diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml new file mode 100644 index 00000000..af7070f3 --- /dev/null +++ b/.github/workflows/workflow.yml @@ -0,0 +1,32 @@ +name: NIST COBOL85 tests +on: + push: + pull_request: + types: [opened, reopened, review_requested] + +jobs: + run-tests: + runs-on: ubuntu-latest + steps: + # Checkout opensource COBOL + - name: Checkout opensource COBOL + uses: actions/checkout@v2 + + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get install -y build-essential libncurses-dev libgmp-dev bison flex gettext automake autoconf + + - name: Install opensource COBOL + run: | + cd vbisam + ./configure --prefix=/usr/ + sudo make install + cd ../ + ./configure --prefix=/usr/ --with-vbisam + sudo make install + + - name: run NIST tests + run: | + cd tests/cobol85 + make test diff --git a/bin/cobcrun.c b/bin/cobcrun.c deleted file mode 100644 index e648eb0b..00000000 --- a/bin/cobcrun.c +++ /dev/null @@ -1,158 +0,0 @@ -/* - * Copyright (C) 2004-2009 Roger While - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, 51 Franklin Street, Fifth Floor - * Boston, MA 02110-1301 USA - */ - -#include "config.h" -#include "defaults.h" - -#include -#include -#include "libcob.h" - -#include "tarstamp.h" - -#ifdef HAVE_KPATHSEA_GETOPT_H -#include -#else -#ifdef HAVE_GETOPT_H -#include -#else -#include "lib/getopt.h" -#endif -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -static const char short_options[] = "hV"; - -static const struct option long_options[] = { - {"help", no_argument, NULL, 'h'}, - {"version", no_argument, NULL, 'V'}, - {NULL, 0, NULL, 0} -}; - -static void -cobcrun_print_version (void) -{ - int year; - int day; - char buff[64]; - char month[64]; - - memset (buff, 0, sizeof(buff)); - memset (month, 0, sizeof(month)); - day = 0; - year = 0; - sscanf (__DATE__, "%s %d %d", month, &day, &year); - if (day && year) { - sprintf (buff, "%s %2.2d %4.4d %s", month, day, year, __TIME__); - } else { - sprintf (buff, "%s %s", __DATE__, __TIME__); - } - printf ("cobcrun (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts ("Copyright (C) 2004-2009 Roger While"); - printf ("Built %s\nPackaged %s\n", buff, octardate); -} - -static void -cobcrun_print_usage (void) -{ - printf ("Usage: cobcrun PROGRAM [param ...]"); - printf ("\n\n"); - printf ("or : cobcrun --help"); - printf ("\n"); - printf (" Display this message"); - printf ("\n\n"); - printf ("or : cobcrun --version, -V"); - printf ("\n"); - printf (" Display runtime version"); - printf ("\n\n"); -} - -static int -process_command_line (int argc, char *argv[]) -{ - int c, idx; - - /* At least one option or module name needed */ - if (argc <= 1) { - cobcrun_print_usage (); - return 1; - } - - /* Translate first command line argument from WIN to UNIX style */ - if (strrchr(argv[1], '/') == argv[1]) { - argv[1][0] = '-'; - } - - /* Process first command line argument only if not a module */ - if (argv[1][0] != '-') { - return 99; - } - - c = getopt_long_only (argc, argv, short_options, long_options, &idx); - if (c > 0) { - switch (c) { - case '?': - return 1; - case 'h': - cobcrun_print_usage (); - return 0; - case 'V': - cobcrun_print_version (); - return 0; - } - } - - return 99; -} - -int -main (int argc, char **argv) -{ - int pcl_return; - - union { - int (*func)(); - void *func_void; - } unifunc; - -#ifdef HAVE_SETLOCALE - setlocale (LC_ALL, ""); -#endif - - pcl_return = process_command_line (argc, argv); - - if (pcl_return != 99) { - return pcl_return; - } - - if (strlen (argv[1]) > 31) { - fprintf (stderr, "Invalid PROGRAM name\n"); - return 1; - } - cob_init (argc - 1, &argv[1]); - unifunc.func_void = cob_resolve (argv[1]); - if (unifunc.func_void == NULL) { - cob_call_error (); - } - cob_stop_run ( unifunc.func() ); -} diff --git a/cobc/cobc.c b/cobc/cobc.c index 90fac667..1b54ad43 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -1168,7 +1168,7 @@ process_command_line (const int argc, char *argv[]) #ifdef _MSC_VER strcat (cob_define_flags, "/I "); #else - strcat (cob_define_flags, "-I"); + strcat (cob_define_flags, " -I"); #endif strcat (cob_define_flags, "\""); strcat (cob_define_flags, optarg); diff --git a/cobc/typeck.c b/cobc/typeck.c index 9b3e5322..4169d582 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -220,111 +220,10 @@ static const char *const bin_sub_funcs[] = { "cob_subswp_s56_binary", "cob_subswp_s64_binary" }; - -static const char *const align_bin_compare_funcs[] = { - "cob_cmp_u8_binary", - "cob_cmp_align_u16_binary", - "cob_cmp_u24_binary", - "cob_cmp_align_u32_binary", - "cob_cmp_u40_binary", - "cob_cmp_u48_binary", - "cob_cmp_u56_binary", - "cob_cmp_align_u64_binary", - "cob_cmp_s8_binary", - "cob_cmp_align_s16_binary", - "cob_cmp_s24_binary", - "cob_cmp_align_s32_binary", - "cob_cmp_s40_binary", - "cob_cmp_s48_binary", - "cob_cmp_s56_binary", - "cob_cmp_align_s64_binary", - "cob_cmp_u8_binary", - "cob_cmpswp_align_u16_binary", - "cob_cmpswp_u24_binary", - "cob_cmpswp_align_u32_binary", - "cob_cmpswp_u40_binary", - "cob_cmpswp_u48_binary", - "cob_cmpswp_u56_binary", - "cob_cmpswp_align_u64_binary", - "cob_cmp_s8_binary", - "cob_cmpswp_align_s16_binary", - "cob_cmpswp_s24_binary", - "cob_cmpswp_align_s32_binary", - "cob_cmpswp_s40_binary", - "cob_cmpswp_s48_binary", - "cob_cmpswp_s56_binary", - "cob_cmpswp_align_s64_binary" -}; - -static const char *const align_bin_add_funcs[] = { - "cob_add_u8_binary", - "cob_add_align_u16_binary", - "cob_add_u24_binary", - "cob_add_align_u32_binary", - "cob_add_u40_binary", - "cob_add_u48_binary", - "cob_add_u56_binary", - "cob_add_align_u64_binary", - "cob_add_s8_binary", - "cob_add_align_s16_binary", - "cob_add_s24_binary", - "cob_add_align_s32_binary", - "cob_add_s40_binary", - "cob_add_s48_binary", - "cob_add_s56_binary", - "cob_add_align_s64_binary", - "cob_add_u8_binary", - "cob_addswp_u16_binary", - "cob_addswp_u24_binary", - "cob_addswp_u32_binary", - "cob_addswp_u40_binary", - "cob_addswp_u48_binary", - "cob_addswp_u56_binary", - "cob_addswp_u64_binary", - "cob_add_s8_binary", - "cob_addswp_s16_binary", - "cob_addswp_s24_binary", - "cob_addswp_s32_binary", - "cob_addswp_s40_binary", - "cob_addswp_s48_binary", - "cob_addswp_s56_binary", - "cob_addswp_s64_binary" -}; - -static const char *const align_bin_sub_funcs[] = { - "cob_sub_u8_binary", - "cob_sub_align_u16_binary", - "cob_sub_u24_binary", - "cob_sub_align_u32_binary", - "cob_sub_u40_binary", - "cob_sub_u48_binary", - "cob_sub_u56_binary", - "cob_sub_align_u64_binary", - "cob_sub_s8_binary", - "cob_sub_align_s16_binary", - "cob_sub_s24_binary", - "cob_sub_align_s32_binary", - "cob_sub_s40_binary", - "cob_sub_s48_binary", - "cob_sub_s56_binary", - "cob_sub_align_s64_binary", - "cob_sub_u8_binary", - "cob_subswp_u16_binary", - "cob_subswp_u24_binary", - "cob_subswp_u32_binary", - "cob_subswp_u40_binary", - "cob_subswp_u48_binary", - "cob_subswp_u56_binary", - "cob_subswp_u64_binary", - "cob_sub_s8_binary", - "cob_subswp_s16_binary", - "cob_subswp_s24_binary", - "cob_subswp_s32_binary", - "cob_subswp_s40_binary", - "cob_subswp_s48_binary", - "cob_subswp_s56_binary", - "cob_subswp_s64_binary" -}; +/** + * * Add a sample comment + * + */ /* functions */ diff --git a/libcob/call.c b/libcob/call.c index c16b06b6..a6ffb015 100644 --- a/libcob/call.c +++ b/libcob/call.c @@ -586,7 +586,6 @@ cob_init_call (void) #ifndef COB_ALT_HASH call_table = cob_malloc (sizeof (struct call_hash *) * HASH_SIZE); #endif - call_filename_buff = cob_malloc (CALL_FILEBUFF_SIZE); call_entry_buff = cob_malloc (COB_SMALL_BUFF); call_entry2_buff = cob_malloc (COB_SMALL_BUFF); diff --git a/libcob/common.c b/libcob/common.c index dc15ab6a..0e8e947c 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -1813,7 +1813,7 @@ cob_accept_time (cob_field *f) time_t t; #if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) struct timeval tmv; - char buff2[8]; + char buff2[17]; #endif #endif char s[12]; diff --git a/libcob/fileio.c b/libcob/fileio.c deleted file mode 100644 index ec7fc3e7..00000000 --- a/libcob/fileio.c +++ /dev/null @@ -1,6366 +0,0 @@ -/* - * Copyright (C) 2002-2009 Keisuke Nishida - * Copyright (C) 2007-2009 Roger While - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 2.1, - * or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; see the file COPYING.LIB. If - * not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor - * Boston, MA 02110-1301 USA - */ - - -#include "config.h" - -#define _LFS64_LARGEFILE 1 -#define _LFS64_STDIO 1 -#define _FILE_OFFSET_BITS 64 -#define _LARGEFILE64_SOURCE 1 -#ifdef _AIX -#define _LARGE_FILES 1 -#endif /* _AIX */ -#if defined(__hpux__) && !defined(__LP64__) -#define _APP32_64BIT_OFF_T 1 -#endif - -#ifdef __MINGW32__ -#define __USE_MINGW_FSEEK 1 -#endif /* __MINGW32__ */ - -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_SYS_TYPES_H -#include -#endif -#include - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef HAVE_FCNTL_H -#include -#endif - -#ifndef _WIN32 -#include -#endif - -#ifdef _WIN32 - -#define WIN32_LEAN_AND_MEAN -#include /* for GetTempPath, GetTempFileName */ -#include -#define fsync _commit -#define getcwd _getcwd -#define chdir _chdir -#define mkdir _mkdir -#define rmdir _rmdir -#endif - -#ifndef O_BINARY -#define O_BINARY 0 -#endif - -#ifndef O_LARGEFILE -#define O_LARGEFILE 0 -#endif - -/* Force symbol exports */ -#define COB_LIB_EXPIMP - -#include "libcob.h" -#include "coblocal.h" - -#ifdef WITH_DB -#ifdef USE_DB41 -#include -#else -#if HAVE_DB1_DB_H -#include -#elif HAVE_DB_185_H -#include -#elif HAVE_DB3_DB_185_H -#include -#elif HAVE_DB4_DB_185_H -#include -#elif HAVE_DB4_1_DB_185_H -#include -#elif HAVE_DB4_2_DB_185_H -#include -#elif HAVE_DB4_3_DB_185_H -#include -#elif HAVE_DB4_4_DB_185_H -#include -#elif HAVE_DB4_5_DB_185_H -#include -#elif HAVE_DB_H -#include -#endif -#endif /* USE_DB41 */ - -#elif defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) - -#define WITH_ANY_ISAM -#include -#endif - -#ifdef WITH_CISAM -#include -#endif - -#ifdef WITH_DISAM -#include -#endif - -#ifdef WITH_VBISAM -#include -#endif - -#if defined(__hpux__) || defined(_AIX) || defined(__sparc) -#define fseek fseeko -#define ftell ftello -#endif - -#ifdef _MSC_VER -#define fseek _fseeki64 -#define ftell _ftelli64 -#define lseek _lseeki64 -#define off_t __int64 -#endif - -#if !defined(__linux__) -#define SEEK_INIT(f) fseek ((FILE *)f->file, (off_t)0, SEEK_CUR) -#else -#define SEEK_INIT(f) -#endif - - -#ifdef _WIN32 -#define INITIAL_FLAGS O_BINARY -#else -#define INITIAL_FLAGS 0 -#endif - -/* SORT definitions */ - -#define COBSORTEND 1 -#define COBSORTABORT 2 -#define COBSORTFILEERR 3 -#define COBSORTNOTOPEN 4 - -struct cobitem { - struct cobitem *next; - size_t end_of_block; - int record_size; - unsigned char block_byte; - unsigned char unique[sizeof(size_t)]; - unsigned char item[1]; -}; - -struct memory_struct { - struct cobitem *first; - struct cobitem *last; - size_t count; -}; - -struct file_struct { - FILE *fp; - size_t count; /* count of items in temporary files */ -}; - -struct cobsort { - void *pointer; - struct cobitem *empty; - void *sort_return; - cob_field *fnstatus; - size_t unique; - size_t retrieving; - size_t files_used; - size_t size; - size_t r_size; - size_t w_size; - size_t memory; - int destination_file; - int retrieval_queue; - struct memory_struct queue[4]; - struct file_struct file[4]; -}; - -/* End SORT definitions */ - -#ifdef _WIN32 -HANDLE listdir_handle; -LPWIN32_FIND_DATA listdir_filedata; -#else -DIR *listdir_handle; -struct dirent *listdir_filedata; -#endif - -#define OPENMODESIZE 3 -#define READOPTSSIZE 4 -#define STARTCONDSIZE 2 -#define EXCPTCODESIZE 6 -#define FNSTATUSSIZE 3 - -cob_file *cob_error_file; - -#ifndef _WIN32 -static int cob_iteration = 0; -static pid_t cob_process_id = 0; -#endif - -static size_t eop_status = 0; - -static int cob_do_sync = 0; -static int cob_sort_memory = 128*1024*1024; - -#ifdef USE_DB41 -static DB_ENV *bdb_env = NULL; -static char *bdb_home; -static char *bdb_buff; -static const char **bdb_data_dir = NULL; -static void *record_lock_object; -static size_t rlo_size = 0; -static unsigned int bdb_lock_id; -#endif - -static struct file_list { - struct file_list *next; - cob_file *file; -} *file_cache = NULL; - -static char *cob_file_path = NULL; -static char *cob_ls_nulls = NULL; -static char *cob_ls_fixed = NULL; -static char *file_open_env; -static char *file_open_name; -static char *file_open_buff; - -#define TIS_DEFINE_USERFH "OC_USERFH" -#define COB_IO_CREATES "OC_IO_CREATES" -#define COB_EXTEND_CREATES "OC_EXTEND_CREATES" - -/* Emergence buffer in case of malloc fail */ -static char runtime_buffer[COB_SMALL_BUFF]; - -#define RETURN_STATUS(x) do { save_status (f, x, fnstatus); return; } while (0) - -static const int status_exception[] = { - 0, /* 0x */ - COB_EC_I_O_AT_END, /* 1x */ - COB_EC_I_O_INVALID_KEY, /* 2x */ - COB_EC_I_O_PERMANENT_ERROR, /* 3x */ - COB_EC_I_O_LOGIC_ERROR, /* 4x */ - COB_EC_I_O_RECORD_OPERATION, /* 5x */ - COB_EC_I_O_FILE_SHARING, /* 6x */ - COB_EC_I_O, /* unused */ - COB_EC_I_O, /* unused */ - COB_EC_I_O_IMP /* 9x */ -}; - -static const char * const prefix[] = { "DD_", "dd_", "" }; -#define NUM_PREFIX sizeof(prefix) / sizeof(char *) - -#ifdef COB_PARAM_CHECK -static const char parm_msg[] = "CALL to %s requires %d parameters"; -#endif - -static int dummy_rnxt_del (cob_file *f); -static int dummy_rewrite (cob_file *f, const int opt); -static int dummy_read (cob_file *f, cob_field *key, const int read_opts); -static int dummy_start (cob_file *f, const int cond, cob_field *key); - -static int cob_file_open (cob_file *f, char *filename, const int mode, - const int sharing); -static int cob_file_close (cob_file *f, const int opt); -static int cob_file_write_opt (cob_file *f, const int opt); - -static int sequential_read (cob_file *f, const int read_opts); -static int sequential_write (cob_file *f, const int opt); -static int sequential_rewrite (cob_file *f, const int opt); -static int lineseq_read (cob_file *f, const int read_opts); -static int lineseq_write (cob_file *f, const int opt); -static int relative_start (cob_file *f, const int cond, cob_field *k); -static int relative_read (cob_file *f, cob_field *k, const int read_opts); -static int relative_read_next (cob_file *f, const int read_opts); -static int relative_write (cob_file *f, const int opt); -static int relative_rewrite (cob_file *f, const int opt); -static int relative_delete (cob_file *f); - -struct indexfile; - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) - -static int extract_key ( - struct indexfile *fh - , int ix_cob_key - , const void *pb_rec - , void *ret_key_value); -static int keycmp ( - struct indexfile *fh - , int ix_cob_key - , const void *pb_rec - , const void *pb_key); - -#endif - -#if defined(WITH_DB) || defined(WITH_ANY_ISAM) || defined(WITH_INDEX_EXTFH) - -#ifdef WITH_DB -#ifdef USE_DB41 -#define DB_PUT(db,flags) db->put (db, NULL, &p->key, &p->data, flags) -#define DB_GET(db,flags) db->get (db, NULL, &p->key, &p->data, flags) -#define DB_SEQ(db,flags) db->c_get (db, &p->key, &p->data, flags) -#define DB_DEL(db,key,flags) db->del (db, NULL, key, flags) -#define DB_CLOSE(db) db->close (db, 0) -#define DB_SYNC(db) db->sync (db, 0) -#define cob_dbtsize_t u_int32_t -#else -#define DB_PUT(db,flags) db->put (db, &p->key, &p->data, flags) -#define DB_GET(db,flags) db->get (db, &p->key, &p->data, flags) -#define DB_SEQ(db,flags) db->seq (db, &p->key, &p->data, flags) -#define DB_DEL(db,key,flags) db->del (db, key, flags) -#define DB_CLOSE(db) db->close (db) -#define DB_SYNC(db) db->sync (db, 0) -#define DB_FIRST R_FIRST -#define DB_LAST R_LAST -#define DB_NEXT R_NEXT -#define DB_PREV R_PREV -#define cob_dbtsize_t size_t -#endif - -#define DBT_SET(key,fld) \ - key.data = fld->data; \ - key.size = (cob_dbtsize_t) fld->size - -struct indexed_file { - size_t key_index; - unsigned char *last_key; /* the last key written */ - unsigned char *temp_key; /* used for temporary storage */ - DB **db; /* database handlers */ - DBT key; - DBT data; - unsigned char **last_readkey; /* the last key read */ - unsigned int *last_dupno; /* the last number of duplicates read */ - int *rewrite_sec_key; -#ifdef USE_DB41 - DBC **cursor; - DB_LOCK bdb_file_lock; - char *filename; /*needed for record locks*/ - DB_LOCK bdb_record_lock; - int write_cursor_open; - unsigned int bdb_lock_id; - int record_locked; - int filenamelen; -#endif -}; -#endif /* WITH_DB */ - - -static int indexed_open (cob_file *f, char *filename, const int mode, - const int sharing); -static int indexed_close (cob_file *f, const int opt); -static int indexed_start (cob_file *f, const int cond, cob_field *key); -static int indexed_read (cob_file *f, cob_field *key, const int read_opts); -static int indexed_read_next (cob_file *f, const int read_opts); -static int indexed_write (cob_file *f, const int opt); -static int indexed_delete (cob_file *f); -static int indexed_rewrite (cob_file *f, const int opt); - -#if !defined(WITH_INDEX_EXTFH) && !defined(WITH_ANY_ISAM) -static int indexed_write_internal (cob_file *f, const int rewrite, const int opt); -static int indexed_delete_internal (cob_file *f, const int rewrite); -#endif /* WITH_INDEX_EXTFH */ - -static const struct cob_fileio_funcs indexed_funcs = { - indexed_open, - indexed_close, - indexed_start, - indexed_read, - indexed_read_next, - indexed_write, - indexed_rewrite, - indexed_delete -}; - -#else /* WITH_DB || WITH_ANY_ISAM || WITH_INDEX_EXTFH */ - -static int -dummy_open (cob_file *f, char *filename, const int mode, const int sharing) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - -static int -dummy_write_close (cob_file *f, const int opt) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - - -static struct cob_fileio_funcs indexed_funcs = { - dummy_open, - dummy_write_close, - dummy_start, - dummy_read, - dummy_rnxt_del, - dummy_write_close, - dummy_rewrite, - dummy_rnxt_del -}; - -#endif /* WITH_DB || WITH_ANY_ISAM || WITH_INDEX_EXTFH */ - - -static const struct cob_fileio_funcs sequential_funcs = { - cob_file_open, - cob_file_close, - dummy_start, - dummy_read, - sequential_read, - sequential_write, - sequential_rewrite, - dummy_rnxt_del -}; - -static const struct cob_fileio_funcs lineseq_funcs = { - cob_file_open, - cob_file_close, - dummy_start, - dummy_read, - lineseq_read, - lineseq_write, - dummy_rewrite, - dummy_rnxt_del -}; - -static const struct cob_fileio_funcs relative_funcs = { - cob_file_open, - cob_file_close, - relative_start, - relative_read, - relative_read_next, - relative_write, - relative_rewrite, - relative_delete -}; - -static const struct cob_fileio_funcs *fileio_funcs[COB_ORG_MAX] = { - &sequential_funcs, - &lineseq_funcs, - &relative_funcs, - &indexed_funcs, - NULL -}; - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH) -extern void extfh_cob_init_fileio (const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - int (*)(cob_file *, const int)); -extern void extfh_cob_exit_fileio (void); -#endif - -#ifdef WITH_INDEX_EXTFH -extern void extfh_indexed_unlock (cob_file *); -extern int extfh_indexed_locate (cob_file *, char *); -extern int extfh_indexed_open (cob_file *, char *, int, int); -extern int extfh_indexed_close (cob_file *, int); -extern int extfh_indexed_start (cob_file *, int, cob_field *); -extern int extfh_indexed_read (cob_file *, cob_field *, int); -extern int extfh_indexed_read_next (cob_file *, int); -extern int extfh_indexed_write (cob_file *, int); -extern int extfh_indexed_delete (cob_file *); -extern int extfh_indexed_rewrite (cob_file *, int); -#endif - -#ifdef WITH_SEQRA_EXTFH -extern void extfh_seqra_unlock (cob_file *); -extern int extfh_seqra_locate (cob_file *, char *); -extern int extfh_cob_file_open (cob_file *, char *, int, int); -extern int extfh_cob_file_close (cob_file *, int); -extern int extfh_sequential_read (cob_file *, int); -extern int extfh_sequential_write (cob_file *, int); -extern int extfh_sequential_rewrite (cob_file *, int); -extern int extfh_relative_start (cob_file *, int, cob_field *); -extern int extfh_relative_read (cob_file *, cob_field *, int); -extern int extfh_relative_read_next (cob_file *, int); -extern int extfh_relative_write (cob_file *, int); -extern int extfh_relative_rewrite (cob_file *, int); -extern int extfh_relative_delete (cob_file *); -#endif - -#if defined(WITH_ANY_ISAM) -/* Isam File handler packet */ - -struct indexfile { - char *filename; /* ISAM data file name */ - char *savekey; /* Area to save last Prime Key read */ - char *recwrk; /* Record work/save area */ - int isfd; /* ISAM file number */ - int recnum; /* last record number read */ - int saverecnum; /* isrecnum of next record to process */ - int saveerrno; /* savefileposition errno */ - int lmode; /* File lock mode for 'isread' */ - int curkey; /* Current active index */ - int startcond; /* Previous 'start' condition value */ - int readdir; /* read direction: ISPREV or ISNEXT */ - int nkeys; /* Actual keys in file */ - int lenkey; /* Length of savekey area */ - int eofpending; /* end of file pending */ - int readdone; /* A 'read' has been succesfully done */ - int startiscur; /* The 'start' record is current */ - int keyhasdups; /* 'curkey' has dups */ - int wrkhasrec; /* 'recwrk' buffer holds the next|prev record */ - struct keydesc key[1]; /* Table of key information */ - /* keydesc is defined in (d|c|vb)isam.h */ -}; - -/* Translate ISAM status to COBOL status and return */ - -static int COB_NOINLINE -isretsts (int dfltsts) -{ - switch (iserrno) { - case 0: - dfltsts = COB_STATUS_00_SUCCESS; - break; - case ENOREC: - dfltsts = COB_STATUS_23_KEY_NOT_EXISTS; - break; - case EENDFILE: - dfltsts = COB_STATUS_10_END_OF_FILE; - break; - case EPERM: - dfltsts = COB_STATUS_37_PERMISSION_DENIED; - break; - case EACCES: - dfltsts = COB_STATUS_37_PERMISSION_DENIED; - break; - case EISDIR: - dfltsts = COB_STATUS_37_PERMISSION_DENIED; - break; - case EDUPL: - dfltsts = COB_STATUS_22_KEY_EXISTS; - break; - case EKEXISTS: - dfltsts = COB_STATUS_22_KEY_EXISTS; - break; - case ENOENT: - dfltsts = COB_STATUS_35_NOT_EXISTS; - break; - case ENOCURR: - if (dfltsts != COB_STATUS_10_END_OF_FILE) { - dfltsts = COB_STATUS_21_KEY_INVALID; - } - break; - case ELOCKED: - dfltsts = COB_STATUS_51_RECORD_LOCKED; - break; - case EFLOCKED: - dfltsts = COB_STATUS_61_FILE_SHARING; - break; - } - return dfltsts; -} - -/* Free memory for indexfile packet */ - -static void COB_NOINLINE -freefh (struct indexfile *fh) -{ - if (fh == NULL) { - return; - } - if (fh->filename) { - free ((void *)fh->filename); - } - if (fh->savekey) { - free ((void *)fh->savekey); - } - if (fh->recwrk) { - free ((void *)fh->recwrk); - } - free ((void *)fh); -} - -/* - Restore ISAM file positioning -*/ -static void -restorefileposition (cob_file *f) -{ - struct indexfile *fh = f->file; - struct keydesc k0; - - memset ((void *)&k0, 0, sizeof(k0)); - if (fh->saverecnum >= 0) { /* Switch back to index */ - isrecnum = fh->saverecnum; - isstart (fh->isfd, &k0, 0, fh->recwrk, ISEQUAL); /* Switch to recnum mode */ - isread (fh->isfd, fh->recwrk, ISEQUAL); /* Read by record number */ - isstart (fh->isfd, &fh->key[fh->curkey], fh->key[fh->curkey].k_leng, fh->recwrk, ISEQUAL); - isread (fh->isfd, fh->recwrk, ISEQUAL); - while (isrecnum != fh->saverecnum) { /* Read back into position */ - if (isread (fh->isfd, fh->recwrk, fh->readdir) == -1) { - break; - } - } - if (isrecnum == fh->saverecnum) { - if (fh->readdir == ISNEXT) { /* Back off by one so next read gets this */ - isread (fh->isfd, fh->recwrk, ISPREV); - } else { - isread (fh->isfd, fh->recwrk, ISNEXT); - } - } - } else if (fh->readdone && fh->curkey == 0) { - /* Original BCS/JR patch: extract_key(fh, 0, fh->recwrk, fh->savekey); */ - memcpy (fh->recwrk + fh->key[fh->curkey].k_start, fh->savekey, - fh->key[fh->curkey].k_leng); - isstart (fh->isfd, &fh->key[fh->curkey], fh->key[fh->curkey].k_leng, fh->recwrk, ISGTEQ); - } -} - -/* Save ISAM file positioning information for later 'restorefileposition' */ - -static void -savefileposition (cob_file *f) -{ - struct indexfile *fh = f->file; - - if (fh->curkey >= 0 && fh->readdir != -1) { /* Switch back to index */ - if (fh->wrkhasrec != fh->readdir) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - if (isread (fh->isfd, fh->recwrk, fh->readdir) == -1) { /* Read next record in file */ - fh->saverecnum = -1; - fh->saveerrno = iserrno; - if (fh->saveerrno == EENDFILE || fh->saveerrno == ENOREC) { - fh->eofpending = fh->readdir; - } - } else { - fh->saverecnum = isrecnum; - fh->saveerrno = 0; - } - memcpy (fh->recwrk, f->record->data, f->record_max); /* Restore saved record data */ - } - } else { - fh->saverecnum = -1; - } -} -#endif /* WITH_ANY_ISAM */ - -static void COB_NOINLINE -cob_sync (cob_file *f, const int mode) -{ -#ifdef WITH_DB - struct indexed_file *p; - size_t i; -#ifdef USE_DB41 - int n; -#endif -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh; -#endif - - if (f->organization == COB_ORG_INDEXED) { -#ifdef WITH_DB - p = f->file; - for (i = 0; i < f->nkeys; i++) { - if (p->db[i]) { - DB_SYNC (p->db[i]); - } - } - if (mode == 2) { - for (i = 0; i < f->nkeys; i++) { - if (p->db[i]) { -#ifdef USE_DB41 - fsync (p->db[i]->fd (p->db[i], &n)); -#else - fsync (p->db[i]->fd (p->db[i])); -#endif - } - } - } -#elif defined(WITH_ANY_ISAM) - fh = f->file; - if (fh) { - isflush (fh->isfd); - } -#endif - return; - } - if (f->organization != COB_ORG_SORT) { - fflush ((FILE *)f->file); - if (mode == 2) { - fsync (fileno ((FILE *)f->file)); - } - } -} - -static void -cob_cache_file (cob_file *f) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - if (f == l->file) { - return; - } - } - l = cob_malloc (sizeof (struct file_list)); - l->file = f; - l->next = file_cache; - file_cache = l; -} - -static void -save_status (cob_file *f, const int status, cob_field *fnstatus) -{ - cob_error_file = f; - if (likely(status == 0)) { - f->file_status[0] = (unsigned char)'0'; - f->file_status[1] = (unsigned char)'0'; - if (fnstatus) { - fnstatus->data[0] = (unsigned char)'0'; - fnstatus->data[1] = (unsigned char)'0'; - } - cob_exception_code = 0; - return; - } - if (likely(status != COB_STATUS_52_EOP)) { - cob_set_exception (status_exception[status / 10]); - } - f->file_status[0] = cob_i2d (status / 10); - f->file_status[1] = cob_i2d (status % 10); - if (fnstatus) { - fnstatus->data[0] = f->file_status[0]; - fnstatus->data[1] = f->file_status[1]; - } -} - -/* Regular file */ - -static size_t COB_NOINLINE -file_linage_check (cob_file *f) -{ - struct linage_struct *lingptr; - - lingptr = (struct linage_struct *)(f->linorkeyptr); - lingptr->lin_lines = cob_get_int (lingptr->linage); - if (lingptr->lin_lines < 1) { - goto linerr; - } - if (lingptr->latfoot) { - lingptr->lin_foot = cob_get_int (lingptr->latfoot); - if (lingptr->lin_foot < 1 || lingptr->lin_foot > lingptr->lin_lines) { - goto linerr; - } - } else { - lingptr->lin_foot = 0; - } - if (lingptr->lattop) { - lingptr->lin_top = cob_get_int (lingptr->lattop); - if (lingptr->lin_top < 0) { - goto linerr; - } - } else { - lingptr->lin_top = 0; - } - if (lingptr->latbot) { - lingptr->lin_bot = cob_get_int (lingptr->latbot); - if (lingptr->lin_bot < 0) { - goto linerr; - } - } else { - lingptr->lin_bot = 0; - } - return 0; -linerr: - cob_set_int (lingptr->linage_ctr, 0); - return 1; -} - -static int -dummy_rnxt_del (cob_file *f) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - -static int -dummy_rewrite (cob_file *f, const int opt) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - -static int -dummy_read (cob_file *f, cob_field *key, const int read_opts) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - -static int -dummy_start (cob_file *f, const int cond, cob_field *key) -{ - return COB_STATUS_91_NOT_AVAILABLE; -} - -static int COB_NOINLINE -cob_file_open (cob_file *f, char *filename, const int mode, const int sharing) -{ - FILE *fp = NULL; - struct linage_struct *lingptr; -#ifdef HAVE_FCNTL - int ret; - struct flock lock; -#endif - - /* open the file */ - switch (mode) { - case COB_OPEN_INPUT: -#if !defined(_WIN32) || defined(_MSC_VER) - if (f->organization == COB_ORG_LINE_SEQUENTIAL) - fp = fopen (filename, "r"); - else -#endif - fp = fopen (filename, "rb"); - break; - case COB_OPEN_OUTPUT: - if (f->organization == COB_ORG_RELATIVE) - fp = fopen (filename, "wb+"); -#if !defined(_WIN32) || defined(_MSC_VER) - else if (f->organization == COB_ORG_LINE_SEQUENTIAL) - fp = fopen (filename, "w"); -#endif - else - fp = fopen (filename, "wb"); - break; - case COB_OPEN_I_O: -#if !defined(_WIN32) || defined(_MSC_VER) - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - fp = fopen (filename, "r+"); - if ((fp == NULL) && (errno == ENOENT) && cob_check_env (COB_IO_CREATES, "yes")) { - fp = fopen (filename, "w+"); - } - } else { -#else - { -#endif - fp = fopen (filename, "rb+"); - if ((fp == NULL) && (errno == ENOENT) && cob_check_env (COB_IO_CREATES, "yes")) { - fp = fopen (filename, "wb+"); - } - } - break; - case COB_OPEN_EXTEND: -#if !defined(_WIN32) || defined(_MSC_VER) - if (f->organization == COB_ORG_LINE_SEQUENTIAL) - fp = fopen (filename, "a+"); - else -#endif - fp = fopen (filename, "ab+"); - break; - } - if (fp == NULL) { - return errno; - } - - if (mode == COB_OPEN_EXTEND) { - fseek (fp, (off_t) 0, SEEK_END); - } - -#ifdef HAVE_FCNTL - /* lock the file */ - if (memcmp (filename, "/dev/", 5)) { - memset ((unsigned char *)&lock, 0, sizeof (struct flock)); - lock.l_type = (sharing || mode == COB_OPEN_OUTPUT) ? F_WRLCK : F_RDLCK; - lock.l_whence = SEEK_SET; - lock.l_start = 0; - lock.l_len = 0; - if (fcntl (fileno (fp), F_SETLK, &lock) < 0) { - ret = errno; - fclose (fp); - return ret; - } - } -#endif - - f->file = fp; - if (unlikely(f->flag_select_features & COB_SELECT_LINAGE)) { - if (file_linage_check (f)) { - return COB_LINAGE_INVALID; - } - f->flag_needs_top = 1; - lingptr = (struct linage_struct *)(f->linorkeyptr); - cob_set_int (lingptr->linage_ctr, 1); - } - return 0; -} - -static int COB_NOINLINE -cob_file_close (cob_file *f, const int opt) -{ -#ifdef HAVE_FCNTL - struct flock lock; -#endif - - switch (opt) { - case COB_CLOSE_NORMAL: - case COB_CLOSE_LOCK: - case COB_CLOSE_NO_REWIND: - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if (f->flag_needs_nl && !(f->flag_select_features & COB_SELECT_LINAGE)) { - f->flag_needs_nl = 0; - putc ('\n', (FILE *)f->file); - } - } -#ifdef HAVE_FCNTL - /* unlock the file */ - memset ((unsigned char *)&lock, 0, sizeof (struct flock)); - lock.l_type = F_UNLCK; - lock.l_whence = SEEK_SET; - lock.l_start = 0; - lock.l_len = 0; - fcntl (fileno ((FILE *)f->file), F_SETLK, &lock); -#endif - /* close the file */ - fclose ((FILE *)f->file); - if (opt == COB_CLOSE_NO_REWIND) { - f->open_mode = COB_OPEN_CLOSED; - return COB_STATUS_07_SUCCESS_NO_UNIT; - } - return COB_STATUS_00_SUCCESS; - default: - fflush ((FILE *)f->file); - return COB_STATUS_07_SUCCESS_NO_UNIT; - } -} - -static int COB_NOINLINE -cob_linage_write_opt (cob_file *f, const int opt) -{ - struct linage_struct *lingptr; - int i, n; - - lingptr = (struct linage_struct *)(f->linorkeyptr); - if (unlikely(opt & COB_WRITE_PAGE)) { - i = cob_get_int (lingptr->linage_ctr); - if (i == 0) { - return COB_STATUS_57_I_O_LINAGE; - } - n = lingptr->lin_lines; - for (; i < n; i++) { - putc ('\n', (FILE *)f->file); - } - for (i = 0; i < lingptr->lin_bot; i++) { - putc ('\n', (FILE *)f->file); - } - if (file_linage_check (f)) { - return COB_STATUS_57_I_O_LINAGE; - } - for (i = 0; i < lingptr->lin_top; i++) { - putc ('\n', (FILE *)f->file); - } - cob_set_int (lingptr->linage_ctr, 1); - } else if (opt & COB_WRITE_LINES) { - n = cob_get_int (lingptr->linage_ctr); - if (n == 0) { - return COB_STATUS_57_I_O_LINAGE; - } - cob_add_int (lingptr->linage_ctr, opt & COB_WRITE_MASK); - i = cob_get_int (lingptr->linage_ctr); - if ((opt & COB_WRITE_EOP) && lingptr->lin_foot) { - if (i >= lingptr->lin_foot) { - eop_status = 1; - } - } - if (i > lingptr->lin_lines) { - if (opt & COB_WRITE_EOP) { - eop_status = 1; - } - for (; n < lingptr->lin_lines; n++) { - putc ('\n', (FILE *)f->file); - } - for (i = 0; i < lingptr->lin_bot; i++) { - putc ('\n', (FILE *)f->file); - } - if (file_linage_check (f)) { - return COB_STATUS_57_I_O_LINAGE; - } - cob_set_int (lingptr->linage_ctr, 1); - for (i = 0; i < lingptr->lin_top; i++) { - putc ('\n', (FILE *)f->file); - } - } else { - for (i = (opt & COB_WRITE_MASK) - 1; i > 0; i--) - putc ('\n', (FILE *)f->file); - } - } - return 0; -} - -static int -cob_file_write_opt (cob_file *f, const int opt) -{ - int i; - - if (unlikely(f->flag_select_features & COB_SELECT_LINAGE)) { - return cob_linage_write_opt (f, opt); - } - if (opt & COB_WRITE_LINES) { - for (i = opt & COB_WRITE_MASK; i > 0; i--) - putc ('\n', (FILE *)f->file); - } else if (opt & COB_WRITE_PAGE) { - putc ('\f', (FILE *)f->file); - } - return 0; -} - -/* SEQUENTIAL */ - -static int -sequential_read (cob_file *f, const int read_opts) -{ - size_t bytesread; - -#if WITH_VARSEQ == 0 || WITH_VARSEQ == 1 || WITH_VARSEQ == 3 - union { - unsigned char sbuff[4]; - unsigned short sshort[2]; - unsigned int sint; - } recsize; -#endif -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_sequential_read (f, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - SEEK_INIT (f); - - /* read the record size */ - if (f->record_min != f->record_max) { -#if WITH_VARSEQ == 2 - if (unlikely(fread (&f->record->size, sizeof (f->record->size), 1, (FILE *)f->file) != 1)) { -#elif WITH_VARSEQ == 3 - if (unlikely(fread (recsize.sbuff, 2, 1, (FILE *)f->file) != 1)) { -#else - if (unlikely(fread (recsize.sbuff, 4, 1, (FILE *)f->file) != 1)) { -#endif - if (ferror ((FILE *)f->file)) { - return COB_STATUS_30_PERMANENT_ERROR; - } else { - return COB_STATUS_10_END_OF_FILE; - } - } -#if WITH_VARSEQ == 0 || WITH_VARSEQ == 3 -#ifdef WORDS_BIGENDIAN - f->record->size = recsize.sshort[0]; -#else - f->record->size = COB_BSWAP_16 (recsize.sshort[0]); -#endif -#elif WITH_VARSEQ == 1 -#ifdef WORDS_BIGENDIAN - f->record->size = recsize.sint; -#else - f->record->size = COB_BSWAP_32 (recsize.sint); -#endif -#endif - } - - /* read the record */ - bytesread = fread (f->record->data, 1, f->record->size, (FILE *)f->file); - if (unlikely(bytesread != f->record->size)) { - if (ferror ((FILE *)f->file)) { - return COB_STATUS_30_PERMANENT_ERROR; - } else if (bytesread == 0) { - return COB_STATUS_10_END_OF_FILE; - } else { - return COB_STATUS_04_SUCCESS_INCOMPLETE; - } - } - return COB_STATUS_00_SUCCESS; -} - -static int -sequential_write (cob_file *f, const int opt) -{ - int ret; - -#if WITH_VARSEQ == 0 || WITH_VARSEQ == 1 || WITH_VARSEQ == 3 - union { - unsigned char sbuff[4]; - unsigned short sshort[2]; - unsigned int sint; - } recsize; -#endif - -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_sequential_write (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - SEEK_INIT (f); - - /* WRITE AFTER */ - if (opt & COB_WRITE_AFTER) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 1; - } - - /* write the record size */ - if (f->record_min != f->record_max) { -#if WITH_VARSEQ == 2 - if (unlikely(fwrite (&f->record->size, sizeof (f->record->size), 1, (FILE *)f->file) != 1)) { -#else /* VARSEQ 0, 1, 3 */ -#if WITH_VARSEQ == 1 -#ifdef WORDS_BIGENDIAN - recsize.sint = f->record->size; -#else - recsize.sint = COB_BSWAP_32 ((unsigned int)f->record->size); -#endif -#else /* VARSEQ 0, 3 */ - recsize.sint = 0; -#ifdef WORDS_BIGENDIAN - recsize.sshort[0] = f->record->size; -#else - recsize.sshort[0] = COB_BSWAP_16 ((unsigned short)f->record->size); -#endif -#endif /* VARSEQ 0, 3 */ -#if WITH_VARSEQ == 3 - if (unlikely(fwrite (recsize.sbuff, 2, 1, (FILE *)f->file) != 1)) { -#else - if (unlikely(fwrite (recsize.sbuff, 4, 1, (FILE *)f->file) != 1)) { -#endif /* VARSEQ 3 */ -#endif /* VARSEQ 0, 1, 3 */ - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - /* write the record */ - if (unlikely(fwrite (f->record->data, f->record->size, 1, (FILE *)f->file) != 1)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - /* WRITE BEFORE */ - if (opt & COB_WRITE_BEFORE) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 0; - } - - return COB_STATUS_00_SUCCESS; -} - -static int -sequential_rewrite (cob_file *f, const int opt) -{ -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_sequential_rewrite (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - if (fseek ((FILE *)f->file, -(off_t) f->record->size, SEEK_CUR)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (fwrite (f->record->data, f->record->size, 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; -} - -/* - * LINE SEQUENTIAL - */ - -static int -lineseq_read (cob_file *f, const int read_opts) -{ - unsigned char *dataptr; - size_t i = 0; - int n; - -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_sequential_read (f, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - dataptr = f->record->data; - for (; ;) { - n = getc ((FILE *)f->file); - if (unlikely(n == EOF)) { - if (!i) { - return COB_STATUS_10_END_OF_FILE; - } else { - break; - } - } - if (unlikely(n == 0 && cob_ls_nulls != NULL)) { - n = getc ((FILE *)f->file); - if (n == EOF) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } else { - if (n == '\r') { - continue; - } - if (n == '\n') { - break; - } - } - if (likely(i < f->record->size)) { - *dataptr++ = n; - i++; - } - } - if (i < f->record->size) { - /* fill the record with spaces */ - memset ((unsigned char *)f->record->data + i, ' ', f->record->size - i); - } - if (f->record_size) { - cob_set_int (f->record_size, (int)i); - } - return COB_STATUS_00_SUCCESS; -} - -static int -lineseq_write (cob_file *f, const int opt) -{ - unsigned char *p; - struct linage_struct *lingptr; - size_t size; - int i; - int ret; - -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_sequential_write (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - -/* RXW - if (opt == 0) { - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - } -*/ - - /* determine the size to be written */ - if (unlikely(cob_ls_fixed != NULL)) { - size = f->record->size; - } else { - for (i = (int)f->record->size - 1; i >= 0; i--) { - if (f->record->data[i] != ' ') { - break; - } - } - size = i + 1; - } - - if (unlikely(f->flag_select_features & COB_SELECT_LINAGE)) { - if (f->flag_needs_top) { - f->flag_needs_top = 0; - lingptr = (struct linage_struct *)(f->linorkeyptr); - for (i = 0; i < lingptr->lin_top; i++) { - putc ('\n', (FILE *)f->file); - } - } - } - /* WRITE AFTER */ - if (opt & COB_WRITE_AFTER) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 1; - } - - /* write to the file */ - if (size) { - if (unlikely(cob_ls_nulls != NULL)) { - p = f->record->data; - for (i = 0; i < (int)size; i++, p++) { - if (*p < ' ') { - putc (0, (FILE *)f->file); - } - putc ((int)(*p), (FILE *)f->file); - } - } else { - if (unlikely(fwrite (f->record->data, size, 1, - (FILE *)f->file) != 1)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - - if (unlikely(f->flag_select_features & COB_SELECT_LINAGE)) { - putc ('\n', (FILE *)f->file); - } - - /* WRITE BEFORE */ - if (opt & COB_WRITE_BEFORE) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 0; - } - - if (f->flag_needs_nl && !unlikely(f->flag_select_features & COB_SELECT_LINAGE)) { - putc ('\n', (FILE *)f->file); - f->flag_needs_nl = 0; - } - - if (unlikely(eop_status)) { - eop_status = 0; - cob_exception_code = 0x0502; - return COB_STATUS_52_EOP; - } - return COB_STATUS_00_SUCCESS; -} - -/* - * RELATIVE - */ - -static int -relative_start (cob_file *f, const int cond, cob_field *k) -{ - int kindex; - size_t relsize; - off_t off; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_start (f, cond, k); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - /* get the index */ - kindex = cob_get_int (k) - 1; - relsize = f->record_max + sizeof (f->record->size); - if (cond == COB_LT) { - kindex--; - } else if (cond == COB_GT) { - kindex++; - } - - /* seek the index */ - for (;;) { - off = kindex * relsize; - if (fseek ((FILE *)f->file, off, SEEK_SET) != 0 || - fread (&f->record->size, sizeof (f->record->size), - 1, (FILE *)f->file) != 1) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - /* check if a valid record */ - if (f->record->size > 0) { - cob_set_int (k, kindex + 1); - fseek ((FILE *)f->file, - (off_t) sizeof (f->record->size), SEEK_CUR); - return COB_STATUS_00_SUCCESS; - } - - /* continue */ - switch (cond) { - case COB_EQ: - return COB_STATUS_23_KEY_NOT_EXISTS; - case COB_LT: - case COB_LE: - kindex--; - break; - case COB_GT: - case COB_GE: - kindex++; - break; - } - } -} - -static int -relative_read (cob_file *f, cob_field *k, const int read_opts) -{ - int relnum; - size_t relsize; - off_t off; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_read (f, k, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - SEEK_INIT (f); - - relnum = cob_get_int (k) - 1; - relsize = f->record_max + sizeof (f->record->size); - off = relnum * relsize; - if (fseek ((FILE *)f->file, off, SEEK_SET) != 0 || - fread (&f->record->size, sizeof (f->record->size), - 1, (FILE *)f->file) != 1) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - if (f->record->size == 0) { - fseek ((FILE *)f->file, - (off_t) sizeof (f->record->size), SEEK_CUR); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - if (fread (f->record->data, f->record_max, 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; -} - -static int -relative_read_next (cob_file *f, const int read_opts) -{ - off_t off; - size_t relsize; - int relnum; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_read_next (f, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - SEEK_INIT (f); - - relsize = f->record_max + sizeof (f->record->size); - for (;;) { - if (fread (&f->record->size, sizeof (f->record->size), 1, (FILE *)f->file) != 1) { - if (ferror ((FILE *)f->file)) { - return COB_STATUS_30_PERMANENT_ERROR; - } else { - return COB_STATUS_10_END_OF_FILE; - } - } - - if (f->keys[0].field) { - if (f->flag_first_read) { - cob_set_int (f->keys[0].field, 1); - f->flag_first_read = 0; - } else { - off = ftell ((FILE *)f->file); - relnum = (int)((off / relsize) + 1); - cob_set_int (f->keys[0].field, 0); - if (cob_add_int (f->keys[0].field, relnum) != 0) { - fseek ((FILE *)f->file, -(off_t) sizeof (f->record->size), - SEEK_CUR); - return COB_STATUS_14_OUT_OF_KEY_RANGE; - } - } - } - - if (f->record->size > 0) { - if (fread (f->record->data, f->record_max, 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; - } - - fseek ((FILE *)f->file, (off_t) f->record_max, SEEK_CUR); - } -} - -static int -relative_write (cob_file *f, const int opt) -{ - size_t size; - size_t relsize; - int i; - int kindex; - off_t off; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_write (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - SEEK_INIT (f); - - relsize = f->record_max + sizeof (f->record->size); - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - kindex = cob_get_int (f->keys[0].field) - 1; - if (kindex < 0) { - return COB_STATUS_21_KEY_INVALID; - } - off = (off_t) (relsize * kindex); - if (fseek ((FILE *)f->file, off, SEEK_SET) != 0) { - return COB_STATUS_21_KEY_INVALID; - } - } else { - off = ftell ((FILE *)f->file); - } - - if (fread (&size, sizeof (size), 1, (FILE *)f->file) > 0) { - fseek ((FILE *)f->file, -(off_t) sizeof (size), SEEK_CUR); - if (size > 0) { - return COB_STATUS_22_KEY_EXISTS; - } - } else { - fseek ((FILE *)f->file, off, SEEK_SET); - } - - if (fwrite (&f->record->size, sizeof (f->record->size), 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (fwrite (f->record->data, f->record_max, 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - /* update RELATIVE KEY */ - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (f->keys[0].field) { -/* - off = ftell ((FILE *)f->file); -*/ - off += relsize; - i = (int)(off / relsize); - cob_set_int (f->keys[0].field, i); - } - } - - return COB_STATUS_00_SUCCESS; -} - -static int -relative_rewrite (cob_file *f, const int opt) -{ - size_t relsize; - int relnum; - off_t off; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_rewrite (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - fseek ((FILE *)f->file, -(off_t) f->record_max, SEEK_CUR); - } else { - relsize = f->record_max + sizeof (f->record->size); - relnum = cob_get_int (f->keys[0].field) - 1; - off = relnum * relsize; - if (fseek ((FILE *)f->file, off, SEEK_SET) != 0 || - fread (&f->record->size, sizeof (f->record->size), - 1, (FILE *)f->file) != 1) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - SEEK_INIT (f); - } - - if (fwrite (f->record->data, f->record_max, 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; -} - -static int -relative_delete (cob_file *f) -{ - size_t relsize; - int relnum; - off_t off; -#ifdef WITH_SEQRA_EXTFH - int extfh_ret; - - extfh_ret = extfh_relative_delete (f); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } -#endif /* WITH_SEQRA_EXTFH */ - - relnum = cob_get_int (f->keys[0].field) - 1; - relsize = f->record_max + sizeof (f->record->size); - off = relnum * relsize; - if (fseek ((FILE *)f->file, off, SEEK_SET) != 0 || - fread (&f->record->size, sizeof (f->record->size), - 1, (FILE *)f->file) != 1) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - fseek ((FILE *)f->file, - (off_t) sizeof (f->record->size), SEEK_CUR); - - f->record->size = 0; - if (fwrite (&f->record->size, sizeof (f->record->size), 1, (FILE *)f->file) != 1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - fseek ((FILE *)f->file, (off_t) f->record_max, SEEK_CUR); - return COB_STATUS_00_SUCCESS; -} - -/* - * INDEXED - */ - -#if defined(WITH_DB) || defined(WITH_INDEX_EXTFH) || defined(WITH_ANY_ISAM) - -#ifdef USE_DB41 -static void -join_environment (void) -{ - int flags, ret; - - if (bdb_home == NULL) { - return; - } - ret = db_env_create (&bdb_env, 0); - if (ret) { - cob_runtime_error ("Can't join BDB environment, env_create: %d %s\n", ret, db_strerror (ret)); - cob_stop_run (1); - } - bdb_env->set_errfile (bdb_env, stderr); -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 2)) - bdb_env->set_msgfile (bdb_env, stderr); -#endif - bdb_env->set_cachesize (bdb_env, 0, 2*1024*1024, 0); - bdb_env->set_alloc (bdb_env, cob_malloc, realloc, free); - flags = DB_CREATE | DB_INIT_MPOOL | DB_INIT_CDB; - ret = bdb_env->open (bdb_env, bdb_home, flags, 0); - if (ret) { - cob_runtime_error ("Can't join BDB environment, env_open: %d %s\n", ret, db_strerror (ret)); - bdb_env->close (bdb_env, 0); - bdb_env = NULL; - cob_stop_run (1); - } -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 1)) - bdb_env->get_data_dirs (bdb_env, &bdb_data_dir); -#endif - bdb_env->lock_id (bdb_env, &bdb_lock_id); -} - -static int -lock_record (cob_file *f, char *key, const unsigned int keylen) -{ - struct indexed_file *p = f->file; - size_t len; - int ret; - DBT dbt; - - len = keylen + p->filenamelen + 1; - if (len > rlo_size) { - free (record_lock_object); - record_lock_object = cob_malloc (len); - rlo_size = len; - } - memcpy ((char *)record_lock_object, p->filename, (size_t)(p->filenamelen + 1)); - memcpy ((char *)record_lock_object + p->filenamelen + 1, key, (size_t)keylen); - dbt.size = (cob_dbtsize_t) len; - dbt.data = record_lock_object; - ret = bdb_env->lock_get (bdb_env, p->bdb_lock_id, DB_LOCK_NOWAIT, - &dbt, DB_LOCK_WRITE, &p->bdb_record_lock); - if (!ret) { - p->record_locked = 1; - } - return ret; -} - -static int -test_record_lock (cob_file *f, char *key, const unsigned int keylen) -{ - struct indexed_file *p = f->file; - size_t len; - int ret; - DBT dbt; - DB_LOCK test_lock; - - len = keylen + p->filenamelen + 1; - if (len > rlo_size) { - free (record_lock_object); - record_lock_object = cob_malloc (len); - rlo_size = len; - } - memcpy ((char *)record_lock_object, p->filename, (size_t)(p->filenamelen + 1)); - memcpy ((char *)record_lock_object + p->filenamelen + 1, key, (size_t)keylen); - dbt.size = (cob_dbtsize_t) len; - dbt.data = record_lock_object; - ret = bdb_env->lock_get (bdb_env, p->bdb_lock_id, DB_LOCK_NOWAIT, - &dbt, DB_LOCK_WRITE, &test_lock); - if (!ret) { - bdb_env->lock_put (bdb_env, &test_lock); - } - return ret; -} - -static int -unlock_record (cob_file *f) -{ - struct indexed_file *p = f->file; - int ret; - - if (p->record_locked == 0) { - return 0; - } - ret = bdb_env->lock_put (bdb_env, &p->bdb_record_lock); - p->record_locked = 0; - return ret; -} -#endif /* USE_DB41 */ - - -/* OPEN the INDEXED file */ - -static int -indexed_open (cob_file *f, char *filename, const int mode, const int sharing) -{ -#ifdef WITH_INDEX_EXTFH - return extfh_indexed_open (f, filename, mode, sharing); -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh; - int ret = COB_STATUS_00_SUCCESS; - int omode = 0; - int lmode = 0; - int vmode = 0; - int dobld = 0; - int isfd = -1; - int k; - int kp; - struct dictinfo di; /* defined in (c|d|vb)isam.h */ - -#if defined(ISVARLEN) - if (f->record_min != f->record_max) { - vmode = ISVARLEN; - isreclen = f->record_min; - } -#endif - if (!f->lock_mode) { - if (mode != COB_OPEN_INPUT) { - lmode = ISEXCLLOCK; - } else { - lmode = ISMANULOCK; - } - } else if ((f->lock_mode & COB_LOCK_EXCLUSIVE)) { - lmode = ISEXCLLOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && mode != COB_OPEN_INPUT) { - lmode = ISAUTOLOCK; - } else { - lmode = ISMANULOCK; - } - switch (mode) { - case COB_OPEN_INPUT: - omode = ISINPUT; - break; - case COB_OPEN_OUTPUT: - lmode = ISEXCLLOCK; - omode = ISOUTPUT; - iserrno = 0; - isfd = isopen (filename, ISINPUT | ISEXCLLOCK | vmode); - if (iserrno == EFLOCKED) { -#ifdef WITH_VBISAM - isfullclose (isfd); -#else - isclose (isfd); -#endif - return COB_STATUS_61_FILE_SHARING; - } else { - if (isfd >= 0) { -#ifdef WITH_VBISAM - isfullclose (isfd); -#else - isclose (isfd); -#endif - } - iserase (filename); - } - iserrno = 0; - dobld = 1; - break; - case COB_OPEN_I_O: - omode = ISINOUT; - break; - case COB_OPEN_EXTEND: - lmode = ISEXCLLOCK; - omode = ISINOUT; - break; - case COB_OPEN_LOCKED: - lmode = ISEXCLLOCK; - omode = ISINOUT; - break; - } - fh = cob_malloc (sizeof(struct indexfile) + ((sizeof (struct keydesc)) * (f->nkeys + 1))); - /* Copy index information */ - for (k = 0; k < f->nkeys; k++) { - memset (&fh->key[k], 0, sizeof(struct keydesc)); - fh->key[k].k_flags = f->keys[k].flag ? ISDUPS : ISNODUPS; - /* additional change to BCS/JR patch: put off the simple-key assamption. */ - if (!f->keys[k].count_components) { - fh->key[k].k_nparts = 1; - fh->key[k].k_start = f->keys[k].offset; - fh->key[k].k_leng = f->keys[k].field->size; - fh->key[k].k_type = CHARTYPE; - }else{ - fh->key[k].k_nparts = f->keys[k].count_components; - for (kp = 0; kp < f->keys[k].count_components; kp++) { - fh->key[k].k_part[kp].kp_start = f->keys[k].component[kp].rb; - fh->key[k].k_part[kp].kp_leng = f->keys[k].component[kp].field->size; - fh->key[k].k_part[kp].kp_type = CHARTYPE; - } - } - if (fh->lenkey < f->keys[k].field->size) { - fh->lenkey = fh->key[k].k_leng; - } - } - iserrno = 0; - fh->lmode = 0; - if (dobld) { -dobuild: - isfd = isbuild (filename, f->record_max, &fh->key[0], ISINOUT | ISEXCLLOCK | vmode); - } else { - if (lmode == ISAUTOLOCK) { - fh->lmode = ISLOCK; - lmode = ISMANULOCK; - } - isfd = isopen (filename, omode | lmode | vmode); - if (isfd == -1) { - if (f->flag_optional) { - if (mode == COB_OPEN_EXTEND || mode == COB_OPEN_I_O) { - dobld = 1; - ret = COB_STATUS_05_SUCCESS_OPTIONAL; - goto dobuild; - } - f->file = fh; - f->open_mode = mode; - fh->isfd = isfd; - fh->filename = strdup (filename); - /* Active index is unknown at this time */ - fh->curkey = -1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - if (f->flag_nonexistent) { - return COB_STATUS_00_SUCCESS; - } - f->flag_nonexistent = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } else if (iserrno == ENOENT) { - if ((mode == COB_OPEN_EXTEND && cob_check_env (COB_EXTEND_CREATES, "yes")) || - (mode == COB_OPEN_I_O && cob_check_env (COB_IO_CREATES, "yes"))) { - dobld = 1; - goto dobuild; - } - } - } else { - memset(&di, 0, sizeof(di)); - isindexinfo (isfd, (void *)&di, 0); - fh->nkeys = di.di_nkeys & 0x7F; /* Mask off ISVARLEN */ - if (fh->nkeys > f->nkeys) { - fh = realloc (fh, sizeof(struct indexfile) + ((sizeof (struct keydesc)) * (fh->nkeys + 1))); - } - for (k = 0; k < fh->nkeys; k++) { - memset (&fh->key[k], 0, sizeof(struct keydesc)); - isindexinfo (isfd, &fh->key[k], k+1); - if (fh->lenkey < fh->key[k].k_leng) { - fh->lenkey = fh->key[k].k_leng; - } - /* Verify that COBOL definition matches the real ISAM file */ - if (f->keys[k].flag) { - if (!(fh->key[k].k_flags & ISDUPS)) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else { - if (fh->key[k].k_flags & ISDUPS) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - /* additional change to BCS/JR patch: put off the simple-key assamption. */ - if (fh->key[k].k_nparts == 1 - && (fh->key[k].k_start != f->keys[k].offset - || fh->key[k].k_leng != f->keys[k].field->size)) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - } - } - if (isfd == -1) { - ret = isretsts (COB_STATUS_35_NOT_EXISTS); - freefh (fh); - return ret; - } - if (ret > 9) { -#ifdef WITH_VBISAM - isfullclose (isfd); -#else - isclose (isfd); -#endif - freefh (fh); - return ret; - } - if (dobld) { - for (k = 1; k < f->nkeys; k++) { - iserrno = 0; - if (isaddindex (isfd, &fh->key[k]) == -1) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - if (ret > 9) { -#ifdef WITH_VBISAM - isfullclose (isfd); -#else - isclose (isfd); -#endif - iserase (filename); - freefh (fh); - return ret; - } - } - f->file = fh; - f->open_mode = mode; - fh->isfd = isfd; - fh->filename = strdup (filename); - fh->savekey = cob_malloc (fh->lenkey + 1); - fh->recwrk = cob_malloc (f->record_max + 1); - fh->curkey = -1; /* Active index is unknown at this time */ - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - return ret; -#else /* WITH_INDEX_EXTFH */ - size_t i, j; -#ifdef USE_DB41 - int flags = 0; - int lock_mode; - int handle_created; -#else - int flags = INITIAL_FLAGS; - BTREEINFO info; -#endif - int ret = 0; - struct indexed_file *p; - size_t maxsize; - - p = cob_malloc (sizeof (struct indexed_file)); -#ifdef USE_DB41 - if (bdb_env != NULL) { - if (mode == COB_OPEN_OUTPUT || mode == COB_OPEN_EXTEND || - (f->lock_mode & COB_LOCK_EXCLUSIVE) || - (mode == COB_OPEN_I_O && !f->lock_mode)) { - lock_mode = DB_LOCK_WRITE; - } else { - lock_mode = DB_LOCK_READ; - } - p->key.size = (cob_dbtsize_t) strlen (filename); - p->key.data = filename; - ret = bdb_env->lock_get (bdb_env, bdb_lock_id, DB_LOCK_NOWAIT, - &p->key, lock_mode, &p->bdb_file_lock); - if (ret) { - free (p); - if (ret == DB_LOCK_NOTGRANTED) { - ret = COB_STATUS_61_FILE_SHARING; - } - return ret; - } - } -#endif - - switch (mode) { - case COB_OPEN_INPUT: -#ifdef USE_DB41 - flags |= DB_RDONLY; -#else - flags |= O_RDONLY; -#endif - break; - case COB_OPEN_OUTPUT: -#ifdef USE_DB41 - flags |= DB_CREATE; -#else - flags |= O_RDWR | O_CREAT | O_TRUNC; -#endif - break; - case COB_OPEN_I_O: - case COB_OPEN_EXTEND: -#ifdef USE_DB41 - flags |= DB_CREATE; -#else - flags |= O_RDWR | O_CREAT; -#endif - break; - } - - p->db = cob_malloc (sizeof (DB *) * f->nkeys); -#ifdef USE_DB41 - p->cursor = cob_malloc (sizeof (DBC *) * f->nkeys); - p->filenamelen = (int) strlen (filename); -#endif - p->last_readkey = cob_malloc (sizeof (unsigned char *) * 2 * f->nkeys); - p->last_dupno = cob_malloc (sizeof (unsigned int) * f->nkeys); - p->rewrite_sec_key = cob_malloc (sizeof (int) * f->nkeys); - maxsize = 0; - for (i = 0; i < f->nkeys; i++) { - if (f->keys[i].field->size > maxsize) { - maxsize = f->keys[i].field->size; - } - } - for (i = 0; i < f->nkeys; i++) { - /* file name */ - memset (runtime_buffer, 0, COB_SMALL_BUFF); - if (i == 0) { - strncpy (runtime_buffer, filename, COB_SMALL_MAX); - } else { - snprintf (runtime_buffer, COB_SMALL_MAX, "%s.%d", - filename, (int)i); - } - - /* btree info */ -#ifdef USE_DB41 - ret = db_create (&p->db[i], bdb_env, 0); - if (!ret) { - handle_created = 1; - if (mode == COB_OPEN_OUTPUT) { - if (bdb_env) { - bdb_env->dbremove (bdb_env, NULL, runtime_buffer, NULL, 0); - } else { - p->db[i]->remove (p->db[i], runtime_buffer, NULL, 0); - ret = db_create (&p->db[i], bdb_env, 0); - } - } - if (!ret) { - if (f->keys[i].flag) { - p->db[i]->set_flags (p->db[i], DB_DUP); - } - } - } else { - handle_created = 0; - } -#else - memset ((unsigned char *)&info, 0, sizeof (info)); - if (f->keys[i].flag) { - info.flags = R_DUP; - } -#endif - - /* open db */ -#ifdef USE_DB41 - if (!ret) { - ret = p->db[i]->open (p->db[i], NULL, runtime_buffer, NULL, - DB_BTREE, flags, COB_FILE_MODE); - } -#else - p->db[i] = dbopen (runtime_buffer, flags, COB_FILE_MODE, DB_BTREE, &info); - if (p->db[i] == 0) { - ret = errno; - } -#endif - if (ret) { - for (j = 0; j < i; j++) { - DB_CLOSE (p->db[j]); - } -#ifdef USE_DB41 - if (handle_created) { - DB_CLOSE (p->db[i]); - } -#endif - free (p->db); - free (p->last_readkey); - free (p->last_dupno); -#ifdef USE_DB41 - free (p->cursor); - if (bdb_env != NULL) { - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - } -#endif - free (p); - return ret; - - } - - p->last_readkey[i] = cob_malloc (maxsize); - p->last_readkey[f->nkeys + i] = cob_malloc (maxsize); - } - - p->temp_key = cob_malloc (maxsize + sizeof(unsigned int)); - f->file = p; - p->key_index = 0; - p->last_key = NULL; - - memset ((unsigned char *)&p->key, 0, sizeof (DBT)); - memset ((unsigned char *)&p->data, 0, sizeof (DBT)); -#ifdef USE_DB41 - p->filename = cob_malloc (strlen (filename) + 1); - strcpy (p->filename, filename); - p->write_cursor_open = 0; - p->record_locked = 0; - if (bdb_env != NULL) { - bdb_env->lock_id (bdb_env, &p->bdb_lock_id); - } - - DBT_SET (p->key, f->keys[0].field); - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - ret = DB_SEQ (p->cursor[0], DB_FIRST); - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; -#else - ret = DB_SEQ (p->db[p->key_index], R_FIRST); -#endif - if (!ret) { - memcpy (p->last_readkey[0], p->key.data, p->key.size); - } else { - p->data.data = NULL; - } - - return 0; -#endif /* WITH_INDEX_EXTFH */ -} - -/* Close the INDEXED file */ - -static int -indexed_close (cob_file *f, const int opt) -{ -#ifdef WITH_INDEX_EXTFH - return extfh_indexed_close (f, opt); -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh = f->file; - - if (fh == NULL) { - return COB_STATUS_00_SUCCESS; - } - if (fh->isfd >= 0) { -#ifdef WITH_VBISAM - isfullclose (fh->isfd); -#else - isclose (fh->isfd); -#endif - } - freefh (fh); - f->file = NULL; - return COB_STATUS_00_SUCCESS; -#else /* WITH_INDEX_EXTFH */ - struct indexed_file *p = f->file; - int i; - - /* close DB's */ -#ifdef USE_DB41 - for (i = 0; i < (int)f->nkeys; i++) { - if (p->cursor[i]) { - p->cursor[i]->c_close (p->cursor[i]); - } - } -#endif - for (i = f->nkeys - 1; i >= 0; i--) { - if (p->db[i]) { - DB_CLOSE (p->db[i]); - } - free (p->last_readkey[i]); - free (p->last_readkey[f->nkeys + i]); - } - - if (p->last_key) { - free (p->last_key); - } - free (p->temp_key); - free (p->db); - free (p->last_readkey); - free (p->last_dupno); - free (p->rewrite_sec_key); -#ifdef USE_DB41 - free (p->filename); - free (p->cursor); - if (bdb_env != NULL) { - unlock_record (f); - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - bdb_env->lock_id_free (bdb_env, p->bdb_lock_id); - } -#endif - free (p); - - return COB_STATUS_00_SUCCESS; -#endif /* WITH_INDEX_EXTFH */ -} - -#if !defined(WITH_INDEX_EXTFH) && !defined(WITH_ANY_ISAM) -static int -indexed_start_internal (cob_file *f, const int cond, cob_field *key, const int read_opts, - const int test_lock) -{ - int ret; - unsigned int dupno; - struct indexed_file *p = f->file; - - /* look up for the key */ - for (p->key_index = 0; p->key_index < f->nkeys; p->key_index++) { - if (f->keys[p->key_index].field->data == key->data) { - break; - } - } -/* RXW - Removed - if (unlikely(p->key_index == f->nkeys)) { - cob_runtime_error ("cob_start_indexed: key not found " - "(should have been detected by cobc)"); - return 99; - } -*/ - - /* search */ - DBT_SET (p->key, key); -#ifdef USE_DB41 - /* the open cursor makes this function atomic */ - if (p->key_index != 0) { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - } - p->db[p->key_index]->cursor (p->db[p->key_index], NULL, &p->cursor[p->key_index], 0); - ret = DB_SEQ (p->cursor[p->key_index], DB_SET_RANGE); -#else - ret = DB_SEQ (p->db[p->key_index], R_CURSOR); -#endif - switch (cond) { - case COB_EQ: - if (ret == 0) { - ret = memcmp (p->key.data, key->data, key->size); - } - break; - case COB_LT: - if (ret != 0) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); -#else - ret = DB_SEQ (p->db[p->key_index], R_LAST); -#endif - } else { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); -#else - ret = DB_SEQ (p->db[p->key_index], R_PREV); -#endif - } - break; - case COB_LE: - if (ret != 0) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); -#else - ret = DB_SEQ (p->db[p->key_index], R_LAST); -#endif - } else if (memcmp (p->key.data, key->data, key->size) != 0) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); -#else - ret = DB_SEQ (p->db[p->key_index], R_PREV); -#endif - } else if (f->keys[p->key_index].flag) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT_NODUP); -#else - while (!ret && memcmp (p->key.data, key->data, key->size) == 0) { - ret = DB_SEQ (p->db[p->key_index], R_NEXT); - } -#endif - if (ret != 0) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); -#else - ret = DB_SEQ (p->db[p->key_index], R_LAST); -#endif - } else { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); -#else - ret = DB_SEQ (p->db[p->key_index], R_PREV); -#endif - } - } - break; - case COB_GT: - while (ret == 0 && memcmp (p->key.data, key->data, key->size) == 0) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); -#else - ret = DB_SEQ (p->db[p->key_index], R_NEXT); -#endif - } - break; - case COB_GE: - /* nothing */ - break; - } - - if (ret == 0 && p->key_index > 0) { - /* temporarily save alternate key */ - memcpy (p->temp_key, p->key.data, f->keys[p->key_index].field->size); - if (f->keys[p->key_index].flag) { - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - } - p->key.data = p->data.data; - p->key.size = f->keys[0].field->size; - ret = DB_GET (p->db[0], 0); - } - -#ifdef USE_DB41 - if (ret == 0 && test_lock) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - ret = test_record_lock (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (read_opts & COB_READ_LOCK) { - ret = lock_record (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } -#endif - - if (ret == 0) { - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.data, f->keys[0].field->size); - } else { - memcpy (p->last_readkey[p->key_index], - p->temp_key, f->keys[p->key_index].field->size); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.data, f->keys[0].field->size); - if (f->keys[p->key_index].flag) { - p->last_dupno[p->key_index] = dupno; - } - } - } - -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - - return (ret == 0) ? COB_STATUS_00_SUCCESS : COB_STATUS_23_KEY_NOT_EXISTS; -} -#endif /* WITH_INDEX_EXTFH */ - -/* START INDEXED file with positioning */ - -static int -indexed_start (cob_file *f, const int cond, cob_field *key) -{ -#ifdef WITH_INDEX_EXTFH - - return extfh_indexed_start (f, cond, key); - -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh = f->file; - int k; - int mode; - int klen; - int ret = COB_STATUS_00_SUCCESS; - - f->flag_read_done = 0; - f->flag_first_read = 0; - fh->readdone = 0; - fh->eofpending = 0; - fh->startiscur = 0; - fh->wrkhasrec = 0; - fh->keyhasdups = 0; - if (f->flag_nonexistent) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - for (k = 0; k < f->nkeys; k++) { - if (f->keys[k].field->data == key->data) { - if (fh->key[k].k_flags & ISDUPS) { - fh->keyhasdups = 1; - } - break; - } - } - /* Use size of data field; This may indicate a partial key */ - klen = key->size; - if (klen < 1 || klen > fh->key[k].k_len) { - klen = fh->key[k].k_len; /* Max key length for this index */ - } - mode = ISGTEQ; - fh->startiscur = 1; - switch (cond) { - case COB_EQ: - mode = ISEQUAL; - fh->readdir = ISNEXT; - break; - case COB_GE: - mode = ISGTEQ; - fh->readdir = ISNEXT; - break; - case COB_GT: - mode = ISGREAT; - fh->readdir = ISNEXT; - break; - case COB_LE: - fh->readdir = ISPREV; - mode = ISGTEQ; - break; - case COB_LT: - fh->readdir = ISPREV; - mode = ISGTEQ; - break; - default: - return COB_STATUS_21_KEY_INVALID; - break; - } - if ((isstart (fh->isfd, &fh->key[k], klen, (void *)f->record->data, mode)) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - fh->curkey = -1; - fh->keyhasdups = 0; - fh->startcond = -1; - fh->readdir = -1; - fh->startiscur = 0; - } else { - if (ret == COB_STATUS_00_SUCCESS) { - fh->startcond = cond; - extract_key (fh, k, f->record->data, fh->savekey); - fh->curkey = k; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 1; - } else { - fh->curkey = -1; - fh->keyhasdups = 0; - fh->startcond = -1; - fh->readdir = -1; - } - } - return ret; -#else /* WITH_INDEX_EXTFH */ - return indexed_start_internal (f, cond, key, 0, 0); -#endif /* WITH_INDEX_EXTFH */ -} - -/* Random READ of the INDEXED file */ - -static int -indexed_read (cob_file *f, cob_field *key, const int read_opts) -{ -#ifdef WITH_INDEX_EXTFH - - return extfh_indexed_read (f, key, read_opts); - -#elif defined(WITH_ANY_ISAM) - - struct indexfile *fh; - int k; - int ret = COB_STATUS_00_SUCCESS; - int lmode; - - fh = f->file; - fh->eofpending = 0; - fh->startiscur = 0; - fh->wrkhasrec = 0; - if (f->flag_nonexistent) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - for (k = 0; k < f->nkeys; k++) { - if (f->keys[k].field->data == key->data) { - break; - } - } - if (fh->curkey != k) { /* Switch to this index */ - isstart (fh->isfd, &fh->key[k], fh->key[0].k_len, (void *)f->record->data, ISEQUAL); - fh->curkey = k; - fh->wrkhasrec = 0; - if (fh->key[k].k_flags & ISDUPS) { - fh->keyhasdups = 1; - } else { - fh->keyhasdups = 0; - } - } - fh->startcond = -1; - lmode = 0; - if (read_opts & COB_READ_LOCK) { - lmode = ISLOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - lmode = ISLCKW; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC)) { - if (f->open_mode != COB_OPEN_INPUT) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - lmode = ISLOCK; - } - } - } -#ifdef ISSKIPLOCK - if (read_opts & COB_READ_IGNORE_LOCK) { - lmode = ISSKIPLOCK; - } -#endif - iserrno = 0; - if ((fh->lmode & ISLOCK) && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - switch (read_opts & 0x0F) { - case COB_READ_NEXT: - fh->readdir = ISNEXT; - if (isread (fh->isfd, (void *)f->record->data, ISNEXT | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - f->flag_end_of_file = 1; - } - break; - case COB_READ_PREVIOUS: - fh->readdir = ISPREV; - if (isread (fh->isfd, (void *)f->record->data, ISPREV | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - f->flag_begin_of_file = 1; - } - break; - case COB_READ_FIRST: - fh->readdir = ISNEXT; - if (isread (fh->isfd, (void *)f->record->data, ISFIRST | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - break; - case COB_READ_LAST: - fh->readdir = ISPREV; - if (isread (fh->isfd, (void *)f->record->data, ISLAST | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - break; - default: - fh->readdir = -1; - if (isread (fh->isfd, (void *)f->record->data, ISEQUAL | lmode) == -1) { - ret = isretsts (COB_STATUS_21_KEY_INVALID); - } - break; - } - if (ret == 0) { - f->flag_first_read = 0; - f->flag_read_done = 1; - fh->readdone = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - extract_key (fh, 0, f->record->data, fh->savekey); - fh->recnum = isrecnum; -#ifdef ISVARLEN - if (f->record_min != f->record_max) { - f->record->size = isreclen; - } -#endif - } else { - memset (fh->savekey, 0, fh->key[0].k_len); - fh->recnum = 0; - fh->readdone = 0; - } - return ret; - -#else /* WITH_INDEX_EXTFH */ - - struct indexed_file *p = f->file; - int ret; - int test_lock = 0; - -#ifdef USE_DB41 - if (bdb_env != NULL) { - unlock_record (f); - test_lock = 1; - } -#endif - - ret = indexed_start_internal (f, COB_EQ, key, read_opts, test_lock); - if (ret != COB_STATUS_00_SUCCESS) { - return ret; - } - - f->record->size = p->data.size; - memcpy (f->record->data, p->data.data, p->data.size); - - return COB_STATUS_00_SUCCESS; -#endif /* WITH_INDEX_EXTFH */ -} - -/* Sequential READ of the INDEXED file */ - -static int -indexed_read_next (cob_file *f, const int read_opts) -{ -#ifdef WITH_INDEX_EXTFH - - return extfh_indexed_read_next (f, read_opts); - -#elif defined(WITH_ANY_ISAM) - - struct indexfile *fh; - int ret; - int lmode; - int domoveback; - - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - lmode = 0; - - if (f->flag_nonexistent) { - if (f->flag_first_read == 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - f->flag_first_read = 0; - return COB_STATUS_10_END_OF_FILE; - } - - if (fh->curkey == -1) { /* Switch to this index */ - isstart (fh->isfd, &fh->key[0], 0, (void *)f->record->data, ISFIRST); - fh->curkey = 0; - fh->readdir = ISNEXT; - fh->startcond = -1; - fh->startiscur = 0; - fh->wrkhasrec = 0; - fh->keyhasdups = 0; - } - if (read_opts & COB_READ_LOCK) { - lmode = ISLOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - lmode = ISLCKW; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && f->open_mode != COB_OPEN_INPUT) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - lmode = ISLOCK; - } - } -#ifdef ISSKIPLOCK - if (read_opts & COB_READ_IGNORE_LOCK) { - lmode |= ISSKIPLOCK; - } -#endif - if ((fh->lmode & ISLOCK) && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - iserrno = 0; - switch (read_opts & 0x0F) { - case COB_READ_NEXT: - fh->readdir = ISNEXT; - if (fh->eofpending == ISNEXT) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - return COB_STATUS_10_END_OF_FILE; - } - if (fh->startiscur) { - if (isread (fh->isfd, (void *)f->record->data, ISCURR) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } else { - switch (fh->startcond) { - case COB_GE: - domoveback = 0; - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) == 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, iserrno == 0 ? ISNEXT : ISFIRST); - } - break; - case COB_LE: - domoveback = 0; - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) == 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, iserrno == 0 ? ISPREV : ISLAST); - } - break; - case COB_LT: - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) >= 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - } - break; - case COB_GT: - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len)<=0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - } - if (isread (fh->isfd, (void *)f->record->data, ISCURR | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - fh->startcond = -1; - fh->startiscur = 0; - } else if (fh->wrkhasrec == ISNEXT) { - memcpy (f->record->data, fh->recwrk, f->record_max); - if (fh->lmode & ISLOCK) { - /* now lock 'peek ahead' record */ - if (isread (fh->isfd, (void *)f->record->data, - ISCURR | fh->lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - } else { - if (fh->wrkhasrec == ISPREV) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - fh->wrkhasrec = 0; - } - if (isread (fh->isfd, (void *)f->record->data, ISNEXT | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - break; - case COB_READ_PREVIOUS: - fh->readdir = ISPREV; - if (fh->eofpending == ISPREV) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - return COB_STATUS_10_END_OF_FILE; - } - if (fh->startiscur) { - if (isread (fh->isfd, (void *)f->record->data, ISCURR | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } else { - switch (fh->startcond) { - case COB_LE: - domoveback = 0; - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) == 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - } - break; - case COB_LT: - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) >= 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - } - break; - case COB_GT: - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) <= 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - case COB_GE: - while (iserrno == 0 - && memcmp (f->record->data + fh->key[fh->curkey].k_start, fh->savekey, fh->key[fh->curkey].k_len) < 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - } - if (isread (fh->isfd, (void *)f->record->data, ISCURR | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - fh->startcond = -1; - fh->startiscur = 0; - } else if (fh->wrkhasrec == ISPREV) { - memcpy (f->record->data, fh->recwrk, f->record_max); - if (fh->lmode & ISLOCK) { - /* now lock 'peek ahead' record */ - if (isread (fh->isfd, (void *)f->record->data, - ISCURR | fh->lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - } else { - if (fh->wrkhasrec == ISNEXT) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - fh->wrkhasrec = 0; - } - if (isread (fh->isfd, (void *)f->record->data, ISPREV | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - } - break; - case COB_READ_FIRST: - fh->readdir = ISNEXT; - if (isread (fh->isfd, (void *)f->record->data, ISFIRST | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - break; - case COB_READ_LAST: - fh->readdir = ISPREV; - if (isread (fh->isfd, (void *)f->record->data, ISLAST | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - break; - default: - fh->readdir = ISNEXT; - if (isread (fh->isfd, (void *)f->record->data, ISNEXT | lmode) == -1) { - ret = isretsts (COB_STATUS_10_END_OF_FILE); - } - break; - } - if (ret == 0) { - fh->eofpending = 0; - f->flag_first_read = 0; - f->flag_read_done = 1; - fh->readdone = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - extract_key (fh, 0, f->record->data, fh->savekey); - fh->recnum = isrecnum; -#if defined(ISVARLEN) - if (f->record_min != f->record_max) { - f->record->size = isreclen; - } -#endif -#if defined(WITH_COBSTATUS02) - if (fh->keyhasdups) { - if (isread (fh->isfd, (void *)fh->recwrk, fh->readdir) == -1) { - fh->eofpending = fh->readdir; - fh->wrkhasrec = 0; - fh->saverecnum = -1; - } else { - fh->wrkhasrec = fh->readdir; - fh->saverecnum = isrecnum; - if (memcmp (f->record->data + fh->key[fh->curkey].k_start, - fh->recwrk + fh->key[fh->curkey].k_start, - fh->key[fh->curkey].k_len) == 0) { - ret = COB_STATUS_02_SUCCESS_DUPLICATE; - } - } - } -#elif defined(WITH_DISAM) - if((isstat1 == '0') && (isstat2 == '2')) { - ret = COB_STATUS_02_SUCCESS_DUPLICATE; - } -#endif - } else { - memset (fh->savekey, 0, fh->key[0].k_len); - fh->recnum = 0; - fh->readdone = 0; - fh->wrkhasrec = 0; - } - return ret; -#else /* WITH_INDEX_EXTFH */ - struct indexed_file *p = f->file; - int ret; - int read_nextprev; - int nextprev = DB_NEXT; - int file_changed = 0; - unsigned int dupno; - -#ifdef USE_DB41 - if (bdb_env != NULL) { - unlock_record (f); - } -#endif - - if (unlikely(read_opts & COB_READ_PREVIOUS)) { - if (f->flag_end_of_file) { - nextprev = DB_LAST; - } else { - nextprev = DB_PREV; - } - } else if (f->flag_begin_of_file) { - nextprev = DB_FIRST; - } -#ifdef USE_DB41 - /* the open cursor makes this function atomic */ - if (p->key_index != 0) { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - } - p->db[p->key_index]->cursor (p->db[p->key_index], NULL, &p->cursor[p->key_index], 0); -#endif - - if (f->flag_first_read) { - /* data is read in indexed_open or indexed_start */ - if (p->data.data == NULL || (f->flag_first_read == 2 && - nextprev == DB_PREV)) { -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - return COB_STATUS_10_END_OF_FILE; - } - /* check if previously read data still exists */ - p->key.size = (cob_dbtsize_t) f->keys[p->key_index].field->size; - p->key.data = p->last_readkey[p->key_index]; -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_SET); -#else - ret = DB_GET (p->db[p->key_index], 0); -#endif - if (!ret && p->key_index > 0) { - if (f->keys[p->key_index].flag) { - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - while (ret == 0 && - memcmp (p->key.data, p->last_readkey[p->key_index], p->key.size) == 0 && - dupno < p->last_dupno[p->key_index]) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); -#else - ret = DB_SEQ (p->db[p->key_index], R_NEXT); -#endif - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - } - if (ret == 0 && - memcmp (p->key.data, p->last_readkey[p->key_index], p->key.size) == 0 && - dupno == p->last_dupno[p->key_index]) { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.data, f->keys[0].field->size); - } else { - ret = 1; - } - } else { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.data, f->keys[0].field->size); - } - if (!ret) { - p->key.size = (cob_dbtsize_t) f->keys[0].field->size; - p->key.data = p->last_readkey[p->key_index + f->nkeys]; - ret = DB_GET (p->db[0], 0); - } - } - file_changed = ret; -#ifdef USE_DB41 - if (bdb_env != NULL && !file_changed) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - ret = test_record_lock (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (read_opts & COB_READ_LOCK) { - ret = lock_record (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } -#endif - } - if (!f->flag_first_read || file_changed) { - if (nextprev == DB_FIRST || nextprev == DB_LAST) { - read_nextprev = 1; - } else { - p->key.size = (cob_dbtsize_t) f->keys[p->key_index].field->size; - p->key.data = p->last_readkey[p->key_index]; -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_SET_RANGE); -#else - ret = DB_SEQ (p->db[p->key_index], R_CURSOR); -#endif - /* ret != 0 possible, records may be deleted since last read */ - if (ret != 0) { - if (nextprev == DB_PREV) { - nextprev = DB_LAST; - read_nextprev = 1; - } else { -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.data, p->last_readkey[p->key_index], p->key.size) == 0) { - if (p->key_index > 0 && f->keys[p->key_index].flag) { - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - while (ret == 0 && - memcmp (p->key.data, p->last_readkey[p->key_index], p->key.size) == 0 && - dupno < p->last_dupno[p->key_index]) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); -#else - ret = DB_SEQ (p->db[p->key_index], R_NEXT); -#endif - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - } - if (ret != 0) { - if (nextprev == DB_PREV) { - nextprev = DB_LAST; - read_nextprev = 1; - } else { -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.data, p->last_readkey[p->key_index], p->key.size) == 0 && - dupno == p->last_dupno[p->key_index]) { - read_nextprev = 1; - } else { - if (nextprev == DB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } else { - read_nextprev = 1; - } - } else { - if (nextprev == DB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } - if (read_nextprev) { -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[p->key_index], nextprev); -#else - ret = DB_SEQ (p->db[p->key_index], nextprev); -#endif - if (ret != 0) { -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - return COB_STATUS_10_END_OF_FILE; - } - } - - if (p->key_index > 0) { - /* temporarily save alternate key */ - memcpy (p->temp_key, p->key.data, p->key.size); - if (f->keys[p->key_index].flag) { - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); - } - p->key.data = p->data.data; - p->key.size = f->keys[0].field->size; - if (DB_GET (p->db[0], 0) != 0) { -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; -#endif - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } -#ifdef USE_DB41 - if (bdb_env != NULL) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - ret = test_record_lock (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (read_opts & COB_READ_LOCK) { - ret = lock_record (f, p->key.data, p->key.size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } -#endif - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.data, p->key.size); - } else { - memcpy (p->last_readkey[p->key_index], p->temp_key, - f->keys[p->key_index].field->size); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.data, f->keys[0].field->size); - if (f->keys[p->key_index].flag) { - p->last_dupno[p->key_index] = dupno; - } - } - } - -#ifdef USE_DB41 - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } -#endif - - f->record->size = p->data.size; - memcpy (f->record->data, p->data.data, p->data.size); - - return COB_STATUS_00_SUCCESS; -#endif /* WITH_INDEX_EXTFH */ -} - -#if !defined(WITH_INDEX_EXTFH) && !defined(WITH_ANY_ISAM) -/* get the next number in a set of duplicates */ -static unsigned int -get_dupno (cob_file *f, const int i) -{ - int ret; - unsigned int dupno = 0; - struct indexed_file *p = f->file; - - DBT_SET (p->key, f->keys[i].field); - memcpy (p->temp_key, p->key.data, p->key.size); -#ifdef USE_DB41 - p->db[i]->cursor (p->db[i], NULL, &p->cursor[i], 0); - ret = DB_SEQ (p->cursor[i], DB_SET_RANGE); -#else - ret = DB_SEQ (p->db[i], R_CURSOR); -#endif - while (ret == 0 && memcmp (p->key.data, p->temp_key, p->key.size) == 0) { - memcpy (&dupno, (ucharptr)p->data.data + f->keys[0].field->size, sizeof(unsigned int)); -#ifdef USE_DB41 - ret = DB_SEQ (p->cursor[i], DB_NEXT); -#else - ret = DB_SEQ (p->db[i], R_NEXT); -#endif - } -#ifdef USE_DB41 - p->cursor[i]->c_close (p->cursor[i]); - p->cursor[i] = NULL; -#endif - return ++dupno; -} - -static int -check_alt_keys (cob_file *f, const int rewrite) -{ - size_t i; - int ret; - struct indexed_file *p = f->file; - - for (i = 1; i < f->nkeys; i++) { - if (!f->keys[i].flag) { - DBT_SET (p->key, f->keys[i].field); - ret = DB_GET (p->db[i], 0); - if (ret == 0) { - if (rewrite) { - if (memcmp (p->data.data, f->keys[0].field->data, f->keys[0].field->size)) { - return 1; - } - } else { - return 1; - } - } - } - } - return 0; -} - -static int -indexed_write_internal (cob_file *f, const int rewrite, const int opt) -{ - size_t i; - struct indexed_file *p = f->file; - int flags; - unsigned int dupno; -#ifdef USE_DB41 - int close_cursor; - - if (bdb_env) { - flags = DB_WRITECURSOR; - } else { - flags = 0; - } - if (p->write_cursor_open) { - close_cursor = 0; - } else { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], flags); - p->write_cursor_open = 1; - close_cursor = 1; - } -#endif - - /* check duplicate alternate keys */ - if (f->nkeys > 1 && !rewrite) { - if (check_alt_keys (f, 0)) { -#ifdef USE_DB41 - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } -#endif - return COB_STATUS_22_KEY_EXISTS; - } - DBT_SET (p->key, f->keys[0].field); - } - - /* write data */ -#ifdef USE_DB41 - if (p->cursor[0]->c_get (p->cursor[0], &p->key, &p->data, DB_SET) == 0) { - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } - return COB_STATUS_22_KEY_EXISTS; - } - p->data.data = f->record->data; - p->data.size = (cob_dbtsize_t) f->record->size; - p->cursor[0]->c_put (p->cursor[0], &p->key, &p->data, DB_KEYFIRST); -#else - p->data.data = f->record->data; - p->data.size = (cob_dbtsize_t) f->record->size; - if (DB_PUT (p->db[0], R_NOOVERWRITE) != 0) { - return COB_STATUS_22_KEY_EXISTS; - } -#endif - - /* write secondary keys */ - p->data = p->key; - for (i = 1; i < f->nkeys; i++) { - if (rewrite && ! p->rewrite_sec_key[i]) { - continue; - } - if (f->keys[i].flag) { - flags = 0; - dupno = get_dupno(f, i); - memcpy (p->temp_key, f->keys[0].field->data, - f->keys[0].field->size); - memcpy (p->temp_key + f->keys[0].field->size, &dupno, - sizeof(unsigned int)); - p->data.data = p->temp_key; - p->data.size = f->keys[0].field->size + sizeof(unsigned int); - } else { -#ifdef USE_DB41 - flags = DB_NOOVERWRITE; -#else - flags = R_NOOVERWRITE; -#endif - } - - DBT_SET (p->key, f->keys[i].field); - if (DB_PUT (p->db[i], flags) != 0) { -#ifdef USE_DB41 - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } -#endif - return COB_STATUS_22_KEY_EXISTS; - } - } - -#ifdef USE_DB41 - if (opt & COB_WRITE_LOCK) { - if (bdb_env != NULL) { - DBT_SET (p->key, f->keys[0].field); - if (lock_record (f, p->key.data, p->key.size)) { - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } -#endif - return COB_STATUS_00_SUCCESS; -} -#endif /* WITH_INDEX_EXTFH */ - -/* WRITE to the INDEXED file */ - -static int -indexed_write (cob_file *f, const int opt) -{ -#ifdef WITH_INDEX_EXTFH - return extfh_indexed_write (f, opt); -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh = f->file; - int ret = COB_STATUS_00_SUCCESS; - - if (f->flag_nonexistent) { - return COB_STATUS_30_PERMANENT_ERROR; - } -#if defined(ISVARLEN) - if (f->record_min != f->record_max) { - isreclen = f->record->size; - } -#endif - if (iswrite (fh->isfd, (void *)f->record->data) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - if (iserrno == EDUPL) { - if (f->open_mode == COB_OPEN_OUTPUT) { - ret = COB_STATUS_21_KEY_INVALID; - } - } - } else { - extract_key (fh, 0, f->record->data, fh->savekey); - } - return ret; -#else /* WITH_INDEX_EXTFH */ - struct indexed_file *p = f->file; - -#ifdef USE_DB41 - if (bdb_env != NULL) { - unlock_record (f); - } -#endif - - /* check record key */ - DBT_SET (p->key, f->keys[0].field); - if (!p->last_key) { - p->last_key = cob_malloc (p->key.size); - } else if (f->access_mode == COB_ACCESS_SEQUENTIAL - && memcmp (p->last_key, p->key.data, p->key.size) > 0) { - return COB_STATUS_21_KEY_INVALID; - } - memcpy (p->last_key, p->key.data, p->key.size); - - return indexed_write_internal (f, 0, opt); -#endif /* WITH_INDEX_EXTFH */ -} - -#if !defined(WITH_INDEX_EXTFH) && !defined(WITH_ANY_ISAM) -static int -indexed_delete_internal (cob_file *f, const int rewrite) -{ - size_t i; - size_t offset; - struct indexed_file *p = f->file; - DBT prim_key; -#ifdef USE_DB41 - int ret, flags, close_cursor; - - if (bdb_env) { - flags = DB_WRITECURSOR; - } else { - flags = 0; - } - if (p->write_cursor_open) { - close_cursor = 0; - } else { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], flags); - p->write_cursor_open = 1; - close_cursor = 1; - } - if (bdb_env != NULL) { - unlock_record (f); - } -#endif - /* find the primary key */ -#ifdef USE_DB41 - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - DBT_SET (p->key, f->keys[0].field); - } - ret = DB_SEQ (p->cursor[0], DB_SET); - if (ret != 0 && f->access_mode != COB_ACCESS_SEQUENTIAL) { - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } - return COB_STATUS_23_KEY_NOT_EXISTS; - } - if (bdb_env != NULL) { - ret = test_record_lock (f, p->key.data, p->key.size); - if (ret) { - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } -#else - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - DBT_SET (p->key, f->keys[0].field); - if (DB_GET (p->db[0], 0) != 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } -#endif - prim_key = p->key; - - /* delete the secondary keys */ - offset = (char *) p->data.data - (char *) f->record->data; - for (i = 1; i < f->nkeys; i++) { - DBT_SET (p->key, f->keys[i].field); - p->key.data = (char *)p->key.data + offset; - /* rewrite: no delete if secondary key is unchanged */ - if (rewrite) { - p->rewrite_sec_key[i] = memcmp (p->key.data, f->keys[i].field->data, p->key.size); - if (!p->rewrite_sec_key[i]) { - continue; - } - } - if (!f->keys[i].flag) { - DB_DEL (p->db[i], &p->key, 0); - } else { - DBT sec_key = p->key; - -#ifdef USE_DB41 - p->db[i]->cursor (p->db[i], NULL, &p->cursor[i], flags); - if (DB_SEQ (p->cursor[i], DB_SET_RANGE) == 0) { -#else - if (DB_SEQ (p->db[i], R_CURSOR) == 0) { -#endif - while (sec_key.size == p->key.size - && memcmp (p->key.data, sec_key.data, - sec_key.size) == 0) { - if (memcmp (p->data.data, prim_key.data, - prim_key.size) == 0) { -#ifdef USE_DB41 - p->cursor[i]->c_del (p->cursor[i], 0); -#else - DB_DEL (p->db[i], &p->key, R_CURSOR); -#endif - } -#ifdef USE_DB41 - if (DB_SEQ (p->cursor[i], DB_NEXT) != 0) { -#else - if (DB_SEQ (p->db[i], R_NEXT) != 0) { -#endif - break; - } - } - } -#ifdef USE_DB41 - p->cursor[i]->c_close (p->cursor[i]); - p->cursor[i] = NULL; -#endif - } - } - - /* delete the record */ -#ifdef USE_DB41 - p->cursor[0]->c_del (p->cursor[0], 0); -#else - DB_DEL (p->db[0], &prim_key, 0); -#endif - -#ifdef USE_DB41 - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } -#endif - return COB_STATUS_00_SUCCESS; -} -#endif /* !WITH_INDEX_EXTFH && !WITH_ANY_ISAM */ - -/* DELETE record from the INDEXED file */ - -static int -indexed_delete (cob_file *f) -{ -#ifdef WITH_INDEX_EXTFH - - return extfh_indexed_delete (f); - -#elif defined(WITH_ANY_ISAM) - - struct indexfile *fh; - int ret; - - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - if (f->flag_nonexistent) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (fh->curkey == -1) { /* Switch to prime index */ - isstart (fh->isfd, &fh->key[0], fh->key[0].k_leng, (void *)f->record->data, ISEQUAL); - fh->curkey = 0; - fh->readdir = ISNEXT; - } else { - savefileposition (f); - if (fh->curkey != 0) { /* Switch to prime index */ - isstart (fh->isfd, &fh->key[0], fh->key[0].k_leng, (void *)f->record->data, ISEQUAL); - } - } - if (isread (fh->isfd, (void *)f->record->data, ISEQUAL | ISLOCK) == -1) { - ret = isretsts (COB_STATUS_21_KEY_INVALID); - } else if (isdelete (fh->isfd, (void *)f->record->data) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - } - restorefileposition (f); - return ret; -#else /* WITH_INDEX_EXTFH */ - return indexed_delete_internal (f, 0); -#endif /* WITH_INDEX_EXTFH */ -} - -/* REWRITE record to the INDEXED file */ - -static int -indexed_rewrite (cob_file *f, const int opt) -{ -#ifdef WITH_INDEX_EXTFH - - return extfh_indexed_rewrite (f, opt); - -#elif defined(WITH_ANY_ISAM) - - struct indexfile *fh; - int k; - int ret; - int curisnum; - - COB_UNUSED (opt); - - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - if (f->flag_nonexistent) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && keycmp (fh, 0, f->record->data, fh->savekey) != 0) { - return COB_STATUS_21_KEY_INVALID; - } - if (fh->curkey >= 0) { /* Index is active */ - /* Save record data */ - memcpy (fh->recwrk, f->record->data, f->record_max); - savefileposition (f); - memcpy (fh->recwrk, f->record->data, f->record_max); - if (fh->curkey != 0) { /* Activate Prime index */ - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, ISEQUAL); - } - /* Verify record exists */ - if (isread (fh->isfd, fh->recwrk, ISEQUAL) == -1) { - restorefileposition (f); - return COB_STATUS_21_KEY_INVALID; - } - curisnum = isrecnum; - for (k = 1; k < f->nkeys && ret == COB_STATUS_00_SUCCESS; k++) { - if (fh->key[k].k_flags & ISDUPS) { - continue; - } - memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[k], fh->key[k].k_leng, (void *)fh->recwrk, ISEQUAL); - if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL) != -1 - && isrecnum != curisnum) { - ret = COB_STATUS_22_KEY_EXISTS; - break; - } - } - if (ret == COB_STATUS_00_SUCCESS) { - memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, ISEQUAL); - if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL | ISLOCK) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - } else if (isrewcurr (fh->isfd, (void *)f->record->data) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - } - } - restorefileposition (f); - return ret; - } - - memcpy (fh->recwrk, f->record->data, f->record_max); - if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL | ISLOCK) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - } else if (isrewrite (fh->isfd, (void *)f->record->data) == -1) { - ret = isretsts (COB_STATUS_49_I_O_DENIED); - } -/* RXW */ - if (!ret) { - if ((f->lock_mode & COB_LOCK_AUTOMATIC) && - !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - } - return ret; -#else /* WITH_INDEX_EXTFH */ - struct indexed_file *p; - int ret; -#ifdef USE_DB41 - int flags; - - p = f->file; - if (bdb_env) { - flags = DB_WRITECURSOR; - } else { - flags = 0; - } - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], flags); - p->write_cursor_open = 1; - if (bdb_env != NULL) { - unlock_record (f); - } -#endif - - /* check duplicate alternate keys */ - if (check_alt_keys (f, 1)) { -#ifdef USE_DB41 - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; -#endif - return COB_STATUS_22_KEY_EXISTS; - } - - /* delete the current record */ - ret = indexed_delete_internal (f, 1); - - if (ret != COB_STATUS_00_SUCCESS) { -#ifdef USE_DB41 - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; -#endif - return ret; - } - - /* write data */ - DBT_SET (p->key, f->keys[0].field); - ret = indexed_write_internal (f, 1, opt); - -#ifdef USE_DB41 - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; -#endif - return ret; -#endif /* WITH_INDEX_EXTFH */ -} - -#ifdef USE_DB41 -/* - * check if a file exists in bdb data dirs - */ -static int -is_absolute (const char *filename) -{ -#ifdef _WIN32 - if (filename[0] == '/' || filename[0] == '\\') { - return 1; - } else { - if (isalpha (filename[0]) && filename[1] == ':' && - (filename[2] == '/' || filename[2] == '\\')) { - return 1; - } else { - return 0; - } - } -#else - if (filename[0] == '/') { - return 1; - } else { - return 0; - } -#endif -} - -static int -bdb_nofile (char *filename) -{ - int i; - struct stat st; - - if (is_absolute (filename)) { - if (stat (filename, &st) == -1 && errno == ENOENT) { - return 1; - } else { - return 0; - } - } - - for (i = 0; bdb_data_dir && bdb_data_dir[i]; ++i) { - bdb_buff[COB_SMALL_MAX] = 0; - if (is_absolute (bdb_data_dir[i])) { - snprintf (bdb_buff, COB_SMALL_MAX, "%s/%s", - bdb_data_dir[i], filename); - } else { - snprintf (bdb_buff, COB_SMALL_MAX, "%s/%s/%s", - bdb_home, bdb_data_dir[i], filename); - } - if (stat (bdb_buff, &st) == 0 || errno != ENOENT) { - return 0; - } - } - if (i == 0) { - bdb_buff[COB_SMALL_MAX] = 0; - snprintf (bdb_buff, COB_SMALL_MAX, "%s/%s", bdb_home, filename); - if (stat (bdb_buff, &st) == 0 || errno != ENOENT) { - return 0; - } - } - return 1; -} -#endif - -#endif /* WITH_DB */ - -static void COB_NOINLINE -cob_file_unlock (cob_file *f) -{ -#ifdef WITH_DB -#ifdef USE_DB41 - struct indexed_file *p; -#endif -#elif defined(WITH_ANY_ISAM) - struct indexfile *fh; -#endif -#ifdef HAVE_FCNTL - struct flock lock; -#endif - - if (f->open_mode != COB_OPEN_CLOSED && - f->open_mode != COB_OPEN_LOCKED) { - if (f->organization == COB_ORG_SORT) { - return; - } - if (f->organization != COB_ORG_INDEXED) { -#ifndef WITH_SEQRA_EXTFH - fflush ((FILE *)f->file); - fsync (fileno ((FILE *)f->file)); -#ifdef HAVE_FCNTL - if (!(f->lock_mode & COB_LOCK_EXCLUSIVE)) { - /* unlock the file */ - memset ((unsigned char *)&lock, 0, sizeof (struct flock)); - lock.l_type = F_UNLCK; - lock.l_whence = SEEK_SET; - lock.l_start = 0; - lock.l_len = 0; - fcntl (fileno ((FILE *)f->file), F_SETLK, &lock); - } -#endif -#endif /* WITH_SEQRA_EXTFH */ - } else { -#ifdef WITH_INDEX_EXTFH - extfh_indexed_unlock (f); -#else /* WITH_INDEX_EXTFH */ -#ifdef WITH_DB -#ifdef USE_DB41 - p = f->file; - if (bdb_env != NULL) { - unlock_record (f); - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - } -#endif -#endif -#if defined(WITH_ANY_ISAM) - fh = f->file; - isrelease (fh->isfd); -#endif -#endif /* WITH_INDEX_EXTFH */ - } - } -} - -/* - * Public interface - */ - -void -cob_ex_unlock_file (cob_file *f, cob_field *fnstatus) -{ - cob_file_unlock (f); - RETURN_STATUS (COB_STATUS_00_SUCCESS); -} - -void -cob_unlock_file (cob_file *f, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_UNLOCK, (char*)f, NULL, NULL, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_unlock_file (f, fnstatus); -} - -void -cob_ex_open (cob_file *f, const int mode, const int sharing, cob_field *fnstatus) -{ - char *p; - char *src; - char *dst; - size_t i; - size_t simple; - int was_not_exist = 0; - struct stat st; - - f->flag_read_done = 0; - - /* file was previously closed with lock */ - if (f->open_mode == COB_OPEN_LOCKED) { - RETURN_STATUS (COB_STATUS_38_CLOSED_WITH_LOCK); - } - - /* file is already open */ - if (f->open_mode != COB_OPEN_CLOSED) { - RETURN_STATUS (COB_STATUS_41_ALREADY_OPEN); - } - - f->last_open_mode = mode; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 2; - - if (f->special) { - if (f->special == 1) { - if (mode != COB_OPEN_INPUT) { - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } - f->file = stdin; - f->open_mode = mode; - RETURN_STATUS (COB_STATUS_00_SUCCESS); - } else { - if (mode != COB_OPEN_OUTPUT) { - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } - f->file = stdout; - f->open_mode = mode; - RETURN_STATUS (COB_STATUS_00_SUCCESS); - } - } - - /* obtain the file name */ - if(f->assign == NULL) { - strncpy (file_open_name, f->select_name, COB_SMALL_MAX); - } else { - cob_field_to_string (f->assign, file_open_name); - } - -#ifdef WITH_INDEX_EXTFH - if (f->organization == COB_ORG_INDEXED) { - int ret; - - ret = extfh_indexed_locate (f, file_open_name); - switch (ret) { - case COB_NOT_CONFIGURED: - /* EXTFH requires OC to process the filename */ - break; - case COB_STATUS_00_SUCCESS: - /* EXTFH recognized the file */ - goto file_available; - default: - /* EXTFH detected an error */ - RETURN_STATUS (ret); - } - } -#endif /* WITH_INDEX_EXTFH */ - -#ifdef WITH_SEQRA_EXTFH - if (f->organization != COB_ORG_INDEXED) { - int ret; - - ret = extfh_seqra_locate (f, file_open_name); - switch (ret) { - case COB_NOT_CONFIGURED: - /* EXTFH requires OC to process the filename */ - break; - case COB_STATUS_00_SUCCESS: - /* EXTFH recognized the file */ - goto file_available; - default: - /* EXTFH detected an error */ - RETURN_STATUS (ret); - } - } -#endif /* WITH_SEQRA_EXTFH */ - - if (cob_current_module->flag_filename_mapping) { - src = file_open_name; - dst = file_open_buff; - simple = 1; - /* expand envoronment variables */ - /* ex. "$TMPDIR/foo" -> "/tmp/foo" */ - while (*src) { - if (!isalnum (*src) && *src != '_' && *src != '-') { - simple = 0; - } - if (*src == '$') { - for (i = 1; ; i++) { - if (!isalnum (src[i]) && src[i] != '_' && *src != '-') { - break; - } - } - memcpy (file_open_env, src + 1, i - 1); - file_open_env[i - 1] = 0; - if ((p = getenv (file_open_env)) != NULL) { - strcpy (dst, p); - dst += strlen (p); - } - src += i; - } else { - *dst++ = *src++; - } - } - *dst = 0; - cb_get_jisword_buff (file_open_buff, file_open_name, COB_SMALL_BUFF); - - /* resolve by environment variables */ - /* ex. "TMPFILE" -> DD_TMPFILE, dd_TMPFILE, or TMPFILE */ - if (simple) { - for (i = 0; i < NUM_PREFIX; i++) { - snprintf (file_open_buff, COB_SMALL_MAX, "%s%s", - prefix[i], file_open_name); - if ((p = getenv (file_open_buff)) != NULL) { - strncpy (file_open_name, p, COB_SMALL_MAX); - break; - } - } - if (i == NUM_PREFIX && cob_file_path) { - snprintf (file_open_buff, COB_SMALL_MAX, "%s/%s", - cob_file_path, file_open_name); - strncpy (file_open_name, file_open_buff, - COB_SMALL_MAX); - } - } - } - /* check if the file exists */ -#ifdef USE_DB41 - if (f->organization == COB_ORG_INDEXED) { - if ((bdb_env && bdb_nofile (file_open_name)) || - (!bdb_env && stat (file_open_name, &st) == -1 && errno == ENOENT)) { - was_not_exist = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0 && - (mode != COB_OPEN_I_O || !cob_check_env (COB_IO_CREATES, "yes")) && - (mode != COB_OPEN_EXTEND || !cob_check_env (COB_EXTEND_CREATES, "yes"))) { - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - } - } - } else if (stat (file_open_name, &st) == -1 && errno == ENOENT) { -#else /* USE_DB41 */ - -#if defined(WITH_ANY_ISAM) - if (f->organization == COB_ORG_INDEXED) { - strncpy (file_open_buff, file_open_name, COB_SMALL_MAX); - strcat (file_open_buff, ".idx"); - if (stat (file_open_buff, &st) == -1 && errno == ENOENT) { - was_not_exist = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0 && - (mode != COB_OPEN_I_O || !cob_check_env (COB_IO_CREATES, "yes")) && - (mode != COB_OPEN_EXTEND || !cob_check_env (COB_EXTEND_CREATES, "yes"))) { - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - } - } - strncpy (file_open_buff, file_open_name, COB_SMALL_MAX); - strcat (file_open_buff, ".dat"); - if (stat (file_open_buff, &st) == -1 && errno == ENOENT) { - was_not_exist = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0 && - (mode != COB_OPEN_I_O || !cob_check_env (COB_IO_CREATES, "yes")) && - (mode != COB_OPEN_EXTEND || !cob_check_env (COB_EXTEND_CREATES, "yes"))) { - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - } - } - } else if (stat (file_open_name, &st) == -1 && errno == ENOENT) { -#else /* WITH_ANY_ISAM */ - if (stat (file_open_name, &st) == -1 && errno == ENOENT) { -#endif /* WITH_ANY_ISAM */ - -#endif /* USE_DB41 */ - - was_not_exist = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0 && - (mode != COB_OPEN_I_O || !cob_check_env (COB_IO_CREATES, "yes")) && - (mode != COB_OPEN_EXTEND || !cob_check_env (COB_EXTEND_CREATES, "yes"))) { - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - } - } - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH) -file_available: -#endif /* WITH_INDEX_EXTFH || WITH_SEQRA_EXTFH */ - - cob_cache_file (f); - - /* open the file */ -#ifdef WITH_SEQRA_EXTFH - if (f->organization != COB_ORG_INDEXED) { - int ret; - - ret = extfh_cob_file_open (f, file_open_name, mode, sharing); - switch (ret) { - case COB_STATUS_00_SUCCESS: - f->open_mode = mode; - break; - case COB_STATUS_35_NOT_EXISTS: - if (f->flag_optional) { - f->open_mode = mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - RETURN_STATUS (COB_STATUS_05_SUCCESS_OPTIONAL); - } - break; - } - RETURN_STATUS (ret); - } -#endif -#if defined(WITH_ANY_ISAM) - if (f->organization == COB_ORG_INDEXED) { - /* Do this here to avoid mangling of the status in the 'switch' below */ - RETURN_STATUS (fileio_funcs[(int)f->organization]->open (f, file_open_name, mode, sharing)); - } -#endif - switch (fileio_funcs[(int)f->organization]->open (f, file_open_name, mode, sharing)) { - case 0: - f->open_mode = mode; - if (f->flag_optional && was_not_exist) { - RETURN_STATUS (COB_STATUS_05_SUCCESS_OPTIONAL); - } else { - RETURN_STATUS (COB_STATUS_00_SUCCESS); - } - case ENOENT: - if (mode == COB_OPEN_EXTEND || mode == COB_OPEN_OUTPUT) { - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } - if (f->flag_optional) { - f->open_mode = mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - RETURN_STATUS (COB_STATUS_05_SUCCESS_OPTIONAL); - } else { - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - } - case EACCES: - case EISDIR: - case EROFS: - RETURN_STATUS (COB_STATUS_37_PERMISSION_DENIED); - case EAGAIN: - case COB_STATUS_61_FILE_SHARING: - RETURN_STATUS (COB_STATUS_61_FILE_SHARING); - case COB_STATUS_91_NOT_AVAILABLE: - RETURN_STATUS (COB_STATUS_91_NOT_AVAILABLE); - case COB_LINAGE_INVALID: - RETURN_STATUS (COB_STATUS_57_I_O_LINAGE); - default: - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } -} - -int -cob_invoke_fun (int operate, char *f, cob_field *key, char *rec, - cob_field *fnstatus, char *openMode, char *startCond, char *read_opts) -{ - int iRet = 0; - char *s; - char funname[256]; - char ret = '0'; - char oper[OPENMODESIZE]; - char excpcode[EXCPTCODESIZE]; - char *p_excpcode = excpcode; - char tmpfnstatus[FNSTATUSSIZE]; - char *p_tmpfnstatus = tmpfnstatus; - int status1 = 0; - int (*funcint)(); - - sprintf (excpcode, "%05d", 0); - sprintf (oper, "%02d", operate); - sprintf (tmpfnstatus, "%02d", 0); - s = getenv (TIS_DEFINE_USERFH); - if (s != NULL) { - strcpy (funname, s); - funcint = cob_resolve_1 (funname); - if (funcint) { - if (fnstatus == NULL) { - funcint (oper, f, key, rec, &p_tmpfnstatus, openMode, - startCond, read_opts, &p_excpcode, (char*)&ret); - } else { - funcint (oper, f, key, rec, fnstatus->data, openMode, - startCond, read_opts, &p_excpcode, (char*)&ret); - } - if (ret == '1') { - iRet = 1; - } else if (ret == '0') { - iRet = 0; - } - cob_exception_code = atoi (p_excpcode); - //ascii [0]->0x30 [9]->0x39 - if (fnstatus != NULL) { - status1 = fnstatus->data[0] - 0x30; - } else { - status1 = p_tmpfnstatus[0] - 0x30; - } - if ((status1 > 0 && status1 <= 9) && cob_exception_code == 0) { - cob_set_exception (status_exception[status1]); - } - } - } - return iRet; -} - -void -cob_open (cob_file *f, const int mode, const int sharing, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", mode); - if (cob_invoke_fun (COB_IO_OPEN, (char *)f, NULL, NULL, fnstatus, openMode, NULL, NULL)) { - f->last_open_mode = atoi (openMode); - return; - } - f->last_open_mode = atoi (openMode); - cob_ex_open (f, f->last_open_mode, sharing, fnstatus); -} - -void -cob_ex_close (cob_file *f, const int opt, cob_field *fnstatus) -{ - int ret; - - f->flag_read_done = 0; - - if (f->special) { - f->open_mode = COB_OPEN_CLOSED; - RETURN_STATUS (COB_STATUS_00_SUCCESS); - } - if (f->open_mode == COB_OPEN_CLOSED) { - RETURN_STATUS (COB_STATUS_42_NOT_OPEN); - } - - if (f->flag_nonexistent) { - ret = COB_STATUS_00_SUCCESS; - } else { -#ifdef WITH_SEQRA_EXTFH - if (f->organization != COB_ORG_INDEXED) { - ret = extfh_cob_file_close (f, opt); - } else { -#endif - ret = fileio_funcs[(int)f->organization]->close (f, opt); -#ifdef WITH_SEQRA_EXTFH - } -#endif - } - - if (ret == COB_STATUS_00_SUCCESS) { - switch (opt) { - case COB_CLOSE_LOCK: - f->open_mode = COB_OPEN_LOCKED; - break; - default: - f->open_mode = COB_OPEN_CLOSED; - break; - } - } - - RETURN_STATUS (ret); -} - -void -cob_close (cob_file *f, const int opt, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_CLOSE, (char *)f, NULL, NULL, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_close (f, opt, fnstatus); -} - -#if 0 -void -cob_unlock (cob_file *f) -{ - int ret; - - f->flag_read_done = 0; - - if (f->open_mode == COB_OPEN_CLOSED) { - RETURN_STATUS (COB_STATUS_42_NOT_OPEN); - } - - if (f->flag_nonexistent) { - ret = COB_STATUS_00_SUCCESS; - } else { - ret = fileio_funcs[(int)f->organization]->close (f, opt); - } - - RETURN_STATUS (ret); -} -#endif - -void -cob_ex_start (cob_file *f, const int cond, cob_field *key, cob_field *fnstatus) -{ - int ret; - - f->flag_read_done = 0; - f->flag_first_read = 0; - - if (f->flag_nonexistent) { - RETURN_STATUS (COB_STATUS_23_KEY_NOT_EXISTS); - } - - if (f->open_mode == COB_OPEN_CLOSED - || f->open_mode == COB_OPEN_OUTPUT - || f->open_mode == COB_OPEN_EXTEND - || f->access_mode == COB_ACCESS_RANDOM) { - RETURN_STATUS (COB_STATUS_47_INPUT_DENIED); - } - - ret = fileio_funcs[(int)f->organization]->start (f, cond, key); - if (ret == COB_STATUS_00_SUCCESS) { - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 1; - } - - RETURN_STATUS (ret); -} - -void -cob_start (cob_file *f, const int cond, cob_field *key, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - char startCond[STARTCONDSIZE]; - - memset (openMode, 0, sizeof (openMode)); - memset (startCond, 0, sizeof (startCond)); - sprintf (openMode, "%02d", f->last_open_mode); - sprintf (startCond, "%01d", cond); - if (cob_invoke_fun (COB_IO_START, (char*)f, key, NULL, fnstatus, openMode, startCond, NULL)) { - return; - } - cob_ex_start (f, cond, key, fnstatus); -} - -void -cob_ex_read (cob_file *f, cob_field *key, cob_field *fnstatus, int read_opts) -{ - int ret; - - f->flag_read_done = 0; - - if (unlikely(f->flag_nonexistent)) { - if (f->flag_first_read == 0) { - RETURN_STATUS (COB_STATUS_23_KEY_NOT_EXISTS); - } - f->flag_first_read = 0; - RETURN_STATUS (COB_STATUS_10_END_OF_FILE); - } - - /* sequential read at the end of file is an error */ - if (key == NULL) { - if (f->flag_end_of_file && !(read_opts & COB_READ_PREVIOUS)) { - RETURN_STATUS (COB_STATUS_46_READ_ERROR); - } - if (f->flag_begin_of_file && (read_opts & COB_READ_PREVIOUS)) { - RETURN_STATUS (COB_STATUS_46_READ_ERROR); - } - } - - if (unlikely(f->open_mode == COB_OPEN_CLOSED - || f->open_mode == COB_OPEN_OUTPUT - || f->open_mode == COB_OPEN_EXTEND)) { - RETURN_STATUS (COB_STATUS_47_INPUT_DENIED); - } - -#ifdef USE_DB41 - if (f->organization == COB_ORG_INDEXED && bdb_env != NULL) { - if (f->open_mode != COB_OPEN_I_O || - (f->lock_mode & COB_LOCK_EXCLUSIVE)) { - read_opts &= ~COB_READ_LOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && - !(read_opts & COB_READ_NO_LOCK)) { - read_opts |= COB_READ_LOCK; - } - } else { - read_opts &= ~COB_READ_LOCK; - } -#endif - if (key) { - ret = fileio_funcs[(int)f->organization]->read (f, key, read_opts); - } else { - ret = fileio_funcs[(int)f->organization]->read_next (f, read_opts); - } - - switch (ret) { - case COB_STATUS_00_SUCCESS: - f->flag_first_read = 0; - f->flag_read_done = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - if (f->record_size && f->organization != COB_ORG_LINE_SEQUENTIAL) { - cob_set_int (f->record_size, (int) f->record->size); - } - break; - case COB_STATUS_10_END_OF_FILE: - if (read_opts & COB_READ_PREVIOUS) { - f->flag_begin_of_file = 1; - } else { - f->flag_end_of_file = 1; - } - break; - } - - RETURN_STATUS (ret); -} - -void -cob_read (cob_file *f, cob_field *key, cob_field *fnstatus, int read_opts) -{ - int status; - char sbuff[3]; - char openMode[OPENMODESIZE]; - char readOpts[READOPTSSIZE]; - - memset (openMode, 0, sizeof (openMode)); - memset (readOpts, 0, sizeof (readOpts)); - sprintf (openMode, "%02d", f->last_open_mode); - sprintf (readOpts, "%03d", read_opts); - if (cob_invoke_fun (COB_IO_READ, (char*)f, key, NULL, fnstatus, openMode, NULL, readOpts)) { - memset (sbuff, 0, sizeof (sbuff)); - if (fnstatus == NULL) { - return; - } - memcpy (sbuff, fnstatus->data, 2); - status = atoi (sbuff); - RETURN_STATUS (status); - } - cob_ex_read (f, key, fnstatus, read_opts); -} - -void -cob_ex_write (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - int ret; - int tmpsize; - - f->flag_read_done = 0; - - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (f->open_mode == COB_OPEN_CLOSED - || f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_I_O) { - RETURN_STATUS (COB_STATUS_48_OUTPUT_DENIED); - } - } else { - if (f->open_mode == COB_OPEN_CLOSED - || f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_EXTEND) { - RETURN_STATUS (COB_STATUS_48_OUTPUT_DENIED); - } - } - tmpsize = f->record->size; - if (f->record_size) { - f->record->size = cob_get_int (f->record_size); - } else { - f->record->size = rec->size; - } - - if (f->record->size < f->record_min || f->record_max < f->record->size) { - RETURN_STATUS (COB_STATUS_44_RECORD_OVERFLOW); - } - -/* RXW -#ifdef USE_DB41 - if (f->organization != COB_ORG_INDEXED || bdb_env == NULL) { - opt &= ~COB_WRITE_LOCK; - } -#endif -*/ - - ret = fileio_funcs[(int)f->organization]->write (f, opt); - - if (unlikely(cob_do_sync && ret == 0)) { - cob_sync (f, cob_do_sync); - } - f->record->size = tmpsize; - - RETURN_STATUS (ret); -} - -void -cob_write (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - if (f->access_mode == COB_ACCESS_SEQUENTIAL && - f->open_mode == COB_OPEN_I_O && - cob_io_rewrite_assumed()) { - cob_rewrite (f, rec, opt, fnstatus); - return; - } - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_WRITE, (char*)f, NULL, (char*)rec->data, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_write (f, rec, opt, fnstatus); -} - -void -cob_ex_rewrite (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - int ret; - int read_done = f->flag_read_done; - - f->flag_read_done = 0; - - if (unlikely(f->open_mode == COB_OPEN_CLOSED || - f->open_mode != COB_OPEN_I_O)) { - RETURN_STATUS (COB_STATUS_49_I_O_DENIED); - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) { - RETURN_STATUS (COB_STATUS_43_READ_NOT_DONE); - } - - if (f->organization == COB_ORG_SEQUENTIAL) { - if (f->record->size != rec->size) { - RETURN_STATUS (COB_STATUS_44_RECORD_OVERFLOW); - } - - if (f->record_size) { - if (f->record->size != (size_t)cob_get_int (f->record_size)) { - RETURN_STATUS (COB_STATUS_44_RECORD_OVERFLOW); - } - } - } - -/* RXW -#ifdef USE_DB41 - if (f->organization != COB_ORG_INDEXED || bdb_env == NULL) { - opt &= ~COB_WRITE_LOCK; - } -#endif -*/ - - ret = fileio_funcs[(int)f->organization]->rewrite (f, opt); - - if (unlikely(cob_do_sync && ret == 0)) { - cob_sync (f, cob_do_sync); - } - - RETURN_STATUS (ret); -} - -void -cob_rewrite (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_REWRITE, (char*)f, NULL, (char*)rec->data, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_rewrite (f, rec, opt, fnstatus); -} - -void -cob_ex_delete (cob_file *f, cob_field *fnstatus) -{ - int ret; - int read_done = f->flag_read_done; - - f->flag_read_done = 0; - - if (unlikely(f->open_mode == COB_OPEN_CLOSED || - f->open_mode != COB_OPEN_I_O)) { - RETURN_STATUS (COB_STATUS_49_I_O_DENIED); - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) { - RETURN_STATUS (COB_STATUS_43_READ_NOT_DONE); - } - - ret = fileio_funcs[(int)f->organization]->fdelete (f); - - if (unlikely(cob_do_sync && ret == 0)) { - cob_sync (f, cob_do_sync); - } - - RETURN_STATUS (ret); -} - -void -cob_delete (cob_file *f, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_DELETE, (char*)f, NULL, NULL, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_delete (f, fnstatus); -} - -void -cob_ex_delete_file (cob_file *f, cob_field *fnstatus) -{ - char *p; - char *src; - char *dst; - size_t i; - size_t simple; - int ret; - - f->flag_read_done = 0; - - /* file was previously closed with lock */ - if (f->open_mode == COB_OPEN_LOCKED) { - RETURN_STATUS (COB_STATUS_38_CLOSED_WITH_LOCK); - } - - /* file is already open */ - if (f->open_mode != COB_OPEN_CLOSED) { - RETURN_STATUS (COB_STATUS_41_ALREADY_OPEN); - } - - if (f->special) { - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } - - /* obtain the file name */ - cob_field_to_string (f->assign, file_open_name); - - if (cob_current_module->flag_filename_mapping) { - src = file_open_name; - dst = file_open_buff; - simple = 1; - /* expand envoronment variables */ - /* ex. "$TMPDIR/foo" -> "/tmp/foo" */ - while (*src) { - if (!isalnum (*src) && *src != '_' && *src != '-') { - simple = 0; - } - if (*src == '$') { - for (i = 1; ; i++) { - if (!isalnum (src[i]) && src[i] != '_' && *src != '-') { - break; - } - } - memcpy (file_open_env, src + 1, i - 1); - file_open_env[i - 1] = 0; - if ((p = getenv (file_open_env)) != NULL) { - strcpy (dst, p); - dst += strlen (p); - } - src += i; - } else { - *dst++ = *src++; - } - } - *dst = 0; - cb_get_jisword_buff (file_open_buff, file_open_name, COB_SMALL_BUFF); - - /* resolve by environment variables */ - /* ex. "TMPFILE" -> DD_TMPFILE, dd_TMPFILE, or TMPFILE */ - if (simple) { - for (i = 0; i < NUM_PREFIX; i++) { - snprintf (file_open_buff, COB_SMALL_MAX, "%s%s", - prefix[i], file_open_name); - if ((p = getenv (file_open_buff)) != NULL) { - strncpy (file_open_name, p, COB_SMALL_MAX); - break; - } - } - if (i == NUM_PREFIX && cob_file_path) { - snprintf (file_open_buff, COB_SMALL_MAX, "%s/%s", - cob_file_path, file_open_name); - strncpy (file_open_name, file_open_buff, COB_SMALL_MAX); - } - } - } - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) - if (f->organization == COB_ORG_INDEXED) { - strncpy (file_open_buff, file_open_name, COB_SMALL_MAX); - strcat (file_open_buff, ".idx"); - ret = unlink (file_open_buff); - if (ret == 0) { - strncpy (file_open_buff, file_open_name, COB_SMALL_MAX); - strcat (file_open_buff, ".dat"); - ret = unlink (file_open_buff); - } - } else { -#elif defined(WITH_DB) /* WITH_CISAM || WITH_DISAM || WITH_VBISAM */ - if (f->organization == COB_ORG_INDEXED) { - RETURN_STATUS (COB_STATUS_91_NOT_AVAILABLE); - } else { -#else /* WITH_CISAM || WITH_DISAM || WITH_VBISAM */ - { -#endif /* WITH_CISAM || WITH_DISAM || WITH_VBISAM */ - ret = unlink (file_open_name); - } - if (ret == 0) { - RETURN_STATUS (COB_STATUS_00_SUCCESS); - } else { - switch (errno) { - case ENOENT: - RETURN_STATUS (COB_STATUS_35_NOT_EXISTS); - case EACCES: - case EISDIR: - case EROFS: - RETURN_STATUS (COB_STATUS_37_PERMISSION_DENIED); - case EAGAIN: - case COB_STATUS_61_FILE_SHARING: - RETURN_STATUS (COB_STATUS_61_FILE_SHARING); - case COB_STATUS_91_NOT_AVAILABLE: - RETURN_STATUS (COB_STATUS_91_NOT_AVAILABLE); - case COB_LINAGE_INVALID: - RETURN_STATUS (COB_STATUS_57_I_O_LINAGE); - default: - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - } - } -} - -void -cob_delete_file (cob_file *f, cob_field *fnstatus) -{ - char openMode[OPENMODESIZE]; - - memset (openMode, 0, sizeof (openMode)); - sprintf (openMode, "%02d", f->last_open_mode); - if (cob_invoke_fun (COB_IO_DELETE_FILE, (char*)f, NULL, NULL, fnstatus, openMode, NULL, NULL)) { - return; - } - cob_ex_delete_file (f, fnstatus); -} - -void -cob_ex_commit (void) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - cob_file_unlock (l->file); - } -} - -void -cob_commit (void) -{ - if (cob_invoke_fun (COB_IO_COMMIT, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) { - return; - } - cob_ex_commit (); -} - -void -cob_ex_rollback (void) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - cob_file_unlock (l->file); - } -} - -void -cob_rollback (void) -{ - if (cob_invoke_fun (COB_IO_ROLLBACK, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) { - return; - } - cob_ex_rollback (); -} - -void -cob_default_error_handle (void) -{ - const char *msg; - unsigned char *file_status; - char *filename; - int status; - - file_status = cob_error_file->file_status; - status = cob_d2i(file_status[0]) * 10 + cob_d2i(file_status[1]); - switch (status) { - case COB_STATUS_10_END_OF_FILE: - msg = "End of file"; - break; - case COB_STATUS_14_OUT_OF_KEY_RANGE: - msg = "Key out of range"; - break; - case COB_STATUS_21_KEY_INVALID: - msg = "Key order not ascending"; - break; - case COB_STATUS_22_KEY_EXISTS: - msg = "Record key already exists"; - break; - case COB_STATUS_23_KEY_NOT_EXISTS: - msg = "Record key does not exist"; - break; - case COB_STATUS_30_PERMANENT_ERROR: - msg = "Permanent file error"; - break; - case COB_STATUS_35_NOT_EXISTS: - msg = "File does not exist"; - break; - case COB_STATUS_37_PERMISSION_DENIED: - msg = "Permission denied"; - break; - case COB_STATUS_41_ALREADY_OPEN: - msg = "File already open"; - break; - case COB_STATUS_42_NOT_OPEN: - msg = "File not open"; - break; - case COB_STATUS_43_READ_NOT_DONE: - msg = "READ must be executed first"; - break; - case COB_STATUS_44_RECORD_OVERFLOW: - msg = "Record overflow"; - break; - case COB_STATUS_46_READ_ERROR: - msg = "Failed to read"; - break; - case COB_STATUS_47_INPUT_DENIED: - msg = "READ/START not allowed"; - break; - case COB_STATUS_48_OUTPUT_DENIED: - msg = "WRITE not allowed"; - break; - case COB_STATUS_49_I_O_DENIED: - msg = "DELETE/REWRITE not allowed"; - break; - case COB_STATUS_51_RECORD_LOCKED: - msg = "Record locked by another file connector"; - break; - case COB_STATUS_52_EOP: - msg = "A page overflow condition occurred"; - break; - case COB_STATUS_57_I_O_LINAGE: - msg = "LINAGE values invalid"; - break; - case COB_STATUS_61_FILE_SHARING: - msg = "File sharing conflict"; - break; - case COB_STATUS_91_NOT_AVAILABLE: - msg = "Runtime library is not configured for this operation"; - break; - default: - msg = "Unknown file error"; - break; - } - - filename = cob_malloc (COB_MEDIUM_BUFF); - cob_field_to_string (cob_error_file->assign, filename); - cob_runtime_error ("%s (STATUS = %02d) File : '%s'", msg, - status, filename); - free (filename); -} - -void -cob_init_fileio (void) -{ - char *s; - int n; - - if ((s = getenv ("COB_SYNC")) != NULL) { - if (*s == 'Y' || *s == 'y') { - cob_do_sync = 1; - } - if (*s == 'P' || *s == 'p') { - cob_do_sync = 2; - } - } - if ((s = getenv ("COB_SORT_MEMORY")) != NULL) { - n = atoi (s); - if (n >= 1024*1024) { - cob_sort_memory = n; - } - } - cob_file_path = getenv ("COB_FILE_PATH"); - if (cob_file_path) { - if (!*cob_file_path || *cob_file_path == ' ') { - cob_file_path = NULL; - } - } - cob_ls_nulls = getenv ("COB_LS_NULLS"); - cob_ls_fixed = getenv ("COB_LS_FIXED"); - - file_open_env = cob_malloc (COB_SMALL_BUFF); - file_open_name = cob_malloc (COB_SMALL_BUFF); - file_open_buff = cob_malloc (COB_SMALL_BUFF); - -#ifdef USE_DB41 - bdb_home = getenv ("DB_HOME"); - join_environment (); - record_lock_object = cob_malloc (1024); - bdb_buff = cob_malloc (COB_SMALL_BUFF); - rlo_size = 1024; -#endif - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH) - extfh_cob_init_fileio (&sequential_funcs, &lineseq_funcs, &relative_funcs, &cob_file_write_opt); -#endif - -} - -void -cob_exit_fileio (void) -{ - struct file_list *l; - char *str_logic_filename = NULL; - char *str_physical_filename = NULL; - - for (l = file_cache; l; l = l->next) { - if (l->file->open_mode != COB_OPEN_CLOSED && - l->file->open_mode != COB_OPEN_LOCKED) { - if(l->file->assign == NULL) { - strncpy (runtime_buffer, l->file->select_name, COB_SMALL_MAX); - } else { - cob_field_to_string (l->file->assign, runtime_buffer); - } - cob_close (l->file, 0, NULL); - str_logic_filename = cb_get_jisword (l->file->select_name); - str_physical_filename = cb_get_jisword (runtime_buffer); - fprintf (stderr, "WARNING - Implicit CLOSE of %s (\"%s\")\n", - str_logic_filename, str_physical_filename); - if (str_logic_filename) { - free (str_logic_filename); - str_logic_filename = NULL; - } - if (str_physical_filename) { - free (str_physical_filename); - str_physical_filename = NULL; - } - fflush (stderr); - } - } -#ifdef USE_DB41 - free (record_lock_object); - if (bdb_env) { - bdb_env->lock_id_free (bdb_env, bdb_lock_id); - bdb_env->close (bdb_env, 0); - } -#endif -#if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH) - extfh_cob_exit_fileio (); -#endif -} - -/* System routines */ - -static void * COB_NOINLINE -cob_str_from_fld (const cob_field *f) -{ - void *mptr; - unsigned char *s; - int i; - int n; - int quote_switch; - - if (!f) { - return cob_malloc (1); - } - for (i = (int) f->size - 1; i >= 0; i--) { - if (f->data[i] != ' ' && f->data[i] != 0) { - break; - } - } - i++; - /* i is 0 or > 0 */ - mptr = cob_malloc ((size_t)(i + 1)); - quote_switch = 0; - s = mptr; - for (n = 0; n < i; n++) { - if (f->data[n] == '"') { - quote_switch = !quote_switch; - continue; - } - s[n] = f->data[n]; - if (quote_switch) { - continue; - } - if (s[n] == ' ' || s[n] == 0) { - s[n] = 0; - break; - } - - } - return mptr; -} - -static int COB_NOINLINE -open_cbl_file (unsigned char *file_name, unsigned char *file_access, - unsigned char *file_handle, const int file_flags) -{ - char *fn; - int flag = O_BINARY; - int fd; - - COB_UNUSED (file_name); - - if (!cob_current_module->cob_procedure_parameters[0]) { - memset (file_handle, -1, 4); - return -1; - } - flag |= file_flags; - switch (*file_access & 0x3f) { - case 1: - flag |= O_RDONLY; - break; - case 2: - flag |= O_CREAT | O_TRUNC | O_WRONLY; - break; - case 3: - flag |= O_RDWR; - break; - default: - memset (file_handle, -1, 4); - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - fd = open (fn, flag, 0660); - if (fd < 0) { - free (fn); - memset (file_handle, -1, 4); - return 35; - } - free (fn); - memcpy (file_handle, &fd, 4); - return 0; -} - -int -CBL_OPEN_FILE (unsigned char *file_name, unsigned char *file_access, - unsigned char *file_lock, unsigned char *file_dev, - unsigned char *file_handle) -{ - COB_UNUSED (file_lock); - COB_UNUSED (file_dev); - - COB_CHK_PARMS (CBL_OPEN_FILE, 5); - - return open_cbl_file (file_name, file_access, file_handle, 0); -} - -int -CBL_CREATE_FILE (unsigned char *file_name, unsigned char *file_access, - unsigned char *file_lock, unsigned char *file_dev, - unsigned char *file_handle) -{ - COB_UNUSED (file_lock); - COB_UNUSED (file_dev); - - COB_CHK_PARMS (CBL_CREATE_FILE, 5); - - return open_cbl_file (file_name, file_access, file_handle, O_CREAT | O_TRUNC); -} - -int -CBL_READ_FILE (unsigned char *file_handle, unsigned char *file_offset, - unsigned char *file_len, unsigned char *flags, unsigned char *buf) -{ - long long off; - int fd; - int len; - int rc; - struct stat st; - - COB_CHK_PARMS (CBL_READ_FILE, 5); - - rc = 0; - memcpy (&fd, file_handle, 4); - memcpy (&off, file_offset, 8); - memcpy (&len, file_len, 4); -#ifndef WORDS_BIGENDIAN - off = COB_BSWAP_64 (off); - len = COB_BSWAP_32 (len); -#endif - if (lseek (fd, (off_t)off, SEEK_SET) < 0) { - return -1; - } - if (len > 0) { - rc = read (fd, buf, (size_t)len); - if (rc < 0) { - rc = -1; - } else if (rc == 0) { - rc = 10; - } else { - rc = 0; - } - } - if ((*flags & 0x80) != 0) { - if (fstat (fd, &st) < 0) { - return -1; - } - off = st.st_size; -#ifndef WORDS_BIGENDIAN - off = COB_BSWAP_64 (off); -#endif - memcpy (file_offset, &off, 8); - } - return rc; -} - -int -CBL_WRITE_FILE (unsigned char *file_handle, unsigned char *file_offset, - unsigned char *file_len, unsigned char *flags, unsigned char *buf) -{ - long long off; - int fd; - int len; - int rc; - - COB_UNUSED (flags); - - COB_CHK_PARMS (CBL_WRITE_FILE, 5); - - memcpy (&fd, file_handle, 4); - memcpy (&off, file_offset, 8); - memcpy (&len, file_len, 4); -#ifndef WORDS_BIGENDIAN - off = COB_BSWAP_64 (off); - len = COB_BSWAP_32 (len); -#endif - if (lseek (fd, (off_t)off, SEEK_SET) < 0) { - return -1; - } - rc = write (fd, buf, (size_t)len); - if (rc < 0) { - return 30; - } - return 0; -} - -int -CBL_CLOSE_FILE (unsigned char *file_handle) -{ - int fd; - - COB_CHK_PARMS (CBL_CLOSE_FILE, 1); - - memcpy (&fd, file_handle, 4); - return close (fd); -} - -int -CBL_FLUSH_FILE (unsigned char *file_handle) -{ - COB_UNUSED (file_handle); - - COB_CHK_PARMS (CBL_FLUSH_FILE, 1); - - return 0; -} - -int -CBL_DELETE_FILE (unsigned char *file_name) -{ - char *fn; - int ret; - - COB_UNUSED (file_name); - - COB_CHK_PARMS (CBL_DELETE_FILE, 1); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - ret = unlink (fn); - free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -CBL_COPY_FILE (unsigned char *fname1, unsigned char *fname2) -{ - char *fn1; - char *fn2; - char buf[COB_SMALL_BUFF]; - int flag = O_BINARY; - int ret; - int i; - int fd1, fd2; - - COB_UNUSED (fname1); - COB_UNUSED (fname2); - - COB_CHK_PARMS (CBL_COPY_FILE, 2); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[1]) { - return -1; - } - fn1 = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - flag |= O_RDONLY; - fd1 = open (fn1, flag, 0); - if (fd1 < 0) { - free (fn1); - return -1; - } - free (fn1); - fn2 = cob_str_from_fld (cob_current_module->cob_procedure_parameters[1]); - flag &= ~O_RDONLY; - flag |= O_CREAT | O_TRUNC | O_WRONLY; - fd2 = open (fn2, flag, 0660); - if (fd2 < 0) { - close (fd1); - free (fn2); - return -1; - } - free (fn2); - ret = 0; - while ((i = read (fd1, buf, sizeof(buf))) > 0) { - if (write (fd2, buf, (size_t)i) < 0) { - ret = -1; - break; - } - } - close (fd1); - close (fd2); - return ret; -} - -int -CBL_CHECK_FILE_EXIST (unsigned char *file_name, unsigned char *file_info) -{ - char *fn; - struct tm *tm; - long long sz; - struct stat st; - short y; - char d, m, hh, mm, ss; - - COB_UNUSED (file_name); - - COB_CHK_PARMS (CBL_CHECK_FILE_EXIST, 2); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - if (stat (fn, &st) < 0) { - free (fn); - return 35; - } - free (fn); - sz = st.st_size; - tm = localtime (&st.st_mtime); - d = (char) tm->tm_mday; - m = (char) tm->tm_mon + 1; - y = tm->tm_year + 1900; - hh = (char) tm->tm_hour; - mm = (char) tm->tm_min; - ss = (char) tm->tm_sec; - -#ifndef WORDS_BIGENDIAN - sz = COB_BSWAP_64 (sz); - y = COB_BSWAP_16 (y); -#endif - memcpy (file_info, &sz, 8); - file_info[8] = d; - file_info[9] = m; - memcpy (file_info+10, &y, 2); - file_info[12] = hh; - file_info[13] = mm; - file_info[14] = ss; - file_info[15] = 0; - return 0; -} - -int -CBL_RENAME_FILE (unsigned char *fname1, unsigned char *fname2) -{ - char *fn1; - char *fn2; - int ret; - - COB_CHK_PARMS (CBL_RENAME_FILE, 2); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[1]) { - return -1; - } - fn1 = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - fn2 = cob_str_from_fld (cob_current_module->cob_procedure_parameters[1]); - ret = rename (fn1, fn2); - free (fn1); - free (fn2); - if (ret) { - return 128; - } - return 0; -} - -int -CBL_GET_CURRENT_DIR (const int flags, const int dir_length, unsigned char *dir) -{ - char *dirname; - int dir_size; - int has_space; - - COB_CHK_PARMS (CBL_GET_CURRENT_DIR, 3); - - if (dir_length < 1) { - return 128; - } - if (flags) { - return 129; - } - memset (dir, ' ', (size_t)dir_length); - dirname = getcwd (NULL, 0); - if (dirname == NULL) { - return 128; - } - dir_size = (int) strlen (dirname); - has_space = 0; - if (strchr (dirname, ' ')) { - has_space = 2; - } - if (dir_size + has_space > dir_length) { - free (dirname); - return 128; - } - if (has_space) { - *dir = '"'; - memcpy (&dir[1], dirname, (size_t)dir_size); - dir[dir_size + 1] = '"'; - } else { - memcpy (dir, dirname, (size_t)dir_size); - } - free (dirname); - return 0; -} - -int -CBL_CREATE_DIR (unsigned char *dir) -{ - char *fn; - int ret; - - COB_CHK_PARMS (CBL_CREATE_DIR, 1); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); -#ifdef _WIN32 - ret = mkdir (fn); -#else - ret = mkdir (fn, 0770); -#endif - free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -CBL_CHANGE_DIR (unsigned char *dir) -{ - char *fn; - int ret; - - COB_CHK_PARMS (CBL_CHANGE_DIR, 1); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - ret = chdir (fn); - free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -CBL_DELETE_DIR (unsigned char *dir) -{ - char *fn; - int ret; - - COB_CHK_PARMS (CBL_DELETE_DIR, 1); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - ret = rmdir (fn); - free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -cob_acuw_mkdir (unsigned char *dir) -{ - int ret; - - COB_CHK_PARMS (C$MAKEDIR, 1); - - ret = CBL_CREATE_DIR (dir); - if (ret < 0) { - ret = 128; - } - return ret; -} - -int -cob_acuw_chdir (unsigned char *dir, unsigned char *status) -{ - int ret; - - COB_CHK_PARMS (C$CHDIR, 2); - - ret = CBL_CHANGE_DIR (dir); - if (ret < 0) { - ret = 128; - } - cob_set_int (cob_current_module->cob_procedure_parameters[1], ret); - return ret; -} - -int -cob_acuw_copyfile (unsigned char *fname1, unsigned char *fname2, unsigned char *file_type) -{ - int ret = 128; - - /* RXW - Type is not yet evaluated */ - - COB_CHK_PARMS (C$COPY, 3); - - if (cob_call_params < 3) { - return 128; - } - ret = CBL_COPY_FILE (fname1, fname2); - if (ret < 0) { - ret = 128; - } - return ret; -} - -int -cob_acuw_file_info (unsigned char *file_name, unsigned char *file_info) -{ - char *fn; - struct tm *tm; - unsigned long long sz; - unsigned int dt; - short y; - short d, m, hh, mm, ss; - struct stat st; - - COB_CHK_PARMS (C$FILEINFO, 2); - - if (cob_call_params < 2 || !cob_current_module->cob_procedure_parameters[0]) { - return 128; - } - fn = cob_str_from_fld (cob_current_module->cob_procedure_parameters[0]); - if (stat (fn, &st) < 0) { - free (fn); - return 35; - } - free (fn); - sz = st.st_size; - tm = localtime (&st.st_mtime); - d = tm->tm_mday; - m = tm->tm_mon + 1; - y = tm->tm_year + 1900; - hh = tm->tm_hour; - mm = tm->tm_min; - ss = tm->tm_sec; - -#ifndef WORDS_BIGENDIAN - sz = COB_BSWAP_64 (sz); -#endif - memcpy (file_info, &sz, 8); - dt = (y * 10000) + (m * 100) + d; -#ifndef WORDS_BIGENDIAN - dt = COB_BSWAP_32 (dt); -#endif - memcpy (file_info + 8, &dt, 4); - dt = (hh * 1000000) + (mm * 10000) + (ss * 100); -#ifndef WORDS_BIGENDIAN - dt = COB_BSWAP_32 (dt); -#endif - memcpy (file_info + 12, &dt, 4); - return 0; -} - -int -cob_acuw_file_delete (unsigned char *file_name, unsigned char *file_type) -{ - int ret; - - /* RXW - Type is not yet evaluated */ - COB_CHK_PARMS (C$DELETE, 2); - - if (cob_call_params < 2 || !cob_current_module->cob_procedure_parameters[0]) { - return 128; - } - ret = CBL_DELETE_FILE (file_name); - if (ret < 0) { - ret = 128; - } - return ret; -} - -static int -cob_listdir_open (cob_field *f_dirname, cob_field *f_pattern) -{ - //FIXME: now not use file pattern(ex. *). -#ifdef _WIN32 - char *dirname = cob_str_from_fld (f_dirname); - char *pattern = cob_str_from_fld (f_pattern); - - LPCTSTR lpFileName = cob_malloc (strlen(dirname) + 1 + strlen (pattern) + 1); - - if (listdir_filedata == NULL) { - listdir_filedata = cob_malloc (sizeof (LPWIN32_FIND_DATA)); - } - - strcpy (lpFileName, dirname); - strcat (lpFileName, "\\"); - strcat (lpFileName, pattern); - listdir_handle = FindFirstFile (lpFileName, listdir_filedata); - free (dirname); - free (pattern); - free (lpFileName); - if (listdir_handle == INVALID_HANDLE_VALUE) { - return 0; - } - -#else - char *dirname = cob_str_from_fld (f_dirname); - listdir_handle = opendir (dirname); - free (dirname); - if (listdir_handle == NULL) { - return 0; - } - -#endif - //FIXME: now not use handle. - return 0; -} - -static int -cob_listdir_next (cob_field *f_handle, cob_field *f_filename) -{ - //FIXME: now not use handle. - char *filename; - int length; - -#ifdef _WIN32 - filename = listdir_filedata->cFileName; -#else - listdir_filedata = readdir (listdir_handle); - if (listdir_filedata == NULL) { - filename = NULL; - }else{ - filename = listdir_filedata->d_name; - } -#endif - memset (f_filename->data, ' ', f_filename->size); - - if(filename != NULL){ - length = strlen (filename); - if (length > f_filename->size) { - length = f_filename->size; - } - memcpy (f_filename->data, filename, length); - } -#ifdef _WIN32 - if (!FindNextFile (listdir_handle, listdir_filedata)) { - strcpy (listdir_filedata->cFileName, " "); - } -#endif - return 0; -} - -static int -cob_listdir_close (cob_field *f_handle) -{ - //FIXME: now not use handle. -#ifdef _WIN32 - FindClose (listdir_handle); -#else - closedir (listdir_handle); -#endif - return 0; -} - -int -cob_acuw_list_directory (unsigned char *data, ...) -{ - int operation_code = -1; - int return_code; - - COB_CHK_PARMS (C$LIST-DIRECTORY, 1); - - if (cob_current_module->cob_procedure_parameters[0] == NULL) { - return -1; - } - - operation_code = cob_get_int (cob_current_module->cob_procedure_parameters[0]); - - switch (operation_code) - { - case 1://LISTDIR-OPEN(value:1) - return_code = cob_listdir_open (cob_current_module->cob_procedure_parameters[1], - cob_current_module->cob_procedure_parameters[2]); - break; - case 2://LISTDIR-NEXT(value:2) - return_code = cob_listdir_next (cob_current_module->cob_procedure_parameters[1], - cob_current_module->cob_procedure_parameters[2]); - break; - case 3://LISTDIR-CLOSE(value:3) - return_code = cob_listdir_close (cob_current_module->cob_procedure_parameters[1]); - break; - default: - //error - return -1; - } - return return_code; -} - -/* SORT */ - -static int -sort_cmps (const unsigned char *s1, const unsigned char *s2, const size_t size, - const unsigned char *col) -{ - size_t i; - int ret; - - if (unlikely(col)) { - for (i = 0; i < size; i++) { - if ((ret = col[s1[i]] - col[s2[i]]) != 0) { - return ret; - } - } - } else { - for (i = 0; i < size; i++) { - if ((ret = s1[i] - s2[i]) != 0) { - return ret; - } - } - } - return 0; -} - -static COB_INLINE void -unique_copy (unsigned char *s1, unsigned char *s2) -{ - size_t size = sizeof(size_t); - - do { - *s1++ = *s2++; - } while (--size); -} - -static int -cob_file_sort_compare (struct cobitem *k1, struct cobitem *k2, void *pointer) -{ - cob_file *f; - size_t i; - int cmp; - size_t u1; - size_t u2; - cob_field f1; - cob_field f2; - - f = pointer; - for (i = 0; i < f->nkeys; i++) { - f1 = f2 = *(f->keys[i].field); - f1.data = k1->item + f->keys[i].offset; - f2.data = k2->item + f->keys[i].offset; - if (COB_FIELD_IS_NUMERIC(&f1)) { - cmp = cob_numeric_cmp (&f1, &f2); - } else { - cmp = sort_cmps (f1.data, f2.data, f1.size, f->sort_collating); - } - if (cmp != 0) { - return (f->keys[i].flag == COB_ASCENDING) ? cmp : -cmp; - } - } - unique_copy ((unsigned char *)&u1, k1->unique); - unique_copy ((unsigned char *)&u2, k2->unique); - if (u1 < u2) { - return -1; - } - return 1; -} - -static void -cob_free_list (struct cobitem *q) -{ - struct cobitem *next; - - while (q != NULL) { - next = q->next; - free (q); - q = next; - } -} - -static struct cobitem * -cob_new_item (struct cobsort *hp, size_t size) -{ - struct cobitem *q; - - if (hp->empty != NULL) { - q = hp->empty; - hp->empty = q->next; - } else { - q = cob_malloc (size); - } - return q; -} - -static FILE * COB_NOINLINE -cob_tmpfile (void) -{ - FILE *fp; - const char *s; - int fd; - char *filename; -#ifdef _WIN32 - char *tmpdir; -#endif - - filename = cob_malloc (COB_MEDIUM_BUFF); - -#ifdef _WIN32 - /* get temporary directory */ - tmpdir = cob_malloc (COB_MEDIUM_BUFF); - if ((s = getenv ("TMPDIR")) != NULL || - (s = getenv ("TMP")) != NULL || - (s = getenv ("TEMP")) != NULL) { - strncpy (tmpdir, s, COB_MEDIUM_MAX); - } else { - GetTempPath (COB_MEDIUM_BUFF, tmpdir); - } - /* get temporary file name */ - GetTempFileName (tmpdir, "cob", 0, filename); - DeleteFile (filename); - free (tmpdir); - fd = _open (filename, _O_CREAT | _O_TRUNC | _O_RDWR | _O_BINARY, 0660); -#else - if ((s = getenv ("TMPDIR")) == NULL && - (s = getenv ("TMP")) == NULL && - (s = getenv ("TEMP")) == NULL) { - s = "/tmp"; - } - if (cob_process_id == 0) { - cob_process_id = getpid (); - } - snprintf (filename, COB_MEDIUM_MAX, "%s/cobsort%d_%d", - s, cob_process_id, cob_iteration); - cob_iteration++; - fd = open (filename, O_CREAT | O_TRUNC | O_RDWR | O_BINARY | O_LARGEFILE, 0660); -#endif - if (fd < 0) { - free (filename); - return NULL; - } -#ifdef _WIN32 - _unlink (filename); - fp = _fdopen (fd, "w+b"); - if (!fp) { - _close (fd); - } -#else - unlink (filename); - fp = fdopen (fd, "w+b"); - if (!fp) { - close (fd); - } -#endif - free (filename); - return fp; -} - -static int COB_NOINLINE -cob_get_temp_file (struct cobsort *hp, const int n) -{ - if (hp->file[n].fp == NULL) { - hp->file[n].fp = cob_tmpfile (); - if (hp->file[n].fp == NULL) { - cob_runtime_error ("SORT is unable to acquire temporary file"); - cob_stop_run (1); - } - } else { - rewind (hp->file[n].fp); - } - hp->file[n].count = 0; - return hp->file[n].fp == NULL; -} - -static int -cob_sort_queues (struct cobsort *hp) -{ - struct cobitem *q; - int source = 0; - int destination; - int move; - int n; - int end_of_block[2]; - - while (hp->queue[source + 1].count != 0) { - destination = source ^ 2; - hp->queue[destination].count = hp->queue[destination + 1].count = 0; - hp->queue[destination].first = hp->queue[destination + 1].first = NULL; - for (;;) { - end_of_block[0] = hp->queue[source].count == 0; - end_of_block[1] = hp->queue[source + 1].count == 0; - if (end_of_block[0] && end_of_block[1]) { - break; - } - while (!end_of_block[0] || !end_of_block[1]) { - if (end_of_block[0]) { - move = 1; - } else if (end_of_block[1]) { - move = 0; - } else { - n = cob_file_sort_compare - (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = n < 0 ? 0 : 1; - } - q = hp->queue[source + move].first; - if (q->end_of_block) { - end_of_block[move] = 1; - } - hp->queue[source + move].first = q->next; - if (hp->queue[destination].first == NULL) { - hp->queue[destination].first = q; - } else { - hp->queue[destination].last->next = q; - } - hp->queue[destination].last = q; - hp->queue[source + move].count--; - hp->queue[destination].count++; - q->next = NULL; - q->end_of_block = 0; - } - hp->queue[destination].last->end_of_block = 1; - destination ^= 1; - } - source = destination & 2; - } - return source; -} - -static int -cob_read_item (struct cobsort *hp, const int n) -{ - FILE *fp = hp->file[n].fp; - - if (getc (fp) != 0) { - hp->queue[n].first->end_of_block = 1; - } else { - hp->queue[n].first->end_of_block = 0; - if (unlikely(fread (hp->queue[n].first->unique, hp->r_size, 1, fp) != 1)) { - return 1; - } - } - return 0; -} - -static int -cob_write_block (struct cobsort *hp, const int n) -{ - struct cobitem *q; - FILE *fp = hp->file[hp->destination_file].fp; - - for (;;) { - q = hp->queue[n].first; - if (q == NULL) { - break; - } - if (unlikely(fwrite (&(q->block_byte), hp->w_size, 1, fp) != 1)) { - return 1; - } - hp->queue[n].first = q->next; - q->next = hp->empty; - hp->empty = q; - } - hp->queue[n].count = 0; - hp->file[hp->destination_file].count++; - if (putc (1, fp) != 1) { - return 1; - } - return 0; -} - -static void -cob_copy_check (cob_file *to, cob_file *from) -{ - unsigned char *toptr; - unsigned char *fromptr; - size_t tosize; - size_t fromsize; - - toptr = to->record->data; - fromptr = from->record->data; - tosize = to->record->size; - fromsize = from->record->size; - if (unlikely(tosize > fromsize)) { - memcpy (toptr, fromptr, fromsize); - memset (toptr + fromsize, ' ', tosize - fromsize); - } else { - memcpy (toptr, fromptr, tosize); - } -} - -static int -cob_file_sort_process (struct cobsort *hp) -{ - int i; - int source; - int destination; - int n; - int move; - int res; - - hp->retrieving = 1; - n = cob_sort_queues (hp); -/* RXW - Cannot be true - if (unlikely(n < 0)) { - return COBSORTABORT; - } -*/ - if (likely(!hp->files_used)) { - hp->retrieval_queue = n; - return 0; - } - if (unlikely(cob_write_block (hp, n))) { - return COBSORTFILEERR; - } - for (i = 0; i < 4; i++) { - hp->queue[i].first = hp->empty; - hp->empty = hp->empty->next; - hp->queue[i].first->next = NULL; - } - rewind (hp->file[0].fp); - rewind (hp->file[1].fp); - if (unlikely(cob_get_temp_file (hp, 2))) { - return COBSORTFILEERR; - } - if (unlikely(cob_get_temp_file (hp, 3))) { - return COBSORTFILEERR; - } - source = 0; - while (hp->file[source].count > 1) { - destination = source ^ 2; - hp->file[destination].count = 0; - hp->file[destination + 1].count = 0; - while (hp->file[source].count > 0) { - if (unlikely(cob_read_item (hp, source))) { - return COBSORTFILEERR; - } - if (hp->file[source + 1].count > 0) { - if (unlikely(cob_read_item (hp, source + 1))) { - return COBSORTFILEERR; - } - } else { - hp->queue[source + 1].first->end_of_block = 1; - } - while (!hp->queue[source].first->end_of_block - || !hp->queue[source + 1].first->end_of_block) { - if (hp->queue[source].first->end_of_block) { - move = 1; - } else if (hp->queue[source + 1].first->end_of_block) { - move = 0; - } else { - res = cob_file_sort_compare - (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = res < 0 ? 0 : 1; - } - if (unlikely(fwrite ( - &(hp->queue[source + move].first->block_byte), - hp->w_size, 1, - hp->file[destination].fp) != 1)) { - return COBSORTFILEERR; - } - if (unlikely(cob_read_item (hp, source + move))) { - return COBSORTFILEERR; - } - } - hp->file[destination].count++; - if (unlikely(putc (1, hp->file[destination].fp) != 1)) { - return COBSORTFILEERR; - } - hp->file[source].count--; - hp->file[source + 1].count--; - destination ^= 1; - } - source = destination & 2; - rewind (hp->file[0].fp); - rewind (hp->file[1].fp); - rewind (hp->file[2].fp); - rewind (hp->file[3].fp); - } - hp->retrieval_queue = source; - if (unlikely(cob_read_item (hp, source))) { - return COBSORTFILEERR; - } - if (unlikely(cob_read_item (hp, source + 1))) { - return COBSORTFILEERR; - } - return 0; -} - -static int -cob_file_sort_submit (cob_file *f, const unsigned char *p) -{ - struct cobsort *hp; -/* RXW - See comment lines below - size_t i; -*/ - struct cobitem *q; - struct memory_struct *z; - int n; - - hp = f->file; - if (unlikely(!hp)) { - return COBSORTNOTOPEN; - } - if (unlikely(hp->retrieving)) { - return COBSORTABORT; -/* RXW - This was a facility to submit new items after retrieval had begun - for (i = 0; i < 4; i++) { - if (hp->queue[i].first != NULL) { - hp->queue[i].last->next = hp->empty; - hp->empty = hp->queue[i].first; - hp->queue[i].first = NULL; - } - } - hp->queue[0].count = hp->queue[1].count = 0; - hp->destination_file = -1; - hp->retrieving = 0; - hp->files_used = 0; -*/ - } - if (hp->queue[0].count + hp->queue[1].count >= hp->memory) { - if (!hp->files_used) { - if (unlikely(cob_get_temp_file (hp, 0))) { - return COBSORTFILEERR; - } - if (unlikely(cob_get_temp_file (hp, 1))) { - return COBSORTFILEERR; - } - hp->files_used = 1; - hp->destination_file = 0; - } - n = cob_sort_queues (hp); -/* RXW - Cannot be true - if (unlikely(n < 0)) { - return COBSORTABORT; - } -*/ - if (unlikely(cob_write_block (hp, n))) { - return COBSORTFILEERR; - } - hp->destination_file ^= 1; - } - q = cob_new_item (hp, sizeof (struct cobitem) + hp->size); - if (f->record_size) { - q->record_size = cob_get_int (f->record_size); - } else { - q->record_size = hp->size; - } - q->end_of_block = 1; - unique_copy (q->unique, (unsigned char *)&(hp->unique)); - hp->unique++; - memcpy (q->item, p, hp->size); - if (hp->queue[0].count <= hp->queue[1].count) { - z = &hp->queue[0]; - } else { - z = &hp->queue[1]; - } - q->next = z->first; - z->first = q; - z->count++; - return 0; -} - -static int -cob_file_sort_retrieve (cob_file *f, unsigned char *p) -{ - struct cobsort *hp; - struct cobitem *next; - struct memory_struct *z; - int move; - int source; - int res; - - hp = f->file; - if (unlikely(!hp)) { - return COBSORTNOTOPEN; - } - if (unlikely(!hp->retrieving)) { - res = cob_file_sort_process (hp); - if (res) { - return res; - } - } - if (unlikely(hp->files_used)) { - source = hp->retrieval_queue; - if (hp->queue[source].first->end_of_block) { - if (hp->queue[source + 1].first->end_of_block) { - return COBSORTEND; - } - move = 1; - } else if (hp->queue[source + 1].first->end_of_block) { - move = 0; - } else { - res = cob_file_sort_compare (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = res < 0 ? 0 : 1; - } - memcpy (p, hp->queue[source + move].first->item, hp->size); - if (unlikely(cob_read_item (hp, source + move))) { - return COBSORTFILEERR; - } - } else { - z = &hp->queue[hp->retrieval_queue]; - if (z->first == NULL) { - return COBSORTEND; - } - memcpy (p, z->first->item, hp->size); - if (f->record_size) { - cob_set_int (f->record_size, z->first->record_size); - } - next = z->first->next; - z->first->next = hp->empty; - hp->empty = z->first; - z->first = next; - } - return 0; -} - -void -cob_file_sort_using (cob_file *sort_file, cob_file *data_file) -{ - int ret; - - cob_open (data_file, COB_OPEN_INPUT, 0, NULL); - for (;;) { - cob_read (data_file, NULL, NULL, COB_READ_NEXT); - if (data_file->file_status[0] != '0') { - break; - } - cob_copy_check (sort_file, data_file); - ret = cob_file_sort_submit (sort_file, sort_file->record->data); - if (ret) { - break; - } - } - cob_close (data_file, COB_CLOSE_NORMAL, NULL); -} - -void -cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) -{ - cob_file **fbase; - struct cobsort *hp; - size_t i; - int ret; - int opt; - va_list args; - size_t cnt_rec = 0; - - fbase = cob_malloc (varcnt * sizeof(cob_file *)); - va_start (args, varcnt); - for (i = 0; i < varcnt; i++) { - fbase[i] = va_arg (args, cob_file *); - } - va_end (args); - for (i = 0; i < varcnt; i++) { - cob_open (fbase[i], COB_OPEN_OUTPUT, 0, NULL); - } - for (;;) { - ret = cob_file_sort_retrieve (sort_file, sort_file->record->data); - if (ret) { - if (ret == COBSORTEND) { - sort_file->file_status[0] = '1'; - sort_file->file_status[1] = '0'; - } else { - hp = sort_file->file; - *(int *)(hp->sort_return) = 16; - sort_file->file_status[0] = '3'; - sort_file->file_status[1] = '0'; - } - break; - } - for (i = 0; i < varcnt; i++) { - if (fbase[i]->special || - fbase[i]->organization == COB_ORG_LINE_SEQUENTIAL) { - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - } else { - opt = 0; - } - cob_copy_check (fbase[i], sort_file); - cob_write (fbase[i], fbase[i]->record, opt, NULL); - } - cnt_rec++; - } - for (i = 0; i < varcnt; i++) { - cob_close (fbase[i], COB_CLOSE_NORMAL, NULL); - } - free (fbase); - cob_verbose_output ("END OF SORT/MERGE, RECORD= %d.", cnt_rec); -} - -void -cob_file_sort_init (cob_file *f, const int nkeys, - const unsigned char *collating_sequence, - void *sort_return, cob_field *fnstatus) -{ - struct cobsort *p; - - p = cob_malloc (sizeof (struct cobsort)); - p->fnstatus = fnstatus; - p->size = f->record_max; - p->r_size = f->record_max + sizeof(size_t); - p->w_size = f->record_max + sizeof(size_t) + 1; - p->pointer = f; - p->sort_return = sort_return; - *(int *)sort_return = 0; - p->memory = (size_t)cob_sort_memory / (p->size + sizeof(struct cobitem)); - f->file = p; - f->keys = cob_malloc (sizeof (struct cob_file_key) * nkeys); - f->nkeys = 0; - if (collating_sequence) { - f->sort_collating = collating_sequence; - } else { - f->sort_collating = cob_current_module->collating_sequence; - } - RETURN_STATUS (COB_STATUS_00_SUCCESS); -} - -void -cob_file_sort_init_key (cob_file *f, const int flag, cob_field *field, - size_t offset) -{ - f->keys[f->nkeys].flag = flag; - f->keys[f->nkeys].field = field; - f->keys[f->nkeys].offset = offset; - f->nkeys++; -} - -void -cob_file_sort_close (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - size_t i; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - cob_free_list (hp->empty); - for (i = 0; i < 4; i++) { - cob_free_list (hp->queue[i].first); - if (hp->file[i].fp != NULL) { - fclose (hp->file[i].fp); - } - } - free (hp); - } - f->file = NULL; - RETURN_STATUS (COB_STATUS_00_SUCCESS); -} - -void -cob_file_release (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - int ret; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - } - ret = cob_file_sort_submit (f, f->record->data); - switch (ret) { - case 0: - RETURN_STATUS (COB_STATUS_00_SUCCESS); - break; - default: - if (likely(hp)) { - *(int *)(hp->sort_return) = 16; - } - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - break; - } -} - -void -cob_file_return (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - int ret; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - } - ret = cob_file_sort_retrieve (f, f->record->data); - switch (ret) { - case 0: - RETURN_STATUS (COB_STATUS_00_SUCCESS); - break; - case COBSORTEND: - RETURN_STATUS (COB_STATUS_10_END_OF_FILE); - break; - default: - if (likely(hp)) { - *(int *)(hp->sort_return) = 16; - } - RETURN_STATUS (COB_STATUS_30_PERMANENT_ERROR); - break; - } -} - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) - -/* -** Using the offset:length of the (component parts) of the ix_cob_key key, -** extract the key-value from the given data record. -*/ - -static int extract_key ( - struct indexfile *fh - , int ix_cob_key /* ordinal of key to use */ - , const void *pb_rec /* pointer to data-record */ - , void *ret_key_value) /* the composited key-value */ -{ - int ix; - struct keydesc *kd_cob = fh->key + ix_cob_key; - const char *p_rec = pb_rec; - char *p_val = ret_key_value; - for (ix = 0; ix < kd_cob->k_nparts; ++ix) { - memcpy (p_val - , p_rec + kd_cob->k_part[ix].kp_start - , kd_cob->k_part[ix].kp_leng); - p_val += kd_cob->k_part[ix].kp_leng; - } - return(0); -} - -/* -** Using the offset:length of the (component parts) of the ix_cob_key key, -** extract the key-value from the given data record and compare it -** to the given key-value. -** Returns: -1 ... extracted key is less than given key. -** 0 ... extracted key is equal to given key. -** +0 ... extracted key is greater than given key. -** -** DEVELOPER TODO: -** Determine max possible size of a key and use local variable instead of malloc() free() -*/ - -static int keycmp ( - struct indexfile *fh - , int ix_cob_key /* ordinal of key to use */ - , const void *pb_rec /* pointer to data-record */ - , const void *pb_key) /* the composited key-value to be compared */ -{ - char *pb_key2; - int cmp; - pb_key2 = malloc (fh->key[ix_cob_key].k_len); - extract_key (fh, ix_cob_key, pb_rec, pb_key2); - cmp = memcmp (pb_key2, pb_key, fh->key[fh->curkey].k_len); - free (pb_key2); - return (cmp); -} - -#endif diff --git a/libcob/intrinsic.c b/libcob/intrinsic.c deleted file mode 100644 index 17b3116d..00000000 --- a/libcob/intrinsic.c +++ /dev/null @@ -1,3348 +0,0 @@ -/* - * Copyright (C) 2005-2009 Roger While - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 2.1, - * or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; see the file COPYING.LIB. If - * not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor - * Boston, MA 02110-1301 USA - */ - -#include "config.h" - -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_SYS_TIME_H -#include -#endif -#include - -/* Note we include the Cygwin version of windows.h here */ -#if defined(_WIN32) || defined(__CYGWIN__) -#undef HAVE_LANGINFO_CODESET -#define WIN32_LEAN_AND_MEAN -#include -#ifdef _WIN32 -#include -#endif -#endif - -#ifdef HAVE_LANGINFO_CODESET -#include -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -/* Force symbol exports */ -#define COB_LIB_EXPIMP - -#include "libcob.h" -#include "coblocal.h" - -/* Stacked field level */ -#define DEPTH_LEVEL 8 - -#define COB_FIELD_INIT(x,y,z) do { \ - field.size = x; \ - field.data = y; \ - field.attr = z; \ - } while (0) - -static char *locale_buff; - -/* Working fields */ -static cob_decimal d1, d2, d3, d4, d5; - -/* Stack definitions for created fields */ -static int curr_entry = 0; -static cob_field *curr_field = NULL; -static cob_field_attr *curr_attr = NULL; -static cob_field calc_field[DEPTH_LEVEL]; -static cob_field_attr calc_attr[DEPTH_LEVEL]; -static size_t calc_size[DEPTH_LEVEL]; - - -/* Constants for date/day calculations */ -static const int normal_days[] = {0,31,59,90,120,151,181,212,243,273,304,334,365}; -static const int leap_days[] = {0,31,60,91,121,152,182,213,244,274,305,335,366}; -static const int normal_month_days[] = {0,31,28,31,30,31,30,31,31,30,31,30,31}; -static const int leap_month_days[] = {0,31,29,31,30,31,30,31,31,30,31,30,31}; - -/* Locale name to Locale ID table */ -#if defined(_WIN32) || defined(__CYGWIN__) - -struct winlocale { - const char *winlocalename; - const int winlocaleid; -}; - -static const struct winlocale wintable[] = -{ - { "af_ZA", 0x0436 }, - { "am_ET", 0x045e }, - { "ar_AE", 0x3801 }, - { "ar_BH", 0x3c01 }, - { "ar_DZ", 0x1401 }, - { "ar_EG", 0x0c01 }, - { "ar_IQ", 0x0801 }, - { "ar_JO", 0x2c01 }, - { "ar_KW", 0x3401 }, - { "ar_LB", 0x3001 }, - { "ar_LY", 0x1001 }, - { "ar_MA", 0x1801 }, - { "ar_OM", 0x2001 }, - { "ar_QA", 0x4001 }, - { "ar_SA", 0x0401 }, - { "ar_SY", 0x2801 }, - { "ar_TN", 0x1c01 }, - { "ar_YE", 0x2401 }, - { "arn_CL", 0x047a }, - { "as_IN", 0x044d }, - { "az_Cyrl_AZ", 0x082c }, - { "az_Latn_AZ", 0x042c }, - { "ba_RU", 0x046d }, - { "be_BY", 0x0423 }, - { "bg_BG", 0x0402 }, - { "bn_IN", 0x0445 }, - { "bo_BT", 0x0851 }, - { "bo_CN", 0x0451 }, - { "br_FR", 0x047e }, - { "bs_Cyrl_BA", 0x201a }, - { "bs_Latn_BA", 0x141a }, - { "ca_ES", 0x0403 }, - { "cs_CZ", 0x0405 }, - { "cy_GB", 0x0452 }, - { "da_DK", 0x0406 }, - { "de_AT", 0x0c07 }, - { "de_CH", 0x0807 }, - { "de_DE", 0x0407 }, - { "de_LI", 0x1407 }, - { "de_LU", 0x1007 }, - { "dsb_DE", 0x082e }, - { "dv_MV", 0x0465 }, - { "el_GR", 0x0408 }, - { "en_029", 0x2409 }, - { "en_AU", 0x0c09 }, - { "en_BZ", 0x2809 }, - { "en_CA", 0x1009 }, - { "en_GB", 0x0809 }, - { "en_IE", 0x1809 }, - { "en_IN", 0x4009 }, - { "en_JM", 0x2009 }, - { "en_MY", 0x4409 }, - { "en_NZ", 0x1409 }, - { "en_PH", 0x3409 }, - { "en_SG", 0x4809 }, - { "en_TT", 0x2c09 }, - { "en_US", 0x0409 }, - { "en_ZA", 0x1c09 }, - { "en_ZW", 0x3009 }, - { "es_AR", 0x2c0a }, - { "es_BO", 0x400a }, - { "es_CL", 0x340a }, - { "es_CO", 0x240a }, - { "es_CR", 0x140a }, - { "es_DO", 0x1c0a }, - { "es_EC", 0x300a }, - { "es_ES", 0x0c0a }, - { "es_GT", 0x100a }, - { "es_HN", 0x480a }, - { "es_MX", 0x080a }, - { "es_NI", 0x4c0a }, - { "es_PA", 0x180a }, - { "es_PE", 0x280a }, - { "es_PR", 0x500a }, - { "es_PY", 0x3c0a }, - { "es_SV", 0x440a }, - { "es_US", 0x540a }, - { "es_UY", 0x380a }, - { "es_VE", 0x200a }, - { "et_EE", 0x0425 }, - { "eu_ES", 0x042d }, - { "fa_IR", 0x0429 }, - { "fi_FI", 0x040b }, - { "fil_PH", 0x0464 }, - { "fo_FO", 0x0438 }, - { "fr_BE", 0x080c }, - { "fr_CA", 0x0c0c }, - { "fr_CH", 0x100c }, - { "fr_FR", 0x040c }, - { "fr_LU", 0x140c }, - { "fr_MC", 0x180c }, - { "fy_NL", 0x0462 }, - { "ga_IE", 0x083c }, - { "gbz_AF", 0x048c }, - { "gl_ES", 0x0456 }, - { "gsw_FR", 0x0484 }, - { "gu_IN", 0x0447 }, - { "ha_Latn_NG", 0x0468 }, - { "he_IL", 0x040d }, - { "hi_IN", 0x0439 }, - { "hr_BA", 0x101a }, - { "hr_HR", 0x041a }, - { "hu_HU", 0x040e }, - { "hy_AM", 0x042b }, - { "id_ID", 0x0421 }, - { "ig_NG", 0x0470 }, - { "ii_CN", 0x0478 }, - { "is_IS", 0x040f }, - { "it_CH", 0x0810 }, - { "it_IT", 0x0410 }, - { "iu_Cans_CA", 0x045d }, - { "iu_Latn_CA", 0x085d }, - { "ja_JP", 0x0411 }, - { "ka_GE", 0x0437 }, - { "kh_KH", 0x0453 }, - { "kk_KZ", 0x043f }, - { "kl_GL", 0x046f }, - { "kn_IN", 0x044b }, - { "ko_KR", 0x0412 }, - { "kok_IN", 0x0457 }, - { "ky_KG", 0x0440 }, - { "lb_LU", 0x046e }, - { "lo_LA", 0x0454 }, - { "lt_LT", 0x0427 }, - { "lv_LV", 0x0426 }, - { "mi_NZ", 0x0481 }, - { "mk_MK", 0x042f }, - { "ml_IN", 0x044c }, - { "mn_Cyrl_MN", 0x0450 }, - { "mn_Mong_CN", 0x0850 }, - { "moh_CA", 0x047c }, - { "mr_IN", 0x044e }, - { "ms_BN", 0x083e }, - { "ms_MY", 0x043e }, - { "mt_MT", 0x043a }, - { "nb_NO", 0x0414 }, - { "ne_NP", 0x0461 }, - { "nl_BE", 0x0813 }, - { "nl_NL", 0x0413 }, - { "nn_NO", 0x0814 }, - { "ns_ZA", 0x046c }, - { "oc_FR", 0x0482 }, - { "or_IN", 0x0448 }, - { "pa_IN", 0x0446 }, - { "pl_PL", 0x0415 }, - { "ps_AF", 0x0463 }, - { "pt_BR", 0x0416 }, - { "pt_PT", 0x0816 }, - { "qut_GT", 0x0486 }, - { "quz_BO", 0x046b }, - { "quz_EC", 0x086b }, - { "quz_PE", 0x0c6b }, - { "rm_CH", 0x0417 }, - { "ro_RO", 0x0418 }, - { "ru_RU", 0x0419 }, - { "rw_RW", 0x0487 }, - { "sa_IN", 0x044f }, - { "sah_RU", 0x0485 }, - { "se_FI", 0x0c3b }, - { "se_NO", 0x043b }, - { "se_SE", 0x083b }, - { "si_LK", 0x045b }, - { "sk_SK", 0x041b }, - { "sl_SI", 0x0424 }, - { "sma_NO", 0x183b }, - { "sma_SE", 0x1c3b }, - { "smj_NO", 0x103b }, - { "smj_SE", 0x143b }, - { "smn_FI", 0x243b }, - { "sms_FI", 0x203b }, - { "sq_AL", 0x041c }, - { "sr_Cyrl_BA", 0x1c1a }, - { "sr_Cyrl_CS", 0x0c1a }, - { "sr_Latn_BA", 0x181a }, - { "sr_Latn_CS", 0x081a }, - { "sv_FI", 0x081d }, - { "sv_SE", 0x041d }, - { "sw_KE", 0x0441 }, - { "syr_SY", 0x045a }, - { "ta_IN", 0x0449 }, - { "te_IN", 0x044a }, - { "tg_Cyrl_TJ", 0x0428 }, - { "th_TH", 0x041e }, - { "tk_TM", 0x0442 }, - { "tmz_Latn_DZ", 0x085f }, - { "tn_ZA", 0x0432 }, - { "tr_IN", 0x0820 }, - { "tr_TR", 0x041f }, - { "tt_RU", 0x0444 }, - { "ug_CN", 0x0480 }, - { "uk_UA", 0x0422 }, - { "ur_PK", 0x0420 }, - { "uz_Cyrl_UZ", 0x0843 }, - { "uz_Latn_UZ", 0x0443 }, - { "vi_VN", 0x042a }, - { "wen_DE", 0x042e }, - { "wo_SN", 0x0488 }, - { "xh_ZA", 0x0434 }, - { "yo_NG", 0x046a }, - { "zh_CN", 0x0804 }, - { "zh_HK", 0x0c04 }, - { "zh_MO", 0x1404 }, - { "zh_SG", 0x1004 }, - { "zh_TW", 0x0404 }, - { "zu_ZA", 0x0435 } -}; - -#define WINLOCSIZE sizeof(wintable) / sizeof(struct winlocale) - -#endif - - -/* Local functions */ - -static void COB_NOINLINE -make_double_entry (void) -{ - unsigned char *s; - - curr_field = &calc_field[curr_entry]; - curr_attr = &calc_attr[curr_entry]; - if (calc_size[curr_entry] < sizeof (double)) { - calc_size[curr_entry] = sizeof (double) + 1; - if (curr_field->data) { - free (curr_field->data); - } - s = cob_malloc (sizeof (double) + 1); - } else { - s = curr_field->data; - memset (s, 0, sizeof (double)); - } - - curr_attr->type = COB_TYPE_NUMERIC_DOUBLE; - curr_attr->digits = 18; - curr_attr->scale = 9; - curr_attr->flags = COB_FLAG_HAVE_SIGN; - curr_attr->pic = NULL; - - curr_field->size = sizeof (double); - curr_field->data = s; - curr_field->attr = curr_attr; - - if (++curr_entry >= DEPTH_LEVEL) { - curr_entry = 0; - } -} - -static void COB_NOINLINE -make_field_entry (cob_field *f) -{ - unsigned char *s; - - curr_field = &calc_field[curr_entry]; - curr_attr = &calc_attr[curr_entry]; - if (f->size > calc_size[curr_entry]) { - calc_size[curr_entry] = f->size + 1; - if (curr_field->data) { - free (curr_field->data); - } - s = cob_malloc (f->size + 1); - } else { - s = curr_field->data; - memset (s, 0, f->size); - } - - *curr_field = *f; - *curr_attr = *(f->attr); - curr_field->data = s; - curr_field->attr = curr_attr; - - if (++curr_entry >= DEPTH_LEVEL) { - curr_entry = 0; - } -} - -static int -leap_year (const int year) -{ - return ((year % 4 == 0 && year % 100 != 0) || (year % 400 == 0)) ? 1 : 0; -} - -/* Leave in -static void -intr_set_double (cob_decimal *d, double v) -{ - mpz_set_d (d->value, v * 1.0e9); - d->scale = 9; -} -*/ - -static double COB_NOINLINE -intr_get_double (cob_decimal *d) -{ - double v; - int n; - - v = mpz_get_d (d->value); - n = d->scale; - for (; n > 0; --n) v /= 10; - for (; n < 0; ++n) v *= 10; - return v; -} - -static int -comp_field (const void *m1, const void *m2) -{ - cob_field *f1; - cob_field *f2; - - f1 = *(cob_field **) m1; - f2 = *(cob_field **) m2; - return cob_cmp (f1, f2); -} - -static void COB_NOINLINE -calc_ref_mod (cob_field *f, const int offset, const int length) -{ - size_t calcoff; - size_t size; - - if ((size_t)offset <= f->size) { - calcoff = (size_t)offset - 1; - size = f->size - calcoff; - if (length > 0 && (size_t)length < size) { - size = (size_t)length; - } - f->size = size; - if (calcoff > 0) { - memmove (f->data, f->data + calcoff, size); - } - } -} - -/* Global functions */ - -/* Numeric expressions */ - -cob_field * -cob_intr_binop (cob_field *f1, int op, cob_field *f2) -{ - size_t bitnum; - size_t sign; - size_t attrsign; - cob_field_attr attr; - cob_field field; - int size; - - cob_decimal_set_field (&d1, f1); - cob_decimal_set_field (&d2, f2); - switch (op) { - case '+': - cob_decimal_add (&d1, &d2); - break; - case '-': - cob_decimal_sub (&d1, &d2); - break; - case '*': - cob_decimal_mul (&d1, &d2); - break; - case '/': - cob_decimal_div (&d1, &d2); - break; - case '^': - cob_decimal_pow (&d1, &d2); - break; - default: - break; - } - - if (mpz_sgn (d1.value) < 0) { - attrsign = COB_FLAG_HAVE_SIGN; - sign = 1; - } else { - attrsign = 0; - sign = 0; - } - bitnum = mpz_sizeinbase (d1.value, 2); - if (bitnum < (33 - sign) && d1.scale < 10) { - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, d1.scale, attrsign, NULL); - COB_FIELD_INIT (4, NULL, &attr); - } else if (bitnum < (65 - sign) && d1.scale < 19) { - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 20, d1.scale, attrsign, NULL); - COB_FIELD_INIT (8, NULL, &attr); - } else { - size = (int)mpz_sizeinbase (d1.value, 10); - if (d1.scale > size) { - size = d1.scale; - } - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, d1.scale, attrsign, NULL); - COB_FIELD_INIT (size, NULL, &attr); - } - make_field_entry (&field); - cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -/* Intrinsics */ - -cob_field * -cob_intr_length (cob_field *srcfield) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_set_int (curr_field, (int)srcfield->size); - return curr_field; -} - -cob_field * -cob_intr_integer (cob_field *srcfield) -{ - int scale; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cob_decimal_set_field (&d1, srcfield); - if (mpz_sgn (d1.value) >= 0) { - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; - } - while(d1.scale > 1) { - mpz_tdiv_q_ui (d1.value, d1.value, 10); - d1.scale--; - } - scale = d1.scale > 0 ? 10 : 1; - if (mpz_fdiv_ui (d1.value, (unsigned int)scale)) { - mpz_sub_ui (d1.value, d1.value, (unsigned int)scale); - } - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_integer_part (cob_field *srcfield) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cob_move (srcfield, curr_field); - return curr_field; -} - -cob_field * -cob_intr_fraction_part (cob_field *srcfield) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 18, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cob_move (srcfield, curr_field); - return curr_field; -} - -cob_field * -cob_intr_sign (cob_field *srcfield) -{ - int n; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_set_int (curr_field, 0); - n = cob_cmp (srcfield, curr_field); - if (n < 0) { - cob_set_int (curr_field, -1); - } else if (n > 0) { - cob_set_int (curr_field, 1); - } - - return curr_field; -} - -cob_field * -cob_intr_upper_case (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = toupper (srcfield->data[i]); - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_lower_case (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = tolower (srcfield->data[i]); - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_reverse (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = srcfield->data[srcfield->size - i - 1]; - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_concatenate (const int offset, const int length, const int params, ...) -{ - cob_field **f; - unsigned char *p; - size_t calcsize; - int i; - cob_field_attr attr; - cob_field field; - va_list args; - - f = cob_malloc (params * sizeof (cob_field *)); - - va_start (args, params); - - /* Extract args / calculate size */ - calcsize = 0; - for (i = 0; i < params; ++i) { - f[i] = va_arg (args, cob_field *); - calcsize += f[i]->size; - } - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (calcsize, NULL, &attr); - make_field_entry (&field); - - p = curr_field->data; - for (i = 0; i < params; ++i) { - memcpy (p, f[i]->data, f[i]->size); - p += f[i]->size; - } - - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - free (f); - return curr_field; -} - -cob_field * -cob_intr_substitute (const int offset, const int length, const int params, ...) -{ - cob_field *var; - cob_field **f1; - cob_field **f2; - unsigned char *p1; - unsigned char *p2; - size_t varsize; - size_t calcsize; - size_t n; - size_t found; - int numreps; - int i; - cob_field_attr attr; - cob_field field; - va_list args; - - numreps = params / 2; - f1 = cob_malloc (numreps * sizeof (cob_field *)); - f2 = cob_malloc (numreps * sizeof (cob_field *)); - - va_start (args, params); - - var = va_arg (args, cob_field *); - varsize = var->size; - - /* Extract args */ - for (i = 0; i < params - 1; ++i) { - if ((i % 2) == 0) { - f1[i / 2] = va_arg (args, cob_field *); - } else { - f2[i / 2] = va_arg (args, cob_field *); - } - } - - /* Calculate required size */ - calcsize = 0; - found = 0; - p1 = var->data; - for (n = 0; n < varsize; ) { - for (i = 0; i < numreps; ++i) { - if (n + f1[i]->size <= varsize) { - if (!memcmp (p1, f1[i]->data, f1[i]->size)) { - p1 += f1[i]->size; - n += f1[i]->size; - calcsize += f2[i]->size; - found = 1; - break; - } - } - } - if (found) { - found = 0; - continue; - } - ++n; - ++p1; - ++calcsize; - } - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - field.size = calcsize; - make_field_entry (&field); - - found = 0; - p1 = var->data; - p2 = curr_field->data; - for (n = 0; n < varsize; ) { - for (i = 0; i < numreps; ++i) { - if (n + f1[i]->size <= varsize) { - if (!memcmp (p1, f1[i]->data, f1[i]->size)) { - memcpy (p2, f2[i]->data, f2[i]->size); - p1 += f1[i]->size; - p2 += f2[i]->size; - n += f1[i]->size; - found = 1; - break; - } - } - } - if (found) { - found = 0; - continue; - } - ++n; - *p2++ = *p1++; - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - free (f1); - free (f2); - return curr_field; -} - -cob_field * -cob_intr_substitute_case (const int offset, const int length, const int params, ...) -{ - cob_field *var; - cob_field **f1; - cob_field **f2; - unsigned char *p1; - unsigned char *p2; - size_t varsize; - size_t calcsize; - size_t n; - size_t found; - int numreps; - int i; - cob_field_attr attr; - cob_field field; - va_list args; - - numreps = params / 2; - f1 = cob_malloc (numreps * sizeof (cob_field *)); - f2 = cob_malloc (numreps * sizeof (cob_field *)); - - va_start (args, params); - - var = va_arg (args, cob_field *); - varsize = var->size; - - /* Extract args */ - for (i = 0; i < params - 1; ++i) { - if ((i % 2) == 0) { - f1[i / 2] = va_arg (args, cob_field *); - } else { - f2[i / 2] = va_arg (args, cob_field *); - } - } - - /* Calculate required size */ - calcsize = 0; - found = 0; - p1 = var->data; - for (n = 0; n < varsize; ) { - for (i = 0; i < numreps; ++i) { - if (n + f1[i]->size <= varsize) { - if (!strncasecmp ((const char *)p1, - (const char *)(f1[i]->data), - f1[i]->size)) { - p1 += f1[i]->size; - n += f1[i]->size; - calcsize += f2[i]->size; - found = 1; - break; - } - } - } - if (found) { - found = 0; - continue; - } - ++n; - ++p1; - ++calcsize; - } - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - field.size = calcsize; - make_field_entry (&field); - - found = 0; - p1 = var->data; - p2 = curr_field->data; - for (n = 0; n < varsize; ) { - for (i = 0; i < numreps; ++i) { - if (n + f1[i]->size <= varsize) { - if (!strncasecmp ((const char *)p1, - (const char *)(f1[i]->data), - f1[i]->size)) { - memcpy (p2, f2[i]->data, f2[i]->size); - p1 += f1[i]->size; - p2 += f2[i]->size; - n += f1[i]->size; - found = 1; - break; - } - } - } - if (found) { - found = 0; - continue; - } - ++n; - *p2++ = *p1++; - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - free (f1); - free (f2); - return curr_field; -} - -cob_field * -cob_intr_trim (const int offset, const int length, - cob_field *srcfield, const int direction) -{ - unsigned char *begin; - unsigned char *end; - size_t i; - size_t size = 0; - - make_field_entry (srcfield); - - for (i = 0; i < srcfield->size; ++i) { - if (srcfield->data[i] != ' ') { - break; - } - } - if (i == srcfield->size) { - curr_field->size = 1; - curr_field->data[0] = ' '; - return curr_field; - } - begin = srcfield->data; - if (direction != 2) { - for (; *begin == ' '; ++begin) ; - } - end = srcfield->data + srcfield->size - 1; - if (direction != 1) { - for (; *end == ' '; end--) ; - } - for (i = 0; begin <= end; ++begin, ++i) { - curr_field->data[i] = *begin; - ++size; - } - curr_field->size = size; - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_exception_file (void) -{ - size_t flen; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - if (cob_exception_code == 0 || !cob_error_file || - (cob_exception_code & 0x0500) != 0x0500) { - field.size = 2; - make_field_entry (&field); - memcpy (curr_field->data, "00", 2); - } else { - flen = strlen (cob_error_file->select_name); - field.size = flen + 2; - make_field_entry (&field); - memcpy (curr_field->data, cob_error_file->file_status, 2); - memcpy (&(curr_field->data[2]), cob_error_file->select_name, flen); - } - return curr_field; -} - -cob_field * -cob_intr_exception_location (void) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - if (!cob_got_exception || !cob_orig_program_id) { - field.size = 1; - make_field_entry (&field); - *(curr_field->data) = ' '; - return curr_field; - } - memset (locale_buff, 0, COB_SMALL_BUFF); - if (cob_orig_section && cob_orig_paragraph) { - snprintf (locale_buff, COB_SMALL_MAX, "%s; %s OF %s; %d", - cob_orig_program_id, cob_orig_paragraph, - cob_orig_section, cob_orig_line); - } else if (cob_orig_section) { - snprintf (locale_buff, COB_SMALL_MAX, "%s; %s; %d", - cob_orig_program_id, cob_orig_section, cob_orig_line); - } else if (cob_orig_paragraph) { - snprintf (locale_buff, COB_SMALL_MAX, "%s; %s; %d", - cob_orig_program_id, cob_orig_paragraph, cob_orig_line); - } else { - snprintf (locale_buff, COB_SMALL_MAX, "%s; ; %d", - cob_orig_program_id, cob_orig_line); - } - field.size = strlen (locale_buff); - make_field_entry (&field); - memcpy (curr_field->data, locale_buff, field.size); - return curr_field; -} - -cob_field * -cob_intr_exception_status (void) -{ - const char *except_name; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (31, NULL, &attr); - make_field_entry (&field); - - memset (curr_field->data, ' ', 31); - if (cob_exception_code) { - except_name = cob_get_exception_name (cob_exception_code); - if (except_name == NULL) { - except_name = "EXCEPTION-OBJECT"; - } - memcpy (curr_field->data, except_name, strlen (except_name)); - } - return curr_field; -} - -cob_field * -cob_intr_exception_statement (void) -{ - size_t flen; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (31, NULL, &attr); - make_field_entry (&field); - - memset (curr_field->data, ' ', 31); - if (cob_exception_code && cob_orig_statement) { - flen = strlen (cob_orig_statement); - if (flen > 31) { - memcpy (curr_field->data, cob_orig_statement, 31); - } else { - memcpy (curr_field->data, cob_orig_statement, flen); - } - } - return curr_field; -} - -cob_field * -cob_intr_when_compiled (const int offset, const int length, cob_field *f) -{ - make_field_entry (f); - - memcpy (curr_field->data, f->data, f->size); - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_current_date (const int offset, const int length) -{ -#if defined(_WIN32) && !defined(__CYGWIN__) - long contz; - struct tm *tmptr; - struct _timeb tmb; - cob_field_attr attr; - cob_field field; -#else -#if !defined(__linux__) && !defined(__CYGWIN__) && !defined(COB_STRFTIME) && defined(HAVE_TIMEZONE) - struct tm *tmptr; - long contz; -#endif - time_t curtime; - cob_field_attr attr; - cob_field field; -#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) - struct timeval tmv; - char buff2[8]; -#endif -#endif /* _WIN32 */ - char buff[24]; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (21, NULL, &attr); - make_field_entry (&field); - memset (buff, 0, sizeof(buff)); - -#if defined(_WIN32) && !defined(__CYGWIN__) - _ftime (&tmb); - tmptr = cob_localtime (&(tmb.time)); - if (tmb.timezone <= 0) { - contz = -tmb.timezone; - snprintf (buff, 23, - "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d+%2.2ld%2.2ld", - tmptr->tm_year + 1900, tmptr->tm_mon + 1, tmptr->tm_mday, - tmptr->tm_hour, tmptr->tm_min, tmptr->tm_sec, - tmb.millitm / 100, contz / 60, contz % 60); - } else { - contz = tmb.timezone; - snprintf (buff, 23, - "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d-%2.2ld%2.2ld", - tmptr->tm_year + 1900, tmptr->tm_mon + 1, tmptr->tm_mday, - tmptr->tm_hour, tmptr->tm_min, tmptr->tm_sec, - tmb.millitm / 100, contz / 60, contz % 60); - } -#else -#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) - gettimeofday (&tmv, NULL); - curtime = tmv.tv_sec; -#else - curtime = time (NULL); -#endif - -#if defined(__linux__) || defined(__CYGWIN__) || defined(COB_STRFTIME) - strftime (buff, 22, "%Y%m%d%H%M%S00%z", cob_localtime (&curtime)); -#elif defined(HAVE_TIMEZONE) - tmptr = cob_localtime (&curtime); - strftime (buff, 17, "%Y%m%d%H%M%S00", tmptr); - /* RXW - Hack for DST - Need something better */ - if (tmptr->tm_isdst > 0) { - timezone -= 3600; - } - if (timezone <= 0) { - contz = -timezone; - buff[16] = '+'; - } else { - contz = timezone; - buff[16] = '-'; - } - sprintf(&buff[17], "%2.2ld%2.2ld", contz / 3600, (contz % 3600) / 60); -#else - strftime (buff, 22, "%Y%m%d%H%M%S0000000", cob_localtime (&curtime)); -#endif - -#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY) - snprintf(buff2, 7, "%2.2ld", tmv.tv_usec / 10000); - memcpy (&buff[14], buff2, 2); -#endif -#endif /* _WIN32 */ - - memcpy (curr_field->data, buff, 21); - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_char (cob_field *srcfield) -{ - int i; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (1, NULL, &attr); - make_field_entry (&field); - - i = cob_get_int (srcfield); - if (i < 1 || i > 256) { - *curr_field->data = 0; - } else { - *curr_field->data = i - 1; - } - return curr_field; -} - -cob_field * -cob_intr_ord (cob_field *srcfield) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_set_int (curr_field, (int)(*srcfield->data + 1)); - return curr_field; -} - -cob_field * -cob_intr_stored_char_length (cob_field *srcfield) -{ - unsigned char *p; - int count; - cob_field_attr attr; - cob_field field; -#ifdef I18N_UTF8 - unsigned char *ub; - int sp; -#endif /*I18N_UTF8*/ - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - -#ifdef I18N_UTF8 - count = 0; - sp = 0; - p = srcfield->data; - ub = srcfield->data + srcfield->size; - while (p < ub) { - if (*p == ' ' - || (ub - p >= COB_ZENCSIZ - && !memcmp(COB_ZENSPC, p, COB_ZENCSIZ))) { - sp++; - } else { - if (sp) { - count += sp; - sp = 0; - } - count++; - } - - p += ((*p >>7) == 0x00)? 1: - ((*p >>5) == 0x06)? 2: - ((*p >>4) == 0x0e)? 3: - ((*p >>3) == 0x1e)? 4: - ((*p >>2) == 0x3e)? 5: - ((*p >>1) == 0x7e)? 6: 1; - } -#else /*!I18N_UTF8*/ - count = srcfield->size; - p = srcfield->data + srcfield->size - 1; - for (; count > 0; count--, p--) { - if (*p != ' ') { - break; - } - } -#endif /*I18N_UTF8*/ - cob_set_int (curr_field, count); - return curr_field; -} - -cob_field * -cob_intr_combined_datetime (cob_field *srcdays, cob_field *srctime) -{ - int srdays; - int srtime; - cob_field_attr attr; - cob_field field; - char buff[16]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 12, 5, 0, NULL); - COB_FIELD_INIT (12, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - srdays = cob_get_int (srcdays); - if (srdays < 1 || srdays > 3067671) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, '0', 12); - return curr_field; - } - srtime = cob_get_int (srctime); - if (srtime < 1 || srtime > 86400) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, '0', 12); - return curr_field; - } - snprintf (buff, 15, "%7.7d%5.5d", srdays, srtime); - memcpy (curr_field->data, buff, 12); - return curr_field; -} - -cob_field * -cob_intr_date_of_integer (cob_field *srcdays) -{ - int i; - int days; - int baseyear = 1601; - int leapyear = 365; - cob_field_attr attr; - cob_field field; - char buff[16]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - /* Base 1601-01-01 */ - days = cob_get_int (srcdays); - if (days < 1 || days > 3067671) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, '0', 8); - return curr_field; - } - while (days > leapyear) { - days -= leapyear; - ++baseyear; - if (leap_year (baseyear)) { - leapyear = 366; - } else { - leapyear = 365; - } - } - for (i = 0; i < 13; ++i) { - if (leap_year (baseyear)) { - if (days <= leap_days[i]) { - days -= leap_days[i-1]; - break; - } - } else { - if (days <= normal_days[i]) { - days -= normal_days[i-1]; - break; - } - } - } - snprintf (buff, 15, "%4.4d%2.2d%2.2d", baseyear, i, days); - memcpy (curr_field->data, buff, 8); - return curr_field; -} - -cob_field * -cob_intr_day_of_integer (cob_field *srcdays) -{ - int days; - int baseyear = 1601; - int leapyear = 365; - cob_field_attr attr; - cob_field field; - char buff[16]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 7, 0, 0, NULL); - COB_FIELD_INIT (7, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - /* Base 1601-01-01 */ - days = cob_get_int (srcdays); - if (days < 1 || days > 3067671) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, '0', 7); - return curr_field; - } - while (days > leapyear) { - days -= leapyear; - ++baseyear; - if (leap_year (baseyear)) { - leapyear = 366; - } else { - leapyear = 365; - } - } - snprintf (buff, 15, "%4.4d%3.3d", baseyear, days); - memcpy (curr_field->data, buff, 7); - return curr_field; -} - -cob_field * -cob_intr_integer_of_date (cob_field *srcfield) -{ - int indate; - int days; - int totaldays; - int month; - int year; - int baseyear = 1601; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 10000; - if (year < 1601 || year > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - indate %= 10000; - month = indate / 100; - if (month < 1 || month > 12) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - days = indate % 100; - if (days < 1 || days > 31) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (leap_year (year)) { - if (days > leap_month_days[month]) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - } else { - if (days > normal_month_days[month]) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - } - totaldays = 0; - while (baseyear != year) { - if (leap_year (baseyear)) { - totaldays += 366; - } else { - totaldays += 365; - } - ++baseyear; - } - if (leap_year (baseyear)) { - totaldays += leap_days[month - 1]; - } else { - totaldays += normal_days[month - 1]; - } - totaldays += days; - cob_set_int (curr_field, totaldays); - return curr_field; -} - -cob_field * -cob_intr_integer_of_day (cob_field *srcfield) -{ - int indate; - int days; - int totaldays; - int year; - int baseyear = 1601; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 1000; - if (year < 1601 || year > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - days = indate % 1000; - if (days < 1 || days > 365 + leap_year (year)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - totaldays = 0; - while (baseyear != year) { - if (leap_year (baseyear)) { - totaldays += 366; - } else { - totaldays += 365; - } - ++baseyear; - } - totaldays += days; - cob_set_int (curr_field, totaldays); - return curr_field; -} - -cob_field * -cob_intr_test_date_yyyymmdd (cob_field *srcfield) -{ - int indate; - int days; - int month; - int year; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 10000; - if (year < 1601 || year > 9999) { - cob_set_int (curr_field, 1); - return curr_field; - } - indate %= 10000; - month = indate / 100; - if (month < 1 || month > 12) { - cob_set_int (curr_field, 2); - return curr_field; - } - days = indate % 100; - if (days < 1 || days > 31) { - cob_set_int (curr_field, 3); - return curr_field; - } - if (leap_year (year)) { - if (days > leap_month_days[month]) { - cob_set_int (curr_field, 3); - return curr_field; - } - } else { - if (days > normal_month_days[month]) { - cob_set_int (curr_field, 3); - return curr_field; - } - } - cob_set_int (curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_test_day_yyyyddd (cob_field *srcfield) -{ - int indate; - int days; - int year; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 1000; - if (year < 1601 || year > 9999) { - cob_set_int (curr_field, 1); - return curr_field; - } - days = indate % 1000; - if (days < 1 || days > 365 + leap_year (year)) { - cob_set_int (curr_field, 2); - return curr_field; - } - cob_set_int (curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_factorial (cob_field *srcfield) -{ - int srcval; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, 0, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - srcval = cob_get_int (srcfield); - if (srcval < 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - d1.scale = 0; - mpz_fac_ui (d1.value, (unsigned int)srcval); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_exp (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = pow (2.7182818284590452354, intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_exp10 (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = pow (10.0, intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_abs (cob_field *srcfield) -{ - - make_field_entry (srcfield); - - cob_decimal_set_field (&d1, srcfield); - mpz_abs (d1.value, d1.value); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_acos (cob_field *srcfield) -{ - unsigned long long result; - double mathd2; - int i, tempres; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, 0, NULL); - COB_FIELD_INIT (8, NULL, &attr); - cob_decimal_set_field (&d1, srcfield); - make_field_entry (&field); - - errno = 0; - mathd2 = acos (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - - result = (unsigned long long) mathd2; - mathd2 -= result; - for (i = 0; i < 17; ++i) { - mathd2 *= 10; - tempres = (int) mathd2; - result *= 10; - result += tempres; - mathd2 -= tempres; - } - memcpy (curr_field->data, (char *)&result, 8); - return curr_field; -} - -cob_field * -cob_intr_asin (cob_field *srcfield) -{ - long long result; - double mathd2; - int i, tempres; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - cob_decimal_set_field (&d1, srcfield); - make_field_entry (&field); - - errno = 0; - mathd2 = asin (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - result = (long long) mathd2; - mathd2 -= result; - for (i = 0; i < 17; ++i) { - mathd2 *= 10; - tempres = (int) mathd2; - result *= 10; - result += tempres; - mathd2 -= tempres; - } - memcpy (curr_field->data, (char *)&result, 8); - return curr_field; -} - -cob_field * -cob_intr_atan (cob_field *srcfield) -{ - long long result; - double mathd2; - int i, tempres; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - cob_decimal_set_field (&d1, srcfield); - make_field_entry (&field); - - errno = 0; - mathd2 = atan (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - result = (long long) mathd2; - mathd2 -= result; - for (i = 0; i < 17; ++i) { - mathd2 *= 10; - tempres = (int) mathd2; - result *= 10; - result += tempres; - mathd2 -= tempres; - } - memcpy (curr_field->data, (char *)&result, 8); - return curr_field; -} - -cob_field * -cob_intr_cos (cob_field *srcfield) -{ - long long result; - double mathd2; - int i, tempres; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - cob_decimal_set_field (&d1, srcfield); - make_field_entry (&field); - - errno = 0; - mathd2 = cos (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - result = (long long) mathd2; - mathd2 -= result; - for (i = 0; i < 17; ++i) { - mathd2 *= 10; - tempres = (int) mathd2; - result *= 10; - result += tempres; - mathd2 -= tempres; - } - memcpy (curr_field->data, (char *)&result, 8); - return curr_field; -} - -cob_field * -cob_intr_log (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = log (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_log10 (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = log10 (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_sin (cob_field *srcfield) -{ - long long result; - double mathd2; - int i, tempres; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 17, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - cob_decimal_set_field (&d1, srcfield); - make_field_entry (&field); - - errno = 0; - mathd2 = sin (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - result = (long long) mathd2; - mathd2 -= result; - for (i = 0; i < 17; ++i) { - mathd2 *= 10; - tempres = (int) mathd2; - result *= 10; - result += tempres; - mathd2 -= tempres; - } - memcpy (curr_field->data, (char *)&result, 8); - return curr_field; -} - -cob_field * -cob_intr_sqrt (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = sqrt (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_tan (cob_field *srcfield) -{ - double mathd2; - - cob_decimal_set_field (&d1, srcfield); - make_double_entry (); - - errno = 0; - mathd2 = tan (intr_get_double (&d1)); - if (errno) { - cob_set_int (curr_field, 0); - return curr_field; - } - memcpy (curr_field->data, (char *)&mathd2, 8); - return curr_field; -} - -cob_field * -cob_intr_numval (cob_field *srcfield) -{ - long long llval = 0; - double val; - size_t i; - int integer_digits = 0; - int decimal_digits = 0; - int sign = 0; - int decimal_seen = 0; - cob_field_attr attr; - cob_field field; - unsigned char integer_buff[64]; - unsigned char decimal_buff[64]; - unsigned char final_buff[64]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - memset (integer_buff, 0, sizeof (integer_buff)); - memset (decimal_buff, 0, sizeof (decimal_buff)); - memset (final_buff, 0, sizeof (final_buff)); - - for (i = 0; i < srcfield->size; ++i) { - if (i < (srcfield->size - 1)) { - if (strcasecmp ((char *)&srcfield->data[i], "CR") == 0 - || strcasecmp ((char *)&srcfield->data[i], "DB") == 0) { - sign = 1; - break; - } - } - if (srcfield->data[i] == ' ') { - continue; - } - if (srcfield->data[i] == '+') { - continue; - } - if (srcfield->data[i] == '-') { - sign = 1; - continue; - } - if (srcfield->data[i] == cob_current_module->decimal_point) { - decimal_seen = 1; - continue; - } - if (srcfield->data[i] >= '0' && srcfield->data[i] <= '9') { - llval *= 10; - llval += srcfield->data[i] - '0'; - if (decimal_seen) { - decimal_buff[decimal_digits++] = srcfield->data[i]; - } else { - integer_buff[integer_digits++] = srcfield->data[i]; - } - } - if ((integer_digits + decimal_digits) > 30) { - break; - } - } - if (!integer_digits) { - integer_buff[0] = '0'; - } - if (!decimal_digits) { - decimal_buff[0] = '0'; - } - if (sign) { - llval = -llval; - } - if ((integer_digits + decimal_digits) <= 18) { - attr.scale = decimal_digits; - make_field_entry (&field); - memcpy (curr_field->data, (char *)&llval, 8); - } else { - snprintf ((char *)final_buff, 63, "%s%s.%s", sign ? "-" : "", - integer_buff, decimal_buff); - sscanf ((char *)final_buff, "%lf", &val); - make_double_entry (); - memcpy (curr_field->data, (char *)&val, sizeof (double)); - } - return curr_field; -} - -cob_field * -cob_intr_numval_c (cob_field *srcfield, cob_field *currency) -{ - unsigned char *currency_data; - long long llval = 0; - double val; - size_t i; - int integer_digits = 0; - int decimal_digits = 0; - int sign = 0; - int decimal_seen = 0; - cob_field_attr attr; - cob_field field; - unsigned char integer_buff[64]; - unsigned char decimal_buff[64]; - unsigned char final_buff[64]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - memset (integer_buff, 0, sizeof (integer_buff)); - memset (decimal_buff, 0, sizeof (decimal_buff)); - memset (final_buff, 0, sizeof (final_buff)); - - currency_data = NULL; - if (currency) { - if (currency->size < srcfield->size) { - currency_data = currency->data; - } - } - for (i = 0; i < srcfield->size; ++i) { - if (i < (srcfield->size - 1)) { - if (strcasecmp ((char *)&srcfield->data[i], "CR") == 0 - || strcasecmp ((char *)&srcfield->data[i], "DB") == 0) { - sign = 1; - break; - } - } - if (currency_data) { - if (i < (srcfield->size - currency->size)) { - if (memcmp ((char *)&srcfield->data[i], currency_data, - currency->size) == 0) { - i += (currency->size - 1); - continue; - } - } - } - if (srcfield->data[i] == ' ') { - continue; - } - if (srcfield->data[i] == '+') { - continue; - } - if (srcfield->data[i] == '-') { - sign = 1; - continue; - } - if (srcfield->data[i] == cob_current_module->decimal_point) { - decimal_seen = 1; - continue; - } - if (srcfield->data[i] == cob_current_module->currency_symbol) { - continue; - } - if (srcfield->data[i] >= '0' && srcfield->data[i] <= '9') { - llval *= 10; - llval += srcfield->data[i] - '0'; - if (decimal_seen) { - decimal_buff[decimal_digits++] = srcfield->data[i]; - } else { - integer_buff[integer_digits++] = srcfield->data[i]; - } - } - if ((integer_digits + decimal_digits) > 30) { - break; - } - } - if (!integer_digits) { - integer_buff[0] = '0'; - } - if (!decimal_digits) { - decimal_buff[0] = '0'; - } - if (sign) { - llval = -llval; - } - if ((integer_digits + decimal_digits) <= 18) { - attr.scale = decimal_digits; - make_field_entry (&field); - memcpy (curr_field->data, (char *)&llval, 8); - } else { - snprintf ((char *)final_buff, 63, "%s%s.%s", sign ? "-" : "", - integer_buff, decimal_buff); - sscanf ((char *)final_buff, "%lf", &val); - make_double_entry (); - memcpy (curr_field->data, (char *)&val, sizeof (double)); - } - return curr_field; -} - -cob_field * -cob_intr_annuity (cob_field *srcfield1, cob_field *srcfield2) -{ - double mathd1, mathd2; - - make_double_entry (); - - cob_decimal_set_field (&d1, srcfield1); - cob_decimal_set_field (&d2, srcfield2); - - mathd1 = intr_get_double (&d1); - mathd2 = intr_get_double (&d2); - if (mathd1 == 0) { - mathd1 = 1.0 / mathd2; - memcpy (curr_field->data, (char *)&mathd1, sizeof (double)); - return curr_field; - } - mathd1 /= (1.0 - pow (mathd1 + 1.0, 0.0 - mathd2)); - memcpy (curr_field->data, (char *)&mathd1, sizeof (double)); - return curr_field; -} - -cob_field * -cob_intr_sum (const int params, ...) -{ - cob_field *f; - size_t size; - va_list args; - int i; - int scale = 0; - cob_field_attr attr; - cob_field field; - - - mpz_set_ui (d1.value, 0); - d1.scale = 0; - - va_start (args, params); - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - if (COB_FIELD_SCALE(f) > scale) { - scale = COB_FIELD_SCALE(f); - } - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - - size = mpz_sizeinbase (d1.value, 10); - if (size < 19) { - /* Store as binary */ - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, scale, - COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - } else { - /* Too big - Store as decimal display */ - if (d1.scale > size) { - size = d1.scale; - } - if (scale > size) { - size = scale; - } - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, scale, - COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (size, NULL, &attr); - } - make_field_entry (&field); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_ord_min (const int params, ...) -{ - cob_field *f, *basef; - int i; - int ordmin = 0; - va_list args; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - if (params <= 1) { - cob_set_int (curr_field, 0); - return curr_field; - } - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) < 0) { - basef = f; - ordmin = i; - } - } - va_end (args); - - cob_set_int (curr_field, ordmin + 1); - return curr_field; -} - -cob_field * -cob_intr_ord_max (const int params, ...) -{ - cob_field *f, *basef; - int ordmin = 0; - int i; - va_list args; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - if (params <= 1) { - cob_set_int (curr_field, 0); - return curr_field; - } - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) > 0) { - basef = f; - ordmin = i; - } - } - va_end (args); - - cob_set_int (curr_field, ordmin + 1); - return curr_field; -} - -cob_field * -cob_intr_min (const int params, ...) -{ - cob_field *f, *basef; - va_list args; - int i; - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) < 0) { - basef = f; - } - } - va_end (args); - - return basef; -} - -cob_field * -cob_intr_max (const int params, ...) -{ - cob_field *f, *basef; - va_list args; - int i; - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) > 0) { - basef = f; - } - } - va_end (args); - - return basef; -} - -cob_field * -cob_intr_midrange (const int params, ...) -{ - cob_field *f, *basemin, *basemax; - va_list args; - int i; - - make_double_entry (); - va_start (args, params); - - basemin = va_arg (args, cob_field *); - basemax = basemin; - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basemin) < 0) { - basemin = f; - } - if (cob_cmp (f, basemax) > 0) { - basemax = f; - } - } - va_end (args); - - cob_decimal_set_field (&d1, basemin); - cob_decimal_set_field (&d2, basemax); - cob_decimal_add (&d1, &d2); - mpz_set_ui (d2.value, 2); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_median (const int params, ...) -{ - cob_field *f; - cob_field **field_alloc; - va_list args; - int i; - - va_start (args, params); - - f = va_arg (args, cob_field *); - if (params == 1) { - va_end (args); - return f; - } - - field_alloc = cob_malloc (params * sizeof (cob_field *)); - field_alloc[0] = f; - - for (i = 1; i < params; ++i) { - field_alloc[i] = va_arg (args, cob_field *); - } - va_end (args); - - qsort (field_alloc, (size_t)params, (size_t)sizeof (cob_field *), comp_field); - - i = params / 2; - if (params % 2) { - f = field_alloc[i]; - } else { - make_double_entry (); - cob_decimal_set_field (&d1, field_alloc[i-1]); - cob_decimal_set_field (&d2, field_alloc[i]); - cob_decimal_add (&d1, &d2); - mpz_set_ui (d2.value, 2); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - cob_decimal_get_field (&d1, curr_field, 0); - f = curr_field; - } - - free (field_alloc); - return f; -} - -cob_field * -cob_intr_mean (const int params, ...) -{ - cob_field *f; - va_list args; - long long n; - union { - unsigned char data[8]; - long long datall; - } datun; - int i; - cob_field_attr attr; - cob_field field; - - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - mpz_set_ui (d1.value, 0); - d1.scale = 0; - - va_start (args, params); - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - - mpz_set_ui (d2.value, (unsigned int)params); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - field.data = datun.data; - cob_decimal_get_field (&d1, &field, 0); - n = datun.datall; - for (i = 0; n; n /= 10, ++i) ; - field.data = NULL; - if (i <= 18) { - attr.scale = 18 - i; - } - make_field_entry (&field); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_mod (cob_field *srcfield1, cob_field *srcfield2) -{ - cob_field *f1; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - f1 = cob_intr_integer (cob_intr_binop (srcfield1, '/', srcfield2)); - cob_decimal_set_field (&d1, srcfield2); - cob_decimal_set_field (&d2, f1); - cob_decimal_mul (&d2, &d1); - cob_decimal_set_field (&d1, srcfield1); - cob_decimal_sub (&d1, &d2); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_range (const int params, ...) -{ - cob_field *f, *basemin, *basemax; - va_list args; - int i; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - va_start (args, params); - - basemin = va_arg (args, cob_field *); - basemax = basemin; - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basemin) < 0) { - basemin = f; - } - if (cob_cmp (f, basemax) > 0) { - basemax = f; - } - } - va_end (args); - - attr.scale = COB_FIELD_SCALE(basemin); - if (COB_FIELD_SCALE(basemax) > attr.scale) { - attr.scale = COB_FIELD_SCALE(basemax); - } - make_field_entry (&field); - cob_decimal_set_field (&d1, basemax); - cob_decimal_set_field (&d2, basemin); - cob_decimal_sub (&d1, &d2); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_rem (cob_field *srcfield1, cob_field *srcfield2) -{ - cob_field *f1; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - f1 = cob_intr_integer_part (cob_intr_binop (srcfield1, '/', srcfield2)); - cob_decimal_set_field (&d1, srcfield2); - cob_decimal_set_field (&d2, f1); - cob_decimal_mul (&d2, &d1); - cob_decimal_set_field (&d1, srcfield1); - cob_decimal_sub (&d1, &d2); - - attr.scale = COB_FIELD_SCALE(srcfield1); - if (COB_FIELD_SCALE(srcfield2) > attr.scale) { - attr.scale = COB_FIELD_SCALE(srcfield2); - } - make_field_entry (&field); - cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_random (const int params, ...) -{ - cob_field *f; - va_list args; - int seed = 1; - int randnum; - int i; - int exp10; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 9, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - va_start (args, params); - - if (params) { - f = va_arg (args, cob_field *); - seed = cob_get_int (f); - if (seed < 0) { - seed = 0; - } -#ifdef __CYGWIN__ - srandom ((unsigned int)seed); -#else - srand ((unsigned int)seed); -#endif - } - va_end (args); - -#ifdef __CYGWIN__ - randnum = (int)random (); -#else - randnum = rand (); -#endif - exp10 = 1; - for (i = 0; i < 10; ++i) { - if ((randnum / exp10) == 0) { - break; - } - exp10 *= 10; - } - if (i == 0) { - i = 1; - } - attr.scale = i; - make_field_entry (&field); - *(long long *)curr_field->data = (long long)randnum; - return curr_field; -} - -cob_field * -cob_intr_variance (const int params, ...) -{ - cob_field *f; - va_list args; - long long n; - union { - unsigned char data[8]; - long long datall; - } datun; - int i; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (8, NULL, &attr); - if (params == 1) { - make_field_entry (&field); - cob_set_int (curr_field, 0); - return curr_field; - } - - /* MEAN for all params */ - mpz_set_ui (d1.value, 0); - d1.scale = 0; - - va_start (args, params); - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - mpz_set_ui (d2.value, (unsigned int)params); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - - /* Got the MEAN in d1, iterate again */ - - mpz_set_ui (d4.value, 0); - d4.scale = 0; - - va_start (args, params); - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_sub (&d2, &d1); - cob_decimal_mul (&d2, &d2); - cob_decimal_add (&d4, &d2); - } - va_end (args); - - mpz_set_ui (d3.value, (unsigned int)params); - d3.scale = 0; - cob_decimal_div (&d4, &d3); - field.data = datun.data; - cob_decimal_get_field (&d4, &field, 0); - n = datun.datall; - for (i = 0; n; n /= 10, ++i) ; - field.data = NULL; - if (i <= 18) { - attr.scale = 18 - i; - } - make_field_entry (&field); - cob_decimal_get_field (&d4, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_standard_deviation (const int params, ...) -{ - cob_field *f; - va_list args; - int i; - - va_start (args, params); - make_double_entry (); - - if (params == 1) { - va_end (args); - cob_set_int (curr_field, 0); - return curr_field; - } - - /* MEAN for all params */ - mpz_set_ui (d1.value, 0); - d1.scale = 0; - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - mpz_set_ui (d2.value, (unsigned int)params); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - - /* Got the MEAN in d1, iterate again */ - - mpz_set_ui (d4.value, 0); - d4.scale = 0; - - va_start (args, params); - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_sub (&d2, &d1); - cob_decimal_mul (&d2, &d2); - cob_decimal_add (&d4, &d2); - } - va_end (args); - - mpz_set_ui (d3.value, (unsigned int)params); - d3.scale = 0; - cob_decimal_div (&d4, &d3); - /* We have the VARIANCE in d4, sqrt = STANDARD-DEVIATION */ - -/* Do not know why this does not work - d5.scale = d4.scale; - mpz_mul_ui (d5.value, d4.value, 1000000000); - mpz_mul_ui (d4.value, d5.value, 1000000000); - mpz_sqrt (d5.value, d4.value); - mpz_div_ui (d4.value, d5.value, 1000000000); - cob_decimal_get_field (&d4, curr_field, 0); - return curr_field; -*/ - - cob_decimal_get_field (&d4, curr_field, 0); - f = cob_intr_sqrt (curr_field); - return f; -} - -cob_field * -cob_intr_present_value (const int params, ...) -{ - cob_field *f; - va_list args; - int i; - - va_start (args, params); - make_double_entry (); - - if (params < 2) { - va_end (args); - fprintf (stderr, "Wrong number of parameters for FUNCTION PRESENT-VALUE\n"); - fflush (stderr); - cob_set_int (curr_field, 0); - return curr_field; - } - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d1, f); - mpz_set_ui (d2.value, 1); - d2.scale = 0; - cob_decimal_add (&d1, &d2); - - mpz_set_ui (d4.value, 0); - d4.scale = 0; - - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - mpz_set (d3.value, d1.value); - d3.scale = d1.scale; - if (i > 1) { - mpz_set_ui (d5.value, (unsigned int)i); - d5.scale = 0; - cob_decimal_pow (&d3, &d5); - } - cob_decimal_div (&d2, &d3); - cob_decimal_add (&d4, &d2); - } - va_end (args); - - cob_decimal_get_field (&d4, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_year_to_yyyy (const int params, ...) -{ - cob_field *f; - struct tm *timeptr; - va_list args; - time_t t; - int year; - int interval; - int xqtyear; - int maxyear; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - va_start (args, params); - f = va_arg (args, cob_field *); - year = cob_get_int (f); - if (params > 1) { - f = va_arg (args, cob_field *); - interval = cob_get_int (f); - } else { - interval = 50; - } - if (params > 2) { - f = va_arg (args, cob_field *); - xqtyear = cob_get_int (f); - } else { - t = time (NULL); - timeptr = cob_localtime (&t); - xqtyear = 1900 + timeptr->tm_year; - } - va_end (args); - - if (year < 0 || year > 99) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (xqtyear < 1601 || xqtyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - maxyear = xqtyear + interval; - if (maxyear < 1700 || maxyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - cob_set_int (curr_field, year); - return curr_field; -} - -cob_field * -cob_intr_date_to_yyyymmdd (const int params, ...) -{ - cob_field *f; - struct tm *timeptr; - va_list args; - time_t t; - int year; - int mmdd; - int interval; - int xqtyear; - int maxyear; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - va_start (args, params); - f = va_arg (args, cob_field *); - year = cob_get_int (f); - mmdd = year % 10000; - year /= 10000; - if (params > 1) { - f = va_arg (args, cob_field *); - interval = cob_get_int (f); - } else { - interval = 50; - } - if (params > 2) { - f = va_arg (args, cob_field *); - xqtyear = cob_get_int (f); - } else { - t = time (NULL); - timeptr = cob_localtime (&t); - xqtyear = 1900 + timeptr->tm_year; - } - va_end (args); - - if (year < 0 || year > 999999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (xqtyear < 1601 || xqtyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - maxyear = xqtyear + interval; - if (maxyear < 1700 || maxyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - year *= 10000; - year += mmdd; - cob_set_int (curr_field, year); - return curr_field; -} - -cob_field * -cob_intr_day_to_yyyyddd (const int params, ...) -{ - cob_field *f; - struct tm *timeptr; - va_list args; - time_t t; - int year; - int days; - int interval; - int xqtyear; - int maxyear; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - va_start (args, params); - f = va_arg (args, cob_field *); - year = cob_get_int (f); - days = year % 1000; - year /= 1000; - if (params > 1) { - f = va_arg (args, cob_field *); - interval = cob_get_int (f); - } else { - interval = 50; - } - if (params > 2) { - f = va_arg (args, cob_field *); - xqtyear = cob_get_int (f); - } else { - t = time (NULL); - timeptr = cob_localtime (&t); - xqtyear = 1900 + timeptr->tm_year; - } - va_end (args); - - if (year < 0 || year > 999999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (xqtyear < 1601 || xqtyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - maxyear = xqtyear + interval; - if (maxyear < 1700 || maxyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - year *= 1000; - year += days; - cob_set_int (curr_field, year); - return curr_field; -} - -cob_field * -cob_intr_seconds_past_midnight (void) -{ - struct tm *timeptr; - time_t t; - int seconds; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - t = time (NULL); - timeptr = cob_localtime (&t); - seconds = (timeptr->tm_hour * 3600) + (timeptr->tm_min * 60) + - timeptr->tm_sec; - cob_set_int (curr_field, seconds); - return curr_field; -} - -cob_field * -cob_intr_seconds_from_formatted_time (cob_field *format, cob_field *value) -{ - unsigned char *p1; - unsigned char *p2; - size_t n; - int seconds = 0; - int minutes = 0; - int hours = 0; - int seconds_seen = 0; - int minutes_seen = 0; - int hours_seen = 0; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 8, 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - - cob_exception_code = 0; - if (value->size < format->size) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_set_int (curr_field, 0); - return curr_field; - } - p1 = format->data; - p2 = value->data; - for (n = 0; n < format->size - 1; ++n, ++p1, ++p2) { - if (!memcmp (p1, "hh", 2) && !hours_seen) { - if (*p2 >= '0' && *p2 <= '9' && - *(p2 + 1) >= '0' && *(p2 + 1) <= '9') { - hours = ((*p2 - '0') * 10) + (*(p2 + 1) - '0'); - hours_seen = 1; - continue; - } - } - if (!memcmp (p1, "mm", 2) && !minutes_seen) { - if (*p2 >= '0' && *p2 <= '9' && - *(p2 + 1) >= '0' && *(p2 + 1) <= '9') { - minutes = ((*p2 - '0') * 10) + (*(p2 + 1) - '0'); - minutes_seen = 1; - continue; - } - } - if (!memcmp (p1, "ss", 2) && !seconds_seen) { - if (*p2 >= '0' && *p2 <= '9' && - *(p2 + 1) >= '0' && *(p2 + 1) <= '9') { - seconds = ((*p2 - '0') * 10) + (*(p2 + 1) - '0'); - seconds_seen = 1; - continue; - } - } - } - if (hours_seen && minutes_seen && seconds_seen) { - seconds += (hours * 3600) + (minutes * 60); - } else { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - seconds = 0; - } - cob_set_int (curr_field, seconds); - return curr_field; -} - -cob_field * -cob_intr_locale_date (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ - cob_field_attr attr; - cob_field field; -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - size_t len; - int indate; - int days; - int month; - int year; -#ifdef HAVE_LANGINFO_CODESET - unsigned char *p; - char *deflocale = NULL; - char *localep = NULL; - char *localep2; - struct tm tstruct; - char buff2[128]; -#else - char *p; - LCID localeid = LOCALE_USER_DEFAULT; - SYSTEMTIME syst; -#endif - char buff[128]; -#endif - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - if (srcfield->size < 8) { - goto derror; - } - p = srcfield->data; - indate = 0; - for (len = 0; len < 8; ++len, ++p) { - if (isdigit (*p)) { - indate *= 10; - indate += (*p - '0'); - } else { - goto derror; - } - } - } - year = indate / 10000; - if (year < 1601 || year > 9999) { - goto derror; - } - indate %= 10000; - month = indate / 100; - if (month < 1 || month > 12) { - goto derror; - } - days = indate % 100; - if (days < 1 || days > 31) { - goto derror; - } - if (leap_year (year)) { - if (days > leap_month_days[month]) { - goto derror; - } - } else { - if (days > normal_month_days[month]) { - goto derror; - } - } -#ifdef HAVE_LANGINFO_CODESET - month--; - - memset ((void *)&tstruct, 0, sizeof(struct tm)); - tstruct.tm_year = year - 1900; - tstruct.tm_mon = month; - tstruct.tm_mday = days; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - deflocale = locale_buff; - localep2 = setlocale (LC_TIME, NULL); - if (localep2) { - localep = strdup (localep2); - } - (void) setlocale (LC_TIME, deflocale); - } - memset (buff2, 0, sizeof(buff2)); - snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(D_FMT)); - if (deflocale) { - if (localep) { - (void) setlocale (LC_TIME, localep); - } - } - strftime (buff, sizeof(buff), buff2, &tstruct); -#else - memset ((void *)&syst, 0, sizeof(syst)); - syst.wYear = year; - syst.wMonth = month; - syst.wDay = days; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - for (p = locale_buff; *p; ++p) { - if (isalnum(*p) || *p == '_') { - continue; - } - break; - } - *p = 0; - for (len = 0; len < WINLOCSIZE; ++len) { - if (!strcmp(locale_buff, wintable[len].winlocalename)) { - localeid = wintable[len].winlocaleid; - break; - } - } - if (len == WINLOCSIZE) { - goto derror; - } - } - if (!GetDateFormat (localeid, DATE_SHORTDATE, &syst, NULL, buff, sizeof(buff))) { - goto derror; - } -#endif - len = strlen (buff); - field.size = len; - make_field_entry (&field); - memcpy (curr_field->data, buff, len); - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -derror: -#endif - field.size = 10; - make_field_entry (&field); - memset (curr_field->data, ' ', 10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_locale_time (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ - cob_field_attr attr; - cob_field field; -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - size_t len; - int indate; - int hours; - int minutes; - int seconds; -#ifdef HAVE_LANGINFO_CODESET - unsigned char *p; - char *deflocale = NULL; - char *localep = NULL; - char *localep2; - struct tm tstruct; - char buff2[128]; -#else - char *p; - LCID localeid = LOCALE_USER_DEFAULT; - SYSTEMTIME syst; -#endif - char buff[128]; -#endif - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - if (srcfield->size < 6) { - goto derror; - } - p = srcfield->data; - indate = 0; - for (len = 0; len < 6; ++len, ++p) { - if (isdigit (*p)) { - indate *= 10; - indate += (*p - '0'); - } else { - goto derror; - } - } - } - hours = indate / 10000; - if (hours < 0 || hours > 24) { - goto derror; - } - indate %= 10000; - minutes = indate / 100; - if (minutes < 0 || minutes > 59) { - goto derror; - } - seconds = indate % 100; - if (seconds < 0 || seconds > 59) { - goto derror; - } - -#ifdef HAVE_LANGINFO_CODESET - memset ((void *)&tstruct, 0, sizeof(struct tm)); - tstruct.tm_hour = hours; - tstruct.tm_min = minutes; - tstruct.tm_sec = seconds; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - deflocale = locale_buff; - localep2 = setlocale (LC_TIME, NULL); - if (localep2) { - localep = strdup (localep2); - } - (void) setlocale (LC_TIME, deflocale); - } - memset (buff2, 0, sizeof(buff2)); - snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(T_FMT)); - if (deflocale) { - if (localep) { - (void) setlocale (LC_TIME, localep); - } - } - strftime (buff, sizeof(buff), buff2, &tstruct); -#else - memset ((void *)&syst, 0, sizeof(syst)); - syst.wHour = hours; - syst.wMinute = minutes; - syst.wSecond = seconds; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - for (p = locale_buff; *p; ++p) { - if (isalnum(*p) || *p == '_') { - continue; - } - break; - } - *p = 0; - for (len = 0; len < WINLOCSIZE; ++len) { - if (!strcmp(locale_buff, wintable[len].winlocalename)) { - localeid = wintable[len].winlocaleid; - break; - } - } - if (len == WINLOCSIZE) { - goto derror; - } - } - if (!GetTimeFormat (localeid, LOCALE_NOUSEROVERRIDE, &syst, NULL, buff, sizeof(buff))) { - - goto derror; - } -#endif - len = strlen (buff); - field.size = len; - make_field_entry (&field); - memcpy (curr_field->data, buff, len); - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -derror: -#endif - field.size = 10; - make_field_entry (&field); - memset (curr_field->data, ' ', 10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_lcl_time_from_secs (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ - cob_field_attr attr; - cob_field field; -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - size_t len; - int indate; - int hours; - int minutes; - int seconds; -#ifdef HAVE_LANGINFO_CODESET - char *deflocale = NULL; - char *localep = NULL; - char *localep2; - struct tm tstruct; - char buff2[128]; -#else - char *p; - LCID localeid = LOCALE_USER_DEFAULT; - SYSTEMTIME syst; -#endif - char buff[128]; -#endif - - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - COB_FIELD_INIT (0, NULL, &attr); - cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - goto derror; - } - if (indate > 86400) { - goto derror; - } - hours = indate / 3600; - indate %= 3600; - minutes = indate / 60; - seconds = indate % 60; - -#ifdef HAVE_LANGINFO_CODESET - memset ((void *)&tstruct, 0, sizeof(struct tm)); - tstruct.tm_hour = hours; - tstruct.tm_min = minutes; - tstruct.tm_sec = seconds; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - deflocale = locale_buff; - localep2 = setlocale (LC_TIME, NULL); - if (localep2) { - localep = strdup (localep2); - } - (void) setlocale (LC_TIME, deflocale); - } - memset (buff2, 0, sizeof(buff2)); - snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(T_FMT)); - if (deflocale) { - if (localep) { - (void) setlocale (LC_TIME, localep); - } - } - strftime (buff, sizeof(buff), buff2, &tstruct); -#else - memset ((void *)&syst, 0, sizeof(syst)); - syst.wHour = hours; - syst.wMinute = minutes; - syst.wSecond = seconds; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff); - for (p = locale_buff; *p; ++p) { - if (isalnum(*p) || *p == '_') { - continue; - } - break; - } - *p = 0; - for (len = 0; len < WINLOCSIZE; ++len) { - if (!strcmp(locale_buff, wintable[len].winlocalename)) { - localeid = wintable[len].winlocaleid; - break; - } - } - if (len == WINLOCSIZE) { - goto derror; - } - } - if (!GetTimeFormat (localeid, LOCALE_NOUSEROVERRIDE, &syst, NULL, buff, sizeof(buff))) { - - goto derror; - } -#endif - len = strlen (buff); - field.size = len; - make_field_entry (&field); - memcpy (curr_field->data, buff, len); - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -derror: -#endif - field.size = 10; - make_field_entry (&field); - memset (curr_field->data, ' ', 10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_national (cob_field *srcfield) -{ - cob_field_attr attr; - cob_field field; - char *pdata; - int ndata; - - pdata = han2zen ((char *)srcfield->data, srcfield->size, &ndata); - COB_ATTR_INIT (COB_TYPE_NATIONAL, 0, 0, 0, NULL); - COB_FIELD_INIT (ndata, NULL, &attr); - make_field_entry (&field); - memcpy (curr_field->data, pdata, ndata); - free (pdata); - return curr_field; -} - -/* Initialization routine */ - -void -cob_init_intrinsic (void) -{ - size_t i; - - cob_decimal_init (&d1); - cob_decimal_init (&d2); - cob_decimal_init (&d3); - cob_decimal_init (&d4); - cob_decimal_init (&d5); - /* mpz_init2 (mp, 256); */ - memset ((char *)&calc_field[0], 0, sizeof (calc_field)); - memset ((char *)&calc_attr[0], 0, sizeof (calc_attr)); - for (i = 0; i < DEPTH_LEVEL; ++i) { - calc_field[i].data = cob_malloc (256); - calc_field[i].size = 256; - calc_size[i] = 256; - } - locale_buff = cob_malloc (COB_SMALL_BUFF); -} diff --git a/libcob/move.c b/libcob/move.c index c8b075de..ec87d542 100644 --- a/libcob/move.c +++ b/libcob/move.c @@ -1503,8 +1503,9 @@ cob_move (cob_field *src, cob_field *dst) } if (COB_FIELD_TYPE (src1) != COB_TYPE_GROUP) { - if ((!(COB_FIELD_TYPE (src1) == COB_TYPE_NATIONAL || - COB_FIELD_TYPE (src1) == COB_TYPE_NATIONAL_EDITED)) && + if ((COB_FIELD_TYPE (src1) == COB_TYPE_NUMERIC_DISPLAY || + COB_FIELD_TYPE (src1) == COB_TYPE_ALPHANUMERIC || + COB_FIELD_TYPE (src1) == COB_TYPE_ALPHANUMERIC_EDITED) && (COB_FIELD_TYPE (dst) == COB_TYPE_NATIONAL || COB_FIELD_TYPE (dst) == COB_TYPE_NATIONAL_EDITED)) { #ifdef I18N_UTF8 diff --git a/libcob/screenio.c b/libcob/screenio.c deleted file mode 100644 index 441765e9..00000000 --- a/libcob/screenio.c +++ /dev/null @@ -1,1803 +0,0 @@ -/* - * Copyright (C) 2001-2009 Keisuke Nishida - * Copyright (C) 2007-2009 Roger While - * - * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public License - * as published by the Free Software Foundation; either version 2.1, - * or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; see the file COPYING.LIB. If - * not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor - * Boston, MA 02110-1301 USA - */ - - -#include "config.h" - -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef _WIN32 -/* Later pdcurses versions require define before the include for DLL build */ -#define PDC_DLL_BUILD 1 -#include -#endif - -#ifdef HAVE_NCURSES_H -#include -#define COB_GEN_SCREENIO -#elif defined(HAVE_NCURSES_NCURSES_H) -#include -#define COB_GEN_SCREENIO -#elif defined(HAVE_PDCURSES_H) -#include -#define COB_GEN_SCREENIO -#elif defined(HAVE_CURSES_H) -#include -#define COB_GEN_SCREENIO -#endif - -/* if LINES unsuported */ -#ifndef A_OVERLINE -#ifdef A_TOP -#define A_OVERLINE A_TOP -#else -#define A_OVERLINE 0x00000000 -#endif /* A_TOP */ -#endif /* A_OVERLINE */ - -#ifndef A_LEFTLINE -#ifdef A_LEFT -#define A_LEFTLINE A_LEFT -#else -#define A_LEFTLINE 0x00000000 -#endif /* A_LEFT */ -#endif /* A_LEFTLINE */ - -#ifndef A_RIGHTLINE -#ifdef A_RIGHT -#define A_RIGHTLINE A_RIGHT -#else -#define A_RIGHTLINE 0x00000000 -#endif /* A_RIGHT */ -#endif /* A_RIGHTLINE */ - -/* Force symbol exports */ -#define COB_LIB_EXPIMP - -#include "libcob.h" -#include "coblocal.h" - -/* Global variables */ - -int cob_screen_initialized = 0; -int cob_screen_mode = 0; - -#define COB_CHECK_BEFORE 1 -#define COB_CHECK_CURRENT 0 - - -#ifdef COB_GEN_SCREENIO - -struct cob_inp_struct { - cob_screen *scr; - size_t up_index; - size_t down_index; - int this_y; - int this_x; -}; - -#define COB_INP_SIZE 1920 * sizeof(struct cob_inp_struct) - -/* Local variables */ - -static struct cob_inp_struct *cob_base_inp = NULL; -static size_t curr_index = 0; -static size_t totl_index = 0; -static size_t cob_has_color = 0; -static size_t cob_extended_status = 0; -static size_t cob_use_esc = 0; -static int global_return; -static int cob_current_y = 0; -static int cob_current_x = 0; -static int cob_max_y = 0; -static int cob_max_x = 0; -static short fore_color; -static short back_color; -static int insert_mode = 0; /* insert toggle, 0=off, 1=on */ - -/* Local functions */ - -static void -cob_convert_key (int *keyp, const unsigned int field_accept) -{ - /* Map key to KEY_xxx value */ - switch (*keyp) { - case '\n': - case '\r': - case '\004': - case '\032': - *keyp = KEY_ENTER; - break; - case '\t': - *keyp = KEY_STAB; - break; - case '\b': - case 0177: - *keyp = KEY_BACKSPACE; - break; - -#ifdef KEY_A1 - /* A1, A3, C1, C3 must be present */ - case KEY_A1: - *keyp = KEY_HOME; - break; - case KEY_A3: - *keyp = KEY_PPAGE; - break; - case KEY_C1: - *keyp = KEY_END; - break; - case KEY_C3: - *keyp = KEY_NPAGE; - break; - /* Any or all of A2, B1-3, C2 MAY be present */ - /* Note B2 ignored */ -#ifdef KEY_A2 - case KEY_A2: - *keyp = KEY_UP; - break; -#endif -#ifdef KEY_B1 - case KEY_B1: - *keyp = KEY_LEFT; - break; -#endif -#ifdef KEY_B3 - case KEY_B3: - *keyp = KEY_RIGHT; - break; -#endif -#ifdef KEY_C2 - case KEY_C2: - *keyp = KEY_DOWN; - break; -#endif - -#if defined(__PDCURSES__) && defined(PADSLASH) - case PADSLASH: - *keyp = '/'; - break; - case PADSTAR: - *keyp = '*'; - break; - case PADMINUS: - *keyp = '-'; - break; - case PADPLUS: - *keyp = '+'; - break; - case PADENTER: - *keyp = KEY_ENTER; - break; -#ifdef PAD0 - case PAD0: - *keyp = KEY_IC; - break; - case PADSTOP: - *keyp = KEY_DC; - break; -#endif /* PAD0 */ -#endif /* __PDCURSES__ */ -#endif /* KEY_A1 */ - default: - break; - } - - /* Check if key should be ignored */ - switch (*keyp) { - /* 2012/08/30 removed for extended Accept usage. - case KEY_STAB: - if (field_accept) { - *keyp = 0; - } - break; */ - case '\033': - if (!cob_extended_status || !cob_use_esc) { - *keyp = 0; - } - break; - case KEY_PPAGE: - case KEY_NPAGE: - case KEY_PRINT: - if (!cob_extended_status) { - *keyp = 0; - } - break; - case KEY_UP: - case KEY_DOWN: - if (field_accept && !cob_extended_status) { - *keyp = 0; - } - break; - default: - break; - } -} - -static void -get_line_column (cob_field *fline, cob_field *fcol, int *line, int *col) -{ - int l; - int c; - int p; - - if (fline == NULL) { - *line = 0; - *col = 0; - return; - } - - p = cob_get_int (fline); - - if (fcol == NULL) { - if (fline->size == 4) { - l = p / 100; - c = p % 100; - } else { - l = p / 1000; - c = p % 1000; - } - } else { - l = p; - c = cob_get_int (fcol); - } - if (l > 0) { - l--; - } - if (c > 0) { - c--; - } - *line = l; - *col = c; -} - -static void -cob_screen_attr (cob_field *fgc, cob_field *bgc, const int attr) -{ - size_t i; - int styles = 0; - int line; - int column; - short fgcolor; - short bgcolor; - short fgdef; - short bgdef; - - attrset (A_NORMAL); - if (attr & COB_SCREEN_REVERSE) { - styles |= A_REVERSE; - } - if (attr & COB_SCREEN_HIGHLIGHT) { - styles |= A_BOLD; - } - if (attr & COB_SCREEN_BLINK) { - styles |= A_BLINK; - } - if (attr & COB_SCREEN_UNDERLINE) { - styles |= A_UNDERLINE; - } - if (attr & COB_SCREEN_OVERLINE) { - styles |= A_OVERLINE; - } - if (attr & COB_SCREEN_RIGHTLINE) { - styles |= A_RIGHTLINE; - } - if (attr & COB_SCREEN_LEFTLINE) { - styles |= A_LEFTLINE; - } - - if (styles) { - attron (styles); - } - if (cob_has_color) { - fgcolor = fore_color; - bgcolor = back_color; - if (fgc) { - switch (cob_get_int (fgc)) { - case COB_SCREEN_BLACK: - fgcolor = COLOR_BLACK; - break; - case COB_SCREEN_BLUE: - fgcolor = COLOR_BLUE; - break; - case COB_SCREEN_GREEN: - fgcolor = COLOR_GREEN; - break; - case COB_SCREEN_CYAN: - fgcolor = COLOR_CYAN; - break; - case COB_SCREEN_RED: - fgcolor = COLOR_RED; - break; - case COB_SCREEN_MAGENTA: - fgcolor = COLOR_MAGENTA; - break; - case COB_SCREEN_YELLOW: - fgcolor = COLOR_YELLOW; - break; - case COB_SCREEN_WHITE: - fgcolor = COLOR_WHITE; - break; - default: - break; - } - } - if (bgc) { - switch (cob_get_int (bgc)) { - case COB_SCREEN_BLACK: - bgcolor = COLOR_BLACK; - break; - case COB_SCREEN_BLUE: - bgcolor = COLOR_BLUE; - break; - case COB_SCREEN_GREEN: - bgcolor = COLOR_GREEN; - break; - case COB_SCREEN_CYAN: - bgcolor = COLOR_CYAN; - break; - case COB_SCREEN_RED: - bgcolor = COLOR_RED; - break; - case COB_SCREEN_MAGENTA: - bgcolor = COLOR_MAGENTA; - break; - case COB_SCREEN_YELLOW: - bgcolor = COLOR_YELLOW; - break; - case COB_SCREEN_WHITE: - bgcolor = COLOR_WHITE; - break; - default: - break; - } - } - for (i = 0; i < (size_t)COLOR_PAIRS; i++) { - pair_content ((short)i, &fgdef, &bgdef); - if (fgdef == fgcolor && bgdef == bgcolor) { - break; - } - if (fgdef == 0 && bgdef == 0) { - init_pair ((short)i, fgcolor, bgcolor); - break; - } - } - if (i != (size_t)COLOR_PAIRS) { -#ifdef HAVE_COLOR_SET - color_set (COLOR_PAIR((short)i), (void *)0); -#else - attrset (COLOR_PAIR(i)); -#endif - bkgdset (COLOR_PAIR(i)); - } else { - attrset (A_NORMAL); - } - } - if (attr & COB_SCREEN_BLANK_SCREEN) { - getyx (stdscr, line, column); - clear (); - move (line, column); - } - if (attr & COB_SCREEN_BLANK_LINE) { - getyx (stdscr, line, column); - move (line, 0); - clrtoeol (); - move (line, column); - } - if (attr & COB_SCREEN_ERASE_EOL) { - clrtoeol (); - } - if (attr & COB_SCREEN_ERASE_EOS) { - clrtobot (); - } - if (attr & COB_SCREEN_BELL) { - beep (); - } -} - -static void COB_NOINLINE -cob_screen_init (void) -{ - char *s; - - if (!cob_screen_initialized) { - s = getenv ("COB_SCREEN_EXCEPTIONS"); - if (s) { - if (*s == 'Y' || *s == 'y') { - cob_extended_status = 1; - s = getenv ("COB_SCREEN_ESC"); - if (s) { - if (*s == 'Y' || *s == 'y') { - cob_use_esc = 1; - } - } - } - } - /* Get default insert mode, if 'Y' set to on */ - s = getenv ("COB_INSERT_MODE"); - if (s) { - if (*s == 'Y' || *s == 'y') { - insert_mode = 1; - } - } - fflush (stdout); - fflush (stderr); - if (!initscr ()) { - cob_runtime_error ("Failed to initialize curses"); - cob_stop_run (1); - } - cbreak (); - keypad (stdscr, 1); - nl (); - noecho (); - if (has_colors ()) { - start_color (); - pair_content ((short)0, &fore_color, &back_color); - if (COLOR_PAIRS) { -#ifdef HAVE_LIBPDCURSES - size_t i; - /* pdcurses sets ALL pairs to default fg/bg */ - /* IMHO a bug. */ - for (i = 1; i < (size_t)COLOR_PAIRS; ++i) { - init_pair ((short)i, 0, 0); - } -#endif - cob_has_color = 1; - } - } - attrset (A_NORMAL); - getmaxyx (stdscr, cob_max_y, cob_max_x); - cob_screen_initialized = 1; - } -} - -void -cob_screen_terminate (void) -{ - if (cob_screen_initialized) { - cob_screen_initialized = 0; - endwin (); - } -} - -static void COB_NOINLINE -cob_check_pos_status (int fret) -{ - cob_field *f; - int sline; - int scolumn; - char datbuf[8]; - - if (fret) { - cob_set_exception (COB_EC_IMP_ACCEPT); - } - if (cob_current_module->crt_status) { - if (COB_FIELD_IS_NUMERIC (cob_current_module->crt_status)) { - cob_set_int (cob_current_module->crt_status, fret); - } else { - sprintf(datbuf, "%4.4d", fret); - memcpy (cob_current_module->crt_status->data, datbuf, 4); - } - } - if (cob_current_module->cursor_pos) { - getyx (stdscr, sline, scolumn); - f = cob_current_module->cursor_pos; - if (COB_FIELD_IS_NUMERIC (f) && - COB_FIELD_TYPE (f) != COB_TYPE_NUMERIC_DISPLAY) { - sline *= 1000; - sline += scolumn; - cob_set_int (f, sline); - } else { - if (f->size < 6) { - sline *= 100; - sline += scolumn; - sprintf(datbuf, "%4.4d", sline); - memcpy (f->data, datbuf, 4); - } else { - sline *= 1000; - sline += scolumn; - sprintf(datbuf, "%6.6d", sline); - memcpy (f->data, datbuf, 6); - } - } - } -} - -static void -cob_screen_puts (cob_screen *s, cob_field *f) -{ - unsigned char *p; - size_t size; - int y; - int x; - int line; - int column; - - getyx (stdscr, y, x); - if (!s->line) { - line = y; - } else { - line = cob_get_int (s->line) - 1; - if (line < 0) { - line = y; - } - } - if (!s->column) { - column = x; - } else { - column = cob_get_int (s->column) - 1; - if (column < 0) { - column = x; - } - } - if (s->attr & COB_SCREEN_LINE_PLUS) { - line = y + line + 1; - } else if (s->attr & COB_SCREEN_LINE_MINUS) { - line = y - line + 1; - } - if (s->attr & COB_SCREEN_COLUMN_PLUS) { - column = x + column + 1; - } else if (s->attr & COB_SCREEN_COLUMN_MINUS) { - column = x - column + 1; - } - move (line, column); - cob_current_y = line; - cob_current_x = column; - cob_screen_attr (s->foreg, s->backg, s->attr); - if (s->attr & COB_SCREEN_INPUT) { - p = f->data; - for (size = 0; size < f->size; size++, p++) { - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - } else if (*p <= ' ') { - addch ('_'); - } else { - addch (*p); - } - } - } else { - addnstr ((char *)f->data, (int)f->size); - } - refresh (); -} - -static int -cob_is_sjis_multibyte (unsigned char c) -{ -#ifdef PDC_SJIS_SUPPORT - if ((c >= 0x81 && c <= 0x9f) || (c >= 0xe0 && c <= 0xfc)) { - return 1; - } -#endif - return 0; -} - -static int -cob_is_sjis_multibyte_at_cursor (unsigned char *data, int current, int checktype) -{ - int flag_multibyte = FALSE; -#ifdef PDC_SJIS_SUPPORT - int i; - - if (checktype == COB_CHECK_BEFORE) { - current--; - } - - for (i = 0; i <= current; i++) { - if (cob_is_sjis_multibyte(data[i])) { - i++; - flag_multibyte = TRUE; - } else { - flag_multibyte = FALSE; - } - } -#endif - return flag_multibyte; -} - -static void -cob_screen_get_all (void) -{ - struct cob_inp_struct *sptr; - cob_screen *s; - unsigned char *p; - int keyp; - int sline; - int scolumn; - int cline; - int ccolumn; - int rightpos; - int ateof; - int gotbacksp; - int ungetched; - - sptr = cob_base_inp; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); -/* RXW - p = s->field->data; - for (count = 0; count < s->field->size; count++) { - if (s->attr & COB_SCREEN_UPDATE) { - keyp = *p++; - addch (keyp); - } else if (s->attr & COB_SCREEN_PROMPT) { - addch ('_'); - } else { - addch (' '); - } - } - move (sline, scolumn); -*/ - ateof = 0; - gotbacksp = 0; - ungetched = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - - for (; ;) { -#ifdef PDC_SJIS_SUPPORT - if (PDC_get_current_byte_type() != PDC_CHAR_SJIS_HIGH) { - refresh (); - } -#else - refresh (); -#endif - errno = 0; - keyp = getch (); - - if (keyp == ERR) { - global_return = 8001; - goto screen_return; - } - if (keyp > KEY_F0 && keyp < KEY_F(65)) { - global_return = 1000 + keyp - KEY_F0; - goto screen_return; - } - - cob_convert_key (&keyp, 0); - if (keyp <= 0) { - (void)flushinp (); - beep (); - continue; - } - - getyx (stdscr, cline, ccolumn); - - switch (keyp) { - case KEY_ENTER: - goto screen_return; - case KEY_PPAGE: - global_return = 2001; - goto screen_return; - case KEY_NPAGE: - global_return = 2002; - goto screen_return; - case KEY_PRINT: - global_return = 2006; - goto screen_return; - case '\033': - global_return = 2005; - goto screen_return; - case KEY_STAB: - if (curr_index < totl_index - 1) { - curr_index++; - } else { - curr_index = 0; - } - sptr = cob_base_inp + curr_index; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_BTAB: - if (curr_index > 0) { - curr_index--; - } else { - curr_index = totl_index - 1; - } - sptr = cob_base_inp + curr_index; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - if (ungetched) { - ungetched = 0; - if (cob_is_sjis_multibyte_at_cursor (s->field->data, rightpos - scolumn, COB_CHECK_CURRENT)) { - p = s->field->data + rightpos - 1; - move (sline, rightpos - 1); - } else { - p = s->field->data + rightpos; - move (sline, rightpos); - } - } else { - p = s->field->data; - move (sline, scolumn); - } - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_UP: - curr_index = sptr->up_index; - sptr = cob_base_inp + curr_index; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_DOWN: - curr_index = sptr->down_index; - sptr = cob_base_inp + curr_index; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_HOME: - curr_index = 0; - sptr = cob_base_inp; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_END: - curr_index = totl_index - 1; - sptr = cob_base_inp + curr_index; - s = sptr->scr; - sline = sptr->this_y; - scolumn = sptr->this_x; - ateof = 0; - gotbacksp = 0; - rightpos = scolumn + s->field->size - 1; - p = s->field->data; - move (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr); - continue; - case KEY_BACKSPACE: - if (ccolumn > scolumn) { - p = s->field->data + ccolumn - scolumn; - if (gotbacksp || ccolumn != rightpos) { - if (!gotbacksp && ccolumn == rightpos - 1 && cob_is_sjis_multibyte(*p)) { - ateof = 0; - } else { - if (cob_is_sjis_multibyte_at_cursor (s->field->data, ccolumn - scolumn, COB_CHECK_BEFORE)) { - ccolumn -= 2; - p -= 2; - } else { - ccolumn--; - p--; - } - } - } else { - ateof = 0; - } - gotbacksp = 1; - if (cob_is_sjis_multibyte (*p) && ccolumn < rightpos) { - move (cline, ccolumn); - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - addch ('*'); - } else { - addch (0x81); - addch (0x40); - } - move (cline, ccolumn); - *p = 0x81; - *(p + 1) = 0x40; - continue; - } else { - move(cline, ccolumn); - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (' '); - } - move (cline, ccolumn); - *p = ' '; - continue; - } - } - continue; - case KEY_LEFT: - gotbacksp = 0; - if (ccolumn > scolumn) { - if (cob_is_sjis_multibyte_at_cursor (s->field->data, ccolumn - scolumn, COB_CHECK_BEFORE)) { - ccolumn--; - if (ccolumn == scolumn) { - ungetched = 1; - ungetch (KEY_BTAB); - } - } - ccolumn--; - move (cline, ccolumn); - p = s->field->data + ccolumn - scolumn; - } else { - ungetched = 1; - ungetch (KEY_BTAB); - } - continue; - case KEY_RIGHT: - gotbacksp = 0; - if (ccolumn < rightpos) { - if (cob_is_sjis_multibyte(*p)) { - if ((ccolumn + 1) == rightpos) { - ungetch('\t'); //goto scolumn - } else { - ccolumn++; - } - } - ccolumn++; - move (cline, ccolumn); - p = s->field->data + ccolumn - scolumn; - } else { - ungetch ('\t'); - } - continue; - default: - break; - } - - if (keyp > 037 && keyp < (int)A_CHARTEXT) { - if (COB_FIELD_IS_NUMERIC (s->field)) { - if (keyp < '0' || keyp > '9') { - beep (); - continue; - } - } - gotbacksp = 0; -#ifdef PDC_SJIS_SUPPORT - if (PDC_get_current_byte_type () == PDC_CHAR_ANSII) { - if (cob_is_sjis_multibyte_at_cursor (s->field->data, ccolumn - scolumn, COB_CHECK_CURRENT)) { - if (ccolumn < rightpos) { - move (cline, ccolumn + 1); - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (' '); - } - move (cline, ccolumn); - *(p + 1) = ' '; - } - } - } else if (PDC_get_current_byte_type () == PDC_CHAR_SJIS_HIGH) { - if (!cob_is_sjis_multibyte_at_cursor(s->field->data, ccolumn - scolumn, COB_CHECK_CURRENT)) { - if (ccolumn < rightpos - 1) { - if (cob_is_sjis_multibyte(*(p + 1))) { - move (cline, ccolumn + 2); - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (' '); - } - move (cline, ccolumn); - *(p + 2) = ' '; - } - } - } - } -#endif - *p = keyp; - if (s->attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch ((unsigned int)keyp); - } - if (ccolumn == rightpos) { -#ifdef PDC_SJIS_SUPPORT - if (PDC_get_current_byte_type () == PDC_CHAR_SJIS_LOW) { - ccolumn--; - p--; - } - PDC_clear_current_buffer (); -#endif - if (s->attr & COB_SCREEN_AUTO) { - if (curr_index == totl_index - 1) { - goto screen_return; - } else { - ungetch (011); - } - } - move (cline, ccolumn); - if (ateof) { - beep (); - } else { - ateof = 1; - } - } else { - p++; - } - continue; - } - gotbacksp = 0; - (void)flushinp (); - beep (); - } -screen_return: - refresh (); -} - -static int -compare_yx (const void *m1, const void *m2) -{ - const struct cob_inp_struct *s1; - const struct cob_inp_struct *s2; - - s1 = m1; - s2 = m2; - if (s1->this_y < s2->this_y) { - return -1; - } - if (s1->this_y > s2->this_y) { - return 1; - } - if (s1->this_x < s2->this_x) { - return -1; - } - if (s1->this_x > s2->this_x) { - return 1; - } - return 0; -} - -static void -cob_prep_input (cob_screen *s) -{ - struct cob_inp_struct *sptr; - int n; - - switch (s->type) { - case COB_SCREEN_TYPE_GROUP: - for (s = s->child; s; s = s->next) { - cob_prep_input (s); - } - break; - case COB_SCREEN_TYPE_FIELD: - cob_screen_puts (s, s->field); - if (s->attr & COB_SCREEN_INPUT) { - sptr = cob_base_inp + totl_index; - sptr->scr = s; - sptr->this_y = cob_current_y; - sptr->this_x = cob_current_x; - totl_index++; - } - break; - case COB_SCREEN_TYPE_VALUE: - cob_screen_puts (s, s->value); - if (s->occurs) { - for (n = 1; n < s->occurs; ++n) { - cob_screen_puts (s, s->value); - } - } - break; - case COB_SCREEN_TYPE_ATTRIBUTE: - cob_screen_attr (s->foreg, s->backg, s->attr); - break; - } -} - -/* Global functions */ - -void -cob_screen_display (cob_screen *s, cob_field *line, cob_field *column) -{ - int n; - - if (!cob_screen_initialized) { - cob_screen_init (); - } - - switch (s->type) { - case COB_SCREEN_TYPE_GROUP: - for (s = s->child; s; s = s->next) { - cob_screen_display (s, line, column); - } - break; - case COB_SCREEN_TYPE_FIELD: - cob_screen_puts (s, s->field); - break; - case COB_SCREEN_TYPE_VALUE: - cob_screen_puts (s, s->value); - if (s->occurs) { - for (n = 1; n < s->occurs; ++n) { - cob_screen_puts (s, s->value); - } - } - break; - case COB_SCREEN_TYPE_ATTRIBUTE: - cob_screen_attr (s->foreg, s->backg, s->attr); - break; - } - refresh (); -} - -void -cob_screen_accept (cob_screen *s, cob_field *line, cob_field *column) -{ - struct cob_inp_struct *sptr; - struct cob_inp_struct *sptr2; - size_t idx; - size_t n; - size_t posu; - size_t posd; - size_t prevy; - size_t firsty; - int starty; - - if (!cob_screen_initialized) { - cob_screen_init (); - } - if (!cob_base_inp) { - cob_base_inp = cob_malloc (COB_INP_SIZE); - } else { - memset (cob_base_inp, 0, COB_INP_SIZE); - } - cob_exception_code = 0; - cob_current_y = 0; - cob_current_x = 0; - totl_index = 0; - move (0, 0); - cob_prep_input (s); - /* No input fields is an error */ - if (!totl_index) { - cob_check_pos_status (8000); - return; - } - qsort (cob_base_inp, totl_index, sizeof(struct cob_inp_struct), compare_yx); - sptr = cob_base_inp; - starty = sptr->this_y; - posu = 0; - posd = 0; - prevy = 0; - firsty = 0; - /* Set up array for Cursor UP/DOWN */ - for (n = 0; n < totl_index; n++) { - sptr = cob_base_inp + n; - if (sptr->this_y > starty) { - if (!firsty) { - firsty = n; - } - starty = sptr->this_y; - sptr2 = cob_base_inp + posd; - for (idx = posd; idx < n; idx++, sptr2++) { - sptr2->down_index = n; - } - posu = prevy; - prevy = n; - posd = n; - } - sptr->up_index = posu; - } - sptr = cob_base_inp; - for (n = 0; n < firsty; n++, sptr++) { - sptr->up_index = posd; - } - curr_index = 0; - global_return = 0; - cob_screen_get_all (); - cob_check_pos_status (global_return); -} - -void -cob_field_display (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *scroll, - const int attr) -{ - int sline; - int scolumn; - - if (!cob_screen_initialized) { - cob_screen_init (); - } - - if (scroll) { - sline = cob_get_int (scroll); - if (attr & COB_SCREEN_SCROLL_DOWN) { - sline = -sline; - } - scrollok (stdscr, 1); - scrl (sline); - scrollok (stdscr, 0); - refresh (); - } - get_line_column (line, column, &sline, &scolumn); - move (sline, scolumn); - cob_screen_attr (fgc, bgc, attr); - addnstr ((char *)f->data, (int)f->size); - refresh (); -} - -void -cob_field_accept (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *scroll, - const int attr) -{ - unsigned char *p; - unsigned char *p2; - size_t count; - int keyp; - int fret; - int sline; - int scolumn; - int cline; - int ccolumn; - int rightpos; - int ateof; - int move_char; - int prompt_char; - - /* Initialize the screen. */ - if (!cob_screen_initialized) { - cob_screen_init (); - } - - if (scroll) { - keyp = cob_get_int (scroll); - if (attr & COB_SCREEN_SCROLL_DOWN) { - keyp = -keyp; - } - scrollok (stdscr, 1); - scrl (keyp); - scrollok (stdscr, 0); - refresh (); - } - cob_exception_code = 0; - /* Start line and column. */ - get_line_column (line, column, &sline, &scolumn); - move (sline, scolumn); - cob_screen_attr (fgc, bgc, attr); - /* Prompt characters. */ - p = f->data; - for (count = 0; count < f->size; count++) { - if (attr & COB_SCREEN_SECURE) { - addch ('*'); - } else if (attr & COB_SCREEN_UPDATE) { - fret = *p++; - addch ((unsigned int)fret); - } else if (COB_FIELD_IS_NUMERIC (f)) { - addch ('0'); - } else if (attr & COB_SCREEN_PROMPT) { - addch ('_'); - } else { - addch (' '); - } - } - move (sline, scolumn); - /* Initialize field. */ - if (!(attr & COB_SCREEN_UPDATE)) { - if (COB_FIELD_IS_NUMERIC (f)) { - cob_move (&cob_zero, f); - } else { - memset (f->data, ' ', f->size); - } - } - - fret = 0; - ateof = 0; - rightpos = scolumn + f->size - 1; - p = f->data; - /* Get characters from keyboard, processing each one. */ - for (; ;) { - /* Get current line, column. */ - getyx (stdscr, cline, ccolumn); - /* Trailing prompts. */ - if (COB_FIELD_IS_NUMERIC (f)) { - prompt_char = '0'; - } else if (attr & COB_SCREEN_PROMPT) { - prompt_char = '_'; - } else { - prompt_char = ' '; - } - for (count = rightpos; count > scolumn - 1; count--) { - /* Get character */ - p2 = f->data + count - scolumn; - move_char = *p2; - /* Field prompts. */ - if (COB_FIELD_IS_NUMERIC (f)) { - /* Numeric prompt zeros. */ - if (move_char == '0') { - move (cline, count); - addch (prompt_char); - } else { - /* Switch to remove prompts from within field. */ - if (attr & COB_SCREEN_SECURE) { - prompt_char = '*'; - } else { - prompt_char = '0'; - } - } - } else { - /* Alpha prompts. */ - if (move_char == ' ') { - move (cline, count); - addch (prompt_char); - } else { - /* Switch to remove prompts from within field. */ - if (attr & COB_SCREEN_SECURE) { - prompt_char = '*'; - } else { - prompt_char = ' '; - } - } - } - } - /* Cursor to current column. */ - move (cline, ccolumn); - /* Refresh screen. */ - refresh (); - errno = 0; - /* Get a character. */ - keyp = getch (); - /* Key error. */ - if (keyp == ERR) { - fret = 8001; - goto field_return; - } - /* Function keys F1 through F64 */ - if (keyp > KEY_F0 && keyp < KEY_F(65)) { - fret = 1000 + keyp - KEY_F0; - goto field_return; - } - - cob_convert_key (&keyp, 1U); - if (keyp <= 0) { - (void)flushinp (); - beep (); - continue; - } - - switch (keyp) { - case KEY_ENTER: - goto field_return; - case KEY_PPAGE: - /* Page up. */ - fret = 2001; - goto field_return; - case KEY_NPAGE: - /* Page down. */ - fret = 2002; - goto field_return; - case KEY_UP: - /* Up arrow. */ - fret = 2003; - goto field_return; - case KEY_DOWN: - /* Down arrow. */ - fret = 2004; - goto field_return; - case KEY_PRINT: - /* Print key. */ - /* pdcurses not returning this ? */ - fret = 2006; - goto field_return; - case 033: - /* Escape key. */ - fret = 2005; - goto field_return; - case KEY_STAB: - /* Tab key. */ - fret = 2007; - goto field_return; - case KEY_BTAB: - /* Back tab key. */ - fret = 2008; - goto field_return; - default: - break; - } - - getyx (stdscr, cline, ccolumn); - switch (keyp) { - case KEY_IC: - /* Insert key toggle. If off turn on, if on turn off. */ - if (insert_mode == 0) { - insert_mode = 1; /* on */ - /* to do, needs vertical bar cursor */ - /* this doesn't seem to work */ - count = curs_set(1); - } else { - insert_mode = 0; /* off */ - /* to do, needs square cursor */ - /* this doesn't seem to work */ - count = curs_set(2); - } - continue; - case KEY_DC: - /* Delete key. */ - /* Delete character, move remainder left. */ - for (count = ccolumn; count < rightpos; count++) { - /* Get character one position to right. */ - p2 = f->data + count - scolumn + 1; - move_char = *p2; - /* Move the character left. */ - p2 = f->data + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - move (cline, count); - if (attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = f->data + f->size - 1; - if (COB_FIELD_IS_NUMERIC (f)) { - *p2 = '0'; - } else { - *p2 = ' '; - } - /* Put cursor back to original position. */ - move (cline, ccolumn); - continue; - case KEY_BACKSPACE: - /* Backspace key. */ - if (ccolumn > scolumn) { - /* Shift remainder left with cursor. */ - for (count = ccolumn; count < rightpos + 1; count++) { - /* Get character. */ - p2 = f->data + count - scolumn ; - move_char = *p2; - /* Move the character left. */ - p2 = f->data + count - scolumn - 1; - *p2 = move_char; - /* Update screen with moved character. */ - move (cline, count - 1); - if (attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = f->data + f->size - 1; - if (COB_FIELD_IS_NUMERIC (f)) { - *p2 = '0'; - } else { - *p2 = ' '; - } - /* Move cursor left one from current. */ - ccolumn--; - move (cline, ccolumn); - p--; - } - ateof = 0; - continue; - case KEY_HOME: - /* Home key, move to start of field. */ - move (sline, scolumn); - p = f->data; - ateof = 0; - continue; - case KEY_END: - /* End key. */ - /* Prepare for empty field. */ - ccolumn = scolumn; - move_char = ' '; - /* Find non blank from right. */ - for (count = rightpos; count >= scolumn; count--) { - /* Get character */ - p2 = f->data + count - scolumn; - move_char = *p2; - /* Non blank stop. */ - if (move_char != ' ') { - ccolumn = count; - count = scolumn; - } - } - /* Cursor to first blank after. */ - if (move_char != ' ' && ccolumn != rightpos) { - ccolumn++; - } - move (cline, ccolumn); - p = f->data + ccolumn - scolumn; - ateof = 0; - continue; - case KEY_LEFT: - /* Left arrow. */ - if (ccolumn > scolumn) { - ccolumn--; - move (cline, ccolumn); - p = f->data + ccolumn - scolumn; - continue; - } - continue; - case KEY_RIGHT: - /* Right arrow. */ - if (ccolumn < rightpos) { - ccolumn++; - move (cline, ccolumn); - p = f->data + ccolumn - scolumn; - continue; - } - continue; - default: - break; - } - - /* Printable character. */ - if (keyp > 037 && keyp < (int)A_CHARTEXT) { - /* Numeric field check. */ - if (COB_FIELD_IS_NUMERIC (f)) { - if (keyp < '0' || keyp > '9') { - beep (); - continue; - } - } - /* Insert character. */ - if (insert_mode == 1) { - /* Move remainder to the right. */ - for (count = rightpos; count > ccolumn - 1; count--) { - /* Get character */ - p2 = f->data + count - scolumn - 1; - move_char = *p2; - /* Move character one right. */ - p2 = f->data + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - if (count > scolumn) { - move (cline, count); - if (move_char != ' ') { - if (attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch (move_char); - } - } - } - } - move (cline, ccolumn); - } - *p = (unsigned char)keyp; - /* Display character or '*' if secure. */ - if (attr & COB_SCREEN_SECURE) { - addch ('*'); - } else { - addch ((unsigned int)keyp); - } - if (ccolumn == rightpos) { - /* Auto-skip at end of field. */ - if (attr & COB_SCREEN_AUTO) { - break; - } - move (cline, ccolumn); - if (ateof) { - beep (); - } else { - ateof = 1; - } - } else { - p++; - } - continue; - } - beep (); - } -field_return: - refresh (); - cob_check_pos_status (fret); -} - -void -cob_screen_line_col (cob_field *f, const int l_or_c) -{ - if (!cob_screen_initialized) { - cob_screen_init (); - } - if (!l_or_c) { - cob_set_int (f, (int)LINES); - } else { - cob_set_int (f, (int)COLS); - } -} - -void -cob_screen_set_mode (const size_t smode) -{ - if (!smode) { - refresh (); - def_prog_mode (); - endwin (); - } else { - reset_prog_mode (); - refresh (); - } -} - - -static void -cob_screen_setline_allclear () -{ - int line, column; - chtype current_ch; - - for (line = 0; line < cob_max_y; line++) { - for (column = 0; column < cob_max_x; column++) { - current_ch = mvinch (line, column); - if (current_ch & (A_UNDERLINE | A_OVERLINE | A_LEFTLINE | A_RIGHTLINE)) { - attrset (current_ch); - attroff (A_UNDERLINE | A_OVERLINE | A_LEFTLINE | A_RIGHTLINE); - addch (current_ch & A_CHARTEXT); - } - } - } -} - - -static void -cob_screen_setline_cell (int line, int column, chtype LINE) -{ - chtype current_ch; - - current_ch = mvinch (line, column); - attrset (current_ch | LINE); - addch (current_ch & A_CHARTEXT); -} - -static void -cob_screen_setline_vertical (int start_line, int length, int column, chtype LINE) -{ - int i; - - for (i = 0; i < length; i++) { - cob_screen_setline_cell (start_line + i, column, LINE); - } -} - -static void -cob_screen_setline_horizontal (int start_column, int length, int line, chtype LINE) -{ - int i; - - for (i = 0; i < length; i++) { - cob_screen_setline_cell (line, start_column + i, LINE); - } -} - -int -CBL_OC_KEISEN (unsigned char * cmd, unsigned char * line, unsigned char * col, unsigned char * lng1, unsigned char * lng2, unsigned char * color, unsigned char * prn) -{ - int k_cmd; - int k_line; - int k_col; - int k_lng1; - int k_lng2; - int k_color; - int k_prn; - COB_UNUSED(k_color); - COB_UNUSED(k_prn); - - COB_CHK_PARMS (CBL_OC_ATTRIBUTE, 5); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[1]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[2]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[3]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[4]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[5]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[6]) { - return -1; - } - - k_cmd = cob_get_int (cob_current_module->cob_procedure_parameters[0]); - k_line = cob_get_int (cob_current_module->cob_procedure_parameters[1]) - 1; - k_col = cob_get_int (cob_current_module->cob_procedure_parameters[2]) - 1; - k_lng1 = cob_get_int (cob_current_module->cob_procedure_parameters[3]); - k_lng2 = cob_get_int (cob_current_module->cob_procedure_parameters[4]); - k_color = cob_get_int (cob_current_module->cob_procedure_parameters[5]); - k_prn = cob_get_int (cob_current_module->cob_procedure_parameters[6]); - - if (!cob_screen_initialized) { - cob_screen_init (); - } - - switch (k_cmd) { - case 0: /* clear */ - cob_screen_setline_allclear (); - break; - case 1: /* under line */ - cob_screen_setline_horizontal (k_col, k_lng1, k_line, A_UNDERLINE); - break; - case 2: /* over line */ - cob_screen_setline_horizontal (k_col, k_lng1, k_line, A_OVERLINE); - break; - case 3: /* vertical line left */ - cob_screen_setline_vertical (k_line, k_lng1, k_col, A_LEFTLINE); - break; - case 4: /* vertical line right */ - cob_screen_setline_vertical (k_line, k_lng1, k_col, A_RIGHTLINE); - break; - case 5: /* box */ - //horizon line - cob_screen_setline_horizontal (k_col, k_lng1, k_line, A_OVERLINE); - cob_screen_setline_horizontal (k_col, k_lng1, k_line + k_lng2 - 1, A_UNDERLINE); - - //vertical line - cob_screen_setline_vertical (k_line, k_lng2, k_col, A_LEFTLINE); - cob_screen_setline_vertical (k_line, k_lng2, k_col + k_lng1 - 1, A_RIGHTLINE); - break; - default: - break; - } - - refresh (); - return 0; -} - -int -CBL_OC_ATTRIBUTE (unsigned char *line, unsigned char *col, unsigned char *lng, unsigned char *fcolor, unsigned char *bcolor, unsigned char *attr, unsigned char *flg) -{ - int k_line; - int k_col; - int k_lng; - cob_field *k_fcolor; - cob_field *k_bcolor; - int k_attr; - int k_flg; - - int i; - chtype current_ch; - - COB_CHK_PARMS (CBL_OC_ATTRIBUTE, 5); - - if (!cob_current_module->cob_procedure_parameters[0]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[1]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[2]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[3]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[4]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[5]) { - return -1; - } - if (!cob_current_module->cob_procedure_parameters[6]) { - return -1; - } - - k_line = cob_get_int (cob_current_module->cob_procedure_parameters[0]) - 1; - k_col = cob_get_int (cob_current_module->cob_procedure_parameters[1]) - 1; - k_lng = cob_get_int (cob_current_module->cob_procedure_parameters[2]); - k_fcolor = cob_current_module->cob_procedure_parameters[3]; - k_bcolor = cob_current_module->cob_procedure_parameters[4]; - k_attr = cob_get_int (cob_current_module->cob_procedure_parameters[5]); - k_flg = cob_get_int (cob_current_module->cob_procedure_parameters[6]); - - if (!cob_screen_initialized) { - cob_screen_init (); - } - - cob_screen_attr (k_fcolor, k_bcolor, k_attr); - - for (i = 0; i < k_lng; i++) { - current_ch = mvinch (k_line, k_col + i); - - if (k_flg == 0) { - attron (current_ch); - } - addch (current_ch & A_CHARTEXT); - } - - refresh (); - - return 0; -} - -#else - -void -cob_screen_terminate (void) -{ -} - -void -cob_field_display (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *scroll, - const int attr) -{ -} - -void -cob_field_accept (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *scroll, - const int attr) -{ -} - -void -cob_screen_display (cob_screen *s, cob_field *line, cob_field *column) -{ -} - -void -cob_screen_accept (cob_screen *s, cob_field *line, cob_field *column) -{ -} - -void -cob_screen_line_col (cob_field *f, const int l_or_c) -{ -} - -void -cob_screen_set_mode (const size_t smode) -{ -} - -int -CBL_OC_KEISEN (unsigned char * cmd, unsigned char * line, unsigned char * col, unsigned char * lng1, unsigned char * lng2, unsigned char * color, unsigned char * prn) -{ -} - -int -CBL_OC_ATTRIBUTE (unsigned char *line, unsigned char *col, unsigned char *lng, unsigned char *fcolor, unsigned char *bcolor, unsigned char *attr, unsigned char *flg) -{ -} - -#endif diff --git a/tests/cobol85/newcob.val b/tests/cobol85/newcob.val new file mode 100644 index 00000000..2c02dfd4 --- /dev/null +++ b/tests/cobol85/newcob.val @@ -0,0 +1,348272 @@ +CCVS85 VERSION 4.0 01 OCT 1992 0032 +*HEADER,COBOL,EXEC85 +000100 IDENTIFICATION DIVISION. EXEC84.2 +000200 EXEC84.2 +000400 PROGRAM-ID. EXEC84.2 +000500 EXEC85. EXEC84.2 +000600 INSTALLATION. EXEC84.2 +000700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".EXEC84.2 +000800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".EXEC84.2 +000900 ENVIRONMENT DIVISION. EXEC84.2 +001000 EXEC84.2 +001100**************************************************************** EXEC84.2 +001200* * EXEC84.2 +001300* VALIDATION FOR:- * EXEC84.2 +001400* * EXEC84.2 +001500* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".EXEC84.2 +001600* * EXEC84.2 +001700* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".EXEC84.2 +001800* * EXEC84.2 +001900**************************************************************** EXEC84.2 +002000 CONFIGURATION SECTION. EXEC84.2 +002100 EXEC84.2 +002200 SPECIAL-NAMES. EXEC84.2 +002300 INPUT-OUTPUT SECTION. EXEC84.2 +002400 FILE-CONTROL. EXEC84.2 +002500 SELECT OPTIONAL POPULATION-FILE EXEC84.2 +002600 ASSIGN TO EXEC84.2 +002700 XXXXX001. EXEC84.2 +002800 SELECT SOURCE-COBOL-PROGRAMS EXEC84.2 +002900 ASSIGN TO EXEC84.2 +003000 XXXXX002 EXEC84.2 +003100 ORGANIZATION SEQUENTIAL. EXEC84.2 +003200 SELECT UPDATED-POPULATION-FILE EXEC84.2 +003300 ASSIGN TO EXEC84.2 +003400 XXXXX003. EXEC84.2 +003500 SELECT PRINT-FILE EXEC84.2 +003600 ASSIGN TO EXEC84.2 +003700 XXXXX055. EXEC84.2 +003800 SELECT CONTROL-CARD-FILE EXEC84.2 +003900 ASSIGN TO EXEC84.2 +004000 XXXXX058. EXEC84.2 +004100 DATA DIVISION. EXEC84.2 +004200 FILE SECTION. EXEC84.2 +004300 FD POPULATION-FILE. EXEC84.2 +004400* RECORD CONTAINS 2400 CHARACTERS. EXEC84.2 +004500 01 SOURCE-IN-2400. EXEC84.2 +004600 02 SOURCE-IN PIC X(80). EXEC84.2 +004700* OCCURS 30. EXEC84.2 +004800 FD CONTROL-CARD-FILE. EXEC84.2 +004900 01 CONTROL-RECORD PIC X(80). EXEC84.2 +005000 FD PRINT-FILE. EXEC84.2 +005100 01 PRINT-REC. EXEC84.2 +005200 05 FILLER PIC X. EXEC84.2 +005300 05 PRINT-DATA PIC X(131). EXEC84.2 +005400 FD SOURCE-COBOL-PROGRAMS EXEC84.2 +005500 BLOCK CONTAINS 1 RECORDS. EXEC84.2 +005600 01 CT-OUT. EXEC84.2 +005700 02 FILLER PIC X(72). EXEC84.2 +005800 02 FILLER PIC X(8). EXEC84.2 +005900 FD UPDATED-POPULATION-FILE EXEC84.2 +006000 RECORD CONTAINS 2400 CHARACTERS. EXEC84.2 +006100 01 UPDATED-SOURCE-OUT-2400. EXEC84.2 +006200 02 UD-SOURCE-OUT PIC X(80) OCCURS 30. EXEC84.2 +006300 EXEC84.2 +006400 WORKING-STORAGE SECTION. EXEC84.2 +006500 EXEC84.2 +006600 01 FILLER PIC X(40) VALUE EXEC84.2 +006700 "NEWEXEC WORKING-STORAGE STARTS HERE ==->". EXEC84.2 +006800 01 BLOCK-TYPE PIC X(5). EXEC84.2 +006900 01 SUB1 PIC S9(3) COMP. EXEC84.2 +007000 01 SUB2 PIC S9(3) COMP. EXEC84.2 +007100 01 SUB3 PIC S9(3) COMP. EXEC84.2 +007200 01 SUB4 PIC S9(3) COMP. EXEC84.2 +007300 01 SUB5 PIC S9(3) COMP. EXEC84.2 +007400 01 SUB6 PIC S9(3) COMP. EXEC84.2 +007500 01 SUB7 PIC S9(3) COMP. EXEC84.2 +007600 01 WA-ERR-IND PIC 9 VALUE ZEROES. EXEC84.2 +007700 01 WA-FIRST-IND PIC 9 VALUE ZEROES. EXEC84.2 +007800 01 WA-ZCARD-TABLE. EXEC84.2 +007900 05 WA-ZCARD OCCURS 10 EXEC84.2 +008000 PIC X(60). EXEC84.2 +008100 01 WA-TOP-OF-PAGE-LINE. EXEC84.2 +008200 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 +008300 05 WA-VERSION. EXEC84.2 +008400 07 WA-VERSION-TEXT PIC X(22) VALUE EXEC84.2 +008500 "CCVS85 VERSION NUMBER ". EXEC84.2 +008600 07 WA-VERSION-NUM PIC X(3) VALUE SPACES. EXEC84.2 +008700 05 WA-RELEASE. EXEC84.2 +008800 07 WA-RELEASE-TEXT PIC X(14) VALUE EXEC84.2 +008900 ", RELEASED ON ". EXEC84.2 +009000 07 WA-VERSION-DATE PIC X(11) VALUE SPACES. EXEC84.2 +009100 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 +009200 05 WA-COMPANY-AND-COMPILER PIC X(30) VALUE SPACES. EXEC84.2 +009300 05 FILLER PIC X(5) VALUE SPACES. EXEC84.2 +009400 05 WA-DATE PIC XXBXXBXX. EXEC84.2 +009500 05 FILLER PIC X(4) VALUE SPACES. EXEC84.2 +009600 05 FILLER PIC X(5) VALUE "PAGE ". EXEC84.2 +009700 05 WA-PAGE-CT PIC Z(5)9. EXEC84.2 +009800 EXEC84.2 +009900 01 WA-ACCT-LINE-1. EXEC84.2 +010000 05 FILLER PIC X(19) VALUE EXEC84.2 +010100 " ** END OF PROGRAM ". EXEC84.2 +010200 05 WA-CURRENT-PROG PIC X(6). EXEC84.2 +010300 05 FILLER PIC X(32) VALUE EXEC84.2 +010400 " FOUND, COBOL LINES PROCESSED: ". EXEC84.2 +010500 05 WA-LINES-COBOL PIC Z(5)9. EXEC84.2 +010600 01 WA-ACCT-LINE-2. EXEC84.2 +010700 05 FILLER PIC X(19) VALUE EXEC84.2 +010800 " ** LINES INSERTED ". EXEC84.2 +010900 05 WA-LINES-INSERTED PIC Z(5)9. EXEC84.2 +011000 05 FILLER PIC X(19) VALUE EXEC84.2 +011100 " ** LINES REPLACED ". EXEC84.2 +011200 05 WA-LINES-REPLACED PIC Z(5)9. EXEC84.2 +011300 05 FILLER PIC X(19) VALUE EXEC84.2 +011400 " ** LINES DELETED ". EXEC84.2 +011500 05 WA-LINES-DELETED PIC Z(5)9. EXEC84.2 +011600 01 WA-ACCT-LINE-3. EXEC84.2 +011700 05 FILLER PIC X(18) VALUE EXEC84.2 +011800 " ** OPTIONAL CODE ". EXEC84.2 +011900 05 WA-OPTIONAL-CODE PIC X(8). EXEC84.2 +012000 05 WA-CODE-REMOVED PIC Z(5)9. EXEC84.2 +012100 05 WA-CODE-KILLED PIC X(21) VALUE EXEC84.2 +012200 " ** COMMENTS DELETED ". EXEC84.2 +012300 05 WA-COMMENTS-DEL PIC Z(5)9. EXEC84.2 +012400 01 WA-FINAL-LINE-1. EXEC84.2 +012500 05 FILLER PIC X(34) VALUE EXEC84.2 +012600 " ** END OF POPULATION FILE REACHED". EXEC84.2 +012700 05 FILLER PIC X(27) VALUE EXEC84.2 +012800 " NUMBER OF PROGRAMS FOUND: ". EXEC84.2 +012900 05 WA-PROGS-FOUND PIC Z(5)9. EXEC84.2 +013000 01 WA-FINAL-LINE-2. EXEC84.2 +013100 05 FILLER PIC X(47) VALUE EXEC84.2 +013200 " ** NUMBER OF PROGRAMS WRITTEN TO SOURCE FILE: ". EXEC84.2 +013300 05 WA-SOURCE-PROGS PIC Z(5)9. EXEC84.2 +013400 01 WA-FINAL-LINE-3. EXEC84.2 +013500 05 FILLER PIC X(48) VALUE EXEC84.2 +013600 " ** NUMBER OF PROGRAMS WRITTEN TO NEW POPULATION". EXEC84.2 +013700 05 FILLER PIC X(7) VALUE " FILE: ". EXEC84.2 +013800 05 WA-NEWPOP-PROGS PIC Z(5)9. EXEC84.2 +013900 01 WB-CONTROL-DATA. EXEC84.2 +014000 05 WB-FILL PIC X(80). EXEC84.2 +014100 05 FILLER REDEFINES WB-FILL. EXEC84.2 +014200 10 WB-3 PIC X(3). EXEC84.2 +014300 10 FILLER PIC X(77). EXEC84.2 +014400 05 FILLER REDEFINES WB-FILL. EXEC84.2 +014500 10 WB-4 PIC X(4). EXEC84.2 +014600 10 WB-NN PIC 99. EXEC84.2 +014700 10 FILLER PIC X. EXEC84.2 +014800 10 WB-X PIC X. EXEC84.2 +014900 10 FILLER PIC X(72). EXEC84.2 +015000 05 FILLER REDEFINES WB-FILL. EXEC84.2 +015100 10 WB-6 PIC X(6). EXEC84.2 +015200 10 FILLER PIC X(74). EXEC84.2 +015300 05 FILLER REDEFINES WB-FILL. EXEC84.2 +015400 10 WB-7 PIC X(7). EXEC84.2 +015500 10 FILLER PIC X(73). EXEC84.2 +015600 05 FILLER REDEFINES WB-FILL. EXEC84.2 +015700 10 WB-8 PIC X(8). EXEC84.2 +015800 10 FILLER PIC X(72). EXEC84.2 +015900 05 FILLER REDEFINES WB-FILL. EXEC84.2 +016000 10 WB-9 PIC X(9). EXEC84.2 +016100 10 FILLER PIC X(71). EXEC84.2 +016200 05 FILLER REDEFINES WB-FILL. EXEC84.2 +016300 10 WB-10 PIC X(10). EXEC84.2 +016400 10 FILLER PIC X(70). EXEC84.2 +016500 05 FILLER REDEFINES WB-FILL. EXEC84.2 +016600 10 WB-11 PIC X(11). EXEC84.2 +016700 10 FILLER PIC X(69). EXEC84.2 +016800 05 FILLER REDEFINES WB-FILL. EXEC84.2 +016900 10 WB-12 PIC X(12). EXEC84.2 +017000 10 FILLER PIC X. EXEC84.2 +017100 10 WB-PROG PIC X(5). EXEC84.2 +017200 10 FILLER PIC X(62). EXEC84.2 +017300 05 FILLER REDEFINES WB-FILL. EXEC84.2 +017400 10 WB-13 PIC X(13). EXEC84.2 +017500 10 FILLER PIC X(67). EXEC84.2 +017600 05 FILLER REDEFINES WB-FILL. EXEC84.2 +017700 10 WB-14 PIC X(14). EXEC84.2 +017800 10 FILLER PIC X. EXEC84.2 +017900 10 WB-MODULE PIC XX. EXEC84.2 +018000 10 FILLER PIC X. EXEC84.2 +018100 10 WB-LEVEL PIC X. EXEC84.2 +018200 10 FILLER PIC X(61). EXEC84.2 +018300 05 FILLER REDEFINES WB-FILL. EXEC84.2 +018400 10 WB-15 PIC X(15). EXEC84.2 +018500 10 FILLER PIC X(65). EXEC84.2 +018600 05 FILLER REDEFINES WB-FILL. EXEC84.2 +018700 10 WB-16 PIC X(16). EXEC84.2 +018800 10 FILLER PIC X(64). EXEC84.2 +018900 05 WB-X-CARD REDEFINES WB-FILL. EXEC84.2 +019000 10 WB-X-HYPHEN PIC XX. EXEC84.2 +019100 10 WB-X-CARD-NUM PIC 9(3). EXEC84.2 +019200 10 WB-PROG-POS. EXEC84.2 +019300 15 WB-PROG-POS-NUM PIC 99. EXEC84.2 +019400 10 FILLER PIC X. EXEC84.2 +019500 10 WB-SUBS-TEXT PIC X(60). EXEC84.2 +019600 10 FILLER PIC X(12). EXEC84.2 +019700 05 WB-START-CARD REDEFINES WB-FILL. EXEC84.2 +019800 10 WB-STAR-START PIC X(6). EXEC84.2 +019900 10 FILLER PIC X. EXEC84.2 +020000 10 WB-UPDATE-PROG PIC X(6). EXEC84.2 +020100 10 FILLER PIC X. EXEC84.2 +020200 10 WB-RENUMBER PIC X. EXEC84.2 +020300 10 FILLER PIC X(65). EXEC84.2 +020400 05 WB-LINE-UPDATE REDEFINES WB-FILL. EXEC84.2 +020500 10 WB-SEQ-1 PIC X(6). EXEC84.2 +020600 10 WB-COBOL-LINE PIC X(74). EXEC84.2 +020700 10 FILLER REDEFINES WB-COBOL-LINE. EXEC84.2 +020800 15 WB-COL-7 PIC X. EXEC84.2 +020900 15 FILLER PIC X(73). EXEC84.2 +021000 10 FILLER REDEFINES WB-COBOL-LINE. EXEC84.2 +021100 15 WB-CHAR PIC X. EXEC84.2 +021200 15 WB-SEQ-2 PIC X(6). EXEC84.2 +021300/ EXEC84.2 +021400 01 WC-CURRENT-POP-RECORD. EXEC84.2 +021500 05 WC-1. EXEC84.2 +021600 10 WC-END-OF-POPFILE PIC X(16). EXEC84.2 +021700 10 FILLER PIC X(64). EXEC84.2 +021800 05 WC-HEADER REDEFINES WC-1. EXEC84.2 +021900 10 WC-STAR-HEADER PIC X(7). EXEC84.2 +022000 10 FILLER PIC X. EXEC84.2 +022100 10 WC-COBOL PIC X(5). EXEC84.2 +022200 10 FILLER PIC X. EXEC84.2 +022300 10 WC-PROG-ID. EXEC84.2 +022400 12 WC-PROG-ID-1-5. EXEC84.2 +022500 15 WC-PROG-ID-1-4. EXEC84.2 +022600 18 WC-MODULE PIC XX. EXEC84.2 +022700 18 WC-LEVEL PIC X. EXEC84.2 +022800 18 FILLER PIC X. EXEC84.2 +022900 15 FILLER PIC X. EXEC84.2 +023000 12 WC-PROG-ID-6 PIC X. EXEC84.2 +023100 10 FILLER PIC X. EXEC84.2 +023200 10 WC-SUBPRG PIC X(6). EXEC84.2 +023300 10 FILLER PIC X. EXEC84.2 +023400 10 WC-PROG2ID. EXEC84.2 +023500 12 WC-PROG2ID-1-5 PIC X(5). EXEC84.2 +023600 12 FILLER PIC X. EXEC84.2 +023700 10 FILLER PIC X(46). EXEC84.2 +023800 05 FILLER REDEFINES WC-1. EXEC84.2 +023900 10 WC-1-72. EXEC84.2 +024000 15 WC-6. EXEC84.2 +024100 20 WC-STAR PIC X. EXEC84.2 +024200 20 FILLER PIC X(5). EXEC84.2 +024300 15 FILLER REDEFINES WC-6. EXEC84.2 +024400 20 WC-1-5 PIC X(5). EXEC84.2 +024500 20 FILLER PIC X. EXEC84.2 +024600 15 WC-COL-7 PIC X. EXEC84.2 +024700 15 WC-COL-8 PIC X. EXEC84.2 +024800 15 FILLER PIC X(3). EXEC84.2 +024900 15 WC-SUB-DATA. EXEC84.2 +025000 20 WC-12-15 PIC X(4). EXEC84.2 +025100 20 FILLER PIC X. EXEC84.2 +025200 20 WC-17-19 PIC 9(3). EXEC84.2 +025300 20 WC-20 PIC X. EXEC84.2 +025400 20 FILLER PIC X(52). EXEC84.2 +025500 10 WC-73-80 PIC X(8). EXEC84.2 +025600 EXEC84.2 +025700 01 WD-SOURCE-REC. EXEC84.2 +025800 05 WD-1. EXEC84.2 +025900 10 FILLER PIC X(6). EXEC84.2 +026000 10 WD-HEADER PIC X(74). EXEC84.2 +026100 EXEC84.2 +026200 01 WE-PRINT-DATA. EXEC84.2 +026300 05 WE-COBOL-LINE PIC X(80). EXEC84.2 +026400 05 FILLER PIC X VALUE SPACE. EXEC84.2 +026500 05 WE-X-CARD PIC X(9). EXEC84.2 +026600 05 FILLER PIC XX VALUE SPACES. EXEC84.2 +026700 05 WE-CHANGE-TYPE PIC X(12). EXEC84.2 +026800 EXEC84.2 +026900 01 WF-PROGRAM-SELECTED-TABLE. EXEC84.2 +027000 05 WF-PROGRAM-SELECTED PIC X(5) OCCURS 50. EXEC84.2 +027100 EXEC84.2 +027200 01 WG-MODULE-SELECTED-TABLE. EXEC84.2 +027300 05 FILLER OCCURS 10. EXEC84.2 +027400 10 WG-MODULE-SELECTED PIC XX. EXEC84.2 +027500 10 WG-MODULE-LEVEL PIC X. EXEC84.2 +027600 EXEC84.2 +027700 01 WV-PRINT-MISCELLANEOUS. EXEC84.2 +027800 05 WV-OPTION-HEADING PIC X(25) VALUE EXEC84.2 +027900 " OPTION SWITCH SETTINGS -". EXEC84.2 +028000 05 WV-OPT-1 PIC X(40) VALUE EXEC84.2 +028100 " 0 1 2". EXEC84.2 +028200 05 WV-OPT-2 PIC X(52) VALUE EXEC84.2 +028300 " 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6". EXEC84.2 +028400 05 WV-OPT-SWITCHES. EXEC84.2 +028500 10 FILLER PIC X VALUE SPACE. EXEC84.2 +028600 10 FILLER OCCURS 26. EXEC84.2 +028700 15 WV-OPT PIC X. EXEC84.2 +028800 15 FILLER PIC X. EXEC84.2 +028900 01 WX-X-CARD-TABLE. EXEC84.2 +029000 05 WX-X-CARD OCCURS 200. EXEC84.2 +029100 10 WX-X-CHAR PIC X EXEC84.2 +029200 OCCURS 60. EXEC84.2 +029300 01 WX-PROG-POS-TABLE. EXEC84.2 +029400 05 WX-PROG-POS OCCURS 200 EXEC84.2 +029500 PIC 99. EXEC84.2 +029600 01 WY-SWITCHES. EXEC84.2 +029700 05 WY-OPTION-SWITCHES. EXEC84.2 +029800 10 WY-OPT-SW-1 PIC X. EXEC84.2 +029900 10 WY-OPT-SW-2 PIC X. EXEC84.2 +030000 10 WY-OPT-SW-3 PIC X. EXEC84.2 +030100 10 WY-OPT-SW-4 PIC X. EXEC84.2 +030200 10 WY-OPT-SW-5 PIC X. EXEC84.2 +030300 10 WY-OPT-SW-6 PIC X. EXEC84.2 +030400 10 WY-OPT-SW-7 PIC X. EXEC84.2 +030500 10 WY-OPT-SW-8 PIC X. EXEC84.2 +030600 10 WY-OPT-SW-9 PIC X. EXEC84.2 +030700 10 WY-OPT-SW-10 PIC X. EXEC84.2 +030800 10 WY-OPT-SW-11 PIC X. EXEC84.2 +030900 10 WY-OPT-SW-12 PIC X. EXEC84.2 +031000 10 WY-OPT-SW-13 PIC X. EXEC84.2 +031100 10 WY-OPT-SW-14 PIC X. EXEC84.2 +031200 10 WY-OPT-SW-15 PIC X. EXEC84.2 +031300 10 WY-OPT-SW-16 PIC X. EXEC84.2 +031400 10 WY-OPT-SW-17 PIC X. EXEC84.2 +031500 10 WY-OPT-SW-18 PIC X. EXEC84.2 +031600 10 WY-OPT-SW-19 PIC X. EXEC84.2 +031700 10 WY-OPT-SW-20 PIC X. EXEC84.2 +031800 10 WY-OPT-SW-21 PIC X. EXEC84.2 +031900 10 WY-OPT-SW-22 PIC X. EXEC84.2 +032000 10 WY-OPT-SW-23 PIC X. EXEC84.2 +032100 10 WY-OPT-SW-24 PIC X. EXEC84.2 +032200 10 WY-OPT-SW-25 PIC X. EXEC84.2 +032300 10 WY-OPT-SW-26 PIC X. EXEC84.2 +032400 05 FILLER REDEFINES WY-OPTION-SWITCHES.EXEC84.2 +032500 10 WY-OPT-SW PIC X EXEC84.2 +032600 OCCURS 26. EXEC84.2 +032700 05 WY-PRINT-SWITCHES. EXEC84.2 +032800 10 WY-EXTRACT-ALL PIC X. EXEC84.2 +032900 10 WY-EXTRACT-AUTO PIC X. EXEC84.2 +033000 10 WY-EXTRACT-MAN PIC X. EXEC84.2 +033100 10 WY-KILL-DELETIONS PIC X. EXEC84.2 +033200 10 WY-LIST-NO-UPDATES PIC X. EXEC84.2 +033300 10 WY-LIST-X-CARDS PIC X. EXEC84.2 +033400 10 WY-LIST-PROGRAMS PIC X. EXEC84.2 +033500 10 WY-LIST-COMPACT PIC X. EXEC84.2 +033600 10 WY-NO-DATA PIC X. EXEC84.2 +033700 10 WY-NO-LIBRARY PIC X. EXEC84.2 +033800 10 WY-NO-SOURCE PIC X. EXEC84.2 +033900 10 WY-REMOVE-COMMENTS PIC X. EXEC84.2 +034000 10 WY-NEW-POP PIC X. EXEC84.2 +034100 10 WY-SELECT-PROG PIC X. EXEC84.2 +034200 10 WY-SELECT-MODULE PIC X. EXEC84.2 +034300 10 WY-SELECT-LEVEL PIC X. EXEC84.2 +034400 EXEC84.2 +034500 01 WZ-MISCELLANEOUS. EXEC84.2 +034600 05 WZ-PROGRAM-SELECTED PIC X. EXEC84.2 +034700 05 WZ-END-OF-POPFILE PIC X. EXEC84.2 +034800 05 WZ-FULL-STOP PIC X. EXEC84.2 +034900 05 WZ-DONT-READ-POPFILE PIC X. EXEC84.2 +035000 05 WZ-UPDATE-THIS-PROG PIC X. EXEC84.2 +035100 05 WZ-REPLACE-FLAG PIC X. EXEC84.2 +035200 05 WZ-LINE-UPDATE PIC X. EXEC84.2 +035300 05 WZ-RESEQUENCE-THIS PIC X. EXEC84.2 +035400 05 WZ-RESEQUENCE-NEXT PIC X. EXEC84.2 +035500 05 WZ-END-OF-UPDATES PIC X. EXEC84.2 +035600 05 WZ-OPTIONAL-SELECTED PIC X. EXEC84.2 +035700 05 WZ-DELETE-FLAG PIC X. EXEC84.2 +035800 05 WZ-NOT-THIS-COMMENT PIC X. EXEC84.2 +035900 05 WZ-CURRENT-HEADER PIC X(5). EXEC84.2 +036000 05 WZ-INVALID-DATA. EXEC84.2 +036100 10 FILLER PIC X(20). EXEC84.2 +036200 10 WZ-ERROR-MESSAGE PIC X(60). EXEC84.2 +036300 05 WZ-CURRENT-UPD-PROG. EXEC84.2 +036400 10 WZ-UPD-PROG-CHAR PIC X. EXEC84.2 +036500 10 FILLER PIC X(5). EXEC84.2 +036600 05 WZ-CURRENT-MAIN-PROG. EXEC84.2 +036700 10 WZ-MAIN-PROG-CHAR PIC X OCCURS 6. EXEC84.2 +036800 05 WZ-PROG-BREAK. EXEC84.2 +036900 10 WZ-1CHAR PIC X OCCURS 6. EXEC84.2 +037000 05 WZ-CURRENT-POP-PROG. EXEC84.2 +037100 10 FILLER PIC X(5). EXEC84.2 +037200 10 WZ-PROG-ID-6 PIC X. EXEC84.2 +037300 05 WZ-MAIN-PROG-FLAG PIC X. EXEC84.2 +037400 05 WZ-LINES-COBOL PIC 9(6). EXEC84.2 +037500 05 WZ-LINES-INSERTED PIC 9(6). EXEC84.2 +037600 05 WZ-LINES-REPLACED PIC 9(6). EXEC84.2 +037700 05 WZ-LINES-DELETED PIC 9(6). EXEC84.2 +037800 05 WZ-COMMENTS-DELETED PIC 9(6). EXEC84.2 +037900 05 WZ-CODE-REMOVED PIC 9(6). EXEC84.2 +038000 05 WZ-SOURCE-PROGS PIC 9(6). EXEC84.2 +038100 05 WZ-NEWPOP-PROGS PIC 9(6). EXEC84.2 +038200 05 WZ-PROGS-FOUND PIC 9(6). EXEC84.2 +038300 05 WZ-COMMENTS-DEL PIC 9(6). EXEC84.2 +038400 05 WZ-SEQ-NO PIC 9(6). EXEC84.2 +038500 05 WZ-SAVE-POP-RECORD. EXEC84.2 +038600 10 WZ-SAVE-SEQ PIC X(6). EXEC84.2 +038700 10 FILLER PIC X(5). EXEC84.2 +038800 10 WZ-SAVE-12-20. EXEC84.2 +038900 15 WZ-SAVE-12-15 PIC X(4). EXEC84.2 +039000 15 FILLER PIC X(5). EXEC84.2 +039100 10 FILLER PIC X(60). EXEC84.2 +039200 05 WZ-PAGE-CT PIC 9(6). EXEC84.2 +039300 05 WZ-LINE-CT PIC 9(6). EXEC84.2 +039400 05 WZ-MODULE PIC XX. EXEC84.2 +039500 05 WZ-LEVEL PIC X. EXEC84.2 +039600 05 WZ-PRINT-HOLD PIC X(132). EXEC84.2 +039700 05 WZ-X-CARD. EXEC84.2 +039800 10 WZ-X-CHAR PIC X EXEC84.2 +039900 OCCURS 60. EXEC84.2 +040000 05 WZ-WITHIN-DELETE-SERIES-FLAG PIC X. EXEC84.2 +040100 01 WZ-VERSION-CARD. EXEC84.2 +040200 10 FILLER PIC X(55) VALUE EXEC84.2 +040300 "CCVS85 VERSION 4.2 01 OCT 1992 0032 ". EXEC84.2 +040400 01 WZ-VERSION-CONTROL REDEFINES WZ-VERSION-CARD. EXEC84.2 +040500 10 FILLER PIC X(16). EXEC84.2 +040600 10 WZ-VERSION-NUM PIC X(3). EXEC84.2 +040700 10 FILLER PIC X(3). EXEC84.2 +040800 10 WZ-VERSION-DATE PIC X(11). EXEC84.2 +040900 EXEC84.2 +041000/ EXEC84.2 +041100 PROCEDURE DIVISION. EXEC84.2 +041200*================== EXEC84.2 +041300* EXEC84.2 +041400 A10-MAIN SECTION. EXEC84.2 +041500*================ EXEC84.2 +041600* EXEC84.2 +041700**************************************************************** EXEC84.2 +041800* THIS IS THE HIGHEST LEVEL CONTROL MODULE * EXEC84.2 +041900* * EXEC84.2 +042000**************************************************************** EXEC84.2 +042100 A10-1-MAIN. EXEC84.2 +042200 PERFORM B10-INITIALISE. EXEC84.2 +042300 EXEC84.2 +042400 PERFORM C10-PROCESS-MONITOR. EXEC84.2 +042500 EXEC84.2 +042600 PERFORM D10-MERGE-UPDATE-CARDS. EXEC84.2 +042700 EXEC84.2 +042800 PERFORM E10-TERMINATE. EXEC84.2 +042900 EXEC84.2 +043000 A10-EXIT. EXEC84.2 +043100 EXIT. EXEC84.2 +043200 EXEC84.2 +043300/ EXEC84.2 +043400 B10-INITIALISE SECTION. EXEC84.2 +043500*====================== EXEC84.2 +043600* EXEC84.2 +043700**************************************************************** EXEC84.2 +043800* THIS SECTION INITIALIZES THE OPTION SWITCH AND X-CARD FIELDS * EXEC84.2 +043900* PRIOR TO READING IN CONTROL CARD FILE. * EXEC84.2 +044000* * EXEC84.2 +044100* * EXEC84.2 +044200* * EXEC84.2 +044300* * EXEC84.2 +044400**************************************************************** EXEC84.2 +044500 B10-1-INIT-OPTION-SWITCHES. EXEC84.2 +044600 MOVE SPACES TO WZ-MISCELLANEOUS. EXEC84.2 +044700 MOVE SPACES TO WF-PROGRAM-SELECTED-TABLE. EXEC84.2 +044800 MOVE SPACES TO WG-MODULE-SELECTED-TABLE. EXEC84.2 +044900 MOVE SPACES TO WY-SWITCHES. EXEC84.2 +045000 MOVE "A" TO WY-OPT-SW-1. EXEC84.2 +045100 MOVE "E" TO WY-OPT-SW-2. EXEC84.2 +045200 MOVE "H" TO WY-OPT-SW-3. EXEC84.2 +045300 MOVE "L" TO WY-OPT-SW-4. EXEC84.2 +045400 MOVE "Y" TO WY-OPT-SW-7. EXEC84.2 +045500 MOVE "T" TO WY-OPT-SW-11. EXEC84.2 +045600 EXEC84.2 +045700 B10-2-INIT-X-CARDS. EXEC84.2 +045800 MOVE ZERO TO SUB1. EXEC84.2 +045900 MOVE ZERO TO SUB6. EXEC84.2 +046000 MOVE ZERO TO SUB7. EXEC84.2 +046100 MOVE 1 TO SUB5. EXEC84.2 +046200 PERFORM B20-INIT-X-CARDS 200 TIMES. EXEC84.2 +046300 MOVE " OMITTED" TO WX-X-CARD (84). EXEC84.2 +046400 MOVE ZERO TO WZ-LINES-COBOL. EXEC84.2 +046500 MOVE ZERO TO WZ-LINES-INSERTED. EXEC84.2 +046600 MOVE ZERO TO WZ-LINES-REPLACED. EXEC84.2 +046700 MOVE ZERO TO WZ-LINES-DELETED. EXEC84.2 +046800 MOVE ZERO TO WZ-COMMENTS-DELETED. EXEC84.2 +046900 MOVE ZERO TO WZ-CODE-REMOVED. EXEC84.2 +047000 MOVE ZERO TO WZ-SOURCE-PROGS. EXEC84.2 +047100 MOVE ZERO TO WZ-NEWPOP-PROGS. EXEC84.2 +047200 MOVE ZERO TO WZ-PROGS-FOUND. EXEC84.2 +047300 MOVE ZERO TO WZ-COMMENTS-DEL. EXEC84.2 +047400 MOVE ZERO TO WZ-SEQ-NO. EXEC84.2 +047500 MOVE ZERO TO WZ-PAGE-CT. EXEC84.2 +047600 MOVE ZERO TO WZ-LINE-CT. EXEC84.2 +047700 ACCEPT WA-DATE FROM DATE. EXEC84.2 +047800 B10-EXIT. EXEC84.2 +047900 EXIT. EXEC84.2 +048000 EXEC84.2 +048100 EXEC84.2 +048200 EXEC84.2 +048300 EXEC84.2 +048400 B20-INIT-X-CARDS SECTION. EXEC84.2 +048500*======================== EXEC84.2 +048600 B20-1-INIT. EXEC84.2 +048700 ADD 1 TO SUB1. EXEC84.2 +048800 MOVE "**** X-CARD UNDEFINED ****" TO WX-X-CARD (SUB1). EXEC84.2 +048900 MOVE ZERO TO WX-PROG-POS (SUB1). EXEC84.2 +049000 EXEC84.2 +049100 B20-EXIT. EXEC84.2 +049200 EXIT. EXEC84.2 +049300/ EXEC84.2 +049400 C10-PROCESS-MONITOR SECTION. EXEC84.2 +049500*=========================== EXEC84.2 +049600 EXEC84.2 +049700**************************************************************** EXEC84.2 +049800* THIS SECTION PROCESSES THE RECORDS COMMENCING WITH "*" * EXEC84.2 +049900* AND "X-" (THE MONITOR PART OF THE INPUT FILE ) AND READS * EXEC84.2 +050000* THE FIRST "*START" UPDATE RECORD. * EXEC84.2 +050100* * EXEC84.2 +050200* PERFORMED BY A10-MAIN * EXEC84.2 +050300* PERFORMS C20-PROCESS-STAR-CARDS * EXEC84.2 +050400* C30-CHECK-COMBINATIONS * EXEC84.2 +050500* C40-PROCESS-X-CARDS * EXEC84.2 +050600**************************************************************** EXEC84.2 +050700 C10-1-OPEN-FILES. EXEC84.2 +050800 OPEN OUTPUT PRINT-FILE. EXEC84.2 +050900 MOVE SPACES TO PRINT-REC. EXEC84.2 +051000 OPEN INPUT CONTROL-CARD-FILE. EXEC84.2 +051100 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +051200 AT END MOVE "CONTROL-CARD-FILE IS EMPTY" EXEC84.2 +051300 TO PRINT-DATA EXEC84.2 +051400 PERFORM X20-PRINT-DETAIL EXEC84.2 +051500 STOP RUN. EXEC84.2 +051600 PERFORM C20-PROCESS-STAR-CARDS EXEC84.2 +051700 UNTIL WB-X-HYPHEN = "X-". EXEC84.2 +051800 PERFORM C30-CHECK-COMBINATIONS. EXEC84.2 +051900 PERFORM C40-PROCESS-X-CARDS EXEC84.2 +052000 UNTIL WB-12 = "*END-MONITOR". EXEC84.2 +052100 EXEC84.2 +052200 PERFORM C50-PRINT-OPTIONS. EXEC84.2 +052300 EXEC84.2 +052400 C10-10-GET-FIRST-START-CARD. EXEC84.2 +052500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +052600 AT END MOVE "NO BEGIN-UPDATE CARD FOUND" EXEC84.2 +052700 TO PRINT-DATA EXEC84.2 +052800 PERFORM X20-PRINT-DETAIL EXEC84.2 +052900 STOP RUN. EXEC84.2 +053000 IF WB-13 NOT = "*BEGIN-UPDATE" EXEC84.2 +053100 MOVE "*BEGIN-UPDATE CARD MISSING" EXEC84.2 +053200 TO PRINT-DATA EXEC84.2 +053300 PERFORM X20-PRINT-DETAIL EXEC84.2 +053400 STOP RUN. EXEC84.2 +053500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +053600 AT END MOVE "NO END-UPDATE CARD FOUND" EXEC84.2 +053700 TO PRINT-DATA EXEC84.2 +053800 PERFORM X20-PRINT-DETAIL EXEC84.2 +053900 STOP RUN. EXEC84.2 +054000 IF WB-11 = "*END-UPDATE" EXEC84.2 +054100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 +054200 GO TO C10-EXIT. EXEC84.2 +054300 IF WB-STAR-START = "*START" EXEC84.2 +054400 PERFORM C60-START-CARD. EXEC84.2 +054500 EXEC84.2 +054600 C10-EXIT. EXEC84.2 +054700 EXIT. EXEC84.2 +054800/ EXEC84.2 +054900 C20-PROCESS-STAR-CARDS SECTION. EXEC84.2 +055000*============================== EXEC84.2 +055100* EXEC84.2 +055200**************************************************************** EXEC84.2 +055300* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * EXEC84.2 +055400* WHICH START WITH AN ASTERISK IN COLUMN 1 AND SETS VARIOUS * EXEC84.2 +055500* FLAGS WHICH CONTROL THE WAY THIS EXECUTIVE ROUTINE WORKS. * EXEC84.2 +055600* * EXEC84.2 +055700* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 +055800* PERFORMS C25-SET-FLAGS * EXEC84.2 +055900**************************************************************** EXEC84.2 +056000 C20-1-UPDATE-CHECK. EXEC84.2 +056100 IF WB-13 = "*BEGIN-UPDATE" EXEC84.2 +056200 MOVE WB-13 TO WZ-INVALID-DATA EXEC84.2 +056300 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 +056400 TO WZ-ERROR-MESSAGE EXEC84.2 +056500 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 +056600 PERFORM X20-PRINT-DETAIL EXEC84.2 +056700 STOP RUN. EXEC84.2 +056800 EXEC84.2 +056900 IF WB-6 = "*START" EXEC84.2 +057000 MOVE WB-6 TO WZ-INVALID-DATA EXEC84.2 +057100 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 +057200 TO WZ-ERROR-MESSAGE EXEC84.2 +057300 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 +057400 PERFORM X20-PRINT-DETAIL EXEC84.2 +057500 STOP RUN. EXEC84.2 +057600 EXEC84.2 +057700 IF WB-11 = "*END-UPDATE" EXEC84.2 +057800 MOVE WB-11 TO WZ-INVALID-DATA EXEC84.2 +057900 MOVE "ENCOUNTERED BEFORE *END-MONITOR CARD" EXEC84.2 +058000 TO WZ-ERROR-MESSAGE EXEC84.2 +058100 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 +058200 PERFORM X20-PRINT-DETAIL EXEC84.2 +058300 STOP RUN. EXEC84.2 +058400 EXEC84.2 +058500 PERFORM C25-SET-FLAGS. EXEC84.2 +058600 EXEC84.2 +058700 C20-EXIT. EXEC84.2 +058800 EXIT. EXEC84.2 +058900 EXEC84.2 +059000/ EXEC84.2 +059100 C25-SET-FLAGS SECTION. EXEC84.2 +059200*===================== EXEC84.2 +059300 C25-1. EXEC84.2 +059400 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 +059500 PERFORM X20-PRINT-DETAIL. EXEC84.2 +059600 IF WB-12 = "*EXTRACT-ALL" EXEC84.2 +059700 MOVE "Y" TO WY-EXTRACT-ALL. EXEC84.2 +059800 IF WB-13 = "*EXTRACT-AUTO" EXEC84.2 +059900 MOVE "Y" TO WY-EXTRACT-AUTO. EXEC84.2 +060000 IF WB-12 = "*EXTRACT-MAN" EXEC84.2 +060100 MOVE "Y" TO WY-EXTRACT-MAN. EXEC84.2 +060200 IF WB-15 = "*KILL-DELETIONS" EXEC84.2 +060300 MOVE "Y" TO WY-KILL-DELETIONS. EXEC84.2 +060400 IF WB-16 = "*LIST NO-UPDATES" EXEC84.2 +060500 MOVE "Y" TO WY-LIST-NO-UPDATES. EXEC84.2 +060600 IF WB-13 = "*LIST X-CARDS" EXEC84.2 +060700 MOVE "Y" TO WY-LIST-X-CARDS. EXEC84.2 +060800 IF WB-14 = "*LIST PROGRAMS" EXEC84.2 +060900 MOVE "Y" TO WY-LIST-PROGRAMS. EXEC84.2 +061000 IF WB-13 = "*LIST COMPACT" EXEC84.2 +061100 MOVE "Y" TO WY-LIST-COMPACT. EXEC84.2 +061200 IF WB-8 = "*NO-DATA" EXEC84.2 +061300 MOVE "Y" TO WY-NO-DATA. EXEC84.2 +061400 IF WB-11 = "*NO-LIBRARY" EXEC84.2 +061500 MOVE "Y" TO WY-NO-LIBRARY. EXEC84.2 +061600 IF WB-10 = "*NO-SOURCE" EXEC84.2 +061700 MOVE "Y" TO WY-NO-SOURCE. EXEC84.2 +061800 IF WB-16 = "*REMOVE-COMMENTS" EXEC84.2 +061900 MOVE "Y" TO WY-REMOVE-COMMENTS. EXEC84.2 +062000 IF WB-8 = "*NEW-POP" EXEC84.2 +062100 MOVE "Y" TO WY-NEW-POP. EXEC84.2 +062200 IF WB-4 = "*OPT" EXEC84.2 +062300 MOVE WB-X TO WY-OPT-SW (WB-NN). EXEC84.2 +062400 IF WB-14 = "*SELECT-MODULE" EXEC84.2 +062500 IF WB-MODULE = SPACE EXEC84.2 +062600 MOVE "SELECTED MODULE NOT SPECIFIED" EXEC84.2 +062700 TO PRINT-DATA EXEC84.2 +062800 PERFORM X20-PRINT-DETAIL EXEC84.2 +062900 STOP RUN. EXEC84.2 +063000 EXEC84.2 +063100 IF WB-14 = "*SELECT-MODULE" EXEC84.2 +063200 ADD 1 TO SUB6 EXEC84.2 +063300 IF SUB6 > 10 EXEC84.2 +063400 MOVE "MORE THAN 10 MODULES SELECTED" EXEC84.2 +063500 TO PRINT-DATA EXEC84.2 +063600 PERFORM X20-PRINT-DETAIL EXEC84.2 +063700 STOP RUN EXEC84.2 +063800 ELSE EXEC84.2 +063900 MOVE "Y" TO WY-SELECT-MODULE EXEC84.2 +064000 MOVE WB-MODULE EXEC84.2 +064100 TO WG-MODULE-SELECTED (SUB6) EXEC84.2 +064200 MOVE WB-LEVEL TO WG-MODULE-LEVEL (SUB6). EXEC84.2 +064300 IF WB-12 = "*SELECT-PROG" EXEC84.2 +064400 ADD 1 TO SUB7 EXEC84.2 +064500 IF SUB7 > 50 EXEC84.2 +064600 MOVE "MORE THAN 50 RECORDS SELECTED" EXEC84.2 +064700 TO PRINT-DATA EXEC84.2 +064800 PERFORM X20-PRINT-DETAIL EXEC84.2 +064900 STOP RUN EXEC84.2 +065000 ELSE EXEC84.2 +065100 MOVE "Y" TO WY-SELECT-PROG EXEC84.2 +065200 MOVE WB-PROG EXEC84.2 +065300 TO WF-PROGRAM-SELECTED (SUB7). EXEC84.2 +065400 EXEC84.2 +065500 C25-10-READ-FILE. EXEC84.2 +065600 MOVE SPACES TO WB-CONTROL-DATA. EXEC84.2 +065700 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +065800 AT END MOVE "*END-MONITOR NOT ENCOUNTERED" EXEC84.2 +065900 TO PRINT-DATA EXEC84.2 +066000 PERFORM X20-PRINT-DETAIL EXEC84.2 +066100 STOP RUN. EXEC84.2 +066200 C25-EXIT. EXEC84.2 +066300 EXIT. EXEC84.2 +066400/ EXEC84.2 +066500 C30-CHECK-COMBINATIONS SECTION. EXEC84.2 +066600*============================== EXEC84.2 +066700* EXEC84.2 +066800**************************************************************** EXEC84.2 +066900* THIS SECTION CHECKS FOR ANY INVALID COMBINATIONS OF * EXEC84.2 +067000* CARDS INPUT WITH AN ASTERISK IN COLUMN 1. * EXEC84.2 +067100* * EXEC84.2 +067200* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 +067300* PERFORMS NONE * EXEC84.2 +067400**************************************************************** EXEC84.2 +067500 C30-1-SELECTION-CHECK. EXEC84.2 +067600 IF WY-EXTRACT-ALL = SPACE EXEC84.2 +067700 GO TO C30-10. EXEC84.2 +067800 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 +067900 MOVE "ALL AND AUTO PROGRAMS SELECTED" EXEC84.2 +068000 TO PRINT-DATA EXEC84.2 +068100 PERFORM X20-PRINT-DETAIL EXEC84.2 +068200 STOP RUN. EXEC84.2 +068300 EXEC84.2 +068400 C30-10. EXEC84.2 +068500 IF WY-EXTRACT-ALL = SPACE EXEC84.2 +068600 GO TO C30-20. EXEC84.2 +068700 IF WY-EXTRACT-MAN = "Y" EXEC84.2 +068800 MOVE "ALL AND MANUAL PROGRAMS SELECTED" EXEC84.2 +068900 TO PRINT-DATA EXEC84.2 +069000 PERFORM X20-PRINT-DETAIL EXEC84.2 +069100 STOP RUN. EXEC84.2 +069200 EXEC84.2 +069300 C30-20. EXEC84.2 +069400 IF WY-LIST-PROGRAMS = SPACE EXEC84.2 +069500 GO TO C30-30. EXEC84.2 +069600 IF WY-LIST-NO-UPDATES = SPACE EXEC84.2 +069700 MOVE "BOTH UPDATES AND PROGRAMS SELECTED" EXEC84.2 +069800 TO PRINT-DATA EXEC84.2 +069900 PERFORM X20-PRINT-DETAIL EXEC84.2 +070000 STOP RUN. EXEC84.2 +070100 EXEC84.2 +070200 C30-30. EXEC84.2 +070300 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 +070400 GO TO C30-40-CHECK-FOR-NEW-FILE. EXEC84.2 +070500 IF WY-EXTRACT-MAN = "Y" EXEC84.2 +070600 MOVE "AUTO AND MANUAL PROGRAMS SELECTED" EXEC84.2 +070700 TO PRINT-DATA EXEC84.2 +070800 PERFORM X20-PRINT-DETAIL EXEC84.2 +070900 STOP RUN. EXEC84.2 +071000 EXEC84.2 +071100 C30-40-CHECK-FOR-NEW-FILE. EXEC84.2 +071200 IF WY-NO-SOURCE = SPACE EXEC84.2 +071300 GO TO C30-50. EXEC84.2 +071400 IF WY-NEW-POP = "Y" EXEC84.2 +071500 GO TO C30-50. EXEC84.2 +071600 MOVE "NO SOURCE OR UPDATED POPFILE SELECTED" TO PRINT-DATA.EXEC84.2 +071700 PERFORM X20-PRINT-DETAIL EXEC84.2 +071800 STOP RUN. EXEC84.2 +071900 EXEC84.2 +072000 C30-50. EXEC84.2 +072100 IF WY-EXTRACT-ALL = "Y" EXEC84.2 +072200 GO TO C30-55. EXEC84.2 +072300 IF WY-EXTRACT-MAN = "Y" EXEC84.2 +072400 GO TO C30-55. EXEC84.2 +072500 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 +072600 GO TO C30-60. EXEC84.2 +072700 C30-55. EXEC84.2 +072800 IF WY-SELECT-PROG = "Y" EXEC84.2 +072900 MOVE "SINGLE PROGRAM SELECTED WITH ALL/AUTO/MANUAL" EXEC84.2 +073000 TO PRINT-DATA EXEC84.2 +073100 PERFORM X20-PRINT-DETAIL EXEC84.2 +073200 STOP RUN. EXEC84.2 +073300 IF WY-SELECT-MODULE = "Y" EXEC84.2 +073400 MOVE "SINGLE MODULE SELECTED WITH ALL/AUTO/MANUAL" EXEC84.2 +073500 TO PRINT-DATA EXEC84.2 +073600 PERFORM X20-PRINT-DETAIL EXEC84.2 +073700 STOP RUN. EXEC84.2 +073800 EXEC84.2 +073900 C30-60. EXEC84.2 +074000 IF WY-SELECT-PROG = SPACE EXEC84.2 +074100 GO TO C30-70. EXEC84.2 +074200 IF WY-SELECT-MODULE = "Y" EXEC84.2 +074300 MOVE "SINGLE MODULE AND SINGLE PROGRAM SELECTED" EXEC84.2 +074400 TO PRINT-DATA EXEC84.2 +074500 PERFORM X20-PRINT-DETAIL EXEC84.2 +074600 STOP RUN. EXEC84.2 +074700 EXEC84.2 +074800 EXEC84.2 +074900 C30-70. EXEC84.2 +075000 IF WY-EXTRACT-ALL = SPACE EXEC84.2 +075100 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 +075200 IF WY-EXTRACT-MAN = SPACE EXEC84.2 +075300 IF WY-SELECT-PROG = SPACE EXEC84.2 +075400 IF WY-SELECT-MODULE = SPACE EXEC84.2 +075500 MOVE "NO PROGRAMS SELECTED" EXEC84.2 +075600 TO PRINT-DATA EXEC84.2 +075700 PERFORM X20-PRINT-DETAIL EXEC84.2 +075800 STOP RUN. EXEC84.2 +075900 EXEC84.2 +076000 C30-EXIT. EXEC84.2 +076100 EXIT. EXEC84.2 +076200/ EXEC84.2 +076300 C40-PROCESS-X-CARDS SECTION. EXEC84.2 +076400*=========================== EXEC84.2 +076500* EXEC84.2 +076600**************************************************************** EXEC84.2 +076700* THIS SECTION PROCESSES THE INPUT PARAMETER FILE RECORDS * EXEC84.2 +076800* WHICH START WITH AN "X" IN COLUMN 1 AND SETS A TABLE WHICH* EXEC84.2 +076900* CONTAINS TEXT TO BE SUBSTITUTED BY THIS EXECUTIVE ROUTINE.* EXEC84.2 +077000* * EXEC84.2 +077100* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 +077200* PERFORMS NONE * EXEC84.2 +077300**************************************************************** EXEC84.2 +077400 C40-1-PROCESS-CARD. EXEC84.2 +077500 IF WB-X-HYPHEN NOT = "X-" EXEC84.2 +077600 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA EXEC84.2 +077700 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE EXEC84.2 +077800 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 +077900 PERFORM X20-PRINT-DETAIL EXEC84.2 +078000 GO TO C40-90-READ-FILE. EXEC84.2 +078100 EXEC84.2 +078200 IF WB-X-CARD-NUM > 200 EXEC84.2 +078300 MOVE "INVALID X-CARD:" TO WZ-INVALID-DATA EXEC84.2 +078400 MOVE WB-CONTROL-DATA TO WZ-ERROR-MESSAGE EXEC84.2 +078500 MOVE WZ-INVALID-DATA TO PRINT-DATA EXEC84.2 +078600 PERFORM X20-PRINT-DETAIL EXEC84.2 +078700 GO TO C40-90-READ-FILE. EXEC84.2 +078800 EXEC84.2 +078900 C40-20-MOVE-DATA. EXEC84.2 +079000 MOVE WB-SUBS-TEXT TO WX-X-CARD (WB-X-CARD-NUM). EXEC84.2 +079100 IF WB-PROG-POS = SPACES EXEC84.2 +079200 GO TO C40-30-MOVE-DATA. EXEC84.2 +079300 IF WB-PROG-POS-NUM < 55 EXEC84.2 +079400 MOVE WB-PROG-POS-NUM EXEC84.2 +079500 TO WX-PROG-POS (WB-X-CARD-NUM). EXEC84.2 +079600 EXEC84.2 +079700 C40-30-MOVE-DATA. EXEC84.2 +079800 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 +079900 PERFORM X20-PRINT-DETAIL. EXEC84.2 +080000 EXEC84.2 +080100 C40-90-READ-FILE. EXEC84.2 +080200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +080300 AT END MOVE EXEC84.2 +080400 "*BEGIN-UPDATE AND *END-UPDATE CARDS NOT ENCOUNTERED" EXEC84.2 +080500 TO PRINT-DATA EXEC84.2 +080600 PERFORM X20-PRINT-DETAIL EXEC84.2 +080700 STOP RUN. EXEC84.2 +080800 EXEC84.2 +080900 C40-EXIT. EXEC84.2 +081000 EXIT. EXEC84.2 +081100 EXEC84.2 +081200/ EXEC84.2 +081300 C50-PRINT-OPTIONS SECTION. EXEC84.2 +081400*========================= EXEC84.2 +081500* EXEC84.2 +081600**************************************************************** EXEC84.2 +081700* THIS SECTION PRINTS DETAILS OF THE PROCESSING OPTIONS * EXEC84.2 +081800* SELECTED BY THE VARIOUS CONTROL CARDS INPUT * EXEC84.2 +081900* * EXEC84.2 +082000* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 +082100* PERFORMS NONE * EXEC84.2 +082200**************************************************************** EXEC84.2 +082300 C50-1-PRINT-OPTION-SWITCHES. EXEC84.2 +082400 WRITE PRINT-REC FROM WV-OPTION-HEADING AFTER PAGE. EXEC84.2 +082500 WRITE PRINT-REC FROM WV-OPT-1 AFTER 1. EXEC84.2 +082600 WRITE PRINT-REC FROM WV-OPT-2 AFTER 1. EXEC84.2 +082700 MOVE SPACES TO WV-OPT-SWITCHES. EXEC84.2 +082800 MOVE ZERO TO SUB1. EXEC84.2 +082900 PERFORM C50-4 26 TIMES. EXEC84.2 +083000 GO TO C50-5. EXEC84.2 +083100 C50-4. EXEC84.2 +083200* PERFORM 26 TIMES EXEC84.2 +083300 ADD 1 TO SUB1 EXEC84.2 +083400 MOVE WY-OPT-SW (SUB1) TO WV-OPT (SUB1). EXEC84.2 +083500* END-PERFORM. EXEC84.2 +083600 C50-5. EXEC84.2 +083700 WRITE PRINT-REC FROM WV-OPT-SWITCHES AFTER 1. EXEC84.2 +083800 EXEC84.2 +083900 C50-20-LISTING-OPTIONS. EXEC84.2 +084000 IF WY-LIST-NO-UPDATES = "Y" EXEC84.2 +084100 MOVE "UPDATES WILL NOT BE REPORTED" TO PRINT-DATA EXEC84.2 +084200 ELSE EXEC84.2 +084300 MOVE "UPDATES WILL BE REPORTED" TO PRINT-DATA. EXEC84.2 +084400 WRITE PRINT-REC AFTER 3. EXEC84.2 +084500 EXEC84.2 +084600 IF WY-LIST-X-CARDS = "Y" EXEC84.2 +084700 MOVE "X-CARD SUBSTITUTIONS WILL BE SHOWN" EXEC84.2 +084800 TO PRINT-DATA EXEC84.2 +084900 ELSE EXEC84.2 +085000 MOVE "X-CARD SUBSTITUTIONS WILL NOT BE SHOWN" EXEC84.2 +085100 TO PRINT-DATA. EXEC84.2 +085200 WRITE PRINT-REC AFTER 1. EXEC84.2 +085300 EXEC84.2 +085400 IF WY-LIST-PROGRAMS = "Y" EXEC84.2 +085500 MOVE "PROGRAM LISTINGS WILL BE PRINTED" EXEC84.2 +085600 TO PRINT-DATA EXEC84.2 +085700 ELSE EXEC84.2 +085800 MOVE "PROGRAM LISTINGS WILL NOT BE PRINTED" EXEC84.2 +085900 TO PRINT-DATA. EXEC84.2 +086000 WRITE PRINT-REC AFTER 1. EXEC84.2 +086100 EXEC84.2 +086200 IF WY-LIST-COMPACT = "Y" EXEC84.2 +086300 MOVE "REPORT WILL BE COMPRESSED" TO PRINT-DATA EXEC84.2 +086400 ELSE EXEC84.2 +086500 MOVE "REPORT WILL BE EXPANDED" TO PRINT-DATA. EXEC84.2 +086600 WRITE PRINT-REC AFTER 1. EXEC84.2 +086700 EXEC84.2 +086800 IF WY-NO-SOURCE = "Y" EXEC84.2 +086900 MOVE "SOURCE FILE WILL BE SUPPRESSED" TO PRINT-DATAEXEC84.2 +087000 ELSE EXEC84.2 +087100 MOVE "SOURCE FILE WILL BE CREATED" TO PRINT-DATA. EXEC84.2 +087200 WRITE PRINT-REC AFTER 1. EXEC84.2 +087300 EXEC84.2 +087400 IF WY-NEW-POP = "Y" EXEC84.2 +087500 MOVE "NEW POPULATION FILE WILL BE CREATED" EXEC84.2 +087600 TO PRINT-DATA EXEC84.2 +087700 ELSE EXEC84.2 +087800 MOVE "NEW POPULATION FILE WILL BE SUPPRESSED" EXEC84.2 +087900 TO PRINT-DATA. EXEC84.2 +088000 WRITE PRINT-REC AFTER 1. EXEC84.2 +088100 EXEC84.2 +088200 EXEC84.2 +088300 C50-30. EXEC84.2 +088400 IF WY-NO-LIBRARY = "Y" EXEC84.2 +088500 MOVE "LIBRARY NOT SELECTED" EXEC84.2 +088600 TO PRINT-DATA EXEC84.2 +088700 ELSE EXEC84.2 +088800 MOVE "LIBRARY FILES WILL BE SELECTED" EXEC84.2 +088900 TO PRINT-DATA. EXEC84.2 +089000 WRITE PRINT-REC AFTER 1. EXEC84.2 +089100 EXEC84.2 +089200 C50-35. EXEC84.2 +089300 IF WY-NO-DATA = "Y" EXEC84.2 +089400 MOVE "DATA BLOCKS WILL BE IGNORED" EXEC84.2 +089500 TO PRINT-DATA EXEC84.2 +089600 ELSE EXEC84.2 +089700 MOVE "DATA BLOCKS WILL BE SENT TO SOURCE FILE" EXEC84.2 +089800 TO PRINT-DATA. EXEC84.2 +089900 WRITE PRINT-REC AFTER 1. EXEC84.2 +090000 EXEC84.2 +090100 C50-40. EXEC84.2 +090200 IF WY-EXTRACT-ALL = "Y" EXEC84.2 +090300 MOVE "ALL PROGRAMS SELECTED" TO PRINT-DATA. EXEC84.2 +090400 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 +090500 MOVE "ALL AUTOMATIC PROGRAMS SELECTED" EXEC84.2 +090600 TO PRINT-DATA. EXEC84.2 +090700 IF WY-EXTRACT-MAN = "Y" EXEC84.2 +090800 MOVE "ALL MANUAL PROGRAMS SELECTED" EXEC84.2 +090900 TO PRINT-DATA. EXEC84.2 +091000 IF WY-SELECT-PROG = "Y" EXEC84.2 +091100 MOVE "SEPARATE PROGRAMS SELECTED" EXEC84.2 +091200 TO PRINT-DATA. EXEC84.2 +091300 IF WY-SELECT-MODULE = "Y" EXEC84.2 +091400 MOVE "SEPARATE MODULES SELECTED" EXEC84.2 +091500 TO PRINT-DATA. EXEC84.2 +091600 WRITE PRINT-REC AFTER 1. EXEC84.2 +091700 EXEC84.2 +091800 IF WY-REMOVE-COMMENTS = "Y" EXEC84.2 +091900 MOVE "COMMENT LINES WILL BE REMOVED" EXEC84.2 +092000 TO PRINT-DATA EXEC84.2 +092100 ELSE EXEC84.2 +092200 MOVE "COMMENT LINES WILL BE RETAINED" EXEC84.2 +092300 TO PRINT-DATA. EXEC84.2 +092400 WRITE PRINT-REC AFTER 1. EXEC84.2 +092500 EXEC84.2 +092600 EXEC84.2 +092700 IF WY-KILL-DELETIONS = "Y" EXEC84.2 +092800 MOVE "UNUSED OPTIONAL CODE WILL BE REMOVED" EXEC84.2 +092900 TO PRINT-DATA EXEC84.2 +093000 ELSE EXEC84.2 +093100 MOVE "UNUSED OPTIONAL CODE WILL BE CONVERTED TO COMEXEC84.2 +093200- "MENTS AND RETAINED" EXEC84.2 +093300 TO PRINT-DATA. EXEC84.2 +093400 WRITE PRINT-REC AFTER 1. EXEC84.2 +093500 EXEC84.2 +093600 C50-EXIT. EXEC84.2 +093700 EXIT. EXEC84.2 +093800 EXEC84.2 +093900/ EXEC84.2 +094000 C60-START-CARD SECTION. EXEC84.2 +094100*====================== EXEC84.2 +094200* EXEC84.2 +094300**************************************************************** EXEC84.2 +094400* WHEN A "*START" CARD IS READ THIS SECTION INITIALISES * EXEC84.2 +094500* VARIOUS FIELDS AND SETS CERTAIN FLAGS. * EXEC84.2 +094600* * EXEC84.2 +094700* PERFORMED BY C10-PROCESS-MONITOR * EXEC84.2 +094800* D62-SERIES-UPDATE * EXEC84.2 +094900* D67-LINE-UPDATE * EXEC84.2 +095000* D68-LINE-EQUAL * EXEC84.2 +095100* D69-LINE-BLANK-OR-LESS * EXEC84.2 +095200* D40-ANY-UPDATES EXEC84.2 +095300* PERFORMS NONE * EXEC84.2 +095400**************************************************************** EXEC84.2 +095500 C60-1. EXEC84.2 +095600 EXEC84.2 +095700 MOVE WB-UPDATE-PROG TO WZ-CURRENT-UPD-PROG. EXEC84.2 +095800 EXEC84.2 +095900 IF WZ-CURRENT-UPD-PROG = WZ-CURRENT-POP-PROG EXEC84.2 +096000 MOVE "Y" TO WZ-UPDATE-THIS-PROG EXEC84.2 +096100 ELSE EXEC84.2 +096200 MOVE SPACE TO WZ-UPDATE-THIS-PROG. EXEC84.2 +096300 EXEC84.2 +096400 C60-EXIT. EXEC84.2 +096500 EXIT. EXEC84.2 +096600/ EXEC84.2 +096700 D10-MERGE-UPDATE-CARDS SECTION. EXEC84.2 +096800*============================== EXEC84.2 +096900* EXEC84.2 +097000**************************************************************** EXEC84.2 +097100* THIS IS THE MAIN CONTROL SECTION FOR THE PROCESSING OF * EXEC84.2 +097200* THE POPULATION FILE. IT OBTAINS THE HEADER FOR THE FIRST * EXEC84.2 +097300* AUDIT ROUTINE IN THE POPFILE AND PROCESSES ALL RECORDS. * EXEC84.2 +097400* * EXEC84.2 +097500* PERFORMED BY A10-MAIN * EXEC84.2 +097600* PERFORMS D11-GET-NEXT-PROGRAM * EXEC84.2 +097700* D15-END-OF-POPFILE * EXEC84.2 +097800* D20-PROCESS-POPFILE * EXEC84.2 +097900**************************************************************** EXEC84.2 +098000 D10-1-OPEN-FILES. EXEC84.2 +098100 IF WY-NEW-POP = "Y" EXEC84.2 +098200 OPEN OUTPUT UPDATED-POPULATION-FILE. EXEC84.2 +098300 EXEC84.2 +098400 IF WY-NO-SOURCE = SPACE EXEC84.2 +098500 OPEN OUTPUT SOURCE-COBOL-PROGRAMS. EXEC84.2 +098600 EXEC84.2 +098700 OPEN INPUT POPULATION-FILE. EXEC84.2 +098800 PERFORM D10-20-GET-VERSION. EXEC84.2 +098900 MOVE WZ-VERSION-CARD TO PRINT-DATA. EXEC84.2 +099000 PERFORM X20-PRINT-DETAIL. EXEC84.2 +099100 EXEC84.2 +099200 D10-10-GET-HEADER. EXEC84.2 +099300 PERFORM D11-GET-NEXT-PROGRAM. EXEC84.2 +099400 EXEC84.2 +099500 PERFORM D20-PROCESS-POPFILE EXEC84.2 +099600 UNTIL WZ-END-OF-POPFILE = "Y". EXEC84.2 +099700 EXEC84.2 +099800 PERFORM D15-END-OF-POPFILE. EXEC84.2 +099900 EXEC84.2 +100000 D10-EXIT. EXEC84.2 +100100 EXIT. EXEC84.2 +100200/ EXEC84.2 +100300 D10-20-GET-VERSION SECTION. EXEC84.2 +100400*============================ EXEC84.2 +100500* EXEC84.2 +100600 D10-20-INIT-VER. EXEC84.2 +100700 MOVE WZ-VERSION-NUM TO WA-VERSION-NUM. EXEC84.2 +100800 MOVE WZ-VERSION-DATE TO WA-VERSION-DATE. EXEC84.2 +100900 EXEC84.2 +101000 D10-20-EXIT. EXEC84.2 +101100 EXIT. EXEC84.2 +101200/ EXEC84.2 +101300 D11-GET-NEXT-PROGRAM SECTION. EXEC84.2 +101400*============================ EXEC84.2 +101500* EXEC84.2 +101600**************************************************************** EXEC84.2 +101700* PERFORMED BY D10-MERGE-UPDATE-CARDS * EXEC84.2 +101800* D30-PROCESS-HEADER * EXEC84.2 +101900**************************************************************** EXEC84.2 +102000 D11-1-READ-POPFILE. EXEC84.2 +102100 MOVE SPACES TO WC-STAR-HEADER. EXEC84.2 +102200 EXEC84.2 +102300 PERFORM X30-READ-POPFILE EXEC84.2 +102400 UNTIL WC-STAR-HEADER = "*HEADER". EXEC84.2 +102500 D11-TEST-END. EXEC84.2 +102600 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 +102700 GO TO D11-EXIT. EXEC84.2 +102800 EXEC84.2 +102900 IF WC-COBOL NOT = "COBOL" EXEC84.2 +103000 IF WC-COBOL = "CLBRY" EXEC84.2 +103100 IF WY-NO-LIBRARY = "Y" EXEC84.2 +103200 GO TO D11-1-READ-POPFILE EXEC84.2 +103300 ELSE EXEC84.2 +103400 NEXT SENTENCE EXEC84.2 +103500 ELSE EXEC84.2 +103600 IF WC-COBOL = "DATA*" EXEC84.2 +103700 IF WY-NO-DATA = "Y" EXEC84.2 +103800 GO TO D11-1-READ-POPFILE EXEC84.2 +103900 ELSE EXEC84.2 +104000 NEXT SENTENCE EXEC84.2 +104100 ELSE EXEC84.2 +104200 GO TO D11-1-READ-POPFILE. EXEC84.2 +104300 EXEC84.2 +104400 D11-EXIT. EXEC84.2 +104500 EXIT. EXEC84.2 +104600/ EXEC84.2 +104700 D15-END-OF-POPFILE SECTION. EXEC84.2 +104800*========================== EXEC84.2 +104900* EXEC84.2 +105000**************************************************************** EXEC84.2 +105100* THIS SECTION PRINTS END OF RUN ACCOUNTING INFORMATION AND * EXEC84.2 +105200* FLAGS ANY OUTSTANDING *UPDATE RECORDS AS UNUSED. * EXEC84.2 +105300* * EXEC84.2 +105400* PERFORMED BY D10-MERGE-UPDATE-CARD * EXEC84.2 +105500* PERFORMS D16-FLAG-UNUSED-UPDATES * EXEC84.2 +105600* X20-PRINT-DETAIL * EXEC84.2 +105700**************************************************************** EXEC84.2 +105800 D15-1-SET-UP-FIELDS. EXEC84.2 +105900 MOVE WZ-PROGS-FOUND TO WA-PROGS-FOUND. EXEC84.2 +106000 MOVE WA-FINAL-LINE-1 TO PRINT-DATA. EXEC84.2 +106100 PERFORM X20-PRINT-DETAIL. EXEC84.2 +106200 EXEC84.2 +106300 IF WY-NO-SOURCE = SPACE EXEC84.2 +106400 MOVE WZ-SOURCE-PROGS TO WA-SOURCE-PROGS EXEC84.2 +106500 MOVE WA-FINAL-LINE-2 TO PRINT-DATA EXEC84.2 +106600 PERFORM X20-PRINT-DETAIL. EXEC84.2 +106700 EXEC84.2 +106800 IF WY-NEW-POP = "Y" EXEC84.2 +106900 MOVE WZ-NEWPOP-PROGS TO WA-NEWPOP-PROGS EXEC84.2 +107000 MOVE WA-FINAL-LINE-3 TO PRINT-DATA EXEC84.2 +107100 PERFORM X20-PRINT-DETAIL. EXEC84.2 +107200 EXEC84.2 +107300 IF WZ-END-OF-UPDATES = SPACE EXEC84.2 +107400 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +107500 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +107600 EXEC84.2 +107700 PERFORM D16-FLAG-UNUSED-UPDATES EXEC84.2 +107800 UNTIL WZ-END-OF-UPDATES = "Y". EXEC84.2 +107900 EXEC84.2 +108000 IF WY-SELECT-PROG = "Y" AND EXEC84.2 +108100 WF-PROGRAM-SELECTED-TABLE NOT = SPACES EXEC84.2 +108200 MOVE "SOME PROGRAMS NOT FOUND" TO PRINT-DATA EXEC84.2 +108300 PERFORM X20-PRINT-DETAIL EXEC84.2 +108400 PERFORM VARYING SUB7 FROM 1 BY 1 UNTIL SUB7 > 50 EXEC84.2 +108500 IF WF-PROGRAM-SELECTED (SUB7) NOT = SPACE EXEC84.2 +108600 MOVE WF-PROGRAM-SELECTED (SUB7) TO PRINT-DATA EXEC84.2 +108700 PERFORM X20-PRINT-DETAIL EXEC84.2 +108800 END-IF EXEC84.2 +108900 END-PERFORM. EXEC84.2 +109000 EXEC84.2 +109100 D15-EXIT. EXEC84.2 +109200 EXIT. EXEC84.2 +109300 EXEC84.2 +109400 EXEC84.2 +109500 EXEC84.2 +109600 EXEC84.2 +109700 D16-FLAG-UNUSED-UPDATES SECTION. EXEC84.2 +109800*=============================== EXEC84.2 +109900 D16-1-PRINT-UPDATES. EXEC84.2 +110000 MOVE WB-CONTROL-DATA TO PRINT-DATA. EXEC84.2 +110100 PERFORM X20-PRINT-DETAIL. EXEC84.2 +110200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +110300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +110400 EXEC84.2 +110500 D16-EXIT. EXEC84.2 +110600 EXIT. EXEC84.2 +110700 EXEC84.2 +110800 EXEC84.2 +110900/ EXEC84.2 +111000 D20-PROCESS-POPFILE SECTION. EXEC84.2 +111100*=========================== EXEC84.2 +111200* EXEC84.2 +111300**************************************************************** EXEC84.2 +111400* THIS IS THE MAIN CONTROL SECTION FOR POPULATION FILE * EXEC84.2 +111500* PROCESSING. * EXEC84.2 +111600* * EXEC84.2 +111700* PERFORMED BY D10-MERGE-UPDATE-CARDS * EXEC84.2 +111800* PERFORMS D25-PRINT-REPORT * EXEC84.2 +111900* D30-PROCESS-HEADER * EXEC84.2 +112000* D90-PROCESS-END-OF * EXEC84.2 +112100* X10-WRITE-UPDATED-POPFILE * EXEC84.2 +112200* X30-READ-POPFILE * EXEC84.2 +112300* X40-WRITE-SOURCE-FILE * EXEC84.2 +112400**************************************************************** EXEC84.2 +112500 D20-1-CHECK-RECORD-TYPE. EXEC84.2 +112600 MOVE SPACE TO WZ-NOT-THIS-COMMENT. EXEC84.2 +112700 MOVE SPACE TO WZ-LINE-UPDATE. EXEC84.2 +112800 MOVE SPACE TO WZ-REPLACE-FLAG. EXEC84.2 +112900* MOVE "Y" TO WZ-UPDATE-THIS-PROG. EXEC84.2 +113000 MOVE SPACE TO WZ-OPTIONAL-SELECTED. EXEC84.2 +113100 MOVE SPACE TO WZ-DELETE-FLAG. EXEC84.2 +113200 EXEC84.2 +113300 IF WC-STAR-HEADER = "*HEADER" EXEC84.2 +113400 MOVE SPACE TO WZ-PROGRAM-SELECTED EXEC84.2 +113500 PERFORM D30-PROCESS-HEADER EXEC84.2 +113600 UNTIL WZ-PROGRAM-SELECTED = "Y" EXEC84.2 +113700 ELSE EXEC84.2 +113800 IF WC-STAR-HEADER = "*END-OF" EXEC84.2 +113900 PERFORM D90-PROCESS-END-OF EXEC84.2 +114000 ELSE EXEC84.2 +114100 PERFORM D50-PROCESS-COBOL-LINE. EXEC84.2 +114200 EXEC84.2 +114300 PERFORM D25-PRINT-REPORT. EXEC84.2 +114400 EXEC84.2 +114500 D20-10-SOURCE-CHECK. EXEC84.2 +114600 IF WY-NO-SOURCE = "Y" EXEC84.2 +114700 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 +114800 IF WZ-DELETE-FLAG = "Y" EXEC84.2 +114900 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 +115000 IF WZ-NOT-THIS-COMMENT = "Y" EXEC84.2 +115100 GO TO D20-20-UPDATED-POP-CHECK. EXEC84.2 +115200* IF WZ-UPDATE-THIS-PROG = SPACE EXEC84.2 +115300* GO TO D20-30-READ-FILE. EXEC84.2 +115400 EXEC84.2 +115500 IF WZ-END-OF-POPFILE NOT = "Y" EXEC84.2 +115600 PERFORM X40-WRITE-SOURCE-FILE. EXEC84.2 +115700 EXEC84.2 +115800 D20-20-UPDATED-POP-CHECK. EXEC84.2 +115900 IF WY-NEW-POP = "Y" EXEC84.2 +116000 PERFORM X10-WRITE-UPDATED-POPFILE. EXEC84.2 +116100 MOVE WZ-SAVE-POP-RECORD TO WC-CURRENT-POP-RECORD. EXEC84.2 +116200 EXEC84.2 +116300 D20-30-READ-FILE. EXEC84.2 +116400 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 +116500 GO TO D20-EXIT. EXEC84.2 +116600 IF WB-SEQ-1 = SPACES EXEC84.2 +116700 MOVE WZ-SAVE-SEQ TO WC-6 EXEC84.2 +116800 GO TO D20-EXIT. EXEC84.2 +116900 PERFORM X30-READ-POPFILE. EXEC84.2 +117000 EXEC84.2 +117100 D20-EXIT. EXEC84.2 +117200 EXIT. EXEC84.2 +117300 EXEC84.2 +117400/ EXEC84.2 +117500 D25-PRINT-REPORT SECTION. EXEC84.2 +117600*======================== EXEC84.2 +117700* EXEC84.2 +117800**************************************************************** EXEC84.2 +117900* DEPENDING ON THE PRINT OPTIONS SELECTED, THIS SECTION * EXEC84.2 +118000* PRINTS EITHER THE EXTRACTED PROGRAMS OR ANY UPDATES AND * EXEC84.2 +118100* X-CARD SUBSTITUTIONS MADE. * EXEC84.2 +118200* * EXEC84.2 +118300* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 +118400* PERFORMS X20-PRINT-DETAIL * EXEC84.2 +118500* D27-PRINT-UPDATES * EXEC84.2 +118600**************************************************************** EXEC84.2 +118700 D25-1-CHECK-LIST-PROGRAMS. EXEC84.2 +118800 IF WY-LIST-PROGRAMS = "Y" EXEC84.2 +118900 MOVE WC-CURRENT-POP-RECORD TO PRINT-DATA EXEC84.2 +119000 PERFORM X20-PRINT-DETAIL EXEC84.2 +119100 GO TO D25-EXIT. EXEC84.2 +119200 EXEC84.2 +119300 D25-10-UPDATES-CHECK. EXEC84.2 +119400 IF WY-LIST-NO-UPDATES = SPACE EXEC84.2 +119500 IF WZ-LINE-UPDATE = "Y" EXEC84.2 +119600 PERFORM D27-PRINT-UPDATES EXEC84.2 +119700 GO TO D25-EXIT. EXEC84.2 +119800 EXEC84.2 +119900 D25-20-X-CARD-CHECK. EXEC84.2 +120000 IF WY-LIST-X-CARDS = "Y" EXEC84.2 +120100 IF WZ-SAVE-12-15 = "XXXX" EXEC84.2 +120200 MOVE WZ-SAVE-12-20 TO WE-X-CARD EXEC84.2 +120300 MOVE "SUBSTITUTION" TO WE-CHANGE-TYPE EXEC84.2 +120400 MOVE WC-CURRENT-POP-RECORD EXEC84.2 +120500 TO WE-COBOL-LINE EXEC84.2 +120600 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 +120700 PERFORM X20-PRINT-DETAIL. EXEC84.2 +120800 EXEC84.2 +120900 D25-EXIT. EXEC84.2 +121000 EXIT. EXEC84.2 +121100 EXEC84.2 +121200 EXEC84.2 +121300 EXEC84.2 +121400/ EXEC84.2 +121500 D27-PRINT-UPDATES SECTION. EXEC84.2 +121600*========================= EXEC84.2 +121700* EXEC84.2 +121800**************************************************************** EXEC84.2 +121900* THIS SECTION WILL PRINT THE ORIGINAL POPULATION FILE * EXEC84.2 +122000* RECORD (IF "*LIST NO-UPDATES" HAS NOT BEEN SPECIFIED) AND,* EXEC84.2 +122100* IF A REPLACEMENT, THE NEW IMAGE OR, IF AN INSERTION, JUST * EXEC84.2 +122200* THE NEW LINE OF CODE. * EXEC84.2 +122300* * EXEC84.2 +122400* PERFORMED BY D25-PRINT-REPORT * EXEC84.2 +122500* PERFORMS X20-PRINT-DETAIL * EXEC84.2 +122600**************************************************************** EXEC84.2 +122700 D27-1-PRINT-REPLACEMENTS. EXEC84.2 +122800 IF WZ-REPLACE-FLAG = "Y" EXEC84.2 +122900 MOVE WZ-SAVE-POP-RECORD TO WE-COBOL-LINE EXEC84.2 +123000 MOVE SPACES TO WE-X-CARD EXEC84.2 +123100 MOVE "ORIGINAL" TO WE-CHANGE-TYPE EXEC84.2 +123200 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 +123300 PERFORM X20-PRINT-DETAIL EXEC84.2 +123400 MOVE "REPLACEMENT" TO WE-CHANGE-TYPE EXEC84.2 +123500 MOVE SPACES TO WE-X-CARD EXEC84.2 +123600 MOVE WC-CURRENT-POP-RECORD TO WE-COBOL-LINE EXEC84.2 +123700 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 +123800 PERFORM X20-PRINT-DETAIL EXEC84.2 +123900 GO TO D27-EXIT. EXEC84.2 +124000 EXEC84.2 +124100 D27-10-PRINT-NEW-DATA. EXEC84.2 +124200 IF WZ-DONT-READ-POPFILE = "Y" EXEC84.2 +124300 MOVE WC-CURRENT-POP-RECORD TO WE-COBOL-LINE EXEC84.2 +124400 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 +124500 PERFORM X20-PRINT-DETAIL EXEC84.2 +124600 GO TO D27-EXIT. EXEC84.2 +124700 EXEC84.2 +124800 D27-20-PRINT-DELETIONS. EXEC84.2 +124900 IF WZ-DELETE-FLAG = "Y" EXEC84.2 +125000 MOVE WZ-SAVE-POP-RECORD TO WE-COBOL-LINE EXEC84.2 +125100 MOVE WE-PRINT-DATA TO PRINT-DATA EXEC84.2 +125200 PERFORM X20-PRINT-DETAIL. EXEC84.2 +125300 EXEC84.2 +125400 D27-EXIT. EXEC84.2 +125500 EXIT. EXEC84.2 +125600 EXEC84.2 +125700/ EXEC84.2 +125800 D30-PROCESS-HEADER SECTION. EXEC84.2 +125900*========================== EXEC84.2 +126000* EXEC84.2 +126100**************************************************************** EXEC84.2 +126200* THIS SECTION PROCESSES ANY "*HEADER" RECORDS. * EXEC84.2 +126300* * EXEC84.2 +126400* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 +126500* PERFORMS D90-PROCESS-END-OF * EXEC84.2 +126600* D11-GET-NEXT-PROGRAM * EXEC84.2 +126700* D31-PROCESS-DATA-HEADER * EXEC84.2 +126800* D32-PROCESS-COBOL-HEADER * EXEC84.2 +126900* D40-ANY-UPDATES * EXEC84.2 +127000* X10-WRITE-UPDATED-POPFILE * EXEC84.2 +127100* D43-PROGRAM-SELECTED * EXEC84.2 +127200**************************************************************** EXEC84.2 +127300 D30-1-CHECK-HEADER-TYPE. EXEC84.2 +127400 MOVE WC-COBOL TO BLOCK-TYPE EXEC84.2 +127500 IF WC-COBOL = "CLBRY" EXEC84.2 +127600 AND WY-NO-LIBRARY NOT = "Y" EXEC84.2 +127700 MOVE WC-HEADER TO PRINT-DATA EXEC84.2 +127800 MOVE WC-PROG-ID TO WZ-CURRENT-MAIN-PROG EXEC84.2 +127900 WZ-CURRENT-POP-PROG EXEC84.2 +128000***************************************************************** EXEC84.2 +128100* NOTE FOLLOWING CHANGES *** EXEC84.2 +128200***************************************************************** EXEC84.2 +128300* PERFORM D36-INITIALISE-PROGRAM-TOTALS EXEC84.2 +128400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +128500 PERFORM D34-PROGRAM-SELECTED. EXEC84.2 +128600 EXEC84.2 +128700 IF WC-COBOL = "DATA*" EXEC84.2 +128800 PERFORM D31-PROCESS-DATA-HEADER. EXEC84.2 +128900 EXEC84.2 +129000 IF WC-COBOL = "COBOL" EXEC84.2 +129100 ADD 1 TO WZ-PROGS-FOUND EXEC84.2 +129200 PERFORM D32-PROCESS-COBOL-HEADER. EXEC84.2 +129300 EXEC84.2 +129400 IF WZ-PROGRAM-SELECTED = "Y" EXEC84.2 +129500 GO TO D30-20-HEADER-SELECTED. EXEC84.2 +129600 EXEC84.2 +129700 PERFORM D11-GET-NEXT-PROGRAM. EXEC84.2 +129800 IF WZ-END-OF-POPFILE = "Y" EXEC84.2 +129900 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +130000 GO TO D30-EXIT EXEC84.2 +130100 ELSE EXEC84.2 +130200 GO TO D30-1-CHECK-HEADER-TYPE. EXEC84.2 +130300 EXEC84.2 +130400 D30-20-HEADER-SELECTED. EXEC84.2 +130500 MOVE WC-COBOL TO WZ-CURRENT-HEADER. EXEC84.2 +130600 IF WZ-END-OF-UPDATES = SPACE EXEC84.2 +130700 PERFORM D40-ANY-UPDATES. EXEC84.2 +130800 EXEC84.2 +130900 D30-EXIT. EXEC84.2 +131000 EXIT. EXEC84.2 +131100/ EXEC84.2 +131200 D31-PROCESS-DATA-HEADER SECTION. EXEC84.2 +131300*=============================== EXEC84.2 +131400* EXEC84.2 +131500 D31-1-CHECK-FOR-DATA-SELECTED. EXEC84.2 +131600 IF WY-NO-DATA = "Y" EXEC84.2 +131700 GO TO D31-EXIT. EXEC84.2 +131800 EXEC84.2 +131900 IF WZ-PROG-ID-6 = "M" EXEC84.2 +132000 GO TO D31-30-MANUAL-CHECK. EXEC84.2 +132100 EXEC84.2 +132200 D31-20-AUTO-CHECK. EXEC84.2 +132300 IF WY-EXTRACT-MAN = SPACE EXEC84.2 +132400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +132500 ELSE EXEC84.2 +132600 GO TO D31-EXIT. EXEC84.2 +132700 EXEC84.2 +132800 D31-30-MANUAL-CHECK. EXEC84.2 +132900 IF WY-EXTRACT-AUTO = SPACE EXEC84.2 +133000 MOVE "Y" TO WZ-PROGRAM-SELECTED. EXEC84.2 +133100 EXEC84.2 +133200 EXEC84.2 +133300 D31-EXIT. EXEC84.2 +133400 EXIT. EXEC84.2 +133500 EXEC84.2 +133600/ EXEC84.2 +133700 D32-PROCESS-COBOL-HEADER SECTION. EXEC84.2 +133800*================================ EXEC84.2 +133900* EXEC84.2 +134000**************************************************************** EXEC84.2 +134100* THIS SECTION CHECKS TO SEE IF THE CURRENT HEADER IS * EXEC84.2 +134200* IS WITHIN THE RANGE SPECIFIED BY THE "*EXTRACT" OR * EXEC84.2 +134300* "*SELECT" RECORDS OF THE INPUT CONTROL-FILE. * EXEC84.2 +134400* * EXEC84.2 +134500* PERFORMED BY D30-PROCESS-HEADER * EXEC84.2 +134600* PERFORMS D33-MODULE-CHECK * EXEC84.2 +134700* D34-PROGRAM-SELECTED * EXEC84.2 +134800**************************************************************** EXEC84.2 +134900* * EXEC84.2 +135000**************************************************************** EXEC84.2 +135100* IF PROGRAM DOES NOT END WITH '5','A','B' OR 'M' IT * EXEC84.2 +135200* SHOULD HAVE A SPACE CHARACTER FOR POSITION 6. * EXEC84.2 +135300**************************************************************** EXEC84.2 +135400* * EXEC84.2 +135500 D32-0-CHECK-A-OR-M. EXEC84.2 +135600 IF WC-PROG-ID-6 = "A" EXEC84.2 +135700 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 +135800 IF WC-PROG-ID-6 = "B" EXEC84.2 +135900 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 +136000 IF WC-PROG-ID-6 = "M" EXEC84.2 +136100 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 +136200 IF WC-PROG-ID-6 = "5" EXEC84.2 +136300 GO TO D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 +136400 MOVE SPACE TO WC-PROG-ID-6. EXEC84.2 +136500 D32-1-CHECK-FOR-ALL-SELECTED. EXEC84.2 +136600 IF WY-EXTRACT-ALL = "Y" EXEC84.2 +136700 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +136800 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +136900 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 +137000 EXEC84.2 +137100 D32-10-MANUAL-CHECK. EXEC84.2 +137200 IF WY-EXTRACT-MAN = "Y" EXEC84.2 +137300 IF WC-PROG-ID-6 = "M" EXEC84.2 +137400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +137500 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +137600 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 +137700 EXEC84.2 +137800 D32-20-AUTO-CHECK. EXEC84.2 +137900 IF WY-EXTRACT-AUTO = "Y" EXEC84.2 +138000 IF WC-PROG-ID-6 = "A" OR "B" EXEC84.2 +138100 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +138200 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +138300 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 +138400 EXEC84.2 +138500 D32-30-MODULE-CHECK. EXEC84.2 +138600 IF WY-SELECT-MODULE = "Y" EXEC84.2 +138700*THE FOLLOWING CHECK ASSUMES THAT THE FILES ON THE POPFILE EXEC84.2 +138800*ARE IN ORDER! EXEC84.2 +138900 IF WG-MODULE-SELECTED-TABLE = SPACES EXEC84.2 +139000 MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 +139100 ELSE EXEC84.2 +139200 MOVE 1 TO SUB6 EXEC84.2 +139300 PERFORM D33-MODULE-CHECK EXEC84.2 +139400 GO TO D32-50-CHECK-IF-SELECTED. EXEC84.2 +139500 EXEC84.2 +139600 MOVE 1 TO SUB7. EXEC84.2 +139700 D32-40-PROGRAM-CHECK. EXEC84.2 +139800 IF WY-SELECT-PROG = "Y" EXEC84.2 +139900 IF WF-PROGRAM-SELECTED-TABLE = SPACES EXEC84.2 +140000 MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 +140100 ELSE EXEC84.2 +140200 IF WC-PROG-ID-1-5 = WF-PROGRAM-SELECTED (SUB7) EXEC84.2 +140300 MOVE SPACE TO WF-PROGRAM-SELECTED (SUB7) EXEC84.2 +140400 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +140500 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +140600 GO TO D32-50-CHECK-IF-SELECTED EXEC84.2 +140700 ELSE EXEC84.2 +140800 IF SUB7 < 50 EXEC84.2 +140900 ADD 1 TO SUB7 EXEC84.2 +141000 GO TO D32-40-PROGRAM-CHECK EXEC84.2 +141100 ELSE EXEC84.2 +141200 IF WC-SUBPRG = "SUBPRG" OR "SUBRTN" EXEC84.2 +141300 MOVE 1 TO SUB7 EXEC84.2 +141400 PERFORM 50 TIMES EXEC84.2 +141500 IF WC-PROG2ID-1-5 = EXEC84.2 +141600 WF-PROGRAM-SELECTED (SUB7) EXEC84.2 +141700 MOVE SPACE TO EXEC84.2 +141800 WF-PROGRAM-SELECTED (SUB7) EXEC84.2 +141900 MOVE "Y" TO EXEC84.2 +142000 WZ-PROGRAM-SELECTED EXEC84.2 +142100 MOVE WC-PROG2ID TO EXEC84.2 +142200 WZ-CURRENT-POP-PROG EXEC84.2 +142300 GO D32-50-CHECK-IF-SELECTED EXEC84.2 +142400 END-IF EXEC84.2 +142500 ADD 1 TO SUB7 EXEC84.2 +142600 END-PERFORM. EXEC84.2 +142700 EXEC84.2 +142800 D32-50-CHECK-IF-SELECTED. EXEC84.2 +142900 IF WZ-PROGRAM-SELECTED = "Y" EXEC84.2 +143000 PERFORM D34-PROGRAM-SELECTED. EXEC84.2 +143100 EXEC84.2 +143200 D32-EXIT. EXEC84.2 +143300 EXIT. EXEC84.2 +143400/ EXEC84.2 +143500 D33-MODULE-CHECK SECTION. EXEC84.2 +143600*======================== EXEC84.2 +143700* EXEC84.2 +143800**************************************************************** EXEC84.2 +143900* IF ONE OR MORE MODULES HAVE BEEN SELECTED, THIS SECTION * EXEC84.2 +144000* CHECKS THAT THE CURRENT POPULATION FILE PROGRAM IS FROM * EXEC84.2 +144100* A SELECTED MODULE (AND LEVEL, IF LEVEL SELECTED). * EXEC84.2 +144200* * EXEC84.2 +144300* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 +144400* PERFORMS NONE * EXEC84.2 +144500**************************************************************** EXEC84.2 +144600 D33-1-MODULE-CHECK. EXEC84.2 +144700 IF WC-MODULE = WG-MODULE-SELECTED (SUB6) EXEC84.2 +144800 GO TO D33-10-CHECK-MODULE-LEVEL. EXEC84.2 +144900 IF WC-MODULE > WG-MODULE-SELECTED (SUB6) AND EXEC84.2 +145000*THE FOLLOWING CHECK MAKES SURE SOME FILES GET OFF EXEC84.2 +145100 WZ-SOURCE-PROGS NOT = 0 EXEC84.2 +145200 MOVE SPACE TO WG-MODULE-SELECTED (SUB6) EXEC84.2 +145300 MOVE SPACE TO WG-MODULE-LEVEL (SUB6) EXEC84.2 +145400 IF SUB6 < 10 EXEC84.2 +145500 ADD 1 TO SUB6 EXEC84.2 +145600 GO TO D33-1-MODULE-CHECK EXEC84.2 +145700 ELSE EXEC84.2 +145800 GO TO D33-EXIT EXEC84.2 +145900 ELSE EXEC84.2 +146000 GO TO D33-EXIT. EXEC84.2 +146100 EXEC84.2 +146200 D33-10-CHECK-MODULE-LEVEL. EXEC84.2 +146300 IF WG-MODULE-LEVEL (SUB6) = SPACE EXEC84.2 +146400 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +146500 MOVE "Y" TO WZ-PROGRAM-SELECTED EXEC84.2 +146600 GO TO D33-EXIT. EXEC84.2 +146700 EXEC84.2 +146800 IF WG-MODULE-LEVEL (SUB6) = WC-LEVEL EXEC84.2 +146900 MOVE WC-PROG-ID TO WZ-CURRENT-POP-PROG EXEC84.2 +147000 MOVE "Y" TO WZ-PROGRAM-SELECTED. EXEC84.2 +147100 EXEC84.2 +147200 D33-EXIT. EXEC84.2 +147300 EXIT. EXEC84.2 +147400 EXEC84.2 +147500/ EXEC84.2 +147600 D34-PROGRAM-SELECTED SECTION. EXEC84.2 +147700*============================ EXEC84.2 +147800* EXEC84.2 +147900**************************************************************** EXEC84.2 +148000* IF THE CURRENT POPULATION FILE PROGRAM HAS BEEN SELECTED * EXEC84.2 +148100* FOR PROCESSING, THIS SECTION UPDATES VARIOUS FIELDS. * EXEC84.2 +148200* * EXEC84.2 +148300* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 +148400* PERFORMS NONE * EXEC84.2 +148500**************************************************************** EXEC84.2 +148600 D34-1-SELECTION-CHECK. EXEC84.2 +148700 IF WZ-PROGRAM-SELECTED = SPACE EXEC84.2 +148800 GO TO D34-EXIT. EXEC84.2 +148900 EXEC84.2 +149000 IF WY-NO-SOURCE = SPACE EXEC84.2 +149100 ADD 1 TO WZ-SOURCE-PROGS. EXEC84.2 +149200 EXEC84.2 +149300 IF WY-NEW-POP = "Y" EXEC84.2 +149400 ADD 1 TO WZ-NEWPOP-PROGS. EXEC84.2 +149500 EXEC84.2 +149600* MOVE SPACE TO WZ-CURRENT-MAIN-PROG. EXEC84.2 +149700 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG. EXEC84.2 +149800 EXEC84.2 +149900 PERFORM D36-INITIALISE-PROGRAM-TOTALS. EXEC84.2 +150000 EXEC84.2 +150100 MOVE WC-HEADER TO PRINT-DATA. EXEC84.2 +150200 IF WC-SUBPRG = "SUBPRG" EXEC84.2 +150300 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG EXEC84.2 +150400* MOVE WC-PROG2ID TO WZ-CURRENT-UPD-PROG EXEC84.2 +150500 MOVE WC-PROG2ID TO WZ-CURRENT-POP-PROG EXEC84.2 +150600 END-IF. EXEC84.2 +150700 IF WC-SUBPRG = "SUBRTN" EXEC84.2 +150800 MOVE WZ-CURRENT-POP-PROG TO WZ-CURRENT-MAIN-PROG EXEC84.2 +150900* MOVE WC-PROG2ID TO WZ-CURRENT-UPD-PROG EXEC84.2 +151000 MOVE WC-PROG2ID TO WZ-CURRENT-POP-PROG EXEC84.2 +151100 END-IF. EXEC84.2 +151200 EXEC84.2 +151300 D34-2-OPEN-OUTPUT. EXEC84.2 +151400 IF WY-LIST-COMPACT = SPACE EXEC84.2 +151500 MOVE 51 TO WZ-LINE-CT. EXEC84.2 +151600 EXEC84.2 +151700 PERFORM X20-PRINT-DETAIL. EXEC84.2 +151800 D34-EXIT. EXEC84.2 +151900 EXIT. EXEC84.2 +152000/ EXEC84.2 +152100 D36-INITIALISE-PROGRAM-TOTALS SECTION. EXEC84.2 +152200*===================================== EXEC84.2 +152300* EXEC84.2 +152400**************************************************************** EXEC84.2 +152500* WHEN A PROGRAM "*HEADER" IS SELECTED THIS SECTION RESETS * EXEC84.2 +152600* ALL THE VARIOUS TOTALS FOR THAT PROGRAM. * EXEC84.2 +152700* * EXEC84.2 +152800* PERFORMED BY D32-PROCESS-COBOL-HEADER * EXEC84.2 +152900* PERFORMS NONE * EXEC84.2 +153000**************************************************************** EXEC84.2 +153100 D36-1-RESET-TOTALS. EXEC84.2 +153200 MOVE ZERO TO WZ-LINES-COBOL. EXEC84.2 +153300 MOVE ZERO TO WZ-LINES-INSERTED. EXEC84.2 +153400 MOVE ZERO TO WZ-LINES-REPLACED. EXEC84.2 +153500 MOVE ZERO TO WZ-LINES-DELETED. EXEC84.2 +153600 MOVE ZERO TO WZ-CODE-REMOVED. EXEC84.2 +153700 MOVE ZERO TO WZ-COMMENTS-DEL. EXEC84.2 +153800 MOVE ZERO TO WZ-SEQ-NO. EXEC84.2 +153900 EXEC84.2 +154000 D36-EXIT. EXEC84.2 +154100 EXIT. EXEC84.2 +154200/ EXEC84.2 +154300 D40-ANY-UPDATES SECTION. EXEC84.2 +154400*======================= EXEC84.2 +154500* EXEC84.2 +154600**************************************************************** EXEC84.2 +154700* THIS SECTION FINDS THE FIRST UPDATE RECORD (IF ANY) FOR * EXEC84.2 +154800* THE CURRENT POPULATION FILE PROGRAM BEING PROCESSED. * EXEC84.2 +154900* * EXEC84.2 +155000* PERFORMED BY D30-PROCESS-HEADER * EXEC84.2 +155100* PERFORMS D42-READ-UPDATE * EXEC84.2 +155200**************************************************************** EXEC84.2 +155300 D40-1-CHECK-UPDATE-AND-POP. EXEC84.2 +155400 MOVE SPACE TO WZ-UPDATE-THIS-PROG. EXEC84.2 +155500 IF WZ-CURRENT-UPD-PROG > WZ-CURRENT-POP-PROG EXEC84.2 +155600 GO TO D40-EXIT. EXEC84.2 +155700 EXEC84.2 +155800 IF WZ-CURRENT-UPD-PROG = WZ-CURRENT-POP-PROG EXEC84.2 +155900 GO TO D40-20-PROGRAMS-EQUAL. EXEC84.2 +156000 EXEC84.2 +156100* IF WZ-CURRENT-POP-PROG = WB-UPDATE-PROG EXEC84.2 +156200* GO TO D40-20-PROGRAMS-EQUAL. EXEC84.2 +156300 EXEC84.2 +156400 IF WZ-UPD-PROG-CHAR = "A" EXEC84.2 +156500 GO TO D40-05-CHECK-LIBRARY. EXEC84.2 +156600 EXEC84.2 +156700 IF WZ-UPD-PROG-CHAR = "K" EXEC84.2 +156800 GO TO D40-05-CHECK-LIBRARY EXEC84.2 +156900 ELSE GO TO D40-10-GET-NEXT-STAR-START. EXEC84.2 +157000* EXEC84.2 +157100 D40-05-CHECK-LIBRARY. EXEC84.2 +157200 IF WZ-CURRENT-POP-PROG < "SQ000" EXEC84.2 +157300 GO TO D40-EXIT. EXEC84.2 +157400 EXEC84.2 +157500 D40-10-GET-NEXT-STAR-START. EXEC84.2 +157600 MOVE SPACES TO WB-STAR-START. EXEC84.2 +157700 PERFORM D42-READ-UPDATE-FILE EXEC84.2 +157800 UNTIL WB-STAR-START = "*START". EXEC84.2 +157900 EXEC84.2 +158000 IF WZ-END-OF-UPDATES = "Y" EXEC84.2 +158100 GO TO D40-EXIT. EXEC84.2 +158200 PERFORM C60-START-CARD. EXEC84.2 +158300 EXEC84.2 +158400 GO TO D40-1-CHECK-UPDATE-AND-POP. EXEC84.2 +158500 EXEC84.2 +158600 D40-20-PROGRAMS-EQUAL. EXEC84.2 +158700 MOVE "Y" TO WZ-UPDATE-THIS-PROG. EXEC84.2 +158800 IF WB-RENUMBER = "R" EXEC84.2 +158900 MOVE "Y" TO WZ-RESEQUENCE-THIS EXEC84.2 +159000 ELSE EXEC84.2 +159100 MOVE SPACE TO WZ-RESEQUENCE-THIS. EXEC84.2 +159200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +159300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +159400 EXEC84.2 +159500 IF WB-11 = "*END-UPDATE" EXEC84.2 +159600 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +159700 EXEC84.2 +159800 D40-EXIT. EXEC84.2 +159900 EXIT. EXEC84.2 +160000 EXEC84.2 +160100/ EXEC84.2 +160200 D42-READ-UPDATE-FILE SECTION. EXEC84.2 +160300*============================ EXEC84.2 +160400 D42-1. EXEC84.2 +160500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +160600 AT END MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 +160700 MOVE "*START" TO WB-STAR-START EXEC84.2 +160800 GO TO D42-EXIT. EXEC84.2 +160900 EXEC84.2 +161000 IF WB-11 = "*END-UPDATE" EXEC84.2 +161100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 +161200 MOVE "*START" TO WB-STAR-START. EXEC84.2 +161300 EXEC84.2 +161400 D42-EXIT. EXEC84.2 +161500 EXIT. EXEC84.2 +161600 EXEC84.2 +161700 EXEC84.2 +161800 EXEC84.2 +161900 EXEC84.2 +162000 D50-PROCESS-COBOL-LINE SECTION. EXEC84.2 +162100*============================== EXEC84.2 +162200* EXEC84.2 +162300**************************************************************** EXEC84.2 +162400* THIS IS THE MAIN SECTION FOR PROCESSING THE COBOL SOURCE * EXEC84.2 +162500* CODE OF THE POPULATION FILE * EXEC84.2 +162600* * EXEC84.2 +162700* * EXEC84.2 +162800**************************************************************** EXEC84.2 +162900 D50-1-CHECK-FOR-UPDATING. EXEC84.2 +163000 EXEC84.2 +163100 IF WZ-UPDATE-THIS-PROG = "Y" EXEC84.2 +163200 PERFORM D60-PROCESS-UPDATE-CARD. EXEC84.2 +163300 EXEC84.2 +163400 IF WZ-DELETE-FLAG = "Y" EXEC84.2 +163500 GO TO D50-EXIT. EXEC84.2 +163600 EXEC84.2 +163700 IF WY-NO-SOURCE = SPACE EXEC84.2 +163800 IF BLOCK-TYPE NOT = "DATA*" EXEC84.2 +163900 PERFORM D80-RAW-LINE. EXEC84.2 +164000 EXEC84.2 +164100 EXEC84.2 +164200 D50-EXIT. EXEC84.2 +164300 EXIT. EXEC84.2 +164400/ EXEC84.2 +164500 D60-PROCESS-UPDATE-CARD SECTION. EXEC84.2 +164600*=============================== EXEC84.2 +164700* EXEC84.2 +164800**************************************************************** EXEC84.2 +164900* THIS IS THE MAIN SECTION FOR PROCESSING ANY UPDATE CARDS * EXEC84.2 +165000* WHICH EXIST FOR THE CURRENT POPULATION FILE PROGRAM * EXEC84.2 +165100* BEING PROCESSED. * EXEC84.2 +165200* * EXEC84.2 +165300* PERFORMED BY D50-PROCESS-COBOL-LINE * EXEC84.2 +165400* PERFORMS D67-LINE-UPDATE * EXEC84.2 +165500* D62-SERIES-UPDATE * EXEC84.2 +165600**************************************************************** EXEC84.2 +165700 D60-1-CHECK-BLOCK-INSERT. EXEC84.2 +165800 IF WB-SEQ-1 = SPACES EXEC84.2 +165900 PERFORM D67-LINE-UPDATE EXEC84.2 +166000 GO TO D60-30-CHECK-END. EXEC84.2 +166100 EXEC84.2 +166200 D60-10-CHECK-FOR-SERIES-UPDATE. EXEC84.2 +166300 IF WB-SEQ-1 NOT NUMERIC EXEC84.2 +166400 GO TO D60-30-CHECK-END. EXEC84.2 +166500 EXEC84.2 +166600 IF WB-SEQ-2 NUMERIC EXEC84.2 +166700 PERFORM D62-SERIES-UPDATE EXEC84.2 +166800 GO TO D60-30-CHECK-END EXEC84.2 +166900 ELSE EXEC84.2 +167000 PERFORM D67-LINE-UPDATE. EXEC84.2 +167100 EXEC84.2 +167200 D60-30-CHECK-END. EXEC84.2 +167300 IF WB-11 = "*END-UPDATE" EXEC84.2 +167400 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +167500 EXEC84.2 +167600 EXEC84.2 +167700 D60-EXIT. EXEC84.2 +167800 EXIT. EXEC84.2 +167900/ EXEC84.2 +168000 D62-SERIES-UPDATE SECTION. EXEC84.2 +168100*========================= EXEC84.2 +168200* EXEC84.2 +168300**************************************************************** EXEC84.2 +168400* THIS SECTION WILL PROCESS SERIES INSERTIONS OR DELETIONS * EXEC84.2 +168500* * EXEC84.2 +168600* PERFORMED BY D60-PROCESS-UPDATE-CARD * EXEC84.2 +168700* PERFORMS C60-START-CARD * EXEC84.2 +168800**************************************************************** EXEC84.2 +168900 D62-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 +169000 IF WC-6 < WB-SEQ-1 EXEC84.2 +169100 IF WZ-WITHIN-DELETE-SERIES-FLAG = "Y" EXEC84.2 +169200* ALLOWS FOR OUT-OF-SEQUENCE LINE NUMBER WITHIN DELETE RANGE EXEC84.2 +169300 GO TO D62-20-NOW-WITHIN-RANGE EXEC84.2 +169400 END-IF EXEC84.2 +169500 GO TO D62-EXIT. EXEC84.2 +169600 EXEC84.2 +169700 IF WC-6 NOT > WB-SEQ-2 EXEC84.2 +169800 GO TO D62-20-NOW-WITHIN-RANGE. EXEC84.2 +169900 EXEC84.2 +170000 D62-10-READ-NEXT-UPDATE-CARD. EXEC84.2 +170100 MOVE SPACES TO WZ-WITHIN-DELETE-SERIES-FLAG. EXEC84.2 +170200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +170300 AT END MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 +170400 GO TO D62-EXIT. EXEC84.2 +170500 EXEC84.2 +170600 IF WB-STAR-START = "*START" EXEC84.2 +170700 PERFORM C60-START-CARD EXEC84.2 +170800 GO TO D62-EXIT. EXEC84.2 +170900 EXEC84.2 +171000 IF WB-11 = "*END-UPDATE" EXEC84.2 +171100 MOVE "Y" TO WZ-END-OF-UPDATES EXEC84.2 +171200 GO TO D62-EXIT. EXEC84.2 +171300 EXEC84.2 +171400 IF WB-SEQ-2 NUMERIC EXEC84.2 +171500 GO TO D62-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 +171600 PERFORM D67-LINE-UPDATE. EXEC84.2 +171700 GO TO D62-EXIT. EXEC84.2 +171800 EXEC84.2 +171900 D62-20-NOW-WITHIN-RANGE. EXEC84.2 +172000 MOVE "Y" TO WZ-LINE-UPDATE. EXEC84.2 +172100 IF WB-COL-7 = "," EXEC84.2 +172200 MOVE "Y" TO WZ-WITHIN-DELETE-SERIES-FLAG EXEC84.2 +172300 ADD 1 TO WZ-LINES-DELETED EXEC84.2 +172400 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 +172500 MOVE SPACES TO WE-X-CARD EXEC84.2 +172600 MOVE "DELETIONS" TO WE-CHANGE-TYPE EXEC84.2 +172700 IF WB-SEQ-1 = WB-SEQ-2 EXEC84.2 +172800 MOVE SPACE TO WZ-WITHIN-DELETE-SERIES-FLAG EXEC84.2 +172900 END-IF EXEC84.2 +173000 GO TO D62-EXIT. EXEC84.2 +173100 EXEC84.2 +173200 MOVE "Y" TO WZ-REPLACE-FLAG. EXEC84.2 +173300 MOVE WB-COL-7 TO WC-COL-7. EXEC84.2 +173400 EXEC84.2 +173500 D62-EXIT. EXEC84.2 +173600 EXIT. EXEC84.2 +173700 EXEC84.2 +173800/ EXEC84.2 +173900 D67-LINE-UPDATE SECTION. EXEC84.2 +174000*======================= EXEC84.2 +174100* EXEC84.2 +174200**************************************************************** EXEC84.2 +174300* THIS SECTION PERFORMS SINGLE LINE AMENDMENTS OR DELETIONS * EXEC84.2 +174400* * EXEC84.2 +174500* PERFORMED BY D60-PROCESS-UPDATE-CARD * EXEC84.2 +174600* D62-SERIES-UPDATE * EXEC84.2 +174700* PERFORMS C60-START-CARD * EXEC84.2 +174800* D68-LINE-EQUAL * EXEC84.2 +174900* D69-LINE-BLANK-OR-LESS * EXEC84.2 +175000**************************************************************** EXEC84.2 +175100 D67-1-CHECK-FOR-WITHIN-RANGE. EXEC84.2 +175200 IF WC-6 < WB-SEQ-1 EXEC84.2 +175300 GO TO D67-EXIT. EXEC84.2 +175400 EXEC84.2 +175500 D67-10-LINES-EQUAL-OR-LESS. EXEC84.2 +175600 MOVE "Y" TO WZ-LINE-UPDATE. EXEC84.2 +175700 IF WB-COL-7 = "," EXEC84.2 +175800 ADD 1 TO WZ-LINES-DELETED EXEC84.2 +175900 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 +176000 MOVE SPACES TO WE-X-CARD EXEC84.2 +176100 MOVE "DELETION" TO WE-CHANGE-TYPE EXEC84.2 +176200 GO TO D67-20-READ-CONTROL. EXEC84.2 +176300 EXEC84.2 +176400 IF WC-6 = WB-SEQ-1 EXEC84.2 +176500 PERFORM D68-LINE-EQUAL EXEC84.2 +176600 GO TO D67-EXIT. EXEC84.2 +176700 EXEC84.2 +176800 IF WB-SEQ-1 = SPACES EXEC84.2 +176900 PERFORM D69-LINE-BLANK-OR-LESS EXEC84.2 +177000 GO TO D67-EXIT. EXEC84.2 +177100 EXEC84.2 +177200 IF WC-6 > WB-SEQ-1 EXEC84.2 +177300 PERFORM D69-LINE-BLANK-OR-LESS EXEC84.2 +177400 GO TO D67-EXIT. EXEC84.2 +177500 EXEC84.2 +177600 D67-20-READ-CONTROL. EXEC84.2 +177700 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +177800 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +177900 IF WB-STAR-START = "*START" EXEC84.2 +178000 PERFORM C60-START-CARD. EXEC84.2 +178100 EXEC84.2 +178200 IF WB-11 = "*END-UPDATE" EXEC84.2 +178300 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +178400 EXEC84.2 +178500 D67-EXIT. EXEC84.2 +178600 EXIT. EXEC84.2 +178700/ EXEC84.2 +178800 D68-LINE-EQUAL SECTION. EXEC84.2 +178900*====================== EXEC84.2 +179000* EXEC84.2 +179100**************************************************************** EXEC84.2 +179200* THIS SECTION IS PERFORMED WHEN THE SEQUENCE NUMBER OF A * EXEC84.2 +179300* SINGLE UPDATE AMEND CARD IS THE SAME AS THE SEQUENCE * EXEC84.2 +179400* NUMBER OF THE CURRENT POPULATION FILE LINE BEING PROCESSED* EXEC84.2 +179500**************************************************************** EXEC84.2 +179600* EXEC84.2 +179700 D68-1. EXEC84.2 +179800 MOVE WB-CONTROL-DATA TO WC-CURRENT-POP-RECORD. EXEC84.2 +179900 ADD 1 TO WZ-LINES-REPLACED. EXEC84.2 +180000 MOVE "Y" TO WZ-REPLACE-FLAG. EXEC84.2 +180100 EXEC84.2 +180200 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +180300 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +180400 EXEC84.2 +180500 IF WB-STAR-START = "*START" EXEC84.2 +180600 PERFORM C60-START-CARD. EXEC84.2 +180700 EXEC84.2 +180800 IF WB-11 = "*END-UPDATE" EXEC84.2 +180900 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +181000 EXEC84.2 +181100 D68-EXIT. EXEC84.2 +181200 EXIT. EXEC84.2 +181300 EXEC84.2 +181400 EXEC84.2 +181500 EXEC84.2 +181600 EXEC84.2 +181700 D69-LINE-BLANK-OR-LESS SECTION. EXEC84.2 +181800*============================== EXEC84.2 +181900 D69-1. EXEC84.2 +182000 MOVE WB-CONTROL-DATA TO WC-CURRENT-POP-RECORD. EXEC84.2 +182100 ADD 1 TO WZ-LINES-INSERTED. EXEC84.2 +182200 MOVE "Y" TO WZ-DONT-READ-POPFILE. EXEC84.2 +182300 MOVE "INSERTIONS" TO WE-CHANGE-TYPE. EXEC84.2 +182400 MOVE SPACES TO WE-X-CARD. EXEC84.2 +182500 READ CONTROL-CARD-FILE INTO WB-CONTROL-DATA EXEC84.2 +182600 AT END MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +182700 EXEC84.2 +182800 IF WB-STAR-START = "*START" EXEC84.2 +182900 PERFORM C60-START-CARD. EXEC84.2 +183000 EXEC84.2 +183100 IF WB-11 = "*END-UPDATE" EXEC84.2 +183200 MOVE "Y" TO WZ-END-OF-UPDATES. EXEC84.2 +183300 EXEC84.2 +183400 D69-EXIT. EXEC84.2 +183500 EXIT. EXEC84.2 +183600 EXEC84.2 +183700/ EXEC84.2 +183800 D80-RAW-LINE SECTION. EXEC84.2 +183900*==================== EXEC84.2 +184000* EXEC84.2 +184100**************************************************************** EXEC84.2 +184200* IF COLUMN 7 OF THE POPULATION FILE PROGRAM CONTAINS A * EXEC84.2 +184300* SPECIAL CHARACTER OR COLS. 12-16 CONTAIN X-CARD INFO., * EXEC84.2 +184400* THIS SECTION WILL MAKE THE NECESSARY CHANGES. * EXEC84.2 +184500* * EXEC84.2 +184600* PERFORMED BY D50-PROCESS-COBOL-LINE * EXEC84.2 +184700* PERFORMS D82-OPTIONAL-LETTER * EXEC84.2 +184800* D86-X-CARD-CHECK * EXEC84.2 +184900* X40-WRITE-SOURCE-FILE * EXEC84.2 +185000**************************************************************** EXEC84.2 +185100 D80-1-ASTERISK-CHECK. EXEC84.2 +185200 IF WC-COL-7 = "D" GO TO D80-30-PRINT-LINE. EXEC84.2 +185300 IF WC-COL-7 NOT = "*" EXEC84.2 +185400 GO TO D80-20-ALPHABETIC-CHECK. EXEC84.2 +185500 EXEC84.2 +185600 IF WY-REMOVE-COMMENTS = "Y" EXEC84.2 +185700 ADD 1 TO WZ-COMMENTS-DELETED EXEC84.2 +185800 MOVE "Y" TO WZ-NOT-THIS-COMMENT EXEC84.2 +185900 GO TO D80-EXIT. EXEC84.2 +186000 EXEC84.2 +186100 D80-20-ALPHABETIC-CHECK. EXEC84.2 +186200 IF WC-COL-7 NOT ALPHABETIC EXEC84.2 +186300 GO TO D80-30-PRINT-LINE. EXEC84.2 +186400 EXEC84.2 +186500 IF WC-COL-7 NOT = SPACE EXEC84.2 +186600 PERFORM D82-OPTIONAL-LETTER. EXEC84.2 +186700 EXEC84.2 +186800 D80-30-PRINT-LINE. EXEC84.2 +186900 IF WZ-DELETE-FLAG = SPACE EXEC84.2 +187000 PERFORM D85-X-CARD-CHECK. EXEC84.2 +187100 EXEC84.2 +187200 D80-EXIT. EXEC84.2 +187300 EXIT. EXEC84.2 +187400 EXEC84.2 +187500/ EXEC84.2 +187600 D82-OPTIONAL-LETTER SECTION. EXEC84.2 +187700*=========================== EXEC84.2 +187800* EXEC84.2 +187900 D82-1-SELECT-OPTIONAL. EXEC84.2 +188000 PERFORM D83-CHECK-OPTION-SWITCHES EXEC84.2 +188100 VARYING SUB4 FROM 1 BY 1 EXEC84.2 +188200 UNTIL SUB4 > 26. EXEC84.2 +188300 EXEC84.2 +188400 IF WZ-OPTIONAL-SELECTED = "Y" EXEC84.2 +188500 MOVE SPACE TO WC-COL-7 EXEC84.2 +188600 GO TO D82-EXIT. EXEC84.2 +188700 EXEC84.2 +188800 D82-10-SAVE-OPTIONAL. EXEC84.2 +188900 ADD 1 TO WZ-CODE-REMOVED. EXEC84.2 +189000 IF WY-KILL-DELETIONS = "Y" EXEC84.2 +189100 MOVE "Y" TO WZ-DELETE-FLAG EXEC84.2 +189200 ELSE EXEC84.2 +189300 MOVE WC-COL-7 TO WC-COL-8 EXEC84.2 +189400 MOVE "*" TO WC-COL-7. EXEC84.2 +189500 EXEC84.2 +189600 D82-EXIT. EXEC84.2 +189700 EXIT. EXEC84.2 +189800 EXEC84.2 +189900 EXEC84.2 +190000 EXEC84.2 +190100 EXEC84.2 +190200 EXEC84.2 +190300 D83-CHECK-OPTION-SWITCHES SECTION. EXEC84.2 +190400*================================= EXEC84.2 +190500* EXEC84.2 +190600 D83-1-CHECK-SWITCH. EXEC84.2 +190700 IF WY-OPT-SW (SUB4) = WC-COL-7 EXEC84.2 +190800 MOVE 99 TO SUB4 EXEC84.2 +190900 MOVE "Y" TO WZ-OPTIONAL-SELECTED. EXEC84.2 +191000 EXEC84.2 +191100 D83-EXIT. EXEC84.2 +191200 EXIT. EXEC84.2 +191300/ EXEC84.2 +191400 D85-X-CARD-CHECK SECTION. EXEC84.2 +191500*======================== EXEC84.2 +191600* EXEC84.2 +191700**************************************************************** EXEC84.2 +191800* WHEN "XXXX" IS ENCOUNTERED IN COLUMNS 12 - 15 THIS * EXEC84.2 +191900* SECTION EITHER SUBSTITUTES THE IMPLEMENTOR ASSIGNED TEXT * EXEC84.2 +192000* OR MOVES THE PROGRAM NAME TO AN IMPLEMENTOR SPECIFIED * EXEC84.2 +192100* POSITION IN THE PROGRAM CODE. * EXEC84.2 +192200* * EXEC84.2 +192300* PERFORMED BY D80-RAW-LINE * EXEC84.2 +192400* PERFORMS D87-PROGRAM-NAME * EXEC84.2 +192500* D86-REMOVE-FULL-STOP * EXEC84.2 +192600* D86-INSERT-FULL-STOP * EXEC84.2 +192700**************************************************************** EXEC84.2 +192800 D85-1-CHECK-FOR-XXXXX. EXEC84.2 +192900 IF WC-12-15 NOT = "XXXX" EXEC84.2 +193000 GO TO D85-EXIT. EXEC84.2 +193100 IF WC-17-19 NOT NUMERIC EXEC84.2 +193200* XXXXX ENTRY IN POPULATION FILE IN ERROR. EXEC84.2 +193300 GO TO D85-EXIT. EXEC84.2 +193400 EXEC84.2 +193500 D85-10-SUBSTITUTION-REQUIRED. EXEC84.2 +193600 MOVE WC-17-19 TO SUB1. EXEC84.2 +193700 MOVE WX-X-CARD (SUB1) TO WZ-X-CARD. EXEC84.2 +193800 IF WX-PROG-POS (SUB1) NOT = ZERO EXEC84.2 +193900 PERFORM D88-PROGRAM-NAME EXEC84.2 +194000 GO TO D85-EXIT. EXEC84.2 +194100 EXEC84.2 +194200 D85-20-TEXT-SUBSTITUTION. EXEC84.2 +194300 IF WC-20 = SPACE EXEC84.2 +194400 PERFORM D86-REMOVE-FULL-STOP EXEC84.2 +194500 VARYING SUB4 FROM 60 BY -1 EXEC84.2 +194600 UNTIL SUB4 < 1 EXEC84.2 +194700 MOVE WZ-X-CARD TO WC-SUB-DATA EXEC84.2 +194800 GO TO D85-EXIT. EXEC84.2 +194900 EXEC84.2 +195000 IF WC-20 = "." EXEC84.2 +195100 PERFORM D87-INSERT-FULL-STOP EXEC84.2 +195200 VARYING SUB4 FROM 60 BY -1 EXEC84.2 +195300 UNTIL SUB4 < 1 EXEC84.2 +195400 MOVE WZ-X-CARD TO WC-SUB-DATA. EXEC84.2 +195500 D85-EXIT. EXEC84.2 +195600 EXIT. EXEC84.2 +195700 EXEC84.2 +195800/ EXEC84.2 +195900 D86-REMOVE-FULL-STOP SECTION. EXEC84.2 +196000*============================ EXEC84.2 +196100* EXEC84.2 +196200 D86-1. EXEC84.2 +196300 IF WZ-X-CHAR (SUB4) = SPACE EXEC84.2 +196400 GO TO D86-EXIT. EXEC84.2 +196500 EXEC84.2 +196600 IF WZ-X-CHAR (SUB4) = "." EXEC84.2 +196700 MOVE SPACE TO WZ-X-CHAR (SUB4) EXEC84.2 +196800 MOVE ZERO TO SUB4 EXEC84.2 +196900 ELSE EXEC84.2 +197000 MOVE ZERO TO SUB4. EXEC84.2 +197100 EXEC84.2 +197200 D86-EXIT. EXEC84.2 +197300 EXIT. EXEC84.2 +197400 EXEC84.2 +197500 EXEC84.2 +197600 EXEC84.2 +197700 EXEC84.2 +197800 EXEC84.2 +197900 D87-INSERT-FULL-STOP SECTION. EXEC84.2 +198000*============================ EXEC84.2 +198100* EXEC84.2 +198200 D87-1. EXEC84.2 +198300 IF WZ-X-CHAR (SUB4) = SPACE EXEC84.2 +198400 GO TO D87-EXIT. EXEC84.2 +198500 EXEC84.2 +198600 IF WZ-X-CHAR (SUB4) = "." EXEC84.2 +198700 MOVE ZERO TO SUB4 EXEC84.2 +198800 ELSE EXEC84.2 +198900 ADD 1 TO SUB4 EXEC84.2 +199000 MOVE "." TO WZ-X-CHAR (SUB4) EXEC84.2 +199100 MOVE ZERO TO SUB4. EXEC84.2 +199200 EXEC84.2 +199300 D87-EXIT. EXEC84.2 +199400 EXIT. EXEC84.2 +199500/ EXEC84.2 +199600 D88-PROGRAM-NAME SECTION. EXEC84.2 +199700*======================== EXEC84.2 +199800* EXEC84.2 +199900 D88-1. EXEC84.2 +200000 MOVE WX-PROG-POS (SUB1) TO SUB2. EXEC84.2 +200100 MOVE SPACE TO WZ-MAIN-PROG-FLAG. EXEC84.2 +200200 MOVE SPACE TO WZ-FULL-STOP. EXEC84.2 +200300 IF WC-20 = "." EXEC84.2 +200400 MOVE "Y" TO WZ-FULL-STOP. EXEC84.2 +200500 EXEC84.2 +200600 IF WX-X-CHAR (SUB1 SUB2) = "J" EXEC84.2 +200700 MOVE WZ-CURRENT-MAIN-PROG TO WZ-PROG-BREAK EXEC84.2 +200800 MOVE "Y" TO WZ-MAIN-PROG-FLAG EXEC84.2 +200900 ELSE EXEC84.2 +201000 MOVE WZ-CURRENT-POP-PROG TO WZ-PROG-BREAK. EXEC84.2 +201100 EXEC84.2 +201200 IF WZ-CURRENT-MAIN-PROG = SPACE EXEC84.2 +201300 MOVE SPACE TO WZ-MAIN-PROG-FLAG. EXEC84.2 +201400 EXEC84.2 +201500 MOVE 1 TO SUB4. EXEC84.2 +201600 PERFORM D89-MOVE-PROGRAM-NAME 6 TIMES. EXEC84.2 +201700 EXEC84.2 +201800 IF WZ-FULL-STOP = "Y" EXEC84.2 +201900 PERFORM D87-INSERT-FULL-STOP EXEC84.2 +202000 VARYING SUB4 FROM 60 BY -1 EXEC84.2 +202100 UNTIL SUB4 < 1 EXEC84.2 +202200 ELSE EXEC84.2 +202300 PERFORM D86-REMOVE-FULL-STOP EXEC84.2 +202400 VARYING SUB4 FROM 60 BY -1 EXEC84.2 +202500 UNTIL SUB4 < 1. EXEC84.2 +202600 EXEC84.2 +202700 MOVE WZ-X-CARD TO WC-SUB-DATA. EXEC84.2 +202800 EXEC84.2 +202900 D88-EXIT. EXEC84.2 +203000 EXIT. EXEC84.2 +203100 EXEC84.2 +203200 EXEC84.2 +203300 EXEC84.2 +203400 EXEC84.2 +203500 D89-MOVE-PROGRAM-NAME SECTION. EXEC84.2 +203600*============================= EXEC84.2 +203700* EXEC84.2 +203800 D89-1. EXEC84.2 +203900* IF WZ-MAIN-PROG-FLAG = "Y" EXEC84.2 +204000* MOVE WZ-MAIN-PROG-CHAR (SUB4) EXEC84.2 +204100* TO WZ-X-CHAR (SUB2) EXEC84.2 +204200* ELSE EXEC84.2 +204300* MOVE WZ-UPD-PROG-CHAR (SUB4) EXEC84.2 +204400* TO WZ-X-CHAR (SUB2). EXEC84.2 +204500 EXEC84.2 +204600 MOVE WZ-1CHAR(SUB4) TO WZ-X-CHAR(SUB2). EXEC84.2 +204700 EXEC84.2 +204800 IF SUB4 = 6 AND WZ-X-CHAR(SUB2) = SPACE EXEC84.2 +204900 ADD 1 SUB2 GIVING SUB4 EXEC84.2 +205000 PERFORM D89-2-CLOSE-SPACE UNTIL WZ-X-CHAR(SUB4) = EXEC84.2 +205100 SPACE EXEC84.2 +205200 MOVE SPACE TO WZ-X-CHAR(SUB2). EXEC84.2 +205300 EXEC84.2 +205400 ADD 1 TO SUB2. EXEC84.2 +205500 ADD 1 TO SUB4. EXEC84.2 +205600 EXEC84.2 +205700 D89-EXIT. EXEC84.2 +205800 EXIT. EXEC84.2 +205900 EXEC84.2 +206000 D89-2-CLOSE-SPACE SECTION. EXEC84.2 +206100 D89-2-1. EXEC84.2 +206200 EXEC84.2 +206300 MOVE WZ-X-CHAR(SUB4) TO WZ-X-CHAR(SUB2). EXEC84.2 +206400 ADD 1 TO SUB2 SUB4. EXEC84.2 +206500 EXEC84.2 +206600/ EXEC84.2 +206700 D90-PROCESS-END-OF SECTION. EXEC84.2 +206800*========================== EXEC84.2 +206900* EXEC84.2 +207000**************************************************************** EXEC84.2 +207100* WHEN A "*END-OF"CARD IS ENCOUNTERED THIS SECTION PERFORMS * EXEC84.2 +207200* THE END-OF-PROGRAMS ACTIONS. * EXEC84.2 +207300* * EXEC84.2 +207400* PERFORMED BY D20-PROCESS-POPFILE * EXEC84.2 +207500* PERFORMS X10-WRITE-UPDATED-POP * EXEC84.2 +207600**************************************************************** EXEC84.2 +207700 D90-1-CHECK-HEADER-TYPE. EXEC84.2 +207800 IF WY-KILL-DELETIONS = "Y" EXEC84.2 +207900 MOVE "DELETED" TO WA-OPTIONAL-CODE EXEC84.2 +208000 ELSE EXEC84.2 +208100 MOVE "UNUSED " TO WA-OPTIONAL-CODE. EXEC84.2 +208200 EXEC84.2 +208300 MOVE WZ-CURRENT-POP-PROG TO WA-CURRENT-PROG EXEC84.2 +208400 MOVE WZ-LINES-COBOL TO WA-LINES-COBOL EXEC84.2 +208500 MOVE WZ-LINES-INSERTED TO WA-LINES-INSERTED EXEC84.2 +208600 MOVE WZ-LINES-REPLACED TO WA-LINES-REPLACED EXEC84.2 +208700 MOVE WZ-LINES-DELETED TO WA-LINES-DELETED EXEC84.2 +208800 MOVE WZ-CODE-REMOVED TO WA-CODE-REMOVED EXEC84.2 +208900 MOVE WZ-COMMENTS-DELETED TO WA-COMMENTS-DEL EXEC84.2 +209000 MOVE WA-ACCT-LINE-1 TO PRINT-DATA EXEC84.2 +209100 PERFORM X20-PRINT-DETAIL EXEC84.2 +209200 MOVE WA-ACCT-LINE-2 TO PRINT-DATA EXEC84.2 +209300 PERFORM X20-PRINT-DETAIL EXEC84.2 +209400 MOVE WA-ACCT-LINE-3 TO PRINT-DATA EXEC84.2 +209500 PERFORM X20-PRINT-DETAIL EXEC84.2 +209600 EXEC84.2 +209700 MOVE SPACES TO WZ-CURRENT-POP-PROG. EXEC84.2 +209800* CLOSE SOURCE-COBOL-PROGRAMS. EXEC84.2 +209900 EXEC84.2 +210000 D90-EXIT. EXEC84.2 +210100 EXIT. EXEC84.2 +210200 EXEC84.2 +210300 EXEC84.2 +210400 D100-PROCESS-DATA. EXEC84.2 +210500 EXIT. EXEC84.2 +210600 EXEC84.2 +210700/ EXEC84.2 +210800 E10-TERMINATE SECTION. EXEC84.2 +210900*===================== EXEC84.2 +211000* EXEC84.2 +211100**************************************************************** EXEC84.2 +211200* THIS SECTION CLOSES ANY OPEN FILES * EXEC84.2 +211300* * EXEC84.2 +211400* * EXEC84.2 +211500**************************************************************** EXEC84.2 +211600 E10-1. EXEC84.2 +211700 CLOSE PRINT-FILE. EXEC84.2 +211800 EXEC84.2 +211900 CLOSE CONTROL-CARD-FILE. EXEC84.2 +212000 EXEC84.2 +212100 IF WY-NEW-POP = "Y" EXEC84.2 +212200 CLOSE UPDATED-POPULATION-FILE. EXEC84.2 +212300 EXEC84.2 +212400***************************************************************** EXEC84.2 +212500 IF WY-NO-SOURCE = SPACE EXEC84.2 +212600 CLOSE SOURCE-COBOL-PROGRAMS. EXEC84.2 +212700 EXEC84.2 +212800 CLOSE POPULATION-FILE. EXEC84.2 +212900 STOP RUN. EXEC84.2 +213000 E20-EXIT. EXEC84.2 +213100 EXIT. EXEC84.2 +213200 EXEC84.2 +213300/ EXEC84.2 +213400 X10-WRITE-UPDATED-POPFILE SECTION. EXEC84.2 +213500*================================= EXEC84.2 +213600* EXEC84.2 +213700 X10-1-CHECK-FOR-NC114. EXEC84.2 +213800* N.B. EXEC84.2 +213900* NC114A HAS MISCELLANEOUS CHARACTERS IN COLUMNS 1-6 AND SO EXEC84.2 +214000* SHOULD NOT BE RESEQUENCED BY THIS EXECUTIVE. EXEC84.2 +214100 EXEC84.2 +214200 IF WZ-CURRENT-POP-PROG = "NC114M" EXEC84.2 +214300 GO TO X10-30-WRITE-FILE. EXEC84.2 +214400 EXEC84.2 +214500 X10-20-RENUMBER-CHECK. EXEC84.2 +214600 IF WC-STAR = "*" EXEC84.2 +214700 GO TO X10-30-WRITE-FILE. EXEC84.2 +214800 IF WZ-RESEQUENCE-THIS = "Y" EXEC84.2 +214900 ADD 100 TO WZ-SEQ-NO EXEC84.2 +215000 MOVE WZ-SEQ-NO TO WC-6. EXEC84.2 +215100 EXEC84.2 +215200 X10-30-WRITE-FILE. EXEC84.2 +215300 MOVE WC-CURRENT-POP-RECORD TO UD-SOURCE-OUT (SUB5). EXEC84.2 +215400 ADD 1 TO SUB5. EXEC84.2 +215500 IF SUB5 GREATER 30 EXEC84.2 +215600 WRITE UPDATED-SOURCE-OUT-2400 EXEC84.2 +215700 MOVE 1 TO SUB5 EXEC84.2 +215800 MOVE SPACE TO UPDATED-SOURCE-OUT-2400. EXEC84.2 +215900 EXEC84.2 +216000 EXEC84.2 +216100 X10-EXIT. EXEC84.2 +216200 EXIT. EXEC84.2 +216300 EXEC84.2 +216400 EXEC84.2 +216500/ EXEC84.2 +216600 X20-PRINT-DETAIL SECTION. EXEC84.2 +216700*======================== EXEC84.2 +216800* EXEC84.2 +216900 X20-1. EXEC84.2 +217000 EXEC84.2 +217100 IF WZ-LINE-CT > 50 EXEC84.2 +217200 MOVE PRINT-REC TO WZ-PRINT-HOLD EXEC84.2 +217300 ADD 1 TO WZ-PAGE-CT EXEC84.2 +217400 MOVE WZ-PAGE-CT TO WA-PAGE-CT EXEC84.2 +217500 MOVE WA-TOP-OF-PAGE-LINE EXEC84.2 +217600 TO PRINT-REC EXEC84.2 +217700 WRITE PRINT-REC AFTER PAGE EXEC84.2 +217800 MOVE SPACE TO PRINT-REC EXEC84.2 +217900 WRITE PRINT-REC EXEC84.2 +218000 MOVE WZ-PRINT-HOLD TO PRINT-REC EXEC84.2 +218100 MOVE ZERO TO WZ-LINE-CT. EXEC84.2 +218200 ADD 1 TO WZ-LINE-CT. EXEC84.2 +218300 EXEC84.2 +218400 X20-2. EXEC84.2 +218500 WRITE PRINT-REC AFTER 1. EXEC84.2 +218600 MOVE SPACE TO PRINT-REC. EXEC84.2 +218700 EXEC84.2 +218800 X20-EXIT. EXEC84.2 +218900 EXIT. EXEC84.2 +219000/ EXEC84.2 +219100 X30-READ-POPFILE SECTION. EXEC84.2 +219200*======================== EXEC84.2 +219300 X30-1. EXEC84.2 +219400 IF WZ-DONT-READ-POPFILE = "Y" EXEC84.2 +219500 MOVE SPACE TO WZ-DONT-READ-POPFILE EXEC84.2 +219600 GO TO X30-EXIT. EXEC84.2 +219700 EXEC84.2 +219800* IF SUB1 GREATER THAN 30 EXEC84.2 +219900 READ POPULATION-FILE INTO WC-CURRENT-POP-RECORD EXEC84.2 +220000 AT END MOVE "Y" TO WZ-END-OF-POPFILE EXEC84.2 +220100 MOVE "*HEADER" TO WC-STAR-HEADER EXEC84.2 +220200 GO TO X30-EXIT. EXEC84.2 +220300 MOVE WC-CURRENT-POP-RECORD TO WZ-SAVE-POP-RECORD. EXEC84.2 +220400 EXEC84.2 +220500 IF WC-STAR = "*" EXEC84.2 +220600 IF WZ-CURRENT-HEADER = "COBOL" EXEC84.2 +220700 IF WC-1-5 = "ABCDE" EXEC84.2 +220800 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +220900 ELSE EXEC84.2 +221000 IF WC-1-5 = "*/+(>" EXEC84.2 +221100 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +221200 ELSE EXEC84.2 +221300 IF WC-1-5 = "999-9" EXEC84.2 +221400 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +221500 ELSE EXEC84.2 +221600 IF WC-1-5 = "Z=.,;" EXEC84.2 +221700 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +221800 ELSE EXEC84.2 +221900 IF WC-1-5 = ")14$ " EXEC84.2 +222000 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +222100 ELSE EXEC84.2 +222200 IF WC-1-5 = " 23 " EXEC84.2 +222300 ADD 1 TO WZ-LINES-COBOL EXEC84.2 +222400 ELSE EXEC84.2 +222500 NEXT SENTENCE EXEC84.2 +222600 ELSE EXEC84.2 +222700 NEXT SENTENCE EXEC84.2 +222800 ELSE EXEC84.2 +222900 IF WZ-CURRENT-HEADER = "COBOL" EXEC84.2 +223000 ADD 1 TO WZ-LINES-COBOL. EXEC84.2 +223100 EXEC84.2 +223200* MOVE SOURCE-IN (SUB1) TO WC-CURRENT-POP-RECORD. EXEC84.2 +223300* ADD 1 TO SUB1. EXEC84.2 +223400 EXEC84.2 +223500 EXEC84.2 +223600 X30-EXIT. EXEC84.2 +223700 EXIT. EXEC84.2 +223800 EXEC84.2 +223900 EXEC84.2 +224000 EXEC84.2 +224100 EXEC84.2 +224200 EXEC84.2 +224300 X40-WRITE-SOURCE-FILE SECTION. EXEC84.2 +224400*= =========================== EXEC84.2 +224500 X40-1. EXEC84.2 +224600 MOVE SPACES TO WD-1. EXEC84.2 +224700* IF BLOCK-TYPE NOT = "DATA*" EXEC84.2 +224800* MOVE SPACES TO WC-73-80. EXEC84.2 +224900 IF WC-STAR = "*" EXEC84.2 +225000 IF WC-1-5 = "*/+(>" EXEC84.2 +225100 WRITE CT-OUT FROM WC-CURRENT-POP-RECORD EXEC84.2 +225200 ELSE EXEC84.2 +225300 MOVE WC-CURRENT-POP-RECORD TO WD-HEADER EXEC84.2 +225400 WRITE CT-OUT FROM WD-SOURCE-REC EXEC84.2 +225500 ELSE EXEC84.2 +225600 WRITE CT-OUT FROM WC-CURRENT-POP-RECORD. EXEC84.2 +225700 EXEC84.2 +225800 X40-EXIT. EXEC84.2 +225900 EXIT. EXEC84.2 +226000 EXEC84.2 +*END-OF,EXEC85 +*HEADER,CLBRY,ALTL1 +000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTL14.2 +000200* EQUATED TO THE X-48 (XXXXX048) CARD. ALTL14.2 +000300 PERFORM FAIL. ALTL14.2 +000400 SUBTRACT 1 FROM ERROR-COUNTER. ALTL14.2 +000500 MOVE "TEXT COPIED FROM WRONG LIBRARY" TO RE-MARK. ALTL14.2 +*END-OF,ALTL1 +*HEADER,CLBRY,ALTLB +000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTLB4.2 +000200* EQUATED TO THE X-47 (XXXXX047) CARD. ALTLB4.2 +000300 MOVE SPACES TO RE-MARK. ALTLB4.2 +000400 PERFORM PASS. ALTLB4.2 +000500 SUBTRACT 1 FROM ERROR-COUNTER. ALTLB4.2 +*END-OF,ALTLB +*HEADER,COBOL,CM101M +000100 IDENTIFICATION DIVISION. CM1014.2 +000200 PROGRAM-ID. CM1014.2 +000300 CM101M. CM1014.2 +000400 AUTHOR. CM1014.2 +000500 FEDERAL COMPILER TESTING CENTER. CM1014.2 +000600 INSTALLATION. CM1014.2 +000700 GENERAL SERVICES ADMINISTRATION CM1014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM1014.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM1014.2 +001100 FALLS CHURCH VIRGINIA 22041. CM1014.2 +001200 CM1014.2 +001300 PHONE (703) 756-6153 CM1014.2 +001400 CM1014.2 +001500 " HIGH ". CM1014.2 +001600 DATE-WRITTEN. CM1014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1014.2 +001800 CREATION DATE / VALIDATION DATE CM1014.2 +001900 "4.2 ". CM1014.2 +002000 SECURITY. CM1014.2 +002100 NONE. CM1014.2 +002200 ENVIRONMENT DIVISION. CM1014.2 +002300 CONFIGURATION SECTION. CM1014.2 +002400 SOURCE-COMPUTER. CM1014.2 +002500 XXXXX082. CM1014.2 +002600 OBJECT-COMPUTER. CM1014.2 +002700 XXXXX083. CM1014.2 +002800 INPUT-OUTPUT SECTION. CM1014.2 +002900 FILE-CONTROL. CM1014.2 +003000 SELECT PRINT-FILE ASSIGN TO CM1014.2 +003100 XXXXX055. CM1014.2 +003200 DATA DIVISION. CM1014.2 +003300 FILE SECTION. CM1014.2 +003400 FD PRINT-FILE CM1014.2 +003500 LABEL RECORDS CM1014.2 +003600 XXXXX084 CM1014.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1014.2 +003800 01 PRINT-REC PICTURE X(120). CM1014.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM1014.2 +004000 WORKING-STORAGE SECTION. CM1014.2 +004100 77 PASSWORD1 PIC X(10) VALUE CM1014.2 +004200 XXXXX031. CM1014.2 +004300 77 DISABLE-STATUS PIC XX VALUE "99". CM1014.2 +004400 77 POLL-COUNT PIC 9(8). CM1014.2 +004500 77 INIT-TIME PIC 9(8). CM1014.2 +004600 77 COMP-TIME PIC 9(8). CM1014.2 +004700 01 SYSTEM-TIME. CM1014.2 +004800 02 SYS-HRS PIC 99. CM1014.2 +004900 02 SYS-MINS PIC 99. CM1014.2 +005000 02 SYS-SECS PIC 99V99. CM1014.2 +005100 01 MSG-TIME. CM1014.2 +005200 02 HOURS PIC 99. CM1014.2 +005300 02 MINUTES PIC 99. CM1014.2 +005400 02 SECONDS PIC 99V99. CM1014.2 +005500 01 SPEC-LINE-1. CM1014.2 +005600 02 FILLER PIC X(40) VALUE CM1014.2 +005700 " INITIAL ENABLE RETURNED STATUS CODE OF ". CM1014.2 +005800 02 INIT-ENABLE-STATUS PIC XX. CM1014.2 +005900 01 INCOMING-MSG. CM1014.2 +006000 02 KILL-FIELD PIC X(4). CM1014.2 +006100 02 FILLER PIC X(68). CM1014.2 +006200 01 LOG-HDR-1. CM1014.2 +006300 02 FILLER PIC X(48) VALUE SPACES. CM1014.2 +006400 02 FILLER PIC X(24) VALUE "LOG OF INCOMING MESSAGES". CM1014.2 +006500 01 LOG-HDR-2. CM1014.2 +006600 02 FILLER PIC X VALUE SPACE. CM1014.2 +006700 02 FILLER PIC X(19) VALUE "SYMBOLIC SOURCE IS ". CM1014.2 +006800 02 SYM-SOURCE PIC X(25). CM1014.2 +006900 02 FILLER PIC X(16) VALUE "MESSAGE DATE IS ". CM1014.2 +007000 02 MSG-DATE PIC 9(6) VALUE ZERO. CM1014.2 +007100 01 LOG-HDR-3. CM1014.2 +007200 02 FILLER PIC X VALUE SPACE. CM1014.2 +007300 02 FILLER PIC X(12) VALUE "TIME RECVD". CM1014.2 +007400 02 FILLER PIC X(9) VALUE "LOG LAG". CM1014.2 +007500 02 FILLER PIC X(7) VALUE "LENGTH". CM1014.2 +007600 02 FILLER PIC X(4) VALUE "END". CM1014.2 +007700 02 FILLER PIC X(3) VALUE "QD". CM1014.2 +007800 02 FILLER PIC X(40) VALUE "POLL COUNT". CM1014.2 +007900 02 FILLER PIC X(16) VALUE "MESSAGE CONTENTS". CM1014.2 +008000 01 LOG-HDR-4. CM1014.2 +008100 02 FILLER PIC X VALUE SPACE. CM1014.2 +008200 02 FILLER PIC X(11) VALUE ALL "-". CM1014.2 +008300 02 FILLER PIC X VALUE SPACES. CM1014.2 +008400 02 FILLER PIC X(7) VALUE ALL "-". CM1014.2 +008500 02 FILLER PIC X(2) VALUE SPACES. CM1014.2 +008600 02 FILLER PIC X(6) VALUE ALL "-". CM1014.2 +008700 02 FILLER PIC X VALUE SPACE. CM1014.2 +008800 02 FILLER PIC XXX VALUE "---". CM1014.2 +008900 02 FILLER PIC X VALUE SPACES. CM1014.2 +009000 02 FILLER PIC XX VALUE "--". CM1014.2 +009100 02 FILLER PIC X VALUE SPACES. CM1014.2 +009200 02 FILLER PIC X(10) VALUE ALL "-". CM1014.2 +009300 02 FILLER PIC X(2) VALUE SPACES. CM1014.2 +009400 02 FILLER PIC X(72) VALUE ALL "-". CM1014.2 +009500 01 LOG-LINE. CM1014.2 +009600 02 FILLER PIC X VALUE SPACE. CM1014.2 +009700 02 RECEIPT-TIME. CM1014.2 +009800 03 HOURS PIC 99. CM1014.2 +009900 03 FILLER PIC X VALUE ":". CM1014.2 +010000 03 MINUTES PIC 99. CM1014.2 +010100 03 FILLER PIC X VALUE ":". CM1014.2 +010200 03 SECONDS PIC 99.99. CM1014.2 +010300 02 LAG-TIME PIC -(4)9.99. CM1014.2 +010400 02 FILLER PIC XX VALUE SPACES. CM1014.2 +010500 02 MESSAGE-LENGTH PIC ZZZ9. CM1014.2 +010600 02 FILLER PIC XXX VALUE SPACES. CM1014.2 +010700 02 SENTINEL PIC XXX. CM1014.2 +010800 02 FILLER PIC X VALUE SPACES. CM1014.2 +010900 02 QUEUE-DEPTH PIC 99. CM1014.2 +011000 02 FILLER PIC X VALUE SPACES. CM1014.2 +011100 02 IDLE-COUNT PIC ZZ,ZZZ,ZZ9. CM1014.2 +011200 02 IDLE-OVERFLOW REDEFINES IDLE-COUNT PIC X(10). CM1014.2 +011300 02 FILLER PIC XX VALUE SPACES. CM1014.2 +011400 02 MSG PIC X(72). CM1014.2 +011500 66 LONG-NARRATIVE RENAMES LAG-TIME THRU MSG. CM1014.2 +011600 66 SHORT-NARRATIVE RENAMES IDLE-COUNT THRU MSG. CM1014.2 +011700 01 TEST-RESULTS. CM1014.2 +011800 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +011900 02 FEATURE PICTURE X(18). CM1014.2 +012000 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +012100 02 P-OR-F PICTURE X(5). CM1014.2 +012200 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +012300 02 PAR-NAME PIC X(20). CM1014.2 +012400 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +012500 02 COMPUTED-A. CM1014.2 +012600 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 +012700 03 COMPUTED-STATUS PIC XX. CM1014.2 +012800 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 +012900 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +013000 02 CORRECT-A. CM1014.2 +013100 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 +013200 03 CORRECT-STATUS PIC XX. CM1014.2 +013300 03 FILLER PIC X(9) VALUE SPACES. CM1014.2 +013400 02 FILLER PICTURE X VALUE SPACE. CM1014.2 +013500 02 RE-MARK PICTURE X(30). CM1014.2 +013600 01 COLUMNS-LINE-1. CM1014.2 +013700 02 FILLER PIC X(3) VALUE SPACES. CM1014.2 +013800 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1014.2 +013900 02 FILLER PIC X(9) VALUE "RESLT". CM1014.2 +014000 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1014.2 +014100 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1014.2 +014200 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1014.2 +014300 02 FILLER PIC X(7) VALUE "REMARKS". CM1014.2 +014400 01 COLUMNS-LINE-2. CM1014.2 +014500 02 FILLER PIC X VALUE SPACE. CM1014.2 +014600 02 FILLER PIC X(18) VALUE ALL "-". CM1014.2 +014700 02 FILLER PIC X VALUE SPACE. CM1014.2 +014800 02 FILLER PIC X(5) VALUE ALL "-". CM1014.2 +014900 02 FILLER PIC X VALUE SPACE. CM1014.2 +015000 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 +015100 02 FILLER PIC X VALUE SPACE. CM1014.2 +015200 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 +015300 02 FILLER PIC X VALUE SPACE. CM1014.2 +015400 02 FILLER PIC X(20) VALUE ALL "-". CM1014.2 +015500 02 FILLER PIC X VALUE SPACE. CM1014.2 +015600 02 FILLER PIC X(31) VALUE ALL "-". CM1014.2 +015700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1014.2 +015800 01 REC-CT PICTURE 99 VALUE ZERO. CM1014.2 +015900 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1014.2 +016000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1014.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1014.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1014.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1014.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1014.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1014.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1014.2 +016700 01 CCVS-H-1. CM1014.2 +016800 02 FILLER PICTURE X(27) VALUE SPACE. CM1014.2 +016900 02 FILLER PICTURE X(67) VALUE CM1014.2 +017000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1014.2 +017100- " SYSTEM". CM1014.2 +017200 02 FILLER PICTURE X(26) VALUE SPACE. CM1014.2 +017300 01 CCVS-H-2. CM1014.2 +017400 02 FILLER PICTURE X(52) VALUE IS CM1014.2 +017500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1014.2 +017600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1014.2 +017700 02 TEST-ID PICTURE IS X(9). CM1014.2 +017800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1014.2 +017900 01 CCVS-H-3. CM1014.2 +018000 02 FILLER PICTURE X(34) VALUE CM1014.2 +018100 " FOR OFFICIAL USE ONLY ". CM1014.2 +018200 02 FILLER PICTURE X(58) VALUE CM1014.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1014.2 +018400 02 FILLER PICTURE X(28) VALUE CM1014.2 +018500 " COPYRIGHT 1974 ". CM1014.2 +018600 01 CCVS-E-1. CM1014.2 +018700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1014.2 +018800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1014.2 +018900 02 ID-AGAIN PICTURE IS X(9). CM1014.2 +019000 02 FILLER PICTURE X(45) VALUE IS CM1014.2 +019100 " NTIS DISTRIBUTION COBOL 74". CM1014.2 +019200 01 CCVS-E-2. CM1014.2 +019300 02 FILLER PICTURE X(31) VALUE CM1014.2 +019400 SPACE. CM1014.2 +019500 02 FILLER PICTURE X(21) VALUE SPACE. CM1014.2 +019600 02 CCVS-E-2-2. CM1014.2 +019700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1014.2 +019800 03 FILLER PICTURE IS X VALUE IS SPACE. CM1014.2 +019900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1014.2 +020000 01 CCVS-E-3. CM1014.2 +020100 02 FILLER PICTURE X(22) VALUE CM1014.2 +020200 " FOR OFFICIAL USE ONLY". CM1014.2 +020300 02 FILLER PICTURE X(12) VALUE SPACE. CM1014.2 +020400 02 FILLER PICTURE X(58) VALUE CM1014.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1014.2 +020600 02 FILLER PICTURE X(13) VALUE SPACE. CM1014.2 +020700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1014.2 +020800 01 CCVS-E-4. CM1014.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1014.2 +021000 02 FILLER PIC XXXX VALUE " OF ". CM1014.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1014.2 +021200 02 FILLER PIC X(40) VALUE CM1014.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". CM1014.2 +021400 01 XXINFO. CM1014.2 +021500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1014.2 +021600 02 INFO-TEXT. CM1014.2 +021700 04 FILLER PIC X(20) VALUE SPACE. CM1014.2 +021800 04 XXCOMPUTED PIC X(20). CM1014.2 +021900 04 FILLER PIC X(5) VALUE SPACE. CM1014.2 +022000 04 XXCORRECT PIC X(20). CM1014.2 +022100 01 HYPHEN-LINE. CM1014.2 +022200 02 FILLER PICTURE IS X VALUE IS SPACE. CM1014.2 +022300 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1014.2 +022400- "*****************************************". CM1014.2 +022500 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1014.2 +022600- "******************************". CM1014.2 +022700 01 CCVS-PGM-ID PIC X(6) VALUE CM1014.2 +022800 "CM101M". CM1014.2 +022900 COMMUNICATION SECTION. CM1014.2 +023000 CD CM-INQUE-1 FOR INPUT CM1014.2 +023100 SYMBOLIC QUEUE IS MAIN-QUEUE CM1014.2 +023200 SYMBOLIC SUB-QUEUE-1 IS NO-SPEC-1 CM1014.2 +023300 SYMBOLIC SUB-QUEUE-2 IS NO-SPEC-2 CM1014.2 +023400 SYMBOLIC SUB-QUEUE-3 IS NO-SPEC-3 CM1014.2 +023500 MESSAGE DATE IS DATE-RECEIVED CM1014.2 +023600 MESSAGE TIME IS TIME-RECEIVED CM1014.2 +023700 SYMBOLIC SOURCE IS WHERE-FROM CM1014.2 +023800 TEXT LENGTH IS MSG-LENGTH CM1014.2 +023900 END KEY IS END-KEY CM1014.2 +024000 STATUS KEY IS STATUS-KEY CM1014.2 +024100 MESSAGE COUNT IS MSG-COUNT. CM1014.2 +024200 PROCEDURE DIVISION. CM1014.2 +024300 SECT-CM101M-0001 SECTION. CM1014.2 +024400 CM101M-INIT. CM1014.2 +024500 OPEN OUTPUT PRINT-FILE. CM1014.2 +024600 MOVE "CM101M " TO TEST-ID. CM1014.2 +024700 MOVE TEST-ID TO ID-AGAIN. CM1014.2 +024800 MOVE SPACE TO TEST-RESULTS. CM1014.2 +024900 PERFORM HEAD-ROUTINE. CM1014.2 +025000 MOVE CM1014.2 +025100 XXXXX030 CM1014.2 +025200 TO MAIN-QUEUE. CM1014.2 +025300 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +025400 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +025500 XXXXX031. CM1014.2 +025600 MOVE STATUS-KEY TO INIT-ENABLE-STATUS. CM1014.2 +025700 MOVE SPEC-LINE-1 TO PRINT-REC. CM1014.2 +025800 WRITE PRINT-REC CM1014.2 +025900 AFTER 2 LINES. CM1014.2 +026000 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 +026100 WRITE PRINT-REC CM1014.2 +026200 AFTER 2 LINES. CM1014.2 +026300 LOG-INIT. CM1014.2 +026400 MOVE ZERO TO POLL-COUNT. CM1014.2 +026500 MOVE ALL "*" TO MSG. CM1014.2 +026600 LOG-MSG. CM1014.2 +026700 MOVE SPACES TO INCOMING-MSG. CM1014.2 +026800 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 +026900 NO DATA PERFORM INCREMENT-POLL-COUNT GO TO LOG-MSG. CM1014.2 +027000 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 +027100 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 +027200 IF STATUS-KEY IS NOT EQUAL TO ZERO CM1014.2 +027300 DISPLAY "RUN ABORTED - STATUS KEY WAS " STATUS-KEY CM1014.2 +027400 STOP RUN. CM1014.2 +027500 IF MSG-DATE IS EQUAL TO ZERO PERFORM LOG-HEADER. CM1014.2 +027600 IF KILL-FIELD IS EQUAL TO "KILL" CM1014.2 +027700 ACCEPT INIT-TIME FROM TIME CM1014.2 +027800 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +027900 XXXXX031 CM1014.2 +028000 ACCEPT COMP-TIME FROM TIME CM1014.2 +028100 MOVE STATUS-KEY TO DISABLE-STATUS. CM1014.2 +028200 MOVE TIME-RECEIVED TO MSG-TIME. CM1014.2 +028300 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 +028400 COMPUTE LAG-TIME = CM1014.2 +028500 ((SYS-HRS * 3600) + (SYS-MINS * 60) + SYS-SECS) - CM1014.2 +028600 ((HOURS OF MSG-TIME * 3600) + (MINUTES OF MSG-TIME * 60) CM1014.2 +028700 + SECONDS OF MSG-TIME). CM1014.2 +028800 IF END-KEY IS EQUAL TO "3" CM1014.2 +028900 MOVE "EGI" TO SENTINEL CM1014.2 +029000 ELSE IF END-KEY IS EQUAL TO "2" CM1014.2 +029100 MOVE "EMI" TO SENTINEL CM1014.2 +029200 ELSE MOVE END-KEY TO SENTINEL. CM1014.2 +029300 MOVE MSG-COUNT TO QUEUE-DEPTH. CM1014.2 +029400 MOVE MSG-LENGTH TO MESSAGE-LENGTH. CM1014.2 +029500 IF POLL-COUNT IS EQUAL TO 99999999 CM1014.2 +029600 MOVE " OVERFLOW " TO IDLE-OVERFLOW CM1014.2 +029700 ELSE MOVE POLL-COUNT TO IDLE-COUNT. CM1014.2 +029800 MOVE INCOMING-MSG TO MSG. CM1014.2 +029900 MOVE LOG-LINE TO PRINT-REC. CM1014.2 +030000 PERFORM WRITE-LINE. CM1014.2 +030100 LOG-MSG-01. CM1014.2 +030200 IF KILL-FIELD IS EQUAL TO "WAIT" CM1014.2 +030300 PERFORM GET-INITIAL-TIME CM1014.2 +030400 PERFORM DELAY-FOR-30-SECS CM1014.2 +030500 GO TO LOG-INIT. CM1014.2 +030600 IF KILL-FIELD IS NOT EQUAL TO "KILL" GO TO LOG-INIT. CM1014.2 +030700 DISABLE-CM-INQUE-1. CM1014.2 +030800 MOVE INIT-TIME TO MSG-TIME. CM1014.2 +030900 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 +031000 MOVE "-DISABLE COMMAND INITIATED FROM PROGRAM" CM1014.2 +031100 TO LONG-NARRATIVE. CM1014.2 +031200 MOVE LOG-LINE TO PRINT-REC. CM1014.2 +031300 WRITE PRINT-REC CM1014.2 +031400 AFTER 2 LINES. CM1014.2 +031500 MOVE COMP-TIME TO MSG-TIME. CM1014.2 +031600 MOVE CORR MSG-TIME TO RECEIPT-TIME. CM1014.2 +031700 MOVE "- STATUS CODE OF" TO LONG-NARRATIVE. CM1014.2 +031800 MOVE DISABLE-STATUS TO QUEUE-DEPTH. CM1014.2 +031900 MOVE "AND EXECUTION CONTROL RETURNED FROM MCS" CM1014.2 +032000 TO SHORT-NARRATIVE. CM1014.2 +032100 MOVE LOG-LINE TO PRINT-REC. CM1014.2 +032200 PERFORM WRITE-LINE. CM1014.2 +032300 MOVE SPACES TO PRINT-REC. CM1014.2 +032400 PERFORM WRITE-LINE. CM1014.2 +032500 GET-INITIAL-TIME. CM1014.2 +032600 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 +032700 COMPUTE INIT-TIME = CM1014.2 +032800 SYS-HRS * 3600 + SYS-MINS * 60 + SYS-SECS. CM1014.2 +032900 LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 +033000 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 +033100 IF MSG-COUNT IS NOT EQUAL TO ZERO CM1014.2 +033200 PERFORM LOG-INIT THRU LOG-MSG CM1014.2 +033300 GO TO LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 +033400 GET-TIME-DIFFERENCE. CM1014.2 +033500 ACCEPT SYSTEM-TIME FROM TIME. CM1014.2 +033600 COMPUTE COMP-TIME = CM1014.2 +033700 SYS-HRS * 3600 + SYS-MINS * 60 + SYS-SECS - INIT-TIME. CM1014.2 +033800 CHECK-FOR-15. CM1014.2 +033900 IF COMP-TIME IS LESS THAN 15 CM1014.2 +034000 GO TO LOOK-FOR-LATE-TRANSMISSIONS. CM1014.2 +034100 15-SECONDS-HAVE-ELAPSED. CM1014.2 +034200 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 +034300 WRITE PRINT-REC CM1014.2 +034400 AFTER 2 LINES. CM1014.2 +034500 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 +034600 PERFORM WRITE-LINE. CM1014.2 +034700 STATUS-TESTS-INIT. CM1014.2 +034800 MOVE " BEGIN INPUT STATUS TESTS" TO PRINT-REC. CM1014.2 +034900 WRITE PRINT-REC CM1014.2 +035000 AFTER 2 LINES. CM1014.2 +035100 MOVE COLUMNS-LINE-1 TO PRINT-REC. CM1014.2 +035200 WRITE PRINT-REC CM1014.2 +035300 AFTER 2 LINES. CM1014.2 +035400 MOVE COLUMNS-LINE-2 TO PRINT-REC. CM1014.2 +035500 PERFORM WRITE-LINE. CM1014.2 +035600 MOVE SPACES TO PRINT-REC. CM1014.2 +035700 PERFORM WRITE-LINE. CM1014.2 +035800 MOVE "MCS STATUS WORD" TO FEATURE. CM1014.2 +035900 REC-STATUS-TEST-01. CM1014.2 +036000 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 +036100 MOVE "99" TO STATUS-KEY. CM1014.2 +036200 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +036300 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 +036400 NO DATA ADD 0 TO POLL-COUNT. CM1014.2 +036500 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +036600 PERFORM PASS GO TO REC-STATUS-WRITE-01. CM1014.2 +036700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +036800 MOVE "20" TO CORRECT-STATUS. CM1014.2 +036900 PERFORM FAIL. CM1014.2 +037000 GO TO REC-STATUS-WRITE-01. CM1014.2 +037100 REC-STATUS-DELETE-01. CM1014.2 +037200 PERFORM DE-LETE. CM1014.2 +037300 REC-STATUS-WRITE-01. CM1014.2 +037400 MOVE "REC-STATUS-TEST-01" TO PAR-NAME. CM1014.2 +037500 PERFORM PRINT-DETAIL. CM1014.2 +037600 REC-STATUS-TEST-02. CM1014.2 +037700 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 +037800 MOVE "99" TO STATUS-KEY. CM1014.2 +037900 MOVE CM1014.2 +038000 XXXXX030 CM1014.2 +038100 TO MAIN-QUEUE. CM1014.2 +038200 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 +038300 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 +038400 RECEIVE CM-INQUE-1 MESSAGE INTO INCOMING-MSG CM1014.2 +038500 NO DATA ADD 0 TO POLL-COUNT. CM1014.2 +038600 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +038700 PERFORM PASS GO TO REC-STATUS-WRITE-02. CM1014.2 +038800 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +038900 MOVE "20" TO CORRECT-STATUS. CM1014.2 +039000 PERFORM FAIL. CM1014.2 +039100 GO TO REC-STATUS-WRITE-02. CM1014.2 +039200 REC-STATUS-DELETE-02. CM1014.2 +039300 PERFORM DE-LETE. CM1014.2 +039400 REC-STATUS-WRITE-02. CM1014.2 +039500 MOVE "REC-STATUS-TEST-02" TO PAR-NAME. CM1014.2 +039600 PERFORM PRINT-DETAIL. CM1014.2 +039700 ACCPT-STATUS-TEST-01. CM1014.2 +039800 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 +039900 MOVE "99" TO STATUS-KEY. CM1014.2 +040000 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +040100 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM1014.2 +040200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +040300 PERFORM PASS GO TO ACCPT-STATUS-WRITE-01. CM1014.2 +040400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +040500 MOVE "20" TO CORRECT-STATUS. CM1014.2 +040600 PERFORM FAIL. CM1014.2 +040700 GO TO ACCPT-STATUS-WRITE-01. CM1014.2 +040800 ACCPT-STATUS-DELETE-01. CM1014.2 +040900 PERFORM DE-LETE. CM1014.2 +041000 ACCPT-STATUS-WRITE-01. CM1014.2 +041100 MOVE "ACCPT-STATUS-TEST-01" TO PAR-NAME. CM1014.2 +041200 PERFORM PRINT-DETAIL. CM1014.2 +041300 ACCPT-STATUS-TEST-02. CM1014.2 +041400 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 +041500 MOVE "99" TO STATUS-KEY. CM1014.2 +041600 MOVE CM1014.2 +041700 XXXXX030 CM1014.2 +041800 TO MAIN-QUEUE. CM1014.2 +041900 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 +042000 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 +042100 ACCEPT CM-INQUE-1 COUNT. CM1014.2 +042200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +042300 PERFORM PASS GO TO ACCPT-STATUS-WRITE-02. CM1014.2 +042400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +042500 MOVE "20" TO CORRECT-STATUS. CM1014.2 +042600 PERFORM FAIL. CM1014.2 +042700 GO TO ACCPT-STATUS-WRITE-02. CM1014.2 +042800 ACCPT-STATUS-DELETE-02. CM1014.2 +042900 PERFORM DE-LETE. CM1014.2 +043000 ACCPT-STATUS-WRITE-02. CM1014.2 +043100 MOVE "ACCPT-STATUS-TEST-02" TO PAR-NAME. CM1014.2 +043200 PERFORM PRINT-DETAIL. CM1014.2 +043300 ENABL-STATUS-TEST-01. CM1014.2 +043400 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 +043500 MOVE "99" TO STATUS-KEY. CM1014.2 +043600 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +043700 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +043800 XXXXX031 CM1014.2 +043900 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +044000 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM1014.2 +044100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +044200 MOVE "20" TO CORRECT-STATUS. CM1014.2 +044300 PERFORM FAIL. CM1014.2 +044400 GO TO ENABL-STATUS-WRITE-01. CM1014.2 +044500 ENABL-STATUS-DELETE-01. CM1014.2 +044600 PERFORM DE-LETE. CM1014.2 +044700 ENABL-STATUS-WRITE-01. CM1014.2 +044800 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM1014.2 +044900 PERFORM PRINT-DETAIL. CM1014.2 +045000 ENABL-STATUS-TEST-02. CM1014.2 +045100 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 +045200 MOVE "99" TO STATUS-KEY. CM1014.2 +045300 MOVE CM1014.2 +045400 XXXXX030 CM1014.2 +045500 TO MAIN-QUEUE. CM1014.2 +045600 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 +045700 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 +045800 ENABLE INPUT CM-INQUE-1 KEY CM1014.2 +045900 PASSWORD1. CM1014.2 +046000 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +046100 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM1014.2 +046200 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +046300 MOVE "20" TO CORRECT-STATUS. CM1014.2 +046400 PERFORM FAIL. CM1014.2 +046500 GO TO ENABL-STATUS-WRITE-02. CM1014.2 +046600 ENABL-STATUS-DELETE-02. CM1014.2 +046700 PERFORM DE-LETE. CM1014.2 +046800 ENABL-STATUS-WRITE-02. CM1014.2 +046900 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM1014.2 +047000 PERFORM PRINT-DETAIL. CM1014.2 +047100 ENABL-STATUS-TEST-03. CM1014.2 +047200 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1014.2 +047300 MOVE "99" TO STATUS-KEY. CM1014.2 +047400 MOVE CM1014.2 +047500 XXXXX030 CM1014.2 +047600 TO MAIN-QUEUE. CM1014.2 +047700 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +047800 ENABLE INPUT CM-INQUE-1 WITH KEY "LETMEIN". CM1014.2 +047900 IF STATUS-KEY IS EQUAL TO "40" CM1014.2 +048000 PERFORM PASS GO TO ENABL-STATUS-WRITE-03. CM1014.2 +048100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +048200 MOVE "40" TO CORRECT-STATUS. CM1014.2 +048300 PERFORM FAIL. CM1014.2 +048400 GO TO ENABL-STATUS-WRITE-03. CM1014.2 +048500 ENABL-STATUS-DELETE-03. CM1014.2 +048600 PERFORM DE-LETE. CM1014.2 +048700 ENABL-STATUS-WRITE-03. CM1014.2 +048800 MOVE "ENABL-STATUS-TEST-03" TO PAR-NAME. CM1014.2 +048900 PERFORM PRINT-DETAIL. CM1014.2 +049000 ENABL-STATUS-TEST-04. CM1014.2 +049100 MOVE "NO QUEUE NAME / WRONG PASSWORD" TO RE-MARK. CM1014.2 +049200 MOVE "99" TO STATUS-KEY. CM1014.2 +049300 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +049400 ENABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +049500 "LETMEIN". CM1014.2 +049600 MOVE "INFO" TO P-OR-F. CM1014.2 +049700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +049800 MOVE " INFO TEST FOR BOTH" TO CORRECT-A. CM1014.2 +049900 GO TO ENABL-STATUS-WRITE-04. CM1014.2 +050000 ENABL-STATUS-DELETE-04. CM1014.2 +050100 PERFORM DE-LETE. CM1014.2 +050200 ENABL-STATUS-WRITE-04. CM1014.2 +050300 MOVE "ENABL-STATUS-TEST-04" TO PAR-NAME. CM1014.2 +050400 PERFORM PRINT-DETAIL. CM1014.2 +050500 DISAB-STATUS-TEST-01. CM1014.2 +050600 MOVE "QUEUE NAME NOT SPECIFIED" TO RE-MARK. CM1014.2 +050700 MOVE "99" TO STATUS-KEY. CM1014.2 +050800 MOVE SPACES TO MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +050900 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +051000 XXXXX031 CM1014.2 +051100 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +051200 PERFORM PASS GO TO DISAB-STATUS-WRITE-01. CM1014.2 +051300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +051400 MOVE "20" TO CORRECT-STATUS. CM1014.2 +051500 PERFORM FAIL. CM1014.2 +051600 GO TO DISAB-STATUS-WRITE-01. CM1014.2 +051700 DISAB-STATUS-DELETE-01. CM1014.2 +051800 PERFORM DE-LETE. CM1014.2 +051900 DISAB-STATUS-WRITE-01. CM1014.2 +052000 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM1014.2 +052100 PERFORM PRINT-DETAIL. CM1014.2 +052200 DISAB-STATUS-TEST-02. CM1014.2 +052300 MOVE "UNKNOWN SUB-QUEUE-1 SPECIFIED" TO RE-MARK. CM1014.2 +052400 MOVE "99" TO STATUS-KEY. CM1014.2 +052500 MOVE CM1014.2 +052600 XXXXX030 CM1014.2 +052700 TO MAIN-QUEUE. CM1014.2 +052800 MOVE "DUMMYNAME" TO NO-SPEC-1. CM1014.2 +052900 MOVE SPACES TO NO-SPEC-2 NO-SPEC-3. CM1014.2 +053000 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +053100 PASSWORD1. CM1014.2 +053200 IF STATUS-KEY IS EQUAL TO "20" CM1014.2 +053300 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM1014.2 +053400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +053500 MOVE "20" TO CORRECT-STATUS. CM1014.2 +053600 PERFORM FAIL. CM1014.2 +053700 GO TO DISAB-STATUS-WRITE-02. CM1014.2 +053800 DISAB-STATUS-DELETE-02. CM1014.2 +053900 PERFORM DE-LETE. CM1014.2 +054000 DISAB-STATUS-WRITE-02. CM1014.2 +054100 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM1014.2 +054200 PERFORM PRINT-DETAIL. CM1014.2 +054300 DISAB-STATUS-TEST-03. CM1014.2 +054400 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1014.2 +054500 MOVE "99" TO STATUS-KEY. CM1014.2 +054600 MOVE CM1014.2 +054700 XXXXX030 CM1014.2 +054800 TO MAIN-QUEUE. CM1014.2 +054900 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +055000 DISABLE INPUT CM-INQUE-1 WITH KEY CM1014.2 +055100 "KILLITNOW". CM1014.2 +055200 IF STATUS-KEY IS EQUAL TO "40" CM1014.2 +055300 PERFORM PASS GO TO DISAB-STATUS-WRITE-03. CM1014.2 +055400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1014.2 +055500 MOVE "40" TO CORRECT-STATUS. CM1014.2 +055600 PERFORM FAIL. CM1014.2 +055700 GO TO DISAB-STATUS-WRITE-03. CM1014.2 +055800 DISAB-STATUS-DELETE-03. CM1014.2 +055900 PERFORM DE-LETE. CM1014.2 +056000 DISAB-STATUS-WRITE-03. CM1014.2 +056100 MOVE "DISAB-STATUS-TEST-03" TO PAR-NAME. CM1014.2 +056200 PERFORM PRINT-DETAIL. CM1014.2 +056300 RENAB-STATUS-TEST-01. CM1014.2 +056400 MOVE "RE-ENABLE PREVIOUSLY DISABLED" TO RE-MARK. CM1014.2 +056500 MOVE "99" TO STATUS-KEY. CM1014.2 +056600 MOVE CM1014.2 +056700 XXXXX030 CM1014.2 +056800 TO MAIN-QUEUE. CM1014.2 +056900 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1014.2 +057000 ENABLE INPUT CM-INQUE-1 KEY CM1014.2 +057100 PASSWORD1. CM1014.2 +057200 IF STATUS-KEY IS EQUAL TO ZERO CM1014.2 +057300 PERFORM PASS GO TO RENAB-STATUS-WRITE-01. CM1014.2 +057400 MOVE STATUS-KEY TO COMPUTED-STATUS CM1014.2 +057500 MOVE ZERO TO CORRECT-STATUS. CM1014.2 +057600 PERFORM FAIL. CM1014.2 +057700 GO TO RENAB-STATUS-WRITE-01. CM1014.2 +057800 RENAB-STATUS-DELETE-01. CM1014.2 +057900 PERFORM DE-LETE. CM1014.2 +058000 RENAB-STATUS-WRITE-01. CM1014.2 +058100 MOVE "RENAB-STATUS-TEST-01" TO PAR-NAME. CM1014.2 +058200 PERFORM PRINT-DETAIL. CM1014.2 +058300 CLOSE-FILES. CM1014.2 +058400 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1014.2 +058500 CLOSE PRINT-FILE. CM1014.2 +058600 STOP RUN. CM1014.2 +058700 PASS. CM1014.2 +058800 MOVE "PASS" TO P-OR-F. CM1014.2 +058900 FAIL. CM1014.2 +059000 ADD 1 TO ERROR-COUNTER. CM1014.2 +059100 MOVE "FAIL*" TO P-OR-F. CM1014.2 +059200 DE-LETE. CM1014.2 +059300 MOVE SPACE TO P-OR-F. CM1014.2 +059400 MOVE " ************ " TO COMPUTED-A. CM1014.2 +059500 MOVE " ************ " TO CORRECT-A. CM1014.2 +059600 MOVE "****TEST DELETED****" TO RE-MARK. CM1014.2 +059700 ADD 1 TO DELETE-CNT. CM1014.2 +059800 PRINT-DETAIL. CM1014.2 +059900 MOVE TEST-RESULTS TO PRINT-REC. CM1014.2 +060000 PERFORM WRITE-LINE. CM1014.2 +060100 MOVE SPACE TO P-OR-F. CM1014.2 +060200 MOVE SPACE TO COMPUTED-A. CM1014.2 +060300 MOVE SPACE TO CORRECT-A. CM1014.2 +060400 END-ROUTINE. CM1014.2 +060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1014.2 +060600 PERFORM WRITE-LINE. CM1014.2 +060700 PARA-Z. CM1014.2 +060800 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1014.2 +060900 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1014.2 +061000 PERFORM WRITE-LINE. CM1014.2 +061100 END-ROUTINE-1. CM1014.2 +061200 PERFORM BLANK-LINE-PRINT. CM1014.2 +061300 IF ERROR-COUNTER IS EQUAL TO ZERO CM1014.2 +061400 GO TO END-ROUTINE-2. CM1014.2 +061500 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1014.2 +061600 GO TO END-ROUTINE-3. CM1014.2 +061700 END-ROUTINE-2. CM1014.2 +061800 MOVE " NO" TO ERROR-TOTAL. CM1014.2 +061900 END-ROUTINE-3. CM1014.2 +062000 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1014.2 +062100 PERFORM WRITE-LINE. CM1014.2 +062200 IF DELETE-CNT IS EQUAL TO ZERO CM1014.2 +062300 MOVE " NO" TO ERROR-TOTAL ELSE CM1014.2 +062400 MOVE DELETE-CNT TO ERROR-TOTAL. CM1014.2 +062500 MOVE "TESTS DELETED " TO ENDER-DESC. CM1014.2 +062600 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1014.2 +062700 PERFORM WRITE-LINE. CM1014.2 +062800 END-ROUTINE-4. CM1014.2 +062900 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1014.2 +063000 PERFORM WRITE-LINE. CM1014.2 +063100 BLANK-LINE-PRINT. CM1014.2 +063200 MOVE SPACE TO DUMMY-RECORD. CM1014.2 +063300 PERFORM WRITE-LINE. CM1014.2 +063400 WRITE-LINE. CM1014.2 +063500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1014.2 +063600 INCREMENT-POLL-COUNT. CM1014.2 +063700 ADD 1 TO POLL-COUNT ON SIZE ERROR ADD 0 TO POLL-COUNT. CM1014.2 +063800 DELAY-FOR-30-SECS. CM1014.2 +063900 PERFORM GET-TIME-DIFFERENCE. CM1014.2 +064000 IF COMP-TIME IS LESS THAN 30 CM1014.2 +064100 GO TO DELAY-FOR-30-SECS. CM1014.2 +064200 LOG-HEADER. CM1014.2 +064300 MOVE LOG-HDR-1 TO PRINT-REC CM1014.2 +064400 WRITE PRINT-REC CM1014.2 +064500 AFTER 3 LINES. CM1014.2 +064600 MOVE DATE-RECEIVED TO MSG-DATE. CM1014.2 +064700 MOVE WHERE-FROM TO SYM-SOURCE. CM1014.2 +064800 MOVE LOG-HDR-2 TO PRINT-REC. CM1014.2 +064900 WRITE PRINT-REC CM1014.2 +065000 AFTER 3 LINES. CM1014.2 +065100 MOVE LOG-HDR-3 TO PRINT-REC. CM1014.2 +065200 WRITE PRINT-REC CM1014.2 +065300 AFTER 2 LINES. CM1014.2 +065400 MOVE LOG-HDR-4 TO PRINT-REC. CM1014.2 +065500 PERFORM WRITE-LINE. CM1014.2 +065600 MOVE SPACES TO PRINT-REC. CM1014.2 +065700 PERFORM WRITE-LINE. CM1014.2 +065800 HEAD-ROUTINE. CM1014.2 +065900 MOVE CCVS-H-1 TO PRINT-REC CM1014.2 +066000 WRITE PRINT-REC CM1014.2 +066100 AFTER ADVANCING PAGE. CM1014.2 +066200 MOVE CCVS-H-2 TO PRINT-REC. CM1014.2 +066300 WRITE PRINT-REC CM1014.2 +066400 AFTER 2 LINES. CM1014.2 +066500 MOVE CCVS-H-3 TO PRINT-REC. CM1014.2 +066600 WRITE PRINT-REC CM1014.2 +066700 AFTER 5 LINES. CM1014.2 +066800 MOVE HYPHEN-LINE TO PRINT-REC. CM1014.2 +066900 PERFORM WRITE-LINE. CM1014.2 +*END-OF,CM101M +*HEADER,COBOL,CM102M +000100 IDENTIFICATION DIVISION. CM1024.2 +000200 PROGRAM-ID. CM1024.2 +000300 CM102M. CM1024.2 +000400 AUTHOR. CM1024.2 +000500 FEDERAL COMPILER TESTING CENTER. CM1024.2 +000600 INSTALLATION. CM1024.2 +000700 GENERAL SERVICES ADMINISTRATION CM1024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM1024.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM1024.2 +001100 FALLS CHURCH VIRGINIA 22041. CM1024.2 +001200 CM1024.2 +001300 PHONE (703) 756-6153 CM1024.2 +001400 CM1024.2 +001500 " HIGH ". CM1024.2 +001600 DATE-WRITTEN. CM1024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1024.2 +001800 CREATION DATE / VALIDATION DATE CM1024.2 +001900 "4.2 ". CM1024.2 +002000 SECURITY. CM1024.2 +002100 NONE. CM1024.2 +002200 ENVIRONMENT DIVISION. CM1024.2 +002300 CONFIGURATION SECTION. CM1024.2 +002400 SOURCE-COMPUTER. CM1024.2 +002500 XXXXX082. CM1024.2 +002600 OBJECT-COMPUTER. CM1024.2 +002700 XXXXX083. CM1024.2 +002800 INPUT-OUTPUT SECTION. CM1024.2 +002900 FILE-CONTROL. CM1024.2 +003000 SELECT PRINT-FILE ASSIGN TO CM1024.2 +003100 XXXXX055. CM1024.2 +003200 DATA DIVISION. CM1024.2 +003300 FILE SECTION. CM1024.2 +003400 FD PRINT-FILE CM1024.2 +003500 LABEL RECORDS CM1024.2 +003600 XXXXX084 CM1024.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1024.2 +003800 01 PRINT-REC PICTURE X(120). CM1024.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM1024.2 +004000 WORKING-STORAGE SECTION. CM1024.2 +004100 77 COMP-TWO PIC 9 COMP VALUE 2. CM1024.2 +004200 77 TWO PIC 9 VALUE 2. CM1024.2 +004300 77 COMP-THREE PIC 9 VALUE 3. CM1024.2 +004400 77 THREE PIC 9 VALUE 3. CM1024.2 +004500 77 SEND-SWITCH PIC 99 COMP. CM1024.2 +004600 77 MSG-NUM PIC 9(4). CM1024.2 +004700 77 MSG-70 PIC X(70). CM1024.2 +004800 77 PASSWORD1 PIC X(10) VALUE CM1024.2 +004900 XXXXX033. CM1024.2 +005000 01 ERR-MSG. CM1024.2 +005100 02 FILLER PIC X(33) VALUE CM1024.2 +005200 "THIS MESSAGE SHOULD NOT APPEAR - ". CM1024.2 +005300 02 TEST-IND PIC X(4). CM1024.2 +005400 01 LOG-HDR-1. CM1024.2 +005500 02 FILLER PIC X(48) VALUE SPACES. CM1024.2 +005600 02 FILLER PIC X(24) VALUE "LOG OF OUTGOING MESSAGES". CM1024.2 +005700 01 LOG-HDR-2. CM1024.2 +005800 02 FILLER PIC X VALUE SPACE. CM1024.2 +005900 02 FILLER PIC X(14) VALUE "START TIME". CM1024.2 +006000 02 FILLER PIC X(10) VALUE "ELAPSED". CM1024.2 +006100 02 FILLER PIC X(13) VALUE "STATUS/ERR". CM1024.2 +006200 02 FILLER PIC X(41) VALUE "LENGTH". CM1024.2 +006300 02 FILLER PIC X(7) VALUE "MESSAGE". CM1024.2 +006400 01 LOG-HDR-3. CM1024.2 +006500 02 FILLER PIC X VALUE SPACES. CM1024.2 +006600 02 FILLER PIC X(11) VALUE ALL "-". CM1024.2 +006700 02 FILLER PIC XXX VALUE SPACES. CM1024.2 +006800 02 FILLER PIC X(7) VALUE ALL "-". CM1024.2 +006900 02 FILLER PIC XXX VALUE SPACES. CM1024.2 +007000 02 FILLER PIC X(10) VALUE ALL "-". CM1024.2 +007100 02 FILLER PIC XXX VALUE SPACES. CM1024.2 +007200 02 FILLER PIC X(6) VALUE ALL "-". CM1024.2 +007300 02 FILLER PIC XXX VALUE SPACES. CM1024.2 +007400 02 FILLER PIC X(72) VALUE ALL "-". CM1024.2 +007500 01 LOG-LINE. CM1024.2 +007600 02 FILLER PIC X VALUE SPACE. CM1024.2 +007700 02 START-TIME. CM1024.2 +007800 03 HOURS PIC 99. CM1024.2 +007900 03 FILLER PIC X VALUE ":". CM1024.2 +008000 03 MINUTES PIC 99. CM1024.2 +008100 03 FILLER PIC X VALUE ":". CM1024.2 +008200 03 SECONDS PIC 99.99. CM1024.2 +008300 02 FILLER PIC XX VALUE SPACES. CM1024.2 +008400 02 ELAPSED PIC -(4)9.99. CM1024.2 +008500 02 FILLER PIC X(7) VALUE SPACES. CM1024.2 +008600 02 STAT PIC 99. CM1024.2 +008700 02 FILLER PIC X VALUE "/". CM1024.2 +008800 02 ERR PIC 9. CM1024.2 +008900 02 FILLER PIC X(5) VALUE SPACES. CM1024.2 +009000 02 LNTH PIC ZZZ9. CM1024.2 +009100 02 FILLER PIC X(5) VALUE SPACES. CM1024.2 +009200 02 MSG-OUT PIC X(72). CM1024.2 +009300 01 LOG-LINE-1. CM1024.2 +009400 02 FILLER PIC X(39) VALUE SPACES. CM1024.2 +009500 02 FILLER PIC X(8) VALUE "CONT". CM1024.2 +009600 02 MSG-FLD PIC X(72). CM1024.2 +009700 01 SUPERIMPOSITION. CM1024.2 +009800 02 S-ALL PIC X(4). CM1024.2 +009900 02 S-WORDS PIC X(6). CM1024.2 +010000 02 S-IN PIC X(3). CM1024.2 +010100 02 S-THIS PIC X(5). CM1024.2 +010200 02 S-MESSAGE PIC X(8). CM1024.2 +010300 02 S-SHOULD PIC X(7). CM1024.2 +010400 02 S-COME PIC X(5). CM1024.2 +010500 02 S-OUT PIC X(4). CM1024.2 +010600 02 S-ON PIC XXX. CM1024.2 +010700 02 S-THE PIC X(4). CM1024.2 +010800 02 S-SAME PIC X(5). CM1024.2 +010900 02 S-LINE PIC X(5). CM1024.2 +011000 01 MSG-A. CM1024.2 +011100 02 FILLER PIC X VALUE SPACE. CM1024.2 +011200 02 MSG-B. CM1024.2 +011300 03 FILLER PIC X VALUE SPACE. CM1024.2 +011400 03 MSG-C. CM1024.2 +011500 04 FILLER PIC X VALUE SPACE. CM1024.2 +011600 04 MSG-D. CM1024.2 +011700 05 FILLER PIC X VALUE SPACE. CM1024.2 +011800 05 MSG-E. CM1024.2 +011900 06 FILLER PIC X(19) VALUE CM1024.2 +012000 "THIS IS MESSAGE NO.". CM1024.2 +012100 06 MSG-NO PIC ZZZZ. CM1024.2 +012200 06 FILLER PIC X(35) VALUE CM1024.2 +012300 ".--THIS SENTENCE MUST NOT APPEAR.". CM1024.2 +012400 01 SYSTEM-TIME. CM1024.2 +012500 02 HOURS PIC 99. CM1024.2 +012600 02 MINUTES PIC 99. CM1024.2 +012700 02 SECONDS PIC 99V99. CM1024.2 +012800 01 COMP-TIME. CM1024.2 +012900 02 COMP-HRS PIC 99. CM1024.2 +013000 02 COMP-MINS PIC 99. CM1024.2 +013100 02 COMP-SECS PIC 99V99. CM1024.2 +013200 01 MSG-F. CM1024.2 +013300 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 +013400 02 MSG-F-NO PIC ZZZZ. CM1024.2 +013500 02 FILLER PIC X(40) VALUE CM1024.2 +013600 " AND SHOULD APPEAR AT THE TOP OF A PAGE.". CM1024.2 +013700 01 MSG-G. CM1024.2 +013800 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 +013900 02 MSG-G-NO PIC ZZZZ. CM1024.2 +014000 02 FILLER PIC X(41) VALUE CM1024.2 +014100 " AND SHOULD APPEAR AFTER TWO BLANK LINES.". CM1024.2 +014200 01 MSG-H. CM1024.2 +014300 02 FILLER PIC X(19) VALUE "THIS IS MESSAGE NO.". CM1024.2 +014400 02 MSG-H-NO PIC ZZZZ. CM1024.2 +014500 02 FILLER PIC X(41) VALUE CM1024.2 +014600 " AND SHOULD APPEAR BEFORE ONE BLANK LINE.". CM1024.2 +014700 01 LONG-MSG. CM1024.2 +014800 02 LONG-MSG-S1 PIC X(73) VALUE "ON PAGE XIII-21, PARAGRAPH 3CM1024.2 +014900- ".5.4(1)C, THE COBOL STANDARD STATES, ""EXCESS ". CM1024.2 +015000 02 LONG-MSG-S2 PIC X(67) VALUE "CHARACTERS OF A MESSAGE OR MCM1024.2 +015100- "ESSAGE SEGMENT WILL NOT BE TRUNCATED. ". CM1024.2 +015200 02 LONG-MSG-S3 PIC X(71) VALUE "CHARACTERS WILL BE PACKED TOCM1024.2 +015300- " A SIZE EQUAL TO THAT OF THE PHYSICAL LINE ". CM1024.2 +015400 02 LONG-MSG-S4 PIC X(69) VALUE "AND THEN OUTPUTTED TO THE DECM1024.2 +015500- "VICE. THE PROCESS CONTINUES ON THE NEXT ". CM1024.2 +015600 02 LONG-MSG-S5 PIC X(73) VALUE "LINE WITH THE EXCESS CHARACTCM1024.2 +015700- "ERS."" IF THIS ENTIRE PARAGRAPH WAS RECEIVED ". CM1024.2 +015800 02 LONG-MSG-S6 PIC X(71) VALUE "BY THE DESIGNATED DEVICE, THCM1024.2 +015900- "EN THE FOREGOING RULE IS SUPPORTED BY THIS ". CM1024.2 +016000 02 LONG-MSG-S7 PIC X(9) VALUE "COMPILER.". CM1024.2 +016100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1024.2 +016200 01 REC-CT PICTURE 99 VALUE ZERO. CM1024.2 +016300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1024.2 +016400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1024.2 +016500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1024.2 +016600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1024.2 +016700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1024.2 +016800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1024.2 +016900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1024.2 +017000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1024.2 +017100 01 CCVS-H-1. CM1024.2 +017200 02 FILLER PICTURE X(27) VALUE SPACE. CM1024.2 +017300 02 FILLER PICTURE X(67) VALUE CM1024.2 +017400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1024.2 +017500- " SYSTEM". CM1024.2 +017600 02 FILLER PICTURE X(26) VALUE SPACE. CM1024.2 +017700 01 CCVS-H-2. CM1024.2 +017800 02 FILLER PICTURE X(52) VALUE IS CM1024.2 +017900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1024.2 +018000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1024.2 +018100 02 TEST-ID PICTURE IS X(9). CM1024.2 +018200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1024.2 +018300 01 CCVS-H-3. CM1024.2 +018400 02 FILLER PICTURE X(34) VALUE CM1024.2 +018500 " FOR OFFICIAL USE ONLY ". CM1024.2 +018600 02 FILLER PICTURE X(58) VALUE CM1024.2 +018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1024.2 +018800 02 FILLER PICTURE X(28) VALUE CM1024.2 +018900 " COPYRIGHT 1974 ". CM1024.2 +019000 01 CCVS-E-1. CM1024.2 +019100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1024.2 +019200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1024.2 +019300 02 ID-AGAIN PICTURE IS X(9). CM1024.2 +019400 02 FILLER PICTURE X(45) VALUE IS CM1024.2 +019500 " NTIS DISTRIBUTION COBOL 74". CM1024.2 +019600 01 CCVS-E-2. CM1024.2 +019700 02 FILLER PICTURE X(31) VALUE CM1024.2 +019800 SPACE. CM1024.2 +019900 02 FILLER PICTURE X(21) VALUE SPACE. CM1024.2 +020000 02 CCVS-E-2-2. CM1024.2 +020100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1024.2 +020200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1024.2 +020300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1024.2 +020400 01 CCVS-E-3. CM1024.2 +020500 02 FILLER PICTURE X(22) VALUE CM1024.2 +020600 " FOR OFFICIAL USE ONLY". CM1024.2 +020700 02 FILLER PICTURE X(12) VALUE SPACE. CM1024.2 +020800 02 FILLER PICTURE X(58) VALUE CM1024.2 +020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1024.2 +021000 02 FILLER PICTURE X(13) VALUE SPACE. CM1024.2 +021100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1024.2 +021200 01 CCVS-E-4. CM1024.2 +021300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1024.2 +021400 02 FILLER PIC XXXX VALUE " OF ". CM1024.2 +021500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1024.2 +021600 02 FILLER PIC X(40) VALUE CM1024.2 +021700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1024.2 +021800 01 XXINFO. CM1024.2 +021900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1024.2 +022000 02 INFO-TEXT. CM1024.2 +022100 04 FILLER PIC X(20) VALUE SPACE. CM1024.2 +022200 04 XXCOMPUTED PIC X(20). CM1024.2 +022300 04 FILLER PIC X(5) VALUE SPACE. CM1024.2 +022400 04 XXCORRECT PIC X(20). CM1024.2 +022500 01 HYPHEN-LINE. CM1024.2 +022600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1024.2 +022700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1024.2 +022800- "*****************************************". CM1024.2 +022900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1024.2 +023000- "******************************". CM1024.2 +023100 01 CCVS-PGM-ID PIC X(6) VALUE CM1024.2 +023200 "CM102M". CM1024.2 +023300 01 TEST-RESULTS. CM1024.2 +023400 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +023500 02 FEATURE PICTURE X(18). CM1024.2 +023600 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +023700 02 P-OR-F PICTURE X(5). CM1024.2 +023800 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +023900 02 PAR-NAME PIC X(20). CM1024.2 +024000 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +024100 02 COMPUTED-A PICTURE X(20). CM1024.2 +024200 02 COMPUTED-SLASH-SET REDEFINES COMPUTED-A. CM1024.2 +024300 03 FILLER PIC X(8). CM1024.2 +024400 03 COMPUTED-STATUS PIC XX. CM1024.2 +024500 03 SLASH PIC X. CM1024.2 +024600 03 COMPUTED-ERR-KEY PIC X. CM1024.2 +024700 03 FILLER PIC X(8). CM1024.2 +024800 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +024900 02 CORRECT-A PICTURE X(20). CM1024.2 +025000 02 CORRECT-SLASH-SET REDEFINES CORRECT-A. CM1024.2 +025100 03 FILLER PIC X(8). CM1024.2 +025200 03 CORRECT-2SLASH1 PIC 99/9. CM1024.2 +025300 03 FILLER PIC X(8). CM1024.2 +025400 02 FILLER PICTURE X VALUE SPACE. CM1024.2 +025500 02 RE-MARK PICTURE X(30). CM1024.2 +025600 01 COLUMNS-LINE-1. CM1024.2 +025700 02 FILLER PIC X(3) VALUE SPACES. CM1024.2 +025800 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1024.2 +025900 02 FILLER PIC X(9) VALUE "RESLT". CM1024.2 +026000 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1024.2 +026100 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1024.2 +026200 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1024.2 +026300 02 FILLER PIC X(7) VALUE "REMARKS". CM1024.2 +026400 01 COLUMNS-LINE-2. CM1024.2 +026500 02 FILLER PIC X VALUE SPACE. CM1024.2 +026600 02 FILLER PIC X(18) VALUE ALL "-". CM1024.2 +026700 02 FILLER PIC X VALUE SPACE. CM1024.2 +026800 02 FILLER PIC X(5) VALUE ALL "-". CM1024.2 +026900 02 FILLER PIC X VALUE SPACE. CM1024.2 +027000 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 +027100 02 FILLER PIC X VALUE SPACE. CM1024.2 +027200 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 +027300 02 FILLER PIC X VALUE SPACE. CM1024.2 +027400 02 FILLER PIC X(20) VALUE ALL "-". CM1024.2 +027500 02 FILLER PIC X VALUE SPACE. CM1024.2 +027600 02 FILLER PIC X(31) VALUE ALL "-". CM1024.2 +027700 COMMUNICATION SECTION. CM1024.2 +027800 CD CM-OUTQUE-1 FOR OUTPUT CM1024.2 +027900 DESTINATION COUNT IS ONE CM1024.2 +028000 TEXT LENGTH IS MSG-LENGTH CM1024.2 +028100 STATUS KEY IS STATUS-KEY CM1024.2 +028200 ERROR KEY IS ERR-KEY CM1024.2 +028300 SYMBOLIC DESTINATION IS SYM-DEST. CM1024.2 +028400 PROCEDURE DIVISION. CM1024.2 +028500 SECT-CM102M-0001 SECTION. CM1024.2 +028600 CM102M-INIT. CM1024.2 +028700 OPEN OUTPUT PRINT-FILE. CM1024.2 +028800 MOVE "CM102M " TO TEST-ID. CM1024.2 +028900 MOVE TEST-ID TO ID-AGAIN. CM1024.2 +029000 MOVE SPACE TO TEST-RESULTS. CM1024.2 +029100 PERFORM HEAD-ROUTINE. CM1024.2 +029200 PERFORM COLUMN-NAMES-ROUTINE. CM1024.2 +029300 MOVE "MCS STATUS WORD" TO FEATURE. CM1024.2 +029400 DISAB-STATUS-TEST-01. CM1024.2 +029500 MOVE "INITIAL DISABLE TO OUTPUT CD" TO RE-MARK. CM1024.2 +029600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +029700 MOVE 1 TO ONE. CM1024.2 +029800 MOVE CM1024.2 +029900 XXXXX032 CM1024.2 +030000 TO SYM-DEST. CM1024.2 +030100 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +030200 XXXXX033. CM1024.2 +030300 MOVE "INFO" TO P-OR-F. CM1024.2 +030400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +030500 MOVE "/" TO SLASH. CM1024.2 +030600 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +030700 MOVE " INFO TEST FOR" TO CORRECT-A. CM1024.2 +030800 GO TO DISAB-STATUS-WRITE-01. CM1024.2 +030900 DISAB-STATUS-DELETE-01. CM1024.2 +031000 PERFORM DE-LETE. CM1024.2 +031100 DISAB-STATUS-WRITE-01. CM1024.2 +031200 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM1024.2 +031300 PERFORM PRINT-DETAIL. CM1024.2 +031400 DISAB-STATUS-TEST-02. CM1024.2 +031500 MOVE "NO DESTINATION SPECIFIED" TO RE-MARK. CM1024.2 +031600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +031700 MOVE "GARBAGE" TO SYM-DEST. CM1024.2 +031800 MOVE 1 TO ONE. CM1024.2 +031900 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +032000 XXXXX033. CM1024.2 +032100 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 +032200 AND ERR-KEY IS EQUAL TO "1" CM1024.2 +032300 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM1024.2 +032400 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 +032500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +032600 MOVE "/" TO SLASH. CM1024.2 +032700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +032800 PERFORM FAIL. CM1024.2 +032900 GO TO DISAB-STATUS-WRITE-02. CM1024.2 +033000 DISAB-STATUS-DELETE-02. CM1024.2 +033100 PERFORM DE-LETE. CM1024.2 +033200 DISAB-STATUS-WRITE-02. CM1024.2 +033300 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM1024.2 +033400 PERFORM PRINT-DETAIL. CM1024.2 +033500 DISAB-STATUS-TEST-03. CM1024.2 +033600 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1024.2 +033700 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +033800 MOVE 1 TO ONE. CM1024.2 +033900 MOVE CM1024.2 +034000 XXXXX032 CM1024.2 +034100 TO SYM-DEST. CM1024.2 +034200 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +034300 "GARBAGE". CM1024.2 +034400 IF STATUS-KEY IS EQUAL TO "40" CM1024.2 +034500 PERFORM PASS GO TO DISAB-STATUS-WRITE-03. CM1024.2 +034600 MOVE 400 TO CORRECT-2SLASH1. CM1024.2 +034700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +034800 MOVE "/" TO SLASH. CM1024.2 +034900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +035000 PERFORM FAIL. CM1024.2 +035100 GO TO DISAB-STATUS-WRITE-03. CM1024.2 +035200 DISAB-STATUS-DELETE-03. CM1024.2 +035300 PERFORM DE-LETE. CM1024.2 +035400 DISAB-STATUS-WRITE-03. CM1024.2 +035500 MOVE "DISAB-STATUS-TEST-03" TO PAR-NAME. CM1024.2 +035600 PERFORM PRINT-DETAIL. CM1024.2 +035700 DISAB-STATUS-TEST-04. CM1024.2 +035800 MOVE "INVALID DESTINATION COUNT (0)" TO RE-MARK. CM1024.2 +035900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +036000 MOVE CM1024.2 +036100 XXXXX032 CM1024.2 +036200 TO SYM-DEST. CM1024.2 +036300 MOVE 0 TO ONE. CM1024.2 +036400 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +036500 XXXXX033. CM1024.2 +036600 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 +036700 PERFORM PASS GO TO DISAB-STATUS-WRITE-04. CM1024.2 +036800 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 +036900 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +037000 MOVE "/" TO SLASH. CM1024.2 +037100 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +037200 PERFORM FAIL. CM1024.2 +037300 GO TO DISAB-STATUS-WRITE-04. CM1024.2 +037400 DISAB-STATUS-DELETE-04. CM1024.2 +037500 PERFORM DE-LETE. CM1024.2 +037600 DISAB-STATUS-WRITE-04. CM1024.2 +037700 MOVE "DISAB-STATUS-TEST-04" TO PAR-NAME. CM1024.2 +037800 PERFORM PRINT-DETAIL. CM1024.2 +037900 DISAB-STATUS-TEST-05. CM1024.2 +038000 MOVE "COMBINATION ERROR" TO RE-MARK. CM1024.2 +038100 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +038200 MOVE SPACES TO SYM-DEST. CM1024.2 +038300 MOVE 0 TO ONE. CM1024.2 +038400 DISABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +038500 "GARBAGE". CM1024.2 +038600 MOVE "INFO" TO P-OR-F. CM1024.2 +038700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +038800 MOVE "/" TO SLASH. CM1024.2 +038900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +039000 GO TO DISAB-STATUS-WRITE-05. CM1024.2 +039100 DISAB-STATUS-DELETE-05. CM1024.2 +039200 PERFORM DE-LETE. CM1024.2 +039300 DISAB-STATUS-WRITE-05. CM1024.2 +039400 MOVE "DISAB-STATUS-TEST-05" TO PAR-NAME. CM1024.2 +039500 PERFORM PRINT-DETAIL. CM1024.2 +039600 SEND-STATUS-TEST-01. CM1024.2 +039700 MOVE "DESTINATION DISABLED" TO RE-MARK. CM1024.2 +039800 MOVE "CM102M- I AM THE FIRST MESSAGE IN QUEUE;" TO MSG-70. CM1024.2 +039900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +040000 MOVE CM1024.2 +040100 XXXXX032 CM1024.2 +040200 TO SYM-DEST. CM1024.2 +040300 MOVE 1 TO ONE. CM1024.2 +040400 MOVE 45 TO MSG-LENGTH. CM1024.2 +040500 SEND CM-OUTQUE-1 FROM MSG-70 WITH EMI CM1024.2 +040600 AFTER ADVANCING PAGE. CM1024.2 +040700 MOVE "THOU SHALT HAVE NO OTHER MESSAGES BEFORE ME." TO MSG-70CM1024.2 +040800 SEND CM-OUTQUE-1 FROM MSG-70 WITH EMI. CM1024.2 +040900 MOVE SPACES TO MSG-70. CM1024.2 +041000 MOVE 1 TO MSG-LENGTH. CM1024.2 +041100 SEND CM-OUTQUE-1 FROM MSG-70 WITH EGI. CM1024.2 +041200 IF STATUS-KEY IS EQUAL TO "10" CM1024.2 +041300 PERFORM PASS GO TO SEND-STATUS-WRITE-01. CM1024.2 +041400 MOVE 100 TO CORRECT-2SLASH1. CM1024.2 +041500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +041600 MOVE "/" TO SLASH. CM1024.2 +041700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +041800 PERFORM FAIL. CM1024.2 +041900 GO TO SEND-STATUS-WRITE-01. CM1024.2 +042000 SEND-STATUS-DELETE-01. CM1024.2 +042100 PERFORM DE-LETE. CM1024.2 +042200 SEND-STATUS-WRITE-01. CM1024.2 +042300 MOVE "SEND-STATUS-TEST-01" TO PAR-NAME. CM1024.2 +042400 PERFORM PRINT-DETAIL. CM1024.2 +042500 SEND-STATUS-TEST-02. CM1024.2 +042600 MOVE "COMBINATION ERROR" TO RE-MARK. CM1024.2 +042700 MOVE SPACES TO SYM-DEST. CM1024.2 +042800 MOVE 0 TO ONE. CM1024.2 +042900 MOVE 100 TO MSG-LENGTH. CM1024.2 +043000 MOVE "S-02" TO TEST-IND. CM1024.2 +043100 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 +043200 MOVE "INFO" TO P-OR-F. CM1024.2 +043300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +043400 MOVE "/" TO SLASH. CM1024.2 +043500 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +043600 GO TO SEND-STATUS-WRITE-02. CM1024.2 +043700 SEND-STATUS-DELETE-02. CM1024.2 +043800 PERFORM DE-LETE. CM1024.2 +043900 SEND-STATUS-WRITE-02. CM1024.2 +044000 MOVE "SEND-STATUS-TEST-02" TO PAR-NAME. CM1024.2 +044100 PERFORM PRINT-DETAIL. CM1024.2 +044200 ENABL-STATUS-TEST-01. CM1024.2 +044300 MOVE "DESTINATION NOT SPECIFIED" TO RE-MARK. CM1024.2 +044400 MOVE SPACES TO SYM-DEST. CM1024.2 +044500 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +044600 MOVE 1 TO ONE. CM1024.2 +044700 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +044800 XXXXX033. CM1024.2 +044900 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 +045000 AND ERR-KEY IS EQUAL TO "1" CM1024.2 +045100 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM1024.2 +045200 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 +045300 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +045400 MOVE "/" TO SLASH. CM1024.2 +045500 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +045600 PERFORM FAIL. CM1024.2 +045700 GO TO ENABL-STATUS-WRITE-01. CM1024.2 +045800 ENABL-STATUS-DELETE-01. CM1024.2 +045900 PERFORM DE-LETE. CM1024.2 +046000 ENABL-STATUS-WRITE-01. CM1024.2 +046100 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM1024.2 +046200 PERFORM PRINT-DETAIL. CM1024.2 +046300 ENABL-STATUS-TEST-02. CM1024.2 +046400 MOVE "INVALID DESTINATION COUNT (0)" TO RE-MARK. CM1024.2 +046500 MOVE CM1024.2 +046600 XXXXX032 CM1024.2 +046700 TO SYM-DEST. CM1024.2 +046800 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +046900 MOVE 0 TO ONE. CM1024.2 +047000 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +047100 XXXXX033. CM1024.2 +047200 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 +047300 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM1024.2 +047400 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 +047500 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +047600 MOVE "/" TO SLASH. CM1024.2 +047700 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +047800 PERFORM FAIL. CM1024.2 +047900 GO TO ENABL-STATUS-WRITE-02. CM1024.2 +048000 ENABL-STATUS-DELETE-02. CM1024.2 +048100 PERFORM DE-LETE. CM1024.2 +048200 ENABL-STATUS-WRITE-02. CM1024.2 +048300 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM1024.2 +048400 PERFORM PRINT-DETAIL. CM1024.2 +048500 ENABL-STATUS-TEST-03. CM1024.2 +048600 MOVE "INVALID PASSWORD USED" TO RE-MARK. CM1024.2 +048700 MOVE CM1024.2 +048800 XXXXX032 CM1024.2 +048900 TO SYM-DEST. CM1024.2 +049000 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +049100 MOVE 1 TO ONE. CM1024.2 +049200 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +049300 "GARBAGE". CM1024.2 +049400 IF STATUS-KEY IS EQUAL TO "40" CM1024.2 +049500 PERFORM PASS GO TO ENABL-STATUS-WRITE-03. CM1024.2 +049600 MOVE 400 TO CORRECT-2SLASH1. CM1024.2 +049700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +049800 MOVE "/" TO SLASH. CM1024.2 +049900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +050000 PERFORM FAIL. CM1024.2 +050100 GO TO ENABL-STATUS-WRITE-03. CM1024.2 +050200 ENABL-STATUS-DELETE-03. CM1024.2 +050300 PERFORM DE-LETE. CM1024.2 +050400 ENABL-STATUS-WRITE-03. CM1024.2 +050500 MOVE "ENABL-STATUS-TEST-03" TO PAR-NAME. CM1024.2 +050600 PERFORM PRINT-DETAIL. CM1024.2 +050700 ENABL-STATUS-TEST-04. CM1024.2 +050800 MOVE "VALID ENABLE/NO ERROR EXPECTED" TO RE-MARK. CM1024.2 +050900 MOVE CM1024.2 +051000 XXXXX032 CM1024.2 +051100 TO SYM-DEST. CM1024.2 +051200 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +051300 MOVE 1 TO ONE. CM1024.2 +051400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +051500 XXXXX033. CM1024.2 +051600 IF STATUS-KEY IS EQUAL TO ZERO CM1024.2 +051700 PERFORM PASS GO TO ENABL-STATUS-WRITE-04. CM1024.2 +051800 MOVE 0 TO CORRECT-2SLASH1. CM1024.2 +051900 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +052000 MOVE "/" TO SLASH. CM1024.2 +052100 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +052200 PERFORM FAIL. CM1024.2 +052300 GO TO ENABL-STATUS-WRITE-04. CM1024.2 +052400 ENABL-STATUS-DELETE-04. CM1024.2 +052500 PERFORM DE-LETE. CM1024.2 +052600 ENABL-STATUS-WRITE-04. CM1024.2 +052700 MOVE "ENABL-STATUS-TEST-04" TO PAR-NAME. CM1024.2 +052800 PERFORM PRINT-DETAIL. CM1024.2 +052900 SEND-STATUS-TEST-03. CM1024.2 +053000 MOVE "DESTINATION UNKNOWN" TO RE-MARK. CM1024.2 +053100 MOVE "GARBAGE" TO SYM-DEST. CM1024.2 +053200 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +053300 MOVE 1 TO ONE. CM1024.2 +053400 MOVE 37 TO MSG-LENGTH. CM1024.2 +053500 MOVE "S-03" TO TEST-IND. CM1024.2 +053600 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 +053700 IF STATUS-KEY IS EQUAL TO "20" CM1024.2 +053800 AND ERR-KEY IS EQUAL TO "1" CM1024.2 +053900 PERFORM PASS GO TO SEND-STATUS-WRITE-03. CM1024.2 +054000 MOVE 201 TO CORRECT-2SLASH1. CM1024.2 +054100 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +054200 MOVE "/" TO SLASH. CM1024.2 +054300 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +054400 PERFORM FAIL. CM1024.2 +054500 GO TO SEND-STATUS-WRITE-03. CM1024.2 +054600 SEND-STATUS-DELETE-03. CM1024.2 +054700 PERFORM DE-LETE. CM1024.2 +054800 SEND-STATUS-WRITE-03. CM1024.2 +054900 MOVE "SEND-STATUS-TEST-03" TO PAR-NAME. CM1024.2 +055000 PERFORM PRINT-DETAIL. CM1024.2 +055100 SEND-STATUS-TEST-04. CM1024.2 +055200 MOVE "DESTINATION COUNT INVALID (0)" TO RE-MARK. CM1024.2 +055300 MOVE CM1024.2 +055400 XXXXX032 CM1024.2 +055500 TO SYM-DEST. CM1024.2 +055600 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +055700 MOVE 0 TO ONE. CM1024.2 +055800 MOVE 37 TO MSG-LENGTH. CM1024.2 +055900 MOVE "S-04" TO TEST-IND. CM1024.2 +056000 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 +056100 IF STATUS-KEY IS EQUAL TO "30" CM1024.2 +056200 PERFORM PASS GO TO SEND-STATUS-WRITE-04. CM1024.2 +056300 MOVE 300 TO CORRECT-2SLASH1. CM1024.2 +056400 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +056500 MOVE "/" TO SLASH. CM1024.2 +056600 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +056700 PERFORM FAIL. CM1024.2 +056800 GO TO SEND-STATUS-WRITE-04. CM1024.2 +056900 SEND-STATUS-DELETE-04. CM1024.2 +057000 PERFORM DE-LETE. CM1024.2 +057100 SEND-STATUS-WRITE-04. CM1024.2 +057200 MOVE "SEND-STATUS-TEST-04" TO PAR-NAME. CM1024.2 +057300 PERFORM PRINT-DETAIL. CM1024.2 +057400 SEND-STATUS-TEST-05. CM1024.2 +057500 MOVE "CHARACTER COUNT EXCESSIVE" TO RE-MARK. CM1024.2 +057600 MOVE CM1024.2 +057700 XXXXX032 CM1024.2 +057800 TO SYM-DEST. CM1024.2 +057900 MOVE "9" TO STATUS-KEY ERR-KEY. CM1024.2 +058000 MOVE 1 TO ONE. CM1024.2 +058100 MOVE 38 TO MSG-LENGTH. CM1024.2 +058200 MOVE "S-05" TO TEST-IND. CM1024.2 +058300 SEND CM-OUTQUE-1 FROM ERR-MSG WITH EMI. CM1024.2 +058400 IF STATUS-KEY IS EQUAL TO "50" CM1024.2 +058500 PERFORM PASS GO TO SEND-STATUS-WRITE-05. CM1024.2 +058600 MOVE 500 TO CORRECT-2SLASH1. CM1024.2 +058700 MOVE STATUS-KEY TO COMPUTED-STATUS. CM1024.2 +058800 MOVE "/" TO SLASH. CM1024.2 +058900 MOVE ERR-KEY TO COMPUTED-ERR-KEY. CM1024.2 +059000 PERFORM FAIL. CM1024.2 +059100 GO TO SEND-STATUS-WRITE-05. CM1024.2 +059200 SEND-STATUS-DELETE-05. CM1024.2 +059300 PERFORM DE-LETE. CM1024.2 +059400 SEND-STATUS-WRITE-05. CM1024.2 +059500 MOVE "SEND-STATUS-TEST-05" TO PAR-NAME. CM1024.2 +059600 PERFORM PRINT-DETAIL. CM1024.2 +059700 STATUS-TESTS-COMPLETED. CM1024.2 +059800 PERFORM END-ROUTINE. CM1024.2 +059900 PERFORM END-ROUTINE-1 THRU END-ROUTINE-3. CM1024.2 +060000 PERFORM END-ROUTINE. CM1024.2 +060100 MOVE LOG-HDR-1 TO PRINT-REC. CM1024.2 +060200 WRITE PRINT-REC CM1024.2 +060300 AFTER 3 LINES. CM1024.2 +060400 MOVE LOG-HDR-2 TO PRINT-REC. CM1024.2 +060500 WRITE PRINT-REC CM1024.2 +060600 AFTER 3 LINES. CM1024.2 +060700 MOVE LOG-HDR-3 TO PRINT-REC. CM1024.2 +060800 WRITE PRINT-REC. CM1024.2 +060900 PERFORM BLANK-LINE-PRINT. CM1024.2 +061000 VARIABLE-LENGTH-MSGS. CM1024.2 +061100 MOVE 1 TO ONE. CM1024.2 +061200 MOVE CM1024.2 +061300 XXXXX032 CM1024.2 +061400 TO SYM-DEST. CM1024.2 +061500 MOVE 1 TO MSG-NO SEND-SWITCH. CM1024.2 +061600 MOVE 28 TO MSG-LENGTH. CM1024.2 +061700 MOVE MSG-A TO MSG-OUT. CM1024.2 +061800 PERFORM SEND-AND-LOG. CM1024.2 +061900 MOVE 2 TO MSG-NO. CM1024.2 +062000 MOVE 27 TO MSG-LENGTH. CM1024.2 +062100 MOVE MSG-B TO MSG-OUT. CM1024.2 +062200 PERFORM SEND-AND-LOG. CM1024.2 +062300 MOVE 3 TO MSG-NO. CM1024.2 +062400 MOVE 26 TO MSG-LENGTH. CM1024.2 +062500 MOVE MSG-C TO MSG-OUT. CM1024.2 +062600 PERFORM SEND-AND-LOG. CM1024.2 +062700 MOVE 4 TO MSG-NO. CM1024.2 +062800 MOVE 25 TO MSG-LENGTH. CM1024.2 +062900 MOVE MSG-D TO MSG-OUT. CM1024.2 +063000 PERFORM SEND-AND-LOG. CM1024.2 +063100 MOVE 2 TO SEND-SWITCH. CM1024.2 +063200 MOVE 5 TO MSG-NO. CM1024.2 +063300 MOVE 24 TO MSG-LENGTH. CM1024.2 +063400 MOVE MSG-E TO MSG-OUT. CM1024.2 +063500 PERFORM SEND-AND-LOG. CM1024.2 +063600 AFTER-PAGE-MSGS. CM1024.2 +063700 MOVE 6 TO MSG-NUM. CM1024.2 +063800 MOVE 3 TO SEND-SWITCH. CM1024.2 +063900 MOVE 63 TO MSG-LENGTH. CM1024.2 +064000 PERFORM AFTER-PAGE-MSGS-01 5 TIMES. CM1024.2 +064100 GO TO AFTER-THREE-MSGS. CM1024.2 +064200 AFTER-PAGE-MSGS-01. CM1024.2 +064300 MOVE MSG-NUM TO MSG-F-NO. CM1024.2 +064400 ADD 1 TO MSG-NUM. CM1024.2 +064500 MOVE MSG-F TO MSG-OUT. CM1024.2 +064600 PERFORM SEND-AND-LOG. CM1024.2 +064700 AFTER-THREE-MSGS. CM1024.2 +064800 MOVE 64 TO MSG-LENGTH. CM1024.2 +064900 PERFORM AFTER-THREE-MSGS-01 5 TIMES. CM1024.2 +065000 GO TO EGI-ONLY. CM1024.2 +065100 AFTER-THREE-MSGS-01. CM1024.2 +065200 MOVE MSG-NUM TO MSG-G-NO. CM1024.2 +065300 ADD 1 TO MSG-NUM SEND-SWITCH. CM1024.2 +065400 MOVE MSG-G TO MSG-OUT. CM1024.2 +065500 PERFORM SEND-AND-LOG. CM1024.2 +065600 EGI-ONLY. CM1024.2 +065700 MOVE "ONLY EGI WAS SENT. NO MESSAGE ACCOMPANYING" TO MSG-OUTCM1024.2 +065800 ADD 1 TO SEND-SWITCH. CM1024.2 +065900 MOVE 0 TO MSG-LENGTH. CM1024.2 +066000 PERFORM SEND-AND-LOG. CM1024.2 +066100 BEFORE-ADV-INIT. CM1024.2 +066200 MOVE "0LTH" TO TEST-IND. CM1024.2 +066300 ADD 1 TO SEND-SWITCH. CM1024.2 +066400 MOVE ERR-MSG TO MSG-OUT. CM1024.2 +066500 PERFORM SEND-AND-LOG. CM1024.2 +066600 BEFORE-PAGE-MSGS. CM1024.2 +066700 MOVE 63 TO MSG-LENGTH. CM1024.2 +066800 PERFORM AFTER-PAGE-MSGS-01 5 TIMES. CM1024.2 +066900 BEFORE-TWO-MSGS. CM1024.2 +067000 MOVE 64 TO MSG-LENGTH. CM1024.2 +067100 PERFORM BEFORE-TWO-MSGS-01 5 TIMES. CM1024.2 +067200 GO TO ZERO-LINES-MSGS. CM1024.2 +067300 BEFORE-TWO-MSGS-01. CM1024.2 +067400 MOVE MSG-NUM TO MSG-H-NO. CM1024.2 +067500 ADD 1 TO MSG-NUM. CM1024.2 +067600 ADD 1 TO SEND-SWITCH. CM1024.2 +067700 MOVE MSG-H TO MSG-OUT. CM1024.2 +067800 PERFORM SEND-AND-LOG. CM1024.2 +067900 ZERO-LINES-MSGS. CM1024.2 +068000 ADD 1 TO SEND-SWITCH. CM1024.2 +068100 MOVE 59 TO MSG-LENGTH. CM1024.2 +068200 MOVE "ALL" TO SUPERIMPOSITION. CM1024.2 +068300 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +068400 MOVE "WORDS" TO S-WORDS. CM1024.2 +068500 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +068600 MOVE "IN" TO S-IN. CM1024.2 +068700 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +068800 MOVE "THIS" TO S-THIS. CM1024.2 +068900 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +069000 MOVE "MESSAGE" TO S-MESSAGE. CM1024.2 +069100 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +069200 MOVE "SHOULD" TO S-SHOULD. CM1024.2 +069300 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +069400 ADD 1 TO SEND-SWITCH. CM1024.2 +069500 MOVE "COME" TO S-COME. CM1024.2 +069600 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +069700 MOVE "OUT" TO S-OUT. CM1024.2 +069800 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +069900 MOVE "ON" TO S-ON. CM1024.2 +070000 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +070100 MOVE "THE" TO S-THE. CM1024.2 +070200 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +070300 MOVE "SAME" TO S-SAME. CM1024.2 +070400 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +070500 MOVE "LINE." TO S-LINE. CM1024.2 +070600 PERFORM ZERO-LINES-MSGS-01. CM1024.2 +070700 GO TO 433-CHARACTER-MSG. CM1024.2 +070800 ZERO-LINES-MSGS-01. CM1024.2 +070900 MOVE SUPERIMPOSITION TO MSG-OUT. CM1024.2 +071000 PERFORM SEND-AND-LOG. CM1024.2 +071100 MOVE SPACES TO SUPERIMPOSITION. CM1024.2 +071200 433-CHARACTER-MSG. CM1024.2 +071300 ADD 1 TO SEND-SWITCH. CM1024.2 +071400 MOVE 433 TO MSG-LENGTH. CM1024.2 +071500 MOVE LONG-MSG-S1 TO MSG-OUT. CM1024.2 +071600 PERFORM SEND-AND-LOG. CM1024.2 +071700 MOVE LONG-MSG-S2 TO MSG-FLD. CM1024.2 +071800 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +071900 MOVE LONG-MSG-S3 TO MSG-FLD. CM1024.2 +072000 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +072100 MOVE LONG-MSG-S4 TO MSG-FLD. CM1024.2 +072200 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +072300 MOVE LONG-MSG-S5 TO MSG-FLD. CM1024.2 +072400 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +072500 MOVE LONG-MSG-S6 TO MSG-FLD. CM1024.2 +072600 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +072700 MOVE LONG-MSG-S7 TO MSG-FLD. CM1024.2 +072800 WRITE PRINT-REC FROM LOG-LINE-1. CM1024.2 +072900 MSG-BEFORE-DELAY-AND-DISABLE. CM1024.2 +073000 MOVE "EXPECT A PAUSE OF UP TO 30 SECONDS BEFORE TRANSMISSION CM1024.2 +073100- "OF NEXT MESSAGE." TO MSG-OUT. CM1024.2 +073200 MOVE 72 TO MSG-LENGTH. CM1024.2 +073300 MOVE 4 TO SEND-SWITCH. CM1024.2 +073400 PERFORM SEND-AND-LOG. CM1024.2 +073500 DELAY-FOR-30-SECS. CM1024.2 +073600 ACCEPT SYSTEM-TIME FROM TIME. CM1024.2 +073700 IF (HOURS OF SYSTEM-TIME * 3600 + MINUTES OF SYSTEM-TIME * 60CM1024.2 +073800 + SECONDS OF SYSTEM-TIME) - (COMP-HRS * 3600 + COMP-MINS CM1024.2 +073900 * 60 + COMP-SECS) IS LESS THAN 30 CM1024.2 +074000 GO TO DELAY-FOR-30-SECS. CM1024.2 +074100 DISABLE-DEVICE. CM1024.2 +074200 MOVE "**** DEVICE DISABLED ****" TO MSG-OUT. CM1024.2 +074300 MOVE 0 TO MSG-LENGTH. CM1024.2 +074400 MOVE 19 TO SEND-SWITCH. CM1024.2 +074500 PERFORM SEND-AND-LOG. CM1024.2 +074600 10-WHILE-DISABLED. CM1024.2 +074700 MOVE "TRANSMISSION NOW RESUMED." TO MSG-OUT. CM1024.2 +074800 MOVE 25 TO MSG-LENGTH. CM1024.2 +074900 MOVE 1 TO SEND-SWITCH. CM1024.2 +075000 PERFORM SEND-AND-LOG. CM1024.2 +075100 MOVE 24 TO MSG-LENGTH. CM1024.2 +075200 PERFORM 10-WHILE-DISABLED-01 8 TIMES. CM1024.2 +075300 GO TO 10-WHILE-DISABLED-02. CM1024.2 +075400 10-WHILE-DISABLED-01. CM1024.2 +075500 MOVE MSG-NUM TO MSG-NO. CM1024.2 +075600 ADD 1 TO MSG-NUM. CM1024.2 +075700 MOVE MSG-E TO MSG-OUT. CM1024.2 +075800 PERFORM SEND-AND-LOG. CM1024.2 +075900 10-WHILE-DISABLED-02. CM1024.2 +076000 MOVE "THERE SHOULD BE NO ABNORMAL DELAY IN RECEIVING THE NEXTCM1024.2 +076100- " MESSAGE." TO MSG-OUT. CM1024.2 +076200 MOVE 63 TO MSG-LENGTH. CM1024.2 +076300 PERFORM SEND-AND-LOG. CM1024.2 +076400 RE-ENABLE-OUTQUE. CM1024.2 +076500 MOVE "**** DEVICE NOW RE-ENABLED ****" TO MSG-OUT. CM1024.2 +076600 MOVE 0 TO MSG-LENGTH. CM1024.2 +076700 MOVE 20 TO SEND-SWITCH. CM1024.2 +076800 PERFORM SEND-AND-LOG. CM1024.2 +076900 ENQUEUE-500-MORE. CM1024.2 +077000 MOVE "THIS IS THAT NEXT MESSAGE." TO MSG-OUT. CM1024.2 +077100 MOVE 26 TO MSG-LENGTH. CM1024.2 +077200 MOVE 2 TO SEND-SWITCH. CM1024.2 +077300 PERFORM SEND-AND-LOG. CM1024.2 +077400 MOVE 24 TO MSG-LENGTH. CM1024.2 +077500 PERFORM 10-WHILE-DISABLED-01 500 TIMES. CM1024.2 +077600 DELAY-DISABLE-DELAY-AND-STOP. CM1024.2 +077700 PERFORM DELAY-FOR-30-SECS. CM1024.2 +077800 PERFORM DISABLE-DEVICE. CM1024.2 +077900 PERFORM DELAY-FOR-30-SECS. CM1024.2 +078000 PERFORM END-ROUTINE THRU PARA-Z. CM1024.2 +078100 PERFORM END-ROUTINE-4. CM1024.2 +078200 CLOSE PRINT-FILE. CM1024.2 +078300 STOP RUN. CM1024.2 +078400 SEND-AND-LOG. CM1024.2 +078500 ACCEPT SYSTEM-TIME FROM TIME. CM1024.2 +078600 PERFORM UNIFORM-SEND. CM1024.2 +078700 ACCEPT COMP-TIME FROM TIME. CM1024.2 +078800 MOVE CORR SYSTEM-TIME TO START-TIME. CM1024.2 +078900 COMPUTE ELAPSED = CM1024.2 +079000 (COMP-HRS * 3600 + COMP-MINS * 60 + COMP-SECS) - CM1024.2 +079100 (HOURS OF SYSTEM-TIME * 3600 + MINUTES OF SYSTEM-TIME * CM1024.2 +079200 60 + SECONDS OF SYSTEM-TIME). CM1024.2 +079300 MOVE STATUS-KEY TO STAT. CM1024.2 +079400 MOVE ERR-KEY TO ERR. CM1024.2 +079500 MOVE MSG-LENGTH TO LNTH. CM1024.2 +079600 MOVE LOG-LINE TO PRINT-REC. CM1024.2 +079700 PERFORM WRITE-LINE. CM1024.2 +079800 UNIFORM-SEND SECTION. CM1024.2 +079900 UNIFORM-SEND-SWITCH. CM1024.2 +080000 GO TO CM1024.2 +080100 SEND-EMI-A1 CM1024.2 +080200 SEND-EGI-A1 CM1024.2 +080300 SEND-EMI-AP CM1024.2 +080400 SEND-EMI-A3-01 CM1024.2 +080500 SEND-EMI-A3-02 CM1024.2 +080600 SEND-EMI-A3-03 CM1024.2 +080700 SEND-EMI-A3-04 CM1024.2 +080800 SEND-EMI-A3-05 CM1024.2 +080900 SEND-EGI-ONLY CM1024.2 +081000 SEND-EMI-BP CM1024.2 +081100 SEND-EMI-B2-01 CM1024.2 +081200 SEND-EMI-B2-02 CM1024.2 +081300 SEND-EMI-B2-03 CM1024.2 +081400 SEND-EMI-B2-04 CM1024.2 +081500 SEND-EMI-B2-05 CM1024.2 +081600 SEND-EMI-A0 CM1024.2 +081700 SEND-EMI-B0 CM1024.2 +081800 SEND-LONG-MSG CM1024.2 +081900 DISABLE-OUTQUE CM1024.2 +082000 ENABLE-OUTQUE CM1024.2 +082100 DEPENDING ON SEND-SWITCH. CM1024.2 +082200 SEND-EMI-A1. CM1024.2 +082300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI. CM1024.2 +082400 GO TO UNIFORM-SEND-EXIT. CM1024.2 +082500 SEND-EGI-A1. CM1024.2 +082600 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EGI. CM1024.2 +082700 GO TO UNIFORM-SEND-EXIT. CM1024.2 +082800 SEND-EMI-AP. CM1024.2 +082900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI AFTER PAGE. CM1024.2 +083000 GO TO UNIFORM-SEND-EXIT. CM1024.2 +083100 SEND-EMI-A3-01. CM1024.2 +083200 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI AFTER ADVANCING 3 CM1024.2 +083300 LINES. CM1024.2 +083400 GO TO UNIFORM-SEND-EXIT. CM1024.2 +083500 SEND-EMI-A3-02. CM1024.2 +083600 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +083700 AFTER ADVANCING THREE LINES. CM1024.2 +083800 GO TO UNIFORM-SEND-EXIT. CM1024.2 +083900 SEND-EMI-A3-03. CM1024.2 +084000 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +084100 AFTER 3 LINE. CM1024.2 +084200 GO TO UNIFORM-SEND-EXIT. CM1024.2 +084300 SEND-EMI-A3-04. CM1024.2 +084400 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +084500 AFTER COMP-THREE. CM1024.2 +084600 GO TO UNIFORM-SEND-EXIT. CM1024.2 +084700 SEND-EMI-A3-05. CM1024.2 +084800 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +084900 AFTER 3. CM1024.2 +085000 GO TO UNIFORM-SEND-EXIT. CM1024.2 +085100 SEND-EGI-ONLY. CM1024.2 +085200 SEND CM-OUTQUE-1 WITH EGI. CM1024.2 +085300 GO TO UNIFORM-SEND-EXIT. CM1024.2 +085400 SEND-EMI-BP. CM1024.2 +085500 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +085600 BEFORE ADVANCING PAGE. CM1024.2 +085700 GO TO UNIFORM-SEND-EXIT. CM1024.2 +085800 SEND-EMI-B2-01. CM1024.2 +085900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +086000 BEFORE ADVANCING 2 LINES. CM1024.2 +086100 GO TO UNIFORM-SEND-EXIT. CM1024.2 +086200 SEND-EMI-B2-02. CM1024.2 +086300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +086400 BEFORE ADVANCING TWO LINES. CM1024.2 +086500 GO TO UNIFORM-SEND-EXIT. CM1024.2 +086600 SEND-EMI-B2-03. CM1024.2 +086700 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +086800 BEFORE 2 LINE. CM1024.2 +086900 GO TO UNIFORM-SEND-EXIT. CM1024.2 +087000 SEND-EMI-B2-04. CM1024.2 +087100 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +087200 BEFORE COMP-TWO. CM1024.2 +087300 GO TO UNIFORM-SEND-EXIT. CM1024.2 +087400 SEND-EMI-B2-05. CM1024.2 +087500 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +087600 BEFORE 2. CM1024.2 +087700 GO TO UNIFORM-SEND-EXIT. CM1024.2 +087800 SEND-EMI-A0. CM1024.2 +087900 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +088000 AFTER 0 LINES. CM1024.2 +088100 GO TO UNIFORM-SEND-EXIT. CM1024.2 +088200 SEND-EMI-B0. CM1024.2 +088300 SEND CM-OUTQUE-1 FROM MSG-OUT WITH EMI CM1024.2 +088400 BEFORE ZERO LINES. CM1024.2 +088500 GO TO UNIFORM-SEND-EXIT. CM1024.2 +088600 SEND-LONG-MSG. CM1024.2 +088700 SEND CM-OUTQUE-1 FROM LONG-MSG WITH EMI AFTER PAGE. CM1024.2 +088800 GO TO UNIFORM-SEND-EXIT. CM1024.2 +088900 DISABLE-OUTQUE. CM1024.2 +089000 DISABLE OUTPUT CM-OUTQUE-1 KEY CM1024.2 +089100 PASSWORD1. CM1024.2 +089200 GO TO UNIFORM-SEND-EXIT. CM1024.2 +089300 ENABLE-OUTQUE. CM1024.2 +089400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1024.2 +089500 XXXXX033. CM1024.2 +089600 UNIFORM-SEND-EXIT. CM1024.2 +089700 EXIT. CM1024.2 +089800 COMMON-SUBROUTINES SECTION. CM1024.2 +089900 PASS. CM1024.2 +090000 MOVE "PASS" TO P-OR-F. CM1024.2 +090100 FAIL. CM1024.2 +090200 ADD 1 TO ERROR-COUNTER. CM1024.2 +090300 MOVE "FAIL*" TO P-OR-F. CM1024.2 +090400 DE-LETE. CM1024.2 +090500 MOVE SPACE TO P-OR-F. CM1024.2 +090600 MOVE " ************ " TO COMPUTED-A. CM1024.2 +090700 MOVE " ************ " TO CORRECT-A. CM1024.2 +090800 MOVE "****TEST DELETED****" TO RE-MARK. CM1024.2 +090900 ADD 1 TO DELETE-CNT. CM1024.2 +091000 PRINT-DETAIL. CM1024.2 +091100 MOVE TEST-RESULTS TO PRINT-REC. CM1024.2 +091200 PERFORM WRITE-LINE. CM1024.2 +091300 MOVE SPACE TO P-OR-F. CM1024.2 +091400 MOVE SPACE TO COMPUTED-A. CM1024.2 +091500 MOVE SPACE TO CORRECT-A. CM1024.2 +091600 COLUMN-NAMES-ROUTINE. CM1024.2 +091700 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM1024.2 +091800 PERFORM WRITE-LINE. CM1024.2 +091900 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM1024.2 +092000 PERFORM WRITE-LINE. CM1024.2 +092100 PERFORM BLANK-LINE-PRINT. CM1024.2 +092200 END-ROUTINE. CM1024.2 +092300 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1024.2 +092400 PERFORM WRITE-LINE. CM1024.2 +092500 PARA-Z. CM1024.2 +092600 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1024.2 +092700 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1024.2 +092800 PERFORM WRITE-LINE. CM1024.2 +092900 END-ROUTINE-1. CM1024.2 +093000 PERFORM BLANK-LINE-PRINT. CM1024.2 +093100 IF ERROR-COUNTER IS EQUAL TO ZERO CM1024.2 +093200 GO TO END-ROUTINE-2. CM1024.2 +093300 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1024.2 +093400 GO TO END-ROUTINE-3. CM1024.2 +093500 END-ROUTINE-2. CM1024.2 +093600 MOVE " NO" TO ERROR-TOTAL. CM1024.2 +093700 END-ROUTINE-3. CM1024.2 +093800 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1024.2 +093900 PERFORM WRITE-LINE. CM1024.2 +094000 IF DELETE-CNT IS EQUAL TO ZERO CM1024.2 +094100 MOVE " NO" TO ERROR-TOTAL ELSE CM1024.2 +094200 MOVE DELETE-CNT TO ERROR-TOTAL. CM1024.2 +094300 MOVE "TESTS DELETED " TO ENDER-DESC. CM1024.2 +094400 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1024.2 +094500 PERFORM WRITE-LINE. CM1024.2 +094600 END-ROUTINE-4. CM1024.2 +094700 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1024.2 +094800 PERFORM WRITE-LINE. CM1024.2 +094900 BLANK-LINE-PRINT. CM1024.2 +095000 MOVE SPACE TO DUMMY-RECORD. CM1024.2 +095100 PERFORM WRITE-LINE. CM1024.2 +095200 WRITE-LINE. CM1024.2 +095300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1024.2 +095400 HEAD-ROUTINE. CM1024.2 +095500 MOVE CCVS-H-1 TO PRINT-REC CM1024.2 +095600 WRITE PRINT-REC CM1024.2 +095700 AFTER ADVANCING PAGE. CM1024.2 +095800 MOVE CCVS-H-2 TO PRINT-REC. CM1024.2 +095900 WRITE PRINT-REC CM1024.2 +096000 AFTER 2 LINES. CM1024.2 +096100 MOVE CCVS-H-3 TO PRINT-REC. CM1024.2 +096200 WRITE PRINT-REC CM1024.2 +096300 AFTER 5 LINES. CM1024.2 +096400 MOVE HYPHEN-LINE TO PRINT-REC. CM1024.2 +096500 PERFORM WRITE-LINE. CM1024.2 +*END-OF,CM102M +*HEADER,COBOL,CM103M +000100 IDENTIFICATION DIVISION. CM1034.2 +000200 PROGRAM-ID. CM1034.2 +000300 CM103M. CM1034.2 +000400 AUTHOR. CM1034.2 +000500 FEDERAL COMPILER TESTING CENTER. CM1034.2 +000600 INSTALLATION. CM1034.2 +000700 GENERAL SERVICES ADMINISTRATION CM1034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM1034.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM1034.2 +001100 FALLS CHURCH VIRGINIA 22041. CM1034.2 +001200 CM1034.2 +001300 PHONE (703) 756-6153 CM1034.2 +001400 CM1034.2 +001500 " HIGH ". CM1034.2 +001600 DATE-WRITTEN. CM1034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1034.2 +001800 CREATION DATE / VALIDATION DATE CM1034.2 +001900 "4.2 ". CM1034.2 +002000 SECURITY. CM1034.2 +002100 NONE. CM1034.2 +002200 ENVIRONMENT DIVISION. CM1034.2 +002300 CONFIGURATION SECTION. CM1034.2 +002400 SOURCE-COMPUTER. CM1034.2 +002500 XXXXX082. CM1034.2 +002600 OBJECT-COMPUTER. CM1034.2 +002700 XXXXX083. CM1034.2 +002800 INPUT-OUTPUT SECTION. CM1034.2 +002900 FILE-CONTROL. CM1034.2 +003000 SELECT PRINT-FILE ASSIGN TO CM1034.2 +003100 XXXXX055. CM1034.2 +003200 DATA DIVISION. CM1034.2 +003300 FILE SECTION. CM1034.2 +003400 FD PRINT-FILE CM1034.2 +003500 LABEL RECORDS CM1034.2 +003600 XXXXX084 CM1034.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1034.2 +003800 01 PRINT-REC PICTURE X(120). CM1034.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM1034.2 +004000 WORKING-STORAGE SECTION. CM1034.2 +004100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1034.2 +004200 01 REC-CT PICTURE 99 VALUE ZERO. CM1034.2 +004300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1034.2 +004400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1034.2 +004500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1034.2 +004600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1034.2 +004700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1034.2 +004800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1034.2 +004900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1034.2 +005000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1034.2 +005100 01 CCVS-H-1. CM1034.2 +005200 02 FILLER PICTURE X(27) VALUE SPACE. CM1034.2 +005300 02 FILLER PICTURE X(67) VALUE CM1034.2 +005400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1034.2 +005500- " SYSTEM". CM1034.2 +005600 02 FILLER PICTURE X(26) VALUE SPACE. CM1034.2 +005700 01 CCVS-H-2. CM1034.2 +005800 02 FILLER PICTURE X(52) VALUE IS CM1034.2 +005900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1034.2 +006000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1034.2 +006100 02 TEST-ID PICTURE IS X(9). CM1034.2 +006200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1034.2 +006300 01 CCVS-H-3. CM1034.2 +006400 02 FILLER PICTURE X(34) VALUE CM1034.2 +006500 " FOR OFFICIAL USE ONLY ". CM1034.2 +006600 02 FILLER PICTURE X(58) VALUE CM1034.2 +006700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1034.2 +006800 02 FILLER PICTURE X(28) VALUE CM1034.2 +006900 " COPYRIGHT 1974 ". CM1034.2 +007000 01 CCVS-E-1. CM1034.2 +007100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1034.2 +007200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1034.2 +007300 02 ID-AGAIN PICTURE IS X(9). CM1034.2 +007400 02 FILLER PICTURE X(45) VALUE IS CM1034.2 +007500 " NTIS DISTRIBUTION COBOL 74". CM1034.2 +007600 01 CCVS-E-2. CM1034.2 +007700 02 FILLER PICTURE X(31) VALUE CM1034.2 +007800 SPACE. CM1034.2 +007900 02 FILLER PICTURE X(21) VALUE SPACE. CM1034.2 +008000 02 CCVS-E-2-2. CM1034.2 +008100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1034.2 +008200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1034.2 +008300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1034.2 +008400 01 CCVS-E-3. CM1034.2 +008500 02 FILLER PICTURE X(22) VALUE CM1034.2 +008600 " FOR OFFICIAL USE ONLY". CM1034.2 +008700 02 FILLER PICTURE X(12) VALUE SPACE. CM1034.2 +008800 02 FILLER PICTURE X(58) VALUE CM1034.2 +008900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1034.2 +009000 02 FILLER PICTURE X(13) VALUE SPACE. CM1034.2 +009100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1034.2 +009200 01 CCVS-E-4. CM1034.2 +009300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1034.2 +009400 02 FILLER PIC XXXX VALUE " OF ". CM1034.2 +009500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1034.2 +009600 02 FILLER PIC X(40) VALUE CM1034.2 +009700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1034.2 +009800 01 XXINFO. CM1034.2 +009900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1034.2 +010000 02 INFO-TEXT. CM1034.2 +010100 04 FILLER PIC X(20) VALUE SPACE. CM1034.2 +010200 04 XXCOMPUTED PIC X(20). CM1034.2 +010300 04 FILLER PIC X(5) VALUE SPACE. CM1034.2 +010400 04 XXCORRECT PIC X(20). CM1034.2 +010500 01 HYPHEN-LINE. CM1034.2 +010600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1034.2 +010700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1034.2 +010800- "*****************************************". CM1034.2 +010900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1034.2 +011000- "******************************". CM1034.2 +011100 01 CCVS-PGM-ID PIC X(6) VALUE CM1034.2 +011200 "CM103M". CM1034.2 +011300 01 MCS-TIME. CM1034.2 +011400 02 HRS PIC 99. CM1034.2 +011500 02 MINS PIC 99. CM1034.2 +011600 02 SECS PIC 99V99. CM1034.2 +011700 01 IN-TIME. CM1034.2 +011800 02 IN-HRS PIC 99. CM1034.2 +011900 02 IN-MINS PIC 99. CM1034.2 +012000 02 IN-SECS PIC 99V99. CM1034.2 +012100 01 OUT-TIME. CM1034.2 +012200 02 OUT-HRS PIC 99. CM1034.2 +012300 02 OUT-MINS PIC 99. CM1034.2 +012400 02 OUT-SECS PIC 99V99. CM1034.2 +012500 01 LOG-HDR-1. CM1034.2 +012600 02 FILLER PIC X(54) VALUE SPACES. CM1034.2 +012700 02 FILLER PIC X(11) VALUE "MESSAGE LOG". CM1034.2 +012800 01 LOG-HDR-2. CM1034.2 +012900 02 FILLER PIC X VALUE SPACE. CM1034.2 +013000 02 FILLER PIC X(12) VALUE "MCS RECEIPT". CM1034.2 +013100 02 FILLER PIC X(8) VALUE "PROGRAM". CM1034.2 +013200 02 FILLER PIC X(9) VALUE "MCS REC". CM1034.2 +013300 02 FILLER PIC X(12) VALUE "RECV SEND". CM1034.2 +013400 02 FILLER PIC X(38) VALUE "MSG". CM1034.2 +013500 02 FILLER PIC X(7) VALUE "MESSAGE". CM1034.2 +013600 01 LOG-HDR-3. CM1034.2 +013700 02 FILLER PIC XXX VALUE SPACE. CM1034.2 +013800 02 FILLER PIC X(10) VALUE "INBOUND". CM1034.2 +013900 02 FILLER PIC X(8) VALUE "RECEIPT". CM1034.2 +014000 02 FILLER PIC X(9) VALUE "OUTB""ND". CM1034.2 +014100 02 FILLER PIC X(11) VALUE "STAT STAT". CM1034.2 +014200 02 FILLER PIC X(39) VALUE "LENGTH". CM1034.2 +014300 02 FILLER PIC X(7) VALUE "CONTENT". CM1034.2 +014400 01 LOG-HDR-4. CM1034.2 +014500 02 FILLER PIC X VALUE SPACE. CM1034.2 +014600 02 FILLER PIC X(11) VALUE ALL "-". CM1034.2 +014700 02 FILLER PIC X VALUE SPACE. CM1034.2 +014800 02 FILLER PIC X(7) VALUE ALL "-". CM1034.2 +014900 02 FILLER PIC X VALUE SPACE. CM1034.2 +015000 02 FILLER PIC X(7) VALUE ALL "-". CM1034.2 +015100 02 FILLER PIC XX VALUE SPACES. CM1034.2 +015200 02 FILLER PIC X(11) VALUE "---- ----". CM1034.2 +015300 02 FILLER PIC X(5) VALUE ALL "-". CM1034.2 +015400 02 FILLER PIC XX VALUE SPACES. CM1034.2 +015500 02 FILLER PIC X(72) VALUE ALL "-". CM1034.2 +015600 01 LOG-LINE. CM1034.2 +015700 02 FILLER PIC X VALUE SPACE. CM1034.2 +015800 02 TIME-REC. CM1034.2 +015900 03 HRS PIC 99. CM1034.2 +016000 03 FILLER PIC X VALUE ":". CM1034.2 +016100 03 MINS PIC 99. CM1034.2 +016200 03 FILLER PIC X VALUE ":". CM1034.2 +016300 03 SECS PIC 99.99. CM1034.2 +016400 02 FILLER PIC X VALUE SPACE. CM1034.2 +016500 02 PROG-TIME PIC ---.99. CM1034.2 +016600 02 FILLER PIC XX VALUE SPACES. CM1034.2 +016700 02 TIME-SENT PIC ---.99. CM1034.2 +016800 02 FILLER PIC XXXX VALUE SPACES. CM1034.2 +016900 02 RECV-STATUS PIC XX. CM1034.2 +017000 02 FILLER PIC XX VALUE SPACES. CM1034.2 +017100 02 SEND-STATUS PIC XX. CM1034.2 +017200 02 FILLER PIC X VALUE "/". CM1034.2 +017300 02 SEND-ERR PIC X. CM1034.2 +017400 02 FILLER PIC XXX VALUE SPACES. CM1034.2 +017500 02 MSG-LNGTH PIC ZZ9. CM1034.2 +017600 02 FILLER PIC XXX VALUE SPACES. CM1034.2 +017700 02 MSG. CM1034.2 +017800 03 KILL-FIELD PIC X(4). CM1034.2 +017900 03 FILLER PIC X(68). CM1034.2 +018000 COMMUNICATION SECTION. CM1034.2 +018100 CD CM-INQUE-1 FOR INPUT CM1034.2 +018200 MAIN-QUEUE NO-SPEC-1 NO-SPEC-2 NO-SPEC-3 FILLER TIME-RECEIVEDCM1034.2 +018300 FILLER IN-LENGTH END-KEY IN-STATUS FILLER. CM1034.2 +018400 CD CM-OUTQUE-1 FOR OUTPUT. CM1034.2 +018500 01 OUTQUE-SPECIFICATIONS. CM1034.2 +018600 02 ONE PIC 9999 VALUE IS 1. CM1034.2 +018700 02 OUT-LENGTH PIC 9999. CM1034.2 +018800 02 OUT-STATUS PIC XX. CM1034.2 +018900 02 ERR-KEY PIC X. CM1034.2 +019000 02 SYM-DEST PIC X(12) VALUE IS CM1034.2 +019100 XXXXX032. CM1034.2 +019200 PROCEDURE DIVISION. CM1034.2 +019300 SECT-CM103M-0001 SECTION. CM1034.2 +019400 CM103M-INIT. CM1034.2 +019500 OPEN OUTPUT PRINT-FILE. CM1034.2 +019600 MOVE "CM103M " TO TEST-ID. CM1034.2 +019700 MOVE TEST-ID TO ID-AGAIN. CM1034.2 +019800 MOVE SPACES TO NO-SPEC-1 NO-SPEC-2 NO-SPEC-3. CM1034.2 +019900 MOVE CM1034.2 +020000 XXXXX030 CM1034.2 +020100 TO MAIN-QUEUE. CM1034.2 +020200 ENABLE INPUT CM-INQUE-1 WITH KEY CM1034.2 +020300 XXXXX031. CM1034.2 +020400 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1034.2 +020500 XXXXX033. CM1034.2 +020600 PERFORM HEAD-ROUTINE. CM1034.2 +020700 PERFORM LOG-HEADER. CM1034.2 +020800 RECEIVE-ECHO-AND-LOG. CM1034.2 +020900 MOVE SPACES TO MSG. CM1034.2 +021000 RECEIVE CM-INQUE-1 MESSAGE INTO MSG. CM1034.2 +021100 ACCEPT IN-TIME FROM TIME. CM1034.2 +021200 IF IN-LENGTH IS GREATER THAN 72 CM1034.2 +021300 MOVE 72 TO OUT-LENGTH CM1034.2 +021400 ELSE MOVE IN-LENGTH TO OUT-LENGTH. CM1034.2 +021500 SEND CM-OUTQUE-1 FROM MSG WITH EMI. CM1034.2 +021600 ACCEPT OUT-TIME FROM TIME. CM1034.2 +021700 MOVE TIME-RECEIVED TO MCS-TIME. CM1034.2 +021800 MOVE CORR MCS-TIME TO TIME-REC. CM1034.2 +021900 COMPUTE PROG-TIME = CM1034.2 +022000 (IN-HRS * 3600 + IN-MINS * 60 + IN-SECS) - CM1034.2 +022100 (HRS OF MCS-TIME * 3600 + MINS OF MCS-TIME * 60 + CM1034.2 +022200 SECS OF MCS-TIME). CM1034.2 +022300 COMPUTE TIME-SENT = CM1034.2 +022400 (OUT-HRS * 3600 + OUT-MINS * 60 + OUT-SECS) - CM1034.2 +022500 (HRS OF MCS-TIME * 3600 + MINS OF MCS-TIME * 60 + CM1034.2 +022600 SECS OF MCS-TIME). CM1034.2 +022700 MOVE IN-STATUS TO RECV-STATUS. CM1034.2 +022800 MOVE OUT-STATUS TO SEND-STATUS. CM1034.2 +022900 MOVE ERR-KEY TO SEND-ERR. CM1034.2 +023000 MOVE IN-LENGTH TO MSG-LNGTH. CM1034.2 +023100 MOVE LOG-LINE TO PRINT-REC. CM1034.2 +023200 WRITE PRINT-REC. CM1034.2 +023300 IF KILL-FIELD IS NOT EQUAL TO "KILL" CM1034.2 +023400 GO TO RECEIVE-ECHO-AND-LOG. CM1034.2 +023500 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1034.2 +023600 CLOSE PRINT-FILE. CM1034.2 +023700 STOP RUN. CM1034.2 +023800 END-ROUTINE. CM1034.2 +023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1034.2 +024000 PERFORM WRITE-LINE. CM1034.2 +024100 PARA-Z. CM1034.2 +024200 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1034.2 +024300 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1034.2 +024400 PERFORM WRITE-LINE. CM1034.2 +024500 END-ROUTINE-3. CM1034.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1034.2 +024700 PERFORM WRITE-LINE. CM1034.2 +024800 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1034.2 +024900 PERFORM WRITE-LINE. CM1034.2 +025000 BLANK-LINE-PRINT. CM1034.2 +025100 MOVE SPACE TO DUMMY-RECORD. CM1034.2 +025200 PERFORM WRITE-LINE. CM1034.2 +025300 WRITE-LINE. CM1034.2 +025400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1034.2 +025500 LOG-HEADER. CM1034.2 +025600 MOVE LOG-HDR-1 TO PRINT-REC CM1034.2 +025700 WRITE PRINT-REC CM1034.2 +025800 AFTER 3 LINES. CM1034.2 +025900 MOVE LOG-HDR-2 TO PRINT-REC. CM1034.2 +026000 WRITE PRINT-REC CM1034.2 +026100 AFTER 3 LINES. CM1034.2 +026200 MOVE LOG-HDR-3 TO PRINT-REC. CM1034.2 +026300 WRITE PRINT-REC CM1034.2 +026400 MOVE LOG-HDR-4 TO PRINT-REC. CM1034.2 +026500 PERFORM WRITE-LINE. CM1034.2 +026600 MOVE SPACES TO PRINT-REC. CM1034.2 +026700 PERFORM WRITE-LINE. CM1034.2 +026800 HEAD-ROUTINE. CM1034.2 +026900 MOVE CCVS-H-1 TO PRINT-REC CM1034.2 +027000 WRITE PRINT-REC CM1034.2 +027100 AFTER ADVANCING PAGE. CM1034.2 +027200 MOVE CCVS-H-2 TO PRINT-REC. CM1034.2 +027300 WRITE PRINT-REC CM1034.2 +027400 AFTER 2 LINES. CM1034.2 +027500 MOVE CCVS-H-3 TO PRINT-REC. CM1034.2 +027600 WRITE PRINT-REC CM1034.2 +027700 AFTER 5 LINES. CM1034.2 +027800 MOVE HYPHEN-LINE TO PRINT-REC. CM1034.2 +027900 PERFORM WRITE-LINE. CM1034.2 +*END-OF,CM103M +*HEADER,COBOL,CM104M +000100 IDENTIFICATION DIVISION. CM1044.2 +000200 PROGRAM-ID. CM1044.2 +000300 CM104M. CM1044.2 +000400 AUTHOR. CM1044.2 +000500 FEDERAL COMPILER TESTING CENTER. CM1044.2 +000600 INSTALLATION. CM1044.2 +000700 GENERAL SERVICES ADMINISTRATION CM1044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM1044.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM1044.2 +001100 FALLS CHURCH VIRGINIA 22041. CM1044.2 +001200 CM1044.2 +001300 PHONE (703) 756-6153 CM1044.2 +001400 CM1044.2 +001500 " HIGH ". CM1044.2 +001600 DATE-WRITTEN. CM1044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1044.2 +001800 CREATION DATE / VALIDATION DATE CM1044.2 +001900 "4.2 ". CM1044.2 +002000 SECURITY. CM1044.2 +002100 NONE. CM1044.2 +002200 ENVIRONMENT DIVISION. CM1044.2 +002300 CONFIGURATION SECTION. CM1044.2 +002400 SOURCE-COMPUTER. CM1044.2 +002500 XXXXX082. CM1044.2 +002600 OBJECT-COMPUTER. CM1044.2 +002700 XXXXX083. CM1044.2 +002800 INPUT-OUTPUT SECTION. CM1044.2 +002900 FILE-CONTROL. CM1044.2 +003000 SELECT PRINT-FILE ASSIGN TO CM1044.2 +003100 XXXXX055. CM1044.2 +003200 DATA DIVISION. CM1044.2 +003300 FILE SECTION. CM1044.2 +003400 FD PRINT-FILE CM1044.2 +003500 LABEL RECORDS CM1044.2 +003600 XXXXX084 CM1044.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1044.2 +003800 01 PRINT-REC PICTURE X(120). CM1044.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM1044.2 +004000 WORKING-STORAGE SECTION. CM1044.2 +004100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1044.2 +004200 01 REC-CT PICTURE 99 VALUE ZERO. CM1044.2 +004300 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1044.2 +004400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1044.2 +004500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1044.2 +004600 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1044.2 +004700 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1044.2 +004800 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1044.2 +004900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1044.2 +005000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1044.2 +005100 01 CCVS-H-1. CM1044.2 +005200 02 FILLER PICTURE X(27) VALUE SPACE. CM1044.2 +005300 02 FILLER PICTURE X(67) VALUE CM1044.2 +005400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1044.2 +005500- " SYSTEM". CM1044.2 +005600 02 FILLER PICTURE X(26) VALUE SPACE. CM1044.2 +005700 01 CCVS-H-2. CM1044.2 +005800 02 FILLER PICTURE X(52) VALUE IS CM1044.2 +005900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1044.2 +006000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1044.2 +006100 02 TEST-ID PICTURE IS X(9). CM1044.2 +006200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1044.2 +006300 01 CCVS-H-3. CM1044.2 +006400 02 FILLER PICTURE X(34) VALUE CM1044.2 +006500 " FOR OFFICIAL USE ONLY ". CM1044.2 +006600 02 FILLER PICTURE X(58) VALUE CM1044.2 +006700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1044.2 +006800 02 FILLER PICTURE X(28) VALUE CM1044.2 +006900 " COPYRIGHT 1974 ". CM1044.2 +007000 01 CCVS-E-1. CM1044.2 +007100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1044.2 +007200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1044.2 +007300 02 ID-AGAIN PICTURE IS X(9). CM1044.2 +007400 02 FILLER PICTURE X(45) VALUE IS CM1044.2 +007500 " NTIS DISTRIBUTION COBOL 74". CM1044.2 +007600 01 CCVS-E-2. CM1044.2 +007700 02 FILLER PICTURE X(31) VALUE CM1044.2 +007800 SPACE. CM1044.2 +007900 02 FILLER PICTURE X(21) VALUE SPACE. CM1044.2 +008000 02 CCVS-E-2-2. CM1044.2 +008100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1044.2 +008200 03 FILLER PICTURE IS X VALUE IS SPACE. CM1044.2 +008300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1044.2 +008400 01 CCVS-E-3. CM1044.2 +008500 02 FILLER PICTURE X(22) VALUE CM1044.2 +008600 " FOR OFFICIAL USE ONLY". CM1044.2 +008700 02 FILLER PICTURE X(12) VALUE SPACE. CM1044.2 +008800 02 FILLER PICTURE X(58) VALUE CM1044.2 +008900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1044.2 +009000 02 FILLER PICTURE X(13) VALUE SPACE. CM1044.2 +009100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1044.2 +009200 01 CCVS-E-4. CM1044.2 +009300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1044.2 +009400 02 FILLER PIC XXXX VALUE " OF ". CM1044.2 +009500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1044.2 +009600 02 FILLER PIC X(40) VALUE CM1044.2 +009700 " TESTS WERE EXECUTED SUCCESSFULLY". CM1044.2 +009800 01 XXINFO. CM1044.2 +009900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1044.2 +010000 02 INFO-TEXT. CM1044.2 +010100 04 FILLER PIC X(20) VALUE SPACE. CM1044.2 +010200 04 XXCOMPUTED PIC X(20). CM1044.2 +010300 04 FILLER PIC X(5) VALUE SPACE. CM1044.2 +010400 04 XXCORRECT PIC X(20). CM1044.2 +010500 01 HYPHEN-LINE. CM1044.2 +010600 02 FILLER PICTURE IS X VALUE IS SPACE. CM1044.2 +010700 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1044.2 +010800- "*****************************************". CM1044.2 +010900 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1044.2 +011000- "******************************". CM1044.2 +011100 01 CCVS-PGM-ID PIC X(6) VALUE CM1044.2 +011200 "CM104M". CM1044.2 +011300 01 LOG-HDR-1. CM1044.2 +011400 02 FILLER PIC X(54) VALUE SPACES. CM1044.2 +011500 02 FILLER PIC X(11) VALUE "MESSAGE LOG". CM1044.2 +011600 01 LOG-HDR-2. CM1044.2 +011700 02 FILLER PIC XXX VALUE SPACES. CM1044.2 +011800 02 FILLER PIC X(12) VALUE "SYMBOLIC". CM1044.2 +011900 02 FILLER PIC X(15) VALUE "TIME MCS". CM1044.2 +012000 02 FILLER PIC X(6) VALUE "SEND". CM1044.2 +012100 02 FILLER PIC X(4) VALUE "MSG". CM1044.2 +012200 02 FILLER PIC XXX VALUE "IN". CM1044.2 +012300 02 FILLER PIC X(3) VALUE "OUT". CM1044.2 +012400 01 LOG-HDR-3. CM1044.2 +012500 02 FILLER PIC X(4) VALUE SPACES. CM1044.2 +012600 02 FILLER PIC X(11) VALUE "SOURCE". CM1044.2 +012700 02 FILLER PIC X(11) VALUE "RECEIVED". CM1044.2 +012800 02 FILLER PIC XXX VALUE "QD". CM1044.2 +012900 02 FILLER PIC X(7) VALUE "COMPLT". CM1044.2 +013000 02 FILLER PIC X(4) VALUE "LTH". CM1044.2 +013100 02 FILLER PIC XXX VALUE "ST". CM1044.2 +013200 02 FILLER PIC X(33) VALUE "STAT". CM1044.2 +013300 02 FILLER PIC X(16) VALUE "MESSAGE CONTENTS". CM1044.2 +013400 01 LOG-HDR-4. CM1044.2 +013500 02 FILLER PIC X VALUE SPACE. CM1044.2 +013600 02 FILLER PIC X(12) VALUE ALL "-". CM1044.2 +013700 02 FILLER PIC X VALUE SPACE. CM1044.2 +013800 02 FILLER PIC X(11) VALUE ALL "-". CM1044.2 +013900 02 FILLER PIC X VALUE SPACE. CM1044.2 +014000 02 FILLER PIC XXX VALUE "--". CM1044.2 +014100 02 FILLER PIC X(6) VALUE ALL "-". CM1044.2 +014200 02 FILLER PIC X VALUE SPACE. CM1044.2 +014300 02 FILLER PIC X(4) VALUE "---". CM1044.2 +014400 02 FILLER PIC XXX VALUE "--". CM1044.2 +014500 02 FILLER PIC X(5) VALUE "----". CM1044.2 +014600 02 FILLER PIC X(72) VALUE ALL "-". CM1044.2 +014700 01 LOG-LINE. CM1044.2 +014800 02 FILLER PIC X VALUE SPACE. CM1044.2 +014900 02 SYM-SOURCE PIC X(12). CM1044.2 +015000 02 FILLER PIC X VALUE SPACE. CM1044.2 +015100 02 LOG-TIME. CM1044.2 +015200 03 HRS PIC 99. CM1044.2 +015300 03 FILLER PIC X VALUE ":". CM1044.2 +015400 03 MINS PIC 99. CM1044.2 +015500 03 FILLER PIC X VALUE ":". CM1044.2 +015600 03 SECS PIC 99.99. CM1044.2 +015700 02 FILLER PIC X VALUE SPACE. CM1044.2 +015800 02 QUEUE-DEPTH PIC Z9. CM1044.2 +015900 02 OUT-TIME PIC -(4).99. CM1044.2 +016000 02 FILLER PIC X VALUE SPACE. CM1044.2 +016100 02 MSG-LENGTH PIC ZZ9. CM1044.2 +016200 02 FILLER PIC X VALUE SPACE. CM1044.2 +016300 02 IN-STATUS PIC XX. CM1044.2 +016400 02 FILLER PIC X VALUE SPACE. CM1044.2 +016500 02 OUT-STATUS PIC XX. CM1044.2 +016600 02 FILLER PIC X VALUE "/". CM1044.2 +016700 02 OUT-ERR-KEY PIC X. CM1044.2 +016800 02 FILLER PIC X VALUE SPACE. CM1044.2 +016900 02 MSG. CM1044.2 +017000 03 KILL-FIELD PIC X(4). CM1044.2 +017100 03 FILLER PIC X(68). CM1044.2 +017200 01 SEND-TIME. CM1044.2 +017300 02 S-HRS PIC 99. CM1044.2 +017400 02 S-MINS PIC 99. CM1044.2 +017500 02 S-SECS PIC 99V99. CM1044.2 +017600 COMMUNICATION SECTION. CM1044.2 +017700 CD CM-INQUE-1 FOR INPUT. CM1044.2 +017800 01 INQUE-1-SPECIFICATIONS. CM1044.2 +017900 02 QUEUE-1 PIC X(24) VALUE CM1044.2 +018000 XXXXX030. CM1044.2 +018100 02 FILLER PIC X(30) VALUE SPACES. CM1044.2 +018200 02 TIME-RECEIVED-1. CM1044.2 +018300 03 HRS PIC 99. CM1044.2 +018400 03 MINS PIC 99. CM1044.2 +018500 03 SECS PIC 99V99. CM1044.2 +018600 02 SOURCE-1 PIC X(12). CM1044.2 +018700 02 IN-LENGTH-1 PIC 9(4). CM1044.2 +018800 02 END-KEY-1 PIC X. CM1044.2 +018900 02 IN-STATUS-1 PIC XX. CM1044.2 +019000 02 MSG-COUNT-1 PIC 9(6). CM1044.2 +019100 01 INQUE-1-DUMMY-RECORD PIC X(87). CM1044.2 +019200 01 INQUE-1-DUMMY-TABLE. CM1044.2 +019300 02 DUMMY-NAME PIC 9 OCCURS 87 TIMES INDEXED BY I1. CM1044.2 +019400 CD CM-OUTQUE-1 FOR OUTPUT. CM1044.2 +019500 01 OUTQUE-1-SPECIFIACTIONS. CM1044.2 +019600 02 DEST-COUNT-1 PIC 9(4) VALUE IS 1. CM1044.2 +019700 02 OUT-LENGTH-1 PIC 9(4). CM1044.2 +019800 02 OUT-STATUS-1 PIC XX. CM1044.2 +019900 02 ERR-KEY-1 PIC X. CM1044.2 +020000 02 SYM-DEST-1 PIC X(12) VALUE CM1044.2 +020100 XXXXX032. CM1044.2 +020200 01 OUTQUE-1-DUMMY-RECORD PIC X(23). CM1044.2 +020300 01 OUTQUE-1-DUMMY-TABLE. CM1044.2 +020400 02 DUMMY-NAME OCCURS 23 TIMES PIC X. CM1044.2 +020500 CD CM-INQUE-2 FOR INPUT CM1044.2 +020600 FILLER FILLER FILLER FILLER FILLER FILLER SOURCE-2 CM1044.2 +020700 IN-LENGTH-2 END-KEY-2 IN-STATUS-2 MSG-COUNT-2. CM1044.2 +020800 01 INQUE-2-RECORD. CM1044.2 +020900 02 FILLER PIC X(54) VALUE CM1044.2 +021000 XXXXX034. CM1044.2 +021100 02 TIME-RECEIVED-2. CM1044.2 +021200 03 HRS PIC 99. CM1044.2 +021300 03 MINS PIC 99. CM1044.2 +021400 03 SECS PIC 99V99. CM1044.2 +021500 02 FILLER PIC X(25). CM1044.2 +021600 CD CM-OUTQUE-2 FOR OUTPUT CM1044.2 +021700 TEXT LENGTH OUT-LENGTH-2 CM1044.2 +021800 STATUS KEY OUT-STATUS-2 CM1044.2 +021900 ERROR KEY ERR-KEY-2. CM1044.2 +022000 01 OUTQUE-2-RECORD. CM1044.2 +022100 02 FILLER PIC 9(4) VALUE 1. CM1044.2 +022200 02 FILLER PIC X(7) VALUE SPACES. CM1044.2 +022300 02 FILLER PIC X(12) VALUE CM1044.2 +022400 XXXXX035. CM1044.2 +022500 PROCEDURE DIVISION. CM1044.2 +022600 SECT-CM104M-0001 SECTION. CM1044.2 +022700 CM104M-INIT. CM1044.2 +022800 OPEN OUTPUT PRINT-FILE. CM1044.2 +022900 MOVE "CM104M " TO TEST-ID. CM1044.2 +023000 MOVE TEST-ID TO ID-AGAIN. CM1044.2 +023100 PERFORM HEAD-ROUTINE. CM1044.2 +023200 PERFORM LOG-HEADER. CM1044.2 +023300 ENABLE INPUT CM-INQUE-1 WITH KEY CM1044.2 +023400 XXXXX031. CM1044.2 +023500 ENABLE INPUT CM-INQUE-2 WITH KEY CM1044.2 +023600 XXXXX036. CM1044.2 +023700 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM1044.2 +023800 XXXXX033. CM1044.2 +023900 ENABLE OUTPUT CM-OUTQUE-2 WITH KEY CM1044.2 +024000 XXXXX037. CM1044.2 +024100 CM104M-POLL-1. CM1044.2 +024200 MOVE SPACES TO MSG. CM1044.2 +024300 RECEIVE CM-INQUE-1 MESSAGE INTO MSG CM1044.2 +024400 NO DATA GO TO CM104M-POLL-2. CM1044.2 +024500 ACCEPT CM-INQUE-1 COUNT. CM1044.2 +024600 IF IN-LENGTH-1 IS GREATER THAN 72 CM1044.2 +024700 MOVE 72 TO OUT-LENGTH-2 CM1044.2 +024800 ELSE MOVE IN-LENGTH-1 TO OUT-LENGTH-2. CM1044.2 +024900 SEND CM-OUTQUE-2 FROM MSG WITH EMI. CM1044.2 +025000 ACCEPT SEND-TIME FROM TIME. CM1044.2 +025100 MOVE SOURCE-1 TO SYM-SOURCE. CM1044.2 +025200 MOVE CORR TIME-RECEIVED-1 TO LOG-TIME. CM1044.2 +025300 COMPUTE OUT-TIME = CM1044.2 +025400 (S-HRS * 3600 + S-MINS * 60 + S-SECS) - CM1044.2 +025500 (HRS OF TIME-RECEIVED-1 * 3600 + MINS OF TIME-RECEIVED-1 CM1044.2 +025600 * 60 + SECS OF TIME-RECEIVED-1). CM1044.2 +025700 MOVE MSG-COUNT-1 TO QUEUE-DEPTH. CM1044.2 +025800 MOVE IN-LENGTH-1 TO MSG-LENGTH. CM1044.2 +025900 MOVE IN-STATUS-1 TO IN-STATUS. CM1044.2 +026000 MOVE OUT-STATUS-2 TO OUT-STATUS. CM1044.2 +026100 MOVE ERR-KEY-2 TO OUT-ERR-KEY. CM1044.2 +026200 MOVE LOG-LINE TO PRINT-REC. CM1044.2 +026300 WRITE PRINT-REC. CM1044.2 +026400 IF KILL-FIELD IS EQUAL TO "KILL" GO TO CM104M-FINI. CM1044.2 +026500 CM104M-POLL-2. CM1044.2 +026600 MOVE SPACES TO MSG. CM1044.2 +026700 RECEIVE CM-INQUE-2 MESSAGE INTO MSG CM1044.2 +026800 NO DATA GO TO CM104M-POLL-1. CM1044.2 +026900 ACCEPT CM-INQUE-2 COUNT. CM1044.2 +027000 IF IN-LENGTH-2 IS GREATER THAN 72 CM1044.2 +027100 MOVE 72 TO OUT-LENGTH-1 CM1044.2 +027200 ELSE MOVE IN-LENGTH-2 TO OUT-LENGTH-1. CM1044.2 +027300 SEND CM-OUTQUE-1 FROM MSG WITH EMI. CM1044.2 +027400 ACCEPT SEND-TIME FROM TIME. CM1044.2 +027500 MOVE SOURCE-2 TO SYM-SOURCE. CM1044.2 +027600 MOVE CORR TIME-RECEIVED-2 TO LOG-TIME. CM1044.2 +027700 COMPUTE OUT-TIME = CM1044.2 +027800 (S-HRS * 3600 + S-MINS * 60 + S-SECS) - CM1044.2 +027900 (HRS OF TIME-RECEIVED-2 * 3600 + MINS OF TIME-RECEIVED-2 CM1044.2 +028000 * 60 + SECS OF TIME-RECEIVED-2). CM1044.2 +028100 MOVE MSG-COUNT-2 TO QUEUE-DEPTH. CM1044.2 +028200 MOVE IN-LENGTH-2 TO MSG-LENGTH. CM1044.2 +028300 MOVE IN-STATUS-2 TO IN-STATUS. CM1044.2 +028400 MOVE OUT-STATUS-1 TO OUT-STATUS. CM1044.2 +028500 MOVE ERR-KEY-1 TO OUT-ERR-KEY. CM1044.2 +028600 MOVE LOG-LINE TO PRINT-REC. CM1044.2 +028700 WRITE PRINT-REC. CM1044.2 +028800 IF KILL-FIELD IS EQUAL TO "KILL" GO TO CM104M-FINI. CM1044.2 +028900 GO TO CM104M-POLL-1. CM1044.2 +029000 CM104M-FINI. CM1044.2 +029100 PERFORM END-ROUTINE THRU END-ROUTINE-3. CM1044.2 +029200 CLOSE PRINT-FILE. CM1044.2 +029300 STOP RUN. CM1044.2 +029400 END-ROUTINE. CM1044.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1044.2 +029600 PERFORM WRITE-LINE. CM1044.2 +029700 PARA-Z. CM1044.2 +029800 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1044.2 +029900 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1044.2 +030000 PERFORM WRITE-LINE. CM1044.2 +030100 END-ROUTINE-3. CM1044.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1044.2 +030300 PERFORM WRITE-LINE. CM1044.2 +030400 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1044.2 +030500 PERFORM WRITE-LINE. CM1044.2 +030600 BLANK-LINE-PRINT. CM1044.2 +030700 MOVE SPACE TO DUMMY-RECORD. CM1044.2 +030800 PERFORM WRITE-LINE. CM1044.2 +030900 WRITE-LINE. CM1044.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1044.2 +031100 LOG-HEADER. CM1044.2 +031200 MOVE LOG-HDR-1 TO PRINT-REC CM1044.2 +031300 WRITE PRINT-REC CM1044.2 +031400 AFTER 3 LINES. CM1044.2 +031500 MOVE LOG-HDR-2 TO PRINT-REC. CM1044.2 +031600 WRITE PRINT-REC CM1044.2 +031700 AFTER 3 LINES. CM1044.2 +031800 MOVE LOG-HDR-3 TO PRINT-REC. CM1044.2 +031900 WRITE PRINT-REC CM1044.2 +032000 MOVE LOG-HDR-4 TO PRINT-REC. CM1044.2 +032100 PERFORM WRITE-LINE. CM1044.2 +032200 MOVE SPACES TO PRINT-REC. CM1044.2 +032300 PERFORM WRITE-LINE. CM1044.2 +032400 HEAD-ROUTINE. CM1044.2 +032500 MOVE CCVS-H-1 TO PRINT-REC CM1044.2 +032600 WRITE PRINT-REC CM1044.2 +032700 AFTER ADVANCING PAGE. CM1044.2 +032800 MOVE CCVS-H-2 TO PRINT-REC. CM1044.2 +032900 WRITE PRINT-REC CM1044.2 +033000 AFTER 2 LINES. CM1044.2 +033100 MOVE CCVS-H-3 TO PRINT-REC. CM1044.2 +033200 WRITE PRINT-REC CM1044.2 +033300 AFTER 5 LINES. CM1044.2 +033400 MOVE HYPHEN-LINE TO PRINT-REC. CM1044.2 +033500 PERFORM WRITE-LINE. CM1044.2 +*END-OF,CM104M +*HEADER,COBOL,CM105M +000100 IDENTIFICATION DIVISION. CM1054.2 +000200 PROGRAM-ID. CM1054.2 +000300 CM105M. CM1054.2 +000400 AUTHOR. CM1054.2 +000500 FEDERAL COMPILER TESTING CENTER. CM1054.2 +000600 INSTALLATION. CM1054.2 +000700 GENERAL SERVICES ADMINISTRATION CM1054.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM1054.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM1054.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM1054.2 +001100 FALLS CHURCH VIRGINIA 22041. CM1054.2 +001200 CM1054.2 +001300 PHONE (703) 756-6153 CM1054.2 +001400 CM1054.2 +001500 " HIGH ". CM1054.2 +001600 DATE-WRITTEN. CM1054.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM1054.2 +001800 CREATION DATE / VALIDATION DATE CM1054.2 +001900 "4.2 ". CM1054.2 +002000 SECURITY. CM1054.2 +002100 NONE. CM1054.2 +002200 ENVIRONMENT DIVISION. CM1054.2 +002300 CONFIGURATION SECTION. CM1054.2 +002400 SOURCE-COMPUTER. CM1054.2 +002500 XXXXX082. CM1054.2 +002600 OBJECT-COMPUTER. CM1054.2 +002700 XXXXX083. CM1054.2 +002800 INPUT-OUTPUT SECTION. CM1054.2 +002900 FILE-CONTROL. CM1054.2 +003000 SELECT PRINT-FILE ASSIGN TO CM1054.2 +003100 XXXXX055. CM1054.2 +003200 DATA DIVISION. CM1054.2 +003300 FILE SECTION. CM1054.2 +003400 FD PRINT-FILE CM1054.2 +003500 LABEL RECORDS CM1054.2 +003600 XXXXX084 CM1054.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM1054.2 +003800 01 PRINT-REC PICTURE X(120). CM1054.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM1054.2 +004000 WORKING-STORAGE SECTION. CM1054.2 +004100 77 P PIC X(12). CM1054.2 +004200 77 PP PIC X(24). CM1054.2 +004300 77 PPP PIC X(36). CM1054.2 +004400 77 PS PIC X(24). CM1054.2 +004500 77 PSP PIC X(36). CM1054.2 +004600 77 PPS PIC X(36). CM1054.2 +004700 01 QUEUE-NAMES. CM1054.2 +004800 02 PPPP PIC X(48) VALUE CM1054.2 +004900 XXXXX038. CM1054.2 +005000 02 PPPS PIC X(48) VALUE CM1054.2 +005100 XXXXX039. CM1054.2 +005200 02 PPSP PIC X(48) VALUE CM1054.2 +005300 XXXXX040. CM1054.2 +005400 02 PSPP PIC X(48) VALUE CM1054.2 +005500 XXXXX041. CM1054.2 +005600 01 QUEUE-NAMES-TABLE REDEFINES QUEUE-NAMES. CM1054.2 +005700 02 NAME-SET PIC X(48) OCCURS 4 TIMES INDEXED BY I1. CM1054.2 +005800 01 TEST-RESULTS. CM1054.2 +005900 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +006000 02 FEATURE PICTURE X(18). CM1054.2 +006100 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +006200 02 P-OR-F PICTURE X(5). CM1054.2 +006300 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +006400 02 PAR-NAME PIC X(20). CM1054.2 +006500 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +006600 02 COMPUTED-A. CM1054.2 +006700 03 FILLER PIC X(9) VALUE SPACE. CM1054.2 +006800 03 STAT PIC XX. CM1054.2 +006900 03 FILLER PIC X(9) VALUE SPACE. CM1054.2 +007000 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +007100 02 CORRECT-A. CM1054.2 +007200 03 FILLER PIC X(8). CM1054.2 +007300 03 CORRECT-QUEUE PIC X(4). CM1054.2 +007400 03 FILLER PIC X(8). CM1054.2 +007500 02 FILLER PICTURE X VALUE SPACE. CM1054.2 +007600 02 RE-MARK. CM1054.2 +007700 03 QUEUE-KEY PIC X(4). CM1054.2 +007800 03 FILLER PIC X(26). CM1054.2 +007900 01 COLUMNS-LINE-1. CM1054.2 +008000 02 FILLER PIC X(3) VALUE SPACES. CM1054.2 +008100 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM1054.2 +008200 02 FILLER PIC X(9) VALUE "RESLT". CM1054.2 +008300 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM1054.2 +008400 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM1054.2 +008500 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM1054.2 +008600 02 FILLER PIC X(7) VALUE "REMARKS". CM1054.2 +008700 01 COLUMNS-LINE-2. CM1054.2 +008800 02 FILLER PIC X VALUE SPACE. CM1054.2 +008900 02 FILLER PIC X(18) VALUE ALL "-". CM1054.2 +009000 02 FILLER PIC X VALUE SPACE. CM1054.2 +009100 02 FILLER PIC X(5) VALUE ALL "-". CM1054.2 +009200 02 FILLER PIC X VALUE SPACE. CM1054.2 +009300 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 +009400 02 FILLER PIC X VALUE SPACE. CM1054.2 +009500 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 +009600 02 FILLER PIC X VALUE SPACE. CM1054.2 +009700 02 FILLER PIC X(20) VALUE ALL "-". CM1054.2 +009800 02 FILLER PIC X VALUE SPACE. CM1054.2 +009900 02 FILLER PIC X(31) VALUE ALL "-". CM1054.2 +010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM1054.2 +010100 01 REC-CT PICTURE 99 VALUE ZERO. CM1054.2 +010200 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM1054.2 +010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM1054.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM1054.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. CM1054.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM1054.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. CM1054.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM1054.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM1054.2 +011000 01 CCVS-H-1. CM1054.2 +011100 02 FILLER PICTURE X(27) VALUE SPACE. CM1054.2 +011200 02 FILLER PICTURE X(67) VALUE CM1054.2 +011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM1054.2 +011400- " SYSTEM". CM1054.2 +011500 02 FILLER PICTURE X(26) VALUE SPACE. CM1054.2 +011600 01 CCVS-H-2. CM1054.2 +011700 02 FILLER PICTURE X(52) VALUE IS CM1054.2 +011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM1054.2 +011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM1054.2 +012000 02 TEST-ID PICTURE IS X(9). CM1054.2 +012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM1054.2 +012200 01 CCVS-H-3. CM1054.2 +012300 02 FILLER PICTURE X(34) VALUE CM1054.2 +012400 " FOR OFFICIAL USE ONLY ". CM1054.2 +012500 02 FILLER PICTURE X(58) VALUE CM1054.2 +012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM1054.2 +012700 02 FILLER PICTURE X(28) VALUE CM1054.2 +012800 " COPYRIGHT 1974 ". CM1054.2 +012900 01 CCVS-E-1. CM1054.2 +013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM1054.2 +013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM1054.2 +013200 02 ID-AGAIN PICTURE IS X(9). CM1054.2 +013300 02 FILLER PICTURE X(45) VALUE IS CM1054.2 +013400 " NTIS DISTRIBUTION COBOL 74". CM1054.2 +013500 01 CCVS-E-2. CM1054.2 +013600 02 FILLER PICTURE X(31) VALUE CM1054.2 +013700 SPACE. CM1054.2 +013800 02 FILLER PICTURE X(21) VALUE SPACE. CM1054.2 +013900 02 CCVS-E-2-2. CM1054.2 +014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM1054.2 +014100 03 FILLER PICTURE IS X VALUE IS SPACE. CM1054.2 +014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM1054.2 +014300 01 CCVS-E-3. CM1054.2 +014400 02 FILLER PICTURE X(22) VALUE CM1054.2 +014500 " FOR OFFICIAL USE ONLY". CM1054.2 +014600 02 FILLER PICTURE X(12) VALUE SPACE. CM1054.2 +014700 02 FILLER PICTURE X(58) VALUE CM1054.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM1054.2 +014900 02 FILLER PICTURE X(13) VALUE SPACE. CM1054.2 +015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM1054.2 +015100 01 CCVS-E-4. CM1054.2 +015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM1054.2 +015300 02 FILLER PIC XXXX VALUE " OF ". CM1054.2 +015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM1054.2 +015500 02 FILLER PIC X(40) VALUE CM1054.2 +015600 " TESTS WERE EXECUTED SUCCESSFULLY". CM1054.2 +015700 01 XXINFO. CM1054.2 +015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM1054.2 +015900 02 INFO-TEXT. CM1054.2 +016000 04 FILLER PIC X(20) VALUE SPACE. CM1054.2 +016100 04 XXCOMPUTED PIC X(20). CM1054.2 +016200 04 FILLER PIC X(5) VALUE SPACE. CM1054.2 +016300 04 XXCORRECT PIC X(20). CM1054.2 +016400 01 HYPHEN-LINE. CM1054.2 +016500 02 FILLER PICTURE IS X VALUE IS SPACE. CM1054.2 +016600 02 FILLER PICTURE IS X(65) VALUE IS "************************CM1054.2 +016700- "*****************************************". CM1054.2 +016800 02 FILLER PICTURE IS X(54) VALUE IS "************************CM1054.2 +016900- "******************************". CM1054.2 +017000 01 CCVS-PGM-ID PIC X(6) VALUE CM1054.2 +017100 "CM105M". CM1054.2 +017200 01 MAIN-QUEUE-NAME. CM1054.2 +017300 02 MAIN-QUEUE PIC X(12). CM1054.2 +017400 02 FILLER PIC X(36) VALUE SPACE. CM1054.2 +017500 COMMUNICATION SECTION. CM1054.2 +017600 CD CM-INQUE-1 INPUT STATUS KEY IS IN-STAT SUB-QUEUE-3 CM1054.2 +017700 IS-OF-NO-INTEREST COUNT NAMED-BELOW SOURCE NOT-USED. CM1054.2 +017800 01 INQUE-RECORD. CM1054.2 +017900 02 QUEUE-SET PIC X(48). CM1054.2 +018000 02 FILLER PIC X(33). CM1054.2 +018100 02 MSG-COUNT-N PIC 9(6). CM1054.2 +018200 02 MSG-CNT REDEFINES MSG-COUNT-N. CM1054.2 +018300 03 FILLER PIC X(4). CM1054.2 +018400 03 MSG-COUNT PIC XX. CM1054.2 +018500 PROCEDURE DIVISION. CM1054.2 +018600 SECT-CM105M-0001 SECTION. CM1054.2 +018700 CM105M-INIT. CM1054.2 +018800 OPEN OUTPUT PRINT-FILE. CM1054.2 +018900 MOVE "CM105M " TO TEST-ID. CM1054.2 +019000 MOVE TEST-ID TO ID-AGAIN. CM1054.2 +019100 MOVE SPACE TO TEST-RESULTS. CM1054.2 +019200 PERFORM HEAD-ROUTINE. CM1054.2 +019300 PERFORM COLUMN-NAMES-ROUTINE. CM1054.2 +019400 MOVE CM1054.2 +019500 XXXXX030 CM1054.2 +019600 TO MAIN-QUEUE. CM1054.2 +019700 MOVE MAIN-QUEUE-NAME TO QUEUE-SET. CM1054.2 +019800 ENABLE INPUT CM-INQUE-1 KEY CM1054.2 +019900 XXXXX031. CM1054.2 +020000 PERFORM BUILD-UP-QUEUES VARYING I1 FROM 1 BY 1 CM1054.2 +020100 UNTIL I1 IS GREATER THAN 4. CM1054.2 +020200 GO TO BEGIN-TESTS. CM1054.2 +020300 BUILD-UP-QUEUES. CM1054.2 +020400 MOVE NAME-SET (I1) TO QUEUE-SET. CM1054.2 +020500 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +020600 IF MSG-COUNT IS LESS THAN 10 GO TO BUILD-UP-QUEUES. CM1054.2 +020700 BEGIN-TESTS. CM1054.2 +020800 DISABLE INPUT CM-INQUE-1 KEY CM1054.2 +020900 XXXXX031. CM1054.2 +021000 MOVE PPPP TO P PP PPP. CM1054.2 +021100 MOVE PPSP TO PPS. CM1054.2 +021200 MOVE PSPP TO PS PSP. CM1054.2 +021300 QUEUE-TEST-01. CM1054.2 +021400 MOVE "QUEUE SERIES PPPP" TO FEATURE. CM1054.2 +021500 MOVE PPPP TO QUEUE-SET. CM1054.2 +021600 PERFORM RECEIVE-A-MSG. CM1054.2 +021700 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 +021800 PERFORM PASS GO TO QUEUE-TEST-WRITE-01. CM1054.2 +021900 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 +022000 PERFORM FAIL. CM1054.2 +022100 QUEUE-TEST-WRITE-01. CM1054.2 +022200 MOVE "QUEUE-TEST-01" TO PAR-NAME. CM1054.2 +022300 PERFORM PRINT-DETAIL. CM1054.2 +022400 QUEUE-TEST-02. CM1054.2 +022500 MOVE "QUEUE SERIES PPPS" TO FEATURE. CM1054.2 +022600 MOVE PPPS TO QUEUE-SET. CM1054.2 +022700 PERFORM RECEIVE-A-MSG. CM1054.2 +022800 IF QUEUE-KEY IS EQUAL TO "PPPS" CM1054.2 +022900 PERFORM PASS GO TO QUEUE-TEST-WRITE-02. CM1054.2 +023000 MOVE "PPPS" TO CORRECT-QUEUE. CM1054.2 +023100 PERFORM FAIL. CM1054.2 +023200 QUEUE-TEST-WRITE-02. CM1054.2 +023300 MOVE "QUEUE-TEST-02" TO PAR-NAME. CM1054.2 +023400 PERFORM PRINT-DETAIL. CM1054.2 +023500 QUEUE-TEST-03. CM1054.2 +023600 MOVE "QUEUE SERIES PPSP" TO FEATURE. CM1054.2 +023700 MOVE PPSP TO QUEUE-SET. CM1054.2 +023800 PERFORM RECEIVE-A-MSG. CM1054.2 +023900 IF QUEUE-KEY IS EQUAL TO "PPSP" CM1054.2 +024000 PERFORM PASS GO TO QUEUE-TEST-WRITE-03. CM1054.2 +024100 MOVE "PPSP" TO CORRECT-QUEUE. CM1054.2 +024200 PERFORM FAIL. CM1054.2 +024300 QUEUE-TEST-WRITE-03. CM1054.2 +024400 MOVE "QUEUE-TEST-03" TO PAR-NAME. CM1054.2 +024500 PERFORM PRINT-DETAIL. CM1054.2 +024600 QUEUE-TEST-04. CM1054.2 +024700 MOVE "QUEUE SERIES PSPP" TO FEATURE. CM1054.2 +024800 MOVE PSPP TO QUEUE-SET. CM1054.2 +024900 PERFORM RECEIVE-A-MSG. CM1054.2 +025000 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 +025100 PERFORM PASS GO TO QUEUE-TEST-WRITE-04. CM1054.2 +025200 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 +025300 PERFORM FAIL. CM1054.2 +025400 QUEUE-TEST-WRITE-04. CM1054.2 +025500 MOVE "QUEUE-TEST-04" TO PAR-NAME. CM1054.2 +025600 PERFORM PRINT-DETAIL. CM1054.2 +025700 QUEUE-TEST-05. CM1054.2 +025800 MOVE "QUEUE SERIES P" TO FEATURE. CM1054.2 +025900 MOVE P TO QUEUE-SET. CM1054.2 +026000 PERFORM RECEIVE-A-MSG. CM1054.2 +026100 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 +026200 PERFORM PASS GO TO QUEUE-TEST-WRITE-05. CM1054.2 +026300 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 +026400 PERFORM FAIL. CM1054.2 +026500 QUEUE-TEST-WRITE-05. CM1054.2 +026600 MOVE "QUEUE-TEST-05" TO PAR-NAME. CM1054.2 +026700 PERFORM PRINT-DETAIL. CM1054.2 +026800 QUEUE-TEST-06. CM1054.2 +026900 MOVE "QUEUE SERIES PP" TO FEATURE. CM1054.2 +027000 MOVE PP TO QUEUE-SET. CM1054.2 +027100 PERFORM RECEIVE-A-MSG. CM1054.2 +027200 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 +027300 PERFORM PASS GO TO QUEUE-TEST-WRITE-06. CM1054.2 +027400 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 +027500 PERFORM FAIL. CM1054.2 +027600 QUEUE-TEST-WRITE-06. CM1054.2 +027700 MOVE "QUEUE-TEST-06" TO PAR-NAME. CM1054.2 +027800 PERFORM PRINT-DETAIL. CM1054.2 +027900 QUEUE-TEST-07. CM1054.2 +028000 MOVE "QUEUE SERIES PPP" TO FEATURE. CM1054.2 +028100 MOVE PPP TO QUEUE-SET. CM1054.2 +028200 PERFORM RECEIVE-A-MSG. CM1054.2 +028300 IF QUEUE-KEY IS EQUAL TO "PPPP" CM1054.2 +028400 PERFORM PASS GO TO QUEUE-TEST-WRITE-07. CM1054.2 +028500 MOVE "PPPP" TO CORRECT-QUEUE. CM1054.2 +028600 PERFORM FAIL. CM1054.2 +028700 QUEUE-TEST-WRITE-07. CM1054.2 +028800 MOVE "QUEUE-TEST-07" TO PAR-NAME. CM1054.2 +028900 PERFORM PRINT-DETAIL. CM1054.2 +029000 QUEUE-TEST-08. CM1054.2 +029100 MOVE "QUEUE SERIES PS" TO FEATURE. CM1054.2 +029200 MOVE PS TO QUEUE-SET. CM1054.2 +029300 PERFORM RECEIVE-A-MSG. CM1054.2 +029400 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 +029500 PERFORM PASS GO TO QUEUE-TEST-WRITE-08. CM1054.2 +029600 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 +029700 PERFORM FAIL. CM1054.2 +029800 QUEUE-TEST-WRITE-08. CM1054.2 +029900 MOVE "QUEUE-TEST-08" TO PAR-NAME. CM1054.2 +030000 PERFORM PRINT-DETAIL. CM1054.2 +030100 QUEUE-TEST-09. CM1054.2 +030200 MOVE "QUEUE SERIES PSP" TO FEATURE. CM1054.2 +030300 MOVE PSP TO QUEUE-SET. CM1054.2 +030400 PERFORM RECEIVE-A-MSG. CM1054.2 +030500 IF QUEUE-KEY IS EQUAL TO "PSPP" CM1054.2 +030600 PERFORM PASS GO TO QUEUE-TEST-WRITE-09. CM1054.2 +030700 MOVE "PSPP" TO CORRECT-QUEUE. CM1054.2 +030800 PERFORM FAIL. CM1054.2 +030900 QUEUE-TEST-WRITE-09. CM1054.2 +031000 MOVE "QUEUE-TEST-09" TO PAR-NAME. CM1054.2 +031100 PERFORM PRINT-DETAIL. CM1054.2 +031200 QUEUE-TEST-10. CM1054.2 +031300 MOVE "QUEUE SERIES PPS" TO FEATURE. CM1054.2 +031400 MOVE PPS TO QUEUE-SET. CM1054.2 +031500 PERFORM RECEIVE-A-MSG. CM1054.2 +031600 IF QUEUE-KEY IS EQUAL TO "PPSP" CM1054.2 +031700 PERFORM PASS GO TO QUEUE-TEST-WRITE-10. CM1054.2 +031800 MOVE "PPSP" TO CORRECT-QUEUE. CM1054.2 +031900 PERFORM FAIL. CM1054.2 +032000 QUEUE-TEST-WRITE-10. CM1054.2 +032100 MOVE "QUEUE-TEST-10" TO PAR-NAME. CM1054.2 +032200 PERFORM PRINT-DETAIL. CM1054.2 +032300 ACCEPT-TEST-01. CM1054.2 +032400 MOVE "ACCEPT GROUP QUEUE" TO FEATURE. CM1054.2 +032500 MOVE PPPP TO QUEUE-SET. CM1054.2 +032600 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +032700 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +032800 MOVE IN-STAT TO STAT CM1054.2 +032900 MOVE "BAD STATUS FOR PPPP" TO RE-MARK CM1054.2 +033000 ELSE CM1054.2 +033100 MOVE MSG-COUNT TO STAT CM1054.2 +033200 MOVE "COUNT FOR PPPP" TO RE-MARK. CM1054.2 +033300 PERFORM ACCEPT-WRITE-01. CM1054.2 +033400 MOVE PPPS TO QUEUE-SET. CM1054.2 +033500 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +033600 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +033700 MOVE IN-STAT TO STAT CM1054.2 +033800 MOVE "BAD STATUS FOR PPPS" TO RE-MARK CM1054.2 +033900 ELSE CM1054.2 +034000 MOVE MSG-COUNT TO STAT CM1054.2 +034100 MOVE "COUNT FOR PPPS" TO RE-MARK. CM1054.2 +034200 PERFORM ACCEPT-WRITE-01. CM1054.2 +034300 MOVE PPSP TO QUEUE-SET. CM1054.2 +034400 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +034500 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +034600 MOVE IN-STAT TO STAT CM1054.2 +034700 MOVE "BAD STATUS FOR PPSP" TO RE-MARK CM1054.2 +034800 ELSE CM1054.2 +034900 MOVE MSG-COUNT TO STAT CM1054.2 +035000 MOVE "COUNT FOR PPSP" TO RE-MARK. CM1054.2 +035100 PERFORM ACCEPT-WRITE-01. CM1054.2 +035200 MOVE PSPP TO QUEUE-SET. CM1054.2 +035300 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +035400 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +035500 MOVE IN-STAT TO STAT CM1054.2 +035600 MOVE "BAD STATUS FOR PSPP" TO RE-MARK CM1054.2 +035700 ELSE CM1054.2 +035800 MOVE MSG-COUNT TO STAT CM1054.2 +035900 MOVE "COUNT FOR PSPP" TO RE-MARK. CM1054.2 +036000 PERFORM ACCEPT-WRITE-01. CM1054.2 +036100 MOVE P TO QUEUE-SET. CM1054.2 +036200 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +036300 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +036400 MOVE IN-STAT TO STAT CM1054.2 +036500 MOVE "BAD STATUS FOR P" TO RE-MARK CM1054.2 +036600 ELSE CM1054.2 +036700 MOVE MSG-COUNT TO STAT CM1054.2 +036800 MOVE "COUNT FOR P" TO RE-MARK. CM1054.2 +036900 PERFORM ACCEPT-WRITE-01. CM1054.2 +037000 MOVE PP TO QUEUE-SET. CM1054.2 +037100 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +037200 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +037300 MOVE IN-STAT TO STAT CM1054.2 +037400 MOVE "BAD STATUS FOR PP" TO STAT CM1054.2 +037500 ELSE CM1054.2 +037600 MOVE MSG-COUNT TO STAT CM1054.2 +037700 MOVE "COUNT FOR PP" TO RE-MARK. CM1054.2 +037800 PERFORM ACCEPT-WRITE-01. CM1054.2 +037900 MOVE PPP TO QUEUE-SET. CM1054.2 +038000 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +038100 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +038200 MOVE IN-STAT TO STAT CM1054.2 +038300 MOVE "BAD STATUS FOR PPP" TO STAT CM1054.2 +038400 ELSE CM1054.2 +038500 MOVE MSG-COUNT TO STAT CM1054.2 +038600 MOVE "COUNT FOR PPP" TO RE-MARK. CM1054.2 +038700 PERFORM ACCEPT-WRITE-01. CM1054.2 +038800 MOVE PS TO QUEUE-SET. CM1054.2 +038900 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +039000 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +039100 MOVE IN-STAT TO STAT CM1054.2 +039200 MOVE "BAD STATUS FOR PS" TO STAT CM1054.2 +039300 ELSE CM1054.2 +039400 MOVE MSG-COUNT TO STAT CM1054.2 +039500 MOVE "COUNT FOR PS" TO RE-MARK. CM1054.2 +039600 PERFORM ACCEPT-WRITE-01. CM1054.2 +039700 MOVE PSP TO QUEUE-SET. CM1054.2 +039800 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +039900 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +040000 MOVE IN-STAT TO STAT CM1054.2 +040100 MOVE "BAD STATUS FOR PSP" TO STAT CM1054.2 +040200 ELSE CM1054.2 +040300 MOVE MSG-COUNT TO STAT CM1054.2 +040400 MOVE "COUNT FOR PSP" TO RE-MARK. CM1054.2 +040500 PERFORM ACCEPT-WRITE-01. CM1054.2 +040600 MOVE PPS TO QUEUE-SET. CM1054.2 +040700 ACCEPT CM-INQUE-1 COUNT. CM1054.2 +040800 IF IN-STAT IS NOT EQUAL TO "00" CM1054.2 +040900 MOVE IN-STAT TO STAT CM1054.2 +041000 MOVE "BAD STATUS FOR PPS" TO STAT CM1054.2 +041100 ELSE CM1054.2 +041200 MOVE MSG-COUNT TO STAT CM1054.2 +041300 MOVE "COUNT FOR PPS" TO RE-MARK. CM1054.2 +041400 PERFORM ACCEPT-WRITE-01. CM1054.2 +041500 GO TO CM105-FINI. CM1054.2 +041600 ACCEPT-WRITE-01. CM1054.2 +041700 MOVE "ACCEPT-TEST-01" TO PAR-NAME. CM1054.2 +041800 MOVE "INFO" TO P-OR-F. CM1054.2 +041900 PERFORM PRINT-DETAIL. CM1054.2 +042000 CM105-FINI. CM1054.2 +042100 PERFORM END-ROUTINE THRU END-ROUTINE-4. CM1054.2 +042200 CLOSE PRINT-FILE. CM1054.2 +042300 STOP RUN. CM1054.2 +042400 RECEIVE-A-MSG. CM1054.2 +042500 MOVE SPACE TO RE-MARK. CM1054.2 +042600 RECEIVE CM-INQUE-1 MESSAGE INTO RE-MARK CM1054.2 +042700 NO DATA MOVE "NOTHING RECEIVED FROM MCS" TO RE-MARK. CM1054.2 +042800 COMMON-SUBROUTINES SECTION. CM1054.2 +042900 PASS. CM1054.2 +043000 MOVE "PASS" TO P-OR-F. CM1054.2 +043100 FAIL. CM1054.2 +043200 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM1054.2 +043300 ADD 1 TO ERROR-COUNTER. CM1054.2 +043400 MOVE "FAIL*" TO P-OR-F. CM1054.2 +043500 PRINT-DETAIL. CM1054.2 +043600 MOVE TEST-RESULTS TO PRINT-REC. CM1054.2 +043700 PERFORM WRITE-LINE. CM1054.2 +043800 MOVE SPACE TO P-OR-F. CM1054.2 +043900 MOVE SPACE TO COMPUTED-A. CM1054.2 +044000 MOVE SPACE TO CORRECT-A. CM1054.2 +044100 MOVE SPACE TO RE-MARK. CM1054.2 +044200 COLUMN-NAMES-ROUTINE. CM1054.2 +044300 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM1054.2 +044400 PERFORM WRITE-LINE. CM1054.2 +044500 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM1054.2 +044600 PERFORM WRITE-LINE. CM1054.2 +044700 PERFORM BLANK-LINE-PRINT. CM1054.2 +044800 END-ROUTINE. CM1054.2 +044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM1054.2 +045000 PERFORM WRITE-LINE. CM1054.2 +045100 PARA-Z. CM1054.2 +045200 PERFORM BLANK-LINE-PRINT 4 TIMES. CM1054.2 +045300 MOVE CCVS-E-1 TO DUMMY-RECORD. CM1054.2 +045400 PERFORM WRITE-LINE. CM1054.2 +045500 END-ROUTINE-1. CM1054.2 +045600 PERFORM BLANK-LINE-PRINT. CM1054.2 +045700 IF ERROR-COUNTER IS EQUAL TO ZERO CM1054.2 +045800 GO TO END-ROUTINE-2. CM1054.2 +045900 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM1054.2 +046000 GO TO END-ROUTINE-3. CM1054.2 +046100 END-ROUTINE-2. CM1054.2 +046200 MOVE " NO" TO ERROR-TOTAL. CM1054.2 +046300 END-ROUTINE-3. CM1054.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1054.2 +046500 PERFORM WRITE-LINE. CM1054.2 +046600 IF DELETE-CNT IS EQUAL TO ZERO CM1054.2 +046700 MOVE " NO" TO ERROR-TOTAL ELSE CM1054.2 +046800 MOVE DELETE-CNT TO ERROR-TOTAL. CM1054.2 +046900 MOVE "TESTS DELETED " TO ENDER-DESC. CM1054.2 +047000 MOVE CCVS-E-2 TO DUMMY-RECORD. CM1054.2 +047100 PERFORM WRITE-LINE. CM1054.2 +047200 END-ROUTINE-4. CM1054.2 +047300 MOVE CCVS-E-3 TO DUMMY-RECORD. CM1054.2 +047400 PERFORM WRITE-LINE. CM1054.2 +047500 BLANK-LINE-PRINT. CM1054.2 +047600 MOVE SPACE TO DUMMY-RECORD. CM1054.2 +047700 PERFORM WRITE-LINE. CM1054.2 +047800 WRITE-LINE. CM1054.2 +047900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM1054.2 +048000 HEAD-ROUTINE. CM1054.2 +048100 MOVE CCVS-H-1 TO PRINT-REC CM1054.2 +048200 WRITE PRINT-REC CM1054.2 +048300 AFTER ADVANCING PAGE. CM1054.2 +048400 MOVE CCVS-H-2 TO PRINT-REC. CM1054.2 +048500 WRITE PRINT-REC CM1054.2 +048600 AFTER 2 LINES. CM1054.2 +048700 MOVE CCVS-H-3 TO PRINT-REC. CM1054.2 +048800 WRITE PRINT-REC CM1054.2 +048900 AFTER 5 LINES. CM1054.2 +049000 MOVE HYPHEN-LINE TO PRINT-REC. CM1054.2 +049100 PERFORM WRITE-LINE. CM1054.2 +*END-OF,CM105M +*HEADER,COBOL,CM201M +000100 IDENTIFICATION DIVISION. CM2014.2 +000200 PROGRAM-ID. CM2014.2 +000300 CM201M. CM2014.2 +000400 AUTHOR. CM2014.2 +000500 FEDERAL COMPILER TESTING CENTER. CM2014.2 +000600 INSTALLATION. CM2014.2 +000700 GENERAL SERVICES ADMINISTRATION CM2014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM2014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM2014.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM2014.2 +001100 FALLS CHURCH VIRGINIA 22041. CM2014.2 +001200 CM2014.2 +001300 PHONE (703) 756-6153 CM2014.2 +001400 CM2014.2 +001500 " HIGH ". CM2014.2 +001600 DATE-WRITTEN. CM2014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM2014.2 +001800 CREATION DATE / VALIDATION DATE CM2014.2 +001900 "4.2 ". CM2014.2 +002000 SECURITY. CM2014.2 +002100 NONE. CM2014.2 +002200 ENVIRONMENT DIVISION. CM2014.2 +002300 CONFIGURATION SECTION. CM2014.2 +002400 SOURCE-COMPUTER. CM2014.2 +002500 XXXXX082. CM2014.2 +002600 OBJECT-COMPUTER. CM2014.2 +002700 XXXXX083. CM2014.2 +002800 DATA DIVISION. CM2014.2 +002900 WORKING-STORAGE SECTION. CM2014.2 +003000 77 MSG-72 PIC X(72). CM2014.2 +003100 01 RECOGNITION-MSG-1. CM2014.2 +003200 02 FILLER PIC X(32) VALUE CM2014.2 +003300 "RECEIPT OF MESSAGE FROM DEVICE """. CM2014.2 +003400 02 DEVICE-NAME PIC X(12). CM2014.2 +003500 02 FILLER PIC X(18) VALUE CM2014.2 +003600 """ IS ACKNOWLEDGED.". CM2014.2 +003700 01 RECOGNITION-MSG-2. CM2014.2 +003800 02 FILLER PIC X(20) VALUE CM2014.2 +003900 "QUEUE INVOLVED WAS """. CM2014.2 +004000 02 QUEUE-INVOLVED PIC X(48). CM2014.2 +004100 02 FILLER PIC XX VALUE """.". CM2014.2 +004200 01 RECOGNITION-MSG-3 PIC X(41) VALUE CM2014.2 +004300 "CM201M INVOKED BUT NO DATA WAS AVAILABLE.". CM2014.2 +004400 COMMUNICATION SECTION. CM2014.2 +004500 CD CM-INQUE-1 FOR INITIAL INPUT. CM2014.2 +004600 01 INQUE-1-RECORD. CM2014.2 +004700 02 QUEUE-SET PIC X(48). CM2014.2 +004800 02 FILLER PIC X(14). CM2014.2 +004900 02 SYM-SOURCE PIC X(12). CM2014.2 +005000 02 IN-LENGTH PIC 9(4). CM2014.2 +005100 02 FILLER PIC XXX. CM2014.2 +005200 02 MSG-COUNT PIC 9(6). CM2014.2 +005300 CD CM-OUTQUE-1 FOR OUTPUT. CM2014.2 +005400 01 OUTQUE-1-RECORD. CM2014.2 +005500 02 FILLER PIC 9999 VALUE 1. CM2014.2 +005600 02 OUT-LENGTH PIC 9999. CM2014.2 +005700 02 FILLER PIC XXX. CM2014.2 +005800 02 SYM-DEST PIC X(12) VALUE CM2014.2 +005900 XXXXX032. CM2014.2 +006000 PROCEDURE DIVISION. CM2014.2 +006100 SECT-CM201M-0001 SECTION. CM2014.2 +006200 CM201M-INIT. CM2014.2 +006300 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM2014.2 +006400 XXXXX033. CM2014.2 +006500 TAKE-NEXT-MSG. CM2014.2 +006600 RECEIVE CM-INQUE-1 MESSAGE INTO MSG-72 CM2014.2 +006700 NO DATA GO TO SOMETHING-IS-WRONG-HERE. CM2014.2 +006800 MOVE QUEUE-SET TO QUEUE-INVOLVED. CM2014.2 +006900 MOVE SYM-SOURCE TO DEVICE-NAME. CM2014.2 +007000 MOVE 62 TO OUT-LENGTH. CM2014.2 +007100 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-1 WITH EMI. CM2014.2 +007200 MOVE 70 TO OUT-LENGTH. CM2014.2 +007300 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-2 WITH EMI. CM2014.2 +007400 MOVE IN-LENGTH TO OUT-LENGTH. CM2014.2 +007500 SEND CM-OUTQUE-1 FROM MSG-72 WITH EGI. CM2014.2 +007600 ACCEPT CM-INQUE-1 MESSAGE COUNT. CM2014.2 +007700 IF MSG-COUNT IS EQUAL TO 0 STOP RUN CM2014.2 +007800 ELSE GO TO TAKE-NEXT-MSG. CM2014.2 +007900 SOMETHING-IS-WRONG-HERE. CM2014.2 +008000 MOVE 40 TO OUT-LENGTH. CM2014.2 +008100 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-3 WITH EMI. CM2014.2 +008200 MOVE QUEUE-SET TO QUEUE-INVOLVED. CM2014.2 +008300 MOVE 70 TO OUT-LENGTH. CM2014.2 +008400 SEND CM-OUTQUE-1 FROM RECOGNITION-MSG-2 WITH EGI. CM2014.2 +008500 STOP RUN. CM2014.2 +*END-OF,CM201M +*HEADER,COBOL,CM202M +000100 IDENTIFICATION DIVISION. CM2024.2 +000200 PROGRAM-ID. CM2024.2 +000300 CM202M. CM2024.2 +000400 AUTHOR. CM2024.2 +000500 FEDERAL COMPILER TESTING CENTER. CM2024.2 +000600 INSTALLATION. CM2024.2 +000700 GENERAL SERVICES ADMINISTRATION CM2024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. CM2024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. CM2024.2 +001000 5203 LEESBURG PIKE SUITE 1100 CM2024.2 +001100 FALLS CHURCH VIRGINIA 22041. CM2024.2 +001200 CM2024.2 +001300 PHONE (703) 756-6153 CM2024.2 +001400 CM2024.2 +001500 " HIGH ". CM2024.2 +001600 DATE-WRITTEN. CM2024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. CM2024.2 +001800 CREATION DATE / VALIDATION DATE CM2024.2 +001900 "4.2 ". CM2024.2 +002000 SECURITY. CM2024.2 +002100 NONE. CM2024.2 +002200 ENVIRONMENT DIVISION. CM2024.2 +002300 CONFIGURATION SECTION. CM2024.2 +002400 SOURCE-COMPUTER. CM2024.2 +002500 XXXXX082. CM2024.2 +002600 OBJECT-COMPUTER. CM2024.2 +002700 XXXXX083. CM2024.2 +002800 INPUT-OUTPUT SECTION. CM2024.2 +002900 FILE-CONTROL. CM2024.2 +003000 SELECT PRINT-FILE ASSIGN TO CM2024.2 +003100 XXXXX055. CM2024.2 +003200 DATA DIVISION. CM2024.2 +003300 FILE SECTION. CM2024.2 +003400 FD PRINT-FILE CM2024.2 +003500 LABEL RECORDS CM2024.2 +003600 XXXXX084 CM2024.2 +003700 DATA RECORD IS PRINT-REC DUMMY-RECORD. CM2024.2 +003800 01 PRINT-REC PICTURE X(120). CM2024.2 +003900 01 DUMMY-RECORD PICTURE X(120). CM2024.2 +004000 WORKING-STORAGE SECTION. CM2024.2 +004100 77 END-FLAG PIC 9. CM2024.2 +004200 77 FAIL-SAFE PIC 999 COMP. CM2024.2 +004300 77 ELAPSED-TIME PIC 999. CM2024.2 +004400 77 ENABLE-ALL-MSG PIC X(57) VALUE CM2024.2 +004500 "ATTEMPT TO ENTER MESSAGES. BOTH SOURCES ARE NOW ENABLED.". CM2024.2 +004600 01 INIT-TIME. CM2024.2 +004700 02 I-HRS PIC 99. CM2024.2 +004800 02 I-MINS PIC 99. CM2024.2 +004900 02 I-SECS PIC 99V99. CM2024.2 +005000 01 TEST-TIME. CM2024.2 +005100 02 T-HRS PIC 99. CM2024.2 +005200 02 T-MINS PIC 99. CM2024.2 +005300 02 T-SECS PIC 99V99. CM2024.2 +005400 01 SKIP-MSG-1 PIC X(71) VALUE "SEGMENTED-MSG-TEST-05: THERE SHOUCM2024.2 +005500- "LD BE NO BLANK LINES BETWEEN THIS LINE". CM2024.2 +005600 01 SKIP-MSG-2 PIC X(17) VALUE "AND THIS ONE.". CM2024.2 +005700 01 INCOMP-MSG. CM2024.2 +005800 02 FILLER PIC X(20) VALUE "INCOMPLETE-MSG-TEST-". CM2024.2 +005900 02 INC-MSG-NO PIC 99. CM2024.2 +006000 02 FILLER PIC X(33) VALUE " FAILURE IF THIS SEGMENT APPEARS.CM2024.2 +006100- "". CM2024.2 +006200 01 ENABLE-MSG. CM2024.2 +006300 02 FILLER PIC X(34) VALUE "ATTEMPT TO ENTER MESSAGES. ONLY CM2024.2 +006400- """". CM2024.2 +006500 02 SELECTED-SOURCE PIC X(12). CM2024.2 +006600 02 FILLER PIC X(13) VALUE """ IS ENABLED.". CM2024.2 +006700 01 DISABLE-MSG. CM2024.2 +006800 02 FILLER PIC X(36) VALUE CM2024.2 +006900 "TERMINALS DEACTIVATED FOR INPUT: ". CM2024.2 +007000 02 TERMINAL-1 PIC X(14) VALUE CM2024.2 +007100 XXXXX042. CM2024.2 +007200 02 TERMINAL-2 PIC X(12) VALUE CM2024.2 +007300 XXXXX043. CM2024.2 +007400 01 SEND-MSG. CM2024.2 +007500 02 FILLER PIC X(17) VALUE "SEND-STATUS-TEST-". CM2024.2 +007600 02 TEST-NUMB PIC 99 VALUE 1. CM2024.2 +007700 02 FILLER PIC X(42) VALUE CM2024.2 +007800 " FAILURE. THIS MESSAGE SHOULD NOT APPEAR.". CM2024.2 +007900 01 ONE-TERMINAL-MSG. CM2024.2 +008000 02 FILLER PIC X(15) VALUE "ONLY TERMINAL """. CM2024.2 +008100 02 SELECTED-DEST PIC X(12) VALUE CM2024.2 +008200 XXXXX032. CM2024.2 +008300 02 FILLER PIC X(30) VALUE CM2024.2 +008400 """ SHOULD RECEIVE THIS MESSAGE.". CM2024.2 +008500 01 SEG-INIT. CM2024.2 +008600 02 FILLER PIC X(19) VALUE "SEGMENTED-MSG-TEST-". CM2024.2 +008700 02 SEG-TEST-NO PIC 99. CM2024.2 +008800 02 FILLER PIC X(19) VALUE " SEGMENT INITIATED ". CM2024.2 +008900 02 FILLER PIC X(16) VALUE "-LENGTH FAILURE ". CM2024.2 +009000 01 SEG-CONT PIC X(10) VALUE "-CONTINUED". CM2024.2 +009100 01 MSG-COMP PIC X(14) VALUE "-MSG COMPLETE.". CM2024.2 +009200 01 GROUP-COMP PIC X(16) VALUE "-GROUP COMPLETE.". CM2024.2 +009300 01 TEST-RESULTS. CM2024.2 +009400 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +009500 02 FEATURE PICTURE X(18). CM2024.2 +009600 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +009700 02 P-OR-F PICTURE X(5). CM2024.2 +009800 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +009900 02 PAR-NAME PIC X(20). CM2024.2 +010000 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +010100 02 COMPUTED-A. CM2024.2 +010200 03 FILLER PIC X(9). CM2024.2 +010300 03 COMPUTED-STATUS PIC XX. CM2024.2 +010400 03 FILLER PIC X(9). CM2024.2 +010500 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +010600 02 CORRECT-A. CM2024.2 +010700 03 FILLER PIC X(9). CM2024.2 +010800 03 CORRECT-STATUS PIC XX. CM2024.2 +010900 03 FILLER PIC X(9). CM2024.2 +011000 02 FILLER PICTURE X VALUE SPACE. CM2024.2 +011100 02 RE-MARK. CM2024.2 +011200 03 MSG-1 PIC X. CM2024.2 +011300 03 FILLER PIC X(29). CM2024.2 +011400 01 COLUMNS-LINE-1. CM2024.2 +011500 02 FILLER PIC X(3) VALUE SPACES. CM2024.2 +011600 02 FILLER PIC X(17) VALUE "FEATURE TESTED". CM2024.2 +011700 02 FILLER PIC X(9) VALUE "RESLT". CM2024.2 +011800 02 FILLER PIC X(21) VALUE "PARAGRAPH NAME". CM2024.2 +011900 02 FILLER PIC X(22) VALUE "COMPUTED DATA". CM2024.2 +012000 02 FILLER PIC X(29) VALUE "CORRECT DATA". CM2024.2 +012100 02 FILLER PIC X(7) VALUE "REMARKS". CM2024.2 +012200 01 COLUMNS-LINE-2. CM2024.2 +012300 02 FILLER PIC X VALUE SPACE. CM2024.2 +012400 02 FILLER PIC X(18) VALUE ALL "-". CM2024.2 +012500 02 FILLER PIC X VALUE SPACE. CM2024.2 +012600 02 FILLER PIC X(5) VALUE ALL "-". CM2024.2 +012700 02 FILLER PIC X VALUE SPACE. CM2024.2 +012800 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 +012900 02 FILLER PIC X VALUE SPACE. CM2024.2 +013000 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 +013100 02 FILLER PIC X VALUE SPACE. CM2024.2 +013200 02 FILLER PIC X(20) VALUE ALL "-". CM2024.2 +013300 02 FILLER PIC X VALUE SPACE. CM2024.2 +013400 02 FILLER PIC X(31) VALUE ALL "-". CM2024.2 +013500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. CM2024.2 +013600 01 REC-CT PICTURE 99 VALUE ZERO. CM2024.2 +013700 01 DELETE-CNT PICTURE 999 VALUE ZERO. CM2024.2 +013800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. CM2024.2 +013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. CM2024.2 +014000 01 PASS-COUNTER PIC 999 VALUE ZERO. CM2024.2 +014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. CM2024.2 +014200 01 ERROR-HOLD PIC 999 VALUE ZERO. CM2024.2 +014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. CM2024.2 +014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. CM2024.2 +014500 01 CCVS-H-1. CM2024.2 +014600 02 FILLER PICTURE X(27) VALUE SPACE. CM2024.2 +014700 02 FILLER PICTURE X(67) VALUE CM2024.2 +014800 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION CM2024.2 +014900- " SYSTEM". CM2024.2 +015000 02 FILLER PICTURE X(26) VALUE SPACE. CM2024.2 +015100 01 CCVS-H-2. CM2024.2 +015200 02 FILLER PICTURE X(52) VALUE IS CM2024.2 +015300 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". CM2024.2 +015400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". CM2024.2 +015500 02 TEST-ID PICTURE IS X(9). CM2024.2 +015600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. CM2024.2 +015700 01 CCVS-H-3. CM2024.2 +015800 02 FILLER PICTURE X(34) VALUE CM2024.2 +015900 " FOR OFFICIAL USE ONLY ". CM2024.2 +016000 02 FILLER PICTURE X(58) VALUE CM2024.2 +016100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".CM2024.2 +016200 02 FILLER PICTURE X(28) VALUE CM2024.2 +016300 " COPYRIGHT 1974 ". CM2024.2 +016400 01 CCVS-E-1. CM2024.2 +016500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. CM2024.2 +016600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". CM2024.2 +016700 02 ID-AGAIN PICTURE IS X(9). CM2024.2 +016800 02 FILLER PICTURE X(45) VALUE IS CM2024.2 +016900 " NTIS DISTRIBUTION COBOL 74". CM2024.2 +017000 01 CCVS-E-2. CM2024.2 +017100 02 FILLER PICTURE X(31) VALUE CM2024.2 +017200 SPACE. CM2024.2 +017300 02 FILLER PICTURE X(21) VALUE SPACE. CM2024.2 +017400 02 CCVS-E-2-2. CM2024.2 +017500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. CM2024.2 +017600 03 FILLER PICTURE IS X VALUE IS SPACE. CM2024.2 +017700 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". CM2024.2 +017800 01 CCVS-E-3. CM2024.2 +017900 02 FILLER PICTURE X(22) VALUE CM2024.2 +018000 " FOR OFFICIAL USE ONLY". CM2024.2 +018100 02 FILLER PICTURE X(12) VALUE SPACE. CM2024.2 +018200 02 FILLER PICTURE X(58) VALUE CM2024.2 +018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".CM2024.2 +018400 02 FILLER PICTURE X(13) VALUE SPACE. CM2024.2 +018500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". CM2024.2 +018600 01 CCVS-E-4. CM2024.2 +018700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. CM2024.2 +018800 02 FILLER PIC XXXX VALUE " OF ". CM2024.2 +018900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. CM2024.2 +019000 02 FILLER PIC X(40) VALUE CM2024.2 +019100 " TESTS WERE EXECUTED SUCCESSFULLY". CM2024.2 +019200 01 XXINFO. CM2024.2 +019300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". CM2024.2 +019400 02 INFO-TEXT. CM2024.2 +019500 04 FILLER PIC X(20) VALUE SPACE. CM2024.2 +019600 04 XXCOMPUTED PIC X(20). CM2024.2 +019700 04 FILLER PIC X(5) VALUE SPACE. CM2024.2 +019800 04 XXCORRECT PIC X(20). CM2024.2 +019900 01 HYPHEN-LINE. CM2024.2 +020000 02 FILLER PICTURE IS X VALUE IS SPACE. CM2024.2 +020100 02 FILLER PICTURE IS X(65) VALUE IS "************************CM2024.2 +020200- "*****************************************". CM2024.2 +020300 02 FILLER PICTURE IS X(54) VALUE IS "************************CM2024.2 +020400- "******************************". CM2024.2 +020500 01 CCVS-PGM-ID PIC X(6) VALUE CM2024.2 +020600 "CM202M". CM2024.2 +020700 COMMUNICATION SECTION. CM2024.2 +020800 CD CM-INQUE-1 INPUT. CM2024.2 +020900 01 INQUE-1-RECORD. CM2024.2 +021000 02 QUEUE-SET PIC X(12) VALUE CM2024.2 +021100 XXXXX030. CM2024.2 +021200 02 FILLER PIC X(36) VALUE SPACES. CM2024.2 +021300 02 FILLER PIC X(14). CM2024.2 +021400 02 SYM-SOURCE PIC X(12). CM2024.2 +021500 02 IN-LENGTH PIC 9999. CM2024.2 +021600 02 END-KEY PIC X. CM2024.2 +021700 02 IN-STATUS PIC XX. CM2024.2 +021800 02 MSG-COUNT PIC 9(6). CM2024.2 +021900 CD CM-OUTQUE-1 OUTPUT CM2024.2 +022000 DESTINATION COUNT DEST-COUNT CM2024.2 +022100 TEXT LENGTH OUT-LENGTH CM2024.2 +022200 STATUS KEY OUT-STATUS CM2024.2 +022300 DESTINATION TABLE OCCURS 2 TIMES INDEXED BY I1 CM2024.2 +022400 ERROR KEY ERR-KEY CM2024.2 +022500 DESTINATION SYM-DEST. CM2024.2 +022600 PROCEDURE DIVISION. CM2024.2 +022700 SECT-CM202M-0001 SECTION. CM2024.2 +022800 CM202M-INIT. CM2024.2 +022900 OPEN OUTPUT PRINT-FILE. CM2024.2 +023000 MOVE "CM202M " TO TEST-ID. CM2024.2 +023100 MOVE TEST-ID TO ID-AGAIN. CM2024.2 +023200 MOVE SPACE TO TEST-RESULTS. CM2024.2 +023300 PERFORM HEAD-ROUTINE. CM2024.2 +023400 MOVE 2 TO DEST-COUNT CM2024.2 +023500 MOVE CM2024.2 +023600 XXXXX032 CM2024.2 +023700 TO SYM-DEST (1). CM2024.2 +023800 MOVE CM2024.2 +023900 XXXXX035 CM2024.2 +024000 TO SYM-DEST (2). CM2024.2 +024100 ENABLE OUTPUT CM-OUTQUE-1 WITH KEY CM2024.2 +024200 XXXXX033. CM2024.2 +024300 MOVE CM2024.2 +024400 XXXXX042 CM2024.2 +024500 TO SELECTED-SOURCE SYM-SOURCE. CM2024.2 +024600 MOVE 59 TO OUT-LENGTH. CM2024.2 +024700 SEND CM-OUTQUE-1 FROM ENABLE-MSG WITH EMI. CM2024.2 +024800 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +024900 XXXXX031. CM2024.2 +025000 PERFORM DELAY-FOR-30. CM2024.2 +025100 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +025200 XXXXX031. CM2024.2 +025300 MOVE CM2024.2 +025400 XXXXX043 CM2024.2 +025500 TO SELECTED-SOURCE SYM-SOURCE. CM2024.2 +025600 SEND CM-OUTQUE-1 FROM ENABLE-MSG WITH EMI. CM2024.2 +025700 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +025800 XXXXX031. CM2024.2 +025900 PERFORM DELAY-FOR-30. CM2024.2 +026000 MOVE 57 TO OUT-LENGTH. CM2024.2 +026100 SEND CM-OUTQUE-1 FROM ENABLE-ALL-MSG WITH EMI. CM2024.2 +026200 MOVE CM2024.2 +026300 XXXXX042 CM2024.2 +026400 TO SYM-SOURCE. CM2024.2 +026500 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +026600 XXXXX031. CM2024.2 +026700 PERFORM DELAY-FOR-30. CM2024.2 +026800 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +026900 XXXXX031. CM2024.2 +027000 MOVE CM2024.2 +027100 XXXXX043 CM2024.2 +027200 TO SYM-SOURCE. CM2024.2 +027300 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +027400 XXXXX031. CM2024.2 +027500 MOVE 62 TO OUT-LENGTH. CM2024.2 +027600 SEND CM-OUTQUE-1 FROM DISABLE-MSG WITH EMI. CM2024.2 +027700 PERFORM DELAY-FOR-30. CM2024.2 +027800 BEGIN-CM202M-STATUS-TESTS. CM2024.2 +027900 MOVE 200 TO FAIL-SAFE. CM2024.2 +028000 MOVE "RCV MSG/SHORT AREA" TO FEATURE. CM2024.2 +028100 MOVE "RECEIVE-TEST-01" TO PAR-NAME. CM2024.2 +028200 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM2024.2 +028300 MOVE " INSPECT RESULTS" TO CORRECT-A. CM2024.2 +028400 RECEIVE-TEST-01. CM2024.2 +028500 RECEIVE CM-INQUE-1 MESSAGE INTO MSG-1 NO DATA CM2024.2 +028600 MOVE "QUEUE TESTED EMPTY" TO COMPUTED-A CM2024.2 +028700 MOVE SPACES TO CORRECT-A RE-MARK CM2024.2 +028800 PERFORM FAIL PERFORM PRINT-DETAIL CM2024.2 +028900 GO TO RECEIVE-TEST-02-INIT. CM2024.2 +029000 IF END-KEY IS EQUAL TO "1" CM2024.2 +029100 MOVE SPACE TO CORRECT-A CM2024.2 +029200 MOVE " ESI WAS SENSED " TO COMPUTED-A CM2024.2 +029300 PERFORM FAIL CM2024.2 +029400 PERFORM PRINT-DETAIL CM2024.2 +029500 GO TO RECEIVE-TEST-02-INIT. CM2024.2 +029600 PERFORM PRINT-DETAIL. CM2024.2 +029700 IF END-KEY IS NOT EQUAL TO "0" GO TO RECEIVE-TEST-02-INIT. CM2024.2 +029800 MOVE "RECEIVE-TEST-01-CONT" TO PAR-NAME. CM2024.2 +029900 SUBTRACT 1 FROM FAIL-SAFE. CM2024.2 +030000 IF FAIL-SAFE IS EQUAL TO 0 CM2024.2 +030100 MOVE "FAIL-SAFE ACTIVATED" TO CORRECT-A CM2024.2 +030200 MOVE "****** WARNING *****" TO COMPUTED-A CM2024.2 +030300 PERFORM PRINT-DETAIL CM2024.2 +030400 GO TO RECEIVE-TEST-02-INIT. CM2024.2 +030500 PERFORM PRINT-DETAIL. CM2024.2 +030600 GO TO RECEIVE-TEST-01. CM2024.2 +030700 RECEIVE-DELETE-01. CM2024.2 +030800 PERFORM DE-LETE. CM2024.2 +030900 PERFORM PRINT-DETAIL. CM2024.2 +031000 RECEIVE-TEST-02-INIT. CM2024.2 +031100 MOVE 200 TO FAIL-SAFE. CM2024.2 +031200 MOVE "RCV SEG/SHORT AREA" TO FEATURE. CM2024.2 +031300 MOVE "RECEIVE-TEST-02" TO PAR-NAME. CM2024.2 +031400 MOVE " SEE REMARKS COLUMN " TO COMPUTED-A. CM2024.2 +031500 MOVE " INSPECT RESULTS" TO CORRECT-A. CM2024.2 +031600 RECEIVE-TEST-02. CM2024.2 +031700 RECEIVE CM-INQUE-1 SEGMENT INTO MSG-1 NO DATA CM2024.2 +031800 MOVE "QUEUE TESTED EMPTY" TO COMPUTED-A CM2024.2 +031900 MOVE SPACES TO CORRECT-A RE-MARK CM2024.2 +032000 PERFORM FAIL PERFORM PRINT-DETAIL CM2024.2 +032100 GO TO RECEIVE-TEST-03-INIT. CM2024.2 +032200 PERFORM PRINT-DETAIL. CM2024.2 +032300 IF END-KEY IS NOT EQUAL TO "0" GO TO RECEIVE-TEST-03-INIT. CM2024.2 +032400 MOVE "RECEIVE-TEST-02-CONT" TO PAR-NAME. CM2024.2 +032500 SUBTRACT 1 FROM FAIL-SAFE. CM2024.2 +032600 IF FAIL-SAFE IS EQUAL TO 0 CM2024.2 +032700 MOVE "FAIL-SAFE ACTIVATED" TO CORRECT-A CM2024.2 +032800 MOVE "****** WARNING *****" TO COMPUTED-A CM2024.2 +032900 PERFORM PRINT-DETAIL CM2024.2 +033000 GO TO RECEIVE-TEST-03-INIT. CM2024.2 +033100 PERFORM PRINT-DETAIL. CM2024.2 +033200 GO TO RECEIVE-TEST-02. CM2024.2 +033300 RECEIVE-DELETE-02. CM2024.2 +033400 PERFORM DE-LETE. CM2024.2 +033500 PERFORM PRINT-DETAIL. CM2024.2 +033600 RECEIVE-TEST-03-INIT. CM2024.2 +033700 MOVE "RCV SEG REPEATEDLY" TO FEATURE. CM2024.2 +033800 MOVE "RECEIVE-TEST-03" TO PAR-NAME. CM2024.2 +033900 RECEIVE-TEST-03. CM2024.2 +034000 MOVE "COMPTD SHOWS END KEY" TO CORRECT-A. CM2024.2 +034100 MOVE ALL "*" TO RE-MARK. CM2024.2 +034200 RECEIVE CM-INQUE-1 SEGMENT INTO RE-MARK CM2024.2 +034300 NO DATA GO TO ENABL-STATUS-TEST-01. CM2024.2 +034400 MOVE END-KEY TO COMPUTED-STATUS. CM2024.2 +034500 PERFORM PRINT-DETAIL. CM2024.2 +034600 MOVE "RECEIVE-TEST-03-CONT" TO PAR-NAME. CM2024.2 +034700 GO TO RECEIVE-TEST-03. CM2024.2 +034800 RECEIVE-DELETE-03. CM2024.2 +034900 PERFORM DE-LETE. CM2024.2 +035000 PERFORM PRINT-DETAIL. CM2024.2 +035100 ENABL-STATUS-TEST-01. CM2024.2 +035200 MOVE "ENABLE TERMINAL" TO FEATURE. CM2024.2 +035300 MOVE "BAD PASSWORD SUPPLIED" TO RE-MARK. CM2024.2 +035400 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY "GARBAGE". CM2024.2 +035500 IF IN-STATUS IS EQUAL TO "40" CM2024.2 +035600 PERFORM PASS GO TO ENABL-STATUS-WRITE-01. CM2024.2 +035700 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 +035800 MOVE "40" TO CORRECT-STATUS. CM2024.2 +035900 PERFORM FAIL. CM2024.2 +036000 GO TO ENABL-STATUS-WRITE-01. CM2024.2 +036100 ENABL-STATUS-DELETE-01. CM2024.2 +036200 PERFORM DE-LETE. CM2024.2 +036300 ENABL-STATUS-WRITE-01. CM2024.2 +036400 MOVE "ENABL-STATUS-TEST-01" TO PAR-NAME. CM2024.2 +036500 PERFORM PRINT-DETAIL. CM2024.2 +036600 ENABL-STATUS-TEST-02. CM2024.2 +036700 MOVE "BAD SOURCE NAME USED" TO RE-MARK. CM2024.2 +036800 MOVE "GARBAGE" TO SYM-SOURCE. CM2024.2 +036900 ENABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +037000 XXXXX031. CM2024.2 +037100 IF IN-STATUS IS EQUAL TO "21" CM2024.2 +037200 PERFORM PASS GO TO ENABL-STATUS-WRITE-02. CM2024.2 +037300 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 +037400 MOVE "21" TO CORRECT-STATUS. CM2024.2 +037500 PERFORM FAIL. CM2024.2 +037600 GO TO ENABL-STATUS-WRITE-02. CM2024.2 +037700 ENABL-STATUS-DELETE-02. CM2024.2 +037800 PERFORM DE-LETE. CM2024.2 +037900 ENABL-STATUS-WRITE-02. CM2024.2 +038000 MOVE "ENABL-STATUS-TEST-02" TO PAR-NAME. CM2024.2 +038100 PERFORM PRINT-DETAIL. CM2024.2 +038200 DISAB-STATUS-TEST-01. CM2024.2 +038300 MOVE "DISABLE TERMINAL" TO FEATURE. CM2024.2 +038400 MOVE "BAD PASSWORD SUPPLIED" TO RE-MARK. CM2024.2 +038500 MOVE CM2024.2 +038600 XXXXX042 CM2024.2 +038700 TO SYM-SOURCE. CM2024.2 +038800 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY "GARBAGE". CM2024.2 +038900 IF IN-STATUS IS EQUAL TO "40" CM2024.2 +039000 PERFORM PASS GO TO DISAB-STATUS-WRITE-01. CM2024.2 +039100 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 +039200 MOVE "40" TO CORRECT-STATUS. CM2024.2 +039300 PERFORM FAIL. CM2024.2 +039400 GO TO DISAB-STATUS-WRITE-01. CM2024.2 +039500 DISAB-STATUS-DELETE-01. CM2024.2 +039600 PERFORM DE-LETE. CM2024.2 +039700 DISAB-STATUS-WRITE-01. CM2024.2 +039800 MOVE "DISAB-STATUS-TEST-01" TO PAR-NAME. CM2024.2 +039900 PERFORM PRINT-DETAIL. CM2024.2 +040000 DISAB-STATUS-TEST-02. CM2024.2 +040100 MOVE "BAD SOURCE NAME USED" TO RE-MARK. CM2024.2 +040200 MOVE "GARBAGE" TO SYM-SOURCE. CM2024.2 +040300 DISABLE INPUT TERMINAL CM-INQUE-1 WITH KEY CM2024.2 +040400 XXXXX031. CM2024.2 +040500 IF IN-STATUS IS EQUAL TO "21" CM2024.2 +040600 PERFORM PASS GO TO DISAB-STATUS-WRITE-02. CM2024.2 +040700 MOVE IN-STATUS TO COMPUTED-STATUS. CM2024.2 +040800 MOVE "21" TO CORRECT-STATUS. CM2024.2 +040900 PERFORM FAIL. CM2024.2 +041000 GO TO DISAB-STATUS-WRITE-02. CM2024.2 +041100 DISAB-STATUS-DELETE-02. CM2024.2 +041200 PERFORM DE-LETE. CM2024.2 +041300 DISAB-STATUS-WRITE-02. CM2024.2 +041400 MOVE "DISAB-STATUS-TEST-02" TO PAR-NAME. CM2024.2 +041500 PERFORM PRINT-DETAIL. CM2024.2 +041600 SEND-STATUS-TEST-01. CM2024.2 +041700 MOVE "COUNT EXCEEDS LIMIT" TO RE-MARK. CM2024.2 +041800 MOVE 3 TO DEST-COUNT. CM2024.2 +041900 MOVE 61 TO OUT-LENGTH. CM2024.2 +042000 SEND CM-OUTQUE-1 FROM SEND-MSG WITH EMI. CM2024.2 +042100 IF OUT-STATUS IS EQUAL TO "30" CM2024.2 +042200 PERFORM PASS GO TO SEND-STATUS-WRITE-01. CM2024.2 +042300 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 +042400 MOVE "30" TO CORRECT-STATUS. CM2024.2 +042500 PERFORM FAIL. CM2024.2 +042600 GO TO SEND-STATUS-WRITE-01. CM2024.2 +042700 SEND-STATUS-DELETE-01. CM2024.2 +042800 PERFORM DE-LETE. CM2024.2 +042900 SEND-STATUS-WRITE-01. CM2024.2 +043000 MOVE "DESTINATION COUNT" TO FEATURE. CM2024.2 +043100 MOVE "SEND-STATUS-TEST-01" TO PAR-NAME. CM2024.2 +043200 PERFORM PRINT-DETAIL. CM2024.2 +043300 MOVE 2 TO DEST-COUNT. CM2024.2 +043400 SEND-STATUS-TEST-02. CM2024.2 +043500 MOVE 2 TO TEST-NUMB. CM2024.2 +043600 MOVE 0 TO OUT-LENGTH. CM2024.2 +043700 SEND CM-OUTQUE-1 FROM SEND-MSG. CM2024.2 +043800 IF OUT-STATUS IS EQUAL TO "60" CM2024.2 +043900 PERFORM PASS GO TO SEND-STATUS-WRITE-02. CM2024.2 +044000 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 +044100 MOVE "60" TO CORRECT-STATUS. CM2024.2 +044200 PERFORM FAIL. CM2024.2 +044300 GO TO SEND-STATUS-WRITE-02. CM2024.2 +044400 SEND-STATUS-DELETE-02. CM2024.2 +044500 PERFORM DE-LETE. CM2024.2 +044600 SEND-STATUS-WRITE-02. CM2024.2 +044700 MOVE "PARTIAL SEGMENT" TO FEATURE. CM2024.2 +044800 MOVE "ZERO CHARACTER COUNT USED" TO RE-MARK. CM2024.2 +044900 MOVE "SEND-STATUS-TEST-02" TO PAR-NAME. CM2024.2 +045000 PERFORM PRINT-DETAIL. CM2024.2 +045100 SEND-STATUS-TEST-03. CM2024.2 +045200 MOVE 0 TO END-FLAG. CM2024.2 +045300 MOVE 3 TO TEST-NUMB. CM2024.2 +045400 MOVE 61 TO OUT-LENGTH. CM2024.2 +045500 SEND CM-OUTQUE-1 WITH END-FLAG. CM2024.2 +045600 IF OUT-STATUS IS EQUAL TO "60" CM2024.2 +045700 PERFORM PASS GO TO SEND-STATUS-WRITE-03. CM2024.2 +045800 MOVE OUT-STATUS TO COMPUTED-STATUS. CM2024.2 +045900 MOVE "60" TO CORRECT-STATUS. CM2024.2 +046000 PERFORM FAIL. CM2024.2 +046100 GO TO SEND-STATUS-WRITE-03. CM2024.2 +046200 SEND-STATUS-DELETE-03. CM2024.2 +046300 PERFORM DE-LETE. CM2024.2 +046400 SEND-STATUS-WRITE-03. CM2024.2 +046500 MOVE "NO SENDING AREA SPECIFIED" TO RE-MARK. CM2024.2 +046600 MOVE "SEND-STATUS-TEST-03" TO PAR-NAME. CM2024.2 +046700 PERFORM PRINT-DETAIL. CM2024.2 +046800 SEND-STATUS-TEST-04. CM2024.2 +046900 MOVE 57 TO OUT-LENGTH. CM2024.2 +047000 MOVE "GARBAGE" TO SYM-DEST (2). CM2024.2 +047100 SEND CM-OUTQUE-1 FROM ONE-TERMINAL-MSG WITH EMI. CM2024.2 +047200 IF OUT-STATUS IS NOT EQUAL TO "20" CM2024.2 +047300 MOVE OUT-STATUS TO COMPUTED-STATUS CM2024.2 +047400 MOVE "STATUS SHOULD BE 20" TO CORRECT-A CM2024.2 +047500 PERFORM FAIL CM2024.2 +047600 ELSE IF ERR-KEY (2) IS NOT EQUAL TO "1" CM2024.2 +047700 MOVE ERR-KEY (2) TO COMPUTED-STATUS CM2024.2 +047800 MOVE " ERROR KEY (2) = 1" TO CORRECT-A CM2024.2 +047900 PERFORM FAIL CM2024.2 +048000 ELSE IF ERR-KEY (1) IS NOT EQUAL TO "0" CM2024.2 +048100 MOVE ERR-KEY (1) TO COMPUTED-STATUS CM2024.2 +048200 MOVE " ERROR KEY (1) = 0" TO CORRECT-A CM2024.2 +048300 PERFORM FAIL CM2024.2 +048400 ELSE PERFORM PASS. CM2024.2 +048500 GO TO SEND-STATUS-WRITE-04. CM2024.2 +048600 SEND-STATUS-DELETE-04. CM2024.2 +048700 PERFORM DE-LETE. CM2024.2 +048800 SEND-STATUS-WRITE-04. CM2024.2 +048900 MOVE "SYMBOLIC DESTINAT""N (2) IS BAD" TO RE-MARK. CM2024.2 +049000 MOVE "SEND-STATUS-TEST-04" TO PAR-NAME. CM2024.2 +049100 PERFORM PRINT-DETAIL. CM2024.2 +049200 MOVE CM2024.2 +049300 XXXXX035 CM2024.2 +049400 TO SYM-DEST (2). CM2024.2 +049500 SEGMENTED-MSG-TEST-01. CM2024.2 +049600 MOVE 1 TO SEG-TEST-NO. CM2024.2 +049700 MOVE 39 TO OUT-LENGTH. CM2024.2 +049800 SEND CM-OUTQUE-1 FROM SEG-INIT WITH ESI. CM2024.2 +049900 MOVE 14 TO OUT-LENGTH. CM2024.2 +050000 SEND CM-OUTQUE-1 FROM MSG-COMP WITH EMI. CM2024.2 +050100 SEGMENTED-MSG-TEST-02. CM2024.2 +050200 MOVE 2 TO SEG-TEST-NO. CM2024.2 +050300 MOVE 39 TO OUT-LENGTH. CM2024.2 +050400 SEND CM-OUTQUE-1 FROM SEG-INIT WITH ESI. CM2024.2 +050500 MOVE 16 TO OUT-LENGTH. CM2024.2 +050600 SEND CM-OUTQUE-1 FROM GROUP-COMP WITH EGI. CM2024.2 +050700 SEGMENTED-MSG-TEST-03. CM2024.2 +050800 MOVE 3 TO SEG-TEST-NO. CM2024.2 +050900 MOVE 39 TO OUT-LENGTH. CM2024.2 +051000 SEND CM-OUTQUE-1 FROM SEG-INIT. CM2024.2 +051100 MOVE 10 TO OUT-LENGTH. CM2024.2 +051200 SEND CM-OUTQUE-1 FROM SEG-CONT WITH ESI. CM2024.2 +051300 MOVE 14 TO OUT-LENGTH. CM2024.2 +051400 SEND CM-OUTQUE-1 FROM MSG-COMP WITH EMI. CM2024.2 +051500 SEGMENTED-MSG-TEST-04. CM2024.2 +051600 MOVE 4 TO SEG-TEST-NO. CM2024.2 +051700 MOVE 0 TO END-FLAG. CM2024.2 +051800 MOVE 39 TO OUT-LENGTH. CM2024.2 +051900 SEND CM-OUTQUE-1 FROM SEG-INIT WITH END-FLAG. CM2024.2 +052000 MOVE 1 TO END-FLAG. CM2024.2 +052100 MOVE 10 TO OUT-LENGTH. CM2024.2 +052200 SEND CM-OUTQUE-1 FROM SEG-CONT WITH END-FLAG. CM2024.2 +052300 MOVE 2 TO END-FLAG. CM2024.2 +052400 MOVE 14 TO OUT-LENGTH. CM2024.2 +052500 SEND CM-OUTQUE-1 FROM MSG-COMP WITH END-FLAG. CM2024.2 +052600 MOVE 3 TO END-FLAG. CM2024.2 +052700 MOVE 16 TO OUT-LENGTH. CM2024.2 +052800 SEND CM-OUTQUE-1 FROM GROUP-COMP WITH END-FLAG. CM2024.2 +052900 SEGMENTED-MSG-TEST-05. CM2024.2 +053000 MOVE 71 TO OUT-LENGTH. CM2024.2 +053100 MOVE 0 TO END-FLAG. CM2024.2 +053200 SEND CM-OUTQUE-1 FROM SKIP-MSG-1 WITH END-FLAG CM2024.2 +053300 BEFORE ADVANCING 4 LINES. CM2024.2 +053400 MOVE 17 TO OUT-LENGTH. CM2024.2 +053500 MOVE 3 TO END-FLAG. CM2024.2 +053600 SEND CM-OUTQUE-1 FROM SKIP-MSG-2 WITH END-FLAG. CM2024.2 +053700 SINGLE-TERMINAL-TEST-01. CM2024.2 +053800 MOVE 1 TO DEST-COUNT. CM2024.2 +053900 MOVE 57 TO OUT-LENGTH. CM2024.2 +054000 SEND CM-OUTQUE-1 FROM ONE-TERMINAL-MSG WITH EGI. CM2024.2 +054100 MOVE 2 TO DEST-COUNT. CM2024.2 +054200 INCOMPLETE-MSG-TEST-01. CM2024.2 +054300 MOVE 55 TO OUT-LENGTH. CM2024.2 +054400 MOVE 1 TO INC-MSG-NO. CM2024.2 +054500 SEND CM-OUTQUE-1 FROM INCOMP-MSG. CM2024.2 +054600 INCOMPLETE-MSG-TEST-02. CM2024.2 +054700 MOVE 55 TO OUT-LENGTH. CM2024.2 +054800 MOVE 2 TO INC-MSG-NO. CM2024.2 +054900 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH ESI. CM2024.2 +055000 INCOMPLETE-MSG-TEST-03. CM2024.2 +055100 MOVE 0 TO END-FLAG. CM2024.2 +055200 MOVE 55 TO OUT-LENGTH. CM2024.2 +055300 MOVE 3 TO INC-MSG-NO. CM2024.2 +055400 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH END-FLAG. CM2024.2 +055500 INCOMPLETE-MSG-TEST-04. CM2024.2 +055600 MOVE 1 TO END-FLAG. CM2024.2 +055700 MOVE 55 TO OUT-LENGTH. CM2024.2 +055800 MOVE 4 TO INC-MSG-NO. CM2024.2 +055900 SEND CM-OUTQUE-1 FROM INCOMP-MSG WITH END-FLAG. CM2024.2 +056000 STOP-WITHOUT-COMPLETING-MSG. CM2024.2 +056100 PERFORM END-ROUTINE THRU END-ROUTINE-4. CM2024.2 +056200 CLOSE PRINT-FILE. CM2024.2 +056300 STOP RUN. CM2024.2 +056400 DELAY-FOR-30 SECTION. CM2024.2 +056500 TAKE-INIT-TIME. CM2024.2 +056600 ACCEPT INIT-TIME FROM TIME. CM2024.2 +056700 TEST-ELAPSED-TIME. CM2024.2 +056800 ACCEPT TEST-TIME FROM TIME. CM2024.2 +056900 COMPUTE ELAPSED-TIME = CM2024.2 +057000 (T-HRS * 3600 + T-MINS * 60 + T-SECS) - CM2024.2 +057100 (I-HRS * 3600 + I-MINS * 60 + I-SECS). CM2024.2 +057200 IF ELAPSED-TIME IS LESS THAN 30 GO TO TEST-ELAPSED-TIME. CM2024.2 +057300 COMMON-SUBROUTINES SECTION. CM2024.2 +057400 PASS. CM2024.2 +057500 MOVE "PASS" TO P-OR-F. CM2024.2 +057600 FAIL. CM2024.2 +057700 ADD 1 TO ERROR-COUNTER. CM2024.2 +057800 MOVE "FAIL*" TO P-OR-F. CM2024.2 +057900 DE-LETE. CM2024.2 +058000 MOVE SPACE TO P-OR-F. CM2024.2 +058100 MOVE " ************ " TO COMPUTED-A. CM2024.2 +058200 MOVE " ************ " TO CORRECT-A. CM2024.2 +058300 MOVE "****TEST DELETED****" TO RE-MARK. CM2024.2 +058400 ADD 1 TO DELETE-CNT. CM2024.2 +058500 PRINT-DETAIL. CM2024.2 +058600 MOVE TEST-RESULTS TO PRINT-REC. CM2024.2 +058700 PERFORM WRITE-LINE. CM2024.2 +058800 MOVE SPACE TO P-OR-F. CM2024.2 +058900 MOVE SPACE TO COMPUTED-A. CM2024.2 +059000 MOVE SPACE TO CORRECT-A. CM2024.2 +059100 MOVE SPACE TO RE-MARK. CM2024.2 +059200 MOVE SPACE TO FEATURE. CM2024.2 +059300 COLUMN-NAMES-ROUTINE. CM2024.2 +059400 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. CM2024.2 +059500 PERFORM WRITE-LINE. CM2024.2 +059600 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. CM2024.2 +059700 PERFORM WRITE-LINE. CM2024.2 +059800 PERFORM BLANK-LINE-PRINT. CM2024.2 +059900 END-ROUTINE. CM2024.2 +060000 MOVE HYPHEN-LINE TO DUMMY-RECORD. CM2024.2 +060100 PERFORM WRITE-LINE. CM2024.2 +060200 PARA-Z. CM2024.2 +060300 PERFORM BLANK-LINE-PRINT 4 TIMES. CM2024.2 +060400 MOVE CCVS-E-1 TO DUMMY-RECORD. CM2024.2 +060500 PERFORM WRITE-LINE. CM2024.2 +060600 END-ROUTINE-1. CM2024.2 +060700 PERFORM BLANK-LINE-PRINT. CM2024.2 +060800 IF ERROR-COUNTER IS EQUAL TO ZERO CM2024.2 +060900 GO TO END-ROUTINE-2. CM2024.2 +061000 MOVE ERROR-COUNTER TO ERROR-TOTAL. CM2024.2 +061100 GO TO END-ROUTINE-3. CM2024.2 +061200 END-ROUTINE-2. CM2024.2 +061300 MOVE " NO" TO ERROR-TOTAL. CM2024.2 +061400 END-ROUTINE-3. CM2024.2 +061500 MOVE CCVS-E-2 TO DUMMY-RECORD. CM2024.2 +061600 PERFORM WRITE-LINE. CM2024.2 +061700 IF DELETE-CNT IS EQUAL TO ZERO CM2024.2 +061800 MOVE " NO" TO ERROR-TOTAL ELSE CM2024.2 +061900 MOVE DELETE-CNT TO ERROR-TOTAL. CM2024.2 +062000 MOVE "TESTS DELETED " TO ENDER-DESC. CM2024.2 +062100 MOVE CCVS-E-2 TO DUMMY-RECORD. CM2024.2 +062200 PERFORM WRITE-LINE. CM2024.2 +062300 END-ROUTINE-4. CM2024.2 +062400 MOVE CCVS-E-3 TO DUMMY-RECORD. CM2024.2 +062500 PERFORM WRITE-LINE. CM2024.2 +062600 BLANK-LINE-PRINT. CM2024.2 +062700 MOVE SPACE TO DUMMY-RECORD. CM2024.2 +062800 PERFORM WRITE-LINE. CM2024.2 +062900 WRITE-LINE. CM2024.2 +063000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINE. CM2024.2 +063100 HEAD-ROUTINE. CM2024.2 +063200 MOVE CCVS-H-1 TO PRINT-REC CM2024.2 +063300 WRITE PRINT-REC CM2024.2 +063400 AFTER ADVANCING PAGE. CM2024.2 +063500 MOVE CCVS-H-2 TO PRINT-REC. CM2024.2 +063600 WRITE PRINT-REC CM2024.2 +063700 AFTER 2 LINES. CM2024.2 +063800 MOVE CCVS-H-3 TO PRINT-REC. CM2024.2 +063900 WRITE PRINT-REC CM2024.2 +064000 AFTER 5 LINES. CM2024.2 +064100 MOVE HYPHEN-LINE TO PRINT-REC. CM2024.2 +064200 PERFORM WRITE-LINE. CM2024.2 +*END-OF,CM202M +*HEADER,COBOL,CM303M +000100 IDENTIFICATION DIVISION. CM3034.2 +000200 PROGRAM-ID. CM3034.2 +000300 CM303M. CM3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF CM3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN COMMUNICATIONS. CM3034.2 +000600 ENVIRONMENT DIVISION. CM3034.2 +000700 CONFIGURATION SECTION. CM3034.2 +000800 SOURCE-COMPUTER. CM3034.2 +000900 XXXXX082. CM3034.2 +001000 OBJECT-COMPUTER. CM3034.2 +001100 XXXXX083. CM3034.2 +001200 CM3034.2 +001300 CM3034.2 +001400 DATA DIVISION. CM3034.2 +001500 FILE SECTION. CM3034.2 +001600 COMMUNICATION SECTION. CM3034.2 +001700 CD COMMNAME FOR INITIAL INPUT. CM3034.2 +001800 01 CREC. CM3034.2 +001900 03 CNAME1 PIC X(87). CM3034.2 +002000 CM3034.2 +002100 PROCEDURE DIVISION. CM3034.2 +002200 CM3034.2 +002300 CM303M-CONTROL. CM3034.2 +002400 PERFORM CM303M-DISABLE THRU CM303M-ENABLE. CM3034.2 +002500 STOP RUN. CM3034.2 +002600 CM3034.2 +002700 CM303M-DISABLE. CM3034.2 +002800 DISABLE INPUT COMMNAME WITH KEY CNAME1. CM3034.2 +002900*Message expected for above statement: OBSOLETE CM3034.2 +003000 CM3034.2 +003100 CM303M-ENABLE. CM3034.2 +003200 ENABLE INPUT COMMNAME WITH KEY CNAME1. CM3034.2 +003300*Message expected for above statement: OBSOLETE CM3034.2 +003400 CM3034.2 +003500*TOTAL NUMBER OF FLAGS EXPECTED = 2. CM3034.2 +*END-OF,CM303M +*HEADER,COBOL,CM401M +000100 IDENTIFICATION DIVISION. CM4014.2 +000200 PROGRAM-ID. CM4014.2 +000300 CM401M. CM4014.2 +000400*The following program tests the flagging of level 2 CM4014.2 +000500*features of the communication module. CM4014.2 +000600 ENVIRONMENT DIVISION. CM4014.2 +000700 CONFIGURATION SECTION. CM4014.2 +000800 SOURCE-COMPUTER. CM4014.2 +000900 XXXXX082. CM4014.2 +001000 OBJECT-COMPUTER. CM4014.2 +001100 XXXXX083. CM4014.2 +001200 DATA DIVISION. CM4014.2 +001300 FILE SECTION. CM4014.2 +001400 COMMUNICATION SECTION. CM4014.2 +001500 CD COMMNAME FOR INITIAL INPUT CM4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +001700 SYMBOLIC SUB-QUEUE-1 IS CQ. CM4014.2 +001800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +001900 01 CREC. CM4014.2 +002000 03 CNAME1 PIC X(8). CM4014.2 +002100 03 CQ PIC 9(8). CM4014.2 +002200 03 FILLER PIC X(62). CM4014.2 +002300 03 CINT PIC 9. CM4014.2 +002400 03 FILLER PIC X(8). CM4014.2 +002500 CM4014.2 +002600 CD COMM2 FOR OUTPUT CM4014.2 +002700 DESTINATION TABLE OCCURS 7 TIMES. CM4014.2 +002800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +002900 CM4014.2 +003000 PROCEDURE DIVISION. CM4014.2 +003100 CM4014.2 +003200 CM401M-CONTROL. CM4014.2 +003300 PERFORM CM401M-DISABLE THRU CM401M-SENDREP. CM4014.2 +003400 STOP RUN. CM4014.2 +003500 CM4014.2 +003600 CM401M-DISABLE. CM4014.2 +003700 DISABLE INPUT COMMNAME WITH KEY CNAME1. CM4014.2 +003800*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +003900 CM4014.2 +004000 CM401M-ENABLE. CM4014.2 +004100 ENABLE INPUT COMMNAME WITH KEY CNAME1. CM4014.2 +004200*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +004300 CM4014.2 +004400 CM4014.2 +004500 CM401M-PURGE. CM4014.2 +004600 PURGE COMM2. CM4014.2 +004700*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +004800 CM4014.2 +004900 CM401M-SEND. CM4014.2 +005000 SEND COMM2 FROM CNAME1. CM4014.2 +005100*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +005200 CM4014.2 +005300 CM401M-SENDID. CM4014.2 +005400 SEND COMM2 FROM CNAME1 WITH CINT. CM4014.2 +005500*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +005600 CM4014.2 +005700 CM401M-SENDESI. CM4014.2 +005800 SEND COMM2 FROM CNAME1 WITH ESI. CM4014.2 +005900*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +006000 CM4014.2 +006100 CM401M-SENDREP. CM4014.2 +006200 SEND COMM2 WITH EMI REPLACING LINE. CM4014.2 +006300*Message expected for above statement: NON-CONFORMING STANDARD CM4014.2 +006400 CM4014.2 +006500*TOTAL NUMBER OF FLAGS EXPECTED = 10. CM4014.2 +*END-OF,CM401M +*HEADER,COBOL,DB101A +000100 IDENTIFICATION DIVISION. DB1014.2 +000200 PROGRAM-ID. DB1014.2 +000300 DB101A. DB1014.2 +000400 AUTHOR. DB1014.2 +000500 FEDERAL COMPILER TESTING CENTER. DB1014.2 +000600 INSTALLATION. DB1014.2 +000700 GENERAL SERVICES ADMINISTRATION DB1014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB1014.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB1014.2 +001100 FALLS CHURCH VIRGINIA 22041. DB1014.2 +001200 DB1014.2 +001300 PHONE (703) 756-6153 DB1014.2 +001400 DB1014.2 +001500 " HIGH ". DB1014.2 +001600 DATE-WRITTEN. DB1014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1014.2 +001800 CREATION DATE / VALIDATION DATE DB1014.2 +001900 "4.2 ". DB1014.2 +002000 SECURITY. DB1014.2 +002100 NONE. DB1014.2 +002200* DB1014.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB1014.2 +002400* DB1014.2 +002500* PROGRAM ABSTRACT DB1014.2 +002600* DB1014.2 +002700* DB101A TESTS THE BASIC OPERATION OF THE DEBUG MODULE WHEN DB1014.2 +002800* BOTH THE COMPILE AND OBJECT TIME DEBUGGING SWITCHES ARE DB1014.2 +002900* TURNED ON. THE PROGRAM CONTAINS BOTH DEBUG LINES AND SIMPLE DB1014.2 +003000* DEBUGGING PROCEDURES. THE DEBUGGING PROCEDURES ARE SPECI- DB1014.2 +003100* FIED FOR PROCEDURE-NAMES AND PROCEDURE-NAME SERIES. THE DB1014.2 +003200* FOLLOWING CONDITIONS ARE EVALUATED FOR THE "DEBUG-ITEM" DB1014.2 +003300* REGISTER DB1014.2 +003400* DB1014.2 +003500* (1) START OF PROGRAM DB1014.2 +003600* (2) REFERENCE BY "ALTER" DB1014.2 +003700* (3) REFERENCE BY "GO TO" DB1014.2 +003800* (4) REFERENCE BY "PERFORM" DB1014.2 +003900* (5) SEQUENTIAL PASSAGE OF CONTROL (FALL THROUGH) DB1014.2 +004000* DB1014.2 +004100* BEFORE BEGINNING EXECUTION OF THE OBJECT PROGRAM, DB1014.2 +004200* WHATEVER JOB CONTROL LANGUAGE IS NECESSARY TO ACTIVATE DB1014.2 +004300* (TURN ON) THE OBJECT TIME DEBUGGING SWITCH SHOULD BE DB1014.2 +004400* SUBMITTED. DB1014.2 +004500* DB1014.2 +004600* DB1014.2 +004700* DB1014.2 +004800* DB1014.2 +004900 ENVIRONMENT DIVISION. DB1014.2 +005000 CONFIGURATION SECTION. DB1014.2 +005100 SOURCE-COMPUTER. DB1014.2 +005200 XXXXX082 DB1014.2 +005300 WITH DEBUGGING MODE. DB1014.2 +005400 OBJECT-COMPUTER. DB1014.2 +005500 XXXXX083. DB1014.2 +005600 INPUT-OUTPUT SECTION. DB1014.2 +005700 FILE-CONTROL. DB1014.2 +005800 SELECT PRINT-FILE ASSIGN TO DB1014.2 +005900 XXXXX055. DB1014.2 +006000 DATA DIVISION. DB1014.2 +006100 FILE SECTION. DB1014.2 +006200 FD PRINT-FILE DB1014.2 +006300 LABEL RECORDS DB1014.2 +006400 XXXXX084 DB1014.2 +006500 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1014.2 +006600 01 PRINT-REC PICTURE X(120). DB1014.2 +006700 01 DUMMY-RECORD PICTURE X(120). DB1014.2 +006800 WORKING-STORAGE SECTION. DB1014.2 +006900 77 A PIC 9 COMP VALUE 1. DB1014.2 +007000 77 B PIC 9 COMP VALUE 5. DB1014.2 +007100 77 C PIC 9 COMP VALUE 9. DB1014.2 +007200 77 D PIC 99 COMP. DB1014.2 +007300 77 RESULT-FLAG PIC 99 VALUE 0. DB1014.2 +007400 77 DBLINE-HOLD PIC X(6). DB1014.2 +007500 77 DBNAME-HOLD PIC X(30). DB1014.2 +007600 77 DBCONT-HOLD PIC X(30). DB1014.2 +007700 77 FIVE PIC 9 COMP VALUE 5. DB1014.2 +007800 01 SIZE-19. DB1014.2 +007900 02 FILLER PIC X. DB1014.2 +008000 02 SIZE-18. DB1014.2 +008100 03 FILLER PIC X. DB1014.2 +008200 03 SIZE-17. DB1014.2 +008300 04 FILLER PIC X. DB1014.2 +008400 04 SIZE-16. DB1014.2 +008500 05 FILLER PIC X. DB1014.2 +008600 05 SIZE-15. DB1014.2 +008700 06 FILLER PIC X. DB1014.2 +008800 06 SIZE-14. DB1014.2 +008900 07 FILLER PIC X. DB1014.2 +009000 07 SIZE-13. DB1014.2 +009100 08 FILLER PIC X. DB1014.2 +009200 08 SIZE-12. DB1014.2 +009300 09 FILLER PIC XX. DB1014.2 +009400 09 SIZE-10. DB1014.2 +009500 10 FILLER PICTURE X(5). DB1014.2 +009600 10 SIZE-5 PICTURE X(5). DB1014.2 +009700 01 TEST-RESULTS. DB1014.2 +009800 02 FILLER PICTURE X VALUE SPACE. DB1014.2 +009900 02 FEATURE PICTURE X(20) VALUE SPACE. DB1014.2 +010000 02 FILLER PICTURE X VALUE SPACE. DB1014.2 +010100 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1014.2 +010200 02 FILLER PICTURE X VALUE SPACE. DB1014.2 +010300 02 PAR-NAME. DB1014.2 +010400 03 FILLER PICTURE X(12) VALUE SPACE. DB1014.2 +010500 03 PARDOT-X PICTURE X VALUE SPACE. DB1014.2 +010600 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1014.2 +010700 03 FILLER PIC X(5) VALUE SPACE. DB1014.2 +010800 02 FILLER PIC X(10) VALUE SPACE. DB1014.2 +010900 02 RE-MARK PIC X(61). DB1014.2 +011000 01 TEST-COMPUTED. DB1014.2 +011100 02 FILLER PIC X(30) VALUE SPACE. DB1014.2 +011200 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1014.2 +011300 02 COMPUTED-X. DB1014.2 +011400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1014.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1014.2 +011600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1014.2 +011700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1014.2 +011800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1014.2 +011900 03 CM-18V0 REDEFINES COMPUTED-A. DB1014.2 +012000 04 COMPUTED-18V0 PICTURE -9(18). DB1014.2 +012100 04 FILLER PICTURE X. DB1014.2 +012200 03 FILLER PIC X(50) VALUE SPACE. DB1014.2 +012300 01 TEST-CORRECT. DB1014.2 +012400 02 FILLER PIC X(30) VALUE SPACE. DB1014.2 +012500 02 FILLER PIC X(17) VALUE " CORRECT =". DB1014.2 +012600 02 CORRECT-X. DB1014.2 +012700 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1014.2 +012800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1014.2 +012900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1014.2 +013000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1014.2 +013100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1014.2 +013200 03 CR-18V0 REDEFINES CORRECT-A. DB1014.2 +013300 04 CORRECT-18V0 PICTURE -9(18). DB1014.2 +013400 04 FILLER PICTURE X. DB1014.2 +013500 03 FILLER PIC X(50) VALUE SPACE. DB1014.2 +013600 01 CCVS-C-1. DB1014.2 +013700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1014.2 +013800- "SS PARAGRAPH-NAME DB1014.2 +013900- " REMARKS". DB1014.2 +014000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1014.2 +014100 01 CCVS-C-2. DB1014.2 +014200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 +014300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1014.2 +014400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1014.2 +014500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1014.2 +014600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1014.2 +014700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1014.2 +014800 01 REC-CT PICTURE 99 VALUE ZERO. DB1014.2 +014900 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1014.2 +015000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1014.2 +015100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1014.2 +015200 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1014.2 +015300 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1014.2 +015400 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1014.2 +015500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1014.2 +015600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1014.2 +015700 01 CCVS-H-1. DB1014.2 +015800 02 FILLER PICTURE X(27) VALUE SPACE. DB1014.2 +015900 02 FILLER PICTURE X(67) VALUE DB1014.2 +016000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1014.2 +016100- " SYSTEM". DB1014.2 +016200 02 FILLER PICTURE X(26) VALUE SPACE. DB1014.2 +016300 01 CCVS-H-2. DB1014.2 +016400 02 FILLER PICTURE X(52) VALUE IS DB1014.2 +016500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1014.2 +016600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1014.2 +016700 02 TEST-ID PICTURE IS X(9). DB1014.2 +016800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1014.2 +016900 01 CCVS-H-3. DB1014.2 +017000 02 FILLER PICTURE X(34) VALUE DB1014.2 +017100 " FOR OFFICIAL USE ONLY ". DB1014.2 +017200 02 FILLER PICTURE X(58) VALUE DB1014.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1014.2 +017400 02 FILLER PICTURE X(28) VALUE DB1014.2 +017500 " COPYRIGHT 1974 ". DB1014.2 +017600 01 CCVS-E-1. DB1014.2 +017700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1014.2 +017800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1014.2 +017900 02 ID-AGAIN PICTURE IS X(9). DB1014.2 +018000 02 FILLER PICTURE X(45) VALUE IS DB1014.2 +018100 " NTIS DISTRIBUTION COBOL 74". DB1014.2 +018200 01 CCVS-E-2. DB1014.2 +018300 02 FILLER PICTURE X(31) VALUE DB1014.2 +018400 SPACE. DB1014.2 +018500 02 FILLER PICTURE X(21) VALUE SPACE. DB1014.2 +018600 02 CCVS-E-2-2. DB1014.2 +018700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1014.2 +018800 03 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 +018900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1014.2 +019000 01 CCVS-E-3. DB1014.2 +019100 02 FILLER PICTURE X(22) VALUE DB1014.2 +019200 " FOR OFFICIAL USE ONLY". DB1014.2 +019300 02 FILLER PICTURE X(12) VALUE SPACE. DB1014.2 +019400 02 FILLER PICTURE X(58) VALUE DB1014.2 +019500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1014.2 +019600 02 FILLER PICTURE X(13) VALUE SPACE. DB1014.2 +019700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1014.2 +019800 01 CCVS-E-4. DB1014.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1014.2 +020000 02 FILLER PIC XXXX VALUE " OF ". DB1014.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1014.2 +020200 02 FILLER PIC X(40) VALUE DB1014.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". DB1014.2 +020400 01 XXINFO. DB1014.2 +020500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1014.2 +020600 02 INFO-TEXT. DB1014.2 +020700 04 FILLER PIC X(20) VALUE SPACE. DB1014.2 +020800 04 XXCOMPUTED PIC X(20). DB1014.2 +020900 04 FILLER PIC X(5) VALUE SPACE. DB1014.2 +021000 04 XXCORRECT PIC X(20). DB1014.2 +021100 01 HYPHEN-LINE. DB1014.2 +021200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1014.2 +021300 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1014.2 +021400- "*****************************************". DB1014.2 +021500 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1014.2 +021600- "******************************". DB1014.2 +021700 01 CCVS-PGM-ID PIC X(6) VALUE DB1014.2 +021800 "DB101A". DB1014.2 +021900 PROCEDURE DIVISION. DB1014.2 +022000 DECLARATIVES. DB1014.2 +022100 START-UP SECTION. DB1014.2 +022200 USE FOR DEBUGGING ON CCVS1. DB1014.2 +022300 BEGIN-START-UP. DB1014.2 +022400 MOVE 1 TO RESULT-FLAG. DB1014.2 +022500 DB-COMMON. DB1014.2 +022600 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1014.2 +022700 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1014.2 +022800 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1014.2 +022900 FALL-THROUGH-AND-SERIES SECTION. DB1014.2 +023000 USE FOR DEBUGGING ON FALL-THROUGH-TEST DB1014.2 +023100 PROC-SERIES-TEST. DB1014.2 +023200 BEGIN-FALL-THROUGH-AND-SERIES. DB1014.2 +023300 PERFORM DB-COMMON. DB1014.2 +023400 MOVE 2 TO RESULT-FLAG. DB1014.2 +023500 GO-TO SECTION. DB1014.2 +023600 USE FOR DEBUGGING ON GO-TO-TEST. DB1014.2 +023700 BEGIN-GO-TO. DB1014.2 +023800 PERFORM DB-COMMON. DB1014.2 +023900 MOVE 3 TO RESULT-FLAG. DB1014.2 +024000 ALTER-PARAGRAPH SECTION. DB1014.2 +024100 USE FOR DEBUGGING ON ALTERABLE-PARAGRAPH. DB1014.2 +024200 BEGIN-ALTER-PARAGRAPH. DB1014.2 +024300 PERFORM DB-COMMON. DB1014.2 +024400 MOVE 4 TO RESULT-FLAG. DB1014.2 +024500 LOOP-ITERATION SECTION. DB1014.2 +024600 USE FOR DEBUGGING ON LOOP-ROUTINE. DB1014.2 +024700 BEGIN-LOOP-ITERATION. DB1014.2 +024800 PERFORM DB-COMMON. DB1014.2 +024900 ADD 1 TO RESULT-FLAG. DB1014.2 +025000 PERFORM-THRU SECTION. DB1014.2 +025100 USE FOR DEBUGGING ON DO-NOTHING-1. DB1014.2 +025200 BEGIN-PERFORM-THRU. DB1014.2 +025300 PERFORM DB-COMMON. DB1014.2 +025400 ADD 1 TO RESULT-FLAG. DB1014.2 +025500 END DECLARATIVES. DB1014.2 +025600******************************************************************DB1014.2 +025700* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +025800* OUTPUT REPORT AS "START-PROGRAM-TEST" SHOULD POINT TO THE *DB1014.2 +025900* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +026000* WHICH READS, "OPEN OUTPUT PRINT-FILE." *DB1014.2 +026100******************************************************************DB1014.2 +026200 CCVS1 SECTION. DB1014.2 +026300 OPEN-FILES. DB1014.2 +026400 OPEN OUTPUT PRINT-FILE. DB1014.2 +026500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1014.2 +026600 MOVE SPACE TO TEST-RESULTS. DB1014.2 +026700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1014.2 +026800 GO TO CCVS1-EXIT. DB1014.2 +026900 CLOSE-FILES. DB1014.2 +027000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1014.2 +027100 TERMINATE-CCVS. DB1014.2 +027200S EXIT PROGRAM. DB1014.2 +027300STERMINATE-CALL. DB1014.2 +027400 STOP RUN. DB1014.2 +027500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1014.2 +027600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1014.2 +027700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1014.2 +027800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1014.2 +027900 MOVE "****TEST DELETED****" TO RE-MARK. DB1014.2 +028000 PRINT-DETAIL. DB1014.2 +028100 IF REC-CT NOT EQUAL TO ZERO DB1014.2 +028200 MOVE "." TO PARDOT-X DB1014.2 +028300 MOVE REC-CT TO DOTVALUE. DB1014.2 +028400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1014.2 +028500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1014.2 +028600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1014.2 +028700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1014.2 +028800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1014.2 +028900 MOVE SPACE TO CORRECT-X. DB1014.2 +029000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1014.2 +029100 MOVE SPACE TO RE-MARK. DB1014.2 +029200 HEAD-ROUTINE. DB1014.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 +029400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1014.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1014.2 +029600 COLUMN-NAMES-ROUTINE. DB1014.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 +030000 END-ROUTINE. DB1014.2 +030100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1014.2 +030200 END-RTN-EXIT. DB1014.2 +030300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 +030400 END-ROUTINE-1. DB1014.2 +030500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1014.2 +030600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1014.2 +030700 ADD PASS-COUNTER TO ERROR-HOLD. DB1014.2 +030800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1014.2 +030900 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1014.2 +031000 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1014.2 +031100 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1014.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1014.2 +031300 END-ROUTINE-12. DB1014.2 +031400 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1014.2 +031500 IF ERROR-COUNTER IS EQUAL TO ZERO DB1014.2 +031600 MOVE "NO " TO ERROR-TOTAL DB1014.2 +031700 ELSE DB1014.2 +031800 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1014.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1014.2 +032000 PERFORM WRITE-LINE. DB1014.2 +032100 END-ROUTINE-13. DB1014.2 +032200 IF DELETE-CNT IS EQUAL TO ZERO DB1014.2 +032300 MOVE "NO " TO ERROR-TOTAL ELSE DB1014.2 +032400 MOVE DELETE-CNT TO ERROR-TOTAL. DB1014.2 +032500 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1014.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 +032700 IF INSPECT-COUNTER EQUAL TO ZERO DB1014.2 +032800 MOVE "NO " TO ERROR-TOTAL DB1014.2 +032900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1014.2 +033000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1014.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 +033200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1014.2 +033300 WRITE-LINE. DB1014.2 +033400 ADD 1 TO RECORD-COUNT. DB1014.2 +033500Y IF RECORD-COUNT GREATER 50 DB1014.2 +033600Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1014.2 +033700Y MOVE SPACE TO DUMMY-RECORD DB1014.2 +033800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1014.2 +033900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1014.2 +034000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1014.2 +034100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1014.2 +034200Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1014.2 +034300Y MOVE ZERO TO RECORD-COUNT. DB1014.2 +034400 PERFORM WRT-LN. DB1014.2 +034500 WRT-LN. DB1014.2 +034600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1014.2 +034700 MOVE SPACE TO DUMMY-RECORD. DB1014.2 +034800 BLANK-LINE-PRINT. DB1014.2 +034900 PERFORM WRT-LN. DB1014.2 +035000 FAIL-ROUTINE. DB1014.2 +035100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1014.2 +035200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1014.2 +035300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1014.2 +035400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 +035500 GO TO FAIL-ROUTINE-EX. DB1014.2 +035600 FAIL-ROUTINE-WRITE. DB1014.2 +035700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1014.2 +035800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1014.2 +035900 FAIL-ROUTINE-EX. EXIT. DB1014.2 +036000 BAIL-OUT. DB1014.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1014.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1014.2 +036300 BAIL-OUT-WRITE. DB1014.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1014.2 +036500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1014.2 +036600 BAIL-OUT-EX. EXIT. DB1014.2 +036700 CCVS1-EXIT. DB1014.2 +036800 EXIT. DB1014.2 +036900 START-PROGRAM-TEST. DB1014.2 +037000 IF RESULT-FLAG IS NOT EQUAL TO 1 DB1014.2 +037100 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +037200 PERFORM FAIL DB1014.2 +037300 GO TO START-PROGRAM-WRITE. DB1014.2 +037400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +037500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +037600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +037700 PERFORM INSPT. DB1014.2 +037800 PERFORM START-PROGRAM-WRITE. DB1014.2 +037900 MOVE DBNAME-HOLD TO SIZE-5. DB1014.2 +038000 IF SIZE-5 IS EQUAL TO "CCVS1" DB1014.2 +038100 PERFORM PASS ELSE DB1014.2 +038200 MOVE "CCVS1" TO CORRECT-A DB1014.2 +038300 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +038400 PERFORM FAIL. DB1014.2 +038500 START-PROGRAM-TEST-1. DB1014.2 +038600 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +038700 PERFORM START-PROGRAM-WRITE. DB1014.2 +038800 MOVE DBCONT-HOLD TO SIZE-13. DB1014.2 +038900 IF SIZE-13 IS EQUAL TO "START PROGRAM" DB1014.2 +039000 PERFORM PASS ELSE DB1014.2 +039100 MOVE "START PROGRAM" TO CORRECT-A DB1014.2 +039200 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +039300 PERFORM FAIL. DB1014.2 +039400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +039500 GO TO START-PROGRAM-WRITE. DB1014.2 +039600 START-PROGRAM-DELETE. DB1014.2 +039700 PERFORM DE-LETE. DB1014.2 +039800 START-PROGRAM-WRITE. DB1014.2 +039900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +040000 MOVE "START-PROGRAM-TEST" TO PAR-NAME. DB1014.2 +040100 PERFORM PRINT-DETAIL. DB1014.2 +040200******************************************************************DB1014.2 +040300* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +040400* OUTPUT REPORT AS "FALL-THROUGH-TEST" SHOULD POINT TO THE *DB1014.2 +040500* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +040600* WHICH READS, "MOVE 0 TO RESULT-FLAG." *DB1014.2 +040700******************************************************************DB1014.2 +040800 MOVE 0 TO RESULT-FLAG. DB1014.2 +040900 FALL-THROUGH-TEST. DB1014.2 +041000 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1014.2 +041100 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +041200 PERFORM FAIL DB1014.2 +041300 GO TO FALL-THROUGH-WRITE. DB1014.2 +041400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +041500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +041600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +041700 PERFORM INSPT. DB1014.2 +041800 PERFORM FALL-THROUGH-WRITE. DB1014.2 +041900 MOVE DBNAME-HOLD TO SIZE-17. DB1014.2 +042000 IF SIZE-17 IS EQUAL TO "FALL-THROUGH-TEST" DB1014.2 +042100 PERFORM PASS ELSE DB1014.2 +042200 MOVE "FALL-THROUGH-TEST" TO CORRECT-A DB1014.2 +042300 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +042400 PERFORM FAIL. DB1014.2 +042500 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +042600 PERFORM FALL-THROUGH-WRITE. DB1014.2 +042700 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 +042800 IF SIZE-12 IS EQUAL TO "FALL THROUGH" DB1014.2 +042900 PERFORM PASS ELSE DB1014.2 +043000 MOVE "FALL THROUGH" TO CORRECT-A DB1014.2 +043100 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +043200 PERFORM FAIL. DB1014.2 +043300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +043400 GO TO FALL-THROUGH-WRITE. DB1014.2 +043500 FALL-THROUGH-DELETE. DB1014.2 +043600 PERFORM DE-LETE. DB1014.2 +043700 FALL-THROUGH-WRITE. DB1014.2 +043800 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +043900 MOVE "FALL-THROUGH-TEST" TO PAR-NAME. DB1014.2 +044000 PERFORM PRINT-DETAIL. DB1014.2 +044100******************************************************************DB1014.2 +044200* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +044300* OUTPUT REPORT AS "PROC-SERIES-TEST" SHOULD POINT TO THE *DB1014.2 +044400* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +044500* WHICH READS, "MOVE 0 TO RESULT-FLAG." *DB1014.2 +044600******************************************************************DB1014.2 +044700 MOVE 0 TO RESULT-FLAG. DB1014.2 +044800 PROC-SERIES-TEST. DB1014.2 +044900 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1014.2 +045000 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +045100 PERFORM FAIL DB1014.2 +045200 GO TO PROC-SERIES-WRITE. DB1014.2 +045300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +045400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +045500 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +045600 PERFORM INSPT. DB1014.2 +045700 PERFORM PROC-SERIES-WRITE. DB1014.2 +045800 MOVE DBNAME-HOLD TO SIZE-16. DB1014.2 +045900 IF SIZE-16 IS EQUAL TO "PROC-SERIES-TEST" DB1014.2 +046000 PERFORM PASS ELSE DB1014.2 +046100 MOVE "PROC-SERIES-TEST" TO CORRECT-A DB1014.2 +046200 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +046300 PERFORM FAIL. DB1014.2 +046400 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +046500 PERFORM PROC-SERIES-WRITE. DB1014.2 +046600 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 +046700 IF SIZE-12 IS EQUAL TO "FALL THROUGH" DB1014.2 +046800 PERFORM PASS ELSE DB1014.2 +046900 MOVE "FALL THROUGH" TO CORRECT-A DB1014.2 +047000 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +047100 PERFORM FAIL. DB1014.2 +047200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +047300 GO TO PROC-SERIES-WRITE. DB1014.2 +047400 PROC-SERIES-DELETE. DB1014.2 +047500 PERFORM DE-LETE. DB1014.2 +047600 PROC-SERIES-WRITE. DB1014.2 +047700 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +047800 MOVE "PROC-SERIES-TEST" TO PAR-NAME. DB1014.2 +047900 PERFORM PRINT-DETAIL. DB1014.2 +048000 MOVE 0 TO RESULT-FLAG. DB1014.2 +048100******************************************************************DB1014.2 +048200* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +048300* OUTPUT REPORT AS "GO-TO-TEST" SHOULD POINT TO THE *DB1014.2 +048400* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +048500* WHICH READS, "GO TO GO-TO-TEST.". *DB1014.2 +048600******************************************************************DB1014.2 +048700 ALTERABLE-PARAGRAPH. DB1014.2 +048800 GO TO GO-TO-TEST. DB1014.2 +048900 FILLER-PARAGRAPH. DB1014.2 +049000 DISPLAY "ALTER FAILED AT ALTER-TEST-INIT". DB1014.2 +049100 PERFORM FAIL. DB1014.2 +049200 GO TO ALTERED-GO-TO-TEST. DB1014.2 +049300 GO-TO-TEST. DB1014.2 +049400 IF RESULT-FLAG IS NOT EQUAL TO 3 DB1014.2 +049500 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +049600 PERFORM FAIL DB1014.2 +049700 GO TO GO-TO-WRITE. DB1014.2 +049800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +049900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +050000 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +050100 PERFORM INSPT. DB1014.2 +050200 PERFORM GO-TO-WRITE. DB1014.2 +050300 MOVE DBNAME-HOLD TO SIZE-10. DB1014.2 +050400 IF SIZE-10 IS EQUAL TO "GO-TO-TEST" DB1014.2 +050500 PERFORM PASS ELSE DB1014.2 +050600 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +050700 MOVE "GO-TO-TEST" TO CORRECT-A DB1014.2 +050800 PERFORM FAIL. DB1014.2 +050900 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +051000 PERFORM GO-TO-WRITE. DB1014.2 +051100 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 +051200 IF SIZE-12 IS EQUAL TO SPACE DB1014.2 +051300 PERFORM PASS DB1014.2 +051400 ELSE DB1014.2 +051500 PERFORM FAIL DB1014.2 +051600 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +051700 MOVE "SPACES" TO CORRECT-A. DB1014.2 +051800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +051900 GO TO GO-TO-WRITE. DB1014.2 +052000 GO-TO-DELETE. DB1014.2 +052100 PERFORM DE-LETE. DB1014.2 +052200 GO-TO-WRITE. DB1014.2 +052300 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +052400 MOVE "GO-TO-TEST" TO PAR-NAME. DB1014.2 +052500 PERFORM PRINT-DETAIL. DB1014.2 +052600 MOVE 0 TO RESULT-FLAG. DB1014.2 +052700******************************************************************DB1014.2 +052800* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +052900* OUTPUT REPORT AS "ALTER-TEST" SHOULD POINT TO THE *DB1014.2 +053000* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +053100* WHICH READS, "ALTER ALTERABLE-PARAGRAPH TO PROCEED TO *DB1014.2 +053200* ALTERED-GO-TO-TEST.". *DB1014.2 +053300******************************************************************DB1014.2 +053400 ALTER-TEST-INIT. DB1014.2 +053500 ALTER ALTERABLE-PARAGRAPH TO PROCEED TO ALTERED-GO-TO-TEST. DB1014.2 +053600 ALTER-TEST. DB1014.2 +053700 IF RESULT-FLAG IS NOT EQUAL TO 4 DB1014.2 +053800 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +053900 PERFORM FAIL DB1014.2 +054000 GO TO ALTER-WRITE. DB1014.2 +054100 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +054200 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +054300 MOVE DBLINE-HOLD TO COMPUTED-A DB1014.2 +054400 PERFORM INSPT. DB1014.2 +054500 PERFORM ALTER-WRITE. DB1014.2 +054600 MOVE DBNAME-HOLD TO SIZE-19. DB1014.2 +054700 IF SIZE-19 IS EQUAL TO "ALTERABLE-PARAGRAPH" DB1014.2 +054800 PERFORM PASS ELSE DB1014.2 +054900 MOVE "ALTERABLE-PARAGRAPH" TO CORRECT-A DB1014.2 +055000 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +055100 PERFORM FAIL. DB1014.2 +055200 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +055300 PERFORM ALTER-WRITE. DB1014.2 +055400 MOVE DBCONT-HOLD TO SIZE-18. DB1014.2 +055500 IF SIZE-18 IS EQUAL TO "ALTERED-GO-TO-TEST" DB1014.2 +055600 PERFORM PASS ELSE DB1014.2 +055700 MOVE "ALTERED-GO-TO-TEST" TO CORRECT-A DB1014.2 +055800 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +055900 PERFORM FAIL. DB1014.2 +056000 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +056100 GO TO ALTER-WRITE. DB1014.2 +056200 ALTER-DELETE. DB1014.2 +056300 PERFORM DE-LETE. DB1014.2 +056400 ALTER-WRITE. DB1014.2 +056500 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +056600 MOVE "ALTER-TEST" TO PAR-NAME. DB1014.2 +056700 PERFORM PRINT-DETAIL. DB1014.2 +056800 MOVE 0 TO RESULT-FLAG. DB1014.2 +056900******************************************************************DB1014.2 +057000* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +057100* OUTPUT REPORT AS "ALTERED-GO-TO-TEST" SHOULD POINT TO THE *DB1014.2 +057200* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +057300* WHICH READS, "GO TO ALTERABLE-PARAGRAPH.". *DB1014.2 +057400******************************************************************DB1014.2 +057500 ALTER-WRITE-END. DB1014.2 +057600 GO TO ALTERABLE-PARAGRAPH. DB1014.2 +057700 ALTERED-GO-TO-TEST. DB1014.2 +057800 IF RESULT-FLAG IS NOT EQUAL TO 4 DB1014.2 +057900 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +058000 PERFORM FAIL DB1014.2 +058100 GO TO ALTERED-GO-TO-WRITE. DB1014.2 +058200 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +058300 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +058400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +058500 PERFORM INSPT. DB1014.2 +058600 PERFORM ALTERED-GO-TO-WRITE. DB1014.2 +058700 MOVE DBNAME-HOLD TO SIZE-19. DB1014.2 +058800 IF SIZE-19 IS EQUAL TO "ALTERABLE-PARAGRAPH" DB1014.2 +058900 PERFORM PASS ELSE DB1014.2 +059000 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +059100 MOVE "ALTERABLE-PARAGRAPH" TO CORRECT-A DB1014.2 +059200 PERFORM FAIL. DB1014.2 +059300 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +059400 PERFORM ALTERED-GO-TO-WRITE. DB1014.2 +059500 IF DBCONT-HOLD EQUAL TO SPACE DB1014.2 +059600 PERFORM PASS DB1014.2 +059700 ELSE DB1014.2 +059800 PERFORM FAIL DB1014.2 +059900 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +060000 MOVE "SPACES" TO CORRECT-A. DB1014.2 +060100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +060200 GO TO ALTERED-GO-TO-WRITE. DB1014.2 +060300 ALTERED-GO-TO-DELETE. DB1014.2 +060400 PERFORM DE-LETE. DB1014.2 +060500 ALTERED-GO-TO-WRITE. DB1014.2 +060600 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +060700 MOVE "ALTERED-GO-TO-TEST" TO PAR-NAME. DB1014.2 +060800 PERFORM PRINT-DETAIL. DB1014.2 +060900 MOVE 0 TO RESULT-FLAG. DB1014.2 +061000******************************************************************DB1014.2 +061100* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +061200* OUTPUT REPORT AS "PERF-ITERATION-TEST" SHOULD POINT TO THE *DB1014.2 +061300* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +061400* WHICH READS, "PERFORM LOOP-ROUTINE FIVE TIMES.". *DB1014.2 +061500******************************************************************DB1014.2 +061600 PERF-ITERATION-TEST. DB1014.2 +061700 PERFORM LOOP-ROUTINE FIVE TIMES. DB1014.2 +061800 IF RESULT-FLAG IS NOT EQUAL TO 5 DB1014.2 +061900 MOVE "05" TO CORRECT-A DB1014.2 +062000 MOVE RESULT-FLAG TO COMPUTED-A DB1014.2 +062100 MOVE "NO. OF TIMES USE PROC EXECUTED" TO RE-MARK DB1014.2 +062200 PERFORM FAIL DB1014.2 +062300 ELSE DB1014.2 +062400 MOVE "PROC EXECUTED FIVE TIMES" TO RE-MARK DB1014.2 +062500 PERFORM PASS. DB1014.2 +062600 IF RESULT-FLAG IS EQUAL TO 0 DB1014.2 +062700 GO TO PERF-ITERATION-WRITE DB1014.2 +062800 ELSE PERFORM PERF-ITERATION-WRITE. DB1014.2 +062900 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +063000 PERFORM INSPT. DB1014.2 +063100 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +063200 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +063300 PERFORM PERF-ITERATION-WRITE. DB1014.2 +063400 MOVE DBNAME-HOLD TO SIZE-12. DB1014.2 +063500 IF SIZE-12 IS EQUAL TO "LOOP-ROUTINE" DB1014.2 +063600 PERFORM PASS ELSE DB1014.2 +063700 MOVE "LOOP-ROUTINE" TO CORRECT-A DB1014.2 +063800 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +063900 PERFORM FAIL. DB1014.2 +064000 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +064100 PERFORM PERF-ITERATION-WRITE. DB1014.2 +064200 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 +064300 IF SIZE-12 IS EQUAL TO "PERFORM LOOP" DB1014.2 +064400 PERFORM PASS ELSE DB1014.2 +064500 MOVE "PERFORM LOOP" TO CORRECT-A DB1014.2 +064600 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +064700 PERFORM FAIL. DB1014.2 +064800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +064900 GO TO PERF-ITERATION-WRITE. DB1014.2 +065000 PERF-ITERATION-DELETE. DB1014.2 +065100 PERFORM DE-LETE. DB1014.2 +065200 PERF-ITERATION-WRITE. DB1014.2 +065300 MOVE "PERF-ITERATION-TEST" TO PAR-NAME. DB1014.2 +065400 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +065500 PERFORM PRINT-DETAIL. DB1014.2 +065600 MOVE 0 TO RESULT-FLAG. DB1014.2 +065700 PERF-ITERATION-END. DB1014.2 +065800 GO TO PERFORM-THRU-TEST. DB1014.2 +065900 LOOP-ROUTINE. DB1014.2 +066000**NESTED PERFORMS ARE USED HERE TO ATTEMPT TO PREVENT OPTIMIZER DB1014.2 +066100* ACTION RESULTING IN LOOP UNFOLDING AND REDUCTION. DB1014.2 +066200 PERFORM DO-NOTHING. DB1014.2 +066300******************************************************************DB1014.2 +066400* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +066500* OUTPUT REPORT AS "PERFORM-THRU-TEST" SHOULD POINT TO THE *DB1014.2 +066600* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +066700* WHICH READS, "ADD A B C GIVING D.". *DB1014.2 +066800******************************************************************DB1014.2 +066900 DO-NOTHING. DB1014.2 +067000 ADD A B C GIVING D. DB1014.2 +067100 DO-NOTHING-1. DB1014.2 +067200 SUBTRACT A FROM B. DB1014.2 +067300 PERFORM-THRU-TEST. DB1014.2 +067400 PERFORM DO-NOTHING THRU DO-NOTHING-1 FIVE TIMES. DB1014.2 +067500 IF RESULT-FLAG IS NOT EQUAL TO 5 DB1014.2 +067600 MOVE "05" TO CORRECT-A DB1014.2 +067700 MOVE RESULT-FLAG TO COMPUTED-A DB1014.2 +067800 MOVE "NO. OF TIMES USE PROC EXECUTED" TO RE-MARK DB1014.2 +067900 PERFORM FAIL DB1014.2 +068000 ELSE DB1014.2 +068100 MOVE "PROC EXECUTED FIVE TIMES" TO RE-MARK DB1014.2 +068200 PERFORM PASS. DB1014.2 +068300 IF RESULT-FLAG IS EQUAL TO 0 DB1014.2 +068400 GO TO PERFORM-THRU-WRITE ELSE DB1014.2 +068500 PERFORM PERFORM-THRU-WRITE. DB1014.2 +068600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +068700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +068800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +068900 PERFORM INSPT. DB1014.2 +069000 PERFORM PERFORM-THRU-WRITE. DB1014.2 +069100 MOVE DBNAME-HOLD TO SIZE-12. DB1014.2 +069200 IF SIZE-12 IS EQUAL TO "DO-NOTHING-1" DB1014.2 +069300 PERFORM PASS ELSE DB1014.2 +069400 MOVE "DO-NOTHING-1" TO CORRECT-A DB1014.2 +069500 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +069600 PERFORM FAIL. DB1014.2 +069700 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +069800 PERFORM PERFORM-THRU-WRITE. DB1014.2 +069900 MOVE DBCONT-HOLD TO SIZE-12 DB1014.2 +070000 IF SIZE-12 IS EQUAL TO "FALL THROUGH" DB1014.2 +070100 PERFORM PASS ELSE DB1014.2 +070200 MOVE "FALL THROUGH" TO CORRECT-A DB1014.2 +070300 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +070400 PERFORM FAIL. DB1014.2 +070500 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +070600 GO TO PERFORM-THRU-WRITE. DB1014.2 +070700 PERFORM-THRU-DELETE. DB1014.2 +070800 PERFORM DE-LETE. DB1014.2 +070900 PERFORM-THRU-WRITE. DB1014.2 +071000 MOVE "PERFORM-THRU-TEST" TO PAR-NAME. DB1014.2 +071100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +071200 PERFORM PRINT-DETAIL. DB1014.2 +071300 MOVE 0 TO RESULT-FLAG. DB1014.2 +071400******************************************************************DB1014.2 +071500* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1014.2 +071600* OUTPUT REPORT AS "SIMPLE-PERFORM-TEST" SHOULD POINT TO THE *DB1014.2 +071700* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1014.2 +071800* WHICH READS, "PERFORM LOOP-ROUTINE.". *DB1014.2 +071900******************************************************************DB1014.2 +072000 SIMPLE-PERFORM-TEST. DB1014.2 +072100 PERFORM LOOP-ROUTINE. DB1014.2 +072200 IF RESULT-FLAG IS NOT EQUAL TO 1 DB1014.2 +072300 MOVE "USE PROCEDURE NOT EXECUTED" TO RE-MARK DB1014.2 +072400 PERFORM FAIL DB1014.2 +072500 GO TO SIMPLE-PERFORM-WRITE. DB1014.2 +072600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1014.2 +072700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1014.2 +072800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1014.2 +072900 PERFORM INSPT. DB1014.2 +073000 PERFORM SIMPLE-PERFORM-WRITE. DB1014.2 +073100 MOVE DBNAME-HOLD TO SIZE-12. DB1014.2 +073200 IF SIZE-12 IS EQUAL TO "LOOP-ROUTINE" DB1014.2 +073300 PERFORM PASS ELSE DB1014.2 +073400 MOVE "LOOP-ROUTINE" TO CORRECT-A DB1014.2 +073500 MOVE DBNAME-HOLD TO COMPUTED-A DB1014.2 +073600 PERFORM FAIL. DB1014.2 +073700 MOVE "DEBUG-NAME" TO RE-MARK. DB1014.2 +073800 PERFORM SIMPLE-PERFORM-WRITE. DB1014.2 +073900 MOVE DBCONT-HOLD TO SIZE-12. DB1014.2 +074000 IF SIZE-12 IS EQUAL TO "PERFORM LOOP" DB1014.2 +074100 PERFORM PASS ELSE DB1014.2 +074200 MOVE "PERFORM LOOP" TO CORRECT-A DB1014.2 +074300 MOVE DBCONT-HOLD TO COMPUTED-A DB1014.2 +074400 PERFORM FAIL. DB1014.2 +074500 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1014.2 +074600 GO TO SIMPLE-PERFORM-WRITE. DB1014.2 +074700 SIMPLE-PERFORM-DELETE. DB1014.2 +074800 PERFORM DE-LETE. DB1014.2 +074900 SIMPLE-PERFORM-WRITE. DB1014.2 +075000 MOVE "SIMPLE-PERFORM-TEST" TO PAR-NAME. DB1014.2 +075100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1014.2 +075200 PERFORM PRINT-DETAIL. DB1014.2 +075300 MOVE 0 TO RESULT-FLAG. DB1014.2 +075400 DEBUG-LINE-TESTS-INIT. DB1014.2 +075500 MOVE "DEBUG LINE TESTS" TO FEATURE. DB1014.2 +075600 DEBUG-LINE-TEST-01. DB1014.2 +075700 MOVE "COMPLETE ENTITY" TO RE-MARK. DB1014.2 +075800 PERFORM FAIL. DB1014.2 +075900D PERFORM PASS SUBTRACT 1 FROM ERROR-COUNTER. DB1014.2 +076000 GO TO DEBUG-LINE-WRITE-01. DB1014.2 +076100 DEBUG-LINE-DELETE-01. DB1014.2 +076200 PERFORM DE-LETE. DB1014.2 +076300 DEBUG-LINE-WRITE-01. DB1014.2 +076400 MOVE "DEBUG-LINE-TEST-01" TO PAR-NAME. DB1014.2 +076500 PERFORM PRINT-DETAIL. DB1014.2 +076600 DEBUG-LINE-TEST-02. DB1014.2 +076700 MOVE "CONSECUTIVE DEBUG LINES" TO RE-MARK. DB1014.2 +076800 PERFORM FAIL. DB1014.2 +076900D PERFORM PASS. DB1014.2 +077000D SUBTRACT 1 FROM ERROR-COUNTER. DB1014.2 +077100 GO TO DEBUG-LINE-WRITE-02. DB1014.2 +077200 DEBUG-LINE-DELETE-02. DB1014.2 +077300 PERFORM DE-LETE. DB1014.2 +077400 DEBUG-LINE-WRITE-02. DB1014.2 +077500 MOVE "DEBUG-LINE-TEST-02" TO PAR-NAME. DB1014.2 +077600 PERFORM PRINT-DETAIL. DB1014.2 +077700 DEBUG-LINE-TEST-03. DB1014.2 +077800 MOVE "BROKEN STATEMENTS" TO RE-MARK. DB1014.2 +077900 PERFORM DB1014.2 +078000D PASS. GO TO DEBUG-LINE-WRITE-03. DB1014.2 +078100DDEBUG-LINE-TEST-03-A. PERFORM DB1014.2 +078200 FAIL. DB1014.2 +078300 GO TO DEBUG-LINE-WRITE-03. DB1014.2 +078400 DEBUG-LINE-DELETE-03. DB1014.2 +078500 PERFORM DE-LETE. DB1014.2 +078600 DEBUG-LINE-WRITE-03. DB1014.2 +078700 MOVE "DEBUG-LINE-TEST-03" TO PAR-NAME. DB1014.2 +078800 PERFORM PRINT-DETAIL. DB1014.2 +078900 DEBUG-LINE-TEST-04. DB1014.2 +079000 MOVE "NESTED COMMENTS" TO RE-MARK. DB1014.2 +079100D PERFORM DB1014.2 +079200* FAIL. GO TO DEBUG-LINE-WRITE-04. DB1014.2 +079300*DEBUG-LINE-TEST-04-A. PERFORM DB1014.2 +079400D PASS. GO TO DEBUG-LINE-WRITE-04. DB1014.2 +079500 DEBUG-LINE-TEST-04-B. DB1014.2 +079600 MOVE " FAILURE 04B" TO COMPUTED-A. DB1014.2 +079700 PERFORM FAIL. DB1014.2 +079800 GO TO DEBUG-LINE-WRITE-04. DB1014.2 +079900 DEBUG-LINE-DELETE-04. DB1014.2 +080000 PERFORM DE-LETE. DB1014.2 +080100 DEBUG-LINE-WRITE-04. DB1014.2 +080200 MOVE "DEBUG-LINE-TEST-04" TO PAR-NAME. DB1014.2 +080300 PERFORM PRINT-DETAIL. DB1014.2 +080400 DEBUG-LINE-TEST-05. DB1014.2 +080500 MOVE "NESTED INSIDE COMMENTS" TO RE-MARK. DB1014.2 +080600* PERFORM FAIL. DB1014.2 +080700* GO TO DEBUG-LINE-WRITE-05. DB1014.2 +080800*DEBUG-LINE-TEST-05-A. DB1014.2 +080900D PERFORM PASS. DB1014.2 +081000D GO TO DEBUG-LINE-WRITE-05. DB1014.2 +081100*DEBUG-LINE-TEST-05-B. DB1014.2 +081200* MOVE " FAILURE 05B" TO COMPUTED-A. DB1014.2 +081300* PERFORM FAIL. GO TO DEBUG-LINE-WRITE-05. DB1014.2 +081400 DEBUG-LINE-TEST-05-C. DB1014.2 +081500 MOVE " FAILURE 05C" TO COMPUTED-A. DB1014.2 +081600 PERFORM FAIL. GO TO DEBUG-LINE-WRITE-05. DB1014.2 +081700 DEBUG-LINE-DELETE-05. DB1014.2 +081800 PERFORM DE-LETE. DB1014.2 +081900 DEBUG-LINE-WRITE-05. DB1014.2 +082000 MOVE "DEBUG-LINE-TEST-05" TO PAR-NAME. DB1014.2 +082100 PERFORM PRINT-DETAIL. DB1014.2 +082200 CCVS-EXIT SECTION. DB1014.2 +082300 CCVS-999999. DB1014.2 +082400 GO TO CLOSE-FILES. DB1014.2 +*END-OF,DB101A +*HEADER,COBOL,DB102A +000100 IDENTIFICATION DIVISION. DB1024.2 +000200 PROGRAM-ID. DB1024.2 +000300 DB102A. DB1024.2 +000400 AUTHOR. DB1024.2 +000500 FEDERAL COMPILER TESTING CENTER. DB1024.2 +000600 INSTALLATION. DB1024.2 +000700 GENERAL SERVICES ADMINISTRATION DB1024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB1024.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB1024.2 +001100 FALLS CHURCH VIRGINIA 22041. DB1024.2 +001200 DB1024.2 +001300 PHONE (703) 756-6153 DB1024.2 +001400 DB1024.2 +001500 " HIGH ". DB1024.2 +001600 DATE-WRITTEN. DB1024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1024.2 +001800 CREATION DATE / VALIDATION DATE DB1024.2 +001900 "4.2 ". DB1024.2 +002000 SECURITY. DB1024.2 +002100 NONE. DB1024.2 +002200* DB1024.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB1024.2 +002400* DB1024.2 +002500* PROGRAM ABSTRACT DB1024.2 +002600* DB1024.2 +002700* DB102A TESTS THE BASIC OPERATION OF THE DEBUG MODULE DB1024.2 +002800* FACILITIES WHEN THE COMPILE TIME DEBUGGING SWITCH IS ON DB1024.2 +002900* AND THE OBJECT TIME SWITCH IS OFF. ALL DEBUG LINES AND DB1024.2 +003000* DEBUGGING PROCEDURES SHOULD BE INCLUDED IN COMPILATION AND DB1024.2 +003100* GENERATE CODE. DB1024.2 +003200* DB1024.2 +003300* BEFORE BEGINNING EXECUTION OF THE OBJECT PROGRAM, THE JOB DB1024.2 +003400* CONTROL LANGUAGE NECESSARY TO DEACTIVATE (TURN OFF) THE DB1024.2 +003500* OBJECT TIME DEBUGGING SWITCH MUST BE SUBMITTED. DB1024.2 +003600* DB1024.2 +003700* AT EXECUTION TIME, CODE GENERATED FROM DEBUG LINES SHOULD DB1024.2 +003800* BE EXECUTED, BUT DEBUGGING PROCEDURES SHOULD BE DEACTIVATED DB1024.2 +003900* BY THE OBJECT TIME SWITCH. DB1024.2 +004000* DB1024.2 +004100* DB1024.2 +004200* DB1024.2 +004300 ENVIRONMENT DIVISION. DB1024.2 +004400 CONFIGURATION SECTION. DB1024.2 +004500 SOURCE-COMPUTER. DB1024.2 +004600 XXXXX082 DB1024.2 +004700 WITH DEBUGGING MODE. DB1024.2 +004800 OBJECT-COMPUTER. DB1024.2 +004900 XXXXX083. DB1024.2 +005000 INPUT-OUTPUT SECTION. DB1024.2 +005100 FILE-CONTROL. DB1024.2 +005200 SELECT PRINT-FILE ASSIGN TO DB1024.2 +005300 XXXXX055. DB1024.2 +005400 DATA DIVISION. DB1024.2 +005500 FILE SECTION. DB1024.2 +005600 FD PRINT-FILE DB1024.2 +005700 LABEL RECORDS DB1024.2 +005800 XXXXX084 DB1024.2 +005900 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1024.2 +006000 01 PRINT-REC PICTURE X(120). DB1024.2 +006100 01 DUMMY-RECORD PICTURE X(120). DB1024.2 +006200 WORKING-STORAGE SECTION. DB1024.2 +006300 77 A PIC 9 COMP VALUE 1. DB1024.2 +006400 77 B PIC 9 COMP VALUE 5. DB1024.2 +006500 77 C PIC 9 COMP VALUE 9. DB1024.2 +006600 77 D PIC 99 COMP. DB1024.2 +006700 77 RESULT-FLAG PIC 99 COMP VALUE 0. DB1024.2 +006800 77 DBLINE-HOLD PIC X(6). DB1024.2 +006900 77 DBNAME-HOLD PIC X(30). DB1024.2 +007000 77 DBCONT-HOLD PIC X(30). DB1024.2 +007100 77 FIVE PIC 9 COMP VALUE 5. DB1024.2 +007200 01 SIZE-19. DB1024.2 +007300 02 FILLER PIC X. DB1024.2 +007400 02 SIZE-18. DB1024.2 +007500 03 FILLER PIC X. DB1024.2 +007600 03 SIZE-17. DB1024.2 +007700 04 FILLER PIC X. DB1024.2 +007800 04 SIZE-16. DB1024.2 +007900 05 FILLER PIC X. DB1024.2 +008000 05 SIZE-15. DB1024.2 +008100 06 FILLER PIC X. DB1024.2 +008200 06 SIZE-14. DB1024.2 +008300 07 FILLER PIC X. DB1024.2 +008400 07 SIZE-13. DB1024.2 +008500 08 FILLER PIC X. DB1024.2 +008600 08 SIZE-12. DB1024.2 +008700 09 FILLER PIC X. DB1024.2 +008800 09 SIZE-11. DB1024.2 +008900 10 FILLER PIC X. DB1024.2 +009000 10 SIZE-10 PIC X(10). DB1024.2 +009100 01 TEST-RESULTS. DB1024.2 +009200 02 FILLER PICTURE X VALUE SPACE. DB1024.2 +009300 02 FEATURE PICTURE X(20) VALUE SPACE. DB1024.2 +009400 02 FILLER PICTURE X VALUE SPACE. DB1024.2 +009500 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1024.2 +009600 02 FILLER PICTURE X VALUE SPACE. DB1024.2 +009700 02 PAR-NAME. DB1024.2 +009800 03 FILLER PICTURE X(12) VALUE SPACE. DB1024.2 +009900 03 PARDOT-X PICTURE X VALUE SPACE. DB1024.2 +010000 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1024.2 +010100 03 FILLER PIC X(5) VALUE SPACE. DB1024.2 +010200 02 FILLER PIC X(10) VALUE SPACE. DB1024.2 +010300 02 RE-MARK PIC X(61). DB1024.2 +010400 01 TEST-COMPUTED. DB1024.2 +010500 02 FILLER PIC X(30) VALUE SPACE. DB1024.2 +010600 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1024.2 +010700 02 COMPUTED-X. DB1024.2 +010800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1024.2 +010900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1024.2 +011000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1024.2 +011100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1024.2 +011200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1024.2 +011300 03 CM-18V0 REDEFINES COMPUTED-A. DB1024.2 +011400 04 COMPUTED-18V0 PICTURE -9(18). DB1024.2 +011500 04 FILLER PICTURE X. DB1024.2 +011600 03 FILLER PIC X(50) VALUE SPACE. DB1024.2 +011700 01 TEST-CORRECT. DB1024.2 +011800 02 FILLER PIC X(30) VALUE SPACE. DB1024.2 +011900 02 FILLER PIC X(17) VALUE " CORRECT =". DB1024.2 +012000 02 CORRECT-X. DB1024.2 +012100 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1024.2 +012200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1024.2 +012300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1024.2 +012400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1024.2 +012500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1024.2 +012600 03 CR-18V0 REDEFINES CORRECT-A. DB1024.2 +012700 04 CORRECT-18V0 PICTURE -9(18). DB1024.2 +012800 04 FILLER PICTURE X. DB1024.2 +012900 03 FILLER PIC X(50) VALUE SPACE. DB1024.2 +013000 01 CCVS-C-1. DB1024.2 +013100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1024.2 +013200- "SS PARAGRAPH-NAME DB1024.2 +013300- " REMARKS". DB1024.2 +013400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1024.2 +013500 01 CCVS-C-2. DB1024.2 +013600 02 FILLER PICTURE IS X VALUE IS SPACE. DB1024.2 +013700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1024.2 +013800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1024.2 +013900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1024.2 +014000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1024.2 +014100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1024.2 +014200 01 REC-CT PICTURE 99 VALUE ZERO. DB1024.2 +014300 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1024.2 +014400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1024.2 +014500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1024.2 +014600 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1024.2 +014700 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1024.2 +014800 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1024.2 +014900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1024.2 +015000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1024.2 +015100 01 CCVS-H-1. DB1024.2 +015200 02 FILLER PICTURE X(27) VALUE SPACE. DB1024.2 +015300 02 FILLER PICTURE X(67) VALUE DB1024.2 +015400 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1024.2 +015500- " SYSTEM". DB1024.2 +015600 02 FILLER PICTURE X(26) VALUE SPACE. DB1024.2 +015700 01 CCVS-H-2. DB1024.2 +015800 02 FILLER PICTURE X(52) VALUE IS DB1024.2 +015900 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1024.2 +016000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1024.2 +016100 02 TEST-ID PICTURE IS X(9). DB1024.2 +016200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1024.2 +016300 01 CCVS-H-3. DB1024.2 +016400 02 FILLER PICTURE X(34) VALUE DB1024.2 +016500 " FOR OFFICIAL USE ONLY ". DB1024.2 +016600 02 FILLER PICTURE X(58) VALUE DB1024.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1024.2 +016800 02 FILLER PICTURE X(28) VALUE DB1024.2 +016900 " COPYRIGHT 1974 ". DB1024.2 +017000 01 CCVS-E-1. DB1024.2 +017100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1024.2 +017200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1024.2 +017300 02 ID-AGAIN PICTURE IS X(9). DB1024.2 +017400 02 FILLER PICTURE X(45) VALUE IS DB1024.2 +017500 " NTIS DISTRIBUTION COBOL 74". DB1024.2 +017600 01 CCVS-E-2. DB1024.2 +017700 02 FILLER PICTURE X(31) VALUE DB1024.2 +017800 SPACE. DB1024.2 +017900 02 FILLER PICTURE X(21) VALUE SPACE. DB1024.2 +018000 02 CCVS-E-2-2. DB1024.2 +018100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1024.2 +018200 03 FILLER PICTURE IS X VALUE IS SPACE. DB1024.2 +018300 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1024.2 +018400 01 CCVS-E-3. DB1024.2 +018500 02 FILLER PICTURE X(22) VALUE DB1024.2 +018600 " FOR OFFICIAL USE ONLY". DB1024.2 +018700 02 FILLER PICTURE X(12) VALUE SPACE. DB1024.2 +018800 02 FILLER PICTURE X(58) VALUE DB1024.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1024.2 +019000 02 FILLER PICTURE X(13) VALUE SPACE. DB1024.2 +019100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1024.2 +019200 01 CCVS-E-4. DB1024.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1024.2 +019400 02 FILLER PIC XXXX VALUE " OF ". DB1024.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1024.2 +019600 02 FILLER PIC X(40) VALUE DB1024.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". DB1024.2 +019800 01 XXINFO. DB1024.2 +019900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1024.2 +020000 02 INFO-TEXT. DB1024.2 +020100 04 FILLER PIC X(20) VALUE SPACE. DB1024.2 +020200 04 XXCOMPUTED PIC X(20). DB1024.2 +020300 04 FILLER PIC X(5) VALUE SPACE. DB1024.2 +020400 04 XXCORRECT PIC X(20). DB1024.2 +020500 01 HYPHEN-LINE. DB1024.2 +020600 02 FILLER PICTURE IS X VALUE IS SPACE. DB1024.2 +020700 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1024.2 +020800- "*****************************************". DB1024.2 +020900 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1024.2 +021000- "******************************". DB1024.2 +021100 01 CCVS-PGM-ID PIC X(6) VALUE DB1024.2 +021200 "DB102A". DB1024.2 +021300 PROCEDURE DIVISION. DB1024.2 +021400 DECLARATIVES. DB1024.2 +021500 START-UP SECTION. DB1024.2 +021600 USE FOR DEBUGGING ON OPEN-FILES. DB1024.2 +021700 BEGIN-START-UP. DB1024.2 +021800 MOVE 1 TO RESULT-FLAG. DB1024.2 +021900 DB-COMMON. DB1024.2 +022000 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1024.2 +022100 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1024.2 +022200 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1024.2 +022300 FALL-THROUGH-AND-SERIES SECTION. DB1024.2 +022400 USE FOR DEBUGGING ON FALL-THROUGH-TEST DB1024.2 +022500 PROC-SERIES-TEST. DB1024.2 +022600 BEGIN-FALL-THROUGH-AND-SERIES. DB1024.2 +022700 PERFORM DB-COMMON. DB1024.2 +022800 MOVE 2 TO RESULT-FLAG. DB1024.2 +022900 GO-TO SECTION. DB1024.2 +023000 USE FOR DEBUGGING ON GO-TO-TEST. DB1024.2 +023100 BEGIN-GO-TO. DB1024.2 +023200 PERFORM DB-COMMON. DB1024.2 +023300 MOVE 3 TO RESULT-FLAG. DB1024.2 +023400 ALTER-PARAGRAPH SECTION. DB1024.2 +023500 USE FOR DEBUGGING ON ALTERABLE-PARAGRAPH. DB1024.2 +023600 BEGIN-ALTER-PARAGRAPH. DB1024.2 +023700 PERFORM DB-COMMON. DB1024.2 +023800 MOVE 4 TO RESULT-FLAG. DB1024.2 +023900 LOOP-ITERATION SECTION. DB1024.2 +024000 USE FOR DEBUGGING ON LOOP-ROUTINE. DB1024.2 +024100 BEGIN-LOOP-ITERATION. DB1024.2 +024200 PERFORM DB-COMMON. DB1024.2 +024300 ADD 1 TO RESULT-FLAG. DB1024.2 +024400 PERFORM-THRU SECTION. DB1024.2 +024500 USE FOR DEBUGGING ON DO-NOTHING-1. DB1024.2 +024600 BEGIN-PERFORM-THRU. DB1024.2 +024700 PERFORM DB-COMMON. DB1024.2 +024800 ADD 1 TO RESULT-FLAG. DB1024.2 +024900 END DECLARATIVES. DB1024.2 +025000 CCVS1 SECTION. DB1024.2 +025100 OPEN-FILES. DB1024.2 +025200 OPEN OUTPUT PRINT-FILE. DB1024.2 +025300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1024.2 +025400 MOVE SPACE TO TEST-RESULTS. DB1024.2 +025500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1024.2 +025600 GO TO CCVS1-EXIT. DB1024.2 +025700 CLOSE-FILES. DB1024.2 +025800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1024.2 +025900 TERMINATE-CCVS. DB1024.2 +026000S EXIT PROGRAM. DB1024.2 +026100STERMINATE-CALL. DB1024.2 +026200 STOP RUN. DB1024.2 +026300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1024.2 +026400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1024.2 +026500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1024.2 +026600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1024.2 +026700 MOVE "****TEST DELETED****" TO RE-MARK. DB1024.2 +026800 PRINT-DETAIL. DB1024.2 +026900 IF REC-CT NOT EQUAL TO ZERO DB1024.2 +027000 MOVE "." TO PARDOT-X DB1024.2 +027100 MOVE REC-CT TO DOTVALUE. DB1024.2 +027200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1024.2 +027300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1024.2 +027400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1024.2 +027500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1024.2 +027600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1024.2 +027700 MOVE SPACE TO CORRECT-X. DB1024.2 +027800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1024.2 +027900 MOVE SPACE TO RE-MARK. DB1024.2 +028000 HEAD-ROUTINE. DB1024.2 +028100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1024.2 +028200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1024.2 +028300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1024.2 +028400 COLUMN-NAMES-ROUTINE. DB1024.2 +028500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1024.2 +028600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1024.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1024.2 +028800 END-ROUTINE. DB1024.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1024.2 +029000 END-RTN-EXIT. DB1024.2 +029100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1024.2 +029200 END-ROUTINE-1. DB1024.2 +029300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1024.2 +029400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1024.2 +029500 ADD PASS-COUNTER TO ERROR-HOLD. DB1024.2 +029600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1024.2 +029700 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1024.2 +029800 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1024.2 +029900 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1024.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1024.2 +030100 END-ROUTINE-12. DB1024.2 +030200 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1024.2 +030300 IF ERROR-COUNTER IS EQUAL TO ZERO DB1024.2 +030400 MOVE "NO " TO ERROR-TOTAL DB1024.2 +030500 ELSE DB1024.2 +030600 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1024.2 +030700 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1024.2 +030800 PERFORM WRITE-LINE. DB1024.2 +030900 END-ROUTINE-13. DB1024.2 +031000 IF DELETE-CNT IS EQUAL TO ZERO DB1024.2 +031100 MOVE "NO " TO ERROR-TOTAL ELSE DB1024.2 +031200 MOVE DELETE-CNT TO ERROR-TOTAL. DB1024.2 +031300 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1024.2 +031400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1024.2 +031500 IF INSPECT-COUNTER EQUAL TO ZERO DB1024.2 +031600 MOVE "NO " TO ERROR-TOTAL DB1024.2 +031700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1024.2 +031800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1024.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1024.2 +032000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1024.2 +032100 WRITE-LINE. DB1024.2 +032200 ADD 1 TO RECORD-COUNT. DB1024.2 +032300Y IF RECORD-COUNT GREATER 50 DB1024.2 +032400Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1024.2 +032500Y MOVE SPACE TO DUMMY-RECORD DB1024.2 +032600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1024.2 +032700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1024.2 +032800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1024.2 +032900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1024.2 +033000Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1024.2 +033100Y MOVE ZERO TO RECORD-COUNT. DB1024.2 +033200 PERFORM WRT-LN. DB1024.2 +033300 WRT-LN. DB1024.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1024.2 +033500 MOVE SPACE TO DUMMY-RECORD. DB1024.2 +033600 BLANK-LINE-PRINT. DB1024.2 +033700 PERFORM WRT-LN. DB1024.2 +033800 FAIL-ROUTINE. DB1024.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1024.2 +034000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1024.2 +034100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1024.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1024.2 +034300 GO TO FAIL-ROUTINE-EX. DB1024.2 +034400 FAIL-ROUTINE-WRITE. DB1024.2 +034500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1024.2 +034600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1024.2 +034700 FAIL-ROUTINE-EX. EXIT. DB1024.2 +034800 BAIL-OUT. DB1024.2 +034900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1024.2 +035000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1024.2 +035100 BAIL-OUT-WRITE. DB1024.2 +035200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1024.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1024.2 +035400 BAIL-OUT-EX. EXIT. DB1024.2 +035500 CCVS1-EXIT. DB1024.2 +035600 EXIT. DB1024.2 +035700 START-PROGRAM-TEST. DB1024.2 +035800 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +035900 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +036000 PERFORM FAIL DB1024.2 +036100 PERFORM START-PROGRAM-WRITE DB1024.2 +036200 ELSE PERFORM PASS DB1024.2 +036300 GO TO START-PROGRAM-WRITE. DB1024.2 +036400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +036500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +036600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +036700 PERFORM START-PROGRAM-WRITE. DB1024.2 +036800 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +036900 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +037000 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +037100 PERFORM START-PROGRAM-WRITE. DB1024.2 +037200 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +037300 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +037400 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +037500 GO TO START-PROGRAM-WRITE. DB1024.2 +037600 START-PROGRAM-DELETE. DB1024.2 +037700 PERFORM DE-LETE. DB1024.2 +037800 START-PROGRAM-WRITE. DB1024.2 +037900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +038000 MOVE "START-PROGRAM-TEST" TO PAR-NAME. DB1024.2 +038100 PERFORM PRINT-DETAIL. DB1024.2 +038200 MOVE 0 TO RESULT-FLAG. DB1024.2 +038300 FALL-THROUGH-TEST. DB1024.2 +038400 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +038500 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +038600 PERFORM FAIL DB1024.2 +038700 PERFORM FALL-THROUGH-WRITE DB1024.2 +038800 ELSE PERFORM PASS DB1024.2 +038900 GO TO FALL-THROUGH-WRITE. DB1024.2 +039000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +039100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +039200 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +039300 PERFORM FALL-THROUGH-WRITE. DB1024.2 +039400 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +039500 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +039600 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +039700 PERFORM FALL-THROUGH-WRITE. DB1024.2 +039800 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +039900 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +040000 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +040100 GO TO FALL-THROUGH-WRITE. DB1024.2 +040200 FALL-THROUGH-DELETE. DB1024.2 +040300 PERFORM DE-LETE. DB1024.2 +040400 FALL-THROUGH-WRITE. DB1024.2 +040500 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +040600 MOVE "FALL-THROUGH-TEST" TO PAR-NAME. DB1024.2 +040700 PERFORM PRINT-DETAIL. DB1024.2 +040800 MOVE 0 TO RESULT-FLAG. DB1024.2 +040900 PROC-SERIES-TEST. DB1024.2 +041000 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +041100 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +041200 PERFORM FAIL DB1024.2 +041300 PERFORM PROC-SERIES-WRITE DB1024.2 +041400 ELSE PERFORM PASS DB1024.2 +041500 GO TO PROC-SERIES-WRITE. DB1024.2 +041600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +041700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +041800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +041900 PERFORM PROC-SERIES-WRITE. DB1024.2 +042000 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +042100 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +042200 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +042300 PERFORM PROC-SERIES-WRITE. DB1024.2 +042400 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +042500 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +042600 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +042700 GO TO PROC-SERIES-WRITE. DB1024.2 +042800 PROC-SERIES-DELETE. DB1024.2 +042900 PERFORM DE-LETE. DB1024.2 +043000 PROC-SERIES-WRITE. DB1024.2 +043100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +043200 MOVE "PROC-SERIES-TEST" TO PAR-NAME. DB1024.2 +043300 PERFORM PRINT-DETAIL. DB1024.2 +043400 MOVE 0 TO RESULT-FLAG. DB1024.2 +043500 ALTERABLE-PARAGRAPH. DB1024.2 +043600 GO TO GO-TO-TEST. DB1024.2 +043700 FILLER-PARAGRAPH. DB1024.2 +043800 DISPLAY "ALTER FAILED AT ALTER-TEST-INIT". DB1024.2 +043900 PERFORM FAIL. DB1024.2 +044000 GO TO ALTERED-GO-TO-TEST. DB1024.2 +044100 GO-TO-TEST. DB1024.2 +044200 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +044300 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +044400 PERFORM FAIL DB1024.2 +044500 PERFORM GO-TO-WRITE DB1024.2 +044600 ELSE PERFORM PASS DB1024.2 +044700 GO TO GO-TO-WRITE. DB1024.2 +044800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +044900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +045000 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +045100 PERFORM GO-TO-WRITE. DB1024.2 +045200 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +045300 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +045400 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +045500 PERFORM GO-TO-WRITE. DB1024.2 +045600 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +045700 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +045800 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +045900 GO TO GO-TO-WRITE. DB1024.2 +046000 GO-TO-DELETE. DB1024.2 +046100 PERFORM DE-LETE. DB1024.2 +046200 GO-TO-WRITE. DB1024.2 +046300 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +046400 MOVE "GO-TO-TEST" TO PAR-NAME. DB1024.2 +046500 PERFORM PRINT-DETAIL. DB1024.2 +046600 MOVE 0 TO RESULT-FLAG. DB1024.2 +046700 ALTER-TEST-INIT. DB1024.2 +046800 ALTER ALTERABLE-PARAGRAPH TO PROCEED TO ALTERED-GO-TO-TEST. DB1024.2 +046900 ALTER-TEST. DB1024.2 +047000 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +047100 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +047200 PERFORM FAIL DB1024.2 +047300 PERFORM ALTER-WRITE DB1024.2 +047400 ELSE PERFORM PASS DB1024.2 +047500 GO TO ALTER-WRITE. DB1024.2 +047600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +047700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +047800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +047900 PERFORM ALTER-WRITE. DB1024.2 +048000 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +048100 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +048200 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +048300 PERFORM ALTER-WRITE. DB1024.2 +048400 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +048500 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +048600 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +048700 GO TO ALTER-WRITE. DB1024.2 +048800 ALTER-DELETE. DB1024.2 +048900 PERFORM DE-LETE. DB1024.2 +049000 ALTER-WRITE. DB1024.2 +049100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +049200 MOVE "ALTER-TEST" TO PAR-NAME. DB1024.2 +049300 PERFORM PRINT-DETAIL. DB1024.2 +049400 MOVE 0 TO RESULT-FLAG. DB1024.2 +049500 ALTER-WRITE-END. DB1024.2 +049600 GO TO ALTERABLE-PARAGRAPH. DB1024.2 +049700 ALTERED-GO-TO-TEST. DB1024.2 +049800 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +049900 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +050000 PERFORM FAIL DB1024.2 +050100 PERFORM ALTERED-GO-TO-WRITE DB1024.2 +050200 ELSE PERFORM PASS DB1024.2 +050300 GO TO ALTERED-GO-TO-WRITE. DB1024.2 +050400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +050500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +050600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +050700 PERFORM ALTERED-GO-TO-WRITE. DB1024.2 +050800 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +050900 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +051000 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +051100 PERFORM ALTERED-GO-TO-WRITE. DB1024.2 +051200 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +051300 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +051400 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +051500 GO TO ALTERED-GO-TO-WRITE. DB1024.2 +051600 ALTERED-GO-TO-DELETE. DB1024.2 +051700 PERFORM DE-LETE. DB1024.2 +051800 ALTERED-GO-TO-WRITE. DB1024.2 +051900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +052000 MOVE "ALTERED-GO-TO-TEST" TO PAR-NAME. DB1024.2 +052100 PERFORM PRINT-DETAIL. DB1024.2 +052200 MOVE 0 TO RESULT-FLAG. DB1024.2 +052300 PERF-ITERATION-TEST. DB1024.2 +052400 PERFORM LOOP-ROUTINE FIVE TIMES. DB1024.2 +052500 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +052600 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +052700 PERFORM FAIL DB1024.2 +052800 PERFORM PERF-ITERATION-WRITE DB1024.2 +052900 ELSE PERFORM PASS DB1024.2 +053000 GO TO PERF-ITERATION-WRITE. DB1024.2 +053100 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +053200 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +053300 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +053400 PERFORM PERF-ITERATION-WRITE. DB1024.2 +053500 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +053600 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +053700 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +053800 PERFORM PERF-ITERATION-WRITE. DB1024.2 +053900 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +054000 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +054100 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +054200 GO TO PERF-ITERATION-WRITE. DB1024.2 +054300 PERF-ITERATION-DELETE. DB1024.2 +054400 PERFORM DE-LETE. DB1024.2 +054500 PERF-ITERATION-WRITE. DB1024.2 +054600 MOVE "PERF-ITERATION-TEST" TO PAR-NAME. DB1024.2 +054700 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +054800 PERFORM PRINT-DETAIL. DB1024.2 +054900 MOVE 0 TO RESULT-FLAG. DB1024.2 +055000 PERF-ITERATION-END. DB1024.2 +055100 GO TO PERFORM-THRU-TEST. DB1024.2 +055200 LOOP-ROUTINE. DB1024.2 +055300**NESTED PERFORMS ARE USED HERE TO ATTEMPT TO PREVENT OPTIMIZER DB1024.2 +055400* ACTION RESULTING IN LOOP UNFOLDING AND REDUCTION. DB1024.2 +055500 PERFORM DO-NOTHING. DB1024.2 +055600 DO-NOTHING. DB1024.2 +055700 ADD A B C GIVING D. DB1024.2 +055800 DO-NOTHING-1. DB1024.2 +055900 SUBTRACT A FROM B. DB1024.2 +056000 PERFORM-THRU-TEST. DB1024.2 +056100 PERFORM DO-NOTHING THRU DO-NOTHING-1 FIVE TIMES. DB1024.2 +056200 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +056300 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +056400 PERFORM FAIL DB1024.2 +056500 PERFORM PERFORM-THRU-WRITE DB1024.2 +056600 ELSE PERFORM PASS DB1024.2 +056700 GO TO PERFORM-THRU-WRITE. DB1024.2 +056800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +056900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +057000 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +057100 PERFORM PERFORM-THRU-WRITE. DB1024.2 +057200 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +057300 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +057400 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +057500 PERFORM PERFORM-THRU-WRITE. DB1024.2 +057600 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +057700 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +057800 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +057900 GO TO PERFORM-THRU-WRITE. DB1024.2 +058000 PERFORM-THRU-DELETE. DB1024.2 +058100 PERFORM DE-LETE. DB1024.2 +058200 PERFORM-THRU-WRITE. DB1024.2 +058300 MOVE "PERFORM-THRU-TEST" TO PAR-NAME. DB1024.2 +058400 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +058500 PERFORM PRINT-DETAIL. DB1024.2 +058600 MOVE 0 TO RESULT-FLAG. DB1024.2 +058700 SIMPLE-PERFORM-TEST. DB1024.2 +058800 PERFORM LOOP-ROUTINE. DB1024.2 +058900 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1024.2 +059000 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1024.2 +059100 PERFORM FAIL DB1024.2 +059200 PERFORM SIMPLE-PERFORM-WRITE DB1024.2 +059300 ELSE PERFORM PASS DB1024.2 +059400 GO TO SIMPLE-PERFORM-WRITE. DB1024.2 +059500 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1024.2 +059600 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1024.2 +059700 MOVE DBLINE-HOLD TO COMPUTED-A. DB1024.2 +059800 PERFORM SIMPLE-PERFORM-WRITE. DB1024.2 +059900 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1024.2 +060000 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1024.2 +060100 MOVE DBNAME-HOLD TO COMPUTED-A. DB1024.2 +060200 PERFORM SIMPLE-PERFORM-WRITE. DB1024.2 +060300 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1024.2 +060400 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1024.2 +060500 MOVE DBCONT-HOLD TO COMPUTED-A. DB1024.2 +060600 GO TO SIMPLE-PERFORM-WRITE. DB1024.2 +060700 SIMPLE-PERFORM-DELETE. DB1024.2 +060800 PERFORM DE-LETE. DB1024.2 +060900 SIMPLE-PERFORM-WRITE. DB1024.2 +061000 MOVE "SIMPLE-PERFORM-TEST" TO PAR-NAME. DB1024.2 +061100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1024.2 +061200 PERFORM PRINT-DETAIL. DB1024.2 +061300 MOVE 0 TO RESULT-FLAG. DB1024.2 +061400 DEBUG-LINE-TESTS-INIT. DB1024.2 +061500 MOVE "DEBUG LINE TESTS" TO FEATURE. DB1024.2 +061600 DEBUG-LINE-TEST-01. DB1024.2 +061700 MOVE "COMPLETE ENTITY" TO RE-MARK. DB1024.2 +061800 PERFORM FAIL. DB1024.2 +061900D PERFORM PASS SUBTRACT 1 FROM ERROR-COUNTER. DB1024.2 +062000 GO TO DEBUG-LINE-WRITE-01. DB1024.2 +062100 DEBUG-LINE-DELETE-01. DB1024.2 +062200 PERFORM DE-LETE. DB1024.2 +062300 DEBUG-LINE-WRITE-01. DB1024.2 +062400 MOVE "DEBUG-LINE-TEST-01" TO PAR-NAME. DB1024.2 +062500 PERFORM PRINT-DETAIL. DB1024.2 +062600 DEBUG-LINE-TEST-02. DB1024.2 +062700 MOVE "CONSECUTIVE DEBUG LINES" TO RE-MARK. DB1024.2 +062800 PERFORM FAIL. DB1024.2 +062900D PERFORM PASS. DB1024.2 +063000D SUBTRACT 1 FROM ERROR-COUNTER. DB1024.2 +063100 GO TO DEBUG-LINE-WRITE-02. DB1024.2 +063200 DEBUG-LINE-DELETE-02. DB1024.2 +063300 PERFORM DE-LETE. DB1024.2 +063400 DEBUG-LINE-WRITE-02. DB1024.2 +063500 MOVE "DEBUG-LINE-TEST-02" TO PAR-NAME. DB1024.2 +063600 PERFORM PRINT-DETAIL. DB1024.2 +063700 DEBUG-LINE-TEST-03. DB1024.2 +063800 MOVE "BROKEN STATEMENTS" TO RE-MARK. DB1024.2 +063900 PERFORM DB1024.2 +064000D PASS. GO TO DEBUG-LINE-WRITE-03. DB1024.2 +064100DDEBUG-LINE-TEST-03-A. PERFORM DB1024.2 +064200 FAIL. DB1024.2 +064300 GO TO DEBUG-LINE-WRITE-03. DB1024.2 +064400 DEBUG-LINE-DELETE-03. DB1024.2 +064500 PERFORM DE-LETE. DB1024.2 +064600 DEBUG-LINE-WRITE-03. DB1024.2 +064700 MOVE "DEBUG-LINE-TEST-03" TO PAR-NAME. DB1024.2 +064800 PERFORM PRINT-DETAIL. DB1024.2 +064900 DEBUG-LINE-TEST-04. DB1024.2 +065000 MOVE "NESTED COMMENTS" TO RE-MARK. DB1024.2 +065100D PERFORM DB1024.2 +065200* FAIL. GO TO DEBUG-LINE-WRITE-04. DB1024.2 +065300*DEBUG-LINE-TEST-04-A. PERFORM DB1024.2 +065400D PASS. GO TO DEBUG-LINE-WRITE-04. DB1024.2 +065500 DEBUG-LINE-TEST-04-B. DB1024.2 +065600 MOVE " FAILURE 04B" TO COMPUTED-A. DB1024.2 +065700 PERFORM FAIL. DB1024.2 +065800 GO TO DEBUG-LINE-WRITE-04. DB1024.2 +065900 DEBUG-LINE-DELETE-04. DB1024.2 +066000 PERFORM DE-LETE. DB1024.2 +066100 DEBUG-LINE-WRITE-04. DB1024.2 +066200 MOVE "DEBUG-LINE-TEST-04" TO PAR-NAME. DB1024.2 +066300 PERFORM PRINT-DETAIL. DB1024.2 +066400 DEBUG-LINE-TEST-05. DB1024.2 +066500 MOVE "NESTED INSIDE COMMENTS" TO RE-MARK. DB1024.2 +066600* PERFORM FAIL. DB1024.2 +066700* GO TO DEBUG-LINE-WRITE-05. DB1024.2 +066800*DEBUG-LINE-TEST-05-A. DB1024.2 +066900D PERFORM PASS. DB1024.2 +067000D GO TO DEBUG-LINE-WRITE-05. DB1024.2 +067100*DEBUG-LINE-TEST-05-B. DB1024.2 +067200* MOVE " FAILURE 05B" TO COMPUTED-A. DB1024.2 +067300* PERFORM FAIL. GO TO DEBUG-LINE-WRITE-05. DB1024.2 +067400 DEBUG-LINE-TEST-05-C. DB1024.2 +067500 MOVE " FAILURE 05C" TO COMPUTED-A. DB1024.2 +067600 PERFORM FAIL. GO TO DEBUG-LINE-WRITE-05. DB1024.2 +067700 DEBUG-LINE-DELETE-05. DB1024.2 +067800 PERFORM DE-LETE. DB1024.2 +067900 DEBUG-LINE-WRITE-05. DB1024.2 +068000 MOVE "DEBUG-LINE-TEST-05" TO PAR-NAME. DB1024.2 +068100 PERFORM PRINT-DETAIL. DB1024.2 +068200 CCVS-EXIT SECTION. DB1024.2 +068300 CCVS-999999. DB1024.2 +068400 GO TO CLOSE-FILES. DB1024.2 +*END-OF,DB102A +*HEADER,COBOL,DB103M +000100 IDENTIFICATION DIVISION. DB1034.2 +000200 PROGRAM-ID. DB1034.2 +000300 DB103M. DB1034.2 +000400 AUTHOR. DB1034.2 +000500 FEDERAL COMPILER TESTING CENTER. DB1034.2 +000600 INSTALLATION. DB1034.2 +000700 GENERAL SERVICES ADMINISTRATION DB1034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB1034.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB1034.2 +001100 FALLS CHURCH VIRGINIA 22041. DB1034.2 +001200 DB1034.2 +001300 PHONE (703) 756-6153 DB1034.2 +001400 DB1034.2 +001500 " HIGH ". DB1034.2 +001600 DATE-WRITTEN. DB1034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1034.2 +001800 CREATION DATE / VALIDATION DATE DB1034.2 +001900 "4.2 ". DB1034.2 +002000 SECURITY. DB1034.2 +002100 NONE. DB1034.2 +002200* DB1034.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB1034.2 +002400* DB1034.2 +002500* PROGRAM ABSTRACT DB1034.2 +002600* DB1034.2 +002700* DB103M TESTS THE BASIC OPERATION OF DEBUG MODULE FACILITIES DB1034.2 +002800* WHEN THE COMPILE TIME DEBUGGING SWITCH IS OFF. ALL DEBUG DB1034.2 +002900* LINES SHOULD BE TREATED AS COMMENTS AND NO CODE SHOULD DB1034.2 +003000* BE GENERATED FOR EITHER DEBUG LINES OR DEBUGGING PROCED- DB1034.2 +003100* URES. DB1034.2 +003200* DB1034.2 +003300* THE OBJECT PROGRAM FOR DB103M SHOULD BE EXECUTED TWICE;ONCE DB1034.2 +003400* WITH THE OBJECT TIME DEBUGGING SWITCH ENABLED (ON), AND ONCE DB1034.2 +003500* WITH THE OBJECT TIME DEBUGGING SWITCH DISABLED (OFF). BOTH DB1034.2 +003600* EXECUTION RUNS SHOULD YIELD THE SAME RESULTS AS THE SETTING DB1034.2 +003700* OF THE OBJECT TIME DEBUGGING SWITCH SHOULD MAKE NO DIFFER- DB1034.2 +003800* ENCE SINCE THE COMPILE TIME DEBUGGING SWITCH WAS INITIALLY DB1034.2 +003900* DISABLED. DB1034.2 +004000* DB1034.2 +004100* DB1034.2 +004200 ENVIRONMENT DIVISION. DB1034.2 +004300 CONFIGURATION SECTION. DB1034.2 +004400 SOURCE-COMPUTER. DB1034.2 +004500 XXXXX082. DB1034.2 +004600 OBJECT-COMPUTER. DB1034.2 +004700 XXXXX083. DB1034.2 +004800 INPUT-OUTPUT SECTION. DB1034.2 +004900 FILE-CONTROL. DB1034.2 +005000 SELECT PRINT-FILE ASSIGN TO DB1034.2 +005100 XXXXX055. DB1034.2 +005200 DATA DIVISION. DB1034.2 +005300 FILE SECTION. DB1034.2 +005400 FD PRINT-FILE DB1034.2 +005500 LABEL RECORDS DB1034.2 +005600 XXXXX084 DB1034.2 +005700 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1034.2 +005800 01 PRINT-REC PICTURE X(120). DB1034.2 +005900 01 DUMMY-RECORD PICTURE X(120). DB1034.2 +006000 WORKING-STORAGE SECTION. DB1034.2 +006100 77 A PIC 9 COMP VALUE 1. DB1034.2 +006200 77 B PIC 9 COMP VALUE 5. DB1034.2 +006300 77 C PIC 9 COMP VALUE 9. DB1034.2 +006400 77 D PIC 99 COMP. DB1034.2 +006500 77 RESULT-FLAG PIC 99 COMP VALUE 0. DB1034.2 +006600 77 DBLINE-HOLD PIC X(6). DB1034.2 +006700 77 DBNAME-HOLD PIC X(30). DB1034.2 +006800 77 DBCONT-HOLD PIC X(30). DB1034.2 +006900 77 FIVE PIC 9 COMP VALUE 5. DB1034.2 +007000 01 SIZE-19. DB1034.2 +007100 02 FILLER PIC X. DB1034.2 +007200 02 SIZE-18. DB1034.2 +007300 03 FILLER PIC X. DB1034.2 +007400 03 SIZE-17. DB1034.2 +007500 04 FILLER PIC X. DB1034.2 +007600 04 SIZE-16. DB1034.2 +007700 05 FILLER PIC X. DB1034.2 +007800 05 SIZE-15. DB1034.2 +007900 06 FILLER PIC X. DB1034.2 +008000 06 SIZE-14. DB1034.2 +008100 07 FILLER PIC X. DB1034.2 +008200 07 SIZE-13. DB1034.2 +008300 08 FILLER PIC X. DB1034.2 +008400 08 SIZE-12. DB1034.2 +008500 09 FILLER PIC X. DB1034.2 +008600 09 SIZE-11. DB1034.2 +008700 10 FILLER PIC X. DB1034.2 +008800 10 SIZE-10 PIC X(10). DB1034.2 +008900 01 TEST-RESULTS. DB1034.2 +009000 02 FILLER PICTURE X VALUE SPACE. DB1034.2 +009100 02 FEATURE PICTURE X(20) VALUE SPACE. DB1034.2 +009200 02 FILLER PICTURE X VALUE SPACE. DB1034.2 +009300 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1034.2 +009400 02 FILLER PICTURE X VALUE SPACE. DB1034.2 +009500 02 PAR-NAME. DB1034.2 +009600 03 FILLER PICTURE X(12) VALUE SPACE. DB1034.2 +009700 03 PARDOT-X PICTURE X VALUE SPACE. DB1034.2 +009800 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1034.2 +009900 03 FILLER PIC X(5) VALUE SPACE. DB1034.2 +010000 02 FILLER PIC X(10) VALUE SPACE. DB1034.2 +010100 02 RE-MARK PIC X(61). DB1034.2 +010200 01 TEST-COMPUTED. DB1034.2 +010300 02 FILLER PIC X(30) VALUE SPACE. DB1034.2 +010400 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1034.2 +010500 02 COMPUTED-X. DB1034.2 +010600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1034.2 +010700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1034.2 +010800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1034.2 +010900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1034.2 +011000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1034.2 +011100 03 CM-18V0 REDEFINES COMPUTED-A. DB1034.2 +011200 04 COMPUTED-18V0 PICTURE -9(18). DB1034.2 +011300 04 FILLER PICTURE X. DB1034.2 +011400 03 FILLER PIC X(50) VALUE SPACE. DB1034.2 +011500 01 TEST-CORRECT. DB1034.2 +011600 02 FILLER PIC X(30) VALUE SPACE. DB1034.2 +011700 02 FILLER PIC X(17) VALUE " CORRECT =". DB1034.2 +011800 02 CORRECT-X. DB1034.2 +011900 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1034.2 +012000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1034.2 +012100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1034.2 +012200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1034.2 +012300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1034.2 +012400 03 CR-18V0 REDEFINES CORRECT-A. DB1034.2 +012500 04 CORRECT-18V0 PICTURE -9(18). DB1034.2 +012600 04 FILLER PICTURE X. DB1034.2 +012700 03 FILLER PIC X(50) VALUE SPACE. DB1034.2 +012800 01 CCVS-C-1. DB1034.2 +012900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1034.2 +013000- "SS PARAGRAPH-NAME DB1034.2 +013100- " REMARKS". DB1034.2 +013200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1034.2 +013300 01 CCVS-C-2. DB1034.2 +013400 02 FILLER PICTURE IS X VALUE IS SPACE. DB1034.2 +013500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1034.2 +013600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1034.2 +013700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1034.2 +013800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1034.2 +013900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1034.2 +014000 01 REC-CT PICTURE 99 VALUE ZERO. DB1034.2 +014100 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1034.2 +014200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1034.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1034.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1034.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1034.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1034.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1034.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1034.2 +014900 01 CCVS-H-1. DB1034.2 +015000 02 FILLER PICTURE X(27) VALUE SPACE. DB1034.2 +015100 02 FILLER PICTURE X(67) VALUE DB1034.2 +015200 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1034.2 +015300- " SYSTEM". DB1034.2 +015400 02 FILLER PICTURE X(26) VALUE SPACE. DB1034.2 +015500 01 CCVS-H-2. DB1034.2 +015600 02 FILLER PICTURE X(52) VALUE IS DB1034.2 +015700 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1034.2 +015800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1034.2 +015900 02 TEST-ID PICTURE IS X(9). DB1034.2 +016000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1034.2 +016100 01 CCVS-H-3. DB1034.2 +016200 02 FILLER PICTURE X(34) VALUE DB1034.2 +016300 " FOR OFFICIAL USE ONLY ". DB1034.2 +016400 02 FILLER PICTURE X(58) VALUE DB1034.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1034.2 +016600 02 FILLER PICTURE X(28) VALUE DB1034.2 +016700 " COPYRIGHT 1974 ". DB1034.2 +016800 01 CCVS-E-1. DB1034.2 +016900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1034.2 +017000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1034.2 +017100 02 ID-AGAIN PICTURE IS X(9). DB1034.2 +017200 02 FILLER PICTURE X(45) VALUE IS DB1034.2 +017300 " NTIS DISTRIBUTION COBOL 74". DB1034.2 +017400 01 CCVS-E-2. DB1034.2 +017500 02 FILLER PICTURE X(31) VALUE DB1034.2 +017600 SPACE. DB1034.2 +017700 02 FILLER PICTURE X(21) VALUE SPACE. DB1034.2 +017800 02 CCVS-E-2-2. DB1034.2 +017900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1034.2 +018000 03 FILLER PICTURE IS X VALUE IS SPACE. DB1034.2 +018100 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1034.2 +018200 01 CCVS-E-3. DB1034.2 +018300 02 FILLER PICTURE X(22) VALUE DB1034.2 +018400 " FOR OFFICIAL USE ONLY". DB1034.2 +018500 02 FILLER PICTURE X(12) VALUE SPACE. DB1034.2 +018600 02 FILLER PICTURE X(58) VALUE DB1034.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1034.2 +018800 02 FILLER PICTURE X(13) VALUE SPACE. DB1034.2 +018900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1034.2 +019000 01 CCVS-E-4. DB1034.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1034.2 +019200 02 FILLER PIC XXXX VALUE " OF ". DB1034.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1034.2 +019400 02 FILLER PIC X(40) VALUE DB1034.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". DB1034.2 +019600 01 XXINFO. DB1034.2 +019700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1034.2 +019800 02 INFO-TEXT. DB1034.2 +019900 04 FILLER PIC X(20) VALUE SPACE. DB1034.2 +020000 04 XXCOMPUTED PIC X(20). DB1034.2 +020100 04 FILLER PIC X(5) VALUE SPACE. DB1034.2 +020200 04 XXCORRECT PIC X(20). DB1034.2 +020300 01 HYPHEN-LINE. DB1034.2 +020400 02 FILLER PICTURE IS X VALUE IS SPACE. DB1034.2 +020500 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1034.2 +020600- "*****************************************". DB1034.2 +020700 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1034.2 +020800- "******************************". DB1034.2 +020900 01 CCVS-PGM-ID PIC X(6) VALUE DB1034.2 +021000 "DB103M". DB1034.2 +021100 PROCEDURE DIVISION. DB1034.2 +021200 DECLARATIVES. DB1034.2 +021300 START-UP SECTION. DB1034.2 +021400 USE FOR DEBUGGING ON OPEN-FILES. DB1034.2 +021500 BEGIN-START-UP. DB1034.2 +021600 MOVE 1 TO RESULT-FLAG. DB1034.2 +021700 DB-COMMON. DB1034.2 +021800 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1034.2 +021900 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1034.2 +022000 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1034.2 +022100 FALL-THROUGH-AND-SERIES SECTION. DB1034.2 +022200 USE FOR DEBUGGING ON FALL-THROUGH-TEST DB1034.2 +022300 PROC-SERIES-TEST. DB1034.2 +022400 BEGIN-FALL-THROUGH-AND-SERIES. DB1034.2 +022500 PERFORM DB-COMMON. DB1034.2 +022600 MOVE 2 TO RESULT-FLAG. DB1034.2 +022700 GO-TO SECTION. DB1034.2 +022800 USE FOR DEBUGGING ON GO-TO-TEST. DB1034.2 +022900 BEGIN-GO-TO. DB1034.2 +023000 PERFORM DB-COMMON. DB1034.2 +023100 MOVE 3 TO RESULT-FLAG. DB1034.2 +023200 ALTER-PARAGRAPH SECTION. DB1034.2 +023300 USE FOR DEBUGGING ON ALTERABLE-PARAGRAPH. DB1034.2 +023400 BEGIN-ALTER-PARAGRAPH. DB1034.2 +023500 PERFORM DB-COMMON. DB1034.2 +023600 MOVE 4 TO RESULT-FLAG. DB1034.2 +023700 LOOP-ITERATION SECTION. DB1034.2 +023800 USE FOR DEBUGGING ON LOOP-ROUTINE. DB1034.2 +023900 BEGIN-LOOP-ITERATION. DB1034.2 +024000 PERFORM DB-COMMON. DB1034.2 +024100 ADD 1 TO RESULT-FLAG. DB1034.2 +024200 PERFORM-THRU SECTION. DB1034.2 +024300 USE FOR DEBUGGING ON DO-NOTHING-1. DB1034.2 +024400 BEGIN-PERFORM-THRU. DB1034.2 +024500 PERFORM DB-COMMON. DB1034.2 +024600 ADD 1 TO RESULT-FLAG. DB1034.2 +024700 END DECLARATIVES. DB1034.2 +024800 CCVS1 SECTION. DB1034.2 +024900 OPEN-FILES. DB1034.2 +025000 OPEN OUTPUT PRINT-FILE. DB1034.2 +025100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1034.2 +025200 MOVE SPACE TO TEST-RESULTS. DB1034.2 +025300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1034.2 +025400 GO TO CCVS1-EXIT. DB1034.2 +025500 CLOSE-FILES. DB1034.2 +025600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1034.2 +025700 TERMINATE-CCVS. DB1034.2 +025800S EXIT PROGRAM. DB1034.2 +025900STERMINATE-CALL. DB1034.2 +026000 STOP RUN. DB1034.2 +026100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1034.2 +026200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1034.2 +026300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1034.2 +026400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1034.2 +026500 MOVE "****TEST DELETED****" TO RE-MARK. DB1034.2 +026600 PRINT-DETAIL. DB1034.2 +026700 IF REC-CT NOT EQUAL TO ZERO DB1034.2 +026800 MOVE "." TO PARDOT-X DB1034.2 +026900 MOVE REC-CT TO DOTVALUE. DB1034.2 +027000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1034.2 +027100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1034.2 +027200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1034.2 +027300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1034.2 +027400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1034.2 +027500 MOVE SPACE TO CORRECT-X. DB1034.2 +027600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1034.2 +027700 MOVE SPACE TO RE-MARK. DB1034.2 +027800 HEAD-ROUTINE. DB1034.2 +027900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1034.2 +028000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1034.2 +028100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1034.2 +028200 COLUMN-NAMES-ROUTINE. DB1034.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1034.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1034.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1034.2 +028600 END-ROUTINE. DB1034.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1034.2 +028800 END-RTN-EXIT. DB1034.2 +028900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1034.2 +029000 END-ROUTINE-1. DB1034.2 +029100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1034.2 +029200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1034.2 +029300 ADD PASS-COUNTER TO ERROR-HOLD. DB1034.2 +029400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1034.2 +029500 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1034.2 +029600 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1034.2 +029700 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1034.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1034.2 +029900 END-ROUTINE-12. DB1034.2 +030000 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1034.2 +030100 IF ERROR-COUNTER IS EQUAL TO ZERO DB1034.2 +030200 MOVE "NO " TO ERROR-TOTAL DB1034.2 +030300 ELSE DB1034.2 +030400 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1034.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1034.2 +030600 PERFORM WRITE-LINE. DB1034.2 +030700 END-ROUTINE-13. DB1034.2 +030800 IF DELETE-CNT IS EQUAL TO ZERO DB1034.2 +030900 MOVE "NO " TO ERROR-TOTAL ELSE DB1034.2 +031000 MOVE DELETE-CNT TO ERROR-TOTAL. DB1034.2 +031100 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1034.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1034.2 +031300 IF INSPECT-COUNTER EQUAL TO ZERO DB1034.2 +031400 MOVE "NO " TO ERROR-TOTAL DB1034.2 +031500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1034.2 +031600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1034.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1034.2 +031800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1034.2 +031900 WRITE-LINE. DB1034.2 +032000 ADD 1 TO RECORD-COUNT. DB1034.2 +032100Y IF RECORD-COUNT GREATER 50 DB1034.2 +032200Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1034.2 +032300Y MOVE SPACE TO DUMMY-RECORD DB1034.2 +032400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1034.2 +032500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1034.2 +032600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1034.2 +032700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1034.2 +032800Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1034.2 +032900Y MOVE ZERO TO RECORD-COUNT. DB1034.2 +033000 PERFORM WRT-LN. DB1034.2 +033100 WRT-LN. DB1034.2 +033200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1034.2 +033300 MOVE SPACE TO DUMMY-RECORD. DB1034.2 +033400 BLANK-LINE-PRINT. DB1034.2 +033500 PERFORM WRT-LN. DB1034.2 +033600 FAIL-ROUTINE. DB1034.2 +033700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1034.2 +033800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1034.2 +033900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1034.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1034.2 +034100 GO TO FAIL-ROUTINE-EX. DB1034.2 +034200 FAIL-ROUTINE-WRITE. DB1034.2 +034300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1034.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1034.2 +034500 FAIL-ROUTINE-EX. EXIT. DB1034.2 +034600 BAIL-OUT. DB1034.2 +034700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1034.2 +034800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1034.2 +034900 BAIL-OUT-WRITE. DB1034.2 +035000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1034.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1034.2 +035200 BAIL-OUT-EX. EXIT. DB1034.2 +035300 CCVS1-EXIT. DB1034.2 +035400 EXIT. DB1034.2 +035500 START-PROGRAM-TEST. DB1034.2 +035600 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +035700 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +035800 PERFORM FAIL DB1034.2 +035900 PERFORM START-PROGRAM-WRITE DB1034.2 +036000 ELSE PERFORM PASS DB1034.2 +036100 GO TO START-PROGRAM-WRITE. DB1034.2 +036200 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +036300 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +036400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +036500 PERFORM START-PROGRAM-WRITE. DB1034.2 +036600 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +036700 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +036800 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +036900 PERFORM START-PROGRAM-WRITE. DB1034.2 +037000 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +037100 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +037200 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +037300 GO TO START-PROGRAM-WRITE. DB1034.2 +037400 START-PROGRAM-DELETE. DB1034.2 +037500 PERFORM DE-LETE. DB1034.2 +037600 START-PROGRAM-WRITE. DB1034.2 +037700 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +037800 MOVE "START-PROGRAM-TEST" TO PAR-NAME. DB1034.2 +037900 PERFORM PRINT-DETAIL. DB1034.2 +038000 MOVE 0 TO RESULT-FLAG. DB1034.2 +038100 FALL-THROUGH-TEST. DB1034.2 +038200 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +038300 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +038400 PERFORM FAIL DB1034.2 +038500 PERFORM FALL-THROUGH-WRITE DB1034.2 +038600 ELSE PERFORM PASS DB1034.2 +038700 GO TO FALL-THROUGH-WRITE. DB1034.2 +038800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +038900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +039000 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +039100 PERFORM FALL-THROUGH-WRITE. DB1034.2 +039200 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +039300 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +039400 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +039500 PERFORM FALL-THROUGH-WRITE. DB1034.2 +039600 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +039700 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +039800 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +039900 GO TO FALL-THROUGH-WRITE. DB1034.2 +040000 FALL-THROUGH-DELETE. DB1034.2 +040100 PERFORM DE-LETE. DB1034.2 +040200 FALL-THROUGH-WRITE. DB1034.2 +040300 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +040400 MOVE "FALL-THROUGH-TEST" TO PAR-NAME. DB1034.2 +040500 PERFORM PRINT-DETAIL. DB1034.2 +040600 MOVE 0 TO RESULT-FLAG. DB1034.2 +040700 PROC-SERIES-TEST. DB1034.2 +040800 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +040900 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +041000 PERFORM FAIL DB1034.2 +041100 PERFORM PROC-SERIES-WRITE DB1034.2 +041200 ELSE PERFORM PASS DB1034.2 +041300 GO TO PROC-SERIES-WRITE. DB1034.2 +041400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +041500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +041600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +041700 PERFORM PROC-SERIES-WRITE. DB1034.2 +041800 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +041900 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +042000 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +042100 PERFORM PROC-SERIES-WRITE. DB1034.2 +042200 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +042300 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +042400 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +042500 GO TO PROC-SERIES-WRITE. DB1034.2 +042600 PROC-SERIES-DELETE. DB1034.2 +042700 PERFORM DE-LETE. DB1034.2 +042800 PROC-SERIES-WRITE. DB1034.2 +042900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +043000 MOVE "PROC-SERIES-TEST" TO PAR-NAME. DB1034.2 +043100 PERFORM PRINT-DETAIL. DB1034.2 +043200 MOVE 0 TO RESULT-FLAG. DB1034.2 +043300 ALTERABLE-PARAGRAPH. DB1034.2 +043400 GO TO GO-TO-TEST. DB1034.2 +043500 FILLER-PARAGRAPH. DB1034.2 +043600 DISPLAY "ALTER FAILED AT ALTER-TEST-INIT". DB1034.2 +043700 PERFORM FAIL. DB1034.2 +043800 GO TO ALTERED-GO-TO-TEST. DB1034.2 +043900 GO-TO-TEST. DB1034.2 +044000 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +044100 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +044200 PERFORM FAIL DB1034.2 +044300 PERFORM GO-TO-WRITE DB1034.2 +044400 ELSE PERFORM PASS DB1034.2 +044500 GO TO GO-TO-WRITE. DB1034.2 +044600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +044700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +044800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +044900 PERFORM GO-TO-WRITE. DB1034.2 +045000 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +045100 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +045200 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +045300 PERFORM GO-TO-WRITE. DB1034.2 +045400 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +045500 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +045600 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +045700 GO TO GO-TO-WRITE. DB1034.2 +045800 GO-TO-DELETE. DB1034.2 +045900 PERFORM DE-LETE. DB1034.2 +046000 GO-TO-WRITE. DB1034.2 +046100 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +046200 MOVE "GO-TO-TEST" TO PAR-NAME. DB1034.2 +046300 PERFORM PRINT-DETAIL. DB1034.2 +046400 MOVE 0 TO RESULT-FLAG. DB1034.2 +046500 ALTER-TEST-INIT. DB1034.2 +046600 ALTER ALTERABLE-PARAGRAPH TO PROCEED TO ALTERED-GO-TO-TEST. DB1034.2 +046700 ALTER-TEST. DB1034.2 +046800 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +046900 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +047000 PERFORM FAIL DB1034.2 +047100 PERFORM ALTER-WRITE DB1034.2 +047200 ELSE PERFORM PASS DB1034.2 +047300 GO TO ALTER-WRITE. DB1034.2 +047400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +047500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +047600 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +047700 PERFORM ALTER-WRITE. DB1034.2 +047800 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +047900 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +048000 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +048100 PERFORM ALTER-WRITE. DB1034.2 +048200 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +048300 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +048400 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +048500 GO TO ALTER-WRITE. DB1034.2 +048600 ALTER-DELETE. DB1034.2 +048700 PERFORM DE-LETE. DB1034.2 +048800 ALTER-WRITE. DB1034.2 +048900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +049000 MOVE "ALTER-TEST" TO PAR-NAME. DB1034.2 +049100 PERFORM PRINT-DETAIL. DB1034.2 +049200 MOVE 0 TO RESULT-FLAG. DB1034.2 +049300 ALTER-WRITE-END. DB1034.2 +049400 GO TO ALTERABLE-PARAGRAPH. DB1034.2 +049500 ALTERED-GO-TO-TEST. DB1034.2 +049600 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +049700 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +049800 PERFORM FAIL DB1034.2 +049900 PERFORM ALTERED-GO-TO-WRITE DB1034.2 +050000 ELSE PERFORM PASS DB1034.2 +050100 GO TO ALTERED-GO-TO-WRITE. DB1034.2 +050200 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +050300 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +050400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +050500 PERFORM ALTERED-GO-TO-WRITE. DB1034.2 +050600 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +050700 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +050800 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +050900 PERFORM ALTERED-GO-TO-WRITE. DB1034.2 +051000 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +051100 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +051200 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +051300 GO TO ALTERED-GO-TO-WRITE. DB1034.2 +051400 ALTERED-GO-TO-DELETE. DB1034.2 +051500 PERFORM DE-LETE. DB1034.2 +051600 ALTERED-GO-TO-WRITE. DB1034.2 +051700 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +051800 MOVE "ALTERED-GO-TO-TEST" TO PAR-NAME. DB1034.2 +051900 PERFORM PRINT-DETAIL. DB1034.2 +052000 MOVE 0 TO RESULT-FLAG. DB1034.2 +052100 PERF-ITERATION-TEST. DB1034.2 +052200 PERFORM LOOP-ROUTINE FIVE TIMES. DB1034.2 +052300 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +052400 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +052500 PERFORM FAIL DB1034.2 +052600 PERFORM PERF-ITERATION-WRITE DB1034.2 +052700 ELSE PERFORM PASS DB1034.2 +052800 GO TO PERF-ITERATION-WRITE. DB1034.2 +052900 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +053000 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +053100 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +053200 PERFORM PERF-ITERATION-WRITE. DB1034.2 +053300 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +053400 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +053500 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +053600 PERFORM PERF-ITERATION-WRITE. DB1034.2 +053700 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +053800 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +053900 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +054000 GO TO PERF-ITERATION-WRITE. DB1034.2 +054100 PERF-ITERATION-DELETE. DB1034.2 +054200 PERFORM DE-LETE. DB1034.2 +054300 PERF-ITERATION-WRITE. DB1034.2 +054400 MOVE "PERF-ITERATION-TEST" TO PAR-NAME. DB1034.2 +054500 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +054600 PERFORM PRINT-DETAIL. DB1034.2 +054700 MOVE 0 TO RESULT-FLAG. DB1034.2 +054800 PERF-ITERATION-END. DB1034.2 +054900 GO TO PERFORM-THRU-TEST. DB1034.2 +055000 LOOP-ROUTINE. DB1034.2 +055100**NESTED PERFORMS ARE USED HERE TO ATTEMPT TO PREVENT OPTIMIZER DB1034.2 +055200* ACTION RESULTING IN LOOP UNFOLDING AND REDUCTION. DB1034.2 +055300 PERFORM DO-NOTHING. DB1034.2 +055400 DO-NOTHING. DB1034.2 +055500 ADD A B C GIVING D. DB1034.2 +055600 DO-NOTHING-1. DB1034.2 +055700 SUBTRACT A FROM B. DB1034.2 +055800 PERFORM-THRU-TEST. DB1034.2 +055900 PERFORM DO-NOTHING THRU DO-NOTHING-1 FIVE TIMES. DB1034.2 +056000 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +056100 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +056200 PERFORM FAIL DB1034.2 +056300 PERFORM PERFORM-THRU-WRITE DB1034.2 +056400 ELSE PERFORM PASS DB1034.2 +056500 GO TO PERFORM-THRU-WRITE. DB1034.2 +056600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +056700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +056800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +056900 PERFORM PERFORM-THRU-WRITE. DB1034.2 +057000 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +057100 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +057200 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +057300 PERFORM PERFORM-THRU-WRITE. DB1034.2 +057400 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +057500 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +057600 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +057700 GO TO PERFORM-THRU-WRITE. DB1034.2 +057800 PERFORM-THRU-DELETE. DB1034.2 +057900 PERFORM DE-LETE. DB1034.2 +058000 PERFORM-THRU-WRITE. DB1034.2 +058100 MOVE "PERFORM-THRU-TEST" TO PAR-NAME. DB1034.2 +058200 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +058300 PERFORM PRINT-DETAIL. DB1034.2 +058400 MOVE 0 TO RESULT-FLAG. DB1034.2 +058500 SIMPLE-PERFORM-TEST. DB1034.2 +058600 PERFORM LOOP-ROUTINE. DB1034.2 +058700 IF RESULT-FLAG IS NOT EQUAL TO 0 DB1034.2 +058800 MOVE "USE PROCEDURE EXECUTED" TO RE-MARK DB1034.2 +058900 PERFORM FAIL DB1034.2 +059000 PERFORM SIMPLE-PERFORM-WRITE DB1034.2 +059100 ELSE PERFORM PASS DB1034.2 +059200 GO TO SIMPLE-PERFORM-WRITE. DB1034.2 +059300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB1034.2 +059400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1034.2 +059500 MOVE DBLINE-HOLD TO COMPUTED-A. DB1034.2 +059600 PERFORM SIMPLE-PERFORM-WRITE. DB1034.2 +059700 MOVE "DEBUG-NAME; SEE NEXT LINE" TO RE-MARK. DB1034.2 +059800 MOVE "<=== DEBUG-NAME" TO CORRECT-A. DB1034.2 +059900 MOVE DBNAME-HOLD TO COMPUTED-A. DB1034.2 +060000 PERFORM SIMPLE-PERFORM-WRITE. DB1034.2 +060100 MOVE "DEBUG-CONTENTS; SEE NEXT LINE" TO RE-MARK. DB1034.2 +060200 MOVE "<=== DEBUG-CONTENTS" TO CORRECT-A. DB1034.2 +060300 MOVE DBCONT-HOLD TO COMPUTED-A. DB1034.2 +060400 GO TO SIMPLE-PERFORM-WRITE. DB1034.2 +060500 SIMPLE-PERFORM-DELETE. DB1034.2 +060600 PERFORM DE-LETE. DB1034.2 +060700 SIMPLE-PERFORM-WRITE. DB1034.2 +060800 MOVE "SIMPLE-PERFORM-TEST" TO PAR-NAME. DB1034.2 +060900 MOVE "DEBUG ON PROC-NAME" TO FEATURE. DB1034.2 +061000 PERFORM PRINT-DETAIL. DB1034.2 +061100 MOVE 0 TO RESULT-FLAG. DB1034.2 +061200 DEBUG-LINE-TESTS-INIT. DB1034.2 +061300 MOVE "DEBUG LINE TESTS" TO FEATURE. DB1034.2 +061400 DEBUG-LINE-TEST-01. DB1034.2 +061500 MOVE "COMPLETE ENTITY" TO RE-MARK. DB1034.2 +061600 PERFORM PASS. DB1034.2 +061700D PERFORM FAIL. DB1034.2 +061800 GO TO DEBUG-LINE-WRITE-01. DB1034.2 +061900 DEBUG-LINE-DELETE-01. DB1034.2 +062000 PERFORM DE-LETE. DB1034.2 +062100 DEBUG-LINE-WRITE-01. DB1034.2 +062200 MOVE "DEBUG-LINE-TEST-01" TO PAR-NAME. DB1034.2 +062300 PERFORM PRINT-DETAIL. DB1034.2 +062400 DEBUG-LINE-TEST-02. DB1034.2 +062500 MOVE "CONSECUTIVE DEBUG LINES" TO RE-MARK. DB1034.2 +062600 PERFORM PASS. DB1034.2 +062700D PERFORM FAIL. DB1034.2 +062800D SUBTRACT 1 FROM D. DB1034.2 +062900 GO TO DEBUG-LINE-WRITE-02. DB1034.2 +063000 DEBUG-LINE-DELETE-02. DB1034.2 +063100 PERFORM DE-LETE. DB1034.2 +063200 DEBUG-LINE-WRITE-02. DB1034.2 +063300 MOVE "DEBUG-LINE-TEST-02" TO PAR-NAME. DB1034.2 +063400 PERFORM PRINT-DETAIL. DB1034.2 +063500 DEBUG-LINE-TEST-03. DB1034.2 +063600 MOVE "BROKEN STATEMENTS" TO RE-MARK. DB1034.2 +063700 PERFORM DB1034.2 +063800D FAIL. GO TO DEBUG-LINE-WRITE-03. DB1034.2 +063900DDEBUG-LINE-TEST-03A. PERFORM DB1034.2 +064000 PASS. DB1034.2 +064100 GO TO DEBUG-LINE-WRITE-03. DB1034.2 +064200 DEBUG-LINE-DELETE-03. DB1034.2 +064300 PERFORM DE-LETE. DB1034.2 +064400 DEBUG-LINE-WRITE-03. DB1034.2 +064500 MOVE "DEBUG-LINE-TEST-03" TO PAR-NAME. DB1034.2 +064600 PERFORM PRINT-DETAIL. DB1034.2 +064700 DEBUG-LINE-TEST-04. DB1034.2 +064800 MOVE "NESTED COMMENTS" TO RE-MARK. DB1034.2 +064900D PERFORM FAIL. DB1034.2 +065000* PERFORM FAIL. MOVE "COMMENTS EXECUTED" TO COMPUTED-A. DB1034.2 +065100* GO TO DEBUG-LINE-WRITE-04. DB1034.2 +065200*DEBUG-LINE-TEST-04-A. DB1034.2 +065300D GO TO DEBUG-LINE-WRITE-04. DB1034.2 +065400 DEBUG-LINE-TEST-04-B. DB1034.2 +065500 PERFORM PASS. DB1034.2 +065600 GO TO DEBUG-LINE-WRITE-04. DB1034.2 +065700 DEBUG-LINE-DELETE-04. DB1034.2 +065800 PERFORM DE-LETE. DB1034.2 +065900 DEBUG-LINE-WRITE-04. DB1034.2 +066000 MOVE "DEBUG-LINE-TEST-04" TO PAR-NAME. DB1034.2 +066100 PERFORM PRINT-DETAIL. DB1034.2 +066200 DEBUG-LINE-TEST-05. DB1034.2 +066300 MOVE "NESTED INSIDE COMMENTS" TO RE-MARK. DB1034.2 +066400* PERFORM FAIL. MOVE "COMMENTS EXECUTED" TO COMPUTED-A. DB1034.2 +066500* GO TO DEBUG-LINE-WRITE-05. DB1034.2 +066600DDEBUG-LINE-TEST-05-A. DB1034.2 +066700D PERFORM FAIL. DB1034.2 +066800D GO TO DEBUG-LINE-WRITE-05. DB1034.2 +066900*DEBUG-LINE-TEST-05-B. DB1034.2 +067000* MOVE " FAILURE 05B" TO COMPUTED-A. DB1034.2 +067100* PERFORM FAIL. GO TO DEBUG-LINE-WRITE-05. DB1034.2 +067200 DEBUG-LINE-TEST-05-C. DB1034.2 +067300 PERFORM PASS. DB1034.2 +067400 GO TO DEBUG-LINE-WRITE-05. DB1034.2 +067500 DEBUG-LINE-DELETE-05. DB1034.2 +067600 PERFORM DE-LETE. DB1034.2 +067700 DEBUG-LINE-WRITE-05. DB1034.2 +067800 MOVE "DEBUG-LINE-TEST-05" TO PAR-NAME. DB1034.2 +067900 PERFORM PRINT-DETAIL. DB1034.2 +068000 CCVS-EXIT SECTION. DB1034.2 +068100 CCVS-999999. DB1034.2 +068200 GO TO CLOSE-FILES. DB1034.2 +*END-OF,DB103M +*HEADER,COBOL,DB104A +000100 IDENTIFICATION DIVISION. DB1044.2 +000200 PROGRAM-ID. DB1044.2 +000300 DB104A. DB1044.2 +000400 AUTHOR. DB1044.2 +000500 FEDERAL COMPILER TESTING CENTER. DB1044.2 +000600 INSTALLATION. DB1044.2 +000700 GENERAL SERVICES ADMINISTRATION DB1044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB1044.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB1044.2 +001100 FALLS CHURCH VIRGINIA 22041. DB1044.2 +001200 DB1044.2 +001300 PHONE (703) 756-6153 DB1044.2 +001400 DB1044.2 +001500 " HIGH ". DB1044.2 +001600 DATE-WRITTEN. DB1044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1044.2 +001800 CREATION DATE / VALIDATION DATE DB1044.2 +001900 "4.2 ". DB1044.2 +002000 SECURITY. DB1044.2 +002100 NONE. DB1044.2 +002200* DB1044.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB1044.2 +002400* DB1044.2 +002500* PROGRAM ABSTRACT DB1044.2 +002600* DB1044.2 +002700* DB104A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE DB1044.2 +002800* PROCEDURES TIED TO SORT INPUT, SORT OUTPUT, AND FILE DB1044.2 +002900* DECLARATIVE PROCEDURES. THIS PROGRAM IS TO BE COMPILED AND DB1044.2 +003000* EXECUTED WITH BOTH COMPILE AND OBJECT TIME DEBUGGING DB1044.2 +003100* SWITCHES ENABLED. THE PROGRAM FIRST BUILDS A SEQUENTIAL DB1044.2 +003200* FILE CONTAINING 99 EIGHTY CHARACTER RECORDS. THIS FILE DB1044.2 +003300* IS THEN SORTED. DB1044.2 +003400* DB1044.2 +003500* ALL DEBUGGING PROCEDURES SHOULD BE INCLUDED IN COMPILATION DB1044.2 +003600* AND GENERATE CODE. BEFORE BEGINNING EXECUTION OF THE OBJECT DB1044.2 +003700* PROGRAM, THE JOB CONTROL LANGUAGE NECESSARY TO ACTIVATE DB1044.2 +003800* THE OBJECT TIME DEBUGGING SWITCH MUST BE SUBMITTED. DB1044.2 +003900* DB1044.2 +004000* EXECUTION OF THE PROGRAM"S SORT SHOULD TRIGGER DEBUGGING DB1044.2 +004100* PROCEDURES AT THE BEGINNING OF THE SORT INPUT AND SORT DB1044.2 +004200* OUTPUT PROCEDURES. DURING EXECUTION OF THE SORT INPUT DB1044.2 +004300* PROCEDURE, END-OF-FILE CONDITION ON THE INPUT FILE SHOULD DB1044.2 +004400* TRIGGER A DECLARATIVE PROCEDURE ASSOCIATED WITH THE FILE, DB1044.2 +004500* AND THIS IN TURN SHOULD CAUSE EXECUTION OF A DEBUGGING DB1044.2 +004600* PROCEDURE MONITORING THE FILE DECLARATIVE PROCEDURE. DB1044.2 +004700* DB1044.2 +004800* THE PERFORMANCE OF THE SORT VERB IS NOT CHECKED IN DB104. DB1044.2 +004900* DB1044.2 +005000* DB1044.2 +005100* DB1044.2 +005200 ENVIRONMENT DIVISION. DB1044.2 +005300 CONFIGURATION SECTION. DB1044.2 +005400 SOURCE-COMPUTER. DB1044.2 +005500 XXXXX082 DB1044.2 +005600 WITH DEBUGGING MODE. DB1044.2 +005700 OBJECT-COMPUTER. DB1044.2 +005800 XXXXX083. DB1044.2 +005900 INPUT-OUTPUT SECTION. DB1044.2 +006000 FILE-CONTROL. DB1044.2 +006100 SELECT PRINT-FILE ASSIGN TO DB1044.2 +006200 XXXXX055. DB1044.2 +006300 SELECT GEN-FILE ASSIGN TO DB1044.2 +006400 XXXXX014 DB1044.2 +006500 FILE STATUS IS GEN-STATUS. DB1044.2 +006600* XXXXX014 REPLACE WITH SEQUENTIAL ACCESS SCRATCH FILE NAME DB1044.2 +006700 SELECT SORT-FILE ASSIGN TO DB1044.2 +006800 XXXXX027. DB1044.2 +006900* XXXXX27 REPLACE WITH SORT FILE NAME DB1044.2 +007000 DATA DIVISION. DB1044.2 +007100 FILE SECTION. DB1044.2 +007200 FD PRINT-FILE DB1044.2 +007300 LABEL RECORDS DB1044.2 +007400 XXXXX084 DB1044.2 +007500 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1044.2 +007600 01 PRINT-REC PICTURE X(120). DB1044.2 +007700 01 DUMMY-RECORD PICTURE X(120). DB1044.2 +007800 FD GEN-FILE DB1044.2 +007900C VALUE OF DB1044.2 +008000C XXXXX074 DB1044.2 +008100* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB1044.2 +008200C IS DB1044.2 +008300C XXXXX075 DB1044.2 +008400* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB1044.2 +008500G XXXXX069 DB1044.2 +008600* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB1044.2 +008700 LABEL RECORD IS STANDARD. DB1044.2 +008800 01 GEN-REC PIC X(80). DB1044.2 +008900 SD SORT-FILE. DB1044.2 +009000 01 SORT-REC. DB1044.2 +009100 02 FILLER PIC X(34). DB1044.2 +009200 02 SORT-REC-NO PIC 9(6). DB1044.2 +009300 02 FILLER PIC X(40). DB1044.2 +009400 WORKING-STORAGE SECTION. DB1044.2 +009500 77 RESULT-FLAG PIC 99 COMP VALUE 0. DB1044.2 +009600 77 DBLINE-HOLD PIC X(6). DB1044.2 +009700 77 DBNAME-HOLD PIC X(30). DB1044.2 +009800 77 DBCONT-HOLD PIC X(30). DB1044.2 +009900 01 FILE-RECORD-INFORMATION-REC. DB1044.2 +010000 03 FILE-RECORD-INFO-SKELETON. DB1044.2 +010100 05 FILLER PICTURE X(48) VALUE DB1044.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB1044.2 +010300 05 FILLER PICTURE X(46) VALUE DB1044.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB1044.2 +010500 05 FILLER PICTURE X(26) VALUE DB1044.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". DB1044.2 +010700 05 FILLER PICTURE X(37) VALUE DB1044.2 +010800 ",RECKEY= ". DB1044.2 +010900 05 FILLER PICTURE X(38) VALUE DB1044.2 +011000 ",ALTKEY1= ". DB1044.2 +011100 05 FILLER PICTURE X(38) VALUE DB1044.2 +011200 ",ALTKEY2= ". DB1044.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.DB1044.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB1044.2 +011500 05 FILE-RECORD-INFO-P1-120. DB1044.2 +011600 07 FILLER PIC X(5). DB1044.2 +011700 07 XFILE-NAME PIC X(6). DB1044.2 +011800 07 FILLER PIC X(8). DB1044.2 +011900 07 XRECORD-NAME PIC X(6). DB1044.2 +012000 07 FILLER PIC X(1). DB1044.2 +012100 07 REELUNIT-NUMBER PIC 9(1). DB1044.2 +012200 07 FILLER PIC X(7). DB1044.2 +012300 07 XRECORD-NUMBER PIC 9(6). DB1044.2 +012400 07 FILLER PIC X(6). DB1044.2 +012500 07 UPDATE-NUMBER PIC 9(2). DB1044.2 +012600 07 FILLER PIC X(5). DB1044.2 +012700 07 ODO-NUMBER PIC 9(4). DB1044.2 +012800 07 FILLER PIC X(5). DB1044.2 +012900 07 XPROGRAM-NAME PIC X(5). DB1044.2 +013000 07 FILLER PIC X(7). DB1044.2 +013100 07 XRECORD-LENGTH PIC 9(6). DB1044.2 +013200 07 FILLER PIC X(7). DB1044.2 +013300 07 CHARS-OR-RECORDS PIC X(2). DB1044.2 +013400 07 FILLER PIC X(1). DB1044.2 +013500 07 XBLOCK-SIZE PIC 9(4). DB1044.2 +013600 07 FILLER PIC X(6). DB1044.2 +013700 07 RECORDS-IN-FILE PIC 9(6). DB1044.2 +013800 07 FILLER PIC X(5). DB1044.2 +013900 07 XFILE-ORGANIZATION PIC X(2). DB1044.2 +014000 07 FILLER PIC X(6). DB1044.2 +014100 07 XLABEL-TYPE PIC X(1). DB1044.2 +014200 05 FILE-RECORD-INFO-P121-240. DB1044.2 +014300 07 FILLER PIC X(8). DB1044.2 +014400 07 XRECORD-KEY PIC X(29). DB1044.2 +014500 07 FILLER PIC X(9). DB1044.2 +014600 07 ALTERNATE-KEY1 PIC X(29). DB1044.2 +014700 07 FILLER PIC X(9). DB1044.2 +014800 07 ALTERNATE-KEY2 PIC X(29). DB1044.2 +014900 07 FILLER PIC X(7). DB1044.2 +015000 01 GEN-STATUS. DB1044.2 +015100 02 END-FLAG PIC X. DB1044.2 +015200 02 FILLER PIC X. DB1044.2 +015300 01 SIZE-13. DB1044.2 +015400 02 FILLER PIC XX. DB1044.2 +015500 02 SIZE-11. DB1044.2 +015600 03 FILLER PIC X. DB1044.2 +015700 03 SIZE-10. DB1044.2 +015800 04 FILLER PIC XX. DB1044.2 +015900 04 SIZE-8. DB1044.2 +016000 05 FILLER PIC X. DB1044.2 +016100 05 SIZE-7 PIC X(7). DB1044.2 +016200 01 TEST-RESULTS. DB1044.2 +016300 02 FILLER PICTURE X VALUE SPACE. DB1044.2 +016400 02 FEATURE PICTURE X(20) VALUE SPACE. DB1044.2 +016500 02 FILLER PICTURE X VALUE SPACE. DB1044.2 +016600 02 P-OR-F PICTURE X(5) VALUE SPACE. DB1044.2 +016700 02 FILLER PICTURE X VALUE SPACE. DB1044.2 +016800 02 PAR-NAME. DB1044.2 +016900 03 FILLER PICTURE X(12) VALUE SPACE. DB1044.2 +017000 03 PARDOT-X PICTURE X VALUE SPACE. DB1044.2 +017100 03 DOTVALUE PICTURE 99 VALUE ZERO. DB1044.2 +017200 03 FILLER PIC X(5) VALUE SPACE. DB1044.2 +017300 02 FILLER PIC X(10) VALUE SPACE. DB1044.2 +017400 02 RE-MARK PIC X(61). DB1044.2 +017500 01 TEST-COMPUTED. DB1044.2 +017600 02 FILLER PIC X(30) VALUE SPACE. DB1044.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED=". DB1044.2 +017800 02 COMPUTED-X. DB1044.2 +017900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB1044.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB1044.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB1044.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB1044.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB1044.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. DB1044.2 +018500 04 COMPUTED-18V0 PICTURE -9(18). DB1044.2 +018600 04 FILLER PICTURE X. DB1044.2 +018700 03 FILLER PIC X(50) VALUE SPACE. DB1044.2 +018800 01 TEST-CORRECT. DB1044.2 +018900 02 FILLER PIC X(30) VALUE SPACE. DB1044.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". DB1044.2 +019100 02 CORRECT-X. DB1044.2 +019200 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB1044.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB1044.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB1044.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB1044.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB1044.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. DB1044.2 +019800 04 CORRECT-18V0 PICTURE -9(18). DB1044.2 +019900 04 FILLER PICTURE X. DB1044.2 +020000 03 FILLER PIC X(50) VALUE SPACE. DB1044.2 +020100 01 CCVS-C-1. DB1044.2 +020200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB1044.2 +020300- "SS PARAGRAPH-NAME DB1044.2 +020400- " REMARKS". DB1044.2 +020500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB1044.2 +020600 01 CCVS-C-2. DB1044.2 +020700 02 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2 +020800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1044.2 +020900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB1044.2 +021000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1044.2 +021100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB1044.2 +021200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1044.2 +021300 01 REC-CT PICTURE 99 VALUE ZERO. DB1044.2 +021400 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1044.2 +021500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1044.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1044.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1044.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1044.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1044.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1044.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1044.2 +022200 01 CCVS-H-1. DB1044.2 +022300 02 FILLER PICTURE X(27) VALUE SPACE. DB1044.2 +022400 02 FILLER PICTURE X(67) VALUE DB1044.2 +022500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1044.2 +022600- " SYSTEM". DB1044.2 +022700 02 FILLER PICTURE X(26) VALUE SPACE. DB1044.2 +022800 01 CCVS-H-2. DB1044.2 +022900 02 FILLER PICTURE X(52) VALUE IS DB1044.2 +023000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1044.2 +023100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1044.2 +023200 02 TEST-ID PICTURE IS X(9). DB1044.2 +023300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1044.2 +023400 01 CCVS-H-3. DB1044.2 +023500 02 FILLER PICTURE X(34) VALUE DB1044.2 +023600 " FOR OFFICIAL USE ONLY ". DB1044.2 +023700 02 FILLER PICTURE X(58) VALUE DB1044.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1044.2 +023900 02 FILLER PICTURE X(28) VALUE DB1044.2 +024000 " COPYRIGHT 1974 ". DB1044.2 +024100 01 CCVS-E-1. DB1044.2 +024200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1044.2 +024300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1044.2 +024400 02 ID-AGAIN PICTURE IS X(9). DB1044.2 +024500 02 FILLER PICTURE X(45) VALUE IS DB1044.2 +024600 " NTIS DISTRIBUTION COBOL 74". DB1044.2 +024700 01 CCVS-E-2. DB1044.2 +024800 02 FILLER PICTURE X(31) VALUE DB1044.2 +024900 SPACE. DB1044.2 +025000 02 FILLER PICTURE X(21) VALUE SPACE. DB1044.2 +025100 02 CCVS-E-2-2. DB1044.2 +025200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1044.2 +025300 03 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2 +025400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1044.2 +025500 01 CCVS-E-3. DB1044.2 +025600 02 FILLER PICTURE X(22) VALUE DB1044.2 +025700 " FOR OFFICIAL USE ONLY". DB1044.2 +025800 02 FILLER PICTURE X(12) VALUE SPACE. DB1044.2 +025900 02 FILLER PICTURE X(58) VALUE DB1044.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1044.2 +026100 02 FILLER PICTURE X(13) VALUE SPACE. DB1044.2 +026200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1044.2 +026300 01 CCVS-E-4. DB1044.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1044.2 +026500 02 FILLER PIC XXXX VALUE " OF ". DB1044.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1044.2 +026700 02 FILLER PIC X(40) VALUE DB1044.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". DB1044.2 +026900 01 XXINFO. DB1044.2 +027000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1044.2 +027100 02 INFO-TEXT. DB1044.2 +027200 04 FILLER PIC X(20) VALUE SPACE. DB1044.2 +027300 04 XXCOMPUTED PIC X(20). DB1044.2 +027400 04 FILLER PIC X(5) VALUE SPACE. DB1044.2 +027500 04 XXCORRECT PIC X(20). DB1044.2 +027600 01 HYPHEN-LINE. DB1044.2 +027700 02 FILLER PICTURE IS X VALUE IS SPACE. DB1044.2 +027800 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1044.2 +027900- "*****************************************". DB1044.2 +028000 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1044.2 +028100- "******************************". DB1044.2 +028200 01 CCVS-PGM-ID PIC X(6) VALUE DB1044.2 +028300 "DB104A". DB1044.2 +028400 PROCEDURE DIVISION. DB1044.2 +028500 DECLARATIVES. DB1044.2 +028600 SORT-IN-PROC SECTION. DB1044.2 +028700 USE FOR DEBUGGING ON SORT-IN. DB1044.2 +028800 BEGIN-SORT-IN-PROC. DB1044.2 +028900 MOVE 1 TO RESULT-FLAG. DB1044.2 +029000 DB-COMMON. DB1044.2 +029100 MOVE DEBUG-LINE TO DBLINE-HOLD. DB1044.2 +029200 MOVE DEBUG-NAME TO DBNAME-HOLD. DB1044.2 +029300 MOVE DEBUG-CONTENTS TO DBCONT-HOLD. DB1044.2 +029400 SORT-OUT-PROC SECTION. DB1044.2 +029500 USE FOR DEBUGGING ON SORT-OUT. DB1044.2 +029600 BEGIN-SORT-OUT-PROC. DB1044.2 +029700 MOVE 2 TO RESULT-FLAG. DB1044.2 +029800 PERFORM DB-COMMON. DB1044.2 +029900 USE-PROC SECTION. DB1044.2 +030000 USE FOR DEBUGGING ON AT-END-PROC. DB1044.2 +030100 BEGIN-USE-PROC. DB1044.2 +030200 ADD 3 TO RESULT-FLAG. DB1044.2 +030300 PERFORM DB-COMMON. DB1044.2 +030400 AT-END-PROC SECTION. DB1044.2 +030500 USE AFTER ERROR PROCEDURE ON GEN-FILE. DB1044.2 +030600 BEGIN-AT-END-PROC. DB1044.2 +030700 ADD 4 TO RESULT-FLAG. DB1044.2 +030800 END DECLARATIVES. DB1044.2 +030900 CCVS1 SECTION. DB1044.2 +031000 OPEN-FILES. DB1044.2 +031100 OPEN OUTPUT PRINT-FILE. DB1044.2 +031200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1044.2 +031300 MOVE SPACE TO TEST-RESULTS. DB1044.2 +031400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1044.2 +031500 GO TO CCVS1-EXIT. DB1044.2 +031600 CLOSE-FILES. DB1044.2 +031700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1044.2 +031800 TERMINATE-CCVS. DB1044.2 +031900S EXIT PROGRAM. DB1044.2 +032000STERMINATE-CALL. DB1044.2 +032100 STOP RUN. DB1044.2 +032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2 +032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2 +032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2 +032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2 +032600 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2 +032700 PRINT-DETAIL. DB1044.2 +032800 IF REC-CT NOT EQUAL TO ZERO DB1044.2 +032900 MOVE "." TO PARDOT-X DB1044.2 +033000 MOVE REC-CT TO DOTVALUE. DB1044.2 +033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1044.2 +033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB1044.2 +033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB1044.2 +033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB1044.2 +033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2 +033600 MOVE SPACE TO CORRECT-X. DB1044.2 +033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2 +033800 MOVE SPACE TO RE-MARK. DB1044.2 +033900 HEAD-ROUTINE. DB1044.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2 +034100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1044.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1044.2 +034300 COLUMN-NAMES-ROUTINE. DB1044.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2 +034700 END-ROUTINE. DB1044.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1044.2 +034900 END-RTN-EXIT. DB1044.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2 +035100 END-ROUTINE-1. DB1044.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1044.2 +035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1044.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. DB1044.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1044.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1044.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1044.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1044.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1044.2 +036000 END-ROUTINE-12. DB1044.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1044.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO DB1044.2 +036300 MOVE "NO " TO ERROR-TOTAL DB1044.2 +036400 ELSE DB1044.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1044.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1044.2 +036700 PERFORM WRITE-LINE. DB1044.2 +036800 END-ROUTINE-13. DB1044.2 +036900 IF DELETE-CNT IS EQUAL TO ZERO DB1044.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE DB1044.2 +037100 MOVE DELETE-CNT TO ERROR-TOTAL. DB1044.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1044.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO DB1044.2 +037500 MOVE "NO " TO ERROR-TOTAL DB1044.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1044.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1044.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1044.2 +038000 WRITE-LINE. DB1044.2 +038100 ADD 1 TO RECORD-COUNT. DB1044.2 +038200Y IF RECORD-COUNT GREATER 50 DB1044.2 +038300Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2 +038400Y MOVE SPACE TO DUMMY-RECORD DB1044.2 +038500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2 +038600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB1044.2 +038700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB1044.2 +038800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1044.2 +038900Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2 +039000Y MOVE ZERO TO RECORD-COUNT. DB1044.2 +039100 PERFORM WRT-LN. DB1044.2 +039200 WRT-LN. DB1044.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2 +039400 MOVE SPACE TO DUMMY-RECORD. DB1044.2 +039500 BLANK-LINE-PRINT. DB1044.2 +039600 PERFORM WRT-LN. DB1044.2 +039700 FAIL-ROUTINE. DB1044.2 +039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1044.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB1044.2 +040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2 +040200 GO TO FAIL-ROUTINE-EX. DB1044.2 +040300 FAIL-ROUTINE-WRITE. DB1044.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB1044.2 +040500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB1044.2 +040600 FAIL-ROUTINE-EX. EXIT. DB1044.2 +040700 BAIL-OUT. DB1044.2 +040800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB1044.2 +040900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB1044.2 +041000 BAIL-OUT-WRITE. DB1044.2 +041100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2 +041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1044.2 +041300 BAIL-OUT-EX. EXIT. DB1044.2 +041400 CCVS1-EXIT. DB1044.2 +041500 EXIT. DB1044.2 +041600 BEGIN-FILE-GENERATION. DB1044.2 +041700 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). DB1044.2 +041800 MOVE "GEN-FI" TO XFILE-NAME (1). DB1044.2 +041900 MOVE "GEN-RE" TO XRECORD-NAME (1). DB1044.2 +042000 MOVE "DB104A" TO XPROGRAM-NAME (1). DB1044.2 +042100 MOVE 80 TO XRECORD-LENGTH (1). DB1044.2 +042200 OPEN OUTPUT GEN-FILE. DB1044.2 +042300 MOVE 99 TO XRECORD-NUMBER (1). DB1044.2 +042400 GEN-LOOP. DB1044.2 +042500 MOVE FILE-RECORD-INFO (1) TO GEN-REC. DB1044.2 +042600 WRITE GEN-REC. DB1044.2 +042700 IF XRECORD-NUMBER (1) IS GREATER THAN 5 DB1044.2 +042800 SUBTRACT 5 FROM XRECORD-NUMBER (1) DB1044.2 +042900 GO TO GEN-LOOP. DB1044.2 +043000 END-OF-GEN-LOOP. DB1044.2 +043100 MOVE 98 TO XRECORD-NUMBER (1). DB1044.2 +043200 PERFORM GEN-LOOP. DB1044.2 +043300 MOVE 97 TO XRECORD-NUMBER (1). DB1044.2 +043400 PERFORM GEN-LOOP. DB1044.2 +043500 MOVE 96 TO XRECORD-NUMBER (1). DB1044.2 +043600 PERFORM GEN-LOOP. DB1044.2 +043700 MOVE 95 TO XRECORD-NUMBER (1). DB1044.2 +043800 PERFORM GEN-LOOP. DB1044.2 +043900 CLOSE GEN-FILE. DB1044.2 +044000******************************************************************DB1044.2 +044100* THE DEBUG-LINE (INSPT) SUBTESTS FOR THE TESTS NAMED IN THE *DB1044.2 +044200* OUTPUT REPORT AS "SORT-IN-2" AND "SORT-OUT-2" SHOULD POINT *DB1044.2 +044300* TO THE "SORT" STATEMENT WHICH APPEARS IN THE PARAGRAPH *DB1044.2 +044400* BELOW NAMED "BEGIN-TESTS". *DB1044.2 +044500******************************************************************DB1044.2 +044600 BEGIN-TESTS. DB1044.2 +044700 MOVE 0 TO RESULT-FLAG. DB1044.2 +044800 SORT SORT-FILE ON ASCENDING KEY SORT-REC-NO DB1044.2 +044900 INPUT PROCEDURE IS SORT-IN DB1044.2 +045000 OUTPUT PROCEDURE IS SORT-OUT. DB1044.2 +045100 GO TO AFTER-SORT. DB1044.2 +045200 SORT-IN SECTION. DB1044.2 +045300 SORT-IN-1. DB1044.2 +045400 MOVE "SORT-IN-1" TO PAR-NAME. DB1044.2 +045500 IF RESULT-FLAG IS NOT EQUAL TO 1 DB1044.2 +045600 MOVE "DEBUG PROCEDURE NOT EXECUTED" TO RE-MARK DB1044.2 +045700 PERFORM FAIL-1 DB1044.2 +045800 PERFORM SORT-IN-WRITE DB1044.2 +045900 GO TO SORT-IN-5 DB1044.2 +046000 ELSE PERFORM PASS-1 DB1044.2 +046100 MOVE "DEBUG PROCEDURE EXECUTED" TO RE-MARK. DB1044.2 +046200 PERFORM SORT-IN-WRITE. DB1044.2 +046300 GO TO SORT-IN-2. DB1044.2 +046400 SORT-IN-DELETE. DB1044.2 +046500 MOVE "SORT-IN" TO PAR-NAME. DB1044.2 +046600 PERFORM DE-LETE-1. DB1044.2 +046700 PERFORM SORT-IN-WRITE. DB1044.2 +046800 GO TO SORT-IN-5. DB1044.2 +046900 SORT-IN-WRITE. DB1044.2 +047000 MOVE "DEBUG SORT INPUT" TO FEATURE. DB1044.2 +047100 PERFORM PRINT-DETAIL-1. DB1044.2 +047200 SORT-IN-2. DB1044.2 +047300 MOVE "SORT-IN-2" TO PAR-NAME. DB1044.2 +047400 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2 +047500 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2 +047600 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2 +047700 PERFORM INSPT-1. DB1044.2 +047800 PERFORM SORT-IN-WRITE. DB1044.2 +047900 SORT-IN-3. DB1044.2 +048000 MOVE DBNAME-HOLD TO SIZE-7. DB1044.2 +048100 IF SIZE-7 IS EQUAL TO "SORT-IN" DB1044.2 +048200 PERFORM PASS-1 ELSE DB1044.2 +048300 MOVE "SORT-IN" TO CORRECT-A DB1044.2 +048400 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2 +048500 PERFORM FAIL-1. DB1044.2 +048600 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2 +048700 MOVE "SORT-IN-3" TO PAR-NAME. DB1044.2 +048800 PERFORM SORT-IN-WRITE. DB1044.2 +048900 SORT-IN-4. DB1044.2 +049000 MOVE DBCONT-HOLD TO SIZE-10. DB1044.2 +049100 IF SIZE-10 IS EQUAL TO "SORT INPUT" DB1044.2 +049200 PERFORM PASS-1 ELSE DB1044.2 +049300 MOVE "SORT INPUT" TO CORRECT-A DB1044.2 +049400 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2 +049500 PERFORM FAIL-1. DB1044.2 +049600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2 +049700 MOVE "SORT-IN-4" TO PAR-NAME. DB1044.2 +049800 PERFORM SORT-IN-WRITE. DB1044.2 +049900 SORT-IN-5. DB1044.2 +050000 OPEN INPUT GEN-FILE. DB1044.2 +050100 MOVE 0 TO RESULT-FLAG. DB1044.2 +050200******************************************************************DB1044.2 +050300* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB1044.2 +050400* OUTPUT REPORT AS "SORT-USE-TEST" SHOULD POINT TO THE *DB1044.2 +050500* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB1044.2 +050600* WHICH READS, "READ GEN-FILE". *DB1044.2 +050700******************************************************************DB1044.2 +050800 SORT-USE-TEST. DB1044.2 +050900 READ GEN-FILE DB1044.2 +051000* AT END GO TO SORT-USE-DELETE. DB1044.2 +051100* DB1044.2 +051200* IN CASE IMPLEMENTATION FAILS TO NOTIFY PROGRAM OF DB1044.2 +051300* END-OF-FILE VIA STATUS OR DECLARATIVE PROC, REMOVE ASTERISK DB1044.2 +051400* FROM THE FIRST OF THESE COMMENT LINES AND PERMIT THE AT END DB1044.2 +051500* CLAUSE TO BE COMPILED; THIS WILL RESULT IN TEST DELETION. DB1044.2 +051600* DB1044.2 +051700 IF RESULT-FLAG IS EQUAL TO 3 DB1044.2 +051800 CLOSE GEN-FILE GO TO SORT-USE-1. DB1044.2 +051900 IF RESULT-FLAG IS EQUAL TO 4 DB1044.2 +052000 CLOSE GEN-FILE GO TO SORT-USE-3. DB1044.2 +052100 IF RESULT-FLAG IS EQUAL TO 7 DB1044.2 +052200 CLOSE GEN-FILE DB1044.2 +052300 PERFORM PASS-1 DB1044.2 +052400 MOVE "BOTH PROCEDURES EXECUTED" TO RE-MARK DB1044.2 +052500 PERFORM SORT-USE-WRITE DB1044.2 +052600 GO TO SORT-USE-2. DB1044.2 +052700 IF END-FLAG IS EQUAL TO "1" DB1044.2 +052800 CLOSE GEN-FILE GO TO SORT-USE-4. DB1044.2 +052900 RELEASE SORT-REC FROM GEN-REC. DB1044.2 +053000 GO TO SORT-USE-TEST. DB1044.2 +053100 SORT-USE-DELETE. DB1044.2 +053200 CLOSE GEN-FILE. DB1044.2 +053300 PERFORM DE-LETE-1. DB1044.2 +053400 GO TO SORT-USE-WRITE. DB1044.2 +053500 SORT-USE-1. DB1044.2 +053600 MOVE "ERROR PROCEDURE NOT COMPLETED" TO RE-MARK. DB1044.2 +053700 PERFORM SORT-USE-WRITE. DB1044.2 +053800 SORT-USE-2. DB1044.2 +053900 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2 +054000 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2 +054100 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2 +054200 PERFORM INSPT-1. DB1044.2 +054300 PERFORM SORT-USE-WRITE. DB1044.2 +054400 MOVE DBNAME-HOLD TO SIZE-11. DB1044.2 +054500 IF SIZE-11 IS EQUAL TO "AT-END-PROC" DB1044.2 +054600 PERFORM PASS-1 ELSE DB1044.2 +054700 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2 +054800 MOVE "AT-END-PROC" TO CORRECT-A DB1044.2 +054900 PERFORM FAIL-1. DB1044.2 +055000 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2 +055100 PERFORM SORT-USE-WRITE. DB1044.2 +055200 MOVE DBCONT-HOLD TO SIZE-13. DB1044.2 +055300 IF SIZE-13 IS EQUAL TO "USE PROCEDURE" DB1044.2 +055400 PERFORM PASS-1 ELSE DB1044.2 +055500 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2 +055600 MOVE "USE PROCEDURE" TO CORRECT-A DB1044.2 +055700 PERFORM FAIL-1. DB1044.2 +055800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2 +055900 GO TO SORT-USE-WRITE. DB1044.2 +056000 SORT-USE-3. DB1044.2 +056100 MOVE "DEBUG ON USE PROC NOT EXECUTED" TO RE-MARK. DB1044.2 +056200 PERFORM FAIL-1. DB1044.2 +056300 GO TO SORT-USE-WRITE. DB1044.2 +056400 SORT-USE-4. DB1044.2 +056500 MOVE "DEBUG AND USE PROCS BOTH FAIL" TO RE-MARK. DB1044.2 +056600 PERFORM FAIL-1. DB1044.2 +056700 SORT-USE-WRITE. DB1044.2 +056800 MOVE "SORT-USE-TEST" TO PAR-NAME. DB1044.2 +056900 MOVE "DEBUG USE PROC" TO FEATURE. DB1044.2 +057000 PERFORM PRINT-DETAIL-1. DB1044.2 +057100 SORT-USE-DONE. DB1044.2 +057200 GO TO SORT-IN-EXIT. DB1044.2 +057300 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2 +057400 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2 +057500 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2 +057600 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2 +057700 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2 +057800 PRINT-DETAIL-1. DB1044.2 +057900 IF REC-CT NOT EQUAL TO ZERO DB1044.2 +058000 MOVE "." TO PARDOT-X DB1044.2 +058100 MOVE REC-CT TO DOTVALUE. DB1044.2 +058200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. DB1044.2 +058300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 DB1044.2 +058400 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 DB1044.2 +058500 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. DB1044.2 +058600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2 +058700 MOVE SPACE TO CORRECT-X. DB1044.2 +058800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2 +058900 MOVE SPACE TO RE-MARK. DB1044.2 +059000 WRITE-LINE-1. DB1044.2 +059100 ADD 1 TO RECORD-COUNT. DB1044.2 +059200Y IF RECORD-COUNT GREATER 50 DB1044.2 +059300Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2 +059400Y MOVE SPACE TO DUMMY-RECORD DB1044.2 +059500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2 +059600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 DB1044.2 +059700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES DB1044.2 +059800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 DB1044.2 +059900Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2 +060000Y MOVE ZERO TO RECORD-COUNT. DB1044.2 +060100 PERFORM WRT-LN-1. DB1044.2 +060200 WRT-LN-1. DB1044.2 +060300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2 +060400 MOVE SPACE TO DUMMY-RECORD. DB1044.2 +060500 BLANK-LINE-PRINT-1. DB1044.2 +060600 PERFORM WRT-LN-1. DB1044.2 +060700 FAIL-ROUTINE-1. DB1044.2 +060800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. DB1044.2 +060900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. DB1044.2 +061000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2 +061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. DB1044.2 +061200 GO TO FAIL-ROUTINE-EX-1. DB1044.2 +061300 FAIL-RTN-WRITE-1. DB1044.2 +061400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 DB1044.2 +061500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. DB1044.2 +061600 FAIL-ROUTINE-EX-1. EXIT. DB1044.2 +061700 BAIL-OUT-1. DB1044.2 +061800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. DB1044.2 +061900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. DB1044.2 +062000 BAIL-OUT-WRITE-1. DB1044.2 +062100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2 +062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. DB1044.2 +062300 BAIL-OUT-EX-1. EXIT. DB1044.2 +062400 SORT-IN-EXIT. DB1044.2 +062500 MOVE 0 TO RESULT-FLAG. DB1044.2 +062600 SORT-OUT SECTION. DB1044.2 +062700 SORT-OUT-1. DB1044.2 +062800 MOVE "SORT-OUT-1" TO PAR-NAME. DB1044.2 +062900 IF RESULT-FLAG IS NOT EQUAL TO 2 DB1044.2 +063000 PERFORM FAIL-2 DB1044.2 +063100 MOVE "DEBUG PROCEDURE NOT EXECUTED" TO RE-MARK DB1044.2 +063200 GO TO SORT-OUT-WRITE. DB1044.2 +063300 PERFORM PASS-2. DB1044.2 +063400 MOVE "DEBUG PROCEDURE EXECUTED" TO RE-MARK. DB1044.2 +063500 PERFORM SORT-OUT-WRITE. DB1044.2 +063600 SORT-OUT-2. DB1044.2 +063700 MOVE "SORT-OUT-2" TO PAR-NAME. DB1044.2 +063800 MOVE DBLINE-HOLD TO COMPUTED-A. DB1044.2 +063900 MOVE "DEBUG-LINE, SEE NEXT LINE" TO RE-MARK. DB1044.2 +064000 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB1044.2 +064100 PERFORM INSPT-2. DB1044.2 +064200 PERFORM SORT-OUT-WRITE. DB1044.2 +064300 SORT-OUT-3. DB1044.2 +064400 MOVE "SORT-OUT-3" TO PAR-NAME. DB1044.2 +064500 MOVE DBNAME-HOLD TO SIZE-8. DB1044.2 +064600 IF SIZE-8 IS EQUAL TO "SORT-OUT" DB1044.2 +064700 PERFORM PASS-2 ELSE DB1044.2 +064800 MOVE "SORT-OUT" TO CORRECT-A DB1044.2 +064900 MOVE DBNAME-HOLD TO COMPUTED-A DB1044.2 +065000 PERFORM FAIL-2. DB1044.2 +065100 MOVE "DEBUG-NAME" TO RE-MARK. DB1044.2 +065200 PERFORM SORT-OUT-WRITE. DB1044.2 +065300 SORT-OUT-4. DB1044.2 +065400 MOVE "SORT-OUT-4" TO PAR-NAME. DB1044.2 +065500 MOVE DBCONT-HOLD TO SIZE-11. DB1044.2 +065600 IF SIZE-11 IS EQUAL TO "SORT OUTPUT" DB1044.2 +065700 PERFORM PASS-2 ELSE DB1044.2 +065800 MOVE "SORT OUTPUT" TO CORRECT-A DB1044.2 +065900 MOVE DBCONT-HOLD TO COMPUTED-A DB1044.2 +066000 PERFORM FAIL-2. DB1044.2 +066100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB1044.2 +066200 GO TO SORT-OUT-WRITE. DB1044.2 +066300 SORT-OUT-DELETE. DB1044.2 +066400 MOVE "SORT-OUT" TO PAR-NAME. DB1044.2 +066500 PERFORM DE-LETE-2. DB1044.2 +066600 SORT-OUT-WRITE. DB1044.2 +066700 MOVE "DEBUG SORT OUTPUT" TO FEATURE. DB1044.2 +066800 PERFORM PRINT-DETAIL-2. DB1044.2 +066900 SORT-OUT-5. DB1044.2 +067000 OPEN OUTPUT GEN-FILE. DB1044.2 +067100 SORT-OUT-6. DB1044.2 +067200 RETURN SORT-FILE INTO GEN-REC DB1044.2 +067300 AT END GO TO SORT-OUT-EXIT. DB1044.2 +067400 WRITE GEN-REC. DB1044.2 +067500 GO TO SORT-OUT-6. DB1044.2 +067600 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1044.2 +067700 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1044.2 +067800 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1044.2 +067900 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1044.2 +068000 MOVE "****TEST DELETED****" TO RE-MARK. DB1044.2 +068100 PRINT-DETAIL-2. DB1044.2 +068200 IF REC-CT NOT EQUAL TO ZERO DB1044.2 +068300 MOVE "." TO PARDOT-X DB1044.2 +068400 MOVE REC-CT TO DOTVALUE. DB1044.2 +068500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. DB1044.2 +068600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 DB1044.2 +068700 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 DB1044.2 +068800 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. DB1044.2 +068900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB1044.2 +069000 MOVE SPACE TO CORRECT-X. DB1044.2 +069100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1044.2 +069200 MOVE SPACE TO RE-MARK. DB1044.2 +069300 WRITE-LINE-2. DB1044.2 +069400 ADD 1 TO RECORD-COUNT. DB1044.2 +069500Y IF RECORD-COUNT GREATER 50 DB1044.2 +069600Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1044.2 +069700Y MOVE SPACE TO DUMMY-RECORD DB1044.2 +069800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1044.2 +069900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 DB1044.2 +070000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES DB1044.2 +070100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 DB1044.2 +070200Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1044.2 +070300Y MOVE ZERO TO RECORD-COUNT. DB1044.2 +070400 PERFORM WRT-LN-2. DB1044.2 +070500 WRT-LN-2. DB1044.2 +070600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1044.2 +070700 MOVE SPACE TO DUMMY-RECORD. DB1044.2 +070800 BLANK-LINE-PRINT-2. DB1044.2 +070900 PERFORM WRT-LN-2. DB1044.2 +071000 FAIL-ROUTINE-2. DB1044.2 +071100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. DB1044.2 +071200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. DB1044.2 +071300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB1044.2 +071400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. DB1044.2 +071500 GO TO FAIL-ROUTINE-EX-2. DB1044.2 +071600 FAIL-RTN-WRITE-2. DB1044.2 +071700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 DB1044.2 +071800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. DB1044.2 +071900 FAIL-ROUTINE-EX-2. EXIT. DB1044.2 +072000 BAIL-OUT-2. DB1044.2 +072100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. DB1044.2 +072200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. DB1044.2 +072300 BAIL-OUT-WRITE-2. DB1044.2 +072400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB1044.2 +072500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. DB1044.2 +072600 BAIL-OUT-EX-2. EXIT. DB1044.2 +072700 SORT-OUT-EXIT. DB1044.2 +072800 CLOSE GEN-FILE. DB1044.2 +072900 MOVE 0 TO RESULT-FLAG. DB1044.2 +073000 END-OF-SORT SECTION. DB1044.2 +073100 AFTER-SORT. DB1044.2 +073200 EXIT. DB1044.2 +073300XDUMP-CODING SECTION. DB1044.2 +073400XBEGIN-DUMP. DB1044.2 +073500X OPEN INPUT GEN-FILE. DB1044.2 +073600X PERFORM BLANK-LINE-PRINT. DB1044.2 +073700X MOVE " DUMP OF GEN-FILE FOLLOWS:" TO PRINT-REC. DB1044.2 +073800X PERFORM WRITE-LINE. DB1044.2 +073900XDUMP-FILE-1. DB1044.2 +074000X READ GEN-FILE AT END GO TO DUMP-FILE-2. DB1044.2 +074100X MOVE GEN-REC TO PRINT-REC. DB1044.2 +074200X PERFORM WRITE-LINE. DB1044.2 +074300X GO TO DUMP-FILE-1. DB1044.2 +074400XDUMP-FILE-2. DB1044.2 +074500X CLOSE GEN-FILE. DB1044.2 +074600 CCVS-EXIT SECTION. DB1044.2 +074700 CCVS-999999. DB1044.2 +074800 GO TO CLOSE-FILES. DB1044.2 +*END-OF,DB104A +*HEADER,COBOL,DB105A +000100 IDENTIFICATION DIVISION. DB1054.2 +000200 PROGRAM-ID. DB1054.2 +000300 DB105A. DB1054.2 +000400 AUTHOR. DB1054.2 +000500 FEDERAL COMPILER TESTING CENTER. DB1054.2 +000600 INSTALLATION. DB1054.2 +000700 GENERAL SERVICES ADMINISTRATION DB1054.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB1054.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB1054.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB1054.2 +001100 FALLS CHURCH VIRGINIA 22041. DB1054.2 +001200 DB1054.2 +001300 PHONE (703) 756-6153 DB1054.2 +001400 DB1054.2 +001500 " HIGH ". DB1054.2 +001600 DATE-WRITTEN. DB1054.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB1054.2 +001800 CREATION DATE / VALIDATION DATE DB1054.2 +001900 "4.2 ". DB1054.2 +002000 SECURITY. DB1054.2 +002100 NONE. DB1054.2 +002200* DB1054.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB1054.2 +002400* DB1054.2 +002500* PROGRAM ABSTRACT DB1054.2 +002600* DB1054.2 +002700* DB105A TESTS THE CAPABILITY OF THE DEBUG MODULE TO MONITOR DB1054.2 +002800* ALL PROCEDURES WITH A SINGLE DEBUGGING DECLARATIVE. THIS DB1054.2 +002900* PROGRAM IS TO BE COMPILED AND EXECUTED WITH BOTH COMPILE DB1054.2 +003000* AND OBJECT TIME DEBUGGING SWITCHES ON. THE DEBUGGING DB1054.2 +003100* PROCEDURE SHOULD BE INCLUDED IN THE COMPILATION AND DB1054.2 +003200* GENERATE CODE. DURING EXECUTION, EACH PROCEDURE SHOULD DB1054.2 +003300* TRIGGER THE DEBUGGING PROCEDURE WHICH SHOULD STACK THE DB1054.2 +003400* NAME OF THE PROCEDURE CALLING IT. PRIOR TO BEING STACKED, DB1054.2 +003500* EACH NAME IS POTENTIALLY ADJUSTED BY MODIFYING A FIXED- DB1054.2 +003600* LOCATION NUMERIC SUBFIELD IN THE NAME. THE CONSEQUENCE IS DB1054.2 +003700* THAT IF THE PROGRAM EXECUTES PROPERLY, THE NAMES THAT ARE DB1054.2 +003800* STACKED WILL BE UNIQUE AND IN AN INCREMENTING SEQUENCE IN DB1054.2 +003900* THE NUMERIC SUBFIELD. NEAR THE END OF THE PROGRAM, THE DB1054.2 +004000* STACKING FUNCTION IS DISABLED AND THE NAME STACK IS COMPARED DB1054.2 +004100* TO A STATIC TABLE CONTAINING PROCEDURE-NAMES IN THE ORDER DB1054.2 +004200* IN WHICH THE PROCEDURES SHOULD HAVE STACKED. DB1054.2 +004300* DB1054.2 +004400* DB105A"S REPORT DIFFERS SLIGHTLY FROM THE NOMINAL CCVS FORMAT.DB1054.2 +004500* IF EXECUTION IS PERFECT, THE REPORT WILL CONSIST OF 227 DB1054.2 +004600* LINES SHOWING DB1054.2 +004700* DB1054.2 +004800* (A) PROGRAM PROCEDURE NAME, AS IT APPEARS IN THE DB1054.2 +004900* PROGRAM. DB1054.2 +005000* (B) ADJUSTED PROCEDURE NAME, AFTER ITS NUMERIC SUBFIELD DB1054.2 +005100* HAS BEEN ADJUSTED. DB1054.2 +005200* (C) ADJUSTED DEBUG-NAME, THAT WAS STACKED BY THE DB1054.2 +005300* DEBUGGING PROCEDURE. DB1054.2 +005400* DB1054.2 +005500* NOMINALLY, THE NUMERIC SUBFIELDS OF THE PROCEDURE NAMES DB1054.2 +005600* SHOULD APPEAR IN ASCENDING SEQUENCE. ANY DEVIATIONS IN THE DB1054.2 +005700* STACKING SEQUENCE FROM THE EXPECTED SEQUENCE WILL CAUSE DB1054.2 +005800* ADDITIONAL REPORT LINES TO BE GENERATED WITH ONE OR MORE DB1054.2 +005900* COLUMNS BLANK. IF NOTHING EVER APPEARS IN THE "ADJUSTED DB1054.2 +006000* DEBUG-NAME" COLUMN, IT MAY BE ASSUMED THAT THE DEBUGGING DB1054.2 +006100* PROCEDURE WAS NEVER EXECUTED. DB1054.2 +006200* DB1054.2 +006300* IT IS A FUNDAMENTAL ASSUMPTION OF DB105A THAT WHEN A SECTION DB1054.2 +006400* IS ENTERED, THE DEBUGGING SECTION WILL BE CALLED TWICE, ONCE DB1054.2 +006500* FOR THE SECTION NAME AND ONCE FOR THE PARAGRAPH NAME THAT DB1054.2 +006600* IMMEDIATELY FOLLOWS THE SECTION NAME. ADDITIONALLY, DB105A DB1054.2 +006700* TRAPS ANY FAILURES IN PROGRAM FLOW CAUSED BY A FAILURE OF DB1054.2 +006800* VERBS FROM THE NUCLEUS MODULE. THESE FAILURES ARE SUMMED DB1054.2 +006900* AND REPORTED AT THE BOTTOM OF DB105A"S REPORT. IF ANY DB1054.2 +007000* PROCEDURE NAMES BEGINNING WITH "PROC-000" APPEAR IN THE DB1054.2 +007100* "ADJUSTED DEBUG-NAME" COLUMN OF THE REPORT, THESE RESULT DB1054.2 +007200* FROM EXECUTION OF PROCEDURES WHICH SHOULD NOT HAVE BEEN DB1054.2 +007300* EXECUTED IF THE PROGRAM HAD FOLLOWED THE PROPER CONTROL FLOW DB1054.2 +007400* SEQUENCE. DB1054.2 +007500* DB1054.2 +007600* DB1054.2 +007700* DB1054.2 +007800 ENVIRONMENT DIVISION. DB1054.2 +007900 CONFIGURATION SECTION. DB1054.2 +008000 SOURCE-COMPUTER. DB1054.2 +008100 XXXXX082 DB1054.2 +008200 WITH DEBUGGING MODE. DB1054.2 +008300 OBJECT-COMPUTER. DB1054.2 +008400 XXXXX083. DB1054.2 +008500 INPUT-OUTPUT SECTION. DB1054.2 +008600 FILE-CONTROL. DB1054.2 +008700 SELECT PRINT-FILE ASSIGN TO DB1054.2 +008800 XXXXX055. DB1054.2 +008900 DATA DIVISION. DB1054.2 +009000 FILE SECTION. DB1054.2 +009100 FD PRINT-FILE DB1054.2 +009200 LABEL RECORDS DB1054.2 +009300 XXXXX084 DB1054.2 +009400 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB1054.2 +009500 01 PRINT-REC PICTURE X(120). DB1054.2 +009600 01 DUMMY-RECORD PICTURE X(120). DB1054.2 +009700 WORKING-STORAGE SECTION. DB1054.2 +009800 77 ATWO-DS-01V00 PICTURE S9 DB1054.2 +009900 VALUE 2. DB1054.2 +010000 77 P-COUNT PICTURE 9(6). DB1054.2 +010100 77 THREE PICTURE IS 9 VALUE IS 3. DB1054.2 +010200 77 XRAY PICTURE IS X. DB1054.2 +010300 77 ALTERLOOP PICTURE IS 9 VALUE IS DB1054.2 +010400 ZERO. DB1054.2 +010500 77 BYPASS PICTURE IS 9 VALUE IS 1. DB1054.2 +010600 77 STACK-END PICTURE IS 999 COMPUTATIONAL. DB1054.2 +010700 77 INCREMENT PICTURE IS 99. DB1054.2 +010800 77 PROC-ACTIVE PICTURE IS 9 VALUE IS 1. DB1054.2 +010900 01 PROCEDURE-NAMES. DB1054.2 +011000 02 FILLER PIC X(25) VALUE "PROC-001-BEGIN-TESTS ". DB1054.2 +011100 02 FILLER PIC X(25) VALUE "PROC-002-GO--TEST-1 ". DB1054.2 +011200 02 FILLER PIC X(25) VALUE "PROC-003-GO--WRITE-1 ". DB1054.2 +011300 02 FILLER PIC X(25) VALUE "PROC-004-GO--INIT-2 ". DB1054.2 +011400 02 FILLER PIC X(25) VALUE "PROC-005-GO--TEST-2 ". DB1054.2 +011500 02 FILLER PIC X(25) VALUE "PROC-005-GO--A ". DB1054.2 +011600 02 FILLER PIC X(25) VALUE "PROC-005-GO--TEST-2 ". DB1054.2 +011700 02 FILLER PIC X(25) VALUE "PROC-005-GO--B ". DB1054.2 +011800 02 FILLER PIC X(25) VALUE "PROC-005-GO--TEST-2 ". DB1054.2 +011900 02 FILLER PIC X(25) VALUE "PROC-005-GO--C ". DB1054.2 +012000 02 FILLER PIC X(25) VALUE "PROC-005-GO--TEST-2 ". DB1054.2 +012100 02 FILLER PIC X(25) VALUE "PROC-005-GO--D ". DB1054.2 +012200 02 FILLER PIC X(25) VALUE "PROC-005-GO--TEST-2 ". DB1054.2 +012300 02 FILLER PIC X(25) VALUE "PROC-005-GO--A ". DB1054.2 +012400 02 FILLER PIC X(25) VALUE "PROC-005-GO--E ". DB1054.2 +012500 02 FILLER PIC X(25) VALUE "PROC-016-GO--WRITE-2 ". DB1054.2 +012600 02 FILLER PIC X(25) VALUE "PROC-017-GO--TEST-3 ". DB1054.2 +012700 02 FILLER PIC X(25) VALUE "PROC-018-GO--PASS-3 ". DB1054.2 +012800 02 FILLER PIC X(25) VALUE "PROC-019-GO--WRITE-3 ". DB1054.2 +012900 02 FILLER PIC X(25) VALUE "PROC-020-GO--TEST-4 ". DB1054.2 +013000 02 FILLER PIC X(25) VALUE "PROC-021-GO--PASS-4 ". DB1054.2 +013100 02 FILLER PIC X(25) VALUE "PROC-022-GO--PAS-4 ". DB1054.2 +013200 02 FILLER PIC X(25) VALUE "PROC-023-GO--WRITE-4 ". DB1054.2 +013300 02 FILLER PIC X(25) VALUE "PROC-024-ALTER-INIT ". DB1054.2 +013400 02 FILLER PIC X(25) VALUE "PROC-025-ALTER-TEST-1 ". DB1054.2 +013500 02 FILLER PIC X(25) VALUE "PROC-026-ALTER-A ". DB1054.2 +013600 02 FILLER PIC X(25) VALUE "PROC-026-ALTER-A ". DB1054.2 +013700 02 FILLER PIC X(25) VALUE "PROC-027-ALTER-C ". DB1054.2 +013800 02 FILLER PIC X(25) VALUE "PROC-028-ALTER-WRITE-1 ". DB1054.2 +013900 02 FILLER PIC X(25) VALUE "PROC-030-ALTER-TEST-3 ". DB1054.2 +014000 02 FILLER PIC X(25) VALUE "PROC-031-ALTER-G ". DB1054.2 +014100 02 FILLER PIC X(25) VALUE "PROC-031-ALTER-G ". DB1054.2 +014200 02 FILLER PIC X(25) VALUE "PROC-032-ALTER-I ". DB1054.2 +014300 02 FILLER PIC X(25) VALUE "PROC-031-ALTER-G ". DB1054.2 +014400 02 FILLER PIC X(25) VALUE "PROC-031-ALTER-G ". DB1054.2 +014500 02 FILLER PIC X(25) VALUE "PROC-032-ALTER-WRITE-3 ". DB1054.2 +014600 02 FILLER PIC X(25) VALUE "PROC-037-EXIT-TEST-1 ". DB1054.2 +014700 02 FILLER PIC X(25) VALUE "PROC-038-EXIT-CHECK-1 ". DB1054.2 +014800 02 FILLER PIC X(25) VALUE "PROC-039-EXIT-WRITE-1 ". DB1054.2 +014900 02 FILLER PIC X(25) VALUE "PROC-040-PFM-TEST-1 ". DB1054.2 +015000 02 FILLER PIC X(25) VALUE "PROC-041-PFM-A ". DB1054.2 +015100 02 FILLER PIC X(25) VALUE "PROC-042-PFM-WRITE-1 ". DB1054.2 +015200 02 FILLER PIC X(25) VALUE "PROC-043-PFM-TEST-2 ". DB1054.2 +015300 02 FILLER PIC X(25) VALUE "PROC-041-PFM-A ". DB1054.2 +015400 02 FILLER PIC X(25) VALUE "PROC-045-PFM-B ". DB1054.2 +015500 02 FILLER PIC X(25) VALUE "PROC-046-PFM-WRITE-2 ". DB1054.2 +015600 02 FILLER PIC X(25) VALUE "PROC-047-PFM-TEST-3 ". DB1054.2 +015700 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +015800 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +015900 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +016000 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +016100 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +016200 02 FILLER PIC X(25) VALUE "PROC-048-PFM-C ". DB1054.2 +016300 02 FILLER PIC X(25) VALUE "PROC-048-PFM-WRITE-3 ". DB1054.2 +016400 02 FILLER PIC X(25) VALUE "PROC-055-PFM-TEST-4 ". DB1054.2 +016500 02 FILLER PIC X(25) VALUE "PROC-056-PFM-E ". DB1054.2 +016600 02 FILLER PIC X(25) VALUE "PROC-057-PFM-F ". DB1054.2 +016700 02 FILLER PIC X(25) VALUE "PROC-058-PFM-G ". DB1054.2 +016800 02 FILLER PIC X(25) VALUE "PROC-059-PFM-H ". DB1054.2 +016900 02 FILLER PIC X(25) VALUE "PROC-060-PFM-WRITE-4 ". DB1054.2 +017000 02 FILLER PIC X(25) VALUE "PROC-061-PFM-TEST-5 ". DB1054.2 +017100 02 FILLER PIC X(25) VALUE "PROC-062-PFM-J ". DB1054.2 +017200 02 FILLER PIC X(25) VALUE "PROC-063-PFM-L ". DB1054.2 +017300 02 FILLER PIC X(25) VALUE "PROC-064-PFM-WRITE-5 ". DB1054.2 +017400 02 FILLER PIC X(25) VALUE "PROC-065-PFM-TEST-6 ". DB1054.2 +017500 02 FILLER PIC X(25) VALUE "PROC-066-PFM-N ". DB1054.2 +017600 02 FILLER PIC X(25) VALUE "PROC-067-PFM-O ". DB1054.2 +017700 02 FILLER PIC X(25) VALUE "PROC-068-PFM-P ". DB1054.2 +017800 02 FILLER PIC X(25) VALUE "PROC-069-PFM-WRITE-6 ". DB1054.2 +017900 02 FILLER PIC X(25) VALUE "PROC-070-PFM-TEST-7 ". DB1054.2 +018000 02 FILLER PIC X(25) VALUE "PROC-071-PFM-V ". DB1054.2 +018100 02 FILLER PIC X(25) VALUE "PROC-072-PFM-W ". DB1054.2 +018200 02 FILLER PIC X(25) VALUE "PROC-073-PFM-X ". DB1054.2 +018300 02 FILLER PIC X(25) VALUE "PROC-074-PFM-Y ". DB1054.2 +018400 02 FILLER PIC X(25) VALUE "PROC-075-PFM-Z ". DB1054.2 +018500 02 FILLER PIC X(25) VALUE "PROC-071-PFM-V ". DB1054.2 +018600 02 FILLER PIC X(25) VALUE "PROC-072-PFM-W ". DB1054.2 +018700 02 FILLER PIC X(25) VALUE "PROC-073-PFM-X ". DB1054.2 +018800 02 FILLER PIC X(25) VALUE "PROC-074-PFM-Y ". DB1054.2 +018900 02 FILLER PIC X(25) VALUE "PROC-075-PFM-Z ". DB1054.2 +019000 02 FILLER PIC X(25) VALUE "PROC-071-PFM-V ". DB1054.2 +019100 02 FILLER PIC X(25) VALUE "PROC-072-PFM-W ". DB1054.2 +019200 02 FILLER PIC X(25) VALUE "PROC-073-PFM-X ". DB1054.2 +019300 02 FILLER PIC X(25) VALUE "PROC-074-PFM-Y ". DB1054.2 +019400 02 FILLER PIC X(25) VALUE "PROC-075-PFM-Z ". DB1054.2 +019500 02 FILLER PIC X(25) VALUE "PROC-071-PFM-V ". DB1054.2 +019600 02 FILLER PIC X(25) VALUE "PROC-072-PFM-W ". DB1054.2 +019700 02 FILLER PIC X(25) VALUE "PROC-073-PFM-X ". DB1054.2 +019800 02 FILLER PIC X(25) VALUE "PROC-074-PFM-Y ". DB1054.2 +019900 02 FILLER PIC X(25) VALUE "PROC-075-PFM-Z ". DB1054.2 +020000 02 FILLER PIC X(25) VALUE "PROC-071-PFM-V ". DB1054.2 +020100 02 FILLER PIC X(25) VALUE "PROC-072-PFM-W ". DB1054.2 +020200 02 FILLER PIC X(25) VALUE "PROC-073-PFM-X ". DB1054.2 +020300 02 FILLER PIC X(25) VALUE "PROC-074-PFM-Y ". DB1054.2 +020400 02 FILLER PIC X(25) VALUE "PROC-075-PFM-Z ". DB1054.2 +020500 02 FILLER PIC X(25) VALUE "PROC-096-PFM-WRITE-7 ". DB1054.2 +020600 02 FILLER PIC X(25) VALUE "PROC-097-PFM-TEST-08 ". DB1054.2 +020700 02 FILLER PIC X(25) VALUE "PROC-098-PFM-B-8 ". DB1054.2 +020800 02 FILLER PIC X(25) VALUE "PROC-097-PFM-A-8 ". DB1054.2 +020900 02 FILLER PIC X(25) VALUE "PROC-098-PFM-B-8 ". DB1054.2 +021000 02 FILLER PIC X(25) VALUE "PROC-097-PFM-A-8 ". DB1054.2 +021100 02 FILLER PIC X(25) VALUE "PROC-098-PFM-B-8 ". DB1054.2 +021200 02 FILLER PIC X(25) VALUE "PROC-097-PFM-TESTT-8 ". DB1054.2 +021300 02 FILLER PIC X(25) VALUE "PROC-098-PFM-TESTTT-8 ". DB1054.2 +021400 02 FILLER PIC X(25) VALUE "PROC-105-PFM-WRITE-08 ". DB1054.2 +021500 02 FILLER PIC X(25) VALUE "PROC-106-PFM-TEST-09 ". DB1054.2 +021600 02 FILLER PIC X(25) VALUE "PROC-107-PFM-B-9 ". DB1054.2 +021700 02 FILLER PIC X(25) VALUE "PROC-106-PFM-A-9 ". DB1054.2 +021800 02 FILLER PIC X(25) VALUE "PROC-107-PFM-B-9 ". DB1054.2 +021900 02 FILLER PIC X(25) VALUE "PROC-106-PFM-A-9 ". DB1054.2 +022000 02 FILLER PIC X(25) VALUE "PROC-107-PFM-B-9 ". DB1054.2 +022100 02 FILLER PIC X(25) VALUE "PROC-106-PFM-A-9 ". DB1054.2 +022200 02 FILLER PIC X(25) VALUE "PROC-107-PFM-B-9 ". DB1054.2 +022300 02 FILLER PIC X(25) VALUE "PROC-106-PFM-TESTT-9 ". DB1054.2 +022400 02 FILLER PIC X(25) VALUE "PROC-107-PFM-TESTTT-9 ". DB1054.2 +022500 02 FILLER PIC X(25) VALUE "PROC-116-PFM-WRITE-09 ". DB1054.2 +022600 02 FILLER PIC X(25) VALUE "PROC-117-PFM-TEST-10 ". DB1054.2 +022700 02 FILLER PIC X(25) VALUE "PROC-118-PFM-B-10 ". DB1054.2 +022800 02 FILLER PIC X(25) VALUE "PROC-119-PFM-C-10 ". DB1054.2 +022900 02 FILLER PIC X(25) VALUE "PROC-120-PFM-D-10 ". DB1054.2 +023000 02 FILLER PIC X(25) VALUE "PROC-117-PFM-A-10 ". DB1054.2 +023100 02 FILLER PIC X(25) VALUE "PROC-118-PFM-B-10 ". DB1054.2 +023200 02 FILLER PIC X(25) VALUE "PROC-119-PFM-C-10 ". DB1054.2 +023300 02 FILLER PIC X(25) VALUE "PROC-120-PFM-D-10 ". DB1054.2 +023400 02 FILLER PIC X(25) VALUE "PROC-117-PFM-A-10 ". DB1054.2 +023500 02 FILLER PIC X(25) VALUE "PROC-118-PFM-B-10 ". DB1054.2 +023600 02 FILLER PIC X(25) VALUE "PROC-119-PFM-C-10 ". DB1054.2 +023700 02 FILLER PIC X(25) VALUE "PROC-120-PFM-D-10 ". DB1054.2 +023800 02 FILLER PIC X(25) VALUE "PROC-118-PFM-B-10 ". DB1054.2 +023900 02 FILLER PIC X(25) VALUE "PROC-119-PFM-C-10 ". DB1054.2 +024000 02 FILLER PIC X(25) VALUE "PROC-120-PFM-D-10 ". DB1054.2 +024100 02 FILLER PIC X(25) VALUE "PROC-117-PFM-A-10 ". DB1054.2 +024200 02 FILLER PIC X(25) VALUE "PROC-118-PFM-B-10 ". DB1054.2 +024300 02 FILLER PIC X(25) VALUE "PROC-119-PFM-C-10 ". DB1054.2 +024400 02 FILLER PIC X(25) VALUE "PROC-120-PFM-D-10 ". DB1054.2 +024500 02 FILLER PIC X(25) VALUE "PROC-121-PFM-TESTT-10 ". DB1054.2 +024600 02 FILLER PIC X(25) VALUE "PROC-122-PFM-TESTTT-10 ". DB1054.2 +024700 02 FILLER PIC X(25) VALUE "PROC-138-PFM-WRITE-10 ". DB1054.2 +024800 02 FILLER PIC X(25) VALUE "PROC-139-PFM-TEST-11 ". DB1054.2 +024900 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +025000 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +025100 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +025200 02 FILLER PIC X(25) VALUE "PROC-139-PFM-A-11 ". DB1054.2 +025300 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +025400 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +025500 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +025600 02 FILLER PIC X(25) VALUE "PROC-139-PFM-A-11 ". DB1054.2 +025700 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +025800 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +025900 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +026000 02 FILLER PIC X(25) VALUE "PROC-139-PFM-A-11 ". DB1054.2 +026100 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +026200 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +026300 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +026400 02 FILLER PIC X(25) VALUE "PROC-139-PFM-A-11 ". DB1054.2 +026500 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +026600 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +026700 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +026800 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +026900 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +027000 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +027100 02 FILLER PIC X(25) VALUE "PROC-139-PFM-A-11 ". DB1054.2 +027200 02 FILLER PIC X(25) VALUE "PROC-140-PFM-B-11 ". DB1054.2 +027300 02 FILLER PIC X(25) VALUE "PROC-139-PFM-C-11 ". DB1054.2 +027400 02 FILLER PIC X(25) VALUE "PROC-140-PFM-D-11 ". DB1054.2 +027500 02 FILLER PIC X(25) VALUE "PROC-139-PFM-TESTT-11 ". DB1054.2 +027600 02 FILLER PIC X(25) VALUE "PROC-140-PFM-TESTTT-11 ". DB1054.2 +027700 02 FILLER PIC X(25) VALUE "PROC-168-PFM-WRITE-11 ". DB1054.2 +027800 02 FILLER PIC X(25) VALUE "PROC-169-PFM-TEST-12 ". DB1054.2 +027900 02 FILLER PIC X(25) VALUE "PROC-170-PFM-A-12 ". DB1054.2 +028000 02 FILLER PIC X(25) VALUE "PROC-171-PFM-B-12 ". DB1054.2 +028100 02 FILLER PIC X(25) VALUE "PROC-172-PFM-C-12 ". DB1054.2 +028200 02 FILLER PIC X(25) VALUE "PROC-173-PFM-D-12 ". DB1054.2 +028300 02 FILLER PIC X(25) VALUE "PROC-174-PFM-E-12 ". DB1054.2 +028400 02 FILLER PIC X(25) VALUE "PROC-175-PFM-TESTT-12 ". DB1054.2 +028500 02 FILLER PIC X(25) VALUE "PROC-176-PFM-WRITE-12 ". DB1054.2 +028600 02 FILLER PIC X(25) VALUE "PROC-177-PFM-TEST-13 ". DB1054.2 +028700 02 FILLER PIC X(25) VALUE "PROC-178-PFM-A-13 ". DB1054.2 +028800 02 FILLER PIC X(25) VALUE "PROC-177-PFM-B-13 ". DB1054.2 +028900 02 FILLER PIC X(25) VALUE "PROC-178-PFM-A-13 ". DB1054.2 +029000 02 FILLER PIC X(25) VALUE "PROC-177-PFM-B-13 ". DB1054.2 +029100 02 FILLER PIC X(25) VALUE "PROC-178-PFM-A-13 ". DB1054.2 +029200 02 FILLER PIC X(25) VALUE "PROC-177-PFM-B-13 ". DB1054.2 +029300 02 FILLER PIC X(25) VALUE "PROC-178-PFM-A-13 ". DB1054.2 +029400 02 FILLER PIC X(25) VALUE "PROC-177-PFM-B-13 ". DB1054.2 +029500 02 FILLER PIC X(25) VALUE "PROC-178-PFM-TESTT-13 ". DB1054.2 +029600 02 FILLER PIC X(25) VALUE "PROC-187-PFM-WRITE-13 ". DB1054.2 +029700 02 FILLER PIC X(25) VALUE "PROC-188-PFM-TEST-14 ". DB1054.2 +029800 02 FILLER PIC X(25) VALUE "PROC-189-A101 ". DB1054.2 +029900 02 FILLER PIC X(25) VALUE "PROC-190-A102 ". DB1054.2 +030000 02 FILLER PIC X(25) VALUE "PROC-191-A103 ". DB1054.2 +030100 02 FILLER PIC X(25) VALUE "PROC-192-A104 ". DB1054.2 +030200 02 FILLER PIC X(25) VALUE "PROC-193-A105 ". DB1054.2 +030300 02 FILLER PIC X(25) VALUE "PROC-194-A106 ". DB1054.2 +030400 02 FILLER PIC X(25) VALUE "PROC-195-A107 ". DB1054.2 +030500 02 FILLER PIC X(25) VALUE "PROC-196-A108 ". DB1054.2 +030600 02 FILLER PIC X(25) VALUE "PROC-197-A109 ". DB1054.2 +030700 02 FILLER PIC X(25) VALUE "PROC-198-A110 ". DB1054.2 +030800 02 FILLER PIC X(25) VALUE "PROC-199-A111 ". DB1054.2 +030900 02 FILLER PIC X(25) VALUE "PROC-200-A112 ". DB1054.2 +031000 02 FILLER PIC X(25) VALUE "PROC-201-A113 ". DB1054.2 +031100 02 FILLER PIC X(25) VALUE "PROC-202-A114 ". DB1054.2 +031200 02 FILLER PIC X(25) VALUE "PROC-203-A115 ". DB1054.2 +031300 02 FILLER PIC X(25) VALUE "PROC-204-A116 ". DB1054.2 +031400 02 FILLER PIC X(25) VALUE "PROC-205-A117 ". DB1054.2 +031500 02 FILLER PIC X(25) VALUE "PROC-206-A118 ". DB1054.2 +031600 02 FILLER PIC X(25) VALUE "PROC-207-A119 ". DB1054.2 +031700 02 FILLER PIC X(25) VALUE "PROC-208-A120 ". DB1054.2 +031800 02 FILLER PIC X(25) VALUE "PROC-209-A121 ". DB1054.2 +031900 02 FILLER PIC X(25) VALUE "PROC-210-PFM-WRITE-14 ". DB1054.2 +032000 02 FILLER PIC X(25) VALUE "PROC-211-PFM-A-15 ". DB1054.2 +032100 02 FILLER PIC X(25) VALUE "PROC-212-PFM-TEST-15 ". DB1054.2 +032200 02 FILLER PIC X(25) VALUE "PROC-213-PFM-G-15 ". DB1054.2 +032300 02 FILLER PIC X(25) VALUE "PROC-214-PFM-H-15 ". DB1054.2 +032400 02 FILLER PIC X(25) VALUE "PROC-215-PFM-E-15 ". DB1054.2 +032500 02 FILLER PIC X(25) VALUE "PROC-216-PFM-L-15 ". DB1054.2 +032600 02 FILLER PIC X(25) VALUE "PROC-217-PFM-B-15 ". DB1054.2 +032700 02 FILLER PIC X(25) VALUE "PROC-218-PFM-WRITE-15 ". DB1054.2 +032800 02 FILLER PIC X(25) VALUE "PROC-219-PFM-TEST-LAST ". DB1054.2 +032900 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033000 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033100 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033200 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033300 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033400 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033500 02 FILLER PIC X(25) VALUE "PROC-220-PFM-U ". DB1054.2 +033600 02 FILLER PIC X(25) VALUE "PROC-227-PFM-WRITE-LAST ". DB1054.2 +033700 01 STATIC-TABLE REDEFINES PROCEDURE-NAMES. DB1054.2 +033800 02 EXPECTED-NAME OCCURS 227 TIMES INDEXED BY STATIC-INDEX DB1054.2 +033900 PICTURE IS X(25). DB1054.2 +034000 01 STACKING-AREA. DB1054.2 +034100 02 PROC-NAME OCCURS 500 TIMES INDEXED BY STACK-INDEX. DB1054.2 +034200 03 PROC-LOC PICTURE IS X(4). DB1054.2 +034300 03 FILLER PICTURE IS X. DB1054.2 +034400 03 BASE-NUMBER PICTURE IS 999. DB1054.2 +034500 03 FILLER PICTURE IS X. DB1054.2 +034600 03 BASE-NAME PICTURE IS X(16). DB1054.2 +034700 01 TABLE-ENTRY. DB1054.2 +034800 02 FILLER PICTURE IS X(5). DB1054.2 +034900 02 TABLE-ENTRY-BASE PICTURE IS 999. DB1054.2 +035000 02 FILLER PICTURE IS X(17). DB1054.2 +035100 01 FLOW-FAILURE-1. DB1054.2 +035200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1054.2 +035300 02 FILLER PICTURE IS X(43) VALUE DB1054.2 +035400 "COUNT OF LEVEL 1 NUCLEUS FLOW FAILURES WAS ". DB1054.2 +035500 02 NUC-FAILURE-COUNT PICTURE IS 999 VALUE 0. DB1054.2 +035600 02 FILLER PICTURE X VALUE ".". DB1054.2 +035700 01 FLOW-FAILURE-2 PICTURE IS X(75) VALUE IS DB1054.2 +035800 " A NON-ZERO COUNT WILL CAUSE FAILURES TO APPEAR IN THE ADB1054.2 +035900- "BOVE REPORT.". DB1054.2 +036000 01 NOTE-RECORD. DB1054.2 +036100 02 A PICTURE X VALUE SPACE. DB1054.2 +036200 02 B PICTURE X VALUE SPACE. DB1054.2 +036300 02 C PICTURE X VALUE SPACE. DB1054.2 +036400 02 D PICTURE X VALUE SPACE. DB1054.2 +036500 02 E PICTURE X VALUE SPACE. DB1054.2 +036600 02 F PICTURE X VALUE SPACE. DB1054.2 +036700 02 G PICTURE X VALUE SPACE. DB1054.2 +036800 02 H PICTURE X VALUE SPACE. DB1054.2 +036900 02 I PICTURE X VALUE SPACE. DB1054.2 +037000 02 J PICTURE X VALUE SPACE. DB1054.2 +037100 02 K PICTURE X VALUE SPACE. DB1054.2 +037200 02 L PICTURE X VALUE SPACE. DB1054.2 +037300 02 M PICTURE X VALUE SPACE. DB1054.2 +037400 02 N PICTURE X VALUE SPACE. DB1054.2 +037500 02 O PICTURE X VALUE SPACE. DB1054.2 +037600 02 P PICTURE X VALUE SPACE. DB1054.2 +037700 01 GO-TABLE. DB1054.2 +037800 02 GO-SCRIPT OCCURS 8 TIMES PICTURE 9. DB1054.2 +037900 01 GO-TO-DEPEND PICTURE IS 9 VALUE IS 0. DB1054.2 +038000 01 GO-TO-DEEP PICTURE IS 9 VALUE IS 1. DB1054.2 +038100 01 PERFORM1 PICTURE IS XXX DB1054.2 +038200 VALUE IS SPACE. DB1054.2 +038300 01 PERFORM2 PICTURE IS S999 DB1054.2 +038400 VALUE IS 20. DB1054.2 +038500 01 PERFORM4 PICTURE IS S99V9. DB1054.2 +038600 01 PERFORM5 PICTURE IS 999 DB1054.2 +038700 VALUE IS ZERO. DB1054.2 +038800 01 PERFORM-KEY PICTURE IS 9. DB1054.2 +038900 01 PERFORM-HOLD. DB1054.2 +039000 02 TEST-LETTER OCCURS 20 TIMES PICTURE X. DB1054.2 +039100 01 TEST-RESULTS. DB1054.2 +039200 02 FILLER PICTURE X VALUE SPACE. DB1054.2 +039300 02 FEATURE PICTURE X(20). DB1054.2 +039400 02 FILLER PICTURE XX VALUE SPACE. DB1054.2 +039500 02 P-OR-F PICTURE X(5). DB1054.2 +039600 02 FILLER PICTURE XX VALUE SPACE. DB1054.2 +039700 02 PAR-NAME. DB1054.2 +039800 03 FILLER PICTURE X(12). DB1054.2 +039900 03 PARDOT-X PICTURE X. DB1054.2 +040000 03 DOTVALUE PICTURE 99. DB1054.2 +040100 03 FILLER PICTURE IS X(10). DB1054.2 +040200 02 FILLER PICTURE X VALUE SPACE. DB1054.2 +040300 02 CORRECT-A PICTURE IS X(25). DB1054.2 +040400 02 CORRECT-NFIELD REDEFINES CORRECT-A. DB1054.2 +040500 03 CORRECT-N PICTURE -9(9).9(9). DB1054.2 +040600 03 FILLER PICTURE X(5). DB1054.2 +040700 02 FILLER PICTURE XX VALUE SPACE. DB1054.2 +040800 02 COMPUTED-A PICTURE IS X(25). DB1054.2 +040900 02 COMPUTED-NFIELD REDEFINES COMPUTED-A. DB1054.2 +041000 03 COMPUTED-N PICTURE -9(9).9(9). DB1054.2 +041100 03 FILLER PICTURE X(5). DB1054.2 +041200 02 RE-MARK PICTURE IS XXX. DB1054.2 +041300 01 COLUMNS-LINE-1. DB1054.2 +041400 02 PAGE-CONTROL-C PICTURE IS X VALUE IS SPACE. DB1054.2 +041500 02 FILLER PICTURE IS X(7) VALUE IS SPACE. DB1054.2 +041600 02 FILLER PICTURE IS X(7) VALUE IS "FEATURE". DB1054.2 +041700 02 FILLER PICTURE IS X(9) VALUE IS SPACE. DB1054.2 +041800 02 FILLER PICTURE IS X(4) VALUE IS "PASS". DB1054.2 +041900 02 FILLER PICTURE IS X(10) VALUE IS SPACE. DB1054.2 +042000 02 FILLER PICTURE IS X(7) VALUE IS "PROGRAM". DB1054.2 +042100 02 FILLER PICTURE IS X(19) VALUE IS SPACE. DB1054.2 +042200 02 FILLER PICTURE IS X(8) VALUE IS "ADJUSTED". DB1054.2 +042300 02 FILLER PICTURE IS X(18) VALUE IS SPACE. DB1054.2 +042400 02 FILLER PICTURE IS X(8) VALUE IS "ADJUSTED". DB1054.2 +042500 01 COLUMNS-LINE-2. DB1054.2 +042600 02 FILLER PICTURE IS X VALUE IS SPACE. DB1054.2 +042700 02 FILLER PICTURE IS X(7) VALUE IS SPACE. DB1054.2 +042800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB1054.2 +042900 02 FILLER PICTURE IS X(10) VALUE IS SPACE. DB1054.2 +043000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB1054.2 +043100 02 FILLER PICTURE IS X(7) VALUE IS SPACE. DB1054.2 +043200 02 FILLER PICTURE IS X(14) VALUE IS "PROCEDURE NAME". DB1054.2 +043300 02 FILLER PICTURE IS X(12) VALUE IS SPACE. DB1054.2 +043400 02 FILLER PICTURE IS X(14) VALUE IS "PROCEDURE NAME". DB1054.2 +043500 02 FILLER PICTURE IS X(14) VALUE IS SPACE. DB1054.2 +043600 02 FILLER PICTURE IS X(10) VALUE IS "DEBUG-NAME". DB1054.2 +043700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB1054.2 +043800 01 REC-CT PICTURE 99 VALUE ZERO. DB1054.2 +043900 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB1054.2 +044000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB1054.2 +044100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB1054.2 +044200 01 PASS-COUNTER PIC 999 VALUE ZERO. DB1054.2 +044300 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB1054.2 +044400 01 ERROR-HOLD PIC 999 VALUE ZERO. DB1054.2 +044500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB1054.2 +044600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB1054.2 +044700 01 CCVS-H-1. DB1054.2 +044800 02 FILLER PICTURE X(27) VALUE SPACE. DB1054.2 +044900 02 FILLER PICTURE X(67) VALUE DB1054.2 +045000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB1054.2 +045100- " SYSTEM". DB1054.2 +045200 02 FILLER PICTURE X(26) VALUE SPACE. DB1054.2 +045300 01 CCVS-H-2. DB1054.2 +045400 02 FILLER PICTURE X(52) VALUE IS DB1054.2 +045500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB1054.2 +045600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB1054.2 +045700 02 TEST-ID PICTURE IS X(9). DB1054.2 +045800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB1054.2 +045900 01 CCVS-H-3. DB1054.2 +046000 02 FILLER PICTURE X(34) VALUE DB1054.2 +046100 " FOR OFFICIAL USE ONLY ". DB1054.2 +046200 02 FILLER PICTURE X(58) VALUE DB1054.2 +046300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB1054.2 +046400 02 FILLER PICTURE X(28) VALUE DB1054.2 +046500 " COPYRIGHT 1974 ". DB1054.2 +046600 01 CCVS-E-1. DB1054.2 +046700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB1054.2 +046800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB1054.2 +046900 02 ID-AGAIN PICTURE IS X(9). DB1054.2 +047000 02 FILLER PICTURE X(45) VALUE IS DB1054.2 +047100 " NTIS DISTRIBUTION COBOL 74". DB1054.2 +047200 01 CCVS-E-2. DB1054.2 +047300 02 FILLER PICTURE X(31) VALUE DB1054.2 +047400 SPACE. DB1054.2 +047500 02 FILLER PICTURE X(21) VALUE SPACE. DB1054.2 +047600 02 CCVS-E-2-2. DB1054.2 +047700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB1054.2 +047800 03 FILLER PICTURE IS X VALUE IS SPACE. DB1054.2 +047900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB1054.2 +048000 01 CCVS-E-3. DB1054.2 +048100 02 FILLER PICTURE X(22) VALUE DB1054.2 +048200 " FOR OFFICIAL USE ONLY". DB1054.2 +048300 02 FILLER PICTURE X(12) VALUE SPACE. DB1054.2 +048400 02 FILLER PICTURE X(58) VALUE DB1054.2 +048500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB1054.2 +048600 02 FILLER PICTURE X(13) VALUE SPACE. DB1054.2 +048700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB1054.2 +048800 01 CCVS-E-4. DB1054.2 +048900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB1054.2 +049000 02 FILLER PIC XXXX VALUE " OF ". DB1054.2 +049100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB1054.2 +049200 02 FILLER PIC X(40) VALUE DB1054.2 +049300 " TESTS WERE EXECUTED SUCCESSFULLY". DB1054.2 +049400 01 XXINFO. DB1054.2 +049500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB1054.2 +049600 02 INFO-TEXT. DB1054.2 +049700 04 FILLER PIC X(20) VALUE SPACE. DB1054.2 +049800 04 XXCOMPUTED PIC X(20). DB1054.2 +049900 04 FILLER PIC X(5) VALUE SPACE. DB1054.2 +050000 04 XXCORRECT PIC X(20). DB1054.2 +050100 01 HYPHEN-LINE. DB1054.2 +050200 02 FILLER PICTURE IS X VALUE IS SPACE. DB1054.2 +050300 02 FILLER PICTURE IS X(65) VALUE IS "************************DB1054.2 +050400- "*****************************************". DB1054.2 +050500 02 FILLER PICTURE IS X(54) VALUE IS "************************DB1054.2 +050600- "******************************". DB1054.2 +050700 01 CCVS-PGM-ID PIC X(6) VALUE DB1054.2 +050800 "DB105A". DB1054.2 +050900 PROCEDURE DIVISION. DB1054.2 +051000 DECLARATIVES. DB1054.2 +051100 DEBUG-ALL-PROCS SECTION. DB1054.2 +051200 USE FOR DEBUGGING ON ALL PROCEDURES. DB1054.2 +051300 DEBUG-ALL-0. DB1054.2 +051400 MOVE 0 TO PROC-ACTIVE. DB1054.2 +051500 IF BYPASS IS EQUAL TO 1 GO TO DEBUG-ALL-EXIT. DB1054.2 +051600 MOVE DEBUG-NAME TO PROC-NAME (STACK-INDEX). DB1054.2 +051700 IF PROC-LOC (STACK-INDEX) IS EQUAL TO "PROC" DB1054.2 +051800 INSPECT PROC-NAME (STACK-INDEX) DB1054.2 +051900 REPLACING CHARACTERS BY " " AFTER INITIAL " ". DB1054.2 +052000 IF BASE-NUMBER (STACK-INDEX) IS NUMERIC DB1054.2 +052100 ADD INCREMENT TO BASE-NUMBER (STACK-INDEX). DB1054.2 +052200 IF STACK-INDEX IS EQUAL TO 500 DB1054.2 +052300 MOVE 1 TO BYPASS DB1054.2 +052400 GO TO DEBUG-ALL-EXIT. DB1054.2 +052500 SET STACK-INDEX UP BY 1. DB1054.2 +052600 DEBUG-ALL-EXIT. DB1054.2 +052700 EXIT. DB1054.2 +052800 END DECLARATIVES. DB1054.2 +052900 CCVS1 SECTION. DB1054.2 +053000 OPEN-FILES. DB1054.2 +053100 OPEN OUTPUT PRINT-FILE. DB1054.2 +053200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB1054.2 +053300 MOVE SPACE TO TEST-RESULTS. DB1054.2 +053400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB1054.2 +053500 GO TO CCVS1-EXIT. DB1054.2 +053600 CLOSE-FILES. DB1054.2 +053700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB1054.2 +053800 TERMINATE-CCVS. DB1054.2 +053900T EXIT PROGRAM. DB1054.2 +054000TTERMINATE-CALL. DB1054.2 +054100 STOP RUN. DB1054.2 +054200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB1054.2 +054300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB1054.2 +054400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB1054.2 +054500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB1054.2 +054600 MOVE "****TEST DELETED****" TO RE-MARK. DB1054.2 +054700 PRINT-DETAIL. DB1054.2 +054800 IF REC-CT NOT EQUAL TO ZERO DB1054.2 +054900 MOVE "." TO PARDOT-X DB1054.2 +055000 MOVE REC-CT TO DOTVALUE. DB1054.2 +055100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB1054.2 +055200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-A. DB1054.2 +055300 MOVE SPACE TO CORRECT-A. DB1054.2 +055400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB1054.2 +055500 MOVE SPACE TO RE-MARK. DB1054.2 +055600 HEAD-ROUTINE. DB1054.2 +055700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1054.2 +055800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB1054.2 +055900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB1054.2 +056000 COLUMN-NAMES-ROUTINE. DB1054.2 +056100 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1054.2 +056200 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. DB1054.2 +056300 PERFORM WRITE-LINE 2 TIMES. DB1054.2 +056400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1054.2 +056500 END-ROUTINE. DB1054.2 +056600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB1054.2 +056700 END-RTN-EXIT. DB1054.2 +056800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB1054.2 +056900 END-ROUTINE-1. DB1054.2 +057000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB1054.2 +057100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB1054.2 +057200 ADD PASS-COUNTER TO ERROR-HOLD. DB1054.2 +057300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB1054.2 +057400 MOVE PASS-COUNTER TO CCVS-E-4-1. DB1054.2 +057500 MOVE ERROR-HOLD TO CCVS-E-4-2. DB1054.2 +057600 MOVE CCVS-E-4 TO CCVS-E-2-2. DB1054.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB1054.2 +057800 END-ROUTINE-12. DB1054.2 +057900 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB1054.2 +058000 IF ERROR-COUNTER IS EQUAL TO ZERO DB1054.2 +058100 MOVE "NO " TO ERROR-TOTAL DB1054.2 +058200 ELSE DB1054.2 +058300 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB1054.2 +058400 MOVE CCVS-E-2 TO DUMMY-RECORD. DB1054.2 +058500 PERFORM WRITE-LINE. DB1054.2 +058600 END-ROUTINE-13. DB1054.2 +058700 IF DELETE-CNT IS EQUAL TO ZERO DB1054.2 +058800 MOVE "NO " TO ERROR-TOTAL ELSE DB1054.2 +058900 MOVE DELETE-CNT TO ERROR-TOTAL. DB1054.2 +059000 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB1054.2 +059100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1054.2 +059200 IF INSPECT-COUNTER EQUAL TO ZERO DB1054.2 +059300 MOVE "NO " TO ERROR-TOTAL DB1054.2 +059400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB1054.2 +059500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB1054.2 +059600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1054.2 +059700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB1054.2 +059800 WRITE-LINE. DB1054.2 +059900 ADD 1 TO RECORD-COUNT. DB1054.2 +060000Y IF RECORD-COUNT GREATER 50 DB1054.2 +060100Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB1054.2 +060200Y MOVE SPACE TO DUMMY-RECORD DB1054.2 +060300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB1054.2 +060400Y MOVE COLUMNS-LINE-1 TO DUMMY-RECORD PERFORM WRT-LN DB1054.2 +060500Y MOVE COLUMNS-LINE-2 TO DUMMY-RECORD PERFORM WRT-LN DB1054.2 +060600Y 2 TIMES DB1054.2 +060700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB1054.2 +060800Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB1054.2 +060900Y MOVE ZERO TO RECORD-COUNT. DB1054.2 +061000 PERFORM WRT-LN. DB1054.2 +061100 WRT-LN. DB1054.2 +061200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB1054.2 +061300 MOVE SPACE TO DUMMY-RECORD. DB1054.2 +061400* DB1054.2 +061500 CCVS1-EXIT. DB1054.2 +061600 EXIT. DB1054.2 +061700 INITIALIZE-PROC-NAME-STACK. DB1054.2 +061800 MOVE 0 TO BYPASS. DB1054.2 +061900 SET STACK-INDEX TO 1. DB1054.2 +062000 MOVE 0 TO INCREMENT. DB1054.2 +062100 PROC-001-BEGIN-TESTS SECTION. DB1054.2 +062200 PROC-002-GO--TEST-1. DB1054.2 +062300 MOVE 0 TO INCREMENT. DB1054.2 +062400 GO TO PROC-003-GO--WRITE-1. DB1054.2 +062500 PROC-000-GO--DELETE-1. DB1054.2 +062600 MOVE 0 TO INCREMENT. DB1054.2 +062700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +062800 GO TO PROC-003-GO--WRITE-1. DB1054.2 +062900 PROC-003-GO--WRITE-1. DB1054.2 +063000 MOVE 0 TO INCREMENT. DB1054.2 +063100 MOVE "GO TO " TO FEATURE. DB1054.2 +063200 MOVE "PROC-002-GO--TEST-1" TO PAR-NAME. DB1054.2 +063300 PROC-004-GO--INIT-2. DB1054.2 +063400 MOVE 0 TO INCREMENT. DB1054.2 +063500 MOVE "PROC-005-GO--TEST-2" TO PAR-NAME. DB1054.2 +063600 MOVE SPACE TO P-OR-F. DB1054.2 +063700 MOVE "GO TO DEPENDING" TO FEATURE. DB1054.2 +063800 PROC-005-GO--TEST-2. DB1054.2 +063900 ADD 1 TO INCREMENT. DB1054.2 +064000 MOVE SPACE TO FEATURE. DB1054.2 +064100 GO TO PROC-005-GO--B DB1054.2 +064200 PROC-005-GO--D DB1054.2 +064300 PROC-005-GO--C DEPENDING ON GO-TO-DEPEND. DB1054.2 +064400 GO TO PROC-005-GO--A. DB1054.2 +064500 PROC-000-GO--DELETE-2. DB1054.2 +064600 MOVE 0 TO INCREMENT. DB1054.2 +064700 MOVE "PROC-005-GO--TEST-2" TO PAR-NAME. DB1054.2 +064800 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +064900 GO TO PROC-016-GO--WRITE-2. DB1054.2 +065000 PROC-005-GO--A. DB1054.2 +065100 ADD 1 TO INCREMENT. DB1054.2 +065200 MOVE "PROC-005-GO--A" TO PAR-NAME. DB1054.2 +065300 IF GO-TO-DEPEND EQUAL TO 0 DB1054.2 +065400 ADD 1 TO GO-TO-DEPEND DB1054.2 +065500 GO TO PROC-005-GO--TEST-2. DB1054.2 +065600 IF GO-TO-DEPEND GREATER THAN 3 DB1054.2 +065700 GO TO PROC-005-GO--E. DB1054.2 +065800 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +065900 MOVE 1 TO GO-TO-DEPEND DB1054.2 +066000 GO TO PROC-005-GO--TEST-2. DB1054.2 +066100 PROC-005-GO--B. DB1054.2 +066200 ADD 1 TO INCREMENT. DB1054.2 +066300 MOVE "PROC-005-GO--B" TO PAR-NAME. DB1054.2 +066400 IF GO-TO-DEPEND NOT EQUAL TO 1 DB1054.2 +066500 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +066600 MOVE 3 TO GO-TO-DEPEND DB1054.2 +066700 GO TO PROC-005-GO--TEST-2. DB1054.2 +066800 ADD 2 TO GO-TO-DEPEND. DB1054.2 +066900 GO TO PROC-005-GO--TEST-2. DB1054.2 +067000 PROC-005-GO--C. DB1054.2 +067100 ADD 1 TO INCREMENT. DB1054.2 +067200 MOVE "PROC-005-GO--C" TO PAR-NAME. DB1054.2 +067300 IF GO-TO-DEPEND NOT EQUAL TO 3 DB1054.2 +067400 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +067500 MOVE 2 TO GO-TO-DEPEND DB1054.2 +067600 GO TO PROC-005-GO--TEST-2. DB1054.2 +067700 SUBTRACT 1 FROM GO-TO-DEPEND. DB1054.2 +067800 GO TO PROC-005-GO--TEST-2. DB1054.2 +067900 PROC-005-GO--D. DB1054.2 +068000 ADD 1 TO INCREMENT. DB1054.2 +068100 MOVE "PROC-005-GO--D" TO PAR-NAME. DB1054.2 +068200 IF GO-TO-DEPEND NOT EQUAL TO 2 DB1054.2 +068300 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +068400 MOVE 4 TO GO-TO-DEPEND DB1054.2 +068500 GO TO PROC-005-GO--TEST-2. DB1054.2 +068600 ADD 2 TO GO-TO-DEPEND. DB1054.2 +068700 GO TO PROC-005-GO--TEST-2. DB1054.2 +068800 PROC-005-GO--E. DB1054.2 +068900 MOVE 0 TO INCREMENT. DB1054.2 +069000 MOVE "PROC-005-GO--E" TO PAR-NAME. DB1054.2 +069100 IF GO-TO-DEPEND EQUAL TO 4 DB1054.2 +069200 GO TO PROC-016-GO--WRITE-2. DB1054.2 +069300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +069400 PROC-016-GO--WRITE-2. DB1054.2 +069500 MOVE 0 TO INCREMENT. DB1054.2 +069600 ADD 1 TO REC-CT. DB1054.2 +069700 PROC-017-GO--TEST-3. DB1054.2 +069800 MOVE 0 TO INCREMENT. DB1054.2 +069900 GO TO PROC-018-GO--PASS-3. DB1054.2 +070000 PROC-000-GO--TEST-3A. DB1054.2 +070100 MOVE 0 TO INCREMENT. DB1054.2 +070200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +070300 GO TO PROC-019-GO--WRITE-3. DB1054.2 +070400 PROC-000-GO--DELETE-3. DB1054.2 +070500 MOVE 0 TO INCREMENT. DB1054.2 +070600 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +070700 GO TO PROC-019-GO--WRITE-3. DB1054.2 +070800 PROC-018-GO--PASS-3 SECTION. DB1054.2 +070900 PROC-019-GO--WRITE-3. DB1054.2 +071000 MOVE 0 TO INCREMENT. DB1054.2 +071100 MOVE "GO TO" TO FEATURE. DB1054.2 +071200 MOVE "PROC-017-GO--TEST-3" TO PAR-NAME. DB1054.2 +071300 PROC-020-GO--TEST-4. DB1054.2 +071400 MOVE 0 TO INCREMENT. DB1054.2 +071500 GO TO PROC-021-GO--PASS-4 DB1054.2 +071600 PROC-000-GO--NUC-FAIL-4 DEPENDING ON GO-TO-DEEP. DB1054.2 +071700* NOTE THAT PROC-021-GO--PASS-4 IS A SECTION-NAME. DB1054.2 +071800 GO TO PROC-000-GO--NUC-FAIL-4. DB1054.2 +071900 PROC-000-GO--DELETE-4. DB1054.2 +072000 MOVE 0 TO INCREMENT. DB1054.2 +072100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +072200 GO TO PROC-023-GO--WRITE-4. DB1054.2 +072300 PROC-021-GO--PASS-4 SECTION. DB1054.2 +072400 PROC-022-GO--PAS-4. DB1054.2 +072500 MOVE 0 TO INCREMENT. DB1054.2 +072600 IF GO-TO-DEEP EQUAL TO 1 DB1054.2 +072700 GO TO PROC-023-GO--WRITE-4. DB1054.2 +072800 PROC-000-GO--NUC-FAIL-4. DB1054.2 +072900 MOVE 0 TO INCREMENT. DB1054.2 +073000 MOVE GO-TO-DEEP TO COMPUTED-N. DB1054.2 +073100 MOVE 1 TO CORRECT-N. DB1054.2 +073200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +073300 PROC-023-GO--WRITE-4. DB1054.2 +073400 MOVE 0 TO INCREMENT. DB1054.2 +073500 MOVE "GO TO DEPENDING" TO FEATURE. DB1054.2 +073600 MOVE "PROC-020-GO--TEST-4" TO PAR-NAME. DB1054.2 +073700 PROC-024-ALTER-INIT. DB1054.2 +073800 MOVE 0 TO INCREMENT. DB1054.2 +073900 MOVE "ALTER" TO FEATURE. DB1054.2 +074000 PROC-025-ALTER-TEST-1. DB1054.2 +074100 MOVE 0 TO INCREMENT. DB1054.2 +074200 ALTER PROC-026-ALTER-A TO PROCEED TO PROC-027-ALTER-C. DB1054.2 +074300 MOVE 1 TO INCREMENT. DB1054.2 +074400 GO TO PROC-026-ALTER-A. DB1054.2 +074500 PROC-000-ALTER-DELETE-1. DB1054.2 +074600 MOVE 0 TO INCREMENT. DB1054.2 +074700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +074800 GO TO PROC-028-ALTER-WRITE-1. DB1054.2 +074900 PROC-026-ALTER-A. DB1054.2 +075000 GO TO PROC-000-ALTER-B. DB1054.2 +075100 PROC-000-ALTER-B. DB1054.2 +075200 MOVE 0 TO INCREMENT. DB1054.2 +075300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +075400 GO TO PROC-028-ALTER-WRITE-1. DB1054.2 +075500 PROC-027-ALTER-C. DB1054.2 +075600 ADD 0 TO INCREMENT. DB1054.2 +075700 PROC-028-ALTER-WRITE-1. DB1054.2 +075800 MOVE 0 TO INCREMENT. DB1054.2 +075900 MOVE "PROC-025-ALTER-TEST-1" TO PAR-NAME. DB1054.2 +076000 PROC-030-ALTER-TEST-3. DB1054.2 +076100 MOVE 0 TO INCREMENT. DB1054.2 +076200 ALTER PROC-031-ALTER-G TO PROCEED TO PROC-032-ALTER-I. DB1054.2 +076300 MOVE 1 TO INCREMENT. DB1054.2 +076400 GO TO PROC-031-ALTER-G. DB1054.2 +076500 PROC-000-ALTER-DELETE-3. DB1054.2 +076600 MOVE 0 TO INCREMENT. DB1054.2 +076700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +076800 GO TO PROC-032-ALTER-WRITE-3. DB1054.2 +076900 PROC-031-ALTER-G. DB1054.2 +077000 GO TO PROC-000-ALTER-H. DB1054.2 +077100 PROC-000-ALTER-H. DB1054.2 +077200 MOVE 0 TO INCREMENT. DB1054.2 +077300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +077400 GO TO PROC-032-ALTER-WRITE-3. DB1054.2 +077500 PROC-032-ALTER-I. DB1054.2 +077600 MOVE 3 TO INCREMENT. DB1054.2 +077700 ADD 1 TO ALTERLOOP. DB1054.2 +077800 IF ALTERLOOP GREATER THAN 1 DB1054.2 +077900 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +078000 GO TO PROC-032-ALTER-WRITE-3. DB1054.2 +078100 ALTER PROC-031-ALTER-G TO PROC-032-ALTER-WRITE-3. DB1054.2 +078200 MOVE 4 TO INCREMENT. DB1054.2 +078300 GO TO PROC-031-ALTER-G. DB1054.2 +078400 PROC-032-ALTER-WRITE-3. DB1054.2 +078500 MOVE 0 TO INCREMENT. DB1054.2 +078600 MOVE "PROC-030-ALTER-TEST-3" TO PAR-NAME. DB1054.2 +078700 PROC-037-EXIT-TEST-1. DB1054.2 +078800 MOVE 0 TO INCREMENT. DB1054.2 +078900 GO TO PROC-038-EXIT-CHECK-1. DB1054.2 +079000 PROC-000-EXIT-DELETE-1. DB1054.2 +079100 MOVE 0 TO INCREMENT. DB1054.2 +079200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +079300 GO TO PROC-039-EXIT-WRITE-1. DB1054.2 +079400 PROC-038-EXIT-CHECK-1. DB1054.2 +079500 EXIT. DB1054.2 +079600 PROC-039-EXIT-WRITE-1. DB1054.2 +079700 MOVE 0 TO INCREMENT. DB1054.2 +079800 MOVE "EXIT" TO FEATURE. DB1054.2 +079900 MOVE "PROC-037-EXIT-TEST-1" TO PAR-NAME. DB1054.2 +080000 PROC-040-PFM-TEST-1. DB1054.2 +080100 MOVE 0 TO INCREMENT. DB1054.2 +080200 MOVE 1 TO PERFORM-KEY. DB1054.2 +080300 PERFORM PROC-041-PFM-A. DB1054.2 +080400 IF PERFORM1 EQUAL TO "ABC" DB1054.2 +080500 NEXT SENTENCE DB1054.2 +080600 ELSE DB1054.2 +080700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +080800 GO TO PROC-042-PFM-WRITE-1. DB1054.2 +080900 PROC-000-PFM-DELETE-1. DB1054.2 +081000 MOVE 0 TO INCREMENT. DB1054.2 +081100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +081200 PROC-042-PFM-WRITE-1. DB1054.2 +081300 MOVE 0 TO INCREMENT. DB1054.2 +081400 MOVE "PERFORM" TO FEATURE. DB1054.2 +081500 MOVE "PFM-TEST-1" TO PAR-NAME. DB1054.2 +081600 PROC-043-PFM-TEST-2. DB1054.2 +081700 MOVE 3 TO INCREMENT. DB1054.2 +081800 MOVE 2 TO PERFORM-KEY. DB1054.2 +081900 GO TO PROC-041-PFM-A. DB1054.2 +082000 PROC-000-PFM-DELETE-2. DB1054.2 +082100 MOVE 0 TO INCREMENT. DB1054.2 +082200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +082300 GO TO PROC-046-PFM-WRITE-2. DB1054.2 +082400 PROC-041-PFM-A. DB1054.2 +082500 MOVE 0 TO INCREMENT. DB1054.2 +082600 IF PERFORM-KEY EQUAL TO 1 DB1054.2 +082700 MOVE "ABC" TO PERFORM1 DB1054.2 +082800 ELSE DB1054.2 +082900 MOVE "XYZ" TO PERFORM1. DB1054.2 +083000 PROC-045-PFM-B. DB1054.2 +083100 MOVE 0 TO INCREMENT. DB1054.2 +083200 IF PERFORM-KEY EQUAL TO 1 DB1054.2 +083300 PERFORM PROC-000-NUCLEUS-FAILURE DB1054.2 +083400 GO TO PROC-043-PFM-TEST-2. DB1054.2 +083500 IF PERFORM1 EQUAL TO "XYZ" DB1054.2 +083600 NEXT SENTENCE DB1054.2 +083700 ELSE DB1054.2 +083800 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +083900 PROC-046-PFM-WRITE-2. DB1054.2 +084000 MOVE 0 TO INCREMENT. DB1054.2 +084100 MOVE "PERFORM" TO FEATURE. DB1054.2 +084200 MOVE "PROC-043-PFM-TEST-2" TO PAR-NAME. DB1054.2 +084300 PROC-047-PFM-TEST-3. DB1054.2 +084400 MOVE 0 TO INCREMENT. DB1054.2 +084500 PERFORM PROC-048-PFM-C 3 TIMES. DB1054.2 +084600 PERFORM PROC-048-PFM-C THREE TIMES. DB1054.2 +084700 IF PERFORM2 EQUAL TO 56 DB1054.2 +084800 NEXT SENTENCE DB1054.2 +084900 ELSE DB1054.2 +085000 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +085100 GO TO PROC-048-PFM-WRITE-3. DB1054.2 +085200 PROC-000-PFM-DELETE-3. DB1054.2 +085300 MOVE 0 TO INCREMENT. DB1054.2 +085400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +085500 PROC-048-PFM-WRITE-3. DB1054.2 +085600 MOVE 0 TO INCREMENT. DB1054.2 +085700 MOVE "PERFORM TIMES" TO FEATURE. DB1054.2 +085800 MOVE "PROC-047-PFM-TEST-3" TO PAR-NAME. DB1054.2 +085900 PROC-055-PFM-TEST-4. DB1054.2 +086000 MOVE 0 TO INCREMENT. DB1054.2 +086100 PERFORM PROC-056-PFM-E THRU PROC-059-PFM-H. DB1054.2 +086200 IF PERFORM4 EQUAL TO 70.0 DB1054.2 +086300 NEXT SENTENCE DB1054.2 +086400 ELSE DB1054.2 +086500 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +086600 GO TO PROC-060-PFM-WRITE-4. DB1054.2 +086700 PROC-000-PFM-DELETE-4. DB1054.2 +086800 MOVE 0 TO INCREMENT. DB1054.2 +086900 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +087000 PROC-060-PFM-WRITE-4. DB1054.2 +087100 MOVE 0 TO INCREMENT. DB1054.2 +087200 MOVE "NESTED PERFORM THRU" TO FEATURE. DB1054.2 +087300 MOVE "PROC-055-PFM-TEST-4" TO PAR-NAME. DB1054.2 +087400 PROC-061-PFM-TEST-5. DB1054.2 +087500 MOVE 0 TO INCREMENT. DB1054.2 +087600 PERFORM PROC-062-PFM-J. DB1054.2 +087700 IF PERFORM2 EQUAL TO 312 DB1054.2 +087800 NEXT SENTENCE DB1054.2 +087900 ELSE DB1054.2 +088000 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +088100 GO TO PROC-064-PFM-WRITE-5. DB1054.2 +088200 PROC-000-PFM-DELETE-5. DB1054.2 +088300 MOVE 0 TO INCREMENT. DB1054.2 +088400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +088500 PROC-064-PFM-WRITE-5. DB1054.2 +088600 MOVE 0 TO INCREMENT. DB1054.2 +088700 MOVE "NESTED PERFORM" TO FEATURE. DB1054.2 +088800 MOVE "PROC-061-PFM-TEST-5" TO PAR-NAME. DB1054.2 +088900 PROC-065-PFM-TEST-6. DB1054.2 +089000 MOVE 0 TO INCREMENT. DB1054.2 +089100 PERFORM PROC-066-PFM-N. DB1054.2 +089200 GO TO PROC-069-PFM-WRITE-6. DB1054.2 +089300 PROC-000-PFM-DELETE-6. DB1054.2 +089400 MOVE 0 TO INCREMENT. DB1054.2 +089500 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +089600 PROC-069-PFM-WRITE-6. DB1054.2 +089700 MOVE 0 TO INCREMENT. DB1054.2 +089800 MOVE "PERFORM SECTION-NAME" TO FEATURE. DB1054.2 +089900 MOVE "PROC-065-PFM-TEST-6" TO PAR-NAME. DB1054.2 +090000 PROC-070-PFM-TEST-7. DB1054.2 +090100 MOVE 0 TO INCREMENT. DB1054.2 +090200 PERFORM PROC-071-PFM-V THRU PROC-075-PFM-Z 5 TIMES. DB1054.2 +090300 MOVE 0 TO INCREMENT. DB1054.2 +090400 GO TO PROC-096-PFM-WRITE-7. DB1054.2 +090500 PROC-000-PFM-DELETE-7. DB1054.2 +090600 MOVE 0 TO INCREMENT. DB1054.2 +090700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +090800 PROC-096-PFM-WRITE-7. DB1054.2 +090900 MOVE 0 TO INCREMENT. DB1054.2 +091000 MOVE "PERFORM EXIT PARAS" TO FEATURE. DB1054.2 +091100 MOVE "PROC-070-PFM-TEST-7" TO PAR-NAME. DB1054.2 +091200 PROC-097-PFM-TEST-08. DB1054.2 +091300 MOVE 0 TO INCREMENT. DB1054.2 +091400 MOVE ZERO TO P-COUNT DB1054.2 +091500 PERFORM PROC-098-PFM-B-8. DB1054.2 +091600 ADD 1 TO P-COUNT. DB1054.2 +091700 PERFORM PROC-097-PFM-A-8. DB1054.2 +091800 ADD 1 TO P-COUNT. DB1054.2 +091900 PROC-097-PFM-A-8 SECTION. DB1054.2 +092000 PROC-098-PFM-B-8. DB1054.2 +092100 ADD 2 TO INCREMENT. DB1054.2 +092200 ADD 100 TO P-COUNT. DB1054.2 +092300 PROC-097-PFM-TESTT-8 SECTION. DB1054.2 +092400 PROC-098-PFM-TESTTT-8. DB1054.2 +092500 MOVE 0 TO INCREMENT. DB1054.2 +092600 IF P-COUNT EQUAL TO 000302 DB1054.2 +092700 GO TO PROC-105-PFM-WRITE-08. DB1054.2 +092800 GO TO PROC-000-PFM-NUC-FAIL-08. DB1054.2 +092900 PROC-000-DELETE-08. DB1054.2 +093000 MOVE 0 TO INCREMENT. DB1054.2 +093100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +093200 GO TO PROC-105-PFM-WRITE-08. DB1054.2 +093300 PROC-000-PFM-NUC-FAIL-08. DB1054.2 +093400 MOVE 0 TO INCREMENT. DB1054.2 +093500 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +093600 MOVE 000302 TO CORRECT-N. DB1054.2 +093700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +093800 PROC-105-PFM-WRITE-08. DB1054.2 +093900 MOVE 0 TO INCREMENT. DB1054.2 +094000 MOVE "PERFORM " TO FEATURE. DB1054.2 +094100 MOVE "PROC-097-PFM-TEST-08" TO PAR-NAME. DB1054.2 +094200 PROC-106-PFM-TEST-09. DB1054.2 +094300 MOVE 0 TO INCREMENT. DB1054.2 +094400 MOVE ZERO TO P-COUNT. DB1054.2 +094500 PERFORM PROC-107-PFM-B-9 1 TIMES. DB1054.2 +094600 ADD 1 TO P-COUNT. DB1054.2 +094700 PERFORM PROC-106-PFM-A-9 ATWO-DS-01V00 TIMES. DB1054.2 +094800 ADD 1 TO P-COUNT. DB1054.2 +094900 PROC-106-PFM-A-9 SECTION. DB1054.2 +095000 PROC-107-PFM-B-9. DB1054.2 +095100 ADD 2 TO INCREMENT. DB1054.2 +095200 ADD 100 TO P-COUNT. DB1054.2 +095300 PROC-106-PFM-TESTT-9 SECTION. DB1054.2 +095400 PROC-107-PFM-TESTTT-9. DB1054.2 +095500 MOVE 0 TO INCREMENT. DB1054.2 +095600 IF P-COUNT EQUAL TO 000402 DB1054.2 +095700 GO TO PROC-116-PFM-WRITE-09. DB1054.2 +095800 GO TO PROC-000-PFM-NUC-FAIL-09. DB1054.2 +095900 PROC-000-PFM-DELETE-09. DB1054.2 +096000 MOVE 0 TO INCREMENT. DB1054.2 +096100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +096200 GO TO PROC-116-PFM-WRITE-09. DB1054.2 +096300 PROC-000-PFM-NUC-FAIL-09. DB1054.2 +096400 MOVE 0 TO INCREMENT. DB1054.2 +096500 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +096600 MOVE 000502 TO CORRECT-N. DB1054.2 +096700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +096800 PROC-116-PFM-WRITE-09. DB1054.2 +096900 MOVE 0 TO INCREMENT. DB1054.2 +097000 MOVE "PERFORM TIMES " TO FEATURE. DB1054.2 +097100 MOVE "PROC-106-PFM-TEST-09" TO PAR-NAME. DB1054.2 +097200 PROC-117-PFM-TEST-10. DB1054.2 +097300 MOVE 0 TO INCREMENT. DB1054.2 +097400 MOVE ZERO TO P-COUNT. DB1054.2 +097500 PERFORM PROC-118-PFM-B-10 THROUGH PROC-120-PFM-D-10. DB1054.2 +097600 MOVE 4 TO INCREMENT. DB1054.2 +097700 ADD 1 TO P-COUNT DB1054.2 +097800 PERFORM PROC-117-PFM-A-10 THRU PROC-119-PFM-C-10. DB1054.2 +097900 MOVE 8 TO INCREMENT. DB1054.2 +098000 ADD 1 TO P-COUNT. DB1054.2 +098100 PERFORM PROC-117-PFM-A-10 THRU PROC-120-PFM-D-10. DB1054.2 +098200 MOVE 11 TO INCREMENT. DB1054.2 +098300 ADD 1 TO P-COUNT. DB1054.2 +098400 PERFORM PROC-118-PFM-B-10 THRU PROC-119-PFM-C-10. DB1054.2 +098500 MOVE 15 TO INCREMENT. DB1054.2 +098600 ADD 1 TO P-COUNT. DB1054.2 +098700 PROC-117-PFM-A-10 SECTION. DB1054.2 +098800 PROC-118-PFM-B-10. DB1054.2 +098900 ADD 100 TO P-COUNT. DB1054.2 +099000 PROC-119-PFM-C-10 SECTION. DB1054.2 +099100 PROC-120-PFM-D-10. DB1054.2 +099200 ADD 10000 TO P-COUNT. DB1054.2 +099300 PROC-121-PFM-TESTT-10 SECTION. DB1054.2 +099400 PROC-122-PFM-TESTTT-10. DB1054.2 +099500 MOVE 0 TO INCREMENT. DB1054.2 +099600 IF P-COUNT EQUAL TO 050504 DB1054.2 +099700 GO TO PROC-138-PFM-WRITE-10. DB1054.2 +099800 GO TO PROC-000-PFM-NUC-FAIL-10. DB1054.2 +099900 PROC-000-PFM-DELETE-10. DB1054.2 +100000 MOVE 0 TO INCREMENT. DB1054.2 +100100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +100200 GO TO PROC-138-PFM-WRITE-10. DB1054.2 +100300 PROC-000-PFM-NUC-FAIL-10. DB1054.2 +100400 MOVE 0 TO INCREMENT. DB1054.2 +100500 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +100600 MOVE 050504 TO CORRECT-N. DB1054.2 +100700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +100800 PROC-138-PFM-WRITE-10. DB1054.2 +100900 MOVE 0 TO INCREMENT. DB1054.2 +101000 MOVE "PERFORM THRU " TO FEATURE. DB1054.2 +101100 MOVE "PROC-117-PFM-TEST-10" TO PAR-NAME. DB1054.2 +101200 PROC-139-PFM-TEST-11. DB1054.2 +101300 MOVE 0 TO INCREMENT. DB1054.2 +101400 MOVE ZERO TO P-COUNT. DB1054.2 +101500 PERFORM PROC-140-PFM-B-11 THROUGH PROC-140-PFM-D-11 1 TIMES. DB1054.2 +101600 MOVE 4 TO INCREMENT. DB1054.2 +101700 ADD 1 TO P-COUNT. DB1054.2 +101800 PERFORM PROC-139-PFM-A-11 THRU PROC-139-PFM-C-11 2 TIMES. DB1054.2 +101900 MOVE 12 TO INCREMENT. DB1054.2 +102000 ADD 1 TO P-COUNT. DB1054.2 +102100 PERFORM PROC-139-PFM-A-11 THRU PROC-140-PFM-D-11 2 TIMES. DB1054.2 +102200 MOVE 19 TO INCREMENT. DB1054.2 +102300 ADD 1 TO P-COUNT. DB1054.2 +102400 PERFORM PROC-140-PFM-B-11 THRU PROC-139-PFM-C-11 1 TIMES. DB1054.2 +102500 MOVE 23 TO INCREMENT. DB1054.2 +102600 ADD 1 TO P-COUNT. DB1054.2 +102700 PROC-139-PFM-A-11 SECTION. DB1054.2 +102800 PROC-140-PFM-B-11. DB1054.2 +102900 ADD 2 TO INCREMENT. DB1054.2 +103000 ADD 100 TO P-COUNT. DB1054.2 +103100 PROC-139-PFM-C-11 SECTION. DB1054.2 +103200 PROC-140-PFM-D-11. DB1054.2 +103300 ADD 2 TO INCREMENT. DB1054.2 +103400 ADD 10000 TO P-COUNT. DB1054.2 +103500 PROC-139-PFM-TESTT-11 SECTION. DB1054.2 +103600 PROC-140-PFM-TESTTT-11. DB1054.2 +103700 MOVE 0 TO INCREMENT. DB1054.2 +103800 IF P-COUNT EQUAL TO 070704 DB1054.2 +103900 GO TO PROC-168-PFM-WRITE-11. DB1054.2 +104000 GO TO PROC-000-PFM-NUC-FAIL-11. DB1054.2 +104100 PROC-000-PFM-DELETE-11. DB1054.2 +104200 MOVE 0 TO INCREMENT. DB1054.2 +104300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +104400 GO TO PROC-168-PFM-WRITE-11. DB1054.2 +104500 PROC-000-PFM-NUC-FAIL-11. DB1054.2 +104600 MOVE 0 TO INCREMENT. DB1054.2 +104700 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +104800 MOVE 090904 TO CORRECT-N. DB1054.2 +104900 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +105000 PROC-168-PFM-WRITE-11. DB1054.2 +105100 MOVE 0 TO INCREMENT. DB1054.2 +105200 MOVE "PERFORM THRU, TIMES " TO FEATURE. DB1054.2 +105300 MOVE "PROC-139-PFM-TEST-11" TO PAR-NAME. DB1054.2 +105400 PROC-169-PFM-TEST-12. DB1054.2 +105500 MOVE 0 TO INCREMENT. DB1054.2 +105600 MOVE ZERO TO P-COUNT. DB1054.2 +105700 ADD 1 TO P-COUNT. DB1054.2 +105800 PERFORM PROC-170-PFM-A-12. DB1054.2 +105900 ADD 2 TO P-COUNT. DB1054.2 +106000 GO TO PROC-175-PFM-TESTT-12. DB1054.2 +106100 PROC-170-PFM-A-12. DB1054.2 +106200 MOVE 0 TO INCREMENT. DB1054.2 +106300 ADD 10 TO P-COUNT. DB1054.2 +106400 PERFORM PROC-171-PFM-B-12. DB1054.2 +106500 ADD 20 TO P-COUNT. DB1054.2 +106600 PROC-171-PFM-B-12. DB1054.2 +106700 MOVE 0 TO INCREMENT. DB1054.2 +106800 ADD 100 TO P-COUNT. DB1054.2 +106900 PERFORM PROC-172-PFM-C-12. DB1054.2 +107000 ADD 200 TO P-COUNT. DB1054.2 +107100 PROC-172-PFM-C-12. DB1054.2 +107200 MOVE 0 TO INCREMENT. DB1054.2 +107300 ADD 1000 TO P-COUNT. DB1054.2 +107400 PERFORM PROC-173-PFM-D-12. DB1054.2 +107500 ADD 2000 TO P-COUNT. DB1054.2 +107600 PROC-173-PFM-D-12. DB1054.2 +107700 MOVE 0 TO INCREMENT. DB1054.2 +107800 ADD 10000 TO P-COUNT. DB1054.2 +107900 PERFORM PROC-174-PFM-E-12. DB1054.2 +108000 ADD 20000 TO P-COUNT. DB1054.2 +108100 PROC-174-PFM-E-12. DB1054.2 +108200 MOVE 0 TO INCREMENT. DB1054.2 +108300 ADD 100000 TO P-COUNT. DB1054.2 +108400 PROC-175-PFM-TESTT-12. DB1054.2 +108500 MOVE 0 TO INCREMENT. DB1054.2 +108600 IF P-COUNT EQUAL TO 133333 DB1054.2 +108700 GO TO PROC-176-PFM-WRITE-12. DB1054.2 +108800 GO TO PROC-000-PFM-NUC-FAIL-12. DB1054.2 +108900 PROC-000-PFM-DELETE-12. DB1054.2 +109000 MOVE 0 TO INCREMENT. DB1054.2 +109100 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +109200 GO TO PROC-176-PFM-WRITE-12. DB1054.2 +109300 PROC-000-PFM-NUC-FAIL-12. DB1054.2 +109400 MOVE 0 TO INCREMENT. DB1054.2 +109500 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +109600 MOVE 133333 TO CORRECT-N. DB1054.2 +109700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +109800 PROC-176-PFM-WRITE-12. DB1054.2 +109900 MOVE 0 TO INCREMENT. DB1054.2 +110000 MOVE "NESTED PERFORM " TO FEATURE. DB1054.2 +110100 MOVE "PROC-169-PFM-TEST-12" TO PAR-NAME. DB1054.2 +110200 PROC-177-PFM-TEST-13. DB1054.2 +110300 MOVE 0 TO INCREMENT. DB1054.2 +110400 MOVE ZERO TO P-COUNT. DB1054.2 +110500 PERFORM PROC-178-PFM-A-13 THRU PROC-177-PFM-B-13. DB1054.2 +110600 ADD 1 TO P-COUNT. DB1054.2 +110700 MOVE 2 TO INCREMENT. DB1054.2 +110800 PERFORM PROC-178-PFM-A-13 THRU PROC-177-PFM-B-13 2 TIMES. DB1054.2 +110900 ADD 2 TO P-COUNT. DB1054.2 +111000 PROC-178-PFM-A-13. DB1054.2 +111100 ADD 2 TO INCREMENT. DB1054.2 +111200 ADD 100 TO P-COUNT. DB1054.2 +111300 PROC-177-PFM-B-13. DB1054.2 +111400 EXIT. DB1054.2 +111500 PROC-178-PFM-TESTT-13. DB1054.2 +111600 MOVE 0 TO INCREMENT. DB1054.2 +111700 IF P-COUNT EQUAL TO 000403 DB1054.2 +111800 GO TO PROC-187-PFM-WRITE-13. DB1054.2 +111900 GO TO PROC-000-PFM-NUC-FAIL-13. DB1054.2 +112000 PROC-000-PFM-DELETE-13. DB1054.2 +112100 MOVE 0 TO INCREMENT. DB1054.2 +112200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +112300 GO TO PROC-187-PFM-WRITE-13. DB1054.2 +112400 PROC-000-PFM-NUC-FAIL-13. DB1054.2 +112500 MOVE 0 TO INCREMENT. DB1054.2 +112600 MOVE P-COUNT TO COMPUTED-N. DB1054.2 +112700 MOVE 000403 TO CORRECT-N. DB1054.2 +112800 MOVE "PERFORM WITH EXIT" TO FEATURE. DB1054.2 +112900 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +113000 PROC-187-PFM-WRITE-13. DB1054.2 +113100 MOVE 0 TO INCREMENT. DB1054.2 +113200 MOVE "PROC-177-PFM-TEST-13" TO PAR-NAME. DB1054.2 +113300 PROC-188-PFM-TEST-14. DB1054.2 +113400 MOVE 0 TO INCREMENT. DB1054.2 +113500 PERFORM PROC-189-A101. DB1054.2 +113600 IF PERFORM-HOLD EQUAL TO "ABCDEFGHIJKLMNOPQRST" DB1054.2 +113700 GO TO PROC-210-PFM-WRITE-14. DB1054.2 +113800 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. DB1054.2 +113900 MOVE PERFORM-HOLD TO COMPUTED-A. DB1054.2 +114000 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +114100 GO TO PROC-210-PFM-WRITE-14. DB1054.2 +114200 PROC-000-PFM-DELETE-14. DB1054.2 +114300 MOVE 0 TO INCREMENT. DB1054.2 +114400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +114500 PROC-210-PFM-WRITE-14. DB1054.2 +114600 MOVE 0 TO INCREMENT. DB1054.2 +114700 MOVE "PROC-188-PFM-TEST-14" TO PAR-NAME. DB1054.2 +114800 PROC-211-PFM-A-15 SECTION. DB1054.2 +114900 PROC-212-PFM-TEST-15. DB1054.2 +115000 MOVE 0 TO INCREMENT. DB1054.2 +115100 PERFORM PROC-213-PFM-G-15 THRU PROC-217-PFM-B-15. DB1054.2 +115200 GO TO PROC-218-PFM-WRITE-15. DB1054.2 +115300 PROC-000-PFM-DELETE-15. DB1054.2 +115400 MOVE 0 TO INCREMENT. DB1054.2 +115500 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +115600 GO TO PROC-218-PFM-WRITE-15. DB1054.2 +115700 PROC-217-PFM-B-15. DB1054.2 +115800 MOVE 0 TO INCREMENT. DB1054.2 +115900 ADD 1 TO REC-CT. DB1054.2 +116000 PROC-000-PFM-C-15. DB1054.2 +116100 MOVE 0 TO INCREMENT. DB1054.2 +116200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +116300 MOVE "RETURN MECHANISM LOST" TO RE-MARK. DB1054.2 +116400 GO TO PROC-218-PFM-WRITE-15. DB1054.2 +116500 PROC-000-PFM-D-15. DB1054.2 +116600 MOVE 0 TO INCREMENT. DB1054.2 +116700 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +116800 MOVE "PERFORM GOT LOST IN GO TOS" TO RE-MARK. DB1054.2 +116900 GO TO PROC-218-PFM-WRITE-15. DB1054.2 +117000 PROC-215-PFM-E-15. DB1054.2 +117100 MOVE 0 TO INCREMENT. DB1054.2 +117200 GO TO PROC-216-PFM-L-15. DB1054.2 +117300 PROC-000-PFM-F-15. DB1054.2 +117400 MOVE 0 TO INCREMENT. DB1054.2 +117500 GO TO PROC-000-PFM-D-15. DB1054.2 +117600 PROC-213-PFM-G-15 SECTION. DB1054.2 +117700 PROC-214-PFM-H-15. DB1054.2 +117800 MOVE 0 TO INCREMENT. DB1054.2 +117900 GO TO PROC-215-PFM-E-15. DB1054.2 +118000 PROC-000-PFM-I-15. DB1054.2 +118100 MOVE 0 TO INCREMENT. DB1054.2 +118200 GO TO PROC-000-PFM-D-15. DB1054.2 +118300 PROC-000-PFM-J-15 SECTION. DB1054.2 +118400 PROC-000-PFM-K-15. DB1054.2 +118500 MOVE 0 TO INCREMENT. DB1054.2 +118600 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +118700 MOVE "PROC-000-PFM-K-15 ENTERED" TO RE-MARK. DB1054.2 +118800 GO TO PROC-218-PFM-WRITE-15. DB1054.2 +118900 PROC-216-PFM-L-15. DB1054.2 +119000 MOVE 0 TO INCREMENT. DB1054.2 +119100 GO TO PROC-217-PFM-B-15. DB1054.2 +119200 PROC-218-PFM-WRITE-15. DB1054.2 +119300 MOVE 0 TO INCREMENT. DB1054.2 +119400 MOVE "PERFORM GO TO PARAS" TO FEATURE. DB1054.2 +119500 MOVE "PROC-212-PFM-TEST-15" TO PAR-NAME. DB1054.2 +119600 PROC-219-PFM-TEST-LAST. DB1054.2 +119700 MOVE 0 TO INCREMENT. DB1054.2 +119800 MOVE 7 TO PERFORM5. DB1054.2 +119900 PERFORM PROC-220-PFM-U PERFORM5 TIMES. DB1054.2 +120000 MOVE 0 TO INCREMENT. DB1054.2 +120100 IF PERFORM5 EQUAL TO 707 DB1054.2 +120200 GO TO PROC-227-PFM-WRITE-LAST. DB1054.2 +120300 GO TO PROC-000-PFM-NUC-FAIL-LST. DB1054.2 +120400 PROC-000-PFM-DELETE-LAST. DB1054.2 +120500 MOVE 0 TO INCREMENT. DB1054.2 +120600 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +120700 GO TO PROC-227-PFM-WRITE-LAST. DB1054.2 +120800 PROC-000-PFM-NUC-FAIL-LST. DB1054.2 +120900 MOVE 0 TO INCREMENT. DB1054.2 +121000 MOVE PERFORM5 TO COMPUTED-N. DB1054.2 +121100 MOVE 707 TO CORRECT-N. DB1054.2 +121200 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +121300 PROC-227-PFM-WRITE-LAST. DB1054.2 +121400 IF PROC-ACTIVE IS NOT EQUAL TO 0 DB1054.2 +121500 MOVE " DEBUGGING PROCEDURE WAS NEVER EXECUTED. NO FURTHEDB1054.2 +121600- "R REPORT WILL BE GENERATED." TO DUMMY-RECORD DB1054.2 +121700 PERFORM WRITE-LINE DB1054.2 +121800 MOVE 227 TO ERROR-COUNTER DB1054.2 +121900 GO TO CCVS-EXIT. DB1054.2 +122000 MOVE 0 TO INCREMENT. DB1054.2 +122100 MOVE SPACE TO TEST-RESULTS. DB1054.2 +122200 MOVE "DEBUG ALL PROCEDURES" TO FEATURE. DB1054.2 +122300 MOVE 0 TO REC-CT. DB1054.2 +122400 MOVE 1 TO BYPASS. DB1054.2 +122500 SET STACK-END TO STACK-INDEX. DB1054.2 +122600 SET STACK-INDEX TO 1. DB1054.2 +122700 SET STATIC-INDEX TO 1. DB1054.2 +122800 PERFORM NAME-LISTER 227 TIMES. DB1054.2 +122900 EMPTY-THE-STACK. DB1054.2 +123000 IF STACK-INDEX IS NOT LESS THAN STACK-END GO TO STACK-EMPTY. DB1054.2 +123100 PERFORM CORRECT-GT-STACK. DB1054.2 +123200 GO TO EMPTY-THE-STACK. DB1054.2 +123300 STACK-EMPTY. DB1054.2 +123400 MOVE SPACE TO DUMMY-RECORD. DB1054.2 +123500 MOVE 51 TO RECORD-COUNT. DB1054.2 +123600 PERFORM WRITE-LINE. DB1054.2 +123700 MOVE FLOW-FAILURE-1 TO DUMMY-RECORD. DB1054.2 +123800 PERFORM WRITE-LINE. DB1054.2 +123900 MOVE FLOW-FAILURE-2 TO DUMMY-RECORD. DB1054.2 +124000 PERFORM WRITE-LINE 2 TIMES. DB1054.2 +124100* DB1054.2 +124200 GO TO CCVS-EXIT. DB1054.2 +124300 NAME-LISTER SECTION. DB1054.2 +124400 NAME-LISTER-1. DB1054.2 +124500 MOVE EXPECTED-NAME (STATIC-INDEX) TO TABLE-ENTRY. DB1054.2 +124600 SET TABLE-ENTRY-BASE TO STATIC-INDEX. DB1054.2 +124700 IF STACK-INDEX IS EQUAL TO STACK-END GO TO STACK-GT-CORRECT. DB1054.2 +124800 IF BASE-NUMBER (STACK-INDEX) IS NOT NUMERIC DB1054.2 +124900 GO TO CORRECT-GT-STACK. DB1054.2 +125000 IF TABLE-ENTRY-BASE IS GREATER THAN BASE-NUMBER (STACK-INDEX)DB1054.2 +125100 GO TO CORRECT-GT-STACK. DB1054.2 +125200 IF TABLE-ENTRY-BASE IS LESS THAN BASE-NUMBER (STACK-INDEX) DB1054.2 +125300 GO TO STACK-GT-CORRECT. DB1054.2 +125400 CORRECT-EQ-STACK. DB1054.2 +125500 MOVE EXPECTED-NAME (STATIC-INDEX) TO PAR-NAME. DB1054.2 +125600 MOVE TABLE-ENTRY TO CORRECT-A. DB1054.2 +125700 MOVE PROC-NAME (STACK-INDEX) TO COMPUTED-A. DB1054.2 +125800 IF CORRECT-A IS NOT EQUAL TO COMPUTED-A PERFORM FAIL DB1054.2 +125900 ELSE PERFORM PASS. DB1054.2 +126000 PERFORM PRINT-DETAIL. DB1054.2 +126100 IF STACK-INDEX IS LESS THAN 500 DB1054.2 +126200 SET STACK-INDEX UP BY 1. DB1054.2 +126300 IF STATIC-INDEX IS LESS THAN 227 DB1054.2 +126400 SET STATIC-INDEX UP BY 1. DB1054.2 +126500 GO TO NAME-LISTER-EXIT. DB1054.2 +126600 CORRECT-GT-STACK. DB1054.2 +126700 MOVE PROC-NAME (STACK-INDEX) TO COMPUTED-A. DB1054.2 +126800 PERFORM FAIL. DB1054.2 +126900 PERFORM PRINT-DETAIL. DB1054.2 +127000 IF STACK-INDEX IS LESS THAN 500 DB1054.2 +127100 SET STACK-INDEX UP BY 1. DB1054.2 +127200 CORRECT-GT-STACK-1. DB1054.2 +127300 GO TO NAME-LISTER-1. DB1054.2 +127400 STACK-GT-CORRECT. DB1054.2 +127500 MOVE EXPECTED-NAME (STATIC-INDEX) TO PAR-NAME. DB1054.2 +127600 MOVE TABLE-ENTRY TO CORRECT-A. DB1054.2 +127700 PERFORM FAIL. DB1054.2 +127800 PERFORM PRINT-DETAIL. DB1054.2 +127900 IF STATIC-INDEX IS LESS THAN 227 DB1054.2 +128000 SET STATIC-INDEX UP BY 1. DB1054.2 +128100 NAME-LISTER-EXIT. DB1054.2 +128200 EXIT. DB1054.2 +128300 OTHER-PROCEDURES SECTION. DB1054.2 +128400 PROC-000-NUCLEUS-FAILURE. DB1054.2 +128500 ADD 1 TO NUC-FAILURE-COUNT. DB1054.2 +128600 PROC-209-A121. DB1054.2 +128700 EXIT. DB1054.2 +128800 PROC-208-A120. DB1054.2 +128900 MOVE 0 TO INCREMENT. DB1054.2 +129000 MOVE "T" TO TEST-LETTER (20). DB1054.2 +129100 PERFORM PROC-209-A121. DB1054.2 +129200 PROC-207-A119. DB1054.2 +129300 MOVE 0 TO INCREMENT. DB1054.2 +129400 MOVE "S" TO TEST-LETTER (19). DB1054.2 +129500 PERFORM PROC-208-A120. DB1054.2 +129600 PROC-206-A118. DB1054.2 +129700 MOVE 0 TO INCREMENT. DB1054.2 +129800 MOVE "R" TO TEST-LETTER (18). DB1054.2 +129900 PERFORM PROC-207-A119. DB1054.2 +130000 PROC-205-A117. DB1054.2 +130100 MOVE 0 TO INCREMENT. DB1054.2 +130200 MOVE "Q" TO TEST-LETTER (17). DB1054.2 +130300 PERFORM PROC-206-A118. DB1054.2 +130400 PROC-204-A116. DB1054.2 +130500 MOVE 0 TO INCREMENT. DB1054.2 +130600 MOVE "P" TO TEST-LETTER (16). DB1054.2 +130700 PERFORM PROC-205-A117. DB1054.2 +130800 PROC-203-A115. DB1054.2 +130900 MOVE 0 TO INCREMENT. DB1054.2 +131000 MOVE "O" TO TEST-LETTER (15). DB1054.2 +131100 PERFORM PROC-204-A116. DB1054.2 +131200 PROC-202-A114. DB1054.2 +131300 MOVE 0 TO INCREMENT. DB1054.2 +131400 MOVE "N" TO TEST-LETTER (14). DB1054.2 +131500 PERFORM PROC-203-A115. DB1054.2 +131600 PROC-201-A113. DB1054.2 +131700 MOVE 0 TO INCREMENT. DB1054.2 +131800 MOVE "M" TO TEST-LETTER (13). DB1054.2 +131900 PERFORM PROC-202-A114. DB1054.2 +132000 PROC-200-A112. DB1054.2 +132100 MOVE 0 TO INCREMENT. DB1054.2 +132200 MOVE "L" TO TEST-LETTER (12). DB1054.2 +132300 PERFORM PROC-201-A113. DB1054.2 +132400 PROC-199-A111. DB1054.2 +132500 MOVE 0 TO INCREMENT. DB1054.2 +132600 MOVE "K" TO TEST-LETTER (11). DB1054.2 +132700 PERFORM PROC-200-A112. DB1054.2 +132800 PROC-198-A110. DB1054.2 +132900 MOVE 0 TO INCREMENT. DB1054.2 +133000 MOVE "J" TO TEST-LETTER (10). DB1054.2 +133100 PERFORM PROC-199-A111. DB1054.2 +133200 PROC-197-A109. DB1054.2 +133300 MOVE 0 TO INCREMENT. DB1054.2 +133400 MOVE "I" TO TEST-LETTER (9). DB1054.2 +133500 PERFORM PROC-198-A110. DB1054.2 +133600 PROC-196-A108. DB1054.2 +133700 MOVE 0 TO INCREMENT. DB1054.2 +133800 MOVE "H" TO TEST-LETTER (8). DB1054.2 +133900 PERFORM PROC-197-A109. DB1054.2 +134000 PROC-195-A107. DB1054.2 +134100 MOVE 0 TO INCREMENT. DB1054.2 +134200 MOVE "G" TO TEST-LETTER (7). DB1054.2 +134300 PERFORM PROC-196-A108. DB1054.2 +134400 PROC-194-A106. DB1054.2 +134500 MOVE 0 TO INCREMENT. DB1054.2 +134600 MOVE "F" TO TEST-LETTER (6). DB1054.2 +134700 PERFORM PROC-195-A107. DB1054.2 +134800 PROC-193-A105. DB1054.2 +134900 MOVE 0 TO INCREMENT. DB1054.2 +135000 MOVE "E" TO TEST-LETTER (5). DB1054.2 +135100 PERFORM PROC-194-A106. DB1054.2 +135200 PROC-192-A104. DB1054.2 +135300 MOVE 0 TO INCREMENT. DB1054.2 +135400 MOVE "D" TO TEST-LETTER (4). DB1054.2 +135500 PERFORM PROC-193-A105. DB1054.2 +135600 PROC-191-A103. DB1054.2 +135700 MOVE 0 TO INCREMENT. DB1054.2 +135800 MOVE "C" TO TEST-LETTER (3). DB1054.2 +135900 PERFORM PROC-192-A104. DB1054.2 +136000 PROC-190-A102. DB1054.2 +136100 MOVE 0 TO INCREMENT. DB1054.2 +136200 MOVE "B" TO TEST-LETTER (2). DB1054.2 +136300 PERFORM PROC-191-A103. DB1054.2 +136400 PROC-189-A101. DB1054.2 +136500 MOVE 0 TO INCREMENT. DB1054.2 +136600 MOVE "A" TO TEST-LETTER (1). DB1054.2 +136700 PERFORM PROC-190-A102. DB1054.2 +136800 PROC-048-PFM-C. DB1054.2 +136900 ADD 1 TO INCREMENT. DB1054.2 +137000 ADD 6 TO PERFORM2. DB1054.2 +137100 PROC-000-PFM-D. DB1054.2 +137200 MOVE 0 TO INCREMENT. DB1054.2 +137300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +137400 GO TO PROC-055-PFM-TEST-4. DB1054.2 +137500* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH DB1054.2 +137600* FROM THE PREVIOUS ONE. DB1054.2 +137700 PROC-056-PFM-E. DB1054.2 +137800 MOVE 0 TO INCREMENT. DB1054.2 +137900 MOVE "CSW" TO PERFORM1. DB1054.2 +138000 PERFORM PROC-057-PFM-F THRU PROC-058-PFM-G. DB1054.2 +138100 SUBTRACT .8 FROM PERFORM4. DB1054.2 +138200 GO TO PROC-059-PFM-H. DB1054.2 +138300 PROC-057-PFM-F. DB1054.2 +138400 MOVE 0 TO INCREMENT. DB1054.2 +138500 MOVE 60.5 TO PERFORM4. DB1054.2 +138600 PROC-058-PFM-G. DB1054.2 +138700 MOVE 0 TO INCREMENT. DB1054.2 +138800 ADD 10.3 TO PERFORM4. DB1054.2 +138900 PROC-059-PFM-H. DB1054.2 +139000 EXIT. DB1054.2 +139100 PROC-000-PFM-I. DB1054.2 +139200 MOVE 0 TO INCREMENT. DB1054.2 +139300 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +139400 GO TO PROC-060-PFM-WRITE-4. DB1054.2 +139500* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH DB1054.2 +139600* FROM THE PREVIOUS ONE. DB1054.2 +139700 PROC-062-PFM-J. DB1054.2 +139800 MOVE 0 TO INCREMENT. DB1054.2 +139900 MOVE "YES" TO PERFORM1. DB1054.2 +140000 PERFORM PROC-063-PFM-L. DB1054.2 +140100 MULTIPLY 3 BY PERFORM2. DB1054.2 +140200 PROC-000-PFM-K. DB1054.2 +140300 MOVE 0 TO INCREMENT. DB1054.2 +140400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +140500 GO TO PROC-064-PFM-WRITE-5. DB1054.2 +140600* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH DB1054.2 +140700* FROM THE PREVIOUS ONE. DB1054.2 +140800 PROC-063-PFM-L. DB1054.2 +140900 MOVE 0 TO INCREMENT. DB1054.2 +141000 MOVE 4 TO PERFORM2. DB1054.2 +141100 ADD 100 TO PERFORM2. DB1054.2 +141200 PROC-000-PFM-M. DB1054.2 +141300 MOVE 0 TO INCREMENT. DB1054.2 +141400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +141500 GO TO PROC-064-PFM-WRITE-5. DB1054.2 +141600* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH DB1054.2 +141700* FROM THE PREVIOUS ONE. DB1054.2 +141800 PROC-066-PFM-N SECTION. DB1054.2 +141900 PROC-067-PFM-O. DB1054.2 +142000 MOVE 0 TO INCREMENT. DB1054.2 +142100 ADD 1 TO NUC-FAILURE-COUNT. DB1054.2 +142200 PROC-068-PFM-P. DB1054.2 +142300 MOVE 0 TO INCREMENT. DB1054.2 +142400 SUBTRACT 1 FROM NUC-FAILURE-COUNT. DB1054.2 +142500 PROC-000-PFM-Q SECTION. DB1054.2 +142600 PROC-000-PFM-R. DB1054.2 +142700 MOVE 0 TO INCREMENT. DB1054.2 +142800 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +142900 GO TO PROC-069-PFM-WRITE-6. DB1054.2 +143000* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH FROM THE DB1054.2 +143100* PREVIOUS ONE. DB1054.2 +143200 PROC-000-PFM-S. DB1054.2 +143300 MOVE 0 TO INCREMENT. DB1054.2 +143400 ADD 1 TO PERFORM5. DB1054.2 +143500 PROC-000-PFM-T. DB1054.2 +143600 MOVE 0 TO INCREMENT. DB1054.2 +143700 ADD 10 TO PERFORM5. DB1054.2 +143800 PROC-220-PFM-U. DB1054.2 +143900 ADD 1 TO INCREMENT. DB1054.2 +144000 ADD 100 TO PERFORM5. DB1054.2 +144100 IF PERFORM5 GREATER THAN 899 DB1054.2 +144200 MOVE PERFORM5 TO COMPUTED-N DB1054.2 +144300 MOVE 707 TO CORRECT-N DB1054.2 +144400 PERFORM PROC-000-NUCLEUS-FAILURE. DB1054.2 +144500 PROC-071-PFM-V. EXIT. DB1054.2 +144600 PROC-072-PFM-W. EXIT. DB1054.2 +144700 PROC-073-PFM-X. EXIT. DB1054.2 +144800 PROC-074-PFM-Y. EXIT. DB1054.2 +144900 PROC-075-PFM-Z. ADD 5 TO INCREMENT. DB1054.2 +145000 CCVS-EXIT SECTION. DB1054.2 +145100 CCVS-999999. DB1054.2 +145200 GO TO CLOSE-FILES. DB1054.2 +*END-OF,DB105A +*HEADER,COBOL,DB201A +000100 IDENTIFICATION DIVISION. DB2014.2 +000200 PROGRAM-ID. DB2014.2 +000300 DB201A. DB2014.2 +000400 AUTHOR. DB2014.2 +000500 FEDERAL COMPILER TESTING CENTER. DB2014.2 +000600 INSTALLATION. DB2014.2 +000700 GENERAL SERVICES ADMINISTRATION DB2014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB2014.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB2014.2 +001100 FALLS CHURCH VIRGINIA 22041. DB2014.2 +001200 DB2014.2 +001300 PHONE (703) 756-6153 DB2014.2 +001400 DB2014.2 +001500 " HIGH ". DB2014.2 +001600 DATE-WRITTEN. DB2014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2014.2 +001800 CREATION DATE / VALIDATION DATE DB2014.2 +001900 "4.2 ". DB2014.2 +002000 SECURITY. DB2014.2 +002100 NONE. DB2014.2 +002200* DB2014.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB2014.2 +002400* DB2014.2 +002500* PROGRAM ABSTRACT DB2014.2 +002600* DB2014.2 +002700* DB201A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE DB2014.2 +002800* DEBUGGING PROCEDURES WHICH ARE MONITORING IDENTIFIERS DB2014.2 +002900* SPECIFIED WITH AND WITHOUT THE "ALL REFERENCES" OPTION. DB2014.2 +003000* THIS PROGRAM IS TO BE COMPILED AND EXECUTED WITH BOTH DB2014.2 +003100* COMPILE AND OBJECT TIME DEBUGGING SWITCHES ENABLED. THE DB2014.2 +003200* DEBUGGING PROCEDURES SHOULD BE INCLUDED IN COMPILATION DB2014.2 +003300* AND GENERATE CODE. DEBUGGING ACTIONS ON THE FOLLOWING DB2014.2 +003400* CONDITIONS ARE ANALYZED DB2014.2 +003500* DB2014.2 +003600* (1) REFERENCE TO IDENTIFIER WITHIN "VARYING", "AFTER", DB2014.2 +003700* AND "UNTIL" PHRASES OF "PERFORM" STATEMENTS. DB2014.2 +003800* (2) REFERENCE TO CHANGED AND UNCHANGED IDENTIFIER DB2014.2 +003900* FIELDS. DB2014.2 +004000* (3) REFERENCE TO SUBSCRIPTED IDENTIFIERS. DB2014.2 +004100* (4) REFERENCE TO QUALIFIED IDENTIFIERS. DB2014.2 +004200* (5) REFERENCE TO IDENTIFIER USED IN "GO TO DEPENDING". DB2014.2 +004300* (6) REFERENCE TO IDENTIFIER IN UNEXECUTED STATEMENTS. DB2014.2 +004400* (7) MULTIPLE REFERENCES TO SAME IDENTIFIER IN SAME DB2014.2 +004500* STATEMENT. DB2014.2 +004600* DB2014.2 +004700* DB2014.2 +004800* DB2014.2 +004900 ENVIRONMENT DIVISION. DB2014.2 +005000 CONFIGURATION SECTION. DB2014.2 +005100 SOURCE-COMPUTER. DB2014.2 +005200 XXXXX082 DB2014.2 +005300 WITH DEBUGGING MODE. DB2014.2 +005400 OBJECT-COMPUTER. DB2014.2 +005500 XXXXX083. DB2014.2 +005600 INPUT-OUTPUT SECTION. DB2014.2 +005700 FILE-CONTROL. DB2014.2 +005800 SELECT PRINT-FILE ASSIGN TO DB2014.2 +005900 XXXXX055. DB2014.2 +006000 DATA DIVISION. DB2014.2 +006100 FILE SECTION. DB2014.2 +006200 FD PRINT-FILE DB2014.2 +006300 LABEL RECORDS DB2014.2 +006400 XXXXX084 DB2014.2 +006500 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2014.2 +006600 01 PRINT-REC PICTURE X(120). DB2014.2 +006700 01 DUMMY-RECORD PICTURE X(120). DB2014.2 +006800 WORKING-STORAGE SECTION. DB2014.2 +006900 77 COUNTER PIC 999 VALUE 0. DB2014.2 +007000 77 GO-TO-DEP-KEY PIC 9. DB2014.2 +007100 77 GO-TO-DEP-KEY-1 PIC 9. DB2014.2 +007200 01 ITEM-1. DB2014.2 +007300 02 KEY-1 PIC 99 VALUE ZERO. DB2014.2 +007400 02 LINE-1 PIC X(6). DB2014.2 +007500 02 NAME-1 PIC X(30). DB2014.2 +007600 02 UNQUAL-NAME-1 PIC X(30). DB2014.2 +007700 02 SUB-1-1 PIC X(5). DB2014.2 +007800 02 SUB-2-1 PIC X(5). DB2014.2 +007900 02 SUB-3-1 PIC X(5). DB2014.2 +008000 02 CONTENTS-1 PIC X(30). DB2014.2 +008100 01 ITEM-2. DB2014.2 +008200 02 KEY-2 PIC 99. DB2014.2 +008300 02 LINE-2 PIC X(6). DB2014.2 +008400 02 NAME-2 PIC X(30). DB2014.2 +008500 02 UNQUAL-NAME-2 PIC X(30). DB2014.2 +008600 02 CONTENTS-2 PIC X(30). DB2014.2 +008700 01 ID-1 PIC 99. DB2014.2 +008800 01 ID-1A REDEFINES ID-1 PIC 99. DB2014.2 +008900 01 ID-2 PIC 99. DB2014.2 +009000 01 ID-2A REDEFINES ID-2 PIC 99. DB2014.2 +009100 01 ID-3 PIC 99. DB2014.2 +009200 01 A-GROUP. DB2014.2 +009300 02 A1. DB2014.2 +009400 03 AB1 PIC X OCCURS 5 TIMES. DB2014.2 +009500 03 AB2. DB2014.2 +009600 04 ABC1 PIC X. DB2014.2 +009700 04 ABC2 PIC X. DB2014.2 +009800 02 A2. DB2014.2 +009900 03 AB1 PIC X OCCURS 5 TIMES. DB2014.2 +010000 03 AB2. DB2014.2 +010100 04 ABC1 PIC X. DB2014.2 +010200 04 ABC2 PIC X. DB2014.2 +010300 01 B-GROUP. DB2014.2 +010400 02 B-LEVEL-1 OCCURS 10 TIMES INDEXED BY I. DB2014.2 +010500 03 B-LEVEL-2 OCCURS 10 TIMES INDEXED BY J. DB2014.2 +010600 04 B-LEVEL-3 OCCURS 10 TIMES INDEXED BY K PIC X. DB2014.2 +010700 01 TEST-RESULTS. DB2014.2 +010800 02 FILLER PICTURE X VALUE SPACE. DB2014.2 +010900 02 FEATURE PICTURE X(20) VALUE SPACE. DB2014.2 +011000 02 FILLER PICTURE X VALUE SPACE. DB2014.2 +011100 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2014.2 +011200 02 FILLER PICTURE X VALUE SPACE. DB2014.2 +011300 02 PAR-NAME. DB2014.2 +011400 03 FILLER PICTURE X(12) VALUE SPACE. DB2014.2 +011500 03 PARDOT-X PICTURE X VALUE SPACE. DB2014.2 +011600 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2014.2 +011700 03 FILLER PIC X(5) VALUE SPACE. DB2014.2 +011800 02 FILLER PIC X(10) VALUE SPACE. DB2014.2 +011900 02 RE-MARK PIC X(61). DB2014.2 +012000 01 TEST-COMPUTED. DB2014.2 +012100 02 FILLER PIC X(30) VALUE SPACE. DB2014.2 +012200 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2014.2 +012300 02 COMPUTED-X. DB2014.2 +012400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2014.2 +012500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2014.2 +012600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2014.2 +012700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2014.2 +012800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2014.2 +012900 03 CM-18V0 REDEFINES COMPUTED-A. DB2014.2 +013000 04 COMPUTED-18V0 PICTURE -9(18). DB2014.2 +013100 04 FILLER PICTURE X. DB2014.2 +013200 03 FILLER PIC X(50) VALUE SPACE. DB2014.2 +013300 01 TEST-CORRECT. DB2014.2 +013400 02 FILLER PIC X(30) VALUE SPACE. DB2014.2 +013500 02 FILLER PIC X(17) VALUE " CORRECT =". DB2014.2 +013600 02 CORRECT-X. DB2014.2 +013700 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2014.2 +013800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2014.2 +013900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2014.2 +014000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2014.2 +014100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2014.2 +014200 03 CR-18V0 REDEFINES CORRECT-A. DB2014.2 +014300 04 CORRECT-18V0 PICTURE -9(18). DB2014.2 +014400 04 FILLER PICTURE X. DB2014.2 +014500 03 FILLER PIC X(50) VALUE SPACE. DB2014.2 +014600 01 CCVS-C-1. DB2014.2 +014700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2014.2 +014800- "SS PARAGRAPH-NAME DB2014.2 +014900- " REMARKS". DB2014.2 +015000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2014.2 +015100 01 CCVS-C-2. DB2014.2 +015200 02 FILLER PICTURE IS X VALUE IS SPACE. DB2014.2 +015300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2014.2 +015400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2014.2 +015500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2014.2 +015600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2014.2 +015700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2014.2 +015800 01 REC-CT PICTURE 99 VALUE ZERO. DB2014.2 +015900 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2014.2 +016000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2014.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2014.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2014.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2014.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2014.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2014.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2014.2 +016700 01 CCVS-H-1. DB2014.2 +016800 02 FILLER PICTURE X(27) VALUE SPACE. DB2014.2 +016900 02 FILLER PICTURE X(67) VALUE DB2014.2 +017000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2014.2 +017100- " SYSTEM". DB2014.2 +017200 02 FILLER PICTURE X(26) VALUE SPACE. DB2014.2 +017300 01 CCVS-H-2. DB2014.2 +017400 02 FILLER PICTURE X(52) VALUE IS DB2014.2 +017500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2014.2 +017600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2014.2 +017700 02 TEST-ID PICTURE IS X(9). DB2014.2 +017800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2014.2 +017900 01 CCVS-H-3. DB2014.2 +018000 02 FILLER PICTURE X(34) VALUE DB2014.2 +018100 " FOR OFFICIAL USE ONLY ". DB2014.2 +018200 02 FILLER PICTURE X(58) VALUE DB2014.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2014.2 +018400 02 FILLER PICTURE X(28) VALUE DB2014.2 +018500 " COPYRIGHT 1974 ". DB2014.2 +018600 01 CCVS-E-1. DB2014.2 +018700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2014.2 +018800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2014.2 +018900 02 ID-AGAIN PICTURE IS X(9). DB2014.2 +019000 02 FILLER PICTURE X(45) VALUE IS DB2014.2 +019100 " NTIS DISTRIBUTION COBOL 74". DB2014.2 +019200 01 CCVS-E-2. DB2014.2 +019300 02 FILLER PICTURE X(31) VALUE DB2014.2 +019400 SPACE. DB2014.2 +019500 02 FILLER PICTURE X(21) VALUE SPACE. DB2014.2 +019600 02 CCVS-E-2-2. DB2014.2 +019700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2014.2 +019800 03 FILLER PICTURE IS X VALUE IS SPACE. DB2014.2 +019900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2014.2 +020000 01 CCVS-E-3. DB2014.2 +020100 02 FILLER PICTURE X(22) VALUE DB2014.2 +020200 " FOR OFFICIAL USE ONLY". DB2014.2 +020300 02 FILLER PICTURE X(12) VALUE SPACE. DB2014.2 +020400 02 FILLER PICTURE X(58) VALUE DB2014.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2014.2 +020600 02 FILLER PICTURE X(13) VALUE SPACE. DB2014.2 +020700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2014.2 +020800 01 CCVS-E-4. DB2014.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2014.2 +021000 02 FILLER PIC XXXX VALUE " OF ". DB2014.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2014.2 +021200 02 FILLER PIC X(40) VALUE DB2014.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". DB2014.2 +021400 01 XXINFO. DB2014.2 +021500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2014.2 +021600 02 INFO-TEXT. DB2014.2 +021700 04 FILLER PIC X(20) VALUE SPACE. DB2014.2 +021800 04 XXCOMPUTED PIC X(20). DB2014.2 +021900 04 FILLER PIC X(5) VALUE SPACE. DB2014.2 +022000 04 XXCORRECT PIC X(20). DB2014.2 +022100 01 HYPHEN-LINE. DB2014.2 +022200 02 FILLER PICTURE IS X VALUE IS SPACE. DB2014.2 +022300 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2014.2 +022400- "*****************************************". DB2014.2 +022500 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2014.2 +022600- "******************************". DB2014.2 +022700 01 CCVS-PGM-ID PIC X(6) VALUE DB2014.2 +022800 "DB201A". DB2014.2 +022900 PROCEDURE DIVISION. DB2014.2 +023000 DECLARATIVES. DB2014.2 +023100 GO-TO-DEPENDING-PROC-1 SECTION. DB2014.2 +023200 USE FOR DEBUGGING ON ALL REFERENCES OF GO-TO-DEP-KEY DB2014.2 +023300 ALL ID-2. DB2014.2 +023400 GO-TO-DEPEND-1. DB2014.2 +023500 ADD 1 TO KEY-1. DB2014.2 +023600 DB-COMMON-1. DB2014.2 +023700 MOVE DEBUG-LINE TO LINE-1. DB2014.2 +023800 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2014.2 +023900 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2014.2 +024000 DB-CLEAR-QUALIFIER-1. DB2014.2 +024100 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS BY SPACES DB2014.2 +024200 AFTER INITIAL SPACE. DB2014.2 +024300 GO-TO-DEPENDING-PROC-2 SECTION. DB2014.2 +024400 USE FOR DEBUGGING ON G-T-D-2. DB2014.2 +024500 GO-TO-DEPEND-2. DB2014.2 +024600 IF KEY-1 IS EQUAL TO 1 DB2014.2 +024700 MOVE 2 TO KEY-2 DB2014.2 +024800 ELSE MOVE 1 TO KEY-2. DB2014.2 +024900 DB-COMMON-2. DB2014.2 +025000 MOVE DEBUG-LINE TO LINE-2. DB2014.2 +025100 MOVE DEBUG-NAME TO NAME-2 UNQUAL-NAME-2. DB2014.2 +025200 MOVE DEBUG-CONTENTS TO CONTENTS-2. DB2014.2 +025300 DB-CLEAR-QUALIFIER-2. DB2014.2 +025400 INSPECT UNQUAL-NAME-2 REPLACING CHARACTERS BY SPACES DB2014.2 +025500 AFTER INITIAL SPACE. DB2014.2 +025600 GO-TO-DEPENDING-PROC-3 SECTION. DB2014.2 +025700 USE FOR DEBUGGING ON GO-TO-DEP-KEY-1. DB2014.2 +025800 GO-TO-DEPEND-3. DB2014.2 +025900 MOVE 1 TO KEY-1. DB2014.2 +026000 PERFORM-PROC-1 SECTION. DB2014.2 +026100 USE FOR DEBUGGING ON ID-1. DB2014.2 +026200 PERFORM-1. DB2014.2 +026300 ADD 1 TO KEY-1. DB2014.2 +026400 PERFORM DB-COMMON-1. DB2014.2 +026500 PERFORM DB-CLEAR-QUALIFIER-1. DB2014.2 +026600 TABLE-PROC-1 SECTION. DB2014.2 +026700 USE FOR DEBUGGING ON B-LEVEL-1 B-LEVEL-2 B-LEVEL-3. DB2014.2 +026800 TABLE-1. DB2014.2 +026900 MOVE 1 TO KEY-1. DB2014.2 +027000 PERFORM DB-COMMON-1. DB2014.2 +027100 PERFORM DB-CLEAR-QUALIFIER-1. DB2014.2 +027200 DB-MOVE-SUBSC-1. DB2014.2 +027300 MOVE DEBUG-SUB-1 TO SUB-1-1. DB2014.2 +027400 IF PAR-NAME = "SUBSC-TEST-2" DB2014.2 +027500 MOVE DEBUG-SUB-2 TO SUB-2-1. DB2014.2 +027600 MOVE DEBUG-SUB-3 TO SUB-3-1. DB2014.2 +027700 QUAL-PROC-1 SECTION. DB2014.2 +027800 USE FOR DEBUGGING ON ALL REFERENCES OF ABC1 OF AB2 OF A1 DB2014.2 +027900 ALL AB2 OF A2. DB2014.2 +028000 QUAL-1. DB2014.2 +028100 MOVE 1 TO KEY-1. DB2014.2 +028200 PERFORM DB-COMMON-1. DB2014.2 +028300 QUAL-SUBC-PROC-1 SECTION. DB2014.2 +028400 USE FOR DEBUGGING ON ALL REFERENCES OF AB1 OF A1. DB2014.2 +028500 QUAL-SUBC-1. DB2014.2 +028600 MOVE 1 TO KEY-1. DB2014.2 +028700 PERFORM DB-COMMON-1. DB2014.2 +028800 MOVE DEBUG-SUB-1 TO SUB-1-1. DB2014.2 +028900 END DECLARATIVES. DB2014.2 +029000 CCVS1 SECTION. DB2014.2 +029100 OPEN-FILES. DB2014.2 +029200 OPEN OUTPUT PRINT-FILE. DB2014.2 +029300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2014.2 +029400 MOVE SPACE TO TEST-RESULTS. DB2014.2 +029500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2014.2 +029600 GO TO CCVS1-EXIT. DB2014.2 +029700 CLOSE-FILES. DB2014.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2014.2 +029900 TERMINATE-CCVS. DB2014.2 +030000S EXIT PROGRAM. DB2014.2 +030100STERMINATE-CALL. DB2014.2 +030200 STOP RUN. DB2014.2 +030300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2014.2 +030400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2014.2 +030500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2014.2 +030600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2014.2 +030700 MOVE "****TEST DELETED****" TO RE-MARK. DB2014.2 +030800 PRINT-DETAIL. DB2014.2 +030900 IF REC-CT NOT EQUAL TO ZERO DB2014.2 +031000 MOVE "." TO PARDOT-X DB2014.2 +031100 MOVE REC-CT TO DOTVALUE. DB2014.2 +031200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2014.2 +031300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2014.2 +031400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2014.2 +031500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2014.2 +031600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2014.2 +031700 MOVE SPACE TO CORRECT-X. DB2014.2 +031800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2014.2 +031900 MOVE SPACE TO RE-MARK. DB2014.2 +032000 HEAD-ROUTINE. DB2014.2 +032100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2014.2 +032200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2014.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2014.2 +032400 COLUMN-NAMES-ROUTINE. DB2014.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2014.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2014.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2014.2 +032800 END-ROUTINE. DB2014.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2014.2 +033000 END-RTN-EXIT. DB2014.2 +033100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2014.2 +033200 END-ROUTINE-1. DB2014.2 +033300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2014.2 +033400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2014.2 +033500 ADD PASS-COUNTER TO ERROR-HOLD. DB2014.2 +033600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2014.2 +033700 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2014.2 +033800 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2014.2 +033900 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2014.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2014.2 +034100 END-ROUTINE-12. DB2014.2 +034200 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2014.2 +034300 IF ERROR-COUNTER IS EQUAL TO ZERO DB2014.2 +034400 MOVE "NO " TO ERROR-TOTAL DB2014.2 +034500 ELSE DB2014.2 +034600 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2014.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2014.2 +034800 PERFORM WRITE-LINE. DB2014.2 +034900 END-ROUTINE-13. DB2014.2 +035000 IF DELETE-CNT IS EQUAL TO ZERO DB2014.2 +035100 MOVE "NO " TO ERROR-TOTAL ELSE DB2014.2 +035200 MOVE DELETE-CNT TO ERROR-TOTAL. DB2014.2 +035300 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2014.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2014.2 +035500 IF INSPECT-COUNTER EQUAL TO ZERO DB2014.2 +035600 MOVE "NO " TO ERROR-TOTAL DB2014.2 +035700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2014.2 +035800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2014.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2014.2 +036000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2014.2 +036100 WRITE-LINE. DB2014.2 +036200 ADD 1 TO RECORD-COUNT. DB2014.2 +036300Y IF RECORD-COUNT GREATER 50 DB2014.2 +036400Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB2014.2 +036500Y MOVE SPACE TO DUMMY-RECORD DB2014.2 +036600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2014.2 +036700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2014.2 +036800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2014.2 +036900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2014.2 +037000Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB2014.2 +037100Y MOVE ZERO TO RECORD-COUNT. DB2014.2 +037200 PERFORM WRT-LN. DB2014.2 +037300 WRT-LN. DB2014.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2014.2 +037500 MOVE SPACE TO DUMMY-RECORD. DB2014.2 +037600 BLANK-LINE-PRINT. DB2014.2 +037700 PERFORM WRT-LN. DB2014.2 +037800 FAIL-ROUTINE. DB2014.2 +037900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2014.2 +038000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2014.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2014.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2014.2 +038300 GO TO FAIL-ROUTINE-EX. DB2014.2 +038400 FAIL-ROUTINE-WRITE. DB2014.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2014.2 +038600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2014.2 +038700 FAIL-ROUTINE-EX. EXIT. DB2014.2 +038800 BAIL-OUT. DB2014.2 +038900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2014.2 +039000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2014.2 +039100 BAIL-OUT-WRITE. DB2014.2 +039200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2014.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2014.2 +039400 BAIL-OUT-EX. EXIT. DB2014.2 +039500 CCVS1-EXIT. DB2014.2 +039600 EXIT. DB2014.2 +039700 SECT-DB201A-0001 SECTION. DB2014.2 +039800 GO-TO-DEPENDING-INIT. DB2014.2 +039900 MOVE "GO TO DEP/ALL REF" TO FEATURE. DB2014.2 +040000 MOVE "GO-TO-DEPENDING" TO PAR-NAME. DB2014.2 +040100 GO-TO-DEPENDING-0. DB2014.2 +040200 MOVE 2 TO GO-TO-DEP-KEY. DB2014.2 +040300 MOVE SPACES TO ITEM-1 ITEM-2. DB2014.2 +040400 MOVE 0 TO KEY-1 KEY-2. DB2014.2 +040500******************************************************************DB2014.2 +040600* THE DEBUG-LINE (INSPT) TESTS NAMED IN THE OUTPUT REPORT AS *DB2014.2 +040700* "G-T-D-2A" AND "G-T-D-3A" SHOULD EACH POINT TO THE *DB2014.2 +040800* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB2014.2 +040900* WHICH READS, "GO TO G-T-D-1 G-T-D-2 G-T-D-5 DEPENDING ON *DB2014.2 +041000* GO-TO-DEP-KEY.". *DB2014.2 +041100******************************************************************DB2014.2 +041200 GO TO G-T-D-1 G-T-D-2 G-T-D-5 DEPENDING ON GO-TO-DEP-KEY. DB2014.2 +041300 GO-TO-DEPENDING-DELETE. DB2014.2 +041400 GO TO G-T-D-2-DELETE. DB2014.2 +041500 G-T-D-1. DB2014.2 +041600 GO TO G-T-D-2-DELETE. DB2014.2 +041700 G-T-D-2. DB2014.2 +041800 MOVE "G-T-D-2" TO PAR-NAME. DB2014.2 +041900 IF KEY-1 IS EQUAL TO 1 DB2014.2 +042000 MOVE "DEBUG EXECUTED ON IDENTIFR" TO RE-MARK DB2014.2 +042100 PERFORM PASS DB2014.2 +042200 PERFORM G-T-D-WRITE DB2014.2 +042300 GO TO G-T-D-2A DB2014.2 +042400 ELSE PERFORM FAIL DB2014.2 +042500 MOVE "DEBUG NOT EXECUTED ON IDENTIFR" TO RE-MARK DB2014.2 +042600 PERFORM G-T-D-WRITE DB2014.2 +042700 PERFORM DELETE-SUBTESTS-2 DB2014.2 +042800 GO TO G-T-D-3. DB2014.2 +042900 G-T-D-2-DELETE. DB2014.2 +043000 PERFORM DE-LETE. DB2014.2 +043100 PERFORM G-T-D-WRITE. DB2014.2 +043200 PERFORM DELETE-SUBTESTS-2. DB2014.2 +043300 GO TO G-T-D-3-DELETE. DB2014.2 +043400 DELETE-SUBTESTS-2. DB2014.2 +043500 MOVE "G-T-D-2A" TO PAR-NAME. DB2014.2 +043600 PERFORM DE-LETE. DB2014.2 +043700 PERFORM G-T-D-WRITE. DB2014.2 +043800 MOVE "G-T-D-2B" TO PAR-NAME. DB2014.2 +043900 PERFORM DE-LETE. DB2014.2 +044000 PERFORM G-T-D-WRITE. DB2014.2 +044100 MOVE "G-T-D-2C" TO PAR-NAME. DB2014.2 +044200 PERFORM DE-LETE. DB2014.2 +044300 PERFORM G-T-D-WRITE. DB2014.2 +044400 G-T-D-2A. DB2014.2 +044500 MOVE "G-T-D-2A" TO PAR-NAME. DB2014.2 +044600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +044700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +044800 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +044900 PERFORM INSPT. DB2014.2 +045000 PERFORM G-T-D-WRITE. DB2014.2 +045100 G-T-D-2B. DB2014.2 +045200 MOVE "G-T-D-2B" TO PAR-NAME. DB2014.2 +045300 IF UNQUAL-NAME-1 IS EQUAL TO "GO-TO-DEP-KEY" DB2014.2 +045400 PERFORM PASS DB2014.2 +045500 ELSE PERFORM FAIL DB2014.2 +045600 MOVE "GO-TO-DEP-KEY" TO CORRECT-A DB2014.2 +045700 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +045800 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +045900 PERFORM G-T-D-WRITE. DB2014.2 +046000 G-T-D-2C. DB2014.2 +046100 MOVE "G-T-D-2C" TO PAR-NAME. DB2014.2 +046200 IF CONTENTS-1 IS EQUAL TO "2" DB2014.2 +046300 PERFORM PASS DB2014.2 +046400 ELSE PERFORM FAIL DB2014.2 +046500 MOVE "2" TO CORRECT-A DB2014.2 +046600 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +046700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +046800 PERFORM G-T-D-WRITE. DB2014.2 +046900 G-T-D-3. DB2014.2 +047000 MOVE "G-T-D-3" TO PAR-NAME. DB2014.2 +047100 IF KEY-2 IS EQUAL TO 1 OR 2 DB2014.2 +047200 MOVE "DEBUG ON PROC-NAME EXECUTED" TO RE-MARK DB2014.2 +047300 PERFORM PASS DB2014.2 +047400 PERFORM G-T-D-WRITE DB2014.2 +047500 GO TO G-T-D-3A DB2014.2 +047600 ELSE DB2014.2 +047700 MOVE "DEBUG ON PRC-NAME NOT EXECUTED" TO RE-MARK DB2014.2 +047800 PERFORM FAIL DB2014.2 +047900 PERFORM G-T-D-WRITE DB2014.2 +048000 PERFORM DELETE-SUBTESTS-3 DB2014.2 +048100 GO TO G-T-D-4. DB2014.2 +048200 G-T-D-3-DELETE. DB2014.2 +048300 MOVE "G-T-D-3" TO PAR-NAME. DB2014.2 +048400 PERFORM DE-LETE. DB2014.2 +048500 PERFORM G-T-D-WRITE. DB2014.2 +048600 PERFORM DELETE-SUBTESTS-3 DB2014.2 +048700 GO TO G-T-D-4-DELETE. DB2014.2 +048800 DELETE-SUBTESTS-3. DB2014.2 +048900 MOVE "G-T-D-3A" TO PAR-NAME. DB2014.2 +049000 PERFORM DE-LETE. DB2014.2 +049100 PERFORM G-T-D-WRITE. DB2014.2 +049200 MOVE "G-T-D-3B" TO PAR-NAME. DB2014.2 +049300 PERFORM DE-LETE. DB2014.2 +049400 PERFORM G-T-D-WRITE. DB2014.2 +049500 MOVE "G-T-D-3C" TO PAR-NAME. DB2014.2 +049600 PERFORM DE-LETE. DB2014.2 +049700 PERFORM G-T-D-WRITE. DB2014.2 +049800 G-T-D-3A. DB2014.2 +049900 MOVE "G-T-D-3A" TO PAR-NAME. DB2014.2 +050000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +050100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +050200 MOVE LINE-2 TO COMPUTED-A. DB2014.2 +050300 PERFORM INSPT. DB2014.2 +050400 PERFORM G-T-D-WRITE. DB2014.2 +050500 G-T-D-3B. DB2014.2 +050600 MOVE "G-T-D-3B" TO PAR-NAME. DB2014.2 +050700 IF UNQUAL-NAME-2 IS EQUAL TO "G-T-D-2" DB2014.2 +050800 PERFORM PASS DB2014.2 +050900 ELSE PERFORM FAIL DB2014.2 +051000 MOVE "G-T-D-2" TO CORRECT-A DB2014.2 +051100 MOVE NAME-2 TO COMPUTED-A. DB2014.2 +051200 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +051300 PERFORM G-T-D-WRITE. DB2014.2 +051400 G-T-D-3C. DB2014.2 +051500 MOVE "G-T-D-3C" TO PAR-NAME. DB2014.2 +051600 IF CONTENTS-2 IS EQUAL TO SPACES DB2014.2 +051700 PERFORM PASS DB2014.2 +051800 ELSE PERFORM FAIL DB2014.2 +051900 MOVE "(SPACES)" TO CORRECT-A DB2014.2 +052000 MOVE CONTENTS-2 TO COMPUTED-A. DB2014.2 +052100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +052200 PERFORM G-T-D-WRITE. DB2014.2 +052300 G-T-D-4. DB2014.2 +052400 MOVE "G-T-D-4" TO PAR-NAME. DB2014.2 +052500 IF KEY-2 IS EQUAL TO 2 DB2014.2 +052600 MOVE "PROCS EXECUTED IN RIGHT ORDER" TO RE-MARK DB2014.2 +052700 PERFORM PASS DB2014.2 +052800 ELSE PERFORM FAIL DB2014.2 +052900 MOVE "PROCS EXECUTED IN WRONG ORDER" TO RE-MARK. DB2014.2 +053000 GO TO G-T-D-WRITE. DB2014.2 +053100 G-T-D-4-DELETE. DB2014.2 +053200 MOVE "G-T-D-4" TO PAR-NAME. DB2014.2 +053300 PERFORM DE-LETE. DB2014.2 +053400 GO TO G-T-D-WRITE. DB2014.2 +053500 G-T-D-5. DB2014.2 +053600 GO TO G-T-D-2-DELETE. DB2014.2 +053700 G-T-D-WRITE. DB2014.2 +053800 PERFORM PRINT-DETAIL. DB2014.2 +053900 G-T-D-6-INIT. DB2014.2 +054000 MOVE "GO TO DEP/NOT ALL" TO FEATURE. DB2014.2 +054100 MOVE "G-T-D-6" TO PAR-NAME. DB2014.2 +054200 G-T-D-6. DB2014.2 +054300 MOVE 2 TO GO-TO-DEP-KEY-1. DB2014.2 +054400 MOVE SPACES TO ITEM-1 ITEM-2. DB2014.2 +054500 MOVE 0 TO KEY-1 KEY-2. DB2014.2 +054600 GO TO G-T-D-7 G-T-D-8 G-T-D-9 DEPENDING ON GO-TO-DEP-KEY-1.DB2014.2 +054700 G-T-D-6-DELETE. DB2014.2 +054800 PERFORM DE-LETE. DB2014.2 +054900 PERFORM G-T-D-WRITE. DB2014.2 +055000 GO TO PERFORM-TESTS-INIT. DB2014.2 +055100 G-T-D-7. DB2014.2 +055200 GO TO G-T-D-8. DB2014.2 +055300 G-T-D-8. DB2014.2 +055400 IF KEY-1 IS EQUAL TO 0 DB2014.2 +055500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +055600 PERFORM PASS DB2014.2 +055700 ELSE PERFORM FAIL DB2014.2 +055800 MOVE "DEBUG PROC EXECUTED" TO RE-MARK. DB2014.2 +055900 PERFORM G-T-D-WRITE. DB2014.2 +056000 GO TO PERFORM-TESTS-INIT. DB2014.2 +056100 G-T-D-9. DB2014.2 +056200 GO TO G-T-D-8. DB2014.2 +056300 PERFORM-TESTS-INIT. DB2014.2 +056400 MOVE "PERFORM VARYING" TO FEATURE. DB2014.2 +056500 MOVE SPACES TO ITEM-1. DB2014.2 +056600 MOVE "PERFORM-VARY-1" TO PAR-NAME. DB2014.2 +056700 MOVE 0 TO KEY-1. DB2014.2 +056800******************************************************************DB2014.2 +056900* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +057000* "P-V-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT WHICH *DB2014.2 +057100* FOLLOWS THIS COMMENT SET AND WHICH READS, "PERFORM *DB2014.2 +057200* P-V-1-SUBR VARYING ID-1 FROM 1 BY 1 UNTIL ID-1A IS GREATER *DB2014.2 +057300* THAN 5.". *DB2014.2 +057400******************************************************************DB2014.2 +057500 PERFORM-VARY-1. DB2014.2 +057600 PERFORM P-V-1-SUBR VARYING ID-1 FROM 1 BY 1 DB2014.2 +057700 UNTIL ID-1A IS GREATER THAN 5. DB2014.2 +057800 GO TO P-V-1-TEST. DB2014.2 +057900 PERFORM-VARYING-1-DELETE. DB2014.2 +058000 PERFORM DE-LETE. DB2014.2 +058100 PERFORM P-V-WRITE. DB2014.2 +058200 PERFORM DELETE-VARYING-SUBTESTS. DB2014.2 +058300 GO TO PERFORM-VARYING-2-DELETE. DB2014.2 +058400 DELETE-VARYING-SUBTESTS. DB2014.2 +058500 MOVE "P-V-1A" TO PAR-NAME. DB2014.2 +058600 PERFORM DE-LETE. DB2014.2 +058700 PERFORM P-V-WRITE. DB2014.2 +058800 MOVE "P-V-1B" TO PAR-NAME. DB2014.2 +058900 PERFORM DE-LETE. DB2014.2 +059000 PERFORM P-V-WRITE. DB2014.2 +059100 MOVE "P-V-1C" TO PAR-NAME. DB2014.2 +059200 PERFORM DE-LETE. DB2014.2 +059300 PERFORM P-V-WRITE. DB2014.2 +059400 P-V-1-SUBR. DB2014.2 +059500 ADD 1 TO COUNTER. DB2014.2 +059600 P-V-1-TEST. DB2014.2 +059700 IF KEY-1 IS EQUAL TO 6 DB2014.2 +059800 MOVE "DEBUG PROC EXECUTED 6 TIMES" TO RE-MARK DB2014.2 +059900 PERFORM PASS DB2014.2 +060000 ELSE PERFORM FAIL DB2014.2 +060100 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +060200 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +060300 MOVE 6 TO CORRECT-18V0. DB2014.2 +060400 PERFORM P-V-WRITE. DB2014.2 +060500 IF KEY-1 IS EQUAL TO 0 DB2014.2 +060600 PERFORM DELETE-VARYING-SUBTESTS DB2014.2 +060700 GO TO PERFORM-VARYING-2-DELETE. DB2014.2 +060800 P-V-1A. DB2014.2 +060900 MOVE "P-V-1A" TO PAR-NAME. DB2014.2 +061000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +061100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +061200 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +061300 PERFORM INSPT. DB2014.2 +061400 PERFORM P-V-WRITE. DB2014.2 +061500 P-V-1B. DB2014.2 +061600 MOVE "P-V-1B" TO PAR-NAME. DB2014.2 +061700 IF UNQUAL-NAME-1 IS EQUAL TO "ID-1" DB2014.2 +061800 PERFORM PASS DB2014.2 +061900 ELSE PERFORM FAIL DB2014.2 +062000 MOVE "ID-1" TO CORRECT-A DB2014.2 +062100 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +062200 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +062300 PERFORM P-V-WRITE. DB2014.2 +062400 P-V-1C. DB2014.2 +062500 MOVE "P-V-1C" TO PAR-NAME. DB2014.2 +062600 IF CONTENTS-1 IS EQUAL TO "06" DB2014.2 +062700 PERFORM PASS DB2014.2 +062800 ELSE PERFORM FAIL DB2014.2 +062900 MOVE "06" TO CORRECT-A DB2014.2 +063000 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +063100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +063200 PERFORM P-V-WRITE. DB2014.2 +063300 PERFORM-VARY-2. DB2014.2 +063400 PERFORM PERFORM-TESTS-INIT. DB2014.2 +063500 MOVE "PERFORM-VARY-2" TO PAR-NAME. DB2014.2 +063600 PERFORM P-V-1-SUBR VARYING ID-1 FROM 1 BY 1 DB2014.2 +063700 UNTIL ID-1 IS GREATER THAN 5. DB2014.2 +063800 GO TO P-V-2-TEST. DB2014.2 +063900 PERFORM-VARYING-2-DELETE. DB2014.2 +064000 MOVE "PERFORM-VARY-2" TO PAR-NAME. DB2014.2 +064100 PERFORM DE-LETE. DB2014.2 +064200 PERFORM P-V-WRITE. DB2014.2 +064300 GO TO PERFORM-AFTER-INIT. DB2014.2 +064400 P-V-2-TEST. DB2014.2 +064500 IF KEY-1 IS EQUAL TO 12 DB2014.2 +064600 PERFORM PASS DB2014.2 +064700 MOVE "DEBUG PROC EXECUTED 12 TIMES" TO RE-MARK DB2014.2 +064800 ELSE PERFORM FAIL DB2014.2 +064900 MOVE "12" TO CORRECT-A DB2014.2 +065000 MOVE KEY-1 TO COMPUTED-A DB2014.2 +065100 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK. DB2014.2 +065200 P-V-WRITE. DB2014.2 +065300 PERFORM PRINT-DETAIL. DB2014.2 +065400 PERFORM-AFTER-INIT. DB2014.2 +065500 MOVE "PERFORM AFTER" TO FEATURE. DB2014.2 +065600 MOVE SPACES TO ITEM-1. DB2014.2 +065700 MOVE 0 TO KEY-1. DB2014.2 +065800 MOVE "PERFORM-AFTER-1" TO PAR-NAME. DB2014.2 +065900 PERFORM-AFTER-1. DB2014.2 +066000 PERFORM P-V-1-SUBR DB2014.2 +066100 VARYING ID-2A FROM 1 BY 1 UNTIL ID-2A IS GREATER THAN 5 DB2014.2 +066200 AFTER ID-1 FROM 1 BY 1 UNTIL ID-1A IS GREATER THAN 5. DB2014.2 +066300 GO TO PERFORM-AFTER-1-TEST. DB2014.2 +066400 PERFORM-AFTER-1-DELETE. DB2014.2 +066500 PERFORM DE-LETE. DB2014.2 +066600 PERFORM P-A-WRITE. DB2014.2 +066700 GO TO DELETE-AFTER-SUBTEST. DB2014.2 +066800 PERFORM-AFTER-1-TEST. DB2014.2 +066900 IF KEY-1 IS EQUAL TO 31 DB2014.2 +067000 MOVE "DEBUG PROC EXECUTED 31 TIMES" TO RE-MARK DB2014.2 +067100 PERFORM PASS DB2014.2 +067200 ELSE PERFORM FAIL DB2014.2 +067300 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +067400 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +067500 MOVE 31 TO CORRECT-18V0. DB2014.2 +067600 PERFORM P-A-WRITE. DB2014.2 +067700 IF KEY-1 IS EQUAL TO 0 DB2014.2 +067800 GO TO DELETE-AFTER-SUBTEST. DB2014.2 +067900 PERFORM-AFT-1A. DB2014.2 +068000 MOVE "PERFORM-AFT-1A" TO PAR-NAME. DB2014.2 +068100 IF CONTENTS-1 IS EQUAL TO "01" DB2014.2 +068200 PERFORM PASS DB2014.2 +068300 ELSE PERFORM FAIL DB2014.2 +068400 MOVE "01" TO CORRECT-A DB2014.2 +068500 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +068600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +068700 GO TO P-A-WRITE. DB2014.2 +068800 DELETE-AFTER-SUBTEST. DB2014.2 +068900 MOVE "PERFORM-AFT-1A" TO PAR-NAME. DB2014.2 +069000 PERFORM DE-LETE. DB2014.2 +069100 P-A-WRITE. DB2014.2 +069200 PERFORM PRINT-DETAIL. DB2014.2 +069300 PERFORM-UNTIL-INIT. DB2014.2 +069400 MOVE "PERFORM UNTIL" TO FEATURE. DB2014.2 +069500 MOVE SPACES TO ITEM-1. DB2014.2 +069600 MOVE 0 TO KEY-1. DB2014.2 +069700 MOVE "PERFORM-UNTIL-1" TO PAR-NAME. DB2014.2 +069800 PERFORM-UNTIL-1. DB2014.2 +069900 PERFORM P-V-1-SUBR DB2014.2 +070000 VARYING ID-1A FROM 1 BY 1 UNTIL ID-1 IS GREATER THAN 5. DB2014.2 +070100 GO TO PERFORM-UNTIL-1-TEST. DB2014.2 +070200 PERFORM-UNTIL-1-DELETE. DB2014.2 +070300 PERFORM DE-LETE. DB2014.2 +070400 PERFORM P-U-WRITE. DB2014.2 +070500 GO TO DELETE-UNTIL-SUBTEST. DB2014.2 +070600 PERFORM-UNTIL-1-TEST. DB2014.2 +070700 IF KEY-1 IS EQUAL TO 6 DB2014.2 +070800 MOVE "DEBUG PROC EXECUTED 6 TIMES" TO RE-MARK DB2014.2 +070900 PERFORM PASS DB2014.2 +071000 ELSE PERFORM FAIL DB2014.2 +071100 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +071200 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +071300 MOVE 6 TO CORRECT-18V0. DB2014.2 +071400 PERFORM P-A-WRITE. DB2014.2 +071500 IF KEY-1 IS EQUAL TO 0 DB2014.2 +071600 GO TO DELETE-UNTIL-SUBTEST. DB2014.2 +071700 PERFORM-UNT-1A. DB2014.2 +071800 MOVE "PERFORM-UNT-1A" TO PAR-NAME. DB2014.2 +071900 IF CONTENTS-1 IS EQUAL TO "06" DB2014.2 +072000 PERFORM PASS DB2014.2 +072100 ELSE PERFORM FAIL DB2014.2 +072200 MOVE "06" TO CORRECT-A DB2014.2 +072300 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +072400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +072500 GO TO P-U-WRITE. DB2014.2 +072600 DELETE-UNTIL-SUBTEST. DB2014.2 +072700 MOVE "PERFORM-UNT-1A" TO PAR-NAME. DB2014.2 +072800 PERFORM DE-LETE. DB2014.2 +072900 P-U-WRITE. DB2014.2 +073000 PERFORM PRINT-DETAIL. DB2014.2 +073100 BYPASSED-CODE-1. DB2014.2 +073200 MOVE 0 TO ID-3 KEY-1 KEY-2. DB2014.2 +073300 MULTIPLY ID-1A BY ID-3. DB2014.2 +073400 MOVE "ALL REF OF IDENT" TO FEATURE. DB2014.2 +073500 IF ID-3 IS NOT EQUAL TO 0 DB2014.2 +073600 MOVE 1 TO ID-2 KEY-2. DB2014.2 +073700 IF KEY-2 IS NOT EQUAL TO 0 DB2014.2 +073800 GO TO BYPASSED-CODE-DELETE. DB2014.2 +073900 IF KEY-1 IS EQUAL TO 0 DB2014.2 +074000 PERFORM PASS DB2014.2 +074100 ELSE PERFORM FAIL DB2014.2 +074200 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2014.2 +074300 GO TO BYPASSED-CODE-WRITE. DB2014.2 +074400 BYPASSED-CODE-DELETE. DB2014.2 +074500 PERFORM DE-LETE. DB2014.2 +074600 BYPASSED-CODE-WRITE. DB2014.2 +074700 MOVE "BYPASSED-CODE-1" TO PAR-NAME. DB2014.2 +074800 PERFORM PRINT-DETAIL. DB2014.2 +074900 REDEFINED-ID-1. DB2014.2 +075000 MOVE 0 TO KEY-1. DB2014.2 +075100 MOVE "ALL REF OF IDENT" TO FEATURE. DB2014.2 +075200 MOVE 0 TO ID-2A. DB2014.2 +075300 IF KEY-1 IS EQUAL TO 0 DB2014.2 +075400 PERFORM PASS DB2014.2 +075500 ELSE PERFORM FAIL DB2014.2 +075600 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2014.2 +075700 GO TO REDEFINED-ID-WRITE. DB2014.2 +075800 REDEFINED-ID-DELETE. DB2014.2 +075900 PERFORM DE-LETE. DB2014.2 +076000 REDEFINED-ID-WRITE. DB2014.2 +076100 MOVE "REDEFINED-ID-1" TO PAR-NAME. DB2014.2 +076200 PERFORM PRINT-DETAIL. DB2014.2 +076300 MOVE-TEST-1-INIT. DB2014.2 +076400 MOVE "ALL REF OF IDENT" TO FEATURE. DB2014.2 +076500 MOVE "MOVE-TEST-1" TO PAR-NAME. DB2014.2 +076600 MOVE SPACES TO ITEM-1. DB2014.2 +076700 MOVE 0 TO KEY-1. DB2014.2 +076800******************************************************************DB2014.2 +076900* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +077000* "MOVE-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2014.2 +077100* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "MOVE 3 TO *DB2014.2 +077200* ID-2.". *DB2014.2 +077300******************************************************************DB2014.2 +077400 MOVE-TEST-1. DB2014.2 +077500 MOVE 3 TO ID-2. DB2014.2 +077600 IF KEY-1 IS EQUAL TO 1 DB2014.2 +077700 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +077800 PERFORM PASS DB2014.2 +077900 PERFORM MOVE-TEST-WRITE DB2014.2 +078000 GO TO MOVE-TEST-1A DB2014.2 +078100 ELSE PERFORM FAIL DB2014.2 +078200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +078300 PERFORM MOVE-TEST-WRITE DB2014.2 +078400 PERFORM DELETE-MOVE-1-SUBTESTS DB2014.2 +078500 GO TO MOVE-TEST-2-INIT. DB2014.2 +078600 MOVE-TEST-1-DELETE. DB2014.2 +078700 PERFORM DE-LETE. DB2014.2 +078800 PERFORM MOVE-TEST-WRITE. DB2014.2 +078900 PERFORM DELETE-MOVE-1-SUBTESTS. DB2014.2 +079000 GO TO MOVE-TEST-2-INIT. DB2014.2 +079100 DELETE-MOVE-1-SUBTESTS. DB2014.2 +079200 MOVE "MOVE-TEST-1A" TO PAR-NAME. DB2014.2 +079300 PERFORM DE-LETE. DB2014.2 +079400 PERFORM MOVE-TEST-WRITE. DB2014.2 +079500 MOVE "MOVE-TEST-1B" TO PAR-NAME. DB2014.2 +079600 PERFORM DE-LETE. DB2014.2 +079700 PERFORM MOVE-TEST-WRITE. DB2014.2 +079800 MOVE "MOVE-TEST-1C" TO PAR-NAME. DB2014.2 +079900 PERFORM DE-LETE. DB2014.2 +080000 PERFORM MOVE-TEST-WRITE. DB2014.2 +080100 MOVE-TEST-1A. DB2014.2 +080200 MOVE "MOVE-TEST-1A" TO PAR-NAME. DB2014.2 +080300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +080400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +080500 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +080600 PERFORM INSPT. DB2014.2 +080700 PERFORM MOVE-TEST-WRITE. DB2014.2 +080800 MOVE-TEST-1B. DB2014.2 +080900 MOVE "MOVE-TEST-1B" TO PAR-NAME. DB2014.2 +081000 IF UNQUAL-NAME-1 IS EQUAL TO "ID-2" DB2014.2 +081100 PERFORM PASS DB2014.2 +081200 ELSE PERFORM FAIL DB2014.2 +081300 MOVE "ID-2" TO CORRECT-A DB2014.2 +081400 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +081500 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +081600 PERFORM MOVE-TEST-WRITE. DB2014.2 +081700 MOVE-TEST-1C. DB2014.2 +081800 MOVE "MOVE-TEST-1C" TO PAR-NAME. DB2014.2 +081900 IF CONTENTS-1 IS EQUAL TO "03" DB2014.2 +082000 PERFORM PASS DB2014.2 +082100 ELSE PERFORM FAIL DB2014.2 +082200 MOVE "03" TO CORRECT-A DB2014.2 +082300 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +082400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +082500 PERFORM MOVE-TEST-WRITE. DB2014.2 +082600 MOVE-TEST-2-INIT. DB2014.2 +082700 MOVE "NOT ALL REF OF IDENT" TO FEATURE. DB2014.2 +082800 MOVE "MOVE-TEST-2" TO PAR-NAME. DB2014.2 +082900 MOVE 0 TO ID-1A. DB2014.2 +083000 MOVE SPACES TO ITEM-1. DB2014.2 +083100 MOVE 0 TO KEY-1. DB2014.2 +083200 MOVE-TEST-2. DB2014.2 +083300 MOVE 5 TO ID-1. DB2014.2 +083400 IF KEY-1 IS EQUAL TO 1 DB2014.2 +083500 MOVE "DEBUG EXECUTED" TO RE-MARK DB2014.2 +083600 PERFORM PASS DB2014.2 +083700 PERFORM MOVE-TEST-WRITE DB2014.2 +083800 GO TO MOVE-TEST-2A DB2014.2 +083900 ELSE PERFORM FAIL DB2014.2 +084000 MOVE "DEBUG NOT EXECUTED" TO RE-MARK DB2014.2 +084100 PERFORM MOVE-TEST-WRITE. DB2014.2 +084200 DELETE-MOVE-2-SUBTEST. DB2014.2 +084300 MOVE "MOVE-TEST-2A" TO PAR-NAME DB2014.2 +084400 PERFORM DE-LETE. DB2014.2 +084500 PERFORM MOVE-TEST-WRITE. DB2014.2 +084600 GO TO MOVE-TEST-3-DELETE. DB2014.2 +084700 MOVE-TEST-2A. DB2014.2 +084800 MOVE "MOVE-TEST-2A" TO PAR-NAME. DB2014.2 +084900 IF CONTENTS-1 IS EQUAL TO "05" DB2014.2 +085000 PERFORM PASS DB2014.2 +085100 ELSE PERFORM FAIL DB2014.2 +085200 MOVE "05" TO CORRECT-A DB2014.2 +085300 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +085400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +085500 PERFORM MOVE-TEST-WRITE. DB2014.2 +085600 MOVE-TEST-3-INIT. DB2014.2 +085700 MOVE "REPEATED NOT ALL REF" TO FEATURE. DB2014.2 +085800 MOVE "MOVE-TEST-3" TO PAR-NAME. DB2014.2 +085900 MOVE 5 TO ID-1A. DB2014.2 +086000 MOVE SPACES TO ITEM-1. DB2014.2 +086100 MOVE 0 TO KEY-1. DB2014.2 +086200 MOVE-TEST-3. DB2014.2 +086300 MOVE 5 TO ID-1. DB2014.2 +086400 IF KEY-1 IS EQUAL TO 1 DB2014.2 +086500 MOVE "REPEATED MOVE INVOKED PROC" TO RE-MARK DB2014.2 +086600 ELSE MOVE "REPEATED MOVE DIDN""T CALL PROC" TO RE-MARK. DB2014.2 +086700 MOVE "INFO" TO P-OR-F. DB2014.2 +086800 PERFORM MOVE-TEST-WRITE. DB2014.2 +086900 GO TO MOVE-TEST-4-INIT. DB2014.2 +087000 MOVE-TEST-3-DELETE. DB2014.2 +087100 MOVE "REPEATED/NOT ALL REF" TO FEATURE. DB2014.2 +087200 MOVE "MOVE-TEST-3" TO PAR-NAME. DB2014.2 +087300 PERFORM DE-LETE. DB2014.2 +087400 PERFORM MOVE-TEST-WRITE. DB2014.2 +087500 MOVE-TEST-4-INIT. DB2014.2 +087600 MOVE 2 TO ID-2A. DB2014.2 +087700 MOVE SPACES TO ITEM-1. DB2014.2 +087800 MOVE 0 TO KEY-1. DB2014.2 +087900 MOVE "SRC OPR/ALL REF" TO FEATURE. DB2014.2 +088000 MOVE "MOVE-TEST-4" TO PAR-NAME. DB2014.2 +088100******************************************************************DB2014.2 +088200* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +088300* "MOVE-TEST-4A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2014.2 +088400* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "MOVE ID-2 *DB2014.2 +088500* TO ID-3.". *DB2014.2 +088600******************************************************************DB2014.2 +088700 MOVE-TEST-4. DB2014.2 +088800 MOVE ID-2 TO ID-3. DB2014.2 +088900 IF KEY-1 IS EQUAL TO 1 DB2014.2 +089000 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +089100 PERFORM PASS DB2014.2 +089200 PERFORM MOVE-TEST-WRITE DB2014.2 +089300 GO TO MOVE-TEST-4A DB2014.2 +089400 ELSE PERFORM FAIL DB2014.2 +089500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +089600 PERFORM MOVE-TEST-WRITE DB2014.2 +089700 PERFORM DELETE-MOVE-4-SUBTESTS DB2014.2 +089800 GO TO MOVE-TEST-5-INIT. DB2014.2 +089900 MOVE-TEST-4-DELETE. DB2014.2 +090000 PERFORM DE-LETE. DB2014.2 +090100 PERFORM MOVE-TEST-WRITE. DB2014.2 +090200 PERFORM DELETE-MOVE-4-SUBTESTS. DB2014.2 +090300 GO TO MOVE-TEST-5-INIT. DB2014.2 +090400 DELETE-MOVE-4-SUBTESTS. DB2014.2 +090500 MOVE "MOVE-TEST-4A" TO PAR-NAME. DB2014.2 +090600 PERFORM DE-LETE. DB2014.2 +090700 PERFORM MOVE-TEST-WRITE. DB2014.2 +090800 MOVE "MOVE-TEST-4B" TO PAR-NAME. DB2014.2 +090900 PERFORM DE-LETE. DB2014.2 +091000 PERFORM MOVE-TEST-WRITE. DB2014.2 +091100 MOVE "MOVE-TEST-4C" TO PAR-NAME. DB2014.2 +091200 PERFORM DE-LETE. DB2014.2 +091300 PERFORM MOVE-TEST-WRITE. DB2014.2 +091400 MOVE-TEST-4A. DB2014.2 +091500 MOVE "MOVE-TEST-4A" TO PAR-NAME. DB2014.2 +091600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +091700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +091800 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +091900 PERFORM INSPT. DB2014.2 +092000 PERFORM MOVE-TEST-WRITE. DB2014.2 +092100 MOVE-TEST-4B. DB2014.2 +092200 MOVE "MOVE-TEST-4B" TO PAR-NAME. DB2014.2 +092300 IF UNQUAL-NAME-1 IS EQUAL TO "ID-2" DB2014.2 +092400 PERFORM PASS DB2014.2 +092500 ELSE PERFORM FAIL DB2014.2 +092600 MOVE "ID-2" TO CORRECT-A DB2014.2 +092700 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +092800 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +092900 PERFORM MOVE-TEST-WRITE. DB2014.2 +093000 MOVE-TEST-4C. DB2014.2 +093100 MOVE "MOVE-TEST-4C" TO PAR-NAME. DB2014.2 +093200 IF CONTENTS-1 IS EQUAL TO "02" DB2014.2 +093300 PERFORM PASS DB2014.2 +093400 ELSE PERFORM FAIL DB2014.2 +093500 MOVE "02" TO CORRECT-A DB2014.2 +093600 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +093700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +093800 PERFORM MOVE-TEST-WRITE. DB2014.2 +093900 MOVE-TEST-5-INIT. DB2014.2 +094000 MOVE 2 TO ID-1A. DB2014.2 +094100 MOVE SPACES TO ITEM-1. DB2014.2 +094200 MOVE 0 TO KEY-1 DB2014.2 +094300 MOVE "SRC OPR/NOT ALL REF" TO FEATURE. DB2014.2 +094400 MOVE "MOVE-TEST-5" TO PAR-NAME. DB2014.2 +094500 MOVE-TEST-5. DB2014.2 +094600 MOVE ID-1 TO ID-3. DB2014.2 +094700 IF KEY-1 IS EQUAL TO 0 DB2014.2 +094800 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +094900 PERFORM PASS DB2014.2 +095000 ELSE PERFORM FAIL DB2014.2 +095100 MOVE "DEBUG PROC EXECUTED" TO RE-MARK. DB2014.2 +095200 PERFORM MOVE-TEST-WRITE. DB2014.2 +095300 GO TO ADD-TEST-1-INIT. DB2014.2 +095400 MOVE-TEST-5-DELETE. DB2014.2 +095500 PERFORM DE-LETE. DB2014.2 +095600 MOVE-TEST-WRITE. DB2014.2 +095700 PERFORM PRINT-DETAIL. DB2014.2 +095800 ADD-TEST-1-INIT. DB2014.2 +095900 MOVE 1 TO ID-2A. DB2014.2 +096000 MOVE SPACES TO ITEM-1. DB2014.2 +096100 MOVE 0 TO KEY-1 ID-3. DB2014.2 +096200 MOVE "MULT SRC OPR/ALL REF" TO FEATURE. DB2014.2 +096300 MOVE "ADD-TEST-1" TO PAR-NAME. DB2014.2 +096400******************************************************************DB2014.2 +096500* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +096600* "ADD-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2014.2 +096700* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2014.2 +096800* "ADD ID-2 ID-2 ID-2 ID-2 TO ID-3.". *DB2014.2 +096900******************************************************************DB2014.2 +097000 ADD-TEST-1. DB2014.2 +097100 ADD ID-2 ID-2 ID-2 ID-2 TO ID-3. DB2014.2 +097200 IF KEY-1 IS EQUAL TO 1 DB2014.2 +097300 PERFORM PASS DB2014.2 +097400 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +097500 ELSE PERFORM FAIL DB2014.2 +097600 MOVE "NO. OF TIMES DEBUG EXECUTED" TO RE-MARK DB2014.2 +097700 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +097800 MOVE 1 TO CORRECT-18V0. DB2014.2 +097900 PERFORM ADD-TEST-WRITE. DB2014.2 +098000 GO TO ADD-TEST-1A. DB2014.2 +098100 ADD-TEST-1-DELETE. DB2014.2 +098200 PERFORM DE-LETE. DB2014.2 +098300 PERFORM ADD-TEST-WRITE. DB2014.2 +098400 PERFORM DELETE-ADD-1-SUBTESTS. DB2014.2 +098500 GO TO ADD-TEST-2-INIT. DB2014.2 +098600 DELETE-ADD-1-SUBTESTS. DB2014.2 +098700 MOVE "ADD-TEST-1A" TO PAR-NAME. DB2014.2 +098800 PERFORM DE-LETE. DB2014.2 +098900 PERFORM ADD-TEST-WRITE. DB2014.2 +099000 MOVE "ADD-TEST-1B" TO PAR-NAME. DB2014.2 +099100 PERFORM DE-LETE. DB2014.2 +099200 PERFORM ADD-TEST-WRITE. DB2014.2 +099300 MOVE "ADD-TEST-1C" TO PAR-NAME. DB2014.2 +099400 PERFORM DE-LETE. DB2014.2 +099500 PERFORM ADD-TEST-WRITE. DB2014.2 +099600 ADD-TEST-1A. DB2014.2 +099700 IF KEY-1 IS EQUAL TO 0 DB2014.2 +099800 PERFORM DELETE-ADD-1-SUBTESTS DB2014.2 +099900 GO TO ADD-TEST-2-INIT. DB2014.2 +100000 MOVE "ADD-TEST-1A" TO PAR-NAME. DB2014.2 +100100 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +100200 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +100300 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +100400 PERFORM INSPT. DB2014.2 +100500 PERFORM ADD-TEST-WRITE. DB2014.2 +100600 ADD-TEST-1B. DB2014.2 +100700 MOVE "ADD-TEST-1B" TO PAR-NAME. DB2014.2 +100800 IF UNQUAL-NAME-1 IS EQUAL TO "ID-2" DB2014.2 +100900 PERFORM PASS DB2014.2 +101000 ELSE PERFORM FAIL DB2014.2 +101100 MOVE "ID-2" TO CORRECT-A DB2014.2 +101200 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +101300 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +101400 PERFORM ADD-TEST-WRITE. DB2014.2 +101500 ADD-TEST-1C. DB2014.2 +101600 MOVE "ADD-TEST-1C" TO PAR-NAME. DB2014.2 +101700 IF CONTENTS-1 IS EQUAL TO "01" DB2014.2 +101800 PERFORM PASS DB2014.2 +101900 ELSE PERFORM FAIL DB2014.2 +102000 MOVE "01" TO CORRECT-A DB2014.2 +102100 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +102200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +102300 PERFORM ADD-TEST-WRITE. DB2014.2 +102400 ADD-TEST-2-INIT. DB2014.2 +102500 MOVE 1 TO ID-1A. DB2014.2 +102600 MOVE SPACES TO ITEM-1. DB2014.2 +102700 MOVE 0 TO KEY-1 ID-3. DB2014.2 +102800 MOVE "MULT SRC OPR/NOT ALL" TO FEATURE. DB2014.2 +102900 MOVE "ADD-TEST-2" TO PAR-NAME. DB2014.2 +103000 ADD-TEST-2. DB2014.2 +103100 ADD ID-1 ID-1 ID-1 ID-1 TO ID-3. DB2014.2 +103200 IF KEY-1 IS EQUAL TO 0 DB2014.2 +103300 PERFORM PASS DB2014.2 +103400 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +103500 ELSE PERFORM FAIL DB2014.2 +103600 MOVE "NO. OF TIMES DEBUG EXECUTED" TO RE-MARK DB2014.2 +103700 MOVE KEY-1 TO COMPUTED-A DB2014.2 +103800 MOVE "0" TO CORRECT-A. DB2014.2 +103900 PERFORM ADD-TEST-WRITE. DB2014.2 +104000 GO TO ADD-TEST-3-INIT. DB2014.2 +104100 ADD-TEST-2-DELETE. DB2014.2 +104200 PERFORM DE-LETE. DB2014.2 +104300 PERFORM ADD-TEST-WRITE. DB2014.2 +104400 ADD-TEST-3-INIT. DB2014.2 +104500 MOVE 1 TO ID-2A. DB2014.2 +104600 MOVE SPACES TO ITEM-1. DB2014.2 +104700 MOVE 0 TO KEY-1. DB2014.2 +104800 MOVE "SRC-RCV OPR/ALL REF" TO FEATURE. DB2014.2 +104900 MOVE "ADD-TEST-3" TO PAR-NAME. DB2014.2 +105000 ADD-TEST-3. DB2014.2 +105100 ADD ID-2 ID-2 ID-2 ID-2 TO ID-2. DB2014.2 +105200 IF KEY-1 IS EQUAL TO 1 DB2014.2 +105300 PERFORM PASS DB2014.2 +105400 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +105500 PERFORM ADD-TEST-WRITE DB2014.2 +105600 GO TO ADD-TEST-3A DB2014.2 +105700 ELSE PERFORM FAIL DB2014.2 +105800 MOVE "NO. OF TIMES DEBUG EXECUTED" TO RE-MARK DB2014.2 +105900 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +106000 MOVE 1 TO CORRECT-18V0. DB2014.2 +106100 PERFORM ADD-TEST-WRITE. DB2014.2 +106200 IF KEY-1 IS EQUAL TO 0 DB2014.2 +106300 PERFORM DELETE-ADD-TEST-3-SUBTEST DB2014.2 +106400 GO TO ADD-TEST-4-INIT DB2014.2 +106500 ELSE GO TO ADD-TEST-3A. DB2014.2 +106600 ADD-TEST-3-DELETE. DB2014.2 +106700 PERFORM DE-LETE. DB2014.2 +106800 PERFORM ADD-TEST-WRITE. DB2014.2 +106900 PERFORM DELETE-ADD-TEST-3-SUBTEST. DB2014.2 +107000 GO TO ADD-TEST-4-INIT. DB2014.2 +107100 DELETE-ADD-TEST-3-SUBTEST. DB2014.2 +107200 MOVE "ADD-TEST-3A" TO PAR-NAME. DB2014.2 +107300 PERFORM DE-LETE. DB2014.2 +107400 PERFORM ADD-TEST-WRITE. DB2014.2 +107500 ADD-TEST-3A. DB2014.2 +107600 MOVE "ADD-TEST-3A" TO PAR-NAME. DB2014.2 +107700 IF CONTENTS-1 IS EQUAL TO "05" DB2014.2 +107800 PERFORM PASS DB2014.2 +107900 ELSE PERFORM FAIL DB2014.2 +108000 MOVE "05" TO CORRECT-A DB2014.2 +108100 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +108200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +108300 PERFORM ADD-TEST-WRITE. DB2014.2 +108400 ADD-TEST-4-INIT. DB2014.2 +108500 MOVE 1 TO ID-1A. DB2014.2 +108600 MOVE SPACES TO ITEM-1. DB2014.2 +108700 MOVE 0 TO KEY-1. DB2014.2 +108800 MOVE "SRC-RCV OPR/NOT ALL" TO FEATURE. DB2014.2 +108900 MOVE "ADD-TEST-4" TO PAR-NAME. DB2014.2 +109000 ADD-TEST-4. DB2014.2 +109100 ADD ID-1 ID-1 ID-1 ID-1 TO ID-1. DB2014.2 +109200 IF KEY-1 IS EQUAL TO 1 DB2014.2 +109300 PERFORM PASS DB2014.2 +109400 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +109500 PERFORM ADD-TEST-WRITE DB2014.2 +109600 GO TO ADD-TEST-4A DB2014.2 +109700 ELSE PERFORM FAIL DB2014.2 +109800 MOVE "NO. OF TIMES DEBUG EXECUTED" TO RE-MARK DB2014.2 +109900 MOVE KEY-1 TO COMPUTED-18V0 DB2014.2 +110000 MOVE 1 TO CORRECT-18V0. DB2014.2 +110100 PERFORM ADD-TEST-WRITE. DB2014.2 +110200 IF KEY-1 IS EQUAL TO 0 DB2014.2 +110300 PERFORM DELETE-ADD-TEST-4-SUBTEST DB2014.2 +110400 GO TO SUBC-TEST-1-INIT DB2014.2 +110500 ELSE GO TO ADD-TEST-4A. DB2014.2 +110600 ADD-TEST-4-DELETE. DB2014.2 +110700 PERFORM DE-LETE. DB2014.2 +110800 PERFORM ADD-TEST-WRITE. DB2014.2 +110900 PERFORM DELETE-ADD-TEST-4-SUBTEST. DB2014.2 +111000 GO TO SUBC-TEST-1-INIT. DB2014.2 +111100 DELETE-ADD-TEST-4-SUBTEST. DB2014.2 +111200 MOVE "ADD-TEST-4A" TO PAR-NAME. DB2014.2 +111300 PERFORM DE-LETE. DB2014.2 +111400 PERFORM ADD-TEST-WRITE. DB2014.2 +111500 ADD-TEST-4A. DB2014.2 +111600 MOVE "ADD-TEST-4A" TO PAR-NAME. DB2014.2 +111700 IF CONTENTS-1 IS EQUAL TO "05" DB2014.2 +111800 PERFORM PASS DB2014.2 +111900 ELSE PERFORM FAIL DB2014.2 +112000 MOVE "05" TO CORRECT-A DB2014.2 +112100 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +112200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +112300 ADD-TEST-WRITE. DB2014.2 +112400 PERFORM PRINT-DETAIL. DB2014.2 +112500 SUBC-TEST-1-INIT. DB2014.2 +112600 MOVE "SUBSC-TEST-1" TO PAR-NAME. DB2014.2 +112700 MOVE "ONE-DIM SUBSCRIPT" TO FEATURE. DB2014.2 +112800 MOVE SPACE TO ITEM-1. DB2014.2 +112900 MOVE 0 TO KEY-1. DB2014.2 +113000 SET I TO 5. DB2014.2 +113100******************************************************************DB2014.2 +113200* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +113300* "SUBSC-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2014.2 +113400* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "MOVE *DB2014.2 +113500* "ABCDE" TO B-LEVEL1 (I).". *DB2014.2 +113600******************************************************************DB2014.2 +113700 SUBSC-TEST-1. DB2014.2 +113800 MOVE "ABCDE" TO B-LEVEL-1 (I). DB2014.2 +113900 IF KEY-1 IS EQUAL TO 1 DB2014.2 +114000 PERFORM PASS DB2014.2 +114100 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2014.2 +114200 PERFORM SUBSC-TEST-WRITE DB2014.2 +114300 GO TO SUBSC-TEST-1A DB2014.2 +114400 ELSE PERFORM FAIL DB2014.2 +114500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +114600 PERFORM SUBSC-TEST-WRITE DB2014.2 +114700 PERFORM DELETE-SUBSC-TEST-1-SUBTESTS DB2014.2 +114800 GO TO SUBSC-TEST-2-INIT. DB2014.2 +114900 SUBSC-TEST-1-DELETE. DB2014.2 +115000 PERFORM DE-LETE. DB2014.2 +115100 PERFORM SUBSC-TEST-WRITE. DB2014.2 +115200 PERFORM DELETE-SUBSC-TEST-1-SUBTESTS. DB2014.2 +115300 GO TO SUBSC-TEST-2-INIT. DB2014.2 +115400 DELETE-SUBSC-TEST-1-SUBTESTS. DB2014.2 +115500 MOVE "SUBSC-TEST-1A" TO PAR-NAME. DB2014.2 +115600 PERFORM DE-LETE. DB2014.2 +115700 PERFORM SUBSC-TEST-WRITE. DB2014.2 +115800 MOVE "SUBSC-TEST-1B" TO PAR-NAME. DB2014.2 +115900 PERFORM DE-LETE. DB2014.2 +116000 PERFORM SUBSC-TEST-WRITE. DB2014.2 +116100 MOVE "SUBSC-TEST-1C" TO PAR-NAME. DB2014.2 +116200 PERFORM DE-LETE. DB2014.2 +116300 PERFORM SUBSC-TEST-WRITE. DB2014.2 +116400 MOVE "SUBSC-TEST-1D" TO PAR-NAME. DB2014.2 +116500 PERFORM DE-LETE. DB2014.2 +116600 PERFORM SUBSC-TEST-WRITE. DB2014.2 +116700 MOVE "SUBSC-TEST-1E" TO PAR-NAME. DB2014.2 +116800 PERFORM DE-LETE. DB2014.2 +116900 PERFORM SUBSC-TEST-WRITE. DB2014.2 +117000 MOVE "SUBSC-TEST-1F" TO PAR-NAME. DB2014.2 +117100 PERFORM DE-LETE. DB2014.2 +117200 PERFORM SUBSC-TEST-WRITE. DB2014.2 +117300 SUBSC-TEST-1A. DB2014.2 +117400 MOVE "SUBSC-TEST-1A" TO PAR-NAME. DB2014.2 +117500 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +117600 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +117700 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +117800 PERFORM INSPT. DB2014.2 +117900 PERFORM SUBSC-TEST-WRITE. DB2014.2 +118000 SUBSC-TEST-1B. DB2014.2 +118100 MOVE "SUBSC-TEST-1B" TO PAR-NAME. DB2014.2 +118200 IF UNQUAL-NAME-1 IS EQUAL TO "B-LEVEL-1" DB2014.2 +118300 PERFORM PASS DB2014.2 +118400 ELSE PERFORM FAIL DB2014.2 +118500 MOVE "B-LEVEL-1" TO CORRECT-A DB2014.2 +118600 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +118700 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +118800 PERFORM SUBSC-TEST-WRITE. DB2014.2 +118900 SUBSC-TEST-1C. DB2014.2 +119000 MOVE "SUBSC-TEST-1C" TO PAR-NAME. DB2014.2 +119100 IF CONTENTS-1 IS EQUAL TO "ABCDE" DB2014.2 +119200 PERFORM PASS DB2014.2 +119300 ELSE PERFORM FAIL DB2014.2 +119400 MOVE "ABCDE" TO CORRECT-A DB2014.2 +119500 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +119600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +119700 PERFORM SUBSC-TEST-WRITE. DB2014.2 +119800 SUBSC-TEST-1D. DB2014.2 +119900 MOVE "SUBSC-TEST-1D" TO PAR-NAME. DB2014.2 +120000 IF SUB-1-1 IS EQUAL TO "0005" DB2014.2 +120100 PERFORM PASS DB2014.2 +120200 ELSE PERFORM FAIL DB2014.2 +120300 MOVE "0005" TO CORRECT-A DB2014.2 +120400 MOVE SUB-1-1 TO COMPUTED-A. DB2014.2 +120500 MOVE "DEBUG-SUB-1" TO RE-MARK. DB2014.2 +120600 PERFORM SUBSC-TEST-WRITE. DB2014.2 +120700 SUBSC-TEST-1E. DB2014.2 +120800 MOVE "SUBSC-TEST-1E" TO PAR-NAME. DB2014.2 +120900 PERFORM DE-LETE. DB2014.2 +121000 PERFORM SUBSC-TEST-WRITE. DB2014.2 +121100 SUBSC-TEST-1F. DB2014.2 +121200 MOVE "SUBSC-TEST-1F" TO PAR-NAME. DB2014.2 +121300 PERFORM DE-LETE. DB2014.2 +121400 PERFORM SUBSC-TEST-WRITE. DB2014.2 +121500 SUBSC-TEST-2-INIT. DB2014.2 +121600 MOVE "SUBSC-TEST-2" TO PAR-NAME. DB2014.2 +121700 MOVE "THR-DIM SUBSCRIPT" TO FEATURE. DB2014.2 +121800 MOVE SPACES TO ITEM-1. DB2014.2 +121900 MOVE 0 TO KEY-1. DB2014.2 +122000 SET I TO 4 DB2014.2 +122100 SET J TO 6. DB2014.2 +122200 SET K TO 8. DB2014.2 +122300 SUBSC-TEST-2. DB2014.2 +122400 MOVE "Z" TO B-LEVEL-3 (I, J, K). DB2014.2 +122500 IF KEY-1 IS EQUAL TO 1 DB2014.2 +122600 PERFORM PASS DB2014.2 +122700 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2014.2 +122800 PERFORM SUBSC-TEST-WRITE DB2014.2 +122900 GO TO SUBSC-TEST-2A DB2014.2 +123000 ELSE PERFORM FAIL DB2014.2 +123100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +123200 PERFORM SUBSC-TEST-WRITE DB2014.2 +123300 PERFORM DELETE-SUBSC-TEST-2-SUBTESTS DB2014.2 +123400 GO TO QUAL-TEST-1-INIT. DB2014.2 +123500 SUBSC-TEST-2-DELETE. DB2014.2 +123600 PERFORM DE-LETE. DB2014.2 +123700 PERFORM SUBSC-TEST-WRITE. DB2014.2 +123800 PERFORM DELETE-SUBSC-TEST-2-SUBTESTS. DB2014.2 +123900 GO TO QUAL-TEST-1-INIT. DB2014.2 +124000 DELETE-SUBSC-TEST-2-SUBTESTS. DB2014.2 +124100 MOVE "SUBSC-TEST-2A" TO PAR-NAME. DB2014.2 +124200 PERFORM DE-LETE. DB2014.2 +124300 PERFORM SUBSC-TEST-WRITE. DB2014.2 +124400 MOVE "SUBSC-TEST-2B" TO PAR-NAME. DB2014.2 +124500 PERFORM DE-LETE. DB2014.2 +124600 PERFORM SUBSC-TEST-WRITE. DB2014.2 +124700 MOVE "SUBSC-TEST-2C" TO PAR-NAME. DB2014.2 +124800 PERFORM DE-LETE. DB2014.2 +124900 PERFORM SUBSC-TEST-WRITE. DB2014.2 +125000 MOVE "SUBSC-TEST-2D" TO PAR-NAME. DB2014.2 +125100 PERFORM DE-LETE. DB2014.2 +125200 PERFORM SUBSC-TEST-WRITE. DB2014.2 +125300 SUBSC-TEST-2A. DB2014.2 +125400 MOVE "SUBSC-TEST-2A" TO PAR-NAME. DB2014.2 +125500 IF CONTENTS-1 IS EQUAL TO "Z" DB2014.2 +125600 PERFORM PASS DB2014.2 +125700 ELSE PERFORM FAIL DB2014.2 +125800 MOVE "Z" TO CORRECT-A DB2014.2 +125900 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +126000 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +126100 PERFORM SUBSC-TEST-WRITE. DB2014.2 +126200 SUBSC-TEST-2B. DB2014.2 +126300 MOVE "SUBSC-TEST-2B" TO PAR-NAME. DB2014.2 +126400 IF SUB-1-1 IS EQUAL TO "0004" DB2014.2 +126500 PERFORM PASS DB2014.2 +126600 ELSE PERFORM FAIL DB2014.2 +126700 MOVE "0004" TO CORRECT-A DB2014.2 +126800 MOVE SUB-1-1 TO COMPUTED-A. DB2014.2 +126900 MOVE "DEBUG-SUB-1" TO RE-MARK. DB2014.2 +127000 PERFORM SUBSC-TEST-WRITE. DB2014.2 +127100 SUBSC-TEST-2C. DB2014.2 +127200 MOVE "SUBSC-TEST-2C" TO PAR-NAME. DB2014.2 +127300 IF SUB-2-1 IS EQUAL TO "0006" DB2014.2 +127400 PERFORM PASS DB2014.2 +127500 ELSE PERFORM FAIL DB2014.2 +127600 MOVE "0006" TO CORRECT-A DB2014.2 +127700 MOVE SUB-2-1 TO COMPUTED-A. DB2014.2 +127800 MOVE "DEBUG-SUB-2" TO RE-MARK. DB2014.2 +127900 PERFORM SUBSC-TEST-WRITE. DB2014.2 +128000 SUBSC-TEST-2D. DB2014.2 +128100 MOVE "SUBSC-TEST-2D" TO PAR-NAME. DB2014.2 +128200 IF SUB-3-1 IS EQUAL TO "0008" DB2014.2 +128300 PERFORM PASS DB2014.2 +128400 ELSE PERFORM FAIL DB2014.2 +128500 MOVE "0008" TO CORRECT-A DB2014.2 +128600 MOVE SUB-3-1 TO COMPUTED-A. DB2014.2 +128700 MOVE "DEBUG-SUB-3" TO RE-MARK. DB2014.2 +128800 SUBSC-TEST-WRITE. DB2014.2 +128900 PERFORM PRINT-DETAIL. DB2014.2 +129000 QUAL-TEST-1-INIT. DB2014.2 +129100 MOVE "QUAL-TEST-1" TO PAR-NAME. DB2014.2 +129200 MOVE "1-LEVEL QUALIFICATN" TO FEATURE. DB2014.2 +129300 MOVE SPACES TO ITEM-1. DB2014.2 +129400 MOVE 0 TO KEY-1. DB2014.2 +129500******************************************************************DB2014.2 +129600* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2014.2 +129700* "QUAL-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2014.2 +129800* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2014.2 +129900* "MOVE "XY" TO AB2 OF A2.". *DB2014.2 +130000******************************************************************DB2014.2 +130100 QUAL-TEST-1. DB2014.2 +130200 MOVE "XY" TO AB2 OF A2. DB2014.2 +130300 IF KEY-1 IS EQUAL TO 1 DB2014.2 +130400 PERFORM PASS DB2014.2 +130500 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +130600 PERFORM QUAL-TEST-WRITE DB2014.2 +130700 GO TO QUAL-TEST-1A DB2014.2 +130800 ELSE PERFORM FAIL DB2014.2 +130900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +131000 PERFORM QUAL-TEST-WRITE DB2014.2 +131100 PERFORM DELETE-QUAL-TEST-1-SUBTESTS DB2014.2 +131200 GO TO QUAL-TEST-2-INIT. DB2014.2 +131300 QUAL-TEST-1-DELETE. DB2014.2 +131400 PERFORM DE-LETE. DB2014.2 +131500 PERFORM QUAL-TEST-WRITE. DB2014.2 +131600 PERFORM DELETE-QUAL-TEST-1-SUBTESTS. DB2014.2 +131700 GO TO QUAL-TEST-2-INIT. DB2014.2 +131800 DELETE-QUAL-TEST-1-SUBTESTS. DB2014.2 +131900 MOVE "QUAL-TEST-1A" TO PAR-NAME. DB2014.2 +132000 PERFORM DE-LETE DB2014.2 +132100 PERFORM QUAL-TEST-WRITE. DB2014.2 +132200 MOVE "QUAL-TEST-1B" TO PAR-NAME. DB2014.2 +132300 PERFORM DE-LETE. DB2014.2 +132400 PERFORM QUAL-TEST-WRITE. DB2014.2 +132500 MOVE "QUAL-TEST-1C" TO PAR-NAME. DB2014.2 +132600 PERFORM DE-LETE. DB2014.2 +132700 PERFORM QUAL-TEST-WRITE. DB2014.2 +132800 QUAL-TEST-1A. DB2014.2 +132900 MOVE "QUAL-TEST-1A" TO PAR-NAME. DB2014.2 +133000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2014.2 +133100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2014.2 +133200 MOVE LINE-1 TO COMPUTED-A. DB2014.2 +133300 PERFORM INSPT. DB2014.2 +133400 PERFORM QUAL-TEST-WRITE. DB2014.2 +133500 QUAL-TEST-1B. DB2014.2 +133600 MOVE "QUAL-TEST-1B" TO PAR-NAME. DB2014.2 +133700 IF NAME-1 IS EQUAL TO "AB2 OF A2" OR DB2014.2 +133800 NAME-1 IS EQUAL TO "AB2 IN A2" DB2014.2 +133900 PERFORM PASS DB2014.2 +134000 ELSE PERFORM FAIL DB2014.2 +134100 MOVE "AB2 OF(IN) A2" TO CORRECT-A DB2014.2 +134200 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +134300 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +134400 PERFORM QUAL-TEST-WRITE. DB2014.2 +134500 QUAL-TEST-1C. DB2014.2 +134600 MOVE "QUAL-TEST-1C" TO PAR-NAME. DB2014.2 +134700 IF CONTENTS-1 IS EQUAL TO "XY" DB2014.2 +134800 PERFORM PASS DB2014.2 +134900 ELSE PERFORM FAIL DB2014.2 +135000 MOVE "XY" TO CORRECT-A DB2014.2 +135100 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +135200 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +135300 PERFORM QUAL-TEST-WRITE. DB2014.2 +135400 QUAL-TEST-2-INIT. DB2014.2 +135500 MOVE "QUAL-TEST-2" TO PAR-NAME. DB2014.2 +135600 MOVE "1-LEVEL QUALIFICATN" TO FEATURE. DB2014.2 +135700 MOVE SPACES TO ITEM-1. DB2014.2 +135800 MOVE 0 TO KEY-1. DB2014.2 +135900 QUAL-TEST-2. DB2014.2 +136000 MOVE "CD" TO AB2 OF A1. DB2014.2 +136100 IF KEY-1 IS EQUAL TO 0 DB2014.2 +136200 PERFORM PASS DB2014.2 +136300 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +136400 ELSE PERFORM FAIL DB2014.2 +136500 MOVE "DEBUG PROC EXECUTED" TO RE-MARK. DB2014.2 +136600 PERFORM QUAL-TEST-WRITE. DB2014.2 +136700 GO TO QUAL-TEST-3-INIT. DB2014.2 +136800 QUAL-TEST-2-DELETE. DB2014.2 +136900 PERFORM DE-LETE. DB2014.2 +137000 PERFORM QUAL-TEST-WRITE. DB2014.2 +137100 QUAL-TEST-3-INIT. DB2014.2 +137200 MOVE "QUAL-TEST-3" TO PAR-NAME. DB2014.2 +137300 MOVE "1-LEVEL QUALIFICATN" TO FEATURE. DB2014.2 +137400 MOVE SPACES TO ITEM-1. DB2014.2 +137500 MOVE 0 TO KEY-1. DB2014.2 +137600 QUAL-TEST-3. DB2014.2 +137700 MOVE "Q" TO ABC2 OF AB2 OF A2. DB2014.2 +137800 IF KEY-1 IS EQUAL TO 0 DB2014.2 +137900 PERFORM PASS DB2014.2 +138000 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +138100 ELSE PERFORM FAIL DB2014.2 +138200 MOVE "DEBUG PROC EXECUTED" TO RE-MARK. DB2014.2 +138300 PERFORM QUAL-TEST-WRITE. DB2014.2 +138400 GO TO QUAL-TEST-4-INIT. DB2014.2 +138500 QUAL-TEST-3-DELETE. DB2014.2 +138600 PERFORM DE-LETE. DB2014.2 +138700 PERFORM QUAL-TEST-WRITE. DB2014.2 +138800 QUAL-TEST-4-INIT. DB2014.2 +138900 MOVE "QUAL-TEST-4" TO PAR-NAME. DB2014.2 +139000 MOVE "2-LEVEL QUALIFICATN" TO FEATURE. DB2014.2 +139100 MOVE SPACES TO ITEM-1. DB2014.2 +139200 MOVE 0 TO KEY-1. DB2014.2 +139300 QUAL-TEST-4. DB2014.2 +139400 MOVE "G" TO ABC1 OF AB2 OF A1. DB2014.2 +139500 IF KEY-1 IS EQUAL TO 1 DB2014.2 +139600 PERFORM PASS DB2014.2 +139700 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +139800 PERFORM QUAL-TEST-WRITE DB2014.2 +139900 GO TO QUAL-TEST-4A DB2014.2 +140000 ELSE PERFORM FAIL DB2014.2 +140100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +140200 PERFORM QUAL-TEST-WRITE DB2014.2 +140300 PERFORM DELETE-QUAL-TEST-4-SUBTESTS DB2014.2 +140400 GO TO QUAL-TEST-5-INIT. DB2014.2 +140500 QUAL-TEST-4-DELETE. DB2014.2 +140600 PERFORM DE-LETE. DB2014.2 +140700 PERFORM QUAL-TEST-WRITE. DB2014.2 +140800 PERFORM DELETE-QUAL-TEST-4-SUBTESTS. DB2014.2 +140900 GO TO QUAL-TEST-5-INIT. DB2014.2 +141000 DELETE-QUAL-TEST-4-SUBTESTS. DB2014.2 +141100 MOVE "QUAL-TEST-4A" TO PAR-NAME. DB2014.2 +141200 PERFORM DE-LETE. DB2014.2 +141300 PERFORM QUAL-TEST-WRITE. DB2014.2 +141400 MOVE "QUAL-TEST-4B" TO PAR-NAME. DB2014.2 +141500 PERFORM DE-LETE. DB2014.2 +141600 PERFORM QUAL-TEST-WRITE. DB2014.2 +141700 QUAL-TEST-4A. DB2014.2 +141800 MOVE "QUAL-TEST-4A" TO PAR-NAME. DB2014.2 +141900 IF NAME-1 IS EQUAL TO "ABC1 OF AB2 OF A1" OR DB2014.2 +142000 NAME-1 IS EQUAL TO "ABC1 IN AB2 IN A1" DB2014.2 +142100 PERFORM PASS DB2014.2 +142200 ELSE PERFORM FAIL DB2014.2 +142300 MOVE "ABC1 OF AB2 OF A1" TO CORRECT-A DB2014.2 +142400 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +142500 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +142600 PERFORM QUAL-TEST-WRITE. DB2014.2 +142700 QUAL-TEST-4B. DB2014.2 +142800 MOVE "QUAL-TEST-4B" TO PAR-NAME. DB2014.2 +142900 IF CONTENTS-1 IS EQUAL TO "G" DB2014.2 +143000 PERFORM PASS DB2014.2 +143100 ELSE PERFORM FAIL DB2014.2 +143200 MOVE "G" TO CORRECT-A DB2014.2 +143300 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +143400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +143500 PERFORM QUAL-TEST-WRITE. DB2014.2 +143600 QUAL-TEST-5-INIT. DB2014.2 +143700 MOVE "QUAL-TEST-5" TO PAR-NAME. DB2014.2 +143800 MOVE "QUALIFIED SUBSC ITEM" TO FEATURE. DB2014.2 +143900 MOVE SPACES TO ITEM-1. DB2014.2 +144000 MOVE 0 TO KEY-1. DB2014.2 +144100 QUAL-TEST-5. DB2014.2 +144200 MOVE "F" TO AB1 OF A1 (3). DB2014.2 +144300 IF KEY-1 IS EQUAL TO 1 DB2014.2 +144400 PERFORM PASS DB2014.2 +144500 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2014.2 +144600 PERFORM QUAL-TEST-WRITE DB2014.2 +144700 GO TO QUAL-TEST-5A DB2014.2 +144800 ELSE PERFORM FAIL DB2014.2 +144900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2014.2 +145000 PERFORM QUAL-TEST-WRITE DB2014.2 +145100 PERFORM DELETE-QUAL-TEST-5-SUBTESTS DB2014.2 +145200 GO TO END-OF-DB201A. DB2014.2 +145300 QUAL-TEST-5-DELETE. DB2014.2 +145400 PERFORM DE-LETE. DB2014.2 +145500 PERFORM QUAL-TEST-WRITE. DB2014.2 +145600 PERFORM DELETE-QUAL-TEST-5-SUBTESTS. DB2014.2 +145700 GO TO END-OF-DB201A. DB2014.2 +145800 DELETE-QUAL-TEST-5-SUBTESTS. DB2014.2 +145900 MOVE "QUAL-TEST-5A" TO PAR-NAME. DB2014.2 +146000 PERFORM DE-LETE. DB2014.2 +146100 PERFORM QUAL-TEST-WRITE. DB2014.2 +146200 MOVE "QUAL-TEST-5B" TO PAR-NAME. DB2014.2 +146300 PERFORM DE-LETE. DB2014.2 +146400 PERFORM QUAL-TEST-WRITE. DB2014.2 +146500 MOVE "QUAL-TEST-5C" TO PAR-NAME. DB2014.2 +146600 PERFORM DE-LETE. DB2014.2 +146700 PERFORM QUAL-TEST-WRITE. DB2014.2 +146800 MOVE "QUAL-TEST-5D" TO PAR-NAME. DB2014.2 +146900 PERFORM DE-LETE. DB2014.2 +147000 PERFORM QUAL-TEST-WRITE. DB2014.2 +147100 MOVE "QUAL-TEST-5E" TO PAR-NAME. DB2014.2 +147200 PERFORM DE-LETE. DB2014.2 +147300 PERFORM QUAL-TEST-WRITE. DB2014.2 +147400 QUAL-TEST-5A. DB2014.2 +147500 MOVE "QUAL-TEST-5A" TO PAR-NAME. DB2014.2 +147600 IF NAME-1 IS EQUAL TO "AB1 OF A1" OR DB2014.2 +147700 NAME-1 IS EQUAL TO "AB1 IN A1" DB2014.2 +147800 PERFORM PASS DB2014.2 +147900 ELSE PERFORM FAIL DB2014.2 +148000 MOVE "AB1 OF(IN) A1" TO CORRECT-A DB2014.2 +148100 MOVE NAME-1 TO COMPUTED-A. DB2014.2 +148200 MOVE "DEBUG-NAME" TO RE-MARK. DB2014.2 +148300 PERFORM QUAL-TEST-WRITE. DB2014.2 +148400 QUAL-TEST-5B. DB2014.2 +148500 MOVE "QUAL-TEST-5B" TO PAR-NAME. DB2014.2 +148600 IF CONTENTS-1 IS EQUAL TO "F" DB2014.2 +148700 PERFORM PASS DB2014.2 +148800 ELSE PERFORM FAIL DB2014.2 +148900 MOVE "F" TO CORRECT-A DB2014.2 +149000 MOVE CONTENTS-1 TO COMPUTED-A. DB2014.2 +149100 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2014.2 +149200 PERFORM QUAL-TEST-WRITE. DB2014.2 +149300 QUAL-TEST-5C. DB2014.2 +149400 MOVE "QUAL-TEST-5C" TO PAR-NAME. DB2014.2 +149500 IF SUB-1-1 IS EQUAL TO "0003" DB2014.2 +149600 PERFORM PASS DB2014.2 +149700 ELSE PERFORM FAIL DB2014.2 +149800 MOVE "0003" TO CORRECT-A DB2014.2 +149900 MOVE SUB-1-1 TO COMPUTED-A. DB2014.2 +150000 MOVE "DEBUG-SUB-1" TO RE-MARK. DB2014.2 +150100 PERFORM QUAL-TEST-WRITE. DB2014.2 +150200 QUAL-TEST-5D. DB2014.2 +150300 MOVE "QUAL-TEST-5D" TO PAR-NAME. DB2014.2 +150400 PERFORM DE-LETE. DB2014.2 +150500 PERFORM QUAL-TEST-WRITE. DB2014.2 +150600 QUAL-TEST-5E. DB2014.2 +150700 MOVE "QUAL-TEST-5E" TO PAR-NAME. DB2014.2 +150800 PERFORM DE-LETE. DB2014.2 +150900 QUAL-TEST-WRITE. DB2014.2 +151000 PERFORM PRINT-DETAIL. DB2014.2 +151100 END-OF-DB201A. DB2014.2 +151200 EXIT. DB2014.2 +151300 CCVS-EXIT SECTION. DB2014.2 +151400 CCVS-999999. DB2014.2 +151500 GO TO CLOSE-FILES. DB2014.2 +*END-OF,DB201A +*HEADER,COBOL,DB202A +000100 IDENTIFICATION DIVISION. DB2024.2 +000200 PROGRAM-ID. DB2024.2 +000300 DB202A. DB2024.2 +000400 AUTHOR. DB2024.2 +000500 FEDERAL COMPILER TESTING CENTER. DB2024.2 +000600 INSTALLATION. DB2024.2 +000700 GENERAL SERVICES ADMINISTRATION DB2024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB2024.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB2024.2 +001100 FALLS CHURCH VIRGINIA 22041. DB2024.2 +001200 DB2024.2 +001300 PHONE (703) 756-6153 DB2024.2 +001400 DB2024.2 +001500 " HIGH ". DB2024.2 +001600 DATE-WRITTEN. DB2024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2024.2 +001800 CREATION DATE / VALIDATION DATE DB2024.2 +001900 "4.2 ". DB2024.2 +002000 SECURITY. DB2024.2 +002100 NONE. DB2024.2 +002200* DB2024.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB2024.2 +002400* DB2024.2 +002500* PROGRAM ABSTRACT DB2024.2 +002600* DB2024.2 +002700* DB202A TESTS THE CPABILITY OF THE DEBUG MODULE TO HANDLE DB2024.2 +002800* DEBUGGING PROCEDURES WHICH ARE MONITORING I-O FUNCTIONS DB2024.2 +002900* OF THE SEQUENTIAL I-O MODULE. THIS PROGRAM IS TO BE DB2024.2 +003000* COMPILED AND EXECUTED WITH BOTH COMPILE AND OBJECT TIME DB2024.2 +003100* DEBUGGING SWITCHES ON. THE DEBUGGING PROCEDURES SHOULD DB2024.2 +003200* BE INCLUDED IN COMPILATION AND GENERATE CODE. DB2024.2 +003300* DB2024.2 +003400* DURING EXECUTION, A SEQUENTIAL FILE IS CREATED CONTAINING DB2024.2 +003500* 80-CHARACTER RECORDS. THE FILE US THEN READ. EXECUTION DB2024.2 +003600* OF "OPEN", "READ", AND "WRITE" FUNCTION SHOULD TRIGGER THE DB2024.2 +003700* APPROPRIATE DEBUGGING PROCEDURES. DB2024.2 +003800* DB2024.2 +003900* DB2024.2 +004000* DB2024.2 +004100 ENVIRONMENT DIVISION. DB2024.2 +004200 CONFIGURATION SECTION. DB2024.2 +004300 SOURCE-COMPUTER. DB2024.2 +004400 XXXXX082 DB2024.2 +004500 WITH DEBUGGING MODE. DB2024.2 +004600 OBJECT-COMPUTER. DB2024.2 +004700 XXXXX083. DB2024.2 +004800 INPUT-OUTPUT SECTION. DB2024.2 +004900 FILE-CONTROL. DB2024.2 +005000 SELECT PRINT-FILE ASSIGN TO DB2024.2 +005100 XXXXX055. DB2024.2 +005200 SELECT SEQ-FILE ASSIGN TO DB2024.2 +005300 XXXXX014. DB2024.2 +005400 DATA DIVISION. DB2024.2 +005500 FILE SECTION. DB2024.2 +005600 FD PRINT-FILE DB2024.2 +005700 LABEL RECORDS DB2024.2 +005800 XXXXX084 DB2024.2 +005900 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2024.2 +006000 01 PRINT-REC PICTURE X(120). DB2024.2 +006100 01 DUMMY-RECORD PICTURE X(120). DB2024.2 +006200 FD SEQ-FILE DB2024.2 +006300C VALUE OF DB2024.2 +006400C XXXXX074 DB2024.2 +006500* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2024.2 +006600C IS DB2024.2 +006700C XXXXX075 DB2024.2 +006800* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2024.2 +006900G XXXXX069 DB2024.2 +007000* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2024.2 +007100 LABEL RECORDS ARE STANDARD. DB2024.2 +007200 01 SEQ-REC-1 PIC X(120). DB2024.2 +007300 01 SEQ-REC-2 PIC X(120). DB2024.2 +007400 01 SEQ-REC-3 PIC X(120). DB2024.2 +007500 WORKING-STORAGE SECTION. DB2024.2 +007600 01 ITEM-1. DB2024.2 +007700 02 KEY-1 PIC 99. DB2024.2 +007800 02 LINE-1 PIC X(6). DB2024.2 +007900 02 NAME-1 PIC X(30). DB2024.2 +008000 02 UNQUAL-NAME-1 PIC X(30). DB2024.2 +008100 02 CONTENTS-1 PIC X(120). DB2024.2 +008200 02 CONTENTS-REC PIC X(120). DB2024.2 +008300 01 FILE-RECORD-INFORMATION-REC. DB2024.2 +008400 03 FILE-RECORD-INFO-SKELETON. DB2024.2 +008500 05 FILLER PICTURE X(48) VALUE DB2024.2 +008600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB2024.2 +008700 05 FILLER PICTURE X(46) VALUE DB2024.2 +008800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB2024.2 +008900 05 FILLER PICTURE X(26) VALUE DB2024.2 +009000 ",LFIL=000000,ORG= ,LBLR= ". DB2024.2 +009100 05 FILLER PICTURE X(37) VALUE DB2024.2 +009200 ",RECKEY= ". DB2024.2 +009300 05 FILLER PICTURE X(38) VALUE DB2024.2 +009400 ",ALTKEY1= ". DB2024.2 +009500 05 FILLER PICTURE X(38) VALUE DB2024.2 +009600 ",ALTKEY2= ". DB2024.2 +009700 05 FILLER PICTURE X(7) VALUE SPACE.DB2024.2 +009800 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB2024.2 +009900 05 FILE-RECORD-INFO-P1-120. DB2024.2 +010000 07 FILLER PIC X(5). DB2024.2 +010100 07 XFILE-NAME PIC X(6). DB2024.2 +010200 07 FILLER PIC X(8). DB2024.2 +010300 07 XRECORD-NAME PIC X(6). DB2024.2 +010400 07 FILLER PIC X(1). DB2024.2 +010500 07 REELUNIT-NUMBER PIC 9(1). DB2024.2 +010600 07 FILLER PIC X(7). DB2024.2 +010700 07 XRECORD-NUMBER PIC 9(6). DB2024.2 +010800 07 FILLER PIC X(6). DB2024.2 +010900 07 UPDATE-NUMBER PIC 9(2). DB2024.2 +011000 07 FILLER PIC X(5). DB2024.2 +011100 07 ODO-NUMBER PIC 9(4). DB2024.2 +011200 07 FILLER PIC X(5). DB2024.2 +011300 07 XPROGRAM-NAME PIC X(5). DB2024.2 +011400 07 FILLER PIC X(7). DB2024.2 +011500 07 XRECORD-LENGTH PIC 9(6). DB2024.2 +011600 07 FILLER PIC X(7). DB2024.2 +011700 07 CHARS-OR-RECORDS PIC X(2). DB2024.2 +011800 07 FILLER PIC X(1). DB2024.2 +011900 07 XBLOCK-SIZE PIC 9(4). DB2024.2 +012000 07 FILLER PIC X(6). DB2024.2 +012100 07 RECORDS-IN-FILE PIC 9(6). DB2024.2 +012200 07 FILLER PIC X(5). DB2024.2 +012300 07 XFILE-ORGANIZATION PIC X(2). DB2024.2 +012400 07 FILLER PIC X(6). DB2024.2 +012500 07 XLABEL-TYPE PIC X(1). DB2024.2 +012600 05 FILE-RECORD-INFO-P121-240. DB2024.2 +012700 07 FILLER PIC X(8). DB2024.2 +012800 07 XRECORD-KEY PIC X(29). DB2024.2 +012900 07 FILLER PIC X(9). DB2024.2 +013000 07 ALTERNATE-KEY1 PIC X(29). DB2024.2 +013100 07 FILLER PIC X(9). DB2024.2 +013200 07 ALTERNATE-KEY2 PIC X(29). DB2024.2 +013300 07 FILLER PIC X(7). DB2024.2 +013400 01 TEST-RESULTS. DB2024.2 +013500 02 FILLER PICTURE X VALUE SPACE. DB2024.2 +013600 02 FEATURE PICTURE X(20) VALUE SPACE. DB2024.2 +013700 02 FILLER PICTURE X VALUE SPACE. DB2024.2 +013800 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2024.2 +013900 02 FILLER PICTURE X VALUE SPACE. DB2024.2 +014000 02 PAR-NAME. DB2024.2 +014100 03 FILLER PICTURE X(12) VALUE SPACE. DB2024.2 +014200 03 PARDOT-X PICTURE X VALUE SPACE. DB2024.2 +014300 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2024.2 +014400 03 FILLER PIC X(5) VALUE SPACE. DB2024.2 +014500 02 FILLER PIC X(10) VALUE SPACE. DB2024.2 +014600 02 RE-MARK PIC X(61). DB2024.2 +014700 01 TEST-COMPUTED. DB2024.2 +014800 02 FILLER PIC X(30) VALUE SPACE. DB2024.2 +014900 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2024.2 +015000 02 COMPUTED-X. DB2024.2 +015100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2024.2 +015200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2024.2 +015300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2024.2 +015400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2024.2 +015500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2024.2 +015600 03 CM-18V0 REDEFINES COMPUTED-A. DB2024.2 +015700 04 COMPUTED-18V0 PICTURE -9(18). DB2024.2 +015800 04 FILLER PICTURE X. DB2024.2 +015900 03 FILLER PIC X(50) VALUE SPACE. DB2024.2 +016000 01 TEST-CORRECT. DB2024.2 +016100 02 FILLER PIC X(30) VALUE SPACE. DB2024.2 +016200 02 FILLER PIC X(17) VALUE " CORRECT =". DB2024.2 +016300 02 CORRECT-X. DB2024.2 +016400 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2024.2 +016500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2024.2 +016600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2024.2 +016700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2024.2 +016800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2024.2 +016900 03 CR-18V0 REDEFINES CORRECT-A. DB2024.2 +017000 04 CORRECT-18V0 PICTURE -9(18). DB2024.2 +017100 04 FILLER PICTURE X. DB2024.2 +017200 03 FILLER PIC X(50) VALUE SPACE. DB2024.2 +017300 01 CCVS-C-1. DB2024.2 +017400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2024.2 +017500- "SS PARAGRAPH-NAME DB2024.2 +017600- " REMARKS". DB2024.2 +017700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2024.2 +017800 01 CCVS-C-2. DB2024.2 +017900 02 FILLER PICTURE IS X VALUE IS SPACE. DB2024.2 +018000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2024.2 +018100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2024.2 +018200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2024.2 +018300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2024.2 +018400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2024.2 +018500 01 REC-CT PICTURE 99 VALUE ZERO. DB2024.2 +018600 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2024.2 +018700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2024.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2024.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2024.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2024.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2024.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2024.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2024.2 +019400 01 CCVS-H-1. DB2024.2 +019500 02 FILLER PICTURE X(27) VALUE SPACE. DB2024.2 +019600 02 FILLER PICTURE X(67) VALUE DB2024.2 +019700 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2024.2 +019800- " SYSTEM". DB2024.2 +019900 02 FILLER PICTURE X(26) VALUE SPACE. DB2024.2 +020000 01 CCVS-H-2. DB2024.2 +020100 02 FILLER PICTURE X(52) VALUE IS DB2024.2 +020200 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2024.2 +020300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2024.2 +020400 02 TEST-ID PICTURE IS X(9). DB2024.2 +020500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2024.2 +020600 01 CCVS-H-3. DB2024.2 +020700 02 FILLER PICTURE X(34) VALUE DB2024.2 +020800 " FOR OFFICIAL USE ONLY ". DB2024.2 +020900 02 FILLER PICTURE X(58) VALUE DB2024.2 +021000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2024.2 +021100 02 FILLER PICTURE X(28) VALUE DB2024.2 +021200 " COPYRIGHT 1974 ". DB2024.2 +021300 01 CCVS-E-1. DB2024.2 +021400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2024.2 +021500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2024.2 +021600 02 ID-AGAIN PICTURE IS X(9). DB2024.2 +021700 02 FILLER PICTURE X(45) VALUE IS DB2024.2 +021800 " NTIS DISTRIBUTION COBOL 74". DB2024.2 +021900 01 CCVS-E-2. DB2024.2 +022000 02 FILLER PICTURE X(31) VALUE DB2024.2 +022100 SPACE. DB2024.2 +022200 02 FILLER PICTURE X(21) VALUE SPACE. DB2024.2 +022300 02 CCVS-E-2-2. DB2024.2 +022400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2024.2 +022500 03 FILLER PICTURE IS X VALUE IS SPACE. DB2024.2 +022600 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2024.2 +022700 01 CCVS-E-3. DB2024.2 +022800 02 FILLER PICTURE X(22) VALUE DB2024.2 +022900 " FOR OFFICIAL USE ONLY". DB2024.2 +023000 02 FILLER PICTURE X(12) VALUE SPACE. DB2024.2 +023100 02 FILLER PICTURE X(58) VALUE DB2024.2 +023200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2024.2 +023300 02 FILLER PICTURE X(13) VALUE SPACE. DB2024.2 +023400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2024.2 +023500 01 CCVS-E-4. DB2024.2 +023600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2024.2 +023700 02 FILLER PIC XXXX VALUE " OF ". DB2024.2 +023800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2024.2 +023900 02 FILLER PIC X(40) VALUE DB2024.2 +024000 " TESTS WERE EXECUTED SUCCESSFULLY". DB2024.2 +024100 01 XXINFO. DB2024.2 +024200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2024.2 +024300 02 INFO-TEXT. DB2024.2 +024400 04 FILLER PIC X(20) VALUE SPACE. DB2024.2 +024500 04 XXCOMPUTED PIC X(20). DB2024.2 +024600 04 FILLER PIC X(5) VALUE SPACE. DB2024.2 +024700 04 XXCORRECT PIC X(20). DB2024.2 +024800 01 HYPHEN-LINE. DB2024.2 +024900 02 FILLER PICTURE IS X VALUE IS SPACE. DB2024.2 +025000 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2024.2 +025100- "*****************************************". DB2024.2 +025200 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2024.2 +025300- "******************************". DB2024.2 +025400 01 CCVS-PGM-ID PIC X(6) VALUE DB2024.2 +025500 "DB202A". DB2024.2 +025600 PROCEDURE DIVISION. DB2024.2 +025700 DECLARATIVES. DB2024.2 +025800 FILENAME-PROC SECTION. DB2024.2 +025900 USE FOR DEBUGGING ON SEQ-FILE. DB2024.2 +026000 FILENAME-1. DB2024.2 +026100 MOVE 1 TO KEY-1. DB2024.2 +026200 DB-COMMON. DB2024.2 +026300 MOVE DEBUG-LINE TO LINE-1. DB2024.2 +026400 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2024.2 +026500 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2024.2 +026600 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS BY SPACES DB2024.2 +026700 AFTER INITIAL SPACE. DB2024.2 +026800 WRITE-PROC SECTION. DB2024.2 +026900 USE FOR DEBUGGING ON ALL REFERENCES OF SEQ-REC-1 SEQ-REC-2. DB2024.2 +027000 WRITE-1. DB2024.2 +027100 ADD 1 TO KEY-1. DB2024.2 +027200 PERFORM DB-COMMON. DB2024.2 +027300 MOVE SEQ-REC-3 TO CONTENTS-REC. DB2024.2 +027400 END DECLARATIVES. DB2024.2 +027500 CCVS1 SECTION. DB2024.2 +027600 OPEN-FILES. DB2024.2 +027700 OPEN OUTPUT PRINT-FILE. DB2024.2 +027800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2024.2 +027900 MOVE SPACE TO TEST-RESULTS. DB2024.2 +028000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2024.2 +028100 GO TO CCVS1-EXIT. DB2024.2 +028200 CLOSE-FILES. DB2024.2 +028300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2024.2 +028400 TERMINATE-CCVS. DB2024.2 +028500S EXIT PROGRAM. DB2024.2 +028600STERMINATE-CALL. DB2024.2 +028700 STOP RUN. DB2024.2 +028800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2024.2 +028900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2024.2 +029000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2024.2 +029100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2024.2 +029200 MOVE "****TEST DELETED****" TO RE-MARK. DB2024.2 +029300 PRINT-DETAIL. DB2024.2 +029400 IF REC-CT NOT EQUAL TO ZERO DB2024.2 +029500 MOVE "." TO PARDOT-X DB2024.2 +029600 MOVE REC-CT TO DOTVALUE. DB2024.2 +029700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2024.2 +029800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2024.2 +029900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2024.2 +030000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2024.2 +030100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2024.2 +030200 MOVE SPACE TO CORRECT-X. DB2024.2 +030300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2024.2 +030400 MOVE SPACE TO RE-MARK. DB2024.2 +030500 HEAD-ROUTINE. DB2024.2 +030600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2024.2 +030700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2024.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2024.2 +030900 COLUMN-NAMES-ROUTINE. DB2024.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2024.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2024.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2024.2 +031300 END-ROUTINE. DB2024.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2024.2 +031500 END-RTN-EXIT. DB2024.2 +031600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2024.2 +031700 END-ROUTINE-1. DB2024.2 +031800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2024.2 +031900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2024.2 +032000 ADD PASS-COUNTER TO ERROR-HOLD. DB2024.2 +032100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2024.2 +032200 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2024.2 +032300 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2024.2 +032400 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2024.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2024.2 +032600 END-ROUTINE-12. DB2024.2 +032700 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2024.2 +032800 IF ERROR-COUNTER IS EQUAL TO ZERO DB2024.2 +032900 MOVE "NO " TO ERROR-TOTAL DB2024.2 +033000 ELSE DB2024.2 +033100 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2024.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2024.2 +033300 PERFORM WRITE-LINE. DB2024.2 +033400 END-ROUTINE-13. DB2024.2 +033500 IF DELETE-CNT IS EQUAL TO ZERO DB2024.2 +033600 MOVE "NO " TO ERROR-TOTAL ELSE DB2024.2 +033700 MOVE DELETE-CNT TO ERROR-TOTAL. DB2024.2 +033800 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2024.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2024.2 +034000 IF INSPECT-COUNTER EQUAL TO ZERO DB2024.2 +034100 MOVE "NO " TO ERROR-TOTAL DB2024.2 +034200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2024.2 +034300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2024.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2024.2 +034500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2024.2 +034600 WRITE-LINE. DB2024.2 +034700 ADD 1 TO RECORD-COUNT. DB2024.2 +034800Y IF RECORD-COUNT GREATER 50 DB2024.2 +034900Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB2024.2 +035000Y MOVE SPACE TO DUMMY-RECORD DB2024.2 +035100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2024.2 +035200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2024.2 +035300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2024.2 +035400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2024.2 +035500Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB2024.2 +035600Y MOVE ZERO TO RECORD-COUNT. DB2024.2 +035700 PERFORM WRT-LN. DB2024.2 +035800 WRT-LN. DB2024.2 +035900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2024.2 +036000 MOVE SPACE TO DUMMY-RECORD. DB2024.2 +036100 BLANK-LINE-PRINT. DB2024.2 +036200 PERFORM WRT-LN. DB2024.2 +036300 FAIL-ROUTINE. DB2024.2 +036400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2024.2 +036500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2024.2 +036600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2024.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2024.2 +036800 GO TO FAIL-ROUTINE-EX. DB2024.2 +036900 FAIL-ROUTINE-WRITE. DB2024.2 +037000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2024.2 +037100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2024.2 +037200 FAIL-ROUTINE-EX. EXIT. DB2024.2 +037300 BAIL-OUT. DB2024.2 +037400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2024.2 +037500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2024.2 +037600 BAIL-OUT-WRITE. DB2024.2 +037700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2024.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2024.2 +037900 BAIL-OUT-EX. EXIT. DB2024.2 +038000 CCVS1-EXIT. DB2024.2 +038100 EXIT. DB2024.2 +038200 BEGIN-DB202A-TEST SECTION. DB2024.2 +038300 OPEN-TEST-1-INIT. DB2024.2 +038400 MOVE SPACES TO ITEM-1. DB2024.2 +038500 MOVE 0 TO KEY-1. DB2024.2 +038600 MOVE "OPEN-TEST-1" TO PAR-NAME. DB2024.2 +038700 MOVE "DEBUG OPEN FILENAME" TO FEATURE. DB2024.2 +038800******************************************************************DB2024.2 +038900* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2024.2 +039000* "OPEN-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2024.2 +039100* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "OPEN *DB2024.2 +039200* OUTPUT SEQ-FILE.". *DB2024.2 +039300******************************************************************DB2024.2 +039400 OPEN-TEST-1. DB2024.2 +039500 OPEN OUTPUT SEQ-FILE. DB2024.2 +039600 IF KEY-1 IS EQUAL TO 1 DB2024.2 +039700 PERFORM PASS DB2024.2 +039800 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +039900 PERFORM GEN-WRITE DB2024.2 +040000 GO TO OPEN-TEST-1A DB2024.2 +040100 ELSE PERFORM FAIL DB2024.2 +040200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2024.2 +040300 PERFORM GEN-WRITE DB2024.2 +040400 PERFORM DELETE-OPEN-TEST-1-SUBTESTS DB2024.2 +040500 GO TO WRITE-TEST-1-INIT. DB2024.2 +040600 OPEN-TEST-1-DELETE. DB2024.2 +040700 PERFORM DE-LETE. DB2024.2 +040800 PERFORM GEN-WRITE. DB2024.2 +040900 PERFORM DELETE-OPEN-TEST-1-SUBTESTS. DB2024.2 +041000 GO TO WRITE-TEST-1-INIT. DB2024.2 +041100 DELETE-OPEN-TEST-1-SUBTESTS. DB2024.2 +041200 MOVE "OPEN-TEST-1A" TO PAR-NAME. DB2024.2 +041300 PERFORM DE-LETE. DB2024.2 +041400 PERFORM GEN-WRITE. DB2024.2 +041500 MOVE "OPEN-TEST-1B" TO PAR-NAME. DB2024.2 +041600 PERFORM DE-LETE. DB2024.2 +041700 PERFORM GEN-WRITE. DB2024.2 +041800 MOVE "OPEN-TEST-1C" TO PAR-NAME. DB2024.2 +041900 PERFORM DE-LETE. DB2024.2 +042000 PERFORM GEN-WRITE. DB2024.2 +042100 OPEN-TEST-1A. DB2024.2 +042200 MOVE "OPEN-TEST-1A" TO PAR-NAME. DB2024.2 +042300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2024.2 +042400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2024.2 +042500 MOVE LINE-1 TO COMPUTED-A. DB2024.2 +042600 PERFORM INSPT. DB2024.2 +042700 PERFORM GEN-WRITE. DB2024.2 +042800 OPEN-TEST-1B. DB2024.2 +042900 MOVE "OPEN-TEST-1B" TO PAR-NAME. DB2024.2 +043000 IF UNQUAL-NAME-1 IS EQUAL TO "SEQ-FILE" DB2024.2 +043100 PERFORM PASS DB2024.2 +043200 ELSE PERFORM FAIL DB2024.2 +043300 MOVE NAME-1 TO COMPUTED-A DB2024.2 +043400 MOVE "SEQ-FILE" TO CORRECT-A. DB2024.2 +043500 MOVE "DEBUG-NAME" TO RE-MARK. DB2024.2 +043600 PERFORM GEN-WRITE. DB2024.2 +043700 OPEN-TEST-1C. DB2024.2 +043800 MOVE "OPEN-TEST-1C" TO PAR-NAME. DB2024.2 +043900 IF CONTENTS-1 IS EQUAL TO SPACES DB2024.2 +044000 PERFORM PASS DB2024.2 +044100 ELSE PERFORM FAIL DB2024.2 +044200 MOVE CONTENTS-1 TO COMPUTED-A DB2024.2 +044300 MOVE "(SPACES)" TO CORRECT-A. DB2024.2 +044400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2024.2 +044500 PERFORM GEN-WRITE. DB2024.2 +044600 WRITE-TEST-1-INIT. DB2024.2 +044700 MOVE "WRITE-TEST-1" TO PAR-NAME. DB2024.2 +044800 MOVE SPACES TO ITEM-1. DB2024.2 +044900 MOVE 0 TO KEY-1. DB2024.2 +045000 MOVE "DEBUG WRITE/ALL REF" TO FEATURE. DB2024.2 +045100 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). DB2024.2 +045200 MOVE "SEQ-FI" TO XFILE-NAME (1). DB2024.2 +045300 MOVE "REC-1" TO XRECORD-NAME (1). DB2024.2 +045400 MOVE ".XXX." TO XPROGRAM-NAME (1). DB2024.2 +045500 MOVE 120 TO XRECORD-LENGTH (1). DB2024.2 +045600 MOVE "RC" TO CHARS-OR-RECORDS (1). DB2024.2 +045700 MOVE 1 TO XBLOCK-SIZE (1). DB2024.2 +045800 MOVE 30 TO RECORDS-IN-FILE (1). DB2024.2 +045900 MOVE "SQ" TO XFILE-ORGANIZATION (1). DB2024.2 +046000 MOVE "S" TO XLABEL-TYPE (1). DB2024.2 +046100 WRITE-TEST-1. DB2024.2 +046200 PERFORM WRITE-REC-1 10 TIMES. DB2024.2 +046300 IF KEY-1 IS EQUAL TO 10 DB2024.2 +046400 PERFORM PASS DB2024.2 +046500 MOVE "DEBUG PROC EXECUTED 10 TIMES" TO RE-MARK DB2024.2 +046600 ELSE PERFORM FAIL DB2024.2 +046700 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +046800 MOVE KEY-1 TO COMPUTED-18V0 DB2024.2 +046900 MOVE 10 TO CORRECT-18V0. DB2024.2 +047000 PERFORM GEN-WRITE. DB2024.2 +047100 IF KEY-1 IS EQUAL TO 0 DB2024.2 +047200 PERFORM DELETE-WRITE-TEST-1-SUBTESTS DB2024.2 +047300 GO TO WRITE-TEST-2-INIT DB2024.2 +047400 ELSE GO TO WRITE-TEST-1A. DB2024.2 +047500 WRITE-TEST-1-DELETE. DB2024.2 +047600 PERFORM DE-LETE. DB2024.2 +047700 PERFORM GEN-WRITE. DB2024.2 +047800 PERFORM DELETE-WRITE-TEST-1-SUBTESTS DB2024.2 +047900 GO TO WRITE-TEST-2-INIT. DB2024.2 +048000 DELETE-WRITE-TEST-1-SUBTESTS. DB2024.2 +048100 MOVE "WRITE-TEST-1A" TO PAR-NAME. DB2024.2 +048200 PERFORM DE-LETE. DB2024.2 +048300 PERFORM GEN-WRITE. DB2024.2 +048400 MOVE "WRITE-TEST-1B" TO PAR-NAME. DB2024.2 +048500 PERFORM DE-LETE. DB2024.2 +048600 PERFORM GEN-WRITE. DB2024.2 +048700 MOVE "WRITE-TEST-1C" TO PAR-NAME. DB2024.2 +048800 PERFORM DE-LETE. DB2024.2 +048900 PERFORM GEN-WRITE. DB2024.2 +049000 MOVE "WRITE-TEST-1D" TO PAR-NAME. DB2024.2 +049100 PERFORM DE-LETE. DB2024.2 +049200 PERFORM GEN-WRITE. DB2024.2 +049300 WRITE-REC-1. DB2024.2 +049400 MOVE SPACES TO SEQ-REC-3. DB2024.2 +049500 ADD 1 TO XRECORD-NUMBER (1). DB2024.2 +049600******************************************************************DB2024.2 +049700* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2024.2 +049800* "WRITE-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2024.2 +049900* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2024.2 +050000* "WRITE SEQ-REC-1 FROM FILE-RECORD-INFO-P1-120 (1).". *DB2024.2 +050100******************************************************************DB2024.2 +050200 WRITE SEQ-REC-1 FROM FILE-RECORD-INFO-P1-120 (1). DB2024.2 +050300 WRITE-TEST-1A. DB2024.2 +050400 MOVE "WRITE-TEST-1A" TO PAR-NAME. DB2024.2 +050500 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2024.2 +050600 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2024.2 +050700 MOVE LINE-1 TO COMPUTED-A. DB2024.2 +050800 PERFORM INSPT. DB2024.2 +050900 PERFORM GEN-WRITE. DB2024.2 +051000 WRITE-TEST-1B. DB2024.2 +051100 MOVE "WRITE-TEST-1B" TO PAR-NAME. DB2024.2 +051200 IF UNQUAL-NAME-1 IS EQUAL TO "SEQ-REC-1" DB2024.2 +051300 PERFORM PASS DB2024.2 +051400 ELSE PERFORM FAIL DB2024.2 +051500 MOVE "SEQ-REC-1" TO CORRECT-A DB2024.2 +051600 MOVE NAME-1 TO COMPUTED-A. DB2024.2 +051700 MOVE "DEBUG-NAME" TO RE-MARK. DB2024.2 +051800 PERFORM GEN-WRITE. DB2024.2 +051900 WRITE-TEST-1C. DB2024.2 +052000 MOVE "WRITE-TEST-1C" TO PAR-NAME. DB2024.2 +052100 IF CONTENTS-REC IS EQUAL TO FILE-RECORD-INFO-P1-120 (1) DB2024.2 +052200 PERFORM PASS DB2024.2 +052300 MOVE "PROC EXECUTED AT PROPER TIME" TO RE-MARK DB2024.2 +052400 PERFORM GEN-WRITE DB2024.2 +052500 GO TO WRITE-TEST-1D DB2024.2 +052600 ELSE PERFORM FAIL DB2024.2 +052700 MOVE "PROC NOT EXEC BETW MOVE / WRITE" TO RE-MARK DB2024.2 +052800 MOVE "1ST LINE = REC AREA" TO COMPUTED-A DB2024.2 +052900 MOVE "2ND LINE = FROM FLD" TO CORRECT-A DB2024.2 +053000 PERFORM GEN-WRITE. DB2024.2 +053100 MOVE CONTENTS-REC TO PRINT-REC. DB2024.2 +053200 PERFORM WRITE-LINE. DB2024.2 +053300 MOVE FILE-RECORD-INFO-P1-120 (1) TO PRINT-REC. DB2024.2 +053400 PERFORM WRITE-LINE. DB2024.2 +053500 WRITE-TEST-1D. DB2024.2 +053600 MOVE "WRITE-TEST-1D" TO PAR-NAME. DB2024.2 +053700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2024.2 +053800 IF CONTENTS-1 IS EQUAL TO FILE-RECORD-INFO-P1-120 (1) DB2024.2 +053900 PERFORM PASS DB2024.2 +054000 PERFORM GEN-WRITE DB2024.2 +054100 GO TO WRITE-TEST-2-INIT DB2024.2 +054200 ELSE PERFORM FAIL DB2024.2 +054300 MOVE "SEE 1ST LINE FOLLOW" TO COMPUTED-A DB2024.2 +054400 MOVE "SEE 2ND LINE FOLLOW" TO CORRECT-A DB2024.2 +054500 PERFORM GEN-WRITE. DB2024.2 +054600 MOVE CONTENTS-1 TO PRINT-REC. DB2024.2 +054700 PERFORM WRITE-LINE. DB2024.2 +054800 MOVE FILE-RECORD-INFO-P1-120 (1) TO PRINT-REC. DB2024.2 +054900 PERFORM WRITE-LINE. DB2024.2 +055000 WRITE-TEST-2-INIT. DB2024.2 +055100 MOVE "WRITE-TEST-2" TO PAR-NAME. DB2024.2 +055200 MOVE SPACES TO ITEM-1. DB2024.2 +055300 MOVE 0 TO KEY-1. DB2024.2 +055400 MOVE "DEBUG WRITE/NOT ALL" TO FEATURE. DB2024.2 +055500 MOVE 10 TO XRECORD-NUMBER (1). DB2024.2 +055600 MOVE "REC-2" TO XRECORD-NAME (1). DB2024.2 +055700 WRITE-TEST-2. DB2024.2 +055800 PERFORM WRITE-REC-2 10 TIMES. DB2024.2 +055900 IF KEY-1 IS EQUAL TO 10 DB2024.2 +056000 PERFORM PASS DB2024.2 +056100 MOVE "DEBUG PROC EXECUTED 10 TIMES" TO RE-MARK DB2024.2 +056200 ELSE PERFORM FAIL DB2024.2 +056300 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +056400 MOVE KEY-1 TO COMPUTED-18V0 DB2024.2 +056500 MOVE 10 TO CORRECT-18V0. DB2024.2 +056600 PERFORM GEN-WRITE. DB2024.2 +056700 IF KEY-1 IS EQUAL TO 0 DB2024.2 +056800 PERFORM DELETE-WRITE-TEST-2-SUBTESTS DB2024.2 +056900 GO TO WRITE-TEST-3-INIT DB2024.2 +057000 ELSE GO TO WRITE-TEST-2A. DB2024.2 +057100 WRITE-TEST-2-DELETE. DB2024.2 +057200 PERFORM DE-LETE. DB2024.2 +057300 PERFORM GEN-WRITE. DB2024.2 +057400 PERFORM DELETE-WRITE-TEST-2-SUBTESTS DB2024.2 +057500 GO TO WRITE-TEST-3-INIT. DB2024.2 +057600 DELETE-WRITE-TEST-2-SUBTESTS. DB2024.2 +057700 MOVE "WRITE-TEST-2A" TO PAR-NAME. DB2024.2 +057800 PERFORM DE-LETE. DB2024.2 +057900 PERFORM GEN-WRITE. DB2024.2 +058000 MOVE "WRITE-TEST-2B" TO PAR-NAME. DB2024.2 +058100 PERFORM DE-LETE. DB2024.2 +058200 PERFORM GEN-WRITE. DB2024.2 +058300 MOVE "WRITE-TEST-2C" TO PAR-NAME. DB2024.2 +058400 PERFORM DE-LETE. DB2024.2 +058500 PERFORM GEN-WRITE. DB2024.2 +058600 WRITE-REC-2. DB2024.2 +058700 MOVE SPACES TO SEQ-REC-3. DB2024.2 +058800 ADD 1 TO XRECORD-NUMBER (1). DB2024.2 +058900 WRITE SEQ-REC-2 FROM FILE-RECORD-INFO-P1-120 (1). DB2024.2 +059000 WRITE-TEST-2A. DB2024.2 +059100 MOVE "WRITE-TEST-2A" TO PAR-NAME. DB2024.2 +059200 IF UNQUAL-NAME-1 IS EQUAL TO "SEQ-REC-2" DB2024.2 +059300 PERFORM PASS DB2024.2 +059400 ELSE PERFORM FAIL DB2024.2 +059500 MOVE "SEQ-REC-2" TO CORRECT-A DB2024.2 +059600 MOVE NAME-1 TO COMPUTED-A. DB2024.2 +059700 MOVE "DEBUG-NAME" TO RE-MARK. DB2024.2 +059800 PERFORM GEN-WRITE. DB2024.2 +059900 WRITE-TEST-2B. DB2024.2 +060000 MOVE "WRITE-TEST-2B" TO PAR-NAME. DB2024.2 +060100 IF CONTENTS-REC IS EQUAL TO FILE-RECORD-INFO-P1-120 (1) DB2024.2 +060200 PERFORM PASS DB2024.2 +060300 MOVE "PROC EXECUTED AT PROPER TIME" TO RE-MARK DB2024.2 +060400 PERFORM GEN-WRITE DB2024.2 +060500 GO TO WRITE-TEST-2C DB2024.2 +060600 ELSE PERFORM FAIL DB2024.2 +060700 MOVE "PROC NOT EXEC BTWN MOVE / WRITE" TO RE-MARK DB2024.2 +060800 MOVE "1ST LINE = REC AREA" TO COMPUTED-A DB2024.2 +060900 MOVE "2ND LINE = FROM FLD" TO CORRECT-A DB2024.2 +061000 PERFORM GEN-WRITE. DB2024.2 +061100 MOVE CONTENTS-REC TO PRINT-REC. DB2024.2 +061200 PERFORM WRITE-LINE. DB2024.2 +061300 MOVE FILE-RECORD-INFO-P1-120 (1) TO PRINT-REC. DB2024.2 +061400 PERFORM WRITE-LINE. DB2024.2 +061500 WRITE-TEST-2C. DB2024.2 +061600 MOVE "WRITE-TEST-2C" TO PAR-NAME. DB2024.2 +061700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2024.2 +061800 IF CONTENTS-1 IS EQUAL TO FILE-RECORD-INFO-P1-120 (1) DB2024.2 +061900 PERFORM PASS DB2024.2 +062000 PERFORM GEN-WRITE DB2024.2 +062100 GO TO WRITE-TEST-3-INIT DB2024.2 +062200 ELSE PERFORM FAIL DB2024.2 +062300 MOVE "SEE 1ST LINE FOLLOW" TO COMPUTED-A DB2024.2 +062400 MOVE "SEE 2ND LINE FOLLOW" TO CORRECT-A DB2024.2 +062500 PERFORM GEN-WRITE. DB2024.2 +062600 MOVE CONTENTS-1 TO PRINT-REC. DB2024.2 +062700 PERFORM WRITE-LINE. DB2024.2 +062800 MOVE FILE-RECORD-INFO-P1-120 (1) TO PRINT-REC. DB2024.2 +062900 PERFORM WRITE-LINE. DB2024.2 +063000 WRITE-TEST-3-INIT. DB2024.2 +063100 MOVE SPACES TO ITEM-1 DB2024.2 +063200 MOVE 0 TO KEY-1 DB2024.2 +063300 MOVE "WRITE/NO DEBUG PROC" TO FEATURE. DB2024.2 +063400 MOVE "WRITE-TEST-3" TO PAR-NAME. DB2024.2 +063500 MOVE "REC-3" TO XRECORD-NAME (1) DB2024.2 +063600 MOVE 20 TO XRECORD-NUMBER (1). DB2024.2 +063700 WRITE-TEST-3. DB2024.2 +063800 PERFORM WRITE-REC-3 10 TIMES. DB2024.2 +063900 IF KEY-1 IS EQUAL TO 0 DB2024.2 +064000 PERFORM PASS DB2024.2 +064100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2024.2 +064200 ELSE PERFORM FAIL DB2024.2 +064300 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +064400 MOVE KEY-1 TO COMPUTED-18V0 DB2024.2 +064500 MOVE 0 TO CORRECT-18V0. DB2024.2 +064600 PERFORM GEN-WRITE. DB2024.2 +064700 GO TO CLOSE-TEST-1-INIT. DB2024.2 +064800 WRITE-TEST-3-DELETE. DB2024.2 +064900 PERFORM DE-LETE. DB2024.2 +065000 PERFORM GEN-WRITE. DB2024.2 +065100 GO TO CLOSE-TEST-1-INIT. DB2024.2 +065200 WRITE-REC-3. DB2024.2 +065300 MOVE SPACES TO SEQ-REC-3. DB2024.2 +065400 ADD 1 TO XRECORD-NUMBER (1). DB2024.2 +065500 WRITE SEQ-REC-3 FROM FILE-RECORD-INFO-P1-120 (1). DB2024.2 +065600 CLOSE-TEST-1-INIT. DB2024.2 +065700 MOVE SPACES TO ITEM-1. DB2024.2 +065800 MOVE 0 TO KEY-1. DB2024.2 +065900 MOVE "CLOSE-TEST-1" TO PAR-NAME. DB2024.2 +066000 MOVE "DEBUG CLOSE FILENAME" TO FEATURE. DB2024.2 +066100******************************************************************DB2024.2 +066200* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2024.2 +066300* "CLOSE-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2024.2 +066400* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2024.2 +066500* "CLOSE SEQ-FILE.". *DB2024.2 +066600******************************************************************DB2024.2 +066700 CLOSE-TEST-1. DB2024.2 +066800 CLOSE SEQ-FILE. DB2024.2 +066900 IF KEY-1 IS EQUAL TO 1 DB2024.2 +067000 PERFORM PASS DB2024.2 +067100 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +067200 PERFORM GEN-WRITE DB2024.2 +067300 GO TO CLOSE-TEST-1A DB2024.2 +067400 ELSE PERFORM FAIL DB2024.2 +067500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2024.2 +067600 PERFORM GEN-WRITE DB2024.2 +067700 PERFORM DELETE-CLOSE-TEST-1-SUBTESTS DB2024.2 +067800 GO TO OPEN-TEST-2-INIT. DB2024.2 +067900 CLOSE-TEST-1-DELETE. DB2024.2 +068000 PERFORM DE-LETE. DB2024.2 +068100 PERFORM GEN-WRITE. DB2024.2 +068200 PERFORM DELETE-CLOSE-TEST-1-SUBTESTS. DB2024.2 +068300 GO TO OPEN-TEST-2-INIT. DB2024.2 +068400 DELETE-CLOSE-TEST-1-SUBTESTS. DB2024.2 +068500 MOVE "CLOSE-TEST-1A" TO PAR-NAME. DB2024.2 +068600 PERFORM DE-LETE. DB2024.2 +068700 PERFORM GEN-WRITE. DB2024.2 +068800 MOVE "CLOSE-TEST-1B" TO PAR-NAME. DB2024.2 +068900 PERFORM DE-LETE. DB2024.2 +069000 PERFORM GEN-WRITE. DB2024.2 +069100 MOVE "CLOSE-TEST-1C" TO PAR-NAME. DB2024.2 +069200 PERFORM DE-LETE. DB2024.2 +069300 PERFORM GEN-WRITE. DB2024.2 +069400 CLOSE-TEST-1A. DB2024.2 +069500 MOVE "CLOSE-TEST-1A" TO PAR-NAME. DB2024.2 +069600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2024.2 +069700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2024.2 +069800 MOVE LINE-1 TO COMPUTED-A. DB2024.2 +069900 PERFORM INSPT. DB2024.2 +070000 PERFORM GEN-WRITE. DB2024.2 +070100 CLOSE-TEST-1B. DB2024.2 +070200 MOVE "CLOSE-TEST-1B" TO PAR-NAME. DB2024.2 +070300 IF UNQUAL-NAME-1 IS EQUAL TO "SEQ-FILE" DB2024.2 +070400 PERFORM PASS DB2024.2 +070500 ELSE PERFORM FAIL DB2024.2 +070600 MOVE NAME-1 TO COMPUTED-A DB2024.2 +070700 MOVE "SEQ-FILE" TO CORRECT-A. DB2024.2 +070800 MOVE "DEBUG-NAME" TO RE-MARK. DB2024.2 +070900 PERFORM GEN-WRITE. DB2024.2 +071000 CLOSE-TEST-1C. DB2024.2 +071100 MOVE "OPEN-TEST-1C" TO PAR-NAME. DB2024.2 +071200 IF CONTENTS-1 IS EQUAL TO SPACES DB2024.2 +071300 PERFORM PASS DB2024.2 +071400 ELSE PERFORM FAIL DB2024.2 +071500 MOVE CONTENTS-1 TO COMPUTED-A DB2024.2 +071600 MOVE "(SPACES)" TO CORRECT-A. DB2024.2 +071700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2024.2 +071800 PERFORM GEN-WRITE. DB2024.2 +071900 OPEN-TEST-2-INIT. DB2024.2 +072000 MOVE SPACES TO ITEM-1. DB2024.2 +072100 MOVE 0 TO KEY-1. DB2024.2 +072200 MOVE "OPEN-TEST-2" TO PAR-NAME. DB2024.2 +072300 MOVE "DEBUG OPEN FILENAME" TO FEATURE. DB2024.2 +072400 OPEN-TEST-2. DB2024.2 +072500 OPEN INPUT SEQ-FILE. DB2024.2 +072600 IF KEY-1 IS EQUAL TO 1 DB2024.2 +072700 PERFORM PASS DB2024.2 +072800 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +072900 ELSE PERFORM FAIL DB2024.2 +073000 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2024.2 +073100 PERFORM GEN-WRITE. DB2024.2 +073200 GO TO READ-TEST-1-INIT. DB2024.2 +073300 OPEN-TEST-2-DELETE. DB2024.2 +073400 PERFORM DE-LETE. DB2024.2 +073500 PERFORM GEN-WRITE. DB2024.2 +073600 READ-TEST-1-INIT. DB2024.2 +073700 MOVE SPACES TO ITEM-1. DB2024.2 +073800 MOVE 0 TO KEY-1. DB2024.2 +073900 MOVE "READ-TEST-1" TO PAR-NAME. DB2024.2 +074000 MOVE "DEBUG READ FILENAME" TO FEATURE. DB2024.2 +074100******************************************************************DB2024.2 +074200* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2024.2 +074300* "READ-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2024.2 +074400* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "READ *DB2024.2 +074500* SEQ-FILE AT END PERFORM READ-TEST-1-DELETE GO TO *DB2024.2 +074600* READ-TEST-2.". *DB2024.2 +074700******************************************************************DB2024.2 +074800 READ-TEST-1. DB2024.2 +074900 READ SEQ-FILE AT END DB2024.2 +075000 PERFORM READ-TEST-1-DELETE DB2024.2 +075100 GO TO READ-TEST-2. DB2024.2 +075200 IF KEY-1 IS EQUAL TO 1 DB2024.2 +075300 PERFORM PASS DB2024.2 +075400 MOVE "DEBUG PROC EXECUTED" TO RE-MARK DB2024.2 +075500 PERFORM GEN-WRITE DB2024.2 +075600 GO TO READ-TEST-1A DB2024.2 +075700 ELSE PERFORM FAIL DB2024.2 +075800 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2024.2 +075900 PERFORM GEN-WRITE DB2024.2 +076000 PERFORM DELETE-READ-TEST-1-SUBTESTS DB2024.2 +076100 GO TO READ-TEST-2-INIT. DB2024.2 +076200 READ-TEST-1-DELETE. DB2024.2 +076300 PERFORM DE-LETE. DB2024.2 +076400 PERFORM GEN-WRITE. DB2024.2 +076500 PERFORM DELETE-READ-TEST-1-SUBTESTS. DB2024.2 +076600 READ-TEST-1-DELETE-A. DB2024.2 +076700 GO TO READ-TEST-2-DELETE. DB2024.2 +076800 DELETE-READ-TEST-1-SUBTESTS. DB2024.2 +076900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2024.2 +077000 PERFORM DE-LETE. DB2024.2 +077100 PERFORM GEN-WRITE. DB2024.2 +077200 MOVE "READ-TEST-1B" TO PAR-NAME. DB2024.2 +077300 PERFORM DE-LETE. DB2024.2 +077400 PERFORM GEN-WRITE. DB2024.2 +077500 MOVE "READ-TEST-1C" TO PAR-NAME. DB2024.2 +077600 PERFORM DE-LETE. DB2024.2 +077700 PERFORM GEN-WRITE. DB2024.2 +077800 READ-TEST-1A. DB2024.2 +077900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2024.2 +078000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2024.2 +078100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2024.2 +078200 MOVE LINE-1 TO COMPUTED-A. DB2024.2 +078300 PERFORM INSPT. DB2024.2 +078400 PERFORM GEN-WRITE. DB2024.2 +078500 READ-TEST-1B. DB2024.2 +078600 MOVE "READ-TEST-1B" TO PAR-NAME. DB2024.2 +078700 IF UNQUAL-NAME-1 IS EQUAL TO "SEQ-FILE" DB2024.2 +078800 PERFORM PASS DB2024.2 +078900 ELSE PERFORM FAIL DB2024.2 +079000 MOVE "SEQ-FILE" TO CORRECT-A DB2024.2 +079100 MOVE NAME-1 TO COMPUTED-A. DB2024.2 +079200 MOVE "DEBUG-NAME" TO RE-MARK. DB2024.2 +079300 PERFORM GEN-WRITE. DB2024.2 +079400 READ-TEST-1C. DB2024.2 +079500 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2024.2 +079600 MOVE "READ-TEST-1C" TO PAR-NAME. DB2024.2 +079700 IF CONTENTS-1 IS EQUAL TO SEQ-REC-3 DB2024.2 +079800 PERFORM PASS DB2024.2 +079900 PERFORM GEN-WRITE DB2024.2 +080000 GO TO READ-TEST-2-INIT DB2024.2 +080100 ELSE PERFORM FAIL DB2024.2 +080200 MOVE "SEE 1ST LINE FOLLOW" TO COMPUTED-A DB2024.2 +080300 MOVE "SEE 2ND LINE FOLLOW" TO CORRECT-A DB2024.2 +080400 PERFORM GEN-WRITE. DB2024.2 +080500 MOVE CONTENTS-1 TO PRINT-REC. DB2024.2 +080600 PERFORM WRITE-LINE. DB2024.2 +080700 MOVE SEQ-REC-3 TO PRINT-REC. DB2024.2 +080800 PERFORM WRITE-LINE. DB2024.2 +080900 READ-TEST-2-INIT. DB2024.2 +081000 MOVE SPACES TO ITEM-1. DB2024.2 +081100 MOVE 0 TO KEY-1. DB2024.2 +081200 READ SEQ-FILE AT END GO TO READ-TEST-2. DB2024.2 +081300 GO TO READ-TEST-2-INIT. DB2024.2 +081400 READ-TEST-2-DELETE. DB2024.2 +081500 MOVE "DEBUG READ AT END" TO FEATURE. DB2024.2 +081600 MOVE "READ-TEST-2" TO PAR-NAME. DB2024.2 +081700 PERFORM DE-LETE. DB2024.2 +081800 PERFORM GEN-WRITE. DB2024.2 +081900 GO TO CLOSE-SEQ-FILE. DB2024.2 +082000 READ-TEST-2. DB2024.2 +082100 MOVE "DEBUG READ AT END" TO FEATURE. DB2024.2 +082200 MOVE "READ-TEST-2" TO PAR-NAME. DB2024.2 +082300 IF KEY-1 IS EQUAL TO 0 DB2024.2 +082400 PERFORM PASS DB2024.2 +082500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2024.2 +082600 ELSE PERFORM FAIL DB2024.2 +082700 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2024.2 +082800 GEN-WRITE. DB2024.2 +082900 PERFORM PRINT-DETAIL. DB2024.2 +083000 CLOSE-SEQ-FILE. DB2024.2 +083100 CLOSE SEQ-FILE. DB2024.2 +083200XTAPE-DUMP SECTION. DB2024.2 +083300XOPEN-FILE. DB2024.2 +083400X OPEN INPUT SEQ-FILE. DB2024.2 +083500XREAD-FILE. DB2024.2 +083600X READ SEQ-FILE AT END GO TO CLOSE-FILE. DB2024.2 +083700X MOVE SEQ-REC-3 TO PRINT-REC. DB2024.2 +083800X PERFORM WRITE-LINE. DB2024.2 +083900X GO TO READ-FILE. DB2024.2 +084000XCLOSE-FILE. DB2024.2 +084100X CLOSE SEQ-FILE. DB2024.2 +084200 CCVS-EXIT SECTION. DB2024.2 +084300 CCVS-999999. DB2024.2 +084400 GO TO CLOSE-FILES. DB2024.2 +*END-OF,DB202A +*HEADER,COBOL,DB203A +000100 IDENTIFICATION DIVISION. DB2034.2 +000200 PROGRAM-ID. DB2034.2 +000300 DB203A. DB2034.2 +000400 AUTHOR. DB2034.2 +000500 FEDERAL COMPILER TESTING CENTER. DB2034.2 +000600 INSTALLATION. DB2034.2 +000700 GENERAL SERVICES ADMINISTRATION DB2034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB2034.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB2034.2 +001100 FALLS CHURCH VIRGINIA 22041. DB2034.2 +001200 DB2034.2 +001300 PHONE (703) 756-6153 DB2034.2 +001400 DB2034.2 +001500 " HIGH ". DB2034.2 +001600 DATE-WRITTEN. DB2034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2034.2 +001800 CREATION DATE / VALIDATION DATE DB2034.2 +001900 "4.2 ". DB2034.2 +002000 SECURITY. DB2034.2 +002100 NONE. DB2034.2 +002200* DB2034.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB2034.2 +002400* DB2034.2 +002500* PROGRAM ABSTRACT DB2034.2 +002600* DB2034.2 +002700* DB203A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE DB2034.2 +002800* DEBUGGING PROCEDURES WHICH ARE MONITORING I-O FUNCTIONS DB2034.2 +002900* OF THE RELATIVE I-O OR INDEXED I-O MODULES. THIS PROGRAM DB2034.2 +003000* IS TO BE COMPILED AND EXECUTED WITH BOTH COMPILE AND OBJECT DB2034.2 +003100* TIME DEBUGGING SWITCHES ON. THE DEBUGGING PROCEDURES DB2034.2 +003200* SHOULD BE INCLUDED IN COMPILATION AND GENERATE CODE. DB2034.2 +003300* DURING EXECUTION, A FILE IS ASSIGNED IN DYNAMIC MODE, DB2034.2 +003400* CREATED SEQUENTIALLY, AND ACCESSED BOTH SEQUENTIALLY DB2034.2 +003500* AND RANDOMLY. ITS RECORDS ARE 80 CHARACTERS IN LENGTH. DB2034.2 +003600* EXECUTION OF "OPEN", "READ", "WRITE", "REWRITE", "START", DB2034.2 +003700* AND "DELETE" FUNCTIONS SHOULD TRIGGER THE APPROPRIATE DB2034.2 +003800* DEBUGGING PROCEDURES. DB2034.2 +003900* DB2034.2 +004000* DB2034.2 +004100* DB2034.2 +004200 ENVIRONMENT DIVISION. DB2034.2 +004300 CONFIGURATION SECTION. DB2034.2 +004400 SOURCE-COMPUTER. DB2034.2 +004500 XXXXX082 DB2034.2 +004600 WITH DEBUGGING MODE. DB2034.2 +004700 OBJECT-COMPUTER. DB2034.2 +004800 XXXXX083. DB2034.2 +004900 SPECIAL-NAMES. DB2034.2 +005000 XXXXX056 DB2034.2 +005100* XXXXX056 REPLACE WITH DISPLAY IMPLEMENTOR NAME DB2034.2 +005200 IS THE-SYSTEM-PRINTER. DB2034.2 +005300 INPUT-OUTPUT SECTION. DB2034.2 +005400 FILE-CONTROL. DB2034.2 +005500 SELECT PRINT-FILE ASSIGN TO DB2034.2 +005600 XXXXX055. DB2034.2 +005700 SELECT IND-FILE ASSIGN TO DB2034.2 +005800 XXXXX024 DB2034.2 +005900J XXXXX044 DB2034.2 +006000* XXXXX044 REPLACE WITH INDEX-FILE-NAME (*OPT J ONLY) DB2034.2 +006100 ORGANIZATION IS INDEXED DB2034.2 +006200 ACCESS MODE IS DYNAMIC DB2034.2 +006300 RECORD KEY IS IND-KEY. DB2034.2 +006400 DATA DIVISION. DB2034.2 +006500 FILE SECTION. DB2034.2 +006600 FD PRINT-FILE DB2034.2 +006700 LABEL RECORDS DB2034.2 +006800 XXXXX084 DB2034.2 +006900 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2034.2 +007000 01 PRINT-REC PICTURE X(120). DB2034.2 +007100 01 DUMMY-RECORD PICTURE X(120). DB2034.2 +007200 FD IND-FILE DB2034.2 +007300C VALUE OF DB2034.2 +007400C XXXXX074 DB2034.2 +007500* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2034.2 +007600C IS DB2034.2 +007700C XXXXX075 DB2034.2 +007800* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2034.2 +007900G XXXXX069 DB2034.2 +008000* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2034.2 +008100 LABEL RECORDS ARE STANDARD. DB2034.2 +008200 01 IND-REC-1. DB2034.2 +008300 02 FILLER PIC X(128). DB2034.2 +008400 02 IND-KEY PIC XX. DB2034.2 +008500 02 FILLER PIC X(110). DB2034.2 +008600 01 IND-REC-2. DB2034.2 +008700 02 IND-REC-1H PIC X(120). DB2034.2 +008800 02 IND-REC-2H PIC X(120). DB2034.2 +008900 WORKING-STORAGE SECTION. DB2034.2 +009000 01 ITEM-1. DB2034.2 +009100 02 KEY-1 PIC 99. DB2034.2 +009200 02 LINE-1 PIC X(6). DB2034.2 +009300 02 NAME-1 PIC X(30). DB2034.2 +009400 02 UNQUAL-NAME-1 PIC X(30). DB2034.2 +009500 02 CONTENTS-1. DB2034.2 +009600 03 CONTENTS-1-1H PIC X(120). DB2034.2 +009700 03 CONTENTS-1-2H PIC X(120). DB2034.2 +009800 02 CONTENTS-REC. DB2034.2 +009900 03 CONTENTS-REC-1H PIC X(120). DB2034.2 +010000 03 CONTENTS-REC-2H PIC X(120). DB2034.2 +010100 01 FILE-RECORD-INFORMATION-REC. DB2034.2 +010200 03 FILE-RECORD-INFO-SKELETON. DB2034.2 +010300 05 FILLER PICTURE X(48) VALUE DB2034.2 +010400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB2034.2 +010500 05 FILLER PICTURE X(46) VALUE DB2034.2 +010600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB2034.2 +010700 05 FILLER PICTURE X(26) VALUE DB2034.2 +010800 ",LFIL=000000,ORG= ,LBLR= ". DB2034.2 +010900 05 FILLER PICTURE X(37) VALUE DB2034.2 +011000 ",RECKEY= ". DB2034.2 +011100 05 FILLER PICTURE X(38) VALUE DB2034.2 +011200 ",ALTKEY1= ". DB2034.2 +011300 05 FILLER PICTURE X(38) VALUE DB2034.2 +011400 ",ALTKEY2= ". DB2034.2 +011500 05 FILLER PICTURE X(7) VALUE SPACE.DB2034.2 +011600 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB2034.2 +011700 05 FILE-RECORD-INFO-P1-120. DB2034.2 +011800 07 FILLER PIC X(5). DB2034.2 +011900 07 XFILE-NAME PIC X(6). DB2034.2 +012000 07 FILLER PIC X(8). DB2034.2 +012100 07 XRECORD-NAME PIC X(6). DB2034.2 +012200 07 FILLER PIC X(1). DB2034.2 +012300 07 REELUNIT-NUMBER PIC 9(1). DB2034.2 +012400 07 FILLER PIC X(7). DB2034.2 +012500 07 XRECORD-NUMBER PIC 9(6). DB2034.2 +012600 07 FILLER PIC X(6). DB2034.2 +012700 07 UPDATE-NUMBER PIC 9(2). DB2034.2 +012800 07 FILLER PIC X(5). DB2034.2 +012900 07 ODO-NUMBER PIC 9(4). DB2034.2 +013000 07 FILLER PIC X(5). DB2034.2 +013100 07 XPROGRAM-NAME PIC X(5). DB2034.2 +013200 07 FILLER PIC X(7). DB2034.2 +013300 07 XRECORD-LENGTH PIC 9(6). DB2034.2 +013400 07 FILLER PIC X(7). DB2034.2 +013500 07 CHARS-OR-RECORDS PIC X(2). DB2034.2 +013600 07 FILLER PIC X(1). DB2034.2 +013700 07 XBLOCK-SIZE PIC 9(4). DB2034.2 +013800 07 FILLER PIC X(6). DB2034.2 +013900 07 RECORDS-IN-FILE PIC 9(6). DB2034.2 +014000 07 FILLER PIC X(5). DB2034.2 +014100 07 XFILE-ORGANIZATION PIC X(2). DB2034.2 +014200 07 FILLER PIC X(6). DB2034.2 +014300 07 XLABEL-TYPE PIC X(1). DB2034.2 +014400 05 FILE-RECORD-INFO-P121-240. DB2034.2 +014500 07 FILLER PIC X(8). DB2034.2 +014600 07 XRECORD-KEY PIC X(29). DB2034.2 +014700 07 FILLER PIC X(9). DB2034.2 +014800 07 ALTERNATE-KEY1 PIC X(29). DB2034.2 +014900 07 FILLER PIC X(9). DB2034.2 +015000 07 ALTERNATE-KEY2 PIC X(29). DB2034.2 +015100 07 FILLER PIC X(7). DB2034.2 +015200 01 TEST-RESULTS. DB2034.2 +015300 02 FILLER PICTURE X VALUE SPACE. DB2034.2 +015400 02 FEATURE PICTURE X(20) VALUE SPACE. DB2034.2 +015500 02 FILLER PICTURE X VALUE SPACE. DB2034.2 +015600 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2034.2 +015700 02 FILLER PICTURE X VALUE SPACE. DB2034.2 +015800 02 PAR-NAME. DB2034.2 +015900 03 FILLER PICTURE X(12) VALUE SPACE. DB2034.2 +016000 03 PARDOT-X PICTURE X VALUE SPACE. DB2034.2 +016100 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2034.2 +016200 03 FILLER PIC X(5) VALUE SPACE. DB2034.2 +016300 02 FILLER PIC X(10) VALUE SPACE. DB2034.2 +016400 02 RE-MARK PIC X(61). DB2034.2 +016500 01 TEST-COMPUTED. DB2034.2 +016600 02 FILLER PIC X(30) VALUE SPACE. DB2034.2 +016700 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2034.2 +016800 02 COMPUTED-X. DB2034.2 +016900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2034.2 +017000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2034.2 +017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2034.2 +017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2034.2 +017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2034.2 +017400 03 CM-18V0 REDEFINES COMPUTED-A. DB2034.2 +017500 04 COMPUTED-18V0 PICTURE -9(18). DB2034.2 +017600 04 FILLER PICTURE X. DB2034.2 +017700 03 FILLER PIC X(50) VALUE SPACE. DB2034.2 +017800 01 TEST-CORRECT. DB2034.2 +017900 02 FILLER PIC X(30) VALUE SPACE. DB2034.2 +018000 02 FILLER PIC X(17) VALUE " CORRECT =". DB2034.2 +018100 02 CORRECT-X. DB2034.2 +018200 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2034.2 +018300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2034.2 +018400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2034.2 +018500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2034.2 +018600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2034.2 +018700 03 CR-18V0 REDEFINES CORRECT-A. DB2034.2 +018800 04 CORRECT-18V0 PICTURE -9(18). DB2034.2 +018900 04 FILLER PICTURE X. DB2034.2 +019000 03 FILLER PIC X(50) VALUE SPACE. DB2034.2 +019100 01 CCVS-C-1. DB2034.2 +019200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2034.2 +019300- "SS PARAGRAPH-NAME DB2034.2 +019400- " REMARKS". DB2034.2 +019500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2034.2 +019600 01 CCVS-C-2. DB2034.2 +019700 02 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 +019800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2034.2 +019900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2034.2 +020000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2034.2 +020100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2034.2 +020200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2034.2 +020300 01 REC-CT PICTURE 99 VALUE ZERO. DB2034.2 +020400 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2034.2 +020500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2034.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2034.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2034.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2034.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2034.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2034.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2034.2 +021200 01 CCVS-H-1. DB2034.2 +021300 02 FILLER PICTURE X(27) VALUE SPACE. DB2034.2 +021400 02 FILLER PICTURE X(67) VALUE DB2034.2 +021500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2034.2 +021600- " SYSTEM". DB2034.2 +021700 02 FILLER PICTURE X(26) VALUE SPACE. DB2034.2 +021800 01 CCVS-H-2. DB2034.2 +021900 02 FILLER PICTURE X(52) VALUE IS DB2034.2 +022000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2034.2 +022100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2034.2 +022200 02 TEST-ID PICTURE IS X(9). DB2034.2 +022300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2034.2 +022400 01 CCVS-H-3. DB2034.2 +022500 02 FILLER PICTURE X(34) VALUE DB2034.2 +022600 " FOR OFFICIAL USE ONLY ". DB2034.2 +022700 02 FILLER PICTURE X(58) VALUE DB2034.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2034.2 +022900 02 FILLER PICTURE X(28) VALUE DB2034.2 +023000 " COPYRIGHT 1974 ". DB2034.2 +023100 01 CCVS-E-1. DB2034.2 +023200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2034.2 +023300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2034.2 +023400 02 ID-AGAIN PICTURE IS X(9). DB2034.2 +023500 02 FILLER PICTURE X(45) VALUE IS DB2034.2 +023600 " NTIS DISTRIBUTION COBOL 74". DB2034.2 +023700 01 CCVS-E-2. DB2034.2 +023800 02 FILLER PICTURE X(31) VALUE DB2034.2 +023900 SPACE. DB2034.2 +024000 02 FILLER PICTURE X(21) VALUE SPACE. DB2034.2 +024100 02 CCVS-E-2-2. DB2034.2 +024200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2034.2 +024300 03 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 +024400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2034.2 +024500 01 CCVS-E-3. DB2034.2 +024600 02 FILLER PICTURE X(22) VALUE DB2034.2 +024700 " FOR OFFICIAL USE ONLY". DB2034.2 +024800 02 FILLER PICTURE X(12) VALUE SPACE. DB2034.2 +024900 02 FILLER PICTURE X(58) VALUE DB2034.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2034.2 +025100 02 FILLER PICTURE X(13) VALUE SPACE. DB2034.2 +025200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2034.2 +025300 01 CCVS-E-4. DB2034.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2034.2 +025500 02 FILLER PIC XXXX VALUE " OF ". DB2034.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2034.2 +025700 02 FILLER PIC X(40) VALUE DB2034.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". DB2034.2 +025900 01 XXINFO. DB2034.2 +026000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2034.2 +026100 02 INFO-TEXT. DB2034.2 +026200 04 FILLER PIC X(20) VALUE SPACE. DB2034.2 +026300 04 XXCOMPUTED PIC X(20). DB2034.2 +026400 04 FILLER PIC X(5) VALUE SPACE. DB2034.2 +026500 04 XXCORRECT PIC X(20). DB2034.2 +026600 01 HYPHEN-LINE. DB2034.2 +026700 02 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 +026800 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2034.2 +026900- "*****************************************". DB2034.2 +027000 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2034.2 +027100- "******************************". DB2034.2 +027200 01 CCVS-PGM-ID PIC X(6) VALUE DB2034.2 +027300 "DB203A". DB2034.2 +027400 PROCEDURE DIVISION. DB2034.2 +027500 DECLARATIVES. DB2034.2 +027600 FILENAME-PROC SECTION. DB2034.2 +027700 USE FOR DEBUGGING ON IND-FILE IND-REC-1. DB2034.2 +027800 FILENAME-1. DB2034.2 +027900 MOVE 1 TO KEY-1. DB2034.2 +028000 MOVE DEBUG-LINE TO LINE-1. DB2034.2 +028100 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2034.2 +028200 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2034.2 +028300 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS DB2034.2 +028400 BY SPACES AFTER INITIAL SPACE. DB2034.2 +028500 END DECLARATIVES. DB2034.2 +028600 CCVS1 SECTION. DB2034.2 +028700 OPEN-FILES. DB2034.2 +028800 OPEN OUTPUT PRINT-FILE. DB2034.2 +028900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2034.2 +029000 MOVE SPACE TO TEST-RESULTS. DB2034.2 +029100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2034.2 +029200 GO TO CCVS1-EXIT. DB2034.2 +029300 CLOSE-FILES. DB2034.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2034.2 +029500 TERMINATE-CCVS. DB2034.2 +029600S EXIT PROGRAM. DB2034.2 +029700STERMINATE-CALL. DB2034.2 +029800 STOP RUN. DB2034.2 +029900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2034.2 +030000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2034.2 +030100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2034.2 +030200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2034.2 +030300 MOVE "****TEST DELETED****" TO RE-MARK. DB2034.2 +030400 PRINT-DETAIL. DB2034.2 +030500 IF REC-CT NOT EQUAL TO ZERO DB2034.2 +030600 MOVE "." TO PARDOT-X DB2034.2 +030700 MOVE REC-CT TO DOTVALUE. DB2034.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2034.2 +030900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2034.2 +031000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2034.2 +031100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2034.2 +031200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2034.2 +031300 MOVE SPACE TO CORRECT-X. DB2034.2 +031400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2034.2 +031500 MOVE SPACE TO RE-MARK. DB2034.2 +031600 HEAD-ROUTINE. DB2034.2 +031700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 +031800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2034.2 +031900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2034.2 +032000 COLUMN-NAMES-ROUTINE. DB2034.2 +032100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 +032200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 +032300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 +032400 END-ROUTINE. DB2034.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2034.2 +032600 END-RTN-EXIT. DB2034.2 +032700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 +032800 END-ROUTINE-1. DB2034.2 +032900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2034.2 +033000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2034.2 +033100 ADD PASS-COUNTER TO ERROR-HOLD. DB2034.2 +033200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2034.2 +033300 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2034.2 +033400 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2034.2 +033500 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2034.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2034.2 +033700 END-ROUTINE-12. DB2034.2 +033800 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2034.2 +033900 IF ERROR-COUNTER IS EQUAL TO ZERO DB2034.2 +034000 MOVE "NO " TO ERROR-TOTAL DB2034.2 +034100 ELSE DB2034.2 +034200 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2034.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2034.2 +034400 PERFORM WRITE-LINE. DB2034.2 +034500 END-ROUTINE-13. DB2034.2 +034600 IF DELETE-CNT IS EQUAL TO ZERO DB2034.2 +034700 MOVE "NO " TO ERROR-TOTAL ELSE DB2034.2 +034800 MOVE DELETE-CNT TO ERROR-TOTAL. DB2034.2 +034900 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2034.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 +035100 IF INSPECT-COUNTER EQUAL TO ZERO DB2034.2 +035200 MOVE "NO " TO ERROR-TOTAL DB2034.2 +035300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2034.2 +035400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2034.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 +035600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 +035700 WRITE-LINE. DB2034.2 +035800 ADD 1 TO RECORD-COUNT. DB2034.2 +035900Y IF RECORD-COUNT GREATER 50 DB2034.2 +036000Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB2034.2 +036100Y MOVE SPACE TO DUMMY-RECORD DB2034.2 +036200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2034.2 +036300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2034.2 +036400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2034.2 +036500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2034.2 +036600Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB2034.2 +036700Y MOVE ZERO TO RECORD-COUNT. DB2034.2 +036800 PERFORM WRT-LN. DB2034.2 +036900 WRT-LN. DB2034.2 +037000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2034.2 +037100 MOVE SPACE TO DUMMY-RECORD. DB2034.2 +037200 BLANK-LINE-PRINT. DB2034.2 +037300 PERFORM WRT-LN. DB2034.2 +037400 FAIL-ROUTINE. DB2034.2 +037500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2034.2 +037600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2034.2 +037700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2034.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 +037900 GO TO FAIL-ROUTINE-EX. DB2034.2 +038000 FAIL-ROUTINE-WRITE. DB2034.2 +038100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2034.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2034.2 +038300 FAIL-ROUTINE-EX. EXIT. DB2034.2 +038400 BAIL-OUT. DB2034.2 +038500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2034.2 +038600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2034.2 +038700 BAIL-OUT-WRITE. DB2034.2 +038800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2034.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 +039000 BAIL-OUT-EX. EXIT. DB2034.2 +039100 CCVS1-EXIT. DB2034.2 +039200 EXIT. DB2034.2 +039300 BEGIN-DB203A-TESTS SECTION. DB2034.2 +039400 SET-UP-REC-AREA. DB2034.2 +039500 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). DB2034.2 +039600 MOVE "IX-FD1" TO XFILE-NAME (1). DB2034.2 +039700 MOVE "REC-1" TO XRECORD-NAME (1). DB2034.2 +039800 MOVE ".XXX." TO XPROGRAM-NAME (1). DB2034.2 +039900 MOVE 240 TO XRECORD-LENGTH (1). DB2034.2 +040000 MOVE "RC" TO CHARS-OR-RECORDS (1). DB2034.2 +040100 MOVE 1 TO XBLOCK-SIZE (1). DB2034.2 +040200 MOVE 5 TO RECORDS-IN-FILE (1). DB2034.2 +040300 MOVE "IX" TO XFILE-ORGANIZATION (1). DB2034.2 +040400 MOVE "S" TO XLABEL-TYPE (1). DB2034.2 +040500 OPEN-TEST-1-INIT. DB2034.2 +040600 MOVE 0 TO KEY-1. DB2034.2 +040700 MOVE "OPEN-TEST-1" TO PAR-NAME. DB2034.2 +040800 MOVE "DEBUG OPEN OUTPUT" TO FEATURE. DB2034.2 +040900 OPEN-TEST-1. DB2034.2 +041000 OPEN OUTPUT IND-FILE. DB2034.2 +041100 IF KEY-1 IS EQUAL TO 1 DB2034.2 +041200 PERFORM PASS DB2034.2 +041300 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +041400 ELSE PERFORM FAIL DB2034.2 +041500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +041600 PERFORM GEN-WRITE. DB2034.2 +041700 GO TO WRITE-TEST-1-INIT. DB2034.2 +041800 OPEN-TEST-1-DELETE. DB2034.2 +041900 PERFORM DE-LETE. DB2034.2 +042000 PERFORM GEN-WRITE. DB2034.2 +042100 WRITE-TEST-1-INIT. DB2034.2 +042200 MOVE 0 TO KEY-1. DB2034.2 +042300 MOVE "WRITE-TEST-1" TO PAR-NAME. DB2034.2 +042400 MOVE "DEBUG WRITE RECORD" TO FEATURE. DB2034.2 +042500 WRITE-TEST-1. DB2034.2 +042600 MOVE 1 TO XRECORD-NUMBER (1). DB2034.2 +042700 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +042800 MOVE "02" TO IND-KEY. DB2034.2 +042900 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 +043000 MOVE 2 TO XRECORD-NUMBER (1). DB2034.2 +043100 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +043200 MOVE "04" TO IND-KEY. DB2034.2 +043300 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 +043400 MOVE 3 TO XRECORD-NUMBER (1). DB2034.2 +043500 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +043600 MOVE "06" TO IND-KEY. DB2034.2 +043700 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 +043800 MOVE 4 TO XRECORD-NUMBER (1). DB2034.2 +043900 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +044000 MOVE "08" TO IND-KEY. DB2034.2 +044100 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 +044200 MOVE 5 TO XRECORD-NUMBER (1). DB2034.2 +044300 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +044400 MOVE "10" TO IND-KEY. DB2034.2 +044500 WRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM. DB2034.2 +044600 IF KEY-1 IS EQUAL TO 1 DB2034.2 +044700 PERFORM PASS DB2034.2 +044800 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +044900 ELSE PERFORM FAIL DB2034.2 +045000 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +045100 PERFORM GEN-WRITE. DB2034.2 +045200 GO TO CLOSE-TEST-1-INIT. DB2034.2 +045300 WRITE-TEST-1-DELETE. DB2034.2 +045400 PERFORM DE-LETE. DB2034.2 +045500 PERFORM GEN-WRITE. DB2034.2 +045600 CLOSE-TEST-1-INIT. DB2034.2 +045700 MOVE 0 TO KEY-1. DB2034.2 +045800 MOVE "CLOSE-TEST-1" TO PAR-NAME. DB2034.2 +045900 MOVE "DEBUG CLOSE FILE" TO FEATURE. DB2034.2 +046000 CLOSE-TEST-1. DB2034.2 +046100 CLOSE IND-FILE. DB2034.2 +046200 IF KEY-1 IS EQUAL TO 1 DB2034.2 +046300 PERFORM PASS DB2034.2 +046400 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +046500 ELSE PERFORM FAIL DB2034.2 +046600 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +046700 PERFORM GEN-WRITE. DB2034.2 +046800 GO TO OPEN-TEST-2-INIT. DB2034.2 +046900 CLOSE-TEST-1-DELETE. DB2034.2 +047000 PERFORM DE-LETE. DB2034.2 +047100 PERFORM GEN-WRITE. DB2034.2 +047200 OPEN-TEST-2-INIT. DB2034.2 +047300 MOVE 0 TO KEY-1. DB2034.2 +047400 MOVE "OPEN-TEST-2" TO PAR-NAME. DB2034.2 +047500 MOVE "DEBUG OPEN I-O" TO FEATURE. DB2034.2 +047600 OPEN-TEST-2. DB2034.2 +047700 OPEN I-O IND-FILE. DB2034.2 +047800 IF KEY-1 IS EQUAL TO 1 DB2034.2 +047900 PERFORM PASS DB2034.2 +048000 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +048100 ELSE PERFORM FAIL DB2034.2 +048200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +048300 PERFORM GEN-WRITE. DB2034.2 +048400 GO TO READ-TEST-1-INIT. DB2034.2 +048500 OPEN-TEST-2-DELETE. DB2034.2 +048600 PERFORM DE-LETE. DB2034.2 +048700 PERFORM GEN-WRITE. DB2034.2 +048800 READ-TEST-1-INIT. DB2034.2 +048900 MOVE SPACES TO ITEM-1. DB2034.2 +049000 MOVE 0 TO KEY-1. DB2034.2 +049100 MOVE "READ-TEST-1" TO PAR-NAME. DB2034.2 +049200 MOVE "DEBUG READ RANDOM" TO FEATURE. DB2034.2 +049300 READ-TEST-1. DB2034.2 +049400 MOVE "04" TO IND-KEY. DB2034.2 +049500******************************************************************DB2034.2 +049600* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2034.2 +049700* "READ-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2034.2 +049800* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "READ *DB2034.2 +049900* IND-FILE KEY IS IND-KEY INVALID KEY GO TO ABORT-PGM.". *DB2034.2 +050000******************************************************************DB2034.2 +050100 READ IND-FILE KEY IS IND-KEY DB2034.2 +050200 INVALID KEY GO TO ABORT-PGM. DB2034.2 +050300 IF KEY-1 IS EQUAL TO 1 DB2034.2 +050400 PERFORM PASS DB2034.2 +050500 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +050600 PERFORM GEN-WRITE DB2034.2 +050700 GO TO READ-TEST-1A DB2034.2 +050800 ELSE PERFORM FAIL DB2034.2 +050900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 +051000 PERFORM GEN-WRITE DB2034.2 +051100 PERFORM DELETE-READ-TEST-1-SUBTESTS DB2034.2 +051200 GO TO REWRITE-TEST-1-INIT. DB2034.2 +051300 READ-TEST-1-DELETE. DB2034.2 +051400 PERFORM DE-LETE. DB2034.2 +051500 PERFORM GEN-WRITE. DB2034.2 +051600 PERFORM DELETE-READ-TEST-1-SUBTESTS. DB2034.2 +051700 GO TO READ-TEST-2-INIT. DB2034.2 +051800 DELETE-READ-TEST-1-SUBTESTS. DB2034.2 +051900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2034.2 +052000 PERFORM DE-LETE. DB2034.2 +052100 PERFORM GEN-WRITE. DB2034.2 +052200 MOVE "READ-TEST-1B" TO PAR-NAME. DB2034.2 +052300 PERFORM DE-LETE. DB2034.2 +052400 PERFORM GEN-WRITE. DB2034.2 +052500 MOVE "READ-TEST-1C" TO PAR-NAME. DB2034.2 +052600 PERFORM DE-LETE. DB2034.2 +052700 PERFORM GEN-WRITE. DB2034.2 +052800 READ-TEST-1A. DB2034.2 +052900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2034.2 +053000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2034.2 +053100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2034.2 +053200 MOVE LINE-1 TO COMPUTED-A. DB2034.2 +053300 PERFORM INSPT. DB2034.2 +053400 PERFORM GEN-WRITE. DB2034.2 +053500 READ-TEST-1B. DB2034.2 +053600 MOVE "READ-TEST-1B" TO PAR-NAME. DB2034.2 +053700 IF UNQUAL-NAME-1 IS EQUAL TO "IND-FILE" DB2034.2 +053800 PERFORM PASS DB2034.2 +053900 ELSE PERFORM FAIL DB2034.2 +054000 MOVE "IND-FILE" TO CORRECT-A DB2034.2 +054100 MOVE NAME-1 TO COMPUTED-A. DB2034.2 +054200 MOVE "DEBUG-NAME" TO RE-MARK. DB2034.2 +054300 PERFORM GEN-WRITE. DB2034.2 +054400 READ-TEST-1C. DB2034.2 +054500 MOVE "READ-TEST-1C" TO PAR-NAME. DB2034.2 +054600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 +054700 IF CONTENTS-1 IS EQUAL TO IND-REC-2 DB2034.2 +054800 PERFORM PASS DB2034.2 +054900 PERFORM GEN-WRITE DB2034.2 +055000 GO TO READ-TEST-2-INIT DB2034.2 +055100 ELSE PERFORM FAIL DB2034.2 +055200 MOVE "LINES 1 AND 3 BELOW" TO COMPUTED-A DB2034.2 +055300 MOVE "LINES 2 AND 4 BELOW" TO CORRECT-A. DB2034.2 +055400 PERFORM GEN-WRITE. DB2034.2 +055500 MOVE CONTENTS-1-1H TO PRINT-REC. DB2034.2 +055600 PERFORM WRITE-LINE. DB2034.2 +055700 MOVE IND-REC-1H TO PRINT-REC. DB2034.2 +055800 PERFORM WRITE-LINE. DB2034.2 +055900 MOVE CONTENTS-1-2H TO PRINT-REC. DB2034.2 +056000 PERFORM WRITE-LINE. DB2034.2 +056100 MOVE IND-REC-2H TO PRINT-REC. DB2034.2 +056200 PERFORM WRITE-LINE. DB2034.2 +056300 READ-TEST-2-INIT. DB2034.2 +056400 MOVE SPACES TO ITEM-1. DB2034.2 +056500 MOVE 0 TO KEY-1. DB2034.2 +056600 MOVE "READ-TEST-2" TO PAR-NAME. DB2034.2 +056700 MOVE "DEBUG READ INV KEY" TO FEATURE. DB2034.2 +056800 READ-TEST-2. DB2034.2 +056900 MOVE "05" TO IND-KEY. DB2034.2 +057000 READ IND-FILE KEY IS IND-KEY DB2034.2 +057100 INVALID KEY GO TO READ-TEST-2-CONT. DB2034.2 +057200 READ-TEST-2-DELETE. DB2034.2 +057300 PERFORM DE-LETE. DB2034.2 +057400 PERFORM GEN-WRITE. DB2034.2 +057500 GO TO REWRITE-TEST-1-INIT. DB2034.2 +057600 READ-TEST-2-CONT. DB2034.2 +057700 IF KEY-1 IS EQUAL TO 0 DB2034.2 +057800 PERFORM PASS DB2034.2 +057900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 +058000 ELSE PERFORM FAIL DB2034.2 +058100 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2034.2 +058200 PERFORM GEN-WRITE. DB2034.2 +058300 REWRITE-TEST-1-INIT. DB2034.2 +058400 MOVE SPACES TO ITEM-1. DB2034.2 +058500 MOVE 0 TO KEY-1. DB2034.2 +058600 MOVE "REWRITE-TEST-1" TO PAR-NAME. DB2034.2 +058700 MOVE "DEBUG REWRITE RECORD" TO FEATURE. DB2034.2 +058800 REWRITE-TEST-1. DB2034.2 +058900 MOVE 2 TO XRECORD-NUMBER (1). DB2034.2 +059000 MOVE 1 TO UPDATE-NUMBER (1). DB2034.2 +059100 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +059200 MOVE "04" TO IND-KEY. DB2034.2 +059300 MOVE IND-REC-2 TO CONTENTS-REC. DB2034.2 +059400******************************************************************DB2034.2 +059500* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2034.2 +059600* "REWRITE-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2034.2 +059700* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2034.2 +059800* "REWRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM.". *DB2034.2 +059900******************************************************************DB2034.2 +060000 REWRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM. DB2034.2 +060100 IF KEY-1 IS EQUAL TO 1 DB2034.2 +060200 PERFORM PASS DB2034.2 +060300 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +060400 PERFORM GEN-WRITE DB2034.2 +060500 GO TO REWRITE-TEST-1A DB2034.2 +060600 ELSE PERFORM FAIL DB2034.2 +060700 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 +060800 PERFORM GEN-WRITE DB2034.2 +060900 PERFORM DELETE-REWRITE-TEST-1-SUBTESTS DB2034.2 +061000 GO TO REWRITE-TEST-2-INIT. DB2034.2 +061100 REWRITE-TEST-1-DELETE. DB2034.2 +061200 PERFORM DE-LETE. DB2034.2 +061300 PERFORM GEN-WRITE. DB2034.2 +061400 PERFORM DELETE-REWRITE-TEST-1-SUBTESTS. DB2034.2 +061500 GO TO REWRITE-TEST-2-INIT. DB2034.2 +061600 DELETE-REWRITE-TEST-1-SUBTESTS. DB2034.2 +061700 MOVE "REWRITE-TEST-1A" TO PAR-NAME. DB2034.2 +061800 PERFORM DE-LETE. DB2034.2 +061900 PERFORM GEN-WRITE. DB2034.2 +062000 MOVE "REWRITE-TEST-1B" TO PAR-NAME. DB2034.2 +062100 PERFORM DE-LETE. DB2034.2 +062200 PERFORM GEN-WRITE. DB2034.2 +062300 MOVE "REWRITE-TEST-1C" TO PAR-NAME. DB2034.2 +062400 PERFORM DE-LETE. DB2034.2 +062500 PERFORM GEN-WRITE. DB2034.2 +062600 REWRITE-TEST-1A. DB2034.2 +062700 MOVE "REWRITE-TEST-1A" TO PAR-NAME. DB2034.2 +062800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2034.2 +062900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2034.2 +063000 MOVE LINE-1 TO COMPUTED-A. DB2034.2 +063100 PERFORM INSPT. DB2034.2 +063200 PERFORM GEN-WRITE. DB2034.2 +063300 REWRITE-TEST-1B. DB2034.2 +063400 MOVE "REWRITE-TEST-1B" TO PAR-NAME. DB2034.2 +063500 IF UNQUAL-NAME-1 IS EQUAL TO "IND-REC-1" DB2034.2 +063600 PERFORM PASS DB2034.2 +063700 ELSE PERFORM FAIL DB2034.2 +063800 MOVE "IND-REC-1" TO CORRECT-A DB2034.2 +063900 MOVE NAME-1 TO COMPUTED-A. DB2034.2 +064000 MOVE "DEBUG-NAME" TO RE-MARK. DB2034.2 +064100 PERFORM GEN-WRITE. DB2034.2 +064200 REWRITE-TEST-1C. DB2034.2 +064300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 +064400 MOVE "REWRITE-TEST-1C" TO PAR-NAME. DB2034.2 +064500 IF CONTENTS-1 IS EQUAL TO CONTENTS-REC DB2034.2 +064600 PERFORM PASS DB2034.2 +064700 PERFORM GEN-WRITE DB2034.2 +064800 GO TO REWRITE-TEST-2-INIT DB2034.2 +064900 ELSE PERFORM FAIL DB2034.2 +065000 MOVE "LINES 1 AND 3 BELOW" TO COMPUTED-A DB2034.2 +065100 MOVE "LINES 2 AND 4 BELOW" TO CORRECT-A DB2034.2 +065200 PERFORM GEN-WRITE. DB2034.2 +065300 MOVE CONTENTS-1-1H TO PRINT-REC. DB2034.2 +065400 PERFORM WRITE-LINE. DB2034.2 +065500 MOVE CONTENTS-REC-1H TO PRINT-REC. DB2034.2 +065600 PERFORM WRITE-LINE. DB2034.2 +065700 MOVE CONTENTS-1-2H TO PRINT-REC. DB2034.2 +065800 PERFORM WRITE-LINE. DB2034.2 +065900 MOVE CONTENTS-REC-2H TO PRINT-REC. DB2034.2 +066000 PERFORM WRITE-LINE. DB2034.2 +066100 REWRITE-TEST-2-INIT. DB2034.2 +066200 MOVE SPACES TO ITEM-1. DB2034.2 +066300 MOVE 0 TO KEY-1. DB2034.2 +066400 MOVE "REWRITE-TEST-2" TO PAR-NAME. DB2034.2 +066500 MOVE "DEBUG REWRITE INVLID" TO FEATURE. DB2034.2 +066600 REWRITE-TEST-2. DB2034.2 +066700 MOVE 6 TO XRECORD-NUMBER (1). DB2034.2 +066800 MOVE 1 TO UPDATE-NUMBER (1). DB2034.2 +066900 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 +067000 MOVE "03" TO IND-KEY. DB2034.2 +067100 REWRITE IND-REC-1 INVALID KEY GO TO REWRITE-TEST-2-CONT. DB2034.2 +067200 REWRITE-TEST-2-DELETE. DB2034.2 +067300 PERFORM DE-LETE. DB2034.2 +067400 PERFORM GEN-WRITE. DB2034.2 +067500 GO TO START-TEST-1-INIT. DB2034.2 +067600 REWRITE-TEST-2-CONT. DB2034.2 +067700 IF KEY-1 IS EQUAL TO 1 DB2034.2 +067800 PERFORM PASS DB2034.2 +067900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +068000 ELSE PERFORM FAIL DB2034.2 +068100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +068200 PERFORM GEN-WRITE. DB2034.2 +068300 START-TEST-1-INIT. DB2034.2 +068400 MOVE SPACES TO ITEM-1. DB2034.2 +068500 MOVE 0 TO KEY-1. DB2034.2 +068600 MOVE "START-TEST-1" TO PAR-NAME. DB2034.2 +068700 MOVE "DEBUG START FILENAME" TO FEATURE. DB2034.2 +068800 START-TEST-1. DB2034.2 +068900 MOVE "05" TO IND-KEY. DB2034.2 +069000 START IND-FILE KEY IS GREATER THAN IND-KEY DB2034.2 +069100 INVALID KEY GO TO ABORT-PGM. DB2034.2 +069200 IF KEY-1 IS EQUAL TO 1 DB2034.2 +069300 PERFORM PASS DB2034.2 +069400 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +069500 PERFORM GEN-WRITE DB2034.2 +069600 GO TO START-TEST-1A DB2034.2 +069700 ELSE PERFORM FAIL DB2034.2 +069800 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 +069900 PERFORM GEN-WRITE DB2034.2 +070000 PERFORM DELETE-START-TEST-1-SUBTEST DB2034.2 +070100 GO TO START-TEST-2-INIT. DB2034.2 +070200 START-TEST-1-DELETE. DB2034.2 +070300 PERFORM DE-LETE. DB2034.2 +070400 PERFORM GEN-WRITE. DB2034.2 +070500 PERFORM DELETE-START-TEST-1-SUBTEST. DB2034.2 +070600 GO TO START-TEST-2-INIT. DB2034.2 +070700 DELETE-START-TEST-1-SUBTEST. DB2034.2 +070800 MOVE "START-TEST-1A" TO PAR-NAME. DB2034.2 +070900 PERFORM DE-LETE. DB2034.2 +071000 PERFORM GEN-WRITE. DB2034.2 +071100 START-TEST-1A. DB2034.2 +071200 MOVE "START-TEST-1A" TO PAR-NAME. DB2034.2 +071300 IF CONTENTS-1 IS EQUAL TO SPACES DB2034.2 +071400 PERFORM PASS DB2034.2 +071500 ELSE PERFORM FAIL DB2034.2 +071600 MOVE CONTENTS-1 TO COMPUTED-A DB2034.2 +071700 MOVE "(SPACES)" TO CORRECT-A. DB2034.2 +071800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 +071900 PERFORM GEN-WRITE. DB2034.2 +072000 START-TEST-2-INIT. DB2034.2 +072100 MOVE 0 TO KEY-1. DB2034.2 +072200 MOVE "START-TEST-2" TO PAR-NAME. DB2034.2 +072300 MOVE "DEBUG START INV KEY" TO FEATURE. DB2034.2 +072400 START-TEST-2. DB2034.2 +072500 MOVE "12" TO IND-KEY. DB2034.2 +072600 START IND-FILE KEY IS GREATER THAN IND-KEY DB2034.2 +072700 INVALID KEY GO TO START-TEST-2-CONT. DB2034.2 +072800 START-TEST-2-DELETE. DB2034.2 +072900 PERFORM DE-LETE. DB2034.2 +073000 PERFORM GEN-WRITE. DB2034.2 +073100 GO TO DELETE-TEST-1-INIT. DB2034.2 +073200 START-TEST-2-CONT. DB2034.2 +073300 IF KEY-1 IS EQUAL TO 1 DB2034.2 +073400 PERFORM PASS DB2034.2 +073500 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +073600 ELSE PERFORM FAIL DB2034.2 +073700 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +073800 PERFORM GEN-WRITE. DB2034.2 +073900 DELETE-TEST-1-INIT. DB2034.2 +074000 MOVE SPACES TO ITEM-1. DB2034.2 +074100 MOVE 0 TO KEY-1. DB2034.2 +074200 MOVE "DELETE-TEST-1" TO PAR-NAME. DB2034.2 +074300 MOVE "DEBUG DELETE FILE" TO FEATURE. DB2034.2 +074400 DELETE-TEST-1. DB2034.2 +074500 MOVE "06" TO IND-KEY. DB2034.2 +074600 DELETE IND-FILE INVALID KEY GO TO ABORT-PGM. DB2034.2 +074700 IF KEY-1 IS EQUAL TO 1 DB2034.2 +074800 PERFORM PASS DB2034.2 +074900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +075000 PERFORM GEN-WRITE DB2034.2 +075100 GO TO DELETE-TEST-1A DB2034.2 +075200 ELSE PERFORM FAIL DB2034.2 +075300 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 +075400 PERFORM GEN-WRITE DB2034.2 +075500 PERFORM DELETE-DELETE-TEST-1-SUBTEST DB2034.2 +075600 GO TO DELETE-TEST-2-INIT. DB2034.2 +075700 DELETE-TEST-1-DELETE. DB2034.2 +075800 PERFORM DE-LETE. DB2034.2 +075900 PERFORM GEN-WRITE. DB2034.2 +076000 PERFORM DELETE-DELETE-TEST-1-SUBTEST. DB2034.2 +076100 GO TO DELETE-TEST-2-INIT. DB2034.2 +076200 DELETE-DELETE-TEST-1-SUBTEST. DB2034.2 +076300 MOVE "DELETE-TEST-1A" TO PAR-NAME. DB2034.2 +076400 PERFORM DE-LETE. DB2034.2 +076500 PERFORM GEN-WRITE. DB2034.2 +076600 DELETE-TEST-1A. DB2034.2 +076700 MOVE "DELETE-TEST-1A" TO PAR-NAME. DB2034.2 +076800 IF CONTENTS-1 IS EQUAL TO SPACES DB2034.2 +076900 PERFORM PASS DB2034.2 +077000 ELSE PERFORM FAIL DB2034.2 +077100 MOVE "(SPACES)" TO CORRECT-A DB2034.2 +077200 MOVE CONTENTS-1 TO COMPUTED-A. DB2034.2 +077300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 +077400 PERFORM GEN-WRITE. DB2034.2 +077500 DELETE-TEST-2-INIT. DB2034.2 +077600 MOVE "DELETE-TEST-2" TO PAR-NAME. DB2034.2 +077700 MOVE "DEBUG DELETE INV KEY" TO FEATURE. DB2034.2 +077800 MOVE 0 TO KEY-1. DB2034.2 +077900 DELETE-TEST-2. DB2034.2 +078000 MOVE "07" TO IND-KEY. DB2034.2 +078100 DELETE IND-FILE INVALID KEY GO TO DELETE-TEST-2-CONT. DB2034.2 +078200 DELETE-TEST-2-DELETE. DB2034.2 +078300 PERFORM DE-LETE. DB2034.2 +078400 PERFORM GEN-WRITE. DB2034.2 +078500 GO TO CLOSE-IND-FILE. DB2034.2 +078600 DELETE-TEST-2-CONT. DB2034.2 +078700 IF KEY-1 IS EQUAL TO 1 DB2034.2 +078800 PERFORM PASS DB2034.2 +078900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 +079000 ELSE PERFORM FAIL DB2034.2 +079100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 +079200 PERFORM GEN-WRITE. DB2034.2 +079300 GO TO CLOSE-IND-FILE. DB2034.2 +079400 GEN-WRITE. DB2034.2 +079500 PERFORM PRINT-DETAIL. DB2034.2 +079600 ABORT-PGM. DB2034.2 +079700 DISPLAY "INDEXED I-O MODULE - FILE HANDLING ERROR - PROGRAM ADB2034.2 +079800- "BORTED." UPON THE-SYSTEM-PRINTER. DB2034.2 +079900 CLOSE-IND-FILE. DB2034.2 +080000 CLOSE IND-FILE. DB2034.2 +080100XOPEN-IND-FILE. DB2034.2 +080200X OPEN INPUT IND-FILE. DB2034.2 +080300X MOVE SPACES TO PRINT-REC. DB2034.2 +080400X PERFORM WRITE-LINE. DB2034.2 +080500X MOVE " DUMP OF IND-FILE FOLLOWS" TO PRINT-REC. DB2034.2 +080600X PERFORM WRITE-LINE. DB2034.2 +080700XREAD-IND-FILE. DB2034.2 +080800X READ IND-FILE NEXT RECORD AT END GO TO CLOSE-FILE-DUMP. DB2034.2 +080900X MOVE IND-REC-1H TO PRINT-REC. DB2034.2 +081000X PERFORM WRITE-LINE. DB2034.2 +081100X MOVE IND-REC-2H TO PRINT-REC. DB2034.2 +081200X PERFORM WRITE-LINE. DB2034.2 +081300X GO TO READ-IND-FILE. DB2034.2 +081400XCLOSE-FILE-DUMP. DB2034.2 +081500X CLOSE IND-FILE. DB2034.2 +081600 CCVS-EXIT SECTION. DB2034.2 +081700 CCVS-999999. DB2034.2 +081800 GO TO CLOSE-FILES. DB2034.2 +*END-OF,DB203A +*HEADER,COBOL,DB204A +000100 IDENTIFICATION DIVISION. DB2044.2 +000200 PROGRAM-ID. DB2044.2 +000300 DB204A. DB2044.2 +000400 AUTHOR. DB2044.2 +000500 FEDERAL COMPILER TESTING CENTER. DB2044.2 +000600 INSTALLATION. DB2044.2 +000700 GENERAL SERVICES ADMINISTRATION DB2044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB2044.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB2044.2 +001100 FALLS CHURCH VIRGINIA 22041. DB2044.2 +001200 DB2044.2 +001300 PHONE (703) 756-6153 DB2044.2 +001400 DB2044.2 +001500 " HIGH ". DB2044.2 +001600 DATE-WRITTEN. DB2044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2044.2 +001800 CREATION DATE / VALIDATION DATE DB2044.2 +001900 "4.2 ". DB2044.2 +002000 SECURITY. DB2044.2 +002100 NONE. DB2044.2 +002200* DB2044.2 +002300* * * * * * * * * * * * * * * * * * * * * *DB2044.2 +002400* DB2044.2 +002500* PROGRAM ABSTRACT DB2044.2 +002600* DB2044.2 +002700* DB204A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE A DB2044.2 +002800* DEBUGGING PROCEDURE WHICH IS MONITORING A "MERGE OUTPUT" DB2044.2 +002900* PROCEDURE. THIS PROGRAM IS TO BE COMPILED AND EXECUTED DB2044.2 +003000* WITH BOTH COMPILE AND OBJECT TIME DEBUGGING SWITCHES ON. DB2044.2 +003100* THE DEBUGGING PROCEDURE SHOULD BE INCLUDED IN COMPILATION DB2044.2 +003200* AND GENERATE CODE. DURING EXECUTION, TWO SEQUENTIAL FILES DB2044.2 +003300* ARE CREATED WITH EACH CONTAINING 80-CHARACTER RECORDS IN DB2044.2 +003400* SORTED ORDER. THE TWO FILES ARE THEN MERGED. EXECUTION DB2044.2 +003500* OF THE MERGE OPERATION SHOULD TRIGGER THE DEBUGGING PRO- DB2044.2 +003600* CEDURE LINKED TO THE MERGE OUTPUT PROCEDURE-NAME. DB2044.2 +003700* DB2044.2 +003800* DB2044.2 +003900* DB2044.2 +004000 ENVIRONMENT DIVISION. DB2044.2 +004100 CONFIGURATION SECTION. DB2044.2 +004200 SOURCE-COMPUTER. DB2044.2 +004300 XXXXX082 DB2044.2 +004400 WITH DEBUGGING MODE. DB2044.2 +004500 OBJECT-COMPUTER. DB2044.2 +004600 XXXXX083. DB2044.2 +004700 INPUT-OUTPUT SECTION. DB2044.2 +004800 FILE-CONTROL. DB2044.2 +004900 SELECT PRINT-FILE ASSIGN TO DB2044.2 +005000 XXXXX055. DB2044.2 +005100 SELECT SQ-FS1 ASSIGN TO DB2044.2 +005200 XXXXX014. DB2044.2 +005300 SELECT SQ-FS2 ASSIGN TO DB2044.2 +005400 XXXXX015. DB2044.2 +005500 SELECT SQ-FS3 ASSIGN TO DB2044.2 +005600 XXXXX016. DB2044.2 +005700 SELECT ST-FS4 ASSIGN TO DB2044.2 +005800 XXXXX027. DB2044.2 +005900 DATA DIVISION. DB2044.2 +006000 FILE SECTION. DB2044.2 +006100 FD PRINT-FILE DB2044.2 +006200 LABEL RECORDS DB2044.2 +006300 XXXXX084 DB2044.2 +006400 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2044.2 +006500 01 PRINT-REC PICTURE X(120). DB2044.2 +006600 01 DUMMY-RECORD PICTURE X(120). DB2044.2 +006700 FD SQ-FS1 DB2044.2 +006800C VALUE OF DB2044.2 +006900C XXXXX074 DB2044.2 +007000* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2 +007100C IS DB2044.2 +007200C XXXXX075 DB2044.2 +007300* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2 +007400G XXXXX069 DB2044.2 +007500* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2 +007600 LABEL RECORDS ARE STANDARD. DB2044.2 +007700 01 REC-1 PIC X(120). DB2044.2 +007800 FD SQ-FS2 DB2044.2 +007900C VALUE OF DB2044.2 +008000C XXXXX074 DB2044.2 +008100* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2 +008200C IS DB2044.2 +008300C XXXXX076 DB2044.2 +008400* XXXXX076 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2 +008500G XXXXX069 DB2044.2 +008600* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2 +008700 LABEL RECORDS ARE STANDARD. DB2044.2 +008800 01 REC-2 PIC X(120). DB2044.2 +008900 FD SQ-FS3 DB2044.2 +009000C VALUE OF DB2044.2 +009100C XXXXX074 DB2044.2 +009200* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2 +009300C IS DB2044.2 +009400C XXXXX077 DB2044.2 +009500* XXXXX077 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2 +009600G XXXXX069 DB2044.2 +009700* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2 +009800 LABEL RECORDS ARE STANDARD. DB2044.2 +009900 01 REC-3 PIC X(120). DB2044.2 +010000 SD ST-FS4. DB2044.2 +010100 01 REC-4. DB2044.2 +010200 02 FILLER PIC X(34). DB2044.2 +010300 02 SORT-KEY PIC X(6). DB2044.2 +010400 02 FILLER PIC X(80). DB2044.2 +010500 WORKING-STORAGE SECTION. DB2044.2 +010600 01 ITEM-1. DB2044.2 +010700 02 KEY-1 PIC 99. DB2044.2 +010800 02 LINE-1 PIC X(6). DB2044.2 +010900 02 NAME-1 PIC X(30). DB2044.2 +011000 02 UNQUAL-NAME-1 PIC X(30). DB2044.2 +011100 02 CONTENTS-1 PIC X(30). DB2044.2 +011200 01 FILE-RECORD-INFORMATION-REC. DB2044.2 +011300 03 FILE-RECORD-INFO-SKELETON. DB2044.2 +011400 05 FILLER PICTURE X(48) VALUE DB2044.2 +011500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB2044.2 +011600 05 FILLER PICTURE X(46) VALUE DB2044.2 +011700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB2044.2 +011800 05 FILLER PICTURE X(26) VALUE DB2044.2 +011900 ",LFIL=000000,ORG= ,LBLR= ". DB2044.2 +012000 05 FILLER PICTURE X(37) VALUE DB2044.2 +012100 ",RECKEY= ". DB2044.2 +012200 05 FILLER PICTURE X(38) VALUE DB2044.2 +012300 ",ALTKEY1= ". DB2044.2 +012400 05 FILLER PICTURE X(38) VALUE DB2044.2 +012500 ",ALTKEY2= ". DB2044.2 +012600 05 FILLER PICTURE X(7) VALUE SPACE.DB2044.2 +012700 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB2044.2 +012800 05 FILE-RECORD-INFO-P1-120. DB2044.2 +012900 07 FILLER PIC X(5). DB2044.2 +013000 07 XFILE-NAME PIC X(6). DB2044.2 +013100 07 FILLER PIC X(8). DB2044.2 +013200 07 XRECORD-NAME PIC X(6). DB2044.2 +013300 07 FILLER PIC X(1). DB2044.2 +013400 07 REELUNIT-NUMBER PIC 9(1). DB2044.2 +013500 07 FILLER PIC X(7). DB2044.2 +013600 07 XRECORD-NUMBER PIC 9(6). DB2044.2 +013700 07 FILLER PIC X(6). DB2044.2 +013800 07 UPDATE-NUMBER PIC 9(2). DB2044.2 +013900 07 FILLER PIC X(5). DB2044.2 +014000 07 ODO-NUMBER PIC 9(4). DB2044.2 +014100 07 FILLER PIC X(5). DB2044.2 +014200 07 XPROGRAM-NAME PIC X(5). DB2044.2 +014300 07 FILLER PIC X(7). DB2044.2 +014400 07 XRECORD-LENGTH PIC 9(6). DB2044.2 +014500 07 FILLER PIC X(7). DB2044.2 +014600 07 CHARS-OR-RECORDS PIC X(2). DB2044.2 +014700 07 FILLER PIC X(1). DB2044.2 +014800 07 XBLOCK-SIZE PIC 9(4). DB2044.2 +014900 07 FILLER PIC X(6). DB2044.2 +015000 07 RECORDS-IN-FILE PIC 9(6). DB2044.2 +015100 07 FILLER PIC X(5). DB2044.2 +015200 07 XFILE-ORGANIZATION PIC X(2). DB2044.2 +015300 07 FILLER PIC X(6). DB2044.2 +015400 07 XLABEL-TYPE PIC X(1). DB2044.2 +015500 05 FILE-RECORD-INFO-P121-240. DB2044.2 +015600 07 FILLER PIC X(8). DB2044.2 +015700 07 XRECORD-KEY PIC X(29). DB2044.2 +015800 07 FILLER PIC X(9). DB2044.2 +015900 07 ALTERNATE-KEY1 PIC X(29). DB2044.2 +016000 07 FILLER PIC X(9). DB2044.2 +016100 07 ALTERNATE-KEY2 PIC X(29). DB2044.2 +016200 07 FILLER PIC X(7). DB2044.2 +016300 01 TEST-RESULTS. DB2044.2 +016400 02 FILLER PICTURE X VALUE SPACE. DB2044.2 +016500 02 FEATURE PICTURE X(20) VALUE SPACE. DB2044.2 +016600 02 FILLER PICTURE X VALUE SPACE. DB2044.2 +016700 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2044.2 +016800 02 FILLER PICTURE X VALUE SPACE. DB2044.2 +016900 02 PAR-NAME. DB2044.2 +017000 03 FILLER PICTURE X(12) VALUE SPACE. DB2044.2 +017100 03 PARDOT-X PICTURE X VALUE SPACE. DB2044.2 +017200 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2044.2 +017300 03 FILLER PIC X(5) VALUE SPACE. DB2044.2 +017400 02 FILLER PIC X(10) VALUE SPACE. DB2044.2 +017500 02 RE-MARK PIC X(61). DB2044.2 +017600 01 TEST-COMPUTED. DB2044.2 +017700 02 FILLER PIC X(30) VALUE SPACE. DB2044.2 +017800 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2044.2 +017900 02 COMPUTED-X. DB2044.2 +018000 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2044.2 +018100 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2044.2 +018200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2044.2 +018300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2044.2 +018400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2044.2 +018500 03 CM-18V0 REDEFINES COMPUTED-A. DB2044.2 +018600 04 COMPUTED-18V0 PICTURE -9(18). DB2044.2 +018700 04 FILLER PICTURE X. DB2044.2 +018800 03 FILLER PIC X(50) VALUE SPACE. DB2044.2 +018900 01 TEST-CORRECT. DB2044.2 +019000 02 FILLER PIC X(30) VALUE SPACE. DB2044.2 +019100 02 FILLER PIC X(17) VALUE " CORRECT =". DB2044.2 +019200 02 CORRECT-X. DB2044.2 +019300 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2044.2 +019400 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2044.2 +019500 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2044.2 +019600 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2044.2 +019700 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2044.2 +019800 03 CR-18V0 REDEFINES CORRECT-A. DB2044.2 +019900 04 CORRECT-18V0 PICTURE -9(18). DB2044.2 +020000 04 FILLER PICTURE X. DB2044.2 +020100 03 FILLER PIC X(50) VALUE SPACE. DB2044.2 +020200 01 CCVS-C-1. DB2044.2 +020300 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2044.2 +020400- "SS PARAGRAPH-NAME DB2044.2 +020500- " REMARKS". DB2044.2 +020600 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2044.2 +020700 01 CCVS-C-2. DB2044.2 +020800 02 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2 +020900 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2044.2 +021000 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2044.2 +021100 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2044.2 +021200 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2044.2 +021300 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2044.2 +021400 01 REC-CT PICTURE 99 VALUE ZERO. DB2044.2 +021500 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2044.2 +021600 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2044.2 +021700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2044.2 +021800 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2044.2 +021900 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2044.2 +022000 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2044.2 +022100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2044.2 +022200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2044.2 +022300 01 CCVS-H-1. DB2044.2 +022400 02 FILLER PICTURE X(27) VALUE SPACE. DB2044.2 +022500 02 FILLER PICTURE X(67) VALUE DB2044.2 +022600 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2044.2 +022700- " SYSTEM". DB2044.2 +022800 02 FILLER PICTURE X(26) VALUE SPACE. DB2044.2 +022900 01 CCVS-H-2. DB2044.2 +023000 02 FILLER PICTURE X(52) VALUE IS DB2044.2 +023100 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2044.2 +023200 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2044.2 +023300 02 TEST-ID PICTURE IS X(9). DB2044.2 +023400 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2044.2 +023500 01 CCVS-H-3. DB2044.2 +023600 02 FILLER PICTURE X(34) VALUE DB2044.2 +023700 " FOR OFFICIAL USE ONLY ". DB2044.2 +023800 02 FILLER PICTURE X(58) VALUE DB2044.2 +023900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2044.2 +024000 02 FILLER PICTURE X(28) VALUE DB2044.2 +024100 " COPYRIGHT 1974 ". DB2044.2 +024200 01 CCVS-E-1. DB2044.2 +024300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2044.2 +024400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2044.2 +024500 02 ID-AGAIN PICTURE IS X(9). DB2044.2 +024600 02 FILLER PICTURE X(45) VALUE IS DB2044.2 +024700 " NTIS DISTRIBUTION COBOL 74". DB2044.2 +024800 01 CCVS-E-2. DB2044.2 +024900 02 FILLER PICTURE X(31) VALUE DB2044.2 +025000 SPACE. DB2044.2 +025100 02 FILLER PICTURE X(21) VALUE SPACE. DB2044.2 +025200 02 CCVS-E-2-2. DB2044.2 +025300 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2044.2 +025400 03 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2 +025500 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2044.2 +025600 01 CCVS-E-3. DB2044.2 +025700 02 FILLER PICTURE X(22) VALUE DB2044.2 +025800 " FOR OFFICIAL USE ONLY". DB2044.2 +025900 02 FILLER PICTURE X(12) VALUE SPACE. DB2044.2 +026000 02 FILLER PICTURE X(58) VALUE DB2044.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2044.2 +026200 02 FILLER PICTURE X(13) VALUE SPACE. DB2044.2 +026300 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2044.2 +026400 01 CCVS-E-4. DB2044.2 +026500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2044.2 +026600 02 FILLER PIC XXXX VALUE " OF ". DB2044.2 +026700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2044.2 +026800 02 FILLER PIC X(40) VALUE DB2044.2 +026900 " TESTS WERE EXECUTED SUCCESSFULLY". DB2044.2 +027000 01 XXINFO. DB2044.2 +027100 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2044.2 +027200 02 INFO-TEXT. DB2044.2 +027300 04 FILLER PIC X(20) VALUE SPACE. DB2044.2 +027400 04 XXCOMPUTED PIC X(20). DB2044.2 +027500 04 FILLER PIC X(5) VALUE SPACE. DB2044.2 +027600 04 XXCORRECT PIC X(20). DB2044.2 +027700 01 HYPHEN-LINE. DB2044.2 +027800 02 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2 +027900 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2044.2 +028000- "*****************************************". DB2044.2 +028100 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2044.2 +028200- "******************************". DB2044.2 +028300 01 CCVS-PGM-ID PIC X(6) VALUE DB2044.2 +028400 "DB204A". DB2044.2 +028500 PROCEDURE DIVISION. DB2044.2 +028600 DECLARATIVES. DB2044.2 +028700 MERGE-PROC SECTION. DB2044.2 +028800 USE FOR DEBUGGING ON MERGE-OUTPUT-PROC. DB2044.2 +028900 MERGE-1. DB2044.2 +029000 ADD 1 TO KEY-1. DB2044.2 +029100 MOVE DEBUG-LINE TO LINE-1. DB2044.2 +029200 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2044.2 +029300 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2044.2 +029400 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS BY SPACES DB2044.2 +029500 AFTER INITIAL SPACE. DB2044.2 +029600 END DECLARATIVES. DB2044.2 +029700 CCVS1 SECTION. DB2044.2 +029800 OPEN-FILES. DB2044.2 +029900 OPEN OUTPUT PRINT-FILE. DB2044.2 +030000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2044.2 +030100 MOVE SPACE TO TEST-RESULTS. DB2044.2 +030200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2044.2 +030300 GO TO CCVS1-EXIT. DB2044.2 +030400 CLOSE-FILES. DB2044.2 +030500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2044.2 +030600 TERMINATE-CCVS. DB2044.2 +030700S EXIT PROGRAM. DB2044.2 +030800STERMINATE-CALL. DB2044.2 +030900 STOP RUN. DB2044.2 +031000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2044.2 +031100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2044.2 +031200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2044.2 +031300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2044.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. DB2044.2 +031500 PRINT-DETAIL. DB2044.2 +031600 IF REC-CT NOT EQUAL TO ZERO DB2044.2 +031700 MOVE "." TO PARDOT-X DB2044.2 +031800 MOVE REC-CT TO DOTVALUE. DB2044.2 +031900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2044.2 +032000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2044.2 +032100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2044.2 +032200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2044.2 +032300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2044.2 +032400 MOVE SPACE TO CORRECT-X. DB2044.2 +032500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2044.2 +032600 MOVE SPACE TO RE-MARK. DB2044.2 +032700 HEAD-ROUTINE. DB2044.2 +032800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2 +032900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2044.2 +033000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2044.2 +033100 COLUMN-NAMES-ROUTINE. DB2044.2 +033200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2 +033300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2 +033500 END-ROUTINE. DB2044.2 +033600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2044.2 +033700 END-RTN-EXIT. DB2044.2 +033800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2 +033900 END-ROUTINE-1. DB2044.2 +034000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2044.2 +034100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2044.2 +034200 ADD PASS-COUNTER TO ERROR-HOLD. DB2044.2 +034300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2044.2 +034400 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2044.2 +034500 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2044.2 +034600 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2044.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2044.2 +034800 END-ROUTINE-12. DB2044.2 +034900 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2044.2 +035000 IF ERROR-COUNTER IS EQUAL TO ZERO DB2044.2 +035100 MOVE "NO " TO ERROR-TOTAL DB2044.2 +035200 ELSE DB2044.2 +035300 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2044.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2044.2 +035500 PERFORM WRITE-LINE. DB2044.2 +035600 END-ROUTINE-13. DB2044.2 +035700 IF DELETE-CNT IS EQUAL TO ZERO DB2044.2 +035800 MOVE "NO " TO ERROR-TOTAL ELSE DB2044.2 +035900 MOVE DELETE-CNT TO ERROR-TOTAL. DB2044.2 +036000 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2044.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2 +036200 IF INSPECT-COUNTER EQUAL TO ZERO DB2044.2 +036300 MOVE "NO " TO ERROR-TOTAL DB2044.2 +036400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2044.2 +036500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2044.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2 +036700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2 +036800 WRITE-LINE. DB2044.2 +036900 ADD 1 TO RECORD-COUNT. DB2044.2 +037000Y IF RECORD-COUNT GREATER 50 DB2044.2 +037100Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB2044.2 +037200Y MOVE SPACE TO DUMMY-RECORD DB2044.2 +037300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2044.2 +037400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2044.2 +037500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2044.2 +037600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2044.2 +037700Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB2044.2 +037800Y MOVE ZERO TO RECORD-COUNT. DB2044.2 +037900 PERFORM WRT-LN. DB2044.2 +038000 WRT-LN. DB2044.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2044.2 +038200 MOVE SPACE TO DUMMY-RECORD. DB2044.2 +038300 BLANK-LINE-PRINT. DB2044.2 +038400 PERFORM WRT-LN. DB2044.2 +038500 FAIL-ROUTINE. DB2044.2 +038600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2044.2 +038700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2044.2 +038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2044.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2 +039000 GO TO FAIL-ROUTINE-EX. DB2044.2 +039100 FAIL-ROUTINE-WRITE. DB2044.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2044.2 +039300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2044.2 +039400 FAIL-ROUTINE-EX. EXIT. DB2044.2 +039500 BAIL-OUT. DB2044.2 +039600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2044.2 +039700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2044.2 +039800 BAIL-OUT-WRITE. DB2044.2 +039900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2044.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2 +040100 BAIL-OUT-EX. EXIT. DB2044.2 +040200 CCVS1-EXIT. DB2044.2 +040300 EXIT. DB2044.2 +040400 CREATE-INPUT-FILES SECTION. DB2044.2 +040500 SET-UP-REC-AREAS. DB2044.2 +040600 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1) DB2044.2 +040700 FILE-RECORD-INFO (2). DB2044.2 +040800 MOVE "SQ-FS1" TO XFILE-NAME (1). DB2044.2 +040900 MOVE "SQ-FS2" TO XFILE-NAME (2). DB2044.2 +041000 MOVE "REC-1" TO XRECORD-NAME (1). DB2044.2 +041100 MOVE "REC-2" TO XRECORD-NAME (2). DB2044.2 +041200 MOVE ".XXX." TO XPROGRAM-NAME (1) DB2044.2 +041300 XPROGRAM-NAME (2). DB2044.2 +041400 MOVE 120 TO XRECORD-LENGTH (1) DB2044.2 +041500 XRECORD-LENGTH (2). DB2044.2 +041600 MOVE "RC" TO CHARS-OR-RECORDS (1) DB2044.2 +041700 CHARS-OR-RECORDS (2). DB2044.2 +041800 MOVE 1 TO XBLOCK-SIZE (1) DB2044.2 +041900 XBLOCK-SIZE (2). DB2044.2 +042000 MOVE 10 TO RECORDS-IN-FILE (1) DB2044.2 +042100 RECORDS-IN-FILE (2). DB2044.2 +042200 MOVE "SQ" TO XFILE-ORGANIZATION (1) DB2044.2 +042300 XFILE-ORGANIZATION (2). DB2044.2 +042400 MOVE "S" TO XLABEL-TYPE (1) DB2044.2 +042500 XLABEL-TYPE (2). DB2044.2 +042600 OPEN OUTPUT SQ-FS1 SQ-FS2. DB2044.2 +042700 WRITE-FILES. DB2044.2 +042800 MOVE 1 TO XRECORD-NUMBER (1). DB2044.2 +042900 MOVE 2 TO XRECORD-NUMBER (2). DB2044.2 +043000 PERFORM WRITE-FILES-SUBROUTINE 10 TIMES. DB2044.2 +043100 CLOSE SQ-FS1 SQ-FS2. DB2044.2 +043200 GO TO BEGIN-DB204A-TESTS. DB2044.2 +043300 WRITE-FILES-SUBROUTINE. DB2044.2 +043400 MOVE FILE-RECORD-INFO (1) TO REC-1. DB2044.2 +043500 WRITE REC-1. DB2044.2 +043600 ADD 2 TO XRECORD-NUMBER (1). DB2044.2 +043700 MOVE FILE-RECORD-INFO (2) TO REC-2. DB2044.2 +043800 WRITE REC-2. DB2044.2 +043900 ADD 2 TO XRECORD-NUMBER (2). DB2044.2 +044000 BEGIN-DB204A-TESTS SECTION. DB2044.2 +044100 MERGE-TEST-INIT. DB2044.2 +044200 MOVE "MERGE-TEST" TO PAR-NAME. DB2044.2 +044300 MOVE "MERGE OUTPUT PROC" TO FEATURE. DB2044.2 +044400 MOVE SPACES TO ITEM-1. DB2044.2 +044500 MOVE 0 TO KEY-1. DB2044.2 +044600******************************************************************DB2044.2 +044700* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2044.2 +044800* "MERGE-TEST-A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2044.2 +044900* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "MERGE *DB2044.2 +045000* ST-FS4 ON ASCENDING KEY SORT-KEY USING SQ-FS1 SQ-FS2 *DB2044.2 +045100* OUTPUT PROCEDURE IS MERGE-OUTPUT-PROC.". *DB2044.2 +045200******************************************************************DB2044.2 +045300 MERGE-TEST. DB2044.2 +045400 MERGE ST-FS4 ON ASCENDING KEY SORT-KEY DB2044.2 +045500 USING SQ-FS1 SQ-FS2 DB2044.2 +045600 OUTPUT PROCEDURE IS MERGE-OUTPUT-PROC. DB2044.2 +045700 IF KEY-1 IS EQUAL TO 1 DB2044.2 +045800 PERFORM PASS DB2044.2 +045900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2044.2 +046000 ELSE PERFORM FAIL DB2044.2 +046100 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2044.2 +046200 MOVE 1 TO CORRECT-18V0 DB2044.2 +046300 MOVE KEY-1 TO COMPUTED-18V0. DB2044.2 +046400 PERFORM PRINT-DETAIL DB2044.2 +046500 IF KEY-1 IS EQUAL TO 0 DB2044.2 +046600 PERFORM DELETE-MERGE-TEST-SUBTESTS DB2044.2 +046700 GO TO END-OF-DB204A DB2044.2 +046800 ELSE GO TO MERGE-TEST-A. DB2044.2 +046900 MERGE-TEST-DELETE. DB2044.2 +047000 PERFORM DE-LETE. DB2044.2 +047100 PERFORM PRINT-DETAIL. DB2044.2 +047200 PERFORM DELETE-MERGE-TEST-SUBTESTS. DB2044.2 +047300 GO TO END-OF-DB204A. DB2044.2 +047400 DELETE-MERGE-TEST-SUBTESTS. DB2044.2 +047500 MOVE "MERGE-TEST-A" TO PAR-NAME. DB2044.2 +047600 PERFORM DE-LETE. DB2044.2 +047700 PERFORM PRINT-DETAIL. DB2044.2 +047800 MOVE "MERGE-TEST-B" TO PAR-NAME. DB2044.2 +047900 PERFORM DE-LETE. DB2044.2 +048000 PERFORM PRINT-DETAIL. DB2044.2 +048100 MOVE "MERGE-TEST-C" TO PAR-NAME. DB2044.2 +048200 PERFORM DE-LETE. DB2044.2 +048300 PERFORM PRINT-DETAIL. DB2044.2 +048400 MERGE-TEST-A. DB2044.2 +048500 MOVE "MERGE-TEST-A" TO PAR-NAME. DB2044.2 +048600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2044.2 +048700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2044.2 +048800 MOVE LINE-1 TO COMPUTED-A. DB2044.2 +048900 PERFORM INSPT. DB2044.2 +049000 PERFORM PRINT-DETAIL. DB2044.2 +049100 MERGE-TEST-B. DB2044.2 +049200 MOVE "MERGE-TEST-B" TO PAR-NAME. DB2044.2 +049300 IF UNQUAL-NAME-1 IS EQUAL TO "MERGE-OUTPUT-PROC" DB2044.2 +049400 PERFORM PASS DB2044.2 +049500 ELSE PERFORM FAIL DB2044.2 +049600 MOVE "MERGE-OUTPUT-PROC" TO CORRECT-A DB2044.2 +049700 MOVE NAME-1 TO COMPUTED-A. DB2044.2 +049800 MOVE "DEBUG-NAME" TO RE-MARK DB2044.2 +049900 PERFORM PRINT-DETAIL. DB2044.2 +050000 MERGE-TEST-C. DB2044.2 +050100 MOVE "MERGE-TEST-C" TO PAR-NAME. DB2044.2 +050200 IF CONTENTS-1 IS EQUAL TO "MERGE OUTPUT" DB2044.2 +050300 PERFORM PASS DB2044.2 +050400 ELSE PERFORM FAIL DB2044.2 +050500 MOVE "MERGE OUTPUT" TO CORRECT-A DB2044.2 +050600 MOVE CONTENTS-1 TO COMPUTED-A. DB2044.2 +050700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2044.2 +050800 PERFORM PRINT-DETAIL. DB2044.2 +050900 GO TO END-OF-DB204A. DB2044.2 +051000 MERGE-OUTPUT-PROC SECTION. DB2044.2 +051100 OPEN-OUTPUT-FILE. DB2044.2 +051200 OPEN OUTPUT SQ-FS3. DB2044.2 +051300 RETURN-RECORDS. DB2044.2 +051400 RETURN ST-FS4 RECORD INTO REC-3 DB2044.2 +051500 AT END GO TO CLOSE-OUTPUT-FILE. DB2044.2 +051600 WRITE REC-3. DB2044.2 +051700 GO TO RETURN-RECORDS. DB2044.2 +051800 CLOSE-OUTPUT-FILE. DB2044.2 +051900 CLOSE SQ-FS3. DB2044.2 +052000 END-OF-DB204A SECTION. DB2044.2 +052100XDUMP-SQ-FS1. DB2044.2 +052200X OPEN INPUT SQ-FS1. DB2044.2 +052300X MOVE "DUMP OF SQ-FS1 FOLLOWS:" TO PRINT-REC. DB2044.2 +052400X PERFORM WRITE-LINE. DB2044.2 +052500XREAD-SQ-FS1. DB2044.2 +052600X READ SQ-FS1 AT END GO TO DUMP-SQ-FS2. DB2044.2 +052700X MOVE REC-1 TO PRINT-REC. DB2044.2 +052800X PERFORM WRITE-LINE. DB2044.2 +052900X GO TO READ-SQ-FS1. DB2044.2 +053000XDUMP-SQ-FS2. DB2044.2 +053100X CLOSE SQ-FS1. DB2044.2 +053200X OPEN INPUT SQ-FS2. DB2044.2 +053300X MOVE "DUMP OF SQ-FS2 FOLLOWS:" TO PRINT-REC. DB2044.2 +053400X PERFORM WRITE-LINE. DB2044.2 +053500XREAD-SQ-FS2. DB2044.2 +053600X READ SQ-FS2 AT END GO TO DUMP-SQ-FS3. DB2044.2 +053700X MOVE REC-2 TO PRINT-REC. DB2044.2 +053800X PERFORM WRITE-LINE. DB2044.2 +053900X GO TO READ-SQ-FS2. DB2044.2 +054000XDUMP-SQ-FS3. DB2044.2 +054100X CLOSE SQ-FS2. DB2044.2 +054200X OPEN INPUT SQ-FS3. DB2044.2 +054300X MOVE "DUMP OF SQ-FS3 FOLLOWS:" TO PRINT-REC. DB2044.2 +054400X PERFORM WRITE-LINE. DB2044.2 +054500XREAD-SQ-FS3. DB2044.2 +054600X READ SQ-FS3 AT END GO TO END-OF-TESTS. DB2044.2 +054700X MOVE REC-3 TO PRINT-REC. DB2044.2 +054800X PERFORM WRITE-LINE. DB2044.2 +054900X GO TO READ-SQ-FS3. DB2044.2 +055000 END-OF-TESTS. DB2044.2 +055100 EXIT. DB2044.2 +055200 CCVS-EXIT SECTION. DB2044.2 +055300 CCVS-999999. DB2044.2 +055400 GO TO CLOSE-FILES. DB2044.2 +*END-OF,DB204A +*HEADER,COBOL,DB205A +000100 IDENTIFICATION DIVISION. DB2054.2 +000200 PROGRAM-ID. DB2054.2 +000300 DB205A. DB2054.2 +000400 AUTHOR. DB2054.2 +000500 FEDERAL COMPILER TESTING CENTER. DB2054.2 +000600 INSTALLATION. DB2054.2 +000700 GENERAL SERVICES ADMINISTRATION DB2054.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2054.2 +000900 SOFTWARE DEVELOPMENT OFFICE. DB2054.2 +001000 5203 LEESBURG PIKE SUITE 1100 DB2054.2 +001100 FALLS CHURCH VIRGINIA 22041. DB2054.2 +001200 DB2054.2 +001300 PHONE (703) 756-6153 DB2054.2 +001400 DB2054.2 +001500 " HIGH ". DB2054.2 +001600 DATE-WRITTEN. DB2054.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2054.2 +001800 CREATION DATE / VALIDATION DATE DB2054.2 +001900 "4.2 ". DB2054.2 +002000 SECURITY. DB2054.2 +002100 NONE. DB2054.2 +002200* DB2054.2 +002300 ENVIRONMENT DIVISION. DB2054.2 +002400 CONFIGURATION SECTION. DB2054.2 +002500 SOURCE-COMPUTER. DB2054.2 +002600 XXXXX082 DB2054.2 +002700 WITH DEBUGGING MODE. DB2054.2 +002800 OBJECT-COMPUTER. DB2054.2 +002900 XXXXX083. DB2054.2 +003000 INPUT-OUTPUT SECTION. DB2054.2 +003100 FILE-CONTROL. DB2054.2 +003200 SELECT PRINT-FILE ASSIGN TO DB2054.2 +003300 XXXXX055. DB2054.2 +003400 DATA DIVISION. DB2054.2 +003500 FILE SECTION. DB2054.2 +003600 FD PRINT-FILE DB2054.2 +003700 LABEL RECORDS DB2054.2 +003800 XXXXX084 DB2054.2 +003900 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2054.2 +004000 01 PRINT-REC PICTURE X(120). DB2054.2 +004100 01 DUMMY-RECORD PICTURE X(120). DB2054.2 +004200 WORKING-STORAGE SECTION. DB2054.2 +004300 77 WORK-AREA PIC X(72). DB2054.2 +004400 01 ITEM-1. DB2054.2 +004500 02 KEY-1 PIC 99. DB2054.2 +004600 02 LINE-1 PIC X(6). DB2054.2 +004700 02 NAME-1 PIC X(30). DB2054.2 +004800 02 UNQUAL-NAME-1 PIC X(30). DB2054.2 +004900 02 CONTENTS-1 PIC X(87). DB2054.2 +005000 01 TEST-RESULTS. DB2054.2 +005100 02 FILLER PICTURE X VALUE SPACE. DB2054.2 +005200 02 FEATURE PICTURE X(20) VALUE SPACE. DB2054.2 +005300 02 FILLER PICTURE X VALUE SPACE. DB2054.2 +005400 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2054.2 +005500 02 FILLER PICTURE X VALUE SPACE. DB2054.2 +005600 02 PAR-NAME. DB2054.2 +005700 03 FILLER PICTURE X(12) VALUE SPACE. DB2054.2 +005800 03 PARDOT-X PICTURE X VALUE SPACE. DB2054.2 +005900 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2054.2 +006000 03 FILLER PIC X(5) VALUE SPACE. DB2054.2 +006100 02 FILLER PIC X(10) VALUE SPACE. DB2054.2 +006200 02 RE-MARK PIC X(61). DB2054.2 +006300 01 TEST-COMPUTED. DB2054.2 +006400 02 FILLER PIC X(30) VALUE SPACE. DB2054.2 +006500 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2054.2 +006600 02 COMPUTED-X. DB2054.2 +006700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2054.2 +006800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2054.2 +006900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2054.2 +007000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2054.2 +007100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2054.2 +007200 03 CM-18V0 REDEFINES COMPUTED-A. DB2054.2 +007300 04 COMPUTED-18V0 PICTURE -9(18). DB2054.2 +007400 04 FILLER PICTURE X. DB2054.2 +007500 03 FILLER PIC X(50) VALUE SPACE. DB2054.2 +007600 01 TEST-CORRECT. DB2054.2 +007700 02 FILLER PIC X(30) VALUE SPACE. DB2054.2 +007800 02 FILLER PIC X(17) VALUE " CORRECT =". DB2054.2 +007900 02 CORRECT-X. DB2054.2 +008000 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2054.2 +008100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2054.2 +008200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2054.2 +008300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2054.2 +008400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2054.2 +008500 03 CR-18V0 REDEFINES CORRECT-A. DB2054.2 +008600 04 CORRECT-18V0 PICTURE -9(18). DB2054.2 +008700 04 FILLER PICTURE X. DB2054.2 +008800 03 FILLER PIC X(50) VALUE SPACE. DB2054.2 +008900 01 CCVS-C-1. DB2054.2 +009000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2054.2 +009100- "SS PARAGRAPH-NAME DB2054.2 +009200- " REMARKS". DB2054.2 +009300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2054.2 +009400 01 CCVS-C-2. DB2054.2 +009500 02 FILLER PICTURE IS X VALUE IS SPACE. DB2054.2 +009600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2054.2 +009700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2054.2 +009800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2054.2 +009900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2054.2 +010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2054.2 +010100 01 REC-CT PICTURE 99 VALUE ZERO. DB2054.2 +010200 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2054.2 +010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2054.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2054.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2054.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2054.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2054.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2054.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2054.2 +011000 01 CCVS-H-1. DB2054.2 +011100 02 FILLER PICTURE X(27) VALUE SPACE. DB2054.2 +011200 02 FILLER PICTURE X(67) VALUE DB2054.2 +011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2054.2 +011400- " SYSTEM". DB2054.2 +011500 02 FILLER PICTURE X(26) VALUE SPACE. DB2054.2 +011600 01 CCVS-H-2. DB2054.2 +011700 02 FILLER PICTURE X(52) VALUE IS DB2054.2 +011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2054.2 +011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2054.2 +012000 02 TEST-ID PICTURE IS X(9). DB2054.2 +012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2054.2 +012200 01 CCVS-H-3. DB2054.2 +012300 02 FILLER PICTURE X(34) VALUE DB2054.2 +012400 " FOR OFFICIAL USE ONLY ". DB2054.2 +012500 02 FILLER PICTURE X(58) VALUE DB2054.2 +012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2054.2 +012700 02 FILLER PICTURE X(28) VALUE DB2054.2 +012800 " COPYRIGHT 1974 ". DB2054.2 +012900 01 CCVS-E-1. DB2054.2 +013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2054.2 +013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2054.2 +013200 02 ID-AGAIN PICTURE IS X(9). DB2054.2 +013300 02 FILLER PICTURE X(45) VALUE IS DB2054.2 +013400 " NTIS DISTRIBUTION COBOL 74". DB2054.2 +013500 01 CCVS-E-2. DB2054.2 +013600 02 FILLER PICTURE X(31) VALUE DB2054.2 +013700 SPACE. DB2054.2 +013800 02 FILLER PICTURE X(21) VALUE SPACE. DB2054.2 +013900 02 CCVS-E-2-2. DB2054.2 +014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2054.2 +014100 03 FILLER PICTURE IS X VALUE IS SPACE. DB2054.2 +014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2054.2 +014300 01 CCVS-E-3. DB2054.2 +014400 02 FILLER PICTURE X(22) VALUE DB2054.2 +014500 " FOR OFFICIAL USE ONLY". DB2054.2 +014600 02 FILLER PICTURE X(12) VALUE SPACE. DB2054.2 +014700 02 FILLER PICTURE X(58) VALUE DB2054.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2054.2 +014900 02 FILLER PICTURE X(13) VALUE SPACE. DB2054.2 +015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2054.2 +015100 01 CCVS-E-4. DB2054.2 +015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2054.2 +015300 02 FILLER PIC XXXX VALUE " OF ". DB2054.2 +015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2054.2 +015500 02 FILLER PIC X(40) VALUE DB2054.2 +015600 " TESTS WERE EXECUTED SUCCESSFULLY". DB2054.2 +015700 01 XXINFO. DB2054.2 +015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2054.2 +015900 02 INFO-TEXT. DB2054.2 +016000 04 FILLER PIC X(20) VALUE SPACE. DB2054.2 +016100 04 XXCOMPUTED PIC X(20). DB2054.2 +016200 04 FILLER PIC X(5) VALUE SPACE. DB2054.2 +016300 04 XXCORRECT PIC X(20). DB2054.2 +016400 01 HYPHEN-LINE. DB2054.2 +016500 02 FILLER PICTURE IS X VALUE IS SPACE. DB2054.2 +016600 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2054.2 +016700- "*****************************************". DB2054.2 +016800 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2054.2 +016900- "******************************". DB2054.2 +017000 01 CCVS-PGM-ID PIC X(6) VALUE DB2054.2 +017100 "DB205A". DB2054.2 +017200 COMMUNICATION SECTION. DB2054.2 +017300 CD CM-INQUE FOR INPUT. DB2054.2 +017400 01 INQUE-SPECS. DB2054.2 +017500 02 IN-QUEUE PIC X(12) VALUE DB2054.2 +017600 XXXXX030. DB2054.2 +017700 02 FILLER PIC X(75) VALUE SPACES. DB2054.2 +017800 CD CM-OUTQUE FOR OUTPUT. DB2054.2 +017900 01 OUTQUE-SPECS. DB2054.2 +018000 02 DEST-COUNT PIC 9(4) VALUE IS 1. DB2054.2 +018100 02 OUT-LENGTH PIC 9(4) VALUE IS 72. DB2054.2 +018200 02 OUTT-STATUS PIC X(3). DB2054.2 +018300 02 SYM-DEST PIC X(12) VALUE IS DB2054.2 +018400 XXXXX032. DB2054.2 +018500 PROCEDURE DIVISION. DB2054.2 +018600 DECLARATIVES. DB2054.2 +018700 DEBUG-PROCEDURE SECTION. DB2054.2 +018800 USE FOR DEBUGGING ON CM-INQUE CM-OUTQUE. DB2054.2 +018900 COMMUNICATION-PROC. DB2054.2 +019000 MOVE 1 TO KEY-1. DB2054.2 +019100 MOVE DEBUG-LINE TO LINE-1. DB2054.2 +019200 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2054.2 +019300 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2054.2 +019400 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS BY SPACES DB2054.2 +019500 AFTER INITIAL SPACE. DB2054.2 +019600 END DECLARATIVES. DB2054.2 +019700 CCVS1 SECTION. DB2054.2 +019800 OPEN-FILES. DB2054.2 +019900 OPEN OUTPUT PRINT-FILE. DB2054.2 +020000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2054.2 +020100 MOVE SPACE TO TEST-RESULTS. DB2054.2 +020200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2054.2 +020300 GO TO CCVS1-EXIT. DB2054.2 +020400 CLOSE-FILES. DB2054.2 +020500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2054.2 +020600 TERMINATE-CCVS. DB2054.2 +020700S EXIT PROGRAM. DB2054.2 +020800STERMINATE-CALL. DB2054.2 +020900 STOP RUN. DB2054.2 +021000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2054.2 +021100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2054.2 +021200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2054.2 +021300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2054.2 +021400 MOVE "****TEST DELETED****" TO RE-MARK. DB2054.2 +021500 PRINT-DETAIL. DB2054.2 +021600 IF REC-CT NOT EQUAL TO ZERO DB2054.2 +021700 MOVE "." TO PARDOT-X DB2054.2 +021800 MOVE REC-CT TO DOTVALUE. DB2054.2 +021900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2054.2 +022000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2054.2 +022100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2054.2 +022200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2054.2 +022300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2054.2 +022400 MOVE SPACE TO CORRECT-X. DB2054.2 +022500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2054.2 +022600 MOVE SPACE TO RE-MARK. DB2054.2 +022700 HEAD-ROUTINE. DB2054.2 +022800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2054.2 +022900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2054.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2054.2 +023100 COLUMN-NAMES-ROUTINE. DB2054.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2054.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2054.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2054.2 +023500 END-ROUTINE. DB2054.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2054.2 +023700 END-RTN-EXIT. DB2054.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2054.2 +023900 END-ROUTINE-1. DB2054.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2054.2 +024100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2054.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. DB2054.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2054.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2054.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2054.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2054.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2054.2 +024800 END-ROUTINE-12. DB2054.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2054.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO DB2054.2 +025100 MOVE "NO " TO ERROR-TOTAL DB2054.2 +025200 ELSE DB2054.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2054.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2054.2 +025500 PERFORM WRITE-LINE. DB2054.2 +025600 END-ROUTINE-13. DB2054.2 +025700 IF DELETE-CNT IS EQUAL TO ZERO DB2054.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE DB2054.2 +025900 MOVE DELETE-CNT TO ERROR-TOTAL. DB2054.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2054.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2054.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO DB2054.2 +026300 MOVE "NO " TO ERROR-TOTAL DB2054.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2054.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2054.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2054.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2054.2 +026800 WRITE-LINE. DB2054.2 +026900 ADD 1 TO RECORD-COUNT. DB2054.2 +027000Y IF RECORD-COUNT GREATER 50 DB2054.2 +027100Y MOVE DUMMY-RECORD TO DUMMY-HOLD DB2054.2 +027200Y MOVE SPACE TO DUMMY-RECORD DB2054.2 +027300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2054.2 +027400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2054.2 +027500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2054.2 +027600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2054.2 +027700Y MOVE DUMMY-HOLD TO DUMMY-RECORD DB2054.2 +027800Y MOVE ZERO TO RECORD-COUNT. DB2054.2 +027900 PERFORM WRT-LN. DB2054.2 +028000 WRT-LN. DB2054.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2054.2 +028200 MOVE SPACE TO DUMMY-RECORD. DB2054.2 +028300 BLANK-LINE-PRINT. DB2054.2 +028400 PERFORM WRT-LN. DB2054.2 +028500 FAIL-ROUTINE. DB2054.2 +028600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2054.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2054.2 +028800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2054.2 +028900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2054.2 +029000 GO TO FAIL-ROUTINE-EX. DB2054.2 +029100 FAIL-ROUTINE-WRITE. DB2054.2 +029200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2054.2 +029300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2054.2 +029400 FAIL-ROUTINE-EX. EXIT. DB2054.2 +029500 BAIL-OUT. DB2054.2 +029600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2054.2 +029700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2054.2 +029800 BAIL-OUT-WRITE. DB2054.2 +029900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2054.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2054.2 +030100 BAIL-OUT-EX. EXIT. DB2054.2 +030200 CCVS1-EXIT. DB2054.2 +030300 EXIT. DB2054.2 +030400 BEGIN-DB205A-TESTS SECTION. DB2054.2 +030500 DISABLE-TEST-1-INIT. DB2054.2 +030600 MOVE SPACES TO ITEM-1. DB2054.2 +030700 MOVE 0 TO KEY-1. DB2054.2 +030800 MOVE "DISABLE-TEST-1" TO PAR-NAME. DB2054.2 +030900 MOVE "DISABLE CD-NAME" TO FEATURE. DB2054.2 +031000 DISABLE-TEST-1. DB2054.2 +031100 DISABLE INPUT CM-INQUE WITH KEY DB2054.2 +031200 XXXXX031. DB2054.2 +031300 IF KEY-1 IS EQUAL TO 1 DB2054.2 +031400 PERFORM PASS DB2054.2 +031500 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2054.2 +031600 PERFORM PRINT-DETAIL DB2054.2 +031700 GO TO DISABLE-TEST-1A DB2054.2 +031800 ELSE PERFORM FAIL DB2054.2 +031900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +032000 PERFORM PRINT-DETAIL DB2054.2 +032100 PERFORM DELETE-DISABLE-TEST-1-SUBTEST DB2054.2 +032200 GO TO ENABLE-TEST-1-INIT. DB2054.2 +032300 DISABLE-TEST-1-DELETE. DB2054.2 +032400 PERFORM DE-LETE. DB2054.2 +032500 PERFORM PRINT-DETAIL. DB2054.2 +032600 PERFORM DELETE-DISABLE-TEST-1-SUBTEST. DB2054.2 +032700 GO TO ENABLE-TEST-1-INIT. DB2054.2 +032800 DELETE-DISABLE-TEST-1-SUBTEST. DB2054.2 +032900 MOVE "DISABLE-TEST-1A" TO PAR-NAME. DB2054.2 +033000 PERFORM DE-LETE. DB2054.2 +033100 PERFORM PRINT-DETAIL. DB2054.2 +033200 DISABLE-TEST-1A. DB2054.2 +033300 MOVE "DISABLE-TEST-1A" TO PAR-NAME. DB2054.2 +033400 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2054.2 +033500 MOVE "DISABLE-TEST-1A" TO PAR-NAME. DB2054.2 +033600 IF CONTENTS-1 IS EQUAL TO INQUE-SPECS DB2054.2 +033700 PERFORM PASS DB2054.2 +033800 PERFORM PRINT-DETAIL DB2054.2 +033900 GO TO ENABLE-TEST-1-INIT DB2054.2 +034000 ELSE PERFORM FAIL DB2054.2 +034100 MOVE "1ST LINE FOLLOWING" TO CORRECT-A DB2054.2 +034200 MOVE "2ND LINE FOLLOWING" TO COMPUTED-A DB2054.2 +034300 PERFORM PRINT-DETAIL. DB2054.2 +034400 MOVE INQUE-SPECS TO PRINT-REC. DB2054.2 +034500 PERFORM WRITE-LINE. DB2054.2 +034600 MOVE CONTENTS-1 TO PRINT-REC. DB2054.2 +034700 PERFORM WRITE-LINE. DB2054.2 +034800 ENABLE-TEST-1-INIT. DB2054.2 +034900 MOVE SPACES TO ITEM-1. DB2054.2 +035000 MOVE 0 TO KEY-1. DB2054.2 +035100 MOVE "ENABLE-TEST-1" TO PAR-NAME. DB2054.2 +035200 MOVE "ENABLE CD-NAME" TO FEATURE. DB2054.2 +035300 ENABLE-TEST-1. DB2054.2 +035400 ENABLE OUTPUT CM-OUTQUE WITH KEY DB2054.2 +035500 XXXXX033. DB2054.2 +035600 IF KEY-1 IS EQUAL TO 1 DB2054.2 +035700 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2054.2 +035800 PERFORM PASS DB2054.2 +035900 PERFORM PRINT-DETAIL DB2054.2 +036000 GO TO ENABLE-TEST-1A DB2054.2 +036100 ELSE PERFORM FAIL DB2054.2 +036200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +036300 PERFORM PRINT-DETAIL DB2054.2 +036400 PERFORM DELETE-ENABLE-TEST-1-SUBTEST DB2054.2 +036500 GO TO ACCEPT-TEST-1-INIT. DB2054.2 +036600 ENABLE-TEST-1-DELETE. DB2054.2 +036700 PERFORM DE-LETE. DB2054.2 +036800 PERFORM PRINT-DETAIL. DB2054.2 +036900 PERFORM DELETE-ENABLE-TEST-1-SUBTEST. DB2054.2 +037000 GO TO ACCEPT-TEST-1-INIT. DB2054.2 +037100 DELETE-ENABLE-TEST-1-SUBTEST. DB2054.2 +037200 MOVE "ENABLE-TEST-1A" TO PAR-NAME. DB2054.2 +037300 PERFORM DE-LETE. DB2054.2 +037400 PERFORM PRINT-DETAIL. DB2054.2 +037500 ENABLE-TEST-1A. DB2054.2 +037600 MOVE "ENABLE-TEST-1A" TO PAR-NAME. DB2054.2 +037700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2054.2 +037800 IF CONTENTS-1 IS EQUAL TO OUTQUE-SPECS DB2054.2 +037900 PERFORM PASS DB2054.2 +038000 PERFORM PRINT-DETAIL DB2054.2 +038100 GO TO ACCEPT-TEST-1-INIT DB2054.2 +038200 ELSE PERFORM FAIL DB2054.2 +038300 MOVE "1ST LINE FOLLOWING" TO CORRECT-A DB2054.2 +038400 MOVE "2ND LINE FOLLOWING" TO COMPUTED-A DB2054.2 +038500 PERFORM PRINT-DETAIL. DB2054.2 +038600 MOVE OUTQUE-SPECS TO PRINT-REC. DB2054.2 +038700 PERFORM WRITE-LINE. DB2054.2 +038800 MOVE CONTENTS-1 TO PRINT-REC. DB2054.2 +038900 PERFORM WRITE-LINE. DB2054.2 +039000 ACCEPT-TEST-1-INIT. DB2054.2 +039100 MOVE SPACES TO ITEM-1. DB2054.2 +039200 MOVE 0 TO KEY-1. DB2054.2 +039300 MOVE "ACCEPT-TEST-1" TO PAR-NAME. DB2054.2 +039400 MOVE "ACCEPT CD-NAME" TO FEATURE. DB2054.2 +039500 ACCEPT-TEST-1. DB2054.2 +039600 ACCEPT CM-INQUE MESSAGE COUNT. DB2054.2 +039700 IF KEY-1 IS EQUAL TO 1 DB2054.2 +039800 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2054.2 +039900 PERFORM PASS DB2054.2 +040000 PERFORM PRINT-DETAIL DB2054.2 +040100 GO TO ACCEPT-TEST-1A DB2054.2 +040200 ELSE PERFORM FAIL DB2054.2 +040300 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +040400 PERFORM PRINT-DETAIL DB2054.2 +040500 PERFORM DELETE-ACCEPT-TEST-1-SUBTEST DB2054.2 +040600 GO TO RECEIVE-TEST-1-INIT. DB2054.2 +040700 ACCEPT-TEST-1-DELETE. DB2054.2 +040800 PERFORM DE-LETE. DB2054.2 +040900 PERFORM PRINT-DETAIL. DB2054.2 +041000 PERFORM DELETE-ACCEPT-TEST-1-SUBTEST. DB2054.2 +041100 GO TO RECEIVE-TEST-1-INIT. DB2054.2 +041200 DELETE-ACCEPT-TEST-1-SUBTEST. DB2054.2 +041300 MOVE "ACCEPT-TEST-1-1A" TO PAR-NAME DB2054.2 +041400 PERFORM DE-LETE. DB2054.2 +041500 PERFORM PRINT-DETAIL. DB2054.2 +041600 ACCEPT-TEST-1A. DB2054.2 +041700 MOVE "ACCEPT-TEST-1A" TO PAR-NAME. DB2054.2 +041800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2054.2 +041900 IF CONTENTS-1 IS EQUAL TO INQUE-SPECS DB2054.2 +042000 PERFORM PASS DB2054.2 +042100 PERFORM PRINT-DETAIL DB2054.2 +042200 GO TO RECEIVE-TEST-1-INIT DB2054.2 +042300 ELSE PERFORM FAIL DB2054.2 +042400 MOVE "1ST LINE FOLLOWING" TO CORRECT-A DB2054.2 +042500 MOVE "2ND LINE FOLLOWING" TO COMPUTED-A DB2054.2 +042600 PERFORM PRINT-DETAIL. DB2054.2 +042700 MOVE INQUE-SPECS TO PRINT-REC. DB2054.2 +042800 PERFORM WRITE-LINE. DB2054.2 +042900 MOVE CONTENTS-1 TO PRINT-REC. DB2054.2 +043000 PERFORM WRITE-LINE. DB2054.2 +043100 RECEIVE-TEST-1-INIT. DB2054.2 +043200 MOVE SPACES TO ITEM-1. DB2054.2 +043300 MOVE 0 TO KEY-1. DB2054.2 +043400 MOVE "RECEIVE-TEST-1" TO PAR-NAME. DB2054.2 +043500 MOVE "RECEIVE W/ NO DATA" TO FEATURE. DB2054.2 +043600 RECEIVE-TEST-1. DB2054.2 +043700 RECEIVE CM-INQUE MESSAGE INTO WORK-AREA DB2054.2 +043800 NO DATA GO TO RECEIVE-TEST-1-CONT. DB2054.2 +043900 GO TO RECEIVE-TEST-1-INIT. DB2054.2 +044000 RECEIVE-TEST-1-DELETE. DB2054.2 +044100 PERFORM DE-LETE. DB2054.2 +044200 PERFORM PRINT-DETAIL. DB2054.2 +044300 GO TO SEND-TEST-1-INIT. DB2054.2 +044400 RECEIVE-TEST-1-CONT. DB2054.2 +044500 IF KEY-1 IS EQUAL TO 0 DB2054.2 +044600 PERFORM PASS DB2054.2 +044700 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +044800 ELSE PERFORM FAIL DB2054.2 +044900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2054.2 +045000 PERFORM PRINT-DETAIL. DB2054.2 +045100 SEND-TEST-1-INIT. DB2054.2 +045200 ENABLE INPUT CM-INQUE WITH KEY DB2054.2 +045300 XXXXX031. DB2054.2 +045400 MOVE SPACES TO ITEM-1. DB2054.2 +045500 MOVE 0 TO KEY-1. DB2054.2 +045600 MOVE "SEND-TEST-1" TO PAR-NAME. DB2054.2 +045700 MOVE "SEND CD-NAME" TO FEATURE. DB2054.2 +045800 SEND-TEST-1. DB2054.2 +045900 MOVE "ENTER ONE MESSAGE NOW." TO WORK-AREA. DB2054.2 +046000******************************************************************DB2054.2 +046100* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB2054.2 +046200* OUTPUT REPORT AS "SEND-TEST-1A" SHOULD POINT TO THE *DB2054.2 +046300* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB2054.2 +046400* WHICH READS, "SEND CM-OUTQUE FROM WORK-AREA WITH EGI.". *DB2054.2 +046500******************************************************************DB2054.2 +046600 SEND CM-OUTQUE FROM WORK-AREA WITH EGI. DB2054.2 +046700 IF KEY-1 IS EQUAL TO 1 DB2054.2 +046800 PERFORM PASS DB2054.2 +046900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2054.2 +047000 PERFORM PRINT-DETAIL DB2054.2 +047100 GO TO SEND-TEST-1A DB2054.2 +047200 ELSE PERFORM FAIL DB2054.2 +047300 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +047400 PERFORM PRINT-DETAIL DB2054.2 +047500 PERFORM DELETE-SEND-TEST-1-SUBTESTS DB2054.2 +047600 GO TO RECEIVE-TEST-2-INIT. DB2054.2 +047700 SEND-TEST-1-DELETE. DB2054.2 +047800 PERFORM DE-LETE. DB2054.2 +047900 PERFORM PRINT-DETAIL. DB2054.2 +048000 PERFORM DELETE-SEND-TEST-1-SUBTESTS. DB2054.2 +048100 GO TO RECEIVE-TEST-2-INIT. DB2054.2 +048200 DELETE-SEND-TEST-1-SUBTESTS. DB2054.2 +048300 MOVE "SEND-TEST-1A" TO PAR-NAME. DB2054.2 +048400 PERFORM DE-LETE. DB2054.2 +048500 PERFORM PRINT-DETAIL. DB2054.2 +048600 MOVE "SEND-TEST-1B" TO PAR-NAME. DB2054.2 +048700 PERFORM DE-LETE. DB2054.2 +048800 PERFORM PRINT-DETAIL. DB2054.2 +048900 MOVE "SEND-TEST-1C" TO PAR-NAME. DB2054.2 +049000 PERFORM DE-LETE. DB2054.2 +049100 PERFORM PRINT-DETAIL. DB2054.2 +049200 SEND-TEST-1A. DB2054.2 +049300 MOVE "SEND-TEST-1A" TO PAR-NAME. DB2054.2 +049400 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2054.2 +049500 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2054.2 +049600 MOVE LINE-1 TO COMPUTED-A. DB2054.2 +049700 PERFORM INSPT. DB2054.2 +049800 PERFORM PRINT-DETAIL. DB2054.2 +049900 SEND-TEST-1B. DB2054.2 +050000 MOVE "SEND-TEST-1B" TO PAR-NAME. DB2054.2 +050100 IF UNQUAL-NAME-1 IS EQUAL TO "CM-OUTQUE" DB2054.2 +050200 PERFORM PASS DB2054.2 +050300 ELSE PERFORM FAIL DB2054.2 +050400 MOVE "CM-OUTQUE" TO CORRECT-A DB2054.2 +050500 MOVE NAME-1 TO COMPUTED-A. DB2054.2 +050600 MOVE "DEBUG-NAME" TO RE-MARK. DB2054.2 +050700 PERFORM PRINT-DETAIL. DB2054.2 +050800 SEND-TEST-1C. DB2054.2 +050900 MOVE "SEND-TEST-1C" TO PAR-NAME. DB2054.2 +051000 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2054.2 +051100 IF CONTENTS-1 IS EQUAL TO OUTQUE-SPECS DB2054.2 +051200 PERFORM PASS DB2054.2 +051300 PERFORM PRINT-DETAIL DB2054.2 +051400 GO TO RECEIVE-TEST-2-INIT DB2054.2 +051500 ELSE PERFORM FAIL DB2054.2 +051600 MOVE "1ST LINE FOLLOWING" TO CORRECT-A DB2054.2 +051700 MOVE "2ND LINE FOLLOWING" TO COMPUTED-A DB2054.2 +051800 PERFORM PRINT-DETAIL. DB2054.2 +051900 MOVE OUTQUE-SPECS TO PRINT-REC. DB2054.2 +052000 PERFORM WRITE-LINE. DB2054.2 +052100 MOVE CONTENTS-1 TO PRINT-REC. DB2054.2 +052200 PERFORM WRITE-LINE. DB2054.2 +052300 RECEIVE-TEST-2-INIT. DB2054.2 +052400 MOVE SPACES TO ITEM-1. DB2054.2 +052500 MOVE 0 TO KEY-1. DB2054.2 +052600 MOVE "RECEIVE-TEST-2" TO PAR-NAME. DB2054.2 +052700 MOVE "RECEIVE W/O NO DATA" TO FEATURE. DB2054.2 +052800******************************************************************DB2054.2 +052900* THE DEBUG-LINE (INSPT) SUBTEST FOR THE TEST NAMED IN THE *DB2054.2 +053000* OUTPUT REPORT AS "RECEIVE-TEST-2A" SHOULD POINT TO THE *DB2054.2 +053100* EXECUTABLE STATEMENT WHICH FOLLOWS THIS COMMENT SET AND *DB2054.2 +053200* WHICH READS, "RECEIVE CM-INQUE MESSAGE INTO WORK-AREA.". *DB2054.2 +053300******************************************************************DB2054.2 +053400 RECEIVE-TEST-2. DB2054.2 +053500 RECEIVE CM-INQUE MESSAGE INTO WORK-AREA. DB2054.2 +053600 IF KEY-1 IS EQUAL TO 1 DB2054.2 +053700 PERFORM PASS DB2054.2 +053800 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2054.2 +053900 PERFORM PRINT-DETAIL DB2054.2 +054000 GO TO RECEIVE-TEST-2A DB2054.2 +054100 ELSE PERFORM FAIL DB2054.2 +054200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2054.2 +054300 PERFORM PRINT-DETAIL DB2054.2 +054400 PERFORM DELETE-RECEIVE-TEST-2-SUBTESTS DB2054.2 +054500 GO TO END-OF-DB205A. DB2054.2 +054600 DELETE-RECEIVE-TEST-2. DB2054.2 +054700 PERFORM DE-LETE. DB2054.2 +054800 PERFORM PRINT-DETAIL. DB2054.2 +054900 PERFORM DELETE-RECEIVE-TEST-2-SUBTESTS. DB2054.2 +055000 GO TO END-OF-DB205A. DB2054.2 +055100 DELETE-RECEIVE-TEST-2-SUBTESTS. DB2054.2 +055200 MOVE "RECEIVE-TEST-2A" TO PAR-NAME. DB2054.2 +055300 PERFORM DE-LETE. DB2054.2 +055400 PERFORM PRINT-DETAIL. DB2054.2 +055500 MOVE "RECEIVE-TEST-2B" TO PAR-NAME. DB2054.2 +055600 PERFORM DE-LETE. DB2054.2 +055700 PERFORM PRINT-DETAIL. DB2054.2 +055800 MOVE "RECEIVE-TEST-2C" TO PAR-NAME. DB2054.2 +055900 PERFORM DE-LETE. DB2054.2 +056000 PERFORM PRINT-DETAIL. DB2054.2 +056100 RECEIVE-TEST-2A. DB2054.2 +056200 MOVE "RECEIVE-TEST-2A" TO PAR-NAME. DB2054.2 +056300 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2054.2 +056400 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2054.2 +056500 MOVE LINE-1 TO COMPUTED-A. DB2054.2 +056600 PERFORM INSPT. DB2054.2 +056700 PERFORM PRINT-DETAIL. DB2054.2 +056800 RECEIVE-TEST-2B. DB2054.2 +056900 MOVE "RECEIVE-TEST-2B" TO PAR-NAME. DB2054.2 +057000 IF UNQUAL-NAME-1 IS EQUAL TO "CM-INQUE" DB2054.2 +057100 PERFORM PASS DB2054.2 +057200 ELSE PERFORM FAIL DB2054.2 +057300 MOVE "CM-INQUE" TO CORRECT-A DB2054.2 +057400 MOVE NAME-1 TO COMPUTED-A. DB2054.2 +057500 MOVE "DEBUG-NAME" TO RE-MARK. DB2054.2 +057600 PERFORM PRINT-DETAIL. DB2054.2 +057700 RECEIVE-TEST-2C. DB2054.2 +057800 MOVE "RECEIVE-TEST-2C" TO PAR-NAME. DB2054.2 +057900 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2054.2 +058000 IF CONTENTS-1 IS EQUAL TO INQUE-SPECS DB2054.2 +058100 PERFORM PASS DB2054.2 +058200 PERFORM PRINT-DETAIL DB2054.2 +058300 GO TO END-OF-DB205A DB2054.2 +058400 ELSE PERFORM FAIL DB2054.2 +058500 MOVE "1ST LINE FOLLOWING" TO CORRECT-A DB2054.2 +058600 MOVE "2ND LINE FOLLOWING" TO COMPUTED-A. DB2054.2 +058700 PERFORM PRINT-DETAIL. DB2054.2 +058800 MOVE INQUE-SPECS TO PRINT-REC. DB2054.2 +058900 PERFORM WRITE-LINE. DB2054.2 +059000 MOVE CONTENTS-1 TO PRINT-REC. DB2054.2 +059100 PERFORM WRITE-LINE. DB2054.2 +059200 END-OF-DB205A. DB2054.2 +059300 EXIT. DB2054.2 +059400 CCVS-EXIT SECTION. DB2054.2 +059500 CCVS-999999. DB2054.2 +059600 GO TO CLOSE-FILES. DB2054.2 +*END-OF,DB205A +*HEADER,COBOL,DB301M +000100 IDENTIFICATION DIVISION. DB3014.2 +000200 PROGRAM-ID. DB3014.2 +000300 DB301M. DB3014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 1 DB3014.2 +000500*FEATURES OF THE DEBUGGING MODULE. DB3014.2 +000600 ENVIRONMENT DIVISION. DB3014.2 +000700 CONFIGURATION SECTION. DB3014.2 +000800 SOURCE-COMPUTER. DB3014.2 +000900 XXXXX082 DB3014.2 +001000 WITH DEBUGGING MODE. DB3014.2 +001100 OBJECT-COMPUTER. DB3014.2 +001200 XXXXX083. DB3014.2 +001300 INPUT-OUTPUT SECTION. DB3014.2 +001400 FILE-CONTROL. DB3014.2 +001500 SELECT TFIL ASSIGN DB3014.2 +001600 XXXXX014 DB3014.2 +001700 ORGANIZATION IS SEQUENTIAL DB3014.2 +001800 ACCESS MODE IS SEQUENTIAL. DB3014.2 +001900 DATA DIVISION. DB3014.2 +002000 FILE SECTION. DB3014.2 +002100 FD TFIL. DB3014.2 +002200 01 FREC. DB3014.2 +002300 03 RKEY PIC 9(8). DB3014.2 +002400 DB3014.2 +002500 PROCEDURE DIVISION. DB3014.2 +002600 DB3014.2 +002700 DECLARATIVES. DB3014.2 +002800 DB3014.2 +002900 DB3014.2 +003000 BUGGING-2 SECTION. DB3014.2 +003100 DB3014.2 +003200 DB3014.2 +003300 USE FOR DEBUGGING ON ALL PROCEDURES. DB3014.2 +003400*Message expected for above statement: NON-CONFORMING STANDARD DB3014.2 +003500 DB3014.2 +003600 DB3014.2 +003700 END DECLARATIVES. DB3014.2 +003800 DB3014.2 +003900 DB301M-FLAGS SECTION. DB3014.2 +004000 DB301M-CONTROL. DB3014.2 +004100 DISPLAY "THIS IS A DUMMY PROCEDURE". DB3014.2 +004200 STOP RUN. DB3014.2 +004300 DB3014.2 +004400 DB3014.2 +004500*TOTAL NUMBER OF FLAGS EXPECTED = 1. DB3014.2 +*END-OF,DB301M +*HEADER,COBOL,DB302M +000100 IDENTIFICATION DIVISION. DB3024.2 +000200 PROGRAM-ID. DB3024.2 +000300 DB302M. DB3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 1 DB3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN DEBUGGING. DB3024.2 +000600 ENVIRONMENT DIVISION. DB3024.2 +000700 CONFIGURATION SECTION. DB3024.2 +000800 SOURCE-COMPUTER. DB3024.2 +000900 XXXXX082 DB3024.2 +001000 WITH DEBUGGING MODE. DB3024.2 +001100 OBJECT-COMPUTER. DB3024.2 +001200 XXXXX083. DB3024.2 +001300 DB3024.2 +001400 INPUT-OUTPUT SECTION. DB3024.2 +001500 FILE-CONTROL. DB3024.2 +001600 SELECT TFIL ASSIGN DB3024.2 +001700 XXXXX014 DB3024.2 +001800 ORGANIZATION IS SEQUENTIAL DB3024.2 +001900 ACCESS MODE IS SEQUENTIAL. DB3024.2 +002000 DB3024.2 +002100 DATA DIVISION. DB3024.2 +002200 FILE SECTION. DB3024.2 +002300 FD TFIL. DB3024.2 +002400 01 FREC. DB3024.2 +002500 03 RKEY PIC 9(8). DB3024.2 +002600 DB3024.2 +002700 PROCEDURE DIVISION. DB3024.2 +002800 DB3024.2 +002900 DECLARATIVES. DB3024.2 +003000 DB3024.2 +003100 BUGGING SECTION. DB3024.2 +003200 DB3024.2 +003300 USE FOR DEBUGGING ON DB302M-CONTROL. DB3024.2 +003400*Message expected for above statement: OBSOLETE DB3024.2 +003500 DB3024.2 +003600 END DECLARATIVES. DB3024.2 +003700 DB3024.2 +003800 DB302-FLAGS SECTION. DB3024.2 +003900 DB3024.2 +004000 DB302M-CONTROL. DB3024.2 +004100 DISPLAY "THIS IS A DUMMY PROCEDURE". DB3024.2 +004200 STOP RUN. DB3024.2 +004300 DB3024.2 +004400*TOTAL NUMBER OF FLAGS EXPECTED = 1. DB3024.2 +*END-OF,DB302M +*HEADER,COBOL,DB303M +000100 IDENTIFICATION DIVISION. DB3034.2 +000200 PROGRAM-ID. DB3034.2 +000300 DB303M. DB3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 2 DB3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN DEBUGGING. DB3034.2 +000600 ENVIRONMENT DIVISION. DB3034.2 +000700 CONFIGURATION SECTION. DB3034.2 +000800 SOURCE-COMPUTER. DB3034.2 +000900 XXXXX082 DB3034.2 +001000 WITH DEBUGGING MODE. DB3034.2 +001100 OBJECT-COMPUTER. DB3034.2 +001200 XXXXX083. DB3034.2 +001300 INPUT-OUTPUT SECTION. DB3034.2 +001400 FILE-CONTROL. DB3034.2 +001500 SELECT TFIL ASSIGN DB3034.2 +001600 XXXXX014 DB3034.2 +001700 ORGANIZATION IS SEQUENTIAL DB3034.2 +001800 ACCESS MODE IS SEQUENTIAL. DB3034.2 +001900 DATA DIVISION. DB3034.2 +002000 FILE SECTION. DB3034.2 +002100 FD TFIL. DB3034.2 +002200 01 FREC. DB3034.2 +002300 03 RKEY PIC 9(8). DB3034.2 +002400 DB3034.2 +002500 DB3034.2 +002600 PROCEDURE DIVISION. DB3034.2 +002700 DB3034.2 +002800 DECLARATIVES. DB3034.2 +002900 DB3034.2 +003000 DB3034.2 +003100 BUGGING-2 SECTION. DB3034.2 +003200 DB3034.2 +003300 USE FOR DEBUGGING ON ALL REFERENCES OF FREC. DB3034.2 +003400*Message expected for above statement: OBSOLETE DB3034.2 +003500 DB3034.2 +003600 DB3034.2 +003700 DB3034.2 +003800 BUGGING-3 SECTION. DB3034.2 +003900 DB3034.2 +004000 DB3034.2 +004100 USE FOR DEBUGGING ON TFIL. DB3034.2 +004200*Message expected for above statement: OBSOLETE DB3034.2 +004300 DB3034.2 +004400 END DECLARATIVES. DB3034.2 +004500 DB3034.2 +004600 DB303M-FLAGS SECTION. DB3034.2 +004700 DB3034.2 +004800 DB303M-CONTROL. DB3034.2 +004900 DISPLAY "THIS IS A DUMMY PROCEDURE". DB3034.2 +005000 STOP RUN. DB3034.2 +005100 DB3034.2 +005200*TOTAL NUMBER OF FLAGS EXPECTED = 2. DB3034.2 +*END-OF,DB303M +*HEADER,COBOL,DB304M +000100 IDENTIFICATION DIVISION. DB3044.2 +000200 PROGRAM-ID. DB3044.2 +000300 DB304M. DB3044.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF OBSOLETE DB3044.2 +000500*LEVEL 2 COMMUNICATION FEATURES THAT ARE USED IN DEBUGGING. DB3044.2 +000600*THIS TEST NEED NOT BE RUN IF COMMUNICATIONS NOT IMPLEMTENTED. DB3044.2 +000700 ENVIRONMENT DIVISION. DB3044.2 +000800 CONFIGURATION SECTION. DB3044.2 +000900 SOURCE-COMPUTER. DB3044.2 +001000 XXXXX082 DB3044.2 +001100 WITH DEBUGGING MODE. DB3044.2 +001200 OBJECT-COMPUTER. DB3044.2 +001300 XXXXX083. DB3044.2 +001400 DATA DIVISION. DB3044.2 +001500 COMMUNICATION SECTION. DB3044.2 +001600 DB3044.2 +001700 CD COMMNAME FOR INPUT. DB3044.2 +001800 01 CREC. DB3044.2 +001900 03 CNAME1 PIC 9(8). DB3044.2 +002000 03 FILLER PIC X(79). DB3044.2 +002100 DB3044.2 +002200 PROCEDURE DIVISION. DB3044.2 +002300 DB3044.2 +002400 DECLARATIVES. DB3044.2 +002500 DB3044.2 +002600 BUGGING SECTION. DB3044.2 +002700 DB3044.2 +002800 USE FOR DEBUGGING ON COMMNAME. DB3044.2 +002900*Message expected for above statement: OBSOLETE DB3044.2 +003000 DB3044.2 +003100 DB3044.2 +003200 DB3044.2 +003300 END DECLARATIVES. DB3044.2 +003400 DB3044.2 +003500 DB304M-FLAGS SECTION. DB3044.2 +003600 DB3044.2 +003700 DB304M-CONTROL. DB3044.2 +003800 DISPLAY "THIS IS A DUMMY PROCEDURE". DB3044.2 +003900 STOP RUN. DB3044.2 +004000 DB3044.2 +004100*TOTAL NUMBER OF FLAGS EXPECTED = 1. DB3044.2 +*END-OF,DB304M +*HEADER,COBOL,DB305M +000100 IDENTIFICATION DIVISION. DB3054.2 +000200 PROGRAM-ID. DB3054.2 +000300 DB305M. DB3054.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 1 DB3054.2 +000500*OBSOLETE FEATURES THAT ARE USED IN DEBUGGING. DB3054.2 +000600 ENVIRONMENT DIVISION. DB3054.2 +000700 CONFIGURATION SECTION. DB3054.2 +000800 SOURCE-COMPUTER. DB3054.2 +000900 XXXXX082 DB3054.2 +001000 WITH DEBUGGING MODE. DB3054.2 +001100 OBJECT-COMPUTER. DB3054.2 +001200 XXXXX083. DB3054.2 +001300 DB3054.2 +001400 INPUT-OUTPUT SECTION. DB3054.2 +001500 FILE-CONTROL. DB3054.2 +001600 SELECT TFIL ASSIGN DB3054.2 +001700 XXXXX014 DB3054.2 +001800 ORGANIZATION IS SEQUENTIAL DB3054.2 +001900 ACCESS MODE IS SEQUENTIAL. DB3054.2 +002000 DB3054.2 +002100 DATA DIVISION. DB3054.2 +002200 FILE SECTION. DB3054.2 +002300 FD TFIL. DB3054.2 +002400 01 FREC. DB3054.2 +002500 03 RKEY PIC 9(8). DB3054.2 +002600 DB3054.2 +002700 PROCEDURE DIVISION. DB3054.2 +002800 DB3054.2 +002900 DECLARATIVES. DB3054.2 +003000 DB3054.2 +003100 BUGGING SECTION. DB3054.2 +003200 DB3054.2 +003300 USE FOR DEBUGGING ON ALL PROCEDURES. DB3054.2 +003400*Message expected for above statement: OBSOLETE DB3054.2 +003500 DB3054.2 +003600 END DECLARATIVES. DB3054.2 +003700 DB3054.2 +003800 DB305-FLAGS SECTION. DB3054.2 +003900 DB3054.2 +004000 DB305M-CONTROL. DB3054.2 +004100 DISPLAY "THIS IS A DUMMY PROCEDURE". DB3054.2 +004200 STOP RUN. DB3054.2 +004300 DB3054.2 +004400*TOTAL NUMBER OF FLAGS EXPECTED = 1. DB3054.2 +*END-OF,DB305M +*HEADER,COBOL,IC101A +000100 IDENTIFICATION DIVISION. IC1014.2 +000200 PROGRAM-ID. IC1014.2 +000300 IC101A. IC1014.2 +000400**************************************************************** IC1014.2 +000500* * IC1014.2 +000600* VALIDATION FOR:- * IC1014.2 +000700* * IC1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +000900* * IC1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1014.2 +001100* * IC1014.2 +001200**************************************************************** IC1014.2 +001300* * IC1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1014.2 +001500* * IC1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1014.2 +001900* * IC1014.2 +002000**************************************************************** IC1014.2 +002100* THIS ROUTINE CHECKS THE USE OF THE CALL STATEMENT IC1014.2 +002200* WITH ONE PARAMETER IN THE USING PHRASE. SUBSEQUENT CALLS IC1014.2 +002300* CHECK THAT THE CALLED ROUTINE REMAINS IN THE LAST USED STATE.IC1014.2 +002400* IC1014.2 +002500* THERE ARE NO DELETE PARAGRAPHS IN THIS ROUTINE IC1014.2 +002600* SINCE THESE ARE THE BASIC CALL TESTS AND IF A CALL IC1014.2 +002700* STATEMENT IS REJECTED THERE IS NO REASON TO RUN THE ROUTINE. IC1014.2 +002800* IC1014.2 +002900* THE FIRST THREE CALLS USE A DATA-NAME THE SAME AS IC1014.2 +003000* THE NAME IN THE SUBPROGRAM. THE LAST TWO CALLS USE IC1014.2 +003100* A DIFFERENT DATA-NAME FROM THE NAME IN THE SUBPROGRAM. IC1014.2 +003200* THE PICTURE CLAUSES FOR DATA-NAMES IN THE USING PHRASES IC1014.2 +003300* OF THE CALLED AND CALLING PROGRAMS ARE IDENTICAL. IC1014.2 +003400 ENVIRONMENT DIVISION. IC1014.2 +003500 CONFIGURATION SECTION. IC1014.2 +003600 SOURCE-COMPUTER. IC1014.2 +003700 XXXXX082. IC1014.2 +003800 OBJECT-COMPUTER. IC1014.2 +003900 XXXXX083. IC1014.2 +004000 INPUT-OUTPUT SECTION. IC1014.2 +004100 FILE-CONTROL. IC1014.2 +004200 SELECT PRINT-FILE ASSIGN TO IC1014.2 +004300 XXXXX055. IC1014.2 +004400 DATA DIVISION. IC1014.2 +004500 FILE SECTION. IC1014.2 +004600 FD PRINT-FILE. IC1014.2 +004700 01 PRINT-REC PICTURE X(120). IC1014.2 +004800 01 DUMMY-RECORD PICTURE X(120). IC1014.2 +004900 WORKING-STORAGE SECTION. IC1014.2 +005000 77 DN1 PICTURE S9 VALUE ZERO. IC1014.2 +005100 77 DN2 PICTURE S9 VALUE ZERO. IC1014.2 +005200 01 TEST-RESULTS. IC1014.2 +005300 02 FILLER PIC X VALUE SPACE. IC1014.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IC1014.2 +005500 02 FILLER PIC X VALUE SPACE. IC1014.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IC1014.2 +005700 02 FILLER PIC X VALUE SPACE. IC1014.2 +005800 02 PAR-NAME. IC1014.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IC1014.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IC1014.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IC1014.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IC1014.2 +006300 02 RE-MARK PIC X(61). IC1014.2 +006400 01 TEST-COMPUTED. IC1014.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IC1014.2 +006600 02 FILLER PIC X(17) VALUE IC1014.2 +006700 " COMPUTED=". IC1014.2 +006800 02 COMPUTED-X. IC1014.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1014.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IC1014.2 +007100 PIC -9(9).9(9). IC1014.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1014.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1014.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1014.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IC1014.2 +007600 04 COMPUTED-18V0 PIC -9(18). IC1014.2 +007700 04 FILLER PIC X. IC1014.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IC1014.2 +007900 01 TEST-CORRECT. IC1014.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IC1014.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IC1014.2 +008200 02 CORRECT-X. IC1014.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IC1014.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1014.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1014.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1014.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1014.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IC1014.2 +008900 04 CORRECT-18V0 PIC -9(18). IC1014.2 +009000 04 FILLER PIC X. IC1014.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IC1014.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1014.2 +009300 01 CCVS-C-1. IC1014.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1014.2 +009500- "SS PARAGRAPH-NAME IC1014.2 +009600- " REMARKS". IC1014.2 +009700 02 FILLER PIC X(20) VALUE SPACE. IC1014.2 +009800 01 CCVS-C-2. IC1014.2 +009900 02 FILLER PIC X VALUE SPACE. IC1014.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". IC1014.2 +010100 02 FILLER PIC X(15) VALUE SPACE. IC1014.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". IC1014.2 +010300 02 FILLER PIC X(94) VALUE SPACE. IC1014.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1014.2 +010500 01 REC-CT PIC 99 VALUE ZERO. IC1014.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1014.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1014.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1014.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1014.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1014.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1014.2 +011500 01 CCVS-H-1. IC1014.2 +011600 02 FILLER PIC X(39) VALUE SPACES. IC1014.2 +011700 02 FILLER PIC X(42) VALUE IC1014.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1014.2 +011900 02 FILLER PIC X(39) VALUE SPACES. IC1014.2 +012000 01 CCVS-H-2A. IC1014.2 +012100 02 FILLER PIC X(40) VALUE SPACE. IC1014.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1014.2 +012300 02 FILLER PIC XXXX VALUE IC1014.2 +012400 "4.2 ". IC1014.2 +012500 02 FILLER PIC X(28) VALUE IC1014.2 +012600 " COPY - NOT FOR DISTRIBUTION". IC1014.2 +012700 02 FILLER PIC X(41) VALUE SPACE. IC1014.2 +012800 IC1014.2 +012900 01 CCVS-H-2B. IC1014.2 +013000 02 FILLER PIC X(15) VALUE IC1014.2 +013100 "TEST RESULT OF ". IC1014.2 +013200 02 TEST-ID PIC X(9). IC1014.2 +013300 02 FILLER PIC X(4) VALUE IC1014.2 +013400 " IN ". IC1014.2 +013500 02 FILLER PIC X(12) VALUE IC1014.2 +013600 " HIGH ". IC1014.2 +013700 02 FILLER PIC X(22) VALUE IC1014.2 +013800 " LEVEL VALIDATION FOR ". IC1014.2 +013900 02 FILLER PIC X(58) VALUE IC1014.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +014100 01 CCVS-H-3. IC1014.2 +014200 02 FILLER PIC X(34) VALUE IC1014.2 +014300 " FOR OFFICIAL USE ONLY ". IC1014.2 +014400 02 FILLER PIC X(58) VALUE IC1014.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1014.2 +014600 02 FILLER PIC X(28) VALUE IC1014.2 +014700 " COPYRIGHT 1985 ". IC1014.2 +014800 01 CCVS-E-1. IC1014.2 +014900 02 FILLER PIC X(52) VALUE SPACE. IC1014.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1014.2 +015100 02 ID-AGAIN PIC X(9). IC1014.2 +015200 02 FILLER PIC X(45) VALUE SPACES. IC1014.2 +015300 01 CCVS-E-2. IC1014.2 +015400 02 FILLER PIC X(31) VALUE SPACE. IC1014.2 +015500 02 FILLER PIC X(21) VALUE SPACE. IC1014.2 +015600 02 CCVS-E-2-2. IC1014.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1014.2 +015800 03 FILLER PIC X VALUE SPACE. IC1014.2 +015900 03 ENDER-DESC PIC X(44) VALUE IC1014.2 +016000 "ERRORS ENCOUNTERED". IC1014.2 +016100 01 CCVS-E-3. IC1014.2 +016200 02 FILLER PIC X(22) VALUE IC1014.2 +016300 " FOR OFFICIAL USE ONLY". IC1014.2 +016400 02 FILLER PIC X(12) VALUE SPACE. IC1014.2 +016500 02 FILLER PIC X(58) VALUE IC1014.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +016700 02 FILLER PIC X(13) VALUE SPACE. IC1014.2 +016800 02 FILLER PIC X(15) VALUE IC1014.2 +016900 " COPYRIGHT 1985". IC1014.2 +017000 01 CCVS-E-4. IC1014.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1014.2 +017200 02 FILLER PIC X(4) VALUE " OF ". IC1014.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1014.2 +017400 02 FILLER PIC X(40) VALUE IC1014.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". IC1014.2 +017600 01 XXINFO. IC1014.2 +017700 02 FILLER PIC X(19) VALUE IC1014.2 +017800 "*** INFORMATION ***". IC1014.2 +017900 02 INFO-TEXT. IC1014.2 +018000 04 FILLER PIC X(8) VALUE SPACE. IC1014.2 +018100 04 XXCOMPUTED PIC X(20). IC1014.2 +018200 04 FILLER PIC X(5) VALUE SPACE. IC1014.2 +018300 04 XXCORRECT PIC X(20). IC1014.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). IC1014.2 +018500 01 HYPHEN-LINE. IC1014.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. IC1014.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************IC1014.2 +018800- "*****************************************". IC1014.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************IC1014.2 +019000- "******************************". IC1014.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE IC1014.2 +019200 "IC101A". IC1014.2 +019300 PROCEDURE DIVISION. IC1014.2 +019400 CCVS1 SECTION. IC1014.2 +019500 OPEN-FILES. IC1014.2 +019600 OPEN OUTPUT PRINT-FILE. IC1014.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1014.2 +019800 MOVE SPACE TO TEST-RESULTS. IC1014.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1014.2 +020000 GO TO CCVS1-EXIT. IC1014.2 +020100 CLOSE-FILES. IC1014.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1014.2 +020300 TERMINATE-CCVS. IC1014.2 +020400S EXIT PROGRAM. IC1014.2 +020500STERMINATE-CALL. IC1014.2 +020600 STOP RUN. IC1014.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1014.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1014.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1014.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1014.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. IC1014.2 +021200 PRINT-DETAIL. IC1014.2 +021300 IF REC-CT NOT EQUAL TO ZERO IC1014.2 +021400 MOVE "." TO PARDOT-X IC1014.2 +021500 MOVE REC-CT TO DOTVALUE. IC1014.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1014.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1014.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1014.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1014.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1014.2 +022100 MOVE SPACE TO CORRECT-X. IC1014.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1014.2 +022300 MOVE SPACE TO RE-MARK. IC1014.2 +022400 HEAD-ROUTINE. IC1014.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1014.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1014.2 +022900 COLUMN-NAMES-ROUTINE. IC1014.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +023300 END-ROUTINE. IC1014.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1014.2 +023500 END-RTN-EXIT. IC1014.2 +023600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +023700 END-ROUTINE-1. IC1014.2 +023800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1014.2 +023900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1014.2 +024000 ADD PASS-COUNTER TO ERROR-HOLD. IC1014.2 +024100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1014.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1014.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1014.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1014.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1014.2 +024600 END-ROUTINE-12. IC1014.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1014.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO IC1014.2 +024900 MOVE "NO " TO ERROR-TOTAL IC1014.2 +025000 ELSE IC1014.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1014.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1014.2 +025300 PERFORM WRITE-LINE. IC1014.2 +025400 END-ROUTINE-13. IC1014.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO IC1014.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE IC1014.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1014.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1014.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO IC1014.2 +026100 MOVE "NO " TO ERROR-TOTAL IC1014.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1014.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1014.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026600 WRITE-LINE. IC1014.2 +026700 ADD 1 TO RECORD-COUNT. IC1014.2 +026800Y IF RECORD-COUNT GREATER 50 IC1014.2 +026900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1014.2 +027000Y MOVE SPACE TO DUMMY-RECORD IC1014.2 +027100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1014.2 +027200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1014.2 +027300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1014.2 +027400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1014.2 +027500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1014.2 +027600Y MOVE ZERO TO RECORD-COUNT. IC1014.2 +027700 PERFORM WRT-LN. IC1014.2 +027800 WRT-LN. IC1014.2 +027900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1014.2 +028000 MOVE SPACE TO DUMMY-RECORD. IC1014.2 +028100 BLANK-LINE-PRINT. IC1014.2 +028200 PERFORM WRT-LN. IC1014.2 +028300 FAIL-ROUTINE. IC1014.2 +028400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1014.2 +028500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1014.2 +028600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1014.2 +028700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1014.2 +028800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +028900 MOVE SPACES TO INF-ANSI-REFERENCE. IC1014.2 +029000 GO TO FAIL-ROUTINE-EX. IC1014.2 +029100 FAIL-ROUTINE-WRITE. IC1014.2 +029200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1014.2 +029300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1014.2 +029400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1014.2 +029500 MOVE SPACES TO COR-ANSI-REFERENCE. IC1014.2 +029600 FAIL-ROUTINE-EX. EXIT. IC1014.2 +029700 BAIL-OUT. IC1014.2 +029800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1014.2 +029900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1014.2 +030000 BAIL-OUT-WRITE. IC1014.2 +030100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1014.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1014.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. IC1014.2 +030500 BAIL-OUT-EX. EXIT. IC1014.2 +030600 CCVS1-EXIT. IC1014.2 +030700 EXIT. IC1014.2 +030800 SECT-IC101-0001 SECTION. IC1014.2 +030900 CALL-INIT-1. IC1014.2 +031000 MOVE "CALL...USING DATA-NM" TO FEATURE. IC1014.2 +031100 MOVE "CALL-TEST-01" TO PAR-NAME. IC1014.2 +031200 CALL-TEST-1. IC1014.2 +031300 CALL "IC102A" USING DN1. IC1014.2 +031400 IF DN1 IS EQUAL TO 1 IC1014.2 +031500 PERFORM PASS IC1014.2 +031600 GO TO CALL-WRITE-1. IC1014.2 +031700 CALL-FAIL-1. IC1014.2 +031800 MOVE 1 TO CORRECT-18V0. IC1014.2 +031900 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +032000 PERFORM FAIL. IC1014.2 +032100 CALL-WRITE-1. IC1014.2 +032200 PERFORM PRINT-DETAIL. IC1014.2 +032300 CALL-INIT-2. IC1014.2 +032400 MOVE 0 TO DN1. IC1014.2 +032500 CALL-TEST-2. IC1014.2 +032600 CALL "IC102A" USING DN1. IC1014.2 +032700 IF DN1 IS EQUAL TO 2 IC1014.2 +032800 PERFORM PASS IC1014.2 +032900 GO TO CALL-WRITE-2. IC1014.2 +033000 CALL-FAIL-2. IC1014.2 +033100 MOVE 2 TO CORRECT-18V0. IC1014.2 +033200 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +033300 PERFORM FAIL. IC1014.2 +033400 CALL-WRITE-2. IC1014.2 +033500 MOVE "CALL-TEST-02" TO PAR-NAME. IC1014.2 +033600 PERFORM PRINT-DETAIL. IC1014.2 +033700 CALL-INIT-3. IC1014.2 +033800 ADD 4 TO DN1. IC1014.2 +033900 CALL-TEST-3. IC1014.2 +034000 CALL "IC102A" USING DN1. IC1014.2 +034100 IF DN1 IS EQUAL TO 3 IC1014.2 +034200 PERFORM PASS IC1014.2 +034300 GO TO CALL-WRITE-3. IC1014.2 +034400 CALL-FAIL-3. IC1014.2 +034500 MOVE 3 TO CORRECT-18V0. IC1014.2 +034600 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +034700 PERFORM FAIL. IC1014.2 +034800 CALL-WRITE-3. IC1014.2 +034900 MOVE "CALL-TEST-03" TO PAR-NAME. IC1014.2 +035000 PERFORM PRINT-DETAIL. IC1014.2 +035100 CALL-TEST-4. IC1014.2 +035200 CALL "IC102A" USING DN2. IC1014.2 +035300 IF DN2 IS NOT EQUAL TO 4 IC1014.2 +035400 GO TO CALL-FAIL-4. IC1014.2 +035500 PERFORM PASS. IC1014.2 +035600 GO TO CALL-WRITE-4. IC1014.2 +035700 CALL-FAIL-4. IC1014.2 +035800 MOVE 4 TO CORRECT-18V0. IC1014.2 +035900 MOVE DN2 TO COMPUTED-18V0. IC1014.2 +036000 PERFORM FAIL. IC1014.2 +036100 CALL-WRITE-4. IC1014.2 +036200 MOVE "CALL-TEST-04" TO PAR-NAME. IC1014.2 +036300 PERFORM PRINT-DETAIL. IC1014.2 +036400 CALL-INIT-5. IC1014.2 +036500 MOVE 0 TO DN2. IC1014.2 +036600 CALL-TEST-5. IC1014.2 +036700 CALL "IC102A" USING DN2. IC1014.2 +036800 IF DN2 IS EQUAL TO 5 IC1014.2 +036900 PERFORM PASS IC1014.2 +037000 GO TO CALL-WRITE-5. IC1014.2 +037100 CALL-FAIL-5. IC1014.2 +037200 MOVE 5 TO CORRECT-18V0. IC1014.2 +037300 MOVE DN2 TO COMPUTED-18V0. IC1014.2 +037400 PERFORM FAIL. IC1014.2 +037500 CALL-WRITE-5. IC1014.2 +037600 MOVE "CALL-TEST-05" TO PAR-NAME. IC1014.2 +037700 PERFORM PRINT-DETAIL. IC1014.2 +037800 CALL-END-ROUTINE. IC1014.2 +037900 GO TO CCVS-EXIT. IC1014.2 +038000 CCVS-EXIT SECTION. IC1014.2 +038100 CCVS-999999. IC1014.2 +038200 GO TO CLOSE-FILES. IC1014.2 +*END-OF,IC101A +*HEADER,COBOL,IC101A,SUBRTN,IC102A +000100 IDENTIFICATION DIVISION. IC1024.2 +000200 PROGRAM-ID. IC1024.2 +000300 IC102A. IC1024.2 +000400**************************************************************** IC1024.2 +000500* * IC1024.2 +000600* VALIDATION FOR:- * IC1024.2 +000700* * IC1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1024.2 +000900* * IC1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1024.2 +001100* * IC1024.2 +001200**************************************************************** IC1024.2 +001300* * IC1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1024.2 +001500* * IC1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1024.2 +001900* * IC1024.2 +002000**************************************************************** IC1024.2 +002100* THIS PROGRAM TESTS THE USE OF THE LINKAGE SECTION IC1024.2 +002200* AND USING PHRASE IN THE PROCEDURE DIVISION HEADER. IC1024.2 +002300 ENVIRONMENT DIVISION. IC1024.2 +002400 CONFIGURATION SECTION. IC1024.2 +002500 SOURCE-COMPUTER. IC1024.2 +002600 XXXXX082. IC1024.2 +002700 OBJECT-COMPUTER. IC1024.2 +002800 XXXXX083. IC1024.2 +002900 INPUT-OUTPUT SECTION. IC1024.2 +003000 FILE-CONTROL. IC1024.2 +003100 SELECT PRINT-FILE ASSIGN TO IC1024.2 +003200 XXXXX055. IC1024.2 +003300 DATA DIVISION. IC1024.2 +003400 FILE SECTION. IC1024.2 +003500 FD PRINT-FILE. IC1024.2 +003600 01 PRINT-REC PICTURE X(120). IC1024.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC1024.2 +003800 WORKING-STORAGE SECTION. IC1024.2 +003900 77 DN2 PICTURE S9 VALUE ZERO. IC1024.2 +004000 LINKAGE SECTION. IC1024.2 +004100 77 DN1 PICTURE S9. IC1024.2 +004200 PROCEDURE DIVISION USING DN1. IC1024.2 +004300 SECT-IC102-0001 SECTION. IC1024.2 +004400 CALL-TEST-001. IC1024.2 +004500 ADD 1 TO DN2. IC1024.2 +004600 MOVE DN2 TO DN1. IC1024.2 +004700 CALL-EXIT-001. IC1024.2 +004800 EXIT PROGRAM. IC1024.2 +*END-OF,IC102A +*HEADER,COBOL,IC103A +000100 IDENTIFICATION DIVISION. IC1034.2 +000200 PROGRAM-ID. IC1034.2 +000300 IC103A. IC1034.2 +000400**************************************************************** IC1034.2 +000500* * IC1034.2 +000600* VALIDATION FOR:- * IC1034.2 +000700* * IC1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +000900* * IC1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1034.2 +001100* * IC1034.2 +001200**************************************************************** IC1034.2 +001300* * IC1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1034.2 +001500* * IC1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1034.2 +001900* * IC1034.2 +002000**************************************************************** IC1034.2 +002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC1034.2 +002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC1034.2 +002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC1034.2 +002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC1034.2 +002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC1034.2 +002600* ARE IDENTICAL. IC1034.2 +002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC1034.2 +002800* THAN ONE EXIT PROGRAM STATEMENT. IC1034.2 +002900 ENVIRONMENT DIVISION. IC1034.2 +003000 CONFIGURATION SECTION. IC1034.2 +003100 SOURCE-COMPUTER. IC1034.2 +003200 XXXXX082. IC1034.2 +003300 OBJECT-COMPUTER. IC1034.2 +003400 XXXXX083. IC1034.2 +003500 INPUT-OUTPUT SECTION. IC1034.2 +003600 FILE-CONTROL. IC1034.2 +003700 SELECT PRINT-FILE ASSIGN TO IC1034.2 +003800 XXXXX055. IC1034.2 +003900 DATA DIVISION. IC1034.2 +004000 FILE SECTION. IC1034.2 +004100 FD PRINT-FILE. IC1034.2 +004200 01 PRINT-REC PICTURE X(120). IC1034.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC1034.2 +004400 WORKING-STORAGE SECTION. IC1034.2 +004500 77 MAIN-DN1 PICTURE 999. IC1034.2 +004600 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC1034.2 +004700 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC1034.2 +004800 01 GROUP-01. IC1034.2 +004900 02 ALPHA-NUM-FIELD PIC X(5). IC1034.2 +005000 02 GROUP-LEV2. IC1034.2 +005100 03 NUMER-FIELD PIC 99. IC1034.2 +005200 03 ALPHA-FIELD PIC A(3). IC1034.2 +005300 01 GROUP-02. IC1034.2 +005400 02 NUM-ITEM PIC S99. IC1034.2 +005500 02 ALPHA-EDITED PICTURE X(6). IC1034.2 +005600 01 TEST-RESULTS. IC1034.2 +005700 02 FILLER PIC X VALUE SPACE. IC1034.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC1034.2 +005900 02 FILLER PIC X VALUE SPACE. IC1034.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC1034.2 +006100 02 FILLER PIC X VALUE SPACE. IC1034.2 +006200 02 PAR-NAME. IC1034.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC1034.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC1034.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC1034.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC1034.2 +006700 02 RE-MARK PIC X(61). IC1034.2 +006800 01 TEST-COMPUTED. IC1034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC1034.2 +007000 02 FILLER PIC X(17) VALUE IC1034.2 +007100 " COMPUTED=". IC1034.2 +007200 02 COMPUTED-X. IC1034.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1034.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC1034.2 +007500 PIC -9(9).9(9). IC1034.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1034.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1034.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1034.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC1034.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC1034.2 +008100 04 FILLER PIC X. IC1034.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC1034.2 +008300 01 TEST-CORRECT. IC1034.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC1034.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC1034.2 +008600 02 CORRECT-X. IC1034.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC1034.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1034.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1034.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1034.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1034.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC1034.2 +009300 04 CORRECT-18V0 PIC -9(18). IC1034.2 +009400 04 FILLER PIC X. IC1034.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC1034.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1034.2 +009700 01 CCVS-C-1. IC1034.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1034.2 +009900- "SS PARAGRAPH-NAME IC1034.2 +010000- " REMARKS". IC1034.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC1034.2 +010200 01 CCVS-C-2. IC1034.2 +010300 02 FILLER PIC X VALUE SPACE. IC1034.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC1034.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC1034.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC1034.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC1034.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1034.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC1034.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1034.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1034.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1034.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1034.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1034.2 +011900 01 CCVS-H-1. IC1034.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC1034.2 +012100 02 FILLER PIC X(42) VALUE IC1034.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1034.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC1034.2 +012400 01 CCVS-H-2A. IC1034.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC1034.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1034.2 +012700 02 FILLER PIC XXXX VALUE IC1034.2 +012800 "4.2 ". IC1034.2 +012900 02 FILLER PIC X(28) VALUE IC1034.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC1034.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC1034.2 +013200 IC1034.2 +013300 01 CCVS-H-2B. IC1034.2 +013400 02 FILLER PIC X(15) VALUE IC1034.2 +013500 "TEST RESULT OF ". IC1034.2 +013600 02 TEST-ID PIC X(9). IC1034.2 +013700 02 FILLER PIC X(4) VALUE IC1034.2 +013800 " IN ". IC1034.2 +013900 02 FILLER PIC X(12) VALUE IC1034.2 +014000 " HIGH ". IC1034.2 +014100 02 FILLER PIC X(22) VALUE IC1034.2 +014200 " LEVEL VALIDATION FOR ". IC1034.2 +014300 02 FILLER PIC X(58) VALUE IC1034.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +014500 01 CCVS-H-3. IC1034.2 +014600 02 FILLER PIC X(34) VALUE IC1034.2 +014700 " FOR OFFICIAL USE ONLY ". IC1034.2 +014800 02 FILLER PIC X(58) VALUE IC1034.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1034.2 +015000 02 FILLER PIC X(28) VALUE IC1034.2 +015100 " COPYRIGHT 1985 ". IC1034.2 +015200 01 CCVS-E-1. IC1034.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC1034.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1034.2 +015500 02 ID-AGAIN PIC X(9). IC1034.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC1034.2 +015700 01 CCVS-E-2. IC1034.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC1034.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC1034.2 +016000 02 CCVS-E-2-2. IC1034.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1034.2 +016200 03 FILLER PIC X VALUE SPACE. IC1034.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC1034.2 +016400 "ERRORS ENCOUNTERED". IC1034.2 +016500 01 CCVS-E-3. IC1034.2 +016600 02 FILLER PIC X(22) VALUE IC1034.2 +016700 " FOR OFFICIAL USE ONLY". IC1034.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC1034.2 +016900 02 FILLER PIC X(58) VALUE IC1034.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC1034.2 +017200 02 FILLER PIC X(15) VALUE IC1034.2 +017300 " COPYRIGHT 1985". IC1034.2 +017400 01 CCVS-E-4. IC1034.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1034.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC1034.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1034.2 +017800 02 FILLER PIC X(40) VALUE IC1034.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC1034.2 +018000 01 XXINFO. IC1034.2 +018100 02 FILLER PIC X(19) VALUE IC1034.2 +018200 "*** INFORMATION ***". IC1034.2 +018300 02 INFO-TEXT. IC1034.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC1034.2 +018500 04 XXCOMPUTED PIC X(20). IC1034.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC1034.2 +018700 04 XXCORRECT PIC X(20). IC1034.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC1034.2 +018900 01 HYPHEN-LINE. IC1034.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC1034.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC1034.2 +019200- "*****************************************". IC1034.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC1034.2 +019400- "******************************". IC1034.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC1034.2 +019600 "IC103A". IC1034.2 +019700 PROCEDURE DIVISION. IC1034.2 +019800 CCVS1 SECTION. IC1034.2 +019900 OPEN-FILES. IC1034.2 +020000 OPEN OUTPUT PRINT-FILE. IC1034.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1034.2 +020200 MOVE SPACE TO TEST-RESULTS. IC1034.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1034.2 +020400 GO TO CCVS1-EXIT. IC1034.2 +020500 CLOSE-FILES. IC1034.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1034.2 +020700 TERMINATE-CCVS. IC1034.2 +020800S EXIT PROGRAM. IC1034.2 +020900STERMINATE-CALL. IC1034.2 +021000 STOP RUN. IC1034.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1034.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1034.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1034.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1034.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC1034.2 +021600 PRINT-DETAIL. IC1034.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC1034.2 +021800 MOVE "." TO PARDOT-X IC1034.2 +021900 MOVE REC-CT TO DOTVALUE. IC1034.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1034.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1034.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1034.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1034.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1034.2 +022500 MOVE SPACE TO CORRECT-X. IC1034.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1034.2 +022700 MOVE SPACE TO RE-MARK. IC1034.2 +022800 HEAD-ROUTINE. IC1034.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2 +023300 COLUMN-NAMES-ROUTINE. IC1034.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +023700 END-ROUTINE. IC1034.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1034.2 +023900 END-RTN-EXIT. IC1034.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +024100 END-ROUTINE-1. IC1034.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1034.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1034.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC1034.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1034.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1034.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1034.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1034.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1034.2 +025000 END-ROUTINE-12. IC1034.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1034.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC1034.2 +025300 MOVE "NO " TO ERROR-TOTAL IC1034.2 +025400 ELSE IC1034.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1034.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1034.2 +025700 PERFORM WRITE-LINE. IC1034.2 +025800 END-ROUTINE-13. IC1034.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC1034.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC1034.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1034.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC1034.2 +026500 MOVE "NO " TO ERROR-TOTAL IC1034.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1034.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1034.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +027000 WRITE-LINE. IC1034.2 +027100 ADD 1 TO RECORD-COUNT. IC1034.2 +027200Y IF RECORD-COUNT GREATER 50 IC1034.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1034.2 +027400Y MOVE SPACE TO DUMMY-RECORD IC1034.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1034.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1034.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1034.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1034.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1034.2 +028000Y MOVE ZERO TO RECORD-COUNT. IC1034.2 +028100 PERFORM WRT-LN. IC1034.2 +028200 WRT-LN. IC1034.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1034.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC1034.2 +028500 BLANK-LINE-PRINT. IC1034.2 +028600 PERFORM WRT-LN. IC1034.2 +028700 FAIL-ROUTINE. IC1034.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2 +029400 GO TO FAIL-ROUTINE-EX. IC1034.2 +029500 FAIL-ROUTINE-WRITE. IC1034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC1034.2 +030000 FAIL-ROUTINE-EX. EXIT. IC1034.2 +030100 BAIL-OUT. IC1034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1034.2 +030400 BAIL-OUT-WRITE. IC1034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2 +030900 BAIL-OUT-EX. EXIT. IC1034.2 +031000 CCVS1-EXIT. IC1034.2 +031100 EXIT. IC1034.2 +031200 SECT-IC103-0001 SECTION. IC1034.2 +031300* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC1034.2 +031400* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC1034.2 +031500* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC1034.2 +031600 EXIT-INIT. IC1034.2 +031700 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC1034.2 +031800 EXIT-INIT-001. IC1034.2 +031900 MOVE 0 TO MAIN-DN2. IC1034.2 +032000 MOVE 1 TO MAIN-DN1. IC1034.2 +032100 EXIT-TEST-001. IC1034.2 +032200 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +032300 IF MAIN-DN2 EQUAL TO 1 IC1034.2 +032400 PERFORM PASS IC1034.2 +032500 GO TO EXIT-WRITE-001. IC1034.2 +032600 EXIT-FAIL-001. IC1034.2 +032700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +032800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +032900 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +033000 PERFORM FAIL. IC1034.2 +033100 EXIT-WRITE-001. IC1034.2 +033200 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2 +033300 PERFORM PRINT-DETAIL. IC1034.2 +033400 EXIT-INIT-002. IC1034.2 +033500 MOVE 0 TO MAIN-DN2. IC1034.2 +033600 MOVE 2 TO MAIN-DN1. IC1034.2 +033700 EXIT-TEST-002. IC1034.2 +033800 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +033900 IF MAIN-DN2 EQUAL TO 2 IC1034.2 +034000 PERFORM PASS IC1034.2 +034100 GO TO EXIT-WRITE-002. IC1034.2 +034200 EXIT-FAIL-002. IC1034.2 +034300 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +034400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +034500 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +034600 PERFORM FAIL. IC1034.2 +034700 EXIT-WRITE-002. IC1034.2 +034800 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2 +034900 PERFORM PRINT-DETAIL. IC1034.2 +035000 EXIT-INIT-003. IC1034.2 +035100 MOVE 0 TO MAIN-DN2. IC1034.2 +035200 MOVE 3 TO MAIN-DN1. IC1034.2 +035300 EXIT-TEST-003. IC1034.2 +035400 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +035500 IF MAIN-DN2 NOT EQUAL TO 3 IC1034.2 +035600 GO TO EXIT-FAIL-003. IC1034.2 +035700 PERFORM PASS. IC1034.2 +035800 GO TO EXIT-WRITE-003. IC1034.2 +035900 EXIT-FAIL-003. IC1034.2 +036000 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +036100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +036200 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +036300 PERFORM FAIL. IC1034.2 +036400 EXIT-WRITE-003. IC1034.2 +036500 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2 +036600 PERFORM PRINT-DETAIL. IC1034.2 +036700 EXIT-INIT-004. IC1034.2 +036800 MOVE 0 TO MAIN-DN2. IC1034.2 +036900 MOVE 4 TO MAIN-DN1. IC1034.2 +037000 EXIT-TEST-004. IC1034.2 +037100 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +037200 IF MAIN-DN2 NOT EQUAL TO 4 IC1034.2 +037300 GO TO EXIT-FAIL-004. IC1034.2 +037400 PERFORM PASS. IC1034.2 +037500 GO TO EXIT-WRITE-004. IC1034.2 +037600 EXIT-FAIL-004. IC1034.2 +037700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +037800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +037900 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +038000 PERFORM FAIL. IC1034.2 +038100 EXIT-WRITE-004. IC1034.2 +038200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2 +038300 PERFORM PRINT-DETAIL. IC1034.2 +038400 GO TO SECT-IC103-0002. IC1034.2 +038500 EXIT-DELETES. IC1034.2 +038600* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC1034.2 +038700* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2 +038800* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC1034.2 +038900 PERFORM DE-LETE. IC1034.2 +039000 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2 +039100 PERFORM PRINT-DETAIL. IC1034.2 +039200 PERFORM DE-LETE. IC1034.2 +039300 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2 +039400 PERFORM PRINT-DETAIL. IC1034.2 +039500 PERFORM DE-LETE. IC1034.2 +039600 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2 +039700 PERFORM PRINT-DETAIL. IC1034.2 +039800 PERFORM DE-LETE. IC1034.2 +039900 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2 +040000 PERFORM PRINT-DETAIL. IC1034.2 +040100 SECT-IC103-0002 SECTION. IC1034.2 +040200* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC1034.2 +040300* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC1034.2 +040400* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC1034.2 +040500* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC1034.2 +040600* REFERENCE X3.23-1974, SECTION XII, 3.1 AND 3.2. IC1034.2 +040700 CALL-INIT-06. IC1034.2 +040800 MOVE "CALL-TEST-06" TO PAR-NAME. IC1034.2 +040900 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC1034.2 +041000 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC1034.2 +041100 MOVE "CALL USING DN SERIES" TO FEATURE. IC1034.2 +041200 CALL-TEST-06. IC1034.2 +041300 CALL "IC104A" USING GROUP-01 ELEM-77 GROUP-02. IC1034.2 +041400 GO TO CALL-TEST-06-01. IC1034.2 +041500 CALL-DELETE-06. IC1034.2 +041600 PERFORM DE-LETE. IC1034.2 +041700 PERFORM PRINT-DETAIL. IC1034.2 +041800 GO TO CCVS-EXIT. IC1034.2 +041900* IF IC104 CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2 +042000* DELETE THE PARAGRAPH CALL-TEST-06. IC1034.2 +042100 CALL-TEST-06-01. IC1034.2 +042200 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC104" IC1034.2 +042300 GO TO CALL-FAIL-06-01. IC1034.2 +042400 PERFORM PASS. IC1034.2 +042500 GO TO CALL-WRITE-06-01. IC1034.2 +042600 CALL-FAIL-06-01. IC1034.2 +042700 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC1034.2 +042800 MOVE "IC104" TO CORRECT-A. IC1034.2 +042900 PERFORM FAIL. IC1034.2 +043000 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC1034.2 +043100 CALL-WRITE-06-01. IC1034.2 +043200 ADD 1 TO REC-CT. IC1034.2 +043300 PERFORM PRINT-DETAIL. IC1034.2 +043400 CALL-TEST-06-02. IC1034.2 +043500 IF NUMER-FIELD EQUAL TO 25 IC1034.2 +043600 PERFORM PASS IC1034.2 +043700 GO TO CALL-WRITE-06-02. IC1034.2 +043800 CALL-FAIL-06-02. IC1034.2 +043900 PERFORM FAIL. IC1034.2 +044000 MOVE NUMER-FIELD TO COMPUTED-18V0. IC1034.2 +044100 MOVE 25 TO CORRECT-18V0. IC1034.2 +044200 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC1034.2 +044300 CALL-WRITE-06-02. IC1034.2 +044400 ADD 1 TO REC-CT. IC1034.2 +044500 PERFORM PRINT-DETAIL. IC1034.2 +044600 CALL-TEST-06-03. IC1034.2 +044700 IF ALPHA-FIELD EQUAL TO "YES" IC1034.2 +044800 PERFORM PASS IC1034.2 +044900 GO TO CALL-WRITE-06-03. IC1034.2 +045000 CALL-FAIL-06-03. IC1034.2 +045100 PERFORM FAIL. IC1034.2 +045200 MOVE ALPHA-FIELD TO COMPUTED-A. IC1034.2 +045300 MOVE "YES" TO CORRECT-A. IC1034.2 +045400 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC1034.2 +045500 CALL-WRITE-06-03. IC1034.2 +045600 ADD 1 TO REC-CT. IC1034.2 +045700 PERFORM PRINT-DETAIL. IC1034.2 +045800 CALL-TEST-06-04. IC1034.2 +045900 IF ELEM-77 EQUAL TO 0.7654 IC1034.2 +046000 PERFORM PASS IC1034.2 +046100 GO TO CALL-WRITE-06-04. IC1034.2 +046200 CALL-FAIL-06-04. IC1034.2 +046300 PERFORM FAIL. IC1034.2 +046400 MOVE ELEM-77 TO COMPUTED-4V14. IC1034.2 +046500 MOVE 0.7654 TO CORRECT-4V14. IC1034.2 +046600 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC1034.2 +046700 CALL-WRITE-06-04. IC1034.2 +046800 ADD 1 TO REC-CT. IC1034.2 +046900 PERFORM PRINT-DETAIL. IC1034.2 +047000 CALL-TEST-06-05. IC1034.2 +047100 IF NUM-ITEM EQUAL TO 25 IC1034.2 +047200 PERFORM PASS IC1034.2 +047300 GO TO CALL-WRITE-06-05. IC1034.2 +047400 CALL-FAIL-06-05. IC1034.2 +047500 PERFORM FAIL. IC1034.2 +047600 MOVE NUM-ITEM TO COMPUTED-18V0. IC1034.2 +047700 MOVE 25 TO CORRECT-18V0. IC1034.2 +047800 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC1034.2 +047900 CALL-WRITE-06-05. IC1034.2 +048000 ADD 1 TO REC-CT. IC1034.2 +048100 PERFORM PRINT-DETAIL. IC1034.2 +048200 CALL-TEST-06-06. IC1034.2 +048300 IF ALPHA-EDITED EQUAL TO "AB C0D" IC1034.2 +048400 PERFORM PASS IC1034.2 +048500 GO TO CALL-WRITE-06-06. IC1034.2 +048600 CALL-FAIL-06-06. IC1034.2 +048700 PERFORM FAIL. IC1034.2 +048800 MOVE ALPHA-EDITED TO COMPUTED-A. IC1034.2 +048900 MOVE "AB C0D" TO CORRECT-A. IC1034.2 +049000 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC1034.2 +049100 CALL-WRITE-06-06. IC1034.2 +049200 ADD 1 TO REC-CT. IC1034.2 +049300 PERFORM PRINT-DETAIL. IC1034.2 +049400 GO TO CCVS-EXIT. IC1034.2 +049500 CCVS-EXIT SECTION. IC1034.2 +049600 CCVS-999999. IC1034.2 +049700 GO TO CLOSE-FILES. IC1034.2 +*END-OF,IC103A +*HEADER,COBOL,IC103A,SUBRTN,IC104A +000100 IDENTIFICATION DIVISION. IC1044.2 +000200 PROGRAM-ID. IC1044.2 +000300 IC104A. IC1044.2 +000400**************************************************************** IC1044.2 +000500* * IC1044.2 +000600* VALIDATION FOR:- * IC1044.2 +000700* * IC1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1044.2 +000900* * IC1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1044.2 +001100* * IC1044.2 +001200**************************************************************** IC1044.2 +001300* * IC1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1044.2 +001500* * IC1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1044.2 +001900* * IC1044.2 +002000**************************************************************** IC1044.2 +002100* THE SUBPROGRAM IC104 HAS THREE OPERANDS IN THE IC1044.2 +002200* USING PHRASE OF THE PROCEDURE DIVISION HEADER. TWO IC1044.2 +002300* OPERANDS ARE 01 GROUP ITEMS AND THE THIRD OPERAND IS IC1044.2 +002400* AN ELEMENTARY 77 ITEM. THE DATA DESCRIPTIONS OF THESE IC1044.2 +002500* OPERANDS IN THE LINKAGE SECTION ARE NOT THE SAME AS THE IC1044.2 +002600* DATA DESCRIPTIONS IN THE WORKING-STORAGE SECTION OF THE IC1044.2 +002700* CALLING PROGRAM, BUT AN EQUAL NUMBER OF CHARACTER IC1044.2 +002800* POSITIONS ARE DEFINED. THE CALLING PROGRAM IS IC103. IC1044.2 +002900 ENVIRONMENT DIVISION. IC1044.2 +003000 CONFIGURATION SECTION. IC1044.2 +003100 SOURCE-COMPUTER. IC1044.2 +003200 XXXXX082. IC1044.2 +003300 OBJECT-COMPUTER. IC1044.2 +003400 XXXXX083. IC1044.2 +003500 INPUT-OUTPUT SECTION. IC1044.2 +003600 FILE-CONTROL. IC1044.2 +003700 SELECT PRINT-FILE ASSIGN TO IC1044.2 +003800 XXXXX055. IC1044.2 +003900 DATA DIVISION. IC1044.2 +004000 FILE SECTION. IC1044.2 +004100 FD PRINT-FILE. IC1044.2 +004200 01 PRINT-REC PICTURE X(120). IC1044.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC1044.2 +004400 WORKING-STORAGE SECTION. IC1044.2 +004500 01 CONSTANT-VALUES. IC1044.2 +004600 02 AN-CONSTANT PIC X(5) VALUE "IC104". IC1044.2 +004700 02 NUM-CONSTANT PIC 99V9999 VALUE 0.7654. IC1044.2 +004800 LINKAGE SECTION. IC1044.2 +004900 01 GRP-01. IC1044.2 +005000 02 AN-FIELD PICTURE X(5). IC1044.2 +005100 02 NUM-DISPLAY PIC 99. IC1044.2 +005200 02 GRP-LEVEL. IC1044.2 +005300 03 A-FIELD PICTURE A(3). IC1044.2 +005400 77 ELEM-01 PIC V9(4) COMPUTATIONAL. IC1044.2 +005500 01 GRP-02. IC1044.2 +005600 02 GRP-03. IC1044.2 +005700 03 NUM-ITEM PICTURE S99. IC1044.2 +005800 03 EDITED-FIELD PIC XXBX0X. IC1044.2 +005900 PROCEDURE DIVISION USING GRP-01 ELEM-01 GRP-02. IC1044.2 +006000 SECT-IC104-0001 SECTION. IC1044.2 +006100* THIS SECTION SETS THE PARAMETER FIELDS REFERRED TO IC1044.2 +006200* IN THE USING PHRASE AND DEFINED IN THE LINKAGE SECTION. IC1044.2 +006300 CALL-TEST-06. IC1044.2 +006400 MOVE AN-CONSTANT TO AN-FIELD. IC1044.2 +006500 ADD 25 TO NUM-DISPLAY. IC1044.2 +006600 MOVE "YES" TO A-FIELD. IC1044.2 +006700 MOVE NUM-CONSTANT TO ELEM-01. IC1044.2 +006800 MOVE NUM-DISPLAY TO NUM-ITEM. IC1044.2 +006900 MOVE "ABCD" TO EDITED-FIELD. IC1044.2 +007000 CALL-EXIT-06. IC1044.2 +007100 EXIT PROGRAM. IC1044.2 +*END-OF,IC104A +*HEADER,COBOL,IC103A,SUBRTN,IC105A +000100 IDENTIFICATION DIVISION. IC1054.2 +000200 PROGRAM-ID. IC1054.2 +000300 IC105A. IC1054.2 +000400**************************************************************** IC1054.2 +000500* * IC1054.2 +000600* VALIDATION FOR:- * IC1054.2 +000700* * IC1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1054.2 +000900* * IC1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1054.2 +001100* * IC1054.2 +001200**************************************************************** IC1054.2 +001300* * IC1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1054.2 +001500* * IC1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1054.2 +001900* * IC1054.2 +002000**************************************************************** IC1054.2 +002100* THE SUBPROGRAM IC105 HAS TWO OPERANDS IN THE IC1054.2 +002200* PROCEDURE DIVISION HEADER AND THE ROUTINE CONTAINS IC1054.2 +002300* FOUR EXIT PROGRAM STATEMENTS. THE CALLING PROGRAM IC1054.2 +002400* IS IC103. IC1054.2 +002500 ENVIRONMENT DIVISION. IC1054.2 +002600 CONFIGURATION SECTION. IC1054.2 +002700 SOURCE-COMPUTER. IC1054.2 +002800 XXXXX082. IC1054.2 +002900 OBJECT-COMPUTER. IC1054.2 +003000 XXXXX083. IC1054.2 +003100 DATA DIVISION. IC1054.2 +003200 LINKAGE SECTION. IC1054.2 +003300 77 DN1 PICTURE 999. IC1054.2 +003400 77 DN2 PICTURE S99 COMPUTATIONAL. IC1054.2 +003500 PROCEDURE DIVISION USING DN1 DN2. IC1054.2 +003600* THIS SUBPROGRAM CONTANS FOUR EXIT PROGRAM STATEMENTS. IC1054.2 +003700* REFERENCE X3.23-1974, SECTION XII, 3.4. IC1054.2 +003800 SECT-IC105-0001 SECTION. IC1054.2 +003900 EXIT-TEST-001. IC1054.2 +004000 IF DN1 IS NOT EQUAL TO 1 IC1054.2 +004100 GO TO EXIT-TEST-002. IC1054.2 +004200 MOVE 1 TO DN2. IC1054.2 +004300 EXIT-STATEMENT-001. IC1054.2 +004400 EXIT PROGRAM. IC1054.2 +004500 EXIT-TEST-002. IC1054.2 +004600 IF DN1 IS NOT EQUAL TO 2 IC1054.2 +004700 GO TO EXIT-TEST-003. IC1054.2 +004800 MOVE 2 TO DN2. IC1054.2 +004900 EXIT-STATEMENT-002. IC1054.2 +005000 EXIT PROGRAM. IC1054.2 +005100 EXIT-TEST-003. IC1054.2 +005200 IF DN1 NOT EQUAL TO 3 IC1054.2 +005300 GO TO EXIT-TEST-004. IC1054.2 +005400 MOVE 3 TO DN2. IC1054.2 +005500 EXIT-STATEMENT-003. IC1054.2 +005600 EXIT PROGRAM. IC1054.2 +005700 EXIT-TEST-004. IC1054.2 +005800 MOVE 4 TO DN2. IC1054.2 +005900 GO TO EXIT-STATEMENT-004. IC1054.2 +006000 EXTRANEOUS-PARAGRAPH. IC1054.2 +006100* THIS PARAGRAPH IS NEVER EXECUTED. IC1054.2 +006200 MOVE 5 TO DN2. IC1054.2 +006300 EXIT-STATEMENT-004. IC1054.2 +006400 EXIT PROGRAM. IC1054.2 +*END-OF,IC105A +*HEADER,COBOL,IC106A +000100 IDENTIFICATION DIVISION. IC1064.2 +000200 PROGRAM-ID. IC1064.2 +000300 IC106A. IC1064.2 +000400**************************************************************** IC1064.2 +000500* * IC1064.2 +000600* VALIDATION FOR:- * IC1064.2 +000700* * IC1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +000900* * IC1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1064.2 +001100* * IC1064.2 +001200**************************************************************** IC1064.2 +001300* * IC1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1064.2 +001500* * IC1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1064.2 +001900* * IC1064.2 +002000**************************************************************** IC1064.2 +002100* THIS PROGRAM CALLS A SUBPROGRAM WITH TWO TABLES IC1064.2 +002200* AND AN INDEX DATA ITEM REFERENCED IN THE USING PHRASE IC1064.2 +002300* OF THE CALL STATEMENT. BOTH OF THE TABLES CONTAIN AN IC1064.2 +002400* INDEXED BY CLAUSE. IC1064.2 +002500* THE TESTS IN THIS PROGRAM VERIFY THAT IC1064.2 +002600* (1) THE INDICES IN THE MAIN PROGRAM AND THE IC1064.2 +002700* SUBPROGRAM ARE SEPARATE, IC1064.2 +002800* (2) AN INDEX DATA ITEM SET IN A MAIN PROGRAM IC1064.2 +002900* CAN BE USED TO SET AN INDEX IN A SUBPROGRAM, IC1064.2 +003000* (3) TABLES CAN BE SHARED BETWEEN A MAIN PROGRAM IC1064.2 +003100* AND A SUBPROGRAM. IC1064.2 +003200* THE SUBPROGRAM IC107 IS CALLED BY THIS PROGRAM. IC1064.2 +003300 ENVIRONMENT DIVISION. IC1064.2 +003400 CONFIGURATION SECTION. IC1064.2 +003500 SOURCE-COMPUTER. IC1064.2 +003600 XXXXX082. IC1064.2 +003700 OBJECT-COMPUTER. IC1064.2 +003800 XXXXX083. IC1064.2 +003900 INPUT-OUTPUT SECTION. IC1064.2 +004000 FILE-CONTROL. IC1064.2 +004100 SELECT PRINT-FILE ASSIGN TO IC1064.2 +004200 XXXXX055. IC1064.2 +004300 DATA DIVISION. IC1064.2 +004400 FILE SECTION. IC1064.2 +004500 FD PRINT-FILE. IC1064.2 +004600 01 PRINT-REC PICTURE X(120). IC1064.2 +004700 01 DUMMY-RECORD PICTURE X(120). IC1064.2 +004800 WORKING-STORAGE SECTION. IC1064.2 +004900 77 IDN1 USAGE IS INDEX. IC1064.2 +005000 77 INDEX-VALUE PIC 999. IC1064.2 +005100 01 TABLE-1. IC1064.2 +005200 02 DN1 PICTURE X IC1064.2 +005300 OCCURS 10 TIMES IC1064.2 +005400 INDEXED BY IN1. IC1064.2 +005500 01 TABLE-2. IC1064.2 +005600 02 DN2 PICTURE X IC1064.2 +005700 OCCURS 10 TIMES IC1064.2 +005800 INDEXED BY IN2. IC1064.2 +005900 01 TEST-RESULTS. IC1064.2 +006000 02 FILLER PIC X VALUE SPACE. IC1064.2 +006100 02 FEATURE PIC X(20) VALUE SPACE. IC1064.2 +006200 02 FILLER PIC X VALUE SPACE. IC1064.2 +006300 02 P-OR-F PIC X(5) VALUE SPACE. IC1064.2 +006400 02 FILLER PIC X VALUE SPACE. IC1064.2 +006500 02 PAR-NAME. IC1064.2 +006600 03 FILLER PIC X(19) VALUE SPACE. IC1064.2 +006700 03 PARDOT-X PIC X VALUE SPACE. IC1064.2 +006800 03 DOTVALUE PIC 99 VALUE ZERO. IC1064.2 +006900 02 FILLER PIC X(8) VALUE SPACE. IC1064.2 +007000 02 RE-MARK PIC X(61). IC1064.2 +007100 01 TEST-COMPUTED. IC1064.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IC1064.2 +007300 02 FILLER PIC X(17) VALUE IC1064.2 +007400 " COMPUTED=". IC1064.2 +007500 02 COMPUTED-X. IC1064.2 +007600 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1064.2 +007700 03 COMPUTED-N REDEFINES COMPUTED-A IC1064.2 +007800 PIC -9(9).9(9). IC1064.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1064.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1064.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1064.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. IC1064.2 +008300 04 COMPUTED-18V0 PIC -9(18). IC1064.2 +008400 04 FILLER PIC X. IC1064.2 +008500 03 FILLER PIC X(50) VALUE SPACE. IC1064.2 +008600 01 TEST-CORRECT. IC1064.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC1064.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". IC1064.2 +008900 02 CORRECT-X. IC1064.2 +009000 03 CORRECT-A PIC X(20) VALUE SPACE. IC1064.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1064.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1064.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1064.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1064.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. IC1064.2 +009600 04 CORRECT-18V0 PIC -9(18). IC1064.2 +009700 04 FILLER PIC X. IC1064.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IC1064.2 +009900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1064.2 +010000 01 CCVS-C-1. IC1064.2 +010100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1064.2 +010200- "SS PARAGRAPH-NAME IC1064.2 +010300- " REMARKS". IC1064.2 +010400 02 FILLER PIC X(20) VALUE SPACE. IC1064.2 +010500 01 CCVS-C-2. IC1064.2 +010600 02 FILLER PIC X VALUE SPACE. IC1064.2 +010700 02 FILLER PIC X(6) VALUE "TESTED". IC1064.2 +010800 02 FILLER PIC X(15) VALUE SPACE. IC1064.2 +010900 02 FILLER PIC X(4) VALUE "FAIL". IC1064.2 +011000 02 FILLER PIC X(94) VALUE SPACE. IC1064.2 +011100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1064.2 +011200 01 REC-CT PIC 99 VALUE ZERO. IC1064.2 +011300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011600 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1064.2 +011800 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1064.2 +011900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1064.2 +012000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1064.2 +012100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1064.2 +012200 01 CCVS-H-1. IC1064.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC1064.2 +012400 02 FILLER PIC X(42) VALUE IC1064.2 +012500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1064.2 +012600 02 FILLER PIC X(39) VALUE SPACES. IC1064.2 +012700 01 CCVS-H-2A. IC1064.2 +012800 02 FILLER PIC X(40) VALUE SPACE. IC1064.2 +012900 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1064.2 +013000 02 FILLER PIC XXXX VALUE IC1064.2 +013100 "4.2 ". IC1064.2 +013200 02 FILLER PIC X(28) VALUE IC1064.2 +013300 " COPY - NOT FOR DISTRIBUTION". IC1064.2 +013400 02 FILLER PIC X(41) VALUE SPACE. IC1064.2 +013500 IC1064.2 +013600 01 CCVS-H-2B. IC1064.2 +013700 02 FILLER PIC X(15) VALUE IC1064.2 +013800 "TEST RESULT OF ". IC1064.2 +013900 02 TEST-ID PIC X(9). IC1064.2 +014000 02 FILLER PIC X(4) VALUE IC1064.2 +014100 " IN ". IC1064.2 +014200 02 FILLER PIC X(12) VALUE IC1064.2 +014300 " HIGH ". IC1064.2 +014400 02 FILLER PIC X(22) VALUE IC1064.2 +014500 " LEVEL VALIDATION FOR ". IC1064.2 +014600 02 FILLER PIC X(58) VALUE IC1064.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +014800 01 CCVS-H-3. IC1064.2 +014900 02 FILLER PIC X(34) VALUE IC1064.2 +015000 " FOR OFFICIAL USE ONLY ". IC1064.2 +015100 02 FILLER PIC X(58) VALUE IC1064.2 +015200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1064.2 +015300 02 FILLER PIC X(28) VALUE IC1064.2 +015400 " COPYRIGHT 1985 ". IC1064.2 +015500 01 CCVS-E-1. IC1064.2 +015600 02 FILLER PIC X(52) VALUE SPACE. IC1064.2 +015700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1064.2 +015800 02 ID-AGAIN PIC X(9). IC1064.2 +015900 02 FILLER PIC X(45) VALUE SPACES. IC1064.2 +016000 01 CCVS-E-2. IC1064.2 +016100 02 FILLER PIC X(31) VALUE SPACE. IC1064.2 +016200 02 FILLER PIC X(21) VALUE SPACE. IC1064.2 +016300 02 CCVS-E-2-2. IC1064.2 +016400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1064.2 +016500 03 FILLER PIC X VALUE SPACE. IC1064.2 +016600 03 ENDER-DESC PIC X(44) VALUE IC1064.2 +016700 "ERRORS ENCOUNTERED". IC1064.2 +016800 01 CCVS-E-3. IC1064.2 +016900 02 FILLER PIC X(22) VALUE IC1064.2 +017000 " FOR OFFICIAL USE ONLY". IC1064.2 +017100 02 FILLER PIC X(12) VALUE SPACE. IC1064.2 +017200 02 FILLER PIC X(58) VALUE IC1064.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +017400 02 FILLER PIC X(13) VALUE SPACE. IC1064.2 +017500 02 FILLER PIC X(15) VALUE IC1064.2 +017600 " COPYRIGHT 1985". IC1064.2 +017700 01 CCVS-E-4. IC1064.2 +017800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1064.2 +017900 02 FILLER PIC X(4) VALUE " OF ". IC1064.2 +018000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1064.2 +018100 02 FILLER PIC X(40) VALUE IC1064.2 +018200 " TESTS WERE EXECUTED SUCCESSFULLY". IC1064.2 +018300 01 XXINFO. IC1064.2 +018400 02 FILLER PIC X(19) VALUE IC1064.2 +018500 "*** INFORMATION ***". IC1064.2 +018600 02 INFO-TEXT. IC1064.2 +018700 04 FILLER PIC X(8) VALUE SPACE. IC1064.2 +018800 04 XXCOMPUTED PIC X(20). IC1064.2 +018900 04 FILLER PIC X(5) VALUE SPACE. IC1064.2 +019000 04 XXCORRECT PIC X(20). IC1064.2 +019100 02 INF-ANSI-REFERENCE PIC X(48). IC1064.2 +019200 01 HYPHEN-LINE. IC1064.2 +019300 02 FILLER PIC IS X VALUE IS SPACE. IC1064.2 +019400 02 FILLER PIC IS X(65) VALUE IS "************************IC1064.2 +019500- "*****************************************". IC1064.2 +019600 02 FILLER PIC IS X(54) VALUE IS "************************IC1064.2 +019700- "******************************". IC1064.2 +019800 01 CCVS-PGM-ID PIC X(9) VALUE IC1064.2 +019900 "IC106A". IC1064.2 +020000 PROCEDURE DIVISION. IC1064.2 +020100 CCVS1 SECTION. IC1064.2 +020200 OPEN-FILES. IC1064.2 +020300 OPEN OUTPUT PRINT-FILE. IC1064.2 +020400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1064.2 +020500 MOVE SPACE TO TEST-RESULTS. IC1064.2 +020600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1064.2 +020700 GO TO CCVS1-EXIT. IC1064.2 +020800 CLOSE-FILES. IC1064.2 +020900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1064.2 +021000 TERMINATE-CCVS. IC1064.2 +021100S EXIT PROGRAM. IC1064.2 +021200STERMINATE-CALL. IC1064.2 +021300 STOP RUN. IC1064.2 +021400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1064.2 +021500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1064.2 +021600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1064.2 +021700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1064.2 +021800 MOVE "****TEST DELETED****" TO RE-MARK. IC1064.2 +021900 PRINT-DETAIL. IC1064.2 +022000 IF REC-CT NOT EQUAL TO ZERO IC1064.2 +022100 MOVE "." TO PARDOT-X IC1064.2 +022200 MOVE REC-CT TO DOTVALUE. IC1064.2 +022300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1064.2 +022400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1064.2 +022500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1064.2 +022600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1064.2 +022700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1064.2 +022800 MOVE SPACE TO CORRECT-X. IC1064.2 +022900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1064.2 +023000 MOVE SPACE TO RE-MARK. IC1064.2 +023100 HEAD-ROUTINE. IC1064.2 +023200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1064.2 +023500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1064.2 +023600 COLUMN-NAMES-ROUTINE. IC1064.2 +023700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +023800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +024000 END-ROUTINE. IC1064.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1064.2 +024200 END-RTN-EXIT. IC1064.2 +024300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +024400 END-ROUTINE-1. IC1064.2 +024500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1064.2 +024600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1064.2 +024700 ADD PASS-COUNTER TO ERROR-HOLD. IC1064.2 +024800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1064.2 +024900 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1064.2 +025000 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1064.2 +025100 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1064.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1064.2 +025300 END-ROUTINE-12. IC1064.2 +025400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1064.2 +025500 IF ERROR-COUNTER IS EQUAL TO ZERO IC1064.2 +025600 MOVE "NO " TO ERROR-TOTAL IC1064.2 +025700 ELSE IC1064.2 +025800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1064.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1064.2 +026000 PERFORM WRITE-LINE. IC1064.2 +026100 END-ROUTINE-13. IC1064.2 +026200 IF DELETE-COUNTER IS EQUAL TO ZERO IC1064.2 +026300 MOVE "NO " TO ERROR-TOTAL ELSE IC1064.2 +026400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1064.2 +026500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1064.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +026700 IF INSPECT-COUNTER EQUAL TO ZERO IC1064.2 +026800 MOVE "NO " TO ERROR-TOTAL IC1064.2 +026900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1064.2 +027000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1064.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +027200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +027300 WRITE-LINE. IC1064.2 +027400 ADD 1 TO RECORD-COUNT. IC1064.2 +027500Y IF RECORD-COUNT GREATER 50 IC1064.2 +027600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1064.2 +027700Y MOVE SPACE TO DUMMY-RECORD IC1064.2 +027800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1064.2 +027900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1064.2 +028000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1064.2 +028100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1064.2 +028200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1064.2 +028300Y MOVE ZERO TO RECORD-COUNT. IC1064.2 +028400 PERFORM WRT-LN. IC1064.2 +028500 WRT-LN. IC1064.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1064.2 +028700 MOVE SPACE TO DUMMY-RECORD. IC1064.2 +028800 BLANK-LINE-PRINT. IC1064.2 +028900 PERFORM WRT-LN. IC1064.2 +029000 FAIL-ROUTINE. IC1064.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1064.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1064.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1064.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1064.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1064.2 +029700 GO TO FAIL-ROUTINE-EX. IC1064.2 +029800 FAIL-ROUTINE-WRITE. IC1064.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1064.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1064.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1064.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. IC1064.2 +030300 FAIL-ROUTINE-EX. EXIT. IC1064.2 +030400 BAIL-OUT. IC1064.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1064.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1064.2 +030700 BAIL-OUT-WRITE. IC1064.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1064.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1064.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1064.2 +031200 BAIL-OUT-EX. EXIT. IC1064.2 +031300 CCVS1-EXIT. IC1064.2 +031400 EXIT. IC1064.2 +031500 SEC-IC106-0001 SECTION. IC1064.2 +031600 LINK-TEST-INITIALIZE. IC1064.2 +031700 MOVE "ABCDEFGHIJ" TO TABLE-1. IC1064.2 +031800 MOVE SPACE TO TABLE-2. IC1064.2 +031900 SET IN1 TO 6. IC1064.2 +032000 SET IDN1 TO IN1. IC1064.2 +032100 CALL "IC107A" USING IDN1 TABLE-1 TABLE-2. IC1064.2 +032200 LINK-TEST-01. IC1064.2 +032300 MOVE "SEPARATE INDEXES" TO FEATURE. IC1064.2 +032400 MOVE "LINK-TEST-01" TO PAR-NAME. IC1064.2 +032500* THIS TEST VERIFIES THAT IN1 HAS NOT BEEN AFFECTED IC1064.2 +032600* BY THE USE OF AN INDEX FOR TABLE-1 IN THE SUBPROGRAM. IC1064.2 +032700 LINK-TEST-01-01. IC1064.2 +032800 MOVE 1 TO REC-CT. IC1064.2 +032900 IF DN1 (IN1) EQUAL TO "F" IC1064.2 +033000 PERFORM PASS IC1064.2 +033100 GO TO LINK-WRITE-01-01. IC1064.2 +033200 LINK-FAIL-01-01. IC1064.2 +033300 PERFORM FAIL. IC1064.2 +033400 MOVE DN1 (IN1) TO COMPUTED-A. IC1064.2 +033500 MOVE "F" TO CORRECT-A. IC1064.2 +033600 MOVE "TABLE INDEX DESTROYED" TO RE-MARK. IC1064.2 +033700 LINK-WRITE-01-01. IC1064.2 +033800 PERFORM PRINT-DETAIL. IC1064.2 +033900 LINK-TEST-01-02. IC1064.2 +034000 ADD 1 TO REC-CT. IC1064.2 +034100 IF IN1 EQUAL TO 6 IC1064.2 +034200 PERFORM PASS IC1064.2 +034300 GO TO LINK-WRITE-01-02. IC1064.2 +034400 LINK-FAIL-01-02. IC1064.2 +034500 PERFORM FAIL. IC1064.2 +034600 MOVE 6 TO CORRECT-18V0. IC1064.2 +034700 SET INDEX-VALUE TO IN1. IC1064.2 +034800 MOVE INDEX-VALUE TO COMPUTED-18V0. IC1064.2 +034900 MOVE "TABLE INDEX DESTROYED" TO RE-MARK. IC1064.2 +035000 LINK-WRITE-01-02. IC1064.2 +035100 PERFORM PRINT-DETAIL. IC1064.2 +035200 LINK-TEST-02. IC1064.2 +035300 MOVE "INDEX DATA ITEM" TO FEATURE. IC1064.2 +035400 MOVE "LINK-TEST-02" TO PAR-NAME. IC1064.2 +035500* THIS TEST VERIFIES THAT THE INDEX DATA ITEM WAS IC1064.2 +035600* USED IN THE SUBPROGRAM TO SET AN INDEX AND AN INDEX IC1064.2 +035700* DATA ITEM. IC1064.2 +035800 LINK-TEST-02-01. IC1064.2 +035900 MOVE 1 TO REC-CT. IC1064.2 +036000 IF DN2 (7) IS EQUAL TO "G" IC1064.2 +036100 PERFORM PASS IC1064.2 +036200 GO TO LINK-WRITE-02-01. IC1064.2 +036300 LINK-FAIL-02-01. IC1064.2 +036400 PERFORM FAIL. IC1064.2 +036500 MOVE DN2 (7) TO COMPUTED-A. IC1064.2 +036600 MOVE "G" TO CORRECT-A. IC1064.2 +036700 MOVE "INDEX DATA ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +036800 LINK-WRITE-02-01. IC1064.2 +036900 PERFORM PRINT-DETAIL. IC1064.2 +037000 LINK-TEST-02-02. IC1064.2 +037100 ADD 1 TO REC-CT. IC1064.2 +037200 IF DN2 (6) EQUAL TO "F" IC1064.2 +037300 PERFORM PASS IC1064.2 +037400 GO TO LINK-WRITE-02-02. IC1064.2 +037500 LINK-FAIL-02-02. IC1064.2 +037600 PERFORM FAIL. IC1064.2 +037700 MOVE DN2 (6) TO COMPUTED-A. IC1064.2 +037800 MOVE "F" TO CORRECT-A. IC1064.2 +037900 MOVE "INDEX DATA ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +038000 LINK-WRITE-02-02. IC1064.2 +038100 PERFORM PRINT-DETAIL. IC1064.2 +038200 LINK-TEST-03. IC1064.2 +038300 MOVE "SUBPROGRAM INDEX" TO FEATURE. IC1064.2 +038400 MOVE "LINK-TEST-03" TO PAR-NAME. IC1064.2 +038500* THIS TEST VERIFIES THAT A SUBPROGRAM INDEX FOR IC1064.2 +038600* A TABLE DEFINED IN THE LINKAGE SECTION OF IC107 CAN BE IC1064.2 +038700* USED TO REFERENCE THE TABLE. IC1064.2 +038800 LINK-TEST-03-01. IC1064.2 +038900 MOVE 1 TO REC-CT. IC1064.2 +039000 IF DN2 (1) EQUAL TO "A" IC1064.2 +039100 PERFORM PASS IC1064.2 +039200 GO TO LINK-WRITE-03-01. IC1064.2 +039300 LINK-FAIL-03-01. IC1064.2 +039400 PERFORM FAIL. IC1064.2 +039500 MOVE DN2 (1) TO COMPUTED-A. IC1064.2 +039600 MOVE "A" TO CORRECT-A. IC1064.2 +039700 MOVE "INDEX IN LINKAGE SECTION" TO RE-MARK. IC1064.2 +039800 LINK-WRITE-03-01. IC1064.2 +039900 PERFORM PRINT-DETAIL. IC1064.2 +040000 LINK-TEST-03-02. IC1064.2 +040100 ADD 1 TO REC-CT. IC1064.2 +040200 IF DN2 (2) EQUAL TO "B" IC1064.2 +040300 PERFORM PASS IC1064.2 +040400 GO TO LINK-WRITE-03-02. IC1064.2 +040500 LINK-FAIL-03-02. IC1064.2 +040600 PERFORM FAIL. IC1064.2 +040700 MOVE DN2 (2) TO COMPUTED-A. IC1064.2 +040800 MOVE "B" TO CORRECT-A. IC1064.2 +040900 MOVE "INDEX IN LINKAGE SECTION" TO RE-MARK. IC1064.2 +041000 LINK-WRITE-03-02. IC1064.2 +041100 PERFORM PRINT-DETAIL. IC1064.2 +041200 LINK-TEST-04. IC1064.2 +041300 MOVE "INDEX DATA ITEM" TO FEATURE. IC1064.2 +041400 MOVE "LINK-TEST-04" TO PAR-NAME. IC1064.2 +041500* THIS TEST VERIFIES THAT AN INDEX DATA ITEM IC1064.2 +041600* SET IN THE SUBPROGRAM CAN BE USED IN THE MAIN PROGRAM. IC1064.2 +041700 LINK-TEST-04-01. IC1064.2 +041800 MOVE 1 TO REC-CT. IC1064.2 +041900 SET IN1 TO IDN1. IC1064.2 +042000 IF IN1 EQUAL TO 3 IC1064.2 +042100 PERFORM PASS IC1064.2 +042200 GO TO LINK-WRITE-04-01. IC1064.2 +042300 LINK-FAIL-04-01. IC1064.2 +042400 MOVE 3 TO CORRECT-18V0. IC1064.2 +042500 SET INDEX-VALUE TO IN1. IC1064.2 +042600 MOVE INDEX-VALUE TO COMPUTED-18V0. IC1064.2 +042700 PERFORM FAIL. IC1064.2 +042800 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +042900 LINK-WRITE-04-01. IC1064.2 +043000 PERFORM PRINT-DETAIL. IC1064.2 +043100 LINK-TEST-04-02. IC1064.2 +043200 ADD 1 TO REC-CT. IC1064.2 +043300 IF DN1 (IN1) EQUAL TO "C" IC1064.2 +043400 PERFORM PASS IC1064.2 +043500 GO TO LINK-WRITE-04-02. IC1064.2 +043600 LINK-FAIL-04-02. IC1064.2 +043700 MOVE "C" TO CORRECT-A. IC1064.2 +043800 MOVE DN1 (IN1) TO COMPUTED-A. IC1064.2 +043900 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +044000 PERFORM FAIL. IC1064.2 +044100 LINK-WRITE-04-02. IC1064.2 +044200 PERFORM PRINT-DETAIL. IC1064.2 +044300 LINK-TEST-04-03. IC1064.2 +044400 ADD 1 TO REC-CT. IC1064.2 +044500 IF DN2 (3) EQUAL TO "C" IC1064.2 +044600 PERFORM PASS IC1064.2 +044700 GO TO LINK-WRITE-04-03. IC1064.2 +044800 LINK-FAIL-04-03. IC1064.2 +044900 PERFORM FAIL. IC1064.2 +045000 MOVE "C" TO CORRECT-A. IC1064.2 +045100 MOVE DN2 (3) TO COMPUTED-A. IC1064.2 +045200 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +045300 LINK-WRITE-04-03. IC1064.2 +045400 PERFORM PRINT-DETAIL. IC1064.2 +045500 LINK-TEST-05. IC1064.2 +045600 MOVE "TABLE REFERENCES" TO FEATURE. IC1064.2 +045700 MOVE "LINK-TEST-05" TO PAR-NAME. IC1064.2 +045800* THIS TEST VERIFIES THAT DATA WAS MOVED FROM THE IC1064.2 +045900* FIRST TABLE IN USING PHRASE TO SECOND TABLE IN USING PHRASE. IC1064.2 +046000* DATA WAS MOVED IN SUBPROGRAM IC107. IC1064.2 +046100 LINK-TEST-05-01. IC1064.2 +046200 MOVE 1 TO REC-CT. IC1064.2 +046300 IF DN2 (4) EQUAL TO "D" IC1064.2 +046400 PERFORM PASS IC1064.2 +046500 GO TO LINK-WRITE-05-01. IC1064.2 +046600 LINK-FAIL-05-01. IC1064.2 +046700 PERFORM FAIL. IC1064.2 +046800 MOVE DN2 (4) TO COMPUTED-A. IC1064.2 +046900 MOVE "D" TO CORRECT-A. IC1064.2 +047000 MOVE "TABLES DEFINED IN LINKAGE SEC" TO RE-MARK. IC1064.2 +047100 LINK-WRITE-05-01. IC1064.2 +047200 PERFORM PRINT-DETAIL. IC1064.2 +047300 LINK-TEST-05-02. IC1064.2 +047400 ADD 1 TO REC-CT. IC1064.2 +047500 IF DN2 (5) EQUAL TO "E" IC1064.2 +047600 PERFORM PASS IC1064.2 +047700 GO TO LINK-WRITE-05-02. IC1064.2 +047800 LINK-FAIL-05-02. IC1064.2 +047900 PERFORM FAIL. IC1064.2 +048000 MOVE DN2 (5) TO COMPUTED-A. IC1064.2 +048100 MOVE "E" TO CORRECT-A. IC1064.2 +048200 MOVE "TABLES DEFINED IN LINKAGE SEC" TO RE-MARK. IC1064.2 +048300 LINK-WRITE-05-02. IC1064.2 +048400 PERFORM PRINT-DETAIL. IC1064.2 +048500 LINK-TEST-06. IC1064.2 +048600 MOVE "REDEFINED ITEM" TO FEATURE. IC1064.2 +048700 MOVE "LINK-TEST-06" TO PAR-NAME. IC1064.2 +048800* THIS TEST VERIFIES THAT DATA WAS MOVED TO IC1064.2 +048900* A REDEFINED ITEM IN THE LINKAGE SECTION OF IC107. IC1064.2 +049000 LINK-TEST-06-01. IC1064.2 +049100 MOVE 1 TO REC-CT. IC1064.2 +049200 IF DN2 (8) EQUAL TO "X" IC1064.2 +049300 PERFORM PASS IC1064.2 +049400 GO TO LINK-WRITE-06-01. IC1064.2 +049500 LINK-FAIL-06-01. IC1064.2 +049600 PERFORM FAIL. IC1064.2 +049700 MOVE DN2 (8) TO COMPUTED-A. IC1064.2 +049800 MOVE "X" TO CORRECT-A. IC1064.2 +049900 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +050000 LINK-WRITE-06-01. IC1064.2 +050100 PERFORM PRINT-DETAIL. IC1064.2 +050200 LINK-TEST-06-02. IC1064.2 +050300 ADD 1 TO REC-CT. IC1064.2 +050400 IF DN2 (9) EQUAL TO "Y" IC1064.2 +050500 PERFORM PASS IC1064.2 +050600 GO TO LINK-WRITE-06-02. IC1064.2 +050700 LINK-FAIL-06-02. IC1064.2 +050800 PERFORM FAIL. IC1064.2 +050900 MOVE DN2 (9) TO COMPUTED-A. IC1064.2 +051000 MOVE "Y" TO CORRECT-A. IC1064.2 +051100 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +051200 LINK-WRITE-06-02. IC1064.2 +051300 PERFORM PRINT-DETAIL. IC1064.2 +051400 LINK-TEST-06-03. IC1064.2 +051500 ADD 1 TO REC-CT. IC1064.2 +051600 IF DN2 (10) EQUAL TO "Z" IC1064.2 +051700 PERFORM PASS IC1064.2 +051800 GO TO LINK-WRITE-06-03. IC1064.2 +051900 LINK-FAIL-06-03. IC1064.2 +052000 PERFORM FAIL. IC1064.2 +052100 MOVE DN2 (10) TO COMPUTED-A. IC1064.2 +052200 MOVE "Z" TO CORRECT-A. IC1064.2 +052300 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +052400 LINK-WRITE-06-03. IC1064.2 +052500 PERFORM PRINT-DETAIL. IC1064.2 +052600 LINK-END-ROUTINE. IC1064.2 +052700 GO TO CCVS-EXIT. IC1064.2 +052800 CCVS-EXIT SECTION. IC1064.2 +052900 CCVS-999999. IC1064.2 +053000 GO TO CLOSE-FILES. IC1064.2 +*END-OF,IC106A +*HEADER,COBOL,IC106A,SUBRTN,IC107A +000100 IDENTIFICATION DIVISION. IC1074.2 +000200 PROGRAM-ID. IC1074.2 +000300 IC107A. IC1074.2 +000400**************************************************************** IC1074.2 +000500* * IC1074.2 +000600* VALIDATION FOR:- * IC1074.2 +000700* * IC1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1074.2 +000900* * IC1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1074.2 +001100* * IC1074.2 +001200**************************************************************** IC1074.2 +001300* * IC1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1074.2 +001500* * IC1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1074.2 +001900* * IC1074.2 +002000**************************************************************** IC1074.2 +002100* THE SUBPROGRAM IC107 CONTAINS TABLES AND AN INDEX IC1074.2 +002200* DATA ITEM WHICH ARE DEFINED IN THE LINKAGE SECTION AND IC1074.2 +002300* NAMED AS OPERANDS IN THE USING PHRASE OF THE PROCEDURE IC1074.2 +002400* DIVISION HEADER. ONE OF THE TABLES HAS AN INDEX DEFINED IC1074.2 +002500* FOR IT. THIS INDEX SHOULD BE SEPARATE FROM THE INDEX IC1074.2 +002600* DEFINED FOR THE SAME TABLE IN THE MAIN PROGRAM IC106, IC1074.2 +002700* BUT NO SPACE SHOULD BE ALLOCATED FOR THE TABLES DEFINED IC1074.2 +002800* IN THE LINKAGE SECTION. THE INDEX DATA ITEM IS SET IN IC1074.2 +002900* THE MAIN PROGRAM PRIOR TO CALLING IC107, AND IT IS USED IC1074.2 +003000* IN THIS SUBPROGRAM TO SET AN INDEX FOR REFERENCING THE IC1074.2 +003100* TABLE IN THE SUBPROGRAM. IC1074.2 +003200 ENVIRONMENT DIVISION. IC1074.2 +003300 CONFIGURATION SECTION. IC1074.2 +003400 SOURCE-COMPUTER. IC1074.2 +003500 XXXXX082. IC1074.2 +003600 OBJECT-COMPUTER. IC1074.2 +003700 XXXXX083. IC1074.2 +003800 INPUT-OUTPUT SECTION. IC1074.2 +003900 FILE-CONTROL. IC1074.2 +004000 SELECT PRINT-FILE ASSIGN TO IC1074.2 +004100 XXXXX055. IC1074.2 +004200 DATA DIVISION. IC1074.2 +004300 FILE SECTION. IC1074.2 +004400 FD PRINT-FILE. IC1074.2 +004500 01 PRINT-REC PICTURE X(120). IC1074.2 +004600 01 DUMMY-RECORD PICTURE X(120). IC1074.2 +004700 WORKING-STORAGE SECTION. IC1074.2 +004800 77 IDN3 USAGE IS INDEX. IC1074.2 +004900 77 S1 PICTURE 99. IC1074.2 +005000 77 AL-CON PICTURE XXX VALUE "XYZ". IC1074.2 +005100 LINKAGE SECTION. IC1074.2 +005200 77 IDN2 USAGE IS INDEX. IC1074.2 +005300 01 GROUP-1. IC1074.2 +005400 02 DN1 PICTURE X OCCURS 10 TIMES IC1074.2 +005500 INDEXED BY IN3. IC1074.2 +005600 01 GROUP-2. IC1074.2 +005700 02 GROUP-21. IC1074.2 +005800 06 DN2 PIC X OCCURS 10 TIMES. IC1074.2 +005900 02 GROUP-2-1 REDEFINES GROUP-21. IC1074.2 +006000 03 FILLER PICTURE X(7). IC1074.2 +006100 03 DN3 PICTURE XXX. IC1074.2 +006200 PROCEDURE DIVISION USING IDN2 GROUP-1 GROUP-2. IC1074.2 +006300 SECT-IC107-0001 SECTION. IC1074.2 +006400 LINK-TEST-02-01. IC1074.2 +006500 SET IN3 TO IDN2. IC1074.2 +006600 IF DN1 (IN3) EQUAL TO "F" IC1074.2 +006700 MOVE "G" TO DN2 (7). IC1074.2 +006800 LINK-TEST-02-02. IC1074.2 +006900 SET IDN3 TO IDN2. IC1074.2 +007000 SET IN3 TO IDN3. IC1074.2 +007100 IF IN3 EQUAL TO 6 IC1074.2 +007200 MOVE "F" TO DN2 (6). IC1074.2 +007300* THE TESTS IN LINK-TEST-02 USE THE INDEX DATA ITEM IC1074.2 +007400* WHICH IS DEFINED IN THE LINKAGE SECTION AND WAS SET IN IC1074.2 +007500* THE MAIN PROGRAM BEFORE THIS SUBPROGRAM WAS CALLED. IC1074.2 +007600 LINK-TEST-03-01. IC1074.2 +007700 SET IN3 TO 1. IC1074.2 +007800 MOVE 1 TO S1. IC1074.2 +007900 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +008000 LINK-TEST-03-02. IC1074.2 +008100 SET IN3 UP BY 1. IC1074.2 +008200 ADD 1 TO S1. IC1074.2 +008300 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +008400* THE TESTS IN LINK-TEST-03 SET THE INDEX DEFINED IN THE IC1074.2 +008500* TABLE IN THE LINKAGE SECTION AND USE THE INDEX TO REFERENCE IC1074.2 +008600* THE TABLE ITEMS. IC1074.2 +008700 LINK-TEST-04-01. IC1074.2 +008800 SET IN3 TO 3. IC1074.2 +008900 SET IDN2 TO IN3. IC1074.2 +009000 LINK-TEST-04-02. IC1074.2 +009100 IF IDN2 IS EQUAL TO IN3 IC1074.2 +009200 MOVE "C" TO DN2 (3). IC1074.2 +009300* THE TESTS IN LINK-TEST-04 RESET THE INDEX DATA ITEM IC1074.2 +009400* TO CORRESPOND TO TABLE POSITION 3, AND COMPARES THE IC1074.2 +009500* INDEX DATA ITEM TO THE INDEX. IC1074.2 +009600 LINK-TEST-05-01. IC1074.2 +009700 MOVE 4 TO S1. IC1074.2 +009800 SET IN3 TO S1. IC1074.2 +009900 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +010000 LINK-TEST-05-02. IC1074.2 +010100 MOVE DN1 (5) TO DN2 (5). IC1074.2 +010200* THE TESTS IN LINK-TEST-05 MOVE DATA FROM THE FIRST IC1074.2 +010300* TABLE DEFINED IN THE LINKAGE SECTION TO THE SECOND TABLE. IC1074.2 +010400 LINK-TEST-06. IC1074.2 +010500 MOVE AL-CON TO DN3. IC1074.2 +010600* THIS TEST MOVES DATA TO THE REDEFINED FIELD IN A TABLE IC1074.2 +010700* IN THE LINKAGE SECTION. IC1074.2 +010800 EXIT-IC107. IC1074.2 +010900 EXIT PROGRAM. IC1074.2 +*END-OF,IC107A +*HEADER,COBOL,IC108A +000100 IDENTIFICATION DIVISION. IC1084.2 +000200 PROGRAM-ID. IC1084.2 +000300 IC108A. IC1084.2 +000400**************************************************************** IC1084.2 +000500* * IC1084.2 +000600* VALIDATION FOR:- * IC1084.2 +000700* * IC1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +000900* * IC1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1084.2 +001100* * IC1084.2 +001200**************************************************************** IC1084.2 +001300* * IC1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1084.2 +001500* * IC1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1084.2 +001900* * IC1084.2 +002000**************************************************************** IC1084.2 +002100* THE PROGRAM IC108 IS THE MAIN PROGRAM WHICH STARTS IC1084.2 +002200* A SEQUENCE OF CALLS TO THE SUBPROGRAMS IC109A,IC110A AND IC1084.2 +002300* IC111A. PARAMETERS ARE SET IN EACH OF THESE SUBPROGRAMS IC1084.2 +002400* AND CHECKED WHEN CONTROL IS RETURNED TO THE MAIN PROGRAM. IC1084.2 +002500 ENVIRONMENT DIVISION. IC1084.2 +002600 CONFIGURATION SECTION. IC1084.2 +002700 SOURCE-COMPUTER. IC1084.2 +002800 XXXXX082. IC1084.2 +002900 OBJECT-COMPUTER. IC1084.2 +003000 XXXXX083. IC1084.2 +003100 INPUT-OUTPUT SECTION. IC1084.2 +003200 FILE-CONTROL. IC1084.2 +003300 SELECT PRINT-FILE ASSIGN TO IC1084.2 +003400 XXXXX055. IC1084.2 +003500 DATA DIVISION. IC1084.2 +003600 FILE SECTION. IC1084.2 +003700 FD PRINT-FILE. IC1084.2 +003800 01 PRINT-REC PICTURE X(120). IC1084.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC1084.2 +004000 WORKING-STORAGE SECTION. IC1084.2 +004100 01 GRP-01. IC1084.2 +004200 02 SUB-CALLED. IC1084.2 +004300 03 DN1 PICTURE X(6). IC1084.2 +004400 03 DN2 PICTURE X(6). IC1084.2 +004500 03 DN3 PICTURE X(6). IC1084.2 +004600 02 TIMES-CALLED. IC1084.2 +004700 03 DN4 PICTURE S999 VALUE ZERO. IC1084.2 +004800 03 DN5 PICTURE S999 VALUE ZERO. IC1084.2 +004900 03 DN6 PICTURE S999 VALUE ZERO. IC1084.2 +005000 02 SPECIAL-FLAGS. IC1084.2 +005100 03 DN7 PICTURE X. IC1084.2 +005200 03 DN8 PICTURE X. IC1084.2 +005300 03 DN9 PICTURE X. IC1084.2 +005400 01 TEST-RESULTS. IC1084.2 +005500 02 FILLER PIC X VALUE SPACE. IC1084.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IC1084.2 +005700 02 FILLER PIC X VALUE SPACE. IC1084.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IC1084.2 +005900 02 FILLER PIC X VALUE SPACE. IC1084.2 +006000 02 PAR-NAME. IC1084.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IC1084.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IC1084.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IC1084.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IC1084.2 +006500 02 RE-MARK PIC X(61). IC1084.2 +006600 01 TEST-COMPUTED. IC1084.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IC1084.2 +006800 02 FILLER PIC X(17) VALUE IC1084.2 +006900 " COMPUTED=". IC1084.2 +007000 02 COMPUTED-X. IC1084.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1084.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IC1084.2 +007300 PIC -9(9).9(9). IC1084.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1084.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1084.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1084.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IC1084.2 +007800 04 COMPUTED-18V0 PIC -9(18). IC1084.2 +007900 04 FILLER PIC X. IC1084.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IC1084.2 +008100 01 TEST-CORRECT. IC1084.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC1084.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IC1084.2 +008400 02 CORRECT-X. IC1084.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IC1084.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1084.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1084.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1084.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1084.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IC1084.2 +009100 04 CORRECT-18V0 PIC -9(18). IC1084.2 +009200 04 FILLER PIC X. IC1084.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IC1084.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1084.2 +009500 01 CCVS-C-1. IC1084.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1084.2 +009700- "SS PARAGRAPH-NAME IC1084.2 +009800- " REMARKS". IC1084.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IC1084.2 +010000 01 CCVS-C-2. IC1084.2 +010100 02 FILLER PIC X VALUE SPACE. IC1084.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IC1084.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IC1084.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IC1084.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IC1084.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1084.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IC1084.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1084.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1084.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1084.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1084.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1084.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1084.2 +011700 01 CCVS-H-1. IC1084.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IC1084.2 +011900 02 FILLER PIC X(42) VALUE IC1084.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1084.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IC1084.2 +012200 01 CCVS-H-2A. IC1084.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IC1084.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1084.2 +012500 02 FILLER PIC XXXX VALUE IC1084.2 +012600 "4.2 ". IC1084.2 +012700 02 FILLER PIC X(28) VALUE IC1084.2 +012800 " COPY - NOT FOR DISTRIBUTION". IC1084.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IC1084.2 +013000 IC1084.2 +013100 01 CCVS-H-2B. IC1084.2 +013200 02 FILLER PIC X(15) VALUE IC1084.2 +013300 "TEST RESULT OF ". IC1084.2 +013400 02 TEST-ID PIC X(9). IC1084.2 +013500 02 FILLER PIC X(4) VALUE IC1084.2 +013600 " IN ". IC1084.2 +013700 02 FILLER PIC X(12) VALUE IC1084.2 +013800 " HIGH ". IC1084.2 +013900 02 FILLER PIC X(22) VALUE IC1084.2 +014000 " LEVEL VALIDATION FOR ". IC1084.2 +014100 02 FILLER PIC X(58) VALUE IC1084.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +014300 01 CCVS-H-3. IC1084.2 +014400 02 FILLER PIC X(34) VALUE IC1084.2 +014500 " FOR OFFICIAL USE ONLY ". IC1084.2 +014600 02 FILLER PIC X(58) VALUE IC1084.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1084.2 +014800 02 FILLER PIC X(28) VALUE IC1084.2 +014900 " COPYRIGHT 1985 ". IC1084.2 +015000 01 CCVS-E-1. IC1084.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IC1084.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1084.2 +015300 02 ID-AGAIN PIC X(9). IC1084.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IC1084.2 +015500 01 CCVS-E-2. IC1084.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IC1084.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IC1084.2 +015800 02 CCVS-E-2-2. IC1084.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1084.2 +016000 03 FILLER PIC X VALUE SPACE. IC1084.2 +016100 03 ENDER-DESC PIC X(44) VALUE IC1084.2 +016200 "ERRORS ENCOUNTERED". IC1084.2 +016300 01 CCVS-E-3. IC1084.2 +016400 02 FILLER PIC X(22) VALUE IC1084.2 +016500 " FOR OFFICIAL USE ONLY". IC1084.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IC1084.2 +016700 02 FILLER PIC X(58) VALUE IC1084.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IC1084.2 +017000 02 FILLER PIC X(15) VALUE IC1084.2 +017100 " COPYRIGHT 1985". IC1084.2 +017200 01 CCVS-E-4. IC1084.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1084.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IC1084.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1084.2 +017600 02 FILLER PIC X(40) VALUE IC1084.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IC1084.2 +017800 01 XXINFO. IC1084.2 +017900 02 FILLER PIC X(19) VALUE IC1084.2 +018000 "*** INFORMATION ***". IC1084.2 +018100 02 INFO-TEXT. IC1084.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IC1084.2 +018300 04 XXCOMPUTED PIC X(20). IC1084.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IC1084.2 +018500 04 XXCORRECT PIC X(20). IC1084.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IC1084.2 +018700 01 HYPHEN-LINE. IC1084.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IC1084.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IC1084.2 +019000- "*****************************************". IC1084.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IC1084.2 +019200- "******************************". IC1084.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IC1084.2 +019400 "IC108A". IC1084.2 +019500 PROCEDURE DIVISION. IC1084.2 +019600 CCVS1 SECTION. IC1084.2 +019700 OPEN-FILES. IC1084.2 +019800 OPEN OUTPUT PRINT-FILE. IC1084.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1084.2 +020000 MOVE SPACE TO TEST-RESULTS. IC1084.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1084.2 +020200 GO TO CCVS1-EXIT. IC1084.2 +020300 CLOSE-FILES. IC1084.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1084.2 +020500 TERMINATE-CCVS. IC1084.2 +020600S EXIT PROGRAM. IC1084.2 +020700STERMINATE-CALL. IC1084.2 +020800 STOP RUN. IC1084.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1084.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1084.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1084.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1084.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. IC1084.2 +021400 PRINT-DETAIL. IC1084.2 +021500 IF REC-CT NOT EQUAL TO ZERO IC1084.2 +021600 MOVE "." TO PARDOT-X IC1084.2 +021700 MOVE REC-CT TO DOTVALUE. IC1084.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1084.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1084.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1084.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1084.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1084.2 +022300 MOVE SPACE TO CORRECT-X. IC1084.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1084.2 +022500 MOVE SPACE TO RE-MARK. IC1084.2 +022600 HEAD-ROUTINE. IC1084.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1084.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1084.2 +023100 COLUMN-NAMES-ROUTINE. IC1084.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +023500 END-ROUTINE. IC1084.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1084.2 +023700 END-RTN-EXIT. IC1084.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +023900 END-ROUTINE-1. IC1084.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1084.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1084.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. IC1084.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1084.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1084.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1084.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1084.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1084.2 +024800 END-ROUTINE-12. IC1084.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1084.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO IC1084.2 +025100 MOVE "NO " TO ERROR-TOTAL IC1084.2 +025200 ELSE IC1084.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1084.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1084.2 +025500 PERFORM WRITE-LINE. IC1084.2 +025600 END-ROUTINE-13. IC1084.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO IC1084.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE IC1084.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1084.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1084.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO IC1084.2 +026300 MOVE "NO " TO ERROR-TOTAL IC1084.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1084.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1084.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026800 WRITE-LINE. IC1084.2 +026900 ADD 1 TO RECORD-COUNT. IC1084.2 +027000Y IF RECORD-COUNT GREATER 50 IC1084.2 +027100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1084.2 +027200Y MOVE SPACE TO DUMMY-RECORD IC1084.2 +027300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1084.2 +027400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1084.2 +027500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1084.2 +027600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1084.2 +027700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1084.2 +027800Y MOVE ZERO TO RECORD-COUNT. IC1084.2 +027900 PERFORM WRT-LN. IC1084.2 +028000 WRT-LN. IC1084.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1084.2 +028200 MOVE SPACE TO DUMMY-RECORD. IC1084.2 +028300 BLANK-LINE-PRINT. IC1084.2 +028400 PERFORM WRT-LN. IC1084.2 +028500 FAIL-ROUTINE. IC1084.2 +028600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1084.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1084.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1084.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1084.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1084.2 +029200 GO TO FAIL-ROUTINE-EX. IC1084.2 +029300 FAIL-ROUTINE-WRITE. IC1084.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1084.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1084.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1084.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IC1084.2 +029800 FAIL-ROUTINE-EX. EXIT. IC1084.2 +029900 BAIL-OUT. IC1084.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1084.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1084.2 +030200 BAIL-OUT-WRITE. IC1084.2 +030300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1084.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1084.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1084.2 +030700 BAIL-OUT-EX. EXIT. IC1084.2 +030800 CCVS1-EXIT. IC1084.2 +030900 EXIT. IC1084.2 +031000 SECTION-IC108-0001 SECTION. IC1084.2 +031100 CALL-PARAGRAPH. IC1084.2 +031200* THE CALL IN THIS PARAGRAPH STARTS THE SEQUENCE IC1084.2 +031300* OF CALLS TO THE SUBPROGRAMS. IC1084.2 +031400 MOVE SPACE TO SUB-CALLED. IC1084.2 +031500 MOVE SPACE TO SPECIAL-FLAGS. IC1084.2 +031600 CALL "IC109A" USING GRP-01. IC1084.2 +031700 CALL-TEST-07. IC1084.2 +031800* THIS TEST VERIFIES THAT EACH SUBPROGRAM WAS CALLED IC1084.2 +031900* BY CHECKING THE PARAMETER FIELDS SET IN EACH SUBPROGRAM. IC1084.2 +032000 MOVE "SUBPROGRAM CALLS" TO FEATURE. IC1084.2 +032100 MOVE "CALL-TEST-07" TO PAR-NAME. IC1084.2 +032200 CALL-TEST-07-01. IC1084.2 +032300 MOVE 1 TO REC-CT. IC1084.2 +032400 IF DN1 IS EQUAL TO "IC109A" IC1084.2 +032500 PERFORM PASS IC1084.2 +032600 GO TO CALL-WRITE-07-01. IC1084.2 +032700 CALL-FAIL-07-01. IC1084.2 +032800 PERFORM FAIL. IC1084.2 +032900 MOVE DN1 TO COMPUTED-A. IC1084.2 +033000 MOVE "IC109A" TO CORRECT-A. IC1084.2 +033100 MOVE "SUBPROGRAM IC109A ERROR" TO RE-MARK. IC1084.2 +033200 CALL-WRITE-07-01. IC1084.2 +033300 PERFORM PRINT-DETAIL. IC1084.2 +033400 CALL-TEST-07-02. IC1084.2 +033500 ADD 1 TO REC-CT. IC1084.2 +033600 IF DN2 IS EQUAL TO "IC110A" IC1084.2 +033700 PERFORM PASS IC1084.2 +033800 GO TO CALL-WRITE-07-02. IC1084.2 +033900 CALL-FAIL-07-02. IC1084.2 +034000 PERFORM FAIL. IC1084.2 +034100 MOVE DN2 TO COMPUTED-A. IC1084.2 +034200 MOVE "IC110A" TO CORRECT-A. IC1084.2 +034300 MOVE "SUBPROGRAM IC110A ERROR" TO RE-MARK. IC1084.2 +034400 CALL-WRITE-07-02. IC1084.2 +034500 PERFORM PRINT-DETAIL. IC1084.2 +034600 CALL-TEST-07-03. IC1084.2 +034700 ADD 1 TO REC-CT. IC1084.2 +034800 IF DN3 EQUAL TO "IC111A" IC1084.2 +034900 PERFORM PASS IC1084.2 +035000 GO TO CALL-WRITE-07-03. IC1084.2 +035100 CALL-FAIL-07-03. IC1084.2 +035200 PERFORM FAIL. IC1084.2 +035300 MOVE DN3 TO COMPUTED-A. IC1084.2 +035400 MOVE "IC111A" TO CORRECT-A. IC1084.2 +035500 MOVE "SUBPROGRAM IC111A ERROR" TO RE-MARK. IC1084.2 +035600 CALL-WRITE-07-03. IC1084.2 +035700 PERFORM PRINT-DETAIL. IC1084.2 +035800 CALL-TEST-08. IC1084.2 +035900* THIS TEST VERIFIES THAT EACH OF THE SUBPROGRAMS IC1084.2 +036000* WERE CALLED ONLY ONCE. IC1084.2 +036100 MOVE "CALL-TEST-08" TO PAR-NAME. IC1084.2 +036200 MOVE "SUBPRGMS CALLED ONCE" TO FEATURE. IC1084.2 +036300 CALL-TEST-08-01. IC1084.2 +036400 MOVE 1 TO REC-CT. IC1084.2 +036500 IF DN4 EQUAL TO 1 IC1084.2 +036600 PERFORM PASS IC1084.2 +036700 GO TO CALL-WRITE-08-01. IC1084.2 +036800 CALL-FAIL-08-01. IC1084.2 +036900 PERFORM FAIL. IC1084.2 +037000 MOVE DN4 TO COMPUTED-18V0. IC1084.2 +037100 MOVE 1 TO CORRECT-18V0. IC1084.2 +037200 MOVE "IC109A CALLED N TIMES" TO RE-MARK. IC1084.2 +037300 CALL-WRITE-08-01. IC1084.2 +037400 PERFORM PRINT-DETAIL. IC1084.2 +037500 CALL-TEST-08-02. IC1084.2 +037600 ADD 1 TO REC-CT. IC1084.2 +037700 IF DN5 EQUAL TO 1 IC1084.2 +037800 PERFORM PASS IC1084.2 +037900 GO TO CALL-WRITE-08-02. IC1084.2 +038000 CALL-FAIL-08-02. IC1084.2 +038100 PERFORM FAIL. IC1084.2 +038200 MOVE DN5 TO COMPUTED-18V0. IC1084.2 +038300 MOVE 1 TO CORRECT-18V0. IC1084.2 +038400 MOVE "IC110A CALLED N TIMES" TO RE-MARK. IC1084.2 +038500 CALL-WRITE-08-02. IC1084.2 +038600 PERFORM PRINT-DETAIL. IC1084.2 +038700 CALL-TEST-08-03. IC1084.2 +038800 ADD 1 TO REC-CT. IC1084.2 +038900 IF DN6 EQUAL TO 1 IC1084.2 +039000 PERFORM PASS IC1084.2 +039100 GO TO CALL-WRITE-08-03. IC1084.2 +039200 CALL-FAIL-08-03. IC1084.2 +039300 PERFORM FAIL. IC1084.2 +039400 MOVE DN6 TO COMPUTED-18V0. IC1084.2 +039500 MOVE 1 TO CORRECT-18V0. IC1084.2 +039600 MOVE "IC111A CALLED N TIMES" TO RE-MARK. IC1084.2 +039700 CALL-WRITE-08-03. IC1084.2 +039800 PERFORM PRINT-DETAIL. IC1084.2 +039900 LINK-TEST-07. IC1084.2 +040000* THIS TEST VERIFIES THAT USING PHRASE OPERANDS IC1084.2 +040100* WHICH WERE DEFINED IN SUBPROGRAM WORKING-STORAGE IC1084.2 +040200* SECTIONS WERE PROCESSED CORRECTLY. IC1084.2 +040300 MOVE "LINK-TEST-07" TO PAR-NAME. IC1084.2 +040400 MOVE "USING OPERANDS" TO FEATURE. IC1084.2 +040500 LINK-TEST-07-01. IC1084.2 +040600 MOVE 1 TO REC-CT. IC1084.2 +040700 IF DN7 EQUAL TO "A" IC1084.2 +040800 PERFORM PASS IC1084.2 +040900 GO TO LINK-WRITE-07-01. IC1084.2 +041000 LINK-FAIL-07-01. IC1084.2 +041100 PERFORM FAIL. IC1084.2 +041200 MOVE DN7 TO COMPUTED-A. IC1084.2 +041300 MOVE "A" TO CORRECT-A. IC1084.2 +041400 MOVE "IC109A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +041500 LINK-WRITE-07-01. IC1084.2 +041600 PERFORM PRINT-DETAIL. IC1084.2 +041700 LINK-TEST-07-02. IC1084.2 +041800 ADD 1 TO REC-CT. IC1084.2 +041900 IF DN8 EQUAL TO "A" IC1084.2 +042000 PERFORM PASS IC1084.2 +042100 GO TO LINK-WRITE-07-02. IC1084.2 +042200 LINK-FAIL-07-02. IC1084.2 +042300 PERFORM FAIL. IC1084.2 +042400 MOVE DN8 TO COMPUTED-A. IC1084.2 +042500 MOVE "A" TO CORRECT-A. IC1084.2 +042600 MOVE "IC110A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +042700 LINK-WRITE-07-02. IC1084.2 +042800 PERFORM PRINT-DETAIL. IC1084.2 +042900 LINK-TEST-07-03. IC1084.2 +043000 ADD 1 TO REC-CT. IC1084.2 +043100 IF DN9 EQUAL TO "B" IC1084.2 +043200 PERFORM PASS IC1084.2 +043300 GO TO LINK-WRITE-07-03. IC1084.2 +043400 LINK-FAIL-07-03. IC1084.2 +043500 PERFORM FAIL. IC1084.2 +043600 MOVE DN9 TO COMPUTED-A. IC1084.2 +043700 MOVE "B" TO CORRECT-A. IC1084.2 +043800 MOVE "IC111A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +043900 LINK-WRITE-07-03. IC1084.2 +044000 PERFORM PRINT-DETAIL. IC1084.2 +044100 GO TO CCVS-EXIT. IC1084.2 +044200 CCVS-EXIT SECTION. IC1084.2 +044300 CCVS-999999. IC1084.2 +044400 GO TO CLOSE-FILES. IC1084.2 +*END-OF,IC108A +*HEADER,COBOL,IC108A,SUBRTN,IC109A +000100 IDENTIFICATION DIVISION. IC1094.2 +000200 PROGRAM-ID. IC1094.2 +000300 IC109A. IC1094.2 +000400**************************************************************** IC1094.2 +000500* * IC1094.2 +000600* VALIDATION FOR:- * IC1094.2 +000700* * IC1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1094.2 +000900* * IC1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1094.2 +001100* * IC1094.2 +001200**************************************************************** IC1094.2 +001300* * IC1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1094.2 +001500* * IC1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1094.2 +001900* * IC1094.2 +002000**************************************************************** IC1094.2 +002100* THE SUBPROGRAM IC109 IS THE FIRST SUBPROGRAM IN A IC1094.2 +002200* SEQUENCE OF CALLS WHICH START IN THE MAIN PROGRAM IC108. IC1094.2 +002300* IC109 CALLS IC110 WITH ONE OPERAND IN THE WORKING-STORAGE IC1094.2 +002400* SECTION AND ONE OPERAND IN THE LINKAGE SECTION. IC1094.2 +002500 ENVIRONMENT DIVISION. IC1094.2 +002600 CONFIGURATION SECTION. IC1094.2 +002700 SOURCE-COMPUTER. IC1094.2 +002800 XXXXX082. IC1094.2 +002900 OBJECT-COMPUTER. IC1094.2 +003000 XXXXX083. IC1094.2 +003100 INPUT-OUTPUT SECTION. IC1094.2 +003200 FILE-CONTROL. IC1094.2 +003300 SELECT PRINT-FILE ASSIGN TO IC1094.2 +003400 XXXXX055. IC1094.2 +003500 DATA DIVISION. IC1094.2 +003600 FILE SECTION. IC1094.2 +003700 FD PRINT-FILE. IC1094.2 +003800 01 PRINT-REC PICTURE X(120). IC1094.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC1094.2 +004000 WORKING-STORAGE SECTION. IC1094.2 +004100 77 WS1 PICTURE X. IC1094.2 +004200 LINKAGE SECTION. IC1094.2 +004300 01 GRP-01. IC1094.2 +004400 02 SUB-CALLED. IC1094.2 +004500 03 DN1 PICTURE X(6). IC1094.2 +004600 03 DN2 PICTURE X(6). IC1094.2 +004700 03 DN3 PICTURE X(6). IC1094.2 +004800 02 TIMES-CALLED. IC1094.2 +004900 03 DN4 PICTURE S999. IC1094.2 +005000 03 DN5 PICTURE S999. IC1094.2 +005100 03 DN6 PICTURE S999. IC1094.2 +005200 02 SPECIAL-FLAGS. IC1094.2 +005300 03 DN7 PICTURE X. IC1094.2 +005400 03 DN8 PICTURE X. IC1094.2 +005500 03 DN9 PICTURE X. IC1094.2 +005600 PROCEDURE DIVISION USING GRP-01. IC1094.2 +005700 SECT-IC109-0001 SECTION. IC1094.2 +005800 PARA-IC109. IC1094.2 +005900 MOVE "IC109A" TO DN1. IC1094.2 +006000 MOVE SPACE TO WS1. IC1094.2 +006100 CALL "IC110A" USING WS1 GRP-01. IC1094.2 +006200 ADD 1 TO DN4. IC1094.2 +006300 MOVE WS1 TO DN9. IC1094.2 +006400 EXIT-IC109. IC1094.2 +006500 EXIT PROGRAM. IC1094.2 +*END-OF,IC109A +*HEADER,COBOL,IC108A,SUBRTN,IC110A +000100 IDENTIFICATION DIVISION. IC1104.2 +000200 PROGRAM-ID. IC1104.2 +000300 IC110A. IC1104.2 +000400**************************************************************** IC1104.2 +000500* * IC1104.2 +000600* VALIDATION FOR:- * IC1104.2 +000700* * IC1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1104.2 +000900* * IC1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1104.2 +001100* * IC1104.2 +001200**************************************************************** IC1104.2 +001300* * IC1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1104.2 +001500* * IC1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1104.2 +001900* * IC1104.2 +002000**************************************************************** IC1104.2 +002100* THE SUBPROGRAM IC110 IS THE SECOND SUBPROGRAM IN A IC1104.2 +002200* SEQUENCE OF CALLS WHICH START IN THE MAIN PROGRAM IC108. IC1104.2 +002300* THIS SUBPROGRAM CALLS IC111 WITH OPERANDS IN THE LINKAGE IC1104.2 +002400* SECTION AND IN THE WORKING-STORAGE SECTION. THE SUBPROGRAM IC1104.2 +002500* IC110 IS CALLED BY IC109. IC1104.2 +002600 ENVIRONMENT DIVISION. IC1104.2 +002700 CONFIGURATION SECTION. IC1104.2 +002800 SOURCE-COMPUTER. IC1104.2 +002900 XXXXX082. IC1104.2 +003000 OBJECT-COMPUTER. IC1104.2 +003100 XXXXX083. IC1104.2 +003200 INPUT-OUTPUT SECTION. IC1104.2 +003300 FILE-CONTROL. IC1104.2 +003400 SELECT PRINT-FILE ASSIGN TO IC1104.2 +003500 XXXXX055. IC1104.2 +003600 DATA DIVISION. IC1104.2 +003700 FILE SECTION. IC1104.2 +003800 FD PRINT-FILE. IC1104.2 +003900 01 PRINT-REC PICTURE X(120). IC1104.2 +004000 01 DUMMY-RECORD PICTURE X(120). IC1104.2 +004100 WORKING-STORAGE SECTION. IC1104.2 +004200 77 WS2 PICTURE X. IC1104.2 +004300 LINKAGE SECTION. IC1104.2 +004400 01 GRP-01. IC1104.2 +004500 02 SUB-CALLED. IC1104.2 +004600 03 DN1 PICTURE X(6). IC1104.2 +004700 03 DN2 PICTURE X(6). IC1104.2 +004800 03 DN3 PICTURE X(6). IC1104.2 +004900 02 TIMES-CALLED. IC1104.2 +005000 03 DN4 PICTURE S999. IC1104.2 +005100 03 DN5 PICTURE S999. IC1104.2 +005200 03 DN6 PICTURE S999. IC1104.2 +005300 02 SPECIAL-FLAGS. IC1104.2 +005400 03 DN7 PICTURE X. IC1104.2 +005500 03 DN8 PICTURE X. IC1104.2 +005600 03 DN9 PICTURE X. IC1104.2 +005700 01 LS1 PICTURE X. IC1104.2 +005800 PROCEDURE DIVISION USING LS1 GRP-01. IC1104.2 +005900 SECT-IC110-0001 SECTION. IC1104.2 +006000 PARA-IC110. IC1104.2 +006100 MOVE "IC110A" TO DN2. IC1104.2 +006200 MOVE SPACE TO WS2. IC1104.2 +006300 CALL "IC111A" USING LS1 GRP-01 WS2. IC1104.2 +006400 MOVE WS2 TO DN7. IC1104.2 +006500 MOVE LS1 TO DN8. IC1104.2 +006600 ADD 1 TO DN5. IC1104.2 +006700 MOVE "B" TO LS1. IC1104.2 +006800 EXIT-IC110. IC1104.2 +006900 EXIT PROGRAM. IC1104.2 +*END-OF,IC110A +*HEADER,COBOL,IC108A,SUBRTN,IC111A +000100 IDENTIFICATION DIVISION. IC1114.2 +000200 PROGRAM-ID. IC1114.2 +000300 IC111A. IC1114.2 +000400**************************************************************** IC1114.2 +000500* * IC1114.2 +000600* VALIDATION FOR:- * IC1114.2 +000700* * IC1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1114.2 +000900* * IC1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1114.2 +001100* * IC1114.2 +001200**************************************************************** IC1114.2 +001300* * IC1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1114.2 +001500* * IC1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1114.2 +001900* * IC1114.2 +002000**************************************************************** IC1114.2 +002100* THE SUBPROGRAM IC111 IS THE LAST SUBPROGRAM CALLED IC1114.2 +002200* IN A SEQUENCE OF SUBPROGRAM CALLS WHICH IS STARTED IN IC1114.2 +002300* MAIN PROGRAM IC108. THE SUBPROGRAM IC111 IS CALLED BY IC1114.2 +002400* THE SUBPROGRAM IC110. IC1114.2 +002500 ENVIRONMENT DIVISION. IC1114.2 +002600 CONFIGURATION SECTION. IC1114.2 +002700 SOURCE-COMPUTER. IC1114.2 +002800 XXXXX082. IC1114.2 +002900 OBJECT-COMPUTER. IC1114.2 +003000 XXXXX083. IC1114.2 +003100 DATA DIVISION. IC1114.2 +003200 LINKAGE SECTION. IC1114.2 +003300 77 LS1 PICTURE X. IC1114.2 +003400 77 LS2 PICTURE X. IC1114.2 +003500 01 GRP-01. IC1114.2 +003600 02 SUB-CALLED. IC1114.2 +003700 03 DN1 PICTURE X(6). IC1114.2 +003800 03 DN2 PICTURE X(6). IC1114.2 +003900 03 DN3 PICTURE X(6). IC1114.2 +004000 02 TIMES-CALLED. IC1114.2 +004100 03 DN4 PICTURE S999. IC1114.2 +004200 03 DN5 PICTURE S999. IC1114.2 +004300 03 DN6 PICTURE S999. IC1114.2 +004400 02 SPECIAL-FLAGS. IC1114.2 +004500 03 DN7 PICTURE X. IC1114.2 +004600 03 DN8 PICTURE X. IC1114.2 +004700 03 DN9 PICTURE X. IC1114.2 +004800 PROCEDURE DIVISION USING LS1 GRP-01 LS2. IC1114.2 +004900 SECT-IC111-0001 SECTION. IC1114.2 +005000 PARA-IC111. IC1114.2 +005100 MOVE "IC111A" TO DN3. IC1114.2 +005200 ADD 1 TO DN6. IC1114.2 +005300 MOVE "A" TO LS2. IC1114.2 +005400 MOVE "A" TO LS1. IC1114.2 +005500 EXIT-IC111. IC1114.2 +005600 EXIT PROGRAM. IC1114.2 +*END-OF,IC111A +*HEADER,COBOL,IC112A +000100 IDENTIFICATION DIVISION. IC1124.2 +000200 PROGRAM-ID. IC1124.2 +000300 IC112A. IC1124.2 +000400**************************************************************** IC1124.2 +000500* * IC1124.2 +000600* VALIDATION FOR:- * IC1124.2 +000700* * IC1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +000900* * IC1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1124.2 +001100* * IC1124.2 +001200**************************************************************** IC1124.2 +001300* * IC1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1124.2 +001500* * IC1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1124.2 +001900* * IC1124.2 +002000**************************************************************** IC1124.2 +002100**************************************************************** IC1124.2 +002200* IC1124.2 +002300* THE ROUTINE IC112 IS A MAIN PROGRAM WHICH HAS A FILE IC1124.2 +002400* DESCRIPTION FOR A SEQUENTIAL MASS STORAGE FILE WITH FIXED IC1124.2 +002500* LENGTH RECORDS. THE FILE IS CREATED, CLOSED AND OPENED AS IC1124.2 +002600* AN INPUT FILE. THE MAIN ROUTINE READS THE FILE AND VERIFIES IC1124.2 +002700* THAT THE FILE IS CORRECT. THE FILE IS CLOSED AND OPENED IC1124.2 +002800* AGAIN AS AN INPUT FILE. A RECORD IS READ AND A CALL IS MADE IC1124.2 +002900* TO THE SUBPROGRAM IC113 WITH THE FILE DESCRIPTION 01 RECORD IC1124.2 +003000* LISTED AS ONE OF THE OPERANDS OF THE USING PHRASE. THE IC1124.2 +003100* SUBPROGRAM IC113 COMPARES THE FIELDS IN THE INPUT RECORD TO IC1124.2 +003200* THE VALUES WRITTEN WHEN THE FILE WAS CREATED. IC1124.2 +003300* IC1124.2 +003400* THIS PROGRAM WAS ADAPTED FROM THE SEQUENTIAL I-O TEST IC1124.2 +003500* CONTAINED IN ROUTINE SQ104. IF ANY ERRORS OCCUR IN RUNNING IC1124.2 +003600* THE ROUTINE SQ104, THE RESULTS OF THE TESTS IN THE ROUTINES IC1124.2 +003700* IC112 AND IC113 ARE INCONCLUSIVE. IC1124.2 +003800* IC1124.2 +003900******************************************* IC1124.2 +004000 ENVIRONMENT DIVISION. IC1124.2 +004100 CONFIGURATION SECTION. IC1124.2 +004200 SOURCE-COMPUTER. IC1124.2 +004300 XXXXX082. IC1124.2 +004400 OBJECT-COMPUTER. IC1124.2 +004500 XXXXX083. IC1124.2 +004600 INPUT-OUTPUT SECTION. IC1124.2 +004700 FILE-CONTROL. IC1124.2 +004800 SELECT PRINT-FILE ASSIGN TO IC1124.2 +004900 XXXXX055. IC1124.2 +005000 SELECT SQ-FS3 ASSIGN TO IC1124.2 +005100 XXXXX014 IC1124.2 +005200 ORGANIZATION IS SEQUENTIAL IC1124.2 +005300 ACCESS MODE IS SEQUENTIAL. IC1124.2 +005400 DATA DIVISION. IC1124.2 +005500 FILE SECTION. IC1124.2 +005600 FD PRINT-FILE. IC1124.2 +005700 01 PRINT-REC PICTURE X(120). IC1124.2 +005800 01 DUMMY-RECORD PICTURE X(120). IC1124.2 +005900 FD SQ-FS3 IC1124.2 +006000 BLOCK CONTAINS 120 CHARACTERS IC1124.2 +006100 RECORD CONTAINS 120 CHARACTERS IC1124.2 +006200 LABEL RECORDS ARE STANDARD IC1124.2 +006300C VALUE OF IC1124.2 +006400C XXXXX074 IC1124.2 +006500C IS IC1124.2 +006600C XXXXX075 IC1124.2 +006700G XXXXX069 IC1124.2 +006800 DATA RECORD SQ-FS3R1-F-G-120. IC1124.2 +006900 01 SQ-FS3R1-F-G-120. IC1124.2 +007000 02 FILLER PIC X(120). IC1124.2 +007100 WORKING-STORAGE SECTION. IC1124.2 +007200 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. IC1124.2 +007300 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. IC1124.2 +007400 01 ERROR-FLAG PICTURE 9 VALUE 0. IC1124.2 +007500 01 EOF-FLAG PICTURE 9 VALUE 0. IC1124.2 +007600 01 FILE-RECORD-INFORMATION-REC. IC1124.2 +007700 03 FILE-RECORD-INFO-SKELETON. IC1124.2 +007800 05 FILLER PICTURE X(48) VALUE IC1124.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IC1124.2 +008000 05 FILLER PICTURE X(46) VALUE IC1124.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IC1124.2 +008200 05 FILLER PICTURE X(26) VALUE IC1124.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". IC1124.2 +008400 05 FILLER PICTURE X(37) VALUE IC1124.2 +008500 ",RECKEY= ". IC1124.2 +008600 05 FILLER PICTURE X(38) VALUE IC1124.2 +008700 ",ALTKEY1= ". IC1124.2 +008800 05 FILLER PICTURE X(38) VALUE IC1124.2 +008900 ",ALTKEY2= ". IC1124.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.IC1124.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IC1124.2 +009200 05 FILE-RECORD-INFO-P1-120. IC1124.2 +009300 07 FILLER PIC X(5). IC1124.2 +009400 07 XFILE-NAME PIC X(6). IC1124.2 +009500 07 FILLER PIC X(8). IC1124.2 +009600 07 XRECORD-NAME PIC X(6). IC1124.2 +009700 07 FILLER PIC X(1). IC1124.2 +009800 07 REELUNIT-NUMBER PIC 9(1). IC1124.2 +009900 07 FILLER PIC X(7). IC1124.2 +010000 07 XRECORD-NUMBER PIC 9(6). IC1124.2 +010100 07 FILLER PIC X(6). IC1124.2 +010200 07 UPDATE-NUMBER PIC 9(2). IC1124.2 +010300 07 FILLER PIC X(5). IC1124.2 +010400 07 ODO-NUMBER PIC 9(4). IC1124.2 +010500 07 FILLER PIC X(5). IC1124.2 +010600 07 XPROGRAM-NAME PIC X(5). IC1124.2 +010700 07 FILLER PIC X(7). IC1124.2 +010800 07 XRECORD-LENGTH PIC 9(6). IC1124.2 +010900 07 FILLER PIC X(7). IC1124.2 +011000 07 CHARS-OR-RECORDS PIC X(2). IC1124.2 +011100 07 FILLER PIC X(1). IC1124.2 +011200 07 XBLOCK-SIZE PIC 9(4). IC1124.2 +011300 07 FILLER PIC X(6). IC1124.2 +011400 07 RECORDS-IN-FILE PIC 9(6). IC1124.2 +011500 07 FILLER PIC X(5). IC1124.2 +011600 07 XFILE-ORGANIZATION PIC X(2). IC1124.2 +011700 07 FILLER PIC X(6). IC1124.2 +011800 07 XLABEL-TYPE PIC X(1). IC1124.2 +011900 05 FILE-RECORD-INFO-P121-240. IC1124.2 +012000 07 FILLER PIC X(8). IC1124.2 +012100 07 XRECORD-KEY PIC X(29). IC1124.2 +012200 07 FILLER PIC X(9). IC1124.2 +012300 07 ALTERNATE-KEY1 PIC X(29). IC1124.2 +012400 07 FILLER PIC X(9). IC1124.2 +012500 07 ALTERNATE-KEY2 PIC X(29). IC1124.2 +012600 07 FILLER PIC X(7). IC1124.2 +012700 01 TEST-RESULTS. IC1124.2 +012800 02 FILLER PIC X VALUE SPACE. IC1124.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. IC1124.2 +013000 02 FILLER PIC X VALUE SPACE. IC1124.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. IC1124.2 +013200 02 FILLER PIC X VALUE SPACE. IC1124.2 +013300 02 PAR-NAME. IC1124.2 +013400 03 FILLER PIC X(19) VALUE SPACE. IC1124.2 +013500 03 PARDOT-X PIC X VALUE SPACE. IC1124.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. IC1124.2 +013700 02 FILLER PIC X(8) VALUE SPACE. IC1124.2 +013800 02 RE-MARK PIC X(61). IC1124.2 +013900 01 TEST-COMPUTED. IC1124.2 +014000 02 FILLER PIC X(30) VALUE SPACE. IC1124.2 +014100 02 FILLER PIC X(17) VALUE IC1124.2 +014200 " COMPUTED=". IC1124.2 +014300 02 COMPUTED-X. IC1124.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1124.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A IC1124.2 +014600 PIC -9(9).9(9). IC1124.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1124.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1124.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1124.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. IC1124.2 +015100 04 COMPUTED-18V0 PIC -9(18). IC1124.2 +015200 04 FILLER PIC X. IC1124.2 +015300 03 FILLER PIC X(50) VALUE SPACE. IC1124.2 +015400 01 TEST-CORRECT. IC1124.2 +015500 02 FILLER PIC X(30) VALUE SPACE. IC1124.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". IC1124.2 +015700 02 CORRECT-X. IC1124.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. IC1124.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1124.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1124.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1124.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1124.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. IC1124.2 +016400 04 CORRECT-18V0 PIC -9(18). IC1124.2 +016500 04 FILLER PIC X. IC1124.2 +016600 03 FILLER PIC X(2) VALUE SPACE. IC1124.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1124.2 +016800 01 CCVS-C-1. IC1124.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1124.2 +017000- "SS PARAGRAPH-NAME IC1124.2 +017100- " REMARKS". IC1124.2 +017200 02 FILLER PIC X(20) VALUE SPACE. IC1124.2 +017300 01 CCVS-C-2. IC1124.2 +017400 02 FILLER PIC X VALUE SPACE. IC1124.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". IC1124.2 +017600 02 FILLER PIC X(15) VALUE SPACE. IC1124.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". IC1124.2 +017800 02 FILLER PIC X(94) VALUE SPACE. IC1124.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1124.2 +018000 01 REC-CT PIC 99 VALUE ZERO. IC1124.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1124.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1124.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1124.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1124.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1124.2 +019000 01 CCVS-H-1. IC1124.2 +019100 02 FILLER PIC X(39) VALUE SPACES. IC1124.2 +019200 02 FILLER PIC X(42) VALUE IC1124.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1124.2 +019400 02 FILLER PIC X(39) VALUE SPACES. IC1124.2 +019500 01 CCVS-H-2A. IC1124.2 +019600 02 FILLER PIC X(40) VALUE SPACE. IC1124.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1124.2 +019800 02 FILLER PIC XXXX VALUE IC1124.2 +019900 "4.2 ". IC1124.2 +020000 02 FILLER PIC X(28) VALUE IC1124.2 +020100 " COPY - NOT FOR DISTRIBUTION". IC1124.2 +020200 02 FILLER PIC X(41) VALUE SPACE. IC1124.2 +020300 IC1124.2 +020400 01 CCVS-H-2B. IC1124.2 +020500 02 FILLER PIC X(15) VALUE IC1124.2 +020600 "TEST RESULT OF ". IC1124.2 +020700 02 TEST-ID PIC X(9). IC1124.2 +020800 02 FILLER PIC X(4) VALUE IC1124.2 +020900 " IN ". IC1124.2 +021000 02 FILLER PIC X(12) VALUE IC1124.2 +021100 " HIGH ". IC1124.2 +021200 02 FILLER PIC X(22) VALUE IC1124.2 +021300 " LEVEL VALIDATION FOR ". IC1124.2 +021400 02 FILLER PIC X(58) VALUE IC1124.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +021600 01 CCVS-H-3. IC1124.2 +021700 02 FILLER PIC X(34) VALUE IC1124.2 +021800 " FOR OFFICIAL USE ONLY ". IC1124.2 +021900 02 FILLER PIC X(58) VALUE IC1124.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1124.2 +022100 02 FILLER PIC X(28) VALUE IC1124.2 +022200 " COPYRIGHT 1985 ". IC1124.2 +022300 01 CCVS-E-1. IC1124.2 +022400 02 FILLER PIC X(52) VALUE SPACE. IC1124.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1124.2 +022600 02 ID-AGAIN PIC X(9). IC1124.2 +022700 02 FILLER PIC X(45) VALUE SPACES. IC1124.2 +022800 01 CCVS-E-2. IC1124.2 +022900 02 FILLER PIC X(31) VALUE SPACE. IC1124.2 +023000 02 FILLER PIC X(21) VALUE SPACE. IC1124.2 +023100 02 CCVS-E-2-2. IC1124.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1124.2 +023300 03 FILLER PIC X VALUE SPACE. IC1124.2 +023400 03 ENDER-DESC PIC X(44) VALUE IC1124.2 +023500 "ERRORS ENCOUNTERED". IC1124.2 +023600 01 CCVS-E-3. IC1124.2 +023700 02 FILLER PIC X(22) VALUE IC1124.2 +023800 " FOR OFFICIAL USE ONLY". IC1124.2 +023900 02 FILLER PIC X(12) VALUE SPACE. IC1124.2 +024000 02 FILLER PIC X(58) VALUE IC1124.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +024200 02 FILLER PIC X(13) VALUE SPACE. IC1124.2 +024300 02 FILLER PIC X(15) VALUE IC1124.2 +024400 " COPYRIGHT 1985". IC1124.2 +024500 01 CCVS-E-4. IC1124.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1124.2 +024700 02 FILLER PIC X(4) VALUE " OF ". IC1124.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1124.2 +024900 02 FILLER PIC X(40) VALUE IC1124.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". IC1124.2 +025100 01 XXINFO. IC1124.2 +025200 02 FILLER PIC X(19) VALUE IC1124.2 +025300 "*** INFORMATION ***". IC1124.2 +025400 02 INFO-TEXT. IC1124.2 +025500 04 FILLER PIC X(8) VALUE SPACE. IC1124.2 +025600 04 XXCOMPUTED PIC X(20). IC1124.2 +025700 04 FILLER PIC X(5) VALUE SPACE. IC1124.2 +025800 04 XXCORRECT PIC X(20). IC1124.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). IC1124.2 +026000 01 HYPHEN-LINE. IC1124.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. IC1124.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************IC1124.2 +026300- "*****************************************". IC1124.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************IC1124.2 +026500- "******************************". IC1124.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE IC1124.2 +026700 "IC112A". IC1124.2 +026800 PROCEDURE DIVISION. IC1124.2 +026900 CCVS1 SECTION. IC1124.2 +027000 OPEN-FILES. IC1124.2 +027100 OPEN OUTPUT PRINT-FILE. IC1124.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1124.2 +027300 MOVE SPACE TO TEST-RESULTS. IC1124.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1124.2 +027500 GO TO CCVS1-EXIT. IC1124.2 +027600 CLOSE-FILES. IC1124.2 +027700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1124.2 +027800 TERMINATE-CCVS. IC1124.2 +027900S EXIT PROGRAM. IC1124.2 +028000STERMINATE-CALL. IC1124.2 +028100 STOP RUN. IC1124.2 +028200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1124.2 +028300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1124.2 +028400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1124.2 +028500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1124.2 +028600 MOVE "****TEST DELETED****" TO RE-MARK. IC1124.2 +028700 PRINT-DETAIL. IC1124.2 +028800 IF REC-CT NOT EQUAL TO ZERO IC1124.2 +028900 MOVE "." TO PARDOT-X IC1124.2 +029000 MOVE REC-CT TO DOTVALUE. IC1124.2 +029100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1124.2 +029200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1124.2 +029300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1124.2 +029400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1124.2 +029500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1124.2 +029600 MOVE SPACE TO CORRECT-X. IC1124.2 +029700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1124.2 +029800 MOVE SPACE TO RE-MARK. IC1124.2 +029900 HEAD-ROUTINE. IC1124.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1124.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1124.2 +030400 COLUMN-NAMES-ROUTINE. IC1124.2 +030500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +030600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +030800 END-ROUTINE. IC1124.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1124.2 +031000 END-RTN-EXIT. IC1124.2 +031100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +031200 END-ROUTINE-1. IC1124.2 +031300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1124.2 +031400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1124.2 +031500 ADD PASS-COUNTER TO ERROR-HOLD. IC1124.2 +031600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1124.2 +031700 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1124.2 +031800 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1124.2 +031900 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1124.2 +032000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1124.2 +032100 END-ROUTINE-12. IC1124.2 +032200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1124.2 +032300 IF ERROR-COUNTER IS EQUAL TO ZERO IC1124.2 +032400 MOVE "NO " TO ERROR-TOTAL IC1124.2 +032500 ELSE IC1124.2 +032600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1124.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1124.2 +032800 PERFORM WRITE-LINE. IC1124.2 +032900 END-ROUTINE-13. IC1124.2 +033000 IF DELETE-COUNTER IS EQUAL TO ZERO IC1124.2 +033100 MOVE "NO " TO ERROR-TOTAL ELSE IC1124.2 +033200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1124.2 +033300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1124.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +033500 IF INSPECT-COUNTER EQUAL TO ZERO IC1124.2 +033600 MOVE "NO " TO ERROR-TOTAL IC1124.2 +033700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1124.2 +033800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1124.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +034000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +034100 WRITE-LINE. IC1124.2 +034200 ADD 1 TO RECORD-COUNT. IC1124.2 +034300Y IF RECORD-COUNT GREATER 50 IC1124.2 +034400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1124.2 +034500Y MOVE SPACE TO DUMMY-RECORD IC1124.2 +034600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1124.2 +034700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1124.2 +034800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1124.2 +034900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1124.2 +035000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1124.2 +035100Y MOVE ZERO TO RECORD-COUNT. IC1124.2 +035200 PERFORM WRT-LN. IC1124.2 +035300 WRT-LN. IC1124.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1124.2 +035500 MOVE SPACE TO DUMMY-RECORD. IC1124.2 +035600 BLANK-LINE-PRINT. IC1124.2 +035700 PERFORM WRT-LN. IC1124.2 +035800 FAIL-ROUTINE. IC1124.2 +035900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1124.2 +036000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1124.2 +036100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1124.2 +036200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1124.2 +036300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +036400 MOVE SPACES TO INF-ANSI-REFERENCE. IC1124.2 +036500 GO TO FAIL-ROUTINE-EX. IC1124.2 +036600 FAIL-ROUTINE-WRITE. IC1124.2 +036700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1124.2 +036800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1124.2 +036900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1124.2 +037000 MOVE SPACES TO COR-ANSI-REFERENCE. IC1124.2 +037100 FAIL-ROUTINE-EX. EXIT. IC1124.2 +037200 BAIL-OUT. IC1124.2 +037300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1124.2 +037400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1124.2 +037500 BAIL-OUT-WRITE. IC1124.2 +037600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1124.2 +037700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1124.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. IC1124.2 +038000 BAIL-OUT-EX. EXIT. IC1124.2 +038100 CCVS1-EXIT. IC1124.2 +038200 EXIT. IC1124.2 +038300 SECT-IC112-0001 SECTION. IC1124.2 +038400 SEQ-INIT-007. IC1124.2 +038500 MOVE FILE-RECORD-INFO-SKELETON IC1124.2 +038600 TO FILE-RECORD-INFO-P1-120 (1). IC1124.2 +038700 MOVE "SQ-FS3" TO XFILE-NAME (1). IC1124.2 +038800 MOVE "R1-F-G" TO XRECORD-NAME (1). IC1124.2 +038900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IC1124.2 +039000 MOVE 120 TO XRECORD-LENGTH (1). IC1124.2 +039100 MOVE "CH" TO CHARS-OR-RECORDS (1). IC1124.2 +039200 MOVE 120 TO XBLOCK-SIZE (1). IC1124.2 +039300 MOVE 000649 TO RECORDS-IN-FILE (1). IC1124.2 +039400 MOVE "SQ" TO XFILE-ORGANIZATION (1). IC1124.2 +039500 MOVE "S" TO XLABEL-TYPE (1). IC1124.2 +039600 MOVE 000001 TO XRECORD-NUMBER (1). IC1124.2 +039700 OPEN OUTPUT SQ-FS3. IC1124.2 +039800 SEQ-TEST-007. IC1124.2 +039900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. IC1124.2 +040000 WRITE SQ-FS3R1-F-G-120. IC1124.2 +040100 IF XRECORD-NUMBER (1) EQUAL TO 649 IC1124.2 +040200 GO TO SEQ-WRITE-007. IC1124.2 +040300 ADD 1 TO XRECORD-NUMBER (1). IC1124.2 +040400 GO TO SEQ-TEST-007. IC1124.2 +040500 SEQ-WRITE-007. IC1124.2 +040600 MOVE "CREATE FILE SQ-FS3" TO FEATURE. IC1124.2 +040700 MOVE "SEQ-TEST-007" TO PAR-NAME. IC1124.2 +040800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IC1124.2 +040900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IC1124.2 +041000 PERFORM PRINT-DETAIL. IC1124.2 +041100 CLOSE SQ-FS3. IC1124.2 +041200* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER IC1124.2 +041300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. IC1124.2 +041400 SEQ-INIT-008. IC1124.2 +041500 MOVE ZERO TO WRK-CS-09V00. IC1124.2 +041600* THIS TEST READS AND CHECKS THE FILE CREATED IN IC1124.2 +041700* SEQ-TEST-007. IC1124.2 +041800 OPEN INPUT SQ-FS3. IC1124.2 +041900 SEQ-TEST-008. IC1124.2 +042000 READ SQ-FS3 RECORD IC1124.2 +042100 AT END GO TO SEQ-TEST-008-1. IC1124.2 +042200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). IC1124.2 +042300 ADD 1 TO WRK-CS-09V00. IC1124.2 +042400 IF WRK-CS-09V00 GREATER THAN 649 IC1124.2 +042500 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IC1124.2 +042600 GO TO SEQ-FAIL-008. IC1124.2 +042700 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IC1124.2 +042800 ADD 1 TO RECORDS-IN-ERROR IC1124.2 +042900 GO TO SEQ-TEST-008. IC1124.2 +043000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" IC1124.2 +043100 ADD 1 TO RECORDS-IN-ERROR IC1124.2 +043200 GO TO SEQ-TEST-008. IC1124.2 +043300 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IC1124.2 +043400 ADD 1 TO RECORDS-IN-ERROR. IC1124.2 +043500 GO TO SEQ-TEST-008. IC1124.2 +043600 SEQ-TEST-008-1. IC1124.2 +043700 IF RECORDS-IN-ERROR EQUAL TO ZERO IC1124.2 +043800 GO TO SEQ-PASS-008. IC1124.2 +043900 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. IC1124.2 +044000 SEQ-FAIL-008. IC1124.2 +044100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1124.2 +044200 PERFORM FAIL. IC1124.2 +044300 GO TO SEQ-WRITE-008. IC1124.2 +044400 SEQ-PASS-008. IC1124.2 +044500 PERFORM PASS. IC1124.2 +044600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IC1124.2 +044700 MOVE WRK-CS-09V00 TO CORRECT-18V0. IC1124.2 +044800 SEQ-WRITE-008. IC1124.2 +044900 MOVE "SEQ-TEST-008" TO PAR-NAME. IC1124.2 +045000 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. IC1124.2 +045100 PERFORM PRINT-DETAIL. IC1124.2 +045200 SEQ-CLOSE-008. IC1124.2 +045300 CLOSE SQ-FS3. IC1124.2 +045400 LINK-INIT-08. IC1124.2 +045500 MOVE ZERO TO WRK-CS-09V00. IC1124.2 +045600 MOVE ZERO TO RECORDS-IN-ERROR. IC1124.2 +045700 OPEN INPUT SQ-FS3. IC1124.2 +045800* IC1124.2 +045900* LINK-TEST-08 READS THE FILE SQ-FS3 AND CALLS THE SUB- IC1124.2 +046000* PROGRAM IC113 TO CHECK THE FIELDS IN THE RECORD. THE FILE IC1124.2 +046100* DESCRIPTION RECORD IS ONE OF THE OPERANDS IN THE USING IC1124.2 +046200* PHRASE OF THE CALL STATEMENT. IC1124.2 +046300* IC1124.2 +046400 MOVE ZERO TO ERROR-FLAG. IC1124.2 +046500 LINK-TEST-08. IC1124.2 +046600 READ SQ-FS3 RECORD IC1124.2 +046700 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A IC1124.2 +046800 MOVE 1 TO EOF-FLAG IC1124.2 +046900 GO TO LINK-FAIL-08. IC1124.2 +047000 CALL "IC113A" USING RECORDS-IN-ERROR SQ-FS3R1-F-G-120 IC1124.2 +047100 ERROR-FLAG WRK-CS-09V00. IC1124.2 +047200 IF WRK-CS-09V00 LESS THAN 649 IC1124.2 +047300 GO TO LINK-TEST-08. IC1124.2 +047400 LINK-TEST-08-01. IC1124.2 +047500 IF ERROR-FLAG EQUAL TO ZERO IC1124.2 +047600 GO TO LINK-PASS-08. IC1124.2 +047700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IC1124.2 +047800 LINK-FAIL-08. IC1124.2 +047900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1124.2 +048000 MOVE "CORRECT COL. = RECORDS-IN-ERROR" TO RE-MARK. IC1124.2 +048100 PERFORM FAIL. IC1124.2 +048200 GO TO LINK-WRITE-08. IC1124.2 +048300 LINK-PASS-08. IC1124.2 +048400 PERFORM PASS. IC1124.2 +048500 LINK-WRITE-08. IC1124.2 +048600 MOVE "LINK-TEST-08" TO PAR-NAME. IC1124.2 +048700 MOVE "USING FD 01 RECORD" TO FEATURE. IC1124.2 +048800 PERFORM PRINT-DETAIL. IC1124.2 +048900 LINK-INIT-09. IC1124.2 +049000 MOVE ZERO TO RECORDS-IN-ERROR ERROR-FLAG. IC1124.2 +049100* IC1124.2 +049200* LINK-TEST-09 READS THE FILE SQ-FS3. THE AT END PHRASE IC1124.2 +049300* OF THE READ STATEMENT SHOULD BE EXECUTED. A CALL TO THE IC1124.2 +049400* SUBPROGRAM IC113 IS CONTAINED IN THE AT END PHRASE WITH IC1124.2 +049500* THE FD 01 RECORD AS ONE OF THE USING OPERANDS. IC1124.2 +049600* IC1124.2 +049700 LINK-TEST-09-01. IC1124.2 +049800 IF EOF-FLAG EQUAL TO 1 IC1124.2 +049900 CALL "IC113A" USING RECORDS-IN-ERROR SQ-FS3R1-F-G-120IC1124.2 +050000 ERROR-FLAG WRK-CS-09V00 IC1124.2 +050100 GO TO LINK-TEST-09-02. IC1124.2 +050200 LINK-TEST-09. IC1124.2 +050300 READ SQ-FS3 IC1124.2 +050400 AT END CALL "IC113A" USING RECORDS-IN-ERROR IC1124.2 +050500 SQ-FS3R1-F-G-120 ERROR-FLAG WRK-CS-09V00 IC1124.2 +050600 GO TO LINK-TEST-09-02. IC1124.2 +050700 MOVE "MORE THAN 649 RECORDS" TO RE-MARK. IC1124.2 +050800 GO TO LINK-FAIL-09. IC1124.2 +050900 LINK-TEST-09-02. IC1124.2 +051000 IF ERROR-FLAG EQUAL TO 1 IC1124.2 +051100 GO TO LINK-PASS-09. IC1124.2 +051200 MOVE "ERROR FLAG NOT SET IN SUBPRGRM" TO RE-MARK. IC1124.2 +051300 LINK-FAIL-09. IC1124.2 +051400 PERFORM FAIL. IC1124.2 +051500 GO TO LINK-WRITE-09. IC1124.2 +051600 LINK-PASS-09. IC1124.2 +051700 PERFORM PASS. IC1124.2 +051800 LINK-WRITE-09. IC1124.2 +051900 MOVE "LINK-TEST-09" TO PAR-NAME. IC1124.2 +052000 MOVE "CALL AFTER AT END" TO FEATURE. IC1124.2 +052100 PERFORM PRINT-DETAIL. IC1124.2 +052200 CLOSE SQ-FS3. IC1124.2 +052300 EXIT-IC112. IC1124.2 +052400 EXIT. IC1124.2 +052500XFILE-DUMP SECTION. IC1124.2 +052600XFILE-3-DUMP-INIT. IC1124.2 +052700X OPEN INPUT SQ-FS3. IC1124.2 +052800X MOVE ZERO TO WRK-CS-09V00. IC1124.2 +052900XFILE-3-DUMP. IC1124.2 +053000X ADD 1 TO WRK-CS-09V00. IC1124.2 +053100X IF WRK-CS-09V00 GREATER THAN 649 IC1124.2 +053200X GO TO FILE-3-DUMP-EXTRA. IC1124.2 +053300X READ SQ-FS3 RECORD AT END IC1124.2 +053400X GO TO FILE-3-DUMP-END. IC1124.2 +053500X PERFORM FILE-3-DUMP-WRITE. IC1124.2 +053600X GO TO FILE-3-DUMP. IC1124.2 +053700XFILE-3-DUMP-WRITE. IC1124.2 +053800X MOVE SQ-FS3R1-F-G-120 TO DUMMY-RECORD. IC1124.2 +053900X PERFORM WRITE-LINE. IC1124.2 +054000XFILE-3-DUMP-EXTRA. IC1124.2 +054100X PERFORM BLANK-LINE-PRINT 5 TIMES. IC1124.2 +054200XFILE-3-DUMP-MORE. IC1124.2 +054300X READ SQ-FS3 RECORD AT END IC1124.2 +054400X GO TO FILE-3-DUMP-END. IC1124.2 +054500X PERFORM FILE-3-DUMP-WRITE. IC1124.2 +054600X ADD 1 TO WRK-CS-09V00. IC1124.2 +054700X IF WRK-CS-09V00 LESS THAN 669 IC1124.2 +054800X GO TO FILE-3-DUMP-MORE. IC1124.2 +054900XFILE-3-DUMP-END. IC1124.2 +055000X CLOSE SQ-FS3. IC1124.2 +055100XFILE-3-DUMP-EXIT. IC1124.2 +055200X EXIT. IC1124.2 +055300 CCVS-EXIT SECTION. IC1124.2 +055400 CCVS-999999. IC1124.2 +055500 GO TO CLOSE-FILES. IC1124.2 +*END-OF,IC112A +*HEADER,COBOL,IC112A,SUBRTN,IC113A +000100 IDENTIFICATION DIVISION. IC1134.2 +000200 PROGRAM-ID. IC1134.2 +000300 IC113A. IC1134.2 +000400**************************************************************** IC1134.2 +000500* * IC1134.2 +000600* VALIDATION FOR:- * IC1134.2 +000700* * IC1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1134.2 +000900* * IC1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1134.2 +001100* * IC1134.2 +001200**************************************************************** IC1134.2 +001300* * IC1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1134.2 +001500* * IC1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1134.2 +001900* * IC1134.2 +002000**************************************************************** IC1134.2 +002100* IC1134.2 +002200* THE SUBPROGRAM IC113 IS CALLED BY THE MAIN PROGRAM IC112IC1134.2 +002300* WHICH HAS A FILE DESCRIPTION RECORD IN THE USING PHRASE OF IC1134.2 +002400* THE CALL STATEMENT REFERENCING THIS SUBPROGRAM. IC113 CHECKSIC1134.2 +002500* THE VALUES IN THE FILE RECORD DESCRIBED IN THE LINKAGE IC1134.2 +002600* SECTION OF THE SUBPROGRAM. IF ANY ERRORS ARE ENCOUNTERED IC1134.2 +002700* THE ERROR-FLAG IS SET TO 1 AND THE RECORDS-IN-ERROR COUNTER IC1134.2 +002800* IS INCREMENTED BY 1. IC1134.2 +002900* IC1134.2 +003000******************************************** IC1134.2 +003100 ENVIRONMENT DIVISION. IC1134.2 +003200 CONFIGURATION SECTION. IC1134.2 +003300 SOURCE-COMPUTER. IC1134.2 +003400 XXXXX082. IC1134.2 +003500 OBJECT-COMPUTER. IC1134.2 +003600 XXXXX083. IC1134.2 +003700 DATA DIVISION. IC1134.2 +003800 WORKING-STORAGE SECTION. IC1134.2 +003900 01 DUMMY-WS-ENTRY PIC 99 VALUE 0. IC1134.2 +004000 LINKAGE SECTION. IC1134.2 +004100 01 COUNT-OF-RECORDS PIC S9(9) USAGE COMP. IC1134.2 +004200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP. IC1134.2 +004300 01 ERROR-FLAG PICTURE 9. IC1134.2 +004400 01 SQ-FS3-R1-G-120. IC1134.2 +004500 02 XFILE-NAME-GROUP. IC1134.2 +004600 03 FILLER PIC X(5). IC1134.2 +004700 03 XFILE-NAME PIC X(6). IC1134.2 +004800 02 XRECORD-NAME-GROUP. IC1134.2 +004900 03 FILLER PIC X(8). IC1134.2 +005000 03 XRECORD-NAME PIC X(6). IC1134.2 +005100 02 REELUNIT-NUMBER-GROUP. IC1134.2 +005200 03 FILLER PIC X(1). IC1134.2 +005300 03 REELUNIT-NUMBER PIC 9(1). IC1134.2 +005400 02 FILLER PIC X(7). IC1134.2 +005500 02 XRECORD-NUMBER PIC 9(6). IC1134.2 +005600 02 FILLER PIC X(79). IC1134.2 +005700 02 XLABEL-TYPE PIC X(1). IC1134.2 +005800 PROCEDURE DIVISION USING RECORDS-IN-ERROR SQ-FS3-R1-G-120 IC1134.2 +005900 ERROR-FLAG COUNT-OF-RECORDS. IC1134.2 +006000 SECT-IC113-0001 SECTION. IC1134.2 +006100 LINK-TEST-08. IC1134.2 +006200 ADD 1 TO COUNT-OF-RECORDS. IC1134.2 +006300 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER IC1134.2 +006400 GO TO LINK-FAIL-08. IC1134.2 +006500 IF REELUNIT-NUMBER-GROUP NOT EQUAL TO "/0" IC1134.2 +006600 GO TO LINK-FAIL-08. IC1134.2 +006700 IF XFILE-NAME NOT EQUAL TO "SQ-FS3" IC1134.2 +006800 GO TO LINK-FAIL-08. IC1134.2 +006900 IF XRECORD-NAME NOT EQUAL TO "R1-F-G" IC1134.2 +007000 GO TO LINK-FAIL-08. IC1134.2 +007100 IF XLABEL-TYPE NOT EQUAL TO "S" IC1134.2 +007200 GO TO LINK-FAIL-08. IC1134.2 +007300 LINK-EXIT-08. IC1134.2 +007400 EXIT PROGRAM. IC1134.2 +007500 LINK-FAIL-08. IC1134.2 +007600 ADD 1 TO RECORDS-IN-ERROR. IC1134.2 +007700 MOVE 1 TO ERROR-FLAG. IC1134.2 +007800 GO TO LINK-EXIT-08. IC1134.2 +*END-OF,IC113A +*HEADER,COBOL,IC114A +000100 IDENTIFICATION DIVISION. IC1144.2 +000200 PROGRAM-ID. IC1144.2 +000300 IC114A. IC1144.2 +000400**************************************************************** IC1144.2 +000500* * IC1144.2 +000600* VALIDATION FOR:- * IC1144.2 +000700* * IC1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +000900* * IC1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1144.2 +001100* * IC1144.2 +001200**************************************************************** IC1144.2 +001300* * IC1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1144.2 +001500* * IC1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1144.2 +001900* * IC1144.2 +002000**************************************************************** IC1144.2 +002100* IC1144.2 +002200* THE ROUTINE IC114 IS A MAIN PROGRAM WHICH CALLS THE IC1144.2 +002300* SUBPROGRAM IC115. THE PURPOSE OF THESE PROGRAMS IS TO IC1144.2 +002400* VERIFY THAT A FILE SECTION, A WORKING-STORAGE SECTION, AND IC1144.2 +002500* A LINKAGE SECTION CAN APPEAR IN A SUBPROGRAM, AND A FILE IC1144.2 +002600* CAN BE WRITTEN AND READ WITHIN A SUBPROGRAM. IC1144.2 +002700* IC1144.2 +002800* THE PROGRAM IC114 CALLS IC115 TO CREATE AND VERIFY THE IC1144.2 +002900* FILE. SUBSEQUENT CALLS TO THE SUBPROGRAM ARE MADE TO READ IC1144.2 +003000* THE FILE AND RETURN A RECORD TO THE MAIN PROGRAM WHICH CHECKSIC1144.2 +003100* THE RECORD CONTENTS. IC1144.2 +003200* IC1144.2 +003300* THE SUBPROGRAM IC115 IS ADAPTED FROM THE SEQUENTIAL I-O IC1144.2 +003400* ROUTINE SQ104. IF SQ104 DOES NOT EXECUTE CORRECTLY THEN IC1144.2 +003500* THE RESULTS OF THESE TESTS ARE INCONCLUSIVE. IC1144.2 +003600* IC1144.2 +003700**************************************************************** IC1144.2 +003800 ENVIRONMENT DIVISION. IC1144.2 +003900 CONFIGURATION SECTION. IC1144.2 +004000 SOURCE-COMPUTER. IC1144.2 +004100 XXXXX082. IC1144.2 +004200 OBJECT-COMPUTER. IC1144.2 +004300 XXXXX083. IC1144.2 +004400 INPUT-OUTPUT SECTION. IC1144.2 +004500 FILE-CONTROL. IC1144.2 +004600 SELECT PRINT-FILE ASSIGN TO IC1144.2 +004700 XXXXX055. IC1144.2 +004800 DATA DIVISION. IC1144.2 +004900 FILE SECTION. IC1144.2 +005000 FD PRINT-FILE. IC1144.2 +005100 01 PRINT-REC PICTURE X(120). IC1144.2 +005200 01 DUMMY-RECORD PICTURE X(120). IC1144.2 +005300 WORKING-STORAGE SECTION. IC1144.2 +005400 01 GROUP-LINKAGE-VARIABLES. IC1144.2 +005500 02 COUNT-OF-RECORDS PICTURE 9(6). IC1144.2 +005600 02 RECORDS-IN-ERROR PICTURE 9(6). IC1144.2 +005700 02 ERROR-FLAG PICTURE 9. IC1144.2 +005800 02 EOF-FLAG PICTURE 9. IC1144.2 +005900 02 CALL-FLAG PICTURE 9. IC1144.2 +006000 01 FILE-REC-SQ-FS3. IC1144.2 +006100 02 XFILE-NAME-GROUP. IC1144.2 +006200 03 FILLER PIC X(5). IC1144.2 +006300 03 XFILE-NAME PIC X(6). IC1144.2 +006400 02 XRECORD-NAME-GROUP. IC1144.2 +006500 03 FILLER PIC X(8). IC1144.2 +006600 03 XRECORD-NAME PIC X(6). IC1144.2 +006700 02 REELUNIT-NUMBER-GROUP. IC1144.2 +006800 03 FILLER PIC X(1). IC1144.2 +006900 03 REELUNIT-NUMBER PIC 9(1). IC1144.2 +007000 02 FILLER PIC X(7). IC1144.2 +007100 02 XRECORD-NUMBER PIC 9(6). IC1144.2 +007200 02 FILLER PIC X(79). IC1144.2 +007300 02 XLABEL-TYPE PIC X(1). IC1144.2 +007400 01 TEST-RESULTS. IC1144.2 +007500 02 FILLER PIC X VALUE SPACE. IC1144.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. IC1144.2 +007700 02 FILLER PIC X VALUE SPACE. IC1144.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. IC1144.2 +007900 02 FILLER PIC X VALUE SPACE. IC1144.2 +008000 02 PAR-NAME. IC1144.2 +008100 03 FILLER PIC X(19) VALUE SPACE. IC1144.2 +008200 03 PARDOT-X PIC X VALUE SPACE. IC1144.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. IC1144.2 +008400 02 FILLER PIC X(8) VALUE SPACE. IC1144.2 +008500 02 RE-MARK PIC X(61). IC1144.2 +008600 01 TEST-COMPUTED. IC1144.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC1144.2 +008800 02 FILLER PIC X(17) VALUE IC1144.2 +008900 " COMPUTED=". IC1144.2 +009000 02 COMPUTED-X. IC1144.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1144.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A IC1144.2 +009300 PIC -9(9).9(9). IC1144.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1144.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1144.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1144.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. IC1144.2 +009800 04 COMPUTED-18V0 PIC -9(18). IC1144.2 +009900 04 FILLER PIC X. IC1144.2 +010000 03 FILLER PIC X(50) VALUE SPACE. IC1144.2 +010100 01 TEST-CORRECT. IC1144.2 +010200 02 FILLER PIC X(30) VALUE SPACE. IC1144.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". IC1144.2 +010400 02 CORRECT-X. IC1144.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. IC1144.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1144.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1144.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1144.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1144.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. IC1144.2 +011100 04 CORRECT-18V0 PIC -9(18). IC1144.2 +011200 04 FILLER PIC X. IC1144.2 +011300 03 FILLER PIC X(2) VALUE SPACE. IC1144.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1144.2 +011500 01 CCVS-C-1. IC1144.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1144.2 +011700- "SS PARAGRAPH-NAME IC1144.2 +011800- " REMARKS". IC1144.2 +011900 02 FILLER PIC X(20) VALUE SPACE. IC1144.2 +012000 01 CCVS-C-2. IC1144.2 +012100 02 FILLER PIC X VALUE SPACE. IC1144.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". IC1144.2 +012300 02 FILLER PIC X(15) VALUE SPACE. IC1144.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". IC1144.2 +012500 02 FILLER PIC X(94) VALUE SPACE. IC1144.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1144.2 +012700 01 REC-CT PIC 99 VALUE ZERO. IC1144.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1144.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1144.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1144.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1144.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1144.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1144.2 +013700 01 CCVS-H-1. IC1144.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IC1144.2 +013900 02 FILLER PIC X(42) VALUE IC1144.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1144.2 +014100 02 FILLER PIC X(39) VALUE SPACES. IC1144.2 +014200 01 CCVS-H-2A. IC1144.2 +014300 02 FILLER PIC X(40) VALUE SPACE. IC1144.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1144.2 +014500 02 FILLER PIC XXXX VALUE IC1144.2 +014600 "4.2 ". IC1144.2 +014700 02 FILLER PIC X(28) VALUE IC1144.2 +014800 " COPY - NOT FOR DISTRIBUTION". IC1144.2 +014900 02 FILLER PIC X(41) VALUE SPACE. IC1144.2 +015000 IC1144.2 +015100 01 CCVS-H-2B. IC1144.2 +015200 02 FILLER PIC X(15) VALUE IC1144.2 +015300 "TEST RESULT OF ". IC1144.2 +015400 02 TEST-ID PIC X(9). IC1144.2 +015500 02 FILLER PIC X(4) VALUE IC1144.2 +015600 " IN ". IC1144.2 +015700 02 FILLER PIC X(12) VALUE IC1144.2 +015800 " HIGH ". IC1144.2 +015900 02 FILLER PIC X(22) VALUE IC1144.2 +016000 " LEVEL VALIDATION FOR ". IC1144.2 +016100 02 FILLER PIC X(58) VALUE IC1144.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +016300 01 CCVS-H-3. IC1144.2 +016400 02 FILLER PIC X(34) VALUE IC1144.2 +016500 " FOR OFFICIAL USE ONLY ". IC1144.2 +016600 02 FILLER PIC X(58) VALUE IC1144.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1144.2 +016800 02 FILLER PIC X(28) VALUE IC1144.2 +016900 " COPYRIGHT 1985 ". IC1144.2 +017000 01 CCVS-E-1. IC1144.2 +017100 02 FILLER PIC X(52) VALUE SPACE. IC1144.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1144.2 +017300 02 ID-AGAIN PIC X(9). IC1144.2 +017400 02 FILLER PIC X(45) VALUE SPACES. IC1144.2 +017500 01 CCVS-E-2. IC1144.2 +017600 02 FILLER PIC X(31) VALUE SPACE. IC1144.2 +017700 02 FILLER PIC X(21) VALUE SPACE. IC1144.2 +017800 02 CCVS-E-2-2. IC1144.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1144.2 +018000 03 FILLER PIC X VALUE SPACE. IC1144.2 +018100 03 ENDER-DESC PIC X(44) VALUE IC1144.2 +018200 "ERRORS ENCOUNTERED". IC1144.2 +018300 01 CCVS-E-3. IC1144.2 +018400 02 FILLER PIC X(22) VALUE IC1144.2 +018500 " FOR OFFICIAL USE ONLY". IC1144.2 +018600 02 FILLER PIC X(12) VALUE SPACE. IC1144.2 +018700 02 FILLER PIC X(58) VALUE IC1144.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +018900 02 FILLER PIC X(13) VALUE SPACE. IC1144.2 +019000 02 FILLER PIC X(15) VALUE IC1144.2 +019100 " COPYRIGHT 1985". IC1144.2 +019200 01 CCVS-E-4. IC1144.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1144.2 +019400 02 FILLER PIC X(4) VALUE " OF ". IC1144.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1144.2 +019600 02 FILLER PIC X(40) VALUE IC1144.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". IC1144.2 +019800 01 XXINFO. IC1144.2 +019900 02 FILLER PIC X(19) VALUE IC1144.2 +020000 "*** INFORMATION ***". IC1144.2 +020100 02 INFO-TEXT. IC1144.2 +020200 04 FILLER PIC X(8) VALUE SPACE. IC1144.2 +020300 04 XXCOMPUTED PIC X(20). IC1144.2 +020400 04 FILLER PIC X(5) VALUE SPACE. IC1144.2 +020500 04 XXCORRECT PIC X(20). IC1144.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). IC1144.2 +020700 01 HYPHEN-LINE. IC1144.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. IC1144.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************IC1144.2 +021000- "*****************************************". IC1144.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************IC1144.2 +021200- "******************************". IC1144.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE IC1144.2 +021400 "IC114A". IC1144.2 +021500 PROCEDURE DIVISION. IC1144.2 +021600 CCVS1 SECTION. IC1144.2 +021700 OPEN-FILES. IC1144.2 +021800 OPEN OUTPUT PRINT-FILE. IC1144.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1144.2 +022000 MOVE SPACE TO TEST-RESULTS. IC1144.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1144.2 +022200 GO TO CCVS1-EXIT. IC1144.2 +022300 CLOSE-FILES. IC1144.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1144.2 +022500 TERMINATE-CCVS. IC1144.2 +022600S EXIT PROGRAM. IC1144.2 +022700STERMINATE-CALL. IC1144.2 +022800 STOP RUN. IC1144.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1144.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1144.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1144.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1144.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IC1144.2 +023400 PRINT-DETAIL. IC1144.2 +023500 IF REC-CT NOT EQUAL TO ZERO IC1144.2 +023600 MOVE "." TO PARDOT-X IC1144.2 +023700 MOVE REC-CT TO DOTVALUE. IC1144.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1144.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1144.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1144.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1144.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1144.2 +024300 MOVE SPACE TO CORRECT-X. IC1144.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1144.2 +024500 MOVE SPACE TO RE-MARK. IC1144.2 +024600 HEAD-ROUTINE. IC1144.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1144.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1144.2 +025100 COLUMN-NAMES-ROUTINE. IC1144.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +025500 END-ROUTINE. IC1144.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1144.2 +025700 END-RTN-EXIT. IC1144.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +025900 END-ROUTINE-1. IC1144.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1144.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1144.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IC1144.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1144.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1144.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1144.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1144.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1144.2 +026800 END-ROUTINE-12. IC1144.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1144.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO IC1144.2 +027100 MOVE "NO " TO ERROR-TOTAL IC1144.2 +027200 ELSE IC1144.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1144.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1144.2 +027500 PERFORM WRITE-LINE. IC1144.2 +027600 END-ROUTINE-13. IC1144.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO IC1144.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE IC1144.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1144.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1144.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO IC1144.2 +028300 MOVE "NO " TO ERROR-TOTAL IC1144.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1144.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1144.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028800 WRITE-LINE. IC1144.2 +028900 ADD 1 TO RECORD-COUNT. IC1144.2 +029000Y IF RECORD-COUNT GREATER 50 IC1144.2 +029100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1144.2 +029200Y MOVE SPACE TO DUMMY-RECORD IC1144.2 +029300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1144.2 +029400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1144.2 +029500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1144.2 +029600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1144.2 +029700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1144.2 +029800Y MOVE ZERO TO RECORD-COUNT. IC1144.2 +029900 PERFORM WRT-LN. IC1144.2 +030000 WRT-LN. IC1144.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1144.2 +030200 MOVE SPACE TO DUMMY-RECORD. IC1144.2 +030300 BLANK-LINE-PRINT. IC1144.2 +030400 PERFORM WRT-LN. IC1144.2 +030500 FAIL-ROUTINE. IC1144.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1144.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1144.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1144.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1144.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1144.2 +031200 GO TO FAIL-ROUTINE-EX. IC1144.2 +031300 FAIL-ROUTINE-WRITE. IC1144.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1144.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1144.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1144.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. IC1144.2 +031800 FAIL-ROUTINE-EX. EXIT. IC1144.2 +031900 BAIL-OUT. IC1144.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1144.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1144.2 +032200 BAIL-OUT-WRITE. IC1144.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1144.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1144.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1144.2 +032700 BAIL-OUT-EX. EXIT. IC1144.2 +032800 CCVS1-EXIT. IC1144.2 +032900 EXIT. IC1144.2 +033000 LINK-TEST-10. IC1144.2 +033100 MOVE 1 TO CALL-FLAG. IC1144.2 +033200* IC1144.2 +033300* THIS TEST CALLS IC115 WHICH CREATES THE FILE SQ-FS3. IC1144.2 +033400* THIS FILE IS A MASS STORAGE SEQUENTIAL FILE WITH 120 IC1144.2 +033500* CHARACTER RECORDS. THERE ARE 649 RECORDS IN THE FILE. IC1144.2 +033600* IC1144.2 +033700 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +033800 FILE-REC-SQ-FS3. IC1144.2 +033900 IF COUNT-OF-RECORDS EQUAL TO 649 IC1144.2 +034000 GO TO LINK-PASS-10. IC1144.2 +034100 LINK-FAIL-10. IC1144.2 +034200 PERFORM FAIL. IC1144.2 +034300 MOVE "FILE NOT CREATED IN IC115" TO RE-MARK. IC1144.2 +034400 MOVE "RECS WRITTEN =" TO COMPUTED-A. IC1144.2 +034500 GO TO LINK-WRITE-10. IC1144.2 +034600 LINK-PASS-10. IC1144.2 +034700 PERFORM PASS. IC1144.2 +034800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IC1144.2 +034900 LINK-WRITE-10. IC1144.2 +035000 MOVE "LINK-TEST-10" TO PAR-NAME. IC1144.2 +035100 MOVE "CREATE FILE SQ-FS3" TO FEATURE. IC1144.2 +035200 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +035300 PERFORM PRINT-DETAIL. IC1144.2 +035400 LINK-TEST-11. IC1144.2 +035500 MOVE 2 TO CALL-FLAG. IC1144.2 +035600 MOVE ZERO TO COUNT-OF-RECORDS RECORDS-IN-ERROR IC1144.2 +035700 ERROR-FLAG EOF-FLAG. IC1144.2 +035800 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +035900 FILE-REC-SQ-FS3. IC1144.2 +036000 IF ERROR-FLAG EQUAL TO ZERO IC1144.2 +036100 GO TO LINK-PASS-11. IC1144.2 +036200 IF COUNT-OF-RECORDS GREATER THAN 649 IC1144.2 +036300 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IC1144.2 +036400 GO TO LINK-FAIL-11. IC1144.2 +036500 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. IC1144.2 +036600 LINK-FAIL-11. IC1144.2 +036700 MOVE "RECORDS-IN-ERROR =" TO COMPUTED-A. IC1144.2 +036800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1144.2 +036900 GO TO LINK-WRITE-11. IC1144.2 +037000 LINK-PASS-11. IC1144.2 +037100 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IC1144.2 +037200 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +037300 PERFORM PASS. IC1144.2 +037400 LINK-WRITE-11. IC1144.2 +037500 MOVE "LINK-TEST-11" TO PAR-NAME. IC1144.2 +037600 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. IC1144.2 +037700 PERFORM PRINT-DETAIL. IC1144.2 +037800 LINK-INIT-12. IC1144.2 +037900 MOVE 3 TO CALL-FLAG. IC1144.2 +038000 MOVE ZERO TO COUNT-OF-RECORDS RECORDS-IN-ERROR IC1144.2 +038100 ERROR-FLAG EOF-FLAG. IC1144.2 +038200 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +038300 FILE-REC-SQ-FS3. IC1144.2 +038400* CALL IC115 TO OPEN FILE SQ-FS3. IC1144.2 +038500 MOVE 4 TO CALL-FLAG. IC1144.2 +038600 LINK-TEST-12. IC1144.2 +038700 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +038800 FILE-REC-SQ-FS3. IC1144.2 +038900* IC1144.2 +039000* THIS TEST REPEATEDLY CALLS IC115 TO READ THE FILE SQ-FS3.IC1144.2 +039100* THE CONTENTS OF EACH DATA RECORD IS CHECKED FOR VALID DATA. IC1144.2 +039200* IC1144.2 +039300 IF EOF-FLAG EQUAL TO 1 IC1144.2 +039400 GO TO LINK-TEST-12-01. IC1144.2 +039500 ADD 1 TO COUNT-OF-RECORDS. IC1144.2 +039600 IF COUNT-OF-RECORDS GREATER THAN 649 IC1144.2 +039700 GO TO LINK-FAIL-12-02. IC1144.2 +039800 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER IC1144.2 +039900 GO TO LINK-FAIL-12-01. IC1144.2 +040000 IF REELUNIT-NUMBER-GROUP NOT EQUAL TO "/0" IC1144.2 +040100 GO TO LINK-FAIL-12-01. IC1144.2 +040200 IF XFILE-NAME NOT EQUAL TO "SQ-FS3" IC1144.2 +040300 GO TO LINK-FAIL-12-01. IC1144.2 +040400 IF XRECORD-NAME NOT EQUAL TO "R1-F-G" IC1144.2 +040500 GO TO LINK-FAIL-12-01. IC1144.2 +040600 IF XLABEL-TYPE NOT EQUAL TO "S" IC1144.2 +040700 GO TO LINK-FAIL-12-01. IC1144.2 +040800 GO TO LINK-TEST-12. IC1144.2 +040900 LINK-FAIL-12-01. IC1144.2 +041000 ADD 1 TO RECORDS-IN-ERROR. IC1144.2 +041100 MOVE 1 TO ERROR-FLAG. IC1144.2 +041200 GO TO LINK-TEST-12. IC1144.2 +041300 LINK-FAIL-12-02. IC1144.2 +041400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK. IC1144.2 +041500 GO TO LINK-FAIL-12. IC1144.2 +041600 LINK-TEST-12-01. IC1144.2 +041700 IF COUNT-OF-RECORDS LESS THAN 649 IC1144.2 +041800 GO TO LINK-FAIL-12-04. IC1144.2 +041900 IF ERROR-FLAG EQUAL TO ZERO IC1144.2 +042000 GO TO LINK-PASS-12. IC1144.2 +042100 LINK-FAIL-12-03. IC1144.2 +042200 MOVE "RECORDS-IN-ERROR =" TO COMPUTED-A. IC1144.2 +042300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1144.2 +042400 LINK-FAIL-12. IC1144.2 +042500 PERFORM FAIL. IC1144.2 +042600 GO TO LINK-WRITE-12. IC1144.2 +042700 LINK-FAIL-12-04. IC1144.2 +042800 MOVE "UNEXPECTED EOF" TO RE-MARK. IC1144.2 +042900 MOVE "RECORDS READ =" TO COMPUTED-A. IC1144.2 +043000 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +043100 GO TO LINK-FAIL-12. IC1144.2 +043200 LINK-PASS-12. IC1144.2 +043300 PERFORM PASS. IC1144.2 +043400 LINK-WRITE-12. IC1144.2 +043500 MOVE "LINK-TEST-12" TO PAR-NAME. IC1144.2 +043600 MOVE "READ IN SUBPRGM" TO FEATURE. IC1144.2 +043700 PERFORM PRINT-DETAIL. IC1144.2 +043800 LINK-CLOSE-12. IC1144.2 +043900 MOVE 5 TO CALL-FLAG. IC1144.2 +044000 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +044100 FILE-REC-SQ-FS3. IC1144.2 +044200 TERMINATE-ROUTINE. IC1144.2 +044300 EXIT. IC1144.2 +044400XFILE-DUMP SECTION. IC1144.2 +044500XFILE-DUMP-INIT. IC1144.2 +044600X MOVE 3 TO CALL-FLAG. IC1144.2 +044700X MOVE ZERO TO EOF-FLAG COUNT-OF-RECORDS. IC1144.2 +044800X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +044900X FILE-REC-SQ-FS3. IC1144.2 +045000X MOVE 4 TO CALL-FLAG. IC1144.2 +045100XFILE-3-DUMP. IC1144.2 +045200X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +045300X FILE-REC-SQ-FS3. IC1144.2 +045400X IF EOF-FLAG EQUAL TO 1 IC1144.2 +045500X GO TO FILE-3-DUMP-END. IC1144.2 +045600X ADD 1 TO COUNT-OF-RECORDS. IC1144.2 +045700X IF COUNT-OF-RECORDS EQUAL TO 650 IC1144.2 +045800X PERFORM BLANK-LINE-PRINT 5 TIMES. IC1144.2 +045900X MOVE FILE-REC-SQ-FS3 TO DUMMY-RECORD. IC1144.2 +046000X PERFORM WRITE-LINE. IC1144.2 +046100X IF COUNT-OF-RECORDS LESS THAN 669 IC1144.2 +046200X GO TO FILE-3-DUMP. IC1144.2 +046300XFILE-3-DUMP-END. IC1144.2 +046400X MOVE 5 TO CALL-FLAG. IC1144.2 +046500X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +046600X FILE-REC-SQ-FS3. IC1144.2 +046700XFILE-3-DUMP-EXIT. IC1144.2 +046800X EXIT. IC1144.2 +046900 CCVS-EXIT SECTION. IC1144.2 +047000 CCVS-999999. IC1144.2 +047100 GO TO CLOSE-FILES. IC1144.2 +*END-OF,IC114A +*HEADER,COBOL,IC114A,SUBRTN,IC115A +000100 IDENTIFICATION DIVISION. IC1154.2 +000200 PROGRAM-ID. IC1154.2 +000300 IC115A. IC1154.2 +000400**************************************************************** IC1154.2 +000500* * IC1154.2 +000600* VALIDATION FOR:- * IC1154.2 +000700* * IC1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1154.2 +000900* * IC1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1154.2 +001100* * IC1154.2 +001200**************************************************************** IC1154.2 +001300* * IC1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1154.2 +001500* * IC1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1154.2 +001900* * IC1154.2 +002000**************************************************************** IC1154.2 +002100* IC1154.2 +002200* THE ROUTINE IC115 IS A SUBPROGRAM CALLED BY IC114. IC1154.2 +002300* THIS SUBPROGRAM CONTAINS A FILE SECTION, A WORKING-STORAGE IC1154.2 +002400* SECTION AND A LINKAGE SECTION. THE FILE SQ-FS3 IS CREATED IC1154.2 +002500* AND VERIFIED IN THIS ROUTINE. THE FILE IS OPENED AND READ IC1154.2 +002600* AGAIN. EACH RECORD IS CHECKED BY MOVING IT TO THE LINKAGE IC1154.2 +002700* SECTION AND RETURNING TO THE MAIN PROGRAM TO VERIFY THE IC1154.2 +002800* RECORD CONTENTS. THE PRINTING OF THE OUTPUT REPORT FOR THE IC1154.2 +002900* TEST RESULTS IS PERFORMED BY RETURNING TO THE MAIN PROGRAM IC1154.2 +003000* IC114. IC1154.2 +003100* IC1154.2 +003200* THIS SUBPROGRAM IS ADAPTED FROM THE SEQUENTIAL I-O IC1154.2 +003300* ROUTINE SQ104. IF THAT ROUTINE DOES NOT PERFORM CORRECTLY IC1154.2 +003400* THEN THE RESULTS OF THESE TESTS ARE INCONCLUSIVE. IC1154.2 +003500* IC1154.2 +003600******************************************** IC1154.2 +003700 ENVIRONMENT DIVISION. IC1154.2 +003800 CONFIGURATION SECTION. IC1154.2 +003900 SOURCE-COMPUTER. IC1154.2 +004000 XXXXX082. IC1154.2 +004100 OBJECT-COMPUTER. IC1154.2 +004200 XXXXX083. IC1154.2 +004300 INPUT-OUTPUT SECTION. IC1154.2 +004400 FILE-CONTROL. IC1154.2 +004500 SELECT SQ-FS3 ASSIGN TO IC1154.2 +004600 XXXXX014 IC1154.2 +004700 ORGANIZATION IS SEQUENTIAL IC1154.2 +004800 ACCESS MODE IS SEQUENTIAL. IC1154.2 +004900 DATA DIVISION. IC1154.2 +005000 FILE SECTION. IC1154.2 +005100 FD SQ-FS3 IC1154.2 +005200 BLOCK CONTAINS 120 CHARACTERS IC1154.2 +005300 RECORD CONTAINS 120 CHARACTERS IC1154.2 +005400 LABEL RECORDS ARE STANDARD IC1154.2 +005500C VALUE OF IC1154.2 +005600C XXXXX074 IC1154.2 +005700C IS IC1154.2 +005800C XXXXX075 IC1154.2 +005900G XXXXX069 IC1154.2 +006000 DATA RECORD SQ-FS3R1-F-G-120. IC1154.2 +006100 01 SQ-FS3R1-F-G-120. IC1154.2 +006200 02 FILLER PIC X(120). IC1154.2 +006300 WORKING-STORAGE SECTION. IC1154.2 +006400 01 FILE-RECORD-INFORMATION-REC. IC1154.2 +006500 03 FILE-RECORD-INFO-SKELETON. IC1154.2 +006600 05 FILLER PICTURE X(48) VALUE IC1154.2 +006700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IC1154.2 +006800 05 FILLER PICTURE X(46) VALUE IC1154.2 +006900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IC1154.2 +007000 05 FILLER PICTURE X(26) VALUE IC1154.2 +007100 ",LFIL=000000,ORG= ,LBLR= ". IC1154.2 +007200 05 FILLER PICTURE X(37) VALUE IC1154.2 +007300 ",RECKEY= ". IC1154.2 +007400 05 FILLER PICTURE X(38) VALUE IC1154.2 +007500 ",ALTKEY1= ". IC1154.2 +007600 05 FILLER PICTURE X(38) VALUE IC1154.2 +007700 ",ALTKEY2= ". IC1154.2 +007800 05 FILLER PICTURE X(7) VALUE SPACE.IC1154.2 +007900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IC1154.2 +008000 05 FILE-RECORD-INFO-P1-120. IC1154.2 +008100 07 FILLER PIC X(5). IC1154.2 +008200 07 XFILE-NAME PIC X(6). IC1154.2 +008300 07 FILLER PIC X(8). IC1154.2 +008400 07 XRECORD-NAME PIC X(6). IC1154.2 +008500 07 FILLER PIC X(1). IC1154.2 +008600 07 REELUNIT-NUMBER PIC 9(1). IC1154.2 +008700 07 FILLER PIC X(7). IC1154.2 +008800 07 XRECORD-NUMBER PIC 9(6). IC1154.2 +008900 07 FILLER PIC X(6). IC1154.2 +009000 07 UPDATE-NUMBER PIC 9(2). IC1154.2 +009100 07 FILLER PIC X(5). IC1154.2 +009200 07 ODO-NUMBER PIC 9(4). IC1154.2 +009300 07 FILLER PIC X(5). IC1154.2 +009400 07 XPROGRAM-NAME PIC X(5). IC1154.2 +009500 07 FILLER PIC X(7). IC1154.2 +009600 07 XRECORD-LENGTH PIC 9(6). IC1154.2 +009700 07 FILLER PIC X(7). IC1154.2 +009800 07 CHARS-OR-RECORDS PIC X(2). IC1154.2 +009900 07 FILLER PIC X(1). IC1154.2 +010000 07 XBLOCK-SIZE PIC 9(4). IC1154.2 +010100 07 FILLER PIC X(6). IC1154.2 +010200 07 RECORDS-IN-FILE PIC 9(6). IC1154.2 +010300 07 FILLER PIC X(5). IC1154.2 +010400 07 XFILE-ORGANIZATION PIC X(2). IC1154.2 +010500 07 FILLER PIC X(6). IC1154.2 +010600 07 XLABEL-TYPE PIC X(1). IC1154.2 +010700 05 FILE-RECORD-INFO-P121-240. IC1154.2 +010800 07 FILLER PIC X(8). IC1154.2 +010900 07 XRECORD-KEY PIC X(29). IC1154.2 +011000 07 FILLER PIC X(9). IC1154.2 +011100 07 ALTERNATE-KEY1 PIC X(29). IC1154.2 +011200 07 FILLER PIC X(9). IC1154.2 +011300 07 ALTERNATE-KEY2 PIC X(29). IC1154.2 +011400 07 FILLER PIC X(7). IC1154.2 +011500 01 CCVS-PGM-ID PIC X(6) VALUE IC1154.2 +011600 "IC115A". IC1154.2 +011700 LINKAGE SECTION. IC1154.2 +011800 01 GROUP-LINKAGE-VARIABLES. IC1154.2 +011900 02 COUNT-OF-RECORDS PICTURE 9(6). IC1154.2 +012000 02 RECORDS-IN-ERROR PICTURE 9(6). IC1154.2 +012100 02 ERROR-FLAG PICTURE 9. IC1154.2 +012200 02 EOF-FLAG PICTURE 9. IC1154.2 +012300 02 CALL-FLAG PICTURE 9. IC1154.2 +012400 01 FILE-REC-SQ-FS3. IC1154.2 +012500 02 FILLER PICTURE X(120). IC1154.2 +012600 PROCEDURE DIVISION USING GROUP-LINKAGE-VARIABLES IC1154.2 +012700 FILE-REC-SQ-FS3. IC1154.2 +012800 SECT-IC115-0001 SECTION. IC1154.2 +012900 INIT-PARAGRAPH. IC1154.2 +013000 GO TO SECT-IC115-0002 SECT-IC115-0003 SECT-IC115-0004 IC1154.2 +013100 SECT-IC115-0005 SECT-IC115-0006 IC1154.2 +013200 DEPENDING ON CALL-FLAG. IC1154.2 +013300* THE IDENTIFIER CALL-FLAG CONTROLS THE SUBPROGRAM IC1154.2 +013400* PROCESSING AND IT IS SET BY THE CALLING PROGRAM IC114. IC1154.2 +013500 SECT-IC115-0002 SECTION. IC1154.2 +013600 LINK-INIT-10. IC1154.2 +013700 MOVE FILE-RECORD-INFO-SKELETON TO IC1154.2 +013800 FILE-RECORD-INFO (1). IC1154.2 +013900 MOVE "SQ-FS3" TO XFILE-NAME (1). IC1154.2 +014000 MOVE "R1-F-G" TO XRECORD-NAME (1). IC1154.2 +014100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IC1154.2 +014200 MOVE 120 TO XRECORD-LENGTH (1). IC1154.2 +014300 MOVE "CH" TO CHARS-OR-RECORDS (1). IC1154.2 +014400 MOVE 120 TO XBLOCK-SIZE (1). IC1154.2 +014500 MOVE 000649 TO RECORDS-IN-FILE (1). IC1154.2 +014600 MOVE "SQ" TO XFILE-ORGANIZATION (1). IC1154.2 +014700 MOVE "S" TO XLABEL-TYPE (1). IC1154.2 +014800 MOVE 000001 TO XRECORD-NUMBER (1). IC1154.2 +014900 OPEN OUTPUT SQ-FS3. IC1154.2 +015000 LINK-TEST-10. IC1154.2 +015100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. IC1154.2 +015200 WRITE SQ-FS3R1-F-G-120. IC1154.2 +015300 IF XRECORD-NUMBER (1) EQUAL TO 649 IC1154.2 +015400 GO TO LINK-TEST-10-01. IC1154.2 +015500 ADD 1 TO XRECORD-NUMBER (1). IC1154.2 +015600 GO TO LINK-TEST-10. IC1154.2 +015700 LINK-TEST-10-01. IC1154.2 +015800 CLOSE SQ-FS3. IC1154.2 +015900 MOVE XRECORD-NUMBER (1) TO COUNT-OF-RECORDS. IC1154.2 +016000* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTERS PER IC1154.2 +016100* RECORD HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. IC1154.2 +016200 LINK-EXIT-10. IC1154.2 +016300 EXIT PROGRAM. IC1154.2 +016400 SECT-IC115-0003 SECTION. IC1154.2 +016500 LINK-INIT-11. IC1154.2 +016600* THIS TEST READS AND CHECKS THE FILE CREATED IN IC1154.2 +016700* SECT-IC115-0002. IC1154.2 +016800 OPEN INPUT SQ-FS3. IC1154.2 +016900 LINK-TEST-11. IC1154.2 +017000 READ SQ-FS3 RECORD IC1154.2 +017100 AT END GO TO LINK-CLOSE-11. IC1154.2 +017200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). IC1154.2 +017300 ADD 1 TO COUNT-OF-RECORDS. IC1154.2 +017400 IF COUNT-OF-RECORDS GREATER THAN 649 IC1154.2 +017500 MOVE 1 TO ERROR-FLAG IC1154.2 +017600 GO TO LINK-CLOSE-11. IC1154.2 +017700 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) IC1154.2 +017800 GO TO LINK-FAIL-11. IC1154.2 +017900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" IC1154.2 +018000 GO TO LINK-FAIL-11. IC1154.2 +018100 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IC1154.2 +018200 GO TO LINK-FAIL-11. IC1154.2 +018300 GO TO LINK-TEST-11. IC1154.2 +018400 LINK-FAIL-11. IC1154.2 +018500 ADD 1 TO RECORDS-IN-ERROR. IC1154.2 +018600 MOVE 1 TO ERROR-FLAG. IC1154.2 +018700 LINK-CLOSE-11. IC1154.2 +018800 CLOSE SQ-FS3. IC1154.2 +018900 LINK-EXIT-11. IC1154.2 +019000 EXIT PROGRAM. IC1154.2 +019100 SECT-IC115-0004 SECTION. IC1154.2 +019200 LINK-INIT-12. IC1154.2 +019300 OPEN INPUT SQ-FS3. IC1154.2 +019400 LINK-INIT-12-EXIT. IC1154.2 +019500 EXIT PROGRAM. IC1154.2 +019600 SECT-IC115-0005 SECTION. IC1154.2 +019700 LINK-TEST-12. IC1154.2 +019800 READ SQ-FS3 RECORD IC1154.2 +019900 AT END MOVE 1 TO EOF-FLAG. IC1154.2 +020000 MOVE SQ-FS3R1-F-G-120 TO FILE-REC-SQ-FS3. IC1154.2 +020100* IC1154.2 +020200* THE MAIN PROGRAM IC114 REPEATLY CALLS THE SUBPROGRAM IC1154.2 +020300* IC115 TO READ THE FILE SQ-FS3. THE DATA RECORD IS MOVED IC1154.2 +020400* TO A LINKAGE RECORD FOR CHECKING OF THE CONTENTS BY THE IC1154.2 +020500* MAIN PROGRAM. IC1154.2 +020600* IC1154.2 +020700 LINK-EXIT-12. IC1154.2 +020800 EXIT PROGRAM. IC1154.2 +020900 SECT-IC115-0006 SECTION. IC1154.2 +021000 LINK-CLOSE-12. IC1154.2 +021100 CLOSE SQ-FS3. IC1154.2 +021200 LINK-CLOSE-EXIT-12. IC1154.2 +021300 EXIT PROGRAM. IC1154.2 +*END-OF,IC115A +*HEADER,COBOL,IC116M +000100 IDENTIFICATION DIVISION. IC1164.2 +000200 PROGRAM-ID. IC1164.2 +000300 IC116M. IC1164.2 +000400**************************************************************** IC1164.2 +000500* * IC1164.2 +000600* VALIDATION FOR:- * IC1164.2 +000700* * IC1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +000900* * IC1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1164.2 +001100* * IC1164.2 +001200**************************************************************** IC1164.2 +001300* * IC1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1164.2 +001500* * IC1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1164.2 +001900* * IC1164.2 +002000**************************************************************** IC1164.2 +002100* IC1164.2 +002200* THE PROGRAM IC116 AND THE SUBPROGRAMS IC117 AND IC118 IC1164.2 +002300* TEST THE CALL STATEMENT WITHOUT THE OPTIONAL USING PHRASE IC1164.2 +002400* AND THE PROCEDURE DIVISION HEADER WITHOUT THE OPTIONAL IC1164.2 +002500* USING PHRASE IN THE SUBPROGRAMS. THE MAIN PROGRAM IC116 IC1164.2 +002600* CALLS THE SUBPROGRAM IC117 WHICH IN TURN CALLS THE SUBPRO- IC1164.2 +002700* GRAM IC118. THE SUBPROGRAMS CONTAIN DISPLAY STATEMENTS WHICHIC1164.2 +002800* SHOW THE EXECUTION SEQUENCE FOR THE PROGRAMS. IC1164.2 +002900* IC1164.2 +003000* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE IC1164.2 +003100* COBOL, X3.23-1974 IC1164.2 +003200* SECTION XII, INTER-PROGRAM COMMUNICATION MODULE. IC1164.2 +003300* IC1164.2 +003400******************************************************************IC1164.2 +003500 ENVIRONMENT DIVISION. IC1164.2 +003600 CONFIGURATION SECTION. IC1164.2 +003700 SOURCE-COMPUTER. IC1164.2 +003800 XXXXX082. IC1164.2 +003900 OBJECT-COMPUTER. IC1164.2 +004000 XXXXX083. IC1164.2 +004100 INPUT-OUTPUT SECTION. IC1164.2 +004200 FILE-CONTROL. IC1164.2 +004300 SELECT PRINT-FILE ASSIGN TO IC1164.2 +004400 XXXXX055. IC1164.2 +004500 DATA DIVISION. IC1164.2 +004600 FILE SECTION. IC1164.2 +004700 FD PRINT-FILE. IC1164.2 +004800 01 PRINT-REC PICTURE X(120). IC1164.2 +004900 01 DUMMY-RECORD PICTURE X(120). IC1164.2 +005000 WORKING-STORAGE SECTION. IC1164.2 +005100 01 SUMMARY-MESSAGE-1. IC1164.2 +005200 02 FILLER PICTURE X(10) VALUE SPACE. IC1164.2 +005300 02 FILLER PICTURE X(46) IC1164.2 +005400 VALUE "THERE SHOULD BE THREE DISPLAY MESSAGES ON THE ". IC1164.2 +005500 02 FILLER PICTURE X(23) IC1164.2 +005600 VALUE "DEFAULT DISPLAY DEVICE.". IC1164.2 +005700 01 SUMMARY-MESSAGE-2. IC1164.2 +005800 02 FILLER PICTURE X(10) VALUE SPACE. IC1164.2 +005900 02 FILLER PICTURE X(44) IC1164.2 +006000 VALUE "IF THERE ARE NOT THREE DISPLAY MESSAGES THE ". IC1164.2 +006100 02 FILLER PICTURE X(33) IC1164.2 +006200 VALUE "OPTIONAL USING PHRASE TESTS FAIL.". IC1164.2 +006300 01 TEST-RESULTS. IC1164.2 +006400 02 FILLER PIC X VALUE SPACE. IC1164.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. IC1164.2 +006600 02 FILLER PIC X VALUE SPACE. IC1164.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. IC1164.2 +006800 02 FILLER PIC X VALUE SPACE. IC1164.2 +006900 02 PAR-NAME. IC1164.2 +007000 03 FILLER PIC X(19) VALUE SPACE. IC1164.2 +007100 03 PARDOT-X PIC X VALUE SPACE. IC1164.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. IC1164.2 +007300 02 FILLER PIC X(8) VALUE SPACE. IC1164.2 +007400 02 RE-MARK PIC X(61). IC1164.2 +007500 01 TEST-COMPUTED. IC1164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC1164.2 +007700 02 FILLER PIC X(17) VALUE IC1164.2 +007800 " COMPUTED=". IC1164.2 +007900 02 COMPUTED-X. IC1164.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1164.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A IC1164.2 +008200 PIC -9(9).9(9). IC1164.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1164.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1164.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1164.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. IC1164.2 +008700 04 COMPUTED-18V0 PIC -9(18). IC1164.2 +008800 04 FILLER PIC X. IC1164.2 +008900 03 FILLER PIC X(50) VALUE SPACE. IC1164.2 +009000 01 TEST-CORRECT. IC1164.2 +009100 02 FILLER PIC X(30) VALUE SPACE. IC1164.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". IC1164.2 +009300 02 CORRECT-X. IC1164.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. IC1164.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1164.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1164.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1164.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1164.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. IC1164.2 +010000 04 CORRECT-18V0 PIC -9(18). IC1164.2 +010100 04 FILLER PIC X. IC1164.2 +010200 03 FILLER PIC X(2) VALUE SPACE. IC1164.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1164.2 +010400 01 CCVS-C-1. IC1164.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1164.2 +010600- "SS PARAGRAPH-NAME IC1164.2 +010700- " REMARKS". IC1164.2 +010800 02 FILLER PIC X(20) VALUE SPACE. IC1164.2 +010900 01 CCVS-C-2. IC1164.2 +011000 02 FILLER PIC X VALUE SPACE. IC1164.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". IC1164.2 +011200 02 FILLER PIC X(15) VALUE SPACE. IC1164.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". IC1164.2 +011400 02 FILLER PIC X(94) VALUE SPACE. IC1164.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1164.2 +011600 01 REC-CT PIC 99 VALUE ZERO. IC1164.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1164.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1164.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1164.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1164.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1164.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1164.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1164.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1164.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1164.2 +012600 01 CCVS-H-1. IC1164.2 +012700 02 FILLER PIC X(39) VALUE SPACES. IC1164.2 +012800 02 FILLER PIC X(42) VALUE IC1164.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1164.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC1164.2 +013100 01 CCVS-H-2A. IC1164.2 +013200 02 FILLER PIC X(40) VALUE SPACE. IC1164.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1164.2 +013400 02 FILLER PIC XXXX VALUE IC1164.2 +013500 "4.2 ". IC1164.2 +013600 02 FILLER PIC X(28) VALUE IC1164.2 +013700 " COPY - NOT FOR DISTRIBUTION". IC1164.2 +013800 02 FILLER PIC X(41) VALUE SPACE. IC1164.2 +013900 IC1164.2 +014000 01 CCVS-H-2B. IC1164.2 +014100 02 FILLER PIC X(15) VALUE IC1164.2 +014200 "TEST RESULT OF ". IC1164.2 +014300 02 TEST-ID PIC X(9). IC1164.2 +014400 02 FILLER PIC X(4) VALUE IC1164.2 +014500 " IN ". IC1164.2 +014600 02 FILLER PIC X(12) VALUE IC1164.2 +014700 " HIGH ". IC1164.2 +014800 02 FILLER PIC X(22) VALUE IC1164.2 +014900 " LEVEL VALIDATION FOR ". IC1164.2 +015000 02 FILLER PIC X(58) VALUE IC1164.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +015200 01 CCVS-H-3. IC1164.2 +015300 02 FILLER PIC X(34) VALUE IC1164.2 +015400 " FOR OFFICIAL USE ONLY ". IC1164.2 +015500 02 FILLER PIC X(58) VALUE IC1164.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1164.2 +015700 02 FILLER PIC X(28) VALUE IC1164.2 +015800 " COPYRIGHT 1985 ". IC1164.2 +015900 01 CCVS-E-1. IC1164.2 +016000 02 FILLER PIC X(52) VALUE SPACE. IC1164.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1164.2 +016200 02 ID-AGAIN PIC X(9). IC1164.2 +016300 02 FILLER PIC X(45) VALUE SPACES. IC1164.2 +016400 01 CCVS-E-2. IC1164.2 +016500 02 FILLER PIC X(31) VALUE SPACE. IC1164.2 +016600 02 FILLER PIC X(21) VALUE SPACE. IC1164.2 +016700 02 CCVS-E-2-2. IC1164.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1164.2 +016900 03 FILLER PIC X VALUE SPACE. IC1164.2 +017000 03 ENDER-DESC PIC X(44) VALUE IC1164.2 +017100 "ERRORS ENCOUNTERED". IC1164.2 +017200 01 CCVS-E-3. IC1164.2 +017300 02 FILLER PIC X(22) VALUE IC1164.2 +017400 " FOR OFFICIAL USE ONLY". IC1164.2 +017500 02 FILLER PIC X(12) VALUE SPACE. IC1164.2 +017600 02 FILLER PIC X(58) VALUE IC1164.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +017800 02 FILLER PIC X(13) VALUE SPACE. IC1164.2 +017900 02 FILLER PIC X(15) VALUE IC1164.2 +018000 " COPYRIGHT 1985". IC1164.2 +018100 01 CCVS-E-4. IC1164.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1164.2 +018300 02 FILLER PIC X(4) VALUE " OF ". IC1164.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1164.2 +018500 02 FILLER PIC X(40) VALUE IC1164.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". IC1164.2 +018700 01 XXINFO. IC1164.2 +018800 02 FILLER PIC X(19) VALUE IC1164.2 +018900 "*** INFORMATION ***". IC1164.2 +019000 02 INFO-TEXT. IC1164.2 +019100 04 FILLER PIC X(8) VALUE SPACE. IC1164.2 +019200 04 XXCOMPUTED PIC X(20). IC1164.2 +019300 04 FILLER PIC X(5) VALUE SPACE. IC1164.2 +019400 04 XXCORRECT PIC X(20). IC1164.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). IC1164.2 +019600 01 HYPHEN-LINE. IC1164.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. IC1164.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************IC1164.2 +019900- "*****************************************". IC1164.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************IC1164.2 +020100- "******************************". IC1164.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE IC1164.2 +020300 "IC116M". IC1164.2 +020400 PROCEDURE DIVISION. IC1164.2 +020500 CCVS1 SECTION. IC1164.2 +020600 OPEN-FILES. IC1164.2 +020700 OPEN OUTPUT PRINT-FILE. IC1164.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1164.2 +020900 MOVE SPACE TO TEST-RESULTS. IC1164.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1164.2 +021100 GO TO CCVS1-EXIT. IC1164.2 +021200 CLOSE-FILES. IC1164.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1164.2 +021400 TERMINATE-CCVS. IC1164.2 +021500S EXIT PROGRAM. IC1164.2 +021600STERMINATE-CALL. IC1164.2 +021700 STOP RUN. IC1164.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1164.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1164.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1164.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1164.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IC1164.2 +022300 PRINT-DETAIL. IC1164.2 +022400 IF REC-CT NOT EQUAL TO ZERO IC1164.2 +022500 MOVE "." TO PARDOT-X IC1164.2 +022600 MOVE REC-CT TO DOTVALUE. IC1164.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1164.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1164.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1164.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1164.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1164.2 +023200 MOVE SPACE TO CORRECT-X. IC1164.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1164.2 +023400 MOVE SPACE TO RE-MARK. IC1164.2 +023500 HEAD-ROUTINE. IC1164.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1164.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1164.2 +024000 COLUMN-NAMES-ROUTINE. IC1164.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +024400 END-ROUTINE. IC1164.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1164.2 +024600 END-RTN-EXIT. IC1164.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +024800 END-ROUTINE-1. IC1164.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1164.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1164.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. IC1164.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1164.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1164.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1164.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1164.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1164.2 +025700 END-ROUTINE-12. IC1164.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1164.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IC1164.2 +026000 MOVE "NO " TO ERROR-TOTAL IC1164.2 +026100 ELSE IC1164.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1164.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1164.2 +026400 PERFORM WRITE-LINE. IC1164.2 +026500 END-ROUTINE-13. IC1164.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IC1164.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IC1164.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1164.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1164.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IC1164.2 +027200 MOVE "NO " TO ERROR-TOTAL IC1164.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1164.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1164.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027700 WRITE-LINE. IC1164.2 +027800 ADD 1 TO RECORD-COUNT. IC1164.2 +027900Y IF RECORD-COUNT GREATER 50 IC1164.2 +028000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC1164.2 +028100Y MOVE SPACE TO DUMMY-RECORD IC1164.2 +028200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1164.2 +028300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1164.2 +028400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1164.2 +028500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1164.2 +028600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC1164.2 +028700Y MOVE ZERO TO RECORD-COUNT. IC1164.2 +028800 PERFORM WRT-LN. IC1164.2 +028900 WRT-LN. IC1164.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1164.2 +029100 MOVE SPACE TO DUMMY-RECORD. IC1164.2 +029200 BLANK-LINE-PRINT. IC1164.2 +029300 PERFORM WRT-LN. IC1164.2 +029400 FAIL-ROUTINE. IC1164.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1164.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1164.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1164.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1164.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC1164.2 +030100 GO TO FAIL-ROUTINE-EX. IC1164.2 +030200 FAIL-ROUTINE-WRITE. IC1164.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1164.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1164.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1164.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. IC1164.2 +030700 FAIL-ROUTINE-EX. EXIT. IC1164.2 +030800 BAIL-OUT. IC1164.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1164.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1164.2 +031100 BAIL-OUT-WRITE. IC1164.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1164.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1164.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IC1164.2 +031600 BAIL-OUT-EX. EXIT. IC1164.2 +031700 CCVS1-EXIT. IC1164.2 +031800 EXIT. IC1164.2 +031900 SECT-IC116-0001 SECTION. IC1164.2 +032000 USNG-TEST-01. IC1164.2 +032100 CALL "IC117M". IC1164.2 +032200* IC1164.2 +032300* THIS TEST CONTAINS A CALL STATEMENT WITHOUT THE OPTIONAL IC1164.2 +032400* USING PHRASE. IC1164.2 +032500* IC1164.2 +032600 USNG-WRITE-01. IC1164.2 +032700 PERFORM BLANK-LINE-PRINT. IC1164.2 +032800 MOVE "CALL WITHOUT USING" TO FEATURE. IC1164.2 +032900 MOVE "USNG-TEST-01" TO PAR-NAME. IC1164.2 +033000 PERFORM PASS. IC1164.2 +033100 PERFORM PRINT-DETAIL. IC1164.2 +033200 SUMMARY-REMARKS. IC1164.2 +033300 PERFORM BLANK-LINE-PRINT. IC1164.2 +033400 MOVE SUMMARY-MESSAGE-1 TO DUMMY-RECORD. IC1164.2 +033500 PERFORM WRITE-LINE. IC1164.2 +033600 MOVE SUMMARY-MESSAGE-2 TO DUMMY-RECORD. IC1164.2 +033700 PERFORM WRITE-LINE. IC1164.2 +033800 PERFORM BLANK-LINE-PRINT. IC1164.2 +033900 IC116-EXIT. IC1164.2 +034000 EXIT. IC1164.2 +034100 CCVS-EXIT SECTION. IC1164.2 +034200 CCVS-999999. IC1164.2 +034300 GO TO CLOSE-FILES. IC1164.2 +*END-OF,IC116M +*HEADER,COBOL,IC116M,SUBRTN,IC117M +000100 IDENTIFICATION DIVISION. IC1174.2 +000200 PROGRAM-ID. IC1174.2 +000300 IC117M. IC1174.2 +000400**************************************************************** IC1174.2 +000500* * IC1174.2 +000600* VALIDATION FOR:- * IC1174.2 +000700* * IC1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1174.2 +000900* * IC1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1174.2 +001100* * IC1174.2 +001200**************************************************************** IC1174.2 +001300* * IC1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1174.2 +001500* * IC1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1174.2 +001900* * IC1174.2 +002000**************************************************************** IC1174.2 +002100* IC1174.2 +002200* THE SUBPROGRAM IC117 IS CALLED BY THE MAIN PROGRAM IC116.IC1174.2 +002300* THE SUBPROGRAM IC117 DOES NOT CONTAIN A LINKAGE SECTION OR IC1174.2 +002400* AN USING PHRASE IN THE PROCEDURE DIVISION HEADER. DISPLAY IC1174.2 +002500* STATEMENTS ARE USED TO VERIFY THE PROGRAM EXECUTION SEQUENCE.IC1174.2 +002600* THE SUBPROGRAM IC118 IS CALLED BY THE SUBPROGRAM IC117 AND IC1174.2 +002700* THE CALL STATEMENT IN THE SUBPROGRAM ALSO DOES NOT HAVE AN IC1174.2 +002800* USING PHRASE. IC1174.2 +002900* IC1174.2 +003000* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE IC1174.2 +003100* COBOL, X3.23-1974 IC1174.2 +003200* SECTION XII, INTER-PROGRAM COMMUNICATION MODULE. IC1174.2 +003300* IC1174.2 +003400******************************************************************IC1174.2 +003500 ENVIRONMENT DIVISION. IC1174.2 +003600 CONFIGURATION SECTION. IC1174.2 +003700 SOURCE-COMPUTER. IC1174.2 +003800 XXXXX082. IC1174.2 +003900 OBJECT-COMPUTER. IC1174.2 +004000 XXXXX083. IC1174.2 +004100 DATA DIVISION. IC1174.2 +004200 WORKING-STORAGE SECTION. IC1174.2 +004300 01 IC117-TEMP1 PICTURE 9. IC1174.2 +004400 01 ONE PICTURE 9 VALUE 1. IC1174.2 +004500 01 IC117-TEMP2 PICTURE 9 VALUE 0. IC1174.2 +004600 PROCEDURE DIVISION. IC1174.2 +004700*USNG-TEST-02. IC1174.2 +004800* IC1174.2 +004900* THIS TEST VERIFIES THAT A SUBPROGRAM PROCEDURE DIVISION IC1174.2 +005000* HEADER IS NOT REQUIRED TO HAVE THE OPTIONAL USING PHRASE. IC1174.2 +005100* IC1174.2 +005200 USNG-VERIFY-02. IC1174.2 +005300 MOVE 1 TO IC117-TEMP1. IC1174.2 +005400 ADD ONE TO IC117-TEMP2. IC1174.2 +005500* IC1174.2 +005600* THE RESULTS OF THE ABOVE STATEMENTS ARE NOT TESTED. IC1174.2 +005700* IC1174.2 +005800 USNG-DISPLAY-02. IC1174.2 +005900 DISPLAY " ". IC1174.2 +006000 DISPLAY "IC117M CALLED". IC1174.2 +006100 USNG-TEST-03. IC1174.2 +006200 CALL "IC118M". IC1174.2 +006300* IC1174.2 +006400* THIS TEST CONTAINS A CALL STATEMENT WITHOUT THE OPTIONAL IC1174.2 +006500* USING PHRASE. IC1174.2 +006600* REFERENCE - X3.23-1995, PAGE X-27, 5.2, THE CALL STATEMENT. IC1174.2 +006700* IC1174.2 +006800 USNG-DISPLAY-03. IC1174.2 +006900 DISPLAY "RETURNED TO IC117M". IC1174.2 +007000 IC117-EXIT. IC1174.2 +007100 EXIT PROGRAM. IC1174.2 +*END-OF,IC117M +*HEADER,COBOL,IC116M,SUBRTN,IC118M +000100 IDENTIFICATION DIVISION. IC1184.2 +000200 PROGRAM-ID. IC1184.2 +000300 IC118M. IC1184.2 +000400**************************************************************** IC1184.2 +000500* * IC1184.2 +000600* VALIDATION FOR:- * IC1184.2 +000700* * IC1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1184.2 +000900* * IC1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1184.2 +001100* * IC1184.2 +001200**************************************************************** IC1184.2 +001300* * IC1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1184.2 +001500* * IC1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1184.2 +001900* * IC1184.2 +002000**************************************************************** IC1184.2 +002100* IC1184.2 +002200* THE SUBPROGRAM IC118 IS CALLED BY THE SUBPROGRAM IC117. IC1184.2 +002300* THE SUBPROGRAM IC118 DOES NOT CONTAIN A LINKAGE SECTION OR IC1184.2 +002400* AN USING PHRASE IN THE PROCEDURE DIVISION HEADER. A DISPLAY IC1184.2 +002500* STATEMENT IS EXECUTED TO VERIFY THAT THIS SUBPROGRAM WAS IC1184.2 +002600* EXECUTED. IC1184.2 +002700* IC1184.2 +002800******************************************************************IC1184.2 +002900 ENVIRONMENT DIVISION. IC1184.2 +003000 CONFIGURATION SECTION. IC1184.2 +003100 SOURCE-COMPUTER. IC1184.2 +003200 XXXXX082. IC1184.2 +003300 OBJECT-COMPUTER. IC1184.2 +003400 XXXXX083. IC1184.2 +003500 DATA DIVISION. IC1184.2 +003600 WORKING-STORAGE SECTION. IC1184.2 +003700 01 IC118-TEMP1 PICTURE 9. IC1184.2 +003800 01 TWO PICTURE 9 VALUE 2. IC1184.2 +003900 01 IC118-TEMP2 PICTURE 99 VALUE 97. IC1184.2 +004000 PROCEDURE DIVISION. IC1184.2 +004100*USNG-TEST-04. IC1184.2 +004200* IC1184.2 +004300* THIS TEST VERIFIES THAT A SUBPROGRAM PROCEDURE DIVISION IC1184.2 +004400* HEADER IS NOT REQUIRED TO HAVE THE OPTIONAL USING PHRASE. IC1184.2 +004500* IC1184.2 +004600 USNG-VERIFY-04. IC1184.2 +004700 MOVE 2 TO IC118-TEMP1. IC1184.2 +004800 ADD TWO TO IC118-TEMP2. IC1184.2 +004900* IC1184.2 +005000* THE RESULTS OF THE ABOVE STATEMENTS ARE NOT TESTED. IC1184.2 +005100* IC1184.2 +005200 USNG-DISPLAY-04. IC1184.2 +005300 DISPLAY "IC118M CALLED". IC1184.2 +005400 IC118-EXIT. IC1184.2 +005500 EXIT PROGRAM. IC1184.2 +*END-OF,IC118M +*HEADER,COBOL,IC201A +000100 IDENTIFICATION DIVISION. IC2014.2 +000200 PROGRAM-ID. IC2014.2 +000300 IC201A. IC2014.2 +000400**************************************************************** IC2014.2 +000500* * IC2014.2 +000600* VALIDATION FOR:- * IC2014.2 +000700* * IC2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +000900* * IC2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2014.2 +001100* * IC2014.2 +001200**************************************************************** IC2014.2 +001300* * IC2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2014.2 +001500* * IC2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2014.2 +001900* * IC2014.2 +002000**************************************************************** IC2014.2 +002100* THE PROGRAM IC201 TESTS THE CALL STATEMENT WITH AN IC2014.2 +002200* IDENTIFIER AS AN OPERAND, AND FOUR OPERANDS IN THE IC2014.2 +002300* USING PHRASE. THE REPETITION OF A DATA-NAME IN THE IC2014.2 +002400* USING PHRASE IS TESTED, AND THE USE OF THE ON OVERFLOW IC2014.2 +002500* PHRASE IN A CALL STATEMENT IS SYNTACTICALLY CHECKED IC2014.2 +002600* IN THE PROGRAM. IC2014.2 +002700**************************************************************** IC2014.2 +002800 ENVIRONMENT DIVISION. IC2014.2 +002900 CONFIGURATION SECTION. IC2014.2 +003000 SOURCE-COMPUTER. IC2014.2 +003100 XXXXX082. IC2014.2 +003200 OBJECT-COMPUTER. IC2014.2 +003300 XXXXX083. IC2014.2 +003400 INPUT-OUTPUT SECTION. IC2014.2 +003500 FILE-CONTROL. IC2014.2 +003600 SELECT PRINT-FILE ASSIGN TO IC2014.2 +003700 XXXXX055. IC2014.2 +003800 DATA DIVISION. IC2014.2 +003900 FILE SECTION. IC2014.2 +004000 FD PRINT-FILE. IC2014.2 +004100 01 PRINT-REC PICTURE X(120). IC2014.2 +004200 01 DUMMY-RECORD PICTURE X(120). IC2014.2 +004300 WORKING-STORAGE SECTION. IC2014.2 +004400 77 DN1 PICTURE S99 VALUE ZERO. IC2014.2 +004500 77 DN3 PICTURE S99. IC2014.2 +004600 77 ID1 PICTURE X(6) VALUE "IC202A". IC2014.2 +004700 77 ID2 PICTURE X(6). IC2014.2 +004800 77 DN2 PICTURE S99 IC2014.2 +004900 USAGE COMPUTATIONAL, VALUE ZERO. IC2014.2 +005000 77 DN4 PICTURE S99 IC2014.2 +005100 USAGE IS COMPUTATIONAL. IC2014.2 +005200 77 CALL-COUNT PIC S99. IC2014.2 +005300 77 FAIL-FLAG PIC 9. IC2014.2 +005400 01 TEST-RESULTS. IC2014.2 +005500 02 FILLER PIC X VALUE SPACE. IC2014.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IC2014.2 +005700 02 FILLER PIC X VALUE SPACE. IC2014.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IC2014.2 +005900 02 FILLER PIC X VALUE SPACE. IC2014.2 +006000 02 PAR-NAME. IC2014.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IC2014.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IC2014.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IC2014.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IC2014.2 +006500 02 RE-MARK PIC X(61). IC2014.2 +006600 01 TEST-COMPUTED. IC2014.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IC2014.2 +006800 02 FILLER PIC X(17) VALUE IC2014.2 +006900 " COMPUTED=". IC2014.2 +007000 02 COMPUTED-X. IC2014.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2014.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IC2014.2 +007300 PIC -9(9).9(9). IC2014.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2014.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2014.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2014.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IC2014.2 +007800 04 COMPUTED-18V0 PIC -9(18). IC2014.2 +007900 04 FILLER PIC X. IC2014.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IC2014.2 +008100 01 TEST-CORRECT. IC2014.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC2014.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2014.2 +008400 02 CORRECT-X. IC2014.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2014.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2014.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2014.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2014.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2014.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IC2014.2 +009100 04 CORRECT-18V0 PIC -9(18). IC2014.2 +009200 04 FILLER PIC X. IC2014.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IC2014.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2014.2 +009500 01 CCVS-C-1. IC2014.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2014.2 +009700- "SS PARAGRAPH-NAME IC2014.2 +009800- " REMARKS". IC2014.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IC2014.2 +010000 01 CCVS-C-2. IC2014.2 +010100 02 FILLER PIC X VALUE SPACE. IC2014.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IC2014.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IC2014.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IC2014.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IC2014.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2014.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IC2014.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2014.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2014.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2014.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2014.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2014.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2014.2 +011700 01 CCVS-H-1. IC2014.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IC2014.2 +011900 02 FILLER PIC X(42) VALUE IC2014.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2014.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IC2014.2 +012200 01 CCVS-H-2A. IC2014.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IC2014.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2014.2 +012500 02 FILLER PIC XXXX VALUE IC2014.2 +012600 "4.2 ". IC2014.2 +012700 02 FILLER PIC X(28) VALUE IC2014.2 +012800 " COPY - NOT FOR DISTRIBUTION". IC2014.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IC2014.2 +013000 IC2014.2 +013100 01 CCVS-H-2B. IC2014.2 +013200 02 FILLER PIC X(15) VALUE IC2014.2 +013300 "TEST RESULT OF ". IC2014.2 +013400 02 TEST-ID PIC X(9). IC2014.2 +013500 02 FILLER PIC X(4) VALUE IC2014.2 +013600 " IN ". IC2014.2 +013700 02 FILLER PIC X(12) VALUE IC2014.2 +013800 " HIGH ". IC2014.2 +013900 02 FILLER PIC X(22) VALUE IC2014.2 +014000 " LEVEL VALIDATION FOR ". IC2014.2 +014100 02 FILLER PIC X(58) VALUE IC2014.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +014300 01 CCVS-H-3. IC2014.2 +014400 02 FILLER PIC X(34) VALUE IC2014.2 +014500 " FOR OFFICIAL USE ONLY ". IC2014.2 +014600 02 FILLER PIC X(58) VALUE IC2014.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2014.2 +014800 02 FILLER PIC X(28) VALUE IC2014.2 +014900 " COPYRIGHT 1985 ". IC2014.2 +015000 01 CCVS-E-1. IC2014.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IC2014.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2014.2 +015300 02 ID-AGAIN PIC X(9). IC2014.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IC2014.2 +015500 01 CCVS-E-2. IC2014.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IC2014.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IC2014.2 +015800 02 CCVS-E-2-2. IC2014.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2014.2 +016000 03 FILLER PIC X VALUE SPACE. IC2014.2 +016100 03 ENDER-DESC PIC X(44) VALUE IC2014.2 +016200 "ERRORS ENCOUNTERED". IC2014.2 +016300 01 CCVS-E-3. IC2014.2 +016400 02 FILLER PIC X(22) VALUE IC2014.2 +016500 " FOR OFFICIAL USE ONLY". IC2014.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IC2014.2 +016700 02 FILLER PIC X(58) VALUE IC2014.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IC2014.2 +017000 02 FILLER PIC X(15) VALUE IC2014.2 +017100 " COPYRIGHT 1985". IC2014.2 +017200 01 CCVS-E-4. IC2014.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2014.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IC2014.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2014.2 +017600 02 FILLER PIC X(40) VALUE IC2014.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2014.2 +017800 01 XXINFO. IC2014.2 +017900 02 FILLER PIC X(19) VALUE IC2014.2 +018000 "*** INFORMATION ***". IC2014.2 +018100 02 INFO-TEXT. IC2014.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IC2014.2 +018300 04 XXCOMPUTED PIC X(20). IC2014.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IC2014.2 +018500 04 XXCORRECT PIC X(20). IC2014.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IC2014.2 +018700 01 HYPHEN-LINE. IC2014.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IC2014.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IC2014.2 +019000- "*****************************************". IC2014.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IC2014.2 +019200- "******************************". IC2014.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IC2014.2 +019400 "IC201A". IC2014.2 +019500 PROCEDURE DIVISION. IC2014.2 +019600 CCVS1 SECTION. IC2014.2 +019700 OPEN-FILES. IC2014.2 +019800 OPEN OUTPUT PRINT-FILE. IC2014.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2014.2 +020000 MOVE SPACE TO TEST-RESULTS. IC2014.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2014.2 +020200 GO TO CCVS1-EXIT. IC2014.2 +020300 CLOSE-FILES. IC2014.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2014.2 +020500 TERMINATE-CCVS. IC2014.2 +020600S EXIT PROGRAM. IC2014.2 +020700STERMINATE-CALL. IC2014.2 +020800 STOP RUN. IC2014.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2014.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2014.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2014.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2014.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. IC2014.2 +021400 PRINT-DETAIL. IC2014.2 +021500 IF REC-CT NOT EQUAL TO ZERO IC2014.2 +021600 MOVE "." TO PARDOT-X IC2014.2 +021700 MOVE REC-CT TO DOTVALUE. IC2014.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2014.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2014.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2014.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2014.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2014.2 +022300 MOVE SPACE TO CORRECT-X. IC2014.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2014.2 +022500 MOVE SPACE TO RE-MARK. IC2014.2 +022600 HEAD-ROUTINE. IC2014.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2014.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2014.2 +023100 COLUMN-NAMES-ROUTINE. IC2014.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +023500 END-ROUTINE. IC2014.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2014.2 +023700 END-RTN-EXIT. IC2014.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +023900 END-ROUTINE-1. IC2014.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2014.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2014.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. IC2014.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2014.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2014.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2014.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2014.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2014.2 +024800 END-ROUTINE-12. IC2014.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2014.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2014.2 +025100 MOVE "NO " TO ERROR-TOTAL IC2014.2 +025200 ELSE IC2014.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2014.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2014.2 +025500 PERFORM WRITE-LINE. IC2014.2 +025600 END-ROUTINE-13. IC2014.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2014.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE IC2014.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2014.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2014.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO IC2014.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2014.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2014.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2014.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026800 WRITE-LINE. IC2014.2 +026900 ADD 1 TO RECORD-COUNT. IC2014.2 +027000Y IF RECORD-COUNT GREATER 50 IC2014.2 +027100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2014.2 +027200Y MOVE SPACE TO DUMMY-RECORD IC2014.2 +027300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2014.2 +027400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2014.2 +027500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2014.2 +027600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2014.2 +027700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2014.2 +027800Y MOVE ZERO TO RECORD-COUNT. IC2014.2 +027900 PERFORM WRT-LN. IC2014.2 +028000 WRT-LN. IC2014.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2014.2 +028200 MOVE SPACE TO DUMMY-RECORD. IC2014.2 +028300 BLANK-LINE-PRINT. IC2014.2 +028400 PERFORM WRT-LN. IC2014.2 +028500 FAIL-ROUTINE. IC2014.2 +028600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2014.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2014.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2014.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2014.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2014.2 +029200 GO TO FAIL-ROUTINE-EX. IC2014.2 +029300 FAIL-ROUTINE-WRITE. IC2014.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2014.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2014.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2014.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2014.2 +029800 FAIL-ROUTINE-EX. EXIT. IC2014.2 +029900 BAIL-OUT. IC2014.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2014.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2014.2 +030200 BAIL-OUT-WRITE. IC2014.2 +030300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2014.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2014.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2014.2 +030700 BAIL-OUT-EX. EXIT. IC2014.2 +030800 CCVS1-EXIT. IC2014.2 +030900 EXIT. IC2014.2 +031000 SECT-IC201-0001 SECTION. IC2014.2 +031100 CALL-TEST-01. IC2014.2 +031200 MOVE "CALL-TEST-01" TO PAR-NAME. IC2014.2 +031300 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2014.2 +031400 MOVE 0 TO CALL-COUNT. IC2014.2 +031500* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2014.2 +031600* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2014.2 +031700* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2014.2 +031800* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2014.2 +031900* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2014.2 +032000 CALL-TEST-01-01. IC2014.2 +032100 MOVE 1 TO REC-CT. IC2014.2 +032200 MOVE ZERO TO DN3, DN4. IC2014.2 +032300 CALL "IC202A" USING DN1, DN2, DN3, DN4. IC2014.2 +032400 PERFORM CHECK-TEST-01. IC2014.2 +032500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +032600 PERFORM PASS IC2014.2 +032700 GO TO CALL-WRITE-01-01. IC2014.2 +032800 CALL-FAIL-01-01. IC2014.2 +032900 PERFORM FAIL. IC2014.2 +033000 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +033100 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +033200 CALL-WRITE-01-01. IC2014.2 +033300 PERFORM PRINT-DETAIL. IC2014.2 +033400 CALL-TEST-01-02. IC2014.2 +033500 ADD 1 TO REC-CT. IC2014.2 +033600 MOVE ZERO TO DN3, DN4. IC2014.2 +033700 CALL ID1 USING DN1, DN2, DN3, DN4. IC2014.2 +033800 PERFORM CHECK-TEST-01. IC2014.2 +033900 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +034000 PERFORM PASS IC2014.2 +034100 GO TO CALL-WRITE-01-02. IC2014.2 +034200 CALL-FAIL-01-02. IC2014.2 +034300 PERFORM FAIL. IC2014.2 +034400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +034500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +034600 CALL-WRITE-01-02. IC2014.2 +034700 PERFORM PRINT-DETAIL. IC2014.2 +034800 CALL-TEST-01-03. IC2014.2 +034900 ADD 1 TO REC-CT. IC2014.2 +035000 MOVE ID1 TO ID2. IC2014.2 +035100 MOVE ZERO TO DN3, DN4. IC2014.2 +035200 CALL ID2 USING DN1 DN2 DN3 DN4. IC2014.2 +035300 PERFORM CHECK-TEST-01. IC2014.2 +035400 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +035500 PERFORM PASS IC2014.2 +035600 GO TO CALL-WRITE-01-03. IC2014.2 +035700 CALL-FAIL-01-03. IC2014.2 +035800 PERFORM FAIL. IC2014.2 +035900 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +036000 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +036100 CALL-WRITE-01-03. IC2014.2 +036200 PERFORM PRINT-DETAIL. IC2014.2 +036300 CALL-TEST-01-04. IC2014.2 +036400 ADD 1 TO REC-CT. IC2014.2 +036500 MOVE "IC202A" TO ID2. IC2014.2 +036600 MOVE ZERO TO DN3, DN4. IC2014.2 +036700 CALL ID2 USING DN1, DN2, DN3, DN4. IC2014.2 +036800 PERFORM CHECK-TEST-01. IC2014.2 +036900 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +037000 PERFORM PASS IC2014.2 +037100 GO TO CALL-WRITE-01-04. IC2014.2 +037200 CALL-FAIL-01-04. IC2014.2 +037300 PERFORM FAIL. IC2014.2 +037400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +037500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +037600 CALL-WRITE-01-04. IC2014.2 +037700 PERFORM PRINT-DETAIL. IC2014.2 +037800 CALL-TEST-02. IC2014.2 +037900 MOVE "CALL-TEST-02" TO PAR-NAME. IC2014.2 +038000 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2014.2 +038100* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2014.2 +038200* A USING PHRASE OF A CALL STATEMENT. IC2014.2 +038300 CALL-TEST-02-01. IC2014.2 +038400 MOVE 1 TO REC-CT. IC2014.2 +038500 MOVE 1 TO DN1. IC2014.2 +038600 MOVE 0 TO DN2, DN3, DN4. IC2014.2 +038700 CALL "IC202A" USING DN1, DN2, DN1, DN4. IC2014.2 +038800 IF DN1 NOT EQUAL TO 2 IC2014.2 +038900 GO TO CALL-FAIL-02-01-1. IC2014.2 +039000 IF DN2 NOT EQUAL TO 0 IC2014.2 +039100 GO TO CALL-FAIL-02-01-2. IC2014.2 +039200 IF DN3 NOT EQUAL TO 0 IC2014.2 +039300 GO TO CALL-FAIL-02-01-3. IC2014.2 +039400 IF DN4 NOT EQUAL TO 5 IC2014.2 +039500 GO TO CALL-FAIL-02-01-4. IC2014.2 +039600 GO TO CALL-PASS-02-01. IC2014.2 +039700 CALL-DELETE-02-01. IC2014.2 +039800 PERFORM DE-LETE. IC2014.2 +039900 GO TO CALL-WRITE-02-01. IC2014.2 +040000 CALL-PASS-02-01. IC2014.2 +040100 PERFORM PASS. IC2014.2 +040200 GO TO CALL-WRITE-02-01. IC2014.2 +040300 CALL-FAIL-02-01-1. IC2014.2 +040400 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +040500 MOVE 2 TO CORRECT-18V0. IC2014.2 +040600 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +040700 GO TO CALL-FAIL-02-01. IC2014.2 +040800 CALL-FAIL-02-01-2. IC2014.2 +040900 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +041000 MOVE 0 TO CORRECT-18V0. IC2014.2 +041100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +041200 GO TO CALL-FAIL-02-01. IC2014.2 +041300 CALL-FAIL-02-01-3. IC2014.2 +041400 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +041500 MOVE ZERO TO CORRECT-18V0. IC2014.2 +041600 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +041700 GO TO CALL-FAIL-02-01. IC2014.2 +041800 CALL-FAIL-02-01-4. IC2014.2 +041900 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +042000 MOVE 5 TO CORRECT-18V0. IC2014.2 +042100 MOVE "ERROR IN DN4 VALUE RETURNED" TO RE-MARK. IC2014.2 +042200 CALL-FAIL-02-01. IC2014.2 +042300 PERFORM FAIL. IC2014.2 +042400 CALL-WRITE-02-01. IC2014.2 +042500 PERFORM PRINT-DETAIL. IC2014.2 +042600 CALL-TEST-02-02. IC2014.2 +042700 ADD 1 TO REC-CT. IC2014.2 +042800 MOVE 0 TO DN4, DN3, DN2, DN1. IC2014.2 +042900 CALL ID1 USING DN1 DN2 DN3 DN2. IC2014.2 +043000 IF DN1 NOT EQUAL TO 0 IC2014.2 +043100 GO TO CALL-FAIL-02-02-1. IC2014.2 +043200 IF DN2 NOT EQUAL TO 6 IC2014.2 +043300 GO TO CALL-FAIL-02-02-2. IC2014.2 +043400 IF DN3 NOT EQUAL TO 1 IC2014.2 +043500 GO TO CALL-FAIL-02-02-3. IC2014.2 +043600 IF DN4 NOT EQUAL TO 0 IC2014.2 +043700 GO TO CALL-FAIL-02-02-4. IC2014.2 +043800 GO TO CALL-PASS-02-02. IC2014.2 +043900 CALL-DELETE-02-02. IC2014.2 +044000 PERFORM DE-LETE. IC2014.2 +044100 GO TO CALL-WRITE-02-02. IC2014.2 +044200 CALL-PASS-02-02. IC2014.2 +044300 PERFORM PASS. IC2014.2 +044400 GO TO CALL-WRITE-02-02. IC2014.2 +044500 CALL-FAIL-02-02-1. IC2014.2 +044600 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +044700 MOVE ZERO TO CORRECT-18V0. IC2014.2 +044800 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +044900 GO TO CALL-FAIL-02-02. IC2014.2 +045000 CALL-FAIL-02-02-2. IC2014.2 +045100 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +045200 MOVE 6 TO CORRECT-18V0. IC2014.2 +045300 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +045400 GO TO CALL-FAIL-02-02. IC2014.2 +045500 CALL-FAIL-02-02-3. IC2014.2 +045600 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +045700 MOVE 1 TO CORRECT-18V0. IC2014.2 +045800 MOVE "ERROR IN DN3 VALUE RETURNED" TO RE-MARK. IC2014.2 +045900 GO TO CALL-FAIL-02-02. IC2014.2 +046000 CALL-FAIL-02-02-4. IC2014.2 +046100 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +046200 MOVE 0 TO CORRECT-18V0. IC2014.2 +046300 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +046400 CALL-FAIL-02-02. IC2014.2 +046500 PERFORM FAIL. IC2014.2 +046600 CALL-WRITE-02-02. IC2014.2 +046700 PERFORM PRINT-DETAIL. IC2014.2 +046800 CALL-TEST-02-03. IC2014.2 +046900 ADD 1 TO REC-CT. IC2014.2 +047000 MOVE 0 TO DN4, DN3. IC2014.2 +047100 MOVE 10 TO DN2. IC2014.2 +047200 MOVE 25 TO DN1. IC2014.2 +047300 CALL ID1 USING DN1 DN2 DN1 DN2. IC2014.2 +047400 IF DN1 EQUAL TO 26 IC2014.2 +047500 GO TO CHECK-02-03-2. IC2014.2 +047600 GO TO CALL-FAIL-02-03-1. IC2014.2 +047700 CALL-DELETE-02-03. IC2014.2 +047800 PERFORM DE-LETE. IC2014.2 +047900 GO TO CALL-WRITE-02-03. IC2014.2 +048000 CALL-FAIL-02-03-1. IC2014.2 +048100 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +048200 MOVE 26 TO CORRECT-18V0. IC2014.2 +048300 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +048400 GO TO CALL-FAIL-02-03. IC2014.2 +048500 CHECK-02-03-2. IC2014.2 +048600 IF DN2 EQUAL TO 7 IC2014.2 +048700 GO TO CHECK-02-03-3. IC2014.2 +048800 CALL-FAIL-02-03-2. IC2014.2 +048900 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +049000 MOVE 7 TO CORRECT-18V0. IC2014.2 +049100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +049200 GO TO CALL-FAIL-02-03. IC2014.2 +049300 CHECK-02-03-3. IC2014.2 +049400 IF DN3 EQUAL TO 0 IC2014.2 +049500 GO TO CHECK-02-03-4. IC2014.2 +049600 CALL-FAIL-02-03-3. IC2014.2 +049700 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +049800 MOVE 0 TO CORRECT-18V0. IC2014.2 +049900 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +050000 GO TO CALL-FAIL-02-03. IC2014.2 +050100 CHECK-02-03-4. IC2014.2 +050200 IF DN4 EQUAL TO 0 IC2014.2 +050300 GO TO CALL-PASS-02-03. IC2014.2 +050400 CALL-FAIL-02-03-4. IC2014.2 +050500 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +050600 MOVE 0 TO CORRECT-18V0. IC2014.2 +050700 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +050800 CALL-FAIL-02-03. IC2014.2 +050900 PERFORM FAIL. IC2014.2 +051000 GO TO CALL-WRITE-02-03. IC2014.2 +051100 CALL-PASS-02-03. IC2014.2 +051200 PERFORM PASS. IC2014.2 +051300 CALL-WRITE-02-03. IC2014.2 +051400 PERFORM PRINT-DETAIL. IC2014.2 +051500 CALL-TEST-03. IC2014.2 +051600* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2014.2 +051700* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2014.2 +051800* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2014.2 +051900 MOVE "CALL-TEST-03" TO PAR-NAME. IC2014.2 +052000 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2014.2 +052100 CALL-TEST-03-01. IC2014.2 +052200 MOVE 7 TO CALL-COUNT. IC2014.2 +052300 MOVE 20 TO DN1. IC2014.2 +052400 MOVE 30 TO DN2. IC2014.2 +052500 MOVE ZERO TO DN3, DN4. IC2014.2 +052600 CALL "IC202A" USING DN1, DN2, DN3, DN4; IC2014.2 +052700 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +052800 GO TO CALL-FAIL-03-01. IC2014.2 +052900 PERFORM CHECK-TEST-03. IC2014.2 +053000 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +053100 PERFORM PASS IC2014.2 +053200 GO TO CALL-WRITE-03-01. IC2014.2 +053300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +053400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +053500 CALL-FAIL-03-01. IC2014.2 +053600 PERFORM FAIL. IC2014.2 +053700 CALL-WRITE-03-01. IC2014.2 +053800 PERFORM PRINT-DETAIL. IC2014.2 +053900 CALL-TEST-03-02. IC2014.2 +054000 MOVE ZERO TO DN3, DN4. IC2014.2 +054100 CALL "IC202A" USING DN1, DN2, DN3, DN4; IC2014.2 +054200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +054300 GO TO CALL-FAIL-03-02. IC2014.2 +054400 PERFORM CHECK-TEST-03. IC2014.2 +054500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +054600 PERFORM PASS IC2014.2 +054700 GO TO CALL-WRITE-03-02. IC2014.2 +054800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +054900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +055000 CALL-FAIL-03-02. IC2014.2 +055100 PERFORM FAIL. IC2014.2 +055200 CALL-WRITE-03-02. IC2014.2 +055300 PERFORM PRINT-DETAIL. IC2014.2 +055400 CALL-TEST-03-03. IC2014.2 +055500 MOVE ZERO TO DN3, DN4. IC2014.2 +055600 CALL ID1 USING DN1 DN2 DN3 DN4 IC2014.2 +055700 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +055800 GO TO CALL-FAIL-03-03. IC2014.2 +055900 PERFORM CHECK-TEST-03. IC2014.2 +056000 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +056100 PERFORM PASS IC2014.2 +056200 GO TO CALL-WRITE-03-03. IC2014.2 +056300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +056400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +056500 CALL-FAIL-03-03. IC2014.2 +056600 PERFORM FAIL. IC2014.2 +056700 CALL-WRITE-03-03. IC2014.2 +056800 PERFORM PRINT-DETAIL. IC2014.2 +056900 CALL-TEST-03-04. IC2014.2 +057000 MOVE ZERO TO DN3, DN4. IC2014.2 +057100 CALL ID1 USING DN1 DN2 DN3 DN4; IC2014.2 +057200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2014.2 +057300 GO TO CALL-FAIL-03-04. IC2014.2 +057400 PERFORM CHECK-TEST-03. IC2014.2 +057500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +057600 PERFORM PASS IC2014.2 +057700 GO TO CALL-WRITE-03-04. IC2014.2 +057800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +057900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +058000 CALL-FAIL-03-04. IC2014.2 +058100 PERFORM FAIL. IC2014.2 +058200 CALL-WRITE-03-04. IC2014.2 +058300 PERFORM PRINT-DETAIL. IC2014.2 +058400 GO TO EXIT-IC201. IC2014.2 +058500 CALL-DELETE-03. IC2014.2 +058600* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2014.2 +058700* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2014.2 +058800* CALL-TEST-03-01. IC2014.2 +058900 PERFORM DE-LETE. IC2014.2 +059000 PERFORM PRINT-DETAIL. IC2014.2 +059100 EXIT-IC201. IC2014.2 +059200 GO TO CCVS-EXIT. IC2014.2 +059300 SECT-IC201-0002 SECTION. IC2014.2 +059400 CHECK-TEST-01. IC2014.2 +059500 MOVE ZERO TO FAIL-FLAG. IC2014.2 +059600 ADD 1 TO CALL-COUNT. IC2014.2 +059700 IF DN1 EQUAL TO ZERO IC2014.2 +059800 NEXT SENTENCE IC2014.2 +059900 ELSE ADD 1 TO FAIL-FLAG. IC2014.2 +060000 IF DN2 NOT EQUAL TO ZERO IC2014.2 +060100 ADD 1 TO FAIL-FLAG. IC2014.2 +060200 IF DN3 NOT EQUAL TO 1 IC2014.2 +060300 ADD 1 TO FAIL-FLAG. IC2014.2 +060400 IF DN4 NOT EQUAL TO CALL-COUNT IC2014.2 +060500 ADD 1 TO FAIL-FLAG. IC2014.2 +060600 CHECK-TEST-03. IC2014.2 +060700 MOVE ZERO TO FAIL-FLAG. IC2014.2 +060800 ADD 1 TO CALL-COUNT. IC2014.2 +060900 IF DN4 NOT EQUAL TO CALL-COUNT IC2014.2 +061000 ADD 1 TO FAIL-FLAG. IC2014.2 +061100 IF DN3 NOT EQUAL TO 21 IC2014.2 +061200 ADD 1 TO FAIL-FLAG. IC2014.2 +061300 IF DN2 NOT EQUAL TO 30 IC2014.2 +061400 ADD 1 TO FAIL-FLAG. IC2014.2 +061500 IF DN1 NOT EQUAL TO 20 IC2014.2 +061600 ADD 1 TO FAIL-FLAG. IC2014.2 +061700 CCVS-EXIT SECTION. IC2014.2 +061800 CCVS-999999. IC2014.2 +061900 GO TO CLOSE-FILES. IC2014.2 +*END-OF,IC201A +*HEADER,COBOL,IC201A,SUBRTN,IC202A +000100 IDENTIFICATION DIVISION. IC2024.2 +000200 PROGRAM-ID. IC2024.2 +000300 IC202A. IC2024.2 +000400**************************************************************** IC2024.2 +000500* * IC2024.2 +000600* VALIDATION FOR:- * IC2024.2 +000700* * IC2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2024.2 +000900* * IC2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2024.2 +001100* * IC2024.2 +001200**************************************************************** IC2024.2 +001300* * IC2024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2024.2 +001500* * IC2024.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2024.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2024.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2024.2 +001900* * IC2024.2 +002000**************************************************************** IC2024.2 +002100* THE SUBPROGRAM IC202 IS CALLED BY THE PROGRAM IC201. * IC2024.2 +002200* THE SUBPROGRAM HAS FOUR OPERANDS IN THE USING PHRASE * IC2024.2 +002300* OF THE PROCEDURE DIVISION HEADER. * IC2024.2 +002400**************************************************************** IC2024.2 +002500 ENVIRONMENT DIVISION. IC2024.2 +002600 CONFIGURATION SECTION. IC2024.2 +002700 SOURCE-COMPUTER. IC2024.2 +002800 XXXXX082. IC2024.2 +002900 OBJECT-COMPUTER. IC2024.2 +003000 XXXXX083. IC2024.2 +003100 INPUT-OUTPUT SECTION. IC2024.2 +003200 FILE-CONTROL. IC2024.2 +003300 SELECT PRINT-FILE ASSIGN TO IC2024.2 +003400 XXXXX055. IC2024.2 +003500 DATA DIVISION. IC2024.2 +003600 FILE SECTION. IC2024.2 +003700 FD PRINT-FILE. IC2024.2 +003800 01 PRINT-REC PICTURE X(120). IC2024.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC2024.2 +004000 WORKING-STORAGE SECTION. IC2024.2 +004100 77 WS1 PICTURE S999. IC2024.2 +004200 77 WS2 PICTURE S999 IC2024.2 +004300 USAGE COMPUTATIONAL, VALUE ZERO. IC2024.2 +004400 LINKAGE SECTION. IC2024.2 +004500 77 DN1 PICTURE S99. IC2024.2 +004600 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2024.2 +004700 77 DN3 PICTURE S99. IC2024.2 +004800 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2024.2 +004900 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2024.2 +005000 SECT-IC202-0001 SECTION. IC2024.2 +005100 CALL-TEST-001. IC2024.2 +005200 MOVE DN1 TO WS1. IC2024.2 +005300 ADD 1 TO WS1. IC2024.2 +005400 ADD 1 TO WS2. IC2024.2 +005500 MOVE WS1 TO DN3. IC2024.2 +005600 MOVE WS2 TO DN4. IC2024.2 +005700 CALL-EXIT-001. IC2024.2 +005800 EXIT PROGRAM. IC2024.2 +*END-OF,IC202A +*HEADER,COBOL,IC203A +000100 IDENTIFICATION DIVISION. IC2034.2 +000200 PROGRAM-ID. IC2034.2 +000300 IC203A. IC2034.2 +000400**************************************************************** IC2034.2 +000500* * IC2034.2 +000600* VALIDATION FOR:- * IC2034.2 +000700* * IC2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +000900* * IC2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2034.2 +001100* * IC2034.2 +001200**************************************************************** IC2034.2 +001300* * IC2034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2034.2 +001500* * IC2034.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2034.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2034.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2034.2 +001900* * IC2034.2 +002000**************************************************************** IC2034.2 +002100* THE PROGRAM IC203 TESTS THE USE OF THE CANCEL * IC2034.2 +002200* STATEMENT. THIS PROGRAM VERIFIES THAT THE INITIAL * IC2034.2 +002300* CALL TO A SUBPROGRAM AND THE FIRST CALL AFTER A CANCEL * IC2034.2 +002400* RESULTS IN A SUBPROGRAM BEING INITIATED IN ITS INITIAL * IC2034.2 +002500* STATE. THE PROGRAM ALSO CANCELS A PROGRAM WHICH HAS * IC2034.2 +002600* NOT BEEN CALLED, IN WHICH CASE CONTROL SHOULD PASS * IC2034.2 +002700* TO THE NEXT SENTENCE. * IC2034.2 +002800**************************************************************** IC2034.2 +002900 ENVIRONMENT DIVISION. IC2034.2 +003000 CONFIGURATION SECTION. IC2034.2 +003100 SOURCE-COMPUTER. IC2034.2 +003200 XXXXX082. IC2034.2 +003300 OBJECT-COMPUTER. IC2034.2 +003400 XXXXX083. IC2034.2 +003500 INPUT-OUTPUT SECTION. IC2034.2 +003600 FILE-CONTROL. IC2034.2 +003700 SELECT PRINT-FILE ASSIGN TO IC2034.2 +003800 XXXXX055. IC2034.2 +003900 DATA DIVISION. IC2034.2 +004000 FILE SECTION. IC2034.2 +004100 FD PRINT-FILE. IC2034.2 +004200 01 PRINT-REC PICTURE X(120). IC2034.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC2034.2 +004400 WORKING-STORAGE SECTION. IC2034.2 +004500 77 ID1 PICTURE X(6) VALUE "IC204A". IC2034.2 +004600 77 ID2 PICTURE X(6) VALUE "IC206A". IC2034.2 +004700 77 DN1 PICTURE S999. IC2034.2 +004800 77 DN5 PICTURE S999. IC2034.2 +004900 01 TABLE-1. IC2034.2 +005000 02 DN2 PICTURE XXX. IC2034.2 +005100 02 DN3 PICTURE 99. IC2034.2 +005200 02 DN4 PICTURE X(5). IC2034.2 +005300 01 TABLE-2. IC2034.2 +005400 02 DN6 PICTURE X IC2034.2 +005500 OCCURS 2 TIMES. IC2034.2 +005600 01 TEST-RESULTS. IC2034.2 +005700 02 FILLER PIC X VALUE SPACE. IC2034.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC2034.2 +005900 02 FILLER PIC X VALUE SPACE. IC2034.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC2034.2 +006100 02 FILLER PIC X VALUE SPACE. IC2034.2 +006200 02 PAR-NAME. IC2034.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC2034.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC2034.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC2034.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC2034.2 +006700 02 RE-MARK PIC X(61). IC2034.2 +006800 01 TEST-COMPUTED. IC2034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC2034.2 +007000 02 FILLER PIC X(17) VALUE IC2034.2 +007100 " COMPUTED=". IC2034.2 +007200 02 COMPUTED-X. IC2034.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2034.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC2034.2 +007500 PIC -9(9).9(9). IC2034.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2034.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2034.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2034.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC2034.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC2034.2 +008100 04 FILLER PIC X. IC2034.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC2034.2 +008300 01 TEST-CORRECT. IC2034.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC2034.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2034.2 +008600 02 CORRECT-X. IC2034.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2034.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2034.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2034.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2034.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2034.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC2034.2 +009300 04 CORRECT-18V0 PIC -9(18). IC2034.2 +009400 04 FILLER PIC X. IC2034.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC2034.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2034.2 +009700 01 CCVS-C-1. IC2034.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2034.2 +009900- "SS PARAGRAPH-NAME IC2034.2 +010000- " REMARKS". IC2034.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC2034.2 +010200 01 CCVS-C-2. IC2034.2 +010300 02 FILLER PIC X VALUE SPACE. IC2034.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC2034.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC2034.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC2034.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC2034.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2034.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC2034.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2034.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2034.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2034.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2034.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2034.2 +011900 01 CCVS-H-1. IC2034.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC2034.2 +012100 02 FILLER PIC X(42) VALUE IC2034.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2034.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC2034.2 +012400 01 CCVS-H-2A. IC2034.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC2034.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2034.2 +012700 02 FILLER PIC XXXX VALUE IC2034.2 +012800 "4.2 ". IC2034.2 +012900 02 FILLER PIC X(28) VALUE IC2034.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC2034.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC2034.2 +013200 IC2034.2 +013300 01 CCVS-H-2B. IC2034.2 +013400 02 FILLER PIC X(15) VALUE IC2034.2 +013500 "TEST RESULT OF ". IC2034.2 +013600 02 TEST-ID PIC X(9). IC2034.2 +013700 02 FILLER PIC X(4) VALUE IC2034.2 +013800 " IN ". IC2034.2 +013900 02 FILLER PIC X(12) VALUE IC2034.2 +014000 " HIGH ". IC2034.2 +014100 02 FILLER PIC X(22) VALUE IC2034.2 +014200 " LEVEL VALIDATION FOR ". IC2034.2 +014300 02 FILLER PIC X(58) VALUE IC2034.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +014500 01 CCVS-H-3. IC2034.2 +014600 02 FILLER PIC X(34) VALUE IC2034.2 +014700 " FOR OFFICIAL USE ONLY ". IC2034.2 +014800 02 FILLER PIC X(58) VALUE IC2034.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2034.2 +015000 02 FILLER PIC X(28) VALUE IC2034.2 +015100 " COPYRIGHT 1985 ". IC2034.2 +015200 01 CCVS-E-1. IC2034.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC2034.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2034.2 +015500 02 ID-AGAIN PIC X(9). IC2034.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC2034.2 +015700 01 CCVS-E-2. IC2034.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC2034.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC2034.2 +016000 02 CCVS-E-2-2. IC2034.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2034.2 +016200 03 FILLER PIC X VALUE SPACE. IC2034.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC2034.2 +016400 "ERRORS ENCOUNTERED". IC2034.2 +016500 01 CCVS-E-3. IC2034.2 +016600 02 FILLER PIC X(22) VALUE IC2034.2 +016700 " FOR OFFICIAL USE ONLY". IC2034.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC2034.2 +016900 02 FILLER PIC X(58) VALUE IC2034.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC2034.2 +017200 02 FILLER PIC X(15) VALUE IC2034.2 +017300 " COPYRIGHT 1985". IC2034.2 +017400 01 CCVS-E-4. IC2034.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2034.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC2034.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2034.2 +017800 02 FILLER PIC X(40) VALUE IC2034.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2034.2 +018000 01 XXINFO. IC2034.2 +018100 02 FILLER PIC X(19) VALUE IC2034.2 +018200 "*** INFORMATION ***". IC2034.2 +018300 02 INFO-TEXT. IC2034.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC2034.2 +018500 04 XXCOMPUTED PIC X(20). IC2034.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC2034.2 +018700 04 XXCORRECT PIC X(20). IC2034.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC2034.2 +018900 01 HYPHEN-LINE. IC2034.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC2034.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC2034.2 +019200- "*****************************************". IC2034.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC2034.2 +019400- "******************************". IC2034.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC2034.2 +019600 "IC203A". IC2034.2 +019700 PROCEDURE DIVISION. IC2034.2 +019800 CCVS1 SECTION. IC2034.2 +019900 OPEN-FILES. IC2034.2 +020000 OPEN OUTPUT PRINT-FILE. IC2034.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2034.2 +020200 MOVE SPACE TO TEST-RESULTS. IC2034.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2034.2 +020400 GO TO CCVS1-EXIT. IC2034.2 +020500 CLOSE-FILES. IC2034.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2034.2 +020700 TERMINATE-CCVS. IC2034.2 +020800S EXIT PROGRAM. IC2034.2 +020900STERMINATE-CALL. IC2034.2 +021000 STOP RUN. IC2034.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2034.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2034.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2034.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2034.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC2034.2 +021600 PRINT-DETAIL. IC2034.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC2034.2 +021800 MOVE "." TO PARDOT-X IC2034.2 +021900 MOVE REC-CT TO DOTVALUE. IC2034.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2034.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2034.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2034.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2034.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2034.2 +022500 MOVE SPACE TO CORRECT-X. IC2034.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2034.2 +022700 MOVE SPACE TO RE-MARK. IC2034.2 +022800 HEAD-ROUTINE. IC2034.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2034.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2034.2 +023300 COLUMN-NAMES-ROUTINE. IC2034.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +023700 END-ROUTINE. IC2034.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2034.2 +023900 END-RTN-EXIT. IC2034.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +024100 END-ROUTINE-1. IC2034.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2034.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2034.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC2034.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2034.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2034.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2034.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2034.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2034.2 +025000 END-ROUTINE-12. IC2034.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2034.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2034.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2034.2 +025400 ELSE IC2034.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2034.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2034.2 +025700 PERFORM WRITE-LINE. IC2034.2 +025800 END-ROUTINE-13. IC2034.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2034.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC2034.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2034.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC2034.2 +026500 MOVE "NO " TO ERROR-TOTAL IC2034.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2034.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2034.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +027000 WRITE-LINE. IC2034.2 +027100 ADD 1 TO RECORD-COUNT. IC2034.2 +027200Y IF RECORD-COUNT GREATER 50 IC2034.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2034.2 +027400Y MOVE SPACE TO DUMMY-RECORD IC2034.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2034.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2034.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2034.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2034.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2034.2 +028000Y MOVE ZERO TO RECORD-COUNT. IC2034.2 +028100 PERFORM WRT-LN. IC2034.2 +028200 WRT-LN. IC2034.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2034.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC2034.2 +028500 BLANK-LINE-PRINT. IC2034.2 +028600 PERFORM WRT-LN. IC2034.2 +028700 FAIL-ROUTINE. IC2034.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2034.2 +029400 GO TO FAIL-ROUTINE-EX. IC2034.2 +029500 FAIL-ROUTINE-WRITE. IC2034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2034.2 +030000 FAIL-ROUTINE-EX. EXIT. IC2034.2 +030100 BAIL-OUT. IC2034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2034.2 +030400 BAIL-OUT-WRITE. IC2034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2034.2 +030900 BAIL-OUT-EX. EXIT. IC2034.2 +031000 CCVS1-EXIT. IC2034.2 +031100 EXIT. IC2034.2 +031200 SECT-IC203-0001 SECTION. IC2034.2 +031300 CALL-TEST-04. IC2034.2 +031400* CALL-TEST-04 VERIFIES THAT A PROGRAM IS IN ITS IC2034.2 +031500* INITIAL STATE THE FIRST TIME IT IS CALLED. IC2034.2 +031600 MOVE "CALL-TEST-04" TO PAR-NAME. IC2034.2 +031700 MOVE "INITIAL STATE" TO FEATURE. IC2034.2 +031800 MOVE 1 TO DN3. IC2034.2 +031900 MOVE SPACE TO DN2, DN4. IC2034.2 +032000 MOVE ZERO TO DN1. IC2034.2 +032100 CALL ID1 USING TABLE-1, DN1. IC2034.2 +032200 GO TO CALL-TEST-04-01. IC2034.2 +032300 CALL-DELETE-04. IC2034.2 +032400 PERFORM DE-LETE. IC2034.2 +032500 PERFORM PRINT-DETAIL. IC2034.2 +032600 GO TO CALL-TEST-05. IC2034.2 +032700 CALL-TEST-04-01. IC2034.2 +032800 MOVE 1 TO REC-CT. IC2034.2 +032900 IF DN1 IS EQUAL TO 1 IC2034.2 +033000 PERFORM PASS IC2034.2 +033100 GO TO CALL-WRITE-04-01. IC2034.2 +033200 CALL-FAIL-04-01. IC2034.2 +033300 PERFORM FAIL. IC2034.2 +033400 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +033500 MOVE 1 TO CORRECT-18V0. IC2034.2 +033600 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +033700 CALL-WRITE-04-01. IC2034.2 +033800 PERFORM PRINT-DETAIL. IC2034.2 +033900 CALL-TEST-04-02. IC2034.2 +034000 ADD 1 TO REC-CT. IC2034.2 +034100 IF DN2 IS EQUAL TO "YES" IC2034.2 +034200 PERFORM PASS IC2034.2 +034300 GO TO CALL-WRITE-04-02. IC2034.2 +034400 CALL-FAIL-04-02. IC2034.2 +034500 PERFORM FAIL. IC2034.2 +034600 MOVE DN2 TO COMPUTED-A. IC2034.2 +034700 MOVE "YES" TO CORRECT-A. IC2034.2 +034800 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +034900 CALL-WRITE-04-02. IC2034.2 +035000 PERFORM PRINT-DETAIL. IC2034.2 +035100 CALL-TEST-04-03. IC2034.2 +035200 ADD 1 TO REC-CT. IC2034.2 +035300 IF DN4 EQUAL TO "EQUAL" IC2034.2 +035400 PERFORM PASS IC2034.2 +035500 GO TO CALL-WRITE-04-03. IC2034.2 +035600 CALL-FAIL-04-03. IC2034.2 +035700 PERFORM FAIL. IC2034.2 +035800 MOVE DN4 TO COMPUTED-A. IC2034.2 +035900 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +036000 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +036100 CALL-WRITE-04-03. IC2034.2 +036200 PERFORM PRINT-DETAIL. IC2034.2 +036300 CALL-TEST-05. IC2034.2 +036400 MOVE "CALL-TEST-05" TO PAR-NAME. IC2034.2 +036500 MOVE "STATE UNCHANGED" TO FEATURE. IC2034.2 +036600* CALL-TEST-05 TESTS THAT THE STATE OF THE SUBPROGRAM IC2034.2 +036700* IS UNCHANGED FROM ITS STATE WHEN LAST EXITED. IC2034.2 +036800 MOVE 2 TO DN3. IC2034.2 +036900 MOVE SPACE TO DN2, DN4. IC2034.2 +037000 MOVE ZERO TO DN5. IC2034.2 +037100 CALL ID1 USING TABLE-1, DN5. IC2034.2 +037200 GO TO CALL-TEST-05-01. IC2034.2 +037300 CALL-DELETE-05. IC2034.2 +037400 PERFORM DE-LETE. IC2034.2 +037500 PERFORM PRINT-DETAIL. IC2034.2 +037600 GO TO CNCL-TEST-01. IC2034.2 +037700 CALL-TEST-05-01. IC2034.2 +037800 MOVE 1 TO REC-CT. IC2034.2 +037900 IF DN5 EQUAL TO 2 IC2034.2 +038000 PERFORM PASS IC2034.2 +038100 GO TO CALL-WRITE-05-01. IC2034.2 +038200 CALL-FAIL-05-01. IC2034.2 +038300 PERFORM FAIL. IC2034.2 +038400 MOVE DN5 TO COMPUTED-18V0. IC2034.2 +038500 MOVE 2 TO CORRECT-18V0. IC2034.2 +038600 MOVE "DN5 INCORRECT" TO RE-MARK. IC2034.2 +038700 CALL-WRITE-05-01. IC2034.2 +038800 PERFORM PRINT-DETAIL. IC2034.2 +038900 CALL-TEST-05-02. IC2034.2 +039000 ADD 1 TO REC-CT. IC2034.2 +039100 IF DN2 EQUAL TO "NO" IC2034.2 +039200 PERFORM PASS IC2034.2 +039300 GO TO CALL-WRITE-05-02. IC2034.2 +039400 CALL-FAIL-05-02. IC2034.2 +039500 PERFORM FAIL. IC2034.2 +039600 MOVE DN2 TO COMPUTED-A. IC2034.2 +039700 MOVE "NO" TO CORRECT-A. IC2034.2 +039800 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +039900 CALL-WRITE-05-02. IC2034.2 +040000 PERFORM PRINT-DETAIL. IC2034.2 +040100 CALL-TEST-05-03. IC2034.2 +040200 ADD 1 TO REC-CT. IC2034.2 +040300 IF DN4 EQUAL TO "EQUAL" IC2034.2 +040400 PERFORM PASS IC2034.2 +040500 GO TO CALL-WRITE-05-03. IC2034.2 +040600 CALL-FAIL-05-03. IC2034.2 +040700 PERFORM FAIL. IC2034.2 +040800 MOVE DN4 TO COMPUTED-A. IC2034.2 +040900 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +041000 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +041100 CALL-WRITE-05-03. IC2034.2 +041200 PERFORM PRINT-DETAIL. IC2034.2 +041300 CNCL-TEST-01. IC2034.2 +041400* THIS TEST VERIFIES THAT A SUBPROGRAM IS IN ITS IC2034.2 +041500* INITIAL STATE THE FIRST TIME IT IS CALLED FOLLOWING IC2034.2 +041600* A CANCEL STATEMENT. IC2034.2 +041700 MOVE "CNCL-TEST-01" TO PAR-NAME. IC2034.2 +041800 MOVE "SET TO INITIAL STATE" TO FEATURE. IC2034.2 +041900 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +042000 CANCEL "IC204A". IC2034.2 +042100 MOVE 1 TO DN3. IC2034.2 +042200 MOVE SPACE TO DN2, DN4. IC2034.2 +042300 MOVE ZERO TO DN1. IC2034.2 +042400 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +042500 GO TO CNCL-TEST-01-01. IC2034.2 +042600 CNCL-DELETE-01. IC2034.2 +042700 PERFORM DE-LETE. IC2034.2 +042800 PERFORM PRINT-DETAIL. IC2034.2 +042900 GO TO CNCL-TEST-02. IC2034.2 +043000 CNCL-TEST-01-01. IC2034.2 +043100 MOVE 1 TO REC-CT. IC2034.2 +043200 IF DN1 IS EQUAL TO 1 IC2034.2 +043300 PERFORM PASS IC2034.2 +043400 GO TO CNCL-WRITE-01-01. IC2034.2 +043500 CNCL-FAIL-01-01. IC2034.2 +043600 PERFORM FAIL. IC2034.2 +043700 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +043800 MOVE 1 TO CORRECT-18V0. IC2034.2 +043900 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +044000 CNCL-WRITE-01-01. IC2034.2 +044100 PERFORM PRINT-DETAIL. IC2034.2 +044200 CNCL-TEST-01-02. IC2034.2 +044300 ADD 1 TO REC-CT. IC2034.2 +044400 IF DN2 IS EQUAL TO "YES" IC2034.2 +044500 PERFORM PASS IC2034.2 +044600 GO TO CNCL-WRITE-01-02. IC2034.2 +044700 CNCL-FAIL-01-02. IC2034.2 +044800 PERFORM FAIL. IC2034.2 +044900 MOVE DN2 TO COMPUTED-A. IC2034.2 +045000 MOVE "YES" TO CORRECT-A. IC2034.2 +045100 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +045200 CNCL-WRITE-01-02. IC2034.2 +045300 PERFORM PRINT-DETAIL. IC2034.2 +045400 CNCL-TEST-01-03. IC2034.2 +045500 ADD 1 TO REC-CT. IC2034.2 +045600 IF DN4 EQUAL TO "EQUAL" IC2034.2 +045700 PERFORM PASS IC2034.2 +045800 GO TO CNCL-WRITE-01-03. IC2034.2 +045900 CNCL-FAIL-01-03. IC2034.2 +046000 PERFORM FAIL. IC2034.2 +046100 MOVE DN4 TO COMPUTED-A. IC2034.2 +046200 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +046300 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +046400 CNCL-WRITE-01-03. IC2034.2 +046500 PERFORM PRINT-DETAIL. IC2034.2 +046600 CNCL-TEST-02. IC2034.2 +046700* THIS TEST USES AN IDENTIFIER IN THE CANCEL STATEMENT. IC2034.2 +046800* THE SUBPROGRAM SHOULD BE IN ITS INITIAL STATE ON THE FIRST IC2034.2 +046900* CALL FOLLOWING A CANCEL OF THE SUBPROGRAM. IC2034.2 +047000 MOVE "CNCL-TEST-02" TO PAR-NAME. IC2034.2 +047100 MOVE "SET TO INITIAL STATE" TO FEATURE. IC2034.2 +047200 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +047300 CANCEL ID1. IC2034.2 +047400 MOVE 1 TO DN3. IC2034.2 +047500 MOVE SPACE TO DN2, DN4. IC2034.2 +047600 MOVE ZERO TO DN1. IC2034.2 +047700 CALL ID1 USING TABLE-1, DN1. IC2034.2 +047800 GO TO CNCL-TEST-02-01. IC2034.2 +047900 CNCL-DELETE-02. IC2034.2 +048000 PERFORM DE-LETE. IC2034.2 +048100 PERFORM PRINT-DETAIL. IC2034.2 +048200 GO TO CNCL-TEST-03. IC2034.2 +048300 CNCL-TEST-02-01. IC2034.2 +048400 MOVE 1 TO REC-CT. IC2034.2 +048500 IF DN1 EQUAL TO 1 IC2034.2 +048600 PERFORM PASS IC2034.2 +048700 GO TO CNCL-WRITE-02-01. IC2034.2 +048800 CNCL-FAIL-02-01. IC2034.2 +048900 PERFORM FAIL. IC2034.2 +049000 MOVE 1 TO CORRECT-18V0. IC2034.2 +049100 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +049200 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +049300 CNCL-WRITE-02-01. IC2034.2 +049400 PERFORM PRINT-DETAIL. IC2034.2 +049500 CNCL-TEST-02-02. IC2034.2 +049600 ADD 1 TO REC-CT. IC2034.2 +049700 IF DN2 EQUAL TO "YES" IC2034.2 +049800 PERFORM PASS IC2034.2 +049900 GO TO CNCL-WRITE-02-02. IC2034.2 +050000 CNCL-FAIL-02-02. IC2034.2 +050100 PERFORM FAIL. IC2034.2 +050200 MOVE DN2 TO COMPUTED-A. IC2034.2 +050300 MOVE "YES" TO CORRECT-A. IC2034.2 +050400 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +050500 CNCL-WRITE-02-02. IC2034.2 +050600 PERFORM PRINT-DETAIL. IC2034.2 +050700 CNCL-TEST-02-03. IC2034.2 +050800 ADD 1 TO REC-CT. IC2034.2 +050900 IF DN4 EQUAL TO "EQUAL" IC2034.2 +051000 PERFORM PASS IC2034.2 +051100 GO TO CNCL-WRITE-02-03. IC2034.2 +051200 CNCL-FAIL-02-03. IC2034.2 +051300 PERFORM FAIL. IC2034.2 +051400 MOVE DN4 TO COMPUTED-A. IC2034.2 +051500 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +051600 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +051700 CNCL-WRITE-02-03. IC2034.2 +051800 PERFORM PRINT-DETAIL. IC2034.2 +051900 CNCL-TEST-03. IC2034.2 +052000* THIS TEST CANCELS A SUBPROGRAM WHICH HAS ALREADY IC2034.2 +052100* BEEN CANCELED. THE SUBPROGRAM IS THEN CALLED AND A CHECK IC2034.2 +052200* IS MADE TO ENSURE THAT THE SUBPROGRAM WAS IN ITS INITIAL IC2034.2 +052300* STATE. IC2034.2 +052400 MOVE "CNCL-TEST-03" TO PAR-NAME. IC2034.2 +052500 MOVE "PREVIOUSLY CANCELED" TO FEATURE. IC2034.2 +052600 CNCL-INIT-03. IC2034.2 +052700 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +052800 CANCEL ID1. IC2034.2 +052900 CANCEL ID1. IC2034.2 +053000 MOVE 1 TO DN3. IC2034.2 +053100 MOVE SPACE TO DN2, DN4. IC2034.2 +053200 MOVE ZERO TO DN1. IC2034.2 +053300 CALL ID1 USING TABLE-1, DN1. IC2034.2 +053400 GO TO CNCL-TEST-03-01. IC2034.2 +053500 CNCL-DELETE-03. IC2034.2 +053600 PERFORM DE-LETE. IC2034.2 +053700 PERFORM PRINT-DETAIL. IC2034.2 +053800 GO TO CNCL-TEST-04. IC2034.2 +053900 CNCL-TEST-03-01. IC2034.2 +054000 MOVE 1 TO REC-CT. IC2034.2 +054100 IF DN1 EQUAL TO 1 IC2034.2 +054200 PERFORM PASS IC2034.2 +054300 GO TO CNCL-WRITE-03-01. IC2034.2 +054400 CNCL-FAIL-03-01. IC2034.2 +054500 PERFORM FAIL. IC2034.2 +054600 MOVE 1 TO CORRECT-18V0. IC2034.2 +054700 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +054800 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +054900 CNCL-WRITE-03-01. IC2034.2 +055000 PERFORM PRINT-DETAIL. IC2034.2 +055100 CNCL-TEST-03-02. IC2034.2 +055200 ADD 1 TO REC-CT. IC2034.2 +055300 IF DN2 IS EQUAL TO "YES" IC2034.2 +055400 PERFORM PASS IC2034.2 +055500 GO TO CNCL-WRITE-03-02. IC2034.2 +055600 CNCL-FAIL-03-02. IC2034.2 +055700 PERFORM FAIL. IC2034.2 +055800 MOVE DN2 TO COMPUTED-A. IC2034.2 +055900 MOVE "YES" TO CORRECT-A. IC2034.2 +056000 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +056100 CNCL-WRITE-03-02. IC2034.2 +056200 PERFORM PRINT-DETAIL. IC2034.2 +056300 CNCL-TEST-03-03. IC2034.2 +056400 ADD 1 TO REC-CT. IC2034.2 +056500 IF DN4 EQUAL TO "EQUAL" IC2034.2 +056600 PERFORM PASS IC2034.2 +056700 GO TO CNCL-WRITE-03-03. IC2034.2 +056800 CNCL-FAIL-03-03. IC2034.2 +056900 PERFORM FAIL. IC2034.2 +057000 MOVE DN4 TO COMPUTED-A. IC2034.2 +057100 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +057200 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +057300 CNCL-WRITE-03-03. IC2034.2 +057400 PERFORM PRINT-DETAIL. IC2034.2 +057500 CNCL-INIT-04. IC2034.2 +057600 MOVE "CNCL-TEST-04" TO PAR-NAME. IC2034.2 +057700 MOVE "CANCEL UNCALLED PROG" TO FEATURE. IC2034.2 +057800 MOVE ZERO TO REC-CT. IC2034.2 +057900 CNCL-TEST-04. IC2034.2 +058000* THIS TEST CANCELS A SUBPROGRAM WHICH HAS NEVER IC2034.2 +058100* BEEN CALLED. THE NEXT SENTENCE SHOULD BE EXECUTED IC2034.2 +058200* IN THIS CASE. IC2034.2 +058300 CANCEL "IC205A". IC2034.2 +058400 GO TO CNCL-PASS-04. IC2034.2 +058500 CNCL-DELETE-04. IC2034.2 +058600 PERFORM DE-LETE. IC2034.2 +058700 GO TO CNCL-WRITE-04. IC2034.2 +058800 CNCL-PASS-04. IC2034.2 +058900 PERFORM PASS. IC2034.2 +059000 CNCL-WRITE-04. IC2034.2 +059100 PERFORM PRINT-DETAIL. IC2034.2 +059200 CNCL-INIT-05. IC2034.2 +059300 MOVE "CNCL-TEST-05" TO PAR-NAME. IC2034.2 +059400 MOVE "CANCEL IN SUBPROGRAM" TO FEATURE. IC2034.2 +059500* THIS TEST CALLS SUBPROGRAM IC205 WHICH CALLS AND IC2034.2 +059600* CANCELS A THIRD SUBPROGRAM IC206. IC2034.2 +059700 CNCL-TEST-05. IC2034.2 +059800 MOVE SPACE TO DN2, DN4, TABLE-2. IC2034.2 +059900 MOVE ZERO TO DN1. IC2034.2 +060000 CALL "IC205A" USING TABLE-1, TABLE-2, DN1. IC2034.2 +060100 IF TABLE-2 EQUAL TO "AB" IC2034.2 +060200 PERFORM PASS IC2034.2 +060300 GO TO CNCL-WRITE-05. IC2034.2 +060400 GO TO CNCL-FAIL-05. IC2034.2 +060500 CNCL-DELETE-05. IC2034.2 +060600 PERFORM DE-LETE. IC2034.2 +060700 GO TO CNCL-WRITE-05. IC2034.2 +060800 CNCL-FAIL-05. IC2034.2 +060900 PERFORM FAIL. IC2034.2 +061000 MOVE "AB" TO CORRECT-A. IC2034.2 +061100 MOVE TABLE-2 TO COMPUTED-A. IC2034.2 +061200 MOVE "TABLE-2 INCORRECT" TO RE-MARK. IC2034.2 +061300 CNCL-WRITE-05. IC2034.2 +061400 PERFORM PRINT-DETAIL. IC2034.2 +061500 CNCL-INIT-06. IC2034.2 +061600 MOVE "CNCL-TEST-06" TO PAR-NAME. IC2034.2 +061700 MOVE "CALL CANCELED PROG" TO FEATURE. IC2034.2 +061800* THIS TEST CHECKS THAT THE CANCEL OF IC204 WHICH IC2034.2 +061900* WAS MADE IN THE SUBPROGRAM IC205 WAS EXECUTED PROPERLY. IC2034.2 +062000* THE SUBPROGRAM IC204 IS CALLED AND THE DATA VALUES IC2034.2 +062100* ARE CHECKED TO SEE IF IC204 WAS IN ITS INITIAL STATE. IC2034.2 +062200 CNCL-TEST-06. IC2034.2 +062300 MOVE 1 TO DN3. IC2034.2 +062400 MOVE SPACE TO DN2, DN4. IC2034.2 +062500 MOVE ZERO TO DN1. IC2034.2 +062600 CALL ID1 USING TABLE-1, DN1. IC2034.2 +062700 GO TO CNCL-TEST-06-01. IC2034.2 +062800 CNCL-DELETE-06. IC2034.2 +062900 PERFORM DE-LETE. IC2034.2 +063000 GO TO CNCL-WRITE-06-03. IC2034.2 +063100 CNCL-TEST-06-01. IC2034.2 +063200 MOVE 1 TO REC-CT. IC2034.2 +063300 IF DN1 IS EQUAL TO 1 IC2034.2 +063400 PERFORM PASS IC2034.2 +063500 GO TO CNCL-WRITE-06-01. IC2034.2 +063600 CNCL-FAIL-06-01. IC2034.2 +063700 PERFORM FAIL. IC2034.2 +063800 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +063900 MOVE 1 TO CORRECT-18V0. IC2034.2 +064000 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +064100 CNCL-WRITE-06-01. IC2034.2 +064200 PERFORM PRINT-DETAIL. IC2034.2 +064300 CNCL-TEST-06-02. IC2034.2 +064400 ADD 1 TO REC-CT. IC2034.2 +064500 IF DN2 IS EQUAL TO "YES" IC2034.2 +064600 PERFORM PASS IC2034.2 +064700 GO TO CNCL-WRITE-06-02. IC2034.2 +064800 CNCL-FAIL-06-02. IC2034.2 +064900 PERFORM FAIL. IC2034.2 +065000 MOVE DN2 TO COMPUTED-A. IC2034.2 +065100 MOVE "YES" TO CORRECT-A. IC2034.2 +065200 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +065300 CNCL-WRITE-06-02. IC2034.2 +065400 PERFORM PRINT-DETAIL. IC2034.2 +065500 CNCL-TEST-06-03. IC2034.2 +065600 ADD 1 TO REC-CT. IC2034.2 +065700 IF DN4 EQUAL TO "EQUAL" IC2034.2 +065800 PERFORM PASS IC2034.2 +065900 GO TO CNCL-WRITE-06-03. IC2034.2 +066000 CNCL-FAIL-06-03. IC2034.2 +066100 PERFORM FAIL. IC2034.2 +066200 MOVE DN4 TO COMPUTED-A. IC2034.2 +066300 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +066400 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +066500 CNCL-WRITE-06-03. IC2034.2 +066600 PERFORM PRINT-DETAIL. IC2034.2 +066700 CNCL-INIT-07. IC2034.2 +066800* THIS TEST CANCELS THE THREE SUBPROGRAMS IC2034.2 +066900* CALLED BY THIS ROUTINE. IC2034.2 +067000 MOVE "CNCL-TEST-07" TO PAR-NAME. IC2034.2 +067100 MOVE "CANCEL 3 PROGS" TO FEATURE. IC2034.2 +067200 MOVE ZERO TO REC-CT. IC2034.2 +067300 CNCL-TEST-07. IC2034.2 +067400 CANCEL ID1, "IC205A", ID2. IC2034.2 +067500 PERFORM PASS. IC2034.2 +067600 GO TO CNCL-WRITE-07. IC2034.2 +067700 CNCL-DELETE-07. IC2034.2 +067800 PERFORM DE-LETE. IC2034.2 +067900 CNCL-WRITE-07. IC2034.2 +068000 PERFORM PRINT-DETAIL. IC2034.2 +068100 CCVS-EXIT SECTION. IC2034.2 +068200 CCVS-999999. IC2034.2 +068300 GO TO CLOSE-FILES. IC2034.2 +*END-OF,IC203A +*HEADER,COBOL,IC203A,SUBRTN,IC204A +000100 IDENTIFICATION DIVISION. IC2044.2 +000200 PROGRAM-ID. IC2044.2 +000300 IC204A. IC2044.2 +000400**************************************************************** IC2044.2 +000500* * IC2044.2 +000600* VALIDATION FOR:- * IC2044.2 +000700* * IC2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2044.2 +000900* * IC2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2044.2 +001100* * IC2044.2 +001200**************************************************************** IC2044.2 +001300* * IC2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2044.2 +001500* * IC2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2044.2 +001900* * IC2044.2 +002000**************************************************************** IC2044.2 +002100* THE SUBPROGRAM IC204 HAS TWO VARIABLES IN WORKING- IC2044.2 +002200* STORAGE WHICH ARE INITIALIZED BY A VALUE STATEMENT. THE IC2044.2 +002300* DATA CONTENTS OF THESE VARIABLES ARE MODIFIED DURING IC2044.2 +002400* EXECUTION OF THE SUBPROGRAM. INDICATORS ARE SET FOR IC2044.2 +002500* VARIABLES IN THE LINKAGE SECTION WHICH RELATE HOW MANY IC2044.2 +002600* TIMES THE SUBPROGRAM HAS BEEN CALLED SINCE IT WAS IC2044.2 +002700* INITIALIZED, AND WHETHER OR NOT THE SUBPROGRAM IS IN IC2044.2 +002800* ITS INITIAL STATE. IC2044.2 +002900**************************************************************** IC2044.2 +003000 ENVIRONMENT DIVISION. IC2044.2 +003100 CONFIGURATION SECTION. IC2044.2 +003200 SOURCE-COMPUTER. IC2044.2 +003300 XXXXX082. IC2044.2 +003400 OBJECT-COMPUTER. IC2044.2 +003500 XXXXX083. IC2044.2 +003600 INPUT-OUTPUT SECTION. IC2044.2 +003700 FILE-CONTROL. IC2044.2 +003800 SELECT PRINT-FILE ASSIGN TO IC2044.2 +003900 XXXXX055. IC2044.2 +004000 DATA DIVISION. IC2044.2 +004100 FILE SECTION. IC2044.2 +004200 FD PRINT-FILE. IC2044.2 +004300 01 PRINT-REC PICTURE X(120). IC2044.2 +004400 01 DUMMY-RECORD PICTURE X(120). IC2044.2 +004500 WORKING-STORAGE SECTION. IC2044.2 +004600 77 WS1 PICTURE 99 VALUE ZERO. IC2044.2 +004700 77 WS2 PICTURE X(5) VALUE "FIRST". IC2044.2 +004800 LINKAGE SECTION. IC2044.2 +004900 77 SUB-DN1 PICTURE S999. IC2044.2 +005000 01 SUB-TABLE-1. IC2044.2 +005100 02 SUB-DN2 PIC XXX. IC2044.2 +005200 02 SUB-DN3 PIC 99. IC2044.2 +005300 02 SUB-DN4 PIC X(5). IC2044.2 +005400 PROCEDURE DIVISION USING SUB-TABLE-1, SUB-DN1. IC2044.2 +005500 SECT-IC204-0001 SECTION. IC2044.2 +005600 CNCL-TEST-01. IC2044.2 +005700 ADD 1 TO WS1. IC2044.2 +005800 MOVE WS1 TO SUB-DN1. IC2044.2 +005900 CNCL-TEST-02. IC2044.2 +006000 MOVE "NO" TO SUB-DN2. IC2044.2 +006100 IF WS2 EQUAL TO "FIRST" IC2044.2 +006200 MOVE SPACE TO WS2 IC2044.2 +006300 MOVE "YES" TO SUB-DN2. IC2044.2 +006400 CNCL-TEST-03. IC2044.2 +006500 MOVE SPACE TO SUB-DN4. IC2044.2 +006600 IF WS1 EQUAL TO SUB-DN3 IC2044.2 +006700 MOVE "EQUAL" TO SUB-DN4. IC2044.2 +006800 IC204-EXIT. IC2044.2 +006900 EXIT PROGRAM. IC2044.2 +007000* THE PARAMETER SUB-DN3 IS SET IN THE CALLING PROGRAM IC2044.2 +007100* EQUAL TO THE NUMBER OF TIMES THE SUBPROGRAM HAS BEEN IC2044.2 +007200* CALLED SINCE BEING INITIALIZED, EITHER BY THE FIRST CALL IC2044.2 +007300* OR THE FIRST CALL AFTER A CANCEL STATEMENT. IC2044.2 +*END-OF,IC204A +*HEADER,COBOL,IC203A,SUBRTN,IC205A +000100 IDENTIFICATION DIVISION. IC2054.2 +000200 PROGRAM-ID. IC2054.2 +000300 IC205A. IC2054.2 +000400**************************************************************** IC2054.2 +000500* * IC2054.2 +000600* VALIDATION FOR:- * IC2054.2 +000700* * IC2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2054.2 +000900* * IC2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2054.2 +001100* * IC2054.2 +001200**************************************************************** IC2054.2 +001300* * IC2054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2054.2 +001500* * IC2054.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2054.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2054.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2054.2 +001900* * IC2054.2 +002000**************************************************************** IC2054.2 +002100* THE SUBPROGRAM IC205 TESTS THE USE OF THE CANCEL * IC2054.2 +002200* STATEMENT WITHIN A SUBPROGRAM. THIS SUBPROGRAM IS * IC2054.2 +002300* CALLED BY IC203 AND CALLS THE SUBPROGRAMS IC204 AND IC206.* IC2054.2 +002400**************************************************************** IC2054.2 +002500 ENVIRONMENT DIVISION. IC2054.2 +002600 CONFIGURATION SECTION. IC2054.2 +002700 SOURCE-COMPUTER. IC2054.2 +002800 XXXXX082. IC2054.2 +002900 OBJECT-COMPUTER. IC2054.2 +003000 XXXXX083. IC2054.2 +003100 INPUT-OUTPUT SECTION. IC2054.2 +003200 FILE-CONTROL. IC2054.2 +003300 SELECT PRINT-FILE ASSIGN TO IC2054.2 +003400 XXXXX055. IC2054.2 +003500 DATA DIVISION. IC2054.2 +003600 FILE SECTION. IC2054.2 +003700 FD PRINT-FILE. IC2054.2 +003800 01 PRINT-REC PICTURE X(120). IC2054.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC2054.2 +004000 WORKING-STORAGE SECTION. IC2054.2 +004100 77 ID1 PICTURE X(6) VALUE "IC204A". IC2054.2 +004200 77 DN2 PICTURE S9(8) USAGE COMP VALUE ZERO. IC2054.2 +004300 LINKAGE SECTION. IC2054.2 +004400 01 TABLE-1. IC2054.2 +004500 02 T-DN1 PIC XXX. IC2054.2 +004600 02 T-DN2 PIC 99. IC2054.2 +004700 02 T-DN3 PIC X(5). IC2054.2 +004800 77 DN1 PICTURE S999. IC2054.2 +004900 01 TABLE-2. IC2054.2 +005000 02 TV-1 PIC X. IC2054.2 +005100 02 TV-2 PIC X. IC2054.2 +005200 PROCEDURE DIVISION USING TABLE-1, TABLE-2, DN1. IC2054.2 +005300 CNCL-TEST-05. IC2054.2 +005400 CALL "IC206A" USING DN2. IC2054.2 +005500 CALL "IC206A" USING DN2. IC2054.2 +005600 CALL "IC206A" USING DN2. IC2054.2 +005700 MOVE "X" TO TV-1. IC2054.2 +005800 IF DN2 EQUAL TO 3 IC2054.2 +005900 MOVE "A" TO TV-1. IC2054.2 +006000 CANCEL "IC206A". IC2054.2 +006100 MOVE ZERO TO DN2. IC2054.2 +006200 CALL "IC206A" USING DN2. IC2054.2 +006300 IF DN2 NOT EQUAL TO 1 IC2054.2 +006400 MOVE "Y" TO TV-2, IC2054.2 +006500 GO TO CNCL-TEST-06. IC2054.2 +006600 MOVE "B" TO TV-2. IC2054.2 +006700 CNCL-TEST-06. IC2054.2 +006800 CANCEL ID1. IC2054.2 +006900 EXIT-IC205. IC2054.2 +007000 EXIT PROGRAM. IC2054.2 +*END-OF,IC205A +*HEADER,COBOL,IC203A,SUBRTN,IC206A +000100 IDENTIFICATION DIVISION. IC2064.2 +000200 PROGRAM-ID. IC2064.2 +000300 IC206A. IC2064.2 +000400**************************************************************** IC2064.2 +000500* * IC2064.2 +000600* VALIDATION FOR:- * IC2064.2 +000700* * IC2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2064.2 +000900* * IC2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2064.2 +001100* * IC2064.2 +001200**************************************************************** IC2064.2 +001300* * IC2064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2064.2 +001500* * IC2064.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2064.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2064.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2064.2 +001900* * IC2064.2 +002000**************************************************************** IC2064.2 +002100* THE SUBPROGRAM IC206 IS CALLED BY THE SUBPROGRAM IC2064.2 +002200* IC205. THE SUBPROGRAM IS THEN CANCELED AND CALLED IC2064.2 +002300* AGAIN. THE PROGRAM IC205 CHECKS IF IC206 WAS IN ITS IC2064.2 +002400* INITIAL STATE ON THE FIRST CALL AFTER THE PROGRAM WAS IC2064.2 +002500* CANCELED. IC2064.2 +002600* THE LINKAGE PARAMETER DN1 CONTAINS THE NUMBER OF IC2064.2 +002700* TIMES IC206 HAS BEEN CALLED SINCE INITIALIZATION WHEN IC2064.2 +002800* CONTROL IS RETURNED TO THE CALLING PROGRAM. IC2064.2 +002900**************************************************************** IC2064.2 +003000 ENVIRONMENT DIVISION. IC2064.2 +003100 CONFIGURATION SECTION. IC2064.2 +003200 SOURCE-COMPUTER. IC2064.2 +003300 XXXXX082. IC2064.2 +003400 OBJECT-COMPUTER. IC2064.2 +003500 XXXXX083. IC2064.2 +003600 INPUT-OUTPUT SECTION. IC2064.2 +003700 FILE-CONTROL. IC2064.2 +003800 SELECT PRINT-FILE ASSIGN TO IC2064.2 +003900 XXXXX055. IC2064.2 +004000 DATA DIVISION. IC2064.2 +004100 FILE SECTION. IC2064.2 +004200 FD PRINT-FILE. IC2064.2 +004300 01 PRINT-REC PICTURE X(120). IC2064.2 +004400 01 DUMMY-RECORD PICTURE X(120). IC2064.2 +004500 WORKING-STORAGE SECTION. IC2064.2 +004600 77 WS1 PICTURE S9(8) USAGE COMPUTATIONAL IC2064.2 +004700 VALUE ZERO. IC2064.2 +004800 LINKAGE SECTION. IC2064.2 +004900 01 DN1 PICTURE S9(8) USAGE COMPUTATIONAL. IC2064.2 +005000 PROCEDURE DIVISION USING DN1. IC2064.2 +005100 SECT-IC206-0001 SECTION. IC2064.2 +005200 TEST-PARAGRAPH. IC2064.2 +005300 ADD 1 TO WS1. IC2064.2 +005400 MOVE WS1 TO DN1. IC2064.2 +005500 EXIT-IC206. IC2064.2 +005600 EXIT PROGRAM. IC2064.2 +*END-OF,IC206A +*HEADER,COBOL,IC207A +000100 IDENTIFICATION DIVISION. IC2074.2 +000200 PROGRAM-ID. IC2074.2 +000300 IC207A. IC2074.2 +000400**************************************************************** IC2074.2 +000500* * IC2074.2 +000600* VALIDATION FOR:- * IC2074.2 +000700* * IC2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +000900* * IC2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2074.2 +001100* * IC2074.2 +001200**************************************************************** IC2074.2 +001300* * IC2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2074.2 +001500* * IC2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2074.2 +001900* * IC2074.2 +002000**************************************************************** IC2074.2 +002100* THE PROGRAM IC207 DEFINES A VARIABLE LENGTH TABLE. IC2074.2 +002200* THE TABLE AND THE VARIABLE CONTAINING THE TABLE LENGTH IC2074.2 +002300* ARE OPERANDS IN A CALL STATEMENT USING PHRASE. ALSO AN IC2074.2 +002400* INDEX IS DEFINED FOR THE TABLE AND AN INDEX DATA ITEM IC2074.2 +002500* IS USED TO PASS AN INDEX VALUE FOR A TABLE REFERENCE IC2074.2 +002600* TO AND FROM THE SUBPROGRAM IC208. IC2074.2 +002700**************************************************************** IC2074.2 +002800 ENVIRONMENT DIVISION. IC2074.2 +002900 CONFIGURATION SECTION. IC2074.2 +003000 SOURCE-COMPUTER. IC2074.2 +003100 XXXXX082. IC2074.2 +003200 OBJECT-COMPUTER. IC2074.2 +003300 XXXXX083. IC2074.2 +003400 INPUT-OUTPUT SECTION. IC2074.2 +003500 FILE-CONTROL. IC2074.2 +003600 SELECT PRINT-FILE ASSIGN TO IC2074.2 +003700 XXXXX055. IC2074.2 +003800 DATA DIVISION. IC2074.2 +003900 FILE SECTION. IC2074.2 +004000 FD PRINT-FILE. IC2074.2 +004100 01 PRINT-REC PICTURE X(120). IC2074.2 +004200 01 DUMMY-RECORD PICTURE X(120). IC2074.2 +004300 WORKING-STORAGE SECTION. IC2074.2 +004400 77 INDEX-1 USAGE IS INDEX. IC2074.2 +004500 77 DN3 PICTURE 99 VALUE 15. IC2074.2 +004600 77 ID1 PICTURE X(6) VALUE "IC208A". IC2074.2 +004700 77 DN4 PICTURE X. IC2074.2 +004800 77 DN5 PICTURE X(15). IC2074.2 +004900 01 TABLE-01. IC2074.2 +005000 02 DN1 PICTURE X IC2074.2 +005100 OCCURS 1 TO 15 TIMES IC2074.2 +005200 DEPENDING ON DN3 IC2074.2 +005300 INDEXED BY IN1. IC2074.2 +005400 01 TABLE-02. IC2074.2 +005500 02 DN2 PICTURE X OCCURS 8 TIMES. IC2074.2 +005600 01 TEST-RESULTS. IC2074.2 +005700 02 FILLER PIC X VALUE SPACE. IC2074.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC2074.2 +005900 02 FILLER PIC X VALUE SPACE. IC2074.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC2074.2 +006100 02 FILLER PIC X VALUE SPACE. IC2074.2 +006200 02 PAR-NAME. IC2074.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC2074.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC2074.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC2074.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC2074.2 +006700 02 RE-MARK PIC X(61). IC2074.2 +006800 01 TEST-COMPUTED. IC2074.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC2074.2 +007000 02 FILLER PIC X(17) VALUE IC2074.2 +007100 " COMPUTED=". IC2074.2 +007200 02 COMPUTED-X. IC2074.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2074.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC2074.2 +007500 PIC -9(9).9(9). IC2074.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2074.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2074.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2074.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC2074.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC2074.2 +008100 04 FILLER PIC X. IC2074.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC2074.2 +008300 01 TEST-CORRECT. IC2074.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC2074.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2074.2 +008600 02 CORRECT-X. IC2074.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2074.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2074.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2074.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2074.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2074.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC2074.2 +009300 04 CORRECT-18V0 PIC -9(18). IC2074.2 +009400 04 FILLER PIC X. IC2074.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC2074.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2074.2 +009700 01 CCVS-C-1. IC2074.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2074.2 +009900- "SS PARAGRAPH-NAME IC2074.2 +010000- " REMARKS". IC2074.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC2074.2 +010200 01 CCVS-C-2. IC2074.2 +010300 02 FILLER PIC X VALUE SPACE. IC2074.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC2074.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC2074.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC2074.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC2074.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2074.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC2074.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2074.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2074.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2074.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2074.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2074.2 +011900 01 CCVS-H-1. IC2074.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC2074.2 +012100 02 FILLER PIC X(42) VALUE IC2074.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2074.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC2074.2 +012400 01 CCVS-H-2A. IC2074.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC2074.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2074.2 +012700 02 FILLER PIC XXXX VALUE IC2074.2 +012800 "4.2 ". IC2074.2 +012900 02 FILLER PIC X(28) VALUE IC2074.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC2074.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC2074.2 +013200 IC2074.2 +013300 01 CCVS-H-2B. IC2074.2 +013400 02 FILLER PIC X(15) VALUE IC2074.2 +013500 "TEST RESULT OF ". IC2074.2 +013600 02 TEST-ID PIC X(9). IC2074.2 +013700 02 FILLER PIC X(4) VALUE IC2074.2 +013800 " IN ". IC2074.2 +013900 02 FILLER PIC X(12) VALUE IC2074.2 +014000 " HIGH ". IC2074.2 +014100 02 FILLER PIC X(22) VALUE IC2074.2 +014200 " LEVEL VALIDATION FOR ". IC2074.2 +014300 02 FILLER PIC X(58) VALUE IC2074.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +014500 01 CCVS-H-3. IC2074.2 +014600 02 FILLER PIC X(34) VALUE IC2074.2 +014700 " FOR OFFICIAL USE ONLY ". IC2074.2 +014800 02 FILLER PIC X(58) VALUE IC2074.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2074.2 +015000 02 FILLER PIC X(28) VALUE IC2074.2 +015100 " COPYRIGHT 1985 ". IC2074.2 +015200 01 CCVS-E-1. IC2074.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC2074.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2074.2 +015500 02 ID-AGAIN PIC X(9). IC2074.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC2074.2 +015700 01 CCVS-E-2. IC2074.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC2074.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC2074.2 +016000 02 CCVS-E-2-2. IC2074.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2074.2 +016200 03 FILLER PIC X VALUE SPACE. IC2074.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC2074.2 +016400 "ERRORS ENCOUNTERED". IC2074.2 +016500 01 CCVS-E-3. IC2074.2 +016600 02 FILLER PIC X(22) VALUE IC2074.2 +016700 " FOR OFFICIAL USE ONLY". IC2074.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC2074.2 +016900 02 FILLER PIC X(58) VALUE IC2074.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC2074.2 +017200 02 FILLER PIC X(15) VALUE IC2074.2 +017300 " COPYRIGHT 1985". IC2074.2 +017400 01 CCVS-E-4. IC2074.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2074.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC2074.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2074.2 +017800 02 FILLER PIC X(40) VALUE IC2074.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2074.2 +018000 01 XXINFO. IC2074.2 +018100 02 FILLER PIC X(19) VALUE IC2074.2 +018200 "*** INFORMATION ***". IC2074.2 +018300 02 INFO-TEXT. IC2074.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC2074.2 +018500 04 XXCOMPUTED PIC X(20). IC2074.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC2074.2 +018700 04 XXCORRECT PIC X(20). IC2074.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC2074.2 +018900 01 HYPHEN-LINE. IC2074.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC2074.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC2074.2 +019200- "*****************************************". IC2074.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC2074.2 +019400- "******************************". IC2074.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC2074.2 +019600 "IC207A". IC2074.2 +019700 PROCEDURE DIVISION. IC2074.2 +019800 CCVS1 SECTION. IC2074.2 +019900 OPEN-FILES. IC2074.2 +020000 OPEN OUTPUT PRINT-FILE. IC2074.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2074.2 +020200 MOVE SPACE TO TEST-RESULTS. IC2074.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2074.2 +020400 GO TO CCVS1-EXIT. IC2074.2 +020500 CLOSE-FILES. IC2074.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2074.2 +020700 TERMINATE-CCVS. IC2074.2 +020800S EXIT PROGRAM. IC2074.2 +020900STERMINATE-CALL. IC2074.2 +021000 STOP RUN. IC2074.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2074.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2074.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2074.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2074.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC2074.2 +021600 PRINT-DETAIL. IC2074.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC2074.2 +021800 MOVE "." TO PARDOT-X IC2074.2 +021900 MOVE REC-CT TO DOTVALUE. IC2074.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2074.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2074.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2074.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2074.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2074.2 +022500 MOVE SPACE TO CORRECT-X. IC2074.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2074.2 +022700 MOVE SPACE TO RE-MARK. IC2074.2 +022800 HEAD-ROUTINE. IC2074.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2074.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2074.2 +023300 COLUMN-NAMES-ROUTINE. IC2074.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +023700 END-ROUTINE. IC2074.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2074.2 +023900 END-RTN-EXIT. IC2074.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +024100 END-ROUTINE-1. IC2074.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2074.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2074.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC2074.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2074.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2074.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2074.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2074.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2074.2 +025000 END-ROUTINE-12. IC2074.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2074.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2074.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2074.2 +025400 ELSE IC2074.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2074.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2074.2 +025700 PERFORM WRITE-LINE. IC2074.2 +025800 END-ROUTINE-13. IC2074.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2074.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC2074.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2074.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2074.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC2074.2 +026500 MOVE "NO " TO ERROR-TOTAL IC2074.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2074.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2074.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +027000 WRITE-LINE. IC2074.2 +027100 ADD 1 TO RECORD-COUNT. IC2074.2 +027200Y IF RECORD-COUNT GREATER 50 IC2074.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2074.2 +027400Y MOVE SPACE TO DUMMY-RECORD IC2074.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2074.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2074.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2074.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2074.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2074.2 +028000Y MOVE ZERO TO RECORD-COUNT. IC2074.2 +028100 PERFORM WRT-LN. IC2074.2 +028200 WRT-LN. IC2074.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2074.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC2074.2 +028500 BLANK-LINE-PRINT. IC2074.2 +028600 PERFORM WRT-LN. IC2074.2 +028700 FAIL-ROUTINE. IC2074.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2074.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2074.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2074.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2074.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2074.2 +029400 GO TO FAIL-ROUTINE-EX. IC2074.2 +029500 FAIL-ROUTINE-WRITE. IC2074.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2074.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2074.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2074.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2074.2 +030000 FAIL-ROUTINE-EX. EXIT. IC2074.2 +030100 BAIL-OUT. IC2074.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2074.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2074.2 +030400 BAIL-OUT-WRITE. IC2074.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2074.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2074.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2074.2 +030900 BAIL-OUT-EX. EXIT. IC2074.2 +031000 CCVS1-EXIT. IC2074.2 +031100 EXIT. IC2074.2 +031200 SECT-IC207-0001 SECTION. IC2074.2 +031300 INIT-PARAGRAPH. IC2074.2 +031400 MOVE "ABCDEFGHIJKLMNO" TO TABLE-01. IC2074.2 +031500 SET IN1 TO 3. IC2074.2 +031600 SET INDEX-1 TO IN1. IC2074.2 +031700 MOVE 3 TO DN3. IC2074.2 +031800 MOVE SPACE TO TABLE-02. IC2074.2 +031900 CALL ID1 USING TABLE-01, TABLE-02, INDEX-1, DN3. IC2074.2 +032000 LINK-TEST-01. IC2074.2 +032100* THIS TEST CHECKS THAT AN INDEX DATA ITEM WAS IC2074.2 +032200* CORRECTLY PASSED TO A SUBPROGRAM. IC2074.2 +032300 MOVE "LINK-TEST-01" TO PAR-NAME. IC2074.2 +032400 MOVE "INDEX DATA ITEM" TO FEATURE. IC2074.2 +032500 IF DN2 (1) IS EQUAL TO "C" IC2074.2 +032600 PERFORM PASS IC2074.2 +032700 GO TO LINK-WRITE-01. IC2074.2 +032800 LINK-FAIL-01. IC2074.2 +032900 PERFORM FAIL. IC2074.2 +033000 MOVE DN2 (1) TO COMPUTED-A. IC2074.2 +033100 MOVE "C" TO CORRECT-A. IC2074.2 +033200 MOVE "VALUE OF DN2(1)" TO RE-MARK. IC2074.2 +033300 LINK-WRITE-01. IC2074.2 +033400 PERFORM PRINT-DETAIL. IC2074.2 +033500 LINK-TEST-02. IC2074.2 +033600* THIS TEST VERIFIES THAT THE VARIABLE LENGTH TABLE IC2074.2 +033700* AND ITS LENGTH WERE PROCESSED CORRECTLY IN THE SUBPROGRAM. IC2074.2 +033800 MOVE 1 TO REC-CT. IC2074.2 +033900 MOVE "LINK-TEST-02" TO PAR-NAME. IC2074.2 +034000 MOVE "VAR. LENGTH TABLE" TO FEATURE. IC2074.2 +034100 LINK-TEST-02-01. IC2074.2 +034200 IF DN2 (2) EQUAL TO "Z" IC2074.2 +034300 PERFORM PASS IC2074.2 +034400 GO TO LINK-WRITE-02-01. IC2074.2 +034500 LINK-FAIL-02-01. IC2074.2 +034600 PERFORM FAIL. IC2074.2 +034700 MOVE DN2 (2) TO COMPUTED-A. IC2074.2 +034800 MOVE "Z" TO CORRECT-A. IC2074.2 +034900 MOVE "VALUE OF DN2(2)" TO RE-MARK. IC2074.2 +035000 LINK-WRITE-02-01. IC2074.2 +035100 PERFORM PRINT-DETAIL. IC2074.2 +035200 LINK-TEST-02-02. IC2074.2 +035300 ADD 1 TO REC-CT. IC2074.2 +035400 IF DN2 (3) EQUAL TO "B" IC2074.2 +035500 PERFORM PASS IC2074.2 +035600 GO TO LINK-WRITE-02-02. IC2074.2 +035700 LINK-FAIL-02-02. IC2074.2 +035800 PERFORM FAIL. IC2074.2 +035900 MOVE DN2 (3) TO COMPUTED-A. IC2074.2 +036000 MOVE "B" TO CORRECT-A. IC2074.2 +036100 MOVE "VALUE OF DN2(3)" TO RE-MARK. IC2074.2 +036200 LINK-WRITE-02-02. IC2074.2 +036300 PERFORM PRINT-DETAIL. IC2074.2 +036400 LINK-TEST-02-03. IC2074.2 +036500 ADD 1 TO REC-CT. IC2074.2 +036600 IF DN2 (4) EQUAL TO "X" IC2074.2 +036700 PERFORM PASS IC2074.2 +036800 GO TO LINK-WRITE-02-03. IC2074.2 +036900 LINK-FAIL-02-03. IC2074.2 +037000 PERFORM FAIL. IC2074.2 +037100 MOVE DN2 (4) TO COMPUTED-A. IC2074.2 +037200 MOVE "X" TO CORRECT-A. IC2074.2 +037300 MOVE "VALUE OF DN2(4)" TO RE-MARK. IC2074.2 +037400 LINK-WRITE-02-03. IC2074.2 +037500 PERFORM PRINT-DETAIL. IC2074.2 +037600 LINK-TEST-02-04. IC2074.2 +037700 ADD 1 TO REC-CT. IC2074.2 +037800 IF DN2 (5) EQUAL TO "G" IC2074.2 +037900 PERFORM PASS IC2074.2 +038000 GO TO LINK-WRITE-02-04. IC2074.2 +038100 LINK-FAIL-02-04. IC2074.2 +038200 PERFORM FAIL. IC2074.2 +038300 MOVE DN2 (5) TO COMPUTED-A. IC2074.2 +038400 MOVE "G" TO CORRECT-A. IC2074.2 +038500 MOVE "VALUE OF DN2(5)" TO RE-MARK. IC2074.2 +038600 LINK-WRITE-02-04. IC2074.2 +038700 PERFORM PRINT-DETAIL. IC2074.2 +038800 LINK-TEST-03. IC2074.2 +038900* THIS TEST VERIFIES THAT THE CONDITION NAMES DEFINED IC2074.2 +039000* IN THE LINKAGE SECTION OF THE SUBPROGRAM WERE PROCESSED IC2074.2 +039100* CORRECTLY. IC2074.2 +039200 MOVE "LINK-TEST-03" TO PAR-NAME. IC2074.2 +039300 MOVE 1 TO REC-CT. IC2074.2 +039400 MOVE "CONDITION NAME" TO FEATURE. IC2074.2 +039500 LINK-TEST-03-01. IC2074.2 +039600 IF DN2 (6) EQUAL TO "A" IC2074.2 +039700 PERFORM PASS IC2074.2 +039800 GO TO LINK-WRITE-03-01. IC2074.2 +039900 LINK-FAIL-03-01. IC2074.2 +040000 PERFORM FAIL. IC2074.2 +040100 MOVE DN2 (6) TO COMPUTED-A. IC2074.2 +040200 MOVE "A" TO CORRECT-A. IC2074.2 +040300 MOVE "VALUE OF DN2(6)" TO RE-MARK. IC2074.2 +040400 LINK-WRITE-03-01. IC2074.2 +040500 PERFORM PRINT-DETAIL. IC2074.2 +040600 LINK-TEST-03-02. IC2074.2 +040700 ADD 1 TO REC-CT. IC2074.2 +040800 IF DN2 (7) EQUAL TO "V" IC2074.2 +040900 PERFORM PASS IC2074.2 +041000 GO TO LINK-WRITE-03-02. IC2074.2 +041100 LINK-FAIL-03-02. IC2074.2 +041200 PERFORM FAIL. IC2074.2 +041300 MOVE DN2 (7) TO COMPUTED-A. IC2074.2 +041400 MOVE "V" TO CORRECT-A. IC2074.2 +041500 MOVE "VALUE OF DN2(7)" TO RE-MARK. IC2074.2 +041600 LINK-WRITE-03-02. IC2074.2 +041700 PERFORM PRINT-DETAIL. IC2074.2 +041800 LINK-TEST-03-03. IC2074.2 +041900 ADD 1 TO REC-CT. IC2074.2 +042000 IF DN2 (8) EQUAL TO "H" IC2074.2 +042100 PERFORM PASS IC2074.2 +042200 GO TO LINK-WRITE-03-03. IC2074.2 +042300 LINK-FAIL-03-03. IC2074.2 +042400 PERFORM FAIL. IC2074.2 +042500 MOVE DN2 (8) TO COMPUTED-A. IC2074.2 +042600 MOVE "H" TO CORRECT-A. IC2074.2 +042700 MOVE "VALUE OF DN2(8)" TO RE-MARK. IC2074.2 +042800 LINK-WRITE-03-03. IC2074.2 +042900 PERFORM PRINT-DETAIL. IC2074.2 +043000 LINK-TEST-04. IC2074.2 +043100 MOVE "LINK-TEST-04" TO PAR-NAME. IC2074.2 +043200 MOVE "CALL PARAMETERS" TO FEATURE. IC2074.2 +043300 MOVE 1 TO REC-CT. IC2074.2 +043400* CHECK THE INDEX DATA ITEM AND TABLE LENGTH WHICH IC2074.2 +043500* WERE SET IN THE SUBPROGRAM AND RETURNED CORRECTLY IC2074.2 +043600* TO THE CALLING PROGRAM. IC2074.2 +043700 LINK-TEST-04-01. IC2074.2 +043800 SET IN1 TO INDEX-1. IC2074.2 +043900 MOVE DN1 (IN1) TO DN4. IC2074.2 +044000 IF DN4 EQUAL TO "B" IC2074.2 +044100 PERFORM PASS IC2074.2 +044200 GO TO LINK-WRITE-04-01. IC2074.2 +044300 LINK-FAIL-04-01. IC2074.2 +044400 PERFORM FAIL. IC2074.2 +044500 MOVE DN4 TO COMPUTED-A. IC2074.2 +044600 MOVE "B" TO CORRECT-A. IC2074.2 +044700 MOVE "VALUE OF DN1(IN1)" TO RE-MARK. IC2074.2 +044800 LINK-WRITE-04-01. IC2074.2 +044900 PERFORM PRINT-DETAIL. IC2074.2 +045000 LINK-TEST-04-02. IC2074.2 +045100 SET IN1 TO 1. IC2074.2 +045200 SEARCH DN1 VARYING IN1 IC2074.2 +045300 AT END PERFORM PASS IC2074.2 +045400 GO TO LINK-WRITE-04-02, IC2074.2 +045500 WHEN DN1 (IN1) EQUAL TO "J" IC2074.2 +045600 PERFORM FAIL IC2074.2 +045700 MOVE DN1 (IN1) TO COMPUTED-A IC2074.2 +045800 MOVE "MATCH SHOULD NOT BE FOUND" TO RE-MARK. IC2074.2 +045900 LINK-WRITE-04-02. IC2074.2 +046000 ADD 1 TO REC-CT. IC2074.2 +046100 PERFORM PRINT-DETAIL. IC2074.2 +046200 LINK-TEST-04-03. IC2074.2 +046300 ADD 1 TO REC-CT. IC2074.2 +046400 MOVE TABLE-01 TO DN5. IC2074.2 +046500 IF DN5 EQUAL TO "ABCDEFGHI " IC2074.2 +046600 PERFORM PASS IC2074.2 +046700 GO TO LINK-WRITE-04-03. IC2074.2 +046800 LINK-FAIL-04-03. IC2074.2 +046900 PERFORM FAIL. IC2074.2 +047000 MOVE DN5 TO COMPUTED-A. IC2074.2 +047100 MOVE "ABCDEFGHI " TO CORRECT-A. IC2074.2 +047200 MOVE "CONTENTS OF TABLE-01" TO RE-MARK. IC2074.2 +047300 LINK-WRITE-04-03. IC2074.2 +047400 PERFORM PRINT-DETAIL. IC2074.2 +047500 EXIT-IC207. IC2074.2 +047600 GO TO CCVS-EXIT. IC2074.2 +047700 CCVS-EXIT SECTION. IC2074.2 +047800 CCVS-999999. IC2074.2 +047900 GO TO CLOSE-FILES. IC2074.2 +*END-OF,IC207A +*HEADER,COBOL,IC207A,SUBRTN,IC208A +000100 IDENTIFICATION DIVISION. IC2084.2 +000200 PROGRAM-ID. IC2084.2 +000300 IC208A. IC2084.2 +000400**************************************************************** IC2084.2 +000500* * IC2084.2 +000600* VALIDATION FOR:- * IC2084.2 +000700* * IC2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2084.2 +000900* * IC2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2084.2 +001100* * IC2084.2 +001200**************************************************************** IC2084.2 +001300* * IC2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2084.2 +001500* * IC2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2084.2 +001900* * IC2084.2 +002000**************************************************************** IC2084.2 +002100* THE SUBPROGRAM IC208 CONTAINS TABLES AND AN INDEX IC2084.2 +002200* DATA ITEM WHICH ARE DEFINED IN THE LINKAGE SECTION IC2084.2 +002300* AND NAMED AS OPERANDS IN THE USING PHRASE OF THE IC2084.2 +002400* PROCEDURE DIVISION HEADER. ONE OF THE TABLES IS DEFINED IC2084.2 +002500* WITH AN OCCURS DEPENDING ON CLAUSE AND HAS CONDITION-NAME IC2084.2 +002600* ENTRIES ASSOCIATED WITH IT. THE SEARCH STATEMENT IS USED IC2084.2 +002700* TO TEST THE VARIABLE LENGTH TABLE CAPABILITY. IC2084.2 +002800**************************************************************** IC2084.2 +002900 ENVIRONMENT DIVISION. IC2084.2 +003000 CONFIGURATION SECTION. IC2084.2 +003100 SOURCE-COMPUTER. IC2084.2 +003200 XXXXX082. IC2084.2 +003300 OBJECT-COMPUTER. IC2084.2 +003400 XXXXX083. IC2084.2 +003500 DATA DIVISION. IC2084.2 +003600 LINKAGE SECTION. IC2084.2 +003700 77 INDEX-1 USAGE IS INDEX. IC2084.2 +003800 77 DN3 PICTURE 99. IC2084.2 +003900 01 TABLE-01. IC2084.2 +004000 02 DN1 PICTURE X IC2084.2 +004100 OCCURS 1 TO 15 TIMES IC2084.2 +004200 DEPENDING ON DN3 IC2084.2 +004300 INDEXED BY IN1. IC2084.2 +004400 88 CN1 VALUE "A". IC2084.2 +004500 88 CN2 VALUE "H". IC2084.2 +004600 88 CN3 VALUE "O". IC2084.2 +004700 01 TABLE-02. IC2084.2 +004800 02 DN2 PICTURE X IC2084.2 +004900 OCCURS 8 TIMES. IC2084.2 +005000 PROCEDURE DIVISION USING TABLE-01, TABLE-02, INDEX-1, DN3. IC2084.2 +005100 SECT-IC208-0001 SECTION. IC2084.2 +005200 LINK-TEST-01. IC2084.2 +005300* THIS TEST USES THE INDEX DATA ITEM SET IN THE CALLING IC2084.2 +005400* PROGRAM TO SET AN INDEX AND REFERENCE A TABLE ITEM. IC2084.2 +005500 SET IN1 TO INDEX-1. IC2084.2 +005600 MOVE DN1 (IN1) TO DN2 (1). IC2084.2 +005700* LINK-TEST-02 TESTS THE VARIABLE LENGTH TABLE CAPABILITY IC2084.2 +005800* WITH THE DATA-NAME WHOSE CONTENTS IS THE TABLE LENGTH IC2084.2 +005900* DEFINED IN THE LINKAGE SECTION. IC2084.2 +006000 LINK-TEST-02-01. IC2084.2 +006100 SET IN1 TO 1. IC2084.2 +006200 SEARCH DN1 VARYING IN1 IC2084.2 +006300 AT END MOVE "Z" TO DN2 (2) IC2084.2 +006400 WHEN DN1 (IN1) EQUAL TO "D" IC2084.2 +006500 MOVE "D" TO DN2 (2). IC2084.2 +006600 LINK-TEST-02-02. IC2084.2 +006700 SET IN1 TO 1. IC2084.2 +006800 SEARCH DN1 VARYING IN1 IC2084.2 +006900 AT END MOVE "Y" TO DN2 (3) IC2084.2 +007000 WHEN DN1 (IN1) EQUAL TO "B" IC2084.2 +007100 MOVE "B" TO DN2 (3). IC2084.2 +007200 LINK-TEST-02-03. IC2084.2 +007300 MOVE 7 TO DN3. IC2084.2 +007400 SET IN1 TO 1. IC2084.2 +007500 SEARCH DN1 VARYING IN1 IC2084.2 +007600 AT END MOVE "X" TO DN2 (4) IC2084.2 +007700 WHEN DN1 (IN1) EQUAL TO "H" IC2084.2 +007800 MOVE "H" TO DN2 (4). IC2084.2 +007900 LINK-TEST-02-04. IC2084.2 +008000 SET IN1 TO 1. IC2084.2 +008100 SEARCH DN1 VARYING IN1 IC2084.2 +008200 AT END MOVE "W" TO DN2 (5) IC2084.2 +008300 WHEN DN1 (IN1) EQUAL TO "G" IC2084.2 +008400 MOVE "G" TO DN2 (5). IC2084.2 +008500 LINK-TEST-03. IC2084.2 +008600 MOVE 10 TO DN3. IC2084.2 +008700* LINK-TEST-03 TESTS THE USE OF CONDITION-NAMES WHICH IC2084.2 +008800* WERE DEFINED IN THE LINKAGE SECTION. IC2084.2 +008900 LINK-TEST-03-01. IC2084.2 +009000 IF CN1 (1) MOVE "A" TO DN2 (6). IC2084.2 +009100 LINK-TEST-03-02. IC2084.2 +009200 IF CN1 (5) MOVE "N" TO DN2 (7) IC2084.2 +009300 ELSE MOVE "V" TO DN2 (7). IC2084.2 +009400 LINK-TEST-03-03. IC2084.2 +009500 IF CN2 (8) MOVE "H" TO DN2 (8). IC2084.2 +009600 LINK-TEST-04. IC2084.2 +009700* THIS TEST SETS THE INDEX DATA ITEM AND TABLE LENGTH IC2084.2 +009800* FOR REFERENCE IN THE CALLING PROGRAM. IC2084.2 +009900 SET IN1 TO 2. IC2084.2 +010000 SET INDEX-1 TO IN1. IC2084.2 +010100 MOVE 9 TO DN3. IC2084.2 +010200 EXIT-IC208. IC2084.2 +010300 EXIT PROGRAM. IC2084.2 +*END-OF,IC208A +*HEADER,COBOL,IC209A +000100 IDENTIFICATION DIVISION. IC2094.2 +000200 PROGRAM-ID. IC2094.2 +000300 IC209A. IC2094.2 +000400**************************************************************** IC2094.2 +000500* * IC2094.2 +000600* VALIDATION FOR:- * IC2094.2 +000700* * IC2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +000900* * IC2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2094.2 +001100* * IC2094.2 +001200**************************************************************** IC2094.2 +001300* * IC2094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2094.2 +001500* * IC2094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2094.2 +001900* * IC2094.2 +002000**************************************************************** IC2094.2 +002100* THIS IS MAIN PROGRAM IC209. IC2094.2 +002200**************************************************************** IC2094.2 +002300 ENVIRONMENT DIVISION. IC2094.2 +002400 CONFIGURATION SECTION. IC2094.2 +002500 SOURCE-COMPUTER. IC2094.2 +002600 XXXXX082. IC2094.2 +002700 OBJECT-COMPUTER. IC2094.2 +002800 XXXXX083. IC2094.2 +002900 INPUT-OUTPUT SECTION. IC2094.2 +003000 FILE-CONTROL. IC2094.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2094.2 +003200 XXXXX055. IC2094.2 +003300 DATA DIVISION. IC2094.2 +003400 FILE SECTION. IC2094.2 +003500 FD PRINT-FILE. IC2094.2 +003600 01 PRINT-REC PICTURE X(120). IC2094.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2094.2 +003800 WORKING-STORAGE SECTION. IC2094.2 +003900 01 TEST-AREA. IC2094.2 +004000 02 TEST1 PICTURE X. IC2094.2 +004100 02 TEST2 PICTURE X. IC2094.2 +004200 02 TEST3 PICTURE X. IC2094.2 +004300 02 TEST4 PICTURE X. IC2094.2 +004400 01 TEST-RESULTS. IC2094.2 +004500 02 FILLER PIC X VALUE SPACE. IC2094.2 +004600 02 FEATURE PIC X(20) VALUE SPACE. IC2094.2 +004700 02 FILLER PIC X VALUE SPACE. IC2094.2 +004800 02 P-OR-F PIC X(5) VALUE SPACE. IC2094.2 +004900 02 FILLER PIC X VALUE SPACE. IC2094.2 +005000 02 PAR-NAME. IC2094.2 +005100 03 FILLER PIC X(19) VALUE SPACE. IC2094.2 +005200 03 PARDOT-X PIC X VALUE SPACE. IC2094.2 +005300 03 DOTVALUE PIC 99 VALUE ZERO. IC2094.2 +005400 02 FILLER PIC X(8) VALUE SPACE. IC2094.2 +005500 02 RE-MARK PIC X(61). IC2094.2 +005600 01 TEST-COMPUTED. IC2094.2 +005700 02 FILLER PIC X(30) VALUE SPACE. IC2094.2 +005800 02 FILLER PIC X(17) VALUE IC2094.2 +005900 " COMPUTED=". IC2094.2 +006000 02 COMPUTED-X. IC2094.2 +006100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2094.2 +006200 03 COMPUTED-N REDEFINES COMPUTED-A IC2094.2 +006300 PIC -9(9).9(9). IC2094.2 +006400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2094.2 +006500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2094.2 +006600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2094.2 +006700 03 CM-18V0 REDEFINES COMPUTED-A. IC2094.2 +006800 04 COMPUTED-18V0 PIC -9(18). IC2094.2 +006900 04 FILLER PIC X. IC2094.2 +007000 03 FILLER PIC X(50) VALUE SPACE. IC2094.2 +007100 01 TEST-CORRECT. IC2094.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IC2094.2 +007300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2094.2 +007400 02 CORRECT-X. IC2094.2 +007500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2094.2 +007600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2094.2 +007700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2094.2 +007800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2094.2 +007900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2094.2 +008000 03 CR-18V0 REDEFINES CORRECT-A. IC2094.2 +008100 04 CORRECT-18V0 PIC -9(18). IC2094.2 +008200 04 FILLER PIC X. IC2094.2 +008300 03 FILLER PIC X(2) VALUE SPACE. IC2094.2 +008400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2094.2 +008500 01 CCVS-C-1. IC2094.2 +008600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2094.2 +008700- "SS PARAGRAPH-NAME IC2094.2 +008800- " REMARKS". IC2094.2 +008900 02 FILLER PIC X(20) VALUE SPACE. IC2094.2 +009000 01 CCVS-C-2. IC2094.2 +009100 02 FILLER PIC X VALUE SPACE. IC2094.2 +009200 02 FILLER PIC X(6) VALUE "TESTED". IC2094.2 +009300 02 FILLER PIC X(15) VALUE SPACE. IC2094.2 +009400 02 FILLER PIC X(4) VALUE "FAIL". IC2094.2 +009500 02 FILLER PIC X(94) VALUE SPACE. IC2094.2 +009600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2094.2 +009700 01 REC-CT PIC 99 VALUE ZERO. IC2094.2 +009800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2094.2 +009900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2094.2 +010300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2094.2 +010400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2094.2 +010500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2094.2 +010600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2094.2 +010700 01 CCVS-H-1. IC2094.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IC2094.2 +010900 02 FILLER PIC X(42) VALUE IC2094.2 +011000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2094.2 +011100 02 FILLER PIC X(39) VALUE SPACES. IC2094.2 +011200 01 CCVS-H-2A. IC2094.2 +011300 02 FILLER PIC X(40) VALUE SPACE. IC2094.2 +011400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2094.2 +011500 02 FILLER PIC XXXX VALUE IC2094.2 +011600 "4.2 ". IC2094.2 +011700 02 FILLER PIC X(28) VALUE IC2094.2 +011800 " COPY - NOT FOR DISTRIBUTION". IC2094.2 +011900 02 FILLER PIC X(41) VALUE SPACE. IC2094.2 +012000 IC2094.2 +012100 01 CCVS-H-2B. IC2094.2 +012200 02 FILLER PIC X(15) VALUE IC2094.2 +012300 "TEST RESULT OF ". IC2094.2 +012400 02 TEST-ID PIC X(9). IC2094.2 +012500 02 FILLER PIC X(4) VALUE IC2094.2 +012600 " IN ". IC2094.2 +012700 02 FILLER PIC X(12) VALUE IC2094.2 +012800 " HIGH ". IC2094.2 +012900 02 FILLER PIC X(22) VALUE IC2094.2 +013000 " LEVEL VALIDATION FOR ". IC2094.2 +013100 02 FILLER PIC X(58) VALUE IC2094.2 +013200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +013300 01 CCVS-H-3. IC2094.2 +013400 02 FILLER PIC X(34) VALUE IC2094.2 +013500 " FOR OFFICIAL USE ONLY ". IC2094.2 +013600 02 FILLER PIC X(58) VALUE IC2094.2 +013700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2094.2 +013800 02 FILLER PIC X(28) VALUE IC2094.2 +013900 " COPYRIGHT 1985 ". IC2094.2 +014000 01 CCVS-E-1. IC2094.2 +014100 02 FILLER PIC X(52) VALUE SPACE. IC2094.2 +014200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2094.2 +014300 02 ID-AGAIN PIC X(9). IC2094.2 +014400 02 FILLER PIC X(45) VALUE SPACES. IC2094.2 +014500 01 CCVS-E-2. IC2094.2 +014600 02 FILLER PIC X(31) VALUE SPACE. IC2094.2 +014700 02 FILLER PIC X(21) VALUE SPACE. IC2094.2 +014800 02 CCVS-E-2-2. IC2094.2 +014900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2094.2 +015000 03 FILLER PIC X VALUE SPACE. IC2094.2 +015100 03 ENDER-DESC PIC X(44) VALUE IC2094.2 +015200 "ERRORS ENCOUNTERED". IC2094.2 +015300 01 CCVS-E-3. IC2094.2 +015400 02 FILLER PIC X(22) VALUE IC2094.2 +015500 " FOR OFFICIAL USE ONLY". IC2094.2 +015600 02 FILLER PIC X(12) VALUE SPACE. IC2094.2 +015700 02 FILLER PIC X(58) VALUE IC2094.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +015900 02 FILLER PIC X(13) VALUE SPACE. IC2094.2 +016000 02 FILLER PIC X(15) VALUE IC2094.2 +016100 " COPYRIGHT 1985". IC2094.2 +016200 01 CCVS-E-4. IC2094.2 +016300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2094.2 +016400 02 FILLER PIC X(4) VALUE " OF ". IC2094.2 +016500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2094.2 +016600 02 FILLER PIC X(40) VALUE IC2094.2 +016700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2094.2 +016800 01 XXINFO. IC2094.2 +016900 02 FILLER PIC X(19) VALUE IC2094.2 +017000 "*** INFORMATION ***". IC2094.2 +017100 02 INFO-TEXT. IC2094.2 +017200 04 FILLER PIC X(8) VALUE SPACE. IC2094.2 +017300 04 XXCOMPUTED PIC X(20). IC2094.2 +017400 04 FILLER PIC X(5) VALUE SPACE. IC2094.2 +017500 04 XXCORRECT PIC X(20). IC2094.2 +017600 02 INF-ANSI-REFERENCE PIC X(48). IC2094.2 +017700 01 HYPHEN-LINE. IC2094.2 +017800 02 FILLER PIC IS X VALUE IS SPACE. IC2094.2 +017900 02 FILLER PIC IS X(65) VALUE IS "************************IC2094.2 +018000- "*****************************************". IC2094.2 +018100 02 FILLER PIC IS X(54) VALUE IS "************************IC2094.2 +018200- "******************************". IC2094.2 +018300 01 CCVS-PGM-ID PIC X(9) VALUE IC2094.2 +018400 "IC209A". IC2094.2 +018500 PROCEDURE DIVISION. IC2094.2 +018600 CCVS1 SECTION. IC2094.2 +018700 OPEN-FILES. IC2094.2 +018800 OPEN OUTPUT PRINT-FILE. IC2094.2 +018900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2094.2 +019000 MOVE SPACE TO TEST-RESULTS. IC2094.2 +019100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2094.2 +019200 GO TO CCVS1-EXIT. IC2094.2 +019300 CLOSE-FILES. IC2094.2 +019400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2094.2 +019500 TERMINATE-CCVS. IC2094.2 +019600S EXIT PROGRAM. IC2094.2 +019700STERMINATE-CALL. IC2094.2 +019800 STOP RUN. IC2094.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2094.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2094.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2094.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2094.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IC2094.2 +020400 PRINT-DETAIL. IC2094.2 +020500 IF REC-CT NOT EQUAL TO ZERO IC2094.2 +020600 MOVE "." TO PARDOT-X IC2094.2 +020700 MOVE REC-CT TO DOTVALUE. IC2094.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2094.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2094.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2094.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2094.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2094.2 +021300 MOVE SPACE TO CORRECT-X. IC2094.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2094.2 +021500 MOVE SPACE TO RE-MARK. IC2094.2 +021600 HEAD-ROUTINE. IC2094.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2094.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2094.2 +022100 COLUMN-NAMES-ROUTINE. IC2094.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +022500 END-ROUTINE. IC2094.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2094.2 +022700 END-RTN-EXIT. IC2094.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +022900 END-ROUTINE-1. IC2094.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2094.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2094.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IC2094.2 +023300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2094.2 +023400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2094.2 +023500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2094.2 +023600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2094.2 +023700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2094.2 +023800 END-ROUTINE-12. IC2094.2 +023900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2094.2 +024000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2094.2 +024100 MOVE "NO " TO ERROR-TOTAL IC2094.2 +024200 ELSE IC2094.2 +024300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2094.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2094.2 +024500 PERFORM WRITE-LINE. IC2094.2 +024600 END-ROUTINE-13. IC2094.2 +024700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2094.2 +024800 MOVE "NO " TO ERROR-TOTAL ELSE IC2094.2 +024900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2094.2 +025000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2094.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025200 IF INSPECT-COUNTER EQUAL TO ZERO IC2094.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2094.2 +025400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2094.2 +025500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2094.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025800 WRITE-LINE. IC2094.2 +025900 ADD 1 TO RECORD-COUNT. IC2094.2 +026000Y IF RECORD-COUNT GREATER 50 IC2094.2 +026100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2094.2 +026200Y MOVE SPACE TO DUMMY-RECORD IC2094.2 +026300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2094.2 +026400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2094.2 +026500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2094.2 +026600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2094.2 +026700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2094.2 +026800Y MOVE ZERO TO RECORD-COUNT. IC2094.2 +026900 PERFORM WRT-LN. IC2094.2 +027000 WRT-LN. IC2094.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2094.2 +027200 MOVE SPACE TO DUMMY-RECORD. IC2094.2 +027300 BLANK-LINE-PRINT. IC2094.2 +027400 PERFORM WRT-LN. IC2094.2 +027500 FAIL-ROUTINE. IC2094.2 +027600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2094.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2094.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2094.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2094.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2094.2 +028200 GO TO FAIL-ROUTINE-EX. IC2094.2 +028300 FAIL-ROUTINE-WRITE. IC2094.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2094.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2094.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2094.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2094.2 +028800 FAIL-ROUTINE-EX. EXIT. IC2094.2 +028900 BAIL-OUT. IC2094.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2094.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2094.2 +029200 BAIL-OUT-WRITE. IC2094.2 +029300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2094.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2094.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2094.2 +029700 BAIL-OUT-EX. EXIT. IC2094.2 +029800 CCVS1-EXIT. IC2094.2 +029900 EXIT. IC2094.2 +030000 CALL-TEST-1. IC2094.2 +030100 MOVE SPACES TO TEST-AREA. IC2094.2 +030200 CALL "IC210A" USING TEST-AREA. IC2094.2 +030300 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +030400 MOVE "CALL-TEST-1" TO PAR-NAME. IC2094.2 +030500 MOVE "MAIN PROGRAM CALLS SUBPROGRAM1" TO RE-MARK. IC2094.2 +030600 IF TEST1 = "Y" PERFORM PASS IC2094.2 +030700 GO TO CALL-WRITE-1. IC2094.2 +030800 CALL-FAIL-1. IC2094.2 +030900 MOVE TEST1 TO COMPUTED-A. IC2094.2 +031000 MOVE "Y" TO CORRECT-A. IC2094.2 +031100 PERFORM FAIL. IC2094.2 +031200 CALL-WRITE-1. IC2094.2 +031300 PERFORM PRINT-DETAIL. IC2094.2 +031400 CALL-TEST-2. IC2094.2 +031500 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +031600 MOVE "CALL-TEST-2" TO PAR-NAME. IC2094.2 +031700 MOVE "SUBPROGRAM1 CALLS SUBPROGRAM2" TO RE-MARK. IC2094.2 +031800 IF TEST2 = "Y" PERFORM PASS IC2094.2 +031900 GO TO CALL-WRITE-2. IC2094.2 +032000 CALL-FAIL-2. IC2094.2 +032100 MOVE TEST2 TO COMPUTED-A. IC2094.2 +032200 MOVE "Y" TO CORRECT-A. IC2094.2 +032300 PERFORM FAIL. IC2094.2 +032400 CALL-WRITE-2. IC2094.2 +032500 PERFORM PRINT-DETAIL. IC2094.2 +032600 CALL-TEST-3. IC2094.2 +032700 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +032800 MOVE "CALL-TEST-3" TO PAR-NAME. IC2094.2 +032900 MOVE "SUBPROGRAM1 CALLS SUBPROGRAM3" TO RE-MARK. IC2094.2 +033000 IF TEST3 = "Y" PERFORM PASS IC2094.2 +033100 GO TO CALL-WRITE-3. IC2094.2 +033200 CALL-FAIL-3. IC2094.2 +033300 MOVE TEST3 TO COMPUTED-A. IC2094.2 +033400 MOVE "Y" TO CORRECT-A. IC2094.2 +033500 PERFORM FAIL. IC2094.2 +033600 CALL-WRITE-3. IC2094.2 +033700 PERFORM PRINT-DETAIL. IC2094.2 +033800 CANCEL-TEST-1. IC2094.2 +033900 MOVE "CANCEL" TO FEATURE. IC2094.2 +034000 MOVE "CANCEL-TEST-1" TO PAR-NAME. IC2094.2 +034100 MOVE "SUBPROGRAM1 CANCELS SUBPROGRAM2" TO RE-MARK. IC2094.2 +034200 IF TEST4 = "Y" PERFORM PASS IC2094.2 +034300 GO TO CANCEL-WRITE-1. IC2094.2 +034400 CANCEL-FAIL-1. IC2094.2 +034500 MOVE TEST4 TO COMPUTED-A. IC2094.2 +034600 MOVE "Y" TO CORRECT-A. IC2094.2 +034700 PERFORM FAIL. IC2094.2 +034800 CANCEL-WRITE-1. IC2094.2 +034900 PERFORM PRINT-DETAIL. IC2094.2 +035000 CCVS-EXIT SECTION. IC2094.2 +035100 CCVS-999999. IC2094.2 +035200 GO TO CLOSE-FILES. IC2094.2 +*END-OF,IC209A +*HEADER,COBOL,IC209A,SUBRTN,IC210A +000100 IDENTIFICATION DIVISION. IC2104.2 +000200 PROGRAM-ID. IC2104.2 +000300 IC210A. IC2104.2 +000400**************************************************************** IC2104.2 +000500* * IC2104.2 +000600* VALIDATION FOR:- * IC2104.2 +000700* * IC2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2104.2 +000900* * IC2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2104.2 +001100* * IC2104.2 +001200**************************************************************** IC2104.2 +001300* * IC2104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2104.2 +001500* * IC2104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2104.2 +001900* * IC2104.2 +002000**************************************************************** IC2104.2 +002100* 1 THIS IS SUBPROGRAM IC210. IC2104.2 +002200**************************************************************** IC2104.2 +002300 ENVIRONMENT DIVISION. IC2104.2 +002400 CONFIGURATION SECTION. IC2104.2 +002500 SOURCE-COMPUTER. IC2104.2 +002600 XXXXX082. IC2104.2 +002700 OBJECT-COMPUTER. IC2104.2 +002800 XXXXX083. IC2104.2 +002900 DATA DIVISION. IC2104.2 +003000 LINKAGE SECTION. IC2104.2 +003100 01 TEST-AREA. IC2104.2 +003200 02 TEST1 PICTURE X. IC2104.2 +003300 02 TEST2 PICTURE X. IC2104.2 +003400 02 TEST3 PICTURE X. IC2104.2 +003500 02 TEST4 PICTURE X. IC2104.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2104.2 +003700 CALL-TEST-2. IC2104.2 +003800 MOVE "Y" TO TEST1. IC2104.2 +003900 CALL "IC211A" USING TEST-AREA. IC2104.2 +004000 IF TEST2 = "Y" GO TO CALL-TEST-3. IC2104.2 +004100 MOVE "N" TO TEST2. IC2104.2 +004200 CALL-TEST-3. IC2104.2 +004300 CALL "IC212A" USING TEST-AREA. IC2104.2 +004400 IF TEST3 = "Y" GO TO CANCEL-TEST-1. IC2104.2 +004500 MOVE "N" TO TEST3. IC2104.2 +004600 CANCEL-TEST-1. IC2104.2 +004700 CANCEL "IC211A". IC2104.2 +004800 MOVE "Y" TO TEST4. IC2104.2 +004900 IC210-EXIT. IC2104.2 +005000 EXIT PROGRAM. IC2104.2 +*END-OF,IC210A +*HEADER,COBOL,IC209A,SUBRTN,IC211A +000100 IDENTIFICATION DIVISION. IC2114.2 +000200 PROGRAM-ID. IC2114.2 +000300 IC211A. IC2114.2 +000400**************************************************************** IC2114.2 +000500* * IC2114.2 +000600* VALIDATION FOR:- * IC2114.2 +000700* * IC2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2114.2 +000900* * IC2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2114.2 +001100* * IC2114.2 +001200**************************************************************** IC2114.2 +001300* * IC2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2114.2 +001500* * IC2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2114.2 +001900* * IC2114.2 +002000**************************************************************** IC2114.2 +002100* THIS IS SUBPROGRAM IC211. IC2114.2 +002200**************************************************************** IC2114.2 +002300 ENVIRONMENT DIVISION. IC2114.2 +002400 CONFIGURATION SECTION. IC2114.2 +002500 SOURCE-COMPUTER. IC2114.2 +002600 XXXXX082. IC2114.2 +002700 OBJECT-COMPUTER. IC2114.2 +002800 XXXXX083. IC2114.2 +002900 DATA DIVISION. IC2114.2 +003000 LINKAGE SECTION. IC2114.2 +003100 01 TEST-AREA. IC2114.2 +003200 02 TEST1 PICTURE X. IC2114.2 +003300 02 TEST2 PICTURE X. IC2114.2 +003400 02 TEST3 PICTURE X. IC2114.2 +003500 02 TEST4 PICTURE X. IC2114.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2114.2 +003700 CALL-TEST-2. IC2114.2 +003800 MOVE "Y" TO TEST2. IC2114.2 +003900 IC211-EXIT. IC2114.2 +004000 EXIT PROGRAM. IC2114.2 +*END-OF,IC211A +*HEADER,COBOL,IC209A,SUBRTN,IC212A +000100 IDENTIFICATION DIVISION. IC2124.2 +000200 PROGRAM-ID. IC2124.2 +000300 IC212A. IC2124.2 +000400**************************************************************** IC2124.2 +000500* * IC2124.2 +000600* VALIDATION FOR:- * IC2124.2 +000700* * IC2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2124.2 +000900* * IC2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2124.2 +001100* * IC2124.2 +001200**************************************************************** IC2124.2 +001300* * IC2124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2124.2 +001500* * IC2124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2124.2 +001900* * IC2124.2 +002000**************************************************************** IC2124.2 +002100* THIS IS SUBPROGRAM IC212. IC2124.2 +002200**************************************************************** IC2124.2 +002300 ENVIRONMENT DIVISION. IC2124.2 +002400 CONFIGURATION SECTION. IC2124.2 +002500 SOURCE-COMPUTER. IC2124.2 +002600 XXXXX082. IC2124.2 +002700 OBJECT-COMPUTER. IC2124.2 +002800 XXXXX083. IC2124.2 +002900 DATA DIVISION. IC2124.2 +003000 LINKAGE SECTION. IC2124.2 +003100 01 TEST-AREA. IC2124.2 +003200 02 TEST1 PICTURE X. IC2124.2 +003300 02 TEST2 PICTURE X. IC2124.2 +003400 02 TEST3 PICTURE X. IC2124.2 +003500 02 TEST4 PICTURE X. IC2124.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2124.2 +003700 CALL-TEST-3. IC2124.2 +003800 MOVE "Y" TO TEST3. IC2124.2 +003900 IC212-EXIT. IC2124.2 +004000 EXIT PROGRAM. IC2124.2 +*END-OF,IC212A +*HEADER,COBOL,IC213A +000100 IDENTIFICATION DIVISION. IC2134.2 +000200 PROGRAM-ID. IC2134.2 +000300 IC213A. IC2134.2 +000400**************************************************************** IC2134.2 +000500* * IC2134.2 +000600* VALIDATION FOR:- * IC2134.2 +000700* * IC2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +000900* * IC2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2134.2 +001100* * IC2134.2 +001200**************************************************************** IC2134.2 +001300* * IC2134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2134.2 +001500* * IC2134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2134.2 +001900* * IC2134.2 +002000**************************************************************** IC2134.2 +002100* THIS IS MAIN PROGRAM IC213. IC2134.2 +002200**************************************************************** IC2134.2 +002300 ENVIRONMENT DIVISION. IC2134.2 +002400 CONFIGURATION SECTION. IC2134.2 +002500 SOURCE-COMPUTER. IC2134.2 +002600 XXXXX082. IC2134.2 +002700 OBJECT-COMPUTER. IC2134.2 +002800 XXXXX083. IC2134.2 +002900 INPUT-OUTPUT SECTION. IC2134.2 +003000 FILE-CONTROL. IC2134.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2134.2 +003200 XXXXX055. IC2134.2 +003300 DATA DIVISION. IC2134.2 +003400 FILE SECTION. IC2134.2 +003500 FD PRINT-FILE. IC2134.2 +003600 01 PRINT-REC PICTURE X(120). IC2134.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2134.2 +003800 WORKING-STORAGE SECTION. IC2134.2 +003900 01 DN1 PICTURE S9 VALUE ZERO. IC2134.2 +004000 01 DN2 PICTURE S9 VALUE ZERO. IC2134.2 +004100 01 DN3 PICTURE S9 VALUE ZERO. IC2134.2 +004200 01 TEST-RESULTS. IC2134.2 +004300 02 FILLER PIC X VALUE SPACE. IC2134.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IC2134.2 +004500 02 FILLER PIC X VALUE SPACE. IC2134.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IC2134.2 +004700 02 FILLER PIC X VALUE SPACE. IC2134.2 +004800 02 PAR-NAME. IC2134.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IC2134.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IC2134.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IC2134.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IC2134.2 +005300 02 RE-MARK PIC X(61). IC2134.2 +005400 01 TEST-COMPUTED. IC2134.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IC2134.2 +005600 02 FILLER PIC X(17) VALUE IC2134.2 +005700 " COMPUTED=". IC2134.2 +005800 02 COMPUTED-X. IC2134.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2134.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IC2134.2 +006100 PIC -9(9).9(9). IC2134.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2134.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2134.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2134.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IC2134.2 +006600 04 COMPUTED-18V0 PIC -9(18). IC2134.2 +006700 04 FILLER PIC X. IC2134.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IC2134.2 +006900 01 TEST-CORRECT. IC2134.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IC2134.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IC2134.2 +007200 02 CORRECT-X. IC2134.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IC2134.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2134.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2134.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2134.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2134.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IC2134.2 +007900 04 CORRECT-18V0 PIC -9(18). IC2134.2 +008000 04 FILLER PIC X. IC2134.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IC2134.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2134.2 +008300 01 CCVS-C-1. IC2134.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2134.2 +008500- "SS PARAGRAPH-NAME IC2134.2 +008600- " REMARKS". IC2134.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IC2134.2 +008800 01 CCVS-C-2. IC2134.2 +008900 02 FILLER PIC X VALUE SPACE. IC2134.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IC2134.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IC2134.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IC2134.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IC2134.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2134.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IC2134.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2134.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2134.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2134.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2134.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2134.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2134.2 +010500 01 CCVS-H-1. IC2134.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IC2134.2 +010700 02 FILLER PIC X(42) VALUE IC2134.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2134.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IC2134.2 +011000 01 CCVS-H-2A. IC2134.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IC2134.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2134.2 +011300 02 FILLER PIC XXXX VALUE IC2134.2 +011400 "4.2 ". IC2134.2 +011500 02 FILLER PIC X(28) VALUE IC2134.2 +011600 " COPY - NOT FOR DISTRIBUTION". IC2134.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IC2134.2 +011800 IC2134.2 +011900 01 CCVS-H-2B. IC2134.2 +012000 02 FILLER PIC X(15) VALUE IC2134.2 +012100 "TEST RESULT OF ". IC2134.2 +012200 02 TEST-ID PIC X(9). IC2134.2 +012300 02 FILLER PIC X(4) VALUE IC2134.2 +012400 " IN ". IC2134.2 +012500 02 FILLER PIC X(12) VALUE IC2134.2 +012600 " HIGH ". IC2134.2 +012700 02 FILLER PIC X(22) VALUE IC2134.2 +012800 " LEVEL VALIDATION FOR ". IC2134.2 +012900 02 FILLER PIC X(58) VALUE IC2134.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +013100 01 CCVS-H-3. IC2134.2 +013200 02 FILLER PIC X(34) VALUE IC2134.2 +013300 " FOR OFFICIAL USE ONLY ". IC2134.2 +013400 02 FILLER PIC X(58) VALUE IC2134.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2134.2 +013600 02 FILLER PIC X(28) VALUE IC2134.2 +013700 " COPYRIGHT 1985 ". IC2134.2 +013800 01 CCVS-E-1. IC2134.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IC2134.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2134.2 +014100 02 ID-AGAIN PIC X(9). IC2134.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IC2134.2 +014300 01 CCVS-E-2. IC2134.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IC2134.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IC2134.2 +014600 02 CCVS-E-2-2. IC2134.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2134.2 +014800 03 FILLER PIC X VALUE SPACE. IC2134.2 +014900 03 ENDER-DESC PIC X(44) VALUE IC2134.2 +015000 "ERRORS ENCOUNTERED". IC2134.2 +015100 01 CCVS-E-3. IC2134.2 +015200 02 FILLER PIC X(22) VALUE IC2134.2 +015300 " FOR OFFICIAL USE ONLY". IC2134.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IC2134.2 +015500 02 FILLER PIC X(58) VALUE IC2134.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IC2134.2 +015800 02 FILLER PIC X(15) VALUE IC2134.2 +015900 " COPYRIGHT 1985". IC2134.2 +016000 01 CCVS-E-4. IC2134.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2134.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IC2134.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2134.2 +016400 02 FILLER PIC X(40) VALUE IC2134.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IC2134.2 +016600 01 XXINFO. IC2134.2 +016700 02 FILLER PIC X(19) VALUE IC2134.2 +016800 "*** INFORMATION ***". IC2134.2 +016900 02 INFO-TEXT. IC2134.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IC2134.2 +017100 04 XXCOMPUTED PIC X(20). IC2134.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IC2134.2 +017300 04 XXCORRECT PIC X(20). IC2134.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IC2134.2 +017500 01 HYPHEN-LINE. IC2134.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IC2134.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IC2134.2 +017800- "*****************************************". IC2134.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IC2134.2 +018000- "******************************". IC2134.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IC2134.2 +018200 "IC213A". IC2134.2 +018300 PROCEDURE DIVISION. IC2134.2 +018400 CCVS1 SECTION. IC2134.2 +018500 OPEN-FILES. IC2134.2 +018600 OPEN OUTPUT PRINT-FILE. IC2134.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2134.2 +018800 MOVE SPACE TO TEST-RESULTS. IC2134.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2134.2 +019000 GO TO CCVS1-EXIT. IC2134.2 +019100 CLOSE-FILES. IC2134.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2134.2 +019300 TERMINATE-CCVS. IC2134.2 +019400S EXIT PROGRAM. IC2134.2 +019500STERMINATE-CALL. IC2134.2 +019600 STOP RUN. IC2134.2 +019700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2134.2 +019800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2134.2 +019900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2134.2 +020000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2134.2 +020100 MOVE "****TEST DELETED****" TO RE-MARK. IC2134.2 +020200 PRINT-DETAIL. IC2134.2 +020300 IF REC-CT NOT EQUAL TO ZERO IC2134.2 +020400 MOVE "." TO PARDOT-X IC2134.2 +020500 MOVE REC-CT TO DOTVALUE. IC2134.2 +020600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2134.2 +020700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2134.2 +020800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2134.2 +020900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2134.2 +021000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2134.2 +021100 MOVE SPACE TO CORRECT-X. IC2134.2 +021200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2134.2 +021300 MOVE SPACE TO RE-MARK. IC2134.2 +021400 HEAD-ROUTINE. IC2134.2 +021500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +021600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +021700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2134.2 +021800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2134.2 +021900 COLUMN-NAMES-ROUTINE. IC2134.2 +022000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +022100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +022300 END-ROUTINE. IC2134.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2134.2 +022500 END-RTN-EXIT. IC2134.2 +022600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +022700 END-ROUTINE-1. IC2134.2 +022800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2134.2 +022900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2134.2 +023000 ADD PASS-COUNTER TO ERROR-HOLD. IC2134.2 +023100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2134.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2134.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2134.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2134.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2134.2 +023600 END-ROUTINE-12. IC2134.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2134.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO IC2134.2 +023900 MOVE "NO " TO ERROR-TOTAL IC2134.2 +024000 ELSE IC2134.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2134.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2134.2 +024300 PERFORM WRITE-LINE. IC2134.2 +024400 END-ROUTINE-13. IC2134.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO IC2134.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE IC2134.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2134.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2134.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO IC2134.2 +025100 MOVE "NO " TO ERROR-TOTAL IC2134.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2134.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2134.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025600 WRITE-LINE. IC2134.2 +025700 ADD 1 TO RECORD-COUNT. IC2134.2 +025800Y IF RECORD-COUNT GREATER 50 IC2134.2 +025900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2134.2 +026000Y MOVE SPACE TO DUMMY-RECORD IC2134.2 +026100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2134.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2134.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2134.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2134.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2134.2 +026600Y MOVE ZERO TO RECORD-COUNT. IC2134.2 +026700 PERFORM WRT-LN. IC2134.2 +026800 WRT-LN. IC2134.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2134.2 +027000 MOVE SPACE TO DUMMY-RECORD. IC2134.2 +027100 BLANK-LINE-PRINT. IC2134.2 +027200 PERFORM WRT-LN. IC2134.2 +027300 FAIL-ROUTINE. IC2134.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2134.2 +027500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2134.2 +027600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2134.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2134.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +027900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2134.2 +028000 GO TO FAIL-ROUTINE-EX. IC2134.2 +028100 FAIL-ROUTINE-WRITE. IC2134.2 +028200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2134.2 +028300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2134.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2134.2 +028500 MOVE SPACES TO COR-ANSI-REFERENCE. IC2134.2 +028600 FAIL-ROUTINE-EX. EXIT. IC2134.2 +028700 BAIL-OUT. IC2134.2 +028800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2134.2 +028900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2134.2 +029000 BAIL-OUT-WRITE. IC2134.2 +029100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2134.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2134.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2134.2 +029500 BAIL-OUT-EX. EXIT. IC2134.2 +029600 CCVS1-EXIT. IC2134.2 +029700 EXIT. IC2134.2 +029800 CALL-TEST-1. IC2134.2 +029900 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2134.2 +030000 MOVE "CALL-TEST-1" TO PAR-NAME. IC2134.2 +030100 MOVE "MAIN PROGRAM CALLS SUBPROGRAM1" TO RE-MARK. IC2134.2 +030200 CALL "IC214A" USING DN1. IC2134.2 +030300 IF DN1 IS EQUAL TO 1 IC2134.2 +030400 PERFORM PASS IC2134.2 +030500 GO TO CALL-WRITE-1. IC2134.2 +030600 CALL-FAIL-1. IC2134.2 +030700 MOVE 1 TO CORRECT-18V0. IC2134.2 +030800 MOVE DN1 TO COMPUTED-18V0. IC2134.2 +030900 PERFORM FAIL. IC2134.2 +031000 CALL-WRITE-1. IC2134.2 +031100 PERFORM PRINT-DETAIL. IC2134.2 +031200 CALL-TEST-2. IC2134.2 +031300 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2134.2 +031400 MOVE "CALL-TEST-2" TO PAR-NAME. IC2134.2 +031500 MOVE "MAIN PROGRAM CALLS SUBPROGRAM2" TO RE-MARK. IC2134.2 +031600 CALL "IC215A" USING DN2, DN3. IC2134.2 +031700 IF DN2 IS EQUAL TO 1 IC2134.2 +031800 PERFORM PASS IC2134.2 +031900 GO TO CALL-WRITE-2. IC2134.2 +032000 CALL-FAIL-2. IC2134.2 +032100 MOVE 1 TO CORRECT-18V0. IC2134.2 +032200 MOVE DN2 TO COMPUTED-18V0. IC2134.2 +032300 PERFORM FAIL. IC2134.2 +032400 CALL-WRITE-2. IC2134.2 +032500 PERFORM PRINT-DETAIL. IC2134.2 +032600 CANCEL-TEST-1. IC2134.2 +032700 MOVE "CANCEL" TO FEATURE. IC2134.2 +032800 MOVE "CANCEL-TEST-1" TO PAR-NAME. IC2134.2 +032900 MOVE "SUBPROGRAM2 CANCELS SUBPROGRAM1" TO RE-MARK. IC2134.2 +033000 IF DN3 IS EQUAL TO 1 IC2134.2 +033100 PERFORM PASS IC2134.2 +033200 GO TO CANCEL-WRITE-1. IC2134.2 +033300 CANCEL-FAIL-1. IC2134.2 +033400 MOVE 1 TO CORRECT-18V0. IC2134.2 +033500 MOVE DN3 TO COMPUTED-18V0. IC2134.2 +033600 PERFORM FAIL. IC2134.2 +033700 CANCEL-WRITE-1. IC2134.2 +033800 PERFORM PRINT-DETAIL. IC2134.2 +033900 CCVS-EXIT SECTION. IC2134.2 +034000 CCVS-999999. IC2134.2 +034100 GO TO CLOSE-FILES. IC2134.2 +*END-OF,IC213A +*HEADER,COBOL,IC213A,SUBRTN,IC214A +000100 IDENTIFICATION DIVISION. IC2144.2 +000200 PROGRAM-ID. IC2144.2 +000300 IC214A. IC2144.2 +000400**************************************************************** IC2144.2 +000500* * IC2144.2 +000600* VALIDATION FOR:- * IC2144.2 +000700* * IC2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2144.2 +000900* * IC2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2144.2 +001100* * IC2144.2 +001200**************************************************************** IC2144.2 +001300* * IC2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2144.2 +001500* * IC2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2144.2 +001900* * IC2144.2 +002000**************************************************************** IC2144.2 +002100* THIS IS SUBPROGRAM IC214. IC2144.2 +002200**************************************************************** IC2144.2 +002300 ENVIRONMENT DIVISION. IC2144.2 +002400 CONFIGURATION SECTION. IC2144.2 +002500 SOURCE-COMPUTER. IC2144.2 +002600 XXXXX082. IC2144.2 +002700 OBJECT-COMPUTER. IC2144.2 +002800 XXXXX083. IC2144.2 +002900 DATA DIVISION. IC2144.2 +003000 LINKAGE SECTION. IC2144.2 +003100 01 DN1 PICTURE S9. IC2144.2 +003200 PROCEDURE DIVISION USING DN1. IC2144.2 +003300 CALL-TEST-1. IC2144.2 +003400 MOVE 1 TO DN1. IC2144.2 +003500 IC214-EXIT. IC2144.2 +003600 EXIT PROGRAM. IC2144.2 +*END-OF,IC214A +*HEADER,COBOL,IC213A,SUBRTN,IC215A +000100 IDENTIFICATION DIVISION. IC2154.2 +000200 PROGRAM-ID. IC2154.2 +000300 IC215A. IC2154.2 +000400**************************************************************** IC2154.2 +000500* * IC2154.2 +000600* VALIDATION FOR:- * IC2154.2 +000700* * IC2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2154.2 +000900* * IC2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2154.2 +001100* * IC2154.2 +001200**************************************************************** IC2154.2 +001300* * IC2154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2154.2 +001500* * IC2154.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2154.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2154.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2154.2 +001900* * IC2154.2 +002000**************************************************************** IC2154.2 +002100* THIS IS SUBPROGRAM IC215. IC2154.2 +002200**************************************************************** IC2154.2 +002300 ENVIRONMENT DIVISION. IC2154.2 +002400 CONFIGURATION SECTION. IC2154.2 +002500 SOURCE-COMPUTER. IC2154.2 +002600 XXXXX082. IC2154.2 +002700 OBJECT-COMPUTER. IC2154.2 +002800 XXXXX083. IC2154.2 +002900 DATA DIVISION. IC2154.2 +003000 LINKAGE SECTION. IC2154.2 +003100 01 DN2 PICTURE S9. IC2154.2 +003200 01 DN3 PICTURE S9. IC2154.2 +003300 PROCEDURE DIVISION USING DN2, DN3. IC2154.2 +003400 CALL-TEST-2. IC2154.2 +003500 MOVE 1 TO DN2. IC2154.2 +003600 CANCEL-TEST-1. IC2154.2 +003700 CANCEL "IC214A". IC2154.2 +003800 MOVE 1 TO DN3. IC2154.2 +003900 IC215-EXIT. IC2154.2 +004000 EXIT PROGRAM. IC2154.2 +*END-OF,IC215A +*HEADER,COBOL,IC216A +000100 IDENTIFICATION DIVISION. IC2164.2 +000200 PROGRAM-ID. IC2164.2 +000300 IC216A. IC2164.2 +000400**************************************************************** IC2164.2 +000500* * IC2164.2 +000600* VALIDATION FOR:- * IC2164.2 +000700* * IC2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +000900* * IC2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2164.2 +001100* * IC2164.2 +001200**************************************************************** IC2164.2 +001300* * IC2164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2164.2 +001500* * IC2164.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2164.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2164.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2164.2 +001900* * IC2164.2 +002000**************************************************************** IC2164.2 +002100* THIS IS MAIN PROGRAM IC216. IC2164.2 +002200**************************************************************** IC2164.2 +002300 ENVIRONMENT DIVISION. IC2164.2 +002400 CONFIGURATION SECTION. IC2164.2 +002500 SOURCE-COMPUTER. IC2164.2 +002600 XXXXX082. IC2164.2 +002700 OBJECT-COMPUTER. IC2164.2 +002800 XXXXX083. IC2164.2 +002900 INPUT-OUTPUT SECTION. IC2164.2 +003000 FILE-CONTROL. IC2164.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2164.2 +003200 XXXXX055. IC2164.2 +003300 DATA DIVISION. IC2164.2 +003400 FILE SECTION. IC2164.2 +003500 FD PRINT-FILE. IC2164.2 +003600 01 PRINT-REC PICTURE X(120). IC2164.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2164.2 +003800 WORKING-STORAGE SECTION. IC2164.2 +003900 01 DN1. IC2164.2 +004000 02 DN2 PICTURE X(5). IC2164.2 +004100 02 DN3 REDEFINES DN2 PICTURE 9(5). IC2164.2 +004200 01 DN4. IC2164.2 +004300 02 DN5. IC2164.2 +004400 03 DN6 PICTURE X(3). IC2164.2 +004500 03 DN7 PICTURE X(3). IC2164.2 +004600 03 DN8 REDEFINES DN7 PICTURE 9(3). IC2164.2 +004700 02 DN9 PICTURE XX. IC2164.2 +004800 01 TEST-RESULTS. IC2164.2 +004900 02 FILLER PIC X VALUE SPACE. IC2164.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IC2164.2 +005100 02 FILLER PIC X VALUE SPACE. IC2164.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IC2164.2 +005300 02 FILLER PIC X VALUE SPACE. IC2164.2 +005400 02 PAR-NAME. IC2164.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IC2164.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IC2164.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IC2164.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IC2164.2 +005900 02 RE-MARK PIC X(61). IC2164.2 +006000 01 TEST-COMPUTED. IC2164.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IC2164.2 +006200 02 FILLER PIC X(17) VALUE IC2164.2 +006300 " COMPUTED=". IC2164.2 +006400 02 COMPUTED-X. IC2164.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2164.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IC2164.2 +006700 PIC -9(9).9(9). IC2164.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2164.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2164.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2164.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IC2164.2 +007200 04 COMPUTED-18V0 PIC -9(18). IC2164.2 +007300 04 FILLER PIC X. IC2164.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IC2164.2 +007500 01 TEST-CORRECT. IC2164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC2164.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IC2164.2 +007800 02 CORRECT-X. IC2164.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IC2164.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2164.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2164.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2164.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2164.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IC2164.2 +008500 04 CORRECT-18V0 PIC -9(18). IC2164.2 +008600 04 FILLER PIC X. IC2164.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IC2164.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2164.2 +008900 01 CCVS-C-1. IC2164.2 +009000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2164.2 +009100- "SS PARAGRAPH-NAME IC2164.2 +009200- " REMARKS". IC2164.2 +009300 02 FILLER PIC X(20) VALUE SPACE. IC2164.2 +009400 01 CCVS-C-2. IC2164.2 +009500 02 FILLER PIC X VALUE SPACE. IC2164.2 +009600 02 FILLER PIC X(6) VALUE "TESTED". IC2164.2 +009700 02 FILLER PIC X(15) VALUE SPACE. IC2164.2 +009800 02 FILLER PIC X(4) VALUE "FAIL". IC2164.2 +009900 02 FILLER PIC X(94) VALUE SPACE. IC2164.2 +010000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2164.2 +010100 01 REC-CT PIC 99 VALUE ZERO. IC2164.2 +010200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2164.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2164.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2164.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2164.2 +011000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2164.2 +011100 01 CCVS-H-1. IC2164.2 +011200 02 FILLER PIC X(39) VALUE SPACES. IC2164.2 +011300 02 FILLER PIC X(42) VALUE IC2164.2 +011400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2164.2 +011500 02 FILLER PIC X(39) VALUE SPACES. IC2164.2 +011600 01 CCVS-H-2A. IC2164.2 +011700 02 FILLER PIC X(40) VALUE SPACE. IC2164.2 +011800 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2164.2 +011900 02 FILLER PIC XXXX VALUE IC2164.2 +012000 "4.2 ". IC2164.2 +012100 02 FILLER PIC X(28) VALUE IC2164.2 +012200 " COPY - NOT FOR DISTRIBUTION". IC2164.2 +012300 02 FILLER PIC X(41) VALUE SPACE. IC2164.2 +012400 IC2164.2 +012500 01 CCVS-H-2B. IC2164.2 +012600 02 FILLER PIC X(15) VALUE IC2164.2 +012700 "TEST RESULT OF ". IC2164.2 +012800 02 TEST-ID PIC X(9). IC2164.2 +012900 02 FILLER PIC X(4) VALUE IC2164.2 +013000 " IN ". IC2164.2 +013100 02 FILLER PIC X(12) VALUE IC2164.2 +013200 " HIGH ". IC2164.2 +013300 02 FILLER PIC X(22) VALUE IC2164.2 +013400 " LEVEL VALIDATION FOR ". IC2164.2 +013500 02 FILLER PIC X(58) VALUE IC2164.2 +013600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +013700 01 CCVS-H-3. IC2164.2 +013800 02 FILLER PIC X(34) VALUE IC2164.2 +013900 " FOR OFFICIAL USE ONLY ". IC2164.2 +014000 02 FILLER PIC X(58) VALUE IC2164.2 +014100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2164.2 +014200 02 FILLER PIC X(28) VALUE IC2164.2 +014300 " COPYRIGHT 1985 ". IC2164.2 +014400 01 CCVS-E-1. IC2164.2 +014500 02 FILLER PIC X(52) VALUE SPACE. IC2164.2 +014600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2164.2 +014700 02 ID-AGAIN PIC X(9). IC2164.2 +014800 02 FILLER PIC X(45) VALUE SPACES. IC2164.2 +014900 01 CCVS-E-2. IC2164.2 +015000 02 FILLER PIC X(31) VALUE SPACE. IC2164.2 +015100 02 FILLER PIC X(21) VALUE SPACE. IC2164.2 +015200 02 CCVS-E-2-2. IC2164.2 +015300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2164.2 +015400 03 FILLER PIC X VALUE SPACE. IC2164.2 +015500 03 ENDER-DESC PIC X(44) VALUE IC2164.2 +015600 "ERRORS ENCOUNTERED". IC2164.2 +015700 01 CCVS-E-3. IC2164.2 +015800 02 FILLER PIC X(22) VALUE IC2164.2 +015900 " FOR OFFICIAL USE ONLY". IC2164.2 +016000 02 FILLER PIC X(12) VALUE SPACE. IC2164.2 +016100 02 FILLER PIC X(58) VALUE IC2164.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +016300 02 FILLER PIC X(13) VALUE SPACE. IC2164.2 +016400 02 FILLER PIC X(15) VALUE IC2164.2 +016500 " COPYRIGHT 1985". IC2164.2 +016600 01 CCVS-E-4. IC2164.2 +016700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2164.2 +016800 02 FILLER PIC X(4) VALUE " OF ". IC2164.2 +016900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2164.2 +017000 02 FILLER PIC X(40) VALUE IC2164.2 +017100 " TESTS WERE EXECUTED SUCCESSFULLY". IC2164.2 +017200 01 XXINFO. IC2164.2 +017300 02 FILLER PIC X(19) VALUE IC2164.2 +017400 "*** INFORMATION ***". IC2164.2 +017500 02 INFO-TEXT. IC2164.2 +017600 04 FILLER PIC X(8) VALUE SPACE. IC2164.2 +017700 04 XXCOMPUTED PIC X(20). IC2164.2 +017800 04 FILLER PIC X(5) VALUE SPACE. IC2164.2 +017900 04 XXCORRECT PIC X(20). IC2164.2 +018000 02 INF-ANSI-REFERENCE PIC X(48). IC2164.2 +018100 01 HYPHEN-LINE. IC2164.2 +018200 02 FILLER PIC IS X VALUE IS SPACE. IC2164.2 +018300 02 FILLER PIC IS X(65) VALUE IS "************************IC2164.2 +018400- "*****************************************". IC2164.2 +018500 02 FILLER PIC IS X(54) VALUE IS "************************IC2164.2 +018600- "******************************". IC2164.2 +018700 01 CCVS-PGM-ID PIC X(9) VALUE IC2164.2 +018800 "IC216A". IC2164.2 +018900 PROCEDURE DIVISION. IC2164.2 +019000 CCVS1 SECTION. IC2164.2 +019100 OPEN-FILES. IC2164.2 +019200 OPEN OUTPUT PRINT-FILE. IC2164.2 +019300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2164.2 +019400 MOVE SPACE TO TEST-RESULTS. IC2164.2 +019500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2164.2 +019600 GO TO CCVS1-EXIT. IC2164.2 +019700 CLOSE-FILES. IC2164.2 +019800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2164.2 +019900 TERMINATE-CCVS. IC2164.2 +020000S EXIT PROGRAM. IC2164.2 +020100STERMINATE-CALL. IC2164.2 +020200 STOP RUN. IC2164.2 +020300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2164.2 +020400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2164.2 +020500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2164.2 +020600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2164.2 +020700 MOVE "****TEST DELETED****" TO RE-MARK. IC2164.2 +020800 PRINT-DETAIL. IC2164.2 +020900 IF REC-CT NOT EQUAL TO ZERO IC2164.2 +021000 MOVE "." TO PARDOT-X IC2164.2 +021100 MOVE REC-CT TO DOTVALUE. IC2164.2 +021200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2164.2 +021300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2164.2 +021400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2164.2 +021500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2164.2 +021600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2164.2 +021700 MOVE SPACE TO CORRECT-X. IC2164.2 +021800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2164.2 +021900 MOVE SPACE TO RE-MARK. IC2164.2 +022000 HEAD-ROUTINE. IC2164.2 +022100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2164.2 +022400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2164.2 +022500 COLUMN-NAMES-ROUTINE. IC2164.2 +022600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +022700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +022900 END-ROUTINE. IC2164.2 +023000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2164.2 +023100 END-RTN-EXIT. IC2164.2 +023200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +023300 END-ROUTINE-1. IC2164.2 +023400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2164.2 +023500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2164.2 +023600 ADD PASS-COUNTER TO ERROR-HOLD. IC2164.2 +023700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2164.2 +023800 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2164.2 +023900 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2164.2 +024000 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2164.2 +024100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2164.2 +024200 END-ROUTINE-12. IC2164.2 +024300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2164.2 +024400 IF ERROR-COUNTER IS EQUAL TO ZERO IC2164.2 +024500 MOVE "NO " TO ERROR-TOTAL IC2164.2 +024600 ELSE IC2164.2 +024700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2164.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2164.2 +024900 PERFORM WRITE-LINE. IC2164.2 +025000 END-ROUTINE-13. IC2164.2 +025100 IF DELETE-COUNTER IS EQUAL TO ZERO IC2164.2 +025200 MOVE "NO " TO ERROR-TOTAL ELSE IC2164.2 +025300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2164.2 +025400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2164.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +025600 IF INSPECT-COUNTER EQUAL TO ZERO IC2164.2 +025700 MOVE "NO " TO ERROR-TOTAL IC2164.2 +025800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2164.2 +025900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2164.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +026100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +026200 WRITE-LINE. IC2164.2 +026300 ADD 1 TO RECORD-COUNT. IC2164.2 +026400Y IF RECORD-COUNT GREATER 50 IC2164.2 +026500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2164.2 +026600Y MOVE SPACE TO DUMMY-RECORD IC2164.2 +026700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2164.2 +026800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2164.2 +026900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2164.2 +027000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2164.2 +027100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2164.2 +027200Y MOVE ZERO TO RECORD-COUNT. IC2164.2 +027300 PERFORM WRT-LN. IC2164.2 +027400 WRT-LN. IC2164.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2164.2 +027600 MOVE SPACE TO DUMMY-RECORD. IC2164.2 +027700 BLANK-LINE-PRINT. IC2164.2 +027800 PERFORM WRT-LN. IC2164.2 +027900 FAIL-ROUTINE. IC2164.2 +028000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2164.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2164.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2164.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2164.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2164.2 +028600 GO TO FAIL-ROUTINE-EX. IC2164.2 +028700 FAIL-ROUTINE-WRITE. IC2164.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2164.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2164.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2164.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IC2164.2 +029200 FAIL-ROUTINE-EX. EXIT. IC2164.2 +029300 BAIL-OUT. IC2164.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2164.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2164.2 +029600 BAIL-OUT-WRITE. IC2164.2 +029700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2164.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2164.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC2164.2 +030100 BAIL-OUT-EX. EXIT. IC2164.2 +030200 CCVS1-EXIT. IC2164.2 +030300 EXIT. IC2164.2 +030400 CALL-TEST-1. IC2164.2 +030500 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2164.2 +030600 MOVE "CALL-TEST-1" TO PAR-NAME. IC2164.2 +030700 MOVE "REFERENCING REDEFINED DATA-NAMES" TO RE-MARK. IC2164.2 +030800 CALL "IC217A" USING DN1, DN4. IC2164.2 +030900 IF DN1 = 12345 IC2164.2 +031000 PERFORM PASS IC2164.2 +031100 GO TO CALL-WRITE-1. IC2164.2 +031200 CALL-FAIL-1. IC2164.2 +031300 MOVE DN1 TO COMPUTED-A. IC2164.2 +031400 MOVE 12345 TO CORRECT-A. IC2164.2 +031500 PERFORM FAIL. IC2164.2 +031600 CALL-WRITE-1. IC2164.2 +031700 PERFORM PRINT-DETAIL. IC2164.2 +031800 CALL-TEST-2. IC2164.2 +031900 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2164.2 +032000 MOVE "CALL-TEST-2" TO PAR-NAME. IC2164.2 +032100 MOVE "REFERENCING REDEFINED DATA-NAMES" TO RE-MARK. IC2164.2 +032200 IF DN4 = "YES987NO" IC2164.2 +032300 PERFORM PASS IC2164.2 +032400 GO TO CALL-WRITE-2. IC2164.2 +032500 CALL-FAIL-2. IC2164.2 +032600 MOVE DN4 TO COMPUTED-A. IC2164.2 +032700 MOVE "YES987NO" TO CORRECT-A. IC2164.2 +032800 PERFORM FAIL. IC2164.2 +032900 CALL-WRITE-2. IC2164.2 +033000 PERFORM PRINT-DETAIL. IC2164.2 +033100 CCVS-EXIT SECTION. IC2164.2 +033200 CCVS-999999. IC2164.2 +033300 GO TO CLOSE-FILES. IC2164.2 +*END-OF,IC216A +*HEADER,COBOL,IC216A,SUBRTN,IC217A +000100 IDENTIFICATION DIVISION. IC2174.2 +000200 PROGRAM-ID. IC2174.2 +000300 IC217A. IC2174.2 +000400**************************************************************** IC2174.2 +000500* * IC2174.2 +000600* VALIDATION FOR:- * IC2174.2 +000700* * IC2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2174.2 +000900* * IC2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2174.2 +001100* * IC2174.2 +001200**************************************************************** IC2174.2 +001300* * IC2174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2174.2 +001500* * IC2174.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2174.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2174.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2174.2 +001900* * IC2174.2 +002000**************************************************************** IC2174.2 +002100* THIS IS SUBPROGRAM IC217. IC2174.2 +002200**************************************************************** IC2174.2 +002300 ENVIRONMENT DIVISION. IC2174.2 +002400 CONFIGURATION SECTION. IC2174.2 +002500 SOURCE-COMPUTER. IC2174.2 +002600 XXXXX082. IC2174.2 +002700 OBJECT-COMPUTER. IC2174.2 +002800 XXXXX083. IC2174.2 +002900 DATA DIVISION. IC2174.2 +003000 LINKAGE SECTION. IC2174.2 +003100 01 DN1. IC2174.2 +003200 02 DN2 PICTURE X(5). IC2174.2 +003300 02 DN3 REDEFINES DN2 PICTURE 9(5). IC2174.2 +003400 01 DN4. IC2174.2 +003500 02 DN5. IC2174.2 +003600 03 DN6 PICTURE X(3). IC2174.2 +003700 03 DN7 PICTURE X(3). IC2174.2 +003800 03 DN8 REDEFINES DN7 PICTURE 9(3). IC2174.2 +003900 02 DN9 PICTURE XX. IC2174.2 +004000 PROCEDURE DIVISION USING DN1, DN4. IC2174.2 +004100 CALL-TEST-1. IC2174.2 +004200 MOVE 12345 TO DN3. IC2174.2 +004300 CALL-TEST-2. IC2174.2 +004400 MOVE "YES" TO DN6. IC2174.2 +004500 MOVE 987 TO DN8. IC2174.2 +004600 MOVE "NO" TO DN9. IC2174.2 +004700 IC217-EXIT. IC2174.2 +004800 EXIT PROGRAM. IC2174.2 +*END-OF,IC217A +*HEADER,COBOL,IC222A +000100 IDENTIFICATION DIVISION. IC2224.2 +000200 PROGRAM-ID. IC2224.2 +000300 IC222A. IC2224.2 +000400**************************************************************** IC2224.2 +000500* * IC2224.2 +000600* VALIDATION FOR:- * IC2224.2 +000700* * IC2224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +000900* * IC2224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +001100* * IC2224.2 +001200**************************************************************** IC2224.2 +001300* * IC2224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2224.2 +001500* * IC2224.2 +001600* X-55 SYSTEM PRINTER * IC2224.2 +001700* X-82 SOURCE-COMPUTER * IC2224.2 +001800* X-83 OBJECT-COMPUTER. * IC2224.2 +001900* * IC2224.2 +002000**************************************************************** IC2224.2 +002100* * IC2224.2 +002200* THE SOURCE FILE CONTAINS TWO PROGRAMS, IC222A AND * IC2224.2 +002300* IC222A-1, WHICH TEST LANGUAGE ELEMENTS FROM LEVEL 2 OF * IC2224.2 +002400* THE INTER-PROGRAM COMMUNICATION MODULE. THE LANGUAGE * IC2224.2 +002500* ELEMENTS TESTED ARE: * IC2224.2 +002600* "ON EXCEPTION" PHRASE * IC2224.2 +002700* "NOT ON EXCEPTION" PHRASE * IC2224.2 +002800* "END-CALL" PHRASE * IC2224.2 +002900* "ON OVERFLOW" PHRASE * IC2224.2 +003000* * IC2224.2 +003100* THE TWO PROGRAMS SHOULD BE COMPILED IN THE SAME * IC2224.2 +003200* INVOCATION OF THE COMPILER TO TEST THE BATCH COMPILATION * IC2224.2 +003300* FEATURE AND RECOGNITION OF THE END PROGRAM HEADER. THE * IC2224.2 +003400* ARRANGEMENT OF THE PROGRAMS IN THE SOURCE FILE IS: * IC2224.2 +003500* * IC2224.2 +003600* IDENTIFICATION DIVISION. * IC2224.2 +003700* PROGRAM-ID. IC222A. * IC2224.2 +003800* . * IC2224.2 +003900* . * IC2224.2 +004000* . * IC2224.2 +004100* END PROGRAM IC222A. IC2224.2 +004200* IDENTIFICATION DIVISION. IC2224.2 +004300* PROGRAM-ID. IC222A-1. IC2224.2 +004400* . * IC2224.2 +004500* . * IC2224.2 +004600* . * IC2224.2 +004700* * IC2224.2 +004800* IC222A, THE FIRST PROGRAM IN THE FILE, CONTAINS THE * IC2224.2 +004900* SUBSTANTIVE TESTS. THE ONLY FUNCTION OF THE OTHER * IC2224.2 +005000* PROGRAM IS TO ENSURE THAT A PROGRAM WITH KNOWN PARAMETER * IC2224.2 +005100* REQUIREMENTS IS AVAILABLE TO BE CALLED. IC222A TESTS * IC2224.2 +005200* CONTROL FLOW THROUGH VARIANTS OF THE CALL STATEMENT WITH * IC2224.2 +005300* THE "ON EXCEPTION" PHRASE PRESENT OR ABSENT; THE "NOT ON * IC2224.2 +005400* EXCEPTION" PHRASE PRESENT OR ABSENT; AND AVAILABLE OR * IC2224.2 +005500* NON-AVAIABLE TARGET PROGRAMS. EACH CALL STATEMENT HAS AN * IC2224.2 +005600* END-CALL PHRASE, AND THERE ARE SECONDARY TESTS WHICH * IC2224.2 +005700* CHECK THAT STATEMENTS FOLLOWING END-CALL ARE PROPERLY * IC2224.2 +005800* EXECUTED. * IC2224.2 +005900* IC2224.2 +006000* THIS TEST SET DOES NOT EXAMINE THE RESULTS RETURNED BY * IC2224.2 +006100* THE CALLED PROGRAM, BUT IS WHOLLY CONCERNED WITH THE FLOW * IC2224.2 +006200* OF CONTROL IN THE CALLING PROGRAM DURING EXECUTION OF A * IC2224.2 +006300* CALL STATEMENT. * IC2224.2 +006400* * IC2224.2 +006500* THERE ARE EIGHT POSIBLE COMBINATIONS OF CALL STATEMENT * IC2224.2 +006600* FORMAT AND CALLED PROGRAM AVAILABILITY THAT COULD BE * IC2224.2 +006700* TESTED. TWO OF THESE COMBINATIONS, THOSE WHERE A PROGRAM * IC2224.2 +006800* WHICH IS NOT AVAILABLE IS CALLED THROUGH A STATEMENT * IC2224.2 +006900* WHICH DOES NOT CONTAIN AN "ON EXCEPTION" PHRASE, PRODUCE * IC2224.2 +007000* EFFECTS WHICH THE STANDARD LEAVES UNDEFINED. THUS THERE * IC2224.2 +007100* ARE SIX CASES WHICH CAN BE TESTED. THIS TEST SUITE TESTS * IC2224.2 +007200* ALL SIX. IN ADDITION, IT TESTS THE TWO CASES WHERE * IC2224.2 +007300* "ON OVERFLOW" CAN BE USED IN PLACE OF "ON EXCEPTION". * IC2224.2 +007400* EACH OF THE EIGHT MAJOR TESTS IS FOLLOWED BY A * IC2224.2 +007500* SUBORDINATE TEST WHICH IS INTENDED TO CHECK THE WAY * IC2224.2 +007600* THAT CONTROL HAS FLOWED THROUGH THE PHRASES OF THE CALL * IC2224.2 +007700* STATEMENT. EVERY CALL STATEMENT IN IC222A HAS AN * IC2224.2 +007800* "END-CALL" SCOPE DELIMITER. THIS SCOPE DELIMITER IS * IC2224.2 +007900* FOLLOWED BY ONE MORE STATEMENT IN THE SENTENCE, AND THE * IC2224.2 +008000* SUBORDINATE TESTS CHECK THAT THIS ADDITIONAL STATEMENT * IC2224.2 +008100* HAS BEEN EXECUTED. * IC2224.2 +008200* * IC2224.2 +008300**************************************************************** IC2224.2 +008400* IC2224.2 +008500 ENVIRONMENT DIVISION. IC2224.2 +008600 CONFIGURATION SECTION. IC2224.2 +008700 SOURCE-COMPUTER. IC2224.2 +008800 XXXXX082. IC2224.2 +008900 OBJECT-COMPUTER. IC2224.2 +009000 XXXXX083. IC2224.2 +009100 INPUT-OUTPUT SECTION. IC2224.2 +009200 FILE-CONTROL. IC2224.2 +009300 SELECT PRINT-FILE ASSIGN TO IC2224.2 +009400 XXXXX055. IC2224.2 +009500* IC2224.2 +009600 DATA DIVISION. IC2224.2 +009700 FILE SECTION. IC2224.2 +009800 FD PRINT-FILE. IC2224.2 +009900 01 PRINT-REC PICTURE X(120). IC2224.2 +010000 01 DUMMY-RECORD PICTURE X(120). IC2224.2 +010100* IC2224.2 +010200 WORKING-STORAGE SECTION. IC2224.2 +010300 77 DN1 PICTURE S99 VALUE ZERO. IC2224.2 +010400 77 DN3 PICTURE S99. IC2224.2 +010500 77 ID1 PICTURE X(8) VALUE "IC222A-1". IC2224.2 +010600 77 ID2 PICTURE X(8). IC2224.2 +010700 77 DN2 PICTURE S99 IC2224.2 +010800 USAGE COMPUTATIONAL, VALUE ZERO. IC2224.2 +010900 77 DN4 PICTURE S99 IC2224.2 +011000 USAGE IS COMPUTATIONAL. IC2224.2 +011100 77 CALL-FLAG PIC 9. IC2224.2 +011200 01 EXCEPTION-PATH-FLAG PICTURE X. IC2224.2 +011300* IC2224.2 +011400 01 TEST-RESULTS. IC2224.2 +011500 02 FILLER PIC X VALUE SPACE. IC2224.2 +011600 02 FEATURE PIC X(20) VALUE SPACE. IC2224.2 +011700 02 FILLER PIC X VALUE SPACE. IC2224.2 +011800 02 P-OR-F PIC X(5) VALUE SPACE. IC2224.2 +011900 02 FILLER PIC X VALUE SPACE. IC2224.2 +012000 02 PAR-NAME. IC2224.2 +012100 03 FILLER PIC X(19) VALUE SPACE. IC2224.2 +012200 03 PARDOT-X PIC X VALUE SPACE. IC2224.2 +012300 03 DOTVALUE PIC 99 VALUE ZERO. IC2224.2 +012400 02 FILLER PIC X(8) VALUE SPACE. IC2224.2 +012500 02 RE-MARK PIC X(61). IC2224.2 +012600 01 TEST-COMPUTED. IC2224.2 +012700 02 FILLER PIC X(30) VALUE SPACE. IC2224.2 +012800 02 FILLER PIC X(17) VALUE IC2224.2 +012900 " COMPUTED=". IC2224.2 +013000 02 COMPUTED-X. IC2224.2 +013100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2224.2 +013200 03 COMPUTED-N REDEFINES COMPUTED-A IC2224.2 +013300 PIC -9(9).9(9). IC2224.2 +013400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2224.2 +013500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2224.2 +013600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2224.2 +013700 03 CM-18V0 REDEFINES COMPUTED-A. IC2224.2 +013800 04 COMPUTED-18V0 PIC -9(18). IC2224.2 +013900 04 FILLER PIC X. IC2224.2 +014000 03 FILLER PIC X(50) VALUE SPACE. IC2224.2 +014100 01 TEST-CORRECT. IC2224.2 +014200 02 FILLER PIC X(30) VALUE SPACE. IC2224.2 +014300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2224.2 +014400 02 CORRECT-X. IC2224.2 +014500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2224.2 +014600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2224.2 +014700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2224.2 +014800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2224.2 +014900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2224.2 +015000 03 CR-18V0 REDEFINES CORRECT-A. IC2224.2 +015100 04 CORRECT-18V0 PIC -9(18). IC2224.2 +015200 04 FILLER PIC X. IC2224.2 +015300 03 FILLER PIC X(2) VALUE SPACE. IC2224.2 +015400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2224.2 +015500 01 CCVS-C-1. IC2224.2 +015600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2224.2 +015700- "SS PARAGRAPH-NAME IC2224.2 +015800- " REMARKS". IC2224.2 +015900 02 FILLER PIC X(20) VALUE SPACE. IC2224.2 +016000 01 CCVS-C-2. IC2224.2 +016100 02 FILLER PIC X VALUE SPACE. IC2224.2 +016200 02 FILLER PIC X(6) VALUE "TESTED". IC2224.2 +016300 02 FILLER PIC X(15) VALUE SPACE. IC2224.2 +016400 02 FILLER PIC X(4) VALUE "FAIL". IC2224.2 +016500 02 FILLER PIC X(94) VALUE SPACE. IC2224.2 +016600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2224.2 +016700 01 REC-CT PIC 99 VALUE ZERO. IC2224.2 +016800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2224.2 +016900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2224.2 +017300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2224.2 +017400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2224.2 +017500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2224.2 +017600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2224.2 +017700 01 CCVS-H-1. IC2224.2 +017800 02 FILLER PIC X(39) VALUE SPACES. IC2224.2 +017900 02 FILLER PIC X(42) VALUE IC2224.2 +018000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2224.2 +018100 02 FILLER PIC X(39) VALUE SPACES. IC2224.2 +018200 01 CCVS-H-2A. IC2224.2 +018300 02 FILLER PIC X(40) VALUE SPACE. IC2224.2 +018400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2224.2 +018500 02 FILLER PIC XXXX VALUE IC2224.2 +018600 "4.2 ". IC2224.2 +018700 02 FILLER PIC X(28) VALUE IC2224.2 +018800 " COPY - NOT FOR DISTRIBUTION". IC2224.2 +018900 02 FILLER PIC X(41) VALUE SPACE. IC2224.2 +019000 IC2224.2 +019100 01 CCVS-H-2B. IC2224.2 +019200 02 FILLER PIC X(15) VALUE IC2224.2 +019300 "TEST RESULT OF ". IC2224.2 +019400 02 TEST-ID PIC X(9). IC2224.2 +019500 02 FILLER PIC X(4) VALUE IC2224.2 +019600 " IN ". IC2224.2 +019700 02 FILLER PIC X(12) VALUE IC2224.2 +019800 " HIGH ". IC2224.2 +019900 02 FILLER PIC X(22) VALUE IC2224.2 +020000 " LEVEL VALIDATION FOR ". IC2224.2 +020100 02 FILLER PIC X(58) VALUE IC2224.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +020300 01 CCVS-H-3. IC2224.2 +020400 02 FILLER PIC X(34) VALUE IC2224.2 +020500 " FOR OFFICIAL USE ONLY ". IC2224.2 +020600 02 FILLER PIC X(58) VALUE IC2224.2 +020700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +020800 02 FILLER PIC X(28) VALUE IC2224.2 +020900 " COPYRIGHT 1985,1986 ". IC2224.2 +021000 01 CCVS-E-1. IC2224.2 +021100 02 FILLER PIC X(52) VALUE SPACE. IC2224.2 +021200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2224.2 +021300 02 ID-AGAIN PIC X(9). IC2224.2 +021400 02 FILLER PIC X(45) VALUE SPACES. IC2224.2 +021500 01 CCVS-E-2. IC2224.2 +021600 02 FILLER PIC X(31) VALUE SPACE. IC2224.2 +021700 02 FILLER PIC X(21) VALUE SPACE. IC2224.2 +021800 02 CCVS-E-2-2. IC2224.2 +021900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2224.2 +022000 03 FILLER PIC X VALUE SPACE. IC2224.2 +022100 03 ENDER-DESC PIC X(44) VALUE IC2224.2 +022200 "ERRORS ENCOUNTERED". IC2224.2 +022300 01 CCVS-E-3. IC2224.2 +022400 02 FILLER PIC X(22) VALUE IC2224.2 +022500 " FOR OFFICIAL USE ONLY". IC2224.2 +022600 02 FILLER PIC X(12) VALUE SPACE. IC2224.2 +022700 02 FILLER PIC X(58) VALUE IC2224.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IC2224.2 +023000 02 FILLER PIC X(20) VALUE IC2224.2 +023100 " COPYRIGHT 1985,1986". IC2224.2 +023200 01 CCVS-E-4. IC2224.2 +023300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2224.2 +023400 02 FILLER PIC X(4) VALUE " OF ". IC2224.2 +023500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2224.2 +023600 02 FILLER PIC X(40) VALUE IC2224.2 +023700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2224.2 +023800 01 XXINFO. IC2224.2 +023900 02 FILLER PIC X(19) VALUE IC2224.2 +024000 "*** INFORMATION ***". IC2224.2 +024100 02 INFO-TEXT. IC2224.2 +024200 04 FILLER PIC X(8) VALUE SPACE. IC2224.2 +024300 04 XXCOMPUTED PIC X(20). IC2224.2 +024400 04 FILLER PIC X(5) VALUE SPACE. IC2224.2 +024500 04 XXCORRECT PIC X(20). IC2224.2 +024600 02 INF-ANSI-REFERENCE PIC X(48). IC2224.2 +024700 01 HYPHEN-LINE. IC2224.2 +024800 02 FILLER PIC IS X VALUE IS SPACE. IC2224.2 +024900 02 FILLER PIC IS X(65) VALUE IS "************************IC2224.2 +025000- "*****************************************". IC2224.2 +025100 02 FILLER PIC IS X(54) VALUE IS "************************IC2224.2 +025200- "******************************". IC2224.2 +025300 01 CCVS-PGM-ID PIC X(9) VALUE IC2224.2 +025400 "IC222A". IC2224.2 +025500* IC2224.2 +025600 PROCEDURE DIVISION. IC2224.2 +025700 CCVS1 SECTION. IC2224.2 +025800 OPEN-FILES. IC2224.2 +025900 OPEN OUTPUT PRINT-FILE. IC2224.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2224.2 +026100 MOVE SPACE TO TEST-RESULTS. IC2224.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2224.2 +026300 GO TO CCVS1-EXIT. IC2224.2 +026400 CLOSE-FILES. IC2224.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2224.2 +026600 TERMINATE-CCVS. IC2224.2 +026700S EXIT PROGRAM. IC2224.2 +026800STERMINATE-CALL. IC2224.2 +026900 STOP RUN. IC2224.2 +027000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2224.2 +027100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2224.2 +027200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2224.2 +027300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2224.2 +027400 MOVE "****TEST DELETED****" TO RE-MARK. IC2224.2 +027500 PRINT-DETAIL. IC2224.2 +027600 IF REC-CT NOT EQUAL TO ZERO IC2224.2 +027700 MOVE "." TO PARDOT-X IC2224.2 +027800 MOVE REC-CT TO DOTVALUE. IC2224.2 +027900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2224.2 +028000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2224.2 +028100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2224.2 +028200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2224.2 +028300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2224.2 +028400 MOVE SPACE TO CORRECT-X. IC2224.2 +028500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2224.2 +028600 MOVE SPACE TO RE-MARK. IC2224.2 +028700 HEAD-ROUTINE. IC2224.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2224.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2224.2 +029200 COLUMN-NAMES-ROUTINE. IC2224.2 +029300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +029400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +029600 END-ROUTINE. IC2224.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2224.2 +029800 END-RTN-EXIT. IC2224.2 +029900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +030000 END-ROUTINE-1. IC2224.2 +030100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2224.2 +030200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2224.2 +030300 ADD PASS-COUNTER TO ERROR-HOLD. IC2224.2 +030400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2224.2 +030500 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2224.2 +030600 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2224.2 +030700 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2224.2 +030800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2224.2 +030900 END-ROUTINE-12. IC2224.2 +031000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2224.2 +031100 IF ERROR-COUNTER IS EQUAL TO ZERO IC2224.2 +031200 MOVE "NO " TO ERROR-TOTAL IC2224.2 +031300 ELSE IC2224.2 +031400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2224.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2224.2 +031600 PERFORM WRITE-LINE. IC2224.2 +031700 END-ROUTINE-13. IC2224.2 +031800 IF DELETE-COUNTER IS EQUAL TO ZERO IC2224.2 +031900 MOVE "NO " TO ERROR-TOTAL ELSE IC2224.2 +032000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2224.2 +032100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2224.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032300 IF INSPECT-COUNTER EQUAL TO ZERO IC2224.2 +032400 MOVE "NO " TO ERROR-TOTAL IC2224.2 +032500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2224.2 +032600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2224.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032900 WRITE-LINE. IC2224.2 +033000 ADD 1 TO RECORD-COUNT. IC2224.2 +033100Y IF RECORD-COUNT GREATER 50 IC2224.2 +033200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2224.2 +033300Y MOVE SPACE TO DUMMY-RECORD IC2224.2 +033400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2224.2 +033500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2224.2 +033600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2224.2 +033700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2224.2 +033800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2224.2 +033900Y MOVE ZERO TO RECORD-COUNT. IC2224.2 +034000 PERFORM WRT-LN. IC2224.2 +034100 WRT-LN. IC2224.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2224.2 +034300 MOVE SPACE TO DUMMY-RECORD. IC2224.2 +034400 BLANK-LINE-PRINT. IC2224.2 +034500 PERFORM WRT-LN. IC2224.2 +034600 FAIL-ROUTINE. IC2224.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2224.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2224.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2224.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2224.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. IC2224.2 +035300 GO TO FAIL-ROUTINE-EX. IC2224.2 +035400 FAIL-ROUTINE-WRITE. IC2224.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2224.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2224.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2224.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. IC2224.2 +035900 FAIL-ROUTINE-EX. EXIT. IC2224.2 +036000 BAIL-OUT. IC2224.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2224.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2224.2 +036300 BAIL-OUT-WRITE. IC2224.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2224.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2224.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. IC2224.2 +036800 BAIL-OUT-EX. EXIT. IC2224.2 +036900 CCVS1-EXIT. IC2224.2 +037000 EXIT. IC2224.2 +037100* IC2224.2 +037200 SECT-IC222A-001 SECTION. IC2224.2 +037300 CALL-INIT-1. IC2224.2 +037400**************************************************************** IC2224.2 +037500* * IC2224.2 +037600* CALL A PROGRAM WHICH EXISTS AND FOR WHICH PARAMETERS * IC2224.2 +037700* MATCH IN NUMBER AND TYPE. EXECUTION SHOULD BE SUCCESSFUL * IC2224.2 +037800* AND THE STATEMENTS IN THE "ON EXCEPTION" PATH IGNORED. * IC2224.2 +037900* THE STATEMENT FOLLOWING THE SCOPE TERMINATOR SHOULD BE * IC2224.2 +038000* EXECUTED. * IC2224.2 +038100* * IC2224.2 +038200**************************************************************** IC2224.2 +038300* IC2224.2 +038400 MOVE 1 TO REC-CT. IC2224.2 +038500 MOVE "CALL-TEST-1" TO PAR-NAME. IC2224.2 +038600 MOVE "AVAILABLE ON " TO FEATURE. IC2224.2 +038700 MOVE 0 TO CALL-FLAG. IC2224.2 +038800 MOVE "P" TO EXCEPTION-PATH-FLAG. IC2224.2 +038900 MOVE "X-27 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +039000 MOVE ZERO TO DN3, DN4. IC2224.2 +039100 GO TO CALL-TEST-1-1. IC2224.2 +039200 CALL-DELETE-1-1. IC2224.2 +039300 PERFORM DE-LETE. IC2224.2 +039400 PERFORM PRINT-DETAIL. IC2224.2 +039500 ADD 1 TO REC-CT. IC2224.2 +039600* IC2224.2 +039700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE IS * IC2224.2 +039800* AUTOMATICALLY DELETED. * IC2224.2 +039900* IC2224.2 +040000 GO TO CALL-DELETE-1-2. IC2224.2 +040100 CALL-TEST-1-1. IC2224.2 +040200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +040300 ON EXCEPTION IC2224.2 +040400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +040500 END-CALL IC2224.2 +040600 MOVE 1 TO CALL-FLAG. IC2224.2 +040700 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +040800 MOVE "UNEXPECTED EXECUTION OF EXCEPTION PATH" IC2224.2 +040900 TO RE-MARK IC2224.2 +041000 MOVE "P" TO CORRECT-A IC2224.2 +041100 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +041200 PERFORM FAIL IC2224.2 +041300 ELSE IC2224.2 +041400 PERFORM PASS. IC2224.2 +041500 CALL-WRITE-1-1. IC2224.2 +041600 PERFORM PRINT-DETAIL. IC2224.2 +041700 ADD 1 TO REC-CT. IC2224.2 +041800* IC2224.2 +041900 CALL-INIT-1-2. IC2224.2 +042000 GO TO CALL-TEST-1-2. IC2224.2 +042100 CALL-DELETE-1-2. IC2224.2 +042200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +042300 PERFORM DE-LETE. IC2224.2 +042400 PERFORM PRINT-DETAIL. IC2224.2 +042500 ADD 1 TO REC-CT. IC2224.2 +042600 GO TO CALL-EXIT-1. IC2224.2 +042700* IC2224.2 +042800 CALL-TEST-1-2. IC2224.2 +042900**************************************************************** IC2224.2 +043000* * IC2224.2 +043100* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +043200* WAS EXECUTED. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +043300* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +043400* CORRECTLY. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +043500* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +043600* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +043700* * IC2224.2 +043800**************************************************************** IC2224.2 +043900* IC2224.2 +044000 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +044100 IF CALL-FLAG = 1 IC2224.2 +044200 PERFORM PASS IC2224.2 +044300 ELSE IC2224.2 +044400 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +044500 MOVE 1 TO CORRECT-N IC2224.2 +044600 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +044700 PERFORM FAIL. IC2224.2 +044800 PERFORM PRINT-DETAIL. IC2224.2 +044900* IC2224.2 +045000 CALL-EXIT-1. IC2224.2 +045100* IC2224.2 +045200* IC2224.2 +045300 CALL-INIT-2. IC2224.2 +045400**************************************************************** IC2224.2 +045500* * IC2224.2 +045600* CALL A PROGRAM WHICH DOES NOT EXIST. PAGE X-28, 5.2.4, * IC2224.2 +045700* RULE (3)A STATES THAT IF A PROGRAM CANNOT BE MADE * IC2224.2 +045800* AVAILABLE THEN THE STATEMENTS IN THE "ON EXCEPTION" * IC2224.2 +045900* PHRASE MUST BE EXECUTED. * IC2224.2 +046000* * IC2224.2 +046100**************************************************************** IC2224.2 +046200* IC2224.2 +046300 MOVE 1 TO REC-CT. IC2224.2 +046400 MOVE "CALL-TEST-2" TO PAR-NAME. IC2224.2 +046500 MOVE "NO PROGRAM ON " TO FEATURE. IC2224.2 +046600 MOVE 0 TO CALL-FLAG. IC2224.2 +046700 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +046800 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +046900 MOVE ZERO TO DN3, DN4. IC2224.2 +047000 GO TO CALL-TEST-2-1. IC2224.2 +047100 CALL-DELETE-2-1. IC2224.2 +047200 PERFORM DE-LETE. IC2224.2 +047300 PERFORM PRINT-DETAIL. IC2224.2 +047400 ADD 1 TO REC-CT. IC2224.2 +047500* IC2224.2 +047600* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +047700* AUTOMATICALLY DELETED. * IC2224.2 +047800* IC2224.2 +047900 GO TO CALL-DELETE-2-2. IC2224.2 +048000 CALL-TEST-2-1. IC2224.2 +048100* CALL "NON-EXISTING-PROGRAM" IC2224.2 +048200 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +048300 ON EXCEPTION IC2224.2 +048400 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +048500 END-CALL IC2224.2 +048600 MOVE 1 TO CALL-FLAG. IC2224.2 +048700 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +048800 MOVE "EXCEPTION SHOULD HAVE OCCURRED" TO RE-MARK IC2224.2 +048900 MOVE "P" TO CORRECT-A IC2224.2 +049000 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +049100 PERFORM FAIL IC2224.2 +049200 ELSE IC2224.2 +049300 PERFORM PASS. IC2224.2 +049400 CALL-WRITE-2-1. IC2224.2 +049500 PERFORM PRINT-DETAIL. IC2224.2 +049600 ADD 1 TO REC-CT. IC2224.2 +049700* IC2224.2 +049800 CALL-INIT-2-2. IC2224.2 +049900 GO TO CALL-TEST-2-2. IC2224.2 +050000 CALL-DELETE-2-2. IC2224.2 +050100 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +050200 PERFORM DE-LETE. IC2224.2 +050300 PERFORM PRINT-DETAIL. IC2224.2 +050400 ADD 1 TO REC-CT. IC2224.2 +050500 GO TO CALL-EXIT-2. IC2224.2 +050600* IC2224.2 +050700 CALL-TEST-2-2. IC2224.2 +050800**************************************************************** IC2224.2 +050900* * IC2224.2 +051000* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +051100* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +051200* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +051300* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +051400* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +051500* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +051600* * IC2224.2 +051700**************************************************************** IC2224.2 +051800* IC2224.2 +051900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +052000 IF CALL-FLAG = 1 IC2224.2 +052100 PERFORM PASS IC2224.2 +052200 ELSE IC2224.2 +052300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +052400 MOVE 1 TO CORRECT-N IC2224.2 +052500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +052600 PERFORM FAIL. IC2224.2 +052700 PERFORM PRINT-DETAIL. IC2224.2 +052800* IC2224.2 +052900 CALL-EXIT-2. IC2224.2 +053000* IC2224.2 +053100* IC2224.2 +053200 CALL-INIT-3. IC2224.2 +053300**************************************************************** IC2224.2 +053400* * IC2224.2 +053500* CALL A PROGRAM WHICH EXISTS, USING A CALL STATEMENT WITH * IC2224.2 +053600* BOTH AN "ON EXCEPTION" PHRASE AND A "NOT ON EXCEPTION" * IC2224.2 +053700* PHRASE. EXECUTION SHOULD BE SUCCESSFUL, THE * IC2224.2 +053800* "ON EXCEPTION" PHRASE IGNORED, AND THE STATEMENTS IN THE * IC2224.2 +053900* "NOT ON EXCEPTION" PHRASE EXECUTED. THE STATEMENT * IC2224.2 +054000* FOLLOWING THE SCOPE TERMINATOR SHOULD BE EXECUTED. * IC2224.2 +054100* * IC2224.2 +054200**************************************************************** IC2224.2 +054300* IC2224.2 +054400 MOVE 1 TO REC-CT. IC2224.2 +054500 MOVE "CALL-TEST-3" TO PAR-NAME. IC2224.2 +054600 MOVE "AVAILABLE ON NOT ON" TO FEATURE. IC2224.2 +054700 MOVE 0 TO CALL-FLAG. IC2224.2 +054800 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +054900 MOVE "X-28 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +055000 MOVE ZERO TO DN3, DN4. IC2224.2 +055100 GO TO CALL-TEST-3-1. IC2224.2 +055200 CALL-DELETE-3-1. IC2224.2 +055300 PERFORM DE-LETE. IC2224.2 +055400 PERFORM PRINT-DETAIL. IC2224.2 +055500 ADD 1 TO REC-CT. IC2224.2 +055600* IC2224.2 +055700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +055800* AUTOMATICALLY DELETED. * IC2224.2 +055900* IC2224.2 +056000 GO TO CALL-DELETE-3-2. IC2224.2 +056100 CALL-TEST-3-1. IC2224.2 +056200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +056300 ON EXCEPTION IC2224.2 +056400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +056500 ADD 2 TO CALL-FLAG IC2224.2 +056600 NOT ON EXCEPTION IC2224.2 +056700 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +056800 ADD 2 TO CALL-FLAG IC2224.2 +056900 END-CALL IC2224.2 +057000 ADD 1 TO CALL-FLAG. IC2224.2 +057100 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +057200 MOVE "NON-EXECUTION OF NOT EXCEPTION PATH" IC2224.2 +057300 TO RE-MARK IC2224.2 +057400 MOVE "P" TO CORRECT-A IC2224.2 +057500 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +057600 PERFORM FAIL IC2224.2 +057700 ELSE IC2224.2 +057800 PERFORM PASS. IC2224.2 +057900 CALL-WRITE-3-1. IC2224.2 +058000 PERFORM PRINT-DETAIL. IC2224.2 +058100 ADD 1 TO REC-CT. IC2224.2 +058200* IC2224.2 +058300 CALL-INIT-3-2. IC2224.2 +058400 GO TO CALL-TEST-3-2. IC2224.2 +058500 CALL-DELETE-3-2. IC2224.2 +058600 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +058700 PERFORM DE-LETE. IC2224.2 +058800 PERFORM PRINT-DETAIL. IC2224.2 +058900 ADD 1 TO REC-CT. IC2224.2 +059000 GO TO CALL-EXIT-3. IC2224.2 +059100* IC2224.2 +059200 CALL-TEST-3-2. IC2224.2 +059300**************************************************************** IC2224.2 +059400* * IC2224.2 +059500* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +059600* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +059700* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +059800* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +059900* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +060000* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +060100* * IC2224.2 +060200**************************************************************** IC2224.2 +060300* IC2224.2 +060400 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +060500 IF CALL-FLAG = 3 IC2224.2 +060600 PERFORM PASS IC2224.2 +060700 ELSE IC2224.2 +060800 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +060900 MOVE 3 TO CORRECT-N IC2224.2 +061000 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +061100 PERFORM FAIL. IC2224.2 +061200 PERFORM PRINT-DETAIL. IC2224.2 +061300* IC2224.2 +061400 CALL-EXIT-3. IC2224.2 +061500* IC2224.2 +061600* IC2224.2 +061700 CALL-INIT-4. IC2224.2 +061800**************************************************************** IC2224.2 +061900* * IC2224.2 +062000* CALL A PROGRAM WHICH IS NOT AVAILABLE FOR EXECUTION, * IC2224.2 +062100* USING A CALL STATEMENT WITH BOTH AN "ON EXCEPTION" PHRASE * IC2224.2 +062200* AND A "NOT ON EXCEPTION" PHRASE. EXECUTION SHOULD BE * IC2224.2 +062300* UNSUCCESSFUL, THE STATEMENTS IN THE "ON EXCEPTION" PHRASE * IC2224.2 +062400* EXECUTED, AND THE STATEMENTS IN THE "NOT ON EXCEPTION" * IC2224.2 +062500* PHRASE IGNORED. THE STATEMENT FOLLOWING THE SCOPE * IC2224.2 +062600* TERMINATOR SHOULD BE EXECUTED IN EITHER CASE. * IC2224.2 +062700* * IC2224.2 +062800**************************************************************** IC2224.2 +062900* IC2224.2 +063000 MOVE 1 TO REC-CT. IC2224.2 +063100 MOVE "CALL-TEST-4" TO PAR-NAME. IC2224.2 +063200 MOVE "CALL ON EXCEPTION" TO FEATURE. IC2224.2 +063300 MOVE 0 TO CALL-FLAG. IC2224.2 +063400 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +063500 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +063600 MOVE ZERO TO DN3, DN4. IC2224.2 +063700 GO TO CALL-TEST-4-1. IC2224.2 +063800 CALL-DELETE-4-1. IC2224.2 +063900 PERFORM DE-LETE. IC2224.2 +064000 PERFORM PRINT-DETAIL. IC2224.2 +064100 ADD 1 TO REC-CT. IC2224.2 +064200* IC2224.2 +064300* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +064400* AUTOMATICALLY DELETED. * IC2224.2 +064500* IC2224.2 +064600 GO TO CALL-DELETE-4-2. IC2224.2 +064700 CALL-TEST-4-1. IC2224.2 +064800* CALL "NON-EXISTENT PROGRAM" IC2224.2 +064900 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +065000 ON EXCEPTION IC2224.2 +065100 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +065200 ADD 2 TO CALL-FLAG IC2224.2 +065300 NOT ON EXCEPTION IC2224.2 +065400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +065500 ADD 2 TO CALL-FLAG IC2224.2 +065600 END-CALL IC2224.2 +065700 ADD 1 TO CALL-FLAG. IC2224.2 +065800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +065900 MOVE "NON-EXECUTION OF EXCEPTION PATH" IC2224.2 +066000 TO RE-MARK IC2224.2 +066100 MOVE "P" TO CORRECT-A IC2224.2 +066200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +066300 PERFORM FAIL IC2224.2 +066400 ELSE IC2224.2 +066500 PERFORM PASS. IC2224.2 +066600 CALL-WRITE-4-1. IC2224.2 +066700 PERFORM PRINT-DETAIL. IC2224.2 +066800 ADD 1 TO REC-CT. IC2224.2 +066900* IC2224.2 +067000 CALL-INIT-4-2. IC2224.2 +067100 GO TO CALL-TEST-4-2. IC2224.2 +067200 CALL-DELETE-4-2. IC2224.2 +067300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +067400 PERFORM DE-LETE. IC2224.2 +067500 PERFORM PRINT-DETAIL. IC2224.2 +067600 ADD 1 TO REC-CT. IC2224.2 +067700 GO TO CALL-EXIT-4. IC2224.2 +067800* IC2224.2 +067900 CALL-TEST-4-2. IC2224.2 +068000**************************************************************** IC2224.2 +068100* * IC2224.2 +068200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +068300* WAS EXECUTED. A PASS HERE ALSO INDICATES THAT ONE AND * IC2224.2 +068400* ONLY ONE OF THE "ON EXCEPTION" AND "NOT ON EXCEPTION" * IC2224.2 +068500* PHRASES OF THE PRECEDING CALL STATEMENT WAS EXECUTED. * IC2224.2 +068600* * IC2224.2 +068700**************************************************************** IC2224.2 +068800* IC2224.2 +068900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +069000 IF CALL-FLAG = 3 IC2224.2 +069100 PERFORM PASS IC2224.2 +069200 ELSE IC2224.2 +069300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +069400 MOVE 3 TO CORRECT-N IC2224.2 +069500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +069600 PERFORM FAIL. IC2224.2 +069700 PERFORM PRINT-DETAIL. IC2224.2 +069800* IC2224.2 +069900 CALL-EXIT-4. IC2224.2 +070000* IC2224.2 +070100* IC2224.2 +070200 CALL-INIT-5. IC2224.2 +070300**************************************************************** IC2224.2 +070400* * IC2224.2 +070500* CALL A PROGRAM WHICH IS AVAILABLE FOR EXECUTION, USING A * IC2224.2 +070600* CALL STATEMENT WITH A "NOT ON EXCEPTION" PHRASE BUT NO * IC2224.2 +070700* "ON EXCEPTION" PHRASE. EXECUTION SHOULD BE SUCCESSFUL, * IC2224.2 +070800* AND THE STATEMENTS IN THE "NOT ON EXCEPTION" PHRASE * IC2224.2 +070900* EXECUTED. THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +071000* SHOULD ALSO BE EXECUTED. * IC2224.2 +071100* * IC2224.2 +071200**************************************************************** IC2224.2 +071300* IC2224.2 +071400 MOVE 1 TO REC-CT. IC2224.2 +071500 MOVE "CALL-TEST-5" TO PAR-NAME. IC2224.2 +071600 MOVE "AVAILABLE -- NOT ON" TO FEATURE. IC2224.2 +071700 MOVE 0 TO CALL-FLAG. IC2224.2 +071800 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +071900 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +072000 MOVE ZERO TO DN3, DN4. IC2224.2 +072100 GO TO CALL-TEST-5-1. IC2224.2 +072200 CALL-DELETE-5-1. IC2224.2 +072300 PERFORM DE-LETE. IC2224.2 +072400 PERFORM PRINT-DETAIL. IC2224.2 +072500 ADD 1 TO REC-CT. IC2224.2 +072600* IC2224.2 +072700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +072800* AUTOMATICALLY DELETED. * IC2224.2 +072900* IC2224.2 +073000 GO TO CALL-DELETE-5-2. IC2224.2 +073100 CALL-TEST-5-1. IC2224.2 +073200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +073300 NOT ON EXCEPTION IC2224.2 +073400 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +073500 ADD 2 TO CALL-FLAG IC2224.2 +073600 END-CALL IC2224.2 +073700 ADD 1 TO CALL-FLAG. IC2224.2 +073800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +073900 MOVE "NON-EXECUTION OF NOT ON EXCEPTION PATH" IC2224.2 +074000 TO RE-MARK IC2224.2 +074100 MOVE "P" TO CORRECT-A IC2224.2 +074200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +074300 PERFORM FAIL IC2224.2 +074400 ELSE IC2224.2 +074500 PERFORM PASS. IC2224.2 +074600 CALL-WRITE-5-1. IC2224.2 +074700 PERFORM PRINT-DETAIL. IC2224.2 +074800 ADD 1 TO REC-CT. IC2224.2 +074900* IC2224.2 +075000 CALL-INIT-5-2. IC2224.2 +075100 GO TO CALL-TEST-5-2. IC2224.2 +075200 CALL-DELETE-5-2. IC2224.2 +075300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +075400 PERFORM DE-LETE. IC2224.2 +075500 PERFORM PRINT-DETAIL. IC2224.2 +075600 ADD 1 TO REC-CT. IC2224.2 +075700 GO TO CALL-EXIT-5. IC2224.2 +075800* IC2224.2 +075900 CALL-TEST-5-2. IC2224.2 +076000**************************************************************** IC2224.2 +076100* * IC2224.2 +076200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +076300* WAS EXECUTED. A PASS HERE ALSO INDICATES THAT THE * IC2224.2 +076400* "NOT ON EXCEPTION" PHRASE OF THE PRECEDING CALL STATEMENT * IC2224.2 +076500* WAS EXECUTED. * IC2224.2 +076600* * IC2224.2 +076700**************************************************************** IC2224.2 +076800* IC2224.2 +076900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +077000 IF CALL-FLAG = 3 IC2224.2 +077100 PERFORM PASS IC2224.2 +077200 ELSE IC2224.2 +077300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +077400 MOVE 3 TO CORRECT-N IC2224.2 +077500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +077600 PERFORM FAIL. IC2224.2 +077700 PERFORM PRINT-DETAIL. IC2224.2 +077800* IC2224.2 +077900 CALL-EXIT-5. IC2224.2 +078000* IC2224.2 +078100* IC2224.2 +078200 CALL-INIT-6. IC2224.2 +078300**************************************************************** IC2224.2 +078400* * IC2224.2 +078500* CALL A PROGRAM WHICH IS AVAILABLE FOR EXECUTION, USING A * IC2224.2 +078600* CALL STATEMENT WITH NEITHER AN "ON EXCEPTION" PHRASE NOR * IC2224.2 +078700* A "NOT ON EXCEPTION" PHRASE. EXECUTION SHOULD BE * IC2224.2 +078800* SUCCESSFUL. THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +078900* SHOULD BE EXECUTED. * IC2224.2 +079000* * IC2224.2 +079100**************************************************************** IC2224.2 +079200* IC2224.2 +079300 MOVE 1 TO REC-CT. IC2224.2 +079400 MOVE "CALL-TEST-6" TO PAR-NAME. IC2224.2 +079500 MOVE "AVAILABLE -- ---" TO FEATURE. IC2224.2 +079600 MOVE 0 TO CALL-FLAG. IC2224.2 +079700 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +079800 MOVE "X-28 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +079900 MOVE ZERO TO DN3, DN4. IC2224.2 +080000 GO TO CALL-TEST-6-1. IC2224.2 +080100 CALL-DELETE-6-1. IC2224.2 +080200 PERFORM DE-LETE. IC2224.2 +080300 PERFORM PRINT-DETAIL. IC2224.2 +080400 ADD 1 TO REC-CT. IC2224.2 +080500* IC2224.2 +080600* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +080700* AUTOMATICALLY DELETED. * IC2224.2 +080800* IC2224.2 +080900 GO TO CALL-DELETE-6-2. IC2224.2 +081000 CALL-TEST-6-1. IC2224.2 +081100 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +081200 END-CALL IC2224.2 +081300 ADD 1 TO CALL-FLAG. IC2224.2 +081400 IF EXCEPTION-PATH-FLAG NOT = "X" IC2224.2 +081500 MOVE "EXCEPTION-PATH-FLAG ALTERED" TO RE-MARK IC2224.2 +081600 MOVE "X" TO CORRECT-A IC2224.2 +081700 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +081800 PERFORM FAIL IC2224.2 +081900 ELSE IC2224.2 +082000 PERFORM PASS. IC2224.2 +082100 CALL-WRITE-6-1. IC2224.2 +082200 PERFORM PRINT-DETAIL. IC2224.2 +082300 ADD 1 TO REC-CT. IC2224.2 +082400* IC2224.2 +082500 CALL-INIT-6-2. IC2224.2 +082600 GO TO CALL-TEST-6-2. IC2224.2 +082700 CALL-DELETE-6-2. IC2224.2 +082800 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +082900 PERFORM DE-LETE. IC2224.2 +083000 PERFORM PRINT-DETAIL. IC2224.2 +083100 ADD 1 TO REC-CT. IC2224.2 +083200 GO TO CALL-EXIT-6. IC2224.2 +083300* IC2224.2 +083400 CALL-TEST-6-2. IC2224.2 +083500**************************************************************** IC2224.2 +083600* * IC2224.2 +083700* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +083800* WAS EXECUTED. * IC2224.2 +083900* * IC2224.2 +084000**************************************************************** IC2224.2 +084100* IC2224.2 +084200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +084300 IF CALL-FLAG = 1 IC2224.2 +084400 PERFORM PASS IC2224.2 +084500 ELSE IC2224.2 +084600 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +084700 MOVE 1 TO CORRECT-N IC2224.2 +084800 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +084900 PERFORM FAIL. IC2224.2 +085000 PERFORM PRINT-DETAIL. IC2224.2 +085100* IC2224.2 +085200 CALL-EXIT-6. IC2224.2 +085300* IC2224.2 +085400* IC2224.2 +085500 CALL-INIT-7. IC2224.2 +085600**************************************************************** IC2224.2 +085700* * IC2224.2 +085800* CALL A PROGRAM WHICH EXISTS AND FOR WHICH PARAMETERS * IC2224.2 +085900* MATCH IN NUMBER AND TYPE. THIS TEST IS A DUPLICATION OF * IC2224.2 +086000* CALL-TEST-1, WITH "ON OVERFLOW" SUBSTITUTED FOR * IC2224.2 +086100* "ON EXCEPTION" IN THE CALL STATEMENT. * IC2224.2 +086200* * IC2224.2 +086300**************************************************************** IC2224.2 +086400* IC2224.2 +086500 MOVE 1 TO REC-CT. IC2224.2 +086600 MOVE "CALL-TEST-7" TO PAR-NAME. IC2224.2 +086700 MOVE "AVAILABLE OV ---" TO FEATURE. IC2224.2 +086800 MOVE 0 TO CALL-FLAG. IC2224.2 +086900 MOVE "P" TO EXCEPTION-PATH-FLAG. IC2224.2 +087000 MOVE "X-27 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +087100 MOVE ZERO TO DN3, DN4. IC2224.2 +087200 GO TO CALL-TEST-7-1. IC2224.2 +087300 CALL-DELETE-7-1. IC2224.2 +087400 PERFORM DE-LETE. IC2224.2 +087500 PERFORM PRINT-DETAIL. IC2224.2 +087600 ADD 1 TO REC-CT. IC2224.2 +087700* IC2224.2 +087800* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +087900* AUTOMATICALLY DELETED. * IC2224.2 +088000* IC2224.2 +088100 GO TO CALL-DELETE-7-2. IC2224.2 +088200 CALL-TEST-7-1. IC2224.2 +088300 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +088400 ON OVERFLOW IC2224.2 +088500 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +088600 END-CALL IC2224.2 +088700 MOVE 1 TO CALL-FLAG. IC2224.2 +088800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +088900 MOVE "UNEXPECTED EXECUTION OF EXCEPTION PATH" IC2224.2 +089000 TO RE-MARK IC2224.2 +089100 MOVE "P" TO CORRECT-A IC2224.2 +089200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +089300 PERFORM FAIL IC2224.2 +089400 ELSE IC2224.2 +089500 PERFORM PASS. IC2224.2 +089600 CALL-WRITE-7-1. IC2224.2 +089700 PERFORM PRINT-DETAIL. IC2224.2 +089800 ADD 1 TO REC-CT. IC2224.2 +089900* IC2224.2 +090000 CALL-INIT-7-2. IC2224.2 +090100 GO TO CALL-TEST-7-2. IC2224.2 +090200 CALL-DELETE-7-2. IC2224.2 +090300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +090400 PERFORM DE-LETE. IC2224.2 +090500 PERFORM PRINT-DETAIL. IC2224.2 +090600 ADD 1 TO REC-CT. IC2224.2 +090700 GO TO CALL-EXIT-7. IC2224.2 +090800* IC2224.2 +090900 CALL-TEST-7-2. IC2224.2 +091000**************************************************************** IC2224.2 +091100* * IC2224.2 +091200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +091300* WAS EXECUTED. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +091400* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +091500* CORRECTLY. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +091600* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +091700* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +091800* * IC2224.2 +091900**************************************************************** IC2224.2 +092000* IC2224.2 +092100 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +092200 IF CALL-FLAG = 1 IC2224.2 +092300 PERFORM PASS IC2224.2 +092400 ELSE IC2224.2 +092500 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +092600 MOVE 1 TO CORRECT-N IC2224.2 +092700 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +092800 PERFORM FAIL. IC2224.2 +092900 PERFORM PRINT-DETAIL. IC2224.2 +093000* IC2224.2 +093100 CALL-EXIT-7. IC2224.2 +093200* IC2224.2 +093300* IC2224.2 +093400 CALL-INIT-8. IC2224.2 +093500**************************************************************** IC2224.2 +093600* * IC2224.2 +093700* CALL A PROGRAM WHICH DOES NOT EXIST. PAGE X-28, 5.2.4 * IC2224.2 +093800* RULE (3)A STATES THAT IF A PROGRAM CANNOT BE MADE * IC2224.2 +093900* AVAILABLE THEN THE STATEMENTS IN THE "ON EXCEPTION" OR * IC2224.2 +094000* "ON OVERFLOW" PHRASE MUST BE EXECUTED. THIS TEST IS A * IC2224.2 +094100* DUPLICATION OF CALL-TEST-2 WITH "ON OVERFLOW" SUBSTITUTED * IC2224.2 +094200* FOR "ON EXCEPTION" IN THE CALL STATEMENT. * IC2224.2 +094300* * IC2224.2 +094400**************************************************************** IC2224.2 +094500* IC2224.2 +094600 MOVE 1 TO REC-CT. IC2224.2 +094700 MOVE "CALL-TEST-8" TO PAR-NAME. IC2224.2 +094800 MOVE "NO PROGRAM OV ---" TO FEATURE. IC2224.2 +094900 MOVE 0 TO CALL-FLAG. IC2224.2 +095000 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +095100 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +095200 MOVE ZERO TO DN3, DN4. IC2224.2 +095300 GO TO CALL-TEST-8-1. IC2224.2 +095400 CALL-DELETE-8-1. IC2224.2 +095500 PERFORM DE-LETE. IC2224.2 +095600 PERFORM PRINT-DETAIL. IC2224.2 +095700 ADD 1 TO REC-CT. IC2224.2 +095800* IC2224.2 +095900* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +096000* AUTOMATICALLY DELETED. * IC2224.2 +096100* IC2224.2 +096200 GO TO CALL-DELETE-8-2. IC2224.2 +096300 CALL-TEST-8-1. IC2224.2 +096400* CALL "NON-EXISTING-PROGRAM" IC2224.2 +096500 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +096600 ON OVERFLOW IC2224.2 +096700 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +096800 END-CALL IC2224.2 +096900 MOVE 1 TO CALL-FLAG. IC2224.2 +097000 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +097100 MOVE "EXCEPTION SHOULD HAVE OCCURRED" TO RE-MARK IC2224.2 +097200 MOVE "P" TO CORRECT-A IC2224.2 +097300 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +097400 PERFORM FAIL IC2224.2 +097500 ELSE IC2224.2 +097600 PERFORM PASS. IC2224.2 +097700 CALL-WRITE-8-1. IC2224.2 +097800 PERFORM PRINT-DETAIL. IC2224.2 +097900 ADD 1 TO REC-CT. IC2224.2 +098000* IC2224.2 +098100 CALL-INIT-8-2. IC2224.2 +098200 GO TO CALL-TEST-8-2. IC2224.2 +098300 CALL-DELETE-8-2. IC2224.2 +098400 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +098500 PERFORM DE-LETE. IC2224.2 +098600 PERFORM PRINT-DETAIL. IC2224.2 +098700 ADD 1 TO REC-CT. IC2224.2 +098800 GO TO CALL-EXIT-8. IC2224.2 +098900* IC2224.2 +099000 CALL-TEST-8-2. IC2224.2 +099100**************************************************************** IC2224.2 +099200* * IC2224.2 +099300* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +099400* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +099500* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +099600* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +099700* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +099800* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +099900* * IC2224.2 +100000**************************************************************** IC2224.2 +100100* IC2224.2 +100200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +100300 IF CALL-FLAG = 1 IC2224.2 +100400 PERFORM PASS IC2224.2 +100500 ELSE IC2224.2 +100600 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +100700 MOVE 1 TO CORRECT-N IC2224.2 +100800 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +100900 PERFORM FAIL. IC2224.2 +101000 PERFORM PRINT-DETAIL. IC2224.2 +101100* IC2224.2 +101200 CALL-EXIT-8. IC2224.2 +101300* IC2224.2 +101400* IC2224.2 +101500 CCVS-EXIT SECTION. IC2224.2 +101600 CCVS-999999. IC2224.2 +101700 GO TO CLOSE-FILES. IC2224.2 +101800 END PROGRAM IC222A. IC2224.2 +101900 IDENTIFICATION DIVISION. IC2224.2 +102000 PROGRAM-ID. IC2224.2 +102100 IC222A-1. IC2224.2 +102200**************************************************************** IC2224.2 +102300* * IC2224.2 +102400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2224.2 +102500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2224.2 +102600* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2224.2 +102700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2224.2 +102800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2224.2 +102900* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2224.2 +103000* * IC2224.2 +103100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2224.2 +103200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2224.2 +103300* DOCUMENT REFERENCE: ISO-1989-1978). * IC2224.2 +103400* * IC2224.2 +103500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2224.2 +103600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2224.2 +103700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2224.2 +103800* * IC2224.2 +103900* THE FEDERAL SOFTWARE TESTING CENTER * IC2224.2 +104000* OFFICE OF SOFTWARE DEVELOPMENT * IC2224.2 +104100* & INFORMATION TECHNOLOGY * IC2224.2 +104200* TWO SKYLINE PLACE * IC2224.2 +104300* SUITE 1100 * IC2224.2 +104400* 5203 LEESBURG PIKE * IC2224.2 +104500* FALLS CHURCH * IC2224.2 +104600* VA 22041 * IC2224.2 +104700* U.S.A. * IC2224.2 +104800* * IC2224.2 +104900* THE PROJECT TEAM MEMBERS WERE: * IC2224.2 +105000* * IC2224.2 +105100* BIADI (BUREAU INTER ADMINISTRATION * IC2224.2 +105200* DE DOCUMENTATION INFORMATIQUE) * IC2224.2 +105300* 21 RUE BARA * IC2224.2 +105400* F-92132 ISSY * IC2224.2 +105500* FRANCE * IC2224.2 +105600* * IC2224.2 +105700* * IC2224.2 +105800* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2224.2 +105900* UND DATENVERARBEITUNG MBH) * IC2224.2 +106000* SCHLOSS BIRLINGHOVEN * IC2224.2 +106100* POSTFACH 12 40 * IC2224.2 +106200* D-5205 ST. AUGUSTIN 1 * IC2224.2 +106300* GERMANY FR * IC2224.2 +106400* * IC2224.2 +106500* * IC2224.2 +106600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2224.2 +106700* OXFORD ROAD * IC2224.2 +106800* MANCHESTER * IC2224.2 +106900* M1 7ED * IC2224.2 +107000* UNITED KINGDOM * IC2224.2 +107100* * IC2224.2 +107200* * IC2224.2 +107300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2224.2 +107400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2224.2 +107500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2224.2 +107600* * IC2224.2 +107700* REVISED 1986 AUGUST * IC2224.2 +107800* * IC2224.2 +107900**************************************************************** IC2224.2 +108000* * IC2224.2 +108100* VALIDATION FOR:- * IC2224.2 +108200* * IC2224.2 +108300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +108400* * IC2224.2 +108500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +108600* * IC2224.2 +108700**************************************************************** IC2224.2 +108800* * IC2224.2 +108900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2224.2 +109000* * IC2224.2 +109100* X-82 SOURCE-COMPUTER * IC2224.2 +109200* X-83 OBJECT-COMPUTER. * IC2224.2 +109300* * IC2224.2 +109400**************************************************************** IC2224.2 +109500* * IC2224.2 +109600* THE SOURCE FILE CONTAINS TWO PROGRAMS, IC222A AND * IC2224.2 +109700* IC222A-1, WHICH TEST LANGUAGE ELEMENTS FROM LEVEL 2 OF * IC2224.2 +109800* THE INTER-PROGRAM COMMUNICATION MODULE. THE LANGUAGE * IC2224.2 +109900* ELEMENTS TESTED ARE: * IC2224.2 +110000* "ON EXCEPTION" PHRASE * IC2224.2 +110100* "NOT ON EXCEPTION" PHRASE * IC2224.2 +110200* "END-CALL" PHRASE * IC2224.2 +110300* "ON OVERFLOW" PHRASE * IC2224.2 +110400* IC2224.2 +110500* THE TWO PROGRAMS SHOULD BE COMPILED IN THE SAME * IC2224.2 +110600* INVOCATION OF THE COMPILER TO TEST THE BATCH COMPILATION * IC2224.2 +110700* FEATURE AND RECOGNITION OF THE END PROGRAM HEADER. THE * IC2224.2 +110800* ARRANGEMENT OF THE PROGRAMS IN THE SOURCE FILE IS: IC2224.2 +110900* IC2224.2 +111000* IDENTIFICATION DIVISION. IC2224.2 +111100* PROGRAM-ID. IC222A. IC2224.2 +111200* . IC2224.2 +111300* . IC2224.2 +111400* . IC2224.2 +111500* END PROGRAM IC222A. IC2224.2 +111600* IDENTIFICATION DIVISION. IC2224.2 +111700* PROGRAM-ID. IC222A-1. IC2224.2 +111800* . IC2224.2 +111900* . IC2224.2 +112000* . IC2224.2 +112100* IC2224.2 +112200* A FULL DESCRIPTION OF THE TWO PROGRAMS IS INCLUDED AS * IC2224.2 +112300* COMMENTS IN PROGRAM IC222A. * IC2224.2 +112400* * IC2224.2 +112500**************************************************************** IC2224.2 +112600* IC2224.2 +112700 ENVIRONMENT DIVISION. IC2224.2 +112800 CONFIGURATION SECTION. IC2224.2 +112900 SOURCE-COMPUTER. IC2224.2 +113000 XXXXX082. IC2224.2 +113100 OBJECT-COMPUTER. IC2224.2 +113200 XXXXX083. IC2224.2 +113300 INPUT-OUTPUT SECTION. IC2224.2 +113400 FILE-CONTROL. IC2224.2 +113500 SELECT PRINT-FILE ASSIGN TO IC2224.2 +113600 XXXXX055. IC2224.2 +113700* IC2224.2 +113800 DATA DIVISION. IC2224.2 +113900 FILE SECTION. IC2224.2 +114000 FD PRINT-FILE. IC2224.2 +114100 01 PRINT-REC PICTURE X(120). IC2224.2 +114200 01 DUMMY-RECORD PICTURE X(120). IC2224.2 +114300 WORKING-STORAGE SECTION. IC2224.2 +114400 77 WS1 PICTURE S999. IC2224.2 +114500 77 WS2 PICTURE S999 IC2224.2 +114600 USAGE COMPUTATIONAL, VALUE ZERO. IC2224.2 +114700 LINKAGE SECTION. IC2224.2 +114800 77 DN1 PICTURE S99. IC2224.2 +114900 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2224.2 +115000 77 DN3 PICTURE S99. IC2224.2 +115100 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2224.2 +115200* IC2224.2 +115300 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2224.2 +115400 SECT-IC222A-1-001 SECTION. IC2224.2 +115500 CALL-TEST-001. IC2224.2 +115600 MOVE DN1 TO WS1. IC2224.2 +115700 ADD 1 TO WS1. IC2224.2 +115800 ADD 1 TO WS2. IC2224.2 +115900 MOVE WS1 TO DN3. IC2224.2 +116000 MOVE WS2 TO DN4. IC2224.2 +116100 CALL-EXIT-001. IC2224.2 +116200 EXIT PROGRAM. IC2224.2 +*END-OF,IC222A +*HEADER,COBOL,IC223A +000100 IDENTIFICATION DIVISION. IC2234.2 +000200 PROGRAM-ID. IC2234.2 +000300 IC223A. IC2234.2 +000400**************************************************************** IC2234.2 +000500* * IC2234.2 +000600* VALIDATION FOR:- * IC2234.2 +000700* * IC2234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +000900* * IC2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +001100* * IC2234.2 +001200**************************************************************** IC2234.2 +001300* * IC2234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2234.2 +001500* * IC2234.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2234.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2234.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2234.2 +001900* * IC2234.2 +002000**************************************************************** IC2234.2 +002100* * IC2234.2 +002200* PROGRAM IC223A AND IC223A-1 WILL TEST THE NEW LANGUAGE * IC2234.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2234.2 +002400* MODULE. * IC2234.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2234.2 +002600* "BY REFERENCE" PHRASE * IC2234.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2234.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2234.2 +002900* IDENTIFICATION DIVISION. * IC2234.2 +003000* PROGRAM-ID. IC223A. * IC2234.2 +003100* . * IC2234.2 +003200* . * IC2234.2 +003300* . * IC2234.2 +003400* END PROGRAM IC223A. * IC2234.2 +003500* PROGRAM-ID. IC223A-1. * IC2234.2 +003600* . * IC2234.2 +003700* . * IC2234.2 +003800* . * IC2234.2 +003900**************************************************************** IC2234.2 +004000 ENVIRONMENT DIVISION. IC2234.2 +004100 CONFIGURATION SECTION. IC2234.2 +004200 SOURCE-COMPUTER. IC2234.2 +004300 XXXXX082. IC2234.2 +004400 OBJECT-COMPUTER. IC2234.2 +004500 XXXXX083. IC2234.2 +004600 INPUT-OUTPUT SECTION. IC2234.2 +004700 FILE-CONTROL. IC2234.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2234.2 +004900 XXXXX055. IC2234.2 +005000 DATA DIVISION. IC2234.2 +005100 FILE SECTION. IC2234.2 +005200 FD PRINT-FILE. IC2234.2 +005300 01 PRINT-REC PICTURE X(120). IC2234.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2234.2 +005500 WORKING-STORAGE SECTION. IC2234.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2234.2 +005700 77 DN3 PICTURE S99. IC2234.2 +005800 77 ID1 PICTURE X(8) VALUE "IC223A-1". IC2234.2 +005900 77 ID2 PICTURE X(8). IC2234.2 +006000 77 DN2 PICTURE S99 IC2234.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2234.2 +006200 77 DN4 PICTURE S99 IC2234.2 +006300 USAGE IS COMPUTATIONAL. IC2234.2 +006400 77 CALL-COUNT PIC S99. IC2234.2 +006500 77 FAIL-FLAG PIC 9. IC2234.2 +006600 01 TEST-RESULTS. IC2234.2 +006700 02 FILLER PIC X VALUE SPACE. IC2234.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2234.2 +006900 02 FILLER PIC X VALUE SPACE. IC2234.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2234.2 +007100 02 FILLER PIC X VALUE SPACE. IC2234.2 +007200 02 PAR-NAME. IC2234.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2234.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2234.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2234.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2234.2 +007700 02 RE-MARK PIC X(61). IC2234.2 +007800 01 TEST-COMPUTED. IC2234.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2234.2 +008000 02 FILLER PIC X(17) VALUE IC2234.2 +008100 " COMPUTED=". IC2234.2 +008200 02 COMPUTED-X. IC2234.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2234.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2234.2 +008500 PIC -9(9).9(9). IC2234.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2234.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2234.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2234.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2234.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2234.2 +009100 04 FILLER PIC X. IC2234.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2234.2 +009300 01 TEST-CORRECT. IC2234.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2234.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2234.2 +009600 02 CORRECT-X. IC2234.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2234.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2234.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2234.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2234.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2234.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2234.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2234.2 +010400 04 FILLER PIC X. IC2234.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2234.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2234.2 +010700 01 CCVS-C-1. IC2234.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2234.2 +010900- "SS PARAGRAPH-NAME IC2234.2 +011000- " REMARKS". IC2234.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2234.2 +011200 01 CCVS-C-2. IC2234.2 +011300 02 FILLER PIC X VALUE SPACE. IC2234.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2234.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2234.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2234.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2234.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2234.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2234.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2234.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2234.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2234.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2234.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2234.2 +012900 01 CCVS-H-1. IC2234.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2234.2 +013100 02 FILLER PIC X(42) VALUE IC2234.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2234.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2234.2 +013400 01 CCVS-H-2A. IC2234.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2234.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2234.2 +013700 02 FILLER PIC XXXX VALUE IC2234.2 +013800 "4.2 ". IC2234.2 +013900 02 FILLER PIC X(28) VALUE IC2234.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2234.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2234.2 +014200 IC2234.2 +014300 01 CCVS-H-2B. IC2234.2 +014400 02 FILLER PIC X(15) VALUE IC2234.2 +014500 "TEST RESULT OF ". IC2234.2 +014600 02 TEST-ID PIC X(9). IC2234.2 +014700 02 FILLER PIC X(4) VALUE IC2234.2 +014800 " IN ". IC2234.2 +014900 02 FILLER PIC X(12) VALUE IC2234.2 +015000 " HIGH ". IC2234.2 +015100 02 FILLER PIC X(22) VALUE IC2234.2 +015200 " LEVEL VALIDATION FOR ". IC2234.2 +015300 02 FILLER PIC X(58) VALUE IC2234.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +015500 01 CCVS-H-3. IC2234.2 +015600 02 FILLER PIC X(34) VALUE IC2234.2 +015700 " FOR OFFICIAL USE ONLY ". IC2234.2 +015800 02 FILLER PIC X(58) VALUE IC2234.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +016000 02 FILLER PIC X(28) VALUE IC2234.2 +016100 " COPYRIGHT 1985 ". IC2234.2 +016200 01 CCVS-E-1. IC2234.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2234.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2234.2 +016500 02 ID-AGAIN PIC X(9). IC2234.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2234.2 +016700 01 CCVS-E-2. IC2234.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2234.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2234.2 +017000 02 CCVS-E-2-2. IC2234.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2234.2 +017200 03 FILLER PIC X VALUE SPACE. IC2234.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2234.2 +017400 "ERRORS ENCOUNTERED". IC2234.2 +017500 01 CCVS-E-3. IC2234.2 +017600 02 FILLER PIC X(22) VALUE IC2234.2 +017700 " FOR OFFICIAL USE ONLY". IC2234.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2234.2 +017900 02 FILLER PIC X(58) VALUE IC2234.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2234.2 +018200 02 FILLER PIC X(15) VALUE IC2234.2 +018300 " COPYRIGHT 1985". IC2234.2 +018400 01 CCVS-E-4. IC2234.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2234.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2234.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2234.2 +018800 02 FILLER PIC X(40) VALUE IC2234.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2234.2 +019000 01 XXINFO. IC2234.2 +019100 02 FILLER PIC X(19) VALUE IC2234.2 +019200 "*** INFORMATION ***". IC2234.2 +019300 02 INFO-TEXT. IC2234.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2234.2 +019500 04 XXCOMPUTED PIC X(20). IC2234.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2234.2 +019700 04 XXCORRECT PIC X(20). IC2234.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2234.2 +019900 01 HYPHEN-LINE. IC2234.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2234.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2234.2 +020200- "*****************************************". IC2234.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2234.2 +020400- "******************************". IC2234.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2234.2 +020600 "IC223A". IC2234.2 +020700 PROCEDURE DIVISION. IC2234.2 +020800 CCVS1 SECTION. IC2234.2 +020900 OPEN-FILES. IC2234.2 +021000 OPEN OUTPUT PRINT-FILE. IC2234.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2234.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2234.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2234.2 +021400 GO TO CCVS1-EXIT. IC2234.2 +021500 CLOSE-FILES. IC2234.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2234.2 +021700 TERMINATE-CCVS. IC2234.2 +021800S EXIT PROGRAM. IC2234.2 +021900STERMINATE-CALL. IC2234.2 +022000 STOP RUN. IC2234.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2234.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2234.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2234.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2234.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2234.2 +022600 PRINT-DETAIL. IC2234.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2234.2 +022800 MOVE "." TO PARDOT-X IC2234.2 +022900 MOVE REC-CT TO DOTVALUE. IC2234.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2234.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2234.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2234.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2234.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2234.2 +023500 MOVE SPACE TO CORRECT-X. IC2234.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2234.2 +023700 MOVE SPACE TO RE-MARK. IC2234.2 +023800 HEAD-ROUTINE. IC2234.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2234.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2234.2 +024300 COLUMN-NAMES-ROUTINE. IC2234.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +024700 END-ROUTINE. IC2234.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2234.2 +024900 END-RTN-EXIT. IC2234.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +025100 END-ROUTINE-1. IC2234.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2234.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2234.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2234.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2234.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2234.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2234.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2234.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2234.2 +026000 END-ROUTINE-12. IC2234.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2234.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2234.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2234.2 +026400 ELSE IC2234.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2234.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2234.2 +026700 PERFORM WRITE-LINE. IC2234.2 +026800 END-ROUTINE-13. IC2234.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2234.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2234.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2234.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2234.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2234.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2234.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2234.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2234.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +028000 WRITE-LINE. IC2234.2 +028100 ADD 1 TO RECORD-COUNT. IC2234.2 +028200Y IF RECORD-COUNT GREATER 50 IC2234.2 +028300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2234.2 +028400Y MOVE SPACE TO DUMMY-RECORD IC2234.2 +028500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2234.2 +028600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2234.2 +028700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2234.2 +028800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2234.2 +028900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2234.2 +029000Y MOVE ZERO TO RECORD-COUNT. IC2234.2 +029100 PERFORM WRT-LN. IC2234.2 +029200 WRT-LN. IC2234.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2234.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2234.2 +029500 BLANK-LINE-PRINT. IC2234.2 +029600 PERFORM WRT-LN. IC2234.2 +029700 FAIL-ROUTINE. IC2234.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2234.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2234.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2234.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2234.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2234.2 +030400 GO TO FAIL-ROUTINE-EX. IC2234.2 +030500 FAIL-ROUTINE-WRITE. IC2234.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2234.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2234.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2234.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2234.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2234.2 +031100 BAIL-OUT. IC2234.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2234.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2234.2 +031400 BAIL-OUT-WRITE. IC2234.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2234.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2234.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2234.2 +031900 BAIL-OUT-EX. EXIT. IC2234.2 +032000 CCVS1-EXIT. IC2234.2 +032100 EXIT. IC2234.2 +032200 SECT-IC223A-001 SECTION. IC2234.2 +032300 CALL-TEST-01. IC2234.2 +032400 MOVE "CALL-TEST-01" TO PAR-NAME. IC2234.2 +032500 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2234.2 +032600 MOVE 0 TO CALL-COUNT. IC2234.2 +032700* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2234.2 +032800* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2234.2 +032900* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2234.2 +033000* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2234.2 +033100* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2234.2 +033200 CALL-TEST-01-01. IC2234.2 +033300 MOVE 1 TO REC-CT. IC2234.2 +033400 MOVE ZERO TO DN3, DN4. IC2234.2 +033500 CALL "IC223A-1" USING BY REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +033600 END-CALL IC2234.2 +033700 PERFORM CHECK-TEST-01. IC2234.2 +033800 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +033900 PERFORM PASS IC2234.2 +034000 GO TO CALL-WRITE-01-01. IC2234.2 +034100 CALL-FAIL-01-01. IC2234.2 +034200 PERFORM FAIL. IC2234.2 +034300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +034400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +034500 CALL-WRITE-01-01. IC2234.2 +034600 PERFORM PRINT-DETAIL. IC2234.2 +034700 CALL-TEST-01-02. IC2234.2 +034800 ADD 1 TO REC-CT. IC2234.2 +034900 MOVE ZERO TO DN3, DN4. IC2234.2 +035000 CALL ID1 USING BY REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +035100 END-CALL IC2234.2 +035200 PERFORM CHECK-TEST-01. IC2234.2 +035300 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +035400 PERFORM PASS IC2234.2 +035500 GO TO CALL-WRITE-01-02. IC2234.2 +035600 CALL-FAIL-01-02. IC2234.2 +035700 PERFORM FAIL. IC2234.2 +035800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +035900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +036000 CALL-WRITE-01-02. IC2234.2 +036100 PERFORM PRINT-DETAIL. IC2234.2 +036200 CALL-TEST-01-03. IC2234.2 +036300 ADD 1 TO REC-CT. IC2234.2 +036400 MOVE ID1 TO ID2. IC2234.2 +036500 MOVE ZERO TO DN3, DN4. IC2234.2 +036600 CALL ID2 USING REFERENCE DN1 DN2 DN3 DN4 IC2234.2 +036700 END-CALL. IC2234.2 +036800 PERFORM CHECK-TEST-01. IC2234.2 +036900 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +037000 PERFORM PASS IC2234.2 +037100 GO TO CALL-WRITE-01-03. IC2234.2 +037200 CALL-FAIL-01-03. IC2234.2 +037300 PERFORM FAIL. IC2234.2 +037400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +037500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +037600 CALL-WRITE-01-03. IC2234.2 +037700 PERFORM PRINT-DETAIL. IC2234.2 +037800 CALL-TEST-01-04. IC2234.2 +037900 ADD 1 TO REC-CT. IC2234.2 +038000 MOVE "IC223A-1" TO ID2. IC2234.2 +038100 MOVE ZERO TO DN3, DN4. IC2234.2 +038200 CALL ID2 USING REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +038300 END-CALL. IC2234.2 +038400 PERFORM CHECK-TEST-01. IC2234.2 +038500 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +038600 PERFORM PASS IC2234.2 +038700 GO TO CALL-WRITE-01-04. IC2234.2 +038800 CALL-FAIL-01-04. IC2234.2 +038900 PERFORM FAIL. IC2234.2 +039000 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +039100 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +039200 CALL-WRITE-01-04. IC2234.2 +039300 PERFORM PRINT-DETAIL. IC2234.2 +039400 CALL-TEST-02. IC2234.2 +039500 MOVE "CALL-TEST-02" TO PAR-NAME. IC2234.2 +039600 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2234.2 +039700* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2234.2 +039800* A USING PHRASE OF A CALL STATEMENT. IC2234.2 +039900 CALL-TEST-02-01. IC2234.2 +040000 MOVE 1 TO REC-CT. IC2234.2 +040100 MOVE 1 TO DN1. IC2234.2 +040200 MOVE 0 TO DN2, DN3, DN4. IC2234.2 +040300 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN1, DN4 IC2234.2 +040400 END-CALL. IC2234.2 +040500 IF DN1 NOT EQUAL TO 2 IC2234.2 +040600 GO TO CALL-FAIL-02-01-1. IC2234.2 +040700 IF DN2 NOT EQUAL TO 0 IC2234.2 +040800 GO TO CALL-FAIL-02-01-2. IC2234.2 +040900 IF DN3 NOT EQUAL TO 0 IC2234.2 +041000 GO TO CALL-FAIL-02-01-3. IC2234.2 +041100 IF DN4 NOT EQUAL TO 5 IC2234.2 +041200 GO TO CALL-FAIL-02-01-4. IC2234.2 +041300 GO TO CALL-PASS-02-01. IC2234.2 +041400 CALL-DELETE-02-01. IC2234.2 +041500 PERFORM DE-LETE. IC2234.2 +041600 GO TO CALL-WRITE-02-01. IC2234.2 +041700 CALL-PASS-02-01. IC2234.2 +041800 PERFORM PASS. IC2234.2 +041900 GO TO CALL-WRITE-02-01. IC2234.2 +042000 CALL-FAIL-02-01-1. IC2234.2 +042100 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +042200 MOVE 2 TO CORRECT-18V0. IC2234.2 +042300 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +042400 GO TO CALL-FAIL-02-01. IC2234.2 +042500 CALL-FAIL-02-01-2. IC2234.2 +042600 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +042700 MOVE 0 TO CORRECT-18V0. IC2234.2 +042800 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +042900 GO TO CALL-FAIL-02-01. IC2234.2 +043000 CALL-FAIL-02-01-3. IC2234.2 +043100 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +043200 MOVE ZERO TO CORRECT-18V0. IC2234.2 +043300 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +043400 GO TO CALL-FAIL-02-01. IC2234.2 +043500 CALL-FAIL-02-01-4. IC2234.2 +043600 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +043700 MOVE 5 TO CORRECT-18V0. IC2234.2 +043800 MOVE "ERROR IN DN4 VALUE RETURNED" TO RE-MARK. IC2234.2 +043900 CALL-FAIL-02-01. IC2234.2 +044000 PERFORM FAIL. IC2234.2 +044100 CALL-WRITE-02-01. IC2234.2 +044200 PERFORM PRINT-DETAIL. IC2234.2 +044300 CALL-TEST-02-02. IC2234.2 +044400 ADD 1 TO REC-CT. IC2234.2 +044500 MOVE 0 TO DN4, DN3, DN2, DN1. IC2234.2 +044600 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN2 IC2234.2 +044700 END-CALL. IC2234.2 +044800 IF DN1 NOT EQUAL TO 0 IC2234.2 +044900 GO TO CALL-FAIL-02-02-1. IC2234.2 +045000 IF DN2 NOT EQUAL TO 6 IC2234.2 +045100 GO TO CALL-FAIL-02-02-2. IC2234.2 +045200 IF DN3 NOT EQUAL TO 1 IC2234.2 +045300 GO TO CALL-FAIL-02-02-3. IC2234.2 +045400 IF DN4 NOT EQUAL TO 0 IC2234.2 +045500 GO TO CALL-FAIL-02-02-4. IC2234.2 +045600 GO TO CALL-PASS-02-02. IC2234.2 +045700 CALL-DELETE-02-02. IC2234.2 +045800 PERFORM DE-LETE. IC2234.2 +045900 GO TO CALL-WRITE-02-02. IC2234.2 +046000 CALL-PASS-02-02. IC2234.2 +046100 PERFORM PASS. IC2234.2 +046200 GO TO CALL-WRITE-02-02. IC2234.2 +046300 CALL-FAIL-02-02-1. IC2234.2 +046400 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +046500 MOVE ZERO TO CORRECT-18V0. IC2234.2 +046600 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +046700 GO TO CALL-FAIL-02-02. IC2234.2 +046800 CALL-FAIL-02-02-2. IC2234.2 +046900 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +047000 MOVE 6 TO CORRECT-18V0. IC2234.2 +047100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +047200 GO TO CALL-FAIL-02-02. IC2234.2 +047300 CALL-FAIL-02-02-3. IC2234.2 +047400 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +047500 MOVE 1 TO CORRECT-18V0. IC2234.2 +047600 MOVE "ERROR IN DN3 VALUE RETURNED" TO RE-MARK. IC2234.2 +047700 GO TO CALL-FAIL-02-02. IC2234.2 +047800 CALL-FAIL-02-02-4. IC2234.2 +047900 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +048000 MOVE 0 TO CORRECT-18V0. IC2234.2 +048100 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +048200 CALL-FAIL-02-02. IC2234.2 +048300 PERFORM FAIL. IC2234.2 +048400 CALL-WRITE-02-02. IC2234.2 +048500 PERFORM PRINT-DETAIL. IC2234.2 +048600 CALL-TEST-02-03. IC2234.2 +048700 ADD 1 TO REC-CT. IC2234.2 +048800 MOVE 0 TO DN4, DN3. IC2234.2 +048900 MOVE 10 TO DN2. IC2234.2 +049000 MOVE 25 TO DN1. IC2234.2 +049100 CALL ID1 USING REFERENCE DN1 DN2 DN1 DN2 IC2234.2 +049200 END-CALL. IC2234.2 +049300 IF DN1 EQUAL TO 26 IC2234.2 +049400 GO TO CHECK-02-03-2. IC2234.2 +049500 GO TO CALL-FAIL-02-03-1. IC2234.2 +049600 CALL-DELETE-02-03. IC2234.2 +049700 PERFORM DE-LETE. IC2234.2 +049800 GO TO CALL-WRITE-02-03. IC2234.2 +049900 CALL-FAIL-02-03-1. IC2234.2 +050000 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +050100 MOVE 26 TO CORRECT-18V0. IC2234.2 +050200 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +050300 GO TO CALL-FAIL-02-03. IC2234.2 +050400 CHECK-02-03-2. IC2234.2 +050500 IF DN2 EQUAL TO 7 IC2234.2 +050600 GO TO CHECK-02-03-3. IC2234.2 +050700 CALL-FAIL-02-03-2. IC2234.2 +050800 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +050900 MOVE 7 TO CORRECT-18V0. IC2234.2 +051000 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +051100 GO TO CALL-FAIL-02-03. IC2234.2 +051200 CHECK-02-03-3. IC2234.2 +051300 IF DN3 EQUAL TO 0 IC2234.2 +051400 GO TO CHECK-02-03-4. IC2234.2 +051500 CALL-FAIL-02-03-3. IC2234.2 +051600 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +051700 MOVE 0 TO CORRECT-18V0. IC2234.2 +051800 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +051900 GO TO CALL-FAIL-02-03. IC2234.2 +052000 CHECK-02-03-4. IC2234.2 +052100 IF DN4 EQUAL TO 0 IC2234.2 +052200 GO TO CALL-PASS-02-03. IC2234.2 +052300 CALL-FAIL-02-03-4. IC2234.2 +052400 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +052500 MOVE 0 TO CORRECT-18V0. IC2234.2 +052600 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +052700 CALL-FAIL-02-03. IC2234.2 +052800 PERFORM FAIL. IC2234.2 +052900 GO TO CALL-WRITE-02-03. IC2234.2 +053000 CALL-PASS-02-03. IC2234.2 +053100 PERFORM PASS. IC2234.2 +053200 CALL-WRITE-02-03. IC2234.2 +053300 PERFORM PRINT-DETAIL. IC2234.2 +053400 CALL-TEST-03. IC2234.2 +053500* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2234.2 +053600* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2234.2 +053700* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2234.2 +053800 MOVE "CALL-TEST-03" TO PAR-NAME. IC2234.2 +053900 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2234.2 +054000 CALL-TEST-03-01. IC2234.2 +054100 MOVE 7 TO CALL-COUNT. IC2234.2 +054200 MOVE 20 TO DN1. IC2234.2 +054300 MOVE 30 TO DN2. IC2234.2 +054400 MOVE ZERO TO DN3, DN4. IC2234.2 +054500 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN3, DN4; IC2234.2 +054600 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +054700 GO TO CALL-FAIL-03-01 IC2234.2 +054800 END-CALL. IC2234.2 +054900 PERFORM CHECK-TEST-03. IC2234.2 +055000 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +055100 PERFORM PASS IC2234.2 +055200 GO TO CALL-WRITE-03-01. IC2234.2 +055300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +055400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +055500 CALL-FAIL-03-01. IC2234.2 +055600 PERFORM FAIL. IC2234.2 +055700 CALL-WRITE-03-01. IC2234.2 +055800 PERFORM PRINT-DETAIL. IC2234.2 +055900 CALL-TEST-03-02. IC2234.2 +056000 MOVE ZERO TO DN3, DN4. IC2234.2 +056100 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN3, DN4; IC2234.2 +056200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +056300 GO TO CALL-FAIL-03-02 IC2234.2 +056400 END-CALL. IC2234.2 +056500 PERFORM CHECK-TEST-03. IC2234.2 +056600 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +056700 PERFORM PASS IC2234.2 +056800 GO TO CALL-WRITE-03-02. IC2234.2 +056900 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +057000 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +057100 CALL-FAIL-03-02. IC2234.2 +057200 PERFORM FAIL. IC2234.2 +057300 CALL-WRITE-03-02. IC2234.2 +057400 PERFORM PRINT-DETAIL. IC2234.2 +057500 CALL-TEST-03-03. IC2234.2 +057600 MOVE ZERO TO DN3, DN4. IC2234.2 +057700 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN4 IC2234.2 +057800 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +057900 GO TO CALL-FAIL-03-03 IC2234.2 +058000 END-CALL. IC2234.2 +058100 PERFORM CHECK-TEST-03. IC2234.2 +058200 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +058300 PERFORM PASS IC2234.2 +058400 GO TO CALL-WRITE-03-03. IC2234.2 +058500 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +058600 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +058700 CALL-FAIL-03-03. IC2234.2 +058800 PERFORM FAIL. IC2234.2 +058900 CALL-WRITE-03-03. IC2234.2 +059000 PERFORM PRINT-DETAIL. IC2234.2 +059100 CALL-TEST-03-04. IC2234.2 +059200 MOVE ZERO TO DN3, DN4. IC2234.2 +059300 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN4; IC2234.2 +059400 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2234.2 +059500 GO TO CALL-FAIL-03-04 IC2234.2 +059600 END-CALL. IC2234.2 +059700 PERFORM CHECK-TEST-03. IC2234.2 +059800 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +059900 PERFORM PASS IC2234.2 +060000 GO TO CALL-WRITE-03-04. IC2234.2 +060100 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +060200 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +060300 CALL-FAIL-03-04. IC2234.2 +060400 PERFORM FAIL. IC2234.2 +060500 CALL-WRITE-03-04. IC2234.2 +060600 PERFORM PRINT-DETAIL. IC2234.2 +060700 GO TO EXIT-IC223A. IC2234.2 +060800 CALL-DELETE-03. IC2234.2 +060900* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2234.2 +061000* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2234.2 +061100* CALL-TEST-03-01. IC2234.2 +061200 PERFORM DE-LETE. IC2234.2 +061300 PERFORM PRINT-DETAIL. IC2234.2 +061400 EXIT-IC223A. IC2234.2 +061500 GO TO CCVS-EXIT. IC2234.2 +061600 SECT-IC223A-002 SECTION. IC2234.2 +061700 CHECK-TEST-01. IC2234.2 +061800 MOVE ZERO TO FAIL-FLAG. IC2234.2 +061900 ADD 1 TO CALL-COUNT. IC2234.2 +062000 IF DN1 EQUAL TO ZERO IC2234.2 +062100 NEXT SENTENCE IC2234.2 +062200 ELSE ADD 1 TO FAIL-FLAG. IC2234.2 +062300 IF DN2 NOT EQUAL TO ZERO IC2234.2 +062400 ADD 1 TO FAIL-FLAG. IC2234.2 +062500 IF DN3 NOT EQUAL TO 1 IC2234.2 +062600 ADD 1 TO FAIL-FLAG. IC2234.2 +062700 IF DN4 NOT EQUAL TO CALL-COUNT IC2234.2 +062800 ADD 1 TO FAIL-FLAG. IC2234.2 +062900 CHECK-TEST-03. IC2234.2 +063000 MOVE ZERO TO FAIL-FLAG. IC2234.2 +063100 ADD 1 TO CALL-COUNT. IC2234.2 +063200 IF DN4 NOT EQUAL TO CALL-COUNT IC2234.2 +063300 ADD 1 TO FAIL-FLAG. IC2234.2 +063400 IF DN3 NOT EQUAL TO 21 IC2234.2 +063500 ADD 1 TO FAIL-FLAG. IC2234.2 +063600 IF DN2 NOT EQUAL TO 30 IC2234.2 +063700 ADD 1 TO FAIL-FLAG. IC2234.2 +063800 IF DN1 NOT EQUAL TO 20 IC2234.2 +063900 ADD 1 TO FAIL-FLAG. IC2234.2 +064000 CCVS-EXIT SECTION. IC2234.2 +064100 CCVS-999999. IC2234.2 +064200 GO TO CLOSE-FILES. IC2234.2 +064300 END PROGRAM IC223A. IC2234.2 +064400 IDENTIFICATION DIVISION. IC2234.2 +064500 PROGRAM-ID. IC2234.2 +064600 IC223A-1. IC2234.2 +064700**************************************************************** IC2234.2 +064800* * IC2234.2 +064900* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2234.2 +065000* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2234.2 +065100* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2234.2 +065200* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2234.2 +065300* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2234.2 +065400* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2234.2 +065500* * IC2234.2 +065600* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2234.2 +065700* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2234.2 +065800* DOCUMENT REFERENCE: ISO-1989-1978). * IC2234.2 +065900* * IC2234.2 +066000* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2234.2 +066100* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2234.2 +066200* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2234.2 +066300* * IC2234.2 +066400* THE FEDERAL SOFTWARE TESTING CENTER * IC2234.2 +066500* OFFICE OF SOFTWARE DEVELOPMENT * IC2234.2 +066600* & INFORMATION TECHNOLOGY * IC2234.2 +066700* TWO SKYLINE PLACE * IC2234.2 +066800* SUITE 1100 * IC2234.2 +066900* 5203 LEESBURG PIKE * IC2234.2 +067000* FALLS CHURCH * IC2234.2 +067100* VA 22041 * IC2234.2 +067200* U.S.A. * IC2234.2 +067300* * IC2234.2 +067400* THE PROJECT TEAM MEMBERS WERE: * IC2234.2 +067500* * IC2234.2 +067600* BIADI (BUREAU INTER ADMINISTRATION * IC2234.2 +067700* DE DOCUMENTATION INFORMATIQUE) * IC2234.2 +067800* 21 RUE BARA * IC2234.2 +067900* F-92132 ISSY * IC2234.2 +068000* FRANCE * IC2234.2 +068100* * IC2234.2 +068200* * IC2234.2 +068300* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2234.2 +068400* UND DATENVERARBEITUNG MBH) * IC2234.2 +068500* SCHLOSS BIRLINGHOVEN * IC2234.2 +068600* POSTFACH 12 40 * IC2234.2 +068700* D-5205 ST. AUGUSTIN 1 * IC2234.2 +068800* GERMANY FR * IC2234.2 +068900* * IC2234.2 +069000* * IC2234.2 +069100* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2234.2 +069200* OXFORD ROAD * IC2234.2 +069300* MANCHESTER * IC2234.2 +069400* M1 7ED * IC2234.2 +069500* UNITED KINGDOM * IC2234.2 +069600* * IC2234.2 +069700* * IC2234.2 +069800* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2234.2 +069900* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2234.2 +070000* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2234.2 +070100* * IC2234.2 +070200**************************************************************** IC2234.2 +070300* * IC2234.2 +070400* VALIDATION FOR:- * IC2234.2 +070500* * IC2234.2 +070600* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +070700* * IC2234.2 +070800* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +070900* * IC2234.2 +071000**************************************************************** IC2234.2 +071100* * IC2234.2 +071200* X-CARDS USED BY THIS PROGRAM ARE :- * IC2234.2 +071300* * IC2234.2 +071400* X-55 - SYSTEM PRINTER NAME. * IC2234.2 +071500* X-82 - SOURCE COMPUTER NAME. * IC2234.2 +071600* X-83 - OBJECT COMPUTER NAME. * IC2234.2 +071700* * IC2234.2 +071800**************************************************************** IC2234.2 +071900* * IC2234.2 +072000* PROGRAM IC223A AND IC223A-1 WILL TEST THE NEW LANGUAGE * IC2234.2 +072100* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2234.2 +072200* MODULE. * IC2234.2 +072300* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2234.2 +072400* "BY REFERENCE" PHRASE * IC2234.2 +072500* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2234.2 +072600* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2234.2 +072700* IDENTIFICATION DIVISION. * IC2234.2 +072800* PROGRAM-ID. IC223A. * IC2234.2 +072900* . * IC2234.2 +073000* . * IC2234.2 +073100* . * IC2234.2 +073200* END PROGRAM IC223A. * IC2234.2 +073300* PROGRAM-ID. IC223A-1. * IC2234.2 +073400* . * IC2234.2 +073500* . * IC2234.2 +073600* . * IC2234.2 +073700**************************************************************** IC2234.2 +073800 ENVIRONMENT DIVISION. IC2234.2 +073900 CONFIGURATION SECTION. IC2234.2 +074000 SOURCE-COMPUTER. IC2234.2 +074100 XXXXX082. IC2234.2 +074200 OBJECT-COMPUTER. IC2234.2 +074300 XXXXX083. IC2234.2 +074400 INPUT-OUTPUT SECTION. IC2234.2 +074500 FILE-CONTROL. IC2234.2 +074600 SELECT PRINT-FILE ASSIGN TO IC2234.2 +074700 XXXXX055. IC2234.2 +074800 DATA DIVISION. IC2234.2 +074900 FILE SECTION. IC2234.2 +075000 FD PRINT-FILE. IC2234.2 +075100 01 PRINT-REC PICTURE X(120). IC2234.2 +075200 01 DUMMY-RECORD PICTURE X(120). IC2234.2 +075300 WORKING-STORAGE SECTION. IC2234.2 +075400 77 WS1 PICTURE S999. IC2234.2 +075500 77 WS2 PICTURE S999 IC2234.2 +075600 USAGE COMPUTATIONAL, VALUE ZERO. IC2234.2 +075700 LINKAGE SECTION. IC2234.2 +075800 77 DN1 PICTURE S99. IC2234.2 +075900 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2234.2 +076000 77 DN3 PICTURE S99. IC2234.2 +076100 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2234.2 +076200 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2234.2 +076300 SECT-IC223A-1-001 SECTION. IC2234.2 +076400 CALL-TEST-001. IC2234.2 +076500 MOVE DN1 TO WS1. IC2234.2 +076600 ADD 1 TO WS1. IC2234.2 +076700 ADD 1 TO WS2. IC2234.2 +076800 MOVE WS1 TO DN3. IC2234.2 +076900 MOVE WS2 TO DN4. IC2234.2 +077000 CALL-EXIT-001. IC2234.2 +077100 EXIT PROGRAM. IC2234.2 +*END-OF,IC223A +*HEADER,COBOL,IC224A +000100 IDENTIFICATION DIVISION. IC2244.2 +000200 PROGRAM-ID. IC2244.2 +000300 IC224A. IC2244.2 +000400**************************************************************** IC2244.2 +000500* * IC2244.2 +000600* VALIDATION FOR:- * IC2244.2 +000700* * IC2244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +000900* * IC2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +001100* * IC2244.2 +001200**************************************************************** IC2244.2 +001300* * IC2244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2244.2 +001500* * IC2244.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2244.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2244.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2244.2 +001900* * IC2244.2 +002000**************************************************************** IC2244.2 +002100* * IC2244.2 +002200* PROGRAM IC224A AND IC224A-1 WILL TEST THE NEW LANGUAGE * IC2244.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2244.2 +002400* MODULE. * IC2244.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2244.2 +002600* "BY CONTENT" PHRASE * IC2244.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2244.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2244.2 +002900* IDENTIFICATION DIVISION. * IC2244.2 +003000* PROGRAM-ID. IC224A. * IC2244.2 +003100* . * IC2244.2 +003200* . * IC2244.2 +003300* . * IC2244.2 +003400* END PROGRAM IC224A. * IC2244.2 +003500* PROGRAM-ID. IC224A-1. * IC2244.2 +003600* . * IC2244.2 +003700* . * IC2244.2 +003800* . * IC2244.2 +003900**************************************************************** IC2244.2 +004000 ENVIRONMENT DIVISION. IC2244.2 +004100 CONFIGURATION SECTION. IC2244.2 +004200 SOURCE-COMPUTER. IC2244.2 +004300 XXXXX082. IC2244.2 +004400 OBJECT-COMPUTER. IC2244.2 +004500 XXXXX083. IC2244.2 +004600 INPUT-OUTPUT SECTION. IC2244.2 +004700 FILE-CONTROL. IC2244.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2244.2 +004900 XXXXX055. IC2244.2 +005000 DATA DIVISION. IC2244.2 +005100 FILE SECTION. IC2244.2 +005200 FD PRINT-FILE. IC2244.2 +005300 01 PRINT-REC PICTURE X(120). IC2244.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2244.2 +005500 WORKING-STORAGE SECTION. IC2244.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2244.2 +005700 77 DN3 PICTURE S99. IC2244.2 +005800 77 ID1 PICTURE X(8) VALUE "IC224A-1". IC2244.2 +005900 77 ID2 PICTURE X(8). IC2244.2 +006000 77 DN2 PICTURE S99 IC2244.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2244.2 +006200 77 DN4 PICTURE S99 IC2244.2 +006300 USAGE IS COMPUTATIONAL. IC2244.2 +006400 77 SAVE-DN1 PICTURE S99. IC2244.2 +006500 77 SAVE-DN3 PICTURE S99. IC2244.2 +006600 77 SAVE-DN2 PICTURE S99 IC2244.2 +006700 USAGE COMPUTATIONAL. IC2244.2 +006800 77 SAVE-DN4 PICTURE S99 IC2244.2 +006900 USAGE IS COMPUTATIONAL. IC2244.2 +007000 77 CALL-COUNT PIC S99. IC2244.2 +007100 77 FAIL-FLAG PIC 9. IC2244.2 +007200 01 TEST-RESULTS. IC2244.2 +007300 02 FILLER PIC X VALUE SPACE. IC2244.2 +007400 02 FEATURE PIC X(20) VALUE SPACE. IC2244.2 +007500 02 FILLER PIC X VALUE SPACE. IC2244.2 +007600 02 P-OR-F PIC X(5) VALUE SPACE. IC2244.2 +007700 02 FILLER PIC X VALUE SPACE. IC2244.2 +007800 02 PAR-NAME. IC2244.2 +007900 03 FILLER PIC X(19) VALUE SPACE. IC2244.2 +008000 03 PARDOT-X PIC X VALUE SPACE. IC2244.2 +008100 03 DOTVALUE PIC 99 VALUE ZERO. IC2244.2 +008200 02 FILLER PIC X(8) VALUE SPACE. IC2244.2 +008300 02 RE-MARK PIC X(61). IC2244.2 +008400 01 TEST-COMPUTED. IC2244.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IC2244.2 +008600 02 FILLER PIC X(17) VALUE IC2244.2 +008700 " COMPUTED=". IC2244.2 +008800 02 COMPUTED-X. IC2244.2 +008900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2244.2 +009000 03 COMPUTED-N REDEFINES COMPUTED-A IC2244.2 +009100 PIC -9(9).9(9). IC2244.2 +009200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2244.2 +009300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2244.2 +009400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2244.2 +009500 03 CM-18V0 REDEFINES COMPUTED-A. IC2244.2 +009600 04 COMPUTED-18V0 PIC -9(18). IC2244.2 +009700 04 FILLER PIC X. IC2244.2 +009800 03 FILLER PIC X(50) VALUE SPACE. IC2244.2 +009900 01 TEST-CORRECT. IC2244.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IC2244.2 +010100 02 FILLER PIC X(17) VALUE " CORRECT =". IC2244.2 +010200 02 CORRECT-X. IC2244.2 +010300 03 CORRECT-A PIC X(20) VALUE SPACE. IC2244.2 +010400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2244.2 +010500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2244.2 +010600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2244.2 +010700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2244.2 +010800 03 CR-18V0 REDEFINES CORRECT-A. IC2244.2 +010900 04 CORRECT-18V0 PIC -9(18). IC2244.2 +011000 04 FILLER PIC X. IC2244.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IC2244.2 +011200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2244.2 +011300 01 CCVS-C-1. IC2244.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2244.2 +011500- "SS PARAGRAPH-NAME IC2244.2 +011600- " REMARKS". IC2244.2 +011700 02 FILLER PIC X(20) VALUE SPACE. IC2244.2 +011800 01 CCVS-C-2. IC2244.2 +011900 02 FILLER PIC X VALUE SPACE. IC2244.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". IC2244.2 +012100 02 FILLER PIC X(15) VALUE SPACE. IC2244.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". IC2244.2 +012300 02 FILLER PIC X(94) VALUE SPACE. IC2244.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2244.2 +012500 01 REC-CT PIC 99 VALUE ZERO. IC2244.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2244.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2244.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2244.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2244.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2244.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2244.2 +013500 01 CCVS-H-1. IC2244.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IC2244.2 +013700 02 FILLER PIC X(42) VALUE IC2244.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2244.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IC2244.2 +014000 01 CCVS-H-2A. IC2244.2 +014100 02 FILLER PIC X(40) VALUE SPACE. IC2244.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2244.2 +014300 02 FILLER PIC XXXX VALUE IC2244.2 +014400 "4.2 ". IC2244.2 +014500 02 FILLER PIC X(28) VALUE IC2244.2 +014600 " COPY - NOT FOR DISTRIBUTION". IC2244.2 +014700 02 FILLER PIC X(41) VALUE SPACE. IC2244.2 +014800 IC2244.2 +014900 01 CCVS-H-2B. IC2244.2 +015000 02 FILLER PIC X(15) VALUE IC2244.2 +015100 "TEST RESULT OF ". IC2244.2 +015200 02 TEST-ID PIC X(9). IC2244.2 +015300 02 FILLER PIC X(4) VALUE IC2244.2 +015400 " IN ". IC2244.2 +015500 02 FILLER PIC X(12) VALUE IC2244.2 +015600 " HIGH ". IC2244.2 +015700 02 FILLER PIC X(22) VALUE IC2244.2 +015800 " LEVEL VALIDATION FOR ". IC2244.2 +015900 02 FILLER PIC X(58) VALUE IC2244.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +016100 01 CCVS-H-3. IC2244.2 +016200 02 FILLER PIC X(34) VALUE IC2244.2 +016300 " FOR OFFICIAL USE ONLY ". IC2244.2 +016400 02 FILLER PIC X(58) VALUE IC2244.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +016600 02 FILLER PIC X(28) VALUE IC2244.2 +016700 " COPYRIGHT 1985 ". IC2244.2 +016800 01 CCVS-E-1. IC2244.2 +016900 02 FILLER PIC X(52) VALUE SPACE. IC2244.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2244.2 +017100 02 ID-AGAIN PIC X(9). IC2244.2 +017200 02 FILLER PIC X(45) VALUE SPACES. IC2244.2 +017300 01 CCVS-E-2. IC2244.2 +017400 02 FILLER PIC X(31) VALUE SPACE. IC2244.2 +017500 02 FILLER PIC X(21) VALUE SPACE. IC2244.2 +017600 02 CCVS-E-2-2. IC2244.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2244.2 +017800 03 FILLER PIC X VALUE SPACE. IC2244.2 +017900 03 ENDER-DESC PIC X(44) VALUE IC2244.2 +018000 "ERRORS ENCOUNTERED". IC2244.2 +018100 01 CCVS-E-3. IC2244.2 +018200 02 FILLER PIC X(22) VALUE IC2244.2 +018300 " FOR OFFICIAL USE ONLY". IC2244.2 +018400 02 FILLER PIC X(12) VALUE SPACE. IC2244.2 +018500 02 FILLER PIC X(58) VALUE IC2244.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +018700 02 FILLER PIC X(13) VALUE SPACE. IC2244.2 +018800 02 FILLER PIC X(15) VALUE IC2244.2 +018900 " COPYRIGHT 1985". IC2244.2 +019000 01 CCVS-E-4. IC2244.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2244.2 +019200 02 FILLER PIC X(4) VALUE " OF ". IC2244.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2244.2 +019400 02 FILLER PIC X(40) VALUE IC2244.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". IC2244.2 +019600 01 XXINFO. IC2244.2 +019700 02 FILLER PIC X(19) VALUE IC2244.2 +019800 "*** INFORMATION ***". IC2244.2 +019900 02 INFO-TEXT. IC2244.2 +020000 04 FILLER PIC X(8) VALUE SPACE. IC2244.2 +020100 04 XXCOMPUTED PIC X(20). IC2244.2 +020200 04 FILLER PIC X(5) VALUE SPACE. IC2244.2 +020300 04 XXCORRECT PIC X(20). IC2244.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). IC2244.2 +020500 01 HYPHEN-LINE. IC2244.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. IC2244.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************IC2244.2 +020800- "*****************************************". IC2244.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************IC2244.2 +021000- "******************************". IC2244.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE IC2244.2 +021200 "IC224A". IC2244.2 +021300 PROCEDURE DIVISION. IC2244.2 +021400 CCVS1 SECTION. IC2244.2 +021500 OPEN-FILES. IC2244.2 +021600 OPEN OUTPUT PRINT-FILE. IC2244.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2244.2 +021800 MOVE SPACE TO TEST-RESULTS. IC2244.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2244.2 +022000 GO TO CCVS1-EXIT. IC2244.2 +022100 CLOSE-FILES. IC2244.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2244.2 +022300 TERMINATE-CCVS. IC2244.2 +022400S EXIT PROGRAM. IC2244.2 +022500STERMINATE-CALL. IC2244.2 +022600 STOP RUN. IC2244.2 +022700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2244.2 +022800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2244.2 +022900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2244.2 +023000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2244.2 +023100 MOVE "****TEST DELETED****" TO RE-MARK. IC2244.2 +023200 PRINT-DETAIL. IC2244.2 +023300 IF REC-CT NOT EQUAL TO ZERO IC2244.2 +023400 MOVE "." TO PARDOT-X IC2244.2 +023500 MOVE REC-CT TO DOTVALUE. IC2244.2 +023600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2244.2 +023700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2244.2 +023800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2244.2 +023900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2244.2 +024000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2244.2 +024100 MOVE SPACE TO CORRECT-X. IC2244.2 +024200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2244.2 +024300 MOVE SPACE TO RE-MARK. IC2244.2 +024400 HEAD-ROUTINE. IC2244.2 +024500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +024600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +024700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2244.2 +024800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2244.2 +024900 COLUMN-NAMES-ROUTINE. IC2244.2 +025000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +025100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +025300 END-ROUTINE. IC2244.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2244.2 +025500 END-RTN-EXIT. IC2244.2 +025600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +025700 END-ROUTINE-1. IC2244.2 +025800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2244.2 +025900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2244.2 +026000 ADD PASS-COUNTER TO ERROR-HOLD. IC2244.2 +026100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2244.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2244.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2244.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2244.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2244.2 +026600 END-ROUTINE-12. IC2244.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2244.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IC2244.2 +026900 MOVE "NO " TO ERROR-TOTAL IC2244.2 +027000 ELSE IC2244.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2244.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2244.2 +027300 PERFORM WRITE-LINE. IC2244.2 +027400 END-ROUTINE-13. IC2244.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IC2244.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IC2244.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2244.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2244.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IC2244.2 +028100 MOVE "NO " TO ERROR-TOTAL IC2244.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2244.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2244.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028600 WRITE-LINE. IC2244.2 +028700 ADD 1 TO RECORD-COUNT. IC2244.2 +028800Y IF RECORD-COUNT GREATER 50 IC2244.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2244.2 +029000Y MOVE SPACE TO DUMMY-RECORD IC2244.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2244.2 +029200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2244.2 +029300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2244.2 +029400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2244.2 +029500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2244.2 +029600Y MOVE ZERO TO RECORD-COUNT. IC2244.2 +029700 PERFORM WRT-LN. IC2244.2 +029800 WRT-LN. IC2244.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2244.2 +030000 MOVE SPACE TO DUMMY-RECORD. IC2244.2 +030100 BLANK-LINE-PRINT. IC2244.2 +030200 PERFORM WRT-LN. IC2244.2 +030300 FAIL-ROUTINE. IC2244.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2244.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2244.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2244.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2244.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2244.2 +031000 GO TO FAIL-ROUTINE-EX. IC2244.2 +031100 FAIL-ROUTINE-WRITE. IC2244.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2244.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2244.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2244.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. IC2244.2 +031600 FAIL-ROUTINE-EX. EXIT. IC2244.2 +031700 BAIL-OUT. IC2244.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2244.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2244.2 +032000 BAIL-OUT-WRITE. IC2244.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2244.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2244.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2244.2 +032500 BAIL-OUT-EX. EXIT. IC2244.2 +032600 CCVS1-EXIT. IC2244.2 +032700 EXIT. IC2244.2 +032800 SECT-IC224A-001 SECTION. IC2244.2 +032900 CALL-TEST-01. IC2244.2 +033000 MOVE "CALL-TEST-01" TO PAR-NAME. IC2244.2 +033100 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2244.2 +033200 MOVE 0 TO CALL-COUNT. IC2244.2 +033300* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2244.2 +033400* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2244.2 +033500* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2244.2 +033600* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2244.2 +033700* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2244.2 +033800 CALL-TEST-01-01. IC2244.2 +033900 MOVE ZERO TO DN3, DN4. IC2244.2 +034000 MOVE "CALL-TEST-01-01" TO PAR-NAME. IC2244.2 +034100 MOVE DN1 TO SAVE-DN1. IC2244.2 +034200 MOVE DN2 TO SAVE-DN2. IC2244.2 +034300 MOVE DN3 TO SAVE-DN3. IC2244.2 +034400 MOVE DN4 TO SAVE-DN4. IC2244.2 +034500 CALL "IC224A-1" USING BY CONTENT DN1, DN2, DN3, DN4 IC2244.2 +034600 END-CALL. IC2244.2 +034700 PERFORM CHECK-TEST-01. IC2244.2 +034800 CALL-TEST-01-02. IC2244.2 +034900 ADD 1 TO REC-CT. IC2244.2 +035000 MOVE ZERO TO DN3, DN4. IC2244.2 +035100 MOVE "CALL-TEST-01-02" TO PAR-NAME. IC2244.2 +035200 MOVE DN1 TO SAVE-DN1. IC2244.2 +035300 MOVE DN2 TO SAVE-DN2. IC2244.2 +035400 MOVE DN3 TO SAVE-DN3. IC2244.2 +035500 MOVE DN4 TO SAVE-DN4. IC2244.2 +035600 CALL ID1 USING CONTENT DN1, DN2, DN3, DN4 IC2244.2 +035700 END-CALL. IC2244.2 +035800 PERFORM CHECK-TEST-01. IC2244.2 +035900 CALL-TEST-01-03. IC2244.2 +036000 MOVE ID1 TO ID2. IC2244.2 +036100 MOVE ZERO TO DN3, DN4. IC2244.2 +036200 MOVE "CALL-TEST-01-03" TO PAR-NAME. IC2244.2 +036300 MOVE DN1 TO SAVE-DN1. IC2244.2 +036400 MOVE DN2 TO SAVE-DN2. IC2244.2 +036500 MOVE DN3 TO SAVE-DN3. IC2244.2 +036600 MOVE DN4 TO SAVE-DN4. IC2244.2 +036700 CALL ID2 USING CONTENT DN1 DN2 DN3 DN4 IC2244.2 +036800 END-CALL. IC2244.2 +036900 PERFORM CHECK-TEST-01. IC2244.2 +037000 CALL-TEST-01-04. IC2244.2 +037100 MOVE "IC224A-1" TO ID2. IC2244.2 +037200 MOVE ZERO TO DN3, DN4. IC2244.2 +037300 MOVE "CALL-TEST-01-03" TO PAR-NAME. IC2244.2 +037400 MOVE DN1 TO SAVE-DN1. IC2244.2 +037500 MOVE DN2 TO SAVE-DN2. IC2244.2 +037600 MOVE DN3 TO SAVE-DN3. IC2244.2 +037700 MOVE DN4 TO SAVE-DN4. IC2244.2 +037800 CALL ID2 USING CONTENT DN1, DN2, DN3, DN4 IC2244.2 +037900 END-CALL. IC2244.2 +038000 PERFORM CHECK-TEST-01. IC2244.2 +038100 CALL-TEST-02. IC2244.2 +038200 MOVE "CALL-TEST-02" TO PAR-NAME. IC2244.2 +038300 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2244.2 +038400* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2244.2 +038500* A USING PHRASE OF A CALL STATEMENT. IC2244.2 +038600 CALL-INIT-02-01. IC2244.2 +038700 MOVE 1 TO DN1. IC2244.2 +038800 MOVE 0 TO DN2, DN3, DN4. IC2244.2 +038900 MOVE "CALL-TEST-02-01" TO PAR-NAME. IC2244.2 +039000 MOVE DN1 TO SAVE-DN1. IC2244.2 +039100 MOVE DN2 TO SAVE-DN2. IC2244.2 +039200 MOVE DN3 TO SAVE-DN3. IC2244.2 +039300 MOVE DN4 TO SAVE-DN4. IC2244.2 +039400 GO TO CALL-TEST-02-01. IC2244.2 +039500 CALL-DELETE-02-01. IC2244.2 +039600 PERFORM DE-LETE. IC2244.2 +039700 PERFORM PRINT-DETAIL. IC2244.2 +039800 GO TO CALL-INIT-02-02. IC2244.2 +039900 CALL-TEST-02-01. IC2244.2 +040000 CALL "IC224A-1" USING CONTENT DN1, DN2, DN1, DN4 IC2244.2 +040100 END-CALL. IC2244.2 +040200 PERFORM CHECK-TEST-01. IC2244.2 +040300 CALL-INIT-02-02. IC2244.2 +040400 MOVE 0 TO DN1, DN2, DN3, DN4. IC2244.2 +040500 MOVE "CALL-TEST-02-02" TO PAR-NAME. IC2244.2 +040600 MOVE DN1 TO SAVE-DN1. IC2244.2 +040700 MOVE DN2 TO SAVE-DN2. IC2244.2 +040800 MOVE DN3 TO SAVE-DN3. IC2244.2 +040900 MOVE DN4 TO SAVE-DN4. IC2244.2 +041000 GO TO CALL-TEST-02-02. IC2244.2 +041100 CALL-DELETE-02-02. IC2244.2 +041200 PERFORM DE-LETE. IC2244.2 +041300 PERFORM PRINT-DETAIL. IC2244.2 +041400 GO TO CALL-INIT-02-03. IC2244.2 +041500 CALL-TEST-02-02. IC2244.2 +041600 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN2 IC2244.2 +041700 END-CALL. IC2244.2 +041800 PERFORM CHECK-TEST-01. IC2244.2 +041900 CALL-INIT-02-03. IC2244.2 +042000 MOVE 0 TO DN4, DN3. IC2244.2 +042100 MOVE 10 TO DN2. IC2244.2 +042200 MOVE 25 TO DN1. IC2244.2 +042300 MOVE "CALL-TEST-02-03" TO PAR-NAME. IC2244.2 +042400 MOVE DN1 TO SAVE-DN1. IC2244.2 +042500 MOVE DN2 TO SAVE-DN2. IC2244.2 +042600 MOVE DN3 TO SAVE-DN3. IC2244.2 +042700 MOVE DN4 TO SAVE-DN4. IC2244.2 +042800 GO TO CALL-TEST-02-03. IC2244.2 +042900 CALL-DELETE-02-03. IC2244.2 +043000 PERFORM DE-LETE. IC2244.2 +043100 PERFORM PRINT-DETAIL. IC2244.2 +043200 GO TO CALL-TEST-03. IC2244.2 +043300 CALL-TEST-02-03. IC2244.2 +043400 CALL ID1 USING CONTENT DN1 DN2 DN1 DN2 IC2244.2 +043500 END-CALL. IC2244.2 +043600 PERFORM CHECK-TEST-01. IC2244.2 +043700 CALL-TEST-03. IC2244.2 +043800* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2244.2 +043900* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2244.2 +044000* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2244.2 +044100 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2244.2 +044200 CALL-INIT-03-01. IC2244.2 +044300 MOVE 20 TO DN1. IC2244.2 +044400 MOVE 30 TO DN2. IC2244.2 +044500 MOVE ZERO TO DN3, DN4. IC2244.2 +044600 MOVE "CALL-TEST-03-01" TO PAR-NAME. IC2244.2 +044700 MOVE DN1 TO SAVE-DN1. IC2244.2 +044800 MOVE DN2 TO SAVE-DN2. IC2244.2 +044900 MOVE DN3 TO SAVE-DN3. IC2244.2 +045000 MOVE DN4 TO SAVE-DN4. IC2244.2 +045100 GO TO CALL-TEST-03-01. IC2244.2 +045200 CALL-DELETE-03-01. IC2244.2 +045300 PERFORM DE-LETE. IC2244.2 +045400 PERFORM PRINT-DETAIL. IC2244.2 +045500 GO TO CALL-INIT-03-02. IC2244.2 +045600 CALL-TEST-03-01. IC2244.2 +045700 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN4; IC2244.2 +045800 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +045900 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +046000 END-CALL. IC2244.2 +046100 MOVE "CALL-TEST-03-01" TO PAR-NAME. IC2244.2 +046200 PERFORM CHECK-TEST-01. IC2244.2 +046300 CALL-INIT-03-02. IC2244.2 +046400 MOVE ZERO TO DN3, DN4. IC2244.2 +046500 MOVE "CALL-TEST-03-02" TO PAR-NAME. IC2244.2 +046600 MOVE DN1 TO SAVE-DN1. IC2244.2 +046700 MOVE DN2 TO SAVE-DN2. IC2244.2 +046800 MOVE DN3 TO SAVE-DN3. IC2244.2 +046900 MOVE DN4 TO SAVE-DN4. IC2244.2 +047000 GO TO CALL-TEST-03-02. IC2244.2 +047100 CALL-DELETE-03-02. IC2244.2 +047200 PERFORM DE-LETE. IC2244.2 +047300 PERFORM PRINT-DETAIL. IC2244.2 +047400 GO TO CALL-INIT-03-03. IC2244.2 +047500 CALL-TEST-03-02. IC2244.2 +047600 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN4; IC2244.2 +047700 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +047800 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +047900 END-CALL. IC2244.2 +048000 PERFORM CHECK-TEST-01. IC2244.2 +048100 CALL-INIT-03-03. IC2244.2 +048200 MOVE ZERO TO DN3, DN4. IC2244.2 +048300 MOVE "CALL-TEST-03-03" TO PAR-NAME. IC2244.2 +048400 MOVE DN1 TO SAVE-DN1. IC2244.2 +048500 MOVE DN2 TO SAVE-DN2. IC2244.2 +048600 MOVE DN3 TO SAVE-DN3. IC2244.2 +048700 MOVE DN4 TO SAVE-DN4. IC2244.2 +048800 GO TO CALL-TEST-03-03. IC2244.2 +048900 CALL-DELETE-03-03. IC2244.2 +049000 PERFORM DE-LETE. IC2244.2 +049100 PERFORM PRINT-DETAIL. IC2244.2 +049200 GO TO CALL-INIT-03-04. IC2244.2 +049300 CALL-TEST-03-03. IC2244.2 +049400 CALL ID1 USING CONTENT DN1 DN2 DN3 DN4 IC2244.2 +049500 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +049600 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +049700 END-CALL. IC2244.2 +049800 PERFORM CHECK-TEST-01. IC2244.2 +049900 CALL-INIT-03-04. IC2244.2 +050000 MOVE ZERO TO DN3, DN4. IC2244.2 +050100 MOVE "CALL-TEST-03-04" TO PAR-NAME. IC2244.2 +050200 MOVE DN1 TO SAVE-DN1. IC2244.2 +050300 MOVE DN2 TO SAVE-DN2. IC2244.2 +050400 MOVE DN3 TO SAVE-DN3. IC2244.2 +050500 MOVE DN4 TO SAVE-DN4. IC2244.2 +050600 GO TO CALL-TEST-03-04. IC2244.2 +050700 CALL-DELETE-03-04. IC2244.2 +050800 PERFORM DE-LETE. IC2244.2 +050900 PERFORM PRINT-DETAIL. IC2244.2 +051000 GO TO EXIT-IC224A. IC2244.2 +051100 CALL-TEST-03-04. IC2244.2 +051200 CALL ID1 USING CONTENT DN1 DN2 DN3 DN4; IC2244.2 +051300 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2244.2 +051400 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +051500 END-CALL. IC2244.2 +051600 PERFORM CHECK-TEST-01. IC2244.2 +051700 GO TO EXIT-IC224A. IC2244.2 +051800 CALL-DELETE-03. IC2244.2 +051900* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2244.2 +052000* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2244.2 +052100* CALL-TEST-03-01. IC2244.2 +052200 PERFORM DE-LETE. IC2244.2 +052300 PERFORM PRINT-DETAIL. IC2244.2 +052400 EXIT-IC224A. IC2244.2 +052500 GO TO CCVS-EXIT. IC2244.2 +052600* IC2244.2 +052700 SECT-IC224A-CHECK-01. IC2244.2 +052800*===================== IC2244.2 +052900 CHECK-TEST-01. IC2244.2 +053000 MOVE 1 TO REC-CT. IC2244.2 +053100 IF DN1 = SAVE-DN1 IC2244.2 +053200 PERFORM PASS IC2244.2 +053300 PERFORM PRINT-DETAIL IC2244.2 +053400 ELSE IC2244.2 +053500 MOVE SAVE-DN1 TO CORRECT-N IC2244.2 +053600 MOVE DN1 TO COMPUTED-N IC2244.2 +053700 MOVE "VALUE OF DN1 HAS CHANGED" TO RE-MARK IC2244.2 +053800 PERFORM FAIL IC2244.2 +053900 PERFORM PRINT-DETAIL. IC2244.2 +054000 ADD 1 TO REC-CT. IC2244.2 +054100 IF DN2 = SAVE-DN2 IC2244.2 +054200 PERFORM PASS IC2244.2 +054300 PERFORM PRINT-DETAIL IC2244.2 +054400 ELSE IC2244.2 +054500 MOVE SAVE-DN2 TO CORRECT-N IC2244.2 +054600 MOVE DN2 TO COMPUTED-N IC2244.2 +054700 MOVE "VALUE OF DN2 HAS CHANGED" TO RE-MARK IC2244.2 +054800 PERFORM FAIL IC2244.2 +054900 PERFORM PRINT-DETAIL. IC2244.2 +055000 ADD 1 TO REC-CT. IC2244.2 +055100 IF DN3 = SAVE-DN3 IC2244.2 +055200 PERFORM PASS IC2244.2 +055300 PERFORM PRINT-DETAIL IC2244.2 +055400 ELSE IC2244.2 +055500 MOVE SAVE-DN3 TO CORRECT-N IC2244.2 +055600 MOVE DN3 TO COMPUTED-N IC2244.2 +055700 MOVE "VALUE OF DN3 HAS CHANGED" TO RE-MARK IC2244.2 +055800 PERFORM FAIL IC2244.2 +055900 PERFORM PRINT-DETAIL. IC2244.2 +056000 ADD 1 TO REC-CT. IC2244.2 +056100 IF DN4 = SAVE-DN4 IC2244.2 +056200 PERFORM PASS IC2244.2 +056300 PERFORM PRINT-DETAIL IC2244.2 +056400 ELSE IC2244.2 +056500 MOVE SAVE-DN4 TO CORRECT-N IC2244.2 +056600 MOVE DN4 TO COMPUTED-N IC2244.2 +056700 MOVE "VALUE OF DN4 HAS CHANGED" TO RE-MARK IC2244.2 +056800 PERFORM FAIL IC2244.2 +056900 PERFORM PRINT-DETAIL. IC2244.2 +057000* IC2244.2 +057100* IC2244.2 +057200 CCVS-EXIT SECTION. IC2244.2 +057300 CCVS-999999. IC2244.2 +057400 GO TO CLOSE-FILES. IC2244.2 +057500 END PROGRAM IC224A. IC2244.2 +057600 IDENTIFICATION DIVISION. IC2244.2 +057700 PROGRAM-ID. IC2244.2 +057800 IC224A-1. IC2244.2 +057900**************************************************************** IC2244.2 +058000* * IC2244.2 +058100* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2244.2 +058200* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2244.2 +058300* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2244.2 +058400* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2244.2 +058500* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2244.2 +058600* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2244.2 +058700* * IC2244.2 +058800* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2244.2 +058900* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2244.2 +059000* DOCUMENT REFERENCE: ISO-1989-1978). * IC2244.2 +059100* * IC2244.2 +059200* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2244.2 +059300* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2244.2 +059400* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2244.2 +059500* * IC2244.2 +059600* THE FEDERAL SOFTWARE TESTING CENTER * IC2244.2 +059700* OFFICE OF SOFTWARE DEVELOPMENT * IC2244.2 +059800* & INFORMATION TECHNOLOGY * IC2244.2 +059900* TWO SKYLINE PLACE * IC2244.2 +060000* SUITE 1100 * IC2244.2 +060100* 5203 LEESBURG PIKE * IC2244.2 +060200* FALLS CHURCH * IC2244.2 +060300* VA 22041 * IC2244.2 +060400* U.S.A. * IC2244.2 +060500* * IC2244.2 +060600* THE PROJECT TEAM MEMBERS WERE: * IC2244.2 +060700* * IC2244.2 +060800* BIADI (BUREAU INTER ADMINISTRATION * IC2244.2 +060900* DE DOCUMENTATION INFORMATIQUE) * IC2244.2 +061000* 21 RUE BARA * IC2244.2 +061100* F-92132 ISSY * IC2244.2 +061200* FRANCE * IC2244.2 +061300* * IC2244.2 +061400* * IC2244.2 +061500* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2244.2 +061600* UND DATENVERARBEITUNG MBH) * IC2244.2 +061700* SCHLOSS BIRLINGHOVEN * IC2244.2 +061800* POSTFACH 12 40 * IC2244.2 +061900* D-5205 ST. AUGUSTIN 1 * IC2244.2 +062000* GERMANY FR * IC2244.2 +062100* * IC2244.2 +062200* * IC2244.2 +062300* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2244.2 +062400* OXFORD ROAD * IC2244.2 +062500* MANCHESTER * IC2244.2 +062600* M1 7ED * IC2244.2 +062700* UNITED KINGDOM * IC2244.2 +062800* * IC2244.2 +062900* * IC2244.2 +063000* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2244.2 +063100* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2244.2 +063200* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2244.2 +063300* * IC2244.2 +063400**************************************************************** IC2244.2 +063500* * IC2244.2 +063600* VALIDATION FOR:- * IC2244.2 +063700* * IC2244.2 +063800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +063900* * IC2244.2 +064000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +064100* * IC2244.2 +064200**************************************************************** IC2244.2 +064300* * IC2244.2 +064400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2244.2 +064500* * IC2244.2 +064600* X-55 - SYSTEM PRINTER NAME. * IC2244.2 +064700* X-82 - SOURCE COMPUTER NAME. * IC2244.2 +064800* X-83 - OBJECT COMPUTER NAME. * IC2244.2 +064900* * IC2244.2 +065000**************************************************************** IC2244.2 +065100* * IC2244.2 +065200* PROGRAM IC224A AND IC224A-1 WILL TEST THE NEW LANGUAGE * IC2244.2 +065300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2244.2 +065400* MODULE. * IC2244.2 +065500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2244.2 +065600* "BY CONTENT" PHRASE * IC2244.2 +065700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2244.2 +065800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2244.2 +065900* IDENTIFICATION DIVISION. * IC2244.2 +066000* PROGRAM-ID. IC224A. * IC2244.2 +066100* . * IC2244.2 +066200* . * IC2244.2 +066300* . * IC2244.2 +066400* END PROGRAM IC224A. * IC2244.2 +066500* PROGRAM-ID. IC224A-1. * IC2244.2 +066600* . * IC2244.2 +066700* . * IC2244.2 +066800* . * IC2244.2 +066900**************************************************************** IC2244.2 +067000 ENVIRONMENT DIVISION. IC2244.2 +067100 CONFIGURATION SECTION. IC2244.2 +067200 SOURCE-COMPUTER. IC2244.2 +067300 XXXXX082. IC2244.2 +067400 OBJECT-COMPUTER. IC2244.2 +067500 XXXXX083. IC2244.2 +067600 INPUT-OUTPUT SECTION. IC2244.2 +067700 FILE-CONTROL. IC2244.2 +067800 SELECT PRINT-FILE ASSIGN TO IC2244.2 +067900 XXXXX055. IC2244.2 +068000 DATA DIVISION. IC2244.2 +068100 FILE SECTION. IC2244.2 +068200 FD PRINT-FILE. IC2244.2 +068300 01 PRINT-REC PICTURE X(120). IC2244.2 +068400 01 DUMMY-RECORD PICTURE X(120). IC2244.2 +068500 WORKING-STORAGE SECTION. IC2244.2 +068600 77 WS1 PICTURE S999. IC2244.2 +068700 77 WS2 PICTURE S999 IC2244.2 +068800 USAGE COMPUTATIONAL, VALUE ZERO. IC2244.2 +068900 LINKAGE SECTION. IC2244.2 +069000 77 DN1 PICTURE S99. IC2244.2 +069100 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2244.2 +069200 77 DN3 PICTURE S99. IC2244.2 +069300 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2244.2 +069400 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2244.2 +069500 SECT-IC224A-1-001 SECTION. IC2244.2 +069600 CALL-TEST-001. IC2244.2 +069700 MOVE DN1 TO WS1. IC2244.2 +069800 ADD 1 TO WS1. IC2244.2 +069900 ADD 1 TO WS2. IC2244.2 +070000 MOVE WS1 TO DN3. IC2244.2 +070100 MOVE WS2 TO DN4. IC2244.2 +070200 CALL-EXIT-001. IC2244.2 +070300 EXIT PROGRAM. IC2244.2 +*END-OF,IC224A +*HEADER,COBOL,IC225A +000100 IDENTIFICATION DIVISION. IC2254.2 +000200 PROGRAM-ID. IC2254.2 +000300 IC225A. IC2254.2 +000400**************************************************************** IC2254.2 +000500* * IC2254.2 +000600* VALIDATION FOR:- * IC2254.2 +000700* * IC2254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +000900* * IC2254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +001100* * IC2254.2 +001200**************************************************************** IC2254.2 +001300* * IC2254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2254.2 +001500* * IC2254.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2254.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2254.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2254.2 +001900* * IC2254.2 +002000**************************************************************** IC2254.2 +002100* * IC2254.2 +002200* PROGRAM IC225A AND IC225A-1 WILL TEST THE NEW LANGUAGE * IC2254.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2254.2 +002400* MODULE. * IC2254.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2254.2 +002600* "BY REFERENCE" PHRASE * IC2254.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2254.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2254.2 +002900* IDENTIFICATION DIVISION. * IC2254.2 +003000* PROGRAM-ID. IC225A. * IC2254.2 +003100* . * IC2254.2 +003200* . * IC2254.2 +003300* . * IC2254.2 +003400* END PROGRAM IC225A. * IC2254.2 +003500* PROGRAM-ID. IC225A-1. * IC2254.2 +003600* . * IC2254.2 +003700* . * IC2254.2 +003800* . * IC2254.2 +003900**************************************************************** IC2254.2 +004000 ENVIRONMENT DIVISION. IC2254.2 +004100 CONFIGURATION SECTION. IC2254.2 +004200 SOURCE-COMPUTER. IC2254.2 +004300 XXXXX082. IC2254.2 +004400 OBJECT-COMPUTER. IC2254.2 +004500 XXXXX083. IC2254.2 +004600 INPUT-OUTPUT SECTION. IC2254.2 +004700 FILE-CONTROL. IC2254.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2254.2 +004900 XXXXX055. IC2254.2 +005000 DATA DIVISION. IC2254.2 +005100 FILE SECTION. IC2254.2 +005200 FD PRINT-FILE. IC2254.2 +005300 01 PRINT-REC PICTURE X(120). IC2254.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2254.2 +005500 WORKING-STORAGE SECTION. IC2254.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2254.2 +005700 77 DN3 PICTURE S99. IC2254.2 +005800 77 ID1 PICTURE X(8) VALUE "IC225A-1". IC2254.2 +005900 77 ID2 PICTURE X(8). IC2254.2 +006000 77 DN2 PICTURE S99 IC2254.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2254.2 +006200 77 DN4 PICTURE S99 IC2254.2 +006300 USAGE IS COMPUTATIONAL. IC2254.2 +006400 77 CALL-COUNT PIC S99. IC2254.2 +006500 77 FAIL-FLAG PIC 9. IC2254.2 +006600 01 TEST-RESULTS. IC2254.2 +006700 02 FILLER PIC X VALUE SPACE. IC2254.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2254.2 +006900 02 FILLER PIC X VALUE SPACE. IC2254.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2254.2 +007100 02 FILLER PIC X VALUE SPACE. IC2254.2 +007200 02 PAR-NAME. IC2254.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2254.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2254.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2254.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2254.2 +007700 02 RE-MARK PIC X(61). IC2254.2 +007800 01 TEST-COMPUTED. IC2254.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2254.2 +008000 02 FILLER PIC X(17) VALUE IC2254.2 +008100 " COMPUTED=". IC2254.2 +008200 02 COMPUTED-X. IC2254.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2254.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2254.2 +008500 PIC -9(9).9(9). IC2254.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2254.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2254.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2254.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2254.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2254.2 +009100 04 FILLER PIC X. IC2254.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2254.2 +009300 01 TEST-CORRECT. IC2254.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2254.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2254.2 +009600 02 CORRECT-X. IC2254.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2254.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2254.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2254.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2254.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2254.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2254.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2254.2 +010400 04 FILLER PIC X. IC2254.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2254.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2254.2 +010700 01 CCVS-C-1. IC2254.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2254.2 +010900- "SS PARAGRAPH-NAME IC2254.2 +011000- " REMARKS". IC2254.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2254.2 +011200 01 CCVS-C-2. IC2254.2 +011300 02 FILLER PIC X VALUE SPACE. IC2254.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2254.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2254.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2254.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2254.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2254.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2254.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2254.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2254.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2254.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2254.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2254.2 +012900 01 CCVS-H-1. IC2254.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2254.2 +013100 02 FILLER PIC X(42) VALUE IC2254.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2254.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2254.2 +013400 01 CCVS-H-2A. IC2254.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2254.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2254.2 +013700 02 FILLER PIC XXXX VALUE IC2254.2 +013800 "4.2 ". IC2254.2 +013900 02 FILLER PIC X(28) VALUE IC2254.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2254.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2254.2 +014200 IC2254.2 +014300 01 CCVS-H-2B. IC2254.2 +014400 02 FILLER PIC X(15) VALUE IC2254.2 +014500 "TEST RESULT OF ". IC2254.2 +014600 02 TEST-ID PIC X(9). IC2254.2 +014700 02 FILLER PIC X(4) VALUE IC2254.2 +014800 " IN ". IC2254.2 +014900 02 FILLER PIC X(12) VALUE IC2254.2 +015000 " HIGH ". IC2254.2 +015100 02 FILLER PIC X(22) VALUE IC2254.2 +015200 " LEVEL VALIDATION FOR ". IC2254.2 +015300 02 FILLER PIC X(58) VALUE IC2254.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +015500 01 CCVS-H-3. IC2254.2 +015600 02 FILLER PIC X(34) VALUE IC2254.2 +015700 " FOR OFFICIAL USE ONLY ". IC2254.2 +015800 02 FILLER PIC X(58) VALUE IC2254.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +016000 02 FILLER PIC X(28) VALUE IC2254.2 +016100 " COPYRIGHT 1985 ". IC2254.2 +016200 01 CCVS-E-1. IC2254.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2254.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2254.2 +016500 02 ID-AGAIN PIC X(9). IC2254.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2254.2 +016700 01 CCVS-E-2. IC2254.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2254.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2254.2 +017000 02 CCVS-E-2-2. IC2254.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2254.2 +017200 03 FILLER PIC X VALUE SPACE. IC2254.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2254.2 +017400 "ERRORS ENCOUNTERED". IC2254.2 +017500 01 CCVS-E-3. IC2254.2 +017600 02 FILLER PIC X(22) VALUE IC2254.2 +017700 " FOR OFFICIAL USE ONLY". IC2254.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2254.2 +017900 02 FILLER PIC X(58) VALUE IC2254.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2254.2 +018200 02 FILLER PIC X(15) VALUE IC2254.2 +018300 " COPYRIGHT 1985". IC2254.2 +018400 01 CCVS-E-4. IC2254.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2254.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2254.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2254.2 +018800 02 FILLER PIC X(40) VALUE IC2254.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2254.2 +019000 01 XXINFO. IC2254.2 +019100 02 FILLER PIC X(19) VALUE IC2254.2 +019200 "*** INFORMATION ***". IC2254.2 +019300 02 INFO-TEXT. IC2254.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2254.2 +019500 04 XXCOMPUTED PIC X(20). IC2254.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2254.2 +019700 04 XXCORRECT PIC X(20). IC2254.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2254.2 +019900 01 HYPHEN-LINE. IC2254.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2254.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2254.2 +020200- "*****************************************". IC2254.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2254.2 +020400- "******************************". IC2254.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2254.2 +020600 "IC225A". IC2254.2 +020700 PROCEDURE DIVISION. IC2254.2 +020800 CCVS1 SECTION. IC2254.2 +020900 OPEN-FILES. IC2254.2 +021000 OPEN OUTPUT PRINT-FILE. IC2254.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2254.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2254.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2254.2 +021400 GO TO CCVS1-EXIT. IC2254.2 +021500 CLOSE-FILES. IC2254.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2254.2 +021700 TERMINATE-CCVS. IC2254.2 +021800S EXIT PROGRAM. IC2254.2 +021900STERMINATE-CALL. IC2254.2 +022000 STOP RUN. IC2254.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2254.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2254.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2254.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2254.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2254.2 +022600 PRINT-DETAIL. IC2254.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2254.2 +022800 MOVE "." TO PARDOT-X IC2254.2 +022900 MOVE REC-CT TO DOTVALUE. IC2254.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2254.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2254.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2254.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2254.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2254.2 +023500 MOVE SPACE TO CORRECT-X. IC2254.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2254.2 +023700 MOVE SPACE TO RE-MARK. IC2254.2 +023800 HEAD-ROUTINE. IC2254.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2254.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2254.2 +024300 COLUMN-NAMES-ROUTINE. IC2254.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +024700 END-ROUTINE. IC2254.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2254.2 +024900 END-RTN-EXIT. IC2254.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +025100 END-ROUTINE-1. IC2254.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2254.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2254.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2254.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2254.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2254.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2254.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2254.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2254.2 +026000 END-ROUTINE-12. IC2254.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2254.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2254.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2254.2 +026400 ELSE IC2254.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2254.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2254.2 +026700 PERFORM WRITE-LINE. IC2254.2 +026800 END-ROUTINE-13. IC2254.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2254.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2254.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2254.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2254.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2254.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2254.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2254.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2254.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +028000 WRITE-LINE. IC2254.2 +028100 ADD 1 TO RECORD-COUNT. IC2254.2 +028200Y IF RECORD-COUNT GREATER 50 IC2254.2 +028300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2254.2 +028400Y MOVE SPACE TO DUMMY-RECORD IC2254.2 +028500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2254.2 +028600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2254.2 +028700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2254.2 +028800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2254.2 +028900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2254.2 +029000Y MOVE ZERO TO RECORD-COUNT. IC2254.2 +029100 PERFORM WRT-LN. IC2254.2 +029200 WRT-LN. IC2254.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2254.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2254.2 +029500 BLANK-LINE-PRINT. IC2254.2 +029600 PERFORM WRT-LN. IC2254.2 +029700 FAIL-ROUTINE. IC2254.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2254.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2254.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2254.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2254.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2254.2 +030400 GO TO FAIL-ROUTINE-EX. IC2254.2 +030500 FAIL-ROUTINE-WRITE. IC2254.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2254.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2254.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2254.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2254.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2254.2 +031100 BAIL-OUT. IC2254.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2254.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2254.2 +031400 BAIL-OUT-WRITE. IC2254.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2254.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2254.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2254.2 +031900 BAIL-OUT-EX. EXIT. IC2254.2 +032000 CCVS1-EXIT. IC2254.2 +032100 EXIT. IC2254.2 +032200 SECT-IC225A-001 SECTION. IC2254.2 +032300 CALL-TEST-01. IC2254.2 +032400 MOVE "X-27 5.2.2" TO ANSI-REFERENCE. IC2254.2 +032500 MOVE "CALL-TEST-01" TO PAR-NAME. IC2254.2 +032600 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2254.2 +032700 MOVE 0 TO CALL-COUNT. IC2254.2 +032800* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2254.2 +032900* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2254.2 +033000* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2254.2 +033100* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2254.2 +033200* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2254.2 +033300 CALL-INIT-01-01. IC2254.2 +033400 MOVE 1 TO REC-CT. IC2254.2 +033500 MOVE ZERO TO DN3, DN4. IC2254.2 +033600 CALL-TEST-01-01-0. IC2254.2 +033700 CALL "IC225A-1" USING BY REFERENCE DN1, DN2, IC2254.2 +033800 CONTENT DN3, DN4 IC2254.2 +033900 END-CALL. IC2254.2 +034000 GO TO CALL-TEST-01-01-1. IC2254.2 +034100 CALL-DELETE-01-01. IC2254.2 +034200 PERFORM DE-LETE. IC2254.2 +034300 PERFORM PRINT-DETAIL. IC2254.2 +034400 GO TO CALL-INIT-01-02. IC2254.2 +034500 CALL-TEST-01-01-1. IC2254.2 +034600 MOVE "CALL-TEST-01-01-1" TO PAR-NAME. IC2254.2 +034700 IF DN1 = ZERO IC2254.2 +034800 PERFORM PASS IC2254.2 +034900 PERFORM PRINT-DETAIL IC2254.2 +035000 ELSE IC2254.2 +035100 MOVE DN1 TO COMPUTED-N IC2254.2 +035200 MOVE ZERO TO CORRECT-N IC2254.2 +035300 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +035400 PERFORM FAIL IC2254.2 +035500 PERFORM PRINT-DETAIL. IC2254.2 +035600 ADD 1 TO REC-CT. IC2254.2 +035700 CALL-TEST-01-01-2. IC2254.2 +035800 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2254.2 +035900 IF DN2 = ZERO IC2254.2 +036000 PERFORM PASS IC2254.2 +036100 PERFORM PRINT-DETAIL IC2254.2 +036200 ELSE IC2254.2 +036300 MOVE DN2 TO COMPUTED-N IC2254.2 +036400 MOVE ZERO TO CORRECT-N IC2254.2 +036500 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +036600 PERFORM FAIL IC2254.2 +036700 PERFORM PRINT-DETAIL. IC2254.2 +036800 ADD 1 TO REC-CT. IC2254.2 +036900 CALL-TEST-01-01-3. IC2254.2 +037000 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2254.2 +037100 IF DN3 = ZERO IC2254.2 +037200 PERFORM PASS IC2254.2 +037300 PERFORM PRINT-DETAIL IC2254.2 +037400 ELSE IC2254.2 +037500 MOVE DN3 TO COMPUTED-N IC2254.2 +037600 MOVE ZERO TO CORRECT-N IC2254.2 +037700 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +037800 PERFORM FAIL IC2254.2 +037900 PERFORM PRINT-DETAIL. IC2254.2 +038000 ADD 1 TO REC-CT. IC2254.2 +038100 CALL-TEST-01-01-4. IC2254.2 +038200 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2254.2 +038300 IF DN4 = ZERO IC2254.2 +038400 PERFORM PASS IC2254.2 +038500 PERFORM PRINT-DETAIL IC2254.2 +038600 ELSE IC2254.2 +038700 MOVE DN4 TO COMPUTED-N IC2254.2 +038800 MOVE ZERO TO CORRECT-N IC2254.2 +038900 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +039000 PERFORM FAIL IC2254.2 +039100 PERFORM PRINT-DETAIL. IC2254.2 +039200* IC2254.2 +039300 CALL-INIT-01-02. IC2254.2 +039400 MOVE 1 TO REC-CT. IC2254.2 +039500 MOVE 2 TO DN1, DN2, DN3 IC2254.2 +039600 MOVE 42 TO DN4. IC2254.2 +039700 CALL-TEST-01-02-0. IC2254.2 +039800 CALL "IC225A-1" USING BY CONTENT DN1 DN2 IC2254.2 +039900 REFERENCE DN3 IC2254.2 +040000 CONTENT DN4 IC2254.2 +040100 END-CALL. IC2254.2 +040200 GO TO CALL-TEST-01-02-1. IC2254.2 +040300 CALL-DELETE-01-02. IC2254.2 +040400 PERFORM DE-LETE. IC2254.2 +040500 PERFORM PRINT-DETAIL. IC2254.2 +040600 GO TO CALL-INIT-01-03. IC2254.2 +040700 CALL-TEST-01-02-1. IC2254.2 +040800 MOVE "CALL-TEST-01-02-1" TO PAR-NAME. IC2254.2 +040900 IF DN1 = 2 IC2254.2 +041000 PERFORM PASS IC2254.2 +041100 PERFORM PRINT-DETAIL IC2254.2 +041200 ELSE IC2254.2 +041300 MOVE DN1 TO COMPUTED-N IC2254.2 +041400 MOVE 2 TO CORRECT-N IC2254.2 +041500 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +041600 PERFORM FAIL IC2254.2 +041700 PERFORM PRINT-DETAIL. IC2254.2 +041800 ADD 1 TO REC-CT. IC2254.2 +041900 CALL-TEST-01-02-2. IC2254.2 +042000 MOVE "CALL-TEST-01-02-2" TO PAR-NAME. IC2254.2 +042100 IF DN2 = 2 IC2254.2 +042200 PERFORM PASS IC2254.2 +042300 PERFORM PRINT-DETAIL IC2254.2 +042400 ELSE IC2254.2 +042500 MOVE DN2 TO COMPUTED-N IC2254.2 +042600 MOVE 2 TO CORRECT-N IC2254.2 +042700 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +042800 PERFORM FAIL IC2254.2 +042900 PERFORM PRINT-DETAIL. IC2254.2 +043000 ADD 1 TO REC-CT. IC2254.2 +043100 CALL-TEST-01-02-3. IC2254.2 +043200 MOVE "CALL-TEST-01-02-3" TO PAR-NAME. IC2254.2 +043300 IF DN3 = 3 IC2254.2 +043400 PERFORM PASS IC2254.2 +043500 PERFORM PRINT-DETAIL IC2254.2 +043600 ELSE IC2254.2 +043700 MOVE DN3 TO COMPUTED-N IC2254.2 +043800 MOVE 3 TO CORRECT-N IC2254.2 +043900 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +044000 PERFORM FAIL IC2254.2 +044100 PERFORM PRINT-DETAIL. IC2254.2 +044200 ADD 1 TO REC-CT. IC2254.2 +044300 CALL-TEST-01-02-4. IC2254.2 +044400 MOVE "CALL-TEST-01-02-4" TO PAR-NAME. IC2254.2 +044500 IF DN4 = 42 IC2254.2 +044600 PERFORM PASS IC2254.2 +044700 PERFORM PRINT-DETAIL IC2254.2 +044800 ELSE IC2254.2 +044900 MOVE DN4 TO COMPUTED-N IC2254.2 +045000 MOVE 42 TO CORRECT-N IC2254.2 +045100 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +045200 PERFORM FAIL IC2254.2 +045300 PERFORM PRINT-DETAIL. IC2254.2 +045400* IC2254.2 +045500 CALL-INIT-01-03. IC2254.2 +045600 MOVE 1 TO REC-CT. IC2254.2 +045700 MOVE 3 TO DN1, DN2, DN3 IC2254.2 +045800 MOVE 71 TO DN4. IC2254.2 +045900 CALL-TEST-01-03-0. IC2254.2 +046000 CALL "IC225A-1" USING BY CONTENT DN1 IC2254.2 +046100 REFERENCE DN2 IC2254.2 +046200 CONTENT DN3 IC2254.2 +046300 REFERENCE DN4 IC2254.2 +046400 END-CALL. IC2254.2 +046500 GO TO CALL-TEST-01-03-1. IC2254.2 +046600 CALL-DELETE-01-03. IC2254.2 +046700 PERFORM DE-LETE. IC2254.2 +046800 PERFORM PRINT-DETAIL. IC2254.2 +046900 GO TO CALL-TEST-02. IC2254.2 +047000 CALL-TEST-01-03-1. IC2254.2 +047100 MOVE "CALL-TEST-01-03-1" TO PAR-NAME. IC2254.2 +047200 IF DN1 = 3 IC2254.2 +047300 PERFORM PASS IC2254.2 +047400 PERFORM PRINT-DETAIL IC2254.2 +047500 ELSE IC2254.2 +047600 MOVE DN1 TO COMPUTED-N IC2254.2 +047700 MOVE 3 TO CORRECT-N IC2254.2 +047800 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +047900 PERFORM FAIL IC2254.2 +048000 PERFORM PRINT-DETAIL. IC2254.2 +048100 ADD 1 TO REC-CT. IC2254.2 +048200 CALL-TEST-01-03-2. IC2254.2 +048300 MOVE "CALL-TEST-01-03-2" TO PAR-NAME. IC2254.2 +048400 IF DN2 = 3 IC2254.2 +048500 PERFORM PASS IC2254.2 +048600 PERFORM PRINT-DETAIL IC2254.2 +048700 ELSE IC2254.2 +048800 MOVE DN2 TO COMPUTED-N IC2254.2 +048900 MOVE 3 TO CORRECT-N IC2254.2 +049000 MOVE "INCORRECT DN2 VALUE RETURNED" TO RE-MARK IC2254.2 +049100 PERFORM FAIL IC2254.2 +049200 PERFORM PRINT-DETAIL. IC2254.2 +049300 ADD 1 TO REC-CT. IC2254.2 +049400 CALL-TEST-01-03-3. IC2254.2 +049500 MOVE "CALL-TEST-01-03-3" TO PAR-NAME. IC2254.2 +049600 IF DN3 = 3 IC2254.2 +049700 PERFORM PASS IC2254.2 +049800 PERFORM PRINT-DETAIL IC2254.2 +049900 ELSE IC2254.2 +050000 MOVE DN3 TO COMPUTED-N IC2254.2 +050100 MOVE 3 TO CORRECT-N IC2254.2 +050200 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +050300 PERFORM FAIL IC2254.2 +050400 PERFORM PRINT-DETAIL. IC2254.2 +050500 ADD 1 TO REC-CT. IC2254.2 +050600 CALL-TEST-01-03-4. IC2254.2 +050700 MOVE "CALL-TEST-01-03-4" TO PAR-NAME. IC2254.2 +050800 IF DN4 = 3 IC2254.2 +050900 PERFORM PASS IC2254.2 +051000 PERFORM PRINT-DETAIL IC2254.2 +051100 ELSE IC2254.2 +051200 MOVE DN4 TO COMPUTED-N IC2254.2 +051300 MOVE 3 TO CORRECT-N IC2254.2 +051400 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +051500 PERFORM FAIL IC2254.2 +051600 PERFORM PRINT-DETAIL. IC2254.2 +051700* IC2254.2 +051800 CALL-TEST-02. IC2254.2 +051900 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2254.2 +052000* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2254.2 +052100* A USING PHRASE OF A CALL STATEMENT. IC2254.2 +052200 CALL-INIT-02-01. IC2254.2 +052300 MOVE 1 TO REC-CT. IC2254.2 +052400 MOVE 1 TO DN1. IC2254.2 +052500 MOVE 0 TO DN2, DN3, DN4. IC2254.2 +052600 CALL-TEST-02-01-0. IC2254.2 +052700 CALL "IC225A-1" USING REFERENCE DN1, IC2254.2 +052800 CONTENT DN2, IC2254.2 +052900 REFERENCE DN1, DN4, IC2254.2 +053000 END-CALL. IC2254.2 +053100 GO TO CALL-TEST-02-01-1. IC2254.2 +053200 CALL-DELETE-02-01. IC2254.2 +053300 PERFORM DE-LETE. IC2254.2 +053400 PERFORM PRINT-DETAIL. IC2254.2 +053500 GO TO CALL-INIT-02-02. IC2254.2 +053600 CALL-TEST-02-01-1. IC2254.2 +053700 MOVE "CALL-TEST-02-01-1" TO PAR-NAME. IC2254.2 +053800 IF DN1 = 2 IC2254.2 +053900 PERFORM PASS IC2254.2 +054000 PERFORM PRINT-DETAIL IC2254.2 +054100 ELSE IC2254.2 +054200 MOVE DN1 TO COMPUTED-N IC2254.2 +054300 MOVE 2 TO CORRECT-N IC2254.2 +054400 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +054500 PERFORM FAIL IC2254.2 +054600 PERFORM PRINT-DETAIL. IC2254.2 +054700 ADD 1 TO REC-CT. IC2254.2 +054800 CALL-TEST-02-01-2. IC2254.2 +054900 MOVE "CALL-TEST-02-01-2" TO PAR-NAME. IC2254.2 +055000 IF DN2 = 0 IC2254.2 +055100 PERFORM PASS IC2254.2 +055200 PERFORM PRINT-DETAIL IC2254.2 +055300 ELSE IC2254.2 +055400 MOVE DN2 TO COMPUTED-N IC2254.2 +055500 MOVE ZERO TO CORRECT-N IC2254.2 +055600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +055700 PERFORM FAIL IC2254.2 +055800 PERFORM PRINT-DETAIL. IC2254.2 +055900 ADD 1 TO REC-CT. IC2254.2 +056000 CALL-TEST-02-01-3. IC2254.2 +056100 MOVE "CALL-TEST-02-01-3" TO PAR-NAME. IC2254.2 +056200 IF DN3 = 0 IC2254.2 +056300 PERFORM PASS IC2254.2 +056400 PERFORM PRINT-DETAIL IC2254.2 +056500 ELSE IC2254.2 +056600 MOVE DN3 TO COMPUTED-N IC2254.2 +056700 MOVE ZERO TO CORRECT-N IC2254.2 +056800 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +056900 PERFORM FAIL IC2254.2 +057000 PERFORM PRINT-DETAIL. IC2254.2 +057100 ADD 1 TO REC-CT. IC2254.2 +057200 CALL-TEST-02-01-4. IC2254.2 +057300 MOVE "CALL-TEST-02-01-4" TO PAR-NAME. IC2254.2 +057400 IF DN4 = 4 IC2254.2 +057500 PERFORM PASS IC2254.2 +057600 PERFORM PRINT-DETAIL IC2254.2 +057700 ELSE IC2254.2 +057800 MOVE DN4 TO COMPUTED-N IC2254.2 +057900 MOVE 4 TO CORRECT-N IC2254.2 +058000 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +058100 PERFORM FAIL IC2254.2 +058200 PERFORM PRINT-DETAIL. IC2254.2 +058300* IC2254.2 +058400 CALL-INIT-02-02. IC2254.2 +058500 MOVE 1 TO REC-CT. IC2254.2 +058600 MOVE 0 TO DN4, DN3, DN2, DN1. IC2254.2 +058700 CALL-TEST-02-02-0. IC2254.2 +058800 CALL ID1 USING BY REFERENCE DN1 IC2254.2 +058900 CONTENT DN2 DN3 DN2 IC2254.2 +059000 END-CALL. IC2254.2 +059100 GO TO CALL-TEST-02-02-1. IC2254.2 +059200 CALL-DELETE-02-02. IC2254.2 +059300 PERFORM DE-LETE. IC2254.2 +059400 PERFORM PRINT-DETAIL. IC2254.2 +059500 GO TO CALL-INIT-02-03. IC2254.2 +059600 CALL-TEST-02-02-1. IC2254.2 +059700 MOVE "CALL-TEST-02-02-1" TO PAR-NAME. IC2254.2 +059800 IF DN1 = 0 IC2254.2 +059900 PERFORM PASS IC2254.2 +060000 PERFORM PRINT-DETAIL IC2254.2 +060100 ELSE IC2254.2 +060200 MOVE DN1 TO COMPUTED-N IC2254.2 +060300 MOVE ZERO TO CORRECT-N IC2254.2 +060400 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +060500 PERFORM FAIL IC2254.2 +060600 PERFORM PRINT-DETAIL. IC2254.2 +060700 ADD 1 TO REC-CT. IC2254.2 +060800 CALL-TEST-02-02-2. IC2254.2 +060900 MOVE "CALL-TEST-02-02-2" TO PAR-NAME. IC2254.2 +061000 IF DN2 = 0 IC2254.2 +061100 PERFORM PASS IC2254.2 +061200 PERFORM PRINT-DETAIL IC2254.2 +061300 ELSE IC2254.2 +061400 MOVE DN2 TO COMPUTED-N IC2254.2 +061500 MOVE ZERO TO CORRECT-N IC2254.2 +061600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +061700 PERFORM FAIL IC2254.2 +061800 PERFORM PRINT-DETAIL. IC2254.2 +061900 ADD 1 TO REC-CT. IC2254.2 +062000 CALL-TEST-02-02-3. IC2254.2 +062100 MOVE "CALL-TEST-02-02-3" TO PAR-NAME. IC2254.2 +062200 IF DN3 = 0 IC2254.2 +062300 PERFORM PASS IC2254.2 +062400 PERFORM PRINT-DETAIL IC2254.2 +062500 ELSE IC2254.2 +062600 MOVE DN3 TO COMPUTED-N IC2254.2 +062700 MOVE ZERO TO CORRECT-N IC2254.2 +062800 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +062900 PERFORM FAIL IC2254.2 +063000 PERFORM PRINT-DETAIL. IC2254.2 +063100 ADD 1 TO REC-CT. IC2254.2 +063200 CALL-TEST-02-02-4. IC2254.2 +063300 MOVE "CALL-TEST-02-02-4" TO PAR-NAME. IC2254.2 +063400 IF DN4 = ZERO IC2254.2 +063500 PERFORM PASS IC2254.2 +063600 PERFORM PRINT-DETAIL IC2254.2 +063700 ELSE IC2254.2 +063800 MOVE DN4 TO COMPUTED-N IC2254.2 +063900 MOVE ZERO TO CORRECT-N IC2254.2 +064000 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +064100 PERFORM FAIL IC2254.2 +064200 PERFORM PRINT-DETAIL. IC2254.2 +064300* IC2254.2 +064400 CALL-INIT-02-03. IC2254.2 +064500 MOVE 1 TO REC-CT. IC2254.2 +064600 MOVE 0 TO DN4, DN3. IC2254.2 +064700 MOVE 10 TO DN2. IC2254.2 +064800 MOVE 25 TO DN1. IC2254.2 +064900 CALL-TEST-02-03-0. IC2254.2 +065000 CALL ID1 USING CONTENT DN1 IC2254.2 +065100 REFERENCE DN2 DN1 IC2254.2 +065200 REFERENCE DN2 IC2254.2 +065300 END-CALL. IC2254.2 +065400 GO TO CALL-TEST-02-03-1. IC2254.2 +065500 CALL-DELETE-02-03. IC2254.2 +065600 PERFORM DE-LETE. IC2254.2 +065700 PERFORM PRINT-DETAIL. IC2254.2 +065800 GO TO CALL-INIT-03-01. IC2254.2 +065900 CALL-TEST-02-03-1. IC2254.2 +066000 MOVE "CALL-TEST-02-03-1" TO PAR-NAME. IC2254.2 +066100 IF DN1 = 26 IC2254.2 +066200 PERFORM PASS IC2254.2 +066300 PERFORM PRINT-DETAIL IC2254.2 +066400 ELSE IC2254.2 +066500 MOVE DN1 TO COMPUTED-N IC2254.2 +066600 MOVE 26 TO CORRECT-N IC2254.2 +066700 MOVE "INCORRECT VALUE RETURNED " TO RE-MARK IC2254.2 +066800 PERFORM FAIL IC2254.2 +066900 PERFORM PRINT-DETAIL. IC2254.2 +067000 ADD 1 TO REC-CT. IC2254.2 +067100 CALL-TEST-02-03-2. IC2254.2 +067200 MOVE "CALL-TEST-02-03-2" TO PAR-NAME. IC2254.2 +067300 IF DN2 = 6 IC2254.2 +067400 PERFORM PASS IC2254.2 +067500 PERFORM PRINT-DETAIL IC2254.2 +067600 ELSE IC2254.2 +067700 MOVE DN2 TO COMPUTED-N IC2254.2 +067800 MOVE 6 TO CORRECT-N IC2254.2 +067900 MOVE "INCORRECT DN2 VALUE RETURNED" TO RE-MARK IC2254.2 +068000 PERFORM FAIL IC2254.2 +068100 PERFORM PRINT-DETAIL. IC2254.2 +068200 ADD 1 TO REC-CT. IC2254.2 +068300 CALL-TEST-02-03-3. IC2254.2 +068400 MOVE "CALL-TEST-02-03-3" TO PAR-NAME. IC2254.2 +068500 IF DN3 = 0 IC2254.2 +068600 PERFORM PASS IC2254.2 +068700 PERFORM PRINT-DETAIL IC2254.2 +068800 ELSE IC2254.2 +068900 MOVE DN3 TO COMPUTED-N IC2254.2 +069000 MOVE ZERO TO CORRECT-N IC2254.2 +069100 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +069200 PERFORM FAIL IC2254.2 +069300 PERFORM PRINT-DETAIL. IC2254.2 +069400 ADD 1 TO REC-CT. IC2254.2 +069500 CALL-TEST-02-03-4. IC2254.2 +069600 MOVE "CALL-TEST-02-03-4" TO PAR-NAME. IC2254.2 +069700 IF DN4 = ZERO IC2254.2 +069800 PERFORM PASS IC2254.2 +069900 PERFORM PRINT-DETAIL IC2254.2 +070000 ELSE IC2254.2 +070100 MOVE DN4 TO COMPUTED-N IC2254.2 +070200 MOVE ZERO TO CORRECT-N IC2254.2 +070300 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +070400 PERFORM FAIL IC2254.2 +070500 PERFORM PRINT-DETAIL. IC2254.2 +070600* IC2254.2 +070700 CALL-TEST-03. IC2254.2 +070800* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2254.2 +070900* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE IC2254.2 +071000* ON OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2254.2 +071100 MOVE "CALL-TEST-03" TO PAR-NAME. IC2254.2 +071200 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2254.2 +071300 CALL-INIT-03-01. IC2254.2 +071400 MOVE 1 TO REC-CT. IC2254.2 +071500 MOVE 6 TO CALL-COUNT. IC2254.2 +071600 MOVE 20 TO DN1. IC2254.2 +071700 MOVE 30 TO DN2. IC2254.2 +071800 MOVE ZERO TO DN3, DN4. IC2254.2 +071900 CALL-TEST-03-01-0. IC2254.2 +072000 MOVE "CALL-TEST-03-01-0" TO PAR-NAME. IC2254.2 +072100 CALL "IC225A-1" USING BY CONTENT DN1, DN2, IC2254.2 +072200 REFERENCE DN3, DN4; IC2254.2 +072300 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +072400 PERFORM FAIL IC2254.2 +072500 PERFORM PRINT-DETAIL. IC2254.2 +072600 GO TO CALL-TEST-03-01-1. IC2254.2 +072700 CALL-DELETE-03-01. IC2254.2 +072800 PERFORM DE-LETE. IC2254.2 +072900 PERFORM PRINT-DETAIL. IC2254.2 +073000 GO TO CALL-INIT-03-02. IC2254.2 +073100 CALL-TEST-03-01-1. IC2254.2 +073200 MOVE "CALL-TEST-03-01-1" TO PAR-NAME. IC2254.2 +073300 IF DN1 = 20 IC2254.2 +073400 PERFORM PASS IC2254.2 +073500 PERFORM PRINT-DETAIL IC2254.2 +073600 ELSE IC2254.2 +073700 MOVE DN1 TO COMPUTED-N IC2254.2 +073800 MOVE 20 TO CORRECT-N IC2254.2 +073900 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +074000 PERFORM FAIL IC2254.2 +074100 PERFORM PRINT-DETAIL. IC2254.2 +074200 ADD 1 TO REC-CT. IC2254.2 +074300 CALL-TEST-03-01-2. IC2254.2 +074400 MOVE "CALL-TEST-03-01-2" TO PAR-NAME. IC2254.2 +074500 IF DN2 = 30 IC2254.2 +074600 PERFORM PASS IC2254.2 +074700 PERFORM PRINT-DETAIL IC2254.2 +074800 ELSE IC2254.2 +074900 MOVE DN2 TO COMPUTED-N IC2254.2 +075000 MOVE 30 TO CORRECT-N IC2254.2 +075100 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +075200 PERFORM FAIL IC2254.2 +075300 PERFORM PRINT-DETAIL. IC2254.2 +075400 ADD 1 TO REC-CT. IC2254.2 +075500 CALL-TEST-03-01-3. IC2254.2 +075600 MOVE "CALL-TEST-03-01-3" TO PAR-NAME. IC2254.2 +075700 IF DN3 = 21 IC2254.2 +075800 PERFORM PASS IC2254.2 +075900 PERFORM PRINT-DETAIL IC2254.2 +076000 ELSE IC2254.2 +076100 MOVE DN3 TO COMPUTED-N IC2254.2 +076200 MOVE 21 TO CORRECT-N IC2254.2 +076300 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +076400 PERFORM FAIL IC2254.2 +076500 PERFORM PRINT-DETAIL. IC2254.2 +076600 ADD 1 TO REC-CT. IC2254.2 +076700 CALL-TEST-03-01-4. IC2254.2 +076800 MOVE "CALL-TEST-03-01-4" TO PAR-NAME. IC2254.2 +076900 IF DN4 = 7 IC2254.2 +077000 PERFORM PASS IC2254.2 +077100 PERFORM PRINT-DETAIL IC2254.2 +077200 ELSE IC2254.2 +077300 MOVE DN4 TO COMPUTED-N IC2254.2 +077400 MOVE 7 TO CORRECT-N IC2254.2 +077500 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +077600 PERFORM FAIL IC2254.2 +077700 PERFORM PRINT-DETAIL. IC2254.2 +077800* IC2254.2 +077900 CALL-INIT-03-02. IC2254.2 +078000 MOVE "CALL-TEST-03-02-0" TO PAR-NAME. IC2254.2 +078100 MOVE 0 TO DN3, DN4. IC2254.2 +078200 MOVE 1 TO REC-CT. IC2254.2 +078300 CALL-TEST-03-02-0. IC2254.2 +078400 CALL "IC225A-1" USING REFERENCE DN1, IC2254.2 +078500 CONTENT DN2, IC2254.2 +078600 REFERENCE DN3, IC2254.2 +078700 CONTENT DN4, IC2254.2 +078800 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +078900 PERFORM FAIL IC2254.2 +079000 PERFORM PRINT-DETAIL. IC2254.2 +079100 GO TO CALL-TEST-03-02-1. IC2254.2 +079200 CALL-DELETE-03-02. IC2254.2 +079300 PERFORM DE-LETE. IC2254.2 +079400 PERFORM PRINT-DETAIL. IC2254.2 +079500 GO TO CALL-INIT-03-03. IC2254.2 +079600 CALL-TEST-03-02-1. IC2254.2 +079700 MOVE "CALL-TEST-03-02-1" TO PAR-NAME. IC2254.2 +079800 IF DN1 = 20 IC2254.2 +079900 PERFORM PASS IC2254.2 +080000 PERFORM PRINT-DETAIL IC2254.2 +080100 ELSE IC2254.2 +080200 MOVE DN1 TO COMPUTED-N IC2254.2 +080300 MOVE 20 TO CORRECT-N IC2254.2 +080400 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +080500 PERFORM FAIL IC2254.2 +080600 PERFORM PRINT-DETAIL. IC2254.2 +080700 ADD 1 TO REC-CT. IC2254.2 +080800 CALL-TEST-03-02-2. IC2254.2 +080900 MOVE "CALL-TEST-03-02-2" TO PAR-NAME. IC2254.2 +081000 IF DN2 = 30 IC2254.2 +081100 PERFORM PASS IC2254.2 +081200 PERFORM PRINT-DETAIL IC2254.2 +081300 ELSE IC2254.2 +081400 MOVE DN2 TO COMPUTED-N IC2254.2 +081500 MOVE 30 TO CORRECT-N IC2254.2 +081600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +081700 PERFORM FAIL IC2254.2 +081800 PERFORM PRINT-DETAIL. IC2254.2 +081900 ADD 1 TO REC-CT. IC2254.2 +082000 CALL-TEST-03-02-3. IC2254.2 +082100 MOVE "CALL-TEST-03-02-3" TO PAR-NAME. IC2254.2 +082200 IF DN3 = 21 IC2254.2 +082300 PERFORM PASS IC2254.2 +082400 PERFORM PRINT-DETAIL IC2254.2 +082500 ELSE IC2254.2 +082600 MOVE DN3 TO COMPUTED-N IC2254.2 +082700 MOVE 21 TO CORRECT-N IC2254.2 +082800 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +082900 PERFORM FAIL IC2254.2 +083000 PERFORM PRINT-DETAIL. IC2254.2 +083100 ADD 1 TO REC-CT. IC2254.2 +083200 CALL-TEST-03-02-4. IC2254.2 +083300 MOVE "CALL-TEST-03-02-4" TO PAR-NAME. IC2254.2 +083400 IF DN4 = 0 IC2254.2 +083500 PERFORM PASS IC2254.2 +083600 PERFORM PRINT-DETAIL IC2254.2 +083700 ELSE IC2254.2 +083800 MOVE DN4 TO COMPUTED-N IC2254.2 +083900 MOVE ZERO TO CORRECT-N IC2254.2 +084000 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +084100 PERFORM FAIL IC2254.2 +084200 PERFORM PRINT-DETAIL. IC2254.2 +084300* IC2254.2 +084400 CALL-INIT-03-03. IC2254.2 +084500 MOVE "CALL-TEST-03-03-0" TO PAR-NAME. IC2254.2 +084600 MOVE 0 TO DN3, DN4. IC2254.2 +084700 MOVE 1 TO REC-CT. IC2254.2 +084800 CALL-TEST-03-03-0. IC2254.2 +084900 CALL ID1 USING BY CONTENT DN1 IC2254.2 +085000 REFERENCE DN2 DN3 DN4 IC2254.2 +085100 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +085200 PERFORM FAIL IC2254.2 +085300 PERFORM PRINT-DETAIL. IC2254.2 +085400 GO TO CALL-TEST-03-03-1. IC2254.2 +085500 CALL-DELETE-03-03. IC2254.2 +085600 PERFORM DE-LETE. IC2254.2 +085700 PERFORM PRINT-DETAIL. IC2254.2 +085800 GO TO CALL-INIT-03-03. IC2254.2 +085900 CALL-TEST-03-03-1. IC2254.2 +086000 MOVE "CALL-TEST-03-03-1" TO PAR-NAME. IC2254.2 +086100 IF DN1 = 20 IC2254.2 +086200 PERFORM PASS IC2254.2 +086300 PERFORM PRINT-DETAIL IC2254.2 +086400 ELSE IC2254.2 +086500 MOVE DN1 TO COMPUTED-N IC2254.2 +086600 MOVE 20 TO CORRECT-N IC2254.2 +086700 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +086800 PERFORM FAIL IC2254.2 +086900 PERFORM PRINT-DETAIL. IC2254.2 +087000 ADD 1 TO REC-CT. IC2254.2 +087100 CALL-TEST-03-03-2. IC2254.2 +087200 MOVE "CALL-TEST-03-03-2" TO PAR-NAME. IC2254.2 +087300 IF DN2 = 30 IC2254.2 +087400 PERFORM PASS IC2254.2 +087500 PERFORM PRINT-DETAIL IC2254.2 +087600 ELSE IC2254.2 +087700 MOVE DN2 TO COMPUTED-N IC2254.2 +087800 MOVE 30 TO CORRECT-N IC2254.2 +087900 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +088000 PERFORM FAIL IC2254.2 +088100 PERFORM PRINT-DETAIL. IC2254.2 +088200 ADD 1 TO REC-CT. IC2254.2 +088300 CALL-TEST-03-03-3. IC2254.2 +088400 MOVE "CALL-TEST-03-03-3" TO PAR-NAME. IC2254.2 +088500 IF DN3 = 21 IC2254.2 +088600 PERFORM PASS IC2254.2 +088700 PERFORM PRINT-DETAIL IC2254.2 +088800 ELSE IC2254.2 +088900 MOVE DN3 TO COMPUTED-N IC2254.2 +089000 MOVE 21 TO CORRECT-N IC2254.2 +089100 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +089200 PERFORM FAIL IC2254.2 +089300 PERFORM PRINT-DETAIL. IC2254.2 +089400 ADD 1 TO REC-CT. IC2254.2 +089500 CALL-TEST-03-03-4. IC2254.2 +089600 MOVE "CALL-TEST-03-03-4" TO PAR-NAME. IC2254.2 +089700 IF DN4 = 9 IC2254.2 +089800 PERFORM PASS IC2254.2 +089900 PERFORM PRINT-DETAIL IC2254.2 +090000 ELSE IC2254.2 +090100 MOVE DN4 TO COMPUTED-N IC2254.2 +090200 MOVE 9 TO CORRECT-N IC2254.2 +090300 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +090400 PERFORM FAIL IC2254.2 +090500 PERFORM PRINT-DETAIL. IC2254.2 +090600* IC2254.2 +090700 GO TO EXIT-IC225A. IC2254.2 +090800* IC2254.2 +090900 CALL-DELETE-03. IC2254.2 +091000* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2254.2 +091100* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2254.2 +091200* CALL-TEST-03-01. IC2254.2 +091300 PERFORM DE-LETE. IC2254.2 +091400 PERFORM PRINT-DETAIL. IC2254.2 +091500 EXIT-IC225A. IC2254.2 +091600 GO TO CCVS-EXIT. IC2254.2 +091700 SECT-IC225A-002 SECTION. IC2254.2 +091800 CHECK-TEST-03. IC2254.2 +091900 MOVE ZERO TO FAIL-FLAG. IC2254.2 +092000 ADD 1 TO CALL-COUNT. IC2254.2 +092100 IF DN4 NOT EQUAL TO CALL-COUNT IC2254.2 +092200 ADD 1 TO FAIL-FLAG. IC2254.2 +092300 IF DN3 NOT EQUAL TO 21 IC2254.2 +092400 ADD 1 TO FAIL-FLAG. IC2254.2 +092500 IF DN2 NOT EQUAL TO 30 IC2254.2 +092600 ADD 1 TO FAIL-FLAG. IC2254.2 +092700 IF DN1 NOT EQUAL TO 20 IC2254.2 +092800 ADD 1 TO FAIL-FLAG. IC2254.2 +092900 CCVS-EXIT SECTION. IC2254.2 +093000 CCVS-999999. IC2254.2 +093100 GO TO CLOSE-FILES. IC2254.2 +093200 END PROGRAM IC225A. IC2254.2 +093300 IDENTIFICATION DIVISION. IC2254.2 +093400 PROGRAM-ID. IC2254.2 +093500 IC225A-1. IC2254.2 +093600**************************************************************** IC2254.2 +093700* * IC2254.2 +093800* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2254.2 +093900* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2254.2 +094000* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2254.2 +094100* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2254.2 +094200* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2254.2 +094300* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2254.2 +094400* * IC2254.2 +094500* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2254.2 +094600* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2254.2 +094700* DOCUMENT REFERENCE: ISO-1989-1978). * IC2254.2 +094800* * IC2254.2 +094900* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2254.2 +095000* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2254.2 +095100* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2254.2 +095200* * IC2254.2 +095300* THE FEDERAL SOFTWARE TESTING CENTER * IC2254.2 +095400* OFFICE OF SOFTWARE DEVELOPMENT * IC2254.2 +095500* & INFORMATION TECHNOLOGY * IC2254.2 +095600* TWO SKYLINE PLACE * IC2254.2 +095700* SUITE 1100 * IC2254.2 +095800* 5203 LEESBURG PIKE * IC2254.2 +095900* FALLS CHURCH * IC2254.2 +096000* VA 22041 * IC2254.2 +096100* U.S.A. * IC2254.2 +096200* * IC2254.2 +096300* THE PROJECT TEAM MEMBERS WERE: * IC2254.2 +096400* * IC2254.2 +096500* BIADI (BUREAU INTER ADMINISTRATION * IC2254.2 +096600* DE DOCUMENTATION INFORMATIQUE) * IC2254.2 +096700* 21 RUE BARA * IC2254.2 +096800* F-92132 ISSY * IC2254.2 +096900* FRANCE * IC2254.2 +097000* * IC2254.2 +097100* * IC2254.2 +097200* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2254.2 +097300* UND DATENVERARBEITUNG MBH) * IC2254.2 +097400* SCHLOSS BIRLINGHOVEN * IC2254.2 +097500* POSTFACH 12 40 * IC2254.2 +097600* D-5205 ST. AUGUSTIN 1 * IC2254.2 +097700* GERMANY FR * IC2254.2 +097800* * IC2254.2 +097900* * IC2254.2 +098000* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2254.2 +098100* OXFORD ROAD * IC2254.2 +098200* MANCHESTER * IC2254.2 +098300* M1 7ED * IC2254.2 +098400* UNITED KINGDOM * IC2254.2 +098500* * IC2254.2 +098600* * IC2254.2 +098700* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2254.2 +098800* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2254.2 +098900* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2254.2 +099000* * IC2254.2 +099100**************************************************************** IC2254.2 +099200* * IC2254.2 +099300* VALIDATION FOR:- * IC2254.2 +099400* * IC2254.2 +099500* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +099600* * IC2254.2 +099700* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +099800* * IC2254.2 +099900**************************************************************** IC2254.2 +100000* * IC2254.2 +100100* X-CARDS USED BY THIS PROGRAM ARE :- * IC2254.2 +100200* * IC2254.2 +100300* X-55 - SYSTEM PRINTER NAME. * IC2254.2 +100400* X-82 - SOURCE COMPUTER NAME. * IC2254.2 +100500* X-83 - OBJECT COMPUTER NAME. * IC2254.2 +100600* * IC2254.2 +100700**************************************************************** IC2254.2 +100800* * IC2254.2 +100900* PROGRAM IC225A AND IC225A-1 WILL TEST THE NEW LANGUAGE * IC2254.2 +101000* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2254.2 +101100* MODULE. * IC2254.2 +101200* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2254.2 +101300* "BY REFERENCE" PHRASE * IC2254.2 +101400* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2254.2 +101500* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2254.2 +101600* IDENTIFICATION DIVISION. * IC2254.2 +101700* PROGRAM-ID. IC225A. * IC2254.2 +101800* . * IC2254.2 +101900* . * IC2254.2 +102000* . * IC2254.2 +102100* END PROGRAM IC225A. * IC2254.2 +102200* PROGRAM-ID. IC225A-1. * IC2254.2 +102300* . * IC2254.2 +102400* . * IC2254.2 +102500* . * IC2254.2 +102600**************************************************************** IC2254.2 +102700 ENVIRONMENT DIVISION. IC2254.2 +102800 CONFIGURATION SECTION. IC2254.2 +102900 SOURCE-COMPUTER. IC2254.2 +103000 XXXXX082. IC2254.2 +103100 OBJECT-COMPUTER. IC2254.2 +103200 XXXXX083. IC2254.2 +103300*INPUT-OUTPUT SECTION. IC2254.2 +103400 DATA DIVISION. IC2254.2 +103500 FILE SECTION. IC2254.2 +103600 WORKING-STORAGE SECTION. IC2254.2 +103700 77 WS1 PICTURE S999. IC2254.2 +103800 77 WS2 PICTURE S999 IC2254.2 +103900 USAGE COMPUTATIONAL, VALUE ZERO. IC2254.2 +104000 LINKAGE SECTION. IC2254.2 +104100 77 DN1 PICTURE S99. IC2254.2 +104200 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2254.2 +104300 77 DN3 PICTURE S99. IC2254.2 +104400 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2254.2 +104500 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2254.2 +104600 SECT-IC225A-1-001 SECTION. IC2254.2 +104700 CALL-TEST-001. IC2254.2 +104800 MOVE DN1 TO WS1. IC2254.2 +104900 ADD 1 TO WS1. IC2254.2 +105000 ADD 1 TO WS2. IC2254.2 +105100 MOVE WS1 TO DN3. IC2254.2 +105200 MOVE WS2 TO DN4. IC2254.2 +105300 CALL-EXIT-001. IC2254.2 +105400 EXIT PROGRAM. IC2254.2 +*END-OF,IC225A +*HEADER,COBOL,IC226A +000100 IDENTIFICATION DIVISION. IC2264.2 +000200 PROGRAM-ID. IC2264.2 +000300 IC226A. IC2264.2 +000400**************************************************************** IC2264.2 +000500* * IC2264.2 +000600* VALIDATION FOR:- * IC2264.2 +000700* * IC2264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +000900* * IC2264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +001100* * IC2264.2 +001200**************************************************************** IC2264.2 +001300* * IC2264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2264.2 +001500* * IC2264.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2264.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2264.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2264.2 +001900* * IC2264.2 +002000**************************************************************** IC2264.2 +002100* * IC2264.2 +002200* PROGRAM IC226A AND IC226A-1 WILL TEST THE NEW LANGUAGE * IC2264.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2264.2 +002400* MODULE. * IC2264.2 +002500* THE NEW LANGUAGE ELEMENT TO BE TESTED WILL BE: * IC2264.2 +002600* THE "EXTERNAL" PHRASE * IC2264.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2264.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2264.2 +002900* IDENTIFICATION DIVISION. * IC2264.2 +003000* PROGRAM-ID. IC226A. * IC2264.2 +003100* . * IC2264.2 +003200* . * IC2264.2 +003300* . * IC2264.2 +003400* END PROGRAM IC226A. * IC2264.2 +003500* PROGRAM-ID. IC226A-1. * IC2264.2 +003600* . * IC2264.2 +003700* . * IC2264.2 +003800* . * IC2264.2 +003900**************************************************************** IC2264.2 +004000 ENVIRONMENT DIVISION. IC2264.2 +004100 CONFIGURATION SECTION. IC2264.2 +004200 SOURCE-COMPUTER. IC2264.2 +004300 XXXXX082. IC2264.2 +004400 OBJECT-COMPUTER. IC2264.2 +004500 XXXXX083. IC2264.2 +004600 INPUT-OUTPUT SECTION. IC2264.2 +004700 FILE-CONTROL. IC2264.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2264.2 +004900 XXXXX055. IC2264.2 +005000 DATA DIVISION. IC2264.2 +005100 FILE SECTION. IC2264.2 +005200 FD PRINT-FILE. IC2264.2 +005300 01 PRINT-REC PICTURE X(120). IC2264.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2264.2 +005500 WORKING-STORAGE SECTION. IC2264.2 +005600 01 EXTERNAL-DATA IS EXTERNAL. IC2264.2 +005700 03 EXT-DATA-1 PIC X(2). IC2264.2 +005800 03 EXT-DATA-2 PIC X(6). IC2264.2 +005900 03 EXT-DATA-3 PIC 9(8). IC2264.2 +006000 03 EXT-DATA-4 PIC 9(4). IC2264.2 +006100 01 SUB PIC 9(4) VALUE ZERO. IC2264.2 +006200* IC2264.2 +006300 01 TEST-RESULTS. IC2264.2 +006400 02 FILLER PIC X VALUE SPACE. IC2264.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. IC2264.2 +006600 02 FILLER PIC X VALUE SPACE. IC2264.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. IC2264.2 +006800 02 FILLER PIC X VALUE SPACE. IC2264.2 +006900 02 PAR-NAME. IC2264.2 +007000 03 FILLER PIC X(19) VALUE SPACE. IC2264.2 +007100 03 PARDOT-X PIC X VALUE SPACE. IC2264.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. IC2264.2 +007300 02 FILLER PIC X(8) VALUE SPACE. IC2264.2 +007400 02 RE-MARK PIC X(61). IC2264.2 +007500 01 TEST-COMPUTED. IC2264.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC2264.2 +007700 02 FILLER PIC X(17) VALUE IC2264.2 +007800 " COMPUTED=". IC2264.2 +007900 02 COMPUTED-X. IC2264.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2264.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A IC2264.2 +008200 PIC -9(9).9(9). IC2264.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2264.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2264.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2264.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. IC2264.2 +008700 04 COMPUTED-18V0 PIC -9(18). IC2264.2 +008800 04 FILLER PIC X. IC2264.2 +008900 03 FILLER PIC X(50) VALUE SPACE. IC2264.2 +009000 01 TEST-CORRECT. IC2264.2 +009100 02 FILLER PIC X(30) VALUE SPACE. IC2264.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". IC2264.2 +009300 02 CORRECT-X. IC2264.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. IC2264.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2264.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2264.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2264.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2264.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. IC2264.2 +010000 04 CORRECT-18V0 PIC -9(18). IC2264.2 +010100 04 FILLER PIC X. IC2264.2 +010200 03 FILLER PIC X(2) VALUE SPACE. IC2264.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2264.2 +010400 01 CCVS-C-1. IC2264.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2264.2 +010600- "SS PARAGRAPH-NAME IC2264.2 +010700- " REMARKS". IC2264.2 +010800 02 FILLER PIC X(20) VALUE SPACE. IC2264.2 +010900 01 CCVS-C-2. IC2264.2 +011000 02 FILLER PIC X VALUE SPACE. IC2264.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". IC2264.2 +011200 02 FILLER PIC X(15) VALUE SPACE. IC2264.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". IC2264.2 +011400 02 FILLER PIC X(94) VALUE SPACE. IC2264.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2264.2 +011600 01 REC-CT PIC 99 VALUE ZERO. IC2264.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2264.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2264.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2264.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2264.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2264.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2264.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2264.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2264.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2264.2 +012600 01 CCVS-H-1. IC2264.2 +012700 02 FILLER PIC X(39) VALUE SPACES. IC2264.2 +012800 02 FILLER PIC X(42) VALUE IC2264.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2264.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2264.2 +013100 01 CCVS-H-2A. IC2264.2 +013200 02 FILLER PIC X(40) VALUE SPACE. IC2264.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2264.2 +013400 02 FILLER PIC XXXX VALUE IC2264.2 +013500 "4.2 ". IC2264.2 +013600 02 FILLER PIC X(28) VALUE IC2264.2 +013700 " COPY - NOT FOR DISTRIBUTION". IC2264.2 +013800 02 FILLER PIC X(41) VALUE SPACE. IC2264.2 +013900 IC2264.2 +014000 01 CCVS-H-2B. IC2264.2 +014100 02 FILLER PIC X(15) VALUE IC2264.2 +014200 "TEST RESULT OF ". IC2264.2 +014300 02 TEST-ID PIC X(9). IC2264.2 +014400 02 FILLER PIC X(4) VALUE IC2264.2 +014500 " IN ". IC2264.2 +014600 02 FILLER PIC X(12) VALUE IC2264.2 +014700 " HIGH ". IC2264.2 +014800 02 FILLER PIC X(22) VALUE IC2264.2 +014900 " LEVEL VALIDATION FOR ". IC2264.2 +015000 02 FILLER PIC X(58) VALUE IC2264.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +015200 01 CCVS-H-3. IC2264.2 +015300 02 FILLER PIC X(34) VALUE IC2264.2 +015400 " FOR OFFICIAL USE ONLY ". IC2264.2 +015500 02 FILLER PIC X(58) VALUE IC2264.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +015700 02 FILLER PIC X(28) VALUE IC2264.2 +015800 " COPYRIGHT 1985 ". IC2264.2 +015900 01 CCVS-E-1. IC2264.2 +016000 02 FILLER PIC X(52) VALUE SPACE. IC2264.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2264.2 +016200 02 ID-AGAIN PIC X(9). IC2264.2 +016300 02 FILLER PIC X(45) VALUE SPACES. IC2264.2 +016400 01 CCVS-E-2. IC2264.2 +016500 02 FILLER PIC X(31) VALUE SPACE. IC2264.2 +016600 02 FILLER PIC X(21) VALUE SPACE. IC2264.2 +016700 02 CCVS-E-2-2. IC2264.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2264.2 +016900 03 FILLER PIC X VALUE SPACE. IC2264.2 +017000 03 ENDER-DESC PIC X(44) VALUE IC2264.2 +017100 "ERRORS ENCOUNTERED". IC2264.2 +017200 01 CCVS-E-3. IC2264.2 +017300 02 FILLER PIC X(22) VALUE IC2264.2 +017400 " FOR OFFICIAL USE ONLY". IC2264.2 +017500 02 FILLER PIC X(12) VALUE SPACE. IC2264.2 +017600 02 FILLER PIC X(58) VALUE IC2264.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +017800 02 FILLER PIC X(13) VALUE SPACE. IC2264.2 +017900 02 FILLER PIC X(15) VALUE IC2264.2 +018000 " COPYRIGHT 1985". IC2264.2 +018100 01 CCVS-E-4. IC2264.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2264.2 +018300 02 FILLER PIC X(4) VALUE " OF ". IC2264.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2264.2 +018500 02 FILLER PIC X(40) VALUE IC2264.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". IC2264.2 +018700 01 XXINFO. IC2264.2 +018800 02 FILLER PIC X(19) VALUE IC2264.2 +018900 "*** INFORMATION ***". IC2264.2 +019000 02 INFO-TEXT. IC2264.2 +019100 04 FILLER PIC X(8) VALUE SPACE. IC2264.2 +019200 04 XXCOMPUTED PIC X(20). IC2264.2 +019300 04 FILLER PIC X(5) VALUE SPACE. IC2264.2 +019400 04 XXCORRECT PIC X(20). IC2264.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). IC2264.2 +019600 01 HYPHEN-LINE. IC2264.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. IC2264.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************IC2264.2 +019900- "*****************************************". IC2264.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************IC2264.2 +020100- "******************************". IC2264.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE IC2264.2 +020300 "IC226A". IC2264.2 +020400 PROCEDURE DIVISION. IC2264.2 +020500 CCVS1 SECTION. IC2264.2 +020600 OPEN-FILES. IC2264.2 +020700 OPEN OUTPUT PRINT-FILE. IC2264.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2264.2 +020900 MOVE SPACE TO TEST-RESULTS. IC2264.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2264.2 +021100 GO TO CCVS1-EXIT. IC2264.2 +021200 CLOSE-FILES. IC2264.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2264.2 +021400 TERMINATE-CCVS. IC2264.2 +021500S EXIT PROGRAM. IC2264.2 +021600STERMINATE-CALL. IC2264.2 +021700 STOP RUN. IC2264.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2264.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2264.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2264.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2264.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IC2264.2 +022300 PRINT-DETAIL. IC2264.2 +022400 IF REC-CT NOT EQUAL TO ZERO IC2264.2 +022500 MOVE "." TO PARDOT-X IC2264.2 +022600 MOVE REC-CT TO DOTVALUE. IC2264.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2264.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2264.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2264.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2264.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2264.2 +023200 MOVE SPACE TO CORRECT-X. IC2264.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2264.2 +023400 MOVE SPACE TO RE-MARK. IC2264.2 +023500 HEAD-ROUTINE. IC2264.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2264.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2264.2 +024000 COLUMN-NAMES-ROUTINE. IC2264.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +024400 END-ROUTINE. IC2264.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2264.2 +024600 END-RTN-EXIT. IC2264.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +024800 END-ROUTINE-1. IC2264.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2264.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2264.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. IC2264.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2264.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2264.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2264.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2264.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2264.2 +025700 END-ROUTINE-12. IC2264.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2264.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IC2264.2 +026000 MOVE "NO " TO ERROR-TOTAL IC2264.2 +026100 ELSE IC2264.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2264.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2264.2 +026400 PERFORM WRITE-LINE. IC2264.2 +026500 END-ROUTINE-13. IC2264.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IC2264.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IC2264.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2264.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2264.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IC2264.2 +027200 MOVE "NO " TO ERROR-TOTAL IC2264.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2264.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2264.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027700 WRITE-LINE. IC2264.2 +027800 ADD 1 TO RECORD-COUNT. IC2264.2 +027900Y IF RECORD-COUNT GREATER 50 IC2264.2 +028000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2264.2 +028100Y MOVE SPACE TO DUMMY-RECORD IC2264.2 +028200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2264.2 +028300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2264.2 +028400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2264.2 +028500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2264.2 +028600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2264.2 +028700Y MOVE ZERO TO RECORD-COUNT. IC2264.2 +028800 PERFORM WRT-LN. IC2264.2 +028900 WRT-LN. IC2264.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2264.2 +029100 MOVE SPACE TO DUMMY-RECORD. IC2264.2 +029200 BLANK-LINE-PRINT. IC2264.2 +029300 PERFORM WRT-LN. IC2264.2 +029400 FAIL-ROUTINE. IC2264.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2264.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2264.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2264.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2264.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC2264.2 +030100 GO TO FAIL-ROUTINE-EX. IC2264.2 +030200 FAIL-ROUTINE-WRITE. IC2264.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2264.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2264.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2264.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. IC2264.2 +030700 FAIL-ROUTINE-EX. EXIT. IC2264.2 +030800 BAIL-OUT. IC2264.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2264.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2264.2 +031100 BAIL-OUT-WRITE. IC2264.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2264.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2264.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2264.2 +031600 BAIL-OUT-EX. EXIT. IC2264.2 +031700 CCVS1-EXIT. IC2264.2 +031800 EXIT. IC2264.2 +031900 SECT-IC226A-001 SECTION. IC2264.2 +032000 EXT-INIT-01. IC2264.2 +032100 MOVE 1 TO REC-CT. IC2264.2 +032200 MOVE "X-21 4.5.1" TO ANSI-REFERENCE. IC2264.2 +032300 MOVE "EXTERNAL CLAUSE" TO FEATURE. IC2264.2 +032400 MOVE "AA" TO EXT-DATA-1. IC2264.2 +032500 MOVE "FIRST]" TO EXT-DATA-2. IC2264.2 +032600 MOVE 12345678 TO EXT-DATA-3. IC2264.2 +032700 MOVE 1 TO EXT-DATA-4. IC2264.2 +032800 EXT-TEST-01-01-0. IC2264.2 +032900 CALL "IC226A-1" IC2264.2 +033000 END-CALL. IC2264.2 +033100 GO TO EXT-TEST-01-01-1. IC2264.2 +033200 EXT-DELETE-01-01. IC2264.2 +033300 PERFORM DE-LETE. IC2264.2 +033400 PERFORM PRINT-DETAIL. IC2264.2 +033500 GO TO CCVS-EXIT. IC2264.2 +033600 EXT-TEST-01-01-1. IC2264.2 +033700 MOVE "EXT-TEST-01-01-1" TO PAR-NAME. IC2264.2 +033800 IF EXT-DATA-1 = "ZZ" IC2264.2 +033900 PERFORM PASS IC2264.2 +034000 PERFORM PRINT-DETAIL IC2264.2 +034100 ELSE IC2264.2 +034200 MOVE EXT-DATA-1 TO COMPUTED-X IC2264.2 +034300 MOVE "ZZ" TO CORRECT-X IC2264.2 +034400 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +034500 PERFORM FAIL IC2264.2 +034600 PERFORM PRINT-DETAIL. IC2264.2 +034700 ADD 1 TO REC-CT. IC2264.2 +034800 CALL-TEST-01-01-2. IC2264.2 +034900 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2264.2 +035000 IF EXT-DATA-2 = "CHANGE" IC2264.2 +035100 PERFORM PASS IC2264.2 +035200 PERFORM PRINT-DETAIL IC2264.2 +035300 ELSE IC2264.2 +035400 MOVE EXT-DATA-2 TO COMPUTED-X IC2264.2 +035500 MOVE "CHANGE" TO CORRECT-X IC2264.2 +035600 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +035700 PERFORM FAIL IC2264.2 +035800 PERFORM PRINT-DETAIL. IC2264.2 +035900 ADD 1 TO REC-CT. IC2264.2 +036000 CALL-TEST-01-01-3. IC2264.2 +036100 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2264.2 +036200 IF EXT-DATA-3 = 87654321 IC2264.2 +036300 PERFORM PASS IC2264.2 +036400 PERFORM PRINT-DETAIL IC2264.2 +036500 ELSE IC2264.2 +036600 MOVE EXT-DATA-3 TO COMPUTED-N IC2264.2 +036700 MOVE 87654321 TO CORRECT-N IC2264.2 +036800 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +036900 PERFORM FAIL IC2264.2 +037000 PERFORM PRINT-DETAIL. IC2264.2 +037100 ADD 1 TO REC-CT. IC2264.2 +037200 CALL-TEST-01-01-4. IC2264.2 +037300 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2264.2 +037400 IF EXT-DATA-4 = 11 IC2264.2 +037500 PERFORM PASS IC2264.2 +037600 PERFORM PRINT-DETAIL IC2264.2 +037700 ELSE IC2264.2 +037800 MOVE EXT-DATA-4 TO COMPUTED-N IC2264.2 +037900 MOVE 11 TO CORRECT-N IC2264.2 +038000 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +038100 PERFORM FAIL IC2264.2 +038200 PERFORM PRINT-DETAIL. IC2264.2 +038300* IC2264.2 +038400 CCVS-EXIT SECTION. IC2264.2 +038500 CCVS-999999. IC2264.2 +038600 GO TO CLOSE-FILES. IC2264.2 +038700 END PROGRAM IC226A. IC2264.2 +038800 IDENTIFICATION DIVISION. IC2264.2 +038900 PROGRAM-ID. IC2264.2 +039000 IC226A-1. IC2264.2 +039100**************************************************************** IC2264.2 +039200* * IC2264.2 +039300* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2264.2 +039400* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2264.2 +039500* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2264.2 +039600* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2264.2 +039700* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2264.2 +039800* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2264.2 +039900* * IC2264.2 +040000* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2264.2 +040100* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2264.2 +040200* DOCUMENT REFERENCE: ISO-1989-1978). * IC2264.2 +040300* * IC2264.2 +040400* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2264.2 +040500* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2264.2 +040600* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2264.2 +040700* * IC2264.2 +040800* THE FEDERAL SOFTWARE TESTING CENTER * IC2264.2 +040900* OFFICE OF SOFTWARE DEVELOPMENT * IC2264.2 +041000* & INFORMATION TECHNOLOGY * IC2264.2 +041100* TWO SKYLINE PLACE * IC2264.2 +041200* SUITE 1100 * IC2264.2 +041300* 5203 LEESBURG PIKE * IC2264.2 +041400* FALLS CHURCH * IC2264.2 +041500* VA 22041 * IC2264.2 +041600* U.S.A. * IC2264.2 +041700* * IC2264.2 +041800* THE PROJECT TEAM MEMBERS WERE: * IC2264.2 +041900* * IC2264.2 +042000* BIADI (BUREAU INTER ADMINISTRATION * IC2264.2 +042100* DE DOCUMENTATION INFORMATIQUE) * IC2264.2 +042200* 21 RUE BARA * IC2264.2 +042300* F-92132 ISSY * IC2264.2 +042400* FRANCE * IC2264.2 +042500* * IC2264.2 +042600* * IC2264.2 +042700* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2264.2 +042800* UND DATENVERARBEITUNG MBH) * IC2264.2 +042900* SCHLOSS BIRLINGHOVEN * IC2264.2 +043000* POSTFACH 12 40 * IC2264.2 +043100* D-5205 ST. AUGUSTIN 1 * IC2264.2 +043200* GERMANY FR * IC2264.2 +043300* * IC2264.2 +043400* * IC2264.2 +043500* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2264.2 +043600* OXFORD ROAD * IC2264.2 +043700* MANCHESTER * IC2264.2 +043800* M1 7ED * IC2264.2 +043900* UNITED KINGDOM * IC2264.2 +044000* * IC2264.2 +044100* * IC2264.2 +044200* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2264.2 +044300* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2264.2 +044400* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2264.2 +044500* * IC2264.2 +044600**************************************************************** IC2264.2 +044700* * IC2264.2 +044800* VALIDATION FOR:- * IC2264.2 +044900* * IC2264.2 +045000* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +045100* * IC2264.2 +045200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +045300* * IC2264.2 +045400**************************************************************** IC2264.2 +045500* * IC2264.2 +045600* X-CARDS USED BY THIS PROGRAM ARE :- * IC2264.2 +045700* * IC2264.2 +045800* X-14 - SEQUENTIAL MASS STORAGE * IC2264.2 +045900* X-55 - SYSTEM PRINTER NAME. * IC2264.2 +046000* X-82 - SOURCE COMPUTER NAME. * IC2264.2 +046100* X-83 - OBJECT COMPUTER NAME. * IC2264.2 +046200* * IC2264.2 +046300**************************************************************** IC2264.2 +046400* * IC2264.2 +046500* PROGRAM IC226A AND IC226A-1 WILL TEST THE NEW LANGUAGE * IC2264.2 +046600* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2264.2 +046700* MODULE. * IC2264.2 +046800* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2264.2 +046900* THE "EXTERNAL" CLAUSE IN WORKING-STORAGE. * IC2264.2 +047000* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2264.2 +047100* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2264.2 +047200* IDENTIFICATION DIVISION. * IC2264.2 +047300* PROGRAM-ID. IC226A. * IC2264.2 +047400* . * IC2264.2 +047500* . * IC2264.2 +047600* . * IC2264.2 +047700* END PROGRAM IC226A. * IC2264.2 +047800* PROGRAM-ID. IC226A-1. * IC2264.2 +047900* . * IC2264.2 +048000* . * IC2264.2 +048100* . * IC2264.2 +048200**************************************************************** IC2264.2 +048300 ENVIRONMENT DIVISION. IC2264.2 +048400 CONFIGURATION SECTION. IC2264.2 +048500 SOURCE-COMPUTER. IC2264.2 +048600 XXXXX082. IC2264.2 +048700 OBJECT-COMPUTER. IC2264.2 +048800 XXXXX083. IC2264.2 +048900*INPUT-OUTPUT SECTION. IC2264.2 +049000 DATA DIVISION. IC2264.2 +049100 FILE SECTION. IC2264.2 +049200 WORKING-STORAGE SECTION. IC2264.2 +049300 01 EXTERNAL-DATA IS EXTERNAL. IC2264.2 +049400 03 EXT-DATA-1 PIC X(2). IC2264.2 +049500 03 EXT-DATA-2 PIC X(6). IC2264.2 +049600 03 EXT-DATA-3 PIC 9(8). IC2264.2 +049700 03 EXT-DATA-4 PIC 9(4). IC2264.2 +049800 PROCEDURE DIVISION. IC2264.2 +049900 SECT-IC226A-1-001 SECTION. IC2264.2 +050000 EXT-TEST-001. IC2264.2 +050100 MOVE "ZZ" TO EXT-DATA-1. IC2264.2 +050200 MOVE "CHANGE" TO EXT-DATA-2. IC2264.2 +050300 MOVE 87654321 TO EXT-DATA-3. IC2264.2 +050400 ADD 10 TO EXT-DATA-4. IC2264.2 +050500 EXT-EXIT-001. IC2264.2 +050600 EXIT PROGRAM. IC2264.2 +*END-OF,IC226A +*HEADER,COBOL,IC227A +000100 IDENTIFICATION DIVISION. IC2274.2 +000200 PROGRAM-ID. IC2274.2 +000300 IC227A. IC2274.2 +000400**************************************************************** IC2274.2 +000500* * IC2274.2 +000600* VALIDATION FOR:- * IC2274.2 +000700* * IC2274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +000900* * IC2274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +001100* * IC2274.2 +001200**************************************************************** IC2274.2 +001300* * IC2274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2274.2 +001500* * IC2274.2 +001600* X-55 SYSTEM PRINTER * IC2274.2 +001700* X-82 SOURCE-COMPUTER * IC2274.2 +001800* X-83 OBJECT-COMPUTER. * IC2274.2 +001900* * IC2274.2 +002000**************************************************************** IC2274.2 +002100* * IC2274.2 +002200* PROGRAMS IC227A AND IC227A-1 TEST LEVEL 2 LANGUAGE * IC2274.2 +002300* ELEMENTS FROM THE INTER-PROGRAM COMMUNICATION MODULE. * IC2274.2 +002400* THE PARTICULAR ELEMENTS TESTED ARE: * IC2274.2 +002500* THE "EXTERNAL" CLAUSE IN THE FILE DESCRIPTION ENTRY * IC2274.2 +002600* * IC2274.2 +002700* ALTHOUGH IC227A AND IC227A-1 ARE SEPARATELY COMPILED * IC2274.2 +002800* PROGRAMS, BOTH ARE INTENDED TO BE COMPILED BY THE SAME * IC2274.2 +002900* INVOCATION OF THE COMPILER, IN ORDER TO TEST STREAM * IC2274.2 +003000* COMPILATION AND RECOGNITION OF THE END PROGRAM HEADER. * IC2274.2 +003100* * IC2274.2 +003200* THE STRUCTURE OF THE SOURCE FILE IS: IC2274.2 +003300* * IC2274.2 +003400* IDENTIFICATION DIVISION. * IC2274.2 +003500* PROGRAM-ID. IC227A. * IC2274.2 +003600* . * IC2274.2 +003700* . * IC2274.2 +003800* . * IC2274.2 +003900* END PROGRAM IC227A. * IC2274.2 +004000* IDENTIFICATION DIVISION. * IC2274.2 +004100* PROGRAM-ID. IC227A-1. * IC2274.2 +004200* . * IC2274.2 +004300* . * IC2274.2 +004400* . * IC2274.2 +004500* END PROGRAM IC227A-1. * IC2274.2 +004600* * IC2274.2 +004700**************************************************************** IC2274.2 +004800* IC2274.2 +004900 ENVIRONMENT DIVISION. IC2274.2 +005000 CONFIGURATION SECTION. IC2274.2 +005100 SOURCE-COMPUTER. IC2274.2 +005200 XXXXX082. IC2274.2 +005300 OBJECT-COMPUTER. IC2274.2 +005400 XXXXX083. IC2274.2 +005500* IC2274.2 +005600 INPUT-OUTPUT SECTION. IC2274.2 +005700 FILE-CONTROL. IC2274.2 +005800 SELECT PRINT-FILE ASSIGN TO IC2274.2 +005900 XXXXX055. IC2274.2 +006000* IC2274.2 +006100 SELECT EXTERNAL-FILE ASSIGN TO IC2274.2 +006200 XXXXX014 IC2274.2 +006300 FILE STATUS IS EXTERNAL-FILE-FS. IC2274.2 +006400* IC2274.2 +006500 DATA DIVISION. IC2274.2 +006600 FILE SECTION. IC2274.2 +006700 FD PRINT-FILE. IC2274.2 +006800 01 PRINT-REC PICTURE X(120). IC2274.2 +006900 01 DUMMY-RECORD PICTURE X(120). IC2274.2 +007000* IC2274.2 +007100 FD EXTERNAL-FILE IC2274.2 +007200 IS EXTERNAL IC2274.2 +007300 RECORD CONTAINS 18 CHARACTERS. IC2274.2 +007400 01 EXTERNAL-FILE-RECORD. IC2274.2 +007500 03 EXT-DATA-1 PIC X(2). IC2274.2 +007600 03 EXT-DATA-2 PIC X(6). IC2274.2 +007700 03 EXT-DATA-3 PIC 9(6). IC2274.2 +007800 03 EXT-DATA-4 PIC 9(4). IC2274.2 +007900* IC2274.2 +008000 WORKING-STORAGE SECTION. IC2274.2 +008100* IC2274.2 +008200*************************************************************** IC2274.2 +008300* * IC2274.2 +008400* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * IC2274.2 +008500* * IC2274.2 +008600*************************************************************** IC2274.2 +008700* IC2274.2 +008800 01 EXTERNAL-RECORD-HOLD. IC2274.2 +008900 03 WSE-DATA-1 PIC X(2). IC2274.2 +009000 03 WSE-DATA-2 PIC X(6). IC2274.2 +009100 03 WSE-DATA-3 PIC 9(6). IC2274.2 +009200 03 WSE-DATA-4 PIC 9(4). IC2274.2 +009300* IC2274.2 +009400 01 EXTERNAL-RECORD-WORK. IC2274.2 +009500 03 WRK-DATA-1 PIC X(2). IC2274.2 +009600 03 WRK-DATA-2 PIC X(6). IC2274.2 +009700 03 WRK-DATA-3 PIC 9(6). IC2274.2 +009800 03 WRK-DATA-4 PIC 9(4). IC2274.2 +009900* IC2274.2 +010000 01 EXTERNAL-FILE-FS PIC XX. IC2274.2 +010100 01 F-S-PARAM PIC XX. IC2274.2 +010200 01 ACTION-CODE PIC 99. IC2274.2 +010300 77 ID1 PICTURE X(8) VALUE "IC227A-1". IC2274.2 +010400* IC2274.2 +010500*************************************************************** IC2274.2 +010600* * IC2274.2 +010700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * IC2274.2 +010800* * IC2274.2 +010900*************************************************************** IC2274.2 +011000* IC2274.2 +011100 01 TEST-RESULTS. IC2274.2 +011200 02 FILLER PIC X VALUE SPACE. IC2274.2 +011300 02 FEATURE PIC X(20) VALUE SPACE. IC2274.2 +011400 02 FILLER PIC X VALUE SPACE. IC2274.2 +011500 02 P-OR-F PIC X(5) VALUE SPACE. IC2274.2 +011600 02 FILLER PIC X VALUE SPACE. IC2274.2 +011700 02 PAR-NAME. IC2274.2 +011800 03 FILLER PIC X(19) VALUE SPACE. IC2274.2 +011900 03 PARDOT-X PIC X VALUE SPACE. IC2274.2 +012000 03 DOTVALUE PIC 99 VALUE ZERO. IC2274.2 +012100 02 FILLER PIC X(8) VALUE SPACE. IC2274.2 +012200 02 RE-MARK PIC X(61). IC2274.2 +012300 01 TEST-COMPUTED. IC2274.2 +012400 02 FILLER PIC X(30) VALUE SPACE. IC2274.2 +012500 02 FILLER PIC X(17) VALUE IC2274.2 +012600 " COMPUTED=". IC2274.2 +012700 02 COMPUTED-X. IC2274.2 +012800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2274.2 +012900 03 COMPUTED-N REDEFINES COMPUTED-A IC2274.2 +013000 PIC -9(9).9(9). IC2274.2 +013100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2274.2 +013200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2274.2 +013300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2274.2 +013400 03 CM-18V0 REDEFINES COMPUTED-A. IC2274.2 +013500 04 COMPUTED-18V0 PIC -9(18). IC2274.2 +013600 04 FILLER PIC X. IC2274.2 +013700 03 FILLER PIC X(50) VALUE SPACE. IC2274.2 +013800 01 TEST-CORRECT. IC2274.2 +013900 02 FILLER PIC X(30) VALUE SPACE. IC2274.2 +014000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2274.2 +014100 02 CORRECT-X. IC2274.2 +014200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2274.2 +014300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2274.2 +014400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2274.2 +014500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2274.2 +014600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2274.2 +014700 03 CR-18V0 REDEFINES CORRECT-A. IC2274.2 +014800 04 CORRECT-18V0 PIC -9(18). IC2274.2 +014900 04 FILLER PIC X. IC2274.2 +015000 03 FILLER PIC X(2) VALUE SPACE. IC2274.2 +015100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2274.2 +015200 01 CCVS-C-1. IC2274.2 +015300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2274.2 +015400- "SS PARAGRAPH-NAME IC2274.2 +015500- " REMARKS". IC2274.2 +015600 02 FILLER PIC X(20) VALUE SPACE. IC2274.2 +015700 01 CCVS-C-2. IC2274.2 +015800 02 FILLER PIC X VALUE SPACE. IC2274.2 +015900 02 FILLER PIC X(6) VALUE "TESTED". IC2274.2 +016000 02 FILLER PIC X(15) VALUE SPACE. IC2274.2 +016100 02 FILLER PIC X(4) VALUE "FAIL". IC2274.2 +016200 02 FILLER PIC X(94) VALUE SPACE. IC2274.2 +016300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2274.2 +016400 01 REC-CT PIC 99 VALUE ZERO. IC2274.2 +016500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2274.2 +017000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2274.2 +017100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2274.2 +017200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2274.2 +017300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2274.2 +017400 01 CCVS-H-1. IC2274.2 +017500 02 FILLER PIC X(39) VALUE SPACES. IC2274.2 +017600 02 FILLER PIC X(42) VALUE IC2274.2 +017700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2274.2 +017800 02 FILLER PIC X(39) VALUE SPACES. IC2274.2 +017900 01 CCVS-H-2A. IC2274.2 +018000 02 FILLER PIC X(40) VALUE SPACE. IC2274.2 +018100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2274.2 +018200 02 FILLER PIC XXXX VALUE IC2274.2 +018300 "4.2 ". IC2274.2 +018400 02 FILLER PIC X(28) VALUE IC2274.2 +018500 " COPY - NOT FOR DISTRIBUTION". IC2274.2 +018600 02 FILLER PIC X(41) VALUE SPACE. IC2274.2 +018700 IC2274.2 +018800 01 CCVS-H-2B. IC2274.2 +018900 02 FILLER PIC X(15) VALUE IC2274.2 +019000 "TEST RESULT OF ". IC2274.2 +019100 02 TEST-ID PIC X(9). IC2274.2 +019200 02 FILLER PIC X(4) VALUE IC2274.2 +019300 " IN ". IC2274.2 +019400 02 FILLER PIC X(12) VALUE IC2274.2 +019500 " HIGH ". IC2274.2 +019600 02 FILLER PIC X(22) VALUE IC2274.2 +019700 " LEVEL VALIDATION FOR ". IC2274.2 +019800 02 FILLER PIC X(58) VALUE IC2274.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +020000 01 CCVS-H-3. IC2274.2 +020100 02 FILLER PIC X(34) VALUE IC2274.2 +020200 " FOR OFFICIAL USE ONLY ". IC2274.2 +020300 02 FILLER PIC X(58) VALUE IC2274.2 +020400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +020500 02 FILLER PIC X(28) VALUE IC2274.2 +020600 " COPYRIGHT 1985,1986 ". IC2274.2 +020700 01 CCVS-E-1. IC2274.2 +020800 02 FILLER PIC X(52) VALUE SPACE. IC2274.2 +020900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2274.2 +021000 02 ID-AGAIN PIC X(9). IC2274.2 +021100 02 FILLER PIC X(45) VALUE SPACES. IC2274.2 +021200 01 CCVS-E-2. IC2274.2 +021300 02 FILLER PIC X(31) VALUE SPACE. IC2274.2 +021400 02 FILLER PIC X(21) VALUE SPACE. IC2274.2 +021500 02 CCVS-E-2-2. IC2274.2 +021600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2274.2 +021700 03 FILLER PIC X VALUE SPACE. IC2274.2 +021800 03 ENDER-DESC PIC X(44) VALUE IC2274.2 +021900 "ERRORS ENCOUNTERED". IC2274.2 +022000 01 CCVS-E-3. IC2274.2 +022100 02 FILLER PIC X(22) VALUE IC2274.2 +022200 " FOR OFFICIAL USE ONLY". IC2274.2 +022300 02 FILLER PIC X(12) VALUE SPACE. IC2274.2 +022400 02 FILLER PIC X(58) VALUE IC2274.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +022600 02 FILLER PIC X(8) VALUE SPACE. IC2274.2 +022700 02 FILLER PIC X(20) VALUE IC2274.2 +022800 " COPYRIGHT 1985,1986". IC2274.2 +022900 01 CCVS-E-4. IC2274.2 +023000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2274.2 +023100 02 FILLER PIC X(4) VALUE " OF ". IC2274.2 +023200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2274.2 +023300 02 FILLER PIC X(40) VALUE IC2274.2 +023400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2274.2 +023500 01 XXINFO. IC2274.2 +023600 02 FILLER PIC X(19) VALUE IC2274.2 +023700 "*** INFORMATION ***". IC2274.2 +023800 02 INFO-TEXT. IC2274.2 +023900 04 FILLER PIC X(8) VALUE SPACE. IC2274.2 +024000 04 XXCOMPUTED PIC X(20). IC2274.2 +024100 04 FILLER PIC X(5) VALUE SPACE. IC2274.2 +024200 04 XXCORRECT PIC X(20). IC2274.2 +024300 02 INF-ANSI-REFERENCE PIC X(48). IC2274.2 +024400 01 HYPHEN-LINE. IC2274.2 +024500 02 FILLER PIC IS X VALUE IS SPACE. IC2274.2 +024600 02 FILLER PIC IS X(65) VALUE IS "************************IC2274.2 +024700- "*****************************************". IC2274.2 +024800 02 FILLER PIC IS X(54) VALUE IS "************************IC2274.2 +024900- "******************************". IC2274.2 +025000 01 CCVS-PGM-ID PIC X(9) VALUE IC2274.2 +025100 "IC227A". IC2274.2 +025200* IC2274.2 +025300* IC2274.2 +025400 PROCEDURE DIVISION. IC2274.2 +025500 CCVS1 SECTION. IC2274.2 +025600 OPEN-FILES. IC2274.2 +025700 OPEN OUTPUT PRINT-FILE. IC2274.2 +025800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2274.2 +025900 MOVE SPACE TO TEST-RESULTS. IC2274.2 +026000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2274.2 +026100 GO TO CCVS1-EXIT. IC2274.2 +026200 CLOSE-FILES. IC2274.2 +026300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2274.2 +026400 TERMINATE-CCVS. IC2274.2 +026500 STOP RUN. IC2274.2 +026600* IC2274.2 +026700 INSPT. IC2274.2 +026800 MOVE "INSPT" TO P-OR-F. IC2274.2 +026900 ADD 1 TO INSPECT-COUNTER. IC2274.2 +027000 PERFORM PRINT-DETAIL. IC2274.2 +027100 IC2274.2 +027200 PASS. IC2274.2 +027300 MOVE "PASS " TO P-OR-F. IC2274.2 +027400 ADD 1 TO PASS-COUNTER. IC2274.2 +027500 PERFORM PRINT-DETAIL. IC2274.2 +027600* IC2274.2 +027700 FAIL. IC2274.2 +027800 MOVE "FAIL*" TO P-OR-F. IC2274.2 +027900 ADD 1 TO ERROR-COUNTER. IC2274.2 +028000 PERFORM PRINT-DETAIL. IC2274.2 +028100* IC2274.2 +028200 DE-LETE. IC2274.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2274.2 +028400 MOVE "*****" TO P-OR-F. IC2274.2 +028500 ADD 1 TO DELETE-COUNTER. IC2274.2 +028600 PERFORM PRINT-DETAIL. IC2274.2 +028700 IC2274.2 +028800 PRINT-DETAIL. IC2274.2 +028900 IF REC-CT NOT EQUAL TO ZERO IC2274.2 +029000 MOVE "." TO PARDOT-X IC2274.2 +029100 MOVE REC-CT TO DOTVALUE. IC2274.2 +029200 MOVE TEST-RESULTS TO PRINT-REC. IC2274.2 +029300 PERFORM WRITE-LINE. IC2274.2 +029400 IF P-OR-F EQUAL TO "FAIL*" IC2274.2 +029500 PERFORM WRITE-LINE IC2274.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2274.2 +029700 ELSE IC2274.2 +029800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2274.2 +029900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2274.2 +030000 MOVE SPACE TO CORRECT-X. IC2274.2 +030100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2274.2 +030200 MOVE SPACE TO RE-MARK. IC2274.2 +030300* IC2274.2 +030400 HEAD-ROUTINE. IC2274.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2 +030900 COLUMN-NAMES-ROUTINE. IC2274.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +031300 END-ROUTINE. IC2274.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. IC2274.2 +031500 PERFORM WRITE-LINE 5 TIMES. IC2274.2 +031600 END-RTN-EXIT. IC2274.2 +031700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +031800* IC2274.2 +031900 END-ROUTINE-1. IC2274.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD IC2274.2 +032100 ADD INSPECT-COUNTER TO ERROR-HOLD. IC2274.2 +032200 ADD DELETE-COUNTER TO ERROR-HOLD. IC2274.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. IC2274.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2274.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2274.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2274.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2274.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2274.2 +032900 END-ROUTINE-12. IC2274.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2274.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO IC2274.2 +033200 MOVE "NO " TO ERROR-TOTAL IC2274.2 +033300 ELSE IC2274.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2274.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2274.2 +033600 PERFORM WRITE-LINE. IC2274.2 +033700 END-ROUTINE-13. IC2274.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO IC2274.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE IC2274.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2274.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2274.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO IC2274.2 +034400 MOVE "NO " TO ERROR-TOTAL IC2274.2 +034500 ELSE IC2274.2 +034600 MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2274.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2274.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +035000* IC2274.2 +035100 WRITE-LINE. IC2274.2 +035200 ADD 1 TO RECORD-COUNT. IC2274.2 +035300Y IF RECORD-COUNT GREATER 50 IC2274.2 +035400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2274.2 +035500Y MOVE SPACE TO DUMMY-RECORD IC2274.2 +035600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2274.2 +035700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2274.2 +035800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2274.2 +035900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2274.2 +036000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2274.2 +036100Y MOVE ZERO TO RECORD-COUNT. IC2274.2 +036200 PERFORM WRT-LN. IC2274.2 +036300 WRT-LN. IC2274.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2274.2 +036500 MOVE SPACE TO DUMMY-RECORD. IC2274.2 +036600 BLANK-LINE-PRINT. IC2274.2 +036700 PERFORM WRT-LN. IC2274.2 +036800 FAIL-ROUTINE. IC2274.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2274.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2 +037500 GO TO FAIL-ROUTINE-EX. IC2274.2 +037600 FAIL-ROUTINE-WRITE. IC2274.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2274.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2274.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2274.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. IC2274.2 +038100 FAIL-ROUTINE-EX. EXIT. IC2274.2 +038200 BAIL-OUT. IC2274.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2274.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2274.2 +038500 BAIL-OUT-WRITE. IC2274.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2274.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2 +039000 BAIL-OUT-EX. EXIT. IC2274.2 +039100 CCVS1-EXIT. IC2274.2 +039200 EXIT. IC2274.2 +039300* IC2274.2 +039400**************************************************************** IC2274.2 +039500* * IC2274.2 +039600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * IC2274.2 +039700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * IC2274.2 +039800* * IC2274.2 +039900**************************************************************** IC2274.2 +040000* IC2274.2 +040100 SECT-IC227A-01 SECTION. IC2274.2 +040200 EXT-INIT-01. IC2274.2 +040300* IC2274.2 +040400* ************************************************* IC2274.2 +040500* * * IC2274.2 +040600* * MAKE EXTERNAL FILE RECORD AREA AVAILABLE * IC2274.2 +040700* * * IC2274.2 +040800* ************************************************* IC2274.2 +040900* IC2274.2 +041000 OPEN OUTPUT EXTERNAL-FILE. IC2274.2 +041100* IC2274.2 +041200 MOVE 1 TO REC-CT. IC2274.2 +041300 MOVE "EXTERNAL FILE RECORD" TO FEATURE. IC2274.2 +041400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +041500 MOVE "EXT-REC-TEST-01" TO PAR-NAME. IC2274.2 +041600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2 +041700 MOVE "**" TO F-S-PARAM. IC2274.2 +041800 MOVE "AA" TO WRK-DATA-1 IC2274.2 +041900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2 +042000 MOVE 123456 TO WRK-DATA-3 IC2274.2 +042100 MOVE 9876 TO WRK-DATA-4. IC2274.2 +042200 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2 +042300 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +042400 GO TO EXT-REC-TEST-01. IC2274.2 +042500 EXT-REC-DELETE-01. IC2274.2 +042600 PERFORM DE-LETE. IC2274.2 +042700 GO TO EXT-REC-DELETE-01-02. IC2274.2 +042800* IC2274.2 +042900* ************************************************* IC2274.2 +043000* * * IC2274.2 +043100* * CHECK THAT SUBPROGRAM SEES SAME RECORD AREA * IC2274.2 +043200* * * IC2274.2 +043300* ************************************************* IC2274.2 +043400* IC2274.2 +043500 EXT-REC-TEST-01. IC2274.2 +043600 MOVE 1 TO ACTION-CODE. IC2274.2 +043700 CALL "IC227A-1" USING ACTION-CODE IC2274.2 +043800 EXTERNAL-RECORD-WORK IC2274.2 +043900 F-S-PARAM. IC2274.2 +044000 IF EXTERNAL-FILE-RECORD EQUAL EXTERNAL-RECORD-HOLD IC2274.2 +044100 PERFORM PASS IC2274.2 +044200 ELSE IC2274.2 +044300 MOVE "SUBPROGRAM DID NOT WRITE TO RECORD AREA" IC2274.2 +044400 TO RE-MARK IC2274.2 +044500 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +044600 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +044700 PERFORM FAIL IC2274.2 +044800 END-IF. IC2274.2 +044900 GO TO EXT-REC-TEST-01-02. IC2274.2 +045000 EXT-REC-DELETE-01-02. IC2274.2 +045100 ADD 1 TO REC-CT IC2274.2 +045200 PERFORM DE-LETE. IC2274.2 +045300 GO TO EXT-REC-DELETE-01-03. IC2274.2 +045400 EXT-REC-TEST-01-02. IC2274.2 +045500 ADD 1 TO REC-CT. IC2274.2 +045600 IF EXTERNAL-RECORD-WORK EQUAL "******************" IC2274.2 +045700 PERFORM PASS IC2274.2 +045800 ELSE IC2274.2 +045900 MOVE "SUBPROGRAM DID NOT READ FROM RECORD AREA" IC2274.2 +046000 TO RE-MARK IC2274.2 +046100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +046200 MOVE "******************" TO CORRECT-A IC2274.2 +046300 PERFORM FAIL IC2274.2 +046400 END-IF. IC2274.2 +046500 GO TO EXT-REC-TEST-01-03. IC2274.2 +046600 EXT-REC-DELETE-01-03. IC2274.2 +046700 ADD 1 TO REC-CT IC2274.2 +046800 PERFORM DE-LETE. IC2274.2 +046900 GO TO EXT-REC-TEST-01-END. IC2274.2 +047000 EXT-REC-TEST-01-03. IC2274.2 +047100 ADD 1 TO REC-CT. IC2274.2 +047200 IF F-S-PARAM IS EQUAL "XX" IC2274.2 +047300 PERFORM PASS IC2274.2 +047400 ELSE IC2274.2 +047500 MOVE "WRONG FILE STATUS VALUE RETURNED" IC2274.2 +047600 TO RE-MARK IC2274.2 +047700 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +047800 MOVE "XX" TO CORRECT-A IC2274.2 +047900 PERFORM FAIL IC2274.2 +048000 END-IF. IC2274.2 +048100 EXT-REC-TEST-01-END. IC2274.2 +048200* IC2274.2 +048300* IC2274.2 +048400 EXT-INIT-02. IC2274.2 +048500* IC2274.2 +048600* ************************************************* IC2274.2 +048700* * * IC2274.2 +048800* * WRITE RECORD FROM PARAMETERS TO FILE * IC2274.2 +048900* * * IC2274.2 +049000* ************************************************* IC2274.2 +049100* IC2274.2 +049200 MOVE 1 TO REC-CT. IC2274.2 +049300 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2 +049400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +049500 MOVE "EXT-FILE-TEST-02" TO PAR-NAME. IC2274.2 +049600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2 +049700 MOVE "**" TO F-S-PARAM. IC2274.2 +049800 MOVE "AA" TO WRK-DATA-1 IC2274.2 +049900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2 +050000 MOVE 123456 TO WRK-DATA-3 IC2274.2 +050100 MOVE 9876 TO WRK-DATA-4. IC2274.2 +050200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +050300 GO TO EXT-FILE-TEST-02. IC2274.2 +050400 EXT-FILE-DELETE-02. IC2274.2 +050500 PERFORM DE-LETE. IC2274.2 +050600 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-FILE-RECORD. IC2274.2 +050700 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +050800 GO TO EXT-FILE-DELETE-02-02. IC2274.2 +050900* IC2274.2 +051000* ************************************************* IC2274.2 +051100* * * IC2274.2 +051200* * CHECK THAT SUBPROGRAM WILL WRITE * IC2274.2 +051300* * * IC2274.2 +051400* ************************************************* IC2274.2 +051500* IC2274.2 +051600 EXT-FILE-TEST-02. IC2274.2 +051700 MOVE 2 TO ACTION-CODE. IC2274.2 +051800 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +051900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +052000 F-S-PARAM. IC2274.2 +052100 IF F-S-PARAM IS EQUAL "00" IC2274.2 +052200 PERFORM PASS IC2274.2 +052300 ELSE IC2274.2 +052400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +052500 TO RE-MARK IC2274.2 +052600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +052700 MOVE "00" TO CORRECT-A IC2274.2 +052800 PERFORM FAIL IC2274.2 +052900 END-IF. IC2274.2 +053000 GO TO EXT-FILE-TEST-02-02. IC2274.2 +053100 EXT-FILE-DELETE-02-02. IC2274.2 +053200 ADD 1 TO REC-CT IC2274.2 +053300 PERFORM DE-LETE. IC2274.2 +053400 GO TO EXT-FILE-TEST-02-END. IC2274.2 +053500 EXT-FILE-TEST-02-02. IC2274.2 +053600 ADD 1 TO REC-CT. IC2274.2 +053700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +053800 PERFORM PASS IC2274.2 +053900 ELSE IC2274.2 +054000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +054100 MOVE "<>" TO CORRECT-A IC2274.2 +054200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +054300 PERFORM FAIL. IC2274.2 +054400* IC2274.2 +054500 EXT-FILE-TEST-02-END. IC2274.2 +054600* IC2274.2 +054700* IC2274.2 +054800 EXT-INIT-03. IC2274.2 +054900* IC2274.2 +055000* ************************************************* IC2274.2 +055100* * * IC2274.2 +055200* * WRITE A RECORD FROM THE MAIN PROGRAM * IC2274.2 +055300* * * IC2274.2 +055400* ************************************************* IC2274.2 +055500* IC2274.2 +055600 MOVE 1 TO REC-CT. IC2274.2 +055700 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2 +055800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +055900 MOVE "EXT-FILE-TEST-03" TO PAR-NAME. IC2274.2 +056000 MOVE "BB" TO EXT-DATA-1 IC2274.2 +056100 MOVE "ZYXWVU" TO EXT-DATA-2 IC2274.2 +056200 MOVE 222222 TO EXT-DATA-3 IC2274.2 +056300 MOVE 9765 TO EXT-DATA-4. IC2274.2 +056400 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +056500 GO TO EXT-FILE-TEST-03-01. IC2274.2 +056600 EXT-FILE-DELETE-03. IC2274.2 +056700 PERFORM DE-LETE. IC2274.2 +056800 GO TO EXT-FILE-TEST-03-END. IC2274.2 +056900* IC2274.2 +057000 EXT-FILE-TEST-03-01. IC2274.2 +057100 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +057200 IF EXTERNAL-FILE-FS IS EQUAL TO "00" IC2274.2 +057300 PERFORM PASS IC2274.2 +057400 ELSE IC2274.2 +057500 MOVE "MAIN PROGRAM FILE STATUS NON-ZERO" TO RE-MARK IC2274.2 +057600 MOVE "00" TO CORRECT-A IC2274.2 +057700 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +057800 PERFORM FAIL. IC2274.2 +057900* IC2274.2 +058000 EXT-FILE-TEST-03-END. IC2274.2 +058100* IC2274.2 +058200* IC2274.2 +058300 EXT-INIT-04. IC2274.2 +058400* IC2274.2 +058500* ************************************************* IC2274.2 +058600* * * IC2274.2 +058700* * CLOSE THE FILE THROUGH THE SUBPROGRAM * IC2274.2 +058800* * * IC2274.2 +058900* ************************************************* IC2274.2 +059000* IC2274.2 +059100 MOVE 1 TO REC-CT. IC2274.2 +059200 MOVE "EXTERNAL FILE CLOSE" TO FEATURE. IC2274.2 +059300 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +059400 MOVE "EXT-FILE-TEST-04" TO PAR-NAME. IC2274.2 +059500 MOVE "**" TO F-S-PARAM. IC2274.2 +059600 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +059700 GO TO EXT-FILE-TEST-04-01. IC2274.2 +059800 EXT-FILE-DELETE-04-01. IC2274.2 +059900 PERFORM DE-LETE. IC2274.2 +060000 CLOSE EXTERNAL-FILE. IC2274.2 +060100 GO TO EXT-FILE-DELETE-04-02. IC2274.2 +060200* IC2274.2 +060300 EXT-FILE-TEST-04-01. IC2274.2 +060400 MOVE 3 TO ACTION-CODE. IC2274.2 +060500 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +060600 EXTERNAL-RECORD-WORK IC2274.2 +060700 REFERENCE F-S-PARAM. IC2274.2 +060800 IF F-S-PARAM IS EQUAL "00" IC2274.2 +060900 PERFORM PASS IC2274.2 +061000 ELSE IC2274.2 +061100 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +061200 TO RE-MARK IC2274.2 +061300 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +061400 MOVE "00" TO CORRECT-A IC2274.2 +061500 PERFORM FAIL IC2274.2 +061600 END-IF. IC2274.2 +061700 GO TO EXT-FILE-TEST-04-02. IC2274.2 +061800 EXT-FILE-DELETE-04-02. IC2274.2 +061900 ADD 1 TO REC-CT IC2274.2 +062000 PERFORM DE-LETE. IC2274.2 +062100 GO TO EXT-FILE-TEST-04-END. IC2274.2 +062200 EXT-FILE-TEST-04-02. IC2274.2 +062300 ADD 1 TO REC-CT. IC2274.2 +062400 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +062500 PERFORM PASS IC2274.2 +062600 ELSE IC2274.2 +062700 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +062800 MOVE "<>" TO CORRECT-A IC2274.2 +062900 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +063000 PERFORM FAIL. IC2274.2 +063100* IC2274.2 +063200 EXT-FILE-TEST-04-END. IC2274.2 +063300* IC2274.2 +063400* IC2274.2 +063500 EXT-INIT-05. IC2274.2 +063600* IC2274.2 +063700* ************************************************* IC2274.2 +063800* * * IC2274.2 +063900* * OPEN FILE FOR INPUT FROM SUBPROGRAM * IC2274.2 +064000* * * IC2274.2 +064100* ************************************************* IC2274.2 +064200* IC2274.2 +064300 MOVE 1 TO REC-CT. IC2274.2 +064400 MOVE "EXTERNAL FILE OPEN" TO FEATURE. IC2274.2 +064500 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +064600 MOVE "EXT-FILE-TEST-05" TO PAR-NAME. IC2274.2 +064700 MOVE "******************" TO EXTERNAL-RECORD-WORK. IC2274.2 +064800 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2 +064900 MOVE "**" TO F-S-PARAM. IC2274.2 +065000 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +065100 GO TO EXT-FILE-TEST-05-01. IC2274.2 +065200 EXT-FILE-DELETE-05. IC2274.2 +065300 PERFORM DE-LETE. IC2274.2 +065400 OPEN INPUT EXTERNAL-FILE. IC2274.2 +065500 GO TO EXT-FILE-DELETE-05-02. IC2274.2 +065600 EXT-FILE-TEST-05-01. IC2274.2 +065700 MOVE 4 TO ACTION-CODE. IC2274.2 +065800 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2 +065900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +066000 BY REFERENCE F-S-PARAM. IC2274.2 +066100 IF F-S-PARAM IS EQUAL "00" IC2274.2 +066200 PERFORM PASS IC2274.2 +066300 ELSE IC2274.2 +066400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +066500 TO RE-MARK IC2274.2 +066600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +066700 MOVE "00" TO CORRECT-A IC2274.2 +066800 PERFORM FAIL IC2274.2 +066900 END-IF. IC2274.2 +067000 GO TO EXT-FILE-TEST-05-02. IC2274.2 +067100 EXT-FILE-DELETE-05-02. IC2274.2 +067200 ADD 1 TO REC-CT IC2274.2 +067300 PERFORM DE-LETE. IC2274.2 +067400 GO TO EXT-FILE-DELETE-05-03. IC2274.2 +067500 EXT-FILE-TEST-05-02. IC2274.2 +067600 ADD 1 TO REC-CT. IC2274.2 +067700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +067800 PERFORM PASS IC2274.2 +067900 ELSE IC2274.2 +068000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +068100 MOVE "<>" TO CORRECT-A IC2274.2 +068200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +068300 PERFORM FAIL. IC2274.2 +068400* GO TO EXT-FILE-TEST-05-03. IC2274.2 +068500 EXT-FILE-DELETE-05-03. IC2274.2 +068600 ADD 1 TO REC-CT. IC2274.2 +068700 PERFORM DE-LETE. IC2274.2 +068800 GO TO EXT-FILE-DELETE-05-04. IC2274.2 +068900 EXT-FILE-TEST-05-03. IC2274.2 +069000 ADD 1 TO REC-CT. IC2274.2 +069100 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +069200 PERFORM PASS IC2274.2 +069300 ELSE IC2274.2 +069400 MOVE "PARAMETER NOT RETURNED THROUGH RECORD AREA" IC2274.2 +069500 TO RE-MARK IC2274.2 +069600 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +069700 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +069800 PERFORM FAIL. IC2274.2 +069900 GO TO EXT-FILE-TEST-05-04. IC2274.2 +070000 EXT-FILE-DELETE-05-04. IC2274.2 +070100 ADD 1 TO REC-CT. IC2274.2 +070200 PERFORM DE-LETE. IC2274.2 +070300 GO TO EXT-FILE-TEST-05-END. IC2274.2 +070400 EXT-FILE-TEST-05-04. IC2274.2 +070500 ADD 1 TO REC-CT. IC2274.2 +070600 IF EXTERNAL-RECORD-WORK IS = "OPEN OPEN OPEN" IC2274.2 +070700 PERFORM PASS IC2274.2 +070800 ELSE IC2274.2 +070900 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +071000 MOVE "OPEN OPEN OPEN" TO CORRECT-A IC2274.2 +071100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +071200 PERFORM FAIL. IC2274.2 +071300* IC2274.2 +071400 EXT-FILE-TEST-05-END. IC2274.2 +071500* IC2274.2 +071600* IC2274.2 +071700 EXT-INIT-06. IC2274.2 +071800* IC2274.2 +071900* ************************************************* IC2274.2 +072000* * * IC2274.2 +072100* * READ THE FIRST RECORD FROM THE FILE WITH * IC2274.2 +072200* * THE MAIN PROGRAM . * IC2274.2 +072300* * * IC2274.2 +072400* ************************************************* IC2274.2 +072500* IC2274.2 +072600 MOVE 1 TO REC-CT. IC2274.2 +072700 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2 +072800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +072900 MOVE "EXT-FILE-TEST-06" TO PAR-NAME. IC2274.2 +073000 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +073100 MOVE "AAPQRSTU1234569876" TO EXTERNAL-RECORD-HOLD. IC2274.2 +073200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +073300 GO TO EXT-FILE-TEST-06-01. IC2274.2 +073400 EXT-FILE-DELETE-06. IC2274.2 +073500 PERFORM DE-LETE. IC2274.2 +073600 GO TO EXT-FILE-DELETE-06-02. IC2274.2 +073700 EXT-FILE-TEST-06-01. IC2274.2 +073800 READ EXTERNAL-FILE NEXT RECORD IC2274.2 +073900 AT END GO TO EXT-FILE-TEST-06-02. IC2274.2 +074000 IF EXTERNAL-FILE-FS IS EQUAL "00" IC2274.2 +074100 PERFORM PASS IC2274.2 +074200 ELSE IC2274.2 +074300 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +074400 TO RE-MARK IC2274.2 +074500 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +074600 MOVE "00" TO CORRECT-A IC2274.2 +074700 PERFORM FAIL IC2274.2 +074800 END-IF. IC2274.2 +074900 GO TO EXT-FILE-TEST-06-02. IC2274.2 +075000 EXT-FILE-DELETE-06-02. IC2274.2 +075100 ADD 1 TO REC-CT IC2274.2 +075200 PERFORM DE-LETE. IC2274.2 +075300 GO TO EXT-FILE-TEST-06-END. IC2274.2 +075400 EXT-FILE-TEST-06-02. IC2274.2 +075500 ADD 1 TO REC-CT. IC2274.2 +075600 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +075700 PERFORM PASS IC2274.2 +075800 ELSE IC2274.2 +075900 MOVE "EXPECTED RECORD NOT READ FROM FILE" IC2274.2 +076000 TO RE-MARK IC2274.2 +076100 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +076200 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +076300 PERFORM FAIL. IC2274.2 +076400* IC2274.2 +076500 EXT-FILE-TEST-06-END. IC2274.2 +076600* IC2274.2 +076700* IC2274.2 +076800 EXT-INIT-07. IC2274.2 +076900* IC2274.2 +077000* ************************************************* IC2274.2 +077100* * * IC2274.2 +077200* * READ SECOND RECORD FROM THE FILE THROUGH * IC2274.2 +077300* * THE SUBPROGRAM * IC2274.2 +077400* * * IC2274.2 +077500* ************************************************* IC2274.2 +077600* IC2274.2 +077700 MOVE 1 TO REC-CT. IC2274.2 +077800 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2 +077900 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +078000 MOVE "EXT-FILE-TEST-07" TO PAR-NAME. IC2274.2 +078100 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +078200 MOVE ";;;;;;;;;;;;;;;;;;" TO EXTERNAL-RECORD-WORK. IC2274.2 +078300 MOVE "BBZYXWVU2222229765" TO EXTERNAL-RECORD-HOLD. IC2274.2 +078400 MOVE "**" TO F-S-PARAM. IC2274.2 +078500 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +078600 GO TO EXT-FILE-TEST-07-01. IC2274.2 +078700 EXT-FILE-DELETE-07. IC2274.2 +078800 PERFORM DE-LETE. IC2274.2 +078900 GO TO EXT-FILE-DELETE-07-02. IC2274.2 +079000 EXT-FILE-TEST-07-01. IC2274.2 +079100 MOVE 5 TO ACTION-CODE. IC2274.2 +079200 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2 +079300 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +079400 BY REFERENCE F-S-PARAM. IC2274.2 +079500 IF F-S-PARAM IS EQUAL "00" IC2274.2 +079600 PERFORM PASS IC2274.2 +079700 ELSE IC2274.2 +079800 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +079900 TO RE-MARK IC2274.2 +080000 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +080100 MOVE "00" TO CORRECT-A IC2274.2 +080200 PERFORM FAIL IC2274.2 +080300 END-IF. IC2274.2 +080400 GO TO EXT-FILE-TEST-07-02. IC2274.2 +080500 EXT-FILE-DELETE-07-02. IC2274.2 +080600 ADD 1 TO REC-CT IC2274.2 +080700 PERFORM DE-LETE. IC2274.2 +080800 GO TO EXT-FILE-DELETE-07-03. IC2274.2 +080900 EXT-FILE-TEST-07-02. IC2274.2 +081000 ADD 1 TO REC-CT. IC2274.2 +081100 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +081200 PERFORM PASS IC2274.2 +081300 ELSE IC2274.2 +081400 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +081500 MOVE "<>" TO CORRECT-A IC2274.2 +081600 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +081700 PERFORM FAIL. IC2274.2 +081800 GO TO EXT-FILE-TEST-07-03. IC2274.2 +081900 EXT-FILE-DELETE-07-03. IC2274.2 +082000 ADD 1 TO REC-CT. IC2274.2 +082100 PERFORM DE-LETE. IC2274.2 +082200 GO TO EXT-FILE-DELETE-07-04. IC2274.2 +082300 EXT-FILE-TEST-07-03. IC2274.2 +082400 ADD 1 TO REC-CT. IC2274.2 +082500 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +082600 PERFORM PASS IC2274.2 +082700 ELSE IC2274.2 +082800 MOVE "EXPECTED RECORD NOT RETURNED THROUGH RECORD AREA" IC2274.2 +082900 TO RE-MARK IC2274.2 +083000 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +083100 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +083200 PERFORM FAIL. IC2274.2 +083300 GO TO EXT-FILE-TEST-07-04. IC2274.2 +083400 EXT-FILE-DELETE-07-04. IC2274.2 +083500 ADD 1 TO REC-CT. IC2274.2 +083600 PERFORM DE-LETE. IC2274.2 +083700 GO TO EXT-FILE-TEST-07-END. IC2274.2 +083800 EXT-FILE-TEST-07-04. IC2274.2 +083900 ADD 1 TO REC-CT. IC2274.2 +084000 IF EXTERNAL-RECORD-WORK IS = EXTERNAL-RECORD-HOLD IC2274.2 +084100 PERFORM PASS IC2274.2 +084200 ELSE IC2274.2 +084300 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +084400 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +084500 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +084600 PERFORM FAIL. IC2274.2 +084700* IC2274.2 +084800 EXT-FILE-TEST-07-END. IC2274.2 +084900* IC2274.2 +085000* IC2274.2 +085100 EXT-INIT-08. IC2274.2 +085200* IC2274.2 +085300* ************************************************* IC2274.2 +085400* * * IC2274.2 +085500* * ATTEMPT TO READ A THIRD RECORD FROM THE * IC2274.2 +085600* * FILE THROUGH THE SUBPROGRAM. THIS SHOULD * IC2274.2 +085700* * CAUSE AN END OF FILE CONDITION. * IC2274.2 +085800* * * IC2274.2 +085900* ************************************************* IC2274.2 +086000* IC2274.2 +086100 MOVE 1 TO REC-CT. IC2274.2 +086200 MOVE "EXTERNAL FILE EOF" TO FEATURE. IC2274.2 +086300 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +086400 MOVE "EXT-FILE-TEST-08" TO PAR-NAME. IC2274.2 +086500 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +086600 MOVE ";;;;;;;;;;;;;;;;;;" TO EXTERNAL-RECORD-WORK. IC2274.2 +086700 MOVE "END-FILE END-FILE" TO EXTERNAL-RECORD-HOLD. IC2274.2 +086800 MOVE "**" TO F-S-PARAM. IC2274.2 +086900 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +087000 GO TO EXT-FILE-TEST-08-01. IC2274.2 +087100 EXT-FILE-DELETE-08. IC2274.2 +087200 PERFORM DE-LETE. IC2274.2 +087300 GO TO EXT-FILE-DELETE-08-02. IC2274.2 +087400 EXT-FILE-TEST-08-01. IC2274.2 +087500 MOVE 5 TO ACTION-CODE. IC2274.2 +087600 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +087700 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +087800 BY REFERENCE F-S-PARAM. IC2274.2 +087900 IF F-S-PARAM IS EQUAL "10" IC2274.2 +088000 PERFORM PASS IC2274.2 +088100 ELSE IC2274.2 +088200 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +088300 TO RE-MARK IC2274.2 +088400 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +088500 MOVE "10" TO CORRECT-A IC2274.2 +088600 PERFORM FAIL IC2274.2 +088700 END-IF. IC2274.2 +088800 GO TO EXT-FILE-TEST-08-02. IC2274.2 +088900 EXT-FILE-DELETE-08-02. IC2274.2 +089000 ADD 1 TO REC-CT IC2274.2 +089100 PERFORM DE-LETE. IC2274.2 +089200 GO TO EXT-FILE-DELETE-08-03. IC2274.2 +089300 EXT-FILE-TEST-08-02. IC2274.2 +089400 ADD 1 TO REC-CT. IC2274.2 +089500 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +089600 PERFORM PASS IC2274.2 +089700 ELSE IC2274.2 +089800 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +089900 MOVE "<>" TO CORRECT-A IC2274.2 +090000 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +090100 PERFORM FAIL. IC2274.2 +090200* GO TO EXT-FILE-TEST-08-03. IC2274.2 +090300 EXT-FILE-DELETE-08-03. IC2274.2 +090400 ADD 1 TO REC-CT. IC2274.2 +090500 PERFORM DE-LETE. IC2274.2 +090600 GO TO EXT-FILE-DELETE-08-04. IC2274.2 +090700 EXT-FILE-TEST-08-03. IC2274.2 +090800 ADD 1 TO REC-CT. IC2274.2 +090900 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +091000 PERFORM PASS IC2274.2 +091100 ELSE IC2274.2 +091200 MOVE "EXPECTED VALUE NOT RETURNED THROUGH RECORD AREA" IC2274.2 +091300 TO RE-MARK IC2274.2 +091400 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +091500 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +091600 PERFORM FAIL. IC2274.2 +091700* GO TO EXT-FILE-TEST-08-04. IC2274.2 +091800 EXT-FILE-DELETE-08-04. IC2274.2 +091900 ADD 1 TO REC-CT. IC2274.2 +092000 PERFORM DE-LETE. IC2274.2 +092100 GO TO EXT-FILE-TEST-08-END. IC2274.2 +092200 EXT-FILE-TEST-08-04. IC2274.2 +092300 ADD 1 TO REC-CT. IC2274.2 +092400 IF EXTERNAL-RECORD-WORK IS = EXTERNAL-RECORD-HOLD IC2274.2 +092500 PERFORM PASS IC2274.2 +092600 ELSE IC2274.2 +092700 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +092800 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +092900 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +093000 PERFORM FAIL. IC2274.2 +093100* IC2274.2 +093200 EXT-FILE-TEST-08-END. IC2274.2 +093300* IC2274.2 +093400* IC2274.2 +093500 EXT-INIT-09. IC2274.2 +093600* IC2274.2 +093700* ************************************************* IC2274.2 +093800* * * IC2274.2 +093900* * CLOSE THE EXTERNAL FILE FROM THE MAIN * IC2274.2 +094000* * PROGRAM. * IC2274.2 +094100* * * IC2274.2 +094200* ************************************************* IC2274.2 +094300* IC2274.2 +094400 MOVE 1 TO REC-CT. IC2274.2 +094500 MOVE "EXTERNAL FILE CLOSE" TO FEATURE. IC2274.2 +094600 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +094700 MOVE "EXT-FILE-TEST-09" TO PAR-NAME. IC2274.2 +094800 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +094900 GO TO EXT-FILE-TEST-09-01. IC2274.2 +095000 EXT-FILE-DELETE-09. IC2274.2 +095100 PERFORM DE-LETE. IC2274.2 +095200 GO TO EXT-FILE-TEST-09-END. IC2274.2 +095300 EXT-FILE-TEST-09-01. IC2274.2 +095400 CLOSE EXTERNAL-FILE. IC2274.2 +095500 IF EXTERNAL-FILE-FS IS EQUAL TO "00" IC2274.2 +095600 PERFORM PASS IC2274.2 +095700 ELSE IC2274.2 +095800 MOVE "FILE CLOSE FAILURE" TO RE-MARK IC2274.2 +095900 MOVE "00" TO CORRECT-A IC2274.2 +096000 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +096100 PERFORM FAIL. IC2274.2 +096200 EXT-FILE-TEST-09-END. IC2274.2 +096300* IC2274.2 +096400* IC2274.2 +096500 CCVS-EXIT SECTION. IC2274.2 +096600 CCVS-999999. IC2274.2 +096700 GO TO CLOSE-FILES. IC2274.2 +096800 END PROGRAM IC227A. IC2274.2 +096900 IDENTIFICATION DIVISION. IC2274.2 +097000 PROGRAM-ID. IC2274.2 +097100 IC227A-1. IC2274.2 +097200**************************************************************** IC2274.2 +097300* * IC2274.2 +097400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2274.2 +097500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2274.2 +097600* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2274.2 +097700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2274.2 +097800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2274.2 +097900* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2274.2 +098000* * IC2274.2 +098100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2274.2 +098200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2274.2 +098300* DOCUMENT REFERENCE: ISO-1989-1978). * IC2274.2 +098400* * IC2274.2 +098500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2274.2 +098600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2274.2 +098700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2274.2 +098800* * IC2274.2 +098900* THE FEDERAL SOFTWARE TESTING CENTER * IC2274.2 +099000* OFFICE OF SOFTWARE DEVELOPMENT * IC2274.2 +099100* & INFORMATION TECHNOLOGY * IC2274.2 +099200* TWO SKYLINE PLACE * IC2274.2 +099300* SUITE 1100 * IC2274.2 +099400* 5203 LEESBURG PIKE * IC2274.2 +099500* FALLS CHURCH * IC2274.2 +099600* VA 22041 * IC2274.2 +099700* U.S.A. * IC2274.2 +099800* * IC2274.2 +099900* THE PROJECT TEAM MEMBERS WERE: * IC2274.2 +100000* * IC2274.2 +100100* BIADI (BUREAU INTER ADMINISTRATION * IC2274.2 +100200* DE DOCUMENTATION INFORMATIQUE) * IC2274.2 +100300* 21 RUE BARA * IC2274.2 +100400* F-92132 ISSY * IC2274.2 +100500* FRANCE * IC2274.2 +100600* * IC2274.2 +100700* * IC2274.2 +100800* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2274.2 +100900* UND DATENVERARBEITUNG MBH) * IC2274.2 +101000* SCHLOSS BIRLINGHOVEN * IC2274.2 +101100* POSTFACH 12 40 * IC2274.2 +101200* D-5205 ST. AUGUSTIN 1 * IC2274.2 +101300* GERMANY FR * IC2274.2 +101400* * IC2274.2 +101500* * IC2274.2 +101600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2274.2 +101700* OXFORD ROAD * IC2274.2 +101800* MANCHESTER * IC2274.2 +101900* M1 7ED * IC2274.2 +102000* UNITED KINGDOM * IC2274.2 +102100* * IC2274.2 +102200* * IC2274.2 +102300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2274.2 +102400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2274.2 +102500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2274.2 +102600* * IC2274.2 +102700* REVISED 1986 AUGUST * IC2274.2 +102800* * IC2274.2 +102900**************************************************************** IC2274.2 +103000* * IC2274.2 +103100* VALIDATION FOR:- * IC2274.2 +103200* * IC2274.2 +103300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +103400* * IC2274.2 +103500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +103600* * IC2274.2 +103700**************************************************************** IC2274.2 +103800* * IC2274.2 +103900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2274.2 +104000* * IC2274.2 +104100* X-82 SOURCE-COMPUTER * IC2274.2 +104200* X-83 OBJECT-COMPUTER. * IC2274.2 +104300* * IC2274.2 +104400**************************************************************** IC2274.2 +104500* * IC2274.2 +104600* PROGRAMS IC227A AND IC227A-1 TEST LEVEL 2 LANGUAGE * IC2274.2 +104700* ELEMENTS FROM THE INTER-PROGRAM COMMUNICATION MODULE. * IC2274.2 +104800* THE PARTICULAR ELEMENTS TESTED ARE: * IC2274.2 +104900* THE "EXTERNAL" CLAUSE IN THE FILE DESCRIPTION ENTRY * IC2274.2 +105000* * IC2274.2 +105100* ALTHOUGH IC227A AND IC227A-1 ARE SEPARATELY COMPILED * IC2274.2 +105200* PROGRAMS, BOTH ARE INTENDED TO BE COMPILED BY THE SAME * IC2274.2 +105300* INVOCATION OF THE COMPILER, IN ORDER TO TEST STREAM * IC2274.2 +105400* COMPILATION AND RECOGNITION OF THE END PROGRAM HEADER. * IC2274.2 +105500* * IC2274.2 +105600* THE STRUCTURE OF THE SOURCE FILE IS: * IC2274.2 +105700* * IC2274.2 +105800* IDENTIFICATION DIVISION. * IC2274.2 +105900* PROGRAM-ID. IC227A. * IC2274.2 +106000* . * IC2274.2 +106100* . * IC2274.2 +106200* . * IC2274.2 +106300* END PROGRAM IC227A. * IC2274.2 +106400* IDENTIFICATION DIVISION. * IC2274.2 +106500* PROGRAM-ID. IC227A-1. * IC2274.2 +106600* . * IC2274.2 +106700* . * IC2274.2 +106800* . * IC2274.2 +106900* END PROGRAM IC227A-1. * IC2274.2 +107000* * IC2274.2 +107100**************************************************************** IC2274.2 +107200* IC2274.2 +107300 ENVIRONMENT DIVISION. IC2274.2 +107400 CONFIGURATION SECTION. IC2274.2 +107500 SOURCE-COMPUTER. IC2274.2 +107600 XXXXX082. IC2274.2 +107700 OBJECT-COMPUTER. IC2274.2 +107800 XXXXX083. IC2274.2 +107900* IC2274.2 +108000 INPUT-OUTPUT SECTION. IC2274.2 +108100 FILE-CONTROL. IC2274.2 +108200 SELECT EXTERNAL-FILE ASSIGN TO IC2274.2 +108300 XXXXX014 IC2274.2 +108400 FILE STATUS IS LINKAGE-FS. IC2274.2 +108500* IC2274.2 +108600 DATA DIVISION. IC2274.2 +108700 FILE SECTION. IC2274.2 +108800 FD EXTERNAL-FILE IC2274.2 +108900 IS EXTERNAL IC2274.2 +109000 RECORD CONTAINS 18 CHARACTERS. IC2274.2 +109100 01 EXTERNAL-FILE-RECORD. IC2274.2 +109200 03 EXT-DATA-1 PIC X(2). IC2274.2 +109300 03 EXT-DATA-2 PIC X(6). IC2274.2 +109400 03 EXT-DATA-3 PIC 9(6). IC2274.2 +109500 03 EXT-DATA-4 PIC 9(4). IC2274.2 +109600* IC2274.2 +109700 WORKING-STORAGE SECTION. IC2274.2 +109800* IC2274.2 +109900*************************************************************** IC2274.2 +110000* * IC2274.2 +110100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * IC2274.2 +110200* * IC2274.2 +110300*************************************************************** IC2274.2 +110400* IC2274.2 +110500 01 EXTERNAL-RECORD-WORK. IC2274.2 +110600 03 WRK-DATA-1 PIC X(2). IC2274.2 +110700 03 WRK-DATA-2 PIC X(6). IC2274.2 +110800 03 WRK-DATA-3 PIC 9(6). IC2274.2 +110900 03 WRK-DATA-4 PIC 9(4). IC2274.2 +111000* IC2274.2 +111100 LINKAGE SECTION. IC2274.2 +111200* IC2274.2 +111300 01 LINKAGE-RECORD-WORK. IC2274.2 +111400 05 WRK-DATA-1 PIC X(2). IC2274.2 +111500 05 WRK-DATA-2 PIC X(6). IC2274.2 +111600 05 WRK-DATA-3 PIC 9(6). IC2274.2 +111700 05 WRK-DATA-4 PIC 9(4). IC2274.2 +111800* IC2274.2 +111900 01 LINKAGE-FS PIC XX. IC2274.2 +112000 01 ACTION-CODE PIC 99. IC2274.2 +112100* IC2274.2 +112200* IC2274.2 +112300 PROCEDURE DIVISION USING ACTION-CODE IC2274.2 +112400 LINKAGE-RECORD-WORK IC2274.2 +112500 LINKAGE-FS. IC2274.2 +112600* IC2274.2 +112700 SECT-IC227A-1-01 SECTION. IC2274.2 +112800 EXT-DECODE-01. IC2274.2 +112900* IC2274.2 +113000* ************************************************* IC2274.2 +113100* * * IC2274.2 +113200* * USE THE ACTION CODE PARAMETER TO IDENTIFY * IC2274.2 +113300* * THE FUNCTION REQUIRED ON THIS ENTRY. * IC2274.2 +113400* * * IC2274.2 +113500* ************************************************* IC2274.2 +113600* IC2274.2 +113700 GO TO SUBPROGRAM-FUNCTION-01 IC2274.2 +113800 SUBPROGRAM-FUNCTION-02 IC2274.2 +113900 SUBPROGRAM-FUNCTION-03 IC2274.2 +114000 SUBPROGRAM-FUNCTION-04 IC2274.2 +114100 SUBPROGRAM-FUNCTION-05 IC2274.2 +114200 DEPENDING ON ACTION-CODE. IC2274.2 +114300* IC2274.2 +114400* CONTROL SHOULD NEVER REACH HERE, BUT ... IC2274.2 +114500* IC2274.2 +114600 MOVE "FFFFFFFFFFFFFFFFFF" TO LINKAGE-RECORD-WORK IC2274.2 +114700 MOVE "FF" TO LINKAGE-FS IC2274.2 +114800 EXIT PROGRAM. IC2274.2 +114900* IC2274.2 +115000* IC2274.2 +115100 SUBPROGRAM-FUNCTION-01. IC2274.2 +115200 MOVE EXTERNAL-FILE-RECORD TO EXTERNAL-RECORD-WORK IC2274.2 +115300 MOVE LINKAGE-RECORD-WORK TO EXTERNAL-FILE-RECORD IC2274.2 +115400 MOVE EXTERNAL-RECORD-WORK TO LINKAGE-RECORD-WORK. IC2274.2 +115500 MOVE "XX" TO LINKAGE-FS. IC2274.2 +115600 EXIT PROGRAM. IC2274.2 +115700* IC2274.2 +115800* IC2274.2 +115900 SUBPROGRAM-FUNCTION-02. IC2274.2 +116000* IC2274.2 +116100* WRITE A RECORD TO THE EXTERNAL FILE IC2274.2 +116200* IC2274.2 +116300 MOVE LINKAGE-RECORD-WORK TO EXTERNAL-FILE-RECORD. IC2274.2 +116400 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +116500 EXIT PROGRAM. IC2274.2 +116600* IC2274.2 +116700* IC2274.2 +116800 SUBPROGRAM-FUNCTION-03. IC2274.2 +116900* IC2274.2 +117000* CLOSE THE EXTERNAL FILE IC2274.2 +117100* IC2274.2 +117200 CLOSE EXTERNAL-FILE. IC2274.2 +117300 EXIT PROGRAM. IC2274.2 +117400* IC2274.2 +117500* IC2274.2 +117600 SUBPROGRAM-FUNCTION-04. IC2274.2 +117700* IC2274.2 +117800* OPEN THE EXTERNAL FILE FOR INPUT IC2274.2 +117900* IC2274.2 +118000 OPEN INPUT EXTERNAL-FILE. IC2274.2 +118100 MOVE "OPEN OPEN OPEN" TO EXTERNAL-FILE-RECORD. IC2274.2 +118200 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +118300 EXIT PROGRAM. IC2274.2 +118400* IC2274.2 +118500* IC2274.2 +118600 SUBPROGRAM-FUNCTION-05. IC2274.2 +118700* IC2274.2 +118800* READ A RECORD FROM THE EXTERNAL FILE IC2274.2 +118900* IC2274.2 +119000 READ EXTERNAL-FILE IC2274.2 +119100 AT END GO TO SUBPROGRAM-FUNCTION-05-EOF. IC2274.2 +119200 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +119300 EXIT PROGRAM. IC2274.2 +119400* IC2274.2 +119500 SUBPROGRAM-FUNCTION-05-EOF. IC2274.2 +119600 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +119700 MOVE "END-FILE END-FILE" TO EXTERNAL-FILE-RECORD. IC2274.2 +119800 EXIT PROGRAM. IC2274.2 +119900* IC2274.2 +120000 END PROGRAM IC227A-1. IC2274.2 +*END-OF,IC227A +*HEADER,COBOL,IC228A +000100 IDENTIFICATION DIVISION. IC2284.2 +000200 PROGRAM-ID. IC2284.2 +000300 IC228A. IC2284.2 +000400**************************************************************** IC2284.2 +000500* * IC2284.2 +000600* VALIDATION FOR:- * IC2284.2 +000700* * IC2284.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +000900* * IC2284.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +001100* * IC2284.2 +001200**************************************************************** IC2284.2 +001300* * IC2284.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2284.2 +001500* * IC2284.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2284.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2284.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2284.2 +001900* * IC2284.2 +002000**************************************************************** IC2284.2 +002100* * IC2284.2 +002200* PROGRAM IC228A AND IC228A-1 WILL TEST THE NEW LANGUAGE * IC2284.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2284.2 +002400* MODULE. * IC2284.2 +002500* THE NEW LANGUAGE ELEMENT TO BE TESTED WILL BE: * IC2284.2 +002600* THE "GLOBAL" PHRASE IN WORKING-STORAGE. * IC2284.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2284.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2284.2 +002900* IDENTIFICATION DIVISION. * IC2284.2 +003000* PROGRAM-ID. IC228A. * IC2284.2 +003100* . * IC2284.2 +003200* . * IC2284.2 +003300* . * IC2284.2 +003400* IDENTIFICATION DIVISION. * IC2284.2 +003500* PROGRAM-ID. IC228A-1. * IC2284.2 +003600* . * IC2284.2 +003700* . * IC2284.2 +003800* . * IC2284.2 +003900* END PROGRAM IC228A-1. * IC2284.2 +004000* END PROGRAM IC228A. * IC2284.2 +004100**************************************************************** IC2284.2 +004200 ENVIRONMENT DIVISION. IC2284.2 +004300 CONFIGURATION SECTION. IC2284.2 +004400 SOURCE-COMPUTER. IC2284.2 +004500 XXXXX082. IC2284.2 +004600 OBJECT-COMPUTER. IC2284.2 +004700 XXXXX083. IC2284.2 +004800 INPUT-OUTPUT SECTION. IC2284.2 +004900 FILE-CONTROL. IC2284.2 +005000 SELECT PRINT-FILE ASSIGN TO IC2284.2 +005100 XXXXX055. IC2284.2 +005200 DATA DIVISION. IC2284.2 +005300 FILE SECTION. IC2284.2 +005400 FD PRINT-FILE. IC2284.2 +005500 01 PRINT-REC PICTURE X(120). IC2284.2 +005600 01 DUMMY-RECORD PICTURE X(120). IC2284.2 +005700 WORKING-STORAGE SECTION. IC2284.2 +005800 01 GLOBAL-DATA IS GLOBAL. IC2284.2 +005900 03 GLO-DATA-1 PIC X(2). IC2284.2 +006000 03 GLO-DATA-2 PIC X(6). IC2284.2 +006100 88 CHANGE-MADE-OK VALUE "CHANGE". IC2284.2 +006200 03 GLO-DATA-3 PIC 9(8). IC2284.2 +006300 03 GLO-DATA-4 PIC 9(4). IC2284.2 +006400 01 SUB PIC 9(4) VALUE ZERO. IC2284.2 +006500* IC2284.2 +006600 01 TEST-RESULTS. IC2284.2 +006700 02 FILLER PIC X VALUE SPACE. IC2284.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2284.2 +006900 02 FILLER PIC X VALUE SPACE. IC2284.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2284.2 +007100 02 FILLER PIC X VALUE SPACE. IC2284.2 +007200 02 PAR-NAME. IC2284.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2284.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2284.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2284.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2284.2 +007700 02 RE-MARK PIC X(61). IC2284.2 +007800 01 TEST-COMPUTED. IC2284.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2284.2 +008000 02 FILLER PIC X(17) VALUE IC2284.2 +008100 " COMPUTED=". IC2284.2 +008200 02 COMPUTED-X. IC2284.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2284.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2284.2 +008500 PIC -9(9).9(9). IC2284.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2284.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2284.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2284.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2284.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2284.2 +009100 04 FILLER PIC X. IC2284.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2284.2 +009300 01 TEST-CORRECT. IC2284.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2284.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2284.2 +009600 02 CORRECT-X. IC2284.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2284.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2284.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2284.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2284.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2284.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2284.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2284.2 +010400 04 FILLER PIC X. IC2284.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2284.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2284.2 +010700 01 CCVS-C-1. IC2284.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2284.2 +010900- "SS PARAGRAPH-NAME IC2284.2 +011000- " REMARKS". IC2284.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2284.2 +011200 01 CCVS-C-2. IC2284.2 +011300 02 FILLER PIC X VALUE SPACE. IC2284.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2284.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2284.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2284.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2284.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2284.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2284.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2284.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2284.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2284.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2284.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2284.2 +012900 01 CCVS-H-1. IC2284.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2284.2 +013100 02 FILLER PIC X(42) VALUE IC2284.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2284.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2284.2 +013400 01 CCVS-H-2A. IC2284.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2284.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2284.2 +013700 02 FILLER PIC XXXX VALUE IC2284.2 +013800 "4.2 ". IC2284.2 +013900 02 FILLER PIC X(28) VALUE IC2284.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2284.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2284.2 +014200 IC2284.2 +014300 01 CCVS-H-2B. IC2284.2 +014400 02 FILLER PIC X(15) VALUE IC2284.2 +014500 "TEST RESULT OF ". IC2284.2 +014600 02 TEST-ID PIC X(9). IC2284.2 +014700 02 FILLER PIC X(4) VALUE IC2284.2 +014800 " IN ". IC2284.2 +014900 02 FILLER PIC X(12) VALUE IC2284.2 +015000 " HIGH ". IC2284.2 +015100 02 FILLER PIC X(22) VALUE IC2284.2 +015200 " LEVEL VALIDATION FOR ". IC2284.2 +015300 02 FILLER PIC X(58) VALUE IC2284.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +015500 01 CCVS-H-3. IC2284.2 +015600 02 FILLER PIC X(34) VALUE IC2284.2 +015700 " FOR OFFICIAL USE ONLY ". IC2284.2 +015800 02 FILLER PIC X(58) VALUE IC2284.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +016000 02 FILLER PIC X(28) VALUE IC2284.2 +016100 " COPYRIGHT 1985 ". IC2284.2 +016200 01 CCVS-E-1. IC2284.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2284.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2284.2 +016500 02 ID-AGAIN PIC X(9). IC2284.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2284.2 +016700 01 CCVS-E-2. IC2284.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2284.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2284.2 +017000 02 CCVS-E-2-2. IC2284.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2284.2 +017200 03 FILLER PIC X VALUE SPACE. IC2284.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2284.2 +017400 "ERRORS ENCOUNTERED". IC2284.2 +017500 01 CCVS-E-3. IC2284.2 +017600 02 FILLER PIC X(22) VALUE IC2284.2 +017700 " FOR OFFICIAL USE ONLY". IC2284.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2284.2 +017900 02 FILLER PIC X(58) VALUE IC2284.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2284.2 +018200 02 FILLER PIC X(15) VALUE IC2284.2 +018300 " COPYRIGHT 1985". IC2284.2 +018400 01 CCVS-E-4. IC2284.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2284.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2284.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2284.2 +018800 02 FILLER PIC X(40) VALUE IC2284.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2284.2 +019000 01 XXINFO. IC2284.2 +019100 02 FILLER PIC X(19) VALUE IC2284.2 +019200 "*** INFORMATION ***". IC2284.2 +019300 02 INFO-TEXT. IC2284.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2284.2 +019500 04 XXCOMPUTED PIC X(20). IC2284.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2284.2 +019700 04 XXCORRECT PIC X(20). IC2284.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2284.2 +019900 01 HYPHEN-LINE. IC2284.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2284.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2284.2 +020200- "*****************************************". IC2284.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2284.2 +020400- "******************************". IC2284.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2284.2 +020600 "IC228A". IC2284.2 +020700 PROCEDURE DIVISION. IC2284.2 +020800 CCVS1 SECTION. IC2284.2 +020900 OPEN-FILES. IC2284.2 +021000 OPEN OUTPUT PRINT-FILE. IC2284.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2284.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2284.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2284.2 +021400 GO TO CCVS1-EXIT. IC2284.2 +021500 CLOSE-FILES. IC2284.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2284.2 +021700 TERMINATE-CCVS. IC2284.2 +021800S EXIT PROGRAM. IC2284.2 +021900STERMINATE-CALL. IC2284.2 +022000 STOP RUN. IC2284.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2284.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2284.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2284.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2284.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2284.2 +022600 PRINT-DETAIL. IC2284.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2284.2 +022800 MOVE "." TO PARDOT-X IC2284.2 +022900 MOVE REC-CT TO DOTVALUE. IC2284.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2284.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2284.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2284.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2284.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2284.2 +023500 MOVE SPACE TO CORRECT-X. IC2284.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2284.2 +023700 MOVE SPACE TO RE-MARK. IC2284.2 +023800 HEAD-ROUTINE. IC2284.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2284.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2284.2 +024300 COLUMN-NAMES-ROUTINE. IC2284.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +024700 END-ROUTINE. IC2284.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2284.2 +024900 END-RTN-EXIT. IC2284.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +025100 END-ROUTINE-1. IC2284.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2284.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2284.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2284.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2284.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2284.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2284.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2284.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2284.2 +026000 END-ROUTINE-12. IC2284.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2284.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2284.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2284.2 +026400 ELSE IC2284.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2284.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2284.2 +026700 PERFORM WRITE-LINE. IC2284.2 +026800 END-ROUTINE-13. IC2284.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2284.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2284.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2284.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2284.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2284.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2284.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2284.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2284.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +028000 WRITE-LINE. IC2284.2 +028100 ADD 1 TO RECORD-COUNT. IC2284.2 +028200Y IF RECORD-COUNT GREATER 50 IC2284.2 +028300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2284.2 +028400Y MOVE SPACE TO DUMMY-RECORD IC2284.2 +028500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2284.2 +028600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2284.2 +028700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2284.2 +028800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2284.2 +028900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2284.2 +029000Y MOVE ZERO TO RECORD-COUNT. IC2284.2 +029100 PERFORM WRT-LN. IC2284.2 +029200 WRT-LN. IC2284.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2284.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2284.2 +029500 BLANK-LINE-PRINT. IC2284.2 +029600 PERFORM WRT-LN. IC2284.2 +029700 FAIL-ROUTINE. IC2284.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2284.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2284.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2284.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2284.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2284.2 +030400 GO TO FAIL-ROUTINE-EX. IC2284.2 +030500 FAIL-ROUTINE-WRITE. IC2284.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2284.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2284.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2284.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2284.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2284.2 +031100 BAIL-OUT. IC2284.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2284.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2284.2 +031400 BAIL-OUT-WRITE. IC2284.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2284.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2284.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2284.2 +031900 BAIL-OUT-EX. EXIT. IC2284.2 +032000 CCVS1-EXIT. IC2284.2 +032100 EXIT. IC2284.2 +032200 SECT-IC228A-001 SECTION. IC2284.2 +032300 GLO-INIT-01. IC2284.2 +032400 MOVE "X-20 4.3.2" TO ANSI-REFERENCE. IC2284.2 +032500 MOVE "GLOBAL CLAUSE" TO FEATURE. IC2284.2 +032600 MOVE "AA" TO GLO-DATA-1. IC2284.2 +032700 MOVE "FIRST]" TO GLO-DATA-2. IC2284.2 +032800 MOVE 12345678 TO GLO-DATA-3. IC2284.2 +032900 MOVE 1 TO GLO-DATA-4. IC2284.2 +033000 GLO-TEST-01-01-0. IC2284.2 +033100 CALL "IC228A-1" IC2284.2 +033200 END-CALL. IC2284.2 +033300 GO TO GLO-TEST-01-01-1. IC2284.2 +033400 GLO-DELETE-01-01. IC2284.2 +033500 PERFORM DE-LETE. IC2284.2 +033600 PERFORM PRINT-DETAIL. IC2284.2 +033700 GO TO CCVS-EXIT. IC2284.2 +033800 GLO-TEST-01-01-1. IC2284.2 +033900 MOVE "GLO-TEST-01-01-1" TO PAR-NAME. IC2284.2 +034000 IF GLO-DATA-1 = "ZZ" IC2284.2 +034100 PERFORM PASS IC2284.2 +034200 PERFORM PRINT-DETAIL IC2284.2 +034300 ELSE IC2284.2 +034400 MOVE GLO-DATA-1 TO COMPUTED-X IC2284.2 +034500 MOVE "ZZ" TO CORRECT-X IC2284.2 +034600 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +034700 PERFORM FAIL IC2284.2 +034800 PERFORM PRINT-DETAIL. IC2284.2 +034900 ADD 1 TO REC-CT. IC2284.2 +035000 CALL-TEST-01-01-2. IC2284.2 +035100 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2284.2 +035200 IF CHANGE-MADE-OK IC2284.2 +035300 PERFORM PASS IC2284.2 +035400 PERFORM PRINT-DETAIL IC2284.2 +035500 ELSE IC2284.2 +035600 MOVE GLO-DATA-2 TO COMPUTED-X IC2284.2 +035700 MOVE "CHANGE" TO CORRECT-X IC2284.2 +035800 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +035900 PERFORM FAIL IC2284.2 +036000 PERFORM PRINT-DETAIL. IC2284.2 +036100 ADD 1 TO REC-CT. IC2284.2 +036200 CALL-TEST-01-01-3. IC2284.2 +036300 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2284.2 +036400 IF GLO-DATA-3 = 87654321 IC2284.2 +036500 PERFORM PASS IC2284.2 +036600 PERFORM PRINT-DETAIL IC2284.2 +036700 ELSE IC2284.2 +036800 MOVE GLO-DATA-3 TO COMPUTED-N IC2284.2 +036900 MOVE 87654321 TO CORRECT-N IC2284.2 +037000 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +037100 PERFORM FAIL IC2284.2 +037200 PERFORM PRINT-DETAIL. IC2284.2 +037300 ADD 1 TO REC-CT. IC2284.2 +037400 CALL-TEST-01-01-4. IC2284.2 +037500 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2284.2 +037600 IF GLO-DATA-4 = 11 IC2284.2 +037700 PERFORM PASS IC2284.2 +037800 PERFORM PRINT-DETAIL IC2284.2 +037900 ELSE IC2284.2 +038000 MOVE GLO-DATA-4 TO COMPUTED-N IC2284.2 +038100 MOVE 11 TO CORRECT-N IC2284.2 +038200 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +038300 PERFORM FAIL IC2284.2 +038400 PERFORM PRINT-DETAIL. IC2284.2 +038500* IC2284.2 +038600 CCVS-EXIT SECTION. IC2284.2 +038700 CCVS-999999. IC2284.2 +038800 GO TO CLOSE-FILES. IC2284.2 +038900 IDENTIFICATION DIVISION. IC2284.2 +039000 PROGRAM-ID. IC2284.2 +039100 IC228A-1. IC2284.2 +039200**************************************************************** IC2284.2 +039300* * IC2284.2 +039400* VALIDATION FOR:- * IC2284.2 +039500* * IC2284.2 +039600* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +039700* * IC2284.2 +039800* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +039900* * IC2284.2 +040000**************************************************************** IC2284.2 +040100* * IC2284.2 +040200* X-CARDS USED BY THIS PROGRAM ARE :- * IC2284.2 +040300* * IC2284.2 +040400* X-55 - SYSTEM PRINTER NAME. * IC2284.2 +040500* X-82 - SOURCE COMPUTER NAME. * IC2284.2 +040600* X-83 - OBJECT COMPUTER NAME. * IC2284.2 +040700* * IC2284.2 +040800**************************************************************** IC2284.2 +040900* * IC2284.2 +041000* PROGRAM IC228A AND IC228A-1 WILL TEST THE NEW LANGUAGE * IC2284.2 +041100* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2284.2 +041200* MODULE. * IC2284.2 +041300* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2284.2 +041400* THE "GLOBAL" CLAUSE IN WORKING-STORAGE. * IC2284.2 +041500* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2284.2 +041600* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2284.2 +041700* IDENTIFICATION DIVISION. * IC2284.2 +041800* PROGRAM-ID. IC228A. * IC2284.2 +041900* . * IC2284.2 +042000* . * IC2284.2 +042100* . * IC2284.2 +042200* IDENTIFICATION DIVISION. * IC2284.2 +042300* PROGRAM-ID. IC228A-1. * IC2284.2 +042400* . * IC2284.2 +042500* . * IC2284.2 +042600* . * IC2284.2 +042700* END PROGRAM IC228A-1. * IC2284.2 +042800* END PROGRAM IC228A. * IC2284.2 +042900**************************************************************** IC2284.2 +043000 ENVIRONMENT DIVISION. IC2284.2 +043100*INPUT-OUTPUT SECTION. IC2284.2 +043200 DATA DIVISION. IC2284.2 +043300*FILE SECTION. IC2284.2 +043400 WORKING-STORAGE SECTION. IC2284.2 +043500 PROCEDURE DIVISION. IC2284.2 +043600 SECT-IC228A-1-001 SECTION. IC2284.2 +043700 GLO-TEST-001. IC2284.2 +043800 MOVE "ZZ" TO GLO-DATA-1. IC2284.2 +043900 MOVE "CHANGE" TO GLO-DATA-2. IC2284.2 +044000 MOVE 87654321 TO GLO-DATA-3. IC2284.2 +044100 ADD 10 TO GLO-DATA-4. IC2284.2 +044200 GLO-EXIT-001. IC2284.2 +044300 EXIT PROGRAM. IC2284.2 +044400 END PROGRAM IC228A-1. IC2284.2 +044500 END PROGRAM IC228A. IC2284.2 +*END-OF,IC228A +*HEADER,COBOL,IC233A +000100 IDENTIFICATION DIVISION. IC2334.2 +000200 PROGRAM-ID. IC2334.2 +000300 IC233A. IC2334.2 +000400**************************************************************** IC2334.2 +000500* * IC2334.2 +000600* VALIDATION FOR:- * IC2334.2 +000700* * IC2334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +000900* * IC2334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +001100* * IC2334.2 +001200**************************************************************** IC2334.2 +001300* * IC2334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 +001500* * IC2334.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2334.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2334.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2334.2 +001900* X-18 - OPTIONAL SEQUENTIAL MASS STORAGE FILE. * IC2334.2 +002000**************************************************************** IC2334.2 +002100* * IC2334.2 +002200* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 +002300* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 +002400* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 +002500* * IC2334.2 +002600* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 +002700* COMPILER AS SHOWN BELOW: * IC2334.2 +002800* IDENTIFICATION DIVISION. * IC2334.2 +002900* PROGRAM-ID. IC233A. * IC2334.2 +003000* . * IC2334.2 +003100* . * IC2334.2 +003200* . * IC2334.2 +003300* IDENTIFICATION DIVISION. * IC2334.2 +003400* PROGRAM-ID. IC233A-1. * IC2334.2 +003500* . * IC2334.2 +003600* . * IC2334.2 +003700* END PROGRAM IC233A-1. * IC2334.2 +003800* END PROGRAM IC233A. * IC2334.2 +003900**************************************************************** IC2334.2 +004000 ENVIRONMENT DIVISION. IC2334.2 +004100 CONFIGURATION SECTION. IC2334.2 +004200 SOURCE-COMPUTER. IC2334.2 +004300 XXXXX082. IC2334.2 +004400 OBJECT-COMPUTER. IC2334.2 +004500 XXXXX083. IC2334.2 +004600 INPUT-OUTPUT SECTION. IC2334.2 +004700 FILE-CONTROL. IC2334.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2334.2 +004900 XXXXX055. IC2334.2 +005000 SELECT OPTIONAL TEST-FILE ASSIGN TO IC2334.2 +005100 XXXXX018. IC2334.2 +005200 DATA DIVISION. IC2334.2 +005300 FILE SECTION. IC2334.2 +005400 FD PRINT-FILE. IC2334.2 +005500 01 PRINT-REC PICTURE X(120). IC2334.2 +005600 01 DUMMY-RECORD PICTURE X(120). IC2334.2 +005700 FD TEST-FILE GLOBAL. IC2334.2 +005800 01 TEST-REC PIC X(20). IC2334.2 +005900 WORKING-STORAGE SECTION. IC2334.2 +006000 01 DILFRAP PIC 9. IC2334.2 +006100 01 TEST-RESULTS. IC2334.2 +006200 02 FILLER PIC X VALUE SPACE. IC2334.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. IC2334.2 +006400 02 FILLER PIC X VALUE SPACE. IC2334.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. IC2334.2 +006600 02 FILLER PIC X VALUE SPACE. IC2334.2 +006700 02 PAR-NAME. IC2334.2 +006800 03 FILLER PIC X(19) VALUE SPACE. IC2334.2 +006900 03 PARDOT-X PIC X VALUE SPACE. IC2334.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. IC2334.2 +007100 02 FILLER PIC X(8) VALUE SPACE. IC2334.2 +007200 02 RE-MARK PIC X(61). IC2334.2 +007300 01 TEST-COMPUTED. IC2334.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 +007500 02 FILLER PIC X(17) VALUE IC2334.2 +007600 " COMPUTED=". IC2334.2 +007700 02 COMPUTED-X. IC2334.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2334.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A IC2334.2 +008000 PIC -9(9).9(9). IC2334.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2334.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2334.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2334.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. IC2334.2 +008500 04 COMPUTED-18V0 PIC -9(18). IC2334.2 +008600 04 FILLER PIC X. IC2334.2 +008700 03 FILLER PIC X(50) VALUE SPACE. IC2334.2 +008800 01 TEST-CORRECT. IC2334.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2334.2 +009100 02 CORRECT-X. IC2334.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2334.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2334.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2334.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2334.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2334.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. IC2334.2 +009800 04 CORRECT-18V0 PIC -9(18). IC2334.2 +009900 04 FILLER PIC X. IC2334.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IC2334.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2334.2 +010200 01 CCVS-C-1. IC2334.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2334.2 +010400- "SS PARAGRAPH-NAME IC2334.2 +010500- " REMARKS". IC2334.2 +010600 02 FILLER PIC X(20) VALUE SPACE. IC2334.2 +010700 01 CCVS-C-2. IC2334.2 +010800 02 FILLER PIC X VALUE SPACE. IC2334.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". IC2334.2 +011000 02 FILLER PIC X(15) VALUE SPACE. IC2334.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". IC2334.2 +011200 02 FILLER PIC X(94) VALUE SPACE. IC2334.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2334.2 +011400 01 REC-CT PIC 99 VALUE ZERO. IC2334.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2334.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2334.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2334.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2334.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2334.2 +012400 01 CCVS-H-1. IC2334.2 +012500 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 +012600 02 FILLER PIC X(42) VALUE IC2334.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2334.2 +012800 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 +012900 01 CCVS-H-2A. IC2334.2 +013000 02 FILLER PIC X(40) VALUE SPACE. IC2334.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2334.2 +013200 02 FILLER PIC XXXX VALUE IC2334.2 +013300 "4.2 ". IC2334.2 +013400 02 FILLER PIC X(28) VALUE IC2334.2 +013500 " COPY - NOT FOR DISTRIBUTION". IC2334.2 +013600 02 FILLER PIC X(41) VALUE SPACE. IC2334.2 +013700 IC2334.2 +013800 01 CCVS-H-2B. IC2334.2 +013900 02 FILLER PIC X(15) VALUE IC2334.2 +014000 "TEST RESULT OF ". IC2334.2 +014100 02 TEST-ID PIC X(9). IC2334.2 +014200 02 FILLER PIC X(4) VALUE IC2334.2 +014300 " IN ". IC2334.2 +014400 02 FILLER PIC X(12) VALUE IC2334.2 +014500 " HIGH ". IC2334.2 +014600 02 FILLER PIC X(22) VALUE IC2334.2 +014700 " LEVEL VALIDATION FOR ". IC2334.2 +014800 02 FILLER PIC X(58) VALUE IC2334.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +015000 01 CCVS-H-3. IC2334.2 +015100 02 FILLER PIC X(34) VALUE IC2334.2 +015200 " FOR OFFICIAL USE ONLY ". IC2334.2 +015300 02 FILLER PIC X(58) VALUE IC2334.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +015500 02 FILLER PIC X(28) VALUE IC2334.2 +015600 " COPYRIGHT 1985 ". IC2334.2 +015700 01 CCVS-E-1. IC2334.2 +015800 02 FILLER PIC X(52) VALUE SPACE. IC2334.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2334.2 +016000 02 ID-AGAIN PIC X(9). IC2334.2 +016100 02 FILLER PIC X(45) VALUE SPACES. IC2334.2 +016200 01 CCVS-E-2. IC2334.2 +016300 02 FILLER PIC X(31) VALUE SPACE. IC2334.2 +016400 02 FILLER PIC X(21) VALUE SPACE. IC2334.2 +016500 02 CCVS-E-2-2. IC2334.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2334.2 +016700 03 FILLER PIC X VALUE SPACE. IC2334.2 +016800 03 ENDER-DESC PIC X(44) VALUE IC2334.2 +016900 "ERRORS ENCOUNTERED". IC2334.2 +017000 01 CCVS-E-3. IC2334.2 +017100 02 FILLER PIC X(22) VALUE IC2334.2 +017200 " FOR OFFICIAL USE ONLY". IC2334.2 +017300 02 FILLER PIC X(12) VALUE SPACE. IC2334.2 +017400 02 FILLER PIC X(58) VALUE IC2334.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +017600 02 FILLER PIC X(13) VALUE SPACE. IC2334.2 +017700 02 FILLER PIC X(15) VALUE IC2334.2 +017800 " COPYRIGHT 1985". IC2334.2 +017900 01 CCVS-E-4. IC2334.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2334.2 +018100 02 FILLER PIC X(4) VALUE " OF ". IC2334.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2334.2 +018300 02 FILLER PIC X(40) VALUE IC2334.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2334.2 +018500 01 XXINFO. IC2334.2 +018600 02 FILLER PIC X(19) VALUE IC2334.2 +018700 "*** INFORMATION ***". IC2334.2 +018800 02 INFO-TEXT. IC2334.2 +018900 04 FILLER PIC X(8) VALUE SPACE. IC2334.2 +019000 04 XXCOMPUTED PIC X(20). IC2334.2 +019100 04 FILLER PIC X(5) VALUE SPACE. IC2334.2 +019200 04 XXCORRECT PIC X(20). IC2334.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). IC2334.2 +019400 01 HYPHEN-LINE. IC2334.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. IC2334.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************IC2334.2 +019700- "*****************************************". IC2334.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************IC2334.2 +019900- "******************************". IC2334.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE IC2334.2 +020100 "IC233A". IC2334.2 +020200 PROCEDURE DIVISION. IC2334.2 +020300 DECLARATIVES. IC2334.2 +020400 SECT-IC233A-001 SECTION. IC2334.2 +020500 USE GLOBAL AFTER ERROR PROCEDURE ON INPUT. IC2334.2 +020600 USE-TEST-2. IC2334.2 +020700 PERFORM D1-PASS. IC2334.2 +020800 PERFORM D1-PRINT-DETAIL. IC2334.2 +020900 MOVE 1 TO DILFRAP. IC2334.2 +021000 GO TO EXIT-USE-TEST-2. IC2334.2 +021100 D1-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 +021200 D1-PRINT-DETAIL. IC2334.2 +021300 IF REC-CT NOT EQUAL TO ZERO IC2334.2 +021400 MOVE "." TO PARDOT-X IC2334.2 +021500 MOVE REC-CT TO DOTVALUE. IC2334.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D1-WRITE-LINE. IC2334.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM D1-WRITE-LINE IC2334.2 +021800 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX IC2334.2 +021900 ELSE PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. IC2334.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 +022100 MOVE SPACE TO CORRECT-X. IC2334.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 +022300 MOVE SPACE TO RE-MARK. IC2334.2 +022400 D1-WRITE-LINE. IC2334.2 +022500 ADD 1 TO RECORD-COUNT. IC2334.2 +022600Y IF RECORD-COUNT GREATER 50 IC2334.2 +022700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 +022800Y MOVE SPACE TO DUMMY-RECORD IC2334.2 +022900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 +023000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 +023100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D1-WRT-LN 2 TIMES IC2334.2 +023200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 +023300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 +023400Y MOVE ZERO TO RECORD-COUNT. IC2334.2 +023500 PERFORM D1-WRT-LN. IC2334.2 +023600 D1-WRT-LN. IC2334.2 +023700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 +023800 MOVE SPACE TO DUMMY-RECORD. IC2334.2 +023900 D1-FAIL-ROUTINE. IC2334.2 +024000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE.IC2334.2 +024100 IF CORRECT-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE. IC2334.2 +024200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +024300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 +024400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 +024500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +024600 GO TO D1-FAIL-ROUTINE-EX. IC2334.2 +024700 D1-FAIL-ROUTINE-WRITE. IC2334.2 +024800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D1-WRITE-LINE IC2334.2 +024900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 +025000 MOVE TEST-CORRECT TO PRINT-REC PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 +025100 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 +025200 D1-FAIL-ROUTINE-EX. EXIT. IC2334.2 +025300 D1-BAIL-OUT. IC2334.2 +025400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D1-BAIL-OUT-WRITE. IC2334.2 +025500 IF CORRECT-A EQUAL TO SPACE GO TO D1-BAIL-OUT-EX. IC2334.2 +025600 D1-BAIL-OUT-WRITE. IC2334.2 +025700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 +025800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +025900 MOVE XXINFO TO DUMMY-RECORD. IC2334.2 +026000 PERFORM D1-WRITE-LINE 2 TIMES. IC2334.2 +026100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +026200 D1-BAIL-OUT-EX. EXIT. IC2334.2 +026300 EXIT-USE-TEST-2. IC2334.2 +026400 EXIT. IC2334.2 +026500 END DECLARATIVES. IC2334.2 +026600 CCVS1 SECTION. IC2334.2 +026700 OPEN-FILES. IC2334.2 +026800 OPEN OUTPUT PRINT-FILE. IC2334.2 +026900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2334.2 +027000 MOVE SPACE TO TEST-RESULTS. IC2334.2 +027100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2334.2 +027200 GO TO CCVS1-EXIT. IC2334.2 +027300 CLOSE-FILES. IC2334.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2334.2 +027500 TERMINATE-CCVS. IC2334.2 +027600S EXIT PROGRAM. IC2334.2 +027700STERMINATE-CALL. IC2334.2 +027800 STOP RUN. IC2334.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2334.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2334.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2334.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2334.2 +028400 PRINT-DETAIL. IC2334.2 +028500 IF REC-CT NOT EQUAL TO ZERO IC2334.2 +028600 MOVE "." TO PARDOT-X IC2334.2 +028700 MOVE REC-CT TO DOTVALUE. IC2334.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2334.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2334.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2334.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2334.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 +029300 MOVE SPACE TO CORRECT-X. IC2334.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 +029500 MOVE SPACE TO RE-MARK. IC2334.2 +029600 HEAD-ROUTINE. IC2334.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 +030100 COLUMN-NAMES-ROUTINE. IC2334.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +030500 END-ROUTINE. IC2334.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2334.2 +030700 END-RTN-EXIT. IC2334.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +030900 END-ROUTINE-1. IC2334.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2334.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2334.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. IC2334.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2334.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2334.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2334.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2334.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2334.2 +031800 END-ROUTINE-12. IC2334.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2334.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2334.2 +032100 MOVE "NO " TO ERROR-TOTAL IC2334.2 +032200 ELSE IC2334.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2334.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2334.2 +032500 PERFORM WRITE-LINE. IC2334.2 +032600 END-ROUTINE-13. IC2334.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2334.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE IC2334.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2334.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2334.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO IC2334.2 +033300 MOVE "NO " TO ERROR-TOTAL IC2334.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2334.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2334.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033800 WRITE-LINE. IC2334.2 +033900 ADD 1 TO RECORD-COUNT. IC2334.2 +034000Y IF RECORD-COUNT GREATER 50 IC2334.2 +034100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 +034200Y MOVE SPACE TO DUMMY-RECORD IC2334.2 +034300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 +034400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 +034500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2334.2 +034600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 +034700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 +034800Y MOVE ZERO TO RECORD-COUNT. IC2334.2 +034900 PERFORM WRT-LN. IC2334.2 +035000 WRT-LN. IC2334.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 +035200 MOVE SPACE TO DUMMY-RECORD. IC2334.2 +035300 BLANK-LINE-PRINT. IC2334.2 +035400 PERFORM WRT-LN. IC2334.2 +035500 FAIL-ROUTINE. IC2334.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2334.2 +035700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2334.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +036200 GO TO FAIL-ROUTINE-EX. IC2334.2 +036300 FAIL-ROUTINE-WRITE. IC2334.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2334.2 +036500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 +036600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2334.2 +036700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 +036800 FAIL-ROUTINE-EX. EXIT. IC2334.2 +036900 BAIL-OUT. IC2334.2 +037000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2334.2 +037100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2334.2 +037200 BAIL-OUT-WRITE. IC2334.2 +037300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +037700 BAIL-OUT-EX. EXIT. IC2334.2 +037800 CCVS1-EXIT. IC2334.2 +037900 EXIT. IC2334.2 +038000 SECT-IC233A-1R-001 SECTION. IC2334.2 +038100 USE-INIT-1. IC2334.2 +038200 MOVE "USE-TEST-1" TO PAR-NAME. IC2334.2 +038300 MOVE "X-34 5.5.4 GR(1)B" TO ANSI-REFERENCE. IC2334.2 +038400 MOVE ZERO TO DILFRAP. IC2334.2 +038500 USE-TEST-0. IC2334.2 +038600 CALL "IC233A-1". IC2334.2 +038700 IF DILFRAP = 1 IC2334.2 +038800 GO TO CCVS-EXIT. IC2334.2 +038900 USE-FAIL-1. IC2334.2 +039000 MOVE "USE PROCEDURE NOT INVOKED" TO RE-MARK. IC2334.2 +039100 PERFORM FAIL. IC2334.2 +039200 GO TO USE-WRITE-1. IC2334.2 +039300 USE-DELETE-1. IC2334.2 +039400 PERFORM DE-LETE. IC2334.2 +039500 USE-WRITE-1. IC2334.2 +039600 PERFORM PRINT-DETAIL. IC2334.2 +039700* IC2334.2 +039800 CCVS-EXIT SECTION. IC2334.2 +039900 CCVS-999999. IC2334.2 +040000 GO TO CLOSE-FILES. IC2334.2 +040100* IC2334.2 +040200 IDENTIFICATION DIVISION. IC2334.2 +040300 PROGRAM-ID. IC2334.2 +040400 IC233A-1. IC2334.2 +040500**************************************************************** IC2334.2 +040600* * IC2334.2 +040700* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2334.2 +040800* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2334.2 +040900* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2334.2 +041000* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2334.2 +041100* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2334.2 +041200* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2334.2 +041300* * IC2334.2 +041400* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2334.2 +041500* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2334.2 +041600* DOCUMENT REFERENCE: ISO-1989-1978). * IC2334.2 +041700* * IC2334.2 +041800* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2334.2 +041900* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2334.2 +042000* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2334.2 +042100* * IC2334.2 +042200* THE FEDERAL SOFTWARE TESTING CENTER * IC2334.2 +042300* OFFICE OF SOFTWARE DEVELOPMENT * IC2334.2 +042400* & INFORMATION TECHNOLOGY * IC2334.2 +042500* TWO SKYLINE PLACE * IC2334.2 +042600* SUITE 1100 * IC2334.2 +042700* 5203 LEESBURG PIKE * IC2334.2 +042800* FALLS CHURCH * IC2334.2 +042900* VA 22041 * IC2334.2 +043000* U.S.A. * IC2334.2 +043100* * IC2334.2 +043200* THE PROJECT TEAM MEMBERS WERE: * IC2334.2 +043300* * IC2334.2 +043400* BIADI (BUREAU INTER ADMINISTRATION * IC2334.2 +043500* DE DOCUMENTATION INFORMATIQUE) * IC2334.2 +043600* 21 RUE BARA * IC2334.2 +043700* F-92132 ISSY * IC2334.2 +043800* FRANCE * IC2334.2 +043900* * IC2334.2 +044000* * IC2334.2 +044100* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2334.2 +044200* UND DATENVERARBEITUNG MBH) * IC2334.2 +044300* SCHLOSS BIRLINGHOVEN * IC2334.2 +044400* POSTFACH 12 40 * IC2334.2 +044500* D-5205 ST. AUGUSTIN 1 * IC2334.2 +044600* GERMANY FR * IC2334.2 +044700* * IC2334.2 +044800* * IC2334.2 +044900* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2334.2 +045000* OXFORD ROAD * IC2334.2 +045100* MANCHESTER * IC2334.2 +045200* M1 7ED * IC2334.2 +045300* UNITED KINGDOM * IC2334.2 +045400* * IC2334.2 +045500* * IC2334.2 +045600* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2334.2 +045700* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2334.2 +045800* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2334.2 +045900* * IC2334.2 +046000**************************************************************** IC2334.2 +046100* * IC2334.2 +046200* VALIDATION FOR:- * IC2334.2 +046300* * IC2334.2 +046400* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +046500* * IC2334.2 +046600* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +046700* * IC2334.2 +046800**************************************************************** IC2334.2 +046900* * IC2334.2 +047000* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 +047100* * IC2334.2 +047200* X-55 - SYSTEM PRINTER NAME. * IC2334.2 +047300* X-82 - SOURCE COMPUTER NAME. * IC2334.2 +047400* X-83 - OBJECT COMPUTER NAME. * IC2334.2 +047500* X-92 - TEST-FILE. * IC2334.2 +047600* * IC2334.2 +047700**************************************************************** IC2334.2 +047800* * IC2334.2 +047900* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 +048000* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 +048100* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 +048200* * IC2334.2 +048300* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 +048400* COMPILER AS SHOWN BELOW: * IC2334.2 +048500* IDENTIFICATION DIVISION. * IC2334.2 +048600* PROGRAM-ID. IC233A. * IC2334.2 +048700* . * IC2334.2 +048800* . * IC2334.2 +048900* . * IC2334.2 +049000* IDENTIFICATION DIVISION. * IC2334.2 +049100* PROGRAM-ID. IC233A-1. * IC2334.2 +049200* . * IC2334.2 +049300* . * IC2334.2 +049400* END PROGRAM IC233A-1. * IC2334.2 +049500* END PROGRAM IC233A. * IC2334.2 +049600**************************************************************** IC2334.2 +049700*ENVIRONMENT DIVISION. IC2334.2 +049800*INPUT-OUTPUT SECTION. IC2334.2 +049900*FILE-CONTROL. IC2334.2 +050000* SELECT TEST-FILE ASSIGN TO IC2334.2 +050100* XXXXX018. IC2334.2 +050200 DATA DIVISION. IC2334.2 +050300 FILE SECTION. IC2334.2 +050400 WORKING-STORAGE SECTION. IC2334.2 +050500 PROCEDURE DIVISION. IC2334.2 +050600 SECT-IC233A-1-001 SECTION. IC2334.2 +050700 USE-INIT-1. IC2334.2 +050800 OPEN INPUT TEST-FILE. IC2334.2 +050900 READ TEST-FILE. IC2334.2 +051000 END-PROG. IC2334.2 +051100 EXIT PROGRAM. IC2334.2 +051200 END PROGRAM IC233A-1. IC2334.2 +051300 END PROGRAM IC233A. IC2334.2 +*END-OF,IC233A +*HEADER,COBOL,IC234A +000100 IDENTIFICATION DIVISION. IC2344.2 +000200 PROGRAM-ID. IC2344.2 +000300 IC234A. IC2344.2 +000400**************************************************************** IC2344.2 +000500* * IC2344.2 +000600* VALIDATION FOR:- * IC2344.2 +000700* * IC2344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +000900* * IC2344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +001100* * IC2344.2 +001200**************************************************************** IC2344.2 +001300* * IC2344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +001500* * IC2344.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +001900* X-14 - TEST-FILE. * IC2344.2 +002000* * IC2344.2 +002100**************************************************************** IC2344.2 +002200* * IC2344.2 +002300* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +002400* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +002500* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +002600* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +002700* * IC2344.2 +002800* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +002900* COMPILER AS SHOWN BELOW: * IC2344.2 +003000* IDENTIFICATION DIVISION. * IC2344.2 +003100* PROGRAM-ID. IC234A. * IC2344.2 +003200* . * IC2344.2 +003300* . * IC2344.2 +003400* . * IC2344.2 +003500* IDENTIFICATION DIVISION. * IC2344.2 +003600* PROGRAM-ID. IC234A-1. * IC2344.2 +003700* . * IC2344.2 +003800* . * IC2344.2 +003900* IDENTIFICATION DIVISION. * IC2344.2 +004000* PROGRAM-ID. IC234A-2. * IC2344.2 +004100* . * IC2344.2 +004200* . * IC2344.2 +004300* . * IC2344.2 +004400* IDENTIFICATION DIVISION. * IC2344.2 +004500* PROGRAM-ID. IC234A-3. * IC2344.2 +004600* . * IC2344.2 +004700* . * IC2344.2 +004800* END PROGRAM IC234A-3. * IC2344.2 +004900* END PROGRAM IC234A-2. * IC2344.2 +005000* END PROGRAM IC234A-1. * IC2344.2 +005100* END PROGRAM IC234A. * IC2344.2 +005200**************************************************************** IC2344.2 +005300 ENVIRONMENT DIVISION. IC2344.2 +005400 CONFIGURATION SECTION. IC2344.2 +005500 SOURCE-COMPUTER. IC2344.2 +005600 XXXXX082. IC2344.2 +005700 OBJECT-COMPUTER. IC2344.2 +005800 XXXXX083. IC2344.2 +005900 INPUT-OUTPUT SECTION. IC2344.2 +006000 FILE-CONTROL. IC2344.2 +006100 SELECT PRINT-FILE ASSIGN TO IC2344.2 +006200 XXXXX055. IC2344.2 +006300 SELECT TEST-FILE ASSIGN TO IC2344.2 +006400 XXXXX014. IC2344.2 +006500 DATA DIVISION. IC2344.2 +006600 FILE SECTION. IC2344.2 +006700 FD PRINT-FILE. IC2344.2 +006800 01 PRINT-REC PIC X(120). IC2344.2 +006900 01 DUMMY-RECORD PIC X(120). IC2344.2 +007000 FD TEST-FILE GLOBAL. IC2344.2 +007100 01 TEST-RECORD PIC X(20). IC2344.2 +007200 WORKING-STORAGE SECTION. IC2344.2 +007300 01 DILFRAP GLOBAL PIC 9. IC2344.2 +007400 01 TEST-RESULTS. IC2344.2 +007500 02 FILLER PIC X VALUE SPACE. IC2344.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. IC2344.2 +007700 02 FILLER PIC X VALUE SPACE. IC2344.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. IC2344.2 +007900 02 FILLER PIC X VALUE SPACE. IC2344.2 +008000 02 PAR-NAME. IC2344.2 +008100 03 FILLER PIC X(19) VALUE SPACE. IC2344.2 +008200 03 PARDOT-X PIC X VALUE SPACE. IC2344.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. IC2344.2 +008400 02 FILLER PIC X(8) VALUE SPACE. IC2344.2 +008500 02 RE-MARK PIC X(61). IC2344.2 +008600 01 TEST-COMPUTED. IC2344.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC2344.2 +008800 02 FILLER PIC X(17) VALUE IC2344.2 +008900 " COMPUTED=". IC2344.2 +009000 02 COMPUTED-X. IC2344.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2344.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A IC2344.2 +009300 PIC -9(9).9(9). IC2344.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2344.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2344.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2344.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. IC2344.2 +009800 04 COMPUTED-18V0 PIC -9(18). IC2344.2 +009900 04 FILLER PIC X. IC2344.2 +010000 03 FILLER PIC X(50) VALUE SPACE. IC2344.2 +010100 01 TEST-CORRECT. IC2344.2 +010200 02 FILLER PIC X(30) VALUE SPACE. IC2344.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2344.2 +010400 02 CORRECT-X. IC2344.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2344.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2344.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2344.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2344.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2344.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. IC2344.2 +011100 04 CORRECT-18V0 PIC -9(18). IC2344.2 +011200 04 FILLER PIC X. IC2344.2 +011300 03 FILLER PIC X(2) VALUE SPACE. IC2344.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2344.2 +011500 01 CCVS-C-1. IC2344.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2344.2 +011700- "SS PARAGRAPH-NAME IC2344.2 +011800- " REMARKS". IC2344.2 +011900 02 FILLER PIC X(20) VALUE SPACE. IC2344.2 +012000 01 CCVS-C-2. IC2344.2 +012100 02 FILLER PIC X VALUE SPACE. IC2344.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". IC2344.2 +012300 02 FILLER PIC X(15) VALUE SPACE. IC2344.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". IC2344.2 +012500 02 FILLER PIC X(94) VALUE SPACE. IC2344.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2344.2 +012700 01 REC-CT PIC 99 VALUE ZERO. IC2344.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2344.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2344.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2344.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2344.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2344.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2344.2 +013700 01 CCVS-H-1. IC2344.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IC2344.2 +013900 02 FILLER PIC X(42) VALUE IC2344.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2344.2 +014100 02 FILLER PIC X(39) VALUE SPACES. IC2344.2 +014200 01 CCVS-H-2A. IC2344.2 +014300 02 FILLER PIC X(40) VALUE SPACE. IC2344.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2344.2 +014500 02 FILLER PIC XXXX VALUE IC2344.2 +014600 "4.2 ". IC2344.2 +014700 02 FILLER PIC X(28) VALUE IC2344.2 +014800 " COPY - NOT FOR DISTRIBUTION". IC2344.2 +014900 02 FILLER PIC X(41) VALUE SPACE. IC2344.2 +015000 IC2344.2 +015100 01 CCVS-H-2B. IC2344.2 +015200 02 FILLER PIC X(15) VALUE IC2344.2 +015300 "TEST RESULT OF ". IC2344.2 +015400 02 TEST-ID PIC X(9). IC2344.2 +015500 02 FILLER PIC X(4) VALUE IC2344.2 +015600 " IN ". IC2344.2 +015700 02 FILLER PIC X(12) VALUE IC2344.2 +015800 " HIGH ". IC2344.2 +015900 02 FILLER PIC X(22) VALUE IC2344.2 +016000 " LEVEL VALIDATION FOR ". IC2344.2 +016100 02 FILLER PIC X(58) VALUE IC2344.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +016300 01 CCVS-H-3. IC2344.2 +016400 02 FILLER PIC X(34) VALUE IC2344.2 +016500 " FOR OFFICIAL USE ONLY ". IC2344.2 +016600 02 FILLER PIC X(58) VALUE IC2344.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +016800 02 FILLER PIC X(28) VALUE IC2344.2 +016900 " COPYRIGHT 1985 ". IC2344.2 +017000 01 CCVS-E-1. IC2344.2 +017100 02 FILLER PIC X(52) VALUE SPACE. IC2344.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2344.2 +017300 02 ID-AGAIN PIC X(9). IC2344.2 +017400 02 FILLER PIC X(45) VALUE SPACES. IC2344.2 +017500 01 CCVS-E-2. IC2344.2 +017600 02 FILLER PIC X(31) VALUE SPACE. IC2344.2 +017700 02 FILLER PIC X(21) VALUE SPACE. IC2344.2 +017800 02 CCVS-E-2-2. IC2344.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2344.2 +018000 03 FILLER PIC X VALUE SPACE. IC2344.2 +018100 03 ENDER-DESC PIC X(44) VALUE IC2344.2 +018200 "ERRORS ENCOUNTERED". IC2344.2 +018300 01 CCVS-E-3. IC2344.2 +018400 02 FILLER PIC X(22) VALUE IC2344.2 +018500 " FOR OFFICIAL USE ONLY". IC2344.2 +018600 02 FILLER PIC X(12) VALUE SPACE. IC2344.2 +018700 02 FILLER PIC X(58) VALUE IC2344.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +018900 02 FILLER PIC X(13) VALUE SPACE. IC2344.2 +019000 02 FILLER PIC X(15) VALUE IC2344.2 +019100 " COPYRIGHT 1985". IC2344.2 +019200 01 CCVS-E-4. IC2344.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2344.2 +019400 02 FILLER PIC X(4) VALUE " OF ". IC2344.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2344.2 +019600 02 FILLER PIC X(40) VALUE IC2344.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2344.2 +019800 01 XXINFO. IC2344.2 +019900 02 FILLER PIC X(19) VALUE IC2344.2 +020000 "*** INFORMATION ***". IC2344.2 +020100 02 INFO-TEXT. IC2344.2 +020200 04 FILLER PIC X(8) VALUE SPACE. IC2344.2 +020300 04 XXCOMPUTED PIC X(20). IC2344.2 +020400 04 FILLER PIC X(5) VALUE SPACE. IC2344.2 +020500 04 XXCORRECT PIC X(20). IC2344.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). IC2344.2 +020700 01 HYPHEN-LINE. IC2344.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. IC2344.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************IC2344.2 +021000- "*****************************************". IC2344.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************IC2344.2 +021200- "******************************". IC2344.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE IC2344.2 +021400 "IC234A". IC2344.2 +021500 PROCEDURE DIVISION. IC2344.2 +021600 DECLARATIVES. IC2344.2 +021700 SECT-IC234A-001 SECTION. IC2344.2 +021800 USE GLOBAL AFTER ERROR PROCEDURE ON INPUT. IC2344.2 +021900 USE-TEST-2. IC2344.2 +022000 ADD 1 TO DILFRAP. IC2344.2 +022100 END DECLARATIVES. IC2344.2 +022200 CCVS1 SECTION. IC2344.2 +022300 OPEN-FILES. IC2344.2 +022400 OPEN OUTPUT PRINT-FILE. IC2344.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2344.2 +022600 MOVE SPACE TO TEST-RESULTS. IC2344.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2344.2 +022800 GO TO CCVS1-EXIT. IC2344.2 +022900 CLOSE-FILES. IC2344.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2344.2 +023100 TERMINATE-CCVS. IC2344.2 +023200S EXIT PROGRAM. IC2344.2 +023300STERMINATE-CALL. IC2344.2 +023400 STOP RUN. IC2344.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2344.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2344.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2344.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2344.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IC2344.2 +024000 PRINT-DETAIL. IC2344.2 +024100 IF REC-CT NOT EQUAL TO ZERO IC2344.2 +024200 MOVE "." TO PARDOT-X IC2344.2 +024300 MOVE REC-CT TO DOTVALUE. IC2344.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2344.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2344.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2344.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2344.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2344.2 +024900 MOVE SPACE TO CORRECT-X. IC2344.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2344.2 +025100 MOVE SPACE TO RE-MARK. IC2344.2 +025200 HEAD-ROUTINE. IC2344.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2344.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2344.2 +025700 COLUMN-NAMES-ROUTINE. IC2344.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +026100 END-ROUTINE. IC2344.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2344.2 +026300 END-RTN-EXIT. IC2344.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +026500 END-ROUTINE-1. IC2344.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2344.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2344.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IC2344.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2344.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2344.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2344.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2344.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2344.2 +027400 END-ROUTINE-12. IC2344.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2344.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IC2344.2 +027700 MOVE "NO " TO ERROR-TOTAL IC2344.2 +027800 ELSE IC2344.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2344.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2344.2 +028100 PERFORM WRITE-LINE. IC2344.2 +028200 END-ROUTINE-13. IC2344.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IC2344.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IC2344.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2344.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2344.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IC2344.2 +028900 MOVE "NO " TO ERROR-TOTAL IC2344.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2344.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2344.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +029400 WRITE-LINE. IC2344.2 +029500 ADD 1 TO RECORD-COUNT. IC2344.2 +029600Y IF RECORD-COUNT GREATER 50 IC2344.2 +029700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2344.2 +029800Y MOVE SPACE TO DUMMY-RECORD IC2344.2 +029900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2344.2 +030000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2344.2 +030100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2344.2 +030200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2344.2 +030300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2344.2 +030400Y MOVE ZERO TO RECORD-COUNT. IC2344.2 +030500 PERFORM WRT-LN. IC2344.2 +030600 WRT-LN. IC2344.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2344.2 +030800 MOVE SPACE TO DUMMY-RECORD. IC2344.2 +030900 BLANK-LINE-PRINT. IC2344.2 +031000 PERFORM WRT-LN. IC2344.2 +031100 FAIL-ROUTINE. IC2344.2 +031200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2344.2 +031300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2344.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2344.2 +031500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2344.2 +031600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +031700 MOVE SPACES TO INF-ANSI-REFERENCE. IC2344.2 +031800 GO TO FAIL-ROUTINE-EX. IC2344.2 +031900 FAIL-ROUTINE-WRITE. IC2344.2 +032000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2344.2 +032100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2344.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2344.2 +032300 MOVE SPACES TO COR-ANSI-REFERENCE. IC2344.2 +032400 FAIL-ROUTINE-EX. EXIT. IC2344.2 +032500 BAIL-OUT. IC2344.2 +032600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2344.2 +032700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2344.2 +032800 BAIL-OUT-WRITE. IC2344.2 +032900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2344.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2344.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IC2344.2 +033300 BAIL-OUT-EX. EXIT. IC2344.2 +033400 CCVS1-EXIT. IC2344.2 +033500 EXIT. IC2344.2 +033600 SECT-IC234A-1R-001 SECTION. IC2344.2 +033700 USE-INIT-1. IC2344.2 +033800 OPEN OUTPUT TEST-FILE. IC2344.2 +033900 CLOSE TEST-FILE. IC2344.2 +034000 MOVE 1 TO REC-CT. IC2344.2 +034100 MOVE "USE GLOBAL INPUT" TO FEATURE. IC2344.2 +034200 MOVE "USE-TEST-1" TO PAR-NAME. IC2344.2 +034300 MOVE "X-34 5.5.4 GR(1)C" TO ANSI-REFERENCE. IC2344.2 +034400 MOVE ZERO TO DILFRAP. IC2344.2 +034500 USE-TEST-0. IC2344.2 +034600 CALL "IC234A-1". IC2344.2 +034700 IF DILFRAP = 1 IC2344.2 +034800 PERFORM PASS IC2344.2 +034900 GO TO USE-WRITE-1. IC2344.2 +035000 USE-FAIL-1. IC2344.2 +035100 MOVE 1 TO CORRECT-N. IC2344.2 +035200 MOVE DILFRAP TO COMPUTED-N. IC2344.2 +035300 IF DILFRAP = 0 IC2344.2 +035400 MOVE "USE PROCEDURE NOT INVOKED" TO RE-MARK IC2344.2 +035500 ELSE MOVE "WRONG 'USE' PROCEDURE INVOKED" TO RE-MARK. IC2344.2 +035600 PERFORM FAIL. IC2344.2 +035700 GO TO USE-WRITE-1. IC2344.2 +035800 USE-DELETE-1. IC2344.2 +035900 PERFORM DE-LETE. IC2344.2 +036000 USE-WRITE-1. IC2344.2 +036100 PERFORM PRINT-DETAIL. IC2344.2 +036200* IC2344.2 +036300 CCVS-EXIT SECTION. IC2344.2 +036400 CCVS-999999. IC2344.2 +036500 GO TO CLOSE-FILES. IC2344.2 +036600* IC2344.2 +036700 IDENTIFICATION DIVISION. IC2344.2 +036800 PROGRAM-ID. IC2344.2 +036900 IC234A-1. IC2344.2 +037000**************************************************************** IC2344.2 +037100* * IC2344.2 +037200* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +037300* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +037400* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +037500* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +037600* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +037700* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +037800* * IC2344.2 +037900* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +038000* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +038100* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +038200* * IC2344.2 +038300* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +038400* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +038500* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +038600* * IC2344.2 +038700* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +038800* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +038900* & INFORMATION TECHNOLOGY * IC2344.2 +039000* TWO SKYLINE PLACE * IC2344.2 +039100* SUITE 1100 * IC2344.2 +039200* 5203 LEESBURG PIKE * IC2344.2 +039300* FALLS CHURCH * IC2344.2 +039400* VA 22041 * IC2344.2 +039500* U.S.A. * IC2344.2 +039600* * IC2344.2 +039700* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +039800* * IC2344.2 +039900* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +040000* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +040100* 21 RUE BARA * IC2344.2 +040200* F-92132 ISSY * IC2344.2 +040300* FRANCE * IC2344.2 +040400* * IC2344.2 +040500* * IC2344.2 +040600* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +040700* UND DATENVERARBEITUNG MBH) * IC2344.2 +040800* SCHLOSS BIRLINGHOVEN * IC2344.2 +040900* POSTFACH 12 40 * IC2344.2 +041000* D-5205 ST. AUGUSTIN 1 * IC2344.2 +041100* GERMANY FR * IC2344.2 +041200* * IC2344.2 +041300* * IC2344.2 +041400* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +041500* OXFORD ROAD * IC2344.2 +041600* MANCHESTER * IC2344.2 +041700* M1 7ED * IC2344.2 +041800* UNITED KINGDOM * IC2344.2 +041900* * IC2344.2 +042000* * IC2344.2 +042100* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +042200* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +042300* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +042400* * IC2344.2 +042500**************************************************************** IC2344.2 +042600* * IC2344.2 +042700* VALIDATION FOR:- * IC2344.2 +042800* * IC2344.2 +042900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +043000* * IC2344.2 +043100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +043200* * IC2344.2 +043300**************************************************************** IC2344.2 +043400* * IC2344.2 +043500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +043600* * IC2344.2 +043700* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +043800* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +043900* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +044000* * IC2344.2 +044100**************************************************************** IC2344.2 +044200* * IC2344.2 +044300* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +044400* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +044500* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +044600* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +044700* * IC2344.2 +044800* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +044900* COMPILER AS SHOWN BELOW: * IC2344.2 +045000* IDENTIFICATION DIVISION. * IC2344.2 +045100* PROGRAM-ID. IC234A. * IC2344.2 +045200* . * IC2344.2 +045300* . * IC2344.2 +045400* . * IC2344.2 +045500* IDENTIFICATION DIVISION. * IC2344.2 +045600* PROGRAM-ID. IC234A-1. * IC2344.2 +045700* . * IC2344.2 +045800* . * IC2344.2 +045900* IDENTIFICATION DIVISION. * IC2344.2 +046000* PROGRAM-ID. IC234A-2. * IC2344.2 +046100* . * IC2344.2 +046200* . * IC2344.2 +046300* . * IC2344.2 +046400* IDENTIFICATION DIVISION. * IC2344.2 +046500* PROGRAM-ID. IC234A-3. * IC2344.2 +046600* . * IC2344.2 +046700* . * IC2344.2 +046800* END PROGRAM IC234A-3. * IC2344.2 +046900* END PROGRAM IC234A-2. * IC2344.2 +047000* END PROGRAM IC234A-1. * IC2344.2 +047100* END PROGRAM IC234A. * IC2344.2 +047200**************************************************************** IC2344.2 +047300*ENVIRONMENT DIVISION. IC2344.2 +047400*INPUT-OUTPUT SECTION. IC2344.2 +047500*FILE-CONTROL. IC2344.2 +047600 DATA DIVISION. IC2344.2 +047700 FILE SECTION. IC2344.2 +047800 WORKING-STORAGE SECTION. IC2344.2 +047900 PROCEDURE DIVISION. IC2344.2 +048000 DECLARATIVES. IC2344.2 +048100 NON-GLOBAL-SECTION SECTION. IC2344.2 +048200 USE AFTER STANDARD EXCEPTION PROCEDURE ON TEST-FILE. IC2344.2 +048300 USE-PARA. IC2344.2 +048400 ADD 2 TO DILFRAP. IC2344.2 +048500 END DECLARATIVES. IC2344.2 +048600 SECT-IC234A-1-001 SECTION. IC2344.2 +048700 USE-INIT-1. IC2344.2 +048800 CALL "IC234A-2". IC2344.2 +048900 EXIT PROGRAM. IC2344.2 +049000* IC2344.2 +049100 IDENTIFICATION DIVISION. IC2344.2 +049200 PROGRAM-ID. IC2344.2 +049300 IC234A-2. IC2344.2 +049400**************************************************************** IC2344.2 +049500* * IC2344.2 +049600* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +049700* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +049800* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +049900* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +050000* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +050100* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +050200* * IC2344.2 +050300* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +050400* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +050500* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +050600* * IC2344.2 +050700* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +050800* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +050900* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +051000* * IC2344.2 +051100* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +051200* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +051300* & INFORMATION TECHNOLOGY * IC2344.2 +051400* TWO SKYLINE PLACE * IC2344.2 +051500* SUITE 1100 * IC2344.2 +051600* 5203 LEESBURG PIKE * IC2344.2 +051700* FALLS CHURCH * IC2344.2 +051800* VA 22041 * IC2344.2 +051900* U.S.A. * IC2344.2 +052000* * IC2344.2 +052100* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +052200* * IC2344.2 +052300* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +052400* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +052500* 21 RUE BARA * IC2344.2 +052600* F-92132 ISSY * IC2344.2 +052700* FRANCE * IC2344.2 +052800* * IC2344.2 +052900* * IC2344.2 +053000* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +053100* UND DATENVERARBEITUNG MBH) * IC2344.2 +053200* SCHLOSS BIRLINGHOVEN * IC2344.2 +053300* POSTFACH 12 40 * IC2344.2 +053400* D-5205 ST. AUGUSTIN 1 * IC2344.2 +053500* GERMANY FR * IC2344.2 +053600* * IC2344.2 +053700* * IC2344.2 +053800* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +053900* OXFORD ROAD * IC2344.2 +054000* MANCHESTER * IC2344.2 +054100* M1 7ED * IC2344.2 +054200* UNITED KINGDOM * IC2344.2 +054300* * IC2344.2 +054400* * IC2344.2 +054500* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +054600* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +054700* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +054800* * IC2344.2 +054900**************************************************************** IC2344.2 +055000* * IC2344.2 +055100* VALIDATION FOR:- * IC2344.2 +055200* * IC2344.2 +055300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +055400* * IC2344.2 +055500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +055600* * IC2344.2 +055700**************************************************************** IC2344.2 +055800* * IC2344.2 +055900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +056000* * IC2344.2 +056100* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +056200* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +056300* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +056400* * IC2344.2 +056500**************************************************************** IC2344.2 +056600* * IC2344.2 +056700* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +056800* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +056900* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +057000* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +057100* * IC2344.2 +057200* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +057300* COMPILER AS SHOWN BELOW: * IC2344.2 +057400* IDENTIFICATION DIVISION. * IC2344.2 +057500* PROGRAM-ID. IC234A. * IC2344.2 +057600* . * IC2344.2 +057700* . * IC2344.2 +057800* . * IC2344.2 +057900* IDENTIFICATION DIVISION. * IC2344.2 +058000* PROGRAM-ID. IC234A-1. * IC2344.2 +058100* . * IC2344.2 +058200* . * IC2344.2 +058300* IDENTIFICATION DIVISION. * IC2344.2 +058400* PROGRAM-ID. IC234A-2. * IC2344.2 +058500* . * IC2344.2 +058600* . * IC2344.2 +058700* . * IC2344.2 +058800* IDENTIFICATION DIVISION. * IC2344.2 +058900* PROGRAM-ID. IC234A-3. * IC2344.2 +059000* . * IC2344.2 +059100* . * IC2344.2 +059200* END PROGRAM IC234A-3. * IC2344.2 +059300* END PROGRAM IC234A-2. * IC2344.2 +059400* END PROGRAM IC234A-1. * IC2344.2 +059500* END PROGRAM IC234A. * IC2344.2 +059600**************************************************************** IC2344.2 +059700*ENVIRONMENT DIVISION. IC2344.2 +059800*INPUT-OUTPUT SECTION. IC2344.2 +059900*FILE-CONTROL. IC2344.2 +060000 DATA DIVISION. IC2344.2 +060100 FILE SECTION. IC2344.2 +060200 WORKING-STORAGE SECTION. IC2344.2 +060300 PROCEDURE DIVISION. IC2344.2 +060400 DECLARATIVES. IC2344.2 +060500 USE-TEST SECTION. IC2344.2 +060600 USE GLOBAL AFTER ERROR PROCEDURE ON OUTPUT. IC2344.2 +060700 USE-TEST-1. IC2344.2 +060800 ADD 4 TO DILFRAP. IC2344.2 +060900 END DECLARATIVES. IC2344.2 +061000 SECT-IC234A-2-001 SECTION. IC2344.2 +061100 USE-INIT-1. IC2344.2 +061200 CALL "IC234A-3". IC2344.2 +061300 EXIT PROGRAM. IC2344.2 +061400* IC2344.2 +061500 IDENTIFICATION DIVISION. IC2344.2 +061600 PROGRAM-ID. IC2344.2 +061700 IC234A-3. IC2344.2 +061800**************************************************************** IC2344.2 +061900* * IC2344.2 +062000* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +062100* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +062200* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +062300* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +062400* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +062500* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +062600* * IC2344.2 +062700* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +062800* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +062900* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +063000* * IC2344.2 +063100* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +063200* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +063300* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +063400* * IC2344.2 +063500* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +063600* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +063700* & INFORMATION TECHNOLOGY * IC2344.2 +063800* TWO SKYLINE PLACE * IC2344.2 +063900* SUITE 1100 * IC2344.2 +064000* 5203 LEESBURG PIKE * IC2344.2 +064100* FALLS CHURCH * IC2344.2 +064200* VA 22041 * IC2344.2 +064300* U.S.A. * IC2344.2 +064400* * IC2344.2 +064500* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +064600* * IC2344.2 +064700* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +064800* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +064900* 21 RUE BARA * IC2344.2 +065000* F-92132 ISSY * IC2344.2 +065100* FRANCE * IC2344.2 +065200* * IC2344.2 +065300* * IC2344.2 +065400* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +065500* UND DATENVERARBEITUNG MBH) * IC2344.2 +065600* SCHLOSS BIRLINGHOVEN * IC2344.2 +065700* POSTFACH 12 40 * IC2344.2 +065800* D-5205 ST. AUGUSTIN 1 * IC2344.2 +065900* GERMANY FR * IC2344.2 +066000* * IC2344.2 +066100* * IC2344.2 +066200* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +066300* OXFORD ROAD * IC2344.2 +066400* MANCHESTER * IC2344.2 +066500* M1 7ED * IC2344.2 +066600* UNITED KINGDOM * IC2344.2 +066700* * IC2344.2 +066800* * IC2344.2 +066900* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +067000* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +067100* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +067200* * IC2344.2 +067300**************************************************************** IC2344.2 +067400* * IC2344.2 +067500* VALIDATION FOR:- * IC2344.2 +067600* * IC2344.2 +067700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +067800* * IC2344.2 +067900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +068000* * IC2344.2 +068100**************************************************************** IC2344.2 +068200* * IC2344.2 +068300* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +068400* * IC2344.2 +068500* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +068600* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +068700* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +068800* * IC2344.2 +068900**************************************************************** IC2344.2 +069000* * IC2344.2 +069100* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +069200* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +069300* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +069400* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +069500* * IC2344.2 +069600* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +069700* COMPILER AS SHOWN BELOW: * IC2344.2 +069800* IDENTIFICATION DIVISION. * IC2344.2 +069900* PROGRAM-ID. IC234A. * IC2344.2 +070000* . * IC2344.2 +070100* . * IC2344.2 +070200* . * IC2344.2 +070300* IDENTIFICATION DIVISION. * IC2344.2 +070400* PROGRAM-ID. IC234A-1. * IC2344.2 +070500* . * IC2344.2 +070600* . * IC2344.2 +070700* IDENTIFICATION DIVISION. * IC2344.2 +070800* PROGRAM-ID. IC234A-2. * IC2344.2 +070900* . * IC2344.2 +071000* . * IC2344.2 +071100* . * IC2344.2 +071200* IDENTIFICATION DIVISION. * IC2344.2 +071300* PROGRAM-ID. IC234A-3. * IC2344.2 +071400* . * IC2344.2 +071500* . * IC2344.2 +071600* END PROGRAM IC234A-3. * IC2344.2 +071700* END PROGRAM IC234A-2. * IC2344.2 +071800* END PROGRAM IC234A-1. * IC2344.2 +071900* END PROGRAM IC234A. * IC2344.2 +072000**************************************************************** IC2344.2 +072100*ENVIRONMENT DIVISION. IC2344.2 +072200*INPUT-OUTPUT SECTION. IC2344.2 +072300*FILE-CONTROL. IC2344.2 +072400 DATA DIVISION. IC2344.2 +072500 FILE SECTION. IC2344.2 +072600 WORKING-STORAGE SECTION. IC2344.2 +072700 PROCEDURE DIVISION. IC2344.2 +072800 SECT-IC234A-3-001 SECTION. IC2344.2 +072900 USE-INIT-1. IC2344.2 +073000 OPEN INPUT TEST-FILE. IC2344.2 +073100 READ TEST-FILE. IC2344.2 +073200 EXIT PROGRAM. IC2344.2 +073300* IC2344.2 +073400 END PROGRAM IC234A-3. IC2344.2 +073500 END PROGRAM IC234A-2. IC2344.2 +073600 END PROGRAM IC234A-1. IC2344.2 +073700 END PROGRAM IC234A. IC2344.2 +*END-OF,IC234A +*HEADER,COBOL,IC235A +000100 IDENTIFICATION DIVISION. IC2354.2 +000200 PROGRAM-ID. IC2354.2 +000300 IC235A. IC2354.2 +000400**************************************************************** IC2354.2 +000500* * IC2354.2 +000600* VALIDATION FOR:- * IC2354.2 +000700* * IC2354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +000900* * IC2354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +001100* * IC2354.2 +001200**************************************************************** IC2354.2 +001300* * IC2354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +001500* * IC2354.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +001900* * IC2354.2 +002000**************************************************************** IC2354.2 +002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC2354.2 +002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC2354.2 +002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC2354.2 +002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC2354.2 +002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC2354.2 +002600* ARE IDENTICAL. IC2354.2 +002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC2354.2 +002800* THAN ONE EXIT PROGRAM STATEMENT. IC2354.2 +002900* REFERENCE: AMERICAN NATIONAL STANDARD IC2354.2 +003000* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IC2354.2 +003100 ENVIRONMENT DIVISION. IC2354.2 +003200 CONFIGURATION SECTION. IC2354.2 +003300 SOURCE-COMPUTER. IC2354.2 +003400 XXXXX082. IC2354.2 +003500 OBJECT-COMPUTER. IC2354.2 +003600 XXXXX083. IC2354.2 +003700 INPUT-OUTPUT SECTION. IC2354.2 +003800 FILE-CONTROL. IC2354.2 +003900 SELECT PRINT-FILE ASSIGN TO IC2354.2 +004000 XXXXX055. IC2354.2 +004100 DATA DIVISION. IC2354.2 +004200 FILE SECTION. IC2354.2 +004300 FD PRINT-FILE. IC2354.2 +004400 01 PRINT-REC PICTURE X(120). IC2354.2 +004500 01 DUMMY-RECORD PICTURE X(120). IC2354.2 +004600 WORKING-STORAGE SECTION. IC2354.2 +004700 77 MAIN-DN1 PICTURE 999. IC2354.2 +004800 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC2354.2 +004900 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC2354.2 +005000 01 GROUP-01. IC2354.2 +005100 02 ALPHA-NUM-FIELD PIC X(8). IC2354.2 +005200 02 GROUP-LEV2. IC2354.2 +005300 03 NUMER-FIELD PIC 99. IC2354.2 +005400 03 ALPHA-FIELD PIC A(3). IC2354.2 +005500 01 GROUP-02. IC2354.2 +005600 02 NUM-ITEM PIC S99. IC2354.2 +005700 02 ALPHA-EDITED PICTURE X(6). IC2354.2 +005800 01 GROUP-03. IC2354.2 +005900 02 ALPHA-NUM-FIELD-3 PIC X(5). IC2354.2 +006000 02 GROUP-LEV2-3. IC2354.2 +006100 03 NUMER-FIELD-3 PIC 99. IC2354.2 +006200 03 ALPHA-FIELD-3 PIC A(3). IC2354.2 +006300 01 GROUP-04. IC2354.2 +006400 03 FILLER PIC XX. IC2354.2 +006500 03 ELEM-NON-01 PIC XX. IC2354.2 +006600 01 FILLER. IC2354.2 +006700 03 SUBSCRIPTED-DATA OCCURS 10 IC2354.2 +006800 PIC XX. IC2354.2 +006900 01 TEST-RESULTS. IC2354.2 +007000 02 FILLER PIC X VALUE SPACE. IC2354.2 +007100 02 FEATURE PIC X(20) VALUE SPACE. IC2354.2 +007200 02 FILLER PIC X VALUE SPACE. IC2354.2 +007300 02 P-OR-F PIC X(5) VALUE SPACE. IC2354.2 +007400 02 FILLER PIC X VALUE SPACE. IC2354.2 +007500 02 PAR-NAME. IC2354.2 +007600 03 FILLER PIC X(19) VALUE SPACE. IC2354.2 +007700 03 PARDOT-X PIC X VALUE SPACE. IC2354.2 +007800 03 DOTVALUE PIC 99 VALUE ZERO. IC2354.2 +007900 02 FILLER PIC X(8) VALUE SPACE. IC2354.2 +008000 02 RE-MARK PIC X(61). IC2354.2 +008100 01 TEST-COMPUTED. IC2354.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC2354.2 +008300 02 FILLER PIC X(17) VALUE IC2354.2 +008400 " COMPUTED=". IC2354.2 +008500 02 COMPUTED-X. IC2354.2 +008600 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2354.2 +008700 03 COMPUTED-N REDEFINES COMPUTED-A IC2354.2 +008800 PIC -9(9).9(9). IC2354.2 +008900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2354.2 +009000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2354.2 +009100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2354.2 +009200 03 CM-18V0 REDEFINES COMPUTED-A. IC2354.2 +009300 04 COMPUTED-18V0 PIC -9(18). IC2354.2 +009400 04 FILLER PIC X. IC2354.2 +009500 03 FILLER PIC X(50) VALUE SPACE. IC2354.2 +009600 01 TEST-CORRECT. IC2354.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IC2354.2 +009800 02 FILLER PIC X(17) VALUE " CORRECT =". IC2354.2 +009900 02 CORRECT-X. IC2354.2 +010000 03 CORRECT-A PIC X(20) VALUE SPACE. IC2354.2 +010100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2354.2 +010200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2354.2 +010300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2354.2 +010400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2354.2 +010500 03 CR-18V0 REDEFINES CORRECT-A. IC2354.2 +010600 04 CORRECT-18V0 PIC -9(18). IC2354.2 +010700 04 FILLER PIC X. IC2354.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IC2354.2 +010900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2354.2 +011000 01 CCVS-C-1. IC2354.2 +011100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2354.2 +011200- "SS PARAGRAPH-NAME IC2354.2 +011300- " REMARKS". IC2354.2 +011400 02 FILLER PIC X(20) VALUE SPACE. IC2354.2 +011500 01 CCVS-C-2. IC2354.2 +011600 02 FILLER PIC X VALUE SPACE. IC2354.2 +011700 02 FILLER PIC X(6) VALUE "TESTED". IC2354.2 +011800 02 FILLER PIC X(15) VALUE SPACE. IC2354.2 +011900 02 FILLER PIC X(4) VALUE "FAIL". IC2354.2 +012000 02 FILLER PIC X(94) VALUE SPACE. IC2354.2 +012100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2354.2 +012200 01 REC-CT PIC 99 VALUE ZERO. IC2354.2 +012300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012600 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2354.2 +012800 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2354.2 +012900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2354.2 +013000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2354.2 +013100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2354.2 +013200 01 CCVS-H-1. IC2354.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2354.2 +013400 02 FILLER PIC X(42) VALUE IC2354.2 +013500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2354.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IC2354.2 +013700 01 CCVS-H-2A. IC2354.2 +013800 02 FILLER PIC X(40) VALUE SPACE. IC2354.2 +013900 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2354.2 +014000 02 FILLER PIC XXXX VALUE IC2354.2 +014100 "4.2 ". IC2354.2 +014200 02 FILLER PIC X(28) VALUE IC2354.2 +014300 " COPY - NOT FOR DISTRIBUTION". IC2354.2 +014400 02 FILLER PIC X(41) VALUE SPACE. IC2354.2 +014500 IC2354.2 +014600 01 CCVS-H-2B. IC2354.2 +014700 02 FILLER PIC X(15) VALUE IC2354.2 +014800 "TEST RESULT OF ". IC2354.2 +014900 02 TEST-ID PIC X(9). IC2354.2 +015000 02 FILLER PIC X(4) VALUE IC2354.2 +015100 " IN ". IC2354.2 +015200 02 FILLER PIC X(12) VALUE IC2354.2 +015300 " HIGH ". IC2354.2 +015400 02 FILLER PIC X(22) VALUE IC2354.2 +015500 " LEVEL VALIDATION FOR ". IC2354.2 +015600 02 FILLER PIC X(58) VALUE IC2354.2 +015700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +015800 01 CCVS-H-3. IC2354.2 +015900 02 FILLER PIC X(34) VALUE IC2354.2 +016000 " FOR OFFICIAL USE ONLY ". IC2354.2 +016100 02 FILLER PIC X(58) VALUE IC2354.2 +016200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +016300 02 FILLER PIC X(28) VALUE IC2354.2 +016400 " COPYRIGHT 1985 ". IC2354.2 +016500 01 CCVS-E-1. IC2354.2 +016600 02 FILLER PIC X(52) VALUE SPACE. IC2354.2 +016700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2354.2 +016800 02 ID-AGAIN PIC X(9). IC2354.2 +016900 02 FILLER PIC X(45) VALUE SPACES. IC2354.2 +017000 01 CCVS-E-2. IC2354.2 +017100 02 FILLER PIC X(31) VALUE SPACE. IC2354.2 +017200 02 FILLER PIC X(21) VALUE SPACE. IC2354.2 +017300 02 CCVS-E-2-2. IC2354.2 +017400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2354.2 +017500 03 FILLER PIC X VALUE SPACE. IC2354.2 +017600 03 ENDER-DESC PIC X(44) VALUE IC2354.2 +017700 "ERRORS ENCOUNTERED". IC2354.2 +017800 01 CCVS-E-3. IC2354.2 +017900 02 FILLER PIC X(22) VALUE IC2354.2 +018000 " FOR OFFICIAL USE ONLY". IC2354.2 +018100 02 FILLER PIC X(12) VALUE SPACE. IC2354.2 +018200 02 FILLER PIC X(58) VALUE IC2354.2 +018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +018400 02 FILLER PIC X(13) VALUE SPACE. IC2354.2 +018500 02 FILLER PIC X(15) VALUE IC2354.2 +018600 " COPYRIGHT 1985". IC2354.2 +018700 01 CCVS-E-4. IC2354.2 +018800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2354.2 +018900 02 FILLER PIC X(4) VALUE " OF ". IC2354.2 +019000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2354.2 +019100 02 FILLER PIC X(40) VALUE IC2354.2 +019200 " TESTS WERE EXECUTED SUCCESSFULLY". IC2354.2 +019300 01 XXINFO. IC2354.2 +019400 02 FILLER PIC X(19) VALUE IC2354.2 +019500 "*** INFORMATION ***". IC2354.2 +019600 02 INFO-TEXT. IC2354.2 +019700 04 FILLER PIC X(8) VALUE SPACE. IC2354.2 +019800 04 XXCOMPUTED PIC X(20). IC2354.2 +019900 04 FILLER PIC X(5) VALUE SPACE. IC2354.2 +020000 04 XXCORRECT PIC X(20). IC2354.2 +020100 02 INF-ANSI-REFERENCE PIC X(48). IC2354.2 +020200 01 HYPHEN-LINE. IC2354.2 +020300 02 FILLER PIC IS X VALUE IS SPACE. IC2354.2 +020400 02 FILLER PIC IS X(65) VALUE IS "************************IC2354.2 +020500- "*****************************************". IC2354.2 +020600 02 FILLER PIC IS X(54) VALUE IS "************************IC2354.2 +020700- "******************************". IC2354.2 +020800 01 CCVS-PGM-ID PIC X(9) VALUE IC2354.2 +020900 "IC235A". IC2354.2 +021000 PROCEDURE DIVISION. IC2354.2 +021100 CCVS1 SECTION. IC2354.2 +021200 OPEN-FILES. IC2354.2 +021300 OPEN OUTPUT PRINT-FILE. IC2354.2 +021400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2354.2 +021500 MOVE SPACE TO TEST-RESULTS. IC2354.2 +021600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2354.2 +021700 GO TO CCVS1-EXIT. IC2354.2 +021800 CLOSE-FILES. IC2354.2 +021900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2354.2 +022000 TERMINATE-CCVS. IC2354.2 +022100S EXIT PROGRAM. IC2354.2 +022200STERMINATE-CALL. IC2354.2 +022300 STOP RUN. IC2354.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2354.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2354.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2354.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2354.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IC2354.2 +022900 PRINT-DETAIL. IC2354.2 +023000 IF REC-CT NOT EQUAL TO ZERO IC2354.2 +023100 MOVE "." TO PARDOT-X IC2354.2 +023200 MOVE REC-CT TO DOTVALUE. IC2354.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2354.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2354.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2354.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2354.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2354.2 +023800 MOVE SPACE TO CORRECT-X. IC2354.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2354.2 +024000 MOVE SPACE TO RE-MARK. IC2354.2 +024100 HEAD-ROUTINE. IC2354.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2 +024600 COLUMN-NAMES-ROUTINE. IC2354.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +025000 END-ROUTINE. IC2354.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2354.2 +025200 END-RTN-EXIT. IC2354.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +025400 END-ROUTINE-1. IC2354.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2354.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2354.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IC2354.2 +025800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2354.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2354.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2354.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2354.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2354.2 +026300 END-ROUTINE-12. IC2354.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2354.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO IC2354.2 +026600 MOVE "NO " TO ERROR-TOTAL IC2354.2 +026700 ELSE IC2354.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2354.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2354.2 +027000 PERFORM WRITE-LINE. IC2354.2 +027100 END-ROUTINE-13. IC2354.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO IC2354.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE IC2354.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2354.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2354.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO IC2354.2 +027800 MOVE "NO " TO ERROR-TOTAL IC2354.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2354.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2354.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +028300 WRITE-LINE. IC2354.2 +028400 ADD 1 TO RECORD-COUNT. IC2354.2 +028500Y IF RECORD-COUNT GREATER 50 IC2354.2 +028600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2354.2 +028700Y MOVE SPACE TO DUMMY-RECORD IC2354.2 +028800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2354.2 +028900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2354.2 +029000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2354.2 +029100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2354.2 +029200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2354.2 +029300Y MOVE ZERO TO RECORD-COUNT. IC2354.2 +029400 PERFORM WRT-LN. IC2354.2 +029500 WRT-LN. IC2354.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2354.2 +029700 MOVE SPACE TO DUMMY-RECORD. IC2354.2 +029800 BLANK-LINE-PRINT. IC2354.2 +029900 PERFORM WRT-LN. IC2354.2 +030000 FAIL-ROUTINE. IC2354.2 +030100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2354.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2354.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2354.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2 +030700 GO TO FAIL-ROUTINE-EX. IC2354.2 +030800 FAIL-ROUTINE-WRITE. IC2354.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2354.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2354.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2354.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. IC2354.2 +031300 FAIL-ROUTINE-EX. EXIT. IC2354.2 +031400 BAIL-OUT. IC2354.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2354.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2354.2 +031700 BAIL-OUT-WRITE. IC2354.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2354.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2 +032200 BAIL-OUT-EX. EXIT. IC2354.2 +032300 CCVS1-EXIT. IC2354.2 +032400 EXIT. IC2354.2 +032500 SECT-IC235-0001 SECTION. IC2354.2 +032600* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC2354.2 +032700* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC2354.2 +032800* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC2354.2 +032900 EXIT-INIT. IC2354.2 +033000 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC2354.2 +033100 EXIT-INIT-001. IC2354.2 +033200 MOVE 0 TO MAIN-DN2. IC2354.2 +033300 MOVE 1 TO MAIN-DN1. IC2354.2 +033400 EXIT-TEST-001. IC2354.2 +033500 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +033600 IF MAIN-DN2 EQUAL TO 1 IC2354.2 +033700 PERFORM PASS IC2354.2 +033800 GO TO EXIT-WRITE-001. IC2354.2 +033900 EXIT-FAIL-001. IC2354.2 +034000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +034100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +034200 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +034300 PERFORM FAIL. IC2354.2 +034400 EXIT-WRITE-001. IC2354.2 +034500 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2 +034600 PERFORM PRINT-DETAIL. IC2354.2 +034700 EXIT-INIT-002. IC2354.2 +034800 MOVE 0 TO MAIN-DN2. IC2354.2 +034900 MOVE 2 TO MAIN-DN1. IC2354.2 +035000 EXIT-TEST-002. IC2354.2 +035100 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +035200 IF MAIN-DN2 EQUAL TO 2 IC2354.2 +035300 PERFORM PASS IC2354.2 +035400 GO TO EXIT-WRITE-002. IC2354.2 +035500 EXIT-FAIL-002. IC2354.2 +035600 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +035700 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +035800 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +035900 PERFORM FAIL. IC2354.2 +036000 EXIT-WRITE-002. IC2354.2 +036100 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2 +036200 PERFORM PRINT-DETAIL. IC2354.2 +036300 EXIT-INIT-003. IC2354.2 +036400 MOVE 0 TO MAIN-DN2. IC2354.2 +036500 MOVE 3 TO MAIN-DN1. IC2354.2 +036600 EXIT-TEST-003. IC2354.2 +036700 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +036800 IF MAIN-DN2 NOT EQUAL TO 3 IC2354.2 +036900 GO TO EXIT-FAIL-003. IC2354.2 +037000 PERFORM PASS. IC2354.2 +037100 GO TO EXIT-WRITE-003. IC2354.2 +037200 EXIT-FAIL-003. IC2354.2 +037300 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +037400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +037500 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +037600 PERFORM FAIL. IC2354.2 +037700 EXIT-WRITE-003. IC2354.2 +037800 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2 +037900 PERFORM PRINT-DETAIL. IC2354.2 +038000 EXIT-INIT-004. IC2354.2 +038100 MOVE 0 TO MAIN-DN2. IC2354.2 +038200 MOVE 4 TO MAIN-DN1. IC2354.2 +038300 EXIT-TEST-004. IC2354.2 +038400 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +038500 IF MAIN-DN2 NOT EQUAL TO 4 IC2354.2 +038600 GO TO EXIT-FAIL-004. IC2354.2 +038700 PERFORM PASS. IC2354.2 +038800 GO TO EXIT-WRITE-004. IC2354.2 +038900 EXIT-FAIL-004. IC2354.2 +039000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +039100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +039200 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +039300 PERFORM FAIL. IC2354.2 +039400 EXIT-WRITE-004. IC2354.2 +039500 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2 +039600 PERFORM PRINT-DETAIL. IC2354.2 +039700 GO TO SECT-IC235-0002. IC2354.2 +039800 EXIT-DELETES. IC2354.2 +039900* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC2354.2 +040000* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2 +040100* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC2354.2 +040200 PERFORM DE-LETE. IC2354.2 +040300 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2 +040400 PERFORM PRINT-DETAIL. IC2354.2 +040500 PERFORM DE-LETE. IC2354.2 +040600 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2 +040700 PERFORM PRINT-DETAIL. IC2354.2 +040800 PERFORM DE-LETE. IC2354.2 +040900 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2 +041000 PERFORM PRINT-DETAIL. IC2354.2 +041100 PERFORM DE-LETE. IC2354.2 +041200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2 +041300 PERFORM PRINT-DETAIL. IC2354.2 +041400 SECT-IC235-0002 SECTION. IC2354.2 +041500* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC2354.2 +041600* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC2354.2 +041700* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC2354.2 +041800* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC2354.2 +041900 CALL-INIT-06. IC2354.2 +042000 MOVE "CALL-TEST-06" TO PAR-NAME. IC2354.2 +042100 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC2354.2 +042200 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC2354.2 +042300 MOVE 11 TO ELEM-NON-01. IC2354.2 +042400 MOVE 99 TO SUBSCRIPTED-DATA (4). IC2354.2 +042500 MOVE "CALL USING DN SERIES" TO FEATURE. IC2354.2 +042600 CALL-TEST-06. IC2354.2 +042700 CALL "IC235A-1" USING GROUP-01 ELEM-77 GROUP-02 IC2354.2 +042800 ELEM-NON-01 SUBSCRIPTED-DATA (4). IC2354.2 +042900 GO TO CALL-TEST-06-01. IC2354.2 +043000 CALL-DELETE-06. IC2354.2 +043100 PERFORM DE-LETE. IC2354.2 +043200 PERFORM PRINT-DETAIL. IC2354.2 +043300 GO TO CCVS-EXIT. IC2354.2 +043400* IF IC235A-1 CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2 +043500* DELETE THE PARAGRAPH CALL-TEST-06. IC2354.2 +043600 CALL-TEST-06-01. IC2354.2 +043700 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC235A-1" IC2354.2 +043800 GO TO CALL-FAIL-06-01. IC2354.2 +043900 PERFORM PASS. IC2354.2 +044000 GO TO CALL-WRITE-06-01. IC2354.2 +044100 CALL-FAIL-06-01. IC2354.2 +044200 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC2354.2 +044300 MOVE "IC235A-1" TO CORRECT-A. IC2354.2 +044400 PERFORM FAIL. IC2354.2 +044500 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC2354.2 +044600 CALL-WRITE-06-01. IC2354.2 +044700 ADD 1 TO REC-CT. IC2354.2 +044800 PERFORM PRINT-DETAIL. IC2354.2 +044900 CALL-TEST-06-02. IC2354.2 +045000 IF NUMER-FIELD EQUAL TO 25 IC2354.2 +045100 PERFORM PASS IC2354.2 +045200 GO TO CALL-WRITE-06-02. IC2354.2 +045300 CALL-FAIL-06-02. IC2354.2 +045400 PERFORM FAIL. IC2354.2 +045500 MOVE NUMER-FIELD TO COMPUTED-18V0. IC2354.2 +045600 MOVE 25 TO CORRECT-18V0. IC2354.2 +045700 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC2354.2 +045800 CALL-WRITE-06-02. IC2354.2 +045900 ADD 1 TO REC-CT. IC2354.2 +046000 PERFORM PRINT-DETAIL. IC2354.2 +046100 CALL-TEST-06-03. IC2354.2 +046200 IF ALPHA-FIELD EQUAL TO "YES" IC2354.2 +046300 PERFORM PASS IC2354.2 +046400 GO TO CALL-WRITE-06-03. IC2354.2 +046500 CALL-FAIL-06-03. IC2354.2 +046600 PERFORM FAIL. IC2354.2 +046700 MOVE ALPHA-FIELD TO COMPUTED-A. IC2354.2 +046800 MOVE "YES" TO CORRECT-A. IC2354.2 +046900 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC2354.2 +047000 CALL-WRITE-06-03. IC2354.2 +047100 ADD 1 TO REC-CT. IC2354.2 +047200 PERFORM PRINT-DETAIL. IC2354.2 +047300 CALL-TEST-06-04. IC2354.2 +047400 IF ELEM-77 EQUAL TO 0.7654 IC2354.2 +047500 PERFORM PASS IC2354.2 +047600 GO TO CALL-WRITE-06-04. IC2354.2 +047700 CALL-FAIL-06-04. IC2354.2 +047800 PERFORM FAIL. IC2354.2 +047900 MOVE ELEM-77 TO COMPUTED-4V14. IC2354.2 +048000 MOVE 0.7654 TO CORRECT-4V14. IC2354.2 +048100 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC2354.2 +048200 CALL-WRITE-06-04. IC2354.2 +048300 ADD 1 TO REC-CT. IC2354.2 +048400 PERFORM PRINT-DETAIL. IC2354.2 +048500 CALL-TEST-06-05. IC2354.2 +048600 IF NUM-ITEM EQUAL TO 25 IC2354.2 +048700 PERFORM PASS IC2354.2 +048800 GO TO CALL-WRITE-06-05. IC2354.2 +048900 CALL-FAIL-06-05. IC2354.2 +049000 PERFORM FAIL. IC2354.2 +049100 MOVE NUM-ITEM TO COMPUTED-18V0. IC2354.2 +049200 MOVE 25 TO CORRECT-18V0. IC2354.2 +049300 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC2354.2 +049400 CALL-WRITE-06-05. IC2354.2 +049500 ADD 1 TO REC-CT. IC2354.2 +049600 PERFORM PRINT-DETAIL. IC2354.2 +049700 CALL-TEST-06-06. IC2354.2 +049800 IF ALPHA-EDITED EQUAL TO "AB C0D" IC2354.2 +049900 PERFORM PASS IC2354.2 +050000 GO TO CALL-WRITE-06-06. IC2354.2 +050100 CALL-FAIL-06-06. IC2354.2 +050200 PERFORM FAIL. IC2354.2 +050300 MOVE ALPHA-EDITED TO COMPUTED-A. IC2354.2 +050400 MOVE "AB C0D" TO CORRECT-A. IC2354.2 +050500 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC2354.2 +050600 CALL-WRITE-06-06. IC2354.2 +050700 ADD 1 TO REC-CT. IC2354.2 +050800 PERFORM PRINT-DETAIL. IC2354.2 +050900 CALL-TEST-06-07. IC2354.2 +051000 IF ELEM-NON-01 = "ZZ" IC2354.2 +051100 PERFORM PASS IC2354.2 +051200 GO TO CALL-WRITE-06-07. IC2354.2 +051300 CALL-FAIL-06-07. IC2354.2 +051400 PERFORM FAIL. IC2354.2 +051500 MOVE ELEM-NON-01 TO COMPUTED-A. IC2354.2 +051600 MOVE "ZZ" TO CORRECT-A. IC2354.2 +051700 MOVE "ELEMENTARY NON LEVEL-01 DATA ITEM" TO RE-MARK. IC2354.2 +051800 CALL-WRITE-06-07. IC2354.2 +051900 MOVE "X-27 5.2.3 SR3" TO ANSI-REFERENCE. IC2354.2 +052000 ADD 1 TO REC-CT. IC2354.2 +052100 PERFORM PRINT-DETAIL. IC2354.2 +052200 CALL-TEST-06-08. IC2354.2 +052300 IF SUBSCRIPTED-DATA (4) = "1A" IC2354.2 +052400 PERFORM PASS IC2354.2 +052500 GO TO CALL-WRITE-06-08. IC2354.2 +052600 CALL-FAIL-06-08. IC2354.2 +052700 PERFORM FAIL. IC2354.2 +052800 MOVE SUBSCRIPTED-DATA (4) TO COMPUTED-A. IC2354.2 +052900 MOVE "1A" TO CORRECT-A. IC2354.2 +053000 MOVE "SUBSCRIPTED LINKAGE DATA ITEM" TO RE-MARK. IC2354.2 +053100 CALL-WRITE-06-08. IC2354.2 +053200 MOVE "XVII-46 (59)" TO ANSI-REFERENCE. IC2354.2 +053300 ADD 1 TO REC-CT. IC2354.2 +053400 PERFORM PRINT-DETAIL. IC2354.2 +053500* IC2354.2 +053600 GO TO CCVS-EXIT. IC2354.2 +053700 CCVS-EXIT SECTION. IC2354.2 +053800 CCVS-999999. IC2354.2 +053900 GO TO CLOSE-FILES. IC2354.2 +054000 IDENTIFICATION DIVISION. IC2354.2 +054100 PROGRAM-ID. IC2354.2 +054200 IC235A-1. IC2354.2 +054300**************************************************************** IC2354.2 +054400* * IC2354.2 +054500* VALIDATION FOR:- * IC2354.2 +054600* * IC2354.2 +054700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +054800* * IC2354.2 +054900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +055000* * IC2354.2 +055100**************************************************************** IC2354.2 +055200* * IC2354.2 +055300* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +055400* * IC2354.2 +055500* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +055600* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +055700* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +055800* * IC2354.2 +055900**************************************************************** IC2354.2 +056000* THE SUBPROGRAM IC235A-1 HAS THREE OPERANDS IN THE IC2354.2 +056100* USING PHRASE OF THE PROCEDURE DIVISION HEADER. TWO IC2354.2 +056200* OPERANDS ARE 01 GROUP ITEMS AND THE THIRD OPERAND IS IC2354.2 +056300* AN ELEMENTARY 77 ITEM. THE DATA DESCRIPTIONS OF THESE IC2354.2 +056400* OPERANDS IN THE LINKAGE SECTION ARE NOT THE SAME AS THE IC2354.2 +056500* DATA DESCRIPTIONS IN THE WORKING-STORAGE SECTION OF THE IC2354.2 +056600* CALLING PROGRAM, BUT AN EQUAL NUMBER OF CHARACTER IC2354.2 +056700* POSITIONS ARE DEFINED. THE CALLING PROGRAM IS IC235. IC2354.2 +056800 ENVIRONMENT DIVISION. IC2354.2 +056900 INPUT-OUTPUT SECTION. IC2354.2 +057000 FILE-CONTROL. IC2354.2 +057100 SELECT PRINT-FILE ASSIGN TO IC2354.2 +057200 XXXXX055. IC2354.2 +057300 DATA DIVISION. IC2354.2 +057400 FILE SECTION. IC2354.2 +057500 FD PRINT-FILE. IC2354.2 +057600 01 PRINT-REC PICTURE X(120). IC2354.2 +057700 01 DUMMY-RECORD PICTURE X(120). IC2354.2 +057800 WORKING-STORAGE SECTION. IC2354.2 +057900 01 CONSTANT-VALUES. IC2354.2 +058000 02 AN-CONSTANT PIC X(8) VALUE "IC235A-1". IC2354.2 +058100 02 NUM-CONSTANT PIC 99V9999 VALUE 0.7654. IC2354.2 +058200 LINKAGE SECTION. IC2354.2 +058300 01 GRP-01. IC2354.2 +058400 02 AN-FIELD PICTURE X(8). IC2354.2 +058500 02 NUM-DISPLAY PIC 99. IC2354.2 +058600 02 GRP-LEVEL. IC2354.2 +058700 03 A-FIELD PICTURE A(3). IC2354.2 +058800 77 ELEM-01 PIC V9(4) COMPUTATIONAL. IC2354.2 +058900 01 GRP-02. IC2354.2 +059000 02 GRP-03. IC2354.2 +059100 03 NUM-ITEM PICTURE S99. IC2354.2 +059200 03 EDITED-FIELD PIC XXBX0X. IC2354.2 +059300 01 ELEM-NON-01 PIC XX. IC2354.2 +059400 01 SUBSCRIPTED-DATA PIC XX. IC2354.2 +059500 PROCEDURE DIVISION USING GRP-01 ELEM-01 GRP-02 IC2354.2 +059600 ELEM-NON-01 SUBSCRIPTED-DATA. IC2354.2 +059700 SECT-IC235A-1-001 SECTION. IC2354.2 +059800* THIS SECTION SETS THE PARAMETER FIELDS REFERRED TO IC2354.2 +059900* IN THE USING PHRASE AND DEFINED IN THE LINKAGE SECTION. IC2354.2 +060000 CALL-TEST-06. IC2354.2 +060100 MOVE AN-CONSTANT TO AN-FIELD. IC2354.2 +060200 ADD 25 TO NUM-DISPLAY. IC2354.2 +060300 MOVE "YES" TO A-FIELD. IC2354.2 +060400 MOVE NUM-CONSTANT TO ELEM-01. IC2354.2 +060500 MOVE NUM-DISPLAY TO NUM-ITEM. IC2354.2 +060600 MOVE "ABCD" TO EDITED-FIELD. IC2354.2 +060700 MOVE "ZZ" TO ELEM-NON-01. IC2354.2 +060800 MOVE "1A" TO SUBSCRIPTED-DATA. IC2354.2 +060900 CALL-EXIT-06. IC2354.2 +061000 EXIT PROGRAM. IC2354.2 +061100 END PROGRAM IC235A-1. IC2354.2 +061200 IDENTIFICATION DIVISION. IC2354.2 +061300 PROGRAM-ID. IC2354.2 +061400 IC235A-2. IC2354.2 +061500**************************************************************** IC2354.2 +061600* * IC2354.2 +061700* VALIDATION FOR:- * IC2354.2 +061800* * IC2354.2 +061900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +062000* * IC2354.2 +062100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +062200* * IC2354.2 +062300**************************************************************** IC2354.2 +062400* * IC2354.2 +062500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +062600* * IC2354.2 +062700* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +062800* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +062900* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +063000* * IC2354.2 +063100**************************************************************** IC2354.2 +063200* THE SUBPROGRAM IC235A-2 HAS TWO OPERANDS IN THE IC2354.2 +063300* PROCEDURE DIVISION HEADER AND THE ROUTINE CONTAINS IC2354.2 +063400* FOUR EXIT PROGRAM STATEMENTS. THE CALLING PROGRAM IC2354.2 +063500* IS IC235. IC2354.2 +063600 ENVIRONMENT DIVISION. IC2354.2 +063700 DATA DIVISION. IC2354.2 +063800 LINKAGE SECTION. IC2354.2 +063900 77 DN1 PICTURE 999. IC2354.2 +064000 77 DN2 PICTURE S99 COMPUTATIONAL. IC2354.2 +064100 PROCEDURE DIVISION USING DN1 DN2. IC2354.2 +064200* THIS SUBPROGRAM CONTANS FOUR EXIT PROGRAM STATEMENTS. IC2354.2 +064300 SECT-IC235A-2-0001 SECTION. IC2354.2 +064400 EXIT-TEST-001. IC2354.2 +064500 IF DN1 IS NOT EQUAL TO 1 IC2354.2 +064600 GO TO EXIT-TEST-002. IC2354.2 +064700 MOVE 1 TO DN2. IC2354.2 +064800 EXIT PROGRAM. IC2354.2 +064900 EXIT-TEST-002. IC2354.2 +065000 IF DN1 IS NOT EQUAL TO 2 IC2354.2 +065100 GO TO EXIT-TEST-003. IC2354.2 +065200 MOVE 2 TO DN2. IC2354.2 +065300 EXIT PROGRAM. IC2354.2 +065400 EXIT-TEST-003. IC2354.2 +065500 IF DN1 NOT EQUAL TO 3 IC2354.2 +065600 GO TO EXIT-TEST-004. IC2354.2 +065700 MOVE 3 TO DN2. IC2354.2 +065800 EXIT PROGRAM. IC2354.2 +065900 EXIT-TEST-004. IC2354.2 +066000 MOVE 4 TO DN2. IC2354.2 +066100 GO TO EXIT-STATEMENT-004. IC2354.2 +066200 EXTRANEOUS-PARAGRAPH. IC2354.2 +066300* THIS PARAGRAPH IS NEVER EXECUTED. IC2354.2 +066400 MOVE 5 TO DN2. IC2354.2 +066500 EXIT-STATEMENT-004. IC2354.2 +066600 EXIT PROGRAM. IC2354.2 +066700 END PROGRAM IC235A-2. IC2354.2 +066800 END PROGRAM IC235A. IC2354.2 +*END-OF,IC235A +*HEADER,COBOL,IC237A +000100 IDENTIFICATION DIVISION. IC2374.2 +000200 PROGRAM-ID. IC2374.2 +000300 IC237A. IC2374.2 +000400**************************************************************** IC2374.2 +000500* * IC2374.2 +000600* VALIDATION FOR:- * IC2374.2 +000700* * IC2374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +000900* * IC2374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +001100* * IC2374.2 +001200**************************************************************** IC2374.2 +001300* * IC2374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2374.2 +001500* * IC2374.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2374.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2374.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2374.2 +001900* * IC2374.2 +002000**************************************************************** IC2374.2 +002100* * IC2374.2 +002200* PROGRAMS IC237A AND IC237A-1 TEST THE ACCESSING OF A * IC2374.2 +002300* LINKAGE SECTION ITEM. * IC2374.2 +002400* * IC2374.2 +002500**************************************************************** IC2374.2 +002600 ENVIRONMENT DIVISION. IC2374.2 +002700 CONFIGURATION SECTION. IC2374.2 +002800 SOURCE-COMPUTER. IC2374.2 +002900 XXXXX082. IC2374.2 +003000 OBJECT-COMPUTER. IC2374.2 +003100 XXXXX083. IC2374.2 +003200 INPUT-OUTPUT SECTION. IC2374.2 +003300 FILE-CONTROL. IC2374.2 +003400 SELECT PRINT-FILE ASSIGN TO IC2374.2 +003500 XXXXX055. IC2374.2 +003600 DATA DIVISION. IC2374.2 +003700 FILE SECTION. IC2374.2 +003800 FD PRINT-FILE. IC2374.2 +003900 01 PRINT-REC PICTURE X(120). IC2374.2 +004000 01 DUMMY-RECORD PICTURE X(120). IC2374.2 +004100 WORKING-STORAGE SECTION. IC2374.2 +004200 01 WS-A PIC 9 VALUE ZERO. IC2374.2 +004300 01 WS-B PIC 9 VALUE ZERO. IC2374.2 +004400 01 WS-C PIC 9 VALUE ZERO. IC2374.2 +004500* IC2374.2 +004600 01 TEST-RESULTS. IC2374.2 +004700 02 FILLER PIC X VALUE SPACE. IC2374.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IC2374.2 +004900 02 FILLER PIC X VALUE SPACE. IC2374.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IC2374.2 +005100 02 FILLER PIC X VALUE SPACE. IC2374.2 +005200 02 PAR-NAME. IC2374.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IC2374.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IC2374.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IC2374.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IC2374.2 +005700 02 RE-MARK PIC X(61). IC2374.2 +005800 01 TEST-COMPUTED. IC2374.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IC2374.2 +006000 02 FILLER PIC X(17) VALUE IC2374.2 +006100 " COMPUTED=". IC2374.2 +006200 02 COMPUTED-X. IC2374.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2374.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IC2374.2 +006500 PIC -9(9).9(9). IC2374.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2374.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2374.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2374.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IC2374.2 +007000 04 COMPUTED-18V0 PIC -9(18). IC2374.2 +007100 04 FILLER PIC X. IC2374.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IC2374.2 +007300 01 TEST-CORRECT. IC2374.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IC2374.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2374.2 +007600 02 CORRECT-X. IC2374.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2374.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2374.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2374.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2374.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2374.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IC2374.2 +008300 04 CORRECT-18V0 PIC -9(18). IC2374.2 +008400 04 FILLER PIC X. IC2374.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IC2374.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2374.2 +008700 01 CCVS-C-1. IC2374.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2374.2 +008900- "SS PARAGRAPH-NAME IC2374.2 +009000- " REMARKS". IC2374.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IC2374.2 +009200 01 CCVS-C-2. IC2374.2 +009300 02 FILLER PIC X VALUE SPACE. IC2374.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IC2374.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IC2374.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IC2374.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IC2374.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2374.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IC2374.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2374.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2374.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2374.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2374.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2374.2 +010900 01 CCVS-H-1. IC2374.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IC2374.2 +011100 02 FILLER PIC X(42) VALUE IC2374.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2374.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IC2374.2 +011400 01 CCVS-H-2A. IC2374.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IC2374.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2374.2 +011700 02 FILLER PIC XXXX VALUE IC2374.2 +011800 "4.2 ". IC2374.2 +011900 02 FILLER PIC X(28) VALUE IC2374.2 +012000 " COPY - NOT FOR DISTRIBUTION". IC2374.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IC2374.2 +012200 IC2374.2 +012300 01 CCVS-H-2B. IC2374.2 +012400 02 FILLER PIC X(15) VALUE IC2374.2 +012500 "TEST RESULT OF ". IC2374.2 +012600 02 TEST-ID PIC X(9). IC2374.2 +012700 02 FILLER PIC X(4) VALUE IC2374.2 +012800 " IN ". IC2374.2 +012900 02 FILLER PIC X(12) VALUE IC2374.2 +013000 " HIGH ". IC2374.2 +013100 02 FILLER PIC X(22) VALUE IC2374.2 +013200 " LEVEL VALIDATION FOR ". IC2374.2 +013300 02 FILLER PIC X(58) VALUE IC2374.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +013500 01 CCVS-H-3. IC2374.2 +013600 02 FILLER PIC X(34) VALUE IC2374.2 +013700 " FOR OFFICIAL USE ONLY ". IC2374.2 +013800 02 FILLER PIC X(58) VALUE IC2374.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +014000 02 FILLER PIC X(28) VALUE IC2374.2 +014100 " COPYRIGHT 1985 ". IC2374.2 +014200 01 CCVS-E-1. IC2374.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IC2374.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2374.2 +014500 02 ID-AGAIN PIC X(9). IC2374.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IC2374.2 +014700 01 CCVS-E-2. IC2374.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IC2374.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IC2374.2 +015000 02 CCVS-E-2-2. IC2374.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2374.2 +015200 03 FILLER PIC X VALUE SPACE. IC2374.2 +015300 03 ENDER-DESC PIC X(44) VALUE IC2374.2 +015400 "ERRORS ENCOUNTERED". IC2374.2 +015500 01 CCVS-E-3. IC2374.2 +015600 02 FILLER PIC X(22) VALUE IC2374.2 +015700 " FOR OFFICIAL USE ONLY". IC2374.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IC2374.2 +015900 02 FILLER PIC X(58) VALUE IC2374.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IC2374.2 +016200 02 FILLER PIC X(15) VALUE IC2374.2 +016300 " COPYRIGHT 1985". IC2374.2 +016400 01 CCVS-E-4. IC2374.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2374.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IC2374.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2374.2 +016800 02 FILLER PIC X(40) VALUE IC2374.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2374.2 +017000 01 XXINFO. IC2374.2 +017100 02 FILLER PIC X(19) VALUE IC2374.2 +017200 "*** INFORMATION ***". IC2374.2 +017300 02 INFO-TEXT. IC2374.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IC2374.2 +017500 04 XXCOMPUTED PIC X(20). IC2374.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IC2374.2 +017700 04 XXCORRECT PIC X(20). IC2374.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IC2374.2 +017900 01 HYPHEN-LINE. IC2374.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IC2374.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IC2374.2 +018200- "*****************************************". IC2374.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IC2374.2 +018400- "******************************". IC2374.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IC2374.2 +018600 "IC237A". IC2374.2 +018700 PROCEDURE DIVISION. IC2374.2 +018800 CCVS1 SECTION. IC2374.2 +018900 OPEN-FILES. IC2374.2 +019000 OPEN OUTPUT PRINT-FILE. IC2374.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2374.2 +019200 MOVE SPACE TO TEST-RESULTS. IC2374.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2374.2 +019400 GO TO CCVS1-EXIT. IC2374.2 +019500 CLOSE-FILES. IC2374.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2374.2 +019700 TERMINATE-CCVS. IC2374.2 +019800S EXIT PROGRAM. IC2374.2 +019900STERMINATE-CALL. IC2374.2 +020000 STOP RUN. IC2374.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2374.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2374.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2374.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2374.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. IC2374.2 +020600 PRINT-DETAIL. IC2374.2 +020700 IF REC-CT NOT EQUAL TO ZERO IC2374.2 +020800 MOVE "." TO PARDOT-X IC2374.2 +020900 MOVE REC-CT TO DOTVALUE. IC2374.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2374.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2374.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2374.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2374.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2374.2 +021500 MOVE SPACE TO CORRECT-X. IC2374.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2374.2 +021700 MOVE SPACE TO RE-MARK. IC2374.2 +021800 HEAD-ROUTINE. IC2374.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2374.2 +022200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2374.2 +022300 COLUMN-NAMES-ROUTINE. IC2374.2 +022400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +022500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +022700 END-ROUTINE. IC2374.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2374.2 +022900 END-RTN-EXIT. IC2374.2 +023000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +023100 END-ROUTINE-1. IC2374.2 +023200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2374.2 +023300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2374.2 +023400 ADD PASS-COUNTER TO ERROR-HOLD. IC2374.2 +023500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2374.2 +023600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2374.2 +023700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2374.2 +023800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2374.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2374.2 +024000 END-ROUTINE-12. IC2374.2 +024100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2374.2 +024200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2374.2 +024300 MOVE "NO " TO ERROR-TOTAL IC2374.2 +024400 ELSE IC2374.2 +024500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2374.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2374.2 +024700 PERFORM WRITE-LINE. IC2374.2 +024800 END-ROUTINE-13. IC2374.2 +024900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2374.2 +025000 MOVE "NO " TO ERROR-TOTAL ELSE IC2374.2 +025100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2374.2 +025200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2374.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +025400 IF INSPECT-COUNTER EQUAL TO ZERO IC2374.2 +025500 MOVE "NO " TO ERROR-TOTAL IC2374.2 +025600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2374.2 +025700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2374.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +025900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +026000 WRITE-LINE. IC2374.2 +026100 ADD 1 TO RECORD-COUNT. IC2374.2 +026200Y IF RECORD-COUNT GREATER 50 IC2374.2 +026300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IC2374.2 +026400Y MOVE SPACE TO DUMMY-RECORD IC2374.2 +026500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2374.2 +026600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2374.2 +026700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2374.2 +026800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2374.2 +026900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IC2374.2 +027000Y MOVE ZERO TO RECORD-COUNT. IC2374.2 +027100 PERFORM WRT-LN. IC2374.2 +027200 WRT-LN. IC2374.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2374.2 +027400 MOVE SPACE TO DUMMY-RECORD. IC2374.2 +027500 BLANK-LINE-PRINT. IC2374.2 +027600 PERFORM WRT-LN. IC2374.2 +027700 FAIL-ROUTINE. IC2374.2 +027800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2374.2 +027900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2374.2 +028000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2374.2 +028100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2374.2 +028200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +028300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2374.2 +028400 GO TO FAIL-ROUTINE-EX. IC2374.2 +028500 FAIL-ROUTINE-WRITE. IC2374.2 +028600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2374.2 +028700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2374.2 +028800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2374.2 +028900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2374.2 +029000 FAIL-ROUTINE-EX. EXIT. IC2374.2 +029100 BAIL-OUT. IC2374.2 +029200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2374.2 +029300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2374.2 +029400 BAIL-OUT-WRITE. IC2374.2 +029500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2374.2 +029600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2374.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2374.2 +029900 BAIL-OUT-EX. EXIT. IC2374.2 +030000 CCVS1-EXIT. IC2374.2 +030100 EXIT. IC2374.2 +030200 SECT-IC237A-001 SECTION. IC2374.2 +030300* IC2374.2 +030400 CALL-INIT-1. IC2374.2 +030500 MOVE "CALL-TEST-1" TO PAR-NAME. IC2374.2 +030600 MOVE 1 TO WS-A. IC2374.2 +030700 MOVE 3 TO WS-B. IC2374.2 +030800 MOVE 5 TO WS-C. IC2374.2 +030900 CALL-TEST-0. IC2374.2 +031000 CALL "IC237A-1" USING WS-A WS-B WS-C. IC2374.2 +031100 CALL-TEST-1. IC2374.2 +031200 IF WS-C = WS-A IC2374.2 +031300 PERFORM PASS IC2374.2 +031400 PERFORM PRINT-DETAIL IC2374.2 +031500 ELSE IC2374.2 +031600 MOVE 1 TO CORRECT-N IC2374.2 +031700 MOVE WS-A TO COMPUTED-N IC2374.2 +031800 MOVE "WRONG VALUE RETURNED FROM CALL TO IC237A-1" IC2374.2 +031900 TO RE-MARK IC2374.2 +032000 PERFORM FAIL IC2374.2 +032100 PERFORM PRINT-DETAIL. IC2374.2 +032200* IC2374.2 +032300 CCVS-EXIT SECTION. IC2374.2 +032400 CCVS-999999. IC2374.2 +032500 GO TO CLOSE-FILES. IC2374.2 +032600 END PROGRAM IC237A. IC2374.2 +032700 IDENTIFICATION DIVISION. IC2374.2 +032800 PROGRAM-ID. IC2374.2 +032900 IC237A-1. IC2374.2 +033000**************************************************************** IC2374.2 +033100* * IC2374.2 +033200* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2374.2 +033300* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2374.2 +033400* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2374.2 +033500* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2374.2 +033600* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2374.2 +033700* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2374.2 +033800* * IC2374.2 +033900* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2374.2 +034000* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2374.2 +034100* DOCUMENT REFERENCE: ISO-1989-1978). * IC2374.2 +034200* * IC2374.2 +034300* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2374.2 +034400* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2374.2 +034500* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2374.2 +034600* * IC2374.2 +034700* THE FEDERAL SOFTWARE TESTING CENTER * IC2374.2 +034800* OFFICE OF SOFTWARE DEVELOPMENT * IC2374.2 +034900* & INFORMATION TECHNOLOGY * IC2374.2 +035000* TWO SKYLINE PLACE * IC2374.2 +035100* SUITE 1100 * IC2374.2 +035200* 5203 LEESBURG PIKE * IC2374.2 +035300* FALLS CHURCH * IC2374.2 +035400* VA 22041 * IC2374.2 +035500* U.S.A. * IC2374.2 +035600* * IC2374.2 +035700* THE PROJECT TEAM MEMBERS WERE: * IC2374.2 +035800* * IC2374.2 +035900* BIADI (BUREAU INTER ADMINISTRATION * IC2374.2 +036000* DE DOCUMENTATION INFORMATIQUE) * IC2374.2 +036100* 21 RUE BARA * IC2374.2 +036200* F-92132 ISSY * IC2374.2 +036300* FRANCE * IC2374.2 +036400* * IC2374.2 +036500* * IC2374.2 +036600* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2374.2 +036700* UND DATENVERARBEITUNG MBH) * IC2374.2 +036800* SCHLOSS BIRLINGHOVEN * IC2374.2 +036900* POSTFACH 12 40 * IC2374.2 +037000* D-5205 ST. AUGUSTIN 1 * IC2374.2 +037100* GERMANY FR * IC2374.2 +037200* * IC2374.2 +037300* * IC2374.2 +037400* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2374.2 +037500* OXFORD ROAD * IC2374.2 +037600* MANCHESTER * IC2374.2 +037700* M1 7ED * IC2374.2 +037800* UNITED KINGDOM * IC2374.2 +037900* * IC2374.2 +038000* * IC2374.2 +038100* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2374.2 +038200* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2374.2 +038300* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2374.2 +038400* * IC2374.2 +038500**************************************************************** IC2374.2 +038600* * IC2374.2 +038700* VALIDATION FOR:- * IC2374.2 +038800* * IC2374.2 +038900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +039000* * IC2374.2 +039100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +039200* * IC2374.2 +039300**************************************************************** IC2374.2 +039400* * IC2374.2 +039500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2374.2 +039600* * IC2374.2 +039700* X-55 - SYSTEM PRINTER NAME. * IC2374.2 +039800* X-82 - SOURCE COMPUTER NAME. * IC2374.2 +039900* X-83 - OBJECT COMPUTER NAME. * IC2374.2 +040000* * IC2374.2 +040100**************************************************************** IC2374.2 +040200 ENVIRONMENT DIVISION. IC2374.2 +040300 CONFIGURATION SECTION. IC2374.2 +040400 SOURCE-COMPUTER. IC2374.2 +040500 XXXXX082. IC2374.2 +040600 OBJECT-COMPUTER. IC2374.2 +040700 XXXXX083. IC2374.2 +040800 INPUT-OUTPUT SECTION. IC2374.2 +040900 FILE-CONTROL. IC2374.2 +041000 SELECT PRINT-FILE ASSIGN TO IC2374.2 +041100 XXXXX055. IC2374.2 +041200 DATA DIVISION. IC2374.2 +041300 FILE SECTION. IC2374.2 +041400 FD PRINT-FILE. IC2374.2 +041500 01 PRINT-REC PICTURE X(120). IC2374.2 +041600 01 DUMMY-RECORD PICTURE X(120). IC2374.2 +041700 WORKING-STORAGE SECTION. IC2374.2 +041800* IC2374.2 +041900 LINKAGE SECTION. IC2374.2 +042000 01 L-A PIC 9. IC2374.2 +042100 01 L-A1 REDEFINES L-A PIC 9. IC2374.2 +042200 01 L-B PIC 9. IC2374.2 +042300 01 L-C PIC 9. IC2374.2 +042400 PROCEDURE DIVISION USING L-A L-B L-C. IC2374.2 +042500* IC2374.2 +042600 SECT-IC237A-1-001 SECTION. IC2374.2 +042700* IC2374.2 +042800 CALLED-FROM-NC121A-FUNCTION. IC2374.2 +042900 MOVE L-A1 TO L-C. IC2374.2 +043000 IC237A-EXIT. IC2374.2 +043100 EXIT PROGRAM. IC2374.2 +043200 END-OF-PROGRAM. IC2374.2 +043300 END PROGRAM IC237A-1. IC2374.2 +*END-OF,IC237A +*HEADER,COBOL,IC401M +000100 IDENTIFICATION DIVISION. IC4014.2 +000200 PROGRAM-ID. IC4014.2 +000300 IC401M IS INITIAL. IC4014.2 +000400*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +000500 IC4014.2 +000600*The following program tests the flagging of high IC4014.2 +000700*subset Features that are used in inter-program IC4014.2 +000800*communication. IC4014.2 +000900 ENVIRONMENT DIVISION. IC4014.2 +001000 CONFIGURATION SECTION. IC4014.2 +001100 SOURCE-COMPUTER. IC4014.2 +001200 XXXXX082. IC4014.2 +001300 OBJECT-COMPUTER. IC4014.2 +001400 XXXXX083. IC4014.2 +001500 DATA DIVISION. IC4014.2 +001600 WORKING-STORAGE SECTION. IC4014.2 +001700 IC4014.2 +001800 01 GLOB IS GLOBAL PIC IS X(2) VALUE IS "HI". IC4014.2 +001900*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +002000 IC4014.2 +002100 01 EXTE IS EXTERNAL PIC IS X(5). IC4014.2 +002200*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +002300 IC4014.2 +002400 PROCEDURE DIVISION. IC4014.2 +002500 IC4014.2 +002600 DECLARATIVES. IC4014.2 +002700 IC4014.2 +002800 IC401M-USE SECTION. IC4014.2 +002900 USE GLOBAL AFTER STANDARD ERROR PROCEDURE ON I-O. IC4014.2 +003000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +003100 IC4014.2 +003200 END DECLARATIVES. IC4014.2 +003300 IC401M-NONDECL SECTION. IC4014.2 +003400 IC401M-CONTROL. IC4014.2 +003500 PERFORM IC401M-CANCEL THRU IC401M-BYCONT. IC4014.2 +003600 STOP RUN. IC4014.2 +003700 IC4014.2 +003800 IC401M-CANCEL. IC4014.2 +003900 CANCEL "NESTEDPROG". IC4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +004100 IC4014.2 +004200 IC4014.2 +004300 IC401M-BYREF. IC4014.2 +004400 CALL "NESTEDPROG" USING BY REFERENCE GLOB. IC4014.2 +004500*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +004600 IC4014.2 +004700 IC4014.2 +004800 IC401M-BYCONT. IC4014.2 +004900 CALL "FIC401M" USING BY CONTENT GLOB. IC4014.2 +005000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005100 IC4014.2 +005200 IC4014.2 +005300 IDENTIFICATION DIVISION. IC4014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005500 IC4014.2 +005600 PROGRAM-ID. IC4014.2 +005700 NESTEDPROG IS COMMON. IC4014.2 +005800*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005900 IC4014.2 +006000 ENVIRONMENT DIVISION. IC4014.2 +006100 DATA DIVISION. IC4014.2 +006200 LINKAGE SECTION. IC4014.2 +006300 01 GLOB-2 PIC X(2). IC4014.2 +006400 IC4014.2 +006500 PROCEDURE DIVISION USING GLOB-2. IC4014.2 +006600 DUMMY-PARA. IC4014.2 +006700 DISPLAY "HELLO". IC4014.2 +006800 IC4014.2 +006900 END-PARA. IC4014.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 11. IC4014.2 +007100 END PROGRAM NESTEDPROG. IC4014.2 +007200*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +007300*Message expected for following statement: NON-CONFORMING STANDARDIC4014.2 +007400 END PROGRAM IC401M. IC4014.2 +*END-OF,IC401M +*HEADER,COBOL,IF101A +000100 IDENTIFICATION DIVISION. IF1014.2 +000200 PROGRAM-ID. IF1014.2 +000300 IF101A. IF1014.2 +000400 IF1014.2 +000500*********************************************************** IF1014.2 +000600* * IF1014.2 +000700* This program is intended to form part of the CCVS85 * IF1014.2 +000800* COBOL Test Suite. It contains tests for the * IF1014.2 +000900* Intrinsic Function ACOS. * IF1014.2 +001000* * IF1014.2 +001100*********************************************************** IF1014.2 +001200 ENVIRONMENT DIVISION. IF1014.2 +001300 CONFIGURATION SECTION. IF1014.2 +001400 SOURCE-COMPUTER. IF1014.2 +001500 XXXXX082. IF1014.2 +001600 OBJECT-COMPUTER. IF1014.2 +001700 XXXXX083. IF1014.2 +001800 INPUT-OUTPUT SECTION. IF1014.2 +001900 FILE-CONTROL. IF1014.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1014.2 +002100 XXXXX055. IF1014.2 +002200 DATA DIVISION. IF1014.2 +002300 FILE SECTION. IF1014.2 +002400 FD PRINT-FILE. IF1014.2 +002500 01 PRINT-REC PICTURE X(120). IF1014.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1014.2 +002700 WORKING-STORAGE SECTION. IF1014.2 +002800*********************************************************** IF1014.2 +002900* Variables specific to the Intrinsic Function Test IF101A* IF1014.2 +003000*********************************************************** IF1014.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1014.2 +003200 01 B PIC S9(10) VALUE 4. IF1014.2 +003300 01 C PIC S9(10) VALUE 100000. IF1014.2 +003400 01 D PIC S9(10) VALUE 1000. IF1014.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1014.2 +003600 01 ARG1 PIC S9V9(17) VALUE 0.00. IF1014.2 +003700 01 SQRT2 PIC S9V9(17) VALUE 1.414213562. IF1014.2 +003800 01 SQRT3D2 PIC S9V9(17) VALUE 0.866025403. IF1014.2 +003900 01 ARR VALUE "40537". IF1014.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1014.2 +004100 01 TEMP PIC S9(5)V9(5). IF1014.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1014.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1014.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1014.2 +004500* IF1014.2 +004600********************************************************** IF1014.2 +004700* IF1014.2 +004800 01 TEST-RESULTS. IF1014.2 +004900 02 FILLER PIC X VALUE SPACE. IF1014.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1014.2 +005100 02 FILLER PIC X VALUE SPACE. IF1014.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1014.2 +005300 02 FILLER PIC X VALUE SPACE. IF1014.2 +005400 02 PAR-NAME. IF1014.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1014.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1014.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1014.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1014.2 +005900 02 RE-MARK PIC X(61). IF1014.2 +006000 01 TEST-COMPUTED. IF1014.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +006200 02 FILLER PIC X(17) VALUE IF1014.2 +006300 " COMPUTED=". IF1014.2 +006400 02 COMPUTED-X. IF1014.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1014.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1014.2 +006700 PIC -9(9).9(9). IF1014.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1014.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1014.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1014.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1014.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1014.2 +007300 04 FILLER PIC X. IF1014.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1014.2 +007500 01 TEST-CORRECT. IF1014.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1014.2 +007800 02 CORRECT-X. IF1014.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1014.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1014.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1014.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1014.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1014.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1014.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1014.2 +008600 04 FILLER PIC X. IF1014.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1014.2 +008900 01 TEST-CORRECT-MIN. IF1014.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1014.2 +009200 02 CORRECTMI-X. IF1014.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1014.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1014.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1014.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1014.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1014.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1014.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1014.2 +010000 04 FILLER PIC X. IF1014.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1014.2 +010300 01 TEST-CORRECT-MAX. IF1014.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1014.2 +010600 02 CORRECTMA-X. IF1014.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1014.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1014.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1014.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1014.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1014.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1014.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1014.2 +011400 04 FILLER PIC X. IF1014.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1014.2 +011700 01 CCVS-C-1. IF1014.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1014.2 +011900- "SS PARAGRAPH-NAME IF1014.2 +012000- " REMARKS". IF1014.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1014.2 +012200 01 CCVS-C-2. IF1014.2 +012300 02 FILLER PIC X VALUE SPACE. IF1014.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1014.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1014.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1014.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1014.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1014.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1014.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1014.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1014.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1014.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1014.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1014.2 +013900 01 CCVS-H-1. IF1014.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1014.2 +014100 02 FILLER PIC X(42) VALUE IF1014.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1014.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1014.2 +014400 01 CCVS-H-2A. IF1014.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1014.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1014.2 +014700 02 FILLER PIC XXXX VALUE IF1014.2 +014800 "4.2 ". IF1014.2 +014900 02 FILLER PIC X(28) VALUE IF1014.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1014.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1014.2 +015200 IF1014.2 +015300 01 CCVS-H-2B. IF1014.2 +015400 02 FILLER PIC X(15) VALUE IF1014.2 +015500 "TEST RESULT OF ". IF1014.2 +015600 02 TEST-ID PIC X(9). IF1014.2 +015700 02 FILLER PIC X(4) VALUE IF1014.2 +015800 " IN ". IF1014.2 +015900 02 FILLER PIC X(12) VALUE IF1014.2 +016000 " HIGH ". IF1014.2 +016100 02 FILLER PIC X(22) VALUE IF1014.2 +016200 " LEVEL VALIDATION FOR ". IF1014.2 +016300 02 FILLER PIC X(58) VALUE IF1014.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1014.2 +016500 01 CCVS-H-3. IF1014.2 +016600 02 FILLER PIC X(34) VALUE IF1014.2 +016700 " FOR OFFICIAL USE ONLY ". IF1014.2 +016800 02 FILLER PIC X(58) VALUE IF1014.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1014.2 +017000 02 FILLER PIC X(28) VALUE IF1014.2 +017100 " COPYRIGHT 1985 ". IF1014.2 +017200 01 CCVS-E-1. IF1014.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1014.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1014.2 +017500 02 ID-AGAIN PIC X(9). IF1014.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1014.2 +017700 01 CCVS-E-2. IF1014.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1014.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1014.2 +018000 02 CCVS-E-2-2. IF1014.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1014.2 +018200 03 FILLER PIC X VALUE SPACE. IF1014.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1014.2 +018400 "ERRORS ENCOUNTERED". IF1014.2 +018500 01 CCVS-E-3. IF1014.2 +018600 02 FILLER PIC X(22) VALUE IF1014.2 +018700 " FOR OFFICIAL USE ONLY". IF1014.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1014.2 +018900 02 FILLER PIC X(58) VALUE IF1014.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1014.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1014.2 +019200 02 FILLER PIC X(15) VALUE IF1014.2 +019300 " COPYRIGHT 1985". IF1014.2 +019400 01 CCVS-E-4. IF1014.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1014.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1014.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1014.2 +019800 02 FILLER PIC X(40) VALUE IF1014.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1014.2 +020000 01 XXINFO. IF1014.2 +020100 02 FILLER PIC X(19) VALUE IF1014.2 +020200 "*** INFORMATION ***". IF1014.2 +020300 02 INFO-TEXT. IF1014.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1014.2 +020500 04 XXCOMPUTED PIC X(20). IF1014.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1014.2 +020700 04 XXCORRECT PIC X(20). IF1014.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1014.2 +020900 01 HYPHEN-LINE. IF1014.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1014.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1014.2 +021200- "*****************************************". IF1014.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1014.2 +021400- "******************************". IF1014.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1014.2 +021600 "IF101A". IF1014.2 +021700 PROCEDURE DIVISION. IF1014.2 +021800 CCVS1 SECTION. IF1014.2 +021900 OPEN-FILES. IF1014.2 +022000 OPEN OUTPUT PRINT-FILE. IF1014.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1014.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1014.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1014.2 +022400 GO TO CCVS1-EXIT. IF1014.2 +022500 CLOSE-FILES. IF1014.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1014.2 +022700 TERMINATE-CCVS. IF1014.2 +022800 STOP RUN. IF1014.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1014.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1014.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1014.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1014.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1014.2 +023400 PRINT-DETAIL. IF1014.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1014.2 +023600 MOVE "." TO PARDOT-X IF1014.2 +023700 MOVE REC-CT TO DOTVALUE. IF1014.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1014.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1014.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1014.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1014.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1014.2 +024300 MOVE SPACE TO CORRECT-X. IF1014.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1014.2 +024500 MOVE SPACE TO RE-MARK. IF1014.2 +024600 HEAD-ROUTINE. IF1014.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1014.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1014.2 +025100 COLUMN-NAMES-ROUTINE. IF1014.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +025500 END-ROUTINE. IF1014.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1014.2 +025700 END-RTN-EXIT. IF1014.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +025900 END-ROUTINE-1. IF1014.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1014.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1014.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1014.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1014.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1014.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1014.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1014.2 +026700 END-ROUTINE-12. IF1014.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1014.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1014.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1014.2 +027100 ELSE IF1014.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1014.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1014.2 +027400 PERFORM WRITE-LINE. IF1014.2 +027500 END-ROUTINE-13. IF1014.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1014.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1014.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1014.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1014.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1014.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1014.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1014.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1014.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028700 WRITE-LINE. IF1014.2 +028800 ADD 1 TO RECORD-COUNT. IF1014.2 +028900Y IF RECORD-COUNT GREATER 42 IF1014.2 +029000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1014.2 +029100Y MOVE SPACE TO DUMMY-RECORD IF1014.2 +029200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1014.2 +029300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1014.2 +029400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1014.2 +029500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1014.2 +029600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1014.2 +029700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +029800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +029900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +030000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1014.2 +030100Y MOVE ZERO TO RECORD-COUNT. IF1014.2 +030200 PERFORM WRT-LN. IF1014.2 +030300 WRT-LN. IF1014.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1014.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1014.2 +030600 BLANK-LINE-PRINT. IF1014.2 +030700 PERFORM WRT-LN. IF1014.2 +030800 FAIL-ROUTINE. IF1014.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1014.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1014.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1014.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1014.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1014.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1014.2 +031600 GO TO FAIL-ROUTINE-EX. IF1014.2 +031700 FAIL-ROUTINE-WRITE. IF1014.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1014.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1014.2 +032000 CORMA-ANSI-REFERENCE. IF1014.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1014.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1014.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1014.2 +032400 ELSE IF1014.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1014.2 +032600 PERFORM WRITE-LINE. IF1014.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1014.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1014.2 +032900 BAIL-OUT. IF1014.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1014.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1014.2 +033200 BAIL-OUT-WRITE. IF1014.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1014.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1014.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1014.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1014.2 +033800 BAIL-OUT-EX. EXIT. IF1014.2 +033900 CCVS1-EXIT. IF1014.2 +034000 EXIT. IF1014.2 +034100******************************************************** IF1014.2 +034200* * IF1014.2 +034300* Intrinsic Function Tests IF101A - ACOS * IF1014.2 +034400* * IF1014.2 +034500******************************************************** IF1014.2 +034600 SECT-IF101A SECTION. IF1014.2 +034700 F-ACOS-INFO. IF1014.2 +034800 MOVE "See ref. A-33 2.5" TO ANSI-REFERENCE. IF1014.2 +034900 MOVE "ACOS Function" TO FEATURE. IF1014.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1014.2 +035100 F-ACOS-01. IF1014.2 +035200 MOVE ZERO TO WS-NUM. IF1014.2 +035300 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +035400 MOVE 0.000020 TO MAX-RANGE. IF1014.2 +035500 F-ACOS-TEST-01. IF1014.2 +035600 COMPUTE WS-NUM = FUNCTION ACOS(1.0). IF1014.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +035900 PERFORM PASS IF1014.2 +036000 ELSE IF1014.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1014.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +036400 PERFORM FAIL. IF1014.2 +036500 GO TO F-ACOS-WRITE-01. IF1014.2 +036600 F-ACOS-DELETE-01. IF1014.2 +036700 PERFORM DE-LETE. IF1014.2 +036800 GO TO F-ACOS-WRITE-01. IF1014.2 +036900 F-ACOS-WRITE-01. IF1014.2 +037000 MOVE "F-ACOS-01" TO PAR-NAME. IF1014.2 +037100 PERFORM PRINT-DETAIL. IF1014.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1014.2 +037300 F-ACOS-02. IF1014.2 +037400 MOVE 1.04718 TO MIN-RANGE. IF1014.2 +037500 MOVE 1.04722 TO MAX-RANGE. IF1014.2 +037600 F-ACOS-TEST-02. IF1014.2 +037700 IF (FUNCTION ACOS(0.5) >= MIN-RANGE) AND IF1014.2 +037800 (FUNCTION ACOS(0.5) <= MAX-RANGE) THEN IF1014.2 +037900 PERFORM PASS IF1014.2 +038000 ELSE IF1014.2 +038100 PERFORM FAIL. IF1014.2 +038200 GO TO F-ACOS-WRITE-02. IF1014.2 +038300 F-ACOS-DELETE-02. IF1014.2 +038400 PERFORM DE-LETE. IF1014.2 +038500 GO TO F-ACOS-WRITE-02. IF1014.2 +038600 F-ACOS-WRITE-02. IF1014.2 +038700 MOVE "F-ACOS-02" TO PAR-NAME. IF1014.2 +038800 PERFORM PRINT-DETAIL. IF1014.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1014.2 +039000 F-ACOS-03. IF1014.2 +039100 EVALUATE FUNCTION ACOS(0) IF1014.2 +039200 WHEN 1.57076 THRU 1.57082 IF1014.2 +039300 PERFORM PASS IF1014.2 +039400 WHEN OTHER IF1014.2 +039500 PERFORM FAIL. IF1014.2 +039600 GO TO F-ACOS-WRITE-03. IF1014.2 +039700 F-ACOS-DELETE-03. IF1014.2 +039800 PERFORM DE-LETE. IF1014.2 +039900 GO TO F-ACOS-WRITE-03. IF1014.2 +040000 F-ACOS-WRITE-03. IF1014.2 +040100 MOVE "F-ACOS-03" TO PAR-NAME. IF1014.2 +040200 PERFORM PRINT-DETAIL. IF1014.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1014.2 +040400 F-ACOS-04. IF1014.2 +040500 MOVE ZERO TO WS-NUM. IF1014.2 +040600 MOVE 3.14153 TO MIN-RANGE. IF1014.2 +040700 MOVE 3.14165 TO MAX-RANGE. IF1014.2 +040800 F-ACOS-TEST-04. IF1014.2 +040900 COMPUTE WS-NUM = FUNCTION ACOS(-1). IF1014.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +041200 PERFORM PASS IF1014.2 +041300 ELSE IF1014.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +041700 PERFORM FAIL. IF1014.2 +041800 GO TO F-ACOS-WRITE-04. IF1014.2 +041900 F-ACOS-DELETE-04. IF1014.2 +042000 PERFORM DE-LETE. IF1014.2 +042100 GO TO F-ACOS-WRITE-04. IF1014.2 +042200 F-ACOS-WRITE-04. IF1014.2 +042300 MOVE "F-ACOS-04" TO PAR-NAME. IF1014.2 +042400 PERFORM PRINT-DETAIL. IF1014.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1014.2 +042600 F-ACOS-05. IF1014.2 +042700 MOVE ZERO TO WS-NUM. IF1014.2 +042800 MOVE 0.044724 TO MIN-RANGE. IF1014.2 +042900 MOVE 0.044726 TO MAX-RANGE. IF1014.2 +043000 F-ACOS-TEST-05. IF1014.2 +043100 COMPUTE WS-NUM = FUNCTION ACOS(.999). IF1014.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +043400 PERFORM PASS IF1014.2 +043500 ELSE IF1014.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +043900 PERFORM FAIL. IF1014.2 +044000 GO TO F-ACOS-WRITE-05. IF1014.2 +044100 F-ACOS-DELETE-05. IF1014.2 +044200 PERFORM DE-LETE. IF1014.2 +044300 GO TO F-ACOS-WRITE-05. IF1014.2 +044400 F-ACOS-WRITE-05. IF1014.2 +044500 MOVE "F-ACOS-05" TO PAR-NAME. IF1014.2 +044600 PERFORM PRINT-DETAIL. IF1014.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1014.2 +044800 F-ACOS-06. IF1014.2 +044900 MOVE ZERO TO WS-NUM. IF1014.2 +045000 MOVE 1.05868 TO MIN-RANGE. IF1014.2 +045100 MOVE 1.05872 TO MAX-RANGE. IF1014.2 +045200 F-ACOS-TEST-06. IF1014.2 +045300 COMPUTE WS-NUM = FUNCTION ACOS(.49). IF1014.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +045600 PERFORM PASS IF1014.2 +045700 ELSE IF1014.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +046100 PERFORM FAIL. IF1014.2 +046200 GO TO F-ACOS-WRITE-06. IF1014.2 +046300 F-ACOS-DELETE-06. IF1014.2 +046400 PERFORM DE-LETE. IF1014.2 +046500 GO TO F-ACOS-WRITE-06. IF1014.2 +046600 F-ACOS-WRITE-06. IF1014.2 +046700 MOVE "F-ACOS-06" TO PAR-NAME. IF1014.2 +046800 PERFORM PRINT-DETAIL. IF1014.2 +046900*****************TEST (g) - SIMPLE TEST***************** IF1014.2 +047000 F-ACOS-07. IF1014.2 +047100 MOVE ZERO TO WS-NUM. IF1014.2 +047200 MOVE 1.56976 TO MIN-RANGE. IF1014.2 +047300 MOVE 1.56982 TO MAX-RANGE. IF1014.2 +047400 F-ACOS-TEST-07. IF1014.2 +047500 COMPUTE WS-NUM = FUNCTION ACOS(.001). IF1014.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +047800 PERFORM PASS IF1014.2 +047900 ELSE IF1014.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +048300 PERFORM FAIL. IF1014.2 +048400 GO TO F-ACOS-WRITE-07. IF1014.2 +048500 F-ACOS-DELETE-07. IF1014.2 +048600 PERFORM DE-LETE. IF1014.2 +048700 GO TO F-ACOS-WRITE-07. IF1014.2 +048800 F-ACOS-WRITE-07. IF1014.2 +048900 MOVE "F-ACOS-07" TO PAR-NAME. IF1014.2 +049000 PERFORM PRINT-DETAIL. IF1014.2 +049100*****************TEST (h) - SIMPLE TEST***************** IF1014.2 +049200 F-ACOS-08. IF1014.2 +049300 MOVE ZERO TO WS-NUM. IF1014.2 +049400 MOVE 3.09680 TO MIN-RANGE. IF1014.2 +049500 MOVE 3.09692 TO MAX-RANGE. IF1014.2 +049600 F-ACOS-TEST-08. IF1014.2 +049700 COMPUTE WS-NUM = FUNCTION ACOS(-.999). IF1014.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +050000 PERFORM PASS IF1014.2 +050100 ELSE IF1014.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +050500 PERFORM FAIL. IF1014.2 +050600 GO TO F-ACOS-WRITE-08. IF1014.2 +050700 F-ACOS-DELETE-08. IF1014.2 +050800 PERFORM DE-LETE. IF1014.2 +050900 GO TO F-ACOS-WRITE-08. IF1014.2 +051000 F-ACOS-WRITE-08. IF1014.2 +051100 MOVE "F-ACOS-08" TO PAR-NAME. IF1014.2 +051200 PERFORM PRINT-DETAIL. IF1014.2 +051300*****************TEST (i) - SIMPLE TEST***************** IF1014.2 +051400 F-ACOS-09. IF1014.2 +051500 MOVE ZERO TO WS-NUM. IF1014.2 +051600 MOVE 1.57080 TO MIN-RANGE. IF1014.2 +051700 MOVE 1.57086 TO MAX-RANGE. IF1014.2 +051800 F-ACOS-TEST-09. IF1014.2 +051900 COMPUTE WS-NUM = FUNCTION ACOS(A). IF1014.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +052200 PERFORM PASS IF1014.2 +052300 ELSE IF1014.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +052700 PERFORM FAIL. IF1014.2 +052800 GO TO F-ACOS-WRITE-09. IF1014.2 +052900 F-ACOS-DELETE-09. IF1014.2 +053000 PERFORM DE-LETE. IF1014.2 +053100 GO TO F-ACOS-WRITE-09. IF1014.2 +053200 F-ACOS-WRITE-09. IF1014.2 +053300 MOVE "F-ACOS-09" TO PAR-NAME. IF1014.2 +053400 PERFORM PRINT-DETAIL. IF1014.2 +053500*****************TEST (j) - SIMPLE TEST***************** IF1014.2 +053600 F-ACOS-10. IF1014.2 +053700 MOVE ZERO TO WS-NUM. IF1014.2 +053800 MOVE 1.57074 TO MIN-RANGE. IF1014.2 +053900 MOVE 1.57080 TO MAX-RANGE. IF1014.2 +054000 F-ACOS-TEST-10. IF1014.2 +054100 COMPUTE WS-NUM = FUNCTION ACOS(.00002). IF1014.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +054400 PERFORM PASS IF1014.2 +054500 ELSE IF1014.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +054900 PERFORM FAIL. IF1014.2 +055000 GO TO F-ACOS-WRITE-10. IF1014.2 +055100 F-ACOS-DELETE-10. IF1014.2 +055200 PERFORM DE-LETE. IF1014.2 +055300 GO TO F-ACOS-WRITE-10. IF1014.2 +055400 F-ACOS-WRITE-10. IF1014.2 +055500 MOVE "F-ACOS-10" TO PAR-NAME. IF1014.2 +055600 PERFORM PRINT-DETAIL. IF1014.2 +055700*****************TEST (a) - COMPLEX TEST**************** IF1014.2 +055800 F-ACOS-11. IF1014.2 +055900 MOVE ZERO TO WS-NUM. IF1014.2 +056000 MOVE 0.785367 TO MIN-RANGE. IF1014.2 +056100 MOVE 0.785429 TO MAX-RANGE. IF1014.2 +056200 F-ACOS-TEST-11. IF1014.2 +056300 COMPUTE WS-NUM = FUNCTION ACOS(1 / SQRT2). IF1014.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +056600 PERFORM PASS IF1014.2 +056700 ELSE IF1014.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +057100 PERFORM FAIL. IF1014.2 +057200 GO TO F-ACOS-WRITE-11. IF1014.2 +057300 F-ACOS-DELETE-11. IF1014.2 +057400 PERFORM DE-LETE. IF1014.2 +057500 GO TO F-ACOS-WRITE-11. IF1014.2 +057600 F-ACOS-WRITE-11. IF1014.2 +057700 MOVE "F-ACOS-11" TO PAR-NAME. IF1014.2 +057800 PERFORM PRINT-DETAIL. IF1014.2 +057900*****************TEST (b) - COMPLEX TEST**************** IF1014.2 +058000 F-ACOS-12. IF1014.2 +058100 MOVE ZERO TO WS-NUM. IF1014.2 +058200 MOVE 0.523577 TO MIN-RANGE. IF1014.2 +058300 MOVE 0.523619 TO MAX-RANGE. IF1014.2 +058400 F-ACOS-TEST-12. IF1014.2 +058500 COMPUTE WS-NUM = FUNCTION ACOS(SQRT3D2). IF1014.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +058800 PERFORM PASS IF1014.2 +058900 ELSE IF1014.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +059300 PERFORM FAIL. IF1014.2 +059400 GO TO F-ACOS-WRITE-12. IF1014.2 +059500 F-ACOS-DELETE-12. IF1014.2 +059600 PERFORM DE-LETE. IF1014.2 +059700 GO TO F-ACOS-WRITE-12. IF1014.2 +059800 F-ACOS-WRITE-12. IF1014.2 +059900 MOVE "F-ACOS-12" TO PAR-NAME. IF1014.2 +060000 PERFORM PRINT-DETAIL. IF1014.2 +060100*****************TEST (c) - COMPLEX TEST**************** IF1014.2 +060200 F-ACOS-13. IF1014.2 +060300 MOVE ZERO TO WS-NUM. IF1014.2 +060400 MOVE 1.58073 TO MIN-RANGE. IF1014.2 +060500 MOVE 1.58085 TO MAX-RANGE. IF1014.2 +060600 F-ACOS-TEST-13. IF1014.2 +060700 COMPUTE WS-NUM = FUNCTION ACOS( 1 - 1.01). IF1014.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +061000 PERFORM PASS IF1014.2 +061100 ELSE IF1014.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +061500 PERFORM FAIL. IF1014.2 +061600 GO TO F-ACOS-WRITE-13. IF1014.2 +061700 F-ACOS-DELETE-13. IF1014.2 +061800 PERFORM DE-LETE. IF1014.2 +061900 GO TO F-ACOS-WRITE-13. IF1014.2 +062000 F-ACOS-WRITE-13. IF1014.2 +062100 MOVE "F-ACOS-13" TO PAR-NAME. IF1014.2 +062200 PERFORM PRINT-DETAIL. IF1014.2 +062300*****************TEST (d) - COMPLEX TEST**************** IF1014.2 +062400 F-ACOS-14. IF1014.2 +062500 MOVE ZERO TO WS-NUM. IF1014.2 +062600 MOVE 0.141533 TO MIN-RANGE. IF1014.2 +062700 MOVE 0.141545 TO MAX-RANGE. IF1014.2 +062800 F-ACOS-TEST-14. IF1014.2 +062900 COMPUTE WS-NUM = FUNCTION ACOS(1.98 / 2). IF1014.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +063200 PERFORM PASS IF1014.2 +063300 ELSE IF1014.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +063700 PERFORM FAIL. IF1014.2 +063800 GO TO F-ACOS-WRITE-14. IF1014.2 +063900 F-ACOS-DELETE-14. IF1014.2 +064000 PERFORM DE-LETE. IF1014.2 +064100 GO TO F-ACOS-WRITE-14. IF1014.2 +064200 F-ACOS-WRITE-14. IF1014.2 +064300 MOVE "F-ACOS-14" TO PAR-NAME. IF1014.2 +064400 PERFORM PRINT-DETAIL. IF1014.2 +064500*****************TEST (e) - COMPLEX TEST**************** IF1014.2 +064600 F-ACOS-15. IF1014.2 +064700 MOVE ZERO TO WS-NUM. IF1014.2 +064800 MOVE 1.05866 TO MIN-RANGE. IF1014.2 +064900 MOVE 1.05874 TO MAX-RANGE. IF1014.2 +065000 F-ACOS-TEST-15. IF1014.2 +065100 COMPUTE WS-NUM = FUNCTION ACOS(0.2 + 0.29). IF1014.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +065400 PERFORM PASS IF1014.2 +065500 ELSE IF1014.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +065900 PERFORM FAIL. IF1014.2 +066000 GO TO F-ACOS-WRITE-15. IF1014.2 +066100 F-ACOS-DELETE-15. IF1014.2 +066200 PERFORM DE-LETE. IF1014.2 +066300 GO TO F-ACOS-WRITE-15. IF1014.2 +066400 F-ACOS-WRITE-15. IF1014.2 +066500 MOVE "F-ACOS-15" TO PAR-NAME. IF1014.2 +066600 PERFORM PRINT-DETAIL. IF1014.2 +066700*****************TEST (f) - COMPLEX TEST**************** IF1014.2 +066800 F-ACOS-16. IF1014.2 +066900 MOVE ZERO TO WS-NUM. IF1014.2 +067000 MOVE 2.99993 TO MIN-RANGE. IF1014.2 +067100 MOVE 3.00017 TO MAX-RANGE. IF1014.2 +067200 F-ACOS-TEST-16. IF1014.2 +067300 COMPUTE WS-NUM = FUNCTION ACOS(0.99 * -1). IF1014.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +067600 PERFORM PASS IF1014.2 +067700 ELSE IF1014.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +068100 PERFORM FAIL. IF1014.2 +068200 GO TO F-ACOS-WRITE-16. IF1014.2 +068300 F-ACOS-DELETE-16. IF1014.2 +068400 PERFORM DE-LETE. IF1014.2 +068500 GO TO F-ACOS-WRITE-16. IF1014.2 +068600 F-ACOS-WRITE-16. IF1014.2 +068700 MOVE "F-ACOS-16" TO PAR-NAME. IF1014.2 +068800 PERFORM PRINT-DETAIL. IF1014.2 +068900*****************TEST (g) - COMPLEX TEST**************** IF1014.2 +069000 F-ACOS-17. IF1014.2 +069100 MOVE ZERO TO WS-NUM. IF1014.2 +069200 MOVE -0.000040 TO MIN-RANGE. IF1014.2 +069300 MOVE 0.00004 TO MAX-RANGE. IF1014.2 +069400 F-ACOS-TEST-17. IF1014.2 +069500 COMPUTE WS-NUM = FUNCTION ACOS(IND (B) - 2). IF1014.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +069800 PERFORM PASS IF1014.2 +069900 ELSE IF1014.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +070300 PERFORM FAIL. IF1014.2 +070400 GO TO F-ACOS-WRITE-17. IF1014.2 +070500 F-ACOS-DELETE-17. IF1014.2 +070600 PERFORM DE-LETE. IF1014.2 +070700 GO TO F-ACOS-WRITE-17. IF1014.2 +070800 F-ACOS-WRITE-17. IF1014.2 +070900 MOVE "F-ACOS-17" TO PAR-NAME. IF1014.2 +071000 PERFORM PRINT-DETAIL. IF1014.2 +071100*****************TEST (h) - COMPLEX TEST**************** IF1014.2 +071200 F-ACOS-18. IF1014.2 +071300 MOVE ZERO TO WS-NUM. IF1014.2 +071400 MOVE 0.679646 TO MIN-RANGE. IF1014.2 +071500 MOVE 0.679700 TO MAX-RANGE. IF1014.2 +071600 F-ACOS-TEST-18. IF1014.2 +071700 COMPUTE WS-NUM = FUNCTION ACOS(IND(5) / 9). IF1014.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +072000 PERFORM PASS IF1014.2 +072100 ELSE IF1014.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +072500 PERFORM FAIL. IF1014.2 +072600 GO TO F-ACOS-WRITE-18. IF1014.2 +072700 F-ACOS-DELETE-18. IF1014.2 +072800 PERFORM DE-LETE. IF1014.2 +072900 GO TO F-ACOS-WRITE-18. IF1014.2 +073000 F-ACOS-WRITE-18. IF1014.2 +073100 MOVE "F-ACOS-18" TO PAR-NAME. IF1014.2 +073200 PERFORM PRINT-DETAIL. IF1014.2 +073300*****************TEST (i) - COMPLEX TEST**************** IF1014.2 +073400 F-ACOS-19. IF1014.2 +073500 MOVE ZERO TO WS-NUM. IF1014.2 +073600 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +073700 MOVE 0.000040 TO MAX-RANGE. IF1014.2 +073800 F-ACOS-TEST-19. IF1014.2 +073900 COMPUTE WS-NUM = FUNCTION ACOS(4 - 3). IF1014.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +074200 PERFORM PASS IF1014.2 +074300 ELSE IF1014.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +074700 PERFORM FAIL. IF1014.2 +074800 GO TO F-ACOS-WRITE-19. IF1014.2 +074900 F-ACOS-DELETE-19. IF1014.2 +075000 PERFORM DE-LETE. IF1014.2 +075100 GO TO F-ACOS-WRITE-19. IF1014.2 +075200 F-ACOS-WRITE-19. IF1014.2 +075300 MOVE "F-ACOS-19" TO PAR-NAME. IF1014.2 +075400 PERFORM PRINT-DETAIL. IF1014.2 +075500*****************TEST (j) - COMPLEX TEST**************** IF1014.2 +075600 F-ACOS-20. IF1014.2 +075700 MOVE ZERO TO WS-NUM. IF1014.2 +075800 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +075900 MOVE 0.000004 TO MAX-RANGE. IF1014.2 +076000 F-ACOS-TEST-20. IF1014.2 +076100 COMPUTE WS-NUM = FUNCTION ACOS(C / C). IF1014.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +076400 PERFORM PASS IF1014.2 +076500 ELSE IF1014.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +076900 PERFORM FAIL. IF1014.2 +077000 GO TO F-ACOS-WRITE-20. IF1014.2 +077100 F-ACOS-DELETE-20. IF1014.2 +077200 PERFORM DE-LETE. IF1014.2 +077300 GO TO F-ACOS-WRITE-20. IF1014.2 +077400 F-ACOS-WRITE-20. IF1014.2 +077500 MOVE "F-ACOS-20" TO PAR-NAME. IF1014.2 +077600 PERFORM PRINT-DETAIL. IF1014.2 +077700*****************TEST (k) - COMPLEX TEST**************** IF1014.2 +077800 F-ACOS-21. IF1014.2 +077900 MOVE ZERO TO WS-NUM. IF1014.2 +078000 MOVE 1.31806 TO MIN-RANGE. IF1014.2 +078100 MOVE 1.31816 TO MAX-RANGE. IF1014.2 +078200 F-ACOS-TEST-21. IF1014.2 +078300 COMPUTE WS-NUM = FUNCTION ACOS(0.25 * 1). IF1014.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +078600 PERFORM PASS IF1014.2 +078700 ELSE IF1014.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +079100 PERFORM FAIL. IF1014.2 +079200 GO TO F-ACOS-WRITE-21. IF1014.2 +079300 F-ACOS-DELETE-21. IF1014.2 +079400 PERFORM DE-LETE. IF1014.2 +079500 GO TO F-ACOS-WRITE-21. IF1014.2 +079600 F-ACOS-WRITE-21. IF1014.2 +079700 MOVE "F-ACOS-21" TO PAR-NAME. IF1014.2 +079800 PERFORM PRINT-DETAIL. IF1014.2 +079900*****************TEST (l) - COMPLEX TEST**************** IF1014.2 +080000 F-ACOS-22. IF1014.2 +080100 MOVE ZERO TO WS-NUM. IF1014.2 +080200 MOVE 1.57073 TO MIN-RANGE. IF1014.2 +080300 MOVE 1.57085 TO MAX-RANGE. IF1014.2 +080400 F-ACOS-TEST-22. IF1014.2 +080500 COMPUTE WS-NUM = FUNCTION ACOS((D / D) - 1). IF1014.2 +080600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +080700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +080800 PERFORM PASS IF1014.2 +080900 ELSE IF1014.2 +081000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +081100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +081200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +081300 PERFORM FAIL. IF1014.2 +081400 GO TO F-ACOS-WRITE-22. IF1014.2 +081500 F-ACOS-DELETE-22. IF1014.2 +081600 PERFORM DE-LETE. IF1014.2 +081700 GO TO F-ACOS-WRITE-22. IF1014.2 +081800 F-ACOS-WRITE-22. IF1014.2 +081900 MOVE "F-ACOS-22" TO PAR-NAME. IF1014.2 +082000 PERFORM PRINT-DETAIL. IF1014.2 +082100*****************TEST (m) - COMPLEX TEST**************** IF1014.2 +082200 F-ACOS-23. IF1014.2 +082300 MOVE ZERO TO WS-NUM. IF1014.2 +082400 MOVE 2.60285 TO MIN-RANGE. IF1014.2 +082500 MOVE 2.60305 TO MAX-RANGE. IF1014.2 +082600 F-ACOS-TEST-23. IF1014.2 +082700 COMPUTE WS-NUM = FUNCTION ACOS(PI - 4). IF1014.2 +082800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +082900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +083000 PERFORM PASS IF1014.2 +083100 ELSE IF1014.2 +083200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +083300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +083400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +083500 PERFORM FAIL. IF1014.2 +083600 GO TO F-ACOS-WRITE-23. IF1014.2 +083700 F-ACOS-DELETE-23. IF1014.2 +083800 PERFORM DE-LETE. IF1014.2 +083900 GO TO F-ACOS-WRITE-23. IF1014.2 +084000 F-ACOS-WRITE-23. IF1014.2 +084100 MOVE "F-ACOS-23" TO PAR-NAME. IF1014.2 +084200 PERFORM PRINT-DETAIL. IF1014.2 +084300*****************TEST (n) - COMPLEX TEST**************** IF1014.2 +084400 F-ACOS-24. IF1014.2 +084500 MOVE ZERO TO WS-NUM. IF1014.2 +084600 MOVE 1.57073 TO MIN-RANGE. IF1014.2 +084700 MOVE 1.57085 TO MAX-RANGE. IF1014.2 +084800 F-ACOS-TEST-24. IF1014.2 +084900 COMPUTE WS-NUM = FUNCTION ACOS(FUNCTION ACOS(D / D)). IF1014.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +085200 PERFORM PASS IF1014.2 +085300 ELSE IF1014.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +085700 PERFORM FAIL. IF1014.2 +085800 GO TO F-ACOS-WRITE-24. IF1014.2 +085900 F-ACOS-DELETE-24. IF1014.2 +086000 PERFORM DE-LETE. IF1014.2 +086100 GO TO F-ACOS-WRITE-24. IF1014.2 +086200 F-ACOS-WRITE-24. IF1014.2 +086300 MOVE "F-ACOS-24" TO PAR-NAME. IF1014.2 +086400 PERFORM PRINT-DETAIL. IF1014.2 +086500*****************TEST (o) - COMPLEX TEST**************** IF1014.2 +086600 F-ACOS-25. IF1014.2 +086700 MOVE ZERO TO WS-NUM. IF1014.2 +086800 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +086900 MOVE 0.000040 TO MAX-RANGE. IF1014.2 +087000 F-ACOS-TEST-25. IF1014.2 +087100 COMPUTE WS-NUM = FUNCTION ACOS(D / D) + FUNCTION ACOS(D / D).IF1014.2 +087200 IF1014.2 +087300 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +087400 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +087500 PERFORM PASS IF1014.2 +087600 ELSE IF1014.2 +087700 MOVE WS-NUM TO COMPUTED-N IF1014.2 +087800 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +087900 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +088000 PERFORM FAIL. IF1014.2 +088100 GO TO F-ACOS-WRITE-25. IF1014.2 +088200 F-ACOS-DELETE-25. IF1014.2 +088300 PERFORM DE-LETE. IF1014.2 +088400 GO TO F-ACOS-WRITE-25. IF1014.2 +088500 F-ACOS-WRITE-25. IF1014.2 +088600 MOVE "F-ACOS-25" TO PAR-NAME. IF1014.2 +088700 PERFORM PRINT-DETAIL. IF1014.2 +088800*****************SPECIAL PERFORM TEST********************** IF1014.2 +088900 F-ACOS-26. IF1014.2 +089000 MOVE ZERO TO ARG1. IF1014.2 +089100 PERFORM F-ACOS-TEST-26 IF1014.2 +089200 UNTIL FUNCTION ACOS(ARG1) < 1. IF1014.2 +089300 PERFORM PASS. IF1014.2 +089400 GO TO F-ACOS-WRITE-26. IF1014.2 +089500 F-ACOS-TEST-26. IF1014.2 +089600 COMPUTE ARG1 = ARG1 + 0.25. IF1014.2 +089700 F-ACOS-DELETE-26. IF1014.2 +089800 PERFORM DE-LETE. IF1014.2 +089900 GO TO F-ACOS-WRITE-26. IF1014.2 +090000 F-ACOS-WRITE-26. IF1014.2 +090100 MOVE "F-ACOS-26" TO PAR-NAME. IF1014.2 +090200 PERFORM PRINT-DETAIL. IF1014.2 +090300********************END OF TESTS*************** IF1014.2 +090400 CCVS-EXIT SECTION. IF1014.2 +090500 CCVS-999999. IF1014.2 +090600 GO TO CLOSE-FILES. IF1014.2 +*END-OF,IF101A +*HEADER,COBOL,IF102A +000100 IDENTIFICATION DIVISION. IF1024.2 +000200 PROGRAM-ID. IF1024.2 +000300 IF102A. IF1024.2 +000400 IF1024.2 +000500*********************************************************** IF1024.2 +000600* * IF1024.2 +000700* This program is intended to form part of the CCVS85 * IF1024.2 +000800* COBOL Test Suite. It contains tests for the * IF1024.2 +000900* Intrinsic Function ANNUITY. * IF1024.2 +001000* * IF1024.2 +001100*********************************************************** IF1024.2 +001200 ENVIRONMENT DIVISION. IF1024.2 +001300 CONFIGURATION SECTION. IF1024.2 +001400 SOURCE-COMPUTER. IF1024.2 +001500 XXXXX082. IF1024.2 +001600 OBJECT-COMPUTER. IF1024.2 +001700 XXXXX083. IF1024.2 +001800 INPUT-OUTPUT SECTION. IF1024.2 +001900 FILE-CONTROL. IF1024.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1024.2 +002100 XXXXX055. IF1024.2 +002200 DATA DIVISION. IF1024.2 +002300 FILE SECTION. IF1024.2 +002400 FD PRINT-FILE. IF1024.2 +002500 01 PRINT-REC PICTURE X(120). IF1024.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1024.2 +002700 WORKING-STORAGE SECTION. IF1024.2 +002800*********************************************************** IF1024.2 +002900* Variables specific to the Intrinsic Function Test IF102A* IF1024.2 +003000*********************************************************** IF1024.2 +003100 01 A PIC S9(10) VALUE 4. IF1024.2 +003200 01 B PIC S9(5)V9(5) VALUE .25. IF1024.2 +003300 01 C PIC S9(10) VALUE 10. IF1024.2 +003400 01 D PIC S9(10) VALUE 100. IF1024.2 +003500 01 ARG2 PIC S9(10) VALUE 1. IF1024.2 +003600 01 ARR VALUE "40537". IF1024.2 +003700 02 IND OCCURS 5 TIMES PIC 9. IF1024.2 +003800 01 TEMP PIC S9(5)V9(5). IF1024.2 +003900 01 WS-NUM PIC S9(5)V9(6). IF1024.2 +004000 01 MIN-RANGE PIC S9(5)V9(7). IF1024.2 +004100 01 MAX-RANGE PIC S9(5)V9(7). IF1024.2 +004200* IF1024.2 +004300********************************************************** IF1024.2 +004400* IF1024.2 +004500 01 TEST-RESULTS. IF1024.2 +004600 02 FILLER PIC X VALUE SPACE. IF1024.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1024.2 +004800 02 FILLER PIC X VALUE SPACE. IF1024.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1024.2 +005000 02 FILLER PIC X VALUE SPACE. IF1024.2 +005100 02 PAR-NAME. IF1024.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1024.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1024.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1024.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1024.2 +005600 02 RE-MARK PIC X(61). IF1024.2 +005700 01 TEST-COMPUTED. IF1024.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +005900 02 FILLER PIC X(17) VALUE IF1024.2 +006000 " COMPUTED=". IF1024.2 +006100 02 COMPUTED-X. IF1024.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1024.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1024.2 +006400 PIC -9(9).9(9). IF1024.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1024.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1024.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1024.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1024.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1024.2 +007000 04 FILLER PIC X. IF1024.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1024.2 +007200 01 TEST-CORRECT. IF1024.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1024.2 +007500 02 CORRECT-X. IF1024.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1024.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1024.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1024.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1024.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1024.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1024.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1024.2 +008300 04 FILLER PIC X. IF1024.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1024.2 +008600 01 TEST-CORRECT-MIN. IF1024.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +008800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1024.2 +008900 02 CORRECTMI-X. IF1024.2 +009000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1024.2 +009100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1024.2 +009200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1024.2 +009300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1024.2 +009400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1024.2 +009500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1024.2 +009600 04 CORRECTMI-18V0 PIC -9(18). IF1024.2 +009700 04 FILLER PIC X. IF1024.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +009900 03 FILLER PIC X(48) VALUE SPACE. IF1024.2 +010000 01 TEST-CORRECT-MAX. IF1024.2 +010100 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +010200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1024.2 +010300 02 CORRECTMA-X. IF1024.2 +010400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1024.2 +010500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1024.2 +010600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1024.2 +010700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1024.2 +010800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1024.2 +010900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1024.2 +011000 04 CORRECTMA-18V0 PIC -9(18). IF1024.2 +011100 04 FILLER PIC X. IF1024.2 +011200 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +011300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1024.2 +011400 01 CCVS-C-1. IF1024.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1024.2 +011600- "SS PARAGRAPH-NAME IF1024.2 +011700- " REMARKS". IF1024.2 +011800 02 FILLER PIC X(20) VALUE SPACE. IF1024.2 +011900 01 CCVS-C-2. IF1024.2 +012000 02 FILLER PIC X VALUE SPACE. IF1024.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". IF1024.2 +012200 02 FILLER PIC X(15) VALUE SPACE. IF1024.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". IF1024.2 +012400 02 FILLER PIC X(94) VALUE SPACE. IF1024.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1024.2 +012600 01 REC-CT PIC 99 VALUE ZERO. IF1024.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1024.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1024.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1024.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1024.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1024.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1024.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1024.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1024.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1024.2 +013600 01 CCVS-H-1. IF1024.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1024.2 +013800 02 FILLER PIC X(42) VALUE IF1024.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1024.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1024.2 +014100 01 CCVS-H-2A. IF1024.2 +014200 02 FILLER PIC X(40) VALUE SPACE. IF1024.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1024.2 +014400 02 FILLER PIC XXXX VALUE IF1024.2 +014500 "4.2 ". IF1024.2 +014600 02 FILLER PIC X(28) VALUE IF1024.2 +014700 " COPY - NOT FOR DISTRIBUTION". IF1024.2 +014800 02 FILLER PIC X(41) VALUE SPACE. IF1024.2 +014900 IF1024.2 +015000 01 CCVS-H-2B. IF1024.2 +015100 02 FILLER PIC X(15) VALUE IF1024.2 +015200 "TEST RESULT OF ". IF1024.2 +015300 02 TEST-ID PIC X(9). IF1024.2 +015400 02 FILLER PIC X(4) VALUE IF1024.2 +015500 " IN ". IF1024.2 +015600 02 FILLER PIC X(12) VALUE IF1024.2 +015700 " HIGH ". IF1024.2 +015800 02 FILLER PIC X(22) VALUE IF1024.2 +015900 " LEVEL VALIDATION FOR ". IF1024.2 +016000 02 FILLER PIC X(58) VALUE IF1024.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1024.2 +016200 01 CCVS-H-3. IF1024.2 +016300 02 FILLER PIC X(34) VALUE IF1024.2 +016400 " FOR OFFICIAL USE ONLY ". IF1024.2 +016500 02 FILLER PIC X(58) VALUE IF1024.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1024.2 +016700 02 FILLER PIC X(28) VALUE IF1024.2 +016800 " COPYRIGHT 1985 ". IF1024.2 +016900 01 CCVS-E-1. IF1024.2 +017000 02 FILLER PIC X(52) VALUE SPACE. IF1024.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1024.2 +017200 02 ID-AGAIN PIC X(9). IF1024.2 +017300 02 FILLER PIC X(45) VALUE SPACES. IF1024.2 +017400 01 CCVS-E-2. IF1024.2 +017500 02 FILLER PIC X(31) VALUE SPACE. IF1024.2 +017600 02 FILLER PIC X(21) VALUE SPACE. IF1024.2 +017700 02 CCVS-E-2-2. IF1024.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1024.2 +017900 03 FILLER PIC X VALUE SPACE. IF1024.2 +018000 03 ENDER-DESC PIC X(44) VALUE IF1024.2 +018100 "ERRORS ENCOUNTERED". IF1024.2 +018200 01 CCVS-E-3. IF1024.2 +018300 02 FILLER PIC X(22) VALUE IF1024.2 +018400 " FOR OFFICIAL USE ONLY". IF1024.2 +018500 02 FILLER PIC X(12) VALUE SPACE. IF1024.2 +018600 02 FILLER PIC X(58) VALUE IF1024.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1024.2 +018800 02 FILLER PIC X(13) VALUE SPACE. IF1024.2 +018900 02 FILLER PIC X(15) VALUE IF1024.2 +019000 " COPYRIGHT 1985". IF1024.2 +019100 01 CCVS-E-4. IF1024.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1024.2 +019300 02 FILLER PIC X(4) VALUE " OF ". IF1024.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1024.2 +019500 02 FILLER PIC X(40) VALUE IF1024.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1024.2 +019700 01 XXINFO. IF1024.2 +019800 02 FILLER PIC X(19) VALUE IF1024.2 +019900 "*** INFORMATION ***". IF1024.2 +020000 02 INFO-TEXT. IF1024.2 +020100 04 FILLER PIC X(8) VALUE SPACE. IF1024.2 +020200 04 XXCOMPUTED PIC X(20). IF1024.2 +020300 04 FILLER PIC X(5) VALUE SPACE. IF1024.2 +020400 04 XXCORRECT PIC X(20). IF1024.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). IF1024.2 +020600 01 HYPHEN-LINE. IF1024.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. IF1024.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************IF1024.2 +020900- "*****************************************". IF1024.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************IF1024.2 +021100- "******************************". IF1024.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE IF1024.2 +021300 "IF102A". IF1024.2 +021400 PROCEDURE DIVISION. IF1024.2 +021500 CCVS1 SECTION. IF1024.2 +021600 OPEN-FILES. IF1024.2 +021700 OPEN OUTPUT PRINT-FILE. IF1024.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1024.2 +021900 MOVE SPACE TO TEST-RESULTS. IF1024.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1024.2 +022100 GO TO CCVS1-EXIT. IF1024.2 +022200 CLOSE-FILES. IF1024.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1024.2 +022400 TERMINATE-CCVS. IF1024.2 +022500 STOP RUN. IF1024.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1024.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1024.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1024.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1024.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. IF1024.2 +023100 PRINT-DETAIL. IF1024.2 +023200 IF REC-CT NOT EQUAL TO ZERO IF1024.2 +023300 MOVE "." TO PARDOT-X IF1024.2 +023400 MOVE REC-CT TO DOTVALUE. IF1024.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1024.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1024.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1024.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1024.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1024.2 +024000 MOVE SPACE TO CORRECT-X. IF1024.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1024.2 +024200 MOVE SPACE TO RE-MARK. IF1024.2 +024300 HEAD-ROUTINE. IF1024.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1024.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1024.2 +024800 COLUMN-NAMES-ROUTINE. IF1024.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +025200 END-ROUTINE. IF1024.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1024.2 +025400 END-RTN-EXIT. IF1024.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +025600 END-ROUTINE-1. IF1024.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1024.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1024.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. IF1024.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1024.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1024.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1024.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1024.2 +026400 END-ROUTINE-12. IF1024.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1024.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1024.2 +026700 MOVE "NO " TO ERROR-TOTAL IF1024.2 +026800 ELSE IF1024.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1024.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1024.2 +027100 PERFORM WRITE-LINE. IF1024.2 +027200 END-ROUTINE-13. IF1024.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1024.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE IF1024.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1024.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1024.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO IF1024.2 +027900 MOVE "NO " TO ERROR-TOTAL IF1024.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1024.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1024.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +028400 WRITE-LINE. IF1024.2 +028500 ADD 1 TO RECORD-COUNT. IF1024.2 +028600Y IF RECORD-COUNT GREATER 42 IF1024.2 +028700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1024.2 +028800Y MOVE SPACE TO DUMMY-RECORD IF1024.2 +028900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1024.2 +029000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1024.2 +029100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1024.2 +029200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1024.2 +029300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1024.2 +029400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1024.2 +029800Y MOVE ZERO TO RECORD-COUNT. IF1024.2 +029900 PERFORM WRT-LN. IF1024.2 +030000 WRT-LN. IF1024.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1024.2 +030200 MOVE SPACE TO DUMMY-RECORD. IF1024.2 +030300 BLANK-LINE-PRINT. IF1024.2 +030400 PERFORM WRT-LN. IF1024.2 +030500 FAIL-ROUTINE. IF1024.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE IF1024.2 +030700 GO TO FAIL-ROUTINE-WRITE. IF1024.2 +030800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1024.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1024.2 +031000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1024.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1024.2 +031300 GO TO FAIL-ROUTINE-EX. IF1024.2 +031400 FAIL-ROUTINE-WRITE. IF1024.2 +031500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1024.2 +031600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1024.2 +031700 CORMA-ANSI-REFERENCE. IF1024.2 +031800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1024.2 +031900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1024.2 +032000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1024.2 +032100 ELSE IF1024.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1024.2 +032300 PERFORM WRITE-LINE. IF1024.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1024.2 +032500 FAIL-ROUTINE-EX. EXIT. IF1024.2 +032600 BAIL-OUT. IF1024.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1024.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1024.2 +032900 BAIL-OUT-WRITE. IF1024.2 +033000 MOVE CORRECT-A TO XXCORRECT. IF1024.2 +033100 MOVE COMPUTED-A TO XXCOMPUTED. IF1024.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1024.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1024.2 +033500 BAIL-OUT-EX. EXIT. IF1024.2 +033600 CCVS1-EXIT. IF1024.2 +033700 EXIT. IF1024.2 +033800******************************************************** IF1024.2 +033900* * IF1024.2 +034000* Intrinsic Function Tests IF102A - ANNUITY * IF1024.2 +034100* * IF1024.2 +034200******************************************************** IF1024.2 +034300 SECT-IF102A SECTION. IF1024.2 +034400 F-ANNUITY-INFO. IF1024.2 +034500 MOVE "See ref. A-34 2.6" TO ANSI-REFERENCE. IF1024.2 +034600 MOVE "ANNUITY Function" TO FEATURE. IF1024.2 +034700*****************TEST (a) - SIMPLE TEST***************** IF1024.2 +034800 F-ANNUITY-01. IF1024.2 +034900 MOVE ZERO TO WS-NUM. IF1024.2 +035000 MOVE 0.249995 TO MIN-RANGE. IF1024.2 +035100 MOVE 0.250005 TO MAX-RANGE. IF1024.2 +035200 F-ANNUITY-TEST-01. IF1024.2 +035300 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 4). IF1024.2 +035400 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +035500 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +035600 PERFORM PASS IF1024.2 +035700 ELSE IF1024.2 +035800 MOVE WS-NUM TO COMPUTED-N IF1024.2 +035900 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +036000 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +036100 PERFORM FAIL. IF1024.2 +036200 GO TO F-ANNUITY-WRITE-01. IF1024.2 +036300 F-ANNUITY-DELETE-01. IF1024.2 +036400 PERFORM DE-LETE. IF1024.2 +036500 GO TO F-ANNUITY-WRITE-01. IF1024.2 +036600 F-ANNUITY-WRITE-01. IF1024.2 +036700 MOVE "F-ANNUITY-01" TO PAR-NAME. IF1024.2 +036800 PERFORM PRINT-DETAIL. IF1024.2 +036900*****************TEST (b) - SIMPLE TEST***************** IF1024.2 +037000 F-ANNUITY-02. IF1024.2 +037100 EVALUATE FUNCTION ANNUITY(2.9, 4) IF1024.2 +037200 WHEN 2.91252 THRU 2.91264 IF1024.2 +037300 PERFORM PASS IF1024.2 +037400 WHEN OTHER IF1024.2 +037500 PERFORM FAIL. IF1024.2 +037600 GO TO F-ANNUITY-WRITE-02. IF1024.2 +037700 F-ANNUITY-DELETE-02. IF1024.2 +037800 PERFORM DE-LETE. IF1024.2 +037900 GO TO F-ANNUITY-WRITE-02. IF1024.2 +038000 F-ANNUITY-WRITE-02. IF1024.2 +038100 MOVE "F-ANNUITY-02" TO PAR-NAME. IF1024.2 +038200 PERFORM PRINT-DETAIL. IF1024.2 +038300*****************TEST (c) - SIMPLE TEST***************** IF1024.2 +038400 F-ANNUITY-03. IF1024.2 +038500 MOVE 0.308663 TO MIN-RANGE. IF1024.2 +038600 MOVE 0.308675 TO MAX-RANGE. IF1024.2 +038700 F-ANNUITY-TEST-03. IF1024.2 +038800 IF (FUNCTION ANNUITY(.09, A) >= MIN-RANGE) AND IF1024.2 +038900 (FUNCTION ANNUITY(.09, A) <= MAX-RANGE) THEN IF1024.2 +039000 PERFORM PASS IF1024.2 +039100 ELSE IF1024.2 +039200 PERFORM FAIL. IF1024.2 +039300 GO TO F-ANNUITY-WRITE-03. IF1024.2 +039400 F-ANNUITY-DELETE-03. IF1024.2 +039500 PERFORM DE-LETE. IF1024.2 +039600 GO TO F-ANNUITY-WRITE-03. IF1024.2 +039700 F-ANNUITY-WRITE-03. IF1024.2 +039800 MOVE "F-ANNUITY-03" TO PAR-NAME. IF1024.2 +039900 PERFORM PRINT-DETAIL. IF1024.2 +040000*****************TEST (d) - SIMPLE TEST***************** IF1024.2 +040100 F-ANNUITY-04. IF1024.2 +040200 MOVE ZERO TO WS-NUM. IF1024.2 +040300 MOVE 0.694430 TO MIN-RANGE. IF1024.2 +040400 MOVE 0.694458 TO MAX-RANGE. IF1024.2 +040500 F-ANNUITY-TEST-04. IF1024.2 +040600 COMPUTE WS-NUM = FUNCTION ANNUITY(B, 2). IF1024.2 +040700 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +040800 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +040900 PERFORM PASS IF1024.2 +041000 ELSE IF1024.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1024.2 +041200 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +041300 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +041400 PERFORM FAIL. IF1024.2 +041500 GO TO F-ANNUITY-WRITE-04. IF1024.2 +041600 F-ANNUITY-DELETE-04. IF1024.2 +041700 PERFORM DE-LETE. IF1024.2 +041800 GO TO F-ANNUITY-WRITE-04. IF1024.2 +041900 F-ANNUITY-WRITE-04. IF1024.2 +042000 MOVE "F-ANNUITY-04" TO PAR-NAME. IF1024.2 +042100 PERFORM PRINT-DETAIL. IF1024.2 +042200*****************TEST (e) - SIMPLE TEST***************** IF1024.2 +042300 F-ANNUITY-05. IF1024.2 +042400 MOVE ZERO TO WS-NUM. IF1024.2 +042500 MOVE 0.423434 TO MIN-RANGE. IF1024.2 +042600 MOVE 0.423450 TO MAX-RANGE. IF1024.2 +042700 F-ANNUITY-TEST-05. IF1024.2 +042800 COMPUTE WS-NUM = FUNCTION ANNUITY(B, 4). IF1024.2 +042900 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +043000 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +043100 PERFORM PASS IF1024.2 +043200 ELSE IF1024.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1024.2 +043400 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +043500 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +043600 PERFORM FAIL. IF1024.2 +043700 GO TO F-ANNUITY-WRITE-05. IF1024.2 +043800 F-ANNUITY-DELETE-05. IF1024.2 +043900 PERFORM DE-LETE. IF1024.2 +044000 GO TO F-ANNUITY-WRITE-05. IF1024.2 +044100 F-ANNUITY-WRITE-05. IF1024.2 +044200 MOVE "F-ANNUITY-05" TO PAR-NAME. IF1024.2 +044300 PERFORM PRINT-DETAIL. IF1024.2 +044400*****************TEST (f) - SIMPLE TEST***************** IF1024.2 +044500 F-ANNUITY-06. IF1024.2 +044600 MOVE ZERO TO WS-NUM. IF1024.2 +044700 MOVE 3.99992 TO MIN-RANGE. IF1024.2 +044800 MOVE 4.00008 TO MAX-RANGE. IF1024.2 +044900 F-ANNUITY-TEST-06. IF1024.2 +045000 COMPUTE WS-NUM = FUNCTION ANNUITY(A, 9). IF1024.2 +045100 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +045200 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +045300 PERFORM PASS IF1024.2 +045400 ELSE IF1024.2 +045500 MOVE WS-NUM TO COMPUTED-N IF1024.2 +045600 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +045700 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +045800 PERFORM FAIL. IF1024.2 +045900 GO TO F-ANNUITY-WRITE-06. IF1024.2 +046000 F-ANNUITY-DELETE-06. IF1024.2 +046100 PERFORM DE-LETE. IF1024.2 +046200 GO TO F-ANNUITY-WRITE-06. IF1024.2 +046300 F-ANNUITY-WRITE-06. IF1024.2 +046400 MOVE "F-ANNUITY-06" TO PAR-NAME. IF1024.2 +046500 PERFORM PRINT-DETAIL. IF1024.2 +046600*****************TEST (g) -SIMPLE TEST****************** IF1024.2 +046700 F-ANNUITY-07. IF1024.2 +046800 MOVE ZERO TO WS-NUM. IF1024.2 +046900 MOVE 5.00054 TO MIN-RANGE. IF1024.2 +047000 MOVE 5.00074 TO MAX-RANGE. IF1024.2 +047100 F-ANNUITY-TEST-07. IF1024.2 +047200 COMPUTE WS-NUM = FUNCTION ANNUITY(5, 5). IF1024.2 +047300 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +047400 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +047500 PERFORM PASS IF1024.2 +047600 ELSE IF1024.2 +047700 MOVE WS-NUM TO COMPUTED-N IF1024.2 +047800 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +047900 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +048000 PERFORM FAIL. IF1024.2 +048100 GO TO F-ANNUITY-WRITE-07. IF1024.2 +048200 F-ANNUITY-DELETE-07. IF1024.2 +048300 PERFORM DE-LETE. IF1024.2 +048400 GO TO F-ANNUITY-WRITE-07. IF1024.2 +048500 F-ANNUITY-WRITE-07. IF1024.2 +048600 MOVE "F-ANNUITY-07" TO PAR-NAME. IF1024.2 +048700 PERFORM PRINT-DETAIL. IF1024.2 +048800*****************TEST (h) - SIMPLE TEST***************** IF1024.2 +048900 F-ANNUITY-08. IF1024.2 +049000 MOVE ZERO TO WS-NUM. IF1024.2 +049100 MOVE 4.03217 TO MIN-RANGE. IF1024.2 +049200 MOVE 4.03233 TO MAX-RANGE. IF1024.2 +049300 F-ANNUITY-TEST-08. IF1024.2 +049400 COMPUTE WS-NUM = FUNCTION ANNUITY(IND(1), IND(A)). IF1024.2 +049500 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +049600 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +049700 PERFORM PASS IF1024.2 +049800 ELSE IF1024.2 +049900 MOVE WS-NUM TO COMPUTED-N IF1024.2 +050000 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +050100 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +050200 PERFORM FAIL. IF1024.2 +050300 GO TO F-ANNUITY-WRITE-08. IF1024.2 +050400 F-ANNUITY-DELETE-08. IF1024.2 +050500 PERFORM DE-LETE. IF1024.2 +050600 GO TO F-ANNUITY-WRITE-08. IF1024.2 +050700 F-ANNUITY-WRITE-08. IF1024.2 +050800 MOVE "F-ANNUITY-08" TO PAR-NAME. IF1024.2 +050900 PERFORM PRINT-DETAIL. IF1024.2 +051000*****************TEST (a) - COMPLEX TEST**************** IF1024.2 +051100 F-ANNUITY-09. IF1024.2 +051200 MOVE ZERO TO WS-NUM. IF1024.2 +051300 MOVE 0.204824 TO MIN-RANGE. IF1024.2 +051400 MOVE 0.204840 TO MAX-RANGE. IF1024.2 +051500 F-ANNUITY-TEST-09. IF1024.2 +051600 COMPUTE WS-NUM = FUNCTION ANNUITY(B / 2, 8). IF1024.2 +051700 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +051800 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +051900 PERFORM PASS IF1024.2 +052000 ELSE IF1024.2 +052100 MOVE WS-NUM TO COMPUTED-N IF1024.2 +052200 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +052300 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +052400 PERFORM FAIL. IF1024.2 +052500 GO TO F-ANNUITY-WRITE-09. IF1024.2 +052600 F-ANNUITY-DELETE-09. IF1024.2 +052700 PERFORM DE-LETE. IF1024.2 +052800 GO TO F-ANNUITY-WRITE-09. IF1024.2 +052900 F-ANNUITY-WRITE-09. IF1024.2 +053000 MOVE "F-ANNUITY-09" TO PAR-NAME. IF1024.2 +053100 PERFORM PRINT-DETAIL. IF1024.2 +053200*****************TEST (b) - COMPLEX TEST**************** IF1024.2 +053300 F-ANNUITY-10. IF1024.2 +053400 MOVE ZERO TO WS-NUM. IF1024.2 +053500 MOVE 0.576553 TO MIN-RANGE. IF1024.2 +053600 MOVE 0.576599 TO MAX-RANGE. IF1024.2 +053700 F-ANNUITY-TEST-10. IF1024.2 +053800 COMPUTE WS-NUM = FUNCTION ANNUITY( IF1024.2 +053900 FUNCTION ANNUITY(0, 3), 3). IF1024.2 +054000 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +054100 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +054200 PERFORM PASS IF1024.2 +054300 ELSE IF1024.2 +054400 MOVE WS-NUM TO COMPUTED-N IF1024.2 +054500 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +054600 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +054700 PERFORM FAIL. IF1024.2 +054800 GO TO F-ANNUITY-WRITE-10. IF1024.2 +054900 F-ANNUITY-DELETE-10. IF1024.2 +055000 PERFORM DE-LETE. IF1024.2 +055100 GO TO F-ANNUITY-WRITE-10. IF1024.2 +055200 F-ANNUITY-WRITE-10. IF1024.2 +055300 MOVE "F-ANNUITY-10" TO PAR-NAME. IF1024.2 +055400 PERFORM PRINT-DETAIL. IF1024.2 +055500*****************TEST (c) - COMPLEX TEST**************** IF1024.2 +055600 F-ANNUITY-11. IF1024.2 +055700 MOVE ZERO TO WS-NUM. IF1024.2 +055800 MOVE 4.49978 TO MIN-RANGE. IF1024.2 +055900 MOVE 5.50022 TO MAX-RANGE. IF1024.2 +056000 F-ANNUITY-TEST-11. IF1024.2 +056100 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 2) + 5. IF1024.2 +056200 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +056300 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +056400 PERFORM PASS IF1024.2 +056500 ELSE IF1024.2 +056600 MOVE WS-NUM TO COMPUTED-N IF1024.2 +056700 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +056800 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +056900 PERFORM FAIL. IF1024.2 +057000 GO TO F-ANNUITY-WRITE-11. IF1024.2 +057100 F-ANNUITY-DELETE-11. IF1024.2 +057200 PERFORM DE-LETE. IF1024.2 +057300 GO TO F-ANNUITY-WRITE-11. IF1024.2 +057400 F-ANNUITY-WRITE-11. IF1024.2 +057500 MOVE "F-ANNUITY-11" TO PAR-NAME. IF1024.2 +057600 PERFORM PRINT-DETAIL. IF1024.2 +057700*****************TEST (d) - COMPLEX TEST**************** IF1024.2 +057800 F-ANNUITY-12. IF1024.2 +057900 MOVE ZERO TO WS-NUM. IF1024.2 +058000 MOVE 0.999960 TO MIN-RANGE. IF1024.2 +058100 MOVE 1.00004 TO MAX-RANGE. IF1024.2 +058200 F-ANNUITY-TEST-12. IF1024.2 +058300 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 2) + IF1024.2 +058400 FUNCTION ANNUITY(0, 2). IF1024.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +058700 PERFORM PASS IF1024.2 +058800 ELSE IF1024.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1024.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +059200 PERFORM FAIL. IF1024.2 +059300 GO TO F-ANNUITY-WRITE-12. IF1024.2 +059400 F-ANNUITY-DELETE-12. IF1024.2 +059500 PERFORM DE-LETE. IF1024.2 +059600 GO TO F-ANNUITY-WRITE-12. IF1024.2 +059700 F-ANNUITY-WRITE-12. IF1024.2 +059800 MOVE "F-ANNUITY-12" TO PAR-NAME. IF1024.2 +059900 PERFORM PRINT-DETAIL. IF1024.2 +060000*****************SPECIAL PERFORM TEST********************** IF1024.2 +060100 F-ANNUITY-13. IF1024.2 +060200 PERFORM F-ANNUITY-TEST-13 IF1024.2 +060300 UNTIL FUNCTION ANNUITY(0, ARG2) < .25. IF1024.2 +060400 PERFORM PASS. IF1024.2 +060500 GO TO F-ANNUITY-WRITE-13. IF1024.2 +060600 F-ANNUITY-TEST-13. IF1024.2 +060700 COMPUTE ARG2 = ARG2 + 1. IF1024.2 +060800 F-ANNUITY-DELETE-13. IF1024.2 +060900 PERFORM DE-LETE. IF1024.2 +061000 GO TO F-ANNUITY-WRITE-13. IF1024.2 +061100 F-ANNUITY-WRITE-13. IF1024.2 +061200 MOVE "F-ANNUITY-13" TO PAR-NAME. IF1024.2 +061300 PERFORM PRINT-DETAIL. IF1024.2 +061400********************END OF TESTS*************** IF1024.2 +061500 CCVS-EXIT SECTION. IF1024.2 +061600 CCVS-999999. IF1024.2 +061700 GO TO CLOSE-FILES. IF1024.2 +*END-OF,IF102A +*HEADER,COBOL,IF103A +000100 IDENTIFICATION DIVISION. IF1034.2 +000200 PROGRAM-ID. IF1034.2 +000300 IF103A. IF1034.2 +000400 IF1034.2 +000500*********************************************************** IF1034.2 +000600* * IF1034.2 +000700* This program is intended to form part of the CCVS85 * IF1034.2 +000800* COBOL Test Suite. It contains tests for the * IF1034.2 +000900* Intrinsic Function ASIN. * IF1034.2 +001000* * IF1034.2 +001100*********************************************************** IF1034.2 +001200 ENVIRONMENT DIVISION. IF1034.2 +001300 CONFIGURATION SECTION. IF1034.2 +001400 SOURCE-COMPUTER. IF1034.2 +001500 XXXXX082. IF1034.2 +001600 OBJECT-COMPUTER. IF1034.2 +001700 XXXXX083. IF1034.2 +001800 INPUT-OUTPUT SECTION. IF1034.2 +001900 FILE-CONTROL. IF1034.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1034.2 +002100 XXXXX055. IF1034.2 +002200 DATA DIVISION. IF1034.2 +002300 FILE SECTION. IF1034.2 +002400 FD PRINT-FILE. IF1034.2 +002500 01 PRINT-REC PICTURE X(120). IF1034.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1034.2 +002700 WORKING-STORAGE SECTION. IF1034.2 +002800*********************************************************** IF1034.2 +002900* Variables specific to the Intrinsic Function Test IF103A* IF1034.2 +003000*********************************************************** IF1034.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1034.2 +003200 01 B PIC S9(10) VALUE 2. IF1034.2 +003300 01 C PIC S9(10) VALUE 100000. IF1034.2 +003400 01 D PIC S9(10) VALUE 1000. IF1034.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1034.2 +003600 01 ARG1 PIC S9V9(17) VALUE 1. IF1034.2 +003700 01 SQRT2 PIC S9V9(17) VALUE 1.414213562. IF1034.2 +003800 01 SQRT3D2 PIC S9V9(17) VALUE 0.866025403. IF1034.2 +003900 01 ARR VALUE "40537". IF1034.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1034.2 +004100 01 TEMP PIC S9(5)V9(5). IF1034.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1034.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1034.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1034.2 +004500* IF1034.2 +004600********************************************************** IF1034.2 +004700* IF1034.2 +004800 01 TEST-RESULTS. IF1034.2 +004900 02 FILLER PIC X VALUE SPACE. IF1034.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1034.2 +005100 02 FILLER PIC X VALUE SPACE. IF1034.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1034.2 +005300 02 FILLER PIC X VALUE SPACE. IF1034.2 +005400 02 PAR-NAME. IF1034.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1034.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1034.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1034.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1034.2 +005900 02 RE-MARK PIC X(61). IF1034.2 +006000 01 TEST-COMPUTED. IF1034.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +006200 02 FILLER PIC X(17) VALUE IF1034.2 +006300 " COMPUTED=". IF1034.2 +006400 02 COMPUTED-X. IF1034.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1034.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1034.2 +006700 PIC -9(9).9(9). IF1034.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1034.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1034.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1034.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1034.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1034.2 +007300 04 FILLER PIC X. IF1034.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1034.2 +007500 01 TEST-CORRECT. IF1034.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1034.2 +007800 02 CORRECT-X. IF1034.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1034.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1034.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1034.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1034.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1034.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1034.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1034.2 +008600 04 FILLER PIC X. IF1034.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1034.2 +008900 01 TEST-CORRECT-MIN. IF1034.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1034.2 +009200 02 CORRECTMI-X. IF1034.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1034.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1034.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1034.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1034.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1034.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1034.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1034.2 +010000 04 FILLER PIC X. IF1034.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1034.2 +010300 01 TEST-CORRECT-MAX. IF1034.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1034.2 +010600 02 CORRECTMA-X. IF1034.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1034.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1034.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1034.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1034.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1034.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1034.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1034.2 +011400 04 FILLER PIC X. IF1034.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1034.2 +011700 01 CCVS-C-1. IF1034.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1034.2 +011900- "SS PARAGRAPH-NAME IF1034.2 +012000- " REMARKS". IF1034.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1034.2 +012200 01 CCVS-C-2. IF1034.2 +012300 02 FILLER PIC X VALUE SPACE. IF1034.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1034.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1034.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1034.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1034.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1034.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1034.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1034.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1034.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1034.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1034.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1034.2 +013900 01 CCVS-H-1. IF1034.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1034.2 +014100 02 FILLER PIC X(42) VALUE IF1034.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1034.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1034.2 +014400 01 CCVS-H-2A. IF1034.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1034.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1034.2 +014700 02 FILLER PIC XXXX VALUE IF1034.2 +014800 "4.2 ". IF1034.2 +014900 02 FILLER PIC X(28) VALUE IF1034.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1034.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1034.2 +015200 IF1034.2 +015300 01 CCVS-H-2B. IF1034.2 +015400 02 FILLER PIC X(15) VALUE IF1034.2 +015500 "TEST RESULT OF ". IF1034.2 +015600 02 TEST-ID PIC X(9). IF1034.2 +015700 02 FILLER PIC X(4) VALUE IF1034.2 +015800 " IN ". IF1034.2 +015900 02 FILLER PIC X(12) VALUE IF1034.2 +016000 " HIGH ". IF1034.2 +016100 02 FILLER PIC X(22) VALUE IF1034.2 +016200 " LEVEL VALIDATION FOR ". IF1034.2 +016300 02 FILLER PIC X(58) VALUE IF1034.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1034.2 +016500 01 CCVS-H-3. IF1034.2 +016600 02 FILLER PIC X(34) VALUE IF1034.2 +016700 " FOR OFFICIAL USE ONLY ". IF1034.2 +016800 02 FILLER PIC X(58) VALUE IF1034.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1034.2 +017000 02 FILLER PIC X(28) VALUE IF1034.2 +017100 " COPYRIGHT 1985 ". IF1034.2 +017200 01 CCVS-E-1. IF1034.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1034.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1034.2 +017500 02 ID-AGAIN PIC X(9). IF1034.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1034.2 +017700 01 CCVS-E-2. IF1034.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1034.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1034.2 +018000 02 CCVS-E-2-2. IF1034.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1034.2 +018200 03 FILLER PIC X VALUE SPACE. IF1034.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1034.2 +018400 "ERRORS ENCOUNTERED". IF1034.2 +018500 01 CCVS-E-3. IF1034.2 +018600 02 FILLER PIC X(22) VALUE IF1034.2 +018700 " FOR OFFICIAL USE ONLY". IF1034.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1034.2 +018900 02 FILLER PIC X(58) VALUE IF1034.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1034.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1034.2 +019200 02 FILLER PIC X(15) VALUE IF1034.2 +019300 " COPYRIGHT 1985". IF1034.2 +019400 01 CCVS-E-4. IF1034.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1034.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1034.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1034.2 +019800 02 FILLER PIC X(40) VALUE IF1034.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1034.2 +020000 01 XXINFO. IF1034.2 +020100 02 FILLER PIC X(19) VALUE IF1034.2 +020200 "*** INFORMATION ***". IF1034.2 +020300 02 INFO-TEXT. IF1034.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1034.2 +020500 04 XXCOMPUTED PIC X(20). IF1034.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1034.2 +020700 04 XXCORRECT PIC X(20). IF1034.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1034.2 +020900 01 HYPHEN-LINE. IF1034.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1034.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1034.2 +021200- "*****************************************". IF1034.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1034.2 +021400- "******************************". IF1034.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1034.2 +021600 "IF103A". IF1034.2 +021700 PROCEDURE DIVISION. IF1034.2 +021800 CCVS1 SECTION. IF1034.2 +021900 OPEN-FILES. IF1034.2 +022000 OPEN OUTPUT PRINT-FILE. IF1034.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1034.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1034.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1034.2 +022400 GO TO CCVS1-EXIT. IF1034.2 +022500 CLOSE-FILES. IF1034.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1034.2 +022700 TERMINATE-CCVS. IF1034.2 +022800 STOP RUN. IF1034.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1034.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1034.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1034.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1034.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1034.2 +023400 PRINT-DETAIL. IF1034.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1034.2 +023600 MOVE "." TO PARDOT-X IF1034.2 +023700 MOVE REC-CT TO DOTVALUE. IF1034.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1034.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1034.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1034.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1034.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1034.2 +024300 MOVE SPACE TO CORRECT-X. IF1034.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1034.2 +024500 MOVE SPACE TO RE-MARK. IF1034.2 +024600 HEAD-ROUTINE. IF1034.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1034.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1034.2 +025100 COLUMN-NAMES-ROUTINE. IF1034.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +025500 END-ROUTINE. IF1034.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1034.2 +025700 END-RTN-EXIT. IF1034.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +025900 END-ROUTINE-1. IF1034.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1034.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1034.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1034.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1034.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1034.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1034.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1034.2 +026700 END-ROUTINE-12. IF1034.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1034.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1034.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1034.2 +027100 ELSE IF1034.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1034.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1034.2 +027400 PERFORM WRITE-LINE. IF1034.2 +027500 END-ROUTINE-13. IF1034.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1034.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1034.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1034.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1034.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1034.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1034.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1034.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1034.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028700 WRITE-LINE. IF1034.2 +028800 ADD 1 TO RECORD-COUNT. IF1034.2 +028900Y IF RECORD-COUNT GREATER 42 IF1034.2 +029000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1034.2 +029100Y MOVE SPACE TO DUMMY-RECORD IF1034.2 +029200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1034.2 +029300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1034.2 +029400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1034.2 +029500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1034.2 +029600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1034.2 +029700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +029800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +029900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +030000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1034.2 +030100Y MOVE ZERO TO RECORD-COUNT. IF1034.2 +030200 PERFORM WRT-LN. IF1034.2 +030300 WRT-LN. IF1034.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1034.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1034.2 +030600 BLANK-LINE-PRINT. IF1034.2 +030700 PERFORM WRT-LN. IF1034.2 +030800 FAIL-ROUTINE. IF1034.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1034.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1034.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1034.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1034.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1034.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1034.2 +031600 GO TO FAIL-ROUTINE-EX. IF1034.2 +031700 FAIL-ROUTINE-WRITE. IF1034.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1034.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1034.2 +032000 CORMA-ANSI-REFERENCE. IF1034.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1034.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1034.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1034.2 +032400 ELSE IF1034.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1034.2 +032600 PERFORM WRITE-LINE. IF1034.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1034.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1034.2 +032900 BAIL-OUT. IF1034.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1034.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1034.2 +033200 BAIL-OUT-WRITE. IF1034.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1034.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1034.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1034.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1034.2 +033800 BAIL-OUT-EX. EXIT. IF1034.2 +033900 CCVS1-EXIT. IF1034.2 +034000 EXIT. IF1034.2 +034100******************************************************** IF1034.2 +034200* * IF1034.2 +034300* Intrinsic Function Tests IF103A - ASIN * IF1034.2 +034400* * IF1034.2 +034500******************************************************** IF1034.2 +034600 SECT-IF103A SECTION. IF1034.2 +034700 F-ASIN-INFO. IF1034.2 +034800 MOVE "See ref. A-35 2.7" TO ANSI-REFERENCE. IF1034.2 +034900 MOVE "ASIN Function" TO FEATURE. IF1034.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1034.2 +035100 F-ASIN-01. IF1034.2 +035200 MOVE ZERO TO WS-NUM. IF1034.2 +035300 MOVE 1.57076 TO MIN-RANGE. IF1034.2 +035400 MOVE 1.57080 TO MAX-RANGE. IF1034.2 +035500 F-ASIN-TEST-01. IF1034.2 +035600 COMPUTE WS-NUM = FUNCTION ASIN(1.0). IF1034.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +035900 PERFORM PASS IF1034.2 +036000 ELSE IF1034.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1034.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +036400 PERFORM FAIL. IF1034.2 +036500 GO TO F-ASIN-WRITE-01. IF1034.2 +036600 F-ASIN-DELETE-01. IF1034.2 +036700 PERFORM DE-LETE. IF1034.2 +036800 GO TO F-ASIN-WRITE-01. IF1034.2 +036900 F-ASIN-WRITE-01. IF1034.2 +037000 MOVE "F-ASIN-01" TO PAR-NAME. IF1034.2 +037100 PERFORM PRINT-DETAIL. IF1034.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1034.2 +037300 F-ASIN-02. IF1034.2 +037400 EVALUATE FUNCTION ASIN(0.5) IF1034.2 +037500 WHEN 0.523588 THRU 0.523609 IF1034.2 +037600 PERFORM PASS IF1034.2 +037700 WHEN OTHER IF1034.2 +037800 PERFORM FAIL. IF1034.2 +037900 GO TO F-ASIN-WRITE-02. IF1034.2 +038000 F-ASIN-DELETE-02. IF1034.2 +038100 PERFORM DE-LETE. IF1034.2 +038200 GO TO F-ASIN-WRITE-02. IF1034.2 +038300 F-ASIN-WRITE-02. IF1034.2 +038400 MOVE "F-ASIN-02" TO PAR-NAME. IF1034.2 +038500 PERFORM PRINT-DETAIL. IF1034.2 +038600*****************TEST (c) - SIMPLE TEST***************** IF1034.2 +038700 F-ASIN-03. IF1034.2 +038800 MOVE -0.000020 TO MIN-RANGE. IF1034.2 +038900 MOVE 0.000020 TO MAX-RANGE. IF1034.2 +039000 F-ASIN-TEST-03. IF1034.2 +039100 IF (FUNCTION ASIN(0) >= MIN-RANGE) AND IF1034.2 +039200 (FUNCTION ASIN(0) <= MAX-RANGE) THEN IF1034.2 +039300 PERFORM PASS IF1034.2 +039400 ELSE IF1034.2 +039500 PERFORM FAIL. IF1034.2 +039600 GO TO F-ASIN-WRITE-03. IF1034.2 +039700 F-ASIN-DELETE-03. IF1034.2 +039800 PERFORM DE-LETE. IF1034.2 +039900 GO TO F-ASIN-WRITE-03. IF1034.2 +040000 F-ASIN-WRITE-03. IF1034.2 +040100 MOVE "F-ASIN-03" TO PAR-NAME. IF1034.2 +040200 PERFORM PRINT-DETAIL. IF1034.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1034.2 +040400 F-ASIN-04. IF1034.2 +040500 MOVE ZERO TO WS-NUM. IF1034.2 +040600 MOVE -1.57080 TO MIN-RANGE. IF1034.2 +040700 MOVE -1.57076 TO MAX-RANGE. IF1034.2 +040800 F-ASIN-TEST-04. IF1034.2 +040900 COMPUTE WS-NUM = FUNCTION ASIN(-1). IF1034.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +041200 PERFORM PASS IF1034.2 +041300 ELSE IF1034.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +041700 PERFORM FAIL. IF1034.2 +041800 GO TO F-ASIN-WRITE-04. IF1034.2 +041900 F-ASIN-DELETE-04. IF1034.2 +042000 PERFORM DE-LETE. IF1034.2 +042100 GO TO F-ASIN-WRITE-04. IF1034.2 +042200 F-ASIN-WRITE-04. IF1034.2 +042300 MOVE "F-ASIN-04" TO PAR-NAME. IF1034.2 +042400 PERFORM PRINT-DETAIL. IF1034.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1034.2 +042600 F-ASIN-05. IF1034.2 +042700 MOVE ZERO TO WS-NUM. IF1034.2 +042800 MOVE 1.52604 TO MIN-RANGE. IF1034.2 +042900 MOVE 1.52610 TO MAX-RANGE. IF1034.2 +043000 F-ASIN-TEST-05. IF1034.2 +043100 COMPUTE WS-NUM = FUNCTION ASIN(.999). IF1034.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +043400 PERFORM PASS IF1034.2 +043500 ELSE IF1034.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +043900 PERFORM FAIL. IF1034.2 +044000 GO TO F-ASIN-WRITE-05. IF1034.2 +044100 F-ASIN-DELETE-05. IF1034.2 +044200 PERFORM DE-LETE. IF1034.2 +044300 GO TO F-ASIN-WRITE-05. IF1034.2 +044400 F-ASIN-WRITE-05. IF1034.2 +044500 MOVE "F-ASIN-05" TO PAR-NAME. IF1034.2 +044600 PERFORM PRINT-DETAIL. IF1034.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1034.2 +044800 F-ASIN-06. IF1034.2 +044900 MOVE ZERO TO WS-NUM. IF1034.2 +045000 MOVE 0.512079 TO MIN-RANGE. IF1034.2 +045100 MOVE 0.512099 TO MAX-RANGE. IF1034.2 +045200 F-ASIN-TEST-06. IF1034.2 +045300 COMPUTE WS-NUM = FUNCTION ASIN(.49). IF1034.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +045600 PERFORM PASS IF1034.2 +045700 ELSE IF1034.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +046100 PERFORM FAIL. IF1034.2 +046200 GO TO F-ASIN-WRITE-06. IF1034.2 +046300 F-ASIN-DELETE-06. IF1034.2 +046400 PERFORM DE-LETE. IF1034.2 +046500 GO TO F-ASIN-WRITE-06. IF1034.2 +046600 F-ASIN-WRITE-06. IF1034.2 +046700 MOVE "F-ASIN-06" TO PAR-NAME. IF1034.2 +046800 PERFORM PRINT-DETAIL. IF1034.2 +046900*****************TEST (h) - SIMPLE TEST***************** IF1034.2 +047000 F-ASIN-08. IF1034.2 +047100 MOVE ZERO TO WS-NUM. IF1034.2 +047200 MOVE -1.52610 TO MIN-RANGE. IF1034.2 +047300 MOVE -1.52604 TO MAX-RANGE. IF1034.2 +047400 F-ASIN-TEST-08. IF1034.2 +047500 COMPUTE WS-NUM = FUNCTION ASIN(-.999). IF1034.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +047800 PERFORM PASS IF1034.2 +047900 ELSE IF1034.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +048300 PERFORM FAIL. IF1034.2 +048400 GO TO F-ASIN-WRITE-08. IF1034.2 +048500 F-ASIN-DELETE-08. IF1034.2 +048600 PERFORM DE-LETE. IF1034.2 +048700 GO TO F-ASIN-WRITE-08. IF1034.2 +048800 F-ASIN-WRITE-08. IF1034.2 +048900 MOVE "F-ASIN-08" TO PAR-NAME. IF1034.2 +049000 PERFORM PRINT-DETAIL. IF1034.2 +049100*****************TEST (k) - SIMPLE TEST***************** IF1034.2 +049200 F-ASIN-11. IF1034.2 +049300 MOVE ZERO TO WS-NUM. IF1034.2 +049400 MOVE -0.000020 TO MIN-RANGE. IF1034.2 +049500 MOVE 0.000020 TO MAX-RANGE. IF1034.2 +049600 F-ASIN-TEST-11. IF1034.2 +049700 COMPUTE WS-NUM = FUNCTION ASIN(IND(B)). IF1034.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +050000 PERFORM PASS IF1034.2 +050100 ELSE IF1034.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +050500 PERFORM FAIL. IF1034.2 +050600 GO TO F-ASIN-WRITE-11. IF1034.2 +050700 F-ASIN-DELETE-11. IF1034.2 +050800 PERFORM DE-LETE. IF1034.2 +050900 GO TO F-ASIN-WRITE-11. IF1034.2 +051000 F-ASIN-WRITE-11. IF1034.2 +051100 MOVE "F-ASIN-11" TO PAR-NAME. IF1034.2 +051200 PERFORM PRINT-DETAIL. IF1034.2 +051300*****************TEST (a) - COMPLEX TEST**************** IF1034.2 +051400 F-ASIN-12. IF1034.2 +051500 MOVE ZERO TO WS-NUM. IF1034.2 +051600 MOVE 0.785367 TO MIN-RANGE. IF1034.2 +051700 MOVE 0.785429 TO MAX-RANGE. IF1034.2 +051800 F-ASIN-TEST-12. IF1034.2 +051900 COMPUTE WS-NUM = FUNCTION ASIN(1 / SQRT2). IF1034.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +052200 PERFORM PASS IF1034.2 +052300 ELSE IF1034.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +052700 PERFORM FAIL. IF1034.2 +052800 GO TO F-ASIN-WRITE-12. IF1034.2 +052900 F-ASIN-DELETE-12. IF1034.2 +053000 PERFORM DE-LETE. IF1034.2 +053100 GO TO F-ASIN-WRITE-12. IF1034.2 +053200 F-ASIN-WRITE-12. IF1034.2 +053300 MOVE "F-ASIN-12" TO PAR-NAME. IF1034.2 +053400 PERFORM PRINT-DETAIL. IF1034.2 +053500*****************TEST (b) COMPLEX-TEST****************** IF1034.2 +053600 F-ASIN-13. IF1034.2 +053700 MOVE ZERO TO WS-NUM. IF1034.2 +053800 MOVE 1.04715 TO MIN-RANGE. IF1034.2 +053900 MOVE 1.04723 TO MAX-RANGE. IF1034.2 +054000 F-ASIN-TEST-13. IF1034.2 +054100 COMPUTE WS-NUM = FUNCTION ASIN(SQRT3D2). IF1034.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +054400 PERFORM PASS IF1034.2 +054500 ELSE IF1034.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +054900 PERFORM FAIL. IF1034.2 +055000 GO TO F-ASIN-WRITE-13. IF1034.2 +055100 F-ASIN-DELETE-13. IF1034.2 +055200 PERFORM DE-LETE. IF1034.2 +055300 GO TO F-ASIN-WRITE-13. IF1034.2 +055400 F-ASIN-WRITE-13. IF1034.2 +055500 MOVE "F-ASIN-13" TO PAR-NAME. IF1034.2 +055600 PERFORM PRINT-DETAIL. IF1034.2 +055700*****************TEST (d) - COMPLEX TEST**************** IF1034.2 +055800 F-ASIN-15. IF1034.2 +055900 MOVE ZERO TO WS-NUM. IF1034.2 +056000 MOVE 1.42919 TO MIN-RANGE. IF1034.2 +056100 MOVE 1.42931 TO MAX-RANGE. IF1034.2 +056200 F-ASIN-TEST-15. IF1034.2 +056300 COMPUTE WS-NUM = FUNCTION ASIN(1.98 / 2). IF1034.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +056600 PERFORM PASS IF1034.2 +056700 ELSE IF1034.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +057100 PERFORM FAIL. IF1034.2 +057200 GO TO F-ASIN-WRITE-15. IF1034.2 +057300 F-ASIN-DELETE-15. IF1034.2 +057400 PERFORM DE-LETE. IF1034.2 +057500 GO TO F-ASIN-WRITE-15. IF1034.2 +057600 F-ASIN-WRITE-15. IF1034.2 +057700 MOVE "F-ASIN-15" TO PAR-NAME. IF1034.2 +057800 PERFORM PRINT-DETAIL. IF1034.2 +057900*****************TEST (e) - COMPLEX TEST**************** IF1034.2 +058000 F-ASIN-16. IF1034.2 +058100 MOVE ZERO TO WS-NUM. IF1034.2 +058200 MOVE 0.512069 TO MIN-RANGE. IF1034.2 +058300 MOVE 0.512110 TO MAX-RANGE. IF1034.2 +058400 F-ASIN-TEST-16. IF1034.2 +058500 COMPUTE WS-NUM = FUNCTION ASIN(0.2 + 0.29). IF1034.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +058800 PERFORM PASS IF1034.2 +058900 ELSE IF1034.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +059300 PERFORM FAIL. IF1034.2 +059400 GO TO F-ASIN-WRITE-16. IF1034.2 +059500 F-ASIN-DELETE-16. IF1034.2 +059600 PERFORM DE-LETE. IF1034.2 +059700 GO TO F-ASIN-WRITE-16. IF1034.2 +059800 F-ASIN-WRITE-16. IF1034.2 +059900 MOVE "F-ASIN-16" TO PAR-NAME. IF1034.2 +060000 PERFORM PRINT-DETAIL. IF1034.2 +060100*****************TEST (f) - COMPLEX TEST**************** IF1034.2 +060200 F-ASIN-17. IF1034.2 +060300 MOVE ZERO TO WS-NUM. IF1034.2 +060400 MOVE -1.42931 TO MIN-RANGE. IF1034.2 +060500 MOVE -1.42919 TO MAX-RANGE. IF1034.2 +060600 F-ASIN-TEST-17. IF1034.2 +060700 COMPUTE WS-NUM = FUNCTION ASIN(0.99 * -1). IF1034.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +061000 PERFORM PASS IF1034.2 +061100 ELSE IF1034.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +061500 PERFORM FAIL. IF1034.2 +061600 GO TO F-ASIN-WRITE-17. IF1034.2 +061700 F-ASIN-DELETE-17. IF1034.2 +061800 PERFORM DE-LETE. IF1034.2 +061900 GO TO F-ASIN-WRITE-17. IF1034.2 +062000 F-ASIN-WRITE-17. IF1034.2 +062100 MOVE "F-ASIN-17" TO PAR-NAME. IF1034.2 +062200 PERFORM PRINT-DETAIL. IF1034.2 +062300*****************TEST (g) - COMPLEX TEST**************** IF1034.2 +062400 F-ASIN-18. IF1034.2 +062500 MOVE ZERO TO WS-NUM. IF1034.2 +062600 MOVE 0.675104 TO MIN-RANGE. IF1034.2 +062700 MOVE 0.675158 TO MAX-RANGE. IF1034.2 +062800 F-ASIN-TEST-18. IF1034.2 +062900 COMPUTE WS-NUM = FUNCTION ASIN(IND(3) / 8). IF1034.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +063200 PERFORM PASS IF1034.2 +063300 ELSE IF1034.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +063700 PERFORM FAIL. IF1034.2 +063800 GO TO F-ASIN-WRITE-18. IF1034.2 +063900 F-ASIN-DELETE-18. IF1034.2 +064000 PERFORM DE-LETE. IF1034.2 +064100 GO TO F-ASIN-WRITE-18. IF1034.2 +064200 F-ASIN-WRITE-18. IF1034.2 +064300 MOVE "F-ASIN-18" TO PAR-NAME. IF1034.2 +064400 PERFORM PRINT-DETAIL. IF1034.2 +064500*****************TEST (h) - COMPLEX TEST**************** IF1034.2 +064600 F-ASIN-19. IF1034.2 +064700 MOVE ZERO TO WS-NUM. IF1034.2 +064800 MOVE 1.57073 TO MIN-RANGE. IF1034.2 +064900 MOVE 1.57080 TO MAX-RANGE. IF1034.2 +065000 F-ASIN-TEST-19. IF1034.2 +065100 COMPUTE WS-NUM = FUNCTION ASIN(4 - 3). IF1034.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +065400 PERFORM PASS IF1034.2 +065500 ELSE IF1034.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +065900 PERFORM FAIL. IF1034.2 +066000 GO TO F-ASIN-WRITE-19. IF1034.2 +066100 F-ASIN-DELETE-19. IF1034.2 +066200 PERFORM DE-LETE. IF1034.2 +066300 GO TO F-ASIN-WRITE-19. IF1034.2 +066400 F-ASIN-WRITE-19. IF1034.2 +066500 MOVE "F-ASIN-19" TO PAR-NAME. IF1034.2 +066600 PERFORM PRINT-DETAIL. IF1034.2 +066700*****************TEST (i) - COMPLEX TEST**************** IF1034.2 +066800 F-ASIN-20. IF1034.2 +066900 MOVE ZERO TO WS-NUM. IF1034.2 +067000 MOVE -0.000040 TO MIN-RANGE. IF1034.2 +067100 MOVE 0.000040 TO MAX-RANGE. IF1034.2 +067200 F-ASIN-TEST-20. IF1034.2 +067300 COMPUTE WS-NUM = FUNCTION ASIN(C - C). IF1034.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +067600 PERFORM PASS IF1034.2 +067700 ELSE IF1034.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +068100 PERFORM FAIL. IF1034.2 +068200 GO TO F-ASIN-WRITE-20. IF1034.2 +068300 F-ASIN-DELETE-20. IF1034.2 +068400 PERFORM DE-LETE. IF1034.2 +068500 GO TO F-ASIN-WRITE-20. IF1034.2 +068600 F-ASIN-WRITE-20. IF1034.2 +068700 MOVE "F-ASIN-20" TO PAR-NAME. IF1034.2 +068800 PERFORM PRINT-DETAIL. IF1034.2 +068900*****************TEST (j) - COMPLEX TEST**************** IF1034.2 +069000 F-ASIN-21. IF1034.2 +069100 MOVE ZERO TO WS-NUM. IF1034.2 +069200 MOVE 0.252670 TO MIN-RANGE. IF1034.2 +069300 MOVE 0.252690 TO MAX-RANGE. IF1034.2 +069400 F-ASIN-TEST-21. IF1034.2 +069500 COMPUTE WS-NUM = FUNCTION ASIN(0.25 * 1). IF1034.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +069800 PERFORM PASS IF1034.2 +069900 ELSE IF1034.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +070300 PERFORM FAIL. IF1034.2 +070400 GO TO F-ASIN-WRITE-21. IF1034.2 +070500 F-ASIN-DELETE-21. IF1034.2 +070600 PERFORM DE-LETE. IF1034.2 +070700 GO TO F-ASIN-WRITE-21. IF1034.2 +070800 F-ASIN-WRITE-21. IF1034.2 +070900 MOVE "F-ASIN-21" TO PAR-NAME. IF1034.2 +071000 PERFORM PRINT-DETAIL. IF1034.2 +071100*****************TEST (k) - COMPLEX TEST**************** IF1034.2 +071200 F-ASIN-22. IF1034.2 +071300 MOVE ZERO TO WS-NUM. IF1034.2 +071400 MOVE 0.323933 TO MIN-RANGE. IF1034.2 +071500 MOVE 0.323959 TO MAX-RANGE. IF1034.2 +071600 F-ASIN-TEST-22. IF1034.2 +071700 COMPUTE WS-NUM = FUNCTION ASIN(1 / PI). IF1034.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +072000 PERFORM PASS IF1034.2 +072100 ELSE IF1034.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +072500 PERFORM FAIL. IF1034.2 +072600 GO TO F-ASIN-WRITE-22. IF1034.2 +072700 F-ASIN-DELETE-22. IF1034.2 +072800 PERFORM DE-LETE. IF1034.2 +072900 GO TO F-ASIN-WRITE-22. IF1034.2 +073000 F-ASIN-WRITE-22. IF1034.2 +073100 MOVE "F-ASIN-22" TO PAR-NAME. IF1034.2 +073200 PERFORM PRINT-DETAIL. IF1034.2 +073300*****************TEST (l) - COMPLEX TEST**************** IF1034.2 +073400 F-ASIN-23. IF1034.2 +073500 MOVE ZERO TO WS-NUM. IF1034.2 +073600 MOVE -0.000040 TO MIN-RANGE. IF1034.2 +073700 MOVE 0.000040 TO MAX-RANGE. IF1034.2 +073800 F-ASIN-TEST-23. IF1034.2 +073900 COMPUTE WS-NUM = FUNCTION ASIN((D / D) - 1). IF1034.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +074200 PERFORM PASS IF1034.2 +074300 ELSE IF1034.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +074700 PERFORM FAIL. IF1034.2 +074800 GO TO F-ASIN-WRITE-23. IF1034.2 +074900 F-ASIN-DELETE-23. IF1034.2 +075000 PERFORM DE-LETE. IF1034.2 +075100 GO TO F-ASIN-WRITE-23. IF1034.2 +075200 F-ASIN-WRITE-23. IF1034.2 +075300 MOVE "F-ASIN-23" TO PAR-NAME. IF1034.2 +075400 PERFORM PRINT-DETAIL. IF1034.2 +075500*****************TEST (m) - COMPLEX TEST**************** IF1034.2 +075600 F-ASIN-24. IF1034.2 +075700 MOVE ZERO TO WS-NUM. IF1034.2 +075800 MOVE -1.03219 TO MIN-RANGE. IF1034.2 +075900 MOVE -1.03211 TO MAX-RANGE. IF1034.2 +076000 F-ASIN-TEST-24. IF1034.2 +076100 COMPUTE WS-NUM = FUNCTION ASIN(PI - 4). IF1034.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +076400 PERFORM PASS IF1034.2 +076500 ELSE IF1034.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +076900 PERFORM FAIL. IF1034.2 +077000 GO TO F-ASIN-WRITE-24. IF1034.2 +077100 F-ASIN-DELETE-24. IF1034.2 +077200 PERFORM DE-LETE. IF1034.2 +077300 GO TO F-ASIN-WRITE-24. IF1034.2 +077400 F-ASIN-WRITE-24. IF1034.2 +077500 MOVE "F-ASIN-24" TO PAR-NAME. IF1034.2 +077600 PERFORM PRINT-DETAIL. IF1034.2 +077700*****************TEST (n) - COMPLEX TEST**************** IF1034.2 +077800 F-ASIN-25. IF1034.2 +077900 MOVE ZERO TO WS-NUM. IF1034.2 +078000 MOVE 0.142546 TO MIN-RANGE. IF1034.2 +078100 MOVE 0.142558 TO MAX-RANGE. IF1034.2 +078200 F-ASIN-TEST-25. IF1034.2 +078300 COMPUTE WS-NUM = FUNCTION ASIN(FUNCTION ASIN(PI - 3)). IF1034.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +078600 PERFORM PASS IF1034.2 +078700 ELSE IF1034.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +079100 PERFORM FAIL. IF1034.2 +079200 GO TO F-ASIN-WRITE-25. IF1034.2 +079300 F-ASIN-DELETE-25. IF1034.2 +079400 PERFORM DE-LETE. IF1034.2 +079500 GO TO F-ASIN-WRITE-25. IF1034.2 +079600 F-ASIN-WRITE-25. IF1034.2 +079700 MOVE "F-ASIN-25" TO PAR-NAME. IF1034.2 +079800 PERFORM PRINT-DETAIL. IF1034.2 +079900*****************TEST (o) - COMPLEX TEST**************** IF1034.2 +080000 F-ASIN-26. IF1034.2 +080100 MOVE ZERO TO WS-NUM. IF1034.2 +080200 MOVE 1.28695 TO MIN-RANGE. IF1034.2 +080300 MOVE 1.28705 TO MAX-RANGE. IF1034.2 +080400 F-ASIN-TEST-26. IF1034.2 +080500 COMPUTE WS-NUM = FUNCTION ASIN(0.6) + IF1034.2 +080600 FUNCTION ASIN(0.6). IF1034.2 +080700 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +080800 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +080900 PERFORM PASS IF1034.2 +081000 ELSE IF1034.2 +081100 MOVE WS-NUM TO COMPUTED-N IF1034.2 +081200 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +081300 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +081400 PERFORM FAIL. IF1034.2 +081500 GO TO F-ASIN-WRITE-26. IF1034.2 +081600 F-ASIN-DELETE-26. IF1034.2 +081700 PERFORM DE-LETE. IF1034.2 +081800 GO TO F-ASIN-WRITE-26. IF1034.2 +081900 F-ASIN-WRITE-26. IF1034.2 +082000 MOVE "F-ASIN-26" TO PAR-NAME. IF1034.2 +082100 PERFORM PRINT-DETAIL. IF1034.2 +082200*****************SPECIAL PERFORM TEST********************** IF1034.2 +082300 F-ASIN-27. IF1034.2 +082400 MOVE ZERO TO WS-NUM. IF1034.2 +082500 PERFORM F-ASIN-TEST-27 IF1034.2 +082600 UNTIL FUNCTION ASIN(ARG1) < 0. IF1034.2 +082700 PERFORM PASS. IF1034.2 +082800 GO TO F-ASIN-WRITE-27. IF1034.2 +082900 F-ASIN-TEST-27. IF1034.2 +083000 COMPUTE ARG1 = ARG1 - 0.25. IF1034.2 +083100 F-ASIN-DELETE-27. IF1034.2 +083200 PERFORM DE-LETE. IF1034.2 +083300 GO TO F-ASIN-WRITE-27. IF1034.2 +083400 F-ASIN-WRITE-27. IF1034.2 +083500 MOVE "F-ASIN-27" TO PAR-NAME. IF1034.2 +083600 PERFORM PRINT-DETAIL. IF1034.2 +083700********************END OF TESTS*************** IF1034.2 +083800 CCVS-EXIT SECTION. IF1034.2 +083900 CCVS-999999. IF1034.2 +084000 GO TO CLOSE-FILES. IF1034.2 +*END-OF,IF103A +*HEADER,COBOL,IF104A +000100 IDENTIFICATION DIVISION. IF1044.2 +000200 PROGRAM-ID. IF1044.2 +000300 IF104A. IF1044.2 +000400 IF1044.2 +000500*********************************************************** IF1044.2 +000600* * IF1044.2 +000700* This program is intended to form part of the CCVS85 * IF1044.2 +000800* COBOL Test Suite. It contains tests for the * IF1044.2 +000900* Intrinsic Function ATAN. * IF1044.2 +001000* * IF1044.2 +001100*********************************************************** IF1044.2 +001200 ENVIRONMENT DIVISION. IF1044.2 +001300 CONFIGURATION SECTION. IF1044.2 +001400 SOURCE-COMPUTER. IF1044.2 +001500 XXXXX082. IF1044.2 +001600 OBJECT-COMPUTER. IF1044.2 +001700 XXXXX083. IF1044.2 +001800 INPUT-OUTPUT SECTION. IF1044.2 +001900 FILE-CONTROL. IF1044.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1044.2 +002100 XXXXX055. IF1044.2 +002200 DATA DIVISION. IF1044.2 +002300 FILE SECTION. IF1044.2 +002400 FD PRINT-FILE. IF1044.2 +002500 01 PRINT-REC PICTURE X(120). IF1044.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1044.2 +002700 WORKING-STORAGE SECTION. IF1044.2 +002800*********************************************************** IF1044.2 +002900* Variables specific to the Intrinsic Function Test IF104A* IF1044.2 +003000*********************************************************** IF1044.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1044.2 +003200 01 B PIC S9(10) VALUE 2. IF1044.2 +003300 01 C PIC S9(10) VALUE 100000. IF1044.2 +003400 01 D PIC S9(10) VALUE 1000. IF1044.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1044.2 +003600 01 ARG1 PIC S9V9(17) VALUE 1.00. IF1044.2 +003700 01 SQRT3 PIC S9V9(17) VALUE 1.732050808. IF1044.2 +003800 01 ARR VALUE "40537". IF1044.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1044.2 +004000 01 TEMP PIC S9(5)V9(5). IF1044.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1044.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1044.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1044.2 +004400* IF1044.2 +004500********************************************************** IF1044.2 +004600* IF1044.2 +004700 01 TEST-RESULTS. IF1044.2 +004800 02 FILLER PIC X VALUE SPACE. IF1044.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1044.2 +005000 02 FILLER PIC X VALUE SPACE. IF1044.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1044.2 +005200 02 FILLER PIC X VALUE SPACE. IF1044.2 +005300 02 PAR-NAME. IF1044.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1044.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1044.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1044.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1044.2 +005800 02 RE-MARK PIC X(61). IF1044.2 +005900 01 TEST-COMPUTED. IF1044.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +006100 02 FILLER PIC X(17) VALUE IF1044.2 +006200 " COMPUTED=". IF1044.2 +006300 02 COMPUTED-X. IF1044.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1044.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1044.2 +006600 PIC -9(9).9(9). IF1044.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1044.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1044.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1044.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1044.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1044.2 +007200 04 FILLER PIC X. IF1044.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1044.2 +007400 01 TEST-CORRECT. IF1044.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1044.2 +007700 02 CORRECT-X. IF1044.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1044.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1044.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1044.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1044.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1044.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1044.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1044.2 +008500 04 FILLER PIC X. IF1044.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1044.2 +008800 01 TEST-CORRECT-MIN. IF1044.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1044.2 +009100 02 CORRECTMI-X. IF1044.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1044.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1044.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1044.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1044.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1044.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1044.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1044.2 +009900 04 FILLER PIC X. IF1044.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1044.2 +010200 01 TEST-CORRECT-MAX. IF1044.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1044.2 +010500 02 CORRECTMA-X. IF1044.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1044.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1044.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1044.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1044.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1044.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1044.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1044.2 +011300 04 FILLER PIC X. IF1044.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1044.2 +011600 01 CCVS-C-1. IF1044.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1044.2 +011800- "SS PARAGRAPH-NAME IF1044.2 +011900- " REMARKS". IF1044.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1044.2 +012100 01 CCVS-C-2. IF1044.2 +012200 02 FILLER PIC X VALUE SPACE. IF1044.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1044.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1044.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1044.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1044.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1044.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1044.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1044.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1044.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1044.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1044.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1044.2 +013800 01 CCVS-H-1. IF1044.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1044.2 +014000 02 FILLER PIC X(42) VALUE IF1044.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1044.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1044.2 +014300 01 CCVS-H-2A. IF1044.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1044.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1044.2 +014600 02 FILLER PIC XXXX VALUE IF1044.2 +014700 "4.2 ". IF1044.2 +014800 02 FILLER PIC X(28) VALUE IF1044.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1044.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1044.2 +015100 IF1044.2 +015200 01 CCVS-H-2B. IF1044.2 +015300 02 FILLER PIC X(15) VALUE IF1044.2 +015400 "TEST RESULT OF ". IF1044.2 +015500 02 TEST-ID PIC X(9). IF1044.2 +015600 02 FILLER PIC X(4) VALUE IF1044.2 +015700 " IN ". IF1044.2 +015800 02 FILLER PIC X(12) VALUE IF1044.2 +015900 " HIGH ". IF1044.2 +016000 02 FILLER PIC X(22) VALUE IF1044.2 +016100 " LEVEL VALIDATION FOR ". IF1044.2 +016200 02 FILLER PIC X(58) VALUE IF1044.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1044.2 +016400 01 CCVS-H-3. IF1044.2 +016500 02 FILLER PIC X(34) VALUE IF1044.2 +016600 " FOR OFFICIAL USE ONLY ". IF1044.2 +016700 02 FILLER PIC X(58) VALUE IF1044.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1044.2 +016900 02 FILLER PIC X(28) VALUE IF1044.2 +017000 " COPYRIGHT 1985 ". IF1044.2 +017100 01 CCVS-E-1. IF1044.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1044.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1044.2 +017400 02 ID-AGAIN PIC X(9). IF1044.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1044.2 +017600 01 CCVS-E-2. IF1044.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1044.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1044.2 +017900 02 CCVS-E-2-2. IF1044.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1044.2 +018100 03 FILLER PIC X VALUE SPACE. IF1044.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1044.2 +018300 "ERRORS ENCOUNTERED". IF1044.2 +018400 01 CCVS-E-3. IF1044.2 +018500 02 FILLER PIC X(22) VALUE IF1044.2 +018600 " FOR OFFICIAL USE ONLY". IF1044.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1044.2 +018800 02 FILLER PIC X(58) VALUE IF1044.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1044.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1044.2 +019100 02 FILLER PIC X(15) VALUE IF1044.2 +019200 " COPYRIGHT 1985". IF1044.2 +019300 01 CCVS-E-4. IF1044.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1044.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1044.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1044.2 +019700 02 FILLER PIC X(40) VALUE IF1044.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1044.2 +019900 01 XXINFO. IF1044.2 +020000 02 FILLER PIC X(19) VALUE IF1044.2 +020100 "*** INFORMATION ***". IF1044.2 +020200 02 INFO-TEXT. IF1044.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1044.2 +020400 04 XXCOMPUTED PIC X(20). IF1044.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1044.2 +020600 04 XXCORRECT PIC X(20). IF1044.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1044.2 +020800 01 HYPHEN-LINE. IF1044.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1044.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1044.2 +021100- "*****************************************". IF1044.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1044.2 +021300- "******************************". IF1044.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1044.2 +021500 "IF104A". IF1044.2 +021600 PROCEDURE DIVISION. IF1044.2 +021700 CCVS1 SECTION. IF1044.2 +021800 OPEN-FILES. IF1044.2 +021900 OPEN OUTPUT PRINT-FILE. IF1044.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1044.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1044.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1044.2 +022300 GO TO CCVS1-EXIT. IF1044.2 +022400 CLOSE-FILES. IF1044.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1044.2 +022600 TERMINATE-CCVS. IF1044.2 +022700 STOP RUN. IF1044.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1044.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1044.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1044.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1044.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1044.2 +023300 PRINT-DETAIL. IF1044.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1044.2 +023500 MOVE "." TO PARDOT-X IF1044.2 +023600 MOVE REC-CT TO DOTVALUE. IF1044.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1044.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1044.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1044.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1044.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1044.2 +024200 MOVE SPACE TO CORRECT-X. IF1044.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1044.2 +024400 MOVE SPACE TO RE-MARK. IF1044.2 +024500 HEAD-ROUTINE. IF1044.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1044.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1044.2 +025000 COLUMN-NAMES-ROUTINE. IF1044.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +025400 END-ROUTINE. IF1044.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1044.2 +025600 END-RTN-EXIT. IF1044.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +025800 END-ROUTINE-1. IF1044.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1044.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1044.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1044.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1044.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1044.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1044.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1044.2 +026600 END-ROUTINE-12. IF1044.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1044.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1044.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1044.2 +027000 ELSE IF1044.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1044.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1044.2 +027300 PERFORM WRITE-LINE. IF1044.2 +027400 END-ROUTINE-13. IF1044.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1044.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1044.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1044.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1044.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1044.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1044.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1044.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1044.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028600 WRITE-LINE. IF1044.2 +028700 ADD 1 TO RECORD-COUNT. IF1044.2 +028800Y IF RECORD-COUNT GREATER 42 IF1044.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1044.2 +029000Y MOVE SPACE TO DUMMY-RECORD IF1044.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1044.2 +029200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1044.2 +029300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1044.2 +029400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1044.2 +029500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1044.2 +029600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1044.2 +030000Y MOVE ZERO TO RECORD-COUNT. IF1044.2 +030100 PERFORM WRT-LN. IF1044.2 +030200 WRT-LN. IF1044.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1044.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1044.2 +030500 BLANK-LINE-PRINT. IF1044.2 +030600 PERFORM WRT-LN. IF1044.2 +030700 FAIL-ROUTINE. IF1044.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1044.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1044.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1044.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1044.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1044.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1044.2 +031500 GO TO FAIL-ROUTINE-EX. IF1044.2 +031600 FAIL-ROUTINE-WRITE. IF1044.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1044.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1044.2 +031900 CORMA-ANSI-REFERENCE. IF1044.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1044.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1044.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1044.2 +032300 ELSE IF1044.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1044.2 +032500 PERFORM WRITE-LINE. IF1044.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1044.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1044.2 +032800 BAIL-OUT. IF1044.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1044.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1044.2 +033100 BAIL-OUT-WRITE. IF1044.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1044.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1044.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1044.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1044.2 +033700 BAIL-OUT-EX. EXIT. IF1044.2 +033800 CCVS1-EXIT. IF1044.2 +033900 EXIT. IF1044.2 +034000******************************************************** IF1044.2 +034100* * IF1044.2 +034200* Intrinsic Function Tests IF104A - ATAN * IF1044.2 +034300* * IF1044.2 +034400******************************************************** IF1044.2 +034500 SECT-IF104A SECTION. IF1044.2 +034600 F-ATAN-INFO. IF1044.2 +034700 MOVE "See ref. A-36 2.8" TO ANSI-REFERENCE. IF1044.2 +034800 MOVE "ATAN Function" TO FEATURE. IF1044.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1044.2 +035000 F-ATAN-01. IF1044.2 +035100 MOVE ZERO TO WS-NUM. IF1044.2 +035200 MOVE 0.785382 TO MIN-RANGE. IF1044.2 +035300 MOVE 0.785414 TO MAX-RANGE. IF1044.2 +035400 F-ATAN-TEST-01. IF1044.2 +035500 COMPUTE WS-NUM = FUNCTION ATAN(1.0). IF1044.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +035800 PERFORM PASS IF1044.2 +035900 ELSE IF1044.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1044.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +036300 PERFORM FAIL. IF1044.2 +036400 GO TO F-ATAN-WRITE-01. IF1044.2 +036500 F-ATAN-DELETE-01. IF1044.2 +036600 PERFORM DE-LETE. IF1044.2 +036700 GO TO F-ATAN-WRITE-01. IF1044.2 +036800 F-ATAN-WRITE-01. IF1044.2 +036900 MOVE "F-ATAN-01" TO PAR-NAME. IF1044.2 +037000 PERFORM PRINT-DETAIL. IF1044.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1044.2 +037200 F-ATAN-02. IF1044.2 +037300 EVALUATE FUNCTION ATAN(0.5) IF1044.2 +037400 WHEN 0.463638 THRU 0.463656 IF1044.2 +037500 PERFORM PASS IF1044.2 +037600 WHEN OTHER IF1044.2 +037700 PERFORM FAIL. IF1044.2 +037800 GO TO F-ATAN-WRITE-02. IF1044.2 +037900 F-ATAN-DELETE-02. IF1044.2 +038000 PERFORM DE-LETE. IF1044.2 +038100 GO TO F-ATAN-WRITE-02. IF1044.2 +038200 F-ATAN-WRITE-02. IF1044.2 +038300 MOVE "F-ATAN-02" TO PAR-NAME. IF1044.2 +038400 PERFORM PRINT-DETAIL. IF1044.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1044.2 +038600 F-ATAN-03. IF1044.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1044.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +038900 F-ATAN-TEST-03. IF1044.2 +039000 IF (FUNCTION ATAN(0) >= MIN-RANGE) AND IF1044.2 +039100 (FUNCTION ATAN(0) <= MAX-RANGE) THEN IF1044.2 +039200 PERFORM PASS IF1044.2 +039300 ELSE IF1044.2 +039400 PERFORM FAIL. IF1044.2 +039500 GO TO F-ATAN-WRITE-03. IF1044.2 +039600 F-ATAN-DELETE-03. IF1044.2 +039700 PERFORM DE-LETE. IF1044.2 +039800 GO TO F-ATAN-WRITE-03. IF1044.2 +039900 F-ATAN-WRITE-03. IF1044.2 +040000 MOVE "F-ATAN-03" TO PAR-NAME. IF1044.2 +040100 PERFORM PRINT-DETAIL. IF1044.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1044.2 +040300 F-ATAN-04. IF1044.2 +040400 MOVE ZERO TO WS-NUM. IF1044.2 +040500 MOVE -0.785414 TO MIN-RANGE. IF1044.2 +040600 MOVE -0.785382 TO MAX-RANGE. IF1044.2 +040700 F-ATAN-TEST-04. IF1044.2 +040800 COMPUTE WS-NUM = FUNCTION ATAN(-1). IF1044.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +041100 PERFORM PASS IF1044.2 +041200 ELSE IF1044.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +041600 PERFORM FAIL. IF1044.2 +041700 GO TO F-ATAN-WRITE-04. IF1044.2 +041800 F-ATAN-DELETE-04. IF1044.2 +041900 PERFORM DE-LETE. IF1044.2 +042000 GO TO F-ATAN-WRITE-04. IF1044.2 +042100 F-ATAN-WRITE-04. IF1044.2 +042200 MOVE "F-ATAN-04" TO PAR-NAME. IF1044.2 +042300 PERFORM PRINT-DETAIL. IF1044.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1044.2 +042500 F-ATAN-05. IF1044.2 +042600 MOVE ZERO TO WS-NUM. IF1044.2 +042700 MOVE 0.784881 TO MIN-RANGE. IF1044.2 +042800 MOVE 0.784913 TO MAX-RANGE. IF1044.2 +042900 F-ATAN-TEST-05. IF1044.2 +043000 COMPUTE WS-NUM = FUNCTION ATAN(.999). IF1044.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +043300 PERFORM PASS IF1044.2 +043400 ELSE IF1044.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +043800 PERFORM FAIL. IF1044.2 +043900 GO TO F-ATAN-WRITE-05. IF1044.2 +044000 F-ATAN-DELETE-05. IF1044.2 +044100 PERFORM DE-LETE. IF1044.2 +044200 GO TO F-ATAN-WRITE-05. IF1044.2 +044300 F-ATAN-WRITE-05. IF1044.2 +044400 MOVE "F-ATAN-05" TO PAR-NAME. IF1044.2 +044500 PERFORM PRINT-DETAIL. IF1044.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1044.2 +044700 F-ATAN-06. IF1044.2 +044800 MOVE ZERO TO WS-NUM. IF1044.2 +044900 MOVE 0.048959 TO MIN-RANGE. IF1044.2 +045000 MOVE 0.048961 TO MAX-RANGE. IF1044.2 +045100 F-ATAN-TEST-06. IF1044.2 +045200 COMPUTE WS-NUM = FUNCTION ATAN(.049). IF1044.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +045500 PERFORM PASS IF1044.2 +045600 ELSE IF1044.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +046000 PERFORM FAIL. IF1044.2 +046100 GO TO F-ATAN-WRITE-06. IF1044.2 +046200 F-ATAN-DELETE-06. IF1044.2 +046300 PERFORM DE-LETE. IF1044.2 +046400 GO TO F-ATAN-WRITE-06. IF1044.2 +046500 F-ATAN-WRITE-06. IF1044.2 +046600 MOVE "F-ATAN-06" TO PAR-NAME. IF1044.2 +046700 PERFORM PRINT-DETAIL. IF1044.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1044.2 +046900 F-ATAN-07. IF1044.2 +047000 MOVE ZERO TO WS-NUM. IF1044.2 +047100 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +047200 MOVE -0.000039 TO MAX-RANGE. IF1044.2 +047300 F-ATAN-TEST-07. IF1044.2 +047400 COMPUTE WS-NUM = FUNCTION ATAN(A). IF1044.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +047700 PERFORM PASS IF1044.2 +047800 ELSE IF1044.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +048200 PERFORM FAIL. IF1044.2 +048300 GO TO F-ATAN-WRITE-07. IF1044.2 +048400 F-ATAN-DELETE-07. IF1044.2 +048500 PERFORM DE-LETE. IF1044.2 +048600 GO TO F-ATAN-WRITE-07. IF1044.2 +048700 F-ATAN-WRITE-07. IF1044.2 +048800 MOVE "F-ATAN-07" TO PAR-NAME. IF1044.2 +048900 PERFORM PRINT-DETAIL. IF1044.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1044.2 +049100 F-ATAN-08. IF1044.2 +049200 MOVE ZERO TO WS-NUM. IF1044.2 +049300 MOVE 0.000019 TO MIN-RANGE. IF1044.2 +049400 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +049500 F-ATAN-TEST-08. IF1044.2 +049600 COMPUTE WS-NUM = FUNCTION ATAN(.00002). IF1044.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +049900 PERFORM PASS IF1044.2 +050000 ELSE IF1044.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +050400 PERFORM FAIL. IF1044.2 +050500 GO TO F-ATAN-WRITE-08. IF1044.2 +050600 F-ATAN-DELETE-08. IF1044.2 +050700 PERFORM DE-LETE. IF1044.2 +050800 GO TO F-ATAN-WRITE-08. IF1044.2 +050900 F-ATAN-WRITE-08. IF1044.2 +051000 MOVE "F-ATAN-08" TO PAR-NAME. IF1044.2 +051100 PERFORM PRINT-DETAIL. IF1044.2 +051200*****************TEST (i) - SIMPLE TEST***************** IF1044.2 +051300 F-ATAN-09. IF1044.2 +051400 MOVE ZERO TO WS-NUM. IF1044.2 +051500 MOVE -0.000020 TO MIN-RANGE. IF1044.2 +051600 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +051700 F-ATAN-TEST-09. IF1044.2 +051800 COMPUTE WS-NUM = FUNCTION ATAN(IND(B)). IF1044.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +052100 PERFORM PASS IF1044.2 +052200 ELSE IF1044.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +052600 PERFORM FAIL. IF1044.2 +052700 GO TO F-ATAN-WRITE-09. IF1044.2 +052800 F-ATAN-DELETE-09. IF1044.2 +052900 PERFORM DE-LETE. IF1044.2 +053000 GO TO F-ATAN-WRITE-09. IF1044.2 +053100 F-ATAN-WRITE-09. IF1044.2 +053200 MOVE "F-ATAN-09" TO PAR-NAME. IF1044.2 +053300 PERFORM PRINT-DETAIL. IF1044.2 +053400*****************TEST (a) - COMPLEX TEST**************** IF1044.2 +053500 F-ATAN-10. IF1044.2 +053600 MOVE ZERO TO WS-NUM. IF1044.2 +053700 MOVE 0.523577 TO MIN-RANGE. IF1044.2 +053800 MOVE 0.523619 TO MAX-RANGE. IF1044.2 +053900 F-ATAN-TEST-10. IF1044.2 +054000 COMPUTE WS-NUM = FUNCTION ATAN(1 / SQRT3). IF1044.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +054300 PERFORM PASS IF1044.2 +054400 ELSE IF1044.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +054800 PERFORM FAIL. IF1044.2 +054900 GO TO F-ATAN-WRITE-10. IF1044.2 +055000 F-ATAN-DELETE-10. IF1044.2 +055100 PERFORM DE-LETE. IF1044.2 +055200 GO TO F-ATAN-WRITE-10. IF1044.2 +055300 F-ATAN-WRITE-10. IF1044.2 +055400 MOVE "F-ATAN-10" TO PAR-NAME. IF1044.2 +055500 PERFORM PRINT-DETAIL. IF1044.2 +055600*****************TEST (b) - COMPLEX TEST**************** IF1044.2 +055700 F-ATAN-11. IF1044.2 +055800 MOVE ZERO TO WS-NUM. IF1044.2 +055900 MOVE 1.04715 TO MIN-RANGE. IF1044.2 +056000 MOVE 1.04723 TO MAX-RANGE. IF1044.2 +056100 F-ATAN-TEST-11. IF1044.2 +056200 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3). IF1044.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +056500 PERFORM PASS IF1044.2 +056600 ELSE IF1044.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +057000 PERFORM FAIL. IF1044.2 +057100 GO TO F-ATAN-WRITE-11. IF1044.2 +057200 F-ATAN-DELETE-11. IF1044.2 +057300 PERFORM DE-LETE. IF1044.2 +057400 GO TO F-ATAN-WRITE-11. IF1044.2 +057500 F-ATAN-WRITE-11. IF1044.2 +057600 MOVE "F-ATAN-11" TO PAR-NAME. IF1044.2 +057700 PERFORM PRINT-DETAIL. IF1044.2 +057800*****************TEST (c) - COMPLEX TEST**************** IF1044.2 +057900 F-ATAN-12. IF1044.2 +058000 MOVE ZERO TO WS-NUM. IF1044.2 +058100 MOVE 1.04690 TO MIN-RANGE. IF1044.2 +058200 MOVE 1.04698 TO MAX-RANGE. IF1044.2 +058300 F-ATAN-TEST-12. IF1044.2 +058400 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3 - .001). IF1044.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +058700 PERFORM PASS IF1044.2 +058800 ELSE IF1044.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +059200 PERFORM FAIL. IF1044.2 +059300 GO TO F-ATAN-WRITE-12. IF1044.2 +059400 F-ATAN-DELETE-12. IF1044.2 +059500 PERFORM DE-LETE. IF1044.2 +059600 GO TO F-ATAN-WRITE-12. IF1044.2 +059700 F-ATAN-WRITE-12. IF1044.2 +059800 MOVE "F-ATAN-12" TO PAR-NAME. IF1044.2 +059900 PERFORM PRINT-DETAIL. IF1044.2 +060000*****************TEST (d) - COMPLEX TEST**************** IF1044.2 +060100 F-ATAN-13. IF1044.2 +060200 MOVE ZERO TO WS-NUM. IF1044.2 +060300 MOVE 0.522827 TO MIN-RANGE. IF1044.2 +060400 MOVE 0.522869 TO MAX-RANGE. IF1044.2 +060500 F-ATAN-TEST-13. IF1044.2 +060600 COMPUTE WS-NUM = FUNCTION ATAN((1 / SQRT3) - .001). IF1044.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +060900 PERFORM PASS IF1044.2 +061000 ELSE IF1044.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +061400 PERFORM FAIL. IF1044.2 +061500 GO TO F-ATAN-WRITE-13. IF1044.2 +061600 F-ATAN-DELETE-13. IF1044.2 +061700 PERFORM DE-LETE. IF1044.2 +061800 GO TO F-ATAN-WRITE-13. IF1044.2 +061900 F-ATAN-WRITE-13. IF1044.2 +062000 MOVE "F-ATAN-13" TO PAR-NAME. IF1044.2 +062100 PERFORM PRINT-DETAIL. IF1044.2 +062200*****************TEST (e) - COMPLEX TEST**************** IF1044.2 +062300 F-ATAN-14. IF1044.2 +062400 MOVE ZERO TO WS-NUM. IF1044.2 +062500 MOVE -0.010000 TO MIN-RANGE. IF1044.2 +062600 MOVE -0.009998 TO MAX-RANGE. IF1044.2 +062700 F-ATAN-TEST-14. IF1044.2 +062800 COMPUTE WS-NUM = FUNCTION ATAN( 1 - 1.01). IF1044.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +063100 PERFORM PASS IF1044.2 +063200 ELSE IF1044.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +063600 PERFORM FAIL. IF1044.2 +063700 GO TO F-ATAN-WRITE-14. IF1044.2 +063800 F-ATAN-DELETE-14. IF1044.2 +063900 PERFORM DE-LETE. IF1044.2 +064000 GO TO F-ATAN-WRITE-14. IF1044.2 +064100 F-ATAN-WRITE-14. IF1044.2 +064200 MOVE "F-ATAN-14" TO PAR-NAME. IF1044.2 +064300 PERFORM PRINT-DETAIL. IF1044.2 +064400*****************TEST (f) - COMPLEX TEST**************** IF1044.2 +064500 F-ATAN-15. IF1044.2 +064600 MOVE ZERO TO WS-NUM. IF1044.2 +064700 MOVE 0.780342 TO MIN-RANGE. IF1044.2 +064800 MOVE 0.780404 TO MAX-RANGE. IF1044.2 +064900 F-ATAN-TEST-15. IF1044.2 +065000 COMPUTE WS-NUM = FUNCTION ATAN(1.98 / 2). IF1044.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +065300 PERFORM PASS IF1044.2 +065400 ELSE IF1044.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +065800 PERFORM FAIL. IF1044.2 +065900 GO TO F-ATAN-WRITE-15. IF1044.2 +066000 F-ATAN-DELETE-15. IF1044.2 +066100 PERFORM DE-LETE. IF1044.2 +066200 GO TO F-ATAN-WRITE-15. IF1044.2 +066300 F-ATAN-WRITE-15. IF1044.2 +066400 MOVE "F-ATAN-15" TO PAR-NAME. IF1044.2 +066500 PERFORM PRINT-DETAIL. IF1044.2 +066600*****************TEST (g) - COMPLEX TEST**************** IF1044.2 +066700 F-ATAN-16. IF1044.2 +066800 MOVE ZERO TO WS-NUM. IF1044.2 +066900 MOVE 1.04964 TO MIN-RANGE. IF1044.2 +067000 MOVE 1.04972 TO MAX-RANGE. IF1044.2 +067100 F-ATAN-TEST-16. IF1044.2 +067200 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3 + .01). IF1044.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +067500 PERFORM PASS IF1044.2 +067600 ELSE IF1044.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +068000 PERFORM FAIL. IF1044.2 +068100 GO TO F-ATAN-WRITE-16. IF1044.2 +068200 F-ATAN-DELETE-16. IF1044.2 +068300 PERFORM DE-LETE. IF1044.2 +068400 GO TO F-ATAN-WRITE-16. IF1044.2 +068500 F-ATAN-WRITE-16. IF1044.2 +068600 MOVE "F-ATAN-16" TO PAR-NAME. IF1044.2 +068700 PERFORM PRINT-DETAIL. IF1044.2 +068800*****************TEST (h) - COMPLEX TEST**************** IF1044.2 +068900 F-ATAN-17. IF1044.2 +069000 MOVE ZERO TO WS-NUM. IF1044.2 +069100 MOVE 0.531045 TO MIN-RANGE. IF1044.2 +069200 MOVE 0.531087 TO MAX-RANGE. IF1044.2 +069300 F-ATAN-TEST-17. IF1044.2 +069400 COMPUTE WS-NUM = FUNCTION ATAN((1 / SQRT3) + .01). IF1044.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +069700 PERFORM PASS IF1044.2 +069800 ELSE IF1044.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +070200 PERFORM FAIL. IF1044.2 +070300 GO TO F-ATAN-WRITE-17. IF1044.2 +070400 F-ATAN-DELETE-17. IF1044.2 +070500 PERFORM DE-LETE. IF1044.2 +070600 GO TO F-ATAN-WRITE-17. IF1044.2 +070700 F-ATAN-WRITE-17. IF1044.2 +070800 MOVE "F-ATAN-17" TO PAR-NAME. IF1044.2 +070900 PERFORM PRINT-DETAIL. IF1044.2 +071000*****************TEST (i) - COMPLEX TEST**************** IF1044.2 +071100 F-ATAN-18. IF1044.2 +071200 MOVE ZERO TO WS-NUM. IF1044.2 +071300 MOVE 1.19023 TO MIN-RANGE. IF1044.2 +071400 MOVE 1.19033 TO MAX-RANGE. IF1044.2 +071500 F-ATAN-TEST-18. IF1044.2 +071600 COMPUTE WS-NUM = FUNCTION ATAN(IND(3) / B). IF1044.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +071900 PERFORM PASS IF1044.2 +072000 ELSE IF1044.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +072400 PERFORM FAIL. IF1044.2 +072500 GO TO F-ATAN-WRITE-18. IF1044.2 +072600 F-ATAN-DELETE-18. IF1044.2 +072700 PERFORM DE-LETE. IF1044.2 +072800 GO TO F-ATAN-WRITE-18. IF1044.2 +072900 F-ATAN-WRITE-18. IF1044.2 +073000 MOVE "F-ATAN-18" TO PAR-NAME. IF1044.2 +073100 PERFORM PRINT-DETAIL. IF1044.2 +073200*****************TEST (j) - COMPLEX TEST**************** IF1044.2 +073300 F-ATAN-19. IF1044.2 +073400 MOVE ZERO TO WS-NUM. IF1044.2 +073500 MOVE 0.785367 TO MIN-RANGE. IF1044.2 +073600 MOVE 0.785429 TO MAX-RANGE. IF1044.2 +073700 F-ATAN-TEST-19. IF1044.2 +073800 COMPUTE WS-NUM = FUNCTION ATAN(4 - 3). IF1044.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +074100 PERFORM PASS IF1044.2 +074200 ELSE IF1044.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +074600 PERFORM FAIL. IF1044.2 +074700 GO TO F-ATAN-WRITE-19. IF1044.2 +074800 F-ATAN-DELETE-19. IF1044.2 +074900 PERFORM DE-LETE. IF1044.2 +075000 GO TO F-ATAN-WRITE-19. IF1044.2 +075100 F-ATAN-WRITE-19. IF1044.2 +075200 MOVE "F-ATAN-19" TO PAR-NAME. IF1044.2 +075300 PERFORM PRINT-DETAIL. IF1044.2 +075400*****************TEST (k) - COMPLEX TEST**************** IF1044.2 +075500 F-ATAN-20. IF1044.2 +075600 MOVE ZERO TO WS-NUM. IF1044.2 +075700 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +075800 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +075900 F-ATAN-TEST-20. IF1044.2 +076000 COMPUTE WS-NUM = FUNCTION ATAN(C - C). IF1044.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +076300 PERFORM PASS IF1044.2 +076400 ELSE IF1044.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +076800 PERFORM FAIL. IF1044.2 +076900 GO TO F-ATAN-WRITE-20. IF1044.2 +077000 F-ATAN-DELETE-20. IF1044.2 +077100 PERFORM DE-LETE. IF1044.2 +077200 GO TO F-ATAN-WRITE-20. IF1044.2 +077300 F-ATAN-WRITE-20. IF1044.2 +077400 MOVE "F-ATAN-20" TO PAR-NAME. IF1044.2 +077500 PERFORM PRINT-DETAIL. IF1044.2 +077600*****************TEST (l) - COMPLEX TEST**************** IF1044.2 +077700 F-ATAN-21. IF1044.2 +077800 MOVE ZERO TO WS-NUM. IF1044.2 +077900 MOVE 0.244968 TO MIN-RANGE. IF1044.2 +078000 MOVE 0.244988 TO MAX-RANGE. IF1044.2 +078100 F-ATAN-TEST-21. IF1044.2 +078200 COMPUTE WS-NUM = FUNCTION ATAN(0.25 * 1). IF1044.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +078500 PERFORM PASS IF1044.2 +078600 ELSE IF1044.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +079000 PERFORM FAIL. IF1044.2 +079100 GO TO F-ATAN-WRITE-21. IF1044.2 +079200 F-ATAN-DELETE-21. IF1044.2 +079300 PERFORM DE-LETE. IF1044.2 +079400 GO TO F-ATAN-WRITE-21. IF1044.2 +079500 F-ATAN-WRITE-21. IF1044.2 +079600 MOVE "F-ATAN-21" TO PAR-NAME. IF1044.2 +079700 PERFORM PRINT-DETAIL. IF1044.2 +079800*****************TEST (m) - COMPLEX TEST**************** IF1044.2 +079900 F-ATAN-22. IF1044.2 +080000 MOVE ZERO TO WS-NUM. IF1044.2 +080100 MOVE 0.308157 TO MIN-RANGE. IF1044.2 +080200 MOVE 0.308181 TO MAX-RANGE. IF1044.2 +080300 F-ATAN-TEST-22. IF1044.2 +080400 COMPUTE WS-NUM = FUNCTION ATAN(1 / PI). IF1044.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +080700 PERFORM PASS IF1044.2 +080800 ELSE IF1044.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +081200 PERFORM FAIL. IF1044.2 +081300 GO TO F-ATAN-WRITE-22. IF1044.2 +081400 F-ATAN-DELETE-22. IF1044.2 +081500 PERFORM DE-LETE. IF1044.2 +081600 GO TO F-ATAN-WRITE-22. IF1044.2 +081700 F-ATAN-WRITE-22. IF1044.2 +081800 MOVE "F-ATAN-22" TO PAR-NAME. IF1044.2 +081900 PERFORM PRINT-DETAIL. IF1044.2 +082000*****************TEST (n) - COMPLEX TEST**************** IF1044.2 +082100 F-ATAN-23. IF1044.2 +082200 MOVE ZERO TO WS-NUM. IF1044.2 +082300 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +082400 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +082500 F-ATAN-TEST-23. IF1044.2 +082600 COMPUTE WS-NUM = FUNCTION ATAN((D / D) - 1). IF1044.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +082900 PERFORM PASS IF1044.2 +083000 ELSE IF1044.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +083400 PERFORM FAIL. IF1044.2 +083500 GO TO F-ATAN-WRITE-23. IF1044.2 +083600 F-ATAN-DELETE-23. IF1044.2 +083700 PERFORM DE-LETE. IF1044.2 +083800 GO TO F-ATAN-WRITE-23. IF1044.2 +083900 F-ATAN-WRITE-23. IF1044.2 +084000 MOVE "F-ATAN-23" TO PAR-NAME. IF1044.2 +084100 PERFORM PRINT-DETAIL. IF1044.2 +084200*****************TEST (o) - COMPLEX TEST**************** IF1044.2 +084300 F-ATAN-24. IF1044.2 +084400 MOVE ZERO TO WS-NUM. IF1044.2 +084500 MOVE -0.709382 TO MIN-RANGE. IF1044.2 +084600 MOVE -0.709326 TO MAX-RANGE. IF1044.2 +084700 F-ATAN-TEST-24. IF1044.2 +084800 COMPUTE WS-NUM = FUNCTION ATAN(PI - 4). IF1044.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +085100 PERFORM PASS IF1044.2 +085200 ELSE IF1044.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +085600 PERFORM FAIL. IF1044.2 +085700 GO TO F-ATAN-WRITE-24. IF1044.2 +085800 F-ATAN-DELETE-24. IF1044.2 +085900 PERFORM DE-LETE. IF1044.2 +086000 GO TO F-ATAN-WRITE-24. IF1044.2 +086100 F-ATAN-WRITE-24. IF1044.2 +086200 MOVE "F-ATAN-24" TO PAR-NAME. IF1044.2 +086300 PERFORM PRINT-DETAIL. IF1044.2 +086400*****************TEST (p) - COMPLEX TEST**************** IF1044.2 +086500 F-ATAN-25. IF1044.2 +086600 MOVE ZERO TO WS-NUM. IF1044.2 +086700 MOVE 0.511215 TO MIN-RANGE. IF1044.2 +086800 MOVE 0.511255 TO MAX-RANGE. IF1044.2 +086900 F-ATAN-TEST-25. IF1044.2 +087000 COMPUTE WS-NUM = FUNCTION ATAN(FUNCTION ATAN(PI / 5)). IF1044.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +087300 PERFORM PASS IF1044.2 +087400 ELSE IF1044.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +087800 PERFORM FAIL. IF1044.2 +087900 GO TO F-ATAN-WRITE-25. IF1044.2 +088000 F-ATAN-DELETE-25. IF1044.2 +088100 PERFORM DE-LETE. IF1044.2 +088200 GO TO F-ATAN-WRITE-25. IF1044.2 +088300 F-ATAN-WRITE-25. IF1044.2 +088400 MOVE "F-ATAN-25" TO PAR-NAME. IF1044.2 +088500 PERFORM PRINT-DETAIL. IF1044.2 +088600*****************TEST (q) - COMPLEX TEST**************** IF1044.2 +088700 F-ATAN-26. IF1044.2 +088800 MOVE ZERO TO WS-NUM. IF1044.2 +088900 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +089000 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +089100 F-ATAN-TEST-26. IF1044.2 +089200 COMPUTE WS-NUM = FUNCTION ATAN(0.6) + FUNCTION ATAN(-0.6). IF1044.2 +089300 IF1044.2 +089400 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +089500 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +089600 PERFORM PASS IF1044.2 +089700 ELSE IF1044.2 +089800 MOVE WS-NUM TO COMPUTED-N IF1044.2 +089900 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +090000 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +090100 PERFORM FAIL. IF1044.2 +090200 GO TO F-ATAN-WRITE-26. IF1044.2 +090300 F-ATAN-DELETE-26. IF1044.2 +090400 PERFORM DE-LETE. IF1044.2 +090500 GO TO F-ATAN-WRITE-26. IF1044.2 +090600 F-ATAN-WRITE-26. IF1044.2 +090700 MOVE "F-ATAN-26" TO PAR-NAME. IF1044.2 +090800 PERFORM PRINT-DETAIL. IF1044.2 +090900*****************SPECIAL PERFORM TEST********************** IF1044.2 +091000 F-ATAN-27. IF1044.2 +091100 MOVE ZERO TO WS-NUM. IF1044.2 +091200 PERFORM F-ATAN-TEST-27 IF1044.2 +091300 UNTIL FUNCTION ATAN(ARG1) < 0. IF1044.2 +091400 PERFORM PASS. IF1044.2 +091500 GO TO F-ATAN-WRITE-27. IF1044.2 +091600 F-ATAN-TEST-27. IF1044.2 +091700 COMPUTE ARG1 = ARG1 - 0.25. IF1044.2 +091800 F-ATAN-DELETE-27. IF1044.2 +091900 PERFORM DE-LETE. IF1044.2 +092000 GO TO F-ATAN-WRITE-27. IF1044.2 +092100 F-ATAN-WRITE-27. IF1044.2 +092200 MOVE "F-ATAN-27" TO PAR-NAME. IF1044.2 +092300 PERFORM PRINT-DETAIL. IF1044.2 +092400********************END OF TESTS*************** IF1044.2 +092500 CCVS-EXIT SECTION. IF1044.2 +092600 CCVS-999999. IF1044.2 +092700 GO TO CLOSE-FILES. IF1044.2 +*END-OF,IF104A +*HEADER,COBOL,IF105A +000100 IDENTIFICATION DIVISION. IF1054.2 +000200 PROGRAM-ID. IF1054.2 +000300 IF105A. IF1054.2 +000400 IF1054.2 +000500*********************************************************** IF1054.2 +000600* * IF1054.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1054.2 +000800* It contains tests for the Intrinsic Function CHAR. * IF1054.2 +000900* * IF1054.2 +001000* * IF1054.2 +001100*********************************************************** IF1054.2 +001200 ENVIRONMENT DIVISION. IF1054.2 +001300 CONFIGURATION SECTION. IF1054.2 +001400 SOURCE-COMPUTER. IF1054.2 +001500 XXXXX082. IF1054.2 +001600 OBJECT-COMPUTER. IF1054.2 +001700 XXXXX083 IF1054.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1054.2 +001900 SPECIAL-NAMES. IF1054.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1054.2 +002100 STANDARD-2. IF1054.2 +002200 INPUT-OUTPUT SECTION. IF1054.2 +002300 FILE-CONTROL. IF1054.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1054.2 +002500 XXXXX055. IF1054.2 +002600 DATA DIVISION. IF1054.2 +002700 FILE SECTION. IF1054.2 +002800 FD PRINT-FILE. IF1054.2 +002900 01 PRINT-REC PICTURE X(120). IF1054.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1054.2 +003100 WORKING-STORAGE SECTION. IF1054.2 +003200*********************************************************** IF1054.2 +003300* Variables specific to the Intrinsic Function Test IF105A* IF1054.2 +003400*********************************************************** IF1054.2 +003500 01 B PIC S9(10) VALUE 37. IF1054.2 +003600 01 C PIC S9(10) VALUE 2. IF1054.2 +003700 01 D PIC S9(10) VALUE 100. IF1054.2 +003800 01 ARR VALUE "066037100070044". IF1054.2 +003900 02 IND OCCURS 5 TIMES PIC 9(3). IF1054.2 +004000 01 TEMP PIC S9(5)V9(5). IF1054.2 +004100 01 WS-ANUM PIC X. IF1054.2 +004200* IF1054.2 +004300********************************************************** IF1054.2 +004400* IF1054.2 +004500 01 TEST-RESULTS. IF1054.2 +004600 02 FILLER PIC X VALUE SPACE. IF1054.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1054.2 +004800 02 FILLER PIC X VALUE SPACE. IF1054.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1054.2 +005000 02 FILLER PIC X VALUE SPACE. IF1054.2 +005100 02 PAR-NAME. IF1054.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1054.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1054.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1054.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1054.2 +005600 02 RE-MARK PIC X(61). IF1054.2 +005700 01 TEST-COMPUTED. IF1054.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +005900 02 FILLER PIC X(17) VALUE IF1054.2 +006000 " COMPUTED=". IF1054.2 +006100 02 COMPUTED-X. IF1054.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1054.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1054.2 +006400 PIC -9(9).9(9). IF1054.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1054.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1054.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1054.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1054.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1054.2 +007000 04 FILLER PIC X. IF1054.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1054.2 +007200 01 TEST-CORRECT. IF1054.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1054.2 +007500 02 CORRECT-X. IF1054.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1054.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1054.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1054.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1054.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1054.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1054.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1054.2 +008300 04 FILLER PIC X. IF1054.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1054.2 +008600 01 TEST-CORRECT-MIN. IF1054.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +008800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1054.2 +008900 02 CORRECTMI-X. IF1054.2 +009000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1054.2 +009100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1054.2 +009200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1054.2 +009300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1054.2 +009400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1054.2 +009500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1054.2 +009600 04 CORRECTMI-18V0 PIC -9(18). IF1054.2 +009700 04 FILLER PIC X. IF1054.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +009900 03 FILLER PIC X(48) VALUE SPACE. IF1054.2 +010000 01 TEST-CORRECT-MAX. IF1054.2 +010100 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +010200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1054.2 +010300 02 CORRECTMA-X. IF1054.2 +010400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1054.2 +010500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1054.2 +010600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1054.2 +010700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1054.2 +010800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1054.2 +010900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1054.2 +011000 04 CORRECTMA-18V0 PIC -9(18). IF1054.2 +011100 04 FILLER PIC X. IF1054.2 +011200 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +011300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1054.2 +011400 01 CCVS-C-1. IF1054.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1054.2 +011600- "SS PARAGRAPH-NAME IF1054.2 +011700- " REMARKS". IF1054.2 +011800 02 FILLER PIC X(20) VALUE SPACE. IF1054.2 +011900 01 CCVS-C-2. IF1054.2 +012000 02 FILLER PIC X VALUE SPACE. IF1054.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". IF1054.2 +012200 02 FILLER PIC X(15) VALUE SPACE. IF1054.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". IF1054.2 +012400 02 FILLER PIC X(94) VALUE SPACE. IF1054.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1054.2 +012600 01 REC-CT PIC 99 VALUE ZERO. IF1054.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1054.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1054.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1054.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1054.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1054.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1054.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1054.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1054.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1054.2 +013600 01 CCVS-H-1. IF1054.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1054.2 +013800 02 FILLER PIC X(42) VALUE IF1054.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1054.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1054.2 +014100 01 CCVS-H-2A. IF1054.2 +014200 02 FILLER PIC X(40) VALUE SPACE. IF1054.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1054.2 +014400 02 FILLER PIC XXXX VALUE IF1054.2 +014500 "4.2 ". IF1054.2 +014600 02 FILLER PIC X(28) VALUE IF1054.2 +014700 " COPY - NOT FOR DISTRIBUTION". IF1054.2 +014800 02 FILLER PIC X(41) VALUE SPACE. IF1054.2 +014900 IF1054.2 +015000 01 CCVS-H-2B. IF1054.2 +015100 02 FILLER PIC X(15) VALUE IF1054.2 +015200 "TEST RESULT OF ". IF1054.2 +015300 02 TEST-ID PIC X(9). IF1054.2 +015400 02 FILLER PIC X(4) VALUE IF1054.2 +015500 " IN ". IF1054.2 +015600 02 FILLER PIC X(12) VALUE IF1054.2 +015700 " HIGH ". IF1054.2 +015800 02 FILLER PIC X(22) VALUE IF1054.2 +015900 " LEVEL VALIDATION FOR ". IF1054.2 +016000 02 FILLER PIC X(58) VALUE IF1054.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1054.2 +016200 01 CCVS-H-3. IF1054.2 +016300 02 FILLER PIC X(34) VALUE IF1054.2 +016400 " FOR OFFICIAL USE ONLY ". IF1054.2 +016500 02 FILLER PIC X(58) VALUE IF1054.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1054.2 +016700 02 FILLER PIC X(28) VALUE IF1054.2 +016800 " COPYRIGHT 1985 ". IF1054.2 +016900 01 CCVS-E-1. IF1054.2 +017000 02 FILLER PIC X(52) VALUE SPACE. IF1054.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1054.2 +017200 02 ID-AGAIN PIC X(9). IF1054.2 +017300 02 FILLER PIC X(45) VALUE SPACES. IF1054.2 +017400 01 CCVS-E-2. IF1054.2 +017500 02 FILLER PIC X(31) VALUE SPACE. IF1054.2 +017600 02 FILLER PIC X(21) VALUE SPACE. IF1054.2 +017700 02 CCVS-E-2-2. IF1054.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1054.2 +017900 03 FILLER PIC X VALUE SPACE. IF1054.2 +018000 03 ENDER-DESC PIC X(44) VALUE IF1054.2 +018100 "ERRORS ENCOUNTERED". IF1054.2 +018200 01 CCVS-E-3. IF1054.2 +018300 02 FILLER PIC X(22) VALUE IF1054.2 +018400 " FOR OFFICIAL USE ONLY". IF1054.2 +018500 02 FILLER PIC X(12) VALUE SPACE. IF1054.2 +018600 02 FILLER PIC X(58) VALUE IF1054.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1054.2 +018800 02 FILLER PIC X(13) VALUE SPACE. IF1054.2 +018900 02 FILLER PIC X(15) VALUE IF1054.2 +019000 " COPYRIGHT 1985". IF1054.2 +019100 01 CCVS-E-4. IF1054.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1054.2 +019300 02 FILLER PIC X(4) VALUE " OF ". IF1054.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1054.2 +019500 02 FILLER PIC X(40) VALUE IF1054.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1054.2 +019700 01 XXINFO. IF1054.2 +019800 02 FILLER PIC X(19) VALUE IF1054.2 +019900 "*** INFORMATION ***". IF1054.2 +020000 02 INFO-TEXT. IF1054.2 +020100 04 FILLER PIC X(8) VALUE SPACE. IF1054.2 +020200 04 XXCOMPUTED PIC X(20). IF1054.2 +020300 04 FILLER PIC X(5) VALUE SPACE. IF1054.2 +020400 04 XXCORRECT PIC X(20). IF1054.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). IF1054.2 +020600 01 HYPHEN-LINE. IF1054.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. IF1054.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************IF1054.2 +020900- "*****************************************". IF1054.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************IF1054.2 +021100- "******************************". IF1054.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE IF1054.2 +021300 "IF105A". IF1054.2 +021400 PROCEDURE DIVISION. IF1054.2 +021500 CCVS1 SECTION. IF1054.2 +021600 OPEN-FILES. IF1054.2 +021700 OPEN OUTPUT PRINT-FILE. IF1054.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1054.2 +021900 MOVE SPACE TO TEST-RESULTS. IF1054.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1054.2 +022100 GO TO CCVS1-EXIT. IF1054.2 +022200 CLOSE-FILES. IF1054.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1054.2 +022400 TERMINATE-CCVS. IF1054.2 +022500 STOP RUN. IF1054.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1054.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1054.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1054.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1054.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. IF1054.2 +023100 PRINT-DETAIL. IF1054.2 +023200 IF REC-CT NOT EQUAL TO ZERO IF1054.2 +023300 MOVE "." TO PARDOT-X IF1054.2 +023400 MOVE REC-CT TO DOTVALUE. IF1054.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1054.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1054.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1054.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1054.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1054.2 +024000 MOVE SPACE TO CORRECT-X. IF1054.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1054.2 +024200 MOVE SPACE TO RE-MARK. IF1054.2 +024300 HEAD-ROUTINE. IF1054.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1054.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1054.2 +024800 COLUMN-NAMES-ROUTINE. IF1054.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +025200 END-ROUTINE. IF1054.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1054.2 +025400 END-RTN-EXIT. IF1054.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +025600 END-ROUTINE-1. IF1054.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1054.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1054.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. IF1054.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1054.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1054.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1054.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1054.2 +026400 END-ROUTINE-12. IF1054.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1054.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1054.2 +026700 MOVE "NO " TO ERROR-TOTAL IF1054.2 +026800 ELSE IF1054.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1054.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1054.2 +027100 PERFORM WRITE-LINE. IF1054.2 +027200 END-ROUTINE-13. IF1054.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1054.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE IF1054.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1054.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1054.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO IF1054.2 +027900 MOVE "NO " TO ERROR-TOTAL IF1054.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1054.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1054.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +028400 WRITE-LINE. IF1054.2 +028500 ADD 1 TO RECORD-COUNT. IF1054.2 +028600Y IF RECORD-COUNT GREATER 42 IF1054.2 +028700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1054.2 +028800Y MOVE SPACE TO DUMMY-RECORD IF1054.2 +028900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1054.2 +029000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1054.2 +029100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1054.2 +029200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1054.2 +029300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1054.2 +029400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1054.2 +029800Y MOVE ZERO TO RECORD-COUNT. IF1054.2 +029900 PERFORM WRT-LN. IF1054.2 +030000 WRT-LN. IF1054.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1054.2 +030200 MOVE SPACE TO DUMMY-RECORD. IF1054.2 +030300 BLANK-LINE-PRINT. IF1054.2 +030400 PERFORM WRT-LN. IF1054.2 +030500 FAIL-ROUTINE. IF1054.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE IF1054.2 +030700 GO TO FAIL-ROUTINE-WRITE. IF1054.2 +030800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1054.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1054.2 +031000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1054.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1054.2 +031300 GO TO FAIL-ROUTINE-EX. IF1054.2 +031400 FAIL-ROUTINE-WRITE. IF1054.2 +031500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1054.2 +031600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1054.2 +031700 CORMA-ANSI-REFERENCE. IF1054.2 +031800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1054.2 +031900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1054.2 +032000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1054.2 +032100 ELSE IF1054.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1054.2 +032300 PERFORM WRITE-LINE. IF1054.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1054.2 +032500 FAIL-ROUTINE-EX. EXIT. IF1054.2 +032600 BAIL-OUT. IF1054.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1054.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1054.2 +032900 BAIL-OUT-WRITE. IF1054.2 +033000 MOVE CORRECT-A TO XXCORRECT. IF1054.2 +033100 MOVE COMPUTED-A TO XXCOMPUTED. IF1054.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1054.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1054.2 +033500 BAIL-OUT-EX. EXIT. IF1054.2 +033600 CCVS1-EXIT. IF1054.2 +033700 EXIT. IF1054.2 +033800******************************************************** IF1054.2 +033900* * IF1054.2 +034000* Intrinsic Function Tests IF105A - CHAR * IF1054.2 +034100* * IF1054.2 +034200******************************************************** IF1054.2 +034300 SECT-IF105A SECTION. IF1054.2 +034400 F-CHAR-INFO. IF1054.2 +034500 MOVE "See ref. A-37 2.9" TO ANSI-REFERENCE. IF1054.2 +034600 MOVE "CHAR Function" TO FEATURE. IF1054.2 +034700*****************TEST (a) ****************************** IF1054.2 +034800 F-CHAR-01. IF1054.2 +034900 MOVE SPACE TO WS-ANUM. IF1054.2 +035000 F-CHAR-TEST-01. IF1054.2 +035100 MOVE FUNCTION CHAR(37) TO WS-ANUM. IF1054.2 +035200 IF WS-ANUM = "$" THEN IF1054.2 +035300 PERFORM PASS IF1054.2 +035400 ELSE IF1054.2 +035500 MOVE "$" TO CORRECT-X IF1054.2 +035600 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +035700 PERFORM FAIL. IF1054.2 +035800 GO TO F-CHAR-WRITE-01. IF1054.2 +035900 F-CHAR-DELETE-01. IF1054.2 +036000 PERFORM DE-LETE. IF1054.2 +036100 GO TO F-CHAR-WRITE-01. IF1054.2 +036200 F-CHAR-WRITE-01. IF1054.2 +036300 MOVE "F-CHAR-01" TO PAR-NAME. IF1054.2 +036400 PERFORM PRINT-DETAIL. IF1054.2 +036500*****************TEST (b) ****************************** IF1054.2 +036600 F-CHAR-TEST-02. IF1054.2 +036700 IF FUNCTION CHAR(B) = "$" THEN IF1054.2 +036800 PERFORM PASS IF1054.2 +036900 ELSE IF1054.2 +037000 PERFORM FAIL. IF1054.2 +037100 GO TO F-CHAR-WRITE-02. IF1054.2 +037200 F-CHAR-DELETE-02. IF1054.2 +037300 PERFORM DE-LETE. IF1054.2 +037400 GO TO F-CHAR-WRITE-02. IF1054.2 +037500 F-CHAR-WRITE-02. IF1054.2 +037600 MOVE "F-CHAR-02" TO PAR-NAME. IF1054.2 +037700 PERFORM PRINT-DETAIL. IF1054.2 +037800*****************TEST (c) ****************************** IF1054.2 +037900 F-CHAR-03. IF1054.2 +038000 MOVE SPACE TO WS-ANUM. IF1054.2 +038100 F-CHAR-TEST-03. IF1054.2 +038200 MOVE FUNCTION CHAR(IND(5)) TO WS-ANUM. IF1054.2 +038300 IF WS-ANUM = "+" THEN IF1054.2 +038400 PERFORM PASS IF1054.2 +038500 ELSE IF1054.2 +038600 MOVE "+" TO CORRECT-X IF1054.2 +038700 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +038800 PERFORM FAIL. IF1054.2 +038900 GO TO F-CHAR-WRITE-03. IF1054.2 +039000 F-CHAR-DELETE-03. IF1054.2 +039100 PERFORM DE-LETE. IF1054.2 +039200 GO TO F-CHAR-WRITE-03. IF1054.2 +039300 F-CHAR-WRITE-03. IF1054.2 +039400 MOVE "F-CHAR-03" TO PAR-NAME. IF1054.2 +039500 PERFORM PRINT-DETAIL. IF1054.2 +039600*****************TEST (d) ****************************** IF1054.2 +039700 F-CHAR-04. IF1054.2 +039800 MOVE SPACE TO WS-ANUM. IF1054.2 +039900 F-CHAR-TEST-04. IF1054.2 +040000 MOVE FUNCTION CHAR(IND(C)) TO WS-ANUM. IF1054.2 +040100 IF WS-ANUM = "$" THEN IF1054.2 +040200 PERFORM PASS IF1054.2 +040300 ELSE IF1054.2 +040400 MOVE "$" TO CORRECT-X IF1054.2 +040500 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +040600 PERFORM FAIL. IF1054.2 +040700 GO TO F-CHAR-WRITE-04. IF1054.2 +040800 F-CHAR-DELETE-04. IF1054.2 +040900 PERFORM DE-LETE. IF1054.2 +041000 GO TO F-CHAR-WRITE-04. IF1054.2 +041100 F-CHAR-WRITE-04. IF1054.2 +041200 MOVE "F-CHAR-04" TO PAR-NAME. IF1054.2 +041300 PERFORM PRINT-DETAIL. IF1054.2 +041400*****************TEST (e) ****************************** IF1054.2 +041500 F-CHAR-05. IF1054.2 +041600 MOVE SPACE TO WS-ANUM. IF1054.2 +041700 F-CHAR-TEST-05. IF1054.2 +041800 MOVE FUNCTION CHAR(87) TO WS-ANUM. IF1054.2 +041900 IF WS-ANUM = "V" THEN IF1054.2 +042000 PERFORM PASS IF1054.2 +042100 ELSE IF1054.2 +042200 MOVE "V" TO CORRECT-X IF1054.2 +042300 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +042400 PERFORM FAIL. IF1054.2 +042500 GO TO F-CHAR-WRITE-05. IF1054.2 +042600 F-CHAR-DELETE-05. IF1054.2 +042700 PERFORM DE-LETE. IF1054.2 +042800 GO TO F-CHAR-WRITE-05. IF1054.2 +042900 F-CHAR-WRITE-05. IF1054.2 +043000 MOVE "F-CHAR-05" TO PAR-NAME. IF1054.2 +043100 PERFORM PRINT-DETAIL. IF1054.2 +043200*****************TEST (f) ****************************** IF1054.2 +043300 F-CHAR-06. IF1054.2 +043400 MOVE SPACE TO WS-ANUM. IF1054.2 +043500 F-CHAR-TEST-06. IF1054.2 +043600 MOVE FUNCTION CHAR(D) TO WS-ANUM. IF1054.2 +043700 IF WS-ANUM = "c" THEN IF1054.2 +043800 PERFORM PASS IF1054.2 +043900 ELSE IF1054.2 +044000 MOVE "c" TO CORRECT-X IF1054.2 +044100 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +044200 PERFORM FAIL. IF1054.2 +044300 GO TO F-CHAR-WRITE-06. IF1054.2 +044400 F-CHAR-DELETE-06. IF1054.2 +044500 PERFORM DE-LETE. IF1054.2 +044600 GO TO F-CHAR-WRITE-06. IF1054.2 +044700 F-CHAR-WRITE-06. IF1054.2 +044800 MOVE "F-CHAR-06" TO PAR-NAME. IF1054.2 +044900 PERFORM PRINT-DETAIL. IF1054.2 +045000*****************TEST (g) ****************************** IF1054.2 +045100 F-CHAR-07. IF1054.2 +045200 MOVE SPACE TO WS-ANUM. IF1054.2 +045300 F-CHAR-TEST-07. IF1054.2 +045400 IF1054.2 +045500 IF FUNCTION ORD(FUNCTION CHAR(2)) = 2 THEN IF1054.2 +045600 PERFORM PASS IF1054.2 +045700 ELSE IF1054.2 +045800 MOVE 2 TO CORRECT-N IF1054.2 +045900 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +046000 PERFORM FAIL. IF1054.2 +046100 GO TO F-CHAR-WRITE-07. IF1054.2 +046200 F-CHAR-DELETE-07. IF1054.2 +046300 PERFORM DE-LETE. IF1054.2 +046400 GO TO F-CHAR-WRITE-07. IF1054.2 +046500 F-CHAR-WRITE-07. IF1054.2 +046600 MOVE "F-CHAR-07" TO PAR-NAME. IF1054.2 +046700 PERFORM PRINT-DETAIL. IF1054.2 +046800*****************TEST (h) ****************************** IF1054.2 +046900 F-CHAR-08. IF1054.2 +047000 MOVE SPACE TO WS-ANUM. IF1054.2 +047100 F-CHAR-TEST-08. IF1054.2 +047200 IF FUNCTION ORD(FUNCTION CHAR(4)) + IF1054.2 +047300 FUNCTION ORD(FUNCTION CHAR(7)) = 11 THEN IF1054.2 +047400 PERFORM PASS IF1054.2 +047500 ELSE IF1054.2 +047600 PERFORM FAIL. IF1054.2 +047700 GO TO F-CHAR-WRITE-08. IF1054.2 +047800 F-CHAR-DELETE-08. IF1054.2 +047900 PERFORM DE-LETE. IF1054.2 +048000 GO TO F-CHAR-WRITE-08. IF1054.2 +048100 F-CHAR-WRITE-08. IF1054.2 +048200 MOVE "F-CHAR-08" TO PAR-NAME. IF1054.2 +048300 PERFORM PRINT-DETAIL. IF1054.2 +048400*******************END OF TESTS************************** IF1054.2 +048500 CCVS-EXIT SECTION. IF1054.2 +048600 CCVS-999999. IF1054.2 +048700 GO TO CLOSE-FILES. IF1054.2 +*END-OF,IF105A +*HEADER,COBOL,IF106A +000100 IDENTIFICATION DIVISION. IF1064.2 +000200 PROGRAM-ID. IF1064.2 +000300 IF106A. IF1064.2 +000400 IF1064.2 +000500*********************************************************** IF1064.2 +000600* * IF1064.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1064.2 +000800* It contains tests for the Intrinsic Function COS. * IF1064.2 +000900* * IF1064.2 +001000*********************************************************** IF1064.2 +001100 ENVIRONMENT DIVISION. IF1064.2 +001200 CONFIGURATION SECTION. IF1064.2 +001300 SOURCE-COMPUTER. IF1064.2 +001400 XXXXX082. IF1064.2 +001500 OBJECT-COMPUTER. IF1064.2 +001600 XXXXX083. IF1064.2 +001700 INPUT-OUTPUT SECTION. IF1064.2 +001800 FILE-CONTROL. IF1064.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1064.2 +002000 XXXXX055. IF1064.2 +002100 DATA DIVISION. IF1064.2 +002200 FILE SECTION. IF1064.2 +002300 FD PRINT-FILE. IF1064.2 +002400 01 PRINT-REC PICTURE X(120). IF1064.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1064.2 +002600 WORKING-STORAGE SECTION. IF1064.2 +002700*********************************************************** IF1064.2 +002800* Variables specific to the Intrinsic Function Test IF106A* IF1064.2 +002900*********************************************************** IF1064.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1064.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1064.2 +003200 01 C PIC S9(10) VALUE 100000. IF1064.2 +003300 01 D PIC S9(10) VALUE 1000. IF1064.2 +003400 01 E PIC S9(10) VALUE 3. IF1064.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1064.2 +003600 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1064.2 +003700 01 ARG1 PIC S9V9(17) VALUE 1.00. IF1064.2 +003800 01 ARR VALUE "40537". IF1064.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1064.2 +004000 01 TEMP PIC S9(5)V9(5). IF1064.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1064.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1064.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1064.2 +004400* IF1064.2 +004500********************************************************** IF1064.2 +004600* IF1064.2 +004700 01 TEST-RESULTS. IF1064.2 +004800 02 FILLER PIC X VALUE SPACE. IF1064.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1064.2 +005000 02 FILLER PIC X VALUE SPACE. IF1064.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1064.2 +005200 02 FILLER PIC X VALUE SPACE. IF1064.2 +005300 02 PAR-NAME. IF1064.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1064.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1064.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1064.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1064.2 +005800 02 RE-MARK PIC X(61). IF1064.2 +005900 01 TEST-COMPUTED. IF1064.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +006100 02 FILLER PIC X(17) VALUE IF1064.2 +006200 " COMPUTED=". IF1064.2 +006300 02 COMPUTED-X. IF1064.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1064.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1064.2 +006600 PIC -9(9).9(9). IF1064.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1064.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1064.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1064.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1064.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1064.2 +007200 04 FILLER PIC X. IF1064.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1064.2 +007400 01 TEST-CORRECT. IF1064.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1064.2 +007700 02 CORRECT-X. IF1064.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1064.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1064.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1064.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1064.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1064.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1064.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1064.2 +008500 04 FILLER PIC X. IF1064.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1064.2 +008800 01 TEST-CORRECT-MIN. IF1064.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1064.2 +009100 02 CORRECTMI-X. IF1064.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1064.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1064.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1064.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1064.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1064.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1064.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1064.2 +009900 04 FILLER PIC X. IF1064.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1064.2 +010200 01 TEST-CORRECT-MAX. IF1064.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1064.2 +010500 02 CORRECTMA-X. IF1064.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1064.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1064.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1064.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1064.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1064.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1064.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1064.2 +011300 04 FILLER PIC X. IF1064.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1064.2 +011600 01 CCVS-C-1. IF1064.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1064.2 +011800- "SS PARAGRAPH-NAME IF1064.2 +011900- " REMARKS". IF1064.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1064.2 +012100 01 CCVS-C-2. IF1064.2 +012200 02 FILLER PIC X VALUE SPACE. IF1064.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1064.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1064.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1064.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1064.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1064.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1064.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1064.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1064.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1064.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1064.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1064.2 +013800 01 CCVS-H-1. IF1064.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1064.2 +014000 02 FILLER PIC X(42) VALUE IF1064.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1064.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1064.2 +014300 01 CCVS-H-2A. IF1064.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1064.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1064.2 +014600 02 FILLER PIC XXXX VALUE IF1064.2 +014700 "4.2 ". IF1064.2 +014800 02 FILLER PIC X(28) VALUE IF1064.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1064.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1064.2 +015100 IF1064.2 +015200 01 CCVS-H-2B. IF1064.2 +015300 02 FILLER PIC X(15) VALUE IF1064.2 +015400 "TEST RESULT OF ". IF1064.2 +015500 02 TEST-ID PIC X(9). IF1064.2 +015600 02 FILLER PIC X(4) VALUE IF1064.2 +015700 " IN ". IF1064.2 +015800 02 FILLER PIC X(12) VALUE IF1064.2 +015900 " HIGH ". IF1064.2 +016000 02 FILLER PIC X(22) VALUE IF1064.2 +016100 " LEVEL VALIDATION FOR ". IF1064.2 +016200 02 FILLER PIC X(58) VALUE IF1064.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1064.2 +016400 01 CCVS-H-3. IF1064.2 +016500 02 FILLER PIC X(34) VALUE IF1064.2 +016600 " FOR OFFICIAL USE ONLY ". IF1064.2 +016700 02 FILLER PIC X(58) VALUE IF1064.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1064.2 +016900 02 FILLER PIC X(28) VALUE IF1064.2 +017000 " COPYRIGHT 1985 ". IF1064.2 +017100 01 CCVS-E-1. IF1064.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1064.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1064.2 +017400 02 ID-AGAIN PIC X(9). IF1064.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1064.2 +017600 01 CCVS-E-2. IF1064.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1064.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1064.2 +017900 02 CCVS-E-2-2. IF1064.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1064.2 +018100 03 FILLER PIC X VALUE SPACE. IF1064.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1064.2 +018300 "ERRORS ENCOUNTERED". IF1064.2 +018400 01 CCVS-E-3. IF1064.2 +018500 02 FILLER PIC X(22) VALUE IF1064.2 +018600 " FOR OFFICIAL USE ONLY". IF1064.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1064.2 +018800 02 FILLER PIC X(58) VALUE IF1064.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1064.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1064.2 +019100 02 FILLER PIC X(15) VALUE IF1064.2 +019200 " COPYRIGHT 1985". IF1064.2 +019300 01 CCVS-E-4. IF1064.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1064.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1064.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1064.2 +019700 02 FILLER PIC X(40) VALUE IF1064.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1064.2 +019900 01 XXINFO. IF1064.2 +020000 02 FILLER PIC X(19) VALUE IF1064.2 +020100 "*** INFORMATION ***". IF1064.2 +020200 02 INFO-TEXT. IF1064.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1064.2 +020400 04 XXCOMPUTED PIC X(20). IF1064.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1064.2 +020600 04 XXCORRECT PIC X(20). IF1064.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1064.2 +020800 01 HYPHEN-LINE. IF1064.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1064.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1064.2 +021100- "*****************************************". IF1064.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1064.2 +021300- "******************************". IF1064.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1064.2 +021500 "IF106A". IF1064.2 +021600 PROCEDURE DIVISION. IF1064.2 +021700 CCVS1 SECTION. IF1064.2 +021800 OPEN-FILES. IF1064.2 +021900 OPEN OUTPUT PRINT-FILE. IF1064.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1064.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1064.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1064.2 +022300 GO TO CCVS1-EXIT. IF1064.2 +022400 CLOSE-FILES. IF1064.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1064.2 +022600 TERMINATE-CCVS. IF1064.2 +022700 STOP RUN. IF1064.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1064.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1064.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1064.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1064.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1064.2 +023300 PRINT-DETAIL. IF1064.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1064.2 +023500 MOVE "." TO PARDOT-X IF1064.2 +023600 MOVE REC-CT TO DOTVALUE. IF1064.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1064.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1064.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1064.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1064.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1064.2 +024200 MOVE SPACE TO CORRECT-X. IF1064.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1064.2 +024400 MOVE SPACE TO RE-MARK. IF1064.2 +024500 HEAD-ROUTINE. IF1064.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1064.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1064.2 +025000 COLUMN-NAMES-ROUTINE. IF1064.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +025400 END-ROUTINE. IF1064.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1064.2 +025600 END-RTN-EXIT. IF1064.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +025800 END-ROUTINE-1. IF1064.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1064.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1064.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1064.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1064.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1064.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1064.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1064.2 +026600 END-ROUTINE-12. IF1064.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1064.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1064.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1064.2 +027000 ELSE IF1064.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1064.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1064.2 +027300 PERFORM WRITE-LINE. IF1064.2 +027400 END-ROUTINE-13. IF1064.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1064.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1064.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1064.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1064.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1064.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1064.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1064.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1064.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028600 WRITE-LINE. IF1064.2 +028700 ADD 1 TO RECORD-COUNT. IF1064.2 +028800Y IF RECORD-COUNT GREATER 42 IF1064.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1064.2 +029000Y MOVE SPACE TO DUMMY-RECORD IF1064.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1064.2 +029200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1064.2 +029300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1064.2 +029400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1064.2 +029500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1064.2 +029600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1064.2 +030000Y MOVE ZERO TO RECORD-COUNT. IF1064.2 +030100 PERFORM WRT-LN. IF1064.2 +030200 WRT-LN. IF1064.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1064.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1064.2 +030500 BLANK-LINE-PRINT. IF1064.2 +030600 PERFORM WRT-LN. IF1064.2 +030700 FAIL-ROUTINE. IF1064.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1064.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1064.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1064.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1064.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1064.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1064.2 +031500 GO TO FAIL-ROUTINE-EX. IF1064.2 +031600 FAIL-ROUTINE-WRITE. IF1064.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1064.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1064.2 +031900 CORMA-ANSI-REFERENCE. IF1064.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1064.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1064.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1064.2 +032300 ELSE IF1064.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1064.2 +032500 PERFORM WRITE-LINE. IF1064.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1064.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1064.2 +032800 BAIL-OUT. IF1064.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1064.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1064.2 +033100 BAIL-OUT-WRITE. IF1064.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1064.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1064.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1064.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1064.2 +033700 BAIL-OUT-EX. EXIT. IF1064.2 +033800 CCVS1-EXIT. IF1064.2 +033900 EXIT. IF1064.2 +034000******************************************************** IF1064.2 +034100* * IF1064.2 +034200* Intrinsic Function Tests IF106A - COS * IF1064.2 +034300* * IF1064.2 +034400******************************************************** IF1064.2 +034500 SECT-IF106A SECTION. IF1064.2 +034600 F-COS-INFO. IF1064.2 +034700 MOVE "See ref. A-38 2.8" TO ANSI-REFERENCE. IF1064.2 +034800 MOVE "COS Function" TO FEATURE. IF1064.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1064.2 +035000 F-COS-01. IF1064.2 +035100 MOVE ZERO TO WS-NUM. IF1064.2 +035200 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +035300 MOVE 1.00000 TO MAX-RANGE. IF1064.2 +035400 F-COS-TEST-01. IF1064.2 +035500 COMPUTE WS-NUM = FUNCTION COS(0). IF1064.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +035800 PERFORM PASS IF1064.2 +035900 ELSE IF1064.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +036300 PERFORM FAIL. IF1064.2 +036400 GO TO F-COS-WRITE-01. IF1064.2 +036500 F-COS-DELETE-01. IF1064.2 +036600 PERFORM DE-LETE. IF1064.2 +036700 GO TO F-COS-WRITE-01. IF1064.2 +036800 F-COS-WRITE-01. IF1064.2 +036900 MOVE "F-COS-01" TO PAR-NAME. IF1064.2 +037000 PERFORM PRINT-DETAIL. IF1064.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1064.2 +037200 F-COS-02. IF1064.2 +037300 MOVE ZERO TO WS-NUM. IF1064.2 +037400 MOVE -1.00000 TO MIN-RANGE. IF1064.2 +037500 MOVE -0.999980 TO MAX-RANGE. IF1064.2 +037600 F-COS-TEST-02. IF1064.2 +037700 COMPUTE WS-NUM = FUNCTION COS(PI). IF1064.2 +037800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +037900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +038000 PERFORM PASS IF1064.2 +038100 ELSE IF1064.2 +038200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +038300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +038400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +038500 PERFORM FAIL. IF1064.2 +038600 GO TO F-COS-WRITE-02. IF1064.2 +038700 F-COS-DELETE-02. IF1064.2 +038800 PERFORM DE-LETE. IF1064.2 +038900 GO TO F-COS-WRITE-02. IF1064.2 +039000 F-COS-WRITE-02. IF1064.2 +039100 MOVE "F-COS-02" TO PAR-NAME. IF1064.2 +039200 PERFORM PRINT-DETAIL. IF1064.2 +039300*****************TEST (c) - SIMPLE TEST***************** IF1064.2 +039400 F-COS-03. IF1064.2 +039500 MOVE ZERO TO WS-NUM. IF1064.2 +039600 MOVE -1.00000 TO MIN-RANGE. IF1064.2 +039700 MOVE -0.999980 TO MAX-RANGE. IF1064.2 +039800 F-COS-TEST-03. IF1064.2 +039900 COMPUTE WS-NUM = FUNCTION COS(MINUSPI). IF1064.2 +040000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +040100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +040200 PERFORM PASS IF1064.2 +040300 ELSE IF1064.2 +040400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +040500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +040600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +040700 PERFORM FAIL. IF1064.2 +040800 GO TO F-COS-WRITE-03. IF1064.2 +040900 F-COS-DELETE-03. IF1064.2 +041000 PERFORM DE-LETE. IF1064.2 +041100 GO TO F-COS-WRITE-03. IF1064.2 +041200 F-COS-WRITE-03. IF1064.2 +041300 MOVE "F-COS-03" TO PAR-NAME. IF1064.2 +041400 PERFORM PRINT-DETAIL. IF1064.2 +041500*****************TEST (d) - SIMPLE TEST***************** IF1064.2 +041600 F-COS-04. IF1064.2 +041700 MOVE ZERO TO WS-NUM. IF1064.2 +041800 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +041900 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +042000 F-COS-TEST-04. IF1064.2 +042100 COMPUTE WS-NUM = FUNCTION COS(0.001). IF1064.2 +042200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +042300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +042400 PERFORM PASS IF1064.2 +042500 ELSE IF1064.2 +042600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +042700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +042800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +042900 PERFORM FAIL. IF1064.2 +043000 GO TO F-COS-WRITE-04. IF1064.2 +043100 F-COS-DELETE-04. IF1064.2 +043200 PERFORM DE-LETE. IF1064.2 +043300 GO TO F-COS-WRITE-04. IF1064.2 +043400 F-COS-WRITE-04. IF1064.2 +043500 MOVE "F-COS-04" TO PAR-NAME. IF1064.2 +043600 PERFORM PRINT-DETAIL. IF1064.2 +043700*****************TEST (e) - SIMPLE TEST***************** IF1064.2 +043800 F-COS-05. IF1064.2 +043900 MOVE ZERO TO WS-NUM. IF1064.2 +044000 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +044100 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +044200 F-COS-TEST-05. IF1064.2 +044300 COMPUTE WS-NUM = FUNCTION COS(.00009). IF1064.2 +044400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +044500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +044600 PERFORM PASS IF1064.2 +044700 ELSE IF1064.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +044900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +045000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +045100 PERFORM FAIL. IF1064.2 +045200 GO TO F-COS-WRITE-05. IF1064.2 +045300 F-COS-DELETE-05. IF1064.2 +045400 PERFORM DE-LETE. IF1064.2 +045500 GO TO F-COS-WRITE-05. IF1064.2 +045600 F-COS-WRITE-05. IF1064.2 +045700 MOVE "F-COS-05" TO PAR-NAME. IF1064.2 +045800 PERFORM PRINT-DETAIL. IF1064.2 +045900*****************TEST (f) - SIMPLE TEST***************** IF1064.2 +046000 F-COS-06. IF1064.2 +046100 MOVE ZERO TO WS-NUM. IF1064.2 +046200 MOVE 0.99998 TO MIN-RANGE. IF1064.2 +046300 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +046400 F-COS-TEST-06. IF1064.2 +046500 COMPUTE WS-NUM = FUNCTION COS(A). IF1064.2 +046600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +046700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +046800 PERFORM PASS IF1064.2 +046900 ELSE IF1064.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +047100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +047200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +047300 PERFORM FAIL. IF1064.2 +047400 GO TO F-COS-WRITE-06. IF1064.2 +047500 F-COS-DELETE-06. IF1064.2 +047600 PERFORM DE-LETE. IF1064.2 +047700 GO TO F-COS-WRITE-06. IF1064.2 +047800 F-COS-WRITE-06. IF1064.2 +047900 MOVE "F-COS-06" TO PAR-NAME. IF1064.2 +048000 PERFORM PRINT-DETAIL. IF1064.2 +048100*****************TEST (g) - SIMPLE TEST***************** IF1064.2 +048200 F-COS-07. IF1064.2 +048300 MOVE ZERO TO WS-NUM. IF1064.2 +048400 MOVE 0.283656 TO MIN-RANGE. IF1064.2 +048500 MOVE 0.283668 TO MAX-RANGE. IF1064.2 +048600 F-COS-TEST-07. IF1064.2 +048700 COMPUTE WS-NUM = FUNCTION COS(IND(E)). IF1064.2 +048800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +048900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +049000 PERFORM PASS IF1064.2 +049100 ELSE IF1064.2 +049200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +049300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +049400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +049500 PERFORM FAIL. IF1064.2 +049600 GO TO F-COS-WRITE-07. IF1064.2 +049700 F-COS-DELETE-07. IF1064.2 +049800 PERFORM DE-LETE. IF1064.2 +049900 GO TO F-COS-WRITE-07. IF1064.2 +050000 F-COS-WRITE-07. IF1064.2 +050100 MOVE "F-COS-07" TO PAR-NAME. IF1064.2 +050200 PERFORM PRINT-DETAIL. IF1064.2 +050300*****************TEST (h) - SIMPLE TEST***************** IF1064.2 +050400 F-COS-08. IF1064.2 +050500 MOVE ZERO TO WS-NUM. IF1064.2 +050600 MOVE 0.753887 TO MIN-RANGE. IF1064.2 +050700 MOVE 0.753917 TO MAX-RANGE. IF1064.2 +050800 F-COS-TEST-08. IF1064.2 +050900 COMPUTE WS-NUM = FUNCTION COS(IND(5)). IF1064.2 +051000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +051100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +051200 PERFORM PASS IF1064.2 +051300 ELSE IF1064.2 +051400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +051500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +051600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +051700 PERFORM FAIL. IF1064.2 +051800 GO TO F-COS-WRITE-08. IF1064.2 +051900 F-COS-DELETE-08. IF1064.2 +052000 PERFORM DE-LETE. IF1064.2 +052100 GO TO F-COS-WRITE-08. IF1064.2 +052200 F-COS-WRITE-08. IF1064.2 +052300 MOVE "F-COS-08" TO PAR-NAME. IF1064.2 +052400 PERFORM PRINT-DETAIL. IF1064.2 +052500*****************TEST (a) - COMPLEX TEST**************** IF1064.2 +052600 F-COS-09. IF1064.2 +052700 MOVE ZERO TO WS-NUM. IF1064.2 +052800 MOVE 0.499980 TO MIN-RANGE. IF1064.2 +052900 MOVE 0.500020 TO MAX-RANGE. IF1064.2 +053000 F-COS-TEST-09. IF1064.2 +053100 COMPUTE WS-NUM = FUNCTION COS(PI / 3). IF1064.2 +053200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +053300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +053400 PERFORM PASS IF1064.2 +053500 ELSE IF1064.2 +053600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +053700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +053800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +053900 PERFORM FAIL. IF1064.2 +054000 GO TO F-COS-WRITE-09. IF1064.2 +054100 F-COS-DELETE-09. IF1064.2 +054200 PERFORM DE-LETE. IF1064.2 +054300 GO TO F-COS-WRITE-09. IF1064.2 +054400 F-COS-WRITE-09. IF1064.2 +054500 MOVE "F-COS-09" TO PAR-NAME. IF1064.2 +054600 PERFORM PRINT-DETAIL. IF1064.2 +054700*****************TEST (b) - COMPLEX TEST**************** IF1064.2 +054800 F-COS-10. IF1064.2 +054900 MOVE ZERO TO WS-NUM. IF1064.2 +055000 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +055100 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +055200 F-COS-TEST-10. IF1064.2 +055300 COMPUTE WS-NUM = FUNCTION COS(PI / 2). IF1064.2 +055400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +055500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +055600 PERFORM PASS IF1064.2 +055700 ELSE IF1064.2 +055800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +055900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +056000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +056100 PERFORM FAIL. IF1064.2 +056200 GO TO F-COS-WRITE-10. IF1064.2 +056300 F-COS-DELETE-10. IF1064.2 +056400 PERFORM DE-LETE. IF1064.2 +056500 GO TO F-COS-WRITE-10. IF1064.2 +056600 F-COS-WRITE-10. IF1064.2 +056700 MOVE "F-COS-10" TO PAR-NAME. IF1064.2 +056800 PERFORM PRINT-DETAIL. IF1064.2 +056900*****************TEST (c) - COMPLEX TEST**************** IF1064.2 +057000 F-COS-11. IF1064.2 +057100 MOVE ZERO TO WS-NUM. IF1064.2 +057200 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +057300 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +057400 F-COS-TEST-11. IF1064.2 +057500 COMPUTE WS-NUM = FUNCTION COS((3 * PI) / 2). IF1064.2 +057600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +057700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +057800 PERFORM PASS IF1064.2 +057900 ELSE IF1064.2 +058000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +058100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +058200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +058300 PERFORM FAIL. IF1064.2 +058400 GO TO F-COS-WRITE-11. IF1064.2 +058500 F-COS-DELETE-11. IF1064.2 +058600 PERFORM DE-LETE. IF1064.2 +058700 GO TO F-COS-WRITE-11. IF1064.2 +058800 F-COS-WRITE-11. IF1064.2 +058900 MOVE "F-COS-11" TO PAR-NAME. IF1064.2 +059000 PERFORM PRINT-DETAIL. IF1064.2 +059100*****************TEST (d) - COMPLEX TEST**************** IF1064.2 +059200 F-COS-12. IF1064.2 +059300 MOVE ZERO TO WS-NUM. IF1064.2 +059400 MOVE 0.499980 TO MIN-RANGE. IF1064.2 +059500 MOVE 0.500002 TO MAX-RANGE. IF1064.2 +059600 F-COS-TEST-12. IF1064.2 +059700 COMPUTE WS-NUM = FUNCTION COS(MINUSPI / 3). IF1064.2 +059800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +059900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +060000 PERFORM PASS IF1064.2 +060100 ELSE IF1064.2 +060200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +060300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +060400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +060500 PERFORM FAIL. IF1064.2 +060600 GO TO F-COS-WRITE-12. IF1064.2 +060700 F-COS-DELETE-12. IF1064.2 +060800 PERFORM DE-LETE. IF1064.2 +060900 GO TO F-COS-WRITE-12. IF1064.2 +061000 F-COS-WRITE-12. IF1064.2 +061100 MOVE "F-COS-12" TO PAR-NAME. IF1064.2 +061200 PERFORM PRINT-DETAIL. IF1064.2 +061300*****************TEST (e) - COMPLEX TEST**************** IF1064.2 +061400 F-COS-13. IF1064.2 +061500 MOVE ZERO TO WS-NUM. IF1064.2 +061600 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +061700 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +061800 F-COS-TEST-13. IF1064.2 +061900 COMPUTE WS-NUM = FUNCTION COS(MINUSPI / 2). IF1064.2 +062000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +062100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +062200 PERFORM PASS IF1064.2 +062300 ELSE IF1064.2 +062400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +062500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +062600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +062700 PERFORM FAIL. IF1064.2 +062800 GO TO F-COS-WRITE-13. IF1064.2 +062900 F-COS-DELETE-13. IF1064.2 +063000 PERFORM DE-LETE. IF1064.2 +063100 GO TO F-COS-WRITE-13. IF1064.2 +063200 F-COS-WRITE-13. IF1064.2 +063300 MOVE "F-COS-13" TO PAR-NAME. IF1064.2 +063400 PERFORM PRINT-DETAIL. IF1064.2 +063500*****************TEST (f) - COMPLEX TEST**************** IF1064.2 +063600 F-COS-14. IF1064.2 +063700 MOVE ZERO TO WS-NUM. IF1064.2 +063800 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +063900 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +064000 F-COS-TEST-14. IF1064.2 +064100 COMPUTE WS-NUM = FUNCTION COS((3 * MINUSPI) / 2). IF1064.2 +064200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +064300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +064400 PERFORM PASS IF1064.2 +064500 ELSE IF1064.2 +064600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +064700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +064800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +064900 PERFORM FAIL. IF1064.2 +065000 GO TO F-COS-WRITE-14. IF1064.2 +065100 F-COS-DELETE-14. IF1064.2 +065200 PERFORM DE-LETE. IF1064.2 +065300 GO TO F-COS-WRITE-14. IF1064.2 +065400 F-COS-WRITE-14. IF1064.2 +065500 MOVE "F-COS-14" TO PAR-NAME. IF1064.2 +065600 PERFORM PRINT-DETAIL. IF1064.2 +065700*****************TEST (h) - COMPLEX TEST**************** IF1064.2 +065800 F-COS-16. IF1064.2 +065900 MOVE ZERO TO WS-NUM. IF1064.2 +066000 MOVE 0.499113 TO MIN-RANGE. IF1064.2 +066100 MOVE 0.499153 TO MAX-RANGE. IF1064.2 +066200 F-COS-TEST-16. IF1064.2 +066300 COMPUTE WS-NUM = FUNCTION COS((PI / 3) + 0.001). IF1064.2 +066400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +066500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +066600 PERFORM PASS IF1064.2 +066700 ELSE IF1064.2 +066800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +066900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +067000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +067100 PERFORM FAIL. IF1064.2 +067200 GO TO F-COS-WRITE-16. IF1064.2 +067300 F-COS-DELETE-16. IF1064.2 +067400 PERFORM DE-LETE. IF1064.2 +067500 GO TO F-COS-WRITE-16. IF1064.2 +067600 F-COS-WRITE-16. IF1064.2 +067700 MOVE "F-COS-16" TO PAR-NAME. IF1064.2 +067800 PERFORM PRINT-DETAIL. IF1064.2 +067900*****************TEST (j) - COMPLEX TEST**************** IF1064.2 +068000 F-COS-18. IF1064.2 +068100 MOVE ZERO TO WS-NUM. IF1064.2 +068200 MOVE 0.999350 TO MIN-RANGE. IF1064.2 +068300 MOVE 0.999430 TO MAX-RANGE. IF1064.2 +068400 F-COS-TEST-18. IF1064.2 +068500 COMPUTE WS-NUM = FUNCTION COS(PI * (4 - 2) / 180). IF1064.2 +068600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +068700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +068800 PERFORM PASS IF1064.2 +068900 ELSE IF1064.2 +069000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +069100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +069200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +069300 PERFORM FAIL. IF1064.2 +069400 GO TO F-COS-WRITE-18. IF1064.2 +069500 F-COS-DELETE-18. IF1064.2 +069600 PERFORM DE-LETE. IF1064.2 +069700 GO TO F-COS-WRITE-18. IF1064.2 +069800 F-COS-WRITE-18. IF1064.2 +069900 MOVE "F-COS-18" TO PAR-NAME. IF1064.2 +070000 PERFORM PRINT-DETAIL. IF1064.2 +070100*****************TEST (k) - COMPLEX TEST**************** IF1064.2 +070200 F-COS-19. IF1064.2 +070300 MOVE ZERO TO WS-NUM. IF1064.2 +070400 MOVE 0.017451 TO MIN-RANGE. IF1064.2 +070500 MOVE 0.017453 TO MAX-RANGE. IF1064.2 +070600 F-COS-TEST-19. IF1064.2 +070700 COMPUTE WS-NUM = FUNCTION COS((PI / 2) - (PI / 180)). IF1064.2 +070800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +070900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +071000 PERFORM PASS IF1064.2 +071100 ELSE IF1064.2 +071200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +071300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +071400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +071500 PERFORM FAIL. IF1064.2 +071600 GO TO F-COS-WRITE-19. IF1064.2 +071700 F-COS-DELETE-19. IF1064.2 +071800 PERFORM DE-LETE. IF1064.2 +071900 GO TO F-COS-WRITE-19. IF1064.2 +072000 F-COS-WRITE-19. IF1064.2 +072100 MOVE "F-COS-19" TO PAR-NAME. IF1064.2 +072200 PERFORM PRINT-DETAIL. IF1064.2 +072300*****************TEST (l) - COMPLEX TEST**************** IF1064.2 +072400 F-COS-20. IF1064.2 +072500 MOVE ZERO TO WS-NUM. IF1064.2 +072600 MOVE 0.515017 TO MIN-RANGE. IF1064.2 +072700 MOVE 0.515059 TO MAX-RANGE. IF1064.2 +072800 F-COS-TEST-20. IF1064.2 +072900 COMPUTE WS-NUM = FUNCTION COS((PI / 3) - (PI / 180)). IF1064.2 +073000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +073100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +073200 PERFORM PASS IF1064.2 +073300 ELSE IF1064.2 +073400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +073500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +073600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +073700 PERFORM FAIL. IF1064.2 +073800 GO TO F-COS-WRITE-20. IF1064.2 +073900 F-COS-DELETE-20. IF1064.2 +074000 PERFORM DE-LETE. IF1064.2 +074100 GO TO F-COS-WRITE-20. IF1064.2 +074200 F-COS-WRITE-20. IF1064.2 +074300 MOVE "F-COS-20" TO PAR-NAME. IF1064.2 +074400 PERFORM PRINT-DETAIL. IF1064.2 +074500*****************TEST (m) - COMPLEX TEST**************** IF1064.2 +074600 F-COS-21. IF1064.2 +074700 MOVE ZERO TO WS-NUM. IF1064.2 +074800 MOVE -0.999887 TO MIN-RANGE. IF1064.2 +074900 MOVE -0.999807 TO MAX-RANGE. IF1064.2 +075000 F-COS-TEST-21. IF1064.2 +075100 COMPUTE WS-NUM = FUNCTION COS(PI + (PI / 180)). IF1064.2 +075200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +075300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +075400 PERFORM PASS IF1064.2 +075500 ELSE IF1064.2 +075600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +075700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +075800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +075900 PERFORM FAIL. IF1064.2 +076000 GO TO F-COS-WRITE-21. IF1064.2 +076100 F-COS-DELETE-21. IF1064.2 +076200 PERFORM DE-LETE. IF1064.2 +076300 GO TO F-COS-WRITE-21. IF1064.2 +076400 F-COS-WRITE-21. IF1064.2 +076500 MOVE "F-COS-21" TO PAR-NAME. IF1064.2 +076600 PERFORM PRINT-DETAIL. IF1064.2 +076700*****************TEST (n) - COMPLEX TEST**************** IF1064.2 +076800 F-COS-22. IF1064.2 +076900 MOVE ZERO TO WS-NUM. IF1064.2 +077000 MOVE 0.034898 TO MIN-RANGE. IF1064.2 +077100 MOVE 0.034900 TO MAX-RANGE. IF1064.2 +077200 F-COS-TEST-22. IF1064.2 +077300 COMPUTE WS-NUM = FUNCTION COS(( PI * 272) / 180). IF1064.2 +077400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +077500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +077600 PERFORM PASS IF1064.2 +077700 ELSE IF1064.2 +077800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +077900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +078000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +078100 PERFORM FAIL. IF1064.2 +078200 GO TO F-COS-WRITE-22. IF1064.2 +078300 F-COS-DELETE-22. IF1064.2 +078400 PERFORM DE-LETE. IF1064.2 +078500 GO TO F-COS-WRITE-22. IF1064.2 +078600 F-COS-WRITE-22. IF1064.2 +078700 MOVE "F-COS-22" TO PAR-NAME. IF1064.2 +078800 PERFORM PRINT-DETAIL. IF1064.2 +078900*****************TEST (o) - COMPLEX TEST**************** IF1064.2 +079000 F-COS-23. IF1064.2 +079100 MOVE ZERO TO WS-NUM. IF1064.2 +079200 MOVE -0.416163 TO MIN-RANGE. IF1064.2 +079300 MOVE -0.416129 TO MAX-RANGE. IF1064.2 +079400 F-COS-TEST-23. IF1064.2 +079500 COMPUTE WS-NUM = FUNCTION COS(4 / 2). IF1064.2 +079600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +079700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +079800 PERFORM PASS IF1064.2 +079900 ELSE IF1064.2 +080000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +080100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +080200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +080300 PERFORM FAIL. IF1064.2 +080400 GO TO F-COS-WRITE-23. IF1064.2 +080500 F-COS-DELETE-23. IF1064.2 +080600 PERFORM DE-LETE. IF1064.2 +080700 GO TO F-COS-WRITE-23. IF1064.2 +080800 F-COS-WRITE-23. IF1064.2 +080900 MOVE "F-COS-23" TO PAR-NAME. IF1064.2 +081000 PERFORM PRINT-DETAIL. IF1064.2 +081100*****************TEST (p) - COMPLEX TEST**************** IF1064.2 +081200 F-COS-24. IF1064.2 +081300 MOVE ZERO TO WS-NUM. IF1064.2 +081400 MOVE 0.070734 TO MIN-RANGE. IF1064.2 +081500 MOVE 0.070740 TO MAX-RANGE. IF1064.2 +081600 F-COS-TEST-24. IF1064.2 +081700 COMPUTE WS-NUM = FUNCTION COS(3 / 2). IF1064.2 +081800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +081900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +082000 PERFORM PASS IF1064.2 +082100 ELSE IF1064.2 +082200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +082300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +082400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +082500 PERFORM FAIL. IF1064.2 +082600 GO TO F-COS-WRITE-24. IF1064.2 +082700 F-COS-DELETE-24. IF1064.2 +082800 PERFORM DE-LETE. IF1064.2 +082900 GO TO F-COS-WRITE-24. IF1064.2 +083000 F-COS-WRITE-24. IF1064.2 +083100 MOVE "F-COS-24" TO PAR-NAME. IF1064.2 +083200 PERFORM PRINT-DETAIL. IF1064.2 +083300*****************TEST (q) - COMPLEX TEST**************** IF1064.2 +083400 F-COS-25. IF1064.2 +083500 MOVE ZERO TO WS-NUM. IF1064.2 +083600 MOVE -1.000000 TO MIN-RANGE. IF1064.2 +083700 MOVE -0.999960 TO MAX-RANGE. IF1064.2 +083800 F-COS-TEST-25. IF1064.2 +083900 COMPUTE WS-NUM = FUNCTION COS(PI - A). IF1064.2 +084000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +084100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +084200 PERFORM PASS IF1064.2 +084300 ELSE IF1064.2 +084400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +084500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +084600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +084700 PERFORM FAIL. IF1064.2 +084800 GO TO F-COS-WRITE-25. IF1064.2 +084900 F-COS-DELETE-25. IF1064.2 +085000 PERFORM DE-LETE. IF1064.2 +085100 GO TO F-COS-WRITE-25. IF1064.2 +085200 F-COS-WRITE-25. IF1064.2 +085300 MOVE "F-COS-25" TO PAR-NAME. IF1064.2 +085400 PERFORM PRINT-DETAIL. IF1064.2 +085500*****************TEST (r) - COMPLEX TEST**************** IF1064.2 +085600 F-COS-26. IF1064.2 +085700 MOVE ZERO TO WS-NUM. IF1064.2 +085800 MOVE -0.839105 TO MIN-RANGE. IF1064.2 +085900 MOVE -0.839037 TO MAX-RANGE. IF1064.2 +086000 F-COS-TEST-26. IF1064.2 +086100 COMPUTE WS-NUM = FUNCTION COS(D / 100). IF1064.2 +086200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +086300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +086400 PERFORM PASS IF1064.2 +086500 ELSE IF1064.2 +086600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +086700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +086800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +086900 PERFORM FAIL. IF1064.2 +087000 GO TO F-COS-WRITE-26. IF1064.2 +087100 F-COS-DELETE-26. IF1064.2 +087200 PERFORM DE-LETE. IF1064.2 +087300 GO TO F-COS-WRITE-26. IF1064.2 +087400 F-COS-WRITE-26. IF1064.2 +087500 MOVE "F-COS-26" TO PAR-NAME. IF1064.2 +087600 PERFORM PRINT-DETAIL. IF1064.2 +087700*****************TEST (s) - COMPLEX TEST**************** IF1064.2 +087800 F-COS-27. IF1064.2 +087900 MOVE ZERO TO WS-NUM. IF1064.2 +088000 MOVE 0.999807 TO MIN-RANGE. IF1064.2 +088100 MOVE 0.999887 TO MAX-RANGE. IF1064.2 +088200 F-COS-TEST-27. IF1064.2 +088300 COMPUTE WS-NUM = FUNCTION COS(PI / 180). IF1064.2 +088400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +088500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +088600 PERFORM PASS IF1064.2 +088700 ELSE IF1064.2 +088800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +088900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +089000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +089100 PERFORM FAIL. IF1064.2 +089200 GO TO F-COS-WRITE-27. IF1064.2 +089300 F-COS-DELETE-27. IF1064.2 +089400 PERFORM DE-LETE. IF1064.2 +089500 GO TO F-COS-WRITE-27. IF1064.2 +089600 F-COS-WRITE-27. IF1064.2 +089700 MOVE "F-COS-27" TO PAR-NAME. IF1064.2 +089800 PERFORM PRINT-DETAIL. IF1064.2 +089900*****************TEST (t) - COMPLEX TEST**************** IF1064.2 +090000 F-COS-28. IF1064.2 +090100 MOVE ZERO TO WS-NUM. IF1064.2 +090200 MOVE -1.000000 TO MIN-RANGE. IF1064.2 +090300 MOVE -0.999960 TO MAX-RANGE. IF1064.2 +090400 F-COS-TEST-28. IF1064.2 +090500 COMPUTE WS-NUM = FUNCTION COS(PI - 0.001). IF1064.2 +090600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +090700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +090800 PERFORM PASS IF1064.2 +090900 ELSE IF1064.2 +091000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +091100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +091200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +091300 PERFORM FAIL. IF1064.2 +091400 GO TO F-COS-WRITE-28. IF1064.2 +091500 F-COS-DELETE-28. IF1064.2 +091600 PERFORM DE-LETE. IF1064.2 +091700 GO TO F-COS-WRITE-28. IF1064.2 +091800 F-COS-WRITE-28. IF1064.2 +091900 MOVE "F-COS-28" TO PAR-NAME. IF1064.2 +092000 PERFORM PRINT-DETAIL. IF1064.2 +092100*****************TEST (u) - COMPLEX TEST**************** IF1064.2 +092200 F-COS-29. IF1064.2 +092300 MOVE ZERO TO WS-NUM. IF1064.2 +092400 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +092500 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +092600 F-COS-TEST-29. IF1064.2 +092700 COMPUTE WS-NUM = FUNCTION COS(PI) + 1. IF1064.2 +092800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +092900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +093000 PERFORM PASS IF1064.2 +093100 ELSE IF1064.2 +093200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +093300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +093400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +093500 PERFORM FAIL. IF1064.2 +093600 GO TO F-COS-WRITE-29. IF1064.2 +093700 F-COS-DELETE-29. IF1064.2 +093800 PERFORM DE-LETE. IF1064.2 +093900 GO TO F-COS-WRITE-29. IF1064.2 +094000 F-COS-WRITE-29. IF1064.2 +094100 MOVE "F-COS-29" TO PAR-NAME. IF1064.2 +094200 PERFORM PRINT-DETAIL. IF1064.2 +094300*****************TEST (v) - COMPLEX TEST**************** IF1064.2 +094400 F-COS-30. IF1064.2 +094500 MOVE ZERO TO WS-NUM. IF1064.2 +094600 MOVE 0.914616 TO MIN-RANGE. IF1064.2 +094700 MOVE 0.914690 TO MAX-RANGE. IF1064.2 +094800 F-COS-TEST-30. IF1064.2 +094900 COMPUTE WS-NUM = FUNCTION COS(FUNCTION COS(2)). IF1064.2 +095000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +095100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +095200 PERFORM PASS IF1064.2 +095300 ELSE IF1064.2 +095400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +095500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +095600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +095700 PERFORM FAIL. IF1064.2 +095800 GO TO F-COS-WRITE-30. IF1064.2 +095900 F-COS-DELETE-30. IF1064.2 +096000 PERFORM DE-LETE. IF1064.2 +096100 GO TO F-COS-WRITE-30. IF1064.2 +096200 F-COS-WRITE-30. IF1064.2 +096300 MOVE "F-COS-30" TO PAR-NAME. IF1064.2 +096400 PERFORM PRINT-DETAIL. IF1064.2 +096500*****************TEST (w) - COMPLEX TEST**************** IF1064.2 +096600 F-COS-31. IF1064.2 +096700 MOVE ZERO TO WS-NUM. IF1064.2 +096800 MOVE -2.00008 TO MIN-RANGE. IF1064.2 +096900 MOVE -1.99992 TO MAX-RANGE. IF1064.2 +097000 F-COS-TEST-31. IF1064.2 +097100 COMPUTE WS-NUM = FUNCTION COS(PI) + IF1064.2 +097200 FUNCTION COS(PI). IF1064.2 +097300 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +097400 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +097500 PERFORM PASS IF1064.2 +097600 ELSE IF1064.2 +097700 MOVE WS-NUM TO COMPUTED-N IF1064.2 +097800 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +097900 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +098000 PERFORM FAIL. IF1064.2 +098100 GO TO F-COS-WRITE-31. IF1064.2 +098200 F-COS-DELETE-31. IF1064.2 +098300 PERFORM DE-LETE. IF1064.2 +098400 GO TO F-COS-WRITE-31. IF1064.2 +098500 F-COS-WRITE-31. IF1064.2 +098600 MOVE "F-COS-31" TO PAR-NAME. IF1064.2 +098700 PERFORM PRINT-DETAIL. IF1064.2 +098800*****************SPECIAL PERFORM TEST********************** IF1064.2 +098900 F-COS-32. IF1064.2 +099000 PERFORM F-COS-TEST-32 IF1064.2 +099100 UNTIL FUNCTION COS(ARG1) < 0. IF1064.2 +099200 PERFORM PASS. IF1064.2 +099300 GO TO F-COS-WRITE-32. IF1064.2 +099400 F-COS-TEST-32. IF1064.2 +099500 COMPUTE ARG1 = ARG1 - 0.25. IF1064.2 +099600 F-COS-DELETE-32. IF1064.2 +099700 PERFORM DE-LETE. IF1064.2 +099800 GO TO F-COS-WRITE-32. IF1064.2 +099900 F-COS-WRITE-32. IF1064.2 +100000 MOVE "F-COS-32" TO PAR-NAME. IF1064.2 +100100 PERFORM PRINT-DETAIL. IF1064.2 +100200********************END OF TESTS*************** IF1064.2 +100300 CCVS-EXIT SECTION. IF1064.2 +100400 CCVS-999999. IF1064.2 +100500 GO TO CLOSE-FILES. IF1064.2 +*END-OF,IF106A +*HEADER,COBOL,IF107A +000100 IDENTIFICATION DIVISION. IF1074.2 +000200 PROGRAM-ID. IF1074.2 +000300 IF107A. IF1074.2 +000400 IF1074.2 +000500*********************************************************** IF1074.2 +000600* * IF1074.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1074.2 +000800* It contains tests for the Intrinsic Function * IF1074.2 +000900* CURRENT-DATE. * IF1074.2 +001000* * IF1074.2 +001100*********************************************************** IF1074.2 +001200 ENVIRONMENT DIVISION. IF1074.2 +001300 CONFIGURATION SECTION. IF1074.2 +001400 SOURCE-COMPUTER. IF1074.2 +001500 XXXXX082. IF1074.2 +001600 OBJECT-COMPUTER. IF1074.2 +001700 XXXXX083. IF1074.2 +001800 INPUT-OUTPUT SECTION. IF1074.2 +001900 FILE-CONTROL. IF1074.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1074.2 +002100 XXXXX055. IF1074.2 +002200 DATA DIVISION. IF1074.2 +002300 FILE SECTION. IF1074.2 +002400 FD PRINT-FILE. IF1074.2 +002500 01 PRINT-REC PICTURE X(120). IF1074.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1074.2 +002700 WORKING-STORAGE SECTION. IF1074.2 +002800*********************************************************** IF1074.2 +002900* Variables specific to the Intrinsic Function Test IF107A* IF1074.2 +003000*********************************************************** IF1074.2 +003100 01 TEMP1 PIC X(21). IF1074.2 +003200 01 TEMP2 PIC X(21). IF1074.2 +003300 01 WS-FIRST VALUE SPACES. IF1074.2 +003400 02 FILLER PIC X(8). IF1074.2 +003500 02 WS-TIME1 PIC X(8). IF1074.2 +003600 02 FILLER PIC X(5). IF1074.2 +003700 01 WS-SECOND VALUE SPACES. IF1074.2 +003800 02 FILLER PIC X(8). IF1074.2 +003900 02 WS-TIME2 PIC X(8). IF1074.2 +004000 02 FILLER PIC X(5). IF1074.2 +004100 01 WS-DATE. IF1074.2 +004200 02 WS-YEAR PIC 9999. IF1074.2 +004300 88 CON-YEAR VALUE 1990 THRU 9999. IF1074.2 +004400 02 WS-MONTH PIC 99. IF1074.2 +004500 88 CON-MONTH VALUE 01 THRU 12. IF1074.2 +004600 02 WS-DAY PIC 99. IF1074.2 +004700 88 CON-DAY VALUE 01 THRU 31. IF1074.2 +004800 02 WS-HOUR PIC 99. IF1074.2 +004900 88 CON-HOUR VALUE 00 THRU 23. IF1074.2 +005000 02 WS-MIN PIC 99. IF1074.2 +005100 88 CON-MIN VALUE 00 THRU 59. IF1074.2 +005200 02 WS-SECOND PIC 99. IF1074.2 +005300 88 CON-SEC VALUE 00 THRU 59. IF1074.2 +005400 02 WS-HUNDSEC PIC 99. IF1074.2 +005500 88 CON-HUNDSEC VALUE 00 THRU 99. IF1074.2 +005600 02 WS-GREENW PIC X. IF1074.2 +005700 88 CON-GREENW VALUE "-", "+", "0". IF1074.2 +005800 02 WS-OFFSET PIC 99. IF1074.2 +005900 88 CON-OFFSET VALUE 00 THRU 13. IF1074.2 +006000 02 WS-OFFSET2 PIC 99. IF1074.2 +006100 88 CON-OFFSET2 VALUE 00 THRU 59. IF1074.2 +006200* IF1074.2 +006300********************************************************** IF1074.2 +006400* IF1074.2 +006500 01 TEST-RESULTS. IF1074.2 +006600 02 FILLER PIC X VALUE SPACE. IF1074.2 +006700 02 FEATURE PIC X(20) VALUE SPACE. IF1074.2 +006800 02 FILLER PIC X VALUE SPACE. IF1074.2 +006900 02 P-OR-F PIC X(5) VALUE SPACE. IF1074.2 +007000 02 FILLER PIC X VALUE SPACE. IF1074.2 +007100 02 PAR-NAME. IF1074.2 +007200 03 FILLER PIC X(19) VALUE SPACE. IF1074.2 +007300 03 PARDOT-X PIC X VALUE SPACE. IF1074.2 +007400 03 DOTVALUE PIC 99 VALUE ZERO. IF1074.2 +007500 02 FILLER PIC X(8) VALUE SPACE. IF1074.2 +007600 02 RE-MARK PIC X(61). IF1074.2 +007700 01 TEST-COMPUTED. IF1074.2 +007800 02 FILLER PIC X(30) VALUE SPACE. IF1074.2 +007900 02 FILLER PIC X(17) VALUE IF1074.2 +008000 " COMPUTED=". IF1074.2 +008100 02 COMPUTED-X. IF1074.2 +008200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1074.2 +008300 03 COMPUTED-N REDEFINES COMPUTED-A IF1074.2 +008400 PIC -9(9).9(9). IF1074.2 +008500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1074.2 +008600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1074.2 +008700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1074.2 +008800 03 CM-18V0 REDEFINES COMPUTED-A. IF1074.2 +008900 04 COMPUTED-18V0 PIC -9(18). IF1074.2 +009000 04 FILLER PIC X. IF1074.2 +009100 03 FILLER PIC X(50) VALUE SPACE. IF1074.2 +009200 01 TEST-CORRECT. IF1074.2 +009300 02 FILLER PIC X(30) VALUE SPACE. IF1074.2 +009400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1074.2 +009500 02 CORRECT-X. IF1074.2 +009600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1074.2 +009700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1074.2 +009800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1074.2 +009900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1074.2 +010000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1074.2 +010100 03 CR-18V0 REDEFINES CORRECT-A. IF1074.2 +010200 04 CORRECT-18V0 PIC -9(18). IF1074.2 +010300 04 FILLER PIC X. IF1074.2 +010400 03 FILLER PIC X(2) VALUE SPACE. IF1074.2 +010500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1074.2 +010600 01 CCVS-C-1. IF1074.2 +010700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1074.2 +010800- "SS PARAGRAPH-NAME IF1074.2 +010900- " REMARKS". IF1074.2 +011000 02 FILLER PIC X(20) VALUE SPACE. IF1074.2 +011100 01 CCVS-C-2. IF1074.2 +011200 02 FILLER PIC X VALUE SPACE. IF1074.2 +011300 02 FILLER PIC X(6) VALUE "TESTED". IF1074.2 +011400 02 FILLER PIC X(15) VALUE SPACE. IF1074.2 +011500 02 FILLER PIC X(4) VALUE "FAIL". IF1074.2 +011600 02 FILLER PIC X(94) VALUE SPACE. IF1074.2 +011700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1074.2 +011800 01 REC-CT PIC 99 VALUE ZERO. IF1074.2 +011900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1074.2 +012400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1074.2 +012500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1074.2 +012600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1074.2 +012700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1074.2 +012800 01 CCVS-H-1. IF1074.2 +012900 02 FILLER PIC X(39) VALUE SPACES. IF1074.2 +013000 02 FILLER PIC X(42) VALUE IF1074.2 +013100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1074.2 +013200 02 FILLER PIC X(39) VALUE SPACES. IF1074.2 +013300 01 CCVS-H-2A. IF1074.2 +013400 02 FILLER PIC X(40) VALUE SPACE. IF1074.2 +013500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1074.2 +013600 02 FILLER PIC XXXX VALUE IF1074.2 +013700 "4.2 ". IF1074.2 +013800 02 FILLER PIC X(28) VALUE IF1074.2 +013900 " COPY - NOT FOR DISTRIBUTION". IF1074.2 +014000 02 FILLER PIC X(41) VALUE SPACE. IF1074.2 +014100 IF1074.2 +014200 01 CCVS-H-2B. IF1074.2 +014300 02 FILLER PIC X(15) VALUE IF1074.2 +014400 "TEST RESULT OF ". IF1074.2 +014500 02 TEST-ID PIC X(9). IF1074.2 +014600 02 FILLER PIC X(4) VALUE IF1074.2 +014700 " IN ". IF1074.2 +014800 02 FILLER PIC X(12) VALUE IF1074.2 +014900 " HIGH ". IF1074.2 +015000 02 FILLER PIC X(22) VALUE IF1074.2 +015100 " LEVEL VALIDATION FOR ". IF1074.2 +015200 02 FILLER PIC X(58) VALUE IF1074.2 +015300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1074.2 +015400 01 CCVS-H-3. IF1074.2 +015500 02 FILLER PIC X(34) VALUE IF1074.2 +015600 " FOR OFFICIAL USE ONLY ". IF1074.2 +015700 02 FILLER PIC X(58) VALUE IF1074.2 +015800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1074.2 +015900 02 FILLER PIC X(28) VALUE IF1074.2 +016000 " COPYRIGHT 1985 ". IF1074.2 +016100 01 CCVS-E-1. IF1074.2 +016200 02 FILLER PIC X(52) VALUE SPACE. IF1074.2 +016300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1074.2 +016400 02 ID-AGAIN PIC X(9). IF1074.2 +016500 02 FILLER PIC X(45) VALUE SPACES. IF1074.2 +016600 01 CCVS-E-2. IF1074.2 +016700 02 FILLER PIC X(31) VALUE SPACE. IF1074.2 +016800 02 FILLER PIC X(21) VALUE SPACE. IF1074.2 +016900 02 CCVS-E-2-2. IF1074.2 +017000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1074.2 +017100 03 FILLER PIC X VALUE SPACE. IF1074.2 +017200 03 ENDER-DESC PIC X(44) VALUE IF1074.2 +017300 "ERRORS ENCOUNTERED". IF1074.2 +017400 01 CCVS-E-3. IF1074.2 +017500 02 FILLER PIC X(22) VALUE IF1074.2 +017600 " FOR OFFICIAL USE ONLY". IF1074.2 +017700 02 FILLER PIC X(12) VALUE SPACE. IF1074.2 +017800 02 FILLER PIC X(58) VALUE IF1074.2 +017900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1074.2 +018000 02 FILLER PIC X(13) VALUE SPACE. IF1074.2 +018100 02 FILLER PIC X(15) VALUE IF1074.2 +018200 " COPYRIGHT 1985". IF1074.2 +018300 01 CCVS-E-4. IF1074.2 +018400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1074.2 +018500 02 FILLER PIC X(4) VALUE " OF ". IF1074.2 +018600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1074.2 +018700 02 FILLER PIC X(40) VALUE IF1074.2 +018800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1074.2 +018900 01 XXINFO. IF1074.2 +019000 02 FILLER PIC X(19) VALUE IF1074.2 +019100 "*** INFORMATION ***". IF1074.2 +019200 02 INFO-TEXT. IF1074.2 +019300 04 FILLER PIC X(8) VALUE SPACE. IF1074.2 +019400 04 XXCOMPUTED PIC X(20). IF1074.2 +019500 04 FILLER PIC X(5) VALUE SPACE. IF1074.2 +019600 04 XXCORRECT PIC X(20). IF1074.2 +019700 02 INF-ANSI-REFERENCE PIC X(48). IF1074.2 +019800 01 HYPHEN-LINE. IF1074.2 +019900 02 FILLER PIC IS X VALUE IS SPACE. IF1074.2 +020000 02 FILLER PIC IS X(65) VALUE IS "************************IF1074.2 +020100- "*****************************************". IF1074.2 +020200 02 FILLER PIC IS X(54) VALUE IS "************************IF1074.2 +020300- "******************************". IF1074.2 +020400 01 CCVS-PGM-ID PIC X(9) VALUE IF1074.2 +020500 "IF107A". IF1074.2 +020600 PROCEDURE DIVISION. IF1074.2 +020700 CCVS1 SECTION. IF1074.2 +020800 OPEN-FILES. IF1074.2 +020900 OPEN OUTPUT PRINT-FILE. IF1074.2 +021000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1074.2 +021100 MOVE SPACE TO TEST-RESULTS. IF1074.2 +021200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1074.2 +021300 GO TO CCVS1-EXIT. IF1074.2 +021400 CLOSE-FILES. IF1074.2 +021500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1074.2 +021600 TERMINATE-CCVS. IF1074.2 +021700 STOP RUN. IF1074.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1074.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1074.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1074.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1074.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IF1074.2 +022300 PRINT-DETAIL. IF1074.2 +022400 IF REC-CT NOT EQUAL TO ZERO IF1074.2 +022500 MOVE "." TO PARDOT-X IF1074.2 +022600 MOVE REC-CT TO DOTVALUE. IF1074.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1074.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1074.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1074.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1074.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1074.2 +023200 MOVE SPACE TO CORRECT-X. IF1074.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1074.2 +023400 MOVE SPACE TO RE-MARK. IF1074.2 +023500 HEAD-ROUTINE. IF1074.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1074.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1074.2 +024000 COLUMN-NAMES-ROUTINE. IF1074.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +024400 END-ROUTINE. IF1074.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 IF1074.2 +024600 TIMES. IF1074.2 +024700 END-RTN-EXIT. IF1074.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +024900 END-ROUTINE-1. IF1074.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1074.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1074.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. IF1074.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1074.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1074.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1074.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1074.2 +025700 END-ROUTINE-12. IF1074.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1074.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1074.2 +026000 MOVE "NO " TO ERROR-TOTAL IF1074.2 +026100 ELSE IF1074.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1074.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1074.2 +026400 PERFORM WRITE-LINE. IF1074.2 +026500 END-ROUTINE-13. IF1074.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1074.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IF1074.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1074.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1074.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IF1074.2 +027200 MOVE "NO " TO ERROR-TOTAL IF1074.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1074.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1074.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027700 WRITE-LINE. IF1074.2 +027800 ADD 1 TO RECORD-COUNT. IF1074.2 +027900Y IF RECORD-COUNT GREATER 42 IF1074.2 +028000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1074.2 +028100Y MOVE SPACE TO DUMMY-RECORD IF1074.2 +028200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1074.2 +028300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1074.2 +028400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1074.2 +028500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1074.2 +028600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1074.2 +028700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +028800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +028900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +029000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1074.2 +029100Y MOVE ZERO TO RECORD-COUNT. IF1074.2 +029200 PERFORM WRT-LN. IF1074.2 +029300 WRT-LN. IF1074.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1074.2 +029500 MOVE SPACE TO DUMMY-RECORD. IF1074.2 +029600 BLANK-LINE-PRINT. IF1074.2 +029700 PERFORM WRT-LN. IF1074.2 +029800 FAIL-ROUTINE. IF1074.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE IF1074.2 +030000 GO TO FAIL-ROUTINE-WRITE. IF1074.2 +030100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1074.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1074.2 +030300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1074.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1074.2 +030600 GO TO FAIL-ROUTINE-EX. IF1074.2 +030700 FAIL-ROUTINE-WRITE. IF1074.2 +030800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1074.2 +030900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1074.2 +031000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1074.2 +031100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1074.2 +031200 FAIL-ROUTINE-EX. EXIT. IF1074.2 +031300 BAIL-OUT. IF1074.2 +031400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1074.2 +031500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1074.2 +031600 BAIL-OUT-WRITE. IF1074.2 +031700 MOVE CORRECT-A TO XXCORRECT. IF1074.2 +031800 MOVE COMPUTED-A TO XXCOMPUTED. IF1074.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1074.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1074.2 +032200 BAIL-OUT-EX. EXIT. IF1074.2 +032300 CCVS1-EXIT. IF1074.2 +032400 EXIT. IF1074.2 +032500******************************************************** IF1074.2 +032600* * IF1074.2 +032700* Intrinsic Function Tests IF107A - CURRENT-DATE * IF1074.2 +032800* * IF1074.2 +032900******************************************************** IF1074.2 +033000 SECT-IF107A SECTION. IF1074.2 +033100 F-WHENCOMP-INFO. IF1074.2 +033200 MOVE "See ref. A-39 2.11" TO ANSI-REFERENCE. IF1074.2 +033300 MOVE "CURRENT-DATE" TO FEATURE. IF1074.2 +033400*****************TEST (a) ****************************** IF1074.2 +033500 F-WHENCOMP-01. IF1074.2 +033600 MOVE SPACES TO TEMP1. IF1074.2 +033700 MOVE SPACES TO WS-DATE. IF1074.2 +033800 F-WHENCOMP-TEST-01. IF1074.2 +033900 MOVE FUNCTION CURRENT-DATE TO TEMP1. IF1074.2 +034000 MOVE TEMP1 TO WS-DATE. IF1074.2 +034100 IF CON-YEAR AND IF1074.2 +034200 CON-MONTH AND IF1074.2 +034300 CON-DAY AND IF1074.2 +034400 CON-HOUR AND IF1074.2 +034500 CON-MIN AND IF1074.2 +034600 CON-SEC AND IF1074.2 +034700 CON-HUNDSEC AND IF1074.2 +034800 CON-GREENW AND IF1074.2 +034900 CON-OFFSET AND IF1074.2 +035000 CON-OFFSET2 THEN IF1074.2 +035100 PERFORM PASS IF1074.2 +035200 ELSE IF1074.2 +035300 MOVE TEMP1 TO COMPUTED-A IF1074.2 +035400 MOVE "Date & Time value " TO CORRECT-X IF1074.2 +035500 PERFORM FAIL. IF1074.2 +035600 GO TO F-WHENCOMP-WRITE-01. IF1074.2 +035700 F-WHENCOMP-DELETE-01. IF1074.2 +035800 PERFORM DE-LETE. IF1074.2 +035900 GO TO F-WHENCOMP-WRITE-01. IF1074.2 +036000 F-WHENCOMP-WRITE-01. IF1074.2 +036100 MOVE "F-WHENCOMP-01" TO PAR-NAME. IF1074.2 +036200 PERFORM PRINT-DETAIL. IF1074.2 +036300*****************TEST (b) ****************************** IF1074.2 +036400 F-WHENCOMP-TEST-02. IF1074.2 +036500 IF FUNCTION CURRENT-DATE >= TEMP1 THEN IF1074.2 +036600 PERFORM PASS IF1074.2 +036700 ELSE IF1074.2 +036800 PERFORM FAIL. IF1074.2 +036900 GO TO F-WHENCOMP-WRITE-02. IF1074.2 +037000 F-WHENCOMP-DELETE-02. IF1074.2 +037100 PERFORM DE-LETE. IF1074.2 +037200 GO TO F-WHENCOMP-WRITE-02. IF1074.2 +037300 F-WHENCOMP-WRITE-02. IF1074.2 +037400 MOVE "F-WHENCOMP-02" TO PAR-NAME. IF1074.2 +037500 PERFORM PRINT-DETAIL. IF1074.2 +037600*******************END OF TESTS************************** IF1074.2 +037700 CCVS-EXIT SECTION. IF1074.2 +037800 CCVS-999999. IF1074.2 +037900 GO TO CLOSE-FILES. IF1074.2 +*END-OF,IF107A +*HEADER,COBOL,IF108A +000100 IDENTIFICATION DIVISION. IF1084.2 +000200 PROGRAM-ID. IF1084.2 +000300 IF108A. IF1084.2 +000400 IF1084.2 +000500*********************************************************** IF1084.2 +000600* * IF1084.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1084.2 +000800* It contains tests for the Intrinsic Function * IF1084.2 +000900* DATE-OF-INTEGER. * IF1084.2 +001000* * IF1084.2 +001100*********************************************************** IF1084.2 +001200 ENVIRONMENT DIVISION. IF1084.2 +001300 CONFIGURATION SECTION. IF1084.2 +001400 SOURCE-COMPUTER. IF1084.2 +001500 XXXXX082. IF1084.2 +001600 OBJECT-COMPUTER. IF1084.2 +001700 XXXXX083. IF1084.2 +001800 INPUT-OUTPUT SECTION. IF1084.2 +001900 FILE-CONTROL. IF1084.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1084.2 +002100 XXXXX055. IF1084.2 +002200 DATA DIVISION. IF1084.2 +002300 FILE SECTION. IF1084.2 +002400 FD PRINT-FILE. IF1084.2 +002500 01 PRINT-REC PICTURE X(120). IF1084.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1084.2 +002700 WORKING-STORAGE SECTION. IF1084.2 +002800*********************************************************** IF1084.2 +002900* Variables specific to the Intrinsic Function Test IF108A* IF1084.2 +003000*********************************************************** IF1084.2 +003100 01 A PIC S9(10) VALUE 400. IF1084.2 +003200 01 C PIC S9(10) VALUE 300. IF1084.2 +003300 01 D PIC S9(10) VALUE 1. IF1084.2 +003400 01 ARG1 PIC S9(10) VALUE 1. IF1084.2 +003500 01 ARR VALUE "40537". IF1084.2 +003600 02 IND OCCURS 5 TIMES PIC 9. IF1084.2 +003700 01 TEMP PIC S9(5)V9(5). IF1084.2 +003800 01 WS-DATE PIC 9(8). IF1084.2 +003900* IF1084.2 +004000********************************************************** IF1084.2 +004100* IF1084.2 +004200 01 TEST-RESULTS. IF1084.2 +004300 02 FILLER PIC X VALUE SPACE. IF1084.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1084.2 +004500 02 FILLER PIC X VALUE SPACE. IF1084.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1084.2 +004700 02 FILLER PIC X VALUE SPACE. IF1084.2 +004800 02 PAR-NAME. IF1084.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1084.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1084.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1084.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1084.2 +005300 02 RE-MARK PIC X(61). IF1084.2 +005400 01 TEST-COMPUTED. IF1084.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1084.2 +005600 02 FILLER PIC X(17) VALUE IF1084.2 +005700 " COMPUTED=". IF1084.2 +005800 02 COMPUTED-X. IF1084.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1084.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1084.2 +006100 PIC -9(9).9(9). IF1084.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1084.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1084.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1084.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1084.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1084.2 +006700 04 FILLER PIC X. IF1084.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1084.2 +006900 01 TEST-CORRECT. IF1084.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1084.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1084.2 +007200 02 CORRECT-X. IF1084.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1084.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1084.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1084.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1084.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1084.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1084.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1084.2 +008000 04 FILLER PIC X. IF1084.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1084.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1084.2 +008300 01 CCVS-C-1. IF1084.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1084.2 +008500- "SS PARAGRAPH-NAME IF1084.2 +008600- " REMARKS". IF1084.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1084.2 +008800 01 CCVS-C-2. IF1084.2 +008900 02 FILLER PIC X VALUE SPACE. IF1084.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1084.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1084.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1084.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1084.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1084.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1084.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1084.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1084.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1084.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1084.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1084.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1084.2 +010500 01 CCVS-H-1. IF1084.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1084.2 +010700 02 FILLER PIC X(42) VALUE IF1084.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1084.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1084.2 +011000 01 CCVS-H-2A. IF1084.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1084.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1084.2 +011300 02 FILLER PIC XXXX VALUE IF1084.2 +011400 "4.2 ". IF1084.2 +011500 02 FILLER PIC X(28) VALUE IF1084.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1084.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1084.2 +011800 IF1084.2 +011900 01 CCVS-H-2B. IF1084.2 +012000 02 FILLER PIC X(15) VALUE IF1084.2 +012100 "TEST RESULT OF ". IF1084.2 +012200 02 TEST-ID PIC X(9). IF1084.2 +012300 02 FILLER PIC X(4) VALUE IF1084.2 +012400 " IN ". IF1084.2 +012500 02 FILLER PIC X(12) VALUE IF1084.2 +012600 " HIGH ". IF1084.2 +012700 02 FILLER PIC X(22) VALUE IF1084.2 +012800 " LEVEL VALIDATION FOR ". IF1084.2 +012900 02 FILLER PIC X(58) VALUE IF1084.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1084.2 +013100 01 CCVS-H-3. IF1084.2 +013200 02 FILLER PIC X(34) VALUE IF1084.2 +013300 " FOR OFFICIAL USE ONLY ". IF1084.2 +013400 02 FILLER PIC X(58) VALUE IF1084.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1084.2 +013600 02 FILLER PIC X(28) VALUE IF1084.2 +013700 " COPYRIGHT 1985 ". IF1084.2 +013800 01 CCVS-E-1. IF1084.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1084.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1084.2 +014100 02 ID-AGAIN PIC X(9). IF1084.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1084.2 +014300 01 CCVS-E-2. IF1084.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1084.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1084.2 +014600 02 CCVS-E-2-2. IF1084.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1084.2 +014800 03 FILLER PIC X VALUE SPACE. IF1084.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1084.2 +015000 "ERRORS ENCOUNTERED". IF1084.2 +015100 01 CCVS-E-3. IF1084.2 +015200 02 FILLER PIC X(22) VALUE IF1084.2 +015300 " FOR OFFICIAL USE ONLY". IF1084.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1084.2 +015500 02 FILLER PIC X(58) VALUE IF1084.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1084.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1084.2 +015800 02 FILLER PIC X(15) VALUE IF1084.2 +015900 " COPYRIGHT 1985". IF1084.2 +016000 01 CCVS-E-4. IF1084.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1084.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1084.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1084.2 +016400 02 FILLER PIC X(40) VALUE IF1084.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1084.2 +016600 01 XXINFO. IF1084.2 +016700 02 FILLER PIC X(19) VALUE IF1084.2 +016800 "*** INFORMATION ***". IF1084.2 +016900 02 INFO-TEXT. IF1084.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1084.2 +017100 04 XXCOMPUTED PIC X(20). IF1084.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1084.2 +017300 04 XXCORRECT PIC X(20). IF1084.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1084.2 +017500 01 HYPHEN-LINE. IF1084.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1084.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1084.2 +017800- "*****************************************". IF1084.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1084.2 +018000- "******************************". IF1084.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1084.2 +018200 "IF108A". IF1084.2 +018300 PROCEDURE DIVISION. IF1084.2 +018400 CCVS1 SECTION. IF1084.2 +018500 OPEN-FILES. IF1084.2 +018600 OPEN OUTPUT PRINT-FILE. IF1084.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1084.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1084.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1084.2 +019000 GO TO CCVS1-EXIT. IF1084.2 +019100 CLOSE-FILES. IF1084.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1084.2 +019300 TERMINATE-CCVS. IF1084.2 +019400 STOP RUN. IF1084.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1084.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1084.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1084.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1084.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1084.2 +020000 PRINT-DETAIL. IF1084.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1084.2 +020200 MOVE "." TO PARDOT-X IF1084.2 +020300 MOVE REC-CT TO DOTVALUE. IF1084.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1084.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1084.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1084.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1084.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1084.2 +020900 MOVE SPACE TO CORRECT-X. IF1084.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1084.2 +021100 MOVE SPACE TO RE-MARK. IF1084.2 +021200 HEAD-ROUTINE. IF1084.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1084.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1084.2 +021700 COLUMN-NAMES-ROUTINE. IF1084.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +022100 END-ROUTINE. IF1084.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1084.2 +022300 END-RTN-EXIT. IF1084.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +022500 END-ROUTINE-1. IF1084.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1084.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1084.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1084.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1084.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1084.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1084.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1084.2 +023300 END-ROUTINE-12. IF1084.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1084.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1084.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1084.2 +023700 ELSE IF1084.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1084.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1084.2 +024000 PERFORM WRITE-LINE. IF1084.2 +024100 END-ROUTINE-13. IF1084.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1084.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1084.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1084.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1084.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1084.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1084.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1084.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1084.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +025300 WRITE-LINE. IF1084.2 +025400 ADD 1 TO RECORD-COUNT. IF1084.2 +025500Y IF RECORD-COUNT GREATER 42 IF1084.2 +025600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1084.2 +025700Y MOVE SPACE TO DUMMY-RECORD IF1084.2 +025800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1084.2 +025900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1084.2 +026000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1084.2 +026100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1084.2 +026200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1084.2 +026300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1084.2 +026700Y MOVE ZERO TO RECORD-COUNT. IF1084.2 +026800 PERFORM WRT-LN. IF1084.2 +026900 WRT-LN. IF1084.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1084.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1084.2 +027200 BLANK-LINE-PRINT. IF1084.2 +027300 PERFORM WRT-LN. IF1084.2 +027400 FAIL-ROUTINE. IF1084.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1084.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1084.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1084.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1084.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1084.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1084.2 +028200 GO TO FAIL-ROUTINE-EX. IF1084.2 +028300 FAIL-ROUTINE-WRITE. IF1084.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1084.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1084.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1084.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1084.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1084.2 +028900 BAIL-OUT. IF1084.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1084.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1084.2 +029200 BAIL-OUT-WRITE. IF1084.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1084.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1084.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1084.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1084.2 +029800 BAIL-OUT-EX. EXIT. IF1084.2 +029900 CCVS1-EXIT. IF1084.2 +030000 EXIT. IF1084.2 +030100******************************************************** IF1084.2 +030200* * IF1084.2 +030300* Intrinsic Function Test IF108A - DATE-OF-INTEGER * IF1084.2 +030400* * IF1084.2 +030500******************************************************** IF1084.2 +030600 SECT-IF108A SECTION. IF1084.2 +030700 F-DATEOFINT-INFO. IF1084.2 +030800 MOVE "See ref. A-41 2.12" TO ANSI-REFERENCE. IF1084.2 +030900 MOVE "DATE-OF-INTEGER" TO FEATURE. IF1084.2 +031000*****************TEST (a) ****************************** IF1084.2 +031100 F-DATEOFINT-01. IF1084.2 +031200 MOVE ZERO TO WS-DATE. IF1084.2 +031300 F-DATEOFINT-TEST-01. IF1084.2 +031400 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(1). IF1084.2 +031500 IF WS-DATE = 16010101 THEN IF1084.2 +031600 PERFORM PASS IF1084.2 +031700 ELSE IF1084.2 +031800 MOVE 16010101 TO CORRECT-N IF1084.2 +031900 MOVE WS-DATE TO COMPUTED-N IF1084.2 +032000 PERFORM FAIL. IF1084.2 +032100 GO TO F-DATEOFINT-WRITE-01. IF1084.2 +032200 F-DATEOFINT-DELETE-01. IF1084.2 +032300 PERFORM DE-LETE. IF1084.2 +032400 GO TO F-DATEOFINT-WRITE-01. IF1084.2 +032500 F-DATEOFINT-WRITE-01. IF1084.2 +032600 MOVE "F-DATEOFINT-01" TO PAR-NAME. IF1084.2 +032700 PERFORM PRINT-DETAIL. IF1084.2 +032800*****************TEST (b) ****************************** IF1084.2 +032900 F-DATEOFINT-TEST-02. IF1084.2 +033000 EVALUATE FUNCTION DATE-OF-INTEGER(A) IF1084.2 +033100 WHEN 16020204 IF1084.2 +033200 PERFORM PASS IF1084.2 +033300 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033400 PERFORM FAIL. IF1084.2 +033500 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033600 F-DATEOFINT-DELETE-02. IF1084.2 +033700 PERFORM DE-LETE. IF1084.2 +033800 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033900 F-DATEOFINT-WRITE-02. IF1084.2 +034000 MOVE "F-DATEOFINT-02" TO PAR-NAME. IF1084.2 +034100 PERFORM PRINT-DETAIL. IF1084.2 +034200*****************TEST (c) ****************************** IF1084.2 +034300 F-DATEOFINT-TEST-03. IF1084.2 +034400 IF FUNCTION DATE-OF-INTEGER(IND(1)) = 16010104 THEN IF1084.2 +034500 PERFORM PASS IF1084.2 +034600 ELSE IF1084.2 +034700 PERFORM FAIL. IF1084.2 +034800 GO TO F-DATEOFINT-WRITE-03. IF1084.2 +034900 F-DATEOFINT-DELETE-03. IF1084.2 +035000 PERFORM DE-LETE. IF1084.2 +035100 GO TO F-DATEOFINT-WRITE-03. IF1084.2 +035200 F-DATEOFINT-WRITE-03. IF1084.2 +035300 MOVE "F-DATEOFINT-03" TO PAR-NAME. IF1084.2 +035400 PERFORM PRINT-DETAIL. IF1084.2 +035500*****************TEST (d) ****************************** IF1084.2 +035600 F-DATEOFINT-04. IF1084.2 +035700 MOVE ZERO TO WS-DATE. IF1084.2 +035800 F-DATEOFINT-TEST-04. IF1084.2 +035900 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(IND(D)). IF1084.2 +036000 IF WS-DATE = 16010104 THEN IF1084.2 +036100 PERFORM PASS IF1084.2 +036200 ELSE IF1084.2 +036300 MOVE 16010104 TO CORRECT-N IF1084.2 +036400 MOVE WS-DATE TO COMPUTED-N IF1084.2 +036500 PERFORM FAIL. IF1084.2 +036600 GO TO F-DATEOFINT-WRITE-04. IF1084.2 +036700 F-DATEOFINT-DELETE-04. IF1084.2 +036800 PERFORM DE-LETE. IF1084.2 +036900 GO TO F-DATEOFINT-WRITE-04. IF1084.2 +037000 F-DATEOFINT-WRITE-04. IF1084.2 +037100 MOVE "F-DATEOFINT-04" TO PAR-NAME. IF1084.2 +037200 PERFORM PRINT-DETAIL. IF1084.2 +037300*****************TEST (e) ****************************** IF1084.2 +037400 F-DATEOFINT-05. IF1084.2 +037500 MOVE ZERO TO WS-DATE. IF1084.2 +037600 F-DATEOFINT-TEST-05. IF1084.2 +037700 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(730). IF1084.2 +037800 IF WS-DATE = 16021231 THEN IF1084.2 +037900 PERFORM PASS IF1084.2 +038000 ELSE IF1084.2 +038100 MOVE 16021231 TO CORRECT-N IF1084.2 +038200 MOVE WS-DATE TO COMPUTED-N IF1084.2 +038300 PERFORM FAIL. IF1084.2 +038400 GO TO F-DATEOFINT-WRITE-05. IF1084.2 +038500 F-DATEOFINT-DELETE-05. IF1084.2 +038600 PERFORM DE-LETE. IF1084.2 +038700 GO TO F-DATEOFINT-WRITE-05. IF1084.2 +038800 F-DATEOFINT-WRITE-05. IF1084.2 +038900 MOVE "F-DATEOFINT-05" TO PAR-NAME. IF1084.2 +039000 PERFORM PRINT-DETAIL. IF1084.2 +039100*****************TEST (f) ****************************** IF1084.2 +039200 F-DATEOFINT-06. IF1084.2 +039300 MOVE ZERO TO WS-DATE. IF1084.2 +039400 F-DATEOFINT-TEST-06. IF1084.2 +039500 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(C). IF1084.2 +039600 IF WS-DATE = 16011027 THEN IF1084.2 +039700 PERFORM PASS IF1084.2 +039800 ELSE IF1084.2 +039900 MOVE 16011027 TO CORRECT-N IF1084.2 +040000 MOVE WS-DATE TO COMPUTED-N IF1084.2 +040100 PERFORM FAIL. IF1084.2 +040200 GO TO F-DATEOFINT-WRITE-06. IF1084.2 +040300 F-DATEOFINT-DELETE-06. IF1084.2 +040400 PERFORM DE-LETE. IF1084.2 +040500 GO TO F-DATEOFINT-WRITE-06. IF1084.2 +040600 F-DATEOFINT-WRITE-06. IF1084.2 +040700 MOVE "F-DATEOFINT-06" TO PAR-NAME. IF1084.2 +040800 PERFORM PRINT-DETAIL. IF1084.2 +040900*****************TEST (g) ****************************** IF1084.2 +041000 F-DATEOFINT-07. IF1084.2 +041100 MOVE ZERO TO WS-DATE. IF1084.2 +041200 F-DATEOFINT-TEST-07. IF1084.2 +041300 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(365). IF1084.2 +041400 IF WS-DATE = 16011231 THEN IF1084.2 +041500 PERFORM PASS IF1084.2 +041600 ELSE IF1084.2 +041700 MOVE 16011231 TO CORRECT-N IF1084.2 +041800 MOVE WS-DATE TO COMPUTED-N IF1084.2 +041900 PERFORM FAIL. IF1084.2 +042000 GO TO F-DATEOFINT-WRITE-07. IF1084.2 +042100 F-DATEOFINT-DELETE-07. IF1084.2 +042200 PERFORM DE-LETE. IF1084.2 +042300 GO TO F-DATEOFINT-WRITE-07. IF1084.2 +042400 F-DATEOFINT-WRITE-07. IF1084.2 +042500 MOVE "F-DATEOFINT-07" TO PAR-NAME. IF1084.2 +042600 PERFORM PRINT-DETAIL. IF1084.2 +042700*****************TEST (h) ****************************** IF1084.2 +042800 F-DATEOFINT-08. IF1084.2 +042900 MOVE ZERO TO WS-DATE. IF1084.2 +043000 F-DATEOFINT-TEST-08. IF1084.2 +043100 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(D) + 10. IF1084.2 +043200 IF WS-DATE = 16010111 THEN IF1084.2 +043300 PERFORM PASS IF1084.2 +043400 ELSE IF1084.2 +043500 MOVE 16010111 TO CORRECT-N IF1084.2 +043600 MOVE WS-DATE TO COMPUTED-N IF1084.2 +043700 PERFORM FAIL. IF1084.2 +043800 GO TO F-DATEOFINT-WRITE-08. IF1084.2 +043900 F-DATEOFINT-DELETE-08. IF1084.2 +044000 PERFORM DE-LETE. IF1084.2 +044100 GO TO F-DATEOFINT-WRITE-08. IF1084.2 +044200 F-DATEOFINT-WRITE-08. IF1084.2 +044300 MOVE "F-DATEOFINT-08" TO PAR-NAME. IF1084.2 +044400 PERFORM PRINT-DETAIL. IF1084.2 +044500*****************TEST (i) ****************************** IF1084.2 +044600 F-DATEOFINT-09. IF1084.2 +044700 MOVE ZERO TO WS-DATE. IF1084.2 +044800 F-DATEOFINT-TEST-09. IF1084.2 +044900 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(D) + IF1084.2 +045000 FUNCTION DATE-OF-INTEGER(D). IF1084.2 +045100 IF WS-DATE = 32020202 THEN IF1084.2 +045200 PERFORM PASS IF1084.2 +045300 ELSE IF1084.2 +045400 MOVE 32020202 TO CORRECT-N IF1084.2 +045500 MOVE WS-DATE TO COMPUTED-N IF1084.2 +045600 PERFORM FAIL. IF1084.2 +045700 GO TO F-DATEOFINT-WRITE-09. IF1084.2 +045800 F-DATEOFINT-DELETE-09. IF1084.2 +045900 PERFORM DE-LETE. IF1084.2 +046000 GO TO F-DATEOFINT-WRITE-09. IF1084.2 +046100 F-DATEOFINT-WRITE-09. IF1084.2 +046200 MOVE "F-DATEOFINT-09" TO PAR-NAME. IF1084.2 +046300 PERFORM PRINT-DETAIL. IF1084.2 +046400 IF1084.2 +046500***************** SPECIAL TEST 1 *********************** IF1084.2 +046600 IF1084.2 +046700 F-DATEOFINT-10. IF1084.2 +046800 MOVE 1 TO ARG1. IF1084.2 +046900 PERFORM F-DATEOFINT-TEST-10 IF1084.2 +047000 UNTIL FUNCTION DATE-OF-INTEGER(ARG1) > 16010110. IF1084.2 +047100 IF ARG1 = 11 THEN IF1084.2 +047200 PERFORM PASS IF1084.2 +047300 ELSE IF1084.2 +047400 PERFORM FAIL. IF1084.2 +047500 GO TO F-DATEOFINT-WRITE-10. IF1084.2 +047600* IF1084.2 +047700 F-DATEOFINT-TEST-10. IF1084.2 +047800 COMPUTE ARG1 = ARG1 + 1. IF1084.2 +047900* IF1084.2 +048000 F-DATEOFINT-DELETE-10. IF1084.2 +048100 PERFORM DE-LETE. IF1084.2 +048200 GO TO F-DATEOFINT-WRITE-10. IF1084.2 +048300 F-DATEOFINT-WRITE-10. IF1084.2 +048400 MOVE "F-DATEOFINT-10" TO PAR-NAME. IF1084.2 +048500 PERFORM PRINT-DETAIL. IF1084.2 +048600*******************END OF TESTS************************** IF1084.2 +048700 CCVS-EXIT SECTION. IF1084.2 +048800 CCVS-999999. IF1084.2 +048900 GO TO CLOSE-FILES. IF1084.2 +*END-OF,IF108A +*HEADER,COBOL,IF109A +000100 IDENTIFICATION DIVISION. IF1094.2 +000200 PROGRAM-ID. IF1094.2 +000300 IF109A. IF1094.2 +000400 IF1094.2 +000500*********************************************************** IF1094.2 +000600* * IF1094.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1094.2 +000800* It contains tests for the Intrinsic Function * IF1094.2 +000900* DAY-OF-INTEGER. * IF1094.2 +001000* * IF1094.2 +001100*********************************************************** IF1094.2 +001200 ENVIRONMENT DIVISION. IF1094.2 +001300 CONFIGURATION SECTION. IF1094.2 +001400 SOURCE-COMPUTER. IF1094.2 +001500 XXXXX082. IF1094.2 +001600 OBJECT-COMPUTER. IF1094.2 +001700 XXXXX083. IF1094.2 +001800 INPUT-OUTPUT SECTION. IF1094.2 +001900 FILE-CONTROL. IF1094.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1094.2 +002100 XXXXX055. IF1094.2 +002200 DATA DIVISION. IF1094.2 +002300 FILE SECTION. IF1094.2 +002400 FD PRINT-FILE. IF1094.2 +002500 01 PRINT-REC PICTURE X(120). IF1094.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1094.2 +002700 WORKING-STORAGE SECTION. IF1094.2 +002800*********************************************************** IF1094.2 +002900* Variables specific to the Intrinsic Function Test IF109A* IF1094.2 +003000*********************************************************** IF1094.2 +003100 01 A PIC S9(10) VALUE 400. IF1094.2 +003200 01 C PIC S9(10) VALUE 365. IF1094.2 +003300 01 D PIC S9(10) VALUE 1. IF1094.2 +003400 01 ARG1 PIC S9(10) VALUE 1. IF1094.2 +003500 01 ARR VALUE "40537". IF1094.2 +003600 02 IND OCCURS 5 TIMES PIC 9. IF1094.2 +003700 01 TEMP PIC S9(5)V9(5). IF1094.2 +003800 01 WS-DATE PIC 9(7). IF1094.2 +003900* IF1094.2 +004000********************************************************** IF1094.2 +004100* IF1094.2 +004200 01 TEST-RESULTS. IF1094.2 +004300 02 FILLER PIC X VALUE SPACE. IF1094.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1094.2 +004500 02 FILLER PIC X VALUE SPACE. IF1094.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1094.2 +004700 02 FILLER PIC X VALUE SPACE. IF1094.2 +004800 02 PAR-NAME. IF1094.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1094.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1094.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1094.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1094.2 +005300 02 RE-MARK PIC X(61). IF1094.2 +005400 01 TEST-COMPUTED. IF1094.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1094.2 +005600 02 FILLER PIC X(17) VALUE IF1094.2 +005700 " COMPUTED=". IF1094.2 +005800 02 COMPUTED-X. IF1094.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1094.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1094.2 +006100 PIC -9(9).9(9). IF1094.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1094.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1094.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1094.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1094.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1094.2 +006700 04 FILLER PIC X. IF1094.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1094.2 +006900 01 TEST-CORRECT. IF1094.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1094.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1094.2 +007200 02 CORRECT-X. IF1094.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1094.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1094.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1094.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1094.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1094.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1094.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1094.2 +008000 04 FILLER PIC X. IF1094.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1094.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1094.2 +008300 01 CCVS-C-1. IF1094.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1094.2 +008500- "SS PARAGRAPH-NAME IF1094.2 +008600- " REMARKS". IF1094.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1094.2 +008800 01 CCVS-C-2. IF1094.2 +008900 02 FILLER PIC X VALUE SPACE. IF1094.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1094.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1094.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1094.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1094.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1094.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1094.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1094.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1094.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1094.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1094.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1094.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1094.2 +010500 01 CCVS-H-1. IF1094.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1094.2 +010700 02 FILLER PIC X(42) VALUE IF1094.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1094.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1094.2 +011000 01 CCVS-H-2A. IF1094.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1094.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1094.2 +011300 02 FILLER PIC XXXX VALUE IF1094.2 +011400 "4.2 ". IF1094.2 +011500 02 FILLER PIC X(28) VALUE IF1094.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1094.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1094.2 +011800 IF1094.2 +011900 01 CCVS-H-2B. IF1094.2 +012000 02 FILLER PIC X(15) VALUE IF1094.2 +012100 "TEST RESULT OF ". IF1094.2 +012200 02 TEST-ID PIC X(9). IF1094.2 +012300 02 FILLER PIC X(4) VALUE IF1094.2 +012400 " IN ". IF1094.2 +012500 02 FILLER PIC X(12) VALUE IF1094.2 +012600 " HIGH ". IF1094.2 +012700 02 FILLER PIC X(22) VALUE IF1094.2 +012800 " LEVEL VALIDATION FOR ". IF1094.2 +012900 02 FILLER PIC X(58) VALUE IF1094.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1094.2 +013100 01 CCVS-H-3. IF1094.2 +013200 02 FILLER PIC X(34) VALUE IF1094.2 +013300 " FOR OFFICIAL USE ONLY ". IF1094.2 +013400 02 FILLER PIC X(58) VALUE IF1094.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1094.2 +013600 02 FILLER PIC X(28) VALUE IF1094.2 +013700 " COPYRIGHT 1985 ". IF1094.2 +013800 01 CCVS-E-1. IF1094.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1094.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1094.2 +014100 02 ID-AGAIN PIC X(9). IF1094.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1094.2 +014300 01 CCVS-E-2. IF1094.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1094.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1094.2 +014600 02 CCVS-E-2-2. IF1094.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1094.2 +014800 03 FILLER PIC X VALUE SPACE. IF1094.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1094.2 +015000 "ERRORS ENCOUNTERED". IF1094.2 +015100 01 CCVS-E-3. IF1094.2 +015200 02 FILLER PIC X(22) VALUE IF1094.2 +015300 " FOR OFFICIAL USE ONLY". IF1094.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1094.2 +015500 02 FILLER PIC X(58) VALUE IF1094.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1094.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1094.2 +015800 02 FILLER PIC X(15) VALUE IF1094.2 +015900 " COPYRIGHT 1985". IF1094.2 +016000 01 CCVS-E-4. IF1094.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1094.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1094.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1094.2 +016400 02 FILLER PIC X(40) VALUE IF1094.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1094.2 +016600 01 XXINFO. IF1094.2 +016700 02 FILLER PIC X(19) VALUE IF1094.2 +016800 "*** INFORMATION ***". IF1094.2 +016900 02 INFO-TEXT. IF1094.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1094.2 +017100 04 XXCOMPUTED PIC X(20). IF1094.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1094.2 +017300 04 XXCORRECT PIC X(20). IF1094.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1094.2 +017500 01 HYPHEN-LINE. IF1094.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1094.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1094.2 +017800- "*****************************************". IF1094.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1094.2 +018000- "******************************". IF1094.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1094.2 +018200 "IF109A". IF1094.2 +018300 PROCEDURE DIVISION. IF1094.2 +018400 CCVS1 SECTION. IF1094.2 +018500 OPEN-FILES. IF1094.2 +018600 OPEN OUTPUT PRINT-FILE. IF1094.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1094.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1094.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1094.2 +019000 GO TO CCVS1-EXIT. IF1094.2 +019100 CLOSE-FILES. IF1094.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1094.2 +019300 TERMINATE-CCVS. IF1094.2 +019400 STOP RUN. IF1094.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1094.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1094.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1094.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1094.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1094.2 +020000 PRINT-DETAIL. IF1094.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1094.2 +020200 MOVE "." TO PARDOT-X IF1094.2 +020300 MOVE REC-CT TO DOTVALUE. IF1094.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1094.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1094.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1094.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1094.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1094.2 +020900 MOVE SPACE TO CORRECT-X. IF1094.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1094.2 +021100 MOVE SPACE TO RE-MARK. IF1094.2 +021200 HEAD-ROUTINE. IF1094.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1094.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1094.2 +021700 COLUMN-NAMES-ROUTINE. IF1094.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +022100 END-ROUTINE. IF1094.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1094.2 +022300 END-RTN-EXIT. IF1094.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +022500 END-ROUTINE-1. IF1094.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1094.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1094.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1094.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1094.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1094.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1094.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1094.2 +023300 END-ROUTINE-12. IF1094.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1094.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1094.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1094.2 +023700 ELSE IF1094.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1094.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1094.2 +024000 PERFORM WRITE-LINE. IF1094.2 +024100 END-ROUTINE-13. IF1094.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1094.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1094.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1094.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1094.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1094.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1094.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1094.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1094.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +025300 WRITE-LINE. IF1094.2 +025400 ADD 1 TO RECORD-COUNT. IF1094.2 +025500Y IF RECORD-COUNT GREATER 42 IF1094.2 +025600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1094.2 +025700Y MOVE SPACE TO DUMMY-RECORD IF1094.2 +025800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1094.2 +025900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1094.2 +026000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1094.2 +026100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1094.2 +026200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1094.2 +026300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1094.2 +026700Y MOVE ZERO TO RECORD-COUNT. IF1094.2 +026800 PERFORM WRT-LN. IF1094.2 +026900 WRT-LN. IF1094.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1094.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1094.2 +027200 BLANK-LINE-PRINT. IF1094.2 +027300 PERFORM WRT-LN. IF1094.2 +027400 FAIL-ROUTINE. IF1094.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1094.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1094.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1094.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1094.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1094.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1094.2 +028200 GO TO FAIL-ROUTINE-EX. IF1094.2 +028300 FAIL-ROUTINE-WRITE. IF1094.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1094.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1094.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1094.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1094.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1094.2 +028900 BAIL-OUT. IF1094.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1094.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1094.2 +029200 BAIL-OUT-WRITE. IF1094.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1094.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1094.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1094.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1094.2 +029800 BAIL-OUT-EX. EXIT. IF1094.2 +029900 CCVS1-EXIT. IF1094.2 +030000 EXIT. IF1094.2 +030100******************************************************** IF1094.2 +030200* * IF1094.2 +030300* Intrinsic Function Test IF109A - DAY-OF-INTEGER * IF1094.2 +030400* * IF1094.2 +030500******************************************************** IF1094.2 +030600 SECT-IF109A SECTION. IF1094.2 +030700 F-DAYOFINT-INFO. IF1094.2 +030800 MOVE "See ref. A-42 2.13" TO ANSI-REFERENCE. IF1094.2 +030900 MOVE "DAY-OF-INTEGER" TO FEATURE. IF1094.2 +031000*****************TEST (a) ****************************** IF1094.2 +031100 F-DAYOFINT-01. IF1094.2 +031200 MOVE ZERO TO WS-DATE. IF1094.2 +031300 F-DAYOFINT-TEST-01. IF1094.2 +031400 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(1). IF1094.2 +031500 IF WS-DATE = 1601001 THEN IF1094.2 +031600 PERFORM PASS IF1094.2 +031700 ELSE IF1094.2 +031800 MOVE 1601001 TO CORRECT-N IF1094.2 +031900 MOVE WS-DATE TO COMPUTED-N IF1094.2 +032000 PERFORM FAIL. IF1094.2 +032100 GO TO F-DAYOFINT-WRITE-01. IF1094.2 +032200 F-DAYOFINT-DELETE-01. IF1094.2 +032300 PERFORM DE-LETE. IF1094.2 +032400 GO TO F-DAYOFINT-WRITE-01. IF1094.2 +032500 F-DAYOFINT-WRITE-01. IF1094.2 +032600 MOVE "F-DAYOFINT-01" TO PAR-NAME. IF1094.2 +032700 PERFORM PRINT-DETAIL. IF1094.2 +032800*****************TEST (b) ****************************** IF1094.2 +032900 F-DAYOFINT-TEST-02. IF1094.2 +033000 EVALUATE FUNCTION DAY-OF-INTEGER(A) IF1094.2 +033100 WHEN 1602035 IF1094.2 +033200 PERFORM PASS IF1094.2 +033300 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033400 PERFORM FAIL. IF1094.2 +033500 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033600 F-DAYOFINT-DELETE-02. IF1094.2 +033700 PERFORM DE-LETE. IF1094.2 +033800 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033900 F-DAYOFINT-WRITE-02. IF1094.2 +034000 MOVE "F-DAYOFINT-02" TO PAR-NAME. IF1094.2 +034100 PERFORM PRINT-DETAIL. IF1094.2 +034200*****************TEST (c) ****************************** IF1094.2 +034300 F-DAYOFINT-TEST-03. IF1094.2 +034400 IF FUNCTION DAY-OF-INTEGER(IND(1)) = 1601004 THEN IF1094.2 +034500 PERFORM PASS IF1094.2 +034600 ELSE IF1094.2 +034700 PERFORM FAIL. IF1094.2 +034800 GO TO F-DAYOFINT-WRITE-03. IF1094.2 +034900 F-DAYOFINT-DELETE-03. IF1094.2 +035000 PERFORM DE-LETE. IF1094.2 +035100 GO TO F-DAYOFINT-WRITE-03. IF1094.2 +035200 F-DAYOFINT-WRITE-03. IF1094.2 +035300 MOVE "F-DAYOFINT-03" TO PAR-NAME. IF1094.2 +035400 PERFORM PRINT-DETAIL. IF1094.2 +035500*****************TEST (d) ****************************** IF1094.2 +035600 F-DAYOFINT-04. IF1094.2 +035700 MOVE ZERO TO WS-DATE. IF1094.2 +035800 F-DAYOFINT-TEST-04. IF1094.2 +035900 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(IND(D)). IF1094.2 +036000 IF WS-DATE = 1601004 THEN IF1094.2 +036100 PERFORM PASS IF1094.2 +036200 ELSE IF1094.2 +036300 MOVE 1601004 TO CORRECT-N IF1094.2 +036400 MOVE WS-DATE TO COMPUTED-N IF1094.2 +036500 PERFORM FAIL. IF1094.2 +036600 GO TO F-DAYOFINT-WRITE-04. IF1094.2 +036700 F-DAYOFINT-DELETE-04. IF1094.2 +036800 PERFORM DE-LETE. IF1094.2 +036900 GO TO F-DAYOFINT-WRITE-04. IF1094.2 +037000 F-DAYOFINT-WRITE-04. IF1094.2 +037100 MOVE "F-DAYOFINT-04" TO PAR-NAME. IF1094.2 +037200 PERFORM PRINT-DETAIL. IF1094.2 +037300*****************TEST (e) ****************************** IF1094.2 +037400 F-DAYOFINT-05. IF1094.2 +037500 MOVE ZERO TO WS-DATE. IF1094.2 +037600 F-DAYOFINT-TEST-05. IF1094.2 +037700 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(C). IF1094.2 +037800 IF WS-DATE = 1601365 THEN IF1094.2 +037900 PERFORM PASS IF1094.2 +038000 ELSE IF1094.2 +038100 MOVE 1601365 TO CORRECT-N IF1094.2 +038200 MOVE WS-DATE TO COMPUTED-N IF1094.2 +038300 PERFORM FAIL. IF1094.2 +038400 GO TO F-DAYOFINT-WRITE-05. IF1094.2 +038500 F-DAYOFINT-DELETE-05. IF1094.2 +038600 PERFORM DE-LETE. IF1094.2 +038700 GO TO F-DAYOFINT-WRITE-05. IF1094.2 +038800 F-DAYOFINT-WRITE-05. IF1094.2 +038900 MOVE "F-DAYOFINT-05" TO PAR-NAME. IF1094.2 +039000 PERFORM PRINT-DETAIL. IF1094.2 +039100*****************TEST (f) ****************************** IF1094.2 +039200 F-DAYOFINT-06. IF1094.2 +039300 MOVE ZERO TO WS-DATE. IF1094.2 +039400 F-DAYOFINT-TEST-06. IF1094.2 +039500 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(D) + 10. IF1094.2 +039600 IF WS-DATE = 1601011 THEN IF1094.2 +039700 PERFORM PASS IF1094.2 +039800 ELSE IF1094.2 +039900 MOVE 1601011 TO CORRECT-N IF1094.2 +040000 MOVE WS-DATE TO COMPUTED-N IF1094.2 +040100 PERFORM FAIL. IF1094.2 +040200 GO TO F-DAYOFINT-WRITE-06. IF1094.2 +040300 F-DAYOFINT-DELETE-06. IF1094.2 +040400 PERFORM DE-LETE. IF1094.2 +040500 GO TO F-DAYOFINT-WRITE-06. IF1094.2 +040600 F-DAYOFINT-WRITE-06. IF1094.2 +040700 MOVE "F-DAYOFINT-06" TO PAR-NAME. IF1094.2 +040800 PERFORM PRINT-DETAIL. IF1094.2 +040900*****************TEST (g) ****************************** IF1094.2 +041000 F-DAYOFINT-07. IF1094.2 +041100 MOVE ZERO TO WS-DATE. IF1094.2 +041200 F-DAYOFINT-TEST-07. IF1094.2 +041300 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(D) + IF1094.2 +041400 FUNCTION DAY-OF-INTEGER(D). IF1094.2 +041500 IF WS-DATE = 3202002 THEN IF1094.2 +041600 PERFORM PASS IF1094.2 +041700 ELSE IF1094.2 +041800 MOVE 3202002 TO CORRECT-N IF1094.2 +041900 MOVE WS-DATE TO COMPUTED-N IF1094.2 +042000 PERFORM FAIL. IF1094.2 +042100 GO TO F-DAYOFINT-WRITE-07. IF1094.2 +042200 F-DAYOFINT-DELETE-07. IF1094.2 +042300 PERFORM DE-LETE. IF1094.2 +042400 GO TO F-DAYOFINT-WRITE-07. IF1094.2 +042500 F-DAYOFINT-WRITE-07. IF1094.2 +042600 MOVE "F-DAYOFINT-07" TO PAR-NAME. IF1094.2 +042700 PERFORM PRINT-DETAIL. IF1094.2 +042800***************** SPECIAL TEST 1 *********************** IF1094.2 +042900 F-DAYOFINT-08. IF1094.2 +043000 MOVE 1 TO ARG1. IF1094.2 +043100 PERFORM F-DAYOFINT-TEST-08 IF1094.2 +043200 UNTIL FUNCTION DAY-OF-INTEGER(ARG1) > 1601010. IF1094.2 +043300 IF ARG1 = 11 THEN IF1094.2 +043400 PERFORM PASS IF1094.2 +043500 ELSE IF1094.2 +043600 PERFORM FAIL. IF1094.2 +043700 GO TO F-DAYOFINT-WRITE-08. IF1094.2 +043800* IF1094.2 +043900 F-DAYOFINT-TEST-08. IF1094.2 +044000 COMPUTE ARG1 = ARG1 + 1. IF1094.2 +044100* IF1094.2 +044200 F-DAYOFINT-DELETE-08. IF1094.2 +044300 PERFORM DE-LETE. IF1094.2 +044400 GO TO F-DAYOFINT-WRITE-08. IF1094.2 +044500 F-DAYOFINT-WRITE-08. IF1094.2 +044600 MOVE "F-DAYOFINT-08" TO PAR-NAME. IF1094.2 +044700 PERFORM PRINT-DETAIL. IF1094.2 +044800*******************END OF TESTS************************** IF1094.2 +044900 CCVS-EXIT SECTION. IF1094.2 +045000 CCVS-999999. IF1094.2 +045100 GO TO CLOSE-FILES. IF1094.2 +*END-OF,IF109A +*HEADER,COBOL,IF110A +000100 IDENTIFICATION DIVISION. IF1104.2 +000200 PROGRAM-ID. IF1104.2 +000300 IF110A. IF1104.2 +000400 IF1104.2 +000500*********************************************************** IF1104.2 +000600* * IF1104.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1104.2 +000800* It contains tests for the Intrinsic Function * IF1104.2 +000900* FACTORIAL. * IF1104.2 +001000* * IF1104.2 +001100*********************************************************** IF1104.2 +001200 ENVIRONMENT DIVISION. IF1104.2 +001300 CONFIGURATION SECTION. IF1104.2 +001400 SOURCE-COMPUTER. IF1104.2 +001500 XXXXX082. IF1104.2 +001600 OBJECT-COMPUTER. IF1104.2 +001700 XXXXX083. IF1104.2 +001800 INPUT-OUTPUT SECTION. IF1104.2 +001900 FILE-CONTROL. IF1104.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1104.2 +002100 XXXXX055. IF1104.2 +002200 DATA DIVISION. IF1104.2 +002300 FILE SECTION. IF1104.2 +002400 FD PRINT-FILE. IF1104.2 +002500 01 PRINT-REC PICTURE X(120). IF1104.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1104.2 +002700 WORKING-STORAGE SECTION. IF1104.2 +002800*********************************************************** IF1104.2 +002900* Variables specific to the Intrinsic Function Test IF110A* IF1104.2 +003000*********************************************************** IF1104.2 +003100 01 A PIC S9(10) VALUE 5. IF1104.2 +003200 01 B PIC S9(10) VALUE 7. IF1104.2 +003300 01 ARG1 PIC S9(10) VALUE 1. IF1104.2 +003400 01 ARR VALUE "40537". IF1104.2 +003500 02 IND OCCURS 5 TIMES PIC 9. IF1104.2 +003600 01 TEMP PIC S9(5)V9(5). IF1104.2 +003700 01 WS-NUM PIC S9(5)V9(6). IF1104.2 +003800 01 MIN-RANGE PIC S9(5)V9(7). IF1104.2 +003900 01 MAX-RANGE PIC S9(5)V9(7). IF1104.2 +004000* IF1104.2 +004100********************************************************** IF1104.2 +004200* IF1104.2 +004300 01 TEST-RESULTS. IF1104.2 +004400 02 FILLER PIC X VALUE SPACE. IF1104.2 +004500 02 FEATURE PIC X(20) VALUE SPACE. IF1104.2 +004600 02 FILLER PIC X VALUE SPACE. IF1104.2 +004700 02 P-OR-F PIC X(5) VALUE SPACE. IF1104.2 +004800 02 FILLER PIC X VALUE SPACE. IF1104.2 +004900 02 PAR-NAME. IF1104.2 +005000 03 FILLER PIC X(19) VALUE SPACE. IF1104.2 +005100 03 PARDOT-X PIC X VALUE SPACE. IF1104.2 +005200 03 DOTVALUE PIC 99 VALUE ZERO. IF1104.2 +005300 02 FILLER PIC X(8) VALUE SPACE. IF1104.2 +005400 02 RE-MARK PIC X(61). IF1104.2 +005500 01 TEST-COMPUTED. IF1104.2 +005600 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +005700 02 FILLER PIC X(17) VALUE IF1104.2 +005800 " COMPUTED=". IF1104.2 +005900 02 COMPUTED-X. IF1104.2 +006000 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1104.2 +006100 03 COMPUTED-N REDEFINES COMPUTED-A IF1104.2 +006200 PIC -9(9).9(9). IF1104.2 +006300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1104.2 +006400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1104.2 +006500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1104.2 +006600 03 CM-18V0 REDEFINES COMPUTED-A. IF1104.2 +006700 04 COMPUTED-18V0 PIC -9(18). IF1104.2 +006800 04 FILLER PIC X. IF1104.2 +006900 03 FILLER PIC X(50) VALUE SPACE. IF1104.2 +007000 01 TEST-CORRECT. IF1104.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +007200 02 FILLER PIC X(17) VALUE " CORRECT =". IF1104.2 +007300 02 CORRECT-X. IF1104.2 +007400 03 CORRECT-A PIC X(20) VALUE SPACE. IF1104.2 +007500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1104.2 +007600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1104.2 +007700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1104.2 +007800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1104.2 +007900 03 CR-18V0 REDEFINES CORRECT-A. IF1104.2 +008000 04 CORRECT-18V0 PIC -9(18). IF1104.2 +008100 04 FILLER PIC X. IF1104.2 +008200 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +008300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1104.2 +008400 01 TEST-CORRECT-MIN. IF1104.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +008600 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1104.2 +008700 02 CORRECTMI-X. IF1104.2 +008800 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1104.2 +008900 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1104.2 +009000 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1104.2 +009100 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1104.2 +009200 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1104.2 +009300 03 CR-18V0 REDEFINES CORRECTMI-A. IF1104.2 +009400 04 CORRECTMI-18V0 PIC -9(18). IF1104.2 +009500 04 FILLER PIC X. IF1104.2 +009600 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +009700 03 FILLER PIC X(48) VALUE SPACE. IF1104.2 +009800 01 TEST-CORRECT-MAX. IF1104.2 +009900 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +010000 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1104.2 +010100 02 CORRECTMA-X. IF1104.2 +010200 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1104.2 +010300 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1104.2 +010400 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1104.2 +010500 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1104.2 +010600 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1104.2 +010700 03 CR-18V0 REDEFINES CORRECTMA-A. IF1104.2 +010800 04 CORRECTMA-18V0 PIC -9(18). IF1104.2 +010900 04 FILLER PIC X. IF1104.2 +011000 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +011100 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1104.2 +011200 01 CCVS-C-1. IF1104.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1104.2 +011400- "SS PARAGRAPH-NAME IF1104.2 +011500- " REMARKS". IF1104.2 +011600 02 FILLER PIC X(20) VALUE SPACE. IF1104.2 +011700 01 CCVS-C-2. IF1104.2 +011800 02 FILLER PIC X VALUE SPACE. IF1104.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". IF1104.2 +012000 02 FILLER PIC X(15) VALUE SPACE. IF1104.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". IF1104.2 +012200 02 FILLER PIC X(94) VALUE SPACE. IF1104.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1104.2 +012400 01 REC-CT PIC 99 VALUE ZERO. IF1104.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1104.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1104.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1104.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1104.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1104.2 +013400 01 CCVS-H-1. IF1104.2 +013500 02 FILLER PIC X(39) VALUE SPACES. IF1104.2 +013600 02 FILLER PIC X(42) VALUE IF1104.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1104.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IF1104.2 +013900 01 CCVS-H-2A. IF1104.2 +014000 02 FILLER PIC X(40) VALUE SPACE. IF1104.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1104.2 +014200 02 FILLER PIC XXXX VALUE IF1104.2 +014300 "4.2 ". IF1104.2 +014400 02 FILLER PIC X(28) VALUE IF1104.2 +014500 " COPY - NOT FOR DISTRIBUTION". IF1104.2 +014600 02 FILLER PIC X(41) VALUE SPACE. IF1104.2 +014700 IF1104.2 +014800 01 CCVS-H-2B. IF1104.2 +014900 02 FILLER PIC X(15) VALUE IF1104.2 +015000 "TEST RESULT OF ". IF1104.2 +015100 02 TEST-ID PIC X(9). IF1104.2 +015200 02 FILLER PIC X(4) VALUE IF1104.2 +015300 " IN ". IF1104.2 +015400 02 FILLER PIC X(12) VALUE IF1104.2 +015500 " HIGH ". IF1104.2 +015600 02 FILLER PIC X(22) VALUE IF1104.2 +015700 " LEVEL VALIDATION FOR ". IF1104.2 +015800 02 FILLER PIC X(58) VALUE IF1104.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1104.2 +016000 01 CCVS-H-3. IF1104.2 +016100 02 FILLER PIC X(34) VALUE IF1104.2 +016200 " FOR OFFICIAL USE ONLY ". IF1104.2 +016300 02 FILLER PIC X(58) VALUE IF1104.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1104.2 +016500 02 FILLER PIC X(28) VALUE IF1104.2 +016600 " COPYRIGHT 1985 ". IF1104.2 +016700 01 CCVS-E-1. IF1104.2 +016800 02 FILLER PIC X(52) VALUE SPACE. IF1104.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1104.2 +017000 02 ID-AGAIN PIC X(9). IF1104.2 +017100 02 FILLER PIC X(45) VALUE SPACES. IF1104.2 +017200 01 CCVS-E-2. IF1104.2 +017300 02 FILLER PIC X(31) VALUE SPACE. IF1104.2 +017400 02 FILLER PIC X(21) VALUE SPACE. IF1104.2 +017500 02 CCVS-E-2-2. IF1104.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1104.2 +017700 03 FILLER PIC X VALUE SPACE. IF1104.2 +017800 03 ENDER-DESC PIC X(44) VALUE IF1104.2 +017900 "ERRORS ENCOUNTERED". IF1104.2 +018000 01 CCVS-E-3. IF1104.2 +018100 02 FILLER PIC X(22) VALUE IF1104.2 +018200 " FOR OFFICIAL USE ONLY". IF1104.2 +018300 02 FILLER PIC X(12) VALUE SPACE. IF1104.2 +018400 02 FILLER PIC X(58) VALUE IF1104.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1104.2 +018600 02 FILLER PIC X(13) VALUE SPACE. IF1104.2 +018700 02 FILLER PIC X(15) VALUE IF1104.2 +018800 " COPYRIGHT 1985". IF1104.2 +018900 01 CCVS-E-4. IF1104.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1104.2 +019100 02 FILLER PIC X(4) VALUE " OF ". IF1104.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1104.2 +019300 02 FILLER PIC X(40) VALUE IF1104.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1104.2 +019500 01 XXINFO. IF1104.2 +019600 02 FILLER PIC X(19) VALUE IF1104.2 +019700 "*** INFORMATION ***". IF1104.2 +019800 02 INFO-TEXT. IF1104.2 +019900 04 FILLER PIC X(8) VALUE SPACE. IF1104.2 +020000 04 XXCOMPUTED PIC X(20). IF1104.2 +020100 04 FILLER PIC X(5) VALUE SPACE. IF1104.2 +020200 04 XXCORRECT PIC X(20). IF1104.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). IF1104.2 +020400 01 HYPHEN-LINE. IF1104.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. IF1104.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************IF1104.2 +020700- "*****************************************". IF1104.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************IF1104.2 +020900- "******************************". IF1104.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE IF1104.2 +021100 "IF110A". IF1104.2 +021200 PROCEDURE DIVISION. IF1104.2 +021300 CCVS1 SECTION. IF1104.2 +021400 OPEN-FILES. IF1104.2 +021500 OPEN OUTPUT PRINT-FILE. IF1104.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1104.2 +021700 MOVE SPACE TO TEST-RESULTS. IF1104.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1104.2 +021900 GO TO CCVS1-EXIT. IF1104.2 +022000 CLOSE-FILES. IF1104.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1104.2 +022200 TERMINATE-CCVS. IF1104.2 +022300 STOP RUN. IF1104.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1104.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1104.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1104.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1104.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IF1104.2 +022900 PRINT-DETAIL. IF1104.2 +023000 IF REC-CT NOT EQUAL TO ZERO IF1104.2 +023100 MOVE "." TO PARDOT-X IF1104.2 +023200 MOVE REC-CT TO DOTVALUE. IF1104.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1104.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1104.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1104.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1104.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1104.2 +023800 MOVE SPACE TO CORRECT-X. IF1104.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1104.2 +024000 MOVE SPACE TO RE-MARK. IF1104.2 +024100 HEAD-ROUTINE. IF1104.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1104.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1104.2 +024600 COLUMN-NAMES-ROUTINE. IF1104.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +025000 END-ROUTINE. IF1104.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1104.2 +025200 END-RTN-EXIT. IF1104.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +025400 END-ROUTINE-1. IF1104.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1104.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1104.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IF1104.2 +025800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1104.2 +025900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1104.2 +026000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1104.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1104.2 +026200 END-ROUTINE-12. IF1104.2 +026300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1104.2 +026400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1104.2 +026500 MOVE "NO " TO ERROR-TOTAL IF1104.2 +026600 ELSE IF1104.2 +026700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1104.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1104.2 +026900 PERFORM WRITE-LINE. IF1104.2 +027000 END-ROUTINE-13. IF1104.2 +027100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1104.2 +027200 MOVE "NO " TO ERROR-TOTAL ELSE IF1104.2 +027300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1104.2 +027400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1104.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +027600 IF INSPECT-COUNTER EQUAL TO ZERO IF1104.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1104.2 +027800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1104.2 +027900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1104.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +028100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +028200 WRITE-LINE. IF1104.2 +028300 ADD 1 TO RECORD-COUNT. IF1104.2 +028400Y IF RECORD-COUNT GREATER 42 IF1104.2 +028500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1104.2 +028600Y MOVE SPACE TO DUMMY-RECORD IF1104.2 +028700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1104.2 +028800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1104.2 +028900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1104.2 +029000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1104.2 +029100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1104.2 +029200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1104.2 +029600Y MOVE ZERO TO RECORD-COUNT. IF1104.2 +029700 PERFORM WRT-LN. IF1104.2 +029800 WRT-LN. IF1104.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1104.2 +030000 MOVE SPACE TO DUMMY-RECORD. IF1104.2 +030100 BLANK-LINE-PRINT. IF1104.2 +030200 PERFORM WRT-LN. IF1104.2 +030300 FAIL-ROUTINE. IF1104.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE IF1104.2 +030500 GO TO FAIL-ROUTINE-WRITE. IF1104.2 +030600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1104.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1104.2 +030800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1104.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1104.2 +031100 GO TO FAIL-ROUTINE-EX. IF1104.2 +031200 FAIL-ROUTINE-WRITE. IF1104.2 +031300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1104.2 +031400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1104.2 +031500 CORMA-ANSI-REFERENCE. IF1104.2 +031600 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1104.2 +031700 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1104.2 +031800 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1104.2 +031900 ELSE IF1104.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1104.2 +032100 PERFORM WRITE-LINE. IF1104.2 +032200 MOVE SPACES TO COR-ANSI-REFERENCE. IF1104.2 +032300 FAIL-ROUTINE-EX. EXIT. IF1104.2 +032400 BAIL-OUT. IF1104.2 +032500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1104.2 +032600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1104.2 +032700 BAIL-OUT-WRITE. IF1104.2 +032800 MOVE CORRECT-A TO XXCORRECT. IF1104.2 +032900 MOVE COMPUTED-A TO XXCOMPUTED. IF1104.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1104.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1104.2 +033300 BAIL-OUT-EX. EXIT. IF1104.2 +033400 CCVS1-EXIT. IF1104.2 +033500 EXIT. IF1104.2 +033600******************************************************** IF1104.2 +033700* * IF1104.2 +033800* Intrinsic Function Tests IF110A - FACTORIAL * IF1104.2 +033900* * IF1104.2 +034000******************************************************** IF1104.2 +034100 SECT-IF110A SECTION. IF1104.2 +034200 F-FACTORIAL-INFO. IF1104.2 +034300 MOVE "See ref. A-43 2.14" TO ANSI-REFERENCE. IF1104.2 +034400 MOVE "FACTORIAL Function" TO FEATURE. IF1104.2 +034500*****************TEST (a) ****************************** IF1104.2 +034600 F-FACTORIAL-01. IF1104.2 +034700 MOVE ZERO TO WS-NUM. IF1104.2 +034800 F-FACTORIAL-TEST-01. IF1104.2 +034900 COMPUTE WS-NUM = FUNCTION FACTORIAL(0). IF1104.2 +035000 IF WS-NUM = 1 THEN IF1104.2 +035100 PERFORM PASS IF1104.2 +035200 ELSE IF1104.2 +035300 MOVE WS-NUM TO COMPUTED-N IF1104.2 +035400 MOVE 1 TO CORRECT-N IF1104.2 +035500 PERFORM FAIL. IF1104.2 +035600 GO TO F-FACTORIAL-WRITE-01. IF1104.2 +035700 F-FACTORIAL-DELETE-01. IF1104.2 +035800 PERFORM DE-LETE. IF1104.2 +035900 GO TO F-FACTORIAL-WRITE-01. IF1104.2 +036000 F-FACTORIAL-WRITE-01. IF1104.2 +036100 MOVE "F-FACTORIAL-01" TO PAR-NAME. IF1104.2 +036200 PERFORM PRINT-DETAIL. IF1104.2 +036300*****************TEST (b) ****************************** IF1104.2 +036400 F-FACTORIAL-02. IF1104.2 +036500 EVALUATE FUNCTION FACTORIAL(3) IF1104.2 +036600 WHEN 6 IF1104.2 +036700 PERFORM PASS IF1104.2 +036800 WHEN OTHER IF1104.2 +036900 PERFORM FAIL. IF1104.2 +037000 GO TO F-FACTORIAL-WRITE-02. IF1104.2 +037100 F-FACTORIAL-DELETE-02. IF1104.2 +037200 PERFORM DE-LETE. IF1104.2 +037300 GO TO F-FACTORIAL-WRITE-02. IF1104.2 +037400 F-FACTORIAL-WRITE-02. IF1104.2 +037500 MOVE "F-FACTORIAL-02" TO PAR-NAME. IF1104.2 +037600 PERFORM PRINT-DETAIL. IF1104.2 +037700*****************TEST (c) ****************************** IF1104.2 +037800 F-FACTORIAL-03. IF1104.2 +037900 IF FUNCTION FACTORIAL(A) = 120 THEN IF1104.2 +038000 PERFORM PASS IF1104.2 +038100 ELSE IF1104.2 +038200 PERFORM FAIL. IF1104.2 +038300 GO TO F-FACTORIAL-WRITE-03. IF1104.2 +038400 F-FACTORIAL-DELETE-03. IF1104.2 +038500 PERFORM DE-LETE. IF1104.2 +038600 GO TO F-FACTORIAL-WRITE-03. IF1104.2 +038700 F-FACTORIAL-WRITE-03. IF1104.2 +038800 MOVE "F-FACTORIAL-03" TO PAR-NAME. IF1104.2 +038900 PERFORM PRINT-DETAIL. IF1104.2 +039000*****************TEST (d) ****************************** IF1104.2 +039100 F-FACTORIAL-04. IF1104.2 +039200 MOVE ZERO TO WS-NUM. IF1104.2 +039300 F-FACTORIAL-TEST-04. IF1104.2 +039400 COMPUTE WS-NUM = FUNCTION FACTORIAL(IND(4)). IF1104.2 +039500 IF WS-NUM = 6 THEN IF1104.2 +039600 PERFORM PASS IF1104.2 +039700 ELSE IF1104.2 +039800 MOVE WS-NUM TO COMPUTED-N IF1104.2 +039900 MOVE 6 TO CORRECT-N IF1104.2 +040000 PERFORM FAIL. IF1104.2 +040100 GO TO F-FACTORIAL-WRITE-04. IF1104.2 +040200 F-FACTORIAL-DELETE-04. IF1104.2 +040300 PERFORM DE-LETE. IF1104.2 +040400 GO TO F-FACTORIAL-WRITE-04. IF1104.2 +040500 F-FACTORIAL-WRITE-04. IF1104.2 +040600 MOVE "F-FACTORIAL-04" TO PAR-NAME. IF1104.2 +040700 PERFORM PRINT-DETAIL. IF1104.2 +040800*****************TEST (e) ****************************** IF1104.2 +040900 F-FACTORIAL-05. IF1104.2 +041000 MOVE ZERO TO WS-NUM. IF1104.2 +041100 F-FACTORIAL-TEST-05. IF1104.2 +041200 COMPUTE WS-NUM = FUNCTION FACTORIAL(IND(A)). IF1104.2 +041300 IF WS-NUM = 5040 THEN IF1104.2 +041400 PERFORM PASS IF1104.2 +041500 ELSE IF1104.2 +041600 MOVE WS-NUM TO COMPUTED-N IF1104.2 +041700 MOVE 5040 TO CORRECT-N IF1104.2 +041800 PERFORM FAIL. IF1104.2 +041900 GO TO F-FACTORIAL-WRITE-05. IF1104.2 +042000 F-FACTORIAL-DELETE-05. IF1104.2 +042100 PERFORM DE-LETE. IF1104.2 +042200 GO TO F-FACTORIAL-WRITE-05. IF1104.2 +042300 F-FACTORIAL-WRITE-05. IF1104.2 +042400 MOVE "F-FACTORIAL-05" TO PAR-NAME. IF1104.2 +042500 PERFORM PRINT-DETAIL. IF1104.2 +042600*****************TEST (f) ****************************** IF1104.2 +042700 F-FACTORIAL-06. IF1104.2 +042800 MOVE ZERO TO WS-NUM. IF1104.2 +042900 F-FACTORIAL-TEST-06. IF1104.2 +043000 COMPUTE WS-NUM = FUNCTION FACTORIAL( IF1104.2 +043100 FUNCTION FACTORIAL(3)). IF1104.2 +043200 IF WS-NUM = 720 THEN IF1104.2 +043300 PERFORM PASS IF1104.2 +043400 ELSE IF1104.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1104.2 +043600 MOVE 720 TO CORRECT-N IF1104.2 +043700 PERFORM FAIL. IF1104.2 +043800 GO TO F-FACTORIAL-WRITE-06. IF1104.2 +043900 F-FACTORIAL-DELETE-06. IF1104.2 +044000 PERFORM DE-LETE. IF1104.2 +044100 GO TO F-FACTORIAL-WRITE-06. IF1104.2 +044200 F-FACTORIAL-WRITE-06. IF1104.2 +044300 MOVE "F-FACTORIAL-06" TO PAR-NAME. IF1104.2 +044400 PERFORM PRINT-DETAIL. IF1104.2 +044500*****************TEST (g) ****************************** IF1104.2 +044600 F-FACTORIAL-07. IF1104.2 +044700 MOVE ZERO TO WS-NUM. IF1104.2 +044800 F-FACTORIAL-TEST-07. IF1104.2 +044900 COMPUTE WS-NUM = FUNCTION FACTORIAL(1) + B. IF1104.2 +045000 IF WS-NUM = 8 THEN IF1104.2 +045100 PERFORM PASS IF1104.2 +045200 ELSE IF1104.2 +045300 MOVE WS-NUM TO COMPUTED-N IF1104.2 +045400 MOVE 8 TO CORRECT-N IF1104.2 +045500 PERFORM FAIL. IF1104.2 +045600 GO TO F-FACTORIAL-WRITE-07. IF1104.2 +045700 F-FACTORIAL-DELETE-07. IF1104.2 +045800 PERFORM DE-LETE. IF1104.2 +045900 GO TO F-FACTORIAL-WRITE-07. IF1104.2 +046000 F-FACTORIAL-WRITE-07. IF1104.2 +046100 MOVE "F-FACTORIAL-07" TO PAR-NAME. IF1104.2 +046200 PERFORM PRINT-DETAIL. IF1104.2 +046300*****************TEST (h) ****************************** IF1104.2 +046400 F-FACTORIAL-08. IF1104.2 +046500 MOVE ZERO TO WS-NUM. IF1104.2 +046600 F-FACTORIAL-TEST-08. IF1104.2 +046700 COMPUTE WS-NUM = FUNCTION FACTORIAL(4) + IF1104.2 +046800 FUNCTION FACTORIAL(2). IF1104.2 +046900 IF WS-NUM = 26 THEN IF1104.2 +047000 PERFORM PASS IF1104.2 +047100 ELSE IF1104.2 +047200 MOVE WS-NUM TO COMPUTED-N IF1104.2 +047300 MOVE 26 TO CORRECT-N IF1104.2 +047400 PERFORM FAIL. IF1104.2 +047500 GO TO F-FACTORIAL-WRITE-08. IF1104.2 +047600 F-FACTORIAL-DELETE-08. IF1104.2 +047700 PERFORM DE-LETE. IF1104.2 +047800 GO TO F-FACTORIAL-WRITE-08. IF1104.2 +047900 F-FACTORIAL-WRITE-08. IF1104.2 +048000 MOVE "F-FACTORIAL-08" TO PAR-NAME. IF1104.2 +048100 PERFORM PRINT-DETAIL. IF1104.2 +048200*****************SPECIAL PERFORM TEST********************** IF1104.2 +048300 F-FACTORIAL-09. IF1104.2 +048400 MOVE ZERO TO WS-NUM. IF1104.2 +048500 PERFORM F-FACTORIAL-TEST-09 IF1104.2 +048600 UNTIL FUNCTION FACTORIAL(ARG1) > 120. IF1104.2 +048700 PERFORM PASS. IF1104.2 +048800 GO TO F-FACTORIAL-WRITE-09. IF1104.2 +048900 F-FACTORIAL-TEST-09. IF1104.2 +049000 COMPUTE ARG1 = ARG1 + 1. IF1104.2 +049100 F-FACTORIAL-DELETE-09. IF1104.2 +049200 PERFORM DE-LETE. IF1104.2 +049300 GO TO F-FACTORIAL-WRITE-09. IF1104.2 +049400 F-FACTORIAL-WRITE-09. IF1104.2 +049500 MOVE "F-FACTORIAL-09" TO PAR-NAME. IF1104.2 +049600 PERFORM PRINT-DETAIL. IF1104.2 +049700********************END OF TESTS*************** IF1104.2 +049800 CCVS-EXIT SECTION. IF1104.2 +049900 CCVS-999999. IF1104.2 +050000 GO TO CLOSE-FILES. IF1104.2 +*END-OF,IF110A +*HEADER,COBOL,IF111A +000100 IDENTIFICATION DIVISION. IF1114.2 +000200 PROGRAM-ID. IF1114.2 +000300 IF111A. IF1114.2 +000400 IF1114.2 +000500*********************************************************** IF1114.2 +000600* * IF1114.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1114.2 +000800* It contains tests for the Intrinsic Function * IF1114.2 +000900* INTEGER. * IF1114.2 +001000* * IF1114.2 +001100*********************************************************** IF1114.2 +001200 ENVIRONMENT DIVISION. IF1114.2 +001300 CONFIGURATION SECTION. IF1114.2 +001400 SOURCE-COMPUTER. IF1114.2 +001500 XXXXX082. IF1114.2 +001600 OBJECT-COMPUTER. IF1114.2 +001700 XXXXX083. IF1114.2 +001800 INPUT-OUTPUT SECTION. IF1114.2 +001900 FILE-CONTROL. IF1114.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1114.2 +002100 XXXXX055. IF1114.2 +002200 DATA DIVISION. IF1114.2 +002300 FILE SECTION. IF1114.2 +002400 FD PRINT-FILE. IF1114.2 +002500 01 PRINT-REC PICTURE X(120). IF1114.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1114.2 +002700 WORKING-STORAGE SECTION. IF1114.2 +002800*********************************************************** IF1114.2 +002900* Variables specific to the Intrinsic Function Test IF111A* IF1114.2 +003000*********************************************************** IF1114.2 +003100 01 A PIC S9(10) VALUE 500000. IF1114.2 +003200 01 B PIC S9(10) VALUE 1. IF1114.2 +003300 01 E PIC S9(6)V9(5) VALUE 399999.122. IF1114.2 +003400 01 F PIC S9(5)V9(5) VALUE 0.00032. IF1114.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1114.2 +003600 01 H PIC S9(5)V9(5) VALUE -5. IF1114.2 +003700 01 I PIC S9(5)V9(5) VALUE 3.4. IF1114.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 4.4. IF1114.2 +003900 01 ARR VALUE "40537". IF1114.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1114.2 +004100 01 TEMP PIC S9(5)V9(5). IF1114.2 +004200 01 WS-INT PIC S9(10). IF1114.2 +004300* IF1114.2 +004400********************************************************** IF1114.2 +004500* IF1114.2 +004600 01 TEST-RESULTS. IF1114.2 +004700 02 FILLER PIC X VALUE SPACE. IF1114.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IF1114.2 +004900 02 FILLER PIC X VALUE SPACE. IF1114.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IF1114.2 +005100 02 FILLER PIC X VALUE SPACE. IF1114.2 +005200 02 PAR-NAME. IF1114.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IF1114.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IF1114.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IF1114.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IF1114.2 +005700 02 RE-MARK PIC X(61). IF1114.2 +005800 01 TEST-COMPUTED. IF1114.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IF1114.2 +006000 02 FILLER PIC X(17) VALUE IF1114.2 +006100 " COMPUTED=". IF1114.2 +006200 02 COMPUTED-X. IF1114.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1114.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IF1114.2 +006500 PIC -9(9).9(9). IF1114.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1114.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1114.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1114.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IF1114.2 +007000 04 COMPUTED-18V0 PIC -9(18). IF1114.2 +007100 04 FILLER PIC X. IF1114.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IF1114.2 +007300 01 TEST-CORRECT. IF1114.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1114.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1114.2 +007600 02 CORRECT-X. IF1114.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1114.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1114.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1114.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1114.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1114.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IF1114.2 +008300 04 CORRECT-18V0 PIC -9(18). IF1114.2 +008400 04 FILLER PIC X. IF1114.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IF1114.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1114.2 +008700 01 CCVS-C-1. IF1114.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1114.2 +008900- "SS PARAGRAPH-NAME IF1114.2 +009000- " REMARKS". IF1114.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IF1114.2 +009200 01 CCVS-C-2. IF1114.2 +009300 02 FILLER PIC X VALUE SPACE. IF1114.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IF1114.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IF1114.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IF1114.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IF1114.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1114.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IF1114.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1114.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1114.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1114.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1114.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1114.2 +010900 01 CCVS-H-1. IF1114.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IF1114.2 +011100 02 FILLER PIC X(42) VALUE IF1114.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1114.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IF1114.2 +011400 01 CCVS-H-2A. IF1114.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IF1114.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1114.2 +011700 02 FILLER PIC XXXX VALUE IF1114.2 +011800 "4.2 ". IF1114.2 +011900 02 FILLER PIC X(28) VALUE IF1114.2 +012000 " COPY - NOT FOR DISTRIBUTION". IF1114.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IF1114.2 +012200 IF1114.2 +012300 01 CCVS-H-2B. IF1114.2 +012400 02 FILLER PIC X(15) VALUE IF1114.2 +012500 "TEST RESULT OF ". IF1114.2 +012600 02 TEST-ID PIC X(9). IF1114.2 +012700 02 FILLER PIC X(4) VALUE IF1114.2 +012800 " IN ". IF1114.2 +012900 02 FILLER PIC X(12) VALUE IF1114.2 +013000 " HIGH ". IF1114.2 +013100 02 FILLER PIC X(22) VALUE IF1114.2 +013200 " LEVEL VALIDATION FOR ". IF1114.2 +013300 02 FILLER PIC X(58) VALUE IF1114.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1114.2 +013500 01 CCVS-H-3. IF1114.2 +013600 02 FILLER PIC X(34) VALUE IF1114.2 +013700 " FOR OFFICIAL USE ONLY ". IF1114.2 +013800 02 FILLER PIC X(58) VALUE IF1114.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1114.2 +014000 02 FILLER PIC X(28) VALUE IF1114.2 +014100 " COPYRIGHT 1985 ". IF1114.2 +014200 01 CCVS-E-1. IF1114.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IF1114.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1114.2 +014500 02 ID-AGAIN PIC X(9). IF1114.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IF1114.2 +014700 01 CCVS-E-2. IF1114.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IF1114.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IF1114.2 +015000 02 CCVS-E-2-2. IF1114.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1114.2 +015200 03 FILLER PIC X VALUE SPACE. IF1114.2 +015300 03 ENDER-DESC PIC X(44) VALUE IF1114.2 +015400 "ERRORS ENCOUNTERED". IF1114.2 +015500 01 CCVS-E-3. IF1114.2 +015600 02 FILLER PIC X(22) VALUE IF1114.2 +015700 " FOR OFFICIAL USE ONLY". IF1114.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IF1114.2 +015900 02 FILLER PIC X(58) VALUE IF1114.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1114.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IF1114.2 +016200 02 FILLER PIC X(15) VALUE IF1114.2 +016300 " COPYRIGHT 1985". IF1114.2 +016400 01 CCVS-E-4. IF1114.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1114.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IF1114.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1114.2 +016800 02 FILLER PIC X(40) VALUE IF1114.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1114.2 +017000 01 XXINFO. IF1114.2 +017100 02 FILLER PIC X(19) VALUE IF1114.2 +017200 "*** INFORMATION ***". IF1114.2 +017300 02 INFO-TEXT. IF1114.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IF1114.2 +017500 04 XXCOMPUTED PIC X(20). IF1114.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IF1114.2 +017700 04 XXCORRECT PIC X(20). IF1114.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IF1114.2 +017900 01 HYPHEN-LINE. IF1114.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IF1114.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IF1114.2 +018200- "*****************************************". IF1114.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IF1114.2 +018400- "******************************". IF1114.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IF1114.2 +018600 "IF111A". IF1114.2 +018700 PROCEDURE DIVISION. IF1114.2 +018800 CCVS1 SECTION. IF1114.2 +018900 OPEN-FILES. IF1114.2 +019000 OPEN OUTPUT PRINT-FILE. IF1114.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1114.2 +019200 MOVE SPACE TO TEST-RESULTS. IF1114.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1114.2 +019400 GO TO CCVS1-EXIT. IF1114.2 +019500 CLOSE-FILES. IF1114.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1114.2 +019700 TERMINATE-CCVS. IF1114.2 +019800 STOP RUN. IF1114.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1114.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1114.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1114.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1114.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IF1114.2 +020400 PRINT-DETAIL. IF1114.2 +020500 IF REC-CT NOT EQUAL TO ZERO IF1114.2 +020600 MOVE "." TO PARDOT-X IF1114.2 +020700 MOVE REC-CT TO DOTVALUE. IF1114.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1114.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1114.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1114.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1114.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1114.2 +021300 MOVE SPACE TO CORRECT-X. IF1114.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1114.2 +021500 MOVE SPACE TO RE-MARK. IF1114.2 +021600 HEAD-ROUTINE. IF1114.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1114.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1114.2 +022100 COLUMN-NAMES-ROUTINE. IF1114.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +022500 END-ROUTINE. IF1114.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1114.2 +022700 END-RTN-EXIT. IF1114.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +022900 END-ROUTINE-1. IF1114.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1114.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1114.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IF1114.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1114.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1114.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1114.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1114.2 +023700 END-ROUTINE-12. IF1114.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1114.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1114.2 +024000 MOVE "NO " TO ERROR-TOTAL IF1114.2 +024100 ELSE IF1114.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1114.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1114.2 +024400 PERFORM WRITE-LINE. IF1114.2 +024500 END-ROUTINE-13. IF1114.2 +024600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1114.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE IF1114.2 +024800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1114.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1114.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO IF1114.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1114.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1114.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1114.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025700 WRITE-LINE. IF1114.2 +025800 ADD 1 TO RECORD-COUNT. IF1114.2 +025900Y IF RECORD-COUNT GREATER 42 IF1114.2 +026000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1114.2 +026100Y MOVE SPACE TO DUMMY-RECORD IF1114.2 +026200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1114.2 +026300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1114.2 +026400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1114.2 +026500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1114.2 +026600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1114.2 +026700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +026800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +026900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +027000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1114.2 +027100Y MOVE ZERO TO RECORD-COUNT. IF1114.2 +027200 PERFORM WRT-LN. IF1114.2 +027300 WRT-LN. IF1114.2 +027400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1114.2 +027500 MOVE SPACE TO DUMMY-RECORD. IF1114.2 +027600 BLANK-LINE-PRINT. IF1114.2 +027700 PERFORM WRT-LN. IF1114.2 +027800 FAIL-ROUTINE. IF1114.2 +027900 IF COMPUTED-X NOT EQUAL TO SPACE IF1114.2 +028000 GO TO FAIL-ROUTINE-WRITE. IF1114.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1114.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1114.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1114.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1114.2 +028600 GO TO FAIL-ROUTINE-EX. IF1114.2 +028700 FAIL-ROUTINE-WRITE. IF1114.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1114.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1114.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1114.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1114.2 +029200 FAIL-ROUTINE-EX. EXIT. IF1114.2 +029300 BAIL-OUT. IF1114.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1114.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1114.2 +029600 BAIL-OUT-WRITE. IF1114.2 +029700 MOVE CORRECT-A TO XXCORRECT. IF1114.2 +029800 MOVE COMPUTED-A TO XXCOMPUTED. IF1114.2 +029900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1114.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1114.2 +030200 BAIL-OUT-EX. EXIT. IF1114.2 +030300 CCVS1-EXIT. IF1114.2 +030400 EXIT. IF1114.2 +030500******************************************************** IF1114.2 +030600* * IF1114.2 +030700* Intrinsic Function Tests IF111A - INTEGER * IF1114.2 +030800* * IF1114.2 +030900******************************************************** IF1114.2 +031000 SECT-IF111A SECTION. IF1114.2 +031100 F-INTEGER-INFO. IF1114.2 +031200 MOVE "See ref. A-44 2.15" TO ANSI-REFERENCE. IF1114.2 +031300 MOVE "INTEGER Function" TO FEATURE. IF1114.2 +031400*****************TEST (a) ****************************** IF1114.2 +031500 F-INTEGER-01. IF1114.2 +031600 MOVE ZERO TO WS-INT. IF1114.2 +031700 F-INTEGER-TEST-01. IF1114.2 +031800 COMPUTE WS-INT = FUNCTION INTEGER(0). IF1114.2 +031900 IF WS-INT = 0 THEN IF1114.2 +032000 PERFORM PASS IF1114.2 +032100 ELSE IF1114.2 +032200 MOVE 0 TO CORRECT-N IF1114.2 +032300 MOVE WS-INT TO COMPUTED-N IF1114.2 +032400 PERFORM FAIL. IF1114.2 +032500 GO TO F-INTEGER-WRITE-01. IF1114.2 +032600 F-INTEGER-DELETE-01. IF1114.2 +032700 PERFORM DE-LETE. IF1114.2 +032800 GO TO F-INTEGER-WRITE-01. IF1114.2 +032900 F-INTEGER-WRITE-01. IF1114.2 +033000 MOVE "F-INTEGER-01" TO PAR-NAME. IF1114.2 +033100 PERFORM PRINT-DETAIL. IF1114.2 +033200*****************TEST (b) ****************************** IF1114.2 +033300 F-INTEGER-02. IF1114.2 +033400 MOVE ZERO TO WS-INT. IF1114.2 +033500 F-INTEGER-TEST-02. IF1114.2 +033600 EVALUATE FUNCTION INTEGER(3) IF1114.2 +033700 WHEN 3 IF1114.2 +033800 PERFORM PASS IF1114.2 +033900 GO TO F-INTEGER-WRITE-02. IF1114.2 +034000 PERFORM FAIL. IF1114.2 +034100 GO TO F-INTEGER-WRITE-02. IF1114.2 +034200 F-INTEGER-DELETE-02. IF1114.2 +034300 PERFORM DE-LETE. IF1114.2 +034400 GO TO F-INTEGER-WRITE-02. IF1114.2 +034500 F-INTEGER-WRITE-02. IF1114.2 +034600 MOVE "F-INTEGER-02" TO PAR-NAME. IF1114.2 +034700 PERFORM PRINT-DETAIL. IF1114.2 +034800*****************TEST (c) ****************************** IF1114.2 +034900 F-INTEGER-03. IF1114.2 +035000 MOVE ZERO TO WS-INT. IF1114.2 +035100 F-INTEGER-TEST-03. IF1114.2 +035200 IF FUNCTION INTEGER(4.578) = 4 THEN IF1114.2 +035300 PERFORM PASS IF1114.2 +035400 ELSE IF1114.2 +035500 MOVE 4 TO CORRECT-N IF1114.2 +035600 PERFORM FAIL. IF1114.2 +035700 GO TO F-INTEGER-WRITE-03. IF1114.2 +035800 F-INTEGER-DELETE-03. IF1114.2 +035900 PERFORM DE-LETE. IF1114.2 +036000 GO TO F-INTEGER-WRITE-03. IF1114.2 +036100 F-INTEGER-WRITE-03. IF1114.2 +036200 MOVE "F-INTEGER-03" TO PAR-NAME. IF1114.2 +036300 PERFORM PRINT-DETAIL. IF1114.2 +036400*****************TEST (d) ****************************** IF1114.2 +036500 F-INTEGER-04. IF1114.2 +036600 MOVE ZERO TO WS-INT. IF1114.2 +036700 F-INTEGER-TEST-04. IF1114.2 +036800 COMPUTE WS-INT = FUNCTION INTEGER(-58). IF1114.2 +036900 IF WS-INT = -58 THEN IF1114.2 +037000 PERFORM PASS IF1114.2 +037100 ELSE IF1114.2 +037200 MOVE -58 TO CORRECT-N IF1114.2 +037300 MOVE WS-INT TO COMPUTED-N IF1114.2 +037400 PERFORM FAIL. IF1114.2 +037500 GO TO F-INTEGER-WRITE-04. IF1114.2 +037600 F-INTEGER-DELETE-04. IF1114.2 +037700 PERFORM DE-LETE. IF1114.2 +037800 GO TO F-INTEGER-WRITE-04. IF1114.2 +037900 F-INTEGER-WRITE-04. IF1114.2 +038000 MOVE "F-INTEGER-04" TO PAR-NAME. IF1114.2 +038100 PERFORM PRINT-DETAIL. IF1114.2 +038200*****************TEST (e) ****************************** IF1114.2 +038300 F-INTEGER-05. IF1114.2 +038400 MOVE ZERO TO WS-INT. IF1114.2 +038500 F-INTEGER-TEST-05. IF1114.2 +038600 COMPUTE WS-INT = FUNCTION INTEGER(-9.763). IF1114.2 +038700 IF WS-INT = -10 THEN IF1114.2 +038800 PERFORM PASS IF1114.2 +038900 ELSE IF1114.2 +039000 MOVE -10 TO CORRECT-N IF1114.2 +039100 MOVE WS-INT TO COMPUTED-N IF1114.2 +039200 PERFORM FAIL. IF1114.2 +039300 GO TO F-INTEGER-WRITE-05. IF1114.2 +039400 F-INTEGER-DELETE-05. IF1114.2 +039500 PERFORM DE-LETE. IF1114.2 +039600 GO TO F-INTEGER-WRITE-05. IF1114.2 +039700 F-INTEGER-WRITE-05. IF1114.2 +039800 MOVE "F-INTEGER-05" TO PAR-NAME. IF1114.2 +039900 PERFORM PRINT-DETAIL. IF1114.2 +040000*****************TEST (f) ****************************** IF1114.2 +040100 F-INTEGER-06. IF1114.2 +040200 MOVE ZERO TO WS-INT. IF1114.2 +040300 F-INTEGER-TEST-06. IF1114.2 +040400 COMPUTE WS-INT = FUNCTION INTEGER(320485). IF1114.2 +040500 IF WS-INT = 320485 THEN IF1114.2 +040600 PERFORM PASS IF1114.2 +040700 ELSE IF1114.2 +040800 MOVE 320485 TO CORRECT-N IF1114.2 +040900 MOVE WS-INT TO COMPUTED-N IF1114.2 +041000 PERFORM FAIL. IF1114.2 +041100 GO TO F-INTEGER-WRITE-06. IF1114.2 +041200 F-INTEGER-DELETE-06. IF1114.2 +041300 PERFORM DE-LETE. IF1114.2 +041400 GO TO F-INTEGER-WRITE-06. IF1114.2 +041500 F-INTEGER-WRITE-06. IF1114.2 +041600 MOVE "F-INTEGER-06" TO PAR-NAME. IF1114.2 +041700 PERFORM PRINT-DETAIL. IF1114.2 +041800*****************TEST (g) ****************************** IF1114.2 +041900 F-INTEGER-07. IF1114.2 +042000 MOVE ZERO TO WS-INT. IF1114.2 +042100 F-INTEGER-TEST-07. IF1114.2 +042200 COMPUTE WS-INT = FUNCTION INTEGER(230492.4828). IF1114.2 +042300 IF WS-INT = 230492 THEN IF1114.2 +042400 PERFORM PASS IF1114.2 +042500 ELSE IF1114.2 +042600 MOVE 230492 TO CORRECT-N IF1114.2 +042700 MOVE WS-INT TO COMPUTED-N IF1114.2 +042800 PERFORM FAIL. IF1114.2 +042900 GO TO F-INTEGER-WRITE-07. IF1114.2 +043000 F-INTEGER-DELETE-07. IF1114.2 +043100 PERFORM DE-LETE. IF1114.2 +043200 GO TO F-INTEGER-WRITE-07. IF1114.2 +043300 F-INTEGER-WRITE-07. IF1114.2 +043400 MOVE "F-INTEGER-07" TO PAR-NAME. IF1114.2 +043500 PERFORM PRINT-DETAIL. IF1114.2 +043600*****************TEST (h) ****************************** IF1114.2 +043700 F-INTEGER-08. IF1114.2 +043800 MOVE ZERO TO WS-INT. IF1114.2 +043900 F-INTEGER-TEST-08. IF1114.2 +044000 COMPUTE WS-INT = FUNCTION INTEGER(0.00032). IF1114.2 +044100 IF WS-INT = 0 THEN IF1114.2 +044200 PERFORM PASS IF1114.2 +044300 ELSE IF1114.2 +044400 MOVE 0 TO CORRECT-N IF1114.2 +044500 MOVE WS-INT TO COMPUTED-N IF1114.2 +044600 PERFORM FAIL. IF1114.2 +044700 GO TO F-INTEGER-WRITE-08. IF1114.2 +044800 F-INTEGER-DELETE-08. IF1114.2 +044900 PERFORM DE-LETE. IF1114.2 +045000 GO TO F-INTEGER-WRITE-08. IF1114.2 +045100 F-INTEGER-WRITE-08. IF1114.2 +045200 MOVE "F-INTEGER-08" TO PAR-NAME. IF1114.2 +045300 PERFORM PRINT-DETAIL. IF1114.2 +045400*****************TEST (i) ****************************** IF1114.2 +045500 F-INTEGER-09. IF1114.2 +045600 MOVE ZERO TO WS-INT. IF1114.2 +045700 F-INTEGER-TEST-09. IF1114.2 +045800 COMPUTE WS-INT = FUNCTION INTEGER(A). IF1114.2 +045900 IF WS-INT = 500000 THEN IF1114.2 +046000 PERFORM PASS IF1114.2 +046100 ELSE IF1114.2 +046200 MOVE 500000 TO CORRECT-N IF1114.2 +046300 MOVE WS-INT TO COMPUTED-N IF1114.2 +046400 PERFORM FAIL. IF1114.2 +046500 GO TO F-INTEGER-WRITE-09. IF1114.2 +046600 F-INTEGER-DELETE-09. IF1114.2 +046700 PERFORM DE-LETE. IF1114.2 +046800 GO TO F-INTEGER-WRITE-09. IF1114.2 +046900 F-INTEGER-WRITE-09. IF1114.2 +047000 MOVE "F-INTEGER-09" TO PAR-NAME. IF1114.2 +047100 PERFORM PRINT-DETAIL. IF1114.2 +047200*****************TEST (j) ****************************** IF1114.2 +047300 F-INTEGER-10. IF1114.2 +047400 MOVE ZERO TO WS-INT. IF1114.2 +047500 F-INTEGER-TEST-10. IF1114.2 +047600 COMPUTE WS-INT = FUNCTION INTEGER(E). IF1114.2 +047700 IF WS-INT = 399999 THEN IF1114.2 +047800 PERFORM PASS IF1114.2 +047900 ELSE IF1114.2 +048000 MOVE 399999 TO CORRECT-N IF1114.2 +048100 MOVE WS-INT TO COMPUTED-N IF1114.2 +048200 PERFORM FAIL. IF1114.2 +048300 GO TO F-INTEGER-WRITE-10. IF1114.2 +048400 F-INTEGER-DELETE-10. IF1114.2 +048500 PERFORM DE-LETE. IF1114.2 +048600 GO TO F-INTEGER-WRITE-10. IF1114.2 +048700 F-INTEGER-WRITE-10. IF1114.2 +048800 MOVE "F-INTEGER-10" TO PAR-NAME. IF1114.2 +048900 PERFORM PRINT-DETAIL. IF1114.2 +049000*****************TEST (k) ****************************** IF1114.2 +049100 F-INTEGER-11. IF1114.2 +049200 MOVE ZERO TO WS-INT. IF1114.2 +049300 F-INTEGER-TEST-11. IF1114.2 +049400 COMPUTE WS-INT = FUNCTION INTEGER(B). IF1114.2 +049500 IF WS-INT = 1 THEN IF1114.2 +049600 PERFORM PASS IF1114.2 +049700 ELSE IF1114.2 +049800 MOVE 1 TO CORRECT-N IF1114.2 +049900 MOVE WS-INT TO COMPUTED-N IF1114.2 +050000 PERFORM FAIL. IF1114.2 +050100 GO TO F-INTEGER-WRITE-11. IF1114.2 +050200 F-INTEGER-DELETE-11. IF1114.2 +050300 PERFORM DE-LETE. IF1114.2 +050400 GO TO F-INTEGER-WRITE-11. IF1114.2 +050500 F-INTEGER-WRITE-11. IF1114.2 +050600 MOVE "F-INTEGER-11" TO PAR-NAME. IF1114.2 +050700 PERFORM PRINT-DETAIL. IF1114.2 +050800*****************TEST (l) ****************************** IF1114.2 +050900 F-INTEGER-12. IF1114.2 +051000 MOVE ZERO TO WS-INT. IF1114.2 +051100 F-INTEGER-TEST-12. IF1114.2 +051200 COMPUTE WS-INT = FUNCTION INTEGER(F). IF1114.2 +051300 IF WS-INT = 0 THEN IF1114.2 +051400 PERFORM PASS IF1114.2 +051500 ELSE IF1114.2 +051600 MOVE 0 TO CORRECT-N IF1114.2 +051700 MOVE WS-INT TO COMPUTED-N IF1114.2 +051800 PERFORM FAIL. IF1114.2 +051900 GO TO F-INTEGER-WRITE-12. IF1114.2 +052000 F-INTEGER-DELETE-12. IF1114.2 +052100 PERFORM DE-LETE. IF1114.2 +052200 GO TO F-INTEGER-WRITE-12. IF1114.2 +052300 F-INTEGER-WRITE-12. IF1114.2 +052400 MOVE "F-INTEGER-12" TO PAR-NAME. IF1114.2 +052500 PERFORM PRINT-DETAIL. IF1114.2 +052600*****************TEST (m) ****************************** IF1114.2 +052700 F-INTEGER-13. IF1114.2 +052800 MOVE ZERO TO WS-INT. IF1114.2 +052900 F-INTEGER-TEST-13. IF1114.2 +053000 COMPUTE WS-INT = FUNCTION INTEGER(IND(2)). IF1114.2 +053100 IF WS-INT = 0 THEN IF1114.2 +053200 PERFORM PASS IF1114.2 +053300 ELSE IF1114.2 +053400 MOVE 0 TO CORRECT-N IF1114.2 +053500 MOVE WS-INT TO COMPUTED-N IF1114.2 +053600 PERFORM FAIL. IF1114.2 +053700 GO TO F-INTEGER-WRITE-13. IF1114.2 +053800 F-INTEGER-DELETE-13. IF1114.2 +053900 PERFORM DE-LETE. IF1114.2 +054000 GO TO F-INTEGER-WRITE-13. IF1114.2 +054100 F-INTEGER-WRITE-13. IF1114.2 +054200 MOVE "F-INTEGER-13" TO PAR-NAME. IF1114.2 +054300 PERFORM PRINT-DETAIL. IF1114.2 +054400*****************TEST (n) ****************************** IF1114.2 +054500 F-INTEGER-14. IF1114.2 +054600 MOVE ZERO TO WS-INT. IF1114.2 +054700 F-INTEGER-TEST-14. IF1114.2 +054800 COMPUTE WS-INT = FUNCTION INTEGER(IND(B)). IF1114.2 +054900 IF WS-INT = 4 THEN IF1114.2 +055000 PERFORM PASS IF1114.2 +055100 ELSE IF1114.2 +055200 MOVE 4 TO CORRECT-N IF1114.2 +055300 MOVE WS-INT TO COMPUTED-N IF1114.2 +055400 PERFORM FAIL. IF1114.2 +055500 GO TO F-INTEGER-WRITE-14. IF1114.2 +055600 F-INTEGER-DELETE-14. IF1114.2 +055700 PERFORM DE-LETE. IF1114.2 +055800 GO TO F-INTEGER-WRITE-14. IF1114.2 +055900 F-INTEGER-WRITE-14. IF1114.2 +056000 MOVE "F-INTEGER-14" TO PAR-NAME. IF1114.2 +056100 PERFORM PRINT-DETAIL. IF1114.2 +056200*****************TEST (o) ****************************** IF1114.2 +056300 F-INTEGER-15. IF1114.2 +056400 MOVE ZERO TO WS-INT. IF1114.2 +056500 F-INTEGER-TEST-15. IF1114.2 +056600 COMPUTE WS-INT = FUNCTION INTEGER((6 / 3) + 9). IF1114.2 +056700 IF WS-INT = 11 THEN IF1114.2 +056800 PERFORM PASS IF1114.2 +056900 ELSE IF1114.2 +057000 MOVE 11 TO CORRECT-N IF1114.2 +057100 MOVE WS-INT TO COMPUTED-N IF1114.2 +057200 PERFORM FAIL. IF1114.2 +057300 GO TO F-INTEGER-WRITE-15. IF1114.2 +057400 F-INTEGER-DELETE-15. IF1114.2 +057500 PERFORM DE-LETE. IF1114.2 +057600 GO TO F-INTEGER-WRITE-15. IF1114.2 +057700 F-INTEGER-WRITE-15. IF1114.2 +057800 MOVE "F-INTEGER-15" TO PAR-NAME. IF1114.2 +057900 PERFORM PRINT-DETAIL. IF1114.2 +058000*****************TEST (p) ****************************** IF1114.2 +058100 F-INTEGER-16. IF1114.2 +058200 MOVE ZERO TO WS-INT. IF1114.2 +058300 F-INTEGER-TEST-16. IF1114.2 +058400 COMPUTE WS-INT = FUNCTION INTEGER(H + B). IF1114.2 +058500 IF WS-INT = -4 THEN IF1114.2 +058600 PERFORM PASS IF1114.2 +058700 ELSE IF1114.2 +058800 MOVE -4 TO CORRECT-N IF1114.2 +058900 MOVE WS-INT TO COMPUTED-N IF1114.2 +059000 PERFORM FAIL. IF1114.2 +059100 GO TO F-INTEGER-WRITE-16. IF1114.2 +059200 F-INTEGER-DELETE-16. IF1114.2 +059300 PERFORM DE-LETE. IF1114.2 +059400 GO TO F-INTEGER-WRITE-16. IF1114.2 +059500 F-INTEGER-WRITE-16. IF1114.2 +059600 MOVE "F-INTEGER-16" TO PAR-NAME. IF1114.2 +059700 PERFORM PRINT-DETAIL. IF1114.2 +059800*****************TEST (q) ****************************** IF1114.2 +059900 F-INTEGER-17. IF1114.2 +060000 MOVE ZERO TO WS-INT. IF1114.2 +060100 F-INTEGER-TEST-17. IF1114.2 +060200 COMPUTE WS-INT = FUNCTION INTEGER(6.3 - 4.2 / 2). IF1114.2 +060300 IF WS-INT = 4 THEN IF1114.2 +060400 PERFORM PASS IF1114.2 +060500 ELSE IF1114.2 +060600 MOVE 4 TO CORRECT-N IF1114.2 +060700 MOVE WS-INT TO COMPUTED-N IF1114.2 +060800 PERFORM FAIL. IF1114.2 +060900 GO TO F-INTEGER-WRITE-17. IF1114.2 +061000 F-INTEGER-DELETE-17. IF1114.2 +061100 PERFORM DE-LETE. IF1114.2 +061200 GO TO F-INTEGER-WRITE-17. IF1114.2 +061300 F-INTEGER-WRITE-17. IF1114.2 +061400 MOVE "F-INTEGER-17" TO PAR-NAME. IF1114.2 +061500 PERFORM PRINT-DETAIL. IF1114.2 +061600*****************TEST (r) ****************************** IF1114.2 +061700 F-INTEGER-18. IF1114.2 +061800 MOVE ZERO TO WS-INT. IF1114.2 +061900 F-INTEGER-TEST-18. IF1114.2 +062000 COMPUTE WS-INT = FUNCTION INTEGER((H + G) * I). IF1114.2 +062100 IF WS-INT = -4 THEN IF1114.2 +062200 PERFORM PASS IF1114.2 +062300 ELSE IF1114.2 +062400 MOVE -4 TO CORRECT-N IF1114.2 +062500 MOVE WS-INT TO COMPUTED-N IF1114.2 +062600 PERFORM FAIL. IF1114.2 +062700 GO TO F-INTEGER-WRITE-18. IF1114.2 +062800 F-INTEGER-DELETE-18. IF1114.2 +062900 PERFORM DE-LETE. IF1114.2 +063000 GO TO F-INTEGER-WRITE-18. IF1114.2 +063100 F-INTEGER-WRITE-18. IF1114.2 +063200 MOVE "F-INTEGER-18" TO PAR-NAME. IF1114.2 +063300 PERFORM PRINT-DETAIL. IF1114.2 +063400*****************TEST (s) ****************************** IF1114.2 +063500 F-INTEGER-19. IF1114.2 +063600 MOVE ZERO TO WS-INT. IF1114.2 +063700 F-INTEGER-TEST-19. IF1114.2 +063800 COMPUTE WS-INT = FUNCTION INTEGER(H / 5). IF1114.2 +063900 IF WS-INT = -1 THEN IF1114.2 +064000 PERFORM PASS IF1114.2 +064100 ELSE IF1114.2 +064200 MOVE -1 TO CORRECT-N IF1114.2 +064300 MOVE WS-INT TO COMPUTED-N IF1114.2 +064400 PERFORM FAIL. IF1114.2 +064500 GO TO F-INTEGER-WRITE-19. IF1114.2 +064600 F-INTEGER-DELETE-19. IF1114.2 +064700 PERFORM DE-LETE. IF1114.2 +064800 GO TO F-INTEGER-WRITE-19. IF1114.2 +064900 F-INTEGER-WRITE-19. IF1114.2 +065000 MOVE "F-INTEGER-19" TO PAR-NAME. IF1114.2 +065100 PERFORM PRINT-DETAIL. IF1114.2 +065200*****************TEST (t) ****************************** IF1114.2 +065300 F-INTEGER-20. IF1114.2 +065400 MOVE ZERO TO TEMP. IF1114.2 +065500 F-INTEGER-TEST-20. IF1114.2 +065600 COMPUTE TEMP = FUNCTION INTEGER(3.2) + I. IF1114.2 +065700 IF (TEMP >= 6.39987) AND IF1114.2 +065800 (TEMP <= 6.40013) IF1114.2 +065900 PERFORM PASS IF1114.2 +066000 ELSE IF1114.2 +066100 MOVE 6.4 TO CORRECT-N IF1114.2 +066200 MOVE TEMP TO COMPUTED-N IF1114.2 +066300 PERFORM FAIL. IF1114.2 +066400 GO TO F-INTEGER-WRITE-20. IF1114.2 +066500 F-INTEGER-DELETE-20. IF1114.2 +066600 PERFORM DE-LETE. IF1114.2 +066700 GO TO F-INTEGER-WRITE-20. IF1114.2 +066800 F-INTEGER-WRITE-20. IF1114.2 +066900 MOVE "F-INTEGER-20" TO PAR-NAME. IF1114.2 +067000 PERFORM PRINT-DETAIL. IF1114.2 +067100*****************TEST (u) ****************************** IF1114.2 +067200 F-INTEGER-21. IF1114.2 +067300 MOVE ZERO TO WS-INT. IF1114.2 +067400 F-INTEGER-TEST-21. IF1114.2 +067500 COMPUTE WS-INT = FUNCTION INTEGER(FUNCTION INTEGER(1.6)). IF1114.2 +067600 IF WS-INT = 1 THEN IF1114.2 +067700 PERFORM PASS IF1114.2 +067800 ELSE IF1114.2 +067900 MOVE 1 TO CORRECT-N IF1114.2 +068000 MOVE WS-INT TO COMPUTED-N IF1114.2 +068100 PERFORM FAIL. IF1114.2 +068200 GO TO F-INTEGER-WRITE-21. IF1114.2 +068300 F-INTEGER-DELETE-21. IF1114.2 +068400 PERFORM DE-LETE. IF1114.2 +068500 GO TO F-INTEGER-WRITE-21. IF1114.2 +068600 F-INTEGER-WRITE-21. IF1114.2 +068700 MOVE "F-INTEGER-21" TO PAR-NAME. IF1114.2 +068800 PERFORM PRINT-DETAIL. IF1114.2 +068900*****************TEST (v) ****************************** IF1114.2 +069000 F-INTEGER-22. IF1114.2 +069100 MOVE ZERO TO WS-INT. IF1114.2 +069200 F-INTEGER-TEST-22. IF1114.2 +069300 COMPUTE WS-INT = FUNCTION INTEGER(1.2) + IF1114.2 +069400 FUNCTION INTEGER(1.6). IF1114.2 +069500 IF WS-INT = 2 THEN IF1114.2 +069600 PERFORM PASS IF1114.2 +069700 ELSE IF1114.2 +069800 MOVE 2 TO CORRECT-N IF1114.2 +069900 MOVE WS-INT TO COMPUTED-N IF1114.2 +070000 PERFORM FAIL. IF1114.2 +070100 GO TO F-INTEGER-WRITE-22. IF1114.2 +070200 F-INTEGER-DELETE-22. IF1114.2 +070300 PERFORM DE-LETE. IF1114.2 +070400 GO TO F-INTEGER-WRITE-22. IF1114.2 +070500 F-INTEGER-WRITE-22. IF1114.2 +070600 MOVE "F-INTEGER-22" TO PAR-NAME. IF1114.2 +070700 PERFORM PRINT-DETAIL. IF1114.2 +070800***************** SPECIAL TEST 1 *********************** IF1114.2 +070900 F-DATEOFINT-23. IF1114.2 +071000*** ARG1:=4.4 *** IF1114.2 +071100 PERFORM F-DATEOFINT-TEST-23 IF1114.2 +071200 UNTIL FUNCTION INTEGER(ARG1) < 0. IF1114.2 +071300 IF ARG1 < 0 THEN IF1114.2 +071400 PERFORM PASS IF1114.2 +071500 ELSE IF1114.2 +071600 PERFORM FAIL. IF1114.2 +071700 GO TO F-DATEOFINT-WRITE-23. IF1114.2 +071800* IF1114.2 +071900 F-DATEOFINT-TEST-23. IF1114.2 +072000 COMPUTE ARG1 = ARG1 - 1. IF1114.2 +072100* IF1114.2 +072200 F-DATEOFINT-DELETE-23. IF1114.2 +072300 PERFORM DE-LETE. IF1114.2 +072400 GO TO F-DATEOFINT-WRITE-23. IF1114.2 +072500 F-DATEOFINT-WRITE-23. IF1114.2 +072600 MOVE "F-DATEOFINT-23" TO PAR-NAME. IF1114.2 +072700 PERFORM PRINT-DETAIL. IF1114.2 +072800*******************END OF TESTS************************** IF1114.2 +072900 CCVS-EXIT SECTION. IF1114.2 +073000 CCVS-999999. IF1114.2 +073100 GO TO CLOSE-FILES. IF1114.2 +*END-OF,IF111A +*HEADER,COBOL,IF112A +000100 IDENTIFICATION DIVISION. IF1124.2 +000200 PROGRAM-ID. IF1124.2 +000300 IF112A. IF1124.2 +000400 IF1124.2 +000500*********************************************************** IF1124.2 +000600* * IF1124.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1124.2 +000800* It contains tests for the Intrinsic Function * IF1124.2 +000900* INTEGER-OF-DATE. * IF1124.2 +001000* * IF1124.2 +001100*********************************************************** IF1124.2 +001200 ENVIRONMENT DIVISION. IF1124.2 +001300 CONFIGURATION SECTION. IF1124.2 +001400 SOURCE-COMPUTER. IF1124.2 +001500 XXXXX082. IF1124.2 +001600 OBJECT-COMPUTER. IF1124.2 +001700 XXXXX083. IF1124.2 +001800 INPUT-OUTPUT SECTION. IF1124.2 +001900 FILE-CONTROL. IF1124.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1124.2 +002100 XXXXX055. IF1124.2 +002200 DATA DIVISION. IF1124.2 +002300 FILE SECTION. IF1124.2 +002400 FD PRINT-FILE. IF1124.2 +002500 01 PRINT-REC PICTURE X(120). IF1124.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1124.2 +002700 WORKING-STORAGE SECTION. IF1124.2 +002800*********************************************************** IF1124.2 +002900* Variables specific to the Intrinsic Function Test IF112A* IF1124.2 +003000*********************************************************** IF1124.2 +003100 01 A PIC S9(10) VALUE 16020204. IF1124.2 +003200 01 D PIC S9(10) VALUE 2. IF1124.2 +003300 01 ARG1 PIC S9(10) VALUE 16010101. IF1124.2 +003400 01 ARR VALUE "1601010116020210". IF1124.2 +003500 02 IND OCCURS 2 TIMES PIC 9(8). IF1124.2 +003600 01 TEMP PIC S9(10). IF1124.2 +003700 01 WS-INT PIC 9(8). IF1124.2 +003800* IF1124.2 +003900********************************************************** IF1124.2 +004000* IF1124.2 +004100 01 TEST-RESULTS. IF1124.2 +004200 02 FILLER PIC X VALUE SPACE. IF1124.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1124.2 +004400 02 FILLER PIC X VALUE SPACE. IF1124.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1124.2 +004600 02 FILLER PIC X VALUE SPACE. IF1124.2 +004700 02 PAR-NAME. IF1124.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1124.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1124.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1124.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1124.2 +005200 02 RE-MARK PIC X(61). IF1124.2 +005300 01 TEST-COMPUTED. IF1124.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1124.2 +005500 02 FILLER PIC X(17) VALUE IF1124.2 +005600 " COMPUTED=". IF1124.2 +005700 02 COMPUTED-X. IF1124.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1124.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1124.2 +006000 PIC -9(9).9(9). IF1124.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1124.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1124.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1124.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1124.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1124.2 +006600 04 FILLER PIC X. IF1124.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1124.2 +006800 01 TEST-CORRECT. IF1124.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1124.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1124.2 +007100 02 CORRECT-X. IF1124.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1124.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1124.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1124.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1124.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1124.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1124.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1124.2 +007900 04 FILLER PIC X. IF1124.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1124.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1124.2 +008200 01 CCVS-C-1. IF1124.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1124.2 +008400- "SS PARAGRAPH-NAME IF1124.2 +008500- " REMARKS". IF1124.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1124.2 +008700 01 CCVS-C-2. IF1124.2 +008800 02 FILLER PIC X VALUE SPACE. IF1124.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1124.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1124.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1124.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1124.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1124.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1124.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1124.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1124.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1124.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1124.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1124.2 +010400 01 CCVS-H-1. IF1124.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1124.2 +010600 02 FILLER PIC X(42) VALUE IF1124.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1124.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1124.2 +010900 01 CCVS-H-2A. IF1124.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1124.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1124.2 +011200 02 FILLER PIC XXXX VALUE IF1124.2 +011300 "4.2 ". IF1124.2 +011400 02 FILLER PIC X(28) VALUE IF1124.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1124.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1124.2 +011700 IF1124.2 +011800 01 CCVS-H-2B. IF1124.2 +011900 02 FILLER PIC X(15) VALUE IF1124.2 +012000 "TEST RESULT OF ". IF1124.2 +012100 02 TEST-ID PIC X(9). IF1124.2 +012200 02 FILLER PIC X(4) VALUE IF1124.2 +012300 " IN ". IF1124.2 +012400 02 FILLER PIC X(12) VALUE IF1124.2 +012500 " HIGH ". IF1124.2 +012600 02 FILLER PIC X(22) VALUE IF1124.2 +012700 " LEVEL VALIDATION FOR ". IF1124.2 +012800 02 FILLER PIC X(58) VALUE IF1124.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1124.2 +013000 01 CCVS-H-3. IF1124.2 +013100 02 FILLER PIC X(34) VALUE IF1124.2 +013200 " FOR OFFICIAL USE ONLY ". IF1124.2 +013300 02 FILLER PIC X(58) VALUE IF1124.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1124.2 +013500 02 FILLER PIC X(28) VALUE IF1124.2 +013600 " COPYRIGHT 1985 ". IF1124.2 +013700 01 CCVS-E-1. IF1124.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1124.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1124.2 +014000 02 ID-AGAIN PIC X(9). IF1124.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1124.2 +014200 01 CCVS-E-2. IF1124.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1124.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1124.2 +014500 02 CCVS-E-2-2. IF1124.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1124.2 +014700 03 FILLER PIC X VALUE SPACE. IF1124.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1124.2 +014900 "ERRORS ENCOUNTERED". IF1124.2 +015000 01 CCVS-E-3. IF1124.2 +015100 02 FILLER PIC X(22) VALUE IF1124.2 +015200 " FOR OFFICIAL USE ONLY". IF1124.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1124.2 +015400 02 FILLER PIC X(58) VALUE IF1124.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1124.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1124.2 +015700 02 FILLER PIC X(15) VALUE IF1124.2 +015800 " COPYRIGHT 1985". IF1124.2 +015900 01 CCVS-E-4. IF1124.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1124.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1124.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1124.2 +016300 02 FILLER PIC X(40) VALUE IF1124.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1124.2 +016500 01 XXINFO. IF1124.2 +016600 02 FILLER PIC X(19) VALUE IF1124.2 +016700 "*** INFORMATION ***". IF1124.2 +016800 02 INFO-TEXT. IF1124.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1124.2 +017000 04 XXCOMPUTED PIC X(20). IF1124.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1124.2 +017200 04 XXCORRECT PIC X(20). IF1124.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1124.2 +017400 01 HYPHEN-LINE. IF1124.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1124.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1124.2 +017700- "*****************************************". IF1124.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1124.2 +017900- "******************************". IF1124.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1124.2 +018100 "IF112A". IF1124.2 +018200 PROCEDURE DIVISION. IF1124.2 +018300 CCVS1 SECTION. IF1124.2 +018400 OPEN-FILES. IF1124.2 +018500 OPEN OUTPUT PRINT-FILE. IF1124.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1124.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1124.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1124.2 +018900 GO TO CCVS1-EXIT. IF1124.2 +019000 CLOSE-FILES. IF1124.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1124.2 +019200 TERMINATE-CCVS. IF1124.2 +019300 STOP RUN. IF1124.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1124.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1124.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1124.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1124.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1124.2 +019900 PRINT-DETAIL. IF1124.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1124.2 +020100 MOVE "." TO PARDOT-X IF1124.2 +020200 MOVE REC-CT TO DOTVALUE. IF1124.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1124.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1124.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1124.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1124.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1124.2 +020800 MOVE SPACE TO CORRECT-X. IF1124.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1124.2 +021000 MOVE SPACE TO RE-MARK. IF1124.2 +021100 HEAD-ROUTINE. IF1124.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1124.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1124.2 +021600 COLUMN-NAMES-ROUTINE. IF1124.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +022000 END-ROUTINE. IF1124.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1124.2 +022200 END-RTN-EXIT. IF1124.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +022400 END-ROUTINE-1. IF1124.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1124.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1124.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1124.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1124.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1124.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1124.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1124.2 +023200 END-ROUTINE-12. IF1124.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1124.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1124.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1124.2 +023600 ELSE IF1124.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1124.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1124.2 +023900 PERFORM WRITE-LINE. IF1124.2 +024000 END-ROUTINE-13. IF1124.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1124.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1124.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1124.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1124.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1124.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1124.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1124.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1124.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +025200 WRITE-LINE. IF1124.2 +025300 ADD 1 TO RECORD-COUNT. IF1124.2 +025400Y IF RECORD-COUNT GREATER 42 IF1124.2 +025500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1124.2 +025600Y MOVE SPACE TO DUMMY-RECORD IF1124.2 +025700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1124.2 +025800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1124.2 +025900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1124.2 +026000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1124.2 +026100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1124.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1124.2 +026600Y MOVE ZERO TO RECORD-COUNT. IF1124.2 +026700 PERFORM WRT-LN. IF1124.2 +026800 WRT-LN. IF1124.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1124.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1124.2 +027100 BLANK-LINE-PRINT. IF1124.2 +027200 PERFORM WRT-LN. IF1124.2 +027300 FAIL-ROUTINE. IF1124.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1124.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1124.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1124.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1124.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1124.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1124.2 +028100 GO TO FAIL-ROUTINE-EX. IF1124.2 +028200 FAIL-ROUTINE-WRITE. IF1124.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1124.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1124.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1124.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1124.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1124.2 +028800 BAIL-OUT. IF1124.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1124.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1124.2 +029100 BAIL-OUT-WRITE. IF1124.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1124.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1124.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1124.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1124.2 +029700 BAIL-OUT-EX. EXIT. IF1124.2 +029800 CCVS1-EXIT. IF1124.2 +029900 EXIT. IF1124.2 +030000******************************************************** IF1124.2 +030100* * IF1124.2 +030200* Intrinsic Function Test IF112A - INTEGER-OF-DATE * IF1124.2 +030300* * IF1124.2 +030400******************************************************** IF1124.2 +030500 SECT-IF112A SECTION. IF1124.2 +030600 F-DATEOFINT-INFO. IF1124.2 +030700 MOVE "See ref. A-45 2.16" TO ANSI-REFERENCE. IF1124.2 +030800 MOVE "INTEGER-OF-DATE" TO FEATURE. IF1124.2 +030900*****************TEST (a) ****************************** IF1124.2 +031000 F-DATEOFINT-01. IF1124.2 +031100 MOVE ZERO TO WS-INT. IF1124.2 +031200 F-DATEOFINT-TEST-01. IF1124.2 +031300 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(16010101). IF1124.2 +031400 IF WS-INT = 1 THEN IF1124.2 +031500 PERFORM PASS IF1124.2 +031600 ELSE IF1124.2 +031700 MOVE 1 TO CORRECT-N IF1124.2 +031800 MOVE WS-INT TO COMPUTED-N IF1124.2 +031900 PERFORM FAIL. IF1124.2 +032000 GO TO F-DATEOFINT-WRITE-01. IF1124.2 +032100 F-DATEOFINT-DELETE-01. IF1124.2 +032200 PERFORM DE-LETE. IF1124.2 +032300 GO TO F-DATEOFINT-WRITE-01. IF1124.2 +032400 F-DATEOFINT-WRITE-01. IF1124.2 +032500 MOVE "F-DATEOFINT-01" TO PAR-NAME. IF1124.2 +032600 PERFORM PRINT-DETAIL. IF1124.2 +032700*****************TEST (b) ****************************** IF1124.2 +032800 F-DATEOFINT-TEST-02. IF1124.2 +032900 EVALUATE FUNCTION INTEGER-OF-DATE(A) IF1124.2 +033000 WHEN 400 IF1124.2 +033100 PERFORM PASS IF1124.2 +033200 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033300 PERFORM FAIL. IF1124.2 +033400 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033500 F-DATEOFINT-DELETE-02. IF1124.2 +033600 PERFORM DE-LETE. IF1124.2 +033700 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033800 F-DATEOFINT-WRITE-02. IF1124.2 +033900 MOVE "F-DATEOFINT-02" TO PAR-NAME. IF1124.2 +034000 PERFORM PRINT-DETAIL. IF1124.2 +034100*****************TEST (c) ****************************** IF1124.2 +034200 F-DATEOFINT-TEST-03. IF1124.2 +034300 IF FUNCTION INTEGER-OF-DATE(IND(1)) = 1 THEN IF1124.2 +034400 PERFORM PASS IF1124.2 +034500 ELSE IF1124.2 +034600 PERFORM FAIL. IF1124.2 +034700 GO TO F-DATEOFINT-WRITE-03. IF1124.2 +034800 F-DATEOFINT-DELETE-03. IF1124.2 +034900 PERFORM DE-LETE. IF1124.2 +035000 GO TO F-DATEOFINT-WRITE-03. IF1124.2 +035100 F-DATEOFINT-WRITE-03. IF1124.2 +035200 MOVE "F-DATEOFINT-03" TO PAR-NAME. IF1124.2 +035300 PERFORM PRINT-DETAIL. IF1124.2 +035400*****************TEST (d) ****************************** IF1124.2 +035500 F-DATEOFINT-04. IF1124.2 +035600 MOVE ZERO TO WS-INT. IF1124.2 +035700 F-DATEOFINT-TEST-04. IF1124.2 +035800 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(IND(D)). IF1124.2 +035900 IF WS-INT = 406 THEN IF1124.2 +036000 PERFORM PASS IF1124.2 +036100 ELSE IF1124.2 +036200 MOVE 406 TO CORRECT-N IF1124.2 +036300 MOVE WS-INT TO COMPUTED-N IF1124.2 +036400 PERFORM FAIL. IF1124.2 +036500 GO TO F-DATEOFINT-WRITE-04. IF1124.2 +036600 F-DATEOFINT-DELETE-04. IF1124.2 +036700 PERFORM DE-LETE. IF1124.2 +036800 GO TO F-DATEOFINT-WRITE-04. IF1124.2 +036900 F-DATEOFINT-WRITE-04. IF1124.2 +037000 MOVE "F-DATEOFINT-04" TO PAR-NAME. IF1124.2 +037100 PERFORM PRINT-DETAIL. IF1124.2 +037200*****************TEST (e) ****************************** IF1124.2 +037300 F-DATEOFINT-05. IF1124.2 +037400 MOVE ZERO TO WS-INT. IF1124.2 +037500 F-DATEOFINT-TEST-05. IF1124.2 +037600 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(16011231). IF1124.2 +037700 IF WS-INT = 365 THEN IF1124.2 +037800 PERFORM PASS IF1124.2 +037900 ELSE IF1124.2 +038000 MOVE 365 TO CORRECT-N IF1124.2 +038100 MOVE WS-INT TO COMPUTED-N IF1124.2 +038200 PERFORM FAIL. IF1124.2 +038300 GO TO F-DATEOFINT-WRITE-05. IF1124.2 +038400 F-DATEOFINT-DELETE-05. IF1124.2 +038500 PERFORM DE-LETE. IF1124.2 +038600 GO TO F-DATEOFINT-WRITE-05. IF1124.2 +038700 F-DATEOFINT-WRITE-05. IF1124.2 +038800 MOVE "F-DATEOFINT-05" TO PAR-NAME. IF1124.2 +038900 PERFORM PRINT-DETAIL. IF1124.2 +039000*****************TEST (f) ****************************** IF1124.2 +039100 F-DATEOFINT-06. IF1124.2 +039200 MOVE ZERO TO WS-INT. IF1124.2 +039300 F-DATEOFINT-TEST-06. IF1124.2 +039400 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(A) + 10. IF1124.2 +039500 IF WS-INT = 410 THEN IF1124.2 +039600 PERFORM PASS IF1124.2 +039700 ELSE IF1124.2 +039800 MOVE 410 TO CORRECT-N IF1124.2 +039900 MOVE WS-INT TO COMPUTED-N IF1124.2 +040000 PERFORM FAIL. IF1124.2 +040100 GO TO F-DATEOFINT-WRITE-06. IF1124.2 +040200 F-DATEOFINT-DELETE-06. IF1124.2 +040300 PERFORM DE-LETE. IF1124.2 +040400 GO TO F-DATEOFINT-WRITE-06. IF1124.2 +040500 F-DATEOFINT-WRITE-06. IF1124.2 +040600 MOVE "F-DATEOFINT-06" TO PAR-NAME. IF1124.2 +040700 PERFORM PRINT-DETAIL. IF1124.2 +040800*****************TEST (g) ****************************** IF1124.2 +040900 F-DATEOFINT-07. IF1124.2 +041000 MOVE ZERO TO WS-INT. IF1124.2 +041100 F-DATEOFINT-TEST-07. IF1124.2 +041200 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(A) + IF1124.2 +041300 FUNCTION INTEGER-OF-DATE(A). IF1124.2 +041400 IF WS-INT = 800 THEN IF1124.2 +041500 PERFORM PASS IF1124.2 +041600 ELSE IF1124.2 +041700 MOVE 800 TO CORRECT-N IF1124.2 +041800 MOVE WS-INT TO COMPUTED-N IF1124.2 +041900 PERFORM FAIL. IF1124.2 +042000 GO TO F-DATEOFINT-WRITE-07. IF1124.2 +042100 F-DATEOFINT-DELETE-07. IF1124.2 +042200 PERFORM DE-LETE. IF1124.2 +042300 GO TO F-DATEOFINT-WRITE-07. IF1124.2 +042400 F-DATEOFINT-WRITE-07. IF1124.2 +042500 MOVE "F-DATEOFINT-07" TO PAR-NAME. IF1124.2 +042600 PERFORM PRINT-DETAIL. IF1124.2 +042700 IF1124.2 +042800***************** SPECIAL TEST 1 *********************** IF1124.2 +042900 IF1124.2 +043000 F-DATEOFINT-10. IF1124.2 +043100 MOVE 16010101 TO ARG1. IF1124.2 +043200 PERFORM F-DATEOFINT-TEST-10 IF1124.2 +043300 UNTIL FUNCTION INTEGER-OF-DATE(ARG1) > 10. IF1124.2 +043400 IF ARG1 = 16010111 THEN IF1124.2 +043500 PERFORM PASS IF1124.2 +043600 ELSE IF1124.2 +043700 PERFORM FAIL. IF1124.2 +043800 GO TO F-DATEOFINT-WRITE-10. IF1124.2 +043900* IF1124.2 +044000 F-DATEOFINT-TEST-10. IF1124.2 +044100 COMPUTE ARG1 = ARG1 + 1. IF1124.2 +044200* IF1124.2 +044300 F-DATEOFINT-DELETE-10. IF1124.2 +044400 PERFORM DE-LETE. IF1124.2 +044500 GO TO F-DATEOFINT-WRITE-10. IF1124.2 +044600 F-DATEOFINT-WRITE-10. IF1124.2 +044700 MOVE "F-DATEOFINT-10" TO PAR-NAME. IF1124.2 +044800 PERFORM PRINT-DETAIL. IF1124.2 +044900*******************END OF TESTS************************** IF1124.2 +045000 CCVS-EXIT SECTION. IF1124.2 +045100 CCVS-999999. IF1124.2 +045200 GO TO CLOSE-FILES. IF1124.2 +*END-OF,IF112A +*HEADER,COBOL,IF113A +000100 IDENTIFICATION DIVISION. IF1134.2 +000200 PROGRAM-ID. IF1134.2 +000300 IF113A. IF1134.2 +000400 IF1134.2 +000500*********************************************************** IF1134.2 +000600* * IF1134.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1134.2 +000800* It contains tests for the Intrinsic Function * IF1134.2 +000900* INTEGER-OF-DAY. * IF1134.2 +001000* * IF1134.2 +001100*********************************************************** IF1134.2 +001200 ENVIRONMENT DIVISION. IF1134.2 +001300 CONFIGURATION SECTION. IF1134.2 +001400 SOURCE-COMPUTER. IF1134.2 +001500 XXXXX082. IF1134.2 +001600 OBJECT-COMPUTER. IF1134.2 +001700 XXXXX083. IF1134.2 +001800 INPUT-OUTPUT SECTION. IF1134.2 +001900 FILE-CONTROL. IF1134.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1134.2 +002100 XXXXX055. IF1134.2 +002200 DATA DIVISION. IF1134.2 +002300 FILE SECTION. IF1134.2 +002400 FD PRINT-FILE. IF1134.2 +002500 01 PRINT-REC PICTURE X(120). IF1134.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1134.2 +002700 WORKING-STORAGE SECTION. IF1134.2 +002800*********************************************************** IF1134.2 +002900* Variables specific to the Intrinsic Function Test IF113A* IF1134.2 +003000*********************************************************** IF1134.2 +003100 01 A PIC S9(10) VALUE 1602035. IF1134.2 +003200 01 C PIC S9(10) VALUE 2. IF1134.2 +003300 01 D PIC S9(10) VALUE 2. IF1134.2 +003400 01 ARG1 PIC S9(10) VALUE 1601001. IF1134.2 +003500 01 ARR VALUE "16010011602035". IF1134.2 +003600 02 IND OCCURS 2 TIMES PIC 9(7). IF1134.2 +003700 01 TEMP PIC S9(10). IF1134.2 +003800 01 WS-INT PIC 9(10). IF1134.2 +003900* IF1134.2 +004000********************************************************** IF1134.2 +004100* IF1134.2 +004200 01 TEST-RESULTS. IF1134.2 +004300 02 FILLER PIC X VALUE SPACE. IF1134.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1134.2 +004500 02 FILLER PIC X VALUE SPACE. IF1134.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1134.2 +004700 02 FILLER PIC X VALUE SPACE. IF1134.2 +004800 02 PAR-NAME. IF1134.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1134.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1134.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1134.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1134.2 +005300 02 RE-MARK PIC X(61). IF1134.2 +005400 01 TEST-COMPUTED. IF1134.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1134.2 +005600 02 FILLER PIC X(17) VALUE IF1134.2 +005700 " COMPUTED=". IF1134.2 +005800 02 COMPUTED-X. IF1134.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1134.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1134.2 +006100 PIC -9(9).9(9). IF1134.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1134.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1134.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1134.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1134.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1134.2 +006700 04 FILLER PIC X. IF1134.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1134.2 +006900 01 TEST-CORRECT. IF1134.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1134.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1134.2 +007200 02 CORRECT-X. IF1134.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1134.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1134.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1134.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1134.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1134.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1134.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1134.2 +008000 04 FILLER PIC X. IF1134.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1134.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1134.2 +008300 01 CCVS-C-1. IF1134.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1134.2 +008500- "SS PARAGRAPH-NAME IF1134.2 +008600- " REMARKS". IF1134.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1134.2 +008800 01 CCVS-C-2. IF1134.2 +008900 02 FILLER PIC X VALUE SPACE. IF1134.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1134.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1134.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1134.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1134.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1134.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1134.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1134.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1134.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1134.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1134.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1134.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1134.2 +010500 01 CCVS-H-1. IF1134.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1134.2 +010700 02 FILLER PIC X(42) VALUE IF1134.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1134.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1134.2 +011000 01 CCVS-H-2A. IF1134.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1134.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1134.2 +011300 02 FILLER PIC XXXX VALUE IF1134.2 +011400 "4.2 ". IF1134.2 +011500 02 FILLER PIC X(28) VALUE IF1134.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1134.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1134.2 +011800 IF1134.2 +011900 01 CCVS-H-2B. IF1134.2 +012000 02 FILLER PIC X(15) VALUE IF1134.2 +012100 "TEST RESULT OF ". IF1134.2 +012200 02 TEST-ID PIC X(9). IF1134.2 +012300 02 FILLER PIC X(4) VALUE IF1134.2 +012400 " IN ". IF1134.2 +012500 02 FILLER PIC X(12) VALUE IF1134.2 +012600 " HIGH ". IF1134.2 +012700 02 FILLER PIC X(22) VALUE IF1134.2 +012800 " LEVEL VALIDATION FOR ". IF1134.2 +012900 02 FILLER PIC X(58) VALUE IF1134.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1134.2 +013100 01 CCVS-H-3. IF1134.2 +013200 02 FILLER PIC X(34) VALUE IF1134.2 +013300 " FOR OFFICIAL USE ONLY ". IF1134.2 +013400 02 FILLER PIC X(58) VALUE IF1134.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1134.2 +013600 02 FILLER PIC X(28) VALUE IF1134.2 +013700 " COPYRIGHT 1985 ". IF1134.2 +013800 01 CCVS-E-1. IF1134.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1134.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1134.2 +014100 02 ID-AGAIN PIC X(9). IF1134.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1134.2 +014300 01 CCVS-E-2. IF1134.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1134.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1134.2 +014600 02 CCVS-E-2-2. IF1134.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1134.2 +014800 03 FILLER PIC X VALUE SPACE. IF1134.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1134.2 +015000 "ERRORS ENCOUNTERED". IF1134.2 +015100 01 CCVS-E-3. IF1134.2 +015200 02 FILLER PIC X(22) VALUE IF1134.2 +015300 " FOR OFFICIAL USE ONLY". IF1134.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1134.2 +015500 02 FILLER PIC X(58) VALUE IF1134.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1134.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1134.2 +015800 02 FILLER PIC X(15) VALUE IF1134.2 +015900 " COPYRIGHT 1985". IF1134.2 +016000 01 CCVS-E-4. IF1134.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1134.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1134.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1134.2 +016400 02 FILLER PIC X(40) VALUE IF1134.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1134.2 +016600 01 XXINFO. IF1134.2 +016700 02 FILLER PIC X(19) VALUE IF1134.2 +016800 "*** INFORMATION ***". IF1134.2 +016900 02 INFO-TEXT. IF1134.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1134.2 +017100 04 XXCOMPUTED PIC X(20). IF1134.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1134.2 +017300 04 XXCORRECT PIC X(20). IF1134.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1134.2 +017500 01 HYPHEN-LINE. IF1134.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1134.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1134.2 +017800- "*****************************************". IF1134.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1134.2 +018000- "******************************". IF1134.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1134.2 +018200 "IF113A". IF1134.2 +018300 PROCEDURE DIVISION. IF1134.2 +018400 CCVS1 SECTION. IF1134.2 +018500 OPEN-FILES. IF1134.2 +018600 OPEN OUTPUT PRINT-FILE. IF1134.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1134.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1134.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1134.2 +019000 GO TO CCVS1-EXIT. IF1134.2 +019100 CLOSE-FILES. IF1134.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1134.2 +019300 TERMINATE-CCVS. IF1134.2 +019400 STOP RUN. IF1134.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1134.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1134.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1134.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1134.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1134.2 +020000 PRINT-DETAIL. IF1134.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1134.2 +020200 MOVE "." TO PARDOT-X IF1134.2 +020300 MOVE REC-CT TO DOTVALUE. IF1134.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1134.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1134.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1134.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1134.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1134.2 +020900 MOVE SPACE TO CORRECT-X. IF1134.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1134.2 +021100 MOVE SPACE TO RE-MARK. IF1134.2 +021200 HEAD-ROUTINE. IF1134.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1134.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1134.2 +021700 COLUMN-NAMES-ROUTINE. IF1134.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +022100 END-ROUTINE. IF1134.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1134.2 +022300 END-RTN-EXIT. IF1134.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +022500 END-ROUTINE-1. IF1134.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1134.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1134.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1134.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1134.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1134.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1134.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1134.2 +023300 END-ROUTINE-12. IF1134.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1134.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1134.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1134.2 +023700 ELSE IF1134.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1134.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1134.2 +024000 PERFORM WRITE-LINE. IF1134.2 +024100 END-ROUTINE-13. IF1134.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1134.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1134.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1134.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1134.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1134.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1134.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1134.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1134.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +025300 WRITE-LINE. IF1134.2 +025400 ADD 1 TO RECORD-COUNT. IF1134.2 +025500Y IF RECORD-COUNT GREATER 42 IF1134.2 +025600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1134.2 +025700Y MOVE SPACE TO DUMMY-RECORD IF1134.2 +025800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1134.2 +025900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1134.2 +026000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1134.2 +026100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1134.2 +026200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1134.2 +026300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1134.2 +026700Y MOVE ZERO TO RECORD-COUNT. IF1134.2 +026800 PERFORM WRT-LN. IF1134.2 +026900 WRT-LN. IF1134.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1134.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1134.2 +027200 BLANK-LINE-PRINT. IF1134.2 +027300 PERFORM WRT-LN. IF1134.2 +027400 FAIL-ROUTINE. IF1134.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1134.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1134.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1134.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1134.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1134.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1134.2 +028200 GO TO FAIL-ROUTINE-EX. IF1134.2 +028300 FAIL-ROUTINE-WRITE. IF1134.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1134.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1134.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1134.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1134.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1134.2 +028900 BAIL-OUT. IF1134.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1134.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1134.2 +029200 BAIL-OUT-WRITE. IF1134.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1134.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1134.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1134.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1134.2 +029800 BAIL-OUT-EX. EXIT. IF1134.2 +029900 CCVS1-EXIT. IF1134.2 +030000 EXIT. IF1134.2 +030100******************************************************** IF1134.2 +030200* * IF1134.2 +030300* Intrinsic Function Test IF113A - INTEGER-OF-DAY * IF1134.2 +030400* * IF1134.2 +030500******************************************************** IF1134.2 +030600 SECT-IF113A SECTION. IF1134.2 +030700 F-INTOFDAY-INFO. IF1134.2 +030800 MOVE "See ref. A-46 2.17" TO ANSI-REFERENCE. IF1134.2 +030900 MOVE "INTEGER-OF-DAY" TO FEATURE. IF1134.2 +031000*****************TEST (a) ****************************** IF1134.2 +031100 F-INTOFDAY-01. IF1134.2 +031200 MOVE ZERO TO WS-INT. IF1134.2 +031300 F-INTOFDAY-TEST-01. IF1134.2 +031400 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(1601001). IF1134.2 +031500 IF WS-INT = 1 THEN IF1134.2 +031600 PERFORM PASS IF1134.2 +031700 ELSE IF1134.2 +031800 MOVE 1 TO CORRECT-N IF1134.2 +031900 MOVE WS-INT TO COMPUTED-N IF1134.2 +032000 PERFORM FAIL. IF1134.2 +032100 GO TO F-INTOFDAY-WRITE-01. IF1134.2 +032200 F-INTOFDAY-DELETE-01. IF1134.2 +032300 PERFORM DE-LETE. IF1134.2 +032400 GO TO F-INTOFDAY-WRITE-01. IF1134.2 +032500 F-INTOFDAY-WRITE-01. IF1134.2 +032600 MOVE "F-INTOFDAY-01" TO PAR-NAME. IF1134.2 +032700 PERFORM PRINT-DETAIL. IF1134.2 +032800*****************TEST (b) ****************************** IF1134.2 +032900 F-INTOFDAY-TEST-02. IF1134.2 +033000 EVALUATE FUNCTION INTEGER-OF-DAY(A) IF1134.2 +033100 WHEN 400 IF1134.2 +033200 PERFORM PASS IF1134.2 +033300 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033400 PERFORM FAIL. IF1134.2 +033500 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033600 F-INTOFDAY-DELETE-02. IF1134.2 +033700 PERFORM DE-LETE. IF1134.2 +033800 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033900 F-INTOFDAY-WRITE-02. IF1134.2 +034000 MOVE "F-INTOFDAY-02" TO PAR-NAME. IF1134.2 +034100 PERFORM PRINT-DETAIL. IF1134.2 +034200*****************TEST (c) ****************************** IF1134.2 +034300 F-INTOFDAY-TEST-03. IF1134.2 +034400 IF FUNCTION INTEGER-OF-DAY(IND(1)) = 1 THEN IF1134.2 +034500 PERFORM PASS IF1134.2 +034600 ELSE IF1134.2 +034700 PERFORM FAIL. IF1134.2 +034800 GO TO F-INTOFDAY-WRITE-03. IF1134.2 +034900 F-INTOFDAY-DELETE-03. IF1134.2 +035000 PERFORM DE-LETE. IF1134.2 +035100 GO TO F-INTOFDAY-WRITE-03. IF1134.2 +035200 F-INTOFDAY-WRITE-03. IF1134.2 +035300 MOVE "F-INTOFDAY-03" TO PAR-NAME. IF1134.2 +035400 PERFORM PRINT-DETAIL. IF1134.2 +035500*****************TEST (d) ****************************** IF1134.2 +035600 F-INTOFDAY-04. IF1134.2 +035700 MOVE ZERO TO WS-INT. IF1134.2 +035800 F-INTOFDAY-TEST-04. IF1134.2 +035900 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(IND(D)). IF1134.2 +036000 IF WS-INT = 400 THEN IF1134.2 +036100 PERFORM PASS IF1134.2 +036200 ELSE IF1134.2 +036300 MOVE 400 TO CORRECT-N IF1134.2 +036400 MOVE WS-INT TO COMPUTED-N IF1134.2 +036500 PERFORM FAIL. IF1134.2 +036600 GO TO F-INTOFDAY-WRITE-04. IF1134.2 +036700 F-INTOFDAY-DELETE-04. IF1134.2 +036800 PERFORM DE-LETE. IF1134.2 +036900 GO TO F-INTOFDAY-WRITE-04. IF1134.2 +037000 F-INTOFDAY-WRITE-04. IF1134.2 +037100 MOVE "F-INTOFDAY-04" TO PAR-NAME. IF1134.2 +037200 PERFORM PRINT-DETAIL. IF1134.2 +037300*****************TEST (e) ****************************** IF1134.2 +037400 F-INTOFDAY-05. IF1134.2 +037500 MOVE ZERO TO WS-INT. IF1134.2 +037600 F-INTOFDAY-TEST-05. IF1134.2 +037700 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(1601365). IF1134.2 +037800 IF WS-INT = 365 THEN IF1134.2 +037900 PERFORM PASS IF1134.2 +038000 ELSE IF1134.2 +038100 MOVE 365 TO CORRECT-N IF1134.2 +038200 MOVE WS-INT TO COMPUTED-N IF1134.2 +038300 PERFORM FAIL. IF1134.2 +038400 GO TO F-INTOFDAY-WRITE-05. IF1134.2 +038500 F-INTOFDAY-DELETE-05. IF1134.2 +038600 PERFORM DE-LETE. IF1134.2 +038700 GO TO F-INTOFDAY-WRITE-05. IF1134.2 +038800 F-INTOFDAY-WRITE-05. IF1134.2 +038900 MOVE "F-INTOFDAY-05" TO PAR-NAME. IF1134.2 +039000 PERFORM PRINT-DETAIL. IF1134.2 +039100*****************TEST (f) ****************************** IF1134.2 +039200 F-INTOFDAY-06. IF1134.2 +039300 MOVE ZERO TO WS-INT. IF1134.2 +039400 F-INTOFDAY-TEST-06. IF1134.2 +039500 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(A) + 10. IF1134.2 +039600 IF WS-INT = 410 THEN IF1134.2 +039700 PERFORM PASS IF1134.2 +039800 ELSE IF1134.2 +039900 MOVE 410 TO CORRECT-N IF1134.2 +040000 MOVE WS-INT TO COMPUTED-N IF1134.2 +040100 PERFORM FAIL. IF1134.2 +040200 GO TO F-INTOFDAY-WRITE-06. IF1134.2 +040300 F-INTOFDAY-DELETE-06. IF1134.2 +040400 PERFORM DE-LETE. IF1134.2 +040500 GO TO F-INTOFDAY-WRITE-06. IF1134.2 +040600 F-INTOFDAY-WRITE-06. IF1134.2 +040700 MOVE "F-INTOFDAY-06" TO PAR-NAME. IF1134.2 +040800 PERFORM PRINT-DETAIL. IF1134.2 +040900*****************TEST (g) ****************************** IF1134.2 +041000 F-INTOFDAY-07. IF1134.2 +041100 MOVE ZERO TO WS-INT. IF1134.2 +041200 F-INTOFDAY-TEST-07. IF1134.2 +041300 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(A) + IF1134.2 +041400 FUNCTION INTEGER-OF-DAY(A). IF1134.2 +041500 IF WS-INT = 800 THEN IF1134.2 +041600 PERFORM PASS IF1134.2 +041700 ELSE IF1134.2 +041800 MOVE 800 TO CORRECT-N IF1134.2 +041900 MOVE WS-INT TO COMPUTED-N IF1134.2 +042000 PERFORM FAIL. IF1134.2 +042100 GO TO F-INTOFDAY-WRITE-07. IF1134.2 +042200 F-INTOFDAY-DELETE-07. IF1134.2 +042300 PERFORM DE-LETE. IF1134.2 +042400 GO TO F-INTOFDAY-WRITE-07. IF1134.2 +042500 F-INTOFDAY-WRITE-07. IF1134.2 +042600 MOVE "F-INTOFDAY-07" TO PAR-NAME. IF1134.2 +042700 PERFORM PRINT-DETAIL. IF1134.2 +042800***************** SPECIAL TEST 1 *********************** IF1134.2 +042900 F-INTOFDAY-08. IF1134.2 +043000 MOVE 1601001 TO ARG1. IF1134.2 +043100 PERFORM F-INTOFDAY-TEST-08 IF1134.2 +043200 UNTIL FUNCTION INTEGER-OF-DAY(ARG1) > 10. IF1134.2 +043300 IF ARG1 = 1601011 THEN IF1134.2 +043400 PERFORM PASS IF1134.2 +043500 ELSE IF1134.2 +043600 PERFORM FAIL. IF1134.2 +043700 GO TO F-INTOFDAY-WRITE-08. IF1134.2 +043800* IF1134.2 +043900 F-INTOFDAY-TEST-08. IF1134.2 +044000 COMPUTE ARG1 = ARG1 + 1. IF1134.2 +044100* IF1134.2 +044200 F-INTOFDAY-DELETE-08. IF1134.2 +044300 PERFORM DE-LETE. IF1134.2 +044400 GO TO F-INTOFDAY-WRITE-08. IF1134.2 +044500 F-INTOFDAY-WRITE-08. IF1134.2 +044600 MOVE "F-INTOFDAY-08" TO PAR-NAME. IF1134.2 +044700 PERFORM PRINT-DETAIL. IF1134.2 +044800*******************END OF TESTS************************** IF1134.2 +044900 CCVS-EXIT SECTION. IF1134.2 +045000 CCVS-999999. IF1134.2 +045100 GO TO CLOSE-FILES. IF1134.2 +*END-OF,IF113A +*HEADER,COBOL,IF114A +000100 IDENTIFICATION DIVISION. IF1144.2 +000200 PROGRAM-ID. IF1144.2 +000300 IF114A. IF1144.2 +000400 IF1144.2 +000500*********************************************************** IF1144.2 +000600* * IF1144.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1144.2 +000800* It contains tests for the Intrinsic Function * IF1144.2 +000900* INTEGER-PART. * IF1144.2 +001000* * IF1144.2 +001100*********************************************************** IF1144.2 +001200 ENVIRONMENT DIVISION. IF1144.2 +001300 CONFIGURATION SECTION. IF1144.2 +001400 SOURCE-COMPUTER. IF1144.2 +001500 XXXXX082. IF1144.2 +001600 OBJECT-COMPUTER. IF1144.2 +001700 XXXXX083. IF1144.2 +001800 INPUT-OUTPUT SECTION. IF1144.2 +001900 FILE-CONTROL. IF1144.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1144.2 +002100 XXXXX055. IF1144.2 +002200 DATA DIVISION. IF1144.2 +002300 FILE SECTION. IF1144.2 +002400 FD PRINT-FILE. IF1144.2 +002500 01 PRINT-REC PICTURE X(120). IF1144.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1144.2 +002700 WORKING-STORAGE SECTION. IF1144.2 +002800*********************************************************** IF1144.2 +002900* Variables specific to the Intrinsic Function Test IF114A* IF1144.2 +003000*********************************************************** IF1144.2 +003100 01 A PIC S9(10) VALUE 500000. IF1144.2 +003200 01 B PIC S9(10) VALUE 1. IF1144.2 +003300 01 E PIC S9(6)V9(5) VALUE 399999.122. IF1144.2 +003400 01 F PIC S9(5)V9(5) VALUE 0.00032. IF1144.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1144.2 +003600 01 H PIC S9(5)V9(5) VALUE -5. IF1144.2 +003700 01 I PIC S9(5)V9(5) VALUE 3.4. IF1144.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 4.4. IF1144.2 +003900 01 ARR VALUE "40537". IF1144.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1144.2 +004100 01 TEMP PIC S9(5)V9(5). IF1144.2 +004200 01 WS-INT PIC S9(10). IF1144.2 +004300* IF1144.2 +004400********************************************************** IF1144.2 +004500* IF1144.2 +004600 01 TEST-RESULTS. IF1144.2 +004700 02 FILLER PIC X VALUE SPACE. IF1144.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IF1144.2 +004900 02 FILLER PIC X VALUE SPACE. IF1144.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IF1144.2 +005100 02 FILLER PIC X VALUE SPACE. IF1144.2 +005200 02 PAR-NAME. IF1144.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IF1144.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IF1144.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IF1144.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IF1144.2 +005700 02 RE-MARK PIC X(61). IF1144.2 +005800 01 TEST-COMPUTED. IF1144.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IF1144.2 +006000 02 FILLER PIC X(17) VALUE IF1144.2 +006100 " COMPUTED=". IF1144.2 +006200 02 COMPUTED-X. IF1144.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1144.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IF1144.2 +006500 PIC -9(9).9(9). IF1144.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1144.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1144.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1144.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IF1144.2 +007000 04 COMPUTED-18V0 PIC -9(18). IF1144.2 +007100 04 FILLER PIC X. IF1144.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IF1144.2 +007300 01 TEST-CORRECT. IF1144.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1144.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1144.2 +007600 02 CORRECT-X. IF1144.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1144.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1144.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1144.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1144.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1144.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IF1144.2 +008300 04 CORRECT-18V0 PIC -9(18). IF1144.2 +008400 04 FILLER PIC X. IF1144.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IF1144.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1144.2 +008700 01 CCVS-C-1. IF1144.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1144.2 +008900- "SS PARAGRAPH-NAME IF1144.2 +009000- " REMARKS". IF1144.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IF1144.2 +009200 01 CCVS-C-2. IF1144.2 +009300 02 FILLER PIC X VALUE SPACE. IF1144.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IF1144.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IF1144.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IF1144.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IF1144.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1144.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IF1144.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1144.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1144.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1144.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1144.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1144.2 +010900 01 CCVS-H-1. IF1144.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IF1144.2 +011100 02 FILLER PIC X(42) VALUE IF1144.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1144.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IF1144.2 +011400 01 CCVS-H-2A. IF1144.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IF1144.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1144.2 +011700 02 FILLER PIC XXXX VALUE IF1144.2 +011800 "4.2 ". IF1144.2 +011900 02 FILLER PIC X(28) VALUE IF1144.2 +012000 " COPY - NOT FOR DISTRIBUTION". IF1144.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IF1144.2 +012200 IF1144.2 +012300 01 CCVS-H-2B. IF1144.2 +012400 02 FILLER PIC X(15) VALUE IF1144.2 +012500 "TEST RESULT OF ". IF1144.2 +012600 02 TEST-ID PIC X(9). IF1144.2 +012700 02 FILLER PIC X(4) VALUE IF1144.2 +012800 " IN ". IF1144.2 +012900 02 FILLER PIC X(12) VALUE IF1144.2 +013000 " HIGH ". IF1144.2 +013100 02 FILLER PIC X(22) VALUE IF1144.2 +013200 " LEVEL VALIDATION FOR ". IF1144.2 +013300 02 FILLER PIC X(58) VALUE IF1144.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1144.2 +013500 01 CCVS-H-3. IF1144.2 +013600 02 FILLER PIC X(34) VALUE IF1144.2 +013700 " FOR OFFICIAL USE ONLY ". IF1144.2 +013800 02 FILLER PIC X(58) VALUE IF1144.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1144.2 +014000 02 FILLER PIC X(28) VALUE IF1144.2 +014100 " COPYRIGHT 1985 ". IF1144.2 +014200 01 CCVS-E-1. IF1144.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IF1144.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1144.2 +014500 02 ID-AGAIN PIC X(9). IF1144.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IF1144.2 +014700 01 CCVS-E-2. IF1144.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IF1144.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IF1144.2 +015000 02 CCVS-E-2-2. IF1144.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1144.2 +015200 03 FILLER PIC X VALUE SPACE. IF1144.2 +015300 03 ENDER-DESC PIC X(44) VALUE IF1144.2 +015400 "ERRORS ENCOUNTERED". IF1144.2 +015500 01 CCVS-E-3. IF1144.2 +015600 02 FILLER PIC X(22) VALUE IF1144.2 +015700 " FOR OFFICIAL USE ONLY". IF1144.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IF1144.2 +015900 02 FILLER PIC X(58) VALUE IF1144.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1144.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IF1144.2 +016200 02 FILLER PIC X(15) VALUE IF1144.2 +016300 " COPYRIGHT 1985". IF1144.2 +016400 01 CCVS-E-4. IF1144.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1144.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IF1144.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1144.2 +016800 02 FILLER PIC X(40) VALUE IF1144.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1144.2 +017000 01 XXINFO. IF1144.2 +017100 02 FILLER PIC X(19) VALUE IF1144.2 +017200 "*** INFORMATION ***". IF1144.2 +017300 02 INFO-TEXT. IF1144.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IF1144.2 +017500 04 XXCOMPUTED PIC X(20). IF1144.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IF1144.2 +017700 04 XXCORRECT PIC X(20). IF1144.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IF1144.2 +017900 01 HYPHEN-LINE. IF1144.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IF1144.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IF1144.2 +018200- "*****************************************". IF1144.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IF1144.2 +018400- "******************************". IF1144.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IF1144.2 +018600 "IF114A". IF1144.2 +018700 PROCEDURE DIVISION. IF1144.2 +018800 CCVS1 SECTION. IF1144.2 +018900 OPEN-FILES. IF1144.2 +019000 OPEN OUTPUT PRINT-FILE. IF1144.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1144.2 +019200 MOVE SPACE TO TEST-RESULTS. IF1144.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1144.2 +019400 GO TO CCVS1-EXIT. IF1144.2 +019500 CLOSE-FILES. IF1144.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1144.2 +019700 TERMINATE-CCVS. IF1144.2 +019800 STOP RUN. IF1144.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1144.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1144.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1144.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1144.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IF1144.2 +020400 PRINT-DETAIL. IF1144.2 +020500 IF REC-CT NOT EQUAL TO ZERO IF1144.2 +020600 MOVE "." TO PARDOT-X IF1144.2 +020700 MOVE REC-CT TO DOTVALUE. IF1144.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1144.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1144.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1144.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1144.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1144.2 +021300 MOVE SPACE TO CORRECT-X. IF1144.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1144.2 +021500 MOVE SPACE TO RE-MARK. IF1144.2 +021600 HEAD-ROUTINE. IF1144.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1144.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1144.2 +022100 COLUMN-NAMES-ROUTINE. IF1144.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +022500 END-ROUTINE. IF1144.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1144.2 +022700 END-RTN-EXIT. IF1144.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +022900 END-ROUTINE-1. IF1144.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1144.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1144.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IF1144.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1144.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1144.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1144.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1144.2 +023700 END-ROUTINE-12. IF1144.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1144.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1144.2 +024000 MOVE "NO " TO ERROR-TOTAL IF1144.2 +024100 ELSE IF1144.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1144.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1144.2 +024400 PERFORM WRITE-LINE. IF1144.2 +024500 END-ROUTINE-13. IF1144.2 +024600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1144.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE IF1144.2 +024800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1144.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1144.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO IF1144.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1144.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1144.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1144.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025700 WRITE-LINE. IF1144.2 +025800 ADD 1 TO RECORD-COUNT. IF1144.2 +025900Y IF RECORD-COUNT GREATER 42 IF1144.2 +026000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1144.2 +026100Y MOVE SPACE TO DUMMY-RECORD IF1144.2 +026200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1144.2 +026300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1144.2 +026400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1144.2 +026500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1144.2 +026600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1144.2 +026700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +026800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +026900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +027000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1144.2 +027100Y MOVE ZERO TO RECORD-COUNT. IF1144.2 +027200 PERFORM WRT-LN. IF1144.2 +027300 WRT-LN. IF1144.2 +027400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1144.2 +027500 MOVE SPACE TO DUMMY-RECORD. IF1144.2 +027600 BLANK-LINE-PRINT. IF1144.2 +027700 PERFORM WRT-LN. IF1144.2 +027800 FAIL-ROUTINE. IF1144.2 +027900 IF COMPUTED-X NOT EQUAL TO SPACE IF1144.2 +028000 GO TO FAIL-ROUTINE-WRITE. IF1144.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1144.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1144.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1144.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1144.2 +028600 GO TO FAIL-ROUTINE-EX. IF1144.2 +028700 FAIL-ROUTINE-WRITE. IF1144.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1144.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1144.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1144.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1144.2 +029200 FAIL-ROUTINE-EX. EXIT. IF1144.2 +029300 BAIL-OUT. IF1144.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1144.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1144.2 +029600 BAIL-OUT-WRITE. IF1144.2 +029700 MOVE CORRECT-A TO XXCORRECT. IF1144.2 +029800 MOVE COMPUTED-A TO XXCOMPUTED. IF1144.2 +029900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1144.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1144.2 +030200 BAIL-OUT-EX. EXIT. IF1144.2 +030300 CCVS1-EXIT. IF1144.2 +030400 EXIT. IF1144.2 +030500******************************************************** IF1144.2 +030600* * IF1144.2 +030700* Intrinsic Function Tests IF114A - INTEGER-PART * IF1144.2 +030800* * IF1144.2 +030900******************************************************** IF1144.2 +031000 SECT-IF114A SECTION. IF1144.2 +031100 F-INTPART-INFO. IF1144.2 +031200 MOVE "See ref. A-47 2.18" TO ANSI-REFERENCE. IF1144.2 +031300 MOVE "INTEGER-PART Function" TO FEATURE. IF1144.2 +031400*****************TEST (a) ****************************** IF1144.2 +031500 F-INTPART-01. IF1144.2 +031600 MOVE ZERO TO WS-INT. IF1144.2 +031700 F-INTPART-TEST-01. IF1144.2 +031800 COMPUTE WS-INT = FUNCTION INTEGER-PART(0). IF1144.2 +031900 IF WS-INT = 0 THEN IF1144.2 +032000 PERFORM PASS IF1144.2 +032100 ELSE IF1144.2 +032200 MOVE 0 TO CORRECT-N IF1144.2 +032300 MOVE WS-INT TO COMPUTED-N IF1144.2 +032400 PERFORM FAIL. IF1144.2 +032500 GO TO F-INTPART-WRITE-01. IF1144.2 +032600 F-INTPART-DELETE-01. IF1144.2 +032700 PERFORM DE-LETE. IF1144.2 +032800 GO TO F-INTPART-WRITE-01. IF1144.2 +032900 F-INTPART-WRITE-01. IF1144.2 +033000 MOVE "F-INTPART-01" TO PAR-NAME. IF1144.2 +033100 PERFORM PRINT-DETAIL. IF1144.2 +033200*****************TEST (b) ****************************** IF1144.2 +033300 F-INTPART-02. IF1144.2 +033400 MOVE ZERO TO WS-INT. IF1144.2 +033500 F-INTPART-TEST-02. IF1144.2 +033600 EVALUATE FUNCTION INTEGER-PART(3) IF1144.2 +033700 WHEN 3 IF1144.2 +033800 PERFORM PASS IF1144.2 +033900 GO TO F-INTPART-WRITE-02. IF1144.2 +034000 PERFORM FAIL. IF1144.2 +034100 GO TO F-INTPART-WRITE-02. IF1144.2 +034200 F-INTPART-DELETE-02. IF1144.2 +034300 PERFORM DE-LETE. IF1144.2 +034400 GO TO F-INTPART-WRITE-02. IF1144.2 +034500 F-INTPART-WRITE-02. IF1144.2 +034600 MOVE "F-INTPART-02" TO PAR-NAME. IF1144.2 +034700 PERFORM PRINT-DETAIL. IF1144.2 +034800*****************TEST (c) ****************************** IF1144.2 +034900 F-INTPART-03. IF1144.2 +035000 MOVE ZERO TO WS-INT. IF1144.2 +035100 F-INTPART-TEST-03. IF1144.2 +035200 IF FUNCTION INTEGER-PART(4.578) = 4 THEN IF1144.2 +035300 PERFORM PASS IF1144.2 +035400 ELSE IF1144.2 +035500 MOVE 4 TO CORRECT-N IF1144.2 +035600 PERFORM FAIL. IF1144.2 +035700 GO TO F-INTPART-WRITE-03. IF1144.2 +035800 F-INTPART-DELETE-03. IF1144.2 +035900 PERFORM DE-LETE. IF1144.2 +036000 GO TO F-INTPART-WRITE-03. IF1144.2 +036100 F-INTPART-WRITE-03. IF1144.2 +036200 MOVE "F-INTPART-03" TO PAR-NAME. IF1144.2 +036300 PERFORM PRINT-DETAIL. IF1144.2 +036400*****************TEST (d) ****************************** IF1144.2 +036500 F-INTPART-04. IF1144.2 +036600 MOVE ZERO TO WS-INT. IF1144.2 +036700 F-INTPART-TEST-04. IF1144.2 +036800 COMPUTE WS-INT = FUNCTION INTEGER-PART(-58). IF1144.2 +036900 IF WS-INT = -58 THEN IF1144.2 +037000 PERFORM PASS IF1144.2 +037100 ELSE IF1144.2 +037200 MOVE -58 TO CORRECT-N IF1144.2 +037300 MOVE WS-INT TO COMPUTED-N IF1144.2 +037400 PERFORM FAIL. IF1144.2 +037500 GO TO F-INTPART-WRITE-04. IF1144.2 +037600 F-INTPART-DELETE-04. IF1144.2 +037700 PERFORM DE-LETE. IF1144.2 +037800 GO TO F-INTPART-WRITE-04. IF1144.2 +037900 F-INTPART-WRITE-04. IF1144.2 +038000 MOVE "F-INTPART-04" TO PAR-NAME. IF1144.2 +038100 PERFORM PRINT-DETAIL. IF1144.2 +038200*****************TEST (e) ****************************** IF1144.2 +038300 F-INTPART-05. IF1144.2 +038400 MOVE ZERO TO WS-INT. IF1144.2 +038500 F-INTPART-TEST-05. IF1144.2 +038600 COMPUTE WS-INT = FUNCTION INTEGER-PART(-9.763). IF1144.2 +038700 IF WS-INT = -9 THEN IF1144.2 +038800 PERFORM PASS IF1144.2 +038900 ELSE IF1144.2 +039000 MOVE -9 TO CORRECT-N IF1144.2 +039100 MOVE WS-INT TO COMPUTED-N IF1144.2 +039200 PERFORM FAIL. IF1144.2 +039300 GO TO F-INTPART-WRITE-05. IF1144.2 +039400 F-INTPART-DELETE-05. IF1144.2 +039500 PERFORM DE-LETE. IF1144.2 +039600 GO TO F-INTPART-WRITE-05. IF1144.2 +039700 F-INTPART-WRITE-05. IF1144.2 +039800 MOVE "F-INTPART-05" TO PAR-NAME. IF1144.2 +039900 PERFORM PRINT-DETAIL. IF1144.2 +040000*****************TEST (f) ****************************** IF1144.2 +040100 F-INTPART-06. IF1144.2 +040200 MOVE ZERO TO WS-INT. IF1144.2 +040300 F-INTPART-TEST-06. IF1144.2 +040400 COMPUTE WS-INT = FUNCTION INTEGER-PART(320485). IF1144.2 +040500 IF WS-INT = 320485 THEN IF1144.2 +040600 PERFORM PASS IF1144.2 +040700 ELSE IF1144.2 +040800 MOVE 320485 TO CORRECT-N IF1144.2 +040900 MOVE WS-INT TO COMPUTED-N IF1144.2 +041000 PERFORM FAIL. IF1144.2 +041100 GO TO F-INTPART-WRITE-06. IF1144.2 +041200 F-INTPART-DELETE-06. IF1144.2 +041300 PERFORM DE-LETE. IF1144.2 +041400 GO TO F-INTPART-WRITE-06. IF1144.2 +041500 F-INTPART-WRITE-06. IF1144.2 +041600 MOVE "F-INTPART-06" TO PAR-NAME. IF1144.2 +041700 PERFORM PRINT-DETAIL. IF1144.2 +041800*****************TEST (g) ****************************** IF1144.2 +041900 F-INTPART-07. IF1144.2 +042000 MOVE ZERO TO WS-INT. IF1144.2 +042100 F-INTPART-TEST-07. IF1144.2 +042200 COMPUTE WS-INT = FUNCTION INTEGER-PART(230492.4828). IF1144.2 +042300 IF WS-INT = 230492 THEN IF1144.2 +042400 PERFORM PASS IF1144.2 +042500 ELSE IF1144.2 +042600 MOVE 230492 TO CORRECT-N IF1144.2 +042700 MOVE WS-INT TO COMPUTED-N IF1144.2 +042800 PERFORM FAIL. IF1144.2 +042900 GO TO F-INTPART-WRITE-07. IF1144.2 +043000 F-INTPART-DELETE-07. IF1144.2 +043100 PERFORM DE-LETE. IF1144.2 +043200 GO TO F-INTPART-WRITE-07. IF1144.2 +043300 F-INTPART-WRITE-07. IF1144.2 +043400 MOVE "F-INTPART-07" TO PAR-NAME. IF1144.2 +043500 PERFORM PRINT-DETAIL. IF1144.2 +043600*****************TEST (h) ****************************** IF1144.2 +043700 F-INTPART-08. IF1144.2 +043800 MOVE ZERO TO WS-INT. IF1144.2 +043900 F-INTPART-TEST-08. IF1144.2 +044000 COMPUTE WS-INT = FUNCTION INTEGER-PART(0.00032). IF1144.2 +044100 IF WS-INT = 0 THEN IF1144.2 +044200 PERFORM PASS IF1144.2 +044300 ELSE IF1144.2 +044400 MOVE 0 TO CORRECT-N IF1144.2 +044500 MOVE WS-INT TO COMPUTED-N IF1144.2 +044600 PERFORM FAIL. IF1144.2 +044700 GO TO F-INTPART-WRITE-08. IF1144.2 +044800 F-INTPART-DELETE-08. IF1144.2 +044900 PERFORM DE-LETE. IF1144.2 +045000 GO TO F-INTPART-WRITE-08. IF1144.2 +045100 F-INTPART-WRITE-08. IF1144.2 +045200 MOVE "F-INTPART-08" TO PAR-NAME. IF1144.2 +045300 PERFORM PRINT-DETAIL. IF1144.2 +045400*****************TEST (i) ****************************** IF1144.2 +045500 F-INTPART-09. IF1144.2 +045600 MOVE ZERO TO WS-INT. IF1144.2 +045700 F-INTPART-TEST-09. IF1144.2 +045800 COMPUTE WS-INT = FUNCTION INTEGER-PART(A). IF1144.2 +045900 IF WS-INT = 500000 THEN IF1144.2 +046000 PERFORM PASS IF1144.2 +046100 ELSE IF1144.2 +046200 MOVE 500000 TO CORRECT-N IF1144.2 +046300 MOVE WS-INT TO COMPUTED-N IF1144.2 +046400 PERFORM FAIL. IF1144.2 +046500 GO TO F-INTPART-WRITE-09. IF1144.2 +046600 F-INTPART-DELETE-09. IF1144.2 +046700 PERFORM DE-LETE. IF1144.2 +046800 GO TO F-INTPART-WRITE-09. IF1144.2 +046900 F-INTPART-WRITE-09. IF1144.2 +047000 MOVE "F-INTPART-09" TO PAR-NAME. IF1144.2 +047100 PERFORM PRINT-DETAIL. IF1144.2 +047200*****************TEST (j) ****************************** IF1144.2 +047300 F-INTPART-10. IF1144.2 +047400 MOVE ZERO TO WS-INT. IF1144.2 +047500 F-INTPART-TEST-10. IF1144.2 +047600 COMPUTE WS-INT = FUNCTION INTEGER-PART(E). IF1144.2 +047700 IF WS-INT = 399999 THEN IF1144.2 +047800 PERFORM PASS IF1144.2 +047900 ELSE IF1144.2 +048000 MOVE 399999 TO CORRECT-N IF1144.2 +048100 MOVE WS-INT TO COMPUTED-N IF1144.2 +048200 PERFORM FAIL. IF1144.2 +048300 GO TO F-INTPART-WRITE-10. IF1144.2 +048400 F-INTPART-DELETE-10. IF1144.2 +048500 PERFORM DE-LETE. IF1144.2 +048600 GO TO F-INTPART-WRITE-10. IF1144.2 +048700 F-INTPART-WRITE-10. IF1144.2 +048800 MOVE "F-INTPART-10" TO PAR-NAME. IF1144.2 +048900 PERFORM PRINT-DETAIL. IF1144.2 +049000*****************TEST (k) ****************************** IF1144.2 +049100 F-INTPART-11. IF1144.2 +049200 MOVE ZERO TO WS-INT. IF1144.2 +049300 F-INTPART-TEST-11. IF1144.2 +049400 COMPUTE WS-INT = FUNCTION INTEGER-PART(B). IF1144.2 +049500 IF WS-INT = 1 THEN IF1144.2 +049600 PERFORM PASS IF1144.2 +049700 ELSE IF1144.2 +049800 MOVE 1 TO CORRECT-N IF1144.2 +049900 MOVE WS-INT TO COMPUTED-N IF1144.2 +050000 PERFORM FAIL. IF1144.2 +050100 GO TO F-INTPART-WRITE-11. IF1144.2 +050200 F-INTPART-DELETE-11. IF1144.2 +050300 PERFORM DE-LETE. IF1144.2 +050400 GO TO F-INTPART-WRITE-11. IF1144.2 +050500 F-INTPART-WRITE-11. IF1144.2 +050600 MOVE "F-INTPART-11" TO PAR-NAME. IF1144.2 +050700 PERFORM PRINT-DETAIL. IF1144.2 +050800*****************TEST (l) ****************************** IF1144.2 +050900 F-INTPART-12. IF1144.2 +051000 MOVE ZERO TO WS-INT. IF1144.2 +051100 F-INTPART-TEST-12. IF1144.2 +051200 COMPUTE WS-INT = FUNCTION INTEGER-PART(F). IF1144.2 +051300 IF WS-INT = 0 THEN IF1144.2 +051400 PERFORM PASS IF1144.2 +051500 ELSE IF1144.2 +051600 MOVE 0 TO CORRECT-N IF1144.2 +051700 MOVE WS-INT TO COMPUTED-N IF1144.2 +051800 PERFORM FAIL. IF1144.2 +051900 GO TO F-INTPART-WRITE-12. IF1144.2 +052000 F-INTPART-DELETE-12. IF1144.2 +052100 PERFORM DE-LETE. IF1144.2 +052200 GO TO F-INTPART-WRITE-12. IF1144.2 +052300 F-INTPART-WRITE-12. IF1144.2 +052400 MOVE "F-INTPART-12" TO PAR-NAME. IF1144.2 +052500 PERFORM PRINT-DETAIL. IF1144.2 +052600*****************TEST (m) ****************************** IF1144.2 +052700 F-INTPART-13. IF1144.2 +052800 MOVE ZERO TO WS-INT. IF1144.2 +052900 F-INTPART-TEST-13. IF1144.2 +053000 COMPUTE WS-INT = FUNCTION INTEGER-PART(IND(1)). IF1144.2 +053100 IF WS-INT = 4 THEN IF1144.2 +053200 PERFORM PASS IF1144.2 +053300 ELSE IF1144.2 +053400 MOVE 4 TO CORRECT-N IF1144.2 +053500 MOVE WS-INT TO COMPUTED-N IF1144.2 +053600 PERFORM FAIL. IF1144.2 +053700 GO TO F-INTPART-WRITE-13. IF1144.2 +053800 F-INTPART-DELETE-13. IF1144.2 +053900 PERFORM DE-LETE. IF1144.2 +054000 GO TO F-INTPART-WRITE-13. IF1144.2 +054100 F-INTPART-WRITE-13. IF1144.2 +054200 MOVE "F-INTPART-13" TO PAR-NAME. IF1144.2 +054300 PERFORM PRINT-DETAIL. IF1144.2 +054400*****************TEST (n) ****************************** IF1144.2 +054500 F-INTPART-14. IF1144.2 +054600 MOVE ZERO TO WS-INT. IF1144.2 +054700 F-INTPART-TEST-14. IF1144.2 +054800 COMPUTE WS-INT = FUNCTION INTEGER-PART(IND(B)). IF1144.2 +054900 IF WS-INT = 4 THEN IF1144.2 +055000 PERFORM PASS IF1144.2 +055100 ELSE IF1144.2 +055200 MOVE 4 TO CORRECT-N IF1144.2 +055300 MOVE WS-INT TO COMPUTED-N IF1144.2 +055400 PERFORM FAIL. IF1144.2 +055500 GO TO F-INTPART-WRITE-14. IF1144.2 +055600 F-INTPART-DELETE-14. IF1144.2 +055700 PERFORM DE-LETE. IF1144.2 +055800 GO TO F-INTPART-WRITE-14. IF1144.2 +055900 F-INTPART-WRITE-14. IF1144.2 +056000 MOVE "F-INTPART-14" TO PAR-NAME. IF1144.2 +056100 PERFORM PRINT-DETAIL. IF1144.2 +056200*****************TEST (o) ****************************** IF1144.2 +056300 F-INTPART-15. IF1144.2 +056400 MOVE ZERO TO WS-INT. IF1144.2 +056500 F-INTPART-TEST-15. IF1144.2 +056600 COMPUTE WS-INT = FUNCTION INTEGER-PART((6 / 3) + 9). IF1144.2 +056700 IF WS-INT = 11 THEN IF1144.2 +056800 PERFORM PASS IF1144.2 +056900 ELSE IF1144.2 +057000 MOVE 11 TO CORRECT-N IF1144.2 +057100 MOVE WS-INT TO COMPUTED-N IF1144.2 +057200 PERFORM FAIL. IF1144.2 +057300 GO TO F-INTPART-WRITE-15. IF1144.2 +057400 F-INTPART-DELETE-15. IF1144.2 +057500 PERFORM DE-LETE. IF1144.2 +057600 GO TO F-INTPART-WRITE-15. IF1144.2 +057700 F-INTPART-WRITE-15. IF1144.2 +057800 MOVE "F-INTPART-15" TO PAR-NAME. IF1144.2 +057900 PERFORM PRINT-DETAIL. IF1144.2 +058000*****************TEST (p) ****************************** IF1144.2 +058100 F-INTPART-16. IF1144.2 +058200 MOVE ZERO TO WS-INT. IF1144.2 +058300 F-INTPART-TEST-16. IF1144.2 +058400 COMPUTE WS-INT = FUNCTION INTEGER-PART(H + B). IF1144.2 +058500 IF WS-INT = -4 THEN IF1144.2 +058600 PERFORM PASS IF1144.2 +058700 ELSE IF1144.2 +058800 MOVE -4 TO CORRECT-N IF1144.2 +058900 MOVE WS-INT TO COMPUTED-N IF1144.2 +059000 PERFORM FAIL. IF1144.2 +059100 GO TO F-INTPART-WRITE-16. IF1144.2 +059200 F-INTPART-DELETE-16. IF1144.2 +059300 PERFORM DE-LETE. IF1144.2 +059400 GO TO F-INTPART-WRITE-16. IF1144.2 +059500 F-INTPART-WRITE-16. IF1144.2 +059600 MOVE "F-INTPART-16" TO PAR-NAME. IF1144.2 +059700 PERFORM PRINT-DETAIL. IF1144.2 +059800*****************TEST (q) ****************************** IF1144.2 +059900 F-INTPART-17. IF1144.2 +060000 MOVE ZERO TO WS-INT. IF1144.2 +060100 F-INTPART-TEST-17. IF1144.2 +060200 COMPUTE WS-INT = FUNCTION INTEGER-PART(6.3 - (4.2 / 2)). IF1144.2 +060300 IF WS-INT = 4 THEN IF1144.2 +060400 PERFORM PASS IF1144.2 +060500 ELSE IF1144.2 +060600 MOVE 4 TO CORRECT-N IF1144.2 +060700 MOVE WS-INT TO COMPUTED-N IF1144.2 +060800 PERFORM FAIL. IF1144.2 +060900 GO TO F-INTPART-WRITE-17. IF1144.2 +061000 F-INTPART-DELETE-17. IF1144.2 +061100 PERFORM DE-LETE. IF1144.2 +061200 GO TO F-INTPART-WRITE-17. IF1144.2 +061300 F-INTPART-WRITE-17. IF1144.2 +061400 MOVE "F-INTPART-17" TO PAR-NAME. IF1144.2 +061500 PERFORM PRINT-DETAIL. IF1144.2 +061600*****************TEST (r) ****************************** IF1144.2 +061700 F-INTPART-18. IF1144.2 +061800 MOVE ZERO TO WS-INT. IF1144.2 +061900 F-INTPART-TEST-18. IF1144.2 +062000 COMPUTE WS-INT = FUNCTION INTEGER-PART((H + G) * I). IF1144.2 +062100 IF WS-INT = -3 THEN IF1144.2 +062200 PERFORM PASS IF1144.2 +062300 ELSE IF1144.2 +062400 MOVE -3 TO CORRECT-N IF1144.2 +062500 MOVE WS-INT TO COMPUTED-N IF1144.2 +062600 PERFORM FAIL. IF1144.2 +062700 GO TO F-INTPART-WRITE-18. IF1144.2 +062800 F-INTPART-DELETE-18. IF1144.2 +062900 PERFORM DE-LETE. IF1144.2 +063000 GO TO F-INTPART-WRITE-18. IF1144.2 +063100 F-INTPART-WRITE-18. IF1144.2 +063200 MOVE "F-INTPART-18" TO PAR-NAME. IF1144.2 +063300 PERFORM PRINT-DETAIL. IF1144.2 +063400*****************TEST (s) ****************************** IF1144.2 +063500 F-INTPART-19. IF1144.2 +063600 MOVE ZERO TO WS-INT. IF1144.2 +063700 F-INTPART-TEST-19. IF1144.2 +063800 COMPUTE WS-INT = FUNCTION INTEGER-PART(H / 5). IF1144.2 +063900 IF WS-INT = -1 THEN IF1144.2 +064000 PERFORM PASS IF1144.2 +064100 ELSE IF1144.2 +064200 MOVE -1 TO CORRECT-N IF1144.2 +064300 MOVE WS-INT TO COMPUTED-N IF1144.2 +064400 PERFORM FAIL. IF1144.2 +064500 GO TO F-INTPART-WRITE-19. IF1144.2 +064600 F-INTPART-DELETE-19. IF1144.2 +064700 PERFORM DE-LETE. IF1144.2 +064800 GO TO F-INTPART-WRITE-19. IF1144.2 +064900 F-INTPART-WRITE-19. IF1144.2 +065000 MOVE "F-INTPART-19" TO PAR-NAME. IF1144.2 +065100 PERFORM PRINT-DETAIL. IF1144.2 +065200*****************TEST (t) ****************************** IF1144.2 +065300 F-INTPART-20. IF1144.2 +065400 MOVE ZERO TO TEMP. IF1144.2 +065500 F-INTPART-TEST-20. IF1144.2 +065600 COMPUTE TEMP = FUNCTION INTEGER-PART(3.2) + I. IF1144.2 +065700 IF (TEMP >= 6.39987) AND IF1144.2 +065800 (TEMP <= 6.40013) IF1144.2 +065900 PERFORM PASS IF1144.2 +066000 ELSE IF1144.2 +066100 MOVE 6.4 TO CORRECT-N IF1144.2 +066200 MOVE TEMP TO COMPUTED-N IF1144.2 +066300 PERFORM FAIL. IF1144.2 +066400 GO TO F-INTPART-WRITE-20. IF1144.2 +066500 F-INTPART-DELETE-20. IF1144.2 +066600 PERFORM DE-LETE. IF1144.2 +066700 GO TO F-INTPART-WRITE-20. IF1144.2 +066800 F-INTPART-WRITE-20. IF1144.2 +066900 MOVE "F-INTPART-20" TO PAR-NAME. IF1144.2 +067000 PERFORM PRINT-DETAIL. IF1144.2 +067100*****************TEST (u) ****************************** IF1144.2 +067200 F-INTPART-21. IF1144.2 +067300 MOVE ZERO TO WS-INT. IF1144.2 +067400 F-INTPART-TEST-21. IF1144.2 +067500 COMPUTE WS-INT = IF1144.2 +067600 FUNCTION INTEGER-PART(FUNCTION INTEGER-PART(3.2)). IF1144.2 +067700 IF WS-INT = 3 THEN IF1144.2 +067800 PERFORM PASS IF1144.2 +067900 ELSE IF1144.2 +068000 MOVE 3 TO CORRECT-N IF1144.2 +068100 MOVE WS-INT TO COMPUTED-N IF1144.2 +068200 PERFORM FAIL. IF1144.2 +068300 GO TO F-INTPART-WRITE-21. IF1144.2 +068400 F-INTPART-DELETE-21. IF1144.2 +068500 PERFORM DE-LETE. IF1144.2 +068600 GO TO F-INTPART-WRITE-21. IF1144.2 +068700 F-INTPART-WRITE-21. IF1144.2 +068800 MOVE "F-INTPART-21" TO PAR-NAME. IF1144.2 +068900 PERFORM PRINT-DETAIL. IF1144.2 +069000*****************TEST (v) ****************************** IF1144.2 +069100 F-INTPART-22. IF1144.2 +069200 MOVE ZERO TO WS-INT. IF1144.2 +069300 F-INTPART-TEST-22. IF1144.2 +069400 COMPUTE WS-INT = FUNCTION INTEGER-PART(3.2) + IF1144.2 +069500 FUNCTION INTEGER-PART(1.3). IF1144.2 +069600 IF WS-INT = 4 THEN IF1144.2 +069700 PERFORM PASS IF1144.2 +069800 ELSE IF1144.2 +069900 MOVE 4 TO CORRECT-N IF1144.2 +070000 MOVE WS-INT TO COMPUTED-N IF1144.2 +070100 PERFORM FAIL. IF1144.2 +070200 GO TO F-INTPART-WRITE-22. IF1144.2 +070300 F-INTPART-DELETE-22. IF1144.2 +070400 PERFORM DE-LETE. IF1144.2 +070500 GO TO F-INTPART-WRITE-22. IF1144.2 +070600 F-INTPART-WRITE-22. IF1144.2 +070700 MOVE "F-INTPART-22" TO PAR-NAME. IF1144.2 +070800 PERFORM PRINT-DETAIL. IF1144.2 +070900***************** SPECIAL TEST 1 *********************** IF1144.2 +071000 F-INTPART-23. IF1144.2 +071100 MOVE 4.4 TO ARG1. IF1144.2 +071200 PERFORM F-INTPART-TEST-23 IF1144.2 +071300 UNTIL FUNCTION INTEGER-PART(ARG1) > 10. IF1144.2 +071400 IF ARG1 = 11.4 THEN IF1144.2 +071500 PERFORM PASS IF1144.2 +071600 ELSE IF1144.2 +071700 PERFORM FAIL. IF1144.2 +071800 GO TO F-INTPART-WRITE-23. IF1144.2 +071900* IF1144.2 +072000 F-INTPART-TEST-23. IF1144.2 +072100 COMPUTE ARG1 = ARG1 + 1. IF1144.2 +072200* IF1144.2 +072300 F-INTPART-DELETE-23. IF1144.2 +072400 PERFORM DE-LETE. IF1144.2 +072500 GO TO F-INTPART-WRITE-23. IF1144.2 +072600 F-INTPART-WRITE-23. IF1144.2 +072700 MOVE "F-INTPART-23" TO PAR-NAME. IF1144.2 +072800 PERFORM PRINT-DETAIL. IF1144.2 +072900*******************END OF TESTS************************** IF1144.2 +073000 CCVS-EXIT SECTION. IF1144.2 +073100 CCVS-999999. IF1144.2 +073200 GO TO CLOSE-FILES. IF1144.2 +*END-OF,IF114A +*HEADER,COBOL,IF115A +000100 IDENTIFICATION DIVISION. IF1154.2 +000200 PROGRAM-ID. IF1154.2 +000300 IF115A. IF1154.2 +000400 IF1154.2 +000500*********************************************************** IF1154.2 +000600* * IF1154.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1154.2 +000800* It contains tests for the Intrinsic Function LENGTH. * IF1154.2 +000900* * IF1154.2 +001000* * IF1154.2 +001100*********************************************************** IF1154.2 +001200 ENVIRONMENT DIVISION. IF1154.2 +001300 CONFIGURATION SECTION. IF1154.2 +001400 SOURCE-COMPUTER. IF1154.2 +001500 XXXXX082. IF1154.2 +001600 OBJECT-COMPUTER. IF1154.2 +001700 XXXXX083. IF1154.2 +001800 INPUT-OUTPUT SECTION. IF1154.2 +001900 FILE-CONTROL. IF1154.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1154.2 +002100 XXXXX055. IF1154.2 +002200 DATA DIVISION. IF1154.2 +002300 FILE SECTION. IF1154.2 +002400 FD PRINT-FILE. IF1154.2 +002500 01 PRINT-REC PICTURE X(120). IF1154.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1154.2 +002700 WORKING-STORAGE SECTION. IF1154.2 +002800*********************************************************** IF1154.2 +002900* Variables specific to the Intrinsic Function Test IF115A* IF1154.2 +003000*********************************************************** IF1154.2 +003100 01 K PIC A(1) VALUE "D". IF1154.2 +003200 01 M PIC A(17) VALUE "longstringofchars". IF1154.2 +003300 01 N PIC A(3) VALUE "abc". IF1154.2 +003400 01 C PIC S9(10). IF1154.2 +003500 01 WS-INT PIC S9(10). IF1154.2 +003600* IF1154.2 +003700********************************************************** IF1154.2 +003800* IF1154.2 +003900 01 TEST-RESULTS. IF1154.2 +004000 02 FILLER PIC X VALUE SPACE. IF1154.2 +004100 02 FEATURE PIC X(20) VALUE SPACE. IF1154.2 +004200 02 FILLER PIC X VALUE SPACE. IF1154.2 +004300 02 P-OR-F PIC X(5) VALUE SPACE. IF1154.2 +004400 02 FILLER PIC X VALUE SPACE. IF1154.2 +004500 02 PAR-NAME. IF1154.2 +004600 03 FILLER PIC X(19) VALUE SPACE. IF1154.2 +004700 03 PARDOT-X PIC X VALUE SPACE. IF1154.2 +004800 03 DOTVALUE PIC 99 VALUE ZERO. IF1154.2 +004900 02 FILLER PIC X(8) VALUE SPACE. IF1154.2 +005000 02 RE-MARK PIC X(61). IF1154.2 +005100 01 TEST-COMPUTED. IF1154.2 +005200 02 FILLER PIC X(30) VALUE SPACE. IF1154.2 +005300 02 FILLER PIC X(17) VALUE IF1154.2 +005400 " COMPUTED=". IF1154.2 +005500 02 COMPUTED-X. IF1154.2 +005600 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1154.2 +005700 03 COMPUTED-N REDEFINES COMPUTED-A IF1154.2 +005800 PIC -9(9).9(9). IF1154.2 +005900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1154.2 +006000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1154.2 +006100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1154.2 +006200 03 CM-18V0 REDEFINES COMPUTED-A. IF1154.2 +006300 04 COMPUTED-18V0 PIC -9(18). IF1154.2 +006400 04 FILLER PIC X. IF1154.2 +006500 03 FILLER PIC X(50) VALUE SPACE. IF1154.2 +006600 01 TEST-CORRECT. IF1154.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1154.2 +006800 02 FILLER PIC X(17) VALUE " CORRECT =". IF1154.2 +006900 02 CORRECT-X. IF1154.2 +007000 03 CORRECT-A PIC X(20) VALUE SPACE. IF1154.2 +007100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1154.2 +007200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1154.2 +007300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1154.2 +007400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1154.2 +007500 03 CR-18V0 REDEFINES CORRECT-A. IF1154.2 +007600 04 CORRECT-18V0 PIC -9(18). IF1154.2 +007700 04 FILLER PIC X. IF1154.2 +007800 03 FILLER PIC X(2) VALUE SPACE. IF1154.2 +007900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1154.2 +008000 01 CCVS-C-1. IF1154.2 +008100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1154.2 +008200- "SS PARAGRAPH-NAME IF1154.2 +008300- " REMARKS". IF1154.2 +008400 02 FILLER PIC X(20) VALUE SPACE. IF1154.2 +008500 01 CCVS-C-2. IF1154.2 +008600 02 FILLER PIC X VALUE SPACE. IF1154.2 +008700 02 FILLER PIC X(6) VALUE "TESTED". IF1154.2 +008800 02 FILLER PIC X(15) VALUE SPACE. IF1154.2 +008900 02 FILLER PIC X(4) VALUE "FAIL". IF1154.2 +009000 02 FILLER PIC X(94) VALUE SPACE. IF1154.2 +009100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1154.2 +009200 01 REC-CT PIC 99 VALUE ZERO. IF1154.2 +009300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009600 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1154.2 +009800 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1154.2 +009900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1154.2 +010000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1154.2 +010100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1154.2 +010200 01 CCVS-H-1. IF1154.2 +010300 02 FILLER PIC X(39) VALUE SPACES. IF1154.2 +010400 02 FILLER PIC X(42) VALUE IF1154.2 +010500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1154.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1154.2 +010700 01 CCVS-H-2A. IF1154.2 +010800 02 FILLER PIC X(40) VALUE SPACE. IF1154.2 +010900 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1154.2 +011000 02 FILLER PIC XXXX VALUE IF1154.2 +011100 "4.2 ". IF1154.2 +011200 02 FILLER PIC X(28) VALUE IF1154.2 +011300 " COPY - NOT FOR DISTRIBUTION". IF1154.2 +011400 02 FILLER PIC X(41) VALUE SPACE. IF1154.2 +011500 IF1154.2 +011600 01 CCVS-H-2B. IF1154.2 +011700 02 FILLER PIC X(15) VALUE IF1154.2 +011800 "TEST RESULT OF ". IF1154.2 +011900 02 TEST-ID PIC X(9). IF1154.2 +012000 02 FILLER PIC X(4) VALUE IF1154.2 +012100 " IN ". IF1154.2 +012200 02 FILLER PIC X(12) VALUE IF1154.2 +012300 " HIGH ". IF1154.2 +012400 02 FILLER PIC X(22) VALUE IF1154.2 +012500 " LEVEL VALIDATION FOR ". IF1154.2 +012600 02 FILLER PIC X(58) VALUE IF1154.2 +012700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2 +012800 01 CCVS-H-3. IF1154.2 +012900 02 FILLER PIC X(34) VALUE IF1154.2 +013000 " FOR OFFICIAL USE ONLY ". IF1154.2 +013100 02 FILLER PIC X(58) VALUE IF1154.2 +013200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1154.2 +013300 02 FILLER PIC X(28) VALUE IF1154.2 +013400 " COPYRIGHT 1985 ". IF1154.2 +013500 01 CCVS-E-1. IF1154.2 +013600 02 FILLER PIC X(52) VALUE SPACE. IF1154.2 +013700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1154.2 +013800 02 ID-AGAIN PIC X(9). IF1154.2 +013900 02 FILLER PIC X(45) VALUE SPACES. IF1154.2 +014000 01 CCVS-E-2. IF1154.2 +014100 02 FILLER PIC X(31) VALUE SPACE. IF1154.2 +014200 02 FILLER PIC X(21) VALUE SPACE. IF1154.2 +014300 02 CCVS-E-2-2. IF1154.2 +014400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1154.2 +014500 03 FILLER PIC X VALUE SPACE. IF1154.2 +014600 03 ENDER-DESC PIC X(44) VALUE IF1154.2 +014700 "ERRORS ENCOUNTERED". IF1154.2 +014800 01 CCVS-E-3. IF1154.2 +014900 02 FILLER PIC X(22) VALUE IF1154.2 +015000 " FOR OFFICIAL USE ONLY". IF1154.2 +015100 02 FILLER PIC X(12) VALUE SPACE. IF1154.2 +015200 02 FILLER PIC X(58) VALUE IF1154.2 +015300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2 +015400 02 FILLER PIC X(13) VALUE SPACE. IF1154.2 +015500 02 FILLER PIC X(15) VALUE IF1154.2 +015600 " COPYRIGHT 1985". IF1154.2 +015700 01 CCVS-E-4. IF1154.2 +015800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1154.2 +015900 02 FILLER PIC X(4) VALUE " OF ". IF1154.2 +016000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1154.2 +016100 02 FILLER PIC X(40) VALUE IF1154.2 +016200 " TESTS WERE EXECUTED SUCCESSFULLY". IF1154.2 +016300 01 XXINFO. IF1154.2 +016400 02 FILLER PIC X(19) VALUE IF1154.2 +016500 "*** INFORMATION ***". IF1154.2 +016600 02 INFO-TEXT. IF1154.2 +016700 04 FILLER PIC X(8) VALUE SPACE. IF1154.2 +016800 04 XXCOMPUTED PIC X(20). IF1154.2 +016900 04 FILLER PIC X(5) VALUE SPACE. IF1154.2 +017000 04 XXCORRECT PIC X(20). IF1154.2 +017100 02 INF-ANSI-REFERENCE PIC X(48). IF1154.2 +017200 01 HYPHEN-LINE. IF1154.2 +017300 02 FILLER PIC IS X VALUE IS SPACE. IF1154.2 +017400 02 FILLER PIC IS X(65) VALUE IS "************************IF1154.2 +017500- "*****************************************". IF1154.2 +017600 02 FILLER PIC IS X(54) VALUE IS "************************IF1154.2 +017700- "******************************". IF1154.2 +017800 01 CCVS-PGM-ID PIC X(9) VALUE IF1154.2 +017900 "IF115A". IF1154.2 +018000 PROCEDURE DIVISION. IF1154.2 +018100 CCVS1 SECTION. IF1154.2 +018200 OPEN-FILES. IF1154.2 +018300 OPEN OUTPUT PRINT-FILE. IF1154.2 +018400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1154.2 +018500 MOVE SPACE TO TEST-RESULTS. IF1154.2 +018600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1154.2 +018700 GO TO CCVS1-EXIT. IF1154.2 +018800 CLOSE-FILES. IF1154.2 +018900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1154.2 +019000 TERMINATE-CCVS. IF1154.2 +019100 STOP RUN. IF1154.2 +019200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1154.2 +019300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1154.2 +019400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1154.2 +019500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1154.2 +019600 MOVE "****TEST DELETED****" TO RE-MARK. IF1154.2 +019700 PRINT-DETAIL. IF1154.2 +019800 IF REC-CT NOT EQUAL TO ZERO IF1154.2 +019900 MOVE "." TO PARDOT-X IF1154.2 +020000 MOVE REC-CT TO DOTVALUE. IF1154.2 +020100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1154.2 +020200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1154.2 +020300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1154.2 +020400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1154.2 +020500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1154.2 +020600 MOVE SPACE TO CORRECT-X. IF1154.2 +020700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1154.2 +020800 MOVE SPACE TO RE-MARK. IF1154.2 +020900 HEAD-ROUTINE. IF1154.2 +021000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2 +021300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2 +021400 COLUMN-NAMES-ROUTINE. IF1154.2 +021500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +021600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +021800 END-ROUTINE. IF1154.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1154.2 +022000 END-RTN-EXIT. IF1154.2 +022100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +022200 END-ROUTINE-1. IF1154.2 +022300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1154.2 +022400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1154.2 +022500 ADD PASS-COUNTER TO ERROR-HOLD. IF1154.2 +022600 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1154.2 +022700 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1154.2 +022800 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1154.2 +022900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1154.2 +023000 END-ROUTINE-12. IF1154.2 +023100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1154.2 +023200 IF ERROR-COUNTER IS EQUAL TO ZERO IF1154.2 +023300 MOVE "NO " TO ERROR-TOTAL IF1154.2 +023400 ELSE IF1154.2 +023500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1154.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1154.2 +023700 PERFORM WRITE-LINE. IF1154.2 +023800 END-ROUTINE-13. IF1154.2 +023900 IF DELETE-COUNTER IS EQUAL TO ZERO IF1154.2 +024000 MOVE "NO " TO ERROR-TOTAL ELSE IF1154.2 +024100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1154.2 +024200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1154.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +024400 IF INSPECT-COUNTER EQUAL TO ZERO IF1154.2 +024500 MOVE "NO " TO ERROR-TOTAL IF1154.2 +024600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1154.2 +024700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1154.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +024900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +025000 WRITE-LINE. IF1154.2 +025100 ADD 1 TO RECORD-COUNT. IF1154.2 +025200Y IF RECORD-COUNT GREATER 42 IF1154.2 +025300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1154.2 +025400Y MOVE SPACE TO DUMMY-RECORD IF1154.2 +025500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1154.2 +025600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2 +025700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2 +025800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2 +025900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2 +026000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1154.2 +026400Y MOVE ZERO TO RECORD-COUNT. IF1154.2 +026500 PERFORM WRT-LN. IF1154.2 +026600 WRT-LN. IF1154.2 +026700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1154.2 +026800 MOVE SPACE TO DUMMY-RECORD. IF1154.2 +026900 BLANK-LINE-PRINT. IF1154.2 +027000 PERFORM WRT-LN. IF1154.2 +027100 FAIL-ROUTINE. IF1154.2 +027200 IF COMPUTED-X NOT EQUAL TO SPACE IF1154.2 +027300 GO TO FAIL-ROUTINE-WRITE. IF1154.2 +027400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1154.2 +027500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2 +027600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1154.2 +027700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +027800 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2 +027900 GO TO FAIL-ROUTINE-EX. IF1154.2 +028000 FAIL-ROUTINE-WRITE. IF1154.2 +028100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1154.2 +028200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1154.2 +028300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1154.2 +028400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1154.2 +028500 FAIL-ROUTINE-EX. EXIT. IF1154.2 +028600 BAIL-OUT. IF1154.2 +028700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1154.2 +028800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1154.2 +028900 BAIL-OUT-WRITE. IF1154.2 +029000 MOVE CORRECT-A TO XXCORRECT. IF1154.2 +029100 MOVE COMPUTED-A TO XXCOMPUTED. IF1154.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2 +029500 BAIL-OUT-EX. EXIT. IF1154.2 +029600 CCVS1-EXIT. IF1154.2 +029700 EXIT. IF1154.2 +029800******************************************************** IF1154.2 +029900* * IF1154.2 +030000* Intrinsic Function Tests IF115A - LENGTH * IF1154.2 +030100* * IF1154.2 +030200******************************************************** IF1154.2 +030300 SECT-IF115A SECTION. IF1154.2 +030400 F-LENGTH-INFO. IF1154.2 +030500 MOVE "See ref. A-48 2.19" TO ANSI-REFERENCE. IF1154.2 +030600 MOVE "LENGTH Function" TO FEATURE. IF1154.2 +030700*****************TEST (a) ****************************** IF1154.2 +030800 F-LENGTH-01. IF1154.2 +030900 MOVE ZERO TO WS-INT. IF1154.2 +031000 F-LENGTH-TEST-01. IF1154.2 +031100 COMPUTE WS-INT = FUNCTION LENGTH("A"). IF1154.2 +031200 IF WS-INT = 1 THEN IF1154.2 +031300 PERFORM PASS IF1154.2 +031400 ELSE IF1154.2 +031500 MOVE 1 TO CORRECT-X IF1154.2 +031600 MOVE WS-INT TO COMPUTED-A IF1154.2 +031700 PERFORM FAIL. IF1154.2 +031800 GO TO F-LENGTH-WRITE-01. IF1154.2 +031900 F-LENGTH-DELETE-01. IF1154.2 +032000 PERFORM DE-LETE. IF1154.2 +032100 GO TO F-LENGTH-WRITE-01. IF1154.2 +032200 F-LENGTH-WRITE-01. IF1154.2 +032300 MOVE "F-LENGTH-01" TO PAR-NAME. IF1154.2 +032400 PERFORM PRINT-DETAIL. IF1154.2 +032500*****************TEST (b) ****************************** IF1154.2 +032600 F-LENGTH-TEST-02. IF1154.2 +032700 EVALUATE FUNCTION LENGTH("ABCDEFGHIJKLMNOPQRST") IF1154.2 +032800 WHEN 20 IF1154.2 +032900 PERFORM PASS IF1154.2 +033000 GO TO F-LENGTH-WRITE-02. IF1154.2 +033100 PERFORM FAIL. IF1154.2 +033200 GO TO F-LENGTH-WRITE-02. IF1154.2 +033300 F-LENGTH-DELETE-02. IF1154.2 +033400 PERFORM DE-LETE. IF1154.2 +033500 GO TO F-LENGTH-WRITE-02. IF1154.2 +033600 F-LENGTH-WRITE-02. IF1154.2 +033700 MOVE "F-LENGTH-02" TO PAR-NAME. IF1154.2 +033800 PERFORM PRINT-DETAIL. IF1154.2 +033900*****************TEST (c) ****************************** IF1154.2 +034000 F-LENGTH-03. IF1154.2 +034100 MOVE ZERO TO WS-INT. IF1154.2 +034200 F-LENGTH-TEST-03. IF1154.2 +034300 IF FUNCTION LENGTH("ABCD") = 4 THEN IF1154.2 +034400 PERFORM PASS IF1154.2 +034500 ELSE IF1154.2 +034600 MOVE 4 TO CORRECT-X IF1154.2 +034700 MOVE WS-INT TO COMPUTED-A IF1154.2 +034800 PERFORM FAIL. IF1154.2 +034900 GO TO F-LENGTH-WRITE-03. IF1154.2 +035000 F-LENGTH-DELETE-03. IF1154.2 +035100 PERFORM DE-LETE. IF1154.2 +035200 GO TO F-LENGTH-WRITE-03. IF1154.2 +035300 F-LENGTH-WRITE-03. IF1154.2 +035400 MOVE "F-LENGTH-03" TO PAR-NAME. IF1154.2 +035500 PERFORM PRINT-DETAIL. IF1154.2 +035600*****************TEST (d) ****************************** IF1154.2 +035700 F-LENGTH-04. IF1154.2 +035800 MOVE ZERO TO WS-INT. IF1154.2 +035900 F-LENGTH-TEST-04. IF1154.2 +036000 COMPUTE WS-INT = FUNCTION LENGTH(K). IF1154.2 +036100 IF WS-INT = 1 THEN IF1154.2 +036200 PERFORM PASS IF1154.2 +036300 ELSE IF1154.2 +036400 MOVE 1 TO CORRECT-X IF1154.2 +036500 MOVE WS-INT TO COMPUTED-A IF1154.2 +036600 PERFORM FAIL. IF1154.2 +036700 GO TO F-LENGTH-WRITE-04. IF1154.2 +036800 F-LENGTH-DELETE-04. IF1154.2 +036900 PERFORM DE-LETE. IF1154.2 +037000 GO TO F-LENGTH-WRITE-04. IF1154.2 +037100 F-LENGTH-WRITE-04. IF1154.2 +037200 MOVE "F-LENGTH-04" TO PAR-NAME. IF1154.2 +037300 PERFORM PRINT-DETAIL. IF1154.2 +037400*****************TEST (e) ****************************** IF1154.2 +037500 F-LENGTH-05. IF1154.2 +037600 MOVE ZERO TO WS-INT. IF1154.2 +037700 F-LENGTH-TEST-05. IF1154.2 +037800 COMPUTE WS-INT = FUNCTION LENGTH(M). IF1154.2 +037900 IF WS-INT = 17 THEN IF1154.2 +038000 PERFORM PASS IF1154.2 +038100 ELSE IF1154.2 +038200 MOVE 17 TO CORRECT-X IF1154.2 +038300 MOVE WS-INT TO COMPUTED-A IF1154.2 +038400 PERFORM FAIL. IF1154.2 +038500 GO TO F-LENGTH-WRITE-05. IF1154.2 +038600 F-LENGTH-DELETE-05. IF1154.2 +038700 PERFORM DE-LETE. IF1154.2 +038800 GO TO F-LENGTH-WRITE-05. IF1154.2 +038900 F-LENGTH-WRITE-05. IF1154.2 +039000 MOVE "F-LENGTH-05" TO PAR-NAME. IF1154.2 +039100 PERFORM PRINT-DETAIL. IF1154.2 +039200*****************TEST (f) ****************************** IF1154.2 +039300 F-LENGTH-06. IF1154.2 +039400 MOVE ZERO TO WS-INT. IF1154.2 +039500 F-LENGTH-TEST-06. IF1154.2 +039600 COMPUTE WS-INT = FUNCTION LENGTH(N). IF1154.2 +039700 IF WS-INT = 3 THEN IF1154.2 +039800 PERFORM PASS IF1154.2 +039900 ELSE IF1154.2 +040000 MOVE 3 TO CORRECT-X IF1154.2 +040100 MOVE WS-INT TO COMPUTED-A IF1154.2 +040200 PERFORM FAIL. IF1154.2 +040300 GO TO F-LENGTH-WRITE-06. IF1154.2 +040400 F-LENGTH-DELETE-06. IF1154.2 +040500 PERFORM DE-LETE. IF1154.2 +040600 GO TO F-LENGTH-WRITE-06. IF1154.2 +040700 F-LENGTH-WRITE-06. IF1154.2 +040800 MOVE "F-LENGTH-06" TO PAR-NAME. IF1154.2 +040900 PERFORM PRINT-DETAIL. IF1154.2 +041000*****************TEST (g) ****************************** IF1154.2 +041100 F-LENGTH-07. IF1154.2 +041200 MOVE ZERO TO WS-INT. IF1154.2 +041300 F-LENGTH-TEST-07. IF1154.2 +041400 COMPUTE WS-INT = FUNCTION LENGTH(N) + 2. IF1154.2 +041500 IF WS-INT = 5 THEN IF1154.2 +041600 PERFORM PASS IF1154.2 +041700 ELSE IF1154.2 +041800 MOVE 5 TO CORRECT-N IF1154.2 +041900 MOVE WS-INT TO COMPUTED-A IF1154.2 +042000 PERFORM FAIL. IF1154.2 +042100 GO TO F-LENGTH-WRITE-07. IF1154.2 +042200 F-LENGTH-DELETE-07. IF1154.2 +042300 PERFORM DE-LETE. IF1154.2 +042400 GO TO F-LENGTH-WRITE-07. IF1154.2 +042500 F-LENGTH-WRITE-07. IF1154.2 +042600 MOVE "F-LENGTH-07" TO PAR-NAME. IF1154.2 +042700 PERFORM PRINT-DETAIL. IF1154.2 +042800*****************TEST (h) ****************************** IF1154.2 +042900 F-LENGTH-08. IF1154.2 +043000 MOVE ZERO TO WS-INT. IF1154.2 +043100 F-LENGTH-TEST-08. IF1154.2 +043200 COMPUTE WS-INT = FUNCTION LENGTH(N) + IF1154.2 +043300 FUNCTION LENGTH(N). IF1154.2 +043400 IF WS-INT = 6 THEN IF1154.2 +043500 PERFORM PASS IF1154.2 +043600 ELSE IF1154.2 +043700 MOVE 6 TO CORRECT-N IF1154.2 +043800 MOVE WS-INT TO COMPUTED-A IF1154.2 +043900 PERFORM FAIL. IF1154.2 +044000 GO TO F-LENGTH-WRITE-08. IF1154.2 +044100 F-LENGTH-DELETE-08. IF1154.2 +044200 PERFORM DE-LETE. IF1154.2 +044300 GO TO F-LENGTH-WRITE-08. IF1154.2 +044400 F-LENGTH-WRITE-08. IF1154.2 +044500 MOVE "F-LENGTH-08" TO PAR-NAME. IF1154.2 +044600 PERFORM PRINT-DETAIL. IF1154.2 +044700*******************END OF TESTS************************** IF1154.2 +044800 CCVS-EXIT SECTION. IF1154.2 +044900 CCVS-999999. IF1154.2 +045000 GO TO CLOSE-FILES. IF1154.2 +*END-OF,IF115A +*HEADER,COBOL,IF116A +000100 IDENTIFICATION DIVISION. IF1164.2 +000200 PROGRAM-ID. IF1164.2 +000300 IF116A. IF1164.2 +000400 IF1164.2 +000500*********************************************************** IF1164.2 +000600* * IF1164.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1164.2 +000800* It contains tests for the Intrinsic Function LOG. * IF1164.2 +000900* * IF1164.2 +001000*********************************************************** IF1164.2 +001100 ENVIRONMENT DIVISION. IF1164.2 +001200 CONFIGURATION SECTION. IF1164.2 +001300 SOURCE-COMPUTER. IF1164.2 +001400 XXXXX082. IF1164.2 +001500 OBJECT-COMPUTER. IF1164.2 +001600 XXXXX083. IF1164.2 +001700 INPUT-OUTPUT SECTION. IF1164.2 +001800 FILE-CONTROL. IF1164.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1164.2 +002000 XXXXX055. IF1164.2 +002100 DATA DIVISION. IF1164.2 +002200 FILE SECTION. IF1164.2 +002300 FD PRINT-FILE. IF1164.2 +002400 01 PRINT-REC PICTURE X(120). IF1164.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1164.2 +002600 WORKING-STORAGE SECTION. IF1164.2 +002700*********************************************************** IF1164.2 +002800* Variables specific to the Intrinsic Function Test IF116A* IF1164.2 +002900*********************************************************** IF1164.2 +003000 01 A PIC S9(10) VALUE 600000. IF1164.2 +003100 01 B PIC S9(10) VALUE 7. IF1164.2 +003200 01 C PIC S9(10) VALUE -4. IF1164.2 +003300 01 D PIC S9(10) VALUE 10. IF1164.2 +003400 01 E PIC S9(1)V9(9) VALUE 2.718281828. IF1164.2 +003500 01 F PIC S9(5)V9(5) VALUE 32000.8. IF1164.2 +003600 01 G PIC S9(5)V9(5) VALUE .00002. IF1164.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1164.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 1.00. IF1164.2 +003900 01 ARR VALUE "40537". IF1164.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1164.2 +004100 01 TEMP PIC S9(10). IF1164.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1164.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1164.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1164.2 +004500* IF1164.2 +004600********************************************************** IF1164.2 +004700* IF1164.2 +004800 01 TEST-RESULTS. IF1164.2 +004900 02 FILLER PIC X VALUE SPACE. IF1164.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1164.2 +005100 02 FILLER PIC X VALUE SPACE. IF1164.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1164.2 +005300 02 FILLER PIC X VALUE SPACE. IF1164.2 +005400 02 PAR-NAME. IF1164.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1164.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1164.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1164.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1164.2 +005900 02 RE-MARK PIC X(61). IF1164.2 +006000 01 TEST-COMPUTED. IF1164.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +006200 02 FILLER PIC X(17) VALUE IF1164.2 +006300 " COMPUTED=". IF1164.2 +006400 02 COMPUTED-X. IF1164.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1164.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1164.2 +006700 PIC -9(9).9(9). IF1164.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1164.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1164.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1164.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1164.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1164.2 +007300 04 FILLER PIC X. IF1164.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1164.2 +007500 01 TEST-CORRECT. IF1164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1164.2 +007800 02 CORRECT-X. IF1164.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1164.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1164.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1164.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1164.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1164.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1164.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1164.2 +008600 04 FILLER PIC X. IF1164.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1164.2 +008900 01 TEST-CORRECT-MIN. IF1164.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1164.2 +009200 02 CORRECTMI-X. IF1164.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1164.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1164.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1164.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1164.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1164.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1164.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1164.2 +010000 04 FILLER PIC X. IF1164.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1164.2 +010300 01 TEST-CORRECT-MAX. IF1164.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1164.2 +010600 02 CORRECTMA-X. IF1164.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1164.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1164.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1164.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1164.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1164.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1164.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1164.2 +011400 04 FILLER PIC X. IF1164.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1164.2 +011700 01 CCVS-C-1. IF1164.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1164.2 +011900- "SS PARAGRAPH-NAME IF1164.2 +012000- " REMARKS". IF1164.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1164.2 +012200 01 CCVS-C-2. IF1164.2 +012300 02 FILLER PIC X VALUE SPACE. IF1164.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1164.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1164.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1164.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1164.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1164.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1164.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1164.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1164.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1164.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1164.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1164.2 +013900 01 CCVS-H-1. IF1164.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1164.2 +014100 02 FILLER PIC X(42) VALUE IF1164.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1164.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1164.2 +014400 01 CCVS-H-2A. IF1164.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1164.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1164.2 +014700 02 FILLER PIC XXXX VALUE IF1164.2 +014800 "4.2 ". IF1164.2 +014900 02 FILLER PIC X(28) VALUE IF1164.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1164.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1164.2 +015200 IF1164.2 +015300 01 CCVS-H-2B. IF1164.2 +015400 02 FILLER PIC X(15) VALUE IF1164.2 +015500 "TEST RESULT OF ". IF1164.2 +015600 02 TEST-ID PIC X(9). IF1164.2 +015700 02 FILLER PIC X(4) VALUE IF1164.2 +015800 " IN ". IF1164.2 +015900 02 FILLER PIC X(12) VALUE IF1164.2 +016000 " HIGH ". IF1164.2 +016100 02 FILLER PIC X(22) VALUE IF1164.2 +016200 " LEVEL VALIDATION FOR ". IF1164.2 +016300 02 FILLER PIC X(58) VALUE IF1164.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1164.2 +016500 01 CCVS-H-3. IF1164.2 +016600 02 FILLER PIC X(34) VALUE IF1164.2 +016700 " FOR OFFICIAL USE ONLY ". IF1164.2 +016800 02 FILLER PIC X(58) VALUE IF1164.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1164.2 +017000 02 FILLER PIC X(28) VALUE IF1164.2 +017100 " COPYRIGHT 1985 ". IF1164.2 +017200 01 CCVS-E-1. IF1164.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1164.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1164.2 +017500 02 ID-AGAIN PIC X(9). IF1164.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1164.2 +017700 01 CCVS-E-2. IF1164.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1164.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1164.2 +018000 02 CCVS-E-2-2. IF1164.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1164.2 +018200 03 FILLER PIC X VALUE SPACE. IF1164.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1164.2 +018400 "ERRORS ENCOUNTERED". IF1164.2 +018500 01 CCVS-E-3. IF1164.2 +018600 02 FILLER PIC X(22) VALUE IF1164.2 +018700 " FOR OFFICIAL USE ONLY". IF1164.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1164.2 +018900 02 FILLER PIC X(58) VALUE IF1164.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1164.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1164.2 +019200 02 FILLER PIC X(15) VALUE IF1164.2 +019300 " COPYRIGHT 1985". IF1164.2 +019400 01 CCVS-E-4. IF1164.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1164.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1164.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1164.2 +019800 02 FILLER PIC X(40) VALUE IF1164.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1164.2 +020000 01 XXINFO. IF1164.2 +020100 02 FILLER PIC X(19) VALUE IF1164.2 +020200 "*** INFORMATION ***". IF1164.2 +020300 02 INFO-TEXT. IF1164.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1164.2 +020500 04 XXCOMPUTED PIC X(20). IF1164.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1164.2 +020700 04 XXCORRECT PIC X(20). IF1164.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1164.2 +020900 01 HYPHEN-LINE. IF1164.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1164.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1164.2 +021200- "*****************************************". IF1164.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1164.2 +021400- "******************************". IF1164.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1164.2 +021600 "IF116A". IF1164.2 +021700 PROCEDURE DIVISION. IF1164.2 +021800 CCVS1 SECTION. IF1164.2 +021900 OPEN-FILES. IF1164.2 +022000 OPEN OUTPUT PRINT-FILE. IF1164.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1164.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1164.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1164.2 +022400 GO TO CCVS1-EXIT. IF1164.2 +022500 CLOSE-FILES. IF1164.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1164.2 +022700 TERMINATE-CCVS. IF1164.2 +022800 STOP RUN. IF1164.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1164.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1164.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1164.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1164.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1164.2 +023400 PRINT-DETAIL. IF1164.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1164.2 +023600 MOVE "." TO PARDOT-X IF1164.2 +023700 MOVE REC-CT TO DOTVALUE. IF1164.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1164.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1164.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1164.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1164.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1164.2 +024300 MOVE SPACE TO CORRECT-X. IF1164.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1164.2 +024500 MOVE SPACE TO RE-MARK. IF1164.2 +024600 HEAD-ROUTINE. IF1164.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1164.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1164.2 +025100 COLUMN-NAMES-ROUTINE. IF1164.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +025500 END-ROUTINE. IF1164.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1164.2 +025700 END-RTN-EXIT. IF1164.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +025900 END-ROUTINE-1. IF1164.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1164.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1164.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1164.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1164.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1164.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1164.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1164.2 +026700 END-ROUTINE-12. IF1164.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1164.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1164.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1164.2 +027100 ELSE IF1164.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1164.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1164.2 +027400 PERFORM WRITE-LINE. IF1164.2 +027500 END-ROUTINE-13. IF1164.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1164.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1164.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1164.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1164.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1164.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1164.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1164.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1164.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028700 WRITE-LINE. IF1164.2 +028800 ADD 1 TO RECORD-COUNT. IF1164.2 +028900Y IF RECORD-COUNT GREATER 42 IF1164.2 +029000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1164.2 +029100Y MOVE SPACE TO DUMMY-RECORD IF1164.2 +029200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1164.2 +029300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1164.2 +029400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1164.2 +029500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1164.2 +029600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1164.2 +029700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +029800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +029900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +030000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1164.2 +030100Y MOVE ZERO TO RECORD-COUNT. IF1164.2 +030200 PERFORM WRT-LN. IF1164.2 +030300 WRT-LN. IF1164.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1164.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1164.2 +030600 BLANK-LINE-PRINT. IF1164.2 +030700 PERFORM WRT-LN. IF1164.2 +030800 FAIL-ROUTINE. IF1164.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1164.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1164.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1164.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1164.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1164.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1164.2 +031600 GO TO FAIL-ROUTINE-EX. IF1164.2 +031700 FAIL-ROUTINE-WRITE. IF1164.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1164.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1164.2 +032000 CORMA-ANSI-REFERENCE. IF1164.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1164.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1164.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1164.2 +032400 ELSE IF1164.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1164.2 +032600 PERFORM WRITE-LINE. IF1164.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1164.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1164.2 +032900 BAIL-OUT. IF1164.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1164.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1164.2 +033200 BAIL-OUT-WRITE. IF1164.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1164.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1164.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1164.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1164.2 +033800 BAIL-OUT-EX. EXIT. IF1164.2 +033900 CCVS1-EXIT. IF1164.2 +034000 EXIT. IF1164.2 +034100******************************************************** IF1164.2 +034200* * IF1164.2 +034300* Intrinsic Function Tests IF116A - LOG * IF1164.2 +034400* * IF1164.2 +034500******************************************************** IF1164.2 +034600 SECT-IF116A SECTION. IF1164.2 +034700 F-LOG-INFO. IF1164.2 +034800 MOVE "See ref. A-49 2.20" TO ANSI-REFERENCE. IF1164.2 +034900 MOVE "LOG Function" TO FEATURE. IF1164.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1164.2 +035100 F-LOG-01. IF1164.2 +035200 MOVE ZERO TO WS-NUM. IF1164.2 +035300 MOVE 0.999980 TO MIN-RANGE. IF1164.2 +035400 MOVE 1.00002 TO MAX-RANGE. IF1164.2 +035500 F-LOG-TEST-01. IF1164.2 +035600 COMPUTE WS-NUM = FUNCTION LOG(E). IF1164.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +035900 PERFORM PASS IF1164.2 +036000 ELSE IF1164.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +036400 PERFORM FAIL. IF1164.2 +036500 GO TO F-LOG-WRITE-01. IF1164.2 +036600 F-LOG-DELETE-01. IF1164.2 +036700 PERFORM DE-LETE. IF1164.2 +036800 GO TO F-LOG-WRITE-01. IF1164.2 +036900 F-LOG-WRITE-01. IF1164.2 +037000 MOVE "F-LOG-01" TO PAR-NAME. IF1164.2 +037100 PERFORM PRINT-DETAIL. IF1164.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1164.2 +037300 F-LOG-02. IF1164.2 +037400 EVALUATE FUNCTION LOG(1) IF1164.2 +037500 WHEN -0.000020 THRU 0.000020 IF1164.2 +037600 PERFORM PASS IF1164.2 +037700 WHEN OTHER IF1164.2 +037800 PERFORM FAIL. IF1164.2 +037900 GO TO F-LOG-WRITE-02. IF1164.2 +038000 F-LOG-DELETE-02. IF1164.2 +038100 PERFORM DE-LETE. IF1164.2 +038200 GO TO F-LOG-WRITE-02. IF1164.2 +038300 F-LOG-WRITE-02. IF1164.2 +038400 MOVE "F-LOG-02" TO PAR-NAME. IF1164.2 +038500 PERFORM PRINT-DETAIL. IF1164.2 +038600*****************TEST (d) - SIMPLE TEST***************** IF1164.2 +038700 F-LOG-04. IF1164.2 +038800 MOVE ZERO TO WS-NUM. IF1164.2 +038900 MOVE -6.90789 TO MIN-RANGE. IF1164.2 +039000 MOVE -6.90761 TO MAX-RANGE. IF1164.2 +039100 F-LOG-TEST-04. IF1164.2 +039200 COMPUTE WS-NUM = FUNCTION LOG(.001). IF1164.2 +039300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +039400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +039500 PERFORM PASS IF1164.2 +039600 ELSE IF1164.2 +039700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +039800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +039900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +040000 PERFORM FAIL. IF1164.2 +040100 GO TO F-LOG-WRITE-04. IF1164.2 +040200 F-LOG-DELETE-04. IF1164.2 +040300 PERFORM DE-LETE. IF1164.2 +040400 GO TO F-LOG-WRITE-04. IF1164.2 +040500 F-LOG-WRITE-04. IF1164.2 +040600 MOVE "F-LOG-04" TO PAR-NAME. IF1164.2 +040700 PERFORM PRINT-DETAIL. IF1164.2 +040800*****************TEST (e) - SIMPLE TEST***************** IF1164.2 +040900 F-LOG-05. IF1164.2 +041000 MOVE ZERO TO WS-NUM. IF1164.2 +041100 MOVE 9.21015 TO MIN-RANGE. IF1164.2 +041200 MOVE 9.21524 TO MAX-RANGE. IF1164.2 +041300 F-LOG-TEST-05. IF1164.2 +041400 COMPUTE WS-NUM = FUNCTION LOG(10000). IF1164.2 +041500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +041600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +041700 PERFORM PASS IF1164.2 +041800 ELSE IF1164.2 +041900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +042000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +042100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +042200 PERFORM FAIL. IF1164.2 +042300 GO TO F-LOG-WRITE-05. IF1164.2 +042400 F-LOG-DELETE-05. IF1164.2 +042500 PERFORM DE-LETE. IF1164.2 +042600 GO TO F-LOG-WRITE-05. IF1164.2 +042700 F-LOG-WRITE-05. IF1164.2 +042800 MOVE "F-LOG-05" TO PAR-NAME. IF1164.2 +042900 PERFORM PRINT-DETAIL. IF1164.2 +043000*****************TEST (f) - SIMPLE TEST***************** IF1164.2 +043100 F-LOG-06. IF1164.2 +043200 MOVE ZERO TO WS-NUM. IF1164.2 +043300 MOVE 8.01598 TO MIN-RANGE. IF1164.2 +043400 MOVE 8.01630 TO MAX-RANGE. IF1164.2 +043500 F-LOG-TEST-06. IF1164.2 +043600 COMPUTE WS-NUM = FUNCTION LOG(3029.48). IF1164.2 +043700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +043800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +043900 PERFORM PASS IF1164.2 +044000 ELSE IF1164.2 +044100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +044200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +044300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +044400 PERFORM FAIL. IF1164.2 +044500 GO TO F-LOG-WRITE-06. IF1164.2 +044600 F-LOG-DELETE-06. IF1164.2 +044700 PERFORM DE-LETE. IF1164.2 +044800 GO TO F-LOG-WRITE-06. IF1164.2 +044900 F-LOG-WRITE-06. IF1164.2 +045000 MOVE "F-LOG-06" TO PAR-NAME. IF1164.2 +045100 PERFORM PRINT-DETAIL. IF1164.2 +045200*****************TEST (g) - SIMPLE TEST***************** IF1164.2 +045300 F-LOG-07. IF1164.2 +045400 MOVE ZERO TO WS-NUM. IF1164.2 +045500 MOVE -9.90368 TO MIN-RANGE. IF1164.2 +045600 MOVE -9.90328 TO MAX-RANGE. IF1164.2 +045700 F-LOG-TEST-07. IF1164.2 +045800 COMPUTE WS-NUM = FUNCTION LOG(.00005). IF1164.2 +045900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +046000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +046100 PERFORM PASS IF1164.2 +046200 ELSE IF1164.2 +046300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +046400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +046500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +046600 PERFORM FAIL. IF1164.2 +046700 GO TO F-LOG-WRITE-07. IF1164.2 +046800 F-LOG-DELETE-07. IF1164.2 +046900 PERFORM DE-LETE. IF1164.2 +047000 GO TO F-LOG-WRITE-07. IF1164.2 +047100 F-LOG-WRITE-07. IF1164.2 +047200 MOVE "F-LOG-07" TO PAR-NAME. IF1164.2 +047300 PERFORM PRINT-DETAIL. IF1164.2 +047400*****************TEST (h) - SIMPLE TEST***************** IF1164.2 +047500 F-LOG-08. IF1164.2 +047600 MOVE ZERO TO WS-NUM. IF1164.2 +047700 MOVE 13.3044 TO MIN-RANGE. IF1164.2 +047800 MOVE 13.3050 TO MAX-RANGE. IF1164.2 +047900 F-LOG-TEST-08. IF1164.2 +048000 COMPUTE WS-NUM = FUNCTION LOG(A). IF1164.2 +048100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +048200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +048300 PERFORM PASS IF1164.2 +048400 ELSE IF1164.2 +048500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +048600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +048700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +048800 PERFORM FAIL. IF1164.2 +048900 GO TO F-LOG-WRITE-08. IF1164.2 +049000 F-LOG-DELETE-08. IF1164.2 +049100 PERFORM DE-LETE. IF1164.2 +049200 GO TO F-LOG-WRITE-08. IF1164.2 +049300 F-LOG-WRITE-08. IF1164.2 +049400 MOVE "F-LOG-08" TO PAR-NAME. IF1164.2 +049500 PERFORM PRINT-DETAIL. IF1164.2 +049600*****************TEST (i) - SIMPLE TEST***************** IF1164.2 +049700 F-LOG-09. IF1164.2 +049800 MOVE ZERO TO WS-NUM. IF1164.2 +049900 MOVE 10.3733 TO MIN-RANGE. IF1164.2 +050000 MOVE 10.3737 TO MAX-RANGE. IF1164.2 +050100 F-LOG-TEST-09. IF1164.2 +050200 COMPUTE WS-NUM = FUNCTION LOG(F). IF1164.2 +050300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +050400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +050500 PERFORM PASS IF1164.2 +050600 ELSE IF1164.2 +050700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +050800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +050900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +051000 PERFORM FAIL. IF1164.2 +051100 GO TO F-LOG-WRITE-09. IF1164.2 +051200 F-LOG-DELETE-09. IF1164.2 +051300 PERFORM DE-LETE. IF1164.2 +051400 GO TO F-LOG-WRITE-09. IF1164.2 +051500 F-LOG-WRITE-09. IF1164.2 +051600 MOVE "F-LOG-09" TO PAR-NAME. IF1164.2 +051700 PERFORM PRINT-DETAIL. IF1164.2 +051800*****************TEST (j) - SIMPLE TEST***************** IF1164.2 +051900 F-LOG-10. IF1164.2 +052000 MOVE ZERO TO WS-NUM. IF1164.2 +052100 MOVE -10.8199 TO MIN-RANGE. IF1164.2 +052200 MOVE -10.8195 TO MAX-RANGE. IF1164.2 +052300 F-LOG-TEST-10. IF1164.2 +052400 COMPUTE WS-NUM = FUNCTION LOG(G). IF1164.2 +052500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +052600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +052700 PERFORM PASS IF1164.2 +052800 ELSE IF1164.2 +052900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +053000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +053100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +053200 PERFORM FAIL. IF1164.2 +053300 GO TO F-LOG-WRITE-10. IF1164.2 +053400 F-LOG-DELETE-10. IF1164.2 +053500 PERFORM DE-LETE. IF1164.2 +053600 GO TO F-LOG-WRITE-10. IF1164.2 +053700 F-LOG-WRITE-10. IF1164.2 +053800 MOVE "F-LOG-10" TO PAR-NAME. IF1164.2 +053900 PERFORM PRINT-DETAIL. IF1164.2 +054000*****************TEST (k) - SIMPLE TEST***************** IF1164.2 +054100 F-LOG-11. IF1164.2 +054200 MOVE ZERO TO WS-NUM. IF1164.2 +054300 MOVE 1.09859 TO MIN-RANGE. IF1164.2 +054400 MOVE 1.09863 TO MAX-RANGE. IF1164.2 +054500 F-LOG-TEST-11. IF1164.2 +054600 COMPUTE WS-NUM = FUNCTION LOG(IND(4)). IF1164.2 +054700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +054800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +054900 PERFORM PASS IF1164.2 +055000 ELSE IF1164.2 +055100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +055200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +055300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +055400 PERFORM FAIL. IF1164.2 +055500 GO TO F-LOG-WRITE-11. IF1164.2 +055600 F-LOG-DELETE-11. IF1164.2 +055700 PERFORM DE-LETE. IF1164.2 +055800 GO TO F-LOG-WRITE-11. IF1164.2 +055900 F-LOG-WRITE-11. IF1164.2 +056000 MOVE "F-LOG-11" TO PAR-NAME. IF1164.2 +056100 PERFORM PRINT-DETAIL. IF1164.2 +056200*****************TEST (a) - COMPLEX TEST**************** IF1164.2 +056300 F-LOG-12. IF1164.2 +056400 MOVE ZERO TO WS-NUM. IF1164.2 +056500 MOVE 1.00032 TO MIN-RANGE. IF1164.2 +056600 MOVE 1.00040 TO MAX-RANGE. IF1164.2 +056700 F-LOG-TEST-12. IF1164.2 +056800 COMPUTE WS-NUM = FUNCTION LOG(E + .001). IF1164.2 +056900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +057000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +057100 PERFORM PASS IF1164.2 +057200 ELSE IF1164.2 +057300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +057400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +057500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +057600 PERFORM FAIL. IF1164.2 +057700 GO TO F-LOG-WRITE-12. IF1164.2 +057800 F-LOG-DELETE-12. IF1164.2 +057900 PERFORM DE-LETE. IF1164.2 +058000 GO TO F-LOG-WRITE-12. IF1164.2 +058100 F-LOG-WRITE-12. IF1164.2 +058200 MOVE "F-LOG-12" TO PAR-NAME. IF1164.2 +058300 PERFORM PRINT-DETAIL. IF1164.2 +058400*****************TEST (b) - COMPLEX TEST**************** IF1164.2 +058500 F-LOG-13. IF1164.2 +058600 MOVE ZERO TO WS-NUM. IF1164.2 +058700 MOVE -2.30267 TO MIN-RANGE. IF1164.2 +058800 MOVE -2.30249 TO MAX-RANGE. IF1164.2 +058900 F-LOG-TEST-13. IF1164.2 +059000 COMPUTE WS-NUM = FUNCTION LOG(1 / 10). IF1164.2 +059100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +059200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +059300 PERFORM PASS IF1164.2 +059400 ELSE IF1164.2 +059500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +059600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +059700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +059800 PERFORM FAIL. IF1164.2 +059900 GO TO F-LOG-WRITE-13. IF1164.2 +060000 F-LOG-DELETE-13. IF1164.2 +060100 PERFORM DE-LETE. IF1164.2 +060200 GO TO F-LOG-WRITE-13. IF1164.2 +060300 F-LOG-WRITE-13. IF1164.2 +060400 MOVE "F-LOG-13" TO PAR-NAME. IF1164.2 +060500 PERFORM PRINT-DETAIL. IF1164.2 +060600*****************TEST (c) - COMPLEX TEST**************** IF1164.2 +060700 F-LOG-14. IF1164.2 +060800 MOVE ZERO TO WS-NUM. IF1164.2 +060900 MOVE 0.962479 TO MIN-RANGE. IF1164.2 +061000 MOVE 0.962556 TO MAX-RANGE. IF1164.2 +061100 F-LOG-TEST-14. IF1164.2 +061200 COMPUTE WS-NUM = FUNCTION LOG(E - .1). IF1164.2 +061300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +061400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +061500 PERFORM PASS IF1164.2 +061600 ELSE IF1164.2 +061700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +061800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +061900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +062000 PERFORM FAIL. IF1164.2 +062100 GO TO F-LOG-WRITE-14. IF1164.2 +062200 F-LOG-DELETE-14. IF1164.2 +062300 PERFORM DE-LETE. IF1164.2 +062400 GO TO F-LOG-WRITE-14. IF1164.2 +062500 F-LOG-WRITE-14. IF1164.2 +062600 MOVE "F-LOG-14" TO PAR-NAME. IF1164.2 +062700 PERFORM PRINT-DETAIL. IF1164.2 +062800*****************TEST (d) - COMPLEX TEST**************** IF1164.2 +062900 F-LOG-15. IF1164.2 +063000 MOVE ZERO TO WS-NUM. IF1164.2 +063100 MOVE -0.105364 TO MIN-RANGE. IF1164.2 +063200 MOVE -0.105356 TO MAX-RANGE. IF1164.2 +063300 F-LOG-TEST-15. IF1164.2 +063400 COMPUTE WS-NUM = FUNCTION LOG(1 - .1). IF1164.2 +063500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +063600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +063700 PERFORM PASS IF1164.2 +063800 ELSE IF1164.2 +063900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +064000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +064100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +064200 PERFORM FAIL. IF1164.2 +064300 GO TO F-LOG-WRITE-15. IF1164.2 +064400 F-LOG-DELETE-15. IF1164.2 +064500 PERFORM DE-LETE. IF1164.2 +064600 GO TO F-LOG-WRITE-15. IF1164.2 +064700 F-LOG-WRITE-15. IF1164.2 +064800 MOVE "F-LOG-15" TO PAR-NAME. IF1164.2 +064900 PERFORM PRINT-DETAIL. IF1164.2 +065000*****************TEST (e) - COMPLEX TEST**************** IF1164.2 +065100 F-LOG-16. IF1164.2 +065200 MOVE ZERO TO WS-NUM. IF1164.2 +065300 MOVE 1.94583 TO MIN-RANGE. IF1164.2 +065400 MOVE 1.94599 TO MAX-RANGE. IF1164.2 +065500 F-LOG-TEST-16. IF1164.2 +065600 COMPUTE WS-NUM = FUNCTION LOG(IND(D - 5)). IF1164.2 +065700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +065800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +065900 PERFORM PASS IF1164.2 +066000 ELSE IF1164.2 +066100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +066200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +066300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +066400 PERFORM FAIL. IF1164.2 +066500 GO TO F-LOG-WRITE-16. IF1164.2 +066600 F-LOG-DELETE-16. IF1164.2 +066700 PERFORM DE-LETE. IF1164.2 +066800 GO TO F-LOG-WRITE-16. IF1164.2 +066900 F-LOG-WRITE-16. IF1164.2 +067000 MOVE "F-LOG-16" TO PAR-NAME. IF1164.2 +067100 PERFORM PRINT-DETAIL. IF1164.2 +067200*****************TEST (f) - COMPLEX TEST**************** IF1164.2 +067300 F-LOG-17. IF1164.2 +067400 MOVE ZERO TO WS-NUM. IF1164.2 +067500 MOVE 2.99561 TO MIN-RANGE. IF1164.2 +067600 MOVE 2.99585 TO MAX-RANGE. IF1164.2 +067700 F-LOG-TEST-17. IF1164.2 +067800 COMPUTE WS-NUM = FUNCTION LOG(2 * 10). IF1164.2 +067900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +068000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +068100 PERFORM PASS IF1164.2 +068200 ELSE IF1164.2 +068300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +068400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +068500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +068600 PERFORM FAIL. IF1164.2 +068700 GO TO F-LOG-WRITE-17. IF1164.2 +068800 F-LOG-DELETE-17. IF1164.2 +068900 PERFORM DE-LETE. IF1164.2 +069000 GO TO F-LOG-WRITE-17. IF1164.2 +069100 F-LOG-WRITE-17. IF1164.2 +069200 MOVE "F-LOG-17" TO PAR-NAME. IF1164.2 +069300 PERFORM PRINT-DETAIL. IF1164.2 +069400*****************TEST (g) - COMPLEX TEST**************** IF1164.2 +069500 F-LOG-18. IF1164.2 +069600 MOVE ZERO TO WS-NUM. IF1164.2 +069700 MOVE 1.09857 TO MIN-RANGE. IF1164.2 +069800 MOVE 1.09865 TO MAX-RANGE. IF1164.2 +069900 F-LOG-TEST-18. IF1164.2 +070000 COMPUTE WS-NUM = FUNCTION LOG(B + C). IF1164.2 +070100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +070200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +070300 PERFORM PASS IF1164.2 +070400 ELSE IF1164.2 +070500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +070600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +070700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +070800 PERFORM FAIL. IF1164.2 +070900 GO TO F-LOG-WRITE-18. IF1164.2 +071000 F-LOG-DELETE-18. IF1164.2 +071100 PERFORM DE-LETE. IF1164.2 +071200 GO TO F-LOG-WRITE-18. IF1164.2 +071300 F-LOG-WRITE-18. IF1164.2 +071400 MOVE "F-LOG-18" TO PAR-NAME. IF1164.2 +071500 PERFORM PRINT-DETAIL. IF1164.2 +071600*****************TEST (h) - COMPLEX TEST**************** IF1164.2 +071700 F-LOG-19. IF1164.2 +071800 MOVE ZERO TO WS-NUM. IF1164.2 +071900 MOVE 0.632497 TO MIN-RANGE. IF1164.2 +072000 MOVE 0.632547 TO MAX-RANGE. IF1164.2 +072100 F-LOG-TEST-19. IF1164.2 +072200 COMPUTE WS-NUM = FUNCTION LOG(3.2 / 1.7). IF1164.2 +072300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +072400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +072500 PERFORM PASS IF1164.2 +072600 ELSE IF1164.2 +072700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +072800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +072900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +073000 PERFORM FAIL. IF1164.2 +073100 GO TO F-LOG-WRITE-19. IF1164.2 +073200 F-LOG-DELETE-19. IF1164.2 +073300 PERFORM DE-LETE. IF1164.2 +073400 GO TO F-LOG-WRITE-19. IF1164.2 +073500 F-LOG-WRITE-19. IF1164.2 +073600 MOVE "F-LOG-19" TO PAR-NAME. IF1164.2 +073700 PERFORM PRINT-DETAIL. IF1164.2 +073800*****************TEST (i) - COMPLEX TEST**************** IF1164.2 +073900 F-LOG-20. IF1164.2 +074000 MOVE ZERO TO WS-NUM. IF1164.2 +074100 MOVE 2.08164 TO MIN-RANGE. IF1164.2 +074200 MOVE 2.08180 TO MAX-RANGE. IF1164.2 +074300 F-LOG-TEST-20. IF1164.2 +074400 COMPUTE WS-NUM = FUNCTION LOG(E - H). IF1164.2 +074500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +074600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +074700 PERFORM PASS IF1164.2 +074800 ELSE IF1164.2 +074900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +075000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +075100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +075200 PERFORM FAIL. IF1164.2 +075300 GO TO F-LOG-WRITE-20. IF1164.2 +075400 F-LOG-DELETE-20. IF1164.2 +075500 PERFORM DE-LETE. IF1164.2 +075600 GO TO F-LOG-WRITE-20. IF1164.2 +075700 F-LOG-WRITE-20. IF1164.2 +075800 MOVE "F-LOG-20" TO PAR-NAME. IF1164.2 +075900 PERFORM PRINT-DETAIL. IF1164.2 +076000*****************TEST (j) - COMPLEX TEST**************** IF1164.2 +076100 F-LOG-21. IF1164.2 +076200 MOVE ZERO TO WS-NUM. IF1164.2 +076300 MOVE 1.60937 TO MIN-RANGE. IF1164.2 +076400 MOVE 1.60949 TO MAX-RANGE. IF1164.2 +076500 F-LOG-TEST-21. IF1164.2 +076600 COMPUTE WS-NUM = FUNCTION LOG(B - 2). IF1164.2 +076700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +076800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +076900 PERFORM PASS IF1164.2 +077000 ELSE IF1164.2 +077100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +077200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +077300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +077400 PERFORM FAIL. IF1164.2 +077500 GO TO F-LOG-WRITE-21. IF1164.2 +077600 F-LOG-DELETE-21. IF1164.2 +077700 PERFORM DE-LETE. IF1164.2 +077800 GO TO F-LOG-WRITE-21. IF1164.2 +077900 F-LOG-WRITE-21. IF1164.2 +078000 MOVE "F-LOG-21" TO PAR-NAME. IF1164.2 +078100 PERFORM PRINT-DETAIL. IF1164.2 +078200*****************TEST (k) - COMPLEX TEST**************** IF1164.2 +078300 F-LOG-22. IF1164.2 +078400 MOVE ZERO TO WS-NUM. IF1164.2 +078500 MOVE 1.48569 TO MIN-RANGE. IF1164.2 +078600 MOVE 1.48581 TO MAX-RANGE. IF1164.2 +078700 F-LOG-TEST-22. IF1164.2 +078800 COMPUTE WS-NUM = FUNCTION LOG(E + 1.7). IF1164.2 +078900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +079000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +079100 PERFORM PASS IF1164.2 +079200 ELSE IF1164.2 +079300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +079400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +079500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +079600 PERFORM FAIL. IF1164.2 +079700 GO TO F-LOG-WRITE-22. IF1164.2 +079800 F-LOG-DELETE-22. IF1164.2 +079900 PERFORM DE-LETE. IF1164.2 +080000 GO TO F-LOG-WRITE-22. IF1164.2 +080100 F-LOG-WRITE-22. IF1164.2 +080200 MOVE "F-LOG-22" TO PAR-NAME. IF1164.2 +080300 PERFORM PRINT-DETAIL. IF1164.2 +080400*****************TEST (l) - COMPLEX TEST**************** IF1164.2 +080500 F-LOG-23. IF1164.2 +080600 MOVE ZERO TO WS-NUM. IF1164.2 +080700 MOVE 4.99980 TO MIN-RANGE. IF1164.2 +080800 MOVE 5.00002 TO MAX-RANGE. IF1164.2 +080900 F-LOG-TEST-23. IF1164.2 +081000 COMPUTE WS-NUM = FUNCTION LOG(E) + 4. IF1164.2 +081100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +081200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +081300 PERFORM PASS IF1164.2 +081400 ELSE IF1164.2 +081500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +081600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +081700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +081800 PERFORM FAIL. IF1164.2 +081900 GO TO F-LOG-WRITE-23. IF1164.2 +082000 F-LOG-DELETE-23. IF1164.2 +082100 PERFORM DE-LETE. IF1164.2 +082200 GO TO F-LOG-WRITE-23. IF1164.2 +082300 F-LOG-WRITE-23. IF1164.2 +082400 MOVE "F-LOG-23" TO PAR-NAME. IF1164.2 +082500 PERFORM PRINT-DETAIL. IF1164.2 +082600*****************TEST (m) - COMPLEX TEST**************** IF1164.2 +082700 F-LOG-24. IF1164.2 +082800 MOVE ZERO TO WS-NUM. IF1164.2 +082900 MOVE 0.665702 TO MIN-RANGE. IF1164.2 +083000 MOVE 0.665756 TO MAX-RANGE. IF1164.2 +083100 F-LOG-TEST-24. IF1164.2 +083200 COMPUTE WS-NUM = FUNCTION LOG(FUNCTION LOG(B)). IF1164.2 +083300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +083400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +083500 PERFORM PASS IF1164.2 +083600 ELSE IF1164.2 +083700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +083800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +083900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +084000 PERFORM FAIL. IF1164.2 +084100 GO TO F-LOG-WRITE-24. IF1164.2 +084200 F-LOG-DELETE-24. IF1164.2 +084300 PERFORM DE-LETE. IF1164.2 +084400 GO TO F-LOG-WRITE-24. IF1164.2 +084500 F-LOG-WRITE-24. IF1164.2 +084600 MOVE "F-LOG-24" TO PAR-NAME. IF1164.2 +084700 PERFORM PRINT-DETAIL. IF1164.2 +084800*****************TEST (n) - COMPLEX TEST**************** IF1164.2 +084900 F-LOG-25. IF1164.2 +085000 MOVE ZERO TO WS-NUM. IF1164.2 +085100 MOVE 1.69307 TO MIN-RANGE. IF1164.2 +085200 MOVE 1.69321 TO MAX-RANGE. IF1164.2 +085300 F-LOG-TEST-25. IF1164.2 +085400 COMPUTE WS-NUM = FUNCTION LOG(E) + IF1164.2 +085500 FUNCTION LOG(2). IF1164.2 +085600 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +085700 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +085800 PERFORM PASS IF1164.2 +085900 ELSE IF1164.2 +086000 MOVE WS-NUM TO COMPUTED-N IF1164.2 +086100 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +086200 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +086300 PERFORM FAIL. IF1164.2 +086400 GO TO F-LOG-WRITE-25. IF1164.2 +086500 F-LOG-DELETE-25. IF1164.2 +086600 PERFORM DE-LETE. IF1164.2 +086700 GO TO F-LOG-WRITE-25. IF1164.2 +086800 F-LOG-WRITE-25. IF1164.2 +086900 MOVE "F-LOG-25" TO PAR-NAME. IF1164.2 +087000 PERFORM PRINT-DETAIL. IF1164.2 +087100*****************SPECIAL PERFORM TEST********************** IF1164.2 +087200 F-LOG-26. IF1164.2 +087300 MOVE ZERO TO WS-NUM. IF1164.2 +087400 PERFORM F-LOG-TEST-26 IF1164.2 +087500 UNTIL FUNCTION LOG(ARG1) > 1. IF1164.2 +087600 PERFORM PASS. IF1164.2 +087700 GO TO F-LOG-WRITE-26. IF1164.2 +087800 F-LOG-TEST-26. IF1164.2 +087900 COMPUTE ARG1 = ARG1 + 0.2. IF1164.2 +088000 F-LOG-DELETE-26. IF1164.2 +088100 PERFORM DE-LETE. IF1164.2 +088200 GO TO F-LOG-WRITE-26. IF1164.2 +088300 F-LOG-WRITE-26. IF1164.2 +088400 MOVE "F-LOG-26" TO PAR-NAME. IF1164.2 +088500 PERFORM PRINT-DETAIL. IF1164.2 +088600********************END OF TESTS*************** IF1164.2 +088700 CCVS-EXIT SECTION. IF1164.2 +088800 CCVS-999999. IF1164.2 +088900 GO TO CLOSE-FILES. IF1164.2 +*END-OF,IF116A +*HEADER,COBOL,IF117A +000100 IDENTIFICATION DIVISION. IF1174.2 +000200 PROGRAM-ID. IF1174.2 +000300 IF117A. IF1174.2 +000400 IF1174.2 +000500*********************************************************** IF1174.2 +000600* * IF1174.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1174.2 +000800* It contains tests for the Intrinsic Function LOG10. * IF1174.2 +000900* * IF1174.2 +001000*********************************************************** IF1174.2 +001100 ENVIRONMENT DIVISION. IF1174.2 +001200 CONFIGURATION SECTION. IF1174.2 +001300 SOURCE-COMPUTER. IF1174.2 +001400 XXXXX082. IF1174.2 +001500 OBJECT-COMPUTER. IF1174.2 +001600 XXXXX083. IF1174.2 +001700 INPUT-OUTPUT SECTION. IF1174.2 +001800 FILE-CONTROL. IF1174.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1174.2 +002000 XXXXX055. IF1174.2 +002100 DATA DIVISION. IF1174.2 +002200 FILE SECTION. IF1174.2 +002300 FD PRINT-FILE. IF1174.2 +002400 01 PRINT-REC PICTURE X(120). IF1174.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1174.2 +002600 WORKING-STORAGE SECTION. IF1174.2 +002700*********************************************************** IF1174.2 +002800* Variables specific to the Intrinsic Function Test IF117A* IF1174.2 +002900*********************************************************** IF1174.2 +003000 01 A PIC S9(10) VALUE 600000. IF1174.2 +003100 01 B PIC S9(10) VALUE 7. IF1174.2 +003200 01 C PIC S9(10) VALUE -4. IF1174.2 +003300 01 D PIC S9(10) VALUE 10. IF1174.2 +003400 01 E PIC S9(1)V9(9) VALUE 2.718281828. IF1174.2 +003500 01 F PIC S9(5)V9(5) VALUE 32000.8. IF1174.2 +003600 01 G PIC S9(5)V9(5) VALUE .00002. IF1174.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1174.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 10.00. IF1174.2 +003900 01 ARR VALUE "40537". IF1174.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1174.2 +004100 01 TEMP PIC S9(10). IF1174.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1174.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1174.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1174.2 +004500* IF1174.2 +004600********************************************************** IF1174.2 +004700* IF1174.2 +004800 01 TEST-RESULTS. IF1174.2 +004900 02 FILLER PIC X VALUE SPACE. IF1174.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1174.2 +005100 02 FILLER PIC X VALUE SPACE. IF1174.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1174.2 +005300 02 FILLER PIC X VALUE SPACE. IF1174.2 +005400 02 PAR-NAME. IF1174.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1174.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1174.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1174.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1174.2 +005900 02 RE-MARK PIC X(61). IF1174.2 +006000 01 TEST-COMPUTED. IF1174.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +006200 02 FILLER PIC X(17) VALUE IF1174.2 +006300 " COMPUTED=". IF1174.2 +006400 02 COMPUTED-X. IF1174.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1174.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1174.2 +006700 PIC -9(9).9(9). IF1174.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1174.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1174.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1174.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1174.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1174.2 +007300 04 FILLER PIC X. IF1174.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1174.2 +007500 01 TEST-CORRECT. IF1174.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1174.2 +007800 02 CORRECT-X. IF1174.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1174.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1174.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1174.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1174.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1174.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1174.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1174.2 +008600 04 FILLER PIC X. IF1174.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1174.2 +008900 01 TEST-CORRECT-MIN. IF1174.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1174.2 +009200 02 CORRECTMI-X. IF1174.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1174.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1174.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1174.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1174.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1174.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1174.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1174.2 +010000 04 FILLER PIC X. IF1174.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1174.2 +010300 01 TEST-CORRECT-MAX. IF1174.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1174.2 +010600 02 CORRECTMA-X. IF1174.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1174.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1174.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1174.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1174.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1174.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1174.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1174.2 +011400 04 FILLER PIC X. IF1174.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1174.2 +011700 01 CCVS-C-1. IF1174.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1174.2 +011900- "SS PARAGRAPH-NAME IF1174.2 +012000- " REMARKS". IF1174.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1174.2 +012200 01 CCVS-C-2. IF1174.2 +012300 02 FILLER PIC X VALUE SPACE. IF1174.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1174.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1174.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1174.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1174.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1174.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1174.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1174.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1174.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1174.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1174.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1174.2 +013900 01 CCVS-H-1. IF1174.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1174.2 +014100 02 FILLER PIC X(42) VALUE IF1174.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1174.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1174.2 +014400 01 CCVS-H-2A. IF1174.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1174.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1174.2 +014700 02 FILLER PIC XXXX VALUE IF1174.2 +014800 "4.2 ". IF1174.2 +014900 02 FILLER PIC X(28) VALUE IF1174.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1174.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1174.2 +015200 IF1174.2 +015300 01 CCVS-H-2B. IF1174.2 +015400 02 FILLER PIC X(15) VALUE IF1174.2 +015500 "TEST RESULT OF ". IF1174.2 +015600 02 TEST-ID PIC X(9). IF1174.2 +015700 02 FILLER PIC X(4) VALUE IF1174.2 +015800 " IN ". IF1174.2 +015900 02 FILLER PIC X(12) VALUE IF1174.2 +016000 " HIGH ". IF1174.2 +016100 02 FILLER PIC X(22) VALUE IF1174.2 +016200 " LEVEL VALIDATION FOR ". IF1174.2 +016300 02 FILLER PIC X(58) VALUE IF1174.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1174.2 +016500 01 CCVS-H-3. IF1174.2 +016600 02 FILLER PIC X(34) VALUE IF1174.2 +016700 " FOR OFFICIAL USE ONLY ". IF1174.2 +016800 02 FILLER PIC X(58) VALUE IF1174.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1174.2 +017000 02 FILLER PIC X(28) VALUE IF1174.2 +017100 " COPYRIGHT 1985 ". IF1174.2 +017200 01 CCVS-E-1. IF1174.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1174.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1174.2 +017500 02 ID-AGAIN PIC X(9). IF1174.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1174.2 +017700 01 CCVS-E-2. IF1174.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1174.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1174.2 +018000 02 CCVS-E-2-2. IF1174.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1174.2 +018200 03 FILLER PIC X VALUE SPACE. IF1174.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1174.2 +018400 "ERRORS ENCOUNTERED". IF1174.2 +018500 01 CCVS-E-3. IF1174.2 +018600 02 FILLER PIC X(22) VALUE IF1174.2 +018700 " FOR OFFICIAL USE ONLY". IF1174.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1174.2 +018900 02 FILLER PIC X(58) VALUE IF1174.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1174.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1174.2 +019200 02 FILLER PIC X(15) VALUE IF1174.2 +019300 " COPYRIGHT 1985". IF1174.2 +019400 01 CCVS-E-4. IF1174.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1174.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1174.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1174.2 +019800 02 FILLER PIC X(40) VALUE IF1174.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1174.2 +020000 01 XXINFO. IF1174.2 +020100 02 FILLER PIC X(19) VALUE IF1174.2 +020200 "*** INFORMATION ***". IF1174.2 +020300 02 INFO-TEXT. IF1174.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1174.2 +020500 04 XXCOMPUTED PIC X(20). IF1174.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1174.2 +020700 04 XXCORRECT PIC X(20). IF1174.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1174.2 +020900 01 HYPHEN-LINE. IF1174.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1174.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1174.2 +021200- "*****************************************". IF1174.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1174.2 +021400- "******************************". IF1174.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1174.2 +021600 "IF117A". IF1174.2 +021700 PROCEDURE DIVISION. IF1174.2 +021800 CCVS1 SECTION. IF1174.2 +021900 OPEN-FILES. IF1174.2 +022000 OPEN OUTPUT PRINT-FILE. IF1174.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1174.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1174.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1174.2 +022400 GO TO CCVS1-EXIT. IF1174.2 +022500 CLOSE-FILES. IF1174.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1174.2 +022700 TERMINATE-CCVS. IF1174.2 +022800 STOP RUN. IF1174.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1174.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1174.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1174.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1174.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1174.2 +023400 PRINT-DETAIL. IF1174.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1174.2 +023600 MOVE "." TO PARDOT-X IF1174.2 +023700 MOVE REC-CT TO DOTVALUE. IF1174.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1174.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1174.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1174.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1174.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1174.2 +024300 MOVE SPACE TO CORRECT-X. IF1174.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1174.2 +024500 MOVE SPACE TO RE-MARK. IF1174.2 +024600 HEAD-ROUTINE. IF1174.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1174.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1174.2 +025100 COLUMN-NAMES-ROUTINE. IF1174.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +025500 END-ROUTINE. IF1174.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1174.2 +025700 END-RTN-EXIT. IF1174.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +025900 END-ROUTINE-1. IF1174.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1174.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1174.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1174.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1174.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1174.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1174.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1174.2 +026700 END-ROUTINE-12. IF1174.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1174.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1174.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1174.2 +027100 ELSE IF1174.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1174.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1174.2 +027400 PERFORM WRITE-LINE. IF1174.2 +027500 END-ROUTINE-13. IF1174.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1174.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1174.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1174.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1174.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1174.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1174.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1174.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1174.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028700 WRITE-LINE. IF1174.2 +028800 ADD 1 TO RECORD-COUNT. IF1174.2 +028900Y IF RECORD-COUNT GREATER 42 IF1174.2 +029000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1174.2 +029100Y MOVE SPACE TO DUMMY-RECORD IF1174.2 +029200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1174.2 +029300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1174.2 +029400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1174.2 +029500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1174.2 +029600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1174.2 +029700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +029800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +029900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +030000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1174.2 +030100Y MOVE ZERO TO RECORD-COUNT. IF1174.2 +030200 PERFORM WRT-LN. IF1174.2 +030300 WRT-LN. IF1174.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1174.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1174.2 +030600 BLANK-LINE-PRINT. IF1174.2 +030700 PERFORM WRT-LN. IF1174.2 +030800 FAIL-ROUTINE. IF1174.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1174.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1174.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1174.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1174.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1174.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1174.2 +031600 GO TO FAIL-ROUTINE-EX. IF1174.2 +031700 FAIL-ROUTINE-WRITE. IF1174.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1174.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1174.2 +032000 CORMA-ANSI-REFERENCE. IF1174.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1174.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1174.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1174.2 +032400 ELSE IF1174.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1174.2 +032600 PERFORM WRITE-LINE. IF1174.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1174.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1174.2 +032900 BAIL-OUT. IF1174.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1174.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1174.2 +033200 BAIL-OUT-WRITE. IF1174.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1174.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1174.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1174.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1174.2 +033800 BAIL-OUT-EX. EXIT. IF1174.2 +033900 CCVS1-EXIT. IF1174.2 +034000 EXIT. IF1174.2 +034100******************************************************** IF1174.2 +034200* * IF1174.2 +034300* Intrinsic Function Tests IF117A - LOG10 * IF1174.2 +034400* * IF1174.2 +034500******************************************************** IF1174.2 +034600 SECT-IF117A SECTION. IF1174.2 +034700 F-LOG10-INFO. IF1174.2 +034800 MOVE "See ref. A-49 2.21" TO ANSI-REFERENCE. IF1174.2 +034900 MOVE "LOG10 Function" TO FEATURE. IF1174.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1174.2 +035100 F-LOG10-01. IF1174.2 +035200 MOVE ZERO TO WS-NUM. IF1174.2 +035300 MOVE -0.000020 TO MIN-RANGE. IF1174.2 +035400 MOVE 0.000020 TO MAX-RANGE. IF1174.2 +035500 F-LOG10-TEST-01. IF1174.2 +035600 COMPUTE WS-NUM = FUNCTION LOG10(1). IF1174.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +035900 PERFORM PASS IF1174.2 +036000 ELSE IF1174.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1174.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +036400 PERFORM FAIL. IF1174.2 +036500 GO TO F-LOG10-WRITE-01. IF1174.2 +036600 F-LOG10-DELETE-01. IF1174.2 +036700 PERFORM DE-LETE. IF1174.2 +036800 GO TO F-LOG10-WRITE-01. IF1174.2 +036900 F-LOG10-WRITE-01. IF1174.2 +037000 MOVE "F-LOG10-01" TO PAR-NAME. IF1174.2 +037100 PERFORM PRINT-DETAIL. IF1174.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1174.2 +037300 F-LOG10-02. IF1174.2 +037400 EVALUATE FUNCTION LOG10(10) IF1174.2 +037500 WHEN 0.999980 THRU 1.000020 IF1174.2 +037600 PERFORM PASS IF1174.2 +037700 WHEN OTHER IF1174.2 +037800 PERFORM FAIL. IF1174.2 +037900 GO TO F-LOG10-WRITE-02. IF1174.2 +038000 F-LOG10-DELETE-02. IF1174.2 +038100 PERFORM DE-LETE. IF1174.2 +038200 GO TO F-LOG10-WRITE-02. IF1174.2 +038300 F-LOG10-WRITE-02. IF1174.2 +038400 MOVE "F-LOG10-02" TO PAR-NAME. IF1174.2 +038500 PERFORM PRINT-DETAIL. IF1174.2 +038600*****************TEST (c) - SIMPLE TEST***************** IF1174.2 +038700 F-LOG10-03. IF1174.2 +038800 MOVE -2.00004 TO MIN-RANGE. IF1174.2 +038900 MOVE -1.99996 TO MAX-RANGE. IF1174.2 +039000 F-LOG10-TEST-03. IF1174.2 +039100 IF (FUNCTION LOG10(.01) >= MIN-RANGE) AND IF1174.2 +039200 (FUNCTION LOG10(.01) <= MAX-RANGE) THEN IF1174.2 +039300 PERFORM PASS IF1174.2 +039400 ELSE IF1174.2 +039500 PERFORM FAIL. IF1174.2 +039600 GO TO F-LOG10-WRITE-03. IF1174.2 +039700 F-LOG10-DELETE-03. IF1174.2 +039800 PERFORM DE-LETE. IF1174.2 +039900 GO TO F-LOG10-WRITE-03. IF1174.2 +040000 F-LOG10-WRITE-03. IF1174.2 +040100 MOVE "F-LOG10-03" TO PAR-NAME. IF1174.2 +040200 PERFORM PRINT-DETAIL. IF1174.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1174.2 +040400 F-LOG10-04. IF1174.2 +040500 MOVE ZERO TO WS-NUM. IF1174.2 +040600 MOVE -3.00006 TO MIN-RANGE. IF1174.2 +040700 MOVE -2.99994 TO MAX-RANGE. IF1174.2 +040800 F-LOG10-TEST-04. IF1174.2 +040900 COMPUTE WS-NUM = FUNCTION LOG10(.001). IF1174.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +041200 PERFORM PASS IF1174.2 +041300 ELSE IF1174.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +041700 PERFORM FAIL. IF1174.2 +041800 GO TO F-LOG10-WRITE-04. IF1174.2 +041900 F-LOG10-DELETE-04. IF1174.2 +042000 PERFORM DE-LETE. IF1174.2 +042100 GO TO F-LOG10-WRITE-04. IF1174.2 +042200 F-LOG10-WRITE-04. IF1174.2 +042300 MOVE "F-LOG10-04" TO PAR-NAME. IF1174.2 +042400 PERFORM PRINT-DETAIL. IF1174.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1174.2 +042600 F-LOG10-05. IF1174.2 +042700 MOVE ZERO TO WS-NUM. IF1174.2 +042800 MOVE 1.99996 TO MIN-RANGE. IF1174.2 +042900 MOVE 2.00004 TO MAX-RANGE. IF1174.2 +043000 F-LOG10-TEST-05. IF1174.2 +043100 COMPUTE WS-NUM = FUNCTION LOG10(100). IF1174.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +043400 PERFORM PASS IF1174.2 +043500 ELSE IF1174.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +043900 PERFORM FAIL. IF1174.2 +044000 GO TO F-LOG10-WRITE-05. IF1174.2 +044100 F-LOG10-DELETE-05. IF1174.2 +044200 PERFORM DE-LETE. IF1174.2 +044300 GO TO F-LOG10-WRITE-05. IF1174.2 +044400 F-LOG10-WRITE-05. IF1174.2 +044500 MOVE "F-LOG10-05" TO PAR-NAME. IF1174.2 +044600 PERFORM PRINT-DETAIL. IF1174.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1174.2 +044800 F-LOG10-06. IF1174.2 +044900 MOVE ZERO TO WS-NUM. IF1174.2 +045000 MOVE 0.999936 TO MIN-RANGE. IF1174.2 +045100 MOVE 0.999976 TO MAX-RANGE. IF1174.2 +045200 F-LOG10-TEST-06. IF1174.2 +045300 COMPUTE WS-NUM = FUNCTION LOG10(9.999). IF1174.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +045600 PERFORM PASS IF1174.2 +045700 ELSE IF1174.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +046100 PERFORM FAIL. IF1174.2 +046200 GO TO F-LOG10-WRITE-06. IF1174.2 +046300 F-LOG10-DELETE-06. IF1174.2 +046400 PERFORM DE-LETE. IF1174.2 +046500 GO TO F-LOG10-WRITE-06. IF1174.2 +046600 F-LOG10-WRITE-06. IF1174.2 +046700 MOVE "F-LOG10-06" TO PAR-NAME. IF1174.2 +046800 PERFORM PRINT-DETAIL. IF1174.2 +046900*****************TEST (h) - SIMPLE TEST***************** IF1174.2 +047000 F-LOG10-08. IF1174.2 +047100 MOVE ZERO TO WS-NUM. IF1174.2 +047200 MOVE -2.04579 TO MIN-RANGE. IF1174.2 +047300 MOVE -2.04571 TO MAX-RANGE. IF1174.2 +047400 F-LOG10-TEST-08. IF1174.2 +047500 COMPUTE WS-NUM = FUNCTION LOG10(.009). IF1174.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +047800 PERFORM PASS IF1174.2 +047900 ELSE IF1174.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +048300 PERFORM FAIL. IF1174.2 +048400 GO TO F-LOG10-WRITE-08. IF1174.2 +048500 F-LOG10-DELETE-08. IF1174.2 +048600 PERFORM DE-LETE. IF1174.2 +048700 GO TO F-LOG10-WRITE-08. IF1174.2 +048800 F-LOG10-WRITE-08. IF1174.2 +048900 MOVE "F-LOG10-08" TO PAR-NAME. IF1174.2 +049000 PERFORM PRINT-DETAIL. IF1174.2 +049100*****************TEST (i) - SIMPLE TEST***************** IF1174.2 +049200 F-LOG10-09. IF1174.2 +049300 MOVE ZERO TO WS-NUM. IF1174.2 +049400 MOVE 2.00039 TO MIN-RANGE. IF1174.2 +049500 MOVE 2.00047 TO MAX-RANGE. IF1174.2 +049600 F-LOG10-TEST-09. IF1174.2 +049700 COMPUTE WS-NUM = FUNCTION LOG10(100.1). IF1174.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +050000 PERFORM PASS IF1174.2 +050100 ELSE IF1174.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +050500 PERFORM FAIL. IF1174.2 +050600 GO TO F-LOG10-WRITE-09. IF1174.2 +050700 F-LOG10-DELETE-09. IF1174.2 +050800 PERFORM DE-LETE. IF1174.2 +050900 GO TO F-LOG10-WRITE-09. IF1174.2 +051000 F-LOG10-WRITE-09. IF1174.2 +051100 MOVE "F-LOG10-09" TO PAR-NAME. IF1174.2 +051200 PERFORM PRINT-DETAIL. IF1174.2 +051300*****************TEST (j) - SIMPLE TEST***************** IF1174.2 +051400 F-LOG10-10. IF1174.2 +051500 MOVE ZERO TO WS-NUM. IF1174.2 +051600 MOVE 3.99992 TO MIN-RANGE. IF1174.2 +051700 MOVE 4.00008 TO MAX-RANGE. IF1174.2 +051800 F-LOG10-TEST-10. IF1174.2 +051900 COMPUTE WS-NUM = FUNCTION LOG10(10000). IF1174.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +052200 PERFORM PASS IF1174.2 +052300 ELSE IF1174.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +052700 PERFORM FAIL. IF1174.2 +052800 GO TO F-LOG10-WRITE-10. IF1174.2 +052900 F-LOG10-DELETE-10. IF1174.2 +053000 PERFORM DE-LETE. IF1174.2 +053100 GO TO F-LOG10-WRITE-10. IF1174.2 +053200 F-LOG10-WRITE-10. IF1174.2 +053300 MOVE "F-LOG10-10" TO PAR-NAME. IF1174.2 +053400 PERFORM PRINT-DETAIL. IF1174.2 +053500*****************TEST (k) - SIMPLE TEST***************** IF1174.2 +053600 F-LOG10-11. IF1174.2 +053700 MOVE ZERO TO WS-NUM. IF1174.2 +053800 MOVE 3.48129 TO MIN-RANGE. IF1174.2 +053900 MOVE 3.48143 TO MAX-RANGE. IF1174.2 +054000 F-LOG10-TEST-11. IF1174.2 +054100 COMPUTE WS-NUM = FUNCTION LOG10(3029.48). IF1174.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +054400 PERFORM PASS IF1174.2 +054500 ELSE IF1174.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +054900 PERFORM FAIL. IF1174.2 +055000 GO TO F-LOG10-WRITE-11. IF1174.2 +055100 F-LOG10-DELETE-11. IF1174.2 +055200 PERFORM DE-LETE. IF1174.2 +055300 GO TO F-LOG10-WRITE-11. IF1174.2 +055400 F-LOG10-WRITE-11. IF1174.2 +055500 MOVE "F-LOG10-11" TO PAR-NAME. IF1174.2 +055600 PERFORM PRINT-DETAIL. IF1174.2 +055700*****************TEST (l) - SIMPLE TEST***************** IF1174.2 +055800 F-LOG10-12. IF1174.2 +055900 MOVE ZERO TO WS-NUM. IF1174.2 +056000 MOVE -4.30111 TO MIN-RANGE. IF1174.2 +056100 MOVE -4.30093 TO MAX-RANGE. IF1174.2 +056200 F-LOG10-TEST-12. IF1174.2 +056300 COMPUTE WS-NUM = FUNCTION LOG10(.00005). IF1174.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +056600 PERFORM PASS IF1174.2 +056700 ELSE IF1174.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +057100 PERFORM FAIL. IF1174.2 +057200 GO TO F-LOG10-WRITE-12. IF1174.2 +057300 F-LOG10-DELETE-12. IF1174.2 +057400 PERFORM DE-LETE. IF1174.2 +057500 GO TO F-LOG10-WRITE-12. IF1174.2 +057600 F-LOG10-WRITE-12. IF1174.2 +057700 MOVE "F-LOG10-12" TO PAR-NAME. IF1174.2 +057800 PERFORM PRINT-DETAIL. IF1174.2 +057900*****************TEST (m) - SIMPLE TEST***************** IF1174.2 +058000 F-LOG10-13. IF1174.2 +058100 MOVE ZERO TO WS-NUM. IF1174.2 +058200 MOVE 5.77803 TO MIN-RANGE. IF1174.2 +058300 MOVE 5.77826 TO MAX-RANGE. IF1174.2 +058400 F-LOG10-TEST-13. IF1174.2 +058500 COMPUTE WS-NUM = FUNCTION LOG10(A). IF1174.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +058800 PERFORM PASS IF1174.2 +058900 ELSE IF1174.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +059300 PERFORM FAIL. IF1174.2 +059400 GO TO F-LOG10-WRITE-13. IF1174.2 +059500 F-LOG10-DELETE-13. IF1174.2 +059600 PERFORM DE-LETE. IF1174.2 +059700 GO TO F-LOG10-WRITE-13. IF1174.2 +059800 F-LOG10-WRITE-13. IF1174.2 +059900 MOVE "F-LOG10-13" TO PAR-NAME. IF1174.2 +060000 PERFORM PRINT-DETAIL. IF1174.2 +060100*****************TEST (n) - SIMPLE TEST***************** IF1174.2 +060200 F-LOG10-14. IF1174.2 +060300 MOVE ZERO TO WS-NUM. IF1174.2 +060400 MOVE 4.50507 TO MIN-RANGE. IF1174.2 +060500 MOVE 4.50525 TO MAX-RANGE. IF1174.2 +060600 F-LOG10-TEST-14. IF1174.2 +060700 COMPUTE WS-NUM = FUNCTION LOG10(F). IF1174.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +061000 PERFORM PASS IF1174.2 +061100 ELSE IF1174.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +061500 PERFORM FAIL. IF1174.2 +061600 GO TO F-LOG10-WRITE-14. IF1174.2 +061700 F-LOG10-DELETE-14. IF1174.2 +061800 PERFORM DE-LETE. IF1174.2 +061900 GO TO F-LOG10-WRITE-14. IF1174.2 +062000 F-LOG10-WRITE-14. IF1174.2 +062100 MOVE "F-LOG10-14" TO PAR-NAME. IF1174.2 +062200 PERFORM PRINT-DETAIL. IF1174.2 +062300*****************TEST (o) - SIMPLE TEST***************** IF1174.2 +062400 F-LOG10-15. IF1174.2 +062500 MOVE ZERO TO WS-NUM. IF1174.2 +062600 MOVE -4.69906 TO MIN-RANGE. IF1174.2 +062700 MOVE -4.69888 TO MAX-RANGE. IF1174.2 +062800 F-LOG10-TEST-15. IF1174.2 +062900 COMPUTE WS-NUM = FUNCTION LOG10(G). IF1174.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +063200 PERFORM PASS IF1174.2 +063300 ELSE IF1174.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +063700 PERFORM FAIL. IF1174.2 +063800 GO TO F-LOG10-WRITE-15. IF1174.2 +063900 F-LOG10-DELETE-15. IF1174.2 +064000 PERFORM DE-LETE. IF1174.2 +064100 GO TO F-LOG10-WRITE-15. IF1174.2 +064200 F-LOG10-WRITE-15. IF1174.2 +064300 MOVE "F-LOG10-15" TO PAR-NAME. IF1174.2 +064400 PERFORM PRINT-DETAIL. IF1174.2 +064500*****************TEST (p) - SIMPLE TEST***************** IF1174.2 +064600 F-LOG10-16. IF1174.2 +064700 MOVE ZERO TO WS-NUM. IF1174.2 +064800 MOVE 0.477111 TO MIN-RANGE. IF1174.2 +064900 MOVE 0.477131 TO MAX-RANGE. IF1174.2 +065000 F-LOG10-TEST-16. IF1174.2 +065100 COMPUTE WS-NUM = FUNCTION LOG10(IND(4)). IF1174.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +065400 PERFORM PASS IF1174.2 +065500 ELSE IF1174.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +065900 PERFORM FAIL. IF1174.2 +066000 GO TO F-LOG10-WRITE-16. IF1174.2 +066100 F-LOG10-DELETE-16. IF1174.2 +066200 PERFORM DE-LETE. IF1174.2 +066300 GO TO F-LOG10-WRITE-16. IF1174.2 +066400 F-LOG10-WRITE-16. IF1174.2 +066500 MOVE "F-LOG10-16" TO PAR-NAME. IF1174.2 +066600 PERFORM PRINT-DETAIL. IF1174.2 +066700*****************TEST (a) - COMPLEX TEST**************** IF1174.2 +066800 F-LOG10-17. IF1174.2 +066900 MOVE ZERO TO WS-NUM. IF1174.2 +067000 MOVE 0.434437 TO MIN-RANGE. IF1174.2 +067100 MOVE 0.434471 TO MAX-RANGE. IF1174.2 +067200 F-LOG10-TEST-17. IF1174.2 +067300 COMPUTE WS-NUM = FUNCTION LOG10(E + .001). IF1174.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +067600 PERFORM PASS IF1174.2 +067700 ELSE IF1174.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +068100 PERFORM FAIL. IF1174.2 +068200 GO TO F-LOG10-WRITE-17. IF1174.2 +068300 F-LOG10-DELETE-17. IF1174.2 +068400 PERFORM DE-LETE. IF1174.2 +068500 GO TO F-LOG10-WRITE-17. IF1174.2 +068600 F-LOG10-WRITE-17. IF1174.2 +068700 MOVE "F-LOG10-17" TO PAR-NAME. IF1174.2 +068800 PERFORM PRINT-DETAIL. IF1174.2 +068900*****************TEST (b) - COMPLEX TEST**************** IF1174.2 +069000 F-LOG10-18. IF1174.2 +069100 MOVE ZERO TO WS-NUM. IF1174.2 +069200 MOVE -1.00004 TO MIN-RANGE. IF1174.2 +069300 MOVE -0.999960 TO MAX-RANGE. IF1174.2 +069400 F-LOG10-TEST-18. IF1174.2 +069500 COMPUTE WS-NUM = FUNCTION LOG10(1 / 10). IF1174.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +069800 PERFORM PASS IF1174.2 +069900 ELSE IF1174.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +070300 PERFORM FAIL. IF1174.2 +070400 GO TO F-LOG10-WRITE-18. IF1174.2 +070500 F-LOG10-DELETE-18. IF1174.2 +070600 PERFORM DE-LETE. IF1174.2 +070700 GO TO F-LOG10-WRITE-18. IF1174.2 +070800 F-LOG10-WRITE-18. IF1174.2 +070900 MOVE "F-LOG10-18" TO PAR-NAME. IF1174.2 +071000 PERFORM PRINT-DETAIL. IF1174.2 +071100*****************TEST (c) - COMPLEX TEST**************** IF1174.2 +071200 F-LOG10-19. IF1174.2 +071300 MOVE ZERO TO WS-NUM. IF1174.2 +071400 MOVE 0.417999 TO MIN-RANGE. IF1174.2 +071500 MOVE 0.418033 TO MAX-RANGE. IF1174.2 +071600 F-LOG10-TEST-19. IF1174.2 +071700 COMPUTE WS-NUM = FUNCTION LOG10(E - .1). IF1174.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +072000 PERFORM PASS IF1174.2 +072100 ELSE IF1174.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +072500 PERFORM FAIL. IF1174.2 +072600 GO TO F-LOG10-WRITE-19. IF1174.2 +072700 F-LOG10-DELETE-19. IF1174.2 +072800 PERFORM DE-LETE. IF1174.2 +072900 GO TO F-LOG10-WRITE-19. IF1174.2 +073000 F-LOG10-WRITE-19. IF1174.2 +073100 MOVE "F-LOG10-19" TO PAR-NAME. IF1174.2 +073200 PERFORM PRINT-DETAIL. IF1174.2 +073300*****************TEST (d) - COMPLEX TEST**************** IF1174.2 +073400 F-LOG10-20. IF1174.2 +073500 MOVE ZERO TO WS-NUM. IF1174.2 +073600 MOVE -0.045759 TO MIN-RANGE. IF1174.2 +073700 MOVE -0.045755 TO MAX-RANGE. IF1174.2 +073800 F-LOG10-TEST-20. IF1174.2 +073900 COMPUTE WS-NUM = FUNCTION LOG10(1 - .1). IF1174.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +074200 PERFORM PASS IF1174.2 +074300 ELSE IF1174.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +074700 PERFORM FAIL. IF1174.2 +074800 GO TO F-LOG10-WRITE-20. IF1174.2 +074900 F-LOG10-DELETE-20. IF1174.2 +075000 PERFORM DE-LETE. IF1174.2 +075100 GO TO F-LOG10-WRITE-20. IF1174.2 +075200 F-LOG10-WRITE-20. IF1174.2 +075300 MOVE "F-LOG10-20" TO PAR-NAME. IF1174.2 +075400 PERFORM PRINT-DETAIL. IF1174.2 +075500*****************TEST (e) - COMPLEX TEST**************** IF1174.2 +075600 F-LOG10-21. IF1174.2 +075700 MOVE ZERO TO WS-NUM. IF1174.2 +075800 MOVE 1.04135 TO MIN-RANGE. IF1174.2 +075900 MOVE 1.04143 TO MAX-RANGE. IF1174.2 +076000 F-LOG10-TEST-21. IF1174.2 +076100 COMPUTE WS-NUM = FUNCTION LOG10(10 * 1.1). IF1174.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +076400 PERFORM PASS IF1174.2 +076500 ELSE IF1174.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +076900 PERFORM FAIL. IF1174.2 +077000 GO TO F-LOG10-WRITE-21. IF1174.2 +077100 F-LOG10-DELETE-21. IF1174.2 +077200 PERFORM DE-LETE. IF1174.2 +077300 GO TO F-LOG10-WRITE-21. IF1174.2 +077400 F-LOG10-WRITE-21. IF1174.2 +077500 MOVE "F-LOG10-21" TO PAR-NAME. IF1174.2 +077600 PERFORM PRINT-DETAIL. IF1174.2 +077700*****************TEST (f) - COMPLEX TEST**************** IF1174.2 +077800 F-LOG10-22. IF1174.2 +077900 MOVE ZERO TO WS-NUM. IF1174.2 +078000 MOVE -1.92090 TO MIN-RANGE. IF1174.2 +078100 MOVE -1.92074 TO MAX-RANGE. IF1174.2 +078200 F-LOG10-TEST-22. IF1174.2 +078300 COMPUTE WS-NUM = FUNCTION LOG10((A * G)/ 1000). IF1174.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +078600 PERFORM PASS IF1174.2 +078700 ELSE IF1174.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +079100 PERFORM FAIL. IF1174.2 +079200 GO TO F-LOG10-WRITE-22. IF1174.2 +079300 F-LOG10-DELETE-22. IF1174.2 +079400 PERFORM DE-LETE. IF1174.2 +079500 GO TO F-LOG10-WRITE-22. IF1174.2 +079600 F-LOG10-WRITE-22. IF1174.2 +079700 MOVE "F-LOG10-22" TO PAR-NAME. IF1174.2 +079800 PERFORM PRINT-DETAIL. IF1174.2 +079900*****************TEST (g) - COMPLEX TEST**************** IF1174.2 +080000 F-LOG10-23. IF1174.2 +080100 MOVE ZERO TO WS-NUM. IF1174.2 +080200 MOVE 0.845064 TO MIN-RANGE. IF1174.2 +080300 MOVE 0.845132 TO MAX-RANGE. IF1174.2 +080400 F-LOG10-TEST-23. IF1174.2 +080500 COMPUTE WS-NUM = FUNCTION LOG10(IND(D - 5)). IF1174.2 +080600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +080700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +080800 PERFORM PASS IF1174.2 +080900 ELSE IF1174.2 +081000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +081100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +081200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +081300 PERFORM FAIL. IF1174.2 +081400 GO TO F-LOG10-WRITE-23. IF1174.2 +081500 F-LOG10-DELETE-23. IF1174.2 +081600 PERFORM DE-LETE. IF1174.2 +081700 GO TO F-LOG10-WRITE-23. IF1174.2 +081800 F-LOG10-WRITE-23. IF1174.2 +081900 MOVE "F-LOG10-23" TO PAR-NAME. IF1174.2 +082000 PERFORM PRINT-DETAIL. IF1174.2 +082100*****************TEST (h) - COMPLEX TEST**************** IF1174.2 +082200 F-LOG10-24. IF1174.2 +082300 MOVE ZERO TO WS-NUM. IF1174.2 +082400 MOVE 1.30097 TO MIN-RANGE. IF1174.2 +082500 MOVE 1.30107 TO MAX-RANGE. IF1174.2 +082600 F-LOG10-TEST-24. IF1174.2 +082700 COMPUTE WS-NUM = FUNCTION LOG10(2 * 10). IF1174.2 +082800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +082900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +083000 PERFORM PASS IF1174.2 +083100 ELSE IF1174.2 +083200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +083300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +083400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +083500 PERFORM FAIL. IF1174.2 +083600 GO TO F-LOG10-WRITE-24. IF1174.2 +083700 F-LOG10-DELETE-24. IF1174.2 +083800 PERFORM DE-LETE. IF1174.2 +083900 GO TO F-LOG10-WRITE-24. IF1174.2 +084000 F-LOG10-WRITE-24. IF1174.2 +084100 MOVE "F-LOG10-24" TO PAR-NAME. IF1174.2 +084200 PERFORM PRINT-DETAIL. IF1174.2 +084300*****************TEST (i) - COMPLEX TEST**************** IF1174.2 +084400 F-LOG10-25. IF1174.2 +084500 MOVE ZERO TO WS-NUM. IF1174.2 +084600 MOVE 0.477102 TO MIN-RANGE. IF1174.2 +084700 MOVE 0.477140 TO MAX-RANGE. IF1174.2 +084800 F-LOG10-TEST-25. IF1174.2 +084900 COMPUTE WS-NUM = FUNCTION LOG10(B + C). IF1174.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +085200 PERFORM PASS IF1174.2 +085300 ELSE IF1174.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +085700 PERFORM FAIL. IF1174.2 +085800 GO TO F-LOG10-WRITE-25. IF1174.2 +085900 F-LOG10-DELETE-25. IF1174.2 +086000 PERFORM DE-LETE. IF1174.2 +086100 GO TO F-LOG10-WRITE-25. IF1174.2 +086200 F-LOG10-WRITE-25. IF1174.2 +086300 MOVE "F-LOG10-25" TO PAR-NAME. IF1174.2 +086400 PERFORM PRINT-DETAIL. IF1174.2 +086500*****************TEST (j) -COMPLEX TEST***************** IF1174.2 +086600 F-LOG10-26. IF1174.2 +086700 MOVE ZERO TO WS-NUM. IF1174.2 +086800 MOVE 0.274690 TO MIN-RANGE. IF1174.2 +086900 MOVE 0.274712 TO MAX-RANGE. IF1174.2 +087000 F-LOG10-TEST-26. IF1174.2 +087100 COMPUTE WS-NUM = FUNCTION LOG10(3.2 / 1.7). IF1174.2 +087200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +087300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +087400 PERFORM PASS IF1174.2 +087500 ELSE IF1174.2 +087600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +087700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +087800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +087900 PERFORM FAIL. IF1174.2 +088000 GO TO F-LOG10-WRITE-26. IF1174.2 +088100 F-LOG10-DELETE-26. IF1174.2 +088200 PERFORM DE-LETE. IF1174.2 +088300 GO TO F-LOG10-WRITE-26. IF1174.2 +088400 F-LOG10-WRITE-26. IF1174.2 +088500 MOVE "F-LOG10-26" TO PAR-NAME. IF1174.2 +088600 PERFORM PRINT-DETAIL. IF1174.2 +088700*****************TEST (k) - COMPLEX TEST**************** IF1174.2 +088800 F-LOG10-27. IF1174.2 +088900 MOVE ZERO TO WS-NUM. IF1174.2 +089000 MOVE 0.904045 TO MIN-RANGE. IF1174.2 +089100 MOVE 0.904117 TO MAX-RANGE. IF1174.2 +089200 F-LOG10-TEST-27. IF1174.2 +089300 COMPUTE WS-NUM = FUNCTION LOG10(E - H). IF1174.2 +089400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +089500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +089600 PERFORM PASS IF1174.2 +089700 ELSE IF1174.2 +089800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +089900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +090000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +090100 PERFORM FAIL. IF1174.2 +090200 GO TO F-LOG10-WRITE-27. IF1174.2 +090300 F-LOG10-DELETE-27. IF1174.2 +090400 PERFORM DE-LETE. IF1174.2 +090500 GO TO F-LOG10-WRITE-27. IF1174.2 +090600 F-LOG10-WRITE-27. IF1174.2 +090700 MOVE "F-LOG10-27" TO PAR-NAME. IF1174.2 +090800 PERFORM PRINT-DETAIL. IF1174.2 +090900*****************TEST (l) - COMPLEX TEST**************** IF1174.2 +091000 F-LOG10-28. IF1174.2 +091100 MOVE ZERO TO WS-NUM. IF1174.2 +091200 MOVE 0.698942 TO MIN-RANGE. IF1174.2 +091300 MOVE 0.698998 TO MAX-RANGE. IF1174.2 +091400 F-LOG10-TEST-28. IF1174.2 +091500 COMPUTE WS-NUM = FUNCTION LOG10(B - 2). IF1174.2 +091600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +091700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +091800 PERFORM PASS IF1174.2 +091900 ELSE IF1174.2 +092000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +092100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +092200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +092300 PERFORM FAIL. IF1174.2 +092400 GO TO F-LOG10-WRITE-28. IF1174.2 +092500 F-LOG10-DELETE-28. IF1174.2 +092600 PERFORM DE-LETE. IF1174.2 +092700 GO TO F-LOG10-WRITE-28. IF1174.2 +092800 F-LOG10-WRITE-28. IF1174.2 +092900 MOVE "F-LOG10-28" TO PAR-NAME. IF1174.2 +093000 PERFORM PRINT-DETAIL. IF1174.2 +093100*****************TEST (m) - COMPLEX TEST**************** IF1174.2 +093200 F-LOG10-29. IF1174.2 +093300 MOVE ZERO TO WS-NUM. IF1174.2 +093400 MOVE 0.645227 TO MIN-RANGE. IF1174.2 +093500 MOVE 0.645279 TO MAX-RANGE. IF1174.2 +093600 F-LOG10-TEST-29. IF1174.2 +093700 COMPUTE WS-NUM = FUNCTION LOG10(E + 1.7). IF1174.2 +093800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +093900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +094000 PERFORM PASS IF1174.2 +094100 ELSE IF1174.2 +094200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +094300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +094400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +094500 PERFORM FAIL. IF1174.2 +094600 GO TO F-LOG10-WRITE-29. IF1174.2 +094700 F-LOG10-DELETE-29. IF1174.2 +094800 PERFORM DE-LETE. IF1174.2 +094900 GO TO F-LOG10-WRITE-29. IF1174.2 +095000 F-LOG10-WRITE-29. IF1174.2 +095100 MOVE "F-LOG10-29" TO PAR-NAME. IF1174.2 +095200 PERFORM PRINT-DETAIL. IF1174.2 +095300*****************TEST (n) - COMPLEX TEST**************** IF1174.2 +095400 F-LOG10-30. IF1174.2 +095500 MOVE ZERO TO WS-NUM. IF1174.2 +095600 MOVE 4.84490 TO MIN-RANGE. IF1174.2 +095700 MOVE 4.84529 TO MAX-RANGE. IF1174.2 +095800 F-LOG10-TEST-30. IF1174.2 +095900 COMPUTE WS-NUM = FUNCTION LOG10(B) + 4. IF1174.2 +096000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +096100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +096200 PERFORM PASS IF1174.2 +096300 ELSE IF1174.2 +096400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +096500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +096600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +096700 PERFORM FAIL. IF1174.2 +096800 GO TO F-LOG10-WRITE-30. IF1174.2 +096900 F-LOG10-DELETE-30. IF1174.2 +097000 PERFORM DE-LETE. IF1174.2 +097100 GO TO F-LOG10-WRITE-30. IF1174.2 +097200 F-LOG10-WRITE-30. IF1174.2 +097300 MOVE "F-LOG10-30" TO PAR-NAME. IF1174.2 +097400 PERFORM PRINT-DETAIL. IF1174.2 +097500*****************TEST (o) - COMPLEX TEST**************** IF1174.2 +097600 F-LOG10-31. IF1174.2 +097700 MOVE ZERO TO WS-NUM. IF1174.2 +097800 MOVE -0.521411 TO MIN-RANGE. IF1174.2 +097900 MOVE -0.521369 TO MAX-RANGE. IF1174.2 +098000 F-LOG10-TEST-31. IF1174.2 +098100 COMPUTE WS-NUM = FUNCTION LOG10(FUNCTION LOG10(2)). IF1174.2 +098200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +098300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +098400 PERFORM PASS IF1174.2 +098500 ELSE IF1174.2 +098600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +098700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +098800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +098900 PERFORM FAIL. IF1174.2 +099000 GO TO F-LOG10-WRITE-31. IF1174.2 +099100 F-LOG10-DELETE-31. IF1174.2 +099200 PERFORM DE-LETE. IF1174.2 +099300 GO TO F-LOG10-WRITE-31. IF1174.2 +099400 F-LOG10-WRITE-31. IF1174.2 +099500 MOVE "F-LOG10-31" TO PAR-NAME. IF1174.2 +099600 PERFORM PRINT-DETAIL. IF1174.2 +099700*****************TEST (p) - COMPLEX TEST**************** IF1174.2 +099800 F-LOG10-32. IF1174.2 +099900 MOVE ZERO TO WS-NUM. IF1174.2 +100000 MOVE -0.000040 TO MIN-RANGE. IF1174.2 +100100 MOVE 0.000040 TO MAX-RANGE. IF1174.2 +100200 F-LOG10-TEST-32. IF1174.2 +100300 COMPUTE WS-NUM = FUNCTION LOG10(1) + IF1174.2 +100400 FUNCTION LOG10(1). IF1174.2 +100500 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +100600 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +100700 PERFORM PASS IF1174.2 +100800 ELSE IF1174.2 +100900 MOVE WS-NUM TO COMPUTED-N IF1174.2 +101000 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +101100 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +101200 PERFORM FAIL. IF1174.2 +101300 GO TO F-LOG10-WRITE-32. IF1174.2 +101400 F-LOG10-DELETE-32. IF1174.2 +101500 PERFORM DE-LETE. IF1174.2 +101600 GO TO F-LOG10-WRITE-32. IF1174.2 +101700 F-LOG10-WRITE-32. IF1174.2 +101800 MOVE "F-LOG10-32" TO PAR-NAME. IF1174.2 +101900 PERFORM PRINT-DETAIL. IF1174.2 +102000*****************SPECIAL PERFORM TEST********************** IF1174.2 +102100 F-LOG10-33. IF1174.2 +102200 PERFORM F-LOG10-TEST-33 IF1174.2 +102300 UNTIL FUNCTION LOG10(ARG1) < 0.30. IF1174.2 +102400 PERFORM PASS. IF1174.2 +102500 GO TO F-LOG10-WRITE-33. IF1174.2 +102600 F-LOG10-TEST-33. IF1174.2 +102700 COMPUTE ARG1 = ARG1 - 1.00. IF1174.2 +102800 F-LOG10-DELETE-33. IF1174.2 +102900 PERFORM DE-LETE. IF1174.2 +103000 GO TO F-LOG10-WRITE-33. IF1174.2 +103100 F-LOG10-WRITE-33. IF1174.2 +103200 MOVE "F-LOG10-33" TO PAR-NAME. IF1174.2 +103300 PERFORM PRINT-DETAIL. IF1174.2 +103400********************END OF TESTS*************** IF1174.2 +103500 CCVS-EXIT SECTION. IF1174.2 +103600 CCVS-999999. IF1174.2 +103700 GO TO CLOSE-FILES. IF1174.2 +*END-OF,IF117A +*HEADER,COBOL,IF118A +000100 IDENTIFICATION DIVISION. IF1184.2 +000200 PROGRAM-ID. IF1184.2 +000300 IF118A. IF1184.2 +000400 IF1184.2 +000500*********************************************************** IF1184.2 +000600* * IF1184.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1184.2 +000800* It contains tests for the Intrinsic Function * IF1184.2 +000900* LOWER-CASE. * IF1184.2 +001000* * IF1184.2 +001100*********************************************************** IF1184.2 +001200 ENVIRONMENT DIVISION. IF1184.2 +001300 CONFIGURATION SECTION. IF1184.2 +001400 SOURCE-COMPUTER. IF1184.2 +001500 XXXXX082. IF1184.2 +001600 OBJECT-COMPUTER. IF1184.2 +001700 XXXXX083. IF1184.2 +001800 INPUT-OUTPUT SECTION. IF1184.2 +001900 FILE-CONTROL. IF1184.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1184.2 +002100 XXXXX055. IF1184.2 +002200 DATA DIVISION. IF1184.2 +002300 FILE SECTION. IF1184.2 +002400 FD PRINT-FILE. IF1184.2 +002500 01 PRINT-REC PICTURE X(120). IF1184.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1184.2 +002700 WORKING-STORAGE SECTION. IF1184.2 +002800*********************************************************** IF1184.2 +002900* Variables specific to the Intrinsic Function Test IF118A* IF1184.2 +003000*********************************************************** IF1184.2 +003100 01 A PIC A(10) VALUE "tumble". IF1184.2 +003200 01 B PIC A(10) VALUE "WEED". IF1184.2 +003300 01 C PIC X(10) VALUE "Was". IF1184.2 +003400 01 D PIC X(10) VALUE "4". IF1184.2 +003500 01 E PIC X(10) VALUE "And4". IF1184.2 +003600 01 TEMP PIC S9(10). IF1184.2 +003700 01 WS-ANUM PIC X(10). IF1184.2 +003800* IF1184.2 +003900********************************************************** IF1184.2 +004000* IF1184.2 +004100 01 TEST-RESULTS. IF1184.2 +004200 02 FILLER PIC X VALUE SPACE. IF1184.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1184.2 +004400 02 FILLER PIC X VALUE SPACE. IF1184.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1184.2 +004600 02 FILLER PIC X VALUE SPACE. IF1184.2 +004700 02 PAR-NAME. IF1184.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1184.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1184.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1184.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1184.2 +005200 02 RE-MARK PIC X(61). IF1184.2 +005300 01 TEST-COMPUTED. IF1184.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1184.2 +005500 02 FILLER PIC X(17) VALUE IF1184.2 +005600 " COMPUTED=". IF1184.2 +005700 02 COMPUTED-X. IF1184.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1184.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1184.2 +006000 PIC -9(9).9(9). IF1184.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1184.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1184.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1184.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1184.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1184.2 +006600 04 FILLER PIC X. IF1184.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1184.2 +006800 01 TEST-CORRECT. IF1184.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1184.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1184.2 +007100 02 CORRECT-X. IF1184.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1184.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1184.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1184.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1184.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1184.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1184.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1184.2 +007900 04 FILLER PIC X. IF1184.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1184.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1184.2 +008200 01 CCVS-C-1. IF1184.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1184.2 +008400- "SS PARAGRAPH-NAME IF1184.2 +008500- " REMARKS". IF1184.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1184.2 +008700 01 CCVS-C-2. IF1184.2 +008800 02 FILLER PIC X VALUE SPACE. IF1184.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1184.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1184.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1184.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1184.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1184.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1184.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1184.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1184.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1184.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1184.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1184.2 +010400 01 CCVS-H-1. IF1184.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1184.2 +010600 02 FILLER PIC X(42) VALUE IF1184.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1184.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1184.2 +010900 01 CCVS-H-2A. IF1184.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1184.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1184.2 +011200 02 FILLER PIC XXXX VALUE IF1184.2 +011300 "4.2 ". IF1184.2 +011400 02 FILLER PIC X(28) VALUE IF1184.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1184.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1184.2 +011700 IF1184.2 +011800 01 CCVS-H-2B. IF1184.2 +011900 02 FILLER PIC X(15) VALUE IF1184.2 +012000 "TEST RESULT OF ". IF1184.2 +012100 02 TEST-ID PIC X(9). IF1184.2 +012200 02 FILLER PIC X(4) VALUE IF1184.2 +012300 " IN ". IF1184.2 +012400 02 FILLER PIC X(12) VALUE IF1184.2 +012500 " HIGH ". IF1184.2 +012600 02 FILLER PIC X(22) VALUE IF1184.2 +012700 " LEVEL VALIDATION FOR ". IF1184.2 +012800 02 FILLER PIC X(58) VALUE IF1184.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1184.2 +013000 01 CCVS-H-3. IF1184.2 +013100 02 FILLER PIC X(34) VALUE IF1184.2 +013200 " FOR OFFICIAL USE ONLY ". IF1184.2 +013300 02 FILLER PIC X(58) VALUE IF1184.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1184.2 +013500 02 FILLER PIC X(28) VALUE IF1184.2 +013600 " COPYRIGHT 1985 ". IF1184.2 +013700 01 CCVS-E-1. IF1184.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1184.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1184.2 +014000 02 ID-AGAIN PIC X(9). IF1184.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1184.2 +014200 01 CCVS-E-2. IF1184.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1184.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1184.2 +014500 02 CCVS-E-2-2. IF1184.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1184.2 +014700 03 FILLER PIC X VALUE SPACE. IF1184.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1184.2 +014900 "ERRORS ENCOUNTERED". IF1184.2 +015000 01 CCVS-E-3. IF1184.2 +015100 02 FILLER PIC X(22) VALUE IF1184.2 +015200 " FOR OFFICIAL USE ONLY". IF1184.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1184.2 +015400 02 FILLER PIC X(58) VALUE IF1184.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1184.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1184.2 +015700 02 FILLER PIC X(15) VALUE IF1184.2 +015800 " COPYRIGHT 1985". IF1184.2 +015900 01 CCVS-E-4. IF1184.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1184.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1184.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1184.2 +016300 02 FILLER PIC X(40) VALUE IF1184.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1184.2 +016500 01 XXINFO. IF1184.2 +016600 02 FILLER PIC X(19) VALUE IF1184.2 +016700 "*** INFORMATION ***". IF1184.2 +016800 02 INFO-TEXT. IF1184.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1184.2 +017000 04 XXCOMPUTED PIC X(20). IF1184.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1184.2 +017200 04 XXCORRECT PIC X(20). IF1184.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1184.2 +017400 01 HYPHEN-LINE. IF1184.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1184.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1184.2 +017700- "*****************************************". IF1184.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1184.2 +017900- "******************************". IF1184.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1184.2 +018100 "IF118A". IF1184.2 +018200 PROCEDURE DIVISION. IF1184.2 +018300 CCVS1 SECTION. IF1184.2 +018400 OPEN-FILES. IF1184.2 +018500 OPEN OUTPUT PRINT-FILE. IF1184.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1184.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1184.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1184.2 +018900 GO TO CCVS1-EXIT. IF1184.2 +019000 CLOSE-FILES. IF1184.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1184.2 +019200 TERMINATE-CCVS. IF1184.2 +019300 STOP RUN. IF1184.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1184.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1184.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1184.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1184.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1184.2 +019900 PRINT-DETAIL. IF1184.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1184.2 +020100 MOVE "." TO PARDOT-X IF1184.2 +020200 MOVE REC-CT TO DOTVALUE. IF1184.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1184.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1184.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1184.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1184.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1184.2 +020800 MOVE SPACE TO CORRECT-X. IF1184.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1184.2 +021000 MOVE SPACE TO RE-MARK. IF1184.2 +021100 HEAD-ROUTINE. IF1184.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1184.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1184.2 +021600 COLUMN-NAMES-ROUTINE. IF1184.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +022000 END-ROUTINE. IF1184.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1184.2 +022200 END-RTN-EXIT. IF1184.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +022400 END-ROUTINE-1. IF1184.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1184.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1184.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1184.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1184.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1184.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1184.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1184.2 +023200 END-ROUTINE-12. IF1184.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1184.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1184.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1184.2 +023600 ELSE IF1184.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1184.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1184.2 +023900 PERFORM WRITE-LINE. IF1184.2 +024000 END-ROUTINE-13. IF1184.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1184.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1184.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1184.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1184.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1184.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1184.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1184.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1184.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +025200 WRITE-LINE. IF1184.2 +025300 ADD 1 TO RECORD-COUNT. IF1184.2 +025400Y IF RECORD-COUNT GREATER 42 IF1184.2 +025500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1184.2 +025600Y MOVE SPACE TO DUMMY-RECORD IF1184.2 +025700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1184.2 +025800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1184.2 +025900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1184.2 +026000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1184.2 +026100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1184.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1184.2 +026600Y MOVE ZERO TO RECORD-COUNT. IF1184.2 +026700 PERFORM WRT-LN. IF1184.2 +026800 WRT-LN. IF1184.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1184.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1184.2 +027100 BLANK-LINE-PRINT. IF1184.2 +027200 PERFORM WRT-LN. IF1184.2 +027300 FAIL-ROUTINE. IF1184.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1184.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1184.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1184.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1184.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1184.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1184.2 +028100 GO TO FAIL-ROUTINE-EX. IF1184.2 +028200 FAIL-ROUTINE-WRITE. IF1184.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1184.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1184.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1184.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1184.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1184.2 +028800 BAIL-OUT. IF1184.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1184.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1184.2 +029100 BAIL-OUT-WRITE. IF1184.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1184.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1184.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1184.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1184.2 +029700 BAIL-OUT-EX. EXIT. IF1184.2 +029800 CCVS1-EXIT. IF1184.2 +029900 EXIT. IF1184.2 +030000******************************************************** IF1184.2 +030100* * IF1184.2 +030200* Intrinsic Function Tests IF118A - LOWCASE * IF1184.2 +030300* * IF1184.2 +030400******************************************************** IF1184.2 +030500 SECT-IF118A SECTION. IF1184.2 +030600 F-LOWCASE-INFO. IF1184.2 +030700 MOVE "See ref. A-51 2.22" TO ANSI-REFERENCE. IF1184.2 +030800 MOVE "LOWER-CASE Function" TO FEATURE. IF1184.2 +030900*****************TEST (a) ****************************** IF1184.2 +031000 F-LOWCASE-01. IF1184.2 +031100 MOVE SPACES TO WS-ANUM. IF1184.2 +031200 F-LOWCASE-TEST-01. IF1184.2 +031300 MOVE FUNCTION LOWER-CASE("figure") TO WS-ANUM. IF1184.2 +031400 IF WS-ANUM = "figure" THEN IF1184.2 +031500 PERFORM PASS IF1184.2 +031600 ELSE IF1184.2 +031700 MOVE "figure" TO CORRECT-A IF1184.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +031900 PERFORM FAIL. IF1184.2 +032000 GO TO F-LOWCASE-WRITE-01. IF1184.2 +032100 F-LOWCASE-DELETE-01. IF1184.2 +032200 PERFORM DE-LETE. IF1184.2 +032300 GO TO F-LOWCASE-WRITE-01. IF1184.2 +032400 F-LOWCASE-WRITE-01. IF1184.2 +032500 MOVE "F-LOWCASE-01" TO PAR-NAME. IF1184.2 +032600 PERFORM PRINT-DETAIL. IF1184.2 +032700*****************TEST (b) ****************************** IF1184.2 +032800 F-LOWCASE-TEST-02. IF1184.2 +032900 MOVE FUNCTION LOWER-CASE("CAPS") TO WS-ANUM. IF1184.2 +033000 IF WS-ANUM = "caps" THEN IF1184.2 +033100 PERFORM PASS IF1184.2 +033200 ELSE IF1184.2 +033300 PERFORM FAIL. IF1184.2 +033400 GO TO F-LOWCASE-WRITE-02. IF1184.2 +033500 F-LOWCASE-DELETE-02. IF1184.2 +033600 PERFORM DE-LETE. IF1184.2 +033700 GO TO F-LOWCASE-WRITE-02. IF1184.2 +033800 F-LOWCASE-WRITE-02. IF1184.2 +033900 MOVE "F-LOWCASE-02" TO PAR-NAME. IF1184.2 +034000 PERFORM PRINT-DETAIL. IF1184.2 +034100*****************TEST (c) ****************************** IF1184.2 +034200 F-LOWCASE-03. IF1184.2 +034300 MOVE SPACES TO WS-ANUM. IF1184.2 +034400 F-LOWCASE-TEST-03. IF1184.2 +034500 IF FUNCTION LOWER-CASE("highnLOW") = "highnlow" THEN IF1184.2 +034600 PERFORM PASS IF1184.2 +034700 ELSE IF1184.2 +034800 MOVE "highnlow" TO CORRECT-A IF1184.2 +034900 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +035000 PERFORM FAIL. IF1184.2 +035100 GO TO F-LOWCASE-WRITE-03. IF1184.2 +035200 F-LOWCASE-DELETE-03. IF1184.2 +035300 PERFORM DE-LETE. IF1184.2 +035400 GO TO F-LOWCASE-WRITE-03. IF1184.2 +035500 F-LOWCASE-WRITE-03. IF1184.2 +035600 MOVE "F-LOWCASE-03" TO PAR-NAME. IF1184.2 +035700 PERFORM PRINT-DETAIL. IF1184.2 +035800*****************TEST (d) ****************************** IF1184.2 +035900 F-LOWCASE-04. IF1184.2 +036000 MOVE SPACES TO WS-ANUM. IF1184.2 +036100 F-LOWCASE-TEST-04. IF1184.2 +036200 MOVE FUNCTION LOWER-CASE("95") TO WS-ANUM. IF1184.2 +036300 IF WS-ANUM = "95" THEN IF1184.2 +036400 PERFORM PASS IF1184.2 +036500 ELSE IF1184.2 +036600 MOVE "95" TO CORRECT-A IF1184.2 +036700 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +036800 PERFORM FAIL. IF1184.2 +036900 GO TO F-LOWCASE-WRITE-04. IF1184.2 +037000 F-LOWCASE-DELETE-04. IF1184.2 +037100 PERFORM DE-LETE. IF1184.2 +037200 GO TO F-LOWCASE-WRITE-04. IF1184.2 +037300 F-LOWCASE-WRITE-04. IF1184.2 +037400 MOVE "F-LOWCASE-04" TO PAR-NAME. IF1184.2 +037500 PERFORM PRINT-DETAIL. IF1184.2 +037600*****************TEST (e) ****************************** IF1184.2 +037700 F-LOWCASE-05. IF1184.2 +037800 MOVE SPACES TO WS-ANUM. IF1184.2 +037900 F-LOWCASE-TEST-05. IF1184.2 +038000 MOVE FUNCTION LOWER-CASE("8isaNUMBER") TO WS-ANUM. IF1184.2 +038100 IF WS-ANUM = "8isanumber" THEN IF1184.2 +038200 PERFORM PASS IF1184.2 +038300 ELSE IF1184.2 +038400 MOVE "8isanumber" TO CORRECT-A IF1184.2 +038500 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +038600 PERFORM FAIL. IF1184.2 +038700 GO TO F-LOWCASE-WRITE-05. IF1184.2 +038800 F-LOWCASE-DELETE-05. IF1184.2 +038900 PERFORM DE-LETE. IF1184.2 +039000 GO TO F-LOWCASE-WRITE-05. IF1184.2 +039100 F-LOWCASE-WRITE-05. IF1184.2 +039200 MOVE "F-LOWCASE-05" TO PAR-NAME. IF1184.2 +039300 PERFORM PRINT-DETAIL. IF1184.2 +039400*****************TEST (f) ****************************** IF1184.2 +039500 F-LOWCASE-06. IF1184.2 +039600 MOVE SPACES TO WS-ANUM. IF1184.2 +039700 F-LOWCASE-TEST-06. IF1184.2 +039800 MOVE FUNCTION LOWER-CASE(A) TO WS-ANUM. IF1184.2 +039900 IF WS-ANUM = "tumble" THEN IF1184.2 +040000 PERFORM PASS IF1184.2 +040100 ELSE IF1184.2 +040200 MOVE "tumble" TO CORRECT-A IF1184.2 +040300 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +040400 PERFORM FAIL. IF1184.2 +040500 GO TO F-LOWCASE-WRITE-06. IF1184.2 +040600 F-LOWCASE-DELETE-06. IF1184.2 +040700 PERFORM DE-LETE. IF1184.2 +040800 GO TO F-LOWCASE-WRITE-06. IF1184.2 +040900 F-LOWCASE-WRITE-06. IF1184.2 +041000 MOVE "F-LOWCASE-06" TO PAR-NAME. IF1184.2 +041100 PERFORM PRINT-DETAIL. IF1184.2 +041200*****************TEST (g) ****************************** IF1184.2 +041300 F-LOWCASE-07. IF1184.2 +041400 MOVE SPACES TO WS-ANUM. IF1184.2 +041500 F-LOWCASE-TEST-07. IF1184.2 +041600 MOVE FUNCTION LOWER-CASE(B) TO WS-ANUM. IF1184.2 +041700 IF WS-ANUM = "weed" THEN IF1184.2 +041800 PERFORM PASS IF1184.2 +041900 ELSE IF1184.2 +042000 MOVE "weed" TO CORRECT-A IF1184.2 +042100 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +042200 PERFORM FAIL. IF1184.2 +042300 GO TO F-LOWCASE-WRITE-07. IF1184.2 +042400 F-LOWCASE-DELETE-07. IF1184.2 +042500 PERFORM DE-LETE. IF1184.2 +042600 GO TO F-LOWCASE-WRITE-07. IF1184.2 +042700 F-LOWCASE-WRITE-07. IF1184.2 +042800 MOVE "F-LOWCASE-07" TO PAR-NAME. IF1184.2 +042900 PERFORM PRINT-DETAIL. IF1184.2 +043000*****************TEST (h) ****************************** IF1184.2 +043100 F-LOWCASE-08. IF1184.2 +043200 MOVE SPACES TO WS-ANUM. IF1184.2 +043300 F-LOWCASE-TEST-08. IF1184.2 +043400 MOVE FUNCTION LOWER-CASE(C) TO WS-ANUM. IF1184.2 +043500 IF WS-ANUM = "was" THEN IF1184.2 +043600 PERFORM PASS IF1184.2 +043700 ELSE IF1184.2 +043800 MOVE "was" TO CORRECT-A IF1184.2 +043900 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +044000 PERFORM FAIL. IF1184.2 +044100 GO TO F-LOWCASE-WRITE-08. IF1184.2 +044200 F-LOWCASE-DELETE-08. IF1184.2 +044300 PERFORM DE-LETE. IF1184.2 +044400 GO TO F-LOWCASE-WRITE-08. IF1184.2 +044500 F-LOWCASE-WRITE-08. IF1184.2 +044600 MOVE "F-LOWCASE-08" TO PAR-NAME. IF1184.2 +044700 PERFORM PRINT-DETAIL. IF1184.2 +044800*****************TEST (i) ****************************** IF1184.2 +044900 F-LOWCASE-09. IF1184.2 +045000 MOVE SPACES TO WS-ANUM. IF1184.2 +045100 F-LOWCASE-TEST-09. IF1184.2 +045200 MOVE FUNCTION LOWER-CASE(D) TO WS-ANUM. IF1184.2 +045300 IF WS-ANUM = "4" THEN IF1184.2 +045400 PERFORM PASS IF1184.2 +045500 ELSE IF1184.2 +045600 MOVE "4" TO CORRECT-A IF1184.2 +045700 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +045800 PERFORM FAIL. IF1184.2 +045900 GO TO F-LOWCASE-WRITE-09. IF1184.2 +046000 F-LOWCASE-DELETE-09. IF1184.2 +046100 PERFORM DE-LETE. IF1184.2 +046200 GO TO F-LOWCASE-WRITE-09. IF1184.2 +046300 F-LOWCASE-WRITE-09. IF1184.2 +046400 MOVE "F-LOWCASE-09" TO PAR-NAME. IF1184.2 +046500 PERFORM PRINT-DETAIL. IF1184.2 +046600*****************TEST (j) ****************************** IF1184.2 +046700 F-LOWCASE-10. IF1184.2 +046800 MOVE SPACES TO WS-ANUM. IF1184.2 +046900 F-LOWCASE-TEST-10. IF1184.2 +047000 MOVE FUNCTION LOWER-CASE(E) TO WS-ANUM. IF1184.2 +047100 IF WS-ANUM = "and4" THEN IF1184.2 +047200 PERFORM PASS IF1184.2 +047300 ELSE IF1184.2 +047400 MOVE "and4" TO CORRECT-A IF1184.2 +047500 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +047600 PERFORM FAIL. IF1184.2 +047700 GO TO F-LOWCASE-WRITE-10. IF1184.2 +047800 F-LOWCASE-DELETE-10. IF1184.2 +047900 PERFORM DE-LETE. IF1184.2 +048000 GO TO F-LOWCASE-WRITE-10. IF1184.2 +048100 F-LOWCASE-WRITE-10. IF1184.2 +048200 MOVE "F-LOWCASE-10" TO PAR-NAME. IF1184.2 +048300 PERFORM PRINT-DETAIL. IF1184.2 +048400*****************TEST (k) ****************************** IF1184.2 +048500 F-LOWCASE-11. IF1184.2 +048600 MOVE ZERO TO TEMP. IF1184.2 +048700 F-LOWCASE-TEST-11. IF1184.2 +048800 IF IF1184.2 +048900 FUNCTION LENGTH(FUNCTION LOWER-CASE("GIZZARD")) + 2 = 9 IF1184.2 +049000 THEN IF1184.2 +049100 PERFORM PASS IF1184.2 +049200 ELSE IF1184.2 +049300 MOVE 9 TO CORRECT-N IF1184.2 +049400 MOVE TEMP TO COMPUTED-N IF1184.2 +049500 PERFORM FAIL. IF1184.2 +049600 GO TO F-LOWCASE-WRITE-11. IF1184.2 +049700 F-LOWCASE-DELETE-11. IF1184.2 +049800 PERFORM DE-LETE. IF1184.2 +049900 GO TO F-LOWCASE-WRITE-11. IF1184.2 +050000 F-LOWCASE-WRITE-11. IF1184.2 +050100 MOVE "F-LOWCASE-11" TO PAR-NAME. IF1184.2 +050200 PERFORM PRINT-DETAIL. IF1184.2 +050300*****************TEST (l) ****************************** IF1184.2 +050400 F-LOWCASE-12. IF1184.2 +050500 MOVE SPACES TO WS-ANUM. IF1184.2 +050600 F-LOWCASE-TEST-12. IF1184.2 +050700 MOVE FUNCTION LOWER-CASE(FUNCTION LOWER-CASE("giZZard")) IF1184.2 +050800 TO WS-ANUM. IF1184.2 +050900 IF WS-ANUM = "gizzard" THEN IF1184.2 +051000 PERFORM PASS IF1184.2 +051100 ELSE IF1184.2 +051200 MOVE "gizzard" TO CORRECT-A IF1184.2 +051300 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +051400 PERFORM FAIL. IF1184.2 +051500 GO TO F-LOWCASE-WRITE-12. IF1184.2 +051600 F-LOWCASE-DELETE-12. IF1184.2 +051700 PERFORM DE-LETE. IF1184.2 +051800 GO TO F-LOWCASE-WRITE-12. IF1184.2 +051900 F-LOWCASE-WRITE-12. IF1184.2 +052000 MOVE "F-LOWCASE-12" TO PAR-NAME. IF1184.2 +052100 PERFORM PRINT-DETAIL. IF1184.2 +052200*****************TEST (m) ****************************** IF1184.2 +052300 F-LOWCASE-13. IF1184.2 +052400 MOVE ZERO TO TEMP. IF1184.2 +052500 F-LOWCASE-TEST-13. IF1184.2 +052600 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION LOWER-CASE("HOME")) IF1184.2 +052700 + FUNCTION LENGTH(FUNCTION LOWER-CASE("HOME")). IF1184.2 +052800 IF TEMP = 8 THEN IF1184.2 +052900 PERFORM PASS IF1184.2 +053000 ELSE IF1184.2 +053100 MOVE 8 TO CORRECT-N IF1184.2 +053200 MOVE TEMP TO COMPUTED-N IF1184.2 +053300 PERFORM FAIL. IF1184.2 +053400 GO TO F-LOWCASE-WRITE-13. IF1184.2 +053500 F-LOWCASE-DELETE-13. IF1184.2 +053600 PERFORM DE-LETE. IF1184.2 +053700 GO TO F-LOWCASE-WRITE-13. IF1184.2 +053800 F-LOWCASE-WRITE-13. IF1184.2 +053900 MOVE "F-LOWCASE-13" TO PAR-NAME. IF1184.2 +054000 PERFORM PRINT-DETAIL. IF1184.2 +054100*******************END OF TESTS************************** IF1184.2 +054200 CCVS-EXIT SECTION. IF1184.2 +054300 CCVS-999999. IF1184.2 +054400 GO TO CLOSE-FILES. IF1184.2 +*END-OF,IF118A +*HEADER,COBOL,IF119A +000100 IDENTIFICATION DIVISION. IF1194.2 +000200 PROGRAM-ID. IF1194.2 +000300 IF119A. IF1194.2 +000400 IF1194.2 +000500*********************************************************** IF1194.2 +000600* * IF1194.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1194.2 +000800* It contains tests for the Intrinsic Function MAX. * IF1194.2 +000900* * IF1194.2 +001000*********************************************************** IF1194.2 +001100 ENVIRONMENT DIVISION. IF1194.2 +001200 CONFIGURATION SECTION. IF1194.2 +001300 SOURCE-COMPUTER. IF1194.2 +001400 XXXXX082. IF1194.2 +001500 OBJECT-COMPUTER. IF1194.2 +001600 XXXXX083 IF1194.2 +001700 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1194.2 +001800 SPECIAL-NAMES. IF1194.2 +001900 ALPHABET PRG-COLL-SEQ IS IF1194.2 +002000 STANDARD-2. IF1194.2 +002100 INPUT-OUTPUT SECTION. IF1194.2 +002200 FILE-CONTROL. IF1194.2 +002300 SELECT PRINT-FILE ASSIGN TO IF1194.2 +002400 XXXXX055. IF1194.2 +002500 DATA DIVISION. IF1194.2 +002600 FILE SECTION. IF1194.2 +002700 FD PRINT-FILE. IF1194.2 +002800 01 PRINT-REC PICTURE X(120). IF1194.2 +002900 01 DUMMY-RECORD PICTURE X(120). IF1194.2 +003000 WORKING-STORAGE SECTION. IF1194.2 +003100*********************************************************** IF1194.2 +003200* Variables specific to the Intrinsic Function Test IF119A* IF1194.2 +003300*********************************************************** IF1194.2 +003400 01 A PIC S9(10) VALUE 5. IF1194.2 +003500 01 B PIC S9(10) VALUE 7. IF1194.2 +003600 01 C PIC S9(10) VALUE -4. IF1194.2 +003700 01 D PIC S9(10) VALUE 10. IF1194.2 +003800 01 E PIC S9(5)V9(5) VALUE 34.26. IF1194.2 +003900 01 F PIC S9(5)V9(5) VALUE -8.32. IF1194.2 +004000 01 G PIC S9(5)V9(5) VALUE 4.08. IF1194.2 +004100 01 H PIC S9(5)V9(5) VALUE -5.3. IF1194.2 +004200 01 I PIC X VALUE "R". IF1194.2 +004300 01 J PIC X VALUE "U". IF1194.2 +004400 01 M PIC S9(10) VALUE 1. IF1194.2 +004500 01 N PIC S9(10) VALUE 3. IF1194.2 +004600 01 O PIC S9(10) VALUE 5. IF1194.2 +004700 01 ARG1 PIC S9(10) VALUE 1. IF1194.2 +004800 01 ARR VALUE "40537". IF1194.2 +004900 02 IND OCCURS 5 TIMES PIC 9. IF1194.2 +005000 01 TEMP PIC S9(10). IF1194.2 +005100 01 WS-NUM PIC S9(6)V9(6). IF1194.2 +005200 01 WS-ANUM PIC X. IF1194.2 +005300 01 MIN-RANGE PIC S9(5)V9(7). IF1194.2 +005400 01 MAX-RANGE PIC S9(5)V9(7). IF1194.2 +005500* IF1194.2 +005600********************************************************** IF1194.2 +005700* IF1194.2 +005800 01 TEST-RESULTS. IF1194.2 +005900 02 FILLER PIC X VALUE SPACE. IF1194.2 +006000 02 FEATURE PIC X(20) VALUE SPACE. IF1194.2 +006100 02 FILLER PIC X VALUE SPACE. IF1194.2 +006200 02 P-OR-F PIC X(5) VALUE SPACE. IF1194.2 +006300 02 FILLER PIC X VALUE SPACE. IF1194.2 +006400 02 PAR-NAME. IF1194.2 +006500 03 FILLER PIC X(19) VALUE SPACE. IF1194.2 +006600 03 PARDOT-X PIC X VALUE SPACE. IF1194.2 +006700 03 DOTVALUE PIC 99 VALUE ZERO. IF1194.2 +006800 02 FILLER PIC X(8) VALUE SPACE. IF1194.2 +006900 02 RE-MARK PIC X(61). IF1194.2 +007000 01 TEST-COMPUTED. IF1194.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +007200 02 FILLER PIC X(17) VALUE IF1194.2 +007300 " COMPUTED=". IF1194.2 +007400 02 COMPUTED-X. IF1194.2 +007500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1194.2 +007600 03 COMPUTED-N REDEFINES COMPUTED-A IF1194.2 +007700 PIC -9(9).9(9). IF1194.2 +007800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1194.2 +007900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1194.2 +008000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1194.2 +008100 03 CM-18V0 REDEFINES COMPUTED-A. IF1194.2 +008200 04 COMPUTED-18V0 PIC -9(18). IF1194.2 +008300 04 FILLER PIC X. IF1194.2 +008400 03 FILLER PIC X(50) VALUE SPACE. IF1194.2 +008500 01 TEST-CORRECT. IF1194.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +008700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1194.2 +008800 02 CORRECT-X. IF1194.2 +008900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1194.2 +009000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1194.2 +009100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1194.2 +009200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1194.2 +009300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1194.2 +009400 03 CR-18V0 REDEFINES CORRECT-A. IF1194.2 +009500 04 CORRECT-18V0 PIC -9(18). IF1194.2 +009600 04 FILLER PIC X. IF1194.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +009800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1194.2 +009900 01 TEST-CORRECT-MIN. IF1194.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +010100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1194.2 +010200 02 CORRECTMI-X. IF1194.2 +010300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1194.2 +010400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1194.2 +010500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1194.2 +010600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1194.2 +010700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1194.2 +010800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1194.2 +010900 04 CORRECTMI-18V0 PIC -9(18). IF1194.2 +011000 04 FILLER PIC X. IF1194.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +011200 03 FILLER PIC X(48) VALUE SPACE. IF1194.2 +011300 01 TEST-CORRECT-MAX. IF1194.2 +011400 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +011500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1194.2 +011600 02 CORRECTMA-X. IF1194.2 +011700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1194.2 +011800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1194.2 +011900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1194.2 +012000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1194.2 +012100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1194.2 +012200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1194.2 +012300 04 CORRECTMA-18V0 PIC -9(18). IF1194.2 +012400 04 FILLER PIC X. IF1194.2 +012500 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +012600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1194.2 +012700 01 CCVS-C-1. IF1194.2 +012800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1194.2 +012900- "SS PARAGRAPH-NAME IF1194.2 +013000- " REMARKS". IF1194.2 +013100 02 FILLER PIC X(20) VALUE SPACE. IF1194.2 +013200 01 CCVS-C-2. IF1194.2 +013300 02 FILLER PIC X VALUE SPACE. IF1194.2 +013400 02 FILLER PIC X(6) VALUE "TESTED". IF1194.2 +013500 02 FILLER PIC X(15) VALUE SPACE. IF1194.2 +013600 02 FILLER PIC X(4) VALUE "FAIL". IF1194.2 +013700 02 FILLER PIC X(94) VALUE SPACE. IF1194.2 +013800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1194.2 +013900 01 REC-CT PIC 99 VALUE ZERO. IF1194.2 +014000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1194.2 +014500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1194.2 +014600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1194.2 +014700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1194.2 +014800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1194.2 +014900 01 CCVS-H-1. IF1194.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1194.2 +015100 02 FILLER PIC X(42) VALUE IF1194.2 +015200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1194.2 +015300 02 FILLER PIC X(39) VALUE SPACES. IF1194.2 +015400 01 CCVS-H-2A. IF1194.2 +015500 02 FILLER PIC X(40) VALUE SPACE. IF1194.2 +015600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1194.2 +015700 02 FILLER PIC XXXX VALUE IF1194.2 +015800 "4.2 ". IF1194.2 +015900 02 FILLER PIC X(28) VALUE IF1194.2 +016000 " COPY - NOT FOR DISTRIBUTION". IF1194.2 +016100 02 FILLER PIC X(41) VALUE SPACE. IF1194.2 +016200 IF1194.2 +016300 01 CCVS-H-2B. IF1194.2 +016400 02 FILLER PIC X(15) VALUE IF1194.2 +016500 "TEST RESULT OF ". IF1194.2 +016600 02 TEST-ID PIC X(9). IF1194.2 +016700 02 FILLER PIC X(4) VALUE IF1194.2 +016800 " IN ". IF1194.2 +016900 02 FILLER PIC X(12) VALUE IF1194.2 +017000 " HIGH ". IF1194.2 +017100 02 FILLER PIC X(22) VALUE IF1194.2 +017200 " LEVEL VALIDATION FOR ". IF1194.2 +017300 02 FILLER PIC X(58) VALUE IF1194.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1194.2 +017500 01 CCVS-H-3. IF1194.2 +017600 02 FILLER PIC X(34) VALUE IF1194.2 +017700 " FOR OFFICIAL USE ONLY ". IF1194.2 +017800 02 FILLER PIC X(58) VALUE IF1194.2 +017900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1194.2 +018000 02 FILLER PIC X(28) VALUE IF1194.2 +018100 " COPYRIGHT 1985 ". IF1194.2 +018200 01 CCVS-E-1. IF1194.2 +018300 02 FILLER PIC X(52) VALUE SPACE. IF1194.2 +018400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1194.2 +018500 02 ID-AGAIN PIC X(9). IF1194.2 +018600 02 FILLER PIC X(45) VALUE SPACES. IF1194.2 +018700 01 CCVS-E-2. IF1194.2 +018800 02 FILLER PIC X(31) VALUE SPACE. IF1194.2 +018900 02 FILLER PIC X(21) VALUE SPACE. IF1194.2 +019000 02 CCVS-E-2-2. IF1194.2 +019100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1194.2 +019200 03 FILLER PIC X VALUE SPACE. IF1194.2 +019300 03 ENDER-DESC PIC X(44) VALUE IF1194.2 +019400 "ERRORS ENCOUNTERED". IF1194.2 +019500 01 CCVS-E-3. IF1194.2 +019600 02 FILLER PIC X(22) VALUE IF1194.2 +019700 " FOR OFFICIAL USE ONLY". IF1194.2 +019800 02 FILLER PIC X(12) VALUE SPACE. IF1194.2 +019900 02 FILLER PIC X(58) VALUE IF1194.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1194.2 +020100 02 FILLER PIC X(13) VALUE SPACE. IF1194.2 +020200 02 FILLER PIC X(15) VALUE IF1194.2 +020300 " COPYRIGHT 1985". IF1194.2 +020400 01 CCVS-E-4. IF1194.2 +020500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1194.2 +020600 02 FILLER PIC X(4) VALUE " OF ". IF1194.2 +020700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1194.2 +020800 02 FILLER PIC X(40) VALUE IF1194.2 +020900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1194.2 +021000 01 XXINFO. IF1194.2 +021100 02 FILLER PIC X(19) VALUE IF1194.2 +021200 "*** INFORMATION ***". IF1194.2 +021300 02 INFO-TEXT. IF1194.2 +021400 04 FILLER PIC X(8) VALUE SPACE. IF1194.2 +021500 04 XXCOMPUTED PIC X(20). IF1194.2 +021600 04 FILLER PIC X(5) VALUE SPACE. IF1194.2 +021700 04 XXCORRECT PIC X(20). IF1194.2 +021800 02 INF-ANSI-REFERENCE PIC X(48). IF1194.2 +021900 01 HYPHEN-LINE. IF1194.2 +022000 02 FILLER PIC IS X VALUE IS SPACE. IF1194.2 +022100 02 FILLER PIC IS X(65) VALUE IS "************************IF1194.2 +022200- "*****************************************". IF1194.2 +022300 02 FILLER PIC IS X(54) VALUE IS "************************IF1194.2 +022400- "******************************". IF1194.2 +022500 01 CCVS-PGM-ID PIC X(9) VALUE IF1194.2 +022600 "IF119A". IF1194.2 +022700 PROCEDURE DIVISION. IF1194.2 +022800 CCVS1 SECTION. IF1194.2 +022900 OPEN-FILES. IF1194.2 +023000 OPEN OUTPUT PRINT-FILE. IF1194.2 +023100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1194.2 +023200 MOVE SPACE TO TEST-RESULTS. IF1194.2 +023300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1194.2 +023400 GO TO CCVS1-EXIT. IF1194.2 +023500 CLOSE-FILES. IF1194.2 +023600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1194.2 +023700 TERMINATE-CCVS. IF1194.2 +023800 STOP RUN. IF1194.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1194.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1194.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1194.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1194.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. IF1194.2 +024400 PRINT-DETAIL. IF1194.2 +024500 IF REC-CT NOT EQUAL TO ZERO IF1194.2 +024600 MOVE "." TO PARDOT-X IF1194.2 +024700 MOVE REC-CT TO DOTVALUE. IF1194.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1194.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1194.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1194.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1194.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1194.2 +025300 MOVE SPACE TO CORRECT-X. IF1194.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1194.2 +025500 MOVE SPACE TO RE-MARK. IF1194.2 +025600 HEAD-ROUTINE. IF1194.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1194.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1194.2 +026100 COLUMN-NAMES-ROUTINE. IF1194.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +026500 END-ROUTINE. IF1194.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1194.2 +026700 END-RTN-EXIT. IF1194.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +026900 END-ROUTINE-1. IF1194.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1194.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1194.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. IF1194.2 +027300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1194.2 +027400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1194.2 +027500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1194.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1194.2 +027700 END-ROUTINE-12. IF1194.2 +027800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1194.2 +027900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1194.2 +028000 MOVE "NO " TO ERROR-TOTAL IF1194.2 +028100 ELSE IF1194.2 +028200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1194.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1194.2 +028400 PERFORM WRITE-LINE. IF1194.2 +028500 END-ROUTINE-13. IF1194.2 +028600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1194.2 +028700 MOVE "NO " TO ERROR-TOTAL ELSE IF1194.2 +028800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1194.2 +028900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1194.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029100 IF INSPECT-COUNTER EQUAL TO ZERO IF1194.2 +029200 MOVE "NO " TO ERROR-TOTAL IF1194.2 +029300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1194.2 +029400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1194.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029700 WRITE-LINE. IF1194.2 +029800 ADD 1 TO RECORD-COUNT. IF1194.2 +029900Y IF RECORD-COUNT GREATER 42 IF1194.2 +030000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1194.2 +030100Y MOVE SPACE TO DUMMY-RECORD IF1194.2 +030200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1194.2 +030300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1194.2 +030400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1194.2 +030500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1194.2 +030600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1194.2 +030700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +030800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +030900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +031000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1194.2 +031100Y MOVE ZERO TO RECORD-COUNT. IF1194.2 +031200 PERFORM WRT-LN. IF1194.2 +031300 WRT-LN. IF1194.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1194.2 +031500 MOVE SPACE TO DUMMY-RECORD. IF1194.2 +031600 BLANK-LINE-PRINT. IF1194.2 +031700 PERFORM WRT-LN. IF1194.2 +031800 FAIL-ROUTINE. IF1194.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE IF1194.2 +032000 GO TO FAIL-ROUTINE-WRITE. IF1194.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1194.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1194.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1194.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +032500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1194.2 +032600 GO TO FAIL-ROUTINE-EX. IF1194.2 +032700 FAIL-ROUTINE-WRITE. IF1194.2 +032800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1194.2 +032900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1194.2 +033000 CORMA-ANSI-REFERENCE. IF1194.2 +033100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1194.2 +033200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1194.2 +033300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1194.2 +033400 ELSE IF1194.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1194.2 +033600 PERFORM WRITE-LINE. IF1194.2 +033700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1194.2 +033800 FAIL-ROUTINE-EX. EXIT. IF1194.2 +033900 BAIL-OUT. IF1194.2 +034000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1194.2 +034100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1194.2 +034200 BAIL-OUT-WRITE. IF1194.2 +034300 MOVE CORRECT-A TO XXCORRECT. IF1194.2 +034400 MOVE COMPUTED-A TO XXCOMPUTED. IF1194.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1194.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1194.2 +034800 BAIL-OUT-EX. EXIT. IF1194.2 +034900 CCVS1-EXIT. IF1194.2 +035000 EXIT. IF1194.2 +035100******************************************************** IF1194.2 +035200* * IF1194.2 +035300* Intrinsic Function Tests IF119A - MAX * IF1194.2 +035400* * IF1194.2 +035500******************************************************** IF1194.2 +035600 SECT-IF119A SECTION. IF1194.2 +035700 F-MAX-INFO. IF1194.2 +035800 MOVE "See ref. A-52 2.23" TO ANSI-REFERENCE. IF1194.2 +035900 MOVE "MAX Function" TO FEATURE. IF1194.2 +036000*****************TEST (a) - SIMPLE TEST***************** IF1194.2 +036100 F-MAX-01. IF1194.2 +036200 MOVE ZERO TO WS-NUM. IF1194.2 +036300 F-MAX-TEST-01. IF1194.2 +036400 COMPUTE WS-NUM = FUNCTION MAX(5, 6, 10, 3, 7). IF1194.2 +036500 IF WS-NUM = 10 THEN IF1194.2 +036600 PERFORM PASS IF1194.2 +036700 ELSE IF1194.2 +036800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +036900 MOVE 10 TO CORRECT-N IF1194.2 +037000 PERFORM FAIL. IF1194.2 +037100 GO TO F-MAX-WRITE-01. IF1194.2 +037200 F-MAX-DELETE-01. IF1194.2 +037300 PERFORM DE-LETE. IF1194.2 +037400 GO TO F-MAX-WRITE-01. IF1194.2 +037500 F-MAX-WRITE-01. IF1194.2 +037600 MOVE "F-MAX-01" TO PAR-NAME. IF1194.2 +037700 PERFORM PRINT-DETAIL. IF1194.2 +037800*****************TEST (b) - SIMPLE TEST***************** IF1194.2 +037900 F-MAX-02. IF1194.2 +038000 EVALUATE FUNCTION MAX(-4, 7, 304, 3, -8) IF1194.2 +038100 WHEN 304 IF1194.2 +038200 PERFORM PASS IF1194.2 +038300 WHEN OTHER IF1194.2 +038400 PERFORM FAIL. IF1194.2 +038500 GO TO F-MAX-WRITE-02. IF1194.2 +038600 F-MAX-DELETE-02. IF1194.2 +038700 PERFORM DE-LETE. IF1194.2 +038800 GO TO F-MAX-WRITE-02. IF1194.2 +038900 F-MAX-WRITE-02. IF1194.2 +039000 MOVE "F-MAX-02" TO PAR-NAME. IF1194.2 +039100 PERFORM PRINT-DETAIL. IF1194.2 +039200*****************TEST (c) - SIMPLE TEST***************** IF1194.2 +039300 F-MAX-03. IF1194.2 +039400 IF (FUNCTION MAX(4.3, 2.6, 7.3, 9.1) >= 9.09982) AND IF1194.2 +039500 (FUNCTION MAX(4.3, 2.6, 7.3, 9.1) <= 9.10018) IF1194.2 +039600 PERFORM PASS IF1194.2 +039700 ELSE IF1194.2 +039800 PERFORM FAIL. IF1194.2 +039900 GO TO F-MAX-WRITE-03. IF1194.2 +040000 F-MAX-DELETE-03. IF1194.2 +040100 PERFORM DE-LETE. IF1194.2 +040200 GO TO F-MAX-WRITE-03. IF1194.2 +040300 F-MAX-WRITE-03. IF1194.2 +040400 MOVE "F-MAX-03" TO PAR-NAME. IF1194.2 +040500 PERFORM PRINT-DETAIL. IF1194.2 +040600*****************TEST (d) - SIMPLE TEST***************** IF1194.2 +040700 F-MAX-04. IF1194.2 +040800 MOVE ZERO TO WS-NUM. IF1194.2 +040900 F-MAX-TEST-04. IF1194.2 +041000 COMPUTE WS-NUM = FUNCTION MAX(-4.3, 10.2, -0.7, 3.9). IF1194.2 +041100 IF (WS-NUM >= 10.1998) AND IF1194.2 +041200 (WS-NUM <= 10.2002) IF1194.2 +041300 PERFORM PASS IF1194.2 +041400 ELSE IF1194.2 +041500 MOVE WS-NUM TO COMPUTED-N IF1194.2 +041600 MOVE 10.2 TO CORRECT-N IF1194.2 +041700 PERFORM FAIL. IF1194.2 +041800 GO TO F-MAX-WRITE-04. IF1194.2 +041900 F-MAX-DELETE-04. IF1194.2 +042000 PERFORM DE-LETE. IF1194.2 +042100 GO TO F-MAX-WRITE-04. IF1194.2 +042200 F-MAX-WRITE-04. IF1194.2 +042300 MOVE "F-MAX-04" TO PAR-NAME. IF1194.2 +042400 PERFORM PRINT-DETAIL. IF1194.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1194.2 +042600 F-MAX-05. IF1194.2 +042700 MOVE ZERO TO WS-NUM. IF1194.2 +042800 F-MAX-TEST-05. IF1194.2 +042900 COMPUTE WS-NUM = FUNCTION MAX(A, B, D). IF1194.2 +043000 IF WS-NUM = 10 THEN IF1194.2 +043100 PERFORM PASS IF1194.2 +043200 ELSE IF1194.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1194.2 +043400 MOVE 10 TO CORRECT-N IF1194.2 +043500 PERFORM FAIL. IF1194.2 +043600 GO TO F-MAX-WRITE-05. IF1194.2 +043700 F-MAX-DELETE-05. IF1194.2 +043800 PERFORM DE-LETE. IF1194.2 +043900 GO TO F-MAX-WRITE-05. IF1194.2 +044000 F-MAX-WRITE-05. IF1194.2 +044100 MOVE "F-MAX-05" TO PAR-NAME. IF1194.2 +044200 PERFORM PRINT-DETAIL. IF1194.2 +044300*****************TEST (f) - SIMPLE TEST***************** IF1194.2 +044400 F-MAX-06. IF1194.2 +044500 MOVE ZERO TO WS-NUM. IF1194.2 +044600 F-MAX-TEST-06. IF1194.2 +044700 COMPUTE WS-NUM = FUNCTION MAX(A, B, C). IF1194.2 +044800 IF WS-NUM = 7 THEN IF1194.2 +044900 PERFORM PASS IF1194.2 +045000 ELSE IF1194.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1194.2 +045200 MOVE 7 TO CORRECT-N IF1194.2 +045300 PERFORM FAIL. IF1194.2 +045400 GO TO F-MAX-WRITE-06. IF1194.2 +045500 F-MAX-DELETE-06. IF1194.2 +045600 PERFORM DE-LETE. IF1194.2 +045700 GO TO F-MAX-WRITE-06. IF1194.2 +045800 F-MAX-WRITE-06. IF1194.2 +045900 MOVE "F-MAX-06" TO PAR-NAME. IF1194.2 +046000 PERFORM PRINT-DETAIL. IF1194.2 +046100*****************TEST (g) - SIMPLE TEST***************** IF1194.2 +046200 F-MAX-07. IF1194.2 +046300 MOVE ZERO TO WS-NUM. IF1194.2 +046400 F-MAX-TEST-07. IF1194.2 +046500 COMPUTE WS-NUM = FUNCTION MAX(E, G). IF1194.2 +046600 IF (WS-NUM >= 34.2593) AND IF1194.2 +046700 (WS-NUM <= 34.2607) IF1194.2 +046800 PERFORM PASS IF1194.2 +046900 ELSE IF1194.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +047100 MOVE 34.26 TO CORRECT-N IF1194.2 +047200 PERFORM FAIL. IF1194.2 +047300 GO TO F-MAX-WRITE-07. IF1194.2 +047400 F-MAX-DELETE-07. IF1194.2 +047500 PERFORM DE-LETE. IF1194.2 +047600 GO TO F-MAX-WRITE-07. IF1194.2 +047700 F-MAX-WRITE-07. IF1194.2 +047800 MOVE "F-MAX-07" TO PAR-NAME. IF1194.2 +047900 PERFORM PRINT-DETAIL. IF1194.2 +048000*****************TEST (h) - SIMPLE TEST***************** IF1194.2 +048100 F-MAX-08. IF1194.2 +048200 MOVE ZERO TO WS-NUM. IF1194.2 +048300 F-MAX-TEST-08. IF1194.2 +048400 COMPUTE WS-NUM = FUNCTION MAX(F, G, H). IF1194.2 +048500 IF (WS-NUM >= 4.07992) AND IF1194.2 +048600 (WS-NUM <= 4.08008) IF1194.2 +048700 PERFORM PASS IF1194.2 +048800 ELSE IF1194.2 +048900 MOVE WS-NUM TO COMPUTED-N IF1194.2 +049000 MOVE 4.08 TO CORRECT-N IF1194.2 +049100 PERFORM FAIL. IF1194.2 +049200 GO TO F-MAX-WRITE-08. IF1194.2 +049300 F-MAX-DELETE-08. IF1194.2 +049400 PERFORM DE-LETE. IF1194.2 +049500 GO TO F-MAX-WRITE-08. IF1194.2 +049600 F-MAX-WRITE-08. IF1194.2 +049700 MOVE "F-MAX-08" TO PAR-NAME. IF1194.2 +049800 PERFORM PRINT-DETAIL. IF1194.2 +049900*****************TEST (i) - SIMPLE TEST***************** IF1194.2 +050000 F-MAX-09. IF1194.2 +050100 MOVE ZERO TO WS-NUM. IF1194.2 +050200 F-MAX-TEST-09. IF1194.2 +050300 COMPUTE WS-NUM = FUNCTION MAX(A, 4, 8, -10, C, 0). IF1194.2 +050400 IF WS-NUM = 8 THEN IF1194.2 +050500 PERFORM PASS IF1194.2 +050600 ELSE IF1194.2 +050700 MOVE WS-NUM TO COMPUTED-N IF1194.2 +050800 MOVE 8 TO CORRECT-N IF1194.2 +050900 PERFORM FAIL. IF1194.2 +051000 GO TO F-MAX-WRITE-09. IF1194.2 +051100 F-MAX-DELETE-09. IF1194.2 +051200 PERFORM DE-LETE. IF1194.2 +051300 GO TO F-MAX-WRITE-09. IF1194.2 +051400 F-MAX-WRITE-09. IF1194.2 +051500 MOVE "F-MAX-09" TO PAR-NAME. IF1194.2 +051600 PERFORM PRINT-DETAIL. IF1194.2 +051700*****************TEST (j) - SIMPLE TEST***************** IF1194.2 +051800 F-MAX-10. IF1194.2 +051900 MOVE ZERO TO WS-NUM. IF1194.2 +052000 F-MAX-TEST-10. IF1194.2 +052100 COMPUTE WS-NUM = FUNCTION MAX(4, D, H, 6.3, -2.0). IF1194.2 +052200 IF (WS-NUM >= 9.9998) AND IF1194.2 +052300 (WS-NUM <= 10.0002) IF1194.2 +052400 PERFORM PASS IF1194.2 +052500 ELSE IF1194.2 +052600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +052700 MOVE 10 TO CORRECT-N IF1194.2 +052800 PERFORM FAIL. IF1194.2 +052900 GO TO F-MAX-WRITE-10. IF1194.2 +053000 F-MAX-DELETE-10. IF1194.2 +053100 PERFORM DE-LETE. IF1194.2 +053200 GO TO F-MAX-WRITE-10. IF1194.2 +053300 F-MAX-WRITE-10. IF1194.2 +053400 MOVE "F-MAX-10" TO PAR-NAME. IF1194.2 +053500 PERFORM PRINT-DETAIL. IF1194.2 +053600*****************TEST (k) - SIMPLE TEST***************** IF1194.2 +053700 F-MAX-11. IF1194.2 +053800 MOVE SPACES TO WS-ANUM. IF1194.2 +053900 F-MAX-TEST-11. IF1194.2 +054000 MOVE FUNCTION MAX("R", I, "I", "a") TO WS-ANUM. IF1194.2 +054100 IF WS-ANUM = "a" THEN IF1194.2 +054200 PERFORM PASS IF1194.2 +054300 ELSE IF1194.2 +054400 MOVE WS-ANUM TO COMPUTED-A IF1194.2 +054500 MOVE "a" TO CORRECT-A IF1194.2 +054600 PERFORM FAIL. IF1194.2 +054700 GO TO F-MAX-WRITE-11. IF1194.2 +054800 F-MAX-DELETE-11. IF1194.2 +054900 PERFORM DE-LETE. IF1194.2 +055000 GO TO F-MAX-WRITE-11. IF1194.2 +055100 F-MAX-WRITE-11. IF1194.2 +055200 MOVE "F-MAX-11" TO PAR-NAME. IF1194.2 +055300 PERFORM PRINT-DETAIL. IF1194.2 +055400*****************TEST (l) - SIMPLE TEST***************** IF1194.2 +055500 F-MAX-12. IF1194.2 +055600 MOVE ZERO TO WS-NUM. IF1194.2 +055700 F-MAX-TEST-12. IF1194.2 +055800 MOVE FUNCTION MAX("A", J, "J") TO WS-ANUM. IF1194.2 +055900 IF WS-ANUM = "U" THEN IF1194.2 +056000 PERFORM PASS IF1194.2 +056100 ELSE IF1194.2 +056200 MOVE WS-ANUM TO COMPUTED-A IF1194.2 +056300 MOVE "U" TO CORRECT-A IF1194.2 +056400 PERFORM FAIL. IF1194.2 +056500 GO TO F-MAX-WRITE-12. IF1194.2 +056600 F-MAX-DELETE-12. IF1194.2 +056700 PERFORM DE-LETE. IF1194.2 +056800 GO TO F-MAX-WRITE-12. IF1194.2 +056900 F-MAX-WRITE-12. IF1194.2 +057000 MOVE "F-MAX-12" TO PAR-NAME. IF1194.2 +057100 PERFORM PRINT-DETAIL. IF1194.2 +057200*****************TEST (m) - SIMPLE TEST***************** IF1194.2 +057300 F-MAX-13. IF1194.2 +057400 MOVE ZERO TO WS-NUM. IF1194.2 +057500 F-MAX-TEST-13. IF1194.2 +057600 COMPUTE WS-NUM = FUNCTION MAX(IND(M), IND(N), IND(O)). IF1194.2 +057700 IF WS-NUM = 7 THEN IF1194.2 +057800 PERFORM PASS IF1194.2 +057900 ELSE IF1194.2 +058000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +058100 MOVE 7 TO CORRECT-N IF1194.2 +058200 PERFORM FAIL. IF1194.2 +058300 GO TO F-MAX-WRITE-13. IF1194.2 +058400 F-MAX-DELETE-13. IF1194.2 +058500 PERFORM DE-LETE. IF1194.2 +058600 GO TO F-MAX-WRITE-13. IF1194.2 +058700 F-MAX-WRITE-13. IF1194.2 +058800 MOVE "F-MAX-13" TO PAR-NAME. IF1194.2 +058900 PERFORM PRINT-DETAIL. IF1194.2 +059000*****************TEST (n) - SIMPLE TEST***************** IF1194.2 +059100 F-MAX-14. IF1194.2 +059200 MOVE ZERO TO WS-NUM. IF1194.2 +059300 F-MAX-TEST-14. IF1194.2 +059400 COMPUTE WS-NUM = FUNCTION MAX(IND(1), IND(2), IND(3)). IF1194.2 +059500 IF WS-NUM = 5 THEN IF1194.2 +059600 PERFORM PASS IF1194.2 +059700 ELSE IF1194.2 +059800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +059900 MOVE 5 TO CORRECT-N IF1194.2 +060000 PERFORM FAIL. IF1194.2 +060100 GO TO F-MAX-WRITE-14. IF1194.2 +060200 F-MAX-DELETE-14. IF1194.2 +060300 PERFORM DE-LETE. IF1194.2 +060400 GO TO F-MAX-WRITE-14. IF1194.2 +060500 F-MAX-WRITE-14. IF1194.2 +060600 MOVE "F-MAX-14" TO PAR-NAME. IF1194.2 +060700 PERFORM PRINT-DETAIL. IF1194.2 +060800*****************TEST (o) - SIMPLE TEST***************** IF1194.2 +060900 F-MAX-15. IF1194.2 +061000 MOVE ZERO TO WS-NUM. IF1194.2 +061100 F-MAX-TEST-15. IF1194.2 +061200 COMPUTE WS-NUM = FUNCTION MAX(IND(ALL)). IF1194.2 +061300 IF WS-NUM = 7 THEN IF1194.2 +061400 PERFORM PASS IF1194.2 +061500 ELSE IF1194.2 +061600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +061700 MOVE 7 TO CORRECT-N IF1194.2 +061800 PERFORM FAIL. IF1194.2 +061900 GO TO F-MAX-WRITE-15. IF1194.2 +062000 F-MAX-DELETE-15. IF1194.2 +062100 PERFORM DE-LETE. IF1194.2 +062200 GO TO F-MAX-WRITE-15. IF1194.2 +062300 F-MAX-WRITE-15. IF1194.2 +062400 MOVE "F-MAX-15" TO PAR-NAME. IF1194.2 +062500 PERFORM PRINT-DETAIL. IF1194.2 +062600*****************TEST (q) - SIMPLE TEST***************** IF1194.2 +062700 F-MAX-17. IF1194.2 +062800 MOVE ZERO TO WS-NUM. IF1194.2 +062900 F-MAX-TEST-17. IF1194.2 +063000 COMPUTE WS-NUM = IF1194.2 +063100 FUNCTION MAX(31000, 310001, 78000, 29000, 12000). IF1194.2 +063200 IF WS-NUM = 310001 THEN IF1194.2 +063300 PERFORM PASS IF1194.2 +063400 ELSE IF1194.2 +063500 MOVE WS-NUM TO COMPUTED-N IF1194.2 +063600 MOVE 310001 TO CORRECT-N IF1194.2 +063700 PERFORM FAIL. IF1194.2 +063800 GO TO F-MAX-WRITE-17. IF1194.2 +063900 F-MAX-DELETE-17. IF1194.2 +064000 PERFORM DE-LETE. IF1194.2 +064100 GO TO F-MAX-WRITE-17. IF1194.2 +064200 F-MAX-WRITE-17. IF1194.2 +064300 MOVE "F-MAX-17" TO PAR-NAME. IF1194.2 +064400 PERFORM PRINT-DETAIL. IF1194.2 +064500*****************TEST (a) - COMPLEX TEST**************** IF1194.2 +064600 F-MAX-18. IF1194.2 +064700 MOVE ZERO TO WS-NUM. IF1194.2 +064800 MOVE 34.9993 TO MIN-RANGE. IF1194.2 +064900 MOVE 35.0007 TO MAX-RANGE. IF1194.2 +065000 F-MAX-TEST-18. IF1194.2 +065100 COMPUTE WS-NUM = FUNCTION MAX(A * B, (C + 1) / 2, 3 + 4). IF1194.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +065400 PERFORM PASS IF1194.2 +065500 ELSE IF1194.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +065900 PERFORM FAIL. IF1194.2 +066000 GO TO F-MAX-WRITE-18. IF1194.2 +066100 F-MAX-DELETE-18. IF1194.2 +066200 PERFORM DE-LETE. IF1194.2 +066300 GO TO F-MAX-WRITE-18. IF1194.2 +066400 F-MAX-WRITE-18. IF1194.2 +066500 MOVE "F-MAX-18" TO PAR-NAME. IF1194.2 +066600 PERFORM PRINT-DETAIL. IF1194.2 +066700*****************TEST (b) - COMPLEX TEST**************** IF1194.2 +066800 F-MAX-19. IF1194.2 +066900 MOVE ZERO TO WS-NUM. IF1194.2 +067000 MOVE 38.2592 TO MIN-RANGE. IF1194.2 +067100 MOVE 38.2608 TO MAX-RANGE. IF1194.2 +067200 F-MAX-TEST-19. IF1194.2 +067300 COMPUTE WS-NUM = FUNCTION MAX(E + 4, H * 2, 5 + A). IF1194.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +067600 PERFORM PASS IF1194.2 +067700 ELSE IF1194.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +068100 PERFORM FAIL. IF1194.2 +068200 GO TO F-MAX-WRITE-19. IF1194.2 +068300 F-MAX-DELETE-19. IF1194.2 +068400 PERFORM DE-LETE. IF1194.2 +068500 GO TO F-MAX-WRITE-19. IF1194.2 +068600 F-MAX-WRITE-19. IF1194.2 +068700 MOVE "F-MAX-19" TO PAR-NAME. IF1194.2 +068800 PERFORM PRINT-DETAIL. IF1194.2 +068900*****************TEST (c) - COMPLEX TEST**************** IF1194.2 +069000 F-MAX-20. IF1194.2 +069100 MOVE ZERO TO WS-NUM. IF1194.2 +069200 MOVE -7.00014 TO MIN-RANGE. IF1194.2 +069300 MOVE -6.99986 TO MAX-RANGE. IF1194.2 +069400 F-MAX-TEST-20. IF1194.2 +069500 COMPUTE WS-NUM = FUNCTION MAX(-7, -9 + 2, -7). IF1194.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +069800 PERFORM PASS IF1194.2 +069900 ELSE IF1194.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +070300 PERFORM FAIL. IF1194.2 +070400 GO TO F-MAX-WRITE-20. IF1194.2 +070500 F-MAX-DELETE-20. IF1194.2 +070600 PERFORM DE-LETE. IF1194.2 +070700 GO TO F-MAX-WRITE-20. IF1194.2 +070800 F-MAX-WRITE-20. IF1194.2 +070900 MOVE "F-MAX-20" TO PAR-NAME. IF1194.2 +071000 PERFORM PRINT-DETAIL. IF1194.2 +071100*****************TEST (d) - COMPLEX TEST**************** IF1194.2 +071200 F-MAX-21. IF1194.2 +071300 MOVE ZERO TO WS-NUM. IF1194.2 +071400 MOVE 49.9990 TO MIN-RANGE. IF1194.2 +071500 MOVE 50.0001 TO MAX-RANGE. IF1194.2 +071600 F-MAX-TEST-21. IF1194.2 +071700 COMPUTE WS-NUM = FUNCTION MAX(FUNCTION MAX(14, A), E, 50). IF1194.2 +071800 IF1194.2 +071900 IF1194.2 +072000 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +072100 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +072200 PERFORM PASS IF1194.2 +072300 ELSE IF1194.2 +072400 MOVE WS-NUM TO COMPUTED-N IF1194.2 +072500 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +072600 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +072700 PERFORM FAIL. IF1194.2 +072800 GO TO F-MAX-WRITE-21. IF1194.2 +072900 F-MAX-DELETE-21. IF1194.2 +073000 PERFORM DE-LETE. IF1194.2 +073100 GO TO F-MAX-WRITE-21. IF1194.2 +073200 F-MAX-WRITE-21. IF1194.2 +073300 MOVE "F-MAX-21" TO PAR-NAME. IF1194.2 +073400 PERFORM PRINT-DETAIL. IF1194.2 +073500*****************TEST (e) - COMPLEX TEST**************** IF1194.2 +073600 F-MAX-22. IF1194.2 +073700 MOVE ZERO TO WS-NUM. IF1194.2 +073800 MOVE 36.2593 TO MIN-RANGE. IF1194.2 +073900 MOVE 36.2607 TO MAX-RANGE. IF1194.2 +074000 F-MAX-TEST-22. IF1194.2 +074100 COMPUTE WS-NUM = FUNCTION MAX(4, B, E) + 2. IF1194.2 +074200 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +074300 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +074400 PERFORM PASS IF1194.2 +074500 ELSE IF1194.2 +074600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +074700 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +074800 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +074900 PERFORM FAIL. IF1194.2 +075000 GO TO F-MAX-WRITE-22. IF1194.2 +075100 F-MAX-DELETE-22. IF1194.2 +075200 PERFORM DE-LETE. IF1194.2 +075300 GO TO F-MAX-WRITE-22. IF1194.2 +075400 F-MAX-WRITE-22. IF1194.2 +075500 MOVE "F-MAX-22" TO PAR-NAME. IF1194.2 +075600 PERFORM PRINT-DETAIL. IF1194.2 +075700*****************TEST (f) - COMPLEX TEST**************** IF1194.2 +075800 F-MAX-23. IF1194.2 +075900 MOVE ZERO TO WS-NUM. IF1194.2 +076000 MOVE 11.9998 TO MIN-RANGE. IF1194.2 +076100 MOVE 12.0002 TO MAX-RANGE. IF1194.2 +076200 F-MAX-TEST-23. IF1194.2 +076300 COMPUTE WS-NUM = FUNCTION MAX(A, G) + IF1194.2 +076400 FUNCTION MAX(B, 0). IF1194.2 +076500 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +076600 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +076700 PERFORM PASS IF1194.2 +076800 ELSE IF1194.2 +076900 MOVE WS-NUM TO COMPUTED-N IF1194.2 +077000 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +077100 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +077200 PERFORM FAIL. IF1194.2 +077300 GO TO F-MAX-WRITE-23. IF1194.2 +077400 F-MAX-DELETE-23. IF1194.2 +077500 PERFORM DE-LETE. IF1194.2 +077600 GO TO F-MAX-WRITE-23. IF1194.2 +077700 F-MAX-WRITE-23. IF1194.2 +077800 MOVE "F-MAX-23" TO PAR-NAME. IF1194.2 +077900 PERFORM PRINT-DETAIL. IF1194.2 +078000*****************SPECIAL PERFORM TEST********************** IF1194.2 +078100 F-MAX-24. IF1194.2 +078200 PERFORM F-MAX-TEST-24 IF1194.2 +078300 UNTIL FUNCTION MAX(ARG1, 1) > 5. IF1194.2 +078400 PERFORM PASS. IF1194.2 +078500 GO TO F-MAX-WRITE-24. IF1194.2 +078600 F-MAX-TEST-24. IF1194.2 +078700 COMPUTE ARG1 = ARG1 + 1. IF1194.2 +078800 F-MAX-DELETE-24. IF1194.2 +078900 PERFORM DE-LETE. IF1194.2 +079000 GO TO F-MAX-WRITE-24. IF1194.2 +079100 F-MAX-WRITE-24. IF1194.2 +079200 MOVE "F-MAX-24" TO PAR-NAME. IF1194.2 +079300 PERFORM PRINT-DETAIL. IF1194.2 +079400********************END OF TESTS*************** IF1194.2 +079500 CCVS-EXIT SECTION. IF1194.2 +079600 CCVS-999999. IF1194.2 +079700 GO TO CLOSE-FILES. IF1194.2 +*END-OF,IF119A +*HEADER,COBOL,IF120A +000100 IDENTIFICATION DIVISION. IF1204.2 +000200 PROGRAM-ID. IF1204.2 +000300 IF120A. IF1204.2 +000400 IF1204.2 +000500*********************************************************** IF1204.2 +000600* * IF1204.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1204.2 +000800* It contains tests for the Intrinsic Function MEAN. * IF1204.2 +000900* * IF1204.2 +001000*********************************************************** IF1204.2 +001100 ENVIRONMENT DIVISION. IF1204.2 +001200 CONFIGURATION SECTION. IF1204.2 +001300 SOURCE-COMPUTER. IF1204.2 +001400 XXXXX082. IF1204.2 +001500 OBJECT-COMPUTER. IF1204.2 +001600 XXXXX083. IF1204.2 +001700 INPUT-OUTPUT SECTION. IF1204.2 +001800 FILE-CONTROL. IF1204.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1204.2 +002000 XXXXX055. IF1204.2 +002100 DATA DIVISION. IF1204.2 +002200 FILE SECTION. IF1204.2 +002300 FD PRINT-FILE. IF1204.2 +002400 01 PRINT-REC PICTURE X(120). IF1204.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1204.2 +002600 WORKING-STORAGE SECTION. IF1204.2 +002700*********************************************************** IF1204.2 +002800* Variables specific to the Intrinsic Function Test IF120A* IF1204.2 +002900*********************************************************** IF1204.2 +003000 01 A PIC S9(10) VALUE 5. IF1204.2 +003100 01 B PIC S9(10) VALUE 7. IF1204.2 +003200 01 C PIC S9(10) VALUE -4. IF1204.2 +003300 01 D PIC S9(10) VALUE 10. IF1204.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1204.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1204.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1204.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1204.2 +003800 01 M PIC S9(10) VALUE 320000. IF1204.2 +003900 01 N PIC S9(10) VALUE 650000. IF1204.2 +004000 01 O PIC S9(10) VALUE -430000. IF1204.2 +004100 01 P PIC S9(10) VALUE 1. IF1204.2 +004200 01 Q PIC S9(10) VALUE 3. IF1204.2 +004300 01 R PIC S9(10) VALUE 5. IF1204.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1204.2 +004500 01 ARG2 PIC S9(10) VALUE 1. IF1204.2 +004600 01 ARR VALUE "40537". IF1204.2 +004700 02 IND OCCURS 5 TIMES PIC 9. IF1204.2 +004800 01 TEMP PIC S9(10)V9(5). IF1204.2 +004900 01 WS-NUM PIC S9(6)V9(6). IF1204.2 +005000 01 MIN-RANGE PIC S9(5)V9(7). IF1204.2 +005100 01 MAX-RANGE PIC S9(5)V9(7). IF1204.2 +005200* IF1204.2 +005300********************************************************** IF1204.2 +005400* IF1204.2 +005500 01 TEST-RESULTS. IF1204.2 +005600 02 FILLER PIC X VALUE SPACE. IF1204.2 +005700 02 FEATURE PIC X(20) VALUE SPACE. IF1204.2 +005800 02 FILLER PIC X VALUE SPACE. IF1204.2 +005900 02 P-OR-F PIC X(5) VALUE SPACE. IF1204.2 +006000 02 FILLER PIC X VALUE SPACE. IF1204.2 +006100 02 PAR-NAME. IF1204.2 +006200 03 FILLER PIC X(19) VALUE SPACE. IF1204.2 +006300 03 PARDOT-X PIC X VALUE SPACE. IF1204.2 +006400 03 DOTVALUE PIC 99 VALUE ZERO. IF1204.2 +006500 02 FILLER PIC X(8) VALUE SPACE. IF1204.2 +006600 02 RE-MARK PIC X(61). IF1204.2 +006700 01 TEST-COMPUTED. IF1204.2 +006800 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +006900 02 FILLER PIC X(17) VALUE IF1204.2 +007000 " COMPUTED=". IF1204.2 +007100 02 COMPUTED-X. IF1204.2 +007200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1204.2 +007300 03 COMPUTED-N REDEFINES COMPUTED-A IF1204.2 +007400 PIC -9(9).9(9). IF1204.2 +007500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1204.2 +007600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1204.2 +007700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1204.2 +007800 03 CM-18V0 REDEFINES COMPUTED-A. IF1204.2 +007900 04 COMPUTED-18V0 PIC -9(18). IF1204.2 +008000 04 FILLER PIC X. IF1204.2 +008100 03 FILLER PIC X(50) VALUE SPACE. IF1204.2 +008200 01 TEST-CORRECT. IF1204.2 +008300 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +008400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1204.2 +008500 02 CORRECT-X. IF1204.2 +008600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1204.2 +008700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1204.2 +008800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1204.2 +008900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1204.2 +009000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1204.2 +009100 03 CR-18V0 REDEFINES CORRECT-A. IF1204.2 +009200 04 CORRECT-18V0 PIC -9(18). IF1204.2 +009300 04 FILLER PIC X. IF1204.2 +009400 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +009500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1204.2 +009600 01 TEST-CORRECT-MIN. IF1204.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +009800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1204.2 +009900 02 CORRECTMI-X. IF1204.2 +010000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1204.2 +010100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1204.2 +010200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1204.2 +010300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1204.2 +010400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1204.2 +010500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1204.2 +010600 04 CORRECTMI-18V0 PIC -9(18). IF1204.2 +010700 04 FILLER PIC X. IF1204.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +010900 03 FILLER PIC X(48) VALUE SPACE. IF1204.2 +011000 01 TEST-CORRECT-MAX. IF1204.2 +011100 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +011200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1204.2 +011300 02 CORRECTMA-X. IF1204.2 +011400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1204.2 +011500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1204.2 +011600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1204.2 +011700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1204.2 +011800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1204.2 +011900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1204.2 +012000 04 CORRECTMA-18V0 PIC -9(18). IF1204.2 +012100 04 FILLER PIC X. IF1204.2 +012200 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +012300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1204.2 +012400 01 CCVS-C-1. IF1204.2 +012500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1204.2 +012600- "SS PARAGRAPH-NAME IF1204.2 +012700- " REMARKS". IF1204.2 +012800 02 FILLER PIC X(20) VALUE SPACE. IF1204.2 +012900 01 CCVS-C-2. IF1204.2 +013000 02 FILLER PIC X VALUE SPACE. IF1204.2 +013100 02 FILLER PIC X(6) VALUE "TESTED". IF1204.2 +013200 02 FILLER PIC X(15) VALUE SPACE. IF1204.2 +013300 02 FILLER PIC X(4) VALUE "FAIL". IF1204.2 +013400 02 FILLER PIC X(94) VALUE SPACE. IF1204.2 +013500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1204.2 +013600 01 REC-CT PIC 99 VALUE ZERO. IF1204.2 +013700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1204.2 +013800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1204.2 +013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1204.2 +014000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1204.2 +014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1204.2 +014200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1204.2 +014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1204.2 +014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1204.2 +014500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1204.2 +014600 01 CCVS-H-1. IF1204.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1204.2 +014800 02 FILLER PIC X(42) VALUE IF1204.2 +014900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1204.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1204.2 +015100 01 CCVS-H-2A. IF1204.2 +015200 02 FILLER PIC X(40) VALUE SPACE. IF1204.2 +015300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1204.2 +015400 02 FILLER PIC XXXX VALUE IF1204.2 +015500 "4.2 ". IF1204.2 +015600 02 FILLER PIC X(28) VALUE IF1204.2 +015700 " COPY - NOT FOR DISTRIBUTION". IF1204.2 +015800 02 FILLER PIC X(41) VALUE SPACE. IF1204.2 +015900 IF1204.2 +016000 01 CCVS-H-2B. IF1204.2 +016100 02 FILLER PIC X(15) VALUE IF1204.2 +016200 "TEST RESULT OF ". IF1204.2 +016300 02 TEST-ID PIC X(9). IF1204.2 +016400 02 FILLER PIC X(4) VALUE IF1204.2 +016500 " IN ". IF1204.2 +016600 02 FILLER PIC X(12) VALUE IF1204.2 +016700 " HIGH ". IF1204.2 +016800 02 FILLER PIC X(22) VALUE IF1204.2 +016900 " LEVEL VALIDATION FOR ". IF1204.2 +017000 02 FILLER PIC X(58) VALUE IF1204.2 +017100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1204.2 +017200 01 CCVS-H-3. IF1204.2 +017300 02 FILLER PIC X(34) VALUE IF1204.2 +017400 " FOR OFFICIAL USE ONLY ". IF1204.2 +017500 02 FILLER PIC X(58) VALUE IF1204.2 +017600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1204.2 +017700 02 FILLER PIC X(28) VALUE IF1204.2 +017800 " COPYRIGHT 1985 ". IF1204.2 +017900 01 CCVS-E-1. IF1204.2 +018000 02 FILLER PIC X(52) VALUE SPACE. IF1204.2 +018100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1204.2 +018200 02 ID-AGAIN PIC X(9). IF1204.2 +018300 02 FILLER PIC X(45) VALUE SPACES. IF1204.2 +018400 01 CCVS-E-2. IF1204.2 +018500 02 FILLER PIC X(31) VALUE SPACE. IF1204.2 +018600 02 FILLER PIC X(21) VALUE SPACE. IF1204.2 +018700 02 CCVS-E-2-2. IF1204.2 +018800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1204.2 +018900 03 FILLER PIC X VALUE SPACE. IF1204.2 +019000 03 ENDER-DESC PIC X(44) VALUE IF1204.2 +019100 "ERRORS ENCOUNTERED". IF1204.2 +019200 01 CCVS-E-3. IF1204.2 +019300 02 FILLER PIC X(22) VALUE IF1204.2 +019400 " FOR OFFICIAL USE ONLY". IF1204.2 +019500 02 FILLER PIC X(12) VALUE SPACE. IF1204.2 +019600 02 FILLER PIC X(58) VALUE IF1204.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1204.2 +019800 02 FILLER PIC X(13) VALUE SPACE. IF1204.2 +019900 02 FILLER PIC X(15) VALUE IF1204.2 +020000 " COPYRIGHT 1985". IF1204.2 +020100 01 CCVS-E-4. IF1204.2 +020200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1204.2 +020300 02 FILLER PIC X(4) VALUE " OF ". IF1204.2 +020400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1204.2 +020500 02 FILLER PIC X(40) VALUE IF1204.2 +020600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1204.2 +020700 01 XXINFO. IF1204.2 +020800 02 FILLER PIC X(19) VALUE IF1204.2 +020900 "*** INFORMATION ***". IF1204.2 +021000 02 INFO-TEXT. IF1204.2 +021100 04 FILLER PIC X(8) VALUE SPACE. IF1204.2 +021200 04 XXCOMPUTED PIC X(20). IF1204.2 +021300 04 FILLER PIC X(5) VALUE SPACE. IF1204.2 +021400 04 XXCORRECT PIC X(20). IF1204.2 +021500 02 INF-ANSI-REFERENCE PIC X(48). IF1204.2 +021600 01 HYPHEN-LINE. IF1204.2 +021700 02 FILLER PIC IS X VALUE IS SPACE. IF1204.2 +021800 02 FILLER PIC IS X(65) VALUE IS "************************IF1204.2 +021900- "*****************************************". IF1204.2 +022000 02 FILLER PIC IS X(54) VALUE IS "************************IF1204.2 +022100- "******************************". IF1204.2 +022200 01 CCVS-PGM-ID PIC X(9) VALUE IF1204.2 +022300 "IF120A". IF1204.2 +022400 PROCEDURE DIVISION. IF1204.2 +022500 CCVS1 SECTION. IF1204.2 +022600 OPEN-FILES. IF1204.2 +022700 OPEN OUTPUT PRINT-FILE. IF1204.2 +022800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1204.2 +022900 MOVE SPACE TO TEST-RESULTS. IF1204.2 +023000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1204.2 +023100 GO TO CCVS1-EXIT. IF1204.2 +023200 CLOSE-FILES. IF1204.2 +023300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1204.2 +023400 TERMINATE-CCVS. IF1204.2 +023500 STOP RUN. IF1204.2 +023600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1204.2 +023700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1204.2 +023800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1204.2 +023900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1204.2 +024000 MOVE "****TEST DELETED****" TO RE-MARK. IF1204.2 +024100 PRINT-DETAIL. IF1204.2 +024200 IF REC-CT NOT EQUAL TO ZERO IF1204.2 +024300 MOVE "." TO PARDOT-X IF1204.2 +024400 MOVE REC-CT TO DOTVALUE. IF1204.2 +024500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1204.2 +024600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1204.2 +024700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1204.2 +024800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1204.2 +024900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1204.2 +025000 MOVE SPACE TO CORRECT-X. IF1204.2 +025100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1204.2 +025200 MOVE SPACE TO RE-MARK. IF1204.2 +025300 HEAD-ROUTINE. IF1204.2 +025400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +025500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +025600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1204.2 +025700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1204.2 +025800 COLUMN-NAMES-ROUTINE. IF1204.2 +025900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +026000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +026100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +026200 END-ROUTINE. IF1204.2 +026300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1204.2 +026400 END-RTN-EXIT. IF1204.2 +026500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +026600 END-ROUTINE-1. IF1204.2 +026700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1204.2 +026800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1204.2 +026900 ADD PASS-COUNTER TO ERROR-HOLD. IF1204.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1204.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1204.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1204.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1204.2 +027400 END-ROUTINE-12. IF1204.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1204.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1204.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1204.2 +027800 ELSE IF1204.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1204.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1204.2 +028100 PERFORM WRITE-LINE. IF1204.2 +028200 END-ROUTINE-13. IF1204.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1204.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IF1204.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1204.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1204.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IF1204.2 +028900 MOVE "NO " TO ERROR-TOTAL IF1204.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1204.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1204.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +029400 WRITE-LINE. IF1204.2 +029500 ADD 1 TO RECORD-COUNT. IF1204.2 +029600Y IF RECORD-COUNT GREATER 42 IF1204.2 +029700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1204.2 +029800Y MOVE SPACE TO DUMMY-RECORD IF1204.2 +029900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1204.2 +030000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1204.2 +030100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1204.2 +030200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1204.2 +030300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1204.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1204.2 +030800Y MOVE ZERO TO RECORD-COUNT. IF1204.2 +030900 PERFORM WRT-LN. IF1204.2 +031000 WRT-LN. IF1204.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1204.2 +031200 MOVE SPACE TO DUMMY-RECORD. IF1204.2 +031300 BLANK-LINE-PRINT. IF1204.2 +031400 PERFORM WRT-LN. IF1204.2 +031500 FAIL-ROUTINE. IF1204.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE IF1204.2 +031700 GO TO FAIL-ROUTINE-WRITE. IF1204.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1204.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1204.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1204.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1204.2 +032300 GO TO FAIL-ROUTINE-EX. IF1204.2 +032400 FAIL-ROUTINE-WRITE. IF1204.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1204.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1204.2 +032700 CORMA-ANSI-REFERENCE. IF1204.2 +032800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1204.2 +032900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1204.2 +033000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1204.2 +033100 ELSE IF1204.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1204.2 +033300 PERFORM WRITE-LINE. IF1204.2 +033400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1204.2 +033500 FAIL-ROUTINE-EX. EXIT. IF1204.2 +033600 BAIL-OUT. IF1204.2 +033700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1204.2 +033800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1204.2 +033900 BAIL-OUT-WRITE. IF1204.2 +034000 MOVE CORRECT-A TO XXCORRECT. IF1204.2 +034100 MOVE COMPUTED-A TO XXCOMPUTED. IF1204.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1204.2 +034300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +034400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1204.2 +034500 BAIL-OUT-EX. EXIT. IF1204.2 +034600 CCVS1-EXIT. IF1204.2 +034700 EXIT. IF1204.2 +034800******************************************************** IF1204.2 +034900* * IF1204.2 +035000* Intrinsic Function Tests IF120A - MEAN * IF1204.2 +035100* * IF1204.2 +035200******************************************************** IF1204.2 +035300 SECT-IF120A SECTION. IF1204.2 +035400 F-MEAN-TEST-INFO. IF1204.2 +035500 MOVE "See ref. A-53 2.24" TO ANSI-REFERENCE. IF1204.2 +035600 MOVE "MEAN Function" TO FEATURE. IF1204.2 +035700*****************TEST (a) - SIMPLE TEST***************** IF1204.2 +035800 F-MEAN-01. IF1204.2 +035900 MOVE ZERO TO WS-NUM. IF1204.2 +036000 F-MEAN-TEST-01. IF1204.2 +036100 COMPUTE WS-NUM = FUNCTION MEAN(5, -2, -14, 0). IF1204.2 +036200 IF (WS-NUM >= -2.75006) AND IF1204.2 +036300 (WS-NUM <= -2.74995) IF1204.2 +036400 PERFORM PASS IF1204.2 +036500 ELSE IF1204.2 +036600 MOVE WS-NUM TO COMPUTED-N IF1204.2 +036700 MOVE -2.75 TO CORRECT-N IF1204.2 +036800 PERFORM FAIL. IF1204.2 +036900 GO TO F-MEAN-WRITE-01. IF1204.2 +037000 F-MEAN-DELETE-01. IF1204.2 +037100 PERFORM DE-LETE. IF1204.2 +037200 GO TO F-MEAN-WRITE-01. IF1204.2 +037300 F-MEAN-WRITE-01. IF1204.2 +037400 MOVE "F-MEAN-01" TO PAR-NAME. IF1204.2 +037500 PERFORM PRINT-DETAIL. IF1204.2 +037600*****************TEST (b) - SIMPLE TEST***************** IF1204.2 +037700 F-MEAN-02. IF1204.2 +037800 EVALUATE FUNCTION MEAN(3.9, -0.3, 8.7, 100.2) IF1204.2 +037900 WHEN 28.1244 THRU 28.1256 IF1204.2 +038000 PERFORM PASS IF1204.2 +038100 WHEN OTHER IF1204.2 +038200 PERFORM FAIL. IF1204.2 +038300 GO TO F-MEAN-WRITE-02. IF1204.2 +038400 F-MEAN-DELETE-02. IF1204.2 +038500 PERFORM DE-LETE. IF1204.2 +038600 GO TO F-MEAN-WRITE-02. IF1204.2 +038700 F-MEAN-WRITE-02. IF1204.2 +038800 MOVE "F-MEAN-02" TO PAR-NAME. IF1204.2 +038900 PERFORM PRINT-DETAIL. IF1204.2 +039000*****************TEST (c) - SIMPLE TEST***************** IF1204.2 +039100 F-MEAN-03. IF1204.2 +039200 IF (FUNCTION MEAN(A, B, C, D) >= 4.49991) AND IF1204.2 +039300 (FUNCTION MEAN(A, B, C, D) <= 4.50009) IF1204.2 +039400 PERFORM PASS IF1204.2 +039500 ELSE IF1204.2 +039600 PERFORM FAIL. IF1204.2 +039700 GO TO F-MEAN-WRITE-03. IF1204.2 +039800 F-MEAN-DELETE-03. IF1204.2 +039900 PERFORM DE-LETE. IF1204.2 +040000 GO TO F-MEAN-WRITE-03. IF1204.2 +040100 F-MEAN-WRITE-03. IF1204.2 +040200 MOVE "F-MEAN-03" TO PAR-NAME. IF1204.2 +040300 PERFORM PRINT-DETAIL. IF1204.2 +040400*****************TEST (d) - SIMPLE TEST***************** IF1204.2 +040500 F-MEAN-04. IF1204.2 +040600 MOVE ZERO TO WS-NUM. IF1204.2 +040700 F-MEAN-TEST-04. IF1204.2 +040800 COMPUTE WS-NUM = FUNCTION MEAN(E, F, G, H). IF1204.2 +040900 IF (WS-NUM >= 6.17988) AND IF1204.2 +041000 (WS-NUM <= 6.18012) IF1204.2 +041100 PERFORM PASS IF1204.2 +041200 ELSE IF1204.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1204.2 +041400 MOVE 6.18 TO CORRECT-N IF1204.2 +041500 PERFORM FAIL. IF1204.2 +041600 GO TO F-MEAN-WRITE-04. IF1204.2 +041700 F-MEAN-DELETE-04. IF1204.2 +041800 PERFORM DE-LETE. IF1204.2 +041900 GO TO F-MEAN-WRITE-04. IF1204.2 +042000 F-MEAN-WRITE-04. IF1204.2 +042100 MOVE "F-MEAN-04" TO PAR-NAME. IF1204.2 +042200 PERFORM PRINT-DETAIL. IF1204.2 +042300*****************TEST (e) - SIMPLE TEST***************** IF1204.2 +042400 F-MEAN-05. IF1204.2 +042500 MOVE ZERO TO WS-NUM. IF1204.2 +042600 F-MEAN-TEST-05. IF1204.2 +042700 COMPUTE WS-NUM = FUNCTION MEAN(10.2, -0.2, 5.6, -15.6). IF1204.2 +042800 IF (WS-NUM >= -0.000020) AND IF1204.2 +042900 (WS-NUM <= 0.000020) IF1204.2 +043000 PERFORM PASS IF1204.2 +043100 ELSE IF1204.2 +043200 MOVE WS-NUM TO COMPUTED-N IF1204.2 +043300 MOVE 0.0 TO CORRECT-N IF1204.2 +043400 PERFORM FAIL. IF1204.2 +043500 GO TO F-MEAN-WRITE-05. IF1204.2 +043600 F-MEAN-DELETE-05. IF1204.2 +043700 PERFORM DE-LETE. IF1204.2 +043800 GO TO F-MEAN-WRITE-05. IF1204.2 +043900 F-MEAN-WRITE-05. IF1204.2 +044000 MOVE "F-MEAN-05" TO PAR-NAME. IF1204.2 +044100 PERFORM PRINT-DETAIL. IF1204.2 +044200*****************TEST (f) - SIMPLE TEST***************** IF1204.2 +044300 F-MEAN-06. IF1204.2 +044400 MOVE ZERO TO WS-NUM. IF1204.2 +044500 F-MEAN-TEST-06. IF1204.2 +044600 COMPUTE WS-NUM = FUNCTION MEAN(A, B, C, D, E, F, G, H). IF1204.2 +044700 IF (WS-NUM >= 5.33989) AND IF1204.2 +044800 (WS-NUM <= 5.34011) IF1204.2 +044900 PERFORM PASS IF1204.2 +045000 ELSE IF1204.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1204.2 +045200 MOVE 5.34 TO CORRECT-N IF1204.2 +045300 PERFORM FAIL. IF1204.2 +045400 GO TO F-MEAN-WRITE-06. IF1204.2 +045500 F-MEAN-DELETE-06. IF1204.2 +045600 PERFORM DE-LETE. IF1204.2 +045700 GO TO F-MEAN-WRITE-06. IF1204.2 +045800 F-MEAN-WRITE-06. IF1204.2 +045900 MOVE "F-MEAN-06" TO PAR-NAME. IF1204.2 +046000 PERFORM PRINT-DETAIL. IF1204.2 +046100*****************TEST (g) - SIMPLE TEST***************** IF1204.2 +046200 F-MEAN-07. IF1204.2 +046300 MOVE ZERO TO WS-NUM. IF1204.2 +046400 F-MEAN-TEST-07. IF1204.2 +046500 COMPUTE WS-NUM = FUNCTION MEAN(IND(2), IND(1), IND(3)). IF1204.2 +046600 IF (WS-NUM >= 2.99994) AND IF1204.2 +046700 (WS-NUM <= 3.00006) IF1204.2 +046800 PERFORM PASS IF1204.2 +046900 ELSE IF1204.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1204.2 +047100 MOVE 3.0 TO CORRECT-N IF1204.2 +047200 PERFORM FAIL. IF1204.2 +047300 GO TO F-MEAN-WRITE-07. IF1204.2 +047400 F-MEAN-DELETE-07. IF1204.2 +047500 PERFORM DE-LETE. IF1204.2 +047600 GO TO F-MEAN-WRITE-07. IF1204.2 +047700 F-MEAN-WRITE-07. IF1204.2 +047800 MOVE "F-MEAN-07" TO PAR-NAME. IF1204.2 +047900 PERFORM PRINT-DETAIL. IF1204.2 +048000*****************TEST (h) - SIMPLE TEST***************** IF1204.2 +048100 F-MEAN-08. IF1204.2 +048200 MOVE ZERO TO WS-NUM. IF1204.2 +048300 F-MEAN-TEST-08. IF1204.2 +048400 COMPUTE WS-NUM = FUNCTION MEAN(IND(P), IND(Q), IND(R)). IF1204.2 +048500 IF (WS-NUM >= 5.33323) AND IF1204.2 +048600 (WS-NUM <= 5.33344) IF1204.2 +048700 PERFORM PASS IF1204.2 +048800 ELSE IF1204.2 +048900 MOVE WS-NUM TO COMPUTED-N IF1204.2 +049000 MOVE 5.333 TO CORRECT-N IF1204.2 +049100 PERFORM FAIL. IF1204.2 +049200 GO TO F-MEAN-WRITE-08. IF1204.2 +049300 F-MEAN-DELETE-08. IF1204.2 +049400 PERFORM DE-LETE. IF1204.2 +049500 GO TO F-MEAN-WRITE-08. IF1204.2 +049600 F-MEAN-WRITE-08. IF1204.2 +049700 MOVE "F-MEAN-08" TO PAR-NAME. IF1204.2 +049800 PERFORM PRINT-DETAIL. IF1204.2 +049900*****************TEST (i) - SIMPLE TEST***************** IF1204.2 +050000 F-MEAN-09. IF1204.2 +050100 MOVE ZERO TO WS-NUM. IF1204.2 +050200 F-MEAN-TEST-09. IF1204.2 +050300 COMPUTE WS-NUM = FUNCTION MEAN(IND(ALL)). IF1204.2 +050400 IF (WS-NUM >= 3.79992) AND IF1204.2 +050500 (WS-NUM <= 3.80008) IF1204.2 +050600 PERFORM PASS IF1204.2 +050700 ELSE IF1204.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1204.2 +050900 MOVE 3.8 TO CORRECT-N IF1204.2 +051000 PERFORM FAIL. IF1204.2 +051100 GO TO F-MEAN-WRITE-09. IF1204.2 +051200 F-MEAN-DELETE-09. IF1204.2 +051300 PERFORM DE-LETE. IF1204.2 +051400 GO TO F-MEAN-WRITE-09. IF1204.2 +051500 F-MEAN-WRITE-09. IF1204.2 +051600 MOVE "F-MEAN-09" TO PAR-NAME. IF1204.2 +051700 PERFORM PRINT-DETAIL. IF1204.2 +051800*****************TEST (k) - SIMPLE TEST***************** IF1204.2 +051900 F-MEAN-11. IF1204.2 +052000 MOVE ZERO TO WS-NUM. IF1204.2 +052100 F-MEAN-TEST-11. IF1204.2 +052200 COMPUTE WS-NUM = FUNCTION MEAN(M, N, O). IF1204.2 +052300 IF WS-NUM = 180000 THEN IF1204.2 +052400 PERFORM PASS IF1204.2 +052500 ELSE IF1204.2 +052600 MOVE WS-NUM TO COMPUTED-N IF1204.2 +052700 MOVE 180000 TO CORRECT-N IF1204.2 +052800 PERFORM FAIL. IF1204.2 +052900 GO TO F-MEAN-WRITE-11. IF1204.2 +053000 F-MEAN-DELETE-11. IF1204.2 +053100 PERFORM DE-LETE. IF1204.2 +053200 GO TO F-MEAN-WRITE-11. IF1204.2 +053300 F-MEAN-WRITE-11. IF1204.2 +053400 MOVE "F-MEAN-11" TO PAR-NAME. IF1204.2 +053500 PERFORM PRINT-DETAIL. IF1204.2 +053600*****************TEST (l) - SIMPLE TEST***************** IF1204.2 +053700 F-MEAN-12. IF1204.2 +053800 MOVE ZERO TO WS-NUM. IF1204.2 +053900 F-MEAN-TEST-12. IF1204.2 +054000 COMPUTE WS-NUM = FUNCTION MEAN(A, 5, A). IF1204.2 +054100 IF WS-NUM = 5 THEN IF1204.2 +054200 PERFORM PASS IF1204.2 +054300 ELSE IF1204.2 +054400 MOVE WS-NUM TO COMPUTED-N IF1204.2 +054500 MOVE 5 TO CORRECT-N IF1204.2 +054600 PERFORM FAIL. IF1204.2 +054700 GO TO F-MEAN-WRITE-12. IF1204.2 +054800 F-MEAN-DELETE-12. IF1204.2 +054900 PERFORM DE-LETE. IF1204.2 +055000 GO TO F-MEAN-WRITE-12. IF1204.2 +055100 F-MEAN-WRITE-12. IF1204.2 +055200 MOVE "F-MEAN-12" TO PAR-NAME. IF1204.2 +055300 PERFORM PRINT-DETAIL. IF1204.2 +055400*****************TEST (a) - COMPLEX TEST**************** IF1204.2 +055500 F-MEAN-13. IF1204.2 +055600 MOVE ZERO TO WS-NUM. IF1204.2 +055700 MOVE 20.6896 TO MIN-RANGE. IF1204.2 +055800 MOVE 20.6904 TO MAX-RANGE. IF1204.2 +055900 F-MEAN-TEST-13. IF1204.2 +056000 COMPUTE WS-NUM = FUNCTION MEAN(E, 9 * A, 0, B / 2). IF1204.2 +056100 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +056200 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +056300 PERFORM PASS IF1204.2 +056400 ELSE IF1204.2 +056500 MOVE WS-NUM TO COMPUTED-N IF1204.2 +056600 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +056700 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +056800 PERFORM FAIL. IF1204.2 +056900 GO TO F-MEAN-WRITE-13. IF1204.2 +057000 F-MEAN-DELETE-13. IF1204.2 +057100 PERFORM DE-LETE. IF1204.2 +057200 GO TO F-MEAN-WRITE-13. IF1204.2 +057300 F-MEAN-WRITE-13. IF1204.2 +057400 MOVE "F-MEAN-13" TO PAR-NAME. IF1204.2 +057500 PERFORM PRINT-DETAIL. IF1204.2 +057600*****************TEST (b) - COMPLEX TEST**************** IF1204.2 +057700 F-MEAN-14. IF1204.2 +057800 MOVE ZERO TO WS-NUM. IF1204.2 +057900 MOVE 83.9983 TO MIN-RANGE. IF1204.2 +058000 MOVE 84.0017 TO MAX-RANGE. IF1204.2 +058100 F-MEAN-TEST-14. IF1204.2 +058200 COMPUTE WS-NUM = FUNCTION MEAN(A, B) + 78. IF1204.2 +058300 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +058400 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +058500 PERFORM PASS IF1204.2 +058600 ELSE IF1204.2 +058700 MOVE WS-NUM TO COMPUTED-N IF1204.2 +058800 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +058900 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +059000 PERFORM FAIL. IF1204.2 +059100 GO TO F-MEAN-WRITE-14. IF1204.2 +059200 F-MEAN-DELETE-14. IF1204.2 +059300 PERFORM DE-LETE. IF1204.2 +059400 GO TO F-MEAN-WRITE-14. IF1204.2 +059500 F-MEAN-WRITE-14. IF1204.2 +059600 MOVE "F-MEAN-14" TO PAR-NAME. IF1204.2 +059700 PERFORM PRINT-DETAIL. IF1204.2 +059800*****************TEST (c) - COMPLEX TEST**************** IF1204.2 +059900 F-MEAN-15. IF1204.2 +060000 MOVE ZERO TO WS-NUM. IF1204.2 +060100 MOVE 2.49995 TO MIN-RANGE. IF1204.2 +060200 MOVE 2.50005 TO MAX-RANGE. IF1204.2 +060300 F-MEAN-TEST-15. IF1204.2 +060400 COMPUTE WS-NUM = FUNCTION MEAN(A , B) + IF1204.2 +060500 FUNCTION MEAN(-2.6, -4.4). IF1204.2 +060600 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +060700 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +060800 PERFORM PASS IF1204.2 +060900 ELSE IF1204.2 +061000 MOVE WS-NUM TO COMPUTED-N IF1204.2 +061100 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +061200 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +061300 PERFORM FAIL. IF1204.2 +061400 GO TO F-MEAN-WRITE-15. IF1204.2 +061500 F-MEAN-DELETE-15. IF1204.2 +061600 PERFORM DE-LETE. IF1204.2 +061700 GO TO F-MEAN-WRITE-15. IF1204.2 +061800 F-MEAN-WRITE-15. IF1204.2 +061900 MOVE "F-MEAN-15" TO PAR-NAME. IF1204.2 +062000 PERFORM PRINT-DETAIL. IF1204.2 +062100*****************TEST (d) - COMPLEX TEST**************** IF1204.2 +062200 F-MEAN-16. IF1204.2 +062300 MOVE ZERO TO WS-NUM. IF1204.2 +062400 MOVE 4.49991 TO MIN-RANGE. IF1204.2 +062500 MOVE 4.50009 TO MAX-RANGE. IF1204.2 +062600 F-MEAN-TEST-16. IF1204.2 +062700 COMPUTE WS-NUM = FUNCTION MEAN(FUNCTION MEAN(4, 2), 6). IF1204.2 +062800 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +062900 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +063000 PERFORM PASS IF1204.2 +063100 ELSE IF1204.2 +063200 MOVE WS-NUM TO COMPUTED-N IF1204.2 +063300 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +063400 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +063500 PERFORM FAIL. IF1204.2 +063600 GO TO F-MEAN-WRITE-16. IF1204.2 +063700 F-MEAN-DELETE-16. IF1204.2 +063800 PERFORM DE-LETE. IF1204.2 +063900 GO TO F-MEAN-WRITE-16. IF1204.2 +064000 F-MEAN-WRITE-16. IF1204.2 +064100 MOVE "F-MEAN-16" TO PAR-NAME. IF1204.2 +064200 PERFORM PRINT-DETAIL. IF1204.2 +064300*****************TEST (e) - COMPLEX TEST**************** IF1204.2 +064400 F-MEAN-17. IF1204.2 +064500 MOVE ZERO TO WS-NUM. IF1204.2 +064600 MOVE 20.7996 TO MIN-RANGE. IF1204.2 +064700 MOVE 20.8004 TO MAX-RANGE. IF1204.2 +064800 F-MEAN-TEST-17. IF1204.2 +064900 COMPUTE WS-NUM = FUNCTION MEAN(2.6 + 30, 4.5 * 2). IF1204.2 +065000 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +065100 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +065200 PERFORM PASS IF1204.2 +065300 ELSE IF1204.2 +065400 MOVE WS-NUM TO COMPUTED-N IF1204.2 +065500 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +065600 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +065700 PERFORM FAIL. IF1204.2 +065800 GO TO F-MEAN-WRITE-17. IF1204.2 +065900 F-MEAN-DELETE-17. IF1204.2 +066000 PERFORM DE-LETE. IF1204.2 +066100 GO TO F-MEAN-WRITE-17. IF1204.2 +066200 F-MEAN-WRITE-17. IF1204.2 +066300 MOVE "F-MEAN-17" TO PAR-NAME. IF1204.2 +066400 PERFORM PRINT-DETAIL. IF1204.2 +066500*****************SPECIAL PERFORM TEST********************** IF1204.2 +066600 F-MEAN-18. IF1204.2 +066700 MOVE ZERO TO WS-NUM. IF1204.2 +066800 PERFORM F-MEAN-TEST-18 IF1204.2 +066900 UNTIL FUNCTION MEAN(ARG1, ARG2) > 8. IF1204.2 +067000 PERFORM PASS. IF1204.2 +067100 GO TO F-MEAN-WRITE-18. IF1204.2 +067200 F-MEAN-TEST-18. IF1204.2 +067300 COMPUTE ARG1 = ARG1 + 1. IF1204.2 +067400 COMPUTE ARG2 = ARG2 + 1. IF1204.2 +067500 F-MEAN-DELETE-18. IF1204.2 +067600 PERFORM DE-LETE. IF1204.2 +067700 GO TO F-MEAN-WRITE-18. IF1204.2 +067800 F-MEAN-WRITE-18. IF1204.2 +067900 MOVE "F-MEAN-18" TO PAR-NAME. IF1204.2 +068000 PERFORM PRINT-DETAIL. IF1204.2 +068100********************END OF TESTS*************** IF1204.2 +068200 CCVS-EXIT SECTION. IF1204.2 +068300 CCVS-999999. IF1204.2 +068400 GO TO CLOSE-FILES. IF1204.2 +*END-OF,IF120A +*HEADER,COBOL,IF121A +000100 IDENTIFICATION DIVISION. IF1214.2 +000200 PROGRAM-ID. IF1214.2 +000300 IF121A. IF1214.2 +000400 IF1214.2 +000500*********************************************************** IF1214.2 +000600* * IF1214.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1214.2 +000800* It contains tests for the Intrinsic Function MEDIAN. * IF1214.2 +000900* * IF1214.2 +001000*********************************************************** IF1214.2 +001100 ENVIRONMENT DIVISION. IF1214.2 +001200 CONFIGURATION SECTION. IF1214.2 +001300 SOURCE-COMPUTER. IF1214.2 +001400 XXXXX082. IF1214.2 +001500 OBJECT-COMPUTER. IF1214.2 +001600 XXXXX083. IF1214.2 +001700 INPUT-OUTPUT SECTION. IF1214.2 +001800 FILE-CONTROL. IF1214.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1214.2 +002000 XXXXX055. IF1214.2 +002100 DATA DIVISION. IF1214.2 +002200 FILE SECTION. IF1214.2 +002300 FD PRINT-FILE. IF1214.2 +002400 01 PRINT-REC PICTURE X(120). IF1214.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1214.2 +002600 WORKING-STORAGE SECTION. IF1214.2 +002700*********************************************************** IF1214.2 +002800* Variables specific to the Intrinsic Function Test IF121A* IF1214.2 +002900*********************************************************** IF1214.2 +003000 01 A PIC S9(10) VALUE 5. IF1214.2 +003100 01 B PIC S9(10) VALUE 7. IF1214.2 +003200 01 C PIC S9(10) VALUE -4. IF1214.2 +003300 01 D PIC S9(10) VALUE 10. IF1214.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1214.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1214.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1214.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1214.2 +003800 01 M PIC S9(10) VALUE 320000. IF1214.2 +003900 01 N PIC S9(10) VALUE 650000. IF1214.2 +004000 01 O PIC S9(10) VALUE -430000. IF1214.2 +004100 01 P PIC S9(10) VALUE 1. IF1214.2 +004200 01 Q PIC S9(10) VALUE 3. IF1214.2 +004300 01 R PIC S9(10) VALUE 5. IF1214.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1214.2 +004500 01 ARG2 PIC S9(10) VALUE 2. IF1214.2 +004600 01 ARR VALUE "40537". IF1214.2 +004700 02 IND OCCURS 5 TIMES PIC 9. IF1214.2 +004800 01 TEMP PIC S9(10)V9(5). IF1214.2 +004900 01 WS-NUM PIC S9(6)V9(7). IF1214.2 +005000 01 MIN-RANGE PIC S9(5)V9(7). IF1214.2 +005100 01 MAX-RANGE PIC S9(5)V9(7). IF1214.2 +005200* IF1214.2 +005300********************************************************** IF1214.2 +005400* IF1214.2 +005500 01 TEST-RESULTS. IF1214.2 +005600 02 FILLER PIC X VALUE SPACE. IF1214.2 +005700 02 FEATURE PIC X(20) VALUE SPACE. IF1214.2 +005800 02 FILLER PIC X VALUE SPACE. IF1214.2 +005900 02 P-OR-F PIC X(5) VALUE SPACE. IF1214.2 +006000 02 FILLER PIC X VALUE SPACE. IF1214.2 +006100 02 PAR-NAME. IF1214.2 +006200 03 FILLER PIC X(19) VALUE SPACE. IF1214.2 +006300 03 PARDOT-X PIC X VALUE SPACE. IF1214.2 +006400 03 DOTVALUE PIC 99 VALUE ZERO. IF1214.2 +006500 02 FILLER PIC X(8) VALUE SPACE. IF1214.2 +006600 02 RE-MARK PIC X(61). IF1214.2 +006700 01 TEST-COMPUTED. IF1214.2 +006800 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +006900 02 FILLER PIC X(17) VALUE IF1214.2 +007000 " COMPUTED=". IF1214.2 +007100 02 COMPUTED-X. IF1214.2 +007200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1214.2 +007300 03 COMPUTED-N REDEFINES COMPUTED-A IF1214.2 +007400 PIC -9(9).9(9). IF1214.2 +007500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1214.2 +007600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1214.2 +007700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1214.2 +007800 03 CM-18V0 REDEFINES COMPUTED-A. IF1214.2 +007900 04 COMPUTED-18V0 PIC -9(18). IF1214.2 +008000 04 FILLER PIC X. IF1214.2 +008100 03 FILLER PIC X(50) VALUE SPACE. IF1214.2 +008200 01 TEST-CORRECT. IF1214.2 +008300 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +008400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1214.2 +008500 02 CORRECT-X. IF1214.2 +008600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1214.2 +008700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1214.2 +008800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1214.2 +008900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1214.2 +009000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1214.2 +009100 03 CR-18V0 REDEFINES CORRECT-A. IF1214.2 +009200 04 CORRECT-18V0 PIC -9(18). IF1214.2 +009300 04 FILLER PIC X. IF1214.2 +009400 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +009500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1214.2 +009600 01 TEST-CORRECT-MIN. IF1214.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +009800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1214.2 +009900 02 CORRECTMI-X. IF1214.2 +010000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1214.2 +010100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1214.2 +010200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1214.2 +010300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1214.2 +010400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1214.2 +010500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1214.2 +010600 04 CORRECTMI-18V0 PIC -9(18). IF1214.2 +010700 04 FILLER PIC X. IF1214.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +010900 03 FILLER PIC X(48) VALUE SPACE. IF1214.2 +011000 01 TEST-CORRECT-MAX. IF1214.2 +011100 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +011200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1214.2 +011300 02 CORRECTMA-X. IF1214.2 +011400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1214.2 +011500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1214.2 +011600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1214.2 +011700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1214.2 +011800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1214.2 +011900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1214.2 +012000 04 CORRECTMA-18V0 PIC -9(18). IF1214.2 +012100 04 FILLER PIC X. IF1214.2 +012200 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +012300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1214.2 +012400 01 CCVS-C-1. IF1214.2 +012500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1214.2 +012600- "SS PARAGRAPH-NAME IF1214.2 +012700- " REMARKS". IF1214.2 +012800 02 FILLER PIC X(20) VALUE SPACE. IF1214.2 +012900 01 CCVS-C-2. IF1214.2 +013000 02 FILLER PIC X VALUE SPACE. IF1214.2 +013100 02 FILLER PIC X(6) VALUE "TESTED". IF1214.2 +013200 02 FILLER PIC X(15) VALUE SPACE. IF1214.2 +013300 02 FILLER PIC X(4) VALUE "FAIL". IF1214.2 +013400 02 FILLER PIC X(94) VALUE SPACE. IF1214.2 +013500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1214.2 +013600 01 REC-CT PIC 99 VALUE ZERO. IF1214.2 +013700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1214.2 +013800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1214.2 +013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1214.2 +014000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1214.2 +014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1214.2 +014200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1214.2 +014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1214.2 +014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1214.2 +014500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1214.2 +014600 01 CCVS-H-1. IF1214.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1214.2 +014800 02 FILLER PIC X(42) VALUE IF1214.2 +014900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1214.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1214.2 +015100 01 CCVS-H-2A. IF1214.2 +015200 02 FILLER PIC X(40) VALUE SPACE. IF1214.2 +015300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1214.2 +015400 02 FILLER PIC XXXX VALUE IF1214.2 +015500 "4.2 ". IF1214.2 +015600 02 FILLER PIC X(28) VALUE IF1214.2 +015700 " COPY - NOT FOR DISTRIBUTION". IF1214.2 +015800 02 FILLER PIC X(41) VALUE SPACE. IF1214.2 +015900 IF1214.2 +016000 01 CCVS-H-2B. IF1214.2 +016100 02 FILLER PIC X(15) VALUE IF1214.2 +016200 "TEST RESULT OF ". IF1214.2 +016300 02 TEST-ID PIC X(9). IF1214.2 +016400 02 FILLER PIC X(4) VALUE IF1214.2 +016500 " IN ". IF1214.2 +016600 02 FILLER PIC X(12) VALUE IF1214.2 +016700 " HIGH ". IF1214.2 +016800 02 FILLER PIC X(22) VALUE IF1214.2 +016900 " LEVEL VALIDATION FOR ". IF1214.2 +017000 02 FILLER PIC X(58) VALUE IF1214.2 +017100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1214.2 +017200 01 CCVS-H-3. IF1214.2 +017300 02 FILLER PIC X(34) VALUE IF1214.2 +017400 " FOR OFFICIAL USE ONLY ". IF1214.2 +017500 02 FILLER PIC X(58) VALUE IF1214.2 +017600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1214.2 +017700 02 FILLER PIC X(28) VALUE IF1214.2 +017800 " COPYRIGHT 1985 ". IF1214.2 +017900 01 CCVS-E-1. IF1214.2 +018000 02 FILLER PIC X(52) VALUE SPACE. IF1214.2 +018100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1214.2 +018200 02 ID-AGAIN PIC X(9). IF1214.2 +018300 02 FILLER PIC X(45) VALUE SPACES. IF1214.2 +018400 01 CCVS-E-2. IF1214.2 +018500 02 FILLER PIC X(31) VALUE SPACE. IF1214.2 +018600 02 FILLER PIC X(21) VALUE SPACE. IF1214.2 +018700 02 CCVS-E-2-2. IF1214.2 +018800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1214.2 +018900 03 FILLER PIC X VALUE SPACE. IF1214.2 +019000 03 ENDER-DESC PIC X(44) VALUE IF1214.2 +019100 "ERRORS ENCOUNTERED". IF1214.2 +019200 01 CCVS-E-3. IF1214.2 +019300 02 FILLER PIC X(22) VALUE IF1214.2 +019400 " FOR OFFICIAL USE ONLY". IF1214.2 +019500 02 FILLER PIC X(12) VALUE SPACE. IF1214.2 +019600 02 FILLER PIC X(58) VALUE IF1214.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1214.2 +019800 02 FILLER PIC X(13) VALUE SPACE. IF1214.2 +019900 02 FILLER PIC X(15) VALUE IF1214.2 +020000 " COPYRIGHT 1985". IF1214.2 +020100 01 CCVS-E-4. IF1214.2 +020200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1214.2 +020300 02 FILLER PIC X(4) VALUE " OF ". IF1214.2 +020400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1214.2 +020500 02 FILLER PIC X(40) VALUE IF1214.2 +020600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1214.2 +020700 01 XXINFO. IF1214.2 +020800 02 FILLER PIC X(19) VALUE IF1214.2 +020900 "*** INFORMATION ***". IF1214.2 +021000 02 INFO-TEXT. IF1214.2 +021100 04 FILLER PIC X(8) VALUE SPACE. IF1214.2 +021200 04 XXCOMPUTED PIC X(20). IF1214.2 +021300 04 FILLER PIC X(5) VALUE SPACE. IF1214.2 +021400 04 XXCORRECT PIC X(20). IF1214.2 +021500 02 INF-ANSI-REFERENCE PIC X(48). IF1214.2 +021600 01 HYPHEN-LINE. IF1214.2 +021700 02 FILLER PIC IS X VALUE IS SPACE. IF1214.2 +021800 02 FILLER PIC IS X(65) VALUE IS "************************IF1214.2 +021900- "*****************************************". IF1214.2 +022000 02 FILLER PIC IS X(54) VALUE IS "************************IF1214.2 +022100- "******************************". IF1214.2 +022200 01 CCVS-PGM-ID PIC X(9) VALUE IF1214.2 +022300 "IF121A". IF1214.2 +022400 PROCEDURE DIVISION. IF1214.2 +022500 CCVS1 SECTION. IF1214.2 +022600 OPEN-FILES. IF1214.2 +022700 OPEN OUTPUT PRINT-FILE. IF1214.2 +022800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1214.2 +022900 MOVE SPACE TO TEST-RESULTS. IF1214.2 +023000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1214.2 +023100 GO TO CCVS1-EXIT. IF1214.2 +023200 CLOSE-FILES. IF1214.2 +023300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1214.2 +023400 TERMINATE-CCVS. IF1214.2 +023500 STOP RUN. IF1214.2 +023600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1214.2 +023700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1214.2 +023800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1214.2 +023900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1214.2 +024000 MOVE "****TEST DELETED****" TO RE-MARK. IF1214.2 +024100 PRINT-DETAIL. IF1214.2 +024200 IF REC-CT NOT EQUAL TO ZERO IF1214.2 +024300 MOVE "." TO PARDOT-X IF1214.2 +024400 MOVE REC-CT TO DOTVALUE. IF1214.2 +024500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1214.2 +024600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1214.2 +024700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1214.2 +024800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1214.2 +024900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1214.2 +025000 MOVE SPACE TO CORRECT-X. IF1214.2 +025100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1214.2 +025200 MOVE SPACE TO RE-MARK. IF1214.2 +025300 HEAD-ROUTINE. IF1214.2 +025400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +025500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +025600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1214.2 +025700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1214.2 +025800 COLUMN-NAMES-ROUTINE. IF1214.2 +025900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +026000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +026100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +026200 END-ROUTINE. IF1214.2 +026300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1214.2 +026400 END-RTN-EXIT. IF1214.2 +026500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +026600 END-ROUTINE-1. IF1214.2 +026700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1214.2 +026800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1214.2 +026900 ADD PASS-COUNTER TO ERROR-HOLD. IF1214.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1214.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1214.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1214.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1214.2 +027400 END-ROUTINE-12. IF1214.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1214.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1214.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1214.2 +027800 ELSE IF1214.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1214.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1214.2 +028100 PERFORM WRITE-LINE. IF1214.2 +028200 END-ROUTINE-13. IF1214.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1214.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IF1214.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1214.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1214.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IF1214.2 +028900 MOVE "NO " TO ERROR-TOTAL IF1214.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1214.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1214.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +029400 WRITE-LINE. IF1214.2 +029500 ADD 1 TO RECORD-COUNT. IF1214.2 +029600Y IF RECORD-COUNT GREATER 42 IF1214.2 +029700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1214.2 +029800Y MOVE SPACE TO DUMMY-RECORD IF1214.2 +029900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1214.2 +030000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1214.2 +030100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1214.2 +030200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1214.2 +030300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1214.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1214.2 +030800Y MOVE ZERO TO RECORD-COUNT. IF1214.2 +030900 PERFORM WRT-LN. IF1214.2 +031000 WRT-LN. IF1214.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1214.2 +031200 MOVE SPACE TO DUMMY-RECORD. IF1214.2 +031300 BLANK-LINE-PRINT. IF1214.2 +031400 PERFORM WRT-LN. IF1214.2 +031500 FAIL-ROUTINE. IF1214.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE IF1214.2 +031700 GO TO FAIL-ROUTINE-WRITE. IF1214.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1214.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1214.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1214.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1214.2 +032300 GO TO FAIL-ROUTINE-EX. IF1214.2 +032400 FAIL-ROUTINE-WRITE. IF1214.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1214.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1214.2 +032700 CORMA-ANSI-REFERENCE. IF1214.2 +032800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1214.2 +032900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1214.2 +033000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1214.2 +033100 ELSE IF1214.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1214.2 +033300 PERFORM WRITE-LINE. IF1214.2 +033400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1214.2 +033500 FAIL-ROUTINE-EX. EXIT. IF1214.2 +033600 BAIL-OUT. IF1214.2 +033700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1214.2 +033800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1214.2 +033900 BAIL-OUT-WRITE. IF1214.2 +034000 MOVE CORRECT-A TO XXCORRECT. IF1214.2 +034100 MOVE COMPUTED-A TO XXCOMPUTED. IF1214.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1214.2 +034300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +034400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1214.2 +034500 BAIL-OUT-EX. EXIT. IF1214.2 +034600 CCVS1-EXIT. IF1214.2 +034700 EXIT. IF1214.2 +034800******************************************************** IF1214.2 +034900* * IF1214.2 +035000* Intrinsic Function Tests IF121A - MEDIAN * IF1214.2 +035100* * IF1214.2 +035200******************************************************** IF1214.2 +035300 SECT-IF121A SECTION. IF1214.2 +035400 F-MEDIAN-INFO. IF1214.2 +035500 MOVE "See ref. A-54 2.25" TO ANSI-REFERENCE. IF1214.2 +035600 MOVE "MEDIAN Function" TO FEATURE. IF1214.2 +035700*****************TEST (a) - SIMPLE TEST***************** IF1214.2 +035800 F-MEDIAN-01. IF1214.2 +035900 MOVE ZERO TO WS-NUM. IF1214.2 +036000 F-MEDIAN-TEST-01. IF1214.2 +036100 COMPUTE WS-NUM = FUNCTION MEDIAN(5, -2, -14, 0). IF1214.2 +036200 IF WS-NUM = -1 THEN IF1214.2 +036300 PERFORM PASS IF1214.2 +036400 ELSE IF1214.2 +036500 MOVE WS-NUM TO COMPUTED-N IF1214.2 +036600 MOVE -1 TO CORRECT-N IF1214.2 +036700 PERFORM FAIL. IF1214.2 +036800 GO TO F-MEDIAN-WRITE-01. IF1214.2 +036900 F-MEDIAN-DELETE-01. IF1214.2 +037000 PERFORM DE-LETE. IF1214.2 +037100 GO TO F-MEDIAN-WRITE-01. IF1214.2 +037200 F-MEDIAN-WRITE-01. IF1214.2 +037300 MOVE "F-MEDIAN-01" TO PAR-NAME. IF1214.2 +037400 PERFORM PRINT-DETAIL. IF1214.2 +037500*****************TEST (b) - SIMPLE TEST***************** IF1214.2 +037600 F-MEDIAN-02. IF1214.2 +037700 EVALUATE FUNCTION MEDIAN(3.9, -0.3, 8.7, 100.2) IF1214.2 +037800 WHEN 6.29987 THRU 6.30013 IF1214.2 +037900 PERFORM PASS IF1214.2 +038000 WHEN OTHER IF1214.2 +038100 PERFORM FAIL. IF1214.2 +038200 GO TO F-MEDIAN-WRITE-02. IF1214.2 +038300 F-MEDIAN-DELETE-02. IF1214.2 +038400 PERFORM DE-LETE. IF1214.2 +038500 GO TO F-MEDIAN-WRITE-02. IF1214.2 +038600 F-MEDIAN-WRITE-02. IF1214.2 +038700 MOVE "F-MEDIAN-02" TO PAR-NAME. IF1214.2 +038800 PERFORM PRINT-DETAIL. IF1214.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1214.2 +039000 F-MEDIAN-03. IF1214.2 +039100 IF FUNCTION MEDIAN(A, B, C, D) = 6 THEN IF1214.2 +039200 PERFORM PASS IF1214.2 +039300 ELSE IF1214.2 +039400 PERFORM FAIL. IF1214.2 +039500 GO TO F-MEDIAN-WRITE-03. IF1214.2 +039600 F-MEDIAN-DELETE-03. IF1214.2 +039700 PERFORM DE-LETE. IF1214.2 +039800 GO TO F-MEDIAN-WRITE-03. IF1214.2 +039900 F-MEDIAN-WRITE-03. IF1214.2 +040000 MOVE "F-MEDIAN-03" TO PAR-NAME. IF1214.2 +040100 PERFORM PRINT-DETAIL. IF1214.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1214.2 +040300 F-MEDIAN-04. IF1214.2 +040400 MOVE ZERO TO WS-NUM. IF1214.2 +040500 F-MEDIAN-TEST-04. IF1214.2 +040600 COMPUTE WS-NUM = FUNCTION MEDIAN(E, F, G). IF1214.2 +040700 IF (WS-NUM >= 4.07992) AND IF1214.2 +040800 (WS-NUM <= 4.08008) IF1214.2 +040900 PERFORM PASS IF1214.2 +041000 ELSE IF1214.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +041200 MOVE 4.08 TO CORRECT-N IF1214.2 +041300 PERFORM FAIL. IF1214.2 +041400 GO TO F-MEDIAN-WRITE-04. IF1214.2 +041500 F-MEDIAN-DELETE-04. IF1214.2 +041600 PERFORM DE-LETE. IF1214.2 +041700 GO TO F-MEDIAN-WRITE-04. IF1214.2 +041800 F-MEDIAN-WRITE-04. IF1214.2 +041900 MOVE "F-MEDIAN-04" TO PAR-NAME. IF1214.2 +042000 PERFORM PRINT-DETAIL. IF1214.2 +042100*****************TEST (e) - SIMPLE TEST***************** IF1214.2 +042200 F-MEDIAN-05. IF1214.2 +042300 MOVE ZERO TO WS-NUM. IF1214.2 +042400 F-MEDIAN-TEST-05. IF1214.2 +042500 COMPUTE WS-NUM = FUNCTION MEDIAN(10.2, -0.2, 5.6, -15.6). IF1214.2 +042600 IF (WS-NUM >= 2.69995) AND IF1214.2 +042700 (WS-NUM <= 2.70005) IF1214.2 +042800 PERFORM PASS IF1214.2 +042900 ELSE IF1214.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1214.2 +043100 MOVE 2.7 TO CORRECT-N IF1214.2 +043200 PERFORM FAIL. IF1214.2 +043300 GO TO F-MEDIAN-WRITE-05. IF1214.2 +043400 F-MEDIAN-DELETE-05. IF1214.2 +043500 PERFORM DE-LETE. IF1214.2 +043600 GO TO F-MEDIAN-WRITE-05. IF1214.2 +043700 F-MEDIAN-WRITE-05. IF1214.2 +043800 MOVE "F-MEDIAN-05" TO PAR-NAME. IF1214.2 +043900 PERFORM PRINT-DETAIL. IF1214.2 +044000*****************TEST (f) - SIMPLE TEST***************** IF1214.2 +044100 F-MEDIAN-06. IF1214.2 +044200 MOVE ZERO TO WS-NUM. IF1214.2 +044300 F-MEDIAN-TEST-06. IF1214.2 +044400 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B, C, D, E, F, G). IF1214.2 +044500 IF (WS-NUM >= 4.99990) AND IF1214.2 +044600 (WS-NUM <= 5.00010) IF1214.2 +044700 PERFORM PASS IF1214.2 +044800 ELSE IF1214.2 +044900 MOVE WS-NUM TO COMPUTED-N IF1214.2 +045000 MOVE 5 TO CORRECT-N IF1214.2 +045100 PERFORM FAIL. IF1214.2 +045200 GO TO F-MEDIAN-WRITE-06. IF1214.2 +045300 F-MEDIAN-DELETE-06. IF1214.2 +045400 PERFORM DE-LETE. IF1214.2 +045500 GO TO F-MEDIAN-WRITE-06. IF1214.2 +045600 F-MEDIAN-WRITE-06. IF1214.2 +045700 MOVE "F-MEDIAN-06" TO PAR-NAME. IF1214.2 +045800 PERFORM PRINT-DETAIL. IF1214.2 +045900*****************TEST (g) - SIMPLE TEST***************** IF1214.2 +046000 F-MEDIAN-07. IF1214.2 +046100 MOVE ZERO TO WS-NUM. IF1214.2 +046200 F-MEDIAN-TEST-07. IF1214.2 +046300 COMPUTE WS-NUM = FUNCTION MEDIAN(IND(1), IND(2), IND(3)). IF1214.2 +046400 IF WS-NUM = 4 THEN IF1214.2 +046500 PERFORM PASS IF1214.2 +046600 ELSE IF1214.2 +046700 MOVE WS-NUM TO COMPUTED-N IF1214.2 +046800 MOVE 4 TO CORRECT-N IF1214.2 +046900 PERFORM FAIL. IF1214.2 +047000 GO TO F-MEDIAN-WRITE-07. IF1214.2 +047100 F-MEDIAN-DELETE-07. IF1214.2 +047200 PERFORM DE-LETE. IF1214.2 +047300 GO TO F-MEDIAN-WRITE-07. IF1214.2 +047400 F-MEDIAN-WRITE-07. IF1214.2 +047500 MOVE "F-MEDIAN-07" TO PAR-NAME. IF1214.2 +047600 PERFORM PRINT-DETAIL. IF1214.2 +047700*****************TEST (h) - SIMPLE TEST***************** IF1214.2 +047800 F-MEDIAN-08. IF1214.2 +047900 MOVE ZERO TO WS-NUM. IF1214.2 +048000 F-MEDIAN-TEST-08. IF1214.2 +048100 COMPUTE WS-NUM = FUNCTION MEDIAN(IND(P), IND(Q), IND(R)). IF1214.2 +048200 IF1214.2 +048300 IF WS-NUM = 5 THEN IF1214.2 +048400 PERFORM PASS IF1214.2 +048500 ELSE IF1214.2 +048600 MOVE WS-NUM TO COMPUTED-N IF1214.2 +048700 MOVE 5 TO CORRECT-N IF1214.2 +048800 PERFORM FAIL. IF1214.2 +048900 GO TO F-MEDIAN-WRITE-08. IF1214.2 +049000 F-MEDIAN-DELETE-08. IF1214.2 +049100 PERFORM DE-LETE. IF1214.2 +049200 GO TO F-MEDIAN-WRITE-08. IF1214.2 +049300 F-MEDIAN-WRITE-08. IF1214.2 +049400 MOVE "F-MEDIAN-08" TO PAR-NAME. IF1214.2 +049500 PERFORM PRINT-DETAIL. IF1214.2 +049600*****************TEST (i) - SIMPLE TEST***************** IF1214.2 +049700 F-MEDIAN-09. IF1214.2 +049800 MOVE ZERO TO WS-NUM. IF1214.2 +049900 F-MEDIAN-TEST-09. IF1214.2 +050000 COMPUTE WS-NUM = FUNCTION MEDIAN(IND(ALL)). IF1214.2 +050100 IF WS-NUM = 4 THEN IF1214.2 +050200 PERFORM PASS IF1214.2 +050300 ELSE IF1214.2 +050400 MOVE WS-NUM TO COMPUTED-N IF1214.2 +050500 MOVE 4 TO CORRECT-N IF1214.2 +050600 PERFORM FAIL. IF1214.2 +050700 GO TO F-MEDIAN-WRITE-09. IF1214.2 +050800 F-MEDIAN-DELETE-09. IF1214.2 +050900 PERFORM DE-LETE. IF1214.2 +051000 GO TO F-MEDIAN-WRITE-09. IF1214.2 +051100 F-MEDIAN-WRITE-09. IF1214.2 +051200 MOVE "F-MEDIAN-09" TO PAR-NAME. IF1214.2 +051300 PERFORM PRINT-DETAIL. IF1214.2 +051400*****************TEST (k) - SIMPLE TEST***************** IF1214.2 +051500 F-MEDIAN-11. IF1214.2 +051600 MOVE ZERO TO WS-NUM. IF1214.2 +051700 F-MEDIAN-TEST-11. IF1214.2 +051800 COMPUTE WS-NUM = FUNCTION MEDIAN(M, N, O). IF1214.2 +051900 IF WS-NUM = 320000 THEN IF1214.2 +052000 PERFORM PASS IF1214.2 +052100 ELSE IF1214.2 +052200 MOVE WS-NUM TO COMPUTED-N IF1214.2 +052300 MOVE 320000 TO CORRECT-N IF1214.2 +052400 PERFORM FAIL. IF1214.2 +052500 GO TO F-MEDIAN-WRITE-11. IF1214.2 +052600 F-MEDIAN-DELETE-11. IF1214.2 +052700 PERFORM DE-LETE. IF1214.2 +052800 GO TO F-MEDIAN-WRITE-11. IF1214.2 +052900 F-MEDIAN-WRITE-11. IF1214.2 +053000 MOVE "F-MEDIAN-11" TO PAR-NAME. IF1214.2 +053100 PERFORM PRINT-DETAIL. IF1214.2 +053200*****************TEST (l) - SIMPLE TEST***************** IF1214.2 +053300 F-MEDIAN-12. IF1214.2 +053400 MOVE ZERO TO WS-NUM. IF1214.2 +053500 F-MEDIAN-TEST-12. IF1214.2 +053600 COMPUTE WS-NUM = FUNCTION MEDIAN(A, 5, A). IF1214.2 +053700 IF WS-NUM = 5 THEN IF1214.2 +053800 PERFORM PASS IF1214.2 +053900 ELSE IF1214.2 +054000 MOVE WS-NUM TO COMPUTED-N IF1214.2 +054100 MOVE 5 TO CORRECT-N IF1214.2 +054200 PERFORM FAIL. IF1214.2 +054300 GO TO F-MEDIAN-WRITE-12. IF1214.2 +054400 F-MEDIAN-DELETE-12. IF1214.2 +054500 PERFORM DE-LETE. IF1214.2 +054600 GO TO F-MEDIAN-WRITE-12. IF1214.2 +054700 F-MEDIAN-WRITE-12. IF1214.2 +054800 MOVE "F-MEDIAN-12" TO PAR-NAME. IF1214.2 +054900 PERFORM PRINT-DETAIL. IF1214.2 +055000*****************TEST (a) - COMPLEX TEST**************** IF1214.2 +055100 F-MEDIAN-13. IF1214.2 +055200 MOVE ZERO TO WS-NUM. IF1214.2 +055300 MOVE 20.7996 TO MIN-RANGE. IF1214.2 +055400 MOVE 20.8004 TO MAX-RANGE. IF1214.2 +055500 F-MEDIAN-TEST-13. IF1214.2 +055600 COMPUTE WS-NUM = FUNCTION MEDIAN(2.6 + 30, 4.5 * 2). IF1214.2 +055700 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +055800 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +055900 PERFORM PASS IF1214.2 +056000 ELSE IF1214.2 +056100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +056200 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +056300 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +056400 PERFORM FAIL. IF1214.2 +056500 GO TO F-MEDIAN-WRITE-13. IF1214.2 +056600 F-MEDIAN-DELETE-13. IF1214.2 +056700 PERFORM DE-LETE. IF1214.2 +056800 GO TO F-MEDIAN-WRITE-13. IF1214.2 +056900 F-MEDIAN-WRITE-13. IF1214.2 +057000 MOVE "F-MEDIAN-13" TO PAR-NAME. IF1214.2 +057100 PERFORM PRINT-DETAIL. IF1214.2 +057200*****************TEST (b) - COMPLEX TEST**************** IF1214.2 +057300 F-MEDIAN-14. IF1214.2 +057400 MOVE ZERO TO WS-NUM. IF1214.2 +057500 MOVE 34.2593 TO MIN-RANGE. IF1214.2 +057600 MOVE 34.2607 TO MAX-RANGE. IF1214.2 +057700 F-MEDIAN-TEST-14. IF1214.2 +057800 COMPUTE WS-NUM = FUNCTION MEDIAN(E, 9 * A, B / 2). IF1214.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +058100 PERFORM PASS IF1214.2 +058200 ELSE IF1214.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1214.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +058600 PERFORM FAIL. IF1214.2 +058700 GO TO F-MEDIAN-WRITE-14. IF1214.2 +058800 F-MEDIAN-DELETE-14. IF1214.2 +058900 PERFORM DE-LETE. IF1214.2 +059000 GO TO F-MEDIAN-WRITE-14. IF1214.2 +059100 F-MEDIAN-WRITE-14. IF1214.2 +059200 MOVE "F-MEDIAN-14" TO PAR-NAME. IF1214.2 +059300 PERFORM PRINT-DETAIL. IF1214.2 +059400*****************TEST (c) - COMPLEX TEST**************** IF1214.2 +059500 F-MEDIAN-15. IF1214.2 +059600 MOVE ZERO TO WS-NUM. IF1214.2 +059700 MOVE 83.9983 TO MIN-RANGE. IF1214.2 +059800 MOVE 84.0017 TO MAX-RANGE. IF1214.2 +059900 F-MEDIAN-TEST-15. IF1214.2 +060000 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B) + 78. IF1214.2 +060100 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +060200 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +060300 PERFORM PASS IF1214.2 +060400 ELSE IF1214.2 +060500 MOVE WS-NUM TO COMPUTED-N IF1214.2 +060600 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +060700 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +060800 PERFORM FAIL. IF1214.2 +060900 GO TO F-MEDIAN-WRITE-15. IF1214.2 +061000 F-MEDIAN-DELETE-15. IF1214.2 +061100 PERFORM DE-LETE. IF1214.2 +061200 GO TO F-MEDIAN-WRITE-15. IF1214.2 +061300 F-MEDIAN-WRITE-15. IF1214.2 +061400 MOVE "F-MEDIAN-15" TO PAR-NAME. IF1214.2 +061500 PERFORM PRINT-DETAIL. IF1214.2 +061600*****************TEST (d) - COMPLEX TEST**************** IF1214.2 +061700 F-MEDIAN-16. IF1214.2 +061800 MOVE ZERO TO WS-NUM. IF1214.2 +061900 MOVE 3.39932 TO MIN-RANGE. IF1214.2 +062000 MOVE 3.40007 TO MAX-RANGE. IF1214.2 +062100 F-MEDIAN-TEST-16. IF1214.2 +062200 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B) + IF1214.2 +062300 FUNCTION MEDIAN(-2.6, -4.4, 1). IF1214.2 +062400 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +062500 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +062600 PERFORM PASS IF1214.2 +062700 ELSE IF1214.2 +062800 MOVE WS-NUM TO COMPUTED-N IF1214.2 +062900 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +063000 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +063100 PERFORM FAIL. IF1214.2 +063200 GO TO F-MEDIAN-WRITE-16. IF1214.2 +063300 F-MEDIAN-DELETE-16. IF1214.2 +063400 PERFORM DE-LETE. IF1214.2 +063500 GO TO F-MEDIAN-WRITE-16. IF1214.2 +063600 F-MEDIAN-WRITE-16. IF1214.2 +063700 MOVE "F-MEDIAN-16" TO PAR-NAME. IF1214.2 +063800 PERFORM PRINT-DETAIL. IF1214.2 +063900*****************TEST (e) - COMPLEX TEST**************** IF1214.2 +064000 F-MEDIAN-17. IF1214.2 +064100 MOVE ZERO TO WS-NUM. IF1214.2 +064200 MOVE 2.24995 TO MIN-RANGE. IF1214.2 +064300 MOVE 2.25004 TO MAX-RANGE. IF1214.2 +064400 F-MEDIAN-TEST-17. IF1214.2 +064500 COMPUTE WS-NUM = IF1214.2 +064600 FUNCTION MEDIAN(FUNCTION MEDIAN(1, 2), 3). IF1214.2 +064700 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +064800 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +064900 PERFORM PASS IF1214.2 +065000 ELSE IF1214.2 +065100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +065200 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +065300 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +065400 PERFORM FAIL. IF1214.2 +065500 GO TO F-MEDIAN-WRITE-17. IF1214.2 +065600 F-MEDIAN-DELETE-17. IF1214.2 +065700 PERFORM DE-LETE. IF1214.2 +065800 GO TO F-MEDIAN-WRITE-17. IF1214.2 +065900 F-MEDIAN-WRITE-17. IF1214.2 +066000 MOVE "F-MEDIAN-17" TO PAR-NAME. IF1214.2 +066100 PERFORM PRINT-DETAIL. IF1214.2 +066200*****************SPECIAL PERFORM TEST********************** IF1214.2 +066300 F-MEDIAN-18. IF1214.2 +066400 PERFORM F-MEDIAN-TEST-18 IF1214.2 +066500 UNTIL FUNCTION MEDIAN(1, ARG1, ARG2, 20) > 10. IF1214.2 +066600 PERFORM PASS. IF1214.2 +066700 GO TO F-MEDIAN-WRITE-18. IF1214.2 +066800 F-MEDIAN-TEST-18. IF1214.2 +066900 COMPUTE ARG1 = ARG1 + 1. IF1214.2 +067000 COMPUTE ARG2 = ARG2 + 1. IF1214.2 +067100 F-MEDIAN-DELETE-18. IF1214.2 +067200 PERFORM DE-LETE. IF1214.2 +067300 GO TO F-MEDIAN-WRITE-18. IF1214.2 +067400 F-MEDIAN-WRITE-18. IF1214.2 +067500 MOVE "F-MEDIAN-18" TO PAR-NAME. IF1214.2 +067600 PERFORM PRINT-DETAIL. IF1214.2 +067700********************END OF TESTS*************** IF1214.2 +067800 CCVS-EXIT SECTION. IF1214.2 +067900 CCVS-999999. IF1214.2 +068000 GO TO CLOSE-FILES. IF1214.2 +*END-OF,IF121A +*HEADER,COBOL,IF122A +000100 IDENTIFICATION DIVISION. IF1224.2 +000200 PROGRAM-ID. IF1224.2 +000300 IF122A. IF1224.2 +000400 IF1224.2 +000500*********************************************************** IF1224.2 +000600* * IF1224.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1224.2 +000800* It contains tests for the Intrinsic Function MIDRANGE * IF1224.2 +000900* * IF1224.2 +001000*********************************************************** IF1224.2 +001100 ENVIRONMENT DIVISION. IF1224.2 +001200 CONFIGURATION SECTION. IF1224.2 +001300 SOURCE-COMPUTER. IF1224.2 +001400 XXXXX082. IF1224.2 +001500 OBJECT-COMPUTER. IF1224.2 +001600 XXXXX083. IF1224.2 +001700 INPUT-OUTPUT SECTION. IF1224.2 +001800 FILE-CONTROL. IF1224.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1224.2 +002000 XXXXX055. IF1224.2 +002100 DATA DIVISION. IF1224.2 +002200 FILE SECTION. IF1224.2 +002300 FD PRINT-FILE. IF1224.2 +002400 01 PRINT-REC PICTURE X(120). IF1224.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1224.2 +002600 WORKING-STORAGE SECTION. IF1224.2 +002700*********************************************************** IF1224.2 +002800* Variables specific to the Intrinsic Function Test IF122A* IF1224.2 +002900*********************************************************** IF1224.2 +003000 01 A PIC S9(10) VALUE 5. IF1224.2 +003100 01 B PIC S9(10) VALUE 7. IF1224.2 +003200 01 C PIC S9(10) VALUE -4. IF1224.2 +003300 01 D PIC S9(10) VALUE 10. IF1224.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1224.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1224.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1224.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1224.2 +003800 01 M PIC S9(10) VALUE 320000. IF1224.2 +003900 01 N PIC S9(10) VALUE 650000. IF1224.2 +004000 01 O PIC S9(10) VALUE -430000. IF1224.2 +004100 01 P PIC S9(10) VALUE 1. IF1224.2 +004200 01 Q PIC S9(10) VALUE 3. IF1224.2 +004300 01 R PIC S9(10) VALUE 5. IF1224.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1224.2 +004500 01 ARR VALUE "40537". IF1224.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1224.2 +004700 01 TEMP PIC S9(10)V9(5). IF1224.2 +004800 01 WS-NUM PIC S9(6)V9(7). IF1224.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1224.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1224.2 +005100* IF1224.2 +005200********************************************************** IF1224.2 +005300* IF1224.2 +005400 01 TEST-RESULTS. IF1224.2 +005500 02 FILLER PIC X VALUE SPACE. IF1224.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1224.2 +005700 02 FILLER PIC X VALUE SPACE. IF1224.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1224.2 +005900 02 FILLER PIC X VALUE SPACE. IF1224.2 +006000 02 PAR-NAME. IF1224.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1224.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1224.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1224.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1224.2 +006500 02 RE-MARK PIC X(61). IF1224.2 +006600 01 TEST-COMPUTED. IF1224.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +006800 02 FILLER PIC X(17) VALUE IF1224.2 +006900 " COMPUTED=". IF1224.2 +007000 02 COMPUTED-X. IF1224.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1224.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1224.2 +007300 PIC -9(9).9(9). IF1224.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1224.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1224.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1224.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1224.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1224.2 +007900 04 FILLER PIC X. IF1224.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1224.2 +008100 01 TEST-CORRECT. IF1224.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1224.2 +008400 02 CORRECT-X. IF1224.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1224.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1224.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1224.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1224.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1224.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1224.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1224.2 +009200 04 FILLER PIC X. IF1224.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1224.2 +009500 01 TEST-CORRECT-MIN. IF1224.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1224.2 +009800 02 CORRECTMI-X. IF1224.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1224.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1224.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1224.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1224.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1224.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1224.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1224.2 +010600 04 FILLER PIC X. IF1224.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1224.2 +010900 01 TEST-CORRECT-MAX. IF1224.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1224.2 +011200 02 CORRECTMA-X. IF1224.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1224.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1224.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1224.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1224.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1224.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1224.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1224.2 +012000 04 FILLER PIC X. IF1224.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1224.2 +012300 01 CCVS-C-1. IF1224.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1224.2 +012500- "SS PARAGRAPH-NAME IF1224.2 +012600- " REMARKS". IF1224.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1224.2 +012800 01 CCVS-C-2. IF1224.2 +012900 02 FILLER PIC X VALUE SPACE. IF1224.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1224.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1224.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1224.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1224.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1224.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1224.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1224.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1224.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1224.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1224.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1224.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1224.2 +014500 01 CCVS-H-1. IF1224.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1224.2 +014700 02 FILLER PIC X(42) VALUE IF1224.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1224.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1224.2 +015000 01 CCVS-H-2A. IF1224.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1224.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1224.2 +015300 02 FILLER PIC XXXX VALUE IF1224.2 +015400 "4.2 ". IF1224.2 +015500 02 FILLER PIC X(28) VALUE IF1224.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1224.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1224.2 +015800 IF1224.2 +015900 01 CCVS-H-2B. IF1224.2 +016000 02 FILLER PIC X(15) VALUE IF1224.2 +016100 "TEST RESULT OF ". IF1224.2 +016200 02 TEST-ID PIC X(9). IF1224.2 +016300 02 FILLER PIC X(4) VALUE IF1224.2 +016400 " IN ". IF1224.2 +016500 02 FILLER PIC X(12) VALUE IF1224.2 +016600 " HIGH ". IF1224.2 +016700 02 FILLER PIC X(22) VALUE IF1224.2 +016800 " LEVEL VALIDATION FOR ". IF1224.2 +016900 02 FILLER PIC X(58) VALUE IF1224.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1224.2 +017100 01 CCVS-H-3. IF1224.2 +017200 02 FILLER PIC X(34) VALUE IF1224.2 +017300 " FOR OFFICIAL USE ONLY ". IF1224.2 +017400 02 FILLER PIC X(58) VALUE IF1224.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1224.2 +017600 02 FILLER PIC X(28) VALUE IF1224.2 +017700 " COPYRIGHT 1985 ". IF1224.2 +017800 01 CCVS-E-1. IF1224.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1224.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1224.2 +018100 02 ID-AGAIN PIC X(9). IF1224.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1224.2 +018300 01 CCVS-E-2. IF1224.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1224.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1224.2 +018600 02 CCVS-E-2-2. IF1224.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1224.2 +018800 03 FILLER PIC X VALUE SPACE. IF1224.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1224.2 +019000 "ERRORS ENCOUNTERED". IF1224.2 +019100 01 CCVS-E-3. IF1224.2 +019200 02 FILLER PIC X(22) VALUE IF1224.2 +019300 " FOR OFFICIAL USE ONLY". IF1224.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1224.2 +019500 02 FILLER PIC X(58) VALUE IF1224.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1224.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1224.2 +019800 02 FILLER PIC X(15) VALUE IF1224.2 +019900 " COPYRIGHT 1985". IF1224.2 +020000 01 CCVS-E-4. IF1224.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1224.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1224.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1224.2 +020400 02 FILLER PIC X(40) VALUE IF1224.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1224.2 +020600 01 XXINFO. IF1224.2 +020700 02 FILLER PIC X(19) VALUE IF1224.2 +020800 "*** INFORMATION ***". IF1224.2 +020900 02 INFO-TEXT. IF1224.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1224.2 +021100 04 XXCOMPUTED PIC X(20). IF1224.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1224.2 +021300 04 XXCORRECT PIC X(20). IF1224.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1224.2 +021500 01 HYPHEN-LINE. IF1224.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1224.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1224.2 +021800- "*****************************************". IF1224.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1224.2 +022000- "******************************". IF1224.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1224.2 +022200 "IF122A". IF1224.2 +022300 PROCEDURE DIVISION. IF1224.2 +022400 CCVS1 SECTION. IF1224.2 +022500 OPEN-FILES. IF1224.2 +022600 OPEN OUTPUT PRINT-FILE. IF1224.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1224.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1224.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1224.2 +023000 GO TO CCVS1-EXIT. IF1224.2 +023100 CLOSE-FILES. IF1224.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1224.2 +023300 TERMINATE-CCVS. IF1224.2 +023400 STOP RUN. IF1224.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1224.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1224.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1224.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1224.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1224.2 +024000 PRINT-DETAIL. IF1224.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1224.2 +024200 MOVE "." TO PARDOT-X IF1224.2 +024300 MOVE REC-CT TO DOTVALUE. IF1224.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1224.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1224.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1224.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1224.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1224.2 +024900 MOVE SPACE TO CORRECT-X. IF1224.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1224.2 +025100 MOVE SPACE TO RE-MARK. IF1224.2 +025200 HEAD-ROUTINE. IF1224.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1224.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1224.2 +025700 COLUMN-NAMES-ROUTINE. IF1224.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +026100 END-ROUTINE. IF1224.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1224.2 +026300 END-RTN-EXIT. IF1224.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +026500 END-ROUTINE-1. IF1224.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1224.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1224.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1224.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1224.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1224.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1224.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1224.2 +027300 END-ROUTINE-12. IF1224.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1224.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1224.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1224.2 +027700 ELSE IF1224.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1224.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1224.2 +028000 PERFORM WRITE-LINE. IF1224.2 +028100 END-ROUTINE-13. IF1224.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1224.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1224.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1224.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1224.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1224.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1224.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1224.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1224.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +029300 WRITE-LINE. IF1224.2 +029400 ADD 1 TO RECORD-COUNT. IF1224.2 +029500Y IF RECORD-COUNT GREATER 42 IF1224.2 +029600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1224.2 +029700Y MOVE SPACE TO DUMMY-RECORD IF1224.2 +029800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1224.2 +029900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1224.2 +030000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1224.2 +030100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1224.2 +030200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1224.2 +030300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1224.2 +030700Y MOVE ZERO TO RECORD-COUNT. IF1224.2 +030800 PERFORM WRT-LN. IF1224.2 +030900 WRT-LN. IF1224.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1224.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1224.2 +031200 BLANK-LINE-PRINT. IF1224.2 +031300 PERFORM WRT-LN. IF1224.2 +031400 FAIL-ROUTINE. IF1224.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1224.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1224.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1224.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1224.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1224.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1224.2 +032200 GO TO FAIL-ROUTINE-EX. IF1224.2 +032300 FAIL-ROUTINE-WRITE. IF1224.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1224.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1224.2 +032600 CORMA-ANSI-REFERENCE. IF1224.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1224.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1224.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1224.2 +033000 ELSE IF1224.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1224.2 +033200 PERFORM WRITE-LINE. IF1224.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1224.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1224.2 +033500 BAIL-OUT. IF1224.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1224.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1224.2 +033800 BAIL-OUT-WRITE. IF1224.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1224.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1224.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1224.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1224.2 +034400 BAIL-OUT-EX. EXIT. IF1224.2 +034500 CCVS1-EXIT. IF1224.2 +034600 EXIT. IF1224.2 +034700******************************************************** IF1224.2 +034800* * IF1224.2 +034900* Intrinsic Function Tests IF122A - MIDRANGE * IF1224.2 +035000* * IF1224.2 +035100******************************************************** IF1224.2 +035200 SECT-IF122A SECTION. IF1224.2 +035300 F-MIDRANGE-INFO. IF1224.2 +035400 MOVE "See ref. A-55 2.26" TO ANSI-REFERENCE. IF1224.2 +035500 MOVE "MIDRANGE Function" TO FEATURE. IF1224.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1224.2 +035700 F-MIDRANGE-01. IF1224.2 +035800 MOVE ZERO TO WS-NUM. IF1224.2 +035900 F-MIDRANGE-TEST-01. IF1224.2 +036000 COMPUTE WS-NUM = FUNCTION MIDRANGE(5, -2, -14, 0). IF1224.2 +036100 IF (WS-NUM >= -4.50009) AND IF1224.2 +036200 (WS-NUM <= -4.49991) IF1224.2 +036300 PERFORM PASS IF1224.2 +036400 ELSE IF1224.2 +036500 MOVE WS-NUM TO COMPUTED-N IF1224.2 +036600 MOVE -4.5 TO CORRECT-N IF1224.2 +036700 PERFORM FAIL. IF1224.2 +036800 GO TO F-MIDRANGE-WRITE-01. IF1224.2 +036900 F-MIDRANGE-DELETE-01. IF1224.2 +037000 PERFORM DE-LETE. IF1224.2 +037100 GO TO F-MIDRANGE-WRITE-01. IF1224.2 +037200 F-MIDRANGE-WRITE-01. IF1224.2 +037300 MOVE "F-MIDRANGE-01" TO PAR-NAME. IF1224.2 +037400 PERFORM PRINT-DETAIL. IF1224.2 +037500*****************TEST (b) - SIMPLE TEST***************** IF1224.2 +037600 F-MIDRANGE-02. IF1224.2 +037700 EVALUATE FUNCTION MIDRANGE(3.9, -0.3, 8.7, 100.2) IF1224.2 +037800 WHEN 49.9490 THRU 49.9510 IF1224.2 +037900 PERFORM PASS IF1224.2 +038000 WHEN OTHER IF1224.2 +038100 PERFORM FAIL. IF1224.2 +038200 GO TO F-MIDRANGE-WRITE-02. IF1224.2 +038300 F-MIDRANGE-DELETE-02. IF1224.2 +038400 PERFORM DE-LETE. IF1224.2 +038500 GO TO F-MIDRANGE-WRITE-02. IF1224.2 +038600 F-MIDRANGE-WRITE-02. IF1224.2 +038700 MOVE "F-MIDRANGE-02" TO PAR-NAME. IF1224.2 +038800 PERFORM PRINT-DETAIL. IF1224.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1224.2 +039000 F-MIDRANGE-03. IF1224.2 +039100 IF FUNCTION MIDRANGE(A, B, C, D) = 3 THEN IF1224.2 +039200 PERFORM PASS IF1224.2 +039300 ELSE IF1224.2 +039400 PERFORM FAIL. IF1224.2 +039500 GO TO F-MIDRANGE-WRITE-03. IF1224.2 +039600 F-MIDRANGE-DELETE-03. IF1224.2 +039700 PERFORM DE-LETE. IF1224.2 +039800 GO TO F-MIDRANGE-WRITE-03. IF1224.2 +039900 F-MIDRANGE-WRITE-03. IF1224.2 +040000 MOVE "F-MIDRANGE-03" TO PAR-NAME. IF1224.2 +040100 PERFORM PRINT-DETAIL. IF1224.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1224.2 +040300 F-MIDRANGE-04. IF1224.2 +040400 MOVE ZERO TO WS-NUM. IF1224.2 +040500 F-MIDRANGE-TEST-04. IF1224.2 +040600 COMPUTE WS-NUM = FUNCTION MIDRANGE(E, F, G, H). IF1224.2 +040700 IF (WS-NUM >= 12.9697) AND IF1224.2 +040800 (WS-NUM <= 12.9703) IF1224.2 +040900 PERFORM PASS IF1224.2 +041000 ELSE IF1224.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1224.2 +041200 MOVE 12.97 TO CORRECT-N IF1224.2 +041300 PERFORM FAIL. IF1224.2 +041400 GO TO F-MIDRANGE-WRITE-04. IF1224.2 +041500 F-MIDRANGE-DELETE-04. IF1224.2 +041600 PERFORM DE-LETE. IF1224.2 +041700 GO TO F-MIDRANGE-WRITE-04. IF1224.2 +041800 F-MIDRANGE-WRITE-04. IF1224.2 +041900 MOVE "F-MIDRANGE-04" TO PAR-NAME. IF1224.2 +042000 PERFORM PRINT-DETAIL. IF1224.2 +042100*****************TEST (e) - SIMPLE TEST***************** IF1224.2 +042200 F-MIDRANGE-05. IF1224.2 +042300 MOVE ZERO TO WS-NUM. IF1224.2 +042400 F-MIDRANGE-TEST-05. IF1224.2 +042500 COMPUTE WS-NUM = FUNCTION MIDRANGE(10.2, -0.2, 5.6, -15.6). IF1224.2 +042600 IF (WS-NUM >= -2.70005) AND IF1224.2 +042700 (WS-NUM <= -2.69995) IF1224.2 +042800 PERFORM PASS IF1224.2 +042900 ELSE IF1224.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1224.2 +043100 MOVE -2.7 TO CORRECT-N IF1224.2 +043200 PERFORM FAIL. IF1224.2 +043300 GO TO F-MIDRANGE-WRITE-05. IF1224.2 +043400 F-MIDRANGE-DELETE-05. IF1224.2 +043500 PERFORM DE-LETE. IF1224.2 +043600 GO TO F-MIDRANGE-WRITE-05. IF1224.2 +043700 F-MIDRANGE-WRITE-05. IF1224.2 +043800 MOVE "F-MIDRANGE-05" TO PAR-NAME. IF1224.2 +043900 PERFORM PRINT-DETAIL. IF1224.2 +044000*****************TEST (f) - SIMPLE TEST***************** IF1224.2 +044100 F-MIDRANGE-06. IF1224.2 +044200 MOVE ZERO TO WS-NUM. IF1224.2 +044300 F-MIDRANGE-TEST-06. IF1224.2 +044400 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B, C, D, E, F, G, H). IF1224.2 +044500 IF (WS-NUM >= 12.9697) AND IF1224.2 +044600 (WS-NUM <= 12.9703) IF1224.2 +044700 PERFORM PASS IF1224.2 +044800 ELSE IF1224.2 +044900 MOVE WS-NUM TO COMPUTED-N IF1224.2 +045000 MOVE 12.97 TO CORRECT-N IF1224.2 +045100 PERFORM FAIL. IF1224.2 +045200 GO TO F-MIDRANGE-WRITE-06. IF1224.2 +045300 F-MIDRANGE-DELETE-06. IF1224.2 +045400 PERFORM DE-LETE. IF1224.2 +045500 GO TO F-MIDRANGE-WRITE-06. IF1224.2 +045600 F-MIDRANGE-WRITE-06. IF1224.2 +045700 MOVE "F-MIDRANGE-06" TO PAR-NAME. IF1224.2 +045800 PERFORM PRINT-DETAIL. IF1224.2 +045900*****************TEST (g) - SIMPLE TEST***************** IF1224.2 +046000 F-MIDRANGE-07. IF1224.2 +046100 MOVE ZERO TO WS-NUM. IF1224.2 +046200 F-MIDRANGE-TEST-07. IF1224.2 +046300 COMPUTE WS-NUM = FUNCTION MIDRANGE(2.6 + 30, 4.5 * 2). IF1224.2 +046400 IF (WS-NUM >= 20.7996) AND IF1224.2 +046500 (WS-NUM <= 20.8004) IF1224.2 +046600 PERFORM PASS IF1224.2 +046700 ELSE IF1224.2 +046800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +046900 MOVE 20.8 TO CORRECT-N IF1224.2 +047000 PERFORM FAIL. IF1224.2 +047100 GO TO F-MIDRANGE-WRITE-07. IF1224.2 +047200 F-MIDRANGE-DELETE-07. IF1224.2 +047300 PERFORM DE-LETE. IF1224.2 +047400 GO TO F-MIDRANGE-WRITE-07. IF1224.2 +047500 F-MIDRANGE-WRITE-07. IF1224.2 +047600 MOVE "F-MIDRANGE-07" TO PAR-NAME. IF1224.2 +047700 PERFORM PRINT-DETAIL. IF1224.2 +047800*****************TEST (h) - SIMPLE TEST***************** IF1224.2 +047900 F-MIDRANGE-08. IF1224.2 +048000 MOVE ZERO TO WS-NUM. IF1224.2 +048100 F-MIDRANGE-TEST-08. IF1224.2 +048200 COMPUTE WS-NUM = FUNCTION MIDRANGE(IND(1), IND(2), IF1224.2 +048300 IND(3)). IF1224.2 +048400 IF (WS-NUM >= 2.49995) AND IF1224.2 +048500 (WS-NUM <= 2.50005) IF1224.2 +048600 PERFORM PASS IF1224.2 +048700 ELSE IF1224.2 +048800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +048900 MOVE 2.5 TO CORRECT-N IF1224.2 +049000 PERFORM FAIL. IF1224.2 +049100 GO TO F-MIDRANGE-WRITE-08. IF1224.2 +049200 F-MIDRANGE-DELETE-08. IF1224.2 +049300 PERFORM DE-LETE. IF1224.2 +049400 GO TO F-MIDRANGE-WRITE-08. IF1224.2 +049500 F-MIDRANGE-WRITE-08. IF1224.2 +049600 MOVE "F-MIDRANGE-08" TO PAR-NAME. IF1224.2 +049700 PERFORM PRINT-DETAIL. IF1224.2 +049800*****************TEST (i) - SIMPLE TEST***************** IF1224.2 +049900 F-MIDRANGE-09. IF1224.2 +050000 MOVE ZERO TO WS-NUM. IF1224.2 +050100 F-MIDRANGE-TEST-09. IF1224.2 +050200 COMPUTE WS-NUM = FUNCTION MIDRANGE(IND(P), IND(Q), IF1224.2 +050300 IND(R)). IF1224.2 +050400 IF (WS-NUM >= 5.49989) AND IF1224.2 +050500 (WS-NUM <= 5.50011) IF1224.2 +050600 PERFORM PASS IF1224.2 +050700 ELSE IF1224.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +050900 MOVE 5.5 TO CORRECT-N IF1224.2 +051000 PERFORM FAIL. IF1224.2 +051100 GO TO F-MIDRANGE-WRITE-09. IF1224.2 +051200 F-MIDRANGE-DELETE-09. IF1224.2 +051300 PERFORM DE-LETE. IF1224.2 +051400 GO TO F-MIDRANGE-WRITE-09. IF1224.2 +051500 F-MIDRANGE-WRITE-09. IF1224.2 +051600 MOVE "F-MIDRANGE-09" TO PAR-NAME. IF1224.2 +051700 PERFORM PRINT-DETAIL. IF1224.2 +051800*****************TEST (j) - SIMPLE TEST***************** IF1224.2 +051900 F-MIDRANGE-10. IF1224.2 +052000 MOVE ZERO TO WS-NUM. IF1224.2 +052100 F-MIDRANGE-TEST-10. IF1224.2 +052200 COMPUTE WS-NUM = FUNCTION MIDRANGE(IND(ALL)). IF1224.2 +052300 IF (WS-NUM >= 3.49993) AND IF1224.2 +052400 (WS-NUM <= 3.50007) IF1224.2 +052500 PERFORM PASS IF1224.2 +052600 ELSE IF1224.2 +052700 MOVE WS-NUM TO COMPUTED-N IF1224.2 +052800 MOVE 3.5 TO CORRECT-N IF1224.2 +052900 PERFORM FAIL. IF1224.2 +053000 GO TO F-MIDRANGE-WRITE-10. IF1224.2 +053100 F-MIDRANGE-DELETE-10. IF1224.2 +053200 PERFORM DE-LETE. IF1224.2 +053300 GO TO F-MIDRANGE-WRITE-10. IF1224.2 +053400 F-MIDRANGE-WRITE-10. IF1224.2 +053500 MOVE "F-MIDRANGE-10" TO PAR-NAME. IF1224.2 +053600 PERFORM PRINT-DETAIL. IF1224.2 +053700*****************TEST (l) - SIMPLE TEST***************** IF1224.2 +053800 F-MIDRANGE-12. IF1224.2 +053900 MOVE ZERO TO WS-NUM. IF1224.2 +054000 F-MIDRANGE-TEST-12. IF1224.2 +054100 COMPUTE WS-NUM = FUNCTION MIDRANGE(M, N, O). IF1224.2 +054200 IF WS-NUM = 110000 THEN IF1224.2 +054300 PERFORM PASS IF1224.2 +054400 ELSE IF1224.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1224.2 +054600 MOVE 110000 TO CORRECT-N IF1224.2 +054700 PERFORM FAIL. IF1224.2 +054800 GO TO F-MIDRANGE-WRITE-12. IF1224.2 +054900 F-MIDRANGE-DELETE-12. IF1224.2 +055000 PERFORM DE-LETE. IF1224.2 +055100 GO TO F-MIDRANGE-WRITE-12. IF1224.2 +055200 F-MIDRANGE-WRITE-12. IF1224.2 +055300 MOVE "F-MIDRANGE-12" TO PAR-NAME. IF1224.2 +055400 PERFORM PRINT-DETAIL. IF1224.2 +055500*****************TEST (m) - SIMPLE TEST***************** IF1224.2 +055600 F-MIDRANGE-13. IF1224.2 +055700 MOVE ZERO TO WS-NUM. IF1224.2 +055800 F-MIDRANGE-TEST-13. IF1224.2 +055900 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, 5, A). IF1224.2 +056000 IF WS-NUM = 5 THEN IF1224.2 +056100 PERFORM PASS IF1224.2 +056200 ELSE IF1224.2 +056300 MOVE WS-NUM TO COMPUTED-N IF1224.2 +056400 MOVE 5 TO CORRECT-N IF1224.2 +056500 PERFORM FAIL. IF1224.2 +056600 GO TO F-MIDRANGE-WRITE-13. IF1224.2 +056700 F-MIDRANGE-DELETE-13. IF1224.2 +056800 PERFORM DE-LETE. IF1224.2 +056900 GO TO F-MIDRANGE-WRITE-13. IF1224.2 +057000 F-MIDRANGE-WRITE-13. IF1224.2 +057100 MOVE "F-MIDRANGE-13" TO PAR-NAME. IF1224.2 +057200 PERFORM PRINT-DETAIL. IF1224.2 +057300*****************TEST (a) - COMPLEX TEST**************** IF1224.2 +057400 F-MIDRANGE-14. IF1224.2 +057500 MOVE ZERO TO WS-NUM. IF1224.2 +057600 MOVE 22.4995 TO MIN-RANGE. IF1224.2 +057700 MOVE 22.5004 TO MAX-RANGE. IF1224.2 +057800 F-MIDRANGE-TEST-14. IF1224.2 +057900 COMPUTE WS-NUM = FUNCTION MIDRANGE(E, 9 * A, 0, B / 2). IF1224.2 +058000 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +058100 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +058200 PERFORM PASS IF1224.2 +058300 ELSE IF1224.2 +058400 MOVE WS-NUM TO COMPUTED-N IF1224.2 +058500 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +058600 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +058700 PERFORM FAIL. IF1224.2 +058800 GO TO F-MIDRANGE-WRITE-14. IF1224.2 +058900 F-MIDRANGE-DELETE-14. IF1224.2 +059000 PERFORM DE-LETE. IF1224.2 +059100 GO TO F-MIDRANGE-WRITE-14. IF1224.2 +059200 F-MIDRANGE-WRITE-14. IF1224.2 +059300 MOVE "F-MIDRANGE-14" TO PAR-NAME. IF1224.2 +059400 PERFORM PRINT-DETAIL. IF1224.2 +059500*****************TEST (b) - COMPLEX TEST**************** IF1224.2 +059600 F-MIDRANGE-15. IF1224.2 +059700 MOVE ZERO TO WS-NUM. IF1224.2 +059800 MOVE 83.9983 TO MIN-RANGE. IF1224.2 +059900 MOVE 84.0017 TO MAX-RANGE. IF1224.2 +060000 F-MIDRANGE-TEST-15. IF1224.2 +060100 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B) + 78. IF1224.2 +060200 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +060300 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +060400 PERFORM PASS IF1224.2 +060500 ELSE IF1224.2 +060600 MOVE WS-NUM TO COMPUTED-N IF1224.2 +060700 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +060800 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +060900 PERFORM FAIL. IF1224.2 +061000 GO TO F-MIDRANGE-WRITE-15. IF1224.2 +061100 F-MIDRANGE-DELETE-15. IF1224.2 +061200 PERFORM DE-LETE. IF1224.2 +061300 GO TO F-MIDRANGE-WRITE-15. IF1224.2 +061400 F-MIDRANGE-WRITE-15. IF1224.2 +061500 MOVE "F-MIDRANGE-15" TO PAR-NAME. IF1224.2 +061600 PERFORM PRINT-DETAIL. IF1224.2 +061700*****************TEST (c) - COMPLEX TEST**************** IF1224.2 +061800 F-MIDRANGE-16. IF1224.2 +061900 MOVE ZERO TO WS-NUM. IF1224.2 +062000 MOVE 2.49995 TO MIN-RANGE. IF1224.2 +062100 MOVE 2.50005 TO MAX-RANGE. IF1224.2 +062200 F-MIDRANGE-TEST-16. IF1224.2 +062300 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B) + IF1224.2 +062400 FUNCTION MIDRANGE(-2.6, -4.4). IF1224.2 +062500 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +062600 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +062700 PERFORM PASS IF1224.2 +062800 ELSE IF1224.2 +062900 MOVE WS-NUM TO COMPUTED-N IF1224.2 +063000 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +063100 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +063200 PERFORM FAIL. IF1224.2 +063300 GO TO F-MIDRANGE-WRITE-16. IF1224.2 +063400 F-MIDRANGE-DELETE-16. IF1224.2 +063500 PERFORM DE-LETE. IF1224.2 +063600 GO TO F-MIDRANGE-WRITE-16. IF1224.2 +063700 F-MIDRANGE-WRITE-16. IF1224.2 +063800 MOVE "F-MIDRANGE-16" TO PAR-NAME. IF1224.2 +063900 PERFORM PRINT-DETAIL. IF1224.2 +064000*****************TEST (d) - COMPLEX TEST**************** IF1224.2 +064100 F-MIDRANGE-17. IF1224.2 +064200 MOVE ZERO TO WS-NUM. IF1224.2 +064300 MOVE 3.49993 TO MIN-RANGE. IF1224.2 +064400 MOVE 3.50007 TO MAX-RANGE. IF1224.2 +064500 F-MIDRANGE-TEST-17. IF1224.2 +064600 COMPUTE WS-NUM = IF1224.2 +064700 FUNCTION MIDRANGE(FUNCTION MIDRANGE(1, 3), 5). IF1224.2 +064800 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +064900 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +065000 PERFORM PASS IF1224.2 +065100 ELSE IF1224.2 +065200 MOVE WS-NUM TO COMPUTED-N IF1224.2 +065300 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +065400 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +065500 PERFORM FAIL. IF1224.2 +065600 GO TO F-MIDRANGE-WRITE-17. IF1224.2 +065700 F-MIDRANGE-DELETE-17. IF1224.2 +065800 PERFORM DE-LETE. IF1224.2 +065900 GO TO F-MIDRANGE-WRITE-17. IF1224.2 +066000 F-MIDRANGE-WRITE-17. IF1224.2 +066100 MOVE "F-MIDRANGE-17" TO PAR-NAME. IF1224.2 +066200 PERFORM PRINT-DETAIL. IF1224.2 +066300*****************SPECIAL PERFORM TEST********************** IF1224.2 +066400 F-MIDRANGE-18. IF1224.2 +066500 PERFORM F-MIDRANGE-TEST-18 IF1224.2 +066600 UNTIL FUNCTION MIDRANGE(1, ARG1) > 10. IF1224.2 +066700 PERFORM PASS. IF1224.2 +066800 GO TO F-MIDRANGE-WRITE-18. IF1224.2 +066900 F-MIDRANGE-TEST-18. IF1224.2 +067000 COMPUTE ARG1 = ARG1 + 1. IF1224.2 +067100 F-MIDRANGE-DELETE-18. IF1224.2 +067200 PERFORM DE-LETE. IF1224.2 +067300 GO TO F-MIDRANGE-WRITE-18. IF1224.2 +067400 F-MIDRANGE-WRITE-18. IF1224.2 +067500 MOVE "F-MIDRANGE-18" TO PAR-NAME. IF1224.2 +067600 PERFORM PRINT-DETAIL. IF1224.2 +067700********************END OF TESTS*************** IF1224.2 +067800 CCVS-EXIT SECTION. IF1224.2 +067900 CCVS-999999. IF1224.2 +068000 GO TO CLOSE-FILES. IF1224.2 +*END-OF,IF122A +*HEADER,COBOL,IF123A +000100 IDENTIFICATION DIVISION. IF1234.2 +000200 PROGRAM-ID. IF1234.2 +000300 IF123A. IF1234.2 +000400 IF1234.2 +000500*********************************************************** IF1234.2 +000600* * IF1234.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1234.2 +000800* It contains tests for the Intrinsic Function MIN. * IF1234.2 +000900* * IF1234.2 +001000*********************************************************** IF1234.2 +001100 ENVIRONMENT DIVISION. IF1234.2 +001200 CONFIGURATION SECTION. IF1234.2 +001300 SOURCE-COMPUTER. IF1234.2 +001400 XXXXX082. IF1234.2 +001500 OBJECT-COMPUTER. IF1234.2 +001600 XXXXX083 IF1234.2 +001700 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1234.2 +001800 SPECIAL-NAMES. IF1234.2 +001900 ALPHABET PRG-COLL-SEQ IS IF1234.2 +002000 STANDARD-2. IF1234.2 +002100 INPUT-OUTPUT SECTION. IF1234.2 +002200 FILE-CONTROL. IF1234.2 +002300 SELECT PRINT-FILE ASSIGN TO IF1234.2 +002400 XXXXX055. IF1234.2 +002500 DATA DIVISION. IF1234.2 +002600 FILE SECTION. IF1234.2 +002700 FD PRINT-FILE. IF1234.2 +002800 01 PRINT-REC PICTURE X(120). IF1234.2 +002900 01 DUMMY-RECORD PICTURE X(120). IF1234.2 +003000 WORKING-STORAGE SECTION. IF1234.2 +003100*********************************************************** IF1234.2 +003200* Variables specific to the Intrinsic Function Test IF123A* IF1234.2 +003300*********************************************************** IF1234.2 +003400 01 A PIC S9(10) VALUE 5. IF1234.2 +003500 01 B PIC S9(10) VALUE 7. IF1234.2 +003600 01 C PIC S9(10) VALUE -4. IF1234.2 +003700 01 D PIC S9(10) VALUE 10. IF1234.2 +003800 01 E PIC S9(5)V9(5) VALUE 34.26. IF1234.2 +003900 01 F PIC S9(5)V9(5) VALUE -8.32. IF1234.2 +004000 01 G PIC S9(5)V9(5) VALUE 4.08. IF1234.2 +004100 01 H PIC S9(5)V9(5) VALUE -5.3. IF1234.2 +004200 01 I PIC X VALUE "R". IF1234.2 +004300 01 J PIC X VALUE "U". IF1234.2 +004400 01 M PIC S9(10) VALUE 1. IF1234.2 +004500 01 N PIC S9(10) VALUE 3. IF1234.2 +004600 01 O PIC S9(10) VALUE 5. IF1234.2 +004700 01 P PIC S9(10) VALUE 1. IF1234.2 +004800 01 Q PIC S9(10) VALUE 3. IF1234.2 +004900 01 R PIC S9(10) VALUE 5. IF1234.2 +005000 01 ARG1 PIC S9(10) VALUE 15. IF1234.2 +005100 01 ARR VALUE "40537". IF1234.2 +005200 02 IND OCCURS 5 TIMES PIC 9. IF1234.2 +005300 01 TEMP PIC S9(10). IF1234.2 +005400 01 WS-NUM PIC S9(5)V9(6). IF1234.2 +005500 01 WS-ANUM PIC X. IF1234.2 +005600 01 MIN-RANGE PIC S9(5)V9(7). IF1234.2 +005700 01 MAX-RANGE PIC S9(5)V9(7). IF1234.2 +005800* IF1234.2 +005900********************************************************** IF1234.2 +006000* IF1234.2 +006100 01 TEST-RESULTS. IF1234.2 +006200 02 FILLER PIC X VALUE SPACE. IF1234.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. IF1234.2 +006400 02 FILLER PIC X VALUE SPACE. IF1234.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. IF1234.2 +006600 02 FILLER PIC X VALUE SPACE. IF1234.2 +006700 02 PAR-NAME. IF1234.2 +006800 03 FILLER PIC X(19) VALUE SPACE. IF1234.2 +006900 03 PARDOT-X PIC X VALUE SPACE. IF1234.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. IF1234.2 +007100 02 FILLER PIC X(8) VALUE SPACE. IF1234.2 +007200 02 RE-MARK PIC X(61). IF1234.2 +007300 01 TEST-COMPUTED. IF1234.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +007500 02 FILLER PIC X(17) VALUE IF1234.2 +007600 " COMPUTED=". IF1234.2 +007700 02 COMPUTED-X. IF1234.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1234.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A IF1234.2 +008000 PIC -9(9).9(9). IF1234.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1234.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1234.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1234.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. IF1234.2 +008500 04 COMPUTED-18V0 PIC -9(18). IF1234.2 +008600 04 FILLER PIC X. IF1234.2 +008700 03 FILLER PIC X(50) VALUE SPACE. IF1234.2 +008800 01 TEST-CORRECT. IF1234.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1234.2 +009100 02 CORRECT-X. IF1234.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1234.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1234.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1234.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1234.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1234.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. IF1234.2 +009800 04 CORRECT-18V0 PIC -9(18). IF1234.2 +009900 04 FILLER PIC X. IF1234.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1234.2 +010200 01 TEST-CORRECT-MIN. IF1234.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +010400 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1234.2 +010500 02 CORRECTMI-X. IF1234.2 +010600 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1234.2 +010700 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1234.2 +010800 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1234.2 +010900 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1234.2 +011000 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1234.2 +011100 03 CR-18V0 REDEFINES CORRECTMI-A. IF1234.2 +011200 04 CORRECTMI-18V0 PIC -9(18). IF1234.2 +011300 04 FILLER PIC X. IF1234.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +011500 03 FILLER PIC X(48) VALUE SPACE. IF1234.2 +011600 01 TEST-CORRECT-MAX. IF1234.2 +011700 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +011800 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1234.2 +011900 02 CORRECTMA-X. IF1234.2 +012000 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1234.2 +012100 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1234.2 +012200 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1234.2 +012300 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1234.2 +012400 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1234.2 +012500 03 CR-18V0 REDEFINES CORRECTMA-A. IF1234.2 +012600 04 CORRECTMA-18V0 PIC -9(18). IF1234.2 +012700 04 FILLER PIC X. IF1234.2 +012800 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +012900 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1234.2 +013000 01 CCVS-C-1. IF1234.2 +013100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1234.2 +013200- "SS PARAGRAPH-NAME IF1234.2 +013300- " REMARKS". IF1234.2 +013400 02 FILLER PIC X(20) VALUE SPACE. IF1234.2 +013500 01 CCVS-C-2. IF1234.2 +013600 02 FILLER PIC X VALUE SPACE. IF1234.2 +013700 02 FILLER PIC X(6) VALUE "TESTED". IF1234.2 +013800 02 FILLER PIC X(15) VALUE SPACE. IF1234.2 +013900 02 FILLER PIC X(4) VALUE "FAIL". IF1234.2 +014000 02 FILLER PIC X(94) VALUE SPACE. IF1234.2 +014100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1234.2 +014200 01 REC-CT PIC 99 VALUE ZERO. IF1234.2 +014300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014600 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1234.2 +014800 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1234.2 +014900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1234.2 +015000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1234.2 +015100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1234.2 +015200 01 CCVS-H-1. IF1234.2 +015300 02 FILLER PIC X(39) VALUE SPACES. IF1234.2 +015400 02 FILLER PIC X(42) VALUE IF1234.2 +015500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1234.2 +015600 02 FILLER PIC X(39) VALUE SPACES. IF1234.2 +015700 01 CCVS-H-2A. IF1234.2 +015800 02 FILLER PIC X(40) VALUE SPACE. IF1234.2 +015900 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1234.2 +016000 02 FILLER PIC XXXX VALUE IF1234.2 +016100 "4.2 ". IF1234.2 +016200 02 FILLER PIC X(28) VALUE IF1234.2 +016300 " COPY - NOT FOR DISTRIBUTION". IF1234.2 +016400 02 FILLER PIC X(41) VALUE SPACE. IF1234.2 +016500 IF1234.2 +016600 01 CCVS-H-2B. IF1234.2 +016700 02 FILLER PIC X(15) VALUE IF1234.2 +016800 "TEST RESULT OF ". IF1234.2 +016900 02 TEST-ID PIC X(9). IF1234.2 +017000 02 FILLER PIC X(4) VALUE IF1234.2 +017100 " IN ". IF1234.2 +017200 02 FILLER PIC X(12) VALUE IF1234.2 +017300 " HIGH ". IF1234.2 +017400 02 FILLER PIC X(22) VALUE IF1234.2 +017500 " LEVEL VALIDATION FOR ". IF1234.2 +017600 02 FILLER PIC X(58) VALUE IF1234.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1234.2 +017800 01 CCVS-H-3. IF1234.2 +017900 02 FILLER PIC X(34) VALUE IF1234.2 +018000 " FOR OFFICIAL USE ONLY ". IF1234.2 +018100 02 FILLER PIC X(58) VALUE IF1234.2 +018200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1234.2 +018300 02 FILLER PIC X(28) VALUE IF1234.2 +018400 " COPYRIGHT 1985 ". IF1234.2 +018500 01 CCVS-E-1. IF1234.2 +018600 02 FILLER PIC X(52) VALUE SPACE. IF1234.2 +018700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1234.2 +018800 02 ID-AGAIN PIC X(9). IF1234.2 +018900 02 FILLER PIC X(45) VALUE SPACES. IF1234.2 +019000 01 CCVS-E-2. IF1234.2 +019100 02 FILLER PIC X(31) VALUE SPACE. IF1234.2 +019200 02 FILLER PIC X(21) VALUE SPACE. IF1234.2 +019300 02 CCVS-E-2-2. IF1234.2 +019400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1234.2 +019500 03 FILLER PIC X VALUE SPACE. IF1234.2 +019600 03 ENDER-DESC PIC X(44) VALUE IF1234.2 +019700 "ERRORS ENCOUNTERED". IF1234.2 +019800 01 CCVS-E-3. IF1234.2 +019900 02 FILLER PIC X(22) VALUE IF1234.2 +020000 " FOR OFFICIAL USE ONLY". IF1234.2 +020100 02 FILLER PIC X(12) VALUE SPACE. IF1234.2 +020200 02 FILLER PIC X(58) VALUE IF1234.2 +020300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1234.2 +020400 02 FILLER PIC X(13) VALUE SPACE. IF1234.2 +020500 02 FILLER PIC X(15) VALUE IF1234.2 +020600 " COPYRIGHT 1985". IF1234.2 +020700 01 CCVS-E-4. IF1234.2 +020800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1234.2 +020900 02 FILLER PIC X(4) VALUE " OF ". IF1234.2 +021000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1234.2 +021100 02 FILLER PIC X(40) VALUE IF1234.2 +021200 " TESTS WERE EXECUTED SUCCESSFULLY". IF1234.2 +021300 01 XXINFO. IF1234.2 +021400 02 FILLER PIC X(19) VALUE IF1234.2 +021500 "*** INFORMATION ***". IF1234.2 +021600 02 INFO-TEXT. IF1234.2 +021700 04 FILLER PIC X(8) VALUE SPACE. IF1234.2 +021800 04 XXCOMPUTED PIC X(20). IF1234.2 +021900 04 FILLER PIC X(5) VALUE SPACE. IF1234.2 +022000 04 XXCORRECT PIC X(20). IF1234.2 +022100 02 INF-ANSI-REFERENCE PIC X(48). IF1234.2 +022200 01 HYPHEN-LINE. IF1234.2 +022300 02 FILLER PIC IS X VALUE IS SPACE. IF1234.2 +022400 02 FILLER PIC IS X(65) VALUE IS "************************IF1234.2 +022500- "*****************************************". IF1234.2 +022600 02 FILLER PIC IS X(54) VALUE IS "************************IF1234.2 +022700- "******************************". IF1234.2 +022800 01 CCVS-PGM-ID PIC X(9) VALUE IF1234.2 +022900 "IF123A". IF1234.2 +023000 PROCEDURE DIVISION. IF1234.2 +023100 CCVS1 SECTION. IF1234.2 +023200 OPEN-FILES. IF1234.2 +023300 OPEN OUTPUT PRINT-FILE. IF1234.2 +023400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1234.2 +023500 MOVE SPACE TO TEST-RESULTS. IF1234.2 +023600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1234.2 +023700 GO TO CCVS1-EXIT. IF1234.2 +023800 CLOSE-FILES. IF1234.2 +023900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1234.2 +024000 TERMINATE-CCVS. IF1234.2 +024100 STOP RUN. IF1234.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1234.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1234.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1234.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1234.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. IF1234.2 +024700 PRINT-DETAIL. IF1234.2 +024800 IF REC-CT NOT EQUAL TO ZERO IF1234.2 +024900 MOVE "." TO PARDOT-X IF1234.2 +025000 MOVE REC-CT TO DOTVALUE. IF1234.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1234.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1234.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1234.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1234.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1234.2 +025600 MOVE SPACE TO CORRECT-X. IF1234.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1234.2 +025800 MOVE SPACE TO RE-MARK. IF1234.2 +025900 HEAD-ROUTINE. IF1234.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1234.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1234.2 +026400 COLUMN-NAMES-ROUTINE. IF1234.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +026800 END-ROUTINE. IF1234.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1234.2 +027000 END-RTN-EXIT. IF1234.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +027200 END-ROUTINE-1. IF1234.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1234.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1234.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. IF1234.2 +027600 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1234.2 +027700 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1234.2 +027800 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1234.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1234.2 +028000 END-ROUTINE-12. IF1234.2 +028100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1234.2 +028200 IF ERROR-COUNTER IS EQUAL TO ZERO IF1234.2 +028300 MOVE "NO " TO ERROR-TOTAL IF1234.2 +028400 ELSE IF1234.2 +028500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1234.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1234.2 +028700 PERFORM WRITE-LINE. IF1234.2 +028800 END-ROUTINE-13. IF1234.2 +028900 IF DELETE-COUNTER IS EQUAL TO ZERO IF1234.2 +029000 MOVE "NO " TO ERROR-TOTAL ELSE IF1234.2 +029100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1234.2 +029200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1234.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +029400 IF INSPECT-COUNTER EQUAL TO ZERO IF1234.2 +029500 MOVE "NO " TO ERROR-TOTAL IF1234.2 +029600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1234.2 +029700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1234.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +029900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +030000 WRITE-LINE. IF1234.2 +030100 ADD 1 TO RECORD-COUNT. IF1234.2 +030200Y IF RECORD-COUNT GREATER 42 IF1234.2 +030300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1234.2 +030400Y MOVE SPACE TO DUMMY-RECORD IF1234.2 +030500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1234.2 +030600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1234.2 +030700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1234.2 +030800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1234.2 +030900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1234.2 +031000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1234.2 +031400Y MOVE ZERO TO RECORD-COUNT. IF1234.2 +031500 PERFORM WRT-LN. IF1234.2 +031600 WRT-LN. IF1234.2 +031700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1234.2 +031800 MOVE SPACE TO DUMMY-RECORD. IF1234.2 +031900 BLANK-LINE-PRINT. IF1234.2 +032000 PERFORM WRT-LN. IF1234.2 +032100 FAIL-ROUTINE. IF1234.2 +032200 IF COMPUTED-X NOT EQUAL TO SPACE IF1234.2 +032300 GO TO FAIL-ROUTINE-WRITE. IF1234.2 +032400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1234.2 +032500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1234.2 +032600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1234.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. IF1234.2 +032900 GO TO FAIL-ROUTINE-EX. IF1234.2 +033000 FAIL-ROUTINE-WRITE. IF1234.2 +033100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1234.2 +033200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1234.2 +033300 CORMA-ANSI-REFERENCE. IF1234.2 +033400 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1234.2 +033500 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1234.2 +033600 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1234.2 +033700 ELSE IF1234.2 +033800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1234.2 +033900 PERFORM WRITE-LINE. IF1234.2 +034000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1234.2 +034100 FAIL-ROUTINE-EX. EXIT. IF1234.2 +034200 BAIL-OUT. IF1234.2 +034300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1234.2 +034400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1234.2 +034500 BAIL-OUT-WRITE. IF1234.2 +034600 MOVE CORRECT-A TO XXCORRECT. IF1234.2 +034700 MOVE COMPUTED-A TO XXCOMPUTED. IF1234.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1234.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1234.2 +035100 BAIL-OUT-EX. EXIT. IF1234.2 +035200 CCVS1-EXIT. IF1234.2 +035300 EXIT. IF1234.2 +035400******************************************************** IF1234.2 +035500* * IF1234.2 +035600* Intrinsic Function Tests IF123A - MIN * IF1234.2 +035700* * IF1234.2 +035800******************************************************** IF1234.2 +035900 SECT-IF123A SECTION. IF1234.2 +036000 F-MIN-INFO. IF1234.2 +036100 MOVE "See ref. A-56 2.27" TO ANSI-REFERENCE. IF1234.2 +036200 MOVE "MIN Function" TO FEATURE. IF1234.2 +036300*****************TEST (a) - SIMPLE TEST***************** IF1234.2 +036400 F-MIN-01. IF1234.2 +036500 MOVE ZERO TO WS-NUM. IF1234.2 +036600 F-MIN-TEST-01. IF1234.2 +036700 COMPUTE WS-NUM = FUNCTION MIN(5, 6, 10, 3, 7). IF1234.2 +036800 IF WS-NUM = 3 THEN IF1234.2 +036900 PERFORM PASS IF1234.2 +037000 ELSE IF1234.2 +037100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +037200 MOVE 3 TO CORRECT-N IF1234.2 +037300 PERFORM FAIL. IF1234.2 +037400 GO TO F-MIN-WRITE-01. IF1234.2 +037500 F-MIN-DELETE-01. IF1234.2 +037600 PERFORM DE-LETE. IF1234.2 +037700 GO TO F-MIN-WRITE-01. IF1234.2 +037800 F-MIN-WRITE-01. IF1234.2 +037900 MOVE "F-MIN-01" TO PAR-NAME. IF1234.2 +038000 PERFORM PRINT-DETAIL. IF1234.2 +038100*****************TEST (b) - SIMPLE TEST***************** IF1234.2 +038200 F-MIN-02. IF1234.2 +038300 EVALUATE FUNCTION MIN(-4, 7, 2304, 3, -8) IF1234.2 +038400 WHEN -8 IF1234.2 +038500 PERFORM PASS IF1234.2 +038600 WHEN OTHER IF1234.2 +038700 PERFORM FAIL. IF1234.2 +038800 GO TO F-MIN-WRITE-02. IF1234.2 +038900 F-MIN-DELETE-02. IF1234.2 +039000 PERFORM DE-LETE. IF1234.2 +039100 GO TO F-MIN-WRITE-02. IF1234.2 +039200 F-MIN-WRITE-02. IF1234.2 +039300 MOVE "F-MIN-02" TO PAR-NAME. IF1234.2 +039400 PERFORM PRINT-DETAIL. IF1234.2 +039500*****************TEST (c) - SIMPLE TEST***************** IF1234.2 +039600 F-MIN-03. IF1234.2 +039700 IF (FUNCTION MIN(4.3, 2.6, 7.3, 9.1) >= 2.59995) AND IF1234.2 +039800 (FUNCTION MIN(4.3, 2.6, 7.3, 9.1) <= 2.60005) THEN IF1234.2 +039900 PERFORM PASS IF1234.2 +040000 ELSE IF1234.2 +040100 PERFORM FAIL. IF1234.2 +040200 GO TO F-MIN-WRITE-03. IF1234.2 +040300 F-MIN-DELETE-03. IF1234.2 +040400 PERFORM DE-LETE. IF1234.2 +040500 GO TO F-MIN-WRITE-03. IF1234.2 +040600 F-MIN-WRITE-03. IF1234.2 +040700 MOVE "F-MIN-03" TO PAR-NAME. IF1234.2 +040800 PERFORM PRINT-DETAIL. IF1234.2 +040900*****************TEST (d) - SIMPLE TEST***************** IF1234.2 +041000 F-MIN-04. IF1234.2 +041100 MOVE ZERO TO WS-NUM. IF1234.2 +041200 F-MIN-TEST-04. IF1234.2 +041300 COMPUTE WS-NUM = FUNCTION MIN(-4.3, 10.2, -0.7, 3.9). IF1234.2 +041400 IF (WS-NUM >= -4.30009) AND IF1234.2 +041500 (WS-NUM <= -4.29991) IF1234.2 +041600 PERFORM PASS IF1234.2 +041700 ELSE IF1234.2 +041800 MOVE WS-NUM TO COMPUTED-N IF1234.2 +041900 MOVE -4.3 TO CORRECT-N IF1234.2 +042000 PERFORM FAIL. IF1234.2 +042100 GO TO F-MIN-WRITE-04. IF1234.2 +042200 F-MIN-DELETE-04. IF1234.2 +042300 PERFORM DE-LETE. IF1234.2 +042400 GO TO F-MIN-WRITE-04. IF1234.2 +042500 F-MIN-WRITE-04. IF1234.2 +042600 MOVE "F-MIN-04" TO PAR-NAME. IF1234.2 +042700 PERFORM PRINT-DETAIL. IF1234.2 +042800*****************TEST (e) - SIMPLE TEST***************** IF1234.2 +042900 F-MIN-05. IF1234.2 +043000 MOVE ZERO TO WS-NUM. IF1234.2 +043100 F-MIN-TEST-05. IF1234.2 +043200 COMPUTE WS-NUM = FUNCTION MIN(A, B, D). IF1234.2 +043300 IF WS-NUM = 5 THEN IF1234.2 +043400 PERFORM PASS IF1234.2 +043500 ELSE IF1234.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1234.2 +043700 MOVE 5 TO CORRECT-N IF1234.2 +043800 PERFORM FAIL. IF1234.2 +043900 GO TO F-MIN-WRITE-05. IF1234.2 +044000 F-MIN-DELETE-05. IF1234.2 +044100 PERFORM DE-LETE. IF1234.2 +044200 GO TO F-MIN-WRITE-05. IF1234.2 +044300 F-MIN-WRITE-05. IF1234.2 +044400 MOVE "F-MIN-05" TO PAR-NAME. IF1234.2 +044500 PERFORM PRINT-DETAIL. IF1234.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1234.2 +044700 F-MIN-06. IF1234.2 +044800 MOVE ZERO TO WS-NUM. IF1234.2 +044900 F-MIN-TEST-06. IF1234.2 +045000 COMPUTE WS-NUM = FUNCTION MIN(A, B, C, D). IF1234.2 +045100 IF WS-NUM = -4 THEN IF1234.2 +045200 PERFORM PASS IF1234.2 +045300 ELSE IF1234.2 +045400 MOVE WS-NUM TO COMPUTED-N IF1234.2 +045500 MOVE -4 TO CORRECT-N IF1234.2 +045600 PERFORM FAIL. IF1234.2 +045700 GO TO F-MIN-WRITE-06. IF1234.2 +045800 F-MIN-DELETE-06. IF1234.2 +045900 PERFORM DE-LETE. IF1234.2 +046000 GO TO F-MIN-WRITE-06. IF1234.2 +046100 F-MIN-WRITE-06. IF1234.2 +046200 MOVE "F-MIN-06" TO PAR-NAME. IF1234.2 +046300 PERFORM PRINT-DETAIL. IF1234.2 +046400*****************TEST (g) - SIMPLE TEST***************** IF1234.2 +046500 F-MIN-07. IF1234.2 +046600 MOVE ZERO TO WS-NUM. IF1234.2 +046700 F-MIN-TEST-07. IF1234.2 +046800 COMPUTE WS-NUM = FUNCTION MIN(E, G). IF1234.2 +046900 IF (WS-NUM >= 4.07992) AND IF1234.2 +047000 (WS-NUM <= 4.08008) IF1234.2 +047100 PERFORM PASS IF1234.2 +047200 ELSE IF1234.2 +047300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +047400 MOVE 4.08 TO CORRECT-N IF1234.2 +047500 PERFORM FAIL. IF1234.2 +047600 GO TO F-MIN-WRITE-07. IF1234.2 +047700 F-MIN-DELETE-07. IF1234.2 +047800 PERFORM DE-LETE. IF1234.2 +047900 GO TO F-MIN-WRITE-07. IF1234.2 +048000 F-MIN-WRITE-07. IF1234.2 +048100 MOVE "F-MIN-07" TO PAR-NAME. IF1234.2 +048200 PERFORM PRINT-DETAIL. IF1234.2 +048300*****************TEST (h) - SIMPLE TEST***************** IF1234.2 +048400 F-MIN-08. IF1234.2 +048500 MOVE ZERO TO WS-NUM. IF1234.2 +048600 F-MIN-TEST-08. IF1234.2 +048700 COMPUTE WS-NUM = FUNCTION MIN(E, F, G, H). IF1234.2 +048800 IF (WS-NUM >= -8.32017) AND IF1234.2 +048900 (WS-NUM <= -8.31983) IF1234.2 +049000 PERFORM PASS IF1234.2 +049100 ELSE IF1234.2 +049200 MOVE WS-NUM TO COMPUTED-N IF1234.2 +049300 MOVE -8.32 TO CORRECT-N IF1234.2 +049400 PERFORM FAIL. IF1234.2 +049500 GO TO F-MIN-WRITE-08. IF1234.2 +049600 F-MIN-DELETE-08. IF1234.2 +049700 PERFORM DE-LETE. IF1234.2 +049800 GO TO F-MIN-WRITE-08. IF1234.2 +049900 F-MIN-WRITE-08. IF1234.2 +050000 MOVE "F-MIN-08" TO PAR-NAME. IF1234.2 +050100 PERFORM PRINT-DETAIL. IF1234.2 +050200*****************TEST (i) - SIMPLE TEST***************** IF1234.2 +050300 F-MIN-09. IF1234.2 +050400 MOVE ZERO TO WS-NUM. IF1234.2 +050500 F-MIN-TEST-09. IF1234.2 +050600 COMPUTE WS-NUM = FUNCTION MIN(A, 4, 8, -10, C, 0). IF1234.2 +050700 IF WS-NUM = -10 THEN IF1234.2 +050800 PERFORM PASS IF1234.2 +050900 ELSE IF1234.2 +051000 MOVE WS-NUM TO COMPUTED-N IF1234.2 +051100 MOVE -10 TO CORRECT-N IF1234.2 +051200 PERFORM FAIL. IF1234.2 +051300 GO TO F-MIN-WRITE-09. IF1234.2 +051400 F-MIN-DELETE-09. IF1234.2 +051500 PERFORM DE-LETE. IF1234.2 +051600 GO TO F-MIN-WRITE-09. IF1234.2 +051700 F-MIN-WRITE-09. IF1234.2 +051800 MOVE "F-MIN-09" TO PAR-NAME. IF1234.2 +051900 PERFORM PRINT-DETAIL. IF1234.2 +052000*****************TEST (j) - SIMPLE TEST***************** IF1234.2 +052100 F-MIN-10. IF1234.2 +052200 MOVE ZERO TO WS-NUM. IF1234.2 +052300 F-MIN-TEST-10. IF1234.2 +052400 COMPUTE WS-NUM = FUNCTION MIN(4, D, E, 6.3, -2.0). IF1234.2 +052500 IF (WS-NUM >= -2.00004) AND IF1234.2 +052600 (WS-NUM <= -1.99996) IF1234.2 +052700 PERFORM PASS IF1234.2 +052800 ELSE IF1234.2 +052900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +053000 MOVE -2.0 TO CORRECT-N IF1234.2 +053100 PERFORM FAIL. IF1234.2 +053200 GO TO F-MIN-WRITE-10. IF1234.2 +053300 F-MIN-DELETE-10. IF1234.2 +053400 PERFORM DE-LETE. IF1234.2 +053500 GO TO F-MIN-WRITE-10. IF1234.2 +053600 F-MIN-WRITE-10. IF1234.2 +053700 MOVE "F-MIN-10" TO PAR-NAME. IF1234.2 +053800 PERFORM PRINT-DETAIL. IF1234.2 +053900*****************TEST (k) - SIMPLE TEST***************** IF1234.2 +054000 F-MIN-11. IF1234.2 +054100 MOVE SPACES TO WS-ANUM. IF1234.2 +054200 F-MIN-TEST-11. IF1234.2 +054300 MOVE FUNCTION MIN("R", I, "I", "a") TO WS-ANUM. IF1234.2 +054400 IF WS-ANUM = "I" THEN IF1234.2 +054500 PERFORM PASS IF1234.2 +054600 ELSE IF1234.2 +054700 MOVE WS-ANUM TO COMPUTED-A IF1234.2 +054800 MOVE "I" TO CORRECT-A IF1234.2 +054900 PERFORM FAIL. IF1234.2 +055000 GO TO F-MIN-WRITE-11. IF1234.2 +055100 F-MIN-DELETE-11. IF1234.2 +055200 PERFORM DE-LETE. IF1234.2 +055300 GO TO F-MIN-WRITE-11. IF1234.2 +055400 F-MIN-WRITE-11. IF1234.2 +055500 MOVE "F-MIN-11" TO PAR-NAME. IF1234.2 +055600 PERFORM PRINT-DETAIL. IF1234.2 +055700*****************TEST (l) - SIMPLE TEST***************** IF1234.2 +055800 F-MIN-12. IF1234.2 +055900 MOVE ZERO TO WS-NUM. IF1234.2 +056000 F-MIN-TEST-12. IF1234.2 +056100 MOVE FUNCTION MIN("a", J, "J") TO WS-ANUM. IF1234.2 +056200 IF WS-ANUM = "J" THEN IF1234.2 +056300 PERFORM PASS IF1234.2 +056400 ELSE IF1234.2 +056500 MOVE WS-ANUM TO COMPUTED-A IF1234.2 +056600 MOVE "J" TO CORRECT-A IF1234.2 +056700 PERFORM FAIL. IF1234.2 +056800 GO TO F-MIN-WRITE-12. IF1234.2 +056900 F-MIN-DELETE-12. IF1234.2 +057000 PERFORM DE-LETE. IF1234.2 +057100 GO TO F-MIN-WRITE-12. IF1234.2 +057200 F-MIN-WRITE-12. IF1234.2 +057300 MOVE "F-MIN-12" TO PAR-NAME. IF1234.2 +057400 PERFORM PRINT-DETAIL. IF1234.2 +057500*****************TEST (m) - SIMPLE TEST***************** IF1234.2 +057600 F-MIN-13. IF1234.2 +057700 MOVE ZERO TO WS-NUM. IF1234.2 +057800 F-MIN-TEST-13. IF1234.2 +057900 COMPUTE WS-NUM = FUNCTION MIN(IND(1), IND(2), IND(3)). IF1234.2 +058000 IF WS-NUM = 0 THEN IF1234.2 +058100 PERFORM PASS IF1234.2 +058200 ELSE IF1234.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +058400 MOVE 0 TO CORRECT-N IF1234.2 +058500 PERFORM FAIL. IF1234.2 +058600 GO TO F-MIN-WRITE-13. IF1234.2 +058700 F-MIN-DELETE-13. IF1234.2 +058800 PERFORM DE-LETE. IF1234.2 +058900 GO TO F-MIN-WRITE-13. IF1234.2 +059000 F-MIN-WRITE-13. IF1234.2 +059100 MOVE "F-MIN-13" TO PAR-NAME. IF1234.2 +059200 PERFORM PRINT-DETAIL. IF1234.2 +059300*****************TEST (n) - SIMPLE TEST***************** IF1234.2 +059400 F-MIN-14. IF1234.2 +059500 MOVE ZERO TO WS-NUM. IF1234.2 +059600 F-MIN-TEST-14. IF1234.2 +059700 COMPUTE WS-NUM = FUNCTION MIN(IND(P), IND(Q), IND(R)). IF1234.2 +059800 IF WS-NUM = 4 THEN IF1234.2 +059900 PERFORM PASS IF1234.2 +060000 ELSE IF1234.2 +060100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +060200 MOVE 4 TO CORRECT-N IF1234.2 +060300 PERFORM FAIL. IF1234.2 +060400 GO TO F-MIN-WRITE-14. IF1234.2 +060500 F-MIN-DELETE-14. IF1234.2 +060600 PERFORM DE-LETE. IF1234.2 +060700 GO TO F-MIN-WRITE-14. IF1234.2 +060800 F-MIN-WRITE-14. IF1234.2 +060900 MOVE "F-MIN-14" TO PAR-NAME. IF1234.2 +061000 PERFORM PRINT-DETAIL. IF1234.2 +061100*****************TEST (o) - SIMPLE TEST***************** IF1234.2 +061200 F-MIN-15. IF1234.2 +061300 MOVE ZERO TO WS-NUM. IF1234.2 +061400 F-MIN-TEST-15. IF1234.2 +061500 COMPUTE WS-NUM = FUNCTION MIN(IND(ALL)). IF1234.2 +061600 IF WS-NUM = 0 THEN IF1234.2 +061700 PERFORM PASS IF1234.2 +061800 ELSE IF1234.2 +061900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +062000 MOVE 0 TO CORRECT-N IF1234.2 +062100 PERFORM FAIL. IF1234.2 +062200 GO TO F-MIN-WRITE-15. IF1234.2 +062300 F-MIN-DELETE-15. IF1234.2 +062400 PERFORM DE-LETE. IF1234.2 +062500 GO TO F-MIN-WRITE-15. IF1234.2 +062600 F-MIN-WRITE-15. IF1234.2 +062700 MOVE "F-MIN-15" TO PAR-NAME. IF1234.2 +062800 PERFORM PRINT-DETAIL. IF1234.2 +062900*****************TEST (q) - SIMPLE TEST***************** IF1234.2 +063000 F-MIN-17. IF1234.2 +063100 MOVE ZERO TO WS-NUM. IF1234.2 +063200 F-MIN-TEST-17. IF1234.2 +063300 COMPUTE WS-NUM = IF1234.2 +063400 FUNCTION MIN(31000, 310001, 78000, 29000, 12000). IF1234.2 +063500 IF WS-NUM = 12000 THEN IF1234.2 +063600 PERFORM PASS IF1234.2 +063700 ELSE IF1234.2 +063800 MOVE WS-NUM TO COMPUTED-N IF1234.2 +063900 MOVE 1200 TO CORRECT-N IF1234.2 +064000 PERFORM FAIL. IF1234.2 +064100 GO TO F-MIN-WRITE-17. IF1234.2 +064200 F-MIN-DELETE-17. IF1234.2 +064300 PERFORM DE-LETE. IF1234.2 +064400 GO TO F-MIN-WRITE-17. IF1234.2 +064500 F-MIN-WRITE-17. IF1234.2 +064600 MOVE "F-MIN-17" TO PAR-NAME. IF1234.2 +064700 PERFORM PRINT-DETAIL. IF1234.2 +064800*****************TEST (a) - COMPLEX TEST**************** IF1234.2 +064900 F-MIN-18. IF1234.2 +065000 MOVE ZERO TO WS-NUM. IF1234.2 +065100 MOVE 1.99996 TO MIN-RANGE. IF1234.2 +065200 MOVE 2.00004 TO MAX-RANGE. IF1234.2 +065300 F-MIN-TEST-18. IF1234.2 +065400 COMPUTE WS-NUM = FUNCTION MIN(A * B, (3 + 1) / 2, 3 + 4). IF1234.2 +065500 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +065600 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +065700 PERFORM PASS IF1234.2 +065800 ELSE IF1234.2 +065900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +066000 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +066100 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +066200 PERFORM FAIL. IF1234.2 +066300 GO TO F-MIN-WRITE-18. IF1234.2 +066400 F-MIN-DELETE-18. IF1234.2 +066500 PERFORM DE-LETE. IF1234.2 +066600 GO TO F-MIN-WRITE-18. IF1234.2 +066700 F-MIN-WRITE-18. IF1234.2 +066800 MOVE "F-MIN-18" TO PAR-NAME. IF1234.2 +066900 PERFORM PRINT-DETAIL. IF1234.2 +067000*****************TEST (b) - COMPLEX TEST**************** IF1234.2 +067100 F-MIN-19. IF1234.2 +067200 MOVE ZERO TO WS-NUM. IF1234.2 +067300 MOVE -10.6002 TO MIN-RANGE. IF1234.2 +067400 MOVE -10.5998 TO MAX-RANGE. IF1234.2 +067500 F-MIN-TEST-19. IF1234.2 +067600 COMPUTE WS-NUM = FUNCTION MIN(E + 4, H * 2, 5 + A). IF1234.2 +067700 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +067800 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +067900 PERFORM PASS IF1234.2 +068000 ELSE IF1234.2 +068100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +068200 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +068300 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +068400 PERFORM FAIL. IF1234.2 +068500 GO TO F-MIN-WRITE-19. IF1234.2 +068600 F-MIN-DELETE-19. IF1234.2 +068700 PERFORM DE-LETE. IF1234.2 +068800 GO TO F-MIN-WRITE-19. IF1234.2 +068900 F-MIN-WRITE-19. IF1234.2 +069000 MOVE "F-MIN-19" TO PAR-NAME. IF1234.2 +069100 PERFORM PRINT-DETAIL. IF1234.2 +069200*****************TEST (c) - COMPLEX TEST**************** IF1234.2 +069300 F-MIN-20. IF1234.2 +069400 MOVE ZERO TO WS-NUM. IF1234.2 +069500 MOVE -7.00014 TO MIN-RANGE. IF1234.2 +069600 MOVE -6.99986 TO MAX-RANGE. IF1234.2 +069700 F-MIN-TEST-20. IF1234.2 +069800 COMPUTE WS-NUM = FUNCTION MIN(-7, -9 + 2, (- B)). IF1234.2 +069900 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +070000 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +070100 PERFORM PASS IF1234.2 +070200 ELSE IF1234.2 +070300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +070400 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +070500 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +070600 PERFORM FAIL. IF1234.2 +070700 GO TO F-MIN-WRITE-20. IF1234.2 +070800 F-MIN-DELETE-20. IF1234.2 +070900 PERFORM DE-LETE. IF1234.2 +071000 GO TO F-MIN-WRITE-20. IF1234.2 +071100 F-MIN-WRITE-20. IF1234.2 +071200 MOVE "F-MIN-20" TO PAR-NAME. IF1234.2 +071300 PERFORM PRINT-DETAIL. IF1234.2 +071400*****************TEST (d) - COMPLEX TEST**************** IF1234.2 +071500 F-MIN-21. IF1234.2 +071600 MOVE ZERO TO WS-NUM. IF1234.2 +071700 MOVE 4.99990 TO MIN-RANGE. IF1234.2 +071800 MOVE 5.00010 TO MAX-RANGE. IF1234.2 +071900 F-MIN-TEST-21. IF1234.2 +072000 COMPUTE WS-NUM = FUNCTION MIN(FUNCTION MIN(14, A), E, 50). IF1234.2 +072100 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +072200 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +072300 PERFORM PASS IF1234.2 +072400 ELSE IF1234.2 +072500 MOVE WS-NUM TO COMPUTED-N IF1234.2 +072600 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +072700 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +072800 PERFORM FAIL. IF1234.2 +072900 GO TO F-MIN-WRITE-21. IF1234.2 +073000 F-MIN-DELETE-21. IF1234.2 +073100 PERFORM DE-LETE. IF1234.2 +073200 GO TO F-MIN-WRITE-21. IF1234.2 +073300 F-MIN-WRITE-21. IF1234.2 +073400 MOVE "F-MIN-21" TO PAR-NAME. IF1234.2 +073500 PERFORM PRINT-DETAIL. IF1234.2 +073600*****************TEST (e) - COMPLEX TEST**************** IF1234.2 +073700 F-MIN-22. IF1234.2 +073800 MOVE ZERO TO WS-NUM. IF1234.2 +073900 MOVE 8.99982 TO MIN-RANGE. IF1234.2 +074000 MOVE 9.00018 TO MAX-RANGE. IF1234.2 +074100 F-MIN-TEST-22. IF1234.2 +074200 COMPUTE WS-NUM = FUNCTION MIN(4, B, E) + A. IF1234.2 +074300 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +074400 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +074500 PERFORM PASS IF1234.2 +074600 ELSE IF1234.2 +074700 MOVE WS-NUM TO COMPUTED-N IF1234.2 +074800 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +074900 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +075000 PERFORM FAIL. IF1234.2 +075100 GO TO F-MIN-WRITE-22. IF1234.2 +075200 F-MIN-DELETE-22. IF1234.2 +075300 PERFORM DE-LETE. IF1234.2 +075400 GO TO F-MIN-WRITE-22. IF1234.2 +075500 F-MIN-WRITE-22. IF1234.2 +075600 MOVE "F-MIN-22" TO PAR-NAME. IF1234.2 +075700 PERFORM PRINT-DETAIL. IF1234.2 +075800*****************TEST (f) - COMPLEX TEST**************** IF1234.2 +075900 F-MIN-23. IF1234.2 +076000 MOVE ZERO TO WS-NUM. IF1234.2 +076100 MOVE 4.99990 TO MIN-RANGE. IF1234.2 +076200 MOVE 5.00010 TO MAX-RANGE. IF1234.2 +076300 F-MIN-TEST-23. IF1234.2 +076400 COMPUTE WS-NUM = FUNCTION MIN(A, E) + FUNCTION MIN(B, 0). IF1234.2 +076500 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +076600 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +076700 PERFORM PASS IF1234.2 +076800 ELSE IF1234.2 +076900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +077000 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +077100 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +077200 PERFORM FAIL. IF1234.2 +077300 GO TO F-MIN-WRITE-23. IF1234.2 +077400 F-MIN-DELETE-23. IF1234.2 +077500 PERFORM DE-LETE. IF1234.2 +077600 GO TO F-MIN-WRITE-23. IF1234.2 +077700 F-MIN-WRITE-23. IF1234.2 +077800 MOVE "F-MIN-23" TO PAR-NAME. IF1234.2 +077900 PERFORM PRINT-DETAIL. IF1234.2 +078000*****************SPECIAL PERFORM TEST********************** IF1234.2 +078100 F-MIN-24. IF1234.2 +078200 PERFORM F-MIN-TEST-24 IF1234.2 +078300 UNTIL FUNCTION MIN(ARG1, 20) < 10. IF1234.2 +078400 PERFORM PASS. IF1234.2 +078500 GO TO F-MIN-WRITE-24. IF1234.2 +078600 F-MIN-TEST-24. IF1234.2 +078700 COMPUTE ARG1 = ARG1 - 1. IF1234.2 +078800 F-MIN-DELETE-24. IF1234.2 +078900 PERFORM DE-LETE. IF1234.2 +079000 GO TO F-MIN-WRITE-24. IF1234.2 +079100 F-MIN-WRITE-24. IF1234.2 +079200 MOVE "F-MIN-24" TO PAR-NAME. IF1234.2 +079300 PERFORM PRINT-DETAIL. IF1234.2 +079400********************END OF TESTS*************** IF1234.2 +079500 CCVS-EXIT SECTION. IF1234.2 +079600 CCVS-999999. IF1234.2 +079700 GO TO CLOSE-FILES. IF1234.2 +*END-OF,IF123A +*HEADER,COBOL,IF124A +000100 IDENTIFICATION DIVISION. IF1244.2 +000200 PROGRAM-ID. IF1244.2 +000300 IF124A. IF1244.2 +000400 IF1244.2 +000500*********************************************************** IF1244.2 +000600* * IF1244.2 +000700* This program is intended to form part of the CCVS85 * IF1244.2 +000800* COBOL Test Suite. It contains tests for the * IF1244.2 +000900* Intrinsic Function MOD. * IF1244.2 +001000* * IF1244.2 +001100*********************************************************** IF1244.2 +001200 ENVIRONMENT DIVISION. IF1244.2 +001300 CONFIGURATION SECTION. IF1244.2 +001400 SOURCE-COMPUTER. IF1244.2 +001500 XXXXX082. IF1244.2 +001600 OBJECT-COMPUTER. IF1244.2 +001700 XXXXX083. IF1244.2 +001800 INPUT-OUTPUT SECTION. IF1244.2 +001900 FILE-CONTROL. IF1244.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1244.2 +002100 XXXXX055. IF1244.2 +002200 DATA DIVISION. IF1244.2 +002300 FILE SECTION. IF1244.2 +002400 FD PRINT-FILE. IF1244.2 +002500 01 PRINT-REC PICTURE X(120). IF1244.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1244.2 +002700 WORKING-STORAGE SECTION. IF1244.2 +002800*********************************************************** IF1244.2 +002900* Variables specific to the Intrinsic Function Test IF124A* IF1244.2 +003000*********************************************************** IF1244.2 +003100 01 A PIC S9(10) VALUE 5. IF1244.2 +003200 01 B PIC S9(10) VALUE 7. IF1244.2 +003300 01 C PIC S9(10) VALUE -4. IF1244.2 +003400 01 ARG2 PIC S9(10) VALUE 1. IF1244.2 +003500 01 TEMP PIC S9(10). IF1244.2 +003600 01 WS-NUM PIC S9(5)V9(6). IF1244.2 +003700 01 MIN-RANGE PIC S9(5)V9(7). IF1244.2 +003800 01 MAX-RANGE PIC S9(5)V9(7). IF1244.2 +003900* IF1244.2 +004000*********************************************************** IF1244.2 +004100* IF1244.2 +004200 01 TEST-RESULTS. IF1244.2 +004300 02 FILLER PIC X VALUE SPACE. IF1244.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1244.2 +004500 02 FILLER PIC X VALUE SPACE. IF1244.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1244.2 +004700 02 FILLER PIC X VALUE SPACE. IF1244.2 +004800 02 PAR-NAME. IF1244.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1244.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1244.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1244.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1244.2 +005300 02 RE-MARK PIC X(61). IF1244.2 +005400 01 TEST-COMPUTED. IF1244.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +005600 02 FILLER PIC X(17) VALUE IF1244.2 +005700 " COMPUTED=". IF1244.2 +005800 02 COMPUTED-X. IF1244.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1244.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1244.2 +006100 PIC -9(9).9(9). IF1244.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1244.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1244.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1244.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1244.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1244.2 +006700 04 FILLER PIC X. IF1244.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1244.2 +006900 01 TEST-CORRECT. IF1244.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1244.2 +007200 02 CORRECT-X. IF1244.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1244.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1244.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1244.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1244.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1244.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1244.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1244.2 +008000 04 FILLER PIC X. IF1244.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1244.2 +008300 01 TEST-CORRECT-MIN. IF1244.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +008500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1244.2 +008600 02 CORRECTMI-X. IF1244.2 +008700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1244.2 +008800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1244.2 +008900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1244.2 +009000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1244.2 +009100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1244.2 +009200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1244.2 +009300 04 CORRECTMI-18V0 PIC -9(18). IF1244.2 +009400 04 FILLER PIC X. IF1244.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +009600 03 FILLER PIC X(48) VALUE SPACE. IF1244.2 +009700 01 TEST-CORRECT-MAX. IF1244.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +009900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1244.2 +010000 02 CORRECTMA-X. IF1244.2 +010100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1244.2 +010200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1244.2 +010300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1244.2 +010400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1244.2 +010500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1244.2 +010600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1244.2 +010700 04 CORRECTMA-18V0 PIC -9(18). IF1244.2 +010800 04 FILLER PIC X. IF1244.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +011000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1244.2 +011100 01 CCVS-C-1. IF1244.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1244.2 +011300- "SS PARAGRAPH-NAME IF1244.2 +011400- " REMARKS". IF1244.2 +011500 02 FILLER PIC X(20) VALUE SPACE. IF1244.2 +011600 01 CCVS-C-2. IF1244.2 +011700 02 FILLER PIC X VALUE SPACE. IF1244.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". IF1244.2 +011900 02 FILLER PIC X(15) VALUE SPACE. IF1244.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". IF1244.2 +012100 02 FILLER PIC X(94) VALUE SPACE. IF1244.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1244.2 +012300 01 REC-CT PIC 99 VALUE ZERO. IF1244.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1244.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1244.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1244.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1244.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1244.2 +013300 01 CCVS-H-1. IF1244.2 +013400 02 FILLER PIC X(39) VALUE SPACES. IF1244.2 +013500 02 FILLER PIC X(42) VALUE IF1244.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1244.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1244.2 +013800 01 CCVS-H-2A. IF1244.2 +013900 02 FILLER PIC X(40) VALUE SPACE. IF1244.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1244.2 +014100 02 FILLER PIC XXXX VALUE IF1244.2 +014200 "4.2 ". IF1244.2 +014300 02 FILLER PIC X(28) VALUE IF1244.2 +014400 " COPY - NOT FOR DISTRIBUTION". IF1244.2 +014500 02 FILLER PIC X(41) VALUE SPACE. IF1244.2 +014600 IF1244.2 +014700 01 CCVS-H-2B. IF1244.2 +014800 02 FILLER PIC X(15) VALUE IF1244.2 +014900 "TEST RESULT OF ". IF1244.2 +015000 02 TEST-ID PIC X(9). IF1244.2 +015100 02 FILLER PIC X(4) VALUE IF1244.2 +015200 " IN ". IF1244.2 +015300 02 FILLER PIC X(12) VALUE IF1244.2 +015400 " HIGH ". IF1244.2 +015500 02 FILLER PIC X(22) VALUE IF1244.2 +015600 " LEVEL VALIDATION FOR ". IF1244.2 +015700 02 FILLER PIC X(58) VALUE IF1244.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1244.2 +015900 01 CCVS-H-3. IF1244.2 +016000 02 FILLER PIC X(34) VALUE IF1244.2 +016100 " FOR OFFICIAL USE ONLY ". IF1244.2 +016200 02 FILLER PIC X(58) VALUE IF1244.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1244.2 +016400 02 FILLER PIC X(28) VALUE IF1244.2 +016500 " COPYRIGHT 1985 ". IF1244.2 +016600 01 CCVS-E-1. IF1244.2 +016700 02 FILLER PIC X(52) VALUE SPACE. IF1244.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1244.2 +016900 02 ID-AGAIN PIC X(9). IF1244.2 +017000 02 FILLER PIC X(45) VALUE SPACES. IF1244.2 +017100 01 CCVS-E-2. IF1244.2 +017200 02 FILLER PIC X(31) VALUE SPACE. IF1244.2 +017300 02 FILLER PIC X(21) VALUE SPACE. IF1244.2 +017400 02 CCVS-E-2-2. IF1244.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1244.2 +017600 03 FILLER PIC X VALUE SPACE. IF1244.2 +017700 03 ENDER-DESC PIC X(44) VALUE IF1244.2 +017800 "ERRORS ENCOUNTERED". IF1244.2 +017900 01 CCVS-E-3. IF1244.2 +018000 02 FILLER PIC X(22) VALUE IF1244.2 +018100 " FOR OFFICIAL USE ONLY". IF1244.2 +018200 02 FILLER PIC X(12) VALUE SPACE. IF1244.2 +018300 02 FILLER PIC X(58) VALUE IF1244.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1244.2 +018500 02 FILLER PIC X(13) VALUE SPACE. IF1244.2 +018600 02 FILLER PIC X(15) VALUE IF1244.2 +018700 " COPYRIGHT 1985". IF1244.2 +018800 01 CCVS-E-4. IF1244.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1244.2 +019000 02 FILLER PIC X(4) VALUE " OF ". IF1244.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1244.2 +019200 02 FILLER PIC X(40) VALUE IF1244.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1244.2 +019400 01 XXINFO. IF1244.2 +019500 02 FILLER PIC X(19) VALUE IF1244.2 +019600 "*** INFORMATION ***". IF1244.2 +019700 02 INFO-TEXT. IF1244.2 +019800 04 FILLER PIC X(8) VALUE SPACE. IF1244.2 +019900 04 XXCOMPUTED PIC X(20). IF1244.2 +020000 04 FILLER PIC X(5) VALUE SPACE. IF1244.2 +020100 04 XXCORRECT PIC X(20). IF1244.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). IF1244.2 +020300 01 HYPHEN-LINE. IF1244.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. IF1244.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************IF1244.2 +020600- "*****************************************". IF1244.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************IF1244.2 +020800- "******************************". IF1244.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE IF1244.2 +021000 "IF124A". IF1244.2 +021100 PROCEDURE DIVISION. IF1244.2 +021200 CCVS1 SECTION. IF1244.2 +021300 OPEN-FILES. IF1244.2 +021400 OPEN OUTPUT PRINT-FILE. IF1244.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1244.2 +021600 MOVE SPACE TO TEST-RESULTS. IF1244.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1244.2 +021800 GO TO CCVS1-EXIT. IF1244.2 +021900 CLOSE-FILES. IF1244.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1244.2 +022100 TERMINATE-CCVS. IF1244.2 +022200 STOP RUN. IF1244.2 +022300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1244.2 +022400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1244.2 +022500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1244.2 +022600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1244.2 +022700 MOVE "****TEST DELETED****" TO RE-MARK. IF1244.2 +022800 PRINT-DETAIL. IF1244.2 +022900 IF REC-CT NOT EQUAL TO ZERO IF1244.2 +023000 MOVE "." TO PARDOT-X IF1244.2 +023100 MOVE REC-CT TO DOTVALUE. IF1244.2 +023200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1244.2 +023300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1244.2 +023400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1244.2 +023500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1244.2 +023600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1244.2 +023700 MOVE SPACE TO CORRECT-X. IF1244.2 +023800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1244.2 +023900 MOVE SPACE TO RE-MARK. IF1244.2 +024000 HEAD-ROUTINE. IF1244.2 +024100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1244.2 +024400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1244.2 +024500 COLUMN-NAMES-ROUTINE. IF1244.2 +024600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +024700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +024900 END-ROUTINE. IF1244.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1244.2 +025100 END-RTN-EXIT. IF1244.2 +025200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +025300 END-ROUTINE-1. IF1244.2 +025400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1244.2 +025500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1244.2 +025600 ADD PASS-COUNTER TO ERROR-HOLD. IF1244.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1244.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1244.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1244.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1244.2 +026100 END-ROUTINE-12. IF1244.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1244.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1244.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1244.2 +026500 ELSE IF1244.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1244.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1244.2 +026800 PERFORM WRITE-LINE. IF1244.2 +026900 END-ROUTINE-13. IF1244.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1244.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE IF1244.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1244.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1244.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO IF1244.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1244.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1244.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1244.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +028100 WRITE-LINE. IF1244.2 +028200 ADD 1 TO RECORD-COUNT. IF1244.2 +028300Y IF RECORD-COUNT GREATER 42 IF1244.2 +028400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1244.2 +028500Y MOVE SPACE TO DUMMY-RECORD IF1244.2 +028600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1244.2 +028700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1244.2 +028800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1244.2 +028900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1244.2 +029000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1244.2 +029100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029400Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1244.2 +029500Y MOVE ZERO TO RECORD-COUNT. IF1244.2 +029600 PERFORM WRT-LN. IF1244.2 +029700 WRT-LN. IF1244.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1244.2 +029900 MOVE SPACE TO DUMMY-RECORD. IF1244.2 +030000 BLANK-LINE-PRINT. IF1244.2 +030100 PERFORM WRT-LN. IF1244.2 +030200 FAIL-ROUTINE. IF1244.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE IF1244.2 +030400 GO TO FAIL-ROUTINE-WRITE. IF1244.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1244.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1244.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1244.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1244.2 +031000 GO TO FAIL-ROUTINE-EX. IF1244.2 +031100 FAIL-ROUTINE-WRITE. IF1244.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1244.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1244.2 +031400 CORMA-ANSI-REFERENCE. IF1244.2 +031500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1244.2 +031600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1244.2 +031700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1244.2 +031800 ELSE IF1244.2 +031900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1244.2 +032000 PERFORM WRITE-LINE. IF1244.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1244.2 +032200 FAIL-ROUTINE-EX. EXIT. IF1244.2 +032300 BAIL-OUT. IF1244.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1244.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1244.2 +032600 BAIL-OUT-WRITE. IF1244.2 +032700 MOVE CORRECT-A TO XXCORRECT. IF1244.2 +032800 MOVE COMPUTED-A TO XXCOMPUTED. IF1244.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1244.2 +033000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +033100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1244.2 +033200 BAIL-OUT-EX. EXIT. IF1244.2 +033300 CCVS1-EXIT. IF1244.2 +033400 EXIT. IF1244.2 +033500******************************************************** IF1244.2 +033600* * IF1244.2 +033700* Intrinsic Function Tests IF124A - MOD * IF1244.2 +033800* * IF1244.2 +033900******************************************************** IF1244.2 +034000 SECT-IF124A SECTION. IF1244.2 +034100 F-MOD-INFO. IF1244.2 +034200 MOVE "See ref. A-58 2.28" TO ANSI-REFERENCE. IF1244.2 +034300 MOVE "MOD Function" TO FEATURE. IF1244.2 +034400*****************TEST (a) - SIMPLE TEST***************** IF1244.2 +034500 F-MOD-01. IF1244.2 +034600 MOVE ZERO TO WS-NUM. IF1244.2 +034700 F-MOD-TEST-01. IF1244.2 +034800 COMPUTE WS-NUM = FUNCTION MOD(6, 6). IF1244.2 +034900 IF WS-NUM = 0 THEN IF1244.2 +035000 PERFORM PASS IF1244.2 +035100 ELSE IF1244.2 +035200 MOVE WS-NUM TO COMPUTED-N IF1244.2 +035300 MOVE 0 TO CORRECT-N IF1244.2 +035400 PERFORM FAIL. IF1244.2 +035500 GO TO F-MOD-WRITE-01. IF1244.2 +035600 F-MOD-DELETE-01. IF1244.2 +035700 PERFORM DE-LETE. IF1244.2 +035800 GO TO F-MOD-WRITE-01. IF1244.2 +035900 F-MOD-WRITE-01. IF1244.2 +036000 MOVE "F-MOD-01" TO PAR-NAME. IF1244.2 +036100 PERFORM PRINT-DETAIL. IF1244.2 +036200*****************TEST (b) - SIMPLE TEST***************** IF1244.2 +036300 F-MOD-02. IF1244.2 +036400 EVALUATE FUNCTION MOD(11, 5) IF1244.2 +036500 WHEN 1 IF1244.2 +036600 PERFORM PASS IF1244.2 +036700 WHEN OTHER IF1244.2 +036800 PERFORM FAIL. IF1244.2 +036900 GO TO F-MOD-WRITE-02. IF1244.2 +037000 F-MOD-DELETE-02. IF1244.2 +037100 PERFORM DE-LETE. IF1244.2 +037200 GO TO F-MOD-WRITE-02. IF1244.2 +037300 F-MOD-WRITE-02. IF1244.2 +037400 MOVE "F-MOD-02" TO PAR-NAME. IF1244.2 +037500 PERFORM PRINT-DETAIL. IF1244.2 +037600*****************TEST (c) - SIMPLE TEST***************** IF1244.2 +037700 F-MOD-03. IF1244.2 +037800 IF FUNCTION MOD(10, 20) = 10 THEN IF1244.2 +037900 PERFORM PASS IF1244.2 +038000 ELSE IF1244.2 +038100 PERFORM FAIL. IF1244.2 +038200 GO TO F-MOD-WRITE-03. IF1244.2 +038300 F-MOD-DELETE-03. IF1244.2 +038400 PERFORM DE-LETE. IF1244.2 +038500 GO TO F-MOD-WRITE-03. IF1244.2 +038600 F-MOD-WRITE-03. IF1244.2 +038700 MOVE "F-MOD-03" TO PAR-NAME. IF1244.2 +038800 PERFORM PRINT-DETAIL. IF1244.2 +038900*****************TEST (d) - SIMPLE TEST***************** IF1244.2 +039000 F-MOD-04. IF1244.2 +039100 MOVE ZERO TO WS-NUM. IF1244.2 +039200 F-MOD-TEST-04. IF1244.2 +039300 COMPUTE WS-NUM = FUNCTION MOD(A, B). IF1244.2 +039400 IF WS-NUM = 5 THEN IF1244.2 +039500 PERFORM PASS IF1244.2 +039600 ELSE IF1244.2 +039700 MOVE WS-NUM TO COMPUTED-N IF1244.2 +039800 MOVE 5 TO CORRECT-N IF1244.2 +039900 PERFORM FAIL. IF1244.2 +040000 GO TO F-MOD-WRITE-04. IF1244.2 +040100 F-MOD-DELETE-04. IF1244.2 +040200 PERFORM DE-LETE. IF1244.2 +040300 GO TO F-MOD-WRITE-04. IF1244.2 +040400 F-MOD-WRITE-04. IF1244.2 +040500 MOVE "F-MOD-04" TO PAR-NAME. IF1244.2 +040600 PERFORM PRINT-DETAIL. IF1244.2 +040700*****************TEST (e) - SIMPLE TEST***************** IF1244.2 +040800 F-MOD-05. IF1244.2 +040900 MOVE ZERO TO WS-NUM. IF1244.2 +041000 F-MOD-TEST-05. IF1244.2 +041100 COMPUTE WS-NUM = FUNCTION MOD(A, -3). IF1244.2 +041200 IF WS-NUM = -1 THEN IF1244.2 +041300 PERFORM PASS IF1244.2 +041400 ELSE IF1244.2 +041500 MOVE WS-NUM TO COMPUTED-N IF1244.2 +041600 MOVE -1 TO CORRECT-N IF1244.2 +041700 PERFORM FAIL. IF1244.2 +041800 GO TO F-MOD-WRITE-05. IF1244.2 +041900 F-MOD-DELETE-05. IF1244.2 +042000 PERFORM DE-LETE. IF1244.2 +042100 GO TO F-MOD-WRITE-05. IF1244.2 +042200 F-MOD-WRITE-05. IF1244.2 +042300 MOVE "F-MOD-05" TO PAR-NAME. IF1244.2 +042400 PERFORM PRINT-DETAIL. IF1244.2 +042500*****************TEST (f) - SIMPLE TEST***************** IF1244.2 +042600 F-MOD-06. IF1244.2 +042700 MOVE ZERO TO WS-NUM. IF1244.2 +042800 F-MOD-TEST-06. IF1244.2 +042900 COMPUTE WS-NUM = FUNCTION MOD(23, B). IF1244.2 +043000 IF WS-NUM = 2 THEN IF1244.2 +043100 PERFORM PASS IF1244.2 +043200 ELSE IF1244.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +043400 MOVE 2 TO CORRECT-N IF1244.2 +043500 PERFORM FAIL. IF1244.2 +043600 GO TO F-MOD-WRITE-06. IF1244.2 +043700 F-MOD-DELETE-06. IF1244.2 +043800 PERFORM DE-LETE. IF1244.2 +043900 GO TO F-MOD-WRITE-06. IF1244.2 +044000 F-MOD-WRITE-06. IF1244.2 +044100 MOVE "F-MOD-06" TO PAR-NAME. IF1244.2 +044200 PERFORM PRINT-DETAIL. IF1244.2 +044300*****************TEST (g) - SIMPLE TEST***************** IF1244.2 +044400 F-MOD-07. IF1244.2 +044500 MOVE ZERO TO WS-NUM. IF1244.2 +044600 F-MOD-TEST-07. IF1244.2 +044700 COMPUTE WS-NUM = FUNCTION MOD(-11, -5). IF1244.2 +044800 IF WS-NUM = -1 THEN IF1244.2 +044900 PERFORM PASS IF1244.2 +045000 ELSE IF1244.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1244.2 +045200 MOVE -1 TO CORRECT-N IF1244.2 +045300 PERFORM FAIL. IF1244.2 +045400 GO TO F-MOD-WRITE-07. IF1244.2 +045500 F-MOD-DELETE-07. IF1244.2 +045600 PERFORM DE-LETE. IF1244.2 +045700 GO TO F-MOD-WRITE-07. IF1244.2 +045800 F-MOD-WRITE-07. IF1244.2 +045900 MOVE "F-MOD-07" TO PAR-NAME. IF1244.2 +046000 PERFORM PRINT-DETAIL. IF1244.2 +046100*****************TEST (h) - SIMPLE TEST***************** IF1244.2 +046200 F-MOD-08. IF1244.2 +046300 MOVE ZERO TO WS-NUM. IF1244.2 +046400 F-MOD-TEST-08. IF1244.2 +046500 COMPUTE WS-NUM = FUNCTION MOD(11, -5). IF1244.2 +046600 IF WS-NUM = -4 THEN IF1244.2 +046700 PERFORM PASS IF1244.2 +046800 ELSE IF1244.2 +046900 MOVE WS-NUM TO COMPUTED-N IF1244.2 +047000 MOVE -4 TO CORRECT-N IF1244.2 +047100 PERFORM FAIL. IF1244.2 +047200 GO TO F-MOD-WRITE-08. IF1244.2 +047300 F-MOD-DELETE-08. IF1244.2 +047400 PERFORM DE-LETE. IF1244.2 +047500 GO TO F-MOD-WRITE-08. IF1244.2 +047600 F-MOD-WRITE-08. IF1244.2 +047700 MOVE "F-MOD-08" TO PAR-NAME. IF1244.2 +047800 PERFORM PRINT-DETAIL. IF1244.2 +047900*****************TEST (i) - SIMPLE TEST***************** IF1244.2 +048000 F-MOD-09. IF1244.2 +048100 MOVE ZERO TO WS-NUM. IF1244.2 +048200 F-MOD-TEST-09. IF1244.2 +048300 COMPUTE WS-NUM = FUNCTION MOD(-11, 5). IF1244.2 +048400 IF WS-NUM = 4 THEN IF1244.2 +048500 PERFORM PASS IF1244.2 +048600 ELSE IF1244.2 +048700 MOVE WS-NUM TO COMPUTED-N IF1244.2 +048800 MOVE 4 TO CORRECT-N IF1244.2 +048900 PERFORM FAIL. IF1244.2 +049000 GO TO F-MOD-WRITE-09. IF1244.2 +049100 F-MOD-DELETE-09. IF1244.2 +049200 PERFORM DE-LETE. IF1244.2 +049300 GO TO F-MOD-WRITE-09. IF1244.2 +049400 F-MOD-WRITE-09. IF1244.2 +049500 MOVE "F-MOD-09" TO PAR-NAME. IF1244.2 +049600 PERFORM PRINT-DETAIL. IF1244.2 +049700*****************TEST (a) - COMPLEX TEST**************** IF1244.2 +049800 F-MOD-11. IF1244.2 +049900 MOVE ZERO TO WS-NUM. IF1244.2 +050000 MOVE -0.000020 TO MIN-RANGE. IF1244.2 +050100 MOVE 0.000020 TO MAX-RANGE. IF1244.2 +050200 F-MOD-TEST-11. IF1244.2 +050300 COMPUTE WS-NUM = FUNCTION MOD(35, FUNCTION INTEGER(A * B)). IF1244.2 +050400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +050500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +050600 PERFORM PASS IF1244.2 +050700 ELSE IF1244.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +050900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +051000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +051100 PERFORM FAIL. IF1244.2 +051200 GO TO F-MOD-WRITE-11. IF1244.2 +051300 F-MOD-DELETE-11. IF1244.2 +051400 PERFORM DE-LETE. IF1244.2 +051500 GO TO F-MOD-WRITE-11. IF1244.2 +051600 F-MOD-WRITE-11. IF1244.2 +051700 MOVE "F-MOD-11" TO PAR-NAME. IF1244.2 +051800 PERFORM PRINT-DETAIL. IF1244.2 +051900*****************TEST (b) - COMPLEX TEST**************** IF1244.2 +052000 F-MOD-12. IF1244.2 +052100 MOVE ZERO TO WS-NUM. IF1244.2 +052200 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +052300 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +052400 F-MOD-TEST-12. IF1244.2 +052500 COMPUTE WS-NUM = FUNCTION MOD(A, FUNCTION INTEGER(B - 5)). IF1244.2 +052600 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +052700 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +052800 PERFORM PASS IF1244.2 +052900 ELSE IF1244.2 +053000 MOVE WS-NUM TO COMPUTED-N IF1244.2 +053100 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +053200 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +053300 PERFORM FAIL. IF1244.2 +053400 GO TO F-MOD-WRITE-12. IF1244.2 +053500 F-MOD-DELETE-12. IF1244.2 +053600 PERFORM DE-LETE. IF1244.2 +053700 GO TO F-MOD-WRITE-12. IF1244.2 +053800 F-MOD-WRITE-12. IF1244.2 +053900 MOVE "F-MOD-12" TO PAR-NAME. IF1244.2 +054000 PERFORM PRINT-DETAIL. IF1244.2 +054100*****************TEST (c) - COMPLEX TEST**************** IF1244.2 +054200 F-MOD-13. IF1244.2 +054300 MOVE ZERO TO WS-NUM. IF1244.2 +054400 MOVE 6.99986 TO MIN-RANGE. IF1244.2 +054500 MOVE 7.00014 TO MAX-RANGE. IF1244.2 +054600 F-MOD-TEST-13. IF1244.2 +054700 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION INTEGER(A - B), 9). IF1244.2 +054800 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +054900 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +055000 PERFORM PASS IF1244.2 +055100 ELSE IF1244.2 +055200 MOVE WS-NUM TO COMPUTED-N IF1244.2 +055300 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +055400 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +055500 PERFORM FAIL. IF1244.2 +055600 GO TO F-MOD-WRITE-13. IF1244.2 +055700 F-MOD-DELETE-13. IF1244.2 +055800 PERFORM DE-LETE. IF1244.2 +055900 GO TO F-MOD-WRITE-13. IF1244.2 +056000 F-MOD-WRITE-13. IF1244.2 +056100 MOVE "F-MOD-13" TO PAR-NAME. IF1244.2 +056200 PERFORM PRINT-DETAIL. IF1244.2 +056300*****************TEST (d) - COMPLEX TEST**************** IF1244.2 +056400 F-MOD-14. IF1244.2 +056500 MOVE ZERO TO WS-NUM. IF1244.2 +056600 MOVE -2.00004 TO MIN-RANGE. IF1244.2 +056700 MOVE -1.99996 TO MAX-RANGE. IF1244.2 +056800 F-MOD-TEST-14. IF1244.2 +056900 COMPUTE WS-NUM = FUNCTION MOD( IF1244.2 +057000 FUNCTION INTEGER((A + B) / -2), -4). IF1244.2 +057100 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +057200 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +057300 PERFORM PASS IF1244.2 +057400 ELSE IF1244.2 +057500 MOVE WS-NUM TO COMPUTED-N IF1244.2 +057600 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +057700 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +057800 PERFORM FAIL. IF1244.2 +057900 GO TO F-MOD-WRITE-14. IF1244.2 +058000 F-MOD-DELETE-14. IF1244.2 +058100 PERFORM DE-LETE. IF1244.2 +058200 GO TO F-MOD-WRITE-14. IF1244.2 +058300 F-MOD-WRITE-14. IF1244.2 +058400 MOVE "F-MOD-14" TO PAR-NAME. IF1244.2 +058500 PERFORM PRINT-DETAIL. IF1244.2 +058600*****************TEST (e) - COMPLEX TEST**************** IF1244.2 +058700 F-MOD-15. IF1244.2 +058800 MOVE ZERO TO WS-NUM. IF1244.2 +058900 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +059000 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +059100 F-MOD-TEST-15. IF1244.2 +059200 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION INTEGER(A * B), IF1244.2 +059300 FUNCTION INTEGER(B - A)). IF1244.2 +059400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +059500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +059600 PERFORM PASS IF1244.2 +059700 ELSE IF1244.2 +059800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +059900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +060000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +060100 PERFORM FAIL. IF1244.2 +060200 GO TO F-MOD-WRITE-15. IF1244.2 +060300 F-MOD-DELETE-15. IF1244.2 +060400 PERFORM DE-LETE. IF1244.2 +060500 GO TO F-MOD-WRITE-15. IF1244.2 +060600 F-MOD-WRITE-15. IF1244.2 +060700 MOVE "F-MOD-15" TO PAR-NAME. IF1244.2 +060800 PERFORM PRINT-DETAIL. IF1244.2 +060900*****************TEST (f) - COMPLEX TEST**************** IF1244.2 +061000 F-MOD-16. IF1244.2 +061100 MOVE ZERO TO WS-NUM. IF1244.2 +061200 MOVE 1.99996 TO MIN-RANGE. IF1244.2 +061300 MOVE 2.00004 TO MAX-RANGE. IF1244.2 +061400 F-MOD-TEST-16. IF1244.2 +061500 COMPUTE WS-NUM = FUNCTION MOD( IF1244.2 +061600 FUNCTION MOD(B, A), A). IF1244.2 +061700 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +061800 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +061900 PERFORM PASS IF1244.2 +062000 ELSE IF1244.2 +062100 MOVE WS-NUM TO COMPUTED-N IF1244.2 +062200 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +062300 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +062400 PERFORM FAIL. IF1244.2 +062500 GO TO F-MOD-WRITE-16. IF1244.2 +062600 F-MOD-DELETE-16. IF1244.2 +062700 PERFORM DE-LETE. IF1244.2 +062800 GO TO F-MOD-WRITE-16. IF1244.2 +062900 F-MOD-WRITE-16. IF1244.2 +063000 MOVE "F-MOD-16" TO PAR-NAME. IF1244.2 +063100 PERFORM PRINT-DETAIL. IF1244.2 +063200*****************TEST (g) - COMPLEX TEST**************** IF1244.2 +063300 F-MOD-17. IF1244.2 +063400 MOVE ZERO TO WS-NUM. IF1244.2 +063500 MOVE 1.99996 TO MIN-RANGE. IF1244.2 +063600 MOVE 2.00004 TO MAX-RANGE. IF1244.2 +063700 F-MOD-TEST-17. IF1244.2 +063800 COMPUTE WS-NUM = FUNCTION MOD(C, FUNCTION MOD(C, B)). IF1244.2 +063900 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +064000 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +064100 PERFORM PASS IF1244.2 +064200 ELSE IF1244.2 +064300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +064400 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +064500 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +064600 PERFORM FAIL. IF1244.2 +064700 GO TO F-MOD-WRITE-17. IF1244.2 +064800 F-MOD-DELETE-17. IF1244.2 +064900 PERFORM DE-LETE. IF1244.2 +065000 GO TO F-MOD-WRITE-17. IF1244.2 +065100 F-MOD-WRITE-17. IF1244.2 +065200 MOVE "F-MOD-17" TO PAR-NAME. IF1244.2 +065300 PERFORM PRINT-DETAIL. IF1244.2 +065400*****************TEST (h) - COMPLEX TEST**************** IF1244.2 +065500 F-MOD-18. IF1244.2 +065600 MOVE ZERO TO WS-NUM. IF1244.2 +065700 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +065800 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +065900 F-MOD-TEST-18. IF1244.2 +066000 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION MOD(9, 5), IF1244.2 +066100 FUNCTION MOD(B, 4)). IF1244.2 +066200 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +066300 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +066400 PERFORM PASS IF1244.2 +066500 ELSE IF1244.2 +066600 MOVE WS-NUM TO COMPUTED-N IF1244.2 +066700 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +066800 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +066900 PERFORM FAIL. IF1244.2 +067000 GO TO F-MOD-WRITE-18. IF1244.2 +067100 F-MOD-DELETE-18. IF1244.2 +067200 PERFORM DE-LETE. IF1244.2 +067300 GO TO F-MOD-WRITE-18. IF1244.2 +067400 F-MOD-WRITE-18. IF1244.2 +067500 MOVE "F-MOD-18" TO PAR-NAME. IF1244.2 +067600 PERFORM PRINT-DETAIL. IF1244.2 +067700*****************TEST (i) - COMPLEX TEST**************** IF1244.2 +067800 F-MOD-19. IF1244.2 +067900 MOVE ZERO TO WS-NUM. IF1244.2 +068000 MOVE 6.99986 TO MIN-RANGE. IF1244.2 +068100 MOVE 7.00014 TO MAX-RANGE. IF1244.2 +068200 F-MOD-TEST-19. IF1244.2 +068300 COMPUTE WS-NUM = FUNCTION MOD(23, B) + A. IF1244.2 +068400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +068500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +068600 PERFORM PASS IF1244.2 +068700 ELSE IF1244.2 +068800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +068900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +069000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +069100 PERFORM FAIL. IF1244.2 +069200 GO TO F-MOD-WRITE-19. IF1244.2 +069300 F-MOD-DELETE-19. IF1244.2 +069400 PERFORM DE-LETE. IF1244.2 +069500 GO TO F-MOD-WRITE-19. IF1244.2 +069600 F-MOD-WRITE-19. IF1244.2 +069700 MOVE "F-MOD-19" TO PAR-NAME. IF1244.2 +069800 PERFORM PRINT-DETAIL. IF1244.2 +069900*****************TEST (j) - COMPLEX TEST**************** IF1244.2 +070000 F-MOD-20. IF1244.2 +070100 MOVE ZERO TO WS-NUM. IF1244.2 +070200 MOVE -0.000020 TO MIN-RANGE. IF1244.2 +070300 MOVE 0.000020 TO MAX-RANGE. IF1244.2 +070400 F-MOD-TEST-20. IF1244.2 +070500 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION MOD(5, 2), 1). IF1244.2 +070600 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +070700 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +070800 PERFORM PASS IF1244.2 +070900 ELSE IF1244.2 +071000 MOVE WS-NUM TO COMPUTED-N IF1244.2 +071100 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +071200 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +071300 PERFORM FAIL. IF1244.2 +071400 GO TO F-MOD-WRITE-20. IF1244.2 +071500 F-MOD-DELETE-20. IF1244.2 +071600 PERFORM DE-LETE. IF1244.2 +071700 GO TO F-MOD-WRITE-20. IF1244.2 +071800 F-MOD-WRITE-20. IF1244.2 +071900 MOVE "F-MOD-20" TO PAR-NAME. IF1244.2 +072000 PERFORM PRINT-DETAIL. IF1244.2 +072100*****************TEST (k) - COMPLEX TEST**************** IF1244.2 +072200 F-MOD-21. IF1244.2 +072300 MOVE ZERO TO WS-NUM. IF1244.2 +072400 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +072500 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +072600 F-MOD-TEST-21. IF1244.2 +072700 COMPUTE WS-NUM = FUNCTION MOD(25, C) + IF1244.2 +072800 FUNCTION MOD(-11, 5). IF1244.2 +072900 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +073000 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +073100 PERFORM PASS IF1244.2 +073200 ELSE IF1244.2 +073300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +073400 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +073500 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +073600 PERFORM FAIL. IF1244.2 +073700 GO TO F-MOD-WRITE-21. IF1244.2 +073800 F-MOD-DELETE-21. IF1244.2 +073900 PERFORM DE-LETE. IF1244.2 +074000 GO TO F-MOD-WRITE-21. IF1244.2 +074100 F-MOD-WRITE-21. IF1244.2 +074200 MOVE "F-MOD-21" TO PAR-NAME. IF1244.2 +074300 PERFORM PRINT-DETAIL. IF1244.2 +074400*****************SPECIAL PERFORM TEST********************** IF1244.2 +074500 F-MOD-22. IF1244.2 +074600 PERFORM F-MOD-TEST-22 IF1244.2 +074700 UNTIL FUNCTION MOD(5, ARG2) >= 2. IF1244.2 +074800 PERFORM PASS. IF1244.2 +074900 GO TO F-MOD-WRITE-22. IF1244.2 +075000 F-MOD-TEST-22. IF1244.2 +075100 COMPUTE ARG2 = ARG2 + 1. IF1244.2 +075200 F-MOD-DELETE-22. IF1244.2 +075300 PERFORM DE-LETE. IF1244.2 +075400 GO TO F-MOD-WRITE-22. IF1244.2 +075500 F-MOD-WRITE-22. IF1244.2 +075600 MOVE "F-MOD-22" TO PAR-NAME. IF1244.2 +075700 PERFORM PRINT-DETAIL. IF1244.2 +075800********************END OF TESTS*************** IF1244.2 +075900 CCVS-EXIT SECTION. IF1244.2 +076000 CCVS-999999. IF1244.2 +076100 GO TO CLOSE-FILES. IF1244.2 +*END-OF,IF124A +*HEADER,COBOL,IF125A +000100 IDENTIFICATION DIVISION. IF1254.2 +000200 PROGRAM-ID. IF1254.2 +000300 IF125A. IF1254.2 +000400 IF1254.2 +000500*********************************************************** IF1254.2 +000600* * IF1254.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1254.2 +000800* It contains tests for the Intrinsic Function NUMVAL. * IF1254.2 +000900* * IF1254.2 +001000* * IF1254.2 +001100*********************************************************** IF1254.2 +001200 ENVIRONMENT DIVISION. IF1254.2 +001300 CONFIGURATION SECTION. IF1254.2 +001400 SOURCE-COMPUTER. IF1254.2 +001500 XXXXX082. IF1254.2 +001600 OBJECT-COMPUTER. IF1254.2 +001700 XXXXX083. IF1254.2 +001800 INPUT-OUTPUT SECTION. IF1254.2 +001900 FILE-CONTROL. IF1254.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1254.2 +002100 XXXXX055. IF1254.2 +002200 DATA DIVISION. IF1254.2 +002300 FILE SECTION. IF1254.2 +002400 FD PRINT-FILE. IF1254.2 +002500 01 PRINT-REC PICTURE X(120). IF1254.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1254.2 +002700 WORKING-STORAGE SECTION. IF1254.2 +002800*********************************************************** IF1254.2 +002900* Variables specific to the Intrinsic Function Test IF125A* IF1254.2 +003000*********************************************************** IF1254.2 +003100 01 A PIC X(1) VALUE "4". IF1254.2 +003200 01 B PIC X(5) VALUE "203". IF1254.2 +003300 01 C PIC X(4) VALUE ".429". IF1254.2 +003400 01 D PIC X(7) VALUE "928.344". IF1254.2 +003500 01 E PIC X(9) VALUE "-042.3240". IF1254.2 +003600 01 F PIC X(7) VALUE " 23.000". IF1254.2 +003700 01 G PIC X(8) VALUE "-92924.3". IF1254.2 +003800 01 H PIC X(6) VALUE "93.21+". IF1254.2 +003900 01 I PIC X(9) VALUE " 92.92 -". IF1254.2 +004000 01 TEMP PIC S9(5)V9(5). IF1254.2 +004100 IF1254.2 +004200* IF1254.2 +004300********************************************************** IF1254.2 +004400* IF1254.2 +004500 01 TEST-RESULTS. IF1254.2 +004600 02 FILLER PIC X VALUE SPACE. IF1254.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1254.2 +004800 02 FILLER PIC X VALUE SPACE. IF1254.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1254.2 +005000 02 FILLER PIC X VALUE SPACE. IF1254.2 +005100 02 PAR-NAME. IF1254.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1254.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1254.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1254.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1254.2 +005600 02 RE-MARK PIC X(61). IF1254.2 +005700 01 TEST-COMPUTED. IF1254.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1254.2 +005900 02 FILLER PIC X(17) VALUE IF1254.2 +006000 " COMPUTED=". IF1254.2 +006100 02 COMPUTED-X. IF1254.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1254.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1254.2 +006400 PIC -9(9).9(9). IF1254.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1254.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1254.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1254.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1254.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1254.2 +007000 04 FILLER PIC X. IF1254.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1254.2 +007200 01 TEST-CORRECT. IF1254.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1254.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1254.2 +007500 02 CORRECT-X. IF1254.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1254.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1254.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1254.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1254.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1254.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1254.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1254.2 +008300 04 FILLER PIC X. IF1254.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1254.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1254.2 +008600 01 CCVS-C-1. IF1254.2 +008700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1254.2 +008800- "SS PARAGRAPH-NAME IF1254.2 +008900- " REMARKS". IF1254.2 +009000 02 FILLER PIC X(20) VALUE SPACE. IF1254.2 +009100 01 CCVS-C-2. IF1254.2 +009200 02 FILLER PIC X VALUE SPACE. IF1254.2 +009300 02 FILLER PIC X(6) VALUE "TESTED". IF1254.2 +009400 02 FILLER PIC X(15) VALUE SPACE. IF1254.2 +009500 02 FILLER PIC X(4) VALUE "FAIL". IF1254.2 +009600 02 FILLER PIC X(94) VALUE SPACE. IF1254.2 +009700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1254.2 +009800 01 REC-CT PIC 99 VALUE ZERO. IF1254.2 +009900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1254.2 +010400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1254.2 +010500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1254.2 +010600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1254.2 +010700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1254.2 +010800 01 CCVS-H-1. IF1254.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1254.2 +011000 02 FILLER PIC X(42) VALUE IF1254.2 +011100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1254.2 +011200 02 FILLER PIC X(39) VALUE SPACES. IF1254.2 +011300 01 CCVS-H-2A. IF1254.2 +011400 02 FILLER PIC X(40) VALUE SPACE. IF1254.2 +011500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1254.2 +011600 02 FILLER PIC XXXX VALUE IF1254.2 +011700 "4.2 ". IF1254.2 +011800 02 FILLER PIC X(28) VALUE IF1254.2 +011900 " COPY - NOT FOR DISTRIBUTION". IF1254.2 +012000 02 FILLER PIC X(41) VALUE SPACE. IF1254.2 +012100 IF1254.2 +012200 01 CCVS-H-2B. IF1254.2 +012300 02 FILLER PIC X(15) VALUE IF1254.2 +012400 "TEST RESULT OF ". IF1254.2 +012500 02 TEST-ID PIC X(9). IF1254.2 +012600 02 FILLER PIC X(4) VALUE IF1254.2 +012700 " IN ". IF1254.2 +012800 02 FILLER PIC X(12) VALUE IF1254.2 +012900 " HIGH ". IF1254.2 +013000 02 FILLER PIC X(22) VALUE IF1254.2 +013100 " LEVEL VALIDATION FOR ". IF1254.2 +013200 02 FILLER PIC X(58) VALUE IF1254.2 +013300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1254.2 +013400 01 CCVS-H-3. IF1254.2 +013500 02 FILLER PIC X(34) VALUE IF1254.2 +013600 " FOR OFFICIAL USE ONLY ". IF1254.2 +013700 02 FILLER PIC X(58) VALUE IF1254.2 +013800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1254.2 +013900 02 FILLER PIC X(28) VALUE IF1254.2 +014000 " COPYRIGHT 1985 ". IF1254.2 +014100 01 CCVS-E-1. IF1254.2 +014200 02 FILLER PIC X(52) VALUE SPACE. IF1254.2 +014300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1254.2 +014400 02 ID-AGAIN PIC X(9). IF1254.2 +014500 02 FILLER PIC X(45) VALUE SPACES. IF1254.2 +014600 01 CCVS-E-2. IF1254.2 +014700 02 FILLER PIC X(31) VALUE SPACE. IF1254.2 +014800 02 FILLER PIC X(21) VALUE SPACE. IF1254.2 +014900 02 CCVS-E-2-2. IF1254.2 +015000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1254.2 +015100 03 FILLER PIC X VALUE SPACE. IF1254.2 +015200 03 ENDER-DESC PIC X(44) VALUE IF1254.2 +015300 "ERRORS ENCOUNTERED". IF1254.2 +015400 01 CCVS-E-3. IF1254.2 +015500 02 FILLER PIC X(22) VALUE IF1254.2 +015600 " FOR OFFICIAL USE ONLY". IF1254.2 +015700 02 FILLER PIC X(12) VALUE SPACE. IF1254.2 +015800 02 FILLER PIC X(58) VALUE IF1254.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1254.2 +016000 02 FILLER PIC X(13) VALUE SPACE. IF1254.2 +016100 02 FILLER PIC X(15) VALUE IF1254.2 +016200 " COPYRIGHT 1985". IF1254.2 +016300 01 CCVS-E-4. IF1254.2 +016400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1254.2 +016500 02 FILLER PIC X(4) VALUE " OF ". IF1254.2 +016600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1254.2 +016700 02 FILLER PIC X(40) VALUE IF1254.2 +016800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1254.2 +016900 01 XXINFO. IF1254.2 +017000 02 FILLER PIC X(19) VALUE IF1254.2 +017100 "*** INFORMATION ***". IF1254.2 +017200 02 INFO-TEXT. IF1254.2 +017300 04 FILLER PIC X(8) VALUE SPACE. IF1254.2 +017400 04 XXCOMPUTED PIC X(20). IF1254.2 +017500 04 FILLER PIC X(5) VALUE SPACE. IF1254.2 +017600 04 XXCORRECT PIC X(20). IF1254.2 +017700 02 INF-ANSI-REFERENCE PIC X(48). IF1254.2 +017800 01 HYPHEN-LINE. IF1254.2 +017900 02 FILLER PIC IS X VALUE IS SPACE. IF1254.2 +018000 02 FILLER PIC IS X(65) VALUE IS "************************IF1254.2 +018100- "*****************************************". IF1254.2 +018200 02 FILLER PIC IS X(54) VALUE IS "************************IF1254.2 +018300- "******************************". IF1254.2 +018400 01 CCVS-PGM-ID PIC X(9) VALUE IF1254.2 +018500 "IF125A". IF1254.2 +018600 PROCEDURE DIVISION. IF1254.2 +018700 CCVS1 SECTION. IF1254.2 +018800 OPEN-FILES. IF1254.2 +018900 OPEN OUTPUT PRINT-FILE. IF1254.2 +019000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1254.2 +019100 MOVE SPACE TO TEST-RESULTS. IF1254.2 +019200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1254.2 +019300 GO TO CCVS1-EXIT. IF1254.2 +019400 CLOSE-FILES. IF1254.2 +019500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1254.2 +019600 TERMINATE-CCVS. IF1254.2 +019700 STOP RUN. IF1254.2 +019800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1254.2 +019900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1254.2 +020000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1254.2 +020100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1254.2 +020200 MOVE "****TEST DELETED****" TO RE-MARK. IF1254.2 +020300 PRINT-DETAIL. IF1254.2 +020400 IF REC-CT NOT EQUAL TO ZERO IF1254.2 +020500 MOVE "." TO PARDOT-X IF1254.2 +020600 MOVE REC-CT TO DOTVALUE. IF1254.2 +020700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1254.2 +020800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1254.2 +020900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1254.2 +021000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1254.2 +021100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1254.2 +021200 MOVE SPACE TO CORRECT-X. IF1254.2 +021300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1254.2 +021400 MOVE SPACE TO RE-MARK. IF1254.2 +021500 HEAD-ROUTINE. IF1254.2 +021600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +021700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +021800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1254.2 +021900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1254.2 +022000 COLUMN-NAMES-ROUTINE. IF1254.2 +022100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +022200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +022300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +022400 END-ROUTINE. IF1254.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1254.2 +022600 END-RTN-EXIT. IF1254.2 +022700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +022800 END-ROUTINE-1. IF1254.2 +022900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1254.2 +023000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1254.2 +023100 ADD PASS-COUNTER TO ERROR-HOLD. IF1254.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1254.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1254.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1254.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1254.2 +023600 END-ROUTINE-12. IF1254.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1254.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1254.2 +023900 MOVE "NO " TO ERROR-TOTAL IF1254.2 +024000 ELSE IF1254.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1254.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1254.2 +024300 PERFORM WRITE-LINE. IF1254.2 +024400 END-ROUTINE-13. IF1254.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1254.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE IF1254.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1254.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1254.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO IF1254.2 +025100 MOVE "NO " TO ERROR-TOTAL IF1254.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1254.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1254.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025600 WRITE-LINE. IF1254.2 +025700 ADD 1 TO RECORD-COUNT. IF1254.2 +025800Y IF RECORD-COUNT GREATER 42 IF1254.2 +025900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1254.2 +026000Y MOVE SPACE TO DUMMY-RECORD IF1254.2 +026100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1254.2 +026200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1254.2 +026300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1254.2 +026400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1254.2 +026500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1254.2 +026600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1254.2 +027000Y MOVE ZERO TO RECORD-COUNT. IF1254.2 +027100 PERFORM WRT-LN. IF1254.2 +027200 WRT-LN. IF1254.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1254.2 +027400 MOVE SPACE TO DUMMY-RECORD. IF1254.2 +027500 BLANK-LINE-PRINT. IF1254.2 +027600 PERFORM WRT-LN. IF1254.2 +027700 FAIL-ROUTINE. IF1254.2 +027800 IF COMPUTED-X NOT EQUAL TO SPACE IF1254.2 +027900 GO TO FAIL-ROUTINE-WRITE. IF1254.2 +028000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1254.2 +028100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1254.2 +028200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1254.2 +028300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +028400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1254.2 +028500 GO TO FAIL-ROUTINE-EX. IF1254.2 +028600 FAIL-ROUTINE-WRITE. IF1254.2 +028700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1254.2 +028800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1254.2 +028900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1254.2 +029000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1254.2 +029100 FAIL-ROUTINE-EX. EXIT. IF1254.2 +029200 BAIL-OUT. IF1254.2 +029300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1254.2 +029400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1254.2 +029500 BAIL-OUT-WRITE. IF1254.2 +029600 MOVE CORRECT-A TO XXCORRECT. IF1254.2 +029700 MOVE COMPUTED-A TO XXCOMPUTED. IF1254.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1254.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1254.2 +030100 BAIL-OUT-EX. EXIT. IF1254.2 +030200 CCVS1-EXIT. IF1254.2 +030300 EXIT. IF1254.2 +030400******************************************************** IF1254.2 +030500* * IF1254.2 +030600* Intrinsic Function Tests IF125A - NUMVAL * IF1254.2 +030700* * IF1254.2 +030800******************************************************** IF1254.2 +030900 SECT-IF125A SECTION. IF1254.2 +031000 F-NUMVAL-INFO. IF1254.2 +031100 MOVE "See ref. A-58 2.29" TO ANSI-REFERENCE. IF1254.2 +031200 MOVE "NUMVAL Function" TO FEATURE. IF1254.2 +031300*****************TEST (a) ****************************** IF1254.2 +031400 F-NUMVAL-01. IF1254.2 +031500 MOVE ZERO TO TEMP. IF1254.2 +031600 F-NUMVAL-TEST-01. IF1254.2 +031700 COMPUTE TEMP = FUNCTION NUMVAL ("9"). IF1254.2 +031800 IF TEMP = 9 THEN IF1254.2 +031900 PERFORM PASS IF1254.2 +032000 ELSE IF1254.2 +032100 MOVE 9 TO CORRECT-N IF1254.2 +032200 MOVE TEMP TO COMPUTED-N IF1254.2 +032300 PERFORM FAIL. IF1254.2 +032400 GO TO F-NUMVAL-WRITE-01. IF1254.2 +032500 F-NUMVAL-DELETE-01. IF1254.2 +032600 PERFORM DE-LETE. IF1254.2 +032700 GO TO F-NUMVAL-WRITE-01. IF1254.2 +032800 F-NUMVAL-WRITE-01. IF1254.2 +032900 MOVE "F-NUMVAL-01" TO PAR-NAME. IF1254.2 +033000 PERFORM PRINT-DETAIL. IF1254.2 +033100*****************TEST (b) ****************************** IF1254.2 +033200 F-NUMVAL-02. IF1254.2 +033300 MOVE 77 TO TEMP. IF1254.2 +033400 F-NUMVAL-TEST-02. IF1254.2 +033500 EVALUATE FUNCTION NUMVAL ("4738") IF1254.2 +033600 ALSO ( TEMP + 96 ) * 2 IF1254.2 +033700 WHEN 4738 IF1254.2 +033800 ALSO 346 IF1254.2 +033900 PERFORM PASS IF1254.2 +034000 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034100 PERFORM FAIL. IF1254.2 +034200 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034300 F-NUMVAL-DELETE-02. IF1254.2 +034400 PERFORM DE-LETE. IF1254.2 +034500 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034600 F-NUMVAL-WRITE-02. IF1254.2 +034700 MOVE "F-NUMVAL-02" TO PAR-NAME. IF1254.2 +034800 PERFORM PRINT-DETAIL. IF1254.2 +034900*****************TEST (c) ****************************** IF1254.2 +035000 F-NUMVAL-TEST-03. IF1254.2 +035100 IF (FUNCTION NUMVAL (".935") >= 0.934981) AND IF1254.2 +035200 (FUNCTION NUMVAL (".935") <= 0.935019) IF1254.2 +035300 PERFORM PASS IF1254.2 +035400 ELSE IF1254.2 +035500 PERFORM FAIL. IF1254.2 +035600 GO TO F-NUMVAL-WRITE-03. IF1254.2 +035700 F-NUMVAL-DELETE-03. IF1254.2 +035800 PERFORM DE-LETE. IF1254.2 +035900 GO TO F-NUMVAL-WRITE-03. IF1254.2 +036000 F-NUMVAL-WRITE-03. IF1254.2 +036100 MOVE "F-NUMVAL-03" TO PAR-NAME. IF1254.2 +036200 PERFORM PRINT-DETAIL. IF1254.2 +036300*****************TEST (d) ****************************** IF1254.2 +036400 F-NUMVAL-04. IF1254.2 +036500 MOVE ZERO TO TEMP. IF1254.2 +036600 F-NUMVAL-TEST-04. IF1254.2 +036700 COMPUTE TEMP = FUNCTION NUMVAL ("385.93"). IF1254.2 +036800 IF (TEMP >= 385.922) AND IF1254.2 +036900 (TEMP <= 385.938) IF1254.2 +037000 PERFORM PASS IF1254.2 +037100 ELSE IF1254.2 +037200 MOVE 385.93 TO CORRECT-N IF1254.2 +037300 MOVE TEMP TO COMPUTED-N IF1254.2 +037400 PERFORM FAIL. IF1254.2 +037500 GO TO F-NUMVAL-WRITE-04. IF1254.2 +037600 F-NUMVAL-DELETE-04. IF1254.2 +037700 PERFORM DE-LETE. IF1254.2 +037800 GO TO F-NUMVAL-WRITE-04. IF1254.2 +037900 F-NUMVAL-WRITE-04. IF1254.2 +038000 MOVE "F-NUMVAL-04" TO PAR-NAME. IF1254.2 +038100 PERFORM PRINT-DETAIL. IF1254.2 +038200*****************TEST (e) ****************************** IF1254.2 +038300 F-NUMVAL-05. IF1254.2 +038400 MOVE ZERO TO TEMP. IF1254.2 +038500 F-NUMVAL-TEST-05. IF1254.2 +038600 COMPUTE TEMP = FUNCTION NUMVAL ("+394.2"). IF1254.2 +038700 IF (TEMP >= 394.192) AND IF1254.2 +038800 (TEMP <= 394.208) IF1254.2 +038900 PERFORM PASS IF1254.2 +039000 ELSE IF1254.2 +039100 MOVE 394.2 TO CORRECT-N IF1254.2 +039200 MOVE TEMP TO COMPUTED-N IF1254.2 +039300 PERFORM FAIL. IF1254.2 +039400 GO TO F-NUMVAL-WRITE-05. IF1254.2 +039500 F-NUMVAL-DELETE-05. IF1254.2 +039600 PERFORM DE-LETE. IF1254.2 +039700 GO TO F-NUMVAL-WRITE-05. IF1254.2 +039800 F-NUMVAL-WRITE-05. IF1254.2 +039900 MOVE "F-NUMVAL-05" TO PAR-NAME. IF1254.2 +040000 PERFORM PRINT-DETAIL. IF1254.2 +040100*****************TEST (f) ****************************** IF1254.2 +040200 F-NUMVAL-06. IF1254.2 +040300 MOVE ZERO TO TEMP. IF1254.2 +040400 F-NUMVAL-TEST-06. IF1254.2 +040500 COMPUTE TEMP = FUNCTION NUMVAL (" 939.83"). IF1254.2 +040600 IF (TEMP >= 939.811) AND IF1254.2 +040700 (TEMP <= 939.849) IF1254.2 +040800 PERFORM PASS IF1254.2 +040900 ELSE IF1254.2 +041000 MOVE 939.83 TO CORRECT-N IF1254.2 +041100 MOVE TEMP TO COMPUTED-N IF1254.2 +041200 PERFORM FAIL. IF1254.2 +041300 GO TO F-NUMVAL-WRITE-06. IF1254.2 +041400 F-NUMVAL-DELETE-06. IF1254.2 +041500 PERFORM DE-LETE. IF1254.2 +041600 GO TO F-NUMVAL-WRITE-06. IF1254.2 +041700 F-NUMVAL-WRITE-06. IF1254.2 +041800 MOVE "F-NUMVAL-06" TO PAR-NAME. IF1254.2 +041900 PERFORM PRINT-DETAIL. IF1254.2 +042000*****************TEST (g) ****************************** IF1254.2 +042100 F-NUMVAL-07. IF1254.2 +042200 MOVE ZERO TO TEMP. IF1254.2 +042300 F-NUMVAL-TEST-07. IF1254.2 +042400 COMPUTE TEMP = FUNCTION NUMVAL (" - 4929.0323"). IF1254.2 +042500 IF (TEMP >= -4929.1309) AND IF1254.2 +042600 (TEMP <= -4928.9337) IF1254.2 +042700 PERFORM PASS IF1254.2 +042800 ELSE IF1254.2 +042900 MOVE -4929.0323 TO CORRECT-N IF1254.2 +043000 MOVE TEMP TO COMPUTED-N IF1254.2 +043100 PERFORM FAIL. IF1254.2 +043200 GO TO F-NUMVAL-WRITE-07. IF1254.2 +043300 F-NUMVAL-DELETE-07. IF1254.2 +043400 PERFORM DE-LETE. IF1254.2 +043500 GO TO F-NUMVAL-WRITE-07. IF1254.2 +043600 F-NUMVAL-WRITE-07. IF1254.2 +043700 MOVE "F-NUMVAL-07" TO PAR-NAME. IF1254.2 +043800 PERFORM PRINT-DETAIL. IF1254.2 +043900*****************TEST (h) ****************************** IF1254.2 +044000 F-NUMVAL-08. IF1254.2 +044100 MOVE ZERO TO TEMP. IF1254.2 +044200 F-NUMVAL-TEST-08. IF1254.2 +044300 COMPUTE TEMP = FUNCTION NUMVAL ("82.9312+"). IF1254.2 +044400 IF (TEMP >= 82.9295) AND IF1254.2 +044500 (TEMP <= 82.9329) IF1254.2 +044600 PERFORM PASS IF1254.2 +044700 ELSE IF1254.2 +044800 MOVE 82.9312 TO CORRECT-N IF1254.2 +044900 MOVE TEMP TO COMPUTED-N IF1254.2 +045000 PERFORM FAIL. IF1254.2 +045100 GO TO F-NUMVAL-WRITE-08. IF1254.2 +045200 F-NUMVAL-DELETE-08. IF1254.2 +045300 PERFORM DE-LETE. IF1254.2 +045400 GO TO F-NUMVAL-WRITE-08. IF1254.2 +045500 F-NUMVAL-WRITE-08. IF1254.2 +045600 MOVE "F-NUMVAL-08" TO PAR-NAME. IF1254.2 +045700 PERFORM PRINT-DETAIL. IF1254.2 +045800*****************TEST (i) ****************************** IF1254.2 +045900 F-NUMVAL-09. IF1254.2 +046000 MOVE ZERO TO TEMP. IF1254.2 +046100 F-NUMVAL-TEST-09. IF1254.2 +046200 COMPUTE TEMP = FUNCTION NUMVAL (" 200.0002 - "). IF1254.2 +046300 IF (TEMP >= -200.0042) AND IF1254.2 +046400 (TEMP <= -199.9962) IF1254.2 +046500 PERFORM PASS IF1254.2 +046600 ELSE IF1254.2 +046700 MOVE -200.0002 TO CORRECT-N IF1254.2 +046800 MOVE TEMP TO COMPUTED-N IF1254.2 +046900 PERFORM FAIL. IF1254.2 +047000 GO TO F-NUMVAL-WRITE-09. IF1254.2 +047100 F-NUMVAL-DELETE-09. IF1254.2 +047200 PERFORM DE-LETE. IF1254.2 +047300 GO TO F-NUMVAL-WRITE-09. IF1254.2 +047400 F-NUMVAL-WRITE-09. IF1254.2 +047500 MOVE "F-NUMVAL-09" TO PAR-NAME. IF1254.2 +047600 PERFORM PRINT-DETAIL. IF1254.2 +047700*****************TEST (j) ****************************** IF1254.2 +047800 F-NUMVAL-10. IF1254.2 +047900 MOVE ZERO TO TEMP. IF1254.2 +048000 F-NUMVAL-TEST-10. IF1254.2 +048100 COMPUTE TEMP = FUNCTION NUMVAL (A). IF1254.2 +048200 IF TEMP = 4 THEN IF1254.2 +048300 PERFORM PASS IF1254.2 +048400 ELSE IF1254.2 +048500 MOVE 4 TO CORRECT-N IF1254.2 +048600 MOVE TEMP TO COMPUTED-N IF1254.2 +048700 PERFORM FAIL. IF1254.2 +048800 GO TO F-NUMVAL-WRITE-10. IF1254.2 +048900 F-NUMVAL-DELETE-10. IF1254.2 +049000 PERFORM DE-LETE. IF1254.2 +049100 GO TO F-NUMVAL-WRITE-10. IF1254.2 +049200 F-NUMVAL-WRITE-10. IF1254.2 +049300 MOVE "F-NUMVAL-10" TO PAR-NAME. IF1254.2 +049400 PERFORM PRINT-DETAIL. IF1254.2 +049500*****************TEST (k) ****************************** IF1254.2 +049600 F-NUMVAL-11. IF1254.2 +049700 MOVE ZERO TO TEMP. IF1254.2 +049800 F-NUMVAL-TEST-11. IF1254.2 +049900 COMPUTE TEMP = FUNCTION NUMVAL (B). IF1254.2 +050000 IF TEMP = 203 THEN IF1254.2 +050100 PERFORM PASS IF1254.2 +050200 ELSE IF1254.2 +050300 MOVE 203 TO CORRECT-N IF1254.2 +050400 MOVE TEMP TO COMPUTED-N IF1254.2 +050500 PERFORM FAIL. IF1254.2 +050600 GO TO F-NUMVAL-WRITE-11. IF1254.2 +050700 F-NUMVAL-DELETE-11. IF1254.2 +050800 PERFORM DE-LETE. IF1254.2 +050900 GO TO F-NUMVAL-WRITE-11. IF1254.2 +051000 F-NUMVAL-WRITE-11. IF1254.2 +051100 MOVE "F-NUMVAL-11" TO PAR-NAME. IF1254.2 +051200 PERFORM PRINT-DETAIL. IF1254.2 +051300*****************TEST (l) ****************************** IF1254.2 +051400 F-NUMVAL-12. IF1254.2 +051500 MOVE ZERO TO TEMP. IF1254.2 +051600 F-NUMVAL-TEST-12. IF1254.2 +051700 COMPUTE TEMP = FUNCTION NUMVAL (C). IF1254.2 +051800 IF (TEMP >= 0.428991) AND IF1254.2 +051900 (TEMP <= 0.429009) IF1254.2 +052000 PERFORM PASS IF1254.2 +052100 ELSE IF1254.2 +052200 MOVE 0.429 TO CORRECT-N IF1254.2 +052300 MOVE TEMP TO COMPUTED-N IF1254.2 +052400 PERFORM FAIL. IF1254.2 +052500 GO TO F-NUMVAL-WRITE-12. IF1254.2 +052600 F-NUMVAL-DELETE-12. IF1254.2 +052700 PERFORM DE-LETE. IF1254.2 +052800 GO TO F-NUMVAL-WRITE-12. IF1254.2 +052900 F-NUMVAL-WRITE-12. IF1254.2 +053000 MOVE "F-NUMVAL-12" TO PAR-NAME. IF1254.2 +053100 PERFORM PRINT-DETAIL. IF1254.2 +053200*****************TEST (m) ****************************** IF1254.2 +053300 F-NUMVAL-13. IF1254.2 +053400 MOVE ZERO TO TEMP. IF1254.2 +053500 F-NUMVAL-TEST-13. IF1254.2 +053600 COMPUTE TEMP = FUNCTION NUMVAL (D). IF1254.2 +053700 IF (TEMP >= 928.325) AND IF1254.2 +053800 (TEMP <= 928.363) IF1254.2 +053900 PERFORM PASS IF1254.2 +054000 ELSE IF1254.2 +054100 MOVE 928.344 TO CORRECT-N IF1254.2 +054200 MOVE TEMP TO COMPUTED-N IF1254.2 +054300 PERFORM FAIL. IF1254.2 +054400 GO TO F-NUMVAL-WRITE-13. IF1254.2 +054500 F-NUMVAL-DELETE-13. IF1254.2 +054600 PERFORM DE-LETE. IF1254.2 +054700 GO TO F-NUMVAL-WRITE-13. IF1254.2 +054800 F-NUMVAL-WRITE-13. IF1254.2 +054900 MOVE "F-NUMVAL-13" TO PAR-NAME. IF1254.2 +055000 PERFORM PRINT-DETAIL. IF1254.2 +055100*****************TEST (n) ****************************** IF1254.2 +055200 F-NUMVAL-14. IF1254.2 +055300 MOVE ZERO TO TEMP. IF1254.2 +055400 F-NUMVAL-TEST-14. IF1254.2 +055500 COMPUTE TEMP = FUNCTION NUMVAL (E). IF1254.2 +055600 IF (TEMP >= -42.3248) AND IF1254.2 +055700 (TEMP <= -42.3232) IF1254.2 +055800 PERFORM PASS IF1254.2 +055900 ELSE IF1254.2 +056000 MOVE -42.324 TO CORRECT-N IF1254.2 +056100 MOVE TEMP TO COMPUTED-N IF1254.2 +056200 PERFORM FAIL. IF1254.2 +056300 GO TO F-NUMVAL-WRITE-14. IF1254.2 +056400 F-NUMVAL-DELETE-14. IF1254.2 +056500 PERFORM DE-LETE. IF1254.2 +056600 GO TO F-NUMVAL-WRITE-14. IF1254.2 +056700 F-NUMVAL-WRITE-14. IF1254.2 +056800 MOVE "F-NUMVAL-14" TO PAR-NAME. IF1254.2 +056900 PERFORM PRINT-DETAIL. IF1254.2 +057000*****************TEST (o) ****************************** IF1254.2 +057100 F-NUMVAL-15. IF1254.2 +057200 MOVE ZERO TO TEMP. IF1254.2 +057300 F-NUMVAL-TEST-15. IF1254.2 +057400 COMPUTE TEMP = FUNCTION NUMVAL (F). IF1254.2 +057500 IF (TEMP >= 22.9995) AND IF1254.2 +057600 (TEMP <= 23.0005) IF1254.2 +057700 PERFORM PASS IF1254.2 +057800 ELSE IF1254.2 +057900 MOVE 23.0 TO CORRECT-N IF1254.2 +058000 MOVE TEMP TO COMPUTED-N IF1254.2 +058100 PERFORM FAIL. IF1254.2 +058200 GO TO F-NUMVAL-WRITE-15. IF1254.2 +058300 F-NUMVAL-DELETE-15. IF1254.2 +058400 PERFORM DE-LETE. IF1254.2 +058500 GO TO F-NUMVAL-WRITE-15. IF1254.2 +058600 F-NUMVAL-WRITE-15. IF1254.2 +058700 MOVE "F-NUMVAL-15" TO PAR-NAME. IF1254.2 +058800 PERFORM PRINT-DETAIL. IF1254.2 +058900*****************TEST (p) ****************************** IF1254.2 +059000 F-NUMVAL-16. IF1254.2 +059100 MOVE ZERO TO TEMP. IF1254.2 +059200 F-NUMVAL-TEST-16. IF1254.2 +059300 COMPUTE TEMP = FUNCTION NUMVAL (G). IF1254.2 +059400 IF (TEMP >= -92926.16) AND IF1254.2 +059500 (TEMP <= -92922.44) IF1254.2 +059600 PERFORM PASS IF1254.2 +059700 ELSE IF1254.2 +059800 MOVE -92924.3 TO CORRECT-N IF1254.2 +059900 MOVE TEMP TO COMPUTED-N IF1254.2 +060000 PERFORM FAIL. IF1254.2 +060100 GO TO F-NUMVAL-WRITE-16. IF1254.2 +060200 F-NUMVAL-DELETE-16. IF1254.2 +060300 PERFORM DE-LETE. IF1254.2 +060400 GO TO F-NUMVAL-WRITE-16. IF1254.2 +060500 F-NUMVAL-WRITE-16. IF1254.2 +060600 MOVE "F-NUMVAL-16" TO PAR-NAME. IF1254.2 +060700 PERFORM PRINT-DETAIL. IF1254.2 +060800*****************TEST (q) ****************************** IF1254.2 +060900 F-NUMVAL-17. IF1254.2 +061000 MOVE ZERO TO TEMP. IF1254.2 +061100 F-NUMVAL-TEST-17. IF1254.2 +061200 COMPUTE TEMP = FUNCTION NUMVAL (H). IF1254.2 +061300 IF (TEMP >= 93.2081) AND IF1254.2 +061400 (TEMP <= 93.2119) IF1254.2 +061500 PERFORM PASS IF1254.2 +061600 ELSE IF1254.2 +061700 MOVE 93.21 TO CORRECT-N IF1254.2 +061800 MOVE TEMP TO COMPUTED-N IF1254.2 +061900 PERFORM FAIL. IF1254.2 +062000 GO TO F-NUMVAL-WRITE-17. IF1254.2 +062100 F-NUMVAL-DELETE-17. IF1254.2 +062200 PERFORM DE-LETE. IF1254.2 +062300 GO TO F-NUMVAL-WRITE-17. IF1254.2 +062400 F-NUMVAL-WRITE-17. IF1254.2 +062500 MOVE "F-NUMVAL-17" TO PAR-NAME. IF1254.2 +062600 PERFORM PRINT-DETAIL. IF1254.2 +062700*****************TEST (r) ****************************** IF1254.2 +062800 F-NUMVAL-18. IF1254.2 +062900 MOVE ZERO TO TEMP. IF1254.2 +063000 F-NUMVAL-TEST-18. IF1254.2 +063100 COMPUTE TEMP = FUNCTION NUMVAL (I). IF1254.2 +063200 IF (TEMP >= -92.9219) AND IF1254.2 +063300 (TEMP <= -92.9181) IF1254.2 +063400 PERFORM PASS IF1254.2 +063500 ELSE IF1254.2 +063600 MOVE -92.92 TO CORRECT-N IF1254.2 +063700 MOVE TEMP TO COMPUTED-N IF1254.2 +063800 PERFORM FAIL. IF1254.2 +063900 GO TO F-NUMVAL-WRITE-18. IF1254.2 +064000 F-NUMVAL-DELETE-18. IF1254.2 +064100 PERFORM DE-LETE. IF1254.2 +064200 GO TO F-NUMVAL-WRITE-18. IF1254.2 +064300 F-NUMVAL-WRITE-18. IF1254.2 +064400 MOVE "F-NUMVAL-18" TO PAR-NAME. IF1254.2 +064500 PERFORM PRINT-DETAIL. IF1254.2 +064600*****************TEST (s) ****************************** IF1254.2 +064700 F-NUMVAL-19. IF1254.2 +064800 MOVE ZERO TO TEMP. IF1254.2 +064900 F-NUMVAL-TEST-19. IF1254.2 +065000 COMPUTE TEMP = (FUNCTION NUMVAL ("90") + 10). IF1254.2 +065100 IF TEMP = 100 THEN IF1254.2 +065200 PERFORM PASS IF1254.2 +065300 ELSE IF1254.2 +065400 MOVE 100 TO CORRECT-N IF1254.2 +065500 MOVE TEMP TO COMPUTED-N IF1254.2 +065600 PERFORM FAIL. IF1254.2 +065700 GO TO F-NUMVAL-WRITE-19. IF1254.2 +065800 F-NUMVAL-DELETE-19. IF1254.2 +065900 PERFORM DE-LETE. IF1254.2 +066000 GO TO F-NUMVAL-WRITE-19. IF1254.2 +066100 F-NUMVAL-WRITE-19. IF1254.2 +066200 MOVE "F-NUMVAL-19" TO PAR-NAME. IF1254.2 +066300 PERFORM PRINT-DETAIL. IF1254.2 +066400*****************TEST (t) ****************************** IF1254.2 +066500 F-NUMVAL-20. IF1254.2 +066600 MOVE ZERO TO TEMP. IF1254.2 +066700 F-NUMVAL-TEST-20. IF1254.2 +066800 COMPUTE TEMP = (FUNCTION NUMVAL ("2") + IF1254.2 +066900 FUNCTION NUMVAL ("8") ). IF1254.2 +067000 IF TEMP = 10 THEN IF1254.2 +067100 PERFORM PASS IF1254.2 +067200 ELSE IF1254.2 +067300 MOVE 10 TO CORRECT-N IF1254.2 +067400 MOVE TEMP TO COMPUTED-N IF1254.2 +067500 PERFORM FAIL. IF1254.2 +067600 GO TO F-NUMVAL-WRITE-20. IF1254.2 +067700 F-NUMVAL-DELETE-20. IF1254.2 +067800 PERFORM DE-LETE. IF1254.2 +067900 GO TO F-NUMVAL-WRITE-20. IF1254.2 +068000 F-NUMVAL-WRITE-20. IF1254.2 +068100 MOVE "F-NUMVAL-20" TO PAR-NAME. IF1254.2 +068200 PERFORM PRINT-DETAIL. IF1254.2 +068300*******************END OF TESTS************************** IF1254.2 +068400 CCVS-EXIT SECTION. IF1254.2 +068500 CCVS-999999. IF1254.2 +068600 GO TO CLOSE-FILES. IF1254.2 +*END-OF,IF125A +*HEADER,COBOL,IF126A +000100 IDENTIFICATION DIVISION. IF1264.2 +000200 PROGRAM-ID. IF1264.2 +000300 IF126A. IF1264.2 +000400 IF1264.2 +000500*********************************************************** IF1264.2 +000600* * IF1264.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1264.2 +000800* It contains tests for the Intrinsic Function * IF1264.2 +000900* NUMVAL-C. * IF1264.2 +001000* * IF1264.2 +001100* * IF1264.2 +001200*********************************************************** IF1264.2 +001300 ENVIRONMENT DIVISION. IF1264.2 +001400 CONFIGURATION SECTION. IF1264.2 +001500 SOURCE-COMPUTER. IF1264.2 +001600 XXXXX082. IF1264.2 +001700 OBJECT-COMPUTER. IF1264.2 +001800 XXXXX083. IF1264.2 +001900 INPUT-OUTPUT SECTION. IF1264.2 +002000 FILE-CONTROL. IF1264.2 +002100 SELECT PRINT-FILE ASSIGN TO IF1264.2 +002200 XXXXX055. IF1264.2 +002300 DATA DIVISION. IF1264.2 +002400 FILE SECTION. IF1264.2 +002500 FD PRINT-FILE. IF1264.2 +002600 01 PRINT-REC PICTURE X(120). IF1264.2 +002700 01 DUMMY-RECORD PICTURE X(120). IF1264.2 +002800 WORKING-STORAGE SECTION. IF1264.2 +002900*********************************************************** IF1264.2 +003000* Variables specific to the Intrinsic Function Test IF126A* IF1264.2 +003100*********************************************************** IF1264.2 +003200 01 A PIC X(1) VALUE "4". IF1264.2 +003300 01 B PIC X(5) VALUE "203". IF1264.2 +003400 01 C PIC X(4) VALUE ".429". IF1264.2 +003500 01 D PIC X(7) VALUE "928.344". IF1264.2 +003600 01 E PIC X(9) VALUE "-042.3240". IF1264.2 +003700 01 F PIC X(7) VALUE " 23.000". IF1264.2 +003800 01 G PIC X(8) VALUE "-92924.3". IF1264.2 +003900 01 H PIC X(6) VALUE "93.21+". IF1264.2 +004000 01 I PIC X(9) VALUE " 92.92 -". IF1264.2 +004100 01 J PIC X(9) VALUE "8,848.934". IF1264.2 +004200 01 K PIC X(12) VALUE "4,825,293.92". IF1264.2 +004300 01 L PIC X(12) VALUE " - 5,555.55 ". IF1264.2 +004400 01 M PIC X(9) VALUE "5,555.55-". IF1264.2 +004500 01 N PIC X(13) VALUE " 77,777.77 + ". IF1264.2 +004600 01 O PIC X(3) VALUE "$33". IF1264.2 +004700 01 P PIC X(5) VALUE "$0.11". IF1264.2 +004800 01 Q PIC X(9) VALUE "$4,000.00". IF1264.2 +004900 01 R PIC X(14) VALUE "$1,000,000.50". IF1264.2 +005000 01 S PIC X(14) VALUE " $ 3,900.21". IF1264.2 +005100 01 T PIC X(14) VALUE " + $ 9,000.99". IF1264.2 +005200 01 U PIC X(15) VALUE " $ 3,890.20 + ". IF1264.2 +005300 01 TEMP PIC S9(7)V9(5). IF1264.2 +005400 IF1264.2 +005500* IF1264.2 +005600********************************************************** IF1264.2 +005700* IF1264.2 +005800 01 TEST-RESULTS. IF1264.2 +005900 02 FILLER PIC X VALUE SPACE. IF1264.2 +006000 02 FEATURE PIC X(20) VALUE SPACE. IF1264.2 +006100 02 FILLER PIC X VALUE SPACE. IF1264.2 +006200 02 P-OR-F PIC X(5) VALUE SPACE. IF1264.2 +006300 02 FILLER PIC X VALUE SPACE. IF1264.2 +006400 02 PAR-NAME. IF1264.2 +006500 03 FILLER PIC X(19) VALUE SPACE. IF1264.2 +006600 03 PARDOT-X PIC X VALUE SPACE. IF1264.2 +006700 03 DOTVALUE PIC 99 VALUE ZERO. IF1264.2 +006800 02 FILLER PIC X(8) VALUE SPACE. IF1264.2 +006900 02 RE-MARK PIC X(61). IF1264.2 +007000 01 TEST-COMPUTED. IF1264.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1264.2 +007200 02 FILLER PIC X(17) VALUE IF1264.2 +007300 " COMPUTED=". IF1264.2 +007400 02 COMPUTED-X. IF1264.2 +007500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1264.2 +007600 03 COMPUTED-N REDEFINES COMPUTED-A IF1264.2 +007700 PIC -9(9).9(9). IF1264.2 +007800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1264.2 +007900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1264.2 +008000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1264.2 +008100 03 CM-18V0 REDEFINES COMPUTED-A. IF1264.2 +008200 04 COMPUTED-18V0 PIC -9(18). IF1264.2 +008300 04 FILLER PIC X. IF1264.2 +008400 03 FILLER PIC X(50) VALUE SPACE. IF1264.2 +008500 01 TEST-CORRECT. IF1264.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1264.2 +008700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1264.2 +008800 02 CORRECT-X. IF1264.2 +008900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1264.2 +009000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1264.2 +009100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1264.2 +009200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1264.2 +009300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1264.2 +009400 03 CR-18V0 REDEFINES CORRECT-A. IF1264.2 +009500 04 CORRECT-18V0 PIC -9(18). IF1264.2 +009600 04 FILLER PIC X. IF1264.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1264.2 +009800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1264.2 +009900 01 CCVS-C-1. IF1264.2 +010000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1264.2 +010100- "SS PARAGRAPH-NAME IF1264.2 +010200- " REMARKS". IF1264.2 +010300 02 FILLER PIC X(20) VALUE SPACE. IF1264.2 +010400 01 CCVS-C-2. IF1264.2 +010500 02 FILLER PIC X VALUE SPACE. IF1264.2 +010600 02 FILLER PIC X(6) VALUE "TESTED". IF1264.2 +010700 02 FILLER PIC X(15) VALUE SPACE. IF1264.2 +010800 02 FILLER PIC X(4) VALUE "FAIL". IF1264.2 +010900 02 FILLER PIC X(94) VALUE SPACE. IF1264.2 +011000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1264.2 +011100 01 REC-CT PIC 99 VALUE ZERO. IF1264.2 +011200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011500 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1264.2 +011700 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1264.2 +011800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1264.2 +011900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1264.2 +012000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1264.2 +012100 01 CCVS-H-1. IF1264.2 +012200 02 FILLER PIC X(39) VALUE SPACES. IF1264.2 +012300 02 FILLER PIC X(42) VALUE IF1264.2 +012400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1264.2 +012500 02 FILLER PIC X(39) VALUE SPACES. IF1264.2 +012600 01 CCVS-H-2A. IF1264.2 +012700 02 FILLER PIC X(40) VALUE SPACE. IF1264.2 +012800 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1264.2 +012900 02 FILLER PIC XXXX VALUE IF1264.2 +013000 "4.2 ". IF1264.2 +013100 02 FILLER PIC X(28) VALUE IF1264.2 +013200 " COPY - NOT FOR DISTRIBUTION". IF1264.2 +013300 02 FILLER PIC X(41) VALUE SPACE. IF1264.2 +013400 IF1264.2 +013500 01 CCVS-H-2B. IF1264.2 +013600 02 FILLER PIC X(15) VALUE IF1264.2 +013700 "TEST RESULT OF ". IF1264.2 +013800 02 TEST-ID PIC X(9). IF1264.2 +013900 02 FILLER PIC X(4) VALUE IF1264.2 +014000 " IN ". IF1264.2 +014100 02 FILLER PIC X(12) VALUE IF1264.2 +014200 " HIGH ". IF1264.2 +014300 02 FILLER PIC X(22) VALUE IF1264.2 +014400 " LEVEL VALIDATION FOR ". IF1264.2 +014500 02 FILLER PIC X(58) VALUE IF1264.2 +014600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1264.2 +014700 01 CCVS-H-3. IF1264.2 +014800 02 FILLER PIC X(34) VALUE IF1264.2 +014900 " FOR OFFICIAL USE ONLY ". IF1264.2 +015000 02 FILLER PIC X(58) VALUE IF1264.2 +015100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1264.2 +015200 02 FILLER PIC X(28) VALUE IF1264.2 +015300 " COPYRIGHT 1985 ". IF1264.2 +015400 01 CCVS-E-1. IF1264.2 +015500 02 FILLER PIC X(52) VALUE SPACE. IF1264.2 +015600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1264.2 +015700 02 ID-AGAIN PIC X(9). IF1264.2 +015800 02 FILLER PIC X(45) VALUE SPACES. IF1264.2 +015900 01 CCVS-E-2. IF1264.2 +016000 02 FILLER PIC X(31) VALUE SPACE. IF1264.2 +016100 02 FILLER PIC X(21) VALUE SPACE. IF1264.2 +016200 02 CCVS-E-2-2. IF1264.2 +016300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1264.2 +016400 03 FILLER PIC X VALUE SPACE. IF1264.2 +016500 03 ENDER-DESC PIC X(44) VALUE IF1264.2 +016600 "ERRORS ENCOUNTERED". IF1264.2 +016700 01 CCVS-E-3. IF1264.2 +016800 02 FILLER PIC X(22) VALUE IF1264.2 +016900 " FOR OFFICIAL USE ONLY". IF1264.2 +017000 02 FILLER PIC X(12) VALUE SPACE. IF1264.2 +017100 02 FILLER PIC X(58) VALUE IF1264.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1264.2 +017300 02 FILLER PIC X(13) VALUE SPACE. IF1264.2 +017400 02 FILLER PIC X(15) VALUE IF1264.2 +017500 " COPYRIGHT 1985". IF1264.2 +017600 01 CCVS-E-4. IF1264.2 +017700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1264.2 +017800 02 FILLER PIC X(4) VALUE " OF ". IF1264.2 +017900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1264.2 +018000 02 FILLER PIC X(40) VALUE IF1264.2 +018100 " TESTS WERE EXECUTED SUCCESSFULLY". IF1264.2 +018200 01 XXINFO. IF1264.2 +018300 02 FILLER PIC X(19) VALUE IF1264.2 +018400 "*** INFORMATION ***". IF1264.2 +018500 02 INFO-TEXT. IF1264.2 +018600 04 FILLER PIC X(8) VALUE SPACE. IF1264.2 +018700 04 XXCOMPUTED PIC X(20). IF1264.2 +018800 04 FILLER PIC X(5) VALUE SPACE. IF1264.2 +018900 04 XXCORRECT PIC X(20). IF1264.2 +019000 02 INF-ANSI-REFERENCE PIC X(48). IF1264.2 +019100 01 HYPHEN-LINE. IF1264.2 +019200 02 FILLER PIC IS X VALUE IS SPACE. IF1264.2 +019300 02 FILLER PIC IS X(65) VALUE IS "************************IF1264.2 +019400- "*****************************************". IF1264.2 +019500 02 FILLER PIC IS X(54) VALUE IS "************************IF1264.2 +019600- "******************************". IF1264.2 +019700 01 CCVS-PGM-ID PIC X(9) VALUE IF1264.2 +019800 "IF126A". IF1264.2 +019900 PROCEDURE DIVISION. IF1264.2 +020000 CCVS1 SECTION. IF1264.2 +020100 OPEN-FILES. IF1264.2 +020200 OPEN OUTPUT PRINT-FILE. IF1264.2 +020300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1264.2 +020400 MOVE SPACE TO TEST-RESULTS. IF1264.2 +020500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1264.2 +020600 GO TO CCVS1-EXIT. IF1264.2 +020700 CLOSE-FILES. IF1264.2 +020800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1264.2 +020900 TERMINATE-CCVS. IF1264.2 +021000 STOP RUN. IF1264.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1264.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1264.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1264.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1264.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IF1264.2 +021600 PRINT-DETAIL. IF1264.2 +021700 IF REC-CT NOT EQUAL TO ZERO IF1264.2 +021800 MOVE "." TO PARDOT-X IF1264.2 +021900 MOVE REC-CT TO DOTVALUE. IF1264.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1264.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1264.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1264.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1264.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1264.2 +022500 MOVE SPACE TO CORRECT-X. IF1264.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1264.2 +022700 MOVE SPACE TO RE-MARK. IF1264.2 +022800 HEAD-ROUTINE. IF1264.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1264.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1264.2 +023300 COLUMN-NAMES-ROUTINE. IF1264.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +023700 END-ROUTINE. IF1264.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1264.2 +023900 END-RTN-EXIT. IF1264.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +024100 END-ROUTINE-1. IF1264.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1264.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1264.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IF1264.2 +024500 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1264.2 +024600 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1264.2 +024700 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1264.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1264.2 +024900 END-ROUTINE-12. IF1264.2 +025000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1264.2 +025100 IF ERROR-COUNTER IS EQUAL TO ZERO IF1264.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1264.2 +025300 ELSE IF1264.2 +025400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1264.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1264.2 +025600 PERFORM WRITE-LINE. IF1264.2 +025700 END-ROUTINE-13. IF1264.2 +025800 IF DELETE-COUNTER IS EQUAL TO ZERO IF1264.2 +025900 MOVE "NO " TO ERROR-TOTAL ELSE IF1264.2 +026000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1264.2 +026100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1264.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026300 IF INSPECT-COUNTER EQUAL TO ZERO IF1264.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1264.2 +026500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1264.2 +026600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1264.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026900 WRITE-LINE. IF1264.2 +027000 ADD 1 TO RECORD-COUNT. IF1264.2 +027100Y IF RECORD-COUNT GREATER 42 IF1264.2 +027200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1264.2 +027300Y MOVE SPACE TO DUMMY-RECORD IF1264.2 +027400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1264.2 +027500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1264.2 +027600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1264.2 +027700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1264.2 +027800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1264.2 +027900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1264.2 +028300Y MOVE ZERO TO RECORD-COUNT. IF1264.2 +028400 PERFORM WRT-LN. IF1264.2 +028500 WRT-LN. IF1264.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1264.2 +028700 MOVE SPACE TO DUMMY-RECORD. IF1264.2 +028800 BLANK-LINE-PRINT. IF1264.2 +028900 PERFORM WRT-LN. IF1264.2 +029000 FAIL-ROUTINE. IF1264.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE IF1264.2 +029200 GO TO FAIL-ROUTINE-WRITE. IF1264.2 +029300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1264.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1264.2 +029500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1264.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1264.2 +029800 GO TO FAIL-ROUTINE-EX. IF1264.2 +029900 FAIL-ROUTINE-WRITE. IF1264.2 +030000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1264.2 +030100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1264.2 +030200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1264.2 +030300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1264.2 +030400 FAIL-ROUTINE-EX. EXIT. IF1264.2 +030500 BAIL-OUT. IF1264.2 +030600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1264.2 +030700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1264.2 +030800 BAIL-OUT-WRITE. IF1264.2 +030900 MOVE CORRECT-A TO XXCORRECT. IF1264.2 +031000 MOVE COMPUTED-A TO XXCOMPUTED. IF1264.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1264.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1264.2 +031400 BAIL-OUT-EX. EXIT. IF1264.2 +031500 CCVS1-EXIT. IF1264.2 +031600 EXIT. IF1264.2 +031700******************************************************** IF1264.2 +031800* * IF1264.2 +031900* Intrinsic Function Tests IF126A - NUMVAL-C * IF1264.2 +032000* * IF1264.2 +032100******************************************************** IF1264.2 +032200 SECT-IF126A SECTION. IF1264.2 +032300 F-NUMVALC-INFO. IF1264.2 +032400 MOVE "See ref. A-59 2.30" TO ANSI-REFERENCE. IF1264.2 +032500 MOVE "NUMVAL-C Function" TO FEATURE. IF1264.2 +032600*****************TEST (a) ****************************** IF1264.2 +032700 F-NUMVALC-01. IF1264.2 +032800 MOVE ZERO TO TEMP. IF1264.2 +032900 F-NUMVALC-TEST-01. IF1264.2 +033000 COMPUTE TEMP = FUNCTION NUMVAL-C ("9"). IF1264.2 +033100 IF TEMP = 9 THEN IF1264.2 +033200 PERFORM PASS IF1264.2 +033300 ELSE IF1264.2 +033400 MOVE 9 TO CORRECT-N IF1264.2 +033500 MOVE TEMP TO COMPUTED-N IF1264.2 +033600 PERFORM FAIL. IF1264.2 +033700 GO TO F-NUMVALC-WRITE-01. IF1264.2 +033800 F-NUMVALC-DELETE-01. IF1264.2 +033900 PERFORM DE-LETE. IF1264.2 +034000 GO TO F-NUMVALC-WRITE-01. IF1264.2 +034100 F-NUMVALC-WRITE-01. IF1264.2 +034200 MOVE "F-NUMVALC-01" TO PAR-NAME. IF1264.2 +034300 PERFORM PRINT-DETAIL. IF1264.2 +034400*****************TEST (b) ******************************* IF1264.2 +034500 F-NUMVALC-02. IF1264.2 +034600 MOVE 77 TO TEMP. IF1264.2 +034700 F-NUMVALC-TEST-02. IF1264.2 +034800 EVALUATE FUNCTION NUMVAL-C (B) IF1264.2 +034900 ALSO ( TEMP + 96 ) * 2 IF1264.2 +035000 WHEN 203 IF1264.2 +035100 ALSO 346 IF1264.2 +035200 PERFORM PASS IF1264.2 +035300 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035400 PERFORM FAIL. IF1264.2 +035500 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035600 F-NUMVALC-DELETE-02. IF1264.2 +035700 PERFORM DE-LETE. IF1264.2 +035800 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035900 F-NUMVALC-WRITE-02. IF1264.2 +036000 MOVE "F-NUMVALC-02" TO PAR-NAME. IF1264.2 +036100 PERFORM PRINT-DETAIL. IF1264.2 +036200*****************TEST (c) ****************************** IF1264.2 +036300 F-NUMVALC-TEST-03. IF1264.2 +036400 IF FUNCTION NUMVAL-C ("92,483") = 92483 THEN IF1264.2 +036500 PERFORM PASS IF1264.2 +036600 ELSE IF1264.2 +036700 PERFORM FAIL. IF1264.2 +036800 GO TO F-NUMVALC-WRITE-03. IF1264.2 +036900 F-NUMVALC-DELETE-03. IF1264.2 +037000 PERFORM DE-LETE. IF1264.2 +037100 GO TO F-NUMVALC-WRITE-03. IF1264.2 +037200 F-NUMVALC-WRITE-03. IF1264.2 +037300 MOVE "F-NUMVALC-03" TO PAR-NAME. IF1264.2 +037400 PERFORM PRINT-DETAIL. IF1264.2 +037500*****************TEST (d) ****************************** IF1264.2 +037600 F-NUMVALC-04. IF1264.2 +037700 MOVE ZERO TO TEMP. IF1264.2 +037800 F-NUMVALC-TEST-04. IF1264.2 +037900 COMPUTE TEMP = FUNCTION NUMVAL-C (C). IF1264.2 +038000 IF (TEMP >= 0.428991) AND IF1264.2 +038100 (TEMP <= 0.429009) IF1264.2 +038200 PERFORM PASS IF1264.2 +038300 ELSE IF1264.2 +038400 MOVE 0.429 TO CORRECT-N IF1264.2 +038500 MOVE TEMP TO COMPUTED-N IF1264.2 +038600 PERFORM FAIL. IF1264.2 +038700 GO TO F-NUMVALC-WRITE-04. IF1264.2 +038800 F-NUMVALC-DELETE-04. IF1264.2 +038900 PERFORM DE-LETE. IF1264.2 +039000 GO TO F-NUMVALC-WRITE-04. IF1264.2 +039100 F-NUMVALC-WRITE-04. IF1264.2 +039200 MOVE "F-NUMVALC-04" TO PAR-NAME. IF1264.2 +039300 PERFORM PRINT-DETAIL. IF1264.2 +039400*****************TEST (e) ****************************** IF1264.2 +039500 F-NUMVALC-05. IF1264.2 +039600 MOVE ZERO TO TEMP. IF1264.2 +039700 F-NUMVALC-TEST-05. IF1264.2 +039800 COMPUTE TEMP = FUNCTION NUMVAL-C ("385.93"). IF1264.2 +039900 IF (TEMP >= 385.922) AND IF1264.2 +040000 (TEMP <= 385.938) IF1264.2 +040100 PERFORM PASS IF1264.2 +040200 ELSE IF1264.2 +040300 MOVE 385.93 TO CORRECT-N IF1264.2 +040400 MOVE TEMP TO COMPUTED-N IF1264.2 +040500 PERFORM FAIL. IF1264.2 +040600 GO TO F-NUMVALC-WRITE-05. IF1264.2 +040700 F-NUMVALC-DELETE-05. IF1264.2 +040800 PERFORM DE-LETE. IF1264.2 +040900 GO TO F-NUMVALC-WRITE-05. IF1264.2 +041000 F-NUMVALC-WRITE-05. IF1264.2 +041100 MOVE "F-NUMVALC-05" TO PAR-NAME. IF1264.2 +041200 PERFORM PRINT-DETAIL. IF1264.2 +041300*****************TEST (f) ****************************** IF1264.2 +041400 F-NUMVALC-06. IF1264.2 +041500 MOVE ZERO TO TEMP. IF1264.2 +041600 F-NUMVALC-TEST-06. IF1264.2 +041700 COMPUTE TEMP = FUNCTION NUMVAL-C (J). IF1264.2 +041800 IF (TEMP >= 8848.76) AND IF1264.2 +041900 (TEMP <= 8849.11) IF1264.2 +042000 PERFORM PASS IF1264.2 +042100 ELSE IF1264.2 +042200 MOVE 8848.934 TO CORRECT-N IF1264.2 +042300 MOVE TEMP TO COMPUTED-N IF1264.2 +042400 PERFORM FAIL. IF1264.2 +042500 GO TO F-NUMVALC-WRITE-06. IF1264.2 +042600 F-NUMVALC-DELETE-06. IF1264.2 +042700 PERFORM DE-LETE. IF1264.2 +042800 GO TO F-NUMVALC-WRITE-06. IF1264.2 +042900 F-NUMVALC-WRITE-06. IF1264.2 +043000 MOVE "F-NUMVALC-06" TO PAR-NAME. IF1264.2 +043100 PERFORM PRINT-DETAIL. IF1264.2 +043200*****************TEST (g) ****************************** IF1264.2 +043300 F-NUMVALC-07. IF1264.2 +043400 MOVE ZERO TO TEMP. IF1264.2 +043500 F-NUMVALC-TEST-07. IF1264.2 +043600 COMPUTE TEMP = FUNCTION NUMVAL-C ("+394.2 "). IF1264.2 +043700 IF (TEMP >= 394.192) AND IF1264.2 +043800 (TEMP <= 394.208) IF1264.2 +043900 PERFORM PASS IF1264.2 +044000 ELSE IF1264.2 +044100 MOVE 394.2 TO CORRECT-N IF1264.2 +044200 MOVE TEMP TO COMPUTED-N IF1264.2 +044300 PERFORM FAIL. IF1264.2 +044400 GO TO F-NUMVALC-WRITE-07. IF1264.2 +044500 F-NUMVALC-DELETE-07. IF1264.2 +044600 PERFORM DE-LETE. IF1264.2 +044700 GO TO F-NUMVALC-WRITE-07. IF1264.2 +044800 F-NUMVALC-WRITE-07. IF1264.2 +044900 MOVE "F-NUMVALC-07" TO PAR-NAME. IF1264.2 +045000 PERFORM PRINT-DETAIL. IF1264.2 +045100*****************TEST (h) ****************************** IF1264.2 +045200 F-NUMVALC-08. IF1264.2 +045300 MOVE ZERO TO TEMP. IF1264.2 +045400 F-NUMVALC-TEST-08. IF1264.2 +045500 COMPUTE TEMP = FUNCTION NUMVAL-C (" 939.83"). IF1264.2 +045600 IF (TEMP >= 939.811) AND IF1264.2 +045700 (TEMP <= 939.849) IF1264.2 +045800 PERFORM PASS IF1264.2 +045900 ELSE IF1264.2 +046000 MOVE 939.83 TO CORRECT-N IF1264.2 +046100 MOVE TEMP TO COMPUTED-N IF1264.2 +046200 PERFORM FAIL. IF1264.2 +046300 GO TO F-NUMVALC-WRITE-08. IF1264.2 +046400 F-NUMVALC-DELETE-08. IF1264.2 +046500 PERFORM DE-LETE. IF1264.2 +046600 GO TO F-NUMVALC-WRITE-08. IF1264.2 +046700 F-NUMVALC-WRITE-08. IF1264.2 +046800 MOVE "F-NUMVALC-08" TO PAR-NAME. IF1264.2 +046900 PERFORM PRINT-DETAIL. IF1264.2 +047000*****************TEST (i) ****************************** IF1264.2 +047100 F-NUMVALC-09. IF1264.2 +047200 MOVE ZERO TO TEMP. IF1264.2 +047300 F-NUMVALC-TEST-09. IF1264.2 +047400 COMPUTE TEMP = FUNCTION NUMVAL-C (" - 4929.0323"). IF1264.2 +047500 IF (TEMP >= -4929.1309) AND IF1264.2 +047600 (TEMP <= -4928.9337) IF1264.2 +047700 PERFORM PASS IF1264.2 +047800 ELSE IF1264.2 +047900 MOVE -4929.0323 TO CORRECT-N IF1264.2 +048000 MOVE TEMP TO COMPUTED-N IF1264.2 +048100 PERFORM FAIL. IF1264.2 +048200 GO TO F-NUMVALC-WRITE-09. IF1264.2 +048300 F-NUMVALC-DELETE-09. IF1264.2 +048400 PERFORM DE-LETE. IF1264.2 +048500 GO TO F-NUMVALC-WRITE-09. IF1264.2 +048600 F-NUMVALC-WRITE-09. IF1264.2 +048700 MOVE "F-NUMVALC-09" TO PAR-NAME. IF1264.2 +048800 PERFORM PRINT-DETAIL. IF1264.2 +048900*****************TEST (j) ****************************** IF1264.2 +049000 F-NUMVALC-10. IF1264.2 +049100 MOVE ZERO TO TEMP. IF1264.2 +049200 F-NUMVALC-TEST-10. IF1264.2 +049300 COMPUTE TEMP = FUNCTION NUMVAL-C (K). IF1264.2 +049400 IF (TEMP >= 4825197.41) AND IF1264.2 +049500 (TEMP <= 4825390.43) IF1264.2 +049600 PERFORM PASS IF1264.2 +049700 ELSE IF1264.2 +049800 MOVE 4825293.92 TO CORRECT-N IF1264.2 +049900 MOVE TEMP TO COMPUTED-N IF1264.2 +050000 PERFORM FAIL. IF1264.2 +050100 GO TO F-NUMVALC-WRITE-10. IF1264.2 +050200 F-NUMVALC-DELETE-10. IF1264.2 +050300 PERFORM DE-LETE. IF1264.2 +050400 GO TO F-NUMVALC-WRITE-10. IF1264.2 +050500 F-NUMVALC-WRITE-10. IF1264.2 +050600 MOVE "F-NUMVALC-10" TO PAR-NAME. IF1264.2 +050700 PERFORM PRINT-DETAIL. IF1264.2 +050800*****************TEST (k) ****************************** IF1264.2 +050900 F-NUMVALC-11. IF1264.2 +051000 MOVE ZERO TO TEMP. IF1264.2 +051100 F-NUMVALC-TEST-11. IF1264.2 +051200 COMPUTE TEMP = FUNCTION NUMVAL-C (L). IF1264.2 +051300 IF (TEMP >= -5555.66) AND IF1264.2 +051400 (TEMP <= -5555.44) IF1264.2 +051500 PERFORM PASS IF1264.2 +051600 ELSE IF1264.2 +051700 MOVE -5555.55 TO CORRECT-N IF1264.2 +051800 MOVE TEMP TO COMPUTED-N IF1264.2 +051900 PERFORM FAIL. IF1264.2 +052000 GO TO F-NUMVALC-WRITE-11. IF1264.2 +052100 F-NUMVALC-DELETE-11. IF1264.2 +052200 PERFORM DE-LETE. IF1264.2 +052300 GO TO F-NUMVALC-WRITE-11. IF1264.2 +052400 F-NUMVALC-WRITE-11. IF1264.2 +052500 MOVE "F-NUMVALC-11" TO PAR-NAME. IF1264.2 +052600 PERFORM PRINT-DETAIL. IF1264.2 +052700*****************TEST (l) ****************************** IF1264.2 +052800 F-NUMVALC-12. IF1264.2 +052900 MOVE ZERO TO TEMP. IF1264.2 +053000 F-NUMVALC-TEST-12. IF1264.2 +053100 COMPUTE TEMP = FUNCTION NUMVAL-C ("82.9312+"). IF1264.2 +053200 IF (TEMP >= 82.9295) AND IF1264.2 +053300 (TEMP <= 82.9329) IF1264.2 +053400 PERFORM PASS IF1264.2 +053500 ELSE IF1264.2 +053600 MOVE 82.9312 TO CORRECT-N IF1264.2 +053700 MOVE TEMP TO COMPUTED-N IF1264.2 +053800 PERFORM FAIL. IF1264.2 +053900 GO TO F-NUMVALC-WRITE-12. IF1264.2 +054000 F-NUMVALC-DELETE-12. IF1264.2 +054100 PERFORM DE-LETE. IF1264.2 +054200 GO TO F-NUMVALC-WRITE-12. IF1264.2 +054300 F-NUMVALC-WRITE-12. IF1264.2 +054400 MOVE "F-NUMVALC-12" TO PAR-NAME. IF1264.2 +054500 PERFORM PRINT-DETAIL. IF1264.2 +054600*****************TEST (m) ****************************** IF1264.2 +054700 F-NUMVALC-13. IF1264.2 +054800 MOVE ZERO TO TEMP. IF1264.2 +054900 F-NUMVALC-TEST-13. IF1264.2 +055000 COMPUTE TEMP = FUNCTION NUMVAL-C (M). IF1264.2 +055100 IF (TEMP >= -5555.66) AND IF1264.2 +055200 (TEMP <= -5555.44) IF1264.2 +055300 PERFORM PASS IF1264.2 +055400 ELSE IF1264.2 +055500 MOVE -5555.55 TO CORRECT-N IF1264.2 +055600 MOVE TEMP TO COMPUTED-N IF1264.2 +055700 PERFORM FAIL. IF1264.2 +055800 GO TO F-NUMVALC-WRITE-13. IF1264.2 +055900 F-NUMVALC-DELETE-13. IF1264.2 +056000 PERFORM DE-LETE. IF1264.2 +056100 GO TO F-NUMVALC-WRITE-13. IF1264.2 +056200 F-NUMVALC-WRITE-13. IF1264.2 +056300 MOVE "F-NUMVALC-13" TO PAR-NAME. IF1264.2 +056400 PERFORM PRINT-DETAIL. IF1264.2 +056500*****************TEST (n) ****************************** IF1264.2 +056600 F-NUMVALC-14. IF1264.2 +056700 MOVE ZERO TO TEMP. IF1264.2 +056800 F-NUMVALC-TEST-14. IF1264.2 +056900 COMPUTE TEMP = FUNCTION NUMVAL-C (" 200.0002 - "). IF1264.2 +057000 IF (TEMP >= -200.0042) AND IF1264.2 +057100 (TEMP <= -199.9962) IF1264.2 +057200 PERFORM PASS IF1264.2 +057300 ELSE IF1264.2 +057400 MOVE -200.0002 TO CORRECT-N IF1264.2 +057500 MOVE TEMP TO COMPUTED-N IF1264.2 +057600 PERFORM FAIL. IF1264.2 +057700 GO TO F-NUMVALC-WRITE-14. IF1264.2 +057800 F-NUMVALC-DELETE-14. IF1264.2 +057900 PERFORM DE-LETE. IF1264.2 +058000 GO TO F-NUMVALC-WRITE-14. IF1264.2 +058100 F-NUMVALC-WRITE-14. IF1264.2 +058200 MOVE "F-NUMVALC-14" TO PAR-NAME. IF1264.2 +058300 PERFORM PRINT-DETAIL. IF1264.2 +058400*****************TEST (o) ****************************** IF1264.2 +058500 F-NUMVALC-15. IF1264.2 +058600 MOVE ZERO TO TEMP. IF1264.2 +058700 F-NUMVALC-TEST-15. IF1264.2 +058800 COMPUTE TEMP = FUNCTION NUMVAL-C (N). IF1264.2 +058900 IF (TEMP >= 77776.21) AND IF1264.2 +059000 (TEMP <= 77779.33) IF1264.2 +059100 PERFORM PASS IF1264.2 +059200 ELSE IF1264.2 +059300 MOVE 77777.77 TO CORRECT-N IF1264.2 +059400 MOVE TEMP TO COMPUTED-N IF1264.2 +059500 PERFORM FAIL. IF1264.2 +059600 GO TO F-NUMVALC-WRITE-15. IF1264.2 +059700 F-NUMVALC-DELETE-15. IF1264.2 +059800 PERFORM DE-LETE. IF1264.2 +059900 GO TO F-NUMVALC-WRITE-15. IF1264.2 +060000 F-NUMVALC-WRITE-15. IF1264.2 +060100 MOVE "F-NUMVALC-15" TO PAR-NAME. IF1264.2 +060200 PERFORM PRINT-DETAIL. IF1264.2 +060300*****************TEST (p) ****************************** IF1264.2 +060400 F-NUMVALC-16. IF1264.2 +060500 MOVE ZERO TO TEMP. IF1264.2 +060600 F-NUMVALC-TEST-16. IF1264.2 +060700 COMPUTE TEMP = FUNCTION NUMVAL-C ("$5", "$"). IF1264.2 +060800 IF TEMP = 5 THEN IF1264.2 +060900 PERFORM PASS IF1264.2 +061000 ELSE IF1264.2 +061100 MOVE 5 TO CORRECT-N IF1264.2 +061200 MOVE TEMP TO COMPUTED-N IF1264.2 +061300 PERFORM FAIL. IF1264.2 +061400 GO TO F-NUMVALC-WRITE-16. IF1264.2 +061500 F-NUMVALC-DELETE-16. IF1264.2 +061600 PERFORM DE-LETE. IF1264.2 +061700 GO TO F-NUMVALC-WRITE-16. IF1264.2 +061800 F-NUMVALC-WRITE-16. IF1264.2 +061900 MOVE "F-NUMVALC-16" TO PAR-NAME. IF1264.2 +062000 PERFORM PRINT-DETAIL. IF1264.2 +062100*****************TEST (q) ****************************** IF1264.2 +062200 F-NUMVALC-17. IF1264.2 +062300 MOVE ZERO TO TEMP. IF1264.2 +062400 F-NUMVALC-TEST-17. IF1264.2 +062500 COMPUTE TEMP = FUNCTION NUMVAL-C (O, "$"). IF1264.2 +062600 IF TEMP = 33 THEN IF1264.2 +062700 PERFORM PASS IF1264.2 +062800 ELSE IF1264.2 +062900 MOVE 33 TO CORRECT-N IF1264.2 +063000 MOVE TEMP TO COMPUTED-N IF1264.2 +063100 PERFORM FAIL. IF1264.2 +063200 GO TO F-NUMVALC-WRITE-17. IF1264.2 +063300 F-NUMVALC-DELETE-17. IF1264.2 +063400 PERFORM DE-LETE. IF1264.2 +063500 GO TO F-NUMVALC-WRITE-17. IF1264.2 +063600 F-NUMVALC-WRITE-17. IF1264.2 +063700 MOVE "F-NUMVALC-17" TO PAR-NAME. IF1264.2 +063800 PERFORM PRINT-DETAIL. IF1264.2 +063900*****************TEST (r) ****************************** IF1264.2 +064000 F-NUMVALC-18. IF1264.2 +064100 MOVE ZERO TO TEMP. IF1264.2 +064200 F-NUMVALC-TEST-18. IF1264.2 +064300 COMPUTE TEMP = FUNCTION NUMVAL-C ("$93,021", "$"). IF1264.2 +064400 IF TEMP = 93021 THEN IF1264.2 +064500 PERFORM PASS IF1264.2 +064600 ELSE IF1264.2 +064700 MOVE 93021 TO CORRECT-N IF1264.2 +064800 MOVE TEMP TO COMPUTED-N IF1264.2 +064900 PERFORM FAIL. IF1264.2 +065000 GO TO F-NUMVALC-WRITE-18. IF1264.2 +065100 F-NUMVALC-DELETE-18. IF1264.2 +065200 PERFORM DE-LETE. IF1264.2 +065300 GO TO F-NUMVALC-WRITE-18. IF1264.2 +065400 F-NUMVALC-WRITE-18. IF1264.2 +065500 MOVE "F-NUMVALC-18" TO PAR-NAME. IF1264.2 +065600 PERFORM PRINT-DETAIL. IF1264.2 +065700*****************TEST (t) ****************************** IF1264.2 +065800 F-NUMVALC-20. IF1264.2 +065900 MOVE ZERO TO TEMP. IF1264.2 +066000 F-NUMVALC-TEST-20. IF1264.2 +066100 COMPUTE TEMP = FUNCTION NUMVAL-C ("$924.93", "$"). IF1264.2 +066200 IF (TEMP >= 924.912) AND IF1264.2 +066300 (TEMP <= 924.948) IF1264.2 +066400 PERFORM PASS IF1264.2 +066500 ELSE IF1264.2 +066600 MOVE 924.93 TO CORRECT-N IF1264.2 +066700 MOVE TEMP TO COMPUTED-N IF1264.2 +066800 PERFORM FAIL. IF1264.2 +066900 GO TO F-NUMVALC-WRITE-20. IF1264.2 +067000 F-NUMVALC-DELETE-20. IF1264.2 +067100 PERFORM DE-LETE. IF1264.2 +067200 GO TO F-NUMVALC-WRITE-20. IF1264.2 +067300 F-NUMVALC-WRITE-20. IF1264.2 +067400 MOVE "F-NUMVALC-20" TO PAR-NAME. IF1264.2 +067500 PERFORM PRINT-DETAIL. IF1264.2 +067600*****************TEST (u) ****************************** IF1264.2 +067700 F-NUMVALC-21. IF1264.2 +067800 MOVE ZERO TO TEMP. IF1264.2 +067900 F-NUMVALC-TEST-21. IF1264.2 +068000 COMPUTE TEMP = FUNCTION NUMVAL-C (Q, "$"). IF1264.2 +068100 IF TEMP = 4000 THEN IF1264.2 +068200 PERFORM PASS IF1264.2 +068300 ELSE IF1264.2 +068400 MOVE 4000 TO CORRECT-N IF1264.2 +068500 MOVE TEMP TO COMPUTED-N IF1264.2 +068600 PERFORM FAIL. IF1264.2 +068700 GO TO F-NUMVALC-WRITE-21. IF1264.2 +068800 F-NUMVALC-DELETE-21. IF1264.2 +068900 PERFORM DE-LETE. IF1264.2 +069000 GO TO F-NUMVALC-WRITE-21. IF1264.2 +069100 F-NUMVALC-WRITE-21. IF1264.2 +069200 MOVE "F-NUMVALC-21" TO PAR-NAME. IF1264.2 +069300 PERFORM PRINT-DETAIL. IF1264.2 +069400*****************TEST (v) ****************************** IF1264.2 +069500 F-NUMVALC-22. IF1264.2 +069600 MOVE ZERO TO TEMP. IF1264.2 +069700 F-NUMVALC-TEST-22. IF1264.2 +069800 COMPUTE TEMP = FUNCTION NUMVAL-C ("-$34.03", "$"). IF1264.2 +069900 IF (TEMP >= -34.0307) AND IF1264.2 +070000 (TEMP <= -34.0293) IF1264.2 +070100 PERFORM PASS IF1264.2 +070200 ELSE IF1264.2 +070300 MOVE -34.03 TO CORRECT-N IF1264.2 +070400 MOVE TEMP TO COMPUTED-N IF1264.2 +070500 PERFORM FAIL. IF1264.2 +070600 GO TO F-NUMVALC-WRITE-22. IF1264.2 +070700 F-NUMVALC-DELETE-22. IF1264.2 +070800 PERFORM DE-LETE. IF1264.2 +070900 GO TO F-NUMVALC-WRITE-22. IF1264.2 +071000 F-NUMVALC-WRITE-22. IF1264.2 +071100 MOVE "F-NUMVALC-22" TO PAR-NAME. IF1264.2 +071200 PERFORM PRINT-DETAIL. IF1264.2 +071300*****************TEST (w) ****************************** IF1264.2 +071400 F-NUMVALC-23. IF1264.2 +071500 MOVE ZERO TO TEMP. IF1264.2 +071600 F-NUMVALC-TEST-23. IF1264.2 +071700 COMPUTE TEMP = FUNCTION NUMVAL-C (R, "$"). IF1264.2 +071800 IF (TEMP >= 999980.5) AND IF1264.2 +071900 (TEMP <= 1000020.5) IF1264.2 +072000 PERFORM PASS IF1264.2 +072100 ELSE IF1264.2 +072200 MOVE 1000000.5 TO CORRECT-N IF1264.2 +072300 MOVE TEMP TO COMPUTED-N IF1264.2 +072400 PERFORM FAIL. IF1264.2 +072500 GO TO F-NUMVALC-WRITE-23. IF1264.2 +072600 F-NUMVALC-DELETE-23. IF1264.2 +072700 PERFORM DE-LETE. IF1264.2 +072800 GO TO F-NUMVALC-WRITE-23. IF1264.2 +072900 F-NUMVALC-WRITE-23. IF1264.2 +073000 MOVE "F-NUMVALC-23" TO PAR-NAME. IF1264.2 +073100 PERFORM PRINT-DETAIL. IF1264.2 +073200*****************TEST (x) ****************************** IF1264.2 +073300 F-NUMVALC-24. IF1264.2 +073400 MOVE ZERO TO TEMP. IF1264.2 +073500 F-NUMVALC-TEST-24. IF1264.2 +073600 COMPUTE TEMP = FUNCTION NUMVAL-C (" $ 89.01", "$"). IF1264.2 +073700 IF (TEMP >= 89.0082) AND IF1264.2 +073800 (TEMP <= 89.0118) IF1264.2 +073900 PERFORM PASS IF1264.2 +074000 ELSE IF1264.2 +074100 MOVE 89.01 TO CORRECT-N IF1264.2 +074200 MOVE TEMP TO COMPUTED-N IF1264.2 +074300 PERFORM FAIL. IF1264.2 +074400 GO TO F-NUMVALC-WRITE-24. IF1264.2 +074500 F-NUMVALC-DELETE-24. IF1264.2 +074600 PERFORM DE-LETE. IF1264.2 +074700 GO TO F-NUMVALC-WRITE-24. IF1264.2 +074800 F-NUMVALC-WRITE-24. IF1264.2 +074900 MOVE "F-NUMVALC-24" TO PAR-NAME. IF1264.2 +075000 PERFORM PRINT-DETAIL. IF1264.2 +075100*****************TEST (y) ****************************** IF1264.2 +075200 F-NUMVALC-25. IF1264.2 +075300 MOVE ZERO TO TEMP. IF1264.2 +075400 F-NUMVALC-TEST-25. IF1264.2 +075500 COMPUTE TEMP = FUNCTION NUMVAL-C (S, "$"). IF1264.2 +075600 IF (TEMP >= 3900.13) AND IF1264.2 +075700 (TEMP <= 3900.29) IF1264.2 +075800 PERFORM PASS IF1264.2 +075900 ELSE IF1264.2 +076000 MOVE 3900.21 TO CORRECT-N IF1264.2 +076100 MOVE TEMP TO COMPUTED-N IF1264.2 +076200 PERFORM FAIL. IF1264.2 +076300 GO TO F-NUMVALC-WRITE-25. IF1264.2 +076400 F-NUMVALC-DELETE-25. IF1264.2 +076500 PERFORM DE-LETE. IF1264.2 +076600 GO TO F-NUMVALC-WRITE-25. IF1264.2 +076700 F-NUMVALC-WRITE-25. IF1264.2 +076800 MOVE "F-NUMVALC-25" TO PAR-NAME. IF1264.2 +076900 PERFORM PRINT-DETAIL. IF1264.2 +077000*****************TEST (z) ****************************** IF1264.2 +077100 F-NUMVALC-26. IF1264.2 +077200 MOVE ZERO TO TEMP. IF1264.2 +077300 F-NUMVALC-TEST-26. IF1264.2 +077400 COMPUTE TEMP = FUNCTION NUMVAL-C ("- $ 890.21", "$"). IF1264.2 +077500 IF (TEMP >= -890.228) AND IF1264.2 +077600 (TEMP <= -890.192) IF1264.2 +077700 PERFORM PASS IF1264.2 +077800 ELSE IF1264.2 +077900 MOVE -890.21 TO CORRECT-N IF1264.2 +078000 MOVE TEMP TO COMPUTED-N IF1264.2 +078100 PERFORM FAIL. IF1264.2 +078200 GO TO F-NUMVALC-WRITE-26. IF1264.2 +078300 F-NUMVALC-DELETE-26. IF1264.2 +078400 PERFORM DE-LETE. IF1264.2 +078500 GO TO F-NUMVALC-WRITE-26. IF1264.2 +078600 F-NUMVALC-WRITE-26. IF1264.2 +078700 MOVE "F-NUMVALC-26" TO PAR-NAME. IF1264.2 +078800 PERFORM PRINT-DETAIL. IF1264.2 +078900*****************TEST (aa) ****************************** IF1264.2 +079000 F-NUMVALC-27. IF1264.2 +079100 MOVE ZERO TO TEMP. IF1264.2 +079200 F-NUMVALC-TEST-27. IF1264.2 +079300 COMPUTE TEMP = FUNCTION NUMVAL-C (T, "$"). IF1264.2 +079400 IF (TEMP >= 9000.81) AND IF1264.2 +079500 (TEMP <= 9001.17) IF1264.2 +079600 PERFORM PASS IF1264.2 +079700 ELSE IF1264.2 +079800 MOVE 9000.99 TO CORRECT-N IF1264.2 +079900 MOVE TEMP TO COMPUTED-N IF1264.2 +080000 PERFORM FAIL. IF1264.2 +080100 GO TO F-NUMVALC-WRITE-27. IF1264.2 +080200 F-NUMVALC-DELETE-27. IF1264.2 +080300 PERFORM DE-LETE. IF1264.2 +080400 GO TO F-NUMVALC-WRITE-27. IF1264.2 +080500 F-NUMVALC-WRITE-27. IF1264.2 +080600 MOVE "F-NUMVALC-27" TO PAR-NAME. IF1264.2 +080700 PERFORM PRINT-DETAIL. IF1264.2 +080800*****************TEST (bb) ****************************** IF1264.2 +080900 F-NUMVALC-28. IF1264.2 +081000 MOVE ZERO TO TEMP. IF1264.2 +081100 F-NUMVALC-TEST-28. IF1264.2 +081200 COMPUTE TEMP = FUNCTION NUMVAL-C (" $ 90.54 - ", "$"). IF1264.2 +081300 IF (TEMP >= -90.5418) AND IF1264.2 +081400 (TEMP <= -90.5382) IF1264.2 +081500 PERFORM PASS IF1264.2 +081600 ELSE IF1264.2 +081700 MOVE -90.54 TO CORRECT-N IF1264.2 +081800 MOVE TEMP TO COMPUTED-N IF1264.2 +081900 PERFORM FAIL. IF1264.2 +082000 GO TO F-NUMVALC-WRITE-28. IF1264.2 +082100 F-NUMVALC-DELETE-28. IF1264.2 +082200 PERFORM DE-LETE. IF1264.2 +082300 GO TO F-NUMVALC-WRITE-28. IF1264.2 +082400 F-NUMVALC-WRITE-28. IF1264.2 +082500 MOVE "F-NUMVALC-28" TO PAR-NAME. IF1264.2 +082600 PERFORM PRINT-DETAIL. IF1264.2 +082700*****************TEST (cc) ****************************** IF1264.2 +082800 F-NUMVALC-29. IF1264.2 +082900 MOVE ZERO TO TEMP. IF1264.2 +083000 F-NUMVALC-TEST-29. IF1264.2 +083100 COMPUTE TEMP = FUNCTION NUMVAL-C (U, "$"). IF1264.2 +083200 IF (TEMP >= 3890.12) AND IF1264.2 +083300 (TEMP <= 3890.28) IF1264.2 +083400 PERFORM PASS IF1264.2 +083500 ELSE IF1264.2 +083600 MOVE 3890.2 TO CORRECT-N IF1264.2 +083700 MOVE TEMP TO COMPUTED-N IF1264.2 +083800 PERFORM FAIL. IF1264.2 +083900 GO TO F-NUMVALC-WRITE-29. IF1264.2 +084000 F-NUMVALC-DELETE-29. IF1264.2 +084100 PERFORM DE-LETE. IF1264.2 +084200 GO TO F-NUMVALC-WRITE-29. IF1264.2 +084300 F-NUMVALC-WRITE-29. IF1264.2 +084400 MOVE "F-NUMVALC-29" TO PAR-NAME. IF1264.2 +084500 PERFORM PRINT-DETAIL. IF1264.2 +084600*****************TEST (dd) ****************************** IF1264.2 +084700 F-NUMVALC-30. IF1264.2 +084800 MOVE ZERO TO TEMP. IF1264.2 +084900 F-NUMVALC-TEST-30. IF1264.2 +085000 COMPUTE TEMP = FUNCTION NUMVAL-C ("90") + 10. IF1264.2 +085100 IF TEMP = 100 THEN IF1264.2 +085200 PERFORM PASS IF1264.2 +085300 ELSE IF1264.2 +085400 MOVE 100 TO CORRECT-N IF1264.2 +085500 MOVE TEMP TO COMPUTED-N IF1264.2 +085600 PERFORM FAIL. IF1264.2 +085700 GO TO F-NUMVALC-WRITE-30. IF1264.2 +085800 F-NUMVALC-DELETE-30. IF1264.2 +085900 PERFORM DE-LETE. IF1264.2 +086000 GO TO F-NUMVALC-WRITE-30. IF1264.2 +086100 F-NUMVALC-WRITE-30. IF1264.2 +086200 MOVE "F-NUMVALC-30" TO PAR-NAME. IF1264.2 +086300 PERFORM PRINT-DETAIL. IF1264.2 +086400*****************TEST (ee) ****************************** IF1264.2 +086500 F-NUMVALC-31. IF1264.2 +086600 MOVE ZERO TO TEMP. IF1264.2 +086700 F-NUMVALC-TEST-31. IF1264.2 +086800 COMPUTE TEMP = FUNCTION NUMVAL-C ("2") + IF1264.2 +086900 FUNCTION NUMVAL-C ("8"). IF1264.2 +087000 IF TEMP = 10 THEN IF1264.2 +087100 PERFORM PASS IF1264.2 +087200 ELSE IF1264.2 +087300 MOVE 10 TO CORRECT-N IF1264.2 +087400 MOVE TEMP TO COMPUTED-N IF1264.2 +087500 PERFORM FAIL. IF1264.2 +087600 GO TO F-NUMVALC-WRITE-31. IF1264.2 +087700 F-NUMVALC-DELETE-31. IF1264.2 +087800 PERFORM DE-LETE. IF1264.2 +087900 GO TO F-NUMVALC-WRITE-31. IF1264.2 +088000 F-NUMVALC-WRITE-31. IF1264.2 +088100 MOVE "F-NUMVALC-31" TO PAR-NAME. IF1264.2 +088200 PERFORM PRINT-DETAIL. IF1264.2 +088300*******************END OF TESTS************************** IF1264.2 +088400 CCVS-EXIT SECTION. IF1264.2 +088500 CCVS-999999. IF1264.2 +088600 GO TO CLOSE-FILES. IF1264.2 +*END-OF,IF126A +*HEADER,COBOL,IF127A +000100 IDENTIFICATION DIVISION. IF1274.2 +000200 PROGRAM-ID. IF1274.2 +000300 IF127A. IF1274.2 +000400 IF1274.2 +000500*********************************************************** IF1274.2 +000600* * IF1274.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1274.2 +000800* It contains tests for the Intrinsic Function ORD. * IF1274.2 +000900* * IF1274.2 +001000* * IF1274.2 +001100*********************************************************** IF1274.2 +001200 ENVIRONMENT DIVISION. IF1274.2 +001300 CONFIGURATION SECTION. IF1274.2 +001400 SOURCE-COMPUTER. IF1274.2 +001500 XXXXX082. IF1274.2 +001600 OBJECT-COMPUTER. IF1274.2 +001700 XXXXX083 IF1274.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1274.2 +001900 SPECIAL-NAMES. IF1274.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1274.2 +002100 STANDARD-2. IF1274.2 +002200 INPUT-OUTPUT SECTION. IF1274.2 +002300 FILE-CONTROL. IF1274.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1274.2 +002500 XXXXX055. IF1274.2 +002600 DATA DIVISION. IF1274.2 +002700 FILE SECTION. IF1274.2 +002800 FD PRINT-FILE. IF1274.2 +002900 01 PRINT-REC PICTURE X(120). IF1274.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1274.2 +003100 WORKING-STORAGE SECTION. IF1274.2 +003200*********************************************************** IF1274.2 +003300* Variables specific to the Intrinsic Function Test IF127A* IF1274.2 +003400*********************************************************** IF1274.2 +003500 01 A PIC X VALUE "F". IF1274.2 +003600 01 B PIC X VALUE "d". IF1274.2 +003700 01 C PIC X VALUE "3". IF1274.2 +003800 01 ARG1 PIC X VALUE "A". IF1274.2 +003900 01 TEMP PIC S9(10). IF1274.2 +004000 01 WS-INT PIC S9(10). IF1274.2 +004100* IF1274.2 +004200********************************************************** IF1274.2 +004300* IF1274.2 +004400 01 TEST-RESULTS. IF1274.2 +004500 02 FILLER PIC X VALUE SPACE. IF1274.2 +004600 02 FEATURE PIC X(20) VALUE SPACE. IF1274.2 +004700 02 FILLER PIC X VALUE SPACE. IF1274.2 +004800 02 P-OR-F PIC X(5) VALUE SPACE. IF1274.2 +004900 02 FILLER PIC X VALUE SPACE. IF1274.2 +005000 02 PAR-NAME. IF1274.2 +005100 03 FILLER PIC X(19) VALUE SPACE. IF1274.2 +005200 03 PARDOT-X PIC X VALUE SPACE. IF1274.2 +005300 03 DOTVALUE PIC 99 VALUE ZERO. IF1274.2 +005400 02 FILLER PIC X(8) VALUE SPACE. IF1274.2 +005500 02 RE-MARK PIC X(61). IF1274.2 +005600 01 TEST-COMPUTED. IF1274.2 +005700 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +005800 02 FILLER PIC X(17) VALUE IF1274.2 +005900 " COMPUTED=". IF1274.2 +006000 02 COMPUTED-X. IF1274.2 +006100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1274.2 +006200 03 COMPUTED-N REDEFINES COMPUTED-A IF1274.2 +006300 PIC -9(9).9(9). IF1274.2 +006400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1274.2 +006500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1274.2 +006600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1274.2 +006700 03 CM-18V0 REDEFINES COMPUTED-A. IF1274.2 +006800 04 COMPUTED-18V0 PIC -9(18). IF1274.2 +006900 04 FILLER PIC X. IF1274.2 +007000 03 FILLER PIC X(50) VALUE SPACE. IF1274.2 +007100 01 TEST-CORRECT. IF1274.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +007300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1274.2 +007400 02 CORRECT-X. IF1274.2 +007500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1274.2 +007600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1274.2 +007700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1274.2 +007800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1274.2 +007900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1274.2 +008000 03 CR-18V0 REDEFINES CORRECT-A. IF1274.2 +008100 04 CORRECT-18V0 PIC -9(18). IF1274.2 +008200 04 FILLER PIC X. IF1274.2 +008300 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +008400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1274.2 +008500 01 TEST-CORRECT-MIN. IF1274.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +008700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1274.2 +008800 02 CORRECTMI-X. IF1274.2 +008900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1274.2 +009000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1274.2 +009100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1274.2 +009200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1274.2 +009300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1274.2 +009400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1274.2 +009500 04 CORRECTMI-18V0 PIC -9(18). IF1274.2 +009600 04 FILLER PIC X. IF1274.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +009800 03 FILLER PIC X(48) VALUE SPACE. IF1274.2 +009900 01 TEST-CORRECT-MAX. IF1274.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +010100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1274.2 +010200 02 CORRECTMA-X. IF1274.2 +010300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1274.2 +010400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1274.2 +010500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1274.2 +010600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1274.2 +010700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1274.2 +010800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1274.2 +010900 04 CORRECTMA-18V0 PIC -9(18). IF1274.2 +011000 04 FILLER PIC X. IF1274.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +011200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1274.2 +011300 01 CCVS-C-1. IF1274.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1274.2 +011500- "SS PARAGRAPH-NAME IF1274.2 +011600- " REMARKS". IF1274.2 +011700 02 FILLER PIC X(20) VALUE SPACE. IF1274.2 +011800 01 CCVS-C-2. IF1274.2 +011900 02 FILLER PIC X VALUE SPACE. IF1274.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". IF1274.2 +012100 02 FILLER PIC X(15) VALUE SPACE. IF1274.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". IF1274.2 +012300 02 FILLER PIC X(94) VALUE SPACE. IF1274.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1274.2 +012500 01 REC-CT PIC 99 VALUE ZERO. IF1274.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1274.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1274.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1274.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1274.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1274.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1274.2 +013500 01 CCVS-H-1. IF1274.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IF1274.2 +013700 02 FILLER PIC X(42) VALUE IF1274.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1274.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1274.2 +014000 01 CCVS-H-2A. IF1274.2 +014100 02 FILLER PIC X(40) VALUE SPACE. IF1274.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1274.2 +014300 02 FILLER PIC XXXX VALUE IF1274.2 +014400 "4.2 ". IF1274.2 +014500 02 FILLER PIC X(28) VALUE IF1274.2 +014600 " COPY - NOT FOR DISTRIBUTION". IF1274.2 +014700 02 FILLER PIC X(41) VALUE SPACE. IF1274.2 +014800 IF1274.2 +014900 01 CCVS-H-2B. IF1274.2 +015000 02 FILLER PIC X(15) VALUE IF1274.2 +015100 "TEST RESULT OF ". IF1274.2 +015200 02 TEST-ID PIC X(9). IF1274.2 +015300 02 FILLER PIC X(4) VALUE IF1274.2 +015400 " IN ". IF1274.2 +015500 02 FILLER PIC X(12) VALUE IF1274.2 +015600 " HIGH ". IF1274.2 +015700 02 FILLER PIC X(22) VALUE IF1274.2 +015800 " LEVEL VALIDATION FOR ". IF1274.2 +015900 02 FILLER PIC X(58) VALUE IF1274.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1274.2 +016100 01 CCVS-H-3. IF1274.2 +016200 02 FILLER PIC X(34) VALUE IF1274.2 +016300 " FOR OFFICIAL USE ONLY ". IF1274.2 +016400 02 FILLER PIC X(58) VALUE IF1274.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1274.2 +016600 02 FILLER PIC X(28) VALUE IF1274.2 +016700 " COPYRIGHT 1985 ". IF1274.2 +016800 01 CCVS-E-1. IF1274.2 +016900 02 FILLER PIC X(52) VALUE SPACE. IF1274.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1274.2 +017100 02 ID-AGAIN PIC X(9). IF1274.2 +017200 02 FILLER PIC X(45) VALUE SPACES. IF1274.2 +017300 01 CCVS-E-2. IF1274.2 +017400 02 FILLER PIC X(31) VALUE SPACE. IF1274.2 +017500 02 FILLER PIC X(21) VALUE SPACE. IF1274.2 +017600 02 CCVS-E-2-2. IF1274.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1274.2 +017800 03 FILLER PIC X VALUE SPACE. IF1274.2 +017900 03 ENDER-DESC PIC X(44) VALUE IF1274.2 +018000 "ERRORS ENCOUNTERED". IF1274.2 +018100 01 CCVS-E-3. IF1274.2 +018200 02 FILLER PIC X(22) VALUE IF1274.2 +018300 " FOR OFFICIAL USE ONLY". IF1274.2 +018400 02 FILLER PIC X(12) VALUE SPACE. IF1274.2 +018500 02 FILLER PIC X(58) VALUE IF1274.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1274.2 +018700 02 FILLER PIC X(13) VALUE SPACE. IF1274.2 +018800 02 FILLER PIC X(15) VALUE IF1274.2 +018900 " COPYRIGHT 1985". IF1274.2 +019000 01 CCVS-E-4. IF1274.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1274.2 +019200 02 FILLER PIC X(4) VALUE " OF ". IF1274.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1274.2 +019400 02 FILLER PIC X(40) VALUE IF1274.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1274.2 +019600 01 XXINFO. IF1274.2 +019700 02 FILLER PIC X(19) VALUE IF1274.2 +019800 "*** INFORMATION ***". IF1274.2 +019900 02 INFO-TEXT. IF1274.2 +020000 04 FILLER PIC X(8) VALUE SPACE. IF1274.2 +020100 04 XXCOMPUTED PIC X(20). IF1274.2 +020200 04 FILLER PIC X(5) VALUE SPACE. IF1274.2 +020300 04 XXCORRECT PIC X(20). IF1274.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). IF1274.2 +020500 01 HYPHEN-LINE. IF1274.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. IF1274.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************IF1274.2 +020800- "*****************************************". IF1274.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************IF1274.2 +021000- "******************************". IF1274.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE IF1274.2 +021200 "IF127A". IF1274.2 +021300 PROCEDURE DIVISION. IF1274.2 +021400 CCVS1 SECTION. IF1274.2 +021500 OPEN-FILES. IF1274.2 +021600 OPEN OUTPUT PRINT-FILE. IF1274.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1274.2 +021800 MOVE SPACE TO TEST-RESULTS. IF1274.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1274.2 +022000 GO TO CCVS1-EXIT. IF1274.2 +022100 CLOSE-FILES. IF1274.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1274.2 +022300 TERMINATE-CCVS. IF1274.2 +022400 STOP RUN. IF1274.2 +022500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1274.2 +022600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1274.2 +022700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1274.2 +022800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1274.2 +022900 MOVE "****TEST DELETED****" TO RE-MARK. IF1274.2 +023000 PRINT-DETAIL. IF1274.2 +023100 IF REC-CT NOT EQUAL TO ZERO IF1274.2 +023200 MOVE "." TO PARDOT-X IF1274.2 +023300 MOVE REC-CT TO DOTVALUE. IF1274.2 +023400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1274.2 +023500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1274.2 +023600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1274.2 +023700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1274.2 +023800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1274.2 +023900 MOVE SPACE TO CORRECT-X. IF1274.2 +024000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1274.2 +024100 MOVE SPACE TO RE-MARK. IF1274.2 +024200 HEAD-ROUTINE. IF1274.2 +024300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +024400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +024500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1274.2 +024600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1274.2 +024700 COLUMN-NAMES-ROUTINE. IF1274.2 +024800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +024900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +025100 END-ROUTINE. IF1274.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1274.2 +025300 END-RTN-EXIT. IF1274.2 +025400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +025500 END-ROUTINE-1. IF1274.2 +025600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1274.2 +025700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1274.2 +025800 ADD PASS-COUNTER TO ERROR-HOLD. IF1274.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1274.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1274.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1274.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1274.2 +026300 END-ROUTINE-12. IF1274.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1274.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1274.2 +026600 MOVE "NO " TO ERROR-TOTAL IF1274.2 +026700 ELSE IF1274.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1274.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1274.2 +027000 PERFORM WRITE-LINE. IF1274.2 +027100 END-ROUTINE-13. IF1274.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1274.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE IF1274.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1274.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1274.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO IF1274.2 +027800 MOVE "NO " TO ERROR-TOTAL IF1274.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1274.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1274.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +028300 WRITE-LINE. IF1274.2 +028400 ADD 1 TO RECORD-COUNT. IF1274.2 +028500Y IF RECORD-COUNT GREATER 42 IF1274.2 +028600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1274.2 +028700Y MOVE SPACE TO DUMMY-RECORD IF1274.2 +028800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1274.2 +028900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1274.2 +029000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1274.2 +029100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1274.2 +029200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1274.2 +029300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1274.2 +029700Y MOVE ZERO TO RECORD-COUNT. IF1274.2 +029800 PERFORM WRT-LN. IF1274.2 +029900 WRT-LN. IF1274.2 +030000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1274.2 +030100 MOVE SPACE TO DUMMY-RECORD. IF1274.2 +030200 BLANK-LINE-PRINT. IF1274.2 +030300 PERFORM WRT-LN. IF1274.2 +030400 FAIL-ROUTINE. IF1274.2 +030500 IF COMPUTED-X NOT EQUAL TO SPACE IF1274.2 +030600 GO TO FAIL-ROUTINE-WRITE. IF1274.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1274.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1274.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1274.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1274.2 +031200 GO TO FAIL-ROUTINE-EX. IF1274.2 +031300 FAIL-ROUTINE-WRITE. IF1274.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1274.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1274.2 +031600 CORMA-ANSI-REFERENCE. IF1274.2 +031700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1274.2 +031800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1274.2 +031900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1274.2 +032000 ELSE IF1274.2 +032100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1274.2 +032200 PERFORM WRITE-LINE. IF1274.2 +032300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1274.2 +032400 FAIL-ROUTINE-EX. EXIT. IF1274.2 +032500 BAIL-OUT. IF1274.2 +032600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1274.2 +032700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1274.2 +032800 BAIL-OUT-WRITE. IF1274.2 +032900 MOVE CORRECT-A TO XXCORRECT. IF1274.2 +033000 MOVE COMPUTED-A TO XXCOMPUTED. IF1274.2 +033100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1274.2 +033200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +033300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1274.2 +033400 BAIL-OUT-EX. EXIT. IF1274.2 +033500 CCVS1-EXIT. IF1274.2 +033600 EXIT. IF1274.2 +033700******************************************************** IF1274.2 +033800* * IF1274.2 +033900* Intrinsic Function Tests IF127A - ORD * IF1274.2 +034000* * IF1274.2 +034100******************************************************** IF1274.2 +034200 SECT-IF127A SECTION. IF1274.2 +034300 F-ORD-INFO. IF1274.2 +034400 MOVE "See ref. A-60 2.31" TO ANSI-REFERENCE. IF1274.2 +034500 MOVE "ORD Function" TO FEATURE. IF1274.2 +034600*****************TEST (a) ****************************** IF1274.2 +034700 F-ORD-01. IF1274.2 +034800 MOVE ZERO TO WS-INT. IF1274.2 +034900 F-ORD-TEST-01. IF1274.2 +035000 COMPUTE WS-INT = FUNCTION ORD("A"). IF1274.2 +035100 IF WS-INT = 66 THEN IF1274.2 +035200 PERFORM PASS IF1274.2 +035300 ELSE IF1274.2 +035400 MOVE 66 TO CORRECT-N IF1274.2 +035500 MOVE WS-INT TO COMPUTED-N IF1274.2 +035600 PERFORM FAIL. IF1274.2 +035700 GO TO F-ORD-WRITE-01. IF1274.2 +035800 F-ORD-DELETE-01. IF1274.2 +035900 PERFORM DE-LETE. IF1274.2 +036000 GO TO F-ORD-WRITE-01. IF1274.2 +036100 F-ORD-WRITE-01. IF1274.2 +036200 MOVE "F-ORD-01" TO PAR-NAME. IF1274.2 +036300 PERFORM PRINT-DETAIL. IF1274.2 +036400*****************TEST (b) ****************************** IF1274.2 +036500 F-ORD-TEST-02. IF1274.2 +036600 EVALUATE FUNCTION ORD("m") IF1274.2 +036700 WHEN 110 IF1274.2 +036800 PERFORM PASS IF1274.2 +036900 GO TO F-ORD-WRITE-02. IF1274.2 +037000 PERFORM FAIL. IF1274.2 +037100 GO TO F-ORD-WRITE-02. IF1274.2 +037200 F-ORD-DELETE-02. IF1274.2 +037300 PERFORM DE-LETE. IF1274.2 +037400 GO TO F-ORD-WRITE-02. IF1274.2 +037500 F-ORD-WRITE-02. IF1274.2 +037600 MOVE "F-ORD-02" TO PAR-NAME. IF1274.2 +037700 PERFORM PRINT-DETAIL. IF1274.2 +037800*****************TEST (c) ****************************** IF1274.2 +037900 F-ORD-03. IF1274.2 +038000 MOVE ZERO TO WS-INT. IF1274.2 +038100 F-ORD-TEST-03. IF1274.2 +038200 IF FUNCTION ORD("5") = 54 THEN IF1274.2 +038300 PERFORM PASS IF1274.2 +038400 ELSE IF1274.2 +038500 PERFORM FAIL. IF1274.2 +038600 GO TO F-ORD-WRITE-03. IF1274.2 +038700 F-ORD-DELETE-03. IF1274.2 +038800 PERFORM DE-LETE. IF1274.2 +038900 GO TO F-ORD-WRITE-03. IF1274.2 +039000 F-ORD-WRITE-03. IF1274.2 +039100 MOVE "F-ORD-03" TO PAR-NAME. IF1274.2 +039200 PERFORM PRINT-DETAIL. IF1274.2 +039300*****************TEST (d) ****************************** IF1274.2 +039400 F-ORD-04. IF1274.2 +039500 MOVE ZERO TO WS-INT. IF1274.2 +039600 F-ORD-TEST-04. IF1274.2 +039700 COMPUTE WS-INT = FUNCTION ORD(A). IF1274.2 +039800 IF WS-INT = 71 THEN IF1274.2 +039900 PERFORM PASS IF1274.2 +040000 ELSE IF1274.2 +040100 MOVE 71 TO CORRECT-N IF1274.2 +040200 MOVE WS-INT TO COMPUTED-N IF1274.2 +040300 PERFORM FAIL. IF1274.2 +040400 GO TO F-ORD-WRITE-04. IF1274.2 +040500 F-ORD-DELETE-04. IF1274.2 +040600 PERFORM DE-LETE. IF1274.2 +040700 GO TO F-ORD-WRITE-04. IF1274.2 +040800 F-ORD-WRITE-04. IF1274.2 +040900 MOVE "F-ORD-04" TO PAR-NAME. IF1274.2 +041000 PERFORM PRINT-DETAIL. IF1274.2 +041100*****************TEST (e) ****************************** IF1274.2 +041200 F-ORD-05. IF1274.2 +041300 MOVE ZERO TO WS-INT. IF1274.2 +041400 F-ORD-TEST-05. IF1274.2 +041500 COMPUTE WS-INT = FUNCTION ORD(B). IF1274.2 +041600 IF WS-INT = 101 THEN IF1274.2 +041700 PERFORM PASS IF1274.2 +041800 ELSE IF1274.2 +041900 MOVE 101 TO CORRECT-N IF1274.2 +042000 MOVE WS-INT TO COMPUTED-N IF1274.2 +042100 PERFORM FAIL. IF1274.2 +042200 GO TO F-ORD-WRITE-05. IF1274.2 +042300 F-ORD-DELETE-05. IF1274.2 +042400 PERFORM DE-LETE. IF1274.2 +042500 GO TO F-ORD-WRITE-05. IF1274.2 +042600 F-ORD-WRITE-05. IF1274.2 +042700 MOVE "F-ORD-05" TO PAR-NAME. IF1274.2 +042800 PERFORM PRINT-DETAIL. IF1274.2 +042900*****************TEST (f) ****************************** IF1274.2 +043000 F-ORD-06. IF1274.2 +043100 MOVE ZERO TO WS-INT. IF1274.2 +043200 F-ORD-TEST-06. IF1274.2 +043300 COMPUTE WS-INT = FUNCTION ORD(C). IF1274.2 +043400 IF WS-INT = 52 THEN IF1274.2 +043500 PERFORM PASS IF1274.2 +043600 ELSE IF1274.2 +043700 MOVE 52 TO CORRECT-N IF1274.2 +043800 MOVE WS-INT TO COMPUTED-N IF1274.2 +043900 PERFORM FAIL. IF1274.2 +044000 GO TO F-ORD-WRITE-06. IF1274.2 +044100 F-ORD-DELETE-06. IF1274.2 +044200 PERFORM DE-LETE. IF1274.2 +044300 GO TO F-ORD-WRITE-06. IF1274.2 +044400 F-ORD-WRITE-06. IF1274.2 +044500 MOVE "F-ORD-06" TO PAR-NAME. IF1274.2 +044600 PERFORM PRINT-DETAIL. IF1274.2 +044700*****************TEST (g) ****************************** IF1274.2 +044800 F-ORD-07. IF1274.2 +044900 MOVE ZERO TO WS-INT. IF1274.2 +045000 F-ORD-TEST-07. IF1274.2 +045100 COMPUTE WS-INT = FUNCTION ORD("g") + 1. IF1274.2 +045200 IF WS-INT = 105 THEN IF1274.2 +045300 PERFORM PASS IF1274.2 +045400 ELSE IF1274.2 +045500 MOVE 105 TO CORRECT-N IF1274.2 +045600 MOVE WS-INT TO COMPUTED-N IF1274.2 +045700 PERFORM FAIL. IF1274.2 +045800 GO TO F-ORD-WRITE-07. IF1274.2 +045900 F-ORD-DELETE-07. IF1274.2 +046000 PERFORM DE-LETE. IF1274.2 +046100 GO TO F-ORD-WRITE-07. IF1274.2 +046200 F-ORD-WRITE-07. IF1274.2 +046300 MOVE "F-ORD-07" TO PAR-NAME. IF1274.2 +046400 PERFORM PRINT-DETAIL. IF1274.2 +046500*****************TEST (h) ****************************** IF1274.2 +046600 F-ORD-08. IF1274.2 +046700 MOVE ZERO TO WS-INT. IF1274.2 +046800 F-ORD-TEST-08. IF1274.2 +046900 COMPUTE WS-INT = FUNCTION ORD("A") + IF1274.2 +047000 FUNCTION ORD(A). IF1274.2 +047100 IF WS-INT = 137 THEN IF1274.2 +047200 PERFORM PASS IF1274.2 +047300 ELSE IF1274.2 +047400 MOVE 137 TO CORRECT-N IF1274.2 +047500 MOVE WS-INT TO COMPUTED-N IF1274.2 +047600 PERFORM FAIL. IF1274.2 +047700 GO TO F-ORD-WRITE-08. IF1274.2 +047800 F-ORD-DELETE-08. IF1274.2 +047900 PERFORM DE-LETE. IF1274.2 +048000 GO TO F-ORD-WRITE-08. IF1274.2 +048100 F-ORD-WRITE-08. IF1274.2 +048200 MOVE "F-ORD-08" TO PAR-NAME. IF1274.2 +048300 PERFORM PRINT-DETAIL. IF1274.2 +048400*****************SPECIAL TEST 1****************************** IF1274.2 +048500 F-ORD-09. IF1274.2 +048600 PERFORM F-ORD-TEST-09 UNTIL FUNCTION ORD(ARG1) = 67. IF1274.2 +048700 IF ARG1 = "B" THEN IF1274.2 +048800 PERFORM PASS IF1274.2 +048900 ELSE IF1274.2 +049000 PERFORM FAIL. IF1274.2 +049100 GO TO F-ORD-WRITE-09. IF1274.2 +049200* IF1274.2 +049300 F-ORD-TEST-09. IF1274.2 +049400 MOVE "B" TO ARG1. IF1274.2 +049500* IF1274.2 +049600 F-ORD-DELETE-09. IF1274.2 +049700 PERFORM DE-LETE. IF1274.2 +049800 GO TO F-ORD-WRITE-09. IF1274.2 +049900 F-ORD-WRITE-09. IF1274.2 +050000 MOVE "F-ORD-09" TO PAR-NAME. IF1274.2 +050100 PERFORM PRINT-DETAIL. IF1274.2 +050200*******************END OF TESTS************************** IF1274.2 +050300 CCVS-EXIT SECTION. IF1274.2 +050400 CCVS-999999. IF1274.2 +050500 GO TO CLOSE-FILES. IF1274.2 +*END-OF,IF127A +*HEADER,COBOL,IF128A +000100 IDENTIFICATION DIVISION. IF1284.2 +000200 PROGRAM-ID. IF1284.2 +000300 IF128A. IF1284.2 +000400 IF1284.2 +000500*********************************************************** IF1284.2 +000600* * IF1284.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1284.2 +000800* It contains tests for the Intrinsic Function ORD-MAX. * IF1284.2 +000900* * IF1284.2 +001000* * IF1284.2 +001100*********************************************************** IF1284.2 +001200 ENVIRONMENT DIVISION. IF1284.2 +001300 CONFIGURATION SECTION. IF1284.2 +001400 SOURCE-COMPUTER. IF1284.2 +001500 XXXXX082. IF1284.2 +001600 OBJECT-COMPUTER. IF1284.2 +001700 XXXXX083 IF1284.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1284.2 +001900 SPECIAL-NAMES. IF1284.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1284.2 +002100 STANDARD-2. IF1284.2 +002200 INPUT-OUTPUT SECTION. IF1284.2 +002300 FILE-CONTROL. IF1284.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1284.2 +002500 XXXXX055. IF1284.2 +002600 DATA DIVISION. IF1284.2 +002700 FILE SECTION. IF1284.2 +002800 FD PRINT-FILE. IF1284.2 +002900 01 PRINT-REC PICTURE X(120). IF1284.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1284.2 +003100 WORKING-STORAGE SECTION. IF1284.2 +003200*********************************************************** IF1284.2 +003300* Variables specific to the Intrinsic Function Test IF128A* IF1284.2 +003400*********************************************************** IF1284.2 +003500 01 A PIC S9(10) VALUE 5. IF1284.2 +003600 01 B PIC S9(10) VALUE 7. IF1284.2 +003700 01 C PIC S9(10) VALUE 4. IF1284.2 +003800 01 D PIC S9(10) VALUE 10. IF1284.2 +003900 01 I PIC X(4) VALUE "R". IF1284.2 +004000 01 J PIC X(4) VALUE "U". IF1284.2 +004100 01 P PIC S9(10) VALUE 1. IF1284.2 +004200 01 Q PIC S9(10) VALUE 3. IF1284.2 +004300 01 R PIC S9(10) VALUE 5. IF1284.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1284.2 +004500 01 ARR VALUE "40537". IF1284.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1284.2 +004700 01 TEMP PIC S9(10). IF1284.2 +004800 01 WS-INT PIC S9(10). IF1284.2 +004900* IF1284.2 +005000********************************************************** IF1284.2 +005100* IF1284.2 +005200 01 TEST-RESULTS. IF1284.2 +005300 02 FILLER PIC X VALUE SPACE. IF1284.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1284.2 +005500 02 FILLER PIC X VALUE SPACE. IF1284.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1284.2 +005700 02 FILLER PIC X VALUE SPACE. IF1284.2 +005800 02 PAR-NAME. IF1284.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1284.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1284.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1284.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1284.2 +006300 02 RE-MARK PIC X(61). IF1284.2 +006400 01 TEST-COMPUTED. IF1284.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +006600 02 FILLER PIC X(17) VALUE IF1284.2 +006700 " COMPUTED=". IF1284.2 +006800 02 COMPUTED-X. IF1284.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1284.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1284.2 +007100 PIC -9(9).9(9). IF1284.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1284.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1284.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1284.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1284.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1284.2 +007700 04 FILLER PIC X. IF1284.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1284.2 +007900 01 TEST-CORRECT. IF1284.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1284.2 +008200 02 CORRECT-X. IF1284.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1284.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1284.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1284.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1284.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1284.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1284.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1284.2 +009000 04 FILLER PIC X. IF1284.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1284.2 +009300 01 TEST-CORRECT-MIN. IF1284.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +009500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1284.2 +009600 02 CORRECTMI-X. IF1284.2 +009700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1284.2 +009800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1284.2 +009900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1284.2 +010000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1284.2 +010100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1284.2 +010200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1284.2 +010300 04 CORRECTMI-18V0 PIC -9(18). IF1284.2 +010400 04 FILLER PIC X. IF1284.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +010600 03 FILLER PIC X(48) VALUE SPACE. IF1284.2 +010700 01 TEST-CORRECT-MAX. IF1284.2 +010800 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +010900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1284.2 +011000 02 CORRECTMA-X. IF1284.2 +011100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1284.2 +011200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1284.2 +011300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1284.2 +011400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1284.2 +011500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1284.2 +011600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1284.2 +011700 04 CORRECTMA-18V0 PIC -9(18). IF1284.2 +011800 04 FILLER PIC X. IF1284.2 +011900 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +012000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1284.2 +012100 01 CCVS-C-1. IF1284.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1284.2 +012300- "SS PARAGRAPH-NAME IF1284.2 +012400- " REMARKS". IF1284.2 +012500 02 FILLER PIC X(20) VALUE SPACE. IF1284.2 +012600 01 CCVS-C-2. IF1284.2 +012700 02 FILLER PIC X VALUE SPACE. IF1284.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". IF1284.2 +012900 02 FILLER PIC X(15) VALUE SPACE. IF1284.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". IF1284.2 +013100 02 FILLER PIC X(94) VALUE SPACE. IF1284.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1284.2 +013300 01 REC-CT PIC 99 VALUE ZERO. IF1284.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1284.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1284.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1284.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1284.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1284.2 +014300 01 CCVS-H-1. IF1284.2 +014400 02 FILLER PIC X(39) VALUE SPACES. IF1284.2 +014500 02 FILLER PIC X(42) VALUE IF1284.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1284.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1284.2 +014800 01 CCVS-H-2A. IF1284.2 +014900 02 FILLER PIC X(40) VALUE SPACE. IF1284.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1284.2 +015100 02 FILLER PIC XXXX VALUE IF1284.2 +015200 "4.2 ". IF1284.2 +015300 02 FILLER PIC X(28) VALUE IF1284.2 +015400 " COPY - NOT FOR DISTRIBUTION". IF1284.2 +015500 02 FILLER PIC X(41) VALUE SPACE. IF1284.2 +015600 IF1284.2 +015700 01 CCVS-H-2B. IF1284.2 +015800 02 FILLER PIC X(15) VALUE IF1284.2 +015900 "TEST RESULT OF ". IF1284.2 +016000 02 TEST-ID PIC X(9). IF1284.2 +016100 02 FILLER PIC X(4) VALUE IF1284.2 +016200 " IN ". IF1284.2 +016300 02 FILLER PIC X(12) VALUE IF1284.2 +016400 " HIGH ". IF1284.2 +016500 02 FILLER PIC X(22) VALUE IF1284.2 +016600 " LEVEL VALIDATION FOR ". IF1284.2 +016700 02 FILLER PIC X(58) VALUE IF1284.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1284.2 +016900 01 CCVS-H-3. IF1284.2 +017000 02 FILLER PIC X(34) VALUE IF1284.2 +017100 " FOR OFFICIAL USE ONLY ". IF1284.2 +017200 02 FILLER PIC X(58) VALUE IF1284.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1284.2 +017400 02 FILLER PIC X(28) VALUE IF1284.2 +017500 " COPYRIGHT 1985 ". IF1284.2 +017600 01 CCVS-E-1. IF1284.2 +017700 02 FILLER PIC X(52) VALUE SPACE. IF1284.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1284.2 +017900 02 ID-AGAIN PIC X(9). IF1284.2 +018000 02 FILLER PIC X(45) VALUE SPACES. IF1284.2 +018100 01 CCVS-E-2. IF1284.2 +018200 02 FILLER PIC X(31) VALUE SPACE. IF1284.2 +018300 02 FILLER PIC X(21) VALUE SPACE. IF1284.2 +018400 02 CCVS-E-2-2. IF1284.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1284.2 +018600 03 FILLER PIC X VALUE SPACE. IF1284.2 +018700 03 ENDER-DESC PIC X(44) VALUE IF1284.2 +018800 "ERRORS ENCOUNTERED". IF1284.2 +018900 01 CCVS-E-3. IF1284.2 +019000 02 FILLER PIC X(22) VALUE IF1284.2 +019100 " FOR OFFICIAL USE ONLY". IF1284.2 +019200 02 FILLER PIC X(12) VALUE SPACE. IF1284.2 +019300 02 FILLER PIC X(58) VALUE IF1284.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1284.2 +019500 02 FILLER PIC X(13) VALUE SPACE. IF1284.2 +019600 02 FILLER PIC X(15) VALUE IF1284.2 +019700 " COPYRIGHT 1985". IF1284.2 +019800 01 CCVS-E-4. IF1284.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1284.2 +020000 02 FILLER PIC X(4) VALUE " OF ". IF1284.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1284.2 +020200 02 FILLER PIC X(40) VALUE IF1284.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1284.2 +020400 01 XXINFO. IF1284.2 +020500 02 FILLER PIC X(19) VALUE IF1284.2 +020600 "*** INFORMATION ***". IF1284.2 +020700 02 INFO-TEXT. IF1284.2 +020800 04 FILLER PIC X(8) VALUE SPACE. IF1284.2 +020900 04 XXCOMPUTED PIC X(20). IF1284.2 +021000 04 FILLER PIC X(5) VALUE SPACE. IF1284.2 +021100 04 XXCORRECT PIC X(20). IF1284.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). IF1284.2 +021300 01 HYPHEN-LINE. IF1284.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. IF1284.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************IF1284.2 +021600- "*****************************************". IF1284.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************IF1284.2 +021800- "******************************". IF1284.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE IF1284.2 +022000 "IF128A". IF1284.2 +022100 PROCEDURE DIVISION. IF1284.2 +022200 CCVS1 SECTION. IF1284.2 +022300 OPEN-FILES. IF1284.2 +022400 OPEN OUTPUT PRINT-FILE. IF1284.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1284.2 +022600 MOVE SPACE TO TEST-RESULTS. IF1284.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1284.2 +022800 GO TO CCVS1-EXIT. IF1284.2 +022900 CLOSE-FILES. IF1284.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1284.2 +023100 TERMINATE-CCVS. IF1284.2 +023200 STOP RUN. IF1284.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1284.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1284.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1284.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1284.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. IF1284.2 +023800 PRINT-DETAIL. IF1284.2 +023900 IF REC-CT NOT EQUAL TO ZERO IF1284.2 +024000 MOVE "." TO PARDOT-X IF1284.2 +024100 MOVE REC-CT TO DOTVALUE. IF1284.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1284.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1284.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1284.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1284.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1284.2 +024700 MOVE SPACE TO CORRECT-X. IF1284.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1284.2 +024900 MOVE SPACE TO RE-MARK. IF1284.2 +025000 HEAD-ROUTINE. IF1284.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1284.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1284.2 +025500 COLUMN-NAMES-ROUTINE. IF1284.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +025900 END-ROUTINE. IF1284.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1284.2 +026100 END-RTN-EXIT. IF1284.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +026300 END-ROUTINE-1. IF1284.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1284.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1284.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. IF1284.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1284.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1284.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1284.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1284.2 +027100 END-ROUTINE-12. IF1284.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1284.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1284.2 +027400 MOVE "NO " TO ERROR-TOTAL IF1284.2 +027500 ELSE IF1284.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1284.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1284.2 +027800 PERFORM WRITE-LINE. IF1284.2 +027900 END-ROUTINE-13. IF1284.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1284.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE IF1284.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1284.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1284.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO IF1284.2 +028600 MOVE "NO " TO ERROR-TOTAL IF1284.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1284.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1284.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +029100 WRITE-LINE. IF1284.2 +029200 ADD 1 TO RECORD-COUNT. IF1284.2 +029300Y IF RECORD-COUNT GREATER 42 IF1284.2 +029400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1284.2 +029500Y MOVE SPACE TO DUMMY-RECORD IF1284.2 +029600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1284.2 +029700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1284.2 +029800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1284.2 +029900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1284.2 +030000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1284.2 +030100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030400Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1284.2 +030500Y MOVE ZERO TO RECORD-COUNT. IF1284.2 +030600 PERFORM WRT-LN. IF1284.2 +030700 WRT-LN. IF1284.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1284.2 +030900 MOVE SPACE TO DUMMY-RECORD. IF1284.2 +031000 BLANK-LINE-PRINT. IF1284.2 +031100 PERFORM WRT-LN. IF1284.2 +031200 FAIL-ROUTINE. IF1284.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE IF1284.2 +031400 GO TO FAIL-ROUTINE-WRITE. IF1284.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1284.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1284.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1284.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1284.2 +032000 GO TO FAIL-ROUTINE-EX. IF1284.2 +032100 FAIL-ROUTINE-WRITE. IF1284.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1284.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1284.2 +032400 CORMA-ANSI-REFERENCE. IF1284.2 +032500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1284.2 +032600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1284.2 +032700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1284.2 +032800 ELSE IF1284.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1284.2 +033000 PERFORM WRITE-LINE. IF1284.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1284.2 +033200 FAIL-ROUTINE-EX. EXIT. IF1284.2 +033300 BAIL-OUT. IF1284.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1284.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1284.2 +033600 BAIL-OUT-WRITE. IF1284.2 +033700 MOVE CORRECT-A TO XXCORRECT. IF1284.2 +033800 MOVE COMPUTED-A TO XXCOMPUTED. IF1284.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1284.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1284.2 +034200 BAIL-OUT-EX. EXIT. IF1284.2 +034300 CCVS1-EXIT. IF1284.2 +034400 EXIT. IF1284.2 +034500******************************************************** IF1284.2 +034600* * IF1284.2 +034700* Intrinsic Function Tests IF128A - ORD-MAX * IF1284.2 +034800* * IF1284.2 +034900******************************************************** IF1284.2 +035000 SECT-IF128A SECTION. IF1284.2 +035100 F-ORD-MAX-INFO. IF1284.2 +035200 MOVE "See ref. A-61 2.32" TO ANSI-REFERENCE. IF1284.2 +035300 MOVE "ORD-MAX Function" TO FEATURE. IF1284.2 +035400*****************TEST (a) ****************************** IF1284.2 +035500 F-ORD-MAX-01. IF1284.2 +035600 MOVE ZERO TO WS-INT. IF1284.2 +035700 F-ORD-MAX-TEST-01. IF1284.2 +035800 COMPUTE WS-INT = FUNCTION ORD-MAX(5, 3, 2, 8, 3, 1). IF1284.2 +035900 IF WS-INT = 4 THEN IF1284.2 +036000 PERFORM PASS IF1284.2 +036100 ELSE IF1284.2 +036200 MOVE 4 TO CORRECT-N IF1284.2 +036300 MOVE WS-INT TO COMPUTED-N IF1284.2 +036400 PERFORM FAIL. IF1284.2 +036500 GO TO F-ORD-MAX-WRITE-01. IF1284.2 +036600 F-ORD-MAX-DELETE-01. IF1284.2 +036700 PERFORM DE-LETE. IF1284.2 +036800 GO TO F-ORD-MAX-WRITE-01. IF1284.2 +036900 F-ORD-MAX-WRITE-01. IF1284.2 +037000 MOVE "F-ORD-MAX-01" TO PAR-NAME. IF1284.2 +037100 PERFORM PRINT-DETAIL. IF1284.2 +037200*****************TEST (b) ****************************** IF1284.2 +037300 F-ORD-MAX-TEST-02. IF1284.2 +037400 EVALUATE FUNCTION ORD-MAX(3, 2, 7, 1, 5) IF1284.2 +037500 WHEN 3 IF1284.2 +037600 PERFORM PASS IF1284.2 +037700 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +037800 PERFORM FAIL. IF1284.2 +037900 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +038000 F-ORD-MAX-DELETE-02. IF1284.2 +038100 PERFORM DE-LETE. IF1284.2 +038200 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +038300 F-ORD-MAX-WRITE-02. IF1284.2 +038400 MOVE "F-ORD-MAX-02" TO PAR-NAME. IF1284.2 +038500 PERFORM PRINT-DETAIL. IF1284.2 +038600*****************TEST (c) ****************************** IF1284.2 +038700 F-ORD-MAX-03. IF1284.2 +038800 MOVE ZERO TO WS-INT. IF1284.2 +038900 F-ORD-MAX-TEST-03. IF1284.2 +039000 IF FUNCTION ORD-MAX(A, B, D) = 3 THEN IF1284.2 +039100 PERFORM PASS IF1284.2 +039200 ELSE IF1284.2 +039300 PERFORM FAIL. IF1284.2 +039400 GO TO F-ORD-MAX-WRITE-03. IF1284.2 +039500 F-ORD-MAX-DELETE-03. IF1284.2 +039600 PERFORM DE-LETE. IF1284.2 +039700 GO TO F-ORD-MAX-WRITE-03. IF1284.2 +039800 F-ORD-MAX-WRITE-03. IF1284.2 +039900 MOVE "F-ORD-MAX-03" TO PAR-NAME. IF1284.2 +040000 PERFORM PRINT-DETAIL. IF1284.2 +040100*****************TEST (d) ****************************** IF1284.2 +040200 F-ORD-MAX-04. IF1284.2 +040300 MOVE ZERO TO WS-INT. IF1284.2 +040400 F-ORD-MAX-TEST-04. IF1284.2 +040500 COMPUTE WS-INT = FUNCTION ORD-MAX(A, B, C). IF1284.2 +040600 IF WS-INT = 2 THEN IF1284.2 +040700 PERFORM PASS IF1284.2 +040800 ELSE IF1284.2 +040900 MOVE 2 TO CORRECT-N IF1284.2 +041000 MOVE WS-INT TO COMPUTED-N IF1284.2 +041100 PERFORM FAIL. IF1284.2 +041200 GO TO F-ORD-MAX-WRITE-04. IF1284.2 +041300 F-ORD-MAX-DELETE-04. IF1284.2 +041400 PERFORM DE-LETE. IF1284.2 +041500 GO TO F-ORD-MAX-WRITE-04. IF1284.2 +041600 F-ORD-MAX-WRITE-04. IF1284.2 +041700 MOVE "F-ORD-MAX-04" TO PAR-NAME. IF1284.2 +041800 PERFORM PRINT-DETAIL. IF1284.2 +041900*****************TEST (e) ****************************** IF1284.2 +042000 F-ORD-MAX-05. IF1284.2 +042100 MOVE ZERO TO WS-INT. IF1284.2 +042200 F-ORD-MAX-TEST-05. IF1284.2 +042300 COMPUTE WS-INT = FUNCTION ORD-MAX(A, 4, B, 7, C, 9). IF1284.2 +042400 IF WS-INT = 6 THEN IF1284.2 +042500 PERFORM PASS IF1284.2 +042600 ELSE IF1284.2 +042700 MOVE 6 TO CORRECT-N IF1284.2 +042800 MOVE WS-INT TO COMPUTED-N IF1284.2 +042900 PERFORM FAIL. IF1284.2 +043000 GO TO F-ORD-MAX-WRITE-05. IF1284.2 +043100 F-ORD-MAX-DELETE-05. IF1284.2 +043200 PERFORM DE-LETE. IF1284.2 +043300 GO TO F-ORD-MAX-WRITE-05. IF1284.2 +043400 F-ORD-MAX-WRITE-05. IF1284.2 +043500 MOVE "F-ORD-MAX-05" TO PAR-NAME. IF1284.2 +043600 PERFORM PRINT-DETAIL. IF1284.2 +043700*****************TEST (f) ****************************** IF1284.2 +043800 F-ORD-MAX-06. IF1284.2 +043900 MOVE ZERO TO WS-INT. IF1284.2 +044000 F-ORD-MAX-TEST-06. IF1284.2 +044100 COMPUTE WS-INT = FUNCTION ORD-MAX(4, 9, A, 3). IF1284.2 +044200 IF WS-INT = 2 THEN IF1284.2 +044300 PERFORM PASS IF1284.2 +044400 ELSE IF1284.2 +044500 MOVE 2 TO CORRECT-N IF1284.2 +044600 MOVE WS-INT TO COMPUTED-N IF1284.2 +044700 PERFORM FAIL. IF1284.2 +044800 GO TO F-ORD-MAX-WRITE-06. IF1284.2 +044900 F-ORD-MAX-DELETE-06. IF1284.2 +045000 PERFORM DE-LETE. IF1284.2 +045100 GO TO F-ORD-MAX-WRITE-06. IF1284.2 +045200 F-ORD-MAX-WRITE-06. IF1284.2 +045300 MOVE "F-ORD-MAX-06" TO PAR-NAME. IF1284.2 +045400 PERFORM PRINT-DETAIL. IF1284.2 +045500*****************TEST (g) ****************************** IF1284.2 +045600 F-ORD-MAX-07. IF1284.2 +045700 MOVE ZERO TO WS-INT. IF1284.2 +045800 F-ORD-MAX-TEST-07. IF1284.2 +045900 COMPUTE WS-INT = FUNCTION ORD-MAX("A", I, "P"). IF1284.2 +046000 IF WS-INT = 2 THEN IF1284.2 +046100 PERFORM PASS IF1284.2 +046200 ELSE IF1284.2 +046300 MOVE 2 TO CORRECT-N IF1284.2 +046400 MOVE WS-INT TO COMPUTED-N IF1284.2 +046500 PERFORM FAIL. IF1284.2 +046600 GO TO F-ORD-MAX-WRITE-07. IF1284.2 +046700 F-ORD-MAX-DELETE-07. IF1284.2 +046800 PERFORM DE-LETE. IF1284.2 +046900 GO TO F-ORD-MAX-WRITE-07. IF1284.2 +047000 F-ORD-MAX-WRITE-07. IF1284.2 +047100 MOVE "F-ORD-MAX-07" TO PAR-NAME. IF1284.2 +047200 PERFORM PRINT-DETAIL. IF1284.2 +047300*****************TEST (h) ****************************** IF1284.2 +047400 F-ORD-MAX-08. IF1284.2 +047500 MOVE ZERO TO WS-INT. IF1284.2 +047600 F-ORD-MAX-TEST-08. IF1284.2 +047700 COMPUTE WS-INT = FUNCTION ORD-MAX("S", "D", J). IF1284.2 +047800 IF WS-INT = 3 THEN IF1284.2 +047900 PERFORM PASS IF1284.2 +048000 ELSE IF1284.2 +048100 MOVE 3 TO CORRECT-N IF1284.2 +048200 MOVE WS-INT TO COMPUTED-N IF1284.2 +048300 PERFORM FAIL. IF1284.2 +048400 GO TO F-ORD-MAX-WRITE-08. IF1284.2 +048500 F-ORD-MAX-DELETE-08. IF1284.2 +048600 PERFORM DE-LETE. IF1284.2 +048700 GO TO F-ORD-MAX-WRITE-08. IF1284.2 +048800 F-ORD-MAX-WRITE-08. IF1284.2 +048900 MOVE "F-ORD-MAX-08" TO PAR-NAME. IF1284.2 +049000 PERFORM PRINT-DETAIL. IF1284.2 +049100*****************TEST (i) ****************************** IF1284.2 +049200 F-ORD-MAX-09. IF1284.2 +049300 MOVE ZERO TO WS-INT. IF1284.2 +049400 F-ORD-MAX-TEST-09. IF1284.2 +049500 COMPUTE WS-INT = FUNCTION ORD-MAX(A, 5, 5, A). IF1284.2 +049600 IF WS-INT = 1 THEN IF1284.2 +049700 PERFORM PASS IF1284.2 +049800 ELSE IF1284.2 +049900 MOVE 1 TO CORRECT-N IF1284.2 +050000 MOVE WS-INT TO COMPUTED-N IF1284.2 +050100 PERFORM FAIL. IF1284.2 +050200 GO TO F-ORD-MAX-WRITE-09. IF1284.2 +050300 F-ORD-MAX-DELETE-09. IF1284.2 +050400 PERFORM DE-LETE. IF1284.2 +050500 GO TO F-ORD-MAX-WRITE-09. IF1284.2 +050600 F-ORD-MAX-WRITE-09. IF1284.2 +050700 MOVE "F-ORD-MAX-09" TO PAR-NAME. IF1284.2 +050800 PERFORM PRINT-DETAIL. IF1284.2 +050900*****************TEST (j) ****************************** IF1284.2 +051000 F-ORD-MAX-10. IF1284.2 +051100 MOVE ZERO TO WS-INT. IF1284.2 +051200 F-ORD-MAX-TEST-10. IF1284.2 +051300 COMPUTE WS-INT = FUNCTION ORD-MAX(IND(1), IND(2), IND(3)). IF1284.2 +051400 IF WS-INT = 3 THEN IF1284.2 +051500 PERFORM PASS IF1284.2 +051600 ELSE IF1284.2 +051700 MOVE 3 TO CORRECT-N IF1284.2 +051800 MOVE WS-INT TO COMPUTED-N IF1284.2 +051900 PERFORM FAIL. IF1284.2 +052000 GO TO F-ORD-MAX-WRITE-10. IF1284.2 +052100 F-ORD-MAX-DELETE-10. IF1284.2 +052200 PERFORM DE-LETE. IF1284.2 +052300 GO TO F-ORD-MAX-WRITE-10. IF1284.2 +052400 F-ORD-MAX-WRITE-10. IF1284.2 +052500 MOVE "F-ORD-MAX-10" TO PAR-NAME. IF1284.2 +052600 PERFORM PRINT-DETAIL. IF1284.2 +052700*****************TEST (k) ****************************** IF1284.2 +052800 F-ORD-MAX-11. IF1284.2 +052900 MOVE ZERO TO WS-INT. IF1284.2 +053000 F-ORD-MAX-TEST-11. IF1284.2 +053100 COMPUTE WS-INT = FUNCTION ORD-MAX(IND(R), IND(P), IND(Q)). IF1284.2 +053200 IF WS-INT = 1 THEN IF1284.2 +053300 PERFORM PASS IF1284.2 +053400 ELSE IF1284.2 +053500 MOVE 1 TO CORRECT-N IF1284.2 +053600 MOVE WS-INT TO COMPUTED-N IF1284.2 +053700 PERFORM FAIL. IF1284.2 +053800 GO TO F-ORD-MAX-WRITE-11. IF1284.2 +053900 F-ORD-MAX-DELETE-11. IF1284.2 +054000 PERFORM DE-LETE. IF1284.2 +054100 GO TO F-ORD-MAX-WRITE-11. IF1284.2 +054200 F-ORD-MAX-WRITE-11. IF1284.2 +054300 MOVE "F-ORD-MAX-11" TO PAR-NAME. IF1284.2 +054400 PERFORM PRINT-DETAIL. IF1284.2 +054500*****************TEST (l) ****************************** IF1284.2 +054600 F-ORD-MAX-12. IF1284.2 +054700 MOVE ZERO TO WS-INT. IF1284.2 +054800 F-ORD-MAX-TEST-12. IF1284.2 +054900 COMPUTE WS-INT = FUNCTION ORD-MAX(IND(ALL)). IF1284.2 +055000 IF WS-INT = 5 THEN IF1284.2 +055100 PERFORM PASS IF1284.2 +055200 ELSE IF1284.2 +055300 MOVE 5 TO CORRECT-N IF1284.2 +055400 MOVE WS-INT TO COMPUTED-N IF1284.2 +055500 PERFORM FAIL. IF1284.2 +055600 GO TO F-ORD-MAX-WRITE-12. IF1284.2 +055700 F-ORD-MAX-DELETE-12. IF1284.2 +055800 PERFORM DE-LETE. IF1284.2 +055900 GO TO F-ORD-MAX-WRITE-12. IF1284.2 +056000 F-ORD-MAX-WRITE-12. IF1284.2 +056100 MOVE "F-ORD-MAX-12" TO PAR-NAME. IF1284.2 +056200 PERFORM PRINT-DETAIL. IF1284.2 +056300*****************TEST (m) ****************************** IF1284.2 +056400 F-ORD-MAX-13. IF1284.2 +056500 MOVE ZERO TO WS-INT. IF1284.2 +056600 F-ORD-MAX-TEST-13. IF1284.2 +056700 COMPUTE WS-INT = FUNCTION ORD-MAX( IF1284.2 +056800 FUNCTION ORD-MAX(1, 4), 3, 1). IF1284.2 +056900 IF WS-INT = 2 THEN IF1284.2 +057000 PERFORM PASS IF1284.2 +057100 ELSE IF1284.2 +057200 MOVE 2 TO CORRECT-N IF1284.2 +057300 MOVE WS-INT TO COMPUTED-N IF1284.2 +057400 PERFORM FAIL. IF1284.2 +057500 GO TO F-ORD-MAX-WRITE-13. IF1284.2 +057600 F-ORD-MAX-DELETE-13. IF1284.2 +057700 PERFORM DE-LETE. IF1284.2 +057800 GO TO F-ORD-MAX-WRITE-13. IF1284.2 +057900 F-ORD-MAX-WRITE-13. IF1284.2 +058000 MOVE "F-ORD-MAX-13" TO PAR-NAME. IF1284.2 +058100 PERFORM PRINT-DETAIL. IF1284.2 +058200*****************TEST (n) ****************************** IF1284.2 +058300 F-ORD-MAX-14. IF1284.2 +058400 MOVE ZERO TO WS-INT. IF1284.2 +058500 F-ORD-MAX-TEST-14. IF1284.2 +058600 COMPUTE WS-INT = FUNCTION ORD-MAX(2, 3, C) + A. IF1284.2 +058700 IF WS-INT = 8 THEN IF1284.2 +058800 PERFORM PASS IF1284.2 +058900 ELSE IF1284.2 +059000 MOVE 8 TO CORRECT-N IF1284.2 +059100 MOVE WS-INT TO COMPUTED-N IF1284.2 +059200 PERFORM FAIL. IF1284.2 +059300 GO TO F-ORD-MAX-WRITE-14. IF1284.2 +059400 F-ORD-MAX-DELETE-14. IF1284.2 +059500 PERFORM DE-LETE. IF1284.2 +059600 GO TO F-ORD-MAX-WRITE-14. IF1284.2 +059700 F-ORD-MAX-WRITE-14. IF1284.2 +059800 MOVE "F-ORD-MAX-14" TO PAR-NAME. IF1284.2 +059900 PERFORM PRINT-DETAIL. IF1284.2 +060000*****************TEST (o) ****************************** IF1284.2 +060100 F-ORD-MAX-15. IF1284.2 +060200 MOVE ZERO TO WS-INT. IF1284.2 +060300 F-ORD-MAX-TEST-15. IF1284.2 +060400 COMPUTE WS-INT = FUNCTION ORD-MAX(2, 3, A) + IF1284.2 +060500 FUNCTION ORD-MAX(1, 1). IF1284.2 +060600 IF WS-INT = 4 THEN IF1284.2 +060700 PERFORM PASS IF1284.2 +060800 ELSE IF1284.2 +060900 MOVE 4 TO CORRECT-N IF1284.2 +061000 MOVE WS-INT TO COMPUTED-N IF1284.2 +061100 PERFORM FAIL. IF1284.2 +061200 GO TO F-ORD-MAX-WRITE-15. IF1284.2 +061300 F-ORD-MAX-DELETE-15. IF1284.2 +061400 PERFORM DE-LETE. IF1284.2 +061500 GO TO F-ORD-MAX-WRITE-15. IF1284.2 +061600 F-ORD-MAX-WRITE-15. IF1284.2 +061700 MOVE "F-ORD-MAX-15" TO PAR-NAME. IF1284.2 +061800 PERFORM PRINT-DETAIL. IF1284.2 +061900*****************SPECIAL TEST 1****************************** IF1284.2 +062000 F-ORD-MAX-16. IF1284.2 +062100 MOVE 1 TO ARG1 IF1284.2 +062200 PERFORM F-ORD-MAX-TEST-16 IF1284.2 +062300 UNTIL FUNCTION ORD-MAX (5, ARG1) = 2. IF1284.2 +062400* IF1284.2 +062500** when ARG1 = 6 , ORD-MAX(5,ARG1) = 2 IF1284.2 +062600* IF1284.2 +062700 IF ARG1 = 6 THEN IF1284.2 +062800 PERFORM PASS IF1284.2 +062900 ELSE IF1284.2 +063000 MOVE 6 TO CORRECT-N IF1284.2 +063100 MOVE WS-INT TO COMPUTED-N IF1284.2 +063200 PERFORM FAIL. IF1284.2 +063300 GO TO F-ORD-MAX-WRITE-16. IF1284.2 +063400* IF1284.2 +063500 F-ORD-MAX-TEST-16. IF1284.2 +063600 COMPUTE ARG1 = ARG1 + 1. IF1284.2 +063700* IF1284.2 +063800 F-ORD-MAX-DELETE-16. IF1284.2 +063900 PERFORM DE-LETE. IF1284.2 +064000 GO TO F-ORD-MAX-WRITE-16. IF1284.2 +064100 F-ORD-MAX-WRITE-16. IF1284.2 +064200 MOVE "F-ORD-MAX-16" TO PAR-NAME. IF1284.2 +064300 PERFORM PRINT-DETAIL. IF1284.2 +064400*******************END OF TESTS************************** IF1284.2 +064500 CCVS-EXIT SECTION. IF1284.2 +064600 CCVS-999999. IF1284.2 +064700 GO TO CLOSE-FILES. IF1284.2 +*END-OF,IF128A +*HEADER,COBOL,IF129A +000100 IDENTIFICATION DIVISION. IF1294.2 +000200 PROGRAM-ID. IF1294.2 +000300 IF129A. IF1294.2 +000400 IF1294.2 +000500*********************************************************** IF1294.2 +000600* * IF1294.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1294.2 +000800* It contains tests for the Intrinsic Function ORD-MIN. * IF1294.2 +000900* * IF1294.2 +001000* * IF1294.2 +001100*********************************************************** IF1294.2 +001200 ENVIRONMENT DIVISION. IF1294.2 +001300 CONFIGURATION SECTION. IF1294.2 +001400 SOURCE-COMPUTER. IF1294.2 +001500 XXXXX082. IF1294.2 +001600 OBJECT-COMPUTER. IF1294.2 +001700 XXXXX083 IF1294.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1294.2 +001900 SPECIAL-NAMES. IF1294.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1294.2 +002100 STANDARD-2. IF1294.2 +002200 INPUT-OUTPUT SECTION. IF1294.2 +002300 FILE-CONTROL. IF1294.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1294.2 +002500 XXXXX055. IF1294.2 +002600 DATA DIVISION. IF1294.2 +002700 FILE SECTION. IF1294.2 +002800 FD PRINT-FILE. IF1294.2 +002900 01 PRINT-REC PICTURE X(120). IF1294.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1294.2 +003100 WORKING-STORAGE SECTION. IF1294.2 +003200*********************************************************** IF1294.2 +003300* Variables specific to the Intrinsic Function Test IF129A* IF1294.2 +003400*********************************************************** IF1294.2 +003500 01 A PIC S9(10) VALUE 5. IF1294.2 +003600 01 B PIC S9(10) VALUE 7. IF1294.2 +003700 01 C PIC S9(10) VALUE 4. IF1294.2 +003800 01 D PIC S9(10) VALUE 10. IF1294.2 +003900 01 I PIC X(4) VALUE "R". IF1294.2 +004000 01 J PIC X(4) VALUE "U". IF1294.2 +004100 01 P PIC S9(10) VALUE 1. IF1294.2 +004200 01 Q PIC S9(10) VALUE 3. IF1294.2 +004300 01 R PIC S9(10) VALUE 5. IF1294.2 +004400 01 ARG1 PIC S9(10) VALUE 10. IF1294.2 +004500 01 ARR VALUE "40537". IF1294.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1294.2 +004700 01 TEMP PIC S9(10). IF1294.2 +004800 01 WS-INT PIC S9(10). IF1294.2 +004900* IF1294.2 +005000********************************************************** IF1294.2 +005100* IF1294.2 +005200 01 TEST-RESULTS. IF1294.2 +005300 02 FILLER PIC X VALUE SPACE. IF1294.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1294.2 +005500 02 FILLER PIC X VALUE SPACE. IF1294.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1294.2 +005700 02 FILLER PIC X VALUE SPACE. IF1294.2 +005800 02 PAR-NAME. IF1294.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1294.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1294.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1294.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1294.2 +006300 02 RE-MARK PIC X(61). IF1294.2 +006400 01 TEST-COMPUTED. IF1294.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1294.2 +006600 02 FILLER PIC X(17) VALUE IF1294.2 +006700 " COMPUTED=". IF1294.2 +006800 02 COMPUTED-X. IF1294.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1294.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1294.2 +007100 PIC -9(9).9(9). IF1294.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1294.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1294.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1294.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1294.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1294.2 +007700 04 FILLER PIC X. IF1294.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1294.2 +007900 01 TEST-CORRECT. IF1294.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1294.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1294.2 +008200 02 CORRECT-X. IF1294.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1294.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1294.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1294.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1294.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1294.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1294.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1294.2 +009000 04 FILLER PIC X. IF1294.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1294.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1294.2 +009300 01 CCVS-C-1. IF1294.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1294.2 +009500- "SS PARAGRAPH-NAME IF1294.2 +009600- " REMARKS". IF1294.2 +009700 02 FILLER PIC X(20) VALUE SPACE. IF1294.2 +009800 01 CCVS-C-2. IF1294.2 +009900 02 FILLER PIC X VALUE SPACE. IF1294.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". IF1294.2 +010100 02 FILLER PIC X(15) VALUE SPACE. IF1294.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". IF1294.2 +010300 02 FILLER PIC X(94) VALUE SPACE. IF1294.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1294.2 +010500 01 REC-CT PIC 99 VALUE ZERO. IF1294.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1294.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1294.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1294.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1294.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1294.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1294.2 +011500 01 CCVS-H-1. IF1294.2 +011600 02 FILLER PIC X(39) VALUE SPACES. IF1294.2 +011700 02 FILLER PIC X(42) VALUE IF1294.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1294.2 +011900 02 FILLER PIC X(39) VALUE SPACES. IF1294.2 +012000 01 CCVS-H-2A. IF1294.2 +012100 02 FILLER PIC X(40) VALUE SPACE. IF1294.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1294.2 +012300 02 FILLER PIC XXXX VALUE IF1294.2 +012400 "4.2 ". IF1294.2 +012500 02 FILLER PIC X(28) VALUE IF1294.2 +012600 " COPY - NOT FOR DISTRIBUTION". IF1294.2 +012700 02 FILLER PIC X(41) VALUE SPACE. IF1294.2 +012800 IF1294.2 +012900 01 CCVS-H-2B. IF1294.2 +013000 02 FILLER PIC X(15) VALUE IF1294.2 +013100 "TEST RESULT OF ". IF1294.2 +013200 02 TEST-ID PIC X(9). IF1294.2 +013300 02 FILLER PIC X(4) VALUE IF1294.2 +013400 " IN ". IF1294.2 +013500 02 FILLER PIC X(12) VALUE IF1294.2 +013600 " HIGH ". IF1294.2 +013700 02 FILLER PIC X(22) VALUE IF1294.2 +013800 " LEVEL VALIDATION FOR ". IF1294.2 +013900 02 FILLER PIC X(58) VALUE IF1294.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1294.2 +014100 01 CCVS-H-3. IF1294.2 +014200 02 FILLER PIC X(34) VALUE IF1294.2 +014300 " FOR OFFICIAL USE ONLY ". IF1294.2 +014400 02 FILLER PIC X(58) VALUE IF1294.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1294.2 +014600 02 FILLER PIC X(28) VALUE IF1294.2 +014700 " COPYRIGHT 1985 ". IF1294.2 +014800 01 CCVS-E-1. IF1294.2 +014900 02 FILLER PIC X(52) VALUE SPACE. IF1294.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1294.2 +015100 02 ID-AGAIN PIC X(9). IF1294.2 +015200 02 FILLER PIC X(45) VALUE SPACES. IF1294.2 +015300 01 CCVS-E-2. IF1294.2 +015400 02 FILLER PIC X(31) VALUE SPACE. IF1294.2 +015500 02 FILLER PIC X(21) VALUE SPACE. IF1294.2 +015600 02 CCVS-E-2-2. IF1294.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1294.2 +015800 03 FILLER PIC X VALUE SPACE. IF1294.2 +015900 03 ENDER-DESC PIC X(44) VALUE IF1294.2 +016000 "ERRORS ENCOUNTERED". IF1294.2 +016100 01 CCVS-E-3. IF1294.2 +016200 02 FILLER PIC X(22) VALUE IF1294.2 +016300 " FOR OFFICIAL USE ONLY". IF1294.2 +016400 02 FILLER PIC X(12) VALUE SPACE. IF1294.2 +016500 02 FILLER PIC X(58) VALUE IF1294.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1294.2 +016700 02 FILLER PIC X(13) VALUE SPACE. IF1294.2 +016800 02 FILLER PIC X(15) VALUE IF1294.2 +016900 " COPYRIGHT 1985". IF1294.2 +017000 01 CCVS-E-4. IF1294.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1294.2 +017200 02 FILLER PIC X(4) VALUE " OF ". IF1294.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1294.2 +017400 02 FILLER PIC X(40) VALUE IF1294.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1294.2 +017600 01 XXINFO. IF1294.2 +017700 02 FILLER PIC X(19) VALUE IF1294.2 +017800 "*** INFORMATION ***". IF1294.2 +017900 02 INFO-TEXT. IF1294.2 +018000 04 FILLER PIC X(8) VALUE SPACE. IF1294.2 +018100 04 XXCOMPUTED PIC X(20). IF1294.2 +018200 04 FILLER PIC X(5) VALUE SPACE. IF1294.2 +018300 04 XXCORRECT PIC X(20). IF1294.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). IF1294.2 +018500 01 HYPHEN-LINE. IF1294.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. IF1294.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************IF1294.2 +018800- "*****************************************". IF1294.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************IF1294.2 +019000- "******************************". IF1294.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE IF1294.2 +019200 "IF129A". IF1294.2 +019300 PROCEDURE DIVISION. IF1294.2 +019400 CCVS1 SECTION. IF1294.2 +019500 OPEN-FILES. IF1294.2 +019600 OPEN OUTPUT PRINT-FILE. IF1294.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1294.2 +019800 MOVE SPACE TO TEST-RESULTS. IF1294.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1294.2 +020000 GO TO CCVS1-EXIT. IF1294.2 +020100 CLOSE-FILES. IF1294.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1294.2 +020300 TERMINATE-CCVS. IF1294.2 +020400 STOP RUN. IF1294.2 +020500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1294.2 +020600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1294.2 +020700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1294.2 +020800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1294.2 +020900 MOVE "****TEST DELETED****" TO RE-MARK. IF1294.2 +021000 PRINT-DETAIL. IF1294.2 +021100 IF REC-CT NOT EQUAL TO ZERO IF1294.2 +021200 MOVE "." TO PARDOT-X IF1294.2 +021300 MOVE REC-CT TO DOTVALUE. IF1294.2 +021400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1294.2 +021500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1294.2 +021600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1294.2 +021700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1294.2 +021800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1294.2 +021900 MOVE SPACE TO CORRECT-X. IF1294.2 +022000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1294.2 +022100 MOVE SPACE TO RE-MARK. IF1294.2 +022200 HEAD-ROUTINE. IF1294.2 +022300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +022400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +022500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1294.2 +022600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1294.2 +022700 COLUMN-NAMES-ROUTINE. IF1294.2 +022800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +022900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +023000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +023100 END-ROUTINE. IF1294.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1294.2 +023300 END-RTN-EXIT. IF1294.2 +023400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +023500 END-ROUTINE-1. IF1294.2 +023600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1294.2 +023700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1294.2 +023800 ADD PASS-COUNTER TO ERROR-HOLD. IF1294.2 +023900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1294.2 +024000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1294.2 +024100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1294.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1294.2 +024300 END-ROUTINE-12. IF1294.2 +024400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1294.2 +024500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1294.2 +024600 MOVE "NO " TO ERROR-TOTAL IF1294.2 +024700 ELSE IF1294.2 +024800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1294.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1294.2 +025000 PERFORM WRITE-LINE. IF1294.2 +025100 END-ROUTINE-13. IF1294.2 +025200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1294.2 +025300 MOVE "NO " TO ERROR-TOTAL ELSE IF1294.2 +025400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1294.2 +025500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1294.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +025700 IF INSPECT-COUNTER EQUAL TO ZERO IF1294.2 +025800 MOVE "NO " TO ERROR-TOTAL IF1294.2 +025900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1294.2 +026000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1294.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +026200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +026300 WRITE-LINE. IF1294.2 +026400 ADD 1 TO RECORD-COUNT. IF1294.2 +026500Y IF RECORD-COUNT GREATER 42 IF1294.2 +026600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1294.2 +026700Y MOVE SPACE TO DUMMY-RECORD IF1294.2 +026800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1294.2 +026900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1294.2 +027000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1294.2 +027100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1294.2 +027200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1294.2 +027300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1294.2 +027700Y MOVE ZERO TO RECORD-COUNT. IF1294.2 +027800 PERFORM WRT-LN. IF1294.2 +027900 WRT-LN. IF1294.2 +028000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1294.2 +028100 MOVE SPACE TO DUMMY-RECORD. IF1294.2 +028200 BLANK-LINE-PRINT. IF1294.2 +028300 PERFORM WRT-LN. IF1294.2 +028400 FAIL-ROUTINE. IF1294.2 +028500 IF COMPUTED-X NOT EQUAL TO SPACE IF1294.2 +028600 GO TO FAIL-ROUTINE-WRITE. IF1294.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1294.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1294.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1294.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1294.2 +029200 GO TO FAIL-ROUTINE-EX. IF1294.2 +029300 FAIL-ROUTINE-WRITE. IF1294.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1294.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1294.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1294.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1294.2 +029800 FAIL-ROUTINE-EX. EXIT. IF1294.2 +029900 BAIL-OUT. IF1294.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1294.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1294.2 +030200 BAIL-OUT-WRITE. IF1294.2 +030300 MOVE CORRECT-A TO XXCORRECT. IF1294.2 +030400 MOVE COMPUTED-A TO XXCOMPUTED. IF1294.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1294.2 +030600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +030700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1294.2 +030800 BAIL-OUT-EX. EXIT. IF1294.2 +030900 CCVS1-EXIT. IF1294.2 +031000 EXIT. IF1294.2 +031100******************************************************** IF1294.2 +031200* * IF1294.2 +031300* Intrinsic Function Tests IF129A - ORD-MIN * IF1294.2 +031400* * IF1294.2 +031500******************************************************** IF1294.2 +031600 SECT-IF129A SECTION. IF1294.2 +031700 F-ORD-MIN-INFO. IF1294.2 +031800 MOVE "See ref. A-62 2.33" TO ANSI-REFERENCE. IF1294.2 +031900 MOVE "ORD-MIN Function" TO FEATURE. IF1294.2 +032000*****************TEST (a) ****************************** IF1294.2 +032100 F-ORD-MIN-01. IF1294.2 +032200 MOVE ZERO TO WS-INT. IF1294.2 +032300 F-ORD-MIN-TEST-01. IF1294.2 +032400 COMPUTE WS-INT = FUNCTION ORD-MIN(5, 3, 2, 8, 3, 1). IF1294.2 +032500 IF WS-INT = 6 THEN IF1294.2 +032600 PERFORM PASS IF1294.2 +032700 ELSE IF1294.2 +032800 MOVE 6 TO CORRECT-N IF1294.2 +032900 MOVE WS-INT TO COMPUTED-N IF1294.2 +033000 PERFORM FAIL. IF1294.2 +033100 GO TO F-ORD-MIN-WRITE-01. IF1294.2 +033200 F-ORD-MIN-DELETE-01. IF1294.2 +033300 PERFORM DE-LETE. IF1294.2 +033400 GO TO F-ORD-MIN-WRITE-01. IF1294.2 +033500 F-ORD-MIN-WRITE-01. IF1294.2 +033600 MOVE "F-ORD-MIN-01" TO PAR-NAME. IF1294.2 +033700 PERFORM PRINT-DETAIL. IF1294.2 +033800*****************TEST (b) ****************************** IF1294.2 +033900 F-ORD-MIN-TEST-02. IF1294.2 +034000 EVALUATE FUNCTION ORD-MIN(3, 2, 7, 1, 5) IF1294.2 +034100 WHEN 4 IF1294.2 +034200 PERFORM PASS IF1294.2 +034300 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034400 PERFORM FAIL. IF1294.2 +034500 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034600 F-ORD-MIN-DELETE-02. IF1294.2 +034700 PERFORM DE-LETE. IF1294.2 +034800 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034900 F-ORD-MIN-WRITE-02. IF1294.2 +035000 MOVE "F-ORD-MIN-02" TO PAR-NAME. IF1294.2 +035100 PERFORM PRINT-DETAIL. IF1294.2 +035200*****************TEST (c) ****************************** IF1294.2 +035300 F-ORD-MIN-03. IF1294.2 +035400 MOVE ZERO TO WS-INT. IF1294.2 +035500 F-ORD-MIN-TEST-03. IF1294.2 +035600 IF FUNCTION ORD-MIN(5, 4, 3, 6, 2, 8) = 5 IF1294.2 +035700 PERFORM PASS IF1294.2 +035800 ELSE IF1294.2 +035900 PERFORM FAIL. IF1294.2 +036000 GO TO F-ORD-MIN-WRITE-03. IF1294.2 +036100 F-ORD-MIN-DELETE-03. IF1294.2 +036200 PERFORM DE-LETE. IF1294.2 +036300 GO TO F-ORD-MIN-WRITE-03. IF1294.2 +036400 F-ORD-MIN-WRITE-03. IF1294.2 +036500 MOVE "F-ORD-MIN-03" TO PAR-NAME. IF1294.2 +036600 PERFORM PRINT-DETAIL. IF1294.2 +036700*****************TEST (d) ****************************** IF1294.2 +036800 F-ORD-MIN-04. IF1294.2 +036900 MOVE ZERO TO WS-INT. IF1294.2 +037000 F-ORD-MIN-TEST-04. IF1294.2 +037100 COMPUTE WS-INT = FUNCTION ORD-MIN(A, B, C). IF1294.2 +037200 IF WS-INT = 3 THEN IF1294.2 +037300 PERFORM PASS IF1294.2 +037400 ELSE IF1294.2 +037500 MOVE 3 TO CORRECT-N IF1294.2 +037600 MOVE WS-INT TO COMPUTED-N IF1294.2 +037700 PERFORM FAIL. IF1294.2 +037800 GO TO F-ORD-MIN-WRITE-04. IF1294.2 +037900 F-ORD-MIN-DELETE-04. IF1294.2 +038000 PERFORM DE-LETE. IF1294.2 +038100 GO TO F-ORD-MIN-WRITE-04. IF1294.2 +038200 F-ORD-MIN-WRITE-04. IF1294.2 +038300 MOVE "F-ORD-MIN-04" TO PAR-NAME. IF1294.2 +038400 PERFORM PRINT-DETAIL. IF1294.2 +038500*****************TEST (e) ****************************** IF1294.2 +038600 F-ORD-MIN-05. IF1294.2 +038700 MOVE ZERO TO WS-INT. IF1294.2 +038800 F-ORD-MIN-TEST-05. IF1294.2 +038900 COMPUTE WS-INT = FUNCTION ORD-MIN(A, B, D). IF1294.2 +039000 IF WS-INT = 1 THEN IF1294.2 +039100 PERFORM PASS IF1294.2 +039200 ELSE IF1294.2 +039300 MOVE 1 TO CORRECT-N IF1294.2 +039400 MOVE WS-INT TO COMPUTED-N IF1294.2 +039500 PERFORM FAIL. IF1294.2 +039600 GO TO F-ORD-MIN-WRITE-05. IF1294.2 +039700 F-ORD-MIN-DELETE-05. IF1294.2 +039800 PERFORM DE-LETE. IF1294.2 +039900 GO TO F-ORD-MIN-WRITE-05. IF1294.2 +040000 F-ORD-MIN-WRITE-05. IF1294.2 +040100 MOVE "F-ORD-MIN-05" TO PAR-NAME. IF1294.2 +040200 PERFORM PRINT-DETAIL. IF1294.2 +040300*****************TEST (f) ****************************** IF1294.2 +040400 F-ORD-MIN-06. IF1294.2 +040500 MOVE ZERO TO WS-INT. IF1294.2 +040600 F-ORD-MIN-TEST-06. IF1294.2 +040700 COMPUTE WS-INT = FUNCTION ORD-MIN(A, 4, B, 7, 1, 9). IF1294.2 +040800 IF WS-INT = 5 THEN IF1294.2 +040900 PERFORM PASS IF1294.2 +041000 ELSE IF1294.2 +041100 MOVE 5 TO CORRECT-N IF1294.2 +041200 MOVE WS-INT TO COMPUTED-N IF1294.2 +041300 PERFORM FAIL. IF1294.2 +041400 GO TO F-ORD-MIN-WRITE-06. IF1294.2 +041500 F-ORD-MIN-DELETE-06. IF1294.2 +041600 PERFORM DE-LETE. IF1294.2 +041700 GO TO F-ORD-MIN-WRITE-06. IF1294.2 +041800 F-ORD-MIN-WRITE-06. IF1294.2 +041900 MOVE "F-ORD-MIN-06" TO PAR-NAME. IF1294.2 +042000 PERFORM PRINT-DETAIL. IF1294.2 +042100*****************TEST (g) ****************************** IF1294.2 +042200 F-ORD-MIN-07. IF1294.2 +042300 MOVE ZERO TO WS-INT. IF1294.2 +042400 F-ORD-MIN-TEST-07. IF1294.2 +042500 COMPUTE WS-INT = FUNCTION ORD-MIN(4, 1, A, 3). IF1294.2 +042600 IF WS-INT = 2 THEN IF1294.2 +042700 PERFORM PASS IF1294.2 +042800 ELSE IF1294.2 +042900 MOVE 2 TO CORRECT-N IF1294.2 +043000 MOVE WS-INT TO COMPUTED-N IF1294.2 +043100 PERFORM FAIL. IF1294.2 +043200 GO TO F-ORD-MIN-WRITE-07. IF1294.2 +043300 F-ORD-MIN-DELETE-07. IF1294.2 +043400 PERFORM DE-LETE. IF1294.2 +043500 GO TO F-ORD-MIN-WRITE-07. IF1294.2 +043600 F-ORD-MIN-WRITE-07. IF1294.2 +043700 MOVE "F-ORD-MIN-07" TO PAR-NAME. IF1294.2 +043800 PERFORM PRINT-DETAIL. IF1294.2 +043900*****************TEST (h) ****************************** IF1294.2 +044000 F-ORD-MIN-08. IF1294.2 +044100 MOVE ZERO TO WS-INT. IF1294.2 +044200 F-ORD-MIN-TEST-08. IF1294.2 +044300 COMPUTE WS-INT = FUNCTION ORD-MIN("A", I, "P"). IF1294.2 +044400 IF WS-INT = 1 THEN IF1294.2 +044500 PERFORM PASS IF1294.2 +044600 ELSE IF1294.2 +044700 MOVE 1 TO CORRECT-N IF1294.2 +044800 MOVE WS-INT TO COMPUTED-N IF1294.2 +044900 PERFORM FAIL. IF1294.2 +045000 GO TO F-ORD-MIN-WRITE-08. IF1294.2 +045100 F-ORD-MIN-DELETE-08. IF1294.2 +045200 PERFORM DE-LETE. IF1294.2 +045300 GO TO F-ORD-MIN-WRITE-08. IF1294.2 +045400 F-ORD-MIN-WRITE-08. IF1294.2 +045500 MOVE "F-ORD-MIN-08" TO PAR-NAME. IF1294.2 +045600 PERFORM PRINT-DETAIL. IF1294.2 +045700*****************TEST (i) ****************************** IF1294.2 +045800 F-ORD-MIN-09. IF1294.2 +045900 MOVE ZERO TO WS-INT. IF1294.2 +046000 F-ORD-MIN-TEST-09. IF1294.2 +046100 COMPUTE WS-INT = FUNCTION ORD-MIN("S", "D", J). IF1294.2 +046200 IF WS-INT = 2 THEN IF1294.2 +046300 PERFORM PASS IF1294.2 +046400 ELSE IF1294.2 +046500 MOVE 2 TO CORRECT-N IF1294.2 +046600 MOVE WS-INT TO COMPUTED-N IF1294.2 +046700 PERFORM FAIL. IF1294.2 +046800 GO TO F-ORD-MIN-WRITE-09. IF1294.2 +046900 F-ORD-MIN-DELETE-09. IF1294.2 +047000 PERFORM DE-LETE. IF1294.2 +047100 GO TO F-ORD-MIN-WRITE-09. IF1294.2 +047200 F-ORD-MIN-WRITE-09. IF1294.2 +047300 MOVE "F-ORD-MIN-09" TO PAR-NAME. IF1294.2 +047400 PERFORM PRINT-DETAIL. IF1294.2 +047500*****************TEST (j) ****************************** IF1294.2 +047600 F-ORD-MIN-10. IF1294.2 +047700 MOVE ZERO TO WS-INT. IF1294.2 +047800 F-ORD-MIN-TEST-10. IF1294.2 +047900 COMPUTE WS-INT = FUNCTION ORD-MIN(A, 5, 5, A). IF1294.2 +048000 IF WS-INT = 1 THEN IF1294.2 +048100 PERFORM PASS IF1294.2 +048200 ELSE IF1294.2 +048300 MOVE 1 TO CORRECT-N IF1294.2 +048400 MOVE WS-INT TO COMPUTED-N IF1294.2 +048500 PERFORM FAIL. IF1294.2 +048600 GO TO F-ORD-MIN-WRITE-10. IF1294.2 +048700 F-ORD-MIN-DELETE-10. IF1294.2 +048800 PERFORM DE-LETE. IF1294.2 +048900 GO TO F-ORD-MIN-WRITE-10. IF1294.2 +049000 F-ORD-MIN-WRITE-10. IF1294.2 +049100 MOVE "F-ORD-MIN-10" TO PAR-NAME. IF1294.2 +049200 PERFORM PRINT-DETAIL. IF1294.2 +049300*****************TEST (k) ****************************** IF1294.2 +049400 F-ORD-MIN-11. IF1294.2 +049500 MOVE ZERO TO WS-INT. IF1294.2 +049600 F-ORD-MIN-TEST-11. IF1294.2 +049700 COMPUTE WS-INT = FUNCTION ORD-MIN(IND(1), IND(2), IND(3)). IF1294.2 +049800 IF WS-INT = 2 THEN IF1294.2 +049900 PERFORM PASS IF1294.2 +050000 ELSE IF1294.2 +050100 MOVE 2 TO CORRECT-N IF1294.2 +050200 MOVE WS-INT TO COMPUTED-N IF1294.2 +050300 PERFORM FAIL. IF1294.2 +050400 GO TO F-ORD-MIN-WRITE-11. IF1294.2 +050500 F-ORD-MIN-DELETE-11. IF1294.2 +050600 PERFORM DE-LETE. IF1294.2 +050700 GO TO F-ORD-MIN-WRITE-11. IF1294.2 +050800 F-ORD-MIN-WRITE-11. IF1294.2 +050900 MOVE "F-ORD-MIN-11" TO PAR-NAME. IF1294.2 +051000 PERFORM PRINT-DETAIL. IF1294.2 +051100*****************TEST (l) ****************************** IF1294.2 +051200 F-ORD-MIN-12. IF1294.2 +051300 MOVE ZERO TO WS-INT. IF1294.2 +051400 F-ORD-MIN-TEST-12. IF1294.2 +051500 COMPUTE WS-INT = FUNCTION ORD-MIN(IND(P), IND(Q), IND(R)). IF1294.2 +051600 IF WS-INT = 1 THEN IF1294.2 +051700 PERFORM PASS IF1294.2 +051800 ELSE IF1294.2 +051900 MOVE 1 TO CORRECT-N IF1294.2 +052000 MOVE WS-INT TO COMPUTED-N IF1294.2 +052100 PERFORM FAIL. IF1294.2 +052200 GO TO F-ORD-MIN-WRITE-12. IF1294.2 +052300 F-ORD-MIN-DELETE-12. IF1294.2 +052400 PERFORM DE-LETE. IF1294.2 +052500 GO TO F-ORD-MIN-WRITE-12. IF1294.2 +052600 F-ORD-MIN-WRITE-12. IF1294.2 +052700 MOVE "F-ORD-MIN-12" TO PAR-NAME. IF1294.2 +052800 PERFORM PRINT-DETAIL. IF1294.2 +052900*****************TEST (m) ****************************** IF1294.2 +053000 F-ORD-MIN-13. IF1294.2 +053100 MOVE ZERO TO WS-INT. IF1294.2 +053200 F-ORD-MIN-TEST-13. IF1294.2 +053300 COMPUTE WS-INT = FUNCTION ORD-MIN( IF1294.2 +053400 FUNCTION ORD-MIN(1, 4), 3, 7). IF1294.2 +053500 IF WS-INT = 1 THEN IF1294.2 +053600 PERFORM PASS IF1294.2 +053700 ELSE IF1294.2 +053800 MOVE 1 TO CORRECT-N IF1294.2 +053900 MOVE WS-INT TO COMPUTED-N IF1294.2 +054000 PERFORM FAIL. IF1294.2 +054100 GO TO F-ORD-MIN-WRITE-13. IF1294.2 +054200 F-ORD-MIN-DELETE-13. IF1294.2 +054300 PERFORM DE-LETE. IF1294.2 +054400 GO TO F-ORD-MIN-WRITE-13. IF1294.2 +054500 F-ORD-MIN-WRITE-13. IF1294.2 +054600 MOVE "F-ORD-MIN-13" TO PAR-NAME. IF1294.2 +054700 PERFORM PRINT-DETAIL. IF1294.2 +054800*****************TEST (n) ****************************** IF1294.2 +054900 F-ORD-MIN-14. IF1294.2 +055000 MOVE ZERO TO WS-INT. IF1294.2 +055100 F-ORD-MIN-TEST-14. IF1294.2 +055200 COMPUTE WS-INT = FUNCTION ORD-MIN(IND(ALL)). IF1294.2 +055300 IF WS-INT = 2 THEN IF1294.2 +055400 PERFORM PASS IF1294.2 +055500 ELSE IF1294.2 +055600 MOVE 2 TO CORRECT-N IF1294.2 +055700 MOVE WS-INT TO COMPUTED-N IF1294.2 +055800 PERFORM FAIL. IF1294.2 +055900 GO TO F-ORD-MIN-WRITE-14. IF1294.2 +056000 F-ORD-MIN-DELETE-14. IF1294.2 +056100 PERFORM DE-LETE. IF1294.2 +056200 GO TO F-ORD-MIN-WRITE-14. IF1294.2 +056300 F-ORD-MIN-WRITE-14. IF1294.2 +056400 MOVE "F-ORD-MIN-14" TO PAR-NAME. IF1294.2 +056500 PERFORM PRINT-DETAIL. IF1294.2 +056600*****************TEST (o) ****************************** IF1294.2 +056700 F-ORD-MIN-15. IF1294.2 +056800 MOVE ZERO TO WS-INT. IF1294.2 +056900 F-ORD-MIN-TEST-15. IF1294.2 +057000 COMPUTE WS-INT = FUNCTION ORD-MIN(2, 3, C) + A. IF1294.2 +057100 IF WS-INT = 6 THEN IF1294.2 +057200 PERFORM PASS IF1294.2 +057300 ELSE IF1294.2 +057400 MOVE 6 TO CORRECT-N IF1294.2 +057500 MOVE WS-INT TO COMPUTED-N IF1294.2 +057600 PERFORM FAIL. IF1294.2 +057700 GO TO F-ORD-MIN-WRITE-15. IF1294.2 +057800 F-ORD-MIN-DELETE-15. IF1294.2 +057900 PERFORM DE-LETE. IF1294.2 +058000 GO TO F-ORD-MIN-WRITE-15. IF1294.2 +058100 F-ORD-MIN-WRITE-15. IF1294.2 +058200 MOVE "F-ORD-MIN-15" TO PAR-NAME. IF1294.2 +058300 PERFORM PRINT-DETAIL. IF1294.2 +058400*****************TEST (p) ****************************** IF1294.2 +058500 F-ORD-MIN-16. IF1294.2 +058600 MOVE ZERO TO WS-INT. IF1294.2 +058700 F-ORD-MIN-TEST-16. IF1294.2 +058800 COMPUTE WS-INT = FUNCTION ORD-MIN(9, 3, A) + IF1294.2 +058900 FUNCTION ORD-MIN(1, 1). IF1294.2 +059000 IF WS-INT = 3 THEN IF1294.2 +059100 PERFORM PASS IF1294.2 +059200 ELSE IF1294.2 +059300 MOVE 3 TO CORRECT-N IF1294.2 +059400 MOVE WS-INT TO COMPUTED-N IF1294.2 +059500 PERFORM FAIL. IF1294.2 +059600 GO TO F-ORD-MIN-WRITE-16. IF1294.2 +059700 F-ORD-MIN-DELETE-16. IF1294.2 +059800 PERFORM DE-LETE. IF1294.2 +059900 GO TO F-ORD-MIN-WRITE-16. IF1294.2 +060000 F-ORD-MIN-WRITE-16. IF1294.2 +060100 MOVE "F-ORD-MIN-16" TO PAR-NAME. IF1294.2 +060200 PERFORM PRINT-DETAIL. IF1294.2 +060300*****************SPECIAL TEST 1****************************** IF1294.2 +060400 F-ORD-MIN-17. IF1294.2 +060500 MOVE 10 TO ARG1 IF1294.2 +060600 PERFORM F-ORD-MIN-TEST-17 IF1294.2 +060700 UNTIL FUNCTION ORD-MIN(2, ARG1) > 1. IF1294.2 +060800* IF1294.2 +060900** when ARG1 = 10 .. 2 ORD-MIN(2,ARG1) = 1 IF1294.2 +061000** when ARG1 = 1 , ORD-MIN(5,ARG1) = 2 IF1294.2 +061100* IF1294.2 +061200 IF ARG1 = 1 THEN IF1294.2 +061300 PERFORM PASS IF1294.2 +061400 ELSE IF1294.2 +061500 MOVE 1 TO CORRECT-N IF1294.2 +061600 MOVE ARG1 TO COMPUTED-N IF1294.2 +061700 PERFORM FAIL. IF1294.2 +061800 GO TO F-ORD-MIN-WRITE-17. IF1294.2 +061900* IF1294.2 +062000 F-ORD-MIN-TEST-17. IF1294.2 +062100 COMPUTE ARG1 = ARG1 - 1. IF1294.2 +062200* IF1294.2 +062300 F-ORD-MIN-DELETE-17. IF1294.2 +062400 PERFORM DE-LETE. IF1294.2 +062500 GO TO F-ORD-MIN-WRITE-17. IF1294.2 +062600 F-ORD-MIN-WRITE-17. IF1294.2 +062700 MOVE "F-ORD-MIN-17" TO PAR-NAME. IF1294.2 +062800 PERFORM PRINT-DETAIL. IF1294.2 +062900*******************END OF TESTS************************** IF1294.2 +063000 CCVS-EXIT SECTION. IF1294.2 +063100 CCVS-999999. IF1294.2 +063200 GO TO CLOSE-FILES. IF1294.2 +*END-OF,IF129A +*HEADER,COBOL,IF130A +000100 IDENTIFICATION DIVISION. IF1304.2 +000200 PROGRAM-ID. IF1304.2 +000300 IF130A. IF1304.2 +000400 IF1304.2 +000500*********************************************************** IF1304.2 +000600* * IF1304.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1304.2 +000800* It contains tests for the Intrinsic Function * IF1304.2 +000900* PRESENT-VALUE. * IF1304.2 +001000* * IF1304.2 +001100*********************************************************** IF1304.2 +001200 ENVIRONMENT DIVISION. IF1304.2 +001300 CONFIGURATION SECTION. IF1304.2 +001400 SOURCE-COMPUTER. IF1304.2 +001500 XXXXX082. IF1304.2 +001600 OBJECT-COMPUTER. IF1304.2 +001700 XXXXX083. IF1304.2 +001800 INPUT-OUTPUT SECTION. IF1304.2 +001900 FILE-CONTROL. IF1304.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1304.2 +002100 XXXXX055. IF1304.2 +002200 DATA DIVISION. IF1304.2 +002300 FILE SECTION. IF1304.2 +002400 FD PRINT-FILE. IF1304.2 +002500 01 PRINT-REC PICTURE X(120). IF1304.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1304.2 +002700 WORKING-STORAGE SECTION. IF1304.2 +002800*********************************************************** IF1304.2 +002900* Variables specific to the Intrinsic Function Test IF130A* IF1304.2 +003000*********************************************************** IF1304.2 +003100 01 A PIC S9(10) VALUE 5. IF1304.2 +003200 01 B PIC S9(10) VALUE 7. IF1304.2 +003300 01 C PIC S9(10) VALUE -4. IF1304.2 +003400 01 D PIC S9(10) VALUE 10. IF1304.2 +003500 01 E PIC S9(5)V9(5) VALUE 34.26. IF1304.2 +003600 01 F PIC S9(5)V9(5) VALUE -8.32. IF1304.2 +003700 01 G PIC S9(5)V9(5) VALUE 4.08. IF1304.2 +003800 01 H PIC S9(5)V9(5) VALUE 5.3. IF1304.2 +003900 01 I PIC S9(5)V9(5) VALUE 0.0009. IF1304.2 +004000 01 J PIC S9(5)V9(5) VALUE 0.0008. IF1304.2 +004100 01 K PIC S9(10) VALUE 23000. IF1304.2 +004200 01 L PIC S9(10) VALUE -23000. IF1304.2 +004300 01 P PIC S9(10) VALUE 1. IF1304.2 +004400 01 Q PIC S9(10) VALUE 3. IF1304.2 +004500 01 R PIC S9(10) VALUE 5. IF1304.2 +004600 01 ARG1 PIC S9(10) VALUE 0. IF1304.2 +004700 01 ARR VALUE "40537". IF1304.2 +004800 02 IND OCCURS 5 TIMES PIC 9. IF1304.2 +004900 01 TEMP PIC S9(10)V9(5). IF1304.2 +005000 01 WS-NUM PIC S9(5)V9(6). IF1304.2 +005100 01 MIN-RANGE PIC S9(5)V9(7). IF1304.2 +005200 01 MAX-RANGE PIC S9(5)V9(7). IF1304.2 +005300* IF1304.2 +005400********************************************************** IF1304.2 +005500* IF1304.2 +005600 01 TEST-RESULTS. IF1304.2 +005700 02 FILLER PIC X VALUE SPACE. IF1304.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IF1304.2 +005900 02 FILLER PIC X VALUE SPACE. IF1304.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IF1304.2 +006100 02 FILLER PIC X VALUE SPACE. IF1304.2 +006200 02 PAR-NAME. IF1304.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IF1304.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IF1304.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IF1304.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IF1304.2 +006700 02 RE-MARK PIC X(61). IF1304.2 +006800 01 TEST-COMPUTED. IF1304.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +007000 02 FILLER PIC X(17) VALUE IF1304.2 +007100 " COMPUTED=". IF1304.2 +007200 02 COMPUTED-X. IF1304.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1304.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IF1304.2 +007500 PIC -9(9).9(9). IF1304.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1304.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1304.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1304.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IF1304.2 +008000 04 COMPUTED-18V0 PIC -9(18). IF1304.2 +008100 04 FILLER PIC X. IF1304.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IF1304.2 +008300 01 TEST-CORRECT. IF1304.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1304.2 +008600 02 CORRECT-X. IF1304.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1304.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1304.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1304.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1304.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1304.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IF1304.2 +009300 04 CORRECT-18V0 PIC -9(18). IF1304.2 +009400 04 FILLER PIC X. IF1304.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1304.2 +009700 01 TEST-CORRECT-MIN. IF1304.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +009900 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1304.2 +010000 02 CORRECTMI-X. IF1304.2 +010100 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1304.2 +010200 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1304.2 +010300 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1304.2 +010400 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1304.2 +010500 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1304.2 +010600 03 CR-18V0 REDEFINES CORRECTMI-A. IF1304.2 +010700 04 CORRECTMI-18V0 PIC -9(18). IF1304.2 +010800 04 FILLER PIC X. IF1304.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +011000 03 FILLER PIC X(48) VALUE SPACE. IF1304.2 +011100 01 TEST-CORRECT-MAX. IF1304.2 +011200 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +011300 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1304.2 +011400 02 CORRECTMA-X. IF1304.2 +011500 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1304.2 +011600 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1304.2 +011700 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1304.2 +011800 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1304.2 +011900 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1304.2 +012000 03 CR-18V0 REDEFINES CORRECTMA-A. IF1304.2 +012100 04 CORRECTMA-18V0 PIC -9(18). IF1304.2 +012200 04 FILLER PIC X. IF1304.2 +012300 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +012400 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1304.2 +012500 01 CCVS-C-1. IF1304.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1304.2 +012700- "SS PARAGRAPH-NAME IF1304.2 +012800- " REMARKS". IF1304.2 +012900 02 FILLER PIC X(20) VALUE SPACE. IF1304.2 +013000 01 CCVS-C-2. IF1304.2 +013100 02 FILLER PIC X VALUE SPACE. IF1304.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". IF1304.2 +013300 02 FILLER PIC X(15) VALUE SPACE. IF1304.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". IF1304.2 +013500 02 FILLER PIC X(94) VALUE SPACE. IF1304.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1304.2 +013700 01 REC-CT PIC 99 VALUE ZERO. IF1304.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1304.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1304.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1304.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1304.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1304.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1304.2 +014700 01 CCVS-H-1. IF1304.2 +014800 02 FILLER PIC X(39) VALUE SPACES. IF1304.2 +014900 02 FILLER PIC X(42) VALUE IF1304.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1304.2 +015100 02 FILLER PIC X(39) VALUE SPACES. IF1304.2 +015200 01 CCVS-H-2A. IF1304.2 +015300 02 FILLER PIC X(40) VALUE SPACE. IF1304.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1304.2 +015500 02 FILLER PIC XXXX VALUE IF1304.2 +015600 "4.2 ". IF1304.2 +015700 02 FILLER PIC X(28) VALUE IF1304.2 +015800 " COPY - NOT FOR DISTRIBUTION". IF1304.2 +015900 02 FILLER PIC X(41) VALUE SPACE. IF1304.2 +016000 IF1304.2 +016100 01 CCVS-H-2B. IF1304.2 +016200 02 FILLER PIC X(15) VALUE IF1304.2 +016300 "TEST RESULT OF ". IF1304.2 +016400 02 TEST-ID PIC X(9). IF1304.2 +016500 02 FILLER PIC X(4) VALUE IF1304.2 +016600 " IN ". IF1304.2 +016700 02 FILLER PIC X(12) VALUE IF1304.2 +016800 " HIGH ". IF1304.2 +016900 02 FILLER PIC X(22) VALUE IF1304.2 +017000 " LEVEL VALIDATION FOR ". IF1304.2 +017100 02 FILLER PIC X(58) VALUE IF1304.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1304.2 +017300 01 CCVS-H-3. IF1304.2 +017400 02 FILLER PIC X(34) VALUE IF1304.2 +017500 " FOR OFFICIAL USE ONLY ". IF1304.2 +017600 02 FILLER PIC X(58) VALUE IF1304.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1304.2 +017800 02 FILLER PIC X(28) VALUE IF1304.2 +017900 " COPYRIGHT 1985 ". IF1304.2 +018000 01 CCVS-E-1. IF1304.2 +018100 02 FILLER PIC X(52) VALUE SPACE. IF1304.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1304.2 +018300 02 ID-AGAIN PIC X(9). IF1304.2 +018400 02 FILLER PIC X(45) VALUE SPACES. IF1304.2 +018500 01 CCVS-E-2. IF1304.2 +018600 02 FILLER PIC X(31) VALUE SPACE. IF1304.2 +018700 02 FILLER PIC X(21) VALUE SPACE. IF1304.2 +018800 02 CCVS-E-2-2. IF1304.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1304.2 +019000 03 FILLER PIC X VALUE SPACE. IF1304.2 +019100 03 ENDER-DESC PIC X(44) VALUE IF1304.2 +019200 "ERRORS ENCOUNTERED". IF1304.2 +019300 01 CCVS-E-3. IF1304.2 +019400 02 FILLER PIC X(22) VALUE IF1304.2 +019500 " FOR OFFICIAL USE ONLY". IF1304.2 +019600 02 FILLER PIC X(12) VALUE SPACE. IF1304.2 +019700 02 FILLER PIC X(58) VALUE IF1304.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1304.2 +019900 02 FILLER PIC X(13) VALUE SPACE. IF1304.2 +020000 02 FILLER PIC X(15) VALUE IF1304.2 +020100 " COPYRIGHT 1985". IF1304.2 +020200 01 CCVS-E-4. IF1304.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1304.2 +020400 02 FILLER PIC X(4) VALUE " OF ". IF1304.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1304.2 +020600 02 FILLER PIC X(40) VALUE IF1304.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". IF1304.2 +020800 01 XXINFO. IF1304.2 +020900 02 FILLER PIC X(19) VALUE IF1304.2 +021000 "*** INFORMATION ***". IF1304.2 +021100 02 INFO-TEXT. IF1304.2 +021200 04 FILLER PIC X(8) VALUE SPACE. IF1304.2 +021300 04 XXCOMPUTED PIC X(20). IF1304.2 +021400 04 FILLER PIC X(5) VALUE SPACE. IF1304.2 +021500 04 XXCORRECT PIC X(20). IF1304.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). IF1304.2 +021700 01 HYPHEN-LINE. IF1304.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. IF1304.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************IF1304.2 +022000- "*****************************************". IF1304.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************IF1304.2 +022200- "******************************". IF1304.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE IF1304.2 +022400 "IF130A". IF1304.2 +022500 PROCEDURE DIVISION. IF1304.2 +022600 CCVS1 SECTION. IF1304.2 +022700 OPEN-FILES. IF1304.2 +022800 OPEN OUTPUT PRINT-FILE. IF1304.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1304.2 +023000 MOVE SPACE TO TEST-RESULTS. IF1304.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1304.2 +023200 GO TO CCVS1-EXIT. IF1304.2 +023300 CLOSE-FILES. IF1304.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1304.2 +023500 TERMINATE-CCVS. IF1304.2 +023600 STOP RUN. IF1304.2 +023700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1304.2 +023800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1304.2 +023900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1304.2 +024000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1304.2 +024100 MOVE "****TEST DELETED****" TO RE-MARK. IF1304.2 +024200 PRINT-DETAIL. IF1304.2 +024300 IF REC-CT NOT EQUAL TO ZERO IF1304.2 +024400 MOVE "." TO PARDOT-X IF1304.2 +024500 MOVE REC-CT TO DOTVALUE. IF1304.2 +024600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1304.2 +024700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1304.2 +024800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1304.2 +024900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1304.2 +025000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1304.2 +025100 MOVE SPACE TO CORRECT-X. IF1304.2 +025200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1304.2 +025300 MOVE SPACE TO RE-MARK. IF1304.2 +025400 HEAD-ROUTINE. IF1304.2 +025500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +025600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +025700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1304.2 +025800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1304.2 +025900 COLUMN-NAMES-ROUTINE. IF1304.2 +026000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +026100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +026300 END-ROUTINE. IF1304.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1304.2 +026500 END-RTN-EXIT. IF1304.2 +026600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +026700 END-ROUTINE-1. IF1304.2 +026800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1304.2 +026900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1304.2 +027000 ADD PASS-COUNTER TO ERROR-HOLD. IF1304.2 +027100 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1304.2 +027200 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1304.2 +027300 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1304.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1304.2 +027500 END-ROUTINE-12. IF1304.2 +027600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1304.2 +027700 IF ERROR-COUNTER IS EQUAL TO ZERO IF1304.2 +027800 MOVE "NO " TO ERROR-TOTAL IF1304.2 +027900 ELSE IF1304.2 +028000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1304.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1304.2 +028200 PERFORM WRITE-LINE. IF1304.2 +028300 END-ROUTINE-13. IF1304.2 +028400 IF DELETE-COUNTER IS EQUAL TO ZERO IF1304.2 +028500 MOVE "NO " TO ERROR-TOTAL ELSE IF1304.2 +028600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1304.2 +028700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1304.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +028900 IF INSPECT-COUNTER EQUAL TO ZERO IF1304.2 +029000 MOVE "NO " TO ERROR-TOTAL IF1304.2 +029100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1304.2 +029200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1304.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +029400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +029500 WRITE-LINE. IF1304.2 +029600 ADD 1 TO RECORD-COUNT. IF1304.2 +029700Y IF RECORD-COUNT GREATER 42 IF1304.2 +029800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1304.2 +029900Y MOVE SPACE TO DUMMY-RECORD IF1304.2 +030000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1304.2 +030100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1304.2 +030200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1304.2 +030300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1304.2 +030400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1304.2 +030500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1304.2 +030900Y MOVE ZERO TO RECORD-COUNT. IF1304.2 +031000 PERFORM WRT-LN. IF1304.2 +031100 WRT-LN. IF1304.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1304.2 +031300 MOVE SPACE TO DUMMY-RECORD. IF1304.2 +031400 BLANK-LINE-PRINT. IF1304.2 +031500 PERFORM WRT-LN. IF1304.2 +031600 FAIL-ROUTINE. IF1304.2 +031700 IF COMPUTED-X NOT EQUAL TO SPACE IF1304.2 +031800 GO TO FAIL-ROUTINE-WRITE. IF1304.2 +031900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1304.2 +032000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1304.2 +032100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1304.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1304.2 +032400 GO TO FAIL-ROUTINE-EX. IF1304.2 +032500 FAIL-ROUTINE-WRITE. IF1304.2 +032600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1304.2 +032700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1304.2 +032800 CORMA-ANSI-REFERENCE. IF1304.2 +032900 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1304.2 +033000 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1304.2 +033100 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1304.2 +033200 ELSE IF1304.2 +033300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1304.2 +033400 PERFORM WRITE-LINE. IF1304.2 +033500 MOVE SPACES TO COR-ANSI-REFERENCE. IF1304.2 +033600 FAIL-ROUTINE-EX. EXIT. IF1304.2 +033700 BAIL-OUT. IF1304.2 +033800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1304.2 +033900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1304.2 +034000 BAIL-OUT-WRITE. IF1304.2 +034100 MOVE CORRECT-A TO XXCORRECT. IF1304.2 +034200 MOVE COMPUTED-A TO XXCOMPUTED. IF1304.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1304.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1304.2 +034600 BAIL-OUT-EX. EXIT. IF1304.2 +034700 CCVS1-EXIT. IF1304.2 +034800 EXIT. IF1304.2 +034900******************************************************** IF1304.2 +035000* * IF1304.2 +035100* Intrinsic Function Tests IF130A - PRESENT-VALUE * IF1304.2 +035200* * IF1304.2 +035300******************************************************** IF1304.2 +035400 SECT-IF130A SECTION. IF1304.2 +035500 F-PRES-VAL-INFO. IF1304.2 +035600 MOVE "See ref. A-63 2.34" TO ANSI-REFERENCE. IF1304.2 +035700 MOVE "PRESENT-VALUE Function" TO FEATURE. IF1304.2 +035800*****************TEST (a) - SIMPLE TEST***************** IF1304.2 +035900 F-PRES-VAL-01. IF1304.2 +036000 MOVE ZERO TO WS-NUM. IF1304.2 +036100 MOVE 43.9991 TO MIN-RANGE. IF1304.2 +036200 MOVE 44.0009 TO MAX-RANGE. IF1304.2 +036300 F-PRES-VAL-TEST-01. IF1304.2 +036400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(0, 23, 12, 9). IF1304.2 +036500 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +036600 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +036700 PERFORM PASS IF1304.2 +036800 ELSE IF1304.2 +036900 MOVE WS-NUM TO COMPUTED-N IF1304.2 +037000 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +037100 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +037200 PERFORM FAIL. IF1304.2 +037300 GO TO F-PRES-VAL-WRITE-01. IF1304.2 +037400 F-PRES-VAL-DELETE-01. IF1304.2 +037500 PERFORM DE-LETE. IF1304.2 +037600 GO TO F-PRES-VAL-WRITE-01. IF1304.2 +037700 F-PRES-VAL-WRITE-01. IF1304.2 +037800 MOVE "F-PRES-VAL-01" TO PAR-NAME. IF1304.2 +037900 PERFORM PRINT-DETAIL. IF1304.2 +038000*****************TEST (b) - SIMPLE TEST***************** IF1304.2 +038100 F-PRES-VAL-02. IF1304.2 +038200 EVALUATE FUNCTION PRESENT-VALUE(1, 10, 20, 10, 5) IF1304.2 +038300 WHEN 11.5623 THRU 11.5627 IF1304.2 +038400 PERFORM PASS IF1304.2 +038500 WHEN OTHER IF1304.2 +038600 PERFORM FAIL. IF1304.2 +038700 GO TO F-PRES-VAL-WRITE-02. IF1304.2 +038800 F-PRES-VAL-DELETE-02. IF1304.2 +038900 PERFORM DE-LETE. IF1304.2 +039000 GO TO F-PRES-VAL-WRITE-02. IF1304.2 +039100 F-PRES-VAL-WRITE-02. IF1304.2 +039200 MOVE "F-PRES-VAL-02" TO PAR-NAME. IF1304.2 +039300 PERFORM PRINT-DETAIL. IF1304.2 +039400*****************TEST (c) - SIMPLE TEST***************** IF1304.2 +039500 F-PRES-VAL-03. IF1304.2 +039600 MOVE 9.53314 TO MIN-RANGE. IF1304.2 +039700 MOVE 9.53352 TO MAX-RANGE. IF1304.2 +039800 F-PRES-VAL-TEST-03. IF1304.2 +039900 IF (FUNCTION PRESENT-VALUE(.5, 8.3, 2.4, 9.9) IF1304.2 +040000 >= MIN-RANGE) AND IF1304.2 +040100 (FUNCTION PRESENT-VALUE(.5, 8.3, 2.4, 9.9) IF1304.2 +040200 <= MAX-RANGE) THEN IF1304.2 +040300 PERFORM PASS IF1304.2 +040400 ELSE IF1304.2 +040500 PERFORM FAIL. IF1304.2 +040600 GO TO F-PRES-VAL-WRITE-03. IF1304.2 +040700 F-PRES-VAL-DELETE-03. IF1304.2 +040800 PERFORM DE-LETE. IF1304.2 +040900 GO TO F-PRES-VAL-WRITE-03. IF1304.2 +041000 F-PRES-VAL-WRITE-03. IF1304.2 +041100 MOVE "F-PRES-VAL-03" TO PAR-NAME. IF1304.2 +041200 PERFORM PRINT-DETAIL. IF1304.2 +041300*****************TEST (d) - SIMPLE TEST***************** IF1304.2 +041400 F-PRES-VAL-04. IF1304.2 +041500 MOVE ZERO TO WS-NUM. IF1304.2 +041600 MOVE 22.6274 TO MIN-RANGE. IF1304.2 +041700 MOVE 22.6283 TO MAX-RANGE. IF1304.2 +041800 F-PRES-VAL-TEST-04. IF1304.2 +041900 COMPUTE WS-NUM = IF1304.2 +042000 FUNCTION PRESENT-VALUE(.1, 5, 4, 2.8, 3.1, 17). IF1304.2 +042100 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +042200 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +042300 PERFORM PASS IF1304.2 +042400 ELSE IF1304.2 +042500 MOVE WS-NUM TO COMPUTED-N IF1304.2 +042600 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +042700 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +042800 PERFORM FAIL. IF1304.2 +042900 GO TO F-PRES-VAL-WRITE-04. IF1304.2 +043000 F-PRES-VAL-DELETE-04. IF1304.2 +043100 PERFORM DE-LETE. IF1304.2 +043200 GO TO F-PRES-VAL-WRITE-04. IF1304.2 +043300 F-PRES-VAL-WRITE-04. IF1304.2 +043400 MOVE "F-PRES-VAL-04" TO PAR-NAME. IF1304.2 +043500 PERFORM PRINT-DETAIL. IF1304.2 +043600*****************TEST (e) - SIMPLE TEST***************** IF1304.2 +043700 F-PRES-VAL-05. IF1304.2 +043800 MOVE ZERO TO WS-NUM. IF1304.2 +043900 MOVE 20.1691 TO MIN-RANGE. IF1304.2 +044000 MOVE 20.1699 TO MAX-RANGE. IF1304.2 +044100 F-PRES-VAL-TEST-05. IF1304.2 +044200 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.04, A, B, D). IF1304.2 +044300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +044400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +044500 PERFORM PASS IF1304.2 +044600 ELSE IF1304.2 +044700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +044800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +044900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +045000 PERFORM FAIL. IF1304.2 +045100 GO TO F-PRES-VAL-WRITE-05. IF1304.2 +045200 F-PRES-VAL-DELETE-05. IF1304.2 +045300 PERFORM DE-LETE. IF1304.2 +045400 GO TO F-PRES-VAL-WRITE-05. IF1304.2 +045500 F-PRES-VAL-WRITE-05. IF1304.2 +045600 MOVE "F-PRES-VAL-05" TO PAR-NAME. IF1304.2 +045700 PERFORM PRINT-DETAIL. IF1304.2 +045800*****************TEST (f) - SIMPLE TEST***************** IF1304.2 +045900 F-PRES-VAL-06. IF1304.2 +046000 MOVE ZERO TO WS-NUM. IF1304.2 +046100 MOVE 33.3113 TO MIN-RANGE. IF1304.2 +046200 MOVE 33.3127 TO MAX-RANGE. IF1304.2 +046300 F-PRES-VAL-TEST-06. IF1304.2 +046400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.08, E, G, H, F). IF1304.2 +046500 IF1304.2 +046600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +046700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +046800 PERFORM PASS IF1304.2 +046900 ELSE IF1304.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +047100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +047200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +047300 PERFORM FAIL. IF1304.2 +047400 GO TO F-PRES-VAL-WRITE-06. IF1304.2 +047500 F-PRES-VAL-DELETE-06. IF1304.2 +047600 PERFORM DE-LETE. IF1304.2 +047700 GO TO F-PRES-VAL-WRITE-06. IF1304.2 +047800 F-PRES-VAL-WRITE-06. IF1304.2 +047900 MOVE "F-PRES-VAL-06" TO PAR-NAME. IF1304.2 +048000 PERFORM PRINT-DETAIL. IF1304.2 +048100*****************TEST (g) - SIMPLE TEST***************** IF1304.2 +048200 F-PRES-VAL-07. IF1304.2 +048300 MOVE ZERO TO WS-NUM. IF1304.2 +048400 MOVE 5.76505 TO MIN-RANGE. IF1304.2 +048500 MOVE 5.76528 TO MAX-RANGE. IF1304.2 +048600 F-PRES-VAL-TEST-07. IF1304.2 +048700 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.2, C, A, 5, 4, 2). IF1304.2 +048800 IF1304.2 +048900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +049000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +049100 PERFORM PASS IF1304.2 +049200 ELSE IF1304.2 +049300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +049400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +049500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +049600 PERFORM FAIL. IF1304.2 +049700 GO TO F-PRES-VAL-WRITE-07. IF1304.2 +049800 F-PRES-VAL-DELETE-07. IF1304.2 +049900 PERFORM DE-LETE. IF1304.2 +050000 GO TO F-PRES-VAL-WRITE-07. IF1304.2 +050100 F-PRES-VAL-WRITE-07. IF1304.2 +050200 MOVE "F-PRES-VAL-07" TO PAR-NAME. IF1304.2 +050300 PERFORM PRINT-DETAIL. IF1304.2 +050400*****************TEST (h) - SIMPLE TEST***************** IF1304.2 +050500 F-PRES-VAL-08. IF1304.2 +050600 MOVE ZERO TO WS-NUM. IF1304.2 +050700 MOVE 0.361674 TO MIN-RANGE. IF1304.2 +050800 MOVE 0.361689 TO MAX-RANGE. IF1304.2 +050900 F-PRES-VAL-TEST-08. IF1304.2 +051000 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.3, A, H, .07, -19). IF1304.2 +051100 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +051200 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +051300 PERFORM PASS IF1304.2 +051400 ELSE IF1304.2 +051500 MOVE WS-NUM TO COMPUTED-N IF1304.2 +051600 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +051700 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +051800 PERFORM FAIL. IF1304.2 +051900 GO TO F-PRES-VAL-WRITE-08. IF1304.2 +052000 F-PRES-VAL-DELETE-08. IF1304.2 +052100 PERFORM DE-LETE. IF1304.2 +052200 GO TO F-PRES-VAL-WRITE-08. IF1304.2 +052300 F-PRES-VAL-WRITE-08. IF1304.2 +052400 MOVE "F-PRES-VAL-08" TO PAR-NAME. IF1304.2 +052500 PERFORM PRINT-DETAIL. IF1304.2 +052600*****************TEST (i) - SIMPLE TEST***************** IF1304.2 +052700 F-PRES-VAL-09. IF1304.2 +052800 MOVE ZERO TO WS-NUM. IF1304.2 +052900 MOVE -0.001500 TO MIN-RANGE. IF1304.2 +053000 MOVE -0.001498 TO MAX-RANGE. IF1304.2 +053100 F-PRES-VAL-TEST-09. IF1304.2 +053200 COMPUTE WS-NUM = IF1304.2 +053300 FUNCTION PRESENT-VALUE(.09, -.0009, -.0008). IF1304.2 +053400 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +053500 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +053600 PERFORM PASS IF1304.2 +053700 ELSE IF1304.2 +053800 MOVE WS-NUM TO COMPUTED-N IF1304.2 +053900 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +054000 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +054100 PERFORM FAIL. IF1304.2 +054200 GO TO F-PRES-VAL-WRITE-09. IF1304.2 +054300 F-PRES-VAL-DELETE-09. IF1304.2 +054400 PERFORM DE-LETE. IF1304.2 +054500 GO TO F-PRES-VAL-WRITE-09. IF1304.2 +054600 F-PRES-VAL-WRITE-09. IF1304.2 +054700 MOVE "F-PRES-VAL-09" TO PAR-NAME. IF1304.2 +054800 PERFORM PRINT-DETAIL. IF1304.2 +054900*****************TEST (k) - SIMPLE TEST***************** IF1304.2 +055000 F-PRES-VAL-11. IF1304.2 +055100 MOVE ZERO TO WS-NUM. IF1304.2 +055200 MOVE 57454.07 TO MIN-RANGE. IF1304.2 +055300 MOVE 57456.37 TO MAX-RANGE. IF1304.2 +055400 F-PRES-VAL-TEST-11. IF1304.2 +055500 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.4, 30000, 40000, IF1304.2 +055600 100000, -80000). IF1304.2 +055700 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +055800 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +055900 PERFORM PASS IF1304.2 +056000 ELSE IF1304.2 +056100 MOVE WS-NUM TO COMPUTED-N IF1304.2 +056200 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +056300 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +056400 PERFORM FAIL. IF1304.2 +056500 GO TO F-PRES-VAL-WRITE-11. IF1304.2 +056600 F-PRES-VAL-DELETE-11. IF1304.2 +056700 PERFORM DE-LETE. IF1304.2 +056800 GO TO F-PRES-VAL-WRITE-11. IF1304.2 +056900 F-PRES-VAL-WRITE-11. IF1304.2 +057000 MOVE "F-PRES-VAL-11" TO PAR-NAME. IF1304.2 +057100 PERFORM PRINT-DETAIL. IF1304.2 +057200*****************TEST (l) - SIMPLE TEST***************** IF1304.2 +057300 F-PRES-VAL-12. IF1304.2 +057400 MOVE ZERO TO WS-NUM. IF1304.2 +057500 MOVE -1406.26 TO MIN-RANGE. IF1304.2 +057600 MOVE -1406.21 TO MAX-RANGE. IF1304.2 +057700 F-PRES-VAL-TEST-12. IF1304.2 +057800 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.07, L, K). IF1304.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +058100 PERFORM PASS IF1304.2 +058200 ELSE IF1304.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +058600 PERFORM FAIL. IF1304.2 +058700 GO TO F-PRES-VAL-WRITE-12. IF1304.2 +058800 F-PRES-VAL-DELETE-12. IF1304.2 +058900 PERFORM DE-LETE. IF1304.2 +059000 GO TO F-PRES-VAL-WRITE-12. IF1304.2 +059100 F-PRES-VAL-WRITE-12. IF1304.2 +059200 MOVE "F-PRES-VAL-12" TO PAR-NAME. IF1304.2 +059300 PERFORM PRINT-DETAIL. IF1304.2 +059400*****************TEST (m) - SIMPLE TEST***************** IF1304.2 +059500 F-PRES-VAL-13. IF1304.2 +059600 MOVE ZERO TO WS-NUM. IF1304.2 +059700 MOVE 6.76570 TO MIN-RANGE. IF1304.2 +059800 MOVE 6.76597 TO MAX-RANGE. IF1304.2 +059900 F-PRES-VAL-TEST-13. IF1304.2 +060000 COMPUTE WS-NUM = IF1304.2 +060100 FUNCTION PRESENT-VALUE(.15, IND(1), IND(2), IF1304.2 +060200 IND(3)). IF1304.2 +060300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +060400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +060500 PERFORM PASS IF1304.2 +060600 ELSE IF1304.2 +060700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +060800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +060900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +061000 PERFORM FAIL. IF1304.2 +061100 GO TO F-PRES-VAL-WRITE-13. IF1304.2 +061200 F-PRES-VAL-DELETE-13. IF1304.2 +061300 PERFORM DE-LETE. IF1304.2 +061400 GO TO F-PRES-VAL-WRITE-13. IF1304.2 +061500 F-PRES-VAL-WRITE-13. IF1304.2 +061600 MOVE "F-PRES-VAL-13" TO PAR-NAME. IF1304.2 +061700 PERFORM PRINT-DETAIL. IF1304.2 +061800*****************TEST (n) - SIMPLE TEST***************** IF1304.2 +061900 F-PRES-VAL-14. IF1304.2 +062000 MOVE ZERO TO WS-NUM. IF1304.2 +062100 MOVE 12.3066 TO MIN-RANGE. IF1304.2 +062200 MOVE 12.3071 TO MAX-RANGE. IF1304.2 +062300 F-PRES-VAL-TEST-14. IF1304.2 +062400 COMPUTE WS-NUM = IF1304.2 +062500 FUNCTION PRESENT-VALUE(.13, IND(P), IND(Q), IND(R)). IF1304.2 +062600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +062700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +062800 PERFORM PASS IF1304.2 +062900 ELSE IF1304.2 +063000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +063100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +063200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +063300 PERFORM FAIL. IF1304.2 +063400 GO TO F-PRES-VAL-WRITE-14. IF1304.2 +063500 F-PRES-VAL-DELETE-14. IF1304.2 +063600 PERFORM DE-LETE. IF1304.2 +063700 GO TO F-PRES-VAL-WRITE-14. IF1304.2 +063800 F-PRES-VAL-WRITE-14. IF1304.2 +063900 MOVE "F-PRES-VAL-14" TO PAR-NAME. IF1304.2 +064000 PERFORM PRINT-DETAIL. IF1304.2 +064100*****************TEST (o) - SIMPLE TEST***************** IF1304.2 +064200 F-PRES-VAL-15. IF1304.2 +064300 MOVE ZERO TO WS-NUM. IF1304.2 +064400 MOVE 37.9070 TO MIN-RANGE. IF1304.2 +064500 MOVE 37.9085 TO MAX-RANGE. IF1304.2 +064600 F-PRES-VAL-TEST-15. IF1304.2 +064700 COMPUTE WS-NUM = IF1304.2 +064800 FUNCTION PRESENT-VALUE(.1, 10, 10, 10, 10, 10). IF1304.2 +064900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +065000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +065100 PERFORM PASS IF1304.2 +065200 ELSE IF1304.2 +065300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +065400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +065500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +065600 PERFORM FAIL. IF1304.2 +065700 GO TO F-PRES-VAL-WRITE-15. IF1304.2 +065800 F-PRES-VAL-DELETE-15. IF1304.2 +065900 PERFORM DE-LETE. IF1304.2 +066000 GO TO F-PRES-VAL-WRITE-15. IF1304.2 +066100 F-PRES-VAL-WRITE-15. IF1304.2 +066200 MOVE "F-PRES-VAL-15" TO PAR-NAME. IF1304.2 +066300 PERFORM PRINT-DETAIL. IF1304.2 +066400*****************TEST (a) - COMPLEX TEST**************** IF1304.2 +066500 F-PRES-VAL-16. IF1304.2 +066600 MOVE ZERO TO WS-NUM. IF1304.2 +066700 MOVE 65.9974 TO MIN-RANGE. IF1304.2 +066800 MOVE 66.0026 TO MAX-RANGE. IF1304.2 +066900 F-PRES-VAL-TEST-16. IF1304.2 +067000 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE IF1304.2 +067100 (-.5, (2 + 3), (6 / 3), (9 - 3)). IF1304.2 +067200 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +067300 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +067400 PERFORM PASS IF1304.2 +067500 ELSE IF1304.2 +067600 MOVE WS-NUM TO COMPUTED-N IF1304.2 +067700 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +067800 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +067900 PERFORM FAIL. IF1304.2 +068000 GO TO F-PRES-VAL-WRITE-16. IF1304.2 +068100 F-PRES-VAL-DELETE-16. IF1304.2 +068200 PERFORM DE-LETE. IF1304.2 +068300 GO TO F-PRES-VAL-WRITE-16. IF1304.2 +068400 F-PRES-VAL-WRITE-16. IF1304.2 +068500 MOVE "F-PRES-VAL-16" TO PAR-NAME. IF1304.2 +068600 PERFORM PRINT-DETAIL. IF1304.2 +068700*****************TEST (b) - COMPLEX TEST**************** IF1304.2 +068800 F-PRES-VAL-17. IF1304.2 +068900 MOVE ZERO TO WS-NUM. IF1304.2 +069000 MOVE 44.4513 TO MIN-RANGE. IF1304.2 +069100 MOVE 44.4549 TO MAX-RANGE. IF1304.2 +069200 F-PRES-VAL-TEST-17. IF1304.2 +069300 COMPUTE WS-NUM = IF1304.2 +069400 FUNCTION PRESENT-VALUE(-.2, 5 / 4, 3.3 * 4, 9.4 + 2). IF1304.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +069700 PERFORM PASS IF1304.2 +069800 ELSE IF1304.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1304.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +070200 PERFORM FAIL. IF1304.2 +070300 GO TO F-PRES-VAL-WRITE-17. IF1304.2 +070400 F-PRES-VAL-DELETE-17. IF1304.2 +070500 PERFORM DE-LETE. IF1304.2 +070600 GO TO F-PRES-VAL-WRITE-17. IF1304.2 +070700 F-PRES-VAL-WRITE-17. IF1304.2 +070800 MOVE "F-PRES-VAL-17" TO PAR-NAME. IF1304.2 +070900 PERFORM PRINT-DETAIL. IF1304.2 +071000*****************TEST (c) - COMPLEX TEST**************** IF1304.2 +071100 F-PRES-VAL-18. IF1304.2 +071200 MOVE ZERO TO WS-NUM. IF1304.2 +071300 MOVE 7.91943 TO MIN-RANGE. IF1304.2 +071400 MOVE 7.92007 TO MAX-RANGE. IF1304.2 +071500 F-PRES-VAL-TEST-18. IF1304.2 +071600 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE IF1304.2 +071700 (.5, A + 2, 4.5 / C, 8, B). IF1304.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +072000 PERFORM PASS IF1304.2 +072100 ELSE IF1304.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1304.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +072500 PERFORM FAIL. IF1304.2 +072600 GO TO F-PRES-VAL-WRITE-18. IF1304.2 +072700 F-PRES-VAL-DELETE-18. IF1304.2 +072800 PERFORM DE-LETE. IF1304.2 +072900 GO TO F-PRES-VAL-WRITE-18. IF1304.2 +073000 F-PRES-VAL-WRITE-18. IF1304.2 +073100 MOVE "F-PRES-VAL-18" TO PAR-NAME. IF1304.2 +073200 PERFORM PRINT-DETAIL. IF1304.2 +073300*****************TEST (d) - COMPLEX TEST**************** IF1304.2 +073400 F-PRES-VAL-19. IF1304.2 +073500 MOVE ZERO TO WS-NUM. IF1304.2 +073600 MOVE 22.4229 TO MIN-RANGE. IF1304.2 +073700 MOVE 22.4247 TO MAX-RANGE. IF1304.2 +073800 F-PRES-VAL-TEST-19. IF1304.2 +073900 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.08, 2, 3) + 18. IF1304.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +074200 PERFORM PASS IF1304.2 +074300 ELSE IF1304.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1304.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +074700 PERFORM FAIL. IF1304.2 +074800 GO TO F-PRES-VAL-WRITE-19. IF1304.2 +074900 F-PRES-VAL-DELETE-19. IF1304.2 +075000 PERFORM DE-LETE. IF1304.2 +075100 GO TO F-PRES-VAL-WRITE-19. IF1304.2 +075200 F-PRES-VAL-WRITE-19. IF1304.2 +075300 MOVE "F-PRES-VAL-19" TO PAR-NAME. IF1304.2 +075400 PERFORM PRINT-DETAIL. IF1304.2 +075500*****************TEST (e) - COMPLEX TEST**************** IF1304.2 +075600 F-PRES-VAL-20. IF1304.2 +075700 MOVE ZERO TO WS-NUM. IF1304.2 +075800 MOVE -2.09570 TO MIN-RANGE. IF1304.2 +075900 MOVE -2.09554 TO MAX-RANGE. IF1304.2 +076000 F-PRES-VAL-TEST-20. IF1304.2 +076100 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.03, -6, -4) + IF1304.2 +076200 FUNCTION PRESENT-VALUE(.2, 9). IF1304.2 +076300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +076400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +076500 PERFORM PASS IF1304.2 +076600 ELSE IF1304.2 +076700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +076800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +076900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +077000 PERFORM FAIL. IF1304.2 +077100 GO TO F-PRES-VAL-WRITE-20. IF1304.2 +077200 F-PRES-VAL-DELETE-20. IF1304.2 +077300 PERFORM DE-LETE. IF1304.2 +077400 GO TO F-PRES-VAL-WRITE-20. IF1304.2 +077500 F-PRES-VAL-WRITE-20. IF1304.2 +077600 MOVE "F-PRES-VAL-20" TO PAR-NAME. IF1304.2 +077700 PERFORM PRINT-DETAIL. IF1304.2 +077800*****************TEST (f) - COMPLEX TEST**************** IF1304.2 +077900 F-PRES-VAL-21. IF1304.2 +078000 MOVE ZERO TO WS-NUM. IF1304.2 +078100 MOVE 1.49994 TO MIN-RANGE. IF1304.2 +078200 MOVE 1.50006 TO MAX-RANGE. IF1304.2 +078300 F-PRES-VAL-TEST-21. IF1304.2 +078400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE( IF1304.2 +078500 FUNCTION PRESENT-VALUE(1, 2), 3). IF1304.2 +078600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +078700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +078800 PERFORM PASS IF1304.2 +078900 ELSE IF1304.2 +079000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +079100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +079200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +079300 PERFORM FAIL. IF1304.2 +079400 GO TO F-PRES-VAL-WRITE-21. IF1304.2 +079500 F-PRES-VAL-DELETE-21. IF1304.2 +079600 PERFORM DE-LETE. IF1304.2 +079700 GO TO F-PRES-VAL-WRITE-21. IF1304.2 +079800 F-PRES-VAL-WRITE-21. IF1304.2 +079900 MOVE "F-PRES-VAL-21" TO PAR-NAME. IF1304.2 +080000 PERFORM PRINT-DETAIL. IF1304.2 +080100*****************SPECIAL PERFORM TEST********************** IF1304.2 +080200 F-PRES-VAL-22. IF1304.2 +080300 PERFORM F-PRES-VAL-TEST-22 IF1304.2 +080400 UNTIL FUNCTION PRESENT-VALUE(ARG1, 2) < 0.5. IF1304.2 +080500 PERFORM PASS. IF1304.2 +080600 GO TO F-PRES-VAL-WRITE-22. IF1304.2 +080700 F-PRES-VAL-TEST-22. IF1304.2 +080800 COMPUTE ARG1 = ARG1 + 1. IF1304.2 +080900 F-PRES-VAL-DELETE-22. IF1304.2 +081000 PERFORM DE-LETE. IF1304.2 +081100 GO TO F-PRES-VAL-WRITE-22. IF1304.2 +081200 F-PRES-VAL-WRITE-22. IF1304.2 +081300 MOVE "F-PRES-VAL-22" TO PAR-NAME. IF1304.2 +081400 PERFORM PRINT-DETAIL. IF1304.2 +081500********************END OF TESTS*************** IF1304.2 +081600 CCVS-EXIT SECTION. IF1304.2 +081700 CCVS-999999. IF1304.2 +081800 GO TO CLOSE-FILES. IF1304.2 +*END-OF,IF130A +*HEADER,COBOL,IF131A +000100 IDENTIFICATION DIVISION. IF1314.2 +000200 PROGRAM-ID. IF1314.2 +000300 IF131A. IF1314.2 +000400 IF1314.2 +000500*********************************************************** IF1314.2 +000600* * IF1314.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1314.2 +000800* It contains tests for the Intrinsic Function * IF1314.2 +000900* RANDOM. * IF1314.2 +001000* * IF1314.2 +001100*********************************************************** IF1314.2 +001200 ENVIRONMENT DIVISION. IF1314.2 +001300 CONFIGURATION SECTION. IF1314.2 +001400 SOURCE-COMPUTER. IF1314.2 +001500 XXXXX082. IF1314.2 +001600 OBJECT-COMPUTER. IF1314.2 +001700 XXXXX083. IF1314.2 +001800 INPUT-OUTPUT SECTION. IF1314.2 +001900 FILE-CONTROL. IF1314.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1314.2 +002100 XXXXX055. IF1314.2 +002200 DATA DIVISION. IF1314.2 +002300 FILE SECTION. IF1314.2 +002400 FD PRINT-FILE. IF1314.2 +002500 01 PRINT-REC PICTURE X(120). IF1314.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1314.2 +002700 WORKING-STORAGE SECTION. IF1314.2 +002800*********************************************************** IF1314.2 +002900* Variables specific to the Intrinsic Function Test IF131A* IF1314.2 +003000*********************************************************** IF1314.2 +003100 01 A PIC S9(10) VALUE 4. IF1314.2 +003200 01 Q PIC S9(10) VALUE 3. IF1314.2 +003300 01 ARR VALUE "40537". IF1314.2 +003400 02 IND OCCURS 5 TIMES PIC 9. IF1314.2 +003500 01 TEMP PIC S9(8)V9(8). IF1314.2 +003600 01 WS-NUM PIC S9(5)V9(6). IF1314.2 +003700 01 MIN-RANGE PIC S9(5)V9(7). IF1314.2 +003800 01 MAX-RANGE PIC S9(5)V9(7). IF1314.2 +003900* IF1314.2 +004000********************************************************** IF1314.2 +004100* IF1314.2 +004200 01 TEST-RESULTS. IF1314.2 +004300 02 FILLER PIC X VALUE SPACE. IF1314.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1314.2 +004500 02 FILLER PIC X VALUE SPACE. IF1314.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1314.2 +004700 02 FILLER PIC X VALUE SPACE. IF1314.2 +004800 02 PAR-NAME. IF1314.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1314.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1314.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1314.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1314.2 +005300 02 RE-MARK PIC X(61). IF1314.2 +005400 01 TEST-COMPUTED. IF1314.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +005600 02 FILLER PIC X(17) VALUE IF1314.2 +005700 " COMPUTED=". IF1314.2 +005800 02 COMPUTED-X. IF1314.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1314.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1314.2 +006100 PIC -9(9).9(9). IF1314.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1314.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1314.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1314.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1314.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1314.2 +006700 04 FILLER PIC X. IF1314.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1314.2 +006900 01 TEST-CORRECT. IF1314.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1314.2 +007200 02 CORRECT-X. IF1314.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1314.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1314.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1314.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1314.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1314.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1314.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1314.2 +008000 04 FILLER PIC X. IF1314.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1314.2 +008300 01 TEST-CORRECT-MIN. IF1314.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +008500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1314.2 +008600 02 CORRECTMI-X. IF1314.2 +008700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1314.2 +008800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1314.2 +008900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1314.2 +009000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1314.2 +009100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1314.2 +009200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1314.2 +009300 04 CORRECTMI-18V0 PIC -9(18). IF1314.2 +009400 04 FILLER PIC X. IF1314.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +009600 03 FILLER PIC X(48) VALUE SPACE. IF1314.2 +009700 01 TEST-CORRECT-MAX. IF1314.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +009900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1314.2 +010000 02 CORRECTMA-X. IF1314.2 +010100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1314.2 +010200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1314.2 +010300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1314.2 +010400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1314.2 +010500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1314.2 +010600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1314.2 +010700 04 CORRECTMA-18V0 PIC -9(18). IF1314.2 +010800 04 FILLER PIC X. IF1314.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +011000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1314.2 +011100 01 CCVS-C-1. IF1314.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1314.2 +011300- "SS PARAGRAPH-NAME IF1314.2 +011400- " REMARKS". IF1314.2 +011500 02 FILLER PIC X(20) VALUE SPACE. IF1314.2 +011600 01 CCVS-C-2. IF1314.2 +011700 02 FILLER PIC X VALUE SPACE. IF1314.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". IF1314.2 +011900 02 FILLER PIC X(15) VALUE SPACE. IF1314.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". IF1314.2 +012100 02 FILLER PIC X(94) VALUE SPACE. IF1314.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1314.2 +012300 01 REC-CT PIC 99 VALUE ZERO. IF1314.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1314.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1314.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1314.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1314.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1314.2 +013300 01 CCVS-H-1. IF1314.2 +013400 02 FILLER PIC X(39) VALUE SPACES. IF1314.2 +013500 02 FILLER PIC X(42) VALUE IF1314.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1314.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1314.2 +013800 01 CCVS-H-2A. IF1314.2 +013900 02 FILLER PIC X(40) VALUE SPACE. IF1314.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1314.2 +014100 02 FILLER PIC XXXX VALUE IF1314.2 +014200 "4.2 ". IF1314.2 +014300 02 FILLER PIC X(28) VALUE IF1314.2 +014400 " COPY - NOT FOR DISTRIBUTION". IF1314.2 +014500 02 FILLER PIC X(41) VALUE SPACE. IF1314.2 +014600 IF1314.2 +014700 01 CCVS-H-2B. IF1314.2 +014800 02 FILLER PIC X(15) VALUE IF1314.2 +014900 "TEST RESULT OF ". IF1314.2 +015000 02 TEST-ID PIC X(9). IF1314.2 +015100 02 FILLER PIC X(4) VALUE IF1314.2 +015200 " IN ". IF1314.2 +015300 02 FILLER PIC X(12) VALUE IF1314.2 +015400 " HIGH ". IF1314.2 +015500 02 FILLER PIC X(22) VALUE IF1314.2 +015600 " LEVEL VALIDATION FOR ". IF1314.2 +015700 02 FILLER PIC X(58) VALUE IF1314.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1314.2 +015900 01 CCVS-H-3. IF1314.2 +016000 02 FILLER PIC X(34) VALUE IF1314.2 +016100 " FOR OFFICIAL USE ONLY ". IF1314.2 +016200 02 FILLER PIC X(58) VALUE IF1314.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1314.2 +016400 02 FILLER PIC X(28) VALUE IF1314.2 +016500 " COPYRIGHT 1985 ". IF1314.2 +016600 01 CCVS-E-1. IF1314.2 +016700 02 FILLER PIC X(52) VALUE SPACE. IF1314.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1314.2 +016900 02 ID-AGAIN PIC X(9). IF1314.2 +017000 02 FILLER PIC X(45) VALUE SPACES. IF1314.2 +017100 01 CCVS-E-2. IF1314.2 +017200 02 FILLER PIC X(31) VALUE SPACE. IF1314.2 +017300 02 FILLER PIC X(21) VALUE SPACE. IF1314.2 +017400 02 CCVS-E-2-2. IF1314.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1314.2 +017600 03 FILLER PIC X VALUE SPACE. IF1314.2 +017700 03 ENDER-DESC PIC X(44) VALUE IF1314.2 +017800 "ERRORS ENCOUNTERED". IF1314.2 +017900 01 CCVS-E-3. IF1314.2 +018000 02 FILLER PIC X(22) VALUE IF1314.2 +018100 " FOR OFFICIAL USE ONLY". IF1314.2 +018200 02 FILLER PIC X(12) VALUE SPACE. IF1314.2 +018300 02 FILLER PIC X(58) VALUE IF1314.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1314.2 +018500 02 FILLER PIC X(13) VALUE SPACE. IF1314.2 +018600 02 FILLER PIC X(15) VALUE IF1314.2 +018700 " COPYRIGHT 1985". IF1314.2 +018800 01 CCVS-E-4. IF1314.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1314.2 +019000 02 FILLER PIC X(4) VALUE " OF ". IF1314.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1314.2 +019200 02 FILLER PIC X(40) VALUE IF1314.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1314.2 +019400 01 XXINFO. IF1314.2 +019500 02 FILLER PIC X(19) VALUE IF1314.2 +019600 "*** INFORMATION ***". IF1314.2 +019700 02 INFO-TEXT. IF1314.2 +019800 04 FILLER PIC X(8) VALUE SPACE. IF1314.2 +019900 04 XXCOMPUTED PIC X(20). IF1314.2 +020000 04 FILLER PIC X(5) VALUE SPACE. IF1314.2 +020100 04 XXCORRECT PIC X(20). IF1314.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). IF1314.2 +020300 01 HYPHEN-LINE. IF1314.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. IF1314.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************IF1314.2 +020600- "*****************************************". IF1314.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************IF1314.2 +020800- "******************************". IF1314.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE IF1314.2 +021000 "IF131A". IF1314.2 +021100 PROCEDURE DIVISION. IF1314.2 +021200 CCVS1 SECTION. IF1314.2 +021300 OPEN-FILES. IF1314.2 +021400 OPEN OUTPUT PRINT-FILE. IF1314.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1314.2 +021600 MOVE SPACE TO TEST-RESULTS. IF1314.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1314.2 +021800 GO TO CCVS1-EXIT. IF1314.2 +021900 CLOSE-FILES. IF1314.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1314.2 +022100 TERMINATE-CCVS. IF1314.2 +022200 STOP RUN. IF1314.2 +022300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1314.2 +022400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1314.2 +022500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1314.2 +022600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1314.2 +022700 MOVE "****TEST DELETED****" TO RE-MARK. IF1314.2 +022800 PRINT-DETAIL. IF1314.2 +022900 IF REC-CT NOT EQUAL TO ZERO IF1314.2 +023000 MOVE "." TO PARDOT-X IF1314.2 +023100 MOVE REC-CT TO DOTVALUE. IF1314.2 +023200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1314.2 +023300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1314.2 +023400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1314.2 +023500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1314.2 +023600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1314.2 +023700 MOVE SPACE TO CORRECT-X. IF1314.2 +023800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1314.2 +023900 MOVE SPACE TO RE-MARK. IF1314.2 +024000 HEAD-ROUTINE. IF1314.2 +024100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1314.2 +024400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1314.2 +024500 COLUMN-NAMES-ROUTINE. IF1314.2 +024600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +024700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +024900 END-ROUTINE. IF1314.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1314.2 +025100 END-RTN-EXIT. IF1314.2 +025200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +025300 END-ROUTINE-1. IF1314.2 +025400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1314.2 +025500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1314.2 +025600 ADD PASS-COUNTER TO ERROR-HOLD. IF1314.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1314.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1314.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1314.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1314.2 +026100 END-ROUTINE-12. IF1314.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1314.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1314.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1314.2 +026500 ELSE IF1314.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1314.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1314.2 +026800 PERFORM WRITE-LINE. IF1314.2 +026900 END-ROUTINE-13. IF1314.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1314.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE IF1314.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1314.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1314.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO IF1314.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1314.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1314.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1314.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +028100 WRITE-LINE. IF1314.2 +028200 ADD 1 TO RECORD-COUNT. IF1314.2 +028300Y IF RECORD-COUNT GREATER 42 IF1314.2 +028400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1314.2 +028500Y MOVE SPACE TO DUMMY-RECORD IF1314.2 +028600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1314.2 +028700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1314.2 +028800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1314.2 +028900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1314.2 +029000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1314.2 +029100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029400Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1314.2 +029500Y MOVE ZERO TO RECORD-COUNT. IF1314.2 +029600 PERFORM WRT-LN. IF1314.2 +029700 WRT-LN. IF1314.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1314.2 +029900 MOVE SPACE TO DUMMY-RECORD. IF1314.2 +030000 BLANK-LINE-PRINT. IF1314.2 +030100 PERFORM WRT-LN. IF1314.2 +030200 FAIL-ROUTINE. IF1314.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE IF1314.2 +030400 GO TO FAIL-ROUTINE-WRITE. IF1314.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1314.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1314.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1314.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1314.2 +031000 GO TO FAIL-ROUTINE-EX. IF1314.2 +031100 FAIL-ROUTINE-WRITE. IF1314.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1314.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1314.2 +031400 CORMA-ANSI-REFERENCE. IF1314.2 +031500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1314.2 +031600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1314.2 +031700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1314.2 +031800 ELSE IF1314.2 +031900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1314.2 +032000 PERFORM WRITE-LINE. IF1314.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1314.2 +032200 FAIL-ROUTINE-EX. EXIT. IF1314.2 +032300 BAIL-OUT. IF1314.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1314.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1314.2 +032600 BAIL-OUT-WRITE. IF1314.2 +032700 MOVE CORRECT-A TO XXCORRECT. IF1314.2 +032800 MOVE COMPUTED-A TO XXCOMPUTED. IF1314.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1314.2 +033000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +033100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1314.2 +033200 BAIL-OUT-EX. EXIT. IF1314.2 +033300 CCVS1-EXIT. IF1314.2 +033400 EXIT. IF1314.2 +033500******************************************************** IF1314.2 +033600* * IF1314.2 +033700* Intrinsic Function Tests IF131A - RANDOM * IF1314.2 +033800* * IF1314.2 +033900******************************************************** IF1314.2 +034000 SECT-IF131A SECTION. IF1314.2 +034100 F-RANDOM-INFO. IF1314.2 +034200 MOVE "See ref. A-64 2.35" TO ANSI-REFERENCE. IF1314.2 +034300 MOVE "RANDOM Function" TO FEATURE. IF1314.2 +034400*****************TEST (a) ****************************** IF1314.2 +034500 F-RANDOM-01. IF1314.2 +034600 MOVE ZERO TO WS-NUM. IF1314.2 +034700 MOVE 0 TO MIN-RANGE. IF1314.2 +034800 MOVE 1 TO MAX-RANGE. IF1314.2 +034900 F-RANDOM-TEST-01. IF1314.2 +035000 COMPUTE WS-NUM = FUNCTION RANDOM. IF1314.2 +035100 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +035200 (WS-NUM < MAX-RANGE) THEN IF1314.2 +035300 PERFORM PASS IF1314.2 +035400 ELSE IF1314.2 +035500 MOVE WS-NUM TO COMPUTED-N IF1314.2 +035600 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +035700 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +035800 PERFORM FAIL. IF1314.2 +035900 GO TO F-RANDOM-WRITE-01. IF1314.2 +036000 F-RANDOM-DELETE-01. IF1314.2 +036100 PERFORM DE-LETE. IF1314.2 +036200 GO TO F-RANDOM-WRITE-01. IF1314.2 +036300 F-RANDOM-WRITE-01. IF1314.2 +036400 MOVE "F-RANDOM-01" TO PAR-NAME. IF1314.2 +036500 PERFORM PRINT-DETAIL. IF1314.2 +036600*****************TEST (b) ****************************** IF1314.2 +036700 F-RANDOM-02. IF1314.2 +036800 EVALUATE FUNCTION RANDOM(3) IF1314.2 +036900 WHEN 0 THRU 1 IF1314.2 +037000 PERFORM PASS IF1314.2 +037100 WHEN OTHER IF1314.2 +037200 PERFORM FAIL. IF1314.2 +037300 GO TO F-RANDOM-WRITE-02. IF1314.2 +037400 F-RANDOM-DELETE-02. IF1314.2 +037500 PERFORM DE-LETE. IF1314.2 +037600 GO TO F-RANDOM-WRITE-02. IF1314.2 +037700 F-RANDOM-WRITE-02. IF1314.2 +037800 MOVE "F-RANDOM-02" TO PAR-NAME. IF1314.2 +037900 PERFORM PRINT-DETAIL. IF1314.2 +038000*****************TEST (c) ****************************** IF1314.2 +038100 F-RANDOM-03. IF1314.2 +038200 MOVE 0 TO MIN-RANGE. IF1314.2 +038300 MOVE 1 TO MAX-RANGE. IF1314.2 +038400 F-RANDOM-TEST-03. IF1314.2 +038500 IF (FUNCTION RANDOM(Q) >= MIN-RANGE) AND IF1314.2 +038600 (FUNCTION RANDOM(Q) < MAX-RANGE) THEN IF1314.2 +038700 PERFORM PASS IF1314.2 +038800 ELSE IF1314.2 +038900 PERFORM FAIL. IF1314.2 +039000 GO TO F-RANDOM-WRITE-03. IF1314.2 +039100 F-RANDOM-DELETE-03. IF1314.2 +039200 PERFORM DE-LETE. IF1314.2 +039300 GO TO F-RANDOM-WRITE-03. IF1314.2 +039400 F-RANDOM-WRITE-03. IF1314.2 +039500 MOVE "F-RANDOM-03" TO PAR-NAME. IF1314.2 +039600 PERFORM PRINT-DETAIL. IF1314.2 +039700*****************TEST (d) ****************************** IF1314.2 +039800 F-RANDOM-04. IF1314.2 +039900 MOVE ZERO TO WS-NUM. IF1314.2 +040000 MOVE 0 TO MIN-RANGE. IF1314.2 +040100 MOVE 1 TO MAX-RANGE. IF1314.2 +040200 F-RANDOM-TEST-04. IF1314.2 +040300 COMPUTE WS-NUM = FUNCTION RANDOM(IND(4)). IF1314.2 +040400 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +040500 (WS-NUM < MAX-RANGE) THEN IF1314.2 +040600 PERFORM PASS IF1314.2 +040700 ELSE IF1314.2 +040800 MOVE WS-NUM TO COMPUTED-N IF1314.2 +040900 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +041000 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +041100 PERFORM FAIL. IF1314.2 +041200 GO TO F-RANDOM-WRITE-04. IF1314.2 +041300 F-RANDOM-DELETE-04. IF1314.2 +041400 PERFORM DE-LETE. IF1314.2 +041500 GO TO F-RANDOM-WRITE-04. IF1314.2 +041600 F-RANDOM-WRITE-04. IF1314.2 +041700 MOVE "F-RANDOM-04" TO PAR-NAME. IF1314.2 +041800 PERFORM PRINT-DETAIL. IF1314.2 +041900*****************TEST (e) ****************************** IF1314.2 +042000 F-RANDOM-05. IF1314.2 +042100 MOVE ZERO TO WS-NUM. IF1314.2 +042200 MOVE 0 TO MIN-RANGE. IF1314.2 +042300 MOVE 1 TO MAX-RANGE. IF1314.2 +042400 F-RANDOM-TEST-05. IF1314.2 +042500 COMPUTE WS-NUM = FUNCTION RANDOM(IND(A)). IF1314.2 +042600 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +042700 (WS-NUM < MAX-RANGE) THEN IF1314.2 +042800 PERFORM PASS IF1314.2 +042900 ELSE IF1314.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1314.2 +043100 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +043200 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +043300 PERFORM FAIL. IF1314.2 +043400 GO TO F-RANDOM-WRITE-05. IF1314.2 +043500 F-RANDOM-DELETE-05. IF1314.2 +043600 PERFORM DE-LETE. IF1314.2 +043700 GO TO F-RANDOM-WRITE-05. IF1314.2 +043800 F-RANDOM-WRITE-05. IF1314.2 +043900 MOVE "F-RANDOM-05" TO PAR-NAME. IF1314.2 +044000 PERFORM PRINT-DETAIL. IF1314.2 +044100*****************TEST (f) ****************************** IF1314.2 +044200 F-RANDOM-06. IF1314.2 +044300 MOVE ZERO TO WS-NUM. IF1314.2 +044400 MOVE 1 TO MIN-RANGE. IF1314.2 +044500 MOVE 2 TO MAX-RANGE. IF1314.2 +044600 F-RANDOM-TEST-06. IF1314.2 +044700 COMPUTE WS-NUM = FUNCTION RANDOM(2) + 1. IF1314.2 +044800 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +044900 (WS-NUM < MAX-RANGE) THEN IF1314.2 +045000 PERFORM PASS IF1314.2 +045100 ELSE IF1314.2 +045200 MOVE WS-NUM TO COMPUTED-N IF1314.2 +045300 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +045400 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +045500 PERFORM FAIL. IF1314.2 +045600 GO TO F-RANDOM-WRITE-06. IF1314.2 +045700 F-RANDOM-DELETE-06. IF1314.2 +045800 PERFORM DE-LETE. IF1314.2 +045900 GO TO F-RANDOM-WRITE-06. IF1314.2 +046000 F-RANDOM-WRITE-06. IF1314.2 +046100 MOVE "F-RANDOM-06" TO PAR-NAME. IF1314.2 +046200 PERFORM PRINT-DETAIL. IF1314.2 +046300*****************TEST (g) ****************************** IF1314.2 +046400 F-RANDOM-07. IF1314.2 +046500 MOVE ZERO TO WS-NUM. IF1314.2 +046600 MOVE 0 TO MIN-RANGE. IF1314.2 +046700 MOVE 2 TO MAX-RANGE. IF1314.2 +046800 F-RANDOM-TEST-07. IF1314.2 +046900 COMPUTE WS-NUM = FUNCTION RANDOM(1) + IF1314.2 +047000 FUNCTION RANDOM(2). IF1314.2 +047100 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +047200 (WS-NUM < MAX-RANGE) THEN IF1314.2 +047300 PERFORM PASS IF1314.2 +047400 ELSE IF1314.2 +047500 MOVE WS-NUM TO COMPUTED-N IF1314.2 +047600 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +047700 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +047800 PERFORM FAIL. IF1314.2 +047900 GO TO F-RANDOM-WRITE-07. IF1314.2 +048000 F-RANDOM-DELETE-07. IF1314.2 +048100 PERFORM DE-LETE. IF1314.2 +048200 GO TO F-RANDOM-WRITE-07. IF1314.2 +048300 F-RANDOM-WRITE-07. IF1314.2 +048400 MOVE "F-RANDOM-07" TO PAR-NAME. IF1314.2 +048500 PERFORM PRINT-DETAIL. IF1314.2 +048600*****************TEST (h) ****************************** IF1314.2 +048700 F-RANDOM-08. IF1314.2 +048800 MOVE ZERO TO WS-NUM. IF1314.2 +048900 MOVE 0 TO MIN-RANGE. IF1314.2 +049000 MOVE 1 TO MAX-RANGE. IF1314.2 +049100 F-RANDOM-TEST-08. IF1314.2 +049200 COMPUTE WS-NUM = FUNCTION RANDOM( IF1314.2 +049300 FUNCTION INTEGER(100 * FUNCTION RANDOM(1))). IF1314.2 +049400 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +049500 (WS-NUM < MAX-RANGE) THEN IF1314.2 +049600 PERFORM PASS IF1314.2 +049700 ELSE IF1314.2 +049800 MOVE WS-NUM TO COMPUTED-N IF1314.2 +049900 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +050000 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +050100 PERFORM FAIL. IF1314.2 +050200 GO TO F-RANDOM-WRITE-08. IF1314.2 +050300 F-RANDOM-DELETE-08. IF1314.2 +050400 PERFORM DE-LETE. IF1314.2 +050500 GO TO F-RANDOM-WRITE-08. IF1314.2 +050600 F-RANDOM-WRITE-08. IF1314.2 +050700 MOVE "F-RANDOM-08" TO PAR-NAME. IF1314.2 +050800 PERFORM PRINT-DETAIL. IF1314.2 +050900********************END OF TESTS*************** IF1314.2 +051000 CCVS-EXIT SECTION. IF1314.2 +051100 CCVS-999999. IF1314.2 +051200 GO TO CLOSE-FILES. IF1314.2 +*END-OF,IF131A +*HEADER,COBOL,IF132A +000100 IDENTIFICATION DIVISION. IF1324.2 +000200 PROGRAM-ID. IF1324.2 +000300 IF132A. IF1324.2 +000400 IF1324.2 +000500*********************************************************** IF1324.2 +000600* * IF1324.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1324.2 +000800* It contains tests for the Intrinsic Function RANGE. * IF1324.2 +000900* * IF1324.2 +001000*********************************************************** IF1324.2 +001100 ENVIRONMENT DIVISION. IF1324.2 +001200 CONFIGURATION SECTION. IF1324.2 +001300 SOURCE-COMPUTER. IF1324.2 +001400 XXXXX082. IF1324.2 +001500 OBJECT-COMPUTER. IF1324.2 +001600 XXXXX083. IF1324.2 +001700 INPUT-OUTPUT SECTION. IF1324.2 +001800 FILE-CONTROL. IF1324.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1324.2 +002000 XXXXX055. IF1324.2 +002100 DATA DIVISION. IF1324.2 +002200 FILE SECTION. IF1324.2 +002300 FD PRINT-FILE. IF1324.2 +002400 01 PRINT-REC PICTURE X(120). IF1324.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1324.2 +002600 WORKING-STORAGE SECTION. IF1324.2 +002700*********************************************************** IF1324.2 +002800* Variables specific to the Intrinsic Function Test IF132A* IF1324.2 +002900*********************************************************** IF1324.2 +003000 01 A PIC S9(10) VALUE 5. IF1324.2 +003100 01 B PIC S9(10) VALUE 7. IF1324.2 +003200 01 C PIC S9(10) VALUE -4. IF1324.2 +003300 01 D PIC S9(10) VALUE 10. IF1324.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1324.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1324.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1324.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1324.2 +003800 01 M PIC S9(10) VALUE 320000. IF1324.2 +003900 01 N PIC S9(10) VALUE 650000. IF1324.2 +004000 01 O PIC S9(10) VALUE -430000. IF1324.2 +004100 01 P PIC S9(10) VALUE 1. IF1324.2 +004200 01 Q PIC S9(10) VALUE 3. IF1324.2 +004300 01 R PIC S9(10) VALUE 5. IF1324.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1324.2 +004500 01 ARR VALUE "40537". IF1324.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1324.2 +004700 01 TEMP PIC S9(10). IF1324.2 +004800 01 WS-NUM PIC S9(7)V9(7). IF1324.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1324.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1324.2 +005100* IF1324.2 +005200********************************************************** IF1324.2 +005300* IF1324.2 +005400 01 TEST-RESULTS. IF1324.2 +005500 02 FILLER PIC X VALUE SPACE. IF1324.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1324.2 +005700 02 FILLER PIC X VALUE SPACE. IF1324.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1324.2 +005900 02 FILLER PIC X VALUE SPACE. IF1324.2 +006000 02 PAR-NAME. IF1324.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1324.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1324.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1324.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1324.2 +006500 02 RE-MARK PIC X(61). IF1324.2 +006600 01 TEST-COMPUTED. IF1324.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +006800 02 FILLER PIC X(17) VALUE IF1324.2 +006900 " COMPUTED=". IF1324.2 +007000 02 COMPUTED-X. IF1324.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1324.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1324.2 +007300 PIC -9(9).9(9). IF1324.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1324.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1324.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1324.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1324.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1324.2 +007900 04 FILLER PIC X. IF1324.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1324.2 +008100 01 TEST-CORRECT. IF1324.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1324.2 +008400 02 CORRECT-X. IF1324.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1324.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1324.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1324.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1324.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1324.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1324.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1324.2 +009200 04 FILLER PIC X. IF1324.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1324.2 +009500 01 TEST-CORRECT-MIN. IF1324.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1324.2 +009800 02 CORRECTMI-X. IF1324.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1324.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1324.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1324.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1324.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1324.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1324.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1324.2 +010600 04 FILLER PIC X. IF1324.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1324.2 +010900 01 TEST-CORRECT-MAX. IF1324.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1324.2 +011200 02 CORRECTMA-X. IF1324.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1324.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1324.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1324.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1324.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1324.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1324.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1324.2 +012000 04 FILLER PIC X. IF1324.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1324.2 +012300 01 CCVS-C-1. IF1324.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1324.2 +012500- "SS PARAGRAPH-NAME IF1324.2 +012600- " REMARKS". IF1324.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1324.2 +012800 01 CCVS-C-2. IF1324.2 +012900 02 FILLER PIC X VALUE SPACE. IF1324.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1324.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1324.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1324.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1324.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1324.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1324.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1324.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1324.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1324.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1324.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1324.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1324.2 +014500 01 CCVS-H-1. IF1324.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1324.2 +014700 02 FILLER PIC X(42) VALUE IF1324.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1324.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1324.2 +015000 01 CCVS-H-2A. IF1324.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1324.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1324.2 +015300 02 FILLER PIC XXXX VALUE IF1324.2 +015400 "4.2 ". IF1324.2 +015500 02 FILLER PIC X(28) VALUE IF1324.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1324.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1324.2 +015800 IF1324.2 +015900 01 CCVS-H-2B. IF1324.2 +016000 02 FILLER PIC X(15) VALUE IF1324.2 +016100 "TEST RESULT OF ". IF1324.2 +016200 02 TEST-ID PIC X(9). IF1324.2 +016300 02 FILLER PIC X(4) VALUE IF1324.2 +016400 " IN ". IF1324.2 +016500 02 FILLER PIC X(12) VALUE IF1324.2 +016600 " HIGH ". IF1324.2 +016700 02 FILLER PIC X(22) VALUE IF1324.2 +016800 " LEVEL VALIDATION FOR ". IF1324.2 +016900 02 FILLER PIC X(58) VALUE IF1324.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1324.2 +017100 01 CCVS-H-3. IF1324.2 +017200 02 FILLER PIC X(34) VALUE IF1324.2 +017300 " FOR OFFICIAL USE ONLY ". IF1324.2 +017400 02 FILLER PIC X(58) VALUE IF1324.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1324.2 +017600 02 FILLER PIC X(28) VALUE IF1324.2 +017700 " COPYRIGHT 1985 ". IF1324.2 +017800 01 CCVS-E-1. IF1324.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1324.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1324.2 +018100 02 ID-AGAIN PIC X(9). IF1324.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1324.2 +018300 01 CCVS-E-2. IF1324.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1324.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1324.2 +018600 02 CCVS-E-2-2. IF1324.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1324.2 +018800 03 FILLER PIC X VALUE SPACE. IF1324.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1324.2 +019000 "ERRORS ENCOUNTERED". IF1324.2 +019100 01 CCVS-E-3. IF1324.2 +019200 02 FILLER PIC X(22) VALUE IF1324.2 +019300 " FOR OFFICIAL USE ONLY". IF1324.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1324.2 +019500 02 FILLER PIC X(58) VALUE IF1324.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1324.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1324.2 +019800 02 FILLER PIC X(15) VALUE IF1324.2 +019900 " COPYRIGHT 1985". IF1324.2 +020000 01 CCVS-E-4. IF1324.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1324.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1324.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1324.2 +020400 02 FILLER PIC X(40) VALUE IF1324.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1324.2 +020600 01 XXINFO. IF1324.2 +020700 02 FILLER PIC X(19) VALUE IF1324.2 +020800 "*** INFORMATION ***". IF1324.2 +020900 02 INFO-TEXT. IF1324.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1324.2 +021100 04 XXCOMPUTED PIC X(20). IF1324.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1324.2 +021300 04 XXCORRECT PIC X(20). IF1324.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1324.2 +021500 01 HYPHEN-LINE. IF1324.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1324.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1324.2 +021800- "*****************************************". IF1324.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1324.2 +022000- "******************************". IF1324.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1324.2 +022200 "IF132A". IF1324.2 +022300 PROCEDURE DIVISION. IF1324.2 +022400 CCVS1 SECTION. IF1324.2 +022500 OPEN-FILES. IF1324.2 +022600 OPEN OUTPUT PRINT-FILE. IF1324.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1324.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1324.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1324.2 +023000 GO TO CCVS1-EXIT. IF1324.2 +023100 CLOSE-FILES. IF1324.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1324.2 +023300 TERMINATE-CCVS. IF1324.2 +023400 STOP RUN. IF1324.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1324.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1324.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1324.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1324.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1324.2 +024000 PRINT-DETAIL. IF1324.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1324.2 +024200 MOVE "." TO PARDOT-X IF1324.2 +024300 MOVE REC-CT TO DOTVALUE. IF1324.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1324.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1324.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1324.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1324.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1324.2 +024900 MOVE SPACE TO CORRECT-X. IF1324.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1324.2 +025100 MOVE SPACE TO RE-MARK. IF1324.2 +025200 HEAD-ROUTINE. IF1324.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1324.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1324.2 +025700 COLUMN-NAMES-ROUTINE. IF1324.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +026100 END-ROUTINE. IF1324.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1324.2 +026300 END-RTN-EXIT. IF1324.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +026500 END-ROUTINE-1. IF1324.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1324.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1324.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1324.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1324.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1324.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1324.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1324.2 +027300 END-ROUTINE-12. IF1324.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1324.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1324.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1324.2 +027700 ELSE IF1324.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1324.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1324.2 +028000 PERFORM WRITE-LINE. IF1324.2 +028100 END-ROUTINE-13. IF1324.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1324.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1324.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1324.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1324.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1324.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1324.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1324.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1324.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +029300 WRITE-LINE. IF1324.2 +029400 ADD 1 TO RECORD-COUNT. IF1324.2 +029500Y IF RECORD-COUNT GREATER 42 IF1324.2 +029600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1324.2 +029700Y MOVE SPACE TO DUMMY-RECORD IF1324.2 +029800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1324.2 +029900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1324.2 +030000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1324.2 +030100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1324.2 +030200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1324.2 +030300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1324.2 +030700Y MOVE ZERO TO RECORD-COUNT. IF1324.2 +030800 PERFORM WRT-LN. IF1324.2 +030900 WRT-LN. IF1324.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1324.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1324.2 +031200 BLANK-LINE-PRINT. IF1324.2 +031300 PERFORM WRT-LN. IF1324.2 +031400 FAIL-ROUTINE. IF1324.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1324.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1324.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1324.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1324.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1324.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1324.2 +032200 GO TO FAIL-ROUTINE-EX. IF1324.2 +032300 FAIL-ROUTINE-WRITE. IF1324.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1324.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1324.2 +032600 CORMA-ANSI-REFERENCE. IF1324.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1324.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1324.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1324.2 +033000 ELSE IF1324.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1324.2 +033200 PERFORM WRITE-LINE. IF1324.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1324.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1324.2 +033500 BAIL-OUT. IF1324.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1324.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1324.2 +033800 BAIL-OUT-WRITE. IF1324.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1324.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1324.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1324.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1324.2 +034400 BAIL-OUT-EX. EXIT. IF1324.2 +034500 CCVS1-EXIT. IF1324.2 +034600 EXIT. IF1324.2 +034700******************************************************** IF1324.2 +034800* * IF1324.2 +034900* Intrinsic Function Tests IF132A - RANGE * IF1324.2 +035000* * IF1324.2 +035100******************************************************** IF1324.2 +035200 SECT-IF132A SECTION. IF1324.2 +035300 F-RANGE-INFO. IF1324.2 +035400 MOVE "See ref. A-65 2.65" TO ANSI-REFERENCE. IF1324.2 +035500 MOVE "RANGE Function" TO FEATURE. IF1324.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1324.2 +035700 F-RANGE-01. IF1324.2 +035800 MOVE ZERO TO WS-NUM. IF1324.2 +035900 F-RANGE-TEST-01. IF1324.2 +036000 COMPUTE WS-NUM = FUNCTION RANGE(5, -2, -14, 0). IF1324.2 +036100 IF WS-NUM = 19 THEN IF1324.2 +036200 PERFORM PASS IF1324.2 +036300 ELSE IF1324.2 +036400 MOVE WS-NUM TO COMPUTED-N IF1324.2 +036500 MOVE 19 TO CORRECT-N IF1324.2 +036600 PERFORM FAIL. IF1324.2 +036700 GO TO F-RANGE-WRITE-01. IF1324.2 +036800 F-RANGE-DELETE-01. IF1324.2 +036900 PERFORM DE-LETE. IF1324.2 +037000 GO TO F-RANGE-WRITE-01. IF1324.2 +037100 F-RANGE-WRITE-01. IF1324.2 +037200 MOVE "F-RANGE-01" TO PAR-NAME. IF1324.2 +037300 PERFORM PRINT-DETAIL. IF1324.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1324.2 +037500 F-RANGE-02. IF1324.2 +037600 EVALUATE FUNCTION RANGE(3.9, -0.3, 8.7, 100.2) IF1324.2 +037700 WHEN 100.498 THRU 100.502 IF1324.2 +037800 PERFORM PASS IF1324.2 +037900 WHEN OTHER IF1324.2 +038000 PERFORM FAIL. IF1324.2 +038100 GO TO F-RANGE-WRITE-02. IF1324.2 +038200 F-RANGE-DELETE-02. IF1324.2 +038300 PERFORM DE-LETE. IF1324.2 +038400 GO TO F-RANGE-WRITE-02. IF1324.2 +038500 F-RANGE-WRITE-02. IF1324.2 +038600 MOVE "F-RANGE-02" TO PAR-NAME. IF1324.2 +038700 PERFORM PRINT-DETAIL. IF1324.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1324.2 +038900 F-RANGE-03. IF1324.2 +039000 IF FUNCTION RANGE(A, B, C, D) = 14 THEN IF1324.2 +039100 PERFORM PASS IF1324.2 +039200 ELSE IF1324.2 +039300 PERFORM FAIL. IF1324.2 +039400 GO TO F-RANGE-WRITE-03. IF1324.2 +039500 F-RANGE-DELETE-03. IF1324.2 +039600 PERFORM DE-LETE. IF1324.2 +039700 GO TO F-RANGE-WRITE-03. IF1324.2 +039800 F-RANGE-WRITE-03. IF1324.2 +039900 MOVE "F-RANGE-03" TO PAR-NAME. IF1324.2 +040000 PERFORM PRINT-DETAIL. IF1324.2 +040100*****************TEST (d) - SIMPLE TEST***************** IF1324.2 +040200 F-RANGE-04. IF1324.2 +040300 MOVE ZERO TO WS-NUM. IF1324.2 +040400 F-RANGE-TEST-04. IF1324.2 +040500 COMPUTE WS-NUM = FUNCTION RANGE(E, F, G). IF1324.2 +040600 IF (WS-NUM >= 42.5791) AND IF1324.2 +040700 (WS-NUM <= 42.5809) IF1324.2 +040800 PERFORM PASS IF1324.2 +040900 ELSE IF1324.2 +041000 MOVE WS-NUM TO COMPUTED-N IF1324.2 +041100 MOVE 42.58 TO CORRECT-N IF1324.2 +041200 PERFORM FAIL. IF1324.2 +041300 GO TO F-RANGE-WRITE-04. IF1324.2 +041400 F-RANGE-DELETE-04. IF1324.2 +041500 PERFORM DE-LETE. IF1324.2 +041600 GO TO F-RANGE-WRITE-04. IF1324.2 +041700 F-RANGE-WRITE-04. IF1324.2 +041800 MOVE "F-RANGE-04" TO PAR-NAME. IF1324.2 +041900 PERFORM PRINT-DETAIL. IF1324.2 +042000*****************TEST (e) - SIMPLE TEST***************** IF1324.2 +042100 F-RANGE-05. IF1324.2 +042200 MOVE ZERO TO WS-NUM. IF1324.2 +042300 F-RANGE-TEST-05. IF1324.2 +042400 COMPUTE WS-NUM = FUNCTION RANGE(10.2 -0.2, 5.6, -15.6). IF1324.2 +042500 IF (WS-NUM >= 25.7995) AND IF1324.2 +042600 (WS-NUM <= 25.8005) IF1324.2 +042700 PERFORM PASS IF1324.2 +042800 ELSE IF1324.2 +042900 MOVE WS-NUM TO COMPUTED-N IF1324.2 +043000 MOVE 25.8 TO CORRECT-N IF1324.2 +043100 PERFORM FAIL. IF1324.2 +043200 GO TO F-RANGE-WRITE-05. IF1324.2 +043300 F-RANGE-DELETE-05. IF1324.2 +043400 PERFORM DE-LETE. IF1324.2 +043500 GO TO F-RANGE-WRITE-05. IF1324.2 +043600 F-RANGE-WRITE-05. IF1324.2 +043700 MOVE "F-RANGE-05" TO PAR-NAME. IF1324.2 +043800 PERFORM PRINT-DETAIL. IF1324.2 +043900*****************TEST (f) - SIMPLE TEST***************** IF1324.2 +044000 F-RANGE-06. IF1324.2 +044100 MOVE ZERO TO WS-NUM. IF1324.2 +044200 F-RANGE-TEST-06. IF1324.2 +044300 COMPUTE WS-NUM = FUNCTION RANGE(A, B, C, D, E, F, G). IF1324.2 +044400 IF (WS-NUM >= 42.5791) AND IF1324.2 +044500 (WS-NUM <= 42.5809) IF1324.2 +044600 PERFORM PASS IF1324.2 +044700 ELSE IF1324.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1324.2 +044900 MOVE 42.58 TO CORRECT-N IF1324.2 +045000 PERFORM FAIL. IF1324.2 +045100 GO TO F-RANGE-WRITE-06. IF1324.2 +045200 F-RANGE-DELETE-06. IF1324.2 +045300 PERFORM DE-LETE. IF1324.2 +045400 GO TO F-RANGE-WRITE-06. IF1324.2 +045500 F-RANGE-WRITE-06. IF1324.2 +045600 MOVE "F-RANGE-06" TO PAR-NAME. IF1324.2 +045700 PERFORM PRINT-DETAIL. IF1324.2 +045800*****************TEST (g) - SIMPLE TEST***************** IF1324.2 +045900 F-RANGE-07. IF1324.2 +046000 MOVE ZERO TO WS-NUM. IF1324.2 +046100 F-RANGE-TEST-07. IF1324.2 +046200 COMPUTE WS-NUM = FUNCTION RANGE(IND(1), IND(2), IND(3)). IF1324.2 +046300 IF WS-NUM = 5 THEN IF1324.2 +046400 PERFORM PASS IF1324.2 +046500 ELSE IF1324.2 +046600 MOVE WS-NUM TO COMPUTED-N IF1324.2 +046700 MOVE 5 TO CORRECT-N IF1324.2 +046800 PERFORM FAIL. IF1324.2 +046900 GO TO F-RANGE-WRITE-07. IF1324.2 +047000 F-RANGE-DELETE-07. IF1324.2 +047100 PERFORM DE-LETE. IF1324.2 +047200 GO TO F-RANGE-WRITE-07. IF1324.2 +047300 F-RANGE-WRITE-07. IF1324.2 +047400 MOVE "F-RANGE-07" TO PAR-NAME. IF1324.2 +047500 PERFORM PRINT-DETAIL. IF1324.2 +047600*****************TEST (h) - SIMPLE TEST***************** IF1324.2 +047700 F-RANGE-08. IF1324.2 +047800 MOVE ZERO TO WS-NUM. IF1324.2 +047900 F-RANGE-TEST-08. IF1324.2 +048000 COMPUTE WS-NUM = FUNCTION RANGE(IND(P), IND(Q), IND(R)). IF1324.2 +048100 IF WS-NUM = 3 THEN IF1324.2 +048200 PERFORM PASS IF1324.2 +048300 ELSE IF1324.2 +048400 MOVE WS-NUM TO COMPUTED-N IF1324.2 +048500 MOVE 3 TO CORRECT-N IF1324.2 +048600 PERFORM FAIL. IF1324.2 +048700 GO TO F-RANGE-WRITE-08. IF1324.2 +048800 F-RANGE-DELETE-08. IF1324.2 +048900 PERFORM DE-LETE. IF1324.2 +049000 GO TO F-RANGE-WRITE-08. IF1324.2 +049100 F-RANGE-WRITE-08. IF1324.2 +049200 MOVE "F-RANGE-08" TO PAR-NAME. IF1324.2 +049300 PERFORM PRINT-DETAIL. IF1324.2 +049400*****************TEST (i) - SIMPLE TEST***************** IF1324.2 +049500 F-RANGE-09. IF1324.2 +049600 MOVE ZERO TO WS-NUM. IF1324.2 +049700 F-RANGE-TEST-09. IF1324.2 +049800 COMPUTE WS-NUM = FUNCTION RANGE(IND(ALL)). IF1324.2 +049900 IF WS-NUM = 7 THEN IF1324.2 +050000 PERFORM PASS IF1324.2 +050100 ELSE IF1324.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1324.2 +050300 MOVE 7 TO CORRECT-N IF1324.2 +050400 PERFORM FAIL. IF1324.2 +050500 GO TO F-RANGE-WRITE-09. IF1324.2 +050600 F-RANGE-DELETE-09. IF1324.2 +050700 PERFORM DE-LETE. IF1324.2 +050800 GO TO F-RANGE-WRITE-09. IF1324.2 +050900 F-RANGE-WRITE-09. IF1324.2 +051000 MOVE "F-RANGE-09" TO PAR-NAME. IF1324.2 +051100 PERFORM PRINT-DETAIL. IF1324.2 +051200*****************TEST (k) - SIMPLE TEST***************** IF1324.2 +051300 F-RANGE-11. IF1324.2 +051400 MOVE ZERO TO WS-NUM. IF1324.2 +051500 F-RANGE-TEST-11. IF1324.2 +051600 COMPUTE WS-NUM = FUNCTION RANGE(M, N, O). IF1324.2 +051700 IF WS-NUM = 1080000 THEN IF1324.2 +051800 PERFORM PASS IF1324.2 +051900 ELSE IF1324.2 +052000 MOVE WS-NUM TO COMPUTED-N IF1324.2 +052100 MOVE 1080000 TO CORRECT-N IF1324.2 +052200 PERFORM FAIL. IF1324.2 +052300 GO TO F-RANGE-WRITE-11. IF1324.2 +052400 F-RANGE-DELETE-11. IF1324.2 +052500 PERFORM DE-LETE. IF1324.2 +052600 GO TO F-RANGE-WRITE-11. IF1324.2 +052700 F-RANGE-WRITE-11. IF1324.2 +052800 MOVE "F-RANGE-11" TO PAR-NAME. IF1324.2 +052900 PERFORM PRINT-DETAIL. IF1324.2 +053000*****************TEST (l) - SIMPLE TEST***************** IF1324.2 +053100 F-RANGE-12. IF1324.2 +053200 MOVE ZERO TO WS-NUM. IF1324.2 +053300 F-RANGE-TEST-12. IF1324.2 +053400 COMPUTE WS-NUM = FUNCTION RANGE(A, 5, A). IF1324.2 +053500 IF WS-NUM = 0 THEN IF1324.2 +053600 PERFORM PASS IF1324.2 +053700 ELSE IF1324.2 +053800 MOVE WS-NUM TO COMPUTED-N IF1324.2 +053900 MOVE 0 TO CORRECT-N IF1324.2 +054000 PERFORM FAIL. IF1324.2 +054100 GO TO F-RANGE-WRITE-12. IF1324.2 +054200 F-RANGE-DELETE-12. IF1324.2 +054300 PERFORM DE-LETE. IF1324.2 +054400 GO TO F-RANGE-WRITE-12. IF1324.2 +054500 F-RANGE-WRITE-12. IF1324.2 +054600 MOVE "F-RANGE-12" TO PAR-NAME. IF1324.2 +054700 PERFORM PRINT-DETAIL. IF1324.2 +054800*****************TEST (a) - COMPLEX TEST**************** IF1324.2 +054900 F-RANGE-13. IF1324.2 +055000 MOVE ZERO TO WS-NUM. IF1324.2 +055100 MOVE 79.9984 TO MIN-RANGE. IF1324.2 +055200 MOVE 80.0160 TO MAX-RANGE. IF1324.2 +055300 F-RANGE-TEST-13. IF1324.2 +055400 COMPUTE WS-NUM = FUNCTION RANGE(A, B) + 78. IF1324.2 +055500 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +055600 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +055700 PERFORM PASS IF1324.2 +055800 ELSE IF1324.2 +055900 MOVE WS-NUM TO COMPUTED-N IF1324.2 +056000 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +056100 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +056200 PERFORM FAIL. IF1324.2 +056300 GO TO F-RANGE-WRITE-13. IF1324.2 +056400 F-RANGE-DELETE-13. IF1324.2 +056500 PERFORM DE-LETE. IF1324.2 +056600 GO TO F-RANGE-WRITE-13. IF1324.2 +056700 F-RANGE-WRITE-13. IF1324.2 +056800 MOVE "F-RANGE-13" TO PAR-NAME. IF1324.2 +056900 PERFORM PRINT-DETAIL. IF1324.2 +057000*****************TEST (b) - COMPLEX TEST**************** IF1324.2 +057100 F-RANGE-14. IF1324.2 +057200 MOVE ZERO TO WS-NUM. IF1324.2 +057300 MOVE 7.39985 TO MIN-RANGE. IF1324.2 +057400 MOVE 7.40015 TO MAX-RANGE. IF1324.2 +057500 F-RANGE-TEST-14. IF1324.2 +057600 COMPUTE WS-NUM = FUNCTION RANGE(A, B) + IF1324.2 +057700 FUNCTION RANGE(-2.6, -4.4, 1). IF1324.2 +057800 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +057900 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +058000 PERFORM PASS IF1324.2 +058100 ELSE IF1324.2 +058200 MOVE WS-NUM TO COMPUTED-N IF1324.2 +058300 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +058400 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +058500 PERFORM FAIL. IF1324.2 +058600 GO TO F-RANGE-WRITE-14. IF1324.2 +058700 F-RANGE-DELETE-14. IF1324.2 +058800 PERFORM DE-LETE. IF1324.2 +058900 GO TO F-RANGE-WRITE-14. IF1324.2 +059000 F-RANGE-WRITE-14. IF1324.2 +059100 MOVE "F-RANGE-14" TO PAR-NAME. IF1324.2 +059200 PERFORM PRINT-DETAIL. IF1324.2 +059300*****************TEST (c) - COMPLEX TEST**************** IF1324.2 +059400 F-RANGE-15. IF1324.2 +059500 MOVE ZERO TO WS-NUM. IF1324.2 +059600 MOVE 9.59981 TO MIN-RANGE. IF1324.2 +059700 MOVE 9.60019 TO MAX-RANGE. IF1324.2 +059800 F-RANGE-TEST-15. IF1324.2 +059900 COMPUTE WS-NUM = IF1324.2 +060000 FUNCTION RANGE(FUNCTION RANGE(6.8, -6.8), 4). IF1324.2 +060100 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +060200 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +060300 PERFORM PASS IF1324.2 +060400 ELSE IF1324.2 +060500 MOVE WS-NUM TO COMPUTED-N IF1324.2 +060600 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +060700 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +060800 PERFORM FAIL. IF1324.2 +060900 GO TO F-RANGE-WRITE-15. IF1324.2 +061000 F-RANGE-DELETE-15. IF1324.2 +061100 PERFORM DE-LETE. IF1324.2 +061200 GO TO F-RANGE-WRITE-15. IF1324.2 +061300 F-RANGE-WRITE-15. IF1324.2 +061400 MOVE "F-RANGE-15" TO PAR-NAME. IF1324.2 +061500 PERFORM PRINT-DETAIL. IF1324.2 +061600*****************SPECIAL PERFORM TEST********************** IF1324.2 +061700 F-RANGE-16. IF1324.2 +061800 PERFORM F-RANGE-TEST-16 IF1324.2 +061900 UNTIL FUNCTION RANGE(ARG1, 1) > 10. IF1324.2 +062000 PERFORM PASS. IF1324.2 +062100 GO TO F-RANGE-WRITE-16. IF1324.2 +062200 F-RANGE-TEST-16. IF1324.2 +062300 COMPUTE ARG1 = ARG1 + 1. IF1324.2 +062400 F-RANGE-DELETE-16. IF1324.2 +062500 PERFORM DE-LETE. IF1324.2 +062600 GO TO F-RANGE-WRITE-16. IF1324.2 +062700 F-RANGE-WRITE-16. IF1324.2 +062800 MOVE "F-RANGE-16" TO PAR-NAME. IF1324.2 +062900 PERFORM PRINT-DETAIL. IF1324.2 +063000********************END OF TESTS*************** IF1324.2 +063100 CCVS-EXIT SECTION. IF1324.2 +063200 CCVS-999999. IF1324.2 +063300 GO TO CLOSE-FILES. IF1324.2 +*END-OF,IF132A +*HEADER,COBOL,IF133A +000100 IDENTIFICATION DIVISION. IF1334.2 +000200 PROGRAM-ID. IF1334.2 +000300 IF133A. IF1334.2 +000400 IF1334.2 +000500*********************************************************** IF1334.2 +000600* * IF1334.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1334.2 +000800* It contains tests for the Intrinsic Function * IF1334.2 +000900* REM. * IF1334.2 +001000* * IF1334.2 +001100*********************************************************** IF1334.2 +001200 ENVIRONMENT DIVISION. IF1334.2 +001300 CONFIGURATION SECTION. IF1334.2 +001400 SOURCE-COMPUTER. IF1334.2 +001500 XXXXX082. IF1334.2 +001600 OBJECT-COMPUTER. IF1334.2 +001700 XXXXX083. IF1334.2 +001800 INPUT-OUTPUT SECTION. IF1334.2 +001900 FILE-CONTROL. IF1334.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1334.2 +002100 XXXXX055. IF1334.2 +002200 DATA DIVISION. IF1334.2 +002300 FILE SECTION. IF1334.2 +002400 FD PRINT-FILE. IF1334.2 +002500 01 PRINT-REC PICTURE X(120). IF1334.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1334.2 +002700 WORKING-STORAGE SECTION. IF1334.2 +002800*********************************************************** IF1334.2 +002900* Variables specific to the Intrinsic Function Test IF133A* IF1334.2 +003000*********************************************************** IF1334.2 +003100 01 A PIC S9(10) VALUE 5. IF1334.2 +003200 01 B PIC S9(5)V9(5) VALUE 7.36. IF1334.2 +003300 01 C PIC S9(10) VALUE -4. IF1334.2 +003400 01 D PIC S9(10) VALUE 7. IF1334.2 +003500 01 ARG2 PIC S9(10) VALUE 1. IF1334.2 +003600 01 TEMP PIC S9(10). IF1334.2 +003700 01 WS-NUM PIC S9(5)V9(6). IF1334.2 +003800 01 MIN-RANGE PIC S9(5)V9(7). IF1334.2 +003900 01 MAX-RANGE PIC S9(5)V9(7). IF1334.2 +004000* IF1334.2 +004100********************************************************** IF1334.2 +004200* IF1334.2 +004300 01 TEST-RESULTS. IF1334.2 +004400 02 FILLER PIC X VALUE SPACE. IF1334.2 +004500 02 FEATURE PIC X(20) VALUE SPACE. IF1334.2 +004600 02 FILLER PIC X VALUE SPACE. IF1334.2 +004700 02 P-OR-F PIC X(5) VALUE SPACE. IF1334.2 +004800 02 FILLER PIC X VALUE SPACE. IF1334.2 +004900 02 PAR-NAME. IF1334.2 +005000 03 FILLER PIC X(19) VALUE SPACE. IF1334.2 +005100 03 PARDOT-X PIC X VALUE SPACE. IF1334.2 +005200 03 DOTVALUE PIC 99 VALUE ZERO. IF1334.2 +005300 02 FILLER PIC X(8) VALUE SPACE. IF1334.2 +005400 02 RE-MARK PIC X(61). IF1334.2 +005500 01 TEST-COMPUTED. IF1334.2 +005600 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +005700 02 FILLER PIC X(17) VALUE IF1334.2 +005800 " COMPUTED=". IF1334.2 +005900 02 COMPUTED-X. IF1334.2 +006000 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1334.2 +006100 03 COMPUTED-N REDEFINES COMPUTED-A IF1334.2 +006200 PIC -9(9).9(9). IF1334.2 +006300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1334.2 +006400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1334.2 +006500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1334.2 +006600 03 CM-18V0 REDEFINES COMPUTED-A. IF1334.2 +006700 04 COMPUTED-18V0 PIC -9(18). IF1334.2 +006800 04 FILLER PIC X. IF1334.2 +006900 03 FILLER PIC X(50) VALUE SPACE. IF1334.2 +007000 01 TEST-CORRECT. IF1334.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +007200 02 FILLER PIC X(17) VALUE " CORRECT =". IF1334.2 +007300 02 CORRECT-X. IF1334.2 +007400 03 CORRECT-A PIC X(20) VALUE SPACE. IF1334.2 +007500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1334.2 +007600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1334.2 +007700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1334.2 +007800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1334.2 +007900 03 CR-18V0 REDEFINES CORRECT-A. IF1334.2 +008000 04 CORRECT-18V0 PIC -9(18). IF1334.2 +008100 04 FILLER PIC X. IF1334.2 +008200 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +008300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1334.2 +008400 01 TEST-CORRECT-MIN. IF1334.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +008600 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1334.2 +008700 02 CORRECTMI-X. IF1334.2 +008800 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1334.2 +008900 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1334.2 +009000 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1334.2 +009100 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1334.2 +009200 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1334.2 +009300 03 CR-18V0 REDEFINES CORRECTMI-A. IF1334.2 +009400 04 CORRECTMI-18V0 PIC -9(18). IF1334.2 +009500 04 FILLER PIC X. IF1334.2 +009600 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +009700 03 FILLER PIC X(48) VALUE SPACE. IF1334.2 +009800 01 TEST-CORRECT-MAX. IF1334.2 +009900 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +010000 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1334.2 +010100 02 CORRECTMA-X. IF1334.2 +010200 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1334.2 +010300 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1334.2 +010400 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1334.2 +010500 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1334.2 +010600 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1334.2 +010700 03 CR-18V0 REDEFINES CORRECTMA-A. IF1334.2 +010800 04 CORRECTMA-18V0 PIC -9(18). IF1334.2 +010900 04 FILLER PIC X. IF1334.2 +011000 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +011100 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1334.2 +011200 01 CCVS-C-1. IF1334.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1334.2 +011400- "SS PARAGRAPH-NAME IF1334.2 +011500- " REMARKS". IF1334.2 +011600 02 FILLER PIC X(20) VALUE SPACE. IF1334.2 +011700 01 CCVS-C-2. IF1334.2 +011800 02 FILLER PIC X VALUE SPACE. IF1334.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". IF1334.2 +012000 02 FILLER PIC X(15) VALUE SPACE. IF1334.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". IF1334.2 +012200 02 FILLER PIC X(94) VALUE SPACE. IF1334.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1334.2 +012400 01 REC-CT PIC 99 VALUE ZERO. IF1334.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1334.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1334.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1334.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1334.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1334.2 +013400 01 CCVS-H-1. IF1334.2 +013500 02 FILLER PIC X(39) VALUE SPACES. IF1334.2 +013600 02 FILLER PIC X(42) VALUE IF1334.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1334.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IF1334.2 +013900 01 CCVS-H-2A. IF1334.2 +014000 02 FILLER PIC X(40) VALUE SPACE. IF1334.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1334.2 +014200 02 FILLER PIC XXXX VALUE IF1334.2 +014300 "4.2 ". IF1334.2 +014400 02 FILLER PIC X(28) VALUE IF1334.2 +014500 " COPY - NOT FOR DISTRIBUTION". IF1334.2 +014600 02 FILLER PIC X(41) VALUE SPACE. IF1334.2 +014700 IF1334.2 +014800 01 CCVS-H-2B. IF1334.2 +014900 02 FILLER PIC X(15) VALUE IF1334.2 +015000 "TEST RESULT OF ". IF1334.2 +015100 02 TEST-ID PIC X(9). IF1334.2 +015200 02 FILLER PIC X(4) VALUE IF1334.2 +015300 " IN ". IF1334.2 +015400 02 FILLER PIC X(12) VALUE IF1334.2 +015500 " HIGH ". IF1334.2 +015600 02 FILLER PIC X(22) VALUE IF1334.2 +015700 " LEVEL VALIDATION FOR ". IF1334.2 +015800 02 FILLER PIC X(58) VALUE IF1334.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1334.2 +016000 01 CCVS-H-3. IF1334.2 +016100 02 FILLER PIC X(34) VALUE IF1334.2 +016200 " FOR OFFICIAL USE ONLY ". IF1334.2 +016300 02 FILLER PIC X(58) VALUE IF1334.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1334.2 +016500 02 FILLER PIC X(28) VALUE IF1334.2 +016600 " COPYRIGHT 1985 ". IF1334.2 +016700 01 CCVS-E-1. IF1334.2 +016800 02 FILLER PIC X(52) VALUE SPACE. IF1334.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1334.2 +017000 02 ID-AGAIN PIC X(9). IF1334.2 +017100 02 FILLER PIC X(45) VALUE SPACES. IF1334.2 +017200 01 CCVS-E-2. IF1334.2 +017300 02 FILLER PIC X(31) VALUE SPACE. IF1334.2 +017400 02 FILLER PIC X(21) VALUE SPACE. IF1334.2 +017500 02 CCVS-E-2-2. IF1334.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1334.2 +017700 03 FILLER PIC X VALUE SPACE. IF1334.2 +017800 03 ENDER-DESC PIC X(44) VALUE IF1334.2 +017900 "ERRORS ENCOUNTERED". IF1334.2 +018000 01 CCVS-E-3. IF1334.2 +018100 02 FILLER PIC X(22) VALUE IF1334.2 +018200 " FOR OFFICIAL USE ONLY". IF1334.2 +018300 02 FILLER PIC X(12) VALUE SPACE. IF1334.2 +018400 02 FILLER PIC X(58) VALUE IF1334.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1334.2 +018600 02 FILLER PIC X(13) VALUE SPACE. IF1334.2 +018700 02 FILLER PIC X(15) VALUE IF1334.2 +018800 " COPYRIGHT 1985". IF1334.2 +018900 01 CCVS-E-4. IF1334.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1334.2 +019100 02 FILLER PIC X(4) VALUE " OF ". IF1334.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1334.2 +019300 02 FILLER PIC X(40) VALUE IF1334.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1334.2 +019500 01 XXINFO. IF1334.2 +019600 02 FILLER PIC X(19) VALUE IF1334.2 +019700 "*** INFORMATION ***". IF1334.2 +019800 02 INFO-TEXT. IF1334.2 +019900 04 FILLER PIC X(8) VALUE SPACE. IF1334.2 +020000 04 XXCOMPUTED PIC X(20). IF1334.2 +020100 04 FILLER PIC X(5) VALUE SPACE. IF1334.2 +020200 04 XXCORRECT PIC X(20). IF1334.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). IF1334.2 +020400 01 HYPHEN-LINE. IF1334.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. IF1334.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************IF1334.2 +020700- "*****************************************". IF1334.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************IF1334.2 +020900- "******************************". IF1334.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE IF1334.2 +021100 "IF133A". IF1334.2 +021200 PROCEDURE DIVISION. IF1334.2 +021300 CCVS1 SECTION. IF1334.2 +021400 OPEN-FILES. IF1334.2 +021500 OPEN OUTPUT PRINT-FILE. IF1334.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1334.2 +021700 MOVE SPACE TO TEST-RESULTS. IF1334.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1334.2 +021900 GO TO CCVS1-EXIT. IF1334.2 +022000 CLOSE-FILES. IF1334.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1334.2 +022200 TERMINATE-CCVS. IF1334.2 +022300 STOP RUN. IF1334.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1334.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1334.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1334.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1334.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IF1334.2 +022900 PRINT-DETAIL. IF1334.2 +023000 IF REC-CT NOT EQUAL TO ZERO IF1334.2 +023100 MOVE "." TO PARDOT-X IF1334.2 +023200 MOVE REC-CT TO DOTVALUE. IF1334.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1334.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1334.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1334.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1334.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1334.2 +023800 MOVE SPACE TO CORRECT-X. IF1334.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1334.2 +024000 MOVE SPACE TO RE-MARK. IF1334.2 +024100 HEAD-ROUTINE. IF1334.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1334.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1334.2 +024600 COLUMN-NAMES-ROUTINE. IF1334.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +025000 END-ROUTINE. IF1334.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1334.2 +025200 END-RTN-EXIT. IF1334.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +025400 END-ROUTINE-1. IF1334.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1334.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1334.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IF1334.2 +025800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1334.2 +025900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1334.2 +026000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1334.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1334.2 +026200 END-ROUTINE-12. IF1334.2 +026300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1334.2 +026400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1334.2 +026500 MOVE "NO " TO ERROR-TOTAL IF1334.2 +026600 ELSE IF1334.2 +026700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1334.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1334.2 +026900 PERFORM WRITE-LINE. IF1334.2 +027000 END-ROUTINE-13. IF1334.2 +027100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1334.2 +027200 MOVE "NO " TO ERROR-TOTAL ELSE IF1334.2 +027300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1334.2 +027400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1334.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +027600 IF INSPECT-COUNTER EQUAL TO ZERO IF1334.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1334.2 +027800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1334.2 +027900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1334.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +028100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +028200 WRITE-LINE. IF1334.2 +028300 ADD 1 TO RECORD-COUNT. IF1334.2 +028400Y IF RECORD-COUNT GREATER 42 IF1334.2 +028500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1334.2 +028600Y MOVE SPACE TO DUMMY-RECORD IF1334.2 +028700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1334.2 +028800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1334.2 +028900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1334.2 +029000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1334.2 +029100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1334.2 +029200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1334.2 +029600Y MOVE ZERO TO RECORD-COUNT. IF1334.2 +029700 PERFORM WRT-LN. IF1334.2 +029800 WRT-LN. IF1334.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1334.2 +030000 MOVE SPACE TO DUMMY-RECORD. IF1334.2 +030100 BLANK-LINE-PRINT. IF1334.2 +030200 PERFORM WRT-LN. IF1334.2 +030300 FAIL-ROUTINE. IF1334.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE IF1334.2 +030500 GO TO FAIL-ROUTINE-WRITE. IF1334.2 +030600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1334.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1334.2 +030800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1334.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1334.2 +031100 GO TO FAIL-ROUTINE-EX. IF1334.2 +031200 FAIL-ROUTINE-WRITE. IF1334.2 +031300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1334.2 +031400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1334.2 +031500 CORMA-ANSI-REFERENCE. IF1334.2 +031600 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1334.2 +031700 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1334.2 +031800 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1334.2 +031900 ELSE IF1334.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1334.2 +032100 PERFORM WRITE-LINE. IF1334.2 +032200 MOVE SPACES TO COR-ANSI-REFERENCE. IF1334.2 +032300 FAIL-ROUTINE-EX. EXIT. IF1334.2 +032400 BAIL-OUT. IF1334.2 +032500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1334.2 +032600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1334.2 +032700 BAIL-OUT-WRITE. IF1334.2 +032800 MOVE CORRECT-A TO XXCORRECT. IF1334.2 +032900 MOVE COMPUTED-A TO XXCOMPUTED. IF1334.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1334.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1334.2 +033300 BAIL-OUT-EX. EXIT. IF1334.2 +033400 CCVS1-EXIT. IF1334.2 +033500 EXIT. IF1334.2 +033600******************************************************** IF1334.2 +033700* * IF1334.2 +033800* Intrinsic Function Tests IF133A - REM * IF1334.2 +033900* * IF1334.2 +034000******************************************************** IF1334.2 +034100 SECT-IF133A SECTION. IF1334.2 +034200 F-REM-INFO. IF1334.2 +034300 MOVE "See ref. A-66 2.37" TO ANSI-REFERENCE. IF1334.2 +034400 MOVE "REM Function" TO FEATURE. IF1334.2 +034500*****************TEST (a) - SIMPLE TEST***************** IF1334.2 +034600 F-REM-01. IF1334.2 +034700 MOVE ZERO TO WS-NUM. IF1334.2 +034800 F-REM-TEST-01. IF1334.2 +034900 COMPUTE WS-NUM = FUNCTION REM(0, 20). IF1334.2 +035000 IF WS-NUM = 0 THEN IF1334.2 +035100 PERFORM PASS IF1334.2 +035200 ELSE IF1334.2 +035300 MOVE WS-NUM TO COMPUTED-N IF1334.2 +035400 MOVE 0 TO CORRECT-N IF1334.2 +035500 PERFORM FAIL. IF1334.2 +035600 GO TO F-REM-WRITE-01. IF1334.2 +035700 F-REM-DELETE-01. IF1334.2 +035800 PERFORM DE-LETE. IF1334.2 +035900 GO TO F-REM-WRITE-01. IF1334.2 +036000 F-REM-WRITE-01. IF1334.2 +036100 MOVE "F-REM-01" TO PAR-NAME. IF1334.2 +036200 PERFORM PRINT-DETAIL. IF1334.2 +036300*****************TEST (b) - SIMPLE TEST***************** IF1334.2 +036400 F-REM-02. IF1334.2 +036500 EVALUATE FUNCTION REM(10.674, 10.674) IF1334.2 +036600 WHEN -0.000020 THRU 0.000020 IF1334.2 +036700 PERFORM PASS IF1334.2 +036800 WHEN OTHER IF1334.2 +036900 PERFORM FAIL. IF1334.2 +037000 GO TO F-REM-WRITE-02. IF1334.2 +037100 F-REM-DELETE-02. IF1334.2 +037200 PERFORM DE-LETE. IF1334.2 +037300 GO TO F-REM-WRITE-02. IF1334.2 +037400 F-REM-WRITE-02. IF1334.2 +037500 MOVE "F-REM-02" TO PAR-NAME. IF1334.2 +037600 PERFORM PRINT-DETAIL. IF1334.2 +037700*****************TEST (c) - SIMPLE TEST***************** IF1334.2 +037800 F-REM-03. IF1334.2 +037900 IF (FUNCTION REM(2.5, A) >= 2.49995) AND IF1334.2 +038000 (FUNCTION REM(2.5, A) <= 2.50005) IF1334.2 +038100 PERFORM PASS IF1334.2 +038200 ELSE IF1334.2 +038300 PERFORM FAIL. IF1334.2 +038400 GO TO F-REM-WRITE-03. IF1334.2 +038500 F-REM-DELETE-03. IF1334.2 +038600 PERFORM DE-LETE. IF1334.2 +038700 GO TO F-REM-WRITE-03. IF1334.2 +038800 F-REM-WRITE-03. IF1334.2 +038900 MOVE "F-REM-03" TO PAR-NAME. IF1334.2 +039000 PERFORM PRINT-DETAIL. IF1334.2 +039100*****************TEST (d) - SIMPLE TEST***************** IF1334.2 +039200 F-REM-04. IF1334.2 +039300 MOVE ZERO TO WS-NUM. IF1334.2 +039400 F-REM-TEST-04. IF1334.2 +039500 COMPUTE WS-NUM = FUNCTION REM(A, 2). IF1334.2 +039600 IF WS-NUM = 1 THEN IF1334.2 +039700 PERFORM PASS IF1334.2 +039800 ELSE IF1334.2 +039900 MOVE WS-NUM TO COMPUTED-N IF1334.2 +040000 MOVE 1 TO CORRECT-N IF1334.2 +040100 PERFORM FAIL. IF1334.2 +040200 GO TO F-REM-WRITE-04. IF1334.2 +040300 F-REM-DELETE-04. IF1334.2 +040400 PERFORM DE-LETE. IF1334.2 +040500 GO TO F-REM-WRITE-04. IF1334.2 +040600 F-REM-WRITE-04. IF1334.2 +040700 MOVE "F-REM-04" TO PAR-NAME. IF1334.2 +040800 PERFORM PRINT-DETAIL. IF1334.2 +040900*****************TEST (e) - SIMPLE TEST***************** IF1334.2 +041000 F-REM-05. IF1334.2 +041100 MOVE ZERO TO WS-NUM. IF1334.2 +041200 F-REM-TEST-05. IF1334.2 +041300 COMPUTE WS-NUM = FUNCTION REM(B, A). IF1334.2 +041400 IF (WS-NUM >= 2.35995) AND IF1334.2 +041500 (WS-NUM <= 2.36005) IF1334.2 +041600 PERFORM PASS IF1334.2 +041700 ELSE IF1334.2 +041800 MOVE WS-NUM TO COMPUTED-N IF1334.2 +041900 MOVE 2.36 TO CORRECT-N IF1334.2 +042000 PERFORM FAIL. IF1334.2 +042100 GO TO F-REM-WRITE-05. IF1334.2 +042200 F-REM-DELETE-05. IF1334.2 +042300 PERFORM DE-LETE. IF1334.2 +042400 GO TO F-REM-WRITE-05. IF1334.2 +042500 F-REM-WRITE-05. IF1334.2 +042600 MOVE "F-REM-05" TO PAR-NAME. IF1334.2 +042700 PERFORM PRINT-DETAIL. IF1334.2 +042800*****************TEST (f) - SIMPLE TEST***************** IF1334.2 +042900 F-REM-06. IF1334.2 +043000 MOVE ZERO TO WS-NUM. IF1334.2 +043100 F-REM-TEST-06. IF1334.2 +043200 COMPUTE WS-NUM = FUNCTION REM(-11, -5). IF1334.2 +043300 IF WS-NUM = -1 THEN IF1334.2 +043400 PERFORM PASS IF1334.2 +043500 ELSE IF1334.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1334.2 +043700 MOVE -1 TO CORRECT-N IF1334.2 +043800 PERFORM FAIL. IF1334.2 +043900 GO TO F-REM-WRITE-06. IF1334.2 +044000 F-REM-DELETE-06. IF1334.2 +044100 PERFORM DE-LETE. IF1334.2 +044200 GO TO F-REM-WRITE-06. IF1334.2 +044300 F-REM-WRITE-06. IF1334.2 +044400 MOVE "F-REM-06" TO PAR-NAME. IF1334.2 +044500 PERFORM PRINT-DETAIL. IF1334.2 +044600*****************TEST (g) - SIMPLE TEST***************** IF1334.2 +044700 F-REM-07. IF1334.2 +044800 MOVE ZERO TO WS-NUM. IF1334.2 +044900 F-REM-TEST-07. IF1334.2 +045000 COMPUTE WS-NUM = FUNCTION REM(11, -5). IF1334.2 +045100 IF WS-NUM = 1 THEN IF1334.2 +045200 PERFORM PASS IF1334.2 +045300 ELSE IF1334.2 +045400 MOVE WS-NUM TO COMPUTED-N IF1334.2 +045500 MOVE 1 TO CORRECT-N IF1334.2 +045600 PERFORM FAIL. IF1334.2 +045700 GO TO F-REM-WRITE-07. IF1334.2 +045800 F-REM-DELETE-07. IF1334.2 +045900 PERFORM DE-LETE. IF1334.2 +046000 GO TO F-REM-WRITE-07. IF1334.2 +046100 F-REM-WRITE-07. IF1334.2 +046200 MOVE "F-REM-07" TO PAR-NAME. IF1334.2 +046300 PERFORM PRINT-DETAIL. IF1334.2 +046400*****************TEST (h) - SIMPLE TEST***************** IF1334.2 +046500 F-REM-08. IF1334.2 +046600 MOVE ZERO TO WS-NUM. IF1334.2 +046700 F-REM-TEST-08. IF1334.2 +046800 COMPUTE WS-NUM = FUNCTION REM(-11, 5). IF1334.2 +046900 IF WS-NUM = -1 THEN IF1334.2 +047000 PERFORM PASS IF1334.2 +047100 ELSE IF1334.2 +047200 MOVE WS-NUM TO COMPUTED-N IF1334.2 +047300 MOVE -1 TO CORRECT-N IF1334.2 +047400 PERFORM FAIL. IF1334.2 +047500 GO TO F-REM-WRITE-08. IF1334.2 +047600 F-REM-DELETE-08. IF1334.2 +047700 PERFORM DE-LETE. IF1334.2 +047800 GO TO F-REM-WRITE-08. IF1334.2 +047900 F-REM-WRITE-08. IF1334.2 +048000 MOVE "F-REM-08" TO PAR-NAME. IF1334.2 +048100 PERFORM PRINT-DETAIL. IF1334.2 +048200*****************TEST (a) - COMPLEX TEST**************** IF1334.2 +048300 F-REM-09. IF1334.2 +048400 MOVE ZERO TO WS-NUM. IF1334.2 +048500 MOVE 0.889982 TO MIN-RANGE. IF1334.2 +048600 MOVE 0.890018 TO MAX-RANGE. IF1334.2 +048700 F-REM-TEST-09. IF1334.2 +048800 COMPUTE WS-NUM = FUNCTION REM(0.89, B + 1). IF1334.2 +048900 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +049000 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +049100 PERFORM PASS IF1334.2 +049200 ELSE IF1334.2 +049300 MOVE WS-NUM TO COMPUTED-N IF1334.2 +049400 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +049500 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +049600 PERFORM FAIL. IF1334.2 +049700 GO TO F-REM-WRITE-09. IF1334.2 +049800 F-REM-DELETE-09. IF1334.2 +049900 PERFORM DE-LETE. IF1334.2 +050000 GO TO F-REM-WRITE-09. IF1334.2 +050100 F-REM-WRITE-09. IF1334.2 +050200 MOVE "F-REM-09" TO PAR-NAME. IF1334.2 +050300 PERFORM PRINT-DETAIL. IF1334.2 +050400*****************TEST (b) - COMPLEX TEST**************** IF1334.2 +050500 F-REM-10. IF1334.2 +050600 MOVE ZERO TO WS-NUM. IF1334.2 +050700 MOVE 0.159997 TO MIN-RANGE. IF1334.2 +050800 MOVE 0.160003 TO MAX-RANGE. IF1334.2 +050900 F-REM-TEST-10. IF1334.2 +051000 COMPUTE WS-NUM = FUNCTION REM(B, C + 2.2). IF1334.2 +051100 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +051200 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +051300 PERFORM PASS IF1334.2 +051400 ELSE IF1334.2 +051500 MOVE WS-NUM TO COMPUTED-N IF1334.2 +051600 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +051700 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +051800 PERFORM FAIL. IF1334.2 +051900 GO TO F-REM-WRITE-10. IF1334.2 +052000 F-REM-DELETE-10. IF1334.2 +052100 PERFORM DE-LETE. IF1334.2 +052200 GO TO F-REM-WRITE-10. IF1334.2 +052300 F-REM-WRITE-10. IF1334.2 +052400 MOVE "F-REM-10" TO PAR-NAME. IF1334.2 +052500 PERFORM PRINT-DETAIL. IF1334.2 +052600*****************TEST (c) - COMPLEX TEST**************** IF1334.2 +052700 F-REM-11. IF1334.2 +052800 MOVE ZERO TO WS-NUM. IF1334.2 +052900 MOVE -0.000020 TO MIN-RANGE. IF1334.2 +053000 MOVE 0.000020 TO MAX-RANGE. IF1334.2 +053100 F-REM-TEST-11. IF1334.2 +053200 COMPUTE WS-NUM = FUNCTION REM(3 / 2, .75). IF1334.2 +053300 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +053400 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +053500 PERFORM PASS IF1334.2 +053600 ELSE IF1334.2 +053700 MOVE WS-NUM TO COMPUTED-N IF1334.2 +053800 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +053900 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +054000 PERFORM FAIL. IF1334.2 +054100 GO TO F-REM-WRITE-11. IF1334.2 +054200 F-REM-DELETE-11. IF1334.2 +054300 PERFORM DE-LETE. IF1334.2 +054400 GO TO F-REM-WRITE-11. IF1334.2 +054500 F-REM-WRITE-11. IF1334.2 +054600 MOVE "F-REM-11" TO PAR-NAME. IF1334.2 +054700 PERFORM PRINT-DETAIL. IF1334.2 +054800*****************TEST (d) - COMPLEX TEST**************** IF1334.2 +054900 F-REM-12. IF1334.2 +055000 MOVE ZERO TO WS-NUM. IF1334.2 +055100 MOVE 6.63987 TO MIN-RANGE. IF1334.2 +055200 MOVE 6.64013 TO MAX-RANGE. IF1334.2 +055300 F-REM-TEST-12. IF1334.2 +055400 COMPUTE WS-NUM = FUNCTION REM(8 + 6, B). IF1334.2 +055500 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +055600 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +055700 PERFORM PASS IF1334.2 +055800 ELSE IF1334.2 +055900 MOVE WS-NUM TO COMPUTED-N IF1334.2 +056000 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +056100 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +056200 PERFORM FAIL. IF1334.2 +056300 GO TO F-REM-WRITE-12. IF1334.2 +056400 F-REM-DELETE-12. IF1334.2 +056500 PERFORM DE-LETE. IF1334.2 +056600 GO TO F-REM-WRITE-12. IF1334.2 +056700 F-REM-WRITE-12. IF1334.2 +056800 MOVE "F-REM-12" TO PAR-NAME. IF1334.2 +056900 PERFORM PRINT-DETAIL. IF1334.2 +057000*****************TEST (e) - COMPLEX TEST**************** IF1334.2 +057100 F-REM-13. IF1334.2 +057200 MOVE ZERO TO WS-NUM. IF1334.2 +057300 MOVE -1.00002 TO MIN-RANGE. IF1334.2 +057400 MOVE -0.999980 TO MAX-RANGE. IF1334.2 +057500 F-REM-TEST-13. IF1334.2 +057600 COMPUTE WS-NUM = FUNCTION REM(C + 1, 2). IF1334.2 +057700 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +057800 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +057900 PERFORM PASS IF1334.2 +058000 ELSE IF1334.2 +058100 MOVE WS-NUM TO COMPUTED-N IF1334.2 +058200 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +058300 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +058400 PERFORM FAIL. IF1334.2 +058500 GO TO F-REM-WRITE-13. IF1334.2 +058600 F-REM-DELETE-13. IF1334.2 +058700 PERFORM DE-LETE. IF1334.2 +058800 GO TO F-REM-WRITE-13. IF1334.2 +058900 F-REM-WRITE-13. IF1334.2 +059000 MOVE "F-REM-13" TO PAR-NAME. IF1334.2 +059100 PERFORM PRINT-DETAIL. IF1334.2 +059200*****************TEST (f) - COMPLEX TEST**************** IF1334.2 +059300 F-REM-14. IF1334.2 +059400 MOVE ZERO TO WS-NUM. IF1334.2 +059500 MOVE 1.99996 TO MIN-RANGE. IF1334.2 +059600 MOVE 2.00004 TO MAX-RANGE. IF1334.2 +059700 F-REM-TEST-14. IF1334.2 +059800 COMPUTE WS-NUM = FUNCTION REM( IF1334.2 +059900 FUNCTION REM(D, A), A). IF1334.2 +060000 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +060100 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +060200 PERFORM PASS IF1334.2 +060300 ELSE IF1334.2 +060400 MOVE WS-NUM TO COMPUTED-N IF1334.2 +060500 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +060600 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +060700 PERFORM FAIL. IF1334.2 +060800 GO TO F-REM-WRITE-14. IF1334.2 +060900 F-REM-DELETE-14. IF1334.2 +061000 PERFORM DE-LETE. IF1334.2 +061100 GO TO F-REM-WRITE-14. IF1334.2 +061200 F-REM-WRITE-14. IF1334.2 +061300 MOVE "F-REM-14" TO PAR-NAME. IF1334.2 +061400 PERFORM PRINT-DETAIL. IF1334.2 +061500*****************TEST (g) - COMPLEX TEST**************** IF1334.2 +061600 F-REM-15. IF1334.2 +061700 MOVE ZERO TO WS-NUM. IF1334.2 +061800 MOVE -0.000020 TO MIN-RANGE. IF1334.2 +061900 MOVE 0.000020 TO MAX-RANGE. IF1334.2 +062000 F-REM-TEST-15. IF1334.2 +062100 COMPUTE WS-NUM = FUNCTION REM(C, IF1334.2 +062200 FUNCTION REM(C, D)). IF1334.2 +062300 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +062400 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +062500 PERFORM PASS IF1334.2 +062600 ELSE IF1334.2 +062700 MOVE WS-NUM TO COMPUTED-N IF1334.2 +062800 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +062900 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +063000 PERFORM FAIL. IF1334.2 +063100 GO TO F-REM-WRITE-15. IF1334.2 +063200 F-REM-DELETE-15. IF1334.2 +063300 PERFORM DE-LETE. IF1334.2 +063400 GO TO F-REM-WRITE-15. IF1334.2 +063500 F-REM-WRITE-15. IF1334.2 +063600 MOVE "F-REM-15" TO PAR-NAME. IF1334.2 +063700 PERFORM PRINT-DETAIL. IF1334.2 +063800*****************TEST (h) - COMPLEX TEST**************** IF1334.2 +063900 F-REM-16. IF1334.2 +064000 MOVE ZERO TO WS-NUM. IF1334.2 +064100 MOVE 0.999980 TO MIN-RANGE. IF1334.2 +064200 MOVE 1.00002 TO MAX-RANGE. IF1334.2 +064300 F-REM-TEST-16. IF1334.2 +064400 COMPUTE WS-NUM = FUNCTION REM( FUNCTION REM(9, 5), IF1334.2 +064500 FUNCTION REM(D, 4)). IF1334.2 +064600 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +064700 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +064800 PERFORM PASS IF1334.2 +064900 ELSE IF1334.2 +065000 MOVE WS-NUM TO COMPUTED-N IF1334.2 +065100 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +065200 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +065300 PERFORM FAIL. IF1334.2 +065400 GO TO F-REM-WRITE-16. IF1334.2 +065500 F-REM-DELETE-16. IF1334.2 +065600 PERFORM DE-LETE. IF1334.2 +065700 GO TO F-REM-WRITE-16. IF1334.2 +065800 F-REM-WRITE-16. IF1334.2 +065900 MOVE "F-REM-16" TO PAR-NAME. IF1334.2 +066000 PERFORM PRINT-DETAIL. IF1334.2 +066100*****************SPECIAL PERFORM TEST********************** IF1334.2 +066200 F-REM-17. IF1334.2 +066300 PERFORM F-REM-TEST-17 IF1334.2 +066400 UNTIL FUNCTION REM(5, ARG2) >= 2. IF1334.2 +066500 PERFORM PASS. IF1334.2 +066600 GO TO F-REM-WRITE-17. IF1334.2 +066700 F-REM-TEST-17. IF1334.2 +066800 COMPUTE ARG2 = ARG2 + 1. IF1334.2 +066900 F-REM-DELETE-17. IF1334.2 +067000 PERFORM DE-LETE. IF1334.2 +067100 GO TO F-REM-WRITE-17. IF1334.2 +067200 F-REM-WRITE-17. IF1334.2 +067300 MOVE "F-REM-17" TO PAR-NAME. IF1334.2 +067400 PERFORM PRINT-DETAIL. IF1334.2 +067500********************END OF TESTS*************** IF1334.2 +067600 CCVS-EXIT SECTION. IF1334.2 +067700 CCVS-999999. IF1334.2 +067800 GO TO CLOSE-FILES. IF1334.2 +*END-OF,IF133A +*HEADER,COBOL,IF134A +000100 IDENTIFICATION DIVISION. IF1344.2 +000200 PROGRAM-ID. IF1344.2 +000300 IF134A. IF1344.2 +000400 IF1344.2 +000500*********************************************************** IF1344.2 +000600* * IF1344.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1344.2 +000800* It contains tests for the Intrinsic Function REVERSE. * IF1344.2 +000900* * IF1344.2 +001000*********************************************************** IF1344.2 +001100 ENVIRONMENT DIVISION. IF1344.2 +001200 CONFIGURATION SECTION. IF1344.2 +001300 SOURCE-COMPUTER. IF1344.2 +001400 XXXXX082. IF1344.2 +001500 OBJECT-COMPUTER. IF1344.2 +001600 XXXXX083. IF1344.2 +001700 INPUT-OUTPUT SECTION. IF1344.2 +001800 FILE-CONTROL. IF1344.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1344.2 +002000 XXXXX055. IF1344.2 +002100 DATA DIVISION. IF1344.2 +002200 FILE SECTION. IF1344.2 +002300 FD PRINT-FILE. IF1344.2 +002400 01 PRINT-REC PICTURE X(120). IF1344.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1344.2 +002600 WORKING-STORAGE SECTION. IF1344.2 +002700*********************************************************** IF1344.2 +002800* Variables specific to the Intrinsic Function Test IF134A* IF1344.2 +002900*********************************************************** IF1344.2 +003000 01 A PIC A(10) VALUE "tumble". IF1344.2 +003100 01 B PIC A(10) VALUE "WEED". IF1344.2 +003200 01 C PIC X(10) VALUE "Was". IF1344.2 +003300 01 D PIC X(10) VALUE "4". IF1344.2 +003400 01 E PIC X(10) VALUE "And4". IF1344.2 +003500 01 TEMP1 PIC X(7) VALUE "giZZard". IF1344.2 +003600 01 TEMP PIC S9(10). IF1344.2 +003700 01 WS-ANUM PIC X(10). IF1344.2 +003800* IF1344.2 +003900********************************************************** IF1344.2 +004000* IF1344.2 +004100 01 TEST-RESULTS. IF1344.2 +004200 02 FILLER PIC X VALUE SPACE. IF1344.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1344.2 +004400 02 FILLER PIC X VALUE SPACE. IF1344.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1344.2 +004600 02 FILLER PIC X VALUE SPACE. IF1344.2 +004700 02 PAR-NAME. IF1344.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1344.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1344.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1344.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1344.2 +005200 02 RE-MARK PIC X(61). IF1344.2 +005300 01 TEST-COMPUTED. IF1344.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1344.2 +005500 02 FILLER PIC X(17) VALUE IF1344.2 +005600 " COMPUTED=". IF1344.2 +005700 02 COMPUTED-X. IF1344.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1344.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1344.2 +006000 PIC -9(9).9(9). IF1344.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1344.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1344.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1344.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1344.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1344.2 +006600 04 FILLER PIC X. IF1344.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1344.2 +006800 01 TEST-CORRECT. IF1344.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1344.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1344.2 +007100 02 CORRECT-X. IF1344.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1344.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1344.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1344.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1344.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1344.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1344.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1344.2 +007900 04 FILLER PIC X. IF1344.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1344.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1344.2 +008200 01 CCVS-C-1. IF1344.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1344.2 +008400- "SS PARAGRAPH-NAME IF1344.2 +008500- " REMARKS". IF1344.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1344.2 +008700 01 CCVS-C-2. IF1344.2 +008800 02 FILLER PIC X VALUE SPACE. IF1344.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1344.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1344.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1344.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1344.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1344.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1344.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1344.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1344.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1344.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1344.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1344.2 +010400 01 CCVS-H-1. IF1344.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1344.2 +010600 02 FILLER PIC X(42) VALUE IF1344.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1344.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1344.2 +010900 01 CCVS-H-2A. IF1344.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1344.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1344.2 +011200 02 FILLER PIC XXXX VALUE IF1344.2 +011300 "4.2 ". IF1344.2 +011400 02 FILLER PIC X(28) VALUE IF1344.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1344.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1344.2 +011700 IF1344.2 +011800 01 CCVS-H-2B. IF1344.2 +011900 02 FILLER PIC X(15) VALUE IF1344.2 +012000 "TEST RESULT OF ". IF1344.2 +012100 02 TEST-ID PIC X(9). IF1344.2 +012200 02 FILLER PIC X(4) VALUE IF1344.2 +012300 " IN ". IF1344.2 +012400 02 FILLER PIC X(12) VALUE IF1344.2 +012500 " HIGH ". IF1344.2 +012600 02 FILLER PIC X(22) VALUE IF1344.2 +012700 " LEVEL VALIDATION FOR ". IF1344.2 +012800 02 FILLER PIC X(58) VALUE IF1344.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1344.2 +013000 01 CCVS-H-3. IF1344.2 +013100 02 FILLER PIC X(34) VALUE IF1344.2 +013200 " FOR OFFICIAL USE ONLY ". IF1344.2 +013300 02 FILLER PIC X(58) VALUE IF1344.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1344.2 +013500 02 FILLER PIC X(28) VALUE IF1344.2 +013600 " COPYRIGHT 1985 ". IF1344.2 +013700 01 CCVS-E-1. IF1344.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1344.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1344.2 +014000 02 ID-AGAIN PIC X(9). IF1344.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1344.2 +014200 01 CCVS-E-2. IF1344.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1344.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1344.2 +014500 02 CCVS-E-2-2. IF1344.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1344.2 +014700 03 FILLER PIC X VALUE SPACE. IF1344.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1344.2 +014900 "ERRORS ENCOUNTERED". IF1344.2 +015000 01 CCVS-E-3. IF1344.2 +015100 02 FILLER PIC X(22) VALUE IF1344.2 +015200 " FOR OFFICIAL USE ONLY". IF1344.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1344.2 +015400 02 FILLER PIC X(58) VALUE IF1344.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1344.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1344.2 +015700 02 FILLER PIC X(15) VALUE IF1344.2 +015800 " COPYRIGHT 1985". IF1344.2 +015900 01 CCVS-E-4. IF1344.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1344.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1344.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1344.2 +016300 02 FILLER PIC X(40) VALUE IF1344.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1344.2 +016500 01 XXINFO. IF1344.2 +016600 02 FILLER PIC X(19) VALUE IF1344.2 +016700 "*** INFORMATION ***". IF1344.2 +016800 02 INFO-TEXT. IF1344.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1344.2 +017000 04 XXCOMPUTED PIC X(20). IF1344.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1344.2 +017200 04 XXCORRECT PIC X(20). IF1344.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1344.2 +017400 01 HYPHEN-LINE. IF1344.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1344.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1344.2 +017700- "*****************************************". IF1344.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1344.2 +017900- "******************************". IF1344.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1344.2 +018100 "IF134A". IF1344.2 +018200 PROCEDURE DIVISION. IF1344.2 +018300 CCVS1 SECTION. IF1344.2 +018400 OPEN-FILES. IF1344.2 +018500 OPEN OUTPUT PRINT-FILE. IF1344.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1344.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1344.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1344.2 +018900 GO TO CCVS1-EXIT. IF1344.2 +019000 CLOSE-FILES. IF1344.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1344.2 +019200 TERMINATE-CCVS. IF1344.2 +019300 STOP RUN. IF1344.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1344.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1344.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1344.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1344.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1344.2 +019900 PRINT-DETAIL. IF1344.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1344.2 +020100 MOVE "." TO PARDOT-X IF1344.2 +020200 MOVE REC-CT TO DOTVALUE. IF1344.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1344.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1344.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1344.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1344.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1344.2 +020800 MOVE SPACE TO CORRECT-X. IF1344.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1344.2 +021000 MOVE SPACE TO RE-MARK. IF1344.2 +021100 HEAD-ROUTINE. IF1344.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1344.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1344.2 +021600 COLUMN-NAMES-ROUTINE. IF1344.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +022000 END-ROUTINE. IF1344.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1344.2 +022200 END-RTN-EXIT. IF1344.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +022400 END-ROUTINE-1. IF1344.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1344.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1344.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1344.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1344.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1344.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1344.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1344.2 +023200 END-ROUTINE-12. IF1344.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1344.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1344.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1344.2 +023600 ELSE IF1344.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1344.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1344.2 +023900 PERFORM WRITE-LINE. IF1344.2 +024000 END-ROUTINE-13. IF1344.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1344.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1344.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1344.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1344.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1344.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1344.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1344.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1344.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +025200 WRITE-LINE. IF1344.2 +025300 ADD 1 TO RECORD-COUNT. IF1344.2 +025400Y IF RECORD-COUNT GREATER 42 IF1344.2 +025500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1344.2 +025600Y MOVE SPACE TO DUMMY-RECORD IF1344.2 +025700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1344.2 +025800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1344.2 +025900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1344.2 +026000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1344.2 +026100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1344.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1344.2 +026600Y MOVE ZERO TO RECORD-COUNT. IF1344.2 +026700 PERFORM WRT-LN. IF1344.2 +026800 WRT-LN. IF1344.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1344.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1344.2 +027100 BLANK-LINE-PRINT. IF1344.2 +027200 PERFORM WRT-LN. IF1344.2 +027300 FAIL-ROUTINE. IF1344.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1344.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1344.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1344.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1344.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1344.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1344.2 +028100 GO TO FAIL-ROUTINE-EX. IF1344.2 +028200 FAIL-ROUTINE-WRITE. IF1344.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1344.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1344.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1344.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1344.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1344.2 +028800 BAIL-OUT. IF1344.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1344.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1344.2 +029100 BAIL-OUT-WRITE. IF1344.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1344.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1344.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1344.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1344.2 +029700 BAIL-OUT-EX. EXIT. IF1344.2 +029800 CCVS1-EXIT. IF1344.2 +029900 EXIT. IF1344.2 +030000******************************************************** IF1344.2 +030100* * IF1344.2 +030200* Intrinsic Function Tests IF134A - REVERSE * IF1344.2 +030300* * IF1344.2 +030400******************************************************** IF1344.2 +030500 SECT-IF134A SECTION. IF1344.2 +030600 F-REVERSE-INFO. IF1344.2 +030700 MOVE "See ref. A-67 2.38" TO ANSI-REFERENCE. IF1344.2 +030800 MOVE "REVERSE Function" TO FEATURE. IF1344.2 +030900*****************TEST (a) ****************************** IF1344.2 +031000 F-REVERSE-01. IF1344.2 +031100 MOVE SPACES TO WS-ANUM. IF1344.2 +031200 F-REVERSE-TEST-01. IF1344.2 +031300 MOVE FUNCTION REVERSE("figure") TO WS-ANUM. IF1344.2 +031400 IF WS-ANUM = "erugif" THEN IF1344.2 +031500 PERFORM PASS IF1344.2 +031600 ELSE IF1344.2 +031700 MOVE "erugif" TO CORRECT-A IF1344.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +031900 PERFORM FAIL. IF1344.2 +032000 GO TO F-REVERSE-WRITE-01. IF1344.2 +032100 F-REVERSE-DELETE-01. IF1344.2 +032200 PERFORM DE-LETE. IF1344.2 +032300 GO TO F-REVERSE-WRITE-01. IF1344.2 +032400 F-REVERSE-WRITE-01. IF1344.2 +032500 MOVE "F-REVERSE-01" TO PAR-NAME. IF1344.2 +032600 PERFORM PRINT-DETAIL. IF1344.2 +032700*****************TEST (b) ****************************** IF1344.2 +032800 F-REVERSE-02. IF1344.2 +032900 MOVE SPACES TO WS-ANUM. IF1344.2 +033000 F-REVERSE-TEST-02. IF1344.2 +033100 IF FUNCTION REVERSE("CAPS") = "SPAC" THEN IF1344.2 +033200 PERFORM PASS IF1344.2 +033300 ELSE IF1344.2 +033400 MOVE "SPAC" TO CORRECT-A IF1344.2 +033500 PERFORM FAIL. IF1344.2 +033600 GO TO F-REVERSE-WRITE-02. IF1344.2 +033700 F-REVERSE-DELETE-02. IF1344.2 +033800 PERFORM DE-LETE. IF1344.2 +033900 GO TO F-REVERSE-WRITE-02. IF1344.2 +034000 F-REVERSE-WRITE-02. IF1344.2 +034100 MOVE "F-REVERSE-02" TO PAR-NAME. IF1344.2 +034200 PERFORM PRINT-DETAIL. IF1344.2 +034300*****************TEST (c) ****************************** IF1344.2 +034400 F-REVERSE-03. IF1344.2 +034500 MOVE SPACES TO WS-ANUM. IF1344.2 +034600 F-REVERSE-TEST-03. IF1344.2 +034700 MOVE FUNCTION REVERSE("highnLOW") TO WS-ANUM. IF1344.2 +034800 IF WS-ANUM = "WOLnhgih" THEN IF1344.2 +034900 PERFORM PASS IF1344.2 +035000 ELSE IF1344.2 +035100 MOVE "WOLnhgih" TO CORRECT-A IF1344.2 +035200 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +035300 PERFORM FAIL. IF1344.2 +035400 GO TO F-REVERSE-WRITE-03. IF1344.2 +035500 F-REVERSE-DELETE-03. IF1344.2 +035600 PERFORM DE-LETE. IF1344.2 +035700 GO TO F-REVERSE-WRITE-03. IF1344.2 +035800 F-REVERSE-WRITE-03. IF1344.2 +035900 MOVE "F-REVERSE-03" TO PAR-NAME. IF1344.2 +036000 PERFORM PRINT-DETAIL. IF1344.2 +036100*****************TEST (d) ****************************** IF1344.2 +036200 F-REVERSE-04. IF1344.2 +036300 MOVE SPACES TO WS-ANUM. IF1344.2 +036400 F-REVERSE-TEST-04. IF1344.2 +036500 MOVE FUNCTION REVERSE("95") TO WS-ANUM. IF1344.2 +036600 IF WS-ANUM = "59" THEN IF1344.2 +036700 PERFORM PASS IF1344.2 +036800 ELSE IF1344.2 +036900 MOVE "59" TO CORRECT-A IF1344.2 +037000 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +037100 PERFORM FAIL. IF1344.2 +037200 GO TO F-REVERSE-WRITE-04. IF1344.2 +037300 F-REVERSE-DELETE-04. IF1344.2 +037400 PERFORM DE-LETE. IF1344.2 +037500 GO TO F-REVERSE-WRITE-04. IF1344.2 +037600 F-REVERSE-WRITE-04. IF1344.2 +037700 MOVE "F-REVERSE-04" TO PAR-NAME. IF1344.2 +037800 PERFORM PRINT-DETAIL. IF1344.2 +037900*****************TEST (e) ****************************** IF1344.2 +038000 F-REVERSE-05. IF1344.2 +038100 MOVE SPACES TO WS-ANUM. IF1344.2 +038200 F-REVERSE-TEST-05. IF1344.2 +038300 MOVE FUNCTION REVERSE("8isaNUMBER") TO WS-ANUM. IF1344.2 +038400 IF WS-ANUM = "REBMUNasi8" THEN IF1344.2 +038500 PERFORM PASS IF1344.2 +038600 ELSE IF1344.2 +038700 MOVE "REBMUNasi8" TO CORRECT-A IF1344.2 +038800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +038900 PERFORM FAIL. IF1344.2 +039000 GO TO F-REVERSE-WRITE-05. IF1344.2 +039100 F-REVERSE-DELETE-05. IF1344.2 +039200 PERFORM DE-LETE. IF1344.2 +039300 GO TO F-REVERSE-WRITE-05. IF1344.2 +039400 F-REVERSE-WRITE-05. IF1344.2 +039500 MOVE "F-REVERSE-05" TO PAR-NAME. IF1344.2 +039600 PERFORM PRINT-DETAIL. IF1344.2 +039700*****************TEST (f) ****************************** IF1344.2 +039800 F-REVERSE-06. IF1344.2 +039900 MOVE SPACES TO WS-ANUM. IF1344.2 +040000 F-REVERSE-TEST-06. IF1344.2 +040100 MOVE FUNCTION REVERSE(A) TO WS-ANUM. IF1344.2 +040200 IF WS-ANUM = " elbmut" THEN IF1344.2 +040300 PERFORM PASS IF1344.2 +040400 ELSE IF1344.2 +040500 MOVE " elbmut" TO CORRECT-A IF1344.2 +040600 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +040700 PERFORM FAIL. IF1344.2 +040800 GO TO F-REVERSE-WRITE-06. IF1344.2 +040900 F-REVERSE-DELETE-06. IF1344.2 +041000 PERFORM DE-LETE. IF1344.2 +041100 GO TO F-REVERSE-WRITE-06. IF1344.2 +041200 F-REVERSE-WRITE-06. IF1344.2 +041300 MOVE "F-REVERSE-06" TO PAR-NAME. IF1344.2 +041400 PERFORM PRINT-DETAIL. IF1344.2 +041500*****************TEST (g) ****************************** IF1344.2 +041600 F-REVERSE-07. IF1344.2 +041700 MOVE SPACES TO WS-ANUM. IF1344.2 +041800 F-REVERSE-TEST-07. IF1344.2 +041900 MOVE FUNCTION REVERSE(B) TO WS-ANUM. IF1344.2 +042000 IF WS-ANUM = " DEEW" THEN IF1344.2 +042100 PERFORM PASS IF1344.2 +042200 ELSE IF1344.2 +042300 MOVE " DEEW" TO CORRECT-A IF1344.2 +042400 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +042500 PERFORM FAIL. IF1344.2 +042600 GO TO F-REVERSE-WRITE-07. IF1344.2 +042700 F-REVERSE-DELETE-07. IF1344.2 +042800 PERFORM DE-LETE. IF1344.2 +042900 GO TO F-REVERSE-WRITE-07. IF1344.2 +043000 F-REVERSE-WRITE-07. IF1344.2 +043100 MOVE "F-REVERSE-07" TO PAR-NAME. IF1344.2 +043200 PERFORM PRINT-DETAIL. IF1344.2 +043300*****************TEST (h) ****************************** IF1344.2 +043400 F-REVERSE-08. IF1344.2 +043500 MOVE SPACES TO WS-ANUM. IF1344.2 +043600 F-REVERSE-TEST-08. IF1344.2 +043700 MOVE FUNCTION REVERSE(C) TO WS-ANUM. IF1344.2 +043800 IF WS-ANUM = " saW" THEN IF1344.2 +043900 PERFORM PASS IF1344.2 +044000 ELSE IF1344.2 +044100 MOVE " saW" TO CORRECT-A IF1344.2 +044200 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +044300 PERFORM FAIL. IF1344.2 +044400 GO TO F-REVERSE-WRITE-08. IF1344.2 +044500 F-REVERSE-DELETE-08. IF1344.2 +044600 PERFORM DE-LETE. IF1344.2 +044700 GO TO F-REVERSE-WRITE-08. IF1344.2 +044800 F-REVERSE-WRITE-08. IF1344.2 +044900 MOVE "F-REVERSE-08" TO PAR-NAME. IF1344.2 +045000 PERFORM PRINT-DETAIL. IF1344.2 +045100*****************TEST (i) ****************************** IF1344.2 +045200 F-REVERSE-09. IF1344.2 +045300 MOVE SPACES TO WS-ANUM. IF1344.2 +045400 F-REVERSE-TEST-09. IF1344.2 +045500 MOVE FUNCTION REVERSE(D) TO WS-ANUM. IF1344.2 +045600 IF WS-ANUM = " 4" THEN IF1344.2 +045700 PERFORM PASS IF1344.2 +045800 ELSE IF1344.2 +045900 MOVE " 4" TO CORRECT-A IF1344.2 +046000 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +046100 PERFORM FAIL. IF1344.2 +046200 GO TO F-REVERSE-WRITE-09. IF1344.2 +046300 F-REVERSE-DELETE-09. IF1344.2 +046400 PERFORM DE-LETE. IF1344.2 +046500 GO TO F-REVERSE-WRITE-09. IF1344.2 +046600 F-REVERSE-WRITE-09. IF1344.2 +046700 MOVE "F-REVERSE-09" TO PAR-NAME. IF1344.2 +046800 PERFORM PRINT-DETAIL. IF1344.2 +046900*****************TEST (j) ****************************** IF1344.2 +047000 F-REVERSE-10. IF1344.2 +047100 MOVE SPACES TO WS-ANUM. IF1344.2 +047200 F-REVERSE-TEST-10. IF1344.2 +047300 MOVE FUNCTION REVERSE(E) TO WS-ANUM. IF1344.2 +047400 IF WS-ANUM = " 4dnA" THEN IF1344.2 +047500 PERFORM PASS IF1344.2 +047600 ELSE IF1344.2 +047700 MOVE " 4dnA" TO CORRECT-A IF1344.2 +047800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +047900 PERFORM FAIL. IF1344.2 +048000 GO TO F-REVERSE-WRITE-10. IF1344.2 +048100 F-REVERSE-DELETE-10. IF1344.2 +048200 PERFORM DE-LETE. IF1344.2 +048300 GO TO F-REVERSE-WRITE-10. IF1344.2 +048400 F-REVERSE-WRITE-10. IF1344.2 +048500 MOVE "F-REVERSE-10" TO PAR-NAME. IF1344.2 +048600 PERFORM PRINT-DETAIL. IF1344.2 +048700*****************TEST (k) ****************************** IF1344.2 +048800 F-REVERSE-11. IF1344.2 +048900 MOVE ZERO TO TEMP. IF1344.2 +049000 F-REVERSE-TEST-11. IF1344.2 +049100 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION REVERSE("Homer")). IF1344.2 +049200 IF TEMP = 5 THEN IF1344.2 +049300 PERFORM PASS IF1344.2 +049400 ELSE IF1344.2 +049500 MOVE 5 TO CORRECT-N IF1344.2 +049600 MOVE TEMP TO COMPUTED-N IF1344.2 +049700 PERFORM FAIL. IF1344.2 +049800 GO TO F-REVERSE-WRITE-11. IF1344.2 +049900 F-REVERSE-DELETE-11. IF1344.2 +050000 PERFORM DE-LETE. IF1344.2 +050100 GO TO F-REVERSE-WRITE-11. IF1344.2 +050200 F-REVERSE-WRITE-11. IF1344.2 +050300 MOVE "F-REVERSE-11" TO PAR-NAME. IF1344.2 +050400 PERFORM PRINT-DETAIL. IF1344.2 +050500*****************TEST (l) ****************************** IF1344.2 +050600 F-REVERSE-12. IF1344.2 +050700 MOVE SPACES TO WS-ANUM. IF1344.2 +050800 F-REVERSE-TEST-12. IF1344.2 +050900 MOVE FUNCTION REVERSE(FUNCTION REVERSE("giZZard")) IF1344.2 +051000 TO WS-ANUM. IF1344.2 +051100 IF WS-ANUM = "giZZard" THEN IF1344.2 +051200 PERFORM PASS IF1344.2 +051300 ELSE IF1344.2 +051400 MOVE "giZZard" TO CORRECT-A IF1344.2 +051500 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +051600 PERFORM FAIL. IF1344.2 +051700 GO TO F-REVERSE-WRITE-12. IF1344.2 +051800 F-REVERSE-DELETE-12. IF1344.2 +051900 PERFORM DE-LETE. IF1344.2 +052000 GO TO F-REVERSE-WRITE-12. IF1344.2 +052100 F-REVERSE-WRITE-12. IF1344.2 +052200 MOVE "F-REVERSE-12" TO PAR-NAME. IF1344.2 +052300 PERFORM PRINT-DETAIL. IF1344.2 +052400*****************TEST (m) ****************************** IF1344.2 +052500 F-REVERSE-13. IF1344.2 +052600 MOVE ZERO TO TEMP. IF1344.2 +052700 F-REVERSE-TEST-13. IF1344.2 +052800 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION REVERSE("HOMER")) + IF1344.2 +052900 FUNCTION LENGTH(FUNCTION REVERSE("Gizzard")). IF1344.2 +053000 IF TEMP = 12 THEN IF1344.2 +053100 PERFORM PASS IF1344.2 +053200 ELSE IF1344.2 +053300 MOVE 12 TO CORRECT-N IF1344.2 +053400 MOVE TEMP TO COMPUTED-N IF1344.2 +053500 PERFORM FAIL. IF1344.2 +053600 GO TO F-REVERSE-WRITE-13. IF1344.2 +053700 F-REVERSE-DELETE-13. IF1344.2 +053800 PERFORM DE-LETE. IF1344.2 +053900 GO TO F-REVERSE-WRITE-13. IF1344.2 +054000 F-REVERSE-WRITE-13. IF1344.2 +054100 MOVE "F-REVERSE-13" TO PAR-NAME. IF1344.2 +054200 PERFORM PRINT-DETAIL. IF1344.2 +054300*******************END OF TESTS************************** IF1344.2 +054400 CCVS-EXIT SECTION. IF1344.2 +054500 CCVS-999999. IF1344.2 +054600 GO TO CLOSE-FILES. IF1344.2 +*END-OF,IF134A +*HEADER,COBOL,IF135A +000100 IDENTIFICATION DIVISION. IF1354.2 +000200 PROGRAM-ID. IF1354.2 +000300 IF135A. IF1354.2 +000400 IF1354.2 +000500*********************************************************** IF1354.2 +000600* * IF1354.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1354.2 +000800* It contains tests for the Intrinsic Function SIN. * IF1354.2 +000900* * IF1354.2 +001000*********************************************************** IF1354.2 +001100 ENVIRONMENT DIVISION. IF1354.2 +001200 CONFIGURATION SECTION. IF1354.2 +001300 SOURCE-COMPUTER. IF1354.2 +001400 XXXXX082. IF1354.2 +001500 OBJECT-COMPUTER. IF1354.2 +001600 XXXXX083. IF1354.2 +001700 INPUT-OUTPUT SECTION. IF1354.2 +001800 FILE-CONTROL. IF1354.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1354.2 +002000 XXXXX055. IF1354.2 +002100 DATA DIVISION. IF1354.2 +002200 FILE SECTION. IF1354.2 +002300 FD PRINT-FILE. IF1354.2 +002400 01 PRINT-REC PICTURE X(120). IF1354.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1354.2 +002600 WORKING-STORAGE SECTION. IF1354.2 +002700*********************************************************** IF1354.2 +002800* Variables specific to the Intrinsic Function Test IF135A* IF1354.2 +002900*********************************************************** IF1354.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1354.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1354.2 +003200 01 C PIC S9(10) VALUE 100000. IF1354.2 +003300 01 D PIC S9(10) VALUE 1000. IF1354.2 +003400 01 PI PIC S9V9(17) VALUE 3.141592654. IF1354.2 +003500 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1354.2 +003600 01 P PIC S9(10) VALUE 1. IF1354.2 +003700 01 ARG1 PIC S9(10) VALUE 3. IF1354.2 +003800 01 ARR VALUE "40537". IF1354.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1354.2 +004000 01 TEMP PIC S9(5)V9(5). IF1354.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1354.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1354.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1354.2 +004400* IF1354.2 +004500********************************************************** IF1354.2 +004600* IF1354.2 +004700 01 TEST-RESULTS. IF1354.2 +004800 02 FILLER PIC X VALUE SPACE. IF1354.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1354.2 +005000 02 FILLER PIC X VALUE SPACE. IF1354.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1354.2 +005200 02 FILLER PIC X VALUE SPACE. IF1354.2 +005300 02 PAR-NAME. IF1354.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1354.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1354.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1354.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1354.2 +005800 02 RE-MARK PIC X(61). IF1354.2 +005900 01 TEST-COMPUTED. IF1354.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +006100 02 FILLER PIC X(17) VALUE IF1354.2 +006200 " COMPUTED=". IF1354.2 +006300 02 COMPUTED-X. IF1354.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1354.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1354.2 +006600 PIC -9(9).9(9). IF1354.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1354.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1354.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1354.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1354.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1354.2 +007200 04 FILLER PIC X. IF1354.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1354.2 +007400 01 TEST-CORRECT. IF1354.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1354.2 +007700 02 CORRECT-X. IF1354.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1354.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1354.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1354.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1354.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1354.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1354.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1354.2 +008500 04 FILLER PIC X. IF1354.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1354.2 +008800 01 TEST-CORRECT-MIN. IF1354.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1354.2 +009100 02 CORRECTMI-X. IF1354.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1354.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1354.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1354.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1354.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1354.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1354.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1354.2 +009900 04 FILLER PIC X. IF1354.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1354.2 +010200 01 TEST-CORRECT-MAX. IF1354.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1354.2 +010500 02 CORRECTMA-X. IF1354.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1354.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1354.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1354.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1354.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1354.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1354.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1354.2 +011300 04 FILLER PIC X. IF1354.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1354.2 +011600 01 CCVS-C-1. IF1354.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1354.2 +011800- "SS PARAGRAPH-NAME IF1354.2 +011900- " REMARKS". IF1354.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1354.2 +012100 01 CCVS-C-2. IF1354.2 +012200 02 FILLER PIC X VALUE SPACE. IF1354.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1354.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1354.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1354.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1354.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1354.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1354.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1354.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1354.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1354.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1354.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1354.2 +013800 01 CCVS-H-1. IF1354.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1354.2 +014000 02 FILLER PIC X(42) VALUE IF1354.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1354.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1354.2 +014300 01 CCVS-H-2A. IF1354.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1354.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1354.2 +014600 02 FILLER PIC XXXX VALUE IF1354.2 +014700 "4.2 ". IF1354.2 +014800 02 FILLER PIC X(28) VALUE IF1354.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1354.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1354.2 +015100 IF1354.2 +015200 01 CCVS-H-2B. IF1354.2 +015300 02 FILLER PIC X(15) VALUE IF1354.2 +015400 "TEST RESULT OF ". IF1354.2 +015500 02 TEST-ID PIC X(9). IF1354.2 +015600 02 FILLER PIC X(4) VALUE IF1354.2 +015700 " IN ". IF1354.2 +015800 02 FILLER PIC X(12) VALUE IF1354.2 +015900 " HIGH ". IF1354.2 +016000 02 FILLER PIC X(22) VALUE IF1354.2 +016100 " LEVEL VALIDATION FOR ". IF1354.2 +016200 02 FILLER PIC X(58) VALUE IF1354.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1354.2 +016400 01 CCVS-H-3. IF1354.2 +016500 02 FILLER PIC X(34) VALUE IF1354.2 +016600 " FOR OFFICIAL USE ONLY ". IF1354.2 +016700 02 FILLER PIC X(58) VALUE IF1354.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1354.2 +016900 02 FILLER PIC X(28) VALUE IF1354.2 +017000 " COPYRIGHT 1985 ". IF1354.2 +017100 01 CCVS-E-1. IF1354.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1354.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1354.2 +017400 02 ID-AGAIN PIC X(9). IF1354.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1354.2 +017600 01 CCVS-E-2. IF1354.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1354.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1354.2 +017900 02 CCVS-E-2-2. IF1354.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1354.2 +018100 03 FILLER PIC X VALUE SPACE. IF1354.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1354.2 +018300 "ERRORS ENCOUNTERED". IF1354.2 +018400 01 CCVS-E-3. IF1354.2 +018500 02 FILLER PIC X(22) VALUE IF1354.2 +018600 " FOR OFFICIAL USE ONLY". IF1354.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1354.2 +018800 02 FILLER PIC X(58) VALUE IF1354.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1354.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1354.2 +019100 02 FILLER PIC X(15) VALUE IF1354.2 +019200 " COPYRIGHT 1985". IF1354.2 +019300 01 CCVS-E-4. IF1354.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1354.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1354.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1354.2 +019700 02 FILLER PIC X(40) VALUE IF1354.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1354.2 +019900 01 XXINFO. IF1354.2 +020000 02 FILLER PIC X(19) VALUE IF1354.2 +020100 "*** INFORMATION ***". IF1354.2 +020200 02 INFO-TEXT. IF1354.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1354.2 +020400 04 XXCOMPUTED PIC X(20). IF1354.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1354.2 +020600 04 XXCORRECT PIC X(20). IF1354.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1354.2 +020800 01 HYPHEN-LINE. IF1354.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1354.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1354.2 +021100- "*****************************************". IF1354.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1354.2 +021300- "******************************". IF1354.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1354.2 +021500 "IF135A". IF1354.2 +021600 PROCEDURE DIVISION. IF1354.2 +021700 CCVS1 SECTION. IF1354.2 +021800 OPEN-FILES. IF1354.2 +021900 OPEN OUTPUT PRINT-FILE. IF1354.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1354.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1354.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1354.2 +022300 GO TO CCVS1-EXIT. IF1354.2 +022400 CLOSE-FILES. IF1354.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1354.2 +022600 TERMINATE-CCVS. IF1354.2 +022700 STOP RUN. IF1354.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1354.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1354.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1354.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1354.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1354.2 +023300 PRINT-DETAIL. IF1354.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1354.2 +023500 MOVE "." TO PARDOT-X IF1354.2 +023600 MOVE REC-CT TO DOTVALUE. IF1354.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1354.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1354.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1354.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1354.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1354.2 +024200 MOVE SPACE TO CORRECT-X. IF1354.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1354.2 +024400 MOVE SPACE TO RE-MARK. IF1354.2 +024500 HEAD-ROUTINE. IF1354.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1354.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1354.2 +025000 COLUMN-NAMES-ROUTINE. IF1354.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +025400 END-ROUTINE. IF1354.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1354.2 +025600 END-RTN-EXIT. IF1354.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +025800 END-ROUTINE-1. IF1354.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1354.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1354.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1354.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1354.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1354.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1354.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1354.2 +026600 END-ROUTINE-12. IF1354.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1354.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1354.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1354.2 +027000 ELSE IF1354.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1354.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1354.2 +027300 PERFORM WRITE-LINE. IF1354.2 +027400 END-ROUTINE-13. IF1354.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1354.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1354.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1354.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1354.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1354.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1354.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1354.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1354.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028600 WRITE-LINE. IF1354.2 +028700 ADD 1 TO RECORD-COUNT. IF1354.2 +028800Y IF RECORD-COUNT GREATER 42 IF1354.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1354.2 +029000Y MOVE SPACE TO DUMMY-RECORD IF1354.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1354.2 +029200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1354.2 +029300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1354.2 +029400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1354.2 +029500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1354.2 +029600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1354.2 +030000Y MOVE ZERO TO RECORD-COUNT. IF1354.2 +030100 PERFORM WRT-LN. IF1354.2 +030200 WRT-LN. IF1354.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1354.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1354.2 +030500 BLANK-LINE-PRINT. IF1354.2 +030600 PERFORM WRT-LN. IF1354.2 +030700 FAIL-ROUTINE. IF1354.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1354.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1354.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1354.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1354.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1354.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1354.2 +031500 GO TO FAIL-ROUTINE-EX. IF1354.2 +031600 FAIL-ROUTINE-WRITE. IF1354.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1354.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1354.2 +031900 CORMA-ANSI-REFERENCE. IF1354.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1354.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1354.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1354.2 +032300 ELSE IF1354.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1354.2 +032500 PERFORM WRITE-LINE. IF1354.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1354.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1354.2 +032800 BAIL-OUT. IF1354.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1354.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1354.2 +033100 BAIL-OUT-WRITE. IF1354.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1354.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1354.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1354.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1354.2 +033700 BAIL-OUT-EX. EXIT. IF1354.2 +033800 CCVS1-EXIT. IF1354.2 +033900 EXIT. IF1354.2 +034000******************************************************** IF1354.2 +034100* * IF1354.2 +034200* Intrinsic Function Tests IF135A - SIN * IF1354.2 +034300* * IF1354.2 +034400******************************************************** IF1354.2 +034500 SECT-IF135A SECTION. IF1354.2 +034600 F-SIN-INFO. IF1354.2 +034700 MOVE "See ref. A-68 2.39" TO ANSI-REFERENCE. IF1354.2 +034800 MOVE "SIN Function" TO FEATURE. IF1354.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1354.2 +035000 F-SIN-01. IF1354.2 +035100 MOVE ZERO TO WS-NUM. IF1354.2 +035200 MOVE -0.000020 TO MIN-RANGE. IF1354.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1354.2 +035400 F-SIN-TEST-01. IF1354.2 +035500 COMPUTE WS-NUM = FUNCTION SIN(0). IF1354.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +035800 PERFORM PASS IF1354.2 +035900 ELSE IF1354.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1354.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +036300 PERFORM FAIL. IF1354.2 +036400 GO TO F-SIN-WRITE-01. IF1354.2 +036500 F-SIN-DELETE-01. IF1354.2 +036600 PERFORM DE-LETE. IF1354.2 +036700 GO TO F-SIN-WRITE-01. IF1354.2 +036800 F-SIN-WRITE-01. IF1354.2 +036900 MOVE "F-SIN-01" TO PAR-NAME. IF1354.2 +037000 PERFORM PRINT-DETAIL. IF1354.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1354.2 +037200 F-SIN-02. IF1354.2 +037300 EVALUATE FUNCTION SIN(PI) IF1354.2 +037400 WHEN -0.000020 THRU 0.000020 IF1354.2 +037500 PERFORM PASS IF1354.2 +037600 WHEN OTHER IF1354.2 +037700 PERFORM FAIL. IF1354.2 +037800 GO TO F-SIN-WRITE-02. IF1354.2 +037900 F-SIN-DELETE-02. IF1354.2 +038000 PERFORM DE-LETE. IF1354.2 +038100 GO TO F-SIN-WRITE-02. IF1354.2 +038200 F-SIN-WRITE-02. IF1354.2 +038300 MOVE "F-SIN-02" TO PAR-NAME. IF1354.2 +038400 PERFORM PRINT-DETAIL. IF1354.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1354.2 +038600 F-SIN-03. IF1354.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1354.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1354.2 +038900 F-SIN-TEST-03. IF1354.2 +039000 IF (FUNCTION SIN(MINUSPI) >= MIN-RANGE) AND IF1354.2 +039100 (FUNCTION SIN(MINUSPI) <= MAX-RANGE) THEN IF1354.2 +039200 PERFORM PASS IF1354.2 +039300 ELSE IF1354.2 +039400 PERFORM FAIL. IF1354.2 +039500 GO TO F-SIN-WRITE-03. IF1354.2 +039600 F-SIN-DELETE-03. IF1354.2 +039700 PERFORM DE-LETE. IF1354.2 +039800 GO TO F-SIN-WRITE-03. IF1354.2 +039900 F-SIN-WRITE-03. IF1354.2 +040000 MOVE "F-SIN-03" TO PAR-NAME. IF1354.2 +040100 PERFORM PRINT-DETAIL. IF1354.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1354.2 +040300 F-SIN-04. IF1354.2 +040400 MOVE ZERO TO WS-NUM. IF1354.2 +040500 MOVE 0.000999 TO MIN-RANGE. IF1354.2 +040600 MOVE 0.001000 TO MAX-RANGE. IF1354.2 +040700 F-SIN-TEST-04. IF1354.2 +040800 COMPUTE WS-NUM = FUNCTION SIN(0.001). IF1354.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +041100 PERFORM PASS IF1354.2 +041200 ELSE IF1354.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +041600 PERFORM FAIL. IF1354.2 +041700 GO TO F-SIN-WRITE-04. IF1354.2 +041800 F-SIN-DELETE-04. IF1354.2 +041900 PERFORM DE-LETE. IF1354.2 +042000 GO TO F-SIN-WRITE-04. IF1354.2 +042100 F-SIN-WRITE-04. IF1354.2 +042200 MOVE "F-SIN-04" TO PAR-NAME. IF1354.2 +042300 PERFORM PRINT-DETAIL. IF1354.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1354.2 +042500 F-SIN-05. IF1354.2 +042600 MOVE ZERO TO WS-NUM. IF1354.2 +042700 MOVE 0.000089 TO MIN-RANGE. IF1354.2 +042800 MOVE 0.000090 TO MAX-RANGE. IF1354.2 +042900 F-SIN-TEST-05. IF1354.2 +043000 COMPUTE WS-NUM = FUNCTION SIN(.00009). IF1354.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +043300 PERFORM PASS IF1354.2 +043400 ELSE IF1354.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +043800 PERFORM FAIL. IF1354.2 +043900 GO TO F-SIN-WRITE-05. IF1354.2 +044000 F-SIN-DELETE-05. IF1354.2 +044100 PERFORM DE-LETE. IF1354.2 +044200 GO TO F-SIN-WRITE-05. IF1354.2 +044300 F-SIN-WRITE-05. IF1354.2 +044400 MOVE "F-SIN-05" TO PAR-NAME. IF1354.2 +044500 PERFORM PRINT-DETAIL. IF1354.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1354.2 +044700 F-SIN-06. IF1354.2 +044800 MOVE ZERO TO WS-NUM. IF1354.2 +044900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +045000 MOVE -0.000039 TO MAX-RANGE. IF1354.2 +045100 F-SIN-TEST-06. IF1354.2 +045200 COMPUTE WS-NUM = FUNCTION SIN(A). IF1354.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +045500 PERFORM PASS IF1354.2 +045600 ELSE IF1354.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +046000 PERFORM FAIL. IF1354.2 +046100 GO TO F-SIN-WRITE-06. IF1354.2 +046200 F-SIN-DELETE-06. IF1354.2 +046300 PERFORM DE-LETE. IF1354.2 +046400 GO TO F-SIN-WRITE-06. IF1354.2 +046500 F-SIN-WRITE-06. IF1354.2 +046600 MOVE "F-SIN-06" TO PAR-NAME. IF1354.2 +046700 PERFORM PRINT-DETAIL. IF1354.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1354.2 +046900 F-SIN-07. IF1354.2 +047000 MOVE ZERO TO WS-NUM. IF1354.2 +047100 MOVE -0.756817 TO MIN-RANGE. IF1354.2 +047200 MOVE -0.756787 TO MAX-RANGE. IF1354.2 +047300 F-SIN-TEST-07. IF1354.2 +047400 COMPUTE WS-NUM = FUNCTION SIN(IND(P)). IF1354.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +047700 PERFORM PASS IF1354.2 +047800 ELSE IF1354.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +048200 PERFORM FAIL. IF1354.2 +048300 GO TO F-SIN-WRITE-07. IF1354.2 +048400 F-SIN-DELETE-07. IF1354.2 +048500 PERFORM DE-LETE. IF1354.2 +048600 GO TO F-SIN-WRITE-07. IF1354.2 +048700 F-SIN-WRITE-07. IF1354.2 +048800 MOVE "F-SIN-07" TO PAR-NAME. IF1354.2 +048900 PERFORM PRINT-DETAIL. IF1354.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1354.2 +049100 F-SIN-08. IF1354.2 +049200 MOVE ZERO TO WS-NUM. IF1354.2 +049300 MOVE 0.141117 TO MIN-RANGE. IF1354.2 +049400 MOVE 0.141123 TO MAX-RANGE. IF1354.2 +049500 F-SIN-TEST-08. IF1354.2 +049600 COMPUTE WS-NUM = FUNCTION SIN(IND(4)). IF1354.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +049900 PERFORM PASS IF1354.2 +050000 ELSE IF1354.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +050400 PERFORM FAIL. IF1354.2 +050500 GO TO F-SIN-WRITE-08. IF1354.2 +050600 F-SIN-DELETE-08. IF1354.2 +050700 PERFORM DE-LETE. IF1354.2 +050800 GO TO F-SIN-WRITE-08. IF1354.2 +050900 F-SIN-WRITE-08. IF1354.2 +051000 MOVE "F-SIN-08" TO PAR-NAME. IF1354.2 +051100 PERFORM PRINT-DETAIL. IF1354.2 +051200*****************TEST (a) - COMPLEX TEST**************** IF1354.2 +051300 F-SIN-09. IF1354.2 +051400 MOVE ZERO TO WS-NUM. IF1354.2 +051500 MOVE 0.865990 TO MIN-RANGE. IF1354.2 +051600 MOVE 0.866060 TO MAX-RANGE. IF1354.2 +051700 F-SIN-TEST-09. IF1354.2 +051800 COMPUTE WS-NUM = FUNCTION SIN(PI / 3). IF1354.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +052100 PERFORM PASS IF1354.2 +052200 ELSE IF1354.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +052600 PERFORM FAIL. IF1354.2 +052700 GO TO F-SIN-WRITE-09. IF1354.2 +052800 F-SIN-DELETE-09. IF1354.2 +052900 PERFORM DE-LETE. IF1354.2 +053000 GO TO F-SIN-WRITE-09. IF1354.2 +053100 F-SIN-WRITE-09. IF1354.2 +053200 MOVE "F-SIN-09" TO PAR-NAME. IF1354.2 +053300 PERFORM PRINT-DETAIL. IF1354.2 +053400*****************TEST (b) - COMPLEX TEST**************** IF1354.2 +053500 F-SIN-10. IF1354.2 +053600 MOVE ZERO TO WS-NUM. IF1354.2 +053700 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +053800 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +053900 F-SIN-TEST-10. IF1354.2 +054000 COMPUTE WS-NUM = FUNCTION SIN(PI / 2). IF1354.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +054300 PERFORM PASS IF1354.2 +054400 ELSE IF1354.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +054800 PERFORM FAIL. IF1354.2 +054900 GO TO F-SIN-WRITE-10. IF1354.2 +055000 F-SIN-DELETE-10. IF1354.2 +055100 PERFORM DE-LETE. IF1354.2 +055200 GO TO F-SIN-WRITE-10. IF1354.2 +055300 F-SIN-WRITE-10. IF1354.2 +055400 MOVE "F-SIN-10" TO PAR-NAME. IF1354.2 +055500 PERFORM PRINT-DETAIL. IF1354.2 +055600*****************TEST (c) - COMPLEX TEST**************** IF1354.2 +055700 F-SIN-11. IF1354.2 +055800 MOVE ZERO TO WS-NUM. IF1354.2 +055900 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +056000 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +056100 F-SIN-TEST-11. IF1354.2 +056200 COMPUTE WS-NUM = FUNCTION SIN((3 * PI) / 2). IF1354.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +056500 PERFORM PASS IF1354.2 +056600 ELSE IF1354.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +057000 PERFORM FAIL. IF1354.2 +057100 GO TO F-SIN-WRITE-11. IF1354.2 +057200 F-SIN-DELETE-11. IF1354.2 +057300 PERFORM DE-LETE. IF1354.2 +057400 GO TO F-SIN-WRITE-11. IF1354.2 +057500 F-SIN-WRITE-11. IF1354.2 +057600 MOVE "F-SIN-11" TO PAR-NAME. IF1354.2 +057700 PERFORM PRINT-DETAIL. IF1354.2 +057800*****************TEST (d) - COMPLEX TEST**************** IF1354.2 +057900 F-SIN-12. IF1354.2 +058000 MOVE ZERO TO WS-NUM. IF1354.2 +058100 MOVE -0.866060 TO MIN-RANGE. IF1354.2 +058200 MOVE -0.865990 TO MAX-RANGE. IF1354.2 +058300 F-SIN-TEST-12. IF1354.2 +058400 COMPUTE WS-NUM = FUNCTION SIN(MINUSPI / 3). IF1354.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +058700 PERFORM PASS IF1354.2 +058800 ELSE IF1354.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +059200 PERFORM FAIL. IF1354.2 +059300 GO TO F-SIN-WRITE-12. IF1354.2 +059400 F-SIN-DELETE-12. IF1354.2 +059500 PERFORM DE-LETE. IF1354.2 +059600 GO TO F-SIN-WRITE-12. IF1354.2 +059700 F-SIN-WRITE-12. IF1354.2 +059800 MOVE "F-SIN-12" TO PAR-NAME. IF1354.2 +059900 PERFORM PRINT-DETAIL. IF1354.2 +060000*****************TEST (e) - COMPLEX TEST**************** IF1354.2 +060100 F-SIN-13. IF1354.2 +060200 MOVE ZERO TO WS-NUM. IF1354.2 +060300 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +060400 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +060500 F-SIN-TEST-13. IF1354.2 +060600 COMPUTE WS-NUM = FUNCTION SIN(MINUSPI / 2). IF1354.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +060900 PERFORM PASS IF1354.2 +061000 ELSE IF1354.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +061400 PERFORM FAIL. IF1354.2 +061500 GO TO F-SIN-WRITE-13. IF1354.2 +061600 F-SIN-DELETE-13. IF1354.2 +061700 PERFORM DE-LETE. IF1354.2 +061800 GO TO F-SIN-WRITE-13. IF1354.2 +061900 F-SIN-WRITE-13. IF1354.2 +062000 MOVE "F-SIN-13" TO PAR-NAME. IF1354.2 +062100 PERFORM PRINT-DETAIL. IF1354.2 +062200*****************TEST (f) - COMPLEX TEST**************** IF1354.2 +062300 F-SIN-14. IF1354.2 +062400 MOVE ZERO TO WS-NUM. IF1354.2 +062500 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +062600 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +062700 F-SIN-TEST-14. IF1354.2 +062800 COMPUTE WS-NUM = FUNCTION SIN((3 * MINUSPI) / 2). IF1354.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +063100 PERFORM PASS IF1354.2 +063200 ELSE IF1354.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +063600 PERFORM FAIL. IF1354.2 +063700 GO TO F-SIN-WRITE-14. IF1354.2 +063800 F-SIN-DELETE-14. IF1354.2 +063900 PERFORM DE-LETE. IF1354.2 +064000 GO TO F-SIN-WRITE-14. IF1354.2 +064100 F-SIN-WRITE-14. IF1354.2 +064200 MOVE "F-SIN-14" TO PAR-NAME. IF1354.2 +064300 PERFORM PRINT-DETAIL. IF1354.2 +064400*****************TEST (g) - COMPLEX TEST**************** IF1354.2 +064500 F-SIN-15. IF1354.2 +064600 MOVE ZERO TO WS-NUM. IF1354.2 +064700 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +064800 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +064900 F-SIN-TEST-15. IF1354.2 +065000 COMPUTE WS-NUM = FUNCTION SIN((PI / 2) - 0.001). IF1354.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +065300 PERFORM PASS IF1354.2 +065400 ELSE IF1354.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +065800 PERFORM FAIL. IF1354.2 +065900 GO TO F-SIN-WRITE-15. IF1354.2 +066000 F-SIN-DELETE-15. IF1354.2 +066100 PERFORM DE-LETE. IF1354.2 +066200 GO TO F-SIN-WRITE-15. IF1354.2 +066300 F-SIN-WRITE-15. IF1354.2 +066400 MOVE "F-SIN-15" TO PAR-NAME. IF1354.2 +066500 PERFORM PRINT-DETAIL. IF1354.2 +066600*****************TEST (h) - COMPLEX TEST**************** IF1354.2 +066700 F-SIN-16. IF1354.2 +066800 MOVE ZERO TO WS-NUM. IF1354.2 +066900 MOVE 0.866489 TO MIN-RANGE. IF1354.2 +067000 MOVE 0.866559 TO MAX-RANGE. IF1354.2 +067100 F-SIN-TEST-16. IF1354.2 +067200 COMPUTE WS-NUM = FUNCTION SIN((PI / 3) + 0.001). IF1354.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +067500 PERFORM PASS IF1354.2 +067600 ELSE IF1354.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +068000 PERFORM FAIL. IF1354.2 +068100 GO TO F-SIN-WRITE-16. IF1354.2 +068200 F-SIN-DELETE-16. IF1354.2 +068300 PERFORM DE-LETE. IF1354.2 +068400 GO TO F-SIN-WRITE-16. IF1354.2 +068500 F-SIN-WRITE-16. IF1354.2 +068600 MOVE "F-SIN-16" TO PAR-NAME. IF1354.2 +068700 PERFORM PRINT-DETAIL. IF1354.2 +068800*****************TEST (i) - COMPLEX TEST**************** IF1354.2 +068900 F-SIN-17. IF1354.2 +069000 MOVE ZERO TO WS-NUM. IF1354.2 +069100 MOVE 0.000999 TO MIN-RANGE. IF1354.2 +069200 MOVE 0.001000 TO MAX-RANGE. IF1354.2 +069300 F-SIN-TEST-17. IF1354.2 +069400 COMPUTE WS-NUM = FUNCTION SIN(PI - 0.001). IF1354.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +069700 PERFORM PASS IF1354.2 +069800 ELSE IF1354.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +070200 PERFORM FAIL. IF1354.2 +070300 GO TO F-SIN-WRITE-17. IF1354.2 +070400 F-SIN-DELETE-17. IF1354.2 +070500 PERFORM DE-LETE. IF1354.2 +070600 GO TO F-SIN-WRITE-17. IF1354.2 +070700 F-SIN-WRITE-17. IF1354.2 +070800 MOVE "F-SIN-17" TO PAR-NAME. IF1354.2 +070900 PERFORM PRINT-DETAIL. IF1354.2 +071000*****************TEST (j) - COMPLEX TEST**************** IF1354.2 +071100 F-SIN-18. IF1354.2 +071200 MOVE ZERO TO WS-NUM. IF1354.2 +071300 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +071400 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +071500 F-SIN-TEST-18. IF1354.2 +071600 COMPUTE WS-NUM = FUNCTION SIN(((3 * PI) / 2) + 0.001). IF1354.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +071900 PERFORM PASS IF1354.2 +072000 ELSE IF1354.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +072400 PERFORM FAIL. IF1354.2 +072500 GO TO F-SIN-WRITE-18. IF1354.2 +072600 F-SIN-DELETE-18. IF1354.2 +072700 PERFORM DE-LETE. IF1354.2 +072800 GO TO F-SIN-WRITE-18. IF1354.2 +072900 F-SIN-WRITE-18. IF1354.2 +073000 MOVE "F-SIN-18" TO PAR-NAME. IF1354.2 +073100 PERFORM PRINT-DETAIL. IF1354.2 +073200*****************TEST (k) - COMPLEX TEST**************** IF1354.2 +073300 F-SIN-19. IF1354.2 +073400 MOVE ZERO TO WS-NUM. IF1354.2 +073500 MOVE 0.034898 TO MIN-RANGE. IF1354.2 +073600 MOVE 0.034900 TO MAX-RANGE. IF1354.2 +073700 F-SIN-TEST-19. IF1354.2 +073800 COMPUTE WS-NUM = FUNCTION SIN( PI * (4 - 2) / 180). IF1354.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +074100 PERFORM PASS IF1354.2 +074200 ELSE IF1354.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +074600 PERFORM FAIL. IF1354.2 +074700 GO TO F-SIN-WRITE-19. IF1354.2 +074800 F-SIN-DELETE-19. IF1354.2 +074900 PERFORM DE-LETE. IF1354.2 +075000 GO TO F-SIN-WRITE-19. IF1354.2 +075100 F-SIN-WRITE-19. IF1354.2 +075200 MOVE "F-SIN-19" TO PAR-NAME. IF1354.2 +075300 PERFORM PRINT-DETAIL. IF1354.2 +075400*****************TEST (l) - COMPLEX TEST**************** IF1354.2 +075500 F-SIN-20. IF1354.2 +075600 MOVE ZERO TO WS-NUM. IF1354.2 +075700 MOVE 0.999807 TO MIN-RANGE. IF1354.2 +075800 MOVE 0.999887 TO MAX-RANGE. IF1354.2 +075900 F-SIN-TEST-20. IF1354.2 +076000 COMPUTE WS-NUM = FUNCTION SIN( (PI / 2) - (PI / 180)). IF1354.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +076300 PERFORM PASS IF1354.2 +076400 ELSE IF1354.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +076800 PERFORM FAIL. IF1354.2 +076900 GO TO F-SIN-WRITE-20. IF1354.2 +077000 F-SIN-DELETE-20. IF1354.2 +077100 PERFORM DE-LETE. IF1354.2 +077200 GO TO F-SIN-WRITE-20. IF1354.2 +077300 F-SIN-WRITE-20. IF1354.2 +077400 MOVE "F-SIN-20" TO PAR-NAME. IF1354.2 +077500 PERFORM PRINT-DETAIL. IF1354.2 +077600*****************TEST (m) - COMPLEX TEST**************** IF1354.2 +077700 F-SIN-21. IF1354.2 +077800 MOVE ZERO TO WS-NUM. IF1354.2 +077900 MOVE 0.857132 TO MIN-RANGE. IF1354.2 +078000 MOVE 0.857201 TO MAX-RANGE. IF1354.2 +078100 F-SIN-TEST-21. IF1354.2 +078200 COMPUTE WS-NUM = FUNCTION SIN((PI / 3) - (PI / 180)). IF1354.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +078500 PERFORM PASS IF1354.2 +078600 ELSE IF1354.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +079000 PERFORM FAIL. IF1354.2 +079100 GO TO F-SIN-WRITE-21. IF1354.2 +079200 F-SIN-DELETE-21. IF1354.2 +079300 PERFORM DE-LETE. IF1354.2 +079400 GO TO F-SIN-WRITE-21. IF1354.2 +079500 F-SIN-WRITE-21. IF1354.2 +079600 MOVE "F-SIN-21" TO PAR-NAME. IF1354.2 +079700 PERFORM PRINT-DETAIL. IF1354.2 +079800*****************TEST (n) - COMPLEX TEST**************** IF1354.2 +079900 F-SIN-22. IF1354.2 +080000 MOVE ZERO TO WS-NUM. IF1354.2 +080100 MOVE -0.017453 TO MIN-RANGE. IF1354.2 +080200 MOVE -0.017451 TO MAX-RANGE. IF1354.2 +080300 F-SIN-TEST-22. IF1354.2 +080400 COMPUTE WS-NUM = FUNCTION SIN(PI + (PI / 180)). IF1354.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +080700 PERFORM PASS IF1354.2 +080800 ELSE IF1354.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +081200 PERFORM FAIL. IF1354.2 +081300 GO TO F-SIN-WRITE-22. IF1354.2 +081400 F-SIN-DELETE-22. IF1354.2 +081500 PERFORM DE-LETE. IF1354.2 +081600 GO TO F-SIN-WRITE-22. IF1354.2 +081700 F-SIN-WRITE-22. IF1354.2 +081800 MOVE "F-SIN-22" TO PAR-NAME. IF1354.2 +081900 PERFORM PRINT-DETAIL. IF1354.2 +082000*****************TEST (o) - COMPLEX TEST**************** IF1354.2 +082100 F-SIN-23. IF1354.2 +082200 MOVE ZERO TO WS-NUM. IF1354.2 +082300 MOVE -0.999430 TO MIN-RANGE. IF1354.2 +082400 MOVE -0.999350 TO MAX-RANGE. IF1354.2 +082500 F-SIN-TEST-23. IF1354.2 +082600 COMPUTE WS-NUM = FUNCTION SIN((PI * 272) / 180). IF1354.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +082900 PERFORM PASS IF1354.2 +083000 ELSE IF1354.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +083400 PERFORM FAIL. IF1354.2 +083500 GO TO F-SIN-WRITE-23. IF1354.2 +083600 F-SIN-DELETE-23. IF1354.2 +083700 PERFORM DE-LETE. IF1354.2 +083800 GO TO F-SIN-WRITE-23. IF1354.2 +083900 F-SIN-WRITE-23. IF1354.2 +084000 MOVE "F-SIN-23" TO PAR-NAME. IF1354.2 +084100 PERFORM PRINT-DETAIL. IF1354.2 +084200*****************TEST (p) - COMPLEX TEST**************** IF1354.2 +084300 F-SIN-24. IF1354.2 +084400 MOVE ZERO TO WS-NUM. IF1354.2 +084500 MOVE 0.909261 TO MIN-RANGE. IF1354.2 +084600 MOVE 0.909333 TO MAX-RANGE. IF1354.2 +084700 F-SIN-TEST-24. IF1354.2 +084800 COMPUTE WS-NUM = FUNCTION SIN(4 / 2). IF1354.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +085100 PERFORM PASS IF1354.2 +085200 ELSE IF1354.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +085600 PERFORM FAIL. IF1354.2 +085700 GO TO F-SIN-WRITE-24. IF1354.2 +085800 F-SIN-DELETE-24. IF1354.2 +085900 PERFORM DE-LETE. IF1354.2 +086000 GO TO F-SIN-WRITE-24. IF1354.2 +086100 F-SIN-WRITE-24. IF1354.2 +086200 MOVE "F-SIN-24" TO PAR-NAME. IF1354.2 +086300 PERFORM PRINT-DETAIL. IF1354.2 +086400*****************TEST (q) - COMPLEX TEST**************** IF1354.2 +086500 F-SIN-25. IF1354.2 +086600 MOVE ZERO TO WS-NUM. IF1354.2 +086700 MOVE 0.997454 TO MIN-RANGE. IF1354.2 +086800 MOVE 0.997534 TO MAX-RANGE. IF1354.2 +086900 F-SIN-TEST-25. IF1354.2 +087000 COMPUTE WS-NUM = FUNCTION SIN(3 / 2). IF1354.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +087300 PERFORM PASS IF1354.2 +087400 ELSE IF1354.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +087800 PERFORM FAIL. IF1354.2 +087900 GO TO F-SIN-WRITE-25. IF1354.2 +088000 F-SIN-DELETE-25. IF1354.2 +088100 PERFORM DE-LETE. IF1354.2 +088200 GO TO F-SIN-WRITE-25. IF1354.2 +088300 F-SIN-WRITE-25. IF1354.2 +088400 MOVE "F-SIN-25" TO PAR-NAME. IF1354.2 +088500 PERFORM PRINT-DETAIL. IF1354.2 +088600*****************TEST (r) - COMPLEX TEST**************** IF1354.2 +088700 F-SIN-26. IF1354.2 +088800 MOVE ZERO TO WS-NUM. IF1354.2 +088900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +089000 MOVE -0.000039 TO MAX-RANGE. IF1354.2 +089100 F-SIN-TEST-26. IF1354.2 +089200 COMPUTE WS-NUM = FUNCTION SIN(PI - A). IF1354.2 +089300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +089400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +089500 PERFORM PASS IF1354.2 +089600 ELSE IF1354.2 +089700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +089800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +089900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +090000 PERFORM FAIL. IF1354.2 +090100 GO TO F-SIN-WRITE-26. IF1354.2 +090200 F-SIN-DELETE-26. IF1354.2 +090300 PERFORM DE-LETE. IF1354.2 +090400 GO TO F-SIN-WRITE-26. IF1354.2 +090500 F-SIN-WRITE-26. IF1354.2 +090600 MOVE "F-SIN-26" TO PAR-NAME. IF1354.2 +090700 PERFORM PRINT-DETAIL. IF1354.2 +090800*****************TEST (s) - COMPLEX TEST**************** IF1354.2 +090900 F-SIN-27. IF1354.2 +091000 MOVE ZERO TO WS-NUM. IF1354.2 +091100 MOVE -0.544043 TO MIN-RANGE. IF1354.2 +091200 MOVE -0.543999 TO MAX-RANGE. IF1354.2 +091300 F-SIN-TEST-27. IF1354.2 +091400 COMPUTE WS-NUM = FUNCTION SIN(D / 100). IF1354.2 +091500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +091600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +091700 PERFORM PASS IF1354.2 +091800 ELSE IF1354.2 +091900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +092000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +092100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +092200 PERFORM FAIL. IF1354.2 +092300 GO TO F-SIN-WRITE-27. IF1354.2 +092400 F-SIN-DELETE-27. IF1354.2 +092500 PERFORM DE-LETE. IF1354.2 +092600 GO TO F-SIN-WRITE-27. IF1354.2 +092700 F-SIN-WRITE-27. IF1354.2 +092800 MOVE "F-SIN-27" TO PAR-NAME. IF1354.2 +092900 PERFORM PRINT-DETAIL. IF1354.2 +093000*****************TEST (t) - COMPLEX TEST**************** IF1354.2 +093100 F-SIN-28. IF1354.2 +093200 MOVE ZERO TO WS-NUM. IF1354.2 +093300 MOVE 0.017451 TO MIN-RANGE. IF1354.2 +093400 MOVE 0.017453 TO MAX-RANGE. IF1354.2 +093500 F-SIN-TEST-28. IF1354.2 +093600 COMPUTE WS-NUM = FUNCTION SIN(PI / 180). IF1354.2 +093700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +093800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +093900 PERFORM PASS IF1354.2 +094000 ELSE IF1354.2 +094100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +094200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +094300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +094400 PERFORM FAIL. IF1354.2 +094500 GO TO F-SIN-WRITE-28. IF1354.2 +094600 F-SIN-DELETE-28. IF1354.2 +094700 PERFORM DE-LETE. IF1354.2 +094800 GO TO F-SIN-WRITE-28. IF1354.2 +094900 F-SIN-WRITE-28. IF1354.2 +095000 MOVE "F-SIN-28" TO PAR-NAME. IF1354.2 +095100 PERFORM PRINT-DETAIL. IF1354.2 +095200*****************TEST (u) - COMPLEX TEST**************** IF1354.2 +095300 F-SIN-29. IF1354.2 +095400 MOVE ZERO TO WS-NUM. IF1354.2 +095500 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +095600 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +095700 F-SIN-TEST-29. IF1354.2 +095800 COMPUTE WS-NUM = FUNCTION SIN(PI) + 1. IF1354.2 +095900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +096000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +096100 PERFORM PASS IF1354.2 +096200 ELSE IF1354.2 +096300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +096400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +096500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +096600 PERFORM FAIL. IF1354.2 +096700 GO TO F-SIN-WRITE-29. IF1354.2 +096800 F-SIN-DELETE-29. IF1354.2 +096900 PERFORM DE-LETE. IF1354.2 +097000 GO TO F-SIN-WRITE-29. IF1354.2 +097100 F-SIN-WRITE-29. IF1354.2 +097200 MOVE "F-SIN-29" TO PAR-NAME. IF1354.2 +097300 PERFORM PRINT-DETAIL. IF1354.2 +097400*****************TEST (v) - COMPLEX TEST**************** IF1354.2 +097500 F-SIN-30. IF1354.2 +097600 MOVE ZERO TO WS-NUM. IF1354.2 +097700 MOVE 0.789040 TO MIN-RANGE. IF1354.2 +097800 MOVE 0.789104 TO MAX-RANGE. IF1354.2 +097900 F-SIN-TEST-30. IF1354.2 +098000 COMPUTE WS-NUM = FUNCTION SIN(FUNCTION SIN(2)). IF1354.2 +098100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +098200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +098300 PERFORM PASS IF1354.2 +098400 ELSE IF1354.2 +098500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +098600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +098700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +098800 PERFORM FAIL. IF1354.2 +098900 GO TO F-SIN-WRITE-30. IF1354.2 +099000 F-SIN-DELETE-30. IF1354.2 +099100 PERFORM DE-LETE. IF1354.2 +099200 GO TO F-SIN-WRITE-30. IF1354.2 +099300 F-SIN-WRITE-30. IF1354.2 +099400 MOVE "F-SIN-30" TO PAR-NAME. IF1354.2 +099500 PERFORM PRINT-DETAIL. IF1354.2 +099600*****************TEST (w) - COMPLEX TEST**************** IF1354.2 +099700 F-SIN-31. IF1354.2 +099800 MOVE ZERO TO WS-NUM. IF1354.2 +099900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +100000 MOVE 0.000040 TO MAX-RANGE. IF1354.2 +100100 F-SIN-TEST-31. IF1354.2 +100200 COMPUTE WS-NUM = FUNCTION SIN(PI / 3) + IF1354.2 +100300 FUNCTION SIN(MINUSPI / 3). IF1354.2 +100400 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +100500 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +100600 PERFORM PASS IF1354.2 +100700 ELSE IF1354.2 +100800 MOVE WS-NUM TO COMPUTED-N IF1354.2 +100900 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +101000 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +101100 PERFORM FAIL. IF1354.2 +101200 GO TO F-SIN-WRITE-31. IF1354.2 +101300 F-SIN-DELETE-31. IF1354.2 +101400 PERFORM DE-LETE. IF1354.2 +101500 GO TO F-SIN-WRITE-31. IF1354.2 +101600 F-SIN-WRITE-31. IF1354.2 +101700 MOVE "F-SIN-31" TO PAR-NAME. IF1354.2 +101800 PERFORM PRINT-DETAIL. IF1354.2 +101900*****************SPECIAL PERFORM TEST********************** IF1354.2 +102000 F-SIN-32. IF1354.2 +102100 PERFORM F-SIN-TEST-32 IF1354.2 +102200 UNTIL FUNCTION SIN(ARG1) < 0. IF1354.2 +102300 PERFORM PASS. IF1354.2 +102400 GO TO F-SIN-WRITE-32. IF1354.2 +102500 F-SIN-TEST-32. IF1354.2 +102600 COMPUTE ARG1 = ARG1 - 1. IF1354.2 +102700 F-SIN-DELETE-32. IF1354.2 +102800 PERFORM DE-LETE. IF1354.2 +102900 GO TO F-SIN-WRITE-32. IF1354.2 +103000 F-SIN-WRITE-32. IF1354.2 +103100 MOVE "F-SIN-32" TO PAR-NAME. IF1354.2 +103200 PERFORM PRINT-DETAIL. IF1354.2 +103300********************END OF TESTS*************** IF1354.2 +103400 CCVS-EXIT SECTION. IF1354.2 +103500 CCVS-999999. IF1354.2 +103600 GO TO CLOSE-FILES. IF1354.2 +*END-OF,IF135A +*HEADER,COBOL,IF136A +000100 IDENTIFICATION DIVISION. IF1364.2 +000200 PROGRAM-ID. IF1364.2 +000300 IF136A. IF1364.2 +000400 IF1364.2 +000500*********************************************************** IF1364.2 +000600* * IF1364.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1364.2 +000800* It contains tests for the Intrinsic Function SQRT. * IF1364.2 +000900* * IF1364.2 +001000*********************************************************** IF1364.2 +001100 ENVIRONMENT DIVISION. IF1364.2 +001200 CONFIGURATION SECTION. IF1364.2 +001300 SOURCE-COMPUTER. IF1364.2 +001400 XXXXX082. IF1364.2 +001500 OBJECT-COMPUTER. IF1364.2 +001600 XXXXX083. IF1364.2 +001700 INPUT-OUTPUT SECTION. IF1364.2 +001800 FILE-CONTROL. IF1364.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1364.2 +002000 XXXXX055. IF1364.2 +002100 DATA DIVISION. IF1364.2 +002200 FILE SECTION. IF1364.2 +002300 FD PRINT-FILE. IF1364.2 +002400 01 PRINT-REC PICTURE X(120). IF1364.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1364.2 +002600 WORKING-STORAGE SECTION. IF1364.2 +002700*********************************************************** IF1364.2 +002800* Variables specific to the Intrinsic Function Test IF136A* IF1364.2 +002900*********************************************************** IF1364.2 +003000 01 A PIC S9(5)V9(5) VALUE 0.00004. IF1364.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1364.2 +003200 01 C PIC S9(10) VALUE 100000. IF1364.2 +003300 01 D PIC S9(10) VALUE 1000. IF1364.2 +003400 01 E PIC S9(10) VALUE 7. IF1364.2 +003500 01 F PIC S9(10) VALUE 6. IF1364.2 +003600 01 P PIC S9(10) VALUE 1. IF1364.2 +003700 01 ARG1 PIC S9(10) VALUE 10. IF1364.2 +003800 01 ARR VALUE "40537". IF1364.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1364.2 +004000 01 TEMP PIC S9(5)V9(5). IF1364.2 +004100 01 WS-NUM PIC S9(5)V9(7). IF1364.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1364.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1364.2 +004400* IF1364.2 +004500********************************************************** IF1364.2 +004600* IF1364.2 +004700 01 TEST-RESULTS. IF1364.2 +004800 02 FILLER PIC X VALUE SPACE. IF1364.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1364.2 +005000 02 FILLER PIC X VALUE SPACE. IF1364.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1364.2 +005200 02 FILLER PIC X VALUE SPACE. IF1364.2 +005300 02 PAR-NAME. IF1364.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1364.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1364.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1364.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1364.2 +005800 02 RE-MARK PIC X(61). IF1364.2 +005900 01 TEST-COMPUTED. IF1364.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +006100 02 FILLER PIC X(17) VALUE IF1364.2 +006200 " COMPUTED=". IF1364.2 +006300 02 COMPUTED-X. IF1364.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1364.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1364.2 +006600 PIC -9(9).9(9). IF1364.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1364.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1364.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1364.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1364.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1364.2 +007200 04 FILLER PIC X. IF1364.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1364.2 +007400 01 TEST-CORRECT. IF1364.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1364.2 +007700 02 CORRECT-X. IF1364.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1364.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1364.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1364.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1364.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1364.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1364.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1364.2 +008500 04 FILLER PIC X. IF1364.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1364.2 +008800 01 TEST-CORRECT-MIN. IF1364.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1364.2 +009100 02 CORRECTMI-X. IF1364.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1364.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1364.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1364.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1364.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1364.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1364.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1364.2 +009900 04 FILLER PIC X. IF1364.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1364.2 +010200 01 TEST-CORRECT-MAX. IF1364.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1364.2 +010500 02 CORRECTMA-X. IF1364.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1364.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1364.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1364.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1364.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1364.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1364.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1364.2 +011300 04 FILLER PIC X. IF1364.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1364.2 +011600 01 CCVS-C-1. IF1364.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1364.2 +011800- "SS PARAGRAPH-NAME IF1364.2 +011900- " REMARKS". IF1364.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1364.2 +012100 01 CCVS-C-2. IF1364.2 +012200 02 FILLER PIC X VALUE SPACE. IF1364.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1364.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1364.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1364.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1364.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1364.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1364.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1364.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1364.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1364.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1364.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1364.2 +013800 01 CCVS-H-1. IF1364.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1364.2 +014000 02 FILLER PIC X(42) VALUE IF1364.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1364.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1364.2 +014300 01 CCVS-H-2A. IF1364.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1364.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1364.2 +014600 02 FILLER PIC XXXX VALUE IF1364.2 +014700 "4.2 ". IF1364.2 +014800 02 FILLER PIC X(28) VALUE IF1364.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1364.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1364.2 +015100 IF1364.2 +015200 01 CCVS-H-2B. IF1364.2 +015300 02 FILLER PIC X(15) VALUE IF1364.2 +015400 "TEST RESULT OF ". IF1364.2 +015500 02 TEST-ID PIC X(9). IF1364.2 +015600 02 FILLER PIC X(4) VALUE IF1364.2 +015700 " IN ". IF1364.2 +015800 02 FILLER PIC X(12) VALUE IF1364.2 +015900 " HIGH ". IF1364.2 +016000 02 FILLER PIC X(22) VALUE IF1364.2 +016100 " LEVEL VALIDATION FOR ". IF1364.2 +016200 02 FILLER PIC X(58) VALUE IF1364.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1364.2 +016400 01 CCVS-H-3. IF1364.2 +016500 02 FILLER PIC X(34) VALUE IF1364.2 +016600 " FOR OFFICIAL USE ONLY ". IF1364.2 +016700 02 FILLER PIC X(58) VALUE IF1364.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1364.2 +016900 02 FILLER PIC X(28) VALUE IF1364.2 +017000 " COPYRIGHT 1985 ". IF1364.2 +017100 01 CCVS-E-1. IF1364.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1364.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1364.2 +017400 02 ID-AGAIN PIC X(9). IF1364.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1364.2 +017600 01 CCVS-E-2. IF1364.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1364.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1364.2 +017900 02 CCVS-E-2-2. IF1364.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1364.2 +018100 03 FILLER PIC X VALUE SPACE. IF1364.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1364.2 +018300 "ERRORS ENCOUNTERED". IF1364.2 +018400 01 CCVS-E-3. IF1364.2 +018500 02 FILLER PIC X(22) VALUE IF1364.2 +018600 " FOR OFFICIAL USE ONLY". IF1364.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1364.2 +018800 02 FILLER PIC X(58) VALUE IF1364.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1364.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1364.2 +019100 02 FILLER PIC X(15) VALUE IF1364.2 +019200 " COPYRIGHT 1985". IF1364.2 +019300 01 CCVS-E-4. IF1364.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1364.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1364.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1364.2 +019700 02 FILLER PIC X(40) VALUE IF1364.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1364.2 +019900 01 XXINFO. IF1364.2 +020000 02 FILLER PIC X(19) VALUE IF1364.2 +020100 "*** INFORMATION ***". IF1364.2 +020200 02 INFO-TEXT. IF1364.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1364.2 +020400 04 XXCOMPUTED PIC X(20). IF1364.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1364.2 +020600 04 XXCORRECT PIC X(20). IF1364.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1364.2 +020800 01 HYPHEN-LINE. IF1364.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1364.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1364.2 +021100- "*****************************************". IF1364.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1364.2 +021300- "******************************". IF1364.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1364.2 +021500 "IF136A". IF1364.2 +021600 PROCEDURE DIVISION. IF1364.2 +021700 CCVS1 SECTION. IF1364.2 +021800 OPEN-FILES. IF1364.2 +021900 OPEN OUTPUT PRINT-FILE. IF1364.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1364.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1364.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1364.2 +022300 GO TO CCVS1-EXIT. IF1364.2 +022400 CLOSE-FILES. IF1364.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1364.2 +022600 TERMINATE-CCVS. IF1364.2 +022700 STOP RUN. IF1364.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1364.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1364.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1364.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1364.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1364.2 +023300 PRINT-DETAIL. IF1364.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1364.2 +023500 MOVE "." TO PARDOT-X IF1364.2 +023600 MOVE REC-CT TO DOTVALUE. IF1364.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1364.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1364.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1364.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1364.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1364.2 +024200 MOVE SPACE TO CORRECT-X. IF1364.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1364.2 +024400 MOVE SPACE TO RE-MARK. IF1364.2 +024500 HEAD-ROUTINE. IF1364.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1364.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1364.2 +025000 COLUMN-NAMES-ROUTINE. IF1364.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +025400 END-ROUTINE. IF1364.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1364.2 +025600 END-RTN-EXIT. IF1364.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +025800 END-ROUTINE-1. IF1364.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1364.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1364.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1364.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1364.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1364.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1364.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1364.2 +026600 END-ROUTINE-12. IF1364.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1364.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1364.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1364.2 +027000 ELSE IF1364.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1364.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1364.2 +027300 PERFORM WRITE-LINE. IF1364.2 +027400 END-ROUTINE-13. IF1364.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1364.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1364.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1364.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1364.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1364.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1364.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1364.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1364.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028600 WRITE-LINE. IF1364.2 +028700 ADD 1 TO RECORD-COUNT. IF1364.2 +028800Y IF RECORD-COUNT GREATER 42 IF1364.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1364.2 +029000Y MOVE SPACE TO DUMMY-RECORD IF1364.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1364.2 +029200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1364.2 +029300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1364.2 +029400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1364.2 +029500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1364.2 +029600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1364.2 +030000Y MOVE ZERO TO RECORD-COUNT. IF1364.2 +030100 PERFORM WRT-LN. IF1364.2 +030200 WRT-LN. IF1364.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1364.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1364.2 +030500 BLANK-LINE-PRINT. IF1364.2 +030600 PERFORM WRT-LN. IF1364.2 +030700 FAIL-ROUTINE. IF1364.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1364.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1364.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1364.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1364.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1364.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1364.2 +031500 GO TO FAIL-ROUTINE-EX. IF1364.2 +031600 FAIL-ROUTINE-WRITE. IF1364.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1364.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1364.2 +031900 CORMA-ANSI-REFERENCE. IF1364.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1364.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1364.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1364.2 +032300 ELSE IF1364.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1364.2 +032500 PERFORM WRITE-LINE. IF1364.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1364.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1364.2 +032800 BAIL-OUT. IF1364.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1364.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1364.2 +033100 BAIL-OUT-WRITE. IF1364.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1364.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1364.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1364.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1364.2 +033700 BAIL-OUT-EX. EXIT. IF1364.2 +033800 CCVS1-EXIT. IF1364.2 +033900 EXIT. IF1364.2 +034000******************************************************** IF1364.2 +034100* * IF1364.2 +034200* Intrinsic Function Tests IF136A - SQRT * IF1364.2 +034300* * IF1364.2 +034400******************************************************** IF1364.2 +034500 SECT-IF136A SECTION. IF1364.2 +034600 F-SQRT-INFO. IF1364.2 +034700 MOVE "See ref. A-69 2.40" TO ANSI-REFERENCE. IF1364.2 +034800 MOVE "SQRT Function" TO FEATURE. IF1364.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1364.2 +035000 F-SQRT-01. IF1364.2 +035100 MOVE ZERO TO WS-NUM. IF1364.2 +035200 MOVE 0.000000 TO MIN-RANGE. IF1364.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1364.2 +035400 F-SQRT-TEST-01. IF1364.2 +035500 COMPUTE WS-NUM = FUNCTION SQRT(0). IF1364.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +035800 PERFORM PASS IF1364.2 +035900 ELSE IF1364.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1364.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +036300 PERFORM FAIL. IF1364.2 +036400 GO TO F-SQRT-WRITE-01. IF1364.2 +036500 F-SQRT-DELETE-01. IF1364.2 +036600 PERFORM DE-LETE. IF1364.2 +036700 GO TO F-SQRT-WRITE-01. IF1364.2 +036800 F-SQRT-WRITE-01. IF1364.2 +036900 MOVE "F-SQRT-01" TO PAR-NAME. IF1364.2 +037000 PERFORM PRINT-DETAIL. IF1364.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1364.2 +037200 F-SQRT-02. IF1364.2 +037300 EVALUATE FUNCTION SQRT(1) IF1364.2 +037400 WHEN 0.999980 THRU 1.00002 IF1364.2 +037500 PERFORM PASS IF1364.2 +037600 WHEN OTHER IF1364.2 +037700 PERFORM FAIL. IF1364.2 +037800 GO TO F-SQRT-WRITE-02. IF1364.2 +037900 F-SQRT-DELETE-02. IF1364.2 +038000 PERFORM DE-LETE. IF1364.2 +038100 GO TO F-SQRT-WRITE-02. IF1364.2 +038200 F-SQRT-WRITE-02. IF1364.2 +038300 MOVE "F-SQRT-02" TO PAR-NAME. IF1364.2 +038400 PERFORM PRINT-DETAIL. IF1364.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1364.2 +038600 F-SQRT-03. IF1364.2 +038700 MOVE 1.99996 TO MIN-RANGE. IF1364.2 +038800 MOVE 2.00004 TO MAX-RANGE. IF1364.2 +038900 F-SQRT-TEST-03. IF1364.2 +039000 IF (FUNCTION SQRT(4) >= MIN-RANGE) AND IF1364.2 +039100 (FUNCTION SQRT(4) <= MAX-RANGE) THEN IF1364.2 +039200 PERFORM PASS IF1364.2 +039300 ELSE IF1364.2 +039400 PERFORM FAIL. IF1364.2 +039500 GO TO F-SQRT-WRITE-03. IF1364.2 +039600 F-SQRT-DELETE-03. IF1364.2 +039700 PERFORM DE-LETE. IF1364.2 +039800 GO TO F-SQRT-WRITE-03. IF1364.2 +039900 F-SQRT-WRITE-03. IF1364.2 +040000 MOVE "F-SQRT-03" TO PAR-NAME. IF1364.2 +040100 PERFORM PRINT-DETAIL. IF1364.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1364.2 +040300 F-SQRT-04. IF1364.2 +040400 MOVE ZERO TO WS-NUM. IF1364.2 +040500 MOVE 0.031621 TO MIN-RANGE. IF1364.2 +040600 MOVE 0.031623 TO MAX-RANGE. IF1364.2 +040700 F-SQRT-TEST-04. IF1364.2 +040800 COMPUTE WS-NUM = FUNCTION SQRT(.001). IF1364.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +041100 PERFORM PASS IF1364.2 +041200 ELSE IF1364.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +041600 PERFORM FAIL. IF1364.2 +041700 GO TO F-SQRT-WRITE-04. IF1364.2 +041800 F-SQRT-DELETE-04. IF1364.2 +041900 PERFORM DE-LETE. IF1364.2 +042000 GO TO F-SQRT-WRITE-04. IF1364.2 +042100 F-SQRT-WRITE-04. IF1364.2 +042200 MOVE "F-SQRT-04" TO PAR-NAME. IF1364.2 +042300 PERFORM PRINT-DETAIL. IF1364.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1364.2 +042500 F-SQRT-05. IF1364.2 +042600 MOVE ZERO TO WS-NUM. IF1364.2 +042700 MOVE 0.999479 TO MIN-RANGE. IF1364.2 +042800 MOVE 0.999519 TO MAX-RANGE. IF1364.2 +042900 F-SQRT-TEST-05. IF1364.2 +043000 COMPUTE WS-NUM = FUNCTION SQRT(.999). IF1364.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +043300 PERFORM PASS IF1364.2 +043400 ELSE IF1364.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +043800 PERFORM FAIL. IF1364.2 +043900 GO TO F-SQRT-WRITE-05. IF1364.2 +044000 F-SQRT-DELETE-05. IF1364.2 +044100 PERFORM DE-LETE. IF1364.2 +044200 GO TO F-SQRT-WRITE-05. IF1364.2 +044300 F-SQRT-WRITE-05. IF1364.2 +044400 MOVE "F-SQRT-05" TO PAR-NAME. IF1364.2 +044500 PERFORM PRINT-DETAIL. IF1364.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1364.2 +044700 F-SQRT-06. IF1364.2 +044800 MOVE ZERO TO WS-NUM. IF1364.2 +044900 MOVE 2.00246 TO MIN-RANGE. IF1364.2 +045000 MOVE 2.00254 TO MAX-RANGE. IF1364.2 +045100 F-SQRT-TEST-06. IF1364.2 +045200 COMPUTE WS-NUM = FUNCTION SQRT(4.01). IF1364.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +045500 PERFORM PASS IF1364.2 +045600 ELSE IF1364.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +046000 PERFORM FAIL. IF1364.2 +046100 GO TO F-SQRT-WRITE-06. IF1364.2 +046200 F-SQRT-DELETE-06. IF1364.2 +046300 PERFORM DE-LETE. IF1364.2 +046400 GO TO F-SQRT-WRITE-06. IF1364.2 +046500 F-SQRT-WRITE-06. IF1364.2 +046600 MOVE "F-SQRT-06" TO PAR-NAME. IF1364.2 +046700 PERFORM PRINT-DETAIL. IF1364.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1364.2 +046900 F-SQRT-07. IF1364.2 +047000 MOVE ZERO TO WS-NUM. IF1364.2 +047100 MOVE 177.224 TO MIN-RANGE. IF1364.2 +047200 MOVE 177.231 TO MAX-RANGE. IF1364.2 +047300 F-SQRT-TEST-07. IF1364.2 +047400 COMPUTE WS-NUM = FUNCTION SQRT(31409.84). IF1364.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +047700 PERFORM PASS IF1364.2 +047800 ELSE IF1364.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +048200 PERFORM FAIL. IF1364.2 +048300 GO TO F-SQRT-WRITE-07. IF1364.2 +048400 F-SQRT-DELETE-07. IF1364.2 +048500 PERFORM DE-LETE. IF1364.2 +048600 GO TO F-SQRT-WRITE-07. IF1364.2 +048700 F-SQRT-WRITE-07. IF1364.2 +048800 MOVE "F-SQRT-07" TO PAR-NAME. IF1364.2 +048900 PERFORM PRINT-DETAIL. IF1364.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1364.2 +049100 F-SQRT-08. IF1364.2 +049200 MOVE ZERO TO WS-NUM. IF1364.2 +049300 MOVE 927.342 TO MIN-RANGE. IF1364.2 +049400 MOVE 927.379 TO MAX-RANGE. IF1364.2 +049500 F-SQRT-TEST-08. IF1364.2 +049600 COMPUTE WS-NUM = FUNCTION SQRT(860000). IF1364.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +049900 PERFORM PASS IF1364.2 +050000 ELSE IF1364.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +050400 PERFORM FAIL. IF1364.2 +050500 GO TO F-SQRT-WRITE-08. IF1364.2 +050600 F-SQRT-DELETE-08. IF1364.2 +050700 PERFORM DE-LETE. IF1364.2 +050800 GO TO F-SQRT-WRITE-08. IF1364.2 +050900 F-SQRT-WRITE-08. IF1364.2 +051000 MOVE "F-SQRT-08" TO PAR-NAME. IF1364.2 +051100 PERFORM PRINT-DETAIL. IF1364.2 +051200*****************TEST (i) - SIMPLE TEST***************** IF1364.2 +051300 F-SQRT-09. IF1364.2 +051400 MOVE ZERO TO WS-NUM. IF1364.2 +051500 MOVE 0.0094866 TO MIN-RANGE. IF1364.2 +051600 MOVE 0.0094870 TO MAX-RANGE. IF1364.2 +051700 F-SQRT-TEST-09. IF1364.2 +051800 COMPUTE WS-NUM = FUNCTION SQRT(.00009). IF1364.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +052100 PERFORM PASS IF1364.2 +052200 ELSE IF1364.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +052600 PERFORM FAIL. IF1364.2 +052700 GO TO F-SQRT-WRITE-09. IF1364.2 +052800 F-SQRT-DELETE-09. IF1364.2 +052900 PERFORM DE-LETE. IF1364.2 +053000 GO TO F-SQRT-WRITE-09. IF1364.2 +053100 F-SQRT-WRITE-09. IF1364.2 +053200 MOVE "F-SQRT-09" TO PAR-NAME. IF1364.2 +053300 PERFORM PRINT-DETAIL. IF1364.2 +053400*****************TEST (j) - SIMPLE TEST***************** IF1364.2 +053500 F-SQRT-10. IF1364.2 +053600 MOVE ZERO TO WS-NUM. IF1364.2 +053700 MOVE 118.320 TO MIN-RANGE. IF1364.2 +053800 MOVE 118.324 TO MAX-RANGE. IF1364.2 +053900 F-SQRT-TEST-10. IF1364.2 +054000 COMPUTE WS-NUM = FUNCTION SQRT(B). IF1364.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +054300 PERFORM PASS IF1364.2 +054400 ELSE IF1364.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +054800 PERFORM FAIL. IF1364.2 +054900 GO TO F-SQRT-WRITE-10. IF1364.2 +055000 F-SQRT-DELETE-10. IF1364.2 +055100 PERFORM DE-LETE. IF1364.2 +055200 GO TO F-SQRT-WRITE-10. IF1364.2 +055300 F-SQRT-WRITE-10. IF1364.2 +055400 MOVE "F-SQRT-10" TO PAR-NAME. IF1364.2 +055500 PERFORM PRINT-DETAIL. IF1364.2 +055600*****************TEST (k) - SIMPLE TEST***************** IF1364.2 +055700 F-SQRT-11. IF1364.2 +055800 MOVE ZERO TO WS-NUM. IF1364.2 +055900 MOVE 316.222 TO MIN-RANGE. IF1364.2 +056000 MOVE 316.234 TO MAX-RANGE. IF1364.2 +056100 F-SQRT-TEST-11. IF1364.2 +056200 COMPUTE WS-NUM = FUNCTION SQRT(C). IF1364.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +056500 PERFORM PASS IF1364.2 +056600 ELSE IF1364.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +057000 PERFORM FAIL. IF1364.2 +057100 GO TO F-SQRT-WRITE-11. IF1364.2 +057200 F-SQRT-DELETE-11. IF1364.2 +057300 PERFORM DE-LETE. IF1364.2 +057400 GO TO F-SQRT-WRITE-11. IF1364.2 +057500 F-SQRT-WRITE-11. IF1364.2 +057600 MOVE "F-SQRT-11" TO PAR-NAME. IF1364.2 +057700 PERFORM PRINT-DETAIL. IF1364.2 +057800*****************TEST (l) - SIMPLE TEST***************** IF1364.2 +057900 F-SQRT-12. IF1364.2 +058000 MOVE ZERO TO WS-NUM. IF1364.2 +058100 MOVE 0.0063244 TO MIN-RANGE. IF1364.2 +058200 MOVE 0.0063246 TO MAX-RANGE. IF1364.2 +058300 F-SQRT-TEST-12. IF1364.2 +058400 COMPUTE WS-NUM = FUNCTION SQRT(A). IF1364.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +058700 PERFORM PASS IF1364.2 +058800 ELSE IF1364.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +059200 PERFORM FAIL. IF1364.2 +059300 GO TO F-SQRT-WRITE-12. IF1364.2 +059400 F-SQRT-DELETE-12. IF1364.2 +059500 PERFORM DE-LETE. IF1364.2 +059600 GO TO F-SQRT-WRITE-12. IF1364.2 +059700 F-SQRT-WRITE-12. IF1364.2 +059800 MOVE "F-SQRT-12" TO PAR-NAME. IF1364.2 +059900 PERFORM PRINT-DETAIL. IF1364.2 +060000*****************TEST (m) - SIMPLE TEST***************** IF1364.2 +060100 F-SQRT-13. IF1364.2 +060200 MOVE ZERO TO WS-NUM. IF1364.2 +060300 MOVE 1.99996 TO MIN-RANGE. IF1364.2 +060400 MOVE 2.00004 TO MAX-RANGE. IF1364.2 +060500 F-SQRT-TEST-13. IF1364.2 +060600 COMPUTE WS-NUM = FUNCTION SQRT(IND(P)). IF1364.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +060900 PERFORM PASS IF1364.2 +061000 ELSE IF1364.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +061400 PERFORM FAIL. IF1364.2 +061500 GO TO F-SQRT-WRITE-13. IF1364.2 +061600 F-SQRT-DELETE-13. IF1364.2 +061700 PERFORM DE-LETE. IF1364.2 +061800 GO TO F-SQRT-WRITE-13. IF1364.2 +061900 F-SQRT-WRITE-13. IF1364.2 +062000 MOVE "F-SQRT-13" TO PAR-NAME. IF1364.2 +062100 PERFORM PRINT-DETAIL. IF1364.2 +062200*****************TEST (n) - SIMPLE TEST***************** IF1364.2 +062300 F-SQRT-14. IF1364.2 +062400 MOVE ZERO TO WS-NUM. IF1364.2 +062500 MOVE 2.23601 TO MIN-RANGE. IF1364.2 +062600 MOVE 2.23610 TO MAX-RANGE. IF1364.2 +062700 F-SQRT-TEST-14. IF1364.2 +062800 COMPUTE WS-NUM = FUNCTION SQRT(IND(3)). IF1364.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +063100 PERFORM PASS IF1364.2 +063200 ELSE IF1364.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +063600 PERFORM FAIL. IF1364.2 +063700 GO TO F-SQRT-WRITE-14. IF1364.2 +063800 F-SQRT-DELETE-14. IF1364.2 +063900 PERFORM DE-LETE. IF1364.2 +064000 GO TO F-SQRT-WRITE-14. IF1364.2 +064100 F-SQRT-WRITE-14. IF1364.2 +064200 MOVE "F-SQRT-14" TO PAR-NAME. IF1364.2 +064300 PERFORM PRINT-DETAIL. IF1364.2 +064400*****************TEST (a) - COMPLEX TEST**************** IF1364.2 +064500 F-SQRT-15. IF1364.2 +064600 MOVE ZERO TO WS-NUM. IF1364.2 +064700 MOVE 0.316214 TO MIN-RANGE. IF1364.2 +064800 MOVE 0.316240 TO MAX-RANGE. IF1364.2 +064900 F-SQRT-TEST-15. IF1364.2 +065000 COMPUTE WS-NUM = FUNCTION SQRT(9 - 8.9). IF1364.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +065300 PERFORM PASS IF1364.2 +065400 ELSE IF1364.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +065800 PERFORM FAIL. IF1364.2 +065900 GO TO F-SQRT-WRITE-15. IF1364.2 +066000 F-SQRT-DELETE-15. IF1364.2 +066100 PERFORM DE-LETE. IF1364.2 +066200 GO TO F-SQRT-WRITE-15. IF1364.2 +066300 F-SQRT-WRITE-15. IF1364.2 +066400 MOVE "F-SQRT-15" TO PAR-NAME. IF1364.2 +066500 PERFORM PRINT-DETAIL. IF1364.2 +066600*****************TEST (b) - COMPLEX TEST**************** IF1364.2 +066700 F-SQRT-16. IF1364.2 +066800 MOVE ZERO TO WS-NUM. IF1364.2 +066900 MOVE 1.95172 TO MIN-RANGE. IF1364.2 +067000 MOVE 1.95188 TO MAX-RANGE. IF1364.2 +067100 F-SQRT-TEST-16. IF1364.2 +067200 COMPUTE WS-NUM = FUNCTION SQRT(8 / 2.1). IF1364.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +067500 PERFORM PASS IF1364.2 +067600 ELSE IF1364.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +068000 PERFORM FAIL. IF1364.2 +068100 GO TO F-SQRT-WRITE-16. IF1364.2 +068200 F-SQRT-DELETE-16. IF1364.2 +068300 PERFORM DE-LETE. IF1364.2 +068400 GO TO F-SQRT-WRITE-16. IF1364.2 +068500 F-SQRT-WRITE-16. IF1364.2 +068600 MOVE "F-SQRT-16" TO PAR-NAME. IF1364.2 +068700 PERFORM PRINT-DETAIL. IF1364.2 +068800*****************TEST (c) - COMPLEX TEST**************** IF1364.2 +068900 F-SQRT-17. IF1364.2 +069000 MOVE ZERO TO WS-NUM. IF1364.2 +069100 MOVE 17.7475 TO MIN-RANGE. IF1364.2 +069200 MOVE 17.7489 TO MAX-RANGE. IF1364.2 +069300 F-SQRT-TEST-17. IF1364.2 +069400 COMPUTE WS-NUM = FUNCTION SQRT(35 * 9). IF1364.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +069700 PERFORM PASS IF1364.2 +069800 ELSE IF1364.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +070200 PERFORM FAIL. IF1364.2 +070300 GO TO F-SQRT-WRITE-17. IF1364.2 +070400 F-SQRT-DELETE-17. IF1364.2 +070500 PERFORM DE-LETE. IF1364.2 +070600 GO TO F-SQRT-WRITE-17. IF1364.2 +070700 F-SQRT-WRITE-17. IF1364.2 +070800 MOVE "F-SQRT-17" TO PAR-NAME. IF1364.2 +070900 PERFORM PRINT-DETAIL. IF1364.2 +071000*****************TEST (d) - COMPLEX TEST**************** IF1364.2 +071100 F-SQRT-18. IF1364.2 +071200 MOVE ZERO TO WS-NUM. IF1364.2 +071300 MOVE 1.13384 TO MIN-RANGE. IF1364.2 +071400 MOVE 1.13393 TO MAX-RANGE. IF1364.2 +071500 F-SQRT-TEST-18. IF1364.2 +071600 COMPUTE WS-NUM = FUNCTION SQRT(9 / 7). IF1364.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +071900 PERFORM PASS IF1364.2 +072000 ELSE IF1364.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +072400 PERFORM FAIL. IF1364.2 +072500 GO TO F-SQRT-WRITE-18. IF1364.2 +072600 F-SQRT-DELETE-18. IF1364.2 +072700 PERFORM DE-LETE. IF1364.2 +072800 GO TO F-SQRT-WRITE-18. IF1364.2 +072900 F-SQRT-WRITE-18. IF1364.2 +073000 MOVE "F-SQRT-18" TO PAR-NAME. IF1364.2 +073100 PERFORM PRINT-DETAIL. IF1364.2 +073200*****************TEST (e) - COMPLEX TEST**************** IF1364.2 +073300 F-SQRT-19. IF1364.2 +073400 MOVE ZERO TO WS-NUM. IF1364.2 +073500 MOVE 3.60541 TO MIN-RANGE. IF1364.2 +073600 MOVE 3.60569 TO MAX-RANGE. IF1364.2 +073700 F-SQRT-TEST-19. IF1364.2 +073800 COMPUTE WS-NUM = FUNCTION SQRT(E + F). IF1364.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +074100 PERFORM PASS IF1364.2 +074200 ELSE IF1364.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +074600 PERFORM FAIL. IF1364.2 +074700 GO TO F-SQRT-WRITE-19. IF1364.2 +074800 F-SQRT-DELETE-19. IF1364.2 +074900 PERFORM DE-LETE. IF1364.2 +075000 GO TO F-SQRT-WRITE-19. IF1364.2 +075100 F-SQRT-WRITE-19. IF1364.2 +075200 MOVE "F-SQRT-19" TO PAR-NAME. IF1364.2 +075300 PERFORM PRINT-DETAIL. IF1364.2 +075400*****************TEST (f) - COMPLEX TEST**************** IF1364.2 +075500 F-SQRT-20. IF1364.2 +075600 MOVE ZERO TO WS-NUM. IF1364.2 +075700 MOVE 11.9517 TO MIN-RANGE. IF1364.2 +075800 MOVE 11.9527 TO MAX-RANGE. IF1364.2 +075900 F-SQRT-TEST-20. IF1364.2 +076000 COMPUTE WS-NUM = FUNCTION SQRT(D / E). IF1364.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +076300 PERFORM PASS IF1364.2 +076400 ELSE IF1364.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +076800 PERFORM FAIL. IF1364.2 +076900 GO TO F-SQRT-WRITE-20. IF1364.2 +077000 F-SQRT-DELETE-20. IF1364.2 +077100 PERFORM DE-LETE. IF1364.2 +077200 GO TO F-SQRT-WRITE-20. IF1364.2 +077300 F-SQRT-WRITE-20. IF1364.2 +077400 MOVE "F-SQRT-20" TO PAR-NAME. IF1364.2 +077500 PERFORM PRINT-DETAIL. IF1364.2 +077600*****************TEST (g) - COMPLEX TEST**************** IF1364.2 +077700 F-SQRT-21. IF1364.2 +077800 MOVE ZERO TO WS-NUM. IF1364.2 +077900 MOVE 1.73198 TO MIN-RANGE. IF1364.2 +078000 MOVE 1.73212 TO MAX-RANGE. IF1364.2 +078100 F-SQRT-TEST-21. IF1364.2 +078200 COMPUTE WS-NUM = FUNCTION SQRT(F - 3). IF1364.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +078500 PERFORM PASS IF1364.2 +078600 ELSE IF1364.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +079000 PERFORM FAIL. IF1364.2 +079100 GO TO F-SQRT-WRITE-21. IF1364.2 +079200 F-SQRT-DELETE-21. IF1364.2 +079300 PERFORM DE-LETE. IF1364.2 +079400 GO TO F-SQRT-WRITE-21. IF1364.2 +079500 F-SQRT-WRITE-21. IF1364.2 +079600 MOVE "F-SQRT-21" TO PAR-NAME. IF1364.2 +079700 PERFORM PRINT-DETAIL. IF1364.2 +079800*****************TEST (h) - COMPLEX TEST**************** IF1364.2 +079900 F-SQRT-22. IF1364.2 +080000 MOVE ZERO TO WS-NUM. IF1364.2 +080100 MOVE 4.01232 TO MIN-RANGE. IF1364.2 +080200 MOVE 4.01264 TO MAX-RANGE. IF1364.2 +080300 F-SQRT-TEST-22. IF1364.2 +080400 COMPUTE WS-NUM = FUNCTION SQRT(E * 2.3). IF1364.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +080700 PERFORM PASS IF1364.2 +080800 ELSE IF1364.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +081200 PERFORM FAIL. IF1364.2 +081300 GO TO F-SQRT-WRITE-22. IF1364.2 +081400 F-SQRT-DELETE-22. IF1364.2 +081500 PERFORM DE-LETE. IF1364.2 +081600 GO TO F-SQRT-WRITE-22. IF1364.2 +081700 F-SQRT-WRITE-22. IF1364.2 +081800 MOVE "F-SQRT-22" TO PAR-NAME. IF1364.2 +081900 PERFORM PRINT-DETAIL. IF1364.2 +082000*****************TEST (i) - COMPLEX TEST**************** IF1364.2 +082100 F-SQRT-23. IF1364.2 +082200 MOVE ZERO TO WS-NUM. IF1364.2 +082300 MOVE 1.56502 TO MIN-RANGE. IF1364.2 +082400 MOVE 1.56514 TO MAX-RANGE. IF1364.2 +082500 F-SQRT-TEST-23. IF1364.2 +082600 COMPUTE WS-NUM = FUNCTION SQRT(FUNCTION SQRT(F)). IF1364.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +082900 PERFORM PASS IF1364.2 +083000 ELSE IF1364.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +083400 PERFORM FAIL. IF1364.2 +083500 GO TO F-SQRT-WRITE-23. IF1364.2 +083600 F-SQRT-DELETE-23. IF1364.2 +083700 PERFORM DE-LETE. IF1364.2 +083800 GO TO F-SQRT-WRITE-23. IF1364.2 +083900 F-SQRT-WRITE-23. IF1364.2 +084000 MOVE "F-SQRT-23" TO PAR-NAME. IF1364.2 +084100 PERFORM PRINT-DETAIL. IF1364.2 +084200*****************TEST (j) - COMPLEX TEST**************** IF1364.2 +084300 F-SQRT-24. IF1364.2 +084400 MOVE ZERO TO WS-NUM. IF1364.2 +084500 MOVE 4.87309 TO MIN-RANGE. IF1364.2 +084600 MOVE 4.87348 TO MAX-RANGE. IF1364.2 +084700 F-SQRT-TEST-24. IF1364.2 +084800 COMPUTE WS-NUM = FUNCTION SQRT(6.5) + IF1364.2 +084900 FUNCTION SQRT(5.4). IF1364.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +085200 PERFORM PASS IF1364.2 +085300 ELSE IF1364.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1364.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +085700 PERFORM FAIL. IF1364.2 +085800 GO TO F-SQRT-WRITE-24. IF1364.2 +085900 F-SQRT-DELETE-24. IF1364.2 +086000 PERFORM DE-LETE. IF1364.2 +086100 GO TO F-SQRT-WRITE-24. IF1364.2 +086200 F-SQRT-WRITE-24. IF1364.2 +086300 MOVE "F-SQRT-24" TO PAR-NAME. IF1364.2 +086400 PERFORM PRINT-DETAIL. IF1364.2 +086500*****************TEST (k) - COMPLEX TEST**************** IF1364.2 +086600 F-SQRT-25. IF1364.2 +086700 MOVE ZERO TO WS-NUM. IF1364.2 +086800 MOVE 9.99960 TO MIN-RANGE. IF1364.2 +086900 MOVE 10.0004 TO MAX-RANGE. IF1364.2 +087000 F-SQRT-TEST-25. IF1364.2 +087100 COMPUTE WS-NUM = FUNCTION SQRT(10) ** 2. IF1364.2 +087200 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +087300 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +087400 PERFORM PASS IF1364.2 +087500 ELSE IF1364.2 +087600 MOVE WS-NUM TO COMPUTED-N IF1364.2 +087700 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +087800 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +087900 PERFORM FAIL. IF1364.2 +088000 GO TO F-SQRT-WRITE-25. IF1364.2 +088100 F-SQRT-DELETE-25. IF1364.2 +088200 PERFORM DE-LETE. IF1364.2 +088300 GO TO F-SQRT-WRITE-25. IF1364.2 +088400 F-SQRT-WRITE-25. IF1364.2 +088500 MOVE "F-SQRT-25" TO PAR-NAME. IF1364.2 +088600 PERFORM PRINT-DETAIL. IF1364.2 +088700*****************SPECIAL PERFORM TEST********************** IF1364.2 +088800 F-SQRT-26. IF1364.2 +088900 PERFORM F-SQRT-TEST-26 IF1364.2 +089000 UNTIL FUNCTION SQRT(ARG1) < 2.0. IF1364.2 +089100 PERFORM PASS. IF1364.2 +089200 GO TO F-SQRT-WRITE-26. IF1364.2 +089300 F-SQRT-TEST-26. IF1364.2 +089400 COMPUTE ARG1 = ARG1 - 1. IF1364.2 +089500 F-SQRT-DELETE-26. IF1364.2 +089600 PERFORM DE-LETE. IF1364.2 +089700 GO TO F-SQRT-WRITE-26. IF1364.2 +089800 F-SQRT-WRITE-26. IF1364.2 +089900 MOVE "F-SQRT-26" TO PAR-NAME. IF1364.2 +090000 PERFORM PRINT-DETAIL. IF1364.2 +090100********************END OF TESTS*************** IF1364.2 +090200 CCVS-EXIT SECTION. IF1364.2 +090300 CCVS-999999. IF1364.2 +090400 GO TO CLOSE-FILES. IF1364.2 +*END-OF,IF136A +*HEADER,COBOL,IF137A +000100 IDENTIFICATION DIVISION. IF1374.2 +000200 PROGRAM-ID. IF1374.2 +000300 IF137A. IF1374.2 +000400 IF1374.2 +000500*********************************************************** IF1374.2 +000600* * IF1374.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1374.2 +000800* It contains tests for the Intrinsic Function * IF1374.2 +000900* STANDARD-DEVIATION. * IF1374.2 +001000* * IF1374.2 +001100*********************************************************** IF1374.2 +001200 ENVIRONMENT DIVISION. IF1374.2 +001300 CONFIGURATION SECTION. IF1374.2 +001400 SOURCE-COMPUTER. IF1374.2 +001500 XXXXX082. IF1374.2 +001600 OBJECT-COMPUTER. IF1374.2 +001700 XXXXX083. IF1374.2 +001800 INPUT-OUTPUT SECTION. IF1374.2 +001900 FILE-CONTROL. IF1374.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1374.2 +002100 XXXXX055. IF1374.2 +002200 DATA DIVISION. IF1374.2 +002300 FILE SECTION. IF1374.2 +002400 FD PRINT-FILE. IF1374.2 +002500 01 PRINT-REC PICTURE X(120). IF1374.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1374.2 +002700 WORKING-STORAGE SECTION. IF1374.2 +002800*********************************************************** IF1374.2 +002900* Variables specific to the Intrinsic Function Test IF137A* IF1374.2 +003000*********************************************************** IF1374.2 +003100 01 A PIC S9(10) VALUE 5. IF1374.2 +003200 01 B PIC S9(10) VALUE 7. IF1374.2 +003300 01 C PIC S9(10) VALUE -4. IF1374.2 +003400 01 D PIC S9(10) VALUE 10. IF1374.2 +003500 01 E PIC S9(5)V9(5) VALUE 34.26. IF1374.2 +003600 01 F PIC S9(5)V9(5) VALUE -8.32. IF1374.2 +003700 01 G PIC S9(5)V9(5) VALUE 4.08. IF1374.2 +003800 01 H PIC S9(5)V9(5) VALUE -5.3. IF1374.2 +003900 01 P PIC S9(10) VALUE 4. IF1374.2 +004000 01 Q PIC S9(10) VALUE 3. IF1374.2 +004100 01 R PIC S9(10) VALUE 5. IF1374.2 +004200 01 ARG3 PIC S9(10) VALUE 2. IF1374.2 +004300 01 ARR VALUE "40537". IF1374.2 +004400 02 IND OCCURS 5 TIMES PIC 9. IF1374.2 +004500 01 TEMP PIC S9(10). IF1374.2 +004600 01 WS-NUM PIC S9(5)V9(6). IF1374.2 +004700 01 MIN-RANGE PIC S9(5)V9(7). IF1374.2 +004800 01 MAX-RANGE PIC S9(5)V9(7). IF1374.2 +004900* IF1374.2 +005000********************************************************** IF1374.2 +005100* IF1374.2 +005200 01 TEST-RESULTS. IF1374.2 +005300 02 FILLER PIC X VALUE SPACE. IF1374.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1374.2 +005500 02 FILLER PIC X VALUE SPACE. IF1374.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1374.2 +005700 02 FILLER PIC X VALUE SPACE. IF1374.2 +005800 02 PAR-NAME. IF1374.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1374.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1374.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1374.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1374.2 +006300 02 RE-MARK PIC X(61). IF1374.2 +006400 01 TEST-COMPUTED. IF1374.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +006600 02 FILLER PIC X(17) VALUE IF1374.2 +006700 " COMPUTED=". IF1374.2 +006800 02 COMPUTED-X. IF1374.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1374.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1374.2 +007100 PIC -9(9).9(9). IF1374.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1374.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1374.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1374.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1374.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1374.2 +007700 04 FILLER PIC X. IF1374.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1374.2 +007900 01 TEST-CORRECT. IF1374.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1374.2 +008200 02 CORRECT-X. IF1374.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1374.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1374.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1374.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1374.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1374.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1374.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1374.2 +009000 04 FILLER PIC X. IF1374.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1374.2 +009300 01 TEST-CORRECT-MIN. IF1374.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +009500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1374.2 +009600 02 CORRECTMI-X. IF1374.2 +009700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1374.2 +009800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1374.2 +009900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1374.2 +010000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1374.2 +010100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1374.2 +010200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1374.2 +010300 04 CORRECTMI-18V0 PIC -9(18). IF1374.2 +010400 04 FILLER PIC X. IF1374.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +010600 03 FILLER PIC X(48) VALUE SPACE. IF1374.2 +010700 01 TEST-CORRECT-MAX. IF1374.2 +010800 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +010900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1374.2 +011000 02 CORRECTMA-X. IF1374.2 +011100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1374.2 +011200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1374.2 +011300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1374.2 +011400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1374.2 +011500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1374.2 +011600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1374.2 +011700 04 CORRECTMA-18V0 PIC -9(18). IF1374.2 +011800 04 FILLER PIC X. IF1374.2 +011900 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +012000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1374.2 +012100 01 CCVS-C-1. IF1374.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1374.2 +012300- "SS PARAGRAPH-NAME IF1374.2 +012400- " REMARKS". IF1374.2 +012500 02 FILLER PIC X(20) VALUE SPACE. IF1374.2 +012600 01 CCVS-C-2. IF1374.2 +012700 02 FILLER PIC X VALUE SPACE. IF1374.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". IF1374.2 +012900 02 FILLER PIC X(15) VALUE SPACE. IF1374.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". IF1374.2 +013100 02 FILLER PIC X(94) VALUE SPACE. IF1374.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1374.2 +013300 01 REC-CT PIC 99 VALUE ZERO. IF1374.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1374.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1374.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1374.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1374.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1374.2 +014300 01 CCVS-H-1. IF1374.2 +014400 02 FILLER PIC X(39) VALUE SPACES. IF1374.2 +014500 02 FILLER PIC X(42) VALUE IF1374.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1374.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1374.2 +014800 01 CCVS-H-2A. IF1374.2 +014900 02 FILLER PIC X(40) VALUE SPACE. IF1374.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1374.2 +015100 02 FILLER PIC XXXX VALUE IF1374.2 +015200 "4.2 ". IF1374.2 +015300 02 FILLER PIC X(28) VALUE IF1374.2 +015400 " COPY - NOT FOR DISTRIBUTION". IF1374.2 +015500 02 FILLER PIC X(41) VALUE SPACE. IF1374.2 +015600 IF1374.2 +015700 01 CCVS-H-2B. IF1374.2 +015800 02 FILLER PIC X(15) VALUE IF1374.2 +015900 "TEST RESULT OF ". IF1374.2 +016000 02 TEST-ID PIC X(9). IF1374.2 +016100 02 FILLER PIC X(4) VALUE IF1374.2 +016200 " IN ". IF1374.2 +016300 02 FILLER PIC X(12) VALUE IF1374.2 +016400 " HIGH ". IF1374.2 +016500 02 FILLER PIC X(22) VALUE IF1374.2 +016600 " LEVEL VALIDATION FOR ". IF1374.2 +016700 02 FILLER PIC X(58) VALUE IF1374.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1374.2 +016900 01 CCVS-H-3. IF1374.2 +017000 02 FILLER PIC X(34) VALUE IF1374.2 +017100 " FOR OFFICIAL USE ONLY ". IF1374.2 +017200 02 FILLER PIC X(58) VALUE IF1374.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1374.2 +017400 02 FILLER PIC X(28) VALUE IF1374.2 +017500 " COPYRIGHT 1985 ". IF1374.2 +017600 01 CCVS-E-1. IF1374.2 +017700 02 FILLER PIC X(52) VALUE SPACE. IF1374.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1374.2 +017900 02 ID-AGAIN PIC X(9). IF1374.2 +018000 02 FILLER PIC X(45) VALUE SPACES. IF1374.2 +018100 01 CCVS-E-2. IF1374.2 +018200 02 FILLER PIC X(31) VALUE SPACE. IF1374.2 +018300 02 FILLER PIC X(21) VALUE SPACE. IF1374.2 +018400 02 CCVS-E-2-2. IF1374.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1374.2 +018600 03 FILLER PIC X VALUE SPACE. IF1374.2 +018700 03 ENDER-DESC PIC X(44) VALUE IF1374.2 +018800 "ERRORS ENCOUNTERED". IF1374.2 +018900 01 CCVS-E-3. IF1374.2 +019000 02 FILLER PIC X(22) VALUE IF1374.2 +019100 " FOR OFFICIAL USE ONLY". IF1374.2 +019200 02 FILLER PIC X(12) VALUE SPACE. IF1374.2 +019300 02 FILLER PIC X(58) VALUE IF1374.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1374.2 +019500 02 FILLER PIC X(13) VALUE SPACE. IF1374.2 +019600 02 FILLER PIC X(15) VALUE IF1374.2 +019700 " COPYRIGHT 1985". IF1374.2 +019800 01 CCVS-E-4. IF1374.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1374.2 +020000 02 FILLER PIC X(4) VALUE " OF ". IF1374.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1374.2 +020200 02 FILLER PIC X(40) VALUE IF1374.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1374.2 +020400 01 XXINFO. IF1374.2 +020500 02 FILLER PIC X(19) VALUE IF1374.2 +020600 "*** INFORMATION ***". IF1374.2 +020700 02 INFO-TEXT. IF1374.2 +020800 04 FILLER PIC X(8) VALUE SPACE. IF1374.2 +020900 04 XXCOMPUTED PIC X(20). IF1374.2 +021000 04 FILLER PIC X(5) VALUE SPACE. IF1374.2 +021100 04 XXCORRECT PIC X(20). IF1374.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). IF1374.2 +021300 01 HYPHEN-LINE. IF1374.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. IF1374.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************IF1374.2 +021600- "*****************************************". IF1374.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************IF1374.2 +021800- "******************************". IF1374.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE IF1374.2 +022000 "IF137A". IF1374.2 +022100 PROCEDURE DIVISION. IF1374.2 +022200 CCVS1 SECTION. IF1374.2 +022300 OPEN-FILES. IF1374.2 +022400 OPEN OUTPUT PRINT-FILE. IF1374.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1374.2 +022600 MOVE SPACE TO TEST-RESULTS. IF1374.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1374.2 +022800 GO TO CCVS1-EXIT. IF1374.2 +022900 CLOSE-FILES. IF1374.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1374.2 +023100 TERMINATE-CCVS. IF1374.2 +023200 STOP RUN. IF1374.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1374.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1374.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1374.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1374.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. IF1374.2 +023800 PRINT-DETAIL. IF1374.2 +023900 IF REC-CT NOT EQUAL TO ZERO IF1374.2 +024000 MOVE "." TO PARDOT-X IF1374.2 +024100 MOVE REC-CT TO DOTVALUE. IF1374.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1374.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1374.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1374.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1374.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1374.2 +024700 MOVE SPACE TO CORRECT-X. IF1374.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1374.2 +024900 MOVE SPACE TO RE-MARK. IF1374.2 +025000 HEAD-ROUTINE. IF1374.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1374.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1374.2 +025500 COLUMN-NAMES-ROUTINE. IF1374.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +025900 END-ROUTINE. IF1374.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1374.2 +026100 END-RTN-EXIT. IF1374.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +026300 END-ROUTINE-1. IF1374.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1374.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1374.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. IF1374.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1374.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1374.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1374.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1374.2 +027100 END-ROUTINE-12. IF1374.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1374.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1374.2 +027400 MOVE "NO " TO ERROR-TOTAL IF1374.2 +027500 ELSE IF1374.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1374.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1374.2 +027800 PERFORM WRITE-LINE. IF1374.2 +027900 END-ROUTINE-13. IF1374.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1374.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE IF1374.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1374.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1374.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO IF1374.2 +028600 MOVE "NO " TO ERROR-TOTAL IF1374.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1374.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1374.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +029100 WRITE-LINE. IF1374.2 +029200 ADD 1 TO RECORD-COUNT. IF1374.2 +029300Y IF RECORD-COUNT GREATER 42 IF1374.2 +029400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1374.2 +029500Y MOVE SPACE TO DUMMY-RECORD IF1374.2 +029600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1374.2 +029700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1374.2 +029800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1374.2 +029900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1374.2 +030000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1374.2 +030100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030400Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1374.2 +030500Y MOVE ZERO TO RECORD-COUNT. IF1374.2 +030600 PERFORM WRT-LN. IF1374.2 +030700 WRT-LN. IF1374.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1374.2 +030900 MOVE SPACE TO DUMMY-RECORD. IF1374.2 +031000 BLANK-LINE-PRINT. IF1374.2 +031100 PERFORM WRT-LN. IF1374.2 +031200 FAIL-ROUTINE. IF1374.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE IF1374.2 +031400 GO TO FAIL-ROUTINE-WRITE. IF1374.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1374.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1374.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1374.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1374.2 +032000 GO TO FAIL-ROUTINE-EX. IF1374.2 +032100 FAIL-ROUTINE-WRITE. IF1374.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1374.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1374.2 +032400 CORMA-ANSI-REFERENCE. IF1374.2 +032500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1374.2 +032600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1374.2 +032700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1374.2 +032800 ELSE IF1374.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1374.2 +033000 PERFORM WRITE-LINE. IF1374.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1374.2 +033200 FAIL-ROUTINE-EX. EXIT. IF1374.2 +033300 BAIL-OUT. IF1374.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1374.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1374.2 +033600 BAIL-OUT-WRITE. IF1374.2 +033700 MOVE CORRECT-A TO XXCORRECT. IF1374.2 +033800 MOVE COMPUTED-A TO XXCOMPUTED. IF1374.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1374.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1374.2 +034200 BAIL-OUT-EX. EXIT. IF1374.2 +034300 CCVS1-EXIT. IF1374.2 +034400 EXIT. IF1374.2 +034500******************************************************** IF1374.2 +034600* * IF1374.2 +034700* Intrinsic Function Tests IF137A - STANDARD-DEVIATION * IF1374.2 +034800* * IF1374.2 +034900******************************************************** IF1374.2 +035000 SECT-IF137A SECTION. IF1374.2 +035100 F-STD-DEV-INFO. IF1374.2 +035200 MOVE "See ref. A-70 2.41" TO ANSI-REFERENCE. IF1374.2 +035300 MOVE "STANDARD-DEVIATION" TO FEATURE. IF1374.2 +035400*****************TEST (a) - SIMPLE TEST***************** IF1374.2 +035500 F-STD-DEV-01. IF1374.2 +035600 MOVE ZERO TO WS-NUM. IF1374.2 +035700 MOVE 6.97750 TO MIN-RANGE. IF1374.2 +035800 MOVE 6.97778 TO MAX-RANGE. IF1374.2 +035900 F-STD-DEV-TEST-01. IF1374.2 +036000 COMPUTE WS-NUM = IF1374.2 +036100 FUNCTION STANDARD-DEVIATION(5, -2, -14, 0). IF1374.2 +036200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +036300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +036400 PERFORM PASS IF1374.2 +036500 ELSE IF1374.2 +036600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +036700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +036800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +036900 PERFORM FAIL. IF1374.2 +037000 GO TO F-STD-DEV-WRITE-01. IF1374.2 +037100 F-STD-DEV-DELETE-01. IF1374.2 +037200 PERFORM DE-LETE. IF1374.2 +037300 GO TO F-STD-DEV-WRITE-01. IF1374.2 +037400 F-STD-DEV-WRITE-01. IF1374.2 +037500 MOVE "F-STD-DEV-01" TO PAR-NAME. IF1374.2 +037600 PERFORM PRINT-DETAIL. IF1374.2 +037700*****************TEST (b) - SIMPLE TEST***************** IF1374.2 +037800 F-STD-DEV-02. IF1374.2 +037900 EVALUATE FUNCTION STANDARD-DEVIATION(3.9, -0.3, 8.7, 100.2) IF1374.2 +038000 WHEN 41.7333 THRU 41.7350 IF1374.2 +038100 PERFORM PASS IF1374.2 +038200 WHEN OTHER IF1374.2 +038300 PERFORM FAIL. IF1374.2 +038400 GO TO F-STD-DEV-WRITE-02. IF1374.2 +038500 F-STD-DEV-DELETE-02. IF1374.2 +038600 PERFORM DE-LETE. IF1374.2 +038700 GO TO F-STD-DEV-WRITE-02. IF1374.2 +038800 F-STD-DEV-WRITE-02. IF1374.2 +038900 MOVE "F-STD-DEV-02" TO PAR-NAME. IF1374.2 +039000 PERFORM PRINT-DETAIL. IF1374.2 +039100*****************TEST (c) - SIMPLE TEST***************** IF1374.2 +039200 F-STD-DEV-03. IF1374.2 +039300 MOVE 5.22005 TO MIN-RANGE. IF1374.2 +039400 MOVE 5.22025 TO MAX-RANGE. IF1374.2 +039500 F-STD-DEV-TEST-03. IF1374.2 +039600 IF (FUNCTION STANDARD-DEVIATION(A, B, C, D) IF1374.2 +039700 >= MIN-RANGE) AND IF1374.2 +039800 (FUNCTION STANDARD-DEVIATION(A, B, C, D) IF1374.2 +039900 <= MAX-RANGE) THEN IF1374.2 +040000 PERFORM PASS IF1374.2 +040100 ELSE IF1374.2 +040200 PERFORM FAIL. IF1374.2 +040300 GO TO F-STD-DEV-WRITE-03. IF1374.2 +040400 F-STD-DEV-DELETE-03. IF1374.2 +040500 PERFORM DE-LETE. IF1374.2 +040600 GO TO F-STD-DEV-WRITE-03. IF1374.2 +040700 F-STD-DEV-WRITE-03. IF1374.2 +040800 MOVE "F-STD-DEV-03" TO PAR-NAME. IF1374.2 +040900 PERFORM PRINT-DETAIL. IF1374.2 +041000*****************TEST (d) - SIMPLE TEST***************** IF1374.2 +041100 F-STD-DEV-04. IF1374.2 +041200 MOVE ZERO TO WS-NUM. IF1374.2 +041300 MOVE 16.8440 TO MIN-RANGE. IF1374.2 +041400 MOVE 16.8447 TO MAX-RANGE. IF1374.2 +041500 F-STD-DEV-TEST-04. IF1374.2 +041600 COMPUTE WS-NUM = IF1374.2 +041700 FUNCTION STANDARD-DEVIATION(E, F, G, H). IF1374.2 +041800 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +041900 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +042000 PERFORM PASS IF1374.2 +042100 ELSE IF1374.2 +042200 MOVE WS-NUM TO COMPUTED-N IF1374.2 +042300 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +042400 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +042500 PERFORM FAIL. IF1374.2 +042600 GO TO F-STD-DEV-WRITE-04. IF1374.2 +042700 F-STD-DEV-DELETE-04. IF1374.2 +042800 PERFORM DE-LETE. IF1374.2 +042900 GO TO F-STD-DEV-WRITE-04. IF1374.2 +043000 F-STD-DEV-WRITE-04. IF1374.2 +043100 MOVE "F-STD-DEV-04" TO PAR-NAME. IF1374.2 +043200 PERFORM PRINT-DETAIL. IF1374.2 +043300*****************TEST (e) - SIMPLE TEST***************** IF1374.2 +043400 F-STD-DEV-05. IF1374.2 +043500 MOVE ZERO TO WS-NUM. IF1374.2 +043600 MOVE 9.73119 TO MIN-RANGE. IF1374.2 +043700 MOVE 9.73158 TO MAX-RANGE. IF1374.2 +043800 F-STD-DEV-TEST-05. IF1374.2 +043900 COMPUTE WS-NUM = IF1374.2 +044000 FUNCTION STANDARD-DEVIATION(10.2, -0.2, 5.6, -15.6). IF1374.2 +044100 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +044200 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +044300 PERFORM PASS IF1374.2 +044400 ELSE IF1374.2 +044500 MOVE WS-NUM TO COMPUTED-N IF1374.2 +044600 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +044700 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +044800 PERFORM FAIL. IF1374.2 +044900 GO TO F-STD-DEV-WRITE-05. IF1374.2 +045000 F-STD-DEV-DELETE-05. IF1374.2 +045100 PERFORM DE-LETE. IF1374.2 +045200 GO TO F-STD-DEV-WRITE-05. IF1374.2 +045300 F-STD-DEV-WRITE-05. IF1374.2 +045400 MOVE "F-STD-DEV-05" TO PAR-NAME. IF1374.2 +045500 PERFORM PRINT-DETAIL. IF1374.2 +045600*****************TEST (f) - SIMPLE TEST***************** IF1374.2 +045700 F-STD-DEV-06. IF1374.2 +045800 MOVE ZERO TO WS-NUM. IF1374.2 +045900 MOVE 12.4976 TO MIN-RANGE. IF1374.2 +046000 MOVE 12.4981 TO MAX-RANGE. IF1374.2 +046100 F-STD-DEV-TEST-06. IF1374.2 +046200 COMPUTE WS-NUM = IF1374.2 +046300 FUNCTION STANDARD-DEVIATION(A, B, C, D, E, F, G, H). IF1374.2 +046400 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +046500 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +046600 PERFORM PASS IF1374.2 +046700 ELSE IF1374.2 +046800 MOVE WS-NUM TO COMPUTED-N IF1374.2 +046900 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +047000 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +047100 PERFORM FAIL. IF1374.2 +047200 GO TO F-STD-DEV-WRITE-06. IF1374.2 +047300 F-STD-DEV-DELETE-06. IF1374.2 +047400 PERFORM DE-LETE. IF1374.2 +047500 GO TO F-STD-DEV-WRITE-06. IF1374.2 +047600 F-STD-DEV-WRITE-06. IF1374.2 +047700 MOVE "F-STD-DEV-06" TO PAR-NAME. IF1374.2 +047800 PERFORM PRINT-DETAIL. IF1374.2 +047900*****************TEST (g) - SIMPLE TEST***************** IF1374.2 +048000 F-STD-DEV-07. IF1374.2 +048100 MOVE ZERO TO WS-NUM. IF1374.2 +048200 MOVE 2.16020 TO MIN-RANGE. IF1374.2 +048300 MOVE 2.16028 TO MAX-RANGE. IF1374.2 +048400 F-STD-DEV-TEST-07. IF1374.2 +048500 COMPUTE WS-NUM = IF1374.2 +048600 FUNCTION STANDARD-DEVIATION(IND(1), IND(2), IND(3)). IF1374.2 +048700 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +048800 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +048900 PERFORM PASS IF1374.2 +049000 ELSE IF1374.2 +049100 MOVE WS-NUM TO COMPUTED-N IF1374.2 +049200 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +049300 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +049400 PERFORM FAIL. IF1374.2 +049500 GO TO F-STD-DEV-WRITE-07. IF1374.2 +049600 F-STD-DEV-DELETE-07. IF1374.2 +049700 PERFORM DE-LETE. IF1374.2 +049800 GO TO F-STD-DEV-WRITE-07. IF1374.2 +049900 F-STD-DEV-WRITE-07. IF1374.2 +050000 MOVE "F-STD-DEV-07" TO PAR-NAME. IF1374.2 +050100 PERFORM PRINT-DETAIL. IF1374.2 +050200*****************TEST (h) - SIMPLE TEST***************** IF1374.2 +050300 F-STD-DEV-08. IF1374.2 +050400 MOVE ZERO TO WS-NUM. IF1374.2 +050500 MOVE 1.63296 TO MIN-RANGE. IF1374.2 +050600 MOVE 1.63302 TO MAX-RANGE. IF1374.2 +050700 F-STD-DEV-TEST-08. IF1374.2 +050800 COMPUTE WS-NUM = IF1374.2 +050900 FUNCTION STANDARD-DEVIATION(IND(P), IND(Q), IND(R)). IF1374.2 +051000 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +051100 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +051200 PERFORM PASS IF1374.2 +051300 ELSE IF1374.2 +051400 MOVE WS-NUM TO COMPUTED-N IF1374.2 +051500 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +051600 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +051700 PERFORM FAIL. IF1374.2 +051800 GO TO F-STD-DEV-WRITE-08. IF1374.2 +051900 F-STD-DEV-DELETE-08. IF1374.2 +052000 PERFORM DE-LETE. IF1374.2 +052100 GO TO F-STD-DEV-WRITE-08. IF1374.2 +052200 F-STD-DEV-WRITE-08. IF1374.2 +052300 MOVE "F-STD-DEV-08" TO PAR-NAME. IF1374.2 +052400 PERFORM PRINT-DETAIL. IF1374.2 +052500*****************TEST (i) - SIMPLE TEST***************** IF1374.2 +052600 F-STD-DEV-09. IF1374.2 +052700 MOVE ZERO TO WS-NUM. IF1374.2 +052800 MOVE 2.31511 TO MIN-RANGE. IF1374.2 +052900 MOVE 2.31521 TO MAX-RANGE. IF1374.2 +053000 F-STD-DEV-TEST-09. IF1374.2 +053100 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(IND(ALL)). IF1374.2 +053200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +053300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +053400 PERFORM PASS IF1374.2 +053500 ELSE IF1374.2 +053600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +053700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +053800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +053900 PERFORM FAIL. IF1374.2 +054000 GO TO F-STD-DEV-WRITE-09. IF1374.2 +054100 F-STD-DEV-DELETE-09. IF1374.2 +054200 PERFORM DE-LETE. IF1374.2 +054300 GO TO F-STD-DEV-WRITE-09. IF1374.2 +054400 F-STD-DEV-WRITE-09. IF1374.2 +054500 MOVE "F-STD-DEV-09" TO PAR-NAME. IF1374.2 +054600 PERFORM PRINT-DETAIL. IF1374.2 +054700*****************TEST (j) - SIMPLE TEST***************** IF1374.2 +054800 F-STD-DEV-10. IF1374.2 +054900 MOVE ZERO TO WS-NUM. IF1374.2 +055000 MOVE 0.028559 TO MIN-RANGE. IF1374.2 +055100 MOVE 0.028561 TO MAX-RANGE. IF1374.2 +055200 F-STD-DEV-TEST-10. IF1374.2 +055300 COMPUTE WS-NUM = IF1374.2 +055400 FUNCTION STANDARD-DEVIATION(0.00032, 0.00019, IF1374.2 +055500 0.00014, -0.06574). IF1374.2 +055600 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +055700 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +055800 PERFORM PASS IF1374.2 +055900 ELSE IF1374.2 +056000 MOVE WS-NUM TO COMPUTED-N IF1374.2 +056100 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +056200 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +056300 PERFORM FAIL. IF1374.2 +056400 GO TO F-STD-DEV-WRITE-10. IF1374.2 +056500 F-STD-DEV-DELETE-10. IF1374.2 +056600 PERFORM DE-LETE. IF1374.2 +056700 GO TO F-STD-DEV-WRITE-10. IF1374.2 +056800 F-STD-DEV-WRITE-10. IF1374.2 +056900 MOVE "F-STD-DEV-10" TO PAR-NAME. IF1374.2 +057000 PERFORM PRINT-DETAIL. IF1374.2 +057100*****************TEST (k) - SIMPLE TEST***************** IF1374.2 +057200 F-STD-DEV-11. IF1374.2 +057300 MOVE ZERO TO WS-NUM. IF1374.2 +057400 MOVE -0.000020 TO MIN-RANGE. IF1374.2 +057500 MOVE 0.000020 TO MAX-RANGE. IF1374.2 +057600 F-STD-DEV-TEST-11. IF1374.2 +057700 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A, 5, A). IF1374.2 +057800 IF1374.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +058100 PERFORM PASS IF1374.2 +058200 ELSE IF1374.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1374.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +058600 PERFORM FAIL. IF1374.2 +058700 GO TO F-STD-DEV-WRITE-11. IF1374.2 +058800 F-STD-DEV-DELETE-11. IF1374.2 +058900 PERFORM DE-LETE. IF1374.2 +059000 GO TO F-STD-DEV-WRITE-11. IF1374.2 +059100 F-STD-DEV-WRITE-11. IF1374.2 +059200 MOVE "F-STD-DEV-11" TO PAR-NAME. IF1374.2 +059300 PERFORM PRINT-DETAIL. IF1374.2 +059400*****************TEST (a) - COMPLEX TEST**************** IF1374.2 +059500 F-STD-DEV-12. IF1374.2 +059600 MOVE ZERO TO WS-NUM. IF1374.2 +059700 MOVE 11.7995 TO MIN-RANGE. IF1374.2 +059800 MOVE 11.8005 TO MAX-RANGE. IF1374.2 +059900 F-STD-DEV-TEST-12. IF1374.2 +060000 COMPUTE WS-NUM = IF1374.2 +060100 FUNCTION STANDARD-DEVIATION(2.6 + 30, 4.5 * 2). IF1374.2 +060200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +060300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +060400 PERFORM PASS IF1374.2 +060500 ELSE IF1374.2 +060600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +060700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +060800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +060900 PERFORM FAIL. IF1374.2 +061000 GO TO F-STD-DEV-WRITE-12. IF1374.2 +061100 F-STD-DEV-DELETE-12. IF1374.2 +061200 PERFORM DE-LETE. IF1374.2 +061300 GO TO F-STD-DEV-WRITE-12. IF1374.2 +061400 F-STD-DEV-WRITE-12. IF1374.2 +061500 MOVE "F-STD-DEV-12" TO PAR-NAME. IF1374.2 +061600 PERFORM PRINT-DETAIL. IF1374.2 +061700*****************TEST (b) - COMPLEX TEST**************** IF1374.2 +061800 F-STD-DEV-13. IF1374.2 +061900 MOVE ZERO TO WS-NUM. IF1374.2 +062000 MOVE 19.3556 TO MIN-RANGE. IF1374.2 +062100 MOVE 19.3572 TO MAX-RANGE. IF1374.2 +062200 F-STD-DEV-TEST-13. IF1374.2 +062300 COMPUTE WS-NUM = IF1374.2 +062400 FUNCTION STANDARD-DEVIATION(E, 9 * A, 0, B / 2). IF1374.2 +062500 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +062600 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +062700 PERFORM PASS IF1374.2 +062800 ELSE IF1374.2 +062900 MOVE WS-NUM TO COMPUTED-N IF1374.2 +063000 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +063100 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +063200 PERFORM FAIL. IF1374.2 +063300 GO TO F-STD-DEV-WRITE-13. IF1374.2 +063400 F-STD-DEV-DELETE-13. IF1374.2 +063500 PERFORM DE-LETE. IF1374.2 +063600 GO TO F-STD-DEV-WRITE-13. IF1374.2 +063700 F-STD-DEV-WRITE-13. IF1374.2 +063800 MOVE "F-STD-DEV-13" TO PAR-NAME. IF1374.2 +063900 PERFORM PRINT-DETAIL. IF1374.2 +064000*****************TEST (c) - COMPLEX TEST**************** IF1374.2 +064100 F-STD-DEV-14. IF1374.2 +064200 MOVE ZERO TO WS-NUM. IF1374.2 +064300 MOVE 77.9969 TO MIN-RANGE. IF1374.2 +064400 MOVE 78.0031 TO MAX-RANGE. IF1374.2 +064500 F-STD-DEV-TEST-14. IF1374.2 +064600 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A) + 78. IF1374.2 +064700 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +064800 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +064900 PERFORM PASS IF1374.2 +065000 ELSE IF1374.2 +065100 MOVE WS-NUM TO COMPUTED-N IF1374.2 +065200 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +065300 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +065400 PERFORM FAIL. IF1374.2 +065500 GO TO F-STD-DEV-WRITE-14. IF1374.2 +065600 F-STD-DEV-DELETE-14. IF1374.2 +065700 PERFORM DE-LETE. IF1374.2 +065800 GO TO F-STD-DEV-WRITE-14. IF1374.2 +065900 F-STD-DEV-WRITE-14. IF1374.2 +066000 MOVE "F-STD-DEV-14" TO PAR-NAME. IF1374.2 +066100 PERFORM PRINT-DETAIL. IF1374.2 +066200*****************TEST (d) - COMPLEX TEST**************** IF1374.2 +066300 F-STD-DEV-15. IF1374.2 +066400 MOVE ZERO TO WS-NUM. IF1374.2 +066500 MOVE 0.99996 TO MIN-RANGE. IF1374.2 +066600 MOVE 1.00004 TO MAX-RANGE. IF1374.2 +066700 F-STD-DEV-TEST-15. IF1374.2 +066800 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A, B) + IF1374.2 +066900 FUNCTION STANDARD-DEVIATION(1, 1). IF1374.2 +067000 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +067100 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +067200 PERFORM PASS IF1374.2 +067300 ELSE IF1374.2 +067400 MOVE WS-NUM TO COMPUTED-N IF1374.2 +067500 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +067600 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +067700 PERFORM FAIL. IF1374.2 +067800 GO TO F-STD-DEV-WRITE-15. IF1374.2 +067900 F-STD-DEV-DELETE-15. IF1374.2 +068000 PERFORM DE-LETE. IF1374.2 +068100 GO TO F-STD-DEV-WRITE-15. IF1374.2 +068200 F-STD-DEV-WRITE-15. IF1374.2 +068300 MOVE "F-STD-DEV-15" TO PAR-NAME. IF1374.2 +068400 PERFORM PRINT-DETAIL. IF1374.2 +068500*****************TEST (e) - COMPLEX TEST**************** IF1374.2 +068600 F-STD-DEV-16. IF1374.2 +068700 MOVE ZERO TO WS-NUM. IF1374.2 +068800 MOVE -0.000040 TO MIN-RANGE. IF1374.2 +068900 MOVE 0.000040 TO MAX-RANGE. IF1374.2 +069000 F-STD-DEV-TEST-16. IF1374.2 +069100 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION( IF1374.2 +069200 FUNCTION STANDARD-DEVIATION(0, 0)). IF1374.2 +069300 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +069400 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +069500 PERFORM PASS IF1374.2 +069600 ELSE IF1374.2 +069700 MOVE WS-NUM TO COMPUTED-N IF1374.2 +069800 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +069900 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +070000 PERFORM FAIL. IF1374.2 +070100 GO TO F-STD-DEV-WRITE-16. IF1374.2 +070200 F-STD-DEV-DELETE-16. IF1374.2 +070300 PERFORM DE-LETE. IF1374.2 +070400 GO TO F-STD-DEV-WRITE-16. IF1374.2 +070500 F-STD-DEV-WRITE-16. IF1374.2 +070600 MOVE "F-STD-DEV-16" TO PAR-NAME. IF1374.2 +070700 PERFORM PRINT-DETAIL. IF1374.2 +070800*****************SPECIAL PERFORM TEST********************** IF1374.2 +070900 F-STD-DEV-17. IF1374.2 +071000 PERFORM F-STD-DEV-TEST-17 IF1374.2 +071100 UNTIL FUNCTION STANDARD-DEVIATION(1, 1, ARG3) > 1. IF1374.2 +071200 PERFORM PASS. IF1374.2 +071300 GO TO F-STD-DEV-WRITE-17. IF1374.2 +071400 F-STD-DEV-TEST-17. IF1374.2 +071500 COMPUTE ARG3 = ARG3 + 1. IF1374.2 +071600 F-STD-DEV-DELETE-17. IF1374.2 +071700 PERFORM DE-LETE. IF1374.2 +071800 GO TO F-STD-DEV-WRITE-17. IF1374.2 +071900 F-STD-DEV-WRITE-17. IF1374.2 +072000 MOVE "F-STD-DEV-17" TO PAR-NAME. IF1374.2 +072100 PERFORM PRINT-DETAIL. IF1374.2 +072200********************END OF TESTS*************** IF1374.2 +072300 CCVS-EXIT SECTION. IF1374.2 +072400 CCVS-999999. IF1374.2 +072500 GO TO CLOSE-FILES. IF1374.2 +*END-OF,IF137A +*HEADER,COBOL,IF138A +000100 IDENTIFICATION DIVISION. IF1384.2 +000200 PROGRAM-ID. IF1384.2 +000300 IF138A. IF1384.2 +000400 IF1384.2 +000500*********************************************************** IF1384.2 +000600* * IF1384.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1384.2 +000800* It contains tests for the Intrinsic Function SUM . * IF1384.2 +000900* * IF1384.2 +001000*********************************************************** IF1384.2 +001100 ENVIRONMENT DIVISION. IF1384.2 +001200 CONFIGURATION SECTION. IF1384.2 +001300 SOURCE-COMPUTER. IF1384.2 +001400 XXXXX082. IF1384.2 +001500 OBJECT-COMPUTER. IF1384.2 +001600 XXXXX083. IF1384.2 +001700 INPUT-OUTPUT SECTION. IF1384.2 +001800 FILE-CONTROL. IF1384.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1384.2 +002000 XXXXX055. IF1384.2 +002100 DATA DIVISION. IF1384.2 +002200 FILE SECTION. IF1384.2 +002300 FD PRINT-FILE. IF1384.2 +002400 01 PRINT-REC PICTURE X(120). IF1384.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1384.2 +002600 WORKING-STORAGE SECTION. IF1384.2 +002700*********************************************************** IF1384.2 +002800* Variables specific to the Intrinsic Function Test IF138A* IF1384.2 +002900*********************************************************** IF1384.2 +003000 01 A PIC S9(10) VALUE 5. IF1384.2 +003100 01 B PIC S9(10) VALUE 7. IF1384.2 +003200 01 C PIC S9(10) VALUE -4. IF1384.2 +003300 01 D PIC S9(10) VALUE 10. IF1384.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1384.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1384.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1384.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1384.2 +003800 01 M PIC S9(10) VALUE 320000. IF1384.2 +003900 01 N PIC S9(10) VALUE 650000. IF1384.2 +004000 01 O PIC S9(10) VALUE -430000. IF1384.2 +004100 01 P PIC S9(10) VALUE 1. IF1384.2 +004200 01 Q PIC S9(10) VALUE 3. IF1384.2 +004300 01 R PIC S9(10) VALUE 5. IF1384.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1384.2 +004500 01 ARR VALUE "40537". IF1384.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1384.2 +004700 01 TEMP PIC S9(10)V9(5). IF1384.2 +004800 01 WS-NUM PIC S9(6)V9(7). IF1384.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1384.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1384.2 +005100* IF1384.2 +005200********************************************************** IF1384.2 +005300* IF1384.2 +005400 01 TEST-RESULTS. IF1384.2 +005500 02 FILLER PIC X VALUE SPACE. IF1384.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1384.2 +005700 02 FILLER PIC X VALUE SPACE. IF1384.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1384.2 +005900 02 FILLER PIC X VALUE SPACE. IF1384.2 +006000 02 PAR-NAME. IF1384.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1384.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1384.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1384.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1384.2 +006500 02 RE-MARK PIC X(61). IF1384.2 +006600 01 TEST-COMPUTED. IF1384.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +006800 02 FILLER PIC X(17) VALUE IF1384.2 +006900 " COMPUTED=". IF1384.2 +007000 02 COMPUTED-X. IF1384.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1384.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1384.2 +007300 PIC -9(9).9(9). IF1384.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1384.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1384.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1384.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1384.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1384.2 +007900 04 FILLER PIC X. IF1384.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1384.2 +008100 01 TEST-CORRECT. IF1384.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1384.2 +008400 02 CORRECT-X. IF1384.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1384.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1384.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1384.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1384.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1384.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1384.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1384.2 +009200 04 FILLER PIC X. IF1384.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1384.2 +009500 01 TEST-CORRECT-MIN. IF1384.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1384.2 +009800 02 CORRECTMI-X. IF1384.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1384.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1384.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1384.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1384.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1384.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1384.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1384.2 +010600 04 FILLER PIC X. IF1384.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1384.2 +010900 01 TEST-CORRECT-MAX. IF1384.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1384.2 +011200 02 CORRECTMA-X. IF1384.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1384.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1384.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1384.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1384.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1384.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1384.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1384.2 +012000 04 FILLER PIC X. IF1384.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1384.2 +012300 01 CCVS-C-1. IF1384.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1384.2 +012500- "SS PARAGRAPH-NAME IF1384.2 +012600- " REMARKS". IF1384.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1384.2 +012800 01 CCVS-C-2. IF1384.2 +012900 02 FILLER PIC X VALUE SPACE. IF1384.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1384.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1384.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1384.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1384.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1384.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1384.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1384.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1384.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1384.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1384.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1384.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1384.2 +014500 01 CCVS-H-1. IF1384.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1384.2 +014700 02 FILLER PIC X(42) VALUE IF1384.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1384.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1384.2 +015000 01 CCVS-H-2A. IF1384.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1384.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1384.2 +015300 02 FILLER PIC XXXX VALUE IF1384.2 +015400 "4.2 ". IF1384.2 +015500 02 FILLER PIC X(28) VALUE IF1384.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1384.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1384.2 +015800 IF1384.2 +015900 01 CCVS-H-2B. IF1384.2 +016000 02 FILLER PIC X(15) VALUE IF1384.2 +016100 "TEST RESULT OF ". IF1384.2 +016200 02 TEST-ID PIC X(9). IF1384.2 +016300 02 FILLER PIC X(4) VALUE IF1384.2 +016400 " IN ". IF1384.2 +016500 02 FILLER PIC X(12) VALUE IF1384.2 +016600 " HIGH ". IF1384.2 +016700 02 FILLER PIC X(22) VALUE IF1384.2 +016800 " LEVEL VALIDATION FOR ". IF1384.2 +016900 02 FILLER PIC X(58) VALUE IF1384.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1384.2 +017100 01 CCVS-H-3. IF1384.2 +017200 02 FILLER PIC X(34) VALUE IF1384.2 +017300 " FOR OFFICIAL USE ONLY ". IF1384.2 +017400 02 FILLER PIC X(58) VALUE IF1384.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1384.2 +017600 02 FILLER PIC X(28) VALUE IF1384.2 +017700 " COPYRIGHT 1985 ". IF1384.2 +017800 01 CCVS-E-1. IF1384.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1384.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1384.2 +018100 02 ID-AGAIN PIC X(9). IF1384.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1384.2 +018300 01 CCVS-E-2. IF1384.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1384.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1384.2 +018600 02 CCVS-E-2-2. IF1384.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1384.2 +018800 03 FILLER PIC X VALUE SPACE. IF1384.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1384.2 +019000 "ERRORS ENCOUNTERED". IF1384.2 +019100 01 CCVS-E-3. IF1384.2 +019200 02 FILLER PIC X(22) VALUE IF1384.2 +019300 " FOR OFFICIAL USE ONLY". IF1384.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1384.2 +019500 02 FILLER PIC X(58) VALUE IF1384.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1384.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1384.2 +019800 02 FILLER PIC X(15) VALUE IF1384.2 +019900 " COPYRIGHT 1985". IF1384.2 +020000 01 CCVS-E-4. IF1384.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1384.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1384.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1384.2 +020400 02 FILLER PIC X(40) VALUE IF1384.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1384.2 +020600 01 XXINFO. IF1384.2 +020700 02 FILLER PIC X(19) VALUE IF1384.2 +020800 "*** INFORMATION ***". IF1384.2 +020900 02 INFO-TEXT. IF1384.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1384.2 +021100 04 XXCOMPUTED PIC X(20). IF1384.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1384.2 +021300 04 XXCORRECT PIC X(20). IF1384.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1384.2 +021500 01 HYPHEN-LINE. IF1384.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1384.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1384.2 +021800- "*****************************************". IF1384.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1384.2 +022000- "******************************". IF1384.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1384.2 +022200 "IF138A". IF1384.2 +022300 PROCEDURE DIVISION. IF1384.2 +022400 CCVS1 SECTION. IF1384.2 +022500 OPEN-FILES. IF1384.2 +022600 OPEN OUTPUT PRINT-FILE. IF1384.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1384.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1384.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1384.2 +023000 GO TO CCVS1-EXIT. IF1384.2 +023100 CLOSE-FILES. IF1384.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1384.2 +023300 TERMINATE-CCVS. IF1384.2 +023400 STOP RUN. IF1384.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1384.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1384.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1384.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1384.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1384.2 +024000 PRINT-DETAIL. IF1384.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1384.2 +024200 MOVE "." TO PARDOT-X IF1384.2 +024300 MOVE REC-CT TO DOTVALUE. IF1384.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1384.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1384.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1384.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1384.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1384.2 +024900 MOVE SPACE TO CORRECT-X. IF1384.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1384.2 +025100 MOVE SPACE TO RE-MARK. IF1384.2 +025200 HEAD-ROUTINE. IF1384.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1384.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1384.2 +025700 COLUMN-NAMES-ROUTINE. IF1384.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +026100 END-ROUTINE. IF1384.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1384.2 +026300 END-RTN-EXIT. IF1384.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +026500 END-ROUTINE-1. IF1384.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1384.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1384.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1384.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1384.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1384.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1384.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1384.2 +027300 END-ROUTINE-12. IF1384.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1384.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1384.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1384.2 +027700 ELSE IF1384.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1384.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1384.2 +028000 PERFORM WRITE-LINE. IF1384.2 +028100 END-ROUTINE-13. IF1384.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1384.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1384.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1384.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1384.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1384.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1384.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1384.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1384.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +029300 WRITE-LINE. IF1384.2 +029400 ADD 1 TO RECORD-COUNT. IF1384.2 +029500Y IF RECORD-COUNT GREATER 42 IF1384.2 +029600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1384.2 +029700Y MOVE SPACE TO DUMMY-RECORD IF1384.2 +029800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1384.2 +029900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1384.2 +030000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1384.2 +030100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1384.2 +030200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1384.2 +030300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1384.2 +030700Y MOVE ZERO TO RECORD-COUNT. IF1384.2 +030800 PERFORM WRT-LN. IF1384.2 +030900 WRT-LN. IF1384.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1384.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1384.2 +031200 BLANK-LINE-PRINT. IF1384.2 +031300 PERFORM WRT-LN. IF1384.2 +031400 FAIL-ROUTINE. IF1384.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1384.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1384.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1384.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1384.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1384.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1384.2 +032200 GO TO FAIL-ROUTINE-EX. IF1384.2 +032300 FAIL-ROUTINE-WRITE. IF1384.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1384.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1384.2 +032600 CORMA-ANSI-REFERENCE. IF1384.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1384.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1384.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1384.2 +033000 ELSE IF1384.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1384.2 +033200 PERFORM WRITE-LINE. IF1384.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1384.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1384.2 +033500 BAIL-OUT. IF1384.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1384.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1384.2 +033800 BAIL-OUT-WRITE. IF1384.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1384.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1384.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1384.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1384.2 +034400 BAIL-OUT-EX. EXIT. IF1384.2 +034500 CCVS1-EXIT. IF1384.2 +034600 EXIT. IF1384.2 +034700******************************************************** IF1384.2 +034800* * IF1384.2 +034900* Intrinsic Function Tests IF138A - SUM * IF1384.2 +035000* * IF1384.2 +035100******************************************************** IF1384.2 +035200 SECT-IF138A SECTION. IF1384.2 +035300 F-SUM-INFO. IF1384.2 +035400 MOVE "See ref. A-69 2.40" TO ANSI-REFERENCE. IF1384.2 +035500 MOVE "SUM Function" TO FEATURE. IF1384.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1384.2 +035700 F-SUM-01. IF1384.2 +035800 MOVE ZERO TO WS-NUM. IF1384.2 +035900 F-SUM-TEST-01. IF1384.2 +036000 COMPUTE WS-NUM = FUNCTION SUM(5, -2, -14, 0). IF1384.2 +036100 IF WS-NUM = -11 THEN IF1384.2 +036200 PERFORM PASS IF1384.2 +036300 ELSE IF1384.2 +036400 MOVE WS-NUM TO COMPUTED-N IF1384.2 +036500 MOVE -11 TO CORRECT-N IF1384.2 +036600 PERFORM FAIL. IF1384.2 +036700 GO TO F-SUM-WRITE-01. IF1384.2 +036800 F-SUM-DELETE-01. IF1384.2 +036900 PERFORM DE-LETE. IF1384.2 +037000 GO TO F-SUM-WRITE-01. IF1384.2 +037100 F-SUM-WRITE-01. IF1384.2 +037200 MOVE "F-SUM-01" TO PAR-NAME. IF1384.2 +037300 PERFORM PRINT-DETAIL. IF1384.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1384.2 +037500 F-SUM-02. IF1384.2 +037600 EVALUATE FUNCTION SUM(3.9, -0.3, 8.7, 100.2) IF1384.2 +037700 WHEN 112.498 THRU 122.502 IF1384.2 +037800 PERFORM PASS IF1384.2 +037900 WHEN OTHER IF1384.2 +038000 PERFORM FAIL. IF1384.2 +038100 GO TO F-SUM-WRITE-02. IF1384.2 +038200 F-SUM-DELETE-02. IF1384.2 +038300 PERFORM DE-LETE. IF1384.2 +038400 GO TO F-SUM-WRITE-02. IF1384.2 +038500 F-SUM-WRITE-02. IF1384.2 +038600 MOVE "F-SUM-02" TO PAR-NAME. IF1384.2 +038700 PERFORM PRINT-DETAIL. IF1384.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1384.2 +038900 F-SUM-03. IF1384.2 +039000 IF FUNCTION SUM(A, B, C, D) = 18 THEN IF1384.2 +039100 PERFORM PASS IF1384.2 +039200 ELSE IF1384.2 +039300 PERFORM FAIL. IF1384.2 +039400 GO TO F-SUM-WRITE-03. IF1384.2 +039500 F-SUM-DELETE-03. IF1384.2 +039600 PERFORM DE-LETE. IF1384.2 +039700 GO TO F-SUM-WRITE-03. IF1384.2 +039800 F-SUM-WRITE-03. IF1384.2 +039900 MOVE "F-SUM-03" TO PAR-NAME. IF1384.2 +040000 PERFORM PRINT-DETAIL. IF1384.2 +040100*****************TEST (d) - SIMPLE TEST***************** IF1384.2 +040200 F-SUM-04. IF1384.2 +040300 MOVE ZERO TO WS-NUM. IF1384.2 +040400 F-SUM-TEST-04. IF1384.2 +040500 COMPUTE WS-NUM = FUNCTION SUM(E, F, G, H). IF1384.2 +040600 IF (WS-NUM >= 24.7195) AND IF1384.2 +040700 (WS-NUM <= 24.7205) IF1384.2 +040800 PERFORM PASS IF1384.2 +040900 ELSE IF1384.2 +041000 MOVE WS-NUM TO COMPUTED-N IF1384.2 +041100 MOVE 24.72 TO CORRECT-N IF1384.2 +041200 PERFORM FAIL. IF1384.2 +041300 GO TO F-SUM-WRITE-04. IF1384.2 +041400 F-SUM-DELETE-04. IF1384.2 +041500 PERFORM DE-LETE. IF1384.2 +041600 GO TO F-SUM-WRITE-04. IF1384.2 +041700 F-SUM-WRITE-04. IF1384.2 +041800 MOVE "F-SUM-04" TO PAR-NAME. IF1384.2 +041900 PERFORM PRINT-DETAIL. IF1384.2 +042000*****************TEST (e) - SIMPLE TEST***************** IF1384.2 +042100 F-SUM-05. IF1384.2 +042200 MOVE ZERO TO WS-NUM. IF1384.2 +042300 F-SUM-TEST-05. IF1384.2 +042400 COMPUTE WS-NUM = FUNCTION SUM(10.2, -0.2, 5.6, -15.6). IF1384.2 +042500 IF (WS-NUM >= -0.000020) AND IF1384.2 +042600 (WS-NUM <= 0.000020) IF1384.2 +042700 PERFORM PASS IF1384.2 +042800 ELSE IF1384.2 +042900 MOVE WS-NUM TO COMPUTED-N IF1384.2 +043000 MOVE 0 TO CORRECT-N IF1384.2 +043100 PERFORM FAIL. IF1384.2 +043200 GO TO F-SUM-WRITE-05. IF1384.2 +043300 F-SUM-DELETE-05. IF1384.2 +043400 PERFORM DE-LETE. IF1384.2 +043500 GO TO F-SUM-WRITE-05. IF1384.2 +043600 F-SUM-WRITE-05. IF1384.2 +043700 MOVE "F-SUM-05" TO PAR-NAME. IF1384.2 +043800 PERFORM PRINT-DETAIL. IF1384.2 +043900*****************TEST (f) - SIMPLE TEST***************** IF1384.2 +044000 F-SUM-06. IF1384.2 +044100 MOVE ZERO TO WS-NUM. IF1384.2 +044200 F-SUM-TEST-06. IF1384.2 +044300 COMPUTE WS-NUM = FUNCTION SUM(A, B, C, D, E, F, G, H). IF1384.2 +044400 IF (WS-NUM >= 42.7191) AND IF1384.2 +044500 (WS-NUM <= 42.7209) IF1384.2 +044600 PERFORM PASS IF1384.2 +044700 ELSE IF1384.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1384.2 +044900 MOVE 42.72 TO CORRECT-N IF1384.2 +045000 PERFORM FAIL. IF1384.2 +045100 GO TO F-SUM-WRITE-06. IF1384.2 +045200 F-SUM-DELETE-06. IF1384.2 +045300 PERFORM DE-LETE. IF1384.2 +045400 GO TO F-SUM-WRITE-06. IF1384.2 +045500 F-SUM-WRITE-06. IF1384.2 +045600 MOVE "F-SUM-06" TO PAR-NAME. IF1384.2 +045700 PERFORM PRINT-DETAIL. IF1384.2 +045800*****************TEST (g) - SIMPLE TEST***************** IF1384.2 +045900 F-SUM-07. IF1384.2 +046000 MOVE ZERO TO WS-NUM. IF1384.2 +046100 F-SUM-TEST-07. IF1384.2 +046200 COMPUTE WS-NUM = FUNCTION SUM(IND(1), IND(2), IND(3)). IF1384.2 +046300 IF WS-NUM = 9 THEN IF1384.2 +046400 PERFORM PASS IF1384.2 +046500 ELSE IF1384.2 +046600 MOVE WS-NUM TO COMPUTED-N IF1384.2 +046700 MOVE 9 TO CORRECT-N IF1384.2 +046800 PERFORM FAIL. IF1384.2 +046900 GO TO F-SUM-WRITE-07. IF1384.2 +047000 F-SUM-DELETE-07. IF1384.2 +047100 PERFORM DE-LETE. IF1384.2 +047200 GO TO F-SUM-WRITE-07. IF1384.2 +047300 F-SUM-WRITE-07. IF1384.2 +047400 MOVE "F-SUM-07" TO PAR-NAME. IF1384.2 +047500 PERFORM PRINT-DETAIL. IF1384.2 +047600*****************TEST (h) - SIMPLE TEST***************** IF1384.2 +047700 F-SUM-08. IF1384.2 +047800 MOVE ZERO TO WS-NUM. IF1384.2 +047900 F-SUM-TEST-08. IF1384.2 +048000 COMPUTE WS-NUM = FUNCTION SUM(IND(P), IND(Q), IND(R)). IF1384.2 +048100 IF WS-NUM = 16 THEN IF1384.2 +048200 PERFORM PASS IF1384.2 +048300 ELSE IF1384.2 +048400 MOVE WS-NUM TO COMPUTED-N IF1384.2 +048500 MOVE 16 TO CORRECT-N IF1384.2 +048600 PERFORM FAIL. IF1384.2 +048700 GO TO F-SUM-WRITE-08. IF1384.2 +048800 F-SUM-DELETE-08. IF1384.2 +048900 PERFORM DE-LETE. IF1384.2 +049000 GO TO F-SUM-WRITE-08. IF1384.2 +049100 F-SUM-WRITE-08. IF1384.2 +049200 MOVE "F-SUM-08" TO PAR-NAME. IF1384.2 +049300 PERFORM PRINT-DETAIL. IF1384.2 +049400*****************TEST (i) - SIMPLE TEST***************** IF1384.2 +049500 F-SUM-09. IF1384.2 +049600 MOVE ZERO TO WS-NUM. IF1384.2 +049700 F-SUM-TEST-09. IF1384.2 +049800 COMPUTE WS-NUM = FUNCTION SUM(IND(ALL)). IF1384.2 +049900 IF WS-NUM = 19 THEN IF1384.2 +050000 PERFORM PASS IF1384.2 +050100 ELSE IF1384.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1384.2 +050300 MOVE 19 TO CORRECT-N IF1384.2 +050400 PERFORM FAIL. IF1384.2 +050500 GO TO F-SUM-WRITE-09. IF1384.2 +050600 F-SUM-DELETE-09. IF1384.2 +050700 PERFORM DE-LETE. IF1384.2 +050800 GO TO F-SUM-WRITE-09. IF1384.2 +050900 F-SUM-WRITE-09. IF1384.2 +051000 MOVE "F-SUM-09" TO PAR-NAME. IF1384.2 +051100 PERFORM PRINT-DETAIL. IF1384.2 +051200*****************TEST (k) - SIMPLE TEST***************** IF1384.2 +051300 F-SUM-11. IF1384.2 +051400 MOVE ZERO TO WS-NUM. IF1384.2 +051500 F-SUM-TEST-11. IF1384.2 +051600 COMPUTE WS-NUM = FUNCTION SUM(M, N, O). IF1384.2 +051700 IF WS-NUM = 540000 THEN IF1384.2 +051800 PERFORM PASS IF1384.2 +051900 ELSE IF1384.2 +052000 MOVE WS-NUM TO COMPUTED-N IF1384.2 +052100 MOVE 540000 TO CORRECT-N IF1384.2 +052200 PERFORM FAIL. IF1384.2 +052300 GO TO F-SUM-WRITE-11. IF1384.2 +052400 F-SUM-DELETE-11. IF1384.2 +052500 PERFORM DE-LETE. IF1384.2 +052600 GO TO F-SUM-WRITE-11. IF1384.2 +052700 F-SUM-WRITE-11. IF1384.2 +052800 MOVE "F-SUM-11" TO PAR-NAME. IF1384.2 +052900 PERFORM PRINT-DETAIL. IF1384.2 +053000*****************TEST (a) - COMPLEX TEST**************** IF1384.2 +053100 F-SUM-12. IF1384.2 +053200 MOVE ZERO TO WS-NUM. IF1384.2 +053300 MOVE 41.5992 TO MIN-RANGE. IF1384.2 +053400 MOVE 41.6008 TO MAX-RANGE. IF1384.2 +053500 F-SUM-TEST-12. IF1384.2 +053600 COMPUTE WS-NUM = FUNCTION SUM(2.6 + 30, 4.5 * 2). IF1384.2 +053700 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +053800 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +053900 PERFORM PASS IF1384.2 +054000 ELSE IF1384.2 +054100 MOVE WS-NUM TO COMPUTED-N IF1384.2 +054200 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +054300 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +054400 PERFORM FAIL. IF1384.2 +054500 GO TO F-SUM-WRITE-12. IF1384.2 +054600 F-SUM-DELETE-12. IF1384.2 +054700 PERFORM DE-LETE. IF1384.2 +054800 GO TO F-SUM-WRITE-12. IF1384.2 +054900 F-SUM-WRITE-12. IF1384.2 +055000 MOVE "F-SUM-12" TO PAR-NAME. IF1384.2 +055100 PERFORM PRINT-DETAIL. IF1384.2 +055200*****************TEST (b) - COMPLEX TEST**************** IF1384.2 +055300 F-SUM-13. IF1384.2 +055400 MOVE ZERO TO WS-NUM. IF1384.2 +055500 MOVE 82.7583 TO MIN-RANGE. IF1384.2 +055600 MOVE 82.7616 TO MAX-RANGE. IF1384.2 +055700 F-SUM-TEST-13. IF1384.2 +055800 COMPUTE WS-NUM = FUNCTION SUM(E, 9 * A, B / 2). IF1384.2 +055900 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +056000 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +056100 PERFORM PASS IF1384.2 +056200 ELSE IF1384.2 +056300 MOVE WS-NUM TO COMPUTED-N IF1384.2 +056400 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +056500 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +056600 PERFORM FAIL. IF1384.2 +056700 GO TO F-SUM-WRITE-13. IF1384.2 +056800 F-SUM-DELETE-13. IF1384.2 +056900 PERFORM DE-LETE. IF1384.2 +057000 GO TO F-SUM-WRITE-13. IF1384.2 +057100 F-SUM-WRITE-13. IF1384.2 +057200 MOVE "F-SUM-13" TO PAR-NAME. IF1384.2 +057300 PERFORM PRINT-DETAIL. IF1384.2 +057400*****************TEST (c) - COMPLEX TEST**************** IF1384.2 +057500 F-SUM-14. IF1384.2 +057600 MOVE ZERO TO WS-NUM. IF1384.2 +057700 MOVE 89.9982 TO MIN-RANGE. IF1384.2 +057800 MOVE 90.0018 TO MAX-RANGE. IF1384.2 +057900 F-SUM-TEST-14. IF1384.2 +058000 COMPUTE WS-NUM = FUNCTION SUM(A, B) + 78. IF1384.2 +058100 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +058200 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +058300 PERFORM PASS IF1384.2 +058400 ELSE IF1384.2 +058500 MOVE WS-NUM TO COMPUTED-N IF1384.2 +058600 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +058700 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +058800 PERFORM FAIL. IF1384.2 +058900 GO TO F-SUM-WRITE-14. IF1384.2 +059000 F-SUM-DELETE-14. IF1384.2 +059100 PERFORM DE-LETE. IF1384.2 +059200 GO TO F-SUM-WRITE-14. IF1384.2 +059300 F-SUM-WRITE-14. IF1384.2 +059400 MOVE "F-SUM-14" TO PAR-NAME. IF1384.2 +059500 PERFORM PRINT-DETAIL. IF1384.2 +059600*****************TEST (d) - COMPLEX TEST**************** IF1384.2 +059700 F-SUM-15. IF1384.2 +059800 MOVE ZERO TO WS-NUM. IF1384.2 +059900 MOVE 4.99990 TO MIN-RANGE. IF1384.2 +060000 MOVE 5.00010 TO MAX-RANGE. IF1384.2 +060100 F-SUM-TEST-15. IF1384.2 +060200 COMPUTE WS-NUM = FUNCTION SUM(A, B) + IF1384.2 +060300 FUNCTION SUM(-2.6, -4.4). IF1384.2 +060400 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +060500 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +060600 PERFORM PASS IF1384.2 +060700 ELSE IF1384.2 +060800 MOVE WS-NUM TO COMPUTED-N IF1384.2 +060900 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +061000 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +061100 PERFORM FAIL. IF1384.2 +061200 GO TO F-SUM-WRITE-15. IF1384.2 +061300 F-SUM-DELETE-15. IF1384.2 +061400 PERFORM DE-LETE. IF1384.2 +061500 GO TO F-SUM-WRITE-15. IF1384.2 +061600 F-SUM-WRITE-15. IF1384.2 +061700 MOVE "F-SUM-15" TO PAR-NAME. IF1384.2 +061800 PERFORM PRINT-DETAIL. IF1384.2 +061900*****************TEST (e) - COMPLEX TEST**************** IF1384.2 +062000 F-SUM-16. IF1384.2 +062100 MOVE ZERO TO WS-NUM. IF1384.2 +062200 MOVE 3.99992 TO MIN-RANGE. IF1384.2 +062300 MOVE 4.00008 TO MAX-RANGE. IF1384.2 +062400 F-SUM-TEST-16. IF1384.2 +062500 COMPUTE WS-NUM = IF1384.2 +062600 FUNCTION SUM(FUNCTION SUM(6.8, -6.8), 4). IF1384.2 +062700 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +062800 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +062900 PERFORM PASS IF1384.2 +063000 ELSE IF1384.2 +063100 MOVE WS-NUM TO COMPUTED-N IF1384.2 +063200 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +063300 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +063400 PERFORM FAIL. IF1384.2 +063500 GO TO F-SUM-WRITE-16. IF1384.2 +063600 F-SUM-DELETE-16. IF1384.2 +063700 PERFORM DE-LETE. IF1384.2 +063800 GO TO F-SUM-WRITE-16. IF1384.2 +063900 F-SUM-WRITE-16. IF1384.2 +064000 MOVE "F-SUM-16" TO PAR-NAME. IF1384.2 +064100 PERFORM PRINT-DETAIL. IF1384.2 +064200*****************SPECIAL PERFORM TEST********************** IF1384.2 +064300 F-SUM-17. IF1384.2 +064400 PERFORM F-SUM-TEST-17 IF1384.2 +064500 UNTIL FUNCTION SUM(ARG1, 1) > 10. IF1384.2 +064600 PERFORM PASS. IF1384.2 +064700 GO TO F-SUM-WRITE-17. IF1384.2 +064800 F-SUM-TEST-17. IF1384.2 +064900 COMPUTE ARG1 = ARG1 + 1. IF1384.2 +065000 F-SUM-DELETE-17. IF1384.2 +065100 PERFORM DE-LETE. IF1384.2 +065200 GO TO F-SUM-WRITE-17. IF1384.2 +065300 F-SUM-WRITE-17. IF1384.2 +065400 MOVE "F-SUM-17" TO PAR-NAME. IF1384.2 +065500 PERFORM PRINT-DETAIL. IF1384.2 +065600********************END OF TESTS*************** IF1384.2 +065700 CCVS-EXIT SECTION. IF1384.2 +065800 CCVS-999999. IF1384.2 +065900 GO TO CLOSE-FILES. IF1384.2 +*END-OF,IF138A +*HEADER,COBOL,IF139A +000100 IDENTIFICATION DIVISION. IF1394.2 +000200 PROGRAM-ID. IF1394.2 +000300 IF139A. IF1394.2 +000400 IF1394.2 +000500*********************************************************** IF1394.2 +000600* * IF1394.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1394.2 +000800* It contains tests for the Intrinsic Function TAN. * IF1394.2 +000900* * IF1394.2 +001000*********************************************************** IF1394.2 +001100 ENVIRONMENT DIVISION. IF1394.2 +001200 CONFIGURATION SECTION. IF1394.2 +001300 SOURCE-COMPUTER. IF1394.2 +001400 XXXXX082. IF1394.2 +001500 OBJECT-COMPUTER. IF1394.2 +001600 XXXXX083. IF1394.2 +001700 INPUT-OUTPUT SECTION. IF1394.2 +001800 FILE-CONTROL. IF1394.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1394.2 +002000 XXXXX055. IF1394.2 +002100 DATA DIVISION. IF1394.2 +002200 FILE SECTION. IF1394.2 +002300 FD PRINT-FILE. IF1394.2 +002400 01 PRINT-REC PICTURE X(120). IF1394.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1394.2 +002600 WORKING-STORAGE SECTION. IF1394.2 +002700*********************************************************** IF1394.2 +002800* Variables specific to the Intrinsic Function Test IF139A* IF1394.2 +002900*********************************************************** IF1394.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1394.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1394.2 +003200 01 C PIC S9(10) VALUE 100000. IF1394.2 +003300 01 D PIC S9(10) VALUE 1000. IF1394.2 +003400 01 PI PIC S9V9(17) VALUE 3.141592654. IF1394.2 +003500 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1394.2 +003600 01 P PIC S9(10) VALUE 1. IF1394.2 +003700 01 ARR VALUE "40537". IF1394.2 +003800 02 IND OCCURS 5 TIMES PIC 9. IF1394.2 +003900 01 TEMP PIC S9(5)V9(5). IF1394.2 +004000 01 WS-NUM PIC S9(5)V9(7). IF1394.2 +004100 01 MIN-RANGE PIC S9(5)V9(7). IF1394.2 +004200 01 MAX-RANGE PIC S9(5)V9(7). IF1394.2 +004300 01 ARG1 PIC S9(5)V9(2) VALUE 1. IF1394.2 +004400* IF1394.2 +004500********************************************************** IF1394.2 +004600* IF1394.2 +004700 01 TEST-RESULTS. IF1394.2 +004800 02 FILLER PIC X VALUE SPACE. IF1394.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1394.2 +005000 02 FILLER PIC X VALUE SPACE. IF1394.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1394.2 +005200 02 FILLER PIC X VALUE SPACE. IF1394.2 +005300 02 PAR-NAME. IF1394.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1394.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1394.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1394.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1394.2 +005800 02 RE-MARK PIC X(61). IF1394.2 +005900 01 TEST-COMPUTED. IF1394.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +006100 02 FILLER PIC X(17) VALUE IF1394.2 +006200 " COMPUTED=". IF1394.2 +006300 02 COMPUTED-X. IF1394.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1394.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1394.2 +006600 PIC -9(9).9(9). IF1394.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1394.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1394.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1394.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1394.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1394.2 +007200 04 FILLER PIC X. IF1394.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1394.2 +007400 01 TEST-CORRECT. IF1394.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1394.2 +007700 02 CORRECT-X. IF1394.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1394.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1394.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1394.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1394.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1394.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1394.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1394.2 +008500 04 FILLER PIC X. IF1394.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1394.2 +008800 01 TEST-CORRECT-MIN. IF1394.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1394.2 +009100 02 CORRECTMI-X. IF1394.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1394.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1394.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1394.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1394.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1394.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1394.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1394.2 +009900 04 FILLER PIC X. IF1394.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1394.2 +010200 01 TEST-CORRECT-MAX. IF1394.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1394.2 +010500 02 CORRECTMA-X. IF1394.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1394.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1394.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1394.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1394.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1394.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1394.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1394.2 +011300 04 FILLER PIC X. IF1394.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1394.2 +011600 01 CCVS-C-1. IF1394.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1394.2 +011800- "SS PARAGRAPH-NAME IF1394.2 +011900- " REMARKS". IF1394.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1394.2 +012100 01 CCVS-C-2. IF1394.2 +012200 02 FILLER PIC X VALUE SPACE. IF1394.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1394.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1394.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1394.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1394.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1394.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1394.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1394.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1394.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1394.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1394.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1394.2 +013800 01 CCVS-H-1. IF1394.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1394.2 +014000 02 FILLER PIC X(42) VALUE IF1394.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1394.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1394.2 +014300 01 CCVS-H-2A. IF1394.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1394.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1394.2 +014600 02 FILLER PIC XXXX VALUE IF1394.2 +014700 "4.2 ". IF1394.2 +014800 02 FILLER PIC X(28) VALUE IF1394.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1394.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1394.2 +015100 IF1394.2 +015200 01 CCVS-H-2B. IF1394.2 +015300 02 FILLER PIC X(15) VALUE IF1394.2 +015400 "TEST RESULT OF ". IF1394.2 +015500 02 TEST-ID PIC X(9). IF1394.2 +015600 02 FILLER PIC X(4) VALUE IF1394.2 +015700 " IN ". IF1394.2 +015800 02 FILLER PIC X(12) VALUE IF1394.2 +015900 " HIGH ". IF1394.2 +016000 02 FILLER PIC X(22) VALUE IF1394.2 +016100 " LEVEL VALIDATION FOR ". IF1394.2 +016200 02 FILLER PIC X(58) VALUE IF1394.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1394.2 +016400 01 CCVS-H-3. IF1394.2 +016500 02 FILLER PIC X(34) VALUE IF1394.2 +016600 " FOR OFFICIAL USE ONLY ". IF1394.2 +016700 02 FILLER PIC X(58) VALUE IF1394.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1394.2 +016900 02 FILLER PIC X(28) VALUE IF1394.2 +017000 " COPYRIGHT 1985 ". IF1394.2 +017100 01 CCVS-E-1. IF1394.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1394.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1394.2 +017400 02 ID-AGAIN PIC X(9). IF1394.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1394.2 +017600 01 CCVS-E-2. IF1394.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1394.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1394.2 +017900 02 CCVS-E-2-2. IF1394.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1394.2 +018100 03 FILLER PIC X VALUE SPACE. IF1394.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1394.2 +018300 "ERRORS ENCOUNTERED". IF1394.2 +018400 01 CCVS-E-3. IF1394.2 +018500 02 FILLER PIC X(22) VALUE IF1394.2 +018600 " FOR OFFICIAL USE ONLY". IF1394.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1394.2 +018800 02 FILLER PIC X(58) VALUE IF1394.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1394.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1394.2 +019100 02 FILLER PIC X(15) VALUE IF1394.2 +019200 " COPYRIGHT 1985". IF1394.2 +019300 01 CCVS-E-4. IF1394.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1394.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1394.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1394.2 +019700 02 FILLER PIC X(40) VALUE IF1394.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1394.2 +019900 01 XXINFO. IF1394.2 +020000 02 FILLER PIC X(19) VALUE IF1394.2 +020100 "*** INFORMATION ***". IF1394.2 +020200 02 INFO-TEXT. IF1394.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1394.2 +020400 04 XXCOMPUTED PIC X(20). IF1394.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1394.2 +020600 04 XXCORRECT PIC X(20). IF1394.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1394.2 +020800 01 HYPHEN-LINE. IF1394.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1394.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1394.2 +021100- "*****************************************". IF1394.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1394.2 +021300- "******************************". IF1394.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1394.2 +021500 "IF139A". IF1394.2 +021600 PROCEDURE DIVISION. IF1394.2 +021700 CCVS1 SECTION. IF1394.2 +021800 OPEN-FILES. IF1394.2 +021900 OPEN OUTPUT PRINT-FILE. IF1394.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1394.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1394.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1394.2 +022300 GO TO CCVS1-EXIT. IF1394.2 +022400 CLOSE-FILES. IF1394.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1394.2 +022600 TERMINATE-CCVS. IF1394.2 +022700 STOP RUN. IF1394.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1394.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1394.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1394.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1394.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1394.2 +023300 PRINT-DETAIL. IF1394.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1394.2 +023500 MOVE "." TO PARDOT-X IF1394.2 +023600 MOVE REC-CT TO DOTVALUE. IF1394.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1394.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1394.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1394.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1394.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1394.2 +024200 MOVE SPACE TO CORRECT-X. IF1394.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1394.2 +024400 MOVE SPACE TO RE-MARK. IF1394.2 +024500 HEAD-ROUTINE. IF1394.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1394.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1394.2 +025000 COLUMN-NAMES-ROUTINE. IF1394.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +025400 END-ROUTINE. IF1394.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1394.2 +025600 END-RTN-EXIT. IF1394.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +025800 END-ROUTINE-1. IF1394.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1394.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1394.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1394.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1394.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1394.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1394.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1394.2 +026600 END-ROUTINE-12. IF1394.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1394.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1394.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1394.2 +027000 ELSE IF1394.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1394.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1394.2 +027300 PERFORM WRITE-LINE. IF1394.2 +027400 END-ROUTINE-13. IF1394.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1394.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1394.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1394.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1394.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1394.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1394.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1394.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1394.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028600 WRITE-LINE. IF1394.2 +028700 ADD 1 TO RECORD-COUNT. IF1394.2 +028800Y IF RECORD-COUNT GREATER 42 IF1394.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1394.2 +029000Y MOVE SPACE TO DUMMY-RECORD IF1394.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1394.2 +029200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1394.2 +029300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1394.2 +029400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1394.2 +029500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1394.2 +029600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1394.2 +030000Y MOVE ZERO TO RECORD-COUNT. IF1394.2 +030100 PERFORM WRT-LN. IF1394.2 +030200 WRT-LN. IF1394.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1394.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1394.2 +030500 BLANK-LINE-PRINT. IF1394.2 +030600 PERFORM WRT-LN. IF1394.2 +030700 FAIL-ROUTINE. IF1394.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1394.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1394.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1394.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1394.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1394.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1394.2 +031500 GO TO FAIL-ROUTINE-EX. IF1394.2 +031600 FAIL-ROUTINE-WRITE. IF1394.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1394.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1394.2 +031900 CORMA-ANSI-REFERENCE. IF1394.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1394.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1394.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1394.2 +032300 ELSE IF1394.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1394.2 +032500 PERFORM WRITE-LINE. IF1394.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1394.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1394.2 +032800 BAIL-OUT. IF1394.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1394.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1394.2 +033100 BAIL-OUT-WRITE. IF1394.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1394.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1394.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1394.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1394.2 +033700 BAIL-OUT-EX. EXIT. IF1394.2 +033800 CCVS1-EXIT. IF1394.2 +033900 EXIT. IF1394.2 +034000******************************************************** IF1394.2 +034100* * IF1394.2 +034200* Intrinsic Function Tests IF139A - TAN * IF1394.2 +034300* * IF1394.2 +034400******************************************************** IF1394.2 +034500 SECT-IF139A SECTION. IF1394.2 +034600 F-TAN-INFO. IF1394.2 +034700 MOVE "See ref. A-71 2.43" TO ANSI-REFERENCE. IF1394.2 +034800 MOVE "TAN Function" TO FEATURE. IF1394.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1394.2 +035000 F-TAN-01. IF1394.2 +035100 MOVE ZERO TO WS-NUM. IF1394.2 +035200 MOVE -0.000020 TO MIN-RANGE. IF1394.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1394.2 +035400 F-TAN-TEST-01. IF1394.2 +035500 COMPUTE WS-NUM = FUNCTION TAN(0). IF1394.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +035800 PERFORM PASS IF1394.2 +035900 ELSE IF1394.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1394.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +036300 PERFORM FAIL. IF1394.2 +036400 GO TO F-TAN-WRITE-01. IF1394.2 +036500 F-TAN-DELETE-01. IF1394.2 +036600 PERFORM DE-LETE. IF1394.2 +036700 GO TO F-TAN-WRITE-01. IF1394.2 +036800 F-TAN-WRITE-01. IF1394.2 +036900 MOVE "F-TAN-01" TO PAR-NAME. IF1394.2 +037000 PERFORM PRINT-DETAIL. IF1394.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1394.2 +037200 F-TAN-02. IF1394.2 +037300 EVALUATE FUNCTION TAN(PI) IF1394.2 +037400 WHEN -0.000020 THRU 0.000020 IF1394.2 +037500 PERFORM PASS IF1394.2 +037600 WHEN OTHER IF1394.2 +037700 PERFORM FAIL. IF1394.2 +037800 GO TO F-TAN-WRITE-02. IF1394.2 +037900 F-TAN-DELETE-02. IF1394.2 +038000 PERFORM DE-LETE. IF1394.2 +038100 GO TO F-TAN-WRITE-02. IF1394.2 +038200 F-TAN-WRITE-02. IF1394.2 +038300 MOVE "F-TAN-02" TO PAR-NAME. IF1394.2 +038400 PERFORM PRINT-DETAIL. IF1394.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1394.2 +038600 F-TAN-03. IF1394.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1394.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1394.2 +038900 F-TAN-TEST-03. IF1394.2 +039000 IF (FUNCTION TAN(MINUSPI) >= MIN-RANGE) AND IF1394.2 +039100 (FUNCTION TAN(MINUSPI) <= MAX-RANGE) THEN IF1394.2 +039200 PERFORM PASS IF1394.2 +039300 ELSE IF1394.2 +039400 PERFORM FAIL. IF1394.2 +039500 GO TO F-TAN-WRITE-03. IF1394.2 +039600 F-TAN-DELETE-03. IF1394.2 +039700 PERFORM DE-LETE. IF1394.2 +039800 GO TO F-TAN-WRITE-03. IF1394.2 +039900 F-TAN-WRITE-03. IF1394.2 +040000 MOVE "F-TAN-03" TO PAR-NAME. IF1394.2 +040100 PERFORM PRINT-DETAIL. IF1394.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1394.2 +040300 F-TAN-04. IF1394.2 +040400 MOVE ZERO TO WS-NUM. IF1394.2 +040500 MOVE 0.000999 TO MIN-RANGE. IF1394.2 +040600 MOVE 0.001000 TO MAX-RANGE. IF1394.2 +040700 F-TAN-TEST-04. IF1394.2 +040800 COMPUTE WS-NUM = FUNCTION TAN(.001). IF1394.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +041100 PERFORM PASS IF1394.2 +041200 ELSE IF1394.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +041600 PERFORM FAIL. IF1394.2 +041700 GO TO F-TAN-WRITE-04. IF1394.2 +041800 F-TAN-DELETE-04. IF1394.2 +041900 PERFORM DE-LETE. IF1394.2 +042000 GO TO F-TAN-WRITE-04. IF1394.2 +042100 F-TAN-WRITE-04. IF1394.2 +042200 MOVE "F-TAN-04" TO PAR-NAME. IF1394.2 +042300 PERFORM PRINT-DETAIL. IF1394.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1394.2 +042500 F-TAN-05. IF1394.2 +042600 MOVE ZERO TO WS-NUM. IF1394.2 +042700 MOVE 0.000089 TO MIN-RANGE. IF1394.2 +042800 MOVE 0.000090 TO MAX-RANGE. IF1394.2 +042900 F-TAN-TEST-05. IF1394.2 +043000 COMPUTE WS-NUM = FUNCTION TAN(.00009). IF1394.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +043300 PERFORM PASS IF1394.2 +043400 ELSE IF1394.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +043800 PERFORM FAIL. IF1394.2 +043900 GO TO F-TAN-WRITE-05. IF1394.2 +044000 F-TAN-DELETE-05. IF1394.2 +044100 PERFORM DE-LETE. IF1394.2 +044200 GO TO F-TAN-WRITE-05. IF1394.2 +044300 F-TAN-WRITE-05. IF1394.2 +044400 MOVE "F-TAN-05" TO PAR-NAME. IF1394.2 +044500 PERFORM PRINT-DETAIL. IF1394.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1394.2 +044700 F-TAN-06. IF1394.2 +044800 MOVE ZERO TO WS-NUM. IF1394.2 +044900 MOVE -0.000040 TO MIN-RANGE. IF1394.2 +045000 MOVE -0.000039 TO MAX-RANGE. IF1394.2 +045100 F-TAN-TEST-06. IF1394.2 +045200 COMPUTE WS-NUM = FUNCTION TAN(A). IF1394.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +045500 PERFORM PASS IF1394.2 +045600 ELSE IF1394.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +046000 PERFORM FAIL. IF1394.2 +046100 GO TO F-TAN-WRITE-06. IF1394.2 +046200 F-TAN-DELETE-06. IF1394.2 +046300 PERFORM DE-LETE. IF1394.2 +046400 GO TO F-TAN-WRITE-06. IF1394.2 +046500 F-TAN-WRITE-06. IF1394.2 +046600 MOVE "F-TAN-06" TO PAR-NAME. IF1394.2 +046700 PERFORM PRINT-DETAIL. IF1394.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1394.2 +046900 F-TAN-07. IF1394.2 +047000 MOVE ZERO TO WS-NUM. IF1394.2 +047100 MOVE 1.15780 TO MIN-RANGE. IF1394.2 +047200 MOVE 1.15784 TO MAX-RANGE. IF1394.2 +047300 F-TAN-TEST-07. IF1394.2 +047400 COMPUTE WS-NUM = FUNCTION TAN(IND(P)). IF1394.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +047700 PERFORM PASS IF1394.2 +047800 ELSE IF1394.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +048200 PERFORM FAIL. IF1394.2 +048300 GO TO F-TAN-WRITE-07. IF1394.2 +048400 F-TAN-DELETE-07. IF1394.2 +048500 PERFORM DE-LETE. IF1394.2 +048600 GO TO F-TAN-WRITE-07. IF1394.2 +048700 F-TAN-WRITE-07. IF1394.2 +048800 MOVE "F-TAN-07" TO PAR-NAME. IF1394.2 +048900 PERFORM PRINT-DETAIL. IF1394.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1394.2 +049100 F-TAN-08. IF1394.2 +049200 MOVE ZERO TO WS-NUM. IF1394.2 +049300 MOVE 0.871430 TO MIN-RANGE. IF1394.2 +049400 MOVE 0.871464 TO MAX-RANGE. IF1394.2 +049500 F-TAN-TEST-08. IF1394.2 +049600 COMPUTE WS-NUM = FUNCTION TAN(IND(5)). IF1394.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +049900 PERFORM PASS IF1394.2 +050000 ELSE IF1394.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +050400 PERFORM FAIL. IF1394.2 +050500 GO TO F-TAN-WRITE-08. IF1394.2 +050600 F-TAN-DELETE-08. IF1394.2 +050700 PERFORM DE-LETE. IF1394.2 +050800 GO TO F-TAN-WRITE-08. IF1394.2 +050900 F-TAN-WRITE-08. IF1394.2 +051000 MOVE "F-TAN-08" TO PAR-NAME. IF1394.2 +051100 PERFORM PRINT-DETAIL. IF1394.2 +051200*****************TEST (a) - COMPLEX TEST**************** IF1394.2 +051300 F-TAN-09. IF1394.2 +051400 MOVE ZERO TO WS-NUM. IF1394.2 +051500 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +051600 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +051700 F-TAN-TEST-09. IF1394.2 +051800 COMPUTE WS-NUM = FUNCTION TAN(PI / 4). IF1394.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +052100 PERFORM PASS IF1394.2 +052200 ELSE IF1394.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +052600 PERFORM FAIL. IF1394.2 +052700 GO TO F-TAN-WRITE-09. IF1394.2 +052800 F-TAN-DELETE-09. IF1394.2 +052900 PERFORM DE-LETE. IF1394.2 +053000 GO TO F-TAN-WRITE-09. IF1394.2 +053100 F-TAN-WRITE-09. IF1394.2 +053200 MOVE "F-TAN-09" TO PAR-NAME. IF1394.2 +053300 PERFORM PRINT-DETAIL. IF1394.2 +053400*****************TEST (b) - COMPLEX TEST**************** IF1394.2 +053500 F-TAN-10. IF1394.2 +053600 MOVE ZERO TO WS-NUM. IF1394.2 +053700 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +053800 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +053900 F-TAN-TEST-10. IF1394.2 +054000 COMPUTE WS-NUM = FUNCTION TAN((3 * PI) / 4). IF1394.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +054300 PERFORM PASS IF1394.2 +054400 ELSE IF1394.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +054800 PERFORM FAIL. IF1394.2 +054900 GO TO F-TAN-WRITE-10. IF1394.2 +055000 F-TAN-DELETE-10. IF1394.2 +055100 PERFORM DE-LETE. IF1394.2 +055200 GO TO F-TAN-WRITE-10. IF1394.2 +055300 F-TAN-WRITE-10. IF1394.2 +055400 MOVE "F-TAN-10" TO PAR-NAME. IF1394.2 +055500 PERFORM PRINT-DETAIL. IF1394.2 +055600*****************TEST (c) - COMPLEX TEST**************** IF1394.2 +055700 F-TAN-11. IF1394.2 +055800 MOVE ZERO TO WS-NUM. IF1394.2 +055900 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +056000 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +056100 F-TAN-TEST-11. IF1394.2 +056200 COMPUTE WS-NUM = FUNCTION TAN((5 * PI) / 4). IF1394.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +056500 PERFORM PASS IF1394.2 +056600 ELSE IF1394.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +057000 PERFORM FAIL. IF1394.2 +057100 GO TO F-TAN-WRITE-11. IF1394.2 +057200 F-TAN-DELETE-11. IF1394.2 +057300 PERFORM DE-LETE. IF1394.2 +057400 GO TO F-TAN-WRITE-11. IF1394.2 +057500 F-TAN-WRITE-11. IF1394.2 +057600 MOVE "F-TAN-11" TO PAR-NAME. IF1394.2 +057700 PERFORM PRINT-DETAIL. IF1394.2 +057800*****************TEST (d) - COMPLEX TEST**************** IF1394.2 +057900 F-TAN-12. IF1394.2 +058000 MOVE ZERO TO WS-NUM. IF1394.2 +058100 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +058200 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +058300 F-TAN-TEST-12. IF1394.2 +058400 COMPUTE WS-NUM = FUNCTION TAN((7 * PI) / 4). IF1394.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +058700 PERFORM PASS IF1394.2 +058800 ELSE IF1394.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +059200 PERFORM FAIL. IF1394.2 +059300 GO TO F-TAN-WRITE-12. IF1394.2 +059400 F-TAN-DELETE-12. IF1394.2 +059500 PERFORM DE-LETE. IF1394.2 +059600 GO TO F-TAN-WRITE-12. IF1394.2 +059700 F-TAN-WRITE-12. IF1394.2 +059800 MOVE "F-TAN-12" TO PAR-NAME. IF1394.2 +059900 PERFORM PRINT-DETAIL. IF1394.2 +060000*****************TEST (e) - COMPLEX TEST**************** IF1394.2 +060100 F-TAN-13. IF1394.2 +060200 MOVE ZERO TO WS-NUM. IF1394.2 +060300 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +060400 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +060500 F-TAN-TEST-13. IF1394.2 +060600 COMPUTE WS-NUM = FUNCTION TAN(MINUSPI / 4). IF1394.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +060900 PERFORM PASS IF1394.2 +061000 ELSE IF1394.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +061400 PERFORM FAIL. IF1394.2 +061500 GO TO F-TAN-WRITE-13. IF1394.2 +061600 F-TAN-DELETE-13. IF1394.2 +061700 PERFORM DE-LETE. IF1394.2 +061800 GO TO F-TAN-WRITE-13. IF1394.2 +061900 F-TAN-WRITE-13. IF1394.2 +062000 MOVE "F-TAN-13" TO PAR-NAME. IF1394.2 +062100 PERFORM PRINT-DETAIL. IF1394.2 +062200*****************TEST (f) - COMPLEX TEST**************** IF1394.2 +062300 F-TAN-14. IF1394.2 +062400 MOVE ZERO TO WS-NUM. IF1394.2 +062500 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +062600 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +062700 F-TAN-TEST-14. IF1394.2 +062800 COMPUTE WS-NUM = FUNCTION TAN((3 * MINUSPI) / 4). IF1394.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +063100 PERFORM PASS IF1394.2 +063200 ELSE IF1394.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +063600 PERFORM FAIL. IF1394.2 +063700 GO TO F-TAN-WRITE-14. IF1394.2 +063800 F-TAN-DELETE-14. IF1394.2 +063900 PERFORM DE-LETE. IF1394.2 +064000 GO TO F-TAN-WRITE-14. IF1394.2 +064100 F-TAN-WRITE-14. IF1394.2 +064200 MOVE "F-TAN-14" TO PAR-NAME. IF1394.2 +064300 PERFORM PRINT-DETAIL. IF1394.2 +064400*****************TEST (g) - COMPLEX TEST**************** IF1394.2 +064500 F-TAN-15. IF1394.2 +064600 MOVE ZERO TO WS-NUM. IF1394.2 +064700 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +064800 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +064900 F-TAN-TEST-15. IF1394.2 +065000 COMPUTE WS-NUM = FUNCTION TAN((5 * MINUSPI) / 4). IF1394.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +065300 PERFORM PASS IF1394.2 +065400 ELSE IF1394.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +065800 PERFORM FAIL. IF1394.2 +065900 GO TO F-TAN-WRITE-15. IF1394.2 +066000 F-TAN-DELETE-15. IF1394.2 +066100 PERFORM DE-LETE. IF1394.2 +066200 GO TO F-TAN-WRITE-15. IF1394.2 +066300 F-TAN-WRITE-15. IF1394.2 +066400 MOVE "F-TAN-15" TO PAR-NAME. IF1394.2 +066500 PERFORM PRINT-DETAIL. IF1394.2 +066600*****************TEST (h) - COMPLEX TEST**************** IF1394.2 +066700 F-TAN-16. IF1394.2 +066800 MOVE ZERO TO WS-NUM. IF1394.2 +066900 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +067000 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +067100 F-TAN-TEST-16. IF1394.2 +067200 COMPUTE WS-NUM = FUNCTION TAN((7 * MINUSPI) / 4). IF1394.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +067500 PERFORM PASS IF1394.2 +067600 ELSE IF1394.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +068000 PERFORM FAIL. IF1394.2 +068100 GO TO F-TAN-WRITE-16. IF1394.2 +068200 F-TAN-DELETE-16. IF1394.2 +068300 PERFORM DE-LETE. IF1394.2 +068400 GO TO F-TAN-WRITE-16. IF1394.2 +068500 F-TAN-WRITE-16. IF1394.2 +068600 MOVE "F-TAN-16" TO PAR-NAME. IF1394.2 +068700 PERFORM PRINT-DETAIL. IF1394.2 +068800*****************TEST (i) - COMPLEX TEST**************** IF1394.2 +068900 F-TAN-17. IF1394.2 +069000 MOVE ZERO TO WS-NUM. IF1394.2 +069100 MOVE 0.997961 TO MIN-RANGE. IF1394.2 +069200 MOVE 0.998041 TO MAX-RANGE. IF1394.2 +069300 F-TAN-TEST-17. IF1394.2 +069400 COMPUTE WS-NUM = FUNCTION TAN((PI / 4) - .001). IF1394.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +069700 PERFORM PASS IF1394.2 +069800 ELSE IF1394.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +070200 PERFORM FAIL. IF1394.2 +070300 GO TO F-TAN-WRITE-17. IF1394.2 +070400 F-TAN-DELETE-17. IF1394.2 +070500 PERFORM DE-LETE. IF1394.2 +070600 GO TO F-TAN-WRITE-17. IF1394.2 +070700 F-TAN-WRITE-17. IF1394.2 +070800 MOVE "F-TAN-17" TO PAR-NAME. IF1394.2 +070900 PERFORM PRINT-DETAIL. IF1394.2 +071000*****************TEST (k) - COMPLEX TEST**************** IF1394.2 +071100 F-TAN-19. IF1394.2 +071200 MOVE ZERO TO WS-NUM. IF1394.2 +071300 MOVE 0.0055554 TO MIN-RANGE. IF1394.2 +071400 MOVE 0.0055558 TO MAX-RANGE. IF1394.2 +071500 F-TAN-TEST-19. IF1394.2 +071600 COMPUTE WS-NUM = FUNCTION TAN(1 / 180). IF1394.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +071900 PERFORM PASS IF1394.2 +072000 ELSE IF1394.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +072400 PERFORM FAIL. IF1394.2 +072500 GO TO F-TAN-WRITE-19. IF1394.2 +072600 F-TAN-DELETE-19. IF1394.2 +072700 PERFORM DE-LETE. IF1394.2 +072800 GO TO F-TAN-WRITE-19. IF1394.2 +072900 F-TAN-WRITE-19. IF1394.2 +073000 MOVE "F-TAN-19" TO PAR-NAME. IF1394.2 +073100 PERFORM PRINT-DETAIL. IF1394.2 +073200*****************TEST (l) - COMPLEX TEST**************** IF1394.2 +073300 F-TAN-20. IF1394.2 +073400 MOVE ZERO TO WS-NUM. IF1394.2 +073500 MOVE 0.965649 TO MIN-RANGE. IF1394.2 +073600 MOVE 0.965727 TO MAX-RANGE. IF1394.2 +073700 F-TAN-TEST-20. IF1394.2 +073800 COMPUTE WS-NUM = FUNCTION TAN((PI / 4) - (PI / 180)). IF1394.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +074100 PERFORM PASS IF1394.2 +074200 ELSE IF1394.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +074600 PERFORM FAIL. IF1394.2 +074700 GO TO F-TAN-WRITE-20. IF1394.2 +074800 F-TAN-DELETE-20. IF1394.2 +074900 PERFORM DE-LETE. IF1394.2 +075000 GO TO F-TAN-WRITE-20. IF1394.2 +075100 F-TAN-WRITE-20. IF1394.2 +075200 MOVE "F-TAN-20" TO PAR-NAME. IF1394.2 +075300 PERFORM PRINT-DETAIL. IF1394.2 +075400*****************TEST (m) - COMPLEX TEST**************** IF1394.2 +075500 F-TAN-21. IF1394.2 +075600 MOVE ZERO TO WS-NUM. IF1394.2 +075700 MOVE 0.034919 TO MIN-RANGE. IF1394.2 +075800 MOVE 0.034921 TO MAX-RANGE. IF1394.2 +075900 F-TAN-TEST-21. IF1394.2 +076000 COMPUTE WS-NUM = FUNCTION TAN(PI + ((2 * PI) / 180)). IF1394.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +076300 PERFORM PASS IF1394.2 +076400 ELSE IF1394.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +076800 PERFORM FAIL. IF1394.2 +076900 GO TO F-TAN-WRITE-21. IF1394.2 +077000 F-TAN-DELETE-21. IF1394.2 +077100 PERFORM DE-LETE. IF1394.2 +077200 GO TO F-TAN-WRITE-21. IF1394.2 +077300 F-TAN-WRITE-21. IF1394.2 +077400 MOVE "F-TAN-21" TO PAR-NAME. IF1394.2 +077500 PERFORM PRINT-DETAIL. IF1394.2 +077600*****************TEST (n) - COMPLEX TEST**************** IF1394.2 +077700 F-TAN-22. IF1394.2 +077800 MOVE ZERO TO WS-NUM. IF1394.2 +077900 MOVE -0.988990 TO MIN-RANGE. IF1394.2 +078000 MOVE -0.988910 TO MAX-RANGE. IF1394.2 +078100 F-TAN-TEST-22. IF1394.2 +078200 COMPUTE WS-NUM = FUNCTION TAN(((PI * 3) / 4) + (1 / 180)). IF1394.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +078500 PERFORM PASS IF1394.2 +078600 ELSE IF1394.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +079000 PERFORM FAIL. IF1394.2 +079100 GO TO F-TAN-WRITE-22. IF1394.2 +079200 F-TAN-DELETE-22. IF1394.2 +079300 PERFORM DE-LETE. IF1394.2 +079400 GO TO F-TAN-WRITE-22. IF1394.2 +079500 F-TAN-WRITE-22. IF1394.2 +079600 MOVE "F-TAN-22" TO PAR-NAME. IF1394.2 +079700 PERFORM PRINT-DETAIL. IF1394.2 +079800*****************TEST (o) - COMPLEX TEST**************** IF1394.2 +079900 F-TAN-23. IF1394.2 +080000 MOVE ZERO TO WS-NUM. IF1394.2 +080100 MOVE 0.977982 TO MIN-RANGE. IF1394.2 +080200 MOVE 0.978060 TO MAX-RANGE. IF1394.2 +080300 F-TAN-TEST-23. IF1394.2 +080400 COMPUTE WS-NUM = FUNCTION TAN(((PI * 5) / 4) - (2 / 180)). IF1394.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +080700 PERFORM PASS IF1394.2 +080800 ELSE IF1394.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +081200 PERFORM FAIL. IF1394.2 +081300 GO TO F-TAN-WRITE-23. IF1394.2 +081400 F-TAN-DELETE-23. IF1394.2 +081500 PERFORM DE-LETE. IF1394.2 +081600 GO TO F-TAN-WRITE-23. IF1394.2 +081700 F-TAN-WRITE-23. IF1394.2 +081800 MOVE "F-TAN-23" TO PAR-NAME. IF1394.2 +081900 PERFORM PRINT-DETAIL. IF1394.2 +082000*****************TEST (p) - COMPLEX TEST**************** IF1394.2 +082100 F-TAN-24. IF1394.2 +082200 MOVE ZERO TO WS-NUM. IF1394.2 +082300 MOVE -2.18512 TO MIN-RANGE. IF1394.2 +082400 MOVE -2.18494 TO MAX-RANGE. IF1394.2 +082500 F-TAN-TEST-24. IF1394.2 +082600 COMPUTE WS-NUM = FUNCTION TAN(4 / 2). IF1394.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +082900 PERFORM PASS IF1394.2 +083000 ELSE IF1394.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +083400 PERFORM FAIL. IF1394.2 +083500 GO TO F-TAN-WRITE-24. IF1394.2 +083600 F-TAN-DELETE-24. IF1394.2 +083700 PERFORM DE-LETE. IF1394.2 +083800 GO TO F-TAN-WRITE-24. IF1394.2 +083900 F-TAN-WRITE-24. IF1394.2 +084000 MOVE "F-TAN-24" TO PAR-NAME. IF1394.2 +084100 PERFORM PRINT-DETAIL. IF1394.2 +084200*****************TEST (q) - COMPLEX TEST**************** IF1394.2 +084300 F-TAN-25. IF1394.2 +084400 MOVE ZERO TO WS-NUM. IF1394.2 +084500 MOVE 14.1008 TO MIN-RANGE. IF1394.2 +084600 MOVE 14.1020 TO MAX-RANGE. IF1394.2 +084700 F-TAN-TEST-25. IF1394.2 +084800 COMPUTE WS-NUM = FUNCTION TAN(3 / 2). IF1394.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +085100 PERFORM PASS IF1394.2 +085200 ELSE IF1394.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +085600 PERFORM FAIL. IF1394.2 +085700 GO TO F-TAN-WRITE-25. IF1394.2 +085800 F-TAN-DELETE-25. IF1394.2 +085900 PERFORM DE-LETE. IF1394.2 +086000 GO TO F-TAN-WRITE-25. IF1394.2 +086100 F-TAN-WRITE-25. IF1394.2 +086200 MOVE "F-TAN-25" TO PAR-NAME. IF1394.2 +086300 PERFORM PRINT-DETAIL. IF1394.2 +086400*****************TEST (s) - COMPLEX TEST**************** IF1394.2 +086500 F-TAN-27. IF1394.2 +086600 MOVE ZERO TO WS-NUM. IF1394.2 +086700 MOVE 0.648334 TO MIN-RANGE. IF1394.2 +086800 MOVE 0.648386 TO MAX-RANGE. IF1394.2 +086900 F-TAN-TEST-27. IF1394.2 +087000 COMPUTE WS-NUM = FUNCTION TAN(D / 100). IF1394.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +087300 PERFORM PASS IF1394.2 +087400 ELSE IF1394.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +087800 PERFORM FAIL. IF1394.2 +087900 GO TO F-TAN-WRITE-27. IF1394.2 +088000 F-TAN-DELETE-27. IF1394.2 +088100 PERFORM DE-LETE. IF1394.2 +088200 GO TO F-TAN-WRITE-27. IF1394.2 +088300 F-TAN-WRITE-27. IF1394.2 +088400 MOVE "F-TAN-27" TO PAR-NAME. IF1394.2 +088500 PERFORM PRINT-DETAIL. IF1394.2 +088600*****************TEST (t) - COMPLEX TEST**************** IF1394.2 +088700 F-TAN-28. IF1394.2 +088800 MOVE ZERO TO WS-NUM. IF1394.2 +088900 MOVE 0.017454 TO MIN-RANGE. IF1394.2 +089000 MOVE 0.017456 TO MAX-RANGE. IF1394.2 +089100 F-TAN-TEST-28. IF1394.2 +089200 COMPUTE WS-NUM = FUNCTION TAN(PI / 180). IF1394.2 +089300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +089400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +089500 PERFORM PASS IF1394.2 +089600 ELSE IF1394.2 +089700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +089800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +089900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +090000 PERFORM FAIL. IF1394.2 +090100 GO TO F-TAN-WRITE-28. IF1394.2 +090200 F-TAN-DELETE-28. IF1394.2 +090300 PERFORM DE-LETE. IF1394.2 +090400 GO TO F-TAN-WRITE-28. IF1394.2 +090500 F-TAN-WRITE-28. IF1394.2 +090600 MOVE "F-TAN-28" TO PAR-NAME. IF1394.2 +090700 PERFORM PRINT-DETAIL. IF1394.2 +090800*****************TEST (u) - COMPLEX TEST**************** IF1394.2 +090900 F-TAN-29. IF1394.2 +091000 MOVE ZERO TO WS-NUM. IF1394.2 +091100 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +091200 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +091300 F-TAN-TEST-29. IF1394.2 +091400 COMPUTE WS-NUM = FUNCTION TAN(PI) + 1. IF1394.2 +091500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +091600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +091700 PERFORM PASS IF1394.2 +091800 ELSE IF1394.2 +091900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +092000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +092100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +092200 PERFORM FAIL. IF1394.2 +092300 GO TO F-TAN-WRITE-29. IF1394.2 +092400 F-TAN-DELETE-29. IF1394.2 +092500 PERFORM DE-LETE. IF1394.2 +092600 GO TO F-TAN-WRITE-29. IF1394.2 +092700 F-TAN-WRITE-29. IF1394.2 +092800 MOVE "F-TAN-29" TO PAR-NAME. IF1394.2 +092900 PERFORM PRINT-DETAIL. IF1394.2 +093000*****************TEST (v) - COMPLEX TEST**************** IF1394.2 +093100 F-TAN-30. IF1394.2 +093200 MOVE ZERO TO WS-NUM. IF1394.2 +093300 MOVE 1.41786 TO MIN-RANGE. IF1394.2 +093400 MOVE 1.41798 TO MAX-RANGE. IF1394.2 +093500 F-TAN-TEST-30. IF1394.2 +093600 COMPUTE WS-NUM = FUNCTION TAN(FUNCTION TAN(2)). IF1394.2 +093700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +093800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +093900 PERFORM PASS IF1394.2 +094000 ELSE IF1394.2 +094100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +094200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +094300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +094400 PERFORM FAIL. IF1394.2 +094500 GO TO F-TAN-WRITE-30. IF1394.2 +094600 F-TAN-DELETE-30. IF1394.2 +094700 PERFORM DE-LETE. IF1394.2 +094800 GO TO F-TAN-WRITE-30. IF1394.2 +094900 F-TAN-WRITE-30. IF1394.2 +095000 MOVE "F-TAN-30" TO PAR-NAME. IF1394.2 +095100 PERFORM PRINT-DETAIL. IF1394.2 +095200*****************TEST (w) - COMPLEX TEST**************** IF1394.2 +095300 F-TAN-31. IF1394.2 +095400 MOVE ZERO TO WS-NUM. IF1394.2 +095500 MOVE -0.000040 TO MIN-RANGE. IF1394.2 +095600 MOVE 0.000040 TO MAX-RANGE. IF1394.2 +095700 F-TAN-TEST-31. IF1394.2 +095800 COMPUTE WS-NUM = FUNCTION TAN(PI / 3) + IF1394.2 +095900 FUNCTION TAN(MINUSPI / 3). IF1394.2 +096000 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +096100 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +096200 PERFORM PASS IF1394.2 +096300 ELSE IF1394.2 +096400 MOVE WS-NUM TO COMPUTED-N IF1394.2 +096500 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +096600 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +096700 PERFORM FAIL. IF1394.2 +096800 GO TO F-TAN-WRITE-31. IF1394.2 +096900 F-TAN-DELETE-31. IF1394.2 +097000 PERFORM DE-LETE. IF1394.2 +097100 GO TO F-TAN-WRITE-31. IF1394.2 +097200 F-TAN-WRITE-31. IF1394.2 +097300 MOVE "F-TAN-31" TO PAR-NAME. IF1394.2 +097400 PERFORM PRINT-DETAIL. IF1394.2 +097500*****************SPECIAL PERFORM TEST********************** IF1394.2 +097600 F-TAN-32. IF1394.2 +097700 PERFORM F-TAN-TEST-32 IF1394.2 +097800 UNTIL FUNCTION TAN(ARG1) < 0. IF1394.2 +097900 PERFORM PASS. IF1394.2 +098000 GO TO F-TAN-WRITE-32. IF1394.2 +098100 F-TAN-TEST-32. IF1394.2 +098200 COMPUTE ARG1 = ARG1 - 0.25. IF1394.2 +098300 F-TAN-DELETE-32. IF1394.2 +098400 PERFORM DE-LETE. IF1394.2 +098500 GO TO F-TAN-WRITE-32. IF1394.2 +098600 F-TAN-WRITE-32. IF1394.2 +098700 MOVE "F-TAN-32" TO PAR-NAME. IF1394.2 +098800 PERFORM PRINT-DETAIL. IF1394.2 +098900********************END OF TESTS*************** IF1394.2 +099000 CCVS-EXIT SECTION. IF1394.2 +099100 CCVS-999999. IF1394.2 +099200 GO TO CLOSE-FILES. IF1394.2 +*END-OF,IF139A +*HEADER,COBOL,IF140A +000100 IDENTIFICATION DIVISION. IF1404.2 +000200 PROGRAM-ID. IF1404.2 +000300 IF140A. IF1404.2 +000400 IF1404.2 +000500*********************************************************** IF1404.2 +000600* * IF1404.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1404.2 +000800* It contains tests for the Intrinsic Function * IF1404.2 +000900* UPPER-CASE. * IF1404.2 +001000* * IF1404.2 +001100*********************************************************** IF1404.2 +001200 ENVIRONMENT DIVISION. IF1404.2 +001300 CONFIGURATION SECTION. IF1404.2 +001400 SOURCE-COMPUTER. IF1404.2 +001500 XXXXX082. IF1404.2 +001600 OBJECT-COMPUTER. IF1404.2 +001700 XXXXX083. IF1404.2 +001800 INPUT-OUTPUT SECTION. IF1404.2 +001900 FILE-CONTROL. IF1404.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1404.2 +002100 XXXXX055. IF1404.2 +002200 DATA DIVISION. IF1404.2 +002300 FILE SECTION. IF1404.2 +002400 FD PRINT-FILE. IF1404.2 +002500 01 PRINT-REC PICTURE X(120). IF1404.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1404.2 +002700 WORKING-STORAGE SECTION. IF1404.2 +002800*********************************************************** IF1404.2 +002900* Variables specific to the Intrinsic Function Test IF140A* IF1404.2 +003000*********************************************************** IF1404.2 +003100 01 A PIC A(10) VALUE "tumble". IF1404.2 +003200 01 B PIC A(10) VALUE "WEED". IF1404.2 +003300 01 C PIC X(10) VALUE "Was". IF1404.2 +003400 01 D PIC X(10) VALUE "4". IF1404.2 +003500 01 E PIC X(10) VALUE "And4". IF1404.2 +003600 01 TEMP PIC S9(10). IF1404.2 +003700 01 WS-ANUM PIC X(10). IF1404.2 +003800* IF1404.2 +003900********************************************************** IF1404.2 +004000* IF1404.2 +004100 01 TEST-RESULTS. IF1404.2 +004200 02 FILLER PIC X VALUE SPACE. IF1404.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1404.2 +004400 02 FILLER PIC X VALUE SPACE. IF1404.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1404.2 +004600 02 FILLER PIC X VALUE SPACE. IF1404.2 +004700 02 PAR-NAME. IF1404.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1404.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1404.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1404.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1404.2 +005200 02 RE-MARK PIC X(61). IF1404.2 +005300 01 TEST-COMPUTED. IF1404.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1404.2 +005500 02 FILLER PIC X(17) VALUE IF1404.2 +005600 " COMPUTED=". IF1404.2 +005700 02 COMPUTED-X. IF1404.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1404.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1404.2 +006000 PIC -9(9).9(9). IF1404.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1404.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1404.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1404.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1404.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1404.2 +006600 04 FILLER PIC X. IF1404.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1404.2 +006800 01 TEST-CORRECT. IF1404.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1404.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1404.2 +007100 02 CORRECT-X. IF1404.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1404.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1404.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1404.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1404.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1404.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1404.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1404.2 +007900 04 FILLER PIC X. IF1404.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1404.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1404.2 +008200 01 CCVS-C-1. IF1404.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1404.2 +008400- "SS PARAGRAPH-NAME IF1404.2 +008500- " REMARKS". IF1404.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1404.2 +008700 01 CCVS-C-2. IF1404.2 +008800 02 FILLER PIC X VALUE SPACE. IF1404.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1404.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1404.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1404.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1404.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1404.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1404.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1404.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1404.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1404.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1404.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1404.2 +010400 01 CCVS-H-1. IF1404.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1404.2 +010600 02 FILLER PIC X(42) VALUE IF1404.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1404.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1404.2 +010900 01 CCVS-H-2A. IF1404.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1404.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1404.2 +011200 02 FILLER PIC XXXX VALUE IF1404.2 +011300 "4.2 ". IF1404.2 +011400 02 FILLER PIC X(28) VALUE IF1404.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1404.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1404.2 +011700 IF1404.2 +011800 01 CCVS-H-2B. IF1404.2 +011900 02 FILLER PIC X(15) VALUE IF1404.2 +012000 "TEST RESULT OF ". IF1404.2 +012100 02 TEST-ID PIC X(9). IF1404.2 +012200 02 FILLER PIC X(4) VALUE IF1404.2 +012300 " IN ". IF1404.2 +012400 02 FILLER PIC X(12) VALUE IF1404.2 +012500 " HIGH ". IF1404.2 +012600 02 FILLER PIC X(22) VALUE IF1404.2 +012700 " LEVEL VALIDATION FOR ". IF1404.2 +012800 02 FILLER PIC X(58) VALUE IF1404.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1404.2 +013000 01 CCVS-H-3. IF1404.2 +013100 02 FILLER PIC X(34) VALUE IF1404.2 +013200 " FOR OFFICIAL USE ONLY ". IF1404.2 +013300 02 FILLER PIC X(58) VALUE IF1404.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1404.2 +013500 02 FILLER PIC X(28) VALUE IF1404.2 +013600 " COPYRIGHT 1985 ". IF1404.2 +013700 01 CCVS-E-1. IF1404.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1404.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1404.2 +014000 02 ID-AGAIN PIC X(9). IF1404.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1404.2 +014200 01 CCVS-E-2. IF1404.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1404.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1404.2 +014500 02 CCVS-E-2-2. IF1404.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1404.2 +014700 03 FILLER PIC X VALUE SPACE. IF1404.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1404.2 +014900 "ERRORS ENCOUNTERED". IF1404.2 +015000 01 CCVS-E-3. IF1404.2 +015100 02 FILLER PIC X(22) VALUE IF1404.2 +015200 " FOR OFFICIAL USE ONLY". IF1404.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1404.2 +015400 02 FILLER PIC X(58) VALUE IF1404.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1404.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1404.2 +015700 02 FILLER PIC X(15) VALUE IF1404.2 +015800 " COPYRIGHT 1985". IF1404.2 +015900 01 CCVS-E-4. IF1404.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1404.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1404.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1404.2 +016300 02 FILLER PIC X(40) VALUE IF1404.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1404.2 +016500 01 XXINFO. IF1404.2 +016600 02 FILLER PIC X(19) VALUE IF1404.2 +016700 "*** INFORMATION ***". IF1404.2 +016800 02 INFO-TEXT. IF1404.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1404.2 +017000 04 XXCOMPUTED PIC X(20). IF1404.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1404.2 +017200 04 XXCORRECT PIC X(20). IF1404.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1404.2 +017400 01 HYPHEN-LINE. IF1404.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1404.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1404.2 +017700- "*****************************************". IF1404.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1404.2 +017900- "******************************". IF1404.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1404.2 +018100 "IF140A". IF1404.2 +018200 PROCEDURE DIVISION. IF1404.2 +018300 CCVS1 SECTION. IF1404.2 +018400 OPEN-FILES. IF1404.2 +018500 OPEN OUTPUT PRINT-FILE. IF1404.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1404.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1404.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1404.2 +018900 GO TO CCVS1-EXIT. IF1404.2 +019000 CLOSE-FILES. IF1404.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1404.2 +019200 TERMINATE-CCVS. IF1404.2 +019300 STOP RUN. IF1404.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1404.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1404.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1404.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1404.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1404.2 +019900 PRINT-DETAIL. IF1404.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1404.2 +020100 MOVE "." TO PARDOT-X IF1404.2 +020200 MOVE REC-CT TO DOTVALUE. IF1404.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1404.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1404.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1404.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1404.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1404.2 +020800 MOVE SPACE TO CORRECT-X. IF1404.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1404.2 +021000 MOVE SPACE TO RE-MARK. IF1404.2 +021100 HEAD-ROUTINE. IF1404.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1404.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1404.2 +021600 COLUMN-NAMES-ROUTINE. IF1404.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +022000 END-ROUTINE. IF1404.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1404.2 +022200 END-RTN-EXIT. IF1404.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +022400 END-ROUTINE-1. IF1404.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1404.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1404.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1404.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1404.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1404.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1404.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1404.2 +023200 END-ROUTINE-12. IF1404.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1404.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1404.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1404.2 +023600 ELSE IF1404.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1404.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1404.2 +023900 PERFORM WRITE-LINE. IF1404.2 +024000 END-ROUTINE-13. IF1404.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1404.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1404.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1404.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1404.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1404.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1404.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1404.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1404.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +025200 WRITE-LINE. IF1404.2 +025300 ADD 1 TO RECORD-COUNT. IF1404.2 +025400Y IF RECORD-COUNT GREATER 42 IF1404.2 +025500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1404.2 +025600Y MOVE SPACE TO DUMMY-RECORD IF1404.2 +025700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1404.2 +025800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1404.2 +025900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1404.2 +026000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1404.2 +026100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1404.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1404.2 +026600Y MOVE ZERO TO RECORD-COUNT. IF1404.2 +026700 PERFORM WRT-LN. IF1404.2 +026800 WRT-LN. IF1404.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1404.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1404.2 +027100 BLANK-LINE-PRINT. IF1404.2 +027200 PERFORM WRT-LN. IF1404.2 +027300 FAIL-ROUTINE. IF1404.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1404.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1404.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1404.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1404.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1404.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1404.2 +028100 GO TO FAIL-ROUTINE-EX. IF1404.2 +028200 FAIL-ROUTINE-WRITE. IF1404.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1404.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1404.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1404.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1404.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1404.2 +028800 BAIL-OUT. IF1404.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1404.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1404.2 +029100 BAIL-OUT-WRITE. IF1404.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1404.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1404.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1404.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1404.2 +029700 BAIL-OUT-EX. EXIT. IF1404.2 +029800 CCVS1-EXIT. IF1404.2 +029900 EXIT. IF1404.2 +030000******************************************************** IF1404.2 +030100* * IF1404.2 +030200* Intrinsic Function Tests IF140A - UPCASE * IF1404.2 +030300* * IF1404.2 +030400******************************************************** IF1404.2 +030500 SECT-IF140A SECTION. IF1404.2 +030600 F-UPCASE-INFO. IF1404.2 +030700 MOVE "See ref. A-73 2.44" TO ANSI-REFERENCE. IF1404.2 +030800 MOVE "UPPER-CASE Function" TO FEATURE. IF1404.2 +030900*****************TEST (a) ****************************** IF1404.2 +031000 F-UPCASE-01. IF1404.2 +031100 MOVE SPACES TO WS-ANUM. IF1404.2 +031200 F-UPCASE-TEST-01. IF1404.2 +031300 MOVE FUNCTION UPPER-CASE("figure") TO WS-ANUM. IF1404.2 +031400 IF WS-ANUM = "FIGURE" THEN IF1404.2 +031500 PERFORM PASS IF1404.2 +031600 ELSE IF1404.2 +031700 MOVE "FIGURE" TO CORRECT-A IF1404.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +031900 PERFORM FAIL. IF1404.2 +032000 GO TO F-UPCASE-WRITE-01. IF1404.2 +032100 F-UPCASE-DELETE-01. IF1404.2 +032200 PERFORM DE-LETE. IF1404.2 +032300 GO TO F-UPCASE-WRITE-01. IF1404.2 +032400 F-UPCASE-WRITE-01. IF1404.2 +032500 MOVE "F-UPCASE-01" TO PAR-NAME. IF1404.2 +032600 PERFORM PRINT-DETAIL. IF1404.2 +032700*****************TEST (b) ****************************** IF1404.2 +032800 F-UPCASE-TEST-02. IF1404.2 +032900 IF FUNCTION UPPER-CASE("CAPS") = "CAPS" THEN IF1404.2 +033000 PERFORM PASS IF1404.2 +033100 ELSE IF1404.2 +033200 PERFORM FAIL. IF1404.2 +033300 GO TO F-UPCASE-WRITE-02. IF1404.2 +033400 F-UPCASE-DELETE-02. IF1404.2 +033500 PERFORM DE-LETE. IF1404.2 +033600 GO TO F-UPCASE-WRITE-02. IF1404.2 +033700 F-UPCASE-WRITE-02. IF1404.2 +033800 MOVE "F-UPCASE-02" TO PAR-NAME. IF1404.2 +033900 PERFORM PRINT-DETAIL. IF1404.2 +034000*****************TEST (c) ****************************** IF1404.2 +034100 F-UPCASE-03. IF1404.2 +034200 MOVE SPACES TO WS-ANUM. IF1404.2 +034300 F-UPCASE-TEST-03. IF1404.2 +034400 MOVE FUNCTION UPPER-CASE("highnLOW") TO WS-ANUM. IF1404.2 +034500 IF WS-ANUM = "HIGHNLOW" THEN IF1404.2 +034600 PERFORM PASS IF1404.2 +034700 ELSE IF1404.2 +034800 MOVE "HIGHNLOW" TO CORRECT-A IF1404.2 +034900 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +035000 PERFORM FAIL. IF1404.2 +035100 GO TO F-UPCASE-WRITE-03. IF1404.2 +035200 F-UPCASE-DELETE-03. IF1404.2 +035300 PERFORM DE-LETE. IF1404.2 +035400 GO TO F-UPCASE-WRITE-03. IF1404.2 +035500 F-UPCASE-WRITE-03. IF1404.2 +035600 MOVE "F-UPCASE-03" TO PAR-NAME. IF1404.2 +035700 PERFORM PRINT-DETAIL. IF1404.2 +035800*****************TEST (d) ****************************** IF1404.2 +035900 F-UPCASE-04. IF1404.2 +036000 MOVE SPACES TO WS-ANUM. IF1404.2 +036100 F-UPCASE-TEST-04. IF1404.2 +036200 MOVE FUNCTION UPPER-CASE("95") TO WS-ANUM. IF1404.2 +036300 IF WS-ANUM = "95" THEN IF1404.2 +036400 PERFORM PASS IF1404.2 +036500 ELSE IF1404.2 +036600 MOVE "95" TO CORRECT-A IF1404.2 +036700 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +036800 PERFORM FAIL. IF1404.2 +036900 GO TO F-UPCASE-WRITE-04. IF1404.2 +037000 F-UPCASE-DELETE-04. IF1404.2 +037100 PERFORM DE-LETE. IF1404.2 +037200 GO TO F-UPCASE-WRITE-04. IF1404.2 +037300 F-UPCASE-WRITE-04. IF1404.2 +037400 MOVE "F-UPCASE-04" TO PAR-NAME. IF1404.2 +037500 PERFORM PRINT-DETAIL. IF1404.2 +037600*****************TEST (e) ****************************** IF1404.2 +037700 F-UPCASE-05. IF1404.2 +037800 MOVE SPACES TO WS-ANUM. IF1404.2 +037900 F-UPCASE-TEST-05. IF1404.2 +038000 MOVE FUNCTION UPPER-CASE("8isaNUMBER") TO WS-ANUM. IF1404.2 +038100 IF WS-ANUM = "8ISANUMBER" THEN IF1404.2 +038200 PERFORM PASS IF1404.2 +038300 ELSE IF1404.2 +038400 MOVE "8ISANUMBER" TO CORRECT-A IF1404.2 +038500 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +038600 PERFORM FAIL. IF1404.2 +038700 GO TO F-UPCASE-WRITE-05. IF1404.2 +038800 F-UPCASE-DELETE-05. IF1404.2 +038900 PERFORM DE-LETE. IF1404.2 +039000 GO TO F-UPCASE-WRITE-05. IF1404.2 +039100 F-UPCASE-WRITE-05. IF1404.2 +039200 MOVE "F-UPCASE-05" TO PAR-NAME. IF1404.2 +039300 PERFORM PRINT-DETAIL. IF1404.2 +039400*****************TEST (f) ****************************** IF1404.2 +039500 F-UPCASE-06. IF1404.2 +039600 MOVE SPACES TO WS-ANUM. IF1404.2 +039700 F-UPCASE-TEST-06. IF1404.2 +039800 MOVE FUNCTION UPPER-CASE(A) TO WS-ANUM. IF1404.2 +039900 IF WS-ANUM = "TUMBLE" THEN IF1404.2 +040000 PERFORM PASS IF1404.2 +040100 ELSE IF1404.2 +040200 MOVE "TUMBLE" TO CORRECT-A IF1404.2 +040300 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +040400 PERFORM FAIL. IF1404.2 +040500 GO TO F-UPCASE-WRITE-06. IF1404.2 +040600 F-UPCASE-DELETE-06. IF1404.2 +040700 PERFORM DE-LETE. IF1404.2 +040800 GO TO F-UPCASE-WRITE-06. IF1404.2 +040900 F-UPCASE-WRITE-06. IF1404.2 +041000 MOVE "F-UPCASE-06" TO PAR-NAME. IF1404.2 +041100 PERFORM PRINT-DETAIL. IF1404.2 +041200*****************TEST (g) ****************************** IF1404.2 +041300 F-UPCASE-07. IF1404.2 +041400 MOVE SPACES TO WS-ANUM. IF1404.2 +041500 F-UPCASE-TEST-07. IF1404.2 +041600 MOVE FUNCTION UPPER-CASE(B) TO WS-ANUM. IF1404.2 +041700 IF WS-ANUM = "WEED" THEN IF1404.2 +041800 PERFORM PASS IF1404.2 +041900 ELSE IF1404.2 +042000 MOVE "WEED" TO CORRECT-A IF1404.2 +042100 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +042200 PERFORM FAIL. IF1404.2 +042300 GO TO F-UPCASE-WRITE-07. IF1404.2 +042400 F-UPCASE-DELETE-07. IF1404.2 +042500 PERFORM DE-LETE. IF1404.2 +042600 GO TO F-UPCASE-WRITE-07. IF1404.2 +042700 F-UPCASE-WRITE-07. IF1404.2 +042800 MOVE "F-UPCASE-07" TO PAR-NAME. IF1404.2 +042900 PERFORM PRINT-DETAIL. IF1404.2 +043000*****************TEST (h) ****************************** IF1404.2 +043100 F-UPCASE-08. IF1404.2 +043200 MOVE SPACES TO WS-ANUM. IF1404.2 +043300 F-UPCASE-TEST-08. IF1404.2 +043400 MOVE FUNCTION UPPER-CASE(C) TO WS-ANUM. IF1404.2 +043500 IF WS-ANUM = "WAS" THEN IF1404.2 +043600 PERFORM PASS IF1404.2 +043700 ELSE IF1404.2 +043800 MOVE "WAS" TO CORRECT-A IF1404.2 +043900 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +044000 PERFORM FAIL. IF1404.2 +044100 GO TO F-UPCASE-WRITE-08. IF1404.2 +044200 F-UPCASE-DELETE-08. IF1404.2 +044300 PERFORM DE-LETE. IF1404.2 +044400 GO TO F-UPCASE-WRITE-08. IF1404.2 +044500 F-UPCASE-WRITE-08. IF1404.2 +044600 MOVE "F-UPCASE-08" TO PAR-NAME. IF1404.2 +044700 PERFORM PRINT-DETAIL. IF1404.2 +044800*****************TEST (i) ****************************** IF1404.2 +044900 F-UPCASE-09. IF1404.2 +045000 MOVE SPACES TO WS-ANUM. IF1404.2 +045100 F-UPCASE-TEST-09. IF1404.2 +045200 MOVE FUNCTION UPPER-CASE(D) TO WS-ANUM. IF1404.2 +045300 IF WS-ANUM = "4" THEN IF1404.2 +045400 PERFORM PASS IF1404.2 +045500 ELSE IF1404.2 +045600 MOVE "4" TO CORRECT-A IF1404.2 +045700 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +045800 PERFORM FAIL. IF1404.2 +045900 GO TO F-UPCASE-WRITE-09. IF1404.2 +046000 F-UPCASE-DELETE-09. IF1404.2 +046100 PERFORM DE-LETE. IF1404.2 +046200 GO TO F-UPCASE-WRITE-09. IF1404.2 +046300 F-UPCASE-WRITE-09. IF1404.2 +046400 MOVE "F-UPCASE-09" TO PAR-NAME. IF1404.2 +046500 PERFORM PRINT-DETAIL. IF1404.2 +046600*****************TEST (j) ****************************** IF1404.2 +046700 F-UPCASE-10. IF1404.2 +046800 MOVE SPACES TO WS-ANUM. IF1404.2 +046900 F-UPCASE-TEST-10. IF1404.2 +047000 MOVE FUNCTION UPPER-CASE(E) TO WS-ANUM. IF1404.2 +047100 IF WS-ANUM = "AND4" THEN IF1404.2 +047200 PERFORM PASS IF1404.2 +047300 ELSE IF1404.2 +047400 MOVE "AND4" TO CORRECT-A IF1404.2 +047500 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +047600 PERFORM FAIL. IF1404.2 +047700 GO TO F-UPCASE-WRITE-10. IF1404.2 +047800 F-UPCASE-DELETE-10. IF1404.2 +047900 PERFORM DE-LETE. IF1404.2 +048000 GO TO F-UPCASE-WRITE-10. IF1404.2 +048100 F-UPCASE-WRITE-10. IF1404.2 +048200 MOVE "F-UPCASE-10" TO PAR-NAME. IF1404.2 +048300 PERFORM PRINT-DETAIL. IF1404.2 +048400*****************TEST (k) ****************************** IF1404.2 +048500 F-UPCASE-11. IF1404.2 +048600 MOVE ZERO TO TEMP. IF1404.2 +048700 F-UPCASE-TEST-11. IF1404.2 +048800 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION UPPER-CASE("Homer")).IF1404.2 +048900 IF TEMP = 5 THEN IF1404.2 +049000 PERFORM PASS IF1404.2 +049100 ELSE IF1404.2 +049200 MOVE 5 TO CORRECT-N IF1404.2 +049300 MOVE TEMP TO COMPUTED-N IF1404.2 +049400 PERFORM FAIL. IF1404.2 +049500 GO TO F-UPCASE-WRITE-11. IF1404.2 +049600 F-UPCASE-DELETE-11. IF1404.2 +049700 PERFORM DE-LETE. IF1404.2 +049800 GO TO F-UPCASE-WRITE-11. IF1404.2 +049900 F-UPCASE-WRITE-11. IF1404.2 +050000 MOVE "F-UPCASE-11" TO PAR-NAME. IF1404.2 +050100 PERFORM PRINT-DETAIL. IF1404.2 +050200*****************TEST (l) ****************************** IF1404.2 +050300 F-UPCASE-12. IF1404.2 +050400 MOVE SPACES TO WS-ANUM. IF1404.2 +050500 F-UPCASE-TEST-12. IF1404.2 +050600 MOVE FUNCTION UPPER-CASE(FUNCTION UPPER-CASE("giZZard")) IF1404.2 +050700 TO WS-ANUM. IF1404.2 +050800 IF WS-ANUM = "GIZZARD" THEN IF1404.2 +050900 PERFORM PASS IF1404.2 +051000 ELSE IF1404.2 +051100 MOVE "GIZZARD" TO CORRECT-A IF1404.2 +051200 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +051300 PERFORM FAIL. IF1404.2 +051400 GO TO F-UPCASE-WRITE-12. IF1404.2 +051500 F-UPCASE-DELETE-12. IF1404.2 +051600 PERFORM DE-LETE. IF1404.2 +051700 GO TO F-UPCASE-WRITE-12. IF1404.2 +051800 F-UPCASE-WRITE-12. IF1404.2 +051900 MOVE "F-UPCASE-12" TO PAR-NAME. IF1404.2 +052000 PERFORM PRINT-DETAIL. IF1404.2 +052100*****************TEST (m) ****************************** IF1404.2 +052200 F-UPCASE-13. IF1404.2 +052300 MOVE ZERO TO TEMP. IF1404.2 +052400 F-UPCASE-TEST-13. IF1404.2 +052500 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION UPPER-CASE("HOMER")) IF1404.2 +052600 + FUNCTION LENGTH(FUNCTION UPPER-CASE("Gizzard")).IF1404.2 +052700 IF TEMP = 12 THEN IF1404.2 +052800 PERFORM PASS IF1404.2 +052900 ELSE IF1404.2 +053000 MOVE 12 TO CORRECT-N IF1404.2 +053100 MOVE TEMP TO COMPUTED-N IF1404.2 +053200 PERFORM FAIL. IF1404.2 +053300 GO TO F-UPCASE-WRITE-13. IF1404.2 +053400 F-UPCASE-DELETE-13. IF1404.2 +053500 PERFORM DE-LETE. IF1404.2 +053600 GO TO F-UPCASE-WRITE-13. IF1404.2 +053700 F-UPCASE-WRITE-13. IF1404.2 +053800 MOVE "F-UPCASE-13" TO PAR-NAME. IF1404.2 +053900 PERFORM PRINT-DETAIL. IF1404.2 +054000*******************END OF TESTS************************** IF1404.2 +054100 CCVS-EXIT SECTION. IF1404.2 +054200 CCVS-999999. IF1404.2 +054300 GO TO CLOSE-FILES. IF1404.2 +*END-OF,IF140A +*HEADER,COBOL,IF141A +000100 IDENTIFICATION DIVISION. IF1414.2 +000200 PROGRAM-ID. IF1414.2 +000300 IF141A. IF1414.2 +000400*********************************************************** IF1414.2 +000500* * IF1414.2 +000600* This program forms part of the CCVS85 COBOL Test Suite. * IF1414.2 +000700* It contains tests for the Intrinsic Function VARIANCE * IF1414.2 +000800* * IF1414.2 +000900*********************************************************** IF1414.2 +001000 ENVIRONMENT DIVISION. IF1414.2 +001100 CONFIGURATION SECTION. IF1414.2 +001200 SOURCE-COMPUTER. IF1414.2 +001300 XXXXX082. IF1414.2 +001400 OBJECT-COMPUTER. IF1414.2 +001500 XXXXX083. IF1414.2 +001600 INPUT-OUTPUT SECTION. IF1414.2 +001700 FILE-CONTROL. IF1414.2 +001800 SELECT PRINT-FILE ASSIGN TO IF1414.2 +001900 XXXXX055. IF1414.2 +002000 DATA DIVISION. IF1414.2 +002100 FILE SECTION. IF1414.2 +002200 FD PRINT-FILE. IF1414.2 +002300 01 PRINT-REC PICTURE X(120). IF1414.2 +002400 01 DUMMY-RECORD PICTURE X(120). IF1414.2 +002500 WORKING-STORAGE SECTION. IF1414.2 +002600*********************************************************** IF1414.2 +002700* Variables specific to the Intrinsic Function Test IF141A* IF1414.2 +002800*********************************************************** IF1414.2 +002900 01 A PIC S9(10) VALUE 5. IF1414.2 +003000 01 B PIC S9(10) VALUE 7. IF1414.2 +003100 01 C PIC S9(10) VALUE -4. IF1414.2 +003200 01 D PIC S9(10) VALUE 10. IF1414.2 +003300 01 E PIC S9(5)V9(5) VALUE 34.26. IF1414.2 +003400 01 F PIC S9(5)V9(5) VALUE -8.32. IF1414.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1414.2 +003600 01 H PIC S9(5)V9(5) VALUE -5.3. IF1414.2 +003700 01 P PIC S9(10) VALUE 4. IF1414.2 +003800 01 Q PIC S9(10) VALUE 3. IF1414.2 +003900 01 R PIC S9(10) VALUE 5. IF1414.2 +004000 01 ARG3 PIC S9(10) VALUE 2. IF1414.2 +004100 01 ARR VALUE "40537". IF1414.2 +004200 02 IND OCCURS 5 TIMES PIC 9. IF1414.2 +004300 01 TEMP PIC S9(10). IF1414.2 +004400 01 WS-NUM PIC S9(5)V9(6). IF1414.2 +004500 01 MIN-RANGE PIC S9(5)V9(7). IF1414.2 +004600 01 MAX-RANGE PIC S9(5)V9(7). IF1414.2 +004700* IF1414.2 +004800********************************************************** IF1414.2 +004900* IF1414.2 +005000 01 TEST-RESULTS. IF1414.2 +005100 02 FILLER PIC X VALUE SPACE. IF1414.2 +005200 02 FEATURE PIC X(20) VALUE SPACE. IF1414.2 +005300 02 FILLER PIC X VALUE SPACE. IF1414.2 +005400 02 P-OR-F PIC X(5) VALUE SPACE. IF1414.2 +005500 02 FILLER PIC X VALUE SPACE. IF1414.2 +005600 02 PAR-NAME. IF1414.2 +005700 03 FILLER PIC X(19) VALUE SPACE. IF1414.2 +005800 03 PARDOT-X PIC X VALUE SPACE. IF1414.2 +005900 03 DOTVALUE PIC 99 VALUE ZERO. IF1414.2 +006000 02 FILLER PIC X(8) VALUE SPACE. IF1414.2 +006100 02 RE-MARK PIC X(61). IF1414.2 +006200 01 TEST-COMPUTED. IF1414.2 +006300 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +006400 02 FILLER PIC X(17) VALUE IF1414.2 +006500 " COMPUTED=". IF1414.2 +006600 02 COMPUTED-X. IF1414.2 +006700 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1414.2 +006800 03 COMPUTED-N REDEFINES COMPUTED-A IF1414.2 +006900 PIC -9(9).9(9). IF1414.2 +007000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1414.2 +007100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1414.2 +007200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1414.2 +007300 03 CM-18V0 REDEFINES COMPUTED-A. IF1414.2 +007400 04 COMPUTED-18V0 PIC -9(18). IF1414.2 +007500 04 FILLER PIC X. IF1414.2 +007600 03 FILLER PIC X(50) VALUE SPACE. IF1414.2 +007700 01 TEST-CORRECT. IF1414.2 +007800 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +007900 02 FILLER PIC X(17) VALUE " CORRECT =". IF1414.2 +008000 02 CORRECT-X. IF1414.2 +008100 03 CORRECT-A PIC X(20) VALUE SPACE. IF1414.2 +008200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1414.2 +008300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1414.2 +008400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1414.2 +008500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1414.2 +008600 03 CR-18V0 REDEFINES CORRECT-A. IF1414.2 +008700 04 CORRECT-18V0 PIC -9(18). IF1414.2 +008800 04 FILLER PIC X. IF1414.2 +008900 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +009000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1414.2 +009100 01 TEST-CORRECT-MIN. IF1414.2 +009200 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +009300 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1414.2 +009400 02 CORRECTMI-X. IF1414.2 +009500 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1414.2 +009600 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1414.2 +009700 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1414.2 +009800 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1414.2 +009900 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1414.2 +010000 03 CR-18V0 REDEFINES CORRECTMI-A. IF1414.2 +010100 04 CORRECTMI-18V0 PIC -9(18). IF1414.2 +010200 04 FILLER PIC X. IF1414.2 +010300 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +010400 03 FILLER PIC X(48) VALUE SPACE. IF1414.2 +010500 01 TEST-CORRECT-MAX. IF1414.2 +010600 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +010700 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1414.2 +010800 02 CORRECTMA-X. IF1414.2 +010900 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1414.2 +011000 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1414.2 +011100 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1414.2 +011200 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1414.2 +011300 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1414.2 +011400 03 CR-18V0 REDEFINES CORRECTMA-A. IF1414.2 +011500 04 CORRECTMA-18V0 PIC -9(18). IF1414.2 +011600 04 FILLER PIC X. IF1414.2 +011700 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +011800 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1414.2 +011900 01 CCVS-C-1. IF1414.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1414.2 +012100- "SS PARAGRAPH-NAME IF1414.2 +012200- " REMARKS". IF1414.2 +012300 02 FILLER PIC X(20) VALUE SPACE. IF1414.2 +012400 01 CCVS-C-2. IF1414.2 +012500 02 FILLER PIC X VALUE SPACE. IF1414.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". IF1414.2 +012700 02 FILLER PIC X(15) VALUE SPACE. IF1414.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". IF1414.2 +012900 02 FILLER PIC X(94) VALUE SPACE. IF1414.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1414.2 +013100 01 REC-CT PIC 99 VALUE ZERO. IF1414.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1414.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1414.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1414.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1414.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1414.2 +014100 01 CCVS-H-1. IF1414.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1414.2 +014300 02 FILLER PIC X(42) VALUE IF1414.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1414.2 +014500 02 FILLER PIC X(39) VALUE SPACES. IF1414.2 +014600 01 CCVS-H-2A. IF1414.2 +014700 02 FILLER PIC X(40) VALUE SPACE. IF1414.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1414.2 +014900 02 FILLER PIC XXXX VALUE IF1414.2 +015000 "4.2 ". IF1414.2 +015100 02 FILLER PIC X(28) VALUE IF1414.2 +015200 " COPY - NOT FOR DISTRIBUTION". IF1414.2 +015300 02 FILLER PIC X(41) VALUE SPACE. IF1414.2 +015400 IF1414.2 +015500 01 CCVS-H-2B. IF1414.2 +015600 02 FILLER PIC X(15) VALUE IF1414.2 +015700 "TEST RESULT OF ". IF1414.2 +015800 02 TEST-ID PIC X(9). IF1414.2 +015900 02 FILLER PIC X(4) VALUE IF1414.2 +016000 " IN ". IF1414.2 +016100 02 FILLER PIC X(12) VALUE IF1414.2 +016200 " HIGH ". IF1414.2 +016300 02 FILLER PIC X(22) VALUE IF1414.2 +016400 " LEVEL VALIDATION FOR ". IF1414.2 +016500 02 FILLER PIC X(58) VALUE IF1414.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1414.2 +016700 01 CCVS-H-3. IF1414.2 +016800 02 FILLER PIC X(34) VALUE IF1414.2 +016900 " FOR OFFICIAL USE ONLY ". IF1414.2 +017000 02 FILLER PIC X(58) VALUE IF1414.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1414.2 +017200 02 FILLER PIC X(28) VALUE IF1414.2 +017300 " COPYRIGHT 1985 ". IF1414.2 +017400 01 CCVS-E-1. IF1414.2 +017500 02 FILLER PIC X(52) VALUE SPACE. IF1414.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1414.2 +017700 02 ID-AGAIN PIC X(9). IF1414.2 +017800 02 FILLER PIC X(45) VALUE SPACES. IF1414.2 +017900 01 CCVS-E-2. IF1414.2 +018000 02 FILLER PIC X(31) VALUE SPACE. IF1414.2 +018100 02 FILLER PIC X(21) VALUE SPACE. IF1414.2 +018200 02 CCVS-E-2-2. IF1414.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1414.2 +018400 03 FILLER PIC X VALUE SPACE. IF1414.2 +018500 03 ENDER-DESC PIC X(44) VALUE IF1414.2 +018600 "ERRORS ENCOUNTERED". IF1414.2 +018700 01 CCVS-E-3. IF1414.2 +018800 02 FILLER PIC X(22) VALUE IF1414.2 +018900 " FOR OFFICIAL USE ONLY". IF1414.2 +019000 02 FILLER PIC X(12) VALUE SPACE. IF1414.2 +019100 02 FILLER PIC X(58) VALUE IF1414.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1414.2 +019300 02 FILLER PIC X(13) VALUE SPACE. IF1414.2 +019400 02 FILLER PIC X(15) VALUE IF1414.2 +019500 " COPYRIGHT 1985". IF1414.2 +019600 01 CCVS-E-4. IF1414.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1414.2 +019800 02 FILLER PIC X(4) VALUE " OF ". IF1414.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1414.2 +020000 02 FILLER PIC X(40) VALUE IF1414.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". IF1414.2 +020200 01 XXINFO. IF1414.2 +020300 02 FILLER PIC X(19) VALUE IF1414.2 +020400 "*** INFORMATION ***". IF1414.2 +020500 02 INFO-TEXT. IF1414.2 +020600 04 FILLER PIC X(8) VALUE SPACE. IF1414.2 +020700 04 XXCOMPUTED PIC X(20). IF1414.2 +020800 04 FILLER PIC X(5) VALUE SPACE. IF1414.2 +020900 04 XXCORRECT PIC X(20). IF1414.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). IF1414.2 +021100 01 HYPHEN-LINE. IF1414.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. IF1414.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************IF1414.2 +021400- "*****************************************". IF1414.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************IF1414.2 +021600- "******************************". IF1414.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE IF1414.2 +021800 "IF141A". IF1414.2 +021900 PROCEDURE DIVISION. IF1414.2 +022000 CCVS1 SECTION. IF1414.2 +022100 OPEN-FILES. IF1414.2 +022200 OPEN OUTPUT PRINT-FILE. IF1414.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1414.2 +022400 MOVE SPACE TO TEST-RESULTS. IF1414.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1414.2 +022600 GO TO CCVS1-EXIT. IF1414.2 +022700 CLOSE-FILES. IF1414.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1414.2 +022900 TERMINATE-CCVS. IF1414.2 +023000 STOP RUN. IF1414.2 +023100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1414.2 +023200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1414.2 +023300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1414.2 +023400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1414.2 +023500 MOVE "****TEST DELETED****" TO RE-MARK. IF1414.2 +023600 PRINT-DETAIL. IF1414.2 +023700 IF REC-CT NOT EQUAL TO ZERO IF1414.2 +023800 MOVE "." TO PARDOT-X IF1414.2 +023900 MOVE REC-CT TO DOTVALUE. IF1414.2 +024000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1414.2 +024100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1414.2 +024200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1414.2 +024300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1414.2 +024400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1414.2 +024500 MOVE SPACE TO CORRECT-X. IF1414.2 +024600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1414.2 +024700 MOVE SPACE TO RE-MARK. IF1414.2 +024800 HEAD-ROUTINE. IF1414.2 +024900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1414.2 +025200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1414.2 +025300 COLUMN-NAMES-ROUTINE. IF1414.2 +025400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +025500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +025700 END-ROUTINE. IF1414.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1414.2 +025900 END-RTN-EXIT. IF1414.2 +026000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +026100 END-ROUTINE-1. IF1414.2 +026200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1414.2 +026300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1414.2 +026400 ADD PASS-COUNTER TO ERROR-HOLD. IF1414.2 +026500 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1414.2 +026600 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1414.2 +026700 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1414.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1414.2 +026900 END-ROUTINE-12. IF1414.2 +027000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1414.2 +027100 IF ERROR-COUNTER IS EQUAL TO ZERO IF1414.2 +027200 MOVE "NO " TO ERROR-TOTAL IF1414.2 +027300 ELSE IF1414.2 +027400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1414.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1414.2 +027600 PERFORM WRITE-LINE. IF1414.2 +027700 END-ROUTINE-13. IF1414.2 +027800 IF DELETE-COUNTER IS EQUAL TO ZERO IF1414.2 +027900 MOVE "NO " TO ERROR-TOTAL ELSE IF1414.2 +028000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1414.2 +028100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1414.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028300 IF INSPECT-COUNTER EQUAL TO ZERO IF1414.2 +028400 MOVE "NO " TO ERROR-TOTAL IF1414.2 +028500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1414.2 +028600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1414.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028900 WRITE-LINE. IF1414.2 +029000 ADD 1 TO RECORD-COUNT. IF1414.2 +029100Y IF RECORD-COUNT GREATER 42 IF1414.2 +029200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1414.2 +029300Y MOVE SPACE TO DUMMY-RECORD IF1414.2 +029400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1414.2 +029500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1414.2 +029600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1414.2 +029700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1414.2 +029800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1414.2 +029900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1414.2 +030300Y MOVE ZERO TO RECORD-COUNT. IF1414.2 +030400 PERFORM WRT-LN. IF1414.2 +030500 WRT-LN. IF1414.2 +030600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1414.2 +030700 MOVE SPACE TO DUMMY-RECORD. IF1414.2 +030800 BLANK-LINE-PRINT. IF1414.2 +030900 PERFORM WRT-LN. IF1414.2 +031000 FAIL-ROUTINE. IF1414.2 +031100 IF COMPUTED-X NOT EQUAL TO SPACE IF1414.2 +031200 GO TO FAIL-ROUTINE-WRITE. IF1414.2 +031300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1414.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1414.2 +031500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1414.2 +031600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +031700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1414.2 +031800 GO TO FAIL-ROUTINE-EX. IF1414.2 +031900 FAIL-ROUTINE-WRITE. IF1414.2 +032000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1414.2 +032100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1414.2 +032200 CORMA-ANSI-REFERENCE. IF1414.2 +032300 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1414.2 +032400 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1414.2 +032500 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1414.2 +032600 ELSE IF1414.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1414.2 +032800 PERFORM WRITE-LINE. IF1414.2 +032900 MOVE SPACES TO COR-ANSI-REFERENCE. IF1414.2 +033000 FAIL-ROUTINE-EX. EXIT. IF1414.2 +033100 BAIL-OUT. IF1414.2 +033200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1414.2 +033300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1414.2 +033400 BAIL-OUT-WRITE. IF1414.2 +033500 MOVE CORRECT-A TO XXCORRECT. IF1414.2 +033600 MOVE COMPUTED-A TO XXCOMPUTED. IF1414.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1414.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1414.2 +034000 BAIL-OUT-EX. EXIT. IF1414.2 +034100 CCVS1-EXIT. IF1414.2 +034200 EXIT. IF1414.2 +034300******************************************************** IF1414.2 +034400* * IF1414.2 +034500* Intrinsic Function Tests IF141A - VARIANCE * IF1414.2 +034600* * IF1414.2 +034700******************************************************** IF1414.2 +034800 SECT-IF141A SECTION. IF1414.2 +034900 F-VARIANCE-INFO. IF1414.2 +035000 MOVE "See ref. A-74 2.45" TO ANSI-REFERENCE. IF1414.2 +035100 MOVE "VARIANCE Function" TO FEATURE. IF1414.2 +035200*****************TEST (a) - SIMPLE TEST***************** IF1414.2 +035300 F-VARIANCE-01. IF1414.2 +035400 MOVE ZERO TO WS-NUM. IF1414.2 +035500 MOVE 48.6865 TO MIN-RANGE. IF1414.2 +035600 MOVE 48.6885 TO MAX-RANGE. IF1414.2 +035700 F-VARIANCE-TEST-01. IF1414.2 +035800 COMPUTE WS-NUM = FUNCTION VARIANCE(5, -2, -14, 0). IF1414.2 +035900 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +036000 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +036100 PERFORM PASS IF1414.2 +036200 ELSE IF1414.2 +036300 MOVE WS-NUM TO COMPUTED-N IF1414.2 +036400 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +036500 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +036600 PERFORM FAIL. IF1414.2 +036700 GO TO F-VARIANCE-WRITE-01. IF1414.2 +036800 F-VARIANCE-DELETE-01. IF1414.2 +036900 PERFORM DE-LETE. IF1414.2 +037000 GO TO F-VARIANCE-WRITE-01. IF1414.2 +037100 F-VARIANCE-WRITE-01. IF1414.2 +037200 MOVE "F-VARIANCE-01" TO PAR-NAME. IF1414.2 +037300 PERFORM PRINT-DETAIL. IF1414.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1414.2 +037500 F-VARIANCE-02. IF1414.2 +037600 EVALUATE FUNCTION VARIANCE(3.9, -0.3, 8.7, 100.2) IF1414.2 +037700 WHEN 1741.70 THRU 1741.77 IF1414.2 +037800 PERFORM PASS IF1414.2 +037900 WHEN OTHER IF1414.2 +038000 PERFORM FAIL. IF1414.2 +038100 GO TO F-VARIANCE-WRITE-02. IF1414.2 +038200 F-VARIANCE-DELETE-02. IF1414.2 +038300 PERFORM DE-LETE. IF1414.2 +038400 GO TO F-VARIANCE-WRITE-02. IF1414.2 +038500 F-VARIANCE-WRITE-02. IF1414.2 +038600 MOVE "F-VARIANCE-02" TO PAR-NAME. IF1414.2 +038700 PERFORM PRINT-DETAIL. IF1414.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1414.2 +038900 F-VARIANCE-03. IF1414.2 +039000 MOVE 27.2494 TO MIN-RANGE. IF1414.2 +039100 MOVE 27.2505 TO MAX-RANGE. IF1414.2 +039200 F-VARIANCE-TEST-03. IF1414.2 +039300 IF (FUNCTION VARIANCE(A, B, C, D) >= MIN-RANGE) AND IF1414.2 +039400 (FUNCTION VARIANCE(A, B, C, D) <= MAX-RANGE) THEN IF1414.2 +039500 PERFORM PASS IF1414.2 +039600 ELSE IF1414.2 +039700 PERFORM FAIL. IF1414.2 +039800 GO TO F-VARIANCE-WRITE-03. IF1414.2 +039900 F-VARIANCE-DELETE-03. IF1414.2 +040000 PERFORM DE-LETE. IF1414.2 +040100 GO TO F-VARIANCE-WRITE-03. IF1414.2 +040200 F-VARIANCE-WRITE-03. IF1414.2 +040300 MOVE "F-VARIANCE-03" TO PAR-NAME. IF1414.2 +040400 PERFORM PRINT-DETAIL. IF1414.2 +040500*****************TEST (d) - SIMPLE TEST***************** IF1414.2 +040600 F-VARIANCE-04. IF1414.2 +040700 MOVE ZERO TO WS-NUM. IF1414.2 +040800 MOVE 283.728 TO MIN-RANGE. IF1414.2 +040900 MOVE 283.740 TO MAX-RANGE. IF1414.2 +041000 F-VARIANCE-TEST-04. IF1414.2 +041100 COMPUTE WS-NUM = FUNCTION VARIANCE(E, F, G, H). IF1414.2 +041200 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +041300 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +041400 PERFORM PASS IF1414.2 +041500 ELSE IF1414.2 +041600 MOVE WS-NUM TO COMPUTED-N IF1414.2 +041700 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +041800 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +041900 PERFORM FAIL. IF1414.2 +042000 GO TO F-VARIANCE-WRITE-04. IF1414.2 +042100 F-VARIANCE-DELETE-04. IF1414.2 +042200 PERFORM DE-LETE. IF1414.2 +042300 GO TO F-VARIANCE-WRITE-04. IF1414.2 +042400 F-VARIANCE-WRITE-04. IF1414.2 +042500 MOVE "F-VARIANCE-04" TO PAR-NAME. IF1414.2 +042600 PERFORM PRINT-DETAIL. IF1414.2 +042700*****************TEST (e) - SIMPLE TEST***************** IF1414.2 +042800 F-VARIANCE-05. IF1414.2 +042900 MOVE ZERO TO WS-NUM. IF1414.2 +043000 MOVE 94.6981 TO MIN-RANGE. IF1414.2 +043100 MOVE 94.7019 TO MAX-RANGE. IF1414.2 +043200 F-VARIANCE-TEST-05. IF1414.2 +043300 COMPUTE WS-NUM = IF1414.2 +043400 FUNCTION VARIANCE(10.2, -0.2, 5.6, -15.6). IF1414.2 +043500 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +043600 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +043700 PERFORM PASS IF1414.2 +043800 ELSE IF1414.2 +043900 MOVE WS-NUM TO COMPUTED-N IF1414.2 +044000 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +044100 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +044200 PERFORM FAIL. IF1414.2 +044300 GO TO F-VARIANCE-WRITE-05. IF1414.2 +044400 F-VARIANCE-DELETE-05. IF1414.2 +044500 PERFORM DE-LETE. IF1414.2 +044600 GO TO F-VARIANCE-WRITE-05. IF1414.2 +044700 F-VARIANCE-WRITE-05. IF1414.2 +044800 MOVE "F-VARIANCE-05" TO PAR-NAME. IF1414.2 +044900 PERFORM PRINT-DETAIL. IF1414.2 +045000*****************TEST (f) - SIMPLE TEST***************** IF1414.2 +045100 F-VARIANCE-06. IF1414.2 +045200 MOVE ZERO TO WS-NUM. IF1414.2 +045300 MOVE 156.194 TO MIN-RANGE. IF1414.2 +045400 MOVE 156.200 TO MAX-RANGE. IF1414.2 +045500 F-VARIANCE-TEST-06. IF1414.2 +045600 COMPUTE WS-NUM = IF1414.2 +045700 FUNCTION VARIANCE(A, B, C, D, E, F, G, H). IF1414.2 +045800 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +045900 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +046000 PERFORM PASS IF1414.2 +046100 ELSE IF1414.2 +046200 MOVE WS-NUM TO COMPUTED-N IF1414.2 +046300 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +046400 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +046500 PERFORM FAIL. IF1414.2 +046600 GO TO F-VARIANCE-WRITE-06. IF1414.2 +046700 F-VARIANCE-DELETE-06. IF1414.2 +046800 PERFORM DE-LETE. IF1414.2 +046900 GO TO F-VARIANCE-WRITE-06. IF1414.2 +047000 F-VARIANCE-WRITE-06. IF1414.2 +047100 MOVE "F-VARIANCE-06" TO PAR-NAME. IF1414.2 +047200 PERFORM PRINT-DETAIL. IF1414.2 +047300*****************TEST (g) - SIMPLE TEST***************** IF1414.2 +047400 F-VARIANCE-07. IF1414.2 +047500 MOVE ZERO TO WS-NUM. IF1414.2 +047600 MOVE 4.66657 TO MIN-RANGE. IF1414.2 +047700 MOVE 4.66675 TO MAX-RANGE. IF1414.2 +047800 F-VARIANCE-TEST-07. IF1414.2 +047900 COMPUTE WS-NUM = IF1414.2 +048000 FUNCTION VARIANCE(IND(1), IND(2), IND(3)). IF1414.2 +048100 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +048200 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +048300 PERFORM PASS IF1414.2 +048400 ELSE IF1414.2 +048500 MOVE WS-NUM TO COMPUTED-N IF1414.2 +048600 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +048700 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +048800 PERFORM FAIL. IF1414.2 +048900 GO TO F-VARIANCE-WRITE-07. IF1414.2 +049000 F-VARIANCE-DELETE-07. IF1414.2 +049100 PERFORM DE-LETE. IF1414.2 +049200 GO TO F-VARIANCE-WRITE-07. IF1414.2 +049300 F-VARIANCE-WRITE-07. IF1414.2 +049400 MOVE "F-VARIANCE-07" TO PAR-NAME. IF1414.2 +049500 PERFORM PRINT-DETAIL. IF1414.2 +049600*****************TEST (h) - SIMPLE TEST***************** IF1414.2 +049700 F-VARIANCE-08. IF1414.2 +049800 MOVE ZERO TO WS-NUM. IF1414.2 +049900 MOVE 2.66661 TO MIN-RANGE. IF1414.2 +050000 MOVE 2.66671 TO MAX-RANGE. IF1414.2 +050100 F-VARIANCE-TEST-08. IF1414.2 +050200 COMPUTE WS-NUM = IF1414.2 +050300 FUNCTION VARIANCE(IND(P), IND(Q), IND(R)). IF1414.2 +050400 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +050500 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +050600 PERFORM PASS IF1414.2 +050700 ELSE IF1414.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1414.2 +050900 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +051000 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +051100 PERFORM FAIL. IF1414.2 +051200 GO TO F-VARIANCE-WRITE-08. IF1414.2 +051300 F-VARIANCE-DELETE-08. IF1414.2 +051400 PERFORM DE-LETE. IF1414.2 +051500 GO TO F-VARIANCE-WRITE-08. IF1414.2 +051600 F-VARIANCE-WRITE-08. IF1414.2 +051700 MOVE "F-VARIANCE-08" TO PAR-NAME. IF1414.2 +051800 PERFORM PRINT-DETAIL. IF1414.2 +051900*****************TEST (i) - SIMPLE TEST***************** IF1414.2 +052000 F-VARIANCE-09. IF1414.2 +052100 MOVE ZERO TO WS-NUM. IF1414.2 +052200 MOVE 5.35989 TO MIN-RANGE. IF1414.2 +052300 MOVE 5.36011 TO MAX-RANGE. IF1414.2 +052400 F-VARIANCE-TEST-09. IF1414.2 +052500 COMPUTE WS-NUM = FUNCTION VARIANCE(IND(ALL)). IF1414.2 +052600 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +052700 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +052800 PERFORM PASS IF1414.2 +052900 ELSE IF1414.2 +053000 MOVE WS-NUM TO COMPUTED-N IF1414.2 +053100 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +053200 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +053300 PERFORM FAIL. IF1414.2 +053400 GO TO F-VARIANCE-WRITE-09. IF1414.2 +053500 F-VARIANCE-DELETE-09. IF1414.2 +053600 PERFORM DE-LETE. IF1414.2 +053700 GO TO F-VARIANCE-WRITE-09. IF1414.2 +053800 F-VARIANCE-WRITE-09. IF1414.2 +053900 MOVE "F-VARIANCE-09" TO PAR-NAME. IF1414.2 +054000 PERFORM PRINT-DETAIL. IF1414.2 +054100*****************TEST (k) - SIMPLE TEST***************** IF1414.2 +054200 F-VARIANCE-11. IF1414.2 +054300 MOVE ZERO TO WS-NUM. IF1414.2 +054400 MOVE -0.000020 TO MIN-RANGE. IF1414.2 +054500 MOVE 0.000020 TO MAX-RANGE. IF1414.2 +054600 F-VARIANCE-TEST-11. IF1414.2 +054700 COMPUTE WS-NUM = FUNCTION VARIANCE(A, 5, A). IF1414.2 +054800 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +054900 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +055000 PERFORM PASS IF1414.2 +055100 ELSE IF1414.2 +055200 MOVE WS-NUM TO COMPUTED-N IF1414.2 +055300 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +055400 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +055500 PERFORM FAIL. IF1414.2 +055600 GO TO F-VARIANCE-WRITE-11. IF1414.2 +055700 F-VARIANCE-DELETE-11. IF1414.2 +055800 PERFORM DE-LETE. IF1414.2 +055900 GO TO F-VARIANCE-WRITE-11. IF1414.2 +056000 F-VARIANCE-WRITE-11. IF1414.2 +056100 MOVE "F-VARIANCE-11" TO PAR-NAME. IF1414.2 +056200 PERFORM PRINT-DETAIL. IF1414.2 +056300*****************TEST (a) - COMPLEX TEST**************** IF1414.2 +056400 F-VARIANCE-12. IF1414.2 +056500 MOVE ZERO TO WS-NUM. IF1414.2 +056600 MOVE 78.9968 TO MIN-RANGE. IF1414.2 +056700 MOVE 79.0031 TO MAX-RANGE. IF1414.2 +056800 F-VARIANCE-TEST-12. IF1414.2 +056900 COMPUTE WS-NUM = FUNCTION VARIANCE(A, B) + 78. IF1414.2 +057000 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +057100 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +057200 PERFORM PASS IF1414.2 +057300 ELSE IF1414.2 +057400 MOVE WS-NUM TO COMPUTED-N IF1414.2 +057500 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +057600 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +057700 PERFORM FAIL. IF1414.2 +057800 GO TO F-VARIANCE-WRITE-12. IF1414.2 +057900 F-VARIANCE-DELETE-12. IF1414.2 +058000 PERFORM DE-LETE. IF1414.2 +058100 GO TO F-VARIANCE-WRITE-12. IF1414.2 +058200 F-VARIANCE-WRITE-12. IF1414.2 +058300 MOVE "F-VARIANCE-12" TO PAR-NAME. IF1414.2 +058400 PERFORM PRINT-DETAIL. IF1414.2 +058500*****************TEST (b) - COMPLEX TEST**************** IF1414.2 +058600 F-VARIANCE-13. IF1414.2 +058700 MOVE ZERO TO WS-NUM. IF1414.2 +058800 MOVE 139.234 TO MIN-RANGE. IF1414.2 +058900 MOVE 139.245 TO MAX-RANGE. IF1414.2 +059000 F-VARIANCE-TEST-13. IF1414.2 +059100 COMPUTE WS-NUM = FUNCTION VARIANCE(2.6 + 30, 4.5 * 2). IF1414.2 +059200 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +059300 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +059400 PERFORM PASS IF1414.2 +059500 ELSE IF1414.2 +059600 MOVE WS-NUM TO COMPUTED-N IF1414.2 +059700 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +059800 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +059900 PERFORM FAIL. IF1414.2 +060000 GO TO F-VARIANCE-WRITE-13. IF1414.2 +060100 F-VARIANCE-DELETE-13. IF1414.2 +060200 PERFORM DE-LETE. IF1414.2 +060300 GO TO F-VARIANCE-WRITE-13. IF1414.2 +060400 F-VARIANCE-WRITE-13. IF1414.2 +060500 MOVE "F-VARIANCE-13" TO PAR-NAME. IF1414.2 +060600 PERFORM PRINT-DETAIL. IF1414.2 +060700*****************TEST (c) - COMPLEX TEST**************** IF1414.2 +060800 F-VARIANCE-14. IF1414.2 +060900 MOVE ZERO TO WS-NUM. IF1414.2 +061000 MOVE 374.658 TO MIN-RANGE. IF1414.2 +061100 MOVE 374.688 TO MAX-RANGE. IF1414.2 +061200 F-VARIANCE-TEST-14. IF1414.2 +061300 COMPUTE WS-NUM = FUNCTION VARIANCE(E, 9 * A, 0, B / 2). IF1414.2 +061400 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +061500 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +061600 PERFORM PASS IF1414.2 +061700 ELSE IF1414.2 +061800 MOVE WS-NUM TO COMPUTED-N IF1414.2 +061900 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +062000 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +062100 PERFORM FAIL. IF1414.2 +062200 GO TO F-VARIANCE-WRITE-14. IF1414.2 +062300 F-VARIANCE-DELETE-14. IF1414.2 +062400 PERFORM DE-LETE. IF1414.2 +062500 GO TO F-VARIANCE-WRITE-14. IF1414.2 +062600 F-VARIANCE-WRITE-14. IF1414.2 +062700 MOVE "F-VARIANCE-14" TO PAR-NAME. IF1414.2 +062800 PERFORM PRINT-DETAIL. IF1414.2 +062900*****************TEST (d) - COMPLEX TEST**************** IF1414.2 +063000 F-VARIANCE-15. IF1414.2 +063100 MOVE ZERO TO WS-NUM. IF1414.2 +063200 MOVE 0.999960 TO MIN-RANGE. IF1414.2 +063300 MOVE 1.00004 TO MAX-RANGE. IF1414.2 +063400 F-VARIANCE-TEST-15. IF1414.2 +063500 COMPUTE WS-NUM = FUNCTION VARIANCE(A, B) + IF1414.2 +063600 FUNCTION VARIANCE(1, 1). IF1414.2 +063700 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +063800 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +063900 PERFORM PASS IF1414.2 +064000 ELSE IF1414.2 +064100 MOVE WS-NUM TO COMPUTED-N IF1414.2 +064200 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +064300 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +064400 PERFORM FAIL. IF1414.2 +064500 GO TO F-VARIANCE-WRITE-15. IF1414.2 +064600 F-VARIANCE-DELETE-15. IF1414.2 +064700 PERFORM DE-LETE. IF1414.2 +064800 GO TO F-VARIANCE-WRITE-15. IF1414.2 +064900 F-VARIANCE-WRITE-15. IF1414.2 +065000 MOVE "F-VARIANCE-15" TO PAR-NAME. IF1414.2 +065100 PERFORM PRINT-DETAIL. IF1414.2 +065200*****************TEST (e) - COMPLEX TEST**************** IF1414.2 +065300 F-VARIANCE-16. IF1414.2 +065400 MOVE ZERO TO WS-NUM. IF1414.2 +065500 MOVE -0.000040 TO MIN-RANGE. IF1414.2 +065600 MOVE 0.000040 TO MAX-RANGE. IF1414.2 +065700 F-VARIANCE-TEST-16. IF1414.2 +065800 COMPUTE WS-NUM = FUNCTION VARIANCE( IF1414.2 +065900 FUNCTION VARIANCE(0), 0). IF1414.2 +066000 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +066100 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +066200 PERFORM PASS IF1414.2 +066300 ELSE IF1414.2 +066400 MOVE WS-NUM TO COMPUTED-N IF1414.2 +066500 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +066600 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +066700 PERFORM FAIL. IF1414.2 +066800 GO TO F-VARIANCE-WRITE-16. IF1414.2 +066900 F-VARIANCE-DELETE-16. IF1414.2 +067000 PERFORM DE-LETE. IF1414.2 +067100 GO TO F-VARIANCE-WRITE-16. IF1414.2 +067200 F-VARIANCE-WRITE-16. IF1414.2 +067300 MOVE "F-VARIANCE-16" TO PAR-NAME. IF1414.2 +067400 PERFORM PRINT-DETAIL. IF1414.2 +067500*****************SPECIAL PERFORM TEST********************** IF1414.2 +067600 F-VARIANCE-17. IF1414.2 +067700 PERFORM F-VARIANCE-TEST-17 IF1414.2 +067800 UNTIL FUNCTION VARIANCE(1, 1, ARG3) > 3. IF1414.2 +067900 PERFORM PASS. IF1414.2 +068000 GO TO F-VARIANCE-WRITE-17. IF1414.2 +068100 F-VARIANCE-TEST-17. IF1414.2 +068200 COMPUTE ARG3 = ARG3 + 1. IF1414.2 +068300 F-VARIANCE-DELETE-17. IF1414.2 +068400 PERFORM DE-LETE. IF1414.2 +068500 GO TO F-VARIANCE-WRITE-17. IF1414.2 +068600 F-VARIANCE-WRITE-17. IF1414.2 +068700 MOVE "F-VARIANCE-17" TO PAR-NAME. IF1414.2 +068800 PERFORM PRINT-DETAIL. IF1414.2 +068900********************END OF TESTS*************** IF1414.2 +069000 CCVS-EXIT SECTION. IF1414.2 +069100 CCVS-999999. IF1414.2 +069200 GO TO CLOSE-FILES. IF1414.2 +*END-OF,IF141A +*HEADER,COBOL,IF142A +000100 IDENTIFICATION DIVISION. IF1424.2 +000200 PROGRAM-ID. IF1424.2 +000300 IF142A. IF1424.2 +000400 IF1424.2 +000500*********************************************************** IF1424.2 +000600* * IF1424.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1424.2 +000800* It contains tests for the Intrinsic Function * IF1424.2 +000900* WHEN-COMPILED. * IF1424.2 +001000* * IF1424.2 +001100*********************************************************** IF1424.2 +001200 ENVIRONMENT DIVISION. IF1424.2 +001300 CONFIGURATION SECTION. IF1424.2 +001400 SOURCE-COMPUTER. IF1424.2 +001500 XXXXX082. IF1424.2 +001600 OBJECT-COMPUTER. IF1424.2 +001700 XXXXX083. IF1424.2 +001800 INPUT-OUTPUT SECTION. IF1424.2 +001900 FILE-CONTROL. IF1424.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1424.2 +002100 XXXXX055. IF1424.2 +002200 DATA DIVISION. IF1424.2 +002300 FILE SECTION. IF1424.2 +002400 FD PRINT-FILE. IF1424.2 +002500 01 PRINT-REC PICTURE X(120). IF1424.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1424.2 +002700 WORKING-STORAGE SECTION. IF1424.2 +002800*********************************************************** IF1424.2 +002900* Variables specific to the Intrinsic Function Test IF142A* IF1424.2 +003000*********************************************************** IF1424.2 +003100 01 TEMP1 PIC X(21). IF1424.2 +003200 01 WS-DATE. IF1424.2 +003300 02 WS-YEAR PIC 9999. IF1424.2 +003400 88 CON-YEAR VALUE 1990 THRU 9999. IF1424.2 +003500 02 WS-MONTH PIC 99. IF1424.2 +003600 88 CON-MONTH VALUE 01 THRU 12. IF1424.2 +003700 02 WS-DAY PIC 99. IF1424.2 +003800 88 CON-DAY VALUE 01 THRU 31. IF1424.2 +003900 02 WS-HOUR PIC 99. IF1424.2 +004000 88 CON-HOUR VALUE 00 THRU 23. IF1424.2 +004100 02 WS-MIN PIC 99. IF1424.2 +004200 88 CON-MIN VALUE 00 THRU 59. IF1424.2 +004300 02 WS-SECOND PIC 99. IF1424.2 +004400 88 CON-SEC VALUE 00 THRU 59. IF1424.2 +004500 02 WS-HUNDSEC PIC 99. IF1424.2 +004600 88 CON-HUNDSEC VALUE 00 THRU 99. IF1424.2 +004700 02 WS-GREENW PIC X. IF1424.2 +004800 88 CON-GREENW VALUE "-", "+", "0". IF1424.2 +004900 02 WS-OFFSET PIC 99. IF1424.2 +005000 88 CON-OFFSET VALUE 00 THRU 13. IF1424.2 +005100* IF1424.2 +005200********************************************************** IF1424.2 +005300* IF1424.2 +005400 01 TEST-RESULTS. IF1424.2 +005500 02 FILLER PIC X VALUE SPACE. IF1424.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1424.2 +005700 02 FILLER PIC X VALUE SPACE. IF1424.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1424.2 +005900 02 FILLER PIC X VALUE SPACE. IF1424.2 +006000 02 PAR-NAME. IF1424.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1424.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1424.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1424.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1424.2 +006500 02 RE-MARK PIC X(61). IF1424.2 +006600 01 TEST-COMPUTED. IF1424.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1424.2 +006800 02 FILLER PIC X(17) VALUE IF1424.2 +006900 " COMPUTED=". IF1424.2 +007000 02 COMPUTED-X. IF1424.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1424.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1424.2 +007300 PIC -9(9).9(9). IF1424.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1424.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1424.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1424.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1424.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1424.2 +007900 04 FILLER PIC X. IF1424.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1424.2 +008100 01 TEST-CORRECT. IF1424.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1424.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1424.2 +008400 02 CORRECT-X. IF1424.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1424.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1424.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1424.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1424.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1424.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1424.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1424.2 +009200 04 FILLER PIC X. IF1424.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1424.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1424.2 +009500 01 CCVS-C-1. IF1424.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1424.2 +009700- "SS PARAGRAPH-NAME IF1424.2 +009800- " REMARKS". IF1424.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IF1424.2 +010000 01 CCVS-C-2. IF1424.2 +010100 02 FILLER PIC X VALUE SPACE. IF1424.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IF1424.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IF1424.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IF1424.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IF1424.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1424.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IF1424.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1424.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1424.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1424.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1424.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1424.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1424.2 +011700 01 CCVS-H-1. IF1424.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IF1424.2 +011900 02 FILLER PIC X(42) VALUE IF1424.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1424.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IF1424.2 +012200 01 CCVS-H-2A. IF1424.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IF1424.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1424.2 +012500 02 FILLER PIC XXXX VALUE IF1424.2 +012600 "4.2 ". IF1424.2 +012700 02 FILLER PIC X(28) VALUE IF1424.2 +012800 " COPY - NOT FOR DISTRIBUTION". IF1424.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IF1424.2 +013000 IF1424.2 +013100 01 CCVS-H-2B. IF1424.2 +013200 02 FILLER PIC X(15) VALUE IF1424.2 +013300 "TEST RESULT OF ". IF1424.2 +013400 02 TEST-ID PIC X(9). IF1424.2 +013500 02 FILLER PIC X(4) VALUE IF1424.2 +013600 " IN ". IF1424.2 +013700 02 FILLER PIC X(12) VALUE IF1424.2 +013800 " HIGH ". IF1424.2 +013900 02 FILLER PIC X(22) VALUE IF1424.2 +014000 " LEVEL VALIDATION FOR ". IF1424.2 +014100 02 FILLER PIC X(58) VALUE IF1424.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1424.2 +014300 01 CCVS-H-3. IF1424.2 +014400 02 FILLER PIC X(34) VALUE IF1424.2 +014500 " FOR OFFICIAL USE ONLY ". IF1424.2 +014600 02 FILLER PIC X(58) VALUE IF1424.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1424.2 +014800 02 FILLER PIC X(28) VALUE IF1424.2 +014900 " COPYRIGHT 1985 ". IF1424.2 +015000 01 CCVS-E-1. IF1424.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IF1424.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1424.2 +015300 02 ID-AGAIN PIC X(9). IF1424.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IF1424.2 +015500 01 CCVS-E-2. IF1424.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IF1424.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IF1424.2 +015800 02 CCVS-E-2-2. IF1424.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1424.2 +016000 03 FILLER PIC X VALUE SPACE. IF1424.2 +016100 03 ENDER-DESC PIC X(44) VALUE IF1424.2 +016200 "ERRORS ENCOUNTERED". IF1424.2 +016300 01 CCVS-E-3. IF1424.2 +016400 02 FILLER PIC X(22) VALUE IF1424.2 +016500 " FOR OFFICIAL USE ONLY". IF1424.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IF1424.2 +016700 02 FILLER PIC X(58) VALUE IF1424.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1424.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IF1424.2 +017000 02 FILLER PIC X(15) VALUE IF1424.2 +017100 " COPYRIGHT 1985". IF1424.2 +017200 01 CCVS-E-4. IF1424.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1424.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IF1424.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1424.2 +017600 02 FILLER PIC X(40) VALUE IF1424.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IF1424.2 +017800 01 XXINFO. IF1424.2 +017900 02 FILLER PIC X(19) VALUE IF1424.2 +018000 "*** INFORMATION ***". IF1424.2 +018100 02 INFO-TEXT. IF1424.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IF1424.2 +018300 04 XXCOMPUTED PIC X(20). IF1424.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IF1424.2 +018500 04 XXCORRECT PIC X(20). IF1424.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IF1424.2 +018700 01 HYPHEN-LINE. IF1424.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IF1424.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IF1424.2 +019000- "*****************************************". IF1424.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IF1424.2 +019200- "******************************". IF1424.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IF1424.2 +019400 "IF142A". IF1424.2 +019500 PROCEDURE DIVISION. IF1424.2 +019600 CCVS1 SECTION. IF1424.2 +019700 OPEN-FILES. IF1424.2 +019800 OPEN OUTPUT PRINT-FILE. IF1424.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1424.2 +020000 MOVE SPACE TO TEST-RESULTS. IF1424.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1424.2 +020200 GO TO CCVS1-EXIT. IF1424.2 +020300 CLOSE-FILES. IF1424.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1424.2 +020500 TERMINATE-CCVS. IF1424.2 +020600 STOP RUN. IF1424.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1424.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1424.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1424.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1424.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. IF1424.2 +021200 PRINT-DETAIL. IF1424.2 +021300 IF REC-CT NOT EQUAL TO ZERO IF1424.2 +021400 MOVE "." TO PARDOT-X IF1424.2 +021500 MOVE REC-CT TO DOTVALUE. IF1424.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1424.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1424.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1424.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1424.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1424.2 +022100 MOVE SPACE TO CORRECT-X. IF1424.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1424.2 +022300 MOVE SPACE TO RE-MARK. IF1424.2 +022400 HEAD-ROUTINE. IF1424.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1424.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1424.2 +022900 COLUMN-NAMES-ROUTINE. IF1424.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +023300 END-ROUTINE. IF1424.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 IF1424.2 +023500 TIMES. IF1424.2 +023600 END-RTN-EXIT. IF1424.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +023800 END-ROUTINE-1. IF1424.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1424.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1424.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. IF1424.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1424.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1424.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1424.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1424.2 +024600 END-ROUTINE-12. IF1424.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1424.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1424.2 +024900 MOVE "NO " TO ERROR-TOTAL IF1424.2 +025000 ELSE IF1424.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1424.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1424.2 +025300 PERFORM WRITE-LINE. IF1424.2 +025400 END-ROUTINE-13. IF1424.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1424.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE IF1424.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1424.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1424.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO IF1424.2 +026100 MOVE "NO " TO ERROR-TOTAL IF1424.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1424.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1424.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026600 WRITE-LINE. IF1424.2 +026700 ADD 1 TO RECORD-COUNT. IF1424.2 +026800Y IF RECORD-COUNT GREATER 42 IF1424.2 +026900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IF1424.2 +027000Y MOVE SPACE TO DUMMY-RECORD IF1424.2 +027100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1424.2 +027200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1424.2 +027300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1424.2 +027400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1424.2 +027500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1424.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IF1424.2 +028000Y MOVE ZERO TO RECORD-COUNT. IF1424.2 +028100 PERFORM WRT-LN. IF1424.2 +028200 WRT-LN. IF1424.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1424.2 +028400 MOVE SPACE TO DUMMY-RECORD. IF1424.2 +028500 BLANK-LINE-PRINT. IF1424.2 +028600 PERFORM WRT-LN. IF1424.2 +028700 FAIL-ROUTINE. IF1424.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE IF1424.2 +028900 GO TO FAIL-ROUTINE-WRITE. IF1424.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1424.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1424.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1424.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1424.2 +029500 GO TO FAIL-ROUTINE-EX. IF1424.2 +029600 FAIL-ROUTINE-WRITE. IF1424.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1424.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1424.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1424.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1424.2 +030100 FAIL-ROUTINE-EX. EXIT. IF1424.2 +030200 BAIL-OUT. IF1424.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1424.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1424.2 +030500 BAIL-OUT-WRITE. IF1424.2 +030600 MOVE CORRECT-A TO XXCORRECT. IF1424.2 +030700 MOVE COMPUTED-A TO XXCOMPUTED. IF1424.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1424.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1424.2 +031100 BAIL-OUT-EX. EXIT. IF1424.2 +031200 CCVS1-EXIT. IF1424.2 +031300 EXIT. IF1424.2 +031400******************************************************** IF1424.2 +031500* * IF1424.2 +031600* Intrinsic Function Tests IF142A - WHEN-COMPILED * IF1424.2 +031700* * IF1424.2 +031800******************************************************** IF1424.2 +031900 SECT-IF142A SECTION. IF1424.2 +032000 F-WHENCOMP-INFO. IF1424.2 +032100 MOVE "See ref. A-75 2.46" TO ANSI-REFERENCE. IF1424.2 +032200 MOVE "WHEN-COMPILED" TO FEATURE. IF1424.2 +032300*****************TEST (a) ****************************** IF1424.2 +032400 F-WHENCOMP-01. IF1424.2 +032500 MOVE SPACES TO TEMP1. IF1424.2 +032600 MOVE SPACES TO WS-DATE. IF1424.2 +032700 F-WHENCOMP-TEST-01. IF1424.2 +032800 MOVE FUNCTION WHEN-COMPILED TO TEMP1. IF1424.2 +032900 MOVE TEMP1 TO WS-DATE. IF1424.2 +033000 IF CON-YEAR AND IF1424.2 +033100 CON-MONTH AND IF1424.2 +033200 CON-DAY AND IF1424.2 +033300 CON-HOUR AND IF1424.2 +033400 CON-MIN AND IF1424.2 +033500 CON-SEC AND IF1424.2 +033600 CON-HUNDSEC AND IF1424.2 +033700 CON-GREENW AND IF1424.2 +033800 CON-OFFSET THEN IF1424.2 +033900 PERFORM PASS IF1424.2 +034000 ELSE IF1424.2 +034100 MOVE TEMP1 TO COMPUTED-A IF1424.2 +034200 MOVE "Date & Time value " TO CORRECT-X IF1424.2 +034300 PERFORM FAIL. IF1424.2 +034400 GO TO F-WHENCOMP-WRITE-01. IF1424.2 +034500 F-WHENCOMP-DELETE-01. IF1424.2 +034600 PERFORM DE-LETE. IF1424.2 +034700 GO TO F-WHENCOMP-WRITE-01. IF1424.2 +034800 F-WHENCOMP-WRITE-01. IF1424.2 +034900 MOVE "F-WHENCOMP-01" TO PAR-NAME. IF1424.2 +035000 PERFORM PRINT-DETAIL. IF1424.2 +035100*****************TEST (b) ****************************** IF1424.2 +035200 F-WHENCOMP-TEST-02. IF1424.2 +035300 IF FUNCTION WHEN-COMPILED >= TEMP1 THEN IF1424.2 +035400 PERFORM PASS IF1424.2 +035500 ELSE IF1424.2 +035600 PERFORM FAIL. IF1424.2 +035700 GO TO F-WHENCOMP-WRITE-02. IF1424.2 +035800 F-WHENCOMP-DELETE-02. IF1424.2 +035900 PERFORM DE-LETE. IF1424.2 +036000 GO TO F-WHENCOMP-WRITE-02. IF1424.2 +036100 F-WHENCOMP-WRITE-02. IF1424.2 +036200 MOVE "F-WHENCOMP-02" TO PAR-NAME. IF1424.2 +036300 PERFORM PRINT-DETAIL. IF1424.2 +036400*******************END OF TESTS************************** IF1424.2 +036500 CCVS-EXIT SECTION. IF1424.2 +036600 CCVS-999999. IF1424.2 +036700 GO TO CLOSE-FILES. IF1424.2 +*END-OF,IF142A +*HEADER,COBOL,IF401M +000100 IDENTIFICATION DIVISION. IF4014.2 +000200 PROGRAM-ID. IF4014.2 +000300 IF401M. IF4014.2 +000400 IF4014.2 +000500 IF4014.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4014.2 +000700*FEATURES. IF4014.2 +000800******************************************************************IF4014.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4014.2 +001000* FUNCTIONS: ACOS, ANNUITY, ASIN, ATAN, CHAR, COS, *IF4014.2 +001100* CURRENT-DATE, DATE-OF-INTEGER, DAY-OF-INTEGER, *IF4014.2 +001200* FACTORIAL, INTEGER, INTEGER-OF-DATE, *IF4014.2 +001300* INTEGER-OF-DAY AND INTEGER-PART. *IF4014.2 +001400******************************************************************IF4014.2 +001500 IF4014.2 +001600 ENVIRONMENT DIVISION. IF4014.2 +001700 CONFIGURATION SECTION. IF4014.2 +001800 SOURCE-COMPUTER. IF4014.2 +001900 XXXXX082. IF4014.2 +002000 OBJECT-COMPUTER. IF4014.2 +002100 XXXXX083. IF4014.2 +002200 IF4014.2 +002300 DATA DIVISION. IF4014.2 +002400 FILE SECTION. IF4014.2 +002500 WORKING-STORAGE SECTION. IF4014.2 +002600 01 TEMP1 PICTURE X(21). IF4014.2 +002700 01 WS-ANUM PICTURE X. IF4014.2 +002800 IF4014.2 +002900 PROCEDURE DIVISION. IF4014.2 +003000 IF401M-ACOS. IF4014.2 +003100 IF FUNCTION ACOS (1.0) = FUNCTION ACOS (1.0) IF4014.2 +003200 CONTINUE. IF4014.2 +003300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +003400 IF4014.2 +003500 IF401M-ANNUITY. IF4014.2 +003600 IF FUNCTION ANNUITY (0, 4) = FUNCTION ANNUITY (0, 4) IF4014.2 +003700 CONTINUE. IF4014.2 +003800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +003900 IF4014.2 +004000 IF401M-ASIN. IF4014.2 +004100 IF FUNCTION ASIN (1.0) = FUNCTION ASIN (1.0) IF4014.2 +004200 CONTINUE. IF4014.2 +004300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +004400 IF4014.2 +004500 IF401M-ATAN. IF4014.2 +004600 IF FUNCTION ATAN (1.0) = FUNCTION ATAN (1.0) IF4014.2 +004700 CONTINUE. IF4014.2 +004800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +004900 IF4014.2 +005000 IF401M-CHAR. IF4014.2 +005100 MOVE FUNCTION CHAR (37) TO WS-ANUM. IF4014.2 +005200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +005300 IF4014.2 +005400 IF401M-COS. IF4014.2 +005500 IF FUNCTION COS (1.0) = FUNCTION COS (1.0) IF4014.2 +005600 CONTINUE. IF4014.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +005800 IF4014.2 +005900 IF401M-CURRENT-DATE. IF4014.2 +006000 MOVE FUNCTION CURRENT-DATE TO TEMP1. IF4014.2 +006100*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +006200 IF4014.2 +006300 IF401M-DATE-OF-INTEGER. IF4014.2 +006400 IF FUNCTION DATE-OF-INTEGER (1) = IF4014.2 +006500 FUNCTION DATE-OF-INTEGER (1) IF4014.2 +006600 CONTINUE. IF4014.2 +006700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +006800 IF4014.2 +006900 IF401M-DAY-OF-INTEGER. IF4014.2 +007000 IF FUNCTION DAY-OF-INTEGER (1) = FUNCTION DAY-OF-INTEGER (1) IF4014.2 +007100 CONTINUE. IF4014.2 +007200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +007300 IF4014.2 +007400 IF401M-FACTORIAL. IF4014.2 +007500 IF FUNCTION FACTORIAL (1) = FUNCTION FACTORIAL (1) IF4014.2 +007600 CONTINUE. IF4014.2 +007700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +007800 IF4014.2 +007900 IF401M-INTEGER. IF4014.2 +008000 IF FUNCTION INTEGER (1.0) = FUNCTION INTEGER (1.0) IF4014.2 +008100 CONTINUE. IF4014.2 +008200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +008300 IF4014.2 +008400 IF401M-INTEGER-OF-DATE. IF4014.2 +008500 IF FUNCTION INTEGER-OF-DATE (16010101) = IF4014.2 +008600 FUNCTION INTEGER-OF-DATE (16010101) IF4014.2 +008700 CONTINUE. IF4014.2 +008800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +008900 IF4014.2 +009000 IF401M-INTEGER-OF-DAY. IF4014.2 +009100 IF FUNCTION INTEGER-OF-DAY (1601001) = IF4014.2 +009200 FUNCTION INTEGER-OF-DAY (1601001) IF4014.2 +009300 CONTINUE. IF4014.2 +009400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +009500 IF4014.2 +009600 IF401M-INTEGER-PART. IF4014.2 +009700 IF FUNCTION INTEGER-PART (4.578) = IF4014.2 +009800 FUNCTION INTEGER-PART (4.578) IF4014.2 +009900 CONTINUE. IF4014.2 +010000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +010100 IF4014.2 +010200 IF401M-END. IF4014.2 +010300 IF4014.2 +010400*TOTAL NUMBER OF FLAGS EXPECTED = 14. IF4014.2 +*END-OF,IF401M +*HEADER,COBOL,IF402M +000100 IDENTIFICATION DIVISION. IF4024.2 +000200 PROGRAM-ID. IF4024.2 +000300 IF402M. IF4024.2 +000400 IF4024.2 +000500 IF4024.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4024.2 +000700*FEATURES. IF4024.2 +000800******************************************************************IF4024.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4024.2 +001000* FUNCTIONS: LENGTH, LOG, LOG10, LOWER-CASE, MAX, MEAN, *IF4024.2 +001100* MEDIAN, MIDRANGE, MIN, MOD, NUMVAL, NUMVAL-C, *IF4024.2 +001200* ORD, ORD-MAX AND ORD-MIN. *IF4024.2 +001300******************************************************************IF4024.2 +001400 IF4024.2 +001500 ENVIRONMENT DIVISION. IF4024.2 +001600 CONFIGURATION SECTION. IF4024.2 +001700 SOURCE-COMPUTER. IF4024.2 +001800 XXXXX082. IF4024.2 +001900 OBJECT-COMPUTER. IF4024.2 +002000 XXXXX083. IF4024.2 +002100 IF4024.2 +002200 DATA DIVISION. IF4024.2 +002300 FILE SECTION. IF4024.2 +002400 WORKING-STORAGE SECTION. IF4024.2 +002500 01 WS-AN-TEMP PICTURE X(3). IF4024.2 +002600 01 WS-TABLE-VALUE PICTURE X(27) IF4024.2 +002700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ ". IF4024.2 +002800 01 WS-TABLE-TOTAL REDEFINES WS-TABLE-VALUE. IF4024.2 +002900 05 WS-TABLE-LV3 OCCURS 3 TIMES. IF4024.2 +003000 10 WS-TABLE-LV2 OCCURS 3 TIMES. IF4024.2 +003100 15 WS-TABLE PICTURE X OCCURS 3 TIMES. IF4024.2 +003200 IF4024.2 +003300 PROCEDURE DIVISION. IF4024.2 +003400 IF402M-LENGTH. IF4024.2 +003500 IF FUNCTION LENGTH ("ABC") = FUNCTION LENGTH ("ABC") IF4024.2 +003600 CONTINUE. IF4024.2 +003700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +003800 IF4024.2 +003900 IF402M-LOG. IF4024.2 +004000 IF FUNCTION LOG (1.0) = FUNCTION LOG (1.0) IF4024.2 +004100 CONTINUE. IF4024.2 +004200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +004300 IF4024.2 +004400 IF402M-LOG10. IF4024.2 +004500 IF FUNCTION LOG10 (1.0) = FUNCTION LOG10 (1.0) IF4024.2 +004600 CONTINUE. IF4024.2 +004700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +004800 IF4024.2 +004900 IF402M-LOWER-CASE. IF4024.2 +005000 MOVE FUNCTION LOWER-CASE ("ABC") TO WS-AN-TEMP. IF4024.2 +005100*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +005200 IF4024.2 +005300 IF402M-MAX. IF4024.2 +005400 IF FUNCTION MAX (5, 6, 10, 3, 7) = IF4024.2 +005500 FUNCTION MAX (5, 6, 10, 3, 7) IF4024.2 +005600 CONTINUE. IF4024.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +005800 IF4024.2 +005900 MOVE FUNCTION MAX (WS-TABLE (ALL, ALL, ALL)) TO WS-AN-TEMP. IF4024.2 +006000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +006100 IF4024.2 +006200 IF402M-MEAN. IF4024.2 +006300 IF FUNCTION MEAN (5, -2, -14, 0) = IF4024.2 +006400 FUNCTION MEAN (5, -2, -14, 0) IF4024.2 +006500 CONTINUE. IF4024.2 +006600*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +006700 IF4024.2 +006800 IF402M-MEDIAN. IF4024.2 +006900 IF FUNCTION MEDIAN (5, -2, -14, 0) = IF4024.2 +007000 FUNCTION MEDIAN (5, -2, -14, 0) IF4024.2 +007100 CONTINUE. IF4024.2 +007200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +007300 IF4024.2 +007400 IF402M-MIDRANGE. IF4024.2 +007500 IF FUNCTION MIDRANGE (5, -2, -14, 0) = IF4024.2 +007600 FUNCTION MIDRANGE (5, -2, -14, 0) IF4024.2 +007700 CONTINUE. IF4024.2 +007800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +007900 IF4024.2 +008000 IF402M-MIN. IF4024.2 +008100 IF FUNCTION MIN (5, 6, 10, 3, 7) = IF4024.2 +008200 FUNCTION MIN (5, 6, 10, 3, 7) IF4024.2 +008300 CONTINUE. IF4024.2 +008400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +008500 IF4024.2 +008600 MOVE FUNCTION MIN (WS-TABLE (ALL, ALL, ALL)) TO WS-AN-TEMP. IF4024.2 +008700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +008800 IF4024.2 +008900 IF402M-MOD. IF4024.2 +009000 IF FUNCTION MOD (6, 6) = FUNCTION MOD (6, 6) IF4024.2 +009100 CONTINUE. IF4024.2 +009200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +009300 IF4024.2 +009400 IF402M-NUMVAL. IF4024.2 +009500 IF FUNCTION NUMVAL ("4738") = FUNCTION NUMVAL ("4738") IF4024.2 +009600 CONTINUE. IF4024.2 +009700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +009800 IF4024.2 +009900 IF402M-NUMVAL-C. IF4024.2 +010000 IF FUNCTION NUMVAL-C ("-$1,234.56") = IF4024.2 +010100 FUNCTION NUMVAL-C ("-$1,234.56") IF4024.2 +010200 CONTINUE. IF4024.2 +010300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +010400 IF4024.2 +010500 IF402M-ORD. IF4024.2 +010600 IF FUNCTION ORD ("A") = FUNCTION ORD ("A") IF4024.2 +010700 CONTINUE. IF4024.2 +010800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +010900 IF4024.2 +011000 IF402M-ORD-MAX. IF4024.2 +011100 IF FUNCTION ORD-MAX (5, 3, 2, 8, 3, 1) = IF4024.2 +011200 FUNCTION ORD-MAX (5, 3, 2, 8, 3, 1) IF4024.2 +011300 CONTINUE. IF4024.2 +011400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +011500 IF4024.2 +011600 IF402M-ORD-MIN. IF4024.2 +011700 IF FUNCTION ORD-MIN (5, 3, 2, 8, 3, 1) = IF4024.2 +011800 FUNCTION ORD-MIN (5, 3, 2, 8, 3, 1) IF4024.2 +011900 CONTINUE. IF4024.2 +012000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +012100 IF4024.2 +012200 IF402M-END. IF4024.2 +012300 IF4024.2 +012400*TOTAL NUMBER OF FLAGS EXPECTED = 17. IF4024.2 +*END-OF,IF402M +*HEADER,COBOL,IF403M +000100 IDENTIFICATION DIVISION. IF4034.2 +000200 PROGRAM-ID. IF4034.2 +000300 IF403M. IF4034.2 +000400 IF4034.2 +000500 IF4034.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4034.2 +000700*FEATURES. IF4034.2 +000800******************************************************************IF4034.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4034.2 +001000* FUNCTIONS: PRESENT-VALUE, RANDOM, RANGE, REM, REVERSE, *IF4034.2 +001100* SIN, SQRT, STANDARD-DEVIATION, SUM, TAN, *IF4034.2 +001200* UPPER-CASE, VARIANCE AND WHEN-COMPILED. *IF4034.2 +001300******************************************************************IF4034.2 +001400 IF4034.2 +001500 ENVIRONMENT DIVISION. IF4034.2 +001600 CONFIGURATION SECTION. IF4034.2 +001700 SOURCE-COMPUTER. IF4034.2 +001800 XXXXX082. IF4034.2 +001900 OBJECT-COMPUTER. IF4034.2 +002000 XXXXX083. IF4034.2 +002100 IF4034.2 +002200 DATA DIVISION. IF4034.2 +002300 FILE SECTION. IF4034.2 +002400 WORKING-STORAGE SECTION. IF4034.2 +002500 01 WS-AN-TEMP PICTURE X(21). IF4034.2 +002600 IF4034.2 +002700 PROCEDURE DIVISION. IF4034.2 +002800 IF403M-PRESENT-VALUE. IF4034.2 +002900 IF FUNCTION PRESENT-VALUE (0, 23, 12, 9) = IF4034.2 +003000 FUNCTION PRESENT-VALUE (0, 23, 12, 9) IF4034.2 +003100 CONTINUE. IF4034.2 +003200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +003300 IF4034.2 +003400 IF403M-RANDOM. IF4034.2 +003500 IF FUNCTION RANDOM (1) = FUNCTION RANDOM (1) IF4034.2 +003600 CONTINUE. IF4034.2 +003700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +003800 IF4034.2 +003900 IF403M-RANGE. IF4034.2 +004000 IF FUNCTION RANGE (5, -2, -14, 0) = IF4034.2 +004100 FUNCTION RANGE (5, -2, -14, 0) IF4034.2 +004200 CONTINUE. IF4034.2 +004300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +004400 IF4034.2 +004500 IF403M-REM. IF4034.2 +004600 IF FUNCTION REM (0, 20) = FUNCTION REM (0, 20) IF4034.2 +004700 CONTINUE. IF4034.2 +004800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +004900 IF4034.2 +005000 IF403M-REVERSE. IF4034.2 +005100 MOVE FUNCTION REVERSE ("ABC") TO WS-AN-TEMP. IF4034.2 +005200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +005300 IF4034.2 +005400 IF403M-SIN. IF4034.2 +005500 IF FUNCTION SIN (1.0) = FUNCTION SIN (1.0) IF4034.2 +005600 CONTINUE. IF4034.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +005800 IF4034.2 +005900 IF403M-SQRT. IF4034.2 +006000 IF FUNCTION SQRT (0) = FUNCTION SQRT (0) IF4034.2 +006100 CONTINUE. IF4034.2 +006200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +006300 IF4034.2 +006400 IF403M-STANDARD-DEVIATION. IF4034.2 +006500 IF FUNCTION STANDARD-DEVIATION (5, -2, -14, 0) = IF4034.2 +006600 FUNCTION STANDARD-DEVIATION (5, -2, -14, 0) IF4034.2 +006700 CONTINUE. IF4034.2 +006800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +006900 IF4034.2 +007000 IF403M-SUM. IF4034.2 +007100 IF FUNCTION SUM (5, -2, -14, 0) = IF4034.2 +007200 FUNCTION SUM (5, -2, -14, 0) IF4034.2 +007300 CONTINUE. IF4034.2 +007400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +007500 IF4034.2 +007600 IF403M-TAN. IF4034.2 +007700 IF FUNCTION TAN (1.0) = FUNCTION TAN (1.0) IF4034.2 +007800 CONTINUE. IF4034.2 +007900*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +008000 IF4034.2 +008100 IF403M-UPPER-CASE. IF4034.2 +008200 MOVE FUNCTION UPPER-CASE ("abc") TO WS-AN-TEMP. IF4034.2 +008300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +008400 IF4034.2 +008500 IF403M-VARIANCE. IF4034.2 +008600 IF FUNCTION VARIANCE (5, -2, -14, 0) = IF4034.2 +008700 FUNCTION VARIANCE (5, -2, -14, 0) IF4034.2 +008800 CONTINUE. IF4034.2 +008900*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +009000 IF4034.2 +009100 IF403M-WHEN-COMPILED. IF4034.2 +009200 MOVE FUNCTION WHEN-COMPILED TO WS-AN-TEMP. IF4034.2 +009300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +009400 IF4034.2 +009500 IF403M-END. IF4034.2 +009600 IF4034.2 +009700*TOTAL NUMBER OF FLAGS EXPECTED = 13. IF4034.2 +*END-OF,IF403M +*HEADER,COBOL,IX101A +000100 IDENTIFICATION DIVISION. IX1014.2 +000200 PROGRAM-ID. IX1014.2 +000300 IX101A. IX1014.2 +000400**************************************************************** IX1014.2 +000500* * IX1014.2 +000600* VALIDATION FOR:- * IX1014.2 +000700* * IX1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +000900* * IX1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1014.2 +001100* * IX1014.2 +001200**************************************************************** IX1014.2 +001300* THIS PROGRAM IS THE FIRST OF A SERIES WHICH PROCESSES AN IX1014.2 +001400* INDEXED FILE. THE FUNCTION OF THIS PROGRAM IS TO CREATE AN IX1014.2 +001500* INDEXED FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL) AND VERIFYIX1014.2 +001600* THAT IT WAS CREATED AS EXPECTED. THE FILE IS IDENTIFIED AS IX1014.2 +001700* "IX-FS1" AND IS PASSED TO PROGRAM IX102 FOR PROCESSING. IX1014.2 +001800* IX1014.2 +001900* IX1014.2 +002000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1014.2 +002100* IX1014.2 +002200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1014.2 +002300* CLAUSE FOR DATA FILE IX-FS1 IX1014.2 +002400* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1014.2 +002500* CLAUSE FOR INDEX FILE IX-FS1 IX1014.2 +002600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1014.2 +002700* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX1014.2 +002800* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1014.2 +002900* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1014.2 +003000* IX1014.2 +003100* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1014.2 +003200* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1014.2 +003300* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1014.2 +003400* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1014.2 +003500* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1014.2 +003600* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1014.2 +003700* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1014.2 +003800* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1014.2 +003900* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1014.2 +004000* THEY ARE AS FOLLOWS IX1014.2 +004100* IX1014.2 +004200* J SELECTS X-CARD 44 IX1014.2 +004300* IX1014.2 +004400****************************************************** IX1014.2 +004500 ENVIRONMENT DIVISION. IX1014.2 +004600 CONFIGURATION SECTION. IX1014.2 +004700 SOURCE-COMPUTER. IX1014.2 +004800 XXXXX082. IX1014.2 +004900 OBJECT-COMPUTER. IX1014.2 +005000 XXXXX083. IX1014.2 +005100 INPUT-OUTPUT SECTION. IX1014.2 +005200 FILE-CONTROL. IX1014.2 +005300P SELECT RAW-DATA ASSIGN TO IX1014.2 +005400P XXXXX062 IX1014.2 +005500P ORGANIZATION IS INDEXED IX1014.2 +005600P ACCESS MODE IS RANDOM IX1014.2 +005700P RECORD KEY IS RAW-DATA-KEY. IX1014.2 +005800 SELECT PRINT-FILE ASSIGN TO IX1014.2 +005900 XXXXX055. IX1014.2 +006000 SELECT IX-FS1 ASSIGN TO IX1014.2 +006100 XXXXP024 IX1014.2 +006200J XXXXP044 IX1014.2 +006300 ORGANIZATION IS INDEXED IX1014.2 +006400 RECORD KEY IS IX-FS1-KEY IX1014.2 +006500 ACCESS MODE IS SEQUENTIAL. IX1014.2 +006600 DATA DIVISION. IX1014.2 +006700 FILE SECTION. IX1014.2 +006800P IX1014.2 +006900PFD RAW-DATA. IX1014.2 +007000P IX1014.2 +007100P01 RAW-DATA-SATZ. IX1014.2 +007200P 05 RAW-DATA-KEY PIC X(6). IX1014.2 +007300P 05 C-DATE PIC 9(6). IX1014.2 +007400P 05 C-TIME PIC 9(8). IX1014.2 +007500P 05 C-NO-OF-TESTS PIC 99. IX1014.2 +007600P 05 C-OK PIC 999. IX1014.2 +007700P 05 C-ALL PIC 999. IX1014.2 +007800P 05 C-FAIL PIC 999. IX1014.2 +007900P 05 C-DELETED PIC 999. IX1014.2 +008000P 05 C-INSPECT PIC 999. IX1014.2 +008100P 05 C-NOTE PIC X(13). IX1014.2 +008200P 05 C-INDENT PIC X. IX1014.2 +008300P 05 C-ABORT PIC X(8). IX1014.2 +008400 FD PRINT-FILE. IX1014.2 +008500 01 PRINT-REC PICTURE X(120). IX1014.2 +008600 01 DUMMY-RECORD PICTURE X(120). IX1014.2 +008700 FD IX-FS1 IX1014.2 +008800C LABEL RECORD IS STANDARD IX1014.2 +008900C DATA RECORD IS IX-FS1R1-F-G-240 IX1014.2 +009000 BLOCK CONTAINS 1 RECORDS IX1014.2 +009100 RECORD CONTAINS 240 CHARACTERS. IX1014.2 +009200 01 IX-FS1R1-F-G-240. IX1014.2 +009300 03 IX-FS1-WRK-120 PIC X(120). IX1014.2 +009400 03 IX-FS1-GRP-120. IX1014.2 +009500 05 FILLER PIC X(8). IX1014.2 +009600 05 IX-FS1-KEY PIC X(29). IX1014.2 +009700 05 FILLER PIC X(83). IX1014.2 +009800 WORKING-STORAGE SECTION. IX1014.2 +009900 01 GRP-0101. IX1014.2 +010000 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX1014.2 +010100 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1014.2 +010200 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX1014.2 +010300 01 FILE-RECORD-INFORMATION-REC. IX1014.2 +010400 03 FILE-RECORD-INFO-SKELETON. IX1014.2 +010500 05 FILLER PICTURE X(48) VALUE IX1014.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1014.2 +010700 05 FILLER PICTURE X(46) VALUE IX1014.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1014.2 +010900 05 FILLER PICTURE X(26) VALUE IX1014.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". IX1014.2 +011100 05 FILLER PICTURE X(37) VALUE IX1014.2 +011200 ",RECKEY= ". IX1014.2 +011300 05 FILLER PICTURE X(38) VALUE IX1014.2 +011400 ",ALTKEY1= ". IX1014.2 +011500 05 FILLER PICTURE X(38) VALUE IX1014.2 +011600 ",ALTKEY2= ". IX1014.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.IX1014.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1014.2 +011900 05 FILE-RECORD-INFO-P1-120. IX1014.2 +012000 07 FILLER PIC X(5). IX1014.2 +012100 07 XFILE-NAME PIC X(6). IX1014.2 +012200 07 FILLER PIC X(8). IX1014.2 +012300 07 XRECORD-NAME PIC X(6). IX1014.2 +012400 07 FILLER PIC X(1). IX1014.2 +012500 07 REELUNIT-NUMBER PIC 9(1). IX1014.2 +012600 07 FILLER PIC X(7). IX1014.2 +012700 07 XRECORD-NUMBER PIC 9(6). IX1014.2 +012800 07 FILLER PIC X(6). IX1014.2 +012900 07 UPDATE-NUMBER PIC 9(2). IX1014.2 +013000 07 FILLER PIC X(5). IX1014.2 +013100 07 ODO-NUMBER PIC 9(4). IX1014.2 +013200 07 FILLER PIC X(5). IX1014.2 +013300 07 XPROGRAM-NAME PIC X(5). IX1014.2 +013400 07 FILLER PIC X(7). IX1014.2 +013500 07 XRECORD-LENGTH PIC 9(6). IX1014.2 +013600 07 FILLER PIC X(7). IX1014.2 +013700 07 CHARS-OR-RECORDS PIC X(2). IX1014.2 +013800 07 FILLER PIC X(1). IX1014.2 +013900 07 XBLOCK-SIZE PIC 9(4). IX1014.2 +014000 07 FILLER PIC X(6). IX1014.2 +014100 07 RECORDS-IN-FILE PIC 9(6). IX1014.2 +014200 07 FILLER PIC X(5). IX1014.2 +014300 07 XFILE-ORGANIZATION PIC X(2). IX1014.2 +014400 07 FILLER PIC X(6). IX1014.2 +014500 07 XLABEL-TYPE PIC X(1). IX1014.2 +014600 05 FILE-RECORD-INFO-P121-240. IX1014.2 +014700 07 FILLER PIC X(8). IX1014.2 +014800 07 XRECORD-KEY PIC X(29). IX1014.2 +014900 07 FILLER PIC X(9). IX1014.2 +015000 07 ALTERNATE-KEY1 PIC X(29). IX1014.2 +015100 07 FILLER PIC X(9). IX1014.2 +015200 07 ALTERNATE-KEY2 PIC X(29). IX1014.2 +015300 07 FILLER PIC X(7). IX1014.2 +015400 01 TEST-RESULTS. IX1014.2 +015500 02 FILLER PIC X VALUE SPACE. IX1014.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. IX1014.2 +015700 02 FILLER PIC X VALUE SPACE. IX1014.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. IX1014.2 +015900 02 FILLER PIC X VALUE SPACE. IX1014.2 +016000 02 PAR-NAME. IX1014.2 +016100 03 FILLER PIC X(19) VALUE SPACE. IX1014.2 +016200 03 PARDOT-X PIC X VALUE SPACE. IX1014.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. IX1014.2 +016400 02 FILLER PIC X(8) VALUE SPACE. IX1014.2 +016500 02 RE-MARK PIC X(61). IX1014.2 +016600 01 TEST-COMPUTED. IX1014.2 +016700 02 FILLER PIC X(30) VALUE SPACE. IX1014.2 +016800 02 FILLER PIC X(17) VALUE IX1014.2 +016900 " COMPUTED=". IX1014.2 +017000 02 COMPUTED-X. IX1014.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1014.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A IX1014.2 +017300 PIC -9(9).9(9). IX1014.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1014.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1014.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1014.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. IX1014.2 +017800 04 COMPUTED-18V0 PIC -9(18). IX1014.2 +017900 04 FILLER PIC X. IX1014.2 +018000 03 FILLER PIC X(50) VALUE SPACE. IX1014.2 +018100 01 TEST-CORRECT. IX1014.2 +018200 02 FILLER PIC X(30) VALUE SPACE. IX1014.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". IX1014.2 +018400 02 CORRECT-X. IX1014.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. IX1014.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1014.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1014.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1014.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1014.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. IX1014.2 +019100 04 CORRECT-18V0 PIC -9(18). IX1014.2 +019200 04 FILLER PIC X. IX1014.2 +019300 03 FILLER PIC X(2) VALUE SPACE. IX1014.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1014.2 +019500 01 CCVS-C-1. IX1014.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1014.2 +019700- "SS PARAGRAPH-NAME IX1014.2 +019800- " REMARKS". IX1014.2 +019900 02 FILLER PIC X(20) VALUE SPACE. IX1014.2 +020000 01 CCVS-C-2. IX1014.2 +020100 02 FILLER PIC X VALUE SPACE. IX1014.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". IX1014.2 +020300 02 FILLER PIC X(15) VALUE SPACE. IX1014.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". IX1014.2 +020500 02 FILLER PIC X(94) VALUE SPACE. IX1014.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1014.2 +020700 01 REC-CT PIC 99 VALUE ZERO. IX1014.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1014.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1014.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1014.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1014.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1014.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1014.2 +021700 01 CCVS-H-1. IX1014.2 +021800 02 FILLER PIC X(39) VALUE SPACES. IX1014.2 +021900 02 FILLER PIC X(42) VALUE IX1014.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1014.2 +022100 02 FILLER PIC X(39) VALUE SPACES. IX1014.2 +022200 01 CCVS-H-2A. IX1014.2 +022300 02 FILLER PIC X(40) VALUE SPACE. IX1014.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1014.2 +022500 02 FILLER PIC XXXX VALUE IX1014.2 +022600 "4.2 ". IX1014.2 +022700 02 FILLER PIC X(28) VALUE IX1014.2 +022800 " COPY - NOT FOR DISTRIBUTION". IX1014.2 +022900 02 FILLER PIC X(41) VALUE SPACE. IX1014.2 +023000 IX1014.2 +023100 01 CCVS-H-2B. IX1014.2 +023200 02 FILLER PIC X(15) VALUE IX1014.2 +023300 "TEST RESULT OF ". IX1014.2 +023400 02 TEST-ID PIC X(9). IX1014.2 +023500 02 FILLER PIC X(4) VALUE IX1014.2 +023600 " IN ". IX1014.2 +023700 02 FILLER PIC X(12) VALUE IX1014.2 +023800 " HIGH ". IX1014.2 +023900 02 FILLER PIC X(22) VALUE IX1014.2 +024000 " LEVEL VALIDATION FOR ". IX1014.2 +024100 02 FILLER PIC X(58) VALUE IX1014.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +024300 01 CCVS-H-3. IX1014.2 +024400 02 FILLER PIC X(34) VALUE IX1014.2 +024500 " FOR OFFICIAL USE ONLY ". IX1014.2 +024600 02 FILLER PIC X(58) VALUE IX1014.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1014.2 +024800 02 FILLER PIC X(28) VALUE IX1014.2 +024900 " COPYRIGHT 1985 ". IX1014.2 +025000 01 CCVS-E-1. IX1014.2 +025100 02 FILLER PIC X(52) VALUE SPACE. IX1014.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1014.2 +025300 02 ID-AGAIN PIC X(9). IX1014.2 +025400 02 FILLER PIC X(45) VALUE SPACES. IX1014.2 +025500 01 CCVS-E-2. IX1014.2 +025600 02 FILLER PIC X(31) VALUE SPACE. IX1014.2 +025700 02 FILLER PIC X(21) VALUE SPACE. IX1014.2 +025800 02 CCVS-E-2-2. IX1014.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1014.2 +026000 03 FILLER PIC X VALUE SPACE. IX1014.2 +026100 03 ENDER-DESC PIC X(44) VALUE IX1014.2 +026200 "ERRORS ENCOUNTERED". IX1014.2 +026300 01 CCVS-E-3. IX1014.2 +026400 02 FILLER PIC X(22) VALUE IX1014.2 +026500 " FOR OFFICIAL USE ONLY". IX1014.2 +026600 02 FILLER PIC X(12) VALUE SPACE. IX1014.2 +026700 02 FILLER PIC X(58) VALUE IX1014.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +026900 02 FILLER PIC X(13) VALUE SPACE. IX1014.2 +027000 02 FILLER PIC X(15) VALUE IX1014.2 +027100 " COPYRIGHT 1985". IX1014.2 +027200 01 CCVS-E-4. IX1014.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1014.2 +027400 02 FILLER PIC X(4) VALUE " OF ". IX1014.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1014.2 +027600 02 FILLER PIC X(40) VALUE IX1014.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". IX1014.2 +027800 01 XXINFO. IX1014.2 +027900 02 FILLER PIC X(19) VALUE IX1014.2 +028000 "*** INFORMATION ***". IX1014.2 +028100 02 INFO-TEXT. IX1014.2 +028200 04 FILLER PIC X(8) VALUE SPACE. IX1014.2 +028300 04 XXCOMPUTED PIC X(20). IX1014.2 +028400 04 FILLER PIC X(5) VALUE SPACE. IX1014.2 +028500 04 XXCORRECT PIC X(20). IX1014.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). IX1014.2 +028700 01 HYPHEN-LINE. IX1014.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. IX1014.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************IX1014.2 +029000- "*****************************************". IX1014.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************IX1014.2 +029200- "******************************". IX1014.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE IX1014.2 +029400 "IX101A". IX1014.2 +029500 PROCEDURE DIVISION. IX1014.2 +029600 CCVS1 SECTION. IX1014.2 +029700 OPEN-FILES. IX1014.2 +029800P OPEN I-O RAW-DATA. IX1014.2 +029900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1014.2 +030000P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1014.2 +030100P MOVE "ABORTED " TO C-ABORT. IX1014.2 +030200P ADD 1 TO C-NO-OF-TESTS. IX1014.2 +030300P ACCEPT C-DATE FROM DATE. IX1014.2 +030400P ACCEPT C-TIME FROM TIME. IX1014.2 +030500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1014.2 +030600PEND-E-1. IX1014.2 +030700P CLOSE RAW-DATA. IX1014.2 +030800 OPEN OUTPUT PRINT-FILE. IX1014.2 +030900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1014.2 +031000 MOVE SPACE TO TEST-RESULTS. IX1014.2 +031100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1014.2 +031200 MOVE ZERO TO REC-SKL-SUB. IX1014.2 +031300 PERFORM CCVS-INIT-FILE 9 TIMES. IX1014.2 +031400 CCVS-INIT-FILE. IX1014.2 +031500 ADD 1 TO REC-SKL-SUB. IX1014.2 +031600 MOVE FILE-RECORD-INFO-SKELETON IX1014.2 +031700 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1014.2 +031800 CCVS-INIT-EXIT. IX1014.2 +031900 GO TO CCVS1-EXIT. IX1014.2 +032000 CLOSE-FILES. IX1014.2 +032100P OPEN I-O RAW-DATA. IX1014.2 +032200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1014.2 +032300P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1014.2 +032400P MOVE "OK. " TO C-ABORT. IX1014.2 +032500P MOVE PASS-COUNTER TO C-OK. IX1014.2 +032600P MOVE ERROR-HOLD TO C-ALL. IX1014.2 +032700P MOVE ERROR-COUNTER TO C-FAIL. IX1014.2 +032800P MOVE DELETE-COUNTER TO C-DELETED. IX1014.2 +032900P MOVE INSPECT-COUNTER TO C-INSPECT. IX1014.2 +033000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1014.2 +033100PEND-E-2. IX1014.2 +033200P CLOSE RAW-DATA. IX1014.2 +033300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1014.2 +033400 TERMINATE-CCVS. IX1014.2 +033500S EXIT PROGRAM. IX1014.2 +033600STERMINATE-CALL. IX1014.2 +033700 STOP RUN. IX1014.2 +033800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1014.2 +033900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1014.2 +034000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1014.2 +034100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1014.2 +034200 MOVE "****TEST DELETED****" TO RE-MARK. IX1014.2 +034300 PRINT-DETAIL. IX1014.2 +034400 IF REC-CT NOT EQUAL TO ZERO IX1014.2 +034500 MOVE "." TO PARDOT-X IX1014.2 +034600 MOVE REC-CT TO DOTVALUE. IX1014.2 +034700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1014.2 +034800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1014.2 +034900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1014.2 +035000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1014.2 +035100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1014.2 +035200 MOVE SPACE TO CORRECT-X. IX1014.2 +035300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1014.2 +035400 MOVE SPACE TO RE-MARK. IX1014.2 +035500 HEAD-ROUTINE. IX1014.2 +035600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +035700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +035800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1014.2 +035900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1014.2 +036000 COLUMN-NAMES-ROUTINE. IX1014.2 +036100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +036200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +036300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +036400 END-ROUTINE. IX1014.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1014.2 +036600 END-RTN-EXIT. IX1014.2 +036700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +036800 END-ROUTINE-1. IX1014.2 +036900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1014.2 +037000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1014.2 +037100 ADD PASS-COUNTER TO ERROR-HOLD. IX1014.2 +037200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1014.2 +037300 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1014.2 +037400 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1014.2 +037500 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1014.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1014.2 +037700 END-ROUTINE-12. IX1014.2 +037800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1014.2 +037900 IF ERROR-COUNTER IS EQUAL TO ZERO IX1014.2 +038000 MOVE "NO " TO ERROR-TOTAL IX1014.2 +038100 ELSE IX1014.2 +038200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1014.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1014.2 +038400 PERFORM WRITE-LINE. IX1014.2 +038500 END-ROUTINE-13. IX1014.2 +038600 IF DELETE-COUNTER IS EQUAL TO ZERO IX1014.2 +038700 MOVE "NO " TO ERROR-TOTAL ELSE IX1014.2 +038800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1014.2 +038900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1014.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039100 IF INSPECT-COUNTER EQUAL TO ZERO IX1014.2 +039200 MOVE "NO " TO ERROR-TOTAL IX1014.2 +039300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1014.2 +039400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1014.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039700 WRITE-LINE. IX1014.2 +039800 ADD 1 TO RECORD-COUNT. IX1014.2 +039900Y IF RECORD-COUNT GREATER 42 IX1014.2 +040000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1014.2 +040100Y MOVE SPACE TO DUMMY-RECORD IX1014.2 +040200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1014.2 +040300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1014.2 +040400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1014.2 +040500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1014.2 +040600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1014.2 +040700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +040800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +040900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +041000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1014.2 +041100Y MOVE ZERO TO RECORD-COUNT. IX1014.2 +041200 PERFORM WRT-LN. IX1014.2 +041300 WRT-LN. IX1014.2 +041400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1014.2 +041500 MOVE SPACE TO DUMMY-RECORD. IX1014.2 +041600 BLANK-LINE-PRINT. IX1014.2 +041700 PERFORM WRT-LN. IX1014.2 +041800 FAIL-ROUTINE. IX1014.2 +041900 IF COMPUTED-X NOT EQUAL TO SPACE IX1014.2 +042000 GO TO FAIL-ROUTINE-WRITE. IX1014.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1014.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1014.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1014.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +042500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1014.2 +042600 GO TO FAIL-ROUTINE-EX. IX1014.2 +042700 FAIL-ROUTINE-WRITE. IX1014.2 +042800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1014.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1014.2 +043000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1014.2 +043100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1014.2 +043200 FAIL-ROUTINE-EX. EXIT. IX1014.2 +043300 BAIL-OUT. IX1014.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1014.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1014.2 +043600 BAIL-OUT-WRITE. IX1014.2 +043700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1014.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1014.2 +043900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +044000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1014.2 +044100 BAIL-OUT-EX. EXIT. IX1014.2 +044200 CCVS1-EXIT. IX1014.2 +044300 EXIT. IX1014.2 +044400 SECT-IX-01-001 SECTION. IX1014.2 +044500 WRITE-INIT-GF-01. IX1014.2 +044600 MOVE "FILE CREATE IX-FS1" TO FEATURE. IX1014.2 +044700 OPEN OUTPUT IX-FS1. IX1014.2 +044800 MOVE "IX-FS1" TO XFILE-NAME (1). IX1014.2 +044900 MOVE "IX-F-G" TO XRECORD-NAME (1). IX1014.2 +045000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1014.2 +045100 MOVE 000240 TO XRECORD-LENGTH (1). IX1014.2 +045200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1014.2 +045300 MOVE 0001 TO XBLOCK-SIZE (1). IX1014.2 +045400 MOVE 000500 TO RECORDS-IN-FILE (1). IX1014.2 +045500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1014.2 +045600 MOVE "S" TO XLABEL-TYPE (1). IX1014.2 +045700 MOVE 000001 TO XRECORD-NUMBER (1). IX1014.2 +045800 WRITE-TEST-GF-01. IX1014.2 +045900 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX1014.2 +046000 MOVE GRP-0101 TO XRECORD-KEY (1). IX1014.2 +046100 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1014.2 +046200 WRITE IX-FS1R1-F-G-240 IX1014.2 +046300 INVALID KEY GO TO WRITE-FAIL-GF-01. IX1014.2 +046400 IF XRECORD-NUMBER (1) EQUAL TO 500 IX1014.2 +046500 GO TO WRITE-PASS-GF-01. IX1014.2 +046600 ADD 000001 TO XRECORD-NUMBER (1). IX1014.2 +046700 GO TO WRITE-TEST-GF-01. IX1014.2 +046800 WRITE-FAIL-GF-01. IX1014.2 +046900 MOVE "IX-41 4.9.2 " TO RE-MARK. IX1014.2 +047000 PERFORM FAIL. IX1014.2 +047100 GO TO WRITE-WRITE-GF-01. IX1014.2 +047200 WRITE-PASS-GF-01. IX1014.2 +047300 PERFORM PASS. IX1014.2 +047400 WRITE-WRITE-GF-01. IX1014.2 +047500 MOVE "WRITE-TEST-GF-01" TO PAR-NAME IX1014.2 +047600 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. IX1014.2 +047700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX1014.2 +047800 PERFORM PRINT-DETAIL. IX1014.2 +047900 CLOSE IX-FS1. IX1014.2 +048000 READ-INIT-GF-01. IX1014.2 +048100 OPEN INPUT IX-FS1. IX1014.2 +048200 MOVE ZERO TO WRK-DU-09V00-001. IX1014.2 +048300 READ-TEST-GF-01. IX1014.2 +048400 READ IX-FS1 IX1014.2 +048500 AT END GO TO READ-TEST-GF-01-1. IX1014.2 +048600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1014.2 +048700 ADD 1 TO WRK-DU-09V00-001. IX1014.2 +048800 IF WRK-DU-09V00-001 GREATER 500 IX1014.2 +048900 MOVE "MORE THAN 500 RECORDS" TO RE-MARK IX1014.2 +049000 GO TO READ-TEST-GF-01-1. IX1014.2 +049100 GO TO READ-TEST-GF-01. IX1014.2 +049200 READ-TEST-GF-01-1. IX1014.2 +049300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX1014.2 +049400 MOVE "IX-28 4.5.2 " TO RE-MARK IX1014.2 +049500 PERFORM FAIL IX1014.2 +049600 ELSE IX1014.2 +049700 PERFORM PASS. IX1014.2 +049800 GO TO READ-WRITE-GF-01. IX1014.2 +049900 READ-WRITE-GF-01. IX1014.2 +050000 MOVE "READ-TEST-GF-01" TO PAR-NAME. IX1014.2 +050100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX1014.2 +050200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX1014.2 +050300 PERFORM PRINT-DETAIL. IX1014.2 +050400 CLOSE IX-FS1. IX1014.2 +050500 CCVS-EXIT SECTION. IX1014.2 +050600 CCVS-999999. IX1014.2 +050700 GO TO CLOSE-FILES. IX1014.2 +*END-OF,IX101A +*HEADER,COBOL,IX101A,SUBPRG,IX102A +000100 IDENTIFICATION DIVISION. IX1024.2 +000200 PROGRAM-ID. IX1024.2 +000300 IX102A. IX1024.2 +000400**************************************************************** IX1024.2 +000500* * IX1024.2 +000600* VALIDATION FOR:- * IX1024.2 +000700* * IX1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +000900* * IX1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1024.2 +001100* * IX1024.2 +001200**************************************************************** IX1024.2 +001300* IX1024.2 +001400* NEW TEST: IX1024.2 +001500* SELECT ... ASSIGN TO ... IX1024.2 +001600* IX1024.2 +001700* NOTE: WILL BE ASSIGNED BY THE X-CARD X-24. IX1024.2 +001800* X-24 SHOULD ASSIGN A } IX1024.2 +001900* IX1024.2 +002000* IX1024.2 +002100* THE FUNCTION OF THIS PROGRAM IS TO PROCESS AN INDEXED FILE IX1024.2 +002200* RANDOMLY (ACCESS MODE IS RANDOM). THE FILE USED AS INPUT IS IX1024.2 +002300* THAT CREATED BY IX101. IX1024.2 +002400* IX1024.2 +002500* FIRST THE FILE IS VERIFIED AS TO THE EXISTANCE AND ACCURACY IX1024.2 +002600* OF THE 500 RECORDS CREATED IN IX101. SECONDLY, RECORDS IX1024.2 +002700* OF THE FILE ARE SELECTIVELY UPDATED; AND THIRDLY, THE IX1024.2 +002800* ACCURACY OF EACH RECORD IN THE FILE IS AGAIN VERIFIED. IX1024.2 +002900* IX1024.2 +003000* IX1024.2 +003100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1024.2 +003200* IX1024.2 +003300* X-24 INDEXED FILE IN ASSGN TO IX1024.2 +003400* CLAUSE FOR DATA FILE IX-FS1 IX1024.2 +003500* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1024.2 +003600* CLAUSE FOR INDEX FILE IX-FS1 IX1024.2 +003700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1024.2 +003800* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX1024.2 +003900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1024.2 +004000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1024.2 +004100* IX1024.2 +004200* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1024.2 +004300* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1024.2 +004400* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1024.2 +004500* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1024.2 +004600* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1024.2 +004700* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1024.2 +004800* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1024.2 +004900* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1024.2 +005000* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1024.2 +005100* THEY ARE AS FOLLOWS IX1024.2 +005200* IX1024.2 +005300* J SELECTS X-CARD 44 IX1024.2 +005400* P SELECTS X-CARD 62 IX1024.2 +005500* IX1024.2 +005600****************************************************** IX1024.2 +005700 ENVIRONMENT DIVISION. IX1024.2 +005800 CONFIGURATION SECTION. IX1024.2 +005900 SOURCE-COMPUTER. IX1024.2 +006000 XXXXX082. IX1024.2 +006100 OBJECT-COMPUTER. IX1024.2 +006200 XXXXX083. IX1024.2 +006300 INPUT-OUTPUT SECTION. IX1024.2 +006400 FILE-CONTROL. IX1024.2 +006500P SELECT RAW-DATA ASSIGN TO IX1024.2 +006600P XXXXX062 IX1024.2 +006700P ORGANIZATION IS INDEXED IX1024.2 +006800P ACCESS MODE IS RANDOM IX1024.2 +006900P RECORD KEY IS RAW-DATA-KEY. IX1024.2 +007000 SELECT PRINT-FILE ASSIGN TO IX1024.2 +007100 XXXXX055. IX1024.2 +007200 SELECT IX-FS1 ASSIGN IX1024.2 +007300 XXXXP024 IX1024.2 +007400J XXXXP044 IX1024.2 +007500 ACCESS MODE IS RANDOM IX1024.2 +007600 ORGANIZATION INDEXED IX1024.2 +007700 RECORD KEY IX-FS1-KEY. IX1024.2 +007800 DATA DIVISION. IX1024.2 +007900 FILE SECTION. IX1024.2 +008000P IX1024.2 +008100PFD RAW-DATA. IX1024.2 +008200P IX1024.2 +008300P01 RAW-DATA-SATZ. IX1024.2 +008400P 05 RAW-DATA-KEY PIC X(6). IX1024.2 +008500P 05 C-DATE PIC 9(6). IX1024.2 +008600P 05 C-TIME PIC 9(8). IX1024.2 +008700P 05 C-NO-OF-TESTS PIC 99. IX1024.2 +008800P 05 C-OK PIC 999. IX1024.2 +008900P 05 C-ALL PIC 999. IX1024.2 +009000P 05 C-FAIL PIC 999. IX1024.2 +009100P 05 C-DELETED PIC 999. IX1024.2 +009200P 05 C-INSPECT PIC 999. IX1024.2 +009300P 05 C-NOTE PIC X(13). IX1024.2 +009400P 05 C-INDENT PIC X. IX1024.2 +009500P 05 C-ABORT PIC X(8). IX1024.2 +009600 FD PRINT-FILE. IX1024.2 +009700 01 PRINT-REC PICTURE X(120). IX1024.2 +009800 01 DUMMY-RECORD PICTURE X(120). IX1024.2 +009900 FD IX-FS1 IX1024.2 +010000C LABEL RECORDS STANDARD IX1024.2 +010100C ; DATA RECORD IX-FS1R1-F-G-240 IX1024.2 +010200 BLOCK 1 RECORDS IX1024.2 +010300 RECORD 240 CHARACTERS. IX1024.2 +010400 01 IX-FS1R1-F-G-240. IX1024.2 +010500 05 IX-FS1-REC-120 PIC X(120). IX1024.2 +010600 05 IX-FS1-REC-120-240. IX1024.2 +010700 10 FILLER PIC X(8). IX1024.2 +010800 10 IX-FS1-KEY PIC X(29). IX1024.2 +010900 10 FILLER PIC X(83). IX1024.2 +011000 WORKING-STORAGE SECTION. IX1024.2 +011100 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011200 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. IX1024.2 +011300 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011400 01 I-O-ERROR-IX-FS1 PIC X(3) VALUE "NO ". IX1024.2 +011500 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011600 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011700 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011800 01 IX-WRK-KEY. IX1024.2 +011900 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX1024.2 +012000 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1024.2 +012100 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX1024.2 +012200 01 DUMMY-WRK-REC. IX1024.2 +012300 02 DUMMY-WRK1 PIC X(120). IX1024.2 +012400 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1024.2 +012500 03 FILLER PIC X(5). IX1024.2 +012600 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1024.2 +012700 01 FILE-RECORD-INFORMATION-REC. IX1024.2 +012800 03 FILE-RECORD-INFO-SKELETON. IX1024.2 +012900 05 FILLER PICTURE X(48) VALUE IX1024.2 +013000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1024.2 +013100 05 FILLER PICTURE X(46) VALUE IX1024.2 +013200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1024.2 +013300 05 FILLER PICTURE X(26) VALUE IX1024.2 +013400 ",LFIL=000000,ORG= ,LBLR= ". IX1024.2 +013500 05 FILLER PICTURE X(37) VALUE IX1024.2 +013600 ",RECKEY= ". IX1024.2 +013700 05 FILLER PICTURE X(38) VALUE IX1024.2 +013800 ",ALTKEY1= ". IX1024.2 +013900 05 FILLER PICTURE X(38) VALUE IX1024.2 +014000 ",ALTKEY2= ". IX1024.2 +014100 05 FILLER PICTURE X(7) VALUE SPACE.IX1024.2 +014200 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1024.2 +014300 05 FILE-RECORD-INFO-P1-120. IX1024.2 +014400 07 FILLER PIC X(5). IX1024.2 +014500 07 XFILE-NAME PIC X(6). IX1024.2 +014600 07 FILLER PIC X(8). IX1024.2 +014700 07 XRECORD-NAME PIC X(6). IX1024.2 +014800 07 FILLER PIC X(1). IX1024.2 +014900 07 REELUNIT-NUMBER PIC 9(1). IX1024.2 +015000 07 FILLER PIC X(7). IX1024.2 +015100 07 XRECORD-NUMBER PIC 9(6). IX1024.2 +015200 07 FILLER PIC X(6). IX1024.2 +015300 07 UPDATE-NUMBER PIC 9(2). IX1024.2 +015400 07 FILLER PIC X(5). IX1024.2 +015500 07 ODO-NUMBER PIC 9(4). IX1024.2 +015600 07 FILLER PIC X(5). IX1024.2 +015700 07 XPROGRAM-NAME PIC X(5). IX1024.2 +015800 07 FILLER PIC X(7). IX1024.2 +015900 07 XRECORD-LENGTH PIC 9(6). IX1024.2 +016000 07 FILLER PIC X(7). IX1024.2 +016100 07 CHARS-OR-RECORDS PIC X(2). IX1024.2 +016200 07 FILLER PIC X(1). IX1024.2 +016300 07 XBLOCK-SIZE PIC 9(4). IX1024.2 +016400 07 FILLER PIC X(6). IX1024.2 +016500 07 RECORDS-IN-FILE PIC 9(6). IX1024.2 +016600 07 FILLER PIC X(5). IX1024.2 +016700 07 XFILE-ORGANIZATION PIC X(2). IX1024.2 +016800 07 FILLER PIC X(6). IX1024.2 +016900 07 XLABEL-TYPE PIC X(1). IX1024.2 +017000 05 FILE-RECORD-INFO-P121-240. IX1024.2 +017100 07 FILLER PIC X(8). IX1024.2 +017200 07 XRECORD-KEY PIC X(29). IX1024.2 +017300 07 FILLER PIC X(9). IX1024.2 +017400 07 ALTERNATE-KEY1 PIC X(29). IX1024.2 +017500 07 FILLER PIC X(9). IX1024.2 +017600 07 ALTERNATE-KEY2 PIC X(29). IX1024.2 +017700 07 FILLER PIC X(7). IX1024.2 +017800 01 TEST-RESULTS. IX1024.2 +017900 02 FILLER PIC X VALUE SPACE. IX1024.2 +018000 02 FEATURE PIC X(20) VALUE SPACE. IX1024.2 +018100 02 FILLER PIC X VALUE SPACE. IX1024.2 +018200 02 P-OR-F PIC X(5) VALUE SPACE. IX1024.2 +018300 02 FILLER PIC X VALUE SPACE. IX1024.2 +018400 02 PAR-NAME. IX1024.2 +018500 03 FILLER PIC X(19) VALUE SPACE. IX1024.2 +018600 03 PARDOT-X PIC X VALUE SPACE. IX1024.2 +018700 03 DOTVALUE PIC 99 VALUE ZERO. IX1024.2 +018800 02 FILLER PIC X(8) VALUE SPACE. IX1024.2 +018900 02 RE-MARK PIC X(61). IX1024.2 +019000 01 TEST-COMPUTED. IX1024.2 +019100 02 FILLER PIC X(30) VALUE SPACE. IX1024.2 +019200 02 FILLER PIC X(17) VALUE IX1024.2 +019300 " COMPUTED=". IX1024.2 +019400 02 COMPUTED-X. IX1024.2 +019500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1024.2 +019600 03 COMPUTED-N REDEFINES COMPUTED-A IX1024.2 +019700 PIC -9(9).9(9). IX1024.2 +019800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1024.2 +019900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1024.2 +020000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1024.2 +020100 03 CM-18V0 REDEFINES COMPUTED-A. IX1024.2 +020200 04 COMPUTED-18V0 PIC -9(18). IX1024.2 +020300 04 FILLER PIC X. IX1024.2 +020400 03 FILLER PIC X(50) VALUE SPACE. IX1024.2 +020500 01 TEST-CORRECT. IX1024.2 +020600 02 FILLER PIC X(30) VALUE SPACE. IX1024.2 +020700 02 FILLER PIC X(17) VALUE " CORRECT =". IX1024.2 +020800 02 CORRECT-X. IX1024.2 +020900 03 CORRECT-A PIC X(20) VALUE SPACE. IX1024.2 +021000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1024.2 +021100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1024.2 +021200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1024.2 +021300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1024.2 +021400 03 CR-18V0 REDEFINES CORRECT-A. IX1024.2 +021500 04 CORRECT-18V0 PIC -9(18). IX1024.2 +021600 04 FILLER PIC X. IX1024.2 +021700 03 FILLER PIC X(2) VALUE SPACE. IX1024.2 +021800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1024.2 +021900 01 CCVS-C-1. IX1024.2 +022000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1024.2 +022100- "SS PARAGRAPH-NAME IX1024.2 +022200- " REMARKS". IX1024.2 +022300 02 FILLER PIC X(20) VALUE SPACE. IX1024.2 +022400 01 CCVS-C-2. IX1024.2 +022500 02 FILLER PIC X VALUE SPACE. IX1024.2 +022600 02 FILLER PIC X(6) VALUE "TESTED". IX1024.2 +022700 02 FILLER PIC X(15) VALUE SPACE. IX1024.2 +022800 02 FILLER PIC X(4) VALUE "FAIL". IX1024.2 +022900 02 FILLER PIC X(94) VALUE SPACE. IX1024.2 +023000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1024.2 +023100 01 REC-CT PIC 99 VALUE ZERO. IX1024.2 +023200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1024.2 +023700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1024.2 +023800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1024.2 +023900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1024.2 +024000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1024.2 +024100 01 CCVS-H-1. IX1024.2 +024200 02 FILLER PIC X(39) VALUE SPACES. IX1024.2 +024300 02 FILLER PIC X(42) VALUE IX1024.2 +024400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1024.2 +024500 02 FILLER PIC X(39) VALUE SPACES. IX1024.2 +024600 01 CCVS-H-2A. IX1024.2 +024700 02 FILLER PIC X(40) VALUE SPACE. IX1024.2 +024800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1024.2 +024900 02 FILLER PIC XXXX VALUE IX1024.2 +025000 "4.2 ". IX1024.2 +025100 02 FILLER PIC X(28) VALUE IX1024.2 +025200 " COPY - NOT FOR DISTRIBUTION". IX1024.2 +025300 02 FILLER PIC X(41) VALUE SPACE. IX1024.2 +025400 IX1024.2 +025500 01 CCVS-H-2B. IX1024.2 +025600 02 FILLER PIC X(15) VALUE IX1024.2 +025700 "TEST RESULT OF ". IX1024.2 +025800 02 TEST-ID PIC X(9). IX1024.2 +025900 02 FILLER PIC X(4) VALUE IX1024.2 +026000 " IN ". IX1024.2 +026100 02 FILLER PIC X(12) VALUE IX1024.2 +026200 " HIGH ". IX1024.2 +026300 02 FILLER PIC X(22) VALUE IX1024.2 +026400 " LEVEL VALIDATION FOR ". IX1024.2 +026500 02 FILLER PIC X(58) VALUE IX1024.2 +026600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +026700 01 CCVS-H-3. IX1024.2 +026800 02 FILLER PIC X(34) VALUE IX1024.2 +026900 " FOR OFFICIAL USE ONLY ". IX1024.2 +027000 02 FILLER PIC X(58) VALUE IX1024.2 +027100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1024.2 +027200 02 FILLER PIC X(28) VALUE IX1024.2 +027300 " COPYRIGHT 1985 ". IX1024.2 +027400 01 CCVS-E-1. IX1024.2 +027500 02 FILLER PIC X(52) VALUE SPACE. IX1024.2 +027600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1024.2 +027700 02 ID-AGAIN PIC X(9). IX1024.2 +027800 02 FILLER PIC X(45) VALUE SPACES. IX1024.2 +027900 01 CCVS-E-2. IX1024.2 +028000 02 FILLER PIC X(31) VALUE SPACE. IX1024.2 +028100 02 FILLER PIC X(21) VALUE SPACE. IX1024.2 +028200 02 CCVS-E-2-2. IX1024.2 +028300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1024.2 +028400 03 FILLER PIC X VALUE SPACE. IX1024.2 +028500 03 ENDER-DESC PIC X(44) VALUE IX1024.2 +028600 "ERRORS ENCOUNTERED". IX1024.2 +028700 01 CCVS-E-3. IX1024.2 +028800 02 FILLER PIC X(22) VALUE IX1024.2 +028900 " FOR OFFICIAL USE ONLY". IX1024.2 +029000 02 FILLER PIC X(12) VALUE SPACE. IX1024.2 +029100 02 FILLER PIC X(58) VALUE IX1024.2 +029200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +029300 02 FILLER PIC X(13) VALUE SPACE. IX1024.2 +029400 02 FILLER PIC X(15) VALUE IX1024.2 +029500 " COPYRIGHT 1985". IX1024.2 +029600 01 CCVS-E-4. IX1024.2 +029700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1024.2 +029800 02 FILLER PIC X(4) VALUE " OF ". IX1024.2 +029900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1024.2 +030000 02 FILLER PIC X(40) VALUE IX1024.2 +030100 " TESTS WERE EXECUTED SUCCESSFULLY". IX1024.2 +030200 01 XXINFO. IX1024.2 +030300 02 FILLER PIC X(19) VALUE IX1024.2 +030400 "*** INFORMATION ***". IX1024.2 +030500 02 INFO-TEXT. IX1024.2 +030600 04 FILLER PIC X(8) VALUE SPACE. IX1024.2 +030700 04 XXCOMPUTED PIC X(20). IX1024.2 +030800 04 FILLER PIC X(5) VALUE SPACE. IX1024.2 +030900 04 XXCORRECT PIC X(20). IX1024.2 +031000 02 INF-ANSI-REFERENCE PIC X(48). IX1024.2 +031100 01 HYPHEN-LINE. IX1024.2 +031200 02 FILLER PIC IS X VALUE IS SPACE. IX1024.2 +031300 02 FILLER PIC IS X(65) VALUE IS "************************IX1024.2 +031400- "*****************************************". IX1024.2 +031500 02 FILLER PIC IS X(54) VALUE IS "************************IX1024.2 +031600- "******************************". IX1024.2 +031700 01 CCVS-PGM-ID PIC X(9) VALUE IX1024.2 +031800 "IX102A". IX1024.2 +031900 PROCEDURE DIVISION. IX1024.2 +032000 CCVS1 SECTION. IX1024.2 +032100 OPEN-FILES. IX1024.2 +032200P OPEN I-O RAW-DATA. IX1024.2 +032300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1024.2 +032400P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1024.2 +032500P MOVE "ABORTED " TO C-ABORT. IX1024.2 +032600P ADD 1 TO C-NO-OF-TESTS. IX1024.2 +032700P ACCEPT C-DATE FROM DATE. IX1024.2 +032800P ACCEPT C-TIME FROM TIME. IX1024.2 +032900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1024.2 +033000PEND-E-1. IX1024.2 +033100P CLOSE RAW-DATA. IX1024.2 +033200 OPEN OUTPUT PRINT-FILE. IX1024.2 +033300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1024.2 +033400 MOVE SPACE TO TEST-RESULTS. IX1024.2 +033500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1024.2 +033600 MOVE ZERO TO REC-SKL-SUB. IX1024.2 +033700 PERFORM CCVS-INIT-FILE 9 TIMES. IX1024.2 +033800 CCVS-INIT-FILE. IX1024.2 +033900 ADD 1 TO REC-SKL-SUB. IX1024.2 +034000 MOVE FILE-RECORD-INFO-SKELETON IX1024.2 +034100 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1024.2 +034200 CCVS-INIT-EXIT. IX1024.2 +034300 GO TO CCVS1-EXIT. IX1024.2 +034400 CLOSE-FILES. IX1024.2 +034500P OPEN I-O RAW-DATA. IX1024.2 +034600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1024.2 +034700P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1024.2 +034800P MOVE "OK. " TO C-ABORT. IX1024.2 +034900P MOVE PASS-COUNTER TO C-OK. IX1024.2 +035000P MOVE ERROR-HOLD TO C-ALL. IX1024.2 +035100P MOVE ERROR-COUNTER TO C-FAIL. IX1024.2 +035200P MOVE DELETE-COUNTER TO C-DELETED. IX1024.2 +035300P MOVE INSPECT-COUNTER TO C-INSPECT. IX1024.2 +035400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1024.2 +035500PEND-E-2. IX1024.2 +035600P CLOSE RAW-DATA. IX1024.2 +035700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1024.2 +035800 TERMINATE-CCVS. IX1024.2 +035900S EXIT PROGRAM. IX1024.2 +036000STERMINATE-CALL. IX1024.2 +036100 STOP RUN. IX1024.2 +036200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1024.2 +036300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1024.2 +036400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1024.2 +036500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1024.2 +036600 MOVE "****TEST DELETED****" TO RE-MARK. IX1024.2 +036700 PRINT-DETAIL. IX1024.2 +036800 IF REC-CT NOT EQUAL TO ZERO IX1024.2 +036900 MOVE "." TO PARDOT-X IX1024.2 +037000 MOVE REC-CT TO DOTVALUE. IX1024.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1024.2 +037200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1024.2 +037300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1024.2 +037400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1024.2 +037500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1024.2 +037600 MOVE SPACE TO CORRECT-X. IX1024.2 +037700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1024.2 +037800 MOVE SPACE TO RE-MARK. IX1024.2 +037900 HEAD-ROUTINE. IX1024.2 +038000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1024.2 +038300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1024.2 +038400 COLUMN-NAMES-ROUTINE. IX1024.2 +038500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +038600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +038800 END-ROUTINE. IX1024.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1024.2 +039000 END-RTN-EXIT. IX1024.2 +039100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +039200 END-ROUTINE-1. IX1024.2 +039300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1024.2 +039400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1024.2 +039500 ADD PASS-COUNTER TO ERROR-HOLD. IX1024.2 +039600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1024.2 +039700 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1024.2 +039800 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1024.2 +039900 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1024.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1024.2 +040100 END-ROUTINE-12. IX1024.2 +040200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1024.2 +040300 IF ERROR-COUNTER IS EQUAL TO ZERO IX1024.2 +040400 MOVE "NO " TO ERROR-TOTAL IX1024.2 +040500 ELSE IX1024.2 +040600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1024.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1024.2 +040800 PERFORM WRITE-LINE. IX1024.2 +040900 END-ROUTINE-13. IX1024.2 +041000 IF DELETE-COUNTER IS EQUAL TO ZERO IX1024.2 +041100 MOVE "NO " TO ERROR-TOTAL ELSE IX1024.2 +041200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1024.2 +041300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1024.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +041500 IF INSPECT-COUNTER EQUAL TO ZERO IX1024.2 +041600 MOVE "NO " TO ERROR-TOTAL IX1024.2 +041700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1024.2 +041800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1024.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +042000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +042100 WRITE-LINE. IX1024.2 +042200 ADD 1 TO RECORD-COUNT. IX1024.2 +042300Y IF RECORD-COUNT GREATER 42 IX1024.2 +042400Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1024.2 +042500Y MOVE SPACE TO DUMMY-RECORD IX1024.2 +042600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1024.2 +042700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1024.2 +042800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1024.2 +042900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1024.2 +043000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1024.2 +043100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043400Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1024.2 +043500Y MOVE ZERO TO RECORD-COUNT. IX1024.2 +043600 PERFORM WRT-LN. IX1024.2 +043700 WRT-LN. IX1024.2 +043800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1024.2 +043900 MOVE SPACE TO DUMMY-RECORD. IX1024.2 +044000 BLANK-LINE-PRINT. IX1024.2 +044100 PERFORM WRT-LN. IX1024.2 +044200 FAIL-ROUTINE. IX1024.2 +044300 IF COMPUTED-X NOT EQUAL TO SPACE IX1024.2 +044400 GO TO FAIL-ROUTINE-WRITE. IX1024.2 +044500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1024.2 +044600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1024.2 +044700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1024.2 +044800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +044900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1024.2 +045000 GO TO FAIL-ROUTINE-EX. IX1024.2 +045100 FAIL-ROUTINE-WRITE. IX1024.2 +045200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1024.2 +045300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1024.2 +045400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1024.2 +045500 MOVE SPACES TO COR-ANSI-REFERENCE. IX1024.2 +045600 FAIL-ROUTINE-EX. EXIT. IX1024.2 +045700 BAIL-OUT. IX1024.2 +045800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1024.2 +045900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1024.2 +046000 BAIL-OUT-WRITE. IX1024.2 +046100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1024.2 +046200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1024.2 +046300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +046400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1024.2 +046500 BAIL-OUT-EX. EXIT. IX1024.2 +046600 CCVS1-EXIT. IX1024.2 +046700 EXIT. IX1024.2 +046800 SECT-IX-02-001 SECTION. IX1024.2 +046900 READ-INIT-F2-01. IX1024.2 +047000* IX1024.2 +047100* TEST 1 IX1024.2 +047200* IX1024.2 +047300 OPEN INPUT IX-FS1. IX1024.2 +047400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1024.2 +047500 MOVE ZERO TO WRK-DU-09V00-001. IX1024.2 +047600 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +047700 MOVE ZERO TO WRK-CS-09V00-002 IX1024.2 +047800 MOVE ZERO TO WRK-DU-09V00-001 IX1024.2 +047900 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +048000 READ-TEST-F2-01. IX1024.2 +048100 ADD 1 TO WRK-DU-09V00-001 IX1024.2 +048200 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +048300 IF WRK-DU-09V00-001 GREATER 501 IX1024.2 +048400 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A IX1024.2 +048500 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX1024.2 +048600 PERFORM FAIL IX1024.2 +048700 PERFORM PRINT-DETAIL IX1024.2 +048800 GO TO READ-WRITE-F2-01. IX1024.2 +048900 READ IX-FS1 IX1024.2 +049000 INVALID KEY GO TO READ-WRITE-F2-01. IX1024.2 +049100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1024.2 +049200 IF XRECORD-NUMBER (1) EQUAL TO WRK-DU-09V00-001 IX1024.2 +049300 GO TO READ-TEST-F2-01. IX1024.2 +049400 MOVE "YES" TO I-O-ERROR-IX-FS1. IX1024.2 +049500 ADD 1 TO WRK-CS-09V00-002 IX1024.2 +049600 GO TO READ-TEST-F2-01. IX1024.2 +049700 READ-WRITE-F2-01. IX1024.2 +049800 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX1024.2 +049900 MOVE "WRONG KEY/NOT 500" TO CORRECT-A IX1024.2 +050000 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +050100 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +050200 PERFORM FAIL IX1024.2 +050300 ELSE IX1024.2 +050400 PERFORM PASS. IX1024.2 +050500 PERFORM PRINT-DETAIL. IX1024.2 +050600 READ-TEST-F2-02. IX1024.2 +050700 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX1024.2 +050800 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +050900* IX1024.2 +051000* TEST 2 IX1024.2 +051100* IX1024.2 +051200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX1024.2 +051300 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A IX1024.2 +051400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX1024.2 +051500 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +051600 PERFORM FAIL IX1024.2 +051700 ELSE IX1024.2 +051800 PERFORM PASS. IX1024.2 +051900 PERFORM PRINT-DETAIL. IX1024.2 +052000 READ-TEST-F2-03. IX1024.2 +052100 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX1024.2 +052200 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +052300* IX1024.2 +052400* TEST 3 IX1024.2 +052500* IX1024.2 +052600 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX1024.2 +052700 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1024.2 +052800 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +052900 MOVE 501 TO CORRECT-18V0 IX1024.2 +053000 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +053100 PERFORM FAIL IX1024.2 +053200 ELSE IX1024.2 +053300 PERFORM PASS. IX1024.2 +053400 PERFORM PRINT-DETAIL. IX1024.2 +053500 READ-TEST-F2-04. IX1024.2 +053600 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX1024.2 +053700 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +053800* IX1024.2 +053900* TEST 4 IX1024.2 +054000* IX1024.2 +054100 IF I-O-ERROR-IX-FS1 EQUAL TO "YES" IX1024.2 +054200 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 IX1024.2 +054300 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK IX1024.2 +054400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +054500 PERFORM FAIL IX1024.2 +054600 ELSE IX1024.2 +054700 PERFORM PASS. IX1024.2 +054800 PERFORM PRINT-DETAIL. IX1024.2 +054900 CLOSE IX-FS1. IX1024.2 +055000 REWRITE-INIT-F2-01. IX1024.2 +055100 MOVE "REWRITE-TEST-F2-01" TO PAR-NAME. IX1024.2 +055200 OPEN I-O IX-FS1. IX1024.2 +055300 MOVE ZERO TO IX-FS1-KEY. IX1024.2 +055400 MOVE ZERO TO WRK-CS-09V00-002. IX1024.2 +055500 MOVE ZERO TO WRK-DU-09V00-001. IX1024.2 +055600 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +055700 MOVE SPACE TO FILE-RECORD-INFO (1). IX1024.2 +055800 REWRITE-TEST-F2-01. IX1024.2 +055900* IX1024.2 +056000* REWRITE TEST 1 IX1024.2 +056100* IX1024.2 +056200 ADD 5 TO WRK-DU-09V00-001. IX1024.2 +056300 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +056400 IF WRK-DU-09V00-001 GREATER 505 IX1024.2 +056500 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX1024.2 +056600 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX1024.2 +056700 PERFORM FAIL IX1024.2 +056800 PERFORM PRINT-DETAIL IX1024.2 +056900 GO TO REWRITE-TEST-F2-01-3. IX1024.2 +057000 READ IX-FS1 IX1024.2 +057100 INVALID KEY GO TO REWRITE-TEST-F2-01-1. IX1024.2 +057200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1) IX1024.2 +057300 ADD 01 TO UPDATE-NUMBER (1). IX1024.2 +057400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1024.2 +057500 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1024.2 +057600 REWRITE IX-FS1R1-F-G-240 IX1024.2 +057700 INVALID KEY GO TO REWRITE-TEST-F2-01-2. IX1024.2 +057800 GO TO REWRITE-TEST-F2-01. IX1024.2 +057900 REWRITE-TEST-F2-01-1. IX1024.2 +058000 IF WRK-DU-09V00-001 LESS THAN 501 IX1024.2 +058100 ADD 1 TO WRK-CS-09V00-004 IX1024.2 +058200 GO TO REWRITE-TEST-F2-01. IX1024.2 +058300 PERFORM PASS. IX1024.2 +058400 PERFORM PRINT-DETAIL. IX1024.2 +058500 REWRITE-TEST-F2-02. IX1024.2 +058600 MOVE "REWRITE-TEST-F2-02" TO PAR-NAME. IX1024.2 +058700 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +058800* IX1024.2 +058900* REWRITE TEST 2 IX1024.2 +059000* IX1024.2 +059100 GO TO REWRITE-TEST-F2-01-3. IX1024.2 +059200 REWRITE-TEST-F2-01-2. IX1024.2 +059300 ADD 1 TO WRK-CS-09V00-005. IX1024.2 +059400 IF WRK-DU-09V00-001 LESS THAN 501 IX1024.2 +059500 GO TO REWRITE-TEST-F2-01. IX1024.2 +059600 REWRITE-TEST-F2-01-3. IX1024.2 +059700 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO IX1024.2 +059800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX1024.2 +059900 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX1024.2 +060000 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +060100 PERFORM FAIL IX1024.2 +060200 ELSE IX1024.2 +060300 PERFORM PASS. IX1024.2 +060400 PERFORM PRINT-DETAIL. IX1024.2 +060500 REWRITE-TEST-F2-03. IX1024.2 +060600 MOVE "REWRITE-TEST-F2-03" TO PAR-NAME. IX1024.2 +060700 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +060800* IX1024.2 +060900* REWRITE TEST 3 IX1024.2 +061000* IX1024.2 +061100 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO IX1024.2 +061200 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A IX1024.2 +061300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX1024.2 +061400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +061500 PERFORM FAIL IX1024.2 +061600 ELSE IX1024.2 +061700 PERFORM PASS. IX1024.2 +061800 PERFORM PRINT-DETAIL. IX1024.2 +061900 CLOSE IX-FS1. IX1024.2 +062000 READ-INIT-F2-05. IX1024.2 +062100 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX1024.2 +062200 OPEN INPUT IX-FS1. IX1024.2 +062300 MOVE 501 TO WRK-DU-09V00-001. IX1024.2 +062400 MOVE ZERO TO WRK-CS-09V00-004. IX1024.2 +062500 MOVE ZERO TO WRK-CS-09V00-005. IX1024.2 +062600 MOVE ZERO TO WRK-CS-09V00-002. IX1024.2 +062700 MOVE SPACE TO FILE-RECORD-INFO (1). IX1024.2 +062800 MOVE "READ ... INVALID " TO FEATURE. IX1024.2 +062900 READ-TEST-F2-05. IX1024.2 +063000 IF WRK-DU-09V00-001 EQUAL TO ZERO IX1024.2 +063100 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX1024.2 +063200 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +063300 MOVE ZERO TO CORRECT-18V0 IX1024.2 +063400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +063500 PERFORM FAIL IX1024.2 +063600 PERFORM PRINT-DETAIL IX1024.2 +063700 GO TO READ-TEST-F2-05. IX1024.2 +063800 SUBTRACT 1 FROM WRK-DU-09V00-001. IX1024.2 +063900 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +064000 READ IX-FS1 IX1024.2 +064100 INVALID KEY GO TO READ-TEST-F2-05-1. IX1024.2 +064200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1024.2 +064300 IF UPDATE-NUMBER (1) EQUAL TO 00 IX1024.2 +064400 ADD 1 TO WRK-CS-09V00-004. IX1024.2 +064500 IF UPDATE-NUMBER (1) EQUAL TO 01 IX1024.2 +064600 ADD 1 TO WRK-CS-09V00-005. IX1024.2 +064700 GO TO READ-TEST-F2-05. IX1024.2 +064800 READ-TEST-F2-05-1. IX1024.2 +064900 IF WRK-DU-09V00-001 GREATER ZERO IX1024.2 +065000 ADD 1 TO WRK-CS-09V00-002 IX1024.2 +065100 GO TO READ-TEST-F2-05. IX1024.2 +065200 PERFORM PASS. IX1024.2 +065300 PERFORM PRINT-DETAIL. IX1024.2 +065400 READ-TEST-F2-06. IX1024.2 +065500 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX1024.2 +065600 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +065700* IX1024.2 +065800* TEST 6 IX1024.2 +065900* IX1024.2 +066000 IF WRK-CS-09V00-004 NOT EQUAL TO 400 IX1024.2 +066100 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX1024.2 +066200 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX1024.2 +066300 MOVE "SHOULD BE 400" TO RE-MARK IX1024.2 +066400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +066500 PERFORM FAIL IX1024.2 +066600 ELSE IX1024.2 +066700 PERFORM PASS. IX1024.2 +066800 PERFORM PRINT-DETAIL. IX1024.2 +066900 READ-TEST-F2-07. IX1024.2 +067000 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX1024.2 +067100 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +067200* IX1024.2 +067300* TEST 7 IX1024.2 +067400* IX1024.2 +067500 IF WRK-CS-09V00-005 NOT EQUAL TO 100 IX1024.2 +067600 MOVE "UPDATED RECORDS" TO COMPUTED-A IX1024.2 +067700 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX1024.2 +067800 MOVE "SHOULD BE 100" TO RE-MARK IX1024.2 +067900 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +068000 PERFORM FAIL IX1024.2 +068100 ELSE IX1024.2 +068200 PERFORM PASS. IX1024.2 +068300 PERFORM PRINT-DETAIL. IX1024.2 +068400 READ-TEST-F2-08. IX1024.2 +068500 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX1024.2 +068600 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +068700* IX1024.2 +068800* TEST 8 IX1024.2 +068900* IX1024.2 +069000 IF WRK-CS-09V00-002 GREATER 1 IX1024.2 +069100 MOVE WRK-CS-09V00-002 TO COMPUTED-N IX1024.2 +069200 MOVE "INVALID KEY/READS" TO CORRECT-A IX1024.2 +069300 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +069400 PERFORM FAIL IX1024.2 +069500 ELSE IX1024.2 +069600 PERFORM PASS. IX1024.2 +069700 PERFORM PRINT-DETAIL. IX1024.2 +069800 CLOSE IX-FS1. IX1024.2 +069900 CCVS-EXIT SECTION. IX1024.2 +070000 CCVS-999999. IX1024.2 +070100 GO TO CLOSE-FILES. IX1024.2 +*END-OF,IX102A +*HEADER,COBOL,IX101A,SUBPRG,IX103A +000100 IDENTIFICATION DIVISION. IX1034.2 +000200 PROGRAM-ID. IX1034.2 +000300 IX103A. IX1034.2 +000400**************************************************************** IX1034.2 +000500* * IX1034.2 +000600* VALIDATION FOR:- * IX1034.2 +000700* * IX1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +000900* * IX1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1034.2 +001100* * IX1034.2 +001200**************************************************************** IX1034.2 +001300* IX1034.2 +001400* NEW TEST: IX1034.2 +001500* SELECT ... INDEXED ... IX1034.2 +001600* (WITHOUT THE OPTIONAL WORD ) IX1034.2 +001700* IX1034.2 +001800* THIS PROGRAM IS THE THIRD OF A SERIES. ITS FUNCTION IX1034.2 +001900* IS TO PROCESS THE FILE SEQUENTIALLY (ACCESS MODE IS IX1034.2 +002000* SEQUENTIAL). THE FILE USED IS THAT RESULTING FROM IX102. IX1034.2 +002100* IX1034.2 +002200* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RECORDS. IX1034.2 +002300* SECONDLY, RECORDS OF THE FILE ARE SELECTIVELY DELETED AND IX1034.2 +002400* THIRDLY THE ACCURACY OF EACH RECORD IN THE FILE IS AGAIN IX1034.2 +002500* VERIFIED. IX1034.2 +002600* IX1034.2 +002700* IX1034.2 +002800* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1034.2 +002900* IX1034.2 +003000* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1034.2 +003100* CLAUSE FOR DATA FILE IX-FS1 IX1034.2 +003200* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1034.2 +003300* CLAUSE FOR INDEX FILE IX-FS1 IX1034.2 +003400* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1034.2 +003500* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX1034.2 +003600* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1034.2 +003700* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1034.2 +003800* IX1034.2 +003900* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1034.2 +004000* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1034.2 +004100* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1034.2 +004200* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1034.2 +004300* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1034.2 +004400* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1034.2 +004500* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1034.2 +004600* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1034.2 +004700* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1034.2 +004800* THEY ARE AS FOLLOWS IX1034.2 +004900* IX1034.2 +005000* J SELECTS X-CARD 44 IX1034.2 +005100* P SELECTS X-CARD 62 IX1034.2 +005200* IX1034.2 +005300****************************************************** IX1034.2 +005400 ENVIRONMENT DIVISION. IX1034.2 +005500 CONFIGURATION SECTION. IX1034.2 +005600 SOURCE-COMPUTER. IX1034.2 +005700 XXXXX082. IX1034.2 +005800 OBJECT-COMPUTER. IX1034.2 +005900 XXXXX083. IX1034.2 +006000 INPUT-OUTPUT SECTION. IX1034.2 +006100 FILE-CONTROL. IX1034.2 +006200P SELECT RAW-DATA ASSIGN TO IX1034.2 +006300P XXXXX062 IX1034.2 +006400P ORGANIZATION IS INDEXED IX1034.2 +006500P ACCESS MODE IS RANDOM IX1034.2 +006600P RECORD KEY IS RAW-DATA-KEY. IX1034.2 +006700 SELECT PRINT-FILE ASSIGN TO IX1034.2 +006800 XXXXX055. IX1034.2 +006900 SELECT IX-FS1 ASSIGN TO IX1034.2 +007000 XXXXD024 IX1034.2 +007100J XXXXD044 IX1034.2 +007200 INDEXED IX1034.2 +007300 RECORD IX-FS1-KEY. IX1034.2 +007400* THE ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH IX1034.2 +007500* SEQUENTIAL HAD BEEN SPECIFIED. IX1034.2 +007600 DATA DIVISION. IX1034.2 +007700 FILE SECTION. IX1034.2 +007800P IX1034.2 +007900PFD RAW-DATA. IX1034.2 +008000P IX1034.2 +008100P01 RAW-DATA-SATZ. IX1034.2 +008200P 05 RAW-DATA-KEY PIC X(6). IX1034.2 +008300P 05 C-DATE PIC 9(6). IX1034.2 +008400P 05 C-TIME PIC 9(8). IX1034.2 +008500P 05 C-NO-OF-TESTS PIC 99. IX1034.2 +008600P 05 C-OK PIC 999. IX1034.2 +008700P 05 C-ALL PIC 999. IX1034.2 +008800P 05 C-FAIL PIC 999. IX1034.2 +008900P 05 C-DELETED PIC 999. IX1034.2 +009000P 05 C-INSPECT PIC 999. IX1034.2 +009100P 05 C-NOTE PIC X(13). IX1034.2 +009200P 05 C-INDENT PIC X. IX1034.2 +009300P 05 C-ABORT PIC X(8). IX1034.2 +009400 FD PRINT-FILE. IX1034.2 +009500 01 PRINT-REC PICTURE X(120). IX1034.2 +009600 01 DUMMY-RECORD PICTURE X(120). IX1034.2 +009700 FD IX-FS1 IX1034.2 +009800C LABEL RECORD STANDARD IX1034.2 +009900C DATA RECORDS ARE IX-FS1R1-F-G-240 IX1034.2 +010000 ; BLOCK CONTAINS 01 RECORDS IX1034.2 +010100 RECORD CONTAINS 240. IX1034.2 +010200 01 IX-FS1R1-F-G-240. IX1034.2 +010300 05 IX-FS1-REC-120 PIC X(120). IX1034.2 +010400 05 IX-FS1-REC-120-240. IX1034.2 +010500 10 FILLER PIC X(8). IX1034.2 +010600 10 IX-FS1-KEY PIC X(29). IX1034.2 +010700 10 FILLER PIC X(83). IX1034.2 +010800 WORKING-STORAGE SECTION. IX1034.2 +010900 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011000 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011100 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011200 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011300 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011400 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011500 01 I-O-ERROR-IX-FS1 PIC X(3) VALUE "NO ". IX1034.2 +011600 01 IX-WRK-KEY. IX1034.2 +011700 03 FILLER PIC X(10). IX1034.2 +011800 03 WRK-DU-09V00-001 PIC 9(9). IX1034.2 +011900 03 FILLER PIC X(10). IX1034.2 +012000 01 DUMMY-WRK-REC. IX1034.2 +012100 02 DUMMY-WRK1 PIC X(120). IX1034.2 +012200 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1034.2 +012300 03 FILLER PIC X(5). IX1034.2 +012400 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1034.2 +012500 01 FILE-RECORD-INFORMATION-REC. IX1034.2 +012600 03 FILE-RECORD-INFO-SKELETON. IX1034.2 +012700 05 FILLER PICTURE X(48) VALUE IX1034.2 +012800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1034.2 +012900 05 FILLER PICTURE X(46) VALUE IX1034.2 +013000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1034.2 +013100 05 FILLER PICTURE X(26) VALUE IX1034.2 +013200 ",LFIL=000000,ORG= ,LBLR= ". IX1034.2 +013300 05 FILLER PICTURE X(37) VALUE IX1034.2 +013400 ",RECKEY= ". IX1034.2 +013500 05 FILLER PICTURE X(38) VALUE IX1034.2 +013600 ",ALTKEY1= ". IX1034.2 +013700 05 FILLER PICTURE X(38) VALUE IX1034.2 +013800 ",ALTKEY2= ". IX1034.2 +013900 05 FILLER PICTURE X(7) VALUE SPACE.IX1034.2 +014000 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1034.2 +014100 05 FILE-RECORD-INFO-P1-120. IX1034.2 +014200 07 FILLER PIC X(5). IX1034.2 +014300 07 XFILE-NAME PIC X(6). IX1034.2 +014400 07 FILLER PIC X(8). IX1034.2 +014500 07 XRECORD-NAME PIC X(6). IX1034.2 +014600 07 FILLER PIC X(1). IX1034.2 +014700 07 REELUNIT-NUMBER PIC 9(1). IX1034.2 +014800 07 FILLER PIC X(7). IX1034.2 +014900 07 XRECORD-NUMBER PIC 9(6). IX1034.2 +015000 07 FILLER PIC X(6). IX1034.2 +015100 07 UPDATE-NUMBER PIC 9(2). IX1034.2 +015200 07 FILLER PIC X(5). IX1034.2 +015300 07 ODO-NUMBER PIC 9(4). IX1034.2 +015400 07 FILLER PIC X(5). IX1034.2 +015500 07 XPROGRAM-NAME PIC X(5). IX1034.2 +015600 07 FILLER PIC X(7). IX1034.2 +015700 07 XRECORD-LENGTH PIC 9(6). IX1034.2 +015800 07 FILLER PIC X(7). IX1034.2 +015900 07 CHARS-OR-RECORDS PIC X(2). IX1034.2 +016000 07 FILLER PIC X(1). IX1034.2 +016100 07 XBLOCK-SIZE PIC 9(4). IX1034.2 +016200 07 FILLER PIC X(6). IX1034.2 +016300 07 RECORDS-IN-FILE PIC 9(6). IX1034.2 +016400 07 FILLER PIC X(5). IX1034.2 +016500 07 XFILE-ORGANIZATION PIC X(2). IX1034.2 +016600 07 FILLER PIC X(6). IX1034.2 +016700 07 XLABEL-TYPE PIC X(1). IX1034.2 +016800 05 FILE-RECORD-INFO-P121-240. IX1034.2 +016900 07 FILLER PIC X(8). IX1034.2 +017000 07 XRECORD-KEY PIC X(29). IX1034.2 +017100 07 FILLER PIC X(9). IX1034.2 +017200 07 ALTERNATE-KEY1 PIC X(29). IX1034.2 +017300 07 FILLER PIC X(9). IX1034.2 +017400 07 ALTERNATE-KEY2 PIC X(29). IX1034.2 +017500 07 FILLER PIC X(7). IX1034.2 +017600 01 TEST-RESULTS. IX1034.2 +017700 02 FILLER PIC X VALUE SPACE. IX1034.2 +017800 02 FEATURE PIC X(20) VALUE SPACE. IX1034.2 +017900 02 FILLER PIC X VALUE SPACE. IX1034.2 +018000 02 P-OR-F PIC X(5) VALUE SPACE. IX1034.2 +018100 02 FILLER PIC X VALUE SPACE. IX1034.2 +018200 02 PAR-NAME. IX1034.2 +018300 03 FILLER PIC X(19) VALUE SPACE. IX1034.2 +018400 03 PARDOT-X PIC X VALUE SPACE. IX1034.2 +018500 03 DOTVALUE PIC 99 VALUE ZERO. IX1034.2 +018600 02 FILLER PIC X(8) VALUE SPACE. IX1034.2 +018700 02 RE-MARK PIC X(61). IX1034.2 +018800 01 TEST-COMPUTED. IX1034.2 +018900 02 FILLER PIC X(30) VALUE SPACE. IX1034.2 +019000 02 FILLER PIC X(17) VALUE IX1034.2 +019100 " COMPUTED=". IX1034.2 +019200 02 COMPUTED-X. IX1034.2 +019300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1034.2 +019400 03 COMPUTED-N REDEFINES COMPUTED-A IX1034.2 +019500 PIC -9(9).9(9). IX1034.2 +019600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1034.2 +019700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1034.2 +019800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1034.2 +019900 03 CM-18V0 REDEFINES COMPUTED-A. IX1034.2 +020000 04 COMPUTED-18V0 PIC -9(18). IX1034.2 +020100 04 FILLER PIC X. IX1034.2 +020200 03 FILLER PIC X(50) VALUE SPACE. IX1034.2 +020300 01 TEST-CORRECT. IX1034.2 +020400 02 FILLER PIC X(30) VALUE SPACE. IX1034.2 +020500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1034.2 +020600 02 CORRECT-X. IX1034.2 +020700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1034.2 +020800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1034.2 +020900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1034.2 +021000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1034.2 +021100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1034.2 +021200 03 CR-18V0 REDEFINES CORRECT-A. IX1034.2 +021300 04 CORRECT-18V0 PIC -9(18). IX1034.2 +021400 04 FILLER PIC X. IX1034.2 +021500 03 FILLER PIC X(2) VALUE SPACE. IX1034.2 +021600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1034.2 +021700 01 CCVS-C-1. IX1034.2 +021800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1034.2 +021900- "SS PARAGRAPH-NAME IX1034.2 +022000- " REMARKS". IX1034.2 +022100 02 FILLER PIC X(20) VALUE SPACE. IX1034.2 +022200 01 CCVS-C-2. IX1034.2 +022300 02 FILLER PIC X VALUE SPACE. IX1034.2 +022400 02 FILLER PIC X(6) VALUE "TESTED". IX1034.2 +022500 02 FILLER PIC X(15) VALUE SPACE. IX1034.2 +022600 02 FILLER PIC X(4) VALUE "FAIL". IX1034.2 +022700 02 FILLER PIC X(94) VALUE SPACE. IX1034.2 +022800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1034.2 +022900 01 REC-CT PIC 99 VALUE ZERO. IX1034.2 +023000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1034.2 +023500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1034.2 +023600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1034.2 +023700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1034.2 +023800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1034.2 +023900 01 CCVS-H-1. IX1034.2 +024000 02 FILLER PIC X(39) VALUE SPACES. IX1034.2 +024100 02 FILLER PIC X(42) VALUE IX1034.2 +024200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1034.2 +024300 02 FILLER PIC X(39) VALUE SPACES. IX1034.2 +024400 01 CCVS-H-2A. IX1034.2 +024500 02 FILLER PIC X(40) VALUE SPACE. IX1034.2 +024600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1034.2 +024700 02 FILLER PIC XXXX VALUE IX1034.2 +024800 "4.2 ". IX1034.2 +024900 02 FILLER PIC X(28) VALUE IX1034.2 +025000 " COPY - NOT FOR DISTRIBUTION". IX1034.2 +025100 02 FILLER PIC X(41) VALUE SPACE. IX1034.2 +025200 IX1034.2 +025300 01 CCVS-H-2B. IX1034.2 +025400 02 FILLER PIC X(15) VALUE IX1034.2 +025500 "TEST RESULT OF ". IX1034.2 +025600 02 TEST-ID PIC X(9). IX1034.2 +025700 02 FILLER PIC X(4) VALUE IX1034.2 +025800 " IN ". IX1034.2 +025900 02 FILLER PIC X(12) VALUE IX1034.2 +026000 " HIGH ". IX1034.2 +026100 02 FILLER PIC X(22) VALUE IX1034.2 +026200 " LEVEL VALIDATION FOR ". IX1034.2 +026300 02 FILLER PIC X(58) VALUE IX1034.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +026500 01 CCVS-H-3. IX1034.2 +026600 02 FILLER PIC X(34) VALUE IX1034.2 +026700 " FOR OFFICIAL USE ONLY ". IX1034.2 +026800 02 FILLER PIC X(58) VALUE IX1034.2 +026900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1034.2 +027000 02 FILLER PIC X(28) VALUE IX1034.2 +027100 " COPYRIGHT 1985 ". IX1034.2 +027200 01 CCVS-E-1. IX1034.2 +027300 02 FILLER PIC X(52) VALUE SPACE. IX1034.2 +027400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1034.2 +027500 02 ID-AGAIN PIC X(9). IX1034.2 +027600 02 FILLER PIC X(45) VALUE SPACES. IX1034.2 +027700 01 CCVS-E-2. IX1034.2 +027800 02 FILLER PIC X(31) VALUE SPACE. IX1034.2 +027900 02 FILLER PIC X(21) VALUE SPACE. IX1034.2 +028000 02 CCVS-E-2-2. IX1034.2 +028100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1034.2 +028200 03 FILLER PIC X VALUE SPACE. IX1034.2 +028300 03 ENDER-DESC PIC X(44) VALUE IX1034.2 +028400 "ERRORS ENCOUNTERED". IX1034.2 +028500 01 CCVS-E-3. IX1034.2 +028600 02 FILLER PIC X(22) VALUE IX1034.2 +028700 " FOR OFFICIAL USE ONLY". IX1034.2 +028800 02 FILLER PIC X(12) VALUE SPACE. IX1034.2 +028900 02 FILLER PIC X(58) VALUE IX1034.2 +029000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +029100 02 FILLER PIC X(13) VALUE SPACE. IX1034.2 +029200 02 FILLER PIC X(15) VALUE IX1034.2 +029300 " COPYRIGHT 1985". IX1034.2 +029400 01 CCVS-E-4. IX1034.2 +029500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1034.2 +029600 02 FILLER PIC X(4) VALUE " OF ". IX1034.2 +029700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1034.2 +029800 02 FILLER PIC X(40) VALUE IX1034.2 +029900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1034.2 +030000 01 XXINFO. IX1034.2 +030100 02 FILLER PIC X(19) VALUE IX1034.2 +030200 "*** INFORMATION ***". IX1034.2 +030300 02 INFO-TEXT. IX1034.2 +030400 04 FILLER PIC X(8) VALUE SPACE. IX1034.2 +030500 04 XXCOMPUTED PIC X(20). IX1034.2 +030600 04 FILLER PIC X(5) VALUE SPACE. IX1034.2 +030700 04 XXCORRECT PIC X(20). IX1034.2 +030800 02 INF-ANSI-REFERENCE PIC X(48). IX1034.2 +030900 01 HYPHEN-LINE. IX1034.2 +031000 02 FILLER PIC IS X VALUE IS SPACE. IX1034.2 +031100 02 FILLER PIC IS X(65) VALUE IS "************************IX1034.2 +031200- "*****************************************". IX1034.2 +031300 02 FILLER PIC IS X(54) VALUE IS "************************IX1034.2 +031400- "******************************". IX1034.2 +031500 01 CCVS-PGM-ID PIC X(9) VALUE IX1034.2 +031600 "IX103A". IX1034.2 +031700 PROCEDURE DIVISION. IX1034.2 +031800 DECLARATIVES. IX1034.2 +031900 USE-IX103-TEST SECTION. IX1034.2 +032000 USE AFTER STANDARD EXCEPTION PROCEDURE IX1034.2 +032100 IX-FS1. IX1034.2 +032200 USE-PAR-001. IX1034.2 +032300 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +032400 USE-PAR-EXIT. IX1034.2 +032500 EXIT. IX1034.2 +032600 END DECLARATIVES. IX1034.2 +032700 CCVS1 SECTION. IX1034.2 +032800 OPEN-FILES. IX1034.2 +032900P OPEN I-O RAW-DATA. IX1034.2 +033000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1034.2 +033100P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1034.2 +033200P MOVE "ABORTED " TO C-ABORT. IX1034.2 +033300P ADD 1 TO C-NO-OF-TESTS. IX1034.2 +033400P ACCEPT C-DATE FROM DATE. IX1034.2 +033500P ACCEPT C-TIME FROM TIME. IX1034.2 +033600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1034.2 +033700PEND-E-1. IX1034.2 +033800P CLOSE RAW-DATA. IX1034.2 +033900 OPEN OUTPUT PRINT-FILE. IX1034.2 +034000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1034.2 +034100 MOVE SPACE TO TEST-RESULTS. IX1034.2 +034200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1034.2 +034300 MOVE ZERO TO REC-SKL-SUB. IX1034.2 +034400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1034.2 +034500 CCVS-INIT-FILE. IX1034.2 +034600 ADD 1 TO REC-SKL-SUB. IX1034.2 +034700 MOVE FILE-RECORD-INFO-SKELETON IX1034.2 +034800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1034.2 +034900 CCVS-INIT-EXIT. IX1034.2 +035000 GO TO CCVS1-EXIT. IX1034.2 +035100 CLOSE-FILES. IX1034.2 +035200P OPEN I-O RAW-DATA. IX1034.2 +035300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1034.2 +035400P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1034.2 +035500P MOVE "OK. " TO C-ABORT. IX1034.2 +035600P MOVE PASS-COUNTER TO C-OK. IX1034.2 +035700P MOVE ERROR-HOLD TO C-ALL. IX1034.2 +035800P MOVE ERROR-COUNTER TO C-FAIL. IX1034.2 +035900P MOVE DELETE-COUNTER TO C-DELETED. IX1034.2 +036000P MOVE INSPECT-COUNTER TO C-INSPECT. IX1034.2 +036100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1034.2 +036200PEND-E-2. IX1034.2 +036300P CLOSE RAW-DATA. IX1034.2 +036400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1034.2 +036500 TERMINATE-CCVS. IX1034.2 +036600S EXIT PROGRAM. IX1034.2 +036700STERMINATE-CALL. IX1034.2 +036800 STOP RUN. IX1034.2 +036900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1034.2 +037000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1034.2 +037100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1034.2 +037200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1034.2 +037300 MOVE "****TEST DELETED****" TO RE-MARK. IX1034.2 +037400 PRINT-DETAIL. IX1034.2 +037500 IF REC-CT NOT EQUAL TO ZERO IX1034.2 +037600 MOVE "." TO PARDOT-X IX1034.2 +037700 MOVE REC-CT TO DOTVALUE. IX1034.2 +037800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1034.2 +037900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1034.2 +038000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1034.2 +038100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1034.2 +038200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1034.2 +038300 MOVE SPACE TO CORRECT-X. IX1034.2 +038400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1034.2 +038500 MOVE SPACE TO RE-MARK. IX1034.2 +038600 HEAD-ROUTINE. IX1034.2 +038700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +038800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +038900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1034.2 +039000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1034.2 +039100 COLUMN-NAMES-ROUTINE. IX1034.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +039300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +039500 END-ROUTINE. IX1034.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1034.2 +039700 END-RTN-EXIT. IX1034.2 +039800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +039900 END-ROUTINE-1. IX1034.2 +040000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1034.2 +040100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1034.2 +040200 ADD PASS-COUNTER TO ERROR-HOLD. IX1034.2 +040300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1034.2 +040400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1034.2 +040500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1034.2 +040600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1034.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1034.2 +040800 END-ROUTINE-12. IX1034.2 +040900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1034.2 +041000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1034.2 +041100 MOVE "NO " TO ERROR-TOTAL IX1034.2 +041200 ELSE IX1034.2 +041300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1034.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1034.2 +041500 PERFORM WRITE-LINE. IX1034.2 +041600 END-ROUTINE-13. IX1034.2 +041700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1034.2 +041800 MOVE "NO " TO ERROR-TOTAL ELSE IX1034.2 +041900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1034.2 +042000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1034.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042200 IF INSPECT-COUNTER EQUAL TO ZERO IX1034.2 +042300 MOVE "NO " TO ERROR-TOTAL IX1034.2 +042400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1034.2 +042500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1034.2 +042600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042800 WRITE-LINE. IX1034.2 +042900 ADD 1 TO RECORD-COUNT. IX1034.2 +043000Y IF RECORD-COUNT GREATER 42 IX1034.2 +043100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1034.2 +043200Y MOVE SPACE TO DUMMY-RECORD IX1034.2 +043300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1034.2 +043400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1034.2 +043500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1034.2 +043600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1034.2 +043700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1034.2 +043800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +043900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +044000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +044100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1034.2 +044200Y MOVE ZERO TO RECORD-COUNT. IX1034.2 +044300 PERFORM WRT-LN. IX1034.2 +044400 WRT-LN. IX1034.2 +044500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1034.2 +044600 MOVE SPACE TO DUMMY-RECORD. IX1034.2 +044700 BLANK-LINE-PRINT. IX1034.2 +044800 PERFORM WRT-LN. IX1034.2 +044900 FAIL-ROUTINE. IX1034.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1034.2 +045100 GO TO FAIL-ROUTINE-WRITE. IX1034.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1034.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1034.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1034.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1034.2 +045700 GO TO FAIL-ROUTINE-EX. IX1034.2 +045800 FAIL-ROUTINE-WRITE. IX1034.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1034.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1034.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1034.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1034.2 +046300 FAIL-ROUTINE-EX. EXIT. IX1034.2 +046400 BAIL-OUT. IX1034.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1034.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1034.2 +046700 BAIL-OUT-WRITE. IX1034.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1034.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1034.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1034.2 +047200 BAIL-OUT-EX. EXIT. IX1034.2 +047300 CCVS1-EXIT. IX1034.2 +047400 EXIT. IX1034.2 +047500 SECT-IX-03-001 SECTION. IX1034.2 +047600 INX-INIT-006. IX1034.2 +047700* THIS FILE "IX-FS1" IS ACCESSED SEQUENTIALLY AND HAS IX1034.2 +047800* ASSOCIATED WITH IT A RECORD KEY WHICH AT ALL TIMES SHOULD IX1034.2 +047900* CONTAIN THE INDEX OF THE RECORD PREVIOUSLY READ. IX1034.2 +048000 OPEN INPUT IX-FS1. IX1034.2 +048100 MOVE "INX-TEST-006" TO PAR-NAME. IX1034.2 +048200 MOVE ZERO TO WRK-CS-09V00-006. IX1034.2 +048300 MOVE ZERO TO WRK-CS-09V00-007. IX1034.2 +048400 MOVE ZERO TO WRK-CS-09V00-008. IX1034.2 +048500 MOVE ZERO TO WRK-CS-09V00-009. IX1034.2 +048600 MOVE ZERO TO WRK-CS-09V00-010. IX1034.2 +048700 MOVE ZERO TO WRK-CS-09V00-011. IX1034.2 +048800 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +048900 MOVE ZERO TO WRK-DU-09V00-001. IX1034.2 +049000 MOVE IX-FS1-KEY TO COMPUTED-A. IX1034.2 +049100 MOVE SPACE TO P-OR-F. IX1034.2 +049200 MOVE "INFORMATION" TO CORRECT-A. IX1034.2 +049300 MOVE "KEY AFTER OPEN" TO RE-MARK. IX1034.2 +049400 MOVE "RECORD KEY ON OPEN" TO FEATURE. IX1034.2 +049500 PERFORM PRINT-DETAIL. IX1034.2 +049600 MOVE "INX-TEST-006" TO PAR-NAME. IX1034.2 +049700 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +049800 INX-TEST-006-R. IX1034.2 +049900 ADD 1 TO WRK-CS-09V00-006. IX1034.2 +050000 READ IX-FS1 IX1034.2 +050100 AT END GO TO READ-TEST-F1-01. IX1034.2 +050200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +050300 IF UPDATE-NUMBER (1) EQUAL TO 00 IX1034.2 +050400 ADD 1 TO WRK-CS-09V00-007 IX1034.2 +050500 GO TO INX-TEST-006-2. IX1034.2 +050600 IF UPDATE-NUMBER (1) EQUAL TO 01 IX1034.2 +050700 ADD 1 TO WRK-CS-09V00-008 IX1034.2 +050800 GO TO INX-TEST-006-2. IX1034.2 +050900 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +051000 INX-TEST-006-2. IX1034.2 +051100 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX1034.2 +051200 IF WRK-DU-09V00-001 NOT EQUAL TO XRECORD-NUMBER (1) IX1034.2 +051300 ADD 1 TO WRK-CS-09V00-010. IX1034.2 +051400 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +051500 GO TO READ-TEST-F1-01. IX1034.2 +051600 GO TO INX-TEST-006-R. IX1034.2 +051700 READ-TEST-F1-01. IX1034.2 +051800 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1034.2 +051900 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +052000* IX1034.2 +052100* TEST 1 IX1034.2 +052200* IX1034.2 +052300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX1034.2 +052400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1034.2 +052500 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +052600 MOVE 500 TO CORRECT-18V0 IX1034.2 +052700 MOVE "IX-28 4.5.2 " TO RE-MARKIX1034.2 +052800 PERFORM FAIL IX1034.2 +052900 ELSE IX1034.2 +053000 PERFORM PASS. IX1034.2 +053100 PERFORM PRINT-DETAIL. IX1034.2 +053200 READ-TEST-F1-02. IX1034.2 +053300 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX1034.2 +053400 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +053500* IX1034.2 +053600* TEST 2 IX1034.2 +053700* IX1034.2 +053800 IF WRK-CS-09V00-007 EQUAL TO 400 IX1034.2 +053900 PERFORM PASS IX1034.2 +054000 ELSE IX1034.2 +054100 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX1034.2 +054200 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 IX1034.2 +054300 MOVE "SHOULD BE 400; IX-28 4.5.2" TO RE-MARK IX1034.2 +054400 PERFORM FAIL. IX1034.2 +054500 PERFORM PRINT-DETAIL. IX1034.2 +054600 READ-TEST-F1-03. IX1034.2 +054700 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX1034.2 +054800 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +054900* IX1034.2 +055000* TEST 3 IX1034.2 +055100* IX1034.2 +055200 IF WRK-CS-09V00-008 EQUAL TO 100 IX1034.2 +055300 PERFORM PASS IX1034.2 +055400 ELSE IX1034.2 +055500 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX1034.2 +055600 MOVE 100 TO CORRECT-18V0 IX1034.2 +055700 MOVE "IX-28 4.5.2 " TO RE-MARKIX1034.2 +055800 PERFORM FAIL. IX1034.2 +055900 PERFORM PRINT-DETAIL. IX1034.2 +056000 READ-TEST-F1-04. IX1034.2 +056100 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX1034.2 +056200 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +056300* IX1034.2 +056400* TEST 4 IX1034.2 +056500* IX1034.2 +056600 IF WRK-CS-09V00-009 EQUAL TO ZERO IX1034.2 +056700 PERFORM PASS IX1034.2 +056800 ELSE IX1034.2 +056900 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +057000 MOVE ZERO TO CORRECT-18V0 IX1034.2 +057100 MOVE "BAD-UPDATES" TO RE-MARK IX1034.2 +057200 PERFORM FAIL. IX1034.2 +057300 PERFORM PRINT-DETAIL. IX1034.2 +057400 READ-TEST-F1-05. IX1034.2 +057500 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX1034.2 +057600 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +057700* IX1034.2 +057800* TEST 5 IX1034.2 +057900* IX1034.2 +058000 IF WRK-CS-09V00-010 EQUAL TO ZERO IX1034.2 +058100 PERFORM PASS IX1034.2 +058200 ELSE IX1034.2 +058300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX1034.2 +058400 MOVE ZERO TO CORRECT-18V0 IX1034.2 +058500 MOVE "KEY VS RECORD; IX-28" TO RE-MARK IX1034.2 +058600 PERFORM FAIL. IX1034.2 +058700 PERFORM PRINT-DETAIL. IX1034.2 +058800 CLOSE IX-FS1. IX1034.2 +058900 DELETE-INIT-GF-01. IX1034.2 +059000* IX1034.2 +059100* TEST 1 IX1034.2 +059200* IX1034.2 +059300 MOVE "DELETE-TEST-GF-01" TO PAR-NAME IX1034.2 +059400 OPEN I-O IX-FS1. IX1034.2 +059500 MOVE ZERO TO WRK-CS-09V00-006 IX1034.2 +059600 MOVE ZERO TO WRK-CS-09V00-007 IX1034.2 +059700 MOVE ZERO TO WRK-CS-09V00-008 IX1034.2 +059800 MOVE ZERO TO WRK-CS-09V00-009 IX1034.2 +059900 MOVE ZERO TO WRK-CS-09V00-010 IX1034.2 +060000 MOVE ZERO TO WRK-CS-09V00-011 IX1034.2 +060100 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +060200 MOVE "DELETE " TO FEATURE. IX1034.2 +060300 DELETE-TEST-GF-01. IX1034.2 +060400 ADD 1 TO WRK-CS-09V00-006 IX1034.2 +060500 ADD 1 TO WRK-CS-09V00-007. IX1034.2 +060600 READ IX-FS1 IX1034.2 +060700 AT END IX1034.2 +060800 MOVE "AT END PATH TAKEN" TO RE-MARK IX1034.2 +060900 GO TO DELETE-TEST-GF-01-3. IX1034.2 +061000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +061100 IF WRK-CS-09V00-007 EQUAL TO 4 IX1034.2 +061200 GO TO DELETE-TEST-GF-01-2. IX1034.2 +061300 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +061400 MOVE "AT END NOT TAKEN" TO RE-MARK IX1034.2 +061500 GO TO DELETE-TEST-GF-01-3. IX1034.2 +061600 GO TO DELETE-TEST-GF-01. IX1034.2 +061700 DELETE-TEST-GF-01-2. IX1034.2 +061800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1034.2 +061900 MOVE 99 TO UPDATE-NUMBER (1). IX1034.2 +062000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1034.2 +062100 DELETE IX-FS1. IX1034.2 +062200 MOVE ZERO TO WRK-CS-09V00-007. IX1034.2 +062300 ADD 1 TO WRK-CS-09V00-008 IX1034.2 +062400 GO TO DELETE-TEST-GF-01. IX1034.2 +062500 DELETE-TEST-GF-01-3. IX1034.2 +062600 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX1034.2 +062700 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +062800 MOVE 501 TO CORRECT-18V0 IX1034.2 +062900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +063000 PERFORM FAIL IX1034.2 +063100 ELSE IX1034.2 +063200 PERFORM PASS. IX1034.2 +063300 PERFORM PRINT-DETAIL. IX1034.2 +063400 DELETE-TEST-GF-02. IX1034.2 +063500 MOVE "DELETE-TEST-GF-02" TO PAR-NAME IX1034.2 +063600 MOVE "DELETE " TO FEATURE. IX1034.2 +063700* IX1034.2 +063800* TEST 2 IX1034.2 +063900* IX1034.2 +064000 IF WRK-CS-09V00-008 NOT EQUAL TO 125 IX1034.2 +064100 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX1034.2 +064200 MOVE 125 TO CORRECT-18V0 IX1034.2 +064300 MOVE "DELETED RECORDS" TO RE-MARK IX1034.2 +064400 PERFORM FAIL IX1034.2 +064500 ELSE IX1034.2 +064600 PERFORM PASS. IX1034.2 +064700 PERFORM PRINT-DETAIL. IX1034.2 +064800 DELETE-TEST-GF-03. IX1034.2 +064900 MOVE "DELETE-TEST-GF-03" TO PAR-NAME IX1034.2 +065000 MOVE "DELETE " TO FEATURE. IX1034.2 +065100* IX1034.2 +065200* TEST 3 IX1034.2 +065300* IX1034.2 +065400 IF WRK-CS-09V00-009 EQUAL TO ZERO IX1034.2 +065500 PERFORM PASS IX1034.2 +065600 ELSE IX1034.2 +065700 PERFORM FAIL IX1034.2 +065800 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +065900 MOVE ZERO TO CORRECT-18V0 IX1034.2 +066000 MOVE "INVALID KEY" TO RE-MARK. IX1034.2 +066100 PERFORM PRINT-DETAIL. IX1034.2 +066200 CLOSE IX-FS1. IX1034.2 +066300 DELETE-INIT-GF-04. IX1034.2 +066400 MOVE "DELETE-TEST-GF-04" TO PAR-NAME IX1034.2 +066500 MOVE "DELETE " TO FEATURE. IX1034.2 +066600* IX1034.2 +066700* TEST 4 IX1034.2 +066800* IX1034.2 +066900 MOVE "DELETE-TEST-GF-04" TO PAR-NAME. IX1034.2 +067000 MOVE ZERO TO WRK-CS-09V00-006 IX1034.2 +067100 MOVE ZERO TO WRK-CS-09V00-007 IX1034.2 +067200 MOVE ZERO TO WRK-CS-09V00-008 IX1034.2 +067300 MOVE ZERO TO WRK-CS-09V00-009 IX1034.2 +067400 MOVE ZERO TO WRK-CS-09V00-010 IX1034.2 +067500 MOVE ZERO TO WRK-CS-09V00-011 IX1034.2 +067600 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +067700 MOVE ZERO TO WRK-DU-09V00-001. IX1034.2 +067800 OPEN INPUT IX-FS1. IX1034.2 +067900 DELETE-TEST-GF-04. IX1034.2 +068000 ADD 1 TO WRK-CS-09V00-006. IX1034.2 +068100 ADD 1 TO WRK-CS-09V00-007. IX1034.2 +068200 ADD 1 TO WRK-CS-09V00-008. IX1034.2 +068300 READ IX-FS1 AT END GO TO DELETE-TEST-GF-04-3. IX1034.2 +068400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +068500 IF UPDATE-NUMBER (1) EQUAL TO 99 IX1034.2 +068600 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +068700 IF WRK-CS-09V00-007 EQUAL TO 4 IX1034.2 +068800 MOVE 01 TO WRK-CS-09V00-007 IX1034.2 +068900 ADD 1 TO WRK-CS-09V00-008. IX1034.2 +069000 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX1034.2 +069100 MOVE WRK-CS-09V00-008 TO WRK-DU-09V00-001. IX1034.2 +069200 IF IX-WRK-KEY EQUAL TO IX-FS1-KEY IX1034.2 +069300 ADD 1 TO WRK-CS-09V00-010. IX1034.2 +069400 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 IX1034.2 +069500 ADD 1 TO WRK-CS-09V00-011. IX1034.2 +069600 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +069700 GO TO DELETE-TEST-GF-04-3. IX1034.2 +069800 GO TO DELETE-TEST-GF-04. IX1034.2 +069900 DELETE-TEST-GF-04-3. IX1034.2 +070000 IF WRK-CS-09V00-006 NOT EQUAL TO 376 IX1034.2 +070100 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1034.2 +070200 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +070300 MOVE 376 TO CORRECT-18V0 IX1034.2 +070400 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +070500 PERFORM FAIL IX1034.2 +070600 ELSE IX1034.2 +070700 PERFORM PASS. IX1034.2 +070800 PERFORM PRINT-DETAIL. IX1034.2 +070900 DELETE-TEST-GF-05. IX1034.2 +071000 MOVE "DELETE-TEST-GF-05" TO PAR-NAME IX1034.2 +071100 MOVE "DELETE " TO FEATURE. IX1034.2 +071200* IX1034.2 +071300* TEST 5 IX1034.2 +071400* IX1034.2 +071500 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO IX1034.2 +071600 MOVE ZERO TO CORRECT-18V0 IX1034.2 +071700 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +071800 MOVE "DELETED RECORDS" TO RE-MARK IX1034.2 +071900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +072000 PERFORM FAIL IX1034.2 +072100 ELSE IX1034.2 +072200 PERFORM PASS. IX1034.2 +072300 PERFORM PRINT-DETAIL. IX1034.2 +072400 DELETE-TEST-GF-06. IX1034.2 +072500 MOVE "DELETE-TEST-GF-06" TO PAR-NAME IX1034.2 +072600 MOVE "DELETE " TO FEATURE. IX1034.2 +072700* IX1034.2 +072800* TEST 6 IX1034.2 +072900* IX1034.2 +073000 IF WRK-CS-09V00-010 NOT EQUAL TO 375 IX1034.2 +073100 MOVE 375 TO CORRECT-18V0 IX1034.2 +073200 MOVE "KEY MISMATCH" TO RE-MARK IX1034.2 +073300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX1034.2 +073400 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +073500 PERFORM FAIL IX1034.2 +073600 ELSE IX1034.2 +073700 PERFORM PASS. IX1034.2 +073800 PERFORM PRINT-DETAIL. IX1034.2 +073900 DELETE-TEST-GF-07. IX1034.2 +074000 MOVE "DELETE-TEST-GF-07" TO PAR-NAME IX1034.2 +074100 MOVE "DELETE " TO FEATURE. IX1034.2 +074200* IX1034.2 +074300* TEST 7 IX1034.2 +074400* IX1034.2 +074500 IF WRK-CS-09V00-011 NOT EQUAL TO 375 IX1034.2 +074600 MOVE 375 TO CORRECT-18V0 IX1034.2 +074700 MOVE "INCORRECT RECORD FOUND" TO RE-MARK IX1034.2 +074800 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 IX1034.2 +074900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +075000 PERFORM FAIL IX1034.2 +075100 ELSE IX1034.2 +075200 PERFORM PASS. IX1034.2 +075300 PERFORM PRINT-DETAIL. IX1034.2 +075400 CLOSE IX-FS1. IX1034.2 +075500 CCVS-EXIT SECTION. IX1034.2 +075600 CCVS-999999. IX1034.2 +075700 GO TO CLOSE-FILES. IX1034.2 +*END-OF,IX103A +*HEADER,COBOL,IX104A +000100 IDENTIFICATION DIVISION. IX1044.2 +000200 PROGRAM-ID. IX1044.2 +000300 IX104A. IX1044.2 +000400**************************************************************** IX1044.2 +000500* * IX1044.2 +000600* VALIDATION FOR:- * IX1044.2 +000700* * IX1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +000900* * IX1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1044.2 +001100* * IX1044.2 +001200**************************************************************** IX1044.2 +001300* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX1044.2 +001400* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX1044.2 +001500* IX1044.2 +001600* (1) FILE STATUS IX1044.2 +001700* (2) USE AFTER EXCEPTION USING FILE-NAME IX1044.2 +001800* (3) READ IX1044.2 +001900* (4) WRITE IX1044.2 +002000* (5) REWRITE IX1044.2 +002100* (6) RECORD KEY IX1044.2 +002200* (7) ACCESS IX1044.2 +002300* IX1044.2 +002400* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX1044.2 +002500* MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RECORDS OF THE IX1044.2 +002600* FILE. THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR IX1044.2 +002700* ACCURACY FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT IX1044.2 +002800* USED. THE READ, WRITE AND REWRITE STATEMENTS ARE USED IX1044.2 +002900* WITHOUT THE APPROPRIATE AT END OR INVALID KEY PHRASES. THE IX1044.2 +003000* OMISSION OF THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE IX1044.2 +003100* PROCEDURE HAS BEEN SPECIFIED. IX1044.2 +003200* IX1044.2 +003300* IX1044.2 +003400* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1044.2 +003500* IX1044.2 +003600* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 +003700* CLAUSE FOR DATA FILE IX-FD2 IX1044.2 +003800* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 +003900* CLAUSE FOR INDEX FILE IX-FD2 IX1044.2 +004000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1044.2 +004100* X-62 FOR RAW-DATA IX1044.2 +004200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1044.2 +004300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1044.2 +004400* IX1044.2 +004500* NOTE: X-CARDS 45 AND 62 ARE OPTIONAL IX1044.2 +004600* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1044.2 +004700* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1044.2 +004800* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1044.2 +004900* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1044.2 +005000* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1044.2 +005100* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1044.2 +005200* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1044.2 +005300* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1044.2 +005400* THEY ARE AS FOLLOWS IX1044.2 +005500* IX1044.2 +005600* J SELECTS X-CARD 45 IX1044.2 +005700* IX1044.2 +005800****************************************************** IX1044.2 +005900 ENVIRONMENT DIVISION. IX1044.2 +006000 CONFIGURATION SECTION. IX1044.2 +006100 SOURCE-COMPUTER. IX1044.2 +006200 XXXXX082. IX1044.2 +006300 OBJECT-COMPUTER. IX1044.2 +006400 XXXXX083. IX1044.2 +006500 INPUT-OUTPUT SECTION. IX1044.2 +006600 FILE-CONTROL. IX1044.2 +006700P SELECT RAW-DATA ASSIGN TO IX1044.2 +006800P XXXXX062 IX1044.2 +006900P ORGANIZATION IS INDEXED IX1044.2 +007000P ACCESS MODE IS RANDOM IX1044.2 +007100P RECORD KEY IS RAW-DATA-KEY. IX1044.2 +007200 SELECT PRINT-FILE ASSIGN TO IX1044.2 +007300 XXXXX055. IX1044.2 +007400 SELECT IX-FS2 ASSIGN IX1044.2 +007500 XXXXX025 IX1044.2 +007600J XXXXX045 IX1044.2 +007700 ORGANIZATION IS INDEXED IX1044.2 +007800 ACCESS SEQUENTIAL IX1044.2 +007900 FILE STATUS IS IX-FS2-STATUS IX1044.2 +008000 RECORD IX-FS2-KEY. IX1044.2 +008100 DATA DIVISION. IX1044.2 +008200 FILE SECTION. IX1044.2 +008300P IX1044.2 +008400PFD RAW-DATA. IX1044.2 +008500P IX1044.2 +008600P01 RAW-DATA-SATZ. IX1044.2 +008700P 05 RAW-DATA-KEY PIC X(6). IX1044.2 +008800P 05 C-DATE PIC 9(6). IX1044.2 +008900P 05 C-TIME PIC 9(8). IX1044.2 +009000P 05 C-NO-OF-TESTS PIC 99. IX1044.2 +009100P 05 C-OK PIC 999. IX1044.2 +009200P 05 C-ALL PIC 999. IX1044.2 +009300P 05 C-FAIL PIC 999. IX1044.2 +009400P 05 C-DELETED PIC 999. IX1044.2 +009500P 05 C-INSPECT PIC 999. IX1044.2 +009600P 05 C-NOTE PIC X(13). IX1044.2 +009700P 05 C-INDENT PIC X. IX1044.2 +009800P 05 C-ABORT PIC X(8). IX1044.2 +009900 FD PRINT-FILE. IX1044.2 +010000 01 PRINT-REC PICTURE X(120). IX1044.2 +010100 01 DUMMY-RECORD PICTURE X(120). IX1044.2 +010200 FD IX-FS2 IX1044.2 +010300C LABEL RECORDS ARE STANDARD IX1044.2 +010400C DATA RECORDS IX-FS2R1-F-G-240 IX1044.2 +010500 BLOCK CONTAINS 480 IX1044.2 +010600 RECORD CONTAINS 240 CHARACTERS. IX1044.2 +010700 01 IX-FS2R1-F-G-240. IX1044.2 +010800 05 IX-FS2-REC-120 PIC X(120). IX1044.2 +010900 05 IX-FS2-REC-120-240. IX1044.2 +011000 10 FILLER PICTURE X(8). IX1044.2 +011100 10 IX-FS2-KEY PIC X(29). IX1044.2 +011200 10 FILLER PIC X(83). IX1044.2 +011300 WORKING-STORAGE SECTION. IX1044.2 +011400 01 GRP-0101. IX1044.2 +011500 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX1044.2 +011600 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1044.2 +011700 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX1044.2 +011800 01 GRP-0001. IX1044.2 +011900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012600 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX1044.2 +012700 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX1044.2 +012800 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX1044.2 +012900 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX1044.2 +013000 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX1044.2 +013100 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX1044.2 +013200 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX1044.2 +013300 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX1044.2 +013400 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX1044.2 +013500 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX1044.2 +013600 01 DUMMY-WRK-REC. IX1044.2 +013700 02 DUMMY-WRK1 PIC X(120). IX1044.2 +013800 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1044.2 +013900 03 FILLER PIC X(5). IX1044.2 +014000 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1044.2 +014100 01 FILE-RECORD-INFORMATION-REC. IX1044.2 +014200 03 FILE-RECORD-INFO-SKELETON. IX1044.2 +014300 05 FILLER PICTURE X(48) VALUE IX1044.2 +014400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1044.2 +014500 05 FILLER PICTURE X(46) VALUE IX1044.2 +014600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1044.2 +014700 05 FILLER PICTURE X(26) VALUE IX1044.2 +014800 ",LFIL=000000,ORG= ,LBLR= ". IX1044.2 +014900 05 FILLER PICTURE X(37) VALUE IX1044.2 +015000 ",RECKEY= ". IX1044.2 +015100 05 FILLER PICTURE X(38) VALUE IX1044.2 +015200 ",ALTKEY1= ". IX1044.2 +015300 05 FILLER PICTURE X(38) VALUE IX1044.2 +015400 ",ALTKEY2= ". IX1044.2 +015500 05 FILLER PICTURE X(7) VALUE SPACE.IX1044.2 +015600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1044.2 +015700 05 FILE-RECORD-INFO-P1-120. IX1044.2 +015800 07 FILLER PIC X(5). IX1044.2 +015900 07 XFILE-NAME PIC X(6). IX1044.2 +016000 07 FILLER PIC X(8). IX1044.2 +016100 07 XRECORD-NAME PIC X(6). IX1044.2 +016200 07 FILLER PIC X(1). IX1044.2 +016300 07 REELUNIT-NUMBER PIC 9(1). IX1044.2 +016400 07 FILLER PIC X(7). IX1044.2 +016500 07 XRECORD-NUMBER PIC 9(6). IX1044.2 +016600 07 FILLER PIC X(6). IX1044.2 +016700 07 UPDATE-NUMBER PIC 9(2). IX1044.2 +016800 07 FILLER PIC X(5). IX1044.2 +016900 07 ODO-NUMBER PIC 9(4). IX1044.2 +017000 07 FILLER PIC X(5). IX1044.2 +017100 07 XPROGRAM-NAME PIC X(5). IX1044.2 +017200 07 FILLER PIC X(7). IX1044.2 +017300 07 XRECORD-LENGTH PIC 9(6). IX1044.2 +017400 07 FILLER PIC X(7). IX1044.2 +017500 07 CHARS-OR-RECORDS PIC X(2). IX1044.2 +017600 07 FILLER PIC X(1). IX1044.2 +017700 07 XBLOCK-SIZE PIC 9(4). IX1044.2 +017800 07 FILLER PIC X(6). IX1044.2 +017900 07 RECORDS-IN-FILE PIC 9(6). IX1044.2 +018000 07 FILLER PIC X(5). IX1044.2 +018100 07 XFILE-ORGANIZATION PIC X(2). IX1044.2 +018200 07 FILLER PIC X(6). IX1044.2 +018300 07 XLABEL-TYPE PIC X(1). IX1044.2 +018400 05 FILE-RECORD-INFO-P121-240. IX1044.2 +018500 07 FILLER PIC X(8). IX1044.2 +018600 07 XRECORD-KEY PIC X(29). IX1044.2 +018700 07 FILLER PIC X(9). IX1044.2 +018800 07 ALTERNATE-KEY1 PIC X(29). IX1044.2 +018900 07 FILLER PIC X(9). IX1044.2 +019000 07 ALTERNATE-KEY2 PIC X(29). IX1044.2 +019100 07 FILLER PIC X(7). IX1044.2 +019200 01 TEST-RESULTS. IX1044.2 +019300 02 FILLER PIC X VALUE SPACE. IX1044.2 +019400 02 FEATURE PIC X(20) VALUE SPACE. IX1044.2 +019500 02 FILLER PIC X VALUE SPACE. IX1044.2 +019600 02 P-OR-F PIC X(5) VALUE SPACE. IX1044.2 +019700 02 FILLER PIC X VALUE SPACE. IX1044.2 +019800 02 PAR-NAME. IX1044.2 +019900 03 FILLER PIC X(19) VALUE SPACE. IX1044.2 +020000 03 PARDOT-X PIC X VALUE SPACE. IX1044.2 +020100 03 DOTVALUE PIC 99 VALUE ZERO. IX1044.2 +020200 02 FILLER PIC X(8) VALUE SPACE. IX1044.2 +020300 02 RE-MARK PIC X(61). IX1044.2 +020400 01 TEST-COMPUTED. IX1044.2 +020500 02 FILLER PIC X(30) VALUE SPACE. IX1044.2 +020600 02 FILLER PIC X(17) VALUE IX1044.2 +020700 " COMPUTED=". IX1044.2 +020800 02 COMPUTED-X. IX1044.2 +020900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1044.2 +021000 03 COMPUTED-N REDEFINES COMPUTED-A IX1044.2 +021100 PIC -9(9).9(9). IX1044.2 +021200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1044.2 +021300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1044.2 +021400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1044.2 +021500 03 CM-18V0 REDEFINES COMPUTED-A. IX1044.2 +021600 04 COMPUTED-18V0 PIC -9(18). IX1044.2 +021700 04 FILLER PIC X. IX1044.2 +021800 03 FILLER PIC X(50) VALUE SPACE. IX1044.2 +021900 01 TEST-CORRECT. IX1044.2 +022000 02 FILLER PIC X(30) VALUE SPACE. IX1044.2 +022100 02 FILLER PIC X(17) VALUE " CORRECT =". IX1044.2 +022200 02 CORRECT-X. IX1044.2 +022300 03 CORRECT-A PIC X(20) VALUE SPACE. IX1044.2 +022400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1044.2 +022500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1044.2 +022600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1044.2 +022700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1044.2 +022800 03 CR-18V0 REDEFINES CORRECT-A. IX1044.2 +022900 04 CORRECT-18V0 PIC -9(18). IX1044.2 +023000 04 FILLER PIC X. IX1044.2 +023100 03 FILLER PIC X(2) VALUE SPACE. IX1044.2 +023200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1044.2 +023300 01 CCVS-C-1. IX1044.2 +023400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1044.2 +023500- "SS PARAGRAPH-NAME IX1044.2 +023600- " REMARKS". IX1044.2 +023700 02 FILLER PIC X(20) VALUE SPACE. IX1044.2 +023800 01 CCVS-C-2. IX1044.2 +023900 02 FILLER PIC X VALUE SPACE. IX1044.2 +024000 02 FILLER PIC X(6) VALUE "TESTED". IX1044.2 +024100 02 FILLER PIC X(15) VALUE SPACE. IX1044.2 +024200 02 FILLER PIC X(4) VALUE "FAIL". IX1044.2 +024300 02 FILLER PIC X(94) VALUE SPACE. IX1044.2 +024400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1044.2 +024500 01 REC-CT PIC 99 VALUE ZERO. IX1044.2 +024600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1044.2 +025000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1044.2 +025100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1044.2 +025200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1044.2 +025300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1044.2 +025400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1044.2 +025500 01 CCVS-H-1. IX1044.2 +025600 02 FILLER PIC X(39) VALUE SPACES. IX1044.2 +025700 02 FILLER PIC X(42) VALUE IX1044.2 +025800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1044.2 +025900 02 FILLER PIC X(39) VALUE SPACES. IX1044.2 +026000 01 CCVS-H-2A. IX1044.2 +026100 02 FILLER PIC X(40) VALUE SPACE. IX1044.2 +026200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1044.2 +026300 02 FILLER PIC XXXX VALUE IX1044.2 +026400 "4.2 ". IX1044.2 +026500 02 FILLER PIC X(28) VALUE IX1044.2 +026600 " COPY - NOT FOR DISTRIBUTION". IX1044.2 +026700 02 FILLER PIC X(41) VALUE SPACE. IX1044.2 +026800 IX1044.2 +026900 01 CCVS-H-2B. IX1044.2 +027000 02 FILLER PIC X(15) VALUE IX1044.2 +027100 "TEST RESULT OF ". IX1044.2 +027200 02 TEST-ID PIC X(9). IX1044.2 +027300 02 FILLER PIC X(4) VALUE IX1044.2 +027400 " IN ". IX1044.2 +027500 02 FILLER PIC X(12) VALUE IX1044.2 +027600 " HIGH ". IX1044.2 +027700 02 FILLER PIC X(22) VALUE IX1044.2 +027800 " LEVEL VALIDATION FOR ". IX1044.2 +027900 02 FILLER PIC X(58) VALUE IX1044.2 +028000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +028100 01 CCVS-H-3. IX1044.2 +028200 02 FILLER PIC X(34) VALUE IX1044.2 +028300 " FOR OFFICIAL USE ONLY ". IX1044.2 +028400 02 FILLER PIC X(58) VALUE IX1044.2 +028500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1044.2 +028600 02 FILLER PIC X(28) VALUE IX1044.2 +028700 " COPYRIGHT 1985 ". IX1044.2 +028800 01 CCVS-E-1. IX1044.2 +028900 02 FILLER PIC X(52) VALUE SPACE. IX1044.2 +029000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1044.2 +029100 02 ID-AGAIN PIC X(9). IX1044.2 +029200 02 FILLER PIC X(45) VALUE SPACES. IX1044.2 +029300 01 CCVS-E-2. IX1044.2 +029400 02 FILLER PIC X(31) VALUE SPACE. IX1044.2 +029500 02 FILLER PIC X(21) VALUE SPACE. IX1044.2 +029600 02 CCVS-E-2-2. IX1044.2 +029700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1044.2 +029800 03 FILLER PIC X VALUE SPACE. IX1044.2 +029900 03 ENDER-DESC PIC X(44) VALUE IX1044.2 +030000 "ERRORS ENCOUNTERED". IX1044.2 +030100 01 CCVS-E-3. IX1044.2 +030200 02 FILLER PIC X(22) VALUE IX1044.2 +030300 " FOR OFFICIAL USE ONLY". IX1044.2 +030400 02 FILLER PIC X(12) VALUE SPACE. IX1044.2 +030500 02 FILLER PIC X(58) VALUE IX1044.2 +030600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +030700 02 FILLER PIC X(13) VALUE SPACE. IX1044.2 +030800 02 FILLER PIC X(15) VALUE IX1044.2 +030900 " COPYRIGHT 1985". IX1044.2 +031000 01 CCVS-E-4. IX1044.2 +031100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1044.2 +031200 02 FILLER PIC X(4) VALUE " OF ". IX1044.2 +031300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1044.2 +031400 02 FILLER PIC X(40) VALUE IX1044.2 +031500 " TESTS WERE EXECUTED SUCCESSFULLY". IX1044.2 +031600 01 XXINFO. IX1044.2 +031700 02 FILLER PIC X(19) VALUE IX1044.2 +031800 "*** INFORMATION ***". IX1044.2 +031900 02 INFO-TEXT. IX1044.2 +032000 04 FILLER PIC X(8) VALUE SPACE. IX1044.2 +032100 04 XXCOMPUTED PIC X(20). IX1044.2 +032200 04 FILLER PIC X(5) VALUE SPACE. IX1044.2 +032300 04 XXCORRECT PIC X(20). IX1044.2 +032400 02 INF-ANSI-REFERENCE PIC X(48). IX1044.2 +032500 01 HYPHEN-LINE. IX1044.2 +032600 02 FILLER PIC IS X VALUE IS SPACE. IX1044.2 +032700 02 FILLER PIC IS X(65) VALUE IS "************************IX1044.2 +032800- "*****************************************". IX1044.2 +032900 02 FILLER PIC IS X(54) VALUE IS "************************IX1044.2 +033000- "******************************". IX1044.2 +033100 01 CCVS-PGM-ID PIC X(9) VALUE IX1044.2 +033200 "IX104A". IX1044.2 +033300 PROCEDURE DIVISION. IX1044.2 +033400 DECLARATIVES. IX1044.2 +033500 IX-FS2-01 SECTION. IX1044.2 +033600 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX1044.2 +033700 IX-FS2-01-01. IX1044.2 +033800 ADD 1 TO WRK-CS-09V00-013. IX1044.2 +033900 GO TO IX-FS2-01-03 IX1044.2 +034000 IX-FS2-01-05 IX1044.2 +034100 DEPENDING ON WRK-CS-09V00-012. IX1044.2 +034200 GO TO IX-FS2-01-EXIT. IX1044.2 +034300 IX-FS2-01-03. IX1044.2 +034400*ENTRY FROM SEGMENT INX-TEST-001. IX1044.2 +034500* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX1044.2 +034600 ADD 1 TO WRK-CS-09V00-014. IX1044.2 +034700 IX-FS2-01-05. IX1044.2 +034800 ADD 1 TO WRK-CS-09V00-017. IX1044.2 +034900 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2 +035000 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX1044.2 +035100 MOVE "10" TO WRK-XN-0002-003. IX1044.2 +035200 IX-FS2-01-EXIT. IX1044.2 +035300 EXIT. IX1044.2 +035400 END DECLARATIVES. IX1044.2 +035500 CCVS1 SECTION. IX1044.2 +035600 OPEN-FILES. IX1044.2 +035700P OPEN I-O RAW-DATA. IX1044.2 +035800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2 +035900P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1044.2 +036000P MOVE "ABORTED " TO C-ABORT. IX1044.2 +036100P ADD 1 TO C-NO-OF-TESTS. IX1044.2 +036200P ACCEPT C-DATE FROM DATE. IX1044.2 +036300P ACCEPT C-TIME FROM TIME. IX1044.2 +036400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1044.2 +036500PEND-E-1. IX1044.2 +036600P CLOSE RAW-DATA. IX1044.2 +036700 OPEN OUTPUT PRINT-FILE. IX1044.2 +036800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1044.2 +036900 MOVE SPACE TO TEST-RESULTS. IX1044.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1044.2 +037100 MOVE ZERO TO REC-SKL-SUB. IX1044.2 +037200 PERFORM CCVS-INIT-FILE 9 TIMES. IX1044.2 +037300 CCVS-INIT-FILE. IX1044.2 +037400 ADD 1 TO REC-SKL-SUB. IX1044.2 +037500 MOVE FILE-RECORD-INFO-SKELETON IX1044.2 +037600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1044.2 +037700 CCVS-INIT-EXIT. IX1044.2 +037800 GO TO CCVS1-EXIT. IX1044.2 +037900 CLOSE-FILES. IX1044.2 +038000P OPEN I-O RAW-DATA. IX1044.2 +038100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2 +038200P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1044.2 +038300P MOVE "OK. " TO C-ABORT. IX1044.2 +038400P MOVE PASS-COUNTER TO C-OK. IX1044.2 +038500P MOVE ERROR-HOLD TO C-ALL. IX1044.2 +038600P MOVE ERROR-COUNTER TO C-FAIL. IX1044.2 +038700P MOVE DELETE-COUNTER TO C-DELETED. IX1044.2 +038800P MOVE INSPECT-COUNTER TO C-INSPECT. IX1044.2 +038900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1044.2 +039000PEND-E-2. IX1044.2 +039100P CLOSE RAW-DATA. IX1044.2 +039200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1044.2 +039300 TERMINATE-CCVS. IX1044.2 +039400S EXIT PROGRAM. IX1044.2 +039500STERMINATE-CALL. IX1044.2 +039600 STOP RUN. IX1044.2 +039700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1044.2 +039800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1044.2 +039900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1044.2 +040000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1044.2 +040100 MOVE "****TEST DELETED****" TO RE-MARK. IX1044.2 +040200 PRINT-DETAIL. IX1044.2 +040300 IF REC-CT NOT EQUAL TO ZERO IX1044.2 +040400 MOVE "." TO PARDOT-X IX1044.2 +040500 MOVE REC-CT TO DOTVALUE. IX1044.2 +040600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1044.2 +040700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1044.2 +040800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1044.2 +040900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1044.2 +041000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1044.2 +041100 MOVE SPACE TO CORRECT-X. IX1044.2 +041200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1044.2 +041300 MOVE SPACE TO RE-MARK. IX1044.2 +041400 HEAD-ROUTINE. IX1044.2 +041500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +041600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +041700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2 +041800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2 +041900 COLUMN-NAMES-ROUTINE. IX1044.2 +042000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +042100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +042200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +042300 END-ROUTINE. IX1044.2 +042400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1044.2 +042500 END-RTN-EXIT. IX1044.2 +042600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +042700 END-ROUTINE-1. IX1044.2 +042800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1044.2 +042900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1044.2 +043000 ADD PASS-COUNTER TO ERROR-HOLD. IX1044.2 +043100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1044.2 +043200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1044.2 +043300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1044.2 +043400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1044.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1044.2 +043600 END-ROUTINE-12. IX1044.2 +043700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1044.2 +043800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1044.2 +043900 MOVE "NO " TO ERROR-TOTAL IX1044.2 +044000 ELSE IX1044.2 +044100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1044.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1044.2 +044300 PERFORM WRITE-LINE. IX1044.2 +044400 END-ROUTINE-13. IX1044.2 +044500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1044.2 +044600 MOVE "NO " TO ERROR-TOTAL ELSE IX1044.2 +044700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1044.2 +044800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1044.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045000 IF INSPECT-COUNTER EQUAL TO ZERO IX1044.2 +045100 MOVE "NO " TO ERROR-TOTAL IX1044.2 +045200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1044.2 +045300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1044.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045600 WRITE-LINE. IX1044.2 +045700 ADD 1 TO RECORD-COUNT. IX1044.2 +045800Y IF RECORD-COUNT GREATER 42 IX1044.2 +045900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1044.2 +046000Y MOVE SPACE TO DUMMY-RECORD IX1044.2 +046100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1044.2 +046200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2 +046300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2 +046400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2 +046500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2 +046600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1044.2 +047000Y MOVE ZERO TO RECORD-COUNT. IX1044.2 +047100 PERFORM WRT-LN. IX1044.2 +047200 WRT-LN. IX1044.2 +047300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1044.2 +047400 MOVE SPACE TO DUMMY-RECORD. IX1044.2 +047500 BLANK-LINE-PRINT. IX1044.2 +047600 PERFORM WRT-LN. IX1044.2 +047700 FAIL-ROUTINE. IX1044.2 +047800 IF COMPUTED-X NOT EQUAL TO SPACE IX1044.2 +047900 GO TO FAIL-ROUTINE-WRITE. IX1044.2 +048000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1044.2 +048100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2 +048200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1044.2 +048300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2 +048500 GO TO FAIL-ROUTINE-EX. IX1044.2 +048600 FAIL-ROUTINE-WRITE. IX1044.2 +048700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1044.2 +048800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1044.2 +048900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1044.2 +049000 MOVE SPACES TO COR-ANSI-REFERENCE. IX1044.2 +049100 FAIL-ROUTINE-EX. EXIT. IX1044.2 +049200 BAIL-OUT. IX1044.2 +049300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1044.2 +049400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1044.2 +049500 BAIL-OUT-WRITE. IX1044.2 +049600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1044.2 +049700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2 +049800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +049900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2 +050000 BAIL-OUT-EX. EXIT. IX1044.2 +050100 CCVS1-EXIT. IX1044.2 +050200 EXIT. IX1044.2 +050300 SECT-IX-04-001 SECTION. IX1044.2 +050400 WRITE-INIT-GF-01. IX1044.2 +050500 MOVE "CREATE IX-FS2" TO FEATURE IX1044.2 +050600 MOVE "IX-FS2" TO XFILE-NAME (2). IX1044.2 +050700 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1044.2 +050800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1044.2 +050900 MOVE 000240 TO XRECORD-LENGTH (2). IX1044.2 +051000 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1044.2 +051100 MOVE 0001 TO XBLOCK-SIZE (2). IX1044.2 +051200 MOVE 000500 TO RECORDS-IN-FILE (2). IX1044.2 +051300 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1044.2 +051400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1044.2 +051500 MOVE "S" TO XLABEL-TYPE (2). IX1044.2 +051600 MOVE 000001 TO XRECORD-NUMBER (2). IX1044.2 +051700*INITIALIZE RECORD WORK AREA NUMBER 2. IX1044.2 +051800 MOVE 1 TO WRK-CS-09V00-012. IX1044.2 +051900 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX1044.2 +052000 WRK-CS-09V00-015 WRK-CS-09V00-016 IX1044.2 +052100 WRK-CS-09V00-017 WRK-CS-09V00-018. IX1044.2 +052200 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +052300 MOVE ZERO TO WRK-DU-09V00-001. IX1044.2 +052400 OPEN OUTPUT IX-FS2. IX1044.2 +052500 MOVE GRP-0101 TO IX-FS2-KEY. IX1044.2 +052600 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX1044.2 +052700*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX1044.2 +052800 WRITE-TEST-GF-01. IX1044.2 +052900 MOVE "99" TO IX-FS2-STATUS. IX1044.2 +053000 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX1044.2 +053100 MOVE GRP-0101 TO XRECORD-KEY (2). IX1044.2 +053200 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX1044.2 +053300 WRITE IX-FS2R1-F-G-240. IX1044.2 +053400 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +053500 ADD 1 TO WRK-CS-09V00-016. IX1044.2 +053600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2 +053700 GO TO WRITE-TEST-GF-01-2. IX1044.2 +053800 ADD 01 TO XRECORD-NUMBER (2). IX1044.2 +053900 GO TO WRITE-TEST-GF-01. IX1044.2 +054000 WRITE-TEST-GF-01-2. IX1044.2 +054100 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX1044.2 +054200 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK IX1044.2 +054300 MOVE ZERO TO CORRECT-18V0 IX1044.2 +054400 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2 +054500 MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2 +054600 PERFORM FAIL IX1044.2 +054700 ELSE IX1044.2 +054800 PERFORM PASS. IX1044.2 +054900 PERFORM PRINT-DETAIL. IX1044.2 +055000 WRITE-TEST-GF-02. IX1044.2 +055100 MOVE "CREATE IX-FS2" TO FEATURE IX1044.2 +055200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1044.2 +055300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX1044.2 +055400 MOVE "INCORRECT COUNT" TO RE-MARK IX1044.2 +055500 MOVE 500 TO CORRECT-18V0 IX1044.2 +055600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX1044.2 +055700 MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2 +055800 PERFORM FAIL IX1044.2 +055900 ELSE IX1044.2 +056000 PERFORM PASS. IX1044.2 +056100 PERFORM PRINT-DETAIL. IX1044.2 +056200 WRITE-TEST-GF-03. IX1044.2 +056300 MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2 +056400 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX1044.2 +056500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2 +056600 MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2 +056700 MOVE "00" TO CORRECT-A IX1044.2 +056800 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +056900 PERFORM FAIL IX1044.2 +057000 ELSE IX1044.2 +057100 PERFORM PASS. IX1044.2 +057200 PERFORM PRINT-DETAIL. IX1044.2 +057300 WRITE-TEST-GF-04. IX1044.2 +057400 MOVE "WRITE: 00 EXP." TO FEATURE. IX1044.2 +057500 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX1044.2 +057600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +057700 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +057800 MOVE "00" TO CORRECT-A IX1044.2 +057900 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +058000 PERFORM FAIL IX1044.2 +058100 ELSE IX1044.2 +058200 PERFORM PASS. IX1044.2 +058300 PERFORM PRINT-DETAIL. IX1044.2 +058400 WRITE-TEST-GF-05. IX1044.2 +058500 MOVE "WRITE: 00 EXP. " TO FEATURE. IX1044.2 +058600 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX1044.2 +058700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX1044.2 +058800 MOVE ZERO TO CORRECT-18V0 IX1044.2 +058900 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX1044.2 +059000 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +059100 PERFORM FAIL IX1044.2 +059200 ELSE IX1044.2 +059300 PERFORM PASS. IX1044.2 +059400 PERFORM PRINT-DETAIL. IX1044.2 +059500 WRITE-TEST-GF-06. IX1044.2 +059600 MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2 +059700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX1044.2 +059800 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +059900 CLOSE IX-FS2. IX1044.2 +060000 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +060100 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2 +060200 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +060300 MOVE "00" TO CORRECT-A IX1044.2 +060400 PERFORM FAIL IX1044.2 +060500 ELSE IX1044.2 +060600 PERFORM PASS. IX1044.2 +060700 PERFORM PRINT-DETAIL. IX1044.2 +060800 READ-INIT-F1-01. IX1044.2 +060900 MOVE 2 TO WRK-CS-09V00-012. IX1044.2 +061000 MOVE ZERO TO WRK-CS-09V00-013. IX1044.2 +061100 MOVE ZERO TO WRK-CS-09V00-014. IX1044.2 +061200 MOVE ZERO TO WRK-CS-09V00-015. IX1044.2 +061300 MOVE ZERO TO WRK-CS-09V00-016. IX1044.2 +061400 MOVE ZERO TO WRK-CS-09V00-017. IX1044.2 +061500 MOVE ZERO TO WRK-CS-09V00-018. IX1044.2 +061600 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +061700 OPEN I-O IX-FS2. IX1044.2 +061800 MOVE SPACE TO WRK-XN-0002-002 IX1044.2 +061900 MOVE SPACE TO WRK-XN-0002-003 IX1044.2 +062000 MOVE SPACE TO WRK-XN-0002-004 IX1044.2 +062100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1044.2 +062200 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +062300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX1044.2 +062400 READ-TEST-F1-01. IX1044.2 +062500 ADD 1 TO WRK-CS-09V00-014. IX1044.2 +062600 ADD 1 TO WRK-CS-09V00-015. IX1044.2 +062700 READ IX-FS2. IX1044.2 +062800 IF IX-FS2-STATUS EQUAL TO "10" IX1044.2 +062900 GO TO READ-TEST-F1-01-3. IX1044.2 +063000 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1044.2 +063100 IF WRK-CS-09V00-015 EQUAL TO 5 IX1044.2 +063200 ADD 01 TO UPDATE-NUMBER (2) IX1044.2 +063300 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240 IX1044.2 +063400 PERFORM READ-010-UPDATE IX1044.2 +063500 MOVE ZERO TO WRK-CS-09V00-015 IX1044.2 +063600 GO TO READ-TEST-F1-01-2. IX1044.2 +063700 IF WRK-CS-09V00-014 GREATER 500 IX1044.2 +063800 GO TO READ-TEST-F1-01-3. IX1044.2 +063900 GO TO READ-TEST-F1-01. IX1044.2 +064000 READ-010-UPDATE. IX1044.2 +064100 REWRITE IX-FS2R1-F-G-240. IX1044.2 +064200 READ-TEST-F1-01-2. IX1044.2 +064300 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +064400 ADD 1 TO WRK-CS-09V00-016. IX1044.2 +064500 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +064600 GO TO READ-TEST-F1-01. IX1044.2 +064700 READ-TEST-F1-01-3. IX1044.2 +064800 MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2 +064900 MOVE "READ-TEST-F1-01-3" TO PAR-NAME. IX1044.2 +065000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX1044.2 +065100 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +065200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX1044.2 +065300 MOVE 1 TO CORRECT-18V0 IX1044.2 +065400 PERFORM FAIL IX1044.2 +065500 ELSE IX1044.2 +065600 PERFORM PASS. IX1044.2 +065700 PERFORM PRINT-DETAIL. IX1044.2 +065800 READ-TEST-F1-02. IX1044.2 +065900 MOVE "READ " TO FEATURE. IX1044.2 +066000 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX1044.2 +066100 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX1044.2 +066200 MOVE "INCORRECT COUNT IX-28 4.5.2" TO RE-MARK IX1044.2 +066300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2 +066400 MOVE 501 TO CORRECT-18V0 IX1044.2 +066500 PERFORM FAIL IX1044.2 +066600 ELSE IX1044.2 +066700 PERFORM PASS. IX1044.2 +066800 PERFORM PRINT-DETAIL. IX1044.2 +066900 READ-TEST-F1-03. IX1044.2 +067000 MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2 +067100 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX1044.2 +067200 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2 +067300 MOVE "IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +067400 MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2 +067500 MOVE "00" TO CORRECT-A IX1044.2 +067600 PERFORM FAIL IX1044.2 +067700 ELSE IX1044.2 +067800 PERFORM PASS. IX1044.2 +067900 PERFORM PRINT-DETAIL. IX1044.2 +068000 READ-TEST-F1-04. IX1044.2 +068100 MOVE "READ AT END: 10 EXP." TO FEATURE. IX1044.2 +068200 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX1044.2 +068300 IF IX-FS2-STATUS NOT EQUAL TO "10" IX1044.2 +068400 MOVE "ATEND/STATUS" TO RE-MARK IX1044.2 +068500 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +068600 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +068700 MOVE "10" TO CORRECT-A IX1044.2 +068800 PERFORM FAIL IX1044.2 +068900 ELSE IX1044.2 +069000 PERFORM PASS. IX1044.2 +069100 PERFORM PRINT-DETAIL. IX1044.2 +069200 READ-TEST-F1-05. IX1044.2 +069300 MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2 +069400 MOVE "READ-TEST-F1-05 " TO PAR-NAME. IX1044.2 +069500 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX1044.2 +069600 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +069700 MOVE WRK-XN-0002-002 TO COMPUTED-A IX1044.2 +069800 MOVE "10" TO CORRECT-A IX1044.2 +069900 PERFORM FAIL IX1044.2 +070000 ELSE IX1044.2 +070100 PERFORM PASS. IX1044.2 +070200 PERFORM PRINT-DETAIL. IX1044.2 +070300 READ-TEST-F1-06. IX1044.2 +070400 MOVE "READ NO EXCEPTION 10" TO FEATURE. IX1044.2 +070500 MOVE "READ-TEST-F1-06 " TO PAR-NAME. IX1044.2 +070600 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX1044.2 +070700 MOVE "NO/EXCEPTION IX-4 1.3.4 (2) A" TO RE-MARK IX1044.2 +070800 MOVE WRK-XN-0002-003 TO COMPUTED-A IX1044.2 +070900 MOVE "10" TO CORRECT-A IX1044.2 +071000 PERFORM FAIL IX1044.2 +071100 ELSE IX1044.2 +071200 PERFORM PASS. IX1044.2 +071300 PERFORM PRINT-DETAIL. IX1044.2 +071400 READ-TEST-F1-07. IX1044.2 +071500 MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2 +071600 MOVE "READ-TEST-F1-07 " TO PAR-NAME. IX1044.2 +071700 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +071800 CLOSE IX-FS2 IX1044.2 +071900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +072000 MOVE "CLOSE/STATUS IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2 +072100 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +072200 MOVE "00" TO CORRECT-A IX1044.2 +072300 PERFORM FAIL IX1044.2 +072400 ELSE IX1044.2 +072500 PERFORM PASS. IX1044.2 +072600 PERFORM PRINT-DETAIL. IX1044.2 +072700 CCVS-EXIT SECTION. IX1044.2 +072800 CCVS-999999. IX1044.2 +072900 GO TO CLOSE-FILES. IX1044.2 +*END-OF,IX104A +*HEADER,COBOL,IX105A +000100 IDENTIFICATION DIVISION. IX1054.2 +000200 PROGRAM-ID. IX1054.2 +000300 IX105A. IX1054.2 +000400**************************************************************** IX1054.2 +000500* * IX1054.2 +000600* VALIDATION FOR:- * IX1054.2 +000700* * IX1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +000900* * IX1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1054.2 +001100* * IX1054.2 +001200**************************************************************** IX1054.2 +001300*GENERAL: THIS PROGRAM PROCESSES THREE INDEXED I-O FILES IX1054.2 +001400* IDENTIFIED AS IX-FR1,IX-FR2 AND IX-FR3. THE FUNCTIONIX1054.2 +001500* OF THIS PROGRAM IS TO CREATE THREE INDEXED FILES IX1054.2 +001600* RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY THAT THEY IX1054.2 +001700* WERE CREATED CORRECTLY. THE FILES PROCESSED IX1054.2 +001800* CONTAIN VARIABLE LENGTH RECORDS. IX1054.2 +001900* IX1054.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS IX1054.2 +002100* PROGRAM ARE: IX1054.2 +002200* IX1054.2 +002300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002400* INDEXED I-O DATA FILE-1 IX1054.2 +002500* X-25 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002600* INDEXED I-O DATA FILE-2 IX1054.2 +002700* X-26 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002800* INDEXED I-O DATA FILE-3 IX1054.2 +002900* X-55 SYSTEM PRINTER IX1054.2 +003000* X-62 FOR RAW-DATA IX1054.2 +003100* X-82 SOURCE-COMPUTER IX1054.2 +003200* X-83 OBJECT-COMPUTER. IX1054.2 +003300* IX1054.2 +003400* THIS PROGRAM SHOULD BE RUN ONLY WHEN AN IMPLEMENTATION * IX1054.2 +003500* PROVIDES VARIABLE-LENGTH RECORDS FOR THE RECORD CONTAINS * IX1054.2 +003600* INTEGER TO INTEGER CLAUSE. * IX1054.2 +003700* * IX1054.2 +003800*************************************************** IX1054.2 +003900 ENVIRONMENT DIVISION. IX1054.2 +004000 CONFIGURATION SECTION. IX1054.2 +004100 SOURCE-COMPUTER. IX1054.2 +004200 XXXXX082. IX1054.2 +004300 OBJECT-COMPUTER. IX1054.2 +004400 XXXXX083. IX1054.2 +004500 INPUT-OUTPUT SECTION. IX1054.2 +004600 FILE-CONTROL. IX1054.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1054.2 +004800 XXXXX055. IX1054.2 +004900 SELECT IX-FR1 ASSIGN TO IX1054.2 +005000 XXXXX024 IX1054.2 +005100 ORGANIZATION IS INDEXED IX1054.2 +005200 ACCESS MODE IS RANDOM IX1054.2 +005300 RECORD KEY IS IX-FR1-KEY. IX1054.2 +005400 SELECT IX-FR2 ASSIGN TO IX1054.2 +005500 XXXXX025 IX1054.2 +005600 ORGANIZATION IS INDEXED IX1054.2 +005700 ACCESS MODE IS RANDOM IX1054.2 +005800 RECORD KEY IS IX-FR2-KEY. IX1054.2 +005900 SELECT IX-FR3 ASSIGN TO IX1054.2 +006000 XXXXX026 IX1054.2 +006100 ORGANIZATION IS INDEXED IX1054.2 +006200 ACCESS MODE IS RANDOM IX1054.2 +006300 RECORD KEY IS IX-FR3-KEY. IX1054.2 +006400 I-O-CONTROL. IX1054.2 +006500 SAME IX-FR2 IX-FR3. IX1054.2 +006600 DATA DIVISION. IX1054.2 +006700 FILE SECTION. IX1054.2 +006800 FD PRINT-FILE. IX1054.2 +006900 01 PRINT-REC PICTURE X(120). IX1054.2 +007000 01 DUMMY-RECORD PICTURE X(120). IX1054.2 +007100 FD IX-FR1 IX1054.2 +007200C LABEL RECORDS ARE STANDARD IX1054.2 +007300C DATA RECORDS ARE GRP-1SEQ-RECORD-1A GRP-1SEQ-RECORD-1B IX1054.2 +007400 RECORD CONTAINS 56 TO 100 CHARACTERS. IX1054.2 +007500 01 GRP-1SEQ-RECORD-1A. IX1054.2 +007600 02 IX-FR1-KEY PICTURE X(8). IX1054.2 +007700 02 FILLER-1A PICTURE X(48). IX1054.2 +007800 01 GRP-1SEQ-RECORD-1B. IX1054.2 +007900 02 FILLER-1B PICTURE X(56). IX1054.2 +008000 02 LONG-REC-1B. IX1054.2 +008100 03 FILLER PICTURE X(15). IX1054.2 +008200 03 REC-NUMBER-1B PICTURE XXX. IX1054.2 +008300 03 FILLER PICTURE X(26). IX1054.2 +008400 FD IX-FR2 IX1054.2 +008500C DATA RECORDS GRP-1SEQ-RECORD-2A GRP-1SEQ-RECORD-2B IX1054.2 +008600C LABEL RECORDS ARE STANDARD IX1054.2 +008700 RECORD CONTAINS 56 TO 101 CHARACTERS. IX1054.2 +008800 01 GRP-1SEQ-RECORD-2A. IX1054.2 +008900 02 IX-FR2-KEY PICTURE X(8). IX1054.2 +009000 02 FILLER-2A PICTURE X(48). IX1054.2 +009100 01 GRP-1SEQ-RECORD-2B. IX1054.2 +009200 02 FILLER-2B PICTURE X(56). IX1054.2 +009300 02 LONG-REC-2B. IX1054.2 +009400 03 FILLER PICTURE X(15). IX1054.2 +009500 03 REC-NUMBER-2B PICTURE XXX. IX1054.2 +009600 03 FILLER PICTURE X(27). IX1054.2 +009700 FD IX-FR3 IX1054.2 +009800C LABEL RECORD STANDARD IX1054.2 +009900C DATA RECORD GRP-1SEQ-RECORD-3A GRP-1SEQ-RECORD-3B IX1054.2 +010000 BLOCK 3 RECORDS IX1054.2 +010100 RECORD CONTAINS 56 TO 102 CHARACTERS. IX1054.2 +010200 01 GRP-1SEQ-RECORD-3A. IX1054.2 +010300 02 IX-FR3-KEY PICTURE X(8). IX1054.2 +010400 02 FILLER-3A PICTURE X(48). IX1054.2 +010500 01 GRP-1SEQ-RECORD-3B. IX1054.2 +010600 02 FILLER-3B PICTURE X(56). IX1054.2 +010700 02 LONG-REC-3B. IX1054.2 +010800 03 FILLER PICTURE X(15). IX1054.2 +010900 03 REC-NUMBER-3B PICTURE XXX. IX1054.2 +011000 02 FILLER PICTURE X(28). IX1054.2 +011100 WORKING-STORAGE SECTION. IX1054.2 +011200 01 SHORT-SW PICTURE 9 VALUE ZERO. IX1054.2 +011300 01 RECORD-BUILD. IX1054.2 +011400 02 KEY-BUILD. IX1054.2 +011500 03 KEY-NAME PICTURE X(3) VALUE "KEY". IX1054.2 +011600 03 KEY-VALUE PICTURE 9(5) VALUE ZERO. IX1054.2 +011700 02 FILLER PICTURE X(6) VALUE " FILE ". IX1054.2 +011800 02 FILE-NO PICTURE 99 VALUE ZERO. IX1054.2 +011900 02 FILLER PICTURE X(14) VALUE IX1054.2 +012000 " RECORD TYPE ". IX1054.2 +012100 02 RECORD-LONG-OR-SHORT PICTURE X(5) VALUE "SHORT". IX1054.2 +012200 02 FILLER PICTURE X(21) VALUE SPACE. IX1054.2 +012300 02 RECORD-LONG-ONLY. IX1054.2 +012400 03 FILLER PICTURE X(15) VALUE IX1054.2 +012500 " RECORD NUMBER ". IX1054.2 +012600 03 THREE-POS-NUM PICTURE 999 VALUE ZERO. IX1054.2 +012700 03 FILLER-LONG PICTURE X(28) VALUE IX1054.2 +012800 " AREA USED FOR LONG RECORD ". IX1054.2 +012900 01 FILE-RECORD-INFORMATION-REC. IX1054.2 +013000 03 FILE-RECORD-INFO-SKELETON. IX1054.2 +013100 05 FILLER PICTURE X(48) VALUE IX1054.2 +013200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1054.2 +013300 05 FILLER PICTURE X(46) VALUE IX1054.2 +013400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1054.2 +013500 05 FILLER PICTURE X(26) VALUE IX1054.2 +013600 ",LFIL=000000,ORG= ,LBLR= ". IX1054.2 +013700 05 FILLER PICTURE X(37) VALUE IX1054.2 +013800 ",RECKEY= ". IX1054.2 +013900 05 FILLER PICTURE X(38) VALUE IX1054.2 +014000 ",ALTKEY1= ". IX1054.2 +014100 05 FILLER PICTURE X(38) VALUE IX1054.2 +014200 ",ALTKEY2= ". IX1054.2 +014300 05 FILLER PICTURE X(7) VALUE SPACE.IX1054.2 +014400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1054.2 +014500 05 FILE-RECORD-INFO-P1-120. IX1054.2 +014600 07 FILLER PIC X(5). IX1054.2 +014700 07 XFILE-NAME PIC X(6). IX1054.2 +014800 07 FILLER PIC X(8). IX1054.2 +014900 07 XRECORD-NAME PIC X(6). IX1054.2 +015000 07 FILLER PIC X(1). IX1054.2 +015100 07 REELUNIT-NUMBER PIC 9(1). IX1054.2 +015200 07 FILLER PIC X(7). IX1054.2 +015300 07 XRECORD-NUMBER PIC 9(6). IX1054.2 +015400 07 FILLER PIC X(6). IX1054.2 +015500 07 UPDATE-NUMBER PIC 9(2). IX1054.2 +015600 07 FILLER PIC X(5). IX1054.2 +015700 07 ODO-NUMBER PIC 9(4). IX1054.2 +015800 07 FILLER PIC X(5). IX1054.2 +015900 07 XPROGRAM-NAME PIC X(5). IX1054.2 +016000 07 FILLER PIC X(7). IX1054.2 +016100 07 XRECORD-LENGTH PIC 9(6). IX1054.2 +016200 07 FILLER PIC X(7). IX1054.2 +016300 07 CHARS-OR-RECORDS PIC X(2). IX1054.2 +016400 07 FILLER PIC X(1). IX1054.2 +016500 07 XBLOCK-SIZE PIC 9(4). IX1054.2 +016600 07 FILLER PIC X(6). IX1054.2 +016700 07 RECORDS-IN-FILE PIC 9(6). IX1054.2 +016800 07 FILLER PIC X(5). IX1054.2 +016900 07 XFILE-ORGANIZATION PIC X(2). IX1054.2 +017000 07 FILLER PIC X(6). IX1054.2 +017100 07 XLABEL-TYPE PIC X(1). IX1054.2 +017200 05 FILE-RECORD-INFO-P121-240. IX1054.2 +017300 07 FILLER PIC X(8). IX1054.2 +017400 07 XRECORD-KEY PIC X(29). IX1054.2 +017500 07 FILLER PIC X(9). IX1054.2 +017600 07 ALTERNATE-KEY1 PIC X(29). IX1054.2 +017700 07 FILLER PIC X(9). IX1054.2 +017800 07 ALTERNATE-KEY2 PIC X(29). IX1054.2 +017900 07 FILLER PIC X(7). IX1054.2 +018000 01 TEST-RESULTS. IX1054.2 +018100 02 FILLER PIC X VALUE SPACE. IX1054.2 +018200 02 FEATURE PIC X(20) VALUE SPACE. IX1054.2 +018300 02 FILLER PIC X VALUE SPACE. IX1054.2 +018400 02 P-OR-F PIC X(5) VALUE SPACE. IX1054.2 +018500 02 FILLER PIC X VALUE SPACE. IX1054.2 +018600 02 PAR-NAME. IX1054.2 +018700 03 FILLER PIC X(19) VALUE SPACE. IX1054.2 +018800 03 PARDOT-X PIC X VALUE SPACE. IX1054.2 +018900 03 DOTVALUE PIC 99 VALUE ZERO. IX1054.2 +019000 02 FILLER PIC X(8) VALUE SPACE. IX1054.2 +019100 02 RE-MARK PIC X(61). IX1054.2 +019200 01 TEST-COMPUTED. IX1054.2 +019300 02 FILLER PIC X(30) VALUE SPACE. IX1054.2 +019400 02 FILLER PIC X(17) VALUE IX1054.2 +019500 " COMPUTED=". IX1054.2 +019600 02 COMPUTED-X. IX1054.2 +019700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1054.2 +019800 03 COMPUTED-N REDEFINES COMPUTED-A IX1054.2 +019900 PIC -9(9).9(9). IX1054.2 +020000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1054.2 +020100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1054.2 +020200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1054.2 +020300 03 CM-18V0 REDEFINES COMPUTED-A. IX1054.2 +020400 04 COMPUTED-18V0 PIC -9(18). IX1054.2 +020500 04 FILLER PIC X. IX1054.2 +020600 03 FILLER PIC X(50) VALUE SPACE. IX1054.2 +020700 01 TEST-CORRECT. IX1054.2 +020800 02 FILLER PIC X(30) VALUE SPACE. IX1054.2 +020900 02 FILLER PIC X(17) VALUE " CORRECT =". IX1054.2 +021000 02 CORRECT-X. IX1054.2 +021100 03 CORRECT-A PIC X(20) VALUE SPACE. IX1054.2 +021200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1054.2 +021300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1054.2 +021400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1054.2 +021500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1054.2 +021600 03 CR-18V0 REDEFINES CORRECT-A. IX1054.2 +021700 04 CORRECT-18V0 PIC -9(18). IX1054.2 +021800 04 FILLER PIC X. IX1054.2 +021900 03 FILLER PIC X(2) VALUE SPACE. IX1054.2 +022000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1054.2 +022100 01 CCVS-C-1. IX1054.2 +022200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1054.2 +022300- "SS PARAGRAPH-NAME IX1054.2 +022400- " REMARKS". IX1054.2 +022500 02 FILLER PIC X(20) VALUE SPACE. IX1054.2 +022600 01 CCVS-C-2. IX1054.2 +022700 02 FILLER PIC X VALUE SPACE. IX1054.2 +022800 02 FILLER PIC X(6) VALUE "TESTED". IX1054.2 +022900 02 FILLER PIC X(15) VALUE SPACE. IX1054.2 +023000 02 FILLER PIC X(4) VALUE "FAIL". IX1054.2 +023100 02 FILLER PIC X(94) VALUE SPACE. IX1054.2 +023200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1054.2 +023300 01 REC-CT PIC 99 VALUE ZERO. IX1054.2 +023400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1054.2 +023900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1054.2 +024000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1054.2 +024100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1054.2 +024200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1054.2 +024300 01 CCVS-H-1. IX1054.2 +024400 02 FILLER PIC X(39) VALUE SPACES. IX1054.2 +024500 02 FILLER PIC X(42) VALUE IX1054.2 +024600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1054.2 +024700 02 FILLER PIC X(39) VALUE SPACES. IX1054.2 +024800 01 CCVS-H-2A. IX1054.2 +024900 02 FILLER PIC X(40) VALUE SPACE. IX1054.2 +025000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1054.2 +025100 02 FILLER PIC XXXX VALUE IX1054.2 +025200 "4.2 ". IX1054.2 +025300 02 FILLER PIC X(28) VALUE IX1054.2 +025400 " COPY - NOT FOR DISTRIBUTION". IX1054.2 +025500 02 FILLER PIC X(41) VALUE SPACE. IX1054.2 +025600 IX1054.2 +025700 01 CCVS-H-2B. IX1054.2 +025800 02 FILLER PIC X(15) VALUE IX1054.2 +025900 "TEST RESULT OF ". IX1054.2 +026000 02 TEST-ID PIC X(9). IX1054.2 +026100 02 FILLER PIC X(4) VALUE IX1054.2 +026200 " IN ". IX1054.2 +026300 02 FILLER PIC X(12) VALUE IX1054.2 +026400 " HIGH ". IX1054.2 +026500 02 FILLER PIC X(22) VALUE IX1054.2 +026600 " LEVEL VALIDATION FOR ". IX1054.2 +026700 02 FILLER PIC X(58) VALUE IX1054.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +026900 01 CCVS-H-3. IX1054.2 +027000 02 FILLER PIC X(34) VALUE IX1054.2 +027100 " FOR OFFICIAL USE ONLY ". IX1054.2 +027200 02 FILLER PIC X(58) VALUE IX1054.2 +027300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1054.2 +027400 02 FILLER PIC X(28) VALUE IX1054.2 +027500 " COPYRIGHT 1985 ". IX1054.2 +027600 01 CCVS-E-1. IX1054.2 +027700 02 FILLER PIC X(52) VALUE SPACE. IX1054.2 +027800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1054.2 +027900 02 ID-AGAIN PIC X(9). IX1054.2 +028000 02 FILLER PIC X(45) VALUE SPACES. IX1054.2 +028100 01 CCVS-E-2. IX1054.2 +028200 02 FILLER PIC X(31) VALUE SPACE. IX1054.2 +028300 02 FILLER PIC X(21) VALUE SPACE. IX1054.2 +028400 02 CCVS-E-2-2. IX1054.2 +028500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1054.2 +028600 03 FILLER PIC X VALUE SPACE. IX1054.2 +028700 03 ENDER-DESC PIC X(44) VALUE IX1054.2 +028800 "ERRORS ENCOUNTERED". IX1054.2 +028900 01 CCVS-E-3. IX1054.2 +029000 02 FILLER PIC X(22) VALUE IX1054.2 +029100 " FOR OFFICIAL USE ONLY". IX1054.2 +029200 02 FILLER PIC X(12) VALUE SPACE. IX1054.2 +029300 02 FILLER PIC X(58) VALUE IX1054.2 +029400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +029500 02 FILLER PIC X(13) VALUE SPACE. IX1054.2 +029600 02 FILLER PIC X(15) VALUE IX1054.2 +029700 " COPYRIGHT 1985". IX1054.2 +029800 01 CCVS-E-4. IX1054.2 +029900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1054.2 +030000 02 FILLER PIC X(4) VALUE " OF ". IX1054.2 +030100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1054.2 +030200 02 FILLER PIC X(40) VALUE IX1054.2 +030300 " TESTS WERE EXECUTED SUCCESSFULLY". IX1054.2 +030400 01 XXINFO. IX1054.2 +030500 02 FILLER PIC X(19) VALUE IX1054.2 +030600 "*** INFORMATION ***". IX1054.2 +030700 02 INFO-TEXT. IX1054.2 +030800 04 FILLER PIC X(8) VALUE SPACE. IX1054.2 +030900 04 XXCOMPUTED PIC X(20). IX1054.2 +031000 04 FILLER PIC X(5) VALUE SPACE. IX1054.2 +031100 04 XXCORRECT PIC X(20). IX1054.2 +031200 02 INF-ANSI-REFERENCE PIC X(48). IX1054.2 +031300 01 HYPHEN-LINE. IX1054.2 +031400 02 FILLER PIC IS X VALUE IS SPACE. IX1054.2 +031500 02 FILLER PIC IS X(65) VALUE IS "************************IX1054.2 +031600- "*****************************************". IX1054.2 +031700 02 FILLER PIC IS X(54) VALUE IS "************************IX1054.2 +031800- "******************************". IX1054.2 +031900 01 CCVS-PGM-ID PIC X(9) VALUE IX1054.2 +032000 "IX105A". IX1054.2 +032100 PROCEDURE DIVISION. IX1054.2 +032200 CCVS1 SECTION. IX1054.2 +032300 OPEN-FILES. IX1054.2 +032400 OPEN OUTPUT PRINT-FILE. IX1054.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1054.2 +032600 MOVE SPACE TO TEST-RESULTS. IX1054.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1054.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX1054.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX1054.2 +033000 CCVS-INIT-FILE. IX1054.2 +033100 ADD 1 TO REC-SKL-SUB. IX1054.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX1054.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1054.2 +033400 CCVS-INIT-EXIT. IX1054.2 +033500 GO TO CCVS1-EXIT. IX1054.2 +033600 CLOSE-FILES. IX1054.2 +033700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1054.2 +033800 TERMINATE-CCVS. IX1054.2 +033900 STOP RUN. IX1054.2 +034000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1054.2 +034100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1054.2 +034200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1054.2 +034300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1054.2 +034400 MOVE "****TEST DELETED****" TO RE-MARK. IX1054.2 +034500 PRINT-DETAIL. IX1054.2 +034600 IF REC-CT NOT EQUAL TO ZERO IX1054.2 +034700 MOVE "." TO PARDOT-X IX1054.2 +034800 MOVE REC-CT TO DOTVALUE. IX1054.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1054.2 +035000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1054.2 +035100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1054.2 +035200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1054.2 +035300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1054.2 +035400 MOVE SPACE TO CORRECT-X. IX1054.2 +035500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1054.2 +035600 MOVE SPACE TO RE-MARK. IX1054.2 +035700 HEAD-ROUTINE. IX1054.2 +035800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +035900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +036000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1054.2 +036100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1054.2 +036200 COLUMN-NAMES-ROUTINE. IX1054.2 +036300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +036400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +036600 END-ROUTINE. IX1054.2 +036700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1054.2 +036800 END-RTN-EXIT. IX1054.2 +036900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +037000 END-ROUTINE-1. IX1054.2 +037100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1054.2 +037200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1054.2 +037300 ADD PASS-COUNTER TO ERROR-HOLD. IX1054.2 +037400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1054.2 +037500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1054.2 +037600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1054.2 +037700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1054.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1054.2 +037900 END-ROUTINE-12. IX1054.2 +038000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1054.2 +038100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1054.2 +038200 MOVE "NO " TO ERROR-TOTAL IX1054.2 +038300 ELSE IX1054.2 +038400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1054.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1054.2 +038600 PERFORM WRITE-LINE. IX1054.2 +038700 END-ROUTINE-13. IX1054.2 +038800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1054.2 +038900 MOVE "NO " TO ERROR-TOTAL ELSE IX1054.2 +039000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1054.2 +039100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1054.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039300 IF INSPECT-COUNTER EQUAL TO ZERO IX1054.2 +039400 MOVE "NO " TO ERROR-TOTAL IX1054.2 +039500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1054.2 +039600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1054.2 +039700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039900 WRITE-LINE. IX1054.2 +040000 ADD 1 TO RECORD-COUNT. IX1054.2 +040100Y IF RECORD-COUNT GREATER 42 IX1054.2 +040200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1054.2 +040300Y MOVE SPACE TO DUMMY-RECORD IX1054.2 +040400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1054.2 +040500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1054.2 +040600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1054.2 +040700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1054.2 +040800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1054.2 +040900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1054.2 +041300Y MOVE ZERO TO RECORD-COUNT. IX1054.2 +041400 PERFORM WRT-LN. IX1054.2 +041500 WRT-LN. IX1054.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1054.2 +041700 MOVE SPACE TO DUMMY-RECORD. IX1054.2 +041800 BLANK-LINE-PRINT. IX1054.2 +041900 PERFORM WRT-LN. IX1054.2 +042000 FAIL-ROUTINE. IX1054.2 +042100 IF COMPUTED-X NOT EQUAL TO SPACE IX1054.2 +042200 GO TO FAIL-ROUTINE-WRITE. IX1054.2 +042300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1054.2 +042400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1054.2 +042500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1054.2 +042600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +042700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1054.2 +042800 GO TO FAIL-ROUTINE-EX. IX1054.2 +042900 FAIL-ROUTINE-WRITE. IX1054.2 +043000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1054.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1054.2 +043200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1054.2 +043300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1054.2 +043400 FAIL-ROUTINE-EX. EXIT. IX1054.2 +043500 BAIL-OUT. IX1054.2 +043600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1054.2 +043700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1054.2 +043800 BAIL-OUT-WRITE. IX1054.2 +043900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1054.2 +044000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1054.2 +044100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +044200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1054.2 +044300 BAIL-OUT-EX. EXIT. IX1054.2 +044400 CCVS1-EXIT. IX1054.2 +044500 EXIT. IX1054.2 +044600 SECT-RC-02-001 SECTION. IX1054.2 +044700 WRITE-INIT-GF-01. IX1054.2 +044800 MOVE "WRITE SHORT & LONG " TO FEATURE. IX1054.2 +044900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1054.2 +045000 WRITE-TEST-GF-01. IX1054.2 +045100* CREATE AN INDEXED FILE OF 180 RECORDS. THE RECORDS SIZE IS IX1054.2 +045200* VARIABLE LENGTH (056 TO 100 CHARACTERS). IX1054.2 +045300 MOVE 1 TO FILE-NO. IX1054.2 +045400 OPEN OUTPUT IX-FR1. IX1054.2 +045500 PERFORM WRITE-TEST-GF-01-SHORT-REC 20 TIMES. IX1054.2 +045600 PERFORM WRITE-TEST-GF-01-LONG-REC 45 TIMES. IX1054.2 +045700 PERFORM WRITE-TEST-GF-01-SHORT-REC 50 TIMES. IX1054.2 +045800 PERFORM WRITE-TEST-GF-01-LONG-REC 29 TIMES. IX1054.2 +045900 PERFORM WRITE-TEST-GF-01-SHORT-REC 35 TIMES. IX1054.2 +046000 PERFORM WRITE-TEST-GF-01-LONG-REC. IX1054.2 +046100 IF THREE-POS-NUM EQUAL 180 IX1054.2 +046200 PERFORM PASS IX1054.2 +046300 MOVE "FILE IX-FR1 CREATED (180 RECORDS)" TO RE-MARK IX1054.2 +046400 GO TO WRITE-TEST-GF-01-WRITE. IX1054.2 +046500 MOVE "WRONG NUMBER OF RECORDS WRITTEN" TO RE-MARK. IX1054.2 +046600 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +046700 WRITE-DELETE-GF-01. IX1054.2 +046800 PERFORM DE-LETE. IX1054.2 +046900* NOTE IX-FR1 IS NOT CREATED SO SKIP TO WRITE-TEST-5. IX1054.2 +047000 PERFORM PRINT-DETAIL. IX1054.2 +047100 GO TO WRITE-INIT-GF-02. IX1054.2 +047200 WRITE-TEST-GF-01-LONG-REC. IX1054.2 +047300 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +047400 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +047500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-1B. IX1054.2 +047600 WRITE GRP-1SEQ-RECORD-1B INVALID KEY IX1054.2 +047700 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +047800 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +047900 WRITE-TEST-GF-01-SHORT-REC. IX1054.2 +048000 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +048100 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +048200 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-1B. IX1054.2 +048300 WRITE GRP-1SEQ-RECORD-1A INVALID KEY IX1054.2 +048400 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +048500 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +048600 WRITE-TEST-GF-01-FAIL. IX1054.2 +048700 MOVE "IX-41 4.9.2 WRONG NUMBER OF RECORDS WRITTEN" TO RE-MARKIX1054.2 +048800 PERFORM FAIL. IX1054.2 +048900 MOVE 180 TO CORRECT-18V0. IX1054.2 +049000 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +049100 WRITE-TEST-GF-01-WRITE. IX1054.2 +049200 MOVE SPACE TO GRP-1SEQ-RECORD-1B. IX1054.2 +049300 PERFORM PRINT-DETAIL. IX1054.2 +049400 CLOSE IX-FR1. IX1054.2 +049500 READ-INIT-F2-01. IX1054.2 +049600 MOVE "READ TO VERIFY " TO FEATURE. IX1054.2 +049700 MOVE "READ-TEST-F2-01 " TO PAR-NAME. IX1054.2 +049800* VERIFY NUMBER OF RECORDS IN FILE. IX1054.2 +049900 OPEN INPUT IX-FR1. IX1054.2 +050000 MOVE 1 TO KEY-VALUE. IX1054.2 +050100 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +050200 READ-TEST-F2-01. IX1054.2 +050300 READ IX-FR1 INVALID KEY IX1054.2 +050400 GO TO COMPARE-FOR-TEST-F2-01. IX1054.2 +050500 ADD 1 TO KEY-VALUE. IX1054.2 +050600 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +050700 IF KEY-VALUE GREATER THAN 181 IX1054.2 +050800 GO TO READ-FAIL-F2-01. IX1054.2 +050900 GO TO READ-TEST-F2-01. IX1054.2 +051000 COMPARE-FOR-TEST-F2-01. IX1054.2 +051100 IF KEY-VALUE EQUAL 181 IX1054.2 +051200 PERFORM PASS IX1054.2 +051300 MOVE "180 RECORDS VERIFIED" TO RE-MARK IX1054.2 +051400 GO TO READ-WRITE-F2-01. IX1054.2 +051500 READ-FAIL-F2-01. IX1054.2 +051600 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1054.2 +051700 PERFORM FAIL. IX1054.2 +051800 MOVE 180 TO CORRECT-18V0. IX1054.2 +051900 SUBTRACT 1 FROM KEY-VALUE. IX1054.2 +052000 MOVE KEY-VALUE TO COMPUTED-18V0. IX1054.2 +052100 MOVE "INCORRECT NUMBER OF RECORDS" TO RE-MARK. IX1054.2 +052200 READ-WRITE-F2-01. IX1054.2 +052300 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1054.2 +052400 PERFORM PRINT-DETAIL. IX1054.2 +052500 CLOSE IX-FR1. IX1054.2 +052600 READ-INIT-F2-02. IX1054.2 +052700 OPEN INPUT IX-FR1. IX1054.2 +052800 MOVE 10 TO KEY-VALUE. IX1054.2 +052900 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +053000 MOVE "READ SHORT RECORDS" TO FEATURE. IX1054.2 +053100 MOVE "READ-TEST-GF-02 " TO PAR-NAME. IX1054.2 +053200 READ-TEST-F2-02. IX1054.2 +053300* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +053400* SHORT RECORD. IX1054.2 +053500 READ IX-FR1 INVALID KEY IX1054.2 +053600 PERFORM FAIL IX1054.2 +053700 MOVE "KEY00010" TO CORRECT-A IX1054.2 +053800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +053900 MOVE "INVALID KEY IX-FR1 IX-28 4.5.2" TO RE-MARK IX1054.2 +054000 GO TO READ-TEST-F2-02-WRITE. IX1054.2 +054100* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +054200* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +054300* OF VARIABLE LENGTH RECORDS. IX1054.2 +054400* NOTE CHECK LENGTH OF RECORD 10. IX1054.2 +054500 COMPARE-FOR-TEST-F2-02. IX1054.2 +054600 IF REC-NUMBER-1B EQUAL TO "010" IX1054.2 +054700 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +054800 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +054900 MOVE 1 TO SHORT-SW. IX1054.2 +055000 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +055100 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +055200 READ-TEST-F2-02-WRITE. IX1054.2 +055300 PERFORM PRINT-DETAIL. IX1054.2 +055400 CLOSE IX-FR1. IX1054.2 +055500 READ-INIT-F2-03. IX1054.2 +055600* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +055700* LONG RECORD. IX1054.2 +055800 OPEN INPUT IX-FR1. IX1054.2 +055900 MOVE 144 TO KEY-VALUE. IX1054.2 +056000 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +056100 MOVE "READ LONG RECORDS" TO FEATURE. IX1054.2 +056200 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX1054.2 +056300 READ-TEST-F2-03. IX1054.2 +056400 READ IX-FR1 INVALID KEY IX1054.2 +056500 PERFORM FAIL IX1054.2 +056600 MOVE "KEY00144" TO CORRECT-A IX1054.2 +056700 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +056800 MOVE "INVAILD KEY IX-FR1" TO RE-MARK IX1054.2 +056900 GO TO READ-WRITE-F2-03. IX1054.2 +057000* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +057100* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +057200 COMPARE-FOR-TEST-F2-03. IX1054.2 +057300 IF REC-NUMBER-1B NOT EQUAL TO "144" GO TO READ-FAIL-F2-03. IX1054.2 +057400 PERFORM PASS. IX1054.2 +057500 PERFORM READ-WRITE-F2-03. IX1054.2 +057600 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A. IX1054.2 +057700 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +057800 IF SHORT-SW EQUAL TO ZERO IX1054.2 +057900 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +058000 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A. IX1054.2 +058100 GO TO READ-WRITE-F2-03. IX1054.2 +058200 READ-FAIL-F2-03. IX1054.2 +058300 PERFORM FAIL. IX1054.2 +058400 MOVE "KEY00144" TO CORRECT-A. IX1054.2 +058500 MOVE IX-FR1-KEY TO COMPUTED-A. IX1054.2 +058600 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +058700 READ-WRITE-F2-03. IX1054.2 +058800 PERFORM PRINT-DETAIL. IX1054.2 +058900 READ-TEST-F2-03-EXIT. IX1054.2 +059000 CLOSE IX-FR1. IX1054.2 +059100 WRITE-INIT-GF-02. IX1054.2 +059200 MOVE "WRITE IX-FS2 " TO FEATURE. IX1054.2 +059300 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX1054.2 +059400* CREATE AN INDEXED FILE OF 101 RECORDS. THE RECORD SIZE IS IX1054.2 +059500* VARIABLE LENGTH (056 TO 101 CHARACTERS). IX1054.2 +059600 MOVE ZERO TO KEY-VALUE THREE-POS-NUM SHORT-SW. IX1054.2 +059700 MOVE 2 TO FILE-NO. IX1054.2 +059800 OPEN OUTPUT IX-FR2. IX1054.2 +059900 WRITE-TEST-GF-02. IX1054.2 +060000 PERFORM WRITE-TEST-GF-02-SHORT-REC 11 TIMES. IX1054.2 +060100 PERFORM WRITE-TEST-GF-02-LONG-REC 29 TIMES. IX1054.2 +060200 PERFORM WRITE-TEST-GF-02-SHORT-REC 20 TIMES. IX1054.2 +060300 PERFORM WRITE-TEST-GF-02-LONG-REC 20 TIMES. IX1054.2 +060400 PERFORM WRITE-TEST-GF-02-SHORT-REC 20 TIMES. IX1054.2 +060500 PERFORM WRITE-TEST-GF-02-LONG-REC. IX1054.2 +060600 IF THREE-POS-NUM EQUAL 101 IX1054.2 +060700 PERFORM PASS IX1054.2 +060800 MOVE "FILE IX-FR2 CREATED (101 RECORDS)" TO RE-MARK IX1054.2 +060900 GO TO WRITE-TEST-GF-02-WRITE. IX1054.2 +061000 MOVE "WRONG NUMBER OF RECORDS WRITTEN IX-41 4.9.2" TO RE-MARKIX1054.2 +061100 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +061200 WRITE-DELETE-GF-02. IX1054.2 +061300 PERFORM DE-LETE. IX1054.2 +061400* NOTE IX-FR2 IS NOT CREATED SO SKIP TO WRITE-TEST-9. IX1054.2 +061500 PERFORM PRINT-DETAIL. IX1054.2 +061600 GO TO WRITE-INIT-GF-03. IX1054.2 +061700 WRITE-TEST-GF-02-LONG-REC. IX1054.2 +061800 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +061900 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +062000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-2B. IX1054.2 +062100 WRITE GRP-1SEQ-RECORD-2B INVALID KEY IX1054.2 +062200 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +062300 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +062400 WRITE-TEST-GF-02-SHORT-REC. IX1054.2 +062500 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +062600 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +062700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-2B. IX1054.2 +062800 WRITE GRP-1SEQ-RECORD-2A INVALID KEY IX1054.2 +062900 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +063000 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +063100 WRITE-TEST-GF-02-FAIL. IX1054.2 +063200 PERFORM FAIL. IX1054.2 +063300 MOVE 101 TO CORRECT-18V0. IX1054.2 +063400 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +063500 WRITE-TEST-GF-02-WRITE. IX1054.2 +063600 MOVE SPACE TO GRP-1SEQ-RECORD-2B. IX1054.2 +063700 PERFORM PRINT-DETAIL. IX1054.2 +063800 CLOSE IX-FR2. IX1054.2 +063900 READ-INIT-F2-05. IX1054.2 +064000* VERIFY NUMBER OF RECORDS IN FILE. IX1054.2 +064100 MOVE "READ IX-FS2 VERIFY " TO FEATURE. IX1054.2 +064200 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX1054.2 +064300 OPEN INPUT IX-FR2. IX1054.2 +064400 MOVE 1 TO KEY-VALUE. IX1054.2 +064500 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +064600 READ-TEST-F2-05. IX1054.2 +064700 READ IX-FR2 INVALID KEY IX1054.2 +064800 GO TO COMPARE-FOR-TEST-F2-05. IX1054.2 +064900 ADD 1 TO KEY-VALUE. IX1054.2 +065000 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +065100 IF KEY-VALUE GREATER THAN 102 IX1054.2 +065200 GO TO READ-TEST-F2-05-FAIL. IX1054.2 +065300 GO TO READ-TEST-F2-05. IX1054.2 +065400 COMPARE-FOR-TEST-F2-05. IX1054.2 +065500 IF KEY-VALUE EQUAL 102 IX1054.2 +065600 PERFORM PASS IX1054.2 +065700 MOVE "101 RECORDS VERIFIED" TO RE-MARK IX1054.2 +065800 GO TO READ-TEST-F2-05-WRITE. IX1054.2 +065900 READ-TEST-F2-05-FAIL. IX1054.2 +066000 PERFORM FAIL. IX1054.2 +066100 MOVE 101 TO CORRECT-18V0. IX1054.2 +066200 SUBTRACT 1 FROM KEY-VALUE. IX1054.2 +066300 MOVE KEY-VALUE TO COMPUTED-18V0. IX1054.2 +066400 MOVE "INCORRECT NUMBER OF RECORDS IX-28 4.5.2" TO RE-MARK. IX1054.2 +066500 READ-TEST-F2-05-WRITE. IX1054.2 +066600 PERFORM PRINT-DETAIL. IX1054.2 +066700 READ-INIT-F2-06. IX1054.2 +066800* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +066900* SHORT RECORD. IX1054.2 +067000 MOVE "READ " TO FEATURE. IX1054.2 +067100 MOVE "READ-TEST-F2-06 " TO PAR-NAME. IX1054.2 +067200 MOVE 100 TO KEY-VALUE. IX1054.2 +067300 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +067400 READ-TEST-F2-06. IX1054.2 +067500 READ IX-FR2 INVALID KEY IX1054.2 +067600 PERFORM FAIL IX1054.2 +067700 MOVE "KEY00100" TO CORRECT-A IX1054.2 +067800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +067900 MOVE "INVAILD KEY IX-FR2 IX-28 4.5.2 " TO RE-MARK IX1054.2 +068000 GO TO READ-TEST-F2-06-WRITE. IX1054.2 +068100* NOTE *** IF REC-NUMBER-2B CONTAINS THE RECORD NUMBER IX1054.2 +068200* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +068300* OF VARIABLE LENGTH RECORDS. IX1054.2 +068400* NOTE CHECK LENGTH OF RECORD 100. IX1054.2 +068500 COMPARE-FOR-TEST-F2-06. IX1054.2 +068600 IF REC-NUMBER-2B EQUAL TO "100" IX1054.2 +068700 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +068800 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +068900 MOVE 1 TO SHORT-SW. IX1054.2 +069000 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +069100 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +069200 READ-TEST-F2-06-WRITE. IX1054.2 +069300 PERFORM PRINT-DETAIL. IX1054.2 +069400 READ-INIT-F2-07. IX1054.2 +069500* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +069600* LONG RECORD. IX1054.2 +069700 MOVE "READ " TO FEATURE. IX1054.2 +069800 MOVE "READ-TEST-F2-07 " TO PAR-NAME. IX1054.2 +069900 MOVE 12 TO KEY-VALUE. IX1054.2 +070000 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +070100 READ-TEST-F2-07. IX1054.2 +070200 READ IX-FR2 INVALID KEY IX1054.2 +070300 PERFORM FAIL IX1054.2 +070400 MOVE "KEY00012" TO CORRECT-A IX1054.2 +070500 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +070600 MOVE "INVALID KEY IX-FR2 IX-28 4.5.2" TO RE-MARK IX1054.2 +070700 GO TO READ-TEST-F2-07-WRITE. IX1054.2 +070800* NOTE ** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +070900* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +071000 COMPARE-FOR-TEST-F2-07. IX1054.2 +071100 IF REC-NUMBER-2B EQUAL TO "012" IX1054.2 +071200 PERFORM PASS IX1054.2 +071300 PERFORM READ-TEST-F2-07-WRITE IX1054.2 +071400 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A IX1054.2 +071500 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK IX1054.2 +071600 IF SHORT-SW EQUAL TO ZERO IX1054.2 +071700 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +071800 GO TO READ-TEST-F2-07-WRITE IX1054.2 +071900 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A IX1054.2 +072000 GO TO READ-TEST-F2-07-WRITE. IX1054.2 +072100 PERFORM FAIL. IX1054.2 +072200 MOVE "KEY00012" TO CORRECT-A. IX1054.2 +072300 MOVE IX-FR2-KEY TO COMPUTED-A. IX1054.2 +072400 MOVE "WRONG LENGTH OR WRONG RECORD" TO RE-MARK. IX1054.2 +072500 READ-TEST-F2-07-WRITE. IX1054.2 +072600 PERFORM PRINT-DETAIL. IX1054.2 +072700 READ-TEST-F2-07-EXIT. IX1054.2 +072800 CLOSE IX-FR2. IX1054.2 +072900 WRITE-INIT-GF-03. IX1054.2 +073000* CREATE AN INDEXED FILE OF 120 RECORDS. THE RECORD SIZE IS IX1054.2 +073100* VARIABLE LENGTH (056-102 CHARACTERS). IX1054.2 +073200 MOVE "WRITE IX-FS3 " TO FEATURE. IX1054.2 +073300 MOVE "WRITE-TEST-GF-03 " TO PAR-NAME. IX1054.2 +073400 MOVE ZERO TO KEY-VALUE THREE-POS-NUM SHORT-SW. IX1054.2 +073500 MOVE 3 TO FILE-NO. IX1054.2 +073600 OPEN OUTPUT IX-FR3. IX1054.2 +073700 WRITE-TEST-GF-03. IX1054.2 +073800 PERFORM WRITE-TEST-GF-03-SHORT-REC. IX1054.2 +073900 PERFORM WRITE-TEST-GF-03-LONG-REC 15 TIMES. IX1054.2 +074000 PERFORM WRITE-TEST-GF-03-SHORT-REC 20 TIMES. IX1054.2 +074100 PERFORM WRITE-TEST-GF-03-LONG-REC 12 TIMES. IX1054.2 +074200 PERFORM WRITE-TEST-GF-03-SHORT-REC 23 TIMES. IX1054.2 +074300 PERFORM WRITE-TEST-GF-03-LONG-REC 23 TIMES. IX1054.2 +074400 PERFORM WRITE-TEST-GF-03-SHORT-REC 25 TIMES. IX1054.2 +074500 PERFORM WRITE-TEST-GF-03-LONG-REC. IX1054.2 +074600 IF THREE-POS-NUM EQUAL 120 IX1054.2 +074700 PERFORM PASS IX1054.2 +074800 MOVE "FILE IX-FR3 CREATED (120 RECORDS)" TO RE-MARK IX1054.2 +074900 GO TO WRITE-TEST-GF-03-WRITE. IX1054.2 +075000 MOVE "WRONG NUMBER OF RECORDS WRITTEN IX-41 4.9.2" TO RE-MARKIX1054.2 +075100 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +075200 WRITE-DELETE-GF-03. IX1054.2 +075300 PERFORM DE-LETE. IX1054.2 +075400* NOTE IX-FR3 IS NOT CREATED SO SKIP TO END-PARAGRAPH. IX1054.2 +075500 PERFORM PRINT-DETAIL. IX1054.2 +075600 GO TO CCVS-EXIT. IX1054.2 +075700 WRITE-TEST-GF-03-LONG-REC. IX1054.2 +075800 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +075900 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +076000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-3B. IX1054.2 +076100 WRITE GRP-1SEQ-RECORD-3B INVALID KEY IX1054.2 +076200 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +076300 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +076400 WRITE-TEST-GF-03-SHORT-REC. IX1054.2 +076500 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +076600 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +076700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-3B. IX1054.2 +076800 WRITE GRP-1SEQ-RECORD-3A INVALID KEY IX1054.2 +076900 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +077000 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +077100 WRITE-TEST-GF-03-FAIL. IX1054.2 +077200 PERFORM FAIL. IX1054.2 +077300 MOVE 120 TO CORRECT-18V0. IX1054.2 +077400 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +077500 WRITE-TEST-GF-03-WRITE. IX1054.2 +077600 MOVE SPACE TO GRP-1SEQ-RECORD-3B. IX1054.2 +077700 PERFORM PRINT-DETAIL. IX1054.2 +077800 CLOSE IX-FR3. IX1054.2 +077900 READ-INIT-F2-08. IX1054.2 +078000* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +078100* LONG RECORD. IX1054.2 +078200 MOVE "READ IX-FS3 VERIFY " TO FEATURE. IX1054.2 +078300 MOVE "READ-TEST-F2-08 " TO PAR-NAME. IX1054.2 +078400 OPEN INPUT IX-FR3. IX1054.2 +078500 MOVE 1 TO KEY-VALUE. IX1054.2 +078600 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +078700 READ-TEST-F2-08. IX1054.2 +078800 READ IX-FR3 INVALID KEY IX1054.2 +078900 PERFORM FAIL IX1054.2 +079000 MOVE "KEY00016" TO CORRECT-A IX1054.2 +079100 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +079200 MOVE "INVAILD KEY IX-FR3" TO RE-MARK IX1054.2 +079300 GO TO READ-TEST-F2-08-WRITE. IX1054.2 +079400 IF KEY-VALUE NOT EQUAL TO 16 IX1054.2 +079500 ADD 1 TO KEY-VALUE IX1054.2 +079600 MOVE KEY-BUILD TO IX-FR3-KEY IX1054.2 +079700 GO TO READ-TEST-F2-08. IX1054.2 +079800* NOTE *** IF REC-NUMBER-3B CONTAINS THE RECORD NUMBER IX1054.2 +079900* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +080000 COMPARE-FOR-TEST-F2-08. IX1054.2 +080100 IF REC-NUMBER-3B EQUAL TO "016" IX1054.2 +080200 PERFORM PASS IX1054.2 +080300 GO TO READ-TEST-F2-08-WRITE. IX1054.2 +080400 PERFORM FAIL. IX1054.2 +080500 MOVE "KEY00016" TO CORRECT-A. IX1054.2 +080600 MOVE IX-FR3-KEY TO COMPUTED-A. IX1054.2 +080700 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +080800 READ-TEST-F2-08-WRITE. IX1054.2 +080900 PERFORM PRINT-DETAIL. IX1054.2 +081000 READ-INIT-09. IX1054.2 +081100* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +081200* SHORT RECORD. IX1054.2 +081300 MOVE "READ SHORT RECORDS" TO FEATURE. IX1054.2 +081400 MOVE "READ-TEST-F2-09 " TO PAR-NAME. IX1054.2 +081500 MOVE 71 TO KEY-VALUE. IX1054.2 +081600 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +081700 READ-TEST-F2-09. IX1054.2 +081800 READ IX-FR3 INVALID KEY IX1054.2 +081900 PERFORM FAIL IX1054.2 +082000 MOVE "KEY00071" TO CORRECT-A IX1054.2 +082100 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +082200 MOVE "INVAILD KEY IX-FR3 IX-28 4.5.2" TO RE-MARK IX1054.2 +082300 GO TO READ-TEST-F2-09-WRITE. IX1054.2 +082400* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +082500* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +082600* OF VARIABLE LENGTH RECORDS. IX1054.2 +082700* NOTE CHECK LENGTH OF RECORD 71. IX1054.2 +082800 COMPARE-FOR-TEST-F2-09. IX1054.2 +082900 IF REC-NUMBER-3B EQUAL TO "071" IX1054.2 +083000 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +083100 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +083200 MOVE 1 TO SHORT-SW. IX1054.2 +083300 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +083400 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +083500 READ-TEST-F2-09-WRITE. IX1054.2 +083600 PERFORM PRINT-DETAIL. IX1054.2 +083700 READ-INIT-F2-10. IX1054.2 +083800* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +083900* LONG RECORD. IX1054.2 +084000 MOVE "READ LONG RECORDS" TO FEATURE. IX1054.2 +084100 MOVE "READ-TEST-F2-10 " TO PAR-NAME. IX1054.2 +084200 MOVE 120 TO KEY-VALUE. IX1054.2 +084300 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +084400 READ-TEST-F2-10. IX1054.2 +084500 READ IX-FR3 INVALID KEY IX1054.2 +084600 PERFORM FAIL IX1054.2 +084700 MOVE "KEY00120" TO CORRECT-A IX1054.2 +084800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +084900 MOVE "INVAILD KEY IX-FR3 IX-28 4.5.2" TO RE-MARK IX1054.2 +085000 GO TO READ-TEST-F2-10-WRITE. IX1054.2 +085100* NOTE *** IF REC-NUMBER-3B CONTAINS THE RECORD NUMBER IX1054.2 +085200* THEN LONG RECORDS WERE WITTEN. IX1054.2 +085300 COMPARE-FOR-TEST-F2-10. IX1054.2 +085400 IF REC-NUMBER-3B EQUAL TO "120" IX1054.2 +085500 PERFORM PASS IX1054.2 +085600 PERFORM READ-TEST-F2-10-WRITE IX1054.2 +085700 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A IX1054.2 +085800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK IX1054.2 +085900 IF SHORT-SW EQUAL TO ZERO IX1054.2 +086000 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +086100 GO TO READ-TEST-F2-10-WRITE IX1054.2 +086200 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A IX1054.2 +086300 GO TO READ-TEST-F2-10-WRITE. IX1054.2 +086400 PERFORM FAIL. IX1054.2 +086500 MOVE "KEY00120" TO CORRECT-A. IX1054.2 +086600 MOVE IX-FR3-KEY TO COMPUTED-A. IX1054.2 +086700 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +086800 READ-TEST-F2-10-WRITE. IX1054.2 +086900 MOVE "READ-TEST-012" TO PAR-NAME. IX1054.2 +087000 PERFORM PRINT-DETAIL. IX1054.2 +087100 READ-TEST-F2-10-EXIT. IX1054.2 +087200 CLOSE IX-FR3. IX1054.2 +087300 CCVS-EXIT SECTION. IX1054.2 +087400 CCVS-999999. IX1054.2 +087500 GO TO CLOSE-FILES. IX1054.2 +*END-OF,IX105A +*HEADER,COBOL,IX106A +000100 IDENTIFICATION DIVISION. IX1064.2 +000200 PROGRAM-ID. IX1064.2 +000300 IX106A. IX1064.2 +000400**************************************************************** IX1064.2 +000500* * IX1064.2 +000600* VALIDATION FOR:- * IX1064.2 +000700* * IX1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +000900* * IX1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1064.2 +001100* * IX1064.2 +001200**************************************************************** IX1064.2 +001300* THE PURPOSE OF THIS PROGRAM IS TO TEST THE ABILITY TO IX1064.2 +001400* USE THE THREE DIFFERENT TYPES OF FILES (SEQUENTIAL , IX1064.2 +001500* INDEXED , AND RELATIVE) IN ONE PROGRAM . THE PROGRAM IX1064.2 +001600* IS BROKEN INTO FIVE SECTIONS . THE FIRST SECTION TESTS IX1064.2 +001700* THE ABILITY TO CREATE A RELATIVE FILE RANDOMLY . THE IX1064.2 +001800* SECOND SECTION TESTS THE ABILITY TO USE ALL THREE FILE IX1064.2 +001900* TYPES , READING IN THE RELATIVE FILE AND WRITING OUT THE IX1064.2 +002000* SEQUENTIAL AND INDEXED FILES . THE THIRD SECTION FURTHER IX1064.2 +002100* TESTS THE ABILITY TO USE THE THREE FILE TYPES . THE FOURTH IX1064.2 +002200* SECTION TESTS THE ABILITY TO DELETE RECORDS FROM THE IX1064.2 +002300* DIFFERENT FILE TYPES . THE FIFTH SECTION TESTS THE ABILITY IX1064.2 +002400* TO REWRITE RECORDS TO EACH OF THE FILE TYPES . IX1064.2 +002500* IX1064.2 +002600* X-CARDS WHICH MUST BE RELACED WITH IMPLEMENTORS NAMES' IN IX1064.2 +002700* THIS PROGRAM ARE : IX1064.2 +002800* IX1064.2 +002900* X-14 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003000* SEQUENTIAL FILE . IX1064.2 +003100* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003200* RELATIVE FILE-1 , FILE-2 . IX1064.2 +003300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003400* INDEXED FILE . IX1064.2 +003500* X-44 SYSTEM-NAME IN ASSIGN CLAUSE FOR IX1064.2 +003600* INDEXED FILE . IX1064.2 +003700* X-55 SYSTEM PRINTER . IX1064.2 +003800* X-62 FOR RAW-DATA IX1064.2 +003900* X-82 SOURCE-COMPUTER . IX1064.2 +004000* X-83 OBJECT-COMPUTER . IX1064.2 +004100* C X-84 PRINTE-FILE LABELS IX1064.2 +004200**************************************************************** IX1064.2 +004300 ENVIRONMENT DIVISION. IX1064.2 +004400 CONFIGURATION SECTION. IX1064.2 +004500 SOURCE-COMPUTER. IX1064.2 +004600 XXXXX082. IX1064.2 +004700 OBJECT-COMPUTER. IX1064.2 +004800 XXXXX083. IX1064.2 +004900 INPUT-OUTPUT SECTION. IX1064.2 +005000 FILE-CONTROL. IX1064.2 +005100P SELECT RAW-DATA ASSIGN TO IX1064.2 +005200P XXXXX062 IX1064.2 +005300P ORGANIZATION IS INDEXED IX1064.2 +005400P ACCESS MODE IS RANDOM IX1064.2 +005500P RECORD KEY IS RAW-DATA-KEY. IX1064.2 +005600 SELECT PRINT-FILE ASSIGN TO IX1064.2 +005700 XXXXX055. IX1064.2 +005800 SELECT RL-FR1 IX1064.2 +005900 ASSIGN TO IX1064.2 +006000 XXXXX021 IX1064.2 +006100 ACCESS MODE IS RANDOM IX1064.2 +006200 RELATIVE KEY IS RL-KEY IX1064.2 +006300 ORGANIZATION IS RELATIVE IX1064.2 +006400 FILE STATUS IS FR1-STATUS. IX1064.2 +006500 SELECT IX-FS1 IX1064.2 +006600 ASSIGN TO IX1064.2 +006700 XXXXX024 IX1064.2 +006800J XXXXX044 IX1064.2 +006900 ACCESS MODE IS RANDOM IX1064.2 +007000 ORGANIZATION IS INDEXED IX1064.2 +007100 RECORD KEY IS IX-FS1-KEY-11-13 IX1064.2 +007200 FILE STATUS IS FS1-STATUS-IX. IX1064.2 +007300 SELECT SQ-FS1 IX1064.2 +007400 ASSIGN TO IX1064.2 +007500 XXXXX014 IX1064.2 +007600 ACCESS MODE IS SEQUENTIAL IX1064.2 +007700 ORGANIZATION IS SEQUENTIAL IX1064.2 +007800 FILE STATUS IS FS1-STATUS-SQ. IX1064.2 +007900 DATA DIVISION. IX1064.2 +008000 FILE SECTION. IX1064.2 +008100P IX1064.2 +008200PFD RAW-DATA. IX1064.2 +008300P IX1064.2 +008400P01 RAW-DATA-SATZ. IX1064.2 +008500P 05 RAW-DATA-KEY PIC X(6). IX1064.2 +008600P 05 C-DATE PIC 9(6). IX1064.2 +008700P 05 C-TIME PIC 9(8). IX1064.2 +008800P 05 C-NO-OF-TESTS PIC 99. IX1064.2 +008900P 05 C-OK PIC 999. IX1064.2 +009000P 05 C-ALL PIC 999. IX1064.2 +009100P 05 C-FAIL PIC 999. IX1064.2 +009200P 05 C-DELETED PIC 999. IX1064.2 +009300P 05 C-INSPECT PIC 999. IX1064.2 +009400P 05 C-NOTE PIC X(13). IX1064.2 +009500P 05 C-INDENT PIC X. IX1064.2 +009600P 05 C-ABORT PIC X(8). IX1064.2 +009700 FD PRINT-FILE. IX1064.2 +009800 01 PRINT-REC PICTURE X(120). IX1064.2 +009900 01 DUMMY-RECORD PICTURE X(120). IX1064.2 +010000 FD RL-FR1 IX1064.2 +010100C LABEL RECORDS ARE STANDARD IX1064.2 +010200C DATA RECORD IS RL-FR1R1-F-G-241 IX1064.2 +010300 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +010400 01 RL-FR1R1-F-G-241. IX1064.2 +010500 05 RL-FR1-REC-120 PICTURE X(120). IX1064.2 +010600 05 RL-FR1-REC-121-241. IX1064.2 +010700 10 FILLER PICTURE X(8). IX1064.2 +010800 10 RL-REC-KEY-AREA. IX1064.2 +010900 15 RL-FR1-KEY. IX1064.2 +011000 20 RL-FR1-KEY-1-10. IX1064.2 +011100 25 RL-FR1-KEY-1-5 PICTURE X(5). IX1064.2 +011200 25 RL-FR1-KEY-6-10 PICTURE X(5). IX1064.2 +011300 20 RL-FR1-KEY-11-13 PICTURE 9(3). IX1064.2 +011400 15 RL-REDF-RECKEY REDEFINES RL-FR1-KEY. IX1064.2 +011500 20 R-RECKEY-1-7 PICTURE X(7). IX1064.2 +011600 20 R-RECKEY-8-13 PICTURE X(6). IX1064.2 +011700 15 FILLER PICTURE X(16). IX1064.2 +011800 10 FILLER PICTURE X(9). IX1064.2 +011900 10 RL-ALT-KEY1-AREA. IX1064.2 +012000 15 RL-FR1-ALTKEY1. IX1064.2 +012100 20 RL-FR1-ALTKEY1-1-10. IX1064.2 +012200 25 RL-FR1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +012300 25 RL-FR1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +012400 20 RL-FR1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +012500 20 RL-FR1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +012600 15 RL-REDF-ALTKEY1 REDEFINES RL-FR1-ALTKEY1. IX1064.2 +012700 20 R-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +012800 20 R-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +012900 20 R-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +013000 15 FILLER PICTURE X(9). IX1064.2 +013100 10 FILLER PICTURE X(9). IX1064.2 +013200 10 RL-ALT-KEY2-AREA. IX1064.2 +013300 15 RL-FR1-ALTKEY2. IX1064.2 +013400 20 RL-FR1-ALTKEY2-1-10. IX1064.2 +013500 25 RL-FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +013600 25 RL-FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +013700 20 RL-FR1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +013800 20 RL-FR1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +013900 15 FILLER PICTURE X(9). IX1064.2 +014000 10 FILLER PICTURE X(8). IX1064.2 +014100 FD IX-FS1 IX1064.2 +014200C LABEL RECORDS ARE STANDARD IX1064.2 +014300C DATA RECORD IS IX-FS1R1-F-G-241 IX1064.2 +014400 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +014500 01 IX-FS1R1-F-G-241. IX1064.2 +014600 05 IX-FS1-REC-120 PICTURE X(120). IX1064.2 +014700 05 IX-FS1-REC-121-241. IX1064.2 +014800 10 FILLER PICTURE X(8). IX1064.2 +014900 10 IX-REC-KEY-AREA. IX1064.2 +015000 15 IX-FS1-KEY. IX1064.2 +015100 20 IX-FS1-KEY-1-10. IX1064.2 +015200 25 IX-FS1-KEY-1-5 PICTURE X(5). IX1064.2 +015300 25 IX-FS1-KEY-6-10 PICTURE X(5). IX1064.2 +015400 20 IX-FS1-KEY-11-13 PICTURE X(3). IX1064.2 +015500 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX1064.2 +015600 20 I-RECKEY-1-7 PICTURE X(7). IX1064.2 +015700 20 I-RECKEY-8-13 PICTURE X(6). IX1064.2 +015800 15 FILLER PICTURE X(16). IX1064.2 +015900 10 FILLER PICTURE X(9). IX1064.2 +016000 10 IX-ALT-KEY1-AREA. IX1064.2 +016100 15 IX-FS1-ALTKEY1. IX1064.2 +016200 20 IX-FS1-ALTKEY1-1-10. IX1064.2 +016300 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +016400 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +016500 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +016600 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +016700 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX1064.2 +016800 20 I-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +016900 20 I-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +017000 20 I-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +017100 15 FILLER PICTURE X(9). IX1064.2 +017200 10 FILLER PICTURE X(9). IX1064.2 +017300 10 IX-ALT-KEY2-AREA. IX1064.2 +017400 15 IX-FS1-ALTKEY2. IX1064.2 +017500 20 IX-FS1-ALTKEY2-1-10. IX1064.2 +017600 25 IX-FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +017700 25 IX-FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +017800 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +017900 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +018000 15 FILLER PICTURE X(9). IX1064.2 +018100 10 FILLER PICTURE X(8). IX1064.2 +018200 FD SQ-FS1 IX1064.2 +018300C LABEL RECORDS ARE STANDARD IX1064.2 +018400C DATA RECORD IS SQ-FS1R1-F-G-241 IX1064.2 +018500 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +018600 01 SQ-FS1R1-F-G-241. IX1064.2 +018700 05 SQ-FS1-REC-120 PICTURE X(120). IX1064.2 +018800 05 SQ-FS1-REC-121-241. IX1064.2 +018900 10 FILLER PICTURE X(8). IX1064.2 +019000 10 SQ-REC-KEY-AREA. IX1064.2 +019100 15 SQ-FS1-KEY. IX1064.2 +019200 20 SQ-FS1-KEY-1-10. IX1064.2 +019300 25 SQ-FS1-KEY-1-5 PICTURE X(5). IX1064.2 +019400 25 SQ-FS1-KEY-6-10 PICTURE X(5). IX1064.2 +019500 20 SQ-FS1-KEY-11-13 PICTURE 9(3). IX1064.2 +019600 15 SQ-REDF-RECKEY REDEFINES SQ-FS1-KEY. IX1064.2 +019700 20 S-RECKEY-1-7 PICTURE X(7). IX1064.2 +019800 20 S-RECKEY-8-13 PICTURE X(6). IX1064.2 +019900 15 FILLER PICTURE X(16). IX1064.2 +020000 10 FILLER PICTURE X(9). IX1064.2 +020100 10 SQ-ALT-KEY1-AREA. IX1064.2 +020200 15 SQ-FS1-ALTKEY1. IX1064.2 +020300 20 SQ-FS1-ALTKEY1-1-10. IX1064.2 +020400 25 SQ-FS1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +020500 25 SQ-FS1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +020600 20 SQ-FS1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +020700 20 SQ-FS1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +020800 15 SQ-REDF-ALTKEY1 REDEFINES SQ-FS1-ALTKEY1. IX1064.2 +020900 20 S-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +021000 20 S-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +021100 20 S-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +021200 15 FILLER PICTURE X(9). IX1064.2 +021300 10 FILLER PICTURE X(9). IX1064.2 +021400 10 SQ-ALT-KEY2-AREA. IX1064.2 +021500 15 SQ-FS1-ALTKEY2. IX1064.2 +021600 20 SQ-FS1-ALTKEY2-1-10. IX1064.2 +021700 25 SQ-FS1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +021800 25 SQ-FS1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +021900 20 SQ-FS1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +022000 20 SQ-FS1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +022100 15 FILLER PICTURE X(9). IX1064.2 +022200 10 FILLER PICTURE X(8). IX1064.2 +022300 WORKING-STORAGE SECTION. IX1064.2 +022400 01 WRK-DS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022500 01 WRK-DS-09V00-002 PIC 9(3) VALUE ZERO. IX1064.2 +022600 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022700 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022800 01 RL-KEY PIC 9(3). IX1064.2 +022900 01 RL-KEY2 PIC 9(3). IX1064.2 +023000* IX1064.2 +023100 01 WRK-FR1-RECKEY. IX1064.2 +023200 05 FR1-RECKEY-1-13. IX1064.2 +023300 10 FR1-RECKEY-1-10 PICTURE X(10). IX1064.2 +023400 10 FR1-RECKEY-11-13 PICTURE 9(3). IX1064.2 +023500 05 FILLER PICTURE X(16) VALUE SPACE. IX1064.2 +023600 01 WRK-FR1-ALTKEY1. IX1064.2 +023700 05 FR1-ALTKEY1-1-20. IX1064.2 +023800 10 FR1-ALTKEY1-1-10. IX1064.2 +023900 15 FR1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +024000 15 FR1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +024100 10 FR1-ALTKEY1-11-13 PICTURE 9(3). IX1064.2 +024200 10 FR1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +024300 05 FILLER PICTURE X(9) VALUE SPACE. IX1064.2 +024400 01 WRK-FR1-ALTKEY2. IX1064.2 +024500 05 FR1-ALTKEY2-1-20. IX1064.2 +024600 10 FR1-ALTKEY2-1-10. IX1064.2 +024700 15 FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +024800 15 FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +024900 10 FR1-ALTKEY2-11-13 PICTURE 9(3). IX1064.2 +025000 10 FR1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +025100 05 FILLER PICTURE X(9) VALUE SPACE. IX1064.2 +025200 01 RECNO PICTURE 9(5) VALUE ZERO. IX1064.2 +025300 01 FR1-STATUS PICTURE XX VALUE SPACE. IX1064.2 +025400 01 FS1-STATUS-IX PIC XX VALUE SPACE. IX1064.2 +025500 01 FS1-STATUS-SQ PIC XX VALUE SPACE. IX1064.2 +025600 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX1064.2 +025700 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX1064.2 +025800 01 INVKEY-COUNTER-RL PICTURE 9(3) COMPUTATIONAL. IX1064.2 +025900 01 INVKEY-COUNTER-IX PICTURE 9(3) COMPUTATIONAL. IX1064.2 +026000 01 RECORDS-WRITTEN PICTURE 9(3). IX1064.2 +026100 01 RECKEY-NUM PICTURE 9(3). IX1064.2 +026200 01 ALTKEY1-NUM PICTURE 9(3). IX1064.2 +026300 01 ALTKEY2-NUM PICTURE 9(3). IX1064.2 +026400 01 RECORD-KEY-CONTENT. IX1064.2 +026500 05 FILLER PIC X(53) VALUE IX1064.2 +026600 "BBBBBBBBBC225EEEEEEEEEF001ALTKEY1WWWWWWWWWV076ALTKEY2".IX1064.2 +026700 05 FILLER PIC X(53) VALUE IX1064.2 +026800 "BBBBBBBBCC224EEEEEEEEFF002ALTKEY1WWWWWWWWVV077ALTKEY2".IX1064.2 +026900 05 FILLER PIC X(53) VALUE IX1064.2 +027000 "BBBBBBBCCC223EEEEEEEFFF003ALTKEY1WWWWWWWVVV078ALTKEY2".IX1064.2 +027100 05 FILLER PIC X(53) VALUE IX1064.2 +027200 "BBBBBBCCCC222EEEEEEFFFF004ALTKEY1WWWWWWVVVV079ALTKEY2".IX1064.2 +027300 05 FILLER PIC X(53) VALUE IX1064.2 +027400 "BBBBBCCCCC221EEEEEFFFFF005ALTKEY1WWWWWVVVVV080ALTKEY2".IX1064.2 +027500 05 FILLER PIC X(53) VALUE IX1064.2 +027600 "BBBBCCCCCC220EEEEFFFFFF006ALTKEY1WWWWVVVVVV081ALTKEY2".IX1064.2 +027700 05 FILLER PIC X(53) VALUE IX1064.2 +027800 "BBBCCCCCCC219EEEFFFFFFF007ALTKEY1WWWVVVVVVV082ALTKEY2".IX1064.2 +027900 05 FILLER PIC X(53) VALUE IX1064.2 +028000 "BBCCCCCCCC218EEFFFFFFFF008ALTKEY1WWVVVVVVVV083ALTKEY2".IX1064.2 +028100 05 FILLER PIC X(53) VALUE IX1064.2 +028200 "BCCCCCCCCC217EFFFFFFFFF009ALTKEY1WVVVVVVVVV084ALTKEY2".IX1064.2 +028300 05 FILLER PIC X(53) VALUE IX1064.2 +028400 "CCCCCCCCCC216FFFFFFFFFF010ALTKEY1VVVVVVVVVV085ALTKEY2".IX1064.2 +028500 05 FILLER PIC X(53) VALUE IX1064.2 +028600 "CCCCCCCCCD215FFFFFFFFFG011ALTKEY1VVVVVVVVVV086ALTKEY2".IX1064.2 +028700 05 FILLER PIC X(53) VALUE IX1064.2 +028800 "CCCCCCCCDD214FFFFFFFFGG012ALTKEY1VVVVVVVVUU087ALTKEY2".IX1064.2 +028900 05 FILLER PIC X(53) VALUE IX1064.2 +029000 "CCCCCCCDDD213FFFFFFFGGG013ALTKEY1VVVVVVVUUU088ALTKEY2".IX1064.2 +029100 05 FILLER PIC X(53) VALUE IX1064.2 +029200 "CCCCCCDDDD212FFFFFFGGGG014ALTKEY1VVVVVVUUUU089ALTKEY2".IX1064.2 +029300 05 FILLER PIC X(53) VALUE IX1064.2 +029400 "CCCCCDDDDD211FFFFFGGGGG015ALTKEY1VVVVVUUUUU090ALTKEY2".IX1064.2 +029500 05 FILLER PIC X(53) VALUE IX1064.2 +029600 "CCCCDDDDDD210FFFFGGGGGG016ALTKEY1VVVVUUUUUU091ALTKEY2".IX1064.2 +029700 05 FILLER PIC X(53) VALUE IX1064.2 +029800 "CCCDDDDDDD209FFFGGGGGGG017ALTKEY1VVVUUUUUUU092ALTKEY2".IX1064.2 +029900 05 FILLER PIC X(53) VALUE IX1064.2 +030000 "CCDDDDDDDD208FFGGGGGGGG018ALTKEY1VVUUUUUUUU093ALTKEY2".IX1064.2 +030100 05 FILLER PIC X(53) VALUE IX1064.2 +030200 "CDDDDDDDDD207FGGGGGGGGG019ALTKEY1VUUUUUUUUU094ALTKEY2".IX1064.2 +030300 05 FILLER PIC X(53) VALUE IX1064.2 +030400 "DDDDDDDDDD206GGGGGGGGGG020ALTKEY1UUUUUUUUUU095ALTKEY2".IX1064.2 +030500 05 FILLER PIC X(53) VALUE IX1064.2 +030600 "DDDDDDDDDE205GGGGGGGGGH021ALTKEY1UUUUUUUUUU096ALTKEY2".IX1064.2 +030700 05 FILLER PIC X(53) VALUE IX1064.2 +030800 "DDDDDDDDEE204GGGGGGGGHH022ALTKEY1UUUUUUUUTT097ALTKEY2".IX1064.2 +030900 05 FILLER PIC X(53) VALUE IX1064.2 +031000 "DDDDDDDEEE203GGGGGGGHHH023ALTKEY1UUUUUUUTTT098ALTKEY2".IX1064.2 +031100 05 FILLER PIC X(53) VALUE IX1064.2 +031200 "DDDDDDEEEE202GGGGGGHHHH024ALTKEY1UUUUUUTTTT099ALTKEY2".IX1064.2 +031300 05 FILLER PIC X(53) VALUE IX1064.2 +031400 "DDDDDEEEEE201GGGGGHHHHH025ALTKEY1UUUUUTTTTT100ALTKEY2".IX1064.2 +031500 05 FILLER PIC X(53) VALUE IX1064.2 +031600 "DDDDEEEEEE200GGGGHHHHHH026ALTKEY1UUUUTTTTTT101ALTKEY2".IX1064.2 +031700 05 FILLER PIC X(53) VALUE IX1064.2 +031800 "DDDEEEEEEE199GGGHHHHHHH027ALTKEY1UUUTTTTTTT102ALTKEY2".IX1064.2 +031900 05 FILLER PIC X(53) VALUE IX1064.2 +032000 "DDEEEEEEEE198GGHHHHHHHH028ALTKEY1UUTTTTTTTT103ALTKEY2".IX1064.2 +032100 05 FILLER PIC X(53) VALUE IX1064.2 +032200 "DEEEEEEEEE197GHHHHHHHHH029ALTKEY1UTTTTTTTTT104ALTKEY2".IX1064.2 +032300 05 FILLER PIC X(53) VALUE IX1064.2 +032400 "EEEEEEEEEE196HHHHHHHHHH030ALTKEY1TTTTTTTTTT105ALTKEY2".IX1064.2 +032500 05 FILLER PIC X(53) VALUE IX1064.2 +032600 "EEEEEEEEEF195HHHHHHHHHI031ALTKEY1TTTTTTTTTT106ALTKEY2".IX1064.2 +032700 05 FILLER PIC X(53) VALUE IX1064.2 +032800 "EEEEEEEEFF194HHHHHHHHII032ALTKEY1TTTTTTTTSS107ALTKEY2".IX1064.2 +032900 05 FILLER PIC X(53) VALUE IX1064.2 +033000 "EEEEEEEFFF193HHHHHHHIII033ALTKEY1TTTTTTTSSS108ALTKEY2".IX1064.2 +033100 05 FILLER PIC X(53) VALUE IX1064.2 +033200 "EEEEEEFFFF192HHHHHHIIII034ALTKEY1TTTTTTSSSS109ALTKEY2".IX1064.2 +033300 05 FILLER PIC X(53) VALUE IX1064.2 +033400 "EEEEEFFFFF191HHHHHIIIII035ALTKEY1TTTTTSSSSS110ALTKEY2".IX1064.2 +033500 05 FILLER PIC X(53) VALUE IX1064.2 +033600 "EEEEFFFFFF190HHHHIIIIII036ALTKEY1TTTTSSSSSS111ALTKEY2".IX1064.2 +033700 05 FILLER PIC X(53) VALUE IX1064.2 +033800 "EEEFFFFFFF189HHHIIIIIII037ALTKEY1TTTSSSSSSS112ALTKEY2".IX1064.2 +033900 05 FILLER PIC X(53) VALUE IX1064.2 +034000 "EEFFFFFFFF188HHIIIIIIII038ALTKEY1TTSSSSSSSS113ALTKEY2".IX1064.2 +034100 05 FILLER PIC X(53) VALUE IX1064.2 +034200 "EFFFFFFFFF187HIIIIIIIII039ALTKEY1TSSSSSSSSS114ALTKEY2".IX1064.2 +034300 05 FILLER PIC X(53) VALUE IX1064.2 +034400 "FFFFFFFFFF186IIIIIIIIII040ALTKEY1SSSSSSSSSS115ALTKEY2".IX1064.2 +034500 05 FILLER PIC X(53) VALUE IX1064.2 +034600 "FFFFFFFFFG185IIIIIIIIIJ041ALTKEY1SSSSSSSSSS116ALTKEY2".IX1064.2 +034700 05 FILLER PIC X(53) VALUE IX1064.2 +034800 "FFFFFFFFGG184IIIIIIIIJJ042ALTKEY1SSSSSSSSRR117ALTKEY2".IX1064.2 +034900 05 FILLER PIC X(53) VALUE IX1064.2 +035000 "FFFFFFFGGG183IIIIIIIJJJ043ALTKEY1SSSSSSSRRR118ALTKEY2".IX1064.2 +035100 05 FILLER PIC X(53) VALUE IX1064.2 +035200 "FFFFFFGGGG182IIIIIIJJJJ044ALTKEY1SSSSSSRRRR119ALTKEY2".IX1064.2 +035300 05 FILLER PIC X(53) VALUE IX1064.2 +035400 "FFFFFGGGGG181IIIIIJJJJJ045ALTKEY1SSSSSRRRRR120ALTKEY2".IX1064.2 +035500 05 FILLER PIC X(53) VALUE IX1064.2 +035600 "FFFFGGGGGG180IIIIJJJJJJ046ALTKEY1SSSSRRRRRR121ALTKEY2".IX1064.2 +035700 05 FILLER PIC X(53) VALUE IX1064.2 +035800 "FFFGGGGGGG179IIIJJJJJJJ047ALTKEY1SSSRRRRRRR122ALTKEY2".IX1064.2 +035900 05 FILLER PIC X(53) VALUE IX1064.2 +036000 "FFGGGGGGGG178IIJJJJJJJJ048ALTKEY1SSRRRRRRRR123ALTKEY2".IX1064.2 +036100 05 FILLER PIC X(53) VALUE IX1064.2 +036200 "FGGGGGGGGG177IJJJJJJJJJ049ALTKEY1SRRRRRRRRR124ALTKEY2".IX1064.2 +036300 05 FILLER PIC X(53) VALUE IX1064.2 +036400 "GGGGGGGGGG176JJJJJJJJJJ050ALTKEY1RRRRRRRRRR125ALTKEY2".IX1064.2 +036500 05 FILLER PIC X(53) VALUE IX1064.2 +036600 "RRRRSSSSSS175VVVVWWWWWW051ALTKEY1GGGGFFFFFF126ALTKEY2".IX1064.2 +036700 05 FILLER PIC X(53) VALUE IX1064.2 +036800 "RRRSSSSSSS174VVVWWWWWWW052ALTKEY1GGGFFFFFFF127ALTKEY2".IX1064.2 +036900 05 FILLER PIC X(53) VALUE IX1064.2 +037000 "RRSSSSSSSS173VVWWWWWWWW053ALTKEY1GGFFFFFFFF128ALTKEY2".IX1064.2 +037100 05 FILLER PIC X(53) VALUE IX1064.2 +037200 "RSSSSSSSSS172VWWWWWWWWW054ALTKEY1GFFFFFFFFF129ALTKEY2".IX1064.2 +037300 05 FILLER PIC X(53) VALUE IX1064.2 +037400 "SSSSSSSSSS171WWWWWWWWWW055ALTKEY1FFFFFFFFFF130ALTKEY2".IX1064.2 +037500 05 FILLER PIC X(53) VALUE IX1064.2 +037600 "SSSSSSSSST170WWWWWWWWWX056ALTKEY1FFFFFFFFFF131ALTKEY2".IX1064.2 +037700 05 FILLER PIC X(53) VALUE IX1064.2 +037800 "SSSSSSSSTT169WWWWWWWWXX057ALTKEY1FFFFFFFFEE132ALTKEY2".IX1064.2 +037900 05 FILLER PIC X(53) VALUE IX1064.2 +038000 "SSSSSSSTTT168WWWWWWWXXX058ALTKEY1FFFFFFFEEE133ALTKEY2".IX1064.2 +038100 05 FILLER PIC X(53) VALUE IX1064.2 +038200 "SSSSSSTTTT167WWWWWWXXXX059ALTKEY1FFFFFFEEEE134ALTKEY2".IX1064.2 +038300 05 FILLER PIC X(53) VALUE IX1064.2 +038400 "SSSSSTTTTT166WWWWWXXXXX060ALTKEY1FFFFFEEEEE135ALTKEY2".IX1064.2 +038500 05 FILLER PIC X(53) VALUE IX1064.2 +038600 "SSSSTTTTTT165WWWWXXXXXX061ALTKEY1FFFFEEEEEE136ALTKEY2".IX1064.2 +038700 05 FILLER PIC X(53) VALUE IX1064.2 +038800 "SSSTTTTTTT164WWWXXXXXXX062ALTKEY1FFFEEEEEEE137ALTKEY2".IX1064.2 +038900 05 FILLER PIC X(53) VALUE IX1064.2 +039000 "SSTTTTTTTT163WWXXXXXXXX063ALTKEY1FFEEEEEEEE138ALTKEY2".IX1064.2 +039100 05 FILLER PIC X(53) VALUE IX1064.2 +039200 "STTTTTTTTT162WXXXXXXXXX064ALTKEY1FEEEEEEEEE139ALTKEY2".IX1064.2 +039300 05 FILLER PIC X(53) VALUE IX1064.2 +039400 "TTTTTTTTTT161XXXXXXXXXX065ALTKEY1EEEEEEEEEE140ALTKEY2".IX1064.2 +039500 05 FILLER PIC X(53) VALUE IX1064.2 +039600 "TTTTTTTTTU160XXXXXXXXXY066ALTKEY1EEEEEEEEEE141ALTKEY2".IX1064.2 +039700 05 FILLER PIC X(53) VALUE IX1064.2 +039800 "TTTTTTTTUU159XXXXXXXXYY067ALTKEY1EEEEEEEEDD142ALTKEY2".IX1064.2 +039900 05 FILLER PIC X(53) VALUE IX1064.2 +040000 "TTTTTTTUUU158XXXXXXXYYY068ALTKEY1EEEEEEEDDD143ALTKEY2".IX1064.2 +040100 05 FILLER PIC X(53) VALUE IX1064.2 +040200 "TTTTTTUUUU157XXXXXXYYYY069ALTKEY1EEEEEEDDDD144ALTKEY2".IX1064.2 +040300 05 FILLER PIC X(53) VALUE IX1064.2 +040400 "TTTTTUUUUU156XXXXXYYYYY070ALTKEY1EEEEEDDDDD145ALTKEY2".IX1064.2 +040500 05 FILLER PIC X(53) VALUE IX1064.2 +040600 "TTTTUUUUUU155XXXXYYYYYY071ALTKEY1EEEEDDDDDD146ALTKEY2".IX1064.2 +040700 05 FILLER PIC X(53) VALUE IX1064.2 +040800 "TTTUUUUUUU154XXXYYYYYYY072ALTKEY1EEEDDDDDDD147ALTKEY2".IX1064.2 +040900 05 FILLER PIC X(53) VALUE IX1064.2 +041000 "TTUUUUUUUU153XXYYYYYYYY073ALTKEY1EEDDDDDDDD148ALTKEY2".IX1064.2 +041100 05 FILLER PIC X(53) VALUE IX1064.2 +041200 "TUUUUUUUUU152XYYYYYYYYY074ALTKEY1EDDDDDDDDD149ALTKEY2".IX1064.2 +041300 05 FILLER PIC X(53) VALUE IX1064.2 +041400 "UUUUUUUUUU151YYYYYYYYYY075ALTKEY1DDDDDDDDDD150ALTKEY2".IX1064.2 +041500 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX1064.2 +041600 05 KEY-VALUES OCCURS 75 TIMES. IX1064.2 +041700 10 RECKEY-VALUE PICTURE X(13). IX1064.2 +041800 10 ALTKEY1-VALUE PICTURE X(20). IX1064.2 +041900 10 ALTKEY2-VALUE PICTURE X(20). IX1064.2 +042000 01 INIT-FLAG PICTURE 9. IX1064.2 +042100 01 HOLD-FILESTATUS-RECORD. IX1064.2 +042200 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX1064.2 +042300 IX1064.2 +042400 01 FILE-RECORD-INFORMATION-REC. IX1064.2 +042500 03 FILE-RECORD-INFO-SKELETON. IX1064.2 +042600 05 FILLER PICTURE X(48) VALUE IX1064.2 +042700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1064.2 +042800 05 FILLER PICTURE X(46) VALUE IX1064.2 +042900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1064.2 +043000 05 FILLER PICTURE X(26) VALUE IX1064.2 +043100 ",LFIL=000000,ORG= ,LBLR= ". IX1064.2 +043200 05 FILLER PICTURE X(37) VALUE IX1064.2 +043300 ",RECKEY= ". IX1064.2 +043400 05 FILLER PICTURE X(38) VALUE IX1064.2 +043500 ",ALTKEY1= ". IX1064.2 +043600 05 FILLER PICTURE X(38) VALUE IX1064.2 +043700 ",ALTKEY2= ". IX1064.2 +043800 05 FILLER PICTURE X(7) VALUE SPACE.IX1064.2 +043900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1064.2 +044000 05 FILE-RECORD-INFO-P1-120. IX1064.2 +044100 07 FILLER PIC X(5). IX1064.2 +044200 07 XFILE-NAME PIC X(6). IX1064.2 +044300 07 FILLER PIC X(8). IX1064.2 +044400 07 XRECORD-NAME PIC X(6). IX1064.2 +044500 07 FILLER PIC X(1). IX1064.2 +044600 07 REELUNIT-NUMBER PIC 9(1). IX1064.2 +044700 07 FILLER PIC X(7). IX1064.2 +044800 07 XRECORD-NUMBER PIC 9(6). IX1064.2 +044900 07 FILLER PIC X(6). IX1064.2 +045000 07 UPDATE-NUMBER PIC 9(2). IX1064.2 +045100 07 FILLER PIC X(5). IX1064.2 +045200 07 ODO-NUMBER PIC 9(4). IX1064.2 +045300 07 FILLER PIC X(5). IX1064.2 +045400 07 XPROGRAM-NAME PIC X(5). IX1064.2 +045500 07 FILLER PIC X(7). IX1064.2 +045600 07 XRECORD-LENGTH PIC 9(6). IX1064.2 +045700 07 FILLER PIC X(7). IX1064.2 +045800 07 CHARS-OR-RECORDS PIC X(2). IX1064.2 +045900 07 FILLER PIC X(1). IX1064.2 +046000 07 XBLOCK-SIZE PIC 9(4). IX1064.2 +046100 07 FILLER PIC X(6). IX1064.2 +046200 07 RECORDS-IN-FILE PIC 9(6). IX1064.2 +046300 07 FILLER PIC X(5). IX1064.2 +046400 07 XFILE-ORGANIZATION PIC X(2). IX1064.2 +046500 07 FILLER PIC X(6). IX1064.2 +046600 07 XLABEL-TYPE PIC X(1). IX1064.2 +046700 05 FILE-RECORD-INFO-P121-240. IX1064.2 +046800 07 FILLER PIC X(8). IX1064.2 +046900 07 XRECORD-KEY PIC X(29). IX1064.2 +047000 07 FILLER PIC X(9). IX1064.2 +047100 07 ALTERNATE-KEY1 PIC X(29). IX1064.2 +047200 07 FILLER PIC X(9). IX1064.2 +047300 07 ALTERNATE-KEY2 PIC X(29). IX1064.2 +047400 07 FILLER PIC X(7). IX1064.2 +047500 IX1064.2 +047600 01 TEST-RESULTS. IX1064.2 +047700 02 FILLER PIC X VALUE SPACE. IX1064.2 +047800 02 FEATURE PIC X(20) VALUE SPACE. IX1064.2 +047900 02 FILLER PIC X VALUE SPACE. IX1064.2 +048000 02 P-OR-F PIC X(5) VALUE SPACE. IX1064.2 +048100 02 FILLER PIC X VALUE SPACE. IX1064.2 +048200 02 PAR-NAME. IX1064.2 +048300 03 FILLER PIC X(19) VALUE SPACE. IX1064.2 +048400 03 PARDOT-X PIC X VALUE SPACE. IX1064.2 +048500 03 DOTVALUE PIC 99 VALUE ZERO. IX1064.2 +048600 02 FILLER PIC X(8) VALUE SPACE. IX1064.2 +048700 02 RE-MARK PIC X(61). IX1064.2 +048800 01 TEST-COMPUTED. IX1064.2 +048900 02 FILLER PIC X(30) VALUE SPACE. IX1064.2 +049000 02 FILLER PIC X(17) VALUE IX1064.2 +049100 " COMPUTED=". IX1064.2 +049200 02 COMPUTED-X. IX1064.2 +049300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1064.2 +049400 03 COMPUTED-N REDEFINES COMPUTED-A IX1064.2 +049500 PIC -9(9).9(9). IX1064.2 +049600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1064.2 +049700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1064.2 +049800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1064.2 +049900 03 CM-18V0 REDEFINES COMPUTED-A. IX1064.2 +050000 04 COMPUTED-18V0 PIC -9(18). IX1064.2 +050100 04 FILLER PIC X. IX1064.2 +050200 03 FILLER PIC X(50) VALUE SPACE. IX1064.2 +050300 01 TEST-CORRECT. IX1064.2 +050400 02 FILLER PIC X(30) VALUE SPACE. IX1064.2 +050500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1064.2 +050600 02 CORRECT-X. IX1064.2 +050700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1064.2 +050800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1064.2 +050900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1064.2 +051000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1064.2 +051100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1064.2 +051200 03 CR-18V0 REDEFINES CORRECT-A. IX1064.2 +051300 04 CORRECT-18V0 PIC -9(18). IX1064.2 +051400 04 FILLER PIC X. IX1064.2 +051500 03 FILLER PIC X(2) VALUE SPACE. IX1064.2 +051600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1064.2 +051700 01 CCVS-C-1. IX1064.2 +051800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1064.2 +051900- "SS PARAGRAPH-NAME IX1064.2 +052000- " REMARKS". IX1064.2 +052100 02 FILLER PIC X(20) VALUE SPACE. IX1064.2 +052200 01 CCVS-C-2. IX1064.2 +052300 02 FILLER PIC X VALUE SPACE. IX1064.2 +052400 02 FILLER PIC X(6) VALUE "TESTED". IX1064.2 +052500 02 FILLER PIC X(15) VALUE SPACE. IX1064.2 +052600 02 FILLER PIC X(4) VALUE "FAIL". IX1064.2 +052700 02 FILLER PIC X(94) VALUE SPACE. IX1064.2 +052800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1064.2 +052900 01 REC-CT PIC 99 VALUE ZERO. IX1064.2 +053000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1064.2 +053500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1064.2 +053600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1064.2 +053700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1064.2 +053800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1064.2 +053900 01 CCVS-H-1. IX1064.2 +054000 02 FILLER PIC X(39) VALUE SPACES. IX1064.2 +054100 02 FILLER PIC X(42) VALUE IX1064.2 +054200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1064.2 +054300 02 FILLER PIC X(39) VALUE SPACES. IX1064.2 +054400 01 CCVS-H-2A. IX1064.2 +054500 02 FILLER PIC X(40) VALUE SPACE. IX1064.2 +054600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1064.2 +054700 02 FILLER PIC XXXX VALUE IX1064.2 +054800 "4.2 ". IX1064.2 +054900 02 FILLER PIC X(28) VALUE IX1064.2 +055000 " COPY - NOT FOR DISTRIBUTION". IX1064.2 +055100 02 FILLER PIC X(41) VALUE SPACE. IX1064.2 +055200 IX1064.2 +055300 01 CCVS-H-2B. IX1064.2 +055400 02 FILLER PIC X(15) VALUE IX1064.2 +055500 "TEST RESULT OF ". IX1064.2 +055600 02 TEST-ID PIC X(9). IX1064.2 +055700 02 FILLER PIC X(4) VALUE IX1064.2 +055800 " IN ". IX1064.2 +055900 02 FILLER PIC X(12) VALUE IX1064.2 +056000 " HIGH ". IX1064.2 +056100 02 FILLER PIC X(22) VALUE IX1064.2 +056200 " LEVEL VALIDATION FOR ". IX1064.2 +056300 02 FILLER PIC X(58) VALUE IX1064.2 +056400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +056500 01 CCVS-H-3. IX1064.2 +056600 02 FILLER PIC X(34) VALUE IX1064.2 +056700 " FOR OFFICIAL USE ONLY ". IX1064.2 +056800 02 FILLER PIC X(58) VALUE IX1064.2 +056900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1064.2 +057000 02 FILLER PIC X(28) VALUE IX1064.2 +057100 " COPYRIGHT 1985 ". IX1064.2 +057200 01 CCVS-E-1. IX1064.2 +057300 02 FILLER PIC X(52) VALUE SPACE. IX1064.2 +057400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1064.2 +057500 02 ID-AGAIN PIC X(9). IX1064.2 +057600 02 FILLER PIC X(45) VALUE SPACES. IX1064.2 +057700 01 CCVS-E-2. IX1064.2 +057800 02 FILLER PIC X(31) VALUE SPACE. IX1064.2 +057900 02 FILLER PIC X(21) VALUE SPACE. IX1064.2 +058000 02 CCVS-E-2-2. IX1064.2 +058100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1064.2 +058200 03 FILLER PIC X VALUE SPACE. IX1064.2 +058300 03 ENDER-DESC PIC X(44) VALUE IX1064.2 +058400 "ERRORS ENCOUNTERED". IX1064.2 +058500 01 CCVS-E-3. IX1064.2 +058600 02 FILLER PIC X(22) VALUE IX1064.2 +058700 " FOR OFFICIAL USE ONLY". IX1064.2 +058800 02 FILLER PIC X(12) VALUE SPACE. IX1064.2 +058900 02 FILLER PIC X(58) VALUE IX1064.2 +059000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +059100 02 FILLER PIC X(13) VALUE SPACE. IX1064.2 +059200 02 FILLER PIC X(15) VALUE IX1064.2 +059300 " COPYRIGHT 1985". IX1064.2 +059400 01 CCVS-E-4. IX1064.2 +059500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1064.2 +059600 02 FILLER PIC X(4) VALUE " OF ". IX1064.2 +059700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1064.2 +059800 02 FILLER PIC X(40) VALUE IX1064.2 +059900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1064.2 +060000 01 XXINFO. IX1064.2 +060100 02 FILLER PIC X(19) VALUE IX1064.2 +060200 "*** INFORMATION ***". IX1064.2 +060300 02 INFO-TEXT. IX1064.2 +060400 04 FILLER PIC X(8) VALUE SPACE. IX1064.2 +060500 04 XXCOMPUTED PIC X(20). IX1064.2 +060600 04 FILLER PIC X(5) VALUE SPACE. IX1064.2 +060700 04 XXCORRECT PIC X(20). IX1064.2 +060800 02 INF-ANSI-REFERENCE PIC X(48). IX1064.2 +060900 01 HYPHEN-LINE. IX1064.2 +061000 02 FILLER PIC IS X VALUE IS SPACE. IX1064.2 +061100 02 FILLER PIC IS X(65) VALUE IS "************************IX1064.2 +061200- "*****************************************". IX1064.2 +061300 02 FILLER PIC IS X(54) VALUE IS "************************IX1064.2 +061400- "******************************". IX1064.2 +061500 01 CCVS-PGM-ID PIC X(9) VALUE IX1064.2 +061600 "IX106A". IX1064.2 +061700 PROCEDURE DIVISION. IX1064.2 +061800 CCVS1 SECTION. IX1064.2 +061900 OPEN-FILES. IX1064.2 +062000P OPEN I-O RAW-DATA. IX1064.2 +062100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1064.2 +062200P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1064.2 +062300P MOVE "ABORTED " TO C-ABORT. IX1064.2 +062400P ADD 1 TO C-NO-OF-TESTS. IX1064.2 +062500P ACCEPT C-DATE FROM DATE. IX1064.2 +062600P ACCEPT C-TIME FROM TIME. IX1064.2 +062700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1064.2 +062800PEND-E-1. IX1064.2 +062900P CLOSE RAW-DATA. IX1064.2 +063000 OPEN OUTPUT PRINT-FILE. IX1064.2 +063100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1064.2 +063200 MOVE SPACE TO TEST-RESULTS. IX1064.2 +063300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1064.2 +063400 MOVE ZERO TO REC-SKL-SUB. IX1064.2 +063500 PERFORM CCVS-INIT-FILE 9 TIMES. IX1064.2 +063600 CCVS-INIT-FILE. IX1064.2 +063700 ADD 1 TO REC-SKL-SUB. IX1064.2 +063800 MOVE FILE-RECORD-INFO-SKELETON IX1064.2 +063900 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1064.2 +064000 CCVS-INIT-EXIT. IX1064.2 +064100 GO TO CCVS1-EXIT. IX1064.2 +064200 CLOSE-FILES. IX1064.2 +064300P OPEN I-O RAW-DATA. IX1064.2 +064400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1064.2 +064500P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1064.2 +064600P MOVE "OK. " TO C-ABORT. IX1064.2 +064700P MOVE PASS-COUNTER TO C-OK. IX1064.2 +064800P MOVE ERROR-HOLD TO C-ALL. IX1064.2 +064900P MOVE ERROR-COUNTER TO C-FAIL. IX1064.2 +065000P MOVE DELETE-COUNTER TO C-DELETED. IX1064.2 +065100P MOVE INSPECT-COUNTER TO C-INSPECT. IX1064.2 +065200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1064.2 +065300PEND-E-2. IX1064.2 +065400P CLOSE RAW-DATA. IX1064.2 +065500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1064.2 +065600 TERMINATE-CCVS. IX1064.2 +065700S EXIT PROGRAM. IX1064.2 +065800STERMINATE-CALL. IX1064.2 +065900 STOP RUN. IX1064.2 +066000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1064.2 +066100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1064.2 +066200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1064.2 +066300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1064.2 +066400 MOVE "****TEST DELETED****" TO RE-MARK. IX1064.2 +066500 PRINT-DETAIL. IX1064.2 +066600 IF REC-CT NOT EQUAL TO ZERO IX1064.2 +066700 MOVE "." TO PARDOT-X IX1064.2 +066800 MOVE REC-CT TO DOTVALUE. IX1064.2 +066900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1064.2 +067000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1064.2 +067100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1064.2 +067200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1064.2 +067300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1064.2 +067400 MOVE SPACE TO CORRECT-X. IX1064.2 +067500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1064.2 +067600 MOVE SPACE TO RE-MARK. IX1064.2 +067700 HEAD-ROUTINE. IX1064.2 +067800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +067900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +068000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1064.2 +068100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1064.2 +068200 COLUMN-NAMES-ROUTINE. IX1064.2 +068300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +068400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +068500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +068600 END-ROUTINE. IX1064.2 +068700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1064.2 +068800 END-RTN-EXIT. IX1064.2 +068900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +069000 END-ROUTINE-1. IX1064.2 +069100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1064.2 +069200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1064.2 +069300 ADD PASS-COUNTER TO ERROR-HOLD. IX1064.2 +069400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1064.2 +069500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1064.2 +069600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1064.2 +069700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1064.2 +069800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1064.2 +069900 END-ROUTINE-12. IX1064.2 +070000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1064.2 +070100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1064.2 +070200 MOVE "NO " TO ERROR-TOTAL IX1064.2 +070300 ELSE IX1064.2 +070400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1064.2 +070500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1064.2 +070600 PERFORM WRITE-LINE. IX1064.2 +070700 END-ROUTINE-13. IX1064.2 +070800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1064.2 +070900 MOVE "NO " TO ERROR-TOTAL ELSE IX1064.2 +071000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1064.2 +071100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1064.2 +071200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071300 IF INSPECT-COUNTER EQUAL TO ZERO IX1064.2 +071400 MOVE "NO " TO ERROR-TOTAL IX1064.2 +071500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1064.2 +071600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1064.2 +071700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071900 WRITE-LINE. IX1064.2 +072000 ADD 1 TO RECORD-COUNT. IX1064.2 +072100Y IF RECORD-COUNT GREATER 42 IX1064.2 +072200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1064.2 +072300Y MOVE SPACE TO DUMMY-RECORD IX1064.2 +072400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1064.2 +072500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1064.2 +072600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1064.2 +072700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1064.2 +072800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1064.2 +072900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1064.2 +073300Y MOVE ZERO TO RECORD-COUNT. IX1064.2 +073400 PERFORM WRT-LN. IX1064.2 +073500 WRT-LN. IX1064.2 +073600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1064.2 +073700 MOVE SPACE TO DUMMY-RECORD. IX1064.2 +073800 BLANK-LINE-PRINT. IX1064.2 +073900 PERFORM WRT-LN. IX1064.2 +074000 FAIL-ROUTINE. IX1064.2 +074100 IF COMPUTED-X NOT EQUAL TO SPACE IX1064.2 +074200 GO TO FAIL-ROUTINE-WRITE. IX1064.2 +074300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1064.2 +074400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1064.2 +074500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1064.2 +074600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +074700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1064.2 +074800 GO TO FAIL-ROUTINE-EX. IX1064.2 +074900 FAIL-ROUTINE-WRITE. IX1064.2 +075000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1064.2 +075100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1064.2 +075200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1064.2 +075300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1064.2 +075400 FAIL-ROUTINE-EX. EXIT. IX1064.2 +075500 BAIL-OUT. IX1064.2 +075600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1064.2 +075700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1064.2 +075800 BAIL-OUT-WRITE. IX1064.2 +075900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1064.2 +076000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1064.2 +076100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +076200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1064.2 +076300 BAIL-OUT-EX. EXIT. IX1064.2 +076400 CCVS1-EXIT. IX1064.2 +076500 EXIT. IX1064.2 +076600******************************************************************IX1064.2 +076700 SECT-0001-RIS101 SECTION. IX1064.2 +076800* IX1064.2 +076900* THIS SECTION CREATES A RELATIVE FILE RANDOMLY. IX1064.2 +077000* IX1064.2 +077100 WRITE-INT-GF-01. IX1064.2 +077200 OPEN OUTPUT RL-FR1. IX1064.2 +077300 MOVE "RL-FR1" TO XFILE-NAME (1). IX1064.2 +077400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1064.2 +077500 MOVE ZERO TO XRECORD-NUMBER (1). IX1064.2 +077600 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1064.2 +077700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1064.2 +077800 MOVE 241 TO XRECORD-LENGTH (1). IX1064.2 +077900 MOVE 001 TO XBLOCK-SIZE (1). IX1064.2 +078000 MOVE "RL" TO XFILE-ORGANIZATION (1). IX1064.2 +078100 MOVE "S" TO XLABEL-TYPE (1). IX1064.2 +078200 MOVE 225 TO RECORDS-IN-FILE (1). IX1064.2 +078300 MOVE "WRITE RL-FR1 " TO FEATURE. IX1064.2 +078400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1064.2 +078500 MOVE ZERO TO KEYSUB. IX1064.2 +078600 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +078700 WRITE-INIT-GF-01-01. IX1064.2 +078800 PERFORM WRITE-TEST-GF-01-R1 75 TIMES. IX1064.2 +078900 GO TO WRITE-TEST-GF-01. IX1064.2 +079000 WRITE-TEST-GF-01-R1. IX1064.2 +079100* IX1064.2 +079200* WRITE-TEST-GF-01-R1 - WRITES THREE RECORDS FOR EACH PASS THRU . IX1064.2 +079300* 1) FOR THE FIRST RECORD CREATED RL-KEY IS IX1064.2 +079400* SET TO FR1-RECKEY-11-13 . IX1064.2 +079500* 2) FOR THE SECOND RECORD CREATED RL-KEY IS IX1064.2 +079600* SET TO FR1-ALTKEY1-11-13 . IX1064.2 +079700* 3) FOR THE THIRD RECORD CREATED RL-KEY IS IX1064.2 +079800* SET TO FR1-ALTKEY2-11-13 . IX1064.2 +079900* THESE RECORD KEYS ARE IN THREE DIFFERENT IX1064.2 +080000* ORDERINGS. IX1064.2 +080100* 1) FR1-RECKEY-11-13 ARE THE NUMBERS FROM IX1064.2 +080200* 225 TO 151 DECENDING . IX1064.2 +080300* 2) FR1-ALTKEY1-11-13 ARE THE NUMBERS FROM IX1064.2 +080400* 1 TO 75 ASCENDING . IX1064.2 +080500* 3) FR1-ALTKEY-11-13 ARE THE NUMBERS FROM IX1064.2 +080600* 76 TO 151 ASCENDING . IX1064.2 +080700* IX1064.2 +080800 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +080900 ADD 001 TO KEYSUB. IX1064.2 +081000 MOVE RECKEY-VALUE (KEYSUB) TO FR1-RECKEY-1-13. IX1064.2 +081100 MOVE ALTKEY1-VALUE (KEYSUB) TO FR1-ALTKEY1-1-20. IX1064.2 +081200 MOVE ALTKEY2-VALUE (KEYSUB) TO FR1-ALTKEY2-1-20. IX1064.2 +081300 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +081400 MOVE WRK-FR1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX1064.2 +081500 MOVE WRK-FR1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX1064.2 +081600 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +081700 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +081800 WRITE RL-FR1R1-F-G-241 IX1064.2 +081900 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +082000 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +082100 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +082200 MOVE FR1-ALTKEY1-11-13 TO FR1-RECKEY-11-13. IX1064.2 +082300 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +082400 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +082500 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +082600 WRITE RL-FR1R1-F-G-241 IX1064.2 +082700 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +082800 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +082900 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +083000 MOVE FR1-ALTKEY2-11-13 TO FR1-RECKEY-11-13. IX1064.2 +083100 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +083200 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +083300 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +083400 WRITE RL-FR1R1-F-G-241 IX1064.2 +083500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +083600 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +083700 WRITE-TEST-GF-01. IX1064.2 +083800 SUBTRACT INVKEY-COUNTER-RL FROM EXCUT-COUNTER-06V00 IX1064.2 +083900 GIVING RECORDS-WRITTEN. IX1064.2 +084000 WRITE-TEST-CHECK. IX1064.2 +084100 MOVE 225 TO CORRECT-18V0. IX1064.2 +084200 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX1064.2 +084300 IF RECORDS-WRITTEN EQUAL TO 225 IX1064.2 +084400 PERFORM PASS IX1064.2 +084500 ELSE IX1064.2 +084600 MOVE "VIII-37 4.9.2 " TO RE-MARK IX1064.2 +084700 PERFORM FAIL. IX1064.2 +084800 PERFORM PRINT-DETAIL. IX1064.2 +084900 WRITE-TEST-GF-01-END. IX1064.2 +085000 CLOSE RL-FR1. IX1064.2 +085100******************************************************************IX1064.2 +085200 SECT-0002-RIS101 SECTION. IX1064.2 +085300* IX1064.2 +085400* THIS SECTION CREATES A SEQUENTIAL AND AN INDEXED FILE USING THE IX1064.2 +085500* RELATIVE FILE CREATED IN THE PREVIOUS SECTION AS INPUT . IX1064.2 +085600* IX1064.2 +085700 WRITE-INIT-GF-02. IX1064.2 +085800 OPEN OUTPUT IX-FS1 SQ-FS1. IX1064.2 +085900 OPEN INPUT RL-FR1. IX1064.2 +086000 MOVE ZERO TO RL-KEY. IX1064.2 +086100 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +086200 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +086300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX1064.2 +086400 PERFORM WRITE-TEST-GF-02-01 75 TIMES. IX1064.2 +086500 PERFORM WRITE-TEST-GF-02-02 75 TIMES. IX1064.2 +086600 PERFORM WRITE-TEST-GF-02-03 75 TIMES. IX1064.2 +086700 GO TO WRITE-TEST-GF-02-END. IX1064.2 +086800 WRITE-INT-GF-02-IX. IX1064.2 +086900 MOVE "WRITE IX-FS1 " TO FEATURE. IX1064.2 +087000 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +087100 WRITE-INT-GF-02-SQ. IX1064.2 +087200 MOVE "WRITE SQ-FS1 " TO FEATURE. IX1064.2 +087300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +087400 WRITE-TEST-GF-02-01. IX1064.2 +087500* IX1064.2 +087600* WRITE-TEST-GF-02-01 - READS IN THE RELATIVE FILE IN SEQUENCE , IX1064.2 +087700* MOVES RL-FR1-ALTKEY1-11-13 TO IX1064.2 +087800* RL-FR1-ALTKEY2-11-13 SO THAT ALL THE IX1064.2 +087900* KEYS ON THE RECORD ARE THE SAME , THEN IX1064.2 +088000* WRITES A SEQUENTIAL RECORD AND AN INDEXED IX1064.2 +088100* FILE RECORD . IX1064.2 +088200* IX1064.2 +088300 ADD 001 TO RL-KEY. IX1064.2 +088400 READ RL-FR1 IX1064.2 +088500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +088600 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +088700 MOVE RL-FR1-ALTKEY1-11-13 TO RL-FR1-ALTKEY2-11-13. IX1064.2 +088800 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +088900 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +089000 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +089100 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +089200 MOVE "WRITE SQ-FS1 " TO FEATURE. IX1064.2 +089300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +089400 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +089500 WRITE SQ-FS1R1-F-G-241. IX1064.2 +089600 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +089700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +089800 MOVE "WRITE IX-FS1 " TO FEATURE. IX1064.2 +089900 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +090000 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +090100 WRITE IX-FS1R1-F-G-241 IX1064.2 +090200 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +090300 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +090400 WRITE-TEST-GF-02-02. IX1064.2 +090500* IX1064.2 +090600* WRITE-TEST-GF-02-02 - READS IN THE RELATIVE FILE IN SEQUENCE IX1064.2 +090700* STARTING AT NUMBER 76 WHERE WRITE-TEST-GF-02-01 IX1064.2 +090800* LEFT OFF . MOVES RL-FR1-ALTKEY2-11-13 TO IX1064.2 +090900* RL-FR1-ALTKEY1-11-13 SO THAT ALL THE KEYS IX1064.2 +091000* IN THE RECORD ARE THE SAME . WRITES A IX1064.2 +091100* SEQUENTIAL AND AN INDEXED FILE RECORD . IX1064.2 +091200* IX1064.2 +091300 ADD 001 TO RL-KEY. IX1064.2 +091400 READ RL-FR1 IX1064.2 +091500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +091600 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +091700 MOVE RL-FR1-ALTKEY2-11-13 TO RL-FR1-ALTKEY1-11-13. IX1064.2 +091800 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +091900 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +092000 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +092100 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +092200 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +092300 WRITE SQ-FS1R1-F-G-241. IX1064.2 +092400 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +092500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +092600 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +092700 WRITE IX-FS1R1-F-G-241 IX1064.2 +092800 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +092900 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +093000 WRITE-TEST-GF-02-03. IX1064.2 +093100* IX1064.2 +093200* WRITE-TEST-GF-02-03 - READS IN THE RELATIVE FILE IN SEQUENCE IX1064.2 +093300* STARTING AT NUMBER 151 WHERE WRITE-TEST-GF-02-02 IX1064.2 +093400* LEFT OFF . MOVES RL-FR1-KEY-11-13 TO IX1064.2 +093500* RL-FR1-ALTKEY1-11-13 AND RL-ALTKEY2-11-13 IX1064.2 +093600* SO THAT ALL THE KEYS IN THE RECORD ARE IX1064.2 +093700* THE SAME . WRITES A SEQUENTIAL AND AN IX1064.2 +093800* INDEXED FILE RECORD . IX1064.2 +093900* IX1064.2 +094000 ADD 001 TO RL-KEY. IX1064.2 +094100 READ RL-FR1 IX1064.2 +094200 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +094300 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +094400 MOVE RL-FR1-KEY-11-13 TO RL-FR1-ALTKEY1-11-13. IX1064.2 +094500 MOVE RL-FR1-ALTKEY1-11-13 TO RL-FR1-ALTKEY2-11-13. IX1064.2 +094600 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +094700 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +094800 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +094900 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +095000 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +095100 WRITE SQ-FS1R1-F-G-241. IX1064.2 +095200 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +095300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +095400 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +095500 WRITE IX-FS1R1-F-G-241 IX1064.2 +095600 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +095700 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +095800 WRITE-TEST-GF-02-END. IX1064.2 +095900 CLOSE RL-FR1. IX1064.2 +096000 CLOSE SQ-FS1. IX1064.2 +096100 CLOSE IX-FS1. IX1064.2 +096200 MOVE "READ RL-FR1 " TO FEATURE. IX1064.2 +096300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +096400 PERFORM WRITE-TEST-GF-01 THRU WRITE-TEST-CHECK. IX1064.2 +096500 SUBTRACT INVKEY-COUNTER-IX FROM EXCUT-COUNTER-06V00 IX1064.2 +096600 GIVING RECORDS-WRITTEN. IX1064.2 +096700 WRITE-TEST-GF-02-2. IX1064.2 +096800 PERFORM WRITE-INT-GF-02-IX. IX1064.2 +096900 MOVE "WRITE-TEST-GF-02-2" TO PAR-NAME. IX1064.2 +097000 PERFORM WRITE-TEST-CHECK. IX1064.2 +097100 WRITE-TEST-GF-02-3. IX1064.2 +097200 PERFORM WRITE-INT-GF-02-SQ. IX1064.2 +097300 MOVE "WRITE-TEST-GF-02-3" TO PAR-NAME. IX1064.2 +097400 PERFORM WRITE-TEST-CHECK. IX1064.2 +097500******************************************************************IX1064.2 +097600 SECT-0003-RIS101 SECTION. IX1064.2 +097700* IX1064.2 +097800* THIS SECTION TESTS THE ABILITY TO HAVE ALL THREE DIFFERNT FILE IX1064.2 +097900* TYPES OPENED AND USED AT THE SAME TIME . IX1064.2 +098000* IX1064.2 +098100 READ-TEST-F2-01-01. IX1064.2 +098200 MOVE ZEROES TO REC-CT. IX1064.2 +098300 OPEN INPUT RL-FR1. IX1064.2 +098400 OPEN INPUT IX-FS1. IX1064.2 +098500 OPEN INPUT SQ-FS1. IX1064.2 +098600 MOVE "OPEN ALL - SEPARATE" TO FEATURE. IX1064.2 +098700 MOVE "READ-TEST-F2-01-02" TO PAR-NAME. IX1064.2 +098800 READ-TEST-F2-01-02. IX1064.2 +098900* IX1064.2 +099000* READ-TEST-F2-01-02 - THIS TESTS THE ABILITY TO READ ALL THREE IX1064.2 +099100* TYPES OF FILES IN ANY ORDER WITH ALL OF THEIX1064.2 +099200* FILES OPEN AT ONCE . IX1064.2 +099300* IX1064.2 +099400 MOVE ZERO TO RL-KEY. IX1064.2 +099500 ADD 001 TO RL-KEY. IX1064.2 +099600 READ SQ-FS1 INTO IX-FS1R1-F-G-241 AT END GO TEST-FINISH-EXIT.IX1064.2 +099700 READ IX-FS1 IX1064.2 +099800 INVALID KEY IX1064.2 +099900 MOVE "1ST IX-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +100000 PERFORM FAIL IX1064.2 +100100 PERFORM PRINT-DETAIL IX1064.2 +100200 GO TO READ-TEST-F2-01-02-END. IX1064.2 +100300 READ RL-FR1 IX1064.2 +100400 INVALID KEY IX1064.2 +100500 MOVE "1ST RL-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +100600 PERFORM FAIL IX1064.2 +100700 PERFORM PRINT-DETAIL IX1064.2 +100800 GO TO READ-TEST-F2-01-02-END. IX1064.2 +100900 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +101000 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +101100 READ RL-FR1 IX1064.2 +101200 INVALID KEY IX1064.2 +101300 MOVE "2ND IX-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +101400 PERFORM FAIL IX1064.2 +101500 PERFORM PRINT-DETAIL IX1064.2 +101600 GO TO READ-TEST-F2-01-02-END. IX1064.2 +101700 READ IX-FS1 IX1064.2 +101800 INVALID KEY IX1064.2 +101900 MOVE "2ND RL-FR1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +102000 PERFORM FAIL IX1064.2 +102100 PERFORM PRINT-DETAIL IX1064.2 +102200 GO TO READ-TEST-F2-01-02-END. IX1064.2 +102300 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +102400 PERFORM PASS. IX1064.2 +102500 PERFORM PRINT-DETAIL. IX1064.2 +102600 READ-TEST-F2-01-02-END. IX1064.2 +102700 CLOSE RL-FR1. IX1064.2 +102800 CLOSE IX-FS1. IX1064.2 +102900 CLOSE SQ-FS1. IX1064.2 +103000 READ-INIT-F2-02. IX1064.2 +103100 OPEN I-O IX-FS1 SQ-FS1 RL-FR1. IX1064.2 +103200 READ-TEST-F2-02. IX1064.2 +103300 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +103400 READ-WRITE-F2-02. IX1064.2 +103500 CLOSE RL-FR1 IX-FS1 SQ-FS1. IX1064.2 +103600 MOVE "R-I-S " TO XFILE-NAME (1). IX1064.2 +103700 MOVE ZERO TO XRECORD-NUMBER (1). IX1064.2 +103800 MOVE "AL" TO XFILE-ORGANIZATION (1). IX1064.2 +103900 MOVE "OPEN ALL 3 IN 1 LINE" TO FEATURE. IX1064.2 +104000 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX1064.2 +104100 PERFORM PASS. IX1064.2 +104200 PERFORM PRINT-DETAIL. IX1064.2 +104300******************************************************************IX1064.2 +104400 SECT-0004-RIS101 SECTION. IX1064.2 +104500* IX1064.2 +104600* THIS SECTION TESTS THE ABILITY TO DELETE RECORDS FROM ONE FILE IX1064.2 +104700* TYPE WHILE HAVING THE OTHER FILES OPEN . IX1064.2 +104800* IX1064.2 +104900 DELETE-TEST-GF-01. IX1064.2 +105000* IX1064.2 +105100* DELETE-TEST-GF-01-01 -IN THIS TEST RECORD NUMBER 121 IS DELETED IX1064.2 +105200* THE RELATIVE FILE . THE FILE IS THEN CLOSED . IX1064.2 +105300* THE RELATIVE FILE IS THEN RE-OPENED AND IX1064.2 +105400* READ EXPECTING TO FIND 122 VALID RECORDS IX1064.2 +105500* AND AN INVALID KEY FOR WHAT USED TO BE IX1064.2 +105600* THE 122ND RECORD. RL-FR1-RECKEY-11-13 IX1064.2 +105700* IS CHECKED TO SEE IF RECORD 123 IS READ IX1064.2 +105800* AS IT SHOULD BE. IX1064.2 +105900* IX1064.2 +106000 OPEN I-O IX-FS1 RL-FR1 SQ-FS1. IX1064.2 +106100 MOVE ZERO TO IX-FS1-KEY-11-13. IX1064.2 +106200 MOVE ZERO TO RL-KEY. IX1064.2 +106300 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +106400 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +106500 MOVE 121 TO IX-FS1-KEY-11-13. IX1064.2 +106600 READ IX-FS1 IX1064.2 +106700 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +106800 ADD 121 TO RL-KEY. IX1064.2 +106900 MOVE "R-I-S " TO XFILE-NAME (1) IX1064.2 +107000 MOVE ZERO TO XRECORD-NUMBER (1) IX1064.2 +107100 MOVE "RL" TO XFILE-ORGANIZATION (1) IX1064.2 +107200 MOVE "DELETE RL RECORD" TO FEATURE IX1064.2 +107300 MOVE "DELETE-TEST-GF-01 " TO PAR-NAME IX1064.2 +107400 DELETE RL-FR1 IX1064.2 +107500 INVALID KEY PERFORM FAIL IX1064.2 +107600 PERFORM PRINT-DETAIL IX1064.2 +107700 GO TO DELETE-TEST-GF-01-END. IX1064.2 +107800 CLOSE RL-FR1. IX1064.2 +107900 OPEN INPUT RL-FR1. IX1064.2 +108000 MOVE ZERO TO RL-KEY. IX1064.2 +108100 PERFORM DELETE-TEST-GF-01-02-R2 122 TIMES. IX1064.2 +108200 DELETE-TEST-GF-01-02-R2. IX1064.2 +108300 ADD 1 TO RL-KEY. IX1064.2 +108400 READ RL-FR1 INVALID KEY IX1064.2 +108500 ADD 1 TO INVKEY-COUNTER-RL. IX1064.2 +108600 DELETE-TEST-GF-01-02-CK. IX1064.2 +108700 IF RL-FR1-KEY-11-13 EQUAL TO 123 IX1064.2 +108800 ADD 1 TO INVKEY-COUNTER-RL. IX1064.2 +108900 IF IX1064.2 +109000 INVKEY-COUNTER-RL EQUAL TO 2 IX1064.2 +109100 PERFORM PASS ELSE IX1064.2 +109200 MOVE "VII-19 4.3.2 " TO RE-MARK IX1064.2 +109300 PERFORM FAIL. IX1064.2 +109400 PERFORM PRINT-DETAIL. IX1064.2 +109500 DELETE-TEST-GF-01-END. IX1064.2 +109600 CLOSE RL-FR1 IX-FS1 SQ-FS1. IX1064.2 +109700******************************************************************IX1064.2 +109800 SECT-TEST-005-RIS101 SECTION. IX1064.2 +109900* IX1064.2 +110000* THIS SECTION TESTS THE ABILITY TO REWRITE A FILE WHILE OTHER IX1064.2 +110100* FILES ARE BEING MANIPULATED . IX1064.2 +110200* IX1064.2 +110300 REWRITE-INIT-GF-01. IX1064.2 +110400 OPEN I-O SQ-FS1 IX-FS1 RL-FR1. IX1064.2 +110500 MOVE ZEROES TO RL-KEY. IX1064.2 +110600 ADD 003 TO RL-KEY. IX1064.2 +110700 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +110800 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +110900 REWRITE-TEST-GF-01. IX1064.2 +111000* IX1064.2 +111100* REWRITE-TEST-GF-01:TESTS THE ABILITY TO REWRITE A RELATIVE FILE IX1064.2 +111200* WHILE ALSO MANIPULATING DATA FROM AN INEXED IX1064.2 +111300* FILE . IX1064.2 +111400* IX1064.2 +111500 READ-INIT-RL. IX1064.2 +111600 READ RL-FR1 IX1064.2 +111700 INVALID KEY IX1064.2 +111800 MOVE "READ RL RECORD" TO FEATURE IX1064.2 +111900 MOVE "READ-INIT-RL " TO PAR-NAME IX1064.2 +112000 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +112100 MOVE RL-FR1-ALTKEY2-11-13 TO IX-FS1-KEY-11-13. IX1064.2 +112200 READ-INIT-IX. IX1064.2 +112300 READ IX-FS1 IX1064.2 +112400 INVALID KEY IX1064.2 +112500 MOVE "READ IX RECORD" TO FEATURE IX1064.2 +112600 MOVE "READ-INIT-IX. " TO PAR-NAME IX1064.2 +112700 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +112800 MOVE RL-FR1-ALTKEY2-11-13 TO IX-FS1-KEY-11-13. IX1064.2 +112900 MOVE IX-FS1R1-F-G-241 TO RL-FR1R1-F-G-241. IX1064.2 +113000 REWRITE RL-FR1R1-F-G-241 IX1064.2 +113100 INVALID KEY IX1064.2 +113200 MOVE "REWRITE RL RECORD" TO FEATURE IX1064.2 +113300 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME IX1064.2 +113400 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +113500 REWRITE-TEST-005-01-1. IX1064.2 +113600 READ RL-FR1 IX1064.2 +113700 INVALID KEY IX1064.2 +113800 MOVE "READ RL RECORD" TO FEATURE IX1064.2 +113900 MOVE "REWRITE-TEST-005-01-1" TO PAR-NAME IX1064.2 +114000 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +114100 REWRITE-TEST-01. IX1064.2 +114200 MOVE "REWRITE RL RECORD" TO FEATURE IX1064.2 +114300 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX1064.2 +114400 IF RL-FR1-KEY-11-13 NOT EQUAL 78 IX1064.2 +114500 PERFORM FAIL IX1064.2 +114600 MOVE RL-FR1-KEY-11-13 TO COMPUTED-A IX1064.2 +114700 MOVE "78" TO CORRECT-A IX1064.2 +114800 PERFORM PRINT-DETAIL IX1064.2 +114900 MOVE RL-FR1-REC-120 TO DUMMY-RECORD IX1064.2 +115000 PERFORM WRITE-LINE IX1064.2 +115100 MOVE RL-FR1-REC-121-241 TO DUMMY-RECORD IX1064.2 +115200 PERFORM WRITE-LINE IX1064.2 +115300 ELSE IX1064.2 +115400 PERFORM PASS. IX1064.2 +115500 PERFORM PRINT-DETAIL. IX1064.2 +115600*************************************************************** IX1064.2 +115700 REWRITE-TEST-GF-02. IX1064.2 +115800* IX1064.2 +115900* REWRITE-TEST-GF-02 TESTS THE ABILITY TO REWRITE A SEQUENTIAL IX1064.2 +116000* FILE WHILE WORKING WITH A RELATIVE ALSO . IX1064.2 +116100* IX1064.2 +116200 PERFORM READ-TEST-F2-02 9 TIMES. IX1064.2 +116300 MOVE 15 TO RL-KEY. IX1064.2 +116400 READ RL-FR1 INTO SQ-FS1R1-F-G-241 IX1064.2 +116500 INVALID KEY IX1064.2 +116600 MOVE "RL INTO SQ" TO FEATURE IX1064.2 +116700 MOVE "REWRITE-TEST-GF-02I" TO PAR-NAME IX1064.2 +116800 MOVE "VIII-26 4.5.2 " TO RE-MARK IX1064.2 +116900 PERFORM FAIL IX1064.2 +117000 PERFORM PRINT-DETAIL IX1064.2 +117100 GO TEST-FINISH-EXIT. IX1064.2 +117200 MOVE "REWRITE-TEST-GF-02 " TO PAR-NAME. IX1064.2 +117300 MOVE "REWRITE SQ" TO FEATURE. IX1064.2 +117400 REWRITE SQ-FS1R1-F-G-241. IX1064.2 +117500 CLOSE SQ-FS1. IX1064.2 +117600 OPEN I-O SQ-FS1. IX1064.2 +117700 PERFORM READ-TEST-F2-02 9 TIMES. IX1064.2 +117800 IF SQ-FS1-ALTKEY2-11-13 EQUAL TO "090" IX1064.2 +117900 PERFORM PASS IX1064.2 +118000 ELSE IX1064.2 +118100 PERFORM FAIL IX1064.2 +118200 MOVE "90" TO CORRECT-A IX1064.2 +118300 MOVE SQ-FS1-KEY-11-13 TO COMPUTED-A. IX1064.2 +118400 PERFORM PRINT-DETAIL. IX1064.2 +118500********* END OF 005-02 REWRITE SQ RECORD ************************IX1064.2 +118600 REWRITE-TEST-GF-03. IX1064.2 +118700* IX1064.2 +118800* REWRITE-TEST-GF-03 TESTS THE ABILITY TO REWRITE AN INDEXED FILEIX1064.2 +118900* WHILE ALSO READING A RELATIVE FILE . IX1064.2 +119000* IX1064.2 +119100 MOVE 15 TO RL-KEY. IX1064.2 +119200 MOVE "077" TO IX-FS1-KEY-11-13. IX1064.2 +119300 MOVE "REWRITE-TEST-GF-03 " TO PAR-NAME. IX1064.2 +119400 MOVE "REWRITE IX" TO FEATURE. IX1064.2 +119500 READ IX-FS1 IX1064.2 +119600 INVALID KEY IX1064.2 +119700 MOVE "READ IX RECORD" TO FEATURE IX1064.2 +119800 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +119900 READ RL-FR1 IX1064.2 +120000 INVALID KEY IX1064.2 +120100 MOVE "READ RL TO PASS TO IX" TO RE-MARK IX1064.2 +120200 PERFORM FAIL IX1064.2 +120300 PERFORM PRINT-DETAIL IX1064.2 +120400 GO REWRITE-TEST-005-END. IX1064.2 +120500 REWRITE IX-FS1R1-F-G-241 FROM RL-FR1R1-F-G-241 IX1064.2 +120600 INVALID KEY IX1064.2 +120700 MOVE "REWRITE IX STATEMENT" TO RE-MARK IX1064.2 +120800 PERFORM FAIL IX1064.2 +120900 PERFORM PRINT-DETAIL IX1064.2 +121000 GO TO REWRITE-TEST-005-END. IX1064.2 +121100 MOVE "015" TO IX-FS1-KEY-11-13. IX1064.2 +121200 READ IX-FS1 IX1064.2 +121300 INVALID KEY IX1064.2 +121400 MOVE "RE-READ IX FOR CHECK" TO RE-MARK IX1064.2 +121500 PERFORM FAIL IX1064.2 +121600 PERFORM PRINT-DETAIL IX1064.2 +121700 GO REWRITE-TEST-005-END. IX1064.2 +121800 IF IX-FS1-ALTKEY2-11-13 EQUAL TO "090" IX1064.2 +121900 PERFORM PASS IX1064.2 +122000 ELSE IX1064.2 +122100 MOVE IX-FS1-REC-120 TO DUMMY-RECORD IX1064.2 +122200 PERFORM WRITE-LINE IX1064.2 +122300 MOVE IX-FS1-REC-121-241 TO DUMMY-RECORD IX1064.2 +122400 PERFORM WRITE-LINE IX1064.2 +122500 PERFORM FAIL. IX1064.2 +122600 PERFORM PRINT-DETAIL. IX1064.2 +122700 REWRITE-TEST-005-END. IX1064.2 +122800 CLOSE SQ-FS1 IX-FS1 RL-FR1. IX1064.2 +122900 TEST-FINISH-EXIT. IX1064.2 +123000 EXIT. IX1064.2 +123100 CCVS-EXIT SECTION. IX1064.2 +123200 CCVS-999999. IX1064.2 +123300 GO TO CLOSE-FILES. IX1064.2 +*END-OF,IX106A +*HEADER,COBOL,IX107A +000100 IDENTIFICATION DIVISION. IX1074.2 +000200 PROGRAM-ID. IX1074.2 +000300 IX107A. IX1074.2 +000400**************************************************************** IX1074.2 +000500* * IX1074.2 +000600* VALIDATION FOR:- * IX1074.2 +000700* * IX1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +000900* * IX1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1074.2 +001100* * IX1074.2 +001200**************************************************************** IX1074.2 +001300* IX1074.2 +001400* THIS ROUTINE TESTS THE FOLLOWING COBOL ELEMENTS FOR PROPERIX1074.2 +001500* SYNTAX WHEN USING AN INDEXED SEQUENTIAL I-O FILE. IX1074.2 +001600* IX1074.2 +001700* SAME AREA FILE-NAME-1 FILE-NAME-2 IX1074.2 +001800* READ .... RECORD AT END .... IX1074.2 +001900* READ .... RECORD END ... IX1074.2 +002000* READ .... AT END .... IX1074.2 +002100* READ .... END .... IX1074.2 +002200* READ .... RECORD INVALID KEY ... IX1074.2 +002300* READ .... INVALID KEY ... IX1074.2 +002400* READ .... RECORD INVALID ... IX1074.2 +002500* READ .... INVALID ... IX1074.2 +002600* IX1074.2 +002700* THERE ARE TWO FILES USED IN THIS ROUTINE. FOLLOWING IX1074.2 +002800* CREATION OF EACH FILE THE ROUTINE READS AND VERIFIES THE FILEIX1074.2 +002900* BEFORE ANY OF THE ABOVE TESTS ARE MADE. ONE FILE SPECIFIES IX1074.2 +003000* AN ACCESS MODE AS RANDOM AND THE OTHER FILE SPECIFIES AN IX1074.2 +003100* ACCESS MODE AS SEQUENTIAL. THE FILES REFERENCED IN THE SAME IX1074.2 +003200* CLAUSE NEED NOT HAVE THE SAME ACCESS MODE. IX1074.2 +003300* IX1074.2 +003400* REFERENCES: SECTION IX-15, SEE VII-19 2.13.3 (4) SAME IX1074.2 +003500* AREA IX1074.2 +003600* IX1074.2 +003700* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1074.2 +003800* IX1074.2 +003900* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1074.2 +004000* CLAUSE FOR DATA FILE IX-FS1 IX1074.2 +004100* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1074.2 +004200* CLAUSE FOR DATA FILE IX-FD2 IX1074.2 +004300* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1074.2 +004400* CLAUSE FOR INDEX FILE IX-FS1 IX1074.2 +004500* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1074.2 +004600* CLAUSE FOR INDEX FILE IX-FD2 IX1074.2 +004700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1074.2 +004800* X-62 FOR RAW-DATA IX1074.2 +004900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1074.2 +005000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1074.2 +005100* X-84 PRINTER-FILE LABELS (OPTIONAL) C IX1074.2 +005200* IX1074.2 +005300* NOTE: X-CARDS 44,45, 62 AND 84 ARE OPTIONAL IX1074.2 +005400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1074.2 +005500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1074.2 +005600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1074.2 +005700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1074.2 +005800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1074.2 +005900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1074.2 +006000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1074.2 +006100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1074.2 +006200* THEY ARE AS FOLLOWS IX1074.2 +006300* IX1074.2 +006400* C SELECTS OBSOLETE FEATURES (E.G. LABEL ..) IX1074.2 +006500* J SELECTS X-CARDS 44 AND 45 IX1074.2 +006600* IX1074.2 +006700* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX1074.2 +006800* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX1074.2 +006900* CODE IS IDENTIFIED BY THE LETTER T OR U IN IX1074.2 +007000* POSITION 7 OF THE SOURCE LINE. FOR CODE IX1074.2 +007100* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX1074.2 +007200* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX1074.2 +007300* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX1074.2 +007400* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX1074.2 +007500* AN INDEXED KEY NOT GREATER THAN 8 CHARACTERS. IX1074.2 +007600* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX1074.2 +007700* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX1074.2 +007800* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX1074.2 +007900* CARD. IX1074.2 +008000* IX1074.2 +008100****************************************************** IX1074.2 +008200 ENVIRONMENT DIVISION. IX1074.2 +008300 CONFIGURATION SECTION. IX1074.2 +008400 SOURCE-COMPUTER. IX1074.2 +008500 XXXXX082. IX1074.2 +008600 OBJECT-COMPUTER. IX1074.2 +008700 XXXXX083. IX1074.2 +008800 INPUT-OUTPUT SECTION. IX1074.2 +008900 FILE-CONTROL. IX1074.2 +009000P SELECT RAW-DATA ASSIGN TO IX1074.2 +009100P XXXXX062 IX1074.2 +009200P ORGANIZATION IS INDEXED IX1074.2 +009300P ACCESS MODE IS RANDOM IX1074.2 +009400P RECORD KEY IS RAW-DATA-KEY. IX1074.2 +009500 SELECT PRINT-FILE ASSIGN TO IX1074.2 +009600 XXXXX055. IX1074.2 +009700 SELECT IX-FS1 ASSIGN TO IX1074.2 +009800 XXXXX024 IX1074.2 +009900J XXXXX044 IX1074.2 +010000 RECORD KEY IS IX-FS1-KEY IX1074.2 +010100 ORGANIZATION IS INDEXED IX1074.2 +010200 ACCESS MODE IS SEQUENTIAL. IX1074.2 +010300 SELECT IX-FD2 ASSIGN TO IX1074.2 +010400 XXXXX025 IX1074.2 +010500J XXXXX045 IX1074.2 +010600 RECORD KEY IS IX-FD2-KEY IX1074.2 +010700 ORGANIZATION IS INDEXED IX1074.2 +010800 ACCESS MODE IS RANDOM. IX1074.2 +010900 I-O-CONTROL. IX1074.2 +011000 SAME AREA IX-FS1 IX-FD2. IX1074.2 +011100 DATA DIVISION. IX1074.2 +011200 FILE SECTION. IX1074.2 +011300P IX1074.2 +011400PFD RAW-DATA. IX1074.2 +011500P IX1074.2 +011600P01 RAW-DATA-SATZ. IX1074.2 +011700P 05 RAW-DATA-KEY PIC X(6). IX1074.2 +011800P 05 C-DATE PIC 9(6). IX1074.2 +011900P 05 C-TIME PIC 9(8). IX1074.2 +012000P 05 C-NO-OF-TESTS PIC 99. IX1074.2 +012100P 05 C-OK PIC 999. IX1074.2 +012200P 05 C-ALL PIC 999. IX1074.2 +012300P 05 C-FAIL PIC 999. IX1074.2 +012400P 05 C-DELETED PIC 999. IX1074.2 +012500P 05 C-INSPECT PIC 999. IX1074.2 +012600P 05 C-NOTE PIC X(13). IX1074.2 +012700P 05 C-INDENT PIC X. IX1074.2 +012800P 05 C-ABORT PIC X(8). IX1074.2 +012900 FD PRINT-FILE. IX1074.2 +013000 01 PRINT-REC PICTURE X(120). IX1074.2 +013100 01 DUMMY-RECORD PICTURE X(120). IX1074.2 +013200 FD IX-FS1 IX1074.2 +013300C LABEL RECORD IS STANDARD IX1074.2 +013400C DATA RECORD IS IX-FS1R1-F-G-240 IX1074.2 +013500 BLOCK CONTAINS 1 RECORDS IX1074.2 +013600 RECORD CONTAINS 240 CHARACTERS. IX1074.2 +013700 01 IX-FS1R1-F-G-240. IX1074.2 +013800 03 IX-FS1-REC-120 PIC X(120). IX1074.2 +013900 03 IX-FS1-REC-121-240. IX1074.2 +014000 05 FILLER PIC X(8). IX1074.2 +014100 05 IX-FS1-KEY. IX1074.2 +014200 10 IX-FS1-KEYNUM PIC 9(5). IX1074.2 +014300T 10 FILLER PIC X(24). IX1074.2 +014400U 05 FILLER PIC X(24). IX1074.2 +014500 05 FILLER PIC X(83). IX1074.2 +014600 FD IX-FD2 IX1074.2 +014700C LABEL RECORD IS STANDARD IX1074.2 +014800C DATA RECORD IS IX-FD2R1-F-G-240 IX1074.2 +014900 BLOCK CONTAINS 5 RECORDS IX1074.2 +015000 RECORD CONTAINS 240 CHARACTERS. IX1074.2 +015100 01 IX-FD2R1-F-G-240. IX1074.2 +015200 03 IX-FD2-REC-120 PIC X(120). IX1074.2 +015300 03 IX-FD2-REC-121-240. IX1074.2 +015400 05 FILLER PIC X(8). IX1074.2 +015500 05 IX-FD2-KEY. IX1074.2 +015600 10 IX-FD2-KEYNUM PIC 9(5). IX1074.2 +015700T 10 FILLER PIC X(24). IX1074.2 +015800U 05 FILLER PIC X(24). IX1074.2 +015900 05 FILLER PIC X(83). IX1074.2 +016000 WORKING-STORAGE SECTION. IX1074.2 +016100 01 WRK-FS1-RECKEY. IX1074.2 +016200 03 WRK-DU-05V00-001 PIC 9(5) VALUE ZERO. IX1074.2 +016300T 03 WRK-XN-24V00-001 PIC X(24) VALUE IX1074.2 +016400T "123456789012345678901234". IX1074.2 +016500 01 WRK-FD2-RECKEY. IX1074.2 +016600 03 WRK-DU-05V00-002 PIC 9(5) VALUE ZERO. IX1074.2 +016700T 03 WRK-XN-24V00-002 PIC X(24) VALUE IX1074.2 +016800T "123456789012345678901234". IX1074.2 +016900 01 WRK-CS-09V00-001 PIC S9(9) COMP VALUE ZERO. IX1074.2 +017000 01 FS1-FILE-SIZE PIC 9(6) VALUE 750. IX1074.2 +017100 01 FD2-FILE-SIZE PIC 9(6) VALUE 649. IX1074.2 +017200 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. IX1074.2 +017300 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. IX1074.2 +017400 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1074.2 +017500 01 EOF-FLAG PICTURE 9 VALUE ZERO. IX1074.2 +017600 01 FILE-RECORD-INFORMATION-REC. IX1074.2 +017700 03 FILE-RECORD-INFO-SKELETON. IX1074.2 +017800 05 FILLER PICTURE X(48) VALUE IX1074.2 +017900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1074.2 +018000 05 FILLER PICTURE X(46) VALUE IX1074.2 +018100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1074.2 +018200 05 FILLER PICTURE X(26) VALUE IX1074.2 +018300 ",LFIL=000000,ORG= ,LBLR= ". IX1074.2 +018400 05 FILLER PICTURE X(37) VALUE IX1074.2 +018500 ",RECKEY= ". IX1074.2 +018600 05 FILLER PICTURE X(38) VALUE IX1074.2 +018700 ",ALTKEY1= ". IX1074.2 +018800 05 FILLER PICTURE X(38) VALUE IX1074.2 +018900 ",ALTKEY2= ". IX1074.2 +019000 05 FILLER PICTURE X(7) VALUE SPACE.IX1074.2 +019100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1074.2 +019200 05 FILE-RECORD-INFO-P1-120. IX1074.2 +019300 07 FILLER PIC X(5). IX1074.2 +019400 07 XFILE-NAME PIC X(6). IX1074.2 +019500 07 FILLER PIC X(8). IX1074.2 +019600 07 XRECORD-NAME PIC X(6). IX1074.2 +019700 07 FILLER PIC X(1). IX1074.2 +019800 07 REELUNIT-NUMBER PIC 9(1). IX1074.2 +019900 07 FILLER PIC X(7). IX1074.2 +020000 07 XRECORD-NUMBER PIC 9(6). IX1074.2 +020100 07 FILLER PIC X(6). IX1074.2 +020200 07 UPDATE-NUMBER PIC 9(2). IX1074.2 +020300 07 FILLER PIC X(5). IX1074.2 +020400 07 ODO-NUMBER PIC 9(4). IX1074.2 +020500 07 FILLER PIC X(5). IX1074.2 +020600 07 XPROGRAM-NAME PIC X(5). IX1074.2 +020700 07 FILLER PIC X(7). IX1074.2 +020800 07 XRECORD-LENGTH PIC 9(6). IX1074.2 +020900 07 FILLER PIC X(7). IX1074.2 +021000 07 CHARS-OR-RECORDS PIC X(2). IX1074.2 +021100 07 FILLER PIC X(1). IX1074.2 +021200 07 XBLOCK-SIZE PIC 9(4). IX1074.2 +021300 07 FILLER PIC X(6). IX1074.2 +021400 07 RECORDS-IN-FILE PIC 9(6). IX1074.2 +021500 07 FILLER PIC X(5). IX1074.2 +021600 07 XFILE-ORGANIZATION PIC X(2). IX1074.2 +021700 07 FILLER PIC X(6). IX1074.2 +021800 07 XLABEL-TYPE PIC X(1). IX1074.2 +021900 05 FILE-RECORD-INFO-P121-240. IX1074.2 +022000 07 FILLER PIC X(8). IX1074.2 +022100 07 XRECORD-KEY PIC X(29). IX1074.2 +022200 07 FILLER PIC X(9). IX1074.2 +022300 07 ALTERNATE-KEY1 PIC X(29). IX1074.2 +022400 07 FILLER PIC X(9). IX1074.2 +022500 07 ALTERNATE-KEY2 PIC X(29). IX1074.2 +022600 07 FILLER PIC X(7). IX1074.2 +022700 01 TEST-RESULTS. IX1074.2 +022800 02 FILLER PIC X VALUE SPACE. IX1074.2 +022900 02 FEATURE PIC X(20) VALUE SPACE. IX1074.2 +023000 02 FILLER PIC X VALUE SPACE. IX1074.2 +023100 02 P-OR-F PIC X(5) VALUE SPACE. IX1074.2 +023200 02 FILLER PIC X VALUE SPACE. IX1074.2 +023300 02 PAR-NAME. IX1074.2 +023400 03 FILLER PIC X(19) VALUE SPACE. IX1074.2 +023500 03 PARDOT-X PIC X VALUE SPACE. IX1074.2 +023600 03 DOTVALUE PIC 99 VALUE ZERO. IX1074.2 +023700 02 FILLER PIC X(8) VALUE SPACE. IX1074.2 +023800 02 RE-MARK PIC X(61). IX1074.2 +023900 01 TEST-COMPUTED. IX1074.2 +024000 02 FILLER PIC X(30) VALUE SPACE. IX1074.2 +024100 02 FILLER PIC X(17) VALUE IX1074.2 +024200 " COMPUTED=". IX1074.2 +024300 02 COMPUTED-X. IX1074.2 +024400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1074.2 +024500 03 COMPUTED-N REDEFINES COMPUTED-A IX1074.2 +024600 PIC -9(9).9(9). IX1074.2 +024700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1074.2 +024800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1074.2 +024900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1074.2 +025000 03 CM-18V0 REDEFINES COMPUTED-A. IX1074.2 +025100 04 COMPUTED-18V0 PIC -9(18). IX1074.2 +025200 04 FILLER PIC X. IX1074.2 +025300 03 FILLER PIC X(50) VALUE SPACE. IX1074.2 +025400 01 TEST-CORRECT. IX1074.2 +025500 02 FILLER PIC X(30) VALUE SPACE. IX1074.2 +025600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1074.2 +025700 02 CORRECT-X. IX1074.2 +025800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1074.2 +025900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1074.2 +026000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1074.2 +026100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1074.2 +026200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1074.2 +026300 03 CR-18V0 REDEFINES CORRECT-A. IX1074.2 +026400 04 CORRECT-18V0 PIC -9(18). IX1074.2 +026500 04 FILLER PIC X. IX1074.2 +026600 03 FILLER PIC X(2) VALUE SPACE. IX1074.2 +026700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1074.2 +026800 01 CCVS-C-1. IX1074.2 +026900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1074.2 +027000- "SS PARAGRAPH-NAME IX1074.2 +027100- " REMARKS". IX1074.2 +027200 02 FILLER PIC X(20) VALUE SPACE. IX1074.2 +027300 01 CCVS-C-2. IX1074.2 +027400 02 FILLER PIC X VALUE SPACE. IX1074.2 +027500 02 FILLER PIC X(6) VALUE "TESTED". IX1074.2 +027600 02 FILLER PIC X(15) VALUE SPACE. IX1074.2 +027700 02 FILLER PIC X(4) VALUE "FAIL". IX1074.2 +027800 02 FILLER PIC X(94) VALUE SPACE. IX1074.2 +027900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1074.2 +028000 01 REC-CT PIC 99 VALUE ZERO. IX1074.2 +028100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1074.2 +028600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1074.2 +028700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1074.2 +028800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1074.2 +028900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1074.2 +029000 01 CCVS-H-1. IX1074.2 +029100 02 FILLER PIC X(39) VALUE SPACES. IX1074.2 +029200 02 FILLER PIC X(42) VALUE IX1074.2 +029300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1074.2 +029400 02 FILLER PIC X(39) VALUE SPACES. IX1074.2 +029500 01 CCVS-H-2A. IX1074.2 +029600 02 FILLER PIC X(40) VALUE SPACE. IX1074.2 +029700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1074.2 +029800 02 FILLER PIC XXXX VALUE IX1074.2 +029900 "4.2 ". IX1074.2 +030000 02 FILLER PIC X(28) VALUE IX1074.2 +030100 " COPY - NOT FOR DISTRIBUTION". IX1074.2 +030200 02 FILLER PIC X(41) VALUE SPACE. IX1074.2 +030300 IX1074.2 +030400 01 CCVS-H-2B. IX1074.2 +030500 02 FILLER PIC X(15) VALUE IX1074.2 +030600 "TEST RESULT OF ". IX1074.2 +030700 02 TEST-ID PIC X(9). IX1074.2 +030800 02 FILLER PIC X(4) VALUE IX1074.2 +030900 " IN ". IX1074.2 +031000 02 FILLER PIC X(12) VALUE IX1074.2 +031100 " HIGH ". IX1074.2 +031200 02 FILLER PIC X(22) VALUE IX1074.2 +031300 " LEVEL VALIDATION FOR ". IX1074.2 +031400 02 FILLER PIC X(58) VALUE IX1074.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +031600 01 CCVS-H-3. IX1074.2 +031700 02 FILLER PIC X(34) VALUE IX1074.2 +031800 " FOR OFFICIAL USE ONLY ". IX1074.2 +031900 02 FILLER PIC X(58) VALUE IX1074.2 +032000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1074.2 +032100 02 FILLER PIC X(28) VALUE IX1074.2 +032200 " COPYRIGHT 1985 ". IX1074.2 +032300 01 CCVS-E-1. IX1074.2 +032400 02 FILLER PIC X(52) VALUE SPACE. IX1074.2 +032500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1074.2 +032600 02 ID-AGAIN PIC X(9). IX1074.2 +032700 02 FILLER PIC X(45) VALUE SPACES. IX1074.2 +032800 01 CCVS-E-2. IX1074.2 +032900 02 FILLER PIC X(31) VALUE SPACE. IX1074.2 +033000 02 FILLER PIC X(21) VALUE SPACE. IX1074.2 +033100 02 CCVS-E-2-2. IX1074.2 +033200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1074.2 +033300 03 FILLER PIC X VALUE SPACE. IX1074.2 +033400 03 ENDER-DESC PIC X(44) VALUE IX1074.2 +033500 "ERRORS ENCOUNTERED". IX1074.2 +033600 01 CCVS-E-3. IX1074.2 +033700 02 FILLER PIC X(22) VALUE IX1074.2 +033800 " FOR OFFICIAL USE ONLY". IX1074.2 +033900 02 FILLER PIC X(12) VALUE SPACE. IX1074.2 +034000 02 FILLER PIC X(58) VALUE IX1074.2 +034100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +034200 02 FILLER PIC X(13) VALUE SPACE. IX1074.2 +034300 02 FILLER PIC X(15) VALUE IX1074.2 +034400 " COPYRIGHT 1985". IX1074.2 +034500 01 CCVS-E-4. IX1074.2 +034600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1074.2 +034700 02 FILLER PIC X(4) VALUE " OF ". IX1074.2 +034800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1074.2 +034900 02 FILLER PIC X(40) VALUE IX1074.2 +035000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1074.2 +035100 01 XXINFO. IX1074.2 +035200 02 FILLER PIC X(19) VALUE IX1074.2 +035300 "*** INFORMATION ***". IX1074.2 +035400 02 INFO-TEXT. IX1074.2 +035500 04 FILLER PIC X(8) VALUE SPACE. IX1074.2 +035600 04 XXCOMPUTED PIC X(20). IX1074.2 +035700 04 FILLER PIC X(5) VALUE SPACE. IX1074.2 +035800 04 XXCORRECT PIC X(20). IX1074.2 +035900 02 INF-ANSI-REFERENCE PIC X(48). IX1074.2 +036000 01 HYPHEN-LINE. IX1074.2 +036100 02 FILLER PIC IS X VALUE IS SPACE. IX1074.2 +036200 02 FILLER PIC IS X(65) VALUE IS "************************IX1074.2 +036300- "*****************************************". IX1074.2 +036400 02 FILLER PIC IS X(54) VALUE IS "************************IX1074.2 +036500- "******************************". IX1074.2 +036600 01 CCVS-PGM-ID PIC X(9) VALUE IX1074.2 +036700 "IX107A". IX1074.2 +036800 PROCEDURE DIVISION. IX1074.2 +036900 CCVS1 SECTION. IX1074.2 +037000 OPEN-FILES. IX1074.2 +037100P OPEN I-O RAW-DATA. IX1074.2 +037200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1074.2 +037300P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1074.2 +037400P MOVE "ABORTED " TO C-ABORT. IX1074.2 +037500P ADD 1 TO C-NO-OF-TESTS. IX1074.2 +037600P ACCEPT C-DATE FROM DATE. IX1074.2 +037700P ACCEPT C-TIME FROM TIME. IX1074.2 +037800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1074.2 +037900PEND-E-1. IX1074.2 +038000P CLOSE RAW-DATA. IX1074.2 +038100 OPEN OUTPUT PRINT-FILE. IX1074.2 +038200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1074.2 +038300 MOVE SPACE TO TEST-RESULTS. IX1074.2 +038400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1074.2 +038500 MOVE ZERO TO REC-SKL-SUB. IX1074.2 +038600 PERFORM CCVS-INIT-FILE 9 TIMES. IX1074.2 +038700 CCVS-INIT-FILE. IX1074.2 +038800 ADD 1 TO REC-SKL-SUB. IX1074.2 +038900 MOVE FILE-RECORD-INFO-SKELETON IX1074.2 +039000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1074.2 +039100 CCVS-INIT-EXIT. IX1074.2 +039200 GO TO CCVS1-EXIT. IX1074.2 +039300 CLOSE-FILES. IX1074.2 +039400P OPEN I-O RAW-DATA. IX1074.2 +039500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1074.2 +039600P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1074.2 +039700P MOVE "OK. " TO C-ABORT. IX1074.2 +039800P MOVE PASS-COUNTER TO C-OK. IX1074.2 +039900P MOVE ERROR-HOLD TO C-ALL. IX1074.2 +040000P MOVE ERROR-COUNTER TO C-FAIL. IX1074.2 +040100P MOVE DELETE-COUNTER TO C-DELETED. IX1074.2 +040200P MOVE INSPECT-COUNTER TO C-INSPECT. IX1074.2 +040300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1074.2 +040400PEND-E-2. IX1074.2 +040500P CLOSE RAW-DATA. IX1074.2 +040600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1074.2 +040700 TERMINATE-CCVS. IX1074.2 +040800S EXIT PROGRAM. IX1074.2 +040900STERMINATE-CALL. IX1074.2 +041000 STOP RUN. IX1074.2 +041100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1074.2 +041200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1074.2 +041300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1074.2 +041400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1074.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. IX1074.2 +041600 PRINT-DETAIL. IX1074.2 +041700 IF REC-CT NOT EQUAL TO ZERO IX1074.2 +041800 MOVE "." TO PARDOT-X IX1074.2 +041900 MOVE REC-CT TO DOTVALUE. IX1074.2 +042000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1074.2 +042100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1074.2 +042200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1074.2 +042300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1074.2 +042400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1074.2 +042500 MOVE SPACE TO CORRECT-X. IX1074.2 +042600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1074.2 +042700 MOVE SPACE TO RE-MARK. IX1074.2 +042800 HEAD-ROUTINE. IX1074.2 +042900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1074.2 +043200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1074.2 +043300 COLUMN-NAMES-ROUTINE. IX1074.2 +043400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +043500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +043700 END-ROUTINE. IX1074.2 +043800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1074.2 +043900 END-RTN-EXIT. IX1074.2 +044000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +044100 END-ROUTINE-1. IX1074.2 +044200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1074.2 +044300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1074.2 +044400 ADD PASS-COUNTER TO ERROR-HOLD. IX1074.2 +044500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1074.2 +044600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1074.2 +044700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1074.2 +044800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1074.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1074.2 +045000 END-ROUTINE-12. IX1074.2 +045100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1074.2 +045200 IF ERROR-COUNTER IS EQUAL TO ZERO IX1074.2 +045300 MOVE "NO " TO ERROR-TOTAL IX1074.2 +045400 ELSE IX1074.2 +045500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1074.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1074.2 +045700 PERFORM WRITE-LINE. IX1074.2 +045800 END-ROUTINE-13. IX1074.2 +045900 IF DELETE-COUNTER IS EQUAL TO ZERO IX1074.2 +046000 MOVE "NO " TO ERROR-TOTAL ELSE IX1074.2 +046100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1074.2 +046200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1074.2 +046300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +046400 IF INSPECT-COUNTER EQUAL TO ZERO IX1074.2 +046500 MOVE "NO " TO ERROR-TOTAL IX1074.2 +046600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1074.2 +046700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1074.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +046900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +047000 WRITE-LINE. IX1074.2 +047100 ADD 1 TO RECORD-COUNT. IX1074.2 +047200Y IF RECORD-COUNT GREATER 42 IX1074.2 +047300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1074.2 +047400Y MOVE SPACE TO DUMMY-RECORD IX1074.2 +047500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1074.2 +047600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1074.2 +047700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1074.2 +047800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1074.2 +047900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1074.2 +048000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1074.2 +048400Y MOVE ZERO TO RECORD-COUNT. IX1074.2 +048500 PERFORM WRT-LN. IX1074.2 +048600 WRT-LN. IX1074.2 +048700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1074.2 +048800 MOVE SPACE TO DUMMY-RECORD. IX1074.2 +048900 BLANK-LINE-PRINT. IX1074.2 +049000 PERFORM WRT-LN. IX1074.2 +049100 FAIL-ROUTINE. IX1074.2 +049200 IF COMPUTED-X NOT EQUAL TO SPACE IX1074.2 +049300 GO TO FAIL-ROUTINE-WRITE. IX1074.2 +049400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1074.2 +049500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1074.2 +049600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1074.2 +049700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +049800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1074.2 +049900 GO TO FAIL-ROUTINE-EX. IX1074.2 +050000 FAIL-ROUTINE-WRITE. IX1074.2 +050100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1074.2 +050200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1074.2 +050300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1074.2 +050400 MOVE SPACES TO COR-ANSI-REFERENCE. IX1074.2 +050500 FAIL-ROUTINE-EX. EXIT. IX1074.2 +050600 BAIL-OUT. IX1074.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1074.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1074.2 +050900 BAIL-OUT-WRITE. IX1074.2 +051000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1074.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1074.2 +051200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +051300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1074.2 +051400 BAIL-OUT-EX. EXIT. IX1074.2 +051500 CCVS1-EXIT. IX1074.2 +051600 EXIT. IX1074.2 +051700 SECT-IX107A-001 SECTION. IX1074.2 +051800 WRITE-INIT-GF-01. IX1074.2 +051900 OPEN OUTPUT IX-FS1. IX1074.2 +052000 MOVE ZERO TO WRK-CS-09V00-001. IX1074.2 +052100 MOVE ZERO TO WRK-DU-05V00-001. IX1074.2 +052200 MOVE "IX-FS1" TO XFILE-NAME (1). IX1074.2 +052300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1074.2 +052400 MOVE 00001 TO XRECORD-NUMBER (1). IX1074.2 +052500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1074.2 +052600 MOVE 750 TO RECORDS-IN-FILE (1). IX1074.2 +052700 MOVE 240 TO XRECORD-LENGTH (1). IX1074.2 +052800 MOVE 0001 TO XBLOCK-SIZE (1). IX1074.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1074.2 +053000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1074.2 +053100 MOVE "S" TO XLABEL-TYPE (1). IX1074.2 +053200 MOVE "FILE CREATED" TO RE-MARK. IX1074.2 +053300 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1074.2 +053400 MOVE "WRITE SEQUENTIAL" TO FEATURE. IX1074.2 +053500 MOVE ZERO TO REC-CT. IX1074.2 +053600 WRITE-TEST-GF-01-R. IX1074.2 +053700 MOVE XRECORD-NUMBER (1) TO WRK-DU-05V00-001. IX1074.2 +053800 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX1074.2 +053900 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1074.2 +054000 WRITE IX-FS1R1-F-G-240 IX1074.2 +054100 INVALID KEY GO TO WRITE-TEST-GF-01-1. IX1074.2 +054200 IF XRECORD-NUMBER (1) NOT LESS THAN FS1-FILE-SIZE IX1074.2 +054300 GO TO WRITE-TEST-GF-01-1. IX1074.2 +054400 ADD 0001 TO XRECORD-NUMBER (1). IX1074.2 +054500 GO TO WRITE-TEST-GF-01-R. IX1074.2 +054600 WRITE-TEST-GF-01-1. IX1074.2 +054700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX1074.2 +054800 MOVE FS1-FILE-SIZE TO CORRECT-18V0. IX1074.2 +054900 IF XRECORD-NUMBER (1) EQUAL TO FS1-FILE-SIZE IX1074.2 +055000 PERFORM PASS IX1074.2 +055100 ELSE IX1074.2 +055200 MOVE "IX-41 4.9.2 " TO RE-MARK IX1074.2 +055300 PERFORM FAIL. IX1074.2 +055400 PERFORM PRINT-DETAIL. IX1074.2 +055500 CLOSE IX-FS1. IX1074.2 +055600 READ-INIT-F1-01. IX1074.2 +055700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +055800* THIS TEST READS AND CHECKS THE FILE CREATED IN IX1074.2 +055900* READ-TEST-001. IX1074.2 +056000 OPEN INPUT IX-FS1. IX1074.2 +056100 READ-TEST-F1-01. IX1074.2 +056200 READ IX-FS1 IX1074.2 +056300 AT END GO TO READ-TEST-F1-01-1. IX1074.2 +056400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1074.2 +056500 ADD 1 TO WRK-CS-09V00. IX1074.2 +056600 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +056700 MOVE "MORE THAN 750 RECORDS" TO RE-MARK IX1074.2 +056800 GO TO READ-FAIL-F1-01. IX1074.2 +056900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IX1074.2 +057000 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +057100 GO TO READ-TEST-F1-01. IX1074.2 +057200 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS1" IX1074.2 +057300 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +057400 GO TO READ-TEST-F1-01. IX1074.2 +057500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IX1074.2 +057600 ADD 1 TO RECORDS-IN-ERROR. IX1074.2 +057700 GO TO READ-TEST-F1-01. IX1074.2 +057800 READ-TEST-F1-01-1. IX1074.2 +057900 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1074.2 +058000 GO TO READ-PASS-F1-01. IX1074.2 +058100 MOVE "ERRORS IN READING IX-FS1" TO RE-MARK. IX1074.2 +058200 READ-FAIL-F1-01. IX1074.2 +058300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1074.2 +058400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1074.2 +058500 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +058600 PERFORM FAIL. IX1074.2 +058700 GO TO READ-WRITE-F1-01. IX1074.2 +058800 READ-PASS-F1-01. IX1074.2 +058900 PERFORM PASS. IX1074.2 +059000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1074.2 +059100 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +059200 READ-WRITE-F1-01. IX1074.2 +059300 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1074.2 +059400 MOVE "READ TO VERIFY " TO FEATURE. IX1074.2 +059500 PERFORM PRINT-DETAIL. IX1074.2 +059600 READ-CLOSE-F1-01. IX1074.2 +059700 CLOSE IX-FS1. IX1074.2 +059800 READ-INIT-F1-02. IX1074.2 +059900 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +060000 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +060100 OPEN INPUT IX-FS1. IX1074.2 +060200* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED IX1074.2 +060300* IN THIS SERIES OF TESTS. IX1074.2 +060400 MOVE "READ...RECORD AT END ..." TO FEATURE. IX1074.2 +060500 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX1074.2 +060600 MOVE ZERO TO ERROR-FLAG. IX1074.2 +060700 READ-TEST-F1-02. IX1074.2 +060800 READ IX-FS1 RECORD AT END IX1074.2 +060900 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +061000 MOVE 1 TO EOF-FLAG IX1074.2 +061100 GO TO READ-FAIL-F1-02. IX1074.2 +061200 PERFORM RECORD-CHECK. IX1074.2 +061300 IF WRK-CS-09V00 EQUAL TO 200 IX1074.2 +061400 GO TO READ-TEST-F1-02-1. IX1074.2 +061500 GO TO READ-TEST-F1-02. IX1074.2 +061600 RECORD-CHECK. IX1074.2 +061700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1074.2 +061800 ADD 1 TO WRK-CS-09V00. IX1074.2 +061900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IX1074.2 +062000 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +062100 MOVE 1 TO ERROR-FLAG. IX1074.2 +062200 READ-TEST-F1-02-1. IX1074.2 +062300 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +062400 GO TO READ-PASS-F1-02. IX1074.2 +062500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +062600 READ-FAIL-F1-02. IX1074.2 +062700 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +062800 PERFORM FAIL. IX1074.2 +062900 GO TO READ-WRITE-F1-02. IX1074.2 +063000 READ-PASS-F1-02. IX1074.2 +063100 PERFORM PASS. IX1074.2 +063200 READ-WRITE-F1-02. IX1074.2 +063300 PERFORM PRINT-DETAIL. IX1074.2 +063400 READ-INIT-F1-03. IX1074.2 +063500 IF EOF-FLAG EQUAL TO 1 IX1074.2 +063600 GO TO READ-EOF-F1-06. IX1074.2 +063700 MOVE ZERO TO ERROR-FLAG. IX1074.2 +063800 MOVE "READ...AT END..." TO FEATURE. IX1074.2 +063900 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX1074.2 +064000 READ-TEST-F1-03. IX1074.2 +064100 READ IX-FS1 AT END IX1074.2 +064200 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +064300 MOVE 1 TO EOF-FLAG IX1074.2 +064400 GO TO READ-FAIL-F1-03. IX1074.2 +064500 PERFORM RECORD-CHECK. IX1074.2 +064600 IF WRK-CS-09V00 EQUAL TO 400 IX1074.2 +064700 GO TO READ-TEST-F1-03-1. IX1074.2 +064800 GO TO READ-TEST-F1-03. IX1074.2 +064900 READ-TEST-F1-03-1. IX1074.2 +065000 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +065100 GO TO READ-PASS-F1-03. IX1074.2 +065200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +065300 READ-FAIL-F1-03. IX1074.2 +065400 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +065500 PERFORM FAIL. IX1074.2 +065600 GO TO READ-WRITE-F1-03. IX1074.2 +065700 READ-PASS-F1-03. IX1074.2 +065800 PERFORM PASS. IX1074.2 +065900 READ-WRITE-F1-03. IX1074.2 +066000 PERFORM PRINT-DETAIL. IX1074.2 +066100 READ-INIT-F1-04. IX1074.2 +066200 IF EOF-FLAG EQUAL TO 1 IX1074.2 +066300 GO TO READ-EOF-F1-06. IX1074.2 +066400 MOVE ZERO TO ERROR-FLAG. IX1074.2 +066500 MOVE "READ...RECORD END..." TO FEATURE. IX1074.2 +066600 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX1074.2 +066700 READ-TEST-F1-04. IX1074.2 +066800 READ IX-FS1 RECORD END IX1074.2 +066900 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +067000 MOVE 1 TO EOF-FLAG IX1074.2 +067100 GO TO READ-FAIL-F1-04. IX1074.2 +067200 PERFORM RECORD-CHECK. IX1074.2 +067300 IF WRK-CS-09V00 EQUAL TO 600 IX1074.2 +067400 GO TO READ-TEST-F1-04-1. IX1074.2 +067500 GO TO READ-TEST-F1-04. IX1074.2 +067600 READ-TEST-F1-04-1. IX1074.2 +067700 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +067800 GO TO READ-PASS-F1-04. IX1074.2 +067900 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +068000 READ-FAIL-F1-04. IX1074.2 +068100 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +068200 PERFORM FAIL. IX1074.2 +068300 GO TO READ-WRITE-F1-04. IX1074.2 +068400 READ-PASS-F1-04. IX1074.2 +068500 PERFORM PASS. IX1074.2 +068600 READ-WRITE-F1-04. IX1074.2 +068700 PERFORM PRINT-DETAIL. IX1074.2 +068800 READ-INIT-F1-05. IX1074.2 +068900 IF EOF-FLAG EQUAL TO 1 IX1074.2 +069000 GO TO READ-EOF-F1-06. IX1074.2 +069100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +069200 MOVE "READ...END..." TO RE-MARK. IX1074.2 +069300 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX1074.2 +069400 READ-TEST-F1-05. IX1074.2 +069500 READ IX-FS1 END GO TO READ-TEST-F1-05-1. IX1074.2 +069600 PERFORM RECORD-CHECK. IX1074.2 +069700 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +069800 GO TO READ-TEST-F1-05-1. IX1074.2 +069900 GO TO READ-TEST-F1-05. IX1074.2 +070000 READ-TEST-F1-05-1. IX1074.2 +070100 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +070200 GO TO READ-PASS-F1-05. IX1074.2 +070300 READ-FAIL-F1-05. IX1074.2 +070400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +070500 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +070600 PERFORM FAIL. IX1074.2 +070700 GO TO READ-WRITE-F1-05. IX1074.2 +070800 READ-PASS-F1-05. IX1074.2 +070900 PERFORM PASS. IX1074.2 +071000 READ-WRITE-F1-05. IX1074.2 +071100 PERFORM PRINT-DETAIL. IX1074.2 +071200 READ-TEST-F1-06. IX1074.2 +071300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO IX1074.2 +071400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A IX1074.2 +071500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 IX1074.2 +071600 GO TO READ-FAIL-F1-06. IX1074.2 +071700 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +071800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK IX1074.2 +071900 GO TO READ-FAIL-F1-06. IX1074.2 +072000 READ-PASS-F1-06. IX1074.2 +072100 PERFORM PASS. IX1074.2 +072200 GO TO READ-WRITE-F1-06. IX1074.2 +072300 READ-EOF-F1-06. IX1074.2 +072400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. IX1074.2 +072500 MOVE "RECORDS READ =" TO COMPUTED-A. IX1074.2 +072600 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +072700 READ-FAIL-F1-06. IX1074.2 +072800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +072900 PERFORM FAIL. IX1074.2 +073000 READ-WRITE-F1-06. IX1074.2 +073100 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX1074.2 +073200 MOVE "READ IX-FS1 750R" TO FEATURE. IX1074.2 +073300 PERFORM PRINT-DETAIL. IX1074.2 +073400 READ-CLOSE-F1-06. IX1074.2 +073500 CLOSE IX-FS1. IX1074.2 +073600 SECT-IX107A-002 SECTION. IX1074.2 +073700 WRITE-INIT-GF-02. IX1074.2 +073800 OPEN OUTPUT IX-FD2. IX1074.2 +073900 MOVE ZERO TO WRK-CS-09V00-001. IX1074.2 +074000 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +074100 MOVE "IX-FD2" TO XFILE-NAME (2). IX1074.2 +074200 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1074.2 +074300 MOVE 00001 TO XRECORD-NUMBER (2). IX1074.2 +074400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1074.2 +074500 MOVE 649 TO RECORDS-IN-FILE (2). IX1074.2 +074600 MOVE 240 TO XRECORD-LENGTH (2). IX1074.2 +074700 MOVE 0005 TO XBLOCK-SIZE (2). IX1074.2 +074800 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1074.2 +074900 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1074.2 +075000 MOVE "S" TO XLABEL-TYPE (2). IX1074.2 +075100 MOVE "FILE CREATED" TO RE-MARK. IX1074.2 +075200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1074.2 +075300 MOVE "WRITE RANDOM MODE" TO FEATURE. IX1074.2 +075400 MOVE ZERO TO REC-CT. IX1074.2 +075500 WRITE-TEST-GF-02-R. IX1074.2 +075600 MOVE XRECORD-NUMBER (2) TO WRK-DU-05V00-002. IX1074.2 +075700 MOVE WRK-FD2-RECKEY TO XRECORD-KEY (2). IX1074.2 +075800 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX1074.2 +075900 WRITE IX-FD2R1-F-G-240 IX1074.2 +076000 INVALID KEY GO TO WRITE-TEST-GF-02-1. IX1074.2 +076100 IF XRECORD-NUMBER (2) NOT LESS THAN FD2-FILE-SIZE IX1074.2 +076200 GO TO WRITE-TEST-GF-02-1. IX1074.2 +076300 ADD 0001 TO XRECORD-NUMBER (2). IX1074.2 +076400 GO TO WRITE-TEST-GF-02-R. IX1074.2 +076500 WRITE-TEST-GF-02-1. IX1074.2 +076600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX1074.2 +076700 MOVE FD2-FILE-SIZE TO CORRECT-18V0. IX1074.2 +076800 IF XRECORD-NUMBER (2) EQUAL TO FD2-FILE-SIZE IX1074.2 +076900 PERFORM PASS IX1074.2 +077000 ELSE IX1074.2 +077100 MOVE "IX-41 4.9.2 " TO RE-MARK IX1074.2 +077200 PERFORM FAIL. IX1074.2 +077300 PERFORM PRINT-DETAIL. IX1074.2 +077400 CLOSE IX-FD2. IX1074.2 +077500 READ-INIT-F2-07. IX1074.2 +077600 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +077700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +077800 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +077900* THIS TEST READS AND CHECKS THE FILE CREATED IN IX1074.2 +078000* READ-TEST-GF-02. IX1074.2 +078100 OPEN INPUT IX-FD2. IX1074.2 +078200 READ-TEST-F2-07. IX1074.2 +078300 ADD 00001 TO WRK-DU-05V00-002. IX1074.2 +078400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +078500 READ IX-FD2 RECORD IX1074.2 +078600 INVALID KEY GO TO READ-TEST-F2-07-1. IX1074.2 +078700 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1074.2 +078800 ADD 1 TO WRK-CS-09V00. IX1074.2 +078900 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +079000 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IX1074.2 +079100 GO TO READ-FAIL-F2-07. IX1074.2 +079200 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) IX1074.2 +079300 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +079400 GO TO READ-TEST-F2-07. IX1074.2 +079500 IF XFILE-NAME (2) NOT EQUAL TO "IX-FD2" IX1074.2 +079600 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +079700 GO TO READ-TEST-F2-07. IX1074.2 +079800 IF XLABEL-TYPE (2) NOT EQUAL TO "S" IX1074.2 +079900 ADD 1 TO RECORDS-IN-ERROR. IX1074.2 +080000 GO TO READ-TEST-F2-07. IX1074.2 +080100 READ-TEST-F2-07-1. IX1074.2 +080200 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1074.2 +080300 GO TO READ-PASS-F2-07. IX1074.2 +080400 MOVE "ERRORS IN READING IX-FD2" TO RE-MARK. IX1074.2 +080500 READ-FAIL-F2-07. IX1074.2 +080600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1074.2 +080700 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +080800 PERFORM FAIL. IX1074.2 +080900 GO TO READ-READ-F2-07. IX1074.2 +081000 READ-PASS-F2-07. IX1074.2 +081100 PERFORM PASS. IX1074.2 +081200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1074.2 +081300 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +081400 READ-READ-F2-07. IX1074.2 +081500 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX1074.2 +081600 MOVE "VERIFY FILE IX-FD2" TO FEATURE. IX1074.2 +081700 PERFORM PRINT-DETAIL. IX1074.2 +081800 READ-CLOSE-F2-07. IX1074.2 +081900 CLOSE IX-FD2. IX1074.2 +082000 READ-INIT-F2-08. IX1074.2 +082100 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +082200 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +082300 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +082400 OPEN INPUT IX-FD2. IX1074.2 +082500* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED IX1074.2 +082600* IN THIS SERIES OF TESTS. IX1074.2 +082700 MOVE "LEV 1 READ STATEMENT" TO FEATURE. IX1074.2 +082800 MOVE ZERO TO EOF-FLAG. IX1074.2 +082900 MOVE "READ...RECORD INVALID KEY ..." TO FEATURE. IX1074.2 +083000 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX1074.2 +083100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +083200 READ-TEST-F2-08. IX1074.2 +083300 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +083400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +083500 READ IX-FD2 RECORD IX1074.2 +083600 INVALID KEY MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +083700 MOVE 1 TO EOF-FLAG IX1074.2 +083800 GO TO READ-FAIL-F2-08. IX1074.2 +083900 PERFORM RECORD-CHECK-1. IX1074.2 +084000 IF WRK-CS-09V00 EQUAL TO 50 IX1074.2 +084100 GO TO READ-TEST-F2-08-1. IX1074.2 +084200 GO TO READ-TEST-F2-08. IX1074.2 +084300 RECORD-CHECK-1. IX1074.2 +084400 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1074.2 +084500 ADD 1 TO WRK-CS-09V00. IX1074.2 +084600 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) IX1074.2 +084700 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +084800 MOVE 1 TO ERROR-FLAG. IX1074.2 +084900 READ-TEST-F2-08-1. IX1074.2 +085000 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +085100 GO TO READ-PASS-F2-08. IX1074.2 +085200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +085300 READ-FAIL-F2-08. IX1074.2 +085400 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +085500 PERFORM FAIL. IX1074.2 +085600 GO TO READ-WRITE-F2-08. IX1074.2 +085700 READ-PASS-F2-08. IX1074.2 +085800 PERFORM PASS. IX1074.2 +085900 READ-WRITE-F2-08. IX1074.2 +086000 PERFORM PRINT-DETAIL. IX1074.2 +086100 READ-INIT-F2-09. IX1074.2 +086200 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +086300 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +086400 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +086500 IF EOF-FLAG EQUAL TO 1 IX1074.2 +086600 GO TO READ-EOF-F2-12. IX1074.2 +086700 MOVE ZERO TO ERROR-FLAG. IX1074.2 +086800 MOVE "READ...INVALID KEY..." TO FEATURE. IX1074.2 +086900 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX1074.2 +087000 READ-TEST-F2-09. IX1074.2 +087100 ADD 00001 TO WRK-DU-05V00-002. IX1074.2 +087200 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +087300 READ IX-FD2 INVALID KEY IX1074.2 +087400 MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +087500 MOVE 1 TO EOF-FLAG IX1074.2 +087600 GO TO READ-FAIL-F2-09. IX1074.2 +087700 PERFORM RECORD-CHECK-1. IX1074.2 +087800 IF WRK-CS-09V00 EQUAL TO 200 IX1074.2 +087900 GO TO READ-TEST-F2-09-1. IX1074.2 +088000 GO TO READ-TEST-F2-09. IX1074.2 +088100 READ-TEST-F2-09-1. IX1074.2 +088200 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +088300 GO TO READ-PASS-F2-09. IX1074.2 +088400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +088500 READ-FAIL-F2-09. IX1074.2 +088600 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +088700 PERFORM FAIL. IX1074.2 +088800 GO TO READ-WRITE-F2-09. IX1074.2 +088900 READ-PASS-F2-09. IX1074.2 +089000 PERFORM PASS. IX1074.2 +089100 READ-WRITE-F2-09. IX1074.2 +089200 PERFORM PRINT-DETAIL. IX1074.2 +089300 READ-INIT-F2-10. IX1074.2 +089400 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +089500 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +089600 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +089700 IF EOF-FLAG EQUAL TO 1 IX1074.2 +089800 GO TO READ-EOF-F2-12. IX1074.2 +089900 MOVE ZERO TO ERROR-FLAG. IX1074.2 +090000 MOVE "READ...RECORD INVALID..." TO FEATURE. IX1074.2 +090100 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX1074.2 +090200 READ-TEST-F2-10. IX1074.2 +090300 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +090400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +090500 READ IX-FD2 RECORD INVALID IX1074.2 +090600 MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +090700 MOVE 1 TO EOF-FLAG IX1074.2 +090800 GO TO READ-FAIL-F2-10. IX1074.2 +090900 PERFORM RECORD-CHECK-1. IX1074.2 +091000 IF WRK-CS-09V00 EQUAL TO 499 IX1074.2 +091100 GO TO READ-TEST-F2-10-1. IX1074.2 +091200 GO TO READ-TEST-F2-10. IX1074.2 +091300 READ-TEST-F2-10-1. IX1074.2 +091400 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +091500 GO TO READ-PASS-F2-10. IX1074.2 +091600 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +091700 READ-FAIL-F2-10. IX1074.2 +091800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +091900 PERFORM FAIL. IX1074.2 +092000 GO TO READ-WRITE-F2-10. IX1074.2 +092100 READ-PASS-F2-10. IX1074.2 +092200 PERFORM PASS. IX1074.2 +092300 READ-WRITE-F2-10. IX1074.2 +092400 PERFORM PRINT-DETAIL. IX1074.2 +092500 READ-INIT-F2-11. IX1074.2 +092600 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +092700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +092800 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +092900 IF EOF-FLAG EQUAL TO 1 IX1074.2 +093000 GO TO READ-EOF-F2-12. IX1074.2 +093100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +093200 MOVE "READ...INVALID..." TO FEATURE. IX1074.2 +093300 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX1074.2 +093400 READ-TEST-F2-11. IX1074.2 +093500 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +093600 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +093700 READ IX-FD2 INVALID IX1074.2 +093800 GO TO READ-TEST-F2-11-1. IX1074.2 +093900 PERFORM RECORD-CHECK-1. IX1074.2 +094000 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +094100 GO TO READ-TEST-F2-11-1. IX1074.2 +094200 GO TO READ-TEST-F2-11. IX1074.2 +094300 READ-TEST-F2-11-1. IX1074.2 +094400 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +094500 GO TO READ-PASS-F2-11. IX1074.2 +094600 READ-FAIL-F2-11. IX1074.2 +094700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +094800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +094900 PERFORM FAIL. IX1074.2 +095000 GO TO READ-WRITE-F2-11. IX1074.2 +095100 READ-PASS-F2-11. IX1074.2 +095200 PERFORM PASS. IX1074.2 +095300 READ-WRITE-F2-11. IX1074.2 +095400 PERFORM PRINT-DETAIL. IX1074.2 +095500 READ-TEST-F2-12. IX1074.2 +095600 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO IX1074.2 +095700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A IX1074.2 +095800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 IX1074.2 +095900 GO TO READ-FAIL-F2-12. IX1074.2 +096000 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +096100 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IX1074.2 +096200 GO TO READ-FAIL-F2-12. IX1074.2 +096300 READ-PASS-F2-12. IX1074.2 +096400 PERFORM PASS IX1074.2 +096500 GO TO READ-WRITE-F2-12. IX1074.2 +096600 READ-EOF-F2-12. IX1074.2 +096700 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. IX1074.2 +096800 MOVE "RECORDS READ =" TO COMPUTED-A. IX1074.2 +096900 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +097000 READ-FAIL-F2-12. IX1074.2 +097100 PERFORM FAIL. IX1074.2 +097200 READ-WRITE-F2-12. IX1074.2 +097300 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX1074.2 +097400 MOVE "READ IX-FS2 VERIFY" TO FEATURE. IX1074.2 +097500 PERFORM PRINT-DETAIL. IX1074.2 +097600 READ-CLOSE-F2-12. IX1074.2 +097700 CLOSE IX-FD2. IX1074.2 +097800 TERMINATE-ROUTINE. IX1074.2 +097900 EXIT. IX1074.2 +098000 CCVS-EXIT SECTION. IX1074.2 +098100 CCVS-999999. IX1074.2 +098200 GO TO CLOSE-FILES. IX1074.2 +*END-OF,IX107A +*HEADER,COBOL,IX108A +000100 IDENTIFICATION DIVISION. IX1084.2 +000200 PROGRAM-ID. IX1084.2 +000300 IX108A. IX1084.2 +000400**************************************************************** IX1084.2 +000500* * IX1084.2 +000600* VALIDATION FOR:- * IX1084.2 +000700* * IX1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +000900* * IX1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1084.2 +001100* * IX1084.2 +001200**************************************************************** IX1084.2 +001300* IX1084.2 +001400* NEW TESTS: IX1084.2 +001500* IX1084.2 +001600* READ STATEMENT WITH THE PHRASES: IX1084.2 +001700* READ ... NOT AT END AND END-READ IX1084.2 +001800* FOR FORMAT 1 AND 2 OF THE READ STATEMENT IX1084.2 +001900* IX1084.2 +002000* DELETE STATEMENT WITH THE PHRASES: IX1084.2 +002100* DELETE ... NOT INVALID AND END-DELETE IX1084.2 +002200* IX1084.2 +002300* REWRITE STATEMENT WITH THE PHRASES: IX1084.2 +002400* REWRITE ... NOT INVALID KEY AND END-REWRITE IX1084.2 +002500* IX1084.2 +002600* WRITE STATEMENT WITH THE PHRASES: IX1084.2 +002700* WRITE ... NOT INVALID KEY AND END-WRITE IX1084.2 +002800* IX1084.2 +002900* IX1084.2 +003000* IX1084.2 +003100* IX1084.2 +003200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1084.2 +003300* IX1084.2 +003400* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003500* CLAUSE FOR DATA FILE IX-FD1 IX1084.2 +003600* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003700* CLAUSE FOR INDEX FILE IX-FD1 IX1084.2 +003800* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003900* CLAUSE FOR DATA FILE IX-FD2 IX1084.2 +004000* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +004100* CLAUSE FOR INDEX FILE IX-FD2 IX1084.2 +004200* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1084.2 +004300* X-62 FOR RAW-DATA IX1084.2 +004400* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1084.2 +004500* X-84 LABEL RECORDS OF PRINT-FILE IX1084.2 +004600* IX1084.2 +004700* NOTE: X-CARDS 45, 62 AND 84 ARE OPTIONAL IX1084.2 +004800* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1084.2 +004900* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1084.2 +005000* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1084.2 +005100* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1084.2 +005200* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1084.2 +005300* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1084.2 +005400* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1084.2 +005500* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1084.2 +005600* THEY ARE AS FOLLOWS IX1084.2 +005700* IX1084.2 +005800* J SELECTS X-CARD 45 IX1084.2 +005900* IX1084.2 +006000****************************************************** IX1084.2 +006100 ENVIRONMENT DIVISION. IX1084.2 +006200 CONFIGURATION SECTION. IX1084.2 +006300 SOURCE-COMPUTER. IX1084.2 +006400 XXXXX082. IX1084.2 +006500 OBJECT-COMPUTER. IX1084.2 +006600 XXXXX083. IX1084.2 +006700 INPUT-OUTPUT SECTION. IX1084.2 +006800 FILE-CONTROL. IX1084.2 +006900P SELECT RAW-DATA ASSIGN TO IX1084.2 +007000P XXXXX062 IX1084.2 +007100P ORGANIZATION IS INDEXED IX1084.2 +007200P ACCESS MODE IS RANDOM IX1084.2 +007300P RECORD KEY IS RAW-DATA-KEY. IX1084.2 +007400 SELECT PRINT-FILE ASSIGN TO IX1084.2 +007500 XXXXX055. IX1084.2 +007600 SELECT IX-FS1 ASSIGN IX1084.2 +007700 XXXXX024 IX1084.2 +007800J XXXXX044 IX1084.2 +007900 ORGANIZATION IS INDEXED IX1084.2 +008000 ACCESS SEQUENTIAL IX1084.2 +008100 FILE STATUS IS IX-FS1-STATUS IX1084.2 +008200 RECORD IX-FS1-KEY. IX1084.2 +008300 SELECT IX-FS2 ASSIGN IX1084.2 +008400 XXXXX025 IX1084.2 +008500J XXXXX045 IX1084.2 +008600 ORGANIZATION IS INDEXED IX1084.2 +008700 ACCESS RANDOM IX1084.2 +008800 FILE STATUS IS IX-FS2-STATUS IX1084.2 +008900 RECORD IX-FS2-KEY. IX1084.2 +009000 DATA DIVISION. IX1084.2 +009100 FILE SECTION. IX1084.2 +009200P IX1084.2 +009300PFD RAW-DATA. IX1084.2 +009400P IX1084.2 +009500P01 RAW-DATA-SATZ. IX1084.2 +009600P 05 RAW-DATA-KEY PIC X(6). IX1084.2 +009700P 05 C-DATE PIC 9(6). IX1084.2 +009800P 05 C-TIME PIC 9(8). IX1084.2 +009900P 05 C-NO-OF-TESTS PIC 99. IX1084.2 +010000P 05 C-OK PIC 999. IX1084.2 +010100P 05 C-ALL PIC 999. IX1084.2 +010200P 05 C-FAIL PIC 999. IX1084.2 +010300P 05 C-DELETED PIC 999. IX1084.2 +010400P 05 C-INSPECT PIC 999. IX1084.2 +010500P 05 C-NOTE PIC X(13). IX1084.2 +010600P 05 C-INDENT PIC X. IX1084.2 +010700P 05 C-ABORT PIC X(8). IX1084.2 +010800 FD PRINT-FILE. IX1084.2 +010900 01 PRINT-REC PICTURE X(120). IX1084.2 +011000 01 DUMMY-RECORD PICTURE X(120). IX1084.2 +011100 FD IX-FS1 IX1084.2 +011200C LABEL RECORDS ARE STANDARD IX1084.2 +011300C DATA RECORDS IX-FS1R1-F-G-240 IX1084.2 +011400 BLOCK CONTAINS 480. IX1084.2 +011500 IX1084.2 +011600 01 IX-FS1R1-F-G-240. IX1084.2 +011700 05 IX-FS1-REC-120 PIC X(120). IX1084.2 +011800 05 IX-FS1-REC-120-240. IX1084.2 +011900 10 FILLER PICTURE X(8). IX1084.2 +012000 10 IX-FS1-KEY PIC X(29). IX1084.2 +012100 10 FILLER PIC X(83). IX1084.2 +012200 IX1084.2 +012300 FD IX-FS2 IX1084.2 +012400C LABEL RECORDS ARE STANDARD IX1084.2 +012500C DATA RECORDS IX-FS2R1-F-G-240 IX1084.2 +012600 BLOCK CONTAINS 480. IX1084.2 +012700 IX1084.2 +012800 01 IX-FS2R1-F-G-240. IX1084.2 +012900 05 IX-FS2-REC-120 PIC X(120). IX1084.2 +013000 05 IX-FS2-REC-120-240. IX1084.2 +013100 10 FILLER PICTURE X(8). IX1084.2 +013200 10 IX-FS2-KEY PIC X(29). IX1084.2 +013300 10 FILLER PIC X(83). IX1084.2 +013400 WORKING-STORAGE SECTION. IX1084.2 +013500 01 SWITCHES-FOR-TEST. IX1084.2 +013600 05 SWITCH-NOT-INVALID PIC 9 VALUE ZERO. IX1084.2 +013700 05 SWITCH-END-XXX PIC 9 VALUE ZERO. IX1084.2 +013800 05 SWITCH-END-X9X PIC 9 VALUE ZERO. IX1084.2 +013900 05 SWITCH-IF PIC 9 VALUE ZERO. IX1084.2 +014000 01 GRP-0101. IX1084.2 +014100 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX1084.2 +014200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1084.2 +014300 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX1084.2 +014400 01 GRP-0001. IX1084.2 +014500 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014600 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014700 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014800 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014900 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015000 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015100 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015200 05 IX-FS1-STATUS PIC XX VALUE SPACE. IX1084.2 +015300 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX1084.2 +015400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX1084.2 +015500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX1084.2 +015600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX1084.2 +015700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX1084.2 +015800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX1084.2 +015900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX1084.2 +016000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX1084.2 +016100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX1084.2 +016200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX1084.2 +016300 01 DUMMY-WRK-REC. IX1084.2 +016400 02 DUMMY-WRK1 PIC X(120). IX1084.2 +016500 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1084.2 +016600 03 FILLER PIC X(5). IX1084.2 +016700 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1084.2 +016800 01 FILE-RECORD-INFORMATION-REC. IX1084.2 +016900 03 FILE-RECORD-INFO-SKELETON. IX1084.2 +017000 05 FILLER PICTURE X(48) VALUE IX1084.2 +017100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1084.2 +017200 05 FILLER PICTURE X(46) VALUE IX1084.2 +017300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1084.2 +017400 05 FILLER PICTURE X(26) VALUE IX1084.2 +017500 ",LFIL=000000,ORG= ,LBLR= ". IX1084.2 +017600 05 FILLER PICTURE X(37) VALUE IX1084.2 +017700 ",RECKEY= ". IX1084.2 +017800 05 FILLER PICTURE X(38) VALUE IX1084.2 +017900 ",ALTKEY1= ". IX1084.2 +018000 05 FILLER PICTURE X(38) VALUE IX1084.2 +018100 ",ALTKEY2= ". IX1084.2 +018200 05 FILLER PICTURE X(7) VALUE SPACE.IX1084.2 +018300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1084.2 +018400 05 FILE-RECORD-INFO-P1-120. IX1084.2 +018500 07 FILLER PIC X(5). IX1084.2 +018600 07 XFILE-NAME PIC X(6). IX1084.2 +018700 07 FILLER PIC X(8). IX1084.2 +018800 07 XRECORD-NAME PIC X(6). IX1084.2 +018900 07 FILLER PIC X(1). IX1084.2 +019000 07 REELUNIT-NUMBER PIC 9(1). IX1084.2 +019100 07 FILLER PIC X(7). IX1084.2 +019200 07 XRECORD-NUMBER PIC 9(6). IX1084.2 +019300 07 FILLER PIC X(6). IX1084.2 +019400 07 UPDATE-NUMBER PIC 9(2). IX1084.2 +019500 07 FILLER PIC X(5). IX1084.2 +019600 07 ODO-NUMBER PIC 9(4). IX1084.2 +019700 07 FILLER PIC X(5). IX1084.2 +019800 07 XPROGRAM-NAME PIC X(5). IX1084.2 +019900 07 FILLER PIC X(7). IX1084.2 +020000 07 XRECORD-LENGTH PIC 9(6). IX1084.2 +020100 07 FILLER PIC X(7). IX1084.2 +020200 07 CHARS-OR-RECORDS PIC X(2). IX1084.2 +020300 07 FILLER PIC X(1). IX1084.2 +020400 07 XBLOCK-SIZE PIC 9(4). IX1084.2 +020500 07 FILLER PIC X(6). IX1084.2 +020600 07 RECORDS-IN-FILE PIC 9(6). IX1084.2 +020700 07 FILLER PIC X(5). IX1084.2 +020800 07 XFILE-ORGANIZATION PIC X(2). IX1084.2 +020900 07 FILLER PIC X(6). IX1084.2 +021000 07 XLABEL-TYPE PIC X(1). IX1084.2 +021100 05 FILE-RECORD-INFO-P121-240. IX1084.2 +021200 07 FILLER PIC X(8). IX1084.2 +021300 07 XRECORD-KEY PIC X(29). IX1084.2 +021400 07 FILLER PIC X(9). IX1084.2 +021500 07 ALTERNATE-KEY1 PIC X(29). IX1084.2 +021600 07 FILLER PIC X(9). IX1084.2 +021700 07 ALTERNATE-KEY2 PIC X(29). IX1084.2 +021800 07 FILLER PIC X(7). IX1084.2 +021900 01 TEST-RESULTS. IX1084.2 +022000 02 FILLER PIC X VALUE SPACE. IX1084.2 +022100 02 FEATURE PIC X(20) VALUE SPACE. IX1084.2 +022200 02 FILLER PIC X VALUE SPACE. IX1084.2 +022300 02 P-OR-F PIC X(5) VALUE SPACE. IX1084.2 +022400 02 FILLER PIC X VALUE SPACE. IX1084.2 +022500 02 PAR-NAME. IX1084.2 +022600 03 FILLER PIC X(19) VALUE SPACE. IX1084.2 +022700 03 PARDOT-X PIC X VALUE SPACE. IX1084.2 +022800 03 DOTVALUE PIC 99 VALUE ZERO. IX1084.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IX1084.2 +023000 02 RE-MARK PIC X(61). IX1084.2 +023100 01 TEST-COMPUTED. IX1084.2 +023200 02 FILLER PIC X(30) VALUE SPACE. IX1084.2 +023300 02 FILLER PIC X(17) VALUE IX1084.2 +023400 " COMPUTED=". IX1084.2 +023500 02 COMPUTED-X. IX1084.2 +023600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1084.2 +023700 03 COMPUTED-N REDEFINES COMPUTED-A IX1084.2 +023800 PIC -9(9).9(9). IX1084.2 +023900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1084.2 +024000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1084.2 +024100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1084.2 +024200 03 CM-18V0 REDEFINES COMPUTED-A. IX1084.2 +024300 04 COMPUTED-18V0 PIC -9(18). IX1084.2 +024400 04 FILLER PIC X. IX1084.2 +024500 03 FILLER PIC X(50) VALUE SPACE. IX1084.2 +024600 01 TEST-CORRECT. IX1084.2 +024700 02 FILLER PIC X(30) VALUE SPACE. IX1084.2 +024800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1084.2 +024900 02 CORRECT-X. IX1084.2 +025000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1084.2 +025100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1084.2 +025200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1084.2 +025300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1084.2 +025400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1084.2 +025500 03 CR-18V0 REDEFINES CORRECT-A. IX1084.2 +025600 04 CORRECT-18V0 PIC -9(18). IX1084.2 +025700 04 FILLER PIC X. IX1084.2 +025800 03 FILLER PIC X(2) VALUE SPACE. IX1084.2 +025900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1084.2 +026000 01 CCVS-C-1. IX1084.2 +026100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1084.2 +026200- "SS PARAGRAPH-NAME IX1084.2 +026300- " REMARKS". IX1084.2 +026400 02 FILLER PIC X(20) VALUE SPACE. IX1084.2 +026500 01 CCVS-C-2. IX1084.2 +026600 02 FILLER PIC X VALUE SPACE. IX1084.2 +026700 02 FILLER PIC X(6) VALUE "TESTED". IX1084.2 +026800 02 FILLER PIC X(15) VALUE SPACE. IX1084.2 +026900 02 FILLER PIC X(4) VALUE "FAIL". IX1084.2 +027000 02 FILLER PIC X(94) VALUE SPACE. IX1084.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1084.2 +027200 01 REC-CT PIC 99 VALUE ZERO. IX1084.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1084.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1084.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1084.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1084.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1084.2 +028200 01 CCVS-H-1. IX1084.2 +028300 02 FILLER PIC X(39) VALUE SPACES. IX1084.2 +028400 02 FILLER PIC X(42) VALUE IX1084.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1084.2 +028600 02 FILLER PIC X(39) VALUE SPACES. IX1084.2 +028700 01 CCVS-H-2A. IX1084.2 +028800 02 FILLER PIC X(40) VALUE SPACE. IX1084.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1084.2 +029000 02 FILLER PIC XXXX VALUE IX1084.2 +029100 "4.2 ". IX1084.2 +029200 02 FILLER PIC X(28) VALUE IX1084.2 +029300 " COPY - NOT FOR DISTRIBUTION". IX1084.2 +029400 02 FILLER PIC X(41) VALUE SPACE. IX1084.2 +029500 IX1084.2 +029600 01 CCVS-H-2B. IX1084.2 +029700 02 FILLER PIC X(15) VALUE IX1084.2 +029800 "TEST RESULT OF ". IX1084.2 +029900 02 TEST-ID PIC X(9). IX1084.2 +030000 02 FILLER PIC X(4) VALUE IX1084.2 +030100 " IN ". IX1084.2 +030200 02 FILLER PIC X(12) VALUE IX1084.2 +030300 " HIGH ". IX1084.2 +030400 02 FILLER PIC X(22) VALUE IX1084.2 +030500 " LEVEL VALIDATION FOR ". IX1084.2 +030600 02 FILLER PIC X(58) VALUE IX1084.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +030800 01 CCVS-H-3. IX1084.2 +030900 02 FILLER PIC X(34) VALUE IX1084.2 +031000 " FOR OFFICIAL USE ONLY ". IX1084.2 +031100 02 FILLER PIC X(58) VALUE IX1084.2 +031200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1084.2 +031300 02 FILLER PIC X(28) VALUE IX1084.2 +031400 " COPYRIGHT 1985 ". IX1084.2 +031500 01 CCVS-E-1. IX1084.2 +031600 02 FILLER PIC X(52) VALUE SPACE. IX1084.2 +031700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1084.2 +031800 02 ID-AGAIN PIC X(9). IX1084.2 +031900 02 FILLER PIC X(45) VALUE SPACES. IX1084.2 +032000 01 CCVS-E-2. IX1084.2 +032100 02 FILLER PIC X(31) VALUE SPACE. IX1084.2 +032200 02 FILLER PIC X(21) VALUE SPACE. IX1084.2 +032300 02 CCVS-E-2-2. IX1084.2 +032400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1084.2 +032500 03 FILLER PIC X VALUE SPACE. IX1084.2 +032600 03 ENDER-DESC PIC X(44) VALUE IX1084.2 +032700 "ERRORS ENCOUNTERED". IX1084.2 +032800 01 CCVS-E-3. IX1084.2 +032900 02 FILLER PIC X(22) VALUE IX1084.2 +033000 " FOR OFFICIAL USE ONLY". IX1084.2 +033100 02 FILLER PIC X(12) VALUE SPACE. IX1084.2 +033200 02 FILLER PIC X(58) VALUE IX1084.2 +033300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +033400 02 FILLER PIC X(13) VALUE SPACE. IX1084.2 +033500 02 FILLER PIC X(15) VALUE IX1084.2 +033600 " COPYRIGHT 1985". IX1084.2 +033700 01 CCVS-E-4. IX1084.2 +033800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1084.2 +033900 02 FILLER PIC X(4) VALUE " OF ". IX1084.2 +034000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1084.2 +034100 02 FILLER PIC X(40) VALUE IX1084.2 +034200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1084.2 +034300 01 XXINFO. IX1084.2 +034400 02 FILLER PIC X(19) VALUE IX1084.2 +034500 "*** INFORMATION ***". IX1084.2 +034600 02 INFO-TEXT. IX1084.2 +034700 04 FILLER PIC X(8) VALUE SPACE. IX1084.2 +034800 04 XXCOMPUTED PIC X(20). IX1084.2 +034900 04 FILLER PIC X(5) VALUE SPACE. IX1084.2 +035000 04 XXCORRECT PIC X(20). IX1084.2 +035100 02 INF-ANSI-REFERENCE PIC X(48). IX1084.2 +035200 01 HYPHEN-LINE. IX1084.2 +035300 02 FILLER PIC IS X VALUE IS SPACE. IX1084.2 +035400 02 FILLER PIC IS X(65) VALUE IS "************************IX1084.2 +035500- "*****************************************". IX1084.2 +035600 02 FILLER PIC IS X(54) VALUE IS "************************IX1084.2 +035700- "******************************". IX1084.2 +035800 01 CCVS-PGM-ID PIC X(9) VALUE IX1084.2 +035900 "IX108A". IX1084.2 +036000 PROCEDURE DIVISION. IX1084.2 +036100 DECLARATIVES. IX1084.2 +036200 IX-FS2-01 SECTION. IX1084.2 +036300 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX1084.2 +036400 IX-FS2-01-01. IX1084.2 +036500 ADD 1 TO WRK-CS-09V00-013. IX1084.2 +036600 GO TO IX-FS2-01-03 IX1084.2 +036700 IX-FS2-01-05 IX1084.2 +036800 DEPENDING ON WRK-CS-09V00-012. IX1084.2 +036900 GO TO IX-FS2-01-EXIT. IX1084.2 +037000 IX-FS2-01-03. IX1084.2 +037100*ENTRY FROM SEGMENT INX-TEST-001. IX1084.2 +037200* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX1084.2 +037300 ADD 1 TO WRK-CS-09V00-014. IX1084.2 +037400 IX-FS2-01-05. IX1084.2 +037500 ADD 1 TO WRK-CS-09V00-017. IX1084.2 +037600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1084.2 +037700 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX1084.2 +037800 MOVE "10" TO WRK-XN-0002-003. IX1084.2 +037900 IX-FS2-01-EXIT. IX1084.2 +038000 EXIT. IX1084.2 +038100 END DECLARATIVES. IX1084.2 +038200 CCVS1 SECTION. IX1084.2 +038300 OPEN-FILES. IX1084.2 +038400P OPEN I-O RAW-DATA. IX1084.2 +038500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1084.2 +038600P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1084.2 +038700P MOVE "ABORTED " TO C-ABORT. IX1084.2 +038800P ADD 1 TO C-NO-OF-TESTS. IX1084.2 +038900P ACCEPT C-DATE FROM DATE. IX1084.2 +039000P ACCEPT C-TIME FROM TIME. IX1084.2 +039100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1084.2 +039200PEND-E-1. IX1084.2 +039300P CLOSE RAW-DATA. IX1084.2 +039400 OPEN OUTPUT PRINT-FILE. IX1084.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1084.2 +039600 MOVE SPACE TO TEST-RESULTS. IX1084.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1084.2 +039800 MOVE ZERO TO REC-SKL-SUB. IX1084.2 +039900 PERFORM CCVS-INIT-FILE 9 TIMES. IX1084.2 +040000 CCVS-INIT-FILE. IX1084.2 +040100 ADD 1 TO REC-SKL-SUB. IX1084.2 +040200 MOVE FILE-RECORD-INFO-SKELETON IX1084.2 +040300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1084.2 +040400 CCVS-INIT-EXIT. IX1084.2 +040500 GO TO CCVS1-EXIT. IX1084.2 +040600 CLOSE-FILES. IX1084.2 +040700P OPEN I-O RAW-DATA. IX1084.2 +040800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1084.2 +040900P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1084.2 +041000P MOVE "OK. " TO C-ABORT. IX1084.2 +041100P MOVE PASS-COUNTER TO C-OK. IX1084.2 +041200P MOVE ERROR-HOLD TO C-ALL. IX1084.2 +041300P MOVE ERROR-COUNTER TO C-FAIL. IX1084.2 +041400P MOVE DELETE-COUNTER TO C-DELETED. IX1084.2 +041500P MOVE INSPECT-COUNTER TO C-INSPECT. IX1084.2 +041600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1084.2 +041700PEND-E-2. IX1084.2 +041800P CLOSE RAW-DATA. IX1084.2 +041900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1084.2 +042000 TERMINATE-CCVS. IX1084.2 +042100S EXIT PROGRAM. IX1084.2 +042200STERMINATE-CALL. IX1084.2 +042300 STOP RUN. IX1084.2 +042400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1084.2 +042500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1084.2 +042600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1084.2 +042700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1084.2 +042800 MOVE "****TEST DELETED****" TO RE-MARK. IX1084.2 +042900 PRINT-DETAIL. IX1084.2 +043000 IF REC-CT NOT EQUAL TO ZERO IX1084.2 +043100 MOVE "." TO PARDOT-X IX1084.2 +043200 MOVE REC-CT TO DOTVALUE. IX1084.2 +043300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1084.2 +043400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1084.2 +043500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1084.2 +043600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1084.2 +043700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1084.2 +043800 MOVE SPACE TO CORRECT-X. IX1084.2 +043900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1084.2 +044000 MOVE SPACE TO RE-MARK. IX1084.2 +044100 HEAD-ROUTINE. IX1084.2 +044200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1084.2 +044500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1084.2 +044600 COLUMN-NAMES-ROUTINE. IX1084.2 +044700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +044800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +045000 END-ROUTINE. IX1084.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1084.2 +045200 END-RTN-EXIT. IX1084.2 +045300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +045400 END-ROUTINE-1. IX1084.2 +045500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1084.2 +045600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1084.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. IX1084.2 +045800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1084.2 +045900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1084.2 +046000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1084.2 +046100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1084.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1084.2 +046300 END-ROUTINE-12. IX1084.2 +046400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1084.2 +046500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1084.2 +046600 MOVE "NO " TO ERROR-TOTAL IX1084.2 +046700 ELSE IX1084.2 +046800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1084.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1084.2 +047000 PERFORM WRITE-LINE. IX1084.2 +047100 END-ROUTINE-13. IX1084.2 +047200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1084.2 +047300 MOVE "NO " TO ERROR-TOTAL ELSE IX1084.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1084.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1084.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +047700 IF INSPECT-COUNTER EQUAL TO ZERO IX1084.2 +047800 MOVE "NO " TO ERROR-TOTAL IX1084.2 +047900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1084.2 +048000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1084.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +048200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +048300 WRITE-LINE. IX1084.2 +048400 ADD 1 TO RECORD-COUNT. IX1084.2 +048500Y IF RECORD-COUNT GREATER 42 IX1084.2 +048600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1084.2 +048700Y MOVE SPACE TO DUMMY-RECORD IX1084.2 +048800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1084.2 +048900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1084.2 +049000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1084.2 +049100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1084.2 +049200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1084.2 +049300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1084.2 +049700Y MOVE ZERO TO RECORD-COUNT. IX1084.2 +049800 PERFORM WRT-LN. IX1084.2 +049900 WRT-LN. IX1084.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1084.2 +050100 MOVE SPACE TO DUMMY-RECORD. IX1084.2 +050200 BLANK-LINE-PRINT. IX1084.2 +050300 PERFORM WRT-LN. IX1084.2 +050400 FAIL-ROUTINE. IX1084.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE IX1084.2 +050600 GO TO FAIL-ROUTINE-WRITE. IX1084.2 +050700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1084.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1084.2 +050900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1084.2 +051000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1084.2 +051200 GO TO FAIL-ROUTINE-EX. IX1084.2 +051300 FAIL-ROUTINE-WRITE. IX1084.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1084.2 +051500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1084.2 +051600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1084.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. IX1084.2 +051800 FAIL-ROUTINE-EX. EXIT. IX1084.2 +051900 BAIL-OUT. IX1084.2 +052000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1084.2 +052100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1084.2 +052200 BAIL-OUT-WRITE. IX1084.2 +052300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1084.2 +052400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1084.2 +052500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +052600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1084.2 +052700 BAIL-OUT-EX. EXIT. IX1084.2 +052800 CCVS1-EXIT. IX1084.2 +052900 EXIT. IX1084.2 +053000 SECT-IX-04-001 SECTION. IX1084.2 +053100******************************************************************IX1084.2 +053200* *IX1084.2 +053300* TEST 1 CREATE INDEXED FILE IX-FS2 *IX1084.2 +053400* *IX1084.2 +053500******************************************************************IX1084.2 +053600 WRITE-INIT-GF-01. IX1084.2 +053700 MOVE "WRITE NOT INVALID END-" TO FEATURE. IX1084.2 +053800 MOVE "IX-FS2" TO XFILE-NAME (2). IX1084.2 +053900 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1084.2 +054000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1084.2 +054100 MOVE 000240 TO XRECORD-LENGTH (2). IX1084.2 +054200 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1084.2 +054300 MOVE 0001 TO XBLOCK-SIZE (2). IX1084.2 +054400 MOVE 000500 TO RECORDS-IN-FILE (2). IX1084.2 +054500 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1084.2 +054600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1084.2 +054700 MOVE "S" TO XLABEL-TYPE (2). IX1084.2 +054800 MOVE 000001 TO XRECORD-NUMBER (2). IX1084.2 +054900 MOVE 1 TO WRK-CS-09V00-012. IX1084.2 +055000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX1084.2 +055100 WRK-CS-09V00-015 WRK-CS-09V00-016 IX1084.2 +055200 WRK-CS-09V00-017 WRK-CS-09V00-018. IX1084.2 +055300 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +055400 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +055500 MOVE ZERO TO WRK-DU-09V00-001. IX1084.2 +055600 OPEN OUTPUT IX-FS1. IX1084.2 +055700 OPEN OUTPUT IX-FS2. IX1084.2 +055800 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +055900 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX1084.2 +056000 WRITE-TEST-GF-01. IX1084.2 +056100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +056200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +056300 MOVE ZERO TO SWITCH-END-X9X. IX1084.2 +056400 MOVE "99" TO IX-FS2-STATUS. IX1084.2 +056500 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX1084.2 +056600 MOVE GRP-0101 TO XRECORD-KEY (2). IX1084.2 +056700 MOVE "IX-FS2" TO XFILE-NAME (2). IX1084.2 +056800 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX1084.2 +056900 WRITE-TEST-GF-01-1. IX1084.2 +057000 WRITE IX-FS2R1-F-G-240 IX1084.2 +057100 NOT INVALID IX1084.2 +057200 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +057300 IF SWITCH-NOT-INVALID = 1 IX1084.2 +057400 MOVE 0 TO SWITCH-NOT-INVALID IX1084.2 +057500 ELSE IX1084.2 +057600 MOVE "WRITE NOT INVALID" TO FEATURE IX1084.2 +057700 PERFORM FAIL IX1084.2 +057800 MOVE "FILE IX-FS2 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +057900 TO RE-MARK IX1084.2 +058000 GO TO CCVS-EXIT. IX1084.2 +058100 WRITE-TEST-GF-01-2. IX1084.2 +058200 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +058300 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +058400 MOVE ZERO TO SWITCH-END-X9X. IX1084.2 +058500 MOVE "IX-FS1" TO XFILE-NAME (2). IX1084.2 +058600 WRITE IX-FS1R1-F-G-240 FROM FILE-RECORD-INFO (2) IX1084.2 +058700 INVALID KEY GO TO WRITE-TEST-GF-01-2-1 IX1084.2 +058800 NOT INVALID IX1084.2 +058900 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +059000 END-WRITE. IX1084.2 +059100 WRITE-TEST-GF-01-2-1. IX1084.2 +059200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +059300 IF SWITCH-NOT-INVALID = 1 IX1084.2 +059400 MOVE 0 TO SWITCH-NOT-INVALID IX1084.2 +059500 ELSE IX1084.2 +059600 MOVE "WRITE NOT INVALID" TO FEATURE IX1084.2 +059700 PERFORM FAIL IX1084.2 +059800 MOVE "FILE IX-FS1 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +059900 TO RE-MARK IX1084.2 +060000 GO TO CCVS-EXIT. IX1084.2 +060100 IF SWITCH-END-XXX = 1 IX1084.2 +060200 MOVE 0 TO SWITCH-END-XXX IX1084.2 +060300 ELSE IX1084.2 +060400 MOVE "WRITE .. END-WRITE" TO FEATURE IX1084.2 +060500 MOVE "FILE IX-FS1 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +060600 TO RE-MARK IX1084.2 +060700 PERFORM FAIL IX1084.2 +060800 GO TO CCVS-EXIT. IX1084.2 +060900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1084.2 +061000 ADD 1 TO WRK-CS-09V00-016. IX1084.2 +061100 IF IX-FS1-STATUS NOT EQUAL TO "00" IX1084.2 +061200 ADD 1 TO WRK-CS-09V00-016. IX1084.2 +061300 IF XRECORD-NUMBER (2) EQUAL TO 100 IX1084.2 +061400 GO TO WRITE-TEST-GF-01-3. IX1084.2 +061500 ADD 01 TO XRECORD-NUMBER (2). IX1084.2 +061600 GO TO WRITE-TEST-GF-01. IX1084.2 +061700 WRITE-TEST-GF-01-3. IX1084.2 +061800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX1084.2 +061900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK IX1084.2 +062000 MOVE ZERO TO CORRECT-18V0 IX1084.2 +062100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1084.2 +062200 MOVE "IX-41 4.9.2 " TO RE-MARKIX1084.2 +062300 PERFORM FAIL IX1084.2 +062400 ELSE IX1084.2 +062500 PERFORM PASS. IX1084.2 +062600 PERFORM PRINT-DETAIL. IX1084.2 +062700 WRITE-TEST-GF-02. IX1084.2 +062800 MOVE "CREATE IX-FS2" TO FEATURE IX1084.2 +062900 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1084.2 +063000 IF XRECORD-NUMBER (2) NOT EQUAL TO 100 IX1084.2 +063100 MOVE "INCORRECT COUNT" TO RE-MARK IX1084.2 +063200 MOVE 500 TO CORRECT-18V0 IX1084.2 +063300 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX1084.2 +063400 MOVE "IX-41 4.9.2 " TO RE-MARKIX1084.2 +063500 PERFORM FAIL IX1084.2 +063600 ELSE IX1084.2 +063700 PERFORM PASS. IX1084.2 +063800 PERFORM PRINT-DETAIL. IX1084.2 +063900 IX1084.2 +064000 CLOSE IX-FS1 IX-FS2. IX1084.2 +064100 IX1084.2 +064200******************************************************************IX1084.2 +064300* *IX1084.2 +064400* TESTS: R E A D NOT INVALID END-READ *IX1084.2 +064500* *IX1084.2 +064600******************************************************************IX1084.2 +064700 READ-INIT-F1-01. IX1084.2 +064800 OPEN INPUT IX-FS1. IX1084.2 +064900 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1084.2 +065000 MOVE "READ NOT AT END " TO FEATURE. IX1084.2 +065100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +065200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +065300 READ-TEST-F1-01-0. IX1084.2 +065400 READ IX-FS1 AT END IX1084.2 +065500 GO TO READ-FAIL-F1-01 IX1084.2 +065600 NOT AT END IX1084.2 +065700 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +065800 READ-TEST-F1-01. IX1084.2 +065900 IF SWITCH-NOT-INVALID = 1 IX1084.2 +066000 GO TO READ-PASS-F1-01. IX1084.2 +066100 READ-FAIL-F1-01. IX1084.2 +066200 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +066300 PERFORM FAIL. IX1084.2 +066400 GO TO READ-WRITE-F1-01. IX1084.2 +066500 READ-PASS-F1-01. IX1084.2 +066600 PERFORM PASS. IX1084.2 +066700 READ-WRITE-F1-01. IX1084.2 +066800 PERFORM PRINT-DETAIL. IX1084.2 +066900 IX1084.2 +067000******************************************************************IX1084.2 +067100* TEST READ .. NOT AT END ... END-READ. *IX1084.2 +067200* *IX1084.2 +067300* IX-28, 4.5.4 *IX1084.2 +067400******************************************************************IX1084.2 +067500 READ-INIT-F1-02. IX1084.2 +067600 MOVE "READ-TEST-F1-02-1" TO PAR-NAME. IX1084.2 +067700 MOVE "READ . NOT INV. . END-" TO FEATURE. IX1084.2 +067800 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +067900 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +068000 READ-TEST-F1-02. IX1084.2 +068100 READ IX-FS1 AT END IX1084.2 +068200 GO TO READ-FAIL-F1-02-1 IX1084.2 +068300 NOT END IX1084.2 +068400 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +068500 END-READ. IX1084.2 +068600 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +068700 READ-TEST-F1-02-1. IX1084.2 +068800 IF SWITCH-NOT-INVALID = 1 IX1084.2 +068900 GO TO READ-PASS-F1-02-1. IX1084.2 +069000 READ-FAIL-F1-02-1. IX1084.2 +069100 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +069200 PERFORM FAIL. IX1084.2 +069300 GO TO READ-WRITE-F1-02-1. IX1084.2 +069400 READ-PASS-F1-02-1. IX1084.2 +069500 PERFORM PASS. IX1084.2 +069600 READ-WRITE-F1-02-1. IX1084.2 +069700 PERFORM PRINT-DETAIL. IX1084.2 +069800 IX1084.2 +069900 READ-TEST-F1-02-2. IX1084.2 +070000 MOVE "READ-TEST-F1-02-2" TO PAR-NAME. IX1084.2 +070100 MOVE "END-READ. " TO FEATURE. IX1084.2 +070200 IF SWITCH-END-XXX = 1 IX1084.2 +070300 GO TO READ-PASS-F1-02-2. IX1084.2 +070400 READ-FAIL-F1-02-2. IX1084.2 +070500 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +070600 PERFORM FAIL. IX1084.2 +070700 GO TO READ-WRITE-F1-02-2. IX1084.2 +070800 READ-PASS-F1-02-2. IX1084.2 +070900 PERFORM PASS. IX1084.2 +071000 READ-WRITE-F1-02-2. IX1084.2 +071100 PERFORM PRINT-DETAIL. IX1084.2 +071200 IX1084.2 +071300******************************************************************IX1084.2 +071400* TEST: IF READ .. NOT AT END ... END-READ ... . *IX1084.2 +071500* *IX1084.2 +071600* IX-28, 4.5.4 *IX1084.2 +071700******************************************************************IX1084.2 +071800 READ-INIT-F1-03. IX1084.2 +071900 MOVE "READ-TEST-F1-03-1" TO PAR-NAME. IX1084.2 +072000 MOVE "IF . READ . NOT INV. . END-" TO FEATURE. IX1084.2 +072100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +072200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +072300 MOVE 1 TO SWITCH-IF. IX1084.2 +072400 READ-TEST-F1-03. IX1084.2 +072500 IF SWITCH-IF = 1 IX1084.2 +072600 READ IX-FS1 AT END IX1084.2 +072700 GO TO READ-FAIL-F1-03-1 IX1084.2 +072800 NOT END IX1084.2 +072900 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +073000 END-READ IX1084.2 +073100 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +073200 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +073300 READ-TEST-F1-03-1. IX1084.2 +073400 IF SWITCH-NOT-INVALID = 1 IX1084.2 +073500 GO TO READ-PASS-F1-03-1. IX1084.2 +073600 READ-FAIL-F1-03-1. IX1084.2 +073700 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +073800 PERFORM FAIL. IX1084.2 +073900 GO TO READ-WRITE-F1-03-1. IX1084.2 +074000 READ-PASS-F1-03-1. IX1084.2 +074100 PERFORM PASS. IX1084.2 +074200 READ-WRITE-F1-03-1. IX1084.2 +074300 PERFORM PRINT-DETAIL. IX1084.2 +074400 IX1084.2 +074500 READ-TEST-F1-03-2. IX1084.2 +074600 MOVE "READ-TEST-F1-03-2" TO PAR-NAME. IX1084.2 +074700 IF SWITCH-END-XXX = 1 IX1084.2 +074800 GO TO READ-PASS-F1-03-2. IX1084.2 +074900 READ-FAIL-F1-03-2. IX1084.2 +075000 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +075100 PERFORM FAIL. IX1084.2 +075200 GO TO READ-WRITE-F1-03-2. IX1084.2 +075300 READ-PASS-F1-03-2. IX1084.2 +075400 PERFORM PASS. IX1084.2 +075500 READ-WRITE-F1-03-2. IX1084.2 +075600 PERFORM PRINT-DETAIL. IX1084.2 +075700 IX1084.2 +075800 READ-TEST-F1-03-3. IX1084.2 +075900 MOVE "READ-TEST-F1-03-3" TO PAR-NAME. IX1084.2 +076000 IF SWITCH-END-X9X = 9 IX1084.2 +076100 GO TO READ-PASS-F1-03-3. IX1084.2 +076200 READ-FAIL-F1-03-3. IX1084.2 +076300 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +076400 PERFORM FAIL. IX1084.2 +076500 GO TO READ-WRITE-F1-03-3. IX1084.2 +076600 READ-PASS-F1-03-3. IX1084.2 +076700 PERFORM PASS. IX1084.2 +076800 READ-WRITE-F1-03-3. IX1084.2 +076900 PERFORM PRINT-DETAIL. IX1084.2 +077000 IX1084.2 +077100 CLOSE IX-FS1. IX1084.2 +077200 IX1084.2 +077300******************************************************************IX1084.2 +077400* TEST READ NOT INVALID *IX1084.2 +077500* *IX1084.2 +077600* IX-28, 4.5.4 *IX1084.2 +077700******************************************************************IX1084.2 +077800 READ-INIT-F2-01. IX1084.2 +077900 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +078000 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +078100 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +078200 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +078300 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +078400 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +078500 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +078600 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +078700 OPEN I-O IX-FS2. IX1084.2 +078800 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +078900 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +079000 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +079100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +079200 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +079300 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +079400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1084.2 +079500 MOVE "READ NOT INVALID." TO FEATURE. IX1084.2 +079600 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +079700 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +079800 READ-TEST-F2-01-0. IX1084.2 +079900 MOVE 1 TO WRK-DU-09V00-001. IX1084.2 +080000 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +080100 READ IX-FS2 INVALID IX1084.2 +080200 GO TO READ-FAIL-F2-01 IX1084.2 +080300 NOT INVALID IX1084.2 +080400 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +080500 READ-TEST-F2-01. IX1084.2 +080600 IF SWITCH-NOT-INVALID = 1 IX1084.2 +080700 GO TO READ-PASS-F2-01. IX1084.2 +080800 READ-FAIL-F2-01. IX1084.2 +080900 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +081000 PERFORM FAIL. IX1084.2 +081100 GO TO READ-WRITE-F2-01. IX1084.2 +081200 READ-PASS-F2-01. IX1084.2 +081300 PERFORM PASS. IX1084.2 +081400 READ-WRITE-F2-01. IX1084.2 +081500 PERFORM PRINT-DETAIL. IX1084.2 +081600 IX1084.2 +081700******************************************************************IX1084.2 +081800* TEST READ .. NOT INVALID ... END-READ. *IX1084.2 +081900* *IX1084.2 +082000* IX-28, 4.5.4 *IX1084.2 +082100******************************************************************IX1084.2 +082200 READ-INIT-F2-02. IX1084.2 +082300 MOVE "READ-TEST-F2-02-1" TO PAR-NAME. IX1084.2 +082400 MOVE "READ . NOT INV. . END-" TO FEATURE. IX1084.2 +082500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +082600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +082700 READ-TEST-F2-02. IX1084.2 +082800 MOVE 2 TO WRK-DU-09V00-001. IX1084.2 +082900 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +083000 READ IX-FS2 INVALID KEY IX1084.2 +083100 GO TO READ-FAIL-F2-02-1 IX1084.2 +083200 NOT INVALID KEY IX1084.2 +083300 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +083400 END-READ. IX1084.2 +083500 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +083600 READ-TEST-F2-02-1. IX1084.2 +083700 IF SWITCH-NOT-INVALID = 1 IX1084.2 +083800 GO TO READ-PASS-F2-02-1. IX1084.2 +083900 READ-FAIL-F2-02-1. IX1084.2 +084000 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +084100 PERFORM FAIL. IX1084.2 +084200 GO TO READ-WRITE-F2-02-1. IX1084.2 +084300 READ-PASS-F2-02-1. IX1084.2 +084400 PERFORM PASS. IX1084.2 +084500 READ-WRITE-F2-02-1. IX1084.2 +084600 PERFORM PRINT-DETAIL. IX1084.2 +084700 IX1084.2 +084800 READ-TEST-F2-02-2. IX1084.2 +084900 MOVE "READ-TEST-F2-02-2" TO PAR-NAME. IX1084.2 +085000 MOVE "END-READ. " TO FEATURE. IX1084.2 +085100 IF SWITCH-END-XXX = 1 IX1084.2 +085200 GO TO READ-PASS-F2-02-2. IX1084.2 +085300 READ-FAIL-F2-02-2. IX1084.2 +085400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +085500 PERFORM FAIL. IX1084.2 +085600 GO TO READ-WRITE-F2-02-2. IX1084.2 +085700 READ-PASS-F2-02-2. IX1084.2 +085800 PERFORM PASS. IX1084.2 +085900 READ-WRITE-F2-02-2. IX1084.2 +086000 PERFORM PRINT-DETAIL. IX1084.2 +086100 IX1084.2 +086200******************************************************************IX1084.2 +086300* TEST: IF READ .. NOT INVALID ... END-READ ... . *IX1084.2 +086400* *IX1084.2 +086500* IX-28, 4.5.4 *IX1084.2 +086600******************************************************************IX1084.2 +086700 READ-INIT-F2-03. IX1084.2 +086800 MOVE "READ-TEST-F2-03-1" TO PAR-NAME. IX1084.2 +086900 MOVE "IF . READ . NOT INV. . END-" TO FEATURE. IX1084.2 +087000 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +087100 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +087200 MOVE 1 TO SWITCH-IF. IX1084.2 +087300 READ-TEST-F2-03. IX1084.2 +087400 MOVE 3 TO WRK-DU-09V00-001. IX1084.2 +087500 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +087600 IF SWITCH-IF = 1 IX1084.2 +087700 READ IX-FS2 INVALID KEY IX1084.2 +087800 GO TO READ-FAIL-F2-03-1 IX1084.2 +087900 NOT INVALID KEY IX1084.2 +088000 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +088100 END-READ IX1084.2 +088200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +088300 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +088400 READ-TEST-F2-03-1. IX1084.2 +088500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +088600 GO TO READ-PASS-F2-03-1. IX1084.2 +088700 READ-FAIL-F2-03-1. IX1084.2 +088800 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +088900 PERFORM FAIL. IX1084.2 +089000 GO TO READ-WRITE-F2-03-1. IX1084.2 +089100 READ-PASS-F2-03-1. IX1084.2 +089200 PERFORM PASS. IX1084.2 +089300 READ-WRITE-F2-03-1. IX1084.2 +089400 PERFORM PRINT-DETAIL. IX1084.2 +089500 IX1084.2 +089600 READ-TEST-F2-03-2. IX1084.2 +089700 MOVE "READ-TEST-F2-03-2" TO PAR-NAME. IX1084.2 +089800 IF SWITCH-END-XXX = 1 IX1084.2 +089900 GO TO READ-PASS-F2-03-2. IX1084.2 +090000 READ-FAIL-F2-03-2. IX1084.2 +090100 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +090200 PERFORM FAIL. IX1084.2 +090300 GO TO READ-WRITE-F2-03-2. IX1084.2 +090400 READ-PASS-F2-03-2. IX1084.2 +090500 PERFORM PASS. IX1084.2 +090600 READ-WRITE-F2-03-2. IX1084.2 +090700 PERFORM PRINT-DETAIL. IX1084.2 +090800 IX1084.2 +090900 READ-TEST-F2-03-3. IX1084.2 +091000 MOVE "READ-TEST-F2-03-3" TO PAR-NAME. IX1084.2 +091100 IF SWITCH-END-X9X = 9 IX1084.2 +091200 GO TO READ-PASS-F2-03-3. IX1084.2 +091300 READ-FAIL-F2-03-3. IX1084.2 +091400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +091500 PERFORM FAIL. IX1084.2 +091600 GO TO READ-WRITE-F2-03-3. IX1084.2 +091700 READ-PASS-F2-03-3. IX1084.2 +091800 PERFORM PASS. IX1084.2 +091900 READ-WRITE-F2-03-3. IX1084.2 +092000 PERFORM PRINT-DETAIL. IX1084.2 +092100 IX1084.2 +092200 CLOSE IX-FS2. IX1084.2 +092300 IX1084.2 +092400******************************************************************IX1084.2 +092500* *IX1084.2 +092600* TESTS: D E L E T E NOT INVALID END-DELETE *IX1084.2 +092700* FOR A FILE WHICH IS IN RANDOM ACCESS MODE *IX1084.2 +092800* *IX1084.2 +092900* *IX1084.2 +093000* TEST DELETE NOT INVALID *IX1084.2 +093100* *IX1084.2 +093200* IX-21, 4.3.2 *IX1084.2 +093300******************************************************************IX1084.2 +093400 DELETE-INIT-GF-01. IX1084.2 +093500 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +093600 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +093700 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +093800 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +093900 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +094000 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +094100 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +094200 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +094300 OPEN I-O IX-FS2. IX1084.2 +094400 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +094500 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +094600 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +094700 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +094800 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +094900 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +095000 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX1084.2 +095100 MOVE "DELETE NOT INVALID." TO FEATURE. IX1084.2 +095200 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +095300 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +095400 DELETE-TEST-GF-01-0. IX1084.2 +095500 MOVE 1 TO WRK-DU-09V00-001. IX1084.2 +095600 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +095700 READ IX-FS2 INVALID KEY IX1084.2 +095800 MOVE " READ FAILED " TO RE-MARK IX1084.2 +095900 PERFORM FAIL IX1084.2 +096000 GO TO DELETE-WRITE-GF-01. IX1084.2 +096100 DELETE IX-FS2 RECORD IX1084.2 +096200 INVALID KEY MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +096300 PERFORM FAIL IX1084.2 +096400 GO TO DELETE-WRITE-GF-01 IX1084.2 +096500 NOT INVALID KEY IX1084.2 +096600 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +096700 DELETE-TEST-GF-01. IX1084.2 +096800 IF SWITCH-NOT-INVALID = 1 IX1084.2 +096900 GO TO DELETE-PASS-GF-01. IX1084.2 +097000 DELETE-FAIL-GF-01. IX1084.2 +097100 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +097200 PERFORM FAIL. IX1084.2 +097300 GO TO DELETE-WRITE-GF-01. IX1084.2 +097400 DELETE-PASS-GF-01. IX1084.2 +097500 PERFORM PASS. IX1084.2 +097600 DELETE-WRITE-GF-01. IX1084.2 +097700 PERFORM PRINT-DETAIL. IX1084.2 +097800 IX1084.2 +097900******************************************************************IX1084.2 +098000* TEST DELETE NOT INVALID ... END-DELETE. *IX1084.2 +098100* *IX1084.2 +098200* IX-21, 4.3.2 *IX1084.2 +098300******************************************************************IX1084.2 +098400 DELETE-INIT-GF-02. IX1084.2 +098500 MOVE "DELETE-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +098600 MOVE "DELETE NOT INV. . END-" TO FEATURE. IX1084.2 +098700 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +098800 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +098900 DELETE-TEST-GF-02. IX1084.2 +099000 MOVE 2 TO WRK-DU-09V00-001. IX1084.2 +099100 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +099200 READ IX-FS2 INVALID KEY IX1084.2 +099300 MOVE "READ FAILED " TO RE-MARK IX1084.2 +099400 PERFORM FAIL IX1084.2 +099500 GO TO DELETE-WRITE-GF-02-1. IX1084.2 +099600 DELETE IX-FS2 RECORD IX1084.2 +099700 INVALID MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +099800 PERFORM FAIL IX1084.2 +099900 GO TO DELETE-WRITE-GF-02-1 IX1084.2 +100000 NOT INVALID IX1084.2 +100100 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +100200 END-DELETE. IX1084.2 +100300 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +100400 DELETE-TEST-GF-02-1. IX1084.2 +100500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +100600 GO TO DELETE-PASS-GF-02-1. IX1084.2 +100700 DELETE-FAIL-GF-02-1. IX1084.2 +100800 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +100900 PERFORM FAIL. IX1084.2 +101000 GO TO DELETE-WRITE-GF-02-1. IX1084.2 +101100 DELETE-PASS-GF-02-1. IX1084.2 +101200 PERFORM PASS. IX1084.2 +101300 DELETE-WRITE-GF-02-1. IX1084.2 +101400 PERFORM PRINT-DETAIL. IX1084.2 +101500 IX1084.2 +101600 DELETE-TEST-GF-02-2. IX1084.2 +101700 MOVE "DELETE-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +101800 MOVE "END-DELETE. " TO FEATURE. IX1084.2 +101900 IF SWITCH-END-XXX = 1 IX1084.2 +102000 GO TO DELETE-PASS-GF-02-2. IX1084.2 +102100 DELETE-FAIL-GF-02-2. IX1084.2 +102200 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +102300 PERFORM FAIL. IX1084.2 +102400 GO TO DELETE-WRITE-GF-02-2. IX1084.2 +102500 DELETE-PASS-GF-02-2. IX1084.2 +102600 PERFORM PASS. IX1084.2 +102700 DELETE-WRITE-GF-02-2. IX1084.2 +102800 PERFORM PRINT-DETAIL. IX1084.2 +102900 IX1084.2 +103000******************************************************************IX1084.2 +103100* TEST: IF DELETE. NOT INVALID ... END-DELETE ... . *IX1084.2 +103200* *IX1084.2 +103300* IX-21, 4.3.2 *IX1084.2 +103400******************************************************************IX1084.2 +103500 DELETE-INIT-GF-03. IX1084.2 +103600 MOVE "DELETE-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +103700 MOVE "IF .DELETE. NOT INV. . END-" TO FEATURE. IX1084.2 +103800 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +103900 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +104000 MOVE 1 TO SWITCH-IF. IX1084.2 +104100 DELETE-TEST-GF-03. IX1084.2 +104200 MOVE 3 TO WRK-DU-09V00-001. IX1084.2 +104300 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +104400 READ IX-FS2 INVALID KEY IX1084.2 +104500 MOVE "READ FAILED " TO RE-MARK IX1084.2 +104600 PERFORM FAIL IX1084.2 +104700 GO TO DELETE-WRITE-GF-03-1. IX1084.2 +104800 IF SWITCH-IF = 1 IX1084.2 +104900 DELETE IX-FS2 RECORD IX1084.2 +105000 INVALID KEY MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +105100 PERFORM FAIL IX1084.2 +105200 GO TO DELETE-WRITE-GF-03-1 IX1084.2 +105300 NOT INVALID KEY IX1084.2 +105400 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +105500 END-DELETE IX1084.2 +105600 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +105700 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +105800 DELETE-TEST-GF-03-1. IX1084.2 +105900 IF SWITCH-NOT-INVALID = 1 IX1084.2 +106000 GO TO DELETE-PASS-GF-03-1. IX1084.2 +106100 DELETE-FAIL-GF-03-1. IX1084.2 +106200 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +106300 PERFORM FAIL. IX1084.2 +106400 GO TO DELETE-WRITE-GF-03-1. IX1084.2 +106500 DELETE-PASS-GF-03-1. IX1084.2 +106600 PERFORM PASS. IX1084.2 +106700 DELETE-WRITE-GF-03-1. IX1084.2 +106800 PERFORM PRINT-DETAIL. IX1084.2 +106900 IX1084.2 +107000 DELETE-TEST-GF-03-2. IX1084.2 +107100 MOVE "END-DELETE" TO FEATURE. IX1084.2 +107200 MOVE "DELETE-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +107300 IF SWITCH-END-XXX = 1 IX1084.2 +107400 GO TO DELETE-PASS-GF-03-2. IX1084.2 +107500 DELETE-FAIL-GF-03-2. IX1084.2 +107600 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +107700 PERFORM FAIL. IX1084.2 +107800 GO TO DELETE-WRITE-GF-03-2. IX1084.2 +107900 DELETE-PASS-GF-03-2. IX1084.2 +108000 PERFORM PASS. IX1084.2 +108100 DELETE-WRITE-GF-03-2. IX1084.2 +108200 PERFORM PRINT-DETAIL. IX1084.2 +108300 IX1084.2 +108400 DELETE-TEST-GF-03-3. IX1084.2 +108500 MOVE "DELETE-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +108600 IF SWITCH-END-X9X = 9 IX1084.2 +108700 GO TO DELETE-PASS-GF-03-3. IX1084.2 +108800 DELETE-FAIL-GF-03-3. IX1084.2 +108900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +109000 PERFORM FAIL. IX1084.2 +109100 GO TO DELETE-WRITE-GF-03-3. IX1084.2 +109200 DELETE-PASS-GF-03-3. IX1084.2 +109300 PERFORM PASS. IX1084.2 +109400 DELETE-WRITE-GF-03-3. IX1084.2 +109500 PERFORM PRINT-DETAIL. IX1084.2 +109600 IX1084.2 +109700 CLOSE IX-FS2. IX1084.2 +109800 IX1084.2 +109900******************************************************************IX1084.2 +110000* *IX1084.2 +110100* TESTS: R E W R I T E NOT INVALID END-REWRITE *IX1084.2 +110200* FOR A FILE WHICH IS IN RANDOM ACCESS MODE *IX1084.2 +110300* *IX1084.2 +110400* *IX1084.2 +110500* TEST REWRITE NOT INVALID *IX1084.2 +110600* *IX1084.2 +110700* IX-33, 4.6.2 *IX1084.2 +110800******************************************************************IX1084.2 +110900 REWRITE-INIT-GF-01. IX1084.2 +111000 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +111100 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +111200 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +111300 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +111400 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +111500 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +111600 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +111700 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +111800 OPEN I-O IX-FS2. IX1084.2 +111900 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +112000 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +112100 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +112200 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +112300 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +112400 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +112500 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX1084.2 +112600 MOVE "REWRITE NOT INVALID." TO FEATURE. IX1084.2 +112700 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +112800 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +112900 REWRITE-TEST-GF-01-0. IX1084.2 +113000 MOVE 5 TO WRK-DU-09V00-001. IX1084.2 +113100 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +113200 READ IX-FS2 INVALID KEY IX1084.2 +113300 MOVE " READ FAILED " TO RE-MARK IX1084.2 +113400 PERFORM FAIL IX1084.2 +113500 GO TO REWRITE-WRITE-GF-01. IX1084.2 +113600 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +113700 REWRITE IX-FS2R1-F-G-240 IX1084.2 +113800 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +113900 PERFORM FAIL IX1084.2 +114000 GO TO REWRITE-WRITE-GF-01 IX1084.2 +114100 NOT INVALID KEY IX1084.2 +114200 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +114300 REWRITE-TEST-GF-01. IX1084.2 +114400 IF SWITCH-NOT-INVALID = 1 IX1084.2 +114500 GO TO REWRITE-PASS-GF-01. IX1084.2 +114600 REWRITE-FAIL-GF-01. IX1084.2 +114700 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +114800 PERFORM FAIL. IX1084.2 +114900 GO TO REWRITE-WRITE-GF-01. IX1084.2 +115000 REWRITE-PASS-GF-01. IX1084.2 +115100 PERFORM PASS. IX1084.2 +115200 REWRITE-WRITE-GF-01. IX1084.2 +115300 PERFORM PRINT-DETAIL. IX1084.2 +115400 IX1084.2 +115500******************************************************************IX1084.2 +115600* TEST REWRITE NOT INVALID ... END-DELETE. *IX1084.2 +115700* *IX1084.2 +115800* IX-33, 4.6.2 *IX1084.2 +115900******************************************************************IX1084.2 +116000 REWRITE-INIT-GF-02. IX1084.2 +116100 MOVE "REWRITE-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +116200 MOVE "REWRITE NOT INV. . END-" TO FEATURE. IX1084.2 +116300 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +116400 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +116500 REWRITE-TEST-GF-02. IX1084.2 +116600 MOVE 6 TO WRK-DU-09V00-001. IX1084.2 +116700 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +116800 READ IX-FS2 INVALID KEY IX1084.2 +116900 MOVE "READ FAILED " TO RE-MARK IX1084.2 +117000 PERFORM FAIL IX1084.2 +117100 GO TO REWRITE-WRITE-GF-02-1. IX1084.2 +117200 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +117300 REWRITE IX-FS2R1-F-G-240 IX1084.2 +117400 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +117500 PERFORM FAIL IX1084.2 +117600 GO TO REWRITE-WRITE-GF-02-1 IX1084.2 +117700 NOT INVALID IX1084.2 +117800 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +117900 END-REWRITE. IX1084.2 +118000 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +118100 REWRITE-TEST-GF-02-1. IX1084.2 +118200 IF SWITCH-NOT-INVALID = 1 IX1084.2 +118300 GO TO REWRITE-PASS-GF-02-1. IX1084.2 +118400 REWRITE-FAIL-GF-02-1. IX1084.2 +118500 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +118600 PERFORM FAIL. IX1084.2 +118700 GO TO REWRITE-WRITE-GF-02-1. IX1084.2 +118800 REWRITE-PASS-GF-02-1. IX1084.2 +118900 PERFORM PASS. IX1084.2 +119000 REWRITE-WRITE-GF-02-1. IX1084.2 +119100 PERFORM PRINT-DETAIL. IX1084.2 +119200 IX1084.2 +119300 REWRITE-TEST-GF-02-2. IX1084.2 +119400 MOVE "REWRITE-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +119500 MOVE "END-REWRITE. " TO FEATURE. IX1084.2 +119600 IF SWITCH-END-XXX = 1 IX1084.2 +119700 GO TO REWRITE-PASS-GF-02-2. IX1084.2 +119800 REWRITE-FAIL-GF-02-2. IX1084.2 +119900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +120000 PERFORM FAIL. IX1084.2 +120100 GO TO REWRITE-WRITE-GF-02-2. IX1084.2 +120200 REWRITE-PASS-GF-02-2. IX1084.2 +120300 PERFORM PASS. IX1084.2 +120400 REWRITE-WRITE-GF-02-2. IX1084.2 +120500 PERFORM PRINT-DETAIL. IX1084.2 +120600 IX1084.2 +120700******************************************************************IX1084.2 +120800* TEST: IF REWRITE. NOT INVALID ... END-DELETE ... . *IX1084.2 +120900* *IX1084.2 +121000* IX-33, 4.6.2 *IX1084.2 +121100******************************************************************IX1084.2 +121200 REWRITE-INIT-GF-03. IX1084.2 +121300 MOVE "REWRITE-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +121400 MOVE "IF .REWRITE. NOT INV. . END-" TO FEATURE. IX1084.2 +121500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +121600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +121700 MOVE 1 TO SWITCH-IF. IX1084.2 +121800 REWRITE-TEST-GF-03. IX1084.2 +121900 MOVE 7 TO WRK-DU-09V00-001. IX1084.2 +122000 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +122100 READ IX-FS2 INVALID KEY IX1084.2 +122200 MOVE "READ FAILED " TO RE-MARK IX1084.2 +122300 PERFORM FAIL IX1084.2 +122400 GO TO REWRITE-WRITE-GF-03-1. IX1084.2 +122500 IF SWITCH-IF = 1 IX1084.2 +122600 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +122700 REWRITE IX-FS2R1-F-G-240 IX1084.2 +122800 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +122900 PERFORM FAIL IX1084.2 +123000 GO TO REWRITE-WRITE-GF-03-1 IX1084.2 +123100 NOT INVALID KEY IX1084.2 +123200 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +123300 END-REWRITE IX1084.2 +123400 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +123500 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +123600 REWRITE-TEST-GF-03-1. IX1084.2 +123700 IF SWITCH-NOT-INVALID = 1 IX1084.2 +123800 GO TO REWRITE-PASS-GF-03-1. IX1084.2 +123900 REWRITE-FAIL-GF-03-1. IX1084.2 +124000 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +124100 PERFORM FAIL. IX1084.2 +124200 GO TO REWRITE-WRITE-GF-03-1. IX1084.2 +124300 REWRITE-PASS-GF-03-1. IX1084.2 +124400 PERFORM PASS. IX1084.2 +124500 REWRITE-WRITE-GF-03-1. IX1084.2 +124600 PERFORM PRINT-DETAIL. IX1084.2 +124700 IX1084.2 +124800 REWRITE-TEST-GF-03-2. IX1084.2 +124900 MOVE "END-REWRITE" TO FEATURE. IX1084.2 +125000 MOVE "REWRITE-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +125100 IF SWITCH-END-XXX = 1 IX1084.2 +125200 GO TO REWRITE-PASS-GF-03-2. IX1084.2 +125300 REWRITE-FAIL-GF-03-2. IX1084.2 +125400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +125500 PERFORM FAIL. IX1084.2 +125600 GO TO REWRITE-WRITE-GF-03-2. IX1084.2 +125700 REWRITE-PASS-GF-03-2. IX1084.2 +125800 PERFORM PASS. IX1084.2 +125900 REWRITE-WRITE-GF-03-2. IX1084.2 +126000 PERFORM PRINT-DETAIL. IX1084.2 +126100 IX1084.2 +126200 REWRITE-TEST-GF-03-3. IX1084.2 +126300 MOVE "REWRITE-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +126400 IF SWITCH-END-X9X = 9 IX1084.2 +126500 GO TO REWRITE-PASS-GF-03-3. IX1084.2 +126600 REWRITE-FAIL-GF-03-3. IX1084.2 +126700 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +126800 PERFORM FAIL. IX1084.2 +126900 GO TO REWRITE-WRITE-GF-03-3. IX1084.2 +127000 REWRITE-PASS-GF-03-3. IX1084.2 +127100 PERFORM PASS. IX1084.2 +127200 REWRITE-WRITE-GF-03-3. IX1084.2 +127300 PERFORM PRINT-DETAIL. IX1084.2 +127400 IX1084.2 +127500 CLOSE IX-FS2. IX1084.2 +127600 IX1084.2 +127700 IX1084.2 +127800******************************************************************IX1084.2 +127900* *IX1084.2 +128000* TESTS: R E W R I T E NOT INVALID END-REWRITE *IX1084.2 +128100* FOR A FILE WHICH IS IN SEQUENTIAL ACCESS MODE *IX1084.2 +128200* *IX1084.2 +128300* *IX1084.2 +128400* TEST REWRITE NOT INVALID *IX1084.2 +128500* *IX1084.2 +128600* IX-33, 4.6.2 *IX1084.2 +128700******************************************************************IX1084.2 +128800 RWR-SEQ-INIT-GF-01. IX1084.2 +128900 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +129000 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +129100 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +129200 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +129300 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +129400 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +129500 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +129600 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +129700 OPEN I-O IX-FS1. IX1084.2 +129800 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +129900 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +130000 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +130100 MOVE IX-FS1-STATUS TO WRK-XN-0002-001 IX1084.2 +130200 MOVE IX-FS1-STATUS TO WRK-XN-0002-001 IX1084.2 +130300 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +130400 MOVE "RWR-SEQ-TEST-GF-01" TO PAR-NAME. IX1084.2 +130500 MOVE "REWRITE NOT INVALID." TO FEATURE. IX1084.2 +130600 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +130700 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +130800 RWR-SEQ-TEST-GF-01-0. IX1084.2 +130900******************************************************************IX1084.2 +131000* *IX1084.2 +131100* READ AND REWRITE THE FIRST THREE RECORDS *IX1084.2 +131200* *IX1084.2 +131300******************************************************************IX1084.2 +131400 READ IX-FS1 AT END IX1084.2 +131500 MOVE " READ FAILED " TO RE-MARK IX1084.2 +131600 PERFORM FAIL IX1084.2 +131700 GO TO RWR-SEQ-WRITE-GF-01. IX1084.2 +131800 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +131900 REWRITE IX-FS1R1-F-G-240 IX1084.2 +132000 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +132100 PERFORM FAIL IX1084.2 +132200 GO TO RWR-SEQ-WRITE-GF-01 IX1084.2 +132300 NOT INVALID KEY IX1084.2 +132400 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +132500 RWR-SEQ-TEST-GF-01. IX1084.2 +132600 IF SWITCH-NOT-INVALID = 1 IX1084.2 +132700 GO TO RWR-SEQ-PASS-GF-01. IX1084.2 +132800 RWR-SEQ-FAIL-GF-01. IX1084.2 +132900 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +133000 PERFORM FAIL. IX1084.2 +133100 GO TO RWR-SEQ-WRITE-GF-01. IX1084.2 +133200 RWR-SEQ-PASS-GF-01. IX1084.2 +133300 PERFORM PASS. IX1084.2 +133400 RWR-SEQ-WRITE-GF-01. IX1084.2 +133500 PERFORM PRINT-DETAIL. IX1084.2 +133600 IX1084.2 +133700******************************************************************IX1084.2 +133800* TEST REWRITE NOT INVALID ... END-DELETE. *IX1084.2 +133900* *IX1084.2 +134000* IX-33, 4.6.2 *IX1084.2 +134100******************************************************************IX1084.2 +134200 RWR-SEQ-INIT-GF-02. IX1084.2 +134300 MOVE "RWR-SEQ-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +134400 MOVE "REWRITE NOT INV. . END-" TO FEATURE. IX1084.2 +134500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +134600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +134700 RWR-SEQ-TEST-GF-02. IX1084.2 +134800 READ IX-FS1 AT END IX1084.2 +134900 MOVE "READ FAILED " TO RE-MARK IX1084.2 +135000 PERFORM FAIL IX1084.2 +135100 GO TO RWR-SEQ-WRITE-GF-02-1. IX1084.2 +135200 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +135300 REWRITE IX-FS1R1-F-G-240 IX1084.2 +135400 INVALID MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +135500 PERFORM FAIL IX1084.2 +135600 GO TO RWR-SEQ-WRITE-GF-02-1 IX1084.2 +135700 NOT INVALID IX1084.2 +135800 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +135900 END-REWRITE. IX1084.2 +136000 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +136100 RWR-SEQ-TEST-GF-02-1. IX1084.2 +136200 IF SWITCH-NOT-INVALID = 1 IX1084.2 +136300 GO TO RWR-SEQ-PASS-GF-02-1. IX1084.2 +136400 RWR-SEQ-FAIL-GF-02-1. IX1084.2 +136500 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +136600 PERFORM FAIL. IX1084.2 +136700 GO TO RWR-SEQ-WRITE-GF-02-1. IX1084.2 +136800 RWR-SEQ-PASS-GF-02-1. IX1084.2 +136900 PERFORM PASS. IX1084.2 +137000 RWR-SEQ-WRITE-GF-02-1. IX1084.2 +137100 PERFORM PRINT-DETAIL. IX1084.2 +137200 IX1084.2 +137300 RWR-SEQ-TEST-GF-02-2. IX1084.2 +137400 MOVE "RWR-SEQ-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +137500 MOVE "END-REWRITE. " TO FEATURE. IX1084.2 +137600 IF SWITCH-END-XXX = 1 IX1084.2 +137700 GO TO RWR-SEQ-PASS-GF-02-2. IX1084.2 +137800 RWR-SEQ-FAIL-GF-02-2. IX1084.2 +137900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +138000 PERFORM FAIL. IX1084.2 +138100 GO TO RWR-SEQ-WRITE-GF-02-2. IX1084.2 +138200 RWR-SEQ-PASS-GF-02-2. IX1084.2 +138300 PERFORM PASS. IX1084.2 +138400 RWR-SEQ-WRITE-GF-02-2. IX1084.2 +138500 PERFORM PRINT-DETAIL. IX1084.2 +138600 IX1084.2 +138700******************************************************************IX1084.2 +138800* TEST: IF REWRITE. NOT INVALID ... END-DELETE ... . *IX1084.2 +138900* *IX1084.2 +139000* IX-33, 4.6.2 *IX1084.2 +139100******************************************************************IX1084.2 +139200 RWR-SEQ-INIT-GF-03. IX1084.2 +139300 MOVE "RWR-SEQ-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +139400 MOVE "IF .REWRITE. NOT INV. . END-" TO FEATURE. IX1084.2 +139500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +139600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +139700 MOVE 1 TO SWITCH-IF. IX1084.2 +139800 RWR-SEQ-TEST-GF-03. IX1084.2 +139900 READ IX-FS1 END IX1084.2 +140000 MOVE "READ FAILED " TO RE-MARK IX1084.2 +140100 PERFORM FAIL IX1084.2 +140200 GO TO RWR-SEQ-WRITE-GF-03-1. IX1084.2 +140300 IF SWITCH-IF = 1 IX1084.2 +140400 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +140500 REWRITE IX-FS1R1-F-G-240 IX1084.2 +140600 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +140700 PERFORM FAIL IX1084.2 +140800 GO TO RWR-SEQ-WRITE-GF-03-1 IX1084.2 +140900 NOT INVALID KEY IX1084.2 +141000 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +141100 END-REWRITE IX1084.2 +141200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +141300 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +141400 RWR-SEQ-TEST-GF-03-1. IX1084.2 +141500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +141600 GO TO RWR-SEQ-PASS-GF-03-1. IX1084.2 +141700 RWR-SEQ-FAIL-GF-03-1. IX1084.2 +141800 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +141900 PERFORM FAIL. IX1084.2 +142000 GO TO RWR-SEQ-WRITE-GF-03-1. IX1084.2 +142100 RWR-SEQ-PASS-GF-03-1. IX1084.2 +142200 PERFORM PASS. IX1084.2 +142300 RWR-SEQ-WRITE-GF-03-1. IX1084.2 +142400 PERFORM PRINT-DETAIL. IX1084.2 +142500 IX1084.2 +142600 RWR-SEQ-TEST-GF-03-2. IX1084.2 +142700 MOVE "END-REWRITE" TO FEATURE. IX1084.2 +142800 MOVE "RWR-SEQ-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +142900 IF SWITCH-END-XXX = 1 IX1084.2 +143000 GO TO RWR-SEQ-PASS-GF-03-2. IX1084.2 +143100 RWR-SEQ-FAIL-GF-03-2. IX1084.2 +143200 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +143300 PERFORM FAIL. IX1084.2 +143400 GO TO RWR-SEQ-WRITE-GF-03-2. IX1084.2 +143500 RWR-SEQ-PASS-GF-03-2. IX1084.2 +143600 PERFORM PASS. IX1084.2 +143700 RWR-SEQ-WRITE-GF-03-2. IX1084.2 +143800 PERFORM PRINT-DETAIL. IX1084.2 +143900 IX1084.2 +144000 RWR-SEQ-TEST-GF-03-3. IX1084.2 +144100 MOVE "RWR-SEQ-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +144200 IF SWITCH-END-X9X = 9 IX1084.2 +144300 GO TO RWR-SEQ-PASS-GF-03-3. IX1084.2 +144400 RWR-SEQ-FAIL-GF-03-3. IX1084.2 +144500 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +144600 PERFORM FAIL. IX1084.2 +144700 GO TO RWR-SEQ-WRITE-GF-03-3. IX1084.2 +144800 RWR-SEQ-PASS-GF-03-3. IX1084.2 +144900 PERFORM PASS. IX1084.2 +145000 RWR-SEQ-WRITE-GF-03-3. IX1084.2 +145100 PERFORM PRINT-DETAIL. IX1084.2 +145200 IX1084.2 +145300 CLOSE IX-FS1. IX1084.2 +145400 IX1084.2 +145500 IX1084.2 +145600 CCVS-EXIT SECTION. IX1084.2 +145700 CCVS-999999. IX1084.2 +145800 GO TO CLOSE-FILES. IX1084.2 +*END-OF,IX108A +*HEADER,COBOL,IX109A +000100 IDENTIFICATION DIVISION. IX1094.2 +000200 PROGRAM-ID. IX1094.2 +000300 IX109A. IX1094.2 +000400**************************************************************** IX1094.2 +000500* * IX1094.2 +000600* VALIDATION FOR:- * IX1094.2 +000700* * IX1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +000900* * IX1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1094.2 +001100* * IX1094.2 +001200**************************************************************** IX1094.2 +001300* IX1094.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-FS3 IX1094.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1094.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1094.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THIS ROUTINE CHECKS AS IX1094.2 +001800* MANY FILE STATUS CODES AS POSSIBLE. HOWEVER, IT IS NOT IX1094.2 +001900* POSSIBLE TO CHECK ALL CODES NEITHER IN THAT PROGRAM NOR IX1094.2 +002000* IN THE FOLLOWING ONE. IX1094.2 +002100* IX1094.2 +002200* 2. THE ROUTINE READS THE CREATED FILE,VERIFIES IT AND *IX1094.2 +002300* CHECKS THE FILE STATUS CODES: IX1094.2 +002400* 00 - AFTER OPEN OUTPUT IX1094.2 +002500* 00 - AFTER WRITE IX1094.2 +002600* 21 - AFTER WRITE (VIOLATE ASCENDING SEQUENCE) IX1094.2 +002700* 00 - AFTER CLOSE OUTPUT IX1094.2 +002800* 00 - AFTER OPEN INPUT IX1094.2 +002900* 00 - AFTER READ (WITHOUT AT END) IX1094.2 +003000* 10 - AFTER READ (SEE IX-4, 1.3.4, (2) A) IX1094.2 +003100* 00 - AFTER CLOSE INPUT IX1094.2 +003200* 00 - AFTER OPEN INPUT IX1094.2 +003300* 00 - AFTER READ ... END ... IX1094.2 +003400* 10 - AFTER READ ... END ... IX1094.2 +003500* 46 - AFTER READ ... END ... IX1094.2 +003600* IX1094.2 +003700* 4. X-CARDS USED IN THIS PROGRAM: IX1094.2 +003800* IX1094.2 +003900* XXXXX024 IX1094.2 +004000* XXXXX055. IX1094.2 +004100* P XXXXX062. IX1094.2 +004200* XXXXX082. IX1094.2 +004300* XXXXX083. IX1094.2 +004400* C XXXXX084 IX1094.2 +004500* IX1094.2 +004600* IX1094.2 +004700 ENVIRONMENT DIVISION. IX1094.2 +004800 CONFIGURATION SECTION. IX1094.2 +004900 SOURCE-COMPUTER. IX1094.2 +005000 XXXXX082. IX1094.2 +005100 OBJECT-COMPUTER. IX1094.2 +005200 XXXXX083. IX1094.2 +005300 INPUT-OUTPUT SECTION. IX1094.2 +005400 FILE-CONTROL. IX1094.2 +005500P SELECT RAW-DATA ASSIGN TO IX1094.2 +005600P XXXXX062 IX1094.2 +005700P ORGANIZATION IS INDEXED IX1094.2 +005800P ACCESS MODE IS RANDOM IX1094.2 +005900P RECORD KEY IS RAW-DATA-KEY. IX1094.2 +006000* IX1094.2 +006100 SELECT PRINT-FILE ASSIGN TO IX1094.2 +006200 XXXXX055. IX1094.2 +006300* IX1094.2 +006400 SELECT IX-FS3 ASSIGN IX1094.2 +006500 XXXXX024 IX1094.2 +006600 ORGANIZATION IS INDEXED IX1094.2 +006700 ACCESS MODE IS SEQUENTIAL IX1094.2 +006800 RECORD KEY IS IX-FS3-KEY IX1094.2 +006900 FILE STATUS IS IX-FS3-STATUS. IX1094.2 +007000 IX1094.2 +007100 DATA DIVISION. IX1094.2 +007200 IX1094.2 +007300 FILE SECTION. IX1094.2 +007400P IX1094.2 +007500PFD RAW-DATA. IX1094.2 +007600P IX1094.2 +007700P01 RAW-DATA-SATZ. IX1094.2 +007800P 05 RAW-DATA-KEY PIC X(6). IX1094.2 +007900P 05 C-DATE PIC 9(6). IX1094.2 +008000P 05 C-TIME PIC 9(8). IX1094.2 +008100P 05 C-NO-OF-TESTS PIC 99. IX1094.2 +008200P 05 C-OK PIC 999. IX1094.2 +008300P 05 C-ALL PIC 999. IX1094.2 +008400P 05 C-FAIL PIC 999. IX1094.2 +008500P 05 C-DELETED PIC 999. IX1094.2 +008600P 05 C-INSPECT PIC 999. IX1094.2 +008700P 05 C-NOTE PIC X(13). IX1094.2 +008800P 05 C-INDENT PIC X. IX1094.2 +008900P 05 C-ABORT PIC X(8). IX1094.2 +009000 IX1094.2 +009100 FD PRINT-FILE. IX1094.2 +009200 IX1094.2 +009300 01 PRINT-REC PIC X(120). IX1094.2 +009400 IX1094.2 +009500 01 DUMMY-RECORD PIC X(120). IX1094.2 +009600 IX1094.2 +009700 FD IX-FS3 IX1094.2 +009800C DATA RECORDS IX-FS3R1-F-G-240 IX1094.2 +009900C LABEL RECORD STANDARD IX1094.2 +010000 RECORD 240 IX1094.2 +010100 BLOCK CONTAINS 2 RECORDS. IX1094.2 +010200 IX1094.2 +010300 01 IX-FS3R1-F-G-240. IX1094.2 +010400 05 IX-FS3-REC-120 PIC X(120). IX1094.2 +010500 05 IX-FS3-REC-120-240. IX1094.2 +010600 10 FILLER PIC X(8). IX1094.2 +010700 10 IX-FS3-KEY PIC X(29). IX1094.2 +010800 10 FILLER PIC X(9). IX1094.2 +010900 10 IX-FS3-ALTER-KEY PIC X(29). IX1094.2 +011000 10 FILLER PIC X(45). IX1094.2 +011100 IX1094.2 +011200 IX1094.2 +011300 WORKING-STORAGE SECTION. IX1094.2 +011400 IX1094.2 +011500 01 GRP-0101. IX1094.2 +011600 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1094.2 +011700 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1094.2 +011800 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1094.2 +011900 IX1094.2 +012000 01 GRP-0102. IX1094.2 +012100 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1094.2 +012200 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1094.2 +012300 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1094.2 +012400 IX1094.2 +012500 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1094.2 +012600 IX1094.2 +012700 01 EOF-FLAG PIC 9 VALUE ZERO. IX1094.2 +012800 IX1094.2 +012900 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1094.2 +013000 IX1094.2 +013100 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1094.2 +013200 IX1094.2 +013300 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1094.2 +013400 IX1094.2 +013500 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1094.2 +013600 IX1094.2 +013700 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1094.2 +013800 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1094.2 +013900 IX1094.2 +014000 01 IX-FS3-STATUS. IX1094.2 +014100 05 IX-FS3-STAT1 PIC X. IX1094.2 +014200 05 IX-FS3-STAT2 PIC X. IX1094.2 +014300 IX1094.2 +014400 01 COUNT-OF-RECS PIC 9(5). IX1094.2 +014500 IX1094.2 +014600 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1094.2 +014700 IX1094.2 +014800 01 FILE-RECORD-INFORMATION-REC. IX1094.2 +014900 05 FILE-RECORD-INFO-SKELETON. IX1094.2 +015000 10 FILLER PIC X(48) VALUE IX1094.2 +015100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1094.2 +015200 10 FILLER PIC X(46) VALUE IX1094.2 +015300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1094.2 +015400 10 FILLER PIC X(26) VALUE IX1094.2 +015500 ",LFIL=000000,ORG= ,LBLR= ". IX1094.2 +015600 10 FILLER PIC X(37) VALUE IX1094.2 +015700 ",RECKEY= ". IX1094.2 +015800 10 FILLER PIC X(38) VALUE IX1094.2 +015900 ",ALTKEY1= ". IX1094.2 +016000 10 FILLER PIC X(38) VALUE IX1094.2 +016100 ",ALTKEY2= ". IX1094.2 +016200 10 FILLER PIC X(7) VALUE SPACE. IX1094.2 +016300 05 FILE-RECORD-INFO OCCURS 10. IX1094.2 +016400 10 FILE-RECORD-INFO-P1-120. IX1094.2 +016500 15 FILLER PIC X(5). IX1094.2 +016600 15 XFILE-NAME PIC X(6). IX1094.2 +016700 15 FILLER PIC X(8). IX1094.2 +016800 15 XRECORD-NAME PIC X(6). IX1094.2 +016900 15 FILLER PIC X(1). IX1094.2 +017000 15 REELUNIT-NUMBER PIC 9(1). IX1094.2 +017100 15 FILLER PIC X(7). IX1094.2 +017200 15 XRECORD-NUMBER PIC 9(6). IX1094.2 +017300 15 FILLER PIC X(6). IX1094.2 +017400 15 UPDATE-NUMBER PIC 9(2). IX1094.2 +017500 15 FILLER PIC X(5). IX1094.2 +017600 15 ODO-NUMBER PIC 9(4). IX1094.2 +017700 15 FILLER PIC X(5). IX1094.2 +017800 15 XPROGRAM-NAME PIC X(5). IX1094.2 +017900 15 FILLER PIC X(7). IX1094.2 +018000 15 XRECORD-LENGTH PIC 9(6). IX1094.2 +018100 15 FILLER PIC X(7). IX1094.2 +018200 15 CHARS-OR-RECORDS PIC X(2). IX1094.2 +018300 15 FILLER PIC X(1). IX1094.2 +018400 15 XBLOCK-SIZE PIC 9(4). IX1094.2 +018500 15 FILLER PIC X(6). IX1094.2 +018600 15 RECORDS-IN-FILE PIC 9(6). IX1094.2 +018700 15 FILLER PIC X(5). IX1094.2 +018800 15 XFILE-ORGANIZATION PIC X(2). IX1094.2 +018900 15 FILLER PIC X(6). IX1094.2 +019000 15 XLABEL-TYPE PIC X(1). IX1094.2 +019100 10 FILE-RECORD-INFO-P121-240. IX1094.2 +019200 15 FILLER PIC X(8). IX1094.2 +019300 15 XRECORD-KEY PIC X(29). IX1094.2 +019400 15 FILLER PIC X(9). IX1094.2 +019500 15 ALTERNATE-KEY1 PIC X(29). IX1094.2 +019600 15 FILLER PIC X(9). IX1094.2 +019700 15 ALTERNATE-KEY2 PIC X(29). IX1094.2 +019800 15 FILLER PIC X(7). IX1094.2 +019900 IX1094.2 +020000 01 TEST-RESULTS. IX1094.2 +020100 02 FILLER PIC X VALUE SPACE. IX1094.2 +020200 02 FEATURE PIC X(20) VALUE SPACE. IX1094.2 +020300 02 FILLER PIC X VALUE SPACE. IX1094.2 +020400 02 P-OR-F PIC X(5) VALUE SPACE. IX1094.2 +020500 02 FILLER PIC X VALUE SPACE. IX1094.2 +020600 02 PAR-NAME. IX1094.2 +020700 03 FILLER PIC X(19) VALUE SPACE. IX1094.2 +020800 03 PARDOT-X PIC X VALUE SPACE. IX1094.2 +020900 03 DOTVALUE PIC 99 VALUE ZERO. IX1094.2 +021000 02 FILLER PIC X(8) VALUE SPACE. IX1094.2 +021100 02 RE-MARK PIC X(61). IX1094.2 +021200 01 TEST-COMPUTED. IX1094.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1094.2 +021400 02 FILLER PIC X(17) VALUE IX1094.2 +021500 " COMPUTED=". IX1094.2 +021600 02 COMPUTED-X. IX1094.2 +021700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1094.2 +021800 03 COMPUTED-N REDEFINES COMPUTED-A IX1094.2 +021900 PIC -9(9).9(9). IX1094.2 +022000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1094.2 +022100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1094.2 +022200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1094.2 +022300 03 CM-18V0 REDEFINES COMPUTED-A. IX1094.2 +022400 04 COMPUTED-18V0 PIC -9(18). IX1094.2 +022500 04 FILLER PIC X. IX1094.2 +022600 03 FILLER PIC X(50) VALUE SPACE. IX1094.2 +022700 01 TEST-CORRECT. IX1094.2 +022800 02 FILLER PIC X(30) VALUE SPACE. IX1094.2 +022900 02 FILLER PIC X(17) VALUE " CORRECT =". IX1094.2 +023000 02 CORRECT-X. IX1094.2 +023100 03 CORRECT-A PIC X(20) VALUE SPACE. IX1094.2 +023200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1094.2 +023300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1094.2 +023400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1094.2 +023500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1094.2 +023600 03 CR-18V0 REDEFINES CORRECT-A. IX1094.2 +023700 04 CORRECT-18V0 PIC -9(18). IX1094.2 +023800 04 FILLER PIC X. IX1094.2 +023900 03 FILLER PIC X(2) VALUE SPACE. IX1094.2 +024000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1094.2 +024100 01 CCVS-C-1. IX1094.2 +024200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1094.2 +024300- "SS PARAGRAPH-NAME IX1094.2 +024400- " REMARKS". IX1094.2 +024500 02 FILLER PIC X(20) VALUE SPACE. IX1094.2 +024600 01 CCVS-C-2. IX1094.2 +024700 02 FILLER PIC X VALUE SPACE. IX1094.2 +024800 02 FILLER PIC X(6) VALUE "TESTED". IX1094.2 +024900 02 FILLER PIC X(15) VALUE SPACE. IX1094.2 +025000 02 FILLER PIC X(4) VALUE "FAIL". IX1094.2 +025100 02 FILLER PIC X(94) VALUE SPACE. IX1094.2 +025200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1094.2 +025300 01 REC-CT PIC 99 VALUE ZERO. IX1094.2 +025400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1094.2 +025900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1094.2 +026000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1094.2 +026100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1094.2 +026200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1094.2 +026300 01 CCVS-H-1. IX1094.2 +026400 02 FILLER PIC X(39) VALUE SPACES. IX1094.2 +026500 02 FILLER PIC X(42) VALUE IX1094.2 +026600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1094.2 +026700 02 FILLER PIC X(39) VALUE SPACES. IX1094.2 +026800 01 CCVS-H-2A. IX1094.2 +026900 02 FILLER PIC X(40) VALUE SPACE. IX1094.2 +027000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1094.2 +027100 02 FILLER PIC XXXX VALUE IX1094.2 +027200 "4.2 ". IX1094.2 +027300 02 FILLER PIC X(28) VALUE IX1094.2 +027400 " COPY - NOT FOR DISTRIBUTION". IX1094.2 +027500 02 FILLER PIC X(41) VALUE SPACE. IX1094.2 +027600 IX1094.2 +027700 01 CCVS-H-2B. IX1094.2 +027800 02 FILLER PIC X(15) VALUE IX1094.2 +027900 "TEST RESULT OF ". IX1094.2 +028000 02 TEST-ID PIC X(9). IX1094.2 +028100 02 FILLER PIC X(4) VALUE IX1094.2 +028200 " IN ". IX1094.2 +028300 02 FILLER PIC X(12) VALUE IX1094.2 +028400 " HIGH ". IX1094.2 +028500 02 FILLER PIC X(22) VALUE IX1094.2 +028600 " LEVEL VALIDATION FOR ". IX1094.2 +028700 02 FILLER PIC X(58) VALUE IX1094.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +028900 01 CCVS-H-3. IX1094.2 +029000 02 FILLER PIC X(34) VALUE IX1094.2 +029100 " FOR OFFICIAL USE ONLY ". IX1094.2 +029200 02 FILLER PIC X(58) VALUE IX1094.2 +029300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1094.2 +029400 02 FILLER PIC X(28) VALUE IX1094.2 +029500 " COPYRIGHT 1985 ". IX1094.2 +029600 01 CCVS-E-1. IX1094.2 +029700 02 FILLER PIC X(52) VALUE SPACE. IX1094.2 +029800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1094.2 +029900 02 ID-AGAIN PIC X(9). IX1094.2 +030000 02 FILLER PIC X(45) VALUE SPACES. IX1094.2 +030100 01 CCVS-E-2. IX1094.2 +030200 02 FILLER PIC X(31) VALUE SPACE. IX1094.2 +030300 02 FILLER PIC X(21) VALUE SPACE. IX1094.2 +030400 02 CCVS-E-2-2. IX1094.2 +030500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1094.2 +030600 03 FILLER PIC X VALUE SPACE. IX1094.2 +030700 03 ENDER-DESC PIC X(44) VALUE IX1094.2 +030800 "ERRORS ENCOUNTERED". IX1094.2 +030900 01 CCVS-E-3. IX1094.2 +031000 02 FILLER PIC X(22) VALUE IX1094.2 +031100 " FOR OFFICIAL USE ONLY". IX1094.2 +031200 02 FILLER PIC X(12) VALUE SPACE. IX1094.2 +031300 02 FILLER PIC X(58) VALUE IX1094.2 +031400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +031500 02 FILLER PIC X(13) VALUE SPACE. IX1094.2 +031600 02 FILLER PIC X(15) VALUE IX1094.2 +031700 " COPYRIGHT 1985". IX1094.2 +031800 01 CCVS-E-4. IX1094.2 +031900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1094.2 +032000 02 FILLER PIC X(4) VALUE " OF ". IX1094.2 +032100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1094.2 +032200 02 FILLER PIC X(40) VALUE IX1094.2 +032300 " TESTS WERE EXECUTED SUCCESSFULLY". IX1094.2 +032400 01 XXINFO. IX1094.2 +032500 02 FILLER PIC X(19) VALUE IX1094.2 +032600 "*** INFORMATION ***". IX1094.2 +032700 02 INFO-TEXT. IX1094.2 +032800 04 FILLER PIC X(8) VALUE SPACE. IX1094.2 +032900 04 XXCOMPUTED PIC X(20). IX1094.2 +033000 04 FILLER PIC X(5) VALUE SPACE. IX1094.2 +033100 04 XXCORRECT PIC X(20). IX1094.2 +033200 02 INF-ANSI-REFERENCE PIC X(48). IX1094.2 +033300 01 HYPHEN-LINE. IX1094.2 +033400 02 FILLER PIC IS X VALUE IS SPACE. IX1094.2 +033500 02 FILLER PIC IS X(65) VALUE IS "************************IX1094.2 +033600- "*****************************************". IX1094.2 +033700 02 FILLER PIC IS X(54) VALUE IS "************************IX1094.2 +033800- "******************************". IX1094.2 +033900 01 TEST-NO PIC 99. IX1094.2 +034000 01 CCVS-PGM-ID PIC X(9) VALUE IX1094.2 +034100 "IX109A". IX1094.2 +034200 PROCEDURE DIVISION. IX1094.2 +034300 DECLARATIVES. IX1094.2 +034400 IX1094.2 +034500 SECT-IX109-0002 SECTION. IX1094.2 +034600 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1094.2 +034700 INPUT-PROCESS. IX1094.2 +034800 IF TEST-NO = 13 IX1094.2 +034900 GO TO D-R-TEST-F1-06-1. IX1094.2 +035000 IF STATUS-TEST-10 EQUAL TO 1 IX1094.2 +035100 IF IX-FS3-STAT1 EQUAL TO "1" IX1094.2 +035200 MOVE 1 TO EOF-FLAG IX1094.2 +035300 ELSE IX1094.2 +035400 IF IX-FS3-STAT1 GREATER THAN "1" IX1094.2 +035500 MOVE 1 TO PERM-ERRORS. IX1094.2 +035600 GO TO DECL-EXIT. IX1094.2 +035700 D-R-TEST-F1-06-1. IX1094.2 +035800 IF IX-FS3-STATUS EQUAL TO "46" IX1094.2 +035900 GO TO D-R-PASS-F1-06-0. IX1094.2 +036000 D-R-FAIL-F1-06-0. IX1094.2 +036100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +036200 MOVE "46" TO CORRECT-X. IX1094.2 +036300 MOVE "IX-5, 1.3.4, (5) E 3)" TO RE-MARK. IX1094.2 +036400 PERFORM D-FAIL. IX1094.2 +036500 GO TO D-R-WRITE-F1-06-0. IX1094.2 +036600 D-R-PASS-F1-06-0. IX1094.2 +036700 PERFORM D-PASS. IX1094.2 +036800 D-R-WRITE-F1-06-0. IX1094.2 +036900 MOVE "READ. 46 EXP." TO FEATURE. IX1094.2 +037000 MOVE "REA-TEST-F1-06-0" TO PAR-NAME. IX1094.2 +037100 PERFORM D-PRINT-DETAIL. IX1094.2 +037200 D-CLOSE-FILES. IX1094.2 +037300 CLOSE IX-FS3. IX1094.2 +037400P OPEN I-O RAW-DATA. IX1094.2 +037500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +037600P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1094.2 +037700P MOVE "OK. " TO C-ABORT. IX1094.2 +037800P MOVE PASS-COUNTER TO C-OK. IX1094.2 +037900P MOVE ERROR-HOLD TO C-ALL. IX1094.2 +038000P MOVE ERROR-COUNTER TO C-FAIL. IX1094.2 +038100P MOVE DELETE-COUNTER TO C-DELETED. IX1094.2 +038200P MOVE INSPECT-COUNTER TO C-INSPECT. IX1094.2 +038300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1094.2 +038400PD-END-E-2. IX1094.2 +038500P CLOSE RAW-DATA. IX1094.2 +038600 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1094.2 +038700 CLOSE PRINT-FILE. IX1094.2 +038800 D-TERMINATE-CCVS. IX1094.2 +038900S EXIT PROGRAM. IX1094.2 +039000SD-TERMINATE-CALL. IX1094.2 +039100 STOP RUN. IX1094.2 +039200 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1094.2 +039300 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1094.2 +039400 D-PRINT-DETAIL. IX1094.2 +039500 IF REC-CT NOT EQUAL TO ZERO IX1094.2 +039600 MOVE "." TO PARDOT-X IX1094.2 +039700 MOVE REC-CT TO DOTVALUE. IX1094.2 +039800 MOVE TEST-RESULTS TO PRINT-REC. IX1094.2 +039900 PERFORM D-WRITE-LINE. IX1094.2 +040000 IF P-OR-F EQUAL TO "FAIL*" IX1094.2 +040100 PERFORM D-WRITE-LINE IX1094.2 +040200 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1094.2 +040300 ELSE IX1094.2 +040400 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1094.2 +040500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1094.2 +040600 MOVE SPACE TO CORRECT-X. IX1094.2 +040700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1094.2 +040800 MOVE SPACE TO RE-MARK. IX1094.2 +040900 D-END-ROUTINE. IX1094.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1094.2 +041100 PERFORM D-WRITE-LINE 5 TIMES. IX1094.2 +041200 D-END-RTN-EXIT. IX1094.2 +041300 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1094.2 +041400 PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +041500 D-END-ROUTINE-1. IX1094.2 +041600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1094.2 +041700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1094.2 +041800 ADD PASS-COUNTER TO ERROR-HOLD. IX1094.2 +041900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1094.2 +042000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1094.2 +042100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1094.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1094.2 +042300 D-END-ROUTINE-12. IX1094.2 +042400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1094.2 +042500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1094.2 +042600 MOVE "NO " TO ERROR-TOTAL IX1094.2 +042700 ELSE IX1094.2 +042800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1094.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +043000 PERFORM D-WRITE-LINE. IX1094.2 +043100 D-END-ROUTINE-13. IX1094.2 +043200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1094.2 +043300 MOVE "NO " TO ERROR-TOTAL ELSE IX1094.2 +043400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1094.2 +043500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1094.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +043700 PERFORM D-WRITE-LINE. IX1094.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO IX1094.2 +043900 MOVE "NO " TO ERROR-TOTAL IX1094.2 +044000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1094.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1094.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1094.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1094.2 +044400 D-WRITE-LINE. IX1094.2 +044500 ADD 1 TO RECORD-COUNT. IX1094.2 +044600Y IF RECORD-COUNT GREATER 42 IX1094.2 +044700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1094.2 +044800Y MOVE SPACE TO DUMMY-RECORD IX1094.2 +044900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1094.2 +045000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1094.2 +045100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1094.2 +045200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1094.2 +045300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1094.2 +045400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1094.2 +045800Y MOVE ZERO TO RECORD-COUNT. IX1094.2 +045900 PERFORM D-WRT-LN. IX1094.2 +046000 D-WRT-LN. IX1094.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1094.2 +046200 MOVE SPACE TO DUMMY-RECORD. IX1094.2 +046300 D-FAIL-ROUTINE. IX1094.2 +046400 IF COMPUTED-X NOT EQUAL TO SPACE IX1094.2 +046500 GO TO D-FAIL-ROUTINE-WRITE. IX1094.2 +046600 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1094.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +046800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1094.2 +046900 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +047100 GO TO D-FAIL-ROUTINE-EX. IX1094.2 +047200 D-FAIL-ROUTINE-WRITE. IX1094.2 +047300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1094.2 +047400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1094.2 +047500 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +047600 MOVE SPACES TO COR-ANSI-REFERENCE. IX1094.2 +047700 D-FAIL-ROUTINE-EX. EXIT. IX1094.2 +047800 D-BAIL-OUT. IX1094.2 +047900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1094.2 +048000 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1094.2 +048100 D-BAIL-OUT-WRITE. IX1094.2 +048200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1094.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +048400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +048500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +048600 D-BAIL-OUT-EX. EXIT. IX1094.2 +048700 DECL-EXIT. EXIT. IX1094.2 +048800 END DECLARATIVES. IX1094.2 +048900 IX1094.2 +049000 IX1094.2 +049100 CCVS1 SECTION. IX1094.2 +049200 OPEN-FILES. IX1094.2 +049300P OPEN I-O RAW-DATA. IX1094.2 +049400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +049500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1094.2 +049600P MOVE "ABORTED " TO C-ABORT. IX1094.2 +049700P ADD 1 TO C-NO-OF-TESTS. IX1094.2 +049800P ACCEPT C-DATE FROM DATE. IX1094.2 +049900P ACCEPT C-TIME FROM TIME. IX1094.2 +050000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1094.2 +050100PEND-E-1. IX1094.2 +050200P CLOSE RAW-DATA. IX1094.2 +050300 OPEN OUTPUT PRINT-FILE. IX1094.2 +050400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1094.2 +050500 MOVE SPACE TO TEST-RESULTS. IX1094.2 +050600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1094.2 +050700 MOVE ZERO TO REC-SKL-SUB. IX1094.2 +050800 PERFORM CCVS-INIT-FILE 9 TIMES. IX1094.2 +050900 CCVS-INIT-FILE. IX1094.2 +051000 ADD 1 TO REC-SKL-SUB. IX1094.2 +051100 MOVE FILE-RECORD-INFO-SKELETON IX1094.2 +051200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1094.2 +051300 CCVS-INIT-EXIT. IX1094.2 +051400 GO TO CCVS1-EXIT. IX1094.2 +051500 CLOSE-FILES. IX1094.2 +051600P OPEN I-O RAW-DATA. IX1094.2 +051700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +051800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1094.2 +051900P MOVE "OK. " TO C-ABORT. IX1094.2 +052000P MOVE PASS-COUNTER TO C-OK. IX1094.2 +052100P MOVE ERROR-HOLD TO C-ALL. IX1094.2 +052200P MOVE ERROR-COUNTER TO C-FAIL. IX1094.2 +052300P MOVE DELETE-COUNTER TO C-DELETED. IX1094.2 +052400P MOVE INSPECT-COUNTER TO C-INSPECT. IX1094.2 +052500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1094.2 +052600PEND-E-2. IX1094.2 +052700P CLOSE RAW-DATA. IX1094.2 +052800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1094.2 +052900 TERMINATE-CCVS. IX1094.2 +053000S EXIT PROGRAM. IX1094.2 +053100STERMINATE-CALL. IX1094.2 +053200 STOP RUN. IX1094.2 +053300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1094.2 +053400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1094.2 +053500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1094.2 +053600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1094.2 +053700 MOVE "****TEST DELETED****" TO RE-MARK. IX1094.2 +053800 PRINT-DETAIL. IX1094.2 +053900 IF REC-CT NOT EQUAL TO ZERO IX1094.2 +054000 MOVE "." TO PARDOT-X IX1094.2 +054100 MOVE REC-CT TO DOTVALUE. IX1094.2 +054200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1094.2 +054300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1094.2 +054400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1094.2 +054500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1094.2 +054600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1094.2 +054700 MOVE SPACE TO CORRECT-X. IX1094.2 +054800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1094.2 +054900 MOVE SPACE TO RE-MARK. IX1094.2 +055000 HEAD-ROUTINE. IX1094.2 +055100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1094.2 +055400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1094.2 +055500 COLUMN-NAMES-ROUTINE. IX1094.2 +055600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +055700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +055900 END-ROUTINE. IX1094.2 +056000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1094.2 +056100 END-RTN-EXIT. IX1094.2 +056200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +056300 END-ROUTINE-1. IX1094.2 +056400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1094.2 +056500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1094.2 +056600 ADD PASS-COUNTER TO ERROR-HOLD. IX1094.2 +056700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1094.2 +056800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1094.2 +056900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1094.2 +057000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1094.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1094.2 +057200 END-ROUTINE-12. IX1094.2 +057300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1094.2 +057400 IF ERROR-COUNTER IS EQUAL TO ZERO IX1094.2 +057500 MOVE "NO " TO ERROR-TOTAL IX1094.2 +057600 ELSE IX1094.2 +057700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1094.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +057900 PERFORM WRITE-LINE. IX1094.2 +058000 END-ROUTINE-13. IX1094.2 +058100 IF DELETE-COUNTER IS EQUAL TO ZERO IX1094.2 +058200 MOVE "NO " TO ERROR-TOTAL ELSE IX1094.2 +058300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1094.2 +058400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1094.2 +058500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +058600 IF INSPECT-COUNTER EQUAL TO ZERO IX1094.2 +058700 MOVE "NO " TO ERROR-TOTAL IX1094.2 +058800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1094.2 +058900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1094.2 +059000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +059100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +059200 WRITE-LINE. IX1094.2 +059300 ADD 1 TO RECORD-COUNT. IX1094.2 +059400Y IF RECORD-COUNT GREATER 42 IX1094.2 +059500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1094.2 +059600Y MOVE SPACE TO DUMMY-RECORD IX1094.2 +059700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1094.2 +059800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1094.2 +059900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1094.2 +060000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1094.2 +060100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1094.2 +060200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1094.2 +060600Y MOVE ZERO TO RECORD-COUNT. IX1094.2 +060700 PERFORM WRT-LN. IX1094.2 +060800 WRT-LN. IX1094.2 +060900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1094.2 +061000 MOVE SPACE TO DUMMY-RECORD. IX1094.2 +061100 BLANK-LINE-PRINT. IX1094.2 +061200 PERFORM WRT-LN. IX1094.2 +061300 FAIL-ROUTINE. IX1094.2 +061400 IF COMPUTED-X NOT EQUAL TO SPACE IX1094.2 +061500 GO TO FAIL-ROUTINE-WRITE. IX1094.2 +061600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1094.2 +061700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +061800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1094.2 +061900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +062000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +062100 GO TO FAIL-ROUTINE-EX. IX1094.2 +062200 FAIL-ROUTINE-WRITE. IX1094.2 +062300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1094.2 +062400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1094.2 +062500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1094.2 +062600 MOVE SPACES TO COR-ANSI-REFERENCE. IX1094.2 +062700 FAIL-ROUTINE-EX. EXIT. IX1094.2 +062800 BAIL-OUT. IX1094.2 +062900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1094.2 +063000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1094.2 +063100 BAIL-OUT-WRITE. IX1094.2 +063200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1094.2 +063300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +063400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +063500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +063600 BAIL-OUT-EX. EXIT. IX1094.2 +063700 CCVS1-EXIT. IX1094.2 +063800 EXIT. IX1094.2 +063900 IX1094.2 +064000 SECT-IX109A-0003 SECTION. IX1094.2 +064100 SEQ-INIT-010. IX1094.2 +064200 MOVE ZERO TO TEST-NO. IX1094.2 +064300 MOVE "IX-FS3" TO XFILE-NAME (1). IX1094.2 +064400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1094.2 +064500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1094.2 +064600 MOVE 000240 TO XRECORD-LENGTH (1). IX1094.2 +064700 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1094.2 +064800 MOVE 0002 TO XBLOCK-SIZE (1). IX1094.2 +064900 MOVE 000050 TO RECORDS-IN-FILE (1). IX1094.2 +065000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1094.2 +065100 MOVE "S" TO XLABEL-TYPE (1). IX1094.2 +065200 MOVE 000001 TO XRECORD-NUMBER (1). IX1094.2 +065300 MOVE 0 TO COUNT-OF-RECS. IX1094.2 +065400 IX1094.2 +065500******************************************************************IX1094.2 +065600* TEST 1 *IX1094.2 +065700* OPEN OUTPUT ... 00 EXPECTED *IX1094.2 +065800* IX-3, 1.3.4 (1) A *IX1094.2 +065900* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1094.2 +066000* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1094.2 +066100******************************************************************IX1094.2 +066200 OPN-INIT-GF-01-0. IX1094.2 +066300 MOVE 1 TO STATUS-TEST-00. IX1094.2 +066400 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +066500 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1094.2 +066600 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +066700 OPEN IX1094.2 +066800 OUTPUT IX-FS3. IX1094.2 +066900 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +067000 GO TO OPN-PASS-GF-01-0. IX1094.2 +067100 OPN-FAIL-GF-01-0. IX1094.2 +067200 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +067300 PERFORM FAIL. IX1094.2 +067400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +067500 MOVE "00" TO CORRECT-X. IX1094.2 +067600 GO TO OPN-WRITE-GF-01-0. IX1094.2 +067700 OPN-PASS-GF-01-0. IX1094.2 +067800 PERFORM PASS. IX1094.2 +067900 OPN-WRITE-GF-01-0. IX1094.2 +068000 PERFORM PRINT-DETAIL. IX1094.2 +068100******************************************************************IX1094.2 +068200* TEST 2 *IX1094.2 +068300* WRITE 00 EXPECTED *IX1094.2 +068400* IX-3, 1.3.4 (1) A *IX1094.2 +068500* CREATING A INDEXED FILE WITH 50 RECORDS *IX1094.2 +068600* KEY: FROM 000000001 TO 000000050 *IX1094.2 +068700******************************************************************IX1094.2 +068800 WRI-INIT-GF-01-0. IX1094.2 +068900 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +069000 MOVE 0 TO STATUS-TEST-00. IX1094.2 +069100 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1094.2 +069200 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +069300 WRI-TEST-GF-01-0. IX1094.2 +069400 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY. IX1094.2 +069500 MOVE GRP-0101 TO XRECORD-KEY (1). IX1094.2 +069600 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1094.2 +069700* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1094.2 +069800 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1094.2 +069900 WRITE IX-FS3R1-F-G-240. IX1094.2 +070000 IF IX-FS3-STATUS NOT = "00" IX1094.2 +070100 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +070200 ELSE IX1094.2 +070300 ADD 1 TO COUNT-OF-RECS. IX1094.2 +070400 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1094.2 +070500 GO TO WRI-TEST-GF-01-1. IX1094.2 +070600 ADD 1 TO XRECORD-NUMBER (1). IX1094.2 +070700 GO TO WRI-TEST-GF-01-0. IX1094.2 +070800 WRI-TEST-GF-01-1. IX1094.2 +070900 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1094.2 +071000 GO TO WRI-PASS-GF-01-0. IX1094.2 +071100 WRI-FAIL-GF-01-0. IX1094.2 +071200 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +071300 PERFORM FAIL. IX1094.2 +071400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1094.2 +071500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1094.2 +071600 GO TO WRI-WRITE-GF-01-0. IX1094.2 +071700 WRI-PASS-GF-01-0. IX1094.2 +071800 PERFORM PASS. IX1094.2 +071900 WRI-WRITE-GF-01-0. IX1094.2 +072000 PERFORM PRINT-DETAIL. IX1094.2 +072100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1094.2 +072200 MOVE "CREATE FILE IX-FS3" TO FEATURE. IX1094.2 +072300 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1094.2 +072400 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1094.2 +072500 PERFORM PRINT-DETAIL. IX1094.2 +072600 IX1094.2 +072700******************************************************************IX1094.2 +072800* TEST 3 *IX1094.2 +072900* WRITE (WRONG SEQUENCE) 21 EXPECTED *IX1094.2 +073000* IX-4, 1.3.4 (3) A *IX1094.2 +073100* KEY: 000000049 *IX1094.2 +073200******************************************************************IX1094.2 +073300 WRI-INIT-GF-02-0. IX1094.2 +073400 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +073500 MOVE 0 TO STATUS-TEST-00. IX1094.2 +073600 MOVE "WRITE: 21 EXP." TO FEATURE. IX1094.2 +073700 MOVE "WRI-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +073800 MOVE 49 TO XRECORD-NUMBER (1). IX1094.2 +073900 WRI-TEST-GF-02-0. IX1094.2 +074000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY. IX1094.2 +074100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1094.2 +074200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1094.2 +074300 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1094.2 +074400 WRITE IX-FS3R1-F-G-240 INVALID KEY GO TO WRI-TEST-GF-02-1. IX1094.2 +074500 WRI-TEST-GF-02-1. IX1094.2 +074600 IF IX-FS3-STATUS = "21" IX1094.2 +074700 GO TO WRI-PASS-GF-02-0. IX1094.2 +074800 WRI-FAIL-GF-02-0. IX1094.2 +074900 MOVE "IX-4, 1.3.4, (3) A. " TO RE-MARK. IX1094.2 +075000 PERFORM FAIL. IX1094.2 +075100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +075200 MOVE "21" TO CORRECT-X. IX1094.2 +075300 GO TO WRI-WRITE-GF-02-0. IX1094.2 +075400 WRI-PASS-GF-02-0. IX1094.2 +075500 PERFORM PASS. IX1094.2 +075600 WRI-WRITE-GF-02-0. IX1094.2 +075700 PERFORM PRINT-DETAIL. IX1094.2 +075800 IX1094.2 +075900******************************************************************IX1094.2 +076000* TEST 4 *IX1094.2 +076100* CLOSE OUTPUT 00 EXPECTED *IX1094.2 +076200* IX-3, 1.3.4 (1) A *IX1094.2 +076300******************************************************************IX1094.2 +076400 CLO-INIT-GF-01-0. IX1094.2 +076500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +076600 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1094.2 +076700 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +076800 CLO-TEST-GF-01-0. IX1094.2 +076900 CLOSE IX-FS3. IX1094.2 +077000 IF IX-FS3-STATUS = "00" IX1094.2 +077100 GO TO CLO-PASS-GF-01-0. IX1094.2 +077200 CLO-FAIL-GF-01-0. IX1094.2 +077300 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +077400 PERFORM FAIL. IX1094.2 +077500 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +077600 MOVE "00" TO CORRECT-X. IX1094.2 +077700 GO TO CLO-WRITE-GF-01-0. IX1094.2 +077800 CLO-PASS-GF-01-0. IX1094.2 +077900 PERFORM PASS. IX1094.2 +078000 CLO-WRITE-GF-01-0. IX1094.2 +078100 PERFORM PRINT-DETAIL. IX1094.2 +078200 IX1094.2 +078300******************************************************************IX1094.2 +078400* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1094.2 +078500******************************************************************IX1094.2 +078600 IX1094.2 +078700******************************************************************IX1094.2 +078800* TEST 5 *IX1094.2 +078900* OPEN INPUT 00 EXPECTED *IX1094.2 +079000* IX-3, 1.3.4 (1) A *IX1094.2 +079100******************************************************************IX1094.2 +079200 OPN-INIT-GF-02-0. IX1094.2 +079300 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +079400 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1094.2 +079500 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +079600 OPN-TEST-GF-02-0. IX1094.2 +079700 OPEN IX1094.2 +079800 INPUT IX-FS3. IX1094.2 +079900 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +080000 GO TO OPN-PASS-GF-02-0. IX1094.2 +080100 OPN-FAIL-GF-02-0. IX1094.2 +080200 MOVE "IX-3, 1.3.4, (1) A." TO RE-MARK. IX1094.2 +080300 PERFORM FAIL. IX1094.2 +080400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +080500 MOVE "00" TO CORRECT-X. IX1094.2 +080600 GO TO OPN-WRITE-GF-02-0. IX1094.2 +080700 OPN-PASS-GF-02-0. IX1094.2 +080800 PERFORM PASS. IX1094.2 +080900 OPN-WRITE-GF-02-0. IX1094.2 +081000 PERFORM PRINT-DETAIL. IX1094.2 +081100******************************************************************IX1094.2 +081200* STATUS 10 CHECK ON INPUT FILE IX-FS3. *IX1094.2 +081300* THIS TEST READS AND VERIFIES THE RECORDS WRITTEN IN *IX1094.2 +081400* INX-TEST-004. THE USE ON INPUT PROCESSES THE AT END *IX1094.2 +081500* CONDITION. THERE IS NO AT END PHRASE IN THE READ STATEMENT. *IX1094.2 +081600******************************************************************IX1094.2 +081700 REA-INIT-F1-01-0. IX1094.2 +081800 MOVE 1 TO STATUS-TEST-10. IX1094.2 +081900 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +082000 MOVE ZERO TO COUNT-OF-RECS. IX1094.2 +082100 MOVE ZERO TO RECORDS-IN-ERROR. IX1094.2 +082200 MOVE ZERO TO PERM-ERRORS. IX1094.2 +082300 MOVE ZERO TO EOF-FLAG. IX1094.2 +082400 REA-TEST-F1-01-0. IX1094.2 +082500 READ IX-FS3. IX1094.2 +082600 IF EOF-FLAG EQUAL TO 1 IX1094.2 +082700 GO TO REA-TEST-F1-01-1. IX1094.2 +082800 MOVE IX-FS3R1-F-G-240 TO FILE-RECORD-INFO (1). IX1094.2 +082900 ADD 1 TO COUNT-OF-RECS. IX1094.2 +083000 IF COUNT-OF-RECS GREATER THAN 50 IX1094.2 +083100 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX1094.2 +083200 GO TO REA-FAIL-F1-01-0. IX1094.2 +083300 IF COUNT-OF-RECS LESS THAN 51 IX1094.2 +083400 IF IX-FS3-STATUS NOT = "00" IX1094.2 +083500 MOVE 1 TO STATUS-TEST-READ. IX1094.2 +083600 IF PERM-ERRORS EQUAL TO 1 IX1094.2 +083700 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +083800 GO TO REA-TEST-F1-01-1. IX1094.2 +083900 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) IX1094.2 +084000 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +084100 GO TO REA-TEST-F1-01-1. IX1094.2 +084200 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS3" IX1094.2 +084300 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +084400 GO TO REA-TEST-F1-01-1. IX1094.2 +084500 MOVE XRECORD-KEY (1) TO GRP-0101. IX1094.2 +084600 IF GRP-0101-KEY NOT EQUAL TO COUNT-OF-RECS IX1094.2 +084700 ADD 1 TO RECORDS-IN-ERROR. IX1094.2 +084800 GO TO REA-TEST-F1-01-0. IX1094.2 +084900 REA-TEST-F1-01-1. IX1094.2 +085000******************************************************************IX1094.2 +085100* TEST 6 *IX1094.2 +085200* READ ... . (WITHOUT AT END) 00 EXPECTED *IX1094.2 +085300* IX-3, 1.3.4 (1) A *IX1094.2 +085400******************************************************************IX1094.2 +085500 MOVE "REA-TEST-F1-01-0" TO PAR-NAME. IX1094.2 +085600 MOVE "READ (USE): 00 EXP." TO FEATURE. IX1094.2 +085700 IF STATUS-TEST-READ = 0 IX1094.2 +085800 GO TO REA-PASS-F1-01-0. IX1094.2 +085900 REA-FAIL-F1-01-0. IX1094.2 +086000 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +086100 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1094.2 +086200 MOVE "00" TO CORRECT-X. IX1094.2 +086300 PERFORM FAIL. IX1094.2 +086400 GO TO REA-WRITE-F1-01-0. IX1094.2 +086500 REA-PASS-F1-01-0. IX1094.2 +086600 PERFORM PASS. IX1094.2 +086700 REA-WRITE-F1-01-0. IX1094.2 +086800 PERFORM PRINT-DETAIL. IX1094.2 +086900* IX1094.2 +087000 REA-INIT-GF-02-0. IX1094.2 +087100******************************************************************IX1094.2 +087200* TEST 7 *IX1094.2 +087300* VERIFY FILE *IX1094.2 +087400******************************************************************IX1094.2 +087500 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1094.2 +087600 GO TO REA-TEST-F1-02-0. IX1094.2 +087700 MOVE "ERRORS IN READING IX-FS3" TO RE-MARK. IX1094.2 +087800 REA-FAIL-F1-02-0. IX1094.2 +087900 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1094.2 +088000 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1094.2 +088100 GO TO REA-FAIL-F1-02-1. IX1094.2 +088200 REA-TEST-F1-02-0. IX1094.2 +088300 IF COUNT-OF-RECORDS EQUAL TO 50 IX1094.2 +088400 GO TO REA-PASS-F1-02-0. IX1094.2 +088500 MOVE "UNEXPECTED EOF" TO RE-MARK. IX1094.2 +088600 MOVE "RECORDS READ =" TO COMPUTED-A. IX1094.2 +088700 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IX1094.2 +088800 REA-FAIL-F1-02-1. IX1094.2 +088900 PERFORM FAIL. IX1094.2 +089000 GO TO REA-WRITE-F1-02-0. IX1094.2 +089100 REA-PASS-F1-02-0. IX1094.2 +089200 PERFORM PASS. IX1094.2 +089300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1094.2 +089400 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IX1094.2 +089500 REA-WRITE-F1-02-0. IX1094.2 +089600 MOVE "REA-TEST-F1-02-0" TO PAR-NAME. IX1094.2 +089700 MOVE "VERIFY FILE IX-FS3" TO FEATURE. IX1094.2 +089800 PERFORM PRINT-DETAIL. IX1094.2 +089900******************************************************************IX1094.2 +090000* TEST 8 *IX1094.2 +090100* READ. (WITHOUT AT END) 10 EXPECTED *IX1094.2 +090200* IX-4, 1.3.4 (2) A *IX1094.2 +090300******************************************************************IX1094.2 +090400 REA-INIT-F1-03-0. IX1094.2 +090500 IF IX-FS3-STATUS EQUAL TO "10" IX1094.2 +090600 GO TO REA-PASS-F1-03-0. IX1094.2 +090700 REA-FAIL-F1-03-0. IX1094.2 +090800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +090900 MOVE "10" TO CORRECT-X. IX1094.2 +091000 MOVE "IX-4, 1.3.4, (2) A." TO RE-MARK. IX1094.2 +091100 PERFORM FAIL. IX1094.2 +091200 GO TO REA-WRITE-F1-03-0. IX1094.2 +091300 REA-PASS-F1-03-0. IX1094.2 +091400 PERFORM PASS. IX1094.2 +091500 REA-WRITE-F1-03-0. IX1094.2 +091600 MOVE "READ : 10 EXP." TO FEATURE. IX1094.2 +091700 MOVE "REA-TEST-F1-03-0" TO PAR-NAME. IX1094.2 +091800 PERFORM PRINT-DETAIL. IX1094.2 +091900******************************************************************IX1094.2 +092000* TEST 9 *IX1094.2 +092100* CLOSE INPUT 00 EXPECTED *IX1094.2 +092200* IX-3, 1.3.4 (1) A *IX1094.2 +092300******************************************************************IX1094.2 +092400 CLO-TEST-GF-02-0. IX1094.2 +092500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +092600 MOVE "CLOSE INPUT: 00 EXP." TO FEATURE. IX1094.2 +092700 MOVE "CLO-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +092800 CLOSE IX-FS3. IX1094.2 +092900 IF IX-FS3-STATUS = "00" IX1094.2 +093000 GO TO CLO-PASS-GF-02-0. IX1094.2 +093100 CLO-FAIL-GF-02-0. IX1094.2 +093200 MOVE "IX-3, 1.3.4, (1) A " TO RE-MARK. IX1094.2 +093300 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +093400 MOVE "00" TO CORRECT-X. IX1094.2 +093500 PERFORM FAIL. IX1094.2 +093600 GO TO CLO-WRITE-GF-02-0. IX1094.2 +093700 CLO-PASS-GF-02-0. IX1094.2 +093800 PERFORM PASS. IX1094.2 +093900 CLO-WRITE-GF-02-0. IX1094.2 +094000 PERFORM PRINT-DETAIL. IX1094.2 +094100 IX1094.2 +094200******************************************************************IX1094.2 +094300* TEST 10 *IX1094.2 +094400* OPEN INPUT (FOR READ ... AT END) 00 EXPECTED *IX1094.2 +094500* IX-3, 1.3.4 (1) A *IX1094.2 +094600******************************************************************IX1094.2 +094700 OPN-INIT-GF-03-0. IX1094.2 +094800 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +094900 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1094.2 +095000 MOVE "OPN-TEST-GF-03-0" TO PAR-NAME. IX1094.2 +095100 OPN-TEST-GF-03-0. IX1094.2 +095200 OPEN IX1094.2 +095300 INPUT IX-FS3. IX1094.2 +095400 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +095500 GO TO OPN-PASS-GF-03-0. IX1094.2 +095600 OPN-FAIL-GF-03-0. IX1094.2 +095700 MOVE "IX-3, 1.3.4, (1) A." TO RE-MARK. IX1094.2 +095800 PERFORM FAIL. IX1094.2 +095900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +096000 MOVE "00" TO CORRECT-X. IX1094.2 +096100 GO TO OPN-WRITE-GF-03-0. IX1094.2 +096200 OPN-PASS-GF-03-0. IX1094.2 +096300 PERFORM PASS. IX1094.2 +096400 OPN-WRITE-GF-03-0. IX1094.2 +096500 PERFORM PRINT-DETAIL. IX1094.2 +096600******************************************************************IX1094.2 +096700* STATUS IO CHECK ON INPUT FILE IX-FS3. *IX1094.2 +096800* THIS TEST READS AND VERIFIES THE RECORDS WRITTEN IN *IX1094.2 +096900* TEST 2. THE USE ON INPUT PROCESSES THE AT END *IX1094.2 +097000* CONDITION. IX1094.2 +097100******************************************************************IX1094.2 +097200 REA-INIT-F1-04-0. IX1094.2 +097300 MOVE 1 TO STATUS-TEST-10. IX1094.2 +097400 MOVE ZERO TO STATUS-TEST-READ. IX1094.2 +097500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +097600 MOVE ZERO TO COUNT-OF-RECS. IX1094.2 +097700 MOVE ZERO TO PERM-ERRORS. IX1094.2 +097800 MOVE ZERO TO EOF-FLAG. IX1094.2 +097900 REA-TEST-F1-04-0. IX1094.2 +098000 READ IX-FS3 AT END MOVE 1 TO EOF-FLAG. IX1094.2 +098100 IF EOF-FLAG EQUAL TO 1 IX1094.2 +098200 GO TO REA-TEST-F1-04-1. IX1094.2 +098300 MOVE IX-FS3R1-F-G-240 TO FILE-RECORD-INFO (1). IX1094.2 +098400 ADD 1 TO COUNT-OF-RECS. IX1094.2 +098500 IF COUNT-OF-RECS LESS THAN 51 IX1094.2 +098600 IF IX-FS3-STATUS NOT = "00" IX1094.2 +098700 MOVE 1 TO STATUS-TEST-READ. IX1094.2 +098800 IF PERM-ERRORS EQUAL TO 1 IX1094.2 +098900 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099000 GO TO REA-TEST-F1-04-1. IX1094.2 +099100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) IX1094.2 +099200 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099300 GO TO REA-TEST-F1-04-1. IX1094.2 +099400 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS3" IX1094.2 +099500 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099600 GO TO REA-TEST-F1-04-1. IX1094.2 +099700 MOVE XRECORD-KEY (1) TO GRP-0101. IX1094.2 +099800 IF GRP-0101-KEY NOT EQUAL TO COUNT-OF-RECS IX1094.2 +099900 ADD 1 TO RECORDS-IN-ERROR. IX1094.2 +100000 GO TO REA-TEST-F1-04-0. IX1094.2 +100100 REA-TEST-F1-04-1. IX1094.2 +100200******************************************************************IX1094.2 +100300* TEST 11 *IX1094.2 +100400* READ ... AT END 00 EXPECTED *IX1094.2 +100500* IX-3, 1.3.4 (1) A *IX1094.2 +100600******************************************************************IX1094.2 +100700 MOVE "REA-TEST-F1-04-0" TO PAR-NAME. IX1094.2 +100800 MOVE "READ...END: 00 EXP." TO FEATURE. IX1094.2 +100900 IF STATUS-TEST-READ = 0 IX1094.2 +101000 GO TO REA-PASS-F1-04-0. IX1094.2 +101100 REA-FAIL-F1-04-0. IX1094.2 +101200 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1094.2 +101300 MOVE "00" TO CORRECT-X. IX1094.2 +101400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +101500 PERFORM FAIL. IX1094.2 +101600 GO TO REA-WRITE-F1-04-0. IX1094.2 +101700 REA-PASS-F1-04-0. IX1094.2 +101800 PERFORM PASS. IX1094.2 +101900 REA-WRITE-F1-04-0. IX1094.2 +102000 PERFORM PRINT-DETAIL. IX1094.2 +102100* IX1094.2 +102200 REA-TEST-F1-05-0. IX1094.2 +102300******************************************************************IX1094.2 +102400* TEST 12 *IX1094.2 +102500* READ ... AT END 10 EXPECTED *IX1094.2 +102600* IX-4, 1.3.4 (2) A 1) *IX1094.2 +102700******************************************************************IX1094.2 +102800 IF IX-FS3-STATUS EQUAL TO "10" IX1094.2 +102900 GO TO REA-PASS-F1-05-0. IX1094.2 +103000 REA-FAIL-F1-05-0. IX1094.2 +103100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +103200 MOVE "10" TO CORRECT-X. IX1094.2 +103300 MOVE "IX-4, 1.3.4, (2) A 1)" TO RE-MARK. IX1094.2 +103400 PERFORM FAIL. IX1094.2 +103500 GO TO REA-WRITE-F1-05-0. IX1094.2 +103600 REA-PASS-F1-05-0. IX1094.2 +103700 PERFORM PASS. IX1094.2 +103800 REA-WRITE-F1-05-0. IX1094.2 +103900 MOVE "READ...END: 10 EXP." TO FEATURE. IX1094.2 +104000 MOVE "REA-TEST-F1-05-0" TO PAR-NAME. IX1094.2 +104100 PERFORM PRINT-DETAIL. IX1094.2 +104200******************************************************************IX1094.2 +104300* TEST 13 *IX1094.2 +104400* READ ... (AFTER AT END) 46 EXPECTED *IX1094.2 +104500* IX-5, 1.3.4 (5) E 3) *IX1094.2 +104600******************************************************************IX1094.2 +104700 REA-TEST-F1-06-0. IX1094.2 +104800 MOVE 13 TO TEST-NO. IX1094.2 +104900 READ IX-FS3 AT END GO TO REA-TEST-F1-06-1. IX1094.2 +105000 REA-TEST-F1-06-1. IX1094.2 +105100 IF IX-FS3-STATUS EQUAL TO "46" IX1094.2 +105200 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1094.2 +105300 TO RE-MARK IX1094.2 +105400 GO TO REA-WRITE-F1-06-0. IX1094.2 +105500 REA-FAIL-F1-06-0. IX1094.2 +105600 MOVE "IX-5, 1.3.4, (5) E 3)" TO RE-MARK. IX1094.2 +105700 REA-WRITE-F1-06-0. IX1094.2 +105800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +105900 MOVE "46" TO CORRECT-X. IX1094.2 +106000 PERFORM FAIL. IX1094.2 +106100 MOVE "READ. 46 EXP." TO FEATURE. IX1094.2 +106200 MOVE "REA-TEST-F1-06-0" TO PAR-NAME. IX1094.2 +106300 PERFORM PRINT-DETAIL. IX1094.2 +106400 CLOSE IX-FS3. IX1094.2 +106500 IX1094.2 +106600 TERMINATE-ROUTINE. IX1094.2 +106700 EXIT. IX1094.2 +106800 IX1094.2 +106900 CCVS-EXIT SECTION. IX1094.2 +107000 CCVS-999999. IX1094.2 +107100 GO TO CLOSE-FILES. IX1094.2 +*END-OF,IX109A +*HEADER,COBOL,IX109A,SUBPRG,IX110A +000100 IDENTIFICATION DIVISION. IX1104.2 +000200 PROGRAM-ID. IX1104.2 +000300 IX110A. IX1104.2 +000400**************************************************************** IX1104.2 +000500* * IX1104.2 +000600* VALIDATION FOR:- * IX1104.2 +000700* * IX1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +000900* * IX1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1104.2 +001100* * IX1104.2 +001200**************************************************************** IX1104.2 +001300* IX1104.2 +001400* 1. THE ROUTINE USES THE FILE IX-FS3 WHICH HAS BEEN CREATED IX1104.2 +001500* BY IX109. THIS FILE IS OPENED IN I-O MODE. IX1104.2 +001600 IX1104.2 +001700* 2. THE ROUTINE CHECKS THE FILE STATUS CODES: IX1104.2 +001800* 00 - AFTER OPEN I-O IX1104.2 +001900* 22 - AFTER WRITE (DUPLIACATE PRIMARY RECORD KEY) IX1104.2 +002000* 00 OR 22 - AFTER REWRITE (DUPLIACATE PRIMARY RECORD KEY) IX1104.2 +002100* 23 - AFTER READ (A NOT EXISTING RECORD KEY) IX1104.2 +002200 IX1104.2 +002300* 3. X-CARDS USED IN THIS PROGRAM (WITH THE OPT CODE): IX1104.2 +002400* IX1104.2 +002500* XXXXX024 IX1104.2 +002600* XXXXX055. IX1104.2 +002700* P XXXXX062. IX1104.2 +002800* XXXXX082. IX1104.2 +002900* XXXXX083. IX1104.2 +003000* XXXXX084 IX1104.2 +003100* IX1104.2 +003200* IX1104.2 +003300 ENVIRONMENT DIVISION. IX1104.2 +003400 CONFIGURATION SECTION. IX1104.2 +003500 SOURCE-COMPUTER. IX1104.2 +003600 XXXXX082. IX1104.2 +003700 OBJECT-COMPUTER. IX1104.2 +003800 XXXXX083. IX1104.2 +003900 INPUT-OUTPUT SECTION. IX1104.2 +004000 FILE-CONTROL. IX1104.2 +004100P SELECT RAW-DATA ASSIGN TO IX1104.2 +004200P XXXXX062 IX1104.2 +004300P ORGANIZATION IS INDEXED IX1104.2 +004400P ACCESS MODE IS RANDOM IX1104.2 +004500P RECORD KEY IS RAW-DATA-KEY. IX1104.2 +004600* IX1104.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1104.2 +004800 XXXXX055. IX1104.2 +004900* IX1104.2 +005000 SELECT IX-FS3 ASSIGN IX1104.2 +005100 XXXXX024 IX1104.2 +005200 ORGANIZATION IS INDEXED IX1104.2 +005300 ACCESS MODE IS RANDOM IX1104.2 +005400 RECORD KEY IS IX-FS3-KEY IX1104.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1104.2 +005600 IX1104.2 +005700 DATA DIVISION. IX1104.2 +005800 IX1104.2 +005900 FILE SECTION. IX1104.2 +006000P IX1104.2 +006100PFD RAW-DATA. IX1104.2 +006200P IX1104.2 +006300P01 RAW-DATA-SATZ. IX1104.2 +006400P 05 RAW-DATA-KEY PIC X(6). IX1104.2 +006500P 05 C-DATE PIC 9(6). IX1104.2 +006600P 05 C-TIME PIC 9(8). IX1104.2 +006700P 05 C-NO-OF-TESTS PIC 99. IX1104.2 +006800P 05 C-OK PIC 999. IX1104.2 +006900P 05 C-ALL PIC 999. IX1104.2 +007000P 05 C-FAIL PIC 999. IX1104.2 +007100P 05 C-DELETED PIC 999. IX1104.2 +007200P 05 C-INSPECT PIC 999. IX1104.2 +007300P 05 C-NOTE PIC X(13). IX1104.2 +007400P 05 C-INDENT PIC X. IX1104.2 +007500P 05 C-ABORT PIC X(8). IX1104.2 +007600 IX1104.2 +007700 FD PRINT-FILE. IX1104.2 +007800 IX1104.2 +007900 01 PRINT-REC PIC X(120). IX1104.2 +008000 IX1104.2 +008100 01 DUMMY-RECORD PIC X(120). IX1104.2 +008200 IX1104.2 +008300 FD IX-FS3 IX1104.2 +008400C DATA RECORDS IX-FS3R1-F-G-240 IX1104.2 +008500C LABEL RECORD STANDARD IX1104.2 +008600 RECORD 240 IX1104.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1104.2 +008800 IX1104.2 +008900 01 IX-FS3R1-F-G-240. IX1104.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1104.2 +009100 05 IX-FS3-REC-120-240. IX1104.2 +009200 10 FILLER PIC X(8). IX1104.2 +009300 10 IX-FS3-KEY PIC X(29). IX1104.2 +009400 10 FILLER PIC X(9). IX1104.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1104.2 +009600 10 FILLER PIC X(45). IX1104.2 +009700 IX1104.2 +009800 IX1104.2 +009900 WORKING-STORAGE SECTION. IX1104.2 +010000 IX1104.2 +010100 01 GRP-0101. IX1104.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1104.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1104.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1104.2 +010500 IX1104.2 +010600 01 GRP-0102. IX1104.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1104.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1104.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1104.2 +011000 IX1104.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1104.2 +011200 IX1104.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1104.2 +011400 IX1104.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1104.2 +011600 IX1104.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1104.2 +011800 IX1104.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1104.2 +012000 IX1104.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1104.2 +012200 IX1104.2 +012250 01 STATUS-TEST-10 PIC P VALUE ZERO. IX1104.2 +012300 IX1104.2 +012400 01 IX-FS3-STATUS. IX1104.2 +012500 05 IX-FS3-STAT1 PIC X. IX1104.2 +012600 05 IX-FS3-STAT2 PIC X. IX1104.2 +012700 IX1104.2 +012800 01 COUNT-OF-RECS PIC 9(5). IX1104.2 +012900 IX1104.2 +013000 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1104.2 +013100 IX1104.2 +013200 01 FILE-RECORD-INFORMATION-REC. IX1104.2 +013300 05 FILE-RECORD-INFO-SKELETON. IX1104.2 +013400 10 FILLER PIC X(48) VALUE IX1104.2 +013500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1104.2 +013600 10 FILLER PIC X(46) VALUE IX1104.2 +013700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1104.2 +013800 10 FILLER PIC X(26) VALUE IX1104.2 +013900 ",LFIL=000000,ORG= ,LBLR= ". IX1104.2 +014000 10 FILLER PIC X(37) VALUE IX1104.2 +014100 ",RECKEY= ". IX1104.2 +014200 10 FILLER PIC X(38) VALUE IX1104.2 +014300 ",ALTKEY1= ". IX1104.2 +014400 10 FILLER PIC X(38) VALUE IX1104.2 +014500 ",ALTKEY2= ". IX1104.2 +014600 10 FILLER PIC X(7) VALUE SPACE. IX1104.2 +014700 05 FILE-RECORD-INFO OCCURS 10. IX1104.2 +014800 10 FILE-RECORD-INFO-P1-120. IX1104.2 +014900 15 FILLER PIC X(5). IX1104.2 +015000 15 XFILE-NAME PIC X(6). IX1104.2 +015100 15 FILLER PIC X(8). IX1104.2 +015200 15 XRECORD-NAME PIC X(6). IX1104.2 +015300 15 FILLER PIC X(1). IX1104.2 +015400 15 REELUNIT-NUMBER PIC 9(1). IX1104.2 +015500 15 FILLER PIC X(7). IX1104.2 +015600 15 XRECORD-NUMBER PIC 9(6). IX1104.2 +015700 15 FILLER PIC X(6). IX1104.2 +015800 15 UPDATE-NUMBER PIC 9(2). IX1104.2 +015900 15 FILLER PIC X(5). IX1104.2 +016000 15 ODO-NUMBER PIC 9(4). IX1104.2 +016100 15 FILLER PIC X(5). IX1104.2 +016200 15 XPROGRAM-NAME PIC X(5). IX1104.2 +016300 15 FILLER PIC X(7). IX1104.2 +016400 15 XRECORD-LENGTH PIC 9(6). IX1104.2 +016500 15 FILLER PIC X(7). IX1104.2 +016600 15 CHARS-OR-RECORDS PIC X(2). IX1104.2 +016700 15 FILLER PIC X(1). IX1104.2 +016800 15 XBLOCK-SIZE PIC 9(4). IX1104.2 +016900 15 FILLER PIC X(6). IX1104.2 +017000 15 RECORDS-IN-FILE PIC 9(6). IX1104.2 +017100 15 FILLER PIC X(5). IX1104.2 +017200 15 XFILE-ORGANIZATION PIC X(2). IX1104.2 +017300 15 FILLER PIC X(6). IX1104.2 +017400 15 XLABEL-TYPE PIC X(1). IX1104.2 +017500 10 FILE-RECORD-INFO-P121-240. IX1104.2 +017600 15 FILLER PIC X(8). IX1104.2 +017700 15 XRECORD-KEY PIC X(29). IX1104.2 +017800 15 FILLER PIC X(9). IX1104.2 +017900 15 ALTERNATE-KEY1 PIC X(29). IX1104.2 +018000 15 FILLER PIC X(9). IX1104.2 +018100 15 ALTERNATE-KEY2 PIC X(29). IX1104.2 +018200 15 FILLER PIC X(7). IX1104.2 +018300 IX1104.2 +018400 01 TEST-RESULTS. IX1104.2 +018500 02 FILLER PIC X VALUE SPACE. IX1104.2 +018600 02 FEATURE PIC X(20) VALUE SPACE. IX1104.2 +018700 02 FILLER PIC X VALUE SPACE. IX1104.2 +018800 02 P-OR-F PIC X(5) VALUE SPACE. IX1104.2 +018900 02 FILLER PIC X VALUE SPACE. IX1104.2 +019000 02 PAR-NAME. IX1104.2 +019100 03 FILLER PIC X(19) VALUE SPACE. IX1104.2 +019200 03 PARDOT-X PIC X VALUE SPACE. IX1104.2 +019300 03 DOTVALUE PIC 99 VALUE ZERO. IX1104.2 +019400 02 FILLER PIC X(8) VALUE SPACE. IX1104.2 +019500 02 RE-MARK PIC X(61). IX1104.2 +019600 01 TEST-COMPUTED. IX1104.2 +019700 02 FILLER PIC X(30) VALUE SPACE. IX1104.2 +019800 02 FILLER PIC X(17) VALUE IX1104.2 +019900 " COMPUTED=". IX1104.2 +020000 02 COMPUTED-X. IX1104.2 +020100 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1104.2 +020200 03 COMPUTED-N REDEFINES COMPUTED-A IX1104.2 +020300 PIC -9(9).9(9). IX1104.2 +020400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1104.2 +020500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1104.2 +020600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1104.2 +020700 03 CM-18V0 REDEFINES COMPUTED-A. IX1104.2 +020800 04 COMPUTED-18V0 PIC -9(18). IX1104.2 +020900 04 FILLER PIC X. IX1104.2 +021000 03 FILLER PIC X(50) VALUE SPACE. IX1104.2 +021100 01 TEST-CORRECT. IX1104.2 +021200 02 FILLER PIC X(30) VALUE SPACE. IX1104.2 +021300 02 FILLER PIC X(17) VALUE " CORRECT =". IX1104.2 +021400 02 CORRECT-X. IX1104.2 +021500 03 CORRECT-A PIC X(20) VALUE SPACE. IX1104.2 +021600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1104.2 +021700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1104.2 +021800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1104.2 +021900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1104.2 +022000 03 CR-18V0 REDEFINES CORRECT-A. IX1104.2 +022100 04 CORRECT-18V0 PIC -9(18). IX1104.2 +022200 04 FILLER PIC X. IX1104.2 +022300 03 FILLER PIC X(2) VALUE SPACE. IX1104.2 +022400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1104.2 +022500 01 CCVS-C-1. IX1104.2 +022600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1104.2 +022700- "SS PARAGRAPH-NAME IX1104.2 +022800- " REMARKS". IX1104.2 +022900 02 FILLER PIC X(20) VALUE SPACE. IX1104.2 +023000 01 CCVS-C-2. IX1104.2 +023100 02 FILLER PIC X VALUE SPACE. IX1104.2 +023200 02 FILLER PIC X(6) VALUE "TESTED". IX1104.2 +023300 02 FILLER PIC X(15) VALUE SPACE. IX1104.2 +023400 02 FILLER PIC X(4) VALUE "FAIL". IX1104.2 +023500 02 FILLER PIC X(94) VALUE SPACE. IX1104.2 +023600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1104.2 +023700 01 REC-CT PIC 99 VALUE ZERO. IX1104.2 +023800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1104.2 +023900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024100 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1104.2 +024300 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1104.2 +024400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1104.2 +024500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1104.2 +024600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1104.2 +024700 01 CCVS-H-1. IX1104.2 +024800 02 FILLER PIC X(39) VALUE SPACES. IX1104.2 +024900 02 FILLER PIC X(42) VALUE IX1104.2 +025000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1104.2 +025100 02 FILLER PIC X(39) VALUE SPACES. IX1104.2 +025200 01 CCVS-H-2A. IX1104.2 +025300 02 FILLER PIC X(40) VALUE SPACE. IX1104.2 +025400 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1104.2 +025500 02 FILLER PIC XXXX VALUE IX1104.2 +025600 "4.2 ". IX1104.2 +025700 02 FILLER PIC X(28) VALUE IX1104.2 +025800 " COPY - NOT FOR DISTRIBUTION". IX1104.2 +025900 02 FILLER PIC X(41) VALUE SPACE. IX1104.2 +026000 IX1104.2 +026100 01 CCVS-H-2B. IX1104.2 +026200 02 FILLER PIC X(15) VALUE IX1104.2 +026300 "TEST RESULT OF ". IX1104.2 +026400 02 TEST-ID PIC X(9). IX1104.2 +026500 02 FILLER PIC X(4) VALUE IX1104.2 +026600 " IN ". IX1104.2 +026700 02 FILLER PIC X(12) VALUE IX1104.2 +026800 " HIGH ". IX1104.2 +026900 02 FILLER PIC X(22) VALUE IX1104.2 +027000 " LEVEL VALIDATION FOR ". IX1104.2 +027100 02 FILLER PIC X(58) VALUE IX1104.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +027300 01 CCVS-H-3. IX1104.2 +027400 02 FILLER PIC X(34) VALUE IX1104.2 +027500 " FOR OFFICIAL USE ONLY ". IX1104.2 +027600 02 FILLER PIC X(58) VALUE IX1104.2 +027700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1104.2 +027800 02 FILLER PIC X(28) VALUE IX1104.2 +027900 " COPYRIGHT 1985 ". IX1104.2 +028000 01 CCVS-E-1. IX1104.2 +028100 02 FILLER PIC X(52) VALUE SPACE. IX1104.2 +028200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1104.2 +028300 02 ID-AGAIN PIC X(9). IX1104.2 +028400 02 FILLER PIC X(45) VALUE SPACES. IX1104.2 +028500 01 CCVS-E-2. IX1104.2 +028600 02 FILLER PIC X(31) VALUE SPACE. IX1104.2 +028700 02 FILLER PIC X(21) VALUE SPACE. IX1104.2 +028800 02 CCVS-E-2-2. IX1104.2 +028900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1104.2 +029000 03 FILLER PIC X VALUE SPACE. IX1104.2 +029100 03 ENDER-DESC PIC X(44) VALUE IX1104.2 +029200 "ERRORS ENCOUNTERED". IX1104.2 +029300 01 CCVS-E-3. IX1104.2 +029400 02 FILLER PIC X(22) VALUE IX1104.2 +029500 " FOR OFFICIAL USE ONLY". IX1104.2 +029600 02 FILLER PIC X(12) VALUE SPACE. IX1104.2 +029700 02 FILLER PIC X(58) VALUE IX1104.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +029900 02 FILLER PIC X(13) VALUE SPACE. IX1104.2 +030000 02 FILLER PIC X(15) VALUE IX1104.2 +030100 " COPYRIGHT 1985". IX1104.2 +030200 01 CCVS-E-4. IX1104.2 +030300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1104.2 +030400 02 FILLER PIC X(4) VALUE " OF ". IX1104.2 +030500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1104.2 +030600 02 FILLER PIC X(40) VALUE IX1104.2 +030700 " TESTS WERE EXECUTED SUCCESSFULLY". IX1104.2 +030800 01 XXINFO. IX1104.2 +030900 02 FILLER PIC X(19) VALUE IX1104.2 +031000 "*** INFORMATION ***". IX1104.2 +031100 02 INFO-TEXT. IX1104.2 +031200 04 FILLER PIC X(8) VALUE SPACE. IX1104.2 +031300 04 XXCOMPUTED PIC X(20). IX1104.2 +031400 04 FILLER PIC X(5) VALUE SPACE. IX1104.2 +031500 04 XXCORRECT PIC X(20). IX1104.2 +031600 02 INF-ANSI-REFERENCE PIC X(48). IX1104.2 +031700 01 HYPHEN-LINE. IX1104.2 +031800 02 FILLER PIC IS X VALUE IS SPACE. IX1104.2 +031900 02 FILLER PIC IS X(65) VALUE IS "************************IX1104.2 +032000- "*****************************************". IX1104.2 +032100 02 FILLER PIC IS X(54) VALUE IS "************************IX1104.2 +032200- "******************************". IX1104.2 +032300 01 CCVS-PGM-ID PIC X(9) VALUE IX1104.2 +032400 "IX110A". IX1104.2 +032500 PROCEDURE DIVISION. IX1104.2 +032600 DECLARATIVES. IX1104.2 +032700 IX1104.2 +032800 SECT-IX110-0002 SECTION. IX1104.2 +032900 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1104.2 +033000 INPUT-PROCESS. IX1104.2 +033100 IF STATUS-TEST-10 EQUAL TO 1 IX1104.2 +033200 GO TO FINAL-CHECK IX1104.2 +033300 ELSE IX1104.2 +033400 GO TO DECL-EXIT. IX1104.2 +033500 FINAL-CHECK. IX1104.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1104.2 +033700 MOVE 1 TO EOF-FLAG. IX1104.2 +033800 IF IX1104.2 +033900 IX-FS3-STAT1 GREATER THAN "1" IX1104.2 +034000 MOVE 1 TO PERM-ERRORS. IX1104.2 +034100 DECL-EXIT. IX1104.2 +034200 END DECLARATIVES. IX1104.2 +034300 IX1104.2 +034400 IX1104.2 +034500 CCVS1 SECTION. IX1104.2 +034600 OPEN-FILES. IX1104.2 +034700P OPEN I-O RAW-DATA. IX1104.2 +034800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1104.2 +034900P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1104.2 +035000P MOVE "ABORTED " TO C-ABORT. IX1104.2 +035100P ADD 1 TO C-NO-OF-TESTS. IX1104.2 +035200P ACCEPT C-DATE FROM DATE. IX1104.2 +035300P ACCEPT C-TIME FROM TIME. IX1104.2 +035400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1104.2 +035500PEND-E-1. IX1104.2 +035600P CLOSE RAW-DATA. IX1104.2 +035700 OPEN OUTPUT PRINT-FILE. IX1104.2 +035800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1104.2 +035900 MOVE SPACE TO TEST-RESULTS. IX1104.2 +036000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1104.2 +036100 MOVE ZERO TO REC-SKL-SUB. IX1104.2 +036200 PERFORM CCVS-INIT-FILE 9 TIMES. IX1104.2 +036300 CCVS-INIT-FILE. IX1104.2 +036400 ADD 1 TO REC-SKL-SUB. IX1104.2 +036500 MOVE FILE-RECORD-INFO-SKELETON IX1104.2 +036600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1104.2 +036700 CCVS-INIT-EXIT. IX1104.2 +036800 GO TO CCVS1-EXIT. IX1104.2 +036900 CLOSE-FILES. IX1104.2 +037000P OPEN I-O RAW-DATA. IX1104.2 +037100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1104.2 +037200P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1104.2 +037300P MOVE "OK. " TO C-ABORT. IX1104.2 +037400P MOVE PASS-COUNTER TO C-OK. IX1104.2 +037500P MOVE ERROR-HOLD TO C-ALL. IX1104.2 +037600P MOVE ERROR-COUNTER TO C-FAIL. IX1104.2 +037700P MOVE DELETE-COUNTER TO C-DELETED. IX1104.2 +037800P MOVE INSPECT-COUNTER TO C-INSPECT. IX1104.2 +037900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1104.2 +038000PEND-E-2. IX1104.2 +038100P CLOSE RAW-DATA. IX1104.2 +038200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1104.2 +038300 TERMINATE-CCVS. IX1104.2 +038400S EXIT PROGRAM. IX1104.2 +038500STERMINATE-CALL. IX1104.2 +038600 STOP RUN. IX1104.2 +038700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1104.2 +038800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1104.2 +038900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1104.2 +039000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1104.2 +039100 MOVE "****TEST DELETED****" TO RE-MARK. IX1104.2 +039200 PRINT-DETAIL. IX1104.2 +039300 IF REC-CT NOT EQUAL TO ZERO IX1104.2 +039400 MOVE "." TO PARDOT-X IX1104.2 +039500 MOVE REC-CT TO DOTVALUE. IX1104.2 +039600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1104.2 +039700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1104.2 +039800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1104.2 +039900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1104.2 +040000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1104.2 +040100 MOVE SPACE TO CORRECT-X. IX1104.2 +040200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1104.2 +040300 MOVE SPACE TO RE-MARK. IX1104.2 +040400 HEAD-ROUTINE. IX1104.2 +040500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +040600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +040700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1104.2 +040800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1104.2 +040900 COLUMN-NAMES-ROUTINE. IX1104.2 +041000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +041100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +041200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +041300 END-ROUTINE. IX1104.2 +041400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1104.2 +041500 END-RTN-EXIT. IX1104.2 +041600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +041700 END-ROUTINE-1. IX1104.2 +041800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1104.2 +041900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1104.2 +042000 ADD PASS-COUNTER TO ERROR-HOLD. IX1104.2 +042100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1104.2 +042200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1104.2 +042300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1104.2 +042400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1104.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1104.2 +042600 END-ROUTINE-12. IX1104.2 +042700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1104.2 +042800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1104.2 +042900 MOVE "NO " TO ERROR-TOTAL IX1104.2 +043000 ELSE IX1104.2 +043100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1104.2 +043200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1104.2 +043300 PERFORM WRITE-LINE. IX1104.2 +043400 END-ROUTINE-13. IX1104.2 +043500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1104.2 +043600 MOVE "NO " TO ERROR-TOTAL ELSE IX1104.2 +043700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1104.2 +043800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1104.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044000 IF INSPECT-COUNTER EQUAL TO ZERO IX1104.2 +044100 MOVE "NO " TO ERROR-TOTAL IX1104.2 +044200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1104.2 +044300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1104.2 +044400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044600 WRITE-LINE. IX1104.2 +044700 ADD 1 TO RECORD-COUNT. IX1104.2 +044800Y IF RECORD-COUNT GREATER 42 IX1104.2 +044900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1104.2 +045000Y MOVE SPACE TO DUMMY-RECORD IX1104.2 +045100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1104.2 +045200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1104.2 +045300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1104.2 +045400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1104.2 +045500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1104.2 +045600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1104.2 +046000Y MOVE ZERO TO RECORD-COUNT. IX1104.2 +046100 PERFORM WRT-LN. IX1104.2 +046200 WRT-LN. IX1104.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1104.2 +046400 MOVE SPACE TO DUMMY-RECORD. IX1104.2 +046500 BLANK-LINE-PRINT. IX1104.2 +046600 PERFORM WRT-LN. IX1104.2 +046700 FAIL-ROUTINE. IX1104.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE IX1104.2 +046900 GO TO FAIL-ROUTINE-WRITE. IX1104.2 +047000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1104.2 +047100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1104.2 +047200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1104.2 +047300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +047400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1104.2 +047500 GO TO FAIL-ROUTINE-EX. IX1104.2 +047600 FAIL-ROUTINE-WRITE. IX1104.2 +047700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1104.2 +047800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1104.2 +047900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1104.2 +048000 MOVE SPACES TO COR-ANSI-REFERENCE. IX1104.2 +048100 FAIL-ROUTINE-EX. EXIT. IX1104.2 +048200 BAIL-OUT. IX1104.2 +048300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1104.2 +048400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1104.2 +048500 BAIL-OUT-WRITE. IX1104.2 +048600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1104.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1104.2 +048800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +048900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1104.2 +049000 BAIL-OUT-EX. EXIT. IX1104.2 +049100 CCVS1-EXIT. IX1104.2 +049200 EXIT. IX1104.2 +049300 IX1104.2 +049400 SECT-IX110A-0003 SECTION. IX1104.2 +049500 SEQ-INIT-010. IX1104.2 +049600 IX1104.2 +049700******************************************************************IX1104.2 +049800* TEST 1 *IX1104.2 +049900* OPEN I-O 00 EXPECTED *IX1104.2 +050000* IX-3, 1.3.4 (1) a *IX1104.2 +050100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1104.2 +050200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1104.2 +050300******************************************************************IX1104.2 +050400 OPN-INIT-GF-01-0. IX1104.2 +050500 MOVE 1 TO STATUS-TEST-00. IX1104.2 +050600 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +050700 MOVE "OPEN I-O: 00 EXP." TO FEATURE. IX1104.2 +050800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +050900 OPEN IX1104.2 +051000 I-O IX-FS3. IX1104.2 +051100 IF IX-FS3-STATUS EQUAL TO "00" IX1104.2 +051200 GO TO OPN-PASS-GF-01-0. IX1104.2 +051300 OPN-FAIL-GF-01-0. IX1104.2 +051400 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1104.2 +051500 PERFORM FAIL. IX1104.2 +051600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +051700 MOVE "00" TO CORRECT-X. IX1104.2 +051800 GO TO OPN-WRITE-GF-01-0. IX1104.2 +051900 OPN-PASS-GF-01-0. IX1104.2 +052000 PERFORM PASS. IX1104.2 +052100 OPN-WRITE-GF-01-0. IX1104.2 +052200 PERFORM PRINT-DETAIL. IX1104.2 +052300 IX1104.2 +052400******************************************************************IX1104.2 +052500* TEST 2 *IX1104.2 +052600* WRITE (DUPLICATE PRIME RECORD KEY) 22 EXPECTED *IX1104.2 +052700* IX-4, 1.3.4 (3) b *IX1104.2 +052800*EXISTING KEYS: FROM 000000001 TO 000000050; WRITE: 000000010 *IX1104.2 +052900******************************************************************IX1104.2 +053000 WRI-INIT-GF-01-0. IX1104.2 +053100 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +053200 MOVE 0 TO STATUS-TEST-00. IX1104.2 +053300 MOVE "WRITE: (DUP) 22 EXP." TO FEATURE. IX1104.2 +053400 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +053500 WRI-TEST-GF-01-0. IX1104.2 +053600 MOVE SPACES TO IX-FS3-REC-120-240. IX1104.2 +053700 MOVE "RECORD-KEY000000010END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +053800 WRITE IX-FS3R1-F-G-240. IX1104.2 +053900 IF IX-FS3-STATUS = "22" IX1104.2 +054000 MOVE 1 TO STATUS-TEST-00 IX1104.2 +054100 GO TO WRI-PASS-GF-01-0. IX1104.2 +054200 WRI-FAIL-GF-01-0. IX1104.2 +054300 MOVE "IX-4, 1.3.4, (3) b. " TO RE-MARK. IX1104.2 +054400 PERFORM FAIL. IX1104.2 +054500 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +054600 MOVE "22" TO CORRECT-X. IX1104.2 +054700 GO TO WRI-WRITE-GF-01-0. IX1104.2 +054800 WRI-PASS-GF-01-0. IX1104.2 +054900 PERFORM PASS. IX1104.2 +055000 WRI-WRITE-GF-01-0. IX1104.2 +055100 PERFORM PRINT-DETAIL. IX1104.2 +055200 IX1104.2 +055300******************************************************************IX1104.2 +055400* TEST 3 *IX1104.2 +055500* REWRITE (DUPLICATE PRIMARY RECORD KEY) 22 EXPECTED *IX1104.2 +055600* IX-4, 1.3.4 (3) b *IX1104.2 +055700* KEY: 000000049 *IX1104.2 +055800******************************************************************IX1104.2 +055900 RWR-INIT-GF-01-0. IX1104.2 +056000 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +056100 MOVE ZERO TO STATUS-TEST-00. IX1104.2 +056200 MOVE "REWRITE:00 / 22 EXP." TO FEATURE. IX1104.2 +056300 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +056400 MOVE "RECORD-KEY000000049END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +056500 RWR-TEST-GF-01-0. IX1104.2 +056600 READ IX-FS3 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1104.2 +056700 MOVE SPACES TO IX-FS3-REC-120-240. IX1104.2 +056800 MOVE "RECORD-KEY000000039END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +056900 REWRITE IX-FS3R1-F-G-240 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1104.2 +057000 RWR-TEST-GF-01-1. IX1104.2 +057100 IF IX-FS3-STATUS = "00" IX1104.2 +057200 GO TO RWR-PASS-GF-01-0. IX1104.2 +057300 IF IX-FS3-STATUS = "22" IX1104.2 +057400 GO TO RWR-PASS-GF-01-0. IX1104.2 +057500 RWR-FAIL-GF-01-0. IX1104.2 +057600 MOVE "IX-4, 1.3.4, (3) b. " TO RE-MARK. IX1104.2 +057700 PERFORM FAIL. IX1104.2 +057800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +057900 MOVE "00 OR 22" TO CORRECT-X. IX1104.2 +058000 GO TO RWR-WRITE-GF-01-0. IX1104.2 +058100 RWR-PASS-GF-01-0. IX1104.2 +058200 PERFORM PASS. IX1104.2 +058300 RWR-WRITE-GF-01-0. IX1104.2 +058400 PERFORM PRINT-DETAIL. IX1104.2 +058500 IX1104.2 +058600******************************************************************IX1104.2 +058700* TEST 4 *IX1104.2 +058800* READ (A RECORD THAT DOES NOT EXIST) 23 EXPECTED *IX1104.2 +058900* IX-4, 1.3.4 (3) c 1) KEY: 000000100 *IX1104.2 +059000******************************************************************IX1104.2 +059100 REA-INIT-GF-01-0. IX1104.2 +059200 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +059300 MOVE "READ: 23 EXP." TO FEATURE. IX1104.2 +059400 MOVE "REA-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +059500 REA-TEST-GF-01-0. IX1104.2 +059600 MOVE "RECORD-KEY000000100END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +059700 READ IX-FS3 INVALID KEY GO TO REA-TEST-GF-01-1. IX1104.2 +059800 REA-TEST-GF-01-1. IX1104.2 +059900 IF IX-FS3-STATUS = "23" IX1104.2 +060000 GO TO REA-PASS-GF-01-0. IX1104.2 +060100 REA-FAIL-GF-01-0. IX1104.2 +060200 MOVE "IX-3, 1.3.4, (3) c 1)" TO RE-MARK. IX1104.2 +060300 PERFORM FAIL. IX1104.2 +060400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +060500 MOVE "23" TO CORRECT-X. IX1104.2 +060600 GO TO REA-WRITE-GF-01-0. IX1104.2 +060700 REA-PASS-GF-01-0. IX1104.2 +060800 PERFORM PASS. IX1104.2 +060900 REA-WRITE-GF-01-0. IX1104.2 +061000 PERFORM PRINT-DETAIL. IX1104.2 +061100 IX1104.2 +061200 CLOSE IX-FS3. IX1104.2 +061300 IX1104.2 +061400 TERMINATE-ROUTINE. IX1104.2 +061500 EXIT. IX1104.2 +061600 IX1104.2 +061700 CCVS-EXIT SECTION. IX1104.2 +061800 CCVS-999999. IX1104.2 +061900 GO TO CLOSE-FILES. IX1104.2 +*END-OF,IX110A +*HEADER,COBOL,IX109A,SUBPRG,IX111A +000100 IDENTIFICATION DIVISION. IX1114.2 +000200 PROGRAM-ID. IX1114.2 +000300 IX111A. IX1114.2 +000400**************************************************************** IX1114.2 +000500* * IX1114.2 +000600* VALIDATION FOR:- * IX1114.2 +000700* * IX1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +000900* * IX1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1114.2 +001100* * IX1114.2 +001200**************************************************************** IX1114.2 +001300* IX1114.2 +001400* 1. THE ROUTINE CHECKS THE PERMANENT ERROR CONDITIONS WITH IX1114.2 +001500* UNSUCCESSFUL COMPLETION FOR AN OPEN STATEMENT FOR A FILE IX1114.2 +001600* WHICH IS NOT PRESENT (STATUS CODE 35 EXPECTED). IX1114.2 +001700* THIS PROGRAM USES THE FILE IX-NOP WHICH DOES NOT EXIST. IX1114.2 +001800* IX1114.2 +001900* 2. THE ROUTINE CHECKS THE FILE STATUS CODES: IX1114.2 +002000* 35 - AFTER OPEN INPUT (NOT EXISTING FILE) IX1114.2 +002100 IX1114.2 +002200* 3. X-CARDS USED IN THIS PROGRAM (WITH THE OPT CODE): IX1114.2 +002300* IX1114.2 +002400* XXXXX025 (FOR THE NON EXISTING IX-NOP) IX1114.2 +002500* XXXXX055. IX1114.2 +002600* XXXXX082. IX1114.2 +002700* XXXXX083. IX1114.2 +002800* IX1114.2 +002900* IX1114.2 +003000 ENVIRONMENT DIVISION. IX1114.2 +003100 CONFIGURATION SECTION. IX1114.2 +003200 SOURCE-COMPUTER. IX1114.2 +003300 XXXXX082. IX1114.2 +003400 OBJECT-COMPUTER. IX1114.2 +003500 XXXXX083. IX1114.2 +003600 INPUT-OUTPUT SECTION. IX1114.2 +003700 FILE-CONTROL. IX1114.2 +003800 SELECT PRINT-FILE ASSIGN TO IX1114.2 +003900 XXXXX055. IX1114.2 +004000* IX1114.2 +004100 SELECT IX-NOP ASSIGN IX1114.2 +004200 XXXXX025 IX1114.2 +004300 ORGANIZATION IS INDEXED IX1114.2 +004400 ACCESS MODE IS SEQUENTIAL IX1114.2 +004500 RECORD KEY IS IX-NOP-KEY IX1114.2 +004600 FILE STATUS IS IX-NOP-STATUS. IX1114.2 +004700 IX1114.2 +004800 IX1114.2 +004900 DATA DIVISION. IX1114.2 +005000 IX1114.2 +005100 FILE SECTION. IX1114.2 +005200 IX1114.2 +005300 FD PRINT-FILE. IX1114.2 +005400 IX1114.2 +005500 01 PRINT-REC PIC X(120). IX1114.2 +005600 IX1114.2 +005700 01 DUMMY-RECORD PIC X(120). IX1114.2 +005800 IX1114.2 +005900 FD IX-NOP IX1114.2 +006000C LABEL RECORD STANDARD IX1114.2 +006100C DATA RECORDS IX-NOPR1-F-G-240 IX1114.2 +006200 RECORD 240 IX1114.2 +006300 BLOCK CONTAINS 2 RECORDS. IX1114.2 +006400 IX1114.2 +006500 01 IX-NOPR1-F-G-240. IX1114.2 +006600 05 IX-NOP-REC-120 PIC X(120). IX1114.2 +006700 05 IX-NOP-REC-120-240. IX1114.2 +006800 10 FILLER PIC X(8). IX1114.2 +006900 10 IX-NOP-KEY PIC X(29). IX1114.2 +007000 10 FILLER PIC X(9). IX1114.2 +007100 10 IX-NOP-ALTER-KEY PIC X(29). IX1114.2 +007200 10 FILLER PIC X(45). IX1114.2 +007300 IX1114.2 +007400 IX1114.2 +007500 WORKING-STORAGE SECTION. IX1114.2 +007600 IX1114.2 +007700 01 IX-NOP-STATUS PIC XX. IX1114.2 +007800 IX1114.2 +007900 01 TEST-RESULTS. IX1114.2 +008000 02 FILLER PIC X VALUE SPACE. IX1114.2 +008100 02 FEATURE PIC X(20) VALUE SPACE. IX1114.2 +008200 02 FILLER PIC X VALUE SPACE. IX1114.2 +008300 02 P-OR-F PIC X(5) VALUE SPACE. IX1114.2 +008400 02 FILLER PIC X VALUE SPACE. IX1114.2 +008500 02 PAR-NAME. IX1114.2 +008600 03 FILLER PIC X(19) VALUE SPACE. IX1114.2 +008700 03 PARDOT-X PIC X VALUE SPACE. IX1114.2 +008800 03 DOTVALUE PIC 99 VALUE ZERO. IX1114.2 +008900 02 FILLER PIC X(8) VALUE SPACE. IX1114.2 +009000 02 RE-MARK PIC X(61). IX1114.2 +009100 01 TEST-COMPUTED. IX1114.2 +009200 02 FILLER PIC X(30) VALUE SPACE. IX1114.2 +009300 02 FILLER PIC X(17) VALUE IX1114.2 +009400 " COMPUTED=". IX1114.2 +009500 02 COMPUTED-X. IX1114.2 +009600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1114.2 +009700 03 COMPUTED-N REDEFINES COMPUTED-A IX1114.2 +009800 PIC -9(9).9(9). IX1114.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1114.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1114.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1114.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. IX1114.2 +010300 04 COMPUTED-18V0 PIC -9(18). IX1114.2 +010400 04 FILLER PIC X. IX1114.2 +010500 03 FILLER PIC X(50) VALUE SPACE. IX1114.2 +010600 01 TEST-CORRECT. IX1114.2 +010700 02 FILLER PIC X(30) VALUE SPACE. IX1114.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1114.2 +010900 02 CORRECT-X. IX1114.2 +011000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1114.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1114.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1114.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1114.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1114.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. IX1114.2 +011600 04 CORRECT-18V0 PIC -9(18). IX1114.2 +011700 04 FILLER PIC X. IX1114.2 +011800 03 FILLER PIC X(2) VALUE SPACE. IX1114.2 +011900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1114.2 +012000 01 CCVS-C-1. IX1114.2 +012100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1114.2 +012200- "SS PARAGRAPH-NAME IX1114.2 +012300- " REMARKS". IX1114.2 +012400 02 FILLER PIC X(20) VALUE SPACE. IX1114.2 +012500 01 CCVS-C-2. IX1114.2 +012600 02 FILLER PIC X VALUE SPACE. IX1114.2 +012700 02 FILLER PIC X(6) VALUE "TESTED". IX1114.2 +012800 02 FILLER PIC X(15) VALUE SPACE. IX1114.2 +012900 02 FILLER PIC X(4) VALUE "FAIL". IX1114.2 +013000 02 FILLER PIC X(94) VALUE SPACE. IX1114.2 +013100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1114.2 +013200 01 REC-CT PIC 99 VALUE ZERO. IX1114.2 +013300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1114.2 +013800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1114.2 +013900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1114.2 +014000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1114.2 +014100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1114.2 +014200 01 CCVS-H-1. IX1114.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IX1114.2 +014400 02 FILLER PIC X(42) VALUE IX1114.2 +014500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1114.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IX1114.2 +014700 01 CCVS-H-2A. IX1114.2 +014800 02 FILLER PIC X(40) VALUE SPACE. IX1114.2 +014900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1114.2 +015000 02 FILLER PIC XXXX VALUE IX1114.2 +015100 "4.2 ". IX1114.2 +015200 02 FILLER PIC X(28) VALUE IX1114.2 +015300 " COPY - NOT FOR DISTRIBUTION". IX1114.2 +015400 02 FILLER PIC X(41) VALUE SPACE. IX1114.2 +015500 IX1114.2 +015600 01 CCVS-H-2B. IX1114.2 +015700 02 FILLER PIC X(15) VALUE IX1114.2 +015800 "TEST RESULT OF ". IX1114.2 +015900 02 TEST-ID PIC X(9). IX1114.2 +016000 02 FILLER PIC X(4) VALUE IX1114.2 +016100 " IN ". IX1114.2 +016200 02 FILLER PIC X(12) VALUE IX1114.2 +016300 " HIGH ". IX1114.2 +016400 02 FILLER PIC X(22) VALUE IX1114.2 +016500 " LEVEL VALIDATION FOR ". IX1114.2 +016600 02 FILLER PIC X(58) VALUE IX1114.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +016800 01 CCVS-H-3. IX1114.2 +016900 02 FILLER PIC X(34) VALUE IX1114.2 +017000 " FOR OFFICIAL USE ONLY ". IX1114.2 +017100 02 FILLER PIC X(58) VALUE IX1114.2 +017200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1114.2 +017300 02 FILLER PIC X(28) VALUE IX1114.2 +017400 " COPYRIGHT 1985 ". IX1114.2 +017500 01 CCVS-E-1. IX1114.2 +017600 02 FILLER PIC X(52) VALUE SPACE. IX1114.2 +017700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1114.2 +017800 02 ID-AGAIN PIC X(9). IX1114.2 +017900 02 FILLER PIC X(45) VALUE SPACES. IX1114.2 +018000 01 CCVS-E-2. IX1114.2 +018100 02 FILLER PIC X(31) VALUE SPACE. IX1114.2 +018200 02 FILLER PIC X(21) VALUE SPACE. IX1114.2 +018300 02 CCVS-E-2-2. IX1114.2 +018400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1114.2 +018500 03 FILLER PIC X VALUE SPACE. IX1114.2 +018600 03 ENDER-DESC PIC X(44) VALUE IX1114.2 +018700 "ERRORS ENCOUNTERED". IX1114.2 +018800 01 CCVS-E-3. IX1114.2 +018900 02 FILLER PIC X(22) VALUE IX1114.2 +019000 " FOR OFFICIAL USE ONLY". IX1114.2 +019100 02 FILLER PIC X(12) VALUE SPACE. IX1114.2 +019200 02 FILLER PIC X(58) VALUE IX1114.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +019400 02 FILLER PIC X(13) VALUE SPACE. IX1114.2 +019500 02 FILLER PIC X(15) VALUE IX1114.2 +019600 " COPYRIGHT 1985". IX1114.2 +019700 01 CCVS-E-4. IX1114.2 +019800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1114.2 +019900 02 FILLER PIC X(4) VALUE " OF ". IX1114.2 +020000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1114.2 +020100 02 FILLER PIC X(40) VALUE IX1114.2 +020200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1114.2 +020300 01 XXINFO. IX1114.2 +020400 02 FILLER PIC X(19) VALUE IX1114.2 +020500 "*** INFORMATION ***". IX1114.2 +020600 02 INFO-TEXT. IX1114.2 +020700 04 FILLER PIC X(8) VALUE SPACE. IX1114.2 +020800 04 XXCOMPUTED PIC X(20). IX1114.2 +020900 04 FILLER PIC X(5) VALUE SPACE. IX1114.2 +021000 04 XXCORRECT PIC X(20). IX1114.2 +021100 02 INF-ANSI-REFERENCE PIC X(48). IX1114.2 +021200 01 HYPHEN-LINE. IX1114.2 +021300 02 FILLER PIC IS X VALUE IS SPACE. IX1114.2 +021400 02 FILLER PIC IS X(65) VALUE IS "************************IX1114.2 +021500- "*****************************************". IX1114.2 +021600 02 FILLER PIC IS X(54) VALUE IS "************************IX1114.2 +021700- "******************************". IX1114.2 +021800 01 CCVS-PGM-ID PIC X(9) VALUE IX1114.2 +021900 "IX111A". IX1114.2 +022000 PROCEDURE DIVISION. IX1114.2 +022100 DECLARATIVES. IX1114.2 +022200 IX1114.2 +022300 SECT-IX111-0001 SECTION. IX1114.2 +022400 USE AFTER EXCEPTION PROCEDURE ON IX-NOP. IX1114.2 +022500 INPUT-PROCESS. IX1114.2 +022600 IF IX-NOP-STATUS = "35" IX1114.2 +022700 PERFORM PASS-DECL IX1114.2 +022800 GO TO ABNORMAL-TERM-DECL IX1114.2 +022900 ELSE IX1114.2 +023000 MOVE "35" TO CORRECT-A IX1114.2 +023100 MOVE IX-NOP-STATUS TO COMPUTED-A IX1114.2 +023200 MOVE "STATUS FOR OPEN INPUT OF FILE THAT IS NOT IX1114.2 +023300- "PRESENT INCORRECT" TO RE-MARK IX1114.2 +023400 MOVE "IX-2, FILE STATUS" TO ANSI-REFERENCE IX1114.2 +023500 PERFORM FAIL-DECL IX1114.2 +023600 GO TO ABNORMAL-TERM-DECL IX1114.2 +023700 END-IF. IX1114.2 +023800 IX1114.2 +023900 PASS-DECL. IX1114.2 +024000 MOVE "PASS " TO P-OR-F. IX1114.2 +024100 ADD 1 TO PASS-COUNTER. IX1114.2 +024200 PERFORM PRINT-DETAIL-DECL. IX1114.2 +024300* IX1114.2 +024400 FAIL-DECL. IX1114.2 +024500 MOVE "FAIL*" TO P-OR-F. IX1114.2 +024600 ADD 1 TO ERROR-COUNTER. IX1114.2 +024700 PERFORM PRINT-DETAIL-DECL. IX1114.2 +024800* IX1114.2 +024900 PRINT-DETAIL-DECL. IX1114.2 +025000 IF REC-CT NOT EQUAL TO ZERO IX1114.2 +025100 MOVE "." TO PARDOT-X IX1114.2 +025200 MOVE REC-CT TO DOTVALUE. IX1114.2 +025300 MOVE TEST-RESULTS TO PRINT-REC. IX1114.2 +025400 PERFORM WRITE-LINE-DECL. IX1114.2 +025500 IF P-OR-F EQUAL TO "FAIL*" IX1114.2 +025600 PERFORM WRITE-LINE-DECL IX1114.2 +025700 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL IX1114.2 +025800 ELSE IX1114.2 +025900 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. IX1114.2 +026000 MOVE SPACE TO P-OR-F. IX1114.2 +026100 MOVE SPACE TO COMPUTED-X. IX1114.2 +026200 MOVE SPACE TO CORRECT-X. IX1114.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1114.2 +026400 MOVE SPACE TO RE-MARK. IX1114.2 +026500* IX1114.2 +026600 WRITE-LINE-DECL. IX1114.2 +026700 ADD 1 TO RECORD-COUNT. IX1114.2 +026800 PERFORM WRT-LN-DECL. IX1114.2 +026900* IX1114.2 +027000 WRT-LN-DECL. IX1114.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1114.2 +027200 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +027300 BLANK-LINE-PRINT-DECL. IX1114.2 +027400 PERFORM WRT-LN-DECL. IX1114.2 +027500 FAIL-ROUTINE-DECL. IX1114.2 +027600 IF COMPUTED-X NOT EQUAL TO SPACE IX1114.2 +027700 GO TO FAIL-ROUTINE-WRITE-DECL. IX1114.2 +027800 IF CORRECT-X NOT EQUAL TO SPACE IX1114.2 +027900 GO TO FAIL-ROUTINE-WRITE-DECL. IX1114.2 +028000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +028100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1114.2 +028200 MOVE XXINFO TO DUMMY-RECORD. IX1114.2 +028300 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +028400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +028500 GO TO FAIL-ROUTINE-EX-DECL. IX1114.2 +028600 FAIL-ROUTINE-WRITE-DECL. IX1114.2 +028700 MOVE TEST-COMPUTED TO PRINT-REC IX1114.2 +028800 PERFORM WRITE-LINE-DECL IX1114.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1114.2 +029000 MOVE TEST-CORRECT TO PRINT-REC IX1114.2 +029100 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +029200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1114.2 +029300 FAIL-ROUTINE-EX-DECL. IX1114.2 +029400 EXIT. IX1114.2 +029500 BAIL-OUT-DECL. IX1114.2 +029600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. IX1114.2 +029700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. IX1114.2 +029800 BAIL-OUT-WRITE-DECL. IX1114.2 +029900 MOVE CORRECT-A TO XXCORRECT. IX1114.2 +030000 MOVE COMPUTED-A TO XXCOMPUTED. IX1114.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +030200 MOVE XXINFO TO DUMMY-RECORD. IX1114.2 +030300 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +030500 BAIL-OUT-EX-DECL. IX1114.2 +030600 EXIT. IX1114.2 +030700* IX1114.2 +030800 ABNORMAL-TERM-DECL. IX1114.2 +030900 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +031000 PERFORM WRITE-LINE-DECL. IX1114.2 +031100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" IX1114.2 +031200 TO DUMMY-RECORD. IX1114.2 +031300 PERFORM WRITE-LINE-DECL 3 TIMES. IX1114.2 +031400* IX1114.2 +031500 EXIT-DECL. IX1114.2 +031600 EXIT. IX1114.2 +031700 END DECLARATIVES. IX1114.2 +031800 IX1114.2 +031900 IX1114.2 +032000 CCVS1 SECTION. IX1114.2 +032100 OPEN-FILES. IX1114.2 +032200 OPEN OUTPUT PRINT-FILE. IX1114.2 +032300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1114.2 +032400 MOVE SPACE TO TEST-RESULTS. IX1114.2 +032500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1114.2 +032600 MOVE ZERO TO REC-SKL-SUB. IX1114.2 +032700 CCVS-INIT-EXIT. IX1114.2 +032800 GO TO CCVS1-EXIT. IX1114.2 +032900 CLOSE-FILES. IX1114.2 +033000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1114.2 +033100 TERMINATE-CCVS. IX1114.2 +033200 STOP RUN. IX1114.2 +033300 HEAD-ROUTINE. IX1114.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +033500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +033600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1114.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1114.2 +033800 COLUMN-NAMES-ROUTINE. IX1114.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +034200 END-ROUTINE. IX1114.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1114.2 +034400 END-RTN-EXIT. IX1114.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +034600 END-ROUTINE-1. IX1114.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1114.2 +034800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1114.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. IX1114.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1114.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1114.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1114.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1114.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1114.2 +035500 END-ROUTINE-12. IX1114.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1114.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1114.2 +035800 MOVE "NO " TO ERROR-TOTAL IX1114.2 +035900 ELSE IX1114.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1114.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1114.2 +036200 PERFORM WRITE-LINE. IX1114.2 +036300 END-ROUTINE-13. IX1114.2 +036400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1114.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE IX1114.2 +036600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1114.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1114.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO IX1114.2 +037000 MOVE "NO " TO ERROR-TOTAL IX1114.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1114.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1114.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +037500 WRITE-LINE. IX1114.2 +037600 ADD 1 TO RECORD-COUNT. IX1114.2 +037700Y IF RECORD-COUNT GREATER 42 IX1114.2 +037800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1114.2 +037900Y MOVE SPACE TO DUMMY-RECORD IX1114.2 +038000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1114.2 +038100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1114.2 +038200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1114.2 +038300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1114.2 +038400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1114.2 +038500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1114.2 +038900Y MOVE ZERO TO RECORD-COUNT. IX1114.2 +039000 PERFORM WRT-LN. IX1114.2 +039100 WRT-LN. IX1114.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1114.2 +039300 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +039400 BLANK-LINE-PRINT. IX1114.2 +039500 PERFORM WRT-LN. IX1114.2 +039600 FAIL-ROUTINE. IX1114.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE IX1114.2 +039800 GO TO FAIL-ROUTINE-WRITE. IX1114.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1114.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1114.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +040400 GO TO FAIL-ROUTINE-EX. IX1114.2 +040500 FAIL-ROUTINE-WRITE. IX1114.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1114.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1114.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1114.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1114.2 +041000 FAIL-ROUTINE-EX. EXIT. IX1114.2 +041100 BAIL-OUT. IX1114.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1114.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1114.2 +041400 BAIL-OUT-WRITE. IX1114.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1114.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +041900 BAIL-OUT-EX. EXIT. IX1114.2 +042000 CCVS1-EXIT. IX1114.2 +042100 EXIT. IX1114.2 +042200 IX1114.2 +042300 SECT-IX111A-0003 SECTION. IX1114.2 +042400 SEQ-INIT-010. IX1114.2 +042500 IX1114.2 +042600******************************************************************IX1114.2 +042700* TEST 1 *IX1114.2 +042800* OPEN INPUT (FILE DOES NOT EXIST) 35 EXPECTED *IX1114.2 +042900* IX-4, 1.3.4 (4) B *IX1114.2 +043000******************************************************************IX1114.2 +043100 OPN-INIT-GF-01-0. IX1114.2 +043200 MOVE SPACES TO IX-NOP-STATUS. IX1114.2 +043300 MOVE "OPEN INPUT 35 EXP." TO FEATURE. IX1114.2 +043400 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1114.2 +043500 OPN-TEST-GF-01-0. IX1114.2 +043600 OPEN IX1114.2 +043700 INPUT IX-NOP. IX1114.2 +043800 IX1114.2 +043900 TERMINATE-ROUTINE. IX1114.2 +044000 EXIT. IX1114.2 +044100 IX1114.2 +044200 CCVS-EXIT SECTION. IX1114.2 +044300 CCVS-999999. IX1114.2 +044400 GO TO CLOSE-FILES. IX1114.2 +*END-OF,IX111A TES06680 +*HEADER,COBOL,IX112A +000100 IDENTIFICATION DIVISION. IX1124.2 +000200 PROGRAM-ID. IX1124.2 +000300 IX112A. IX1124.2 +000400**************************************************************** IX1124.2 +000500* * IX1124.2 +000600* VALIDATION FOR:- * IX1124.2 +000700* * IX1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +000900* * IX1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1124.2 +001100* * IX1124.2 +001200**************************************************************** IX1124.2 +001300* IX1124.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-VS2 IX1124.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1124.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1124.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THEN THE FILE IS OPENED IX1124.2 +001800* AS I-O AND IT IS ATTEMTED TO REWRITE A RECORD WITH A IX1124.2 +001900* WRONG RECORD LENGTH. IX1124.2 +002000* IX1124.2 +002100* 2. THE ROUTINE READS THE CREATED FILE, VERIFIES IT AND IX1124.2 +002200* CHECKS THE FILE STATUS CODE: IX1124.2 +002300* 44 - AFTER REWRITE (WITH WRONG RECORD LENGTH) IX1124.2 +002400* IX1124.2 +002500* 3. X-CARDS USED IN THIS PROGRAM: IX1124.2 +002600* IX1124.2 +002700* XXXXX024 IX1124.2 +002800* XXXXX055. IX1124.2 +002900* XXXXX062. IX1124.2 +003000* XXXXX082. IX1124.2 +003100* XXXXX083. IX1124.2 +003200* XXXXX084 IX1124.2 +003300* IX1124.2 +003400* IX1124.2 +003500 ENVIRONMENT DIVISION. IX1124.2 +003600 CONFIGURATION SECTION. IX1124.2 +003700 SOURCE-COMPUTER. IX1124.2 +003800 XXXXX082. IX1124.2 +003900 OBJECT-COMPUTER. IX1124.2 +004000 XXXXX083. IX1124.2 +004100 INPUT-OUTPUT SECTION. IX1124.2 +004200 FILE-CONTROL. IX1124.2 +004300P SELECT RAW-DATA ASSIGN TO IX1124.2 +004400P XXXXX062 IX1124.2 +004500P ORGANIZATION IS INDEXED IX1124.2 +004600P ACCESS MODE IS RANDOM IX1124.2 +004700P RECORD KEY IS RAW-DATA-KEY. IX1124.2 +004800* IX1124.2 +004900 SELECT PRINT-FILE ASSIGN TO IX1124.2 +005000 XXXXX055. IX1124.2 +005100* IX1124.2 +005200 SELECT IX-VS2 ASSIGN IX1124.2 +005300 XXXXX024 IX1124.2 +005400 ORGANIZATION IS INDEXED IX1124.2 +005500 ACCESS MODE IS SEQUENTIAL IX1124.2 +005600 RECORD KEY IS IX-VS2-KEY IX1124.2 +005700 FILE STATUS IS IX-VS2-STATUS. IX1124.2 +005800 IX1124.2 +005900 DATA DIVISION. IX1124.2 +006000 IX1124.2 +006100 FILE SECTION. IX1124.2 +006200P IX1124.2 +006300PFD RAW-DATA. IX1124.2 +006400P IX1124.2 +006500P01 RAW-DATA-SATZ. IX1124.2 +006600P 05 RAW-DATA-KEY PIC X(6). IX1124.2 +006700P 05 C-DATE PIC 9(6). IX1124.2 +006800P 05 C-TIME PIC 9(8). IX1124.2 +006900P 05 C-NO-OF-TESTS PIC 99. IX1124.2 +007000P 05 C-OK PIC 999. IX1124.2 +007100P 05 C-ALL PIC 999. IX1124.2 +007200P 05 C-FAIL PIC 999. IX1124.2 +007300P 05 C-DELETED PIC 999. IX1124.2 +007400P 05 C-INSPECT PIC 999. IX1124.2 +007500P 05 C-NOTE PIC X(13). IX1124.2 +007600P 05 C-INDENT PIC X. IX1124.2 +007700P 05 C-ABORT PIC X(8). IX1124.2 +007800 IX1124.2 +007900 FD PRINT-FILE. IX1124.2 +008000 IX1124.2 +008100 01 PRINT-REC PIC X(120). IX1124.2 +008200 IX1124.2 +008300 01 DUMMY-RECORD PIC X(120). IX1124.2 +008400 IX1124.2 +008500 FD IX-VS2 IX1124.2 +008600C DATA RECORDS IX-VS2R1-F-G-240 IX-VS2R1-F-G-200 IX1124.2 +008700C IX-VS2R1-F-G-280 IX1124.2 +008800C LABEL RECORD STANDARD IX1124.2 +008900 RECORD 200 TO 280 IX1124.2 +009000 BLOCK CONTAINS 2 RECORDS. IX1124.2 +009100 IX1124.2 +009200 01 IX-VS2R1-F-G-240. IX1124.2 +009300 05 IX-VS2-REC-120 PIC X(120). IX1124.2 +009400 05 IX-VS2-REC-120-240. IX1124.2 +009500 10 FILLER PIC X(8). IX1124.2 +009600 10 IX-VS2-KEY PIC X(29). IX1124.2 +009700 10 FILLER PIC X(9). IX1124.2 +009800 10 IX-VS2-ALTER-KEY PIC X(29). IX1124.2 +009900 10 FILLER PIC X(45). IX1124.2 +010000 IX1124.2 +010100 01 IX-VS2R1-F-G-200. IX1124.2 +010200 05 IX-VS2-REC-SHORT PIC X(120). IX1124.2 +010300 05 IX-VS2-REC-120-200 PIC X(80). IX1124.2 +010400 IX1124.2 +010500 01 IX-VS2R1-F-G-280. IX1124.2 +010600 05 IX-VS2-REC-LONG PIC X(120). IX1124.2 +010700 05 IX-VS2-REC-120-239 PIC X(120). IX1124.2 +010800 05 IX-VS2-REC-240-280 PIC X(40). IX1124.2 +010900 IX1124.2 +011000 WORKING-STORAGE SECTION. IX1124.2 +011100 IX1124.2 +011200 01 GRP-0101. IX1124.2 +011300 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1124.2 +011400 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1124.2 +011500 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1124.2 +011600 IX1124.2 +011700 01 GRP-0102. IX1124.2 +011800 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1124.2 +011900 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1124.2 +012000 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1124.2 +012100 IX1124.2 +012200 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1124.2 +012300 IX1124.2 +012400 01 EOF-FLAG PIC 9 VALUE ZERO. IX1124.2 +012500 IX1124.2 +012600 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1124.2 +012700 IX1124.2 +012800 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1124.2 +012900 IX1124.2 +013000 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1124.2 +013100 IX1124.2 +013200 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1124.2 +013300 IX1124.2 +013400 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1124.2 +013500 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1124.2 +013600 IX1124.2 +013700 01 IX-VS2-STATUS. IX1124.2 +013800 05 IX-VS2-STAT1 PIC X. IX1124.2 +013900 05 IX-VS2-STAT2 PIC X. IX1124.2 +014000 IX1124.2 +014100 01 COUNT-OF-RECS PIC 9(5). IX1124.2 +014200 IX1124.2 +014300 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1124.2 +014400 IX1124.2 +014500 01 FILE-RECORD-INFORMATION-REC. IX1124.2 +014600 05 FILE-RECORD-INFO-SKELETON. IX1124.2 +014700 10 FILLER PIC X(48) VALUE IX1124.2 +014800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1124.2 +014900 10 FILLER PIC X(46) VALUE IX1124.2 +015000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1124.2 +015100 10 FILLER PIC X(26) VALUE IX1124.2 +015200 ",LFIL=000000,ORG= ,LBLR= ". IX1124.2 +015300 10 FILLER PIC X(37) VALUE IX1124.2 +015400 ",RECKEY= ". IX1124.2 +015500 10 FILLER PIC X(38) VALUE IX1124.2 +015600 ",ALTKEY1= ". IX1124.2 +015700 10 FILLER PIC X(38) VALUE IX1124.2 +015800 ",ALTKEY2= ". IX1124.2 +015900 10 FILLER PIC X(7) VALUE SPACE. IX1124.2 +016000 05 FILE-RECORD-INFO OCCURS 10. IX1124.2 +016100 10 FILE-RECORD-INFO-P1-120. IX1124.2 +016200 15 FILLER PIC X(5). IX1124.2 +016300 15 XFILE-NAME PIC X(6). IX1124.2 +016400 15 FILLER PIC X(8). IX1124.2 +016500 15 XRECORD-NAME PIC X(6). IX1124.2 +016600 15 FILLER PIC X(1). IX1124.2 +016700 15 REELUNIT-NUMBER PIC 9(1). IX1124.2 +016800 15 FILLER PIC X(7). IX1124.2 +016900 15 XRECORD-NUMBER PIC 9(6). IX1124.2 +017000 15 FILLER PIC X(6). IX1124.2 +017100 15 UPDATE-NUMBER PIC 9(2). IX1124.2 +017200 15 FILLER PIC X(5). IX1124.2 +017300 15 ODO-NUMBER PIC 9(4). IX1124.2 +017400 15 FILLER PIC X(5). IX1124.2 +017500 15 XPROGRAM-NAME PIC X(5). IX1124.2 +017600 15 FILLER PIC X(7). IX1124.2 +017700 15 XRECORD-LENGTH PIC 9(6). IX1124.2 +017800 15 FILLER PIC X(7). IX1124.2 +017900 15 CHARS-OR-RECORDS PIC X(2). IX1124.2 +018000 15 FILLER PIC X(1). IX1124.2 +018100 15 XBLOCK-SIZE PIC 9(4). IX1124.2 +018200 15 FILLER PIC X(6). IX1124.2 +018300 15 RECORDS-IN-FILE PIC 9(6). IX1124.2 +018400 15 FILLER PIC X(5). IX1124.2 +018500 15 XFILE-ORGANIZATION PIC X(2). IX1124.2 +018600 15 FILLER PIC X(6). IX1124.2 +018700 15 XLABEL-TYPE PIC X(1). IX1124.2 +018800 10 FILE-RECORD-INFO-P121-240. IX1124.2 +018900 15 FILLER PIC X(8). IX1124.2 +019000 15 XRECORD-KEY PIC X(29). IX1124.2 +019100 15 FILLER PIC X(9). IX1124.2 +019200 15 ALTERNATE-KEY1 PIC X(29). IX1124.2 +019300 15 FILLER PIC X(9). IX1124.2 +019400 15 ALTERNATE-KEY2 PIC X(29). IX1124.2 +019500 15 FILLER PIC X(7). IX1124.2 +019600 IX1124.2 +019700 01 TEST-RESULTS. IX1124.2 +019800 02 FILLER PIC X VALUE SPACE. IX1124.2 +019900 02 FEATURE PIC X(20) VALUE SPACE. IX1124.2 +020000 02 FILLER PIC X VALUE SPACE. IX1124.2 +020100 02 P-OR-F PIC X(5) VALUE SPACE. IX1124.2 +020200 02 FILLER PIC X VALUE SPACE. IX1124.2 +020300 02 PAR-NAME. IX1124.2 +020400 03 FILLER PIC X(19) VALUE SPACE. IX1124.2 +020500 03 PARDOT-X PIC X VALUE SPACE. IX1124.2 +020600 03 DOTVALUE PIC 99 VALUE ZERO. IX1124.2 +020700 02 FILLER PIC X(8) VALUE SPACE. IX1124.2 +020800 02 RE-MARK PIC X(61). IX1124.2 +020900 01 TEST-COMPUTED. IX1124.2 +021000 02 FILLER PIC X(30) VALUE SPACE. IX1124.2 +021100 02 FILLER PIC X(17) VALUE IX1124.2 +021200 " COMPUTED=". IX1124.2 +021300 02 COMPUTED-X. IX1124.2 +021400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1124.2 +021500 03 COMPUTED-N REDEFINES COMPUTED-A IX1124.2 +021600 PIC -9(9).9(9). IX1124.2 +021700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1124.2 +021800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1124.2 +021900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1124.2 +022000 03 CM-18V0 REDEFINES COMPUTED-A. IX1124.2 +022100 04 COMPUTED-18V0 PIC -9(18). IX1124.2 +022200 04 FILLER PIC X. IX1124.2 +022300 03 FILLER PIC X(50) VALUE SPACE. IX1124.2 +022400 01 TEST-CORRECT. IX1124.2 +022500 02 FILLER PIC X(30) VALUE SPACE. IX1124.2 +022600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1124.2 +022700 02 CORRECT-X. IX1124.2 +022800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1124.2 +022900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1124.2 +023000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1124.2 +023100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1124.2 +023200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1124.2 +023300 03 CR-18V0 REDEFINES CORRECT-A. IX1124.2 +023400 04 CORRECT-18V0 PIC -9(18). IX1124.2 +023500 04 FILLER PIC X. IX1124.2 +023600 03 FILLER PIC X(2) VALUE SPACE. IX1124.2 +023700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1124.2 +023800 01 CCVS-C-1. IX1124.2 +023900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1124.2 +024000- "SS PARAGRAPH-NAME IX1124.2 +024100- " REMARKS". IX1124.2 +024200 02 FILLER PIC X(20) VALUE SPACE. IX1124.2 +024300 01 CCVS-C-2. IX1124.2 +024400 02 FILLER PIC X VALUE SPACE. IX1124.2 +024500 02 FILLER PIC X(6) VALUE "TESTED". IX1124.2 +024600 02 FILLER PIC X(15) VALUE SPACE. IX1124.2 +024700 02 FILLER PIC X(4) VALUE "FAIL". IX1124.2 +024800 02 FILLER PIC X(94) VALUE SPACE. IX1124.2 +024900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1124.2 +025000 01 REC-CT PIC 99 VALUE ZERO. IX1124.2 +025100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1124.2 +025600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1124.2 +025700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1124.2 +025800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1124.2 +025900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1124.2 +026000 01 CCVS-H-1. IX1124.2 +026100 02 FILLER PIC X(39) VALUE SPACES. IX1124.2 +026200 02 FILLER PIC X(42) VALUE IX1124.2 +026300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1124.2 +026400 02 FILLER PIC X(39) VALUE SPACES. IX1124.2 +026500 01 CCVS-H-2A. IX1124.2 +026600 02 FILLER PIC X(40) VALUE SPACE. IX1124.2 +026700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1124.2 +026800 02 FILLER PIC XXXX VALUE IX1124.2 +026900 "4.2 ". IX1124.2 +027000 02 FILLER PIC X(28) VALUE IX1124.2 +027100 " COPY - NOT FOR DISTRIBUTION". IX1124.2 +027200 02 FILLER PIC X(41) VALUE SPACE. IX1124.2 +027300 IX1124.2 +027400 01 CCVS-H-2B. IX1124.2 +027500 02 FILLER PIC X(15) VALUE IX1124.2 +027600 "TEST RESULT OF ". IX1124.2 +027700 02 TEST-ID PIC X(9). IX1124.2 +027800 02 FILLER PIC X(4) VALUE IX1124.2 +027900 " IN ". IX1124.2 +028000 02 FILLER PIC X(12) VALUE IX1124.2 +028100 " HIGH ". IX1124.2 +028200 02 FILLER PIC X(22) VALUE IX1124.2 +028300 " LEVEL VALIDATION FOR ". IX1124.2 +028400 02 FILLER PIC X(58) VALUE IX1124.2 +028500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +028600 01 CCVS-H-3. IX1124.2 +028700 02 FILLER PIC X(34) VALUE IX1124.2 +028800 " FOR OFFICIAL USE ONLY ". IX1124.2 +028900 02 FILLER PIC X(58) VALUE IX1124.2 +029000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1124.2 +029100 02 FILLER PIC X(28) VALUE IX1124.2 +029200 " COPYRIGHT 1985 ". IX1124.2 +029300 01 CCVS-E-1. IX1124.2 +029400 02 FILLER PIC X(52) VALUE SPACE. IX1124.2 +029500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1124.2 +029600 02 ID-AGAIN PIC X(9). IX1124.2 +029700 02 FILLER PIC X(45) VALUE SPACES. IX1124.2 +029800 01 CCVS-E-2. IX1124.2 +029900 02 FILLER PIC X(31) VALUE SPACE. IX1124.2 +030000 02 FILLER PIC X(21) VALUE SPACE. IX1124.2 +030100 02 CCVS-E-2-2. IX1124.2 +030200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1124.2 +030300 03 FILLER PIC X VALUE SPACE. IX1124.2 +030400 03 ENDER-DESC PIC X(44) VALUE IX1124.2 +030500 "ERRORS ENCOUNTERED". IX1124.2 +030600 01 CCVS-E-3. IX1124.2 +030700 02 FILLER PIC X(22) VALUE IX1124.2 +030800 " FOR OFFICIAL USE ONLY". IX1124.2 +030900 02 FILLER PIC X(12) VALUE SPACE. IX1124.2 +031000 02 FILLER PIC X(58) VALUE IX1124.2 +031100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +031200 02 FILLER PIC X(13) VALUE SPACE. IX1124.2 +031300 02 FILLER PIC X(15) VALUE IX1124.2 +031400 " COPYRIGHT 1985". IX1124.2 +031500 01 CCVS-E-4. IX1124.2 +031600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1124.2 +031700 02 FILLER PIC X(4) VALUE " OF ". IX1124.2 +031800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1124.2 +031900 02 FILLER PIC X(40) VALUE IX1124.2 +032000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1124.2 +032100 01 XXINFO. IX1124.2 +032200 02 FILLER PIC X(19) VALUE IX1124.2 +032300 "*** INFORMATION ***". IX1124.2 +032400 02 INFO-TEXT. IX1124.2 +032500 04 FILLER PIC X(8) VALUE SPACE. IX1124.2 +032600 04 XXCOMPUTED PIC X(20). IX1124.2 +032700 04 FILLER PIC X(5) VALUE SPACE. IX1124.2 +032800 04 XXCORRECT PIC X(20). IX1124.2 +032900 02 INF-ANSI-REFERENCE PIC X(48). IX1124.2 +033000 01 HYPHEN-LINE. IX1124.2 +033100 02 FILLER PIC IS X VALUE IS SPACE. IX1124.2 +033200 02 FILLER PIC IS X(65) VALUE IS "************************IX1124.2 +033300- "*****************************************". IX1124.2 +033400 02 FILLER PIC IS X(54) VALUE IS "************************IX1124.2 +033500- "******************************". IX1124.2 +033600 01 CCVS-PGM-ID PIC X(9) VALUE IX1124.2 +033700 "IX112A". IX1124.2 +033800 01 TEST-NUMBER PIC 9 VALUE ZERO. IX1124.2 +033900 IX1124.2 +034000 PROCEDURE DIVISION. IX1124.2 +034100 DECLARATIVES. IX1124.2 +034200 IX1124.2 +034300 SECT-IX105-0002 SECTION. IX1124.2 +034400 USE AFTER EXCEPTION PROCEDURE ON IX-VS2. IX1124.2 +034500 INPUT-PROCESS. IX1124.2 +034600 MOVE 1 TO PERM-ERRORS. IX1124.2 +034700 IF TEST-NUMBER NOT = 7 GO TO END-DECL. IX1124.2 +034800 D-RWR-TEST-GF-01-1. IX1124.2 +034900 IF IX-VS2-STATUS = "00" IX1124.2 +035000 GO TO D-RWR-PASS-GF-01-0. IX1124.2 +035100 IF IX-VS2-STATUS = "44" IX1124.2 +035200 GO TO D-RWR-PASS-GF-01-0. IX1124.2 +035300 D-RWR-FAIL-GF-01-0. IX1124.2 +035400 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1124.2 +035500 PERFORM D-FAIL. IX1124.2 +035600 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +035700 MOVE "00 OR 44" TO CORRECT-X. IX1124.2 +035800 GO TO D-RWR-WRITE-GF-01-0. IX1124.2 +035900 D-RWR-PASS-GF-01-0. IX1124.2 +036000 PERFORM D-PASS. IX1124.2 +036100 D-RWR-WRITE-GF-01-0. IX1124.2 +036200 PERFORM D-PRINT-DETAIL. IX1124.2 +036300 D-CLOSE-FILES. IX1124.2 +036400P OPEN I-O RAW-DATA. IX1124.2 +036500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +036600P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1124.2 +036700P MOVE "OK. " TO C-ABORT. IX1124.2 +036800P MOVE PASS-COUNTER TO C-OK. IX1124.2 +036900P MOVE ERROR-HOLD TO C-ALL. IX1124.2 +037000P MOVE ERROR-COUNTER TO C-FAIL. IX1124.2 +037100P MOVE DELETE-COUNTER TO C-DELETED. IX1124.2 +037200P MOVE INSPECT-COUNTER TO C-INSPECT. IX1124.2 +037300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1124.2 +037400PD-END-E-2. IX1124.2 +037500P CLOSE RAW-DATA. IX1124.2 +037600 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1124.2 +037700 CLOSE PRINT-FILE. IX1124.2 +037800 D-TERMINATE-CCVS. IX1124.2 +037900S EXIT PROGRAM. IX1124.2 +038000SD-TERMINATE-CALL. IX1124.2 +038100 STOP RUN. IX1124.2 +038200 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1124.2 +038300 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1124.2 +038400 D-PRINT-DETAIL. IX1124.2 +038500 IF REC-CT NOT EQUAL TO ZERO IX1124.2 +038600 MOVE "." TO PARDOT-X IX1124.2 +038700 MOVE REC-CT TO DOTVALUE. IX1124.2 +038800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. IX1124.2 +038900 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE IX1124.2 +039000 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1124.2 +039100 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1124.2 +039200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1124.2 +039300 MOVE SPACE TO CORRECT-X. IX1124.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1124.2 +039500 MOVE SPACE TO RE-MARK. IX1124.2 +039600 D-END-ROUTINE. IX1124.2 +039700 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1124.2 +039800 PERFORM D-WRITE-LINE 5 TIMES. IX1124.2 +039900 D-END-RTN-EXIT. IX1124.2 +040000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +040100 D-END-ROUTINE-1. IX1124.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1124.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1124.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1124.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1124.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1124.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1124.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1124.2 +040900 D-END-ROUTINE-12. IX1124.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1124.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1124.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1124.2 +041300 ELSE IX1124.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1124.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1124.2 +041600 PERFORM D-WRITE-LINE. IX1124.2 +041700 D-END-ROUTINE-13. IX1124.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1124.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1124.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1124.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1124.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042300 IF INSPECT-COUNTER EQUAL TO ZERO IX1124.2 +042400 MOVE "NO " TO ERROR-TOTAL IX1124.2 +042500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1124.2 +042600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1124.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042900 D-WRITE-LINE. IX1124.2 +043000 ADD 1 TO RECORD-COUNT. IX1124.2 +043100Y IF RECORD-COUNT GREATER 42 IX1124.2 +043200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1124.2 +043300Y MOVE SPACE TO DUMMY-RECORD IX1124.2 +043400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1124.2 +043500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1124.2 +043600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1124.2 +043700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1124.2 +043800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1124.2 +043900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1124.2 +044300Y MOVE ZERO TO RECORD-COUNT. IX1124.2 +044400 PERFORM D-WRT-LN. IX1124.2 +044500 D-WRT-LN. IX1124.2 +044600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1124.2 +044700 MOVE SPACE TO DUMMY-RECORD. IX1124.2 +044800 D-BLANK-LINE-PRINT. IX1124.2 +044900 PERFORM D-WRT-LN. IX1124.2 +045000 D-FAIL-ROUTINE. IX1124.2 +045100 IF COMPUTED-X NOT EQUAL TO SPACE IX1124.2 +045200 GO TO D-FAIL-ROUTINE-WRITE. IX1124.2 +045300 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE. IX1124.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +045500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1124.2 +045600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +045700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +045800 GO TO D-FAIL-ROUTINE-EX. IX1124.2 +045900 D-FAIL-ROUTINE-WRITE. IX1124.2 +046000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1124.2 +046100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1124.2 +046200 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +046300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1124.2 +046400 D-FAIL-ROUTINE-EX. EXIT. IX1124.2 +046500 D-BAIL-OUT. IX1124.2 +046600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1124.2 +046700 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1124.2 +046800 D-BAIL-OUT-WRITE. IX1124.2 +046900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1124.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +047100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +047200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +047300 D-BAIL-OUT-EX. EXIT. IX1124.2 +047400 IX1124.2 +047500 END-DECL. IX1124.2 +047600 END DECLARATIVES. IX1124.2 +047700 IX1124.2 +047800 IX1124.2 +047900 CCVS1 SECTION. IX1124.2 +048000 OPEN-FILES. IX1124.2 +048100P OPEN I-O RAW-DATA. IX1124.2 +048200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +048300P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1124.2 +048400P MOVE "ABORTED " TO C-ABORT. IX1124.2 +048500P ADD 1 TO C-NO-OF-TESTS. IX1124.2 +048600P ACCEPT C-DATE FROM DATE. IX1124.2 +048700P ACCEPT C-TIME FROM TIME. IX1124.2 +048800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1124.2 +048900PEND-E-1. IX1124.2 +049000P CLOSE RAW-DATA. IX1124.2 +049100 OPEN OUTPUT PRINT-FILE. IX1124.2 +049200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1124.2 +049300 MOVE SPACE TO TEST-RESULTS. IX1124.2 +049400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1124.2 +049500 MOVE ZERO TO REC-SKL-SUB. IX1124.2 +049600 PERFORM CCVS-INIT-FILE 9 TIMES. IX1124.2 +049700 CCVS-INIT-FILE. IX1124.2 +049800 ADD 1 TO REC-SKL-SUB. IX1124.2 +049900 MOVE FILE-RECORD-INFO-SKELETON IX1124.2 +050000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1124.2 +050100 CCVS-INIT-EXIT. IX1124.2 +050200 GO TO CCVS1-EXIT. IX1124.2 +050300 CLOSE-FILES. IX1124.2 +050400P OPEN I-O RAW-DATA. IX1124.2 +050500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +050600P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1124.2 +050700P MOVE "OK. " TO C-ABORT. IX1124.2 +050800P MOVE PASS-COUNTER TO C-OK. IX1124.2 +050900P MOVE ERROR-HOLD TO C-ALL. IX1124.2 +051000P MOVE ERROR-COUNTER TO C-FAIL. IX1124.2 +051100P MOVE DELETE-COUNTER TO C-DELETED. IX1124.2 +051200P MOVE INSPECT-COUNTER TO C-INSPECT. IX1124.2 +051300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1124.2 +051400PEND-E-2. IX1124.2 +051500P CLOSE RAW-DATA. IX1124.2 +051600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1124.2 +051700 TERMINATE-CCVS. IX1124.2 +051800S EXIT PROGRAM. IX1124.2 +051900STERMINATE-CALL. IX1124.2 +052000 STOP RUN. IX1124.2 +052100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1124.2 +052200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1124.2 +052300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1124.2 +052400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1124.2 +052500 MOVE "****TEST DELETED****" TO RE-MARK. IX1124.2 +052600 PRINT-DETAIL. IX1124.2 +052700 IF REC-CT NOT EQUAL TO ZERO IX1124.2 +052800 MOVE "." TO PARDOT-X IX1124.2 +052900 MOVE REC-CT TO DOTVALUE. IX1124.2 +053000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1124.2 +053100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1124.2 +053200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1124.2 +053300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1124.2 +053400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1124.2 +053500 MOVE SPACE TO CORRECT-X. IX1124.2 +053600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1124.2 +053700 MOVE SPACE TO RE-MARK. IX1124.2 +053800 HEAD-ROUTINE. IX1124.2 +053900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1124.2 +054200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1124.2 +054300 COLUMN-NAMES-ROUTINE. IX1124.2 +054400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +054500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +054700 END-ROUTINE. IX1124.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1124.2 +054900 END-RTN-EXIT. IX1124.2 +055000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +055100 END-ROUTINE-1. IX1124.2 +055200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1124.2 +055300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1124.2 +055400 ADD PASS-COUNTER TO ERROR-HOLD. IX1124.2 +055500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1124.2 +055600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1124.2 +055700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1124.2 +055800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1124.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1124.2 +056000 END-ROUTINE-12. IX1124.2 +056100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1124.2 +056200 IF ERROR-COUNTER IS EQUAL TO ZERO IX1124.2 +056300 MOVE "NO " TO ERROR-TOTAL IX1124.2 +056400 ELSE IX1124.2 +056500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1124.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1124.2 +056700 PERFORM WRITE-LINE. IX1124.2 +056800 END-ROUTINE-13. IX1124.2 +056900 IF DELETE-COUNTER IS EQUAL TO ZERO IX1124.2 +057000 MOVE "NO " TO ERROR-TOTAL ELSE IX1124.2 +057100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1124.2 +057200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1124.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +057400 IF INSPECT-COUNTER EQUAL TO ZERO IX1124.2 +057500 MOVE "NO " TO ERROR-TOTAL IX1124.2 +057600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1124.2 +057700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1124.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +057900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +058000 WRITE-LINE. IX1124.2 +058100 ADD 1 TO RECORD-COUNT. IX1124.2 +058200Y IF RECORD-COUNT GREATER 42 IX1124.2 +058300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1124.2 +058400Y MOVE SPACE TO DUMMY-RECORD IX1124.2 +058500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1124.2 +058600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1124.2 +058700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1124.2 +058800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1124.2 +058900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1124.2 +059000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1124.2 +059400Y MOVE ZERO TO RECORD-COUNT. IX1124.2 +059500 PERFORM WRT-LN. IX1124.2 +059600 WRT-LN. IX1124.2 +059700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1124.2 +059800 MOVE SPACE TO DUMMY-RECORD. IX1124.2 +059900 BLANK-LINE-PRINT. IX1124.2 +060000 PERFORM WRT-LN. IX1124.2 +060100 FAIL-ROUTINE. IX1124.2 +060200 IF COMPUTED-X NOT EQUAL TO SPACE IX1124.2 +060300 GO TO FAIL-ROUTINE-WRITE. IX1124.2 +060400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1124.2 +060500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1124.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +060800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +060900 GO TO FAIL-ROUTINE-EX. IX1124.2 +061000 FAIL-ROUTINE-WRITE. IX1124.2 +061100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1124.2 +061200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1124.2 +061300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1124.2 +061400 MOVE SPACES TO COR-ANSI-REFERENCE. IX1124.2 +061500 FAIL-ROUTINE-EX. EXIT. IX1124.2 +061600 BAIL-OUT. IX1124.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1124.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1124.2 +061900 BAIL-OUT-WRITE. IX1124.2 +062000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1124.2 +062100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +062300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +062400 BAIL-OUT-EX. EXIT. IX1124.2 +062500 CCVS1-EXIT. IX1124.2 +062600 EXIT. IX1124.2 +062700 IX1124.2 +062800 SECT-IX112A-0003 SECTION. IX1124.2 +062900 SEQ-INIT-010. IX1124.2 +063000 MOVE "IX-VS2" TO XFILE-NAME (1). IX1124.2 +063100 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1124.2 +063200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1124.2 +063300 MOVE 000240 TO XRECORD-LENGTH (1). IX1124.2 +063400 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1124.2 +063500 MOVE 0002 TO XBLOCK-SIZE (1). IX1124.2 +063600 MOVE 000050 TO RECORDS-IN-FILE (1). IX1124.2 +063700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1124.2 +063800 MOVE "S" TO XLABEL-TYPE (1). IX1124.2 +063900 MOVE 000001 TO XRECORD-NUMBER (1). IX1124.2 +064000 MOVE 0 TO COUNT-OF-RECS. IX1124.2 +064100 IX1124.2 +064200******************************************************************IX1124.2 +064300* TEST 1 *IX1124.2 +064400* OPEN OUTPUT ... 00 EXPECTED *IX1124.2 +064500* IX-3, 1.3.4 (1) a *IX1124.2 +064600* STATUS 00 CHECK ON OUTPUT FILE IX-VS2 *IX1124.2 +064700* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1124.2 +064800******************************************************************IX1124.2 +064900 OPN-INIT-GF-01-0. IX1124.2 +065000 ADD 1 TO TEST-NUMBER. IX1124.2 +065100 MOVE 1 TO STATUS-TEST-00. IX1124.2 +065200 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +065300 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1124.2 +065400 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +065500 OPEN IX1124.2 +065600 OUTPUT IX-VS2. IX1124.2 +065700 IF IX-VS2-STATUS EQUAL TO "00" IX1124.2 +065800 GO TO OPN-PASS-GF-01-0. IX1124.2 +065900 OPN-FAIL-GF-01-0. IX1124.2 +066000 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +066100 PERFORM FAIL. IX1124.2 +066200 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +066300 MOVE "00" TO CORRECT-X. IX1124.2 +066400 GO TO OPN-WRITE-GF-01-0. IX1124.2 +066500 OPN-PASS-GF-01-0. IX1124.2 +066600 PERFORM PASS. IX1124.2 +066700 OPN-WRITE-GF-01-0. IX1124.2 +066800 PERFORM PRINT-DETAIL. IX1124.2 +066900******************************************************************IX1124.2 +067000* TEST 2 *IX1124.2 +067100* WRITE 00 EXPECTED *IX1124.2 +067200* IX-3, 1.3.4 (1) a *IX1124.2 +067300* CREATING A INDEXED FILE WITH 50 RECORDS *IX1124.2 +067400* KEY: FROM 000000001 TO 000000050 *IX1124.2 +067500******************************************************************IX1124.2 +067600 WRI-INIT-GF-01-0. IX1124.2 +067700 ADD 1 TO TEST-NUMBER. IX1124.2 +067800 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +067900 MOVE 0 TO STATUS-TEST-00. IX1124.2 +068000 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1124.2 +068100 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +068200 WRI-TEST-GF-01-0. IX1124.2 +068300 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1124.2 +068400 MOVE GRP-0101 TO XRECORD-KEY (1). IX1124.2 +068500 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1124.2 +068600* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1124.2 +068700 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1124.2 +068800 WRITE IX-VS2R1-F-G-240. IX1124.2 +068900 IF IX-VS2-STATUS NOT = "00" IX1124.2 +069000 MOVE 1 TO STATUS-TEST-00 IX1124.2 +069100 GO TO WRI-FAIL-GF-01-0. IX1124.2 +069200 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1124.2 +069300 GO TO WRI-TEST-GF-01-1. IX1124.2 +069400 ADD 1 TO XRECORD-NUMBER (1). IX1124.2 +069500 GO TO WRI-TEST-GF-01-0. IX1124.2 +069600 WRI-TEST-GF-01-1. IX1124.2 +069700 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1124.2 +069800 GO TO WRI-PASS-GF-01-0. IX1124.2 +069900 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1124.2 +070000 WRI-FAIL-GF-01-0. IX1124.2 +070100 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +070200 PERFORM FAIL. IX1124.2 +070300 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1124.2 +070400 GO TO WRI-WRITE-GF-01-0. IX1124.2 +070500 WRI-PASS-GF-01-0. IX1124.2 +070600 PERFORM PASS. IX1124.2 +070700 WRI-WRITE-GF-01-0. IX1124.2 +070800 PERFORM PRINT-DETAIL. IX1124.2 +070900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1124.2 +071000 MOVE "CREATE FILE IX-VS2" TO FEATURE. IX1124.2 +071100 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1124.2 +071200 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1124.2 +071300 PERFORM PRINT-DETAIL. IX1124.2 +071400 IX1124.2 +071500******************************************************************IX1124.2 +071600* TEST 3 *IX1124.2 +071700* WRITE (WRONG SEQUENCE) 21 EXPECTED *IX1124.2 +071800* IX-4, 1.3.4 (3) a *IX1124.2 +071900* KEY: 000000049 *IX1124.2 +072000******************************************************************IX1124.2 +072100 WRI-INIT-GF-02-0. IX1124.2 +072200 ADD 1 TO TEST-NUMBER. IX1124.2 +072300 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +072400 MOVE 0 TO STATUS-TEST-00. IX1124.2 +072500 MOVE "WRITE:WRONG SEQ 21EX" TO FEATURE. IX1124.2 +072600 MOVE "WRI-TEST-GF-02-0" TO PAR-NAME. IX1124.2 +072700 MOVE 49 TO XRECORD-NUMBER (1). IX1124.2 +072800 WRI-TEST-GF-02-0. IX1124.2 +072900 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1124.2 +073000 MOVE GRP-0101 TO XRECORD-KEY (1). IX1124.2 +073100 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1124.2 +073200 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1124.2 +073300 WRITE IX-VS2R1-F-G-240 INVALID KEY GO TO WRI-TEST-GF-02-1. IX1124.2 +073400 WRI-TEST-GF-02-1. IX1124.2 +073500 IF IX-VS2-STATUS = "21" IX1124.2 +073600 GO TO WRI-PASS-GF-02-0. IX1124.2 +073700 WRI-FAIL-GF-02-0. IX1124.2 +073800 MOVE "IX-4, 1.3.4, (3) a. " TO RE-MARK. IX1124.2 +073900 PERFORM FAIL. IX1124.2 +074000 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +074100 MOVE "21" TO CORRECT-X. IX1124.2 +074200 GO TO WRI-WRITE-GF-02-0. IX1124.2 +074300 WRI-PASS-GF-02-0. IX1124.2 +074400 PERFORM PASS. IX1124.2 +074500 WRI-WRITE-GF-02-0. IX1124.2 +074600 PERFORM PRINT-DETAIL. IX1124.2 +074700 IX1124.2 +074800******************************************************************IX1124.2 +074900* TEST 4 *IX1124.2 +075000* CLOSE OUTPUT 00 EXPECTED *IX1124.2 +075100* IX-3, 1.3.4 (1) a *IX1124.2 +075200******************************************************************IX1124.2 +075300 CLO-INIT-GF-01-0. IX1124.2 +075400 ADD 1 TO TEST-NUMBER. IX1124.2 +075500 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +075600 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1124.2 +075700 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +075800 CLO-TEST-GF-01-0. IX1124.2 +075900 CLOSE IX-VS2. IX1124.2 +076000 IF IX-VS2-STATUS = "00" IX1124.2 +076100 GO TO CLO-PASS-GF-01-0. IX1124.2 +076200 CLO-FAIL-GF-01-0. IX1124.2 +076300 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +076400 PERFORM FAIL. IX1124.2 +076500 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +076600 MOVE "00" TO CORRECT-X. IX1124.2 +076700 GO TO CLO-WRITE-GF-01-0. IX1124.2 +076800 CLO-PASS-GF-01-0. IX1124.2 +076900 PERFORM PASS. IX1124.2 +077000 CLO-WRITE-GF-01-0. IX1124.2 +077100 PERFORM PRINT-DETAIL. IX1124.2 +077200 IX1124.2 +077300******************************************************************IX1124.2 +077400* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1124.2 +077500******************************************************************IX1124.2 +077600 IX1124.2 +077700******************************************************************IX1124.2 +077800* TEST 5 *IX1124.2 +077900* OPEN INPUT 00 EXPECTED *IX1124.2 +078000* IX-3, 1.3.4 (1) a *IX1124.2 +078100******************************************************************IX1124.2 +078200 OPN-INIT-GF-02-0. IX1124.2 +078300 ADD 1 TO TEST-NUMBER. IX1124.2 +078400 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +078500 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1124.2 +078600 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1124.2 +078700 OPN-TEST-GF-02-0. IX1124.2 +078800 OPEN IX1124.2 +078900 INPUT IX-VS2. IX1124.2 +079000 IF IX-VS2-STATUS EQUAL TO "00" IX1124.2 +079100 GO TO OPN-PASS-GF-02-0. IX1124.2 +079200 OPN-FAIL-GF-02-0. IX1124.2 +079300 MOVE "IX-3, 1.3.4, (1) a." TO RE-MARK. IX1124.2 +079400 PERFORM FAIL. IX1124.2 +079500 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +079600 MOVE "00" TO CORRECT-X. IX1124.2 +079700 GO TO OPN-WRITE-GF-02-0. IX1124.2 +079800 OPN-PASS-GF-02-0. IX1124.2 +079900 PERFORM PASS. IX1124.2 +080000 OPN-WRITE-GF-02-0. IX1124.2 +080100 PERFORM PRINT-DETAIL. IX1124.2 +080200 IX1124.2 +080300******************************************************************IX1124.2 +080400* TEST 6 *IX1124.2 +080500* READ OO EXPECTED *IX1124.2 +080600* IX-3, 1.3.4 (1) a *IX1124.2 +080700******************************************************************IX1124.2 +080800 REA-INIT-F1-01-0. IX1124.2 +080900 ADD 1 TO TEST-NUMBER. IX1124.2 +081000 MOVE 1 TO STATUS-TEST-10. IX1124.2 +081100 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +081200 MOVE ZERO TO COUNT-OF-RECS. IX1124.2 +081300 MOVE ZERO TO PERM-ERRORS. IX1124.2 +081400 MOVE ZERO TO EOF-FLAG. IX1124.2 +081500 REA-TEST-F1-01-0. IX1124.2 +081600 READ IX-VS2. IX1124.2 +081700 MOVE "REA-TEST-F1-01-0" TO PAR-NAME. IX1124.2 +081800 MOVE "READ (USE): 00 EXP." TO FEATURE. IX1124.2 +081900 IF IX-VS2-STATUS = "00" IX1124.2 +082000 GO TO REA-PASS-F1-01-0. IX1124.2 +082100 REA-FAIL-F1-01-0. IX1124.2 +082200 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +082300 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1124.2 +082400 MOVE "00" TO CORRECT-X. IX1124.2 +082500 PERFORM FAIL. IX1124.2 +082600 GO TO REA-WRITE-F1-01-0. IX1124.2 +082700 REA-PASS-F1-01-0. IX1124.2 +082800 PERFORM PASS. IX1124.2 +082900 REA-WRITE-F1-01-0. IX1124.2 +083000 PERFORM PRINT-DETAIL. IX1124.2 +083100 IX1124.2 +083200******************************************************************IX1124.2 +083300* TEST 7 *IX1124.2 +083400* REWRITE (WITH WRONG RECORD LENGTH (SHORTER)) *IX1124.2 +083500* IX-5, 1.3.4 (5) d 1 & 2 *IX1124.2 +083600* FILE STATUS 00 OR 44 EXPECTED *IX1124.2 +083700* KEY: 000000005 *IX1124.2 +083800******************************************************************IX1124.2 +083900 RWR-INIT-GF-01-0. IX1124.2 +084000 ADD 1 TO TEST-NUMBER. IX1124.2 +084100 CLOSE IX-VS2. IX1124.2 +084200 OPEN I-O IX-VS2. IX1124.2 +084300 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +084400 MOVE 0 TO STATUS-TEST-00. IX1124.2 +084500 MOVE "RWRTE SH. 00/44 EXP." TO FEATURE. IX1124.2 +084600 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +084700 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +084800 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +084900 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085000 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085100 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085200 RWR-TEST-GF-01-0. IX1124.2 +085300 MOVE "WRONG RECORD LENGTH ( SHORTER)" TO IX-VS2-REC-LONG. IX1124.2 +085400 REWRITE IX-VS2R1-F-G-200. IX1124.2 +085500 RWR-TEST-GF-01-1. IX1124.2 +085600 IF IX-VS2-STATUS = "00" IX1124.2 +085700 GO TO RWR-PASS-GF-01-0. IX1124.2 +085800 IF IX-VS2-STATUS = "44" IX1124.2 +085900 GO TO RWR-PASS-GF-01-0. IX1124.2 +086000 RWR-FAIL-GF-01-0. IX1124.2 +086100 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1124.2 +086200 PERFORM FAIL. IX1124.2 +086300 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +086400 MOVE "00 OR 44" TO CORRECT-X. IX1124.2 +086500 GO TO RWR-WRITE-GF-01-0. IX1124.2 +086600 RWR-PASS-GF-01-0. IX1124.2 +086700 PERFORM PASS. IX1124.2 +086800 RWR-WRITE-GF-01-0. IX1124.2 +086900 PERFORM PRINT-DETAIL. IX1124.2 +087000 IX1124.2 +087100 TERMINATE-ROUTINE. IX1124.2 +087200 EXIT. IX1124.2 +087300 IX1124.2 +087400 CCVS-EXIT SECTION. IX1124.2 +087500 CCVS-999999. IX1124.2 +087600 GO TO CLOSE-FILES. IX1124.2 +*END-OF,IX112A +*HEADER,COBOL,IX113A +000100 IDENTIFICATION DIVISION. IX1134.2 +000200 PROGRAM-ID. IX1134.2 +000300 IX113A. IX1134.2 +000400**************************************************************** IX1134.2 +000500* * IX1134.2 +000600* VALIDATION FOR:- * IX1134.2 +000700* * IX1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +000900* * IX1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1134.2 +001100* * IX1134.2 +001200**************************************************************** IX1134.2 +001300* IX1134.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-FS3 IX1134.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1134.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1134.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. IX1134.2 +001800* IX1134.2 +001900* 2. THE ROUTINE READS THE CREATED FILE,VERIFIES IT AND *IX1134.2 +002000* CHECKS THE FILE STATUS CODES: IX1134.2 +002100* 00 - AFTER OPEN OUTPUT IX1134.2 +002200* 00 - AFTER WRITE IX1134.2 +002300* 00 - AFTER CLOSE OUTPUT IX1134.2 +002400* 42 - AFTER CLOSE OUTPUT IX1134.2 +002500* IX1134.2 +002600* 4. X-CARDS USED IN THIS PROGRAM: IX1134.2 +002700* IX1134.2 +002800* XXXXX024 IX1134.2 +002900* XXXXX055. IX1134.2 +003000* P XXXXX062. IX1134.2 +003100* XXXXX082. IX1134.2 +003200* XXXXX083. IX1134.2 +003300* C XXXXX084 IX1134.2 +003400* IX1134.2 +003500* IX1134.2 +003600 ENVIRONMENT DIVISION. IX1134.2 +003700 CONFIGURATION SECTION. IX1134.2 +003800 SOURCE-COMPUTER. IX1134.2 +003900 XXXXX082. IX1134.2 +004000 OBJECT-COMPUTER. IX1134.2 +004100 XXXXX083. IX1134.2 +004200 INPUT-OUTPUT SECTION. IX1134.2 +004300 FILE-CONTROL. IX1134.2 +004400P SELECT RAW-DATA ASSIGN TO IX1134.2 +004500P XXXXX062 IX1134.2 +004600P ORGANIZATION IS INDEXED IX1134.2 +004700P ACCESS MODE IS RANDOM IX1134.2 +004800P RECORD KEY IS RAW-DATA-KEY. IX1134.2 +004900* IX1134.2 +005000 SELECT PRINT-FILE ASSIGN TO IX1134.2 +005100 XXXXX055. IX1134.2 +005200* IX1134.2 +005300 SELECT IX-FS3 ASSIGN IX1134.2 +005400 XXXXX024 IX1134.2 +005500 ORGANIZATION IS INDEXED IX1134.2 +005600 ACCESS MODE IS SEQUENTIAL IX1134.2 +005700 RECORD KEY IS IX-FS3-KEY IX1134.2 +005800 FILE STATUS IS IX-FS3-STATUS. IX1134.2 +005900 IX1134.2 +006000 DATA DIVISION. IX1134.2 +006100 IX1134.2 +006200 FILE SECTION. IX1134.2 +006300P IX1134.2 +006400PFD RAW-DATA. IX1134.2 +006500P IX1134.2 +006600P01 RAW-DATA-SATZ. IX1134.2 +006700P 05 RAW-DATA-KEY PIC X(6). IX1134.2 +006800P 05 C-DATE PIC 9(6). IX1134.2 +006900P 05 C-TIME PIC 9(8). IX1134.2 +007000P 05 C-NO-OF-TESTS PIC 99. IX1134.2 +007100P 05 C-OK PIC 999. IX1134.2 +007200P 05 C-ALL PIC 999. IX1134.2 +007300P 05 C-FAIL PIC 999. IX1134.2 +007400P 05 C-DELETED PIC 999. IX1134.2 +007500P 05 C-INSPECT PIC 999. IX1134.2 +007600P 05 C-NOTE PIC X(13). IX1134.2 +007700P 05 C-INDENT PIC X. IX1134.2 +007800P 05 C-ABORT PIC X(8). IX1134.2 +007900 IX1134.2 +008000 FD PRINT-FILE. IX1134.2 +008100 IX1134.2 +008200 01 PRINT-REC PIC X(120). IX1134.2 +008300 IX1134.2 +008400 01 DUMMY-RECORD PIC X(120). IX1134.2 +008500 IX1134.2 +008600 FD IX-FS3 IX1134.2 +008700C DATA RECORDS IX-FS3R1-F-G-240 IX1134.2 +008800C LABEL RECORD STANDARD IX1134.2 +008900 RECORD 240 IX1134.2 +009000 BLOCK CONTAINS 2 RECORDS. IX1134.2 +009100 IX1134.2 +009200 01 IX-FS3R1-F-G-240. IX1134.2 +009300 05 IX-FS3-REC-120 PIC X(120). IX1134.2 +009400 05 IX-FS3-REC-120-240. IX1134.2 +009500 10 FILLER PIC X(8). IX1134.2 +009600 10 IX-FS3-KEY PIC X(29). IX1134.2 +009700 10 FILLER PIC X(9). IX1134.2 +009800 10 IX-FS3-ALTER-KEY PIC X(29). IX1134.2 +009900 10 FILLER PIC X(45). IX1134.2 +010000 IX1134.2 +010100 IX1134.2 +010200 WORKING-STORAGE SECTION. IX1134.2 +010300 IX1134.2 +010400 01 GRP-0101. IX1134.2 +010500 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1134.2 +010600 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1134.2 +010700 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1134.2 +010800 IX1134.2 +010900 01 GRP-0102. IX1134.2 +011000 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1134.2 +011100 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1134.2 +011200 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1134.2 +011300 IX1134.2 +011400 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1134.2 +011500 IX1134.2 +011600 01 EOF-FLAG PIC 9 VALUE ZERO. IX1134.2 +011700 IX1134.2 +011800 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1134.2 +011900 IX1134.2 +012000 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1134.2 +012100 IX1134.2 +012200 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1134.2 +012300 IX1134.2 +012400 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1134.2 +012500 IX1134.2 +012600 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1134.2 +012700 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1134.2 +012800 IX1134.2 +012900 01 IX-FS3-STATUS. IX1134.2 +013000 05 IX-FS3-STAT1 PIC X. IX1134.2 +013100 05 IX-FS3-STAT2 PIC X. IX1134.2 +013200 IX1134.2 +013300 01 COUNT-OF-RECS PIC 9(5). IX1134.2 +013400 IX1134.2 +013500 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1134.2 +013600 IX1134.2 +013700 01 FILE-RECORD-INFORMATION-REC. IX1134.2 +013800 05 FILE-RECORD-INFO-SKELETON. IX1134.2 +013900 10 FILLER PIC X(48) VALUE IX1134.2 +014000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1134.2 +014100 10 FILLER PIC X(46) VALUE IX1134.2 +014200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1134.2 +014300 10 FILLER PIC X(26) VALUE IX1134.2 +014400 ",LFIL=000000,ORG= ,LBLR= ". IX1134.2 +014500 10 FILLER PIC X(37) VALUE IX1134.2 +014600 ",RECKEY= ". IX1134.2 +014700 10 FILLER PIC X(38) VALUE IX1134.2 +014800 ",ALTKEY1= ". IX1134.2 +014900 10 FILLER PIC X(38) VALUE IX1134.2 +015000 ",ALTKEY2= ". IX1134.2 +015100 10 FILLER PIC X(7) VALUE SPACE. IX1134.2 +015200 05 FILE-RECORD-INFO OCCURS 10. IX1134.2 +015300 10 FILE-RECORD-INFO-P1-120. IX1134.2 +015400 15 FILLER PIC X(5). IX1134.2 +015500 15 XFILE-NAME PIC X(6). IX1134.2 +015600 15 FILLER PIC X(8). IX1134.2 +015700 15 XRECORD-NAME PIC X(6). IX1134.2 +015800 15 FILLER PIC X(1). IX1134.2 +015900 15 REELUNIT-NUMBER PIC 9(1). IX1134.2 +016000 15 FILLER PIC X(7). IX1134.2 +016100 15 XRECORD-NUMBER PIC 9(6). IX1134.2 +016200 15 FILLER PIC X(6). IX1134.2 +016300 15 UPDATE-NUMBER PIC 9(2). IX1134.2 +016400 15 FILLER PIC X(5). IX1134.2 +016500 15 ODO-NUMBER PIC 9(4). IX1134.2 +016600 15 FILLER PIC X(5). IX1134.2 +016700 15 XPROGRAM-NAME PIC X(5). IX1134.2 +016800 15 FILLER PIC X(7). IX1134.2 +016900 15 XRECORD-LENGTH PIC 9(6). IX1134.2 +017000 15 FILLER PIC X(7). IX1134.2 +017100 15 CHARS-OR-RECORDS PIC X(2). IX1134.2 +017200 15 FILLER PIC X(1). IX1134.2 +017300 15 XBLOCK-SIZE PIC 9(4). IX1134.2 +017400 15 FILLER PIC X(6). IX1134.2 +017500 15 RECORDS-IN-FILE PIC 9(6). IX1134.2 +017600 15 FILLER PIC X(5). IX1134.2 +017700 15 XFILE-ORGANIZATION PIC X(2). IX1134.2 +017800 15 FILLER PIC X(6). IX1134.2 +017900 15 XLABEL-TYPE PIC X(1). IX1134.2 +018000 10 FILE-RECORD-INFO-P121-240. IX1134.2 +018100 15 FILLER PIC X(8). IX1134.2 +018200 15 XRECORD-KEY PIC X(29). IX1134.2 +018300 15 FILLER PIC X(9). IX1134.2 +018400 15 ALTERNATE-KEY1 PIC X(29). IX1134.2 +018500 15 FILLER PIC X(9). IX1134.2 +018600 15 ALTERNATE-KEY2 PIC X(29). IX1134.2 +018700 15 FILLER PIC X(7). IX1134.2 +018800 IX1134.2 +018900 01 TEST-RESULTS. IX1134.2 +019000 02 FILLER PIC X VALUE SPACE. IX1134.2 +019100 02 FEATURE PIC X(20) VALUE SPACE. IX1134.2 +019200 02 FILLER PIC X VALUE SPACE. IX1134.2 +019300 02 P-OR-F PIC X(5) VALUE SPACE. IX1134.2 +019400 02 FILLER PIC X VALUE SPACE. IX1134.2 +019500 02 PAR-NAME. IX1134.2 +019600 03 FILLER PIC X(19) VALUE SPACE. IX1134.2 +019700 03 PARDOT-X PIC X VALUE SPACE. IX1134.2 +019800 03 DOTVALUE PIC 99 VALUE ZERO. IX1134.2 +019900 02 FILLER PIC X(8) VALUE SPACE. IX1134.2 +020000 02 RE-MARK PIC X(61). IX1134.2 +020100 01 TEST-COMPUTED. IX1134.2 +020200 02 FILLER PIC X(30) VALUE SPACE. IX1134.2 +020300 02 FILLER PIC X(17) VALUE IX1134.2 +020400 " COMPUTED=". IX1134.2 +020500 02 COMPUTED-X. IX1134.2 +020600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1134.2 +020700 03 COMPUTED-N REDEFINES COMPUTED-A IX1134.2 +020800 PIC -9(9).9(9). IX1134.2 +020900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1134.2 +021000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1134.2 +021100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1134.2 +021200 03 CM-18V0 REDEFINES COMPUTED-A. IX1134.2 +021300 04 COMPUTED-18V0 PIC -9(18). IX1134.2 +021400 04 FILLER PIC X. IX1134.2 +021500 03 FILLER PIC X(50) VALUE SPACE. IX1134.2 +021600 01 TEST-CORRECT. IX1134.2 +021700 02 FILLER PIC X(30) VALUE SPACE. IX1134.2 +021800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1134.2 +021900 02 CORRECT-X. IX1134.2 +022000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1134.2 +022100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1134.2 +022200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1134.2 +022300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1134.2 +022400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1134.2 +022500 03 CR-18V0 REDEFINES CORRECT-A. IX1134.2 +022600 04 CORRECT-18V0 PIC -9(18). IX1134.2 +022700 04 FILLER PIC X. IX1134.2 +022800 03 FILLER PIC X(2) VALUE SPACE. IX1134.2 +022900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1134.2 +023000 01 CCVS-C-1. IX1134.2 +023100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1134.2 +023200- "SS PARAGRAPH-NAME IX1134.2 +023300- " REMARKS". IX1134.2 +023400 02 FILLER PIC X(20) VALUE SPACE. IX1134.2 +023500 01 CCVS-C-2. IX1134.2 +023600 02 FILLER PIC X VALUE SPACE. IX1134.2 +023700 02 FILLER PIC X(6) VALUE "TESTED". IX1134.2 +023800 02 FILLER PIC X(15) VALUE SPACE. IX1134.2 +023900 02 FILLER PIC X(4) VALUE "FAIL". IX1134.2 +024000 02 FILLER PIC X(94) VALUE SPACE. IX1134.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1134.2 +024200 01 REC-CT PIC 99 VALUE ZERO. IX1134.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1134.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1134.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1134.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1134.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1134.2 +025200 01 CCVS-H-1. IX1134.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1134.2 +025400 02 FILLER PIC X(42) VALUE IX1134.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1134.2 +025600 02 FILLER PIC X(39) VALUE SPACES. IX1134.2 +025700 01 CCVS-H-2A. IX1134.2 +025800 02 FILLER PIC X(40) VALUE SPACE. IX1134.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1134.2 +026000 02 FILLER PIC XXXX VALUE IX1134.2 +026100 "4.2 ". IX1134.2 +026200 02 FILLER PIC X(28) VALUE IX1134.2 +026300 " COPY - NOT FOR DISTRIBUTION". IX1134.2 +026400 02 FILLER PIC X(41) VALUE SPACE. IX1134.2 +026500 IX1134.2 +026600 01 CCVS-H-2B. IX1134.2 +026700 02 FILLER PIC X(15) VALUE IX1134.2 +026800 "TEST RESULT OF ". IX1134.2 +026900 02 TEST-ID PIC X(9). IX1134.2 +027000 02 FILLER PIC X(4) VALUE IX1134.2 +027100 " IN ". IX1134.2 +027200 02 FILLER PIC X(12) VALUE IX1134.2 +027300 " HIGH ". IX1134.2 +027400 02 FILLER PIC X(22) VALUE IX1134.2 +027500 " LEVEL VALIDATION FOR ". IX1134.2 +027600 02 FILLER PIC X(58) VALUE IX1134.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +027800 01 CCVS-H-3. IX1134.2 +027900 02 FILLER PIC X(34) VALUE IX1134.2 +028000 " FOR OFFICIAL USE ONLY ". IX1134.2 +028100 02 FILLER PIC X(58) VALUE IX1134.2 +028200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1134.2 +028300 02 FILLER PIC X(28) VALUE IX1134.2 +028400 " COPYRIGHT 1985 ". IX1134.2 +028500 01 CCVS-E-1. IX1134.2 +028600 02 FILLER PIC X(52) VALUE SPACE. IX1134.2 +028700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1134.2 +028800 02 ID-AGAIN PIC X(9). IX1134.2 +028900 02 FILLER PIC X(45) VALUE SPACES. IX1134.2 +029000 01 CCVS-E-2. IX1134.2 +029100 02 FILLER PIC X(31) VALUE SPACE. IX1134.2 +029200 02 FILLER PIC X(21) VALUE SPACE. IX1134.2 +029300 02 CCVS-E-2-2. IX1134.2 +029400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1134.2 +029500 03 FILLER PIC X VALUE SPACE. IX1134.2 +029600 03 ENDER-DESC PIC X(44) VALUE IX1134.2 +029700 "ERRORS ENCOUNTERED". IX1134.2 +029800 01 CCVS-E-3. IX1134.2 +029900 02 FILLER PIC X(22) VALUE IX1134.2 +030000 " FOR OFFICIAL USE ONLY". IX1134.2 +030100 02 FILLER PIC X(12) VALUE SPACE. IX1134.2 +030200 02 FILLER PIC X(58) VALUE IX1134.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +030400 02 FILLER PIC X(13) VALUE SPACE. IX1134.2 +030500 02 FILLER PIC X(15) VALUE IX1134.2 +030600 " COPYRIGHT 1985". IX1134.2 +030700 01 CCVS-E-4. IX1134.2 +030800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1134.2 +030900 02 FILLER PIC X(4) VALUE " OF ". IX1134.2 +031000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1134.2 +031100 02 FILLER PIC X(40) VALUE IX1134.2 +031200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1134.2 +031300 01 XXINFO. IX1134.2 +031400 02 FILLER PIC X(19) VALUE IX1134.2 +031500 "*** INFORMATION ***". IX1134.2 +031600 02 INFO-TEXT. IX1134.2 +031700 04 FILLER PIC X(8) VALUE SPACE. IX1134.2 +031800 04 XXCOMPUTED PIC X(20). IX1134.2 +031900 04 FILLER PIC X(5) VALUE SPACE. IX1134.2 +032000 04 XXCORRECT PIC X(20). IX1134.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). IX1134.2 +032200 01 HYPHEN-LINE. IX1134.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. IX1134.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************IX1134.2 +032500- "*****************************************". IX1134.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************IX1134.2 +032700- "******************************". IX1134.2 +032800 01 TEST-NO PIC 99. IX1134.2 +032900 01 CCVS-PGM-ID PIC X(9) VALUE IX1134.2 +033000 "IX113A". IX1134.2 +033100 PROCEDURE DIVISION. IX1134.2 +033200 DECLARATIVES. IX1134.2 +033300 IX1134.2 +033400 SECT-IX105-0002 SECTION. IX1134.2 +033500 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1134.2 +033600 INPUT-PROCESS. IX1134.2 +033700 IF TEST-NO = 5 IX1134.2 +033800 GO TO D-C-TEST-GF-02-1. IX1134.2 +033900 IF STATUS-TEST-10 EQUAL TO 1 IX1134.2 +034000 IF IX-FS3-STAT1 EQUAL TO "1" IX1134.2 +034100 MOVE 1 TO EOF-FLAG IX1134.2 +034200 ELSE IX1134.2 +034300 IF IX-FS3-STAT1 GREATER THAN "1" IX1134.2 +034400 MOVE 1 TO PERM-ERRORS. IX1134.2 +034500 GO TO DECL-EXIT. IX1134.2 +034600 D-C-TEST-GF-02-1. IX1134.2 +034700 IF IX-FS3-STATUS EQUAL TO "42" IX1134.2 +034800 GO TO D-C-PASS-GF-02-0. IX1134.2 +034900 D-C-FAIL-GF-02-0. IX1134.2 +035000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +035100 MOVE "42" TO CORRECT-X. IX1134.2 +035200 MOVE "IX-5, 1.3.4, (5) B" TO RE-MARK. IX1134.2 +035300 PERFORM D-FAIL. IX1134.2 +035400 GO TO D-C-WRITE-GF-02-0. IX1134.2 +035500 D-C-PASS-GF-02-0. IX1134.2 +035600 PERFORM D-PASS. IX1134.2 +035700 D-C-WRITE-GF-02-0. IX1134.2 +035800 PERFORM D-PRINT-DETAIL. IX1134.2 +035900 D-CLOSE-FILES. IX1134.2 +036000P OPEN I-O RAW-DATA. IX1134.2 +036100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +036200P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1134.2 +036300P MOVE "OK. " TO C-ABORT. IX1134.2 +036400P MOVE PASS-COUNTER TO C-OK. IX1134.2 +036500P MOVE ERROR-HOLD TO C-ALL. IX1134.2 +036600P MOVE ERROR-COUNTER TO C-FAIL. IX1134.2 +036700P MOVE DELETE-COUNTER TO C-DELETED. IX1134.2 +036800P MOVE INSPECT-COUNTER TO C-INSPECT. IX1134.2 +036900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1134.2 +037000PD-END-E-2. IX1134.2 +037100P CLOSE RAW-DATA. IX1134.2 +037200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1134.2 +037300 CLOSE PRINT-FILE. IX1134.2 +037400 D-TERMINATE-CCVS. IX1134.2 +037500S EXIT PROGRAM. IX1134.2 +037600SD-TERMINATE-CALL. IX1134.2 +037700 STOP RUN. IX1134.2 +037800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1134.2 +037900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1134.2 +038000 D-PRINT-DETAIL. IX1134.2 +038100 IF REC-CT NOT EQUAL TO ZERO IX1134.2 +038200 MOVE "." TO PARDOT-X IX1134.2 +038300 MOVE REC-CT TO DOTVALUE. IX1134.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. IX1134.2 +038500 PERFORM D-WRITE-LINE. IX1134.2 +038600 IF P-OR-F EQUAL TO "FAIL*" IX1134.2 +038700 PERFORM D-WRITE-LINE IX1134.2 +038800 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1134.2 +038900 ELSE IX1134.2 +039000 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1134.2 +039100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1134.2 +039200 MOVE SPACE TO CORRECT-X. IX1134.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1134.2 +039400 MOVE SPACE TO RE-MARK. IX1134.2 +039500 D-END-ROUTINE. IX1134.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1134.2 +039700 PERFORM D-WRITE-LINE 5 TIMES. IX1134.2 +039800 D-END-RTN-EXIT. IX1134.2 +039900 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1134.2 +040000 PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +040100 D-END-ROUTINE-1. IX1134.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1134.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1134.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1134.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1134.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1134.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1134.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1134.2 +040900 D-END-ROUTINE-12. IX1134.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1134.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1134.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1134.2 +041300 ELSE IX1134.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1134.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +041600 PERFORM D-WRITE-LINE. IX1134.2 +041700 D-END-ROUTINE-13. IX1134.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1134.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1134.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1134.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1134.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +042300 PERFORM D-WRITE-LINE. IX1134.2 +042400 IF INSPECT-COUNTER EQUAL TO ZERO IX1134.2 +042500 MOVE "NO " TO ERROR-TOTAL IX1134.2 +042600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1134.2 +042700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1134.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1134.2 +042900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1134.2 +043000 D-WRITE-LINE. IX1134.2 +043100 ADD 1 TO RECORD-COUNT. IX1134.2 +043200Y IF RECORD-COUNT GREATER 42 IX1134.2 +043300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1134.2 +043400Y MOVE SPACE TO DUMMY-RECORD IX1134.2 +043500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1134.2 +043600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1134.2 +043700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1134.2 +043800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1134.2 +043900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1134.2 +044000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1134.2 +044400Y MOVE ZERO TO RECORD-COUNT. IX1134.2 +044500 PERFORM D-WRT-LN. IX1134.2 +044600 D-WRT-LN. IX1134.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1134.2 +044800 MOVE SPACE TO DUMMY-RECORD. IX1134.2 +044900 D-FAIL-ROUTINE. IX1134.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1134.2 +045100 GO TO D-FAIL-ROUTINE-WRITE. IX1134.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1134.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1134.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +045700 GO TO D-FAIL-ROUTINE-EX. IX1134.2 +045800 D-FAIL-ROUTINE-WRITE. IX1134.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1134.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1134.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1134.2 +046300 D-FAIL-ROUTINE-EX. EXIT. IX1134.2 +046400 D-BAIL-OUT. IX1134.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1134.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1134.2 +046700 D-BAIL-OUT-WRITE. IX1134.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1134.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +047200 D-BAIL-OUT-EX. EXIT. IX1134.2 +047300 DECL-EXIT. EXIT. IX1134.2 +047400 END DECLARATIVES. IX1134.2 +047500 IX1134.2 +047600 IX1134.2 +047700 CCVS1 SECTION. IX1134.2 +047800 OPEN-FILES. IX1134.2 +047900P OPEN I-O RAW-DATA. IX1134.2 +048000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +048100P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1134.2 +048200P MOVE "ABORTED " TO C-ABORT. IX1134.2 +048300P ADD 1 TO C-NO-OF-TESTS. IX1134.2 +048400P ACCEPT C-DATE FROM DATE. IX1134.2 +048500P ACCEPT C-TIME FROM TIME. IX1134.2 +048600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1134.2 +048700PEND-E-1. IX1134.2 +048800P CLOSE RAW-DATA. IX1134.2 +048900 OPEN OUTPUT PRINT-FILE. IX1134.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1134.2 +049100 MOVE SPACE TO TEST-RESULTS. IX1134.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1134.2 +049300 MOVE ZERO TO REC-SKL-SUB. IX1134.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1134.2 +049500 CCVS-INIT-FILE. IX1134.2 +049600 ADD 1 TO REC-SKL-SUB. IX1134.2 +049700 MOVE FILE-RECORD-INFO-SKELETON IX1134.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1134.2 +049900 CCVS-INIT-EXIT. IX1134.2 +050000 GO TO CCVS1-EXIT. IX1134.2 +050100 CLOSE-FILES. IX1134.2 +050200P OPEN I-O RAW-DATA. IX1134.2 +050300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +050400P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1134.2 +050500P MOVE "OK. " TO C-ABORT. IX1134.2 +050600P MOVE PASS-COUNTER TO C-OK. IX1134.2 +050700P MOVE ERROR-HOLD TO C-ALL. IX1134.2 +050800P MOVE ERROR-COUNTER TO C-FAIL. IX1134.2 +050900P MOVE DELETE-COUNTER TO C-DELETED. IX1134.2 +051000P MOVE INSPECT-COUNTER TO C-INSPECT. IX1134.2 +051100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1134.2 +051200PEND-E-2. IX1134.2 +051300P CLOSE RAW-DATA. IX1134.2 +051400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1134.2 +051500 TERMINATE-CCVS. IX1134.2 +051600S EXIT PROGRAM. IX1134.2 +051700STERMINATE-CALL. IX1134.2 +051800 STOP RUN. IX1134.2 +051900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1134.2 +052000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1134.2 +052100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1134.2 +052200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1134.2 +052300 MOVE "****TEST DELETED****" TO RE-MARK. IX1134.2 +052400 PRINT-DETAIL. IX1134.2 +052500 IF REC-CT NOT EQUAL TO ZERO IX1134.2 +052600 MOVE "." TO PARDOT-X IX1134.2 +052700 MOVE REC-CT TO DOTVALUE. IX1134.2 +052800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1134.2 +052900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1134.2 +053000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1134.2 +053100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1134.2 +053200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1134.2 +053300 MOVE SPACE TO CORRECT-X. IX1134.2 +053400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1134.2 +053500 MOVE SPACE TO RE-MARK. IX1134.2 +053600 HEAD-ROUTINE. IX1134.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1134.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1134.2 +054100 COLUMN-NAMES-ROUTINE. IX1134.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +054500 END-ROUTINE. IX1134.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1134.2 +054700 END-RTN-EXIT. IX1134.2 +054800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +054900 END-ROUTINE-1. IX1134.2 +055000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1134.2 +055100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1134.2 +055200 ADD PASS-COUNTER TO ERROR-HOLD. IX1134.2 +055300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1134.2 +055400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1134.2 +055500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1134.2 +055600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1134.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1134.2 +055800 END-ROUTINE-12. IX1134.2 +055900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1134.2 +056000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1134.2 +056100 MOVE "NO " TO ERROR-TOTAL IX1134.2 +056200 ELSE IX1134.2 +056300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1134.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +056500 PERFORM WRITE-LINE. IX1134.2 +056600 END-ROUTINE-13. IX1134.2 +056700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1134.2 +056800 MOVE "NO " TO ERROR-TOTAL ELSE IX1134.2 +056900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1134.2 +057000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1134.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO IX1134.2 +057300 MOVE "NO " TO ERROR-TOTAL IX1134.2 +057400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1134.2 +057500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1134.2 +057600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057800 WRITE-LINE. IX1134.2 +057900 ADD 1 TO RECORD-COUNT. IX1134.2 +058000Y IF RECORD-COUNT GREATER 42 IX1134.2 +058100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1134.2 +058200Y MOVE SPACE TO DUMMY-RECORD IX1134.2 +058300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1134.2 +058400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1134.2 +058500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1134.2 +058600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1134.2 +058700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1134.2 +058800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +058900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +059000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +059100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1134.2 +059200Y MOVE ZERO TO RECORD-COUNT. IX1134.2 +059300 PERFORM WRT-LN. IX1134.2 +059400 WRT-LN. IX1134.2 +059500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1134.2 +059600 MOVE SPACE TO DUMMY-RECORD. IX1134.2 +059700 BLANK-LINE-PRINT. IX1134.2 +059800 PERFORM WRT-LN. IX1134.2 +059900 FAIL-ROUTINE. IX1134.2 +060000 IF COMPUTED-X NOT EQUAL TO SPACE IX1134.2 +060100 GO TO FAIL-ROUTINE-WRITE. IX1134.2 +060200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1134.2 +060300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +060400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1134.2 +060500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +060600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +060700 GO TO FAIL-ROUTINE-EX. IX1134.2 +060800 FAIL-ROUTINE-WRITE. IX1134.2 +060900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1134.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1134.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1134.2 +061200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1134.2 +061300 FAIL-ROUTINE-EX. EXIT. IX1134.2 +061400 BAIL-OUT. IX1134.2 +061500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1134.2 +061600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1134.2 +061700 BAIL-OUT-WRITE. IX1134.2 +061800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1134.2 +061900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +062000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +062100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +062200 BAIL-OUT-EX. EXIT. IX1134.2 +062300 CCVS1-EXIT. IX1134.2 +062400 EXIT. IX1134.2 +062500 IX1134.2 +062600 SECT-IX113A-0003 SECTION. IX1134.2 +062700 SEQ-INIT-010. IX1134.2 +062800 MOVE ZERO TO TEST-NO. IX1134.2 +062900 MOVE "IX-FS3" TO XFILE-NAME (1). IX1134.2 +063000 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1134.2 +063100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1134.2 +063200 MOVE 000240 TO XRECORD-LENGTH (1). IX1134.2 +063300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1134.2 +063400 MOVE 0002 TO XBLOCK-SIZE (1). IX1134.2 +063500 MOVE 000050 TO RECORDS-IN-FILE (1). IX1134.2 +063600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1134.2 +063700 MOVE "S" TO XLABEL-TYPE (1). IX1134.2 +063800 MOVE 000001 TO XRECORD-NUMBER (1). IX1134.2 +063900 MOVE 0 TO COUNT-OF-RECS. IX1134.2 +064000 IX1134.2 +064100******************************************************************IX1134.2 +064200* TEST 1 *IX1134.2 +064300* OPEN OUTPUT ... 00 EXPECTED *IX1134.2 +064400* IX-3, 1.3.4 (1) A *IX1134.2 +064500* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1134.2 +064600* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1134.2 +064700******************************************************************IX1134.2 +064800 OPN-INIT-GF-01-0. IX1134.2 +064900 MOVE 1 TO STATUS-TEST-00. IX1134.2 +065000 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +065100 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1134.2 +065200 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +065300 OPEN IX1134.2 +065400 OUTPUT IX-FS3. IX1134.2 +065500 IF IX-FS3-STATUS EQUAL TO "00" IX1134.2 +065600 GO TO OPN-PASS-GF-01-0. IX1134.2 +065700 OPN-FAIL-GF-01-0. IX1134.2 +065800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +065900 PERFORM FAIL. IX1134.2 +066000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +066100 MOVE "00" TO CORRECT-X. IX1134.2 +066200 GO TO OPN-WRITE-GF-01-0. IX1134.2 +066300 OPN-PASS-GF-01-0. IX1134.2 +066400 PERFORM PASS. IX1134.2 +066500 OPN-WRITE-GF-01-0. IX1134.2 +066600 PERFORM PRINT-DETAIL. IX1134.2 +066700******************************************************************IX1134.2 +066800* TEST 2 *IX1134.2 +066900* WRITE 00 EXPECTED *IX1134.2 +067000* IX-3, 1.3.4 (1) A *IX1134.2 +067100* CREATING A INDEXED FILE WITH 50 RECORDS *IX1134.2 +067200* KEY: FROM 000000001 TO 000000050 *IX1134.2 +067300******************************************************************IX1134.2 +067400 WRI-INIT-GF-01-0. IX1134.2 +067500 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +067600 MOVE 0 TO STATUS-TEST-00. IX1134.2 +067700 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1134.2 +067800 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +067900 WRI-TEST-GF-01-0. IX1134.2 +068000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1134.2 +068100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1134.2 +068200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1134.2 +068300* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1134.2 +068400 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1134.2 +068500 WRITE IX-FS3R1-F-G-240. IX1134.2 +068600 IF IX-FS3-STATUS NOT = "00" IX1134.2 +068700 MOVE 1 TO STATUS-TEST-00 IX1134.2 +068800 GO TO WRI-FAIL-GF-01-0. IX1134.2 +068900 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1134.2 +069000 GO TO WRI-TEST-GF-01-1. IX1134.2 +069100 ADD 1 TO XRECORD-NUMBER (1). IX1134.2 +069200 GO TO WRI-TEST-GF-01-0. IX1134.2 +069300 WRI-TEST-GF-01-1. IX1134.2 +069400 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1134.2 +069500 GO TO WRI-PASS-GF-01-0. IX1134.2 +069600 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1134.2 +069700 WRI-FAIL-GF-01-0. IX1134.2 +069800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +069900 PERFORM FAIL. IX1134.2 +070000 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1134.2 +070100 GO TO WRI-WRITE-GF-01-0. IX1134.2 +070200 WRI-PASS-GF-01-0. IX1134.2 +070300 PERFORM PASS. IX1134.2 +070400 WRI-WRITE-GF-01-0. IX1134.2 +070500 PERFORM PRINT-DETAIL. IX1134.2 +070600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1134.2 +070700 MOVE "CREATE FILE IX-FS3" TO FEATURE. IX1134.2 +070800 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1134.2 +070900 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1134.2 +071000 PERFORM PRINT-DETAIL. IX1134.2 +071100 IX1134.2 +071200******************************************************************IX1134.2 +071300* TEST 4 *IX1134.2 +071400* CLOSE OUTPUT 00 EXPECTED *IX1134.2 +071500* IX-3, 1.3.4 (1) A *IX1134.2 +071600******************************************************************IX1134.2 +071700 CLO-INIT-GF-01-0. IX1134.2 +071800 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +071900 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1134.2 +072000 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +072100 CLO-TEST-GF-01-0. IX1134.2 +072200 CLOSE IX-FS3. IX1134.2 +072300 IF IX-FS3-STATUS = "00" IX1134.2 +072400 GO TO CLO-PASS-GF-01-0. IX1134.2 +072500 CLO-FAIL-GF-01-0. IX1134.2 +072600 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +072700 PERFORM FAIL. IX1134.2 +072800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +072900 MOVE "00" TO CORRECT-X. IX1134.2 +073000 GO TO CLO-WRITE-GF-01-0. IX1134.2 +073100 CLO-PASS-GF-01-0. IX1134.2 +073200 PERFORM PASS. IX1134.2 +073300 CLO-WRITE-GF-01-0. IX1134.2 +073400 PERFORM PRINT-DETAIL. IX1134.2 +073500 IX1134.2 +073600******************************************************************IX1134.2 +073700* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1134.2 +073800******************************************************************IX1134.2 +073900 IX1134.2 +074000******************************************************************IX1134.2 +074100* TEST 5 *IX1134.2 +074200* CLOSE FOR A FILE NOT IN THE OPEN MODE *IX1134.2 +074300* FILE STATUS 42 EXPECTED IX-5, 1.3.4 (5) B *IX1134.2 +074400******************************************************************IX1134.2 +074500 CLO-TEST-GF-02-0. IX1134.2 +074600 MOVE 5 TO TEST-NO. IX1134.2 +074700 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +074800 MOVE "CLOSE-INPUT: 42 EXP." TO FEATURE IX1134.2 +074900 MOVE "CLO-TEST-GF-02-0" TO PAR-NAME. IX1134.2 +075000 CLOSE IX-FS3. IX1134.2 +075100 CLO-TEST-GF-02-1. IX1134.2 +075200 IF IX-FS3-STATUS EQUAL TO "42" IX1134.2 +075300 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1134.2 +075400 TO RE-MARK IX1134.2 +075500 GO TO CLO-WRITE-GF-02-0. IX1134.2 +075600 CLO-FAIL-GF-02-0. IX1134.2 +075700 MOVE "IX-5, 1.3.4, (5) B" TO RE-MARK. IX1134.2 +075800 CLO-WRITE-GF-02-0. IX1134.2 +075900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +076000 MOVE "42" TO CORRECT-X. IX1134.2 +076100 PERFORM FAIL. IX1134.2 +076200 PERFORM PRINT-DETAIL. IX1134.2 +076300 IX1134.2 +076400 TERMINATE-ROUTINE. IX1134.2 +076500 EXIT. IX1134.2 +076600 IX1134.2 +076700 CCVS-EXIT SECTION. IX1134.2 +076800 CCVS-999999. IX1134.2 +076900 GO TO CLOSE-FILES. IX1134.2 +*END-OF,IX113A +*HEADER,COBOL,IX113A,SUBPRG,IX114A +000100 IDENTIFICATION DIVISION. IX1144.2 +000200 PROGRAM-ID. IX1144.2 +000300 IX114A. IX1144.2 +000400**************************************************************** IX1144.2 +000500* * IX1144.2 +000600* VALIDATION FOR:- * IX1144.2 +000700* * IX1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +000900* * IX1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1144.2 +001100* * IX1144.2 +001200**************************************************************** IX1144.2 +001300* IX1144.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1144.2 +001500* IX113A. IX1144.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED) IX1144.2 +001700* THEN CLOSED AND THE STATUS CHECKED (00 EXPECTED). AN IX1144.2 +001800* ATTEMPT IS THEN MADE TO READ A RECORD AT WHICH POINT THE IX1144.2 +001900* DECLARATIVES SHOULD BE ACTIONED AND THE STATUS SHOULD BE *IX1144.2 +002000* 47 (IX-5, 1.3.4 (5) F). IX1144.2 +002100* IX1144.2 +002200* 4. X-CARDS USED IN THIS PROGRAM: IX1144.2 +002300* IX1144.2 +002400* XXXXX024 IX1144.2 +002500* XXXXX055. IX1144.2 +002600* P XXXXX062. IX1144.2 +002700* XXXXX082. IX1144.2 +002800* XXXXX083. IX1144.2 +002900* C XXXXX084 IX1144.2 +003000* IX1144.2 +003100* IX1144.2 +003200 ENVIRONMENT DIVISION. IX1144.2 +003300 CONFIGURATION SECTION. IX1144.2 +003400 SOURCE-COMPUTER. IX1144.2 +003500 XXXXX082. IX1144.2 +003600 OBJECT-COMPUTER. IX1144.2 +003700 XXXXX083. IX1144.2 +003800 INPUT-OUTPUT SECTION. IX1144.2 +003900 FILE-CONTROL. IX1144.2 +004000P SELECT RAW-DATA ASSIGN TO IX1144.2 +004100P XXXXX062 IX1144.2 +004200P ORGANIZATION IS INDEXED IX1144.2 +004300P ACCESS MODE IS RANDOM IX1144.2 +004400P RECORD KEY IS RAW-DATA-KEY. IX1144.2 +004500* IX1144.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1144.2 +004700 XXXXX055. IX1144.2 +004800* IX1144.2 +004900 SELECT IX-FS3 ASSIGN IX1144.2 +005000 XXXXX024 IX1144.2 +005100 ORGANIZATION IS INDEXED IX1144.2 +005200 ACCESS MODE IS SEQUENTIAL IX1144.2 +005300 RECORD KEY IS IX-FS3-KEY IX1144.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1144.2 +005500 IX1144.2 +005600 DATA DIVISION. IX1144.2 +005700 IX1144.2 +005800 FILE SECTION. IX1144.2 +005900P IX1144.2 +006000PFD RAW-DATA. IX1144.2 +006100P IX1144.2 +006200P01 RAW-DATA-SATZ. IX1144.2 +006300P 05 RAW-DATA-KEY PIC X(6). IX1144.2 +006400P 05 C-DATE PIC 9(6). IX1144.2 +006500P 05 C-TIME PIC 9(8). IX1144.2 +006600P 05 C-NO-OF-TESTS PIC 99. IX1144.2 +006700P 05 C-OK PIC 999. IX1144.2 +006800P 05 C-ALL PIC 999. IX1144.2 +006900P 05 C-FAIL PIC 999. IX1144.2 +007000P 05 C-DELETED PIC 999. IX1144.2 +007100P 05 C-INSPECT PIC 999. IX1144.2 +007200P 05 C-NOTE PIC X(13). IX1144.2 +007300P 05 C-INDENT PIC X. IX1144.2 +007400P 05 C-ABORT PIC X(8). IX1144.2 +007500 IX1144.2 +007600 FD PRINT-FILE. IX1144.2 +007700 IX1144.2 +007800 01 PRINT-REC PIC X(120). IX1144.2 +007900 IX1144.2 +008000 01 DUMMY-RECORD PIC X(120). IX1144.2 +008100 IX1144.2 +008200 FD IX-FS3 IX1144.2 +008300C DATA RECORDS IX-FS3R1-F-G-240 IX1144.2 +008400C LABEL RECORD STANDARD IX1144.2 +008500 RECORD 240 IX1144.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1144.2 +008700 IX1144.2 +008800 01 IX-FS3R1-F-G-240. IX1144.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1144.2 +009000 05 IX-FS3-REC-120-240. IX1144.2 +009100 10 FILLER PIC X(8). IX1144.2 +009200 10 IX-FS3-KEY PIC X(29). IX1144.2 +009300 10 FILLER PIC X(9). IX1144.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1144.2 +009500 10 FILLER PIC X(45). IX1144.2 +009600 IX1144.2 +009700 IX1144.2 +009800 WORKING-STORAGE SECTION. IX1144.2 +009900 IX1144.2 +010000 01 GRP-0101. IX1144.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1144.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1144.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1144.2 +010400 IX1144.2 +010500 01 GRP-0102. IX1144.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1144.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1144.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1144.2 +010900 IX1144.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1144.2 +011100 IX1144.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1144.2 +011300 IX1144.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1144.2 +011500 IX1144.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1144.2 +011700 IX1144.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1144.2 +011900 IX1144.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1144.2 +012100 IX1144.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1144.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1144.2 +012400 IX1144.2 +012500 01 IX-FS3-STATUS. IX1144.2 +012600 05 IX-FS3-STAT1 PIC X. IX1144.2 +012700 05 IX-FS3-STAT2 PIC X. IX1144.2 +012800 IX1144.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1144.2 +013000 IX1144.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1144.2 +013200 IX1144.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1144.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1144.2 +013500 10 FILLER PIC X(48) VALUE IX1144.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1144.2 +013700 10 FILLER PIC X(46) VALUE IX1144.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1144.2 +013900 10 FILLER PIC X(26) VALUE IX1144.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1144.2 +014100 10 FILLER PIC X(37) VALUE IX1144.2 +014200 ",RECKEY= ". IX1144.2 +014300 10 FILLER PIC X(38) VALUE IX1144.2 +014400 ",ALTKEY1= ". IX1144.2 +014500 10 FILLER PIC X(38) VALUE IX1144.2 +014600 ",ALTKEY2= ". IX1144.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1144.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1144.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1144.2 +015000 15 FILLER PIC X(5). IX1144.2 +015100 15 XFILE-NAME PIC X(6). IX1144.2 +015200 15 FILLER PIC X(8). IX1144.2 +015300 15 XRECORD-NAME PIC X(6). IX1144.2 +015400 15 FILLER PIC X(1). IX1144.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1144.2 +015600 15 FILLER PIC X(7). IX1144.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1144.2 +015800 15 FILLER PIC X(6). IX1144.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1144.2 +016000 15 FILLER PIC X(5). IX1144.2 +016100 15 ODO-NUMBER PIC 9(4). IX1144.2 +016200 15 FILLER PIC X(5). IX1144.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1144.2 +016400 15 FILLER PIC X(7). IX1144.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1144.2 +016600 15 FILLER PIC X(7). IX1144.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1144.2 +016800 15 FILLER PIC X(1). IX1144.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1144.2 +017000 15 FILLER PIC X(6). IX1144.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1144.2 +017200 15 FILLER PIC X(5). IX1144.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1144.2 +017400 15 FILLER PIC X(6). IX1144.2 +017500 15 XLABEL-TYPE PIC X(1). IX1144.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1144.2 +017700 15 FILLER PIC X(8). IX1144.2 +017800 15 XRECORD-KEY PIC X(29). IX1144.2 +017900 15 FILLER PIC X(9). IX1144.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1144.2 +018100 15 FILLER PIC X(9). IX1144.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1144.2 +018300 15 FILLER PIC X(7). IX1144.2 +018400 IX1144.2 +018500 01 TEST-RESULTS. IX1144.2 +018600 02 FILLER PIC X VALUE SPACE. IX1144.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1144.2 +018800 02 FILLER PIC X VALUE SPACE. IX1144.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1144.2 +019000 02 FILLER PIC X VALUE SPACE. IX1144.2 +019100 02 PAR-NAME. IX1144.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1144.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1144.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1144.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1144.2 +019600 02 RE-MARK PIC X(61). IX1144.2 +019700 01 TEST-COMPUTED. IX1144.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1144.2 +019900 02 FILLER PIC X(17) VALUE IX1144.2 +020000 " COMPUTED=". IX1144.2 +020100 02 COMPUTED-X. IX1144.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1144.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1144.2 +020400 PIC -9(9).9(9). IX1144.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1144.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1144.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1144.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1144.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1144.2 +021000 04 FILLER PIC X. IX1144.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1144.2 +021200 01 TEST-CORRECT. IX1144.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1144.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1144.2 +021500 02 CORRECT-X. IX1144.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1144.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1144.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1144.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1144.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1144.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1144.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1144.2 +022300 04 FILLER PIC X. IX1144.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1144.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1144.2 +022600 01 CCVS-C-1. IX1144.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1144.2 +022800- "SS PARAGRAPH-NAME IX1144.2 +022900- " REMARKS". IX1144.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1144.2 +023100 01 CCVS-C-2. IX1144.2 +023200 02 FILLER PIC X VALUE SPACE. IX1144.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1144.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1144.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1144.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1144.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1144.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1144.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1144.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1144.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1144.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1144.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1144.2 +024800 01 CCVS-H-1. IX1144.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1144.2 +025000 02 FILLER PIC X(42) VALUE IX1144.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1144.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1144.2 +025300 01 CCVS-H-2A. IX1144.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1144.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1144.2 +025600 02 FILLER PIC XXXX VALUE IX1144.2 +025700 "4.2 ". IX1144.2 +025800 02 FILLER PIC X(28) VALUE IX1144.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1144.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1144.2 +026100 IX1144.2 +026200 01 CCVS-H-2B. IX1144.2 +026300 02 FILLER PIC X(15) VALUE IX1144.2 +026400 "TEST RESULT OF ". IX1144.2 +026500 02 TEST-ID PIC X(9). IX1144.2 +026600 02 FILLER PIC X(4) VALUE IX1144.2 +026700 " IN ". IX1144.2 +026800 02 FILLER PIC X(12) VALUE IX1144.2 +026900 " HIGH ". IX1144.2 +027000 02 FILLER PIC X(22) VALUE IX1144.2 +027100 " LEVEL VALIDATION FOR ". IX1144.2 +027200 02 FILLER PIC X(58) VALUE IX1144.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +027400 01 CCVS-H-3. IX1144.2 +027500 02 FILLER PIC X(34) VALUE IX1144.2 +027600 " FOR OFFICIAL USE ONLY ". IX1144.2 +027700 02 FILLER PIC X(58) VALUE IX1144.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1144.2 +027900 02 FILLER PIC X(28) VALUE IX1144.2 +028000 " COPYRIGHT 1985 ". IX1144.2 +028100 01 CCVS-E-1. IX1144.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1144.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1144.2 +028400 02 ID-AGAIN PIC X(9). IX1144.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1144.2 +028600 01 CCVS-E-2. IX1144.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1144.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1144.2 +028900 02 CCVS-E-2-2. IX1144.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1144.2 +029100 03 FILLER PIC X VALUE SPACE. IX1144.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1144.2 +029300 "ERRORS ENCOUNTERED". IX1144.2 +029400 01 CCVS-E-3. IX1144.2 +029500 02 FILLER PIC X(22) VALUE IX1144.2 +029600 " FOR OFFICIAL USE ONLY". IX1144.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1144.2 +029800 02 FILLER PIC X(58) VALUE IX1144.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1144.2 +030100 02 FILLER PIC X(15) VALUE IX1144.2 +030200 " COPYRIGHT 1985". IX1144.2 +030300 01 CCVS-E-4. IX1144.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1144.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1144.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1144.2 +030700 02 FILLER PIC X(40) VALUE IX1144.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1144.2 +030900 01 XXINFO. IX1144.2 +031000 02 FILLER PIC X(19) VALUE IX1144.2 +031100 "*** INFORMATION ***". IX1144.2 +031200 02 INFO-TEXT. IX1144.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1144.2 +031400 04 XXCOMPUTED PIC X(20). IX1144.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1144.2 +031600 04 XXCORRECT PIC X(20). IX1144.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1144.2 +031800 01 HYPHEN-LINE. IX1144.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1144.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1144.2 +032100- "*****************************************". IX1144.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1144.2 +032300- "******************************". IX1144.2 +032400 01 TEST-NO PIC 99. IX1144.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1144.2 +032600 "IX114A". IX1144.2 +032700 PROCEDURE DIVISION. IX1144.2 +032800 DECLARATIVES. IX1144.2 +032900 IX1144.2 +033000 SECT-IX105-0002 SECTION. IX1144.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1144.2 +033200 INPUT-PROCESS. IX1144.2 +033300 IF TEST-NO = 5 IX1144.2 +033400 GO TO D-C-TEST-GF-01-1. IX1144.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1144.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1144.2 +033700 MOVE 1 TO EOF-FLAG IX1144.2 +033800 ELSE IX1144.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1144.2 +034000 MOVE 1 TO PERM-ERRORS. IX1144.2 +034100 GO TO DECL-EXIT. IX1144.2 +034200 D-C-TEST-GF-01-1. IX1144.2 +034300 IF IX-FS3-STATUS EQUAL TO "47" IX1144.2 +034400 GO TO D-C-PASS-GF-01-0. IX1144.2 +034500 D-C-FAIL-GF-01-0. IX1144.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +034700 MOVE "47" TO CORRECT-X. IX1144.2 +034800 MOVE "IX-5, 1.3.4, (5) F" TO RE-MARK. IX1144.2 +034900 PERFORM D-FAIL. IX1144.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1144.2 +035100 D-C-PASS-GF-01-0. IX1144.2 +035200 PERFORM D-PASS. IX1144.2 +035300 D-C-WRITE-GF-01-0. IX1144.2 +035400 PERFORM D-PRINT-DETAIL. IX1144.2 +035500 D-CLOSE-FILES. IX1144.2 +035600P OPEN I-O RAW-DATA. IX1144.2 +035700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +035800P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1144.2 +035900P MOVE "OK. " TO C-ABORT. IX1144.2 +036000P MOVE PASS-COUNTER TO C-OK. IX1144.2 +036100P MOVE ERROR-HOLD TO C-ALL. IX1144.2 +036200P MOVE ERROR-COUNTER TO C-FAIL. IX1144.2 +036300P MOVE DELETE-COUNTER TO C-DELETED. IX1144.2 +036400P MOVE INSPECT-COUNTER TO C-INSPECT. IX1144.2 +036500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1144.2 +036600PD-END-E-2. IX1144.2 +036700P CLOSE RAW-DATA. IX1144.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1144.2 +036900 CLOSE PRINT-FILE. IX1144.2 +037000 D-TERMINATE-CCVS. IX1144.2 +037100S EXIT PROGRAM. IX1144.2 +037200SD-TERMINATE-CALL. IX1144.2 +037300 STOP RUN. IX1144.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1144.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1144.2 +037600 D-PRINT-DETAIL. IX1144.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1144.2 +037800 MOVE "." TO PARDOT-X IX1144.2 +037900 MOVE REC-CT TO DOTVALUE. IX1144.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1144.2 +038100 PERFORM D-WRITE-LINE. IX1144.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1144.2 +038300 PERFORM D-WRITE-LINE IX1144.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1144.2 +038500 ELSE IX1144.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1144.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1144.2 +038800 MOVE SPACE TO CORRECT-X. IX1144.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1144.2 +039000 MOVE SPACE TO RE-MARK. IX1144.2 +039100 D-END-ROUTINE. IX1144.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1144.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1144.2 +039400 D-END-RTN-EXIT. IX1144.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1144.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +039700 D-END-ROUTINE-1. IX1144.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1144.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1144.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1144.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1144.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1144.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1144.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1144.2 +040500 D-END-ROUTINE-12. IX1144.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1144.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1144.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1144.2 +040900 ELSE IX1144.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1144.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +041200 PERFORM D-WRITE-LINE. IX1144.2 +041300 D-END-ROUTINE-13. IX1144.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1144.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1144.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1144.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1144.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +041900 PERFORM D-WRITE-LINE. IX1144.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1144.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1144.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1144.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1144.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1144.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1144.2 +042600 D-WRITE-LINE. IX1144.2 +042700 ADD 1 TO RECORD-COUNT. IX1144.2 +042800Y IF RECORD-COUNT GREATER 42 IX1144.2 +042900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1144.2 +043000Y MOVE SPACE TO DUMMY-RECORD IX1144.2 +043100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1144.2 +043200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1144.2 +043300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1144.2 +043400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1144.2 +043500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1144.2 +043600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1144.2 +044000Y MOVE ZERO TO RECORD-COUNT. IX1144.2 +044100 PERFORM D-WRT-LN. IX1144.2 +044200 D-WRT-LN. IX1144.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1144.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1144.2 +044500 D-FAIL-ROUTINE. IX1144.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1144.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1144.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1144.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1144.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1144.2 +045400 D-FAIL-ROUTINE-WRITE. IX1144.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1144.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1144.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1144.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1144.2 +046000 D-BAIL-OUT. IX1144.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1144.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1144.2 +046300 D-BAIL-OUT-WRITE. IX1144.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1144.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +046800 D-BAIL-OUT-EX. EXIT. IX1144.2 +046900 DECL-EXIT. EXIT. IX1144.2 +047000 END DECLARATIVES. IX1144.2 +047100 IX1144.2 +047200 IX1144.2 +047300 CCVS1 SECTION. IX1144.2 +047400 OPEN-FILES. IX1144.2 +047500P OPEN I-O RAW-DATA. IX1144.2 +047600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +047700P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1144.2 +047800P MOVE "ABORTED " TO C-ABORT. IX1144.2 +047900P ADD 1 TO C-NO-OF-TESTS. IX1144.2 +048000P ACCEPT C-DATE FROM DATE. IX1144.2 +048100P ACCEPT C-TIME FROM TIME. IX1144.2 +048200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1144.2 +048300PEND-E-1. IX1144.2 +048400P CLOSE RAW-DATA. IX1144.2 +048500 OPEN OUTPUT PRINT-FILE. IX1144.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1144.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1144.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1144.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1144.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1144.2 +049100 CCVS-INIT-FILE. IX1144.2 +049200 ADD 1 TO REC-SKL-SUB. IX1144.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1144.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1144.2 +049500 CCVS-INIT-EXIT. IX1144.2 +049600 GO TO CCVS1-EXIT. IX1144.2 +049700 CLOSE-FILES. IX1144.2 +049800P OPEN I-O RAW-DATA. IX1144.2 +049900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +050000P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1144.2 +050100P MOVE "OK. " TO C-ABORT. IX1144.2 +050200P MOVE PASS-COUNTER TO C-OK. IX1144.2 +050300P MOVE ERROR-HOLD TO C-ALL. IX1144.2 +050400P MOVE ERROR-COUNTER TO C-FAIL. IX1144.2 +050500P MOVE DELETE-COUNTER TO C-DELETED. IX1144.2 +050600P MOVE INSPECT-COUNTER TO C-INSPECT. IX1144.2 +050700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1144.2 +050800PEND-E-2. IX1144.2 +050900P CLOSE RAW-DATA. IX1144.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1144.2 +051100 TERMINATE-CCVS. IX1144.2 +051200S EXIT PROGRAM. IX1144.2 +051300STERMINATE-CALL. IX1144.2 +051400 STOP RUN. IX1144.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1144.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1144.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1144.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1144.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1144.2 +052000 PRINT-DETAIL. IX1144.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1144.2 +052200 MOVE "." TO PARDOT-X IX1144.2 +052300 MOVE REC-CT TO DOTVALUE. IX1144.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1144.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1144.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1144.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1144.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1144.2 +052900 MOVE SPACE TO CORRECT-X. IX1144.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1144.2 +053100 MOVE SPACE TO RE-MARK. IX1144.2 +053200 HEAD-ROUTINE. IX1144.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1144.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1144.2 +053700 COLUMN-NAMES-ROUTINE. IX1144.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +054100 END-ROUTINE. IX1144.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1144.2 +054300 END-RTN-EXIT. IX1144.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +054500 END-ROUTINE-1. IX1144.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1144.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1144.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1144.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1144.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1144.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1144.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1144.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1144.2 +055400 END-ROUTINE-12. IX1144.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1144.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1144.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1144.2 +055800 ELSE IX1144.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1144.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +056100 PERFORM WRITE-LINE. IX1144.2 +056200 END-ROUTINE-13. IX1144.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1144.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1144.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1144.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1144.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1144.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1144.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1144.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1144.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +057400 WRITE-LINE. IX1144.2 +057500 ADD 1 TO RECORD-COUNT. IX1144.2 +057600Y IF RECORD-COUNT GREATER 42 IX1144.2 +057700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1144.2 +057800Y MOVE SPACE TO DUMMY-RECORD IX1144.2 +057900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1144.2 +058000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1144.2 +058100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1144.2 +058200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1144.2 +058300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1144.2 +058400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1144.2 +058800Y MOVE ZERO TO RECORD-COUNT. IX1144.2 +058900 PERFORM WRT-LN. IX1144.2 +059000 WRT-LN. IX1144.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1144.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1144.2 +059300 BLANK-LINE-PRINT. IX1144.2 +059400 PERFORM WRT-LN. IX1144.2 +059500 FAIL-ROUTINE. IX1144.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1144.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1144.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1144.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1144.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +060300 GO TO FAIL-ROUTINE-EX. IX1144.2 +060400 FAIL-ROUTINE-WRITE. IX1144.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1144.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1144.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1144.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1144.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1144.2 +061000 BAIL-OUT. IX1144.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1144.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1144.2 +061300 BAIL-OUT-WRITE. IX1144.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1144.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +061800 BAIL-OUT-EX. EXIT. IX1144.2 +061900 CCVS1-EXIT. IX1144.2 +062000 EXIT. IX1144.2 +062100 IX1144.2 +062200 SECT-IX114A-0003 SECTION. IX1144.2 +062300 SEQ-INIT-010. IX1144.2 +062400 MOVE ZERO TO TEST-NO. IX1144.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1144.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1144.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1144.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1144.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1144.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1144.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1144.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1144.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1144.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1144.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1144.2 +063600 IX1144.2 +063700******************************************************************IX1144.2 +063800* TEST 1 *IX1144.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1144.2 +064000* IX-3, 1.3.4 (1) A *IX1144.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1144.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1144.2 +064300******************************************************************IX1144.2 +064400 OPN-INIT-GF-01-0. IX1144.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1144.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1144.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +064900 OPEN IX1144.2 +065000 I-O IX-FS3. IX1144.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1144.2 +065200 GO TO OPN-PASS-GF-01-0. IX1144.2 +065300 OPN-FAIL-GF-01-0. IX1144.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1144.2 +065500 PERFORM FAIL. IX1144.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +065700 MOVE "00" TO CORRECT-X. IX1144.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1144.2 +065900 OPN-PASS-GF-01-0. IX1144.2 +066000 PERFORM PASS. IX1144.2 +066100 OPN-WRITE-GF-01-0. IX1144.2 +066200 PERFORM PRINT-DETAIL. IX1144.2 +066300******************************************************************IX1144.2 +066400* TEST 4 *IX1144.2 +066500* CLOSE I-O 00 EXPECTED *IX1144.2 +066600* IX-3, 1.3.4 (1) A *IX1144.2 +066700******************************************************************IX1144.2 +066800 CLO-INIT-GF-01-0. IX1144.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1144.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +067200 CLO-TEST-GF-01-0. IX1144.2 +067300 CLOSE IX-FS3. IX1144.2 +067400 IF IX-FS3-STATUS = "00" IX1144.2 +067500 GO TO CLO-PASS-GF-01-0. IX1144.2 +067600 CLO-FAIL-GF-01-0. IX1144.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1144.2 +067800 PERFORM FAIL. IX1144.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +068000 MOVE "00" TO CORRECT-X. IX1144.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1144.2 +068200 CLO-PASS-GF-01-0. IX1144.2 +068300 PERFORM PASS. IX1144.2 +068400 CLO-WRITE-GF-01-0. IX1144.2 +068500 PERFORM PRINT-DETAIL. IX1144.2 +068600 IX1144.2 +068700******************************************************************IX1144.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1144.2 +068900******************************************************************IX1144.2 +069000 IX1144.2 +069100******************************************************************IX1144.2 +069200* TEST 5 *IX1144.2 +069300* READ ... A FILE NOT IN THE OPEN MODE *IX1144.2 +069400* FILE STATUS 47 EXPECTED IX-5, 1.3.4 (5) F *IX1144.2 +069500******************************************************************IX1144.2 +069600 REA-TEST-GF-01-0. IX1144.2 +069700 MOVE 5 TO TEST-NO. IX1144.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +069900 MOVE "READ. 47 EXP." TO FEATURE IX1144.2 +070000 MOVE "REA-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +070100 READ IX-FS3 AT END GO TO REA-TEST-GF-01-1. IX1144.2 +070200 REA-TEST-GF-01-1. IX1144.2 +070300 IF IX-FS3-STATUS EQUAL TO "47" IX1144.2 +070400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1144.2 +070500 TO RE-MARK IX1144.2 +070600 GO TO REA-WRITE-GF-01-0. IX1144.2 +070700 REA-FAIL-GF-01-0. IX1144.2 +070800 MOVE "IX-5, 1.3.4, (5) F" TO RE-MARK. IX1144.2 +070900 REA-WRITE-GF-01-0. IX1144.2 +071000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +071100 MOVE "47" TO CORRECT-X. IX1144.2 +071200 PERFORM FAIL. IX1144.2 +071300 PERFORM PRINT-DETAIL. IX1144.2 +071400 IX1144.2 +071500 TERMINATE-ROUTINE. IX1144.2 +071600 EXIT. IX1144.2 +071700 IX1144.2 +071800 CCVS-EXIT SECTION. IX1144.2 +071900 CCVS-999999. IX1144.2 +072000 GO TO CLOSE-FILES. IX1144.2 +*END-OF,IX114A +*HEADER,COBOL,IX113A,SUBPRG,IX115A +000100 IDENTIFICATION DIVISION. IX1154.2 +000200 PROGRAM-ID. IX1154.2 +000300 IX115A. IX1154.2 +000400**************************************************************** IX1154.2 +000500* * IX1154.2 +000600* VALIDATION FOR:- * IX1154.2 +000700* * IX1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +000900* * IX1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1154.2 +001100* * IX1154.2 +001200**************************************************************** IX1154.2 +001300* IX1154.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1154.2 +001500* IX113A. IX1154.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED) IX1154.2 +001700* THEN CLOSED AND THE STATUS CHECKED AGAIN (00 EXPECTED). AN IX1154.2 +001800* ATTEMPT IS THEN MADE TO WRITE A RECORD TO THE CLOSED FILE IX1154.2 +001900* AT WHICH POINT THE USE AFTER STANDARD EXCEPTION PROCEDURE *IX1154.2 +002000* STATEMENTS IN THE DECLARATIVES SHOULD BE EXECUTED AND THE IX1154.2 +002100* FILE STATUS SHOULD BE 48 (IX-5, 1.3.4 (5) G. IX1154.2 +002200* IX1154.2 +002300* 4. X-CARDS USED IN THIS PROGRAM: IX1154.2 +002400* IX1154.2 +002500* XXXXX024 IX1154.2 +002600* XXXXX055. IX1154.2 +002700* P XXXXX062. IX1154.2 +002800* XXXXX082. IX1154.2 +002900* XXXXX083. IX1154.2 +003000* C XXXXX084 IX1154.2 +003100* IX1154.2 +003200* IX1154.2 +003300 ENVIRONMENT DIVISION. IX1154.2 +003400 CONFIGURATION SECTION. IX1154.2 +003500 SOURCE-COMPUTER. IX1154.2 +003600 XXXXX082. IX1154.2 +003700 OBJECT-COMPUTER. IX1154.2 +003800 XXXXX083. IX1154.2 +003900 INPUT-OUTPUT SECTION. IX1154.2 +004000 FILE-CONTROL. IX1154.2 +004100P SELECT RAW-DATA ASSIGN TO IX1154.2 +004200P XXXXX062 IX1154.2 +004300P ORGANIZATION IS INDEXED IX1154.2 +004400P ACCESS MODE IS RANDOM IX1154.2 +004500P RECORD KEY IS RAW-DATA-KEY. IX1154.2 +004600* IX1154.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1154.2 +004800 XXXXX055. IX1154.2 +004900* IX1154.2 +005000 SELECT IX-FS3 ASSIGN IX1154.2 +005100 XXXXX024 IX1154.2 +005200 ORGANIZATION IS INDEXED IX1154.2 +005300 ACCESS MODE IS SEQUENTIAL IX1154.2 +005400 RECORD KEY IS IX-FS3-KEY IX1154.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1154.2 +005600 IX1154.2 +005700 DATA DIVISION. IX1154.2 +005800 IX1154.2 +005900 FILE SECTION. IX1154.2 +006000P IX1154.2 +006100PFD RAW-DATA. IX1154.2 +006200P IX1154.2 +006300P01 RAW-DATA-SATZ. IX1154.2 +006400P 05 RAW-DATA-KEY PIC X(6). IX1154.2 +006500P 05 C-DATE PIC 9(6). IX1154.2 +006600P 05 C-TIME PIC 9(8). IX1154.2 +006700P 05 C-NO-OF-TESTS PIC 99. IX1154.2 +006800P 05 C-OK PIC 999. IX1154.2 +006900P 05 C-ALL PIC 999. IX1154.2 +007000P 05 C-FAIL PIC 999. IX1154.2 +007100P 05 C-DELETED PIC 999. IX1154.2 +007200P 05 C-INSPECT PIC 999. IX1154.2 +007300P 05 C-NOTE PIC X(13). IX1154.2 +007400P 05 C-INDENT PIC X. IX1154.2 +007500P 05 C-ABORT PIC X(8). IX1154.2 +007600 IX1154.2 +007700 FD PRINT-FILE. IX1154.2 +007800 IX1154.2 +007900 01 PRINT-REC PIC X(120). IX1154.2 +008000 IX1154.2 +008100 01 DUMMY-RECORD PIC X(120). IX1154.2 +008200 IX1154.2 +008300 FD IX-FS3 IX1154.2 +008400C DATA RECORDS IX-FS3R1-F-G-240 IX1154.2 +008500C LABEL RECORD STANDARD IX1154.2 +008600 RECORD 240 IX1154.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1154.2 +008800 IX1154.2 +008900 01 IX-FS3R1-F-G-240. IX1154.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1154.2 +009100 05 IX-FS3-REC-120-240. IX1154.2 +009200 10 FILLER PIC X(8). IX1154.2 +009300 10 IX-FS3-KEY PIC X(29). IX1154.2 +009400 10 FILLER PIC X(9). IX1154.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1154.2 +009600 10 FILLER PIC X(45). IX1154.2 +009700 IX1154.2 +009800 IX1154.2 +009900 WORKING-STORAGE SECTION. IX1154.2 +010000 IX1154.2 +010100 01 GRP-0101. IX1154.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1154.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1154.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1154.2 +010500 IX1154.2 +010600 01 GRP-0102. IX1154.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1154.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1154.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1154.2 +011000 IX1154.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1154.2 +011200 IX1154.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1154.2 +011400 IX1154.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1154.2 +011600 IX1154.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1154.2 +011800 IX1154.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1154.2 +012000 IX1154.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1154.2 +012200 IX1154.2 +012300 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1154.2 +012400 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1154.2 +012500 IX1154.2 +012600 01 IX-FS3-STATUS. IX1154.2 +012700 05 IX-FS3-STAT1 PIC X. IX1154.2 +012800 05 IX-FS3-STAT2 PIC X. IX1154.2 +012900 IX1154.2 +013000 01 COUNT-OF-RECS PIC 9(5). IX1154.2 +013100 IX1154.2 +013200 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1154.2 +013300 IX1154.2 +013400 01 FILE-RECORD-INFORMATION-REC. IX1154.2 +013500 05 FILE-RECORD-INFO-SKELETON. IX1154.2 +013600 10 FILLER PIC X(48) VALUE IX1154.2 +013700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1154.2 +013800 10 FILLER PIC X(46) VALUE IX1154.2 +013900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1154.2 +014000 10 FILLER PIC X(26) VALUE IX1154.2 +014100 ",LFIL=000000,ORG= ,LBLR= ". IX1154.2 +014200 10 FILLER PIC X(37) VALUE IX1154.2 +014300 ",RECKEY= ". IX1154.2 +014400 10 FILLER PIC X(38) VALUE IX1154.2 +014500 ",ALTKEY1= ". IX1154.2 +014600 10 FILLER PIC X(38) VALUE IX1154.2 +014700 ",ALTKEY2= ". IX1154.2 +014800 10 FILLER PIC X(7) VALUE SPACE. IX1154.2 +014900 05 FILE-RECORD-INFO OCCURS 10. IX1154.2 +015000 10 FILE-RECORD-INFO-P1-120. IX1154.2 +015100 15 FILLER PIC X(5). IX1154.2 +015200 15 XFILE-NAME PIC X(6). IX1154.2 +015300 15 FILLER PIC X(8). IX1154.2 +015400 15 XRECORD-NAME PIC X(6). IX1154.2 +015500 15 FILLER PIC X(1). IX1154.2 +015600 15 REELUNIT-NUMBER PIC 9(1). IX1154.2 +015700 15 FILLER PIC X(7). IX1154.2 +015800 15 XRECORD-NUMBER PIC 9(6). IX1154.2 +015900 15 FILLER PIC X(6). IX1154.2 +016000 15 UPDATE-NUMBER PIC 9(2). IX1154.2 +016100 15 FILLER PIC X(5). IX1154.2 +016200 15 ODO-NUMBER PIC 9(4). IX1154.2 +016300 15 FILLER PIC X(5). IX1154.2 +016400 15 XPROGRAM-NAME PIC X(5). IX1154.2 +016500 15 FILLER PIC X(7). IX1154.2 +016600 15 XRECORD-LENGTH PIC 9(6). IX1154.2 +016700 15 FILLER PIC X(7). IX1154.2 +016800 15 CHARS-OR-RECORDS PIC X(2). IX1154.2 +016900 15 FILLER PIC X(1). IX1154.2 +017000 15 XBLOCK-SIZE PIC 9(4). IX1154.2 +017100 15 FILLER PIC X(6). IX1154.2 +017200 15 RECORDS-IN-FILE PIC 9(6). IX1154.2 +017300 15 FILLER PIC X(5). IX1154.2 +017400 15 XFILE-ORGANIZATION PIC X(2). IX1154.2 +017500 15 FILLER PIC X(6). IX1154.2 +017600 15 XLABEL-TYPE PIC X(1). IX1154.2 +017700 10 FILE-RECORD-INFO-P121-240. IX1154.2 +017800 15 FILLER PIC X(8). IX1154.2 +017900 15 XRECORD-KEY PIC X(29). IX1154.2 +018000 15 FILLER PIC X(9). IX1154.2 +018100 15 ALTERNATE-KEY1 PIC X(29). IX1154.2 +018200 15 FILLER PIC X(9). IX1154.2 +018300 15 ALTERNATE-KEY2 PIC X(29). IX1154.2 +018400 15 FILLER PIC X(7). IX1154.2 +018500 IX1154.2 +018600 01 TEST-RESULTS. IX1154.2 +018700 02 FILLER PIC X VALUE SPACE. IX1154.2 +018800 02 FEATURE PIC X(20) VALUE SPACE. IX1154.2 +018900 02 FILLER PIC X VALUE SPACE. IX1154.2 +019000 02 P-OR-F PIC X(5) VALUE SPACE. IX1154.2 +019100 02 FILLER PIC X VALUE SPACE. IX1154.2 +019200 02 PAR-NAME. IX1154.2 +019300 03 FILLER PIC X(19) VALUE SPACE. IX1154.2 +019400 03 PARDOT-X PIC X VALUE SPACE. IX1154.2 +019500 03 DOTVALUE PIC 99 VALUE ZERO. IX1154.2 +019600 02 FILLER PIC X(8) VALUE SPACE. IX1154.2 +019700 02 RE-MARK PIC X(61). IX1154.2 +019800 01 TEST-COMPUTED. IX1154.2 +019900 02 FILLER PIC X(30) VALUE SPACE. IX1154.2 +020000 02 FILLER PIC X(17) VALUE IX1154.2 +020100 " COMPUTED=". IX1154.2 +020200 02 COMPUTED-X. IX1154.2 +020300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1154.2 +020400 03 COMPUTED-N REDEFINES COMPUTED-A IX1154.2 +020500 PIC -9(9).9(9). IX1154.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1154.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1154.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1154.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. IX1154.2 +021000 04 COMPUTED-18V0 PIC -9(18). IX1154.2 +021100 04 FILLER PIC X. IX1154.2 +021200 03 FILLER PIC X(50) VALUE SPACE. IX1154.2 +021300 01 TEST-CORRECT. IX1154.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1154.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1154.2 +021600 02 CORRECT-X. IX1154.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1154.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1154.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1154.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1154.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1154.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. IX1154.2 +022300 04 CORRECT-18V0 PIC -9(18). IX1154.2 +022400 04 FILLER PIC X. IX1154.2 +022500 03 FILLER PIC X(2) VALUE SPACE. IX1154.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1154.2 +022700 01 CCVS-C-1. IX1154.2 +022800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1154.2 +022900- "SS PARAGRAPH-NAME IX1154.2 +023000- " REMARKS". IX1154.2 +023100 02 FILLER PIC X(20) VALUE SPACE. IX1154.2 +023200 01 CCVS-C-2. IX1154.2 +023300 02 FILLER PIC X VALUE SPACE. IX1154.2 +023400 02 FILLER PIC X(6) VALUE "TESTED". IX1154.2 +023500 02 FILLER PIC X(15) VALUE SPACE. IX1154.2 +023600 02 FILLER PIC X(4) VALUE "FAIL". IX1154.2 +023700 02 FILLER PIC X(94) VALUE SPACE. IX1154.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1154.2 +023900 01 REC-CT PIC 99 VALUE ZERO. IX1154.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1154.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1154.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1154.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1154.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1154.2 +024900 01 CCVS-H-1. IX1154.2 +025000 02 FILLER PIC X(39) VALUE SPACES. IX1154.2 +025100 02 FILLER PIC X(42) VALUE IX1154.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1154.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1154.2 +025400 01 CCVS-H-2A. IX1154.2 +025500 02 FILLER PIC X(40) VALUE SPACE. IX1154.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1154.2 +025700 02 FILLER PIC XXXX VALUE IX1154.2 +025800 "4.2 ". IX1154.2 +025900 02 FILLER PIC X(28) VALUE IX1154.2 +026000 " COPY - NOT FOR DISTRIBUTION". IX1154.2 +026100 02 FILLER PIC X(41) VALUE SPACE. IX1154.2 +026200 IX1154.2 +026300 01 CCVS-H-2B. IX1154.2 +026400 02 FILLER PIC X(15) VALUE IX1154.2 +026500 "TEST RESULT OF ". IX1154.2 +026600 02 TEST-ID PIC X(9). IX1154.2 +026700 02 FILLER PIC X(4) VALUE IX1154.2 +026800 " IN ". IX1154.2 +026900 02 FILLER PIC X(12) VALUE IX1154.2 +027000 " HIGH ". IX1154.2 +027100 02 FILLER PIC X(22) VALUE IX1154.2 +027200 " LEVEL VALIDATION FOR ". IX1154.2 +027300 02 FILLER PIC X(58) VALUE IX1154.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +027500 01 CCVS-H-3. IX1154.2 +027600 02 FILLER PIC X(34) VALUE IX1154.2 +027700 " FOR OFFICIAL USE ONLY ". IX1154.2 +027800 02 FILLER PIC X(58) VALUE IX1154.2 +027900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1154.2 +028000 02 FILLER PIC X(28) VALUE IX1154.2 +028100 " COPYRIGHT 1985 ". IX1154.2 +028200 01 CCVS-E-1. IX1154.2 +028300 02 FILLER PIC X(52) VALUE SPACE. IX1154.2 +028400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1154.2 +028500 02 ID-AGAIN PIC X(9). IX1154.2 +028600 02 FILLER PIC X(45) VALUE SPACES. IX1154.2 +028700 01 CCVS-E-2. IX1154.2 +028800 02 FILLER PIC X(31) VALUE SPACE. IX1154.2 +028900 02 FILLER PIC X(21) VALUE SPACE. IX1154.2 +029000 02 CCVS-E-2-2. IX1154.2 +029100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1154.2 +029200 03 FILLER PIC X VALUE SPACE. IX1154.2 +029300 03 ENDER-DESC PIC X(44) VALUE IX1154.2 +029400 "ERRORS ENCOUNTERED". IX1154.2 +029500 01 CCVS-E-3. IX1154.2 +029600 02 FILLER PIC X(22) VALUE IX1154.2 +029700 " FOR OFFICIAL USE ONLY". IX1154.2 +029800 02 FILLER PIC X(12) VALUE SPACE. IX1154.2 +029900 02 FILLER PIC X(58) VALUE IX1154.2 +030000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +030100 02 FILLER PIC X(13) VALUE SPACE. IX1154.2 +030200 02 FILLER PIC X(15) VALUE IX1154.2 +030300 " COPYRIGHT 1985". IX1154.2 +030400 01 CCVS-E-4. IX1154.2 +030500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1154.2 +030600 02 FILLER PIC X(4) VALUE " OF ". IX1154.2 +030700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1154.2 +030800 02 FILLER PIC X(40) VALUE IX1154.2 +030900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1154.2 +031000 01 XXINFO. IX1154.2 +031100 02 FILLER PIC X(19) VALUE IX1154.2 +031200 "*** INFORMATION ***". IX1154.2 +031300 02 INFO-TEXT. IX1154.2 +031400 04 FILLER PIC X(8) VALUE SPACE. IX1154.2 +031500 04 XXCOMPUTED PIC X(20). IX1154.2 +031600 04 FILLER PIC X(5) VALUE SPACE. IX1154.2 +031700 04 XXCORRECT PIC X(20). IX1154.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). IX1154.2 +031900 01 HYPHEN-LINE. IX1154.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. IX1154.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************IX1154.2 +032200- "*****************************************". IX1154.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************IX1154.2 +032400- "******************************". IX1154.2 +032500 01 TEST-NO PIC 99. IX1154.2 +032600 01 CCVS-PGM-ID PIC X(9) VALUE IX1154.2 +032700 "IX115A". IX1154.2 +032800 PROCEDURE DIVISION. IX1154.2 +032900 DECLARATIVES. IX1154.2 +033000 IX1154.2 +033100 SECT-IX105-0002 SECTION. IX1154.2 +033200 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1154.2 +033300 INPUT-PROCESS. IX1154.2 +033400 IF TEST-NO = 5 IX1154.2 +033500 GO TO D-C-TEST-GF-01-1. IX1154.2 +033600 IF STATUS-TEST-10 EQUAL TO 1 IX1154.2 +033700 IF IX-FS3-STAT1 EQUAL TO "1" IX1154.2 +033800 MOVE 1 TO EOF-FLAG IX1154.2 +033900 ELSE IX1154.2 +034000 IF IX-FS3-STAT1 GREATER THAN "1" IX1154.2 +034100 MOVE 1 TO PERM-ERRORS. IX1154.2 +034200 GO TO DECL-EXIT. IX1154.2 +034300 D-C-TEST-GF-01-1. IX1154.2 +034400 IF IX-FS3-STATUS EQUAL TO "48" IX1154.2 +034500 GO TO D-C-PASS-GF-01-0. IX1154.2 +034600 D-C-FAIL-GF-01-0. IX1154.2 +034700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +034800 MOVE "48" TO CORRECT-X. IX1154.2 +034900 MOVE "IX-5, 1.3.4, (5) G" TO RE-MARK. IX1154.2 +035000 PERFORM D-FAIL. IX1154.2 +035100 GO TO D-C-WRITE-GF-01-0. IX1154.2 +035200 D-C-PASS-GF-01-0. IX1154.2 +035300 PERFORM D-PASS. IX1154.2 +035400 D-C-WRITE-GF-01-0. IX1154.2 +035500 PERFORM D-PRINT-DETAIL. IX1154.2 +035600 D-CLOSE-FILES. IX1154.2 +035700P OPEN I-O RAW-DATA. IX1154.2 +035800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +035900P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1154.2 +036000P MOVE "OK. " TO C-ABORT. IX1154.2 +036100P MOVE PASS-COUNTER TO C-OK. IX1154.2 +036200P MOVE ERROR-HOLD TO C-ALL. IX1154.2 +036300P MOVE ERROR-COUNTER TO C-FAIL. IX1154.2 +036400P MOVE DELETE-COUNTER TO C-DELETED. IX1154.2 +036500P MOVE INSPECT-COUNTER TO C-INSPECT. IX1154.2 +036600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1154.2 +036700PD-END-E-2. IX1154.2 +036800P CLOSE RAW-DATA. IX1154.2 +036900 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1154.2 +037000 CLOSE PRINT-FILE. IX1154.2 +037100 D-TERMINATE-CCVS. IX1154.2 +037200S EXIT PROGRAM. IX1154.2 +037300SD-TERMINATE-CALL. IX1154.2 +037400 STOP RUN. IX1154.2 +037500 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1154.2 +037600 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1154.2 +037700 D-PRINT-DETAIL. IX1154.2 +037800 IF REC-CT NOT EQUAL TO ZERO IX1154.2 +037900 MOVE "." TO PARDOT-X IX1154.2 +038000 MOVE REC-CT TO DOTVALUE. IX1154.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. IX1154.2 +038200 PERFORM D-WRITE-LINE. IX1154.2 +038300 IF P-OR-F EQUAL TO "FAIL*" IX1154.2 +038400 PERFORM D-WRITE-LINE IX1154.2 +038500 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1154.2 +038600 ELSE IX1154.2 +038700 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1154.2 +038800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1154.2 +038900 MOVE SPACE TO CORRECT-X. IX1154.2 +039000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1154.2 +039100 MOVE SPACE TO RE-MARK. IX1154.2 +039200 D-END-ROUTINE. IX1154.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1154.2 +039400 PERFORM D-WRITE-LINE 5 TIMES. IX1154.2 +039500 D-END-RTN-EXIT. IX1154.2 +039600 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1154.2 +039700 PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +039800 D-END-ROUTINE-1. IX1154.2 +039900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1154.2 +040000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1154.2 +040100 ADD PASS-COUNTER TO ERROR-HOLD. IX1154.2 +040200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1154.2 +040300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1154.2 +040400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1154.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1154.2 +040600 D-END-ROUTINE-12. IX1154.2 +040700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1154.2 +040800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1154.2 +040900 MOVE "NO " TO ERROR-TOTAL IX1154.2 +041000 ELSE IX1154.2 +041100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1154.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +041300 PERFORM D-WRITE-LINE. IX1154.2 +041400 D-END-ROUTINE-13. IX1154.2 +041500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1154.2 +041600 MOVE "NO " TO ERROR-TOTAL ELSE IX1154.2 +041700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1154.2 +041800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1154.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +042000 PERFORM D-WRITE-LINE. IX1154.2 +042100 IF INSPECT-COUNTER EQUAL TO ZERO IX1154.2 +042200 MOVE "NO " TO ERROR-TOTAL IX1154.2 +042300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1154.2 +042400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1154.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1154.2 +042600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1154.2 +042700 D-WRITE-LINE. IX1154.2 +042800 ADD 1 TO RECORD-COUNT. IX1154.2 +042900Y IF RECORD-COUNT GREATER 42 IX1154.2 +043000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1154.2 +043100Y MOVE SPACE TO DUMMY-RECORD IX1154.2 +043200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1154.2 +043300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1154.2 +043400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1154.2 +043500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1154.2 +043600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1154.2 +043700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +043800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +043900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +044000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1154.2 +044100Y MOVE ZERO TO RECORD-COUNT. IX1154.2 +044200 PERFORM D-WRT-LN. IX1154.2 +044300 D-WRT-LN. IX1154.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1154.2 +044500 MOVE SPACE TO DUMMY-RECORD. IX1154.2 +044600 D-FAIL-ROUTINE. IX1154.2 +044700 IF COMPUTED-X NOT EQUAL TO SPACE IX1154.2 +044800 GO TO D-FAIL-ROUTINE-WRITE. IX1154.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1154.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1154.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +045400 GO TO D-FAIL-ROUTINE-EX. IX1154.2 +045500 D-FAIL-ROUTINE-WRITE. IX1154.2 +045600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1154.2 +045700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1154.2 +045800 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +045900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1154.2 +046000 D-FAIL-ROUTINE-EX. EXIT. IX1154.2 +046100 D-BAIL-OUT. IX1154.2 +046200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1154.2 +046300 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1154.2 +046400 D-BAIL-OUT-WRITE. IX1154.2 +046500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1154.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +046700 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +046800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +046900 D-BAIL-OUT-EX. EXIT. IX1154.2 +047000 DECL-EXIT. EXIT. IX1154.2 +047100 END DECLARATIVES. IX1154.2 +047200 IX1154.2 +047300 IX1154.2 +047400 CCVS1 SECTION. IX1154.2 +047500 OPEN-FILES. IX1154.2 +047600P OPEN I-O RAW-DATA. IX1154.2 +047700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +047800P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1154.2 +047900P MOVE "ABORTED " TO C-ABORT. IX1154.2 +048000P ADD 1 TO C-NO-OF-TESTS. IX1154.2 +048100P ACCEPT C-DATE FROM DATE. IX1154.2 +048200P ACCEPT C-TIME FROM TIME. IX1154.2 +048300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1154.2 +048400PEND-E-1. IX1154.2 +048500P CLOSE RAW-DATA. IX1154.2 +048600 OPEN OUTPUT PRINT-FILE. IX1154.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1154.2 +048800 MOVE SPACE TO TEST-RESULTS. IX1154.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1154.2 +049000 MOVE ZERO TO REC-SKL-SUB. IX1154.2 +049100 PERFORM CCVS-INIT-FILE 9 TIMES. IX1154.2 +049200 CCVS-INIT-FILE. IX1154.2 +049300 ADD 1 TO REC-SKL-SUB. IX1154.2 +049400 MOVE FILE-RECORD-INFO-SKELETON IX1154.2 +049500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1154.2 +049600 CCVS-INIT-EXIT. IX1154.2 +049700 GO TO CCVS1-EXIT. IX1154.2 +049800 CLOSE-FILES. IX1154.2 +049900P OPEN I-O RAW-DATA. IX1154.2 +050000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +050100P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1154.2 +050200P MOVE "OK. " TO C-ABORT. IX1154.2 +050300P MOVE PASS-COUNTER TO C-OK. IX1154.2 +050400P MOVE ERROR-HOLD TO C-ALL. IX1154.2 +050500P MOVE ERROR-COUNTER TO C-FAIL. IX1154.2 +050600P MOVE DELETE-COUNTER TO C-DELETED. IX1154.2 +050700P MOVE INSPECT-COUNTER TO C-INSPECT. IX1154.2 +050800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1154.2 +050900PEND-E-2. IX1154.2 +051000P CLOSE RAW-DATA. IX1154.2 +051100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1154.2 +051200 TERMINATE-CCVS. IX1154.2 +051300S EXIT PROGRAM. IX1154.2 +051400STERMINATE-CALL. IX1154.2 +051500 STOP RUN. IX1154.2 +051600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1154.2 +051700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1154.2 +051800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1154.2 +051900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1154.2 +052000 MOVE "****TEST DELETED****" TO RE-MARK. IX1154.2 +052100 PRINT-DETAIL. IX1154.2 +052200 IF REC-CT NOT EQUAL TO ZERO IX1154.2 +052300 MOVE "." TO PARDOT-X IX1154.2 +052400 MOVE REC-CT TO DOTVALUE. IX1154.2 +052500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1154.2 +052600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1154.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1154.2 +052800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1154.2 +052900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1154.2 +053000 MOVE SPACE TO CORRECT-X. IX1154.2 +053100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1154.2 +053200 MOVE SPACE TO RE-MARK. IX1154.2 +053300 HEAD-ROUTINE. IX1154.2 +053400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +053500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +053600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1154.2 +053700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1154.2 +053800 COLUMN-NAMES-ROUTINE. IX1154.2 +053900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +054000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +054200 END-ROUTINE. IX1154.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1154.2 +054400 END-RTN-EXIT. IX1154.2 +054500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +054600 END-ROUTINE-1. IX1154.2 +054700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1154.2 +054800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1154.2 +054900 ADD PASS-COUNTER TO ERROR-HOLD. IX1154.2 +055000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1154.2 +055100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1154.2 +055200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1154.2 +055300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1154.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1154.2 +055500 END-ROUTINE-12. IX1154.2 +055600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1154.2 +055700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1154.2 +055800 MOVE "NO " TO ERROR-TOTAL IX1154.2 +055900 ELSE IX1154.2 +056000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1154.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +056200 PERFORM WRITE-LINE. IX1154.2 +056300 END-ROUTINE-13. IX1154.2 +056400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1154.2 +056500 MOVE "NO " TO ERROR-TOTAL ELSE IX1154.2 +056600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1154.2 +056700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1154.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +056900 IF INSPECT-COUNTER EQUAL TO ZERO IX1154.2 +057000 MOVE "NO " TO ERROR-TOTAL IX1154.2 +057100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1154.2 +057200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1154.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +057400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +057500 WRITE-LINE. IX1154.2 +057600 ADD 1 TO RECORD-COUNT. IX1154.2 +057700Y IF RECORD-COUNT GREATER 42 IX1154.2 +057800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1154.2 +057900Y MOVE SPACE TO DUMMY-RECORD IX1154.2 +058000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1154.2 +058100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1154.2 +058200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1154.2 +058300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1154.2 +058400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1154.2 +058500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1154.2 +058900Y MOVE ZERO TO RECORD-COUNT. IX1154.2 +059000 PERFORM WRT-LN. IX1154.2 +059100 WRT-LN. IX1154.2 +059200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1154.2 +059300 MOVE SPACE TO DUMMY-RECORD. IX1154.2 +059400 BLANK-LINE-PRINT. IX1154.2 +059500 PERFORM WRT-LN. IX1154.2 +059600 FAIL-ROUTINE. IX1154.2 +059700 IF COMPUTED-X NOT EQUAL TO SPACE IX1154.2 +059800 GO TO FAIL-ROUTINE-WRITE. IX1154.2 +059900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1154.2 +060000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +060100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1154.2 +060200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +060300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +060400 GO TO FAIL-ROUTINE-EX. IX1154.2 +060500 FAIL-ROUTINE-WRITE. IX1154.2 +060600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1154.2 +060700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1154.2 +060800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1154.2 +060900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1154.2 +061000 FAIL-ROUTINE-EX. EXIT. IX1154.2 +061100 BAIL-OUT. IX1154.2 +061200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1154.2 +061300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1154.2 +061400 BAIL-OUT-WRITE. IX1154.2 +061500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1154.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +061700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +061800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +061900 BAIL-OUT-EX. EXIT. IX1154.2 +062000 CCVS1-EXIT. IX1154.2 +062100 EXIT. IX1154.2 +062200 IX1154.2 +062300 SECT-IX115A-0003 SECTION. IX1154.2 +062400 SEQ-INIT-010. IX1154.2 +062500 MOVE ZERO TO TEST-NO. IX1154.2 +062600 MOVE "IX-FS3" TO XFILE-NAME (1). IX1154.2 +062700 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1154.2 +062800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1154.2 +062900 MOVE 000240 TO XRECORD-LENGTH (1). IX1154.2 +063000 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1154.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). IX1154.2 +063200 MOVE 000050 TO RECORDS-IN-FILE (1). IX1154.2 +063300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1154.2 +063400 MOVE "S" TO XLABEL-TYPE (1). IX1154.2 +063500 MOVE 000001 TO XRECORD-NUMBER (1). IX1154.2 +063600 MOVE 0 TO COUNT-OF-RECS. IX1154.2 +063700 IX1154.2 +063800******************************************************************IX1154.2 +063900* TEST 1 *IX1154.2 +064000* OPEN I-O IX1154.2 +064100* IX-3, 1.3.4 (1) A *IX1154.2 +064200* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1154.2 +064300* THE OPEN STATEMENT IS SUCCESSFULLY EXECUTED *IX1154.2 +064400******************************************************************IX1154.2 +064500 OPN-INIT-GF-01-0. IX1154.2 +064600 MOVE 1 TO STATUS-TEST-00. IX1154.2 +064700 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +064800 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1154.2 +064900 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +065000 OPEN IX1154.2 +065100 I-O IX-FS3. IX1154.2 +065200 IF IX-FS3-STATUS EQUAL TO "00" IX1154.2 +065300 GO TO OPN-PASS-GF-01-0. IX1154.2 +065400 OPN-FAIL-GF-01-0. IX1154.2 +065500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1154.2 +065600 PERFORM FAIL. IX1154.2 +065700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +065800 MOVE "00" TO CORRECT-X. IX1154.2 +065900 GO TO OPN-WRITE-GF-01-0. IX1154.2 +066000 OPN-PASS-GF-01-0. IX1154.2 +066100 PERFORM PASS. IX1154.2 +066200 OPN-WRITE-GF-01-0. IX1154.2 +066300 PERFORM PRINT-DETAIL. IX1154.2 +066400******************************************************************IX1154.2 +066500* TEST 4 *IX1154.2 +066600* CLOSE I-O 00 EXPECTED *IX1154.2 +066700* IX-3, 1.3.4 (1) A *IX1154.2 +066800******************************************************************IX1154.2 +066900 CLO-INIT-GF-01-0. IX1154.2 +067000 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +067100 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1154.2 +067200 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +067300 CLO-TEST-GF-01-0. IX1154.2 +067400 CLOSE IX-FS3. IX1154.2 +067500 IF IX-FS3-STATUS = "00" IX1154.2 +067600 GO TO CLO-PASS-GF-01-0. IX1154.2 +067700 CLO-FAIL-GF-01-0. IX1154.2 +067800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1154.2 +067900 PERFORM FAIL. IX1154.2 +068000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +068100 MOVE "00" TO CORRECT-X. IX1154.2 +068200 GO TO CLO-WRITE-GF-01-0. IX1154.2 +068300 CLO-PASS-GF-01-0. IX1154.2 +068400 PERFORM PASS. IX1154.2 +068500 CLO-WRITE-GF-01-0. IX1154.2 +068600 PERFORM PRINT-DETAIL. IX1154.2 +068700 IX1154.2 +068800******************************************************************IX1154.2 +068900* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1154.2 +069000******************************************************************IX1154.2 +069100 IX1154.2 +069200******************************************************************IX1154.2 +069300* TEST 5 *IX1154.2 +069400* WRITE... A FILE NOT IN THE OPEN MODE *IX1154.2 +069500* FILE STATUS 48 EXPECTED IX-5, 1.3.4 (5) G *IX1154.2 +069600******************************************************************IX1154.2 +069700 WRI-TEST-GF-01-0. IX1154.2 +069800 MOVE 5 TO TEST-NO. IX1154.2 +069900 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +070000 MOVE "WRITE. 48 EXP." TO FEATURE IX1154.2 +070100 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +070200 WRITE IX-FS3R1-F-G-240. IX1154.2 +070300 WRI-TEST-GF-01-1. IX1154.2 +070400 IF IX-FS3-STATUS EQUAL TO "48" IX1154.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1154.2 +070600 TO RE-MARK IX1154.2 +070700 GO TO WRI-WRITE-GF-01-0. IX1154.2 +070800 WRI-FAIL-GF-01-0. IX1154.2 +070900 MOVE "IX-5, 1.3.4, (5) G" TO RE-MARK. IX1154.2 +071000 WRI-WRITE-GF-01-0. IX1154.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +071200 MOVE "48" TO CORRECT-X. IX1154.2 +071300 PERFORM FAIL. IX1154.2 +071400 PERFORM PRINT-DETAIL. IX1154.2 +071500 IX1154.2 +071600 TERMINATE-ROUTINE. IX1154.2 +071700 EXIT. IX1154.2 +071800 IX1154.2 +071900 CCVS-EXIT SECTION. IX1154.2 +072000 CCVS-999999. IX1154.2 +072100 GO TO CLOSE-FILES. IX1154.2 +*END-OF,IX115A +*HEADER,COBOL,IX113A,SUBPRG,IX116A +000100 IDENTIFICATION DIVISION. IX1164.2 +000200 PROGRAM-ID. IX1164.2 +000300 IX116A. IX1164.2 +000400**************************************************************** IX1164.2 +000500* * IX1164.2 +000600* VALIDATION FOR:- * IX1164.2 +000700* * IX1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +000900* * IX1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1164.2 +001100* * IX1164.2 +001200**************************************************************** IX1164.2 +001300* IX1164.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1164.2 +001500* IX113A. IX1164.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1164.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN AN ATTEMPT IX1164.2 +001800* IS MADE TO DELETE A RECORD, AT WHICH POINT THE DECLARATIVES IX1164.2 +001900* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 49 . IX1164.2 +002000* IX1164.2 +002100* STANDARD REFERENCE IX-5, 1.3.4 (5) H IX1164.2 +002200* IX1164.2 +002300* X-CARDS USED IN THIS PROGRAM: IX1164.2 +002400* IX1164.2 +002500* XXXXX024 IX1164.2 +002600* XXXXX055. IX1164.2 +002700* P XXXXX062. IX1164.2 +002800* XXXXX082. IX1164.2 +002900* XXXXX083. IX1164.2 +003000* C XXXXX084 IX1164.2 +003100* IX1164.2 +003200* IX1164.2 +003300 ENVIRONMENT DIVISION. IX1164.2 +003400 CONFIGURATION SECTION. IX1164.2 +003500 SOURCE-COMPUTER. IX1164.2 +003600 XXXXX082. IX1164.2 +003700 OBJECT-COMPUTER. IX1164.2 +003800 XXXXX083. IX1164.2 +003900 INPUT-OUTPUT SECTION. IX1164.2 +004000 FILE-CONTROL. IX1164.2 +004100P SELECT RAW-DATA ASSIGN TO IX1164.2 +004200P XXXXX062 IX1164.2 +004300P ORGANIZATION IS INDEXED IX1164.2 +004400P ACCESS MODE IS RANDOM IX1164.2 +004500P RECORD KEY IS RAW-DATA-KEY. IX1164.2 +004600* IX1164.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1164.2 +004800 XXXXX055. IX1164.2 +004900* IX1164.2 +005000 SELECT IX-FS3 ASSIGN IX1164.2 +005100 XXXXX024 IX1164.2 +005200 ORGANIZATION IS INDEXED IX1164.2 +005300 ACCESS MODE IS SEQUENTIAL IX1164.2 +005400 RECORD KEY IS IX-FS3-KEY IX1164.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1164.2 +005600 IX1164.2 +005700 DATA DIVISION. IX1164.2 +005800 IX1164.2 +005900 FILE SECTION. IX1164.2 +006000P IX1164.2 +006100PFD RAW-DATA. IX1164.2 +006200P IX1164.2 +006300P01 RAW-DATA-SATZ. IX1164.2 +006400P 05 RAW-DATA-KEY PIC X(6). IX1164.2 +006500P 05 C-DATE PIC 9(6). IX1164.2 +006600P 05 C-TIME PIC 9(8). IX1164.2 +006700P 05 C-NO-OF-TESTS PIC 99. IX1164.2 +006800P 05 C-OK PIC 999. IX1164.2 +006900P 05 C-ALL PIC 999. IX1164.2 +007000P 05 C-FAIL PIC 999. IX1164.2 +007100P 05 C-DELETED PIC 999. IX1164.2 +007200P 05 C-INSPECT PIC 999. IX1164.2 +007300P 05 C-NOTE PIC X(13). IX1164.2 +007400P 05 C-INDENT PIC X. IX1164.2 +007500P 05 C-ABORT PIC X(8). IX1164.2 +007600 IX1164.2 +007700 FD PRINT-FILE. IX1164.2 +007800 IX1164.2 +007900 01 PRINT-REC PIC X(120). IX1164.2 +008000 IX1164.2 +008100 01 DUMMY-RECORD PIC X(120). IX1164.2 +008200 IX1164.2 +008300 FD IX-FS3 IX1164.2 +008400C DATA RECORDS IX-FS3R1-F-G-240 IX1164.2 +008500C LABEL RECORD STANDARD IX1164.2 +008600 RECORD 240 IX1164.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1164.2 +008800 IX1164.2 +008900 01 IX-FS3R1-F-G-240. IX1164.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1164.2 +009100 05 IX-FS3-REC-120-240. IX1164.2 +009200 10 FILLER PIC X(8). IX1164.2 +009300 10 IX-FS3-KEY PIC X(29). IX1164.2 +009400 10 FILLER PIC X(9). IX1164.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1164.2 +009600 10 FILLER PIC X(45). IX1164.2 +009700 IX1164.2 +009800 IX1164.2 +009900 WORKING-STORAGE SECTION. IX1164.2 +010000 IX1164.2 +010100 01 GRP-0101. IX1164.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1164.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1164.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1164.2 +010500 IX1164.2 +010600 01 GRP-0102. IX1164.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1164.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1164.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1164.2 +011000 IX1164.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1164.2 +011200 IX1164.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1164.2 +011400 IX1164.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1164.2 +011600 IX1164.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1164.2 +011800 IX1164.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1164.2 +012000 IX1164.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1164.2 +012200 IX1164.2 +012300 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1164.2 +012400 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1164.2 +012500 IX1164.2 +012600 01 IX-FS3-STATUS. IX1164.2 +012700 05 IX-FS3-STAT1 PIC X. IX1164.2 +012800 05 IX-FS3-STAT2 PIC X. IX1164.2 +012900 IX1164.2 +013000 01 COUNT-OF-RECS PIC 9(5). IX1164.2 +013100 IX1164.2 +013200 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1164.2 +013300 IX1164.2 +013400 01 FILE-RECORD-INFORMATION-REC. IX1164.2 +013500 05 FILE-RECORD-INFO-SKELETON. IX1164.2 +013600 10 FILLER PIC X(48) VALUE IX1164.2 +013700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1164.2 +013800 10 FILLER PIC X(46) VALUE IX1164.2 +013900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1164.2 +014000 10 FILLER PIC X(26) VALUE IX1164.2 +014100 ",LFIL=000000,ORG= ,LBLR= ". IX1164.2 +014200 10 FILLER PIC X(37) VALUE IX1164.2 +014300 ",RECKEY= ". IX1164.2 +014400 10 FILLER PIC X(38) VALUE IX1164.2 +014500 ",ALTKEY1= ". IX1164.2 +014600 10 FILLER PIC X(38) VALUE IX1164.2 +014700 ",ALTKEY2= ". IX1164.2 +014800 10 FILLER PIC X(7) VALUE SPACE. IX1164.2 +014900 05 FILE-RECORD-INFO OCCURS 10. IX1164.2 +015000 10 FILE-RECORD-INFO-P1-120. IX1164.2 +015100 15 FILLER PIC X(5). IX1164.2 +015200 15 XFILE-NAME PIC X(6). IX1164.2 +015300 15 FILLER PIC X(8). IX1164.2 +015400 15 XRECORD-NAME PIC X(6). IX1164.2 +015500 15 FILLER PIC X(1). IX1164.2 +015600 15 REELUNIT-NUMBER PIC 9(1). IX1164.2 +015700 15 FILLER PIC X(7). IX1164.2 +015800 15 XRECORD-NUMBER PIC 9(6). IX1164.2 +015900 15 FILLER PIC X(6). IX1164.2 +016000 15 UPDATE-NUMBER PIC 9(2). IX1164.2 +016100 15 FILLER PIC X(5). IX1164.2 +016200 15 ODO-NUMBER PIC 9(4). IX1164.2 +016300 15 FILLER PIC X(5). IX1164.2 +016400 15 XPROGRAM-NAME PIC X(5). IX1164.2 +016500 15 FILLER PIC X(7). IX1164.2 +016600 15 XRECORD-LENGTH PIC 9(6). IX1164.2 +016700 15 FILLER PIC X(7). IX1164.2 +016800 15 CHARS-OR-RECORDS PIC X(2). IX1164.2 +016900 15 FILLER PIC X(1). IX1164.2 +017000 15 XBLOCK-SIZE PIC 9(4). IX1164.2 +017100 15 FILLER PIC X(6). IX1164.2 +017200 15 RECORDS-IN-FILE PIC 9(6). IX1164.2 +017300 15 FILLER PIC X(5). IX1164.2 +017400 15 XFILE-ORGANIZATION PIC X(2). IX1164.2 +017500 15 FILLER PIC X(6). IX1164.2 +017600 15 XLABEL-TYPE PIC X(1). IX1164.2 +017700 10 FILE-RECORD-INFO-P121-240. IX1164.2 +017800 15 FILLER PIC X(8). IX1164.2 +017900 15 XRECORD-KEY PIC X(29). IX1164.2 +018000 15 FILLER PIC X(9). IX1164.2 +018100 15 ALTERNATE-KEY1 PIC X(29). IX1164.2 +018200 15 FILLER PIC X(9). IX1164.2 +018300 15 ALTERNATE-KEY2 PIC X(29). IX1164.2 +018400 15 FILLER PIC X(7). IX1164.2 +018500 IX1164.2 +018600 01 TEST-RESULTS. IX1164.2 +018700 02 FILLER PIC X VALUE SPACE. IX1164.2 +018800 02 FEATURE PIC X(20) VALUE SPACE. IX1164.2 +018900 02 FILLER PIC X VALUE SPACE. IX1164.2 +019000 02 P-OR-F PIC X(5) VALUE SPACE. IX1164.2 +019100 02 FILLER PIC X VALUE SPACE. IX1164.2 +019200 02 PAR-NAME. IX1164.2 +019300 03 FILLER PIC X(19) VALUE SPACE. IX1164.2 +019400 03 PARDOT-X PIC X VALUE SPACE. IX1164.2 +019500 03 DOTVALUE PIC 99 VALUE ZERO. IX1164.2 +019600 02 FILLER PIC X(8) VALUE SPACE. IX1164.2 +019700 02 RE-MARK PIC X(61). IX1164.2 +019800 01 TEST-COMPUTED. IX1164.2 +019900 02 FILLER PIC X(30) VALUE SPACE. IX1164.2 +020000 02 FILLER PIC X(17) VALUE IX1164.2 +020100 " COMPUTED=". IX1164.2 +020200 02 COMPUTED-X. IX1164.2 +020300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1164.2 +020400 03 COMPUTED-N REDEFINES COMPUTED-A IX1164.2 +020500 PIC -9(9).9(9). IX1164.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1164.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1164.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1164.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. IX1164.2 +021000 04 COMPUTED-18V0 PIC -9(18). IX1164.2 +021100 04 FILLER PIC X. IX1164.2 +021200 03 FILLER PIC X(50) VALUE SPACE. IX1164.2 +021300 01 TEST-CORRECT. IX1164.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1164.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1164.2 +021600 02 CORRECT-X. IX1164.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1164.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1164.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1164.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1164.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1164.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. IX1164.2 +022300 04 CORRECT-18V0 PIC -9(18). IX1164.2 +022400 04 FILLER PIC X. IX1164.2 +022500 03 FILLER PIC X(2) VALUE SPACE. IX1164.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1164.2 +022700 01 CCVS-C-1. IX1164.2 +022800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1164.2 +022900- "SS PARAGRAPH-NAME IX1164.2 +023000- " REMARKS". IX1164.2 +023100 02 FILLER PIC X(20) VALUE SPACE. IX1164.2 +023200 01 CCVS-C-2. IX1164.2 +023300 02 FILLER PIC X VALUE SPACE. IX1164.2 +023400 02 FILLER PIC X(6) VALUE "TESTED". IX1164.2 +023500 02 FILLER PIC X(15) VALUE SPACE. IX1164.2 +023600 02 FILLER PIC X(4) VALUE "FAIL". IX1164.2 +023700 02 FILLER PIC X(94) VALUE SPACE. IX1164.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1164.2 +023900 01 REC-CT PIC 99 VALUE ZERO. IX1164.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1164.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1164.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1164.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1164.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1164.2 +024900 01 CCVS-H-1. IX1164.2 +025000 02 FILLER PIC X(39) VALUE SPACES. IX1164.2 +025100 02 FILLER PIC X(42) VALUE IX1164.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1164.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1164.2 +025400 01 CCVS-H-2A. IX1164.2 +025500 02 FILLER PIC X(40) VALUE SPACE. IX1164.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1164.2 +025700 02 FILLER PIC XXXX VALUE IX1164.2 +025800 "4.2 ". IX1164.2 +025900 02 FILLER PIC X(28) VALUE IX1164.2 +026000 " COPY - NOT FOR DISTRIBUTION". IX1164.2 +026100 02 FILLER PIC X(41) VALUE SPACE. IX1164.2 +026200 IX1164.2 +026300 01 CCVS-H-2B. IX1164.2 +026400 02 FILLER PIC X(15) VALUE IX1164.2 +026500 "TEST RESULT OF ". IX1164.2 +026600 02 TEST-ID PIC X(9). IX1164.2 +026700 02 FILLER PIC X(4) VALUE IX1164.2 +026800 " IN ". IX1164.2 +026900 02 FILLER PIC X(12) VALUE IX1164.2 +027000 " HIGH ". IX1164.2 +027100 02 FILLER PIC X(22) VALUE IX1164.2 +027200 " LEVEL VALIDATION FOR ". IX1164.2 +027300 02 FILLER PIC X(58) VALUE IX1164.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +027500 01 CCVS-H-3. IX1164.2 +027600 02 FILLER PIC X(34) VALUE IX1164.2 +027700 " FOR OFFICIAL USE ONLY ". IX1164.2 +027800 02 FILLER PIC X(58) VALUE IX1164.2 +027900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1164.2 +028000 02 FILLER PIC X(28) VALUE IX1164.2 +028100 " COPYRIGHT 1985 ". IX1164.2 +028200 01 CCVS-E-1. IX1164.2 +028300 02 FILLER PIC X(52) VALUE SPACE. IX1164.2 +028400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1164.2 +028500 02 ID-AGAIN PIC X(9). IX1164.2 +028600 02 FILLER PIC X(45) VALUE SPACES. IX1164.2 +028700 01 CCVS-E-2. IX1164.2 +028800 02 FILLER PIC X(31) VALUE SPACE. IX1164.2 +028900 02 FILLER PIC X(21) VALUE SPACE. IX1164.2 +029000 02 CCVS-E-2-2. IX1164.2 +029100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1164.2 +029200 03 FILLER PIC X VALUE SPACE. IX1164.2 +029300 03 ENDER-DESC PIC X(44) VALUE IX1164.2 +029400 "ERRORS ENCOUNTERED". IX1164.2 +029500 01 CCVS-E-3. IX1164.2 +029600 02 FILLER PIC X(22) VALUE IX1164.2 +029700 " FOR OFFICIAL USE ONLY". IX1164.2 +029800 02 FILLER PIC X(12) VALUE SPACE. IX1164.2 +029900 02 FILLER PIC X(58) VALUE IX1164.2 +030000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +030100 02 FILLER PIC X(13) VALUE SPACE. IX1164.2 +030200 02 FILLER PIC X(15) VALUE IX1164.2 +030300 " COPYRIGHT 1985". IX1164.2 +030400 01 CCVS-E-4. IX1164.2 +030500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1164.2 +030600 02 FILLER PIC X(4) VALUE " OF ". IX1164.2 +030700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1164.2 +030800 02 FILLER PIC X(40) VALUE IX1164.2 +030900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1164.2 +031000 01 XXINFO. IX1164.2 +031100 02 FILLER PIC X(19) VALUE IX1164.2 +031200 "*** INFORMATION ***". IX1164.2 +031300 02 INFO-TEXT. IX1164.2 +031400 04 FILLER PIC X(8) VALUE SPACE. IX1164.2 +031500 04 XXCOMPUTED PIC X(20). IX1164.2 +031600 04 FILLER PIC X(5) VALUE SPACE. IX1164.2 +031700 04 XXCORRECT PIC X(20). IX1164.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). IX1164.2 +031900 01 HYPHEN-LINE. IX1164.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. IX1164.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************IX1164.2 +032200- "*****************************************". IX1164.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************IX1164.2 +032400- "******************************". IX1164.2 +032500 01 TEST-NO PIC 99. IX1164.2 +032600 01 CCVS-PGM-ID PIC X(9) VALUE IX1164.2 +032700 "IX116A". IX1164.2 +032800 PROCEDURE DIVISION. IX1164.2 +032900 DECLARATIVES. IX1164.2 +033000 IX1164.2 +033100 SECT-IX105-0002 SECTION. IX1164.2 +033200 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1164.2 +033300 INPUT-PROCESS. IX1164.2 +033400 IF TEST-NO = 5 IX1164.2 +033500 GO TO D-C-TEST-GF-01-1. IX1164.2 +033600 IF STATUS-TEST-10 EQUAL TO 1 IX1164.2 +033700 IF IX-FS3-STAT1 EQUAL TO "1" IX1164.2 +033800 MOVE 1 TO EOF-FLAG IX1164.2 +033900 ELSE IX1164.2 +034000 IF IX-FS3-STAT1 GREATER THAN "1" IX1164.2 +034100 MOVE 1 TO PERM-ERRORS. IX1164.2 +034200 GO TO DECL-EXIT. IX1164.2 +034300 D-C-TEST-GF-01-1. IX1164.2 +034400 IF IX-FS3-STATUS EQUAL TO "49" IX1164.2 +034500 GO TO D-C-PASS-GF-01-0. IX1164.2 +034600 D-C-FAIL-GF-01-0. IX1164.2 +034700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +034800 MOVE "49" TO CORRECT-X. IX1164.2 +034900 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1164.2 +035000 PERFORM D-FAIL. IX1164.2 +035100 GO TO D-C-WRITE-GF-01-0. IX1164.2 +035200 D-C-PASS-GF-01-0. IX1164.2 +035300 PERFORM D-PASS. IX1164.2 +035400 D-C-WRITE-GF-01-0. IX1164.2 +035500 PERFORM D-PRINT-DETAIL. IX1164.2 +035600 D-CLOSE-FILES. IX1164.2 +035700P OPEN I-O RAW-DATA. IX1164.2 +035800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +035900P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1164.2 +036000P MOVE "OK. " TO C-ABORT. IX1164.2 +036100P MOVE PASS-COUNTER TO C-OK. IX1164.2 +036200P MOVE ERROR-HOLD TO C-ALL. IX1164.2 +036300P MOVE ERROR-COUNTER TO C-FAIL. IX1164.2 +036400P MOVE DELETE-COUNTER TO C-DELETED. IX1164.2 +036500P MOVE INSPECT-COUNTER TO C-INSPECT. IX1164.2 +036600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1164.2 +036700PD-END-E-2. IX1164.2 +036800P CLOSE RAW-DATA. IX1164.2 +036900 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1164.2 +037000 CLOSE PRINT-FILE. IX1164.2 +037100 D-TERMINATE-CCVS. IX1164.2 +037200S EXIT PROGRAM. IX1164.2 +037300SD-TERMINATE-CALL. IX1164.2 +037400 STOP RUN. IX1164.2 +037500 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1164.2 +037600 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1164.2 +037700 D-PRINT-DETAIL. IX1164.2 +037800 IF REC-CT NOT EQUAL TO ZERO IX1164.2 +037900 MOVE "." TO PARDOT-X IX1164.2 +038000 MOVE REC-CT TO DOTVALUE. IX1164.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. IX1164.2 +038200 PERFORM D-WRITE-LINE. IX1164.2 +038300 IF P-OR-F EQUAL TO "FAIL*" IX1164.2 +038400 PERFORM D-WRITE-LINE IX1164.2 +038500 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1164.2 +038600 ELSE IX1164.2 +038700 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1164.2 +038800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1164.2 +038900 MOVE SPACE TO CORRECT-X. IX1164.2 +039000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1164.2 +039100 MOVE SPACE TO RE-MARK. IX1164.2 +039200 D-END-ROUTINE. IX1164.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1164.2 +039400 PERFORM D-WRITE-LINE 5 TIMES. IX1164.2 +039500 D-END-RTN-EXIT. IX1164.2 +039600 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1164.2 +039700 PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +039800 D-END-ROUTINE-1. IX1164.2 +039900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1164.2 +040000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1164.2 +040100 ADD PASS-COUNTER TO ERROR-HOLD. IX1164.2 +040200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1164.2 +040300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1164.2 +040400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1164.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1164.2 +040600 D-END-ROUTINE-12. IX1164.2 +040700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1164.2 +040800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1164.2 +040900 MOVE "NO " TO ERROR-TOTAL IX1164.2 +041000 ELSE IX1164.2 +041100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1164.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +041300 PERFORM D-WRITE-LINE. IX1164.2 +041400 D-END-ROUTINE-13. IX1164.2 +041500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1164.2 +041600 MOVE "NO " TO ERROR-TOTAL ELSE IX1164.2 +041700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1164.2 +041800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1164.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +042000 PERFORM D-WRITE-LINE. IX1164.2 +042100 IF INSPECT-COUNTER EQUAL TO ZERO IX1164.2 +042200 MOVE "NO " TO ERROR-TOTAL IX1164.2 +042300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1164.2 +042400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1164.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1164.2 +042600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1164.2 +042700 D-WRITE-LINE. IX1164.2 +042800 ADD 1 TO RECORD-COUNT. IX1164.2 +042900Y IF RECORD-COUNT GREATER 42 IX1164.2 +043000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1164.2 +043100Y MOVE SPACE TO DUMMY-RECORD IX1164.2 +043200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1164.2 +043300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1164.2 +043400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1164.2 +043500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1164.2 +043600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1164.2 +043700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +043800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +043900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +044000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1164.2 +044100Y MOVE ZERO TO RECORD-COUNT. IX1164.2 +044200 PERFORM D-WRT-LN. IX1164.2 +044300 D-WRT-LN. IX1164.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1164.2 +044500 MOVE SPACE TO DUMMY-RECORD. IX1164.2 +044600 D-FAIL-ROUTINE. IX1164.2 +044700 IF COMPUTED-X NOT EQUAL TO SPACE IX1164.2 +044800 GO TO D-FAIL-ROUTINE-WRITE. IX1164.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1164.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1164.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +045400 GO TO D-FAIL-ROUTINE-EX. IX1164.2 +045500 D-FAIL-ROUTINE-WRITE. IX1164.2 +045600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1164.2 +045700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1164.2 +045800 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +045900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1164.2 +046000 D-FAIL-ROUTINE-EX. EXIT. IX1164.2 +046100 D-BAIL-OUT. IX1164.2 +046200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1164.2 +046300 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1164.2 +046400 D-BAIL-OUT-WRITE. IX1164.2 +046500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1164.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +046700 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +046800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +046900 D-BAIL-OUT-EX. EXIT. IX1164.2 +047000 DECL-EXIT. EXIT. IX1164.2 +047100 END DECLARATIVES. IX1164.2 +047200 IX1164.2 +047300 IX1164.2 +047400 CCVS1 SECTION. IX1164.2 +047500 OPEN-FILES. IX1164.2 +047600P OPEN I-O RAW-DATA. IX1164.2 +047700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +047800P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1164.2 +047900P MOVE "ABORTED " TO C-ABORT. IX1164.2 +048000P ADD 1 TO C-NO-OF-TESTS. IX1164.2 +048100P ACCEPT C-DATE FROM DATE. IX1164.2 +048200P ACCEPT C-TIME FROM TIME. IX1164.2 +048300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1164.2 +048400PEND-E-1. IX1164.2 +048500P CLOSE RAW-DATA. IX1164.2 +048600 OPEN OUTPUT PRINT-FILE. IX1164.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1164.2 +048800 MOVE SPACE TO TEST-RESULTS. IX1164.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1164.2 +049000 MOVE ZERO TO REC-SKL-SUB. IX1164.2 +049100 PERFORM CCVS-INIT-FILE 9 TIMES. IX1164.2 +049200 CCVS-INIT-FILE. IX1164.2 +049300 ADD 1 TO REC-SKL-SUB. IX1164.2 +049400 MOVE FILE-RECORD-INFO-SKELETON IX1164.2 +049500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1164.2 +049600 CCVS-INIT-EXIT. IX1164.2 +049700 GO TO CCVS1-EXIT. IX1164.2 +049800 CLOSE-FILES. IX1164.2 +049900P OPEN I-O RAW-DATA. IX1164.2 +050000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +050100P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1164.2 +050200P MOVE "OK. " TO C-ABORT. IX1164.2 +050300P MOVE PASS-COUNTER TO C-OK. IX1164.2 +050400P MOVE ERROR-HOLD TO C-ALL. IX1164.2 +050500P MOVE ERROR-COUNTER TO C-FAIL. IX1164.2 +050600P MOVE DELETE-COUNTER TO C-DELETED. IX1164.2 +050700P MOVE INSPECT-COUNTER TO C-INSPECT. IX1164.2 +050800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1164.2 +050900PEND-E-2. IX1164.2 +051000P CLOSE RAW-DATA. IX1164.2 +051100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1164.2 +051200 TERMINATE-CCVS. IX1164.2 +051300S EXIT PROGRAM. IX1164.2 +051400STERMINATE-CALL. IX1164.2 +051500 STOP RUN. IX1164.2 +051600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1164.2 +051700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1164.2 +051800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1164.2 +051900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1164.2 +052000 MOVE "****TEST DELETED****" TO RE-MARK. IX1164.2 +052100 PRINT-DETAIL. IX1164.2 +052200 IF REC-CT NOT EQUAL TO ZERO IX1164.2 +052300 MOVE "." TO PARDOT-X IX1164.2 +052400 MOVE REC-CT TO DOTVALUE. IX1164.2 +052500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1164.2 +052600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1164.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1164.2 +052800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1164.2 +052900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1164.2 +053000 MOVE SPACE TO CORRECT-X. IX1164.2 +053100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1164.2 +053200 MOVE SPACE TO RE-MARK. IX1164.2 +053300 HEAD-ROUTINE. IX1164.2 +053400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +053500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +053600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1164.2 +053700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1164.2 +053800 COLUMN-NAMES-ROUTINE. IX1164.2 +053900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +054000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +054200 END-ROUTINE. IX1164.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1164.2 +054400 END-RTN-EXIT. IX1164.2 +054500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +054600 END-ROUTINE-1. IX1164.2 +054700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1164.2 +054800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1164.2 +054900 ADD PASS-COUNTER TO ERROR-HOLD. IX1164.2 +055000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1164.2 +055100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1164.2 +055200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1164.2 +055300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1164.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1164.2 +055500 END-ROUTINE-12. IX1164.2 +055600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1164.2 +055700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1164.2 +055800 MOVE "NO " TO ERROR-TOTAL IX1164.2 +055900 ELSE IX1164.2 +056000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1164.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +056200 PERFORM WRITE-LINE. IX1164.2 +056300 END-ROUTINE-13. IX1164.2 +056400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1164.2 +056500 MOVE "NO " TO ERROR-TOTAL ELSE IX1164.2 +056600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1164.2 +056700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1164.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +056900 IF INSPECT-COUNTER EQUAL TO ZERO IX1164.2 +057000 MOVE "NO " TO ERROR-TOTAL IX1164.2 +057100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1164.2 +057200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1164.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +057400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +057500 WRITE-LINE. IX1164.2 +057600 ADD 1 TO RECORD-COUNT. IX1164.2 +057700Y IF RECORD-COUNT GREATER 42 IX1164.2 +057800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1164.2 +057900Y MOVE SPACE TO DUMMY-RECORD IX1164.2 +058000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1164.2 +058100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1164.2 +058200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1164.2 +058300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1164.2 +058400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1164.2 +058500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1164.2 +058900Y MOVE ZERO TO RECORD-COUNT. IX1164.2 +059000 PERFORM WRT-LN. IX1164.2 +059100 WRT-LN. IX1164.2 +059200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1164.2 +059300 MOVE SPACE TO DUMMY-RECORD. IX1164.2 +059400 BLANK-LINE-PRINT. IX1164.2 +059500 PERFORM WRT-LN. IX1164.2 +059600 FAIL-ROUTINE. IX1164.2 +059700 IF COMPUTED-X NOT EQUAL TO SPACE IX1164.2 +059800 GO TO FAIL-ROUTINE-WRITE. IX1164.2 +059900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1164.2 +060000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +060100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1164.2 +060200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +060300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +060400 GO TO FAIL-ROUTINE-EX. IX1164.2 +060500 FAIL-ROUTINE-WRITE. IX1164.2 +060600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1164.2 +060700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1164.2 +060800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1164.2 +060900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1164.2 +061000 FAIL-ROUTINE-EX. EXIT. IX1164.2 +061100 BAIL-OUT. IX1164.2 +061200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1164.2 +061300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1164.2 +061400 BAIL-OUT-WRITE. IX1164.2 +061500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1164.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +061700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +061800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +061900 BAIL-OUT-EX. EXIT. IX1164.2 +062000 CCVS1-EXIT. IX1164.2 +062100 EXIT. IX1164.2 +062200 IX1164.2 +062300 SECT-IX116A-0003 SECTION. IX1164.2 +062400 SEQ-INIT-010. IX1164.2 +062500 MOVE ZERO TO TEST-NO. IX1164.2 +062600 MOVE "IX-FS3" TO XFILE-NAME (1). IX1164.2 +062700 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1164.2 +062800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1164.2 +062900 MOVE 000240 TO XRECORD-LENGTH (1). IX1164.2 +063000 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1164.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). IX1164.2 +063200 MOVE 000050 TO RECORDS-IN-FILE (1). IX1164.2 +063300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1164.2 +063400 MOVE "S" TO XLABEL-TYPE (1). IX1164.2 +063500 MOVE 000001 TO XRECORD-NUMBER (1). IX1164.2 +063600 MOVE 0 TO COUNT-OF-RECS. IX1164.2 +063700 IX1164.2 +063800******************************************************************IX1164.2 +063900* TEST 1 *IX1164.2 +064000* OPEN OUTPUT ... 00 EXPECTED *IX1164.2 +064100* IX-3, 1.3.4 (1) A *IX1164.2 +064200* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1164.2 +064300* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1164.2 +064400******************************************************************IX1164.2 +064500 OPN-INIT-GF-01-0. IX1164.2 +064600 MOVE 1 TO STATUS-TEST-00. IX1164.2 +064700 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +064800 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1164.2 +064900 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +065000 OPEN IX1164.2 +065100 I-O IX-FS3. IX1164.2 +065200 IF IX-FS3-STATUS EQUAL TO "00" IX1164.2 +065300 GO TO OPN-PASS-GF-01-0. IX1164.2 +065400 OPN-FAIL-GF-01-0. IX1164.2 +065500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1164.2 +065600 PERFORM FAIL. IX1164.2 +065700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +065800 MOVE "00" TO CORRECT-X. IX1164.2 +065900 GO TO OPN-WRITE-GF-01-0. IX1164.2 +066000 OPN-PASS-GF-01-0. IX1164.2 +066100 PERFORM PASS. IX1164.2 +066200 OPN-WRITE-GF-01-0. IX1164.2 +066300 PERFORM PRINT-DETAIL. IX1164.2 +066400******************************************************************IX1164.2 +066500* TEST 4 *IX1164.2 +066600* CLOSE I-O 00 EXPECTED *IX1164.2 +066700* IX-3, 1.3.4 (1) A *IX1164.2 +066800******************************************************************IX1164.2 +066900 CLO-INIT-GF-01-0. IX1164.2 +067000 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +067100 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1164.2 +067200 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +067300 CLO-TEST-GF-01-0. IX1164.2 +067400 CLOSE IX-FS3. IX1164.2 +067500 IF IX-FS3-STATUS = "00" IX1164.2 +067600 GO TO CLO-PASS-GF-01-0. IX1164.2 +067700 CLO-FAIL-GF-01-0. IX1164.2 +067800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1164.2 +067900 PERFORM FAIL. IX1164.2 +068000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +068100 MOVE "00" TO CORRECT-X. IX1164.2 +068200 GO TO CLO-WRITE-GF-01-0. IX1164.2 +068300 CLO-PASS-GF-01-0. IX1164.2 +068400 PERFORM PASS. IX1164.2 +068500 CLO-WRITE-GF-01-0. IX1164.2 +068600 PERFORM PRINT-DETAIL. IX1164.2 +068700 IX1164.2 +068800******************************************************************IX1164.2 +068900* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1164.2 +069000******************************************************************IX1164.2 +069100 IX1164.2 +069200******************************************************************IX1164.2 +069300* TEST 5 *IX1164.2 +069400* DELETE.... FILE NOT IN THE OPEN MODE *IX1164.2 +069500* FILE STATUS 49 EXPECTED IX-5, 1.3.4 (5) H *IX1164.2 +069600******************************************************************IX1164.2 +069700 DEL-TEST-GF-01-0. IX1164.2 +069800 MOVE 5 TO TEST-NO. IX1164.2 +069900 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +070000 MOVE "DELETE 49 EXP." TO FEATURE IX1164.2 +070100 MOVE "DEL-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +070200 DELETE IX-FS3 RECORD. IX1164.2 +070300 DEL-TEST-GF-01-1. IX1164.2 +070400 IF IX-FS3-STATUS EQUAL TO "49" IX1164.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1164.2 +070600 TO RE-MARK IX1164.2 +070700 GO TO DEL-WRITE-GF-01-0. IX1164.2 +070800 DEL-FAIL-GF-01-0. IX1164.2 +070900 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1164.2 +071000 DEL-WRITE-GF-01-0. IX1164.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +071200 MOVE "49" TO CORRECT-X. IX1164.2 +071300 PERFORM FAIL. IX1164.2 +071400 PERFORM PRINT-DETAIL. IX1164.2 +071500 IX1164.2 +071600 TERMINATE-ROUTINE. IX1164.2 +071700 EXIT. IX1164.2 +071800 IX1164.2 +071900 CCVS-EXIT SECTION. IX1164.2 +072000 CCVS-999999. IX1164.2 +072100 GO TO CLOSE-FILES. IX1164.2 +*END-OF,IX116A +*HEADER,COBOL,IX113A,SUBPRG,IX117A +000100 IDENTIFICATION DIVISION. IX1174.2 +000200 PROGRAM-ID. IX1174.2 +000300 IX117A. IX1174.2 +000400**************************************************************** IX1174.2 +000500* * IX1174.2 +000600* VALIDATION FOR:- * IX1174.2 +000700* * IX1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +000900* * IX1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1174.2 +001100* * IX1174.2 +001200**************************************************************** IX1174.2 +001300* IX1174.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1174.2 +001500* IX113A. IX1174.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1174.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN AN ATTEMPT IX1174.2 +001800* IS MADE TO REWRITE A RECORD, AT WHICH POINT THE DECLARATIVES IX1174.2 +001900* SECTION SHOULD BE ACTIONED AND THE FILE STATUES SHOULD BE 49 IX1174.2 +002000* IX1174.2 +002100* IX1174.2 +002200* 4. X-CARDS USED IN THIS PROGRAM: IX1174.2 +002300* IX1174.2 +002400* XXXXX024 IX1174.2 +002500* XXXXX055. IX1174.2 +002600* P XXXXX062. IX1174.2 +002700* XXXXX082. IX1174.2 +002800* XXXXX083. IX1174.2 +002900* C XXXXX084 IX1174.2 +003000* IX1174.2 +003100* IX1174.2 +003200 ENVIRONMENT DIVISION. IX1174.2 +003300 CONFIGURATION SECTION. IX1174.2 +003400 SOURCE-COMPUTER. IX1174.2 +003500 XXXXX082. IX1174.2 +003600 OBJECT-COMPUTER. IX1174.2 +003700 XXXXX083. IX1174.2 +003800 INPUT-OUTPUT SECTION. IX1174.2 +003900 FILE-CONTROL. IX1174.2 +004000P SELECT RAW-DATA ASSIGN TO IX1174.2 +004100P XXXXX062 IX1174.2 +004200P ORGANIZATION IS INDEXED IX1174.2 +004300P ACCESS MODE IS RANDOM IX1174.2 +004400P RECORD KEY IS RAW-DATA-KEY. IX1174.2 +004500* IX1174.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1174.2 +004700 XXXXX055. IX1174.2 +004800* IX1174.2 +004900 SELECT IX-FS3 ASSIGN IX1174.2 +005000 XXXXX024 IX1174.2 +005100 ORGANIZATION IS INDEXED IX1174.2 +005200 ACCESS MODE IS SEQUENTIAL IX1174.2 +005300 RECORD KEY IS IX-FS3-KEY IX1174.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1174.2 +005500 IX1174.2 +005600 DATA DIVISION. IX1174.2 +005700 IX1174.2 +005800 FILE SECTION. IX1174.2 +005900P IX1174.2 +006000PFD RAW-DATA. IX1174.2 +006100P IX1174.2 +006200P01 RAW-DATA-SATZ. IX1174.2 +006300P 05 RAW-DATA-KEY PIC X(6). IX1174.2 +006400P 05 C-DATE PIC 9(6). IX1174.2 +006500P 05 C-TIME PIC 9(8). IX1174.2 +006600P 05 C-NO-OF-TESTS PIC 99. IX1174.2 +006700P 05 C-OK PIC 999. IX1174.2 +006800P 05 C-ALL PIC 999. IX1174.2 +006900P 05 C-FAIL PIC 999. IX1174.2 +007000P 05 C-DELETED PIC 999. IX1174.2 +007100P 05 C-INSPECT PIC 999. IX1174.2 +007200P 05 C-NOTE PIC X(13). IX1174.2 +007300P 05 C-INDENT PIC X. IX1174.2 +007400P 05 C-ABORT PIC X(8). IX1174.2 +007500 IX1174.2 +007600 FD PRINT-FILE. IX1174.2 +007700 IX1174.2 +007800 01 PRINT-REC PIC X(120). IX1174.2 +007900 IX1174.2 +008000 01 DUMMY-RECORD PIC X(120). IX1174.2 +008100 IX1174.2 +008200 FD IX-FS3 IX1174.2 +008300C DATA RECORDS IX-FS3R1-F-G-240 IX1174.2 +008400C LABEL RECORD STANDARD IX1174.2 +008500 RECORD 240 IX1174.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1174.2 +008700 IX1174.2 +008800 01 IX-FS3R1-F-G-240. IX1174.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1174.2 +009000 05 IX-FS3-REC-120-240. IX1174.2 +009100 10 FILLER PIC X(8). IX1174.2 +009200 10 IX-FS3-KEY PIC X(29). IX1174.2 +009300 10 FILLER PIC X(9). IX1174.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1174.2 +009500 10 FILLER PIC X(45). IX1174.2 +009600 IX1174.2 +009700 IX1174.2 +009800 WORKING-STORAGE SECTION. IX1174.2 +009900 IX1174.2 +010000 01 GRP-0101. IX1174.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1174.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1174.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1174.2 +010400 IX1174.2 +010500 01 GRP-0102. IX1174.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1174.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1174.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1174.2 +010900 IX1174.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1174.2 +011100 IX1174.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1174.2 +011300 IX1174.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1174.2 +011500 IX1174.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1174.2 +011700 IX1174.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1174.2 +011900 IX1174.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1174.2 +012100 IX1174.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1174.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1174.2 +012400 IX1174.2 +012500 01 IX-FS3-STATUS. IX1174.2 +012600 05 IX-FS3-STAT1 PIC X. IX1174.2 +012700 05 IX-FS3-STAT2 PIC X. IX1174.2 +012800 IX1174.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1174.2 +013000 IX1174.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1174.2 +013200 IX1174.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1174.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1174.2 +013500 10 FILLER PIC X(48) VALUE IX1174.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1174.2 +013700 10 FILLER PIC X(46) VALUE IX1174.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1174.2 +013900 10 FILLER PIC X(26) VALUE IX1174.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1174.2 +014100 10 FILLER PIC X(37) VALUE IX1174.2 +014200 ",RECKEY= ". IX1174.2 +014300 10 FILLER PIC X(38) VALUE IX1174.2 +014400 ",ALTKEY1= ". IX1174.2 +014500 10 FILLER PIC X(38) VALUE IX1174.2 +014600 ",ALTKEY2= ". IX1174.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1174.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1174.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1174.2 +015000 15 FILLER PIC X(5). IX1174.2 +015100 15 XFILE-NAME PIC X(6). IX1174.2 +015200 15 FILLER PIC X(8). IX1174.2 +015300 15 XRECORD-NAME PIC X(6). IX1174.2 +015400 15 FILLER PIC X(1). IX1174.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1174.2 +015600 15 FILLER PIC X(7). IX1174.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1174.2 +015800 15 FILLER PIC X(6). IX1174.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1174.2 +016000 15 FILLER PIC X(5). IX1174.2 +016100 15 ODO-NUMBER PIC 9(4). IX1174.2 +016200 15 FILLER PIC X(5). IX1174.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1174.2 +016400 15 FILLER PIC X(7). IX1174.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1174.2 +016600 15 FILLER PIC X(7). IX1174.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1174.2 +016800 15 FILLER PIC X(1). IX1174.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1174.2 +017000 15 FILLER PIC X(6). IX1174.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1174.2 +017200 15 FILLER PIC X(5). IX1174.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1174.2 +017400 15 FILLER PIC X(6). IX1174.2 +017500 15 XLABEL-TYPE PIC X(1). IX1174.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1174.2 +017700 15 FILLER PIC X(8). IX1174.2 +017800 15 XRECORD-KEY PIC X(29). IX1174.2 +017900 15 FILLER PIC X(9). IX1174.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1174.2 +018100 15 FILLER PIC X(9). IX1174.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1174.2 +018300 15 FILLER PIC X(7). IX1174.2 +018400 IX1174.2 +018500 01 TEST-RESULTS. IX1174.2 +018600 02 FILLER PIC X VALUE SPACE. IX1174.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1174.2 +018800 02 FILLER PIC X VALUE SPACE. IX1174.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1174.2 +019000 02 FILLER PIC X VALUE SPACE. IX1174.2 +019100 02 PAR-NAME. IX1174.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1174.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1174.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1174.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1174.2 +019600 02 RE-MARK PIC X(61). IX1174.2 +019700 01 TEST-COMPUTED. IX1174.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1174.2 +019900 02 FILLER PIC X(17) VALUE IX1174.2 +020000 " COMPUTED=". IX1174.2 +020100 02 COMPUTED-X. IX1174.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1174.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1174.2 +020400 PIC -9(9).9(9). IX1174.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1174.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1174.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1174.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1174.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1174.2 +021000 04 FILLER PIC X. IX1174.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1174.2 +021200 01 TEST-CORRECT. IX1174.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1174.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1174.2 +021500 02 CORRECT-X. IX1174.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1174.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1174.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1174.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1174.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1174.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1174.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1174.2 +022300 04 FILLER PIC X. IX1174.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1174.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1174.2 +022600 01 CCVS-C-1. IX1174.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1174.2 +022800- "SS PARAGRAPH-NAME IX1174.2 +022900- " REMARKS". IX1174.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1174.2 +023100 01 CCVS-C-2. IX1174.2 +023200 02 FILLER PIC X VALUE SPACE. IX1174.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1174.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1174.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1174.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1174.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1174.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1174.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1174.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1174.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1174.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1174.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1174.2 +024800 01 CCVS-H-1. IX1174.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1174.2 +025000 02 FILLER PIC X(42) VALUE IX1174.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1174.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1174.2 +025300 01 CCVS-H-2A. IX1174.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1174.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1174.2 +025600 02 FILLER PIC XXXX VALUE IX1174.2 +025700 "4.2 ". IX1174.2 +025800 02 FILLER PIC X(28) VALUE IX1174.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1174.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1174.2 +026100 IX1174.2 +026200 01 CCVS-H-2B. IX1174.2 +026300 02 FILLER PIC X(15) VALUE IX1174.2 +026400 "TEST RESULT OF ". IX1174.2 +026500 02 TEST-ID PIC X(9). IX1174.2 +026600 02 FILLER PIC X(4) VALUE IX1174.2 +026700 " IN ". IX1174.2 +026800 02 FILLER PIC X(12) VALUE IX1174.2 +026900 " HIGH ". IX1174.2 +027000 02 FILLER PIC X(22) VALUE IX1174.2 +027100 " LEVEL VALIDATION FOR ". IX1174.2 +027200 02 FILLER PIC X(58) VALUE IX1174.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +027400 01 CCVS-H-3. IX1174.2 +027500 02 FILLER PIC X(34) VALUE IX1174.2 +027600 " FOR OFFICIAL USE ONLY ". IX1174.2 +027700 02 FILLER PIC X(58) VALUE IX1174.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1174.2 +027900 02 FILLER PIC X(28) VALUE IX1174.2 +028000 " COPYRIGHT 1985 ". IX1174.2 +028100 01 CCVS-E-1. IX1174.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1174.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1174.2 +028400 02 ID-AGAIN PIC X(9). IX1174.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1174.2 +028600 01 CCVS-E-2. IX1174.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1174.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1174.2 +028900 02 CCVS-E-2-2. IX1174.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1174.2 +029100 03 FILLER PIC X VALUE SPACE. IX1174.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1174.2 +029300 "ERRORS ENCOUNTERED". IX1174.2 +029400 01 CCVS-E-3. IX1174.2 +029500 02 FILLER PIC X(22) VALUE IX1174.2 +029600 " FOR OFFICIAL USE ONLY". IX1174.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1174.2 +029800 02 FILLER PIC X(58) VALUE IX1174.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1174.2 +030100 02 FILLER PIC X(15) VALUE IX1174.2 +030200 " COPYRIGHT 1985". IX1174.2 +030300 01 CCVS-E-4. IX1174.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1174.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1174.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1174.2 +030700 02 FILLER PIC X(40) VALUE IX1174.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1174.2 +030900 01 XXINFO. IX1174.2 +031000 02 FILLER PIC X(19) VALUE IX1174.2 +031100 "*** INFORMATION ***". IX1174.2 +031200 02 INFO-TEXT. IX1174.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1174.2 +031400 04 XXCOMPUTED PIC X(20). IX1174.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1174.2 +031600 04 XXCORRECT PIC X(20). IX1174.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1174.2 +031800 01 HYPHEN-LINE. IX1174.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1174.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1174.2 +032100- "*****************************************". IX1174.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1174.2 +032300- "******************************". IX1174.2 +032400 01 TEST-NO PIC 99. IX1174.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1174.2 +032600 "IX117A". IX1174.2 +032700 PROCEDURE DIVISION. IX1174.2 +032800 DECLARATIVES. IX1174.2 +032900 IX1174.2 +033000 SECT-IX105-0002 SECTION. IX1174.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1174.2 +033200 INPUT-PROCESS. IX1174.2 +033300 IF TEST-NO = 5 IX1174.2 +033400 GO TO D-C-TEST-GF-01-1. IX1174.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1174.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1174.2 +033700 MOVE 1 TO EOF-FLAG IX1174.2 +033800 ELSE IX1174.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1174.2 +034000 MOVE 1 TO PERM-ERRORS. IX1174.2 +034100 GO TO DECL-EXIT. IX1174.2 +034200 D-C-TEST-GF-01-1. IX1174.2 +034300 IF IX-FS3-STATUS EQUAL TO "49" IX1174.2 +034400 GO TO D-C-PASS-GF-01-0. IX1174.2 +034500 D-C-FAIL-GF-01-0. IX1174.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +034700 MOVE "49" TO CORRECT-X. IX1174.2 +034800 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1174.2 +034900 PERFORM D-FAIL. IX1174.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1174.2 +035100 D-C-PASS-GF-01-0. IX1174.2 +035200 PERFORM D-PASS. IX1174.2 +035300 D-C-WRITE-GF-01-0. IX1174.2 +035400 PERFORM D-PRINT-DETAIL. IX1174.2 +035500 D-CLOSE-FILES. IX1174.2 +035600P OPEN I-O RAW-DATA. IX1174.2 +035700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +035800P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1174.2 +035900P MOVE "OK. " TO C-ABORT. IX1174.2 +036000P MOVE PASS-COUNTER TO C-OK. IX1174.2 +036100P MOVE ERROR-HOLD TO C-ALL. IX1174.2 +036200P MOVE ERROR-COUNTER TO C-FAIL. IX1174.2 +036300P MOVE DELETE-COUNTER TO C-DELETED. IX1174.2 +036400P MOVE INSPECT-COUNTER TO C-INSPECT. IX1174.2 +036500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1174.2 +036600PD-END-E-2. IX1174.2 +036700P CLOSE RAW-DATA. IX1174.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1174.2 +036900 CLOSE PRINT-FILE. IX1174.2 +037000 D-TERMINATE-CCVS. IX1174.2 +037100S EXIT PROGRAM. IX1174.2 +037200SD-TERMINATE-CALL. IX1174.2 +037300 STOP RUN. IX1174.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1174.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1174.2 +037600 D-PRINT-DETAIL. IX1174.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1174.2 +037800 MOVE "." TO PARDOT-X IX1174.2 +037900 MOVE REC-CT TO DOTVALUE. IX1174.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1174.2 +038100 PERFORM D-WRITE-LINE. IX1174.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1174.2 +038300 PERFORM D-WRITE-LINE IX1174.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1174.2 +038500 ELSE IX1174.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1174.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1174.2 +038800 MOVE SPACE TO CORRECT-X. IX1174.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1174.2 +039000 MOVE SPACE TO RE-MARK. IX1174.2 +039100 D-END-ROUTINE. IX1174.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1174.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1174.2 +039400 D-END-RTN-EXIT. IX1174.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1174.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +039700 D-END-ROUTINE-1. IX1174.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1174.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1174.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1174.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1174.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1174.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1174.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1174.2 +040500 D-END-ROUTINE-12. IX1174.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1174.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1174.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1174.2 +040900 ELSE IX1174.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1174.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +041200 PERFORM D-WRITE-LINE. IX1174.2 +041300 D-END-ROUTINE-13. IX1174.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1174.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1174.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1174.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1174.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +041900 PERFORM D-WRITE-LINE. IX1174.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1174.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1174.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1174.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1174.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1174.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1174.2 +042600 D-WRITE-LINE. IX1174.2 +042700 ADD 1 TO RECORD-COUNT. IX1174.2 +042800Y IF RECORD-COUNT GREATER 42 IX1174.2 +042900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1174.2 +043000Y MOVE SPACE TO DUMMY-RECORD IX1174.2 +043100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1174.2 +043200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1174.2 +043300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1174.2 +043400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1174.2 +043500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1174.2 +043600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1174.2 +044000Y MOVE ZERO TO RECORD-COUNT. IX1174.2 +044100 PERFORM D-WRT-LN. IX1174.2 +044200 D-WRT-LN. IX1174.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1174.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1174.2 +044500 D-FAIL-ROUTINE. IX1174.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1174.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1174.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1174.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1174.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1174.2 +045400 D-FAIL-ROUTINE-WRITE. IX1174.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1174.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1174.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1174.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1174.2 +046000 D-BAIL-OUT. IX1174.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1174.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1174.2 +046300 D-BAIL-OUT-WRITE. IX1174.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1174.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +046800 D-BAIL-OUT-EX. EXIT. IX1174.2 +046900 DECL-EXIT. EXIT. IX1174.2 +047000 END DECLARATIVES. IX1174.2 +047100 IX1174.2 +047200 IX1174.2 +047300 CCVS1 SECTION. IX1174.2 +047400 OPEN-FILES. IX1174.2 +047500P OPEN I-O RAW-DATA. IX1174.2 +047600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +047700P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1174.2 +047800P MOVE "ABORTED " TO C-ABORT. IX1174.2 +047900P ADD 1 TO C-NO-OF-TESTS. IX1174.2 +048000P ACCEPT C-DATE FROM DATE. IX1174.2 +048100P ACCEPT C-TIME FROM TIME. IX1174.2 +048200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1174.2 +048300PEND-E-1. IX1174.2 +048400P CLOSE RAW-DATA. IX1174.2 +048500 OPEN OUTPUT PRINT-FILE. IX1174.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1174.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1174.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1174.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1174.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1174.2 +049100 CCVS-INIT-FILE. IX1174.2 +049200 ADD 1 TO REC-SKL-SUB. IX1174.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1174.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1174.2 +049500 CCVS-INIT-EXIT. IX1174.2 +049600 GO TO CCVS1-EXIT. IX1174.2 +049700 CLOSE-FILES. IX1174.2 +049800P OPEN I-O RAW-DATA. IX1174.2 +049900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +050000P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1174.2 +050100P MOVE "OK. " TO C-ABORT. IX1174.2 +050200P MOVE PASS-COUNTER TO C-OK. IX1174.2 +050300P MOVE ERROR-HOLD TO C-ALL. IX1174.2 +050400P MOVE ERROR-COUNTER TO C-FAIL. IX1174.2 +050500P MOVE DELETE-COUNTER TO C-DELETED. IX1174.2 +050600P MOVE INSPECT-COUNTER TO C-INSPECT. IX1174.2 +050700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1174.2 +050800PEND-E-2. IX1174.2 +050900P CLOSE RAW-DATA. IX1174.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1174.2 +051100 TERMINATE-CCVS. IX1174.2 +051200S EXIT PROGRAM. IX1174.2 +051300STERMINATE-CALL. IX1174.2 +051400 STOP RUN. IX1174.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1174.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1174.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1174.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1174.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1174.2 +052000 PRINT-DETAIL. IX1174.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1174.2 +052200 MOVE "." TO PARDOT-X IX1174.2 +052300 MOVE REC-CT TO DOTVALUE. IX1174.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1174.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1174.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1174.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1174.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1174.2 +052900 MOVE SPACE TO CORRECT-X. IX1174.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1174.2 +053100 MOVE SPACE TO RE-MARK. IX1174.2 +053200 HEAD-ROUTINE. IX1174.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1174.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1174.2 +053700 COLUMN-NAMES-ROUTINE. IX1174.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +054100 END-ROUTINE. IX1174.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1174.2 +054300 END-RTN-EXIT. IX1174.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +054500 END-ROUTINE-1. IX1174.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1174.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1174.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1174.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1174.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1174.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1174.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1174.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1174.2 +055400 END-ROUTINE-12. IX1174.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1174.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1174.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1174.2 +055800 ELSE IX1174.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1174.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +056100 PERFORM WRITE-LINE. IX1174.2 +056200 END-ROUTINE-13. IX1174.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1174.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1174.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1174.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1174.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1174.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1174.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1174.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1174.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +057400 WRITE-LINE. IX1174.2 +057500 ADD 1 TO RECORD-COUNT. IX1174.2 +057600Y IF RECORD-COUNT GREATER 42 IX1174.2 +057700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1174.2 +057800Y MOVE SPACE TO DUMMY-RECORD IX1174.2 +057900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1174.2 +058000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1174.2 +058100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1174.2 +058200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1174.2 +058300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1174.2 +058400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1174.2 +058800Y MOVE ZERO TO RECORD-COUNT. IX1174.2 +058900 PERFORM WRT-LN. IX1174.2 +059000 WRT-LN. IX1174.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1174.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1174.2 +059300 BLANK-LINE-PRINT. IX1174.2 +059400 PERFORM WRT-LN. IX1174.2 +059500 FAIL-ROUTINE. IX1174.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1174.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1174.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1174.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1174.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +060300 GO TO FAIL-ROUTINE-EX. IX1174.2 +060400 FAIL-ROUTINE-WRITE. IX1174.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1174.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1174.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1174.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1174.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1174.2 +061000 BAIL-OUT. IX1174.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1174.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1174.2 +061300 BAIL-OUT-WRITE. IX1174.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1174.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +061800 BAIL-OUT-EX. EXIT. IX1174.2 +061900 CCVS1-EXIT. IX1174.2 +062000 EXIT. IX1174.2 +062100 IX1174.2 +062200 SECT-IX117A-0003 SECTION. IX1174.2 +062300 SEQ-INIT-010. IX1174.2 +062400 MOVE ZERO TO TEST-NO. IX1174.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1174.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1174.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1174.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1174.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1174.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1174.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1174.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1174.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1174.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1174.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1174.2 +063600 IX1174.2 +063700******************************************************************IX1174.2 +063800* TEST 1 *IX1174.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1174.2 +064000* IX-3, 1.3.4 (1) A *IX1174.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1174.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1174.2 +064300******************************************************************IX1174.2 +064400 OPN-INIT-GF-01-0. IX1174.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1174.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1174.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +064900 OPEN IX1174.2 +065000 I-O IX-FS3. IX1174.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1174.2 +065200 GO TO OPN-PASS-GF-01-0. IX1174.2 +065300 OPN-FAIL-GF-01-0. IX1174.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1174.2 +065500 PERFORM FAIL. IX1174.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +065700 MOVE "00" TO CORRECT-X. IX1174.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1174.2 +065900 OPN-PASS-GF-01-0. IX1174.2 +066000 PERFORM PASS. IX1174.2 +066100 OPN-WRITE-GF-01-0. IX1174.2 +066200 PERFORM PRINT-DETAIL. IX1174.2 +066300******************************************************************IX1174.2 +066400* TEST 4 *IX1174.2 +066500* CLOSE I-O 00 EXPECTED *IX1174.2 +066600* IX-3, 1.3.4 (1) A *IX1174.2 +066700******************************************************************IX1174.2 +066800 CLO-INIT-GF-01-0. IX1174.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1174.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +067200 CLO-TEST-GF-01-0. IX1174.2 +067300 CLOSE IX-FS3. IX1174.2 +067400 IF IX-FS3-STATUS = "00" IX1174.2 +067500 GO TO CLO-PASS-GF-01-0. IX1174.2 +067600 CLO-FAIL-GF-01-0. IX1174.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1174.2 +067800 PERFORM FAIL. IX1174.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +068000 MOVE "00" TO CORRECT-X. IX1174.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1174.2 +068200 CLO-PASS-GF-01-0. IX1174.2 +068300 PERFORM PASS. IX1174.2 +068400 CLO-WRITE-GF-01-0. IX1174.2 +068500 PERFORM PRINT-DETAIL. IX1174.2 +068600 IX1174.2 +068700******************************************************************IX1174.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1174.2 +068900******************************************************************IX1174.2 +069000 IX1174.2 +069100******************************************************************IX1174.2 +069200* TEST 5 *IX1174.2 +069300* REWRITE... FILE NOT IN THE OPEN MODE *IX1174.2 +069400* FILE STATUS 49 EXPECTED IX-5, 1.3.4 (5) H *IX1174.2 +069500******************************************************************IX1174.2 +069600 RWR-TEST-GF-01-0. IX1174.2 +069700 MOVE 5 TO TEST-NO. IX1174.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +069900 MOVE "REWRITE 49 EXP." TO FEATURE IX1174.2 +070000 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +070100 REWRITE IX-FS3R1-F-G-240. IX1174.2 +070200 RWR-TEST-GF-01-1. IX1174.2 +070300 IF IX-FS3-STATUS EQUAL TO "49" IX1174.2 +070400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1174.2 +070500 TO RE-MARK IX1174.2 +070600 GO TO RWR-WRITE-GF-01-0. IX1174.2 +070700 RWR-FAIL-GF-01-0. IX1174.2 +070800 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1174.2 +070900 RWR-WRITE-GF-01-0. IX1174.2 +071000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +071100 MOVE "49" TO CORRECT-X. IX1174.2 +071200 PERFORM FAIL. IX1174.2 +071300 PERFORM PRINT-DETAIL. IX1174.2 +071400 IX1174.2 +071500 TERMINATE-ROUTINE. IX1174.2 +071600 EXIT. IX1174.2 +071700 IX1174.2 +071800 CCVS-EXIT SECTION. IX1174.2 +071900 CCVS-999999. IX1174.2 +072000 GO TO CLOSE-FILES. IX1174.2 +*END-OF,IX117A +*HEADER,COBOL,IX113A,SUBPRG,IX118A +000100 IDENTIFICATION DIVISION. IX1184.2 +000200 PROGRAM-ID. IX1184.2 +000300 IX118A. IX1184.2 +000400**************************************************************** IX1184.2 +000500* * IX1184.2 +000600* VALIDATION FOR:- * IX1184.2 +000700* * IX1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +000900* * IX1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1184.2 +001100* * IX1184.2 +001200**************************************************************** IX1184.2 +001300* IX1184.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1184.2 +001500* IX113A. IX1184.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1184.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN THE FILE IS IX1184.2 +001800* OPENED TWICE, AT WHICH POINT THE DECLARATIVES IX1184.2 +001900* SECTION SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 41 IX1184.2 +002000* STANDARD REF. IX-5 1.3.4 (5) A IX1184.2 +002100* IX1184.2 +002200* X-CARDS USED IN THIS PROGRAM: IX1184.2 +002300* IX1184.2 +002400* XXXXX024 IX1184.2 +002500* XXXXX055. IX1184.2 +002600* P XXXXX062. IX1184.2 +002700* XXXXX082. IX1184.2 +002800* XXXXX083. IX1184.2 +002900* C XXXXX084 IX1184.2 +003000* IX1184.2 +003100* IX1184.2 +003200 ENVIRONMENT DIVISION. IX1184.2 +003300 CONFIGURATION SECTION. IX1184.2 +003400 SOURCE-COMPUTER. IX1184.2 +003500 XXXXX082. IX1184.2 +003600 OBJECT-COMPUTER. IX1184.2 +003700 XXXXX083. IX1184.2 +003800 INPUT-OUTPUT SECTION. IX1184.2 +003900 FILE-CONTROL. IX1184.2 +004000P SELECT RAW-DATA ASSIGN TO IX1184.2 +004100P XXXXX062 IX1184.2 +004200P ORGANIZATION IS INDEXED IX1184.2 +004300P ACCESS MODE IS RANDOM IX1184.2 +004400P RECORD KEY IS RAW-DATA-KEY. IX1184.2 +004500* IX1184.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1184.2 +004700 XXXXX055. IX1184.2 +004800* IX1184.2 +004900 SELECT IX-FS3 ASSIGN IX1184.2 +005000 XXXXX024 IX1184.2 +005100 ORGANIZATION IS INDEXED IX1184.2 +005200 ACCESS MODE IS SEQUENTIAL IX1184.2 +005300 RECORD KEY IS IX-FS3-KEY IX1184.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1184.2 +005500 IX1184.2 +005600 DATA DIVISION. IX1184.2 +005700 IX1184.2 +005800 FILE SECTION. IX1184.2 +005900P IX1184.2 +006000PFD RAW-DATA. IX1184.2 +006100P IX1184.2 +006200P01 RAW-DATA-SATZ. IX1184.2 +006300P 05 RAW-DATA-KEY PIC X(6). IX1184.2 +006400P 05 C-DATE PIC 9(6). IX1184.2 +006500P 05 C-TIME PIC 9(8). IX1184.2 +006600P 05 C-NO-OF-TESTS PIC 99. IX1184.2 +006700P 05 C-OK PIC 999. IX1184.2 +006800P 05 C-ALL PIC 999. IX1184.2 +006900P 05 C-FAIL PIC 999. IX1184.2 +007000P 05 C-DELETED PIC 999. IX1184.2 +007100P 05 C-INSPECT PIC 999. IX1184.2 +007200P 05 C-NOTE PIC X(13). IX1184.2 +007300P 05 C-INDENT PIC X. IX1184.2 +007400P 05 C-ABORT PIC X(8). IX1184.2 +007500 IX1184.2 +007600 FD PRINT-FILE. IX1184.2 +007700 IX1184.2 +007800 01 PRINT-REC PIC X(120). IX1184.2 +007900 IX1184.2 +008000 01 DUMMY-RECORD PIC X(120). IX1184.2 +008100 IX1184.2 +008200 FD IX-FS3 IX1184.2 +008300C DATA RECORDS IX-FS3R1-F-G-240 IX1184.2 +008400C LABEL RECORD STANDARD IX1184.2 +008500 RECORD 240 IX1184.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1184.2 +008700 IX1184.2 +008800 01 IX-FS3R1-F-G-240. IX1184.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1184.2 +009000 05 IX-FS3-REC-120-240. IX1184.2 +009100 10 FILLER PIC X(8). IX1184.2 +009200 10 IX-FS3-KEY PIC X(29). IX1184.2 +009300 10 FILLER PIC X(9). IX1184.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1184.2 +009500 10 FILLER PIC X(45). IX1184.2 +009600 IX1184.2 +009700 IX1184.2 +009800 WORKING-STORAGE SECTION. IX1184.2 +009900 IX1184.2 +010000 01 GRP-0101. IX1184.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1184.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1184.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1184.2 +010400 IX1184.2 +010500 01 GRP-0102. IX1184.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1184.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1184.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1184.2 +010900 IX1184.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1184.2 +011100 IX1184.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1184.2 +011300 IX1184.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1184.2 +011500 IX1184.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1184.2 +011700 IX1184.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1184.2 +011900 IX1184.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1184.2 +012100 IX1184.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1184.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1184.2 +012400 IX1184.2 +012500 01 IX-FS3-STATUS. IX1184.2 +012600 05 IX-FS3-STAT1 PIC X. IX1184.2 +012700 05 IX-FS3-STAT2 PIC X. IX1184.2 +012800 IX1184.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1184.2 +013000 IX1184.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1184.2 +013200 IX1184.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1184.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1184.2 +013500 10 FILLER PIC X(48) VALUE IX1184.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1184.2 +013700 10 FILLER PIC X(46) VALUE IX1184.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1184.2 +013900 10 FILLER PIC X(26) VALUE IX1184.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1184.2 +014100 10 FILLER PIC X(37) VALUE IX1184.2 +014200 ",RECKEY= ". IX1184.2 +014300 10 FILLER PIC X(38) VALUE IX1184.2 +014400 ",ALTKEY1= ". IX1184.2 +014500 10 FILLER PIC X(38) VALUE IX1184.2 +014600 ",ALTKEY2= ". IX1184.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1184.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1184.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1184.2 +015000 15 FILLER PIC X(5). IX1184.2 +015100 15 XFILE-NAME PIC X(6). IX1184.2 +015200 15 FILLER PIC X(8). IX1184.2 +015300 15 XRECORD-NAME PIC X(6). IX1184.2 +015400 15 FILLER PIC X(1). IX1184.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1184.2 +015600 15 FILLER PIC X(7). IX1184.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1184.2 +015800 15 FILLER PIC X(6). IX1184.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1184.2 +016000 15 FILLER PIC X(5). IX1184.2 +016100 15 ODO-NUMBER PIC 9(4). IX1184.2 +016200 15 FILLER PIC X(5). IX1184.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1184.2 +016400 15 FILLER PIC X(7). IX1184.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1184.2 +016600 15 FILLER PIC X(7). IX1184.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1184.2 +016800 15 FILLER PIC X(1). IX1184.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1184.2 +017000 15 FILLER PIC X(6). IX1184.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1184.2 +017200 15 FILLER PIC X(5). IX1184.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1184.2 +017400 15 FILLER PIC X(6). IX1184.2 +017500 15 XLABEL-TYPE PIC X(1). IX1184.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1184.2 +017700 15 FILLER PIC X(8). IX1184.2 +017800 15 XRECORD-KEY PIC X(29). IX1184.2 +017900 15 FILLER PIC X(9). IX1184.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1184.2 +018100 15 FILLER PIC X(9). IX1184.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1184.2 +018300 15 FILLER PIC X(7). IX1184.2 +018400 IX1184.2 +018500 01 TEST-RESULTS. IX1184.2 +018600 02 FILLER PIC X VALUE SPACE. IX1184.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1184.2 +018800 02 FILLER PIC X VALUE SPACE. IX1184.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1184.2 +019000 02 FILLER PIC X VALUE SPACE. IX1184.2 +019100 02 PAR-NAME. IX1184.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1184.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1184.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1184.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1184.2 +019600 02 RE-MARK PIC X(61). IX1184.2 +019700 01 TEST-COMPUTED. IX1184.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1184.2 +019900 02 FILLER PIC X(17) VALUE IX1184.2 +020000 " COMPUTED=". IX1184.2 +020100 02 COMPUTED-X. IX1184.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1184.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1184.2 +020400 PIC -9(9).9(9). IX1184.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1184.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1184.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1184.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1184.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1184.2 +021000 04 FILLER PIC X. IX1184.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1184.2 +021200 01 TEST-CORRECT. IX1184.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1184.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1184.2 +021500 02 CORRECT-X. IX1184.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1184.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1184.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1184.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1184.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1184.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1184.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1184.2 +022300 04 FILLER PIC X. IX1184.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1184.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1184.2 +022600 01 CCVS-C-1. IX1184.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1184.2 +022800- "SS PARAGRAPH-NAME IX1184.2 +022900- " REMARKS". IX1184.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1184.2 +023100 01 CCVS-C-2. IX1184.2 +023200 02 FILLER PIC X VALUE SPACE. IX1184.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1184.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1184.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1184.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1184.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1184.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1184.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1184.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1184.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1184.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1184.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1184.2 +024800 01 CCVS-H-1. IX1184.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1184.2 +025000 02 FILLER PIC X(42) VALUE IX1184.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1184.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1184.2 +025300 01 CCVS-H-2A. IX1184.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1184.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1184.2 +025600 02 FILLER PIC XXXX VALUE IX1184.2 +025700 "4.2 ". IX1184.2 +025800 02 FILLER PIC X(28) VALUE IX1184.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1184.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1184.2 +026100 IX1184.2 +026200 01 CCVS-H-2B. IX1184.2 +026300 02 FILLER PIC X(15) VALUE IX1184.2 +026400 "TEST RESULT OF ". IX1184.2 +026500 02 TEST-ID PIC X(9). IX1184.2 +026600 02 FILLER PIC X(4) VALUE IX1184.2 +026700 " IN ". IX1184.2 +026800 02 FILLER PIC X(12) VALUE IX1184.2 +026900 " HIGH ". IX1184.2 +027000 02 FILLER PIC X(22) VALUE IX1184.2 +027100 " LEVEL VALIDATION FOR ". IX1184.2 +027200 02 FILLER PIC X(58) VALUE IX1184.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +027400 01 CCVS-H-3. IX1184.2 +027500 02 FILLER PIC X(34) VALUE IX1184.2 +027600 " FOR OFFICIAL USE ONLY ". IX1184.2 +027700 02 FILLER PIC X(58) VALUE IX1184.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1184.2 +027900 02 FILLER PIC X(28) VALUE IX1184.2 +028000 " COPYRIGHT 1985 ". IX1184.2 +028100 01 CCVS-E-1. IX1184.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1184.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1184.2 +028400 02 ID-AGAIN PIC X(9). IX1184.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1184.2 +028600 01 CCVS-E-2. IX1184.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1184.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1184.2 +028900 02 CCVS-E-2-2. IX1184.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1184.2 +029100 03 FILLER PIC X VALUE SPACE. IX1184.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1184.2 +029300 "ERRORS ENCOUNTERED". IX1184.2 +029400 01 CCVS-E-3. IX1184.2 +029500 02 FILLER PIC X(22) VALUE IX1184.2 +029600 " FOR OFFICIAL USE ONLY". IX1184.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1184.2 +029800 02 FILLER PIC X(58) VALUE IX1184.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1184.2 +030100 02 FILLER PIC X(15) VALUE IX1184.2 +030200 " COPYRIGHT 1985". IX1184.2 +030300 01 CCVS-E-4. IX1184.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1184.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1184.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1184.2 +030700 02 FILLER PIC X(40) VALUE IX1184.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1184.2 +030900 01 XXINFO. IX1184.2 +031000 02 FILLER PIC X(19) VALUE IX1184.2 +031100 "*** INFORMATION ***". IX1184.2 +031200 02 INFO-TEXT. IX1184.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1184.2 +031400 04 XXCOMPUTED PIC X(20). IX1184.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1184.2 +031600 04 XXCORRECT PIC X(20). IX1184.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1184.2 +031800 01 HYPHEN-LINE. IX1184.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1184.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1184.2 +032100- "*****************************************". IX1184.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1184.2 +032300- "******************************". IX1184.2 +032400 01 TEST-NO PIC 99. IX1184.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1184.2 +032600 "IX118A". IX1184.2 +032700 PROCEDURE DIVISION. IX1184.2 +032800 DECLARATIVES. IX1184.2 +032900 IX1184.2 +033000 SECT-IX105-0002 SECTION. IX1184.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1184.2 +033200 INPUT-PROCESS. IX1184.2 +033300 IF TEST-NO = 5 IX1184.2 +033400 GO TO D-C-TEST-GF-01-1. IX1184.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1184.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1184.2 +033700 MOVE 1 TO EOF-FLAG IX1184.2 +033800 ELSE IX1184.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1184.2 +034000 MOVE 1 TO PERM-ERRORS. IX1184.2 +034100 GO TO DECL-EXIT. IX1184.2 +034200 D-C-TEST-GF-01-1. IX1184.2 +034300 IF IX-FS3-STATUS EQUAL TO "41" IX1184.2 +034400 GO TO D-C-PASS-GF-01-0. IX1184.2 +034500 D-C-FAIL-GF-01-0. IX1184.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +034700 MOVE "41" TO CORRECT-X. IX1184.2 +034800 MOVE "IX-5, 1.3.4, (5) A" TO RE-MARK. IX1184.2 +034900 PERFORM D-FAIL. IX1184.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1184.2 +035100 D-C-PASS-GF-01-0. IX1184.2 +035200 PERFORM D-PASS. IX1184.2 +035300 D-C-WRITE-GF-01-0. IX1184.2 +035400 PERFORM D-PRINT-DETAIL. IX1184.2 +035500 D-CLOSE-FILES. IX1184.2 +035600P OPEN I-O RAW-DATA. IX1184.2 +035700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +035800P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1184.2 +035900P MOVE "OK. " TO C-ABORT. IX1184.2 +036000P MOVE PASS-COUNTER TO C-OK. IX1184.2 +036100P MOVE ERROR-HOLD TO C-ALL. IX1184.2 +036200P MOVE ERROR-COUNTER TO C-FAIL. IX1184.2 +036300P MOVE DELETE-COUNTER TO C-DELETED. IX1184.2 +036400P MOVE INSPECT-COUNTER TO C-INSPECT. IX1184.2 +036500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1184.2 +036600PD-END-E-2. IX1184.2 +036700P CLOSE RAW-DATA. IX1184.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1184.2 +036900 CLOSE PRINT-FILE. IX1184.2 +037000 D-TERMINATE-CCVS. IX1184.2 +037100S EXIT PROGRAM. IX1184.2 +037200SD-TERMINATE-CALL. IX1184.2 +037300 STOP RUN. IX1184.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1184.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1184.2 +037600 D-PRINT-DETAIL. IX1184.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1184.2 +037800 MOVE "." TO PARDOT-X IX1184.2 +037900 MOVE REC-CT TO DOTVALUE. IX1184.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1184.2 +038100 PERFORM D-WRITE-LINE. IX1184.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1184.2 +038300 PERFORM D-WRITE-LINE IX1184.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1184.2 +038500 ELSE IX1184.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1184.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1184.2 +038800 MOVE SPACE TO CORRECT-X. IX1184.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1184.2 +039000 MOVE SPACE TO RE-MARK. IX1184.2 +039100 D-END-ROUTINE. IX1184.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1184.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1184.2 +039400 D-END-RTN-EXIT. IX1184.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1184.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +039700 D-END-ROUTINE-1. IX1184.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1184.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1184.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1184.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1184.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1184.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1184.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1184.2 +040500 D-END-ROUTINE-12. IX1184.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1184.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1184.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1184.2 +040900 ELSE IX1184.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1184.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +041200 PERFORM D-WRITE-LINE. IX1184.2 +041300 D-END-ROUTINE-13. IX1184.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1184.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1184.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1184.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1184.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +041900 PERFORM D-WRITE-LINE. IX1184.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1184.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1184.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1184.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1184.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1184.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1184.2 +042600 D-WRITE-LINE. IX1184.2 +042700 ADD 1 TO RECORD-COUNT. IX1184.2 +042800Y IF RECORD-COUNT GREATER 42 IX1184.2 +042900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1184.2 +043000Y MOVE SPACE TO DUMMY-RECORD IX1184.2 +043100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1184.2 +043200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1184.2 +043300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1184.2 +043400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1184.2 +043500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1184.2 +043600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1184.2 +044000Y MOVE ZERO TO RECORD-COUNT. IX1184.2 +044100 PERFORM D-WRT-LN. IX1184.2 +044200 D-WRT-LN. IX1184.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1184.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1184.2 +044500 D-FAIL-ROUTINE. IX1184.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1184.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1184.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1184.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1184.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1184.2 +045400 D-FAIL-ROUTINE-WRITE. IX1184.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1184.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1184.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1184.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1184.2 +046000 D-BAIL-OUT. IX1184.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1184.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1184.2 +046300 D-BAIL-OUT-WRITE. IX1184.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1184.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +046800 D-BAIL-OUT-EX. EXIT. IX1184.2 +046900 DECL-EXIT. EXIT. IX1184.2 +047000 END DECLARATIVES. IX1184.2 +047100 IX1184.2 +047200 IX1184.2 +047300 CCVS1 SECTION. IX1184.2 +047400 OPEN-FILES. IX1184.2 +047500P OPEN I-O RAW-DATA. IX1184.2 +047600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +047700P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1184.2 +047800P MOVE "ABORTED " TO C-ABORT. IX1184.2 +047900P ADD 1 TO C-NO-OF-TESTS. IX1184.2 +048000P ACCEPT C-DATE FROM DATE. IX1184.2 +048100P ACCEPT C-TIME FROM TIME. IX1184.2 +048200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1184.2 +048300PEND-E-1. IX1184.2 +048400P CLOSE RAW-DATA. IX1184.2 +048500 OPEN OUTPUT PRINT-FILE. IX1184.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1184.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1184.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1184.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1184.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1184.2 +049100 CCVS-INIT-FILE. IX1184.2 +049200 ADD 1 TO REC-SKL-SUB. IX1184.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1184.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1184.2 +049500 CCVS-INIT-EXIT. IX1184.2 +049600 GO TO CCVS1-EXIT. IX1184.2 +049700 CLOSE-FILES. IX1184.2 +049800P OPEN I-O RAW-DATA. IX1184.2 +049900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +050000P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1184.2 +050100P MOVE "OK. " TO C-ABORT. IX1184.2 +050200P MOVE PASS-COUNTER TO C-OK. IX1184.2 +050300P MOVE ERROR-HOLD TO C-ALL. IX1184.2 +050400P MOVE ERROR-COUNTER TO C-FAIL. IX1184.2 +050500P MOVE DELETE-COUNTER TO C-DELETED. IX1184.2 +050600P MOVE INSPECT-COUNTER TO C-INSPECT. IX1184.2 +050700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1184.2 +050800PEND-E-2. IX1184.2 +050900P CLOSE RAW-DATA. IX1184.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1184.2 +051100 TERMINATE-CCVS. IX1184.2 +051200S EXIT PROGRAM. IX1184.2 +051300STERMINATE-CALL. IX1184.2 +051400 STOP RUN. IX1184.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1184.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1184.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1184.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1184.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1184.2 +052000 PRINT-DETAIL. IX1184.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1184.2 +052200 MOVE "." TO PARDOT-X IX1184.2 +052300 MOVE REC-CT TO DOTVALUE. IX1184.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1184.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1184.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1184.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1184.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1184.2 +052900 MOVE SPACE TO CORRECT-X. IX1184.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1184.2 +053100 MOVE SPACE TO RE-MARK. IX1184.2 +053200 HEAD-ROUTINE. IX1184.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1184.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1184.2 +053700 COLUMN-NAMES-ROUTINE. IX1184.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +054100 END-ROUTINE. IX1184.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1184.2 +054300 END-RTN-EXIT. IX1184.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +054500 END-ROUTINE-1. IX1184.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1184.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1184.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1184.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1184.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1184.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1184.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1184.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1184.2 +055400 END-ROUTINE-12. IX1184.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1184.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1184.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1184.2 +055800 ELSE IX1184.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1184.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +056100 PERFORM WRITE-LINE. IX1184.2 +056200 END-ROUTINE-13. IX1184.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1184.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1184.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1184.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1184.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1184.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1184.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1184.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1184.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +057400 WRITE-LINE. IX1184.2 +057500 ADD 1 TO RECORD-COUNT. IX1184.2 +057600Y IF RECORD-COUNT GREATER 42 IX1184.2 +057700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1184.2 +057800Y MOVE SPACE TO DUMMY-RECORD IX1184.2 +057900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1184.2 +058000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1184.2 +058100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1184.2 +058200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1184.2 +058300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1184.2 +058400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1184.2 +058800Y MOVE ZERO TO RECORD-COUNT. IX1184.2 +058900 PERFORM WRT-LN. IX1184.2 +059000 WRT-LN. IX1184.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1184.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1184.2 +059300 BLANK-LINE-PRINT. IX1184.2 +059400 PERFORM WRT-LN. IX1184.2 +059500 FAIL-ROUTINE. IX1184.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1184.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1184.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1184.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1184.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +060300 GO TO FAIL-ROUTINE-EX. IX1184.2 +060400 FAIL-ROUTINE-WRITE. IX1184.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1184.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1184.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1184.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1184.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1184.2 +061000 BAIL-OUT. IX1184.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1184.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1184.2 +061300 BAIL-OUT-WRITE. IX1184.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1184.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +061800 BAIL-OUT-EX. EXIT. IX1184.2 +061900 CCVS1-EXIT. IX1184.2 +062000 EXIT. IX1184.2 +062100 IX1184.2 +062200 SECT-IX118A-0003 SECTION. IX1184.2 +062300 SEQ-INIT-010. IX1184.2 +062400 MOVE ZERO TO TEST-NO. IX1184.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1184.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1184.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1184.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1184.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1184.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1184.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1184.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1184.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1184.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1184.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1184.2 +063600 IX1184.2 +063700******************************************************************IX1184.2 +063800* TEST 1 *IX1184.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1184.2 +064000* IX-3, 1.3.4 (1) A *IX1184.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1184.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1184.2 +064300******************************************************************IX1184.2 +064400 OPN-INIT-GF-01-0. IX1184.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1184.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1184.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1184.2 +064900 OPEN IX1184.2 +065000 I-O IX-FS3. IX1184.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1184.2 +065200 GO TO OPN-PASS-GF-01-0. IX1184.2 +065300 OPN-FAIL-GF-01-0. IX1184.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1184.2 +065500 PERFORM FAIL. IX1184.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +065700 MOVE "00" TO CORRECT-X. IX1184.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1184.2 +065900 OPN-PASS-GF-01-0. IX1184.2 +066000 PERFORM PASS. IX1184.2 +066100 OPN-WRITE-GF-01-0. IX1184.2 +066200 PERFORM PRINT-DETAIL. IX1184.2 +066300******************************************************************IX1184.2 +066400* TEST 4 *IX1184.2 +066500* CLOSE I-O 00 EXPECTED *IX1184.2 +066600* IX-3, 1.3.4 (1) A *IX1184.2 +066700******************************************************************IX1184.2 +066800 CLO-INIT-GF-01-0. IX1184.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1184.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1184.2 +067200 CLO-TEST-GF-01-0. IX1184.2 +067300 CLOSE IX-FS3. IX1184.2 +067400 IF IX-FS3-STATUS = "00" IX1184.2 +067500 GO TO CLO-PASS-GF-01-0. IX1184.2 +067600 CLO-FAIL-GF-01-0. IX1184.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1184.2 +067800 PERFORM FAIL. IX1184.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +068000 MOVE "00" TO CORRECT-X. IX1184.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1184.2 +068200 CLO-PASS-GF-01-0. IX1184.2 +068300 PERFORM PASS. IX1184.2 +068400 CLO-WRITE-GF-01-0. IX1184.2 +068500 PERFORM PRINT-DETAIL. IX1184.2 +068600 IX1184.2 +068700******************************************************************IX1184.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1184.2 +068900******************************************************************IX1184.2 +069000 IX1184.2 +069100******************************************************************IX1184.2 +069200* TEST 5 *IX1184.2 +069300* OPEN FOR A FILE ALREADY IN OPEN MODE *IX1184.2 +069400* FILE STATUS 41 EXPECTED IX-5, 1.3.4 (5) A *IX1184.2 +069500******************************************************************IX1184.2 +069600 OPN-TEST-GF-02-0. IX1184.2 +069700 MOVE 5 TO TEST-NO. IX1184.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +069900 MOVE "OPEN 41 EXP." TO FEATURE IX1184.2 +070000 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1184.2 +070100 OPEN INPUT IX-FS3. IX1184.2 +070200 OPEN INPUT IX-FS3. IX1184.2 +070300 OPN-TEST-GF-02-1. IX1184.2 +070400 IF IX-FS3-STATUS EQUAL TO "41" IX1184.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1184.2 +070600 TO RE-MARK IX1184.2 +070700 GO TO OPN-WRITE-GF-02-0. IX1184.2 +070800 OPN-FAIL-GF-02-0. IX1184.2 +070900 MOVE "IX-5, 1.3.4, (5) A" TO RE-MARK. IX1184.2 +071000 OPN-WRITE-GF-02-0. IX1184.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +071200 MOVE "41" TO CORRECT-X. IX1184.2 +071300 PERFORM FAIL. IX1184.2 +071400 PERFORM PRINT-DETAIL. IX1184.2 +071500 CLOSE IX-FS3. IX1184.2 +071600 IX1184.2 +071700 TERMINATE-ROUTINE. IX1184.2 +071800 EXIT. IX1184.2 +071900 IX1184.2 +072000 CCVS-EXIT SECTION. IX1184.2 +072100 CCVS-999999. IX1184.2 +072200 GO TO CLOSE-FILES. IX1184.2 +*END-OF,IX118A +*HEADER,COBOL,IX113A,SUBPRG,IX119A +000100 IDENTIFICATION DIVISION. IX1194.2 +000200 PROGRAM-ID. IX1194.2 +000300 IX119A. IX1194.2 +000400**************************************************************** IX1194.2 +000500* * IX1194.2 +000600* VALIDATION FOR:- * IX1194.2 +000700* * IX1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +000900* * IX1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1194.2 +001100* * IX1194.2 +001200**************************************************************** IX1194.2 +001300* IX1194.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1194.2 +001500* IX113A. IX1194.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1194.2 +001700* THEN AN ATTEMPT IS MADE TO REWRITE A RECORD WITH THE WRONG IX1194.2 +001800* PRIME RECORD KEY (STATUS 21 EXPECTED). THEN AN ATTEMPT IX1194.2 +001900* IS MADE TO DELETE A RECORD, AT WHICH POINT THE DECLARATIVES IX1194.2 +002000* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 43 . IX1194.2 +002100* IX1194.2 +002200* STANDARD REFERENCE IX-5, 1.3.4 (3) A IX1194.2 +002300* STANDARD REFERENCE IX-5, 1.3.4 (5) C IX1194.2 +002400* IX1194.2 +002500* X-CARDS USED IN THIS PROGRAM: IX1194.2 +002600* IX1194.2 +002700* XXXXX024 IX1194.2 +002800* XXXXX055. IX1194.2 +002900* P XXXXX062. IX1194.2 +003000* XXXXX082. IX1194.2 +003100* XXXXX083. IX1194.2 +003200* C XXXXX084 IX1194.2 +003300* IX1194.2 +003400* IX1194.2 +003500 ENVIRONMENT DIVISION. IX1194.2 +003600 CONFIGURATION SECTION. IX1194.2 +003700 SOURCE-COMPUTER. IX1194.2 +003800 XXXXX082. IX1194.2 +003900 OBJECT-COMPUTER. IX1194.2 +004000 XXXXX083. IX1194.2 +004100 INPUT-OUTPUT SECTION. IX1194.2 +004200 FILE-CONTROL. IX1194.2 +004300P SELECT RAW-DATA ASSIGN TO IX1194.2 +004400P XXXXX062 IX1194.2 +004500P ORGANIZATION IS INDEXED IX1194.2 +004600P ACCESS MODE IS RANDOM IX1194.2 +004700P RECORD KEY IS RAW-DATA-KEY. IX1194.2 +004800* IX1194.2 +004900 SELECT PRINT-FILE ASSIGN TO IX1194.2 +005000 XXXXX055. IX1194.2 +005100* IX1194.2 +005200 SELECT IX-FS3 ASSIGN IX1194.2 +005300 XXXXX024 IX1194.2 +005400 ORGANIZATION IS INDEXED IX1194.2 +005500 ACCESS MODE IS SEQUENTIAL IX1194.2 +005600 RECORD KEY IS IX-FS3-KEY IX1194.2 +005700 FILE STATUS IS IX-FS3-STATUS. IX1194.2 +005800 IX1194.2 +005900 DATA DIVISION. IX1194.2 +006000 IX1194.2 +006100 FILE SECTION. IX1194.2 +006200P IX1194.2 +006300PFD RAW-DATA. IX1194.2 +006400P IX1194.2 +006500P01 RAW-DATA-SATZ. IX1194.2 +006600P 05 RAW-DATA-KEY PIC X(6). IX1194.2 +006700P 05 C-DATE PIC 9(6). IX1194.2 +006800P 05 C-TIME PIC 9(8). IX1194.2 +006900P 05 C-NO-OF-TESTS PIC 99. IX1194.2 +007000P 05 C-OK PIC 999. IX1194.2 +007100P 05 C-ALL PIC 999. IX1194.2 +007200P 05 C-FAIL PIC 999. IX1194.2 +007300P 05 C-DELETED PIC 999. IX1194.2 +007400P 05 C-INSPECT PIC 999. IX1194.2 +007500P 05 C-NOTE PIC X(13). IX1194.2 +007600P 05 C-INDENT PIC X. IX1194.2 +007700P 05 C-ABORT PIC X(8). IX1194.2 +007800 IX1194.2 +007900 FD PRINT-FILE. IX1194.2 +008000 IX1194.2 +008100 01 PRINT-REC PIC X(120). IX1194.2 +008200 IX1194.2 +008300 01 DUMMY-RECORD PIC X(120). IX1194.2 +008400 IX1194.2 +008500 FD IX-FS3 IX1194.2 +008600C DATA RECORDS IX-FS3R1-F-G-240 IX1194.2 +008700C LABEL RECORD STANDARD IX1194.2 +008800 RECORD 240 IX1194.2 +008900 BLOCK CONTAINS 2 RECORDS. IX1194.2 +009000 IX1194.2 +009100 01 IX-FS3R1-F-G-240. IX1194.2 +009200 05 IX-FS3-REC-120 PIC X(120). IX1194.2 +009300 05 IX-FS3-REC-120-240. IX1194.2 +009400 10 FILLER PIC X(8). IX1194.2 +009500 10 IX-FS3-KEY PIC X(29). IX1194.2 +009600 10 FILLER PIC X(9). IX1194.2 +009700 10 IX-FS3-ALTER-KEY PIC X(29). IX1194.2 +009800 10 FILLER PIC X(45). IX1194.2 +009900 IX1194.2 +010000 IX1194.2 +010100 WORKING-STORAGE SECTION. IX1194.2 +010200 IX1194.2 +010300 01 GRP-0101. IX1194.2 +010400 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1194.2 +010500 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1194.2 +010600 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1194.2 +010700 IX1194.2 +010800 01 GRP-0102. IX1194.2 +010900 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1194.2 +011000 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1194.2 +011100 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1194.2 +011200 IX1194.2 +011300 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1194.2 +011400 IX1194.2 +011500 01 EOF-FLAG PIC 9 VALUE ZERO. IX1194.2 +011600 IX1194.2 +011700 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1194.2 +011800 IX1194.2 +011900 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1194.2 +012000 IX1194.2 +012100 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1194.2 +012200 IX1194.2 +012300 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1194.2 +012400 IX1194.2 +012500 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1194.2 +012600 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1194.2 +012700 IX1194.2 +012800 01 IX-FS3-STATUS. IX1194.2 +012900 05 IX-FS3-STAT1 PIC X. IX1194.2 +013000 05 IX-FS3-STAT2 PIC X. IX1194.2 +013100 IX1194.2 +013200 01 COUNT-OF-RECS PIC 9(5). IX1194.2 +013300 IX1194.2 +013400 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1194.2 +013500 IX1194.2 +013600 01 FILE-RECORD-INFORMATION-REC. IX1194.2 +013700 05 FILE-RECORD-INFO-SKELETON. IX1194.2 +013800 10 FILLER PIC X(48) VALUE IX1194.2 +013900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1194.2 +014000 10 FILLER PIC X(46) VALUE IX1194.2 +014100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1194.2 +014200 10 FILLER PIC X(26) VALUE IX1194.2 +014300 ",LFIL=000000,ORG= ,LBLR= ". IX1194.2 +014400 10 FILLER PIC X(37) VALUE IX1194.2 +014500 ",RECKEY= ". IX1194.2 +014600 10 FILLER PIC X(38) VALUE IX1194.2 +014700 ",ALTKEY1= ". IX1194.2 +014800 10 FILLER PIC X(38) VALUE IX1194.2 +014900 ",ALTKEY2= ". IX1194.2 +015000 10 FILLER PIC X(7) VALUE SPACE. IX1194.2 +015100 05 FILE-RECORD-INFO OCCURS 10. IX1194.2 +015200 10 FILE-RECORD-INFO-P1-120. IX1194.2 +015300 15 FILLER PIC X(5). IX1194.2 +015400 15 XFILE-NAME PIC X(6). IX1194.2 +015500 15 FILLER PIC X(8). IX1194.2 +015600 15 XRECORD-NAME PIC X(6). IX1194.2 +015700 15 FILLER PIC X(1). IX1194.2 +015800 15 REELUNIT-NUMBER PIC 9(1). IX1194.2 +015900 15 FILLER PIC X(7). IX1194.2 +016000 15 XRECORD-NUMBER PIC 9(6). IX1194.2 +016100 15 FILLER PIC X(6). IX1194.2 +016200 15 UPDATE-NUMBER PIC 9(2). IX1194.2 +016300 15 FILLER PIC X(5). IX1194.2 +016400 15 ODO-NUMBER PIC 9(4). IX1194.2 +016500 15 FILLER PIC X(5). IX1194.2 +016600 15 XPROGRAM-NAME PIC X(5). IX1194.2 +016700 15 FILLER PIC X(7). IX1194.2 +016800 15 XRECORD-LENGTH PIC 9(6). IX1194.2 +016900 15 FILLER PIC X(7). IX1194.2 +017000 15 CHARS-OR-RECORDS PIC X(2). IX1194.2 +017100 15 FILLER PIC X(1). IX1194.2 +017200 15 XBLOCK-SIZE PIC 9(4). IX1194.2 +017300 15 FILLER PIC X(6). IX1194.2 +017400 15 RECORDS-IN-FILE PIC 9(6). IX1194.2 +017500 15 FILLER PIC X(5). IX1194.2 +017600 15 XFILE-ORGANIZATION PIC X(2). IX1194.2 +017700 15 FILLER PIC X(6). IX1194.2 +017800 15 XLABEL-TYPE PIC X(1). IX1194.2 +017900 10 FILE-RECORD-INFO-P121-240. IX1194.2 +018000 15 FILLER PIC X(8). IX1194.2 +018100 15 XRECORD-KEY PIC X(29). IX1194.2 +018200 15 FILLER PIC X(9). IX1194.2 +018300 15 ALTERNATE-KEY1 PIC X(29). IX1194.2 +018400 15 FILLER PIC X(9). IX1194.2 +018500 15 ALTERNATE-KEY2 PIC X(29). IX1194.2 +018600 15 FILLER PIC X(7). IX1194.2 +018700 IX1194.2 +018800 01 TEST-RESULTS. IX1194.2 +018900 02 FILLER PIC X VALUE SPACE. IX1194.2 +019000 02 FEATURE PIC X(20) VALUE SPACE. IX1194.2 +019100 02 FILLER PIC X VALUE SPACE. IX1194.2 +019200 02 P-OR-F PIC X(5) VALUE SPACE. IX1194.2 +019300 02 FILLER PIC X VALUE SPACE. IX1194.2 +019400 02 PAR-NAME. IX1194.2 +019500 03 FILLER PIC X(19) VALUE SPACE. IX1194.2 +019600 03 PARDOT-X PIC X VALUE SPACE. IX1194.2 +019700 03 DOTVALUE PIC 99 VALUE ZERO. IX1194.2 +019800 02 FILLER PIC X(8) VALUE SPACE. IX1194.2 +019900 02 RE-MARK PIC X(61). IX1194.2 +020000 01 TEST-COMPUTED. IX1194.2 +020100 02 FILLER PIC X(30) VALUE SPACE. IX1194.2 +020200 02 FILLER PIC X(17) VALUE IX1194.2 +020300 " COMPUTED=". IX1194.2 +020400 02 COMPUTED-X. IX1194.2 +020500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1194.2 +020600 03 COMPUTED-N REDEFINES COMPUTED-A IX1194.2 +020700 PIC -9(9).9(9). IX1194.2 +020800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1194.2 +020900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1194.2 +021000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1194.2 +021100 03 CM-18V0 REDEFINES COMPUTED-A. IX1194.2 +021200 04 COMPUTED-18V0 PIC -9(18). IX1194.2 +021300 04 FILLER PIC X. IX1194.2 +021400 03 FILLER PIC X(50) VALUE SPACE. IX1194.2 +021500 01 TEST-CORRECT. IX1194.2 +021600 02 FILLER PIC X(30) VALUE SPACE. IX1194.2 +021700 02 FILLER PIC X(17) VALUE " CORRECT =". IX1194.2 +021800 02 CORRECT-X. IX1194.2 +021900 03 CORRECT-A PIC X(20) VALUE SPACE. IX1194.2 +022000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1194.2 +022100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1194.2 +022200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1194.2 +022300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1194.2 +022400 03 CR-18V0 REDEFINES CORRECT-A. IX1194.2 +022500 04 CORRECT-18V0 PIC -9(18). IX1194.2 +022600 04 FILLER PIC X. IX1194.2 +022700 03 FILLER PIC X(2) VALUE SPACE. IX1194.2 +022800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1194.2 +022900 01 CCVS-C-1. IX1194.2 +023000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1194.2 +023100- "SS PARAGRAPH-NAME IX1194.2 +023200- " REMARKS". IX1194.2 +023300 02 FILLER PIC X(20) VALUE SPACE. IX1194.2 +023400 01 CCVS-C-2. IX1194.2 +023500 02 FILLER PIC X VALUE SPACE. IX1194.2 +023600 02 FILLER PIC X(6) VALUE "TESTED". IX1194.2 +023700 02 FILLER PIC X(15) VALUE SPACE. IX1194.2 +023800 02 FILLER PIC X(4) VALUE "FAIL". IX1194.2 +023900 02 FILLER PIC X(94) VALUE SPACE. IX1194.2 +024000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1194.2 +024100 01 REC-CT PIC 99 VALUE ZERO. IX1194.2 +024200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1194.2 +024700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1194.2 +024800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1194.2 +024900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1194.2 +025000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1194.2 +025100 01 CCVS-H-1. IX1194.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1194.2 +025300 02 FILLER PIC X(42) VALUE IX1194.2 +025400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1194.2 +025500 02 FILLER PIC X(39) VALUE SPACES. IX1194.2 +025600 01 CCVS-H-2A. IX1194.2 +025700 02 FILLER PIC X(40) VALUE SPACE. IX1194.2 +025800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1194.2 +025900 02 FILLER PIC XXXX VALUE IX1194.2 +026000 "4.2 ". IX1194.2 +026100 02 FILLER PIC X(28) VALUE IX1194.2 +026200 " COPY - NOT FOR DISTRIBUTION". IX1194.2 +026300 02 FILLER PIC X(41) VALUE SPACE. IX1194.2 +026400 IX1194.2 +026500 01 CCVS-H-2B. IX1194.2 +026600 02 FILLER PIC X(15) VALUE IX1194.2 +026700 "TEST RESULT OF ". IX1194.2 +026800 02 TEST-ID PIC X(9). IX1194.2 +026900 02 FILLER PIC X(4) VALUE IX1194.2 +027000 " IN ". IX1194.2 +027100 02 FILLER PIC X(12) VALUE IX1194.2 +027200 " HIGH ". IX1194.2 +027300 02 FILLER PIC X(22) VALUE IX1194.2 +027400 " LEVEL VALIDATION FOR ". IX1194.2 +027500 02 FILLER PIC X(58) VALUE IX1194.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +027700 01 CCVS-H-3. IX1194.2 +027800 02 FILLER PIC X(34) VALUE IX1194.2 +027900 " FOR OFFICIAL USE ONLY ". IX1194.2 +028000 02 FILLER PIC X(58) VALUE IX1194.2 +028100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1194.2 +028200 02 FILLER PIC X(28) VALUE IX1194.2 +028300 " COPYRIGHT 1985 ". IX1194.2 +028400 01 CCVS-E-1. IX1194.2 +028500 02 FILLER PIC X(52) VALUE SPACE. IX1194.2 +028600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1194.2 +028700 02 ID-AGAIN PIC X(9). IX1194.2 +028800 02 FILLER PIC X(45) VALUE SPACES. IX1194.2 +028900 01 CCVS-E-2. IX1194.2 +029000 02 FILLER PIC X(31) VALUE SPACE. IX1194.2 +029100 02 FILLER PIC X(21) VALUE SPACE. IX1194.2 +029200 02 CCVS-E-2-2. IX1194.2 +029300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1194.2 +029400 03 FILLER PIC X VALUE SPACE. IX1194.2 +029500 03 ENDER-DESC PIC X(44) VALUE IX1194.2 +029600 "ERRORS ENCOUNTERED". IX1194.2 +029700 01 CCVS-E-3. IX1194.2 +029800 02 FILLER PIC X(22) VALUE IX1194.2 +029900 " FOR OFFICIAL USE ONLY". IX1194.2 +030000 02 FILLER PIC X(12) VALUE SPACE. IX1194.2 +030100 02 FILLER PIC X(58) VALUE IX1194.2 +030200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +030300 02 FILLER PIC X(13) VALUE SPACE. IX1194.2 +030400 02 FILLER PIC X(15) VALUE IX1194.2 +030500 " COPYRIGHT 1985". IX1194.2 +030600 01 CCVS-E-4. IX1194.2 +030700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1194.2 +030800 02 FILLER PIC X(4) VALUE " OF ". IX1194.2 +030900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1194.2 +031000 02 FILLER PIC X(40) VALUE IX1194.2 +031100 " TESTS WERE EXECUTED SUCCESSFULLY". IX1194.2 +031200 01 XXINFO. IX1194.2 +031300 02 FILLER PIC X(19) VALUE IX1194.2 +031400 "*** INFORMATION ***". IX1194.2 +031500 02 INFO-TEXT. IX1194.2 +031600 04 FILLER PIC X(8) VALUE SPACE. IX1194.2 +031700 04 XXCOMPUTED PIC X(20). IX1194.2 +031800 04 FILLER PIC X(5) VALUE SPACE. IX1194.2 +031900 04 XXCORRECT PIC X(20). IX1194.2 +032000 02 INF-ANSI-REFERENCE PIC X(48). IX1194.2 +032100 01 HYPHEN-LINE. IX1194.2 +032200 02 FILLER PIC IS X VALUE IS SPACE. IX1194.2 +032300 02 FILLER PIC IS X(65) VALUE IS "************************IX1194.2 +032400- "*****************************************". IX1194.2 +032500 02 FILLER PIC IS X(54) VALUE IS "************************IX1194.2 +032600- "******************************". IX1194.2 +032700 01 TEST-NO PIC 99. IX1194.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE IX1194.2 +032900 "IX119A". IX1194.2 +033000 PROCEDURE DIVISION. IX1194.2 +033100 DECLARATIVES. IX1194.2 +033200 IX1194.2 +033300 SECT-IX105-0002 SECTION. IX1194.2 +033400 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1194.2 +033500 INPUT-PROCESS. IX1194.2 +033600 IF TEST-NO = 5 IX1194.2 +033700 GO TO D-C-TEST-GF-01-1. IX1194.2 +033800 IF STATUS-TEST-10 EQUAL TO 1 IX1194.2 +033900 IF IX-FS3-STAT1 EQUAL TO "1" IX1194.2 +034000 MOVE 1 TO EOF-FLAG IX1194.2 +034100 ELSE IX1194.2 +034200 IF IX-FS3-STAT1 GREATER THAN "1" IX1194.2 +034300 MOVE 1 TO PERM-ERRORS. IX1194.2 +034400 GO TO DECL-EXIT. IX1194.2 +034500 D-C-TEST-GF-01-1. IX1194.2 +034600 IF IX-FS3-STATUS EQUAL TO "43" IX1194.2 +034700 GO TO D-C-PASS-GF-01-0. IX1194.2 +034800 D-C-FAIL-GF-01-0. IX1194.2 +034900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +035000 MOVE "43" TO CORRECT-X. IX1194.2 +035100 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1194.2 +035200 PERFORM D-FAIL. IX1194.2 +035300 GO TO D-C-WRITE-GF-01-0. IX1194.2 +035400 D-C-PASS-GF-01-0. IX1194.2 +035500 PERFORM D-PASS. IX1194.2 +035600 D-C-WRITE-GF-01-0. IX1194.2 +035700 PERFORM D-PRINT-DETAIL. IX1194.2 +035800 D-CLOSE-FILES. IX1194.2 +035900 CLOSE IX-FS3. IX1194.2 +036000P OPEN I-O RAW-DATA. IX1194.2 +036100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +036200P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1194.2 +036300P MOVE "OK. " TO C-ABORT. IX1194.2 +036400P MOVE PASS-COUNTER TO C-OK. IX1194.2 +036500P MOVE ERROR-HOLD TO C-ALL. IX1194.2 +036600P MOVE ERROR-COUNTER TO C-FAIL. IX1194.2 +036700P MOVE DELETE-COUNTER TO C-DELETED. IX1194.2 +036800P MOVE INSPECT-COUNTER TO C-INSPECT. IX1194.2 +036900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1194.2 +037000PD-END-E-2. IX1194.2 +037100P CLOSE RAW-DATA. IX1194.2 +037200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1194.2 +037300 CLOSE PRINT-FILE. IX1194.2 +037400 D-TERMINATE-CCVS. IX1194.2 +037500S EXIT PROGRAM. IX1194.2 +037600SD-TERMINATE-CALL. IX1194.2 +037700 STOP RUN. IX1194.2 +037800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1194.2 +037900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1194.2 +038000 D-PRINT-DETAIL. IX1194.2 +038100 IF REC-CT NOT EQUAL TO ZERO IX1194.2 +038200 MOVE "." TO PARDOT-X IX1194.2 +038300 MOVE REC-CT TO DOTVALUE. IX1194.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. IX1194.2 +038500 PERFORM D-WRITE-LINE. IX1194.2 +038600 IF P-OR-F EQUAL TO "FAIL*" IX1194.2 +038700 PERFORM D-WRITE-LINE IX1194.2 +038800 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1194.2 +038900 ELSE IX1194.2 +039000 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1194.2 +039100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1194.2 +039200 MOVE SPACE TO CORRECT-X. IX1194.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1194.2 +039400 MOVE SPACE TO RE-MARK. IX1194.2 +039500 D-END-ROUTINE. IX1194.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1194.2 +039700 PERFORM D-WRITE-LINE 5 TIMES. IX1194.2 +039800 D-END-RTN-EXIT. IX1194.2 +039900 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1194.2 +040000 PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +040100 D-END-ROUTINE-1. IX1194.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1194.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1194.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1194.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1194.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1194.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1194.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1194.2 +040900 D-END-ROUTINE-12. IX1194.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1194.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1194.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1194.2 +041300 ELSE IX1194.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1194.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +041600 PERFORM D-WRITE-LINE. IX1194.2 +041700 D-END-ROUTINE-13. IX1194.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1194.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1194.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1194.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1194.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +042300 PERFORM D-WRITE-LINE. IX1194.2 +042400 IF INSPECT-COUNTER EQUAL TO ZERO IX1194.2 +042500 MOVE "NO " TO ERROR-TOTAL IX1194.2 +042600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1194.2 +042700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1194.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1194.2 +042900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1194.2 +043000 D-WRITE-LINE. IX1194.2 +043100 ADD 1 TO RECORD-COUNT. IX1194.2 +043200Y IF RECORD-COUNT GREATER 42 IX1194.2 +043300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1194.2 +043400Y MOVE SPACE TO DUMMY-RECORD IX1194.2 +043500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1194.2 +043600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1194.2 +043700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1194.2 +043800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1194.2 +043900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1194.2 +044000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1194.2 +044400Y MOVE ZERO TO RECORD-COUNT. IX1194.2 +044500 PERFORM D-WRT-LN. IX1194.2 +044600 D-WRT-LN. IX1194.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1194.2 +044800 MOVE SPACE TO DUMMY-RECORD. IX1194.2 +044900 D-FAIL-ROUTINE. IX1194.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1194.2 +045100 GO TO D-FAIL-ROUTINE-WRITE. IX1194.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1194.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1194.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +045700 GO TO D-FAIL-ROUTINE-EX. IX1194.2 +045800 D-FAIL-ROUTINE-WRITE. IX1194.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1194.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1194.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1194.2 +046300 D-FAIL-ROUTINE-EX. EXIT. IX1194.2 +046400 D-BAIL-OUT. IX1194.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1194.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1194.2 +046700 D-BAIL-OUT-WRITE. IX1194.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1194.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +047200 D-BAIL-OUT-EX. EXIT. IX1194.2 +047300 DECL-EXIT. EXIT. IX1194.2 +047400 END DECLARATIVES. IX1194.2 +047500 IX1194.2 +047600 IX1194.2 +047700 CCVS1 SECTION. IX1194.2 +047800 OPEN-FILES. IX1194.2 +047900P OPEN I-O RAW-DATA. IX1194.2 +048000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +048100P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1194.2 +048200P MOVE "ABORTED " TO C-ABORT. IX1194.2 +048300P ADD 1 TO C-NO-OF-TESTS. IX1194.2 +048400P ACCEPT C-DATE FROM DATE. IX1194.2 +048500P ACCEPT C-TIME FROM TIME. IX1194.2 +048600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1194.2 +048700PEND-E-1. IX1194.2 +048800P CLOSE RAW-DATA. IX1194.2 +048900 OPEN OUTPUT PRINT-FILE. IX1194.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1194.2 +049100 MOVE SPACE TO TEST-RESULTS. IX1194.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1194.2 +049300 MOVE ZERO TO REC-SKL-SUB. IX1194.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1194.2 +049500 CCVS-INIT-FILE. IX1194.2 +049600 ADD 1 TO REC-SKL-SUB. IX1194.2 +049700 MOVE FILE-RECORD-INFO-SKELETON IX1194.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1194.2 +049900 CCVS-INIT-EXIT. IX1194.2 +050000 GO TO CCVS1-EXIT. IX1194.2 +050100 CLOSE-FILES. IX1194.2 +050200P OPEN I-O RAW-DATA. IX1194.2 +050300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +050400P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1194.2 +050500P MOVE "OK. " TO C-ABORT. IX1194.2 +050600P MOVE PASS-COUNTER TO C-OK. IX1194.2 +050700P MOVE ERROR-HOLD TO C-ALL. IX1194.2 +050800P MOVE ERROR-COUNTER TO C-FAIL. IX1194.2 +050900P MOVE DELETE-COUNTER TO C-DELETED. IX1194.2 +051000P MOVE INSPECT-COUNTER TO C-INSPECT. IX1194.2 +051100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1194.2 +051200PEND-E-2. IX1194.2 +051300P CLOSE RAW-DATA. IX1194.2 +051400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1194.2 +051500 TERMINATE-CCVS. IX1194.2 +051600S EXIT PROGRAM. IX1194.2 +051700STERMINATE-CALL. IX1194.2 +051800 STOP RUN. IX1194.2 +051900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1194.2 +052000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1194.2 +052100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1194.2 +052200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1194.2 +052300 MOVE "****TEST DELETED****" TO RE-MARK. IX1194.2 +052400 PRINT-DETAIL. IX1194.2 +052500 IF REC-CT NOT EQUAL TO ZERO IX1194.2 +052600 MOVE "." TO PARDOT-X IX1194.2 +052700 MOVE REC-CT TO DOTVALUE. IX1194.2 +052800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1194.2 +052900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1194.2 +053000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1194.2 +053100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1194.2 +053200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1194.2 +053300 MOVE SPACE TO CORRECT-X. IX1194.2 +053400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1194.2 +053500 MOVE SPACE TO RE-MARK. IX1194.2 +053600 HEAD-ROUTINE. IX1194.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1194.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1194.2 +054100 COLUMN-NAMES-ROUTINE. IX1194.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +054500 END-ROUTINE. IX1194.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1194.2 +054700 END-RTN-EXIT. IX1194.2 +054800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +054900 END-ROUTINE-1. IX1194.2 +055000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1194.2 +055100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1194.2 +055200 ADD PASS-COUNTER TO ERROR-HOLD. IX1194.2 +055300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1194.2 +055400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1194.2 +055500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1194.2 +055600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1194.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1194.2 +055800 END-ROUTINE-12. IX1194.2 +055900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1194.2 +056000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1194.2 +056100 MOVE "NO " TO ERROR-TOTAL IX1194.2 +056200 ELSE IX1194.2 +056300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1194.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +056500 PERFORM WRITE-LINE. IX1194.2 +056600 END-ROUTINE-13. IX1194.2 +056700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1194.2 +056800 MOVE "NO " TO ERROR-TOTAL ELSE IX1194.2 +056900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1194.2 +057000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1194.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO IX1194.2 +057300 MOVE "NO " TO ERROR-TOTAL IX1194.2 +057400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1194.2 +057500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1194.2 +057600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057800 WRITE-LINE. IX1194.2 +057900 ADD 1 TO RECORD-COUNT. IX1194.2 +058000Y IF RECORD-COUNT GREATER 42 IX1194.2 +058100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1194.2 +058200Y MOVE SPACE TO DUMMY-RECORD IX1194.2 +058300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1194.2 +058400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1194.2 +058500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1194.2 +058600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1194.2 +058700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1194.2 +058800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +058900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +059000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +059100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1194.2 +059200Y MOVE ZERO TO RECORD-COUNT. IX1194.2 +059300 PERFORM WRT-LN. IX1194.2 +059400 WRT-LN. IX1194.2 +059500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1194.2 +059600 MOVE SPACE TO DUMMY-RECORD. IX1194.2 +059700 BLANK-LINE-PRINT. IX1194.2 +059800 PERFORM WRT-LN. IX1194.2 +059900 FAIL-ROUTINE. IX1194.2 +060000 IF COMPUTED-X NOT EQUAL TO SPACE IX1194.2 +060100 GO TO FAIL-ROUTINE-WRITE. IX1194.2 +060200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1194.2 +060300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +060400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1194.2 +060500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +060600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +060700 GO TO FAIL-ROUTINE-EX. IX1194.2 +060800 FAIL-ROUTINE-WRITE. IX1194.2 +060900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1194.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1194.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1194.2 +061200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1194.2 +061300 FAIL-ROUTINE-EX. EXIT. IX1194.2 +061400 BAIL-OUT. IX1194.2 +061500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1194.2 +061600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1194.2 +061700 BAIL-OUT-WRITE. IX1194.2 +061800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1194.2 +061900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +062000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +062100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +062200 BAIL-OUT-EX. EXIT. IX1194.2 +062300 CCVS1-EXIT. IX1194.2 +062400 EXIT. IX1194.2 +062500 IX1194.2 +062600 SECT-IX119A-0003 SECTION. IX1194.2 +062700 SEQ-INIT-010. IX1194.2 +062800 MOVE ZERO TO TEST-NO. IX1194.2 +062900 MOVE "IX-FS3" TO XFILE-NAME (1). IX1194.2 +063000 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1194.2 +063100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1194.2 +063200 MOVE 000240 TO XRECORD-LENGTH (1). IX1194.2 +063300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1194.2 +063400 MOVE 0002 TO XBLOCK-SIZE (1). IX1194.2 +063500 MOVE 000050 TO RECORDS-IN-FILE (1). IX1194.2 +063600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1194.2 +063700 MOVE "S" TO XLABEL-TYPE (1). IX1194.2 +063800 MOVE 000001 TO XRECORD-NUMBER (1). IX1194.2 +063900 MOVE 0 TO COUNT-OF-RECS. IX1194.2 +064000 IX1194.2 +064100******************************************************************IX1194.2 +064200* TEST 1 *IX1194.2 +064300* OPEN OUTPUT ... 00 EXPECTED *IX1194.2 +064400* IX-3, 1.3.4 (1) A *IX1194.2 +064500* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1194.2 +064600* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1194.2 +064700******************************************************************IX1194.2 +064800 OPN-INIT-GF-01-0. IX1194.2 +064900 MOVE 1 TO STATUS-TEST-00. IX1194.2 +065000 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +065100 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1194.2 +065200 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +065300 OPEN IX1194.2 +065400 I-O IX-FS3. IX1194.2 +065500 IF IX-FS3-STATUS EQUAL TO "00" IX1194.2 +065600 GO TO OPN-PASS-GF-01-0. IX1194.2 +065700 OPN-FAIL-GF-01-0. IX1194.2 +065800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1194.2 +065900 PERFORM FAIL. IX1194.2 +066000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +066100 MOVE "00" TO CORRECT-X. IX1194.2 +066200 GO TO OPN-WRITE-GF-01-0. IX1194.2 +066300 OPN-PASS-GF-01-0. IX1194.2 +066400 PERFORM PASS. IX1194.2 +066500 OPN-WRITE-GF-01-0. IX1194.2 +066600 PERFORM PRINT-DETAIL. IX1194.2 +066700******************************************************************IX1194.2 +066800* TEST 4 *IX1194.2 +066900* REWRITE PRIME RECORD SHOULD BE CHANGED 21 OR 22 EXPECTED IX1194.2 +067000* IX-3, 1.3.4 (3) A *IX1194.2 +067100******************************************************************IX1194.2 +067200 RWR-INIT-GF-01-0. IX1194.2 +067300 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +067400 MOVE 0 TO STATUS-TEST-00. IX1194.2 +067500 MOVE "REWRITE: 21/22 EXP." TO FEATURE. IX1194.2 +067600 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +067700 READ IX-FS3 AT END MOVE 0 TO IX-FS3-KEY. IX1194.2 +067800 MOVE 9 TO XRECORD-NUMBER (1). IX1194.2 +067900 RWR-TEST-GF-01-0. IX1194.2 +068000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1194.2 +068100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1194.2 +068200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1194.2 +068300 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1194.2 +068400 REWRITE IX-FS3R1-F-G-240 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1194.2 +068500 RWR-TEST-GF-01-1. IX1194.2 +068600 IF IX-FS3-STATUS = "21" IX1194.2 +068700 GO TO RWR-PASS-GF-01-0. IX1194.2 +068800 IF IX-FS3-STATUS = "22" IX1194.2 +068900 GO TO RWR-PASS-GF-01-0. IX1194.2 +069000 RWR-FAIL-GF-01-0. IX1194.2 +069100 MOVE "IX-3, 1.3.4, (3) A. " TO RE-MARK. IX1194.2 +069200 PERFORM FAIL. IX1194.2 +069300 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +069400 MOVE "21" TO CORRECT-X. IX1194.2 +069500 GO TO RWR-WRITE-GF-01-0. IX1194.2 +069600 RWR-PASS-GF-01-0. IX1194.2 +069700 PERFORM PASS. IX1194.2 +069800 RWR-WRITE-GF-01-0. IX1194.2 +069900 PERFORM PRINT-DETAIL. IX1194.2 +070000 IX1194.2 +070100******************************************************************IX1194.2 +070200* TEST 5 *IX1194.2 +070300* DELETE.... STATUS 43 EXPECTED IX1194.2 +070400* IX-5, 1.3.4 (5) C IX1194.2 +070500******************************************************************IX1194.2 +070600 DEL-TEST-GF-01-0. IX1194.2 +070700 MOVE 5 TO TEST-NO. IX1194.2 +070800 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +070900 MOVE "DELETE 43 EXP." TO FEATURE IX1194.2 +071000 MOVE "DEL-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +071100 DELETE IX-FS3 RECORD. IX1194.2 +071200 DEL-TEST-GF-01-1. IX1194.2 +071300 IF IX-FS3-STATUS EQUAL TO "43" IX1194.2 +071400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1194.2 +071500 TO RE-MARK IX1194.2 +071600 GO TO DEL-WRITE-GF-01-0. IX1194.2 +071700 DEL-FAIL-GF-01-0. IX1194.2 +071800 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1194.2 +071900 DEL-WRITE-GF-01-0. IX1194.2 +072000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +072100 MOVE "43" TO CORRECT-X. IX1194.2 +072200 PERFORM FAIL. IX1194.2 +072300 PERFORM PRINT-DETAIL. IX1194.2 +072400 CLOSE IX-FS3. IX1194.2 +072500 IX1194.2 +072600 TERMINATE-ROUTINE. IX1194.2 +072700 EXIT. IX1194.2 +072800 IX1194.2 +072900 CCVS-EXIT SECTION. IX1194.2 +073000 CCVS-999999. IX1194.2 +073100 GO TO CLOSE-FILES. IX1194.2 +*END-OF,IX119A +*HEADER,COBOL,IX113A,SUBPRG,IX120A +000100 IDENTIFICATION DIVISION. IX1204.2 +000200 PROGRAM-ID. IX1204.2 +000300 IX120A. IX1204.2 +000400**************************************************************** IX1204.2 +000500* * IX1204.2 +000600* VALIDATION FOR:- * IX1204.2 +000700* * IX1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +000900* * IX1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1204.2 +001100* * IX1204.2 +001200**************************************************************** IX1204.2 +001300* IX1204.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1204.2 +001500* IX113A. IX1204.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1204.2 +001700* THE FILE IS THEN READ UNTIL THE AT END CONDITION IS REACHED IX1204.2 +001800* AND THEN READ ONCE MORE. AN ATTEMPT IS THEN MADE TO REWRITE IX1204.2 +001900* A RECORD, AT WHICH POINT THE DECLARATIVES IX1204.2 +002000* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 43 . IX1204.2 +002100* IX1204.2 +002200* STANDARD REFERENCE IX-5, 1.3.4 (5) C IX1204.2 +002300* IX1204.2 +002400* X-CARDS USED IN THIS PROGRAM: IX1204.2 +002500* IX1204.2 +002600* XXXXX024 IX1204.2 +002700* XXXXX055. IX1204.2 +002800* P XXXXX062. IX1204.2 +002900* XXXXX082. IX1204.2 +003000* XXXXX083. IX1204.2 +003100* C XXXXX084 IX1204.2 +003200* IX1204.2 +003300* IX1204.2 +003400 ENVIRONMENT DIVISION. IX1204.2 +003500 CONFIGURATION SECTION. IX1204.2 +003600 SOURCE-COMPUTER. IX1204.2 +003700 XXXXX082. IX1204.2 +003800 OBJECT-COMPUTER. IX1204.2 +003900 XXXXX083. IX1204.2 +004000 INPUT-OUTPUT SECTION. IX1204.2 +004100 FILE-CONTROL. IX1204.2 +004200P SELECT RAW-DATA ASSIGN TO IX1204.2 +004300P XXXXX062 IX1204.2 +004400P ORGANIZATION IS INDEXED IX1204.2 +004500P ACCESS MODE IS RANDOM IX1204.2 +004600P RECORD KEY IS RAW-DATA-KEY. IX1204.2 +004700* IX1204.2 +004800 SELECT PRINT-FILE ASSIGN TO IX1204.2 +004900 XXXXX055. IX1204.2 +005000* IX1204.2 +005100 SELECT IX-FS3 ASSIGN IX1204.2 +005200 XXXXX024 IX1204.2 +005300 ORGANIZATION IS INDEXED IX1204.2 +005400 ACCESS MODE IS SEQUENTIAL IX1204.2 +005500 RECORD KEY IS IX-FS3-KEY IX1204.2 +005600 FILE STATUS IS IX-FS3-STATUS. IX1204.2 +005700 IX1204.2 +005800 DATA DIVISION. IX1204.2 +005900 IX1204.2 +006000 FILE SECTION. IX1204.2 +006100P IX1204.2 +006200PFD RAW-DATA. IX1204.2 +006300P IX1204.2 +006400P01 RAW-DATA-SATZ. IX1204.2 +006500P 05 RAW-DATA-KEY PIC X(6). IX1204.2 +006600P 05 C-DATE PIC 9(6). IX1204.2 +006700P 05 C-TIME PIC 9(8). IX1204.2 +006800P 05 C-NO-OF-TESTS PIC 99. IX1204.2 +006900P 05 C-OK PIC 999. IX1204.2 +007000P 05 C-ALL PIC 999. IX1204.2 +007100P 05 C-FAIL PIC 999. IX1204.2 +007200P 05 C-DELETED PIC 999. IX1204.2 +007300P 05 C-INSPECT PIC 999. IX1204.2 +007400P 05 C-NOTE PIC X(13). IX1204.2 +007500P 05 C-INDENT PIC X. IX1204.2 +007600P 05 C-ABORT PIC X(8). IX1204.2 +007700 IX1204.2 +007800 FD PRINT-FILE. IX1204.2 +007900 IX1204.2 +008000 01 PRINT-REC PIC X(120). IX1204.2 +008100 IX1204.2 +008200 01 DUMMY-RECORD PIC X(120). IX1204.2 +008300 IX1204.2 +008400 FD IX-FS3 IX1204.2 +008500C DATA RECORDS IX-FS3R1-F-G-240 IX1204.2 +008600C LABEL RECORD STANDARD IX1204.2 +008700 RECORD 240 IX1204.2 +008800 BLOCK CONTAINS 2 RECORDS. IX1204.2 +008900 IX1204.2 +009000 01 IX-FS3R1-F-G-240. IX1204.2 +009100 05 IX-FS3-REC-120 PIC X(120). IX1204.2 +009200 05 IX-FS3-REC-120-240. IX1204.2 +009300 10 FILLER PIC X(8). IX1204.2 +009400 10 IX-FS3-KEY PIC X(29). IX1204.2 +009500 10 FILLER PIC X(9). IX1204.2 +009600 10 IX-FS3-ALTER-KEY PIC X(29). IX1204.2 +009700 10 FILLER PIC X(45). IX1204.2 +009800 IX1204.2 +009900 IX1204.2 +010000 WORKING-STORAGE SECTION. IX1204.2 +010100 IX1204.2 +010200 01 GRP-0101. IX1204.2 +010300 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1204.2 +010400 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1204.2 +010500 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1204.2 +010600 IX1204.2 +010700 01 GRP-0102. IX1204.2 +010800 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1204.2 +010900 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1204.2 +011000 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1204.2 +011100 IX1204.2 +011200 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1204.2 +011300 IX1204.2 +011400 01 EOF-FLAG PIC 9 VALUE ZERO. IX1204.2 +011500 IX1204.2 +011600 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1204.2 +011700 IX1204.2 +011800 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1204.2 +011900 IX1204.2 +012000 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1204.2 +012100 IX1204.2 +012200 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1204.2 +012300 IX1204.2 +012400 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1204.2 +012500 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1204.2 +012600 IX1204.2 +012700 01 IX-FS3-STATUS. IX1204.2 +012800 05 IX-FS3-STAT1 PIC X. IX1204.2 +012900 05 IX-FS3-STAT2 PIC X. IX1204.2 +013000 IX1204.2 +013100 01 COUNT-OF-RECS PIC 9(5). IX1204.2 +013200 IX1204.2 +013300 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1204.2 +013400 IX1204.2 +013500 01 FILE-RECORD-INFORMATION-REC. IX1204.2 +013600 05 FILE-RECORD-INFO-SKELETON. IX1204.2 +013700 10 FILLER PIC X(48) VALUE IX1204.2 +013800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1204.2 +013900 10 FILLER PIC X(46) VALUE IX1204.2 +014000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1204.2 +014100 10 FILLER PIC X(26) VALUE IX1204.2 +014200 ",LFIL=000000,ORG= ,LBLR= ". IX1204.2 +014300 10 FILLER PIC X(37) VALUE IX1204.2 +014400 ",RECKEY= ". IX1204.2 +014500 10 FILLER PIC X(38) VALUE IX1204.2 +014600 ",ALTKEY1= ". IX1204.2 +014700 10 FILLER PIC X(38) VALUE IX1204.2 +014800 ",ALTKEY2= ". IX1204.2 +014900 10 FILLER PIC X(7) VALUE SPACE. IX1204.2 +015000 05 FILE-RECORD-INFO OCCURS 10. IX1204.2 +015100 10 FILE-RECORD-INFO-P1-120. IX1204.2 +015200 15 FILLER PIC X(5). IX1204.2 +015300 15 XFILE-NAME PIC X(6). IX1204.2 +015400 15 FILLER PIC X(8). IX1204.2 +015500 15 XRECORD-NAME PIC X(6). IX1204.2 +015600 15 FILLER PIC X(1). IX1204.2 +015700 15 REELUNIT-NUMBER PIC 9(1). IX1204.2 +015800 15 FILLER PIC X(7). IX1204.2 +015900 15 XRECORD-NUMBER PIC 9(6). IX1204.2 +016000 15 FILLER PIC X(6). IX1204.2 +016100 15 UPDATE-NUMBER PIC 9(2). IX1204.2 +016200 15 FILLER PIC X(5). IX1204.2 +016300 15 ODO-NUMBER PIC 9(4). IX1204.2 +016400 15 FILLER PIC X(5). IX1204.2 +016500 15 XPROGRAM-NAME PIC X(5). IX1204.2 +016600 15 FILLER PIC X(7). IX1204.2 +016700 15 XRECORD-LENGTH PIC 9(6). IX1204.2 +016800 15 FILLER PIC X(7). IX1204.2 +016900 15 CHARS-OR-RECORDS PIC X(2). IX1204.2 +017000 15 FILLER PIC X(1). IX1204.2 +017100 15 XBLOCK-SIZE PIC 9(4). IX1204.2 +017200 15 FILLER PIC X(6). IX1204.2 +017300 15 RECORDS-IN-FILE PIC 9(6). IX1204.2 +017400 15 FILLER PIC X(5). IX1204.2 +017500 15 XFILE-ORGANIZATION PIC X(2). IX1204.2 +017600 15 FILLER PIC X(6). IX1204.2 +017700 15 XLABEL-TYPE PIC X(1). IX1204.2 +017800 10 FILE-RECORD-INFO-P121-240. IX1204.2 +017900 15 FILLER PIC X(8). IX1204.2 +018000 15 XRECORD-KEY PIC X(29). IX1204.2 +018100 15 FILLER PIC X(9). IX1204.2 +018200 15 ALTERNATE-KEY1 PIC X(29). IX1204.2 +018300 15 FILLER PIC X(9). IX1204.2 +018400 15 ALTERNATE-KEY2 PIC X(29). IX1204.2 +018500 15 FILLER PIC X(7). IX1204.2 +018600 IX1204.2 +018700 01 TEST-RESULTS. IX1204.2 +018800 02 FILLER PIC X VALUE SPACE. IX1204.2 +018900 02 FEATURE PIC X(20) VALUE SPACE. IX1204.2 +019000 02 FILLER PIC X VALUE SPACE. IX1204.2 +019100 02 P-OR-F PIC X(5) VALUE SPACE. IX1204.2 +019200 02 FILLER PIC X VALUE SPACE. IX1204.2 +019300 02 PAR-NAME. IX1204.2 +019400 03 FILLER PIC X(19) VALUE SPACE. IX1204.2 +019500 03 PARDOT-X PIC X VALUE SPACE. IX1204.2 +019600 03 DOTVALUE PIC 99 VALUE ZERO. IX1204.2 +019700 02 FILLER PIC X(8) VALUE SPACE. IX1204.2 +019800 02 RE-MARK PIC X(61). IX1204.2 +019900 01 TEST-COMPUTED. IX1204.2 +020000 02 FILLER PIC X(30) VALUE SPACE. IX1204.2 +020100 02 FILLER PIC X(17) VALUE IX1204.2 +020200 " COMPUTED=". IX1204.2 +020300 02 COMPUTED-X. IX1204.2 +020400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1204.2 +020500 03 COMPUTED-N REDEFINES COMPUTED-A IX1204.2 +020600 PIC -9(9).9(9). IX1204.2 +020700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1204.2 +020800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1204.2 +020900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1204.2 +021000 03 CM-18V0 REDEFINES COMPUTED-A. IX1204.2 +021100 04 COMPUTED-18V0 PIC -9(18). IX1204.2 +021200 04 FILLER PIC X. IX1204.2 +021300 03 FILLER PIC X(50) VALUE SPACE. IX1204.2 +021400 01 TEST-CORRECT. IX1204.2 +021500 02 FILLER PIC X(30) VALUE SPACE. IX1204.2 +021600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1204.2 +021700 02 CORRECT-X. IX1204.2 +021800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1204.2 +021900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1204.2 +022000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1204.2 +022100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1204.2 +022200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1204.2 +022300 03 CR-18V0 REDEFINES CORRECT-A. IX1204.2 +022400 04 CORRECT-18V0 PIC -9(18). IX1204.2 +022500 04 FILLER PIC X. IX1204.2 +022600 03 FILLER PIC X(2) VALUE SPACE. IX1204.2 +022700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1204.2 +022800 01 CCVS-C-1. IX1204.2 +022900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1204.2 +023000- "SS PARAGRAPH-NAME IX1204.2 +023100- " REMARKS". IX1204.2 +023200 02 FILLER PIC X(20) VALUE SPACE. IX1204.2 +023300 01 CCVS-C-2. IX1204.2 +023400 02 FILLER PIC X VALUE SPACE. IX1204.2 +023500 02 FILLER PIC X(6) VALUE "TESTED". IX1204.2 +023600 02 FILLER PIC X(15) VALUE SPACE. IX1204.2 +023700 02 FILLER PIC X(4) VALUE "FAIL". IX1204.2 +023800 02 FILLER PIC X(94) VALUE SPACE. IX1204.2 +023900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1204.2 +024000 01 REC-CT PIC 99 VALUE ZERO. IX1204.2 +024100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1204.2 +024600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1204.2 +024700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1204.2 +024800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1204.2 +024900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1204.2 +025000 01 CCVS-H-1. IX1204.2 +025100 02 FILLER PIC X(39) VALUE SPACES. IX1204.2 +025200 02 FILLER PIC X(42) VALUE IX1204.2 +025300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1204.2 +025400 02 FILLER PIC X(39) VALUE SPACES. IX1204.2 +025500 01 CCVS-H-2A. IX1204.2 +025600 02 FILLER PIC X(40) VALUE SPACE. IX1204.2 +025700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1204.2 +025800 02 FILLER PIC XXXX VALUE IX1204.2 +025900 "4.2 ". IX1204.2 +026000 02 FILLER PIC X(28) VALUE IX1204.2 +026100 " COPY - NOT FOR DISTRIBUTION". IX1204.2 +026200 02 FILLER PIC X(41) VALUE SPACE. IX1204.2 +026300 IX1204.2 +026400 01 CCVS-H-2B. IX1204.2 +026500 02 FILLER PIC X(15) VALUE IX1204.2 +026600 "TEST RESULT OF ". IX1204.2 +026700 02 TEST-ID PIC X(9). IX1204.2 +026800 02 FILLER PIC X(4) VALUE IX1204.2 +026900 " IN ". IX1204.2 +027000 02 FILLER PIC X(12) VALUE IX1204.2 +027100 " HIGH ". IX1204.2 +027200 02 FILLER PIC X(22) VALUE IX1204.2 +027300 " LEVEL VALIDATION FOR ". IX1204.2 +027400 02 FILLER PIC X(58) VALUE IX1204.2 +027500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +027600 01 CCVS-H-3. IX1204.2 +027700 02 FILLER PIC X(34) VALUE IX1204.2 +027800 " FOR OFFICIAL USE ONLY ". IX1204.2 +027900 02 FILLER PIC X(58) VALUE IX1204.2 +028000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1204.2 +028100 02 FILLER PIC X(28) VALUE IX1204.2 +028200 " COPYRIGHT 1985 ". IX1204.2 +028300 01 CCVS-E-1. IX1204.2 +028400 02 FILLER PIC X(52) VALUE SPACE. IX1204.2 +028500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1204.2 +028600 02 ID-AGAIN PIC X(9). IX1204.2 +028700 02 FILLER PIC X(45) VALUE SPACES. IX1204.2 +028800 01 CCVS-E-2. IX1204.2 +028900 02 FILLER PIC X(31) VALUE SPACE. IX1204.2 +029000 02 FILLER PIC X(21) VALUE SPACE. IX1204.2 +029100 02 CCVS-E-2-2. IX1204.2 +029200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1204.2 +029300 03 FILLER PIC X VALUE SPACE. IX1204.2 +029400 03 ENDER-DESC PIC X(44) VALUE IX1204.2 +029500 "ERRORS ENCOUNTERED". IX1204.2 +029600 01 CCVS-E-3. IX1204.2 +029700 02 FILLER PIC X(22) VALUE IX1204.2 +029800 " FOR OFFICIAL USE ONLY". IX1204.2 +029900 02 FILLER PIC X(12) VALUE SPACE. IX1204.2 +030000 02 FILLER PIC X(58) VALUE IX1204.2 +030100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +030200 02 FILLER PIC X(13) VALUE SPACE. IX1204.2 +030300 02 FILLER PIC X(15) VALUE IX1204.2 +030400 " COPYRIGHT 1985". IX1204.2 +030500 01 CCVS-E-4. IX1204.2 +030600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1204.2 +030700 02 FILLER PIC X(4) VALUE " OF ". IX1204.2 +030800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1204.2 +030900 02 FILLER PIC X(40) VALUE IX1204.2 +031000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1204.2 +031100 01 XXINFO. IX1204.2 +031200 02 FILLER PIC X(19) VALUE IX1204.2 +031300 "*** INFORMATION ***". IX1204.2 +031400 02 INFO-TEXT. IX1204.2 +031500 04 FILLER PIC X(8) VALUE SPACE. IX1204.2 +031600 04 XXCOMPUTED PIC X(20). IX1204.2 +031700 04 FILLER PIC X(5) VALUE SPACE. IX1204.2 +031800 04 XXCORRECT PIC X(20). IX1204.2 +031900 02 INF-ANSI-REFERENCE PIC X(48). IX1204.2 +032000 01 HYPHEN-LINE. IX1204.2 +032100 02 FILLER PIC IS X VALUE IS SPACE. IX1204.2 +032200 02 FILLER PIC IS X(65) VALUE IS "************************IX1204.2 +032300- "*****************************************". IX1204.2 +032400 02 FILLER PIC IS X(54) VALUE IS "************************IX1204.2 +032500- "******************************". IX1204.2 +032600 01 TEST-NO PIC 99. IX1204.2 +032700 01 CCVS-PGM-ID PIC X(9) VALUE IX1204.2 +032800 "IX120A". IX1204.2 +032900 PROCEDURE DIVISION. IX1204.2 +033000 DECLARATIVES. IX1204.2 +033100 IX1204.2 +033200 SECT-IX105-0002 SECTION. IX1204.2 +033300 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1204.2 +033400 INPUT-PROCESS. IX1204.2 +033500 IF TEST-NO = 5 IX1204.2 +033600 GO TO D-C-TEST-GF-01-1. IX1204.2 +033700 IF STATUS-TEST-10 EQUAL TO 1 IX1204.2 +033800 IF IX-FS3-STAT1 EQUAL TO "1" IX1204.2 +033900 MOVE 1 TO EOF-FLAG IX1204.2 +034000 ELSE IX1204.2 +034100 IF IX-FS3-STAT1 GREATER THAN "1" IX1204.2 +034200 MOVE 1 TO PERM-ERRORS. IX1204.2 +034300 GO TO DECL-EXIT. IX1204.2 +034400 D-C-TEST-GF-01-1. IX1204.2 +034500 IF IX-FS3-STATUS EQUAL TO "43" IX1204.2 +034600 GO TO D-C-PASS-GF-01-0. IX1204.2 +034700 D-C-FAIL-GF-01-0. IX1204.2 +034800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +034900 MOVE "43" TO CORRECT-X. IX1204.2 +035000 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1204.2 +035100 PERFORM D-FAIL. IX1204.2 +035200 GO TO D-C-WRITE-GF-01-0. IX1204.2 +035300 D-C-PASS-GF-01-0. IX1204.2 +035400 PERFORM D-PASS. IX1204.2 +035500 D-C-WRITE-GF-01-0. IX1204.2 +035600 PERFORM D-PRINT-DETAIL. IX1204.2 +035700 D-CLOSE-FILES. IX1204.2 +035800 CLOSE IX-FS3. IX1204.2 +035900P OPEN I-O RAW-DATA. IX1204.2 +036000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +036100P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1204.2 +036200P MOVE "OK. " TO C-ABORT. IX1204.2 +036300P MOVE PASS-COUNTER TO C-OK. IX1204.2 +036400P MOVE ERROR-HOLD TO C-ALL. IX1204.2 +036500P MOVE ERROR-COUNTER TO C-FAIL. IX1204.2 +036600P MOVE DELETE-COUNTER TO C-DELETED. IX1204.2 +036700P MOVE INSPECT-COUNTER TO C-INSPECT. IX1204.2 +036800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1204.2 +036900PD-END-E-2. IX1204.2 +037000P CLOSE RAW-DATA. IX1204.2 +037100 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1204.2 +037200 CLOSE PRINT-FILE. IX1204.2 +037300 D-TERMINATE-CCVS. IX1204.2 +037400S EXIT PROGRAM. IX1204.2 +037500SD-TERMINATE-CALL. IX1204.2 +037600 STOP RUN. IX1204.2 +037700 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1204.2 +037800 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1204.2 +037900 D-PRINT-DETAIL. IX1204.2 +038000 IF REC-CT NOT EQUAL TO ZERO IX1204.2 +038100 MOVE "." TO PARDOT-X IX1204.2 +038200 MOVE REC-CT TO DOTVALUE. IX1204.2 +038300 MOVE TEST-RESULTS TO PRINT-REC. IX1204.2 +038400 PERFORM D-WRITE-LINE. IX1204.2 +038500 IF P-OR-F EQUAL TO "FAIL*" IX1204.2 +038600 PERFORM D-WRITE-LINE IX1204.2 +038700 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1204.2 +038800 ELSE IX1204.2 +038900 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1204.2 +039000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1204.2 +039100 MOVE SPACE TO CORRECT-X. IX1204.2 +039200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1204.2 +039300 MOVE SPACE TO RE-MARK. IX1204.2 +039400 D-END-ROUTINE. IX1204.2 +039500 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1204.2 +039600 PERFORM D-WRITE-LINE 5 TIMES. IX1204.2 +039700 D-END-RTN-EXIT. IX1204.2 +039800 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1204.2 +039900 PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +040000 D-END-ROUTINE-1. IX1204.2 +040100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1204.2 +040200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1204.2 +040300 ADD PASS-COUNTER TO ERROR-HOLD. IX1204.2 +040400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1204.2 +040500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1204.2 +040600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1204.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1204.2 +040800 D-END-ROUTINE-12. IX1204.2 +040900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1204.2 +041000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1204.2 +041100 MOVE "NO " TO ERROR-TOTAL IX1204.2 +041200 ELSE IX1204.2 +041300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1204.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +041500 PERFORM D-WRITE-LINE. IX1204.2 +041600 D-END-ROUTINE-13. IX1204.2 +041700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1204.2 +041800 MOVE "NO " TO ERROR-TOTAL ELSE IX1204.2 +041900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1204.2 +042000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1204.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +042200 PERFORM D-WRITE-LINE. IX1204.2 +042300 IF INSPECT-COUNTER EQUAL TO ZERO IX1204.2 +042400 MOVE "NO " TO ERROR-TOTAL IX1204.2 +042500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1204.2 +042600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1204.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1204.2 +042800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1204.2 +042900 D-WRITE-LINE. IX1204.2 +043000 ADD 1 TO RECORD-COUNT. IX1204.2 +043100Y IF RECORD-COUNT GREATER 42 IX1204.2 +043200Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1204.2 +043300Y MOVE SPACE TO DUMMY-RECORD IX1204.2 +043400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1204.2 +043500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1204.2 +043600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1204.2 +043700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1204.2 +043800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1204.2 +043900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044200Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1204.2 +044300Y MOVE ZERO TO RECORD-COUNT. IX1204.2 +044400 PERFORM D-WRT-LN. IX1204.2 +044500 D-WRT-LN. IX1204.2 +044600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1204.2 +044700 MOVE SPACE TO DUMMY-RECORD. IX1204.2 +044800 D-FAIL-ROUTINE. IX1204.2 +044900 IF COMPUTED-X NOT EQUAL TO SPACE IX1204.2 +045000 GO TO D-FAIL-ROUTINE-WRITE. IX1204.2 +045100 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1204.2 +045200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +045300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1204.2 +045400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +045500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +045600 GO TO D-FAIL-ROUTINE-EX. IX1204.2 +045700 D-FAIL-ROUTINE-WRITE. IX1204.2 +045800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1204.2 +045900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1204.2 +046000 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +046100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1204.2 +046200 D-FAIL-ROUTINE-EX. EXIT. IX1204.2 +046300 D-BAIL-OUT. IX1204.2 +046400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1204.2 +046500 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1204.2 +046600 D-BAIL-OUT-WRITE. IX1204.2 +046700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1204.2 +046800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +046900 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +047100 D-BAIL-OUT-EX. EXIT. IX1204.2 +047200 DECL-EXIT. EXIT. IX1204.2 +047300 END DECLARATIVES. IX1204.2 +047400 IX1204.2 +047500 IX1204.2 +047600 CCVS1 SECTION. IX1204.2 +047700 OPEN-FILES. IX1204.2 +047800P OPEN I-O RAW-DATA. IX1204.2 +047900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +048000P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1204.2 +048100P MOVE "ABORTED " TO C-ABORT. IX1204.2 +048200P ADD 1 TO C-NO-OF-TESTS. IX1204.2 +048300P ACCEPT C-DATE FROM DATE. IX1204.2 +048400P ACCEPT C-TIME FROM TIME. IX1204.2 +048500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1204.2 +048600PEND-E-1. IX1204.2 +048700P CLOSE RAW-DATA. IX1204.2 +048800 OPEN OUTPUT PRINT-FILE. IX1204.2 +048900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1204.2 +049000 MOVE SPACE TO TEST-RESULTS. IX1204.2 +049100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1204.2 +049200 MOVE ZERO TO REC-SKL-SUB. IX1204.2 +049300 PERFORM CCVS-INIT-FILE 9 TIMES. IX1204.2 +049400 CCVS-INIT-FILE. IX1204.2 +049500 ADD 1 TO REC-SKL-SUB. IX1204.2 +049600 MOVE FILE-RECORD-INFO-SKELETON IX1204.2 +049700 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1204.2 +049800 CCVS-INIT-EXIT. IX1204.2 +049900 GO TO CCVS1-EXIT. IX1204.2 +050000 CLOSE-FILES. IX1204.2 +050100P OPEN I-O RAW-DATA. IX1204.2 +050200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +050300P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1204.2 +050400P MOVE "OK. " TO C-ABORT. IX1204.2 +050500P MOVE PASS-COUNTER TO C-OK. IX1204.2 +050600P MOVE ERROR-HOLD TO C-ALL. IX1204.2 +050700P MOVE ERROR-COUNTER TO C-FAIL. IX1204.2 +050800P MOVE DELETE-COUNTER TO C-DELETED. IX1204.2 +050900P MOVE INSPECT-COUNTER TO C-INSPECT. IX1204.2 +051000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1204.2 +051100PEND-E-2. IX1204.2 +051200P CLOSE RAW-DATA. IX1204.2 +051300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1204.2 +051400 TERMINATE-CCVS. IX1204.2 +051500S EXIT PROGRAM. IX1204.2 +051600STERMINATE-CALL. IX1204.2 +051700 STOP RUN. IX1204.2 +051800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1204.2 +051900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1204.2 +052000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1204.2 +052100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1204.2 +052200 MOVE "****TEST DELETED****" TO RE-MARK. IX1204.2 +052300 PRINT-DETAIL. IX1204.2 +052400 IF REC-CT NOT EQUAL TO ZERO IX1204.2 +052500 MOVE "." TO PARDOT-X IX1204.2 +052600 MOVE REC-CT TO DOTVALUE. IX1204.2 +052700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1204.2 +052800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1204.2 +052900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1204.2 +053000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1204.2 +053100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1204.2 +053200 MOVE SPACE TO CORRECT-X. IX1204.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1204.2 +053400 MOVE SPACE TO RE-MARK. IX1204.2 +053500 HEAD-ROUTINE. IX1204.2 +053600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +053700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +053800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1204.2 +053900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1204.2 +054000 COLUMN-NAMES-ROUTINE. IX1204.2 +054100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +054200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +054400 END-ROUTINE. IX1204.2 +054500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1204.2 +054600 END-RTN-EXIT. IX1204.2 +054700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +054800 END-ROUTINE-1. IX1204.2 +054900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1204.2 +055000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1204.2 +055100 ADD PASS-COUNTER TO ERROR-HOLD. IX1204.2 +055200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1204.2 +055300 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1204.2 +055400 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1204.2 +055500 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1204.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1204.2 +055700 END-ROUTINE-12. IX1204.2 +055800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1204.2 +055900 IF ERROR-COUNTER IS EQUAL TO ZERO IX1204.2 +056000 MOVE "NO " TO ERROR-TOTAL IX1204.2 +056100 ELSE IX1204.2 +056200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1204.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +056400 PERFORM WRITE-LINE. IX1204.2 +056500 END-ROUTINE-13. IX1204.2 +056600 IF DELETE-COUNTER IS EQUAL TO ZERO IX1204.2 +056700 MOVE "NO " TO ERROR-TOTAL ELSE IX1204.2 +056800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1204.2 +056900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1204.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057100 IF INSPECT-COUNTER EQUAL TO ZERO IX1204.2 +057200 MOVE "NO " TO ERROR-TOTAL IX1204.2 +057300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1204.2 +057400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1204.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057700 WRITE-LINE. IX1204.2 +057800 ADD 1 TO RECORD-COUNT. IX1204.2 +057900Y IF RECORD-COUNT GREATER 42 IX1204.2 +058000Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1204.2 +058100Y MOVE SPACE TO DUMMY-RECORD IX1204.2 +058200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1204.2 +058300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1204.2 +058400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1204.2 +058500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1204.2 +058600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1204.2 +058700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +058800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +058900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +059000Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1204.2 +059100Y MOVE ZERO TO RECORD-COUNT. IX1204.2 +059200 PERFORM WRT-LN. IX1204.2 +059300 WRT-LN. IX1204.2 +059400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1204.2 +059500 MOVE SPACE TO DUMMY-RECORD. IX1204.2 +059600 BLANK-LINE-PRINT. IX1204.2 +059700 PERFORM WRT-LN. IX1204.2 +059800 FAIL-ROUTINE. IX1204.2 +059900 IF COMPUTED-X NOT EQUAL TO SPACE IX1204.2 +060000 GO TO FAIL-ROUTINE-WRITE. IX1204.2 +060100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1204.2 +060200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +060300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1204.2 +060400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +060500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +060600 GO TO FAIL-ROUTINE-EX. IX1204.2 +060700 FAIL-ROUTINE-WRITE. IX1204.2 +060800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1204.2 +060900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1204.2 +061000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1204.2 +061100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1204.2 +061200 FAIL-ROUTINE-EX. EXIT. IX1204.2 +061300 BAIL-OUT. IX1204.2 +061400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1204.2 +061500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1204.2 +061600 BAIL-OUT-WRITE. IX1204.2 +061700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1204.2 +061800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +061900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +062000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +062100 BAIL-OUT-EX. EXIT. IX1204.2 +062200 CCVS1-EXIT. IX1204.2 +062300 EXIT. IX1204.2 +062400 IX1204.2 +062500 SECT-IX120A-0003 SECTION. IX1204.2 +062600 SEQ-INIT-010. IX1204.2 +062700 MOVE ZERO TO TEST-NO. IX1204.2 +062800 MOVE "IX-FS3" TO XFILE-NAME (1). IX1204.2 +062900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1204.2 +063000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1204.2 +063100 MOVE 000240 TO XRECORD-LENGTH (1). IX1204.2 +063200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1204.2 +063300 MOVE 0002 TO XBLOCK-SIZE (1). IX1204.2 +063400 MOVE 000050 TO RECORDS-IN-FILE (1). IX1204.2 +063500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1204.2 +063600 MOVE "S" TO XLABEL-TYPE (1). IX1204.2 +063700 MOVE 000001 TO XRECORD-NUMBER (1). IX1204.2 +063800 MOVE 0 TO COUNT-OF-RECS. IX1204.2 +063900 IX1204.2 +064000******************************************************************IX1204.2 +064100* TEST 1 *IX1204.2 +064200* OPEN OUTPUT ... 00 EXPECTED *IX1204.2 +064300* IX-3, 1.3.4 (1) A *IX1204.2 +064400* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1204.2 +064500* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1204.2 +064600******************************************************************IX1204.2 +064700 OPN-INIT-GF-01-0. IX1204.2 +064800 MOVE 1 TO STATUS-TEST-00. IX1204.2 +064900 MOVE SPACES TO IX-FS3-STATUS. IX1204.2 +065000 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1204.2 +065100 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1204.2 +065200 OPEN IX1204.2 +065300 I-O IX-FS3. IX1204.2 +065400 IF IX-FS3-STATUS EQUAL TO "00" IX1204.2 +065500 GO TO OPN-PASS-GF-01-0. IX1204.2 +065600 OPN-FAIL-GF-01-0. IX1204.2 +065700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1204.2 +065800 PERFORM FAIL. IX1204.2 +065900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +066000 MOVE "00" TO CORRECT-X. IX1204.2 +066100 GO TO OPN-WRITE-GF-01-0. IX1204.2 +066200 OPN-PASS-GF-01-0. IX1204.2 +066300 PERFORM PASS. IX1204.2 +066400 OPN-WRITE-GF-01-0. IX1204.2 +066500 PERFORM PRINT-DETAIL. IX1204.2 +066600******************************************************************IX1204.2 +066700* TEST 5 *IX1204.2 +066800* REWRITE WHERE THE LAST EXECUTED I-O STATEMENT PRIOR TO *IX1204.2 +066900* THE REWRITE WAS NOT A SUCCESSFULLY EXECUTED READ IX1204.2 +067000* STATEMENT. STATUS 43 EXPECTED. IX1204.2 +067100* IX-3, 1.3.4 (3) A *IX1204.2 +067200******************************************************************IX1204.2 +067300 RWR-INIT-GF-01-0. IX1204.2 +067400 MOVE 5 TO TEST-NO. IX1204.2 +067500 MOVE SPACES TO IX-FS3-STATUS. IX1204.2 +067600 MOVE 0 TO STATUS-TEST-00. IX1204.2 +067700 MOVE "REWRITE: 43 EXP." TO FEATURE. IX1204.2 +067800 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1204.2 +067900*RWR-READ-GF-01-0. IX1204.2 +068000* READ IX-FS3 AT END GO TO RWR-TEST-GF-01-0. IX1204.2 +068100* GO TO RWR-READ-GF-01-0. IX1204.2 +068200*RWR-TEST-GF-01-0. IX1204.2 +068300* READ IX-FS3 AT END GO TO RWR-TEST-GF-01-1. IX1204.2 +068400* MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1204.2 +068500 RWR-TEST-GF-01-1. IX1204.2 +068600 REWRITE IX-FS3R1-F-G-240. IX1204.2 +068700 IF IX-FS3-STATUS EQUAL TO "43" IX1204.2 +068800 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1204.2 +068900 TO RE-MARK IX1204.2 +069000 GO TO RWR-WRITE-GF-01-0. IX1204.2 +069100 RWR-FAIL-GF-01-0. IX1204.2 +069200 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1204.2 +069300 RWR-WRITE-GF-01-0. IX1204.2 +069400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +069500 MOVE "43" TO CORRECT-X. IX1204.2 +069600 PERFORM FAIL. IX1204.2 +069700 PERFORM PRINT-DETAIL. IX1204.2 +069800 CLOSE IX-FS3. IX1204.2 +069900 IX1204.2 +070000 TERMINATE-ROUTINE. IX1204.2 +070100 EXIT. IX1204.2 +070200 IX1204.2 +070300 CCVS-EXIT SECTION. IX1204.2 +070400 CCVS-999999. IX1204.2 +070500 GO TO CLOSE-FILES. IX1204.2 +*END-OF,IX120A +*HEADER,COBOL,IX121A +000100 IDENTIFICATION DIVISION. IX1214.2 +000200 PROGRAM-ID. IX1214.2 +000300 IX121A. IX1214.2 +000400**************************************************************** IX1214.2 +000500* * IX1214.2 +000600* VALIDATION FOR:- * IX1214.2 +000700* * IX1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +000900* * IX1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1214.2 +001100* * IX1214.2 +001200**************************************************************** IX1214.2 +001300* IX1214.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-VS2 IX1214.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1214.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1214.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THEN THE FILE IS OPENED IX1214.2 +001800* AS I-O AND IT IS ATTEMTED TO REWRITE A RECORD WITH A IX1214.2 +001900* WRONG RECORD LENGTH. THE RECORD REWRITTEN IS LONGER IX1214.2 +002000* THAN THE RECORD READ. IX1214.2 +002100* IX1214.2 +002200* NOTE: THIS PROGRAM IS A SUPPLEMENT TO PROGRAM IX112A, WHICH IX1214.2 +002300* REWRITES A RECORD SHORTER THAN THE RECORD READ. IX1214.2 +002400* IX1214.2 +002500* 2. THE ROUTINE READS THE CREATED FILE, VERIFIES IT AND IX1214.2 +002600* CHECKS THE FILE STATUS CODE: IX1214.2 +002700* 44 - AFTER REWRITE (WITH WRONG RECORD LENGTH) IX1214.2 +002800* IX1214.2 +002900* 3. X-CARDS USED IN THIS PROGRAM: IX1214.2 +003000* IX1214.2 +003100* XXXXX024 IX1214.2 +003200* XXXXX055. IX1214.2 +003300* XXXXX062. IX1214.2 +003400* XXXXX082. IX1214.2 +003500* XXXXX083. IX1214.2 +003600* XXXXX084 IX1214.2 +003700* IX1214.2 +003800* IX1214.2 +003900 ENVIRONMENT DIVISION. IX1214.2 +004000 CONFIGURATION SECTION. IX1214.2 +004100 SOURCE-COMPUTER. IX1214.2 +004200 XXXXX082. IX1214.2 +004300 OBJECT-COMPUTER. IX1214.2 +004400 XXXXX083. IX1214.2 +004500 INPUT-OUTPUT SECTION. IX1214.2 +004600 FILE-CONTROL. IX1214.2 +004700P SELECT RAW-DATA ASSIGN TO IX1214.2 +004800P XXXXX062 IX1214.2 +004900P ORGANIZATION IS INDEXED IX1214.2 +005000P ACCESS MODE IS RANDOM IX1214.2 +005100P RECORD KEY IS RAW-DATA-KEY. IX1214.2 +005200* IX1214.2 +005300 SELECT PRINT-FILE ASSIGN TO IX1214.2 +005400 XXXXX055. IX1214.2 +005500* IX1214.2 +005600 SELECT IX-VS2 ASSIGN IX1214.2 +005700 XXXXX024 IX1214.2 +005800 ORGANIZATION IS INDEXED IX1214.2 +005900 ACCESS MODE IS SEQUENTIAL IX1214.2 +006000 RECORD KEY IS IX-VS2-KEY IX1214.2 +006100 FILE STATUS IS IX-VS2-STATUS. IX1214.2 +006200 IX1214.2 +006300 DATA DIVISION. IX1214.2 +006400 IX1214.2 +006500 FILE SECTION. IX1214.2 +006600P IX1214.2 +006700PFD RAW-DATA. IX1214.2 +006800P IX1214.2 +006900P01 RAW-DATA-SATZ. IX1214.2 +007000P 05 RAW-DATA-KEY PIC X(6). IX1214.2 +007100P 05 C-DATE PIC 9(6). IX1214.2 +007200P 05 C-TIME PIC 9(8). IX1214.2 +007300P 05 C-NO-OF-TESTS PIC 99. IX1214.2 +007400P 05 C-OK PIC 999. IX1214.2 +007500P 05 C-ALL PIC 999. IX1214.2 +007600P 05 C-FAIL PIC 999. IX1214.2 +007700P 05 C-DELETED PIC 999. IX1214.2 +007800P 05 C-INSPECT PIC 999. IX1214.2 +007900P 05 C-NOTE PIC X(13). IX1214.2 +008000P 05 C-INDENT PIC X. IX1214.2 +008100P 05 C-ABORT PIC X(8). IX1214.2 +008200 IX1214.2 +008300 FD PRINT-FILE. IX1214.2 +008400 IX1214.2 +008500 01 PRINT-REC PIC X(120). IX1214.2 +008600 IX1214.2 +008700 01 DUMMY-RECORD PIC X(120). IX1214.2 +008800 IX1214.2 +008900 FD IX-VS2 IX1214.2 +009000C DATA RECORDS IX-VS2R1-F-G-240 IX-VS2R1-F-G-200 IX1214.2 +009100C IX-VS2R1-F-G-280 IX1214.2 +009200C LABEL RECORD STANDARD IX1214.2 +009300 RECORD 200 TO 280 IX1214.2 +009400 BLOCK CONTAINS 2 RECORDS. IX1214.2 +009500 IX1214.2 +009600 01 IX-VS2R1-F-G-240. IX1214.2 +009700 05 IX-VS2-REC-120 PIC X(120). IX1214.2 +009800 05 IX-VS2-REC-120-240. IX1214.2 +009900 10 FILLER PIC X(8). IX1214.2 +010000 10 IX-VS2-KEY PIC X(29). IX1214.2 +010100 10 FILLER PIC X(9). IX1214.2 +010200 10 IX-VS2-ALTER-KEY PIC X(29). IX1214.2 +010300 10 FILLER PIC X(45). IX1214.2 +010400 IX1214.2 +010500 01 IX-VS2R1-F-G-200. IX1214.2 +010600 05 IX-VS2-REC-SHORT PIC X(120). IX1214.2 +010700 05 IX-VS2-REC-120-200 PIC X(80). IX1214.2 +010800 IX1214.2 +010900 01 IX-VS2R1-F-G-280. IX1214.2 +011000 05 IX-VS2-REC-LONG PIC X(120). IX1214.2 +011100 05 IX-VS2-REC-120-239 PIC X(120). IX1214.2 +011200 05 IX-VS2-REC-240-280 PIC X(40). IX1214.2 +011300 IX1214.2 +011400 WORKING-STORAGE SECTION. IX1214.2 +011500 IX1214.2 +011600 01 GRP-0101. IX1214.2 +011700 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1214.2 +011800 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1214.2 +011900 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1214.2 +012000 IX1214.2 +012100 01 GRP-0102. IX1214.2 +012200 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1214.2 +012300 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1214.2 +012400 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1214.2 +012500 IX1214.2 +012600 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1214.2 +012700 IX1214.2 +012800 01 EOF-FLAG PIC 9 VALUE ZERO. IX1214.2 +012900 IX1214.2 +013000 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1214.2 +013100 IX1214.2 +013200 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1214.2 +013300 IX1214.2 +013400 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1214.2 +013500 IX1214.2 +013600 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1214.2 +013700 IX1214.2 +013800 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1214.2 +013900 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1214.2 +014000 IX1214.2 +014100 01 IX-VS2-STATUS. IX1214.2 +014200 05 IX-VS2-STAT1 PIC X. IX1214.2 +014300 05 IX-VS2-STAT2 PIC X. IX1214.2 +014400 IX1214.2 +014500 01 COUNT-OF-RECS PIC 9(5). IX1214.2 +014600 IX1214.2 +014700 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1214.2 +014800 IX1214.2 +014900 01 FILE-RECORD-INFORMATION-REC. IX1214.2 +015000 05 FILE-RECORD-INFO-SKELETON. IX1214.2 +015100 10 FILLER PIC X(48) VALUE IX1214.2 +015200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1214.2 +015300 10 FILLER PIC X(46) VALUE IX1214.2 +015400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1214.2 +015500 10 FILLER PIC X(26) VALUE IX1214.2 +015600 ",LFIL=000000,ORG= ,LBLR= ". IX1214.2 +015700 10 FILLER PIC X(37) VALUE IX1214.2 +015800 ",RECKEY= ". IX1214.2 +015900 10 FILLER PIC X(38) VALUE IX1214.2 +016000 ",ALTKEY1= ". IX1214.2 +016100 10 FILLER PIC X(38) VALUE IX1214.2 +016200 ",ALTKEY2= ". IX1214.2 +016300 10 FILLER PIC X(7) VALUE SPACE. IX1214.2 +016400 05 FILE-RECORD-INFO OCCURS 10. IX1214.2 +016500 10 FILE-RECORD-INFO-P1-120. IX1214.2 +016600 15 FILLER PIC X(5). IX1214.2 +016700 15 XFILE-NAME PIC X(6). IX1214.2 +016800 15 FILLER PIC X(8). IX1214.2 +016900 15 XRECORD-NAME PIC X(6). IX1214.2 +017000 15 FILLER PIC X(1). IX1214.2 +017100 15 REELUNIT-NUMBER PIC 9(1). IX1214.2 +017200 15 FILLER PIC X(7). IX1214.2 +017300 15 XRECORD-NUMBER PIC 9(6). IX1214.2 +017400 15 FILLER PIC X(6). IX1214.2 +017500 15 UPDATE-NUMBER PIC 9(2). IX1214.2 +017600 15 FILLER PIC X(5). IX1214.2 +017700 15 ODO-NUMBER PIC 9(4). IX1214.2 +017800 15 FILLER PIC X(5). IX1214.2 +017900 15 XPROGRAM-NAME PIC X(5). IX1214.2 +018000 15 FILLER PIC X(7). IX1214.2 +018100 15 XRECORD-LENGTH PIC 9(6). IX1214.2 +018200 15 FILLER PIC X(7). IX1214.2 +018300 15 CHARS-OR-RECORDS PIC X(2). IX1214.2 +018400 15 FILLER PIC X(1). IX1214.2 +018500 15 XBLOCK-SIZE PIC 9(4). IX1214.2 +018600 15 FILLER PIC X(6). IX1214.2 +018700 15 RECORDS-IN-FILE PIC 9(6). IX1214.2 +018800 15 FILLER PIC X(5). IX1214.2 +018900 15 XFILE-ORGANIZATION PIC X(2). IX1214.2 +019000 15 FILLER PIC X(6). IX1214.2 +019100 15 XLABEL-TYPE PIC X(1). IX1214.2 +019200 10 FILE-RECORD-INFO-P121-240. IX1214.2 +019300 15 FILLER PIC X(8). IX1214.2 +019400 15 XRECORD-KEY PIC X(29). IX1214.2 +019500 15 FILLER PIC X(9). IX1214.2 +019600 15 ALTERNATE-KEY1 PIC X(29). IX1214.2 +019700 15 FILLER PIC X(9). IX1214.2 +019800 15 ALTERNATE-KEY2 PIC X(29). IX1214.2 +019900 15 FILLER PIC X(7). IX1214.2 +020000 IX1214.2 +020100 01 TEST-RESULTS. IX1214.2 +020200 02 FILLER PIC X VALUE SPACE. IX1214.2 +020300 02 FEATURE PIC X(20) VALUE SPACE. IX1214.2 +020400 02 FILLER PIC X VALUE SPACE. IX1214.2 +020500 02 P-OR-F PIC X(5) VALUE SPACE. IX1214.2 +020600 02 FILLER PIC X VALUE SPACE. IX1214.2 +020700 02 PAR-NAME. IX1214.2 +020800 03 FILLER PIC X(19) VALUE SPACE. IX1214.2 +020900 03 PARDOT-X PIC X VALUE SPACE. IX1214.2 +021000 03 DOTVALUE PIC 99 VALUE ZERO. IX1214.2 +021100 02 FILLER PIC X(8) VALUE SPACE. IX1214.2 +021200 02 RE-MARK PIC X(61). IX1214.2 +021300 01 TEST-COMPUTED. IX1214.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1214.2 +021500 02 FILLER PIC X(17) VALUE IX1214.2 +021600 " COMPUTED=". IX1214.2 +021700 02 COMPUTED-X. IX1214.2 +021800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1214.2 +021900 03 COMPUTED-N REDEFINES COMPUTED-A IX1214.2 +022000 PIC -9(9).9(9). IX1214.2 +022100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1214.2 +022200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1214.2 +022300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1214.2 +022400 03 CM-18V0 REDEFINES COMPUTED-A. IX1214.2 +022500 04 COMPUTED-18V0 PIC -9(18). IX1214.2 +022600 04 FILLER PIC X. IX1214.2 +022700 03 FILLER PIC X(50) VALUE SPACE. IX1214.2 +022800 01 TEST-CORRECT. IX1214.2 +022900 02 FILLER PIC X(30) VALUE SPACE. IX1214.2 +023000 02 FILLER PIC X(17) VALUE " CORRECT =". IX1214.2 +023100 02 CORRECT-X. IX1214.2 +023200 03 CORRECT-A PIC X(20) VALUE SPACE. IX1214.2 +023300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1214.2 +023400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1214.2 +023500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1214.2 +023600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1214.2 +023700 03 CR-18V0 REDEFINES CORRECT-A. IX1214.2 +023800 04 CORRECT-18V0 PIC -9(18). IX1214.2 +023900 04 FILLER PIC X. IX1214.2 +024000 03 FILLER PIC X(2) VALUE SPACE. IX1214.2 +024100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1214.2 +024200 01 CCVS-C-1. IX1214.2 +024300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1214.2 +024400- "SS PARAGRAPH-NAME IX1214.2 +024500- " REMARKS". IX1214.2 +024600 02 FILLER PIC X(20) VALUE SPACE. IX1214.2 +024700 01 CCVS-C-2. IX1214.2 +024800 02 FILLER PIC X VALUE SPACE. IX1214.2 +024900 02 FILLER PIC X(6) VALUE "TESTED". IX1214.2 +025000 02 FILLER PIC X(15) VALUE SPACE. IX1214.2 +025100 02 FILLER PIC X(4) VALUE "FAIL". IX1214.2 +025200 02 FILLER PIC X(94) VALUE SPACE. IX1214.2 +025300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1214.2 +025400 01 REC-CT PIC 99 VALUE ZERO. IX1214.2 +025500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1214.2 +026000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1214.2 +026100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1214.2 +026200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1214.2 +026300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1214.2 +026400 01 CCVS-H-1. IX1214.2 +026500 02 FILLER PIC X(39) VALUE SPACES. IX1214.2 +026600 02 FILLER PIC X(42) VALUE IX1214.2 +026700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1214.2 +026800 02 FILLER PIC X(39) VALUE SPACES. IX1214.2 +026900 01 CCVS-H-2A. IX1214.2 +027000 02 FILLER PIC X(40) VALUE SPACE. IX1214.2 +027100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1214.2 +027200 02 FILLER PIC XXXX VALUE IX1214.2 +027300 "4.2 ". IX1214.2 +027400 02 FILLER PIC X(28) VALUE IX1214.2 +027500 " COPY - NOT FOR DISTRIBUTION". IX1214.2 +027600 02 FILLER PIC X(41) VALUE SPACE. IX1214.2 +027700 IX1214.2 +027800 01 CCVS-H-2B. IX1214.2 +027900 02 FILLER PIC X(15) VALUE IX1214.2 +028000 "TEST RESULT OF ". IX1214.2 +028100 02 TEST-ID PIC X(9). IX1214.2 +028200 02 FILLER PIC X(4) VALUE IX1214.2 +028300 " IN ". IX1214.2 +028400 02 FILLER PIC X(12) VALUE IX1214.2 +028500 " HIGH ". IX1214.2 +028600 02 FILLER PIC X(22) VALUE IX1214.2 +028700 " LEVEL VALIDATION FOR ". IX1214.2 +028800 02 FILLER PIC X(58) VALUE IX1214.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +029000 01 CCVS-H-3. IX1214.2 +029100 02 FILLER PIC X(34) VALUE IX1214.2 +029200 " FOR OFFICIAL USE ONLY ". IX1214.2 +029300 02 FILLER PIC X(58) VALUE IX1214.2 +029400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1214.2 +029500 02 FILLER PIC X(28) VALUE IX1214.2 +029600 " COPYRIGHT 1985 ". IX1214.2 +029700 01 CCVS-E-1. IX1214.2 +029800 02 FILLER PIC X(52) VALUE SPACE. IX1214.2 +029900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1214.2 +030000 02 ID-AGAIN PIC X(9). IX1214.2 +030100 02 FILLER PIC X(45) VALUE SPACES. IX1214.2 +030200 01 CCVS-E-2. IX1214.2 +030300 02 FILLER PIC X(31) VALUE SPACE. IX1214.2 +030400 02 FILLER PIC X(21) VALUE SPACE. IX1214.2 +030500 02 CCVS-E-2-2. IX1214.2 +030600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1214.2 +030700 03 FILLER PIC X VALUE SPACE. IX1214.2 +030800 03 ENDER-DESC PIC X(44) VALUE IX1214.2 +030900 "ERRORS ENCOUNTERED". IX1214.2 +031000 01 CCVS-E-3. IX1214.2 +031100 02 FILLER PIC X(22) VALUE IX1214.2 +031200 " FOR OFFICIAL USE ONLY". IX1214.2 +031300 02 FILLER PIC X(12) VALUE SPACE. IX1214.2 +031400 02 FILLER PIC X(58) VALUE IX1214.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +031600 02 FILLER PIC X(13) VALUE SPACE. IX1214.2 +031700 02 FILLER PIC X(15) VALUE IX1214.2 +031800 " COPYRIGHT 1985". IX1214.2 +031900 01 CCVS-E-4. IX1214.2 +032000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1214.2 +032100 02 FILLER PIC X(4) VALUE " OF ". IX1214.2 +032200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1214.2 +032300 02 FILLER PIC X(40) VALUE IX1214.2 +032400 " TESTS WERE EXECUTED SUCCESSFULLY". IX1214.2 +032500 01 XXINFO. IX1214.2 +032600 02 FILLER PIC X(19) VALUE IX1214.2 +032700 "*** INFORMATION ***". IX1214.2 +032800 02 INFO-TEXT. IX1214.2 +032900 04 FILLER PIC X(8) VALUE SPACE. IX1214.2 +033000 04 XXCOMPUTED PIC X(20). IX1214.2 +033100 04 FILLER PIC X(5) VALUE SPACE. IX1214.2 +033200 04 XXCORRECT PIC X(20). IX1214.2 +033300 02 INF-ANSI-REFERENCE PIC X(48). IX1214.2 +033400 01 HYPHEN-LINE. IX1214.2 +033500 02 FILLER PIC IS X VALUE IS SPACE. IX1214.2 +033600 02 FILLER PIC IS X(65) VALUE IS "************************IX1214.2 +033700- "*****************************************". IX1214.2 +033800 02 FILLER PIC IS X(54) VALUE IS "************************IX1214.2 +033900- "******************************". IX1214.2 +034000 01 CCVS-PGM-ID PIC X(9) VALUE IX1214.2 +034100 "IX121A". IX1214.2 +034200 01 TEST-NUMBER PIC 9 VALUE ZERO. IX1214.2 +034300 IX1214.2 +034400 PROCEDURE DIVISION. IX1214.2 +034500 DECLARATIVES. IX1214.2 +034600 IX1214.2 +034700 SECT-IX105-0002 SECTION. IX1214.2 +034800 USE AFTER EXCEPTION PROCEDURE ON IX-VS2. IX1214.2 +034900 INPUT-PROCESS. IX1214.2 +035000 MOVE 1 TO PERM-ERRORS. IX1214.2 +035100 IF TEST-NUMBER NOT = 3 GO TO END-DECL. IX1214.2 +035200 D-RWR-TEST-GF-01-1. IX1214.2 +035300 IF IX-VS2-STATUS = "00" IX1214.2 +035400 GO TO D-RWR-PASS-GF-01-0. IX1214.2 +035500 IF IX-VS2-STATUS = "44" IX1214.2 +035600 GO TO D-RWR-PASS-GF-01-0. IX1214.2 +035700 D-RWR-FAIL-GF-01-0. IX1214.2 +035800 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1214.2 +035900 PERFORM D-FAIL. IX1214.2 +036000 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +036100 MOVE "00 OR 44" TO CORRECT-X. IX1214.2 +036200 GO TO D-RWR-WRITE-GF-01-0. IX1214.2 +036300 D-RWR-PASS-GF-01-0. IX1214.2 +036400 PERFORM D-PASS. IX1214.2 +036500 D-RWR-WRITE-GF-01-0. IX1214.2 +036600 PERFORM D-PRINT-DETAIL. IX1214.2 +036700 D-CLOSE-FILES. IX1214.2 +036800P OPEN I-O RAW-DATA. IX1214.2 +036900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +037000P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1214.2 +037100P MOVE "OK. " TO C-ABORT. IX1214.2 +037200P MOVE PASS-COUNTER TO C-OK. IX1214.2 +037300P MOVE ERROR-HOLD TO C-ALL. IX1214.2 +037400P MOVE ERROR-COUNTER TO C-FAIL. IX1214.2 +037500P MOVE DELETE-COUNTER TO C-DELETED. IX1214.2 +037600P MOVE INSPECT-COUNTER TO C-INSPECT. IX1214.2 +037700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1214.2 +037800PD-END-E-2. IX1214.2 +037900P CLOSE RAW-DATA. IX1214.2 +038000 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1214.2 +038100 CLOSE PRINT-FILE. IX1214.2 +038200 D-TERMINATE-CCVS. IX1214.2 +038300S EXIT PROGRAM. IX1214.2 +038400SD-TERMINATE-CALL. IX1214.2 +038500 STOP RUN. IX1214.2 +038600 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1214.2 +038700 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1214.2 +038800 D-PRINT-DETAIL. IX1214.2 +038900 IF REC-CT NOT EQUAL TO ZERO IX1214.2 +039000 MOVE "." TO PARDOT-X IX1214.2 +039100 MOVE REC-CT TO DOTVALUE. IX1214.2 +039200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. IX1214.2 +039300 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE IX1214.2 +039400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1214.2 +039500 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1214.2 +039600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1214.2 +039700 MOVE SPACE TO CORRECT-X. IX1214.2 +039800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1214.2 +039900 MOVE SPACE TO RE-MARK. IX1214.2 +040000 D-END-ROUTINE. IX1214.2 +040100 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1214.2 +040200 PERFORM D-WRITE-LINE 5 TIMES. IX1214.2 +040300 D-END-RTN-EXIT. IX1214.2 +040400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +040500 D-END-ROUTINE-1. IX1214.2 +040600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1214.2 +040700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1214.2 +040800 ADD PASS-COUNTER TO ERROR-HOLD. IX1214.2 +040900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1214.2 +041000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1214.2 +041100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1214.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1214.2 +041300 D-END-ROUTINE-12. IX1214.2 +041400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1214.2 +041500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1214.2 +041600 MOVE "NO " TO ERROR-TOTAL IX1214.2 +041700 ELSE IX1214.2 +041800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1214.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1214.2 +042000 PERFORM D-WRITE-LINE. IX1214.2 +042100 D-END-ROUTINE-13. IX1214.2 +042200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1214.2 +042300 MOVE "NO " TO ERROR-TOTAL ELSE IX1214.2 +042400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1214.2 +042500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1214.2 +042600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +042700 IF INSPECT-COUNTER EQUAL TO ZERO IX1214.2 +042800 MOVE "NO " TO ERROR-TOTAL IX1214.2 +042900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1214.2 +043000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1214.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +043200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +043300 D-WRITE-LINE. IX1214.2 +043400 ADD 1 TO RECORD-COUNT. IX1214.2 +043500Y IF RECORD-COUNT GREATER 42 IX1214.2 +043600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1214.2 +043700Y MOVE SPACE TO DUMMY-RECORD IX1214.2 +043800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1214.2 +043900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1214.2 +044000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1214.2 +044100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1214.2 +044200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1214.2 +044300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1214.2 +044700Y MOVE ZERO TO RECORD-COUNT. IX1214.2 +044800 PERFORM D-WRT-LN. IX1214.2 +044900 D-WRT-LN. IX1214.2 +045000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1214.2 +045100 MOVE SPACE TO DUMMY-RECORD. IX1214.2 +045200 D-BLANK-LINE-PRINT. IX1214.2 +045300 PERFORM D-WRT-LN. IX1214.2 +045400 D-FAIL-ROUTINE. IX1214.2 +045500 IF COMPUTED-X NOT EQUAL TO SPACE IX1214.2 +045600 GO TO D-FAIL-ROUTINE-WRITE. IX1214.2 +045700 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE. IX1214.2 +045800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +045900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1214.2 +046000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +046100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +046200 GO TO D-FAIL-ROUTINE-EX. IX1214.2 +046300 D-FAIL-ROUTINE-WRITE. IX1214.2 +046400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1214.2 +046500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1214.2 +046600 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +046700 MOVE SPACES TO COR-ANSI-REFERENCE. IX1214.2 +046800 D-FAIL-ROUTINE-EX. EXIT. IX1214.2 +046900 D-BAIL-OUT. IX1214.2 +047000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1214.2 +047100 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1214.2 +047200 D-BAIL-OUT-WRITE. IX1214.2 +047300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1214.2 +047400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +047500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +047600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +047700 D-BAIL-OUT-EX. EXIT. IX1214.2 +047800 IX1214.2 +047900 END-DECL. IX1214.2 +048000 END DECLARATIVES. IX1214.2 +048100 IX1214.2 +048200 IX1214.2 +048300 CCVS1 SECTION. IX1214.2 +048400 OPEN-FILES. IX1214.2 +048500P OPEN I-O RAW-DATA. IX1214.2 +048600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +048700P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1214.2 +048800P MOVE "ABORTED " TO C-ABORT. IX1214.2 +048900P ADD 1 TO C-NO-OF-TESTS. IX1214.2 +049000P ACCEPT C-DATE FROM DATE. IX1214.2 +049100P ACCEPT C-TIME FROM TIME. IX1214.2 +049200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1214.2 +049300PEND-E-1. IX1214.2 +049400P CLOSE RAW-DATA. IX1214.2 +049500 OPEN OUTPUT PRINT-FILE. IX1214.2 +049600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1214.2 +049700 MOVE SPACE TO TEST-RESULTS. IX1214.2 +049800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1214.2 +049900 MOVE ZERO TO REC-SKL-SUB. IX1214.2 +050000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1214.2 +050100 CCVS-INIT-FILE. IX1214.2 +050200 ADD 1 TO REC-SKL-SUB. IX1214.2 +050300 MOVE FILE-RECORD-INFO-SKELETON IX1214.2 +050400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1214.2 +050500 CCVS-INIT-EXIT. IX1214.2 +050600 GO TO CCVS1-EXIT. IX1214.2 +050700 CLOSE-FILES. IX1214.2 +050800P OPEN I-O RAW-DATA. IX1214.2 +050900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +051000P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1214.2 +051100P MOVE "OK. " TO C-ABORT. IX1214.2 +051200P MOVE PASS-COUNTER TO C-OK. IX1214.2 +051300P MOVE ERROR-HOLD TO C-ALL. IX1214.2 +051400P MOVE ERROR-COUNTER TO C-FAIL. IX1214.2 +051500P MOVE DELETE-COUNTER TO C-DELETED. IX1214.2 +051600P MOVE INSPECT-COUNTER TO C-INSPECT. IX1214.2 +051700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1214.2 +051800PEND-E-2. IX1214.2 +051900P CLOSE RAW-DATA. IX1214.2 +052000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1214.2 +052100 TERMINATE-CCVS. IX1214.2 +052200S EXIT PROGRAM. IX1214.2 +052300STERMINATE-CALL. IX1214.2 +052400 STOP RUN. IX1214.2 +052500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1214.2 +052600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1214.2 +052700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1214.2 +052800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1214.2 +052900 MOVE "****TEST DELETED****" TO RE-MARK. IX1214.2 +053000 PRINT-DETAIL. IX1214.2 +053100 IF REC-CT NOT EQUAL TO ZERO IX1214.2 +053200 MOVE "." TO PARDOT-X IX1214.2 +053300 MOVE REC-CT TO DOTVALUE. IX1214.2 +053400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1214.2 +053500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1214.2 +053600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1214.2 +053700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1214.2 +053800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1214.2 +053900 MOVE SPACE TO CORRECT-X. IX1214.2 +054000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1214.2 +054100 MOVE SPACE TO RE-MARK. IX1214.2 +054200 HEAD-ROUTINE. IX1214.2 +054300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +054400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +054500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1214.2 +054600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1214.2 +054700 COLUMN-NAMES-ROUTINE. IX1214.2 +054800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +054900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +055100 END-ROUTINE. IX1214.2 +055200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1214.2 +055300 END-RTN-EXIT. IX1214.2 +055400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +055500 END-ROUTINE-1. IX1214.2 +055600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1214.2 +055700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1214.2 +055800 ADD PASS-COUNTER TO ERROR-HOLD. IX1214.2 +055900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1214.2 +056000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1214.2 +056100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1214.2 +056200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1214.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1214.2 +056400 END-ROUTINE-12. IX1214.2 +056500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1214.2 +056600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1214.2 +056700 MOVE "NO " TO ERROR-TOTAL IX1214.2 +056800 ELSE IX1214.2 +056900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1214.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1214.2 +057100 PERFORM WRITE-LINE. IX1214.2 +057200 END-ROUTINE-13. IX1214.2 +057300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1214.2 +057400 MOVE "NO " TO ERROR-TOTAL ELSE IX1214.2 +057500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1214.2 +057600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1214.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +057800 IF INSPECT-COUNTER EQUAL TO ZERO IX1214.2 +057900 MOVE "NO " TO ERROR-TOTAL IX1214.2 +058000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1214.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1214.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +058400 WRITE-LINE. IX1214.2 +058500 ADD 1 TO RECORD-COUNT. IX1214.2 +058600Y IF RECORD-COUNT GREATER 42 IX1214.2 +058700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX1214.2 +058800Y MOVE SPACE TO DUMMY-RECORD IX1214.2 +058900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1214.2 +059000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1214.2 +059100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1214.2 +059200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1214.2 +059300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1214.2 +059400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX1214.2 +059800Y MOVE ZERO TO RECORD-COUNT. IX1214.2 +059900 PERFORM WRT-LN. IX1214.2 +060000 WRT-LN. IX1214.2 +060100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1214.2 +060200 MOVE SPACE TO DUMMY-RECORD. IX1214.2 +060300 BLANK-LINE-PRINT. IX1214.2 +060400 PERFORM WRT-LN. IX1214.2 +060500 FAIL-ROUTINE. IX1214.2 +060600 IF COMPUTED-X NOT EQUAL TO SPACE IX1214.2 +060700 GO TO FAIL-ROUTINE-WRITE. IX1214.2 +060800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1214.2 +060900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +061000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1214.2 +061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +061200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +061300 GO TO FAIL-ROUTINE-EX. IX1214.2 +061400 FAIL-ROUTINE-WRITE. IX1214.2 +061500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1214.2 +061600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1214.2 +061700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1214.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1214.2 +061900 FAIL-ROUTINE-EX. EXIT. IX1214.2 +062000 BAIL-OUT. IX1214.2 +062100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1214.2 +062200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1214.2 +062300 BAIL-OUT-WRITE. IX1214.2 +062400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1214.2 +062500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +062600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +062700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +062800 BAIL-OUT-EX. EXIT. IX1214.2 +062900 CCVS1-EXIT. IX1214.2 +063000 EXIT. IX1214.2 +063100 IX1214.2 +063200 SECT-IX121A-0003 SECTION. IX1214.2 +063300 SEQ-INIT-010. IX1214.2 +063400 MOVE "IX-VS2" TO XFILE-NAME (1). IX1214.2 +063500 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1214.2 +063600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1214.2 +063700 MOVE 000240 TO XRECORD-LENGTH (1). IX1214.2 +063800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1214.2 +063900 MOVE 0002 TO XBLOCK-SIZE (1). IX1214.2 +064000 MOVE 000050 TO RECORDS-IN-FILE (1). IX1214.2 +064100 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1214.2 +064200 MOVE "S" TO XLABEL-TYPE (1). IX1214.2 +064300 MOVE 000001 TO XRECORD-NUMBER (1). IX1214.2 +064400 MOVE 0 TO COUNT-OF-RECS. IX1214.2 +064500 IX1214.2 +064600******************************************************************IX1214.2 +064700* TEST 1 *IX1214.2 +064800* OPEN OUTPUT ... 00 EXPECTED *IX1214.2 +064900* IX-3, 1.3.4 (1) a *IX1214.2 +065000* STATUS 00 CHECK ON OUTPUT FILE IX-VS2 *IX1214.2 +065100* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1214.2 +065200******************************************************************IX1214.2 +065300 OPN-INIT-GF-01-0. IX1214.2 +065400 ADD 1 TO TEST-NUMBER. IX1214.2 +065500 MOVE 1 TO STATUS-TEST-00. IX1214.2 +065600 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +065700 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1214.2 +065800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +065900 OPEN IX1214.2 +066000 OUTPUT IX-VS2. IX1214.2 +066100 IF IX-VS2-STATUS EQUAL TO "00" IX1214.2 +066200 GO TO OPN-PASS-GF-01-0. IX1214.2 +066300 OPN-FAIL-GF-01-0. IX1214.2 +066400 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1214.2 +066500 PERFORM FAIL. IX1214.2 +066600 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +066700 MOVE "00" TO CORRECT-X. IX1214.2 +066800 GO TO OPN-WRITE-GF-01-0. IX1214.2 +066900 OPN-PASS-GF-01-0. IX1214.2 +067000 PERFORM PASS. IX1214.2 +067100 OPN-WRITE-GF-01-0. IX1214.2 +067200 PERFORM PRINT-DETAIL. IX1214.2 +067300******************************************************************IX1214.2 +067400* TEST 2 *IX1214.2 +067500* WRITE 00 EXPECTED *IX1214.2 +067600* IX-3, 1.3.4 (1) a *IX1214.2 +067700* CREATING A INDEXED FILE WITH 50 RECORDS *IX1214.2 +067800* KEY: FROM 000000001 TO 000000050 *IX1214.2 +067900******************************************************************IX1214.2 +068000 WRI-INIT-GF-01-0. IX1214.2 +068100 ADD 1 TO TEST-NUMBER. IX1214.2 +068200 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +068300 MOVE 0 TO STATUS-TEST-00. IX1214.2 +068400 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1214.2 +068500 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +068600 WRI-TEST-GF-01-0. IX1214.2 +068700 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1214.2 +068800 MOVE GRP-0101 TO XRECORD-KEY (1). IX1214.2 +068900 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1214.2 +069000* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1214.2 +069100 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1214.2 +069200 WRITE IX-VS2R1-F-G-240. IX1214.2 +069300 IF IX-VS2-STATUS NOT = "00" IX1214.2 +069400 MOVE 1 TO STATUS-TEST-00 IX1214.2 +069500 GO TO WRI-FAIL-GF-01-0. IX1214.2 +069600 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1214.2 +069700 GO TO WRI-TEST-GF-01-1. IX1214.2 +069800 ADD 1 TO XRECORD-NUMBER (1). IX1214.2 +069900 GO TO WRI-TEST-GF-01-0. IX1214.2 +070000 WRI-TEST-GF-01-1. IX1214.2 +070100 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1214.2 +070200 GO TO WRI-PASS-GF-01-0. IX1214.2 +070300 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1214.2 +070400 WRI-FAIL-GF-01-0. IX1214.2 +070500 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1214.2 +070600 PERFORM FAIL. IX1214.2 +070700 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1214.2 +070800 GO TO WRI-WRITE-GF-01-0. IX1214.2 +070900 WRI-PASS-GF-01-0. IX1214.2 +071000 PERFORM PASS. IX1214.2 +071100 WRI-WRITE-GF-01-0. IX1214.2 +071200 PERFORM PRINT-DETAIL. IX1214.2 +071300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1214.2 +071400 MOVE "CREATE FILE IX-VS2" TO FEATURE. IX1214.2 +071500 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1214.2 +071600 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1214.2 +071700 PERFORM PRINT-DETAIL. IX1214.2 +071800******************************************************************IX1214.2 +071900* TEST 3 *IX1214.2 +072000* REWRITE (WITH WRONG RECORD LENGTH (SHORTER)) *IX1214.2 +072100* IX-5, 1.3.4 (5) d 1 & 2 *IX1214.2 +072200* FILE STATUS 00 OR 44 EXPECTED *IX1214.2 +072300* KEY: 000000005 *IX1214.2 +072400******************************************************************IX1214.2 +072500 RWR-INIT-GF-01-0. IX1214.2 +072600 ADD 1 TO TEST-NUMBER. IX1214.2 +072700 CLOSE IX-VS2. IX1214.2 +072800 OPEN I-O IX-VS2. IX1214.2 +072900 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +073000 MOVE 0 TO STATUS-TEST-00. IX1214.2 +073100 MOVE "RWRTE LG. 00/44 EXP." TO FEATURE. IX1214.2 +073200 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +073300 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073400 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073500 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073600 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073700 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073800 RWR-TEST-GF-01-0. IX1214.2 +073900 MOVE "WRONG RECORD LENGTH ( LONGER )" TO IX-VS2-REC-LONG. IX1214.2 +074000 REWRITE IX-VS2R1-F-G-280. IX1214.2 +074100 RWR-TEST-GF-01-1. IX1214.2 +074200 IF IX-VS2-STATUS = "00" IX1214.2 +074300 GO TO RWR-PASS-GF-01-0. IX1214.2 +074400 IF IX-VS2-STATUS = "44" IX1214.2 +074500 GO TO RWR-PASS-GF-01-0. IX1214.2 +074600 RWR-FAIL-GF-01-0. IX1214.2 +074700 MOVE "IX-5, 1.3.4, (5) D 1 & 2; LONG RECORD" TO RE-MARK. IX1214.2 +074800 PERFORM FAIL. IX1214.2 +074900 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +075000 MOVE "00 OR 44" TO CORRECT-X. IX1214.2 +075100 GO TO RWR-WRITE-GF-01-0. IX1214.2 +075200 RWR-PASS-GF-01-0. IX1214.2 +075300 PERFORM PASS. IX1214.2 +075400 RWR-WRITE-GF-01-0. IX1214.2 +075500 PERFORM PRINT-DETAIL. IX1214.2 +075600 IX1214.2 +075700 TERMINATE-ROUTINE. IX1214.2 +075800 EXIT. IX1214.2 +075900 IX1214.2 +076000 CCVS-EXIT SECTION. IX1214.2 +076100 CCVS-999999. IX1214.2 +076200 GO TO CLOSE-FILES. IX1214.2 +*END-OF,IX121A +*HEADER,COBOL,IX201A +000100 IDENTIFICATION DIVISION. IX2014.2 +000200 PROGRAM-ID. IX2014.2 +000300 IX201A. IX2014.2 +000400**************************************************************** IX2014.2 +000500* * IX2014.2 +000600* VALIDATION FOR:- * IX2014.2 +000700* * IX2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +000900* * IX2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2014.2 +001100* * IX2014.2 +001200**************************************************************** IX2014.2 +001300* THIS PROGRAM IS THE FIRST OF A SERIES WHICH PROCESSES AN IX2014.2 +001400* INDEXED FILE. THE FUNCTION OF THIS PROGRAM IS TO CREATE AN IX2014.2 +001500* INDEXED FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL) AND VERIFYIX2014.2 +001600* THAT IT WAS CREATED CORRECTLY. THE FILE IS IDENTIFIED AS IX2014.2 +001700* "IX-FS1" AND IS PASSED TO IX202 FOR PROCESSING. IX2014.2 +001800* IX2014.2 +001900* IX2014.2 +002000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2014.2 +002100* IX2014.2 +002200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2014.2 +002300* CLAUSE FOR DATA FILE IX-FS1 IX2014.2 +002400* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2014.2 +002500* CLAUSE FOR INDEX FILE IX-FS1 IX2014.2 +002600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2014.2 +002700* X-62 FOR RAW-DATA IX2014.2 +002800* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2014.2 +002900* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2014.2 +003000* IX2014.2 +003100* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2014.2 +003200* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2014.2 +003300* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2014.2 +003400* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2014.2 +003500* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2014.2 +003600* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2014.2 +003700* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2014.2 +003800* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2014.2 +003900* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2014.2 +004000* THEY ARE AS FOLLOWS IX2014.2 +004100* IX2014.2 +004200* P SELECTS X-CARDS 62 IX2014.2 +004300* J SELECTS X-CARD 44 IX2014.2 +004400* IX2014.2 +004500****************************************************** IX2014.2 +004600 ENVIRONMENT DIVISION. IX2014.2 +004700 CONFIGURATION SECTION. IX2014.2 +004800 SOURCE-COMPUTER. IX2014.2 +004900 XXXXX082. IX2014.2 +005000 OBJECT-COMPUTER. IX2014.2 +005100 XXXXX083. IX2014.2 +005200 INPUT-OUTPUT SECTION. IX2014.2 +005300 FILE-CONTROL. IX2014.2 +005400P SELECT RAW-DATA ASSIGN TO IX2014.2 +005500P XXXXX062 IX2014.2 +005600P ORGANIZATION IS INDEXED IX2014.2 +005700P ACCESS MODE IS RANDOM IX2014.2 +005800P RECORD KEY IS RAW-DATA-KEY. IX2014.2 +005900 SELECT PRINT-FILE ASSIGN TO IX2014.2 +006000 XXXXX055. IX2014.2 +006100 SELECT IX-FS1 ASSIGN TO IX2014.2 +006200 XXXXP024 IX2014.2 +006300J XXXXP044 IX2014.2 +006400 ORGANIZATION IS INDEXED IX2014.2 +006500 RECORD KEY IS IX-FS1-KEY IX2014.2 +006600 ACCESS MODE IS SEQUENTIAL. IX2014.2 +006700 DATA DIVISION. IX2014.2 +006800 FILE SECTION. IX2014.2 +006900P IX2014.2 +007000PFD RAW-DATA. IX2014.2 +007100P IX2014.2 +007200P01 RAW-DATA-SATZ. IX2014.2 +007300P 05 RAW-DATA-KEY PIC X(6). IX2014.2 +007400P 05 C-DATE PIC 9(6). IX2014.2 +007500P 05 C-TIME PIC 9(8). IX2014.2 +007600P 05 C-NO-OF-TESTS PIC 99. IX2014.2 +007700P 05 C-OK PIC 999. IX2014.2 +007800P 05 C-ALL PIC 999. IX2014.2 +007900P 05 C-FAIL PIC 999. IX2014.2 +008000P 05 C-DELETED PIC 999. IX2014.2 +008100P 05 C-INSPECT PIC 999. IX2014.2 +008200P 05 C-NOTE PIC X(13). IX2014.2 +008300P 05 C-INDENT PIC X. IX2014.2 +008400P 05 C-ABORT PIC X(8). IX2014.2 +008500 FD PRINT-FILE. IX2014.2 +008600 01 PRINT-REC PICTURE X(120). IX2014.2 +008700 01 DUMMY-RECORD PICTURE X(120). IX2014.2 +008800 FD IX-FS1 IX2014.2 +008900C LABEL RECORD IS STANDARD IX2014.2 +009000C DATA RECORD IS IX-FS1R1-F-G-240 IX2014.2 +009100 BLOCK CONTAINS 1 RECORDS IX2014.2 +009200 RECORD CONTAINS 240 CHARACTERS. IX2014.2 +009300 01 IX-FS1R1-F-G-240. IX2014.2 +009400 03 IX-FS1-WRK-120 PIC X(120). IX2014.2 +009500 03 IX-FS1-GRP-120. IX2014.2 +009600 05 FILLER PIC X(8). IX2014.2 +009700 05 IX-FS1-KEY PIC X(29). IX2014.2 +009800 05 FILLER PIC X(83). IX2014.2 +009900 WORKING-STORAGE SECTION. IX2014.2 +010000 01 GRP-0101. IX2014.2 +010100 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2014.2 +010200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2014.2 +010300 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2014.2 +010400 01 FILE-RECORD-INFORMATION-REC. IX2014.2 +010500 03 FILE-RECORD-INFO-SKELETON. IX2014.2 +010600 05 FILLER PICTURE X(48) VALUE IX2014.2 +010700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2014.2 +010800 05 FILLER PICTURE X(46) VALUE IX2014.2 +010900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2014.2 +011000 05 FILLER PICTURE X(26) VALUE IX2014.2 +011100 ",LFIL=000000,ORG= ,LBLR= ". IX2014.2 +011200 05 FILLER PICTURE X(37) VALUE IX2014.2 +011300 ",RECKEY= ". IX2014.2 +011400 05 FILLER PICTURE X(38) VALUE IX2014.2 +011500 ",ALTKEY1= ". IX2014.2 +011600 05 FILLER PICTURE X(38) VALUE IX2014.2 +011700 ",ALTKEY2= ". IX2014.2 +011800 05 FILLER PICTURE X(7) VALUE SPACE.IX2014.2 +011900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2014.2 +012000 05 FILE-RECORD-INFO-P1-120. IX2014.2 +012100 07 FILLER PIC X(5). IX2014.2 +012200 07 XFILE-NAME PIC X(6). IX2014.2 +012300 07 FILLER PIC X(8). IX2014.2 +012400 07 XRECORD-NAME PIC X(6). IX2014.2 +012500 07 FILLER PIC X(1). IX2014.2 +012600 07 REELUNIT-NUMBER PIC 9(1). IX2014.2 +012700 07 FILLER PIC X(7). IX2014.2 +012800 07 XRECORD-NUMBER PIC 9(6). IX2014.2 +012900 07 FILLER PIC X(6). IX2014.2 +013000 07 UPDATE-NUMBER PIC 9(2). IX2014.2 +013100 07 FILLER PIC X(5). IX2014.2 +013200 07 ODO-NUMBER PIC 9(4). IX2014.2 +013300 07 FILLER PIC X(5). IX2014.2 +013400 07 XPROGRAM-NAME PIC X(5). IX2014.2 +013500 07 FILLER PIC X(7). IX2014.2 +013600 07 XRECORD-LENGTH PIC 9(6). IX2014.2 +013700 07 FILLER PIC X(7). IX2014.2 +013800 07 CHARS-OR-RECORDS PIC X(2). IX2014.2 +013900 07 FILLER PIC X(1). IX2014.2 +014000 07 XBLOCK-SIZE PIC 9(4). IX2014.2 +014100 07 FILLER PIC X(6). IX2014.2 +014200 07 RECORDS-IN-FILE PIC 9(6). IX2014.2 +014300 07 FILLER PIC X(5). IX2014.2 +014400 07 XFILE-ORGANIZATION PIC X(2). IX2014.2 +014500 07 FILLER PIC X(6). IX2014.2 +014600 07 XLABEL-TYPE PIC X(1). IX2014.2 +014700 05 FILE-RECORD-INFO-P121-240. IX2014.2 +014800 07 FILLER PIC X(8). IX2014.2 +014900 07 XRECORD-KEY PIC X(29). IX2014.2 +015000 07 FILLER PIC X(9). IX2014.2 +015100 07 ALTERNATE-KEY1 PIC X(29). IX2014.2 +015200 07 FILLER PIC X(9). IX2014.2 +015300 07 ALTERNATE-KEY2 PIC X(29). IX2014.2 +015400 07 FILLER PIC X(7). IX2014.2 +015500 01 TEST-RESULTS. IX2014.2 +015600 02 FILLER PIC X VALUE SPACE. IX2014.2 +015700 02 FEATURE PIC X(20) VALUE SPACE. IX2014.2 +015800 02 FILLER PIC X VALUE SPACE. IX2014.2 +015900 02 P-OR-F PIC X(5) VALUE SPACE. IX2014.2 +016000 02 FILLER PIC X VALUE SPACE. IX2014.2 +016100 02 PAR-NAME. IX2014.2 +016200 03 FILLER PIC X(19) VALUE SPACE. IX2014.2 +016300 03 PARDOT-X PIC X VALUE SPACE. IX2014.2 +016400 03 DOTVALUE PIC 99 VALUE ZERO. IX2014.2 +016500 02 FILLER PIC X(8) VALUE SPACE. IX2014.2 +016600 02 RE-MARK PIC X(61). IX2014.2 +016700 01 TEST-COMPUTED. IX2014.2 +016800 02 FILLER PIC X(30) VALUE SPACE. IX2014.2 +016900 02 FILLER PIC X(17) VALUE IX2014.2 +017000 " COMPUTED=". IX2014.2 +017100 02 COMPUTED-X. IX2014.2 +017200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2014.2 +017300 03 COMPUTED-N REDEFINES COMPUTED-A IX2014.2 +017400 PIC -9(9).9(9). IX2014.2 +017500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2014.2 +017600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2014.2 +017700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2014.2 +017800 03 CM-18V0 REDEFINES COMPUTED-A. IX2014.2 +017900 04 COMPUTED-18V0 PIC -9(18). IX2014.2 +018000 04 FILLER PIC X. IX2014.2 +018100 03 FILLER PIC X(50) VALUE SPACE. IX2014.2 +018200 01 TEST-CORRECT. IX2014.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2014.2 +018400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2014.2 +018500 02 CORRECT-X. IX2014.2 +018600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2014.2 +018700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2014.2 +018800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2014.2 +018900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2014.2 +019000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2014.2 +019100 03 CR-18V0 REDEFINES CORRECT-A. IX2014.2 +019200 04 CORRECT-18V0 PIC -9(18). IX2014.2 +019300 04 FILLER PIC X. IX2014.2 +019400 03 FILLER PIC X(2) VALUE SPACE. IX2014.2 +019500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2014.2 +019600 01 CCVS-C-1. IX2014.2 +019700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2014.2 +019800- "SS PARAGRAPH-NAME IX2014.2 +019900- " REMARKS". IX2014.2 +020000 02 FILLER PIC X(20) VALUE SPACE. IX2014.2 +020100 01 CCVS-C-2. IX2014.2 +020200 02 FILLER PIC X VALUE SPACE. IX2014.2 +020300 02 FILLER PIC X(6) VALUE "TESTED". IX2014.2 +020400 02 FILLER PIC X(15) VALUE SPACE. IX2014.2 +020500 02 FILLER PIC X(4) VALUE "FAIL". IX2014.2 +020600 02 FILLER PIC X(94) VALUE SPACE. IX2014.2 +020700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2014.2 +020800 01 REC-CT PIC 99 VALUE ZERO. IX2014.2 +020900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2014.2 +021400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2014.2 +021500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2014.2 +021600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2014.2 +021700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2014.2 +021800 01 CCVS-H-1. IX2014.2 +021900 02 FILLER PIC X(39) VALUE SPACES. IX2014.2 +022000 02 FILLER PIC X(42) VALUE IX2014.2 +022100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2014.2 +022200 02 FILLER PIC X(39) VALUE SPACES. IX2014.2 +022300 01 CCVS-H-2A. IX2014.2 +022400 02 FILLER PIC X(40) VALUE SPACE. IX2014.2 +022500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2014.2 +022600 02 FILLER PIC XXXX VALUE IX2014.2 +022700 "4.2 ". IX2014.2 +022800 02 FILLER PIC X(28) VALUE IX2014.2 +022900 " COPY - NOT FOR DISTRIBUTION". IX2014.2 +023000 02 FILLER PIC X(41) VALUE SPACE. IX2014.2 +023100 IX2014.2 +023200 01 CCVS-H-2B. IX2014.2 +023300 02 FILLER PIC X(15) VALUE IX2014.2 +023400 "TEST RESULT OF ". IX2014.2 +023500 02 TEST-ID PIC X(9). IX2014.2 +023600 02 FILLER PIC X(4) VALUE IX2014.2 +023700 " IN ". IX2014.2 +023800 02 FILLER PIC X(12) VALUE IX2014.2 +023900 " HIGH ". IX2014.2 +024000 02 FILLER PIC X(22) VALUE IX2014.2 +024100 " LEVEL VALIDATION FOR ". IX2014.2 +024200 02 FILLER PIC X(58) VALUE IX2014.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +024400 01 CCVS-H-3. IX2014.2 +024500 02 FILLER PIC X(34) VALUE IX2014.2 +024600 " FOR OFFICIAL USE ONLY ". IX2014.2 +024700 02 FILLER PIC X(58) VALUE IX2014.2 +024800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2014.2 +024900 02 FILLER PIC X(28) VALUE IX2014.2 +025000 " COPYRIGHT 1985 ". IX2014.2 +025100 01 CCVS-E-1. IX2014.2 +025200 02 FILLER PIC X(52) VALUE SPACE. IX2014.2 +025300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2014.2 +025400 02 ID-AGAIN PIC X(9). IX2014.2 +025500 02 FILLER PIC X(45) VALUE SPACES. IX2014.2 +025600 01 CCVS-E-2. IX2014.2 +025700 02 FILLER PIC X(31) VALUE SPACE. IX2014.2 +025800 02 FILLER PIC X(21) VALUE SPACE. IX2014.2 +025900 02 CCVS-E-2-2. IX2014.2 +026000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2014.2 +026100 03 FILLER PIC X VALUE SPACE. IX2014.2 +026200 03 ENDER-DESC PIC X(44) VALUE IX2014.2 +026300 "ERRORS ENCOUNTERED". IX2014.2 +026400 01 CCVS-E-3. IX2014.2 +026500 02 FILLER PIC X(22) VALUE IX2014.2 +026600 " FOR OFFICIAL USE ONLY". IX2014.2 +026700 02 FILLER PIC X(12) VALUE SPACE. IX2014.2 +026800 02 FILLER PIC X(58) VALUE IX2014.2 +026900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +027000 02 FILLER PIC X(13) VALUE SPACE. IX2014.2 +027100 02 FILLER PIC X(15) VALUE IX2014.2 +027200 " COPYRIGHT 1985". IX2014.2 +027300 01 CCVS-E-4. IX2014.2 +027400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2014.2 +027500 02 FILLER PIC X(4) VALUE " OF ". IX2014.2 +027600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2014.2 +027700 02 FILLER PIC X(40) VALUE IX2014.2 +027800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2014.2 +027900 01 XXINFO. IX2014.2 +028000 02 FILLER PIC X(19) VALUE IX2014.2 +028100 "*** INFORMATION ***". IX2014.2 +028200 02 INFO-TEXT. IX2014.2 +028300 04 FILLER PIC X(8) VALUE SPACE. IX2014.2 +028400 04 XXCOMPUTED PIC X(20). IX2014.2 +028500 04 FILLER PIC X(5) VALUE SPACE. IX2014.2 +028600 04 XXCORRECT PIC X(20). IX2014.2 +028700 02 INF-ANSI-REFERENCE PIC X(48). IX2014.2 +028800 01 HYPHEN-LINE. IX2014.2 +028900 02 FILLER PIC IS X VALUE IS SPACE. IX2014.2 +029000 02 FILLER PIC IS X(65) VALUE IS "************************IX2014.2 +029100- "*****************************************". IX2014.2 +029200 02 FILLER PIC IS X(54) VALUE IS "************************IX2014.2 +029300- "******************************". IX2014.2 +029400 01 CCVS-PGM-ID PIC X(9) VALUE IX2014.2 +029500 "IX201A". IX2014.2 +029600 PROCEDURE DIVISION. IX2014.2 +029700 CCVS1 SECTION. IX2014.2 +029800 OPEN-FILES. IX2014.2 +029900P OPEN I-O RAW-DATA. IX2014.2 +030000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2014.2 +030100P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2014.2 +030200P MOVE "ABORTED " TO C-ABORT. IX2014.2 +030300P ADD 1 TO C-NO-OF-TESTS. IX2014.2 +030400P ACCEPT C-DATE FROM DATE. IX2014.2 +030500P ACCEPT C-TIME FROM TIME. IX2014.2 +030600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2014.2 +030700PEND-E-1. IX2014.2 +030800P CLOSE RAW-DATA. IX2014.2 +030900 OPEN OUTPUT PRINT-FILE. IX2014.2 +031000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2014.2 +031100 MOVE SPACE TO TEST-RESULTS. IX2014.2 +031200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2014.2 +031300 MOVE ZERO TO REC-SKL-SUB. IX2014.2 +031400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2014.2 +031500 CCVS-INIT-FILE. IX2014.2 +031600 ADD 1 TO REC-SKL-SUB. IX2014.2 +031700 MOVE FILE-RECORD-INFO-SKELETON IX2014.2 +031800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2014.2 +031900 CCVS-INIT-EXIT. IX2014.2 +032000 GO TO CCVS1-EXIT. IX2014.2 +032100 CLOSE-FILES. IX2014.2 +032200P OPEN I-O RAW-DATA. IX2014.2 +032300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2014.2 +032400P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2014.2 +032500P MOVE "OK. " TO C-ABORT. IX2014.2 +032600P MOVE PASS-COUNTER TO C-OK. IX2014.2 +032700P MOVE ERROR-HOLD TO C-ALL. IX2014.2 +032800P MOVE ERROR-COUNTER TO C-FAIL. IX2014.2 +032900P MOVE DELETE-COUNTER TO C-DELETED. IX2014.2 +033000P MOVE INSPECT-COUNTER TO C-INSPECT. IX2014.2 +033100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2014.2 +033200PEND-E-2. IX2014.2 +033300P CLOSE RAW-DATA. IX2014.2 +033400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2014.2 +033500 TERMINATE-CCVS. IX2014.2 +033600S EXIT PROGRAM. IX2014.2 +033700STERMINATE-CALL. IX2014.2 +033800 STOP RUN. IX2014.2 +033900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2014.2 +034000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2014.2 +034100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2014.2 +034200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2014.2 +034300 MOVE "****TEST DELETED****" TO RE-MARK. IX2014.2 +034400 PRINT-DETAIL. IX2014.2 +034500 IF REC-CT NOT EQUAL TO ZERO IX2014.2 +034600 MOVE "." TO PARDOT-X IX2014.2 +034700 MOVE REC-CT TO DOTVALUE. IX2014.2 +034800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2014.2 +034900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2014.2 +035000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2014.2 +035100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2014.2 +035200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2014.2 +035300 MOVE SPACE TO CORRECT-X. IX2014.2 +035400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2014.2 +035500 MOVE SPACE TO RE-MARK. IX2014.2 +035600 HEAD-ROUTINE. IX2014.2 +035700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +035800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +035900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2014.2 +036000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2014.2 +036100 COLUMN-NAMES-ROUTINE. IX2014.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +036500 END-ROUTINE. IX2014.2 +036600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2014.2 +036700 END-RTN-EXIT. IX2014.2 +036800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +036900 END-ROUTINE-1. IX2014.2 +037000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2014.2 +037100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2014.2 +037200 ADD PASS-COUNTER TO ERROR-HOLD. IX2014.2 +037300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2014.2 +037400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2014.2 +037500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2014.2 +037600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2014.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2014.2 +037800 END-ROUTINE-12. IX2014.2 +037900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2014.2 +038000 IF ERROR-COUNTER IS EQUAL TO ZERO IX2014.2 +038100 MOVE "NO " TO ERROR-TOTAL IX2014.2 +038200 ELSE IX2014.2 +038300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2014.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2014.2 +038500 PERFORM WRITE-LINE. IX2014.2 +038600 END-ROUTINE-13. IX2014.2 +038700 IF DELETE-COUNTER IS EQUAL TO ZERO IX2014.2 +038800 MOVE "NO " TO ERROR-TOTAL ELSE IX2014.2 +038900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2014.2 +039000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2014.2 +039100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039200 IF INSPECT-COUNTER EQUAL TO ZERO IX2014.2 +039300 MOVE "NO " TO ERROR-TOTAL IX2014.2 +039400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2014.2 +039500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2014.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039800 WRITE-LINE. IX2014.2 +039900 ADD 1 TO RECORD-COUNT. IX2014.2 +040000Y IF RECORD-COUNT GREATER 42 IX2014.2 +040100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2014.2 +040200Y MOVE SPACE TO DUMMY-RECORD IX2014.2 +040300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2014.2 +040400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2014.2 +040500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2014.2 +040600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2014.2 +040700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2014.2 +040800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +040900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +041000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +041100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2014.2 +041200Y MOVE ZERO TO RECORD-COUNT. IX2014.2 +041300 PERFORM WRT-LN. IX2014.2 +041400 WRT-LN. IX2014.2 +041500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2014.2 +041600 MOVE SPACE TO DUMMY-RECORD. IX2014.2 +041700 BLANK-LINE-PRINT. IX2014.2 +041800 PERFORM WRT-LN. IX2014.2 +041900 FAIL-ROUTINE. IX2014.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE IX2014.2 +042100 GO TO FAIL-ROUTINE-WRITE. IX2014.2 +042200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2014.2 +042300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2014.2 +042400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2014.2 +042500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2014.2 +042700 GO TO FAIL-ROUTINE-EX. IX2014.2 +042800 FAIL-ROUTINE-WRITE. IX2014.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2014.2 +043000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2014.2 +043100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2014.2 +043200 MOVE SPACES TO COR-ANSI-REFERENCE. IX2014.2 +043300 FAIL-ROUTINE-EX. EXIT. IX2014.2 +043400 BAIL-OUT. IX2014.2 +043500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2014.2 +043600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2014.2 +043700 BAIL-OUT-WRITE. IX2014.2 +043800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2014.2 +043900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2014.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2014.2 +044200 BAIL-OUT-EX. EXIT. IX2014.2 +044300 CCVS1-EXIT. IX2014.2 +044400 EXIT. IX2014.2 +044500 SECT-IX-01-001 SECTION. IX2014.2 +044600 WRITE-INIT-GF-01. IX2014.2 +044700 MOVE "WRITE IX-FS1" TO FEATURE. IX2014.2 +044800 OPEN OUTPUT IX-FS1. IX2014.2 +044900 MOVE "IX-FS1" TO XFILE-NAME (1). IX2014.2 +045000 MOVE "IX-F-G" TO XRECORD-NAME (1). IX2014.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2014.2 +045200 MOVE 000240 TO XRECORD-LENGTH (1). IX2014.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2014.2 +045400 MOVE 0001 TO XBLOCK-SIZE (1). IX2014.2 +045500 MOVE 000500 TO RECORDS-IN-FILE (1). IX2014.2 +045600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2014.2 +045700 MOVE "S" TO XLABEL-TYPE (1). IX2014.2 +045800 MOVE 000001 TO XRECORD-NUMBER (1). IX2014.2 +045900 WRITE-TEST-GF-01. IX2014.2 +046000 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2014.2 +046100 MOVE GRP-0101 TO XRECORD-KEY (1). IX2014.2 +046200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2014.2 +046300 WRITE IX-FS1R1-F-G-240 IX2014.2 +046400 INVALID KEY GO TO WRITE-FAIL-GF-01. IX2014.2 +046500 IF XRECORD-NUMBER (1) EQUAL TO 500 IX2014.2 +046600 PERFORM PASS IX2014.2 +046700 GO TO WRITE-WRITE-GF-01. IX2014.2 +046800 ADD 000001 TO XRECORD-NUMBER (1). IX2014.2 +046900 GO TO WRITE-TEST-GF-01. IX2014.2 +047000 WRITE-FAIL-GF-01. IX2014.2 +047100 MOVE "BOUNDARY VIOLATION. WRITE FAILED; IX-41" TO RE-MARK. IX2014.2 +047200 PERFORM FAIL. IX2014.2 +047300 WRITE-WRITE-GF-01. IX2014.2 +047400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME IX2014.2 +047500 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. IX2014.2 +047600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2014.2 +047700 PERFORM PRINT-DETAIL. IX2014.2 +047800 CLOSE IX-FS1. IX2014.2 +047900 READ-INIT-F1-01. IX2014.2 +048000 OPEN INPUT IX-FS1. IX2014.2 +048100 MOVE ZERO TO WRK-DU-09V00-001. IX2014.2 +048200 READ-TEST-F1-01. IX2014.2 +048300 READ IX-FS1 IX2014.2 +048400 AT END GO TO READ-TEST-F1-01-1. IX2014.2 +048500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2014.2 +048600 ADD 1 TO WRK-DU-09V00-001. IX2014.2 +048700 IF WRK-DU-09V00-001 GREATER 500 IX2014.2 +048800 MOVE "MORE THAN 500 RECORDS" TO RE-MARK IX2014.2 +048900 GO TO READ-TEST-F1-01-1. IX2014.2 +049000 GO TO READ-TEST-F1-01. IX2014.2 +049100 READ-TEST-F1-01-1. IX2014.2 +049200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX2014.2 +049300 MOVE "READ FAILED; IX-28, 4.5.2" TO RE-MARK IX2014.2 +049400 PERFORM FAIL IX2014.2 +049500 ELSE IX2014.2 +049600 PERFORM PASS. IX2014.2 +049700 READ-WRITE-F1-01. IX2014.2 +049800 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2014.2 +049900 MOVE "READ TO VERIFY " TO FEATURE. IX2014.2 +050000 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2014.2 +050100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2014.2 +050200 PERFORM PRINT-DETAIL. IX2014.2 +050300 CLOSE IX-FS1. IX2014.2 +050400 CCVS-EXIT SECTION. IX2014.2 +050500 CCVS-999999. IX2014.2 +050600 GO TO CLOSE-FILES. IX2014.2 +*END-OF,IX201A +*HEADER,COBOL,IX201A,SUBPRG,IX202A +000100 IDENTIFICATION DIVISION. IX2024.2 +000200 PROGRAM-ID. IX2024.2 +000300 IX202A. IX2024.2 +000400**************************************************************** IX2024.2 +000500* * IX2024.2 +000600* VALIDATION FOR:- * IX2024.2 +000700* * IX2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +000900* * IX2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2024.2 +001100* * IX2024.2 +001200**************************************************************** IX2024.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO PROCESS AN INDEXED FILE IX2024.2 +001400* RANDOMLY USING THE ACCESS MODE IS DYNAMIC CLAUSE. THE FILE IX2024.2 +001500* USED AS INPUT IS THAT CREATED BY IX201A. IX2024.2 +001600* IX2024.2 +001700* FIRST THE FILE IS VERIFIED AS TO THE EXISTANCE AND ACCURACY IX2024.2 +001800* OF THE 500 RECORDS CREATED IN THE FIRST RUN UNIT. SECONDLY, IX2024.2 +001900* RECORDS OF THE FILE ARE SELECTIVELY UPDATED; AND THIRDLY, THEIX2024.2 +002000* ACCURACY OF EACH RECORD IN THE FILE IS AGAIN VERIFIED. IX2024.2 +002100* IX2024.2 +002200* IX2024.2 +002300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2024.2 +002400* IX2024.2 +002500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2024.2 +002600* CLAUSE FOR DATA FILE IX-FS1 IX2024.2 +002700* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2024.2 +002800* CLAUSE FOR INDEX FILE IX-FS1 IX2024.2 +002900* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2024.2 +003000* X-62 FOR RAW-DATA IX2024.2 +003100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2024.2 +003200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2024.2 +003300* IX2024.2 +003400* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2024.2 +003500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2024.2 +003600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2024.2 +003700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2024.2 +003800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2024.2 +003900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2024.2 +004000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2024.2 +004100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2024.2 +004200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2024.2 +004300* THEY ARE AS FOLLOWS IX2024.2 +004400* IX2024.2 +004500* P SELECTS X-CARDS 62 IX2024.2 +004600* J SELECTS X-CARD 44 IX2024.2 +004700* IX2024.2 +004800****************************************************** IX2024.2 +004900 ENVIRONMENT DIVISION. IX2024.2 +005000 CONFIGURATION SECTION. IX2024.2 +005100 SOURCE-COMPUTER. IX2024.2 +005200 XXXXX082. IX2024.2 +005300 OBJECT-COMPUTER. IX2024.2 +005400 XXXXX083. IX2024.2 +005500 INPUT-OUTPUT SECTION. IX2024.2 +005600 FILE-CONTROL. IX2024.2 +005700P SELECT RAW-DATA ASSIGN TO IX2024.2 +005800P XXXXX062 IX2024.2 +005900P ORGANIZATION IS INDEXED IX2024.2 +006000P ACCESS MODE IS RANDOM IX2024.2 +006100P RECORD KEY IS RAW-DATA-KEY. IX2024.2 +006200 SELECT PRINT-FILE ASSIGN TO IX2024.2 +006300 XXXXX055. IX2024.2 +006400 SELECT IX-FD1 ASSIGN IX2024.2 +006500 XXXXP024 IX2024.2 +006600J XXXXP044 IX2024.2 +006700 ACCESS MODE IS DYNAMIC IX2024.2 +006800 ; ORGANIZATION INDEXED IX2024.2 +006900 RECORD KEY IX-FD1-KEY. IX2024.2 +007000 DATA DIVISION. IX2024.2 +007100 FILE SECTION. IX2024.2 +007200P IX2024.2 +007300PFD RAW-DATA. IX2024.2 +007400P IX2024.2 +007500P01 RAW-DATA-SATZ. IX2024.2 +007600P 05 RAW-DATA-KEY PIC X(6). IX2024.2 +007700P 05 C-DATE PIC 9(6). IX2024.2 +007800P 05 C-TIME PIC 9(8). IX2024.2 +007900P 05 C-NO-OF-TESTS PIC 99. IX2024.2 +008000P 05 C-OK PIC 999. IX2024.2 +008100P 05 C-ALL PIC 999. IX2024.2 +008200P 05 C-FAIL PIC 999. IX2024.2 +008300P 05 C-DELETED PIC 999. IX2024.2 +008400P 05 C-INSPECT PIC 999. IX2024.2 +008500P 05 C-NOTE PIC X(13). IX2024.2 +008600P 05 C-INDENT PIC X. IX2024.2 +008700P 05 C-ABORT PIC X(8). IX2024.2 +008800 FD PRINT-FILE. IX2024.2 +008900 01 PRINT-REC PICTURE X(120). IX2024.2 +009000 01 DUMMY-RECORD PICTURE X(120). IX2024.2 +009100 FD IX-FD1 IX2024.2 +009200C LABEL RECORDS STANDARD IX2024.2 +009300C DATA RECORD IX-FS1R1-F-G-240 IX2024.2 +009400 BLOCK 1 RECORDS IX2024.2 +009500 RECORD 240 CHARACTERS. IX2024.2 +009600 01 IX-FS1R1-F-G-240. IX2024.2 +009700 05 IX-FD1-REC-120 PIC X(120). IX2024.2 +009800 05 IX-FD1-REC-120-240. IX2024.2 +009900 10 FILLER PIC X(8). IX2024.2 +010000 10 IX-FD1-KEY PIC X(29). IX2024.2 +010100 10 FILLER PIC X(83). IX2024.2 +010200 WORKING-STORAGE SECTION. IX2024.2 +010300 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010400 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. IX2024.2 +010500 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010600 01 I-O-ERROR-IX-FD1 PIC X(3) VALUE "NO ". IX2024.2 +010700 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010800 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010900 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +011000 01 IX-WRK-KEY. IX2024.2 +011100 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2024.2 +011200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2024.2 +011300 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2024.2 +011400 01 DUMMY-WRK-REC. IX2024.2 +011500 02 DUMMY-WRK1 PIC X(120). IX2024.2 +011600 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2024.2 +011700 03 FILLER PIC X(5). IX2024.2 +011800 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2024.2 +011900 01 FILE-RECORD-INFORMATION-REC. IX2024.2 +012000 03 FILE-RECORD-INFO-SKELETON. IX2024.2 +012100 05 FILLER PICTURE X(48) VALUE IX2024.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2024.2 +012300 05 FILLER PICTURE X(46) VALUE IX2024.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2024.2 +012500 05 FILLER PICTURE X(26) VALUE IX2024.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". IX2024.2 +012700 05 FILLER PICTURE X(37) VALUE IX2024.2 +012800 ",RECKEY= ". IX2024.2 +012900 05 FILLER PICTURE X(38) VALUE IX2024.2 +013000 ",ALTKEY1= ". IX2024.2 +013100 05 FILLER PICTURE X(38) VALUE IX2024.2 +013200 ",ALTKEY2= ". IX2024.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.IX2024.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2024.2 +013500 05 FILE-RECORD-INFO-P1-120. IX2024.2 +013600 07 FILLER PIC X(5). IX2024.2 +013700 07 XFILE-NAME PIC X(6). IX2024.2 +013800 07 FILLER PIC X(8). IX2024.2 +013900 07 XRECORD-NAME PIC X(6). IX2024.2 +014000 07 FILLER PIC X(1). IX2024.2 +014100 07 REELUNIT-NUMBER PIC 9(1). IX2024.2 +014200 07 FILLER PIC X(7). IX2024.2 +014300 07 XRECORD-NUMBER PIC 9(6). IX2024.2 +014400 07 FILLER PIC X(6). IX2024.2 +014500 07 UPDATE-NUMBER PIC 9(2). IX2024.2 +014600 07 FILLER PIC X(5). IX2024.2 +014700 07 ODO-NUMBER PIC 9(4). IX2024.2 +014800 07 FILLER PIC X(5). IX2024.2 +014900 07 XPROGRAM-NAME PIC X(5). IX2024.2 +015000 07 FILLER PIC X(7). IX2024.2 +015100 07 XRECORD-LENGTH PIC 9(6). IX2024.2 +015200 07 FILLER PIC X(7). IX2024.2 +015300 07 CHARS-OR-RECORDS PIC X(2). IX2024.2 +015400 07 FILLER PIC X(1). IX2024.2 +015500 07 XBLOCK-SIZE PIC 9(4). IX2024.2 +015600 07 FILLER PIC X(6). IX2024.2 +015700 07 RECORDS-IN-FILE PIC 9(6). IX2024.2 +015800 07 FILLER PIC X(5). IX2024.2 +015900 07 XFILE-ORGANIZATION PIC X(2). IX2024.2 +016000 07 FILLER PIC X(6). IX2024.2 +016100 07 XLABEL-TYPE PIC X(1). IX2024.2 +016200 05 FILE-RECORD-INFO-P121-240. IX2024.2 +016300 07 FILLER PIC X(8). IX2024.2 +016400 07 XRECORD-KEY PIC X(29). IX2024.2 +016500 07 FILLER PIC X(9). IX2024.2 +016600 07 ALTERNATE-KEY1 PIC X(29). IX2024.2 +016700 07 FILLER PIC X(9). IX2024.2 +016800 07 ALTERNATE-KEY2 PIC X(29). IX2024.2 +016900 07 FILLER PIC X(7). IX2024.2 +017000 01 TEST-RESULTS. IX2024.2 +017100 02 FILLER PIC X VALUE SPACE. IX2024.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. IX2024.2 +017300 02 FILLER PIC X VALUE SPACE. IX2024.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. IX2024.2 +017500 02 FILLER PIC X VALUE SPACE. IX2024.2 +017600 02 PAR-NAME. IX2024.2 +017700 03 FILLER PIC X(19) VALUE SPACE. IX2024.2 +017800 03 PARDOT-X PIC X VALUE SPACE. IX2024.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. IX2024.2 +018000 02 FILLER PIC X(8) VALUE SPACE. IX2024.2 +018100 02 RE-MARK PIC X(61). IX2024.2 +018200 01 TEST-COMPUTED. IX2024.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2024.2 +018400 02 FILLER PIC X(17) VALUE IX2024.2 +018500 " COMPUTED=". IX2024.2 +018600 02 COMPUTED-X. IX2024.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2024.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A IX2024.2 +018900 PIC -9(9).9(9). IX2024.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2024.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2024.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2024.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. IX2024.2 +019400 04 COMPUTED-18V0 PIC -9(18). IX2024.2 +019500 04 FILLER PIC X. IX2024.2 +019600 03 FILLER PIC X(50) VALUE SPACE. IX2024.2 +019700 01 TEST-CORRECT. IX2024.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2024.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2024.2 +020000 02 CORRECT-X. IX2024.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2024.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2024.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2024.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2024.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2024.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. IX2024.2 +020700 04 CORRECT-18V0 PIC -9(18). IX2024.2 +020800 04 FILLER PIC X. IX2024.2 +020900 03 FILLER PIC X(2) VALUE SPACE. IX2024.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2024.2 +021100 01 CCVS-C-1. IX2024.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2024.2 +021300- "SS PARAGRAPH-NAME IX2024.2 +021400- " REMARKS". IX2024.2 +021500 02 FILLER PIC X(20) VALUE SPACE. IX2024.2 +021600 01 CCVS-C-2. IX2024.2 +021700 02 FILLER PIC X VALUE SPACE. IX2024.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". IX2024.2 +021900 02 FILLER PIC X(15) VALUE SPACE. IX2024.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". IX2024.2 +022100 02 FILLER PIC X(94) VALUE SPACE. IX2024.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2024.2 +022300 01 REC-CT PIC 99 VALUE ZERO. IX2024.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2024.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2024.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2024.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2024.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2024.2 +023300 01 CCVS-H-1. IX2024.2 +023400 02 FILLER PIC X(39) VALUE SPACES. IX2024.2 +023500 02 FILLER PIC X(42) VALUE IX2024.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2024.2 +023700 02 FILLER PIC X(39) VALUE SPACES. IX2024.2 +023800 01 CCVS-H-2A. IX2024.2 +023900 02 FILLER PIC X(40) VALUE SPACE. IX2024.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2024.2 +024100 02 FILLER PIC XXXX VALUE IX2024.2 +024200 "4.2 ". IX2024.2 +024300 02 FILLER PIC X(28) VALUE IX2024.2 +024400 " COPY - NOT FOR DISTRIBUTION". IX2024.2 +024500 02 FILLER PIC X(41) VALUE SPACE. IX2024.2 +024600 IX2024.2 +024700 01 CCVS-H-2B. IX2024.2 +024800 02 FILLER PIC X(15) VALUE IX2024.2 +024900 "TEST RESULT OF ". IX2024.2 +025000 02 TEST-ID PIC X(9). IX2024.2 +025100 02 FILLER PIC X(4) VALUE IX2024.2 +025200 " IN ". IX2024.2 +025300 02 FILLER PIC X(12) VALUE IX2024.2 +025400 " HIGH ". IX2024.2 +025500 02 FILLER PIC X(22) VALUE IX2024.2 +025600 " LEVEL VALIDATION FOR ". IX2024.2 +025700 02 FILLER PIC X(58) VALUE IX2024.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +025900 01 CCVS-H-3. IX2024.2 +026000 02 FILLER PIC X(34) VALUE IX2024.2 +026100 " FOR OFFICIAL USE ONLY ". IX2024.2 +026200 02 FILLER PIC X(58) VALUE IX2024.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2024.2 +026400 02 FILLER PIC X(28) VALUE IX2024.2 +026500 " COPYRIGHT 1985 ". IX2024.2 +026600 01 CCVS-E-1. IX2024.2 +026700 02 FILLER PIC X(52) VALUE SPACE. IX2024.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2024.2 +026900 02 ID-AGAIN PIC X(9). IX2024.2 +027000 02 FILLER PIC X(45) VALUE SPACES. IX2024.2 +027100 01 CCVS-E-2. IX2024.2 +027200 02 FILLER PIC X(31) VALUE SPACE. IX2024.2 +027300 02 FILLER PIC X(21) VALUE SPACE. IX2024.2 +027400 02 CCVS-E-2-2. IX2024.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2024.2 +027600 03 FILLER PIC X VALUE SPACE. IX2024.2 +027700 03 ENDER-DESC PIC X(44) VALUE IX2024.2 +027800 "ERRORS ENCOUNTERED". IX2024.2 +027900 01 CCVS-E-3. IX2024.2 +028000 02 FILLER PIC X(22) VALUE IX2024.2 +028100 " FOR OFFICIAL USE ONLY". IX2024.2 +028200 02 FILLER PIC X(12) VALUE SPACE. IX2024.2 +028300 02 FILLER PIC X(58) VALUE IX2024.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +028500 02 FILLER PIC X(13) VALUE SPACE. IX2024.2 +028600 02 FILLER PIC X(15) VALUE IX2024.2 +028700 " COPYRIGHT 1985". IX2024.2 +028800 01 CCVS-E-4. IX2024.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2024.2 +029000 02 FILLER PIC X(4) VALUE " OF ". IX2024.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2024.2 +029200 02 FILLER PIC X(40) VALUE IX2024.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2024.2 +029400 01 XXINFO. IX2024.2 +029500 02 FILLER PIC X(19) VALUE IX2024.2 +029600 "*** INFORMATION ***". IX2024.2 +029700 02 INFO-TEXT. IX2024.2 +029800 04 FILLER PIC X(8) VALUE SPACE. IX2024.2 +029900 04 XXCOMPUTED PIC X(20). IX2024.2 +030000 04 FILLER PIC X(5) VALUE SPACE. IX2024.2 +030100 04 XXCORRECT PIC X(20). IX2024.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). IX2024.2 +030300 01 HYPHEN-LINE. IX2024.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. IX2024.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************IX2024.2 +030600- "*****************************************". IX2024.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************IX2024.2 +030800- "******************************". IX2024.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE IX2024.2 +031000 "IX202A". IX2024.2 +031100 PROCEDURE DIVISION. IX2024.2 +031200 CCVS1 SECTION. IX2024.2 +031300 OPEN-FILES. IX2024.2 +031400P OPEN I-O RAW-DATA. IX2024.2 +031500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2024.2 +031600P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2024.2 +031700P MOVE "ABORTED " TO C-ABORT. IX2024.2 +031800P ADD 1 TO C-NO-OF-TESTS. IX2024.2 +031900P ACCEPT C-DATE FROM DATE. IX2024.2 +032000P ACCEPT C-TIME FROM TIME. IX2024.2 +032100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2024.2 +032200PEND-E-1. IX2024.2 +032300P CLOSE RAW-DATA. IX2024.2 +032400 OPEN OUTPUT PRINT-FILE. IX2024.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2024.2 +032600 MOVE SPACE TO TEST-RESULTS. IX2024.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2024.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX2024.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2024.2 +033000 CCVS-INIT-FILE. IX2024.2 +033100 ADD 1 TO REC-SKL-SUB. IX2024.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX2024.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2024.2 +033400 CCVS-INIT-EXIT. IX2024.2 +033500 GO TO CCVS1-EXIT. IX2024.2 +033600 CLOSE-FILES. IX2024.2 +033700P OPEN I-O RAW-DATA. IX2024.2 +033800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2024.2 +033900P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2024.2 +034000P MOVE "OK. " TO C-ABORT. IX2024.2 +034100P MOVE PASS-COUNTER TO C-OK. IX2024.2 +034200P MOVE ERROR-HOLD TO C-ALL. IX2024.2 +034300P MOVE ERROR-COUNTER TO C-FAIL. IX2024.2 +034400P MOVE DELETE-COUNTER TO C-DELETED. IX2024.2 +034500P MOVE INSPECT-COUNTER TO C-INSPECT. IX2024.2 +034600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2024.2 +034700PEND-E-2. IX2024.2 +034800P CLOSE RAW-DATA. IX2024.2 +034900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2024.2 +035000 TERMINATE-CCVS. IX2024.2 +035100S EXIT PROGRAM. IX2024.2 +035200STERMINATE-CALL. IX2024.2 +035300 STOP RUN. IX2024.2 +035400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2024.2 +035500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2024.2 +035600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2024.2 +035700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2024.2 +035800 MOVE "****TEST DELETED****" TO RE-MARK. IX2024.2 +035900 PRINT-DETAIL. IX2024.2 +036000 IF REC-CT NOT EQUAL TO ZERO IX2024.2 +036100 MOVE "." TO PARDOT-X IX2024.2 +036200 MOVE REC-CT TO DOTVALUE. IX2024.2 +036300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2024.2 +036400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2024.2 +036500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2024.2 +036600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2024.2 +036700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2024.2 +036800 MOVE SPACE TO CORRECT-X. IX2024.2 +036900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2024.2 +037000 MOVE SPACE TO RE-MARK. IX2024.2 +037100 HEAD-ROUTINE. IX2024.2 +037200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2024.2 +037500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2024.2 +037600 COLUMN-NAMES-ROUTINE. IX2024.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +038000 END-ROUTINE. IX2024.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2024.2 +038200 END-RTN-EXIT. IX2024.2 +038300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +038400 END-ROUTINE-1. IX2024.2 +038500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2024.2 +038600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2024.2 +038700 ADD PASS-COUNTER TO ERROR-HOLD. IX2024.2 +038800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2024.2 +038900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2024.2 +039000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2024.2 +039100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2024.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2024.2 +039300 END-ROUTINE-12. IX2024.2 +039400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2024.2 +039500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2024.2 +039600 MOVE "NO " TO ERROR-TOTAL IX2024.2 +039700 ELSE IX2024.2 +039800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2024.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2024.2 +040000 PERFORM WRITE-LINE. IX2024.2 +040100 END-ROUTINE-13. IX2024.2 +040200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2024.2 +040300 MOVE "NO " TO ERROR-TOTAL ELSE IX2024.2 +040400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2024.2 +040500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2024.2 +040600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +040700 IF INSPECT-COUNTER EQUAL TO ZERO IX2024.2 +040800 MOVE "NO " TO ERROR-TOTAL IX2024.2 +040900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2024.2 +041000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2024.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +041200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +041300 WRITE-LINE. IX2024.2 +041400 ADD 1 TO RECORD-COUNT. IX2024.2 +041500Y IF RECORD-COUNT GREATER 42 IX2024.2 +041600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2024.2 +041700Y MOVE SPACE TO DUMMY-RECORD IX2024.2 +041800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2024.2 +041900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2024.2 +042000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2024.2 +042100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2024.2 +042200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2024.2 +042300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2024.2 +042700Y MOVE ZERO TO RECORD-COUNT. IX2024.2 +042800 PERFORM WRT-LN. IX2024.2 +042900 WRT-LN. IX2024.2 +043000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2024.2 +043100 MOVE SPACE TO DUMMY-RECORD. IX2024.2 +043200 BLANK-LINE-PRINT. IX2024.2 +043300 PERFORM WRT-LN. IX2024.2 +043400 FAIL-ROUTINE. IX2024.2 +043500 IF COMPUTED-X NOT EQUAL TO SPACE IX2024.2 +043600 GO TO FAIL-ROUTINE-WRITE. IX2024.2 +043700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2024.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2024.2 +043900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2024.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2024.2 +044200 GO TO FAIL-ROUTINE-EX. IX2024.2 +044300 FAIL-ROUTINE-WRITE. IX2024.2 +044400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2024.2 +044500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2024.2 +044600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2024.2 +044700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2024.2 +044800 FAIL-ROUTINE-EX. EXIT. IX2024.2 +044900 BAIL-OUT. IX2024.2 +045000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2024.2 +045100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2024.2 +045200 BAIL-OUT-WRITE. IX2024.2 +045300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2024.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2024.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2024.2 +045700 BAIL-OUT-EX. EXIT. IX2024.2 +045800 CCVS1-EXIT. IX2024.2 +045900 EXIT. IX2024.2 +046000 SECT-IX-02-001 SECTION. IX2024.2 +046100 READ-INIT-F2-01. IX2024.2 +046200 OPEN INPUT IX-FD1. IX2024.2 +046300 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2024.2 +046400 MOVE ZERO TO WRK-DU-09V00-001. IX2024.2 +046500 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +046600 MOVE ZERO TO WRK-CS-09V00-002 IX2024.2 +046700 MOVE ZERO TO WRK-DU-09V00-001 IX2024.2 +046800 MOVE "READ RANDOM " TO FEATURE. IX2024.2 +046900 READ-TEST-F2-01-R. IX2024.2 +047000 ADD 1 TO WRK-DU-09V00-001 IX2024.2 +047100 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +047200 IF WRK-DU-09V00-001 GREATER 501 IX2024.2 +047300 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +047400 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A IX2024.2 +047500 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX2024.2 +047600 PERFORM FAIL IX2024.2 +047700 PERFORM PRINT-DETAIL IX2024.2 +047800 GO TO READ-WRITE-F2-01. IX2024.2 +047900 READ IX-FD1 IX2024.2 +048000 INVALID KEY GO TO READ-WRITE-F2-01. IX2024.2 +048100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2024.2 +048200 IF XRECORD-NUMBER (1) EQUAL TO WRK-DU-09V00-001 IX2024.2 +048300 GO TO READ-TEST-F2-01-R. IX2024.2 +048400 MOVE "YES" TO I-O-ERROR-IX-FD1. IX2024.2 +048500 ADD 1 TO WRK-CS-09V00-002 IX2024.2 +048600 GO TO READ-TEST-F2-01-R. IX2024.2 +048700 READ-WRITE-F2-01. IX2024.2 +048800 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX2024.2 +048900 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +049000 MOVE "WRONG KEY/NOT 500" TO CORRECT-A IX2024.2 +049100 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +049200 PERFORM FAIL IX2024.2 +049300 ELSE IX2024.2 +049400 PERFORM PASS. IX2024.2 +049500 PERFORM PRINT-DETAIL. IX2024.2 +049600 READ-TEST-F2-01-1. IX2024.2 +049700 MOVE "READ-TEST-F2-01-1" TO PAR-NAME. IX2024.2 +049800 MOVE "READ TOO LESS RECORDS" TO RE-MARK. IX2024.2 +049900 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX2024.2 +050000 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +050100 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A IX2024.2 +050200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2024.2 +050300 PERFORM FAIL IX2024.2 +050400 ELSE IX2024.2 +050500 PERFORM PASS. IX2024.2 +050600 PERFORM PRINT-DETAIL. IX2024.2 +050700 READ-TEST-F2-01-2. IX2024.2 +050800 MOVE "READ-TEST-F2-01-2" TO PAR-NAME. IX2024.2 +050900 MOVE "READ TOO MUCH RECORDS" TO RE-MARK. IX2024.2 +051000 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX2024.2 +051100 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +051200 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX2024.2 +051300 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +051400 MOVE 501 TO CORRECT-18V0 IX2024.2 +051500 PERFORM FAIL IX2024.2 +051600 ELSE IX2024.2 +051700 PERFORM PASS. IX2024.2 +051800 PERFORM PRINT-DETAIL. IX2024.2 +051900 READ-TEST-F2-01-3. IX2024.2 +052000 MOVE "READ-TEST-F2-01-3" TO PAR-NAME. IX2024.2 +052100 MOVE "READ WRONG RECORDS" TO RE-MARK. IX2024.2 +052200 IF I-O-ERROR-IX-FD1 EQUAL TO "YES" IX2024.2 +052300 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +052400 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 IX2024.2 +052500 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK IX2024.2 +052600 PERFORM FAIL IX2024.2 +052700 ELSE IX2024.2 +052800 PERFORM PASS. IX2024.2 +052900 PERFORM PRINT-DETAIL. IX2024.2 +053000 CLOSE IX-FD1. IX2024.2 +053100* IX2024.2 +053200* U P D A T E READ & REWRITE IX2024.2 +053300* IX2024.2 +053400 RWRT-INIT-GF-01-R . IX2024.2 +053500 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2024.2 +053600 MOVE "REWRITE " TO FEATURE. IX2024.2 +053700 OPEN I-O IX-FD1. IX2024.2 +053800 MOVE ZERO TO IX-FD1-KEY. IX2024.2 +053900 MOVE ZERO TO WRK-CS-09V00-002. IX2024.2 +054000 MOVE ZERO TO WRK-DU-09V00-001. IX2024.2 +054100 MOVE SPACE TO FILE-RECORD-INFO (1). IX2024.2 +054200 RWRT-TEST-GF-01-R. IX2024.2 +054300 ADD 5 TO WRK-DU-09V00-001. IX2024.2 +054400 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +054500 IF WRK-DU-09V00-001 GREATER 505 IX2024.2 +054600 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX2024.2 +054700 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX2024.2 +054800 PERFORM FAIL IX2024.2 +054900 PERFORM PRINT-DETAIL IX2024.2 +055000 GO TO RWRT-TEST-GF-01-3. IX2024.2 +055100 READ IX-FD1 IX2024.2 +055200 INVALID KEY GO TO RWRT-TEST-GF-01-1. IX2024.2 +055300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1) IX2024.2 +055400 ADD 01 TO UPDATE-NUMBER (1). IX2024.2 +055500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2024.2 +055600 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2024.2 +055700 REWRITE IX-FS1R1-F-G-240 IX2024.2 +055800 INVALID KEY GO TO RWRT-TEST-GF-01-2. IX2024.2 +055900 GO TO RWRT-TEST-GF-01-R. IX2024.2 +056000 RWRT-TEST-GF-01-1. IX2024.2 +056100 MOVE "RWRT-TEST-GF-01-1" TO PAR-NAME. IX2024.2 +056200 MOVE "READ INVALID" TO FEATURE. IX2024.2 +056300 IF WRK-DU-09V00-001 LESS THAN 501 IX2024.2 +056400 ADD 1 TO WRK-CS-09V00-001 IX2024.2 +056500 GO TO RWRT-TEST-GF-01-R. IX2024.2 +056600 PERFORM PASS. IX2024.2 +056700 PERFORM PRINT-DETAIL. IX2024.2 +056800 GO TO RWRT-TEST-GF-01-3. IX2024.2 +056900 RWRT-TEST-GF-01-2. IX2024.2 +057000 ADD 1 TO WRK-CS-09V00-005. IX2024.2 +057100 IF WRK-DU-09V00-001 LESS THAN 501 IX2024.2 +057200 GO TO RWRT-TEST-GF-01-R. IX2024.2 +057300 RWRT-TEST-GF-01-3. IX2024.2 +057400 MOVE "RWRT-TEST-GF-03-1" TO PAR-NAME. IX2024.2 +057500 MOVE "READ INVALID" TO FEATURE. IX2024.2 +057600 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO IX2024.2 +057700 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +057800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2024.2 +057900 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX2024.2 +058000 PERFORM FAIL IX2024.2 +058100 ELSE IX2024.2 +058200 PERFORM PASS. IX2024.2 +058300 PERFORM PRINT-DETAIL. IX2024.2 +058400 RWRT-TEST-GF-02-1. IX2024.2 +058500 MOVE "RWRT-TEST-GF-02-1" TO PAR-NAME. IX2024.2 +058600 MOVE "REWRITE " TO FEATURE. IX2024.2 +058700 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO IX2024.2 +058800 MOVE "IX-33; 4.6.2 " TO RE-MARK IX2024.2 +058900 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A IX2024.2 +059000 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX2024.2 +059100 PERFORM FAIL IX2024.2 +059200 ELSE IX2024.2 +059300 PERFORM PASS. IX2024.2 +059400 PERFORM PRINT-DETAIL. IX2024.2 +059500 CLOSE IX-FD1. IX2024.2 +059600 READ-INIT-F2-02. IX2024.2 +059700 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2024.2 +059800 MOVE "READ " TO FEATURE. IX2024.2 +059900 OPEN INPUT IX-FD1. IX2024.2 +060000 MOVE 501 TO WRK-DU-09V00-001. IX2024.2 +060100 MOVE ZERO TO WRK-CS-09V00-004. IX2024.2 +060200 MOVE ZERO TO WRK-CS-09V00-005. IX2024.2 +060300 MOVE ZERO TO WRK-CS-09V00-002. IX2024.2 +060400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2024.2 +060500 READ-TEST-F2-02-R. IX2024.2 +060600 IF WRK-DU-09V00-001 EQUAL TO ZERO IX2024.2 +060700 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX2024.2 +060800 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +060900 MOVE ZERO TO CORRECT-18V0 IX2024.2 +061000 PERFORM FAIL IX2024.2 +061100 PERFORM PRINT-DETAIL IX2024.2 +061200 GO TO READ-TEST-F2-02-1-0. IX2024.2 +061300 SUBTRACT 1 FROM WRK-DU-09V00-001. IX2024.2 +061400 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +061500 READ IX-FD1 IX2024.2 +061600 INVALID KEY GO TO READ-TEST-F2-02-1. IX2024.2 +061700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2024.2 +061800 IF UPDATE-NUMBER (1) EQUAL TO 00 IX2024.2 +061900 ADD 1 TO WRK-CS-09V00-004. IX2024.2 +062000 IF UPDATE-NUMBER (1) EQUAL TO 01 IX2024.2 +062100 ADD 1 TO WRK-CS-09V00-005. IX2024.2 +062200 GO TO READ-TEST-F2-02-R. IX2024.2 +062300 READ-TEST-F2-02-1. IX2024.2 +062400 IF WRK-DU-09V00-001 GREATER ZERO IX2024.2 +062500 ADD 1 TO WRK-CS-09V00-002 IX2024.2 +062600 GO TO READ-TEST-F2-02-R. IX2024.2 +062700 PERFORM PASS. IX2024.2 +062800 PERFORM PRINT-DETAIL. IX2024.2 +062900 READ-TEST-F2-02-1-0. IX2024.2 +063000 MOVE "READ-TEST-F2-02-1 " TO PAR-NAME. IX2024.2 +063100 MOVE "READ " TO FEATURE. IX2024.2 +063200 IF WRK-CS-09V00-004 NOT EQUAL TO 400 IX2024.2 +063300 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX2024.2 +063400 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX2024.2 +063500 MOVE "SHOULD BE 400" TO RE-MARK IX2024.2 +063600 PERFORM FAIL IX2024.2 +063700 ELSE IX2024.2 +063800 PERFORM PASS. IX2024.2 +063900 PERFORM PRINT-DETAIL. IX2024.2 +064000 READ-TEST-F2-02-2. IX2024.2 +064100 MOVE "READ-TEST-F2-02-2" TO PAR-NAME. IX2024.2 +064200 MOVE "READ " TO FEATURE. IX2024.2 +064300 IF WRK-CS-09V00-005 NOT EQUAL TO 100 IX2024.2 +064400 MOVE "UPDATED RECORDS" TO COMPUTED-A IX2024.2 +064500 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX2024.2 +064600 MOVE "SHOULD BE 100" TO RE-MARK IX2024.2 +064700 PERFORM FAIL IX2024.2 +064800 ELSE IX2024.2 +064900 PERFORM PASS. IX2024.2 +065000 PERFORM PRINT-DETAIL. IX2024.2 +065100 READ-TEST-F2-02-3. IX2024.2 +065200 MOVE "READ-TEST-F2-02-3" TO PAR-NAME. IX2024.2 +065300 MOVE "READ " TO FEATURE. IX2024.2 +065400 IF WRK-CS-09V00-002 GREATER 1 IX2024.2 +065500 MOVE WRK-CS-09V00-002 TO COMPUTED-N IX2024.2 +065600 MOVE "INVALID KEY/READS" TO CORRECT-A IX2024.2 +065700 PERFORM FAIL IX2024.2 +065800 ELSE IX2024.2 +065900 PERFORM PASS. IX2024.2 +066000 PERFORM PRINT-DETAIL. IX2024.2 +066100 CLOSE IX-FD1. IX2024.2 +066200 CCVS-EXIT SECTION. IX2024.2 +066300 CCVS-999999. IX2024.2 +066400 GO TO CLOSE-FILES. IX2024.2 +*END-OF,IX202A +*HEADER,COBOL,IX201A,SUBPRG,IX203A +000100 IDENTIFICATION DIVISION. IX2034.2 +000200 PROGRAM-ID. IX2034.2 +000300 IX203A. IX2034.2 +000400**************************************************************** IX2034.2 +000500* * IX2034.2 +000600* VALIDATION FOR:- * IX2034.2 +000700* * IX2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +000900* * IX2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2034.2 +001100* * IX2034.2 +001200**************************************************************** IX2034.2 +001300* THIS PROGRAM IS THE THIRD OF A SERIES. ITS FUNCTION IX2034.2 +001400* IS TO PROCESS THE FILE SEQUENTIALLY USING THE ACCESS MODE IS IX2034.2 +001500* DYNAMIC CLAUSE. THE FILE USED IS THAT RESULTING FROM IX202. IX2034.2 +001600* IX2034.2 +001700* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RECORDS. IX2034.2 +001800* SECONDLY, RECORDS OF THE FILE ARE SELECTIVELY DELETED AND IX2034.2 +001900* THIRDLY THE ACCURACY OF EACH RECORD IN THE FILE IS AGAIN IX2034.2 +002000* VERIFIED. IX2034.2 +002100* IX2034.2 +002200* IX2034.2 +002300* IX2034.2 +002400* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2034.2 +002500* IX2034.2 +002600* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2034.2 +002700* CLAUSE FOR DATA FILE IX-FS1 IX2034.2 +002800* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2034.2 +002900* CLAUSE FOR INDEX FILE IX-FS1 IX2034.2 +003000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2034.2 +003100* X-62 FOR RAW-DATA IX2034.2 +003200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2034.2 +003300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2034.2 +003400* IX2034.2 +003500* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2034.2 +003600* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2034.2 +003700* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2034.2 +003800* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2034.2 +003900* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2034.2 +004000* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2034.2 +004100* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2034.2 +004200* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2034.2 +004300* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2034.2 +004400* THEY ARE AS FOLLOWS IX2034.2 +004500* IX2034.2 +004600* P SELECTS X-CARDS 62 IX2034.2 +004700* J SELECTS X-CARD 44 IX2034.2 +004800* IX2034.2 +004900 ENVIRONMENT DIVISION. IX2034.2 +005000 CONFIGURATION SECTION. IX2034.2 +005100 SOURCE-COMPUTER. IX2034.2 +005200 XXXXX082. IX2034.2 +005300 OBJECT-COMPUTER. IX2034.2 +005400 XXXXX083. IX2034.2 +005500 INPUT-OUTPUT SECTION. IX2034.2 +005600 FILE-CONTROL. IX2034.2 +005700P SELECT RAW-DATA ASSIGN TO IX2034.2 +005800P XXXXX062 IX2034.2 +005900P ORGANIZATION IS INDEXED IX2034.2 +006000P ACCESS MODE IS RANDOM IX2034.2 +006100P RECORD KEY IS RAW-DATA-KEY. IX2034.2 +006200 SELECT PRINT-FILE ASSIGN TO IX2034.2 +006300 XXXXX055. IX2034.2 +006400 SELECT IX-FD1 ASSIGN TO IX2034.2 +006500 XXXXD024 IX2034.2 +006600J XXXXD044 IX2034.2 +006700 ACCESS MODE IS DYNAMIC IX2034.2 +006800 ORGANIZATION IS INDEXED IX2034.2 +006900 RECORD IX-FD1-KEY. IX2034.2 +007000 DATA DIVISION. IX2034.2 +007100 FILE SECTION. IX2034.2 +007200P IX2034.2 +007300PFD RAW-DATA. IX2034.2 +007400P IX2034.2 +007500P01 RAW-DATA-SATZ. IX2034.2 +007600P 05 RAW-DATA-KEY PIC X(6). IX2034.2 +007700P 05 C-DATE PIC 9(6). IX2034.2 +007800P 05 C-TIME PIC 9(8). IX2034.2 +007900P 05 C-NO-OF-TESTS PIC 99. IX2034.2 +008000P 05 C-OK PIC 999. IX2034.2 +008100P 05 C-ALL PIC 999. IX2034.2 +008200P 05 C-FAIL PIC 999. IX2034.2 +008300P 05 C-DELETED PIC 999. IX2034.2 +008400P 05 C-INSPECT PIC 999. IX2034.2 +008500P 05 C-NOTE PIC X(13). IX2034.2 +008600P 05 C-INDENT PIC X. IX2034.2 +008700P 05 C-ABORT PIC X(8). IX2034.2 +008800 FD PRINT-FILE. IX2034.2 +008900 01 PRINT-REC PICTURE X(120). IX2034.2 +009000 01 DUMMY-RECORD PICTURE X(120). IX2034.2 +009100 FD IX-FD1 IX2034.2 +009200C LABEL RECORD STANDARD IX2034.2 +009300C DATA RECORDS ARE IX-FD1R1-F-G-240 IX2034.2 +009400 BLOCK CONTAINS 01 RECORDS IX2034.2 +009500 RECORD CONTAINS 240. IX2034.2 +009600 01 IX-FD1R1-F-G-240. IX2034.2 +009700 05 IX-FD1-REC-120 PIC X(120). IX2034.2 +009800 05 IX-FD1-REC-120-240. IX2034.2 +009900 10 FILLER PIC X(8). IX2034.2 +010000 10 IX-FD1-KEY PIC X(29). IX2034.2 +010100 10 FILLER PIC X(83). IX2034.2 +010200 WORKING-STORAGE SECTION. IX2034.2 +010300 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010400 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010500 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010600 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010700 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010800 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010900 01 I-O-ERROR-IX-FD1 PIC X(3) VALUE "NO ". IX2034.2 +011000 01 IX-WRK-KEY. IX2034.2 +011100 03 FILLER PIC X(10). IX2034.2 +011200 03 WRK-DU-09V00-001 PIC 9(9). IX2034.2 +011300 03 FILLER PIC X(10). IX2034.2 +011400 01 DUMMY-WRK-REC. IX2034.2 +011500 02 DUMMY-WRK1 PIC X(120). IX2034.2 +011600 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2034.2 +011700 03 FILLER PIC X(5). IX2034.2 +011800 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2034.2 +011900 01 FILE-RECORD-INFORMATION-REC. IX2034.2 +012000 03 FILE-RECORD-INFO-SKELETON. IX2034.2 +012100 05 FILLER PICTURE X(48) VALUE IX2034.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2034.2 +012300 05 FILLER PICTURE X(46) VALUE IX2034.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2034.2 +012500 05 FILLER PICTURE X(26) VALUE IX2034.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". IX2034.2 +012700 05 FILLER PICTURE X(37) VALUE IX2034.2 +012800 ",RECKEY= ". IX2034.2 +012900 05 FILLER PICTURE X(38) VALUE IX2034.2 +013000 ",ALTKEY1= ". IX2034.2 +013100 05 FILLER PICTURE X(38) VALUE IX2034.2 +013200 ",ALTKEY2= ". IX2034.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.IX2034.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2034.2 +013500 05 FILE-RECORD-INFO-P1-120. IX2034.2 +013600 07 FILLER PIC X(5). IX2034.2 +013700 07 XFILE-NAME PIC X(6). IX2034.2 +013800 07 FILLER PIC X(8). IX2034.2 +013900 07 XRECORD-NAME PIC X(6). IX2034.2 +014000 07 FILLER PIC X(1). IX2034.2 +014100 07 REELUNIT-NUMBER PIC 9(1). IX2034.2 +014200 07 FILLER PIC X(7). IX2034.2 +014300 07 XRECORD-NUMBER PIC 9(6). IX2034.2 +014400 07 FILLER PIC X(6). IX2034.2 +014500 07 UPDATE-NUMBER PIC 9(2). IX2034.2 +014600 07 FILLER PIC X(5). IX2034.2 +014700 07 ODO-NUMBER PIC 9(4). IX2034.2 +014800 07 FILLER PIC X(5). IX2034.2 +014900 07 XPROGRAM-NAME PIC X(5). IX2034.2 +015000 07 FILLER PIC X(7). IX2034.2 +015100 07 XRECORD-LENGTH PIC 9(6). IX2034.2 +015200 07 FILLER PIC X(7). IX2034.2 +015300 07 CHARS-OR-RECORDS PIC X(2). IX2034.2 +015400 07 FILLER PIC X(1). IX2034.2 +015500 07 XBLOCK-SIZE PIC 9(4). IX2034.2 +015600 07 FILLER PIC X(6). IX2034.2 +015700 07 RECORDS-IN-FILE PIC 9(6). IX2034.2 +015800 07 FILLER PIC X(5). IX2034.2 +015900 07 XFILE-ORGANIZATION PIC X(2). IX2034.2 +016000 07 FILLER PIC X(6). IX2034.2 +016100 07 XLABEL-TYPE PIC X(1). IX2034.2 +016200 05 FILE-RECORD-INFO-P121-240. IX2034.2 +016300 07 FILLER PIC X(8). IX2034.2 +016400 07 XRECORD-KEY PIC X(29). IX2034.2 +016500 07 FILLER PIC X(9). IX2034.2 +016600 07 ALTERNATE-KEY1 PIC X(29). IX2034.2 +016700 07 FILLER PIC X(9). IX2034.2 +016800 07 ALTERNATE-KEY2 PIC X(29). IX2034.2 +016900 07 FILLER PIC X(7). IX2034.2 +017000 01 TEST-RESULTS. IX2034.2 +017100 02 FILLER PIC X VALUE SPACE. IX2034.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. IX2034.2 +017300 02 FILLER PIC X VALUE SPACE. IX2034.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. IX2034.2 +017500 02 FILLER PIC X VALUE SPACE. IX2034.2 +017600 02 PAR-NAME. IX2034.2 +017700 03 FILLER PIC X(19) VALUE SPACE. IX2034.2 +017800 03 PARDOT-X PIC X VALUE SPACE. IX2034.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. IX2034.2 +018000 02 FILLER PIC X(8) VALUE SPACE. IX2034.2 +018100 02 RE-MARK PIC X(61). IX2034.2 +018200 01 TEST-COMPUTED. IX2034.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2034.2 +018400 02 FILLER PIC X(17) VALUE IX2034.2 +018500 " COMPUTED=". IX2034.2 +018600 02 COMPUTED-X. IX2034.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2034.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A IX2034.2 +018900 PIC -9(9).9(9). IX2034.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2034.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2034.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2034.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. IX2034.2 +019400 04 COMPUTED-18V0 PIC -9(18). IX2034.2 +019500 04 FILLER PIC X. IX2034.2 +019600 03 FILLER PIC X(50) VALUE SPACE. IX2034.2 +019700 01 TEST-CORRECT. IX2034.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2034.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2034.2 +020000 02 CORRECT-X. IX2034.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2034.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2034.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2034.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2034.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2034.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. IX2034.2 +020700 04 CORRECT-18V0 PIC -9(18). IX2034.2 +020800 04 FILLER PIC X. IX2034.2 +020900 03 FILLER PIC X(2) VALUE SPACE. IX2034.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2034.2 +021100 01 CCVS-C-1. IX2034.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2034.2 +021300- "SS PARAGRAPH-NAME IX2034.2 +021400- " REMARKS". IX2034.2 +021500 02 FILLER PIC X(20) VALUE SPACE. IX2034.2 +021600 01 CCVS-C-2. IX2034.2 +021700 02 FILLER PIC X VALUE SPACE. IX2034.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". IX2034.2 +021900 02 FILLER PIC X(15) VALUE SPACE. IX2034.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". IX2034.2 +022100 02 FILLER PIC X(94) VALUE SPACE. IX2034.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2034.2 +022300 01 REC-CT PIC 99 VALUE ZERO. IX2034.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2034.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2034.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2034.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2034.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2034.2 +023300 01 CCVS-H-1. IX2034.2 +023400 02 FILLER PIC X(39) VALUE SPACES. IX2034.2 +023500 02 FILLER PIC X(42) VALUE IX2034.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2034.2 +023700 02 FILLER PIC X(39) VALUE SPACES. IX2034.2 +023800 01 CCVS-H-2A. IX2034.2 +023900 02 FILLER PIC X(40) VALUE SPACE. IX2034.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2034.2 +024100 02 FILLER PIC XXXX VALUE IX2034.2 +024200 "4.2 ". IX2034.2 +024300 02 FILLER PIC X(28) VALUE IX2034.2 +024400 " COPY - NOT FOR DISTRIBUTION". IX2034.2 +024500 02 FILLER PIC X(41) VALUE SPACE. IX2034.2 +024600 IX2034.2 +024700 01 CCVS-H-2B. IX2034.2 +024800 02 FILLER PIC X(15) VALUE IX2034.2 +024900 "TEST RESULT OF ". IX2034.2 +025000 02 TEST-ID PIC X(9). IX2034.2 +025100 02 FILLER PIC X(4) VALUE IX2034.2 +025200 " IN ". IX2034.2 +025300 02 FILLER PIC X(12) VALUE IX2034.2 +025400 " HIGH ". IX2034.2 +025500 02 FILLER PIC X(22) VALUE IX2034.2 +025600 " LEVEL VALIDATION FOR ". IX2034.2 +025700 02 FILLER PIC X(58) VALUE IX2034.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +025900 01 CCVS-H-3. IX2034.2 +026000 02 FILLER PIC X(34) VALUE IX2034.2 +026100 " FOR OFFICIAL USE ONLY ". IX2034.2 +026200 02 FILLER PIC X(58) VALUE IX2034.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2034.2 +026400 02 FILLER PIC X(28) VALUE IX2034.2 +026500 " COPYRIGHT 1985 ". IX2034.2 +026600 01 CCVS-E-1. IX2034.2 +026700 02 FILLER PIC X(52) VALUE SPACE. IX2034.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2034.2 +026900 02 ID-AGAIN PIC X(9). IX2034.2 +027000 02 FILLER PIC X(45) VALUE SPACES. IX2034.2 +027100 01 CCVS-E-2. IX2034.2 +027200 02 FILLER PIC X(31) VALUE SPACE. IX2034.2 +027300 02 FILLER PIC X(21) VALUE SPACE. IX2034.2 +027400 02 CCVS-E-2-2. IX2034.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2034.2 +027600 03 FILLER PIC X VALUE SPACE. IX2034.2 +027700 03 ENDER-DESC PIC X(44) VALUE IX2034.2 +027800 "ERRORS ENCOUNTERED". IX2034.2 +027900 01 CCVS-E-3. IX2034.2 +028000 02 FILLER PIC X(22) VALUE IX2034.2 +028100 " FOR OFFICIAL USE ONLY". IX2034.2 +028200 02 FILLER PIC X(12) VALUE SPACE. IX2034.2 +028300 02 FILLER PIC X(58) VALUE IX2034.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +028500 02 FILLER PIC X(13) VALUE SPACE. IX2034.2 +028600 02 FILLER PIC X(15) VALUE IX2034.2 +028700 " COPYRIGHT 1985". IX2034.2 +028800 01 CCVS-E-4. IX2034.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2034.2 +029000 02 FILLER PIC X(4) VALUE " OF ". IX2034.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2034.2 +029200 02 FILLER PIC X(40) VALUE IX2034.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2034.2 +029400 01 XXINFO. IX2034.2 +029500 02 FILLER PIC X(19) VALUE IX2034.2 +029600 "*** INFORMATION ***". IX2034.2 +029700 02 INFO-TEXT. IX2034.2 +029800 04 FILLER PIC X(8) VALUE SPACE. IX2034.2 +029900 04 XXCOMPUTED PIC X(20). IX2034.2 +030000 04 FILLER PIC X(5) VALUE SPACE. IX2034.2 +030100 04 XXCORRECT PIC X(20). IX2034.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). IX2034.2 +030300 01 HYPHEN-LINE. IX2034.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. IX2034.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************IX2034.2 +030600- "*****************************************". IX2034.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************IX2034.2 +030800- "******************************". IX2034.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE IX2034.2 +031000 "IX203A". IX2034.2 +031100 PROCEDURE DIVISION. IX2034.2 +031200 CCVS1 SECTION. IX2034.2 +031300 OPEN-FILES. IX2034.2 +031400P OPEN I-O RAW-DATA. IX2034.2 +031500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2034.2 +031600P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2034.2 +031700P MOVE "ABORTED " TO C-ABORT. IX2034.2 +031800P ADD 1 TO C-NO-OF-TESTS. IX2034.2 +031900P ACCEPT C-DATE FROM DATE. IX2034.2 +032000P ACCEPT C-TIME FROM TIME. IX2034.2 +032100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2034.2 +032200PEND-E-1. IX2034.2 +032300P CLOSE RAW-DATA. IX2034.2 +032400 OPEN OUTPUT PRINT-FILE. IX2034.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2034.2 +032600 MOVE SPACE TO TEST-RESULTS. IX2034.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2034.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX2034.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2034.2 +033000 CCVS-INIT-FILE. IX2034.2 +033100 ADD 1 TO REC-SKL-SUB. IX2034.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX2034.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2034.2 +033400 CCVS-INIT-EXIT. IX2034.2 +033500 GO TO CCVS1-EXIT. IX2034.2 +033600 CLOSE-FILES. IX2034.2 +033700P OPEN I-O RAW-DATA. IX2034.2 +033800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2034.2 +033900P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2034.2 +034000P MOVE "OK. " TO C-ABORT. IX2034.2 +034100P MOVE PASS-COUNTER TO C-OK. IX2034.2 +034200P MOVE ERROR-HOLD TO C-ALL. IX2034.2 +034300P MOVE ERROR-COUNTER TO C-FAIL. IX2034.2 +034400P MOVE DELETE-COUNTER TO C-DELETED. IX2034.2 +034500P MOVE INSPECT-COUNTER TO C-INSPECT. IX2034.2 +034600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2034.2 +034700PEND-E-2. IX2034.2 +034800P CLOSE RAW-DATA. IX2034.2 +034900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2034.2 +035000 TERMINATE-CCVS. IX2034.2 +035100S EXIT PROGRAM. IX2034.2 +035200STERMINATE-CALL. IX2034.2 +035300 STOP RUN. IX2034.2 +035400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2034.2 +035500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2034.2 +035600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2034.2 +035700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2034.2 +035800 MOVE "****TEST DELETED****" TO RE-MARK. IX2034.2 +035900 PRINT-DETAIL. IX2034.2 +036000 IF REC-CT NOT EQUAL TO ZERO IX2034.2 +036100 MOVE "." TO PARDOT-X IX2034.2 +036200 MOVE REC-CT TO DOTVALUE. IX2034.2 +036300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2034.2 +036400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2034.2 +036500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2034.2 +036600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2034.2 +036700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2034.2 +036800 MOVE SPACE TO CORRECT-X. IX2034.2 +036900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2034.2 +037000 MOVE SPACE TO RE-MARK. IX2034.2 +037100 HEAD-ROUTINE. IX2034.2 +037200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2034.2 +037500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2034.2 +037600 COLUMN-NAMES-ROUTINE. IX2034.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +038000 END-ROUTINE. IX2034.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2034.2 +038200 END-RTN-EXIT. IX2034.2 +038300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +038400 END-ROUTINE-1. IX2034.2 +038500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2034.2 +038600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2034.2 +038700 ADD PASS-COUNTER TO ERROR-HOLD. IX2034.2 +038800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2034.2 +038900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2034.2 +039000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2034.2 +039100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2034.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2034.2 +039300 END-ROUTINE-12. IX2034.2 +039400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2034.2 +039500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2034.2 +039600 MOVE "NO " TO ERROR-TOTAL IX2034.2 +039700 ELSE IX2034.2 +039800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2034.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2034.2 +040000 PERFORM WRITE-LINE. IX2034.2 +040100 END-ROUTINE-13. IX2034.2 +040200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2034.2 +040300 MOVE "NO " TO ERROR-TOTAL ELSE IX2034.2 +040400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2034.2 +040500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2034.2 +040600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +040700 IF INSPECT-COUNTER EQUAL TO ZERO IX2034.2 +040800 MOVE "NO " TO ERROR-TOTAL IX2034.2 +040900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2034.2 +041000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2034.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +041200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +041300 WRITE-LINE. IX2034.2 +041400 ADD 1 TO RECORD-COUNT. IX2034.2 +041500Y IF RECORD-COUNT GREATER 42 IX2034.2 +041600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2034.2 +041700Y MOVE SPACE TO DUMMY-RECORD IX2034.2 +041800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2034.2 +041900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2034.2 +042000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2034.2 +042100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2034.2 +042200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2034.2 +042300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2034.2 +042700Y MOVE ZERO TO RECORD-COUNT. IX2034.2 +042800 PERFORM WRT-LN. IX2034.2 +042900 WRT-LN. IX2034.2 +043000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2034.2 +043100 MOVE SPACE TO DUMMY-RECORD. IX2034.2 +043200 BLANK-LINE-PRINT. IX2034.2 +043300 PERFORM WRT-LN. IX2034.2 +043400 FAIL-ROUTINE. IX2034.2 +043500 IF COMPUTED-X NOT EQUAL TO SPACE IX2034.2 +043600 GO TO FAIL-ROUTINE-WRITE. IX2034.2 +043700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2034.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2034.2 +043900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2034.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2034.2 +044200 GO TO FAIL-ROUTINE-EX. IX2034.2 +044300 FAIL-ROUTINE-WRITE. IX2034.2 +044400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2034.2 +044500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2034.2 +044600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2034.2 +044700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2034.2 +044800 FAIL-ROUTINE-EX. EXIT. IX2034.2 +044900 BAIL-OUT. IX2034.2 +045000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2034.2 +045100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2034.2 +045200 BAIL-OUT-WRITE. IX2034.2 +045300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2034.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2034.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2034.2 +045700 BAIL-OUT-EX. EXIT. IX2034.2 +045800 CCVS1-EXIT. IX2034.2 +045900 EXIT. IX2034.2 +046000 SECT-IX-03-001 SECTION. IX2034.2 +046100 READ-INIT-F1-01. IX2034.2 +046200* THIS FILE "IX-FD1" IS ACCESSED SEQUENTIALLY AND HAS IX2034.2 +046300* ASSOCIATED WITH IT A RECORD KEY WHICH AT ALL TIMES SHOULD IX2034.2 +046400* CONTAIN THE INDEX OF THE RECORD PREVIOUSLY READ. IX2034.2 +046500 OPEN INPUT IX-FD1. IX2034.2 +046600 MOVE ZERO TO WRK-CS-09V00-006. IX2034.2 +046700 MOVE ZERO TO WRK-CS-09V00-007. IX2034.2 +046800 MOVE ZERO TO WRK-CS-09V00-008. IX2034.2 +046900 MOVE ZERO TO WRK-CS-09V00-009. IX2034.2 +047000 MOVE ZERO TO WRK-CS-09V00-010. IX2034.2 +047100 MOVE ZERO TO WRK-CS-09V00-011. IX2034.2 +047200 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +047300 MOVE ZERO TO WRK-DU-09V00-001. IX2034.2 +047400 MOVE IX-FD1-KEY TO COMPUTED-A. IX2034.2 +047500 MOVE SPACE TO P-OR-F. IX2034.2 +047600 MOVE "INFORMATION" TO CORRECT-A. IX2034.2 +047700 MOVE "KEY AFTER OPEN" TO RE-MARK. IX2034.2 +047800 MOVE "RECORD KEY ON OPEN" TO FEATURE. IX2034.2 +047900 MOVE "READ-INIT-F1-01" TO PAR-NAME. IX2034.2 +048000 PERFORM PRINT-DETAIL. IX2034.2 +048100* IX2034.2 +048200* IX2034.2 +048300* IX2034.2 +048400 READ-INIT-F1-01-0. IX2034.2 +048500 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2034.2 +048600 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +048700 READ-TEST-F1-01-R. IX2034.2 +048800 ADD 1 TO WRK-CS-09V00-006. IX2034.2 +048900 READ IX-FD1 NEXT RECORD IX2034.2 +049000 AT END GO TO READ-TEST-F1-01. IX2034.2 +049100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +049200 IF UPDATE-NUMBER (1) EQUAL TO 00 IX2034.2 +049300 ADD 1 TO WRK-CS-09V00-007 IX2034.2 +049400 GO TO READ-TEST-F1-01-2. IX2034.2 +049500 IF UPDATE-NUMBER (1) EQUAL TO 01 IX2034.2 +049600 ADD 1 TO WRK-CS-09V00-008 IX2034.2 +049700 GO TO READ-TEST-F1-01-2. IX2034.2 +049800 ADD 1 TO WRK-CS-09V00-009. IX2034.2 +049900 READ-TEST-F1-01-2. IX2034.2 +050000 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX2034.2 +050100 IF WRK-DU-09V00-001 NOT EQUAL TO XRECORD-NUMBER (1) IX2034.2 +050200 ADD 1 TO WRK-CS-09V00-010. IX2034.2 +050300 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +050400 GO TO READ-TEST-F1-01. IX2034.2 +050500 GO TO READ-TEST-F1-01-R. IX2034.2 +050600 READ-TEST-F1-01. IX2034.2 +050700 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX2034.2 +050800 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX2034.2 +050900 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +051000 MOVE 500 TO CORRECT-18V0 IX2034.2 +051100 MOVE "IX-28; 4.5.2 FORMAT 1 " TO RE-MARK IX2034.2 +051200 PERFORM FAIL IX2034.2 +051300 ELSE IX2034.2 +051400 PERFORM PASS. IX2034.2 +051500 PERFORM PRINT-DETAIL. IX2034.2 +051600* IX2034.2 +051700* IX2034.2 +051800* IX2034.2 +051900 READ-TEST-F1-02. IX2034.2 +052000 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2034.2 +052100 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +052200 IF WRK-CS-09V00-007 EQUAL TO 400 IX2034.2 +052300 PERFORM PASS IX2034.2 +052400 ELSE IX2034.2 +052500 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX2034.2 +052600 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 IX2034.2 +052700 MOVE "SHOULD BE 400; IX-28; 4.5.2 FORMAT 1 " IX2034.2 +052800 TO RE-MARK IX2034.2 +052900 PERFORM FAIL. IX2034.2 +053000 PERFORM PRINT-DETAIL. IX2034.2 +053100* IX2034.2 +053200* IX2034.2 +053300* IX2034.2 +053400 READ-TEST-F1-03. IX2034.2 +053500 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX2034.2 +053600 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +053700 IF WRK-CS-09V00-008 EQUAL TO 100 IX2034.2 +053800 PERFORM PASS IX2034.2 +053900 ELSE IX2034.2 +054000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX2034.2 +054100 MOVE 100 TO CORRECT-18V0 IX2034.2 +054200 MOVE "IX-28; 4.5.2 FORMAT 1 " TO RE-MARK IX2034.2 +054300 PERFORM FAIL. IX2034.2 +054400 PERFORM PRINT-DETAIL. IX2034.2 +054500* IX2034.2 +054600 READ-TEST-F1-04. IX2034.2 +054700 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX2034.2 +054800 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +054900 IF WRK-CS-09V00-009 EQUAL TO ZERO IX2034.2 +055000 PERFORM PASS IX2034.2 +055100 ELSE IX2034.2 +055200 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +055300 MOVE ZERO TO CORRECT-18V0 IX2034.2 +055400 MOVE "BAD UPDATES; IX-28; 4.5.2 FORMAT 1 " IX2034.2 +055500 TO RE-MARK IX2034.2 +055600 PERFORM FAIL. IX2034.2 +055700 PERFORM PRINT-DETAIL. IX2034.2 +055800* IX2034.2 +055900 READ-TEST-F1-05. IX2034.2 +056000 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX2034.2 +056100 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +056200 IF WRK-CS-09V00-010 EQUAL TO ZERO IX2034.2 +056300 PERFORM PASS IX2034.2 +056400 ELSE IX2034.2 +056500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX2034.2 +056600 MOVE ZERO TO CORRECT-18V0 IX2034.2 +056700 MOVE "IX-28; 4.5.2 FORMAT 1; KEY VS RECORD" IX2034.2 +056800 TO RE-MARK IX2034.2 +056900 PERFORM FAIL. IX2034.2 +057000 PERFORM PRINT-DETAIL. IX2034.2 +057100 CLOSE IX-FD1. IX2034.2 +057200* IX2034.2 +057300* R E A D NEXT RECORD IX2034.2 +057400* IX2034.2 +057500 DELETE-INIT-GF-01. IX2034.2 +057600 OPEN I-O IX-FD1. IX2034.2 +057700 MOVE ZERO TO WRK-CS-09V00-006 IX2034.2 +057800 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +057900 MOVE ZERO TO WRK-CS-09V00-008 IX2034.2 +058000 MOVE ZERO TO WRK-CS-09V00-009 IX2034.2 +058100 MOVE ZERO TO WRK-CS-09V00-010 IX2034.2 +058200 MOVE ZERO TO WRK-CS-09V00-011 IX2034.2 +058300 IX2034.2 +058400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +058500 MOVE "DELETE " TO FEATURE. IX2034.2 +058600 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2034.2 +058700 DELETE-TEST-GF-01-R. IX2034.2 +058800 ADD 1 TO WRK-CS-09V00-006 IX2034.2 +058900 ADD 1 TO WRK-CS-09V00-007. IX2034.2 +059000 READ IX-FD1 NEXT RECORD IX2034.2 +059100 AT END IX2034.2 +059200 MOVE "AT END PATH TAKEN " TO RE-MARK IX2034.2 +059300 GO TO DELETE-TEST-GF-01. IX2034.2 +059400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +059500 IF WRK-CS-09V00-007 EQUAL TO 4 IX2034.2 +059600 GO TO DELETE-TEST-GF-01-2. IX2034.2 +059700 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +059800 MOVE "AT END NOT TAKEN" TO RE-MARK IX2034.2 +059900 GO TO DELETE-TEST-GF-01. IX2034.2 +060000 GO TO DELETE-TEST-GF-01-R. IX2034.2 +060100 DELETE-TEST-GF-01-2. IX2034.2 +060200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2034.2 +060300 MOVE 99 TO UPDATE-NUMBER (1). IX2034.2 +060400 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2034.2 +060500 DELETE IX-FD1 INVALID KEY IX2034.2 +060600 ADD 1 TO WRK-CS-09V00-009 IX2034.2 +060700 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +060800 GO TO DELETE-TEST-GF-01-R. IX2034.2 +060900 MOVE ZERO TO WRK-CS-09V00-007. IX2034.2 +061000 ADD 1 TO WRK-CS-09V00-008 IX2034.2 +061100 GO TO DELETE-TEST-GF-01-R. IX2034.2 +061200 DELETE-TEST-GF-01. IX2034.2 +061300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX2034.2 +061400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +061500 MOVE 501 TO CORRECT-18V0 IX2034.2 +061600 MOVE "IX-21; 4.3.2 " TO RE-MARK IX2034.2 +061700 PERFORM FAIL IX2034.2 +061800 ELSE IX2034.2 +061900 PERFORM PASS. IX2034.2 +062000 PERFORM PRINT-DETAIL. IX2034.2 +062100* IX2034.2 +062200* IX2034.2 +062300* IX2034.2 +062400 DELETE-TEST-GF-02. IX2034.2 +062500 MOVE "DELETE " TO FEATURE. IX2034.2 +062600 MOVE "DELETE-TEST-GF-02" TO PAR-NAME IX2034.2 +062700 IF WRK-CS-09V00-008 NOT EQUAL TO 125 IX2034.2 +062800 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX2034.2 +062900 MOVE 125 TO CORRECT-18V0 IX2034.2 +063000 MOVE "DELETED RECORDS; IX-21; 4.3.2 " TO RE-MARK IX2034.2 +063100 PERFORM FAIL IX2034.2 +063200 ELSE IX2034.2 +063300 PERFORM PASS. IX2034.2 +063400 PERFORM PRINT-DETAIL. IX2034.2 +063500* IX2034.2 +063600* IX2034.2 +063700* IX2034.2 +063800 DELETE-TEST-GF-03. IX2034.2 +063900 MOVE "DELETE " TO FEATURE. IX2034.2 +064000 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2034.2 +064100 IF WRK-CS-09V00-009 EQUAL TO ZERO IX2034.2 +064200 PERFORM PASS IX2034.2 +064300 ELSE IX2034.2 +064400 PERFORM FAIL IX2034.2 +064500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +064600 MOVE ZERO TO CORRECT-18V0 IX2034.2 +064700 MOVE "INVALID KEY; IX-21; 4.3.2 " TO RE-MARK. IX2034.2 +064800 PERFORM PRINT-DETAIL. IX2034.2 +064900 CLOSE IX-FD1. IX2034.2 +065000* IX2034.2 +065100* IX2034.2 +065200* IX2034.2 +065300 DELETE-INIT-GF-04. IX2034.2 +065400 MOVE "DELETE-TEST-GF-04" TO PAR-NAME. IX2034.2 +065500 MOVE ZERO TO WRK-CS-09V00-006 IX2034.2 +065600 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +065700 MOVE ZERO TO WRK-CS-09V00-008 IX2034.2 +065800 MOVE ZERO TO WRK-CS-09V00-009 IX2034.2 +065900 MOVE ZERO TO WRK-CS-09V00-010 IX2034.2 +066000 MOVE ZERO TO WRK-CS-09V00-011 IX2034.2 +066100 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +066200 MOVE ZERO TO WRK-DU-09V00-001. IX2034.2 +066300 OPEN INPUT IX-FD1. IX2034.2 +066400 DELETE-TEST-GF-04-R. IX2034.2 +066500 ADD 1 TO WRK-CS-09V00-006. IX2034.2 +066600 ADD 1 TO WRK-CS-09V00-007. IX2034.2 +066700 ADD 1 TO WRK-CS-09V00-008. IX2034.2 +066800 READ IX-FD1 NEXT RECORD AT END GO TO DELETE-TEST-GF-04. IX2034.2 +066900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +067000 IF UPDATE-NUMBER (1) EQUAL TO 99 IX2034.2 +067100 ADD 1 TO WRK-CS-09V00-009. IX2034.2 +067200 IF WRK-CS-09V00-007 EQUAL TO 4 IX2034.2 +067300 MOVE 01 TO WRK-CS-09V00-007 IX2034.2 +067400 ADD 1 TO WRK-CS-09V00-008. IX2034.2 +067500 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX2034.2 +067600 MOVE WRK-CS-09V00-008 TO WRK-DU-09V00-001. IX2034.2 +067700 IF IX-WRK-KEY EQUAL TO IX-FD1-KEY IX2034.2 +067800 ADD 1 TO WRK-CS-09V00-010. IX2034.2 +067900 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 IX2034.2 +068000 ADD 1 TO WRK-CS-09V00-011. IX2034.2 +068100 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +068200 GO TO DELETE-TEST-GF-04. IX2034.2 +068300 GO TO DELETE-TEST-GF-04-R. IX2034.2 +068400 DELETE-TEST-GF-04. IX2034.2 +068500 IF WRK-CS-09V00-006 NOT EQUAL TO 376 IX2034.2 +068600 MOVE "IX-21; 4.3.2; INCORRECT RECORD COUNT" IX2034.2 +068700 TO RE-MARK IX2034.2 +068800 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +068900 MOVE 376 TO CORRECT-18V0 IX2034.2 +069000 PERFORM FAIL IX2034.2 +069100 ELSE IX2034.2 +069200 PERFORM PASS. IX2034.2 +069300 PERFORM PRINT-DETAIL. IX2034.2 +069400* IX2034.2 +069500 DELETE-TEST-GF-05. IX2034.2 +069600 MOVE "DELETE " TO FEATURE. IX2034.2 +069700 MOVE "DELETE-TEST-GF-05" TO PAR-NAME IX2034.2 +069800 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO IX2034.2 +069900 MOVE ZERO TO CORRECT-18V0 IX2034.2 +070000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +070100 MOVE "IX-21; 4.3.2; DELETED RECORDDS" TO RE-MARK IX2034.2 +070200 PERFORM FAIL IX2034.2 +070300 ELSE IX2034.2 +070400 PERFORM PASS. IX2034.2 +070500 PERFORM PRINT-DETAIL. IX2034.2 +070600* IX2034.2 +070700 DELETE-TEST-GF-06. IX2034.2 +070800 MOVE "DELETE " TO FEATURE. IX2034.2 +070900 MOVE "DELETE-TEST-GF-06" TO PAR-NAME IX2034.2 +071000 IF WRK-CS-09V00-010 NOT EQUAL TO 375 IX2034.2 +071100 MOVE 375 TO CORRECT-18V0 IX2034.2 +071200 MOVE "IX-21; 4.3.2; KEY MISMATCH" TO RE-MARK IX2034.2 +071300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX2034.2 +071400 PERFORM FAIL IX2034.2 +071500 ELSE IX2034.2 +071600 PERFORM PASS. IX2034.2 +071700 PERFORM PRINT-DETAIL. IX2034.2 +071800* IX2034.2 +071900 DELETE-TEST-GF-07. IX2034.2 +072000 MOVE "DELETE " TO FEATURE. IX2034.2 +072100 MOVE "DELETE-TEST-GF-07" TO PAR-NAME IX2034.2 +072200 IF WRK-CS-09V00-011 NOT EQUAL TO 375 IX2034.2 +072300 MOVE 375 TO CORRECT-18V0 IX2034.2 +072400 MOVE "INCORRECT RECORD FOUND; IX-21, 4.3.2" IX2034.2 +072500 TO RE-MARK IX2034.2 +072600 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 IX2034.2 +072700 PERFORM FAIL IX2034.2 +072800 ELSE IX2034.2 +072900 PERFORM PASS. IX2034.2 +073000 PERFORM PRINT-DETAIL. IX2034.2 +073100 CLOSE IX-FD1. IX2034.2 +073200 IX2034.2 +073300 IX2034.2 +073400 CCVS-999999. IX2034.2 +073500 GO TO CLOSE-FILES. IX2034.2 +*END-OF,IX203A +*HEADER,COBOL,IX204A +000100 IDENTIFICATION DIVISION. IX2044.2 +000200 PROGRAM-ID. IX2044.2 +000300 IX204A. IX2044.2 +000400**************************************************************** IX2044.2 +000500* * IX2044.2 +000600* VALIDATION FOR:- * IX2044.2 +000700* * IX2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +000900* * IX2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2044.2 +001100* * IX2044.2 +001200**************************************************************** IX2044.2 +001300*IX204A IX2044.2 +001400******************************************************************IX2044.2 +001500* IX2044.2 +001600* NEW TESTS: IX2044.2 +001700* CLOSE ... IX2044.2 +001800* IX2044.2 +001900* IX2044.2 +002000* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX2044.2 +002100* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX2044.2 +002200* IX2044.2 +002300* (1) FILE STATUS (ONLY 00 & 10) IX2044.2 +002400* (2) USE AFTER ERROR PROCEDURE ON FILE-NAME IX2044.2 +002500* (3) READ IX2044.2 +002600* (4) WRITE IX2044.2 +002700* (5) REWRITE IX2044.2 +002800* (6) RECORD KEY IX2044.2 +002900* (7) ACCESS IX2044.2 +003000* IX2044.2 +003100* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX2044.2 +003200* MODE DYMANIC) AND THEN UPDATES SELECTIVE RECORDS OF THE FILE.IX2044.2 +003300* THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR ACCURACYIX2044.2 +003400* FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT USED. THE IX2044.2 +003500* READ, WRITE AND REWRITE STATEMENTS ARE USED WITHOUT THE IX2044.2 +003600* APPROPRIATE AT END OR INVALID KEY PHRASES. THE OMISSION OF IX2044.2 +003700* THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE IX2044.2 +003800* HAS BEEN SPECIFIED. IX2044.2 +003900* IX2044.2 +004000* IX2044.2 +004100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2044.2 +004200* IX2044.2 +004300* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2044.2 +004400* CLAUSE FOR DATA FILE IX-FD2 IX2044.2 +004500* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2044.2 +004600* CLAUSE FOR INDEX FILE IX-FD2 IX2044.2 +004700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2044.2 +004800* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX2044.2 +004900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2044.2 +005000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2044.2 +005100* X-84 LABEL RECORDS FOR PRINT-FILEPUTER IX2044.2 +005200* IX2044.2 +005300* NOTE: X-CARDS 45, 62 AND 84 ARE OPTIONAL IX2044.2 +005400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2044.2 +005500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2044.2 +005600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2044.2 +005700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2044.2 +005800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2044.2 +005900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2044.2 +006000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2044.2 +006100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2044.2 +006200* THEY ARE AS FOLLOWS IX2044.2 +006300* IX2044.2 +006400* P SELECTS X-CARDS 62 IX2044.2 +006500* J SELECTS X-CARD 45 IX2044.2 +006600* C SELECTS X-CARD 84 IX2044.2 +006700* IX2044.2 +006800****************************************************** IX2044.2 +006900 ENVIRONMENT DIVISION. IX2044.2 +007000 CONFIGURATION SECTION. IX2044.2 +007100 SOURCE-COMPUTER. IX2044.2 +007200 XXXXX082. IX2044.2 +007300 OBJECT-COMPUTER. IX2044.2 +007400 XXXXX083. IX2044.2 +007500 INPUT-OUTPUT SECTION. IX2044.2 +007600 FILE-CONTROL. IX2044.2 +007700P SELECT RAW-DATA ASSIGN TO IX2044.2 +007800P XXXXX062 IX2044.2 +007900P ORGANIZATION IS INDEXED IX2044.2 +008000P ACCESS MODE IS RANDOM IX2044.2 +008100P RECORD KEY IS RAW-DATA-KEY. IX2044.2 +008200 SELECT PRINT-FILE ASSIGN TO IX2044.2 +008300 XXXXX055. IX2044.2 +008400 SELECT IX-FD2 ASSIGN IX2044.2 +008500 XXXXX025 IX2044.2 +008600J XXXXX045 IX2044.2 +008700 ORGANIZATION IS INDEXED IX2044.2 +008800 ACCESS DYNAMIC IX2044.2 +008900 FILE STATUS IS IX-FD2-STATUS IX2044.2 +009000 RECORD IX-FD2-KEY. IX2044.2 +009100 DATA DIVISION. IX2044.2 +009200 FILE SECTION. IX2044.2 +009300P IX2044.2 +009400PFD RAW-DATA. IX2044.2 +009500P IX2044.2 +009600P01 RAW-DATA-SATZ. IX2044.2 +009700P 05 RAW-DATA-KEY PIC X(6). IX2044.2 +009800P 05 C-DATE PIC 9(6). IX2044.2 +009900P 05 C-TIME PIC 9(8). IX2044.2 +010000P 05 C-NO-OF-TESTS PIC 99. IX2044.2 +010100P 05 C-OK PIC 999. IX2044.2 +010200P 05 C-ALL PIC 999. IX2044.2 +010300P 05 C-FAIL PIC 999. IX2044.2 +010400P 05 C-DELETED PIC 999. IX2044.2 +010500P 05 C-INSPECT PIC 999. IX2044.2 +010600P 05 C-NOTE PIC X(13). IX2044.2 +010700P 05 C-INDENT PIC X. IX2044.2 +010800P 05 C-ABORT PIC X(8). IX2044.2 +010900 FD PRINT-FILE. IX2044.2 +011000 01 PRINT-REC PICTURE X(120). IX2044.2 +011100 01 DUMMY-RECORD PICTURE X(120). IX2044.2 +011200 FD IX-FD2 IX2044.2 +011300C LABEL RECORDS ARE STANDARD IX2044.2 +011400C DATA RECORDS IX-FD2R1-F-G-240 IX2044.2 +011500 BLOCK CONTAINS 480 IX2044.2 +011600 RECORD CONTAINS 240 CHARACTERS. IX2044.2 +011700 01 IX-FD2R1-F-G-240. IX2044.2 +011800 05 IX-FD2-REC-120 PIC X(120). IX2044.2 +011900 05 IX-FD2-REC-120-240. IX2044.2 +012000 10 FILLER PICTURE X(8). IX2044.2 +012100 10 IX-FD2-KEY PIC X(29). IX2044.2 +012200 10 FILLER PIC X(83). IX2044.2 +012300 WORKING-STORAGE SECTION. IX2044.2 +012400 01 GRP-0101. IX2044.2 +012500 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX2044.2 +012600 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2044.2 +012700 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX2044.2 +012800 01 GRP-0001. IX2044.2 +012900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013600 05 IX-FD2-STATUS PIC XX VALUE SPACE. IX2044.2 +013700 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX2044.2 +013800 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX2044.2 +013900 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX2044.2 +014000 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX2044.2 +014100 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX2044.2 +014200 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX2044.2 +014300 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX2044.2 +014400 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX2044.2 +014500 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX2044.2 +014600 01 DUMMY-WRK-REC. IX2044.2 +014700 02 DUMMY-WRK1 PIC X(120). IX2044.2 +014800 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2044.2 +014900 03 FILLER PIC X(5). IX2044.2 +015000 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2044.2 +015100 01 FILE-RECORD-INFORMATION-REC. IX2044.2 +015200 03 FILE-RECORD-INFO-SKELETON. IX2044.2 +015300 05 FILLER PICTURE X(48) VALUE IX2044.2 +015400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2044.2 +015500 05 FILLER PICTURE X(46) VALUE IX2044.2 +015600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2044.2 +015700 05 FILLER PICTURE X(26) VALUE IX2044.2 +015800 ",LFIL=000000,ORG= ,LBLR= ". IX2044.2 +015900 05 FILLER PICTURE X(37) VALUE IX2044.2 +016000 ",RECKEY= ". IX2044.2 +016100 05 FILLER PICTURE X(38) VALUE IX2044.2 +016200 ",ALTKEY1= ". IX2044.2 +016300 05 FILLER PICTURE X(38) VALUE IX2044.2 +016400 ",ALTKEY2= ". IX2044.2 +016500 05 FILLER PICTURE X(7) VALUE SPACE.IX2044.2 +016600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2044.2 +016700 05 FILE-RECORD-INFO-P1-120. IX2044.2 +016800 07 FILLER PIC X(5). IX2044.2 +016900 07 XFILE-NAME PIC X(6). IX2044.2 +017000 07 FILLER PIC X(8). IX2044.2 +017100 07 XRECORD-NAME PIC X(6). IX2044.2 +017200 07 FILLER PIC X(1). IX2044.2 +017300 07 REELUNIT-NUMBER PIC 9(1). IX2044.2 +017400 07 FILLER PIC X(7). IX2044.2 +017500 07 XRECORD-NUMBER PIC 9(6). IX2044.2 +017600 07 FILLER PIC X(6). IX2044.2 +017700 07 UPDATE-NUMBER PIC 9(2). IX2044.2 +017800 07 FILLER PIC X(5). IX2044.2 +017900 07 ODO-NUMBER PIC 9(4). IX2044.2 +018000 07 FILLER PIC X(5). IX2044.2 +018100 07 XPROGRAM-NAME PIC X(5). IX2044.2 +018200 07 FILLER PIC X(7). IX2044.2 +018300 07 XRECORD-LENGTH PIC 9(6). IX2044.2 +018400 07 FILLER PIC X(7). IX2044.2 +018500 07 CHARS-OR-RECORDS PIC X(2). IX2044.2 +018600 07 FILLER PIC X(1). IX2044.2 +018700 07 XBLOCK-SIZE PIC 9(4). IX2044.2 +018800 07 FILLER PIC X(6). IX2044.2 +018900 07 RECORDS-IN-FILE PIC 9(6). IX2044.2 +019000 07 FILLER PIC X(5). IX2044.2 +019100 07 XFILE-ORGANIZATION PIC X(2). IX2044.2 +019200 07 FILLER PIC X(6). IX2044.2 +019300 07 XLABEL-TYPE PIC X(1). IX2044.2 +019400 05 FILE-RECORD-INFO-P121-240. IX2044.2 +019500 07 FILLER PIC X(8). IX2044.2 +019600 07 XRECORD-KEY PIC X(29). IX2044.2 +019700 07 FILLER PIC X(9). IX2044.2 +019800 07 ALTERNATE-KEY1 PIC X(29). IX2044.2 +019900 07 FILLER PIC X(9). IX2044.2 +020000 07 ALTERNATE-KEY2 PIC X(29). IX2044.2 +020100 07 FILLER PIC X(7). IX2044.2 +020200 01 TEST-RESULTS. IX2044.2 +020300 02 FILLER PIC X VALUE SPACE. IX2044.2 +020400 02 FEATURE PIC X(20) VALUE SPACE. IX2044.2 +020500 02 FILLER PIC X VALUE SPACE. IX2044.2 +020600 02 P-OR-F PIC X(5) VALUE SPACE. IX2044.2 +020700 02 FILLER PIC X VALUE SPACE. IX2044.2 +020800 02 PAR-NAME. IX2044.2 +020900 03 FILLER PIC X(19) VALUE SPACE. IX2044.2 +021000 03 PARDOT-X PIC X VALUE SPACE. IX2044.2 +021100 03 DOTVALUE PIC 99 VALUE ZERO. IX2044.2 +021200 02 FILLER PIC X(8) VALUE SPACE. IX2044.2 +021300 02 RE-MARK PIC X(61). IX2044.2 +021400 01 TEST-COMPUTED. IX2044.2 +021500 02 FILLER PIC X(30) VALUE SPACE. IX2044.2 +021600 02 FILLER PIC X(17) VALUE IX2044.2 +021700 " COMPUTED=". IX2044.2 +021800 02 COMPUTED-X. IX2044.2 +021900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2044.2 +022000 03 COMPUTED-N REDEFINES COMPUTED-A IX2044.2 +022100 PIC -9(9).9(9). IX2044.2 +022200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2044.2 +022300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2044.2 +022400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2044.2 +022500 03 CM-18V0 REDEFINES COMPUTED-A. IX2044.2 +022600 04 COMPUTED-18V0 PIC -9(18). IX2044.2 +022700 04 FILLER PIC X. IX2044.2 +022800 03 FILLER PIC X(50) VALUE SPACE. IX2044.2 +022900 01 TEST-CORRECT. IX2044.2 +023000 02 FILLER PIC X(30) VALUE SPACE. IX2044.2 +023100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2044.2 +023200 02 CORRECT-X. IX2044.2 +023300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2044.2 +023400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2044.2 +023500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2044.2 +023600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2044.2 +023700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2044.2 +023800 03 CR-18V0 REDEFINES CORRECT-A. IX2044.2 +023900 04 CORRECT-18V0 PIC -9(18). IX2044.2 +024000 04 FILLER PIC X. IX2044.2 +024100 03 FILLER PIC X(2) VALUE SPACE. IX2044.2 +024200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2044.2 +024300 01 CCVS-C-1. IX2044.2 +024400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2044.2 +024500- "SS PARAGRAPH-NAME IX2044.2 +024600- " REMARKS". IX2044.2 +024700 02 FILLER PIC X(20) VALUE SPACE. IX2044.2 +024800 01 CCVS-C-2. IX2044.2 +024900 02 FILLER PIC X VALUE SPACE. IX2044.2 +025000 02 FILLER PIC X(6) VALUE "TESTED". IX2044.2 +025100 02 FILLER PIC X(15) VALUE SPACE. IX2044.2 +025200 02 FILLER PIC X(4) VALUE "FAIL". IX2044.2 +025300 02 FILLER PIC X(94) VALUE SPACE. IX2044.2 +025400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2044.2 +025500 01 REC-CT PIC 99 VALUE ZERO. IX2044.2 +025600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2044.2 +026000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2044.2 +026100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2044.2 +026200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2044.2 +026300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2044.2 +026400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2044.2 +026500 01 CCVS-H-1. IX2044.2 +026600 02 FILLER PIC X(39) VALUE SPACES. IX2044.2 +026700 02 FILLER PIC X(42) VALUE IX2044.2 +026800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2044.2 +026900 02 FILLER PIC X(39) VALUE SPACES. IX2044.2 +027000 01 CCVS-H-2A. IX2044.2 +027100 02 FILLER PIC X(40) VALUE SPACE. IX2044.2 +027200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2044.2 +027300 02 FILLER PIC XXXX VALUE IX2044.2 +027400 "4.2 ". IX2044.2 +027500 02 FILLER PIC X(28) VALUE IX2044.2 +027600 " COPY - NOT FOR DISTRIBUTION". IX2044.2 +027700 02 FILLER PIC X(41) VALUE SPACE. IX2044.2 +027800 IX2044.2 +027900 01 CCVS-H-2B. IX2044.2 +028000 02 FILLER PIC X(15) VALUE IX2044.2 +028100 "TEST RESULT OF ". IX2044.2 +028200 02 TEST-ID PIC X(9). IX2044.2 +028300 02 FILLER PIC X(4) VALUE IX2044.2 +028400 " IN ". IX2044.2 +028500 02 FILLER PIC X(12) VALUE IX2044.2 +028600 " HIGH ". IX2044.2 +028700 02 FILLER PIC X(22) VALUE IX2044.2 +028800 " LEVEL VALIDATION FOR ". IX2044.2 +028900 02 FILLER PIC X(58) VALUE IX2044.2 +029000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +029100 01 CCVS-H-3. IX2044.2 +029200 02 FILLER PIC X(34) VALUE IX2044.2 +029300 " FOR OFFICIAL USE ONLY ". IX2044.2 +029400 02 FILLER PIC X(58) VALUE IX2044.2 +029500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2044.2 +029600 02 FILLER PIC X(28) VALUE IX2044.2 +029700 " COPYRIGHT 1985 ". IX2044.2 +029800 01 CCVS-E-1. IX2044.2 +029900 02 FILLER PIC X(52) VALUE SPACE. IX2044.2 +030000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2044.2 +030100 02 ID-AGAIN PIC X(9). IX2044.2 +030200 02 FILLER PIC X(45) VALUE SPACES. IX2044.2 +030300 01 CCVS-E-2. IX2044.2 +030400 02 FILLER PIC X(31) VALUE SPACE. IX2044.2 +030500 02 FILLER PIC X(21) VALUE SPACE. IX2044.2 +030600 02 CCVS-E-2-2. IX2044.2 +030700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2044.2 +030800 03 FILLER PIC X VALUE SPACE. IX2044.2 +030900 03 ENDER-DESC PIC X(44) VALUE IX2044.2 +031000 "ERRORS ENCOUNTERED". IX2044.2 +031100 01 CCVS-E-3. IX2044.2 +031200 02 FILLER PIC X(22) VALUE IX2044.2 +031300 " FOR OFFICIAL USE ONLY". IX2044.2 +031400 02 FILLER PIC X(12) VALUE SPACE. IX2044.2 +031500 02 FILLER PIC X(58) VALUE IX2044.2 +031600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +031700 02 FILLER PIC X(13) VALUE SPACE. IX2044.2 +031800 02 FILLER PIC X(15) VALUE IX2044.2 +031900 " COPYRIGHT 1985". IX2044.2 +032000 01 CCVS-E-4. IX2044.2 +032100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2044.2 +032200 02 FILLER PIC X(4) VALUE " OF ". IX2044.2 +032300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2044.2 +032400 02 FILLER PIC X(40) VALUE IX2044.2 +032500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2044.2 +032600 01 XXINFO. IX2044.2 +032700 02 FILLER PIC X(19) VALUE IX2044.2 +032800 "*** INFORMATION ***". IX2044.2 +032900 02 INFO-TEXT. IX2044.2 +033000 04 FILLER PIC X(8) VALUE SPACE. IX2044.2 +033100 04 XXCOMPUTED PIC X(20). IX2044.2 +033200 04 FILLER PIC X(5) VALUE SPACE. IX2044.2 +033300 04 XXCORRECT PIC X(20). IX2044.2 +033400 02 INF-ANSI-REFERENCE PIC X(48). IX2044.2 +033500 01 HYPHEN-LINE. IX2044.2 +033600 02 FILLER PIC IS X VALUE IS SPACE. IX2044.2 +033700 02 FILLER PIC IS X(65) VALUE IS "************************IX2044.2 +033800- "*****************************************". IX2044.2 +033900 02 FILLER PIC IS X(54) VALUE IS "************************IX2044.2 +034000- "******************************". IX2044.2 +034100 01 CCVS-PGM-ID PIC X(9) VALUE IX2044.2 +034200 "IX204A". IX2044.2 +034300 PROCEDURE DIVISION. IX2044.2 +034400 DECLARATIVES. IX2044.2 +034500 IX-FD2-01 SECTION. IX2044.2 +034600 USE AFTER STANDARD ERROR PROCEDURE ON IX-FD2. IX2044.2 +034700 IX-FD2-01-01. IX2044.2 +034800 ADD 1 TO WRK-CS-09V00-013. IX2044.2 +034900 GO TO IX-FD2-01-03 IX2044.2 +035000 IX-FD2-01-05 IX2044.2 +035100 DEPENDING ON WRK-CS-09V00-012. IX2044.2 +035200 GO TO IX-FD2-01-EXIT. IX2044.2 +035300 IX-FD2-01-03. IX2044.2 +035400*ENTRY FROM SEGMENT INX-TEST-001. IX2044.2 +035500* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX2044.2 +035600 ADD 1 TO WRK-CS-09V00-014. IX2044.2 +035700 IX-FD2-01-05. IX2044.2 +035800 ADD 1 TO WRK-CS-09V00-017. IX2044.2 +035900 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2044.2 +036000 MOVE IX-FD2-STATUS TO WRK-XN-0002-002 IX2044.2 +036100 MOVE "10" TO WRK-XN-0002-003. IX2044.2 +036200 IX-FD2-01-EXIT. IX2044.2 +036300 EXIT. IX2044.2 +036400 END DECLARATIVES. IX2044.2 +036500 CCVS1 SECTION. IX2044.2 +036600 OPEN-FILES. IX2044.2 +036700P OPEN I-O RAW-DATA. IX2044.2 +036800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2044.2 +036900P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2044.2 +037000P MOVE "ABORTED " TO C-ABORT. IX2044.2 +037100P ADD 1 TO C-NO-OF-TESTS. IX2044.2 +037200P ACCEPT C-DATE FROM DATE. IX2044.2 +037300P ACCEPT C-TIME FROM TIME. IX2044.2 +037400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2044.2 +037500PEND-E-1. IX2044.2 +037600P CLOSE RAW-DATA. IX2044.2 +037700 OPEN OUTPUT PRINT-FILE. IX2044.2 +037800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2044.2 +037900 MOVE SPACE TO TEST-RESULTS. IX2044.2 +038000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2044.2 +038100 MOVE ZERO TO REC-SKL-SUB. IX2044.2 +038200 PERFORM CCVS-INIT-FILE 9 TIMES. IX2044.2 +038300 CCVS-INIT-FILE. IX2044.2 +038400 ADD 1 TO REC-SKL-SUB. IX2044.2 +038500 MOVE FILE-RECORD-INFO-SKELETON IX2044.2 +038600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2044.2 +038700 CCVS-INIT-EXIT. IX2044.2 +038800 GO TO CCVS1-EXIT. IX2044.2 +038900 CLOSE-FILES. IX2044.2 +039000P OPEN I-O RAW-DATA. IX2044.2 +039100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2044.2 +039200P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2044.2 +039300P MOVE "OK. " TO C-ABORT. IX2044.2 +039400P MOVE PASS-COUNTER TO C-OK. IX2044.2 +039500P MOVE ERROR-HOLD TO C-ALL. IX2044.2 +039600P MOVE ERROR-COUNTER TO C-FAIL. IX2044.2 +039700P MOVE DELETE-COUNTER TO C-DELETED. IX2044.2 +039800P MOVE INSPECT-COUNTER TO C-INSPECT. IX2044.2 +039900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2044.2 +040000PEND-E-2. IX2044.2 +040100P CLOSE RAW-DATA. IX2044.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2044.2 +040300 TERMINATE-CCVS. IX2044.2 +040400S EXIT PROGRAM. IX2044.2 +040500STERMINATE-CALL. IX2044.2 +040600 STOP RUN. IX2044.2 +040700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2044.2 +040800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2044.2 +040900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2044.2 +041000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2044.2 +041100 MOVE "****TEST DELETED****" TO RE-MARK. IX2044.2 +041200 PRINT-DETAIL. IX2044.2 +041300 IF REC-CT NOT EQUAL TO ZERO IX2044.2 +041400 MOVE "." TO PARDOT-X IX2044.2 +041500 MOVE REC-CT TO DOTVALUE. IX2044.2 +041600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2044.2 +041700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2044.2 +041800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2044.2 +041900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2044.2 +042000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2044.2 +042100 MOVE SPACE TO CORRECT-X. IX2044.2 +042200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2044.2 +042300 MOVE SPACE TO RE-MARK. IX2044.2 +042400 HEAD-ROUTINE. IX2044.2 +042500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +042600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +042700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2044.2 +042800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2044.2 +042900 COLUMN-NAMES-ROUTINE. IX2044.2 +043000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +043100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +043200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +043300 END-ROUTINE. IX2044.2 +043400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2044.2 +043500 END-RTN-EXIT. IX2044.2 +043600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +043700 END-ROUTINE-1. IX2044.2 +043800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2044.2 +043900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2044.2 +044000 ADD PASS-COUNTER TO ERROR-HOLD. IX2044.2 +044100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2044.2 +044200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2044.2 +044300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2044.2 +044400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2044.2 +044500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2044.2 +044600 END-ROUTINE-12. IX2044.2 +044700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2044.2 +044800 IF ERROR-COUNTER IS EQUAL TO ZERO IX2044.2 +044900 MOVE "NO " TO ERROR-TOTAL IX2044.2 +045000 ELSE IX2044.2 +045100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2044.2 +045200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2044.2 +045300 PERFORM WRITE-LINE. IX2044.2 +045400 END-ROUTINE-13. IX2044.2 +045500 IF DELETE-COUNTER IS EQUAL TO ZERO IX2044.2 +045600 MOVE "NO " TO ERROR-TOTAL ELSE IX2044.2 +045700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2044.2 +045800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2044.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046000 IF INSPECT-COUNTER EQUAL TO ZERO IX2044.2 +046100 MOVE "NO " TO ERROR-TOTAL IX2044.2 +046200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2044.2 +046300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2044.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046600 WRITE-LINE. IX2044.2 +046700 ADD 1 TO RECORD-COUNT. IX2044.2 +046800Y IF RECORD-COUNT GREATER 42 IX2044.2 +046900Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2044.2 +047000Y MOVE SPACE TO DUMMY-RECORD IX2044.2 +047100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2044.2 +047200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2044.2 +047300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2044.2 +047400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2044.2 +047500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2044.2 +047600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047900Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2044.2 +048000Y MOVE ZERO TO RECORD-COUNT. IX2044.2 +048100 PERFORM WRT-LN. IX2044.2 +048200 WRT-LN. IX2044.2 +048300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2044.2 +048400 MOVE SPACE TO DUMMY-RECORD. IX2044.2 +048500 BLANK-LINE-PRINT. IX2044.2 +048600 PERFORM WRT-LN. IX2044.2 +048700 FAIL-ROUTINE. IX2044.2 +048800 IF COMPUTED-X NOT EQUAL TO SPACE IX2044.2 +048900 GO TO FAIL-ROUTINE-WRITE. IX2044.2 +049000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2044.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2044.2 +049200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2044.2 +049300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +049400 MOVE SPACES TO INF-ANSI-REFERENCE. IX2044.2 +049500 GO TO FAIL-ROUTINE-EX. IX2044.2 +049600 FAIL-ROUTINE-WRITE. IX2044.2 +049700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2044.2 +049800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2044.2 +049900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2044.2 +050000 MOVE SPACES TO COR-ANSI-REFERENCE. IX2044.2 +050100 FAIL-ROUTINE-EX. EXIT. IX2044.2 +050200 BAIL-OUT. IX2044.2 +050300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2044.2 +050400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2044.2 +050500 BAIL-OUT-WRITE. IX2044.2 +050600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2044.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2044.2 +050800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. IX2044.2 +051000 BAIL-OUT-EX. EXIT. IX2044.2 +051100 CCVS1-EXIT. IX2044.2 +051200 EXIT. IX2044.2 +051300 SECT-IX-04-001 SECTION. IX2044.2 +051400 WRITE-INIT-GF-01. IX2044.2 +051500 MOVE "CREATE IX-FD2" TO FEATURE IX2044.2 +051600 MOVE "WRITE-TEST-001" TO PAR-NAME. IX2044.2 +051700 MOVE "IX-FD2" TO XFILE-NAME (2). IX2044.2 +051800 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2044.2 +051900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2044.2 +052000 MOVE 000240 TO XRECORD-LENGTH (2). IX2044.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2044.2 +052200 MOVE 0001 TO XBLOCK-SIZE (2). IX2044.2 +052300 MOVE 000500 TO RECORDS-IN-FILE (2). IX2044.2 +052400 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2044.2 +052500 MOVE "S" TO XLABEL-TYPE (2). IX2044.2 +052600 MOVE 000001 TO XRECORD-NUMBER (2). IX2044.2 +052700*INITIALIZE RECORD WORK AREA NUMBER 2. IX2044.2 +052800 MOVE 1 TO WRK-CS-09V00-012. IX2044.2 +052900 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX2044.2 +053000 WRK-CS-09V00-015 WRK-CS-09V00-016 IX2044.2 +053100 WRK-CS-09V00-017 WRK-CS-09V00-018. IX2044.2 +053200 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +053300 MOVE ZERO TO WRK-DU-09V00-001. IX2044.2 +053400 OPEN OUTPUT IX-FD2. IX2044.2 +053500 MOVE GRP-0101 TO IX-FD2-KEY. IX2044.2 +053600 MOVE IX-FD2-STATUS TO WRK-XN-0002-001. IX2044.2 +053700*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX2044.2 +053800 WRITE-TEST-GF-01-R. IX2044.2 +053900 MOVE "99" TO IX-FD2-STATUS. IX2044.2 +054000 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX2044.2 +054100 MOVE GRP-0101 TO XRECORD-KEY (2). IX2044.2 +054200 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX2044.2 +054300 WRITE IX-FD2R1-F-G-240. IX2044.2 +054400 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +054500 ADD 1 TO WRK-CS-09V00-016. IX2044.2 +054600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2044.2 +054700 GO TO WRITE-TEST-GF-01. IX2044.2 +054800 ADD 01 TO XRECORD-NUMBER (2). IX2044.2 +054900 GO TO WRITE-TEST-GF-01-R. IX2044.2 +055000 WRITE-TEST-GF-01. IX2044.2 +055100 MOVE "WRITE IX-FD2." TO FEATURE. IX2044.2 +055200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2044.2 +055300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX2044.2 +055400 MOVE "EXCEPTIONS/ERRORS; IX-41 4.9.2" TO RE-MARK IX2044.2 +055500 MOVE ZERO TO CORRECT-18V0 IX2044.2 +055600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2044.2 +055700 PERFORM FAIL IX2044.2 +055800 ELSE IX2044.2 +055900 PERFORM PASS. IX2044.2 +056000 PERFORM PRINT-DETAIL. IX2044.2 +056100 WRITE-TEST-GF-02. IX2044.2 +056200 MOVE "WRITE IX-FD2." TO FEATURE. IX2044.2 +056300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2044.2 +056400 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX2044.2 +056500 MOVE "INCORRECT COUNT; IX-41 4.9.2" TO RE-MARK IX2044.2 +056600 MOVE 500 TO CORRECT-18V0 IX2044.2 +056700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX2044.2 +056800 PERFORM FAIL IX2044.2 +056900 ELSE IX2044.2 +057000 PERFORM PASS. IX2044.2 +057100 PERFORM PRINT-DETAIL. IX2044.2 +057200 WRITE-TEST-GF-03. IX2044.2 +057300 MOVE "OPEN OUTPUT 00" TO FEATURE. IX2044.2 +057400 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2044.2 +057500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2044.2 +057600 MOVE "STATUS/OPEN; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +057700 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2044.2 +057800 MOVE "00" TO CORRECT-A IX2044.2 +057900 PERFORM FAIL IX2044.2 +058000 ELSE IX2044.2 +058100 PERFORM PASS. IX2044.2 +058200 PERFORM PRINT-DETAIL. IX2044.2 +058300 WRITE-TEST-GF-04. IX2044.2 +058400 MOVE "WRITE STATUS 00" TO FEATURE. IX2044.2 +058500 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX2044.2 +058600 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +058700 MOVE "STATUS/WRITE; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +058800 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +058900 MOVE "00" TO CORRECT-A IX2044.2 +059000 PERFORM FAIL IX2044.2 +059100 ELSE IX2044.2 +059200 PERFORM PASS. IX2044.2 +059300 PERFORM PRINT-DETAIL. IX2044.2 +059400 WRITE-TEST-GF-05. IX2044.2 +059500 MOVE "WRITE STATUS 00" TO FEATURE. IX2044.2 +059600 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX2044.2 +059700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX2044.2 +059800 MOVE "STATUS/WRITE; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +059900 MOVE ZERO TO CORRECT-18V0 IX2044.2 +060000 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX2044.2 +060100 PERFORM FAIL IX2044.2 +060200 ELSE IX2044.2 +060300 PERFORM PASS. IX2044.2 +060400 PERFORM PRINT-DETAIL. IX2044.2 +060500 WRITE-TEST-GF-06. IX2044.2 +060600 MOVE "CLOSE: STATUS: 00" TO FEATURE. IX2044.2 +060700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX2044.2 +060800 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +060900 CLOSE IX-FD2. IX2044.2 +061000 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +061100 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +061200 MOVE IX-FD2-STATUS TO COMPUTED-18V0 IX2044.2 +061300 MOVE "00" TO CORRECT-A IX2044.2 +061400 PERFORM FAIL IX2044.2 +061500 ELSE IX2044.2 +061600 PERFORM PASS. IX2044.2 +061700 PERFORM PRINT-DETAIL. IX2044.2 +061800 RWRT-INIT-GF-01. IX2044.2 +061900 MOVE 2 TO WRK-CS-09V00-012. IX2044.2 +062000 MOVE ZERO TO WRK-CS-09V00-013. IX2044.2 +062100 MOVE ZERO TO WRK-CS-09V00-014. IX2044.2 +062200 MOVE ZERO TO WRK-CS-09V00-015. IX2044.2 +062300 MOVE ZERO TO WRK-CS-09V00-016. IX2044.2 +062400 MOVE ZERO TO WRK-CS-09V00-017. IX2044.2 +062500 MOVE ZERO TO WRK-CS-09V00-018. IX2044.2 +062600 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +062700 OPEN I-O IX-FD2. IX2044.2 +062800 MOVE SPACE TO WRK-XN-0002-002 IX2044.2 +062900 MOVE SPACE TO WRK-XN-0002-003 IX2044.2 +063000 MOVE SPACE TO WRK-XN-0002-004 IX2044.2 +063100 MOVE IX-FD2-STATUS TO WRK-XN-0002-001 IX2044.2 +063200 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +063300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX2044.2 +063400 RWRT-TEST-GF-01-R. IX2044.2 +063500 ADD 1 TO WRK-CS-09V00-014. IX2044.2 +063600 ADD 1 TO WRK-CS-09V00-015. IX2044.2 +063700 READ IX-FD2 NEXT RECORD. IX2044.2 +063800 IF IX-FD2-STATUS EQUAL TO "10" IX2044.2 +063900 GO TO RWRT-TEST-GF-01. IX2044.2 +064000 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2044.2 +064100 IF WRK-CS-09V00-015 EQUAL TO 5 IX2044.2 +064200 ADD 01 TO UPDATE-NUMBER (2) IX2044.2 +064300 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240 IX2044.2 +064400 PERFORM RWRT-010-UPDATE IX2044.2 +064500 MOVE ZERO TO WRK-CS-09V00-015 IX2044.2 +064600 GO TO RWRT-TEST-GF-01-2. IX2044.2 +064700 IF WRK-CS-09V00-014 GREATER 500 IX2044.2 +064800 GO TO RWRT-TEST-GF-01. IX2044.2 +064900 GO TO RWRT-TEST-GF-01-R. IX2044.2 +065000 RWRT-010-UPDATE. IX2044.2 +065100 REWRITE IX-FD2R1-F-G-240. IX2044.2 +065200 RWRT-TEST-GF-01-2. IX2044.2 +065300 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +065400 ADD 1 TO WRK-CS-09V00-016. IX2044.2 +065500 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +065600 GO TO RWRT-TEST-GF-01-R. IX2044.2 +065700 RWRT-TEST-GF-01. IX2044.2 +065800 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2044.2 +065900 MOVE "REWRITE IX-FD2" TO FEATURE. IX2044.2 +066000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX2044.2 +066100 MOVE "EXCEPTIONS/ERRORS; IX-33 4.6.2" TO RE-MARK IX2044.2 +066200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX2044.2 +066300 MOVE 1 TO CORRECT-18V0 IX2044.2 +066400 PERFORM FAIL IX2044.2 +066500 ELSE IX2044.2 +066600 PERFORM PASS. IX2044.2 +066700 PERFORM PRINT-DETAIL. IX2044.2 +066800 RWRT-TEST-GF-02. IX2044.2 +066900 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. IX2044.2 +067000 MOVE "UPDATE IX-FD2" TO FEATURE. IX2044.2 +067100 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX2044.2 +067200 MOVE "INCORRECT COUNT; IX-33 4.6.2" TO RE-MARK IX2044.2 +067300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2044.2 +067400 MOVE 501 TO CORRECT-18V0 IX2044.2 +067500 PERFORM FAIL IX2044.2 +067600 ELSE IX2044.2 +067700 PERFORM PASS. IX2044.2 +067800 PERFORM PRINT-DETAIL. IX2044.2 +067900 RWRT-TEST-GF-03. IX2044.2 +068000 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. IX2044.2 +068100 MOVE "OPEN I-O STATUS: 00" TO FEATURE. IX2044.2 +068200 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2044.2 +068300 MOVE "OPEN/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +068400 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2044.2 +068500 MOVE "00" TO CORRECT-A IX2044.2 +068600 PERFORM FAIL IX2044.2 +068700 ELSE IX2044.2 +068800 PERFORM PASS. IX2044.2 +068900 PERFORM PRINT-DETAIL. IX2044.2 +069000 RWRT-TEST-GF-04. IX2044.2 +069100 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. IX2044.2 +069200 MOVE "READ I-O STATUS 10" TO FEATURE. IX2044.2 +069300 IF IX-FD2-STATUS NOT EQUAL TO "10" IX2044.2 +069400 MOVE "AT END/STATUS; IX-4 1.3.4 (2) A" TO RE-MARK IX2044.2 +069500 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +069600 MOVE "10" TO CORRECT-A IX2044.2 +069700 PERFORM FAIL IX2044.2 +069800 ELSE IX2044.2 +069900 PERFORM PASS. IX2044.2 +070000 PERFORM PRINT-DETAIL. IX2044.2 +070100 RWRT-TEST-GF-05. IX2044.2 +070200 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. IX2044.2 +070300 MOVE "UPDATE IX-FD2" TO FEATURE. IX2044.2 +070400 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX2044.2 +070500 MOVE "EXCEPTIN/STATUS; IX-4 1.3.4 (2) A" TO RE-MARKIX2044.2 +070600 MOVE WRK-XN-0002-002 TO COMPUTED-A IX2044.2 +070700 MOVE "10" TO CORRECT-A IX2044.2 +070800 PERFORM FAIL IX2044.2 +070900 ELSE IX2044.2 +071000 PERFORM PASS. IX2044.2 +071100 PERFORM PRINT-DETAIL. IX2044.2 +071200 RWRT-TEST-GF-06. IX2044.2 +071300 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. IX2044.2 +071400 MOVE "STATUS: 10 " TO FEATURE. IX2044.2 +071500 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX2044.2 +071600 MOVE "NO/EXCEPTION; IX-4 1.3.4 (2) A" TO RE-MARK IX2044.2 +071700 MOVE WRK-XN-0002-003 TO COMPUTED-A IX2044.2 +071800 MOVE "10" TO CORRECT-A IX2044.2 +071900 PERFORM FAIL IX2044.2 +072000 ELSE IX2044.2 +072100 PERFORM PASS. IX2044.2 +072200 PERFORM PRINT-DETAIL. IX2044.2 +072300 RWRT-TEST-GF-07. IX2044.2 +072400 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. IX2044.2 +072500 MOVE "CLOSE . LOCK: 00" TO FEATURE. IX2044.2 +072600 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +072700 CLOSE IX-FD2 WITH LOCK. IX2044.2 +072800 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +072900 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +073000 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +073100 MOVE "00" TO CORRECT-A IX2044.2 +073200 PERFORM FAIL IX2044.2 +073300 ELSE IX2044.2 +073400 PERFORM PASS. IX2044.2 +073500 PERFORM PRINT-DETAIL. IX2044.2 +073600 IX2044.2 +073700 CCVS-EXIT SECTION. IX2044.2 +073800 CCVS-999999. IX2044.2 +073900 GO TO CLOSE-FILES. IX2044.2 +*END-OF,IX204A +*HEADER,COBOL,IX205A +000100 IDENTIFICATION DIVISION. IX2054.2 +000200 PROGRAM-ID. IX2054.2 +000300 IX205A. IX2054.2 +000400**************************************************************** IX2054.2 +000500* * IX2054.2 +000600* VALIDATION FOR:- * IX2054.2 +000700* * IX2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +000900* * IX2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2054.2 +001100* * IX2054.2 +001200**************************************************************** IX2054.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE IX2054.2 +001400* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2054.2 +001500* LEVEL 2 OF INDEXED I-O. THE ELEMENTS TESTED IN THIS ROU- IX2054.2 +001600* TINE ARE: IX2054.2 +001700* IX2054.2 +001800* (1) ACCESS MODE DYNAMIC; IX2054.2 +001900* (2) ALTERNATE RECORD KEY WITHOUT THE DUPLICATES OPTION; IX2054.2 +002000* (3) RESERVE CLAUSE; IX2054.2 +002100* (4) SAME CLAUSE; IX2054.2 +002200* (5) BLOCK CONTAINS INTEGER-1 TO INTEGER-2 CLAUSE; IX2054.2 +002300* (6) VALUE OF IMPLEMENTOR-NAME. IX2054.2 +002400* IX2054.2 +002500* NEW TEST: START ... IX2054.2 +002600* KEY IS GREATER THAN OR EQUAL TO ... IX2054.2 +002700* IX2054.2 +002800* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2054.2 +002900* ROUTINE. FILES ARE CREATED AND ACCESSED USING THE ACCESS IX2054.2 +003000* MODE IS DYNAMIC. IX2054.2 +003100* IX2054.2 +003200* IX2054.2 +003300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2054.2 +003400* IX2054.2 +003500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2054.2 +003600* CLAUSE FOR DATA FILE IX-FS1 IX2054.2 +003700* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2054.2 +003800* CLAUSE FOR DATA FILE IX-FD2 IX2054.2 +003900* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2054.2 +004000* CLAUSE FOR INDEX FILE IX-FS1 IX2054.2 +004100* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2054.2 +004200* CLAUSE FOR INDEX FILE IX-FD2 IX2054.2 +004300* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2054.2 +004400* X-62 FOR RAW-DATA IX2054.2 +004500* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2054.2 +004600* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2054.2 +004700* X-84 LABEL RECORDS FOR PRINT-FILE IX2054.2 +004800* IX2054.2 +004900* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2054.2 +005000* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2054.2 +005100* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2054.2 +005200* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2054.2 +005300* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2054.2 +005400* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2054.2 +005500* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2054.2 +005600* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2054.2 +005700* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2054.2 +005800* THEY ARE AS FOLLOWS IX2054.2 +005900* IX2054.2 +006000* P SELECTS X-CARDS 62 IX2054.2 +006100* J SELECTS X-CARDS 44 AND 45 IX2054.2 +006200* C SELECTS X-CARDS 84 IX2054.2 +006300* IX2054.2 +006400****************************************************** IX2054.2 +006500 ENVIRONMENT DIVISION. IX2054.2 +006600 CONFIGURATION SECTION. IX2054.2 +006700 SOURCE-COMPUTER. IX2054.2 +006800 XXXXX082. IX2054.2 +006900 OBJECT-COMPUTER. IX2054.2 +007000 XXXXX083. IX2054.2 +007100 INPUT-OUTPUT SECTION. IX2054.2 +007200 FILE-CONTROL. IX2054.2 +007300P SELECT RAW-DATA ASSIGN TO IX2054.2 +007400P XXXXX062 IX2054.2 +007500P ORGANIZATION IS INDEXED IX2054.2 +007600P ACCESS MODE IS RANDOM IX2054.2 +007700P RECORD KEY IS RAW-DATA-KEY. IX2054.2 +007800 SELECT PRINT-FILE ASSIGN TO IX2054.2 +007900 XXXXX055. IX2054.2 +008000 SELECT IX-FD1 ASSIGN TO IX2054.2 +008100 XXXXX024 IX2054.2 +008200J XXXXX044 IX2054.2 +008300 RESERVE 3 AREA IX2054.2 +008400 ORGANIZATION IS INDEXED IX2054.2 +008500 ACCESS MODE IS DYNAMIC IX2054.2 +008600 RECORD KEY IS IX-FD1-KEY IX2054.2 +008700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1. IX2054.2 +008800 SELECT IX-FD2 ASSIGN TO IX2054.2 +008900 XXXXX025 IX2054.2 +009000J XXXXX045 IX2054.2 +009100 RESERVE 2 AREAS IX2054.2 +009200 ACCESS MODE DYNAMIC IX2054.2 +009300 ORGANIZATION INDEXED IX2054.2 +009400 RECORD KEY IX-FD2-KEY IX2054.2 +009500 ALTERNATE RECORD IX-FD2-ALTKEY1. IX2054.2 +009600 I-O-CONTROL. IX2054.2 +009700 SAME RECORD IX-FD1 IX-FD2. IX2054.2 +009800 DATA DIVISION. IX2054.2 +009900 FILE SECTION. IX2054.2 +010000P IX2054.2 +010100PFD RAW-DATA. IX2054.2 +010200P IX2054.2 +010300P01 RAW-DATA-SATZ. IX2054.2 +010400P 05 RAW-DATA-KEY PIC X(6). IX2054.2 +010500P 05 C-DATE PIC 9(6). IX2054.2 +010600P 05 C-TIME PIC 9(8). IX2054.2 +010700P 05 C-NO-OF-TESTS PIC 99. IX2054.2 +010800P 05 C-OK PIC 999. IX2054.2 +010900P 05 C-ALL PIC 999. IX2054.2 +011000P 05 C-FAIL PIC 999. IX2054.2 +011100P 05 C-DELETED PIC 999. IX2054.2 +011200P 05 C-INSPECT PIC 999. IX2054.2 +011300P 05 C-NOTE PIC X(13). IX2054.2 +011400P 05 C-INDENT PIC X. IX2054.2 +011500P 05 C-ABORT PIC X(8). IX2054.2 +011600 FD PRINT-FILE. IX2054.2 +011700 01 PRINT-REC PICTURE X(120). IX2054.2 +011800 01 DUMMY-RECORD PICTURE X(120). IX2054.2 +011900 FD IX-FD1 IX2054.2 +012000C LABEL RECORDS ARE STANDARD IX2054.2 +012100 RECORD CONTAINS 240 CHARACTERS. IX2054.2 +012200 01 IX-FD1R1-F-G-240. IX2054.2 +012300 05 IX-FD1-REC-120 PIC X(120). IX2054.2 +012400 05 IX-FD1-REC-120-240. IX2054.2 +012500 10 FILLER PIC X(8). IX2054.2 +012600 10 IX-FD1-REC-KEY. IX2054.2 +012700 15 FILLER PIC X(19). IX2054.2 +012800 15 IX-FD1-KEY PIC X(10). IX2054.2 +012900 10 FILLER PIC X(9). IX2054.2 +013000 10 IX-FD1-ALT1-KEY. IX2054.2 +013100 15 FILLER PIC X(19). IX2054.2 +013200 15 IX-FD1-ALTKEY1 PIC X(10). IX2054.2 +013300 10 FILLER PIC X(45). IX2054.2 +013400 FD IX-FD2 IX2054.2 +013500C LABEL RECORDS ARE STANDARD IX2054.2 +013600 BLOCK CONTAINS 5 TO 25 RECORDS IX2054.2 +013700 RECORD CONTAINS 240 CHARACTERS. IX2054.2 +013800 01 IX-FD2R1-F-G-240. IX2054.2 +013900 05 IX-FD2-REC-120 PIC X(120). IX2054.2 +014000 05 IX-FD2-REC-120-240. IX2054.2 +014100 10 FILLER PIC X(8). IX2054.2 +014200 10 IX-FD2-REC-KEY. IX2054.2 +014300 15 FILLER PIC X(19). IX2054.2 +014400 15 IX-FD2-KEY PIC X(10). IX2054.2 +014500 10 FILLER PIC X(9). IX2054.2 +014600 10 IX-FD2-ALT1-KEY. IX2054.2 +014700 15 FILLER PIC X(19). IX2054.2 +014800 15 IX-FD2-ALTKEY1 PIC X(10). IX2054.2 +014900 10 FILLER PIC X(45). IX2054.2 +015000 WORKING-STORAGE SECTION. IX2054.2 +015100*01 IX-FD2-ID IX2054.2 +015200* XXXXX086. IX2054.2 +015300 01 WRK-CS-09V00-001 PIC S9(9) COMPUTATIONAL. IX2054.2 +015400 01 WRK-REC-KEY-FD1. IX2054.2 +015500 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +015600 03 WRK-DU-10V00-001 PIC 9(10) VALUE ZERO. IX2054.2 +015700 01 WRK-ALT1-KEY-FD1. IX2054.2 +015800 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +015900 03 WRK-DU-10V00-002 PIC 9(10) VALUE ZERO. IX2054.2 +016000 01 FD1-FILE-SIZE PIC 9(10) VALUE 200. IX2054.2 +016100 01 WRK-REC-KEY-FD2. IX2054.2 +016200 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +016300 03 WRK-DU-10V00-003 PIC 9(10) VALUE ZERO. IX2054.2 +016400 01 WRK-ALT1-KEY-FD2. IX2054.2 +016500 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +016600 03 WRK-DU-10V00-004 PIC 9(10) VALUE ZERO. IX2054.2 +016700 01 FD2-FILE-SIZE PIC 9(10) VALUE 200. IX2054.2 +016800 01 FILE-RECORD-INFORMATION-REC. IX2054.2 +016900 03 FILE-RECORD-INFO-SKELETON. IX2054.2 +017000 05 FILLER PICTURE X(48) VALUE IX2054.2 +017100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2054.2 +017200 05 FILLER PICTURE X(46) VALUE IX2054.2 +017300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2054.2 +017400 05 FILLER PICTURE X(26) VALUE IX2054.2 +017500 ",LFIL=000000,ORG= ,LBLR= ". IX2054.2 +017600 05 FILLER PICTURE X(37) VALUE IX2054.2 +017700 ",RECKEY= ". IX2054.2 +017800 05 FILLER PICTURE X(38) VALUE IX2054.2 +017900 ",ALTKEY1= ". IX2054.2 +018000 05 FILLER PICTURE X(38) VALUE IX2054.2 +018100 ",ALTKEY2= ". IX2054.2 +018200 05 FILLER PICTURE X(7) VALUE SPACE.IX2054.2 +018300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2054.2 +018400 05 FILE-RECORD-INFO-P1-120. IX2054.2 +018500 07 FILLER PIC X(5). IX2054.2 +018600 07 XFILE-NAME PIC X(6). IX2054.2 +018700 07 FILLER PIC X(8). IX2054.2 +018800 07 XRECORD-NAME PIC X(6). IX2054.2 +018900 07 FILLER PIC X(1). IX2054.2 +019000 07 REELUNIT-NUMBER PIC 9(1). IX2054.2 +019100 07 FILLER PIC X(7). IX2054.2 +019200 07 XRECORD-NUMBER PIC 9(6). IX2054.2 +019300 07 FILLER PIC X(6). IX2054.2 +019400 07 UPDATE-NUMBER PIC 9(2). IX2054.2 +019500 07 FILLER PIC X(5). IX2054.2 +019600 07 ODO-NUMBER PIC 9(4). IX2054.2 +019700 07 FILLER PIC X(5). IX2054.2 +019800 07 XPROGRAM-NAME PIC X(5). IX2054.2 +019900 07 FILLER PIC X(7). IX2054.2 +020000 07 XRECORD-LENGTH PIC 9(6). IX2054.2 +020100 07 FILLER PIC X(7). IX2054.2 +020200 07 CHARS-OR-RECORDS PIC X(2). IX2054.2 +020300 07 FILLER PIC X(1). IX2054.2 +020400 07 XBLOCK-SIZE PIC 9(4). IX2054.2 +020500 07 FILLER PIC X(6). IX2054.2 +020600 07 RECORDS-IN-FILE PIC 9(6). IX2054.2 +020700 07 FILLER PIC X(5). IX2054.2 +020800 07 XFILE-ORGANIZATION PIC X(2). IX2054.2 +020900 07 FILLER PIC X(6). IX2054.2 +021000 07 XLABEL-TYPE PIC X(1). IX2054.2 +021100 05 FILE-RECORD-INFO-P121-240. IX2054.2 +021200 07 FILLER PIC X(8). IX2054.2 +021300 07 XRECORD-KEY PIC X(29). IX2054.2 +021400 07 FILLER PIC X(9). IX2054.2 +021500 07 ALTERNATE-KEY1 PIC X(29). IX2054.2 +021600 07 FILLER PIC X(9). IX2054.2 +021700 07 ALTERNATE-KEY2 PIC X(29). IX2054.2 +021800 07 FILLER PIC X(7). IX2054.2 +021900 01 TEST-RESULTS. IX2054.2 +022000 02 FILLER PIC X VALUE SPACE. IX2054.2 +022100 02 FEATURE PIC X(20) VALUE SPACE. IX2054.2 +022200 02 FILLER PIC X VALUE SPACE. IX2054.2 +022300 02 P-OR-F PIC X(5) VALUE SPACE. IX2054.2 +022400 02 FILLER PIC X VALUE SPACE. IX2054.2 +022500 02 PAR-NAME. IX2054.2 +022600 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +022700 03 PARDOT-X PIC X VALUE SPACE. IX2054.2 +022800 03 DOTVALUE PIC 99 VALUE ZERO. IX2054.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IX2054.2 +023000 02 RE-MARK PIC X(61). IX2054.2 +023100 01 TEST-COMPUTED. IX2054.2 +023200 02 FILLER PIC X(30) VALUE SPACE. IX2054.2 +023300 02 FILLER PIC X(17) VALUE IX2054.2 +023400 " COMPUTED=". IX2054.2 +023500 02 COMPUTED-X. IX2054.2 +023600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2054.2 +023700 03 COMPUTED-N REDEFINES COMPUTED-A IX2054.2 +023800 PIC -9(9).9(9). IX2054.2 +023900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2054.2 +024000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2054.2 +024100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2054.2 +024200 03 CM-18V0 REDEFINES COMPUTED-A. IX2054.2 +024300 04 COMPUTED-18V0 PIC -9(18). IX2054.2 +024400 04 FILLER PIC X. IX2054.2 +024500 03 FILLER PIC X(50) VALUE SPACE. IX2054.2 +024600 01 TEST-CORRECT. IX2054.2 +024700 02 FILLER PIC X(30) VALUE SPACE. IX2054.2 +024800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2054.2 +024900 02 CORRECT-X. IX2054.2 +025000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2054.2 +025100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2054.2 +025200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2054.2 +025300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2054.2 +025400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2054.2 +025500 03 CR-18V0 REDEFINES CORRECT-A. IX2054.2 +025600 04 CORRECT-18V0 PIC -9(18). IX2054.2 +025700 04 FILLER PIC X. IX2054.2 +025800 03 FILLER PIC X(2) VALUE SPACE. IX2054.2 +025900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2054.2 +026000 01 CCVS-C-1. IX2054.2 +026100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2054.2 +026200- "SS PARAGRAPH-NAME IX2054.2 +026300- " REMARKS". IX2054.2 +026400 02 FILLER PIC X(20) VALUE SPACE. IX2054.2 +026500 01 CCVS-C-2. IX2054.2 +026600 02 FILLER PIC X VALUE SPACE. IX2054.2 +026700 02 FILLER PIC X(6) VALUE "TESTED". IX2054.2 +026800 02 FILLER PIC X(15) VALUE SPACE. IX2054.2 +026900 02 FILLER PIC X(4) VALUE "FAIL". IX2054.2 +027000 02 FILLER PIC X(94) VALUE SPACE. IX2054.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2054.2 +027200 01 REC-CT PIC 99 VALUE ZERO. IX2054.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2054.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2054.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2054.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2054.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2054.2 +028200 01 CCVS-H-1. IX2054.2 +028300 02 FILLER PIC X(39) VALUE SPACES. IX2054.2 +028400 02 FILLER PIC X(42) VALUE IX2054.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2054.2 +028600 02 FILLER PIC X(39) VALUE SPACES. IX2054.2 +028700 01 CCVS-H-2A. IX2054.2 +028800 02 FILLER PIC X(40) VALUE SPACE. IX2054.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2054.2 +029000 02 FILLER PIC XXXX VALUE IX2054.2 +029100 "4.2 ". IX2054.2 +029200 02 FILLER PIC X(28) VALUE IX2054.2 +029300 " COPY - NOT FOR DISTRIBUTION". IX2054.2 +029400 02 FILLER PIC X(41) VALUE SPACE. IX2054.2 +029500 IX2054.2 +029600 01 CCVS-H-2B. IX2054.2 +029700 02 FILLER PIC X(15) VALUE IX2054.2 +029800 "TEST RESULT OF ". IX2054.2 +029900 02 TEST-ID PIC X(9). IX2054.2 +030000 02 FILLER PIC X(4) VALUE IX2054.2 +030100 " IN ". IX2054.2 +030200 02 FILLER PIC X(12) VALUE IX2054.2 +030300 " HIGH ". IX2054.2 +030400 02 FILLER PIC X(22) VALUE IX2054.2 +030500 " LEVEL VALIDATION FOR ". IX2054.2 +030600 02 FILLER PIC X(58) VALUE IX2054.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +030800 01 CCVS-H-3. IX2054.2 +030900 02 FILLER PIC X(34) VALUE IX2054.2 +031000 " FOR OFFICIAL USE ONLY ". IX2054.2 +031100 02 FILLER PIC X(58) VALUE IX2054.2 +031200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2054.2 +031300 02 FILLER PIC X(28) VALUE IX2054.2 +031400 " COPYRIGHT 1985 ". IX2054.2 +031500 01 CCVS-E-1. IX2054.2 +031600 02 FILLER PIC X(52) VALUE SPACE. IX2054.2 +031700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2054.2 +031800 02 ID-AGAIN PIC X(9). IX2054.2 +031900 02 FILLER PIC X(45) VALUE SPACES. IX2054.2 +032000 01 CCVS-E-2. IX2054.2 +032100 02 FILLER PIC X(31) VALUE SPACE. IX2054.2 +032200 02 FILLER PIC X(21) VALUE SPACE. IX2054.2 +032300 02 CCVS-E-2-2. IX2054.2 +032400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2054.2 +032500 03 FILLER PIC X VALUE SPACE. IX2054.2 +032600 03 ENDER-DESC PIC X(44) VALUE IX2054.2 +032700 "ERRORS ENCOUNTERED". IX2054.2 +032800 01 CCVS-E-3. IX2054.2 +032900 02 FILLER PIC X(22) VALUE IX2054.2 +033000 " FOR OFFICIAL USE ONLY". IX2054.2 +033100 02 FILLER PIC X(12) VALUE SPACE. IX2054.2 +033200 02 FILLER PIC X(58) VALUE IX2054.2 +033300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +033400 02 FILLER PIC X(13) VALUE SPACE. IX2054.2 +033500 02 FILLER PIC X(15) VALUE IX2054.2 +033600 " COPYRIGHT 1985". IX2054.2 +033700 01 CCVS-E-4. IX2054.2 +033800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2054.2 +033900 02 FILLER PIC X(4) VALUE " OF ". IX2054.2 +034000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2054.2 +034100 02 FILLER PIC X(40) VALUE IX2054.2 +034200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2054.2 +034300 01 XXINFO. IX2054.2 +034400 02 FILLER PIC X(19) VALUE IX2054.2 +034500 "*** INFORMATION ***". IX2054.2 +034600 02 INFO-TEXT. IX2054.2 +034700 04 FILLER PIC X(8) VALUE SPACE. IX2054.2 +034800 04 XXCOMPUTED PIC X(20). IX2054.2 +034900 04 FILLER PIC X(5) VALUE SPACE. IX2054.2 +035000 04 XXCORRECT PIC X(20). IX2054.2 +035100 02 INF-ANSI-REFERENCE PIC X(48). IX2054.2 +035200 01 HYPHEN-LINE. IX2054.2 +035300 02 FILLER PIC IS X VALUE IS SPACE. IX2054.2 +035400 02 FILLER PIC IS X(65) VALUE IS "************************IX2054.2 +035500- "*****************************************". IX2054.2 +035600 02 FILLER PIC IS X(54) VALUE IS "************************IX2054.2 +035700- "******************************". IX2054.2 +035800 01 CCVS-PGM-ID PIC X(9) VALUE IX2054.2 +035900 "IX205A". IX2054.2 +036000 PROCEDURE DIVISION. IX2054.2 +036100 CCVS1 SECTION. IX2054.2 +036200 OPEN-FILES. IX2054.2 +036300P OPEN I-O RAW-DATA. IX2054.2 +036400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2054.2 +036500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2054.2 +036600P MOVE "ABORTED " TO C-ABORT. IX2054.2 +036700P ADD 1 TO C-NO-OF-TESTS. IX2054.2 +036800P ACCEPT C-DATE FROM DATE. IX2054.2 +036900P ACCEPT C-TIME FROM TIME. IX2054.2 +037000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2054.2 +037100PEND-E-1. IX2054.2 +037200P CLOSE RAW-DATA. IX2054.2 +037300 OPEN OUTPUT PRINT-FILE. IX2054.2 +037400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2054.2 +037500 MOVE SPACE TO TEST-RESULTS. IX2054.2 +037600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2054.2 +037700 MOVE ZERO TO REC-SKL-SUB. IX2054.2 +037800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2054.2 +037900 CCVS-INIT-FILE. IX2054.2 +038000 ADD 1 TO REC-SKL-SUB. IX2054.2 +038100 MOVE FILE-RECORD-INFO-SKELETON IX2054.2 +038200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2054.2 +038300 CCVS-INIT-EXIT. IX2054.2 +038400 GO TO CCVS1-EXIT. IX2054.2 +038500 CLOSE-FILES. IX2054.2 +038600P OPEN I-O RAW-DATA. IX2054.2 +038700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2054.2 +038800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2054.2 +038900P MOVE "OK. " TO C-ABORT. IX2054.2 +039000P MOVE PASS-COUNTER TO C-OK. IX2054.2 +039100P MOVE ERROR-HOLD TO C-ALL. IX2054.2 +039200P MOVE ERROR-COUNTER TO C-FAIL. IX2054.2 +039300P MOVE DELETE-COUNTER TO C-DELETED. IX2054.2 +039400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2054.2 +039500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2054.2 +039600PEND-E-2. IX2054.2 +039700P CLOSE RAW-DATA. IX2054.2 +039800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2054.2 +039900 TERMINATE-CCVS. IX2054.2 +040000S EXIT PROGRAM. IX2054.2 +040100STERMINATE-CALL. IX2054.2 +040200 STOP RUN. IX2054.2 +040300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2054.2 +040400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2054.2 +040500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2054.2 +040600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2054.2 +040700 MOVE "****TEST DELETED****" TO RE-MARK. IX2054.2 +040800 PRINT-DETAIL. IX2054.2 +040900 IF REC-CT NOT EQUAL TO ZERO IX2054.2 +041000 MOVE "." TO PARDOT-X IX2054.2 +041100 MOVE REC-CT TO DOTVALUE. IX2054.2 +041200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2054.2 +041300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2054.2 +041400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2054.2 +041500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2054.2 +041600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2054.2 +041700 MOVE SPACE TO CORRECT-X. IX2054.2 +041800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2054.2 +041900 MOVE SPACE TO RE-MARK. IX2054.2 +042000 HEAD-ROUTINE. IX2054.2 +042100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2054.2 +042400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2054.2 +042500 COLUMN-NAMES-ROUTINE. IX2054.2 +042600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +042700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +042900 END-ROUTINE. IX2054.2 +043000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2054.2 +043100 END-RTN-EXIT. IX2054.2 +043200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +043300 END-ROUTINE-1. IX2054.2 +043400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2054.2 +043500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2054.2 +043600 ADD PASS-COUNTER TO ERROR-HOLD. IX2054.2 +043700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2054.2 +043800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2054.2 +043900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2054.2 +044000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2054.2 +044100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2054.2 +044200 END-ROUTINE-12. IX2054.2 +044300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2054.2 +044400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2054.2 +044500 MOVE "NO " TO ERROR-TOTAL IX2054.2 +044600 ELSE IX2054.2 +044700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2054.2 +044800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2054.2 +044900 PERFORM WRITE-LINE. IX2054.2 +045000 END-ROUTINE-13. IX2054.2 +045100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2054.2 +045200 MOVE "NO " TO ERROR-TOTAL ELSE IX2054.2 +045300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2054.2 +045400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2054.2 +045500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +045600 IF INSPECT-COUNTER EQUAL TO ZERO IX2054.2 +045700 MOVE "NO " TO ERROR-TOTAL IX2054.2 +045800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2054.2 +045900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2054.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +046100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +046200 WRITE-LINE. IX2054.2 +046300 ADD 1 TO RECORD-COUNT. IX2054.2 +046400Y IF RECORD-COUNT GREATER 42 IX2054.2 +046500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2054.2 +046600Y MOVE SPACE TO DUMMY-RECORD IX2054.2 +046700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2054.2 +046800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2054.2 +046900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2054.2 +047000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2054.2 +047100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2054.2 +047200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2054.2 +047600Y MOVE ZERO TO RECORD-COUNT. IX2054.2 +047700 PERFORM WRT-LN. IX2054.2 +047800 WRT-LN. IX2054.2 +047900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2054.2 +048000 MOVE SPACE TO DUMMY-RECORD. IX2054.2 +048100 BLANK-LINE-PRINT. IX2054.2 +048200 PERFORM WRT-LN. IX2054.2 +048300 FAIL-ROUTINE. IX2054.2 +048400 IF COMPUTED-X NOT EQUAL TO SPACE IX2054.2 +048500 GO TO FAIL-ROUTINE-WRITE. IX2054.2 +048600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2054.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2054.2 +048800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2054.2 +048900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +049000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2054.2 +049100 GO TO FAIL-ROUTINE-EX. IX2054.2 +049200 FAIL-ROUTINE-WRITE. IX2054.2 +049300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2054.2 +049400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2054.2 +049500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2054.2 +049600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2054.2 +049700 FAIL-ROUTINE-EX. EXIT. IX2054.2 +049800 BAIL-OUT. IX2054.2 +049900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2054.2 +050000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2054.2 +050100 BAIL-OUT-WRITE. IX2054.2 +050200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2054.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2054.2 +050400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +050500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2054.2 +050600 BAIL-OUT-EX. EXIT. IX2054.2 +050700 CCVS1-EXIT. IX2054.2 +050800 EXIT. IX2054.2 +050900 SECT-IX-01-001 SECTION. IX2054.2 +051000 WRITE-INIT-GF-01. IX2054.2 +051100 OPEN OUTPUT IX-FD1. IX2054.2 +051200 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +051300 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +051400 MOVE "IX-FD1" TO XFILE-NAME (1). IX2054.2 +051500 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2054.2 +051600 MOVE 000001 TO XRECORD-NUMBER (1). IX2054.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2054.2 +051800 MOVE 200 TO RECORDS-IN-FILE (1). IX2054.2 +051900 MOVE 240 TO XRECORD-LENGTH (1). IX2054.2 +052000 MOVE 0001 TO XBLOCK-SIZE (1). IX2054.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2054.2 +052200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2054.2 +052300 MOVE "S" TO XLABEL-TYPE (1). IX2054.2 +052400 MOVE 000200 TO WRK-DU-10V00-002 IX2054.2 +052500 MOVE "FILE CREATED" TO RE-MARK. IX2054.2 +052600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2054.2 +052700 MOVE "WRITE DYNAMIC MODE " TO FEATURE. IX2054.2 +052800 WRITE-TEST-GF-01-R. IX2054.2 +052900 MOVE XRECORD-NUMBER (1) TO WRK-DU-10V00-001. IX2054.2 +053000 MOVE WRK-REC-KEY-FD1 TO XRECORD-KEY (1). IX2054.2 +053100 MOVE WRK-ALT1-KEY-FD1 TO ALTERNATE-KEY1 (1). IX2054.2 +053200 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2054.2 +053300 WRITE IX-FD1R1-F-G-240 IX2054.2 +053400 INVALID KEY GO TO WRITE-TEST-GF-01. IX2054.2 +053500 IF XRECORD-NUMBER (1) NOT LESS THAN FD1-FILE-SIZE IX2054.2 +053600 GO TO WRITE-TEST-GF-01. IX2054.2 +053700 ADD 000001 TO XRECORD-NUMBER (1). IX2054.2 +053800 SUBTRACT 000001 FROM WRK-DU-10V00-002. IX2054.2 +053900 GO TO WRITE-TEST-GF-01-R. IX2054.2 +054000 WRITE-TEST-GF-01. IX2054.2 +054100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2054.2 +054200 MOVE FD1-FILE-SIZE TO CORRECT-18V0. IX2054.2 +054300 IF XRECORD-NUMBER (1) EQUAL TO FD1-FILE-SIZE IX2054.2 +054400 PERFORM PASS IX2054.2 +054500 ELSE IX2054.2 +054600 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2054.2 +054700 PERFORM FAIL. IX2054.2 +054800 PERFORM PRINT-DETAIL. IX2054.2 +054900* IX2054.2 +055000* 01 IX2054.2 +055100* IX2054.2 +055200 CLOSE IX-FD1. IX2054.2 +055300 READ-INIT-F1-01. IX2054.2 +055400 OPEN INPUT IX-FD1. IX2054.2 +055500 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +055600 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +055700 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +055800 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2054.2 +055900 MOVE "READ NEXT RECORD " TO FEATURE. IX2054.2 +056000 READ-TEST-F1-01-3. IX2054.2 +056100 ADD 1 TO WRK-DU-10V00-001. IX2054.2 +056200 READ IX-FD1 IX2054.2 +056300 NEXT RECORD IX2054.2 +056400 AT END IX2054.2 +056500 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +056600* IX2054.2 +056700* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +056800* HAS BEEN TAKEN. IX2054.2 +056900* IX2054.2 +057000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +057100 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +057200 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +057300* IX2054.2 +057400* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2054.2 +057500* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +057600* IX2054.2 +057700 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +057800 IF WRK-CS-09V00-001 GREATER THAN 24 IX2054.2 +057900 NEXT SENTENCE ELSE IX2054.2 +058000 GO TO READ-TEST-F1-01-3. IX2054.2 +058100 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +058200 PERFORM FAIL IX2054.2 +058300 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +058400 MOVE ZERO TO CORRECT-18V0 IX2054.2 +058500 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +058600 ELSE PERFORM PASS. IX2054.2 +058700 PERFORM PRINT-DETAIL. IX2054.2 +058800* IX2054.2 +058900* 02 IX2054.2 +059000* IX2054.2 +059100 READ-INIT-F2-02. IX2054.2 +059200 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2054.2 +059300 MOVE "READ . RECORD INVALID" TO FEATURE. IX2054.2 +059400 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +059500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +059600 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +059700 READ-TEST-F1-02-5. IX2054.2 +059800 ADD 10 TO WRK-DU-10V00-001. IX2054.2 +059900 MOVE WRK-DU-10V00-001 TO IX-FD1-KEY IX2054.2 +060000 READ IX-FD1 RECORD IX2054.2 +060100 INVALID KEY IX2054.2 +060200 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +060300* IX2054.2 +060400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +060500* PATH HAS BEEN TAKEN. IX2054.2 +060600* IX2054.2 +060700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +060800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +060900 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +061000* IX2054.2 +061100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2054.2 +061200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +061300* IX2054.2 +061400 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +061500 IF WRK-CS-09V00-001 GREATER THAN 10 IX2054.2 +061600 NEXT SENTENCE ELSE IX2054.2 +061700 GO TO READ-TEST-F1-02-5. IX2054.2 +061800 READ-TEST-F1-02. IX2054.2 +061900 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +062000 PERFORM FAIL IX2054.2 +062100 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +062200 MOVE ZERO TO CORRECT-18V0 IX2054.2 +062300 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +062400 ELSE PERFORM PASS. IX2054.2 +062500 PERFORM PRINT-DETAIL. IX2054.2 +062600* IX2054.2 +062700* 03 IX2054.2 +062800* IX2054.2 +062900 READ-INIT-GF-03. IX2054.2 +063000 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2054.2 +063100 MOVE "START = READ ALTERN." TO FEATURE. IX2054.2 +063200 MOVE 0000000200 TO WRK-DU-10V00-001. IX2054.2 +063300 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2054.2 +063400 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2054.2 +063500 MOVE 0000000001 TO WRK-DU-10V00-002. IX2054.2 +063600 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +063700 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2054.2 +063800 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +063900 START IX-FD1 IX2054.2 +064000 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2054.2 +064100 INVALID KEY IX2054.2 +064200 ADD 1000000 TO WRK-DU-10V00-002. IX2054.2 +064300* IX2054.2 +064400* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +064500* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +064600* IX2054.2 +064700 READ-TEST-F1-03. IX2054.2 +064800 READ IX-FD1 IX2054.2 +064900 NEXT RECORD IX2054.2 +065000 AT END IX2054.2 +065100 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +065200* IX2054.2 +065300* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +065400* HAS BEEN TAKEN ON THE READ STATEMENT. IX2054.2 +065500* IX2054.2 +065600 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +065700 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +065800 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +065900* IX2054.2 +066000* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +066100* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +066200* IX2054.2 +066300 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2054.2 +066400 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +066500 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +066600 NEXT SENTENCE ELSE IX2054.2 +066700 GO TO READ-TEST-F1-03. IX2054.2 +066800 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +066900 PERFORM FAIL IX2054.2 +067000 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +067100 MOVE ZERO TO CORRECT-18V0 IX2054.2 +067200 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +067300 ELSE PERFORM PASS. IX2054.2 +067400 PERFORM PRINT-DETAIL. IX2054.2 +067500* IX2054.2 +067600* 04 IX2054.2 +067700* IX2054.2 +067800 READ-INIT-GF-04. IX2054.2 +067900 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2054.2 +068000 MOVE "START >= READ ALTERN." TO FEATURE. IX2054.2 +068100 MOVE 0000000200 TO WRK-DU-10V00-001. IX2054.2 +068200 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2054.2 +068300 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2054.2 +068400 MOVE 0000000001 TO WRK-DU-10V00-002. IX2054.2 +068500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +068600 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2054.2 +068700 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +068800 START IX-FD1 IX2054.2 +068900 KEY IS GREATER THAN OR EQUAL TO IX-FD1-ALTKEY1 IX2054.2 +069000 INVALID KEY IX2054.2 +069100 ADD 1000000 TO WRK-DU-10V00-002. IX2054.2 +069200* IX2054.2 +069300* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +069400* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +069500* IX2054.2 +069600 READ-TEST-F1-04. IX2054.2 +069700 READ IX-FD1 IX2054.2 +069800 NEXT RECORD IX2054.2 +069900 AT END IX2054.2 +070000 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +070100* IX2054.2 +070200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +070300* HAS BEEN TAKEN ON THE READ STATEMENT. IX2054.2 +070400* IX2054.2 +070500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +070600 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +070700 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +070800* IX2054.2 +070900* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +071000* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +071100* IX2054.2 +071200 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2054.2 +071300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +071400 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +071500 NEXT SENTENCE ELSE IX2054.2 +071600 GO TO READ-TEST-F1-04. IX2054.2 +071700 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +071800 PERFORM FAIL IX2054.2 +071900 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +072000 MOVE ZERO TO CORRECT-18V0 IX2054.2 +072100 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +072200 ELSE PERFORM PASS. IX2054.2 +072300 PERFORM PRINT-DETAIL. IX2054.2 +072400 CLOSE IX-FD1. IX2054.2 +072500 READ-EXIT-F1. IX2054.2 +072600 EXIT. IX2054.2 +072700 SECT-IX-01-002 SECTION. IX2054.2 +072800 WRITE-INIT-GF-02. IX2054.2 +072900 OPEN OUTPUT IX-FD2. IX2054.2 +073000 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +073100 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +073200 MOVE "IX-FD2" TO XFILE-NAME (2). IX2054.2 +073300 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2054.2 +073400 MOVE 000001 TO XRECORD-NUMBER (2). IX2054.2 +073500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2054.2 +073600 MOVE 000240 TO XRECORD-LENGTH (2). IX2054.2 +073700 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2054.2 +073800 MOVE 0025 TO XBLOCK-SIZE (2). IX2054.2 +073900 MOVE 0000200 TO RECORDS-IN-FILE (2). IX2054.2 +074000 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2054.2 +074100 MOVE "S" TO XLABEL-TYPE (2). IX2054.2 +074200 MOVE 000200 TO WRK-DU-10V00-004. IX2054.2 +074300 MOVE "FILE CREATED" TO RE-MARK. IX2054.2 +074400 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2054.2 +074500 MOVE "DYNAMIC MODE" TO FEATURE. IX2054.2 +074600 WRITE-TEST-GF-02-R. IX2054.2 +074700 MOVE XRECORD-NUMBER (2) TO WRK-DU-10V00-003. IX2054.2 +074800 MOVE WRK-REC-KEY-FD2 TO XRECORD-KEY (2). IX2054.2 +074900 MOVE WRK-ALT1-KEY-FD2 TO ALTERNATE-KEY1 (2). IX2054.2 +075000 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX2054.2 +075100 WRITE IX-FD2R1-F-G-240 IX2054.2 +075200 INVALID KEY GO TO WRITE-TEST-GF-02. IX2054.2 +075300 IF XRECORD-NUMBER (2) NOT LESS THAN FD2-FILE-SIZE IX2054.2 +075400 GO TO WRITE-TEST-GF-02. IX2054.2 +075500 ADD 000001 TO XRECORD-NUMBER (2). IX2054.2 +075600 SUBTRACT 000001 FROM WRK-DU-10V00-004. IX2054.2 +075700 GO TO WRITE-TEST-GF-02-R. IX2054.2 +075800 WRITE-TEST-GF-02. IX2054.2 +075900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX2054.2 +076000 MOVE FD2-FILE-SIZE TO CORRECT-18V0. IX2054.2 +076100 IF XRECORD-NUMBER (2) EQUAL TO FD2-FILE-SIZE IX2054.2 +076200 PERFORM PASS IX2054.2 +076300 ELSE IX2054.2 +076400 MOVE "FILE CREATION PREMATURE; IX-41" TO RE-MARK IX2054.2 +076500 PERFORM FAIL. IX2054.2 +076600 PERFORM PRINT-DETAIL. IX2054.2 +076700* IX2054.2 +076800* 02 IX2054.2 +076900* IX2054.2 +077000 CLOSE IX-FD2. IX2054.2 +077100 READ-INIT-F1-05. IX2054.2 +077200 OPEN INPUT IX-FD2. IX2054.2 +077300 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +077400 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +077500 MOVE " READ SEQUENTIAL" TO FEATURE. IX2054.2 +077600 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +077700 READ-TEST-F1-05-3. IX2054.2 +077800 ADD 1 TO WRK-DU-10V00-003. IX2054.2 +077900 READ IX-FD2 IX2054.2 +078000 NEXT RECORD IX2054.2 +078100 AT END IX2054.2 +078200 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +078300* IX2054.2 +078400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +078500* HAS BEEN TAKEN. IX2054.2 +078600* IX2054.2 +078700 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +078800 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +078900 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +079000* IX2054.2 +079100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2054.2 +079200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +079300* IX2054.2 +079400 ADD 000000001 TO WRK-CS-09V00-001. IX2054.2 +079500 IF WRK-CS-09V00-001 GREATER THAN 24 IX2054.2 +079600 NEXT SENTENCE ELSE IX2054.2 +079700 GO TO READ-TEST-F1-05-3. IX2054.2 +079800 READ-TEST-F1-05. IX2054.2 +079900 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX2054.2 +080000 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +080100 MOVE "RETRIEVED A NOT EXPECTED RECORD " TO RE-MARK IX2054.2 +080200 PERFORM FAIL IX2054.2 +080300 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +080400 MOVE ZERO TO CORRECT-18V0 IX2054.2 +080500 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +080600 ELSE PERFORM PASS. IX2054.2 +080700 PERFORM PRINT-DETAIL. IX2054.2 +080800* IX2054.2 +080900* 06 IX2054.2 +081000* IX2054.2 +081100 READ-TEST-F1-06-4. IX2054.2 +081200 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +081300 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +081400 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +081500 MOVE " READ RANDOM" TO FEATURE. IX2054.2 +081600 READ-TEST-F1-06-5. IX2054.2 +081700 ADD 10 TO WRK-DU-10V00-003. IX2054.2 +081800 MOVE WRK-DU-10V00-003 TO IX-FD2-KEY IX2054.2 +081900 READ IX-FD2 RECORD IX2054.2 +082000 INVALID KEY IX2054.2 +082100 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +082200* IX2054.2 +082300* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +082400* PATH HAS BEEN TAKEN. IX2054.2 +082500* IX2054.2 +082600 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +082700 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +082800 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +082900* IX2054.2 +083000* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2054.2 +083100* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +083200* IX2054.2 +083300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +083400 IF WRK-CS-09V00-001 GREATER THAN 10 IX2054.2 +083500 NEXT SENTENCE ELSE IX2054.2 +083600 GO TO READ-TEST-F1-06-5. IX2054.2 +083700 READ-TEST-F1-06. IX2054.2 +083800 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX2054.2 +083900 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +084000 MOVE "RETRIEVED A NOT EXPECTED RECORD " TO RE-MARK IX2054.2 +084100 PERFORM FAIL IX2054.2 +084200 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +084300 MOVE ZERO TO CORRECT-18V0 IX2054.2 +084400 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +084500 ELSE PERFORM PASS. IX2054.2 +084600 PERFORM PRINT-DETAIL. IX2054.2 +084700* IX2054.2 +084800* 07 IX2054.2 +084900* IX2054.2 +085000 READ-TEST-F1-07-6. IX2054.2 +085100 MOVE 00000200 TO WRK-DU-10V00-003. IX2054.2 +085200 MOVE WRK-REC-KEY-FD2 TO IX-FD2-REC-KEY. IX2054.2 +085300 MOVE FD2-FILE-SIZE TO WRK-DU-10V00-003. IX2054.2 +085400 MOVE 000000001 TO WRK-DU-10V00-004. IX2054.2 +085500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +085600 MOVE WRK-ALT1-KEY-FD2 TO IX-FD2-ALT1-KEY. IX2054.2 +085700 MOVE " READ ALTERNATE KEY" TO FEATURE. IX2054.2 +085800 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +085900 START IX-FD2 IX2054.2 +086000 KEY IS EQUAL TO IX-FD2-ALTKEY1 IX2054.2 +086100 INVALID KEY ADD 1000000 TO WRK-DU-10V00-004. IX2054.2 +086200* IX2054.2 +086300* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +086400* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +086500* IX2054.2 +086600 READ-TEST-F1-07-7. IX2054.2 +086700 READ IX-FD2 IX2054.2 +086800 NEXT RECORD IX2054.2 +086900 AT END IX2054.2 +087000 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +087100* IX2054.2 +087200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +087300* HAS BEEN TAKEN. IX2054.2 +087400* IX2054.2 +087500 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +087600 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +087700 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +087800* IX2054.2 +087900* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +088000* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +088100* IX2054.2 +088200 SUBTRACT 1 FROM WRK-DU-10V00-003. IX2054.2 +088300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +088400 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +088500 NEXT SENTENCE ELSE IX2054.2 +088600 GO TO READ-TEST-F1-07-7. IX2054.2 +088700 READ-TEST-F1-07. IX2054.2 +088800 MOVE "READ-TEST-F1-07" TO PAR-NAME. IX2054.2 +088900 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +089000 PERFORM FAIL IX2054.2 +089100 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +089200 MOVE ZERO TO CORRECT-18V0 IX2054.2 +089300 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +089400 ELSE PERFORM PASS. IX2054.2 +089500 PERFORM PRINT-DETAIL. IX2054.2 +089600 CLOSE IX-FD2. IX2054.2 +089700 INX-EXIT-002. IX2054.2 +089800 EXIT. IX2054.2 +089900 READ-INIT-F1-08. IX2054.2 +090000 OPEN INPUT IX-FD1. IX2054.2 +090100 OPEN INPUT IX-FD2. IX2054.2 +090200 MOVE SPACE TO FILE-RECORD-INFO (9). IX2054.2 +090300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2054.2 +090400 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +090500 MOVE SPACES TO IX-FD1R1-F-G-240. IX2054.2 +090600 MOVE SPACES TO IX-FD2R1-F-G-240. IX2054.2 +090700 MOVE "SAME AREA" TO FEATURE. IX2054.2 +090800 READ-TEST-F1-08-1. IX2054.2 +090900 READ IX-FD1 IX2054.2 +091000 NEXT RECORD IX2054.2 +091100 AT END IX2054.2 +091200 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +091300 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +091400 READ-TEST-F1-08. IX2054.2 +091500 MOVE "READ-TEST-F1-08" TO PAR-NAME. IX2054.2 +091600 IF XFILE-NAME (1) EQUAL TO "IX-FD1" IX2054.2 +091700 PERFORM PASS IX2054.2 +091800 ELSE IX2054.2 +091900 MOVE "RETRIEVED A RECORD NOT EXPECTED " TO RE-MARK IX2054.2 +092000 PERFORM FAIL IX2054.2 +092100 MOVE XFILE-NAME (1) TO COMPUTED-A IX2054.2 +092200 MOVE "IX-FD1" TO CORRECT-A. IX2054.2 +092300 PERFORM PRINT-DETAIL. IX2054.2 +092400* IX2054.2 +092500* 09 IX2054.2 +092600* IX2054.2 +092700 READ IX-FD2 IX2054.2 +092800 NEXT RECORD IX2054.2 +092900 AT END IX2054.2 +093000 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +093100* IX2054.2 +093200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +093300* PATH HAS BEEN TAKEN. IX2054.2 +093400* IX2054.2 +093500 READ-TEST-F1-09. IX2054.2 +093600 MOVE "READ-TEST-F1-09" TO PAR-NAME. IX2054.2 +093700 IF WRK-DU-10V00-004 EQUAL TO ZERO IX2054.2 +093800 PERFORM PASS IX2054.2 +093900 ELSE IX2054.2 +094000 MOVE "RETRIEVED A RECORD NOT EXPECTED " TO RE-MARK IX2054.2 +094100 PERFORM FAIL IX2054.2 +094200 MOVE WRK-DU-10V00-004 TO COMPUTED-A IX2054.2 +094300 MOVE ZERO TO CORRECT-A IX2054.2 +094400 MOVE "SEE PROGRAM" TO RE-MARK. IX2054.2 +094500 PERFORM PRINT-DETAIL. IX2054.2 +094600* IX2054.2 +094700* 10 IX2054.2 +094800* IX2054.2 +094900 READ-TEST-F1-10. IX2054.2 +095000 MOVE "READ-TEST-F1-10" TO PAR-NAME. IX2054.2 +095100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (9). IX2054.2 +095200* IX2054.2 +095300* NOTE IN TESTING THE SAME AREA CLAUSE THE RECORD AREA IX2054.2 +095400* SHOULD BE SHARED BY BOTH FILES IX-FD1 AND IX-FD2, IX2054.2 +095500* THEREFORE FILE IX-FD2 IS READ AND THE RECORD IX2054.2 +095600* IDENTIFIED FOR IX-FD1 IS ACCESSED AND TESTED FOR IX2054.2 +095700* EXPECTED PRESENCE OF IX-FD2 FILE RECORD CONTENTS. IX2054.2 +095800* IX2054.2 +095900 IF XFILE-NAME (9) EQUAL TO "IX-FD2" IX2054.2 +096000 PERFORM PASS IX2054.2 +096100 ELSE IX2054.2 +096200 PERFORM FAIL IX2054.2 +096300 MOVE XFILE-NAME (9) TO COMPUTED-A IX2054.2 +096400 MOVE "IX-FD2" TO CORRECT-A IX2054.2 +096500 MOVE "SEE PROGRAM" TO RE-MARK. IX2054.2 +096600 PERFORM PRINT-DETAIL. IX2054.2 +096700 CLOSE IX-FD2. IX2054.2 +096800 CLOSE IX-FD1. IX2054.2 +096900 INX-EXIT-003. IX2054.2 +097000 EXIT. IX2054.2 +097100 CCVS-EXIT SECTION. IX2054.2 +097200 CCVS-999999. IX2054.2 +097300 GO TO CLOSE-FILES. IX2054.2 +*END-OF,IX205A +*HEADER,COBOL,IX206A +000100 IDENTIFICATION DIVISION. IX2064.2 +000200 PROGRAM-ID. IX2064.2 +000300 IX206A. IX2064.2 +000400**************************************************************** IX2064.2 +000500* * IX2064.2 +000600* VALIDATION FOR:- * IX2064.2 +000700* * IX2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +000900* * IX2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2064.2 +001100* * IX2064.2 +001200*IX206A IX2064.2 +001300******************************************************************IX2064.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE IX2064.2 +001500* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2064.2 +001600* LEVEL 2 OF INDEXED I-O. IX2064.2 +001700* THE ELEMENTS TESTED IN THIS PROGRAM ARE: IX2064.2 +001800* IX2064.2 +001900* (1) ACCESS MODE DYNAMIC IX2064.2 +002000* (2) ALTERNATE RECORD KEY WITHOUT THE DUPLICATES OPTION IX2064.2 +002100* (3) RESERVE CLAUSE IX2064.2 +002200* (4) SAME CLAUSE IX2064.2 +002300* (5) BLOCK CONTAINS INTEGER-1 TO INTEGER-2 CLAUSE IX2064.2 +002400* (6) VALUE OF IMPLEMENTOR-NAME SERIES. IX2064.2 +002500* IX2064.2 +002600* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2064.2 +002700* ROUTINE. ONE FILE IS CREATED AND ACCESSED IN THE DYNAMIC IX2064.2 +002800* ACCESS MODE AND THE 2ND FILE IS CREATED 2ND ACCESSED IN THE IX2064.2 +002900* SEQUENTIAL ACCESS MODE. IX2064.2 +003000* IX2064.2 +003100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2064.2 +003200* IX2064.2 +003300* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2064.2 +003400* CLAUSE FOR DATA FILE IX-FS1 IX2064.2 +003500* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2064.2 +003600* CLAUSE FOR DATA FILE IX-FD2 IX2064.2 +003700* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2064.2 +003800* CLAUSE FOR INDEX FILE IX-FS1 IX2064.2 +003900* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2064.2 +004000* CLAUSE FOR INDEX FILE IX-FD2 IX2064.2 +004100* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2064.2 +004200* X-62 FOR RAW-DATA IX2064.2 +004300* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2064.2 +004400* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2064.2 +004500* X-84 LABEL RECORDS FOR PRINT-FILE IX2064.2 +004600* IX2064.2 +004700* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2064.2 +004800* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2064.2 +004900* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2064.2 +005000* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2064.2 +005100* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2064.2 +005200* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2064.2 +005300* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2064.2 +005400* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2064.2 +005500* THEY ARE AS FOLLOWS IX2064.2 +005600* IX2064.2 +005700* P SELECTS X-CARDS 62 IX2064.2 +005800* J SELECTS X-CARDS 44 & 45 IX2064.2 +005900* C SELECTS X-CARDS 84 IX2064.2 +006000* IX2064.2 +006100****************************************************** IX2064.2 +006200 ENVIRONMENT DIVISION. IX2064.2 +006300 CONFIGURATION SECTION. IX2064.2 +006400 SOURCE-COMPUTER. IX2064.2 +006500 XXXXX082. IX2064.2 +006600 OBJECT-COMPUTER. IX2064.2 +006700 XXXXX083. IX2064.2 +006800 INPUT-OUTPUT SECTION. IX2064.2 +006900 FILE-CONTROL. IX2064.2 +007000P SELECT RAW-DATA ASSIGN TO IX2064.2 +007100P XXXXX062 IX2064.2 +007200P ORGANIZATION IS INDEXED IX2064.2 +007300P ACCESS MODE IS RANDOM IX2064.2 +007400P RECORD KEY IS RAW-DATA-KEY. IX2064.2 +007500 SELECT PRINT-FILE ASSIGN TO IX2064.2 +007600 XXXXX055. IX2064.2 +007700 SELECT IX-FD1 ASSIGN TO IX2064.2 +007800 XXXXX024 IX2064.2 +007900J XXXXX044 IX2064.2 +008000 RESERVE 3 IX2064.2 +008100 ORGANIZATION IS INDEXED IX2064.2 +008200 ACCESS DYNAMIC IX2064.2 +008300 RECORD KEY IS IX-FD1-KEY IX2064.2 +008400 ALTERNATE RECORD IS IX-FD1-ALTKEY1. IX2064.2 +008500 SELECT IX-FS1 ASSIGN TO IX2064.2 +008600 XXXXX025 IX2064.2 +008700J XXXXX045 IX2064.2 +008800 ; RESERVE 4 AREAS IX2064.2 +008900 ; ACCESS MODE IS SEQUENTIAL IX2064.2 +009000 ORGANIZATION INDEXED IX2064.2 +009100 RECORD KEY IX-FS1-KEY IX2064.2 +009200 ; ALTERNATE RECORD KEY IX-FS1-ALTKEY1. IX2064.2 +009300 I-O-CONTROL. IX2064.2 +009400 SAME RECORD FOR IX-FD1, IX-FS1. IX2064.2 +009500 DATA DIVISION. IX2064.2 +009600 FILE SECTION. IX2064.2 +009700P IX2064.2 +009800PFD RAW-DATA. IX2064.2 +009900P IX2064.2 +010000P01 RAW-DATA-SATZ. IX2064.2 +010100P 05 RAW-DATA-KEY PIC X(6). IX2064.2 +010200P 05 C-DATE PIC 9(6). IX2064.2 +010300P 05 C-TIME PIC 9(8). IX2064.2 +010400P 05 C-NO-OF-TESTS PIC 99. IX2064.2 +010500P 05 C-OK PIC 999. IX2064.2 +010600P 05 C-ALL PIC 999. IX2064.2 +010700P 05 C-FAIL PIC 999. IX2064.2 +010800P 05 C-DELETED PIC 999. IX2064.2 +010900P 05 C-INSPECT PIC 999. IX2064.2 +011000P 05 C-NOTE PIC X(13). IX2064.2 +011100P 05 C-INDENT PIC X. IX2064.2 +011200P 05 C-ABORT PIC X(8). IX2064.2 +011300 FD PRINT-FILE. IX2064.2 +011400 01 PRINT-REC PICTURE X(120). IX2064.2 +011500 01 DUMMY-RECORD PICTURE X(120). IX2064.2 +011600 FD IX-FD1 IX2064.2 +011700C LABEL RECORDS ARE STANDARD IX2064.2 +011800 BLOCK 10 TO 20 RECORDS IX2064.2 +011900 RECORD CONTAINS 240 CHARACTERS. IX2064.2 +012000 01 IX-FD1R1-F-G-240. IX2064.2 +012100 05 IX-FD1-REC-120 PIC X(120). IX2064.2 +012200 05 IX-FD1-REC-120-240. IX2064.2 +012300 10 FILLER PIC X(8). IX2064.2 +012400 10 IX-FD1-REC-KEY. IX2064.2 +012500 15 FILLER PIC X(19). IX2064.2 +012600 15 IX-FD1-KEY PIC X(10). IX2064.2 +012700 10 FILLER PIC X(9). IX2064.2 +012800 10 IX-FD1-ALT1-KEY. IX2064.2 +012900 15 FILLER PIC X(19). IX2064.2 +013000 15 IX-FD1-ALTKEY1 PIC X(10). IX2064.2 +013100 10 FILLER PIC X(45). IX2064.2 +013200 FD IX-FS1 IX2064.2 +013300C LABEL RECORDS ARE STANDARD IX2064.2 +013400 RECORD CONTAINS 240 CHARACTERS. IX2064.2 +013500 01 IX-FS1R1-F-G-240. IX2064.2 +013600 05 IX-FS1-REC-120 PIC X(120). IX2064.2 +013700 05 IX-FS1-REC-120-240. IX2064.2 +013800 10 FILLER PIC X(8). IX2064.2 +013900 10 IX-FS1-REC-KEY. IX2064.2 +014000 15 FILLER PIC X(19). IX2064.2 +014100 15 IX-FS1-KEY PIC X(10). IX2064.2 +014200 10 FILLER PIC X(9). IX2064.2 +014300 10 IX-FS1-ALT1-KEY. IX2064.2 +014400 15 FILLER PIC X(19). IX2064.2 +014500 15 IX-FS1-ALTKEY1 PIC X(10). IX2064.2 +014600 10 FILLER PIC X(45). IX2064.2 +014700 WORKING-STORAGE SECTION. IX2064.2 +014800 01 WRK-CS-09V00-001 PIC S9(9) COMPUTATIONAL. IX2064.2 +014900 01 WRK-REC-KEY-FD1. IX2064.2 +015000 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015100 03 WRK-DU-10V00-001 PIC 9(10) VALUE ZERO. IX2064.2 +015200 01 WRK-ALT1-KEY-FD1. IX2064.2 +015300 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015400 03 WRK-DU-10V00-002 PIC 9(10) VALUE ZERO. IX2064.2 +015500 01 FD1-FILE-SIZE PIC 9(10) VALUE 200. IX2064.2 +015600 01 WRK-REC-KEY-FS1. IX2064.2 +015700 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015800 03 WRK-DU-10V00-003 PIC 9(10) VALUE ZERO. IX2064.2 +015900 01 WRK-ALT1-KEY-FS1. IX2064.2 +016000 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +016100 03 WRK-DU-10V00-004 PIC 9(10) VALUE ZERO. IX2064.2 +016200 01 FS1-FILE-SIZE PIC 9(10) VALUE 200. IX2064.2 +016300C01 IX-FD1-ID1 IX2064.2 +016400C XXXXX086. IX2064.2 +016500C01 IX-FD1-ID2 IX2064.2 +016600C XXXXX087. IX2064.2 +016700C01 IX-FS1-ID2 IX2064.2 +016800C XXXXX088. IX2064.2 +016900 01 FILE-RECORD-INFORMATION-REC. IX2064.2 +017000 03 FILE-RECORD-INFO-SKELETON. IX2064.2 +017100 05 FILLER PICTURE X(48) VALUE IX2064.2 +017200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2064.2 +017300 05 FILLER PICTURE X(46) VALUE IX2064.2 +017400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2064.2 +017500 05 FILLER PICTURE X(26) VALUE IX2064.2 +017600 ",LFIL=000000,ORG= ,LBLR= ". IX2064.2 +017700 05 FILLER PICTURE X(37) VALUE IX2064.2 +017800 ",RECKEY= ". IX2064.2 +017900 05 FILLER PICTURE X(38) VALUE IX2064.2 +018000 ",ALTKEY1= ". IX2064.2 +018100 05 FILLER PICTURE X(38) VALUE IX2064.2 +018200 ",ALTKEY2= ". IX2064.2 +018300 05 FILLER PICTURE X(7) VALUE SPACE.IX2064.2 +018400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2064.2 +018500 05 FILE-RECORD-INFO-P1-120. IX2064.2 +018600 07 FILLER PIC X(5). IX2064.2 +018700 07 XFILE-NAME PIC X(6). IX2064.2 +018800 07 FILLER PIC X(8). IX2064.2 +018900 07 XRECORD-NAME PIC X(6). IX2064.2 +019000 07 FILLER PIC X(1). IX2064.2 +019100 07 REELUNIT-NUMBER PIC 9(1). IX2064.2 +019200 07 FILLER PIC X(7). IX2064.2 +019300 07 XRECORD-NUMBER PIC 9(6). IX2064.2 +019400 07 FILLER PIC X(6). IX2064.2 +019500 07 UPDATE-NUMBER PIC 9(2). IX2064.2 +019600 07 FILLER PIC X(5). IX2064.2 +019700 07 ODO-NUMBER PIC 9(4). IX2064.2 +019800 07 FILLER PIC X(5). IX2064.2 +019900 07 XPROGRAM-NAME PIC X(5). IX2064.2 +020000 07 FILLER PIC X(7). IX2064.2 +020100 07 XRECORD-LENGTH PIC 9(6). IX2064.2 +020200 07 FILLER PIC X(7). IX2064.2 +020300 07 CHARS-OR-RECORDS PIC X(2). IX2064.2 +020400 07 FILLER PIC X(1). IX2064.2 +020500 07 XBLOCK-SIZE PIC 9(4). IX2064.2 +020600 07 FILLER PIC X(6). IX2064.2 +020700 07 RECORDS-IN-FILE PIC 9(6). IX2064.2 +020800 07 FILLER PIC X(5). IX2064.2 +020900 07 XFILE-ORGANIZATION PIC X(2). IX2064.2 +021000 07 FILLER PIC X(6). IX2064.2 +021100 07 XLABEL-TYPE PIC X(1). IX2064.2 +021200 05 FILE-RECORD-INFO-P121-240. IX2064.2 +021300 07 FILLER PIC X(8). IX2064.2 +021400 07 XRECORD-KEY PIC X(29). IX2064.2 +021500 07 FILLER PIC X(9). IX2064.2 +021600 07 ALTERNATE-KEY1 PIC X(29). IX2064.2 +021700 07 FILLER PIC X(9). IX2064.2 +021800 07 ALTERNATE-KEY2 PIC X(29). IX2064.2 +021900 07 FILLER PIC X(7). IX2064.2 +022000 01 TEST-RESULTS. IX2064.2 +022100 02 FILLER PIC X VALUE SPACE. IX2064.2 +022200 02 FEATURE PIC X(20) VALUE SPACE. IX2064.2 +022300 02 FILLER PIC X VALUE SPACE. IX2064.2 +022400 02 P-OR-F PIC X(5) VALUE SPACE. IX2064.2 +022500 02 FILLER PIC X VALUE SPACE. IX2064.2 +022600 02 PAR-NAME. IX2064.2 +022700 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +022800 03 PARDOT-X PIC X VALUE SPACE. IX2064.2 +022900 03 DOTVALUE PIC 99 VALUE ZERO. IX2064.2 +023000 02 FILLER PIC X(8) VALUE SPACE. IX2064.2 +023100 02 RE-MARK PIC X(61). IX2064.2 +023200 01 TEST-COMPUTED. IX2064.2 +023300 02 FILLER PIC X(30) VALUE SPACE. IX2064.2 +023400 02 FILLER PIC X(17) VALUE IX2064.2 +023500 " COMPUTED=". IX2064.2 +023600 02 COMPUTED-X. IX2064.2 +023700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2064.2 +023800 03 COMPUTED-N REDEFINES COMPUTED-A IX2064.2 +023900 PIC -9(9).9(9). IX2064.2 +024000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2064.2 +024100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2064.2 +024200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2064.2 +024300 03 CM-18V0 REDEFINES COMPUTED-A. IX2064.2 +024400 04 COMPUTED-18V0 PIC -9(18). IX2064.2 +024500 04 FILLER PIC X. IX2064.2 +024600 03 FILLER PIC X(50) VALUE SPACE. IX2064.2 +024700 01 TEST-CORRECT. IX2064.2 +024800 02 FILLER PIC X(30) VALUE SPACE. IX2064.2 +024900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2064.2 +025000 02 CORRECT-X. IX2064.2 +025100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2064.2 +025200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2064.2 +025300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2064.2 +025400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2064.2 +025500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2064.2 +025600 03 CR-18V0 REDEFINES CORRECT-A. IX2064.2 +025700 04 CORRECT-18V0 PIC -9(18). IX2064.2 +025800 04 FILLER PIC X. IX2064.2 +025900 03 FILLER PIC X(2) VALUE SPACE. IX2064.2 +026000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2064.2 +026100 01 CCVS-C-1. IX2064.2 +026200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2064.2 +026300- "SS PARAGRAPH-NAME IX2064.2 +026400- " REMARKS". IX2064.2 +026500 02 FILLER PIC X(20) VALUE SPACE. IX2064.2 +026600 01 CCVS-C-2. IX2064.2 +026700 02 FILLER PIC X VALUE SPACE. IX2064.2 +026800 02 FILLER PIC X(6) VALUE "TESTED". IX2064.2 +026900 02 FILLER PIC X(15) VALUE SPACE. IX2064.2 +027000 02 FILLER PIC X(4) VALUE "FAIL". IX2064.2 +027100 02 FILLER PIC X(94) VALUE SPACE. IX2064.2 +027200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2064.2 +027300 01 REC-CT PIC 99 VALUE ZERO. IX2064.2 +027400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2064.2 +027900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2064.2 +028000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2064.2 +028100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2064.2 +028200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2064.2 +028300 01 CCVS-H-1. IX2064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. IX2064.2 +028500 02 FILLER PIC X(42) VALUE IX2064.2 +028600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2064.2 +028700 02 FILLER PIC X(39) VALUE SPACES. IX2064.2 +028800 01 CCVS-H-2A. IX2064.2 +028900 02 FILLER PIC X(40) VALUE SPACE. IX2064.2 +029000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2064.2 +029100 02 FILLER PIC XXXX VALUE IX2064.2 +029200 "4.2 ". IX2064.2 +029300 02 FILLER PIC X(28) VALUE IX2064.2 +029400 " COPY - NOT FOR DISTRIBUTION". IX2064.2 +029500 02 FILLER PIC X(41) VALUE SPACE. IX2064.2 +029600 IX2064.2 +029700 01 CCVS-H-2B. IX2064.2 +029800 02 FILLER PIC X(15) VALUE IX2064.2 +029900 "TEST RESULT OF ". IX2064.2 +030000 02 TEST-ID PIC X(9). IX2064.2 +030100 02 FILLER PIC X(4) VALUE IX2064.2 +030200 " IN ". IX2064.2 +030300 02 FILLER PIC X(12) VALUE IX2064.2 +030400 " HIGH ". IX2064.2 +030500 02 FILLER PIC X(22) VALUE IX2064.2 +030600 " LEVEL VALIDATION FOR ". IX2064.2 +030700 02 FILLER PIC X(58) VALUE IX2064.2 +030800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +030900 01 CCVS-H-3. IX2064.2 +031000 02 FILLER PIC X(34) VALUE IX2064.2 +031100 " FOR OFFICIAL USE ONLY ". IX2064.2 +031200 02 FILLER PIC X(58) VALUE IX2064.2 +031300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2064.2 +031400 02 FILLER PIC X(28) VALUE IX2064.2 +031500 " COPYRIGHT 1985 ". IX2064.2 +031600 01 CCVS-E-1. IX2064.2 +031700 02 FILLER PIC X(52) VALUE SPACE. IX2064.2 +031800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2064.2 +031900 02 ID-AGAIN PIC X(9). IX2064.2 +032000 02 FILLER PIC X(45) VALUE SPACES. IX2064.2 +032100 01 CCVS-E-2. IX2064.2 +032200 02 FILLER PIC X(31) VALUE SPACE. IX2064.2 +032300 02 FILLER PIC X(21) VALUE SPACE. IX2064.2 +032400 02 CCVS-E-2-2. IX2064.2 +032500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2064.2 +032600 03 FILLER PIC X VALUE SPACE. IX2064.2 +032700 03 ENDER-DESC PIC X(44) VALUE IX2064.2 +032800 "ERRORS ENCOUNTERED". IX2064.2 +032900 01 CCVS-E-3. IX2064.2 +033000 02 FILLER PIC X(22) VALUE IX2064.2 +033100 " FOR OFFICIAL USE ONLY". IX2064.2 +033200 02 FILLER PIC X(12) VALUE SPACE. IX2064.2 +033300 02 FILLER PIC X(58) VALUE IX2064.2 +033400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +033500 02 FILLER PIC X(13) VALUE SPACE. IX2064.2 +033600 02 FILLER PIC X(15) VALUE IX2064.2 +033700 " COPYRIGHT 1985". IX2064.2 +033800 01 CCVS-E-4. IX2064.2 +033900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2064.2 +034000 02 FILLER PIC X(4) VALUE " OF ". IX2064.2 +034100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2064.2 +034200 02 FILLER PIC X(40) VALUE IX2064.2 +034300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2064.2 +034400 01 XXINFO. IX2064.2 +034500 02 FILLER PIC X(19) VALUE IX2064.2 +034600 "*** INFORMATION ***". IX2064.2 +034700 02 INFO-TEXT. IX2064.2 +034800 04 FILLER PIC X(8) VALUE SPACE. IX2064.2 +034900 04 XXCOMPUTED PIC X(20). IX2064.2 +035000 04 FILLER PIC X(5) VALUE SPACE. IX2064.2 +035100 04 XXCORRECT PIC X(20). IX2064.2 +035200 02 INF-ANSI-REFERENCE PIC X(48). IX2064.2 +035300 01 HYPHEN-LINE. IX2064.2 +035400 02 FILLER PIC IS X VALUE IS SPACE. IX2064.2 +035500 02 FILLER PIC IS X(65) VALUE IS "************************IX2064.2 +035600- "*****************************************". IX2064.2 +035700 02 FILLER PIC IS X(54) VALUE IS "************************IX2064.2 +035800- "******************************". IX2064.2 +035900 01 CCVS-PGM-ID PIC X(9) VALUE IX2064.2 +036000 "IX206A". IX2064.2 +036100 PROCEDURE DIVISION. IX2064.2 +036200 CCVS1 SECTION. IX2064.2 +036300 OPEN-FILES. IX2064.2 +036400P OPEN I-O RAW-DATA. IX2064.2 +036500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2064.2 +036600P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2064.2 +036700P MOVE "ABORTED " TO C-ABORT. IX2064.2 +036800P ADD 1 TO C-NO-OF-TESTS. IX2064.2 +036900P ACCEPT C-DATE FROM DATE. IX2064.2 +037000P ACCEPT C-TIME FROM TIME. IX2064.2 +037100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2064.2 +037200PEND-E-1. IX2064.2 +037300P CLOSE RAW-DATA. IX2064.2 +037400 OPEN OUTPUT PRINT-FILE. IX2064.2 +037500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2064.2 +037600 MOVE SPACE TO TEST-RESULTS. IX2064.2 +037700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2064.2 +037800 MOVE ZERO TO REC-SKL-SUB. IX2064.2 +037900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2064.2 +038000 CCVS-INIT-FILE. IX2064.2 +038100 ADD 1 TO REC-SKL-SUB. IX2064.2 +038200 MOVE FILE-RECORD-INFO-SKELETON IX2064.2 +038300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2064.2 +038400 CCVS-INIT-EXIT. IX2064.2 +038500 GO TO CCVS1-EXIT. IX2064.2 +038600 CLOSE-FILES. IX2064.2 +038700P OPEN I-O RAW-DATA. IX2064.2 +038800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2064.2 +038900P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2064.2 +039000P MOVE "OK. " TO C-ABORT. IX2064.2 +039100P MOVE PASS-COUNTER TO C-OK. IX2064.2 +039200P MOVE ERROR-HOLD TO C-ALL. IX2064.2 +039300P MOVE ERROR-COUNTER TO C-FAIL. IX2064.2 +039400P MOVE DELETE-COUNTER TO C-DELETED. IX2064.2 +039500P MOVE INSPECT-COUNTER TO C-INSPECT. IX2064.2 +039600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2064.2 +039700PEND-E-2. IX2064.2 +039800P CLOSE RAW-DATA. IX2064.2 +039900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2064.2 +040000 TERMINATE-CCVS. IX2064.2 +040100S EXIT PROGRAM. IX2064.2 +040200STERMINATE-CALL. IX2064.2 +040300 STOP RUN. IX2064.2 +040400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2064.2 +040500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2064.2 +040600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2064.2 +040700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2064.2 +040800 MOVE "****TEST DELETED****" TO RE-MARK. IX2064.2 +040900 PRINT-DETAIL. IX2064.2 +041000 IF REC-CT NOT EQUAL TO ZERO IX2064.2 +041100 MOVE "." TO PARDOT-X IX2064.2 +041200 MOVE REC-CT TO DOTVALUE. IX2064.2 +041300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2064.2 +041400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2064.2 +041500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2064.2 +041600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2064.2 +041700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2064.2 +041800 MOVE SPACE TO CORRECT-X. IX2064.2 +041900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2064.2 +042000 MOVE SPACE TO RE-MARK. IX2064.2 +042100 HEAD-ROUTINE. IX2064.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2064.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2064.2 +042600 COLUMN-NAMES-ROUTINE. IX2064.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +043000 END-ROUTINE. IX2064.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2064.2 +043200 END-RTN-EXIT. IX2064.2 +043300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +043400 END-ROUTINE-1. IX2064.2 +043500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2064.2 +043600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2064.2 +043700 ADD PASS-COUNTER TO ERROR-HOLD. IX2064.2 +043800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2064.2 +043900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2064.2 +044000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2064.2 +044100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2064.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2064.2 +044300 END-ROUTINE-12. IX2064.2 +044400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2064.2 +044500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2064.2 +044600 MOVE "NO " TO ERROR-TOTAL IX2064.2 +044700 ELSE IX2064.2 +044800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2064.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2064.2 +045000 PERFORM WRITE-LINE. IX2064.2 +045100 END-ROUTINE-13. IX2064.2 +045200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2064.2 +045300 MOVE "NO " TO ERROR-TOTAL ELSE IX2064.2 +045400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2064.2 +045500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2064.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +045700 IF INSPECT-COUNTER EQUAL TO ZERO IX2064.2 +045800 MOVE "NO " TO ERROR-TOTAL IX2064.2 +045900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2064.2 +046000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2064.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +046200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +046300 WRITE-LINE. IX2064.2 +046400 ADD 1 TO RECORD-COUNT. IX2064.2 +046500Y IF RECORD-COUNT GREATER 42 IX2064.2 +046600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2064.2 +046700Y MOVE SPACE TO DUMMY-RECORD IX2064.2 +046800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2064.2 +046900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2064.2 +047000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2064.2 +047100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2064.2 +047200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2064.2 +047300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2064.2 +047700Y MOVE ZERO TO RECORD-COUNT. IX2064.2 +047800 PERFORM WRT-LN. IX2064.2 +047900 WRT-LN. IX2064.2 +048000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2064.2 +048100 MOVE SPACE TO DUMMY-RECORD. IX2064.2 +048200 BLANK-LINE-PRINT. IX2064.2 +048300 PERFORM WRT-LN. IX2064.2 +048400 FAIL-ROUTINE. IX2064.2 +048500 IF COMPUTED-X NOT EQUAL TO SPACE IX2064.2 +048600 GO TO FAIL-ROUTINE-WRITE. IX2064.2 +048700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2064.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2064.2 +048900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2064.2 +049000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2064.2 +049200 GO TO FAIL-ROUTINE-EX. IX2064.2 +049300 FAIL-ROUTINE-WRITE. IX2064.2 +049400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2064.2 +049500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2064.2 +049600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2064.2 +049700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2064.2 +049800 FAIL-ROUTINE-EX. EXIT. IX2064.2 +049900 BAIL-OUT. IX2064.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2064.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2064.2 +050200 BAIL-OUT-WRITE. IX2064.2 +050300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2064.2 +050400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2064.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2064.2 +050700 BAIL-OUT-EX. EXIT. IX2064.2 +050800 CCVS1-EXIT. IX2064.2 +050900 EXIT. IX2064.2 +051000 SECT-IX-01-001 SECTION. IX2064.2 +051100 WRITE-INIT-GF-01. IX2064.2 +051200 OPEN OUTPUT IX-FD1. IX2064.2 +051300 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +051400 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +051500 MOVE "IX-FD1" TO XFILE-NAME (1). IX2064.2 +051600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2064.2 +051700 MOVE 000001 TO XRECORD-NUMBER (1). IX2064.2 +051800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2064.2 +051900 MOVE 200 TO RECORDS-IN-FILE (1). IX2064.2 +052000 MOVE 240 TO XRECORD-LENGTH (1). IX2064.2 +052100 MOVE 0020 TO XBLOCK-SIZE (1). IX2064.2 +052200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2064.2 +052300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2064.2 +052400 MOVE "S" TO XLABEL-TYPE (1). IX2064.2 +052500 MOVE 000200 TO WRK-DU-10V00-002 IX2064.2 +052600 MOVE "FILE CREATED" TO RE-MARK. IX2064.2 +052700 WRITE-TEST-GF-01-R. IX2064.2 +052800 MOVE XRECORD-NUMBER (1) TO WRK-DU-10V00-001. IX2064.2 +052900 MOVE WRK-REC-KEY-FD1 TO XRECORD-KEY (1). IX2064.2 +053000 MOVE WRK-ALT1-KEY-FD1 TO ALTERNATE-KEY1 (1). IX2064.2 +053100 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2064.2 +053200 WRITE IX-FD1R1-F-G-240 IX2064.2 +053300 INVALID KEY GO TO WRITE-TEST-GF-01. IX2064.2 +053400 IF XRECORD-NUMBER (1) NOT LESS THAN FD1-FILE-SIZE IX2064.2 +053500 GO TO WRITE-TEST-GF-01. IX2064.2 +053600 ADD 000001 TO XRECORD-NUMBER (1). IX2064.2 +053700 SUBTRACT 000001 FROM WRK-DU-10V00-002. IX2064.2 +053800 GO TO WRITE-TEST-GF-01-R. IX2064.2 +053900 WRITE-TEST-GF-01. IX2064.2 +054000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2064.2 +054100 MOVE "WRITE IX-FD1" TO FEATURE. IX2064.2 +054200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2064.2 +054300 MOVE FD1-FILE-SIZE TO CORRECT-18V0. IX2064.2 +054400 IF XRECORD-NUMBER (1) EQUAL TO FD1-FILE-SIZE IX2064.2 +054500 PERFORM PASS IX2064.2 +054600 ELSE IX2064.2 +054700 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +054800 PERFORM FAIL. IX2064.2 +054900 PERFORM PRINT-DETAIL. IX2064.2 +055000* IX2064.2 +055100* IX2064.2 +055200 CLOSE IX-FD1. IX2064.2 +055300 READ-INIT-F1-01. IX2064.2 +055400 OPEN INPUT IX-FD1. IX2064.2 +055500 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +055600 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +055700 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +055800 READ-TEST-F1-01-3. IX2064.2 +055900 ADD 1 TO WRK-DU-10V00-001. IX2064.2 +056000 READ IX-FD1 IX2064.2 +056100 NEXT RECORD IX2064.2 +056200 AT END IX2064.2 +056300 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +056400* IX2064.2 +056500* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +056600* HAS BEEN TAKEN. IX2064.2 +056700* IX2064.2 +056800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +056900 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +057000 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +057100* IX2064.2 +057200* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2064.2 +057300* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +057400* IX2064.2 +057500 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +057600 IF WRK-CS-09V00-001 GREATER THAN 24 IX2064.2 +057700 GO TO READ-TEST-F1-01. IX2064.2 +057800 GO TO READ-TEST-F1-01-3. IX2064.2 +057900 READ-TEST-F1-01. IX2064.2 +058000 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2064.2 +058100 MOVE "READ SEQUENTIAL" TO FEATURE. IX2064.2 +058200 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +058300 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +058400 PERFORM FAIL IX2064.2 +058500 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +058600 MOVE ZERO TO CORRECT-18V0 IX2064.2 +058700 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +058800 ELSE IX2064.2 +058900 PERFORM PASS. IX2064.2 +059000 PERFORM PRINT-DETAIL. IX2064.2 +059100* IX2064.2 +059200* IX2064.2 +059300 READ-INIT-F2-02. IX2064.2 +059400 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +059500 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +059600 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +059700 READ-TEST-F2-02-5. IX2064.2 +059800 ADD 10 TO WRK-DU-10V00-001. IX2064.2 +059900 MOVE WRK-DU-10V00-001 TO IX-FD1-KEY IX2064.2 +060000 READ IX-FD1 RECORD IX2064.2 +060100 INVALID KEY IX2064.2 +060200 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +060300* IX2064.2 +060400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2064.2 +060500* PATH HAS BEEN TAKEN. IX2064.2 +060600* IX2064.2 +060700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +060800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +060900 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +061000* IX2064.2 +061100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2064.2 +061200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +061300* IX2064.2 +061400 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +061500 IF WRK-CS-09V00-001 GREATER THAN 10 IX2064.2 +061600 NEXT SENTENCE ELSE IX2064.2 +061700 GO TO READ-TEST-F2-02-5. IX2064.2 +061800 READ-TEST-F2-02. IX2064.2 +061900 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2064.2 +062000 MOVE "READ RANDOM " TO FEATURE. IX2064.2 +062100 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +062200 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +062300 PERFORM FAIL IX2064.2 +062400 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +062500 MOVE ZERO TO CORRECT-18V0 IX2064.2 +062600 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +062700 ELSE IX2064.2 +062800 PERFORM PASS. IX2064.2 +062900 PERFORM PRINT-DETAIL. IX2064.2 +063000* IX2064.2 +063100* IX2064.2 +063200 READ-INIT-F2-03. IX2064.2 +063300 MOVE 0000000200 TO WRK-DU-10V00-001. IX2064.2 +063400 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2064.2 +063500 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2064.2 +063600 MOVE 0000000001 TO WRK-DU-10V00-002. IX2064.2 +063700 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +063800 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2064.2 +063900 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +064000 START IX-FD1 IX2064.2 +064100 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2064.2 +064200 INVALID KEY IX2064.2 +064300 ADD 1000000 TO WRK-DU-10V00-002. IX2064.2 +064400* IX2064.2 +064500* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2064.2 +064600* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2064.2 +064700* IX2064.2 +064800 READ-TEST-F2-03-7. IX2064.2 +064900 READ IX-FD1 IX2064.2 +065000 NEXT RECORD IX2064.2 +065100 AT END IX2064.2 +065200 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +065300* IX2064.2 +065400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +065500* HAS BEEN TAKEN ON THE READ STATEMENT. IX2064.2 +065600* IX2064.2 +065700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +065800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +065900 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +066000* IX2064.2 +066100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2064.2 +066200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +066300* IX2064.2 +066400 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2064.2 +066500 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +066600 IF WRK-CS-09V00-001 GREATER THAN 25 IX2064.2 +066700 NEXT SENTENCE ELSE IX2064.2 +066800 GO TO READ-TEST-F2-03-7. IX2064.2 +066900 READ-TEST-F2-03. IX2064.2 +067000 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2064.2 +067100 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2064.2 +067200 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +067300 PERFORM FAIL IX2064.2 +067400 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +067500 MOVE ZERO TO CORRECT-18V0 IX2064.2 +067600 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +067700 ELSE IX2064.2 +067800 PERFORM PASS. IX2064.2 +067900 PERFORM PRINT-DETAIL. IX2064.2 +068000 CLOSE IX-FD1. IX2064.2 +068100 INX-EXIT-001. IX2064.2 +068200 EXIT. IX2064.2 +068300 SECT-IX-01-002 SECTION. IX2064.2 +068400 WRITE-INIT-GF-02. IX2064.2 +068500 OPEN OUTPUT IX-FS1. IX2064.2 +068600 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +068700 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +068800 MOVE "IX-FS1" TO XFILE-NAME (2). IX2064.2 +068900 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2064.2 +069000 MOVE 000001 TO XRECORD-NUMBER (2). IX2064.2 +069100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2064.2 +069200 MOVE 000240 TO XRECORD-LENGTH (2). IX2064.2 +069300 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2064.2 +069400 MOVE 0001 TO XBLOCK-SIZE (2). IX2064.2 +069500 MOVE 0000200 TO RECORDS-IN-FILE (2). IX2064.2 +069600 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2064.2 +069700 MOVE "S" TO XLABEL-TYPE (2). IX2064.2 +069800 MOVE 000200 TO WRK-DU-10V00-004. IX2064.2 +069900 MOVE "FILE CREATED" TO RE-MARK. IX2064.2 +070000 MOVE "SEQUENTIAL MODE" TO FEATURE. IX2064.2 +070100 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2064.2 +070200 WRITE-TEST-GF-02-R. IX2064.2 +070300 MOVE XRECORD-NUMBER (2) TO WRK-DU-10V00-003. IX2064.2 +070400 MOVE WRK-REC-KEY-FS1 TO XRECORD-KEY (2). IX2064.2 +070500 MOVE WRK-ALT1-KEY-FS1 TO ALTERNATE-KEY1 (2). IX2064.2 +070600 MOVE FILE-RECORD-INFO (2) TO IX-FS1R1-F-G-240. IX2064.2 +070700 WRITE IX-FS1R1-F-G-240 IX2064.2 +070800 INVALID KEY GO TO WRITE-TEST-GF-02. IX2064.2 +070900 IF XRECORD-NUMBER (2) NOT LESS THAN FS1-FILE-SIZE IX2064.2 +071000 GO TO WRITE-TEST-GF-02. IX2064.2 +071100 ADD 000001 TO XRECORD-NUMBER (2). IX2064.2 +071200 SUBTRACT 000001 FROM WRK-DU-10V00-004. IX2064.2 +071300 GO TO WRITE-TEST-GF-02-R. IX2064.2 +071400 WRITE-TEST-GF-02. IX2064.2 +071500 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX2064.2 +071600 MOVE FS1-FILE-SIZE TO CORRECT-18V0. IX2064.2 +071700 IF XRECORD-NUMBER (2) EQUAL TO FS1-FILE-SIZE IX2064.2 +071800 PERFORM PASS IX2064.2 +071900 ELSE IX2064.2 +072000 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +072100 PERFORM FAIL. IX2064.2 +072200 PERFORM PRINT-DETAIL. IX2064.2 +072300* IX2064.2 +072400* IX2064.2 +072500 CLOSE IX-FS1. IX2064.2 +072600 READ-INIT-F1-04. IX2064.2 +072700 OPEN INPUT IX-FS1. IX2064.2 +072800 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +072900 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +073000 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +073100 READ-TEST-F1-04-3. IX2064.2 +073200 ADD 1 TO WRK-DU-10V00-003. IX2064.2 +073300 READ IX-FS1 IX2064.2 +073400 AT END IX2064.2 +073500 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +073600* IX2064.2 +073700* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +073800* HAS BEEN TAKEN. IX2064.2 +073900* IX2064.2 +074000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (2). IX2064.2 +074100 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2064.2 +074200 ADD 1 TO WRK-DU-10V00-004. IX2064.2 +074300* IX2064.2 +074400* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2064.2 +074500* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +074600* IX2064.2 +074700 ADD 000000001 TO WRK-CS-09V00-001. IX2064.2 +074800 IF WRK-CS-09V00-001 GREATER THAN 24 IX2064.2 +074900 NEXT SENTENCE ELSE IX2064.2 +075000 GO TO READ-TEST-F1-04-3. IX2064.2 +075100 READ-TEST-F1-04. IX2064.2 +075200 MOVE "READE-TEST-F1-04" TO PAR-NAME. IX2064.2 +075300 MOVE "READ SEQUENTIAL " TO FEATURE. IX2064.2 +075400 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2064.2 +075500 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +075600 PERFORM FAIL IX2064.2 +075700 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2064.2 +075800 MOVE ZERO TO CORRECT-18V0 IX2064.2 +075900 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +076000 ELSE IX2064.2 +076100 PERFORM PASS. IX2064.2 +076200 PERFORM PRINT-DETAIL. IX2064.2 +076300* IX2064.2 +076400* IX2064.2 +076500 READ-TEST-F2-05-4. IX2064.2 +076600 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +076700 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +076800 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +076900 READ-TEST-F2-05-5. IX2064.2 +077000 MOVE 00000200 TO WRK-DU-10V00-003. IX2064.2 +077100 MOVE WRK-REC-KEY-FS1 TO IX-FS1-REC-KEY. IX2064.2 +077200 MOVE FS1-FILE-SIZE TO WRK-DU-10V00-003. IX2064.2 +077300 MOVE 000000001 TO WRK-DU-10V00-004. IX2064.2 +077400 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +077500 MOVE WRK-ALT1-KEY-FS1 TO IX-FS1-ALT1-KEY. IX2064.2 +077600 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +077700 START IX-FS1 IX2064.2 +077800 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2064.2 +077900 INVALID KEY ADD 1000000 TO WRK-DU-10V00-004. IX2064.2 +078000* IX2064.2 +078100* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2064.2 +078200* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2064.2 +078300* IX2064.2 +078400 READ-TEST-F2-05-6. IX2064.2 +078500 READ IX-FS1 IX2064.2 +078600 AT END IX2064.2 +078700 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +078800* IX2064.2 +078900* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +079000* HAS BEEN TAKEN. IX2064.2 +079100* IX2064.2 +079200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (2). IX2064.2 +079300 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2064.2 +079400 ADD 1 TO WRK-DU-10V00-004. IX2064.2 +079500* IX2064.2 +079600* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2064.2 +079700* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +079800* IX2064.2 +079900 SUBTRACT 1 FROM WRK-DU-10V00-003. IX2064.2 +080000 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +080100 IF WRK-CS-09V00-001 GREATER THAN 25 IX2064.2 +080200 NEXT SENTENCE ELSE IX2064.2 +080300 GO TO READ-TEST-F2-05-6. IX2064.2 +080400 READ-TEST-F2-05. IX2064.2 +080500 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2064.2 +080600 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2064.2 +080700 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2064.2 +080800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +080900 PERFORM FAIL IX2064.2 +081000 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2064.2 +081100 MOVE ZERO TO CORRECT-18V0 IX2064.2 +081200 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +081300 ELSE IX2064.2 +081400 PERFORM PASS. IX2064.2 +081500 PERFORM PRINT-DETAIL. IX2064.2 +081600 CLOSE IX-FS1. IX2064.2 +081700 INX-EXIT-002. IX2064.2 +081800 EXIT. IX2064.2 +081900 READ-INIT-F1-06. IX2064.2 +082000 OPEN INPUT IX-FD1. IX2064.2 +082100 OPEN INPUT IX-FS1. IX2064.2 +082200 MOVE SPACE TO FILE-RECORD-INFO (9). IX2064.2 +082300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2064.2 +082400 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +082500 MOVE SPACES TO IX-FD1R1-F-G-240. IX2064.2 +082600 MOVE SPACES TO IX-FS1R1-F-G-240. IX2064.2 +082700 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX2064.2 +082800 MOVE "SAME AREA" TO FEATURE. IX2064.2 +082900 READ-TEST-F1-06. IX2064.2 +083000 READ IX-FD1 IX2064.2 +083100 NEXT RECORD IX2064.2 +083200 AT END IX2064.2 +083300 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +083400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +083500 IF XFILE-NAME (1) EQUAL TO "IX-FD1" IX2064.2 +083600 PERFORM PASS IX2064.2 +083700 ELSE IX2064.2 +083800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +083900 PERFORM FAIL IX2064.2 +084000 MOVE XFILE-NAME (1) TO COMPUTED-A IX2064.2 +084100 MOVE "IX-FD1" TO CORRECT-A. IX2064.2 +084200 PERFORM PRINT-DETAIL. IX2064.2 +084300* IX2064.2 +084400* IX2064.2 +084500 READ-TEST-F1-07. IX2064.2 +084600 MOVE "READ-TEST-F1-07 " TO PAR-NAME. IX2064.2 +084700 MOVE "SAME AREA " TO FEATURE. IX2064.2 +084800 READ IX-FS1 IX2064.2 +084900 AT END IX2064.2 +085000 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +085100* IX2064.2 +085200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2064.2 +085300* PATH HAS BEEN TAKEN. IX2064.2 +085400* IX2064.2 +085500 IF WRK-DU-10V00-004 EQUAL TO ZERO IX2064.2 +085600 PERFORM PASS IX2064.2 +085700 ELSE IX2064.2 +085800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +085900 PERFORM FAIL IX2064.2 +086000 MOVE WRK-DU-10V00-004 TO COMPUTED-A IX2064.2 +086100 MOVE ZERO TO CORRECT-A IX2064.2 +086200 MOVE "SEE PROGRAM" TO RE-MARK. IX2064.2 +086300 PERFORM PRINT-DETAIL. IX2064.2 +086400* IX2064.2 +086500* IX2064.2 +086600 READ-TEST-F1-08. IX2064.2 +086700 MOVE "READ-TEST-F1-08 " TO PAR-NAME. IX2064.2 +086800 MOVE "SAME AREA " TO FEATURE. IX2064.2 +086900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (9). IX2064.2 +087000* IX2064.2 +087100* NOTE IN TESTING THE SAME AREA CLAUSE THE RECORD AREA IX2064.2 +087200* SHOULD BE SHARED BY BOTH FILES IX-FD1 AND IX-FS1, IX2064.2 +087300* THEREFORE FILE IX-FS1 IS READ AND THE RECORD IX2064.2 +087400* IDENTIFIED FOR IX-FD1 IS ACCESSED AND TESTED FOR IX2064.2 +087500* EXPECTED PRESENCE OF IX-FS1 FILE RECORD CONTENTS. IX2064.2 +087600* IX2064.2 +087700 IF XFILE-NAME (9) EQUAL TO "IX-FS1" IX2064.2 +087800 PERFORM PASS IX2064.2 +087900 ELSE IX2064.2 +088000 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +088100 PERFORM FAIL IX2064.2 +088200 MOVE XFILE-NAME (9) TO COMPUTED-A IX2064.2 +088300 MOVE "IX-FS1" TO CORRECT-A IX2064.2 +088400 MOVE "SEE PROGRAM" TO RE-MARK. IX2064.2 +088500 PERFORM PRINT-DETAIL. IX2064.2 +088600 CLOSE IX-FS1. IX2064.2 +088700 CLOSE IX-FD1. IX2064.2 +088800 INX-EXIT-003. IX2064.2 +088900 EXIT. IX2064.2 +089000 CCVS-EXIT SECTION. IX2064.2 +089100 CCVS-999999. IX2064.2 +089200 GO TO CLOSE-FILES. IX2064.2 +*END-OF,IX206A +*HEADER,COBOL,IX207A +000100 IDENTIFICATION DIVISION. IX2074.2 +000200 PROGRAM-ID. IX2074.2 +000300 IX207A. IX2074.2 +000400**************************************************************** IX2074.2 +000500* * IX2074.2 +000600* VALIDATION FOR:- * IX2074.2 +000700* * IX2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +000900* * IX2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2074.2 +001100* * IX2074.2 +001200**************************************************************** IX2074.2 +001300*IX207A IX2074.2 +001400******************************************************************IX2074.2 +001500*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLEIX2074.2 +001600* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2074.2 +001700* LEVEL 2 OF INDEXED I-O. THE ELEMENTS TESTED IN THIS IX2074.2 +001800* ROUTINE ARE: IX2074.2 +001900* IX2074.2 +002000* (1) ORDERING OF CLAUSES IN FILE-CONTROL-ENTRY; IX2074.2 +002100* (2) ALTERNATE RECORD KEY WITH THE DUPLICATES OPTION; IX2074.2 +002200* (3) USE AFTER STANDARD EXCEPTION FILE-NAME-1, FILE-NAME-2; IX2074.2 +002300* (4) FILE STATUS. IX2074.2 +002400* IX2074.2 +002500* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2074.2 +002600* ROUTINE. FILES ARE CREATED AND ACCESSED IN THE SEQUENTIAL IX2074.2 +002700* ACCESS MODE. IX2074.2 +002800* IX2074.2 +002900* IX2074.2 +003000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2074.2 +003100* IX2074.2 +003200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2074.2 +003300* CLAUSE FOR DATA FILE IX-FS1 IX2074.2 +003400* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2074.2 +003500* CLAUSE FOR DATA FILE IX-FD2 IX2074.2 +003600* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2074.2 +003700* CLAUSE FOR INDEX FILE IX-FS1 IX2074.2 +003800* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2074.2 +003900* CLAUSE FOR INDEX FILE IX-FD2 IX2074.2 +004000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2074.2 +004100* X-62 FOR RAW-DATA IX2074.2 +004200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2074.2 +004300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2074.2 +004400* X-84 LABEL RECORDS FOR PRINT-FILE IX2074.2 +004500* IX2074.2 +004600* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2074.2 +004700* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2074.2 +004800* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2074.2 +004900* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2074.2 +005000* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2074.2 +005100* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2074.2 +005200* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2074.2 +005300* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2074.2 +005400* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2074.2 +005500* THEY ARE AS FOLLOWS IX2074.2 +005600* IX2074.2 +005700* P SELECTS X-CARDS 62 IX2074.2 +005800* C SELECTS X-CARDS 84 IX2074.2 +005900* IX2074.2 +006000* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX2074.2 +006100* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX2074.2 +006200* CODE IS IDENTIFIED BY THE LETTER T,U OR X IN IX2074.2 +006300* POSITION 7 OF THE SOURCE LINE. USE OF IX2074.2 +006400* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS IX2074.2 +006500* OF THE FILES AFTER THE TEST REPORT. FOR CODE IX2074.2 +006600* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX2074.2 +006700* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX2074.2 +006800* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX2074.2 +006900* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX2074.2 +007000* AN INDEXED KEY NO GREATER THAN 8 CHARACTERS. IX2074.2 +007100* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX2074.2 +007200* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX2074.2 +007300* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX2074.2 +007400* CARD. IX2074.2 +007500* IX2074.2 +007600****************************************************** IX2074.2 +007700 ENVIRONMENT DIVISION. IX2074.2 +007800 CONFIGURATION SECTION. IX2074.2 +007900 SOURCE-COMPUTER. IX2074.2 +008000 XXXXX082. IX2074.2 +008100 OBJECT-COMPUTER. IX2074.2 +008200 XXXXX083. IX2074.2 +008300 INPUT-OUTPUT SECTION. IX2074.2 +008400 FILE-CONTROL. IX2074.2 +008500P SELECT RAW-DATA ASSIGN TO IX2074.2 +008600P XXXXX062 IX2074.2 +008700P ORGANIZATION IS INDEXED IX2074.2 +008800P ACCESS MODE IS RANDOM IX2074.2 +008900P RECORD KEY IS RAW-DATA-KEY. IX2074.2 +009000 SELECT PRINT-FILE ASSIGN TO IX2074.2 +009100 XXXXX055. IX2074.2 +009200 IX2074.2 +009300 SELECT IX-FS1 IX2074.2 +009400 ACCESS MODE IS SEQUENTIAL IX2074.2 +009500 ALTERNATE RECORD IX-FS1-ALTKEY1 IX2074.2 +009600 WITH DUPLICATES IX2074.2 +009700 FILE STATUS FS1-STATUS IX2074.2 +009800 RECORD KEY IS IX-FS1-KEY IX2074.2 +009900 ORGANIZATION IS INDEXED IX2074.2 +010000 ASSIGN TO IX2074.2 +010100J XXXXX044 IX2074.2 +010200 XXXXX024. IX2074.2 +010300 IX2074.2 +010400 SELECT IX-FS2 IX2074.2 +010500 ASSIGN TO IX2074.2 +010600 XXXXX025 IX2074.2 +010700J XXXXX045 IX2074.2 +010800 ORGANIZATION IS INDEXED IX2074.2 +010900 ALTERNATE RECORD KEY IX-FS2-ALTKEY1 IX2074.2 +011000 DUPLICATES IX2074.2 +011100 RECORD KEY IS IX-FS2-KEY. IX2074.2 +011200 IX2074.2 +011300 DATA DIVISION. IX2074.2 +011400 FILE SECTION. IX2074.2 +011500P IX2074.2 +011600PFD RAW-DATA. IX2074.2 +011700P IX2074.2 +011800P01 RAW-DATA-SATZ. IX2074.2 +011900P 05 RAW-DATA-KEY PIC X(6). IX2074.2 +012000P 05 C-DATE PIC 9(6). IX2074.2 +012100P 05 C-TIME PIC 9(8). IX2074.2 +012200P 05 C-NO-OF-TESTS PIC 99. IX2074.2 +012300P 05 C-OK PIC 999. IX2074.2 +012400P 05 C-ALL PIC 999. IX2074.2 +012500P 05 C-FAIL PIC 999. IX2074.2 +012600P 05 C-DELETED PIC 999. IX2074.2 +012700P 05 C-INSPECT PIC 999. IX2074.2 +012800P 05 C-NOTE PIC X(13). IX2074.2 +012900P 05 C-INDENT PIC X. IX2074.2 +013000P 05 C-ABORT PIC X(8). IX2074.2 +013100 FD PRINT-FILE. IX2074.2 +013200 01 PRINT-REC PICTURE X(120). IX2074.2 +013300 01 DUMMY-RECORD PICTURE X(120). IX2074.2 +013400 FD IX-FS1 IX2074.2 +013500C LABEL RECORD IS STANDARD IX2074.2 +013600C DATA RECORD IS IX-FS1R1-F-G-240 IX2074.2 +013700 RECORD CONTAINS 240 CHARACTERS. IX2074.2 +013800 01 IX-FS1R1-F-G-240. IX2074.2 +013900 05 IX-FS1-REC-120 PIC X(120). IX2074.2 +014000 05 IX-FS1-REC-121-240. IX2074.2 +014100 10 FILLER PIC X(8). IX2074.2 +014200 10 IX-FS1-KEY. IX2074.2 +014300 15 IX-FS1-KEYNUM PIC 9(5). IX2074.2 +014400T 15 FILLER PIC X(24). IX2074.2 +014500U 10 FILLER PIC X(24). IX2074.2 +014600 10 FILLER PIC X(9). IX2074.2 +014700 10 IX-FS1-ALTKEY1. IX2074.2 +014800T 15 FILLER PIC X(24). IX2074.2 +014900 15 IX-FS1-ALTKEY1NUM PIC 9(5). IX2074.2 +015000U 10 FILLER PIC X(24). IX2074.2 +015100 10 FILLER PIC X(45). IX2074.2 +015200 FD IX-FS2 IX2074.2 +015300C LABEL RECORDS ARE STANDARD IX2074.2 +015400C DATA RECORD IS IX-FS2R1-F-G-240 IX2074.2 +015500 RECORD CONTAINS 240 CHARACTERS. IX2074.2 +015600 01 IX-FS2R1-F-G-240. IX2074.2 +015700 05 IX-FS2-REC-120 PIC X(120). IX2074.2 +015800 05 IX-FS2-REC-121-240. IX2074.2 +015900 10 FILLER PIC X(8). IX2074.2 +016000 10 IX-FS2-KEY. IX2074.2 +016100 15 IX-FS2-KEYNUM PIC 9(5). IX2074.2 +016200T 15 FILLER PIC A(24). IX2074.2 +016300U 10 FILLER PIC X(24). IX2074.2 +016400 10 FILLER PIC X(9). IX2074.2 +016500 10 IX-FS2-ALTKEY1. IX2074.2 +016600T 15 FILLER PIC X(24). IX2074.2 +016700 15 IX-FS2-ALTKEY1NUM PIC 9(5). IX2074.2 +016800U 10 FILLER PIC X(24). IX2074.2 +016900 10 FILLER PIC X(45). IX2074.2 +017000 WORKING-STORAGE SECTION. IX2074.2 +017100 01 IX-FS1-FILESIZE PIC 9(6) VALUE 300. IX2074.2 +017200 01 IX-FS2-FILESIZE PIC 9(6) VALUE 300. IX2074.2 +017300 01 WRK-FS1-RECKEY. IX2074.2 +017400 03 WRK-DU-05V00-001 PIC 9(5) VALUE ZERO. IX2074.2 +017500T 03 WRK-XN-24V00-001 PIC X(24) VALUE IX2074.2 +017600T "123456789009876543211234". IX2074.2 +017700 01 WRK-FS2-RECKEY. IX2074.2 +017800 03 WRK-DU-05V00-002 PIC 9(5) VALUE ZERO. IX2074.2 +017900T 03 WRK-XN-24V00-002 PIC A(24) VALUE IX2074.2 +018000T "ABCDEFGHIJKLMNOPQRSTUVWX". IX2074.2 +018100 01 WRK-FS1-ALTKEY. IX2074.2 +018200T 03 WRK-XN-24V00-003 PIC X(24) VALUE IX2074.2 +018300T "+-*/=$,;.(()><""<>()).;,$". IX2074.2 +018400* IX2074.2 +018500* THE ALPHNUMERIC POSITIONS OF THE DATA ITEM ABOVE CONTAINS A IX2074.2 +018600* LITERAL VALUE WITH INBEDDED QUOTES. IX2074.2 +018700* IX2074.2 +018800 03 WRK-DU-05V00-003 PIC 9(5) VALUE ZERO. IX2074.2 +018900 01 WRK-FS2-ALTKEY. IX2074.2 +019000T 03 WRK-XN-24V00-003 PIC X(24) VALUE IX2074.2 +019100T "AB12CD34EF56GH78IJ90KL*,". IX2074.2 +019200 03 WRK-DU-05V00-004 PIC 9(5) VALUE ZERO. IX2074.2 +019300 01 WRK-DS-05V00-005 PIC S9(5) VALUE ZERO. IX2074.2 +019400 01 WRK-DS-05V00-006 PIC S9(5) VALUE ZERO. IX2074.2 +019500 01 WRK-DS-05V00-007 PIC S9(5) VALUE ZERO. IX2074.2 +019600 01 WRK-DS-05V00-008 PIC S9(5) VALUE ZERO. IX2074.2 +019700 01 WRK-DS-04V00-001 PIC S9(4) VALUE ZERO. IX2074.2 +019800 01 WRK-DS-04V00-002 PIC S9(4) VALUE ZERO. IX2074.2 +019900 01 FS1-STATUS PIC XX VALUE SPACE. IX2074.2 +020000 01 FILE-RECORD-INFORMATION-REC. IX2074.2 +020100 03 FILE-RECORD-INFO-SKELETON. IX2074.2 +020200 05 FILLER PICTURE X(48) VALUE IX2074.2 +020300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2074.2 +020400 05 FILLER PICTURE X(46) VALUE IX2074.2 +020500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2074.2 +020600 05 FILLER PICTURE X(26) VALUE IX2074.2 +020700 ",LFIL=000000,ORG= ,LBLR= ". IX2074.2 +020800 05 FILLER PICTURE X(37) VALUE IX2074.2 +020900 ",RECKEY= ". IX2074.2 +021000 05 FILLER PICTURE X(38) VALUE IX2074.2 +021100 ",ALTKEY1= ". IX2074.2 +021200 05 FILLER PICTURE X(38) VALUE IX2074.2 +021300 ",ALTKEY2= ". IX2074.2 +021400 05 FILLER PICTURE X(7) VALUE SPACE.IX2074.2 +021500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2074.2 +021600 05 FILE-RECORD-INFO-P1-120. IX2074.2 +021700 07 FILLER PIC X(5). IX2074.2 +021800 07 XFILE-NAME PIC X(6). IX2074.2 +021900 07 FILLER PIC X(8). IX2074.2 +022000 07 XRECORD-NAME PIC X(6). IX2074.2 +022100 07 FILLER PIC X(1). IX2074.2 +022200 07 REELUNIT-NUMBER PIC 9(1). IX2074.2 +022300 07 FILLER PIC X(7). IX2074.2 +022400 07 XRECORD-NUMBER PIC 9(6). IX2074.2 +022500 07 FILLER PIC X(6). IX2074.2 +022600 07 UPDATE-NUMBER PIC 9(2). IX2074.2 +022700 07 FILLER PIC X(5). IX2074.2 +022800 07 ODO-NUMBER PIC 9(4). IX2074.2 +022900 07 FILLER PIC X(5). IX2074.2 +023000 07 XPROGRAM-NAME PIC X(5). IX2074.2 +023100 07 FILLER PIC X(7). IX2074.2 +023200 07 XRECORD-LENGTH PIC 9(6). IX2074.2 +023300 07 FILLER PIC X(7). IX2074.2 +023400 07 CHARS-OR-RECORDS PIC X(2). IX2074.2 +023500 07 FILLER PIC X(1). IX2074.2 +023600 07 XBLOCK-SIZE PIC 9(4). IX2074.2 +023700 07 FILLER PIC X(6). IX2074.2 +023800 07 RECORDS-IN-FILE PIC 9(6). IX2074.2 +023900 07 FILLER PIC X(5). IX2074.2 +024000 07 XFILE-ORGANIZATION PIC X(2). IX2074.2 +024100 07 FILLER PIC X(6). IX2074.2 +024200 07 XLABEL-TYPE PIC X(1). IX2074.2 +024300 05 FILE-RECORD-INFO-P121-240. IX2074.2 +024400 07 FILLER PIC X(8). IX2074.2 +024500 07 XRECORD-KEY PIC X(29). IX2074.2 +024600 07 FILLER PIC X(9). IX2074.2 +024700 07 ALTERNATE-KEY1 PIC X(29). IX2074.2 +024800 07 FILLER PIC X(9). IX2074.2 +024900 07 ALTERNATE-KEY2 PIC X(29). IX2074.2 +025000 07 FILLER PIC X(7). IX2074.2 +025100 01 TEST-RESULTS. IX2074.2 +025200 02 FILLER PIC X VALUE SPACE. IX2074.2 +025300 02 FEATURE PIC X(20) VALUE SPACE. IX2074.2 +025400 02 FILLER PIC X VALUE SPACE. IX2074.2 +025500 02 P-OR-F PIC X(5) VALUE SPACE. IX2074.2 +025600 02 FILLER PIC X VALUE SPACE. IX2074.2 +025700 02 PAR-NAME. IX2074.2 +025800 03 FILLER PIC X(19) VALUE SPACE. IX2074.2 +025900 03 PARDOT-X PIC X VALUE SPACE. IX2074.2 +026000 03 DOTVALUE PIC 99 VALUE ZERO. IX2074.2 +026100 02 FILLER PIC X(8) VALUE SPACE. IX2074.2 +026200 02 RE-MARK PIC X(61). IX2074.2 +026300 01 TEST-COMPUTED. IX2074.2 +026400 02 FILLER PIC X(30) VALUE SPACE. IX2074.2 +026500 02 FILLER PIC X(17) VALUE IX2074.2 +026600 " COMPUTED=". IX2074.2 +026700 02 COMPUTED-X. IX2074.2 +026800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2074.2 +026900 03 COMPUTED-N REDEFINES COMPUTED-A IX2074.2 +027000 PIC -9(9).9(9). IX2074.2 +027100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2074.2 +027200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2074.2 +027300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2074.2 +027400 03 CM-18V0 REDEFINES COMPUTED-A. IX2074.2 +027500 04 COMPUTED-18V0 PIC -9(18). IX2074.2 +027600 04 FILLER PIC X. IX2074.2 +027700 03 FILLER PIC X(50) VALUE SPACE. IX2074.2 +027800 01 TEST-CORRECT. IX2074.2 +027900 02 FILLER PIC X(30) VALUE SPACE. IX2074.2 +028000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2074.2 +028100 02 CORRECT-X. IX2074.2 +028200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2074.2 +028300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2074.2 +028400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2074.2 +028500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2074.2 +028600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2074.2 +028700 03 CR-18V0 REDEFINES CORRECT-A. IX2074.2 +028800 04 CORRECT-18V0 PIC -9(18). IX2074.2 +028900 04 FILLER PIC X. IX2074.2 +029000 03 FILLER PIC X(2) VALUE SPACE. IX2074.2 +029100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2074.2 +029200 01 CCVS-C-1. IX2074.2 +029300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2074.2 +029400- "SS PARAGRAPH-NAME IX2074.2 +029500- " REMARKS". IX2074.2 +029600 02 FILLER PIC X(20) VALUE SPACE. IX2074.2 +029700 01 CCVS-C-2. IX2074.2 +029800 02 FILLER PIC X VALUE SPACE. IX2074.2 +029900 02 FILLER PIC X(6) VALUE "TESTED". IX2074.2 +030000 02 FILLER PIC X(15) VALUE SPACE. IX2074.2 +030100 02 FILLER PIC X(4) VALUE "FAIL". IX2074.2 +030200 02 FILLER PIC X(94) VALUE SPACE. IX2074.2 +030300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2074.2 +030400 01 REC-CT PIC 99 VALUE ZERO. IX2074.2 +030500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2074.2 +031000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2074.2 +031100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2074.2 +031200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2074.2 +031300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2074.2 +031400 01 CCVS-H-1. IX2074.2 +031500 02 FILLER PIC X(39) VALUE SPACES. IX2074.2 +031600 02 FILLER PIC X(42) VALUE IX2074.2 +031700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2074.2 +031800 02 FILLER PIC X(39) VALUE SPACES. IX2074.2 +031900 01 CCVS-H-2A. IX2074.2 +032000 02 FILLER PIC X(40) VALUE SPACE. IX2074.2 +032100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2074.2 +032200 02 FILLER PIC XXXX VALUE IX2074.2 +032300 "4.2 ". IX2074.2 +032400 02 FILLER PIC X(28) VALUE IX2074.2 +032500 " COPY - NOT FOR DISTRIBUTION". IX2074.2 +032600 02 FILLER PIC X(41) VALUE SPACE. IX2074.2 +032700 IX2074.2 +032800 01 CCVS-H-2B. IX2074.2 +032900 02 FILLER PIC X(15) VALUE IX2074.2 +033000 "TEST RESULT OF ". IX2074.2 +033100 02 TEST-ID PIC X(9). IX2074.2 +033200 02 FILLER PIC X(4) VALUE IX2074.2 +033300 " IN ". IX2074.2 +033400 02 FILLER PIC X(12) VALUE IX2074.2 +033500 " HIGH ". IX2074.2 +033600 02 FILLER PIC X(22) VALUE IX2074.2 +033700 " LEVEL VALIDATION FOR ". IX2074.2 +033800 02 FILLER PIC X(58) VALUE IX2074.2 +033900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +034000 01 CCVS-H-3. IX2074.2 +034100 02 FILLER PIC X(34) VALUE IX2074.2 +034200 " FOR OFFICIAL USE ONLY ". IX2074.2 +034300 02 FILLER PIC X(58) VALUE IX2074.2 +034400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2074.2 +034500 02 FILLER PIC X(28) VALUE IX2074.2 +034600 " COPYRIGHT 1985 ". IX2074.2 +034700 01 CCVS-E-1. IX2074.2 +034800 02 FILLER PIC X(52) VALUE SPACE. IX2074.2 +034900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2074.2 +035000 02 ID-AGAIN PIC X(9). IX2074.2 +035100 02 FILLER PIC X(45) VALUE SPACES. IX2074.2 +035200 01 CCVS-E-2. IX2074.2 +035300 02 FILLER PIC X(31) VALUE SPACE. IX2074.2 +035400 02 FILLER PIC X(21) VALUE SPACE. IX2074.2 +035500 02 CCVS-E-2-2. IX2074.2 +035600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2074.2 +035700 03 FILLER PIC X VALUE SPACE. IX2074.2 +035800 03 ENDER-DESC PIC X(44) VALUE IX2074.2 +035900 "ERRORS ENCOUNTERED". IX2074.2 +036000 01 CCVS-E-3. IX2074.2 +036100 02 FILLER PIC X(22) VALUE IX2074.2 +036200 " FOR OFFICIAL USE ONLY". IX2074.2 +036300 02 FILLER PIC X(12) VALUE SPACE. IX2074.2 +036400 02 FILLER PIC X(58) VALUE IX2074.2 +036500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +036600 02 FILLER PIC X(13) VALUE SPACE. IX2074.2 +036700 02 FILLER PIC X(15) VALUE IX2074.2 +036800 " COPYRIGHT 1985". IX2074.2 +036900 01 CCVS-E-4. IX2074.2 +037000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2074.2 +037100 02 FILLER PIC X(4) VALUE " OF ". IX2074.2 +037200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2074.2 +037300 02 FILLER PIC X(40) VALUE IX2074.2 +037400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2074.2 +037500 01 XXINFO. IX2074.2 +037600 02 FILLER PIC X(19) VALUE IX2074.2 +037700 "*** INFORMATION ***". IX2074.2 +037800 02 INFO-TEXT. IX2074.2 +037900 04 FILLER PIC X(8) VALUE SPACE. IX2074.2 +038000 04 XXCOMPUTED PIC X(20). IX2074.2 +038100 04 FILLER PIC X(5) VALUE SPACE. IX2074.2 +038200 04 XXCORRECT PIC X(20). IX2074.2 +038300 02 INF-ANSI-REFERENCE PIC X(48). IX2074.2 +038400 01 HYPHEN-LINE. IX2074.2 +038500 02 FILLER PIC IS X VALUE IS SPACE. IX2074.2 +038600 02 FILLER PIC IS X(65) VALUE IS "************************IX2074.2 +038700- "*****************************************". IX2074.2 +038800 02 FILLER PIC IS X(54) VALUE IS "************************IX2074.2 +038900- "******************************". IX2074.2 +039000 01 CCVS-PGM-ID PIC X(9) VALUE IX2074.2 +039100 "IX207A". IX2074.2 +039200 PROCEDURE DIVISION. IX2074.2 +039300 DECLARATIVES. IX2074.2 +039400 USE-IX207A-TEST SECTION. IX2074.2 +039500 USE AFTER STANDARD EXCEPTION PROCEDURE IX2074.2 +039600 IX-FS1, IX-FS2. IX2074.2 +039700 USE-PAR-001. IX2074.2 +039800 ADD 00001 TO WRK-DS-05V00-006. IX2074.2 +039900 IF WRK-DS-05V00-005 LESS THAN 301 IX2074.2 +040000 GO TO USE-PAR-EXIT. IX2074.2 +040100 USE-PAR-002. IX2074.2 +040200 IF WRK-DS-05V00-006 EQUAL TO 0001 IX2074.2 +040300 MOVE "PASS" TO P-OR-F. IX2074.2 +040400 ADD 1 TO DOTVALUE. IX2074.2 +040500 MOVE "EXCEPTION PROCEDURE EXECUTED" TO RE-MARK. IX2074.2 +040600 MOVE TEST-RESULTS TO PRINT-REC. IX2074.2 +040700 WRITE PRINT-REC. IX2074.2 +040800 USE-PAR-EXIT. IX2074.2 +040900 EXIT. IX2074.2 +041000 END DECLARATIVES. IX2074.2 +041100 CCVS1 SECTION. IX2074.2 +041200 OPEN-FILES. IX2074.2 +041300P OPEN I-O RAW-DATA. IX2074.2 +041400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2074.2 +041500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2074.2 +041600P MOVE "ABORTED " TO C-ABORT. IX2074.2 +041700P ADD 1 TO C-NO-OF-TESTS. IX2074.2 +041800P ACCEPT C-DATE FROM DATE. IX2074.2 +041900P ACCEPT C-TIME FROM TIME. IX2074.2 +042000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2074.2 +042100PEND-E-1. IX2074.2 +042200P CLOSE RAW-DATA. IX2074.2 +042300 OPEN OUTPUT PRINT-FILE. IX2074.2 +042400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2074.2 +042500 MOVE SPACE TO TEST-RESULTS. IX2074.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2074.2 +042700 MOVE ZERO TO REC-SKL-SUB. IX2074.2 +042800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2074.2 +042900 CCVS-INIT-FILE. IX2074.2 +043000 ADD 1 TO REC-SKL-SUB. IX2074.2 +043100 MOVE FILE-RECORD-INFO-SKELETON IX2074.2 +043200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2074.2 +043300 CCVS-INIT-EXIT. IX2074.2 +043400 GO TO CCVS1-EXIT. IX2074.2 +043500 CLOSE-FILES. IX2074.2 +043600P OPEN I-O RAW-DATA. IX2074.2 +043700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2074.2 +043800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2074.2 +043900P MOVE "OK. " TO C-ABORT. IX2074.2 +044000P MOVE PASS-COUNTER TO C-OK. IX2074.2 +044100P MOVE ERROR-HOLD TO C-ALL. IX2074.2 +044200P MOVE ERROR-COUNTER TO C-FAIL. IX2074.2 +044300P MOVE DELETE-COUNTER TO C-DELETED. IX2074.2 +044400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2074.2 +044500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2074.2 +044600PEND-E-2. IX2074.2 +044700P CLOSE RAW-DATA. IX2074.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2074.2 +044900 TERMINATE-CCVS. IX2074.2 +045000S EXIT PROGRAM. IX2074.2 +045100STERMINATE-CALL. IX2074.2 +045200 STOP RUN. IX2074.2 +045300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2074.2 +045400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2074.2 +045500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2074.2 +045600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2074.2 +045700 MOVE "****TEST DELETED****" TO RE-MARK. IX2074.2 +045800 PRINT-DETAIL. IX2074.2 +045900 IF REC-CT NOT EQUAL TO ZERO IX2074.2 +046000 MOVE "." TO PARDOT-X IX2074.2 +046100 MOVE REC-CT TO DOTVALUE. IX2074.2 +046200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +046300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2074.2 +046400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2074.2 +046500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2074.2 +046600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2074.2 +046700 MOVE SPACE TO CORRECT-X. IX2074.2 +046800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2074.2 +046900 MOVE SPACE TO RE-MARK. IX2074.2 +047000 HEAD-ROUTINE. IX2074.2 +047100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2074.2 +047400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2074.2 +047500 COLUMN-NAMES-ROUTINE. IX2074.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +047900 END-ROUTINE. IX2074.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2074.2 +048100 END-RTN-EXIT. IX2074.2 +048200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +048300 END-ROUTINE-1. IX2074.2 +048400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2074.2 +048500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2074.2 +048600 ADD PASS-COUNTER TO ERROR-HOLD. IX2074.2 +048700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2074.2 +048800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2074.2 +048900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2074.2 +049000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2074.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2074.2 +049200 END-ROUTINE-12. IX2074.2 +049300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2074.2 +049400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2074.2 +049500 MOVE "NO " TO ERROR-TOTAL IX2074.2 +049600 ELSE IX2074.2 +049700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2074.2 +049800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2074.2 +049900 PERFORM WRITE-LINE. IX2074.2 +050000 END-ROUTINE-13. IX2074.2 +050100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2074.2 +050200 MOVE "NO " TO ERROR-TOTAL ELSE IX2074.2 +050300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2074.2 +050400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2074.2 +050500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +050600 IF INSPECT-COUNTER EQUAL TO ZERO IX2074.2 +050700 MOVE "NO " TO ERROR-TOTAL IX2074.2 +050800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2074.2 +050900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2074.2 +051000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +051100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +051200 WRITE-LINE. IX2074.2 +051300 ADD 1 TO RECORD-COUNT. IX2074.2 +051400Y IF RECORD-COUNT GREATER 42 IX2074.2 +051500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2074.2 +051600Y MOVE SPACE TO DUMMY-RECORD IX2074.2 +051700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2074.2 +051800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2074.2 +051900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2074.2 +052000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2074.2 +052100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2074.2 +052200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2074.2 +052600Y MOVE ZERO TO RECORD-COUNT. IX2074.2 +052700 PERFORM WRT-LN. IX2074.2 +052800 WRT-LN. IX2074.2 +052900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2074.2 +053000 MOVE SPACE TO DUMMY-RECORD. IX2074.2 +053100 BLANK-LINE-PRINT. IX2074.2 +053200 PERFORM WRT-LN. IX2074.2 +053300 FAIL-ROUTINE. IX2074.2 +053400 IF COMPUTED-X NOT EQUAL TO SPACE IX2074.2 +053500 GO TO FAIL-ROUTINE-WRITE. IX2074.2 +053600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2074.2 +053700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2074.2 +053800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2074.2 +053900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +054000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2074.2 +054100 GO TO FAIL-ROUTINE-EX. IX2074.2 +054200 FAIL-ROUTINE-WRITE. IX2074.2 +054300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2074.2 +054400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2074.2 +054500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2074.2 +054600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2074.2 +054700 FAIL-ROUTINE-EX. EXIT. IX2074.2 +054800 BAIL-OUT. IX2074.2 +054900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2074.2 +055000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2074.2 +055100 BAIL-OUT-WRITE. IX2074.2 +055200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2074.2 +055300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2074.2 +055400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +055500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2074.2 +055600 BAIL-OUT-EX. EXIT. IX2074.2 +055700 CCVS1-EXIT. IX2074.2 +055800 EXIT. IX2074.2 +055900 SECT-IX207A-0001 SECTION. IX2074.2 +056000 WRITE-INT-GF-01. IX2074.2 +056100 OPEN OUTPUT IX-FS1. IX2074.2 +056200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2074.2 +056300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2074.2 +056400 MOVE ZERO TO XRECORD-NUMBER (1). IX2074.2 +056500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2074.2 +056600 MOVE 000240 TO XRECORD-LENGTH (1). IX2074.2 +056700 MOVE 0001 TO XBLOCK-SIZE (1). IX2074.2 +056800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2074.2 +056900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2074.2 +057000 MOVE "S" TO XLABEL-TYPE (1). IX2074.2 +057100 MOVE 000300 TO IX-FS1-FILESIZE IX2074.2 +057200 MOVE 000300 TO RECORDS-IN-FILE (1). IX2074.2 +057300 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +057400 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +057500 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +057600 MOVE 00001 TO WRK-DU-05V00-001. IX2074.2 +057700 MOVE IX-FS1-FILESIZE TO WRK-DU-05V00-003. IX2074.2 +057800 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +057900 MOVE 00001 TO WRK-DS-05V00-007. IX2074.2 +058000 MOVE "TESTED FEATURES: "IX2074.2 +058100 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058200 MOVE "ORDERING OF CLAUSES IN SELECT STATEMENT IX-8 2.3.3 (1)"IX2074.2 +058300 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058400 MOVE "ALERNATE RECORD KEY WITH DUPLICATES; IX-11 "IX2074.2 +058500 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058600 MOVE "USE AFTER STANDARD EXECPTION; IX-39 "IX2074.2 +058700 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058800 MOVE "FILE STATUS; IX-3 "IX2074.2 +058900 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +059000 PERFORM BLANK-LINE-PRINT. IX2074.2 +059100* IX2074.2 +059200* WRK-DS-05V00-005 = COUNTS THE NUMBER OF TIMES READ/WRITE IX2074.2 +059300* WAS EXECUTED. IX2074.2 +059400* IX2074.2 +059500* WRK-DS-04V00-001 = THIS COUNTER IS INCREMENTED EACH TIME IX2074.2 +059600* A WRITE STATEMENT IS ENCOUNTERED IX2074.2 +059700* THE COUNTER IS DECREMENTED EACH TIME AN IX2074.2 +059800* INVALID KEY CONDITION OCCURS ON THE WRITEIX2074.2 +059900* WRK-DU-05V00-001 = NUMERIC FIELD ENBEDDED IN RECORD KEY IX2074.2 +060000* WHICH MAKES THE KEY UNIQUE. IX2074.2 +060100* IX2074.2 +060200* WRK-DU-05V00-003 = NUMERIC FIELD ENBEDDED IN ALTERNATE KEY IX2074.2 +060300* WHICH MAKES THE KEY UNIQUE. IX2074.2 +060400* IX2074.2 +060500* WRK-DS-05V00-006 = COUNTER IS INCREMENTED EACH TIME A RECORDIX2074.2 +060600* RETRIEVED IS NOT THE ONE EXPECTED. IX2074.2 +060700* IX2074.2 +060800* WRK-DS-05V00-007 = THIS COUNTER IS USED TO CREATE A IX2074.2 +060900* DUPLICATE ALTERNATE KEY - I.E., EVERY IX2074.2 +061000* 50TH RECORD. IX2074.2 +061100* IX2074.2 +061200* WRK-DS-05V00-008 = COUNTER CONTAINING THE RECORD NUMBER IX2074.2 +061300* WHICH IS EXPECTED TO BE FOUND. IX2074.2 +061400* IX2074.2 +061500* NOTE - RECORDS OF THE FILE ARE CREATED SEQUENTIALLY IX2074.2 +061600* BY RECORD KEY VALUE . THE ALTERNATE RECORD KEY IX2074.2 +061700* VALUES ARE CREATED INVERSE TO TO THE RECORD IX2074.2 +061800* CREATION SEQUENCE OF THE FILE. IX2074.2 +061900* IX2074.2 +062000* FOLLOWING IS AN EXAMPLE OF THE SEQUENTIAL ORDER OF THE IX2074.2 +062100* RECORDS AS CREATED. IX2074.2 +062200* IX2074.2 +062300* RECORD RECORD ALTERNATE IX2074.2 +062400* NUMBER KEY KEY IX2074.2 +062500* IX2074.2 +062600* 001 001 300 IX2074.2 +062700* 002 002 299 IX2074.2 +062800* 003 003 298 IX2074.2 +062900* . . . IX2074.2 +063000* . . . IX2074.2 +063100* . . . IX2074.2 +063200* 50 050 251 IX2074.2 +063300* 51 051 251 IX2074.2 +063400* 52 052 249 IX2074.2 +063500* IX2074.2 +063600* IX2074.2 +063700 WRITE-TEST-GF-01-R1. IX2074.2 +063800 ADD 000001 TO XRECORD-NUMBER (1). IX2074.2 +063900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2074.2 +064000 MOVE WRK-FS1-ALTKEY TO ALTERNATE-KEY1 (1). IX2074.2 +064100 WRITE IX-FS1R1-F-G-240 FROM FILE-RECORD-INFO (1) IX2074.2 +064200 INVALID KEY IX2074.2 +064300 SUBTRACT 0001 FROM WRK-DS-04V00-001. IX2074.2 +064400 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +064500 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +064600 ADD 00001 TO WRK-DS-05V00-007. IX2074.2 +064700 IF WRK-DS-05V00-007 GREATER THAN 50 IX2074.2 +064800 MOVE 0001 TO WRK-DS-05V00-007 IX2074.2 +064900 ELSE IX2074.2 +065000 SUBTRACT WRK-DU-05V00-001 FROM IX-FS1-FILESIZE IX2074.2 +065100 GIVING WRK-DU-05V00-003. IX2074.2 +065200* IX2074.2 +065300* EVERY 50TH AND 51ST ALTERNATE KEY VALUE WILL BE EQUAL. IX2074.2 +065400* IX2074.2 +065500 ADD 00001 TO WRK-DU-05V00-001. IX2074.2 +065600 IF WRK-DS-05V00-005 LESS THAN IX-FS1-FILESIZE IX2074.2 +065700 GO TO WRITE-TEST-GF-01-R1. IX2074.2 +065800 CLOSE IX-FS1. IX2074.2 +065900 WRITE-TEST-GF-01. IX2074.2 +066000 MOVE "WRITE" TO FEATURE. IX2074.2 +066100 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2074.2 +066200 IF WRK-DS-04V00-001 NOT EQUAL TO IX-FS1-FILESIZE IX2074.2 +066300 PERFORM FAIL IX2074.2 +066400 MOVE WRK-DS-04V00-001 TO COMPUTED-N IX2074.2 +066500 MOVE IX-FS1-FILESIZE TO CORRECT-N IX2074.2 +066600 ELSE IX2074.2 +066700 PERFORM PASS. IX2074.2 +066800 PERFORM PRINT-DETAIL. IX2074.2 +066900* IX2074.2 +067000* IX2074.2 +067100 READ-INIT-F1-01. IX2074.2 +067200 MOVE 001 TO WRK-DS-05V00-008. IX2074.2 +067300 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +067400 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +067500 OPEN INPUT IX-FS1. IX2074.2 +067600 READ-TEST-F1-01-R2. IX2074.2 +067700 READ IX-FS1 RECORD AT END IX2074.2 +067800 GO TO READ-TEST-F1-01. IX2074.2 +067900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +068000 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +068100 IF WRK-DS-05V00-008 NOT EQUAL TO XRECORD-NUMBER (1) IX2074.2 +068200 ADD 00001 TO WRK-DS-05V00-006. IX2074.2 +068300 ADD 00001 TO WRK-DS-05V00-008. IX2074.2 +068400 IF WRK-DS-05V00-005 LESS THAN IX-FS1-FILESIZE IX2074.2 +068500 GO TO READ-TEST-F1-01-R2. IX2074.2 +068600 READ-TEST-F1-01. IX2074.2 +068700 MOVE "READ RECORD KEY " TO FEATURE. IX2074.2 +068800 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2074.2 +068900 CLOSE IX-FS1. IX2074.2 +069000 SUBTRACT IX-FS1-FILESIZE FROM WRK-DS-05V00-005. IX2074.2 +069100 ADD WRK-DS-05V00-005 TO WRK-DS-05V00-006. IX2074.2 +069200 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +069300 PERFORM FAIL IX2074.2 +069400 MOVE ZERO TO CORRECT-N IX2074.2 +069500 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +069600 ELSE IX2074.2 +069700 PERFORM PASS. IX2074.2 +069800 PERFORM PRINT-DETAIL. IX2074.2 +069900* IX2074.2 +070000* IX2074.2 +070100 READ-INT-F1-02. IX2074.2 +070200 MOVE 00020 TO WRK-DS-05V00-006. IX2074.2 +070300 MOVE 00241 TO WRK-DS-05V00-008. IX2074.2 +070400 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +070500 MOVE 00060 TO WRK-DU-05V00-003. IX2074.2 +070600 OPEN INPUT IX-FS1. IX2074.2 +070700 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +070800 START IX-FS1 KEY IS EQUAL TO IX2074.2 +070900 IX-FS1-ALTKEY1 IX2074.2 +071000 INVALID KEY IX2074.2 +071100 ADD 1000 TO WRK-DS-05V00-006. IX2074.2 +071200 READ-TEST-F1-02-R3. IX2074.2 +071300 READ IX-FS1 RECORD AT END IX2074.2 +071400 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +071500 GO TO READ-TEST-F1-02. IX2074.2 +071600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +071700 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +071800 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (1) IX2074.2 +071900 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +072000 IF WRK-DS-05V00-005 LESS THAN 20 IX2074.2 +072100 SUBTRACT 00001 FROM WRK-DS-05V00-008 IX2074.2 +072200 GO TO READ-TEST-F1-02-R3. IX2074.2 +072300 READ-TEST-F1-02. IX2074.2 +072400 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2074.2 +072500 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2074.2 +072600 CLOSE IX-FS1. IX2074.2 +072700 MOVE "READ ALTERNATE KEY" TO FEATURE. IX2074.2 +072800 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +072900 PERFORM FAIL IX2074.2 +073000 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +073100 MOVE ZERO TO CORRECT-N IX2074.2 +073200 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +073300 ELSE IX2074.2 +073400 PERFORM PASS. IX2074.2 +073500* IX2074.2 +073600* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATES THAT IX2074.2 +073700* AN INVALID KEY CONDITION OCCURRED ON THE START IX2074.2 +073800* STATEMENT - SEE PARAGRAPH INX-INIT-001-3. IX2074.2 +073900* IX2074.2 +074000* COMPUTED RESULTS IN INCREMENTS OF 10000 INDICATE THAT THE IX2074.2 +074100* AT END PATH ON THE READ WAS TAKEN. IX2074.2 +074200* IX2074.2 +074300* COMPUTED RESULTS IN INCREMENTS OF 00001 INDICATE THAT THE IX2074.2 +074400* RECORD MADE AVAILABLE AS A RESULT OF THE READ IX2074.2 +074500* WAS NOT THE ONE EXPECTED. IX2074.2 +074600* IX2074.2 +074700 PERFORM PRINT-DETAIL. IX2074.2 +074800* IX2074.2 +074900* 03 IX2074.2 +075000* IX2074.2 +075100 READ-INIT-F1-03. IX2074.2 +075200 MOVE 00060 TO WRK-DS-05V00-006. IX2074.2 +075300 MOVE 00001 TO WRK-DU-05V00-003. IX2074.2 +075400 MOVE 00300 TO WRK-DS-05V00-008. IX2074.2 +075500 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +075600 OPEN INPUT IX-FS1. IX2074.2 +075700 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +075800 START IX-FS1 KEY IS EQUAL TO IX2074.2 +075900 IX-FS1-ALTKEY1 IX2074.2 +076000 INVALID KEY IX2074.2 +076100 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +076200 READ-TEST-F1-03-R4. IX2074.2 +076300 READ IX-FS1 RECORD AT END IX2074.2 +076400 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +076500 GO TO READ-TEST-F1-03. IX2074.2 +076600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +076700 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (1) IX2074.2 +076800 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +076900 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +077000 IF WRK-DS-05V00-005 EQUAL TO 50 AND IX2074.2 +077100 XRECORD-NUMBER (1) EQUAL TO 250 IX2074.2 +077200 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +077300 IF WRK-DS-05V00-005 EQUAL TO 51 AND IX2074.2 +077400 XRECORD-NUMBER (1) EQUAL TO 251 IX2074.2 +077500 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +077600 SUBTRACT 00001 FROM WRK-DS-05V00-008. IX2074.2 +077700 IF WRK-DS-05V00-005 LESS THAN 60 IX2074.2 +077800 GO TO READ-TEST-F1-03-R4. IX2074.2 +077900 READ-TEST-F1-03. IX2074.2 +078000 MOVE "READ DUPLICATE KEY " TO FEATURE. IX2074.2 +078100 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2074.2 +078200 CLOSE IX-FS1. IX2074.2 +078300 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +078400 PERFORM FAIL IX2074.2 +078500 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +078600 MOVE ZERO TO CORRECT-N IX2074.2 +078700 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +078800 ELSE IX2074.2 +078900 PERFORM PASS. IX2074.2 +079000* IX2074.2 +079100* WITH THE GIVEN SYNTACTICAL COBOL ENTRIES IN THE FILE-CONTROL IX2074.2 +079200* PARAGRAPH THIS TEST VERIFIES THAT RECORDS WITH DUPLICATE IX2074.2 +079300* KEYS CAN BE ACCESSED WHEN THE FILE IS READ IX2074.2 +079400* SEQUENTIALLY. THE START STATEMENT ESTABLISHES THE ALTERNATE IX2074.2 +079500* KEY AS THE KEY OF REFERENCE AND POSITIONS THE CURRENT IX2074.2 +079600* RECORD POINTER TO THE LAST RECORD IN THE FILE (ALTERNATE IX2074.2 +079700* KEY VALUE OF 1). SIXTY RECORDS ARE READ SEQUENTIALLY USING IX2074.2 +079800* THE ALTERNATE KEY - THE FILE IS BEING READ INVERSE TO ITS IX2074.2 +079900* CREATION. ON THE 50 TH AND 51 ST READ (RECORD NUMBERS 250 IX2074.2 +080000* AND 251) THESE RECORDS SHOULD CONTAIN ALTERNATE KEYS IX2074.2 +080100* WHICH ARE THE SAME. RECORDS WITH LIKE KEYS SHOULD BE MADE IX2074.2 +080200* AVAILABLE IN THE SEQUENCE IN WHICH THEY ARE CREATED, IX2074.2 +080300* THEREFORE RECORD NUMBER 250 SHOULD BE READ BEFORE RECORD IX2074.2 +080400* NUMBER 251. IX2074.2 +080500* IX2074.2 +080600* COMPUTE RESULTS IN INCREMENTS OF 1000 INDICATES THAT IX2074.2 +080700* AN INVALID KEY CONDITION OCCURRED ON THE START IX2074.2 +080800* STATEMENT - SEE PARAGRAPH READ-INIT-001-4. IX2074.2 +080900* IX2074.2 +081000* COMPUTED RESULTS IN INCREMENTS OF 10000 INDICATE THAT THE IX2074.2 +081100* AT END PATH ON THE READ WAS TAKEN. IX2074.2 +081200* IX2074.2 +081300* COMPUTED RESULTS IN INCREMENTS OF 00001 INDICATE THAT THE IX2074.2 +081400* RECORD MADE AVAILABLE AS A RESULT OF THE READ IX2074.2 +081500* WAS NOT THE ONE EXPECTED. IX2074.2 +081600* IX2074.2 +081700* IX2074.2 +081800 PERFORM PRINT-DETAIL. IX2074.2 +081900* IX2074.2 +082000* IX2074.2 +082100 READ-INIT-F1-04. IX2074.2 +082200 MOVE 20300 TO WRK-DS-05V00-006. IX2074.2 +082300 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +082400 MOVE 00001 TO WRK-DU-05V00-003. IX2074.2 +082500 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +082600 MOVE ZERO TO WRK-DS-04V00-002 IX2074.2 +082700 OPEN INPUT IX-FS1. IX2074.2 +082800 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +082900 START IX-FS1 KEY IS EQUAL TO IX2074.2 +083000 IX-FS1-ALTKEY1 IX2074.2 +083100 INVALID KEY IX2074.2 +083200 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +083300 MOVE IX-FS1-FILESIZE TO WRK-DS-05V00-008. IX2074.2 +083400 MOVE "44" TO FS1-STATUS. IX2074.2 +083500* IX2074.2 +083600* WRK-DS-04V00-001 = A COUNTER WHICH IS INCREMENTED BY 1 EACH IX2074.2 +083700* TIME A FILE STATUS VALUE "00" (SUCCESS- IX2074.2 +083800* FUL READ) WAS ENCOUNTERED DURING THE READIX2074.2 +083900* OF THE FILE. IX2074.2 +084000* IX2074.2 +084100* WRK-DS-04V00-002 = A COUNTER WHICH IS INCREMENTED BY 1 IX2074.2 +084200* EACH TIME A FILE STATUS OF "02" (DUP- IX2074.2 +084300* LICATE KEY) IS ENCOUNTERED DURING A READ.IX2074.2 +084400* IX2074.2 +084500 READ-TEST-F1-04-R5. IX2074.2 +084600 READ IX-FS1 RECORD AT END IX2074.2 +084700 SUBTRACT 20000 FROM WRK-DS-05V00-006 IX2074.2 +084800 GO TO READ-TEST-F1-04. IX2074.2 +084900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +085000 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +085100 IF FS1-STATUS EQUAL TO "00" IX2074.2 +085200 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +085300 IF FS1-STATUS EQUAL TO "02" IX2074.2 +085400 ADD 1 TO WRK-DS-04V00-002. IX2074.2 +085500 IF WRK-DS-05V00-005 GREATER THAN WRK-DS-05V00-008 IX2074.2 +085600 ADD 00001 TO WRK-DS-05V00-006 IX2074.2 +085700 ELSE IX2074.2 +085800 GO TO READ-TEST-F1-04-R5. IX2074.2 +085900 READ-TEST-F1-04. IX2074.2 +086000 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2074.2 +086100 MOVE "FILE STATUS" TO FEATURE. IX2074.2 +086200 IF FS1-STATUS NOT EQUAL TO "10" IX2074.2 +086300 ADD 10000 TO WRK-DS-05V00-006. IX2074.2 +086400 SUBTRACT WRK-DS-04V00-001 FROM WRK-DS-05V00-006. IX2074.2 +086500 SUBTRACT WRK-DS-04V00-002 FROM WRK-DS-05V00-006. IX2074.2 +086600 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +086700 PERFORM FAIL IX2074.2 +086800 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +086900 MOVE ZERO TO CORRECT-N IX2074.2 +087000 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +087100 ELSE IX2074.2 +087200 PERFORM PASS. IX2074.2 +087300* IX2074.2 +087400* COMPUTED RESULT INDICATED IX2074.2 +087500* INCREMENTS ACTION IX2074.2 +087600* IX2074.2 +087700* 10000 FILE STATUS NOT UPDATED ON EOF IX2074.2 +087800* 20000 AT END PATH OF READ NOT TAKEN IX2074.2 +087900* 01000 INVALID KEY ON START STATEMENT. IX2074.2 +088000* 00001 FILE STATUS DID NOT REFLECT IX2074.2 +088100* APPROPRIATE STATUS CONTENTS OF A IX2074.2 +088200* SUCCESSFUL READ IX2074.2 +088300* IX2074.2 +088400 PERFORM PRINT-DETAIL. IX2074.2 +088500 CLOSE IX-FS1. IX2074.2 +088600* IX2074.2 +088700* IX2074.2 +088800 SECTION-IX207A-0002 SECTION. IX2074.2 +088900 WRITE-INIT-GF-02. IX2074.2 +089000 OPEN OUTPUT IX-FS2. IX2074.2 +089100 MOVE "IX-FS2" TO XFILE-NAME (2). IX2074.2 +089200 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2074.2 +089300 MOVE ZERO TO XRECORD-NUMBER (2). IX2074.2 +089400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2074.2 +089500 MOVE 000240 TO XRECORD-LENGTH (2). IX2074.2 +089600 MOVE 0001 TO XBLOCK-SIZE (2). IX2074.2 +089700 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2074.2 +089800 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2074.2 +089900 MOVE "S" TO XLABEL-TYPE (2). IX2074.2 +090000 MOVE 000300 TO RECORDS-IN-FILE (2). IX2074.2 +090100 MOVE 000300 TO IX-FS2-FILESIZE. IX2074.2 +090200 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +090300 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +090400 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +090500 MOVE 00001 TO WRK-DU-05V00-002. IX2074.2 +090600 MOVE IX-FS2-FILESIZE TO WRK-DU-05V00-004. IX2074.2 +090700 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +090800 MOVE 00001 TO WRK-DS-05V00-007. IX2074.2 +090900* IX2074.2 +091000* WRK-DU-05V00-002 = NUMERIC FIELD EMBEDDED IN RECORD KEY IX2074.2 +091100* WHICH MAKES THE KEY UNIQUE. IX2074.2 +091200* IX2074.2 +091300* WRK-DU-05V00-004 = NUMERIC FIELD EMBEDDED IN ALTERNATE KEY IX2074.2 +091400* WHICH MAKES THE KEY UNIQUE. IX2074.2 +091500* IX2074.2 +091600* WRK-DS-05V00-005 = COUNTS THE NUMBER OF TIMES A READ/WRITE IX2074.2 +091700* WAS EXECUTED. IX2074.2 +091800* IX2074.2 +091900* WRK-DS-05V00-006 = ERROR COUNTER WHICH IS INCREMENTED EACH IX2074.2 +092000* TIME AN UNEXPECTED CONDITION OCCURS. IX2074.2 +092100* IX2074.2 +092200* IX2074.2 +092300* WRK-DS-05V00-007 = THIS COUNTERIS USED TO CREATE A DUPLICATEIX2074.2 +092400* ALTERNATE KEY - I.E., EVERY 50TH RECORD. IX2074.2 +092500* IX2074.2 +092600* WRK-DS-05V00-008 = COUNTER CONTAINING THE RECORD NUMBER IX2074.2 +092700* WHICH IS EXPECTED TO BE FOUND. IX2074.2 +092800* IX2074.2 +092900* WRK-DS-04V00-001 = THIS COUNTER IS INCREMENTED EACH TIME IX2074.2 +093000* AN INVALID KEY CONDITION OCCURS ON THE IX2074.2 +093100* WRITE. IX2074.2 +093200* IX2074.2 +093300 PERFORM BLANK-LINE-PRINT. IX2074.2 +093400 MOVE "SELECT ENTRY - ACCESS MODE NOT PRESENT - ACCESS IX2074.2 +093500- "MODE SEQUENTIAL IS ASSUMED" TO PRINT-REC. IX2074.2 +093600 PERFORM WRITE-LINE. IX2074.2 +093700 PERFORM BLANK-LINE-PRINT. IX2074.2 +093800 WRITE-TEST-GF-02-R1. IX2074.2 +093900 ADD 000001 TO XRECORD-NUMBER (2). IX2074.2 +094000 MOVE WRK-FS2-RECKEY TO XRECORD-KEY (2). IX2074.2 +094100 MOVE WRK-FS2-ALTKEY TO ALTERNATE-KEY1 (2). IX2074.2 +094200 WRITE IX-FS2R1-F-G-240 FROM FILE-RECORD-INFO (2) IX2074.2 +094300 INVALID KEY IX2074.2 +094400 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +094500 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +094600* INCREMENT RECORD KEY VALUE. IX2074.2 +094700 ADD 00001 TO WRK-DS-05V00-007. IX2074.2 +094800 IF WRK-DS-05V00-007 GREATER THAN 50 IX2074.2 +094900 MOVE 00001 TO WRK-DS-05V00-007 IX2074.2 +095000 ELSE IX2074.2 +095100 SUBTRACT WRK-DU-05V00-002 FROM IX-FS2-FILESIZE IX2074.2 +095200 GIVING WRK-DU-05V00-004. IX2074.2 +095300* IX2074.2 +095400* EVERY 50TH AND 51ST ALTERNATE KEY VALUE WILL BE EQUAL. IX2074.2 +095500* IX2074.2 +095600 ADD 00001 TO WRK-DU-05V00-002. IX2074.2 +095700 IF WRK-DS-05V00-005 LESS THAN IX-FS2-FILESIZE IX2074.2 +095800 GO TO WRITE-TEST-GF-02-R1. IX2074.2 +095900 WRITE-TEST-GF-02. IX2074.2 +096000 MOVE "WRITE IX-FS2 " TO FEATURE. IX2074.2 +096100 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX2074.2 +096200 CLOSE IX-FS2. IX2074.2 +096300 ADD WRK-DS-04V00-001 WRK-DS-05V00-005 IX2074.2 +096400 GIVING WRK-DS-05V00-006. IX2074.2 +096500 IF WRK-DS-05V00-006 NOT EQUAL TO 00300 IX2074.2 +096600 PERFORM FAIL IX2074.2 +096700 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +096800 MOVE 300 TO CORRECT-N IX2074.2 +096900 ELSE IX2074.2 +097000 PERFORM PASS. IX2074.2 +097100 PERFORM PRINT-DETAIL. IX2074.2 +097200* IX2074.2 +097300* IX2074.2 +097400 READ-INIT-F1-04. IX2074.2 +097500 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +097600 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +097700 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +097800 MOVE 00120 TO WRK-DS-05V00-006. IX2074.2 +097900 MOVE ZERO TO WRK-DS-05V00-007. IX2074.2 +098000 MOVE 300 TO WRK-DS-05V00-008. IX2074.2 +098100 MOVE 0001 TO WRK-DU-05V00-004. IX2074.2 +098200 OPEN INPUT IX-FS2. IX2074.2 +098300 MOVE WRK-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2074.2 +098400 START IX-FS2 KEY IS EQUAL TO IX2074.2 +098500 IX-FS2-ALTKEY1 IX2074.2 +098600 INVALID KEY IX2074.2 +098700 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +098800 READ-TEST-F1-04-R2. IX2074.2 +098900 READ IX-FS2 RECORD AT END IX2074.2 +099000 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +099100 GO TO READ-TEST-F1-04-R3. IX2074.2 +099200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2074.2 +099300 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +099400 IF WRK-DS-05V00-005 EQUAL TO 50 AND IX2074.2 +099500 XRECORD-NUMBER (2) EQUAL TO 250 IX2074.2 +099600 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +099700 IF WRK-DS-05V00-005 EQUAL TO 51 AND IX2074.2 +099800 XRECORD-NUMBER (2) EQUAL TO 251 IX2074.2 +099900 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100000 IF WRK-DS-05V00-005 EQUAL TO 100 AND IX2074.2 +100100 XRECORD-NUMBER (2) EQUAL TO 200 IX2074.2 +100200 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100300 IF WRK-DS-05V00-005 EQUAL TO 101 AND IX2074.2 +100400 XRECORD-NUMBER (2) EQUAL TO 201 IX2074.2 +100500 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100600* IX2074.2 +100700* THE PRECEEDING 4 IF STATEMENTS CHECK THOSE RECORDS WHICH HAVEIX2074.2 +100800* LIKE ALTERNATE RECORD KEYS (DUPLICATE KEYS). THE FILE WAS IX2074.2 +100900* CREATED SEQUENTIALLY BY RECORD KEY VALUE HOWEVER THE IX2074.2 +101000* ALTERNATE RECORD KEY SEQUENCE IS INVERSE TO THE FILE IX2074.2 +101100* CREATION SEQUENCE WITH DUPLICATE ALTERNATE KEYS ESTABLISHED IX2074.2 +101200* IN RECORD KEY SEQUENCE. THE TEST EXPECTS THE RECORDS WHICH IX2074.2 +101300* HAVE LIKE KEYS TO BE PROVIDED IN THE ORDER IN WHICH THEY WEREIX2074.2 +101400* WRITTEN WHEN THE FILE IS SEQUENTIALLY READ BY THE ALTERNATE IX2074.2 +101500* RECORD KEY . IX2074.2 +101600* IX2074.2 +101700 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (2) IX2074.2 +101800 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +101900 SUBTRACT 00001 FROM WRK-DS-05V00-008. IX2074.2 +102000 IF WRK-DS-05V00-005 LESS THAN 120 IX2074.2 +102100 GO TO READ-TEST-F1-04-R2. IX2074.2 +102200 READ-TEST-F1-04-R3. IX2074.2 +102300 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2074.2 +102400 MOVE "READ-TEST-F1-04-R3. " TO PAR-NAME. IX2074.2 +102500 CLOSE IX-FS2. IX2074.2 +102600 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +102700 PERFORM FAIL IX2074.2 +102800 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +102900 MOVE ZERO TO CORRECT-N IX2074.2 +103000 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +103100 ELSE IX2074.2 +103200 PERFORM PASS. IX2074.2 +103300* IX2074.2 +103400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATES AN INVALID KEYIX2074.2 +103500* CONDITION OCCURRED ON THE START STATEMENT - SEE IX2074.2 +103600* PARAGRAPH READ-INIT-F1-04-2; INCREMENTS OF 10000 IX2074.2 +103700* INDICATES THAT AN UNEXPECTED AT END PATH ON THE IX2074.2 +103800* READ WAS TAKEN; INCREMENTS OF 00001 INDICATES THAT IX2074.2 +103900* THE RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2074.2 +104000* IX2074.2 +104100 PERFORM PRINT-DETAIL. IX2074.2 +104200* IX2074.2 +104300* IX2074.2 +104400 READ-INIT-F1-05. IX2074.2 +104500 MOVE 00301 TO WRK-DS-05V00-006. IX2074.2 +104600 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +104700 MOVE ZERO TO WRK-DS-05V00-007. IX2074.2 +104800 MOVE ZERO TO WRK-DS-05V00-008. IX2074.2 +104900 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +105000 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +105100 OPEN INPUT IX-FS1. IX2074.2 +105200 OPEN INPUT IX-FS2. IX2074.2 +105300 READ-TEST-F1-05-R3. IX2074.2 +105400 READ IX-FS1. IX2074.2 +105500 READ IX-FS2. IX2074.2 +105600 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +105700 IF WRK-DS-05V00-005 LESS THAN 301 IX2074.2 +105800 GO TO READ-TEST-F1-05-R3. IX2074.2 +105900 READ-TEST-F1-05. IX2074.2 +106000 MOVE "USE " TO FEATURE. IX2074.2 +106100 MOVE "READ-TEST-F1-05 " TO PAR-NAME. IX2074.2 +106200 CLOSE IX-FS1. IX2074.2 +106300 SUBTRACT WRK-DS-05V00-005 FROM WRK-DS-05V00-006. IX2074.2 +106400 IF WRK-DS-05V00-006 NOT EQUAL TO 00002 IX2074.2 +106500 PERFORM FAIL IX2074.2 +106600 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +106700 MOVE 00002 TO CORRECT-N IX2074.2 +106800 ELSE IX2074.2 +106900 PERFORM PASS. IX2074.2 +107000* IX2074.2 +107100* USE PROCEDURE SHOULD BE EXECUTED ONCE FOR EACH FILE. IX2074.2 +107200* IX2074.2 +107300 PERFORM PRINT-DETAIL. IX2074.2 +107400* IX2074.2 +107500* IX2074.2 +107600 CLOSE IX-FS2. IX2074.2 +107700 IX2074.2 +107800 IX2074.2 +107900 CCVS-EXIT SECTION. IX2074.2 +108000 CCVS-999999. IX2074.2 +108100 GO TO CLOSE-FILES. IX2074.2 +*END-OF,IX207A +*HEADER,COBOL,IX208A +000100 IDENTIFICATION DIVISION. IX2084.2 +000200 PROGRAM-ID. IX2084.2 +000300 IX208A. IX2084.2 +000400**************************************************************** IX2084.2 +000500* * IX2084.2 +000600* VALIDATION FOR:- * IX2084.2 +000700* * IX2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +000900* * IX2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2084.2 +001100* * IX2084.2 +001200**************************************************************** IX2084.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE SYN- IX2084.2 +001400* TACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH LEVEL 2IX2084.2 +001500* OF THE INDEXED I-O MODULE. THE ELEMENTS TESTED IN THIS IX2084.2 +001600* ROUTINE ARE: IX2084.2 +001700* IX2084.2 +001800* (1) READ STATEMENT; IX2084.2 +001900* (2) START STATEMENT; IX2084.2 +002000* (3) USE STATEMENT. IX2084.2 +002100* IX2084.2 +002200* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2084.2 +002300* ROUTINE. IX2084.2 +002400* IX2084.2 +002500* IX2084.2 +002600* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2084.2 +002700* IX2084.2 +002800* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2084.2 +002900* CLAUSE FOR DATA FILE IX-FS1 IX2084.2 +003000* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2084.2 +003100* CLAUSE FOR DATA FILE IX-FD2 IX2084.2 +003200* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2084.2 +003300* CLAUSE FOR INDEX FILE IX-FS1 IX2084.2 +003400* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2084.2 +003500* CLAUSE FOR INDEX FILE IX-FD2 IX2084.2 +003600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2084.2 +003700* X-69 ADDITIONAL VALUE OF PHRASES IX2084.2 +003800* X-74 VALUE OF IMPLEMENTOR-NAME IX2084.2 +003900* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE IX-FS1 IX2084.2 +004000* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE IX-FD2 IX2084.2 +004100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2084.2 +004200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2084.2 +004300* IX2084.2 +004400* NOTE: X-CARDS 44,45,69,74,75 AND 76 ARE OPTIONAL IX2084.2 +004500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2084.2 +004600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2084.2 +004700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2084.2 +004800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2084.2 +004900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2084.2 +005000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2084.2 +005100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2084.2 +005200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2084.2 +005300* THEY ARE AS FOLLOWS IX2084.2 +005400* IX2084.2 +005500* C SELECTS X-CARDS 74,75 AND 76 IX2084.2 +005600* G SELECTS X-CARDS 69 IX2084.2 +005700* J SELECTS X-CARDS 44 AND 45 IX2084.2 +005800* IX2084.2 +005900* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX2084.2 +006000* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX2084.2 +006100* CODE IS IDENTIFIED BY THE LETTER T,U OR X IN IX2084.2 +006200* POSITION 7 OF THE SOURCE LINE. USE OF IX2084.2 +006300* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS IX2084.2 +006400* OF THE FILES AFTER THE TEST REPORT. FOR CODE IX2084.2 +006500* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX2084.2 +006600* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX2084.2 +006700* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX2084.2 +006800* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX2084.2 +006900* AN INDEXED KEY NO GREATER THAN 8 CHARACTERS. IX2084.2 +007000* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX2084.2 +007100* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX2084.2 +007200* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX2084.2 +007300* CARD. IX2084.2 +007400* IX2084.2 +007500****************************************************** IX2084.2 +007600 ENVIRONMENT DIVISION. IX2084.2 +007700 CONFIGURATION SECTION. IX2084.2 +007800 SOURCE-COMPUTER. IX2084.2 +007900 XXXXX082. IX2084.2 +008000 OBJECT-COMPUTER. IX2084.2 +008100 XXXXX083. IX2084.2 +008200 INPUT-OUTPUT SECTION. IX2084.2 +008300 FILE-CONTROL. IX2084.2 +008400P SELECT RAW-DATA ASSIGN TO IX2084.2 +008500P XXXXX062 IX2084.2 +008600P ORGANIZATION IS INDEXED IX2084.2 +008700P ACCESS MODE IS RANDOM IX2084.2 +008800P RECORD KEY IS RAW-DATA-KEY. IX2084.2 +008900 SELECT PRINT-FILE ASSIGN TO IX2084.2 +009000 XXXXX055. IX2084.2 +009100 SELECT IX-FD1 IX2084.2 +009200 ASSIGN TO IX2084.2 +009300 XXXXX024 IX2084.2 +009400J XXXXX044 IX2084.2 +009500 ORGANIZATION IS INDEXED IX2084.2 +009600 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2084.2 +009700 RECORD KEY IS IX-FD1-KEY IX2084.2 +009800 ACCESS MODE IS DYNAMIC. IX2084.2 +009900 SELECT IX-FS2 IX2084.2 +010000 ASSIGN TO IX2084.2 +010100 XXXXX025 IX2084.2 +010200J XXXXX045 IX2084.2 +010300 RECORD KEY IS IX-FS2-KEY IX2084.2 +010400 ALTERNATE RECORD KEY IS IX-FS2-ALTKEY1 IX2084.2 +010500 ACCESS MODE IS SEQUENTIAL IX2084.2 +010600 ORGANIZATION IS INDEXED. IX2084.2 +010700 DATA DIVISION. IX2084.2 +010800 FILE SECTION. IX2084.2 +010900P IX2084.2 +011000PFD RAW-DATA. IX2084.2 +011100P IX2084.2 +011200P01 RAW-DATA-SATZ. IX2084.2 +011300P 05 RAW-DATA-KEY PIC X(6). IX2084.2 +011400P 05 C-DATE PIC 9(6). IX2084.2 +011500P 05 C-TIME PIC 9(8). IX2084.2 +011600P 05 C-NO-OF-TESTS PIC 99. IX2084.2 +011700P 05 C-OK PIC 999. IX2084.2 +011800P 05 C-ALL PIC 999. IX2084.2 +011900P 05 C-FAIL PIC 999. IX2084.2 +012000P 05 C-DELETED PIC 999. IX2084.2 +012100P 05 C-INSPECT PIC 999. IX2084.2 +012200P 05 C-NOTE PIC X(13). IX2084.2 +012300P 05 C-INDENT PIC X. IX2084.2 +012400P 05 C-ABORT PIC X(8). IX2084.2 +012500 FD PRINT-FILE. IX2084.2 +012600 01 PRINT-REC PICTURE X(120). IX2084.2 +012700 01 DUMMY-RECORD PICTURE X(120). IX2084.2 +012800 FD IX-FD1 IX2084.2 +012900C LABEL RECORD IS STANDARD IX2084.2 +013000C DATA RECORD IS IX-FD1R1-F-G-240 IX2084.2 +013100 RECORD CONTAINS 240 CHARACTERS. IX2084.2 +013200 01 IX-FD1R1-F-G-240. IX2084.2 +013300 05 IX-FD1-REC-001-120 PICTURE X(120). IX2084.2 +013400 05 IX-FD1-REC-121-240. IX2084.2 +013500 10 FILLER PICTURE X(8). IX2084.2 +013600 10 IX-FD1-KEY. IX2084.2 +013700 15 IX-FS1-KEYNUM PICTURE 9(5). IX2084.2 +013800T 15 FILLER PICTURE 9(5). IX2084.2 +013900U 10 FILLER PICTURE X(5). IX2084.2 +014000 10 FILLER PICTURE X(19). IX2084.2 +014100 10 FILLER PICTURE X(9). IX2084.2 +014200 10 IX-FD1-ALTKEY1. IX2084.2 +014300T 15 FILLER PICTURE 9(5). IX2084.2 +014400 15 IX-FD1-ALTKEY1NUM PICTURE 9(5). IX2084.2 +014500U 10 FILLER PICTURE 9(5). IX2084.2 +014600 10 FILLER PICTURE X(19). IX2084.2 +014700 10 FILLER PICTURE X(45). IX2084.2 +014800 FD IX-FS2 IX2084.2 +014900C LABEL RECORDS ARE STANDARD IX2084.2 +015000C DATA RECORD IS IX-FS2R1-F-G-240 IX2084.2 +015100 . IX2084.2 +015200 01 IX-FS2R1-F-G-240. IX2084.2 +015300 05 IX-FS2-REC-001-120 PICTURE X(120). IX2084.2 +015400 05 IX-FS2-REC-121-240. IX2084.2 +015500 10 FILLER PICTURE X(8). IX2084.2 +015600 10 IX-FS2-KEY. IX2084.2 +015700 15 IX-FS2-KEYNUM PICTURE 9(5). IX2084.2 +015800T 15 FILLER PICTURE 9(5). IX2084.2 +015900U 10 FILLER PICTURE 9(5). IX2084.2 +016000 10 FILLER PICTURE X(19). IX2084.2 +016100 10 FILLER PICTURE X(9). IX2084.2 +016200 10 IX-FS2-ALTKEY1. IX2084.2 +016300T 15 FILLER PICTURE 9(5). IX2084.2 +016400 15 IX-FS2-ALTKEY1NUM PICTURE 9(5). IX2084.2 +016500U 10 FILLER PICTURE 9(5). IX2084.2 +016600 10 FILLER PICTURE X(19). IX2084.2 +016700 10 FILLER PICTURE X(45). IX2084.2 +016800 WORKING-STORAGE SECTION. IX2084.2 +016900 01 IX-FD1-FILESIZE PICTURE 9(6) VALUE 300. IX2084.2 +017000 01 IX-FS2-FILESIZE PICTURE 9(6) VALUE 300. IX2084.2 +017100 01 WRK-IX-FD1-RECKEY. IX2084.2 +017200 03 WRK-DU-05V00-001 PICTURE 9(5) VALUE ZERO. IX2084.2 +017300T 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017400 01 WRK-IX-FS2-RECKEY. IX2084.2 +017500 03 WRK-DU-05V00-003 PICTURE 9(5) VALUE ZERO. IX2084.2 +017600T 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017700 01 WRK-IX-FD1-ALTKEY. IX2084.2 +017800T 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017900 03 WRK-DU-05V00-002 PICTURE 9(5) VALUE ZERO. IX2084.2 +018000 01 WRK-IX-FS2-ALTKEY. IX2084.2 +018100T 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +018200 03 WRK-DU-05V00-004 PICTURE 9(5) VALUE ZERO. IX2084.2 +018300 01 EXCUT-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. IX2084.2 +018400 01 INV-KEY-COUNTER PICTURE S9(6) VALUE ZERO. IX2084.2 +018500 01 LOGICAL-FILE-REC PICTURE S9(6) VALUE ZERO. IX2084.2 +018600 01 ERROR-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. IX2084.2 +018700 01 ASCEND-DESEND-SWITCH PICTURE XX VALUE "UP". IX2084.2 +018800 88 ASCEND VALUE "UP". IX2084.2 +018900 88 DSCEND VALUE "DN". IX2084.2 +019000 01 FILE-RECORD-INFORMATION-REC. IX2084.2 +019100 03 FILE-RECORD-INFO-SKELETON. IX2084.2 +019200 05 FILLER PICTURE X(48) VALUE IX2084.2 +019300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2084.2 +019400 05 FILLER PICTURE X(46) VALUE IX2084.2 +019500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2084.2 +019600 05 FILLER PICTURE X(26) VALUE IX2084.2 +019700 ",LFIL=000000,ORG= ,LBLR= ". IX2084.2 +019800 05 FILLER PICTURE X(37) VALUE IX2084.2 +019900 ",RECKEY= ". IX2084.2 +020000 05 FILLER PICTURE X(38) VALUE IX2084.2 +020100 ",ALTKEY1= ". IX2084.2 +020200 05 FILLER PICTURE X(38) VALUE IX2084.2 +020300 ",ALTKEY2= ". IX2084.2 +020400 05 FILLER PICTURE X(7) VALUE SPACE.IX2084.2 +020500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2084.2 +020600 05 FILE-RECORD-INFO-P1-120. IX2084.2 +020700 07 FILLER PIC X(5). IX2084.2 +020800 07 XFILE-NAME PIC X(6). IX2084.2 +020900 07 FILLER PIC X(8). IX2084.2 +021000 07 XRECORD-NAME PIC X(6). IX2084.2 +021100 07 FILLER PIC X(1). IX2084.2 +021200 07 REELUNIT-NUMBER PIC 9(1). IX2084.2 +021300 07 FILLER PIC X(7). IX2084.2 +021400 07 XRECORD-NUMBER PIC 9(6). IX2084.2 +021500 07 FILLER PIC X(6). IX2084.2 +021600 07 UPDATE-NUMBER PIC 9(2). IX2084.2 +021700 07 FILLER PIC X(5). IX2084.2 +021800 07 ODO-NUMBER PIC 9(4). IX2084.2 +021900 07 FILLER PIC X(5). IX2084.2 +022000 07 XPROGRAM-NAME PIC X(5). IX2084.2 +022100 07 FILLER PIC X(7). IX2084.2 +022200 07 XRECORD-LENGTH PIC 9(6). IX2084.2 +022300 07 FILLER PIC X(7). IX2084.2 +022400 07 CHARS-OR-RECORDS PIC X(2). IX2084.2 +022500 07 FILLER PIC X(1). IX2084.2 +022600 07 XBLOCK-SIZE PIC 9(4). IX2084.2 +022700 07 FILLER PIC X(6). IX2084.2 +022800 07 RECORDS-IN-FILE PIC 9(6). IX2084.2 +022900 07 FILLER PIC X(5). IX2084.2 +023000 07 XFILE-ORGANIZATION PIC X(2). IX2084.2 +023100 07 FILLER PIC X(6). IX2084.2 +023200 07 XLABEL-TYPE PIC X(1). IX2084.2 +023300 05 FILE-RECORD-INFO-P121-240. IX2084.2 +023400 07 FILLER PIC X(8). IX2084.2 +023500 07 XRECORD-KEY PIC X(29). IX2084.2 +023600 07 FILLER PIC X(9). IX2084.2 +023700 07 ALTERNATE-KEY1 PIC X(29). IX2084.2 +023800 07 FILLER PIC X(9). IX2084.2 +023900 07 ALTERNATE-KEY2 PIC X(29). IX2084.2 +024000 07 FILLER PIC X(7). IX2084.2 +024100 01 TEST-RESULTS. IX2084.2 +024200 02 FILLER PIC X VALUE SPACE. IX2084.2 +024300 02 FEATURE PIC X(20) VALUE SPACE. IX2084.2 +024400 02 FILLER PIC X VALUE SPACE. IX2084.2 +024500 02 P-OR-F PIC X(5) VALUE SPACE. IX2084.2 +024600 02 FILLER PIC X VALUE SPACE. IX2084.2 +024700 02 PAR-NAME. IX2084.2 +024800 03 FILLER PIC X(19) VALUE SPACE. IX2084.2 +024900 03 PARDOT-X PIC X VALUE SPACE. IX2084.2 +025000 03 DOTVALUE PIC 99 VALUE ZERO. IX2084.2 +025100 02 FILLER PIC X(8) VALUE SPACE. IX2084.2 +025200 02 RE-MARK PIC X(61). IX2084.2 +025300 01 TEST-COMPUTED. IX2084.2 +025400 02 FILLER PIC X(30) VALUE SPACE. IX2084.2 +025500 02 FILLER PIC X(17) VALUE IX2084.2 +025600 " COMPUTED=". IX2084.2 +025700 02 COMPUTED-X. IX2084.2 +025800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2084.2 +025900 03 COMPUTED-N REDEFINES COMPUTED-A IX2084.2 +026000 PIC -9(9).9(9). IX2084.2 +026100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2084.2 +026200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2084.2 +026300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2084.2 +026400 03 CM-18V0 REDEFINES COMPUTED-A. IX2084.2 +026500 04 COMPUTED-18V0 PIC -9(18). IX2084.2 +026600 04 FILLER PIC X. IX2084.2 +026700 03 FILLER PIC X(50) VALUE SPACE. IX2084.2 +026800 01 TEST-CORRECT. IX2084.2 +026900 02 FILLER PIC X(30) VALUE SPACE. IX2084.2 +027000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2084.2 +027100 02 CORRECT-X. IX2084.2 +027200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2084.2 +027300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2084.2 +027400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2084.2 +027500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2084.2 +027600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2084.2 +027700 03 CR-18V0 REDEFINES CORRECT-A. IX2084.2 +027800 04 CORRECT-18V0 PIC -9(18). IX2084.2 +027900 04 FILLER PIC X. IX2084.2 +028000 03 FILLER PIC X(2) VALUE SPACE. IX2084.2 +028100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2084.2 +028200 01 CCVS-C-1. IX2084.2 +028300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2084.2 +028400- "SS PARAGRAPH-NAME IX2084.2 +028500- " REMARKS". IX2084.2 +028600 02 FILLER PIC X(20) VALUE SPACE. IX2084.2 +028700 01 CCVS-C-2. IX2084.2 +028800 02 FILLER PIC X VALUE SPACE. IX2084.2 +028900 02 FILLER PIC X(6) VALUE "TESTED". IX2084.2 +029000 02 FILLER PIC X(15) VALUE SPACE. IX2084.2 +029100 02 FILLER PIC X(4) VALUE "FAIL". IX2084.2 +029200 02 FILLER PIC X(94) VALUE SPACE. IX2084.2 +029300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2084.2 +029400 01 REC-CT PIC 99 VALUE ZERO. IX2084.2 +029500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2084.2 +030000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2084.2 +030100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2084.2 +030200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2084.2 +030300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2084.2 +030400 01 CCVS-H-1. IX2084.2 +030500 02 FILLER PIC X(39) VALUE SPACES. IX2084.2 +030600 02 FILLER PIC X(42) VALUE IX2084.2 +030700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2084.2 +030800 02 FILLER PIC X(39) VALUE SPACES. IX2084.2 +030900 01 CCVS-H-2A. IX2084.2 +031000 02 FILLER PIC X(40) VALUE SPACE. IX2084.2 +031100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2084.2 +031200 02 FILLER PIC XXXX VALUE IX2084.2 +031300 "4.2 ". IX2084.2 +031400 02 FILLER PIC X(28) VALUE IX2084.2 +031500 " COPY - NOT FOR DISTRIBUTION". IX2084.2 +031600 02 FILLER PIC X(41) VALUE SPACE. IX2084.2 +031700 IX2084.2 +031800 01 CCVS-H-2B. IX2084.2 +031900 02 FILLER PIC X(15) VALUE IX2084.2 +032000 "TEST RESULT OF ". IX2084.2 +032100 02 TEST-ID PIC X(9). IX2084.2 +032200 02 FILLER PIC X(4) VALUE IX2084.2 +032300 " IN ". IX2084.2 +032400 02 FILLER PIC X(12) VALUE IX2084.2 +032500 " HIGH ". IX2084.2 +032600 02 FILLER PIC X(22) VALUE IX2084.2 +032700 " LEVEL VALIDATION FOR ". IX2084.2 +032800 02 FILLER PIC X(58) VALUE IX2084.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +033000 01 CCVS-H-3. IX2084.2 +033100 02 FILLER PIC X(34) VALUE IX2084.2 +033200 " FOR OFFICIAL USE ONLY ". IX2084.2 +033300 02 FILLER PIC X(58) VALUE IX2084.2 +033400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2084.2 +033500 02 FILLER PIC X(28) VALUE IX2084.2 +033600 " COPYRIGHT 1985 ". IX2084.2 +033700 01 CCVS-E-1. IX2084.2 +033800 02 FILLER PIC X(52) VALUE SPACE. IX2084.2 +033900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2084.2 +034000 02 ID-AGAIN PIC X(9). IX2084.2 +034100 02 FILLER PIC X(45) VALUE SPACES. IX2084.2 +034200 01 CCVS-E-2. IX2084.2 +034300 02 FILLER PIC X(31) VALUE SPACE. IX2084.2 +034400 02 FILLER PIC X(21) VALUE SPACE. IX2084.2 +034500 02 CCVS-E-2-2. IX2084.2 +034600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2084.2 +034700 03 FILLER PIC X VALUE SPACE. IX2084.2 +034800 03 ENDER-DESC PIC X(44) VALUE IX2084.2 +034900 "ERRORS ENCOUNTERED". IX2084.2 +035000 01 CCVS-E-3. IX2084.2 +035100 02 FILLER PIC X(22) VALUE IX2084.2 +035200 " FOR OFFICIAL USE ONLY". IX2084.2 +035300 02 FILLER PIC X(12) VALUE SPACE. IX2084.2 +035400 02 FILLER PIC X(58) VALUE IX2084.2 +035500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +035600 02 FILLER PIC X(13) VALUE SPACE. IX2084.2 +035700 02 FILLER PIC X(15) VALUE IX2084.2 +035800 " COPYRIGHT 1985". IX2084.2 +035900 01 CCVS-E-4. IX2084.2 +036000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2084.2 +036100 02 FILLER PIC X(4) VALUE " OF ". IX2084.2 +036200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2084.2 +036300 02 FILLER PIC X(40) VALUE IX2084.2 +036400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2084.2 +036500 01 XXINFO. IX2084.2 +036600 02 FILLER PIC X(19) VALUE IX2084.2 +036700 "*** INFORMATION ***". IX2084.2 +036800 02 INFO-TEXT. IX2084.2 +036900 04 FILLER PIC X(8) VALUE SPACE. IX2084.2 +037000 04 XXCOMPUTED PIC X(20). IX2084.2 +037100 04 FILLER PIC X(5) VALUE SPACE. IX2084.2 +037200 04 XXCORRECT PIC X(20). IX2084.2 +037300 02 INF-ANSI-REFERENCE PIC X(48). IX2084.2 +037400 01 HYPHEN-LINE. IX2084.2 +037500 02 FILLER PIC IS X VALUE IS SPACE. IX2084.2 +037600 02 FILLER PIC IS X(65) VALUE IS "************************IX2084.2 +037700- "*****************************************". IX2084.2 +037800 02 FILLER PIC IS X(54) VALUE IS "************************IX2084.2 +037900- "******************************". IX2084.2 +038000 01 CCVS-PGM-ID PIC X(9) VALUE IX2084.2 +038100 "IX208A". IX2084.2 +038200 PROCEDURE DIVISION. IX2084.2 +038300 DECLARATIVES. IX2084.2 +038400 USE-IX208A-TEST SECTION. IX2084.2 +038500 USE AFTER ERROR PROCEDURE IX-FD1 IX-FS2. IX2084.2 +038600 USE-PAR-001. IX2084.2 +038700 ADD 010000 TO ERROR-COUNTER-06V00. IX2084.2 +038800 USE-PAR-EXIT. IX2084.2 +038900 EXIT. IX2084.2 +039000 END DECLARATIVES. IX2084.2 +039100 CCVS1 SECTION. IX2084.2 +039200 OPEN-FILES. IX2084.2 +039300P OPEN I-O RAW-DATA. IX2084.2 +039400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2084.2 +039500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2084.2 +039600P MOVE "ABORTED " TO C-ABORT. IX2084.2 +039700P ADD 1 TO C-NO-OF-TESTS. IX2084.2 +039800P ACCEPT C-DATE FROM DATE. IX2084.2 +039900P ACCEPT C-TIME FROM TIME. IX2084.2 +040000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2084.2 +040100PEND-E-1. IX2084.2 +040200P CLOSE RAW-DATA. IX2084.2 +040300 OPEN OUTPUT PRINT-FILE. IX2084.2 +040400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2084.2 +040500 MOVE SPACE TO TEST-RESULTS. IX2084.2 +040600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2084.2 +040700 MOVE ZERO TO REC-SKL-SUB. IX2084.2 +040800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2084.2 +040900 CCVS-INIT-FILE. IX2084.2 +041000 ADD 1 TO REC-SKL-SUB. IX2084.2 +041100 MOVE FILE-RECORD-INFO-SKELETON IX2084.2 +041200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2084.2 +041300 CCVS-INIT-EXIT. IX2084.2 +041400 GO TO CCVS1-EXIT. IX2084.2 +041500 CLOSE-FILES. IX2084.2 +041600P OPEN I-O RAW-DATA. IX2084.2 +041700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2084.2 +041800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2084.2 +041900P MOVE "OK. " TO C-ABORT. IX2084.2 +042000P MOVE PASS-COUNTER TO C-OK. IX2084.2 +042100P MOVE ERROR-HOLD TO C-ALL. IX2084.2 +042200P MOVE ERROR-COUNTER TO C-FAIL. IX2084.2 +042300P MOVE DELETE-COUNTER TO C-DELETED. IX2084.2 +042400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2084.2 +042500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2084.2 +042600PEND-E-2. IX2084.2 +042700P CLOSE RAW-DATA. IX2084.2 +042800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2084.2 +042900 TERMINATE-CCVS. IX2084.2 +043000S EXIT PROGRAM. IX2084.2 +043100STERMINATE-CALL. IX2084.2 +043200 STOP RUN. IX2084.2 +043300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2084.2 +043400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2084.2 +043500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2084.2 +043600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2084.2 +043700 MOVE "****TEST DELETED****" TO RE-MARK. IX2084.2 +043800 PRINT-DETAIL. IX2084.2 +043900 IF REC-CT NOT EQUAL TO ZERO IX2084.2 +044000 MOVE "." TO PARDOT-X IX2084.2 +044100 MOVE REC-CT TO DOTVALUE. IX2084.2 +044200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2084.2 +044300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2084.2 +044400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2084.2 +044500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2084.2 +044600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2084.2 +044700 MOVE SPACE TO CORRECT-X. IX2084.2 +044800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2084.2 +044900 MOVE SPACE TO RE-MARK. IX2084.2 +045000 HEAD-ROUTINE. IX2084.2 +045100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2084.2 +045400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2084.2 +045500 COLUMN-NAMES-ROUTINE. IX2084.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +045900 END-ROUTINE. IX2084.2 +046000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2084.2 +046100 END-RTN-EXIT. IX2084.2 +046200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +046300 END-ROUTINE-1. IX2084.2 +046400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2084.2 +046500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2084.2 +046600 ADD PASS-COUNTER TO ERROR-HOLD. IX2084.2 +046700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2084.2 +046800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2084.2 +046900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2084.2 +047000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2084.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2084.2 +047200 END-ROUTINE-12. IX2084.2 +047300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2084.2 +047400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2084.2 +047500 MOVE "NO " TO ERROR-TOTAL IX2084.2 +047600 ELSE IX2084.2 +047700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2084.2 +047800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2084.2 +047900 PERFORM WRITE-LINE. IX2084.2 +048000 END-ROUTINE-13. IX2084.2 +048100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2084.2 +048200 MOVE "NO " TO ERROR-TOTAL ELSE IX2084.2 +048300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2084.2 +048400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2084.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO IX2084.2 +048700 MOVE "NO " TO ERROR-TOTAL IX2084.2 +048800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2084.2 +048900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2084.2 +049000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +049100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +049200 WRITE-LINE. IX2084.2 +049300 ADD 1 TO RECORD-COUNT. IX2084.2 +049400Y IF RECORD-COUNT GREATER 42 IX2084.2 +049500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2084.2 +049600Y MOVE SPACE TO DUMMY-RECORD IX2084.2 +049700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2084.2 +049800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2084.2 +049900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2084.2 +050000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2084.2 +050100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2084.2 +050200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2084.2 +050600Y MOVE ZERO TO RECORD-COUNT. IX2084.2 +050700 PERFORM WRT-LN. IX2084.2 +050800 WRT-LN. IX2084.2 +050900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2084.2 +051000 MOVE SPACE TO DUMMY-RECORD. IX2084.2 +051100 BLANK-LINE-PRINT. IX2084.2 +051200 PERFORM WRT-LN. IX2084.2 +051300 FAIL-ROUTINE. IX2084.2 +051400 IF COMPUTED-X NOT EQUAL TO SPACE IX2084.2 +051500 GO TO FAIL-ROUTINE-WRITE. IX2084.2 +051600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2084.2 +051700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2084.2 +051800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2084.2 +051900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +052000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2084.2 +052100 GO TO FAIL-ROUTINE-EX. IX2084.2 +052200 FAIL-ROUTINE-WRITE. IX2084.2 +052300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2084.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2084.2 +052500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2084.2 +052600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2084.2 +052700 FAIL-ROUTINE-EX. EXIT. IX2084.2 +052800 BAIL-OUT. IX2084.2 +052900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2084.2 +053000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2084.2 +053100 BAIL-OUT-WRITE. IX2084.2 +053200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2084.2 +053300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2084.2 +053400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2084.2 +053600 BAIL-OUT-EX. EXIT. IX2084.2 +053700 CCVS1-EXIT. IX2084.2 +053800 EXIT. IX2084.2 +053900 SECT-IX208A-0001 SECTION. IX2084.2 +054000 WRITE-INIT-GF-01. IX2084.2 +054100 OPEN OUTPUT IX-FD1. IX2084.2 +054200 OPEN OUTPUT IX-FS2. IX2084.2 +054300 MOVE "IX-FD1" TO XFILE-NAME (1). IX2084.2 +054400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2084.2 +054500 MOVE ZERO TO XRECORD-NUMBER (1). IX2084.2 +054600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2084.2 +054700 MOVE 000240 TO XRECORD-LENGTH (1). IX2084.2 +054800 MOVE 0001 TO XBLOCK-SIZE (1). IX2084.2 +054900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2084.2 +055000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2084.2 +055100 MOVE "S" TO XLABEL-TYPE (1). IX2084.2 +055200 MOVE 000300 TO IX-FD1-FILESIZE. IX2084.2 +055300 MOVE 000300 TO RECORDS-IN-FILE (1). IX2084.2 +055400 MOVE 00001 TO WRK-DU-05V00-001. IX2084.2 +055500 MOVE 00300 TO WRK-DU-05V00-002. IX2084.2 +055600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +055700 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +055800 MOVE "WRITE-INIT-GF-01" TO PAR-NAME. IX2084.2 +055900 MOVE "IX-FS2" TO XFILE-NAME (2). IX2084.2 +056000 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2084.2 +056100 MOVE ZERO TO XRECORD-NUMBER (2). IX2084.2 +056200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2084.2 +056300 MOVE 000240 TO XRECORD-LENGTH (2). IX2084.2 +056400 MOVE 0001 TO XBLOCK-SIZE (2). IX2084.2 +056500 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2084.2 +056600 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2084.2 +056700 MOVE "S" TO XLABEL-TYPE (2). IX2084.2 +056800 MOVE 00300 TO IX-FS2-FILESIZE. IX2084.2 +056900 MOVE 00300 TO RECORDS-IN-FILE (2). IX2084.2 +057000 MOVE 00001 TO WRK-DU-05V00-003. IX2084.2 +057100 MOVE 00300 TO WRK-DU-05V00-004. IX2084.2 +057200 WRITE-TEST-GF-00. IX2084.2 +057300 ADD 0001 TO XRECORD-NUMBER (1). IX2084.2 +057400 MOVE WRK-IX-FD1-RECKEY TO XRECORD-KEY (1). IX2084.2 +057500 MOVE WRK-IX-FD1-ALTKEY TO ALTERNATE-KEY1 (1). IX2084.2 +057600 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2084.2 +057700 WRITE IX-FD1R1-F-G-240 IX2084.2 +057800 INVALID KEY IX2084.2 +057900 ADD 000001 TO INV-KEY-COUNTER. IX2084.2 +058000 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +058100 ADD 00001 TO WRK-DU-05V00-001. IX2084.2 +058200 SUBTRACT 00001 FROM WRK-DU-05V00-002. IX2084.2 +058300 IF XRECORD-NUMBER (1) LESS THAN IX-FD1-FILESIZE IX2084.2 +058400 GO TO WRITE-TEST-GF-00. IX2084.2 +058500 CLOSE IX-FD1. IX2084.2 +058600 WRITE-TEST-GF-01. IX2084.2 +058700 MOVE "CREATE FILE IX-FD1" TO FEATURE. IX2084.2 +058800 IF EXCUT-COUNTER-06V00 NOT EQUAL TO IX-FD1-FILESIZE IX2084.2 +058900 PERFORM FAIL IX2084.2 +059000 MOVE IX-FD1-FILESIZE TO CORRECT-N IX2084.2 +059100 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N IX2084.2 +059200 MOVE "INCORRECT NUMBER OF WRITES; IX-41" TO RE-MARK IX2084.2 +059300 PERFORM PRINT-DETAIL IX2084.2 +059400 GO TO WRITE-INIT-GF-02. IX2084.2 +059500 IF INV-KEY-COUNTER NOT EQUAL TO ZERO IX2084.2 +059600 PERFORM FAIL IX2084.2 +059700 MOVE INV-KEY-COUNTER TO COMPUTED-N IX2084.2 +059800 MOVE ZERO TO CORRECT-N IX2084.2 +059900 MOVE "INVALID KEY ON WRITE; IX-41" TO RE-MARK IX2084.2 +060000 PERFORM PRINT-DETAIL IX2084.2 +060100 GO TO WRITE-INIT-GF-02. IX2084.2 +060200* IX2084.2 +060300* 01 IX2084.2 +060400* IX2084.2 +060500 PERFORM PASS. IX2084.2 +060600 PERFORM PRINT-DETAIL. IX2084.2 +060700 WRITE-INIT-GF-02. IX2084.2 +060800 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +060900 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +061000 WRITE-TEST-GF-02-1. IX2084.2 +061100 ADD 0001 TO XRECORD-NUMBER (2). IX2084.2 +061200 MOVE WRK-IX-FS2-RECKEY TO XRECORD-KEY (2). IX2084.2 +061300 MOVE WRK-IX-FS2-ALTKEY TO ALTERNATE-KEY1 (2). IX2084.2 +061400 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX2084.2 +061500 WRITE IX-FS2R1-F-G-240 IX2084.2 +061600 INVALID KEY IX2084.2 +061700 ADD 000001 TO INV-KEY-COUNTER. IX2084.2 +061800 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +061900 ADD 00001 TO WRK-DU-05V00-003. IX2084.2 +062000 SUBTRACT 00001 FROM WRK-DU-05V00-004. IX2084.2 +062100 IF XRECORD-NUMBER (2) LESS THAN IX-FS2-FILESIZE IX2084.2 +062200 GO TO WRITE-TEST-GF-02-1. IX2084.2 +062300 CLOSE IX-FS2. IX2084.2 +062400 WRITE-TEST-GF-02. IX2084.2 +062500 MOVE "CREATE FILE IX-FS2" TO FEATURE. IX2084.2 +062600 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX2084.2 +062700 IF EXCUT-COUNTER-06V00 NOT EQUAL TO IX-FS2-FILESIZE IX2084.2 +062800 PERFORM FAIL IX2084.2 +062900 MOVE IX-FS2-FILESIZE TO CORRECT-N IX2084.2 +063000 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N IX2084.2 +063100 MOVE "INCORRECT NUMBER OF WRITES; IX-41" TO RE-MARK IX2084.2 +063200 PERFORM PRINT-DETAIL IX2084.2 +063300 GO TO READ-INIT-F1-01. IX2084.2 +063400* IX2084.2 +063500* 02 IX2084.2 +063600* IX2084.2 +063700 IF INV-KEY-COUNTER NOT EQUAL TO ZERO IX2084.2 +063800 PERFORM FAIL IX2084.2 +063900 MOVE INV-KEY-COUNTER TO COMPUTED-N IX2084.2 +064000 MOVE ZERO TO CORRECT-N IX2084.2 +064100 MOVE "INVALID KEY ON WRITE; IX-41" TO RE-MARK IX2084.2 +064200 PERFORM PRINT-DETAIL IX2084.2 +064300 GO TO READ-INIT-F1-01. IX2084.2 +064400 PERFORM PASS. IX2084.2 +064500 PERFORM PRINT-DETAIL. IX2084.2 +064600 READ-INIT-F1-01. IX2084.2 +064700 PERFORM BLANK-LINE-PRINT. IX2084.2 +064800 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS IX2084.2 +064900- "ACCESS MODE IS DYNAMIC." TO PRINT-REC. IX2084.2 +065000 PERFORM WRITE-LINE. IX2084.2 +065100 PERFORM BLANK-LINE-PRINT. IX2084.2 +065200 MOVE "READ NEXT" TO FEATURE. IX2084.2 +065300 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2084.2 +065400 READ-INIT-F1-01-R1. IX2084.2 +065500 OPEN INPUT IX-FD1. IX2084.2 +065600 PERFORM INX-INIT-002-R. IX2084.2 +065700 READ-TEST-F1-01-1. IX2084.2 +065800 READ IX-FD1 NEXT. IX2084.2 +065900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +066000 PERFORM INX-VERIFY-002. IX2084.2 +066100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +066200 GO TO READ-TEST-F1-01-1. IX2084.2 +066300 CLOSE IX-FD1. IX2084.2 +066400 READ-TEST-F1-01. IX2084.2 +066500 PERFORM INX-TEST-002. IX2084.2 +066600 GO TO READ-INIT-F1-02. IX2084.2 +066700* IX2084.2 +066800* 01 IX2084.2 +066900* IX2084.2 +067000 READ-DELETE-F1-01. IX2084.2 +067100 PERFORM DE-LETE. IX2084.2 +067200 PERFORM PRINT-DETAIL. IX2084.2 +067300 READ-INIT-F1-02. IX2084.2 +067400 PERFORM INX-INIT-002-R. IX2084.2 +067500 OPEN INPUT IX-FD1. IX2084.2 +067600 READ-TEST-F1-02. IX2084.2 +067700 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +067800 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +067900 READ IX-FD1 NEXT RECORD IX2084.2 +068000 INTO FILE-RECORD-INFO (9). IX2084.2 +068100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +068200 PERFORM INX-VERIFY-002. IX2084.2 +068300 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC IX2084.2 +068400 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +068500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +068600 GO TO READ-TEST-F1-02. IX2084.2 +068700 CLOSE IX-FD1. IX2084.2 +068800 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2084.2 +068900 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +069000 PERFORM INX-TEST-002. IX2084.2 +069100* IX2084.2 +069200* 02 IX2084.2 +069300* IX2084.2 +069400 GO TO READ-INIT-F1-03. IX2084.2 +069500 READ-DELETE-F1-02. IX2084.2 +069600 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2084.2 +069700 MOVE "READ ... INTO " TO FEATURE. IX2084.2 +069800 PERFORM DE-LETE. IX2084.2 +069900 PERFORM PRINT-DETAIL. IX2084.2 +070000 READ-INIT-F1-03. IX2084.2 +070100 OPEN INPUT IX-FD1. IX2084.2 +070200 PERFORM INX-INIT-002-R. IX2084.2 +070300 READ-TEST-F1-03. IX2084.2 +070400 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +070500 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +070600 READ IX-FD1 NEXT IX2084.2 +070700 INTO FILE-RECORD-INFO (9). IX2084.2 +070800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +070900 PERFORM INX-VERIFY-002. IX2084.2 +071000 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC IX2084.2 +071100 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +071200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +071300 GO TO READ-TEST-F1-03. IX2084.2 +071400 CLOSE IX-FD1. IX2084.2 +071500 READ-TEST-F1-03-1. IX2084.2 +071600 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX2084.2 +071700 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +071800 PERFORM INX-TEST-002. IX2084.2 +071900* IX2084.2 +072000* 03 IX2084.2 +072100* IX2084.2 +072200 GO TO READ-INIT-F1-04. IX2084.2 +072300 READ-DELETE-TEST-F1-03. IX2084.2 +072400 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2084.2 +072500 PERFORM DE-LETE. IX2084.2 +072600 PERFORM PRINT-DETAIL. IX2084.2 +072700 READ-INIT-F1-04. IX2084.2 +072800 OPEN INPUT IX-FD1. IX2084.2 +072900 PERFORM INX-INIT-002-R. IX2084.2 +073000 MOVE IX-FD1-FILESIZE TO ERROR-COUNTER-06V00. IX2084.2 +073100 ADD 000001 TO ERROR-COUNTER-06V00. IX2084.2 +073200 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX2084.2 +073300 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +073400 READ-TEST-F1-04. IX2084.2 +073500 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +073600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +073700 READ IX-FD1 NEXT INTO FILE-RECORD-INFO (9) AT END IX2084.2 +073800 SUBTRACT 000001 FROM ERROR-COUNTER-06V00 IX2084.2 +073900 GO TO READ-TEST-F1-04-1. IX2084.2 +074000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +074100 PERFORM INX-VERIFY-002. IX2084.2 +074200 IF EXCUT-COUNTER-06V00 GREATER THAN IX-FD1-FILESIZE IX2084.2 +074300 NEXT SENTENCE IX2084.2 +074400 ELSE IX2084.2 +074500 GO TO READ-TEST-F1-04. IX2084.2 +074600* IX2084.2 +074700* TEST READ-TEST-F1-04 TESTS THE COBOL CONSTRUCT "READ FILE- IX2084.2 +074800* NAME NEXT INTO IDENTIFIER AT END". THE TEST READS THE FILE IX2084.2 +074900* SEQUENTIALY VIA THE RECORD KEY (RECORD KEY IS THE KEY OF IX2084.2 +075000* REFERENCE) UNTIL AN END-OF-FILE CONDITION OCCURS. A CHECK IX2084.2 +075100* IS MADE TO VERIFY THAT THE PROPER RECORDS WERE RETRIVED AND IX2084.2 +075200* THE AT END PATH WAS TAKEN ON THE 301 ST READ. IX2084.2 +075300* IX2084.2 +075400 READ-TEST-F1-04-1. IX2084.2 +075500 CLOSE IX-FD1. IX2084.2 +075600 PERFORM INX-TEST-002. IX2084.2 +075700* .04 IX2084.2 +075800 GO TO READ-INIT-F2-01. IX2084.2 +075900 READ-DELETE-F1-04. IX2084.2 +076000 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2084.2 +076100 PERFORM DE-LETE. IX2084.2 +076200 PERFORM PRINT-DETAIL. IX2084.2 +076300 READ-INIT-F2-01. IX2084.2 +076400 OPEN INPUT IX-FD1. IX2084.2 +076500 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2084.2 +076600 MOVE "READ . KEY IS .." TO FEATURE. IX2084.2 +076700 PERFORM INX-INIT-002-R. IX2084.2 +076800 MOVE ZERO TO WRK-DU-05V00-001. IX2084.2 +076900 READ-TEST-F2-01. IX2084.2 +077000 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +077100 ADD 000004 TO LOGICAL-FILE-REC. IX2084.2 +077200 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +077300 READ IX-FD1 IX2084.2 +077400 KEY IS IX-FD1-KEY. IX2084.2 +077500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +077600 PERFORM INX-VERIFY-002. IX2084.2 +077700 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +077800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +077900 GO TO READ-TEST-F2-01. IX2084.2 +078000 CLOSE IX-FD1. IX2084.2 +078100 PERFORM INX-TEST-002. IX2084.2 +078200* .05 IX2084.2 +078300 GO TO READ-INIT-F2-02. IX2084.2 +078400 READ-DELETE-F2-01. IX2084.2 +078500 MOVE "READ-TEST-F2-01 " TO PAR-NAME. IX2084.2 +078600 PERFORM DE-LETE. IX2084.2 +078700 PERFORM PRINT-DETAIL. IX2084.2 +078800 READ-INIT-F2-02. IX2084.2 +078900 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX2084.2 +079000 MOVE "READ ... INTO " TO FEATURE. IX2084.2 +079100 OPEN INPUT IX-FD1. IX2084.2 +079200 PERFORM INX-INIT-002-R. IX2084.2 +079300 MOVE ZERO TO WRK-DU-05V00-001. IX2084.2 +079400 READ-TEST-F2-02. IX2084.2 +079500 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +079600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +079700 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +079800 ADD 000004 TO LOGICAL-FILE-REC. IX2084.2 +079900 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +080000 READ IX-FD1 INTO FILE-RECORD-INFO (9) IX2084.2 +080100 KEY IS IX-FD1-KEY. IX2084.2 +080200 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +080300 PERFORM INX-VERIFY-002. IX2084.2 +080400 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-RECIX2084.2 +080500 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +080600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +080700 GO TO READ-TEST-F2-02. IX2084.2 +080800 CLOSE IX-FD1. IX2084.2 +080900 PERFORM INX-TEST-002. IX2084.2 +081000* .06 IX2084.2 +081100 GO TO READ-INIT-F2-03. IX2084.2 +081200 READ-DELETE-F2-02. IX2084.2 +081300 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX2084.2 +081400 PERFORM DE-LETE. IX2084.2 +081500 PERFORM PRINT-DETAIL. IX2084.2 +081600 READ-INIT-F2-03. IX2084.2 +081700 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX2084.2 +081800 MOVE "READ . KEY ALTERNATE" TO FEATURE. IX2084.2 +081900 OPEN INPUT IX-FD1. IX2084.2 +082000 PERFORM INX-INIT-002-R. IX2084.2 +082100 MOVE ZERO TO WRK-DU-05V00-002. IX2084.2 +082200 MOVE 301 TO LOGICAL-FILE-REC. IX2084.2 +082300 READ-TEST-F2-03. IX2084.2 +082400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +082500 ADD 00005 TO WRK-DU-05V00-002. IX2084.2 +082600 SUBTRACT 00006 FROM LOGICAL-FILE-REC. IX2084.2 +082700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +082800 READ IX-FD1 RECORD IX2084.2 +082900 KEY IX-FD1-ALTKEY1. IX2084.2 +083000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +083100 PERFORM INX-VERIFY-002. IX2084.2 +083200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +083300 GO TO READ-TEST-F2-03. IX2084.2 +083400 CLOSE IX-FD1. IX2084.2 +083500 PERFORM INX-TEST-002. IX2084.2 +083600* .07 IX2084.2 +083700 GO TO READ-INIT-F2-04. IX2084.2 +083800 READ-DELETE-F2-03. IX2084.2 +083900 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX2084.2 +084000 PERFORM DE-LETE. IX2084.2 +084100 PERFORM PRINT-DETAIL. IX2084.2 +084200 READ-INIT-F2-04. IX2084.2 +084300 MOVE "READ-TEST-F2-04 " TO PAR-NAME. IX2084.2 +084400 MOVE "READ .RECORD KEY ..." TO FEATURE. IX2084.2 +084500 OPEN INPUT IX-FD1. IX2084.2 +084600 PERFORM INX-INIT-002-R. IX2084.2 +084700 MOVE 00301 TO WRK-DU-05V00-001. IX2084.2 +084800 MOVE SPACE TO IX-FD1R1-F-G-240. IX2084.2 +084900 READ-TEST-F2-04. IX2084.2 +085000 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +085100 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +085200 READ IX-FD1 RECORD IX2084.2 +085300 KEY IX-FD1-KEY IX2084.2 +085400 INVALID SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +085500 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +085600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +085700 GO TO READ-TEST-F2-04. IX2084.2 +085800 CLOSE IX-FD1. IX2084.2 +085900 PERFORM INX-TEST-002. IX2084.2 +086000* .08 IX2084.2 +086100 GO TO READ-INIT-F2-05. IX2084.2 +086200 READ-DELETE-F2-04. IX2084.2 +086300 MOVE "READ-TEST-F2-04 " TO PAR-NAME. IX2084.2 +086400 PERFORM DE-LETE. IX2084.2 +086500 PERFORM PRINT-DETAIL. IX2084.2 +086600 READ-INIT-F2-05. IX2084.2 +086700 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX2084.2 +086800 MOVE "READ RECORD KEY IS A" TO FEATURE. IX2084.2 +086900 OPEN INPUT IX-FD1. IX2084.2 +087000 PERFORM INX-INIT-002-R. IX2084.2 +087100 MOVE 00010 TO WRK-DU-05V00-001. IX2084.2 +087200 MOVE 00301 TO WRK-DU-05V00-002. IX2084.2 +087300 MOVE SPACE TO IX-FD1R1-F-G-240. IX2084.2 +087400 READ-TEST-F2-05. IX2084.2 +087500 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +087600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +087700 ADD 00005 TO WRK-DU-05V00-002. IX2084.2 +087800 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +087900 READ IX-FD1 RECORD IX2084.2 +088000 KEY IS IX-FD1-ALTKEY1 IX2084.2 +088100 INVALID KEY SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +088200 ADD 00001 TO EXCUT-COUNTER-06V00. IX2084.2 +088300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +088400 GO TO READ-TEST-F2-05. IX2084.2 +088500 CLOSE IX-FD1. IX2084.2 +088600 PERFORM INX-TEST-002. IX2084.2 +088700* .09 IX2084.2 +088800 GO TO START-INIT-GF-01. IX2084.2 +088900 READ-DELETE-F2-05. IX2084.2 +089000 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX2084.2 +089100 PERFORM DE-LETE. IX2084.2 +089200 PERFORM PRINT-DETAIL. IX2084.2 +089300 INX-INIT-002-R. IX2084.2 +089400 MOVE 00010 TO ERROR-COUNTER-06V00. IX2084.2 +089500 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +089600 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +089700 MOVE ZERO TO LOGICAL-FILE-REC. IX2084.2 +089800 INX-VERIFY-002. IX2084.2 +089900 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +090000 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +090100 IF XRECORD-NUMBER (1) EQUAL TO LOGICAL-FILE-REC IX2084.2 +090200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +090300 INX-TEST-002. IX2084.2 +090400 IF ERROR-COUNTER-06V00 EQUAL TO ZERO IX2084.2 +090500 PERFORM PASS IX2084.2 +090600 ELSE IX2084.2 +090700 PERFORM FAIL IX2084.2 +090800 MOVE ZERO TO CORRECT-N IX2084.2 +090900 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N IX2084.2 +091000 MOVE "SEE PROGRAM (READ-TEST- ; IX-28)" TO RE-MARK. IX2084.2 +091100 PERFORM PRINT-DETAIL. IX2084.2 +091200* IX2084.2 +091300* EACH TEST IS EXECUTED 10 TIMES EXCEPT FOR INX-TEST-002-04IX2084.2 +091400* WHICH IS EXECUTED 300 TIMES. FOLLOWING THE LAST IX2084.2 +091500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS IX2084.2 +091600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO IX2084.2 +091700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED IX2084.2 +091800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED IX2084.2 +091900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 IX2084.2 +092000* IS INITIALIZED WITH A VALUE. EACH TIME THE CORRECT RECORD IX2084.2 +092100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY IX2084.2 +092200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR IX2084.2 +092300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. IX2084.2 +092400* FOR EACH EXECUTION THAT DID NOT PRODUCE THE EXPECTED IX2084.2 +092500* RESULTS THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE IX2084.2 +092600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATEIX2084.2 +092700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO IX2084.2 +092800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED IX2084.2 +092900* AS A RESULT OF THE READ OR START WAS NOT-AS EXPECTED. IX2084.2 +093000* IX2084.2 +093100* IX2084.2 +093200* IX2084.2 +093300* COMPUTED RESULT INDICATED IX2084.2 +093400* INCREMENTS ACTION IX2084.2 +093500* IX2084.2 +093600* 000100 THE RECORD FOUND IN THE IDENTIFIER IX2084.2 +093700* SPECIFIED IN THE INTO PHRASE OF THE IX2084.2 +093800* READ STATEMENT WAS NOT THE RECORD IX2084.2 +093900* EXPECTED FOLLOWING EXECUTION OF THE IX2084.2 +094000* READ. IX2084.2 +094100* IX2084.2 +094200* 000001 THE RECORD RETREIVED FROM THE FILE IX2084.2 +094300* FOLLOWING THE READ WAS NOT THE ONE IX2084.2 +094400* EXPECTED. IX2084.2 +094500* IX2084.2 +094600* 010000 AN UNEXPECTED INVALID KEY OR AT END IX2084.2 +094700* CONDITION OCCURRED. NOTE - ASSUMPTION IX2084.2 +094800* IS THAT THE "USE" STATEMENT IS ONLY IX2084.2 +094900* EXECUTED WHEN AN INVALID KEY OR AT END IX2084.2 +095000* CONDITION OCCURS AND THE INVALID KEY OR IX2084.2 +095100* AT END PHRASE HAS NOT BEEN SPECIFIED. IX2084.2 +095200* IX2084.2 +095300 START-INIT-GF-01. IX2084.2 +095400 OPEN INPUT IX-FD1. IX2084.2 +095500 OPEN INPUT IX-FS2. IX2084.2 +095600 PERFORM BLANK-LINE-PRINT. IX2084.2 +095700 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINE AS IX2084.2 +095800- "ACCESS MODE IS SEQUENTIAL" TO PRINT-REC. IX2084.2 +095900 PERFORM WRITE-LINE. IX2084.2 +096000 PERFORM BLANK-LINE-PRINT. IX2084.2 +096100 MOVE "START-TEST-GF-01 " TO PAR-NAME. IX2084.2 +096200 MOVE "START EQUAL TO" TO FEATURE. IX2084.2 +096300 PERFORM INX-INIT-003-R. IX2084.2 +096400 START-TEST-GF-01. IX2084.2 +096500 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +096600 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +096700 START IX-FS2. IX2084.2 +096800 READ IX-FS2 RECORD AT END IX2084.2 +096900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +097000 GO TO START-TEST-GF-01-1. IX2084.2 +097100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +097200 PERFORM INX-VERIFY-003A. IX2084.2 +097300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +097400 GO TO START-TEST-GF-01. IX2084.2 +097500 START-TEST-GF-01-1. IX2084.2 +097600 PERFORM INX-TEST-003. IX2084.2 +097700* .01 IX2084.2 +097800 GO TO START-INIT-GF-02. IX2084.2 +097900 INX-DELETE-003-01. IX2084.2 +098000 MOVE "START-TEST-GF-01 " TO PAR-NAME. IX2084.2 +098100 PERFORM DE-LETE. IX2084.2 +098200 PERFORM PRINT-DETAIL. IX2084.2 +098300 START-INIT-GF-02. IX2084.2 +098400 PERFORM INX-INIT-003-R. IX2084.2 +098500 START-TEST-GF-02. IX2084.2 +098600 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +098700 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +098800 START IX-FS2 IX2084.2 +098900 KEY EQUAL TO IX-FS2-KEY. IX2084.2 +099000 READ IX-FS2 RECORD AT END IX2084.2 +099100 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +099200 GO TO START-TEST-GF-02-1. IX2084.2 +099300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +099400 PERFORM INX-VERIFY-003A. IX2084.2 +099500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +099600 GO TO START-TEST-GF-02. IX2084.2 +099700 START-TEST-GF-02-1. IX2084.2 +099800 MOVE "START-TEST-GF-02 " TO PAR-NAME. IX2084.2 +099900 MOVE "START KEY EQUAL TO " TO FEATURE. IX2084.2 +100000 PERFORM INX-TEST-003. IX2084.2 +100100* .02 IX2084.2 +100200 GO TO START-INIT-GF-03. IX2084.2 +100300 START-DELETE-GF-02. IX2084.2 +100400 MOVE "START-TEST-GF-02 " TO PAR-NAME. IX2084.2 +100500 PERFORM DE-LETE. IX2084.2 +100600 PERFORM PRINT-DETAIL. IX2084.2 +100700 START-INIT-GF-03. IX2084.2 +100800 PERFORM INX-INIT-003-R. IX2084.2 +100900 START-TEST-GF-03. IX2084.2 +101000 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +101100 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +101200 START IX-FS2 IX2084.2 +101300 KEY IS EQUAL TO IX-FS2-KEY. IX2084.2 +101400 READ IX-FS2 RECORD AT END IX2084.2 +101500 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +101600 GO TO START-TEST-GF-03-1. IX2084.2 +101700 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +101800 PERFORM INX-VERIFY-003A. IX2084.2 +101900 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +102000 GO TO START-TEST-GF-03. IX2084.2 +102100 START-TEST-GF-03-1. IX2084.2 +102200 MOVE "START-TEST-GF-03 " TO PAR-NAME. IX2084.2 +102300 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +102400 PERFORM INX-TEST-003. IX2084.2 +102500* .03 IX2084.2 +102600 GO TO START-INIT-GF-04. IX2084.2 +102700 START-DELETE-GF-03. IX2084.2 +102800 MOVE "START-TEST-GF-03 " TO PAR-NAME. IX2084.2 +102900 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +103000 PERFORM DE-LETE. IX2084.2 +103100 PERFORM PRINT-DETAIL. IX2084.2 +103200 START-INIT-GF-04. IX2084.2 +103300 PERFORM INX-INIT-003-R. IX2084.2 +103400 START-TEST-GF-04. IX2084.2 +103500 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +103600 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +103700 START IX-FS2 IX2084.2 +103800 KEY IS EQUAL IX-FS2-KEY. IX2084.2 +103900 READ IX-FS2 RECORD AT END IX2084.2 +104000 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +104100 GO TO START-TEST-GF-04-1. IX2084.2 +104200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +104300 PERFORM INX-VERIFY-003A. IX2084.2 +104400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +104500 GO TO START-TEST-GF-04. IX2084.2 +104600 START-TEST-GF-04-1. IX2084.2 +104700 MOVE "START-TEST-GF-04 " TO PAR-NAME. IX2084.2 +104800 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +104900 PERFORM INX-TEST-003. IX2084.2 +105000* .04 IX2084.2 +105100 GO TO START-INIT-GF-05. IX2084.2 +105200 INX-DELETE-003-04. IX2084.2 +105300 MOVE "START-TEST-GF-04 " TO PAR-NAME. IX2084.2 +105400 PERFORM DE-LETE. IX2084.2 +105500 PERFORM PRINT-DETAIL. IX2084.2 +105600 START-INIT-GF-05. IX2084.2 +105700 PERFORM INX-INIT-003-R. IX2084.2 +105800 START-TEST-GF-05. IX2084.2 +105900 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +106000 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +106100 START IX-FS2 IX2084.2 +106200 KEY IS = IX-FS2-KEY. IX2084.2 +106300 READ IX-FS2 RECORD AT END IX2084.2 +106400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +106500 GO TO START-TEST-GF-05-1. IX2084.2 +106600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +106700 PERFORM INX-VERIFY-003A. IX2084.2 +106800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +106900 GO TO START-TEST-GF-05. IX2084.2 +107000 START-TEST-GF-05-1. IX2084.2 +107100 MOVE "START-TEST-GF-05 " TO PAR-NAME. IX2084.2 +107200 MOVE "START KEY IS = ... " TO FEATURE. IX2084.2 +107300 PERFORM INX-TEST-003. IX2084.2 +107400* .05 IX2084.2 +107500 GO TO START-INIT-GF-06. IX2084.2 +107600 START-DELETE-GF-05. IX2084.2 +107700 MOVE "START-TEST-GF-05 " TO PAR-NAME. IX2084.2 +107800 PERFORM DE-LETE. IX2084.2 +107900 PERFORM PRINT-DETAIL. IX2084.2 +108000 START-INIT-GF-06. IX2084.2 +108100 PERFORM INX-INIT-003-R. IX2084.2 +108200 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +108300 START-TEST-GF-06. IX2084.2 +108400 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +108500 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +108600 START IX-FS2 IX2084.2 +108700 KEY IS GREATER THAN IX-FS2-KEY. IX2084.2 +108800 READ IX-FS2 RECORD AT END IX2084.2 +108900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +109000 GO TO START-TEST-GF-06-1. IX2084.2 +109100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +109200 PERFORM INX-VERIFY-003A. IX2084.2 +109300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +109400 GO TO START-TEST-GF-06. IX2084.2 +109500 START-TEST-GF-06-1. IX2084.2 +109600 MOVE "START-TEST-GF-06 " TO PAR-NAME. IX2084.2 +109700 MOVE "START GREATER THAN" TO FEATURE. IX2084.2 +109800 PERFORM INX-TEST-003. IX2084.2 +109900* .06 IX2084.2 +110000 GO TO START-INIT-GF-07. IX2084.2 +110100 START-DELETE-GF-06. IX2084.2 +110200 MOVE "START-TEST-GF-06 " TO PAR-NAME. IX2084.2 +110300 PERFORM DE-LETE. IX2084.2 +110400 PERFORM PRINT-DETAIL. IX2084.2 +110500 START-INIT-GF-07. IX2084.2 +110600 PERFORM INX-INIT-003-R. IX2084.2 +110700 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +110800 START-TEST-GF-07. IX2084.2 +110900 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +111000 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +111100 START IX-FS2 IX2084.2 +111200 KEY GREATER THAN IX-FS2-KEY. IX2084.2 +111300 READ IX-FS2 RECORD AT END IX2084.2 +111400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +111500 GO TO START-TEST-GF-07-1. IX2084.2 +111600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +111700 PERFORM INX-VERIFY-003A. IX2084.2 +111800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +111900 GO TO START-TEST-GF-07. IX2084.2 +112000 START-TEST-GF-07-1. IX2084.2 +112100 MOVE "START-TEST-GF-07 " TO PAR-NAME. IX2084.2 +112200 MOVE "START KEY GREATER THAN" TO FEATURE. IX2084.2 +112300* .07 IX2084.2 +112400 GO TO START-INIT-GF-08. IX2084.2 +112500 START-DELETE-GF-07. IX2084.2 +112600 MOVE "START-TEST-GF-07 " TO PAR-NAME. IX2084.2 +112700 PERFORM DE-LETE. IX2084.2 +112800 PERFORM PRINT-DETAIL. IX2084.2 +112900 START-INIT-GF-08. IX2084.2 +113000 PERFORM INX-INIT-003-R. IX2084.2 +113100 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +113200 GIVING LOGICAL-FILE-REC. IX2084.2 +113300 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +113400 START-TEST-GF-08. IX2084.2 +113500 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +113600 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +113700 START IX-FS2 IX2084.2 +113800 KEY IS GREATER IX-FS2-ALTKEY1. IX2084.2 +113900 READ IX-FS2 RECORD AT END IX2084.2 +114000 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +114100 GO TO START-TEST-GF-08-1. IX2084.2 +114200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +114300 PERFORM INX-VERIFY-003A. IX2084.2 +114400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +114500 GO TO START-TEST-GF-08. IX2084.2 +114600 START-TEST-GF-08-1. IX2084.2 +114700 MOVE "START-TEST-GF-08 " TO PAR-NAME. IX2084.2 +114800 MOVE "START KEY IS GREATER" TO FEATURE. IX2084.2 +114900 PERFORM INX-TEST-003. IX2084.2 +115000* .08 IX2084.2 +115100 GO TO START-INIT-GF-09. IX2084.2 +115200 START-DELETE-GF-08. IX2084.2 +115300 MOVE "START-TEST-GF-08 " TO PAR-NAME. IX2084.2 +115400 PERFORM DE-LETE. IX2084.2 +115500 PERFORM PRINT-DETAIL. IX2084.2 +115600 START-INIT-GF-09. IX2084.2 +115700 PERFORM INX-INIT-003-R. IX2084.2 +115800 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +115900 GIVING LOGICAL-FILE-REC. IX2084.2 +116000 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +116100 START-TEST-GF-09. IX2084.2 +116200 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +116300 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +116400 START IX-FS2 IX2084.2 +116500 KEY IS > IX-FS2-ALTKEY1. IX2084.2 +116600 READ IX-FS2 RECORD AT END IX2084.2 +116700 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +116800 GO TO START-TEST-GF-09-1. IX2084.2 +116900 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +117000 PERFORM INX-VERIFY-003A. IX2084.2 +117100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +117200 GO TO START-TEST-GF-09. IX2084.2 +117300 START-TEST-GF-09-1. IX2084.2 +117400 MOVE "START-TEST-GF-09 " TO PAR-NAME. IX2084.2 +117500 MOVE "START KEY IS > ... " TO FEATURE. IX2084.2 +117600 PERFORM INX-TEST-003. IX2084.2 +117700* .09 IX2084.2 +117800 GO TO START-INIT-GF-10. IX2084.2 +117900 START-DELETE-GF-09. IX2084.2 +118000 MOVE "START-TEST-GF-09 " TO PAR-NAME. IX2084.2 +118100 PERFORM DE-LETE. IX2084.2 +118200 PERFORM PRINT-DETAIL. IX2084.2 +118300 START-INIT-GF-10. IX2084.2 +118400 PERFORM INX-INIT-003-R. IX2084.2 +118500 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +118600 GIVING LOGICAL-FILE-REC. IX2084.2 +118700 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +118800 START-TEST-GF-10. IX2084.2 +118900 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +119000 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +119100 START IX-FS2 IX2084.2 +119200 KEY > IX-FS2-ALTKEY1. IX2084.2 +119300 READ IX-FS2 RECORD AT END IX2084.2 +119400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +119500 GO TO START-TEST-GF-10-1. IX2084.2 +119600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +119700 PERFORM INX-VERIFY-003A. IX2084.2 +119800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +119900 GO TO START-TEST-GF-10. IX2084.2 +120000 START-TEST-GF-10-1. IX2084.2 +120100 MOVE "START-TEST-GF-10 " TO PAR-NAME. IX2084.2 +120200 MOVE "START ... KEY > ... " TO FEATURE. IX2084.2 +120300 PERFORM INX-TEST-003. IX2084.2 +120400* .10 IX2084.2 +120500 GO TO START-INIT-GF-11. IX2084.2 +120600 START-DELETE-GF-10. IX2084.2 +120700 MOVE "START-TEST-GF-10 " TO PAR-NAME. IX2084.2 +120800 PERFORM DE-LETE. IX2084.2 +120900 PERFORM PRINT-DETAIL. IX2084.2 +121000 START-INIT-GF-11. IX2084.2 +121100 MOVE "START NOT LESS THAN" TO FEATURE. IX2084.2 +121200 PERFORM INX-INIT-003-R. IX2084.2 +121300 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +121400 GIVING LOGICAL-FILE-REC. IX2084.2 +121500 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +121600 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +121700 START-TEST-GF-11. IX2084.2 +121800 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +121900 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +122000 START IX-FS2 IX2084.2 +122100 KEY IS NOT LESS THAN IX-FS2-ALTKEY1. IX2084.2 +122200 READ IX-FS2 RECORD AT END IX2084.2 +122300 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +122400 GO TO START-TEST-GF-11-1. IX2084.2 +122500 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +122600 PERFORM INX-VERIFY-003A. IX2084.2 +122700 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +122800 GO TO START-TEST-GF-11. IX2084.2 +122900 START-TEST-GF-11-1. IX2084.2 +123000 MOVE "START-TEST-GF-11 " TO PAR-NAME. IX2084.2 +123100 MOVE "START KEY IS NOT LESS THAN" TO FEATURE. IX2084.2 +123200 PERFORM INX-TEST-003. IX2084.2 +123300* .11 IX2084.2 +123400 GO TO START-INIT-GF-12. IX2084.2 +123500 START-DELETE-GF-22. IX2084.2 +123600 MOVE "START-TEST-GF-11 " TO PAR-NAME. IX2084.2 +123700 PERFORM DE-LETE. IX2084.2 +123800 PERFORM PRINT-DETAIL. IX2084.2 +123900 START-INIT-GF-12. IX2084.2 +124000 PERFORM INX-INIT-003-R. IX2084.2 +124100 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +124200 GIVING LOGICAL-FILE-REC. IX2084.2 +124300 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +124400 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +124500 START-TEST-GF-12. IX2084.2 +124600 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +124700 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +124800 START IX-FS2 IX2084.2 +124900 KEY IS NOT LESS IX-FS2-ALTKEY1. IX2084.2 +125000 READ IX-FS2 RECORD AT END IX2084.2 +125100 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +125200 GO TO START-TEST-GF-12-1. IX2084.2 +125300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +125400 PERFORM INX-VERIFY-003A. IX2084.2 +125500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +125600 GO TO START-TEST-GF-12. IX2084.2 +125700 START-TEST-GF-12-1. IX2084.2 +125800 MOVE "START-TEST-GF-12 " TO PAR-NAME. IX2084.2 +125900 MOVE "START KEY IS NOT LESS" TO FEATURE. IX2084.2 +126000 PERFORM INX-TEST-003. IX2084.2 +126100* .12 IX2084.2 +126200 GO TO START-INIT-GF-13. IX2084.2 +126300 START-DELETE-GF-12. IX2084.2 +126400 MOVE "START-TEST-GF-12 " TO PAR-NAME. IX2084.2 +126500 PERFORM DE-LETE. IX2084.2 +126600 PERFORM PRINT-DETAIL. IX2084.2 +126700 START-INIT-GF-13. IX2084.2 +126800 PERFORM INX-INIT-003-R. IX2084.2 +126900 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +127000 GIVING LOGICAL-FILE-REC. IX2084.2 +127100 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +127200 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +127300 START-TEST-GF-13. IX2084.2 +127400 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +127500 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +127600 START IX-FS2 IX2084.2 +127700 KEY NOT LESS THAN IX-FS2-ALTKEY1. IX2084.2 +127800 READ IX-FS2 RECORD AT END IX2084.2 +127900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +128000 GO TO START-TEST-GF-13-1. IX2084.2 +128100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +128200 PERFORM INX-VERIFY-003A. IX2084.2 +128300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +128400 GO TO START-TEST-GF-13. IX2084.2 +128500 START-TEST-GF-13-1. IX2084.2 +128600 MOVE "START-TEST-GF-13 " TO PAR-NAME. IX2084.2 +128700 MOVE "START KEY NOT LESS THAN " TO FEATURE. IX2084.2 +128800 PERFORM INX-TEST-003. IX2084.2 +128900* .13 IX2084.2 +129000 GO TO START-INIT-GF-14. IX2084.2 +129100 START-DELETE-GF-13. IX2084.2 +129200 MOVE "START-TEST-GF-13 " TO PAR-NAME. IX2084.2 +129300 PERFORM DE-LETE. IX2084.2 +129400 PERFORM PRINT-DETAIL. IX2084.2 +129500 START-INIT-GF-14. IX2084.2 +129600 PERFORM INX-INIT-003-R. IX2084.2 +129700 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +129800 GIVING LOGICAL-FILE-REC. IX2084.2 +129900 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +130000 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +130100 START-TEST-GF-14. IX2084.2 +130200 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +130300 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +130400 START IX-FS2 IX2084.2 +130500 KEY IS NOT < IX-FS2-ALTKEY1. IX2084.2 +130600 READ IX-FS2 RECORD AT END IX2084.2 +130700 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +130800 GO TO START-TEST-GF-14-1. IX2084.2 +130900 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +131000 PERFORM INX-VERIFY-003A. IX2084.2 +131100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +131200 GO TO START-TEST-GF-14. IX2084.2 +131300 START-TEST-GF-14-1. IX2084.2 +131400 MOVE "START-TEST-GF-14 " TO PAR-NAME. IX2084.2 +131500 MOVE "START KEY IS NOT < " TO FEATURE. IX2084.2 +131600 PERFORM INX-TEST-003. IX2084.2 +131700* .14 IX2084.2 +131800 GO TO START-INIT-GF-15. IX2084.2 +131900 START-DELETE-GF-14. IX2084.2 +132000 MOVE "START-TEST-GF-14 " TO PAR-NAME. IX2084.2 +132100 PERFORM DE-LETE. IX2084.2 +132200 PERFORM PRINT-DETAIL. IX2084.2 +132300 START-INIT-GF-15. IX2084.2 +132400 PERFORM BLANK-LINE-PRINT. IX2084.2 +132500 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS IX2084.2 +132600- "ACCESS MODE IS DYNAMIC" TO PRINT-REC. IX2084.2 +132700 PERFORM WRITE-LINE. IX2084.2 +132800 PERFORM BLANK-LINE-PRINT. IX2084.2 +132900 MOVE "START EQUAL TO " TO FEATURE. IX2084.2 +133000 PERFORM INX-INIT-003-R. IX2084.2 +133100 SUBTRACT WRK-DU-05V00-002 FROM IX-FD1-FILESIZE IX2084.2 +133200 GIVING LOGICAL-FILE-REC. IX2084.2 +133300 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +133400 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +133500 START-TEST-GF-15. IX2084.2 +133600 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +133700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +133800 START IX-FD1 IX2084.2 +133900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +134000 INVALID KEY ADD 010000 TO ERROR-COUNTER-06V00. IX2084.2 +134100 READ IX-FD1 NEXT RECORD AT END IX2084.2 +134200 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +134300 GO TO START-TEST-GF-15-1. IX2084.2 +134400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +134500 PERFORM INX-VERIFY-003B. IX2084.2 +134600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +134700 GO TO START-TEST-GF-15. IX2084.2 +134800 START-TEST-GF-15-1. IX2084.2 +134900 MOVE "START-TEST-GF-15 " TO PAR-NAME. IX2084.2 +135000 MOVE "START KEY IS EQUAL TO" TO FEATURE. IX2084.2 +135100 PERFORM INX-TEST-003. IX2084.2 +135200* .15 IX2084.2 +135300 GO TO START-INIT-GF-16. IX2084.2 +135400 START-DELETE-GF-15. IX2084.2 +135500 MOVE "START-TEST-GF-15 " TO PAR-NAME. IX2084.2 +135600 PERFORM DE-LETE. IX2084.2 +135700 PERFORM PRINT-DETAIL. IX2084.2 +135800 START-INIT-GF-16. IX2084.2 +135900 MOVE 00055 TO WRK-DU-05V00-001. IX2084.2 +136000 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +136100 MOVE "START INVALID KEY" TO FEATURE. IX2084.2 +136200 PERFORM INX-INIT-003-R. IX2084.2 +136300 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +136400 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-002. IX2084.2 +136500 START-TEST-GF-16. IX2084.2 +136600 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +136700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +136800 START IX-FD1 IX2084.2 +136900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +137000 INVALID SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +137100 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +137200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +137300 GO TO START-TEST-GF-16. IX2084.2 +137400 MOVE "START-TEST-GF-16 " TO PAR-NAME. IX2084.2 +137500 PERFORM INX-TEST-003. IX2084.2 +137600* .16 IX2084.2 +137700 GO TO START-INIT-GF-17. IX2084.2 +137800 START-DELETE-GF-16. IX2084.2 +137900 MOVE "START-TEST-GF-16 " TO PAR-NAME. IX2084.2 +138000 PERFORM DE-LETE. IX2084.2 +138100 PERFORM PRINT-DETAIL. IX2084.2 +138200 START-INIT-GF-17. IX2084.2 +138300 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +138400 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +138500 PERFORM INX-INIT-003-R. IX2084.2 +138600 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +138700 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +138800 START-TEST-GF-17. IX2084.2 +138900 ADD 00003 TO WRK-DU-05V00-001. IX2084.2 +139000 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +139100 START IX-FD1 INVALID KEY IX2084.2 +139200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +139300 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +139400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +139500 GO TO START-TEST-GF-17. IX2084.2 +139600 MOVE "START-TEST-GF-17 " TO PAR-NAME. IX2084.2 +139700 PERFORM INX-TEST-003. IX2084.2 +139800* .17 IX2084.2 +139900 GO TO START-INIT-GF-18. IX2084.2 +140000 START-DELETE-GF-17. IX2084.2 +140100 MOVE "START-TEST-GF-17 " TO PAR-NAME. IX2084.2 +140200 PERFORM DE-LETE. IX2084.2 +140300 PERFORM PRINT-DETAIL. IX2084.2 +140400 START-INIT-GF-18. IX2084.2 +140500 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +140600 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +140700 PERFORM INX-INIT-003-R. IX2084.2 +140800 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +140900 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +141000 START-TEST-GF-18. IX2084.2 +141100 ADD 00003 TO WRK-DU-05V00-001. IX2084.2 +141200 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +141300 START IX-FD1 ; INVALID KEY IX2084.2 +141400 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +141500 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +141600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +141700 GO TO START-TEST-GF-18. IX2084.2 +141800 MOVE "START-TEST-GF-18 " TO PAR-NAME. IX2084.2 +141900 PERFORM INX-TEST-003. IX2084.2 +142000* .18 IX2084.2 +142100 GO TO START-INIT-GF-19. IX2084.2 +142200 START-DELETE-GF-18. IX2084.2 +142300 MOVE "START-TEST-GF-18 " TO PAR-NAME. IX2084.2 +142400 PERFORM DE-LETE. IX2084.2 +142500 PERFORM PRINT-DETAIL. IX2084.2 +142600 START-INIT-GF-19. IX2084.2 +142700 PERFORM INX-INIT-003-R. IX2084.2 +142800 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +142900 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +143000 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-002. IX2084.2 +143100 START-TEST-GF-19. IX2084.2 +143200 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +143300 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +143400 START IX-FD1 IX2084.2 +143500 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +143600 ; INVALID KEY SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +143700 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +143800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +143900 GO TO START-TEST-GF-19. IX2084.2 +144000 MOVE "START-TEST-GF-19 " TO PAR-NAME. IX2084.2 +144100 PERFORM INX-TEST-003. IX2084.2 +144200* .19 IX2084.2 +144300 GO TO START-END. IX2084.2 +144400 START-DELETE-GF-19. IX2084.2 +144500 MOVE "START-TEST-GF-19 " TO PAR-NAME. IX2084.2 +144600 PERFORM DE-LETE. IX2084.2 +144700 PERFORM PRINT-DETAIL. IX2084.2 +144800 INX-INIT-003-R. IX2084.2 +144900 MOVE ZERO TO LOGICAL-FILE-REC. IX2084.2 +145000 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +145100 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +145200 MOVE 00050 TO WRK-DU-05V00-004. IX2084.2 +145300 MOVE ZERO TO WRK-DU-05V00-003. IX2084.2 +145400 MOVE 10 TO ERROR-COUNTER-06V00. IX2084.2 +145500 INX-VERIFY-003A. IX2084.2 +145600 IF ASCEND IX2084.2 +145700 ADD 000003 TO LOGICAL-FILE-REC IX2084.2 +145800 ELSE IX2084.2 +145900 SUBTRACT 000003 FROM LOGICAL-FILE-REC. IX2084.2 +146000 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (2) IX2084.2 +146100 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +146200 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +146300 INX-VERIFY-003B. IX2084.2 +146400 IF ASCEND IX2084.2 +146500 ADD 000002 TO LOGICAL-FILE-REC IX2084.2 +146600 ELSE IX2084.2 +146700 SUBTRACT 000002 FROM LOGICAL-FILE-REC. IX2084.2 +146800 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (1) IX2084.2 +146900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +147000 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +147100 INX-TEST-003. IX2084.2 +147200 IF EXCUT-COUNTER-06V00 NOT EQUAL TO 000010 IX2084.2 +147300 MULTIPLY 100 BY EXCUT-COUNTER-06V00 IX2084.2 +147400 ADD EXCUT-COUNTER-06V00 TO ERROR-COUNTER-06V00. IX2084.2 +147500 IF ERROR-COUNTER-06V00 EQUAL TO ZERO IX2084.2 +147600 PERFORM PASS IX2084.2 +147700 ELSE IX2084.2 +147800 PERFORM FAIL IX2084.2 +147900 MOVE ZERO TO CORRECT-N IX2084.2 +148000 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N IX2084.2 +148100 MOVE "SEE PROGRAM (START-TEST- ); IX-36" TO RE-MARK.IX2084.2 +148200 PERFORM PRINT-DETAIL. IX2084.2 +148300* IX2084.2 +148400* EACH TEST IS EXECUTED 10 TIMES. FOLLOWING THE 10TH IX2084.2 +148500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS IX2084.2 +148600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO IX2084.2 +148700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED IX2084.2 +148800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED IX2084.2 +148900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 IX2084.2 +149000* IS LOADED WITH THE VALUE 10. EACH TIME THE CORRECT RECORD IX2084.2 +149100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY IX2084.2 +149200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR IX2084.2 +149300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. IX2084.2 +149400* FOR EACH ACTION THAT DID NOT OCCUR AS IX2084.2 +149500* EXPECTED THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE IX2084.2 +149600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATEIX2084.2 +149700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO IX2084.2 +149800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED IX2084.2 +149900* AS A RESULT OF THE READ OR START WAS NOT AS EXPECTED. IX2084.2 +150000* IX2084.2 +150100* COMPUTED RESULT INDICATED IX2084.2 +150200* INCREMENTS ACTION IX2084.2 +150300* IX2084.2 +150400* 000001 THE RECORD RETREIVED FROM THE FILE IX2084.2 +150500* FOLLOWING THE READ WAS NOT THE ONE IX2084.2 +150600* EXPECTED. IX2084.2 +150700* IX2084.2 +150800* 000100 INDICATES,BY 10"S THE NUMBER OF TIMES THE IX2084.2 +150900* TEST WAS EXECUTED. IX2084.2 +151000* IX2084.2 +151100* 010000 AN UNEXPECTED INVALID KEY OR AT END IX2084.2 +151200* CONDITION OCCURRED. NOTE - ASSUMPTION IX2084.2 +151300* IS THAT THE "USE" STATEMENT IS ONLY IX2084.2 +151400* EXECUTED WHEN AN INVALID KEY OR AT END IX2084.2 +151500* CONDITION OCCURS AND THE INVALID KEY OR IX2084.2 +151600* AT END PHRASE HAS NOT BEEN SPECIFIED. IX2084.2 +151700* IX2084.2 +151800 START-END. IX2084.2 +151900 CLOSE IX-FD1. IX2084.2 +152000 CLOSE IX-FS2. IX2084.2 +152100 INX-EXIT-003. IX2084.2 +152200 EXIT. IX2084.2 +152300 CCVS-EXIT SECTION. IX2084.2 +152400 CCVS-999999. IX2084.2 +152500 GO TO CLOSE-FILES. IX2084.2 +*END-OF,IX208A +*HEADER,COBOL,IX209A +000100 IDENTIFICATION DIVISION. IX2094.2 +000200 PROGRAM-ID. IX2094.2 +000300 IX209A. IX2094.2 +000400**************************************************************** IX2094.2 +000500* * IX2094.2 +000600* VALIDATION FOR:- * IX2094.2 +000700* * IX2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +000900* * IX2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2094.2 +001100* * IX2094.2 +001200**************************************************************** IX2094.2 +001300* * IX2094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2094.2 +001500* * IX2094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2094.2 +001900* * IX2094.2 +002000**************************************************************** IX2094.2 +002100* "IX209A" IX2094.2 +002200******************************************************************IX2094.2 +002300* THE PURPOSE OF THIS PROGRAM IS TO TEST USE OF THE IX2094.2 +002400* START --- EQUAL TO --- STATEMENT USING FIRST THE PRIME IX2094.2 +002500* RECORD KEY AND THEN WITH EACH OF THE ALTERNATE RECORD KEYS IX2094.2 +002600* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2094.2 +002700* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2094.2 +002800* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2094.2 +002900* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2094.2 +003000* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2094.2 +003100* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2094.2 +003200* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2094.2 +003300* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2094.2 +003400* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2094.2 +003500* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2094.2 +003600* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2094.2 +003700* IX2094.2 +003800* REFERENCE AMERICAN NATIONAL STANDARD IX2094.2 +003900* PROGRAMMING LANGUAGE COBOL, X3.23-198X. IX2094.2 +004000* SECTION IX, INDEX I-O, THE START IX2094.2 +004100* STATEMENT. PARAGRAPHS 4.7.3 (3), (4); IX2094.2 +004200* 4.7.4 (1), (4), (5)IX2094.2 +004300* AND IX2094.2 +004400* THE FILE STATUS PARAGRAPH 1.3.4 IX2094.2 +004500* IX2094.2 +004600* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2094.2 +004700* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2094.2 +004800* FROM THE TEST, AND THE RECORD KEY IS LOADED WITH A KEY VALUE.IX2094.2 +004900* DEPENDING ON THE NATURE OF THE TEST THE KEY VALUE MAY OR IX2094.2 +005000* MAY NOT BE A VALID KEY FOR THE FILE. IX2094.2 +005100* IX2094.2 +005200* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2094.2 +005300* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2094.2 +005400* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2094.2 +005500* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2094.2 +005600* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2094.2 +005700* EQUAL TO --- STATEMENT. IX2094.2 +005800* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2094.2 +005900* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2094.2 +006000* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2094.2 +006100* THE FILE. IX2094.2 +006200* IX2094.2 +006300* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2094.2 +006400* ------ ---------- --------------- --------------- IX2094.2 +006500* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2094.2 +006600* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2094.2 +006700* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2094.2 +006800* . . . . IX2094.2 +006900* . . . . IX2094.2 +007000* . . . . IX2094.2 +007100* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2094.2 +007200* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2094.2 +007300* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2094.2 +007400* . . . . IX2094.2 +007500* . . . . IX2094.2 +007600* . . . . IX2094.2 +007700* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2094.2 +007800* IX2094.2 +007900* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2094.2 +008000* EVERY 10TH AND 11TH RECORDS. IX2094.2 +008100* IX2094.2 +008200* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2094.2 +008300* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2094.2 +008400* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2094.2 +008500* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2094.2 +008600* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2094.2 +008700* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2094.2 +008800* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2094.2 +008900* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2094.2 +009000* THE FILE. IX2094.2 +009100* IX2094.2 +009200* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2094.2 +009300* RECORD SIZE = 240 CHARS. IX2094.2 +009400* RECORD KEY SIZE = 13 CHARS. IX2094.2 +009500* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2094.2 +009600* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2094.2 +009700* ACCESS MODE = SEQUENTIAL IX2094.2 +009800* IX2094.2 +009900* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2094.2 +010000* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2094.2 +010100* TEST FOLLOWS. IX2094.2 +010200* IX2094.2 +010300* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2094.2 +010400* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2094.2 +010500* TWO ALTERNATE KEYS. IX2094.2 +010600* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2094.2 +010700* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2094.2 +010800* FILE WAS CREATED CORRECTLY. IX2094.2 +010900* START --- KEY IS EQUAL TO RECORD-KEY INVALID KEY ---. (INX-IX2094.2 +011000* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2094.2 +011100* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2094.2 +011200* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +011300* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +011400* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +011500* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +011600* FILE (.04). IX2094.2 +011700* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +011800* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2094.2 +011900* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +012000* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2094.2 +012100* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +012200* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +012300* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +012400* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +012500* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +012600* THE LAST RECORD IN THE FILE (.09. IX2094.2 +012700* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2094.2 +012800* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +012900* FROM THE START IN INX-TEST-003.01 THRU IX2094.2 +013000* INX-TEST-003.09. IX2094.2 +013100* START --- KEY IS EQUAL TO ALTNATE-KEY INVALID KEY --. (INX-IX2094.2 +013200* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2094.2 +013300* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2094.2 +013400* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +013500* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +013600* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +013700* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +013800* FILE (.04). IX2094.2 +013900* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +014000* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2094.2 +014100* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +014200* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2094.2 +014300* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +014400* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +014500* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +014600* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +014700* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +014800* THE LAST RECORD IN THE FILE (.09. IX2094.2 +014900* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2094.2 +015000* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +015100* FROM THE START IN INX-TEST-005.01 THRU IX2094.2 +015200* INX-TEST-005.09. IX2094.2 +015300* START --- KEY IS EQUAL TO ALTNATE-KEY INVALID KEY --. (INX-IX2094.2 +015400* TEST-007.01 THRU INX-TEST-007.04) - THE START IX2094.2 +015500* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY IX2094.2 +015600* WHICH SPECIFIES THE DUPLICATES OPTION FOR THE FILE IX2094.2 +015700* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +015800* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +015900* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +016000* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +016100* FILE (.04). IX2094.2 +016200* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +016300* TEST-007.05 THRU INX-TEST-007.09) - THE START IX2094.2 +016400* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +016500* SUBORDINATE TO THE ALTERNATE-KEY W/DUP FOR THE FILE IX2094.2 +016600* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +016700* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +016800* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +016900* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +017000* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +017100* THE LAST RECORD IN THE FILE (.09. IX2094.2 +017200* FILE STATUS. (INX-TEST-008.01 THRU INX-TEST-008.09) - THESEIX2094.2 +017300* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +017400* FROM THE START IN INX-TEST-007.01 THRU IX2094.2 +017500* INX-TEST-007.09. IX2094.2 +017600* IX2094.2 +017700******************************************************************IX2094.2 +017800 ENVIRONMENT DIVISION. IX2094.2 +017900 CONFIGURATION SECTION. IX2094.2 +018000 SOURCE-COMPUTER. IX2094.2 +018100 XXXXX082. IX2094.2 +018200 OBJECT-COMPUTER. IX2094.2 +018300 XXXXX083. IX2094.2 +018400 INPUT-OUTPUT SECTION. IX2094.2 +018500 FILE-CONTROL. IX2094.2 +018600P SELECT RAW-DATA ASSIGN TO IX2094.2 +018700P XXXXX062 IX2094.2 +018800P ORGANIZATION IS INDEXED IX2094.2 +018900P ACCESS MODE IS RANDOM IX2094.2 +019000P RECORD KEY IS RAW-DATA-KEY. IX2094.2 +019100 SELECT PRINT-FILE ASSIGN TO IX2094.2 +019200 XXXXX055. IX2094.2 +019300 SELECT IX-FS1 IX2094.2 +019400 ASSIGN TO IX2094.2 +019500 XXXXX024 IX2094.2 +019600J XXXXX044 IX2094.2 +019700 ACCESS MODE IS SEQUENTIAL IX2094.2 +019800 ORGANIZATION IS INDEXED IX2094.2 +019900 RECORD KEY IS IX-FS1-KEY IX2094.2 +020000 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2094.2 +020100 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2094.2 +020200 FILE STATUS IS FS1-STATUS. IX2094.2 +020300 DATA DIVISION. IX2094.2 +020400 FILE SECTION. IX2094.2 +020500P IX2094.2 +020600PFD RAW-DATA. IX2094.2 +020700P IX2094.2 +020800P01 RAW-DATA-SATZ. IX2094.2 +020900P 05 RAW-DATA-KEY PIC X(6). IX2094.2 +021000P 05 C-DATE PIC 9(6). IX2094.2 +021100P 05 C-TIME PIC 9(8). IX2094.2 +021200P 05 C-NO-OF-TESTS PIC 99. IX2094.2 +021300P 05 C-OK PIC 999. IX2094.2 +021400P 05 C-ALL PIC 999. IX2094.2 +021500P 05 C-FAIL PIC 999. IX2094.2 +021600P 05 C-DELETED PIC 999. IX2094.2 +021700P 05 C-INSPECT PIC 999. IX2094.2 +021800P 05 C-NOTE PIC X(13). IX2094.2 +021900P 05 C-INDENT PIC X. IX2094.2 +022000P 05 C-ABORT PIC X(8). IX2094.2 +022100 FD PRINT-FILE. IX2094.2 +022200 01 PRINT-REC PICTURE X(120). IX2094.2 +022300 01 DUMMY-RECORD PICTURE X(120). IX2094.2 +022400 FD IX-FS1 IX2094.2 +022500C LABEL RECORDS ARE STANDARD IX2094.2 +022600C DATA RECORD IS IX-FS1R1-F-G-240 IX2094.2 +022700 RECORD CONTAINS 240 CHARACTERS. IX2094.2 +022800 01 IX-FS1R1-F-G-240. IX2094.2 +022900 05 IX-FS1-REC-120 PICTURE X(120). IX2094.2 +023000 05 IX-FS1-REC-121-240. IX2094.2 +023100 10 FILLER PICTURE X(8). IX2094.2 +023200 10 IX-REC-KEY-AREA. IX2094.2 +023300 15 IX-FS1-KEY. IX2094.2 +023400 20 IX-FS1-KEY-1-10. IX2094.2 +023500 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2094.2 +023600 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2094.2 +023700 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2094.2 +023800 15 FILLER PICTURE X(16). IX2094.2 +023900 10 FILLER PICTURE X(9). IX2094.2 +024000 10 IX-ALT-KEY1-AREA. IX2094.2 +024100 15 IX-FS1-ALTKEY1. IX2094.2 +024200 20 IX-FS1-ALTKEY1-1-10. IX2094.2 +024300 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2094.2 +024400 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2094.2 +024500 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2094.2 +024600 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2094.2 +024700 15 FILLER PICTURE X(9). IX2094.2 +024800 10 FILLER PICTURE X(9). IX2094.2 +024900 10 IX-ALT-KEY2-AREA. IX2094.2 +025000 15 IX-FS1-ALTKEY2. IX2094.2 +025100 20 IX-FS1-ALTKEY2-1-10. IX2094.2 +025200 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2094.2 +025300 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2094.2 +025400 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2094.2 +025500 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2094.2 +025600 15 FILLER PICTURE X(9). IX2094.2 +025700 10 FILLER PICTURE X(7). IX2094.2 +025800 WORKING-STORAGE SECTION. IX2094.2 +025900 01 WRK-FS1-RECKEY. IX2094.2 +026000 05 FS1-RECKEY-1-13. IX2094.2 +026100 10 FS1-RECKEY-1-10 PICTURE X(10). IX2094.2 +026200 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2094.2 +026300 05 FILLER PICTURE X(16) VALUE SPACE. IX2094.2 +026400 01 WRK-FS1-ALTKEY1. IX2094.2 +026500 05 FS1-ALTKEY1-1-20. IX2094.2 +026600 10 FS1-ALTKEY1-1-10. IX2094.2 +026700 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2094.2 +026800 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2094.2 +026900 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2094.2 +027000 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2094.2 +027100 05 FILLER PICTURE X(9) VALUE SPACE. IX2094.2 +027200 01 WRK-FS1-ALTKEY2. IX2094.2 +027300 05 FS1-ALTKEY2-1-20. IX2094.2 +027400 10 FS1-ALTKEY2-1-10. IX2094.2 +027500 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2094.2 +027600 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2094.2 +027700 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2094.2 +027800 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2094.2 +027900 05 FILLER PICTURE X(9) VALUE SPACE. IX2094.2 +028000 01 RECNO PICTURE 9(5) VALUE ZERO. IX2094.2 +028100 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2094.2 +028200 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2094.2 +028300 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2094.2 +028400 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2094.2 +028500 01 RECORDS-WRITTEN PICTURE 9(3). IX2094.2 +028600 01 RECKEY-NUM PICTURE 9(3). IX2094.2 +028700 01 ALTKEY1-NUM PICTURE 9(3). IX2094.2 +028800 01 ALTKEY2-NUM PICTURE 9(3). IX2094.2 +028900 01 RECORD-KEY-CONTENT. IX2094.2 +029000 05 FILLER PIC X(53) VALUE IX2094.2 +029100 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2094.2 +029200 05 FILLER PIC X(53) VALUE IX2094.2 +029300 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2094.2 +029400 05 FILLER PIC X(53) VALUE IX2094.2 +029500 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2094.2 +029600 05 FILLER PIC X(53) VALUE IX2094.2 +029700 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2094.2 +029800 05 FILLER PIC X(53) VALUE IX2094.2 +029900 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2094.2 +030000 05 FILLER PIC X(53) VALUE IX2094.2 +030100 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2094.2 +030200 05 FILLER PIC X(53) VALUE IX2094.2 +030300 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2094.2 +030400 05 FILLER PIC X(53) VALUE IX2094.2 +030500 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2094.2 +030600 05 FILLER PIC X(53) VALUE IX2094.2 +030700 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2094.2 +030800 05 FILLER PIC X(53) VALUE IX2094.2 +030900 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2094.2 +031000 05 FILLER PIC X(53) VALUE IX2094.2 +031100 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2094.2 +031200 05 FILLER PIC X(53) VALUE IX2094.2 +031300 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2094.2 +031400 05 FILLER PIC X(53) VALUE IX2094.2 +031500 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2094.2 +031600 05 FILLER PIC X(53) VALUE IX2094.2 +031700 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2094.2 +031800 05 FILLER PIC X(53) VALUE IX2094.2 +031900 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2094.2 +032000 05 FILLER PIC X(53) VALUE IX2094.2 +032100 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2094.2 +032200 05 FILLER PIC X(53) VALUE IX2094.2 +032300 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2094.2 +032400 05 FILLER PIC X(53) VALUE IX2094.2 +032500 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2094.2 +032600 05 FILLER PIC X(53) VALUE IX2094.2 +032700 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2094.2 +032800 05 FILLER PIC X(53) VALUE IX2094.2 +032900 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2094.2 +033000 05 FILLER PIC X(53) VALUE IX2094.2 +033100 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2094.2 +033200 05 FILLER PIC X(53) VALUE IX2094.2 +033300 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2094.2 +033400 05 FILLER PIC X(53) VALUE IX2094.2 +033500 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2094.2 +033600 05 FILLER PIC X(53) VALUE IX2094.2 +033700 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2094.2 +033800 05 FILLER PIC X(53) VALUE IX2094.2 +033900 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2094.2 +034000 05 FILLER PIC X(53) VALUE IX2094.2 +034100 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2094.2 +034200 05 FILLER PIC X(53) VALUE IX2094.2 +034300 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2094.2 +034400 05 FILLER PIC X(53) VALUE IX2094.2 +034500 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2094.2 +034600 05 FILLER PIC X(53) VALUE IX2094.2 +034700 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2094.2 +034800 05 FILLER PIC X(53) VALUE IX2094.2 +034900 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2094.2 +035000 05 FILLER PIC X(53) VALUE IX2094.2 +035100 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2094.2 +035200 05 FILLER PIC X(53) VALUE IX2094.2 +035300 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2094.2 +035400 05 FILLER PIC X(53) VALUE IX2094.2 +035500 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2094.2 +035600 05 FILLER PIC X(53) VALUE IX2094.2 +035700 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2094.2 +035800 05 FILLER PIC X(53) VALUE IX2094.2 +035900 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2094.2 +036000 05 FILLER PIC X(53) VALUE IX2094.2 +036100 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2094.2 +036200 05 FILLER PIC X(53) VALUE IX2094.2 +036300 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2094.2 +036400 05 FILLER PIC X(53) VALUE IX2094.2 +036500 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2094.2 +036600 05 FILLER PIC X(53) VALUE IX2094.2 +036700 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2094.2 +036800 05 FILLER PIC X(53) VALUE IX2094.2 +036900 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2094.2 +037000 05 FILLER PIC X(53) VALUE IX2094.2 +037100 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2094.2 +037200 05 FILLER PIC X(53) VALUE IX2094.2 +037300 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2094.2 +037400 05 FILLER PIC X(53) VALUE IX2094.2 +037500 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2094.2 +037600 05 FILLER PIC X(53) VALUE IX2094.2 +037700 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2094.2 +037800 05 FILLER PIC X(53) VALUE IX2094.2 +037900 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2094.2 +038000 05 FILLER PIC X(53) VALUE IX2094.2 +038100 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2094.2 +038200 05 FILLER PIC X(53) VALUE IX2094.2 +038300 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2094.2 +038400 05 FILLER PIC X(53) VALUE IX2094.2 +038500 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2094.2 +038600 05 FILLER PIC X(53) VALUE IX2094.2 +038700 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2094.2 +038800 05 FILLER PIC X(53) VALUE IX2094.2 +038900 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2094.2 +039000 05 FILLER PIC X(53) VALUE IX2094.2 +039100 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2094.2 +039200 05 FILLER PIC X(53) VALUE IX2094.2 +039300 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2094.2 +039400 05 FILLER PIC X(53) VALUE IX2094.2 +039500 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2094.2 +039600 05 FILLER PIC X(53) VALUE IX2094.2 +039700 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2094.2 +039800 05 FILLER PIC X(53) VALUE IX2094.2 +039900 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2094.2 +040000 05 FILLER PIC X(53) VALUE IX2094.2 +040100 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2094.2 +040200 05 FILLER PIC X(53) VALUE IX2094.2 +040300 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2094.2 +040400 05 FILLER PIC X(53) VALUE IX2094.2 +040500 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2094.2 +040600 05 FILLER PIC X(53) VALUE IX2094.2 +040700 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2094.2 +040800 05 FILLER PIC X(53) VALUE IX2094.2 +040900 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2094.2 +041000 05 FILLER PIC X(53) VALUE IX2094.2 +041100 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2094.2 +041200 05 FILLER PIC X(53) VALUE IX2094.2 +041300 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2094.2 +041400 05 FILLER PIC X(53) VALUE IX2094.2 +041500 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2094.2 +041600 05 FILLER PIC X(53) VALUE IX2094.2 +041700 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2094.2 +041800 05 FILLER PIC X(53) VALUE IX2094.2 +041900 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2094.2 +042000 05 FILLER PIC X(53) VALUE IX2094.2 +042100 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2094.2 +042200 05 FILLER PIC X(53) VALUE IX2094.2 +042300 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2094.2 +042400 05 FILLER PIC X(53) VALUE IX2094.2 +042500 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2094.2 +042600 05 FILLER PIC X(53) VALUE IX2094.2 +042700 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2094.2 +042800 05 FILLER PIC X(53) VALUE IX2094.2 +042900 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2094.2 +043000 05 FILLER PIC X(53) VALUE IX2094.2 +043100 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2094.2 +043200 05 FILLER PIC X(53) VALUE IX2094.2 +043300 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2094.2 +043400 05 FILLER PIC X(53) VALUE IX2094.2 +043500 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2094.2 +043600 05 FILLER PIC X(53) VALUE IX2094.2 +043700 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2094.2 +043800 05 FILLER PIC X(53) VALUE IX2094.2 +043900 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2094.2 +044000 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2094.2 +044100 05 KEY-VALUES OCCURS 75 TIMES. IX2094.2 +044200 10 RECKEY-VALUE PICTURE X(13). IX2094.2 +044300 10 ALTKEY1-VALUE PICTURE X(20). IX2094.2 +044400 10 ALTKEY2-VALUE PICTURE X(20). IX2094.2 +044500 01 INIT-FLAG PICTURE 9. IX2094.2 +044600 01 HOLD-FILESTATUS-RECORD. IX2094.2 +044700 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2094.2 +044800 01 FILE-RECORD-INFORMATION-REC. IX2094.2 +044900 03 FILE-RECORD-INFO-SKELETON. IX2094.2 +045000 05 FILLER PICTURE X(48) VALUE IX2094.2 +045100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2094.2 +045200 05 FILLER PICTURE X(46) VALUE IX2094.2 +045300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2094.2 +045400 05 FILLER PICTURE X(26) VALUE IX2094.2 +045500 ",LFIL=000000,ORG= ,LBLR= ". IX2094.2 +045600 05 FILLER PICTURE X(37) VALUE IX2094.2 +045700 ",RECKEY= ". IX2094.2 +045800 05 FILLER PICTURE X(38) VALUE IX2094.2 +045900 ",ALTKEY1= ". IX2094.2 +046000 05 FILLER PICTURE X(38) VALUE IX2094.2 +046100 ",ALTKEY2= ". IX2094.2 +046200 05 FILLER PICTURE X(7) VALUE SPACE.IX2094.2 +046300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2094.2 +046400 05 FILE-RECORD-INFO-P1-120. IX2094.2 +046500 07 FILLER PIC X(5). IX2094.2 +046600 07 XFILE-NAME PIC X(6). IX2094.2 +046700 07 FILLER PIC X(8). IX2094.2 +046800 07 XRECORD-NAME PIC X(6). IX2094.2 +046900 07 FILLER PIC X(1). IX2094.2 +047000 07 REELUNIT-NUMBER PIC 9(1). IX2094.2 +047100 07 FILLER PIC X(7). IX2094.2 +047200 07 XRECORD-NUMBER PIC 9(6). IX2094.2 +047300 07 FILLER PIC X(6). IX2094.2 +047400 07 UPDATE-NUMBER PIC 9(2). IX2094.2 +047500 07 FILLER PIC X(5). IX2094.2 +047600 07 ODO-NUMBER PIC 9(4). IX2094.2 +047700 07 FILLER PIC X(5). IX2094.2 +047800 07 XPROGRAM-NAME PIC X(5). IX2094.2 +047900 07 FILLER PIC X(7). IX2094.2 +048000 07 XRECORD-LENGTH PIC 9(6). IX2094.2 +048100 07 FILLER PIC X(7). IX2094.2 +048200 07 CHARS-OR-RECORDS PIC X(2). IX2094.2 +048300 07 FILLER PIC X(1). IX2094.2 +048400 07 XBLOCK-SIZE PIC 9(4). IX2094.2 +048500 07 FILLER PIC X(6). IX2094.2 +048600 07 RECORDS-IN-FILE PIC 9(6). IX2094.2 +048700 07 FILLER PIC X(5). IX2094.2 +048800 07 XFILE-ORGANIZATION PIC X(2). IX2094.2 +048900 07 FILLER PIC X(6). IX2094.2 +049000 07 XLABEL-TYPE PIC X(1). IX2094.2 +049100 05 FILE-RECORD-INFO-P121-240. IX2094.2 +049200 07 FILLER PIC X(8). IX2094.2 +049300 07 XRECORD-KEY PIC X(29). IX2094.2 +049400 07 FILLER PIC X(9). IX2094.2 +049500 07 ALTERNATE-KEY1 PIC X(29). IX2094.2 +049600 07 FILLER PIC X(9). IX2094.2 +049700 07 ALTERNATE-KEY2 PIC X(29). IX2094.2 +049800 07 FILLER PIC X(7). IX2094.2 +049900 01 TEST-RESULTS. IX2094.2 +050000 02 FILLER PIC X VALUE SPACE. IX2094.2 +050100 02 FEATURE PIC X(20) VALUE SPACE. IX2094.2 +050200 02 FILLER PIC X VALUE SPACE. IX2094.2 +050300 02 P-OR-F PIC X(5) VALUE SPACE. IX2094.2 +050400 02 FILLER PIC X VALUE SPACE. IX2094.2 +050500 02 PAR-NAME. IX2094.2 +050600 03 FILLER PIC X(19) VALUE SPACE. IX2094.2 +050700 03 PARDOT-X PIC X VALUE SPACE. IX2094.2 +050800 03 DOTVALUE PIC 99 VALUE ZERO. IX2094.2 +050900 02 FILLER PIC X(8) VALUE SPACE. IX2094.2 +051000 02 RE-MARK PIC X(61). IX2094.2 +051100 01 TEST-COMPUTED. IX2094.2 +051200 02 FILLER PIC X(30) VALUE SPACE. IX2094.2 +051300 02 FILLER PIC X(17) VALUE IX2094.2 +051400 " COMPUTED=". IX2094.2 +051500 02 COMPUTED-X. IX2094.2 +051600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2094.2 +051700 03 COMPUTED-N REDEFINES COMPUTED-A IX2094.2 +051800 PIC -9(9).9(9). IX2094.2 +051900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2094.2 +052000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2094.2 +052100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2094.2 +052200 03 CM-18V0 REDEFINES COMPUTED-A. IX2094.2 +052300 04 COMPUTED-18V0 PIC -9(18). IX2094.2 +052400 04 FILLER PIC X. IX2094.2 +052500 03 FILLER PIC X(50) VALUE SPACE. IX2094.2 +052600 01 TEST-CORRECT. IX2094.2 +052700 02 FILLER PIC X(30) VALUE SPACE. IX2094.2 +052800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2094.2 +052900 02 CORRECT-X. IX2094.2 +053000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2094.2 +053100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2094.2 +053200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2094.2 +053300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2094.2 +053400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2094.2 +053500 03 CR-18V0 REDEFINES CORRECT-A. IX2094.2 +053600 04 CORRECT-18V0 PIC -9(18). IX2094.2 +053700 04 FILLER PIC X. IX2094.2 +053800 03 FILLER PIC X(2) VALUE SPACE. IX2094.2 +053900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2094.2 +054000 01 CCVS-C-1. IX2094.2 +054100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2094.2 +054200- "SS PARAGRAPH-NAME IX2094.2 +054300- " REMARKS". IX2094.2 +054400 02 FILLER PIC X(20) VALUE SPACE. IX2094.2 +054500 01 CCVS-C-2. IX2094.2 +054600 02 FILLER PIC X VALUE SPACE. IX2094.2 +054700 02 FILLER PIC X(6) VALUE "TESTED". IX2094.2 +054800 02 FILLER PIC X(15) VALUE SPACE. IX2094.2 +054900 02 FILLER PIC X(4) VALUE "FAIL". IX2094.2 +055000 02 FILLER PIC X(94) VALUE SPACE. IX2094.2 +055100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2094.2 +055200 01 REC-CT PIC 99 VALUE ZERO. IX2094.2 +055300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2094.2 +055800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2094.2 +055900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2094.2 +056000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2094.2 +056100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2094.2 +056200 01 CCVS-H-1. IX2094.2 +056300 02 FILLER PIC X(39) VALUE SPACES. IX2094.2 +056400 02 FILLER PIC X(42) VALUE IX2094.2 +056500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2094.2 +056600 02 FILLER PIC X(39) VALUE SPACES. IX2094.2 +056700 01 CCVS-H-2A. IX2094.2 +056800 02 FILLER PIC X(40) VALUE SPACE. IX2094.2 +056900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2094.2 +057000 02 FILLER PIC XXXX VALUE IX2094.2 +057100 "4.2 ". IX2094.2 +057200 02 FILLER PIC X(28) VALUE IX2094.2 +057300 " COPY - NOT FOR DISTRIBUTION". IX2094.2 +057400 02 FILLER PIC X(41) VALUE SPACE. IX2094.2 +057500 IX2094.2 +057600 01 CCVS-H-2B. IX2094.2 +057700 02 FILLER PIC X(15) VALUE IX2094.2 +057800 "TEST RESULT OF ". IX2094.2 +057900 02 TEST-ID PIC X(9). IX2094.2 +058000 02 FILLER PIC X(4) VALUE IX2094.2 +058100 " IN ". IX2094.2 +058200 02 FILLER PIC X(12) VALUE IX2094.2 +058300 " HIGH ". IX2094.2 +058400 02 FILLER PIC X(22) VALUE IX2094.2 +058500 " LEVEL VALIDATION FOR ". IX2094.2 +058600 02 FILLER PIC X(58) VALUE IX2094.2 +058700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +058800 01 CCVS-H-3. IX2094.2 +058900 02 FILLER PIC X(34) VALUE IX2094.2 +059000 " FOR OFFICIAL USE ONLY ". IX2094.2 +059100 02 FILLER PIC X(58) VALUE IX2094.2 +059200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2094.2 +059300 02 FILLER PIC X(28) VALUE IX2094.2 +059400 " COPYRIGHT 1985 ". IX2094.2 +059500 01 CCVS-E-1. IX2094.2 +059600 02 FILLER PIC X(52) VALUE SPACE. IX2094.2 +059700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2094.2 +059800 02 ID-AGAIN PIC X(9). IX2094.2 +059900 02 FILLER PIC X(45) VALUE SPACES. IX2094.2 +060000 01 CCVS-E-2. IX2094.2 +060100 02 FILLER PIC X(31) VALUE SPACE. IX2094.2 +060200 02 FILLER PIC X(21) VALUE SPACE. IX2094.2 +060300 02 CCVS-E-2-2. IX2094.2 +060400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2094.2 +060500 03 FILLER PIC X VALUE SPACE. IX2094.2 +060600 03 ENDER-DESC PIC X(44) VALUE IX2094.2 +060700 "ERRORS ENCOUNTERED". IX2094.2 +060800 01 CCVS-E-3. IX2094.2 +060900 02 FILLER PIC X(22) VALUE IX2094.2 +061000 " FOR OFFICIAL USE ONLY". IX2094.2 +061100 02 FILLER PIC X(12) VALUE SPACE. IX2094.2 +061200 02 FILLER PIC X(58) VALUE IX2094.2 +061300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +061400 02 FILLER PIC X(13) VALUE SPACE. IX2094.2 +061500 02 FILLER PIC X(15) VALUE IX2094.2 +061600 " COPYRIGHT 1985". IX2094.2 +061700 01 CCVS-E-4. IX2094.2 +061800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2094.2 +061900 02 FILLER PIC X(4) VALUE " OF ". IX2094.2 +062000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2094.2 +062100 02 FILLER PIC X(40) VALUE IX2094.2 +062200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2094.2 +062300 01 XXINFO. IX2094.2 +062400 02 FILLER PIC X(19) VALUE IX2094.2 +062500 "*** INFORMATION ***". IX2094.2 +062600 02 INFO-TEXT. IX2094.2 +062700 04 FILLER PIC X(8) VALUE SPACE. IX2094.2 +062800 04 XXCOMPUTED PIC X(20). IX2094.2 +062900 04 FILLER PIC X(5) VALUE SPACE. IX2094.2 +063000 04 XXCORRECT PIC X(20). IX2094.2 +063100 02 INF-ANSI-REFERENCE PIC X(48). IX2094.2 +063200 01 HYPHEN-LINE. IX2094.2 +063300 02 FILLER PIC IS X VALUE IS SPACE. IX2094.2 +063400 02 FILLER PIC IS X(65) VALUE IS "************************IX2094.2 +063500- "*****************************************". IX2094.2 +063600 02 FILLER PIC IS X(54) VALUE IS "************************IX2094.2 +063700- "******************************". IX2094.2 +063800 01 CCVS-PGM-ID PIC X(9) VALUE IX2094.2 +063900 "IX209A". IX2094.2 +064000 PROCEDURE DIVISION. IX2094.2 +064100 CCVS1 SECTION. IX2094.2 +064200 OPEN-FILES. IX2094.2 +064300P OPEN I-O RAW-DATA. IX2094.2 +064400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2094.2 +064500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2094.2 +064600P MOVE "ABORTED " TO C-ABORT. IX2094.2 +064700P ADD 1 TO C-NO-OF-TESTS. IX2094.2 +064800P ACCEPT C-DATE FROM DATE. IX2094.2 +064900P ACCEPT C-TIME FROM TIME. IX2094.2 +065000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2094.2 +065100PEND-E-1. IX2094.2 +065200P CLOSE RAW-DATA. IX2094.2 +065300 OPEN OUTPUT PRINT-FILE. IX2094.2 +065400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2094.2 +065500 MOVE SPACE TO TEST-RESULTS. IX2094.2 +065600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2094.2 +065700 MOVE ZERO TO REC-SKL-SUB. IX2094.2 +065800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2094.2 +065900 CCVS-INIT-FILE. IX2094.2 +066000 ADD 1 TO REC-SKL-SUB. IX2094.2 +066100 MOVE FILE-RECORD-INFO-SKELETON IX2094.2 +066200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2094.2 +066300 CCVS-INIT-EXIT. IX2094.2 +066400 GO TO CCVS1-EXIT. IX2094.2 +066500 CLOSE-FILES. IX2094.2 +066600P OPEN I-O RAW-DATA. IX2094.2 +066700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2094.2 +066800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2094.2 +066900P MOVE "OK. " TO C-ABORT. IX2094.2 +067000P MOVE PASS-COUNTER TO C-OK. IX2094.2 +067100P MOVE ERROR-HOLD TO C-ALL. IX2094.2 +067200P MOVE ERROR-COUNTER TO C-FAIL. IX2094.2 +067300P MOVE DELETE-COUNTER TO C-DELETED. IX2094.2 +067400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2094.2 +067500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2094.2 +067600PEND-E-2. IX2094.2 +067700P CLOSE RAW-DATA. IX2094.2 +067800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2094.2 +067900 TERMINATE-CCVS. IX2094.2 +068000S EXIT PROGRAM. IX2094.2 +068100STERMINATE-CALL. IX2094.2 +068200 STOP RUN. IX2094.2 +068300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2094.2 +068400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2094.2 +068500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2094.2 +068600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2094.2 +068700 MOVE "****TEST DELETED****" TO RE-MARK. IX2094.2 +068800 PRINT-DETAIL. IX2094.2 +068900 IF REC-CT NOT EQUAL TO ZERO IX2094.2 +069000 MOVE "." TO PARDOT-X IX2094.2 +069100 MOVE REC-CT TO DOTVALUE. IX2094.2 +069200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2094.2 +069300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2094.2 +069400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2094.2 +069500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2094.2 +069600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2094.2 +069700 MOVE SPACE TO CORRECT-X. IX2094.2 +069800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2094.2 +069900 MOVE SPACE TO RE-MARK. IX2094.2 +070000 HEAD-ROUTINE. IX2094.2 +070100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2094.2 +070400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2094.2 +070500 COLUMN-NAMES-ROUTINE. IX2094.2 +070600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +070700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +070900 END-ROUTINE. IX2094.2 +071000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2094.2 +071100 END-RTN-EXIT. IX2094.2 +071200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +071300 END-ROUTINE-1. IX2094.2 +071400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2094.2 +071500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2094.2 +071600 ADD PASS-COUNTER TO ERROR-HOLD. IX2094.2 +071700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2094.2 +071800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2094.2 +071900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2094.2 +072000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2094.2 +072100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2094.2 +072200 END-ROUTINE-12. IX2094.2 +072300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2094.2 +072400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2094.2 +072500 MOVE "NO " TO ERROR-TOTAL IX2094.2 +072600 ELSE IX2094.2 +072700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2094.2 +072800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2094.2 +072900 PERFORM WRITE-LINE. IX2094.2 +073000 END-ROUTINE-13. IX2094.2 +073100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2094.2 +073200 MOVE "NO " TO ERROR-TOTAL ELSE IX2094.2 +073300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2094.2 +073400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2094.2 +073500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +073600 IF INSPECT-COUNTER EQUAL TO ZERO IX2094.2 +073700 MOVE "NO " TO ERROR-TOTAL IX2094.2 +073800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2094.2 +073900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2094.2 +074000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +074100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +074200 WRITE-LINE. IX2094.2 +074300 ADD 1 TO RECORD-COUNT. IX2094.2 +074400Y IF RECORD-COUNT GREATER 42 IX2094.2 +074500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2094.2 +074600Y MOVE SPACE TO DUMMY-RECORD IX2094.2 +074700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2094.2 +074800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2094.2 +074900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2094.2 +075000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2094.2 +075100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2094.2 +075200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2094.2 +075600Y MOVE ZERO TO RECORD-COUNT. IX2094.2 +075700 PERFORM WRT-LN. IX2094.2 +075800 WRT-LN. IX2094.2 +075900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2094.2 +076000 MOVE SPACE TO DUMMY-RECORD. IX2094.2 +076100 BLANK-LINE-PRINT. IX2094.2 +076200 PERFORM WRT-LN. IX2094.2 +076300 FAIL-ROUTINE. IX2094.2 +076400 IF COMPUTED-X NOT EQUAL TO SPACE IX2094.2 +076500 GO TO FAIL-ROUTINE-WRITE. IX2094.2 +076600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2094.2 +076700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2094.2 +076800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2094.2 +076900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +077000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2094.2 +077100 GO TO FAIL-ROUTINE-EX. IX2094.2 +077200 FAIL-ROUTINE-WRITE. IX2094.2 +077300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2094.2 +077400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2094.2 +077500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2094.2 +077600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2094.2 +077700 FAIL-ROUTINE-EX. EXIT. IX2094.2 +077800 BAIL-OUT. IX2094.2 +077900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2094.2 +078000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2094.2 +078100 BAIL-OUT-WRITE. IX2094.2 +078200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2094.2 +078300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2094.2 +078400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +078500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2094.2 +078600 BAIL-OUT-EX. EXIT. IX2094.2 +078700 CCVS1-EXIT. IX2094.2 +078800 EXIT. IX2094.2 +078900 SECT-0001-IX209A SECTION. IX2094.2 +079000 WRITE-INT-GF-01. IX2094.2 +079100 OPEN OUTPUT IX-FS1. IX2094.2 +079200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2094.2 +079300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2094.2 +079400 MOVE ZERO TO XRECORD-NUMBER (1). IX2094.2 +079500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2094.2 +079600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2094.2 +079700 MOVE 240 TO XRECORD-LENGTH (1). IX2094.2 +079800 MOVE 001 TO XBLOCK-SIZE (1). IX2094.2 +079900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2094.2 +080000 MOVE "S" TO XLABEL-TYPE (1). IX2094.2 +080100 MOVE 200 TO RECORDS-IN-FILE (1). IX2094.2 +080200 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2094.2 +080300 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2094.2 +080400 MOVE ZERO TO KEYSUB. IX2094.2 +080500 MOVE ZERO TO INVKEY-COUNTER. IX2094.2 +080600 WRITE-INIT-GF-01-01. IX2094.2 +080700 PERFORM WRITE-TEST-GF-01-1 50 TIMES. IX2094.2 +080800 PERFORM WRITE-TEST-GF-01-2 125 TIMES. IX2094.2 +080900 PERFORM WRITE-TEST-GF-01-1 25 TIMES. IX2094.2 +081000 GO TO WRITE-TEST-GF-01. IX2094.2 +081100 WRITE-TEST-GF-01-1. IX2094.2 +081200 ADD 001 TO XRECORD-NUMBER (1). IX2094.2 +081300 ADD 001 TO KEYSUB. IX2094.2 +081400 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2094.2 +081500 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2094.2 +081600 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2094.2 +081700 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2094.2 +081800 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2094.2 +081900 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2094.2 +082000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2094.2 +082100 WRITE IX-FS1R1-F-G-240 IX2094.2 +082200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2094.2 +082300 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +082400 WRITE-TEST-GF-01-2. IX2094.2 +082500 ADD 002 TO FS1-RECKEY-11-13. IX2094.2 +082600 ADD 002 TO FS1-ALTKEY1-11-13. IX2094.2 +082700 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2094.2 +082800 ADD 001 TO XRECORD-NUMBER (1). IX2094.2 +082900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2094.2 +083000 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2094.2 +083100 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2094.2 +083200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2094.2 +083300 WRITE IX-FS1R1-F-G-240 IX2094.2 +083400 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2094.2 +083500 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +083600 WRITE-TEST-GF-01. IX2094.2 +083700 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2094.2 +083800 GIVING RECORDS-WRITTEN. IX2094.2 +083900 MOVE 200 TO CORRECT-18V0. IX2094.2 +084000 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2094.2 +084100 IF RECORDS-WRITTEN EQUAL TO 200 IX2094.2 +084200 PERFORM PASS IX2094.2 +084300 ELSE IX2094.2 +084400 PERFORM FAIL. IX2094.2 +084500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2094.2 +084600 PERFORM PRINT-DETAIL. IX2094.2 +084700 GO TO WRITE-TEST-GF-01-END. IX2094.2 +084800 WRITE-DELETE-GF-01. IX2094.2 +084900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2094.2 +085000 PERFORM DE-LETE. IX2094.2 +085100 PERFORM PRINT-DETAIL. IX2094.2 +085200 WRITE-TEST-GF-01-END. IX2094.2 +085300 CLOSE IX-FS1. IX2094.2 +085400 READ-INIT-F1-01. IX2094.2 +085500 OPEN INPUT IX-FS1. IX2094.2 +085600 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2094.2 +085700 MOVE "READ FILE IX-FS1" TO FEATURE. IX2094.2 +085800 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2094.2 +085900 MOVE 02 TO RECKEY-NUM. IX2094.2 +086000 MOVE 002 TO ALTKEY1-NUM. IX2094.2 +086100 READ-TEST-F1-01-R1. IX2094.2 +086200 READ IX-FS1 AT END GO TO READ-TEST-F1-01. IX2094.2 +086300 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2094.2 +086400 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2094.2 +086500 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2094.2 +086600 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2094.2 +086700 NEXT SENTENCE IX2094.2 +086800 ELSE IX2094.2 +086900 PERFORM READ-FAIL-F1-01. IX2094.2 +087000 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +087100 ADD 002 TO RECKEY-NUM IX2094.2 +087200 ADD 002 TO ALTKEY1-NUM. IX2094.2 +087300 GO TO READ-TEST-F1-01-R1. IX2094.2 +087400 READ-TEST-F1-01. IX2094.2 +087500 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2094.2 +087600 PERFORM PASS ELSE IX2094.2 +087700 MOVE "IX-28; 4.5.2 OR IX-41; 4.9.2 NOT COORECTLY EXECUTED" IX2094.2 +087800 TO RE-MARK IX2094.2 +087900 PERFORM FAIL. IX2094.2 +088000 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2094.2 +088100 MOVE 200 TO CORRECT-18V0. IX2094.2 +088200 MOVE "RECORDS IN FILE" TO RE-MARK. IX2094.2 +088300 PERFORM PRINT-DETAIL. IX2094.2 +088400 GO TO READ-EXIT-F1-01. IX2094.2 +088500 READ-FAIL-F1-01. IX2094.2 +088600 PERFORM FAIL. IX2094.2 +088700 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2094.2 +088800 MOVE RECKEY-NUM TO CORRECT-18V0. IX2094.2 +088900 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2094.2 +089000 PERFORM PRINT-DETAIL. IX2094.2 +089100 READ-EXIT-F1-01. IX2094.2 +089200 CLOSE IX-FS1. IX2094.2 +089300 START-INIT-GF-01. IX2094.2 +089400 OPEN INPUT IX-FS1. IX2094.2 +089500 MOVE "START EQ TO RECKEY" TO FEATURE. IX2094.2 +089600 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2094.2 +089700 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +089800* IX2094.2 +089900* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +090000* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +090100* START-TEST-GF-01 USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2094.2 +090200* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2094.2 +090300* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2094.2 +090400* TAKEN FOR THE TESTS. IX2094.2 +090500* IX2094.2 +090600* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +090700* IX2094.2 +090800* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +090900* START-TEST-GF-02 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEYIX2094.2 +091000* START-TEST-GF-03 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +091100* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2094.2 +091200* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +091300* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +091400* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +091500* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +091600* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2094.2 +091700* IX2094.2 +091800* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +091900* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +092000* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +092100* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +092200* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2094.2 +092300* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2094.2 +092400* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +092500* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +092600* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +092700* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +092800* IX2094.2 +092900 START-INIT-GF-01-01. IX2094.2 +093000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +093100 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2094.2 +093200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +093300 MOVE "**" TO FILESTATUS (1) IX2094.2 +093400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +093500 GO TO START-DELETE-GF-01. IX2094.2 +093600 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +093700 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +093800 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +093900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +094000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +094100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +094200 START-TEST-GF-01. IX2094.2 +094300* IX2094.2 +094400* START-TEST-GF-01 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +094500* WHICH HAS A RECORD KEY VALUE OF IX2094.2 +094600* CCCCCCCCCD022 (RECORD NUMBER 11). IX2094.2 +094700* IX2094.2 +094800 START IX-FS1 IX2094.2 +094900 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +095000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +095100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +095200 GO TO START-FAIL-GF-01. IX2094.2 +095300 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +095400 READ IX-FS1 AT END IX2094.2 +095500 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +095600 GO TO START-FAIL-GF-01. IX2094.2 +095700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +095800 IF XRECORD-NUMBER (1) EQUAL TO 11 IX2094.2 +095900 PERFORM PASS IX2094.2 +096000 MOVE SPACE TO RE-MARK IX2094.2 +096100 GO TO START-WRITE-GF-01. IX2094.2 +096200 MOVE 11 TO RECNO. IX2094.2 +096300 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +096400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +096500 START-FAIL-GF-01. IX2094.2 +096600 PERFORM FAIL. IX2094.2 +096700 MOVE 11 TO CORRECT-18V0. IX2094.2 +096800 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +096900 GO TO START-WRITE-GF-01. IX2094.2 +097000 START-DELETE-GF-01. IX2094.2 +097100 PERFORM DE-LETE. IX2094.2 +097200 START-WRITE-GF-01. IX2094.2 +097300 PERFORM PRINT-DETAIL. IX2094.2 +097400 START-INIT-GF-02. IX2094.2 +097500 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2094.2 +097600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +097700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +097800 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +097900 MOVE "**" TO FILESTATUS (2) IX2094.2 +098000 GO TO START-DELETE-GF-02. IX2094.2 +098100 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2094.2 +098200 MOVE "HHHHHHHIII066ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +098300 MOVE "TTTTTTTSSS334ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +098400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +098500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +098600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +098700 START-TEST-GF-02. IX2094.2 +098800* IX2094.2 +098900* START-TEST-GF-02 - THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +099000* FILE WHICH HAS A RECORD KEY VALUE OF IX2094.2 +099100* "EEEEEEEFFF067". THIS KEY VALUE IS IX2094.2 +099200* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +099300* EXISTING RECORD KEYS IN THE FILE. IX2094.2 +099400* IX2094.2 +099500 START IX-FS1 IX2094.2 +099600 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +099700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +099800 GO TO START-PASS-GF-02. IX2094.2 +099900 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +100000 READ IX-FS1 AT END IX2094.2 +100100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +100200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +100300 PERFORM FAIL. IX2094.2 +100400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +100500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +100600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +100700 GO TO START-WRITE-GF-02. IX2094.2 +100800 START-PASS-GF-02. IX2094.2 +100900 PERFORM PASS. IX2094.2 +101000 GO TO START-WRITE-GF-02. IX2094.2 +101100 START-DELETE-GF-02. IX2094.2 +101200 PERFORM DE-LETE. IX2094.2 +101300 START-WRITE-GF-02. IX2094.2 +101400 PERFORM PRINT-DETAIL. IX2094.2 +101500 START-INIT-GF-03. IX2094.2 +101600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +101700 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2094.2 +101800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +101900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +102000 MOVE "**" TO FILESTATUS (3) IX2094.2 +102100 GO TO START-DELETE-GF-03. IX2094.2 +102200 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2094.2 +102300 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +102400 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +102500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +102600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +102700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +102800 START-TEST-GF-03. IX2094.2 +102900* IX2094.2 +103000* START-TEST-GF-03 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +103100* RECORD IN THE FILE WHICH HAS A RECORD IX2094.2 +103200* KEY VALUE OF "BBBBBBBBBC001". THIS KEY IX2094.2 +103300* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +103400* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +103500* IX2094.2 +103600 START IX-FS1 IX2094.2 +103700 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +103800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +103900 GO TO START-PASS-GF-03. IX2094.2 +104000 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +104100 READ IX-FS1 AT END IX2094.2 +104200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +104300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +104400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +104500 PERFORM FAIL. IX2094.2 +104600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +104700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +104800 GO TO START-WRITE-GF-03. IX2094.2 +104900 START-PASS-GF-03. IX2094.2 +105000 PERFORM PASS. IX2094.2 +105100 GO TO START-WRITE-GF-03. IX2094.2 +105200 START-DELETE-GF-03. IX2094.2 +105300 PERFORM DE-LETE. IX2094.2 +105400 START-WRITE-GF-03. IX2094.2 +105500 PERFORM PRINT-DETAIL. IX2094.2 +105600 START-INIT-GF-04. IX2094.2 +105700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2094.2 +105800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +105900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +106000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +106100 MOVE "**" TO FILESTATUS (4) IX2094.2 +106200 GO TO START-DELETE-GF-04. IX2094.2 +106300 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2094.2 +106400 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +106500 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +106600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +106700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +106800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +106900 START-TEST-GF-04. IX2094.2 +107000* IX2094.2 +107100* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +107200* RECORD IN THE FILE WHICH HAS A RECORD IX2094.2 +107300* KEY VALUE OF "UUUUUUUUUU401". THIS IX2094.2 +107400* VALUE IS SEQUENTIALLY ONE GREATER THAN IX2094.2 +107500* ANY RECORD KEY CURRENTLY EXISTING IN IX2094.2 +107600* THE FILE. AN INVALID KEY CONDITION IX2094.2 +107700* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +107800* IX2094.2 +107900 START IX-FS1 IX2094.2 +108000 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +108100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +108200 GO TO START-PASS-GF-04. IX2094.2 +108300 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +108400 READ IX-FS1 AT END IX2094.2 +108500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +108600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +108700 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +108800 PERFORM FAIL. IX2094.2 +108900 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +109000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +109100 GO TO START-WRITE-GF-04. IX2094.2 +109200 START-PASS-GF-04. IX2094.2 +109300 PERFORM PASS. IX2094.2 +109400 GO TO START-WRITE-GF-04. IX2094.2 +109500 START-DELETE-GF-04. IX2094.2 +109600 PERFORM DE-LETE. IX2094.2 +109700 START-WRITE-GF-04. IX2094.2 +109800 PERFORM PRINT-DETAIL. IX2094.2 +109900 START-INIT-GF-05. IX2094.2 +110000 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2094.2 +110100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +110200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +110300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +110400 MOVE "**" TO FILESTATUS (5) IX2094.2 +110500 GO TO START-DELETE-GF-05. IX2094.2 +110600 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2094.2 +110700 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +110800 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +110900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +111000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +111100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +111200 START-TEST-GF-05. IX2094.2 +111300* START-TEST-GF-05 - THE START STATEMENT USES AN OPERAND IX2094.2 +111400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +111500* OF A RECORD KEY BUT IS THE NAME OF A IX2094.2 +111600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +111700* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2094.2 +111800* (POSITIONS 1 THRU 5 OF THE RECORD KEY) IX2094.2 +111900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +112000* BALANCE OF THE KEY (POSITIONS 6 THRU 13) IS IX2094.2 +112100* NOT A VALID KEY VALUE FOR THE FILE. THE IX2094.2 +112200* RECORD WITH THE RECORD KEY "CDDDDDDDDD038" IX2094.2 +112300* (RECORD NUMBER 19) IS EXPECTED TO BE FOUND. IX2094.2 +112400* IX2094.2 +112500 START IX-FS1 IX2094.2 +112600 KEY IS EQUAL TO IX-FS1-KEY-1-5 IX2094.2 +112700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +112800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +112900 GO TO START-FAIL-GF-05. IX2094.2 +113000 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +113100 READ IX-FS1 AT END IX2094.2 +113200 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +113300 GO TO START-FAIL-GF-05. IX2094.2 +113400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +113500 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2094.2 +113600 PERFORM PASS IX2094.2 +113700 GO TO START-WRITE-GF-05. IX2094.2 +113800 MOVE 19 TO RECNO. IX2094.2 +113900 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +114000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +114100 START-FAIL-GF-05. IX2094.2 +114200 PERFORM FAIL. IX2094.2 +114300 MOVE 19 TO CORRECT-18V0. IX2094.2 +114400 MOVE "IX-36; 4.7.2 ETC.; SUBORDINATE D-I OF KEY" TO RE-MARK. IX2094.2 +114500 GO TO START-WRITE-GF-05. IX2094.2 +114600 START-DELETE-GF-05. IX2094.2 +114700 PERFORM DE-LETE. IX2094.2 +114800 START-WRITE-GF-05. IX2094.2 +114900 PERFORM PRINT-DETAIL. IX2094.2 +115000 START-INIT-GF-06. IX2094.2 +115100 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2094.2 +115200 PERFORM START-INITIALIZE-RECORD. IX2094.2 +115300 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +115400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +115500 MOVE "**" TO FILESTATUS (6) IX2094.2 +115600 GO TO START-DELETE-GF-06. IX2094.2 +115700 MOVE "TTTTTUUUUU390" TO FS1-RECKEY-1-13. IX2094.2 +115800 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +115900 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +116000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +116100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +116200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +116300 START-TEST-GF-06. IX2094.2 +116400* IX2094.2 +116500* START-TEST-GF-06 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +116600* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2094.2 +116700* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2094.2 +116800* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2094.2 +116900* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +117000* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +117100* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +117200* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +117300* TO BE POSITIONED TO RECORD KEY TTTTTTTTTT380 IX2094.2 +117400* (RECORD NUMBER 190) WHICH WAS THE IX2094.2 +117500* FIRST RECORD WRITTEN TO THE FILE THAT IX2094.2 +117600* CONTAINS TTTTT IN THE FIRST 5 POSITIONS OF IX2094.2 +117700* THE KEY. THE RECORD KEY WAS LOADED WITH THE IX2094.2 +117800* VALUE "TTTTTUUUUU390" (KEY FOR RECORD NUMBER IX2094.2 +117900* 195) BEFORE THE START WAS EXECUTED. IX2094.2 +118000* IX2094.2 +118100 START IX-FS1 IX2094.2 +118200 KEY IS EQUAL TO IX-FS1-KEY-1-5 IX2094.2 +118300 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +118400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +118500 GO TO START-FAIL-GF-06. IX2094.2 +118600 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +118700 READ IX-FS1 AT END IX2094.2 +118800 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +118900 GO TO START-FAIL-GF-06. IX2094.2 +119000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +119100 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2094.2 +119200 PERFORM PASS IX2094.2 +119300 GO TO START-WRITE-GF-06. IX2094.2 +119400 MOVE 65 TO RECNO. IX2094.2 +119500 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +119600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +119700 START-FAIL-GF-06. IX2094.2 +119800 MOVE "IX-36; 4.7.2 ETC.; SUBORDINATE D-I OF KEY" TO RE-MARK. IX2094.2 +119900 PERFORM FAIL. IX2094.2 +120000 MOVE 190 TO CORRECT-18V0. IX2094.2 +120100 GO TO START-WRITE-GF-06. IX2094.2 +120200 START-DELETE-GF-06. IX2094.2 +120300 PERFORM DE-LETE. IX2094.2 +120400 START-WRITE-GF-06. IX2094.2 +120500 PERFORM PRINT-DETAIL. IX2094.2 +120600 START-INIT-GF-07. IX2094.2 +120700 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2094.2 +120800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +120900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +121000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +121100 MOVE "**" TO FILESTATUS (7) IX2094.2 +121200 GO TO START-DELETE-GF-07. IX2094.2 +121300 MOVE "CCCCCCD022 " TO FS1-RECKEY-1-13. IX2094.2 +121400 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +121500 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +121600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +121700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +121800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +121900 START-TEST-GF-07. IX2094.2 +122000* IX2094.2 +122100* START-TEST-GF-07 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +122200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +122300* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +122400* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +122500* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IX2094.2 +122600* IS LOADED WITH "CCCCCCD022". NO SUCH RECORD IX2094.2 +122700* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +122800* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +122900* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +123000* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +123100* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +123200* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +123300* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +123400* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +123500* IX2094.2 +123600 START IX-FS1 IX2094.2 +123700 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +123800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +123900 GO TO START-PASS-GF-07. IX2094.2 +124000 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +124100 READ IX-FS1 AT END IX2094.2 +124200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +124300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +124400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +124500 PERFORM FAIL. IX2094.2 +124600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +124700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +124800 GO TO START-WRITE-GF-07. IX2094.2 +124900 START-PASS-GF-07. IX2094.2 +125000 PERFORM PASS. IX2094.2 +125100 GO TO START-WRITE-GF-07. IX2094.2 +125200 START-DELETE-GF-07. IX2094.2 +125300 PERFORM DE-LETE. IX2094.2 +125400 START-WRITE-GF-07. IX2094.2 +125500 PERFORM PRINT-DETAIL. IX2094.2 +125600 START-INIT-GF-08. IX2094.2 +125700 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2094.2 +125800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +125900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +126000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +126100 MOVE "**" TO FILESTATUS (8) IX2094.2 +126200 GO TO START-DELETE-GF-08. IX2094.2 +126300 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +126400 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +126500 MOVE "WWWWWWWWWW400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +126600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +126700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +126800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +126900 START-TEST-GF-08. IX2094.2 +127000* IX2094.2 +127100* START-TEST-GF-08 - THIS TEST USES AN OPERAND IN THE IX2094.2 +127200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +127300* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +127400* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +127500* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +127600* LOADED WITH "ABBBBBBBBC". THIS KEY VALUE IX2094.2 +127700* IS LOWER THAN ANY RECORD KEY VALUE IN IX2094.2 +127800* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +127900* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +128000* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +128100* EXECUTED. IX2094.2 +128200* IX2094.2 +128300 START IX-FS1 IX2094.2 +128400 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +128500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +128600 GO TO START-PASS-GF-08. IX2094.2 +128700 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +128800 READ IX-FS1 AT END IX2094.2 +128900 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +129000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +129100 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +129200 PERFORM FAIL. IX2094.2 +129300 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +129400 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +129500 GO TO START-WRITE-GF-08. IX2094.2 +129600 START-PASS-GF-08. IX2094.2 +129700 PERFORM PASS. IX2094.2 +129800 GO TO START-WRITE-GF-08. IX2094.2 +129900 START-DELETE-GF-08. IX2094.2 +130000 PERFORM DE-LETE. IX2094.2 +130100 START-WRITE-GF-08. IX2094.2 +130200 PERFORM PRINT-DETAIL. IX2094.2 +130300 START-INIT-GF-09. IX2094.2 +130400 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2094.2 +130500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +130600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +130700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +130800 MOVE "**" TO FILESTATUS (9) IX2094.2 +130900 GO TO START-DELETE-GF-09. IX2094.2 +131000 MOVE "UUUUUUUUUV400" TO FS1-RECKEY-1-13. IX2094.2 +131100 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +131200 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +131300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +131400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +131500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +131600 START-TEST-GF-09. IX2094.2 +131700* IX2094.2 +131800* START-TEST-GF-09 - THIS TEST USES AN OPERAND IN THE IX2094.2 +131900* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +132000* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +132100* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +132200* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +132300* LOADED WITH "UUUUUUUUUV". THIS KEY VALUE IX2094.2 +132400* IS GREATER THAN ANY RECORD KEY VALUE IN IX2094.2 +132500* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +132600* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +132700* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +132800* EXECUTED. IX2094.2 +132900* IX2094.2 +133000 START IX-FS1 IX2094.2 +133100 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +133200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +133300 GO TO START-PASS-GF-09. IX2094.2 +133400 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +133500 READ IX-FS1 AT END IX2094.2 +133600 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +133700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +133800 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +133900 PERFORM FAIL. IX2094.2 +134000 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +134100 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +134200 GO TO START-WRITE-GF-09. IX2094.2 +134300 START-PASS-GF-09. IX2094.2 +134400 PERFORM PASS. IX2094.2 +134500 GO TO START-WRITE-GF-09. IX2094.2 +134600 START-DELETE-GF-09. IX2094.2 +134700 PERFORM DE-LETE. IX2094.2 +134800 START-WRITE-GF-09. IX2094.2 +134900 PERFORM PRINT-DETAIL. IX2094.2 +135000 CLOSE IX-FS1. IX2094.2 +135100 START-INIT-GF-FILE-STATUS. IX2094.2 +135200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +135300 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2094.2 +135400* IX2094.2 +135500* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +135600* IX2094.2 +135700 START-TEST-GF-10. IX2094.2 +135800 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +135900 PERFORM DE-LETE IX2094.2 +136000 GO TO START-WRITE-GF-10. IX2094.2 +136100* IX2094.2 +136200* START-TEST-GF-10 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +136300* RESULTING FROM START-TEST-GF-01. THE FILE IX2094.2 +136400* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +136500* IX2094.2 +136600 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +136700 PERFORM PASS IX2094.2 +136800 ELSE IX2094.2 +136900 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-01 " TO RE-MARK IX2094.2 +137000 PERFORM FAIL IX2094.2 +137100 MOVE "00" TO CORRECT-A IX2094.2 +137200 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +137300 START-WRITE-GF-10. IX2094.2 +137400 PERFORM PRINT-DETAIL. IX2094.2 +137500 START-TEST-GF-11. IX2094.2 +137600 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +137700 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2094.2 +137800 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +137900 PERFORM DE-LETE IX2094.2 +138000 GO TO START-WRITE-GF-11. IX2094.2 +138100* IX2094.2 +138200* START-TEST-GF-11 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +138300* RESULTING FROM START-TEST-GF-02. THE FILE IX2094.2 +138400* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +138500* IX2094.2 +138600 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +138700 PERFORM PASS IX2094.2 +138800 ELSE PERFORM FAIL IX2094.2 +138900 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-02 " TO RE-MARK IX2094.2 +139000 MOVE "23" TO CORRECT-A IX2094.2 +139100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +139200 START-WRITE-GF-11. IX2094.2 +139300 PERFORM PRINT-DETAIL. IX2094.2 +139400 START-TEST-GF-12. IX2094.2 +139500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +139600 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2094.2 +139700 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +139800 PERFORM DE-LETE IX2094.2 +139900 GO TO START-WRITE-GF-12. IX2094.2 +140000* IX2094.2 +140100* START-TEST-GF-12 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +140200* RESULTING FROM START-TEST-GF-03. THE FILE IX2094.2 +140300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +140400* IX2094.2 +140500 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +140600 PERFORM PASS IX2094.2 +140700 ELSE PERFORM FAIL IX2094.2 +140800 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-03 " TO RE-MARK IX2094.2 +140900 MOVE "23" TO CORRECT-A IX2094.2 +141000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +141100 START-WRITE-GF-12. IX2094.2 +141200 PERFORM PRINT-DETAIL. IX2094.2 +141300 START-TEST-GF-13. IX2094.2 +141400 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2094.2 +141500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +141600 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +141700 PERFORM DE-LETE IX2094.2 +141800 GO TO START-WRITE-GF-13. IX2094.2 +141900* IX2094.2 +142000* START-TEST-GF-13 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +142100* RESULTING FROM START-TEST-GF-04. THE FILE IX2094.2 +142200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +142300* IX2094.2 +142400 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +142500 PERFORM PASS IX2094.2 +142600 ELSE PERFORM FAIL IX2094.2 +142700 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-04 " TO RE-MARK IX2094.2 +142800 MOVE "23" TO CORRECT-A IX2094.2 +142900 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +143000 START-WRITE-GF-13. IX2094.2 +143100 PERFORM PRINT-DETAIL. IX2094.2 +143200 START-TEST-GF-14. IX2094.2 +143300 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2094.2 +143400 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +143500 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +143600 PERFORM DE-LETE IX2094.2 +143700 GO TO START-WRITE-GF-14. IX2094.2 +143800* IX2094.2 +143900* START-TEST-GF-14 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +144000* RESULTING FROM START-TEST-GF-05. THE FILE IX2094.2 +144100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +144200* IX2094.2 +144300 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +144400 PERFORM PASS IX2094.2 +144500 ELSE PERFORM FAIL IX2094.2 +144600 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-05 " TO RE-MARKIX2094.2 +144700 MOVE "00" TO CORRECT-A IX2094.2 +144800 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +144900 START-WRITE-GF-14. IX2094.2 +145000 PERFORM PRINT-DETAIL. IX2094.2 +145100 START-TEST-GF-15. IX2094.2 +145200 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2094.2 +145300 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +145400 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +145500 PERFORM DE-LETE IX2094.2 +145600 GO TO START-WRITE-GF-15. IX2094.2 +145700* IX2094.2 +145800* START-TEST-GF-15 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +145900* RESULTING FROM START-TEST-GF-06. THE FILE IX2094.2 +146000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +146100* IX2094.2 +146200 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +146300 PERFORM PASS IX2094.2 +146400 ELSE PERFORM FAIL IX2094.2 +146500 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-06 " TO RE-MARKIX2094.2 +146600 MOVE "00" TO CORRECT-A IX2094.2 +146700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +146800 START-WRITE-GF-15. IX2094.2 +146900 PERFORM PRINT-DETAIL. IX2094.2 +147000 START-TEST-GGF-16. IX2094.2 +147100 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2094.2 +147200 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +147300 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +147400 PERFORM DE-LETE IX2094.2 +147500 GO TO START-WRITE-GF-16. IX2094.2 +147600* IX2094.2 +147700* START-TEST-GF-16 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +147800* RESULTING FROM START-TEST-GF-07. THE FILE IX2094.2 +147900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +148000* IX2094.2 +148100 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +148200 PERFORM PASS IX2094.2 +148300 ELSE PERFORM FAIL IX2094.2 +148400 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-07 " TO RE-MARKIX2094.2 +148500 MOVE "23" TO CORRECT-A IX2094.2 +148600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +148700 START-WRITE-GF-16. IX2094.2 +148800 PERFORM PRINT-DETAIL. IX2094.2 +148900 START-TEST-GF-17. IX2094.2 +149000 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2094.2 +149100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +149200 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +149300 PERFORM DE-LETE IX2094.2 +149400 GO TO START-WRITE-GF-17. IX2094.2 +149500* IX2094.2 +149600* START-TEST-GF-07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +149700* RESULTING FROM START-TEST-GF-08. THE FILE IX2094.2 +149800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +149900* IX2094.2 +150000 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +150100 PERFORM PASS IX2094.2 +150200 ELSE PERFORM FAIL IX2094.2 +150300 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-08 " TO RE-MARKIX2094.2 +150400 MOVE "23" TO CORRECT-A IX2094.2 +150500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +150600 START-WRITE-GF-17. IX2094.2 +150700 PERFORM PRINT-DETAIL. IX2094.2 +150800 START-TEST-GF-18. IX2094.2 +150900 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2094.2 +151000 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +151100 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +151200 PERFORM DE-LETE IX2094.2 +151300 GO TO START-WRITE-GF-18. IX2094.2 +151400* IX2094.2 +151500* START-TEST-GF-18 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +151600* RESULTING FROM START-TEST-GF-09. THE FILE IX2094.2 +151700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +151800* IX2094.2 +151900 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +152000 PERFORM PASS IX2094.2 +152100 ELSE PERFORM FAIL IX2094.2 +152200 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-09 " TO RE-MARKIX2094.2 +152300 MOVE "23" TO CORRECT-A IX2094.2 +152400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +152500 START-WRITE-GF-18. IX2094.2 +152600 PERFORM PRINT-DETAIL. IX2094.2 +152700******************************************************************IX2094.2 +152800 IX2094.2 +152900 START-INIT-005. IX2094.2 +153000 OPEN INPUT IX-FS1. IX2094.2 +153100 MOVE "STR EQ ALTKY W/O DUP" TO FEATURE. IX2094.2 +153200 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2094.2 +153300 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +153400* IX2094.2 +153500* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +153600* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +153700* START-TEST-GF-19/27 USES ONLY THE ALTERNATE RECORD KEY WITHOUT IX2094.2 +153800* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2094.2 +153900* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2094.2 +154000* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2094.2 +154100* IX2094.2 +154200* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +154300* IX2094.2 +154400* START-TEST-GF-19 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +154500* START-TEST-GF-20 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEIX2094.2 +154600* START-TEST-GF-21 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +154700* START-TEST-GF-22 - GREATER THAN LAST FILE RECORD / INVALID KEIX2094.2 +154800* START-TEST-GF-23 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2094.2 +154900* START-TEST-GF-24 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2094.2 +155000* START-TEST-GF-25 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2094.2 +155100* START-TEST-GF-26 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2094.2 +155200* START-TEST-GF-27 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEYIX2094.2 +155300* IX2094.2 +155400* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +155500* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +155600* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +155700* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +155800* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2094.2 +155900* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2094.2 +156000* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +156100* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +156200* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +156300* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +156400* IX2094.2 +156500 START-INIT-GF-19. IX2094.2 +156600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +156700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +156800 MOVE "**" TO FILESTATUS (1) IX2094.2 +156900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +157000 GO TO START-DELETE-GF-19. IX2094.2 +157100 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2094.2 +157200 MOVE "XXXXXXXXXY382ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +157300 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +157400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +157500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +157600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +157700 START-TEST-GF-19. IX2094.2 +157800* IX2094.2 +157900* START-TEST-GF-19 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +158000* WHICH HAS AN ALTERNATE KEY VALUE OF IX2094.2 +158100* XXXXXXXXXY382ALTKEY1 (RECORD NUMBER 191). IX2094.2 +158200* IX2094.2 +158300 START IX-FS1 IX2094.2 +158400 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +158500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +158600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +158700 GO TO START-FAIL-GF-19. IX2094.2 +158800 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +158900 READ IX-FS1 AT END IX2094.2 +159000 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +159100 GO TO START-FAIL-GF-19. IX2094.2 +159200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +159300 IF XRECORD-NUMBER (1) EQUAL TO 191 IX2094.2 +159400 PERFORM PASS IX2094.2 +159500 MOVE SPACE TO RE-MARK IX2094.2 +159600 GO TO START-WRITE-GF-19. IX2094.2 +159700 MOVE 66 TO RECNO. IX2094.2 +159800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +159900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +160000 START-FAIL-GF-19. IX2094.2 +160100 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +160200 PERFORM FAIL. IX2094.2 +160300 MOVE 191 TO CORRECT-18V0. IX2094.2 +160400 GO TO START-WRITE-GF-19. IX2094.2 +160500 START-DELETE-GF-19. IX2094.2 +160600 PERFORM DE-LETE. IX2094.2 +160700 START-WRITE-GF-19. IX2094.2 +160800 PERFORM PRINT-DETAIL. IX2094.2 +160900 START-INIT-GF-20. IX2094.2 +161000 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2094.2 +161100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +161200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +161300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +161400 MOVE "**" TO FILESTATUS (2) IX2094.2 +161500 GO TO START-DELETE-GF-20. IX2094.2 +161600 MOVE "EEEEEEEFFF066" TO FS1-RECKEY-1-13. IX2094.2 +161700 MOVE "HHHHHHHIII067ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +161800 MOVE "TTTTTTTSSS334ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +161900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +162000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +162100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +162200 START-TEST-GF-20. IX2094.2 +162300* IX2094.2 +162400* START-TEST-GF.02 - THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +162500* FILE WHICH HAS AN ALTERNATE KEY VALUE OF IX2094.2 +162600* HHHHHHHIII067ALTKEY1. THIS KEY VALUE IS IX2094.2 +162700* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +162800* EXISTING ALTERNATE KEYS IN THE FILE. IX2094.2 +162900* IX2094.2 +163000 START IX-FS1 IX2094.2 +163100 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +163200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +163300 GO TO START-PASS-GF-20. IX2094.2 +163400 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +163500 READ IX-FS1 AT END IX2094.2 +163600 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +163700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +163800 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +163900 PERFORM FAIL. IX2094.2 +164000 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +164100 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +164200 GO TO START-WRITE-GF-20. IX2094.2 +164300 START-PASS-GF-20. IX2094.2 +164400 PERFORM PASS. IX2094.2 +164500 MOVE "INVALID KEY" TO RE-MARK. IX2094.2 +164600 GO TO START-WRITE-GF-20. IX2094.2 +164700 START-DELETE-GF-20. IX2094.2 +164800 PERFORM DE-LETE. IX2094.2 +164900 START-WRITE-GF-20. IX2094.2 +165000 PERFORM PRINT-DETAIL. IX2094.2 +165100 START-INIT-GF-21. IX2094.2 +165200 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2094.2 +165300 PERFORM START-INITIALIZE-RECORD. IX2094.2 +165400 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +165500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +165600 MOVE "**" TO FILESTATUS (3) IX2094.2 +165700 GO TO START-DELETE-GF-21. IX2094.2 +165800 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +165900 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +166000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +166100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +166200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +166300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +166400 START-TEST-GF-21. IX2094.2 +166500* IX2094.2 +166600* START-TEST-GF-21 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +166700* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +166800* KEY VALUE OF EEEEEEEEEF001ALTKEY1. THIS KEY IX2094.2 +166900* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +167000* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +167100* IX2094.2 +167200 START IX-FS1 IX2094.2 +167300 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +167400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +167500 GO TO START-PASS-GF-21. IX2094.2 +167600 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +167700 READ IX-FS1 AT END IX2094.2 +167800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +167900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +168000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +168100 PERFORM FAIL. IX2094.2 +168200 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +168300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +168400 GO TO START-WRITE-GF-21. IX2094.2 +168500 START-PASS-GF-21. IX2094.2 +168600 PERFORM PASS. IX2094.2 +168700 MOVE "INVALID KEY" TO RE-MARK. IX2094.2 +168800 GO TO START-WRITE-GF-21. IX2094.2 +168900 START-DELETE-GF-21. IX2094.2 +169000 PERFORM DE-LETE. IX2094.2 +169100 START-WRITE-GF-21. IX2094.2 +169200 PERFORM PRINT-DETAIL. IX2094.2 +169300 START-INIT-GF-22. IX2094.2 +169400 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2094.2 +169500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +169600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +169700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +169800 MOVE "**" TO FILESTATUS (4) IX2094.2 +169900 GO TO START-DELETE-GF-22. IX2094.2 +170000 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +170100 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +170200 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +170300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +170400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +170500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +170600 START-TEST-GF-22. IX2094.2 +170700* IX2094.2 +170800* START-TEST-GF-22 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +170900* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +171000* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2094.2 +171100* VALUE IS SEQUENTIALLY GREATER THAN IX2094.2 +171200* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2094.2 +171300* THE FILE. AN INVALID KEY CONDITION IX2094.2 +171400* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +171500* IX2094.2 +171600 START IX-FS1 IX2094.2 +171700 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +171800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +171900 GO TO START-PASS-GF-22. IX2094.2 +172000 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +172100 READ IX-FS1 AT END IX2094.2 +172200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +172300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +172400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +172500 PERFORM FAIL. IX2094.2 +172600 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +172700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +172800 GO TO START-WRITE-GF-22. IX2094.2 +172900 START-PASS-GF-22. IX2094.2 +173000 PERFORM PASS. IX2094.2 +173100 GO TO START-WRITE-GF-22. IX2094.2 +173200 START-DELETE-GF-22. IX2094.2 +173300 PERFORM DE-LETE. IX2094.2 +173400 START-WRITE-GF-22. IX2094.2 +173500 PERFORM PRINT-DETAIL. IX2094.2 +173600 START-INIT-GF-23. IX2094.2 +173700 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2094.2 +173800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +173900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +174000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +174100 MOVE "**" TO FILESTATUS (5) IX2094.2 +174200 GO TO START-DELETE-GF-23. IX2094.2 +174300 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2094.2 +174400 MOVE "GGGGHXXXXX052ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +174500 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +174600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +174700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +174800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +174900 START-TEST-GF-23. IX2094.2 +175000* START-TEST-GF-23 - THE START STATEMENT USES AN OPERAND IX2094.2 +175100* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +175200* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2094.2 +175300* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +175400* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2094.2 +175500* (POSITIONS 1 THRU 5 OF THE ALTERNATE KEY) IX2094.2 +175600* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +175700* BALANCE OF THE KEY (POSITIONS 6 THRU 13 OF IX2094.2 +175800* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2094.2 +175900* FOR THE FILE. THE IX2094.2 +176000* RECORD WITH THE ALTERNATE KEY "GGGGHHHHHH052 IX2094.2 +176100* ALTKEY1 (RECORD NUMBER 26) IS EXPECTED TO IX2094.2 +176200* BE FOUND. IX2094.2 +176300* IX2094.2 +176400 START IX-FS1 IX2094.2 +176500 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-5 IX2094.2 +176600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +176700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +176800 GO TO START-FAIL-GF-23. IX2094.2 +176900 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +177000 READ IX-FS1 AT END IX2094.2 +177100 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +177200 GO TO START-FAIL-GF-23. IX2094.2 +177300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +177400 IF XRECORD-NUMBER (1) EQUAL TO 26 IX2094.2 +177500 PERFORM PASS IX2094.2 +177600 GO TO START-WRITE-GF-23. IX2094.2 +177700 MOVE 26 TO RECNO. IX2094.2 +177800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +177900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +178000 START-FAIL-GF-23. IX2094.2 +178100 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +178200 PERFORM FAIL. IX2094.2 +178300 MOVE 26 TO CORRECT-18V0. IX2094.2 +178400 GO TO START-WRITE-GF-23. IX2094.2 +178500 START-DELETE-GF-23. IX2094.2 +178600 PERFORM DE-LETE. IX2094.2 +178700 START-WRITE-GF-23. IX2094.2 +178800 PERFORM PRINT-DETAIL. IX2094.2 +178900 START-INIT-GF-24. IX2094.2 +179000 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2094.2 +179100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +179200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +179300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +179400 MOVE "**" TO FILESTATUS (6) IX2094.2 +179500 GO TO START-DELETE-GF-24. IX2094.2 +179600 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2094.2 +179700 MOVE "XXXXXYYYYY390ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +179800 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +179900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +180000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +180100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +180200 START-TEST-GF-24. IX2094.2 +180300* IX2094.2 +180400* START-TEST-GF-24 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +180500* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2094.2 +180600* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2094.2 +180700* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2094.2 +180800* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +180900* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +181000* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +181100* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +181200* TO BE POSITIONED TO RECORD KEY XXXXXXXXXX380 IX2094.2 +181300* ALTKEY1 (RECORD NUMBER 190) WHICH WAS THE IX2094.2 +181400* FIRST RECORD WRITTEN TO THE FILE THAT IX2094.2 +181500* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF IX2094.2 +181600* THE KEY. THE ALTERNATE KEY WAS LOADED WITH THEIX2094.2 +181700* VALUE XXXXXYYYYY390ALTKEY1 (KEY FOR RECORD IX2094.2 +181800* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2094.2 +181900* IX2094.2 +182000 START IX-FS1 IX2094.2 +182100 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-5 IX2094.2 +182200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +182300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +182400 GO TO START-FAIL-GF-24. IX2094.2 +182500 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +182600 READ IX-FS1 AT END IX2094.2 +182700 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +182800 GO TO START-FAIL-GF-24. IX2094.2 +182900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +183000 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2094.2 +183100 PERFORM PASS IX2094.2 +183200 GO TO START-WRITE-GF-24. IX2094.2 +183300 MOVE 65 TO RECNO. IX2094.2 +183400 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +183500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +183600 START-FAIL-GF-24. IX2094.2 +183700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +183800 PERFORM FAIL. IX2094.2 +183900 MOVE 190 TO CORRECT-18V0. IX2094.2 +184000 GO TO START-WRITE-GF-24. IX2094.2 +184100 START-DELETE-GF-24. IX2094.2 +184200 PERFORM DE-LETE. IX2094.2 +184300 START-WRITE-GF-24. IX2094.2 +184400 PERFORM PRINT-DETAIL. IX2094.2 +184500 START-INIT-GF-25. IX2094.2 +184600 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2094.2 +184700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +184800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +184900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +185000 MOVE "**" TO FILESTATUS (7) IX2094.2 +185100 GO TO START-DELETE-GF-25. IX2094.2 +185200 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +185300 MOVE "022ALTKEY1 " TO FS1-ALTKEY1-1-20. IX2094.2 +185400 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +185500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +185600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +185700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +185800 START-TEST-GF-25. IX2094.2 +185900* IX2094.2 +186000* START-TEST-GF-25 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +186100* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +186200* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +186300* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +186400* POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) IX2094.2 +186500* IS LOADED WITH "022ALTKEY1". NO SUCH RECORD IX2094.2 +186600* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +186700* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +186800* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +186900* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +187000* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +187100* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +187200* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +187300* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +187400* IX2094.2 +187500 START IX-FS1 IX2094.2 +187600 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +187700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +187800 GO TO START-PASS-GF-25. IX2094.2 +187900 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +188000 READ IX-FS1 AT END IX2094.2 +188100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +188200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +188300 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +188400 PERFORM FAIL. IX2094.2 +188500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +188600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +188700 GO TO START-WRITE-GF-25. IX2094.2 +188800 START-PASS-GF-25. IX2094.2 +188900 PERFORM PASS. IX2094.2 +189000 GO TO START-WRITE-GF-25. IX2094.2 +189100 START-DELETE-GF-25. IX2094.2 +189200 PERFORM DE-LETE. IX2094.2 +189300 START-WRITE-GF-25. IX2094.2 +189400 PERFORM PRINT-DETAIL. IX2094.2 +189500 START-INIT-GF-26. IX2094.2 +189600 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2094.2 +189700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +189800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +189900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +190000 MOVE "**" TO FILESTATUS (8) IX2094.2 +190100 GO TO START-DELETE-GF-26. IX2094.2 +190200 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +190300 MOVE "EEEEEEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +190400 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +190500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +190600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +190700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +190800 START-TEST-GF-26. IX2094.2 +190900* IX2094.2 +191000* START-TEST-GF-26 - THIS TEST USES AN OPERAND IN THE IX2094.2 +191100* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +191200* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +191300* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +191400* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +191500* LOADED WITH "EEEEEEEEEE". THIS KEY VALUE IX2094.2 +191600* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +191700* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +191800* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +191900* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +192000* EXECUTED. IX2094.2 +192100* IX2094.2 +192200 START IX-FS1 IX2094.2 +192300 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +192400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +192500 GO TO START-PASS-GF-26. IX2094.2 +192600 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +192700 READ IX-FS1 AT END IX2094.2 +192800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +192900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +193000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +193100 PERFORM FAIL. IX2094.2 +193200 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +193300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +193400 GO TO START-WRITE-GF-26. IX2094.2 +193500 START-PASS-GF-26. IX2094.2 +193600 PERFORM PASS. IX2094.2 +193700 GO TO START-WRITE-GF-26. IX2094.2 +193800 START-DELETE-GF-26. IX2094.2 +193900 PERFORM DE-LETE. IX2094.2 +194000 START-WRITE-GF-26. IX2094.2 +194100 PERFORM PRINT-DETAIL. IX2094.2 +194200 START-INIT-GF-27. IX2094.2 +194300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2094.2 +194400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +194500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +194600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +194700 MOVE "**" TO FILESTATUS (9) IX2094.2 +194800 GO TO START-DELETE-GF-27. IX2094.2 +194900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +195000 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +195100 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +195200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +195300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +195400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +195500 START-TEST-GF-27. IX2094.2 +195600* IX2094.2 +195700* START-TEST-GF-27 - THIS TEST USES AN OPERAND IN THE IX2094.2 +195800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +195900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +196000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +196100* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +196200* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2094.2 +196300* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +196400* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +196500* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +196600* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +196700* EXECUTED. IX2094.2 +196800* IX2094.2 +196900 START IX-FS1 IX2094.2 +197000 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +197100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +197200 GO TO START-PASS-GF-27. IX2094.2 +197300 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +197400 READ IX-FS1 AT END IX2094.2 +197500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +197600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +197700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +197800 PERFORM FAIL. IX2094.2 +197900 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +198000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +198100 GO TO START-WRITE-GF-27. IX2094.2 +198200 START-PASS-GF-27. IX2094.2 +198300 PERFORM PASS. IX2094.2 +198400 GO TO START-WRITE-GF-27. IX2094.2 +198500 START-DELETE-GF-27. IX2094.2 +198600 PERFORM DE-LETE. IX2094.2 +198700 START-WRITE-GF-27. IX2094.2 +198800 PERFORM PRINT-DETAIL. IX2094.2 +198900 IX2094.2 +199000 CLOSE IX-FS1. IX2094.2 +199100 IX2094.2 +199200 START-INIT-FILE-STATUS-2. IX2094.2 +199300 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +199400 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2094.2 +199500* IX2094.2 +199600* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +199700* CAPTURED FROM THE LAST NINE TSTS. IX2094.2 +199800* IX2094.2 +199900 START-TEST-GF-28. IX2094.2 +200000 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +200100 PERFORM DE-LETE IX2094.2 +200200 GO TO START-WRITE-GF-28. IX2094.2 +200300* IX2094.2 +200400* START-TEST-GF-28 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +200500* RESULTING FROM START-TEST-GF-19. THE FILE IX2094.2 +200600* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +200700* IX2094.2 +200800 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +200900 PERFORM PASS IX2094.2 +201000 ELSE IX2094.2 +201100 MOVE "IX-3; 1.3.4 (1) A FROM START-TEST-GF-19 " TO RE-MARKIX2094.2 +201200 PERFORM FAIL IX2094.2 +201300 MOVE "00" TO CORRECT-A IX2094.2 +201400 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +201500 START-WRITE-GF-28. IX2094.2 +201600 PERFORM PRINT-DETAIL. IX2094.2 +201700 START-TEST-GF-29. IX2094.2 +201800 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +201900 MOVE "START-TEST-GF-29" TO PAR-NAME. IX2094.2 +202000 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +202100 PERFORM DE-LETE IX2094.2 +202200 GO TO START-WRITE-GF-29. IX2094.2 +202300* IX2094.2 +202400* START-TEST-GF-29 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +202500* RESULTING FROM START-TEST-GF-20. THE FILE IX2094.2 +202600* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +202700* IX2094.2 +202800 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +202900 PERFORM PASS IX2094.2 +203000 ELSE PERFORM FAIL IX2094.2 +203100 MOVE "IX-4; 1.3.4 (3) C ; SEE START-TEST-GF-20 " TO RE-MARKIX2094.2 +203200 MOVE "23" TO CORRECT-A IX2094.2 +203300 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +203400 START-WRITE-GF-29. IX2094.2 +203500 PERFORM PRINT-DETAIL. IX2094.2 +203600 START-TEST-GF-30. IX2094.2 +203700 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +203800 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2094.2 +203900 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +204000 PERFORM DE-LETE IX2094.2 +204100 GO TO START-WRITE-GF-30. IX2094.2 +204200* IX2094.2 +204300* START-TEST-GF-30 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +204400* RESULTING FROM START-TEST-GF-21. THE FILE IX2094.2 +204500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +204600* IX2094.2 +204700 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +204800 PERFORM PASS IX2094.2 +204900 ELSE PERFORM FAIL IX2094.2 +205000 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-21 " TO RE-MARKIX2094.2 +205100 MOVE "23" TO CORRECT-A IX2094.2 +205200 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +205300 START-WRITE-GF-30. IX2094.2 +205400 PERFORM PRINT-DETAIL. IX2094.2 +205500 START-TEST-GF-31. IX2094.2 +205600 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +205700 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2094.2 +205800 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +205900 PERFORM DE-LETE IX2094.2 +206000 GO TO START-WRITE-GF-31. IX2094.2 +206100* IX2094.2 +206200* START-TEST-GF-31 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +206300* RESULTING FROM START-TEST-GF-22. THE FILE IX2094.2 +206400* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +206500* IX2094.2 +206600 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +206700 PERFORM PASS IX2094.2 +206800 ELSE PERFORM FAIL IX2094.2 +206900 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-22 " TO RE-MARKIX2094.2 +207000 MOVE "23" TO CORRECT-A IX2094.2 +207100 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +207200 START-WRITE-GF-31. IX2094.2 +207300 PERFORM PRINT-DETAIL. IX2094.2 +207400 START-TEST-GF-32. IX2094.2 +207500 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +207600 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2094.2 +207700 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +207800 PERFORM DE-LETE IX2094.2 +207900 GO TO START-WRITE-GF-32. IX2094.2 +208000* IX2094.2 +208100* START-TEST-GF.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +208200* RESULTING FROM START-TEST-GF-23. THE FILE IX2094.2 +208300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +208400* IX2094.2 +208500 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +208600 PERFORM PASS IX2094.2 +208700 ELSE PERFORM FAIL IX2094.2 +208800 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-23 " TO RE-MARKIX2094.2 +208900 MOVE "00" TO CORRECT-A IX2094.2 +209000 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +209100 START-WRITE-GF-32. IX2094.2 +209200 PERFORM PRINT-DETAIL. IX2094.2 +209300 START-TEST-GF-33. IX2094.2 +209400 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +209500 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2094.2 +209600 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +209700 PERFORM DE-LETE IX2094.2 +209800 GO TO START-WRITE-GF-33. IX2094.2 +209900* IX2094.2 +210000* START-TEST-GF-33 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +210100* RESULTING FROM START-TEST-GF-24. THE FILE IX2094.2 +210200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +210300* IX2094.2 +210400 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +210500 PERFORM PASS IX2094.2 +210600 ELSE PERFORM FAIL IX2094.2 +210700 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-24 " TO RE-MARKIX2094.2 +210800 MOVE "00" TO CORRECT-A IX2094.2 +210900 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +211000 START-WRITE-GF-33. IX2094.2 +211100 PERFORM PRINT-DETAIL. IX2094.2 +211200 START-TEST-GF-34. IX2094.2 +211300 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +211400 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2094.2 +211500 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +211600 PERFORM DE-LETE IX2094.2 +211700 GO TO START-WRITE-GF-34. IX2094.2 +211800* IX2094.2 +211900* START-TEST-GF-34 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +212000* RESULTING FROM START-TEST-GF-25. THE FILE IX2094.2 +212100* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +212200* IX2094.2 +212300 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +212400 PERFORM PASS IX2094.2 +212500 ELSE PERFORM FAIL IX2094.2 +212600 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-25 " TO RE-MARKIX2094.2 +212700 MOVE "23" TO CORRECT-A IX2094.2 +212800 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +212900 START-WRITE-GF-34. IX2094.2 +213000 PERFORM PRINT-DETAIL. IX2094.2 +213100 START-TEST-GF-35. IX2094.2 +213200 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +213300 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2094.2 +213400 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +213500 PERFORM DE-LETE IX2094.2 +213600 GO TO START-WRITE-GF-35. IX2094.2 +213700* IX2094.2 +213800* START-TEST-GF-35 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +213900* RESULTING FROM START-TEST-GF-26. THE FILE IX2094.2 +214000* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +214100* IX2094.2 +214200 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +214300 PERFORM PASS IX2094.2 +214400 ELSE PERFORM FAIL IX2094.2 +214500 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-26 " TO RE-MARKIX2094.2 +214600 MOVE "23" TO CORRECT-A IX2094.2 +214700 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +214800 START-WRITE-GF-35. IX2094.2 +214900 PERFORM PRINT-DETAIL. IX2094.2 +215000 START-TEST-GF-36. IX2094.2 +215100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +215200 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2094.2 +215300 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +215400 PERFORM DE-LETE IX2094.2 +215500 GO TO START-WRITE-GF-36. IX2094.2 +215600* IX2094.2 +215700* START-TEST-GF-36 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +215800* RESULTING FROM START-TEST-GF-27. THE FILE IX2094.2 +215900* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +216000* IX2094.2 +216100 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +216200 PERFORM PASS IX2094.2 +216300 ELSE PERFORM FAIL IX2094.2 +216400 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-27 " TO RE-MARKIX2094.2 +216500 MOVE "23" TO CORRECT-A IX2094.2 +216600 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +216700 START-WRITE-GF-36. IX2094.2 +216800 PERFORM PRINT-DETAIL. IX2094.2 +216900 IX2094.2 +217000 IX2094.2 +217100 START-INIT-GF-37-ETC. IX2094.2 +217200 OPEN INPUT IX-FS1. IX2094.2 +217300 MOVE "STRT EQ ALTKY W/DUP" TO FEATURE. IX2094.2 +217400 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2094.2 +217500 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +217600* IX2094.2 +217700* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +217800* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +217900* START-TEST-007 USES ONLY THE ALTERNATE RECORD KEY WITH DUPLI- IX2094.2 +218000* CATES OPTION (ALTERNATE-KEY2) FOR ESTABLISHING IX2094.2 +218100* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2094.2 +218200* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2094.2 +218300* TAKEN FOR THE TESTS. IX2094.2 +218400* IX2094.2 +218500* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +218600* IX2094.2 +218700* START-TEST-GF-37 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +218800* START-TEST-GF-38 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEYIX2094.2 +218900* START-TEST-GF-39 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +219000* START-TEST-GF-40 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2094.2 +219100* START-TEST-GF-41 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +219200* START-TEST-GF-42 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +219300* START-TEST-GF-43 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +219400* START-TEST-GF-44 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +219500* START-TEST-GF-45 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2094.2 +219600* IX2094.2 +219700* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +219800* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +219900* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +220000* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +220100* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD MATCH IX2094.2 +220200* RECORDS IN THE FILE. IF A KEY MATCH IS EXPECTED FROM IX2094.2 +220300* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +220400* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +220500* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +220600* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +220700* IX2094.2 +220800 START-INIT-GF-37. IX2094.2 +220900 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2094.2 +221000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +221100 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +221200 MOVE "**" TO FILESTATUS (1) IX2094.2 +221300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +221400 GO TO START-DELETE-GF-37. IX2094.2 +221500 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2094.2 +221600 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +221700 MOVE "VVVVVVVVUU376ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +221800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +221900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +222000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +222100 START-TEST-GF-37. IX2094.2 +222200* IX2094.2 +222300* START-TEST-GF-37 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +222400* WHICH HAS AN ALTERNATE RECORD KEY VALUE OF IX2094.2 +222500* VVVVVVVVUU376ALTKEY2 (RECORD NUMBER 12). IX2094.2 +222600* IX2094.2 +222700 START IX-FS1 IX2094.2 +222800 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +222900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +223000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +223100 GO TO START-FAIL-GF-37. IX2094.2 +223200 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +223300 READ IX-FS1 AT END IX2094.2 +223400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +223500 GO TO START-FAIL-GF-37. IX2094.2 +223600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +223700 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2094.2 +223800 PERFORM PASS IX2094.2 +223900 MOVE SPACE TO RE-MARK IX2094.2 +224000 GO TO START-WRITE-GF-37. IX2094.2 +224100 MOVE 12 TO RECNO. IX2094.2 +224200 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +224300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +224400 START-FAIL-GF-37. IX2094.2 +224500 PERFORM FAIL. IX2094.2 +224600 MOVE 12 TO CORRECT-18V0. IX2094.2 +224700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +224800 GO TO START-WRITE-GF-37. IX2094.2 +224900 START-DELETE-GF-37. IX2094.2 +225000 PERFORM DE-LETE. IX2094.2 +225100 START-WRITE-GF-37. IX2094.2 +225200 PERFORM PRINT-DETAIL. IX2094.2 +225300 START-INIT-GF-38. IX2094.2 +225400 MOVE "START-TEST-GF-38" TO PAR-NAME. IX2094.2 +225500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +225600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +225700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +225800 MOVE "**" TO FILESTATUS (2) IX2094.2 +225900 GO TO START-DELETE-GF-38. IX2094.2 +226000 MOVE "EEEEEEEEFF064" TO FS1-RECKEY-1-13. IX2094.2 +226100 MOVE "HHHHHHHIII066ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +226200 MOVE "TTTTTTTSSS335ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +226300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +226400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +226500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +226600 START-TEST-GF-38. IX2094.2 +226700* IX2094.2 +226800* START-TEST-GF-38- THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +226900* FILE WHICH HAS AN ALTERNATE RECORD KEY VALUE IX2094.2 +227000* OF TTTTTTTSSS335ALTKEY2. THIS KEY VALUE IS IX2094.2 +227100* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +227200* EXISTING ALTERNATE KEYS IN THE FILE. IX2094.2 +227300* IX2094.2 +227400 START IX-FS1 IX2094.2 +227500 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +227600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +227700 GO TO START-PASS-GF-38. IX2094.2 +227800 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +227900 READ IX-FS1 AT END IX2094.2 +228000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +228100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +228200 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +228300 PERFORM FAIL. IX2094.2 +228400 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +228500 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +228600 GO TO START-WRITE-GF-38. IX2094.2 +228700 START-PASS-GF-38. IX2094.2 +228800 PERFORM PASS. IX2094.2 +228900 GO TO START-WRITE-GF-38. IX2094.2 +229000 START-DELETE-GF-38. IX2094.2 +229100 PERFORM DE-LETE. IX2094.2 +229200 START-WRITE-GF-38. IX2094.2 +229300 PERFORM PRINT-DETAIL. IX2094.2 +229400 START-INIT-GF-39. IX2094.2 +229500 MOVE "START-TEST-GF-39" TO PAR-NAME. IX2094.2 +229600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +229700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +229800 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +229900 MOVE "**" TO FILESTATUS (3) IX2094.2 +230000 GO TO START-DELETE-GF-39. IX2094.2 +230100 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +230200 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +230300 MOVE "DDDDDDDDDC000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +230400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +230500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +230600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +230700 START-TEST-GF-39. IX2094.2 +230800* IX2094.2 +230900* START-TEST-GF-39 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +231000* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +231100* KEY VALUE OF DDDDDDDDDC000ALTKEY2. THIS KEY IX2094.2 +231200* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +231300* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +231400* IX2094.2 +231500 START IX-FS1 IX2094.2 +231600 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +231700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +231800 GO TO START-PASS-GF-39. IX2094.2 +231900 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +232000 READ IX-FS1 AT END IX2094.2 +232100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +232200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +232300 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +232400 PERFORM FAIL. IX2094.2 +232500 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +232600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +232700 GO TO START-WRITE-GF-39. IX2094.2 +232800 START-PASS-GF-39. IX2094.2 +232900 PERFORM PASS. IX2094.2 +233000 GO TO START-WRITE-GF-39. IX2094.2 +233100 START-DELETE-GF-39. IX2094.2 +233200 PERFORM DE-LETE. IX2094.2 +233300 START-WRITE-GF-39. IX2094.2 +233400 PERFORM PRINT-DETAIL. IX2094.2 +233500 START-INIT-GF-40. IX2094.2 +233600 MOVE "START-TEST-GF-40" TO PAR-NAME. IX2094.2 +233700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +233800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +233900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +234000 MOVE "**" TO FILESTATUS (4) IX2094.2 +234100 GO TO START-DELETE-GF-40. IX2094.2 +234200 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +234300 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +234400 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +234500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +234600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +234700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +234800 START-TEST-GF-40. IX2094.2 +234900* IX2094.2 +235000* START-TEST-GF-40 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +235100* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +235200* KEY VALUE OF WWWWWWWWWV399ALTKEY2. THIS IX2094.2 +235300* VALUE IS SEQUENTIALLY ONE GREATER THAN IX2094.2 +235400* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2094.2 +235500* THE FILE. AN INVALID KEY CONDITION IX2094.2 +235600* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +235700* IX2094.2 +235800 START IX-FS1 IX2094.2 +235900 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +236000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +236100 GO TO START-PASS-GF-40. IX2094.2 +236200 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +236300 READ IX-FS1 AT END IX2094.2 +236400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +236500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +236600 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +236700 PERFORM FAIL. IX2094.2 +236800 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +236900 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +237000 GO TO START-WRITE-GF-40. IX2094.2 +237100 START-PASS-GF-40. IX2094.2 +237200 PERFORM PASS. IX2094.2 +237300 GO TO START-WRITE-GF-40. IX2094.2 +237400 START-DELETE-GF-40. IX2094.2 +237500 PERFORM DE-LETE. IX2094.2 +237600 START-WRITE-GF-40. IX2094.2 +237700 PERFORM PRINT-DETAIL. IX2094.2 +237800 START-INIT-GF-41. IX2094.2 +237900 MOVE "START-TEST-GF-41" TO PAR-NAME. IX2094.2 +238000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +238100 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +238200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +238300 MOVE "**" TO FILESTATUS (5) IX2094.2 +238400 GO TO START-DELETE-GF-41. IX2094.2 +238500 MOVE "CCCCCCCCCC038" TO FS1-RECKEY-1-13. IX2094.2 +238600 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +238700 MOVE "VUUUUVVVVV362ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +238800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +238900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +239000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +239100 START-TEST-GF-41. IX2094.2 +239200* IX2094.2 +239300* START-TEST-GF-41 - THE START STATEMENT USES AN OPERAND IX2094.2 +239400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +239500* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2094.2 +239600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +239700* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2094.2 +239800* (POSITIONS 1 THRU 5 OF THE ALTERNATE KEY) IX2094.2 +239900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +240000* BALANCE OF THE ALTERNATE KEY (POSITIONS 6 IX2094.2 +240100* THRU 20) IN NOT A VALID KEY VALUE FOR THE IX2094.2 +240200* FILE. THE IX2094.2 +240300* RECORD WITH THE ALTERNATE KEY IX2094.2 +240400* VUUUUUUUUU362ALTKEY2 (RECORD NUMBER 19) IS IX2094.2 +240500* EXPECTED TO BE FOUND. IX2094.2 +240600* IX2094.2 +240700 START IX-FS1 IX2094.2 +240800 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-5 IX2094.2 +240900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +241000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +241100 GO TO START-FAIL-GF-41. IX2094.2 +241200 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +241300 READ IX-FS1 AT END IX2094.2 +241400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +241500 GO TO START-FAIL-GF-41. IX2094.2 +241600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +241700 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2094.2 +241800 PERFORM PASS IX2094.2 +241900 GO TO START-WRITE-GF-41. IX2094.2 +242000 MOVE 19 TO RECNO. IX2094.2 +242100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +242200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +242300 START-FAIL-GF-41. IX2094.2 +242400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +242500 PERFORM FAIL. IX2094.2 +242600 MOVE 19 TO CORRECT-18V0. IX2094.2 +242700 GO TO START-WRITE-GF-41. IX2094.2 +242800 START-DELETE-GF-41. IX2094.2 +242900 PERFORM DE-LETE. IX2094.2 +243000 START-WRITE-GF-41. IX2094.2 +243100 PERFORM PRINT-DETAIL. IX2094.2 +243200 START-INIT-GF-42. IX2094.2 +243300 MOVE "START-TEST-GF-42" TO PAR-NAME. IX2094.2 +243400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +243500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +243600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +243700 MOVE "**" TO FILESTATUS (6) IX2094.2 +243800 GO TO START-DELETE-GF-42. IX2094.2 +243900 MOVE "TTTTTTTTTT390" TO FS1-RECKEY-1-13. IX2094.2 +244000 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +244100 MOVE "EEEEEDDDDD010ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +244200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +244300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +244400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +244500 START-TEST-GF-42. IX2094.2 +244600* IX2094.2 +244700* START-TEST-GF-42 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +244800* KEY PHRASE WHICH IS NOT THE NAME OF AN ALTER-IX2094.2 +244900* NATE KEY BUT IS THE NAME OF A DATA ITEM THAT IX2094.2 +245000* SUBORDINATE TO THE ALTERNATE KEY. THE CONTENTIX2094.2 +245100* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +245200* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +245300* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +245400* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +245500* TO BE POSITIONED TO ALTERNATE KEY IX2094.2 +245600* EEEEEDDDDD020ALTKEY2 (RECORD NO 195) WHICH IX2094.2 +245700* IS THE FIRST RECORD ALPHABETICALLY IN THE IX2094.2 +245800* FILE THAT CONTAINS EEEEE IN THE FIRST 5 IX2094.2 +245900* POSITIONS OF THE KEY. NOTE THIS IS ALSO IX2094.2 +246000* A RECORD IN WHICH THE VALUE OF THE FULL IX2094.2 +246100* 20 POSITION KEY IS A DUPLICATE OF ANOTHER IX2094.2 +246200* RECORD (RECORD NUMBER 191). THE ALTERNATE IX2094.2 +246300* KEY WAS LOADED WITH THE VALUE IX2094.2 +246400* EEEEEDDDDD010ALTKEY2 (KEY FOR RECORD NUMBER IX2094.2 +246500* 195) BEFORE THE START WAS EXECUTED. IX2094.2 +246600* IX2094.2 +246700 START IX-FS1 IX2094.2 +246800 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-5 IX2094.2 +246900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +247000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +247100 GO TO START-FAIL-GF-42. IX2094.2 +247200 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +247300 READ IX-FS1 AT END IX2094.2 +247400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +247500 GO TO START-FAIL-GF-42. IX2094.2 +247600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +247700 IF XRECORD-NUMBER (1) EQUAL TO 195 IX2094.2 +247800 PERFORM PASS IX2094.2 +247900 GO TO START-WRITE-GF-42. IX2094.2 +248000 MOVE 65 TO RECNO. IX2094.2 +248100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +248200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +248300 START-FAIL-GF-42. IX2094.2 +248400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +248500 PERFORM FAIL. IX2094.2 +248600 MOVE 195 TO CORRECT-18V0. IX2094.2 +248700 GO TO START-WRITE-GF-42. IX2094.2 +248800 START-DELETE-GF-42. IX2094.2 +248900 PERFORM DE-LETE. IX2094.2 +249000 START-WRITE-GF-42. IX2094.2 +249100 PERFORM PRINT-DETAIL. IX2094.2 +249200 START-INIT-GF-43. IX2094.2 +249300 MOVE "START-TEST-GF-43" TO PAR-NAME. IX2094.2 +249400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +249500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +249600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +249700 MOVE "**" TO FILESTATUS (7) IX2094.2 +249800 GO TO START-DELETE-GF-43. IX2094.2 +249900 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +250000 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +250100 MOVE "380ALTKEY2 " TO FS1-ALTKEY2-1-20. IX2094.2 +250200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +250300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +250400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +250500 START-TEST-GF-43. IX2094.2 +250600* IX2094.2 +250700* START-TEST-GF-43 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +250800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +250900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +251000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +251100* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IX2094.2 +251200* IS LOADED WITH "380ALTKEY2". NO SUCH RECORD IX2094.2 +251300* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +251400* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +251500* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +251600* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +251700* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +251800* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +251900* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +252000* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +252100* IX2094.2 +252200 START IX-FS1 IX2094.2 +252300 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +252400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +252500 GO TO START-PASS-GF-43. IX2094.2 +252600 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +252700 READ IX-FS1 AT END IX2094.2 +252800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +252900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +253000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +253100 PERFORM FAIL. IX2094.2 +253200 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +253300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +253400 GO TO START-WRITE-GF-43. IX2094.2 +253500 START-PASS-GF-43. IX2094.2 +253600 PERFORM PASS. IX2094.2 +253700 GO TO START-WRITE-GF-43. IX2094.2 +253800 START-DELETE-GF-43. IX2094.2 +253900 PERFORM DE-LETE. IX2094.2 +254000 START-WRITE-GF-43. IX2094.2 +254100 PERFORM PRINT-DETAIL. IX2094.2 +254200 START-INIT-GF-44. IX2094.2 +254300 MOVE "START-TEST-GF-44" TO PAR-NAME. IX2094.2 +254400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +254500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +254600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +254700 MOVE "**" TO FILESTATUS (8) IX2094.2 +254800 GO TO START-DELETE-GF-44. IX2094.2 +254900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +255000 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +255100 MOVE "DDDDDDDDDC000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +255200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +255300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +255400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +255500 START-TEST-GF-44. IX2094.2 +255600* IX2094.2 +255700* START-TEST-GF-44 - THIS TEST USES AN OPERAND IN THE IX2094.2 +255800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +255900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +256000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +256100* (POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) ISIX2094.2 +256200* LOADED WITH "DDDDDDDDDC". THIS KEY VALUE IX2094.2 +256300* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +256400* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +256500* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +256600* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +256700* EXECUTED. IX2094.2 +256800* IX2094.2 +256900 START IX-FS1 IX2094.2 +257000 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +257100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +257200 GO TO START-PASS-GF-44. IX2094.2 +257300 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +257400 READ IX-FS1 AT END IX2094.2 +257500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +257600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +257700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +257800 PERFORM FAIL. IX2094.2 +257900 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +258000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +258100 GO TO START-WRITE-GF-44. IX2094.2 +258200 START-PASS-GF-44. IX2094.2 +258300 PERFORM PASS. IX2094.2 +258400 GO TO START-WRITE-GF-44. IX2094.2 +258500 START-DELETE-GF-44. IX2094.2 +258600 PERFORM DE-LETE. IX2094.2 +258700 START-WRITE-GF-44. IX2094.2 +258800 PERFORM PRINT-DETAIL. IX2094.2 +258900 START-INIT-GF-45. IX2094.2 +259000 MOVE "START-TEST-GF-45" TO PAR-NAME. IX2094.2 +259100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +259200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +259300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +259400 MOVE "**" TO FILESTATUS (9) IX2094.2 +259500 GO TO START-DELETE-GF-45. IX2094.2 +259600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +259700 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +259800 MOVE "WWWWWWWWWW400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +259900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +260000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +260100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +260200 START-TEST-GF-45. IX2094.2 +260300* IX2094.2 +260400* START-TEST-GF-45 - THIS TEST USES AN OPERAND IN THE IX2094.2 +260500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +260600* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +260700* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +260800* (POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) ISIX2094.2 +260900* LOADED WITH "WWWWWWWWWW". THIS KEY VALUE IX2094.2 +261000* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +261100* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +261200* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +261300* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +261400* EXECUTED. IX2094.2 +261500* IX2094.2 +261600 START IX-FS1 IX2094.2 +261700 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +261800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +261900 GO TO START-PASS-GF-45. IX2094.2 +262000 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +262100 READ IX-FS1 AT END IX2094.2 +262200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +262300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +262400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +262500 PERFORM FAIL. IX2094.2 +262600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +262700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +262800 GO TO START-WRITE-GF-45. IX2094.2 +262900 START-PASS-GF-45. IX2094.2 +263000 PERFORM PASS. IX2094.2 +263100 GO TO START-WRITE-GF-45. IX2094.2 +263200 START-DELETE-GF-45. IX2094.2 +263300 PERFORM DE-LETE. IX2094.2 +263400 START-WRITE-GF-45. IX2094.2 +263500 PERFORM PRINT-DETAIL. IX2094.2 +263600 IX2094.2 +263700 CLOSE IX-FS1. IX2094.2 +263800 IX2094.2 +263900 START-INIT-FILE-STATUS-03. IX2094.2 +264000 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +264100 MOVE "START-TEST-GF-46" TO PAR-NAME. IX2094.2 +264200* IX2094.2 +264300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +264400* CAPTURED FROM THE NINE TESTS BEFORE. IX2094.2 +264500* IX2094.2 +264600 START-TEST-GF-46. IX2094.2 +264700 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +264800 PERFORM DE-LETE IX2094.2 +264900 GO TO START-WRITE-GF-46. IX2094.2 +265000* IX2094.2 +265100* START-TEST-GF-046 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +265200* RESULTING FROM START-TEST-GF-37. THE FILE IX2094.2 +265300* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +265400* IX2094.2 +265500 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +265600 PERFORM PASS IX2094.2 +265700 ELSE IX2094.2 +265800 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-37 " TO RE-MARKIX2094.2 +265900 PERFORM FAIL IX2094.2 +266000 MOVE "00" TO CORRECT-A IX2094.2 +266100 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +266200 START-WRITE-GF-46. IX2094.2 +266300 PERFORM PRINT-DETAIL. IX2094.2 +266400 START-TEST-GF-47. IX2094.2 +266500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +266600 MOVE "START-TEST-GF-47" TO PAR-NAME. IX2094.2 +266700 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +266800 PERFORM DE-LETE IX2094.2 +266900 GO TO START-WRITE-GF-47. IX2094.2 +267000* IX2094.2 +267100* START-TEST-GF-47 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +267200* RESULTING FROM START-TEST-GF-38. THE FILE IX2094.2 +267300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +267400* IX2094.2 +267500 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +267600 PERFORM PASS IX2094.2 +267700 ELSE PERFORM FAIL IX2094.2 +267800 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-38 " TO RE-MARKIX2094.2 +267900 MOVE "23" TO CORRECT-A IX2094.2 +268000 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +268100 START-WRITE-GF-47. IX2094.2 +268200 PERFORM PRINT-DETAIL. IX2094.2 +268300 START-TEST-GF-48. IX2094.2 +268400 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +268500 MOVE "START-TEST-GF-48" TO PAR-NAME. IX2094.2 +268600 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +268700 PERFORM DE-LETE IX2094.2 +268800 GO TO START-WRITE-GF-48. IX2094.2 +268900* IX2094.2 +269000* START-TEST-GF-48 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +269100* RESULTING FROM START-TEST-GF-39. THE FILE IX2094.2 +269200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +269300* IX2094.2 +269400 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +269500 PERFORM PASS IX2094.2 +269600 ELSE PERFORM FAIL IX2094.2 +269700 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-39 " TO RE-MARKIX2094.2 +269800 MOVE "23" TO CORRECT-A IX2094.2 +269900 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +270000 START-WRITE-GF-48. IX2094.2 +270100 PERFORM PRINT-DETAIL. IX2094.2 +270200 START-TEST-GF-49. IX2094.2 +270300 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +270400 MOVE "START-TEST-GF-49" TO PAR-NAME. IX2094.2 +270500 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +270600 PERFORM DE-LETE IX2094.2 +270700 GO TO START-WRITE-GF-49. IX2094.2 +270800* IX2094.2 +270900* START-TEST-GF-49 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +271000* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +271100* RESULTING FROM START-TEST-GF-40. THE FILE IX2094.2 +271200* IX2094.2 +271300 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +271400 PERFORM PASS IX2094.2 +271500 ELSE PERFORM FAIL IX2094.2 +271600 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-40 " TO RE-MARKIX2094.2 +271700 MOVE "23" TO CORRECT-A IX2094.2 +271800 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +271900 START-WRITE-GF-49. IX2094.2 +272000 PERFORM PRINT-DETAIL. IX2094.2 +272100 START-TEST-GF-50. IX2094.2 +272200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +272300 MOVE "START-TEST-GF-50" TO PAR-NAME. IX2094.2 +272400 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +272500 PERFORM DE-LETE IX2094.2 +272600 GO TO START-WRITE-GF-50. IX2094.2 +272700* IX2094.2 +272800* START-TEST-GF-50 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +272900* RESULTING FROM START-TEST-GF-41. THE FILE IX2094.2 +273000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +273100* IX2094.2 +273200 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +273300 PERFORM PASS IX2094.2 +273400 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-41 " TO RE-MARKIX2094.2 +273500 ELSE PERFORM FAIL IX2094.2 +273600 MOVE "00" TO CORRECT-A IX2094.2 +273700 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +273800 START-WRITE-GF-50. IX2094.2 +273900 MOVE "FROM START-TEST-007.05" TO RE-MARK. IX2094.2 +274000 PERFORM PRINT-DETAIL. IX2094.2 +274100 START-TEST-GF-51. IX2094.2 +274200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +274300 MOVE "START-TEST-GF-51" TO PAR-NAME. IX2094.2 +274400 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +274500 PERFORM DE-LETE IX2094.2 +274600 GO TO START-WRITE-GF-51. IX2094.2 +274700* IX2094.2 +274800* START-TEST-GF-51 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +274900* RESULTING FROM START-TEST-GF-42. THE FILE IX2094.2 +275000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +275100* IX2094.2 +275200 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +275300 PERFORM PASS IX2094.2 +275400 ELSE PERFORM FAIL IX2094.2 +275500 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-42 " TO RE-MARKIX2094.2 +275600 MOVE "00" TO CORRECT-A IX2094.2 +275700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +275800 START-WRITE-GF-51. IX2094.2 +275900 PERFORM PRINT-DETAIL. IX2094.2 +276000 START-TEST-GF-52. IX2094.2 +276100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +276200 MOVE "START-TEST-GF-52" TO PAR-NAME. IX2094.2 +276300 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +276400 PERFORM DE-LETE IX2094.2 +276500 GO TO START-WRITE-GF-52. IX2094.2 +276600* IX2094.2 +276700* START-TEST-GF-52 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +276800* RESULTING FROM START-TEST-GF-43. THE FILE IX2094.2 +276900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +277000* IX2094.2 +277100 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +277200 PERFORM PASS IX2094.2 +277300 ELSE PERFORM FAIL IX2094.2 +277400 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-43 " TO RE-MARKIX2094.2 +277500 MOVE "23" TO CORRECT-A IX2094.2 +277600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +277700 START-WRITE-GF-52. IX2094.2 +277800 PERFORM PRINT-DETAIL. IX2094.2 +277900 START-TEST-GF-53. IX2094.2 +278000 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +278100 MOVE "START-TEST-GF-53" TO PAR-NAME. IX2094.2 +278200 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +278300 PERFORM DE-LETE IX2094.2 +278400 GO TO START-WRITE-GF-53. IX2094.2 +278500* IX2094.2 +278600* START-TEST-GF-53 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +278700* RESULTING FROM START-TEST-GF-44. THE FILE IX2094.2 +278800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +278900* IX2094.2 +279000 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +279100 PERFORM PASS IX2094.2 +279200 ELSE PERFORM FAIL IX2094.2 +279300 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-44 " TO RE-MARKIX2094.2 +279400 MOVE "23" TO CORRECT-A IX2094.2 +279500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +279600 START-WRITE-GF-53. IX2094.2 +279700 PERFORM PRINT-DETAIL. IX2094.2 +279800 START-TEST-GF-54. IX2094.2 +279900 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +280000 MOVE "START-TEST-GF-54" TO PAR-NAME. IX2094.2 +280100 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +280200 PERFORM DE-LETE IX2094.2 +280300 GO TO START-WRITE-GF-54. IX2094.2 +280400* IX2094.2 +280500* START-TEST-GF-54 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +280600* RESULTING FROM START-TEST-GF-45. THE FILE IX2094.2 +280700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +280800* IX2094.2 +280900 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +281000 PERFORM PASS IX2094.2 +281100 ELSE PERFORM FAIL IX2094.2 +281200 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-45 " TO RE-MARKIX2094.2 +281300 MOVE "23" TO CORRECT-A IX2094.2 +281400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +281500 START-WRITE-GF-54. IX2094.2 +281600 PERFORM PRINT-DETAIL. IX2094.2 +281700*START-WRITE-008. IX2094.2 +281800 GO TO START-TEST-COMPLETE. IX2094.2 +281900*START-CLOSE-FILES. IX2094.2 +282000* GO TO START-TEST-COMPLETE. IX2094.2 +282100 START-INITIALIZE-RECORD. IX2094.2 +282200 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2094.2 +282300 MOVE ZERO TO INIT-FLAG. IX2094.2 +282400 MOVE 9999 TO XRECORD-NUMBER (1). IX2094.2 +282500 MOVE SPACE TO IX-FS1R1-F-G-240. IX2094.2 +282600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +282700 START IX-FS1 KEY IS EQUAL TO IX-FS1-KEY INVALID KEY IX2094.2 +282800 MOVE 1 TO INIT-FLAG. IX2094.2 +282900 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2094.2 +283000 AT END MOVE 1 TO INIT-FLAG. IX2094.2 +283100 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2094.2 +283200 MOVE 1 TO INIT-FLAG. IX2094.2 +283300 MOVE "**" TO FS1-STATUS. IX2094.2 +283400 DISPLAY-RECORD-KEYS. IX2094.2 +283500 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2094.2 +283600 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2094.2 +283700 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2094.2 +283800 MOVE SPACE TO P-OR-F. IX2094.2 +283900 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2094.2 +284000 PERFORM PRINT-DETAIL. IX2094.2 +284100 DISPLAY-ALTERNATE-KEY1. IX2094.2 +284200 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2094.2 +284300 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2094.2 +284400 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2094.2 +284500 MOVE SPACE TO P-OR-F. IX2094.2 +284600 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2094.2 +284700 PERFORM PRINT-DETAIL. IX2094.2 +284800 DISPLAY-ALTERNATE-KEY2. IX2094.2 +284900 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2094.2 +285000 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2094.2 +285100 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2094.2 +285200 MOVE SPACE TO P-OR-F. IX2094.2 +285300 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2094.2 +285400 PERFORM PRINT-DETAIL. IX2094.2 +285500 START-TEST-COMPLETE. IX2094.2 +285600 EXIT. IX2094.2 +285700 CCVS-EXIT SECTION. IX2094.2 +285800 CCVS-999999. IX2094.2 +285900 GO TO CLOSE-FILES. IX2094.2 +*END-OF,IX209A +*HEADER,COBOL,IX210A +000100 IDENTIFICATION DIVISION. IX2104.2 +000200 PROGRAM-ID. IX2104.2 +000300 IX210A. IX2104.2 +000400**************************************************************** IX2104.2 +000500* * IX2104.2 +000600* VALIDATION FOR:- * IX2104.2 +000700* * IX2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +000900* * IX2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2104.2 +001100* * IX2104.2 +001200**************************************************************** IX2104.2 +001300* * IX2104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2104.2 +001500* * IX2104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2104.2 +001900* * IX2104.2 +002000**************************************************************** IX2104.2 +002100* THE PURPOSE OF THE PROGRAM IS TO TEST USE OF THE IX2104.2 +002200* START --- GREATER THAN --- STATEMENT USING FIRST THE PRIME IX2104.2 +002300* RECORD KEY AND THEN WITH AN ALTERNATE RECORD KEY IX2104.2 +002400* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2104.2 +002500* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2104.2 +002600* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2104.2 +002700* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2104.2 +002800* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2104.2 +002900* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2104.2 +003000* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2104.2 +003100* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2104.2 +003200* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2104.2 +003300* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2104.2 +003400* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2104.2 +003500* IX2104.2 +003600* REFERENCE AMERICAN NATIONAL STANDARD IX2104.2 +003700* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2104.2 +003800* SECTION IX, INDEX I-O, THE START IX2104.2 +003900* STATEMENT. PARAGRAPHS 4.7.3 (3); IX2104.2 +004000* 4.7.4 (1), (4), (4)IX2104.2 +004100* AND IX2104.2 +004200* THE FILE STATUS PARAGRAPH 1.3.4 IX2104.2 +004300* IX2104.2 +004400* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2104.2 +004500* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2104.2 +004600* FROM THE TEST, AND THE RECORD KEY IS LOADED WITH A KEY VALUE.IX2104.2 +004700* DEPENDING ON THE NATURE OF THE TEST THE KEY VALUE MAY OR IX2104.2 +004800* MAY NOT BE A VALID KEY FOR THE FILE. IX2104.2 +004900* IX2104.2 +005000* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2104.2 +005100* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2104.2 +005200* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2104.2 +005300* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2104.2 +005400* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2104.2 +005500* GREATER THAN ---STATEMENT. IX2104.2 +005600* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2104.2 +005700* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2104.2 +005800* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2104.2 +005900* THE FILE. IX2104.2 +006000* IX2104.2 +006100* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2104.2 +006200* ------ ---------- --------------- --------------- IX2104.2 +006300* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2104.2 +006400* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2104.2 +006500* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2104.2 +006600* . . . . IX2104.2 +006700* . . . . IX2104.2 +006800* . . . . IX2104.2 +006900* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2104.2 +007000* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2104.2 +007100* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2104.2 +007200* . . . . IX2104.2 +007300* . . . . IX2104.2 +007400* . . . . IX2104.2 +007500* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2104.2 +007600* IX2104.2 +007700* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2104.2 +007800* EVERY 10TH AND 11TH RECORDS. IX2104.2 +007900* IX2104.2 +008000* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2104.2 +008100* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2104.2 +008200* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2104.2 +008300* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2104.2 +008400* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2104.2 +008500* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2104.2 +008600* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2104.2 +008700* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2104.2 +008800* THE FILE. IX2104.2 +008900* IX2104.2 +009000* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2104.2 +009100* RECORD SIZE = 240 CHARS. IX2104.2 +009200* RECORD KEY SIZE = 13 CHARS. IX2104.2 +009300* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2104.2 +009400* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2104.2 +009500* ACCESS MODE = SEQUENTIAL IX2104.2 +009600* IX2104.2 +009700* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2104.2 +009800* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2104.2 +009900* TEST FOLLOWS. IX2104.2 +010000* IX2104.2 +010100* PROGRAM COLLATING SEQUENCE CLAUSE. (ALL START TESTS) - IX2104.2 +010200* THE PROGRAM COLLATING SEQUENCE CLAUSE SHOULD HAVE NO IX2104.2 +010300* EFFECT ON THE COMARAISIONS ASSOCIATED WITH THE START IX2104.2 +010400* STATEMENT. THIS PROGRAM ASSUMES THAT THE PROGRAM IX2104.2 +010500* COLLATING SEQUENCE CLAUSE ALSO DOES NOT IN ANY WAY IX2104.2 +010600* EFFECT THE SEQUENTIAL ORDER OF RECORDS ACCESSED IX2104.2 +010700* FROM OR WRITTEN TO THE FILE. IX2104.2 +010800* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2104.2 +010900* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2104.2 +011000* TWO ALTERNATE KEYS. IX2104.2 +011100* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2104.2 +011200* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2104.2 +011300* FILE WAS CREATED CORRECTLY. IX2104.2 +011400* START ---KEY GREATER THAN RECORD-KEY INVALID KEY ---. (INX-IX2104.2 +011500* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2104.2 +011600* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2104.2 +011700* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +011800* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2104.2 +011900* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2104.2 +012000* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2104.2 +012100* FILE (.04). IX2104.2 +012200* START ---KEY GREATER THAN DATA-ITEM INVALID KEY ---. (INX-IX2104.2 +012300* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2104.2 +012400* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2104.2 +012500* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2104.2 +012600* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +012700* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2104.2 +012800* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2104.2 +012900* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2104.2 +013000* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2104.2 +013100* THE LAST RECORD IN THE FILE (.09. IX2104.2 +013200* IX2104.2 +013300* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2104.2 +013400* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2104.2 +013500* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2104.2 +013600* NAMED BY THE RECORD KEY CLAUSE. IX2104.2 +013700* IX2104.2 +013800* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2104.2 +013900* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2104.2 +014000* FROM THE START IN INX-TEST-003.01 THRU IX2104.2 +014100* INX-TEST-003.09. IX2104.2 +014200* START ---KEY GREATER THAN ALTNATE-KEY INVALID KEY --. (INX-IX2104.2 +014300* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2104.2 +014400* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2104.2 +014500* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +014600* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2104.2 +014700* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2104.2 +014800* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2104.2 +014900* FILE (.04). IX2104.2 +015000* START ---KEY GREATER THAN DATA-ITEM INVALID KEY --. (INX-IX2104.2 +015100* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2104.2 +015200* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2104.2 +015300* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2104.2 +015400* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +015500* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2104.2 +015600* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2104.2 +015700* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2104.2 +015800* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2104.2 +015900* THE LAST RECORD IN THE FILE (.09. IX2104.2 +016000* IX2104.2 +016100* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2104.2 +016200* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2104.2 +016300* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2104.2 +016400* NAMED BY THE RECORD KEY CLAUSE. IX2104.2 +016500* IX2104.2 +016600* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2104.2 +016700* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2104.2 +016800* FROM THE START IN INX-TEST-005.01 THRU IX2104.2 +016900* INX-TEST-005.09. IX2104.2 +017000* MULTIPLE STARTS. (INX-TEST-007) - THIS TEST EXECUTES IX2104.2 +017100* SEVERAL START STATEMENTS FOLLOWED BY A READ STATEMENTIX2104.2 +017200* AND EXPECTS THE RECORD DESIGNATED BY THE LAST IX2104.2 +017300* START BE MADE AVAILABLE. IX2104.2 +017400* IX2104.2 +017500******************************************************************IX2104.2 +017600* IX2104.2 +017700 ENVIRONMENT DIVISION. IX2104.2 +017800 CONFIGURATION SECTION. IX2104.2 +017900 SOURCE-COMPUTER. IX2104.2 +018000 XXXXX082. IX2104.2 +018100 OBJECT-COMPUTER. IX2104.2 +018200 XXXXX083 IX2104.2 +018300 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2104.2 +018400 SPECIAL-NAMES. IX2104.2 +018500 ALPHABET IX2104.2 +018600 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2104.2 +018700 INPUT-OUTPUT SECTION. IX2104.2 +018800 FILE-CONTROL. IX2104.2 +018900P SELECT RAW-DATA ASSIGN TO IX2104.2 +019000P XXXXX062 IX2104.2 +019100P ORGANIZATION IS INDEXED IX2104.2 +019200P ACCESS MODE IS RANDOM IX2104.2 +019300P RECORD KEY IS RAW-DATA-KEY. IX2104.2 +019400 SELECT PRINT-FILE ASSIGN TO IX2104.2 +019500 XXXXX055. IX2104.2 +019600 SELECT IX-FS1 IX2104.2 +019700 ASSIGN TO IX2104.2 +019800 XXXXX024 IX2104.2 +019900J XXXXX044 IX2104.2 +020000 ACCESS MODE IS SEQUENTIAL IX2104.2 +020100 ORGANIZATION IS INDEXED IX2104.2 +020200 RECORD KEY IS IX-FS1-KEY IX2104.2 +020300 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2104.2 +020400 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2104.2 +020500 FILE STATUS IS FS1-STATUS. IX2104.2 +020600 DATA DIVISION. IX2104.2 +020700 FILE SECTION. IX2104.2 +020800P IX2104.2 +020900PFD RAW-DATA. IX2104.2 +021000P IX2104.2 +021100P01 RAW-DATA-SATZ. IX2104.2 +021200P 05 RAW-DATA-KEY PIC X(6). IX2104.2 +021300P 05 C-DATE PIC 9(6). IX2104.2 +021400P 05 C-TIME PIC 9(8). IX2104.2 +021500P 05 C-NO-OF-TESTS PIC 99. IX2104.2 +021600P 05 C-OK PIC 999. IX2104.2 +021700P 05 C-ALL PIC 999. IX2104.2 +021800P 05 C-FAIL PIC 999. IX2104.2 +021900P 05 C-DELETED PIC 999. IX2104.2 +022000P 05 C-INSPECT PIC 999. IX2104.2 +022100P 05 C-NOTE PIC X(13). IX2104.2 +022200P 05 C-INDENT PIC X. IX2104.2 +022300P 05 C-ABORT PIC X(8). IX2104.2 +022400 FD PRINT-FILE. IX2104.2 +022500 01 PRINT-REC PICTURE X(120). IX2104.2 +022600 01 DUMMY-RECORD PICTURE X(120). IX2104.2 +022700 FD IX-FS1 IX2104.2 +022800C LABEL RECORDS ARE STANDARD IX2104.2 +022900C DATA RECORD IS IX-FS1R1-F-G-240 IX2104.2 +023000 RECORD CONTAINS 240 CHARACTERS. IX2104.2 +023100 01 IX-FS1R1-F-G-240. IX2104.2 +023200 05 IX-FS1-REC-120 PICTURE X(120). IX2104.2 +023300 05 IX-FS1-REC-121-240. IX2104.2 +023400 10 FILLER PICTURE X(8). IX2104.2 +023500 10 IX-REC-KEY-AREA. IX2104.2 +023600 15 IX-FS1-KEY. IX2104.2 +023700 20 IX-FS1-KEY-1-10. IX2104.2 +023800 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2104.2 +023900 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2104.2 +024000 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2104.2 +024100 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX2104.2 +024200 20 R-RECKEY-1-7 PICTURE X(7). IX2104.2 +024300 20 R-RECKEY-8-13 PICTURE X(6). IX2104.2 +024400 15 FILLER PICTURE X(16). IX2104.2 +024500 10 FILLER PICTURE X(9). IX2104.2 +024600 10 IX-ALT-KEY1-AREA. IX2104.2 +024700 15 IX-FS1-ALTKEY1. IX2104.2 +024800 20 IX-FS1-ALTKEY1-1-10. IX2104.2 +024900 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2104.2 +025000 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2104.2 +025100 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2104.2 +025200 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2104.2 +025300 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX2104.2 +025400 20 R-ALTKEY1-1-6 PICTURE X(6). IX2104.2 +025500 20 R-ALTKEY1-7-10 PICTURE X(4). IX2104.2 +025600 20 R-ALTKEY1-11-20 PICTURE X(10). IX2104.2 +025700 15 FILLER PICTURE X(9). IX2104.2 +025800 10 FILLER PICTURE X(9). IX2104.2 +025900 10 IX-ALT-KEY2-AREA. IX2104.2 +026000 15 IX-FS1-ALTKEY2. IX2104.2 +026100 20 IX-FS1-ALTKEY2-1-10. IX2104.2 +026200 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2104.2 +026300 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2104.2 +026400 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2104.2 +026500 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2104.2 +026600 15 FILLER PICTURE X(9). IX2104.2 +026700 10 FILLER PICTURE X(7). IX2104.2 +026800 WORKING-STORAGE SECTION. IX2104.2 +026900 01 WRK-FS1-RECKEY. IX2104.2 +027000 05 FS1-RECKEY-1-13. IX2104.2 +027100 10 FS1-RECKEY-1-10 PICTURE X(10). IX2104.2 +027200 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2104.2 +027300 05 FILLER PICTURE X(16) VALUE SPACE. IX2104.2 +027400 01 WRK-FS1-ALTKEY1. IX2104.2 +027500 05 FS1-ALTKEY1-1-20. IX2104.2 +027600 10 FS1-ALTKEY1-1-10. IX2104.2 +027700 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2104.2 +027800 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2104.2 +027900 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2104.2 +028000 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2104.2 +028100 05 FILLER PICTURE X(9) VALUE SPACE. IX2104.2 +028200 01 WRK-FS1-ALTKEY2. IX2104.2 +028300 05 FS1-ALTKEY2-1-20. IX2104.2 +028400 10 FS1-ALTKEY2-1-10. IX2104.2 +028500 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2104.2 +028600 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2104.2 +028700 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2104.2 +028800 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2104.2 +028900 05 FILLER PICTURE X(9) VALUE SPACE. IX2104.2 +029000 01 RECNO PICTURE 9(5) VALUE ZERO. IX2104.2 +029100 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2104.2 +029200 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2104.2 +029300 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2104.2 +029400 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2104.2 +029500 01 RECORDS-WRITTEN PICTURE 9(3). IX2104.2 +029600 01 RECKEY-NUM PICTURE 9(3). IX2104.2 +029700 01 ALTKEY1-NUM PICTURE 9(3). IX2104.2 +029800 01 ALTKEY2-NUM PICTURE 9(3). IX2104.2 +029900 01 RECORD-KEY-CONTENT. IX2104.2 +030000 05 FILLER PIC X(53) VALUE IX2104.2 +030100 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2104.2 +030200 05 FILLER PIC X(53) VALUE IX2104.2 +030300 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2104.2 +030400 05 FILLER PIC X(53) VALUE IX2104.2 +030500 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2104.2 +030600 05 FILLER PIC X(53) VALUE IX2104.2 +030700 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2104.2 +030800 05 FILLER PIC X(53) VALUE IX2104.2 +030900 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2104.2 +031000 05 FILLER PIC X(53) VALUE IX2104.2 +031100 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2104.2 +031200 05 FILLER PIC X(53) VALUE IX2104.2 +031300 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2104.2 +031400 05 FILLER PIC X(53) VALUE IX2104.2 +031500 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2104.2 +031600 05 FILLER PIC X(53) VALUE IX2104.2 +031700 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2104.2 +031800 05 FILLER PIC X(53) VALUE IX2104.2 +031900 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2104.2 +032000 05 FILLER PIC X(53) VALUE IX2104.2 +032100 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2104.2 +032200 05 FILLER PIC X(53) VALUE IX2104.2 +032300 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2104.2 +032400 05 FILLER PIC X(53) VALUE IX2104.2 +032500 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2104.2 +032600 05 FILLER PIC X(53) VALUE IX2104.2 +032700 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2104.2 +032800 05 FILLER PIC X(53) VALUE IX2104.2 +032900 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2104.2 +033000 05 FILLER PIC X(53) VALUE IX2104.2 +033100 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2104.2 +033200 05 FILLER PIC X(53) VALUE IX2104.2 +033300 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2104.2 +033400 05 FILLER PIC X(53) VALUE IX2104.2 +033500 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2104.2 +033600 05 FILLER PIC X(53) VALUE IX2104.2 +033700 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2104.2 +033800 05 FILLER PIC X(53) VALUE IX2104.2 +033900 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2104.2 +034000 05 FILLER PIC X(53) VALUE IX2104.2 +034100 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2104.2 +034200 05 FILLER PIC X(53) VALUE IX2104.2 +034300 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2104.2 +034400 05 FILLER PIC X(53) VALUE IX2104.2 +034500 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2104.2 +034600 05 FILLER PIC X(53) VALUE IX2104.2 +034700 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2104.2 +034800 05 FILLER PIC X(53) VALUE IX2104.2 +034900 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2104.2 +035000 05 FILLER PIC X(53) VALUE IX2104.2 +035100 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2104.2 +035200 05 FILLER PIC X(53) VALUE IX2104.2 +035300 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2104.2 +035400 05 FILLER PIC X(53) VALUE IX2104.2 +035500 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2104.2 +035600 05 FILLER PIC X(53) VALUE IX2104.2 +035700 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2104.2 +035800 05 FILLER PIC X(53) VALUE IX2104.2 +035900 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2104.2 +036000 05 FILLER PIC X(53) VALUE IX2104.2 +036100 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2104.2 +036200 05 FILLER PIC X(53) VALUE IX2104.2 +036300 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2104.2 +036400 05 FILLER PIC X(53) VALUE IX2104.2 +036500 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2104.2 +036600 05 FILLER PIC X(53) VALUE IX2104.2 +036700 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2104.2 +036800 05 FILLER PIC X(53) VALUE IX2104.2 +036900 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2104.2 +037000 05 FILLER PIC X(53) VALUE IX2104.2 +037100 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2104.2 +037200 05 FILLER PIC X(53) VALUE IX2104.2 +037300 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2104.2 +037400 05 FILLER PIC X(53) VALUE IX2104.2 +037500 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2104.2 +037600 05 FILLER PIC X(53) VALUE IX2104.2 +037700 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2104.2 +037800 05 FILLER PIC X(53) VALUE IX2104.2 +037900 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2104.2 +038000 05 FILLER PIC X(53) VALUE IX2104.2 +038100 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2104.2 +038200 05 FILLER PIC X(53) VALUE IX2104.2 +038300 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2104.2 +038400 05 FILLER PIC X(53) VALUE IX2104.2 +038500 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2104.2 +038600 05 FILLER PIC X(53) VALUE IX2104.2 +038700 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2104.2 +038800 05 FILLER PIC X(53) VALUE IX2104.2 +038900 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2104.2 +039000 05 FILLER PIC X(53) VALUE IX2104.2 +039100 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2104.2 +039200 05 FILLER PIC X(53) VALUE IX2104.2 +039300 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2104.2 +039400 05 FILLER PIC X(53) VALUE IX2104.2 +039500 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2104.2 +039600 05 FILLER PIC X(53) VALUE IX2104.2 +039700 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2104.2 +039800 05 FILLER PIC X(53) VALUE IX2104.2 +039900 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2104.2 +040000 05 FILLER PIC X(53) VALUE IX2104.2 +040100 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2104.2 +040200 05 FILLER PIC X(53) VALUE IX2104.2 +040300 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2104.2 +040400 05 FILLER PIC X(53) VALUE IX2104.2 +040500 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2104.2 +040600 05 FILLER PIC X(53) VALUE IX2104.2 +040700 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2104.2 +040800 05 FILLER PIC X(53) VALUE IX2104.2 +040900 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2104.2 +041000 05 FILLER PIC X(53) VALUE IX2104.2 +041100 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2104.2 +041200 05 FILLER PIC X(53) VALUE IX2104.2 +041300 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2104.2 +041400 05 FILLER PIC X(53) VALUE IX2104.2 +041500 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2104.2 +041600 05 FILLER PIC X(53) VALUE IX2104.2 +041700 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2104.2 +041800 05 FILLER PIC X(53) VALUE IX2104.2 +041900 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2104.2 +042000 05 FILLER PIC X(53) VALUE IX2104.2 +042100 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2104.2 +042200 05 FILLER PIC X(53) VALUE IX2104.2 +042300 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2104.2 +042400 05 FILLER PIC X(53) VALUE IX2104.2 +042500 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2104.2 +042600 05 FILLER PIC X(53) VALUE IX2104.2 +042700 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2104.2 +042800 05 FILLER PIC X(53) VALUE IX2104.2 +042900 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2104.2 +043000 05 FILLER PIC X(53) VALUE IX2104.2 +043100 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2104.2 +043200 05 FILLER PIC X(53) VALUE IX2104.2 +043300 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2104.2 +043400 05 FILLER PIC X(53) VALUE IX2104.2 +043500 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2104.2 +043600 05 FILLER PIC X(53) VALUE IX2104.2 +043700 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2104.2 +043800 05 FILLER PIC X(53) VALUE IX2104.2 +043900 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2104.2 +044000 05 FILLER PIC X(53) VALUE IX2104.2 +044100 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2104.2 +044200 05 FILLER PIC X(53) VALUE IX2104.2 +044300 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2104.2 +044400 05 FILLER PIC X(53) VALUE IX2104.2 +044500 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2104.2 +044600 05 FILLER PIC X(53) VALUE IX2104.2 +044700 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2104.2 +044800 05 FILLER PIC X(53) VALUE IX2104.2 +044900 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2104.2 +045000 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2104.2 +045100 05 KEY-VALUES OCCURS 75 TIMES. IX2104.2 +045200 10 RECKEY-VALUE PICTURE X(13). IX2104.2 +045300 10 ALTKEY1-VALUE PICTURE X(20). IX2104.2 +045400 10 ALTKEY2-VALUE PICTURE X(20). IX2104.2 +045500 01 INIT-FLAG PICTURE 9. IX2104.2 +045600 01 HOLD-FILESTATUS-RECORD. IX2104.2 +045700 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2104.2 +045800 01 FILE-RECORD-INFORMATION-REC. IX2104.2 +045900 03 FILE-RECORD-INFO-SKELETON. IX2104.2 +046000 05 FILLER PICTURE X(48) VALUE IX2104.2 +046100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2104.2 +046200 05 FILLER PICTURE X(46) VALUE IX2104.2 +046300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2104.2 +046400 05 FILLER PICTURE X(26) VALUE IX2104.2 +046500 ",LFIL=000000,ORG= ,LBLR= ". IX2104.2 +046600 05 FILLER PICTURE X(37) VALUE IX2104.2 +046700 ",RECKEY= ". IX2104.2 +046800 05 FILLER PICTURE X(38) VALUE IX2104.2 +046900 ",ALTKEY1= ". IX2104.2 +047000 05 FILLER PICTURE X(38) VALUE IX2104.2 +047100 ",ALTKEY2= ". IX2104.2 +047200 05 FILLER PICTURE X(7) VALUE SPACE.IX2104.2 +047300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2104.2 +047400 05 FILE-RECORD-INFO-P1-120. IX2104.2 +047500 07 FILLER PIC X(5). IX2104.2 +047600 07 XFILE-NAME PIC X(6). IX2104.2 +047700 07 FILLER PIC X(8). IX2104.2 +047800 07 XRECORD-NAME PIC X(6). IX2104.2 +047900 07 FILLER PIC X(1). IX2104.2 +048000 07 REELUNIT-NUMBER PIC 9(1). IX2104.2 +048100 07 FILLER PIC X(7). IX2104.2 +048200 07 XRECORD-NUMBER PIC 9(6). IX2104.2 +048300 07 FILLER PIC X(6). IX2104.2 +048400 07 UPDATE-NUMBER PIC 9(2). IX2104.2 +048500 07 FILLER PIC X(5). IX2104.2 +048600 07 ODO-NUMBER PIC 9(4). IX2104.2 +048700 07 FILLER PIC X(5). IX2104.2 +048800 07 XPROGRAM-NAME PIC X(5). IX2104.2 +048900 07 FILLER PIC X(7). IX2104.2 +049000 07 XRECORD-LENGTH PIC 9(6). IX2104.2 +049100 07 FILLER PIC X(7). IX2104.2 +049200 07 CHARS-OR-RECORDS PIC X(2). IX2104.2 +049300 07 FILLER PIC X(1). IX2104.2 +049400 07 XBLOCK-SIZE PIC 9(4). IX2104.2 +049500 07 FILLER PIC X(6). IX2104.2 +049600 07 RECORDS-IN-FILE PIC 9(6). IX2104.2 +049700 07 FILLER PIC X(5). IX2104.2 +049800 07 XFILE-ORGANIZATION PIC X(2). IX2104.2 +049900 07 FILLER PIC X(6). IX2104.2 +050000 07 XLABEL-TYPE PIC X(1). IX2104.2 +050100 05 FILE-RECORD-INFO-P121-240. IX2104.2 +050200 07 FILLER PIC X(8). IX2104.2 +050300 07 XRECORD-KEY PIC X(29). IX2104.2 +050400 07 FILLER PIC X(9). IX2104.2 +050500 07 ALTERNATE-KEY1 PIC X(29). IX2104.2 +050600 07 FILLER PIC X(9). IX2104.2 +050700 07 ALTERNATE-KEY2 PIC X(29). IX2104.2 +050800 07 FILLER PIC X(7). IX2104.2 +050900 01 TEST-RESULTS. IX2104.2 +051000 02 FILLER PIC X VALUE SPACE. IX2104.2 +051100 02 FEATURE PIC X(20) VALUE SPACE. IX2104.2 +051200 02 FILLER PIC X VALUE SPACE. IX2104.2 +051300 02 P-OR-F PIC X(5) VALUE SPACE. IX2104.2 +051400 02 FILLER PIC X VALUE SPACE. IX2104.2 +051500 02 PAR-NAME. IX2104.2 +051600 03 FILLER PIC X(19) VALUE SPACE. IX2104.2 +051700 03 PARDOT-X PIC X VALUE SPACE. IX2104.2 +051800 03 DOTVALUE PIC 99 VALUE ZERO. IX2104.2 +051900 02 FILLER PIC X(8) VALUE SPACE. IX2104.2 +052000 02 RE-MARK PIC X(61). IX2104.2 +052100 01 TEST-COMPUTED. IX2104.2 +052200 02 FILLER PIC X(30) VALUE SPACE. IX2104.2 +052300 02 FILLER PIC X(17) VALUE IX2104.2 +052400 " COMPUTED=". IX2104.2 +052500 02 COMPUTED-X. IX2104.2 +052600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2104.2 +052700 03 COMPUTED-N REDEFINES COMPUTED-A IX2104.2 +052800 PIC -9(9).9(9). IX2104.2 +052900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2104.2 +053000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2104.2 +053100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2104.2 +053200 03 CM-18V0 REDEFINES COMPUTED-A. IX2104.2 +053300 04 COMPUTED-18V0 PIC -9(18). IX2104.2 +053400 04 FILLER PIC X. IX2104.2 +053500 03 FILLER PIC X(50) VALUE SPACE. IX2104.2 +053600 01 TEST-CORRECT. IX2104.2 +053700 02 FILLER PIC X(30) VALUE SPACE. IX2104.2 +053800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2104.2 +053900 02 CORRECT-X. IX2104.2 +054000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2104.2 +054100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2104.2 +054200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2104.2 +054300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2104.2 +054400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2104.2 +054500 03 CR-18V0 REDEFINES CORRECT-A. IX2104.2 +054600 04 CORRECT-18V0 PIC -9(18). IX2104.2 +054700 04 FILLER PIC X. IX2104.2 +054800 03 FILLER PIC X(2) VALUE SPACE. IX2104.2 +054900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2104.2 +055000 01 CCVS-C-1. IX2104.2 +055100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2104.2 +055200- "SS PARAGRAPH-NAME IX2104.2 +055300- " REMARKS". IX2104.2 +055400 02 FILLER PIC X(20) VALUE SPACE. IX2104.2 +055500 01 CCVS-C-2. IX2104.2 +055600 02 FILLER PIC X VALUE SPACE. IX2104.2 +055700 02 FILLER PIC X(6) VALUE "TESTED". IX2104.2 +055800 02 FILLER PIC X(15) VALUE SPACE. IX2104.2 +055900 02 FILLER PIC X(4) VALUE "FAIL". IX2104.2 +056000 02 FILLER PIC X(94) VALUE SPACE. IX2104.2 +056100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2104.2 +056200 01 REC-CT PIC 99 VALUE ZERO. IX2104.2 +056300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2104.2 +056800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2104.2 +056900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2104.2 +057000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2104.2 +057100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2104.2 +057200 01 CCVS-H-1. IX2104.2 +057300 02 FILLER PIC X(39) VALUE SPACES. IX2104.2 +057400 02 FILLER PIC X(42) VALUE IX2104.2 +057500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2104.2 +057600 02 FILLER PIC X(39) VALUE SPACES. IX2104.2 +057700 01 CCVS-H-2A. IX2104.2 +057800 02 FILLER PIC X(40) VALUE SPACE. IX2104.2 +057900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2104.2 +058000 02 FILLER PIC XXXX VALUE IX2104.2 +058100 "4.2 ". IX2104.2 +058200 02 FILLER PIC X(28) VALUE IX2104.2 +058300 " COPY - NOT FOR DISTRIBUTION". IX2104.2 +058400 02 FILLER PIC X(41) VALUE SPACE. IX2104.2 +058500 IX2104.2 +058600 01 CCVS-H-2B. IX2104.2 +058700 02 FILLER PIC X(15) VALUE IX2104.2 +058800 "TEST RESULT OF ". IX2104.2 +058900 02 TEST-ID PIC X(9). IX2104.2 +059000 02 FILLER PIC X(4) VALUE IX2104.2 +059100 " IN ". IX2104.2 +059200 02 FILLER PIC X(12) VALUE IX2104.2 +059300 " HIGH ". IX2104.2 +059400 02 FILLER PIC X(22) VALUE IX2104.2 +059500 " LEVEL VALIDATION FOR ". IX2104.2 +059600 02 FILLER PIC X(58) VALUE IX2104.2 +059700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +059800 01 CCVS-H-3. IX2104.2 +059900 02 FILLER PIC X(34) VALUE IX2104.2 +060000 " FOR OFFICIAL USE ONLY ". IX2104.2 +060100 02 FILLER PIC X(58) VALUE IX2104.2 +060200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2104.2 +060300 02 FILLER PIC X(28) VALUE IX2104.2 +060400 " COPYRIGHT 1985 ". IX2104.2 +060500 01 CCVS-E-1. IX2104.2 +060600 02 FILLER PIC X(52) VALUE SPACE. IX2104.2 +060700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2104.2 +060800 02 ID-AGAIN PIC X(9). IX2104.2 +060900 02 FILLER PIC X(45) VALUE SPACES. IX2104.2 +061000 01 CCVS-E-2. IX2104.2 +061100 02 FILLER PIC X(31) VALUE SPACE. IX2104.2 +061200 02 FILLER PIC X(21) VALUE SPACE. IX2104.2 +061300 02 CCVS-E-2-2. IX2104.2 +061400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2104.2 +061500 03 FILLER PIC X VALUE SPACE. IX2104.2 +061600 03 ENDER-DESC PIC X(44) VALUE IX2104.2 +061700 "ERRORS ENCOUNTERED". IX2104.2 +061800 01 CCVS-E-3. IX2104.2 +061900 02 FILLER PIC X(22) VALUE IX2104.2 +062000 " FOR OFFICIAL USE ONLY". IX2104.2 +062100 02 FILLER PIC X(12) VALUE SPACE. IX2104.2 +062200 02 FILLER PIC X(58) VALUE IX2104.2 +062300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +062400 02 FILLER PIC X(13) VALUE SPACE. IX2104.2 +062500 02 FILLER PIC X(15) VALUE IX2104.2 +062600 " COPYRIGHT 1985". IX2104.2 +062700 01 CCVS-E-4. IX2104.2 +062800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2104.2 +062900 02 FILLER PIC X(4) VALUE " OF ". IX2104.2 +063000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2104.2 +063100 02 FILLER PIC X(40) VALUE IX2104.2 +063200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2104.2 +063300 01 XXINFO. IX2104.2 +063400 02 FILLER PIC X(19) VALUE IX2104.2 +063500 "*** INFORMATION ***". IX2104.2 +063600 02 INFO-TEXT. IX2104.2 +063700 04 FILLER PIC X(8) VALUE SPACE. IX2104.2 +063800 04 XXCOMPUTED PIC X(20). IX2104.2 +063900 04 FILLER PIC X(5) VALUE SPACE. IX2104.2 +064000 04 XXCORRECT PIC X(20). IX2104.2 +064100 02 INF-ANSI-REFERENCE PIC X(48). IX2104.2 +064200 01 HYPHEN-LINE. IX2104.2 +064300 02 FILLER PIC IS X VALUE IS SPACE. IX2104.2 +064400 02 FILLER PIC IS X(65) VALUE IS "************************IX2104.2 +064500- "*****************************************". IX2104.2 +064600 02 FILLER PIC IS X(54) VALUE IS "************************IX2104.2 +064700- "******************************". IX2104.2 +064800 01 CCVS-PGM-ID PIC X(9) VALUE IX2104.2 +064900 "IX210A". IX2104.2 +065000 PROCEDURE DIVISION. IX2104.2 +065100 CCVS1 SECTION. IX2104.2 +065200 OPEN-FILES. IX2104.2 +065300P OPEN I-O RAW-DATA. IX2104.2 +065400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2104.2 +065500P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2104.2 +065600P MOVE "ABORTED " TO C-ABORT. IX2104.2 +065700P ADD 1 TO C-NO-OF-TESTS. IX2104.2 +065800P ACCEPT C-DATE FROM DATE. IX2104.2 +065900P ACCEPT C-TIME FROM TIME. IX2104.2 +066000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2104.2 +066100PEND-E-1. IX2104.2 +066200P CLOSE RAW-DATA. IX2104.2 +066300 OPEN OUTPUT PRINT-FILE. IX2104.2 +066400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2104.2 +066500 MOVE SPACE TO TEST-RESULTS. IX2104.2 +066600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2104.2 +066700 MOVE ZERO TO REC-SKL-SUB. IX2104.2 +066800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2104.2 +066900 CCVS-INIT-FILE. IX2104.2 +067000 ADD 1 TO REC-SKL-SUB. IX2104.2 +067100 MOVE FILE-RECORD-INFO-SKELETON IX2104.2 +067200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2104.2 +067300 CCVS-INIT-EXIT. IX2104.2 +067400 GO TO CCVS1-EXIT. IX2104.2 +067500 CLOSE-FILES. IX2104.2 +067600P OPEN I-O RAW-DATA. IX2104.2 +067700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2104.2 +067800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2104.2 +067900P MOVE "OK. " TO C-ABORT. IX2104.2 +068000P MOVE PASS-COUNTER TO C-OK. IX2104.2 +068100P MOVE ERROR-HOLD TO C-ALL. IX2104.2 +068200P MOVE ERROR-COUNTER TO C-FAIL. IX2104.2 +068300P MOVE DELETE-COUNTER TO C-DELETED. IX2104.2 +068400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2104.2 +068500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2104.2 +068600PEND-E-2. IX2104.2 +068700P CLOSE RAW-DATA. IX2104.2 +068800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2104.2 +068900 TERMINATE-CCVS. IX2104.2 +069000S EXIT PROGRAM. IX2104.2 +069100STERMINATE-CALL. IX2104.2 +069200 STOP RUN. IX2104.2 +069300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2104.2 +069400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2104.2 +069500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2104.2 +069600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2104.2 +069700 MOVE "****TEST DELETED****" TO RE-MARK. IX2104.2 +069800 PRINT-DETAIL. IX2104.2 +069900 IF REC-CT NOT EQUAL TO ZERO IX2104.2 +070000 MOVE "." TO PARDOT-X IX2104.2 +070100 MOVE REC-CT TO DOTVALUE. IX2104.2 +070200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2104.2 +070300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2104.2 +070400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2104.2 +070500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2104.2 +070600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2104.2 +070700 MOVE SPACE TO CORRECT-X. IX2104.2 +070800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2104.2 +070900 MOVE SPACE TO RE-MARK. IX2104.2 +071000 HEAD-ROUTINE. IX2104.2 +071100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2104.2 +071400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2104.2 +071500 COLUMN-NAMES-ROUTINE. IX2104.2 +071600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +071700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +071900 END-ROUTINE. IX2104.2 +072000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2104.2 +072100 END-RTN-EXIT. IX2104.2 +072200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +072300 END-ROUTINE-1. IX2104.2 +072400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2104.2 +072500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2104.2 +072600 ADD PASS-COUNTER TO ERROR-HOLD. IX2104.2 +072700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2104.2 +072800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2104.2 +072900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2104.2 +073000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2104.2 +073100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2104.2 +073200 END-ROUTINE-12. IX2104.2 +073300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2104.2 +073400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2104.2 +073500 MOVE "NO " TO ERROR-TOTAL IX2104.2 +073600 ELSE IX2104.2 +073700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2104.2 +073800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2104.2 +073900 PERFORM WRITE-LINE. IX2104.2 +074000 END-ROUTINE-13. IX2104.2 +074100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2104.2 +074200 MOVE "NO " TO ERROR-TOTAL ELSE IX2104.2 +074300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2104.2 +074400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2104.2 +074500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +074600 IF INSPECT-COUNTER EQUAL TO ZERO IX2104.2 +074700 MOVE "NO " TO ERROR-TOTAL IX2104.2 +074800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2104.2 +074900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2104.2 +075000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +075100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +075200 WRITE-LINE. IX2104.2 +075300 ADD 1 TO RECORD-COUNT. IX2104.2 +075400Y IF RECORD-COUNT GREATER 42 IX2104.2 +075500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2104.2 +075600Y MOVE SPACE TO DUMMY-RECORD IX2104.2 +075700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2104.2 +075800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2104.2 +075900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2104.2 +076000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2104.2 +076100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2104.2 +076200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2104.2 +076600Y MOVE ZERO TO RECORD-COUNT. IX2104.2 +076700 PERFORM WRT-LN. IX2104.2 +076800 WRT-LN. IX2104.2 +076900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2104.2 +077000 MOVE SPACE TO DUMMY-RECORD. IX2104.2 +077100 BLANK-LINE-PRINT. IX2104.2 +077200 PERFORM WRT-LN. IX2104.2 +077300 FAIL-ROUTINE. IX2104.2 +077400 IF COMPUTED-X NOT EQUAL TO SPACE IX2104.2 +077500 GO TO FAIL-ROUTINE-WRITE. IX2104.2 +077600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2104.2 +077700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2104.2 +077800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2104.2 +077900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +078000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2104.2 +078100 GO TO FAIL-ROUTINE-EX. IX2104.2 +078200 FAIL-ROUTINE-WRITE. IX2104.2 +078300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2104.2 +078400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2104.2 +078500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2104.2 +078600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2104.2 +078700 FAIL-ROUTINE-EX. EXIT. IX2104.2 +078800 BAIL-OUT. IX2104.2 +078900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2104.2 +079000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2104.2 +079100 BAIL-OUT-WRITE. IX2104.2 +079200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2104.2 +079300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2104.2 +079400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +079500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2104.2 +079600 BAIL-OUT-EX. EXIT. IX2104.2 +079700 CCVS1-EXIT. IX2104.2 +079800 EXIT. IX2104.2 +079900 SECT-0001-IX210A SECTION. IX2104.2 +080000 WRITE-INT-GF. IX2104.2 +080100 OPEN OUTPUT IX-FS1. IX2104.2 +080200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2104.2 +080300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2104.2 +080400 MOVE ZERO TO XRECORD-NUMBER (1). IX2104.2 +080500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2104.2 +080600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2104.2 +080700 MOVE 240 TO XRECORD-LENGTH (1). IX2104.2 +080800 MOVE 001 TO XBLOCK-SIZE (1). IX2104.2 +080900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2104.2 +081000 MOVE "S" TO XLABEL-TYPE (1). IX2104.2 +081100 MOVE 200 TO RECORDS-IN-FILE (1). IX2104.2 +081200 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2104.2 +081300 MOVE "WRITE-TEST-GF-1" TO PAR-NAME. IX2104.2 +081400 MOVE ZERO TO KEYSUB. IX2104.2 +081500 MOVE ZERO TO INVKEY-COUNTER. IX2104.2 +081600 WRITE-INIT-GF-01. IX2104.2 +081700 PERFORM WRITE-TEST-GF-01 50 TIMES. IX2104.2 +081800 PERFORM WRITE-TEST-GF-02 125 TIMES. IX2104.2 +081900 PERFORM WRITE-TEST-GF-01 25 TIMES. IX2104.2 +082000 GO TO WRITE-TEST-GF-1. IX2104.2 +082100 WRITE-TEST-GF-01. IX2104.2 +082200 ADD 001 TO XRECORD-NUMBER (1). IX2104.2 +082300 ADD 001 TO KEYSUB. IX2104.2 +082400 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2104.2 +082500 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2104.2 +082600 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2104.2 +082700 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2104.2 +082800 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2104.2 +082900 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2104.2 +083000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2104.2 +083100 WRITE IX-FS1R1-F-G-240 IX2104.2 +083200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2104.2 +083300 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +083400 WRITE-TEST-GF-02. IX2104.2 +083500 ADD 002 TO FS1-RECKEY-11-13. IX2104.2 +083600 ADD 002 TO FS1-ALTKEY1-11-13. IX2104.2 +083700 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2104.2 +083800 ADD 001 TO XRECORD-NUMBER (1). IX2104.2 +083900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2104.2 +084000 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2104.2 +084100 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2104.2 +084200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2104.2 +084300 WRITE IX-FS1R1-F-G-240 IX2104.2 +084400 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2104.2 +084500 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +084600 WRITE-TEST-GF-1. IX2104.2 +084700 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2104.2 +084800 GIVING RECORDS-WRITTEN. IX2104.2 +084900 MOVE 200 TO CORRECT-18V0. IX2104.2 +085000 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2104.2 +085100 IF RECORDS-WRITTEN EQUAL TO 200 IX2104.2 +085200 PERFORM PASS IX2104.2 +085300 ELSE IX2104.2 +085400 PERFORM FAIL. IX2104.2 +085500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2104.2 +085600 GO TO WRITE-TEST-GF-END. IX2104.2 +085700 WRITE-DELETE-GF-1. IX2104.2 +085800 PERFORM DE-LETE. IX2104.2 +085900 WRITE-TEST-GF-END. IX2104.2 +086000 PERFORM PRINT-DETAIL. IX2104.2 +086100 CLOSE IX-FS1. IX2104.2 +086200 READ-INIT-F1. IX2104.2 +086300 OPEN INPUT IX-FS1. IX2104.2 +086400 MOVE "READ FILE IX-FS1" TO FEATURE. IX2104.2 +086500 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2104.2 +086600 MOVE 02 TO RECKEY-NUM. IX2104.2 +086700 MOVE 002 TO ALTKEY1-NUM. IX2104.2 +086800 READ-TEST-F1-R1. IX2104.2 +086900 READ IX-FS1 AT END GO TO READ-TEST-F1. IX2104.2 +087000 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2104.2 +087100 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2104.2 +087200 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2104.2 +087300 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2104.2 +087400 NEXT SENTENCE IX2104.2 +087500 ELSE IX2104.2 +087600 PERFORM READ-FAIL-F1. IX2104.2 +087700 IF EXCUT-COUNTER-06V00 GREATER THAN 200 IX2104.2 +087800 GO TO READ-TEST-F1. IX2104.2 +087900 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +088000 ADD 002 TO RECKEY-NUM IX2104.2 +088100 ADD 002 TO ALTKEY1-NUM. IX2104.2 +088200 GO TO READ-TEST-F1-R1. IX2104.2 +088300 READ-TEST-F1. IX2104.2 +088400 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2104.2 +088500 PERFORM PASS ELSE IX2104.2 +088600 PERFORM FAIL. IX2104.2 +088700 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2104.2 +088800 MOVE 200 TO CORRECT-18V0. IX2104.2 +088900 MOVE "RECORDS IN FILE" TO RE-MARK. IX2104.2 +089000 GO TO READ-EXIT-F1. IX2104.2 +089100 READ-FAIL-F1. IX2104.2 +089200 PERFORM FAIL. IX2104.2 +089300 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2104.2 +089400 MOVE RECKEY-NUM TO CORRECT-18V0. IX2104.2 +089500 MOVE "NUM EMBEDDED IN RECKEY; IX-41 & IX-28" TO RE-MARK. IX2104.2 +089600 READ-EXIT-F1. IX2104.2 +089700 PERFORM PRINT-DETAIL. IX2104.2 +089800 CLOSE IX-FS1. IX2104.2 +089900 START-INIT. IX2104.2 +090000 OPEN INPUT IX-FS1. IX2104.2 +090100 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +090200 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2104.2 +090300 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2104.2 +090400* IX2104.2 +090500* THE "START -- GREATER THAN--" IS CHECKED FOR PROPER POSITIONING IX2104.2 +090600* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2104.2 +090700* START-TEST-GF USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2104.2 +090800* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2104.2 +090900* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2104.2 +091000* TAKEN FOR THE TESTS. IX2104.2 +091100* IX2104.2 +091200* CONDITIONS (CONTENTS OF KEY) / ACTION IX2104.2 +091300* IX2104.2 +091400* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2104.2 +091500* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2104.2 +091600* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2104.2 +091700* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2104.2 +091800* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +091900* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +092000* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2104.2 +092100* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2104.2 +092200* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2104.2 +092300* IX2104.2 +092400* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2104.2 +092500* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2104.2 +092600* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2104.2 +092700* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2104.2 +092800* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2104.2 +092900* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2104.2 +093000* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2104.2 +093100* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2104.2 +093200* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2104.2 +093300* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2104.2 +093400* IX2104.2 +093500 START-INIT-GF-01. IX2104.2 +093600 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2104.2 +093700 PERFORM START-INITIALIZE-RECORD. IX2104.2 +093800 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +093900 MOVE "**" TO FILESTATUS (1) IX2104.2 +094000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +094100 GO TO START-DELETE-GF-01. IX2104.2 +094200 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2104.2 +094300 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +094400 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +094500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +094600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +094700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +094800 START-TEST-GF-01. IX2104.2 +094900* IX2104.2 +095000* START-TEST-GF-01 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +095100* WHICH HAS A RECORD KEY VALUE OF IX2104.2 +095200* CCCCCCCCDD024 (RECORD NUMBER 12). IX2104.2 +095300* IX2104.2 +095400 START IX-FS1 IX2104.2 +095500 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +095600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2104.2 +095700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +095800 GO TO START-FAIL-GF-01. IX2104.2 +095900 MOVE FS1-STATUS TO FILESTATUS (1). IX2104.2 +096000 READ IX-FS1 AT END IX2104.2 +096100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +096200 GO TO START-FAIL-GF-01. IX2104.2 +096300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +096400 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2104.2 +096500 PERFORM PASS IX2104.2 +096600 MOVE SPACE TO RE-MARK IX2104.2 +096700 GO TO START-EXIT-GF-01. IX2104.2 +096800 MOVE 12 TO RECNO. IX2104.2 +096900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +097000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +097100 START-FAIL-GF-01. IX2104.2 +097200 PERFORM FAIL. IX2104.2 +097300 MOVE 12 TO CORRECT-18V0. IX2104.2 +097400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +097500 GO TO START-EXIT-GF-01. IX2104.2 +097600 START-DELETE-GF-01. IX2104.2 +097700 PERFORM DE-LETE. IX2104.2 +097800 START-EXIT-GF-01. IX2104.2 +097900 PERFORM PRINT-DETAIL. IX2104.2 +098000 START-INIT-GF-02. IX2104.2 +098100 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +098200 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2104.2 +098300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +098400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +098500 MOVE "**" TO FILESTATUS (2) IX2104.2 +098600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +098700 GO TO START-DELETE-GF-02. IX2104.2 +098800 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2104.2 +098900 MOVE "HHHHHHHHII064ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +099000 MOVE "TTTTTTTTSS336ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +099100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +099200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +099300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +099400 START-TEST-GF-02. IX2104.2 +099500* IX2104.2 +099600* START-TEST-GF-02 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +099700* WHICH HAS A RECORD KEY VALUE OF EEEEEEFFFF068IX2104.2 +099800* (RECORD NUMBER 34). THIS KEY VALUE IS IX2104.2 +099900* SEQUENTIALLY A LOGICAL RECORD HIGHER THAN IX2104.2 +100000* THE RECORD CONTAINING THE KEY VALUE LOADED IX2104.2 +100100* INTO THE RECORD KEY BEFORE THE START WAS IX2104.2 +100200* EXECUTED. THE KEY VALUE INITIALLY LOADED IX2104.2 +100300* WAS A VALUE BETWEEN TWO EXISTING KEY VALUES. IX2104.2 +100400* IX2104.2 +100500 START IX-FS1 IX2104.2 +100600 KEY GREATER THAN OR EQUAL TO IX-FS1-KEY IX2104.2 +100700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2104.2 +100800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +100900 GO TO START-FAIL-GF-02. IX2104.2 +101000 MOVE FS1-STATUS TO FILESTATUS (2). IX2104.2 +101100 READ IX-FS1 AT END IX2104.2 +101200 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +101300 GO TO START-FAIL-GF-02. IX2104.2 +101400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +101500 IF XRECORD-NUMBER (1) EQUAL TO 34 IX2104.2 +101600 PERFORM PASS IX2104.2 +101700 MOVE SPACE TO RE-MARK IX2104.2 +101800 GO TO START-EXIT-GF-02. IX2104.2 +101900 MOVE 34 TO RECNO. IX2104.2 +102000 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +102100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +102200 START-FAIL-GF-02. IX2104.2 +102300 PERFORM FAIL. IX2104.2 +102400 MOVE 34 TO CORRECT-18V0. IX2104.2 +102500 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +102600 GO TO START-EXIT-GF-02. IX2104.2 +102700 START-DELETE-GF-02. IX2104.2 +102800 PERFORM DE-LETE. IX2104.2 +102900 START-EXIT-GF-02. IX2104.2 +103000 PERFORM PRINT-DETAIL. IX2104.2 +103100 START-INIT-GF-03. IX2104.2 +103200 PERFORM START-INITIALIZE-RECORD. IX2104.2 +103300 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +103400 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2104.2 +103500 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +103600 MOVE "**" TO FILESTATUS (3) IX2104.2 +103700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +103800 GO TO START-DELETE-GF-03. IX2104.2 +103900 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2104.2 +104000 MOVE "EEEEEEEEEF003ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +104100 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +104200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +104300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +104400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +104500 START-TEST-GF-03. IX2104.2 +104600* IX2104.2 +104700* START-TEST-GF-03 - THE START STATEMENT SHOULD FIND A IX2104.2 +104800* RECORD IN THE FILE WHICH HAS A RECORD KEY IX2104.2 +104900* VALUE OF "BBBBBBBBBC002" (RECORD NUMBER 1). IX2104.2 +105000* THE KEY WAS LOADED BEFORE THE START IS IX2104.2 +105100* EXECUTED WITH THE VALUE THAT IS SEQUENTIALLY IX2104.2 +105200* LOWER THAN ANY CURRENTLY EXISTING KEY IN IX2104.2 +105300* THE FILE. IX2104.2 +105400* IX2104.2 +105500 START IX-FS1 IX2104.2 +105600 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +105700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2104.2 +105800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +105900 GO TO START-FAIL-GF-03 IX2104.2 +106000 END-START. IX2104.2 +106100 MOVE FS1-STATUS TO FILESTATUS (3). IX2104.2 +106200 READ IX-FS1 AT END IX2104.2 +106300 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +106400 GO TO START-FAIL-GF-03. IX2104.2 +106500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +106600 IF XRECORD-NUMBER (1) EQUAL TO 01 IX2104.2 +106700 PERFORM PASS IX2104.2 +106800 MOVE SPACE TO RE-MARK IX2104.2 +106900 GO TO START-EXIT-GF-03. IX2104.2 +107000 MOVE 01 TO RECNO. IX2104.2 +107100 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +107200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +107300 START-FAIL-GF-03. IX2104.2 +107400 PERFORM FAIL. IX2104.2 +107500 MOVE 01 TO CORRECT-18V0. IX2104.2 +107600 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +107700 GO TO START-EXIT-GF-03. IX2104.2 +107800 START-DELETE-GF-03. IX2104.2 +107900 PERFORM DE-LETE. IX2104.2 +108000 START-EXIT-GF-03. IX2104.2 +108100 PERFORM PRINT-DETAIL. IX2104.2 +108200 START-INIT-GF-04. IX2104.2 +108300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +108400 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +108500 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2104.2 +108600 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +108700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +108800 MOVE "**" TO FILESTATUS (4) IX2104.2 +108900 GO TO START-DELETE-GF-04. IX2104.2 +109000 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2104.2 +109100 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +109200 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +109300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +109400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +109500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +109600 START-TEST-GF-04. IX2104.2 +109700* IX2104.2 +109800* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2104.2 +109900* RECORD IN THE FILE WHICH HAS A RECORD IX2104.2 +110000* KEY VALUE GREATER THAN "UUUUUUUUUU401". THIS IX2104.2 +110100* VALUE IS SEQUENTIALLY GREATER THAN IX2104.2 +110200* ANY RECORD KEY CURRENTLY EXISTING IN IX2104.2 +110300* THE FILE. AN INVALID KEY CONDITION IX2104.2 +110400* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +110500* IX2104.2 +110600 START IX-FS1 IX2104.2 +110700 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +110800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2104.2 +110900 GO TO START-PASS-GF-04. IX2104.2 +111000 MOVE FS1-STATUS TO FILESTATUS (4). IX2104.2 +111100 READ IX-FS1 AT END IX2104.2 +111200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +111300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +111400 PERFORM FAIL. IX2104.2 +111500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +111600 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +111700 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +111800 GO TO START-EXIT-GF-04. IX2104.2 +111900 START-PASS-GF-04. IX2104.2 +112000 PERFORM PASS. IX2104.2 +112100 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +112200 GO TO START-EXIT-GF-04. IX2104.2 +112300 START-DELETE-GF-04. IX2104.2 +112400 PERFORM DE-LETE. IX2104.2 +112500 START-EXIT-GF-04. IX2104.2 +112600 PERFORM PRINT-DETAIL. IX2104.2 +112700 START-INIT-GF-05. IX2104.2 +112800 PERFORM START-INITIALIZE-RECORD. IX2104.2 +112900 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +113000 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2104.2 +113100 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +113200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +113300 MOVE "**" TO FILESTATUS (5) IX2104.2 +113400 GO TO START-DELETE-GF-05. IX2104.2 +113500 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2104.2 +113600 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +113700 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +113800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +113900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +114000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +114100 START-TEST-GF-05. IX2104.2 +114200* START-TEST-GF-05 - THE START STATEMENT USES AN OPERAND IX2104.2 +114300* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2104.2 +114400* OF A RECORD KEY BUT IS THE NAME OF A IX2104.2 +114500* DATA ITEM WHICH IS SUBORDINATE TO THE IX2104.2 +114600* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2104.2 +114700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2104.2 +114800* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2104.2 +114900* BALANCE OF THE KEY (POSITIONS 8 THRU 13) IS IX2104.2 +115000* NOT A VALID KEY VALUE FOR THE FILE. THE IX2104.2 +115100* RECORD WITH THE RECORD KEY "DDDDDDDDDD040" IX2104.2 +115200* (RECORD NUMBER 20) IS EXPECTED TO BE FOUND. IX2104.2 +115300* IX2104.2 +115400 START IX-FS1 IX2104.2 +115500 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +115600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2104.2 +115700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +115800 GO TO START-FAIL-GF-05. IX2104.2 +115900 MOVE FS1-STATUS TO FILESTATUS (5). IX2104.2 +116000 READ IX-FS1 AT END IX2104.2 +116100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +116200 GO TO START-FAIL-GF-05. IX2104.2 +116300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +116400 IF XRECORD-NUMBER (1) EQUAL TO 20 IX2104.2 +116500 PERFORM PASS IX2104.2 +116600 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2104.2 +116700 GO TO START-EXIT-GF-05. IX2104.2 +116800 MOVE 20 TO RECNO. IX2104.2 +116900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +117000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +117100 START-FAIL-GF-05. IX2104.2 +117200 PERFORM FAIL. IX2104.2 +117300 MOVE 20 TO CORRECT-18V0. IX2104.2 +117400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +117500 GO TO START-EXIT-GF-05. IX2104.2 +117600 START-DELETE-GF-05. IX2104.2 +117700 PERFORM DE-LETE. IX2104.2 +117800 START-EXIT-GF-05. IX2104.2 +117900 PERFORM PRINT-DETAIL. IX2104.2 +118000 START-INIT-GF-06. IX2104.2 +118100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +118200 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +118300 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2104.2 +118400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +118500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +118600 MOVE "**" TO FILESTATUS (6) IX2104.2 +118700 GO TO START-DELETE-GF-06. IX2104.2 +118800 MOVE "TTTTTTTTTT380" TO FS1-RECKEY-1-13. IX2104.2 +118900 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +119000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +119100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +119200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +119300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +119400 START-TEST-GF-06. IX2104.2 +119500* IX2104.2 +119600* START-TEST-GF-06 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +119700* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2104.2 +119800* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2104.2 +119900* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2104.2 +120000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2104.2 +120100* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2104.2 +120200* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2104.2 +120300* THIS TEST EXPECTS THE RECORD POINTER IX2104.2 +120400* TO BE POSITIONED TO RECORD KEY TTTTUUUUUU392 IX2104.2 +120500* (RECORD NUMBER 196) WHICH WAS THE RECORD IX2104.2 +120600* WRITTEN TO THE FILE AFTER THE LAST RECORD IX2104.2 +120700* THAT CONTAINS TTTTT IN THE FIRST 5 POSITIONS IX2104.2 +120800* OF THE KEY. THE RECORD KEY WAS LOADED WITH IX2104.2 +120900* THE VALUE "TTTTTTTTTT380" (KEY FOR RECORD IX2104.2 +121000* NUMBER 190) BEFORE THE START WAS EXECUTED. IX2104.2 +121100* IX2104.2 +121200 START IX-FS1 IX2104.2 +121300 KEY IS GREATER THAN IX-FS1-KEY-1-5 IX2104.2 +121400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2104.2 +121500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +121600 GO TO START-FAIL-GF-06. IX2104.2 +121700 MOVE FS1-STATUS TO FILESTATUS (6). IX2104.2 +121800 READ IX-FS1 AT END IX2104.2 +121900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +122000 GO TO START-FAIL-GF-06. IX2104.2 +122100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +122200 IF XRECORD-NUMBER (1) EQUAL TO 196 IX2104.2 +122300 PERFORM PASS IX2104.2 +122400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +122500 GO TO START-EXIT-GF-06. IX2104.2 +122600 MOVE 71 TO RECNO. IX2104.2 +122700 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +122800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +122900 START-FAIL-GF-06. IX2104.2 +123000 PERFORM FAIL. IX2104.2 +123100 MOVE 196 TO CORRECT-18V0. IX2104.2 +123200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +123300 GO TO START-EXIT-GF-06. IX2104.2 +123400 START-DELETE-GF-06. IX2104.2 +123500 PERFORM DE-LETE. IX2104.2 +123600 START-EXIT-GF-06. IX2104.2 +123700 PERFORM PRINT-DETAIL. IX2104.2 +123800 START-INIT-GF-07. IX2104.2 +123900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +124000 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +124100 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2104.2 +124200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +124300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +124400 MOVE "**" TO FILESTATUS (7) IX2104.2 +124500 GO TO START-DELETE-GF-07. IX2104.2 +124600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +124700 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +124800 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +124900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +125000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +125100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +125200 START-TEST-GF-07. IX2104.2 +125300* IX2104.2 +125400* START-TEST-GF-07 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +125500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +125600* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2104.2 +125700* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +125800* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2104.2 +125900* IS LOADED WITH "UUUUUUU" WHICH IS THE IX2104.2 +126000* KEY VALUE OF THE LAST RECORD IN THE FILE. IX2104.2 +126100* THERE SHOULD BE NO RECORD IN THE FILE GREATERIX2104.2 +126200* THAN THIS KEY VALUE THUS AND INVALID KEY IX2104.2 +126300* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +126400* IX2104.2 +126500 START IX-FS1 IX2104.2 +126600 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +126700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2104.2 +126800 GO TO START-PASS-GF-07. IX2104.2 +126900 MOVE FS1-STATUS TO FILESTATUS (7). IX2104.2 +127000 READ IX-FS1 AT END IX2104.2 +127100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +127200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +127300 PERFORM FAIL. IX2104.2 +127400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +127500 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +127600 MOVE "AT END PATH TAKEN & IX-36 ETC " TO RE-MARK. IX2104.2 +127700 GO TO START-EXIT-GF-07. IX2104.2 +127800 START-PASS-GF-07. IX2104.2 +127900 PERFORM PASS. IX2104.2 +128000 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +128100 GO TO START-EXIT-GF-07. IX2104.2 +128200 START-DELETE-GF-07. IX2104.2 +128300 PERFORM DE-LETE. IX2104.2 +128400 START-EXIT-GF-07. IX2104.2 +128500 PERFORM PRINT-DETAIL. IX2104.2 +128600 START-INIT-GF-08. IX2104.2 +128700 PERFORM START-INITIALIZE-RECORD. IX2104.2 +128800 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +128900 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2104.2 +129000 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +129100 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +129200 MOVE "**" TO FILESTATUS (8) IX2104.2 +129300 GO TO START-DELETE-GF-08. IX2104.2 +129400 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2104.2 +129500 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +129600 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +129700 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +129800 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +129900 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +130000 START-TEST-GF-08. IX2104.2 +130100* IX2104.2 +130200* START-TEST-GF-08 - THIS TEST USES AN OPERAND IN THE KEY IX2104.2 +130300* PHRASE OF THE START STATEMENT WHICH IS A DATAIX2104.2 +130400* ITEM SUBORDINATE TO THE RECORD KEY NAME. THEIX2104.2 +130500* CONTENTS OF THE DATA ITEM (POSITIONS 1 THRU IX2104.2 +130600* 7 OF THE RECORD KEY) IS LOADED WITH "ABBBBBBBIX2104.2 +130700* BC". THIS KEY VALUE IS LOWER THAN ANY RECORDIX2104.2 +130800* KEY VALUE IN POSITIONS 1 THRU 7 EXISTING IX2104.2 +130900* IN THE FILE. THE START STATEMENT WITH THE IX2104.2 +131000* KEY IS GREATER THAN PHRASE IS EXECUTED AND IX2104.2 +131100* SHOULD FIND THE RECORD WITH THE KEY VALUE IX2104.2 +131200* "BBBBBBBBBC002" (RECORD NUMBER 01). IX2104.2 +131300* IX2104.2 +131400 START IX-FS1 IX2104.2 +131500 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +131600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2104.2 +131700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +131800 GO TO START-FAIL-GF-08. IX2104.2 +131900 MOVE FS1-STATUS TO FILESTATUS (8). IX2104.2 +132000 READ IX-FS1 AT END IX2104.2 +132100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +132200 GO TO START-FAIL-GF-08. IX2104.2 +132300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +132400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +132500 PERFORM PASS IX2104.2 +132600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +132700 GO TO START-EXIT-GF-08. IX2104.2 +132800 MOVE 01 TO RECNO. IX2104.2 +132900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +133000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +133100 START-FAIL-GF-08. IX2104.2 +133200 PERFORM FAIL. IX2104.2 +133300 MOVE 001 TO CORRECT-18V0. IX2104.2 +133400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +133500 GO TO START-EXIT-GF-08. IX2104.2 +133600 START-DELETE-GF-08. IX2104.2 +133700 PERFORM DE-LETE. IX2104.2 +133800 START-EXIT-GF-08. IX2104.2 +133900 PERFORM PRINT-DETAIL. IX2104.2 +134000 START-INIT-GF-09. IX2104.2 +134100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +134200 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +134300 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2104.2 +134400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +134500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +134600 MOVE "**" TO FILESTATUS (9) IX2104.2 +134700 GO TO START-DELETE-GF-09. IX2104.2 +134800 MOVE "UUUUUUVVVV400" TO FS1-RECKEY-1-13. IX2104.2 +134900 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +135000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +135100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +135200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +135300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +135400 START-TEST-GF-09. IX2104.2 +135500* IX2104.2 +135600* START-TEST-GF-09 - THIS TEST USES AN OPERAND IN THE IX2104.2 +135700* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +135800* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2104.2 +135900* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +136000* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IS IX2104.2 +136100* LOADED WITH "UUUUUUV". THIS KEY VALUE IX2104.2 +136200* IS GREATER THAN ANY RECORD KEY VALUE IN IX2104.2 +136300* POSITION 1 THRU 7 EXISTING IN THE FILE IX2104.2 +136400* THEREFORE AN INVALID KEY CONDITION IS IX2104.2 +136500* EXPECTED WHEN THE START STATEMENT IS IX2104.2 +136600* EXECUTED. IX2104.2 +136700* IX2104.2 +136800 START IX-FS1 IX2104.2 +136900 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +137000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2104.2 +137100 GO TO START-PASS-GF-09. IX2104.2 +137200 MOVE FS1-STATUS TO FILESTATUS (9). IX2104.2 +137300 READ IX-FS1 AT END IX2104.2 +137400 MOVE "IX-36 ETS & AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +137500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +137600 PERFORM FAIL. IX2104.2 +137700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +137800 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +137900 GO TO START-EXIT-GF-09. IX2104.2 +138000 START-PASS-GF-09. IX2104.2 +138100 PERFORM PASS. IX2104.2 +138200 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +138300 GO TO START-EXIT-GF-09. IX2104.2 +138400 START-DELETE-GF-09. IX2104.2 +138500 PERFORM DE-LETE. IX2104.2 +138600 START-EXIT-GF-09. IX2104.2 +138700 PERFORM PRINT-DETAIL. IX2104.2 +138800 START-TERM-GF. IX2104.2 +138900 CLOSE IX-FS1. IX2104.2 +139000 START-INIT-GF-10. IX2104.2 +139100 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +139200 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2104.2 +139300* IX2104.2 +139400* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2104.2 +139500* CAPTURED FROM THE TESTS IN START-TEST-GF-01 TO -09 IX2104.2 +139600* IX2104.2 +139700 START-TEST-GF-10. IX2104.2 +139800 IF FILESTATUS (1) EQUAL TO "**" IX2104.2 +139900 PERFORM DE-LETE IX2104.2 +140000 GO TO START-WRITE-GF-10. IX2104.2 +140100* IX2104.2 +140200* START-TEST-GF-10 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +140300* RESULTING FROM START-TEST-GF-01. THE FILE IX2104.2 +140400* STATUS CONTENTS IS EXPECTED TO BE "00". IX2104.2 +140500* IX2104.2 +140600 IF FILESTATUS (1) EQUAL TO "00" IX2104.2 +140700 PERFORM PASS IX2104.2 +140800 ELSE IX2104.2 +140900 MOVE "FROM START-TEST-GF-01; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +141000 PERFORM FAIL IX2104.2 +141100 MOVE "00" TO CORRECT-A IX2104.2 +141200 MOVE FILESTATUS (1) TO COMPUTED-A. IX2104.2 +141300 START-WRITE-GF-10. IX2104.2 +141400 PERFORM PRINT-DETAIL. IX2104.2 +141500 START-TEST-GF-11. IX2104.2 +141600 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +141700 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2104.2 +141800 IF FILESTATUS (2) EQUAL TO "**" IX2104.2 +141900 PERFORM DE-LETE IX2104.2 +142000 GO TO START-WRITE-GF-11. IX2104.2 +142100* IX2104.2 +142200* START-TEST-GF-02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +142300* RESULTING FROM START-TEST-003.02. THE FILE IX2104.2 +142400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +142500* IX2104.2 +142600 IF FILESTATUS (2) EQUAL TO "00" IX2104.2 +142700 PERFORM PASS IX2104.2 +142800 ELSE PERFORM FAIL IX2104.2 +142900 MOVE "FROM START-TEST-GF-02; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +143000 MOVE "00" TO CORRECT-A IX2104.2 +143100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2104.2 +143200 START-WRITE-GF-11. IX2104.2 +143300 PERFORM PRINT-DETAIL. IX2104.2 +143400 START-TEST-GF-12. IX2104.2 +143500 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +143600 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2104.2 +143700 IF FILESTATUS (3) EQUAL TO "**" IX2104.2 +143800 PERFORM DE-LETE IX2104.2 +143900 GO TO START-WRITE-GF-12. IX2104.2 +144000* IX2104.2 +144100* START-TEST-GF-03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +144200* RESULTING FROM START-TEST-003.03. THE FILE IX2104.2 +144300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +144400* IX2104.2 +144500 IF FILESTATUS (3) EQUAL TO "00" IX2104.2 +144600 PERFORM PASS IX2104.2 +144700 ELSE PERFORM FAIL IX2104.2 +144800 MOVE "FROM START-TEST-GF-03; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +144900 MOVE "00" TO CORRECT-A IX2104.2 +145000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2104.2 +145100 START-WRITE-GF-12. IX2104.2 +145200 PERFORM PRINT-DETAIL. IX2104.2 +145300 START-TEST-GF-13. IX2104.2 +145400 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +145500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2104.2 +145600 IF FILESTATUS (4) EQUAL TO "**" IX2104.2 +145700 PERFORM DE-LETE IX2104.2 +145800 GO TO START-WRITE-GF-13. IX2104.2 +145900* IX2104.2 +146000* START-TEST-GF-04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +146100* RESULTING FROM START-TEST-003.04. THE FILE IX2104.2 +146200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +146300* IX2104.2 +146400 IF FILESTATUS (4) EQUAL TO "23" IX2104.2 +146500 PERFORM PASS IX2104.2 +146600 ELSE PERFORM FAIL IX2104.2 +146700 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +146800 MOVE "23" TO CORRECT-A IX2104.2 +146900 MOVE FILESTATUS (4) TO COMPUTED-A. IX2104.2 +147000 START-WRITE-GF-13. IX2104.2 +147100 PERFORM PRINT-DETAIL. IX2104.2 +147200 START-TEST-GF-14. IX2104.2 +147300 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +147400 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2104.2 +147500 IF FILESTATUS (5) EQUAL TO "**" IX2104.2 +147600 PERFORM DE-LETE IX2104.2 +147700 GO TO START-WRITE-GF-14. IX2104.2 +147800* IX2104.2 +147900* START-TEST-GF-05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +148000* RESULTING FROM START-TEST-GF-05. THE FILE IX2104.2 +148100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +148200* IX2104.2 +148300 IF FILESTATUS (5) EQUAL TO "00" IX2104.2 +148400 PERFORM PASS IX2104.2 +148500 ELSE PERFORM FAIL IX2104.2 +148600 MOVE "FROM START-TEST-GF-05; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +148700 MOVE "00" TO CORRECT-A IX2104.2 +148800 MOVE FILESTATUS (5) TO COMPUTED-A. IX2104.2 +148900 START-WRITE-GF-14. IX2104.2 +149000 PERFORM PRINT-DETAIL. IX2104.2 +149100 START-TEST-GF-15. IX2104.2 +149200 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +149300 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2104.2 +149400 IF FILESTATUS (6) EQUAL TO "**" IX2104.2 +149500 PERFORM DE-LETE IX2104.2 +149600 GO TO START-WRITE-GF-15. IX2104.2 +149700* IX2104.2 +149800* START-TEST-GF-15 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +149900* RESULTING FROM START-TEST-GF-06. THE FILE IX2104.2 +150000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +150100* IX2104.2 +150200 IF FILESTATUS (6) EQUAL TO "00" IX2104.2 +150300 PERFORM PASS IX2104.2 +150400 ELSE PERFORM FAIL IX2104.2 +150500 MOVE "FROM START-TEST-GF-01; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +150600 MOVE "00" TO CORRECT-A IX2104.2 +150700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2104.2 +150800 START-WRITE-GF-15. IX2104.2 +150900 PERFORM PRINT-DETAIL. IX2104.2 +151000 START-TEST-GF-16. IX2104.2 +151100 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +151200 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2104.2 +151300 IF FILESTATUS (7) EQUAL TO "**" IX2104.2 +151400 PERFORM DE-LETE IX2104.2 +151500 GO TO START-WRITE-GF-16. IX2104.2 +151600* IX2104.2 +151700* START-TEST-GF-16 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +151800* RESULTING FROM START-TEST-GF-07. THE FILE IX2104.2 +151900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2104.2 +152000* IX2104.2 +152100 IF FILESTATUS (7) EQUAL TO "23" IX2104.2 +152200 PERFORM PASS IX2104.2 +152300 ELSE PERFORM FAIL IX2104.2 +152400 MOVE "FROM START-TEST-GF-07; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +152500 MOVE "23" TO CORRECT-A IX2104.2 +152600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2104.2 +152700 START-WRITE-GF-16. IX2104.2 +152800 PERFORM PRINT-DETAIL. IX2104.2 +152900 START-TEST-GF-17. IX2104.2 +153000 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +153100 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2104.2 +153200 IF FILESTATUS (8) EQUAL TO "**" IX2104.2 +153300 PERFORM DE-LETE IX2104.2 +153400 GO TO START-WRITE-GF-17. IX2104.2 +153500* IX2104.2 +153600* START-TEST-GF-17 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +153700* RESULTING FROM START-TEST-GF-08. THE FILE IX2104.2 +153800* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +153900* IX2104.2 +154000 IF FILESTATUS (8) EQUAL TO "00" IX2104.2 +154100 PERFORM PASS IX2104.2 +154200 ELSE PERFORM FAIL IX2104.2 +154300 MOVE "FROM START-TEST-GF-08; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +154400 MOVE "00" TO CORRECT-A IX2104.2 +154500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2104.2 +154600 START-WRITE-GF-17. IX2104.2 +154700 PERFORM PRINT-DETAIL. IX2104.2 +154800 START-TEST-GF-18. IX2104.2 +154900 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +155000 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2104.2 +155100 IF FILESTATUS (9) EQUAL TO "**" IX2104.2 +155200 PERFORM DE-LETE IX2104.2 +155300 GO TO START-WRITE-GF-18. IX2104.2 +155400* IX2104.2 +155500* START-WRITE-GF-18 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +155600* RESULTING FROM START-TEST-GF-09. THE FILE IX2104.2 +155700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +155800* IX2104.2 +155900 IF FILESTATUS (9) EQUAL TO "23" IX2104.2 +156000 PERFORM PASS IX2104.2 +156100 ELSE PERFORM FAIL IX2104.2 +156200 MOVE "FROM START-TEST-GF-09; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +156300 MOVE "23" TO CORRECT-A IX2104.2 +156400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2104.2 +156500 START-WRITE-GF-18. IX2104.2 +156600 PERFORM PRINT-DETAIL. IX2104.2 +156700 IX2104.2 +156800 IX2104.2 +156900 START-INIT-GF-19-0. IX2104.2 +157000 OPEN INPUT IX-FS1. IX2104.2 +157100 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2104.2 +157200* IX2104.2 +157300* THE "START -- GREATER THAN--" IS CHECKED FOR PROPER POSITIONING IX2104.2 +157400* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2104.2 +157500* START-TEST-GF USES ONLY THE ALTERNATE RECORD KEY WITHOUT THE IX2104.2 +157600* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2104.2 +157700* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2104.2 +157800* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2104.2 +157900* IX2104.2 +158000* CONDITIONS (CONTENTS OF KEY) / ACTION IX2104.2 +158100* IX2104.2 +158200* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2104.2 +158300* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2104.2 +158400* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2104.2 +158500* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEIX2104.2 +158600* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +158700* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +158800* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2104.2 +158900* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2104.2 +159000* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2104.2 +159100* IX2104.2 +159200* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2104.2 +159300* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2104.2 +159400* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2104.2 +159500* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2104.2 +159600* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2104.2 +159700* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2104.2 +159800* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2104.2 +159900* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2104.2 +160000* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2104.2 +160100* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2104.2 +160200* IX2104.2 +160300 START-INIT-GF-19. IX2104.2 +160400 PERFORM START-INITIALIZE-RECORD. IX2104.2 +160500 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +160600 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2104.2 +160700 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +160800 MOVE "**" TO FILESTATUS (1) IX2104.2 +160900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +161000 GO TO START-DELETE-GF-19. IX2104.2 +161100 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +161200 MOVE "XXXXXXXXXY382ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +161300 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +161400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +161500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +161600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +161700 START-TEST-19. IX2104.2 +161800* IX2104.2 +161900* START-TEST-GF-19 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +162000* WHICH HAS AN ALTERNATE KEY VALUE OF IX2104.2 +162100* XXXXXXXXYY384ALTKEY1 (RECORD NUMBER 192). IX2104.2 +162200* IX2104.2 +162300 START IX-FS1 IX2104.2 +162400 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +162500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2104.2 +162600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +162700 GO TO START-FAIL-GF-19. IX2104.2 +162800 MOVE FS1-STATUS TO FILESTATUS (1). IX2104.2 +162900 READ IX-FS1 AT END IX2104.2 +163000 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +163100 GO TO START-FAIL-GF-19. IX2104.2 +163200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +163300 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2104.2 +163400 PERFORM PASS IX2104.2 +163500 MOVE SPACE TO RE-MARK IX2104.2 +163600 GO TO START-EXIT-GF-19. IX2104.2 +163700 MOVE 67 TO RECNO. IX2104.2 +163800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +163900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +164000 START-FAIL-GF-19. IX2104.2 +164100 PERFORM FAIL. IX2104.2 +164200 MOVE 192 TO CORRECT-18V0. IX2104.2 +164300 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +164400 GO TO START-EXIT-GF-19. IX2104.2 +164500 START-DELETE-GF-19. IX2104.2 +164600 PERFORM DE-LETE. IX2104.2 +164700 START-EXIT-GF-19. IX2104.2 +164800 PERFORM PRINT-DETAIL. IX2104.2 +164900 START-INIT-GF-20. IX2104.2 +165000 PERFORM START-INITIALIZE-RECORD. IX2104.2 +165100 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +165200 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2104.2 +165300 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +165400 MOVE "**" TO FILESTATUS (2) IX2104.2 +165500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +165600 GO TO START-DELETE-GF-20. IX2104.2 +165700 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +165800 MOVE "HHHHHHHIII67ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +165900 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +166000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +166100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +166200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +166300 START-TEST-GF-20. IX2104.2 +166400* IX2104.2 +166500* START-TEST-GF-20 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +166600* WHICH HAS AN ALTERNATE KEY VALUE OF IX2104.2 +166700* HHHHHHIIII068ALTKEY1 (RECORD NUMBER 34). IX2104.2 +166800* THE DATA ITEM WAS LOADED WITH A KEY VALUE IX2104.2 +166900* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2104.2 +167000* EXISTING ALTERNATE KEYS IN THE FILE. IX2104.2 +167100* IX2104.2 +167200 START IX-FS1 IX2104.2 +167300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +167400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2104.2 +167500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +167600 GO TO START-FAIL-GF-20. IX2104.2 +167700 MOVE FS1-STATUS TO FILESTATUS (2). IX2104.2 +167800 READ IX-FS1 AT END IX2104.2 +167900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +168000 GO TO START-FAIL-GF-20. IX2104.2 +168100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +168200 IF XRECORD-NUMBER (1) EQUAL TO 034 IX2104.2 +168300 PERFORM PASS IX2104.2 +168400 MOVE SPACE TO RE-MARK IX2104.2 +168500 GO TO START-EXIT-GF-20. IX2104.2 +168600 MOVE 34 TO RECNO. IX2104.2 +168700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +168800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +168900 START-FAIL-GF-20. IX2104.2 +169000 PERFORM FAIL. IX2104.2 +169100 MOVE 034 TO CORRECT-18V0. IX2104.2 +169200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +169300 GO TO START-EXIT-GF-20. IX2104.2 +169400 START-DELETE-GF-20. IX2104.2 +169500 PERFORM DE-LETE. IX2104.2 +169600 START-EXIT-GF-20. IX2104.2 +169700 PERFORM PRINT-DETAIL. IX2104.2 +169800 START-INIT-GF-21. IX2104.2 +169900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +170000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +170100 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2104.2 +170200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +170300 MOVE "**" TO FILESTATUS (3) IX2104.2 +170400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +170500 GO TO START-DELETE-GF-21. IX2104.2 +170600 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +170700 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +170800 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +170900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +171000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +171100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +171200 START-TEST-GF-21. IX2104.2 +171300* IX2104.2 +171400* START-TEST-GF-21 - THE START STATEMENT SHOULD FIND A IX2104.2 +171500* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2104.2 +171600* KEY VALUE OF EEEEEEEEEF002ALTKEY1 (RECORD IX2104.2 +171700* NUMBER 01). THE ALTERNATE KEY WAS LOADED IX2104.2 +171800* WITH A VALUE THAT IS SEQUENTIALLY LOWER IX2104.2 +171900* THAN ANY CURRENTLY EXISTNNG KEY IN THE FILE IX2104.2 +172000* BEFORE THE START WAS EXECUTED. IX2104.2 +172100* IX2104.2 +172200 START IX-FS1 IX2104.2 +172300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +172400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2104.2 +172500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +172600 GO TO START-FAIL-GF-21. IX2104.2 +172700 MOVE FS1-STATUS TO FILESTATUS (3). IX2104.2 +172800 READ IX-FS1 AT END IX2104.2 +172900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +173000 GO TO START-FAIL-GF-21. IX2104.2 +173100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +173200 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +173300 PERFORM PASS IX2104.2 +173400 MOVE SPACE TO RE-MARK IX2104.2 +173500 GO TO START-EXIT-GF-21. IX2104.2 +173600 MOVE 01 TO RECNO. IX2104.2 +173700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +173800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +173900 START-FAIL-GF-21. IX2104.2 +174000 PERFORM FAIL. IX2104.2 +174100 MOVE 001 TO CORRECT-18V0. IX2104.2 +174200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +174300 GO TO START-EXIT-GF-21. IX2104.2 +174400 START-DELETE-GF-21. IX2104.2 +174500 PERFORM DE-LETE. IX2104.2 +174600 START-EXIT-GF-21. IX2104.2 +174700 PERFORM PRINT-DETAIL. IX2104.2 +174800 START-INIT-GF-22. IX2104.2 +174900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +175000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +175100 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2104.2 +175200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +175300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +175400 MOVE "**" TO FILESTATUS (4) IX2104.2 +175500 GO TO START-DELETE-GF-22. IX2104.2 +175600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +175700 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +175800 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +175900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +176000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +176100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +176200 START-TEST-GF-22. IX2104.2 +176300* IX2104.2 +176400* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2104.2 +176500* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2104.2 +176600* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2104.2 +176700* VALUE IS SEQUENTIALLY GREATER THAN IX2104.2 +176800* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2104.2 +176900* THE FILE. AN INVALID KEY CONDITION IX2104.2 +177000* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +177100* IX2104.2 +177200 START IX-FS1 IX2104.2 +177300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +177400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2104.2 +177500 GO TO START-PASS-GF-22. IX2104.2 +177600 MOVE FS1-STATUS TO FILESTATUS (4). IX2104.2 +177700 READ IX-FS1 AT END IX2104.2 +177800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +177900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +178000 PERFORM FAIL. IX2104.2 +178100 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2104.2 +178200 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +178300 GO TO START-EXIT-GF-22. IX2104.2 +178400 START-PASS-GF-22. IX2104.2 +178500 PERFORM PASS. IX2104.2 +178600 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +178700 GO TO START-EXIT-GF-22. IX2104.2 +178800 START-DELETE-GF-22. IX2104.2 +178900 PERFORM DE-LETE. IX2104.2 +179000 START-EXIT-GF-22. IX2104.2 +179100 PERFORM PRINT-DETAIL. IX2104.2 +179200 START-INIT-GF-23. IX2104.2 +179300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +179400 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +179500 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2104.2 +179600 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +179700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +179800 MOVE "**" TO FILESTATUS (5) IX2104.2 +179900 GO TO START-DELETE-GF-23. IX2104.2 +180000 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2104.2 +180100 MOVE "GGGGHHHHHH100ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +180200 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +180300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +180400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +180500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +180600 START-TEST-GF-23. IX2104.2 +180700* IX2104.2 +180800* START-TEST-GF-23 - THE START STATEMENT USES AN OPERAND IX2104.2 +180900* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2104.2 +181000* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2104.2 +181100* DATA ITEM WHICH IS SUBORDINATE TO THE IX2104.2 +181200* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2104.2 +181300* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2104.2 +181400* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2104.2 +181500* BALANCE OF THE KEY (POSITIONS 7 THRU 20 OF IX2104.2 +181600* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2104.2 +181700* FOR THE FILE. THE IX2104.2 +181800* RECORD WITH THE ALTERNATE KEY "GGGHHHHHHH054 IX2104.2 +181900* ALTKEY1 (RECORD NUMBER 27) IS EXPECTED TO IX2104.2 +182000* BE FOUND. IX2104.2 +182100* IX2104.2 +182200 START IX-FS1 IX2104.2 +182300 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +182400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2104.2 +182500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +182600 GO TO START-FAIL-GF-23. IX2104.2 +182700 MOVE FS1-STATUS TO FILESTATUS (5). IX2104.2 +182800 READ IX-FS1 AT END IX2104.2 +182900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +183000 GO TO START-FAIL-GF-23. IX2104.2 +183100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +183200 IF XRECORD-NUMBER (1) EQUAL TO 27 IX2104.2 +183300 PERFORM PASS IX2104.2 +183400 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2104.2 +183500 GO TO START-EXIT-GF-23. IX2104.2 +183600 MOVE 27 TO RECNO. IX2104.2 +183700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +183800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +183900 START-FAIL-GF-23. IX2104.2 +184000 PERFORM FAIL. IX2104.2 +184100 MOVE 27 TO CORRECT-18V0. IX2104.2 +184200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +184300 GO TO START-EXIT-GF-23. IX2104.2 +184400 START-DELETE-GF-23. IX2104.2 +184500 PERFORM DE-LETE. IX2104.2 +184600 START-EXIT-GF-23. IX2104.2 +184700 PERFORM PRINT-DETAIL. IX2104.2 +184800 START-INIT-GF-24. IX2104.2 +184900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +185000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +185100 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2104.2 +185200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +185300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +185400 MOVE "**" TO FILESTATUS (6) IX2104.2 +185500 GO TO START-DELETE-GF-24. IX2104.2 +185600 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2104.2 +185700 MOVE "XXXXXXXXXX380ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +185800 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +185900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +186000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +186100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +186200 START-TEST-GF-24. IX2104.2 +186300* IX2104.2 +186400* START-TEST-GF-24 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +186500* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2104.2 +186600* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2104.2 +186700* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2104.2 +186800* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2104.2 +186900* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2104.2 +187000* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2104.2 +187100* THIS TEST EXPECTS THE RECORD POINTER IX2104.2 +187200* TO BE POSITIONED TO RECORD KEY XXXXYYYYYY392 IX2104.2 +187300* ALTKEY1 (RECORD NUMBER 196) WHICH WAS THE IX2104.2 +187400* RECORD WRITTEN AFTER THE LAST RECORD THAT IX2104.2 +187500* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF IX2104.2 +187600* THE KEY. THE ALTERNATE KEY WAS LOADED WITH THEIX2104.2 +187700* VALUE XXXXXXXXXX380ALTKEY1 (KEY FOR RECORD IX2104.2 +187800* NUMBER 190) BEFORE THE START WAS EXECUTED. IX2104.2 +187900* IX2104.2 +188000 START IX-FS1 IX2104.2 +188100 KEY IS GREATER THAN IX-FS1-ALTKEY1-1-5 IX2104.2 +188200 INVALID KEY IX2104.2 +188300 MOVE FS1-STATUS TO FILESTATUS (6) IX2104.2 +188400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +188500 GO TO START-FAIL-GF-24. IX2104.2 +188600 MOVE FS1-STATUS TO FILESTATUS (6). IX2104.2 +188700 READ IX-FS1 AT END IX2104.2 +188800 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +188900 GO TO START-FAIL-GF-24. IX2104.2 +189000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +189100 IF XRECORD-NUMBER (1) EQUAL TO 196 IX2104.2 +189200 PERFORM PASS IX2104.2 +189300 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +189400 GO TO START-EXIT-GF-24. IX2104.2 +189500 MOVE 71 TO RECNO. IX2104.2 +189600 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +189700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +189800 START-FAIL-GF-24. IX2104.2 +189900 PERFORM FAIL. IX2104.2 +190000 MOVE 196 TO CORRECT-18V0. IX2104.2 +190100 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +190200 GO TO START-EXIT-GF-24. IX2104.2 +190300 START-DELETE-GF-24. IX2104.2 +190400 PERFORM DE-LETE. IX2104.2 +190500 START-EXIT-GF-24. IX2104.2 +190600 PERFORM PRINT-DETAIL. IX2104.2 +190700 START-INIT-GF-25. IX2104.2 +190800 PERFORM START-INITIALIZE-RECORD. IX2104.2 +190900 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +191000 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2104.2 +191100 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +191200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +191300 MOVE "**" TO FILESTATUS (7) IX2104.2 +191400 GO TO START-DELETE-GF-25. IX2104.2 +191500 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2104.2 +191600 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +191700 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +191800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +191900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +192000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +192100 START-TEST-GF-25. IX2104.2 +192200* IX2104.2 +192300* START-TEST-GF-25 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +192400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +192500* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +192600* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +192700* POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2104.2 +192800* IS LOADED WITH YYYYYY WHICH IS THE KEY VALUE IX2104.2 +192900* OF THE LAST RECORD IN THE FILE. THERE SHOULDIX2104.2 +193000* BE NO RECORD IN THE FILE WITH A KEY VALUE IX2104.2 +193100* GREATER THUS AN INVALID KEY IS EXPECTED IX2104.2 +193200* WHEN THE START IS EXECUTED. IX2104.2 +193300* IX2104.2 +193400 START IX-FS1 IX2104.2 +193500 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +193600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2104.2 +193700 GO TO START-PASS-GF-25. IX2104.2 +193800 MOVE FS1-STATUS TO FILESTATUS (7). IX2104.2 +193900 READ IX-FS1 AT END IX2104.2 +194000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +194100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +194200 PERFORM FAIL. IX2104.2 +194300 MOVE "AT END PATH AND IX-36 ETC " TO RE-MARK. IX2104.2 +194400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +194500 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +194600 GO TO START-EXIT-GF-25. IX2104.2 +194700 START-PASS-GF-25. IX2104.2 +194800 PERFORM PASS. IX2104.2 +194900 MOVE "INVALID KEY" TO RE-MARK. IX2104.2 +195000 GO TO START-EXIT-GF-25. IX2104.2 +195100 START-DELETE-GF-25. IX2104.2 +195200 PERFORM DE-LETE. IX2104.2 +195300 START-EXIT-GF-25. IX2104.2 +195400 PERFORM PRINT-DETAIL. IX2104.2 +195500 START-INIT-GF-26. IX2104.2 +195600 PERFORM START-INITIALIZE-RECORD. IX2104.2 +195700 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +195800 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2104.2 +195900 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +196000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +196100 MOVE "**" TO FILESTATUS (8) IX2104.2 +196200 GO TO START-DELETE-GF-26. IX2104.2 +196300 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2104.2 +196400 MOVE "EEEEDEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +196500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +196600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +196700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +196800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +196900 START-TEST-GF-26. IX2104.2 +197000* IX2104.2 +197100* START-TEST-GF-26 - THIS TEST USES AN OPERAND IN THE IX2104.2 +197200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +197300* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +197400* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +197500* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IS IX2104.2 +197600* LOADED WITH "EEEEDE". THIS KEY VALUE IX2104.2 +197700* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2104.2 +197800* POSITION 1 THRU 6 EXISTING IN THE FILE IX2104.2 +197900* THE START STATEMENT WITH THE KEY IS GREATER IX2104.2 +198000* THAN PHRASE IS EXECUTED AND SHOULD FIND A IX2104.2 +198100* RECORD WITH THE KEY VALUE "EEEEEEEEEF002 IX2104.2 +198200* ALTKEY1 (RECORD NUMBER 01). IX2104.2 +198300* IX2104.2 +198400 START IX-FS1 IX2104.2 +198500 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +198600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2104.2 +198700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +198800 GO TO START-FAIL-GF-26. IX2104.2 +198900 MOVE FS1-STATUS TO FILESTATUS (8). IX2104.2 +199000 READ IX-FS1 AT END IX2104.2 +199100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +199200 GO TO START-FAIL-GF-26. IX2104.2 +199300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +199400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +199500 PERFORM PASS IX2104.2 +199600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +199700 GO TO START-EXIT-GF-26. IX2104.2 +199800 MOVE 01 TO RECNO. IX2104.2 +199900 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +200000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +200100 START-FAIL-GF-26. IX2104.2 +200200 PERFORM FAIL. IX2104.2 +200300 MOVE 001 TO CORRECT-18V0. IX2104.2 +200400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +200500 GO TO START-EXIT-GF-26. IX2104.2 +200600 START-DELETE-GF-26. IX2104.2 +200700 PERFORM DE-LETE. IX2104.2 +200800 START-EXIT-GF-26. IX2104.2 +200900 PERFORM PRINT-DETAIL. IX2104.2 +201000 START-INIT-GF-27. IX2104.2 +201100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +201200 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +201300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2104.2 +201400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +201500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +201600 MOVE "**" TO FILESTATUS (9) IX2104.2 +201700 GO TO START-DELETE-GF-27. IX2104.2 +201800 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +201900 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +202000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +202100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +202200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +202300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +202400 START-TEST-GF-27. IX2104.2 +202500* IX2104.2 +202600* START-TEST-GF-27 - THIS TEST USES AN OPERAND IN THE IX2104.2 +202700* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +202800* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +202900* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +203000* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2104.2 +203100* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2104.2 +203200* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2104.2 +203300* POSITION 1 THRU 10 EXISTING IN THE FILE IX2104.2 +203400* THEREFORE AN INVALID KEY CONDITION IS IX2104.2 +203500* EXPECTED WHEN THE START STATEMENT IS IX2104.2 +203600* EXECUTED. IX2104.2 +203700* IX2104.2 +203800 START IX-FS1 IX2104.2 +203900 KEY IS GREATER THAN IX-FS1-ALTKEY1-1-10 IX2104.2 +204000 INVALID KEY IX2104.2 +204100 MOVE FS1-STATUS TO FILESTATUS (9) IX2104.2 +204200 GO TO START-PASS-GF-27. IX2104.2 +204300 MOVE FS1-STATUS TO FILESTATUS (9). IX2104.2 +204400 READ IX-FS1 AT END IX2104.2 +204500 MOVE "IX-36 ETC.; AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +204600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +204700 PERFORM FAIL. IX2104.2 +204800 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +204900 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +205000 GO TO START-EXIT-GF-27. IX2104.2 +205100 START-PASS-GF-27. IX2104.2 +205200 PERFORM PASS. IX2104.2 +205300 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +205400 GO TO START-EXIT-GF-27. IX2104.2 +205500 START-DELETE-GF-27. IX2104.2 +205600 PERFORM DE-LETE. IX2104.2 +205700 START-EXIT-GF-27. IX2104.2 +205800 PERFORM PRINT-DETAIL. IX2104.2 +205900 IX2104.2 +206000 CLOSE IX-FS1. IX2104.2 +206100 IX2104.2 +206200* IX2104.2 +206300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2104.2 +206400* CAPTURED FROM THE TESTS IN START-TEST-005. IX2104.2 +206500* IX2104.2 +206600 START-TEST-GF-28. IX2104.2 +206700 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +206800 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2104.2 +206900 IF FILESTATUS (1) EQUAL TO "**" IX2104.2 +207000 PERFORM DE-LETE IX2104.2 +207100 GO TO START-WRITE-GF-28. IX2104.2 +207200* IX2104.2 +207300* START-TEST-GF-28 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +207400* RESULTING FROM START-TEST-GF-19. THE FILE IX2104.2 +207500* STATUS CONTENTS IS EXPECTED TO BE "00". IX2104.2 +207600* IX2104.2 +207700 IF FILESTATUS (1) EQUAL TO "00" IX2104.2 +207800 PERFORM PASS IX2104.2 +207900 ELSE IX2104.2 +208000 MOVE "FROM START-TEST-GF-19; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +208100 PERFORM FAIL IX2104.2 +208200 MOVE "00" TO CORRECT-A IX2104.2 +208300 MOVE FILESTATUS (1) TO COMPUTED-A. IX2104.2 +208400 START-WRITE-GF-28. IX2104.2 +208500 PERFORM PRINT-DETAIL. IX2104.2 +208600 START-TEST-GF-29. IX2104.2 +208700 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +208800 MOVE "START-TEST-GF-29" TO PAR-NAME. IX2104.2 +208900 IF FILESTATUS (2) EQUAL TO "**" IX2104.2 +209000 PERFORM DE-LETE IX2104.2 +209100 GO TO START-WRITE-GF-29. IX2104.2 +209200* IX2104.2 +209300* START-TEST-GF-29 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +209400* RESULTING FROM START-TEST-GF-20. THE FILE IX2104.2 +209500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +209600* IX2104.2 +209700 IF FILESTATUS (2) EQUAL TO "00" IX2104.2 +209800 PERFORM PASS IX2104.2 +209900 ELSE PERFORM FAIL IX2104.2 +210000 MOVE "FROM START-TEST-GF-20; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +210100 MOVE "00" TO CORRECT-A IX2104.2 +210200 MOVE FILESTATUS (2) TO COMPUTED-A. IX2104.2 +210300 START-WRITE-GF-29. IX2104.2 +210400 PERFORM PRINT-DETAIL. IX2104.2 +210500 START-TEST-GF-30. IX2104.2 +210600 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +210700 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2104.2 +210800 IF FILESTATUS (3) EQUAL TO "**" IX2104.2 +210900 PERFORM DE-LETE IX2104.2 +211000 GO TO START-WRITE-GF-30. IX2104.2 +211100* IX2104.2 +211200* START-TEST-GF-30 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +211300* RESULTING FROM START-TEST-GF-21. THE FILE IX2104.2 +211400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +211500* IX2104.2 +211600 IF FILESTATUS (3) EQUAL TO "00" IX2104.2 +211700 PERFORM PASS IX2104.2 +211800 ELSE PERFORM FAIL IX2104.2 +211900 MOVE "FROM START-TEST-GF-21; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +212000 MOVE "00" TO CORRECT-A IX2104.2 +212100 MOVE FILESTATUS (3) TO COMPUTED-A. IX2104.2 +212200 START-WRITE-GF-30. IX2104.2 +212300 PERFORM PRINT-DETAIL. IX2104.2 +212400 START-TEST-GF-31. IX2104.2 +212500 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +212600 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2104.2 +212700 IF FILESTATUS (4) EQUAL TO "**" IX2104.2 +212800 PERFORM DE-LETE IX2104.2 +212900 GO TO START-WRITE-GF-31. IX2104.2 +213000* IX2104.2 +213100* START-TEST-GF-31 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +213200* RESULTING FROM START-TEST-GF-22. THE FILE IX2104.2 +213300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +213400* IX2104.2 +213500 IF FILESTATUS (4) EQUAL TO "23" IX2104.2 +213600 PERFORM PASS IX2104.2 +213700 ELSE PERFORM FAIL IX2104.2 +213800 MOVE "FROM START-TEST-GF-22; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +213900 MOVE "23" TO CORRECT-A IX2104.2 +214000 MOVE FILESTATUS (4) TO COMPUTED-A. IX2104.2 +214100 START-WRITE-GF-31. IX2104.2 +214200 PERFORM PRINT-DETAIL. IX2104.2 +214300 START-TEST-GF-32. IX2104.2 +214400 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +214500 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2104.2 +214600 IF FILESTATUS (5) EQUAL TO "**" IX2104.2 +214700 PERFORM DE-LETE IX2104.2 +214800 GO TO START-WRITE-GF-32. IX2104.2 +214900* IX2104.2 +215000* START-TEST-GF.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +215100* RESULTING FROM START-TEST-GF-23. THE FILE IX2104.2 +215200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +215300* IX2104.2 +215400 IF FILESTATUS (5) EQUAL TO "00" IX2104.2 +215500 PERFORM PASS IX2104.2 +215600 ELSE PERFORM FAIL IX2104.2 +215700 MOVE "FROM START-TEST-GF-23; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +215800 MOVE "00" TO CORRECT-A IX2104.2 +215900 MOVE FILESTATUS (5) TO COMPUTED-A. IX2104.2 +216000 START-WRITE-GF-32. IX2104.2 +216100 PERFORM PRINT-DETAIL. IX2104.2 +216200 START-TEST-GF-33. IX2104.2 +216300 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +216400 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2104.2 +216500 IF FILESTATUS (6) EQUAL TO "**" IX2104.2 +216600 PERFORM DE-LETE IX2104.2 +216700 GO TO START-WRITE-GF-33. IX2104.2 +216800* IX2104.2 +216900* START-TEST-GF-33 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +217000* RESULTING FROM START-TEST-GF-24. THE FILE IX2104.2 +217100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +217200* IX2104.2 +217300 IF FILESTATUS (6) EQUAL TO "00" IX2104.2 +217400 PERFORM PASS IX2104.2 +217500 ELSE PERFORM FAIL IX2104.2 +217600 MOVE "FROM START-TEST-GF-24; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +217700 MOVE "00" TO CORRECT-A IX2104.2 +217800 MOVE FILESTATUS (6) TO COMPUTED-A. IX2104.2 +217900 START-WRITE-GF-33. IX2104.2 +218000 PERFORM PRINT-DETAIL. IX2104.2 +218100 START-TEST-GF-34. IX2104.2 +218200 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +218300 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2104.2 +218400 IF FILESTATUS (7) EQUAL TO "**" IX2104.2 +218500 PERFORM DE-LETE IX2104.2 +218600 GO TO START-WRITE-GF-34. IX2104.2 +218700* IX2104.2 +218800* START-TEST-GF-34 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +218900* RESULTING FROM START-TEST-GF-25. THE FILE IX2104.2 +219000* STATUS CONTENTS IS EXPECTED TO BE "23" IX2104.2 +219100* IX2104.2 +219200 IF FILESTATUS (7) EQUAL TO "23" IX2104.2 +219300 PERFORM PASS IX2104.2 +219400 ELSE PERFORM FAIL IX2104.2 +219500 MOVE "FROM START-TEST-GF-25; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +219600 MOVE "23" TO CORRECT-A IX2104.2 +219700 MOVE FILESTATUS (7) TO COMPUTED-A. IX2104.2 +219800 START-WRITE-GF-34. IX2104.2 +219900 PERFORM PRINT-DETAIL. IX2104.2 +220000 START-TEST-GF-35. IX2104.2 +220100 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +220200 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2104.2 +220300 IF FILESTATUS (8) EQUAL TO "**" IX2104.2 +220400 PERFORM DE-LETE IX2104.2 +220500 GO TO START-WRITE-GF-35. IX2104.2 +220600* IX2104.2 +220700* START-TEST-GF-35 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +220800* RESULTING FROM START-TEST-GF-26. THE FILE IX2104.2 +220900* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +221000* IX2104.2 +221100 IF FILESTATUS (8) EQUAL TO "00" IX2104.2 +221200 PERFORM PASS IX2104.2 +221300 ELSE PERFORM FAIL IX2104.2 +221400 MOVE "FROM START-TEST-GF-26; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +221500 MOVE "00" TO CORRECT-A IX2104.2 +221600 MOVE FILESTATUS (8) TO COMPUTED-A. IX2104.2 +221700 START-WRITE-GF-35. IX2104.2 +221800 PERFORM PRINT-DETAIL. IX2104.2 +221900 START-TEST-GF-36. IX2104.2 +222000 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +222100 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2104.2 +222200 IF FILESTATUS (9) EQUAL TO "**" IX2104.2 +222300 PERFORM DE-LETE IX2104.2 +222400 GO TO START-WRITE-GF-36. IX2104.2 +222500* IX2104.2 +222600* START-TEST-GF-36 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +222700* RESULTING FROM START-TEST-GF-27. THE FILE IX2104.2 +222800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +222900* IX2104.2 +223000 IF FILESTATUS (9) EQUAL TO "23" IX2104.2 +223100 PERFORM PASS IX2104.2 +223200 ELSE PERFORM FAIL IX2104.2 +223300 MOVE "FROM START-TEST-GF-27; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +223400 MOVE "23" TO CORRECT-A IX2104.2 +223500 MOVE FILESTATUS (9) TO COMPUTED-A. IX2104.2 +223600 START-WRITE-GF-36. IX2104.2 +223700 PERFORM PRINT-DETAIL. IX2104.2 +223800 IX2104.2 +223900 IX2104.2 +224000 START-INIT-GF-SERIES. IX2104.2 +224100 OPEN I-O IX-FS1. IX2104.2 +224200 MOVE "START SERIES" TO FEATURE. IX2104.2 +224300 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2104.2 +224400 MOVE ZERO TO INVKEY-COUNTER. IX2104.2 +224500* IX2104.2 +224600* THIS TEST EXECUTES SEVERAL START STATEMENTS USING DIFFERENT IX2104.2 +224700* KEY VALUES. FOLLOWING EXECUTION OF THE LAST START IX2104.2 +224800* STATEMENT THE READ STATEMENT IS EXECUTED. THE START IX2104.2 +224900* STATEMENT SHOULD HAVE POSITION THE RECORD POINTER IX2104.2 +225000* SUCH THAT RECORD NUMBER 49 IS MADE AVAILABLE FOLLOWING IX2104.2 +225100* EXECUTION OF THE READ STATEMENT. THE KEY OF REFERENCE IX2104.2 +225200* SHOULD BE ALTERNATE-KEY-2. IX2104.2 +225300* IX2104.2 +225400 START-TEST-GF-37. IX2104.2 +225500 MOVE "FGGGGGGGGG098" TO FS1-RECKEY-1-13. IX2104.2 +225600 MOVE "WWWWWWWXXX366ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +225700 MOVE "RRRRRRRRRR300ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +225800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +225900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +226000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +226100 START IX-FS1 IX2104.2 +226200 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2104.2 +226300 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +226400 START IX-FS1 IX2104.2 +226500 INVALID KEY ADD 01 TO INVKEY-COUNTER. IX2104.2 +226600 START IX-FS1 IX2104.2 +226700 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2104.2 +226800 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +226900 START IX-FS1 IX2104.2 +227000 KEY IS GREATER THAN IX-FS1-ALTKEY2-1-5 IX2104.2 +227100 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +227200 READ IX-FS1 AT END IX2104.2 +227300 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +227400 GO TO START-FAIL-GF-37. IX2104.2 +227500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +227600 IF XRECORD-NUMBER (1) EQUAL TO 49 IX2104.2 +227700 PERFORM PASS IX2104.2 +227800 MOVE "MULTIPLE STARTS BEFORE READ " TO RE-MARK IX2104.2 +227900 GO TO START-EXIT-GF-37. IX2104.2 +228000 MOVE 49 TO RECNO. IX2104.2 +228100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2104.2 +228200 START-FAIL-GF-37. IX2104.2 +228300 PERFORM FAIL. IX2104.2 +228400 MOVE 49 TO CORRECT-18V0. IX2104.2 +228500 MOVE "AFTER MULTIPLE STARTS; IX-36 ETC " TO RE-MARK. IX2104.2 +228600 GO TO START-EXIT-GF-37. IX2104.2 +228700 START-DELETE-GF-37. IX2104.2 +228800 PERFORM DE-LETE. IX2104.2 +228900 START-EXIT-GF-37. IX2104.2 +229000 PERFORM PRINT-DETAIL. IX2104.2 +229100 CLOSE IX-FS1. IX2104.2 +229200 START-CLOSE-FILES. IX2104.2 +229300 GO TO START-TEST-COMPLETE. IX2104.2 +229400 START-INITIALIZE-RECORD. IX2104.2 +229500 MOVE "**" TO FS1-STATUS. IX2104.2 +229600 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2104.2 +229700 MOVE ZERO TO INIT-FLAG. IX2104.2 +229800 MOVE 9999 TO XRECORD-NUMBER (1). IX2104.2 +229900 MOVE SPACE TO IX-FS1R1-F-G-240. IX2104.2 +230000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +230100 START IX-FS1 IX2104.2 +230200 KEY IS EQUAL TO IX-FS1-KEY IX2104.2 +230300 INVALID KEY MOVE 1 TO INIT-FLAG. IX2104.2 +230400 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2104.2 +230500 AT END MOVE 1 TO INIT-FLAG. IX2104.2 +230600 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2104.2 +230700 MOVE 1 TO INIT-FLAG. IX2104.2 +230800 DISPLAY-RECORD-KEYS. IX2104.2 +230900 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2104.2 +231000 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2104.2 +231100 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2104.2 +231200 MOVE SPACE TO P-OR-F. IX2104.2 +231300 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2104.2 +231400 PERFORM PRINT-DETAIL. IX2104.2 +231500 DISPLAY-ALTERNATE-KEY1. IX2104.2 +231600 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2104.2 +231700 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2104.2 +231800 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2104.2 +231900 MOVE SPACE TO P-OR-F. IX2104.2 +232000 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2104.2 +232100 PERFORM PRINT-DETAIL. IX2104.2 +232200 DISPLAY-ALTERNATE-KEY2. IX2104.2 +232300 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2104.2 +232400 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2104.2 +232500 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2104.2 +232600 MOVE SPACE TO P-OR-F. IX2104.2 +232700 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2104.2 +232800 PERFORM PRINT-DETAIL. IX2104.2 +232900 START-TEST-COMPLETE. IX2104.2 +233000 EXIT. IX2104.2 +233100 CCVS-EXIT SECTION. IX2104.2 +233200 CCVS-999999. IX2104.2 +233300 GO TO CLOSE-FILES. IX2104.2 +*END-OF,IX210A +*HEADER,COBOL,IX211A +000100 IDENTIFICATION DIVISION. IX2114.2 +000200 PROGRAM-ID. IX2114.2 +000300 IX211A. IX2114.2 +000400**************************************************************** IX2114.2 +000500* * IX2114.2 +000600* VALIDATION FOR:- * IX2114.2 +000700* * IX2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +000900* * IX2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2114.2 +001100* * IX2114.2 +001200**************************************************************** IX2114.2 +001300* * IX2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2114.2 +001500* * IX2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2114.2 +001900* * IX2114.2 +002000**************************************************************** IX2114.2 +002100* "IX211A" IX2114.2 +002200******************************************************************IX2114.2 +002300* IX2114.2 +002400* THIS PROGRAM TESTS THE CAPABILITY TO CHANGE (UPDATE) INDEX IX2114.2 +002500* KEYS OF RECORDS IN AN INDEXED I-O FILE AND THEN RETRIEVE THE IX2114.2 +002600* RECORDS FROM THE FILE IN THE PROPER SEQUENCE. A RECORD IX2114.2 +002700* MODIFICATION FOR THE FILE WILL INVOLVE THE UPDATING IX2114.2 +002800* OF THE UPDATE-NUMBER FIELD, THE RECORD-KEY OR ALTERNATE-KEY, IX2114.2 +002900* AND THE ODO-NUMBER FIELD OF THE RECORD. EACH TIME A GIVEN IX2114.2 +003000* RECORD IS MODIFIED THE UPDATE-NUMBER FIELD WILL BE INCREMENT-IX2114.2 +003100* ED BY ONE. TO KEEP TRACK OF THOSE RECORDS MODIFIED, IX2114.2 +003200* THE ODO-NUMBER FIELD WILL ALWAYS CARRY THE SEQUENTIAL LOC- IX2114.2 +003300* ATION OF THE RECORD WITHIN THE FILE WHICH REFLECTS THE LAST IX2114.2 +003400* KEY VALUE POSITION BEFORE THE RECORD WAS MODIFIED. THIS IX2114.2 +003500* LOCATION NUMBER WILL BE USED FOR VERIFYING THAT THE SEQUENTI-IX2114.2 +003600* AL REORDING OF THE RECORD FOR THE FILE WAS PROPER. ONLY ONE IX2114.2 +003700* OF THE 3 KEYS OF THE RECORD WILLBE MODIFIED FOR ANY GIVEN IX2114.2 +003800* REWIRTE OF THE RECORD. IX2114.2 +003900* FURTHER A TEST IS MADE TO SEE IF THE POSITION INDICATOR IX2114.2 +004000* IS AFFECTED BY EXECUTION OF THE REWRITE STATEMENT. IT SHOULDIX2114.2 +004100* NOT (PARAGRAPH 4.6.4 (7), PAGE IX-34). IX2114.2 +004200* IX2114.2 +004300* REFERENCE AMERICAN NATIONAL STANDARD IX2114.2 +004400* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2114.2 +004500* SECTION IX, INDEXED I-O, THE REWRITE IX2114.2 +004600* STATEMENT, PARAGRAPHS 4.6.4 (7),(14), ANDIX2114.2 +004700* (15 B) IX2114.2 +004800* IX2114.2 +004900* IX2114.2 +005000* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2114.2 +005100* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2114.2 +005200* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2114.2 +005300* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2114.2 +005400* ACCURACY. IX2114.2 +005500* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2114.2 +005600* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2114.2 +005700* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2114.2 +005800* THE FILE. IX2114.2 +005900* IX2114.2 +006000* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2114.2 +006100* ------ ---------- --------------- --------------- IX2114.2 +006200* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2114.2 +006300* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2114.2 +006400* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2114.2 +006500* . . . . IX2114.2 +006600* . . . . IX2114.2 +006700* . . . . IX2114.2 +006800* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2114.2 +006900* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2114.2 +007000* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2114.2 +007100* . . . . IX2114.2 +007200* . . . . IX2114.2 +007300* . . . . IX2114.2 +007400* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2114.2 +007500* IX2114.2 +007600* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2114.2 +007700* EVERY 10TH AND 11TH RECORDS. IX2114.2 +007800* IX2114.2 +007900* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2114.2 +008000* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2114.2 +008100* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2114.2 +008200* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2114.2 +008300* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2114.2 +008400* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2114.2 +008500* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2114.2 +008600* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2114.2 +008700* THE FILE. IX2114.2 +008800* IX2114.2 +008900* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2114.2 +009000* RECORD SIZE = 240 CHARS. IX2114.2 +009100* RECORD KEY SIZE = 13 CHARS. IX2114.2 +009200* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2114.2 +009300* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2114.2 +009400* ACCESS MODE = DYNAMIC IX2114.2 +009500* IX2114.2 +009600* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2114.2 +009700* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2114.2 +009800* TEST FOLLOWS. IX2114.2 +009900* IX2114.2 +010000* WRITE --- INVALID KEY --. (INX-TEST-001) - THIS TEST IX2114.2 +010100* CREATES A FILE OF 200 RECORDS CONTAINING A RECORD KEYIX2114.2 +010200* AND 2 ALTERNATE KEYS. IX2114.2 +010300* READ --- AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2114.2 +010400* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2114.2 +010500* FILE WAS CREATED CORRECTLY. IX2114.2 +010600* START --- KEY IS EQUAL TO ALTERNAT-KEY1 ---. AND IX2114.2 +010700* READ --- NEXT AT END ---. (INX-TEST-003.01) - THIS TEST IX2114.2 +010800* READS A RECORD AND ESTABLISHES THE ALTERNAT-KEY1 AS IX2114.2 +010900* THE KEY OF REFERENCE FOR THE FOLLOWING REWRITE TEST. IX2114.2 +011000* REWRITE --- INVALID KEY ---. (INX-TEST-003-02) - THIS TEST IX2114.2 +011100* MODIFIES THE ALTERNATE-KEY1 KEY OF THE RECORD AND IX2114.2 +011200* REWRITES THE RECORD IX2114.2 +011300* READ --- NEXT AT END ---. (INX-TEST-003.03) - ONE RECORD IX2114.2 +011400* IS READ SEQUENTIALLY FROM THE FILE. THE REWRITE IX2114.2 +011500* IN PREVIOUS TEST SHOULD NOT HAVE AFFECTED THE RECORD IX2114.2 +011600* POINTER FOR THE FILE, THUS THE RECORD MADE AVAILABLE IX2114.2 +011700* SHOULD BE THE NEXT RECORD AS THOUGH THE ALTERNATE KEYIX2114.2 +011800* HAD NOT BEEN MODIFIED. IX2114.2 +011900* READ --- NEXT AT END ---. (INX-TEST-003.04) - THIS TEST IX2114.2 +012000* READS THE NEXT 4 RECORDS SEQUENTIALLY TO SEE IF IX2114.2 +012100* THE REWRITE OF THE RECORD CAUSED SEQUENTIAL IX2114.2 +012200* REORDING OF THE RECORDS. IX2114.2 +012300* IX2114.2 +012400******************************************************************IX2114.2 +012500 ENVIRONMENT DIVISION. IX2114.2 +012600 CONFIGURATION SECTION. IX2114.2 +012700 SOURCE-COMPUTER. IX2114.2 +012800 XXXXX082. IX2114.2 +012900 OBJECT-COMPUTER. IX2114.2 +013000 XXXXX083. IX2114.2 +013100 INPUT-OUTPUT SECTION. IX2114.2 +013200 FILE-CONTROL. IX2114.2 +013300P SELECT RAW-DATA ASSIGN TO IX2114.2 +013400P XXXXX062 IX2114.2 +013500P ORGANIZATION IS INDEXED IX2114.2 +013600P ACCESS MODE IS RANDOM IX2114.2 +013700P RECORD KEY IS RAW-DATA-KEY. IX2114.2 +013800 SELECT PRINT-FILE ASSIGN TO IX2114.2 +013900 XXXXX055. IX2114.2 +014000 SELECT IX-FD1 IX2114.2 +014100 ASSIGN TO IX2114.2 +014200 XXXXX024 IX2114.2 +014300J XXXXX044 IX2114.2 +014400 ACCESS MODE IS DYNAMIC IX2114.2 +014500 ORGANIZATION IS INDEXED IX2114.2 +014600 RECORD KEY IS IX-FD1-KEY IX2114.2 +014700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2114.2 +014800 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY2 WITH DUPLICATES IX2114.2 +014900 FILE STATUS IS FD1-STATUS. IX2114.2 +015000 DATA DIVISION. IX2114.2 +015100 FILE SECTION. IX2114.2 +015200P IX2114.2 +015300PFD RAW-DATA. IX2114.2 +015400P IX2114.2 +015500P01 RAW-DATA-SATZ. IX2114.2 +015600P 05 RAW-DATA-KEY PIC X(6). IX2114.2 +015700P 05 C-DATE PIC 9(6). IX2114.2 +015800P 05 C-TIME PIC 9(8). IX2114.2 +015900P 05 C-NO-OF-TESTS PIC 99. IX2114.2 +016000P 05 C-OK PIC 999. IX2114.2 +016100P 05 C-ALL PIC 999. IX2114.2 +016200P 05 C-FAIL PIC 999. IX2114.2 +016300P 05 C-DELETED PIC 999. IX2114.2 +016400P 05 C-INSPECT PIC 999. IX2114.2 +016500P 05 C-NOTE PIC X(13). IX2114.2 +016600P 05 C-INDENT PIC X. IX2114.2 +016700P 05 C-ABORT PIC X(8). IX2114.2 +016800 FD PRINT-FILE. IX2114.2 +016900 01 PRINT-REC PICTURE X(120). IX2114.2 +017000 01 DUMMY-RECORD PICTURE X(120). IX2114.2 +017100 FD IX-FD1 IX2114.2 +017200C LABEL RECORDS ARE STANDARD IX2114.2 +017300C DATA RECORD IS IX-FD1R1-F-G-240 IX2114.2 +017400 RECORD CONTAINS 240 CHARACTERS. IX2114.2 +017500 01 IX-FD1R1-F-G-240. IX2114.2 +017600 05 IX-FD1-REC-120 PICTURE X(120). IX2114.2 +017700 05 IX-FD1-REC-121-240. IX2114.2 +017800 10 FILLER PICTURE X(8). IX2114.2 +017900 10 IX-REC-KEY-AREA. IX2114.2 +018000 15 IX-FD1-KEY. IX2114.2 +018100 20 IX-FD1-KEY-1-10. IX2114.2 +018200 25 IX-FD1-KEY-1-5 PICTURE X(5). IX2114.2 +018300 25 IX-FD1-KEY-6-10 PICTURE X(5). IX2114.2 +018400 20 IX-FD1-KEY-11-13 PICTURE X(3). IX2114.2 +018500 15 FILLER PICTURE X(16). IX2114.2 +018600 10 FILLER PICTURE X(9). IX2114.2 +018700 10 IX-ALT-KEY1-AREA. IX2114.2 +018800 15 IX-FD1-ALTKEY1. IX2114.2 +018900 20 IX-FD1-ALTKEY1-1-10. IX2114.2 +019000 25 IX-FD1-ALTKEY1-1-5 PICTURE X(5). IX2114.2 +019100 25 IX-FD1-ALTKEY1-6-10 PICTURE X(5). IX2114.2 +019200 20 IX-FD1-ALTKEY1-11-13 PICTURE X(3). IX2114.2 +019300 20 IX-FD1-ALTKEY1-14-20 PICTURE X(7). IX2114.2 +019400 15 FILLER PICTURE X(9). IX2114.2 +019500 10 FILLER PICTURE X(9). IX2114.2 +019600 10 IX-ALT-KEY2-AREA. IX2114.2 +019700 15 IX-FD1-ALTKEY2. IX2114.2 +019800 20 IX-FD1-ALTKEY2-1-10. IX2114.2 +019900 25 IX-FD1-ALTKEY2-1-5 PICTURE X(5). IX2114.2 +020000 25 IX-FD1-ALTKEY2-6-10 PICTURE X(5). IX2114.2 +020100 20 IX-FD1-ALTKEY2-11-13 PICTURE X(3). IX2114.2 +020200 20 IX-FD1-ALTKEY2-14-20 PICTURE X(7). IX2114.2 +020300 15 FILLER PICTURE X(9). IX2114.2 +020400 10 FILLER PICTURE X(7). IX2114.2 +020500 WORKING-STORAGE SECTION. IX2114.2 +020600 01 WRK-FD1-RECKEY. IX2114.2 +020700 05 FD1-RECKEY-1-13. IX2114.2 +020800 10 FD1-RECKEY-1-10 PICTURE X(10). IX2114.2 +020900 10 FD1-RECKEY-11-13 PICTURE 9(3). IX2114.2 +021000 05 FILLER PICTURE X(16) VALUE SPACE. IX2114.2 +021100 01 WRK-FD1-ALTKEY1. IX2114.2 +021200 05 FD1-ALTKEY1-1-20. IX2114.2 +021300 10 FD1-ALTKEY1-1-10. IX2114.2 +021400 15 FD1-ALTKEY1-1-5 PICTURE X(5). IX2114.2 +021500 15 FD1-ALTKEY1-6-10 PICTURE X(5). IX2114.2 +021600 10 FD1-ALTKEY1-11-13 PICTURE 9(3). IX2114.2 +021700 10 FD1-ALTKEY1-14-20 PICTURE X(7). IX2114.2 +021800 05 FILLER PICTURE X(9) VALUE SPACE. IX2114.2 +021900 01 WRK-FD1-ALTKEY2. IX2114.2 +022000 05 FD1-ALTKEY2-1-20. IX2114.2 +022100 10 FD1-ALTKEY2-1-10. IX2114.2 +022200 15 FD1-ALTKEY2-1-5 PICTURE X(5). IX2114.2 +022300 15 FD1-ALTKEY2-6-10 PICTURE X(5). IX2114.2 +022400 10 FD1-ALTKEY2-11-13 PICTURE 9(3). IX2114.2 +022500 10 FD1-ALTKEY2-14-20 PICTURE X(7). IX2114.2 +022600 05 FILLER PICTURE X(9) VALUE SPACE. IX2114.2 +022700 01 RECNO PICTURE 9(5) VALUE ZERO. IX2114.2 +022800 01 ADJUSTED-NUM PIC X(8) VALUE "NO". IX2114.2 +022900 01 FD1-STATUS PICTURE XX VALUE SPACE. IX2114.2 +023000 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2114.2 +023100 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2114.2 +023200 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2114.2 +023300 01 RECORDS-WRITTEN PICTURE 9(3). IX2114.2 +023400 01 RECKEY-NUM PICTURE 9(3). IX2114.2 +023500 01 ALTKEY1-NUM PICTURE 9(3). IX2114.2 +023600 01 ALTKEY2-NUM PICTURE 9(3). IX2114.2 +023700 01 RECORD-KEY-CONTENT. IX2114.2 +023800 05 FILLER PIC X(53) VALUE IX2114.2 +023900 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2114.2 +024000 05 FILLER PIC X(53) VALUE IX2114.2 +024100 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2114.2 +024200 05 FILLER PIC X(53) VALUE IX2114.2 +024300 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2114.2 +024400 05 FILLER PIC X(53) VALUE IX2114.2 +024500 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2114.2 +024600 05 FILLER PIC X(53) VALUE IX2114.2 +024700 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2114.2 +024800 05 FILLER PIC X(53) VALUE IX2114.2 +024900 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2114.2 +025000 05 FILLER PIC X(53) VALUE IX2114.2 +025100 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2114.2 +025200 05 FILLER PIC X(53) VALUE IX2114.2 +025300 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2114.2 +025400 05 FILLER PIC X(53) VALUE IX2114.2 +025500 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2114.2 +025600 05 FILLER PIC X(53) VALUE IX2114.2 +025700 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2114.2 +025800 05 FILLER PIC X(53) VALUE IX2114.2 +025900 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2114.2 +026000 05 FILLER PIC X(53) VALUE IX2114.2 +026100 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2114.2 +026200 05 FILLER PIC X(53) VALUE IX2114.2 +026300 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2114.2 +026400 05 FILLER PIC X(53) VALUE IX2114.2 +026500 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2114.2 +026600 05 FILLER PIC X(53) VALUE IX2114.2 +026700 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2114.2 +026800 05 FILLER PIC X(53) VALUE IX2114.2 +026900 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2114.2 +027000 05 FILLER PIC X(53) VALUE IX2114.2 +027100 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2114.2 +027200 05 FILLER PIC X(53) VALUE IX2114.2 +027300 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2114.2 +027400 05 FILLER PIC X(53) VALUE IX2114.2 +027500 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2114.2 +027600 05 FILLER PIC X(53) VALUE IX2114.2 +027700 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2114.2 +027800 05 FILLER PIC X(53) VALUE IX2114.2 +027900 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2114.2 +028000 05 FILLER PIC X(53) VALUE IX2114.2 +028100 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2114.2 +028200 05 FILLER PIC X(53) VALUE IX2114.2 +028300 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2114.2 +028400 05 FILLER PIC X(53) VALUE IX2114.2 +028500 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2114.2 +028600 05 FILLER PIC X(53) VALUE IX2114.2 +028700 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2114.2 +028800 05 FILLER PIC X(53) VALUE IX2114.2 +028900 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2114.2 +029000 05 FILLER PIC X(53) VALUE IX2114.2 +029100 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2114.2 +029200 05 FILLER PIC X(53) VALUE IX2114.2 +029300 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2114.2 +029400 05 FILLER PIC X(53) VALUE IX2114.2 +029500 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2114.2 +029600 05 FILLER PIC X(53) VALUE IX2114.2 +029700 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2114.2 +029800 05 FILLER PIC X(53) VALUE IX2114.2 +029900 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2114.2 +030000 05 FILLER PIC X(53) VALUE IX2114.2 +030100 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2114.2 +030200 05 FILLER PIC X(53) VALUE IX2114.2 +030300 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2114.2 +030400 05 FILLER PIC X(53) VALUE IX2114.2 +030500 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2114.2 +030600 05 FILLER PIC X(53) VALUE IX2114.2 +030700 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2114.2 +030800 05 FILLER PIC X(53) VALUE IX2114.2 +030900 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2114.2 +031000 05 FILLER PIC X(53) VALUE IX2114.2 +031100 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2114.2 +031200 05 FILLER PIC X(53) VALUE IX2114.2 +031300 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2114.2 +031400 05 FILLER PIC X(53) VALUE IX2114.2 +031500 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2114.2 +031600 05 FILLER PIC X(53) VALUE IX2114.2 +031700 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2114.2 +031800 05 FILLER PIC X(53) VALUE IX2114.2 +031900 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2114.2 +032000 05 FILLER PIC X(53) VALUE IX2114.2 +032100 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2114.2 +032200 05 FILLER PIC X(53) VALUE IX2114.2 +032300 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2114.2 +032400 05 FILLER PIC X(53) VALUE IX2114.2 +032500 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2114.2 +032600 05 FILLER PIC X(53) VALUE IX2114.2 +032700 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2114.2 +032800 05 FILLER PIC X(53) VALUE IX2114.2 +032900 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2114.2 +033000 05 FILLER PIC X(53) VALUE IX2114.2 +033100 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2114.2 +033200 05 FILLER PIC X(53) VALUE IX2114.2 +033300 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2114.2 +033400 05 FILLER PIC X(53) VALUE IX2114.2 +033500 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2114.2 +033600 05 FILLER PIC X(53) VALUE IX2114.2 +033700 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2114.2 +033800 05 FILLER PIC X(53) VALUE IX2114.2 +033900 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2114.2 +034000 05 FILLER PIC X(53) VALUE IX2114.2 +034100 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2114.2 +034200 05 FILLER PIC X(53) VALUE IX2114.2 +034300 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2114.2 +034400 05 FILLER PIC X(53) VALUE IX2114.2 +034500 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2114.2 +034600 05 FILLER PIC X(53) VALUE IX2114.2 +034700 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2114.2 +034800 05 FILLER PIC X(53) VALUE IX2114.2 +034900 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2114.2 +035000 05 FILLER PIC X(53) VALUE IX2114.2 +035100 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2114.2 +035200 05 FILLER PIC X(53) VALUE IX2114.2 +035300 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2114.2 +035400 05 FILLER PIC X(53) VALUE IX2114.2 +035500 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2114.2 +035600 05 FILLER PIC X(53) VALUE IX2114.2 +035700 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2114.2 +035800 05 FILLER PIC X(53) VALUE IX2114.2 +035900 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2114.2 +036000 05 FILLER PIC X(53) VALUE IX2114.2 +036100 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2114.2 +036200 05 FILLER PIC X(53) VALUE IX2114.2 +036300 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2114.2 +036400 05 FILLER PIC X(53) VALUE IX2114.2 +036500 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2114.2 +036600 05 FILLER PIC X(53) VALUE IX2114.2 +036700 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2114.2 +036800 05 FILLER PIC X(53) VALUE IX2114.2 +036900 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2114.2 +037000 05 FILLER PIC X(53) VALUE IX2114.2 +037100 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2114.2 +037200 05 FILLER PIC X(53) VALUE IX2114.2 +037300 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2114.2 +037400 05 FILLER PIC X(53) VALUE IX2114.2 +037500 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2114.2 +037600 05 FILLER PIC X(53) VALUE IX2114.2 +037700 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2114.2 +037800 05 FILLER PIC X(53) VALUE IX2114.2 +037900 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2114.2 +038000 05 FILLER PIC X(53) VALUE IX2114.2 +038100 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2114.2 +038200 05 FILLER PIC X(53) VALUE IX2114.2 +038300 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2114.2 +038400 05 FILLER PIC X(53) VALUE IX2114.2 +038500 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2114.2 +038600 05 FILLER PIC X(53) VALUE IX2114.2 +038700 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2114.2 +038800 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2114.2 +038900 05 KEY-VALUES OCCURS 75 TIMES. IX2114.2 +039000 10 RECKEY-VALUE PICTURE X(13). IX2114.2 +039100 10 ALTKEY1-VALUE PICTURE X(20). IX2114.2 +039200 10 ALTKEY2-VALUE PICTURE X(20). IX2114.2 +039300 01 INIT-FLAG PICTURE 9. IX2114.2 +039400 01 HOLD-FILESTATUS-RECORD. IX2114.2 +039500 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2114.2 +039600 01 FILE-RECORD-INFORMATION-REC. IX2114.2 +039700 03 FILE-RECORD-INFO-SKELETON. IX2114.2 +039800 05 FILLER PICTURE X(48) VALUE IX2114.2 +039900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2114.2 +040000 05 FILLER PICTURE X(46) VALUE IX2114.2 +040100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2114.2 +040200 05 FILLER PICTURE X(26) VALUE IX2114.2 +040300 ",LFIL=000000,ORG= ,LBLR= ". IX2114.2 +040400 05 FILLER PICTURE X(37) VALUE IX2114.2 +040500 ",RECKEY= ". IX2114.2 +040600 05 FILLER PICTURE X(38) VALUE IX2114.2 +040700 ",ALTKEY1= ". IX2114.2 +040800 05 FILLER PICTURE X(38) VALUE IX2114.2 +040900 ",ALTKEY2= ". IX2114.2 +041000 05 FILLER PICTURE X(7) VALUE SPACE.IX2114.2 +041100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2114.2 +041200 05 FILE-RECORD-INFO-P1-120. IX2114.2 +041300 07 FILLER PIC X(5). IX2114.2 +041400 07 XFILE-NAME PIC X(6). IX2114.2 +041500 07 FILLER PIC X(8). IX2114.2 +041600 07 XRECORD-NAME PIC X(6). IX2114.2 +041700 07 FILLER PIC X(1). IX2114.2 +041800 07 REELUNIT-NUMBER PIC 9(1). IX2114.2 +041900 07 FILLER PIC X(7). IX2114.2 +042000 07 XRECORD-NUMBER PIC 9(6). IX2114.2 +042100 07 FILLER PIC X(6). IX2114.2 +042200 07 UPDATE-NUMBER PIC 9(2). IX2114.2 +042300 07 FILLER PIC X(5). IX2114.2 +042400 07 ODO-NUMBER PIC 9(4). IX2114.2 +042500 07 FILLER PIC X(5). IX2114.2 +042600 07 XPROGRAM-NAME PIC X(5). IX2114.2 +042700 07 FILLER PIC X(7). IX2114.2 +042800 07 XRECORD-LENGTH PIC 9(6). IX2114.2 +042900 07 FILLER PIC X(7). IX2114.2 +043000 07 CHARS-OR-RECORDS PIC X(2). IX2114.2 +043100 07 FILLER PIC X(1). IX2114.2 +043200 07 XBLOCK-SIZE PIC 9(4). IX2114.2 +043300 07 FILLER PIC X(6). IX2114.2 +043400 07 RECORDS-IN-FILE PIC 9(6). IX2114.2 +043500 07 FILLER PIC X(5). IX2114.2 +043600 07 XFILE-ORGANIZATION PIC X(2). IX2114.2 +043700 07 FILLER PIC X(6). IX2114.2 +043800 07 XLABEL-TYPE PIC X(1). IX2114.2 +043900 05 FILE-RECORD-INFO-P121-240. IX2114.2 +044000 07 FILLER PIC X(8). IX2114.2 +044100 07 XRECORD-KEY PIC X(29). IX2114.2 +044200 07 FILLER PIC X(9). IX2114.2 +044300 07 ALTERNATE-KEY1 PIC X(29). IX2114.2 +044400 07 FILLER PIC X(9). IX2114.2 +044500 07 ALTERNATE-KEY2 PIC X(29). IX2114.2 +044600 07 FILLER PIC X(7). IX2114.2 +044700 01 TEST-RESULTS. IX2114.2 +044800 02 FILLER PIC X VALUE SPACE. IX2114.2 +044900 02 FEATURE PIC X(20) VALUE SPACE. IX2114.2 +045000 02 FILLER PIC X VALUE SPACE. IX2114.2 +045100 02 P-OR-F PIC X(5) VALUE SPACE. IX2114.2 +045200 02 FILLER PIC X VALUE SPACE. IX2114.2 +045300 02 PAR-NAME. IX2114.2 +045400 03 FILLER PIC X(19) VALUE SPACE. IX2114.2 +045500 03 PARDOT-X PIC X VALUE SPACE. IX2114.2 +045600 03 DOTVALUE PIC 99 VALUE ZERO. IX2114.2 +045700 02 FILLER PIC X(8) VALUE SPACE. IX2114.2 +045800 02 RE-MARK PIC X(61). IX2114.2 +045900 01 TEST-COMPUTED. IX2114.2 +046000 02 FILLER PIC X(30) VALUE SPACE. IX2114.2 +046100 02 FILLER PIC X(17) VALUE IX2114.2 +046200 " COMPUTED=". IX2114.2 +046300 02 COMPUTED-X. IX2114.2 +046400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2114.2 +046500 03 COMPUTED-N REDEFINES COMPUTED-A IX2114.2 +046600 PIC -9(9).9(9). IX2114.2 +046700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2114.2 +046800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2114.2 +046900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2114.2 +047000 03 CM-18V0 REDEFINES COMPUTED-A. IX2114.2 +047100 04 COMPUTED-18V0 PIC -9(18). IX2114.2 +047200 04 FILLER PIC X. IX2114.2 +047300 03 FILLER PIC X(50) VALUE SPACE. IX2114.2 +047400 01 TEST-CORRECT. IX2114.2 +047500 02 FILLER PIC X(30) VALUE SPACE. IX2114.2 +047600 02 FILLER PIC X(17) VALUE " CORRECT =". IX2114.2 +047700 02 CORRECT-X. IX2114.2 +047800 03 CORRECT-A PIC X(20) VALUE SPACE. IX2114.2 +047900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2114.2 +048000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2114.2 +048100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2114.2 +048200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2114.2 +048300 03 CR-18V0 REDEFINES CORRECT-A. IX2114.2 +048400 04 CORRECT-18V0 PIC -9(18). IX2114.2 +048500 04 FILLER PIC X. IX2114.2 +048600 03 FILLER PIC X(2) VALUE SPACE. IX2114.2 +048700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2114.2 +048800 01 CCVS-C-1. IX2114.2 +048900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2114.2 +049000- "SS PARAGRAPH-NAME IX2114.2 +049100- " REMARKS". IX2114.2 +049200 02 FILLER PIC X(20) VALUE SPACE. IX2114.2 +049300 01 CCVS-C-2. IX2114.2 +049400 02 FILLER PIC X VALUE SPACE. IX2114.2 +049500 02 FILLER PIC X(6) VALUE "TESTED". IX2114.2 +049600 02 FILLER PIC X(15) VALUE SPACE. IX2114.2 +049700 02 FILLER PIC X(4) VALUE "FAIL". IX2114.2 +049800 02 FILLER PIC X(94) VALUE SPACE. IX2114.2 +049900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2114.2 +050000 01 REC-CT PIC 99 VALUE ZERO. IX2114.2 +050100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2114.2 +050600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2114.2 +050700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2114.2 +050800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2114.2 +050900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2114.2 +051000 01 CCVS-H-1. IX2114.2 +051100 02 FILLER PIC X(39) VALUE SPACES. IX2114.2 +051200 02 FILLER PIC X(42) VALUE IX2114.2 +051300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2114.2 +051400 02 FILLER PIC X(39) VALUE SPACES. IX2114.2 +051500 01 CCVS-H-2A. IX2114.2 +051600 02 FILLER PIC X(40) VALUE SPACE. IX2114.2 +051700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2114.2 +051800 02 FILLER PIC XXXX VALUE IX2114.2 +051900 "4.2 ". IX2114.2 +052000 02 FILLER PIC X(28) VALUE IX2114.2 +052100 " COPY - NOT FOR DISTRIBUTION". IX2114.2 +052200 02 FILLER PIC X(41) VALUE SPACE. IX2114.2 +052300 IX2114.2 +052400 01 CCVS-H-2B. IX2114.2 +052500 02 FILLER PIC X(15) VALUE IX2114.2 +052600 "TEST RESULT OF ". IX2114.2 +052700 02 TEST-ID PIC X(9). IX2114.2 +052800 02 FILLER PIC X(4) VALUE IX2114.2 +052900 " IN ". IX2114.2 +053000 02 FILLER PIC X(12) VALUE IX2114.2 +053100 " HIGH ". IX2114.2 +053200 02 FILLER PIC X(22) VALUE IX2114.2 +053300 " LEVEL VALIDATION FOR ". IX2114.2 +053400 02 FILLER PIC X(58) VALUE IX2114.2 +053500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +053600 01 CCVS-H-3. IX2114.2 +053700 02 FILLER PIC X(34) VALUE IX2114.2 +053800 " FOR OFFICIAL USE ONLY ". IX2114.2 +053900 02 FILLER PIC X(58) VALUE IX2114.2 +054000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2114.2 +054100 02 FILLER PIC X(28) VALUE IX2114.2 +054200 " COPYRIGHT 1985 ". IX2114.2 +054300 01 CCVS-E-1. IX2114.2 +054400 02 FILLER PIC X(52) VALUE SPACE. IX2114.2 +054500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2114.2 +054600 02 ID-AGAIN PIC X(9). IX2114.2 +054700 02 FILLER PIC X(45) VALUE SPACES. IX2114.2 +054800 01 CCVS-E-2. IX2114.2 +054900 02 FILLER PIC X(31) VALUE SPACE. IX2114.2 +055000 02 FILLER PIC X(21) VALUE SPACE. IX2114.2 +055100 02 CCVS-E-2-2. IX2114.2 +055200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2114.2 +055300 03 FILLER PIC X VALUE SPACE. IX2114.2 +055400 03 ENDER-DESC PIC X(44) VALUE IX2114.2 +055500 "ERRORS ENCOUNTERED". IX2114.2 +055600 01 CCVS-E-3. IX2114.2 +055700 02 FILLER PIC X(22) VALUE IX2114.2 +055800 " FOR OFFICIAL USE ONLY". IX2114.2 +055900 02 FILLER PIC X(12) VALUE SPACE. IX2114.2 +056000 02 FILLER PIC X(58) VALUE IX2114.2 +056100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +056200 02 FILLER PIC X(13) VALUE SPACE. IX2114.2 +056300 02 FILLER PIC X(15) VALUE IX2114.2 +056400 " COPYRIGHT 1985". IX2114.2 +056500 01 CCVS-E-4. IX2114.2 +056600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2114.2 +056700 02 FILLER PIC X(4) VALUE " OF ". IX2114.2 +056800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2114.2 +056900 02 FILLER PIC X(40) VALUE IX2114.2 +057000 " TESTS WERE EXECUTED SUCCESSFULLY". IX2114.2 +057100 01 XXINFO. IX2114.2 +057200 02 FILLER PIC X(19) VALUE IX2114.2 +057300 "*** INFORMATION ***". IX2114.2 +057400 02 INFO-TEXT. IX2114.2 +057500 04 FILLER PIC X(8) VALUE SPACE. IX2114.2 +057600 04 XXCOMPUTED PIC X(20). IX2114.2 +057700 04 FILLER PIC X(5) VALUE SPACE. IX2114.2 +057800 04 XXCORRECT PIC X(20). IX2114.2 +057900 02 INF-ANSI-REFERENCE PIC X(48). IX2114.2 +058000 01 HYPHEN-LINE. IX2114.2 +058100 02 FILLER PIC IS X VALUE IS SPACE. IX2114.2 +058200 02 FILLER PIC IS X(65) VALUE IS "************************IX2114.2 +058300- "*****************************************". IX2114.2 +058400 02 FILLER PIC IS X(54) VALUE IS "************************IX2114.2 +058500- "******************************". IX2114.2 +058600 01 CCVS-PGM-ID PIC X(9) VALUE IX2114.2 +058700 "IX211A". IX2114.2 +058800 PROCEDURE DIVISION. IX2114.2 +058900 CCVS1 SECTION. IX2114.2 +059000 OPEN-FILES. IX2114.2 +059100P OPEN I-O RAW-DATA. IX2114.2 +059200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2114.2 +059300P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2114.2 +059400P MOVE "ABORTED " TO C-ABORT. IX2114.2 +059500P ADD 1 TO C-NO-OF-TESTS. IX2114.2 +059600P ACCEPT C-DATE FROM DATE. IX2114.2 +059700P ACCEPT C-TIME FROM TIME. IX2114.2 +059800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2114.2 +059900PEND-E-1. IX2114.2 +060000P CLOSE RAW-DATA. IX2114.2 +060100 OPEN OUTPUT PRINT-FILE. IX2114.2 +060200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2114.2 +060300 MOVE SPACE TO TEST-RESULTS. IX2114.2 +060400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2114.2 +060500 MOVE ZERO TO REC-SKL-SUB. IX2114.2 +060600 PERFORM CCVS-INIT-FILE 9 TIMES. IX2114.2 +060700 CCVS-INIT-FILE. IX2114.2 +060800 ADD 1 TO REC-SKL-SUB. IX2114.2 +060900 MOVE FILE-RECORD-INFO-SKELETON IX2114.2 +061000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2114.2 +061100 CCVS-INIT-EXIT. IX2114.2 +061200 GO TO CCVS1-EXIT. IX2114.2 +061300 CLOSE-FILES. IX2114.2 +061400P OPEN I-O RAW-DATA. IX2114.2 +061500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2114.2 +061600P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2114.2 +061700P MOVE "OK. " TO C-ABORT. IX2114.2 +061800P MOVE PASS-COUNTER TO C-OK. IX2114.2 +061900P MOVE ERROR-HOLD TO C-ALL. IX2114.2 +062000P MOVE ERROR-COUNTER TO C-FAIL. IX2114.2 +062100P MOVE DELETE-COUNTER TO C-DELETED. IX2114.2 +062200P MOVE INSPECT-COUNTER TO C-INSPECT. IX2114.2 +062300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2114.2 +062400PEND-E-2. IX2114.2 +062500P CLOSE RAW-DATA. IX2114.2 +062600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2114.2 +062700 TERMINATE-CCVS. IX2114.2 +062800S EXIT PROGRAM. IX2114.2 +062900STERMINATE-CALL. IX2114.2 +063000 STOP RUN. IX2114.2 +063100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2114.2 +063200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2114.2 +063300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2114.2 +063400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2114.2 +063500 MOVE "****TEST DELETED****" TO RE-MARK. IX2114.2 +063600 PRINT-DETAIL. IX2114.2 +063700 IF REC-CT NOT EQUAL TO ZERO IX2114.2 +063800 MOVE "." TO PARDOT-X IX2114.2 +063900 MOVE REC-CT TO DOTVALUE. IX2114.2 +064000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2114.2 +064100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2114.2 +064200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2114.2 +064300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2114.2 +064400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2114.2 +064500 MOVE SPACE TO CORRECT-X. IX2114.2 +064600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2114.2 +064700 MOVE SPACE TO RE-MARK. IX2114.2 +064800 HEAD-ROUTINE. IX2114.2 +064900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2114.2 +065200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2114.2 +065300 COLUMN-NAMES-ROUTINE. IX2114.2 +065400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +065500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +065700 END-ROUTINE. IX2114.2 +065800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2114.2 +065900 END-RTN-EXIT. IX2114.2 +066000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +066100 END-ROUTINE-1. IX2114.2 +066200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2114.2 +066300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2114.2 +066400 ADD PASS-COUNTER TO ERROR-HOLD. IX2114.2 +066500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2114.2 +066600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2114.2 +066700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2114.2 +066800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2114.2 +066900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2114.2 +067000 END-ROUTINE-12. IX2114.2 +067100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2114.2 +067200 IF ERROR-COUNTER IS EQUAL TO ZERO IX2114.2 +067300 MOVE "NO " TO ERROR-TOTAL IX2114.2 +067400 ELSE IX2114.2 +067500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2114.2 +067600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2114.2 +067700 PERFORM WRITE-LINE. IX2114.2 +067800 END-ROUTINE-13. IX2114.2 +067900 IF DELETE-COUNTER IS EQUAL TO ZERO IX2114.2 +068000 MOVE "NO " TO ERROR-TOTAL ELSE IX2114.2 +068100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2114.2 +068200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2114.2 +068300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +068400 IF INSPECT-COUNTER EQUAL TO ZERO IX2114.2 +068500 MOVE "NO " TO ERROR-TOTAL IX2114.2 +068600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2114.2 +068700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2114.2 +068800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +068900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +069000 WRITE-LINE. IX2114.2 +069100 ADD 1 TO RECORD-COUNT. IX2114.2 +069200Y IF RECORD-COUNT GREATER 42 IX2114.2 +069300Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2114.2 +069400Y MOVE SPACE TO DUMMY-RECORD IX2114.2 +069500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2114.2 +069600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2114.2 +069700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2114.2 +069800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2114.2 +069900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2114.2 +070000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070300Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2114.2 +070400Y MOVE ZERO TO RECORD-COUNT. IX2114.2 +070500 PERFORM WRT-LN. IX2114.2 +070600 WRT-LN. IX2114.2 +070700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2114.2 +070800 MOVE SPACE TO DUMMY-RECORD. IX2114.2 +070900 BLANK-LINE-PRINT. IX2114.2 +071000 PERFORM WRT-LN. IX2114.2 +071100 FAIL-ROUTINE. IX2114.2 +071200 IF COMPUTED-X NOT EQUAL TO SPACE IX2114.2 +071300 GO TO FAIL-ROUTINE-WRITE. IX2114.2 +071400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2114.2 +071500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2114.2 +071600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2114.2 +071700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +071800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2114.2 +071900 GO TO FAIL-ROUTINE-EX. IX2114.2 +072000 FAIL-ROUTINE-WRITE. IX2114.2 +072100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2114.2 +072200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2114.2 +072300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2114.2 +072400 MOVE SPACES TO COR-ANSI-REFERENCE. IX2114.2 +072500 FAIL-ROUTINE-EX. EXIT. IX2114.2 +072600 BAIL-OUT. IX2114.2 +072700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2114.2 +072800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2114.2 +072900 BAIL-OUT-WRITE. IX2114.2 +073000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2114.2 +073100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2114.2 +073200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +073300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2114.2 +073400 BAIL-OUT-EX. EXIT. IX2114.2 +073500 CCVS1-EXIT. IX2114.2 +073600 EXIT. IX2114.2 +073700 SECT-0001-IX211A SECTION. IX2114.2 +073800 WRITE-INT-GF-01. IX2114.2 +073900 OPEN OUTPUT IX-FD1. IX2114.2 +074000 MOVE "IX-FD1" TO XFILE-NAME (1). IX2114.2 +074100 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2114.2 +074200 MOVE ZERO TO XRECORD-NUMBER (1). IX2114.2 +074300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2114.2 +074400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2114.2 +074500 MOVE 240 TO XRECORD-LENGTH (1). IX2114.2 +074600 MOVE 001 TO XBLOCK-SIZE (1). IX2114.2 +074700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2114.2 +074800 MOVE "S" TO XLABEL-TYPE (1). IX2114.2 +074900 MOVE 200 TO RECORDS-IN-FILE (1). IX2114.2 +075000 MOVE "CREATE-FILE-FD1" TO FEATURE. IX2114.2 +075100 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2114.2 +075200 MOVE ZERO TO KEYSUB. IX2114.2 +075300 MOVE ZERO TO INVKEY-COUNTER. IX2114.2 +075400 WRITE-INIT-GF-01-01. IX2114.2 +075500 PERFORM WRITE-TEST-GF-01-1 50 TIMES. IX2114.2 +075600 PERFORM WRITE-TEST-GF-01-2 125 TIMES. IX2114.2 +075700 PERFORM WRITE-TEST-GF-01-1 25 TIMES. IX2114.2 +075800 GO TO WRITE-TEST-GF-01. IX2114.2 +075900 WRITE-TEST-GF-01-1. IX2114.2 +076000 ADD 001 TO XRECORD-NUMBER (1). IX2114.2 +076100 ADD 001 TO KEYSUB. IX2114.2 +076200 MOVE RECKEY-VALUE (KEYSUB) TO FD1-RECKEY-1-13. IX2114.2 +076300 MOVE ALTKEY1-VALUE (KEYSUB) TO FD1-ALTKEY1-1-20. IX2114.2 +076400 MOVE ALTKEY2-VALUE (KEYSUB) TO FD1-ALTKEY2-1-20. IX2114.2 +076500 MOVE WRK-FD1-RECKEY TO XRECORD-KEY (1). IX2114.2 +076600 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +076700 MOVE WRK-FD1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2114.2 +076800 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +076900 WRITE IX-FD1R1-F-G-240 IX2114.2 +077000 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2114.2 +077100 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +077200 WRITE-TEST-GF-01-2. IX2114.2 +077300 ADD 002 TO FD1-RECKEY-11-13. IX2114.2 +077400 ADD 002 TO FD1-ALTKEY1-11-13. IX2114.2 +077500 SUBTRACT 002 FROM FD1-ALTKEY2-11-13. IX2114.2 +077600 ADD 001 TO XRECORD-NUMBER (1). IX2114.2 +077700 MOVE WRK-FD1-RECKEY TO XRECORD-KEY (1). IX2114.2 +077800 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +077900 MOVE WRK-FD1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2114.2 +078000 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +078100 WRITE IX-FD1R1-F-G-240 IX2114.2 +078200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2114.2 +078300 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +078400 WRITE-TEST-GF-01. IX2114.2 +078500 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2114.2 +078600 GIVING RECORDS-WRITTEN. IX2114.2 +078700 MOVE 200 TO CORRECT-18V0. IX2114.2 +078800 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2114.2 +078900 IF RECORDS-WRITTEN EQUAL TO 200 IX2114.2 +079000 PERFORM PASS IX2114.2 +079100 ELSE IX2114.2 +079200 PERFORM FAIL. IX2114.2 +079300 MOVE "RECORDS IN FILE" TO RE-MARK. IX2114.2 +079400 GO TO WRITE-TEST-GF-01-END. IX2114.2 +079500 WRITE-DELETE-GF-01. IX2114.2 +079600 PERFORM DE-LETE. IX2114.2 +079700 WRITE-TEST-GF-01-END. IX2114.2 +079800 PERFORM PRINT-DETAIL. IX2114.2 +079900 CLOSE IX-FD1. IX2114.2 +080000 READ-INIT-F1-01. IX2114.2 +080100 OPEN INPUT IX-FD1. IX2114.2 +080200 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2114.2 +080300 MOVE "READ FILE IX-FD1" TO FEATURE. IX2114.2 +080400 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +080500 MOVE 02 TO RECKEY-NUM. IX2114.2 +080600 MOVE 002 TO ALTKEY1-NUM. IX2114.2 +080700 READ-TEST-F1-01-1. IX2114.2 +080800 READ IX-FD1 NEXT IX2114.2 +080900 AT END GO TO READ-TEST-F1-01. IX2114.2 +081000 MOVE IX-REC-KEY-AREA TO WRK-FD1-RECKEY. IX2114.2 +081100 MOVE IX-ALT-KEY1-AREA TO WRK-FD1-ALTKEY1. IX2114.2 +081200 IF FD1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2114.2 +081300 AND FD1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2114.2 +081400 NEXT SENTENCE IX2114.2 +081500 ELSE IX2114.2 +081600 PERFORM READ-FAIL-F1-01. IX2114.2 +081700 IF EXCUT-COUNTER-06V00 GREATER THAN 200 IX2114.2 +081800 GO TO READ-TEST-F1-01. IX2114.2 +081900 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +082000 ADD 002 TO RECKEY-NUM IX2114.2 +082100 ADD 002 TO ALTKEY1-NUM. IX2114.2 +082200 GO TO READ-TEST-F1-01-1. IX2114.2 +082300 READ-TEST-F1-01. IX2114.2 +082400 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2114.2 +082500 PERFORM PASS ELSE IX2114.2 +082600 PERFORM FAIL. IX2114.2 +082700 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2114.2 +082800 MOVE 200 TO CORRECT-18V0. IX2114.2 +082900 MOVE "RECORDS IN FILE" TO RE-MARK. IX2114.2 +083000 GO TO READ-EXIT-F1-01. IX2114.2 +083100 READ-FAIL-F1-01. IX2114.2 +083200 PERFORM FAIL. IX2114.2 +083300 MOVE FD1-RECKEY-11-13 TO COMPUTED-18V0. IX2114.2 +083400 MOVE RECKEY-NUM TO CORRECT-18V0. IX2114.2 +083500 MOVE "NUM EMBEDDED IN RECKEY; IX-28 READ; IX-41 WRITE" IX2114.2 +083600 TO RE-MARK. IX2114.2 +083700 READ-EXIT-F1-01. IX2114.2 +083800 PERFORM PRINT-DETAIL. IX2114.2 +083900 CLOSE IX-FD1. IX2114.2 +084000 READ-INIT-F1-02. IX2114.2 +084100 OPEN I-O IX-FD1. IX2114.2 +084200 MOVE "START & READ NEXT " TO FEATURE. IX2114.2 +084300 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2114.2 +084400 MOVE "SSSSSSSSTT364" TO FD1-RECKEY-1-13. IX2114.2 +084500 MOVE "WWWWWWWWXX364ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +084600 MOVE "FFFFFFFFEE036ALTKEY2" TO FD1-ALTKEY2-1-20. IX2114.2 +084700 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +084800 MOVE WRK-FD1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2114.2 +084900 MOVE WRK-FD1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2114.2 +085000 READ-TEST-F1-02. IX2114.2 +085100* IX2114.2 +085200* READ-TEST-F1-02 - THIS TEST READS A RECORD AND CHECKS THE IX2114.2 +085300* RECORD MADE AVAILABLE. THE PURPOSE IS TO IX2114.2 +085400* ESTABLISH IX-FD1-ALTKEY1 AS THE KEY OF REF- IX2114.2 +085500* ERENCE AND TO MAKE A RECORD AVAILABLE IX2114.2 +085600* FOR TESTING THE REWRITE STATEMENT IN THE IX2114.2 +085700* NEXT TEST. RECORD 182 (ALTERNATE KEY IX2114.2 +085800* "WWWWWWWWXX364ALTKEY1") IS EXPECTED TO BE IX2114.2 +085900* RETRIEVED. IX2114.2 +086000* IX2114.2 +086100 START IX-FD1 IX2114.2 +086200 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2114.2 +086300 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2114.2 +086400 GO TO READ-FAIL-F1-02. IX2114.2 +086500 READ IX-FD1 NEXT AT END IX2114.2 +086600 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +086700 GO TO READ-FAIL-F1-02. IX2114.2 +086800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +086900 IF XRECORD-NUMBER (1) EQUAL TO 182 IX2114.2 +087000 PERFORM PASS IX2114.2 +087100 GO TO READ-WRITE-F1-02. IX2114.2 +087200 READ-FAIL-F1-02. IX2114.2 +087300 PERFORM FAIL. IX2114.2 +087400 MOVE "RECORD 182 RETRIEVED" TO CORRECT-A. IX2114.2 +087500 MOVE "SEQUENTIAL READ; IX-28 4.5.2" TO RE-MARK. IX2114.2 +087600 READ-WRITE-F1-02. IX2114.2 +087700 PERFORM PRINT-DETAIL. IX2114.2 +087800 RWRT-TEST-GF-01. IX2114.2 +087900 MOVE "REWRITE " TO FEATURE. IX2114.2 +088000 MOVE "RWRT-TEST-GF-01 " TO PAR-NAME. IX2114.2 +088100* IX2114.2 +088200* RWRT-TEST-GF-01 - THE TEST MODIFIES THE CONTENTS OF ALTERNATE- IX2114.2 +088300* KEY1 OF THE RECORD RETRIEVED BY THE TEST IX2114.2 +088400* BEFORE AND REWRITES THE RECORD.THE NEW ALTER-IX2114.2 +088500* NATE KEY VALUE IS "WWWWWWXXXX369ALTKEY1" IX2114.2 +088600* WHICH BECOMES SEQUENTIAL RECORD NUMBER 184. IX2114.2 +088700* THE NEW KEY FOR THE FILE HAS A KEY VALUE IX2114.2 +088800* SEQUENTIALLY GREATER THAN THE RECORD VALUE IX2114.2 +088900* RETRIEVED FROM RECORD. THE SEQUENTIAL RECORD IX2114.2 +089000* RETRIEVED BEFORE THE REWRITE WAS NUMBER IX2114.2 +089100* 182. THE CURRENT RECORD POINTER FOR THE FILEIX2114.2 +089200* IS NOT EXPECTED TO BE MODIFIED BY IX2114.2 +089300* EXECUTION OF THE REWRITE. IX2114.2 +089400* IX2114.2 +089500 MOVE 182 TO ODO-NUMBER (1). IX2114.2 +089600 ADD 01 TO UPDATE-NUMBER (1). IX2114.2 +089700 MOVE "WWWWWWXXXX369ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +089800 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +089900 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +090000 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2114.2 +090100 MOVE "INVALID KEY REWRITE" TO COMPUTED-A IX2114.2 +090200 GO TO RWRT-FAIL-GF-01. IX2114.2 +090300 PERFORM PASS. IX2114.2 +090400 GO TO RWRT-WRITE-GF-01. IX2114.2 +090500 RWRT-FAIL-GF-01. IX2114.2 +090600 PERFORM FAIL. IX2114.2 +090700 MOVE "IX-33 4.6.2 " TO RE-MARK. IX2114.2 +090800 RWRT-WRITE-GF-01. IX2114.2 +090900 PERFORM PRINT-DETAIL. IX2114.2 +091000 READ-INIT-F1-03. IX2114.2 +091100 MOVE "READ NEXT AT END " TO FEATURE. IX2114.2 +091200 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2114.2 +091300 READ-TEST-F1-03. IX2114.2 +091400* IX2114.2 +091500* READ-TEST-F1-03 - THIS TEST PERFORMS A SEQUENTIAL READ AND IX2114.2 +091600* CHECKS THE RECORD MADE AVAILABLE. THE KEY OFIX2114.2 +091700* REFERENCE IS EXPECTED TO BE THAT ESTABLISHED IX2114.2 +091800* BEFORE. THE LOGICAL RECORD IX2114.2 +091900* RETRIEVED IS EXPECTED TO BE THAT RECORD THAT IX2114.2 +092000* WOULD HAVE BEEN RETRIEVED HAD THE ALTERNATE IX2114.2 +092100* KEY NOT BEEN CHANGE BY THE REWRITE IN IX2114.2 +092200* RWRT-TEST-GF-01. IX2114.2 +092300* IX2114.2 +092400 READ IX-FD1 NEXT AT END IX2114.2 +092500 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +092600 GO TO READ-FAIL-F1-03. IX2114.2 +092700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +092800 IF XRECORD-NUMBER (1) EQUAL TO 183 IX2114.2 +092900 PERFORM PASS IX2114.2 +093000 GO TO READ-WRITE-F1-03. IX2114.2 +093100 MOVE 58 TO RECNO. IX2114.2 +093200 PERFORM DISPLAY-ALTERNATE-KEY1. IX2114.2 +093300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2114.2 +093400 READ-FAIL-F1-03. IX2114.2 +093500 PERFORM FAIL. IX2114.2 +093600 MOVE 183 TO CORRECT-18V0. IX2114.2 +093700 MOVE "RECORD NUMBER; IX-28" TO RE-MARK. IX2114.2 +093800 READ-WRITE-F1-03. IX2114.2 +093900 PERFORM PRINT-DETAIL. IX2114.2 +094000 READ-INIT-F1-04. IX2114.2 +094100 MOVE "READ NEXT 4 RECS " TO FEATURE. IX2114.2 +094200 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2114.2 +094300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +094400 MOVE 183 TO RECKEY-NUM. IX2114.2 +094500 READ-TEST-F1-04. IX2114.2 +094600* IX2114.2 +094700* READ-TEST-F1-04 - THE TEST SEQUENTIALLY READS THE NEXT 4 REC- IX2114.2 +094800* ORDS AND CHECKS THE RECORD NUMBER FIELD OF IX2114.2 +094900* EACH RECORD RETRIEVED. THE CONTENTS OF IX2114.2 +095000* THE RECORD NUMBER FIELD IS EXPECTED TO BE IX2114.2 +095100* 184, 182, 185 AND 186 (ALTERNATE KEY VALUES IX2114.2 +095200* WWWWWWXXXX368ALTKEY1 THROUGH WWWXXXXXXX372 IX2114.2 +095300* ALTKEY1 RESPECTIVELY). THE RECORD IN WHICH IX2114.2 +095400* THE ALTERNATE KEY VALUE WAS CHANGED TO IX2114.2 +095500* WWWWWWXXXX369ALTKEY1 (SEQUENTIAL RECORD 184 IX2114.2 +095600* AFTER THE REORDING OCCURS I.E, AS A RESULT OFIX2114.2 +095700* CHANGING THE ALTERNATE KEY VALUE IN IX2114.2 +095800* RWRT-TEST-GF-01) SHOULD BE MADE AVAILABLE. IX2114.2 +095900* IX2114.2 +096000 READ IX-FD1 NEXT AT END IX2114.2 +096100 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +096200 MOVE "SUCCESSFUL READ" TO CORRECT-A IX2114.2 +096300 GO TO READ-FAIL-F1-04. IX2114.2 +096400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +096500 IF EXCUT-COUNTER-06V00 EQUAL TO 1 IX2114.2 +096600 MOVE 182 TO RECKEY-NUM ELSE IX2114.2 +096700 ADD 001 TO RECKEY-NUM. IX2114.2 +096800 IF XRECORD-NUMBER (1) NOT EQUAL TO RECKEY-NUM IX2114.2 +096900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +097000 MOVE RECKEY-NUM TO CORRECT-18V0 IX2114.2 +097100 GO TO READ-FAIL-F1-04. IX2114.2 +097200 IF EXCUT-COUNTER-06V00 EQUAL TO 1 IX2114.2 +097300 MOVE 184 TO RECKEY-NUM. IX2114.2 +097400 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +097500 IF EXCUT-COUNTER-06V00 NOT LESS THAN 4 IX2114.2 +097600 PERFORM PASS IX2114.2 +097700 GO TO READ-WRITE-F1-04. IX2114.2 +097800 GO TO READ-TEST-F1-04. IX2114.2 +097900 READ-FAIL-F1-04. IX2114.2 +098000 PERFORM FAIL. IX2114.2 +098100 MOVE "IX-28, IX-32" TO RE-MARK. IX2114.2 +098200 READ-WRITE-F1-04. IX2114.2 +098300 PERFORM PRINT-DETAIL. IX2114.2 +098400 CLOSE IX-FD1. IX2114.2 +098500 IX2114.2 +098600 IX2114.2 +098700 READ-INIT-F1-004. IX2114.2 +098800 OPEN INPUT IX-FD1. IX2114.2 +098900 MOVE "READ UPDATED ALTKEY" TO FEATURE. IX2114.2 +099000 MOVE "READ-TEST-F1-004" TO PAR-NAME. IX2114.2 +099100 MOVE "SSSSSSSSSS360" TO FD1-RECKEY-1-13. IX2114.2 +099200 MOVE "WWWWWWWWWW360ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +099300 MOVE "FFFFFFFFFF040ALTKEY2" TO FD1-ALTKEY2-1-20. IX2114.2 +099400 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +099500 MOVE WRK-FD1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2114.2 +099600 MOVE WRK-FD1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2114.2 +099700 MOVE 180 TO RECKEY-NUM. IX2114.2 +099800 START IX-FD1 IX2114.2 +099900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2114.2 +100000 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2114.2 +100100 GO TO READ-FAIL-004. IX2114.2 +100200 MOVE 179 TO RECKEY-NUM. IX2114.2 +100300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +100400 MOVE 4 TO REC-CT. IX2114.2 +100500 READ-TEST-F1. IX2114.2 +100600 ADD 1 TO REC-CT. IX2114.2 +100700 MOVE "READ UPDATED RECS " TO FEATURE. IX2114.2 +100800 MOVE "READ-TEST-F1- " TO PAR-NAME. IX2114.2 +100900* IX2114.2 +101000*READ-TEST-F1-04 - THIS TEST READS THAT SEGMENT OF THE FILE IX2114.2 +101100* UPDATED IN THE FIRST 4 TESTS AND CHECKS THE NEWIX2114.2 +101200* SEQUENTIAL ORDER OF THE RECORDS. THE SEQUENTIALIX2114.2 +101300* RETRIEVAL OF THE RECORDS FROM THE FILE IS IX2114.2 +101400* EXPECTED TO REFLECT THE UPDATED KEY SEQUENCE. IX2114.2 +101500* THE START STATEMENT IX2114.2 +101600* EXTABLISHES ALTERNATE KEY1 AS THE KEY OF REF- IX2114.2 +101700* ERENCE AND CURRENT RECORD POINTER TO POINT TO IX2114.2 +101800* RELATIVE RECORD NUMBER 180 (ALTERNATE-KEY1 IX2114.2 +101900* VALUE WWWWWWWWWW360ALTKEY1 BEFORE THE FILE IX2114.2 +102000* READING BEGINS. IX2114.2 +102100* IX2114.2 +102200 ADD 001 TO RECKEY-NUM. IX2114.2 +102300 READ IX-FD1 NEXT AT END IX2114.2 +102400 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +102500 GO TO READ-FAIL-004. IX2114.2 +102600 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +102700 IF RECKEY-NUM EQUAL TO 182 IX2114.2 +102800 MOVE "YES" TO ADJUSTED-NUM IX2114.2 +102900 ADD 001 TO RECKEY-NUM. IX2114.2 +103000* IX2114.2 +103100* THE ABOVE IF STATEMENT ADJUSTS THE RECKEY-NUM TO ACCOUNT IX2114.2 +103200* FOR THE VOID LEFT IN THE NUMBERING SEQUENCE WHEN THE RECORD IX2114.2 +103300* WAS REWRITTEN WITH A NEW ALTERNATE KEY. THE RELATIVE IX2114.2 +103400* RETREIVAL POSITION OF THE RECORD IN THE FILE SHOULD HAVE IX2114.2 +103500* CHANGED FROM 182 TO 184. IX2114.2 +103600* IX2114.2 +103700 IF RECKEY-NUM EQUAL TO 185 IX2114.2 +103800 AND ADJUSTED-NUM EQUAL TO "YES" IX2114.2 +103900 MOVE "NO" TO ADJUSTED-NUM IX2114.2 +104000 SUBTRACT 001 FROM RECKEY-NUM IX2114.2 +104100* IX2114.2 +104200* THE SUBTRACT STATEMENT IS TO READJUST RECKEY-NUM FOR IX2114.2 +104300* INSERTED RECORD CAUSED BY UPDATE OF ALTERNATE KEY IN IX2114.2 +104400* THE RECORD. THE SEQUENTIAL RETRIEVAL POSITION OF UPDATED IX2114.2 +104500* RECORD SHOULD BE POSITION NUMBER 184. IX2114.2 +104600* IX2114.2 +104700 PERFORM READ-TEST-004-1 IX2114.2 +104800 ADD 001 TO EXCUT-COUNTER-06V00 IX2114.2 +104900 GO TO READ-TEST-F1. IX2114.2 +105000 IF XRECORD-NUMBER (1) EQUAL TO RECKEY-NUM IX2114.2 +105100 PERFORM READ-PASS-004 IX2114.2 +105200 ELSE IX2114.2 +105300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +105400 PERFORM READ-FAIL-004. IX2114.2 +105500 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +105600 IF EXCUT-COUNTER-06V00 LESS THAN 11 IX2114.2 +105700 GO TO READ-TEST-F1. IX2114.2 +105800 GO TO READ-END-004. IX2114.2 +105900 READ-TEST-004-1. IX2114.2 +106000 IF XRECORD-NUMBER (1) EQUAL TO 182 IX2114.2 +106100 PERFORM READ-PASS-004 IX2114.2 +106200 ELSE IX2114.2 +106300 MOVE "WWWWWWXXXX369ALTKEY1" TO CORRECT-A IX2114.2 +106400 MOVE ALTERNATE-KEY1 (1) TO WRK-FD1-ALTKEY1 IX2114.2 +106500 MOVE FD1-ALTKEY1-1-20 TO COMPUTED-A IX2114.2 +106600 MOVE SPACE TO P-OR-F IX2114.2 +106700 MOVE "ALTERNATE RECORD KEY1 VALUES; IX-33" TO RE-MARKIX2114.2 +106800 PERFORM PRINT-DETAIL IX2114.2 +106900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +107000 MOVE 182 TO CORRECT-18V0 IX2114.2 +107100 PERFORM FAIL IX2114.2 +107200 PERFORM PRINT-DETAIL. IX2114.2 +107300 READ-PASS-004. IX2114.2 +107400 PERFORM PASS IX2114.2 +107500 PERFORM PRINT-DETAIL. IX2114.2 +107600 READ-FAIL-004. IX2114.2 +107700 PERFORM FAIL. IX2114.2 +107800 MOVE RECKEY-NUM TO CORRECT-18V0. IX2114.2 +107900 MOVE "RECORD NUMBER; IX-28, IX-33 " TO RE-MARK. IX2114.2 +108000 PERFORM PRINT-DETAIL. IX2114.2 +108100 READ-END-004. IX2114.2 +108200 CLOSE IX-FD1. IX2114.2 +108300 IX2114.2 +108400 GO TO CCVS-EXIT. IX2114.2 +108500 IX2114.2 +108600 IX2114.2 +108700 INX-INITIALIZE-RECORD. IX2114.2 +108800 MOVE "GGGGGGGGGG200" TO FD1-RECKEY-1-13. IX2114.2 +108900 MOVE ZERO TO INIT-FLAG. IX2114.2 +109000 MOVE 9999 TO XRECORD-NUMBER (1). IX2114.2 +109100 MOVE SPACE TO IX-FD1R1-F-G-240. IX2114.2 +109200 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +109300 START IX-FD1 IX2114.2 +109400 KEY IS EQUAL TO IX-FD1-KEY IX2114.2 +109500 INVALID KEY MOVE 1 TO INIT-FLAG. IX2114.2 +109600 READ IX-FD1 NEXT INTO FILE-RECORD-INFO (1) IX2114.2 +109700 AT END MOVE 1 TO INIT-FLAG. IX2114.2 +109800 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2114.2 +109900 MOVE 1 TO INIT-FLAG. IX2114.2 +110000 DISPLAY-RECORD-KEYS. IX2114.2 +110100 MOVE XRECORD-KEY (1) TO WRK-FD1-RECKEY. IX2114.2 +110200 MOVE FD1-RECKEY-1-13 TO COMPUTED-A. IX2114.2 +110300 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2114.2 +110400 MOVE SPACE TO P-OR-F. IX2114.2 +110500 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2114.2 +110600 PERFORM PRINT-DETAIL. IX2114.2 +110700 DISPLAY-ALTERNATE-KEY1. IX2114.2 +110800 MOVE ALTERNATE-KEY1 (1) TO WRK-FD1-ALTKEY1. IX2114.2 +110900 MOVE FD1-ALTKEY1-1-20 TO COMPUTED-A. IX2114.2 +111000 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2114.2 +111100 MOVE SPACE TO P-OR-F. IX2114.2 +111200 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2114.2 +111300 PERFORM PRINT-DETAIL. IX2114.2 +111400 DISPLAY-ALTERNATE-KEY2. IX2114.2 +111500 MOVE ALTERNATE-KEY2 (1) TO WRK-FD1-ALTKEY2. IX2114.2 +111600 MOVE FD1-ALTKEY2-1-20 TO COMPUTED-A. IX2114.2 +111700 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2114.2 +111800 MOVE SPACE TO P-OR-F. IX2114.2 +111900 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2114.2 +112000 PERFORM PRINT-DETAIL. IX2114.2 +112100 IX2114.2 +112200 IX2114.2 +112300 CCVS-EXIT SECTION. IX2114.2 +112400 CCVS-999999. IX2114.2 +112500 GO TO CLOSE-FILES. IX2114.2 +*END-OF,IX211A +*HEADER,COBOL,IX212A +000100 IDENTIFICATION DIVISION. IX2124.2 +000200 PROGRAM-ID. IX2124.2 +000300 IX212A. IX2124.2 +000400**************************************************************** IX2124.2 +000500* * IX2124.2 +000600* VALIDATION FOR:- * IX2124.2 +000700* * IX2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +000900* * IX2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2124.2 +001100* * IX2124.2 +001200**************************************************************** IX2124.2 +001300* * IX2124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2124.2 +001500* * IX2124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2124.2 +001900* * IX2124.2 +002000**************************************************************** IX2124.2 +002100* * IX2124.2 +002200* THIS IS IX212A. IX2124.2 +002300* THIS PROGRAM CREATES A 100 RECORD FIXED LENGTH INDEXED IX2124.2 +002400* FILE WHOSE ACCESS IS DYNAMIC AND CONTAINS 10 ALTERNATE IX2124.2 +002500* KEYS. THE INDEXED FILE IS MANIPULATED BY THE ALTERNATE KEYS IX2124.2 +002600* USING THE FOLLOWING VERBS: IX2124.2 +002700* . DELETE IX2124.2 +002800* . READ ... NEXT RECORD IX2124.2 +002900* . READ ... RECORD KEY IX2124.2 +003000* . REWRITE IX2124.2 +003100* . START IX2124.2 +003200* IX2124.2 +003300 ENVIRONMENT DIVISION. IX2124.2 +003400 CONFIGURATION SECTION. IX2124.2 +003500 SOURCE-COMPUTER. IX2124.2 +003600 XXXXX082. IX2124.2 +003700 OBJECT-COMPUTER. IX2124.2 +003800 XXXXX083. IX2124.2 +003900 INPUT-OUTPUT SECTION. IX2124.2 +004000 FILE-CONTROL. IX2124.2 +004100P SELECT RAW-DATA ASSIGN TO IX2124.2 +004200P XXXXX062 IX2124.2 +004300P ORGANIZATION IS INDEXED IX2124.2 +004400P ACCESS MODE IS RANDOM IX2124.2 +004500P RECORD KEY IS RAW-DATA-KEY. IX2124.2 +004600 SELECT PRINT-FILE ASSIGN TO IX2124.2 +004700 XXXXX055. IX2124.2 +004800 SELECT IX-FS1 IX2124.2 +004900 ASSIGN TO IX2124.2 +005000 XXXXX024 IX2124.2 +005100J XXXXX044 IX2124.2 +005200 ACCESS MODE IS DYNAMIC IX2124.2 +005300 RECORD KEY IS IX-FS1-KEY IX2124.2 +005400 ALTERNATE RECORD KEY IS IX-FS1-ALT01 IX2124.2 +005500 ALTERNATE RECORD KEY IS IX-FS1-ALT02 IX2124.2 +005600 ALTERNATE RECORD KEY IS IX-FS1-ALT03 IX2124.2 +005700 ALTERNATE RECORD KEY IS IX-FS1-ALT04 IX2124.2 +005800 ALTERNATE RECORD KEY IS IX-FS1-ALT05 IX2124.2 +005900 ALTERNATE RECORD KEY IS IX-FS1-ALT06 IX2124.2 +006000 ALTERNATE RECORD KEY IS IX-FS1-ALT07 IX2124.2 +006100 ALTERNATE RECORD KEY IS IX-FS1-ALT08 IX2124.2 +006200 ALTERNATE RECORD KEY IS IX-FS1-ALT09 IX2124.2 +006300 ALTERNATE RECORD KEY IS IX-FS1-ALT10 IX2124.2 +006400 ORGANIZATION IS INDEXED. IX2124.2 +006500 DATA DIVISION. IX2124.2 +006600 FILE SECTION. IX2124.2 +006700P IX2124.2 +006800PFD RAW-DATA. IX2124.2 +006900P IX2124.2 +007000P01 RAW-DATA-SATZ. IX2124.2 +007100P 05 RAW-DATA-KEY PIC X(6). IX2124.2 +007200P 05 C-DATE PIC 9(6). IX2124.2 +007300P 05 C-TIME PIC 9(8). IX2124.2 +007400P 05 C-NO-OF-TESTS PIC 99. IX2124.2 +007500P 05 C-OK PIC 999. IX2124.2 +007600P 05 C-ALL PIC 999. IX2124.2 +007700P 05 C-FAIL PIC 999. IX2124.2 +007800P 05 C-DELETED PIC 999. IX2124.2 +007900P 05 C-INSPECT PIC 999. IX2124.2 +008000P 05 C-NOTE PIC X(13). IX2124.2 +008100P 05 C-INDENT PIC X. IX2124.2 +008200P 05 C-ABORT PIC X(8). IX2124.2 +008300 FD PRINT-FILE. IX2124.2 +008400 01 PRINT-REC PICTURE X(120). IX2124.2 +008500 01 DUMMY-RECORD PICTURE X(120). IX2124.2 +008600 FD IX-FS1 IX2124.2 +008700C LABEL RECORDS ARE STANDARD IX2124.2 +008800C DATA RECORD IS IX-FS1-RECORD IX2124.2 +008900 RECORD CONTAINS 116 CHARACTERS. IX2124.2 +009000 01 IX-FS1-RECORD. IX2124.2 +009100 02 IX-FS1-KEY PIC X(6). IX2124.2 +009200 02 IX-FS1-ALT01 PIC X(11). IX2124.2 +009300 02 IX-FS1-ALT02 PIC X(11). IX2124.2 +009400 02 IX-FS1-ALT03 PIC X(11). IX2124.2 +009500 02 IX-FS1-ALT04 PIC X(11). IX2124.2 +009600 02 IX-FS1-ALT05 PIC X(11). IX2124.2 +009700 02 IX-FS1-ALT06 PIC X(11). IX2124.2 +009800 02 IX-FS1-ALT07 PIC X(11). IX2124.2 +009900 02 IX-FS1-ALT08 PIC X(11). IX2124.2 +010000 02 IX-FS1-ALT09 PIC X(11). IX2124.2 +010100 02 IX-FS1-ALT10 PIC X(11). IX2124.2 +010200 WORKING-STORAGE SECTION. IX2124.2 +010300 01 RECORD-COUNTER PIC 999 VALUE ZEROS. IX2124.2 +010400 01 INVKEY-COUNTER PIC 999 VALUE ZEROS. IX2124.2 +010500 01 WORK-RECORD. IX2124.2 +010600 02 FILLER PIC XXX VALUE "AAA". IX2124.2 +010700 02 COUNTER00 PIC 999. IX2124.2 +010800 02 FILLER PIC XXX VALUE "CCC". IX2124.2 +010900 02 COUNTER01 PIC 999. IX2124.2 +011000 02 FILLER PIC X(5) VALUE "ALT01". IX2124.2 +011100 02 FILLER PIC XXX VALUE "EEE". IX2124.2 +011200 02 COUNTER02 PIC 999. IX2124.2 +011300 02 FILLER PIC X(5) VALUE "ALT02". IX2124.2 +011400 02 FILLER PIC XXX VALUE "GGG". IX2124.2 +011500 02 COUNTER03 PIC 999. IX2124.2 +011600 02 FILLER PIC X(5) VALUE "ALT03". IX2124.2 +011700 02 FILLER PIC XXX VALUE "III". IX2124.2 +011800 02 COUNTER04 PIC 999. IX2124.2 +011900 02 FILLER PIC X(5) VALUE "ALT04". IX2124.2 +012000 02 FILLER PIC XXX VALUE "KKK". IX2124.2 +012100 02 COUNTER05 PIC 999. IX2124.2 +012200 02 FILLER PIC X(5) VALUE "ALT05". IX2124.2 +012300 02 FILLER PIC XXX VALUE "MMM". IX2124.2 +012400 02 COUNTER06 PIC 999. IX2124.2 +012500 02 FILLER PIC X(5) VALUE "ALT06". IX2124.2 +012600 02 FILLER PIC XXX VALUE "OOO". IX2124.2 +012700 02 COUNTER07 PIC 999. IX2124.2 +012800 02 FILLER PIC X(5) VALUE "ALT07". IX2124.2 +012900 02 FILLER PIC XXX VALUE "QQQ". IX2124.2 +013000 02 COUNTER08 PIC 999. IX2124.2 +013100 02 FILLER PIC X(5) VALUE "ALT08". IX2124.2 +013200 02 FILLER PIC XXX VALUE "SSS". IX2124.2 +013300 02 COUNTER09 PIC 999. IX2124.2 +013400 02 FILLER PIC X(5) VALUE "ALT09". IX2124.2 +013500 02 FILLER PIC XXX VALUE "UUU". IX2124.2 +013600 02 COUNTER10 PIC 999. IX2124.2 +013700 02 FILLER PIC X(5) VALUE "ALT10". IX2124.2 +013800 01 TEST-RESULTS. IX2124.2 +013900 02 FILLER PIC X VALUE SPACE. IX2124.2 +014000 02 FEATURE PIC X(20) VALUE SPACE. IX2124.2 +014100 02 FILLER PIC X VALUE SPACE. IX2124.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. IX2124.2 +014300 02 FILLER PIC X VALUE SPACE. IX2124.2 +014400 02 PAR-NAME. IX2124.2 +014500 03 FILLER PIC X(19) VALUE SPACE. IX2124.2 +014600 03 PARDOT-X PIC X VALUE SPACE. IX2124.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. IX2124.2 +014800 02 FILLER PIC X(8) VALUE SPACE. IX2124.2 +014900 02 RE-MARK PIC X(61). IX2124.2 +015000 01 TEST-COMPUTED. IX2124.2 +015100 02 FILLER PIC X(30) VALUE SPACE. IX2124.2 +015200 02 FILLER PIC X(17) VALUE IX2124.2 +015300 " COMPUTED=". IX2124.2 +015400 02 COMPUTED-X. IX2124.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2124.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A IX2124.2 +015700 PIC -9(9).9(9). IX2124.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2124.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2124.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2124.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. IX2124.2 +016200 04 COMPUTED-18V0 PIC -9(18). IX2124.2 +016300 04 FILLER PIC X. IX2124.2 +016400 03 FILLER PIC X(50) VALUE SPACE. IX2124.2 +016500 01 TEST-CORRECT. IX2124.2 +016600 02 FILLER PIC X(30) VALUE SPACE. IX2124.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". IX2124.2 +016800 02 CORRECT-X. IX2124.2 +016900 03 CORRECT-A PIC X(20) VALUE SPACE. IX2124.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2124.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2124.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2124.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2124.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. IX2124.2 +017500 04 CORRECT-18V0 PIC -9(18). IX2124.2 +017600 04 FILLER PIC X. IX2124.2 +017700 03 FILLER PIC X(2) VALUE SPACE. IX2124.2 +017800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2124.2 +017900 01 CCVS-C-1. IX2124.2 +018000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2124.2 +018100- "SS PARAGRAPH-NAME IX2124.2 +018200- " REMARKS". IX2124.2 +018300 02 FILLER PIC X(20) VALUE SPACE. IX2124.2 +018400 01 CCVS-C-2. IX2124.2 +018500 02 FILLER PIC X VALUE SPACE. IX2124.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". IX2124.2 +018700 02 FILLER PIC X(15) VALUE SPACE. IX2124.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". IX2124.2 +018900 02 FILLER PIC X(94) VALUE SPACE. IX2124.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2124.2 +019100 01 REC-CT PIC 99 VALUE ZERO. IX2124.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2124.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2124.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2124.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2124.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2124.2 +020100 01 CCVS-H-1. IX2124.2 +020200 02 FILLER PIC X(39) VALUE SPACES. IX2124.2 +020300 02 FILLER PIC X(42) VALUE IX2124.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2124.2 +020500 02 FILLER PIC X(39) VALUE SPACES. IX2124.2 +020600 01 CCVS-H-2A. IX2124.2 +020700 02 FILLER PIC X(40) VALUE SPACE. IX2124.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2124.2 +020900 02 FILLER PIC XXXX VALUE IX2124.2 +021000 "4.2 ". IX2124.2 +021100 02 FILLER PIC X(28) VALUE IX2124.2 +021200 " COPY - NOT FOR DISTRIBUTION". IX2124.2 +021300 02 FILLER PIC X(41) VALUE SPACE. IX2124.2 +021400 IX2124.2 +021500 01 CCVS-H-2B. IX2124.2 +021600 02 FILLER PIC X(15) VALUE IX2124.2 +021700 "TEST RESULT OF ". IX2124.2 +021800 02 TEST-ID PIC X(9). IX2124.2 +021900 02 FILLER PIC X(4) VALUE IX2124.2 +022000 " IN ". IX2124.2 +022100 02 FILLER PIC X(12) VALUE IX2124.2 +022200 " HIGH ". IX2124.2 +022300 02 FILLER PIC X(22) VALUE IX2124.2 +022400 " LEVEL VALIDATION FOR ". IX2124.2 +022500 02 FILLER PIC X(58) VALUE IX2124.2 +022600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +022700 01 CCVS-H-3. IX2124.2 +022800 02 FILLER PIC X(34) VALUE IX2124.2 +022900 " FOR OFFICIAL USE ONLY ". IX2124.2 +023000 02 FILLER PIC X(58) VALUE IX2124.2 +023100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2124.2 +023200 02 FILLER PIC X(28) VALUE IX2124.2 +023300 " COPYRIGHT 1985 ". IX2124.2 +023400 01 CCVS-E-1. IX2124.2 +023500 02 FILLER PIC X(52) VALUE SPACE. IX2124.2 +023600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2124.2 +023700 02 ID-AGAIN PIC X(9). IX2124.2 +023800 02 FILLER PIC X(45) VALUE SPACES. IX2124.2 +023900 01 CCVS-E-2. IX2124.2 +024000 02 FILLER PIC X(31) VALUE SPACE. IX2124.2 +024100 02 FILLER PIC X(21) VALUE SPACE. IX2124.2 +024200 02 CCVS-E-2-2. IX2124.2 +024300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2124.2 +024400 03 FILLER PIC X VALUE SPACE. IX2124.2 +024500 03 ENDER-DESC PIC X(44) VALUE IX2124.2 +024600 "ERRORS ENCOUNTERED". IX2124.2 +024700 01 CCVS-E-3. IX2124.2 +024800 02 FILLER PIC X(22) VALUE IX2124.2 +024900 " FOR OFFICIAL USE ONLY". IX2124.2 +025000 02 FILLER PIC X(12) VALUE SPACE. IX2124.2 +025100 02 FILLER PIC X(58) VALUE IX2124.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +025300 02 FILLER PIC X(13) VALUE SPACE. IX2124.2 +025400 02 FILLER PIC X(15) VALUE IX2124.2 +025500 " COPYRIGHT 1985". IX2124.2 +025600 01 CCVS-E-4. IX2124.2 +025700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2124.2 +025800 02 FILLER PIC X(4) VALUE " OF ". IX2124.2 +025900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2124.2 +026000 02 FILLER PIC X(40) VALUE IX2124.2 +026100 " TESTS WERE EXECUTED SUCCESSFULLY". IX2124.2 +026200 01 XXINFO. IX2124.2 +026300 02 FILLER PIC X(19) VALUE IX2124.2 +026400 "*** INFORMATION ***". IX2124.2 +026500 02 INFO-TEXT. IX2124.2 +026600 04 FILLER PIC X(8) VALUE SPACE. IX2124.2 +026700 04 XXCOMPUTED PIC X(20). IX2124.2 +026800 04 FILLER PIC X(5) VALUE SPACE. IX2124.2 +026900 04 XXCORRECT PIC X(20). IX2124.2 +027000 02 INF-ANSI-REFERENCE PIC X(48). IX2124.2 +027100 01 HYPHEN-LINE. IX2124.2 +027200 02 FILLER PIC IS X VALUE IS SPACE. IX2124.2 +027300 02 FILLER PIC IS X(65) VALUE IS "************************IX2124.2 +027400- "*****************************************". IX2124.2 +027500 02 FILLER PIC IS X(54) VALUE IS "************************IX2124.2 +027600- "******************************". IX2124.2 +027700 01 CCVS-PGM-ID PIC X(9) VALUE IX2124.2 +027800 "IX212A". IX2124.2 +027900 PROCEDURE DIVISION. IX2124.2 +028000 CCVS1 SECTION. IX2124.2 +028100 OPEN-FILES. IX2124.2 +028200P OPEN I-O RAW-DATA. IX2124.2 +028300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2124.2 +028400P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2124.2 +028500P MOVE "ABORTED " TO C-ABORT. IX2124.2 +028600P ADD 1 TO C-NO-OF-TESTS. IX2124.2 +028700P ACCEPT C-DATE FROM DATE. IX2124.2 +028800P ACCEPT C-TIME FROM TIME. IX2124.2 +028900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2124.2 +029000PEND-E-1. IX2124.2 +029100P CLOSE RAW-DATA. IX2124.2 +029200 OPEN OUTPUT PRINT-FILE. IX2124.2 +029300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2124.2 +029400 MOVE SPACE TO TEST-RESULTS. IX2124.2 +029500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2124.2 +029600 GO TO CCVS1-EXIT. IX2124.2 +029700 CLOSE-FILES. IX2124.2 +029800P OPEN I-O RAW-DATA. IX2124.2 +029900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2124.2 +030000P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2124.2 +030100P MOVE "OK. " TO C-ABORT. IX2124.2 +030200P MOVE PASS-COUNTER TO C-OK. IX2124.2 +030300P MOVE ERROR-HOLD TO C-ALL. IX2124.2 +030400P MOVE ERROR-COUNTER TO C-FAIL. IX2124.2 +030500P MOVE DELETE-COUNTER TO C-DELETED. IX2124.2 +030600P MOVE INSPECT-COUNTER TO C-INSPECT. IX2124.2 +030700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2124.2 +030800PEND-E-2. IX2124.2 +030900P CLOSE RAW-DATA. IX2124.2 +031000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2124.2 +031100 TERMINATE-CCVS. IX2124.2 +031200S EXIT PROGRAM. IX2124.2 +031300STERMINATE-CALL. IX2124.2 +031400 STOP RUN. IX2124.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2124.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2124.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2124.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2124.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. IX2124.2 +032000 PRINT-DETAIL. IX2124.2 +032100 IF REC-CT NOT EQUAL TO ZERO IX2124.2 +032200 MOVE "." TO PARDOT-X IX2124.2 +032300 MOVE REC-CT TO DOTVALUE. IX2124.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2124.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2124.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2124.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2124.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2124.2 +032900 MOVE SPACE TO CORRECT-X. IX2124.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2124.2 +033100 MOVE SPACE TO RE-MARK. IX2124.2 +033200 HEAD-ROUTINE. IX2124.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +033400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +033500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2124.2 +033600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2124.2 +033700 COLUMN-NAMES-ROUTINE. IX2124.2 +033800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +033900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +034100 END-ROUTINE. IX2124.2 +034200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2124.2 +034300 END-RTN-EXIT. IX2124.2 +034400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +034500 END-ROUTINE-1. IX2124.2 +034600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2124.2 +034700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2124.2 +034800 ADD PASS-COUNTER TO ERROR-HOLD. IX2124.2 +034900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2124.2 +035000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2124.2 +035100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2124.2 +035200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2124.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2124.2 +035400 END-ROUTINE-12. IX2124.2 +035500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2124.2 +035600 IF ERROR-COUNTER IS EQUAL TO ZERO IX2124.2 +035700 MOVE "NO " TO ERROR-TOTAL IX2124.2 +035800 ELSE IX2124.2 +035900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2124.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2124.2 +036100 PERFORM WRITE-LINE. IX2124.2 +036200 END-ROUTINE-13. IX2124.2 +036300 IF DELETE-COUNTER IS EQUAL TO ZERO IX2124.2 +036400 MOVE "NO " TO ERROR-TOTAL ELSE IX2124.2 +036500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2124.2 +036600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2124.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +036800 IF INSPECT-COUNTER EQUAL TO ZERO IX2124.2 +036900 MOVE "NO " TO ERROR-TOTAL IX2124.2 +037000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2124.2 +037100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2124.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +037300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +037400 WRITE-LINE. IX2124.2 +037500 ADD 1 TO RECORD-COUNT. IX2124.2 +037600Y IF RECORD-COUNT GREATER 42 IX2124.2 +037700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2124.2 +037800Y MOVE SPACE TO DUMMY-RECORD IX2124.2 +037900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2124.2 +038000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2124.2 +038100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2124.2 +038200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2124.2 +038300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2124.2 +038400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2124.2 +038800Y MOVE ZERO TO RECORD-COUNT. IX2124.2 +038900 PERFORM WRT-LN. IX2124.2 +039000 WRT-LN. IX2124.2 +039100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2124.2 +039200 MOVE SPACE TO DUMMY-RECORD. IX2124.2 +039300 BLANK-LINE-PRINT. IX2124.2 +039400 PERFORM WRT-LN. IX2124.2 +039500 FAIL-ROUTINE. IX2124.2 +039600 IF COMPUTED-X NOT EQUAL TO SPACE IX2124.2 +039700 GO TO FAIL-ROUTINE-WRITE. IX2124.2 +039800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2124.2 +039900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2124.2 +040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2124.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +040200 MOVE SPACES TO INF-ANSI-REFERENCE. IX2124.2 +040300 GO TO FAIL-ROUTINE-EX. IX2124.2 +040400 FAIL-ROUTINE-WRITE. IX2124.2 +040500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2124.2 +040600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2124.2 +040700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2124.2 +040800 MOVE SPACES TO COR-ANSI-REFERENCE. IX2124.2 +040900 FAIL-ROUTINE-EX. EXIT. IX2124.2 +041000 BAIL-OUT. IX2124.2 +041100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2124.2 +041200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2124.2 +041300 BAIL-OUT-WRITE. IX2124.2 +041400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2124.2 +041500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2124.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. IX2124.2 +041800 BAIL-OUT-EX. EXIT. IX2124.2 +041900 CCVS1-EXIT. IX2124.2 +042000 EXIT. IX2124.2 +042100 WRITE-INIT-GF-01. IX2124.2 +042200 OPEN OUTPUT IX-FS1. IX2124.2 +042300 PERFORM CREATE-IX-FS1 VARYING RECORD-COUNTER FROM 1 BY 1 IX2124.2 +042400 UNTIL RECORD-COUNTER IS GREATER THAN 100. IX2124.2 +042500 GO TO WRITE-TEST-GF-01. IX2124.2 +042600 CREATE-IX-FS1. IX2124.2 +042700 MOVE RECORD-COUNTER TO COUNTER00, COUNTER01, COUNTER02, IX2124.2 +042800 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2124.2 +042900 COUNTER08, COUNTER09, COUNTER10. IX2124.2 +043000 WRITE IX-FS1-RECORD FROM WORK-RECORD INVALID KEY IX2124.2 +043100 ADD 1 TO INVKEY-COUNTER. IX2124.2 +043200 WRITE-TEST-GF-01. IX2124.2 +043300 MOVE "WRITE INVALID KEY" TO FEATURE. IX2124.2 +043400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2124.2 +043500 MOVE "CREATE IX-FS1" TO RE-MARK. IX2124.2 +043600 IF INVKEY-COUNTER = 0 IX2124.2 +043700 PERFORM PASS IX2124.2 +043800 ELSE GO TO WRITE-FAIL-GF-01. IX2124.2 +043900 GO TO WRITE-WRITE-GF-01. IX2124.2 +044000 WRITE-DELETE-GF-01. IX2124.2 +044100 PERFORM DE-LETE. IX2124.2 +044200 GO TO WRITE-WRITE-GF-01. IX2124.2 +044300 WRITE-FAIL-GF-01. IX2124.2 +044400 MOVE "IX-41; ONE WRITE FAILED AT LEAST" TO RE-MARK. IX2124.2 +044500 PERFORM FAIL. IX2124.2 +044600 MOVE INVKEY-COUNTER TO COMPUTED-18V0. IX2124.2 +044700 MOVE 0 TO CORRECT-18V0. IX2124.2 +044800 WRITE-WRITE-GF-01. IX2124.2 +044900 PERFORM PRINT-DETAIL. IX2124.2 +045000 READ-TEST-F2-01. IX2124.2 +045100 CLOSE IX-FS1. IX2124.2 +045200 OPEN I-O IX-FS1. IX2124.2 +045300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +045400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2124.2 +045500 MOVE "RETRIEVED BY ALTERNATE KEY 1" TO RE-MARK. IX2124.2 +045600 MOVE "CCC012ALT01" TO IX-FS1-ALT01. IX2124.2 +045700 READ IX-FS1 RECORD IX2124.2 +045800 KEY IS IX-FS1-ALT01 IX2124.2 +045900 INVALID KEY GO TO READ-INVALID-F2-01. IX2124.2 +046000 IF IX-FS1-KEY = "AAA012" IX2124.2 +046100 PERFORM PASS IX2124.2 +046200 ELSE GO TO READ-FAIL-F2-01. IX2124.2 +046300 GO TO READ-WRITE-F2-01. IX2124.2 +046400 READ-DELETE-F2-01. IX2124.2 +046500 PERFORM DE-LETE. IX2124.2 +046600 GO TO READ-WRITE-F2-01. IX2124.2 +046700 READ-INVALID-F2-01. IX2124.2 +046800 PERFORM FAIL. IX2124.2 +046900 MOVE "IX-28; INVALID KEY CONDITION (IX-6) EXISTS" TO RE-MARK.IX2124.2 +047000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +047100 MOVE "CCC012ALT01" TO CORRECT-A. IX2124.2 +047200 GO TO READ-WRITE-F2-01. IX2124.2 +047300 READ-FAIL-F2-01. IX2124.2 +047400 MOVE "IX-28; RETRIEVED BY ALTERENATE KEY 1" TO RE-MARK. IX2124.2 +047500 PERFORM FAIL. IX2124.2 +047600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +047700 MOVE "AAA012" TO CORRECT-A. IX2124.2 +047800 READ-WRITE-F2-01. IX2124.2 +047900 PERFORM PRINT-DETAIL. IX2124.2 +048000 READ-TEST-F2-02. IX2124.2 +048100 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +048200 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2124.2 +048300 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2124.2 +048400 MOVE "QQQ043ALT08" TO IX-FS1-ALT08. IX2124.2 +048500 READ IX-FS1 RECORD IX2124.2 +048600 KEY IS IX-FS1-ALT08 IX2124.2 +048700 INVALID KEY GO TO READ-INVALID-F2-02. IX2124.2 +048800 IF IX-FS1-KEY = "AAA043" IX2124.2 +048900 PERFORM PASS IX2124.2 +049000 ELSE GO TO READ-FAIL-F2-02. IX2124.2 +049100 GO TO READ-WRITE-F2-02. IX2124.2 +049200 READ-DELETE-F2-02. IX2124.2 +049300 PERFORM DE-LETE. IX2124.2 +049400 GO TO READ-WRITE-F2-02. IX2124.2 +049500 READ-INVALID-F2-02. IX2124.2 +049600 PERFORM FAIL. IX2124.2 +049700 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +049800 TO RE-MARK. IX2124.2 +049900 MOVE "QQQ043ALT08" TO CORRECT-A. IX2124.2 +050000 GO TO READ-WRITE-F2-02. IX2124.2 +050100 READ-FAIL-F2-02. IX2124.2 +050200 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +050300 PERFORM FAIL. IX2124.2 +050400 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +050500 MOVE "AAA043" TO CORRECT-A. IX2124.2 +050600 READ-WRITE-F2-02. IX2124.2 +050700 PERFORM PRINT-DETAIL. IX2124.2 +050800 DELETE-TEST-GF-01. IX2124.2 +050900 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +051000 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2124.2 +051100 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-02" TO RE-MARK. IX2124.2 +051200 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-INVALID-GF-01. IX2124.2 +051300 PERFORM PASS. IX2124.2 +051400 GO TO DELETE-WRITE-GF-01. IX2124.2 +051500 DELETE-DELETE-GF-01. IX2124.2 +051600 PERFORM DE-LETE. IX2124.2 +051700 GO TO DELETE-WRITE-GF-01. IX2124.2 +051800 DELETE-INVALID-GF-01. IX2124.2 +051900 MOVE "IX-21; 4.3.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +052000 TO RE-MARK. IX2124.2 +052100 PERFORM FAIL. IX2124.2 +052200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +052300 MOVE "AAA043" TO CORRECT-A. IX2124.2 +052400 DELETE-WRITE-GF-01. IX2124.2 +052500 PERFORM PRINT-DETAIL. IX2124.2 +052600 READ-TEST-F2-03. IX2124.2 +052700 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +052800 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2124.2 +052900 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2124.2 +053000 MOVE "III017ALT04" TO IX-FS1-ALT04. IX2124.2 +053100 READ IX-FS1 RECORD IX2124.2 +053200 KEY IS IX-FS1-ALT04 IX2124.2 +053300 INVALID KEY GO TO READ-INVALID-F2-03. IX2124.2 +053400 IF IX-FS1-KEY = "AAA017" IX2124.2 +053500 PERFORM PASS IX2124.2 +053600 ELSE GO TO READ-FAIL-F2-03. IX2124.2 +053700 GO TO READ-WRITE-F2-03. IX2124.2 +053800 READ-DELETE-F2-03. IX2124.2 +053900 PERFORM DE-LETE. IX2124.2 +054000 GO TO READ-WRITE-F2-03. IX2124.2 +054100 READ-INVALID-F2-03. IX2124.2 +054200 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +054300 TO RE-MARK. IX2124.2 +054400 PERFORM FAIL. IX2124.2 +054500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +054600 MOVE "III017ALT04" TO CORRECT-A. IX2124.2 +054700 GO TO READ-WRITE-F2-03. IX2124.2 +054800 READ-FAIL-F2-03. IX2124.2 +054900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +055000 PERFORM FAIL. IX2124.2 +055100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +055200 MOVE "AAA017" TO CORRECT-A. IX2124.2 +055300 READ-WRITE-F2-03. IX2124.2 +055400 PERFORM PRINT-DETAIL. IX2124.2 +055500 REWRITE-TEST-GF-01. IX2124.2 +055600 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +055700 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX2124.2 +055800 MOVE "REWRITES RECORD FOUND IN READ-TEST-F2-03" TO RE-MARK. IX2124.2 +055900 MOVE "III917ALT04" TO IX-FS1-ALT04. IX2124.2 +056000 REWRITE IX-FS1-RECORD INVALID KEY IX2124.2 +056100 GO TO REWRITE-INVALID-GF-01. IX2124.2 +056200 PERFORM PASS. IX2124.2 +056300 GO TO REWRITE-WRITE-GF-01. IX2124.2 +056400 REWRITE-DELETE-GF-01. IX2124.2 +056500 PERFORM DE-LETE. IX2124.2 +056600 GO TO REWRITE-WRITE-GF-01. IX2124.2 +056700 REWRITE-INVALID-GF-01. IX2124.2 +056800 MOVE "IX-33; 4.6.2, INVALID KEY CONDITION (IX-6) " TO RE-MARKIX2124.2 +056900 PERFORM FAIL. IX2124.2 +057000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +057100 MOVE "III917ALT04" TO CORRECT-A. IX2124.2 +057200 REWRITE-WRITE-GF-01. IX2124.2 +057300 PERFORM PRINT-DETAIL. IX2124.2 +057400 READ-TEST-F2-04. IX2124.2 +057500 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +057600 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX2124.2 +057700 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +057800 MOVE "ZZZ999ALT09" TO IX-FS1-ALT09. IX2124.2 +057900 READ IX-FS1 RECORD IX2124.2 +058000 KEY IS IX-FS1-ALT09 IX2124.2 +058100 INVALID KEY PERFORM PASS IX2124.2 +058200 GO TO READ-WRITE-F2-04. IX2124.2 +058300 GO TO READ-FAIL-F2-04. IX2124.2 +058400 READ-DELETE-F2-04. IX2124.2 +058500 PERFORM DE-LETE. IX2124.2 +058600 GO TO READ-WRITE-F2-04. IX2124.2 +058700 READ-FAIL-F2-04. IX2124.2 +058800 MOVE "IX-28; 4.5.2 F2, INVALID KEY NOT TAKEN (IX-6)" IX2124.2 +058900 TO RE-MARK. IX2124.2 +059000 PERFORM FAIL. IX2124.2 +059100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +059200 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +059300 READ-WRITE-F2-04. IX2124.2 +059400 PERFORM PRINT-DETAIL. IX2124.2 +059500 START-TEST-GF-01. IX2124.2 +059600 MOVE "START...KEY IS EQUAL" TO FEATURE. IX2124.2 +059700 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2124.2 +059800 MOVE "RETRIEVED BY ALTERNATE KEY 3" TO RE-MARK. IX2124.2 +059900 MOVE "GGG058ALT03" TO IX-FS1-ALT03. IX2124.2 +060000 START IX-FS1 IX2124.2 +060100 KEY IS EQUAL TO IX-FS1-ALT03 IX2124.2 +060200 INVALID KEY GO TO START-INVALID-GF-01. IX2124.2 +060300 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-01. IX2124.2 +060400 IF IX-FS1-KEY = "AAA058" IX2124.2 +060500 PERFORM PASS IX2124.2 +060600 ELSE GO TO START-FAIL-GF-01. IX2124.2 +060700 GO TO START-WRITE-GF-01. IX2124.2 +060800 START-DELETE-GF-01. IX2124.2 +060900 PERFORM DE-LETE. IX2124.2 +061000 GO TO START-WRITE-GF-01. IX2124.2 +061100 START-INVALID-GF-01. IX2124.2 +061200 MOVE "IX-36; 4.7.2, INVALID KEY CONDITION (IX-6)" TO RE-MARK.IX2124.2 +061300 PERFORM FAIL. IX2124.2 +061400 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +061500 MOVE "GGG058ALT03" TO CORRECT-A. IX2124.2 +061600 GO TO START-WRITE-GF-01. IX2124.2 +061700 START-END-GF-01. IX2124.2 +061800 MOVE "IX-28; 4.5.2 F1, AT END CONDITION " TO RE-MARK. IX2124.2 +061900 PERFORM FAIL. IX2124.2 +062000 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +062100 MOVE "AAA058" TO CORRECT-A. IX2124.2 +062200 GO TO START-WRITE-GF-01. IX2124.2 +062300 START-FAIL-GF-01. IX2124.2 +062400 MOVE "IX-28; 4.5.2 F1, WRONG KEY OR IX-36 WRONG START " IX2124.2 +062500 TO RE-MARK. IX2124.2 +062600 PERFORM FAIL. IX2124.2 +062700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +062800 MOVE "AAA058" TO CORRECT-A. IX2124.2 +062900 START-WRITE-GF-01. IX2124.2 +063000 PERFORM PRINT-DETAIL. IX2124.2 +063100 START-TEST-GF-02. IX2124.2 +063200 MOVE "START...KEY >" TO FEATURE. IX2124.2 +063300 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2124.2 +063400 MOVE "RETRIEVED BY ALTERNATE KEY 6" TO RE-MARK. IX2124.2 +063500 MOVE "MMM089ALT06" TO IX-FS1-ALT06. IX2124.2 +063600 START IX-FS1 IX2124.2 +063700 KEY > IX-FS1-ALT06 IX2124.2 +063800 INVALID KEY GO TO START-INVALID-GF-02. IX2124.2 +063900 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-02. IX2124.2 +064000 IF IX-FS1-KEY = "AAA090" IX2124.2 +064100 PERFORM PASS IX2124.2 +064200 ELSE GO TO START-FAIL-GF-02. IX2124.2 +064300 GO TO START-WRITE-GF-02. IX2124.2 +064400 START-DELETE-GF-02. IX2124.2 +064500 PERFORM DE-LETE. IX2124.2 +064600 GO TO START-WRITE-GF-02. IX2124.2 +064700 START-INVALID-GF-02. IX2124.2 +064800 MOVE "IX-36; 4.7.2, INVALID KEY CONDITION (IX-6)" TO RE-MARK.IX2124.2 +064900 PERFORM FAIL. IX2124.2 +065000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +065100 MOVE "MMM089ALT09" TO CORRECT-A. IX2124.2 +065200 GO TO START-WRITE-GF-02. IX2124.2 +065300 START-END-GF-02. IX2124.2 +065400 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +065500 PERFORM FAIL. IX2124.2 +065600 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +065700 MOVE "AAA090" TO CORRECT-A. IX2124.2 +065800 GO TO START-WRITE-GF-02. IX2124.2 +065900 START-FAIL-GF-02. IX2124.2 +066000 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +066100 TO RE-MARK. IX2124.2 +066200 PERFORM FAIL. IX2124.2 +066300 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +066400 MOVE "AAA090" TO CORRECT-A. IX2124.2 +066500 START-WRITE-GF-02. IX2124.2 +066600 PERFORM PRINT-DETAIL. IX2124.2 +066700 START-TEST-GF-03. IX2124.2 +066800 MOVE "START...KEY NOT <" TO FEATURE. IX2124.2 +066900 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2124.2 +067000 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2124.2 +067100 MOVE "UUU002ALT10" TO IX-FS1-ALT10. IX2124.2 +067200 START IX-FS1 IX2124.2 +067300 KEY NOT < IX-FS1-ALT10 IX2124.2 +067400 INVALID KEY GO TO START-INVALID-GF-03. IX2124.2 +067500 READ IX-FS1 NEXT RECORD IX2124.2 +067600 AT END GO TO START-END-GF-03. IX2124.2 +067700 IF IX-FS1-KEY = "AAA002" IX2124.2 +067800 PERFORM PASS IX2124.2 +067900 ELSE GO TO START-FAIL-GF-03. IX2124.2 +068000 GO TO START-WRITE-GF-03. IX2124.2 +068100 START-DELETE-GF-03. IX2124.2 +068200 PERFORM DE-LETE. IX2124.2 +068300 GO TO START-WRITE-GF-03. IX2124.2 +068400 START-INVALID-GF-03. IX2124.2 +068500 MOVE "IX-36; 4.7.2 F2, INVALID KEY CONDITION (IX-6)" IX2124.2 +068600 TO RE-MARK. IX2124.2 +068700 PERFORM FAIL. IX2124.2 +068800 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +068900 MOVE "UUU002ALT10" TO CORRECT-A. IX2124.2 +069000 GO TO START-WRITE-GF-03. IX2124.2 +069100 START-END-GF-03. IX2124.2 +069200 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +069300 PERFORM FAIL. IX2124.2 +069400 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +069500 MOVE "AAA002" TO CORRECT-A. IX2124.2 +069600 GO TO START-WRITE-GF-03. IX2124.2 +069700 START-FAIL-GF-03. IX2124.2 +069800 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +069900 TO RE-MARK. IX2124.2 +070000 PERFORM FAIL. IX2124.2 +070100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +070200 MOVE "AAA002" TO CORRECT-A. IX2124.2 +070300 START-WRITE-GF-03. IX2124.2 +070400 PERFORM PRINT-DETAIL. IX2124.2 +070500 START-TEST-GF-04. IX2124.2 +070600 MOVE "START...KEY >= " TO FEATURE. IX2124.2 +070700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2124.2 +070800 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2124.2 +070900 MOVE "UUU002ALT10" TO IX-FS1-ALT10. IX2124.2 +071000 START IX-FS1 IX2124.2 +071100 KEY >= IX-FS1-ALT10 IX2124.2 +071200 INVALID KEY GO TO START-INVALID-GF-04. IX2124.2 +071300 READ IX-FS1 NEXT RECORD IX2124.2 +071400 AT END GO TO START-END-GF-04. IX2124.2 +071500 IF IX-FS1-KEY = "AAA002" IX2124.2 +071600 PERFORM PASS IX2124.2 +071700 ELSE GO TO START-FAIL-GF-04. IX2124.2 +071800 GO TO START-WRITE-GF-04. IX2124.2 +071900 START-DELETE-GF-04. IX2124.2 +072000 PERFORM DE-LETE. IX2124.2 +072100 GO TO START-WRITE-GF-04. IX2124.2 +072200 START-INVALID-GF-04. IX2124.2 +072300 MOVE "IX-36; 4.7.2 F2, INVALID KEY CONDITION (IX-6)" IX2124.2 +072400 TO RE-MARK. IX2124.2 +072500 PERFORM FAIL. IX2124.2 +072600 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +072700 MOVE "UUU002ALT10" TO CORRECT-A. IX2124.2 +072800 GO TO START-WRITE-GF-04. IX2124.2 +072900 START-END-GF-04. IX2124.2 +073000 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +073100 PERFORM FAIL. IX2124.2 +073200 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +073300 MOVE "AAA002" TO CORRECT-A. IX2124.2 +073400 GO TO START-WRITE-GF-04. IX2124.2 +073500 START-FAIL-GF-04. IX2124.2 +073600 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +073700 TO RE-MARK. IX2124.2 +073800 PERFORM FAIL. IX2124.2 +073900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +074000 MOVE "AAA002" TO CORRECT-A. IX2124.2 +074100 START-WRITE-GF-04. IX2124.2 +074200 PERFORM PRINT-DETAIL. IX2124.2 +074300 READ-TEST-F2-05. IX2124.2 +074400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +074500 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2124.2 +074600 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +074700 MOVE "QQQ043ALT08" TO IX-FS1-ALT08. IX2124.2 +074800 READ IX-FS1 RECORD IX2124.2 +074900 KEY IS IX-FS1-ALT08 IX2124.2 +075000 INVALID KEY PERFORM PASS IX2124.2 +075100 GO TO READ-WRITE-F2-05. IX2124.2 +075200 GO TO READ-FAIL-F2-05. IX2124.2 +075300 READ-DELETE-F2-05. IX2124.2 +075400 PERFORM DE-LETE. IX2124.2 +075500 GO TO READ-WRITE-F2-05. IX2124.2 +075600 READ-FAIL-F2-05. IX2124.2 +075700 MOVE "IX-28; 4.5.2 F2, INVALID KEY PATH NOT TAKEN (IX-6) " IX2124.2 +075800 TO RE-MARK. IX2124.2 +075900 PERFORM FAIL. IX2124.2 +076000 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +076100 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +076200 READ-WRITE-F2-05. IX2124.2 +076300 PERFORM PRINT-DETAIL. IX2124.2 +076400 READ-TEST-F2-06. IX2124.2 +076500 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +076600 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX2124.2 +076700 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2124.2 +076800 MOVE "III917ALT04" TO IX-FS1-ALT04. IX2124.2 +076900 READ IX-FS1 RECORD IX2124.2 +077000 KEY IS IX-FS1-ALT04 IX2124.2 +077100 INVALID KEY GO TO READ-INVALID-F2-06. IX2124.2 +077200 IF IX-FS1-KEY = "AAA017" IX2124.2 +077300 PERFORM PASS IX2124.2 +077400 ELSE GO TO READ-FAIL-F2-06. IX2124.2 +077500 GO TO READ-WRITE-F2-06. IX2124.2 +077600 READ-DELETE-F2-06. IX2124.2 +077700 PERFORM DE-LETE. IX2124.2 +077800 GO TO READ-WRITE-F2-06. IX2124.2 +077900 READ-INVALID-F2-06. IX2124.2 +078000 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +078100 TO RE-MARK. IX2124.2 +078200 PERFORM FAIL. IX2124.2 +078300 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +078400 MOVE "III917ALT04" TO CORRECT-A. IX2124.2 +078500 GO TO READ-WRITE-F2-06. IX2124.2 +078600 READ-FAIL-F2-06. IX2124.2 +078700 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +078800 PERFORM FAIL. IX2124.2 +078900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +079000 MOVE "AAA017" TO CORRECT-A. IX2124.2 +079100 READ-WRITE-F2-06. IX2124.2 +079200 PERFORM PRINT-DETAIL. IX2124.2 +079300 READ-TEST-F2-07. IX2124.2 +079400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +079500 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX2124.2 +079600 MOVE "RETRIEVED BY PRIMARY KEY" TO RE-MARK. IX2124.2 +079700 MOVE "AAA018" TO IX-FS1-KEY. IX2124.2 +079800 READ IX-FS1 RECORD IX2124.2 +079900 KEY IS IX-FS1-KEY IX2124.2 +080000 INVALID KEY GO TO READ-INVALID-F2-07. IX2124.2 +080100 IF IX-FS1-KEY = "AAA018" IX2124.2 +080200 PERFORM PASS IX2124.2 +080300 ELSE GO TO READ-FAIL-F2-07. IX2124.2 +080400 GO TO READ-WRITE-F2-07. IX2124.2 +080500 READ-DELETE-F2-07. IX2124.2 +080600 PERFORM DE-LETE. IX2124.2 +080700 GO TO READ-WRITE-F2-07. IX2124.2 +080800 READ-INVALID-F2-07. IX2124.2 +080900 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +081000 TO RE-MARK. IX2124.2 +081100 PERFORM FAIL. IX2124.2 +081200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +081300 MOVE "AAA018" TO CORRECT-A. IX2124.2 +081400 GO TO READ-WRITE-F2-07. IX2124.2 +081500 READ-FAIL-F2-07. IX2124.2 +081600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +081700 PERFORM FAIL. IX2124.2 +081800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +081900 MOVE "AAA018" TO CORRECT-A. IX2124.2 +082000 READ-WRITE-F2-07. IX2124.2 +082100 PERFORM PRINT-DETAIL. IX2124.2 +082200 DELETE-TEST-GF-02. IX2124.2 +082300 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +082400 MOVE "DELETE-TEST-GF-02" TO PAR-NAME. IX2124.2 +082500 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-07" TO RE-MARK. IX2124.2 +082600 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-02. IX2124.2 +082700 PERFORM PASS. IX2124.2 +082800 GO TO DELETE-WRITE-GF-02. IX2124.2 +082900 DELETE-DELETE-GF-02. IX2124.2 +083000 PERFORM DE-LETE. IX2124.2 +083100 GO TO DELETE-WRITE-GF-02. IX2124.2 +083200 DELETE-FAIL-GF-02. IX2124.2 +083300 MOVE "IX-21; 4.3.2 INVALID KEY PATH TAKEN (IX-6)" TO RE-MARK.IX2124.2 +083400 PERFORM FAIL. IX2124.2 +083500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +083600 MOVE "AAA018" TO CORRECT-A. IX2124.2 +083700 DELETE-WRITE-GF-02. IX2124.2 +083800 PERFORM PRINT-DETAIL. IX2124.2 +083900 READ-TEST-F1-08. IX2124.2 +084000 MOVE "READ...NEXT RECORD" TO FEATURE. IX2124.2 +084100 MOVE "READ-TEST-F1-08" TO PAR-NAME. IX2124.2 +084200 MOVE "READS NEXT RECORD" TO RE-MARK. IX2124.2 +084300 READ IX-FS1 NEXT RECORD AT END GO TO READ-END-F1-08. IX2124.2 +084400 IF IX-FS1-KEY = "AAA019" IX2124.2 +084500 PERFORM PASS IX2124.2 +084600 ELSE GO TO READ-FAIL-F1-08. IX2124.2 +084700 GO TO READ-WRITE-F1-08. IX2124.2 +084800 READ-DELETE-F1-08. IX2124.2 +084900 PERFORM DE-LETE. IX2124.2 +085000 GO TO READ-WRITE-F1-08. IX2124.2 +085100 READ-END-F1-08. IX2124.2 +085200 MOVE "IX-28; 4.5.2 F1, AT END CONDITION TAKEN" TO RE-MARK. IX2124.2 +085300 PERFORM FAIL. IX2124.2 +085400 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +085500 MOVE "AAA019" TO CORRECT-A. IX2124.2 +085600 GO TO READ-WRITE-F1-08. IX2124.2 +085700 READ-FAIL-F1-08. IX2124.2 +085800 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2124.2 +085900 PERFORM FAIL. IX2124.2 +086000 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +086100 MOVE "AAA019" TO CORRECT-A. IX2124.2 +086200 READ-WRITE-F1-08. IX2124.2 +086300 PERFORM PRINT-DETAIL. IX2124.2 +086400 REWRITE-TEST-GF-02. IX2124.2 +086500 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +086600 MOVE "REWRITE-TEST-GF-02" TO PAR-NAME. IX2124.2 +086700 MOVE "REWRITES RECORD FOUND IN READ-TEST-F1-08" TO RE-MARK. IX2124.2 +086800 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2124.2 +086900 REWRITE IX-FS1-RECORD INVALID KEY GO TO REWRITE-FAIL-GF-02. IX2124.2 +087000 PERFORM PASS. IX2124.2 +087100 GO TO REWRITE-WRITE-GF-02. IX2124.2 +087200 REWRITE-DELETE-GF-02. IX2124.2 +087300 PERFORM DE-LETE. IX2124.2 +087400 GO TO REWRITE-WRITE-GF-02. IX2124.2 +087500 REWRITE-FAIL-GF-02. IX2124.2 +087600 MOVE "IX-33; 4.6.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +087700 TO RE-MARK. IX2124.2 +087800 PERFORM FAIL. IX2124.2 +087900 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +088000 MOVE "SSSSSSALT09" TO CORRECT-A. IX2124.2 +088100 REWRITE-WRITE-GF-02. IX2124.2 +088200 PERFORM PRINT-DETAIL. IX2124.2 +088300 READ-TEST-F2-09. IX2124.2 +088400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +088500 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX2124.2 +088600 MOVE "RETRIEVED BY ALTERNATE KEY 2" TO RE-MARK. IX2124.2 +088700 MOVE "EEE075ALT02" TO IX-FS1-ALT02. IX2124.2 +088800 READ IX-FS1 RECORD IX2124.2 +088900 KEY IS IX-FS1-ALT02 IX2124.2 +089000 INVALID KEY GO TO READ-INVALID-F2-09. IX2124.2 +089100 IF IX-FS1-KEY = "AAA075" IX2124.2 +089200 PERFORM PASS IX2124.2 +089300 ELSE GO TO READ-FAIL-F2-09. IX2124.2 +089400 GO TO READ-WRITE-F2-09. IX2124.2 +089500 READ-DELETE-F2-09. IX2124.2 +089600 PERFORM DE-LETE. IX2124.2 +089700 GO TO READ-WRITE-F2-09. IX2124.2 +089800 READ-INVALID-F2-09. IX2124.2 +089900 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +090000 TO RE-MARK. IX2124.2 +090100 PERFORM FAIL. IX2124.2 +090200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +090300 MOVE "EEE075ALT02" TO CORRECT-A. IX2124.2 +090400 GO TO READ-WRITE-F2-09. IX2124.2 +090500 READ-FAIL-F2-09. IX2124.2 +090600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +090700 PERFORM FAIL. IX2124.2 +090800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +090900 MOVE "AAA075" TO CORRECT-A. IX2124.2 +091000 READ-WRITE-F2-09. IX2124.2 +091100 PERFORM PRINT-DETAIL. IX2124.2 +091200 REWRITE-TEST-GF-03. IX2124.2 +091300 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +091400 MOVE "REWRITE-TEST-GF-03" TO PAR-NAME. IX2124.2 +091500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +091600 MOVE "EEE076ALT02" TO IX-FS1-ALT02. IX2124.2 +091700 REWRITE IX-FS1-RECORD INVALID KEY IX2124.2 +091800 PERFORM PASS IX2124.2 +091900 GO TO REWRITE-WRITE-GF-03. IX2124.2 +092000 GO TO REWRITE-FAIL-GF-03. IX2124.2 +092100 REWRITE-DELETE-GF-03. IX2124.2 +092200 PERFORM DE-LETE. IX2124.2 +092300 GO TO REWRITE-WRITE-GF-03. IX2124.2 +092400 REWRITE-FAIL-GF-03. IX2124.2 +092500 MOVE "IX-33; 4.6.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +092600- " TAKEN" TO RE-MARK. IX2124.2 +092700 PERFORM FAIL. IX2124.2 +092800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +092900 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +093000 REWRITE-WRITE-GF-03. IX2124.2 +093100 PERFORM PRINT-DETAIL. IX2124.2 +093200 READ-TEST-F2-10. IX2124.2 +093300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +093400 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX2124.2 +093500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +093600 MOVE "KKK018ALT05" TO IX-FS1-ALT05. IX2124.2 +093700 READ IX-FS1 RECORD IX2124.2 +093800 KEY IS IX-FS1-ALT05 IX2124.2 +093900 INVALID KEY PERFORM PASS IX2124.2 +094000 GO TO READ-WRITE-F2-10. IX2124.2 +094100 GO TO READ-FAIL-F2-10. IX2124.2 +094200 READ-DELETE-F2-10. IX2124.2 +094300 PERFORM DE-LETE. IX2124.2 +094400 GO TO READ-WRITE-F2-10. IX2124.2 +094500 READ-FAIL-F2-10. IX2124.2 +094600 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +094700- " TAKEN" TO RE-MARK. IX2124.2 +094800 PERFORM FAIL. IX2124.2 +094900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +095000 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +095100 READ-WRITE-F2-10. IX2124.2 +095200 PERFORM PRINT-DETAIL. IX2124.2 +095300 READ-TEST-F2-11. IX2124.2 +095400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +095500 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX2124.2 +095600 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2124.2 +095700 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2124.2 +095800 READ IX-FS1 RECORD IX2124.2 +095900 KEY IS IX-FS1-ALT09 IX2124.2 +096000 INVALID KEY GO TO READ-INVALID-F2-11. IX2124.2 +096100 IF IX-FS1-KEY = "AAA019" IX2124.2 +096200 PERFORM PASS IX2124.2 +096300 ELSE GO TO READ-FAIL-F2-11. IX2124.2 +096400 GO TO READ-WRITE-F2-11. IX2124.2 +096500 READ-DELETE-F2-11. IX2124.2 +096600 PERFORM DE-LETE. IX2124.2 +096700 GO TO READ-WRITE-F2-11. IX2124.2 +096800 READ-INVALID-F2-11. IX2124.2 +096900 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +097000- " TAKEN" TO RE-MARK. IX2124.2 +097100 PERFORM FAIL. IX2124.2 +097200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +097300 MOVE "SSSSSSALT09" TO CORRECT-A. IX2124.2 +097400 GO TO READ-WRITE-F2-11. IX2124.2 +097500 READ-FAIL-F2-11. IX2124.2 +097600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +097700 PERFORM FAIL. IX2124.2 +097800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +097900 MOVE "AAA019" TO CORRECT-A. IX2124.2 +098000 READ-WRITE-F2-11. IX2124.2 +098100 PERFORM PRINT-DETAIL. IX2124.2 +098200 READ-TEST-F2-12. IX2124.2 +098300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +098400 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX2124.2 +098500 MOVE "RETRIEVED BY ALTERNATE KEY 7" TO RE-MARK. IX2124.2 +098600 MOVE "OOO026ALT07" TO IX-FS1-ALT07. IX2124.2 +098700 READ IX-FS1 RECORD IX2124.2 +098800 KEY IS IX-FS1-ALT07 IX2124.2 +098900 INVALID KEY GO TO READ-INVALID-F2-12. IX2124.2 +099000 IF IX-FS1-KEY = "AAA026" IX2124.2 +099100 PERFORM PASS IX2124.2 +099200 ELSE GO TO READ-FAIL-F2-12. IX2124.2 +099300 GO TO READ-WRITE-F2-12. IX2124.2 +099400 READ-DELETE-F2-12. IX2124.2 +099500 PERFORM DE-LETE. IX2124.2 +099600 GO TO READ-WRITE-F2-12. IX2124.2 +099700 READ-INVALID-F2-12. IX2124.2 +099800 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +099900- " TAKEN" TO RE-MARK. IX2124.2 +100000 PERFORM FAIL. IX2124.2 +100100 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +100200 MOVE "OOO026ALT07" TO CORRECT-A. IX2124.2 +100300 GO TO READ-WRITE-F2-12. IX2124.2 +100400 READ-FAIL-F2-12. IX2124.2 +100500 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +100600 PERFORM FAIL. IX2124.2 +100700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +100800 MOVE "AAA026" TO CORRECT-A. IX2124.2 +100900 READ-WRITE-F2-12. IX2124.2 +101000 PERFORM PRINT-DETAIL. IX2124.2 +101100 DELETE-TEST-GF-03. IX2124.2 +101200 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +101300 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2124.2 +101400 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-12" TO RE-MARK. IX2124.2 +101500 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-03. IX2124.2 +101600 PERFORM PASS. IX2124.2 +101700 GO TO DELETE-WRITE-GF-03. IX2124.2 +101800 DELETE-DELETE-GF-03. IX2124.2 +101900 PERFORM DE-LETE. IX2124.2 +102000 GO TO DELETE-WRITE-GF-03. IX2124.2 +102100 DELETE-FAIL-GF-03. IX2124.2 +102200 MOVE "IX-21; 4.3.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +102300- " TAKEN" TO RE-MARK. IX2124.2 +102400 PERFORM FAIL. IX2124.2 +102500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +102600 MOVE "AAA026" TO CORRECT-A. IX2124.2 +102700 DELETE-WRITE-GF-03. IX2124.2 +102800 PERFORM PRINT-DETAIL. IX2124.2 +102900 READ-TEST-F2-13. IX2124.2 +103000 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +103100 MOVE "READ-TEST-F2-13" TO PAR-NAME. IX2124.2 +103200 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +103300 MOVE "KKK026ALT05" TO IX-FS1-ALT05. IX2124.2 +103400 READ IX-FS1 RECORD IX2124.2 +103500 KEY IS IX-FS1-ALT05 IX2124.2 +103600 INVALID KEY PERFORM PASS IX2124.2 +103700 GO TO READ-WRITE-F2-13. IX2124.2 +103800 GO TO READ-FAIL-F2-13. IX2124.2 +103900 READ-DELETE-F2-13. IX2124.2 +104000 PERFORM DE-LETE. IX2124.2 +104100 GO TO READ-WRITE-F2-13. IX2124.2 +104200 READ-FAIL-F2-13. IX2124.2 +104300 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +104400- " TAKEN" TO RE-MARK. IX2124.2 +104500 PERFORM FAIL. IX2124.2 +104600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +104700 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +104800 READ-WRITE-F2-13. IX2124.2 +104900 PERFORM PRINT-DETAIL. IX2124.2 +105000 CLOSE IX-FS1. IX2124.2 +105100 CCVS-EXIT SECTION. IX2124.2 +105200 CCVS-999999. IX2124.2 +105300 GO TO CLOSE-FILES. IX2124.2 +*END-OF,IX212A +*HEADER,COBOL,IX213A +000100 IDENTIFICATION DIVISION. IX2134.2 +000200 PROGRAM-ID. IX2134.2 +000300 IX213A. IX2134.2 +000400**************************************************************** IX2134.2 +000500* * IX2134.2 +000600* VALIDATION FOR:- * IX2134.2 +000700* * IX2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +000900* * IX2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2134.2 +001100* * IX2134.2 +001200**************************************************************** IX2134.2 +001300* * IX2134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2134.2 +001500* * IX2134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2134.2 +001900* * IX2134.2 +002000**************************************************************** IX2134.2 +002100* THIS PROGRAM CREATES A 100 RECORD FIXED LENGTH INDEXED FILE IX2134.2 +002200* WHOSE ACCESS MODES IS DYNAMIC AND CONTAINS 100 DUPLICATE IX2134.2 +002300* ALTERNATE KEYS. THE INDEXED FILE IS MANIPULATED BY THE IX2134.2 +002400* DUPLICATE ALTERNATE KEYS USING THE FOLLOWING VERBS: IX2134.2 +002500* IX2134.2 +002600* . DELETE IX2134.2 +002700* . READ ... NEXT RECORD IX2134.2 +002800* . READ ... RECORD KEY IX2134.2 +002900* . REWRITE IX2134.2 +003000* . START IX2134.2 +003100* IX2134.2 +003200 ENVIRONMENT DIVISION. IX2134.2 +003300 CONFIGURATION SECTION. IX2134.2 +003400 SOURCE-COMPUTER. IX2134.2 +003500 XXXXX082. IX2134.2 +003600 OBJECT-COMPUTER. IX2134.2 +003700 XXXXX083. IX2134.2 +003800 INPUT-OUTPUT SECTION. IX2134.2 +003900 FILE-CONTROL. IX2134.2 +004000P SELECT RAW-DATA ASSIGN TO IX2134.2 +004100P XXXXX062 IX2134.2 +004200P ORGANIZATION IS INDEXED IX2134.2 +004300P ACCESS MODE IS RANDOM IX2134.2 +004400P RECORD KEY IS RAW-DATA-KEY. IX2134.2 +004500 SELECT PRINT-FILE ASSIGN TO IX2134.2 +004600 XXXXX055. IX2134.2 +004700 SELECT IX-FS1 IX2134.2 +004800 ASSIGN TO IX2134.2 +004900 XXXXX024 IX2134.2 +005000J XXXXX044 IX2134.2 +005100 ACCESS MODE IS DYNAMIC IX2134.2 +005200 RECORD KEY IS IX-FS1-KEY IX2134.2 +005300 ALTERNATE RECORD KEY IS IX-FS1-ALT01 WITH DUPLICATES IX2134.2 +005400 ALTERNATE RECORD KEY IS IX-FS1-ALT02 WITH DUPLICATES IX2134.2 +005500 ALTERNATE RECORD KEY IS IX-FS1-ALT03 WITH DUPLICATES IX2134.2 +005600 ALTERNATE RECORD KEY IS IX-FS1-ALT04 WITH DUPLICATES IX2134.2 +005700 ALTERNATE RECORD KEY IS IX-FS1-ALT05 WITH DUPLICATES IX2134.2 +005800 ALTERNATE RECORD KEY IS IX-FS1-ALT06 WITH DUPLICATES IX2134.2 +005900 ALTERNATE RECORD KEY IS IX-FS1-ALT07 WITH DUPLICATES IX2134.2 +006000 ALTERNATE RECORD KEY IS IX-FS1-ALT08 WITH DUPLICATES IX2134.2 +006100 ALTERNATE RECORD KEY IS IX-FS1-ALT09 WITH DUPLICATES IX2134.2 +006200 ALTERNATE RECORD KEY IS IX-FS1-ALT10 WITH DUPLICATES IX2134.2 +006300 ORGANIZATION IS INDEXED. IX2134.2 +006400 DATA DIVISION. IX2134.2 +006500 FILE SECTION. IX2134.2 +006600P IX2134.2 +006700PFD RAW-DATA. IX2134.2 +006800P IX2134.2 +006900P01 RAW-DATA-SATZ. IX2134.2 +007000P 05 RAW-DATA-KEY PIC X(6). IX2134.2 +007100P 05 C-DATE PIC 9(6). IX2134.2 +007200P 05 C-TIME PIC 9(8). IX2134.2 +007300P 05 C-NO-OF-TESTS PIC 99. IX2134.2 +007400P 05 C-OK PIC 999. IX2134.2 +007500P 05 C-ALL PIC 999. IX2134.2 +007600P 05 C-FAIL PIC 999. IX2134.2 +007700P 05 C-DELETED PIC 999. IX2134.2 +007800P 05 C-INSPECT PIC 999. IX2134.2 +007900P 05 C-NOTE PIC X(13). IX2134.2 +008000P 05 C-INDENT PIC X. IX2134.2 +008100P 05 C-ABORT PIC X(8). IX2134.2 +008200 FD PRINT-FILE. IX2134.2 +008300 01 PRINT-REC PICTURE X(120). IX2134.2 +008400 01 DUMMY-RECORD PICTURE X(120). IX2134.2 +008500 FD IX-FS1 IX2134.2 +008600C LABEL RECORDS ARE STANDARD IX2134.2 +008700C DATA RECORD IS IX-FS1-RECORD IX2134.2 +008800 RECORD CONTAINS 116 CHARACTERS. IX2134.2 +008900 01 IX-FS1-RECORD. IX2134.2 +009000 02 IX-FS1-KEY PIC X(6). IX2134.2 +009100 02 IX-FS1-ALT01 PIC X(11). IX2134.2 +009200 02 IX-FS1-ALT02 PIC X(11). IX2134.2 +009300 02 IX-FS1-ALT03 PIC X(11). IX2134.2 +009400 02 IX-FS1-ALT04 PIC X(11). IX2134.2 +009500 02 IX-FS1-ALT05 PIC X(11). IX2134.2 +009600 02 IX-FS1-ALT06 PIC X(11). IX2134.2 +009700 02 IX-FS1-ALT07 PIC X(11). IX2134.2 +009800 02 IX-FS1-ALT08 PIC X(11). IX2134.2 +009900 02 IX-FS1-ALT09 PIC X(11). IX2134.2 +010000 02 IX-FS1-ALT10 PIC X(11). IX2134.2 +010100 WORKING-STORAGE SECTION. IX2134.2 +010200 01 RECORD-COUNTER PIC 999 VALUE ZEROS. IX2134.2 +010300 01 INVKEY-COUNTER PIC 999 VALUE ZEROS. IX2134.2 +010400 01 WORK-RECORD. IX2134.2 +010500 02 FILLER PIC XXX VALUE "AAA". IX2134.2 +010600 02 COUNTER00 PIC 999. IX2134.2 +010700 02 FILLER PIC XXX VALUE "CCC". IX2134.2 +010800 02 COUNTER01 PIC 999. IX2134.2 +010900 02 FILLER PIC X(5) VALUE "ALT01". IX2134.2 +011000 02 FILLER PIC XXX VALUE "EEE". IX2134.2 +011100 02 COUNTER02 PIC 999. IX2134.2 +011200 02 FILLER PIC X(5) VALUE "ALT02". IX2134.2 +011300 02 FILLER PIC XXX VALUE "GGG". IX2134.2 +011400 02 COUNTER03 PIC 999. IX2134.2 +011500 02 FILLER PIC X(5) VALUE "ALT03". IX2134.2 +011600 02 FILLER PIC XXX VALUE "III". IX2134.2 +011700 02 COUNTER04 PIC 999. IX2134.2 +011800 02 FILLER PIC X(5) VALUE "ALT04". IX2134.2 +011900 02 FILLER PIC XXX VALUE "KKK". IX2134.2 +012000 02 COUNTER05 PIC 999. IX2134.2 +012100 02 FILLER PIC X(5) VALUE "ALT05". IX2134.2 +012200 02 FILLER PIC XXX VALUE "MMM". IX2134.2 +012300 02 COUNTER06 PIC 999. IX2134.2 +012400 02 FILLER PIC X(5) VALUE "ALT06". IX2134.2 +012500 02 FILLER PIC XXX VALUE "OOO". IX2134.2 +012600 02 COUNTER07 PIC 999. IX2134.2 +012700 02 FILLER PIC X(5) VALUE "ALT07". IX2134.2 +012800 02 FILLER PIC XXX VALUE "QQQ". IX2134.2 +012900 02 COUNTER08 PIC 999. IX2134.2 +013000 02 FILLER PIC X(5) VALUE "ALT08". IX2134.2 +013100 02 FILLER PIC XXX VALUE "SSS". IX2134.2 +013200 02 COUNTER09 PIC 999. IX2134.2 +013300 02 FILLER PIC X(5) VALUE "ALT09". IX2134.2 +013400 02 FILLER PIC XXX VALUE "UUU". IX2134.2 +013500 02 COUNTER10 PIC 999. IX2134.2 +013600 02 FILLER PIC X(5) VALUE "ALT10". IX2134.2 +013700 01 TEST-RESULTS. IX2134.2 +013800 02 FILLER PIC X VALUE SPACE. IX2134.2 +013900 02 FEATURE PIC X(20) VALUE SPACE. IX2134.2 +014000 02 FILLER PIC X VALUE SPACE. IX2134.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. IX2134.2 +014200 02 FILLER PIC X VALUE SPACE. IX2134.2 +014300 02 PAR-NAME. IX2134.2 +014400 03 FILLER PIC X(19) VALUE SPACE. IX2134.2 +014500 03 PARDOT-X PIC X VALUE SPACE. IX2134.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. IX2134.2 +014700 02 FILLER PIC X(8) VALUE SPACE. IX2134.2 +014800 02 RE-MARK PIC X(61). IX2134.2 +014900 01 TEST-COMPUTED. IX2134.2 +015000 02 FILLER PIC X(30) VALUE SPACE. IX2134.2 +015100 02 FILLER PIC X(17) VALUE IX2134.2 +015200 " COMPUTED=". IX2134.2 +015300 02 COMPUTED-X. IX2134.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2134.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A IX2134.2 +015600 PIC -9(9).9(9). IX2134.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2134.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2134.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2134.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. IX2134.2 +016100 04 COMPUTED-18V0 PIC -9(18). IX2134.2 +016200 04 FILLER PIC X. IX2134.2 +016300 03 FILLER PIC X(50) VALUE SPACE. IX2134.2 +016400 01 TEST-CORRECT. IX2134.2 +016500 02 FILLER PIC X(30) VALUE SPACE. IX2134.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". IX2134.2 +016700 02 CORRECT-X. IX2134.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. IX2134.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2134.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2134.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2134.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2134.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. IX2134.2 +017400 04 CORRECT-18V0 PIC -9(18). IX2134.2 +017500 04 FILLER PIC X. IX2134.2 +017600 03 FILLER PIC X(2) VALUE SPACE. IX2134.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2134.2 +017800 01 CCVS-C-1. IX2134.2 +017900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2134.2 +018000- "SS PARAGRAPH-NAME IX2134.2 +018100- " REMARKS". IX2134.2 +018200 02 FILLER PIC X(20) VALUE SPACE. IX2134.2 +018300 01 CCVS-C-2. IX2134.2 +018400 02 FILLER PIC X VALUE SPACE. IX2134.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". IX2134.2 +018600 02 FILLER PIC X(15) VALUE SPACE. IX2134.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". IX2134.2 +018800 02 FILLER PIC X(94) VALUE SPACE. IX2134.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2134.2 +019000 01 REC-CT PIC 99 VALUE ZERO. IX2134.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2134.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2134.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2134.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2134.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2134.2 +020000 01 CCVS-H-1. IX2134.2 +020100 02 FILLER PIC X(39) VALUE SPACES. IX2134.2 +020200 02 FILLER PIC X(42) VALUE IX2134.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2134.2 +020400 02 FILLER PIC X(39) VALUE SPACES. IX2134.2 +020500 01 CCVS-H-2A. IX2134.2 +020600 02 FILLER PIC X(40) VALUE SPACE. IX2134.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2134.2 +020800 02 FILLER PIC XXXX VALUE IX2134.2 +020900 "4.2 ". IX2134.2 +021000 02 FILLER PIC X(28) VALUE IX2134.2 +021100 " COPY - NOT FOR DISTRIBUTION". IX2134.2 +021200 02 FILLER PIC X(41) VALUE SPACE. IX2134.2 +021300 IX2134.2 +021400 01 CCVS-H-2B. IX2134.2 +021500 02 FILLER PIC X(15) VALUE IX2134.2 +021600 "TEST RESULT OF ". IX2134.2 +021700 02 TEST-ID PIC X(9). IX2134.2 +021800 02 FILLER PIC X(4) VALUE IX2134.2 +021900 " IN ". IX2134.2 +022000 02 FILLER PIC X(12) VALUE IX2134.2 +022100 " HIGH ". IX2134.2 +022200 02 FILLER PIC X(22) VALUE IX2134.2 +022300 " LEVEL VALIDATION FOR ". IX2134.2 +022400 02 FILLER PIC X(58) VALUE IX2134.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +022600 01 CCVS-H-3. IX2134.2 +022700 02 FILLER PIC X(34) VALUE IX2134.2 +022800 " FOR OFFICIAL USE ONLY ". IX2134.2 +022900 02 FILLER PIC X(58) VALUE IX2134.2 +023000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2134.2 +023100 02 FILLER PIC X(28) VALUE IX2134.2 +023200 " COPYRIGHT 1985 ". IX2134.2 +023300 01 CCVS-E-1. IX2134.2 +023400 02 FILLER PIC X(52) VALUE SPACE. IX2134.2 +023500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2134.2 +023600 02 ID-AGAIN PIC X(9). IX2134.2 +023700 02 FILLER PIC X(45) VALUE SPACES. IX2134.2 +023800 01 CCVS-E-2. IX2134.2 +023900 02 FILLER PIC X(31) VALUE SPACE. IX2134.2 +024000 02 FILLER PIC X(21) VALUE SPACE. IX2134.2 +024100 02 CCVS-E-2-2. IX2134.2 +024200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2134.2 +024300 03 FILLER PIC X VALUE SPACE. IX2134.2 +024400 03 ENDER-DESC PIC X(44) VALUE IX2134.2 +024500 "ERRORS ENCOUNTERED". IX2134.2 +024600 01 CCVS-E-3. IX2134.2 +024700 02 FILLER PIC X(22) VALUE IX2134.2 +024800 " FOR OFFICIAL USE ONLY". IX2134.2 +024900 02 FILLER PIC X(12) VALUE SPACE. IX2134.2 +025000 02 FILLER PIC X(58) VALUE IX2134.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +025200 02 FILLER PIC X(13) VALUE SPACE. IX2134.2 +025300 02 FILLER PIC X(15) VALUE IX2134.2 +025400 " COPYRIGHT 1985". IX2134.2 +025500 01 CCVS-E-4. IX2134.2 +025600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2134.2 +025700 02 FILLER PIC X(4) VALUE " OF ". IX2134.2 +025800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2134.2 +025900 02 FILLER PIC X(40) VALUE IX2134.2 +026000 " TESTS WERE EXECUTED SUCCESSFULLY". IX2134.2 +026100 01 XXINFO. IX2134.2 +026200 02 FILLER PIC X(19) VALUE IX2134.2 +026300 "*** INFORMATION ***". IX2134.2 +026400 02 INFO-TEXT. IX2134.2 +026500 04 FILLER PIC X(8) VALUE SPACE. IX2134.2 +026600 04 XXCOMPUTED PIC X(20). IX2134.2 +026700 04 FILLER PIC X(5) VALUE SPACE. IX2134.2 +026800 04 XXCORRECT PIC X(20). IX2134.2 +026900 02 INF-ANSI-REFERENCE PIC X(48). IX2134.2 +027000 01 HYPHEN-LINE. IX2134.2 +027100 02 FILLER PIC IS X VALUE IS SPACE. IX2134.2 +027200 02 FILLER PIC IS X(65) VALUE IS "************************IX2134.2 +027300- "*****************************************". IX2134.2 +027400 02 FILLER PIC IS X(54) VALUE IS "************************IX2134.2 +027500- "******************************". IX2134.2 +027600 01 CCVS-PGM-ID PIC X(9) VALUE IX2134.2 +027700 "IX213A". IX2134.2 +027800 PROCEDURE DIVISION. IX2134.2 +027900 CCVS1 SECTION. IX2134.2 +028000 OPEN-FILES. IX2134.2 +028100P OPEN I-O RAW-DATA. IX2134.2 +028200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2134.2 +028300P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2134.2 +028400P MOVE "ABORTED " TO C-ABORT. IX2134.2 +028500P ADD 1 TO C-NO-OF-TESTS. IX2134.2 +028600P ACCEPT C-DATE FROM DATE. IX2134.2 +028700P ACCEPT C-TIME FROM TIME. IX2134.2 +028800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2134.2 +028900PEND-E-1. IX2134.2 +029000P CLOSE RAW-DATA. IX2134.2 +029100 OPEN OUTPUT PRINT-FILE. IX2134.2 +029200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2134.2 +029300 MOVE SPACE TO TEST-RESULTS. IX2134.2 +029400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2134.2 +029500 GO TO CCVS1-EXIT. IX2134.2 +029600 CLOSE-FILES. IX2134.2 +029700P OPEN I-O RAW-DATA. IX2134.2 +029800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2134.2 +029900P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2134.2 +030000P MOVE "OK. " TO C-ABORT. IX2134.2 +030100P MOVE PASS-COUNTER TO C-OK. IX2134.2 +030200P MOVE ERROR-HOLD TO C-ALL. IX2134.2 +030300P MOVE ERROR-COUNTER TO C-FAIL. IX2134.2 +030400P MOVE DELETE-COUNTER TO C-DELETED. IX2134.2 +030500P MOVE INSPECT-COUNTER TO C-INSPECT. IX2134.2 +030600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2134.2 +030700PEND-E-2. IX2134.2 +030800P CLOSE RAW-DATA. IX2134.2 +030900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2134.2 +031000 TERMINATE-CCVS. IX2134.2 +031100S EXIT PROGRAM. IX2134.2 +031200STERMINATE-CALL. IX2134.2 +031300 STOP RUN. IX2134.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2134.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2134.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2134.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2134.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. IX2134.2 +031900 PRINT-DETAIL. IX2134.2 +032000 IF REC-CT NOT EQUAL TO ZERO IX2134.2 +032100 MOVE "." TO PARDOT-X IX2134.2 +032200 MOVE REC-CT TO DOTVALUE. IX2134.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2134.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2134.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2134.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2134.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2134.2 +032800 MOVE SPACE TO CORRECT-X. IX2134.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2134.2 +033000 MOVE SPACE TO RE-MARK. IX2134.2 +033100 HEAD-ROUTINE. IX2134.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2134.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2134.2 +033600 COLUMN-NAMES-ROUTINE. IX2134.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +034000 END-ROUTINE. IX2134.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2134.2 +034200 END-RTN-EXIT. IX2134.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +034400 END-ROUTINE-1. IX2134.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2134.2 +034600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2134.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. IX2134.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2134.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2134.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2134.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2134.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2134.2 +035300 END-ROUTINE-12. IX2134.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2134.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2134.2 +035600 MOVE "NO " TO ERROR-TOTAL IX2134.2 +035700 ELSE IX2134.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2134.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2134.2 +036000 PERFORM WRITE-LINE. IX2134.2 +036100 END-ROUTINE-13. IX2134.2 +036200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2134.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE IX2134.2 +036400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2134.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2134.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO IX2134.2 +036800 MOVE "NO " TO ERROR-TOTAL IX2134.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2134.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2134.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +037300 WRITE-LINE. IX2134.2 +037400 ADD 1 TO RECORD-COUNT. IX2134.2 +037500Y IF RECORD-COUNT GREATER 42 IX2134.2 +037600Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2134.2 +037700Y MOVE SPACE TO DUMMY-RECORD IX2134.2 +037800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2134.2 +037900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2134.2 +038000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2134.2 +038100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2134.2 +038200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2134.2 +038300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038600Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2134.2 +038700Y MOVE ZERO TO RECORD-COUNT. IX2134.2 +038800 PERFORM WRT-LN. IX2134.2 +038900 WRT-LN. IX2134.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2134.2 +039100 MOVE SPACE TO DUMMY-RECORD. IX2134.2 +039200 BLANK-LINE-PRINT. IX2134.2 +039300 PERFORM WRT-LN. IX2134.2 +039400 FAIL-ROUTINE. IX2134.2 +039500 IF COMPUTED-X NOT EQUAL TO SPACE IX2134.2 +039600 GO TO FAIL-ROUTINE-WRITE. IX2134.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2134.2 +039800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2134.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2134.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +040100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2134.2 +040200 GO TO FAIL-ROUTINE-EX. IX2134.2 +040300 FAIL-ROUTINE-WRITE. IX2134.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2134.2 +040500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2134.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2134.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2134.2 +040800 FAIL-ROUTINE-EX. EXIT. IX2134.2 +040900 BAIL-OUT. IX2134.2 +041000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2134.2 +041100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2134.2 +041200 BAIL-OUT-WRITE. IX2134.2 +041300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2134.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2134.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2134.2 +041700 BAIL-OUT-EX. EXIT. IX2134.2 +041800 CCVS1-EXIT. IX2134.2 +041900 EXIT. IX2134.2 +042000 WRITE-INIT-GF-01. IX2134.2 +042100 OPEN OUTPUT IX-FS1. IX2134.2 +042200 PERFORM CREATE-IX-FS1 VARYING RECORD-COUNTER FROM 1 BY 1 IX2134.2 +042300 UNTIL RECORD-COUNTER IS GREATER THAN 100. IX2134.2 +042400 CREATE-IX-FS1. IX2134.2 +042500 MOVE RECORD-COUNTER TO COUNTER00, COUNTER01, COUNTER02, IX2134.2 +042600 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +042700 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +042800 IF RECORD-COUNTER = 011 MOVE 010 TO COUNTER01, COUNTER02, IX2134.2 +042900 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043000 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043100 IF RECORD-COUNTER = 021 MOVE 020 TO COUNTER01, COUNTER02, IX2134.2 +043200 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043300 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043400 IF RECORD-COUNTER = 031 MOVE 030 TO COUNTER01, COUNTER02, IX2134.2 +043500 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043600 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043700 IF RECORD-COUNTER = 041 MOVE 040 TO COUNTER01, COUNTER02, IX2134.2 +043800 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043900 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044000 IF RECORD-COUNTER = 051 MOVE 050 TO COUNTER01, COUNTER02, IX2134.2 +044100 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044200 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044300 IF RECORD-COUNTER = 061 MOVE 060 TO COUNTER01, COUNTER02, IX2134.2 +044400 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044500 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044600 IF RECORD-COUNTER = 071 MOVE 070 TO COUNTER01, COUNTER02, IX2134.2 +044700 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044800 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044900 IF RECORD-COUNTER = 081 MOVE 080 TO COUNTER01, COUNTER02, IX2134.2 +045000 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +045100 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +045200 IF RECORD-COUNTER = 091 MOVE 090 TO COUNTER01, COUNTER02, IX2134.2 +045300 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +045400 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +045500 WRITE IX-FS1-RECORD FROM WORK-RECORD INVALID KEY IX2134.2 +045600 ADD 1 TO INVKEY-COUNTER. IX2134.2 +045700 WRITE-TEST-GD-01. IX2134.2 +045800 MOVE "WRITE INVALID KEY" TO FEATURE. IX2134.2 +045900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2134.2 +046000 MOVE "CREATE IX-FS1" TO RE-MARK. IX2134.2 +046100 IF INVKEY-COUNTER = 0 IX2134.2 +046200 PERFORM PASS IX2134.2 +046300 ELSE GO TO WRITE-FAIL-GF-01. IX2134.2 +046400 GO TO WRITE-WRITE-GF-01. IX2134.2 +046500 INDEX-DELETE-1. IX2134.2 +046600 PERFORM DE-LETE. IX2134.2 +046700 GO TO WRITE-WRITE-GF-01. IX2134.2 +046800 WRITE-FAIL-GF-01. IX2134.2 +046900 MOVE "IX-41; 4.9.2, FILE NOT CREATED CORRECTLY" TO RE-MARK. IX2134.2 +047000 PERFORM FAIL. IX2134.2 +047100 MOVE INVKEY-COUNTER TO COMPUTED-18V0. IX2134.2 +047200 MOVE 0 TO CORRECT-18V0. IX2134.2 +047300 WRITE-WRITE-GF-01. IX2134.2 +047400 PERFORM PRINT-DETAIL. IX2134.2 +047500 READ-TEST-F2-01. IX2134.2 +047600 CLOSE IX-FS1. IX2134.2 +047700 OPEN I-O IX-FS1. IX2134.2 +047800 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +047900 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2134.2 +048000 MOVE "RETRIEVED BY ALTERNATE KEY 1" TO RE-MARK. IX2134.2 +048100 MOVE "CCC050ALT01" TO IX-FS1-ALT01. IX2134.2 +048200 READ IX-FS1 RECORD IX2134.2 +048300 KEY IS IX-FS1-ALT01 IX2134.2 +048400 INVALID KEY GO TO READ-INVALID-F2-01. IX2134.2 +048500 IF IX-FS1-KEY = "AAA050" IX2134.2 +048600 PERFORM PASS IX2134.2 +048700 ELSE GO TO READ-FAIL-F2-01. IX2134.2 +048800 GO TO READ-WRITE-F2-01. IX2134.2 +048900 READ-DELETE-F2-01. IX2134.2 +049000 PERFORM DE-LETE. IX2134.2 +049100 GO TO READ-WRITE-F2-01. IX2134.2 +049200 READ-INVALID-F2-01. IX2134.2 +049300 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +049400 TO RE-MARK. IX2134.2 +049500 PERFORM FAIL. IX2134.2 +049600 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +049700 MOVE "CCC050ALT01" TO CORRECT-A. IX2134.2 +049800 GO TO READ-WRITE-F2-01. IX2134.2 +049900 READ-FAIL-F2-01. IX2134.2 +050000 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +050100 PERFORM FAIL. IX2134.2 +050200 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +050300 MOVE "AAA050" TO CORRECT-A. IX2134.2 +050400 READ-WRITE-F2-01. IX2134.2 +050500 PERFORM PRINT-DETAIL. IX2134.2 +050600 READ-TEST-F2-02. IX2134.2 +050700 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +050800 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2134.2 +050900 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2134.2 +051000 MOVE "QQQ040ALT08" TO IX-FS1-ALT08. IX2134.2 +051100 READ IX-FS1 RECORD IX2134.2 +051200 KEY IS IX-FS1-ALT08 IX2134.2 +051300 INVALID KEY GO TO READ-INVALID-F2-02. IX2134.2 +051400 IF IX-FS1-KEY = "AAA040" IX2134.2 +051500 PERFORM PASS IX2134.2 +051600 ELSE GO TO READ-FAIL-F2-02. IX2134.2 +051700 GO TO READ-WRITE-F2-02. IX2134.2 +051800 READ-DELETE-F2-02. IX2134.2 +051900 PERFORM DE-LETE. IX2134.2 +052000 GO TO READ-WRITE-F2-02. IX2134.2 +052100 READ-INVALID-F2-02. IX2134.2 +052200 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +052300 TO RE-MARK. IX2134.2 +052400 PERFORM FAIL. IX2134.2 +052500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +052600 MOVE "QQQ040ALT08" TO CORRECT-A. IX2134.2 +052700 GO TO READ-WRITE-F2-02. IX2134.2 +052800 READ-FAIL-F2-02. IX2134.2 +052900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +053000 PERFORM FAIL. IX2134.2 +053100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +053200 MOVE "AAA040" TO CORRECT-A. IX2134.2 +053300 READ-WRITE-F2-02. IX2134.2 +053400 PERFORM PRINT-DETAIL. IX2134.2 +053500 DELETE-TEST-GF-01. IX2134.2 +053600 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +053700 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2134.2 +053800 MOVE "DELETES RECORD FOUND IN READ-TEST-GF-02" TO RE-MARK. IX2134.2 +053900 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-INVALID-GF-01. IX2134.2 +054000 PERFORM PASS. IX2134.2 +054100 GO TO DELETE-WRITE-GF-01. IX2134.2 +054200 DELETE-DELETE-GF-01. IX2134.2 +054300 PERFORM DE-LETE. IX2134.2 +054400 GO TO DELETE-WRITE-GF-01. IX2134.2 +054500 DELETE-INVALID-GF-01. IX2134.2 +054600 MOVE "IX-21; 4.3.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +054700 TO RE-MARK. IX2134.2 +054800 PERFORM FAIL. IX2134.2 +054900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +055000 MOVE "AAA040" TO CORRECT-A. IX2134.2 +055100 DELETE-WRITE-GF-01. IX2134.2 +055200 PERFORM PRINT-DETAIL. IX2134.2 +055300 READ-TEST-F2-03. IX2134.2 +055400 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +055500 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2134.2 +055600 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2134.2 +055700 MOVE "III030ALT04" TO IX-FS1-ALT04. IX2134.2 +055800 READ IX-FS1 RECORD IX2134.2 +055900 KEY IS IX-FS1-ALT04 IX2134.2 +056000 INVALID KEY GO TO READ-INVALID-F2-03. IX2134.2 +056100 IF IX-FS1-KEY = "AAA030" IX2134.2 +056200 PERFORM PASS IX2134.2 +056300 ELSE GO TO READ-FAIL-F2-03. IX2134.2 +056400 GO TO READ-WRITE-F2-03. IX2134.2 +056500 READ-DELETE-F2-03. IX2134.2 +056600 PERFORM DE-LETE. IX2134.2 +056700 GO TO READ-WRITE-F2-03. IX2134.2 +056800 READ-INVALID-F2-03. IX2134.2 +056900 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +057000 TO RE-MARK. IX2134.2 +057100 PERFORM FAIL. IX2134.2 +057200 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +057300 MOVE "III030ALT04" TO CORRECT-A. IX2134.2 +057400 GO TO READ-WRITE-F2-03. IX2134.2 +057500 READ-FAIL-F2-03. IX2134.2 +057600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +057700 PERFORM FAIL. IX2134.2 +057800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +057900 MOVE "AAA030" TO CORRECT-A. IX2134.2 +058000 READ-WRITE-F2-03. IX2134.2 +058100 PERFORM PRINT-DETAIL. IX2134.2 +058200 REWRITE-TEST-GF-01. IX2134.2 +058300 MOVE "REWRITE...INVALID..." TO FEATURE. IX2134.2 +058400 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX2134.2 +058500 MOVE "REWRITE-S RECORD FOUND IN READ-TEST-F2-03" TO RE-MARK. IX2134.2 +058600 MOVE "IIIIIIALT04" TO IX-FS1-ALT04. IX2134.2 +058700 REWRITE IX-FS1-RECORD INVALID KEY IX2134.2 +058800 GO TO REWRITE-INVALID-GF-01. IX2134.2 +058900 PERFORM PASS. IX2134.2 +059000 GO TO REWRITE-WRITE-GF-01. IX2134.2 +059100 REWRITE-DELETE-GF-01. IX2134.2 +059200 PERFORM DE-LETE. IX2134.2 +059300 GO TO REWRITE-WRITE-GF-01. IX2134.2 +059400 REWRITE-INVALID-GF-01. IX2134.2 +059500 MOVE "IX-33; 4.6.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +059600 TO RE-MARK. IX2134.2 +059700 PERFORM FAIL. IX2134.2 +059800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +059900 MOVE "IIIIIIALT04" TO CORRECT-A. IX2134.2 +060000 REWRITE-WRITE-GF-01. IX2134.2 +060100 PERFORM PRINT-DETAIL. IX2134.2 +060200 READ-TEST-F2-04. IX2134.2 +060300 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +060400 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX2134.2 +060500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2134.2 +060600 MOVE "ZZZ999ALT09" TO IX-FS1-ALT09. IX2134.2 +060700 READ IX-FS1 RECORD IX2134.2 +060800 KEY IS IX-FS1-ALT09 IX2134.2 +060900 INVALID KEY PERFORM PASS IX2134.2 +061000 GO TO READ-WRITE-F2-04. IX2134.2 +061100 GO TO READ-FAIL-F2-04. IX2134.2 +061200 READ-DELETE-F2-04. IX2134.2 +061300 PERFORM DE-LETE. IX2134.2 +061400 GO TO READ-WRITE-F2-04. IX2134.2 +061500 READ-FAIL-F2-04. IX2134.2 +061600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY SHOULD BE TAKEN" IX2134.2 +061700 TO RE-MARK. IX2134.2 +061800 PERFORM FAIL. IX2134.2 +061900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +062000 MOVE "INVALID KEY" TO CORRECT-A. IX2134.2 +062100 READ-WRITE-F2-04. IX2134.2 +062200 PERFORM PRINT-DETAIL. IX2134.2 +062300 START-TEST-GF-01. IX2134.2 +062400 MOVE "START...KEY IS EQUAL" TO FEATURE. IX2134.2 +062500 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2134.2 +062600 MOVE "RETRIEVED BY ALTERNATE KEY 3" TO RE-MARK. IX2134.2 +062700 MOVE "GGG020ALT03" TO IX-FS1-ALT03. IX2134.2 +062800 START IX-FS1 IX2134.2 +062900 KEY IS EQUAL TO IX-FS1-ALT03 IX2134.2 +063000 INVALID KEY GO TO START-INVALID-GF-01. IX2134.2 +063100 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-01. IX2134.2 +063200 IF IX-FS1-KEY = "AAA020" IX2134.2 +063300 PERFORM PASS IX2134.2 +063400 ELSE GO TO START-FAIL-GF-01. IX2134.2 +063500 GO TO START-WRITE-GF-01. IX2134.2 +063600 START-DELETE-GF-01. IX2134.2 +063700 PERFORM DE-LETE. IX2134.2 +063800 GO TO START-WRITE-GF-01. IX2134.2 +063900 START-INVALID-GF-01. IX2134.2 +064000 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +064100 TO RE-MARK. IX2134.2 +064200 PERFORM FAIL. IX2134.2 +064300 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +064400 MOVE "GGG020ALT03" TO CORRECT-A. IX2134.2 +064500 GO TO START-WRITE-GF-01. IX2134.2 +064600 START-END-GF-01. IX2134.2 +064700 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +064800 PERFORM FAIL. IX2134.2 +064900 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +065000 MOVE "AAA020" TO CORRECT-A. IX2134.2 +065100 GO TO START-WRITE-GF-01. IX2134.2 +065200 START-FAIL-GF-01. IX2134.2 +065300 PERFORM FAIL. IX2134.2 +065400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +065500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +065600 MOVE "AAA020" TO CORRECT-A. IX2134.2 +065700 START-WRITE-GF-01. IX2134.2 +065800 PERFORM PRINT-DETAIL. IX2134.2 +065900 START-TEST-GF-02. IX2134.2 +066000 MOVE "START...KEY >" TO FEATURE. IX2134.2 +066100 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2134.2 +066200 MOVE "RETRIEVED BY ALTERNATE KEY 6" TO RE-MARK. IX2134.2 +066300 MOVE "MMM090ALT06" TO IX-FS1-ALT06. IX2134.2 +066400 START IX-FS1 IX2134.2 +066500 KEY > IX-FS1-ALT06 IX2134.2 +066600 INVALID KEY GO TO START-INVALID-GF-02. IX2134.2 +066700 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-02. IX2134.2 +066800 IF IX-FS1-KEY = "AAA092" IX2134.2 +066900 PERFORM PASS IX2134.2 +067000 ELSE GO TO START-INVALID-GF-02. IX2134.2 +067100 GO TO START-WRITE-GF-02. IX2134.2 +067200 START-DELETE-GF-02. IX2134.2 +067300 PERFORM DE-LETE. IX2134.2 +067400 GO TO START-WRITE-GF-02. IX2134.2 +067500 START-INVALID-GF-02. IX2134.2 +067600 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +067700 TO RE-MARK. IX2134.2 +067800 PERFORM FAIL. IX2134.2 +067900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +068000 MOVE "MMM090ALT09" TO CORRECT-A. IX2134.2 +068100 GO TO START-WRITE-GF-02. IX2134.2 +068200 START-END-GF-02. IX2134.2 +068300 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +068400 PERFORM FAIL. IX2134.2 +068500 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +068600 MOVE "AAA092" TO CORRECT-A. IX2134.2 +068700 GO TO START-WRITE-GF-02. IX2134.2 +068800 START-FAIL-GF-02. IX2134.2 +068900 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2134.2 +069000 PERFORM FAIL. IX2134.2 +069100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +069200 MOVE "AAA092" TO CORRECT-A. IX2134.2 +069300 START-WRITE-GF-02. IX2134.2 +069400 PERFORM PRINT-DETAIL. IX2134.2 +069500 START-TEST-GF-03. IX2134.2 +069600 MOVE "START...KEY >" TO FEATURE. IX2134.2 +069700 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2134.2 +069800 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2134.2 +069900 MOVE "UUU080ALT10" TO IX-FS1-ALT10. IX2134.2 +070000 START IX-FS1 IX2134.2 +070100 KEY > IX-FS1-ALT10 IX2134.2 +070200 INVALID KEY GO TO START-INVALID-GF-03. IX2134.2 +070300 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-03. IX2134.2 +070400 IF IX-FS1-KEY = "AAA082" IX2134.2 +070500 PERFORM PASS IX2134.2 +070600 ELSE GO TO START-FAIL-GF-03. IX2134.2 +070700 GO TO START-WRITE-GF-03. IX2134.2 +070800 START-DELETE-GF-03. IX2134.2 +070900 PERFORM DE-LETE. IX2134.2 +071000 GO TO START-WRITE-GF-03. IX2134.2 +071100 START-INVALID-GF-03. IX2134.2 +071200 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +071300 TO RE-MARK. IX2134.2 +071400 PERFORM FAIL. IX2134.2 +071500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +071600 MOVE "UUU080ALT10" TO CORRECT-A. IX2134.2 +071700 GO TO START-WRITE-GF-03. IX2134.2 +071800 START-END-GF-03. IX2134.2 +071900 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +072000 PERFORM FAIL. IX2134.2 +072100 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +072200 MOVE "AAA082" TO CORRECT-A. IX2134.2 +072300 GO TO START-WRITE-GF-03. IX2134.2 +072400 START-FAIL-GF-03. IX2134.2 +072500 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2134.2 +072600 PERFORM FAIL. IX2134.2 +072700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +072800 MOVE "AAA082" TO CORRECT-A. IX2134.2 +072900 START-WRITE-GF-03. IX2134.2 +073000 PERFORM PRINT-DETAIL. IX2134.2 +073100 READ-TEST-F2-05. IX2134.2 +073200 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +073300 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2134.2 +073400 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2134.2 +073500 MOVE "QQQ040ALT08" TO IX-FS1-ALT08. IX2134.2 +073600 READ IX-FS1 RECORD IX2134.2 +073700 KEY IS IX-FS1-ALT08 IX2134.2 +073800 INVALID KEY GO TO READ-INVALID-F2-05. IX2134.2 +073900 IF IX-FS1-KEY = "AAA041" IX2134.2 +074000 PERFORM PASS IX2134.2 +074100 ELSE GO TO READ-FAIL-F2-05. IX2134.2 +074200 GO TO READ-WRITE-F2-05. IX2134.2 +074300 READ-DELETE-F2-05. IX2134.2 +074400 PERFORM DE-LETE. IX2134.2 +074500 GO TO READ-WRITE-F2-05. IX2134.2 +074600 READ-INVALID-F2-05. IX2134.2 +074700 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +074800 TO RE-MARK. IX2134.2 +074900 PERFORM FAIL. IX2134.2 +075000 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +075100 MOVE "QQQ040ALT08" TO CORRECT-A. IX2134.2 +075200 GO TO READ-WRITE-F2-05. IX2134.2 +075300 READ-FAIL-F2-05. IX2134.2 +075400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +075500 PERFORM FAIL. IX2134.2 +075600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +075700 MOVE "AAA041" TO CORRECT-A. IX2134.2 +075800 READ-WRITE-F2-05. IX2134.2 +075900 PERFORM PRINT-DETAIL. IX2134.2 +076000 READ-TEST-F2-06. IX2134.2 +076100 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +076200 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX2134.2 +076300 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2134.2 +076400 MOVE "IIIIIIALT04" TO IX-FS1-ALT04. IX2134.2 +076500 READ IX-FS1 RECORD IX2134.2 +076600 KEY IS IX-FS1-ALT04 IX2134.2 +076700 INVALID KEY GO TO READ-INVALID-F2-06. IX2134.2 +076800 IF IX-FS1-KEY = "AAA030" IX2134.2 +076900 PERFORM PASS IX2134.2 +077000 ELSE GO TO READ-FAIL-F2-06. IX2134.2 +077100 GO TO READ-WRITE-F2-06. IX2134.2 +077200 READ-DELETE-F2-06. IX2134.2 +077300 PERFORM DE-LETE. IX2134.2 +077400 GO TO READ-WRITE-F2-06. IX2134.2 +077500 READ-INVALID-F2-06. IX2134.2 +077600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +077700 TO RE-MARK. IX2134.2 +077800 PERFORM FAIL. IX2134.2 +077900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +078000 MOVE "IIIIIIALT04" TO CORRECT-A. IX2134.2 +078100 GO TO READ-WRITE-F2-06. IX2134.2 +078200 READ-FAIL-F2-06. IX2134.2 +078300 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +078400 PERFORM FAIL. IX2134.2 +078500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +078600 MOVE "AAA030" TO CORRECT-A. IX2134.2 +078700 READ-WRITE-F2-06. IX2134.2 +078800 PERFORM PRINT-DETAIL. IX2134.2 +078900 READ-TEST-F2-07. IX2134.2 +079000 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +079100 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX2134.2 +079200 MOVE "RETRIEVED BY PRIMARY KEY" TO RE-MARK. IX2134.2 +079300 MOVE "AAA011" TO IX-FS1-KEY. IX2134.2 +079400 READ IX-FS1 RECORD IX2134.2 +079500 KEY IS IX-FS1-KEY IX2134.2 +079600 INVALID KEY GO TO READ-INVALID-F2-07. IX2134.2 +079700 IF IX-FS1-KEY = "AAA011" IX2134.2 +079800 PERFORM PASS IX2134.2 +079900 ELSE GO TO READ-FAIL-F2-07. IX2134.2 +080000 GO TO READ-WRITE-F2-07. IX2134.2 +080100 READ-DELETE-F2-07. IX2134.2 +080200 PERFORM DE-LETE. IX2134.2 +080300 GO TO READ-WRITE-F2-07. IX2134.2 +080400 READ-INVALID-F2-07. IX2134.2 +080500 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +080600 TO RE-MARK. IX2134.2 +080700 PERFORM FAIL. IX2134.2 +080800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +080900 MOVE "AAA011" TO CORRECT-A. IX2134.2 +081000 GO TO READ-WRITE-F2-07. IX2134.2 +081100 READ-FAIL-F2-07. IX2134.2 +081200 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +081300 PERFORM FAIL. IX2134.2 +081400 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +081500 MOVE "AAA011" TO CORRECT-A. IX2134.2 +081600 READ-WRITE-F2-07. IX2134.2 +081700 PERFORM PRINT-DETAIL. IX2134.2 +081800 DELETE-TEST-GF-02. IX2134.2 +081900 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +082000 MOVE "DELETE-TEST-GF-02" TO PAR-NAME. IX2134.2 +082100 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-07" TO RE-MARK. IX2134.2 +082200 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-02. IX2134.2 +082300 PERFORM PASS. IX2134.2 +082400 GO TO DELETE-WRITE-GF-02. IX2134.2 +082500 DELETE-DELETE-GF-02. IX2134.2 +082600 PERFORM DE-LETE. IX2134.2 +082700 GO TO DELETE-WRITE-GF-02. IX2134.2 +082800 DELETE-FAIL-GF-02. IX2134.2 +082900 MOVE "IX-21; 4.3.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +083000 TO RE-MARK. IX2134.2 +083100 PERFORM FAIL. IX2134.2 +083200 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +083300 MOVE "AAA011" TO CORRECT-A. IX2134.2 +083400 DELETE-WRITE-GF-02. IX2134.2 +083500 PERFORM PRINT-DETAIL. IX2134.2 +083600 READ-TEST-F2-08. IX2134.2 +083700 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +083800 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX2134.2 +083900 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2134.2 +084000 MOVE "SSS060ALT09" TO IX-FS1-ALT09. IX2134.2 +084100 READ IX-FS1 RECORD IX2134.2 +084200 KEY IS IX-FS1-ALT09 IX2134.2 +084300 INVALID KEY GO TO READ-INVALID-F2-08. IX2134.2 +084400 IF IX-FS1-KEY = "AAA060" IX2134.2 +084500 PERFORM PASS IX2134.2 +084600 ELSE GO TO READ-FAIL-F2-08. IX2134.2 +084700 GO TO READ-WRITE-F2-08. IX2134.2 +084800 READ-DELETE-F2-08. IX2134.2 +084900 PERFORM DE-LETE. IX2134.2 +085000 GO TO READ-WRITE-F2-08. IX2134.2 +085100 READ-INVALID-F2-08. IX2134.2 +085200 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +085300 TO RE-MARK. IX2134.2 +085400 PERFORM FAIL. IX2134.2 +085500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +085600 MOVE "AAA060" TO CORRECT-A. IX2134.2 +085700 GO TO READ-WRITE-F2-08. IX2134.2 +085800 READ-FAIL-F2-08. IX2134.2 +085900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +086000 PERFORM FAIL. IX2134.2 +086100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +086200 MOVE "AAA060" TO CORRECT-A. IX2134.2 +086300 READ-WRITE-F2-08. IX2134.2 +086400 PERFORM PRINT-DETAIL. IX2134.2 +086500 REWRITE-TEST-GF-02. IX2134.2 +086600 MOVE "REWRITE...INVALID..." TO FEATURE. IX2134.2 +086700 MOVE "REWRITE-TEST-GF-02" TO PAR-NAME. IX2134.2 +086800 MOVE "REWRITES RECORD FOUND IN READ-TEST-GF-08" TO RE-MARK. IX2134.2 +086900 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2134.2 +087000 REWRITE IX-FS1-RECORD INVALID KEY GO TO REWRITE-FAIL-GF-02. IX2134.2 +087100 PERFORM PASS. IX2134.2 +087200 GO TO REWRITE-WRITE-GF-02. IX2134.2 +087300 REWRITE-DELETE-GF-02. IX2134.2 +087400 PERFORM DE-LETE. IX2134.2 +087500 GO TO REWRITE-WRITE-GF-02. IX2134.2 +087600 REWRITE-FAIL-GF-02. IX2134.2 +087700 PERFORM FAIL. IX2134.2 +087800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +087900 MOVE "SSSSSSALT09" TO CORRECT-A. IX2134.2 +088000 REWRITE-WRITE-GF-02. IX2134.2 +088100 PERFORM PRINT-DETAIL. IX2134.2 +088200 READ-TEST-F2-09. IX2134.2 +088300 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +088400 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX2134.2 +088500 MOVE "RETRIEVED BY ALTERNATE KEY 5" TO RE-MARK. IX2134.2 +088600 MOVE "KKK010ALT05" TO IX-FS1-ALT05. IX2134.2 +088700 READ IX-FS1 RECORD IX2134.2 +088800 KEY IS IX-FS1-ALT05 IX2134.2 +088900 INVALID KEY GO TO READ-INVALID-F2-09. IX2134.2 +089000 IF IX-FS1-KEY = "AAA010" IX2134.2 +089100 PERFORM PASS IX2134.2 +089200 ELSE GO TO READ-FAIL-F2-09. IX2134.2 +089300 GO TO READ-WRITE-F2-09. IX2134.2 +089400 READ-DELETE-F2-09. IX2134.2 +089500 PERFORM DE-LETE. IX2134.2 +089600 GO TO READ-WRITE-F2-09. IX2134.2 +089700 READ-INVALID-F2-09. IX2134.2 +089800 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +089900 TO RE-MARK. IX2134.2 +090000 PERFORM FAIL. IX2134.2 +090100 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +090200 MOVE "KKK010ALT05" TO CORRECT-A. IX2134.2 +090300 GO TO READ-WRITE-F2-09. IX2134.2 +090400 READ-FAIL-F2-09. IX2134.2 +090500 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +090600 PERFORM FAIL. IX2134.2 +090700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +090800 MOVE "AAA010" TO CORRECT-A. IX2134.2 +090900 READ-WRITE-F2-09. IX2134.2 +091000 PERFORM PRINT-DETAIL. IX2134.2 +091100 READ-TEST-F2-10. IX2134.2 +091200 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +091300 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX2134.2 +091400 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2134.2 +091500 MOVE "SSS060ALT09" TO IX-FS1-ALT09. IX2134.2 +091600 READ IX-FS1 RECORD IX2134.2 +091700 KEY IS IX-FS1-ALT09 IX2134.2 +091800 INVALID KEY GO TO READ-INVALID-F2-10. IX2134.2 +091900 IF IX-FS1-KEY = "AAA061" IX2134.2 +092000 PERFORM PASS IX2134.2 +092100 ELSE GO TO READ-FAIL-F2-10. IX2134.2 +092200 GO TO READ-WRITE-F2-10. IX2134.2 +092300 READ-DELETE-F2-10. IX2134.2 +092400 PERFORM DE-LETE. IX2134.2 +092500 GO TO READ-WRITE-F2-10. IX2134.2 +092600 READ-INVALID-F2-10. IX2134.2 +092700 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +092800 TO RE-MARK. IX2134.2 +092900 PERFORM FAIL. IX2134.2 +093000 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +093100 MOVE "SSS060ALT09" TO CORRECT-A. IX2134.2 +093200 GO TO READ-WRITE-F2-10. IX2134.2 +093300 READ-FAIL-F2-10. IX2134.2 +093400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +093500 PERFORM FAIL. IX2134.2 +093600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +093700 MOVE "AAA061" TO CORRECT-A. IX2134.2 +093800 READ-WRITE-F2-10. IX2134.2 +093900 PERFORM PRINT-DETAIL. IX2134.2 +094000 READ-TEST-F2-11. IX2134.2 +094100 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +094200 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX2134.2 +094300 MOVE "RETRIEVED BY ALTERNATE KEY 7" TO RE-MARK. IX2134.2 +094400 MOVE "OOO070ALT07" TO IX-FS1-ALT07. IX2134.2 +094500 READ IX-FS1 RECORD IX2134.2 +094600 KEY IS IX-FS1-ALT07 IX2134.2 +094700 INVALID KEY GO TO READ-INVALID-F2-11. IX2134.2 +094800 IF IX-FS1-KEY = "AAA070" IX2134.2 +094900 PERFORM PASS IX2134.2 +095000 ELSE GO TO READ-FAIL-F2-11. IX2134.2 +095100 GO TO READ-WRITE-F2-11. IX2134.2 +095200 READ-DELETE-F2-11. IX2134.2 +095300 PERFORM DE-LETE. IX2134.2 +095400 GO TO READ-WRITE-F2-11. IX2134.2 +095500 READ-INVALID-F2-11. IX2134.2 +095600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +095700 TO RE-MARK. IX2134.2 +095800 PERFORM FAIL. IX2134.2 +095900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +096000 MOVE "OOO070ALT07" TO CORRECT-A. IX2134.2 +096100 GO TO READ-WRITE-F2-11. IX2134.2 +096200 READ-FAIL-F2-11. IX2134.2 +096300 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +096400 PERFORM FAIL. IX2134.2 +096500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +096600 MOVE "AAA070" TO CORRECT-A. IX2134.2 +096700 READ-WRITE-F2-11. IX2134.2 +096800 PERFORM PRINT-DETAIL. IX2134.2 +096900 DELETE-TEST-GF-03. IX2134.2 +097000 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +097100 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2134.2 +097200 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-11" TO RE-MARK. IX2134.2 +097300 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-03. IX2134.2 +097400 PERFORM PASS. IX2134.2 +097500 GO TO DELETE-WRITE-GF-03. IX2134.2 +097600 DELETE-DELETE-GF-03. IX2134.2 +097700 PERFORM DE-LETE. IX2134.2 +097800 GO TO DELETE-WRITE-GF-03. IX2134.2 +097900 DELETE-FAIL-GF-03. IX2134.2 +098000 MOVE "IX-21; 4.3.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +098100 TO RE-MARK. IX2134.2 +098200 PERFORM FAIL. IX2134.2 +098300 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +098400 MOVE "AAA070" TO CORRECT-A. IX2134.2 +098500 DELETE-WRITE-GF-03. IX2134.2 +098600 PERFORM PRINT-DETAIL. IX2134.2 +098700 READ-TEST-F2-12. IX2134.2 +098800 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +098900 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX2134.2 +099000 MOVE "RETRIEVED BY ALTERNATE KEY 5" TO RE-MARK. IX2134.2 +099100 MOVE "KKK070ALT05" TO IX-FS1-ALT05. IX2134.2 +099200 READ IX-FS1 RECORD IX2134.2 +099300 KEY IS IX-FS1-ALT05 IX2134.2 +099400 INVALID KEY GO TO READ-INVALID-F2-12. IX2134.2 +099500 IF IX-FS1-KEY = "AAA071" IX2134.2 +099600 PERFORM PASS IX2134.2 +099700 ELSE GO TO READ-FAIL-F2-12. IX2134.2 +099800 GO TO READ-WRITE-F2-12. IX2134.2 +099900 READ-DELETE-F2-12. IX2134.2 +100000 PERFORM DE-LETE. IX2134.2 +100100 GO TO READ-WRITE-F2-12. IX2134.2 +100200 READ-INVALID-F2-12. IX2134.2 +100300 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +100400 TO RE-MARK. IX2134.2 +100500 PERFORM FAIL. IX2134.2 +100600 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +100700 MOVE "KKK070ALT05" TO CORRECT-A. IX2134.2 +100800 GO TO READ-WRITE-F2-12. IX2134.2 +100900 READ-FAIL-F2-12. IX2134.2 +101000 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +101100 PERFORM FAIL. IX2134.2 +101200 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +101300 MOVE "AAA071" TO CORRECT-A. IX2134.2 +101400 READ-WRITE-F2-12. IX2134.2 +101500 PERFORM PRINT-DETAIL. IX2134.2 +101600 CLOSE IX-FS1. IX2134.2 +101700 CCVS-EXIT SECTION. IX2134.2 +101800 CCVS-999999. IX2134.2 +101900 GO TO CLOSE-FILES. IX2134.2 +*END-OF,IX213A +*HEADER,COBOL,IX214A +000100 IDENTIFICATION DIVISION. IX2144.2 +000200 PROGRAM-ID. IX2144.2 +000300 IX214A. IX2144.2 +000400**************************************************************** IX2144.2 +000500* * IX2144.2 +000600* VALIDATION FOR:- * IX2144.2 +000700* * IX2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +000900* * IX2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2144.2 +001100* * IX2144.2 +001200**************************************************************** IX2144.2 +001300* * IX2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2144.2 +001500* * IX2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2144.2 +001900* * IX2144.2 +002000**************************************************************** IX2144.2 +002100* "IX214A" IX2144.2 +002200******************************************************************IX2144.2 +002300* THE PURPOSE OF THE PROGRAM IS TO TEST USE OF THE IX2144.2 +002400* START --- NOT LESS THAN --- STATEMENT USING FIRST THE PRIME IX2144.2 +002500* RECORD KEY AND THEN WITH AN ALTERNATE RECORD KEY IX2144.2 +002600* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2144.2 +002700* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2144.2 +002800* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2144.2 +002900* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2144.2 +003000* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2144.2 +003100* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2144.2 +003200* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2144.2 +003300* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2144.2 +003400* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2144.2 +003500* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2144.2 +003600* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2144.2 +003700* IX2144.2 +003800* REFERENCE AMERICAN NATIONAL STANDARD IX2144.2 +003900* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2144.2 +004000* SECTION IX, INDEX I-O, THE START IX2144.2 +004100* STATEMENT. PARAGRAPHS 4.7.3 (3), (4); IX2144.2 +004200* 4.7.4 (1), (4), (5)IX2144.2 +004300* AND IX2144.2 +004400* THE FILE STATUS PARAGRAPH 1.3.4 IX2144.2 +004500* IX2144.2 +004600* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2144.2 +004700* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2144.2 +004800* FROM THE TEST. IF DURING THIS PROCEDURE AN INVALID KEY OCCURIX2144.2 +004900* THE TEST IS DELETED. ALSO BEFORE EACH TEST THE RECORD KEY ISIX2144.2 +005000* LOADED WITH A KEY VALUE AND DEPENDING ON THE NATURE OF THE TEIX2144.2 +005100* THE KEY VALUE MAY OR MAY NOT BE A VALID KEY FOR THE FILE. IX2144.2 +005200* IX2144.2 +005300* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2144.2 +005400* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2144.2 +005500* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2144.2 +005600* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2144.2 +005700* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2144.2 +005800* NOT LESS THAN ---STATEMENT. IX2144.2 +005900* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2144.2 +006000* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2144.2 +006100* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2144.2 +006200* THE FILE. IX2144.2 +006300* IX2144.2 +006400* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2144.2 +006500* ------ ---------- --------------- --------------- IX2144.2 +006600* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2144.2 +006700* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2144.2 +006800* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2144.2 +006900* . . . . IX2144.2 +007000* . . . . IX2144.2 +007100* . . . . IX2144.2 +007200* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2144.2 +007300* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2144.2 +007400* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2144.2 +007500* . . . . IX2144.2 +007600* . . . . IX2144.2 +007700* . . . . IX2144.2 +007800* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2144.2 +007900* IX2144.2 +008000* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2144.2 +008100* EVERY 10TH AND 11TH RECORDS. IX2144.2 +008200* IX2144.2 +008300* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2144.2 +008400* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2144.2 +008500* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2144.2 +008600* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2144.2 +008700* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2144.2 +008800* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2144.2 +008900* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2144.2 +009000* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2144.2 +009100* THE FILE. IX2144.2 +009200* IX2144.2 +009300* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2144.2 +009400* RECORD SIZE = 240 CHARS. IX2144.2 +009500* RECORD KEY SIZE = 13 CHARS. IX2144.2 +009600* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2144.2 +009700* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2144.2 +009800* ACCESS MODE = SEQUENTIAL IX2144.2 +009900* IX2144.2 +010000* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2144.2 +010100* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2144.2 +010200* TEST FOLLOWS. IX2144.2 +010300* IX2144.2 +010400* PROGRAM COLLATING SEQUENCE CLAUSE. (ALL START TESTS) - IX2144.2 +010500* THE PROGRAM COLLATING SEQUENCE CLAUSE SHOULD HAVE NO IX2144.2 +010600* EFFECT ON THE COMARAISIONS ASSOCIATED WITH THE START IX2144.2 +010700* STATEMENT. THIS PROGRAM ASSUMES THAT THE PROGRAM IX2144.2 +010800* COLLATING SEQUENCE CLAUSE ALSO DOES NOT IN ANY WAY IX2144.2 +010900* EFFECT THE SEQUENTIAL ORDER OF RECORDS ACCESSED IX2144.2 +011000* FROM OR WRITTEN TO THE FILE. IX2144.2 +011100* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2144.2 +011200* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2144.2 +011300* TWO ALTERNATE KEYS. IX2144.2 +011400* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2144.2 +011500* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2144.2 +011600* FILE WAS CREATED CORRECTLY. IX2144.2 +011700* START ---KEY NOT LESS THAN RECORD-KEY INVALID KEY ---. (INXIX2144.2 +011800* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2144.2 +011900* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2144.2 +012000* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +012100* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2144.2 +012200* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2144.2 +012300* (.03) AND NOT LESS THAN THAN THE LAST RECORD IN THE IX2144.2 +012400* FILE (.04). IX2144.2 +012500* START ---KEY NOT LESS THAN DATA-ITEM INVALID KEY ---. (INXIX2144.2 +012600* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2144.2 +012700* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2144.2 +012800* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2144.2 +012900* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +013000* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2144.2 +013100* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2144.2 +013200* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2144.2 +013300* THE FIRST RECORD IN THE FILE (.08) AND NOT LESS THAN IX2144.2 +013400* THE LAST RECORD IN THE FILE (.09. IX2144.2 +013500* IX2144.2 +013600* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2144.2 +013700* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2144.2 +013800* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2144.2 +013900* NAMED BY THE RECORD KEY CLAUSE. IX2144.2 +014000* IX2144.2 +014100* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2144.2 +014200* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2144.2 +014300* FROM THE START IN INX-TEST-003.01 THRU IX2144.2 +014400* INX-TEST-003.09. IX2144.2 +014500* START ---KEY NOT LESS THAN ALTNATE-KEY INVALID KEY --. (INXIX2144.2 +014600* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2144.2 +014700* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2144.2 +014800* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +014900* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2144.2 +015000* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2144.2 +015100* (.03) AND NOT LESS THAN THAN THE LAST RECORD IN THE IX2144.2 +015200* FILE (.04). IX2144.2 +015300* START ---KEY NOT LESS THAN DATA-ITEM INVALID KEY --. (INXIX2144.2 +015400* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2144.2 +015500* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2144.2 +015600* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2144.2 +015700* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +015800* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2144.2 +015900* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2144.2 +016000* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2144.2 +016100* THE FIRST RECORD IN THE FILE (.08) AND NOT LESS THAN IX2144.2 +016200* THE LAST RECORD IN THE FILE (.09. IX2144.2 +016300* IX2144.2 +016400* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2144.2 +016500* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2144.2 +016600* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2144.2 +016700* NAMED BY THE RECORD KEY CLAUSE. IX2144.2 +016800* IX2144.2 +016900* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2144.2 +017000* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2144.2 +017100* FROM THE START IN INX-TEST-005.01 THRU IX2144.2 +017200* INX-TEST-005.09. IX2144.2 +017300* MULTIPLE STARTS. (INX-TEST-007) - THIS TEST EXECUTES IX2144.2 +017400* SEVERAL START STATEMENTS FOLLOWED BY A READ STATEMENTIX2144.2 +017500* AND EXPECTS THE RECORD DESIGNATED BY THE LAST IX2144.2 +017600* START BE MADE AVAILABLE. IX2144.2 +017700* IX2144.2 +017800******************************************************************IX2144.2 +017900* IX2144.2 +018000 ENVIRONMENT DIVISION. IX2144.2 +018100 CONFIGURATION SECTION. IX2144.2 +018200 SOURCE-COMPUTER. IX2144.2 +018300 XXXXX082. IX2144.2 +018400 OBJECT-COMPUTER. IX2144.2 +018500 XXXXX083 IX2144.2 +018600 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2144.2 +018700 SPECIAL-NAMES. IX2144.2 +018800 ALPHABET IX2144.2 +018900 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2144.2 +019000 INPUT-OUTPUT SECTION. IX2144.2 +019100 FILE-CONTROL. IX2144.2 +019200P SELECT RAW-DATA ASSIGN TO IX2144.2 +019300P XXXXX062 IX2144.2 +019400P ORGANIZATION IS INDEXED IX2144.2 +019500P ACCESS MODE IS RANDOM IX2144.2 +019600P RECORD KEY IS RAW-DATA-KEY. IX2144.2 +019700 SELECT PRINT-FILE ASSIGN TO IX2144.2 +019800 XXXXX055. IX2144.2 +019900 SELECT IX-FS1 IX2144.2 +020000 ASSIGN TO IX2144.2 +020100 XXXXX024 IX2144.2 +020200J XXXXX044 IX2144.2 +020300 ACCESS MODE IS SEQUENTIAL IX2144.2 +020400 ORGANIZATION IS INDEXED IX2144.2 +020500 RECORD KEY IS IX-FS1-KEY IX2144.2 +020600 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2144.2 +020700 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2144.2 +020800 FILE STATUS IS FS1-STATUS. IX2144.2 +020900 DATA DIVISION. IX2144.2 +021000 FILE SECTION. IX2144.2 +021100P IX2144.2 +021200PFD RAW-DATA. IX2144.2 +021300P IX2144.2 +021400P01 RAW-DATA-SATZ. IX2144.2 +021500P 05 RAW-DATA-KEY PIC X(6). IX2144.2 +021600P 05 C-DATE PIC 9(6). IX2144.2 +021700P 05 C-TIME PIC 9(8). IX2144.2 +021800P 05 C-NO-OF-TESTS PIC 99. IX2144.2 +021900P 05 C-OK PIC 999. IX2144.2 +022000P 05 C-ALL PIC 999. IX2144.2 +022100P 05 C-FAIL PIC 999. IX2144.2 +022200P 05 C-DELETED PIC 999. IX2144.2 +022300P 05 C-INSPECT PIC 999. IX2144.2 +022400P 05 C-NOTE PIC X(13). IX2144.2 +022500P 05 C-INDENT PIC X. IX2144.2 +022600P 05 C-ABORT PIC X(8). IX2144.2 +022700 FD PRINT-FILE. IX2144.2 +022800 01 PRINT-REC PICTURE X(120). IX2144.2 +022900 01 DUMMY-RECORD PICTURE X(120). IX2144.2 +023000 FD IX-FS1 IX2144.2 +023100C LABEL RECORDS ARE STANDARD IX2144.2 +023200C DATA RECORD IS IX-FS1R1-F-G-240 IX2144.2 +023300 RECORD CONTAINS 240 CHARACTERS. IX2144.2 +023400 01 IX-FS1R1-F-G-240. IX2144.2 +023500 05 IX-FS1-REC-120 PICTURE X(120). IX2144.2 +023600 05 IX-FS1-REC-121-240. IX2144.2 +023700 10 FILLER PICTURE X(8). IX2144.2 +023800 10 IX-REC-KEY-AREA. IX2144.2 +023900 15 IX-FS1-KEY. IX2144.2 +024000 20 IX-FS1-KEY-1-10. IX2144.2 +024100 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2144.2 +024200 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2144.2 +024300 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2144.2 +024400 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX2144.2 +024500 20 R-RECKEY-1-7 PICTURE X(7). IX2144.2 +024600 20 R-RECKEY-8-13 PICTURE X(6). IX2144.2 +024700 15 FILLER PICTURE X(16). IX2144.2 +024800 10 FILLER PICTURE X(9). IX2144.2 +024900 10 IX-ALT-KEY1-AREA. IX2144.2 +025000 15 IX-FS1-ALTKEY1. IX2144.2 +025100 20 IX-FS1-ALTKEY1-1-10. IX2144.2 +025200 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2144.2 +025300 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2144.2 +025400 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2144.2 +025500 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2144.2 +025600 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX2144.2 +025700 20 R-ALTKEY1-1-6 PICTURE X(6). IX2144.2 +025800 20 R-ALTKEY1-7-10 PICTURE X(4). IX2144.2 +025900 20 R-ALTKEY1-11-20 PICTURE X(10). IX2144.2 +026000 15 FILLER PICTURE X(9). IX2144.2 +026100 10 FILLER PICTURE X(9). IX2144.2 +026200 10 IX-ALT-KEY2-AREA. IX2144.2 +026300 15 IX-FS1-ALTKEY2. IX2144.2 +026400 20 IX-FS1-ALTKEY2-1-10. IX2144.2 +026500 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2144.2 +026600 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2144.2 +026700 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2144.2 +026800 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2144.2 +026900 15 FILLER PICTURE X(9). IX2144.2 +027000 10 FILLER PICTURE X(7). IX2144.2 +027100 WORKING-STORAGE SECTION. IX2144.2 +027200 01 WRK-FS1-RECKEY. IX2144.2 +027300 05 FS1-RECKEY-1-13. IX2144.2 +027400 10 FS1-RECKEY-1-10 PICTURE X(10). IX2144.2 +027500 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2144.2 +027600 05 FILLER PICTURE X(16) VALUE SPACE. IX2144.2 +027700 01 WRK-FS1-ALTKEY1. IX2144.2 +027800 05 FS1-ALTKEY1-1-20. IX2144.2 +027900 10 FS1-ALTKEY1-1-10. IX2144.2 +028000 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2144.2 +028100 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2144.2 +028200 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2144.2 +028300 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2144.2 +028400 05 FILLER PICTURE X(9) VALUE SPACE. IX2144.2 +028500 01 WRK-FS1-ALTKEY2. IX2144.2 +028600 05 FS1-ALTKEY2-1-20. IX2144.2 +028700 10 FS1-ALTKEY2-1-10. IX2144.2 +028800 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2144.2 +028900 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2144.2 +029000 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2144.2 +029100 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2144.2 +029200 05 FILLER PICTURE X(9) VALUE SPACE. IX2144.2 +029300 01 RECNO PICTURE 9(5) VALUE ZERO. IX2144.2 +029400 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2144.2 +029500 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2144.2 +029600 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2144.2 +029700 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2144.2 +029800 01 RECORDS-WRITTEN PICTURE 9(3). IX2144.2 +029900 01 RECKEY-NUM PICTURE 9(3). IX2144.2 +030000 01 ALTKEY1-NUM PICTURE 9(3). IX2144.2 +030100 01 ALTKEY2-NUM PICTURE 9(3). IX2144.2 +030200 01 RECORD-KEY-CONTENT. IX2144.2 +030300 05 FILLER PIC X(53) VALUE IX2144.2 +030400 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2144.2 +030500 05 FILLER PIC X(53) VALUE IX2144.2 +030600 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2144.2 +030700 05 FILLER PIC X(53) VALUE IX2144.2 +030800 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2144.2 +030900 05 FILLER PIC X(53) VALUE IX2144.2 +031000 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2144.2 +031100 05 FILLER PIC X(53) VALUE IX2144.2 +031200 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2144.2 +031300 05 FILLER PIC X(53) VALUE IX2144.2 +031400 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2144.2 +031500 05 FILLER PIC X(53) VALUE IX2144.2 +031600 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2144.2 +031700 05 FILLER PIC X(53) VALUE IX2144.2 +031800 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2144.2 +031900 05 FILLER PIC X(53) VALUE IX2144.2 +032000 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2144.2 +032100 05 FILLER PIC X(53) VALUE IX2144.2 +032200 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2144.2 +032300 05 FILLER PIC X(53) VALUE IX2144.2 +032400 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2144.2 +032500 05 FILLER PIC X(53) VALUE IX2144.2 +032600 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2144.2 +032700 05 FILLER PIC X(53) VALUE IX2144.2 +032800 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2144.2 +032900 05 FILLER PIC X(53) VALUE IX2144.2 +033000 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2144.2 +033100 05 FILLER PIC X(53) VALUE IX2144.2 +033200 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2144.2 +033300 05 FILLER PIC X(53) VALUE IX2144.2 +033400 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2144.2 +033500 05 FILLER PIC X(53) VALUE IX2144.2 +033600 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2144.2 +033700 05 FILLER PIC X(53) VALUE IX2144.2 +033800 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2144.2 +033900 05 FILLER PIC X(53) VALUE IX2144.2 +034000 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2144.2 +034100 05 FILLER PIC X(53) VALUE IX2144.2 +034200 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2144.2 +034300 05 FILLER PIC X(53) VALUE IX2144.2 +034400 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2144.2 +034500 05 FILLER PIC X(53) VALUE IX2144.2 +034600 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2144.2 +034700 05 FILLER PIC X(53) VALUE IX2144.2 +034800 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2144.2 +034900 05 FILLER PIC X(53) VALUE IX2144.2 +035000 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2144.2 +035100 05 FILLER PIC X(53) VALUE IX2144.2 +035200 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2144.2 +035300 05 FILLER PIC X(53) VALUE IX2144.2 +035400 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2144.2 +035500 05 FILLER PIC X(53) VALUE IX2144.2 +035600 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2144.2 +035700 05 FILLER PIC X(53) VALUE IX2144.2 +035800 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2144.2 +035900 05 FILLER PIC X(53) VALUE IX2144.2 +036000 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2144.2 +036100 05 FILLER PIC X(53) VALUE IX2144.2 +036200 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2144.2 +036300 05 FILLER PIC X(53) VALUE IX2144.2 +036400 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2144.2 +036500 05 FILLER PIC X(53) VALUE IX2144.2 +036600 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2144.2 +036700 05 FILLER PIC X(53) VALUE IX2144.2 +036800 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2144.2 +036900 05 FILLER PIC X(53) VALUE IX2144.2 +037000 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2144.2 +037100 05 FILLER PIC X(53) VALUE IX2144.2 +037200 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2144.2 +037300 05 FILLER PIC X(53) VALUE IX2144.2 +037400 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2144.2 +037500 05 FILLER PIC X(53) VALUE IX2144.2 +037600 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2144.2 +037700 05 FILLER PIC X(53) VALUE IX2144.2 +037800 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2144.2 +037900 05 FILLER PIC X(53) VALUE IX2144.2 +038000 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2144.2 +038100 05 FILLER PIC X(53) VALUE IX2144.2 +038200 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2144.2 +038300 05 FILLER PIC X(53) VALUE IX2144.2 +038400 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2144.2 +038500 05 FILLER PIC X(53) VALUE IX2144.2 +038600 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2144.2 +038700 05 FILLER PIC X(53) VALUE IX2144.2 +038800 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2144.2 +038900 05 FILLER PIC X(53) VALUE IX2144.2 +039000 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2144.2 +039100 05 FILLER PIC X(53) VALUE IX2144.2 +039200 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2144.2 +039300 05 FILLER PIC X(53) VALUE IX2144.2 +039400 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2144.2 +039500 05 FILLER PIC X(53) VALUE IX2144.2 +039600 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2144.2 +039700 05 FILLER PIC X(53) VALUE IX2144.2 +039800 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2144.2 +039900 05 FILLER PIC X(53) VALUE IX2144.2 +040000 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2144.2 +040100 05 FILLER PIC X(53) VALUE IX2144.2 +040200 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2144.2 +040300 05 FILLER PIC X(53) VALUE IX2144.2 +040400 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2144.2 +040500 05 FILLER PIC X(53) VALUE IX2144.2 +040600 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2144.2 +040700 05 FILLER PIC X(53) VALUE IX2144.2 +040800 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2144.2 +040900 05 FILLER PIC X(53) VALUE IX2144.2 +041000 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2144.2 +041100 05 FILLER PIC X(53) VALUE IX2144.2 +041200 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2144.2 +041300 05 FILLER PIC X(53) VALUE IX2144.2 +041400 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2144.2 +041500 05 FILLER PIC X(53) VALUE IX2144.2 +041600 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2144.2 +041700 05 FILLER PIC X(53) VALUE IX2144.2 +041800 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2144.2 +041900 05 FILLER PIC X(53) VALUE IX2144.2 +042000 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2144.2 +042100 05 FILLER PIC X(53) VALUE IX2144.2 +042200 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2144.2 +042300 05 FILLER PIC X(53) VALUE IX2144.2 +042400 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2144.2 +042500 05 FILLER PIC X(53) VALUE IX2144.2 +042600 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2144.2 +042700 05 FILLER PIC X(53) VALUE IX2144.2 +042800 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2144.2 +042900 05 FILLER PIC X(53) VALUE IX2144.2 +043000 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2144.2 +043100 05 FILLER PIC X(53) VALUE IX2144.2 +043200 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2144.2 +043300 05 FILLER PIC X(53) VALUE IX2144.2 +043400 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2144.2 +043500 05 FILLER PIC X(53) VALUE IX2144.2 +043600 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2144.2 +043700 05 FILLER PIC X(53) VALUE IX2144.2 +043800 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2144.2 +043900 05 FILLER PIC X(53) VALUE IX2144.2 +044000 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2144.2 +044100 05 FILLER PIC X(53) VALUE IX2144.2 +044200 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2144.2 +044300 05 FILLER PIC X(53) VALUE IX2144.2 +044400 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2144.2 +044500 05 FILLER PIC X(53) VALUE IX2144.2 +044600 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2144.2 +044700 05 FILLER PIC X(53) VALUE IX2144.2 +044800 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2144.2 +044900 05 FILLER PIC X(53) VALUE IX2144.2 +045000 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2144.2 +045100 05 FILLER PIC X(53) VALUE IX2144.2 +045200 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2144.2 +045300 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2144.2 +045400 05 KEY-VALUES OCCURS 75 TIMES. IX2144.2 +045500 10 RECKEY-VALUE PICTURE X(13). IX2144.2 +045600 10 ALTKEY1-VALUE PICTURE X(20). IX2144.2 +045700 10 ALTKEY2-VALUE PICTURE X(20). IX2144.2 +045800 01 INIT-FLAG PICTURE 9. IX2144.2 +045900 01 HOLD-FILESTATUS-RECORD. IX2144.2 +046000 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2144.2 +046100 01 FILE-RECORD-INFORMATION-REC. IX2144.2 +046200 03 FILE-RECORD-INFO-SKELETON. IX2144.2 +046300 05 FILLER PICTURE X(48) VALUE IX2144.2 +046400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2144.2 +046500 05 FILLER PICTURE X(46) VALUE IX2144.2 +046600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2144.2 +046700 05 FILLER PICTURE X(26) VALUE IX2144.2 +046800 ",LFIL=000000,ORG= ,LBLR= ". IX2144.2 +046900 05 FILLER PICTURE X(37) VALUE IX2144.2 +047000 ",RECKEY= ". IX2144.2 +047100 05 FILLER PICTURE X(38) VALUE IX2144.2 +047200 ",ALTKEY1= ". IX2144.2 +047300 05 FILLER PICTURE X(38) VALUE IX2144.2 +047400 ",ALTKEY2= ". IX2144.2 +047500 05 FILLER PICTURE X(7) VALUE SPACE.IX2144.2 +047600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2144.2 +047700 05 FILE-RECORD-INFO-P1-120. IX2144.2 +047800 07 FILLER PIC X(5). IX2144.2 +047900 07 XFILE-NAME PIC X(6). IX2144.2 +048000 07 FILLER PIC X(8). IX2144.2 +048100 07 XRECORD-NAME PIC X(6). IX2144.2 +048200 07 FILLER PIC X(1). IX2144.2 +048300 07 REELUNIT-NUMBER PIC 9(1). IX2144.2 +048400 07 FILLER PIC X(7). IX2144.2 +048500 07 XRECORD-NUMBER PIC 9(6). IX2144.2 +048600 07 FILLER PIC X(6). IX2144.2 +048700 07 UPDATE-NUMBER PIC 9(2). IX2144.2 +048800 07 FILLER PIC X(5). IX2144.2 +048900 07 ODO-NUMBER PIC 9(4). IX2144.2 +049000 07 FILLER PIC X(5). IX2144.2 +049100 07 XPROGRAM-NAME PIC X(5). IX2144.2 +049200 07 FILLER PIC X(7). IX2144.2 +049300 07 XRECORD-LENGTH PIC 9(6). IX2144.2 +049400 07 FILLER PIC X(7). IX2144.2 +049500 07 CHARS-OR-RECORDS PIC X(2). IX2144.2 +049600 07 FILLER PIC X(1). IX2144.2 +049700 07 XBLOCK-SIZE PIC 9(4). IX2144.2 +049800 07 FILLER PIC X(6). IX2144.2 +049900 07 RECORDS-IN-FILE PIC 9(6). IX2144.2 +050000 07 FILLER PIC X(5). IX2144.2 +050100 07 XFILE-ORGANIZATION PIC X(2). IX2144.2 +050200 07 FILLER PIC X(6). IX2144.2 +050300 07 XLABEL-TYPE PIC X(1). IX2144.2 +050400 05 FILE-RECORD-INFO-P121-240. IX2144.2 +050500 07 FILLER PIC X(8). IX2144.2 +050600 07 XRECORD-KEY PIC X(29). IX2144.2 +050700 07 FILLER PIC X(9). IX2144.2 +050800 07 ALTERNATE-KEY1 PIC X(29). IX2144.2 +050900 07 FILLER PIC X(9). IX2144.2 +051000 07 ALTERNATE-KEY2 PIC X(29). IX2144.2 +051100 07 FILLER PIC X(7). IX2144.2 +051200 01 TEST-RESULTS. IX2144.2 +051300 02 FILLER PIC X VALUE SPACE. IX2144.2 +051400 02 FEATURE PIC X(20) VALUE SPACE. IX2144.2 +051500 02 FILLER PIC X VALUE SPACE. IX2144.2 +051600 02 P-OR-F PIC X(5) VALUE SPACE. IX2144.2 +051700 02 FILLER PIC X VALUE SPACE. IX2144.2 +051800 02 PAR-NAME. IX2144.2 +051900 03 FILLER PIC X(19) VALUE SPACE. IX2144.2 +052000 03 PARDOT-X PIC X VALUE SPACE. IX2144.2 +052100 03 DOTVALUE PIC 99 VALUE ZERO. IX2144.2 +052200 02 FILLER PIC X(8) VALUE SPACE. IX2144.2 +052300 02 RE-MARK PIC X(61). IX2144.2 +052400 01 TEST-COMPUTED. IX2144.2 +052500 02 FILLER PIC X(30) VALUE SPACE. IX2144.2 +052600 02 FILLER PIC X(17) VALUE IX2144.2 +052700 " COMPUTED=". IX2144.2 +052800 02 COMPUTED-X. IX2144.2 +052900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2144.2 +053000 03 COMPUTED-N REDEFINES COMPUTED-A IX2144.2 +053100 PIC -9(9).9(9). IX2144.2 +053200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2144.2 +053300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2144.2 +053400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2144.2 +053500 03 CM-18V0 REDEFINES COMPUTED-A. IX2144.2 +053600 04 COMPUTED-18V0 PIC -9(18). IX2144.2 +053700 04 FILLER PIC X. IX2144.2 +053800 03 FILLER PIC X(50) VALUE SPACE. IX2144.2 +053900 01 TEST-CORRECT. IX2144.2 +054000 02 FILLER PIC X(30) VALUE SPACE. IX2144.2 +054100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2144.2 +054200 02 CORRECT-X. IX2144.2 +054300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2144.2 +054400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2144.2 +054500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2144.2 +054600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2144.2 +054700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2144.2 +054800 03 CR-18V0 REDEFINES CORRECT-A. IX2144.2 +054900 04 CORRECT-18V0 PIC -9(18). IX2144.2 +055000 04 FILLER PIC X. IX2144.2 +055100 03 FILLER PIC X(2) VALUE SPACE. IX2144.2 +055200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2144.2 +055300 01 CCVS-C-1. IX2144.2 +055400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2144.2 +055500- "SS PARAGRAPH-NAME IX2144.2 +055600- " REMARKS". IX2144.2 +055700 02 FILLER PIC X(20) VALUE SPACE. IX2144.2 +055800 01 CCVS-C-2. IX2144.2 +055900 02 FILLER PIC X VALUE SPACE. IX2144.2 +056000 02 FILLER PIC X(6) VALUE "TESTED". IX2144.2 +056100 02 FILLER PIC X(15) VALUE SPACE. IX2144.2 +056200 02 FILLER PIC X(4) VALUE "FAIL". IX2144.2 +056300 02 FILLER PIC X(94) VALUE SPACE. IX2144.2 +056400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2144.2 +056500 01 REC-CT PIC 99 VALUE ZERO. IX2144.2 +056600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2144.2 +057000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2144.2 +057100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2144.2 +057200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2144.2 +057300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2144.2 +057400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2144.2 +057500 01 CCVS-H-1. IX2144.2 +057600 02 FILLER PIC X(39) VALUE SPACES. IX2144.2 +057700 02 FILLER PIC X(42) VALUE IX2144.2 +057800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2144.2 +057900 02 FILLER PIC X(39) VALUE SPACES. IX2144.2 +058000 01 CCVS-H-2A. IX2144.2 +058100 02 FILLER PIC X(40) VALUE SPACE. IX2144.2 +058200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2144.2 +058300 02 FILLER PIC XXXX VALUE IX2144.2 +058400 "4.2 ". IX2144.2 +058500 02 FILLER PIC X(28) VALUE IX2144.2 +058600 " COPY - NOT FOR DISTRIBUTION". IX2144.2 +058700 02 FILLER PIC X(41) VALUE SPACE. IX2144.2 +058800 IX2144.2 +058900 01 CCVS-H-2B. IX2144.2 +059000 02 FILLER PIC X(15) VALUE IX2144.2 +059100 "TEST RESULT OF ". IX2144.2 +059200 02 TEST-ID PIC X(9). IX2144.2 +059300 02 FILLER PIC X(4) VALUE IX2144.2 +059400 " IN ". IX2144.2 +059500 02 FILLER PIC X(12) VALUE IX2144.2 +059600 " HIGH ". IX2144.2 +059700 02 FILLER PIC X(22) VALUE IX2144.2 +059800 " LEVEL VALIDATION FOR ". IX2144.2 +059900 02 FILLER PIC X(58) VALUE IX2144.2 +060000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +060100 01 CCVS-H-3. IX2144.2 +060200 02 FILLER PIC X(34) VALUE IX2144.2 +060300 " FOR OFFICIAL USE ONLY ". IX2144.2 +060400 02 FILLER PIC X(58) VALUE IX2144.2 +060500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2144.2 +060600 02 FILLER PIC X(28) VALUE IX2144.2 +060700 " COPYRIGHT 1985 ". IX2144.2 +060800 01 CCVS-E-1. IX2144.2 +060900 02 FILLER PIC X(52) VALUE SPACE. IX2144.2 +061000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2144.2 +061100 02 ID-AGAIN PIC X(9). IX2144.2 +061200 02 FILLER PIC X(45) VALUE SPACES. IX2144.2 +061300 01 CCVS-E-2. IX2144.2 +061400 02 FILLER PIC X(31) VALUE SPACE. IX2144.2 +061500 02 FILLER PIC X(21) VALUE SPACE. IX2144.2 +061600 02 CCVS-E-2-2. IX2144.2 +061700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2144.2 +061800 03 FILLER PIC X VALUE SPACE. IX2144.2 +061900 03 ENDER-DESC PIC X(44) VALUE IX2144.2 +062000 "ERRORS ENCOUNTERED". IX2144.2 +062100 01 CCVS-E-3. IX2144.2 +062200 02 FILLER PIC X(22) VALUE IX2144.2 +062300 " FOR OFFICIAL USE ONLY". IX2144.2 +062400 02 FILLER PIC X(12) VALUE SPACE. IX2144.2 +062500 02 FILLER PIC X(58) VALUE IX2144.2 +062600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +062700 02 FILLER PIC X(13) VALUE SPACE. IX2144.2 +062800 02 FILLER PIC X(15) VALUE IX2144.2 +062900 " COPYRIGHT 1985". IX2144.2 +063000 01 CCVS-E-4. IX2144.2 +063100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2144.2 +063200 02 FILLER PIC X(4) VALUE " OF ". IX2144.2 +063300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2144.2 +063400 02 FILLER PIC X(40) VALUE IX2144.2 +063500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2144.2 +063600 01 XXINFO. IX2144.2 +063700 02 FILLER PIC X(19) VALUE IX2144.2 +063800 "*** INFORMATION ***". IX2144.2 +063900 02 INFO-TEXT. IX2144.2 +064000 04 FILLER PIC X(8) VALUE SPACE. IX2144.2 +064100 04 XXCOMPUTED PIC X(20). IX2144.2 +064200 04 FILLER PIC X(5) VALUE SPACE. IX2144.2 +064300 04 XXCORRECT PIC X(20). IX2144.2 +064400 02 INF-ANSI-REFERENCE PIC X(48). IX2144.2 +064500 01 HYPHEN-LINE. IX2144.2 +064600 02 FILLER PIC IS X VALUE IS SPACE. IX2144.2 +064700 02 FILLER PIC IS X(65) VALUE IS "************************IX2144.2 +064800- "*****************************************". IX2144.2 +064900 02 FILLER PIC IS X(54) VALUE IS "************************IX2144.2 +065000- "******************************". IX2144.2 +065100 01 CCVS-PGM-ID PIC X(9) VALUE IX2144.2 +065200 "IX214A". IX2144.2 +065300 PROCEDURE DIVISION. IX2144.2 +065400 CCVS1 SECTION. IX2144.2 +065500 OPEN-FILES. IX2144.2 +065600P OPEN I-O RAW-DATA. IX2144.2 +065700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2144.2 +065800P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2144.2 +065900P MOVE "ABORTED " TO C-ABORT. IX2144.2 +066000P ADD 1 TO C-NO-OF-TESTS. IX2144.2 +066100P ACCEPT C-DATE FROM DATE. IX2144.2 +066200P ACCEPT C-TIME FROM TIME. IX2144.2 +066300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2144.2 +066400PEND-E-1. IX2144.2 +066500P CLOSE RAW-DATA. IX2144.2 +066600 OPEN OUTPUT PRINT-FILE. IX2144.2 +066700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2144.2 +066800 MOVE SPACE TO TEST-RESULTS. IX2144.2 +066900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2144.2 +067000 MOVE ZERO TO REC-SKL-SUB. IX2144.2 +067100 PERFORM CCVS-INIT-FILE 9 TIMES. IX2144.2 +067200 CCVS-INIT-FILE. IX2144.2 +067300 ADD 1 TO REC-SKL-SUB. IX2144.2 +067400 MOVE FILE-RECORD-INFO-SKELETON IX2144.2 +067500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2144.2 +067600 CCVS-INIT-EXIT. IX2144.2 +067700 GO TO CCVS1-EXIT. IX2144.2 +067800 CLOSE-FILES. IX2144.2 +067900P OPEN I-O RAW-DATA. IX2144.2 +068000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2144.2 +068100P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2144.2 +068200P MOVE "OK. " TO C-ABORT. IX2144.2 +068300P MOVE PASS-COUNTER TO C-OK. IX2144.2 +068400P MOVE ERROR-HOLD TO C-ALL. IX2144.2 +068500P MOVE ERROR-COUNTER TO C-FAIL. IX2144.2 +068600P MOVE DELETE-COUNTER TO C-DELETED. IX2144.2 +068700P MOVE INSPECT-COUNTER TO C-INSPECT. IX2144.2 +068800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2144.2 +068900PEND-E-2. IX2144.2 +069000P CLOSE RAW-DATA. IX2144.2 +069100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2144.2 +069200 TERMINATE-CCVS. IX2144.2 +069300S EXIT PROGRAM. IX2144.2 +069400STERMINATE-CALL. IX2144.2 +069500 STOP RUN. IX2144.2 +069600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2144.2 +069700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2144.2 +069800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2144.2 +069900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2144.2 +070000 MOVE "****TEST DELETED****" TO RE-MARK. IX2144.2 +070100 PRINT-DETAIL. IX2144.2 +070200 IF REC-CT NOT EQUAL TO ZERO IX2144.2 +070300 MOVE "." TO PARDOT-X IX2144.2 +070400 MOVE REC-CT TO DOTVALUE. IX2144.2 +070500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2144.2 +070600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2144.2 +070700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2144.2 +070800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2144.2 +070900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2144.2 +071000 MOVE SPACE TO CORRECT-X. IX2144.2 +071100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2144.2 +071200 MOVE SPACE TO RE-MARK. IX2144.2 +071300 HEAD-ROUTINE. IX2144.2 +071400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +071500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +071600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2144.2 +071700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2144.2 +071800 COLUMN-NAMES-ROUTINE. IX2144.2 +071900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +072000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +072100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +072200 END-ROUTINE. IX2144.2 +072300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2144.2 +072400 END-RTN-EXIT. IX2144.2 +072500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +072600 END-ROUTINE-1. IX2144.2 +072700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2144.2 +072800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2144.2 +072900 ADD PASS-COUNTER TO ERROR-HOLD. IX2144.2 +073000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2144.2 +073100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2144.2 +073200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2144.2 +073300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2144.2 +073400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2144.2 +073500 END-ROUTINE-12. IX2144.2 +073600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2144.2 +073700 IF ERROR-COUNTER IS EQUAL TO ZERO IX2144.2 +073800 MOVE "NO " TO ERROR-TOTAL IX2144.2 +073900 ELSE IX2144.2 +074000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2144.2 +074100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2144.2 +074200 PERFORM WRITE-LINE. IX2144.2 +074300 END-ROUTINE-13. IX2144.2 +074400 IF DELETE-COUNTER IS EQUAL TO ZERO IX2144.2 +074500 MOVE "NO " TO ERROR-TOTAL ELSE IX2144.2 +074600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2144.2 +074700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2144.2 +074800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +074900 IF INSPECT-COUNTER EQUAL TO ZERO IX2144.2 +075000 MOVE "NO " TO ERROR-TOTAL IX2144.2 +075100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2144.2 +075200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2144.2 +075300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +075400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +075500 WRITE-LINE. IX2144.2 +075600 ADD 1 TO RECORD-COUNT. IX2144.2 +075700Y IF RECORD-COUNT GREATER 42 IX2144.2 +075800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2144.2 +075900Y MOVE SPACE TO DUMMY-RECORD IX2144.2 +076000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2144.2 +076100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2144.2 +076200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2144.2 +076300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2144.2 +076400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2144.2 +076500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2144.2 +076900Y MOVE ZERO TO RECORD-COUNT. IX2144.2 +077000 PERFORM WRT-LN. IX2144.2 +077100 WRT-LN. IX2144.2 +077200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2144.2 +077300 MOVE SPACE TO DUMMY-RECORD. IX2144.2 +077400 BLANK-LINE-PRINT. IX2144.2 +077500 PERFORM WRT-LN. IX2144.2 +077600 FAIL-ROUTINE. IX2144.2 +077700 IF COMPUTED-X NOT EQUAL TO SPACE IX2144.2 +077800 GO TO FAIL-ROUTINE-WRITE. IX2144.2 +077900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2144.2 +078000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2144.2 +078100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2144.2 +078200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +078300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2144.2 +078400 GO TO FAIL-ROUTINE-EX. IX2144.2 +078500 FAIL-ROUTINE-WRITE. IX2144.2 +078600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2144.2 +078700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2144.2 +078800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2144.2 +078900 MOVE SPACES TO COR-ANSI-REFERENCE. IX2144.2 +079000 FAIL-ROUTINE-EX. EXIT. IX2144.2 +079100 BAIL-OUT. IX2144.2 +079200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2144.2 +079300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2144.2 +079400 BAIL-OUT-WRITE. IX2144.2 +079500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2144.2 +079600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2144.2 +079700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +079800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2144.2 +079900 BAIL-OUT-EX. EXIT. IX2144.2 +080000 CCVS1-EXIT. IX2144.2 +080100 EXIT. IX2144.2 +080200 SECT-0001-IX214A SECTION. IX2144.2 +080300 WRITE-INT-GF-01. IX2144.2 +080400 OPEN OUTPUT IX-FS1. IX2144.2 +080500 MOVE "IX-FS1" TO XFILE-NAME (1). IX2144.2 +080600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2144.2 +080700 MOVE ZERO TO XRECORD-NUMBER (1). IX2144.2 +080800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2144.2 +080900 MOVE "IX214A" TO XPROGRAM-NAME (1). IX2144.2 +081000 MOVE 240 TO XRECORD-LENGTH (1). IX2144.2 +081100 MOVE 001 TO XBLOCK-SIZE (1). IX2144.2 +081200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2144.2 +081300 MOVE "S" TO XLABEL-TYPE (1). IX2144.2 +081400 MOVE 200 TO RECORDS-IN-FILE (1). IX2144.2 +081500 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2144.2 +081600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2144.2 +081700 MOVE ZERO TO KEYSUB. IX2144.2 +081800 MOVE ZERO TO INVKEY-COUNTER. IX2144.2 +081900 WRITE-INIT-GF-01-01. IX2144.2 +082000 PERFORM WRITE-TEST-GF-01-R1 50 TIMES. IX2144.2 +082100 PERFORM WRITE-TEST-GF-01-R2 125 TIMES. IX2144.2 +082200 PERFORM WRITE-TEST-GF-01-R1 25 TIMES. IX2144.2 +082300 GO TO WRITE-TEST-GF-01. IX2144.2 +082400 WRITE-TEST-GF-01-R1. IX2144.2 +082500 ADD 001 TO XRECORD-NUMBER (1). IX2144.2 +082600 ADD 001 TO KEYSUB. IX2144.2 +082700 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2144.2 +082800 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2144.2 +082900 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2144.2 +083000 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2144.2 +083100 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2144.2 +083200 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2144.2 +083300 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2144.2 +083400 WRITE IX-FS1R1-F-G-240 IX2144.2 +083500 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2144.2 +083600 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +083700 WRITE-TEST-GF-01-R2. IX2144.2 +083800 ADD 002 TO FS1-RECKEY-11-13. IX2144.2 +083900 ADD 002 TO FS1-ALTKEY1-11-13. IX2144.2 +084000 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2144.2 +084100 ADD 001 TO XRECORD-NUMBER (1). IX2144.2 +084200 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2144.2 +084300 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2144.2 +084400 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2144.2 +084500 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2144.2 +084600 WRITE IX-FS1R1-F-G-240 IX2144.2 +084700 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2144.2 +084800 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +084900 WRITE-TEST-GF-01. IX2144.2 +085000 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2144.2 +085100 GIVING RECORDS-WRITTEN. IX2144.2 +085200 MOVE 200 TO CORRECT-18V0. IX2144.2 +085300 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2144.2 +085400 IF RECORDS-WRITTEN EQUAL TO 200 IX2144.2 +085500 PERFORM PASS IX2144.2 +085600 ELSE IX2144.2 +085700 PERFORM FAIL. IX2144.2 +085800 MOVE "RECORDS IN FILE" TO RE-MARK. IX2144.2 +085900 GO TO WRITE-TEST-GF-01-END. IX2144.2 +086000 WRITE-DELETE-GF-01. IX2144.2 +086100 PERFORM DE-LETE. IX2144.2 +086200 WRITE-TEST-GF-01-END. IX2144.2 +086300 PERFORM PRINT-DETAIL. IX2144.2 +086400 CLOSE IX-FS1. IX2144.2 +086500 IX2144.2 +086600 IX2144.2 +086700 READ-INIT-F1-01. IX2144.2 +086800 OPEN INPUT IX-FS1. IX2144.2 +086900 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2144.2 +087000 MOVE "READ FILE IX-FS1" TO FEATURE. IX2144.2 +087100 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2144.2 +087200 MOVE 02 TO RECKEY-NUM. IX2144.2 +087300 MOVE 002 TO ALTKEY1-NUM. IX2144.2 +087400 READ-TEST-F1-01-R1. IX2144.2 +087500 READ IX-FS1 AT END GO TO READ-TEST-F1-01. IX2144.2 +087600 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2144.2 +087700 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2144.2 +087800 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2144.2 +087900 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2144.2 +088000 NEXT SENTENCE IX2144.2 +088100 ELSE IX2144.2 +088200 PERFORM READ-FAIL-F1-01. IX2144.2 +088300 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2144.2 +088400 GO TO READ-TEST-F1-01. IX2144.2 +088500 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +088600 ADD 002 TO RECKEY-NUM IX2144.2 +088700 ADD 002 TO ALTKEY1-NUM. IX2144.2 +088800 GO TO READ-TEST-F1-01-R1. IX2144.2 +088900 READ-TEST-F1-01. IX2144.2 +089000 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2144.2 +089100 PERFORM PASS ELSE IX2144.2 +089200 PERFORM FAIL. IX2144.2 +089300 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2144.2 +089400 MOVE 200 TO CORRECT-18V0. IX2144.2 +089500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2144.2 +089600 GO TO READ-WRITE-F1-01. IX2144.2 +089700 READ-FAIL-F1-01. IX2144.2 +089800 PERFORM FAIL. IX2144.2 +089900 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2144.2 +090000 MOVE RECKEY-NUM TO CORRECT-18V0. IX2144.2 +090100 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2144.2 +090200 READ-WRITE-F1-01. IX2144.2 +090300 PERFORM PRINT-DETAIL. IX2144.2 +090400 CLOSE IX-FS1. IX2144.2 +090500 START-INIT. IX2144.2 +090600 OPEN INPUT IX-FS1. IX2144.2 +090700 MOVE "START NLT RECKEY " TO FEATURE. IX2144.2 +090800 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2144.2 +090900 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2144.2 +091000* IX2144.2 +091100* THE "START -- NOT LESS THAN--" IS CHECKED FOR PROPER POSITIONINGIX2144.2 +091200* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2144.2 +091300* START-TEST-GF- USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2144.2 +091400* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2144.2 +091500* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2144.2 +091600* TAKEN FOR THE TESTS. IX2144.2 +091700* IX2144.2 +091800* CONDITIONS (CONTENTS OF KEY) / ACTION IX2144.2 +091900* IX2144.2 +092000* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2144.2 +092100* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2144.2 +092200* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2144.2 +092300* START-TEST-GF-04 - NOT LESS THAN LAST FILE RECORD / INVALID KEIX2144.2 +092400* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2144.2 +092500* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2144.2 +092600* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2144.2 +092700* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2144.2 +092800* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2144.2 +092900* IX2144.2 +093000* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2144.2 +093100* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2144.2 +093200* IF DURING THIS INITIALIZATION AN INVALID KEY OCCURS THE TEST IX2144.2 +093300* WILL BE DELETED AND CONTROL WILL BE PASSED TO THE NEXT TEST. IX2144.2 +093400* WHEN TESTING IF AN INVALID KEY IS EXPECTED, THE KEYS IX2144.2 +093500* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2144.2 +093600* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2144.2 +093700* MATCH RECORDS IN THE FILE. BUT IF A KEY MATCH IS EXPECTED FROMIX2144.2 +093800* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2144.2 +093900* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2144.2 +094000* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2144.2 +094100* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2144.2 +094200* IX2144.2 +094300 START-INIT-GF-01. IX2144.2 +094400 PERFORM START-INITIALIZE-RECORD. IX2144.2 +094500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +094600 PERFORM START-INIT-ERROR IX2144.2 +094700 GO TO START-DELETE-GF-01. IX2144.2 +094800 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2144.2 +094900 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +095000 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +095100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +095200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +095300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +095400 START-TEST-GF-01. IX2144.2 +095500* IX2144.2 +095600* START-TEST-GF-.01 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +095700* WHICH HAS A RECORD KEY VALUE OF IX2144.2 +095800* CCCCCCCCDD022 (RECORD NUMBER 11). IX2144.2 +095900* IX2144.2 +096000 START IX-FS1 IX2144.2 +096100 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +096200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2144.2 +096300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +096400 GO TO START-FAIL-GF-01. IX2144.2 +096500 MOVE FS1-STATUS TO FILESTATUS (1). IX2144.2 +096600 READ IX-FS1 AT END IX2144.2 +096700 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +096800 GO TO START-FAIL-GF-01. IX2144.2 +096900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +097000 IF XRECORD-NUMBER (1) EQUAL TO 11 IX2144.2 +097100 PERFORM PASS IX2144.2 +097200 MOVE SPACE TO RE-MARK IX2144.2 +097300 GO TO START-WRITE-GF-01. IX2144.2 +097400 MOVE 11 TO RECNO. IX2144.2 +097500 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +097600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +097700 START-FAIL-GF-01. IX2144.2 +097800 PERFORM FAIL. IX2144.2 +097900 MOVE 11 TO CORRECT-18V0. IX2144.2 +098000 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +098100 TO RE-MARK. IX2144.2 +098200 GO TO START-WRITE-GF-01. IX2144.2 +098300 START-DELETE-GF-01. IX2144.2 +098400 PERFORM DE-LETE. IX2144.2 +098500 START-WRITE-GF-01. IX2144.2 +098600 PERFORM PRINT-DETAIL. IX2144.2 +098700 START-INIT-GF-02. IX2144.2 +098800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +098900 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2144.2 +099000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +099100 PERFORM START-INIT-ERROR IX2144.2 +099200 GO TO START-DELETE-GF-02. IX2144.2 +099300 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2144.2 +099400 MOVE "HHHHHHHHII064ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +099500 MOVE "TTTTTTTTSS336ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +099600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +099700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +099800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +099900 START-TEST-GF-02. IX2144.2 +100000* IX2144.2 +100100* START-TEST-GF-.02 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +100200* WHICH HAS A RECORD KEY VALUE OF EEEEEEFFFF068IX2144.2 +100300* (RECORD NUMBER 34). THIS KEY VALUE IS IX2144.2 +100400* SEQUENTIALLY A LOGICAL RECORD HIGHER THAN IX2144.2 +100500* THE RECORD CONTAINING THE KEY VALUE LOADED IX2144.2 +100600* INTO THE RECORD KEY BEFORE THE START WAS IX2144.2 +100700* EXECUTED. THE KEY VALUE INITIALLY LOADED IX2144.2 +100800* WAS A VALUE BETWEEN TWO EXISTING KEY VALUES. IX2144.2 +100900* IX2144.2 +101000 START IX-FS1 IX2144.2 +101100 KEY NOT LESS THAN IX-FS1-KEY IX2144.2 +101200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2144.2 +101300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +101400 GO TO START-FAIL-GF-02. IX2144.2 +101500 MOVE FS1-STATUS TO FILESTATUS (2). IX2144.2 +101600 READ IX-FS1 AT END IX2144.2 +101700 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +101800 GO TO START-FAIL-GF-02. IX2144.2 +101900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +102000 IF XRECORD-NUMBER (1) EQUAL TO 34 IX2144.2 +102100 PERFORM PASS IX2144.2 +102200 MOVE SPACE TO RE-MARK IX2144.2 +102300 GO TO START-WRITE-GF-02. IX2144.2 +102400 MOVE 34 TO RECNO. IX2144.2 +102500 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +102600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +102700 START-FAIL-GF-02. IX2144.2 +102800 PERFORM FAIL. IX2144.2 +102900 MOVE 34 TO CORRECT-18V0. IX2144.2 +103000 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +103100 TO RE-MARK. IX2144.2 +103200 GO TO START-WRITE-GF-02. IX2144.2 +103300 START-DELETE-GF-02. IX2144.2 +103400 PERFORM DE-LETE. IX2144.2 +103500 START-WRITE-GF-02. IX2144.2 +103600 PERFORM PRINT-DETAIL. IX2144.2 +103700 START-INIT-GF-03. IX2144.2 +103800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +103900 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2144.2 +104000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +104100 PERFORM START-INIT-ERROR IX2144.2 +104200 GO TO START-DELETE-GF-03. IX2144.2 +104300 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2144.2 +104400 MOVE "EEEEEEEEEF003ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +104500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +104600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +104700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +104800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +104900 START-TEST-GF-03. IX2144.2 +105000* IX2144.2 +105100* START-TEST-GF-.03 - THE START STATEMENT SHOULD FIND A IX2144.2 +105200* RECORD IN THE FILE WHICH HAS A RECORD KEY IX2144.2 +105300* VALUE OF "BBBBBBBBBC002" (RECORD NUMBER 1). IX2144.2 +105400* THE KEY WAS LOADED BEFORE THE START IS IX2144.2 +105500* EXECUTED WITH THE VALUE THAT IS SEQUENTIALLY IX2144.2 +105600* LOWER THAN ANY CURRENTLY EXISTING KEY IN IX2144.2 +105700* THE FILE. IX2144.2 +105800* IX2144.2 +105900 START IX-FS1 IX2144.2 +106000 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +106100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2144.2 +106200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +106300 GO TO START-FAIL-GF-03. IX2144.2 +106400 MOVE FS1-STATUS TO FILESTATUS (3). IX2144.2 +106500 READ IX-FS1 AT END IX2144.2 +106600 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +106700 GO TO START-FAIL-GF-03. IX2144.2 +106800 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +106900 IF XRECORD-NUMBER (1) EQUAL TO 01 IX2144.2 +107000 PERFORM PASS IX2144.2 +107100 MOVE SPACE TO RE-MARK IX2144.2 +107200 GO TO START-WRITE-GF-03. IX2144.2 +107300 MOVE 01 TO RECNO. IX2144.2 +107400 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +107500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +107600 START-FAIL-GF-03. IX2144.2 +107700 PERFORM FAIL. IX2144.2 +107800 MOVE 01 TO CORRECT-18V0. IX2144.2 +107900 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +108000 TO RE-MARK. IX2144.2 +108100 GO TO START-WRITE-GF-03. IX2144.2 +108200 START-DELETE-GF-03. IX2144.2 +108300 PERFORM DE-LETE. IX2144.2 +108400 START-WRITE-GF-03. IX2144.2 +108500 PERFORM PRINT-DETAIL. IX2144.2 +108600 START-INIT-GF-04. IX2144.2 +108700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +108800 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2144.2 +108900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +109000 PERFORM START-INIT-ERROR IX2144.2 +109100 GO TO START-DELETE-GF-04. IX2144.2 +109200 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2144.2 +109300 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +109400 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +109500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +109600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +109700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +109800 START-TEST-GF-04. IX2144.2 +109900* IX2144.2 +110000* START-TEST-GF-.04 - THE START STATEMENT SHOULD NOT FIND A IX2144.2 +110100* RECORD IN THE FILE WHICH HAS A RECORD IX2144.2 +110200* KEY VALUE NOT LESS THAN "UUUUUUUUUU401". THISIX2144.2 +110300* VALUE IS SEQUENTIALLY NOT LESS THAN IX2144.2 +110400* ANY RECORD KEY CURRENTLY EXISTING IN IX2144.2 +110500* THE FILE. AN INVALID KEY CONDITION IX2144.2 +110600* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +110700* IX2144.2 +110800 START IX-FS1 IX2144.2 +110900 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +111000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2144.2 +111100 GO TO START-PASS-GF-04. IX2144.2 +111200 MOVE FS1-STATUS TO FILESTATUS (4). IX2144.2 +111300 READ IX-FS1 AT END IX2144.2 +111400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +111500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +111600 PERFORM FAIL. IX2144.2 +111700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +111800 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +111900 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +112000 TO RE-MARK. IX2144.2 +112100 GO TO START-WRITE-GF-04. IX2144.2 +112200 START-PASS-GF-04. IX2144.2 +112300 PERFORM PASS. IX2144.2 +112400 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +112500 GO TO START-WRITE-GF-04. IX2144.2 +112600 START-DELETE-GF-04. IX2144.2 +112700 PERFORM DE-LETE. IX2144.2 +112800 START-WRITE-GF-04. IX2144.2 +112900 PERFORM PRINT-DETAIL. IX2144.2 +113000 START-INIT-GF-05. IX2144.2 +113100 PERFORM START-INITIALIZE-RECORD. IX2144.2 +113200 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2144.2 +113300 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +113400 PERFORM START-INIT-ERROR IX2144.2 +113500 GO TO START-DELETE-GF-05. IX2144.2 +113600 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2144.2 +113700 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +113800 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +113900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +114000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +114100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +114200 START-TEST-GF-05. IX2144.2 +114300* START-TEST-GF-.05 - THE START STATEMENT USES AN OPERAND IX2144.2 +114400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2144.2 +114500* OF A RECORD KEY BUT IS THE NAME OF A IX2144.2 +114600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2144.2 +114700* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2144.2 +114800* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2144.2 +114900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2144.2 +115000* BALANCE OF THE KEY (POSITIONS 8 THRU 13) IS IX2144.2 +115100* NOT A VALID KEY VALUE FOR THE FILE. THE IX2144.2 +115200* RECORD WITH THE RECORD KEY "CDDDDDDDDD038" IX2144.2 +115300* (RECORD NUMBER 19) IS EXPECTED TO BE FOUND. IX2144.2 +115400* IX2144.2 +115500 START IX-FS1 IX2144.2 +115600 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +115700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2144.2 +115800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +115900 GO TO START-FAIL-GF-05. IX2144.2 +116000 MOVE FS1-STATUS TO FILESTATUS (5). IX2144.2 +116100 READ IX-FS1 AT END IX2144.2 +116200 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +116300 GO TO START-FAIL-GF-05. IX2144.2 +116400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +116500 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2144.2 +116600 PERFORM PASS IX2144.2 +116700 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2144.2 +116800 GO TO START-WRITE-GF-05. IX2144.2 +116900 MOVE 19 TO RECNO. IX2144.2 +117000 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +117100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +117200 START-FAIL-GF-05. IX2144.2 +117300 PERFORM FAIL. IX2144.2 +117400 MOVE 19 TO CORRECT-18V0. IX2144.2 +117500 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +117600 TO RE-MARK. IX2144.2 +117700 GO TO START-WRITE-GF-05. IX2144.2 +117800 START-DELETE-GF-05. IX2144.2 +117900 PERFORM DE-LETE. IX2144.2 +118000 START-WRITE-GF-05. IX2144.2 +118100 PERFORM PRINT-DETAIL. IX2144.2 +118200 START-INIT-GF-06. IX2144.2 +118300 PERFORM START-INITIALIZE-RECORD. IX2144.2 +118400 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2144.2 +118500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +118600 PERFORM START-INIT-ERROR IX2144.2 +118700 GO TO START-DELETE-GF-06. IX2144.2 +118800 MOVE "TTTTTUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +118900 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +119000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +119100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +119200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +119300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +119400 START-TEST-GF-06. IX2144.2 +119500* IX2144.2 +119600* START-TEST-GF-.06 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +119700* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2144.2 +119800* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2144.2 +119900* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2144.2 +120000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2144.2 +120100* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2144.2 +120200* 5 POSITIONS OF 6 OTHER RECORDS IN THE FILE. IX2144.2 +120300* THIS TEST EXPECTS THE RECORD POINTER IX2144.2 +120400* TO BE POSITIONED TO RECORD KEY TTTTTTTTTT380 IX2144.2 +120500* (RECORD NUMBER 190) WHICH WAS THE FIRST IX2144.2 +120600* RECORD WRITTEN TO THE FILE IX2144.2 +120700* THAT CONTAINS TTTTT IN THE FIRST 5 POSITIONS IX2144.2 +120800* OF THE KEY. THE RECORD KEY WAS LOADED WITH IX2144.2 +120900* THE VALUE "TTTTTUUUUU390" (KEY FOR RECORD IX2144.2 +121000* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2144.2 +121100* IX2144.2 +121200 START IX-FS1 IX2144.2 +121300 KEY IS NOT LESS THAN IX-FS1-KEY-1-5 IX2144.2 +121400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2144.2 +121500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +121600 GO TO START-FAIL-GF-06. IX2144.2 +121700 MOVE FS1-STATUS TO FILESTATUS (6). IX2144.2 +121800 READ IX-FS1 AT END IX2144.2 +121900 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +122000 GO TO START-FAIL-GF-06. IX2144.2 +122100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +122200 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2144.2 +122300 PERFORM PASS IX2144.2 +122400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +122500 GO TO START-WRITE-GF-06. IX2144.2 +122600 MOVE 65 TO RECNO. IX2144.2 +122700 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +122800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +122900 START-FAIL-GF-06. IX2144.2 +123000 PERFORM FAIL. IX2144.2 +123100 MOVE 190 TO CORRECT-18V0. IX2144.2 +123200 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +123300 TO RE-MARK. IX2144.2 +123400 GO TO START-WRITE-GF-06. IX2144.2 +123500 START-DELETE-GF-06. IX2144.2 +123600 PERFORM DE-LETE. IX2144.2 +123700 START-WRITE-GF-06. IX2144.2 +123800 PERFORM PRINT-DETAIL. IX2144.2 +123900 START-INIT-GF-07. IX2144.2 +124000 PERFORM START-INITIALIZE-RECORD. IX2144.2 +124100 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2144.2 +124200 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +124300 PERFORM START-INIT-ERROR IX2144.2 +124400 GO TO START-DELETE-GF-07. IX2144.2 +124500 MOVE "UUUUUUVUUU410" TO FS1-RECKEY-1-13. IX2144.2 +124600 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +124700 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +124800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +124900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +125000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +125100 START-TEST-GF-07. IX2144.2 +125200* IX2144.2 +125300* START-TEST-GF-.07 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +125400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +125500* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2144.2 +125600* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +125700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2144.2 +125800* IS LOADED WITH "UUUUUUV" WHICH IS HIGHER THANIX2144.2 +125900* THE KEY VALUE OF THE LAST RECORD IN THE FILE.IX2144.2 +126000* THERE SHOULD BE NO RECORD IN THE FILE NOT IX2144.2 +126100* LESS THAN THIS KEY VALUE THUS AND INVALID KEYIX2144.2 +126200* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +126300* IX2144.2 +126400 START IX-FS1 IX2144.2 +126500 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +126600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2144.2 +126700 GO TO START-PASS-GF-07. IX2144.2 +126800 MOVE FS1-STATUS TO FILESTATUS (7). IX2144.2 +126900 READ IX-FS1 AT END IX2144.2 +127000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +127100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +127200 PERFORM FAIL. IX2144.2 +127300 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +127400 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +127500 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +127600 TO RE-MARK. IX2144.2 +127700 GO TO START-WRITE-GF-07. IX2144.2 +127800 START-PASS-GF-07. IX2144.2 +127900 PERFORM PASS. IX2144.2 +128000 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +128100 GO TO START-WRITE-GF-07. IX2144.2 +128200 START-DELETE-GF-07. IX2144.2 +128300 PERFORM DE-LETE. IX2144.2 +128400 START-WRITE-GF-07. IX2144.2 +128500 PERFORM PRINT-DETAIL. IX2144.2 +128600 START-INIT-GF-08. IX2144.2 +128700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +128800 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2144.2 +128900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +129000 PERFORM START-INIT-ERROR IX2144.2 +129100 GO TO START-DELETE-GF-08. IX2144.2 +129200 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2144.2 +129300 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +129400 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +129500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +129600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +129700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +129800 START-TEST-GF-08. IX2144.2 +129900* IX2144.2 +130000* START-TEST-GF-.08 - THIS TEST USES AN OPERAND IN THE KEY IX2144.2 +130100* PHRASE OF THE START STATEMENT WHICH IS A DATAIX2144.2 +130200* ITEM SUBORDINATE TO THE RECORD KEY NAME. THEIX2144.2 +130300* CONTENTS OF THE DATA ITEM (POSITIONS 1 THRU IX2144.2 +130400* 7 OF THE RECORD KEY) IS LOADED WITH "ABBBBBB"IX2144.2 +130500* THIS KEY VALUE IS LOWER THAN ANY RECORD IX2144.2 +130600* KEY VALUE IN POSITIONS 1 THRU 7 EXISTING IX2144.2 +130700* IN THE FILE. THE START STATEMENT WITH THE IX2144.2 +130800* KEY IS NOT LESS THAN PHRASE IS EXECUTED AND IX2144.2 +130900* SHOULD FIND THE RECORD WITH THE KEY VALUE IX2144.2 +131000* "BBBBBBBBBC002" (RECORD NUMBER 01). IX2144.2 +131100* IX2144.2 +131200 START IX-FS1 IX2144.2 +131300 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +131400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2144.2 +131500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +131600 GO TO START-FAIL-GF-08. IX2144.2 +131700 MOVE FS1-STATUS TO FILESTATUS (8). IX2144.2 +131800 READ IX-FS1 AT END IX2144.2 +131900 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +132000 GO TO START-FAIL-GF-08. IX2144.2 +132100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +132200 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +132300 PERFORM PASS IX2144.2 +132400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +132500 GO TO START-WRITE-GF-08. IX2144.2 +132600 MOVE 01 TO RECNO. IX2144.2 +132700 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +132800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +132900 START-FAIL-GF-08. IX2144.2 +133000 PERFORM FAIL. IX2144.2 +133100 MOVE 001 TO CORRECT-18V0. IX2144.2 +133200 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +133300 TO RE-MARK. IX2144.2 +133400 GO TO START-WRITE-GF-08. IX2144.2 +133500 START-DELETE-GF-08. IX2144.2 +133600 PERFORM DE-LETE. IX2144.2 +133700 START-WRITE-GF-08. IX2144.2 +133800 PERFORM PRINT-DETAIL. IX2144.2 +133900 START-INIT-GF-09. IX2144.2 +134000 PERFORM START-INITIALIZE-RECORD. IX2144.2 +134100 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2144.2 +134200 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +134300 PERFORM START-INIT-ERROR IX2144.2 +134400 GO TO START-DELETE-GF-09. IX2144.2 +134500 MOVE "UUUUUUVVVV400" TO FS1-RECKEY-1-13. IX2144.2 +134600 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +134700 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +134800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +134900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +135000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +135100 START-TEST-GF-09. IX2144.2 +135200* IX2144.2 +135300* START-TEST-GF-.09 - THIS TEST USES AN OPERAND IN THE IX2144.2 +135400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +135500* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2144.2 +135600* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +135700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IS IX2144.2 +135800* LOADED WITH "UUUUUUV". THIS KEY VALUE IX2144.2 +135900* IS NOT LESS THAN ANY RECORD KEY VALUE IN IX2144.2 +136000* POSITION 1 THRU 7 EXISTING IN THE FILE IX2144.2 +136100* THEREFORE AN INVALID KEY CONDITION IS IX2144.2 +136200* EXPECTED WHEN THE START STATEMENT IS IX2144.2 +136300* EXECUTED. IX2144.2 +136400* IX2144.2 +136500 START IX-FS1 IX2144.2 +136600 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +136700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2144.2 +136800 GO TO START-PASS-GF-09. IX2144.2 +136900 MOVE FS1-STATUS TO FILESTATUS (9). IX2144.2 +137000 READ IX-FS1 AT END IX2144.2 +137100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +137200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +137300 PERFORM FAIL. IX2144.2 +137400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +137500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +137600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +137700 TO RE-MARK. IX2144.2 +137800 GO TO START-WRITE-GF-09. IX2144.2 +137900 START-PASS-GF-09. IX2144.2 +138000 PERFORM PASS. IX2144.2 +138100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +138200 GO TO START-WRITE-GF-09. IX2144.2 +138300 START-DELETE-GF-09. IX2144.2 +138400 PERFORM DE-LETE. IX2144.2 +138500 START-WRITE-GF-09. IX2144.2 +138600 PERFORM PRINT-DETAIL. IX2144.2 +138700 CLOSE IX-FS1. IX2144.2 +138800 IX2144.2 +138900* IX2144.2 +139000* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2144.2 +139100* CAPTURED FROM THE TESTS IN START-TEST-GF-. IX2144.2 +139200* IX2144.2 +139300 START-TEST-GF-10. IX2144.2 +139400 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +139500 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2144.2 +139600 IF FILESTATUS (1) EQUAL TO "**" IX2144.2 +139700 PERFORM DE-LETE IX2144.2 +139800 MOVE "FROM START-TEST-GF-01" TO CORRECT-A IX2144.2 +139900 GO TO START-TEST-GF-10A. IX2144.2 +140000* IX2144.2 +140100* START-TEST-004.01 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +140200* RESULTING FROM START-TEST-GF-01. THE FILE IX2144.2 +140300* STATUS CONTENTS IS EXPECTED TO BE "00". IX2144.2 +140400* IX2144.2 +140500 IF FILESTATUS (1) EQUAL TO "00" IX2144.2 +140600 PERFORM PASS IX2144.2 +140700 ELSE IX2144.2 +140800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-01" TO RE-MARKIX2144.2 +140900 PERFORM FAIL IX2144.2 +141000 MOVE "00" TO CORRECT-A IX2144.2 +141100 MOVE FILESTATUS (1) TO COMPUTED-A. IX2144.2 +141200 START-TEST-GF-10A. IX2144.2 +141300 PERFORM PRINT-DETAIL. IX2144.2 +141400 START-TEST-GF-11. IX2144.2 +141500 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +141600 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2144.2 +141700 IF FILESTATUS (2) EQUAL TO "**" IX2144.2 +141800 PERFORM DE-LETE IX2144.2 +141900 MOVE "FROM START-TEST-GF-02" TO CORRECT-A IX2144.2 +142000 GO TO START-TEST-GF-11A. IX2144.2 +142100* IX2144.2 +142200* START-TEST-004.02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +142300* RESULTING FROM START-TEST-GF-02. THE FILE IX2144.2 +142400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +142500* IX2144.2 +142600 IF FILESTATUS (2) EQUAL TO "00" IX2144.2 +142700 PERFORM PASS IX2144.2 +142800 ELSE PERFORM FAIL IX2144.2 +142900 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-02" TO RE-MARKIX2144.2 +143000 MOVE "00" TO CORRECT-A IX2144.2 +143100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2144.2 +143200 START-TEST-GF-11A. IX2144.2 +143300 PERFORM PRINT-DETAIL. IX2144.2 +143400 START-TEST-GF-12. IX2144.2 +143500 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2144.2 +143600 IF FILESTATUS (3) EQUAL TO "**" IX2144.2 +143700 PERFORM DE-LETE IX2144.2 +143800 MOVE "FROM START-TEST-GF-03" TO CORRECT-A IX2144.2 +143900 GO TO START-TEST-GF-12A. IX2144.2 +144000* IX2144.2 +144100* START-TEST-004.03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +144200* RESULTING FROM START-TEST-GF-03. THE FILE IX2144.2 +144300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +144400* IX2144.2 +144500 IF FILESTATUS (3) EQUAL TO "00" IX2144.2 +144600 PERFORM PASS IX2144.2 +144700 ELSE PERFORM FAIL IX2144.2 +144800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-03" TO RE-MARKIX2144.2 +144900 MOVE "00" TO CORRECT-A IX2144.2 +145000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2144.2 +145100 START-TEST-GF-12A. IX2144.2 +145200 PERFORM PRINT-DETAIL. IX2144.2 +145300 START-TEST-GF-13. IX2144.2 +145400 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +145500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2144.2 +145600 IF FILESTATUS (4) EQUAL TO "**" IX2144.2 +145700 PERFORM DE-LETE IX2144.2 +145800 MOVE "FROM START-TEST-GF-04" TO CORRECT-A IX2144.2 +145900 GO TO START-TEST-GF-13A. IX2144.2 +146000* IX2144.2 +146100* START-TEST-004.04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +146200* RESULTING FROM START-TEST-GF-04. THE FILE IX2144.2 +146300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +146400* IX2144.2 +146500 IF FILESTATUS (4) EQUAL TO "23" IX2144.2 +146600 PERFORM PASS IX2144.2 +146700 ELSE PERFORM FAIL IX2144.2 +146800 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +146900 MOVE "23" TO CORRECT-A IX2144.2 +147000 MOVE FILESTATUS (4) TO COMPUTED-A. IX2144.2 +147100 START-TEST-GF-13A. IX2144.2 +147200 PERFORM PRINT-DETAIL. IX2144.2 +147300 START-TEST-GF-14. IX2144.2 +147400 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +147500 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2144.2 +147600 IF FILESTATUS (5) EQUAL TO "**" IX2144.2 +147700 PERFORM DE-LETE IX2144.2 +147800 MOVE "FROM START-TEST-GF-05" TO CORRECT-A IX2144.2 +147900 GO TO START-TEST-GF-14A. IX2144.2 +148000* IX2144.2 +148100* START-TEST-004.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +148200* RESULTING FROM START-TEST-GF-05. THE FILE IX2144.2 +148300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +148400* IX2144.2 +148500 IF FILESTATUS (5) EQUAL TO "00" IX2144.2 +148600 PERFORM PASS IX2144.2 +148700 ELSE PERFORM FAIL IX2144.2 +148800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-05" TO RE-MARKIX2144.2 +148900 MOVE "00" TO CORRECT-A IX2144.2 +149000 MOVE FILESTATUS (5) TO COMPUTED-A. IX2144.2 +149100 START-TEST-GF-14A. IX2144.2 +149200 PERFORM PRINT-DETAIL. IX2144.2 +149300 START-TEST-GF-15. IX2144.2 +149400 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2144.2 +149500 IF FILESTATUS (6) EQUAL TO "**" IX2144.2 +149600 PERFORM DE-LETE IX2144.2 +149700 MOVE "FROM START-TEST-GF-06" TO CORRECT-A IX2144.2 +149800 GO TO START-TEST-GF-15A. IX2144.2 +149900* IX2144.2 +150000* START-TEST-004.06 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +150100* RESULTING FROM START-TEST-GF-06. THE FILE IX2144.2 +150200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +150300* IX2144.2 +150400 IF FILESTATUS (6) EQUAL TO "00" IX2144.2 +150500 PERFORM PASS IX2144.2 +150600 ELSE PERFORM FAIL IX2144.2 +150700 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-06" TO RE-MARKIX2144.2 +150800 MOVE "00" TO CORRECT-A IX2144.2 +150900 MOVE FILESTATUS (6) TO COMPUTED-A. IX2144.2 +151000 START-TEST-GF-15A. IX2144.2 +151100 PERFORM PRINT-DETAIL. IX2144.2 +151200 START-TEST-GF-16. IX2144.2 +151300 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +151400 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2144.2 +151500 IF FILESTATUS (7) EQUAL TO "**" IX2144.2 +151600 PERFORM DE-LETE IX2144.2 +151700 MOVE "FROM START-TEST-GF-07" TO CORRECT-A IX2144.2 +151800 GO TO START-TEST-GF-16A. IX2144.2 +151900* IX2144.2 +152000* START-TEST-004.07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +152100* RESULTING FROM START-TEST-GF-07. THE FILE IX2144.2 +152200* STATUS CONTENTS IS EXPECTED TO BE "23" IX2144.2 +152300* IX2144.2 +152400 IF FILESTATUS (7) EQUAL TO "23" IX2144.2 +152500 PERFORM PASS IX2144.2 +152600 ELSE PERFORM FAIL IX2144.2 +152700 MOVE "FROM START-TEST-GF-07; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +152800 MOVE "23" TO CORRECT-A IX2144.2 +152900 MOVE FILESTATUS (7) TO COMPUTED-A. IX2144.2 +153000 START-TEST-GF-16A. IX2144.2 +153100 PERFORM PRINT-DETAIL. IX2144.2 +153200 START-TEST-GF-17. IX2144.2 +153300 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +153400 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2144.2 +153500 IF FILESTATUS (8) EQUAL TO "**" IX2144.2 +153600 PERFORM DE-LETE IX2144.2 +153700 MOVE "FROM START-TEST-GF-08" TO CORRECT-A IX2144.2 +153800 GO TO START-TEST-GF-17A. IX2144.2 +153900* IX2144.2 +154000* START-TEST-004.08 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +154100* RESULTING FROM START-TEST-GF-08. THE FILE IX2144.2 +154200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +154300* IX2144.2 +154400 IF FILESTATUS (8) EQUAL TO "00" IX2144.2 +154500 PERFORM PASS IX2144.2 +154600 ELSE PERFORM FAIL IX2144.2 +154700 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-08" TO RE-MARKIX2144.2 +154800 MOVE "00" TO CORRECT-A IX2144.2 +154900 MOVE FILESTATUS (8) TO COMPUTED-A. IX2144.2 +155000 START-TEST-GF-17A. IX2144.2 +155100 PERFORM PRINT-DETAIL. IX2144.2 +155200 START-TEST-GF-18. IX2144.2 +155300 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +155400 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2144.2 +155500 IF FILESTATUS (9) EQUAL TO "**" IX2144.2 +155600 PERFORM DE-LETE IX2144.2 +155700 MOVE "FROM START-TEST-GF-09" TO CORRECT-A IX2144.2 +155800 GO TO START-TEST-GF-18A. IX2144.2 +155900* IX2144.2 +156000* START-TEST-004.09 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +156100* RESULTING FROM START-TEST-GF-09. THE FILE IX2144.2 +156200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +156300* IX2144.2 +156400 IF FILESTATUS (9) EQUAL TO "23" IX2144.2 +156500 PERFORM PASS IX2144.2 +156600 ELSE PERFORM FAIL IX2144.2 +156700 MOVE "FROM START-TEST-GF-09; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +156800 MOVE "23" TO CORRECT-A IX2144.2 +156900 MOVE FILESTATUS (9) TO COMPUTED-A. IX2144.2 +157000 START-TEST-GF-18A. IX2144.2 +157100 PERFORM PRINT-DETAIL. IX2144.2 +157200 IX2144.2 +157300 IX2144.2 +157400*START-INIT-005. IX2144.2 +157500 OPEN INPUT IX-FS1. IX2144.2 +157600 MOVE "STR NLT ALTKY W/O DUP" TO FEATURE. IX2144.2 +157700 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2144.2 +157800* IX2144.2 +157900* THE "START - NOT LESS THAN--" IS CHECKED FOR PROPER POSITIONINGIX2144.2 +158000* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2144.2 +158100* START-TEST-GF USES ONLY THE ALTERNATE RECORD KEY WITHOUT THE IX2144.2 +158200* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2144.2 +158300* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2144.2 +158400* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2144.2 +158500* IX2144.2 +158600* CONDITIONS (CONTENTS OF KEY) / ACTION IX2144.2 +158700* IX2144.2 +158800* START-TEST-GF-19 - EQUAL A RECORD IN FILE / RECORD FOUND IX2144.2 +158900* START-TEST-GF-20 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2144.2 +159000* START-TEST-GF-21 - LESS THAN FIRST FILE REC. / REC. FOUND IX2144.2 +159100* START-TEST-GF-22 - NOT LESS THAN LAST FILE RECORD / INVALID KIX2144.2 +159200* START-TEST-GF-23 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2144.2 +159300* START-TEST-GF-24 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2144.2 +159400* START-TEST-GF-25 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2144.2 +159500* START-TEST-GF-26 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNIX2144.2 +159600* START-TEST-GF-27 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEYIX2144.2 +159700* IX2144.2 +159800* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2144.2 +159900* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2144.2 +160000* IF DURING THIS INITIALIZATION AN INVALID KEY OCCURS THE TEST IX2144.2 +160100* WILL BE DELETED AND CONTROL WILL BE PASSED TO THE NEXT TEST. IX2144.2 +160200* WHEN TESTING IF AN INVALID KEY IS EXPECTED, THE KEYS IX2144.2 +160300* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2144.2 +160400* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2144.2 +160500* MATCH RECORDS IN THE FILE. BUT IF A KEY MATCH IS EXPECTED FROMIX2144.2 +160600* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2144.2 +160700* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2144.2 +160800* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2144.2 +160900* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2144.2 +161000* IX2144.2 +161100 START-INIT-GF-19. IX2144.2 +161200 PERFORM START-INITIALIZE-RECORD. IX2144.2 +161300 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2144.2 +161400 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +161500 PERFORM START-INIT-ERROR IX2144.2 +161600 GO TO START-DELETE-GF-19. IX2144.2 +161700 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +161800 MOVE "XXXXXXXXYY384ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +161900 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +162000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +162100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +162200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +162300 START-TEST-GF-19. IX2144.2 +162400* IX2144.2 +162500* START-TEST-GF.01 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +162600* WHICH HAS AN ALTERNATE KEY VALUE OF IX2144.2 +162700* XXXXXXXXYY384ALTKEY1 (RECORD NUMBER 192). IX2144.2 +162800* IX2144.2 +162900 START IX-FS1 IX2144.2 +163000 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +163100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2144.2 +163200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +163300 GO TO START-FAIL-GF-19. IX2144.2 +163400 MOVE FS1-STATUS TO FILESTATUS (1). IX2144.2 +163500 READ IX-FS1 AT END IX2144.2 +163600 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +163700 GO TO START-FAIL-GF-19. IX2144.2 +163800 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +163900 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2144.2 +164000 PERFORM PASS IX2144.2 +164100 MOVE SPACE TO RE-MARK IX2144.2 +164200 GO TO START-WRITE-GF-19. IX2144.2 +164300 MOVE 67 TO RECNO. IX2144.2 +164400 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +164500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +164600 START-FAIL-GF-19. IX2144.2 +164700 PERFORM FAIL. IX2144.2 +164800 MOVE 192 TO CORRECT-18V0. IX2144.2 +164900 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +165000 TO RE-MARK. IX2144.2 +165100 GO TO START-WRITE-GF-19. IX2144.2 +165200 START-DELETE-GF-19. IX2144.2 +165300 PERFORM DE-LETE. IX2144.2 +165400 START-WRITE-GF-19. IX2144.2 +165500 PERFORM PRINT-DETAIL. IX2144.2 +165600 START-INIT-GF-20. IX2144.2 +165700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +165800 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2144.2 +165900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +166000 PERFORM START-INIT-ERROR IX2144.2 +166100 GO TO START-DELETE-GF-20. IX2144.2 +166200 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +166300 MOVE "HHHHHHHIII67ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +166400 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +166500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +166600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +166700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +166800 START-TEST-GF-20. IX2144.2 +166900* IX2144.2 +167000* START-TEST-GF.02 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +167100* WHICH HAS AN ALTERNATE KEY VALUE OF IX2144.2 +167200* HHHHHHIIII068ALTKEY1 (RECORD NUMBER 34). IX2144.2 +167300* THE DATA ITEM WAS LOADED WITH A KEY VALUE IX2144.2 +167400* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2144.2 +167500* EXISTING ALTERNATE KEYS IN THE FILE. IX2144.2 +167600* IX2144.2 +167700 START IX-FS1 IX2144.2 +167800 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +167900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2144.2 +168000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +168100 GO TO START-FAIL-GF-20. IX2144.2 +168200 MOVE FS1-STATUS TO FILESTATUS (2). IX2144.2 +168300 READ IX-FS1 AT END IX2144.2 +168400 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +168500 GO TO START-FAIL-GF-20. IX2144.2 +168600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +168700 IF XRECORD-NUMBER (1) EQUAL TO 034 IX2144.2 +168800 PERFORM PASS IX2144.2 +168900 MOVE SPACE TO RE-MARK IX2144.2 +169000 GO TO START-WRITE-GF-20. IX2144.2 +169100 MOVE 34 TO RECNO. IX2144.2 +169200 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +169300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +169400 START-FAIL-GF-20. IX2144.2 +169500 PERFORM FAIL. IX2144.2 +169600 MOVE 034 TO CORRECT-18V0. IX2144.2 +169700 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +169800 TO RE-MARK. IX2144.2 +169900 GO TO START-WRITE-GF-20. IX2144.2 +170000 START-DELETE-GF-20. IX2144.2 +170100 PERFORM DE-LETE. IX2144.2 +170200 START-WRITE-GF-20. IX2144.2 +170300 PERFORM PRINT-DETAIL. IX2144.2 +170400 START-INIT-GF-21. IX2144.2 +170500 PERFORM START-INITIALIZE-RECORD. IX2144.2 +170600 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2144.2 +170700 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +170800 PERFORM START-INIT-ERROR IX2144.2 +170900 GO TO START-DELETE-GF-21. IX2144.2 +171000 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +171100 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +171200 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +171300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +171400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +171500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +171600 START-TEST-GF-21. IX2144.2 +171700* IX2144.2 +171800* START-TEST-GF.03 - THE START STATEMENT SHOULD FIND A IX2144.2 +171900* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2144.2 +172000* KEY VALUE OF EEEEEEEEEF002ALTKEY1 (RECORD IX2144.2 +172100* NUMBER 01). THE ALTERNATE KEY WAS LOADED IX2144.2 +172200* WITH A VALUE THAT IS SEQUENTIALLY LOWER IX2144.2 +172300* THAN ANY CURRENTLY EXISTNNG KEY IN THE FILE IX2144.2 +172400* BEFORE THE START WAS EXECUTED. IX2144.2 +172500* IX2144.2 +172600 START IX-FS1 IX2144.2 +172700 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +172800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2144.2 +172900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +173000 GO TO START-FAIL-GF-21. IX2144.2 +173100 MOVE FS1-STATUS TO FILESTATUS (3). IX2144.2 +173200 READ IX-FS1 AT END IX2144.2 +173300 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +173400 GO TO START-FAIL-GF-21. IX2144.2 +173500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +173600 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +173700 PERFORM PASS IX2144.2 +173800 MOVE SPACE TO RE-MARK IX2144.2 +173900 GO TO START-WRITE-GF-21. IX2144.2 +174000 MOVE 01 TO RECNO. IX2144.2 +174100 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +174200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +174300 START-FAIL-GF-21. IX2144.2 +174400 PERFORM FAIL. IX2144.2 +174500 MOVE 001 TO CORRECT-18V0. IX2144.2 +174600 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +174700 TO RE-MARK. IX2144.2 +174800 GO TO START-WRITE-GF-21. IX2144.2 +174900 START-DELETE-GF-21. IX2144.2 +175000 PERFORM DE-LETE. IX2144.2 +175100 START-WRITE-GF-21. IX2144.2 +175200 PERFORM PRINT-DETAIL. IX2144.2 +175300 START-INIT-GF-22. IX2144.2 +175400 PERFORM START-INITIALIZE-RECORD. IX2144.2 +175500 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2144.2 +175600 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +175700 PERFORM START-INIT-ERROR IX2144.2 +175800 GO TO START-DELETE-GF-22. IX2144.2 +175900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2144.2 +176000 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +176100 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +176200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +176300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +176400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +176500 START-TEST-GF-22. IX2144.2 +176600* IX2144.2 +176700* START-TEST-GF.04 - THE START STATEMENT SHOULD NOT FIND A IX2144.2 +176800* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2144.2 +176900* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2144.2 +177000* VALUE IS SEQUENTIALLY NOT LESS THAN IX2144.2 +177100* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2144.2 +177200* THE FILE. AN INVALID KEY CONDITION IX2144.2 +177300* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +177400* IX2144.2 +177500 START IX-FS1 IX2144.2 +177600 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +177700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2144.2 +177800 GO TO START-PASS-GF-22. IX2144.2 +177900 MOVE FS1-STATUS TO FILESTATUS (4). IX2144.2 +178000 READ IX-FS1 AT END IX2144.2 +178100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +178200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +178300 PERFORM FAIL. IX2144.2 +178400 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2144.2 +178500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +178600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +178700 TO RE-MARK. IX2144.2 +178800 GO TO START-WRITE-GF-22. IX2144.2 +178900 START-PASS-GF-22. IX2144.2 +179000 PERFORM PASS. IX2144.2 +179100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +179200 GO TO START-WRITE-GF-22. IX2144.2 +179300 START-DELETE-GF-22. IX2144.2 +179400 PERFORM DE-LETE. IX2144.2 +179500 START-WRITE-GF-22. IX2144.2 +179600 PERFORM PRINT-DETAIL. IX2144.2 +179700 START-INIT-GF-23. IX2144.2 +179800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +179900 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2144.2 +180000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +180100 PERFORM START-INIT-ERROR IX2144.2 +180200 GO TO START-DELETE-GF-23. IX2144.2 +180300 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2144.2 +180400 MOVE "GGGGHHHHHH100ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +180500 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +180600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +180700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +180800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +180900 START-TEST-GF-23. IX2144.2 +181000* IX2144.2 +181100* START-TEST-GF.05 - THE START STATEMENT USES AN OPERAND IX2144.2 +181200* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2144.2 +181300* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2144.2 +181400* DATA ITEM WHICH IS SUBORDINATE TO THE IX2144.2 +181500* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2144.2 +181600* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2144.2 +181700* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2144.2 +181800* BALANCE OF THE KEY (POSITIONS 7 THRU 20 OF IX2144.2 +181900* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2144.2 +182000* FOR THE FILE. THE IX2144.2 +182100* RECORD WITH THE ALTERNATE KEY GGGGHHHHHH052 IX2144.2 +182200* ALTKEY1 (RECORD NUMBER 26) IS EXPECTED TO IX2144.2 +182300* BE FOUND. IX2144.2 +182400* IX2144.2 +182500 START IX-FS1 IX2144.2 +182600 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +182700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2144.2 +182800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +182900 GO TO START-FAIL-GF-23. IX2144.2 +183000 MOVE FS1-STATUS TO FILESTATUS (5). IX2144.2 +183100 READ IX-FS1 AT END IX2144.2 +183200 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +183300 GO TO START-FAIL-GF-23. IX2144.2 +183400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +183500 IF XRECORD-NUMBER (1) EQUAL TO 26 IX2144.2 +183600 PERFORM PASS IX2144.2 +183700 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2144.2 +183800 GO TO START-WRITE-GF-23. IX2144.2 +183900 MOVE 26 TO RECNO. IX2144.2 +184000 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +184100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +184200 START-FAIL-GF-23. IX2144.2 +184300 PERFORM FAIL. IX2144.2 +184400 MOVE 26 TO CORRECT-18V0. IX2144.2 +184500 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +184600 TO RE-MARK. IX2144.2 +184700 GO TO START-WRITE-GF-23. IX2144.2 +184800 START-DELETE-GF-23. IX2144.2 +184900 PERFORM DE-LETE. IX2144.2 +185000 START-WRITE-GF-23. IX2144.2 +185100 PERFORM PRINT-DETAIL. IX2144.2 +185200 START-INIT-GF-24. IX2144.2 +185300 PERFORM START-INITIALIZE-RECORD. IX2144.2 +185400 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2144.2 +185500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +185600 PERFORM START-INIT-ERROR IX2144.2 +185700 GO TO START-DELETE-GF-24. IX2144.2 +185800 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +185900 MOVE "XXXXXYYYYY390ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +186000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +186100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +186200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +186300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +186400 START-TEST-GF-24. IX2144.2 +186500* IX2144.2 +186600* START-TEST-GF.06 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +186700* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2144.2 +186800* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2144.2 +186900* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2144.2 +187000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2144.2 +187100* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2144.2 +187200* 5 POSITIONS OF 6 OTHER RECORDS IN THE FILE. IX2144.2 +187300* THIS TEST EXPECTS THE RECORD POINTER IX2144.2 +187400* TO BE POSITIONED TO RECORD KEY XXXXXXXXXX380 IX2144.2 +187500* ALTKEY1 (RECORD NUMBER 190) WHICH WAS THE FIRIX2144.2 +187600* RECORD WRITTEN THAT IX2144.2 +187700* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF THIX2144.2 +187800* KEY. THE ALTERNATE KEY WAS LOADED WITH THE IX2144.2 +187900* VALUE XXXXXYYYYY390ALTKEY1 (KEY FOR RECORD IX2144.2 +188000* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2144.2 +188100* IX2144.2 +188200 START IX-FS1 IX2144.2 +188300 KEY IS NOT LESS THAN IX-FS1-ALTKEY1-1-5 IX2144.2 +188400 INVALID KEY IX2144.2 +188500 MOVE FS1-STATUS TO FILESTATUS (6) IX2144.2 +188600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +188700 GO TO START-FAIL-GF-24. IX2144.2 +188800 MOVE FS1-STATUS TO FILESTATUS (6). IX2144.2 +188900 READ IX-FS1 AT END IX2144.2 +189000 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +189100 GO TO START-FAIL-GF-24. IX2144.2 +189200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +189300 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2144.2 +189400 PERFORM PASS IX2144.2 +189500 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +189600 GO TO START-WRITE-GF-24. IX2144.2 +189700 MOVE 65 TO RECNO. IX2144.2 +189800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +189900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +190000 START-FAIL-GF-24. IX2144.2 +190100 PERFORM FAIL. IX2144.2 +190200 MOVE 190 TO CORRECT-18V0. IX2144.2 +190300 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +190400 TO RE-MARK. IX2144.2 +190500 GO TO START-WRITE-GF-24. IX2144.2 +190600 START-DELETE-GF-24. IX2144.2 +190700 PERFORM DE-LETE. IX2144.2 +190800 START-WRITE-GF-24. IX2144.2 +190900 PERFORM PRINT-DETAIL. IX2144.2 +191000 START-INIT-GF-25. IX2144.2 +191100 PERFORM START-INITIALIZE-RECORD. IX2144.2 +191200 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2144.2 +191300 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +191400 PERFORM START-INIT-ERROR IX2144.2 +191500 GO TO START-DELETE-GF-25. IX2144.2 +191600 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2144.2 +191700 MOVE "YYYYYZYYYY410ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +191800 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +191900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +192000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +192100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +192200 START-TEST-GF-25. IX2144.2 +192300* IX2144.2 +192400* START-TEST-GF.07 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +192500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +192600* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +192700* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +192800* POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2144.2 +192900* IS LOADED WITH YYYYYZ WHICH IS HIGHER THAN THIX2144.2 +193000* KEY VALUE OF THE LAST RECORD IN THE FILE. THIX2144.2 +193100* SHOULD BE NO RECORD IN THE FILE NOT LESS THANIX2144.2 +193200* KEY VALUE THUS AN INVALID KEY IS EXPECTED IX2144.2 +193300* WHEN THE START IS EXECUTED. IX2144.2 +193400* IX2144.2 +193500 START IX-FS1 IX2144.2 +193600 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +193700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2144.2 +193800 GO TO START-PASS-GF-25. IX2144.2 +193900 MOVE FS1-STATUS TO FILESTATUS (7). IX2144.2 +194000 READ IX-FS1 AT END IX2144.2 +194100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +194200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +194300 PERFORM FAIL. IX2144.2 +194400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +194500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +194600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +194700 TO RE-MARK. IX2144.2 +194800 GO TO START-WRITE-GF-25. IX2144.2 +194900 START-PASS-GF-25. IX2144.2 +195000 PERFORM PASS. IX2144.2 +195100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +195200 GO TO START-WRITE-GF-25. IX2144.2 +195300 START-DELETE-GF-25. IX2144.2 +195400 PERFORM DE-LETE. IX2144.2 +195500 START-WRITE-GF-25. IX2144.2 +195600 PERFORM PRINT-DETAIL. IX2144.2 +195700 START-INIT-GF-26. IX2144.2 +195800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +195900 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2144.2 +196000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +196100 PERFORM START-INIT-ERROR IX2144.2 +196200 GO TO START-DELETE-GF-26. IX2144.2 +196300 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +196400 MOVE "EEEEDEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +196500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +196600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +196700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +196800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +196900 START-TEST-GF-26. IX2144.2 +197000* IX2144.2 +197100* START-TEST-GF.08 - THIS TEST USES AN OPERAND IN THE IX2144.2 +197200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +197300* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +197400* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +197500* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IS IX2144.2 +197600* LOADED WITH "EEEEDE". THIS KEY VALUE IX2144.2 +197700* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2144.2 +197800* POSITION 1 THRU 6 EXISTING IN THE FILE IX2144.2 +197900* THE START STATEMENT WITH THE KEY IS NOT LESS IX2144.2 +198000* THAN PHRASE IS EXECUTED AND SHOULD FIND A IX2144.2 +198100* RECORD WITH THE KEY VALUE "EEEEEEEEEF002 IX2144.2 +198200* ALTKEY1 (RECORD NUMBER 01). IX2144.2 +198300* IX2144.2 +198400 START IX-FS1 IX2144.2 +198500 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +198600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2144.2 +198700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +198800 GO TO START-FAIL-GF-26. IX2144.2 +198900 MOVE FS1-STATUS TO FILESTATUS (8). IX2144.2 +199000 READ IX-FS1 AT END IX2144.2 +199100 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +199200 GO TO START-FAIL-GF-26. IX2144.2 +199300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +199400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +199500 PERFORM PASS IX2144.2 +199600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +199700 GO TO START-WRITE-GF-26. IX2144.2 +199800 MOVE 01 TO RECNO. IX2144.2 +199900 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +200000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +200100 START-FAIL-GF-26. IX2144.2 +200200 PERFORM FAIL. IX2144.2 +200300 MOVE 001 TO CORRECT-18V0. IX2144.2 +200400 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +200500 TO RE-MARK. IX2144.2 +200600 GO TO START-WRITE-GF-26. IX2144.2 +200700 START-DELETE-GF-26. IX2144.2 +200800 PERFORM DE-LETE. IX2144.2 +200900 START-WRITE-GF-26. IX2144.2 +201000 PERFORM PRINT-DETAIL. IX2144.2 +201100 START-INIT-GF-27. IX2144.2 +201200 PERFORM START-INITIALIZE-RECORD. IX2144.2 +201300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2144.2 +201400 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +201500 PERFORM START-INIT-ERROR IX2144.2 +201600 GO TO START-DELETE-GF-27. IX2144.2 +201700 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2144.2 +201800 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +201900 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +202000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +202100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +202200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +202300 START-TEST-GF-27. IX2144.2 +202400* IX2144.2 +202500* START-TEST-GF.09 - THIS TEST USES AN OPERAND IN THE IX2144.2 +202600* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +202700* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +202800* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +202900* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2144.2 +203000* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2144.2 +203100* IS NOT LESS THAN ANY ALTERNATE KEY VALUE IN IX2144.2 +203200* POSITION 1 THRU 10 EXISTING IN THE FILE IX2144.2 +203300* THEREFORE AN INVALID KEY CONDITION IS IX2144.2 +203400* EXPECTED WHEN THE START STATEMENT IS IX2144.2 +203500* EXECUTED. IX2144.2 +203600* IX2144.2 +203700 START IX-FS1 IX2144.2 +203800 KEY IS NOT LESS THAN IX-FS1-ALTKEY1-1-10 IX2144.2 +203900 INVALID KEY IX2144.2 +204000 MOVE FS1-STATUS TO FILESTATUS (9) IX2144.2 +204100 GO TO START-PASS-GF-27. IX2144.2 +204200 MOVE FS1-STATUS TO FILESTATUS (9). IX2144.2 +204300 READ IX-FS1 AT END IX2144.2 +204400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +204500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +204600 PERFORM FAIL. IX2144.2 +204700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +204800 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +204900 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +205000 TO RE-MARK. IX2144.2 +205100 GO TO START-WRITE-GF-27. IX2144.2 +205200 START-PASS-GF-27. IX2144.2 +205300 PERFORM PASS. IX2144.2 +205400 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +205500 GO TO START-WRITE-GF-27. IX2144.2 +205600 START-DELETE-GF-27. IX2144.2 +205700 PERFORM DE-LETE. IX2144.2 +205800 START-WRITE-GF-27. IX2144.2 +205900 PERFORM PRINT-DETAIL. IX2144.2 +206000 CLOSE IX-FS1. IX2144.2 +206100 IX2144.2 +206200* IX2144.2 +206300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2144.2 +206400* CAPTURED FROM THE TESTS IN START-TEST-GF. IX2144.2 +206500* IX2144.2 +206600 START-TEST-GF-28. IX2144.2 +206700 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +206800 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2144.2 +206900 IF FILESTATUS (1) EQUAL TO "**" IX2144.2 +207000 PERFORM DE-LETE IX2144.2 +207100 MOVE "FROM START-TEST-GF-19" TO CORRECT-A IX2144.2 +207200 GO TO START-TEST-GF-28A. IX2144.2 +207300* IX2144.2 +207400* START-TEST-006.01 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +207500* RESULTING FROM START-TEST-GF-19. THE FILE IX2144.2 +207600* STATUS CONTENTS IS EXPECTED TO BE "00". IX2144.2 +207700* IX2144.2 +207800 IF FILESTATUS (1) EQUAL TO "00" IX2144.2 +207900 PERFORM PASS IX2144.2 +208000 ELSE IX2144.2 +208100 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-19" TO RE-MARKIX2144.2 +208200 PERFORM FAIL IX2144.2 +208300 MOVE "00" TO CORRECT-A IX2144.2 +208400 MOVE FILESTATUS (1) TO COMPUTED-A. IX2144.2 +208500 START-TEST-GF-28A. IX2144.2 +208600 PERFORM PRINT-DETAIL. IX2144.2 +208700 START-TEST-GF-29. IX2144.2 +208800 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2144.2 +208900 IF FILESTATUS (2) EQUAL TO "**" IX2144.2 +209000 PERFORM DE-LETE IX2144.2 +209100 MOVE "FROM START-TEST-GF-20" TO CORRECT-A IX2144.2 +209200 GO TO START-TEST-GF-29A. IX2144.2 +209300* IX2144.2 +209400* START-TEST-006.02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +209500* RESULTING FROM START-TEST-GF-20. THE FILE IX2144.2 +209600* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +209700* IX2144.2 +209800 IF FILESTATUS (2) EQUAL TO "00" IX2144.2 +209900 PERFORM PASS IX2144.2 +210000 ELSE PERFORM FAIL IX2144.2 +210100 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-20" TO RE-MARKIX2144.2 +210200 MOVE "00" TO CORRECT-A IX2144.2 +210300 MOVE FILESTATUS (2) TO COMPUTED-A. IX2144.2 +210400 START-TEST-GF-29A. IX2144.2 +210500 PERFORM PRINT-DETAIL. IX2144.2 +210600 START-TEST-GF-30. IX2144.2 +210700 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2144.2 +210800 IF FILESTATUS (3) EQUAL TO "**" IX2144.2 +210900 PERFORM DE-LETE IX2144.2 +211000 MOVE "FROM START-TEST-GF.21" TO CORRECT-A IX2144.2 +211100 GO TO START-TEST-GF-30A. IX2144.2 +211200* IX2144.2 +211300* START-TEST-006.03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +211400* RESULTING FROM START-TEST-GF-21. THE FILE IX2144.2 +211500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +211600* IX2144.2 +211700 IF FILESTATUS (3) EQUAL TO "00" IX2144.2 +211800 PERFORM PASS IX2144.2 +211900 ELSE PERFORM FAIL IX2144.2 +212000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-21" TO RE-MARKIX2144.2 +212100 MOVE "00" TO CORRECT-A IX2144.2 +212200 MOVE FILESTATUS (3) TO COMPUTED-A. IX2144.2 +212300 START-TEST-GF-30A. IX2144.2 +212400 PERFORM PRINT-DETAIL. IX2144.2 +212500 START-TEST-GF-31. IX2144.2 +212600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +212700 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2144.2 +212800 IF FILESTATUS (4) EQUAL TO "**" IX2144.2 +212900 PERFORM DE-LETE IX2144.2 +213000 MOVE "FROM START-TEST-GF-22" TO CORRECT-A IX2144.2 +213100 GO TO START-TEST-GF-31A. IX2144.2 +213200* IX2144.2 +213300* START-TEST-006.04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +213400* RESULTING FROM START-TEST-GF-22. THE FILE IX2144.2 +213500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +213600* IX2144.2 +213700 IF FILESTATUS (4) EQUAL TO "23" IX2144.2 +213800 PERFORM PASS IX2144.2 +213900 ELSE PERFORM FAIL IX2144.2 +214000 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +214100 MOVE "23" TO CORRECT-A IX2144.2 +214200 MOVE FILESTATUS (4) TO COMPUTED-A. IX2144.2 +214300 START-TEST-GF-31A. IX2144.2 +214400 PERFORM PRINT-DETAIL. IX2144.2 +214500 START-TEST-GF-32. IX2144.2 +214600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +214700 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2144.2 +214800 IF FILESTATUS (5) EQUAL TO "**" IX2144.2 +214900 PERFORM DE-LETE IX2144.2 +215000 MOVE "FROM START-TEST-GF-23" TO CORRECT-A IX2144.2 +215100 GO TO START-TEST-GF-32A. IX2144.2 +215200* IX2144.2 +215300* START-TEST-006.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +215400* RESULTING FROM START-TEST-GF-23. THE FILE IX2144.2 +215500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +215600* IX2144.2 +215700 IF FILESTATUS (5) EQUAL TO "00" IX2144.2 +215800 PERFORM PASS IX2144.2 +215900 ELSE PERFORM FAIL IX2144.2 +216000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-23" TO RE-MARKIX2144.2 +216100 MOVE "00" TO CORRECT-A IX2144.2 +216200 MOVE FILESTATUS (5) TO COMPUTED-A. IX2144.2 +216300 START-TEST-GF-32A. IX2144.2 +216400 PERFORM PRINT-DETAIL. IX2144.2 +216500 START-TEST-GF-33. IX2144.2 +216600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +216700 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2144.2 +216800 IF FILESTATUS (6) EQUAL TO "**" IX2144.2 +216900 PERFORM DE-LETE IX2144.2 +217000 MOVE "FROM START-TEST-GF-24" TO CORRECT-A IX2144.2 +217100 GO TO START-TEST-GF-33A. IX2144.2 +217200* IX2144.2 +217300* START-TEST-006.06 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +217400* RESULTING FROM START-TEST-GF-24. THE FILE IX2144.2 +217500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +217600* IX2144.2 +217700 IF FILESTATUS (6) EQUAL TO "00" IX2144.2 +217800 PERFORM PASS IX2144.2 +217900 ELSE PERFORM FAIL IX2144.2 +218000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-24" TO RE-MARKIX2144.2 +218100 MOVE "00" TO CORRECT-A IX2144.2 +218200 MOVE FILESTATUS (6) TO COMPUTED-A. IX2144.2 +218300 START-TEST-GF-33A. IX2144.2 +218400 PERFORM PRINT-DETAIL. IX2144.2 +218500 START-TEST-GF-34. IX2144.2 +218600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +218700 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2144.2 +218800 IF FILESTATUS (7) EQUAL TO "**" IX2144.2 +218900 PERFORM DE-LETE IX2144.2 +219000 MOVE "FROM START-TEST-GF-25" TO CORRECT-A IX2144.2 +219100 GO TO START-TEST-GF-34A. IX2144.2 +219200* IX2144.2 +219300* START-TEST-006.07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +219400* RESULTING FROM START-TEST-GF-25. THE FILE IX2144.2 +219500* STATUS CONTENTS IS EXPECTED TO BE "23" IX2144.2 +219600* IX2144.2 +219700 IF FILESTATUS (7) EQUAL TO "23" IX2144.2 +219800 PERFORM PASS IX2144.2 +219900 ELSE PERFORM FAIL IX2144.2 +220000 MOVE "FROM START-TEST-GF-25; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +220100 MOVE "23" TO CORRECT-A IX2144.2 +220200 MOVE FILESTATUS (7) TO COMPUTED-A. IX2144.2 +220300 START-TEST-GF-34A. IX2144.2 +220400 PERFORM PRINT-DETAIL. IX2144.2 +220500 START-TEST-GF-35. IX2144.2 +220600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +220700 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2144.2 +220800 IF FILESTATUS (8) EQUAL TO "**" IX2144.2 +220900 PERFORM DE-LETE IX2144.2 +221000 MOVE "FROM START-TEST-GF-26" TO CORRECT-A IX2144.2 +221100 GO TO START-TEST-GF-35A. IX2144.2 +221200* IX2144.2 +221300* START-TEST-006.08 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +221400* RESULTING FROM START-TEST-GF-26. THE FILE IX2144.2 +221500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +221600* IX2144.2 +221700 IF FILESTATUS (8) EQUAL TO "00" IX2144.2 +221800 PERFORM PASS IX2144.2 +221900 ELSE PERFORM FAIL IX2144.2 +222000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-26" TO RE-MARKIX2144.2 +222100 MOVE "00" TO CORRECT-A IX2144.2 +222200 MOVE FILESTATUS (8) TO COMPUTED-A. IX2144.2 +222300 START-TEST-GF-35A. IX2144.2 +222400 PERFORM PRINT-DETAIL. IX2144.2 +222500 START-TEST-GF-36. IX2144.2 +222600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +222700 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2144.2 +222800 IF FILESTATUS (9) EQUAL TO "**" IX2144.2 +222900 PERFORM DE-LETE IX2144.2 +223000 MOVE "FROM START-TEST-GF-27" TO CORRECT-A IX2144.2 +223100 GO TO START-TEST-GF-36A. IX2144.2 +223200* IX2144.2 +223300* START-TEST-006.09 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +223400* RESULTING FROM START-TEST-GF-27. THE FILE IX2144.2 +223500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +223600* IX2144.2 +223700 IF FILESTATUS (9) EQUAL TO "23" IX2144.2 +223800 PERFORM PASS IX2144.2 +223900 ELSE PERFORM FAIL IX2144.2 +224000 MOVE "FROM START-TEST-GF-27; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +224100 MOVE "23" TO CORRECT-A IX2144.2 +224200 MOVE FILESTATUS (9) TO COMPUTED-A. IX2144.2 +224300 START-TEST-GF-36A. IX2144.2 +224400 PERFORM PRINT-DETAIL. IX2144.2 +224500 IX2144.2 +224600 IX2144.2 +224700 IX2144.2 +224800 START-INIT-GF-37. IX2144.2 +224900 OPEN I-O IX-FS1. IX2144.2 +225000 MOVE "START SERIES" TO FEATURE. IX2144.2 +225100 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2144.2 +225200 MOVE ZERO TO INVKEY-COUNTER. IX2144.2 +225300* IX2144.2 +225400* THIS TEST EXECUTES SEVERAL START STATEMENTS USING DIFFERENT IX2144.2 +225500* KEY VALUES. FOLLOWING EXECUTION OF THE LAST START IX2144.2 +225600* STATEMENT THE READ STATEMENT IS EXECUTED. THE START IX2144.2 +225700* STATEMENT SHOULD HAVE POSITION THE RECORD POINTER IX2144.2 +225800* SUCH THAT RECORD NUMBER 50 IS MADE AVAILABLE IX2144.2 +225900* TO THE READ STATEMENT. THE KEY OF REFERENCE IX2144.2 +226000* SHOULD BE ALTERNATE-KEY-2. IX2144.2 +226100* IX2144.2 +226200 START-TEST-GF-37. IX2144.2 +226300 MOVE "FGGGGGGGGG098" TO FS1-RECKEY-1-13. IX2144.2 +226400 MOVE "WWWWWWWXXX366ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +226500 MOVE "RRRRRRRRRR300ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +226600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +226700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +226800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +226900 START IX-FS1 IX2144.2 +227000 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2144.2 +227100 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227200 START IX-FS1 INVALID KEY ADD 01 TO INVKEY-COUNTER. IX2144.2 +227300 START IX-FS1 IX2144.2 +227400 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +227500 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227600 START IX-FS1 IX2144.2 +227700 KEY IS NOT LESS THAN IX-FS1-ALTKEY2-1-5 IX2144.2 +227800 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227900 READ IX-FS1 AT END IX2144.2 +228000 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +228100 GO TO START-FAIL-GF-37. IX2144.2 +228200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +228300 IF XRECORD-NUMBER (1) EQUAL TO 175 IX2144.2 +228400 PERFORM PASS IX2144.2 +228500 MOVE "MULTIPLE STARTS BEFORE READ " TO RE-MARK IX2144.2 +228600 GO TO START-WRITE-GF-37. IX2144.2 +228700 MOVE "RRRRRRRRRR050ALTKEY2" TO CORRECT-A. IX2144.2 +228800 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2144.2 +228900 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2144.2 +229000 MOVE SPACE TO P-OR-F. IX2144.2 +229100 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2144.2 +229200 PERFORM PRINT-DETAIL. IX2144.2 +229300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +229400 START-FAIL-GF-37. IX2144.2 +229500 PERFORM FAIL. IX2144.2 +229600 MOVE 175 TO CORRECT-18V0. IX2144.2 +229700 MOVE "WRONG RECORD NUMBER; IX-28 OR IX-36" TO RE-MARK. IX2144.2 +229800 GO TO START-WRITE-GF-37. IX2144.2 +229900 START-DELETE-GF-37. IX2144.2 +230000 PERFORM DE-LETE. IX2144.2 +230100 START-WRITE-GF-37. IX2144.2 +230200 PERFORM PRINT-DETAIL. IX2144.2 +230300 IX2144.2 +230400 CLOSE IX-FS1. IX2144.2 +230500 GO TO CCVS-EXIT. IX2144.2 +230600 IX2144.2 +230700 IX2144.2 +230800 START-INITIALIZE-RECORD. IX2144.2 +230900 MOVE "**" TO FS1-STATUS. IX2144.2 +231000 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2144.2 +231100 MOVE ZERO TO INIT-FLAG. IX2144.2 +231200 MOVE 9999 TO XRECORD-NUMBER (1). IX2144.2 +231300 MOVE SPACE TO IX-FS1R1-F-G-240. IX2144.2 +231400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +231500 START IX-FS1 IX2144.2 +231600 KEY IS EQUAL TO IX-FS1-KEY IX2144.2 +231700 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +231800 MOVE 01 TO INIT-FLAG. IX2144.2 +231900 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2144.2 +232000 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +232100 MOVE 01 TO INIT-FLAG. IX2144.2 +232200 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2144.2 +232300 MOVE 02 TO INIT-FLAG. IX2144.2 +232400 MOVE SPACE TO FS1-STATUS. IX2144.2 +232500 START-INIT-ERROR. IX2144.2 +232600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2144.2 +232700 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2144.2 +232800 IF INIT-FLAG NOT EQUAL 01 IX2144.2 +232900 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY IX2144.2 +233000 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2144.2 +233100 PERFORM PRINT-DETAIL. IX2144.2 +233200 MOVE "**" TO FILESTATUS (REC-CT). IX2144.2 +233300 DISPLAY-RECORD-KEYS. IX2144.2 +233400 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2144.2 +233500 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2144.2 +233600 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2144.2 +233700 MOVE SPACE TO P-OR-F. IX2144.2 +233800 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2144.2 +233900 PERFORM PRINT-DETAIL. IX2144.2 +234000 DISPLAY-ALTERNATE-KEY1. IX2144.2 +234100 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2144.2 +234200 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2144.2 +234300 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2144.2 +234400 MOVE SPACE TO P-OR-F. IX2144.2 +234500 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2144.2 +234600 PERFORM PRINT-DETAIL. IX2144.2 +234700 DISPLAY-ALTERNATE-KEY2. IX2144.2 +234800 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2144.2 +234900 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2144.2 +235000 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2144.2 +235100 MOVE SPACE TO P-OR-F. IX2144.2 +235200 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2144.2 +235300 PERFORM PRINT-DETAIL. IX2144.2 +235400 IX2144.2 +235500 IX2144.2 +235600 CCVS-EXIT SECTION. IX2144.2 +235700 CCVS-999999. IX2144.2 +235800 GO TO CLOSE-FILES. IX2144.2 +*END-OF,IX214A +*HEADER,COBOL,IX215A +000100 IDENTIFICATION DIVISION. IX2154.2 +000200 PROGRAM-ID. IX2154.2 +000300 IX215A. IX2154.2 +000400**************************************************************** IX2154.2 +000500* * IX2154.2 +000600* VALIDATION FOR:- * IX2154.2 +000700* * IX2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +000900* * IX2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2154.2 +001100* * IX2154.2 +001200**************************************************************** IX2154.2 +001300* THE PURPOSE OF THIS PROGRAM IS TO TEST THE ABILITY TO IX2154.2 +001400* DESCRIBE THE PRIME RECORD KEY AND THE ALTERNATE RECORD KEYS IX2154.2 +001500* IN A REDEFINES CLAUSES AND TO TEST THE USE OF QUALIFICATION IX2154.2 +001600* OF THE RECORD KEYS. THE PROGRAM IS BROKEN INTO THREE SEC- IX2154.2 +001700* TIONS. THE FIRST SECTION TESTS THE ABILITY TO USE A IX2154.2 +001800* REDEFINED DATA ITEM OR A DATA ITEM SUBORDINATE TO IT CON- IX2154.2 +001900* TAINING THE LEFTMOST CHARACTER POSTIONS OF THE REDEFINED DATAIX2154.2 +002000* ITEM IN THE KEY PHRASE OF THE START STATEMENT. THE SECOND IX2154.2 +002100* SECTION TESTS THE ABILITY TO USE A RECORD KEY WHICH IS NESTEDIX2154.2 +002200* IN REDEFINES OR A DATA ITEM SUBORDINATE TO IT THAT CONTAINS IX2154.2 +002300* THE LEFTMOST CHARACTER POSITIONS OF A REDEFINED DATA ITEM IX2154.2 +002400* WHICH IS NESTED IN REDEFINES IN THE KEY PHRASE OF THE START IX2154.2 +002500* STATEMENT. THE THIRD SECTION TESTS THE USE OF QUALIFICATION IX2154.2 +002600* OF THE RECORD KEYS. DIFFERENT KEY VALUES ARE USED FOR IX2154.2 +002700* TESTING. IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IX2154.2 +002800* IN THE FILE THE EXECUTION OF A START STATEMENT FOLLOWED BY A IX2154.2 +002900* READ NEXT STATEMENT IS EXPECTED TO MADE AVAILABLE THE RECORD.IX2154.2 +003000* IF A KEY VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD INIX2154.2 +003100* THE FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2154.2 +003200* IX2154.2 +003300* REFERENCE AMERICAN NATIONAL STANDARD IX2154.2 +003400* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2154.2 +003500* SECTION IX, INDEX I-O, THE START IX2154.2 +003600* STATEMENT. PARAGRAPHS 4.7.3 (2), (3), (4); IX2154.2 +003700* 4.7.4 (1), (4), (5), IX2154.2 +003800* (10) AND IX2154.2 +003900* THE REDEFINES CLAUSE PAGE VI-39 5.10.4 (1), IX2154.2 +004000* (2). IX2154.2 +004100* IX2154.2 +004200* BEFORE EACH TEST THE RECORD KEY IS LOAD WITH A KEY VALUE IX2154.2 +004300* WHICH MAY OR MAY NOT BE A VALID KEY FOR THE FILE. ALSO IX2154.2 +004400* BEFORE EACH STEP IN A TEST AN INITIALIZATION PROCEDURE MAY ORIX2154.2 +004500* MAY NOT BE PERFORMED WHICH MAKES AVAILABLE RECORD NUMBER 200.IX2154.2 +004600* IF DURING THIS PROCEDURE AN INVALID KEY OCCURS THE TEST IS IX2154.2 +004700* DELETED. IX2154.2 +004800* IX2154.2 +004900* BEFORE EACH SECTION A INDEXED FILE IS CREATED CONTAINING TWO IX2154.2 +005000* ALTERNATE KEY AND THE ONE REQUIRED RECORD KEY FOR THE FILE. IX2154.2 +005100* IMMEDIATELY FOLLOWING FILE CREATION THE FILE IS READ AND THE IX2154.2 +005200* RECORDS OF THE FILE VERIFIED FOR ACCURACY. NEXT THE TESTS IX2154.2 +005300* ARE EXECUTED USING THE READ, DELETE, REWRITE, and START IX2154.2 +005400* STATEMENTS. IX2154.2 +005500* IX2154.2 +005600* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2154.2 +005700* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA CONTENTSIX2154.2 +005800* FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN THE FILE.IX2154.2 +005900* IX2154.2 +006000* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2154.2 +006100* ------ ---------- --------------- --------------- IX2154.2 +006200* 001 BBBBBBBBBC002 EEEEEEEEEF002ALTKEY1 WWWWWWWWWV398ALTKEY2IX2154.2 +006300* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2154.2 +006400* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2154.2 +006500* . . . . IX2154.2 +006600* . . . . IX2154.2 +006700* . . . . IX2154.2 +006800* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2154.2 +006900* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2154.2 +007000* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2154.2 +007100* . . . . IX2154.2 +007200* . . . . IX2154.2 +007300* . . . . IX2154.2 +007400* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEYIX2154.2 +007500* IX2154.2 +007600* NOTE 1 - ALTERNATE-KEY-2 CONTAINS DUPLICATE KEYS EVERY 10TH IX2154.2 +007700* AND 11TH RECORDS. IX2154.2 +007800* IX2154.2 +007900* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE FILE IX2154.2 +008000* FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE IX2154.2 +008100* MIDDEL 125 RECORDS ONLY THE NUMBER PART OF THE KEYS IX2154.2 +008200* ARE VARIED AND VARIED IN THE SEQUENCE SHOWN ABOVE. IX2154.2 +008300* THAT IS, RECORD KEY AND ALTERNATE-KEY-1 ARE IX2154.2 +008400* INCREMENTED BY 2 ANDT THE ALTERNATE KEY-2 IS IX2154.2 +008500* DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO THEIX2154.2 +008600* FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO IX2154.2 +008700* THAT AN I-O OPERATION IS REQUIRED FOR EACH RECORD IX2154.2 +008800* ACCESSED FROM THE FILE. IX2154.2 +008900* IX2154.2 +009000* X-CARD'S WHICH MUST BE REPLACED WITH IMPLEMENTOR-NAMES' IN IX2154.2 +009100* THIS PROGRAM ARE: IX2154.2 +009200* IX2154.2 +009300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009400* INDEXED FILE-1. IX2154.2 +009500* X-25 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009600* INDEXED FILE-2. IX2154.2 +009700* X-26 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009800* INDEXED FILE-3. IX2154.2 +009900* X-44 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010000* FILE-1 IF NEEDED. IX2154.2 +010100* X-45 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010200* FILE-2 IF NEEDED. IX2154.2 +010300* X-46 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010400* FILE-3 IF NEEDED. IX2154.2 +010500* X-55 SYSTEM PRINTER. IX2154.2 +010600* X-62 FOR RAW-DATA IX2154.2 +010700* X-82 SOURCE-COMPUTER. IX2154.2 +010800* X-83 OBJECT-COMPUTER. IX2154.2 +010900* IX2154.2 +011000******************************************************************IX2154.2 +011100* IX2154.2 +011200 ENVIRONMENT DIVISION. IX2154.2 +011300 CONFIGURATION SECTION. IX2154.2 +011400 SOURCE-COMPUTER. IX2154.2 +011500 XXXXX082. IX2154.2 +011600 OBJECT-COMPUTER. IX2154.2 +011700 XXXXX083 IX2154.2 +011800 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2154.2 +011900 SPECIAL-NAMES. IX2154.2 +012000 ALPHABET IX2154.2 +012100 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2154.2 +012200 INPUT-OUTPUT SECTION. IX2154.2 +012300 FILE-CONTROL. IX2154.2 +012400P SELECT RAW-DATA ASSIGN TO IX2154.2 +012500P XXXXX062 IX2154.2 +012600P ORGANIZATION IS INDEXED IX2154.2 +012700P ACCESS MODE IS RANDOM IX2154.2 +012800P RECORD KEY IS RAW-DATA-KEY. IX2154.2 +012900 SELECT PRINT-FILE ASSIGN TO IX2154.2 +013000 XXXXX055. IX2154.2 +013100 SELECT IX-FD1 IX2154.2 +013200 ASSIGN TO IX2154.2 +013300 XXXXX024 IX2154.2 +013400J XXXXX044 IX2154.2 +013500 ACCESS MODE IS DYNAMIC IX2154.2 +013600 RECORD KEY IS IX-FD1-KEY IX2154.2 +013700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2154.2 +013800 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY2 WITH DUPLICATES IX2154.2 +013900 ORGANIZATION IS INDEXED. IX2154.2 +014000 SELECT IX-FD2 IX2154.2 +014100 ASSIGN TO IX2154.2 +014200 XXXXX025 IX2154.2 +014300J XXXXX045 IX2154.2 +014400 ACCESS MODE IS DYNAMIC IX2154.2 +014500 ORGANIZATION IS INDEXED IX2154.2 +014600 RECORD KEY IS IX-FD2-KEY IX2154.2 +014700 ALTERNATE RECORD KEY IS IX-FD2-ALTKEY1 IX2154.2 +014800 ALTERNATE RECORD KEY IS IX-FD2-ALTKEY2 WITH DUPLICATES IX2154.2 +014900 . IX2154.2 +015000 SELECT IX-FD3 IX2154.2 +015100 ASSIGN TO IX2154.2 +015200 XXXXX026 IX2154.2 +015300J XXXXX046 IX2154.2 +015400 ACCESS MODE IS DYNAMIC IX2154.2 +015500 ORGANIZATION IS INDEXED IX2154.2 +015600 RECORD KEY IS IX-FD3-KEY IN IX-FD3-RECKEY-AREA IX2154.2 +015700 ALTERNATE RECORD KEY IS IX-FD3-KEY OF IX2154.2 +015800 IX-FD3-ALTKEY1-AREA IX2154.2 +015900 ALTERNATE RECORD KEY IS IX-FD3-KEY IX2154.2 +016000 IN IX-FD3-ALTKEY2-AREA IX2154.2 +016100 WITH DUPLICATES IX2154.2 +016200 . IX2154.2 +016300 DATA DIVISION. IX2154.2 +016400 FILE SECTION. IX2154.2 +016500P IX2154.2 +016600PFD RAW-DATA. IX2154.2 +016700P IX2154.2 +016800P01 RAW-DATA-SATZ. IX2154.2 +016900P 05 RAW-DATA-KEY PIC X(6). IX2154.2 +017000P 05 C-DATE PIC 9(6). IX2154.2 +017100P 05 C-TIME PIC 9(8). IX2154.2 +017200P 05 C-NO-OF-TESTS PIC 99. IX2154.2 +017300P 05 C-OK PIC 999. IX2154.2 +017400P 05 C-ALL PIC 999. IX2154.2 +017500P 05 C-FAIL PIC 999. IX2154.2 +017600P 05 C-DELETED PIC 999. IX2154.2 +017700P 05 C-INSPECT PIC 999. IX2154.2 +017800P 05 C-NOTE PIC X(13). IX2154.2 +017900P 05 C-INDENT PIC X. IX2154.2 +018000P 05 C-ABORT PIC X(8). IX2154.2 +018100 FD PRINT-FILE. IX2154.2 +018200 01 PRINT-REC PICTURE X(120). IX2154.2 +018300 01 DUMMY-RECORD PICTURE X(120). IX2154.2 +018400 FD IX-FD1 IX2154.2 +018500C LABEL RECORDS ARE STANDARD IX2154.2 +018600C DATA RECORD IS IX-FD1R1-F-G-240 IX2154.2 +018700 RECORD CONTAINS 240 CHARACTERS. IX2154.2 +018800 01 IX-FD1R1-F-G-240. IX2154.2 +018900 05 IX-FD1-REC-120 PICTURE X(120). IX2154.2 +019000 05 IX-FD1-REC-121-240. IX2154.2 +019100 10 FILLER PICTURE X(8). IX2154.2 +019200 10 IX-REC-KEY-AREA. IX2154.2 +019300 15 IX-FD1-KEY. IX2154.2 +019400 20 IX-FD1-KEY-1-10. IX2154.2 +019500 25 IX-FD1-KEY-1-5 PICTURE X(5). IX2154.2 +019600 25 IX-FD1-KEY-6-10 PICTURE X(5). IX2154.2 +019700 20 IX-FD1-KEY-11-13 PICTURE X(3). IX2154.2 +019800 15 IX-REDF-RECKEY REDEFINES IX-FD1-KEY. IX2154.2 +019900 20 R-RECKEY-1-7 PICTURE X(7). IX2154.2 +020000 20 R-REDF-RECKEY-1-7 REDEFINES R-RECKEY-1-7. IX2154.2 +020100 25 R-RECKEY-1-5 PICTURE X(5). IX2154.2 +020200 25 R-RECKEY-6-7 PICTURE XX. IX2154.2 +020300 20 R-RECKEY-8-13 PICTURE X(6). IX2154.2 +020400 15 FILLER PICTURE X(16). IX2154.2 +020500 10 FILLER PICTURE X(9). IX2154.2 +020600 10 IX-ALT-KEY1-AREA. IX2154.2 +020700 15 IX-FD1-ALTKEY1. IX2154.2 +020800 20 IX-FDW-ALTKEY1-1-10. IX2154.2 +020900 25 IX-FDW-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +021000 25 IX-FDW-ALTKEY1-6-10 PICTURE X(5). IX2154.2 +021100 20 IX-FDW-ALTKEY1-11-13 PICTURE X(3). IX2154.2 +021200 20 IX-FDW-ALTKEY1-14-20 PICTURE X(7). IX2154.2 +021300 15 IX-REDF-ALTKEY1 REDEFINES IX-FD1-ALTKEY1. IX2154.2 +021400 20 R-ALTKEY1-1-6 PICTURE X(6). IX2154.2 +021500 20 R-REDF-ALTKEY1-1-6 REDEFINES R-ALTKEY1-1-6. IX2154.2 +021600 25 R-ALTKEY1-1-4 PICTURE X(4). IX2154.2 +021700 25 R-ALTKEY1-5-6 PICTURE XX. IX2154.2 +021800 20 R-ALTKEY1-7-10 PICTURE X(4). IX2154.2 +021900 20 R-ALTKEY1-11-20 PICTURE X(10). IX2154.2 +022000 15 FILLER PICTURE X(9). IX2154.2 +022100 10 FILLER PICTURE X(9). IX2154.2 +022200 10 IX-ALT-KEY2-AREA. IX2154.2 +022300 15 IX-FD1-ALTKEY2. IX2154.2 +022400 20 IX-FDW-ALTKEY2-1-10. IX2154.2 +022500 25 IX-FDW-ALTKEY2-1-5 PICTURE X(5). IX2154.2 +022600 25 IX-FDW-ALTKEY2-6-10 PICTURE X(5). IX2154.2 +022700 20 IX-FDW-ALTKEY2-11-13 PICTURE X(3). IX2154.2 +022800 20 IX-FDW-ALTKEY2-14-20 PICTURE X(7). IX2154.2 +022900 15 IX-REDF-ALTKEY2 REDEFINES IX-FD1-ALTKEY2. IX2154.2 +023000 20 R-ALTKEY2-1-3 PICTURE XXX. IX2154.2 +023100 20 R-REDF-ALTKEY2-1-3 REDEFINES R-ALTKEY2-1-3. IX2154.2 +023200 25 R-ALTKEY2-1-2 PICTURE XX. IX2154.2 +023300 25 R-ALTKEY2-3-3 PICTURE X. IX2154.2 +023400 20 R-ALTKEY2-4-20 PICTURE X(17). IX2154.2 +023500 15 FILLER PICTURE X(9). IX2154.2 +023600 10 FILLER PICTURE X(7). IX2154.2 +023700 FD IX-FD2 IX2154.2 +023800C LABEL RECORDS ARE STANDARD IX2154.2 +023900C DATA RECORD IS IX-FD2R1-F-G-241 IX2154.2 +024000 BLOCK CONTAINS 4 RECORDS IX2154.2 +024100 RECORD CONTAINS 241 CHARACTERS. IX2154.2 +024200 01 IX-FD2R1-F-G-241. IX2154.2 +024300 03 IX-FD2-REC-241. IX2154.2 +024400 05 IX-FD2-REC-120 PICTURE X(120). IX2154.2 +024500 05 IX-FD2-REC-121-241. IX2154.2 +024600 10 IX-FD2-RECKEY-AREA PICTURE X(37). IX2154.2 +024700 10 IX-FD2-RECKEY-AREA2 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +024800 15 IX-FD2-RECKEY-AREA2-1 PICTURE X(23). IX2154.2 +024900 15 IX-FD2-RECKEY-AREA2-2 PICTURE X(14). IX2154.2 +025000 10 IX-FD2-RECKEY-AREA3 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +025100 15 FILLER PICTURE X(8). IX2154.2 +025200 15 IX-FD2-KEY PICTURE X(13). IX2154.2 +025300 15 FILLER PICTURE X(16). IX2154.2 +025400 10 IX-FD2-RECKEY-AREA4 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +025500 15 FILLER PICTURE X(8). IX2154.2 +025600 15 IX-FD2-RECKEY-REDF PICTURE X(13). IX2154.2 +025700 15 IX-FD2-RECKEY-REDF2 REDEFINES IX-FD2-RECKEY-REDF. IX2154.2 +025800 20 IX-FD2-RECKEY-1-6 PICTURE X(6). IX2154.2 +025900 20 IX-FD2-RECKEY-7-13 PICTURE X(7). IX2154.2 +026000 15 FILLER PICTURE X(16). IX2154.2 +026100 10 FILLER PICTURE X(9). IX2154.2 +026200 10 IX-FD2-ALTKEY1-AREA PICTURE X(29). IX2154.2 +026300 10 IX-FD2-ALTKEY1-AREA2 REDEFINES IX-FD2-ALTKEY1-AREA. IX2154.2 +026400 15 IX-FD2-ALTKEY1-1-6 PICTURE X(6). IX2154.2 +026500 15 IX-FD2-ALTKEY1-7-20 PICTURE X(14). IX2154.2 +026600 15 FILLER PICTURE X(9). IX2154.2 +026700 10 IX-FD2-ALTKEY1-AREA3 REDEFINES IX-FD2-ALTKEY1-AREA. IX2154.2 +026800 15 IX-FD2-ALTKEY1. IX2154.2 +026900 20 IX-FD2-ALTKEY1-10 PICTURE X(10). IX2154.2 +027000 20 IX-FD2-ALTKEY1-11-20 PICTURE X(10). IX2154.2 +027100 15 IX-FD2-REDF-ALTKEY1 REDEFINES IX-FD2-ALTKEY1. IX2154.2 +027200 20 IX-FD2-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +027300 20 IX-FD2-ALTKEY1-6-20 PICTURE X(15). IX2154.2 +027400 15 FILLER PICTURE X(9). IX2154.2 +027500 10 FILLER PICTURE X(9). IX2154.2 +027600 10 IX-FD2-ALTKEY2-AREA PICTURE X(29). IX2154.2 +027700 10 IX-FD2-ALTKEY2-AREA2 REDEFINES IX-FD2-ALTKEY2-AREA. IX2154.2 +027800 15 IX-FD2-ALTKEY2 PICTURE X(20). IX2154.2 +027900 15 FILLER PICTURE X(9). IX2154.2 +028000 10 IX-FD2-ALTKEY2-AREA3 REDEFINES IX-FD2-ALTKEY2-AREA. IX2154.2 +028100 15 IX-FD2-ALTKEY2-1-6 PICTURE X(6). IX2154.2 +028200 15 IX-FD2-REDF-ALTKEY2-1-6 IX2154.2 +028300 REDEFINES IX-FD2-ALTKEY2-1-6. IX2154.2 +028400 20 IX-FD2-ALTKEY2-1-3 PICTURE XXX. IX2154.2 +028500 20 IX-FD2-ALTKEY2-4-6 PICTURE XXX. IX2154.2 +028600 15 IX-FD2-ALTKEY2-7-20 PICTURE X(14). IX2154.2 +028700 15 FILLER PICTURE X(9). IX2154.2 +028800 10 FILLER PICTURE X(8). IX2154.2 +028900 03 IX-FD2-REC-241-240 REDEFINES IX-FD2-REC-241. IX2154.2 +029000 05 IX-FD2-REC-240 PIC X(240). IX2154.2 +029100 05 FILLER PIC X. IX2154.2 +029200 FD IX-FD3 IX2154.2 +029300C LABEL RECORDS ARE STANDARD IX2154.2 +029400C DATA RECORD IS IX-FD3R1-F-G-242 IX2154.2 +029500 RECORD CONTAINS 242 CHARACTERS IX2154.2 +029600 BLOCK CONTAINS 1694 CHARACTERS. IX2154.2 +029700 01 IX-FD3R1-F-G-242. IX2154.2 +029800 03 IX-FD3-REC-242. IX2154.2 +029900 05 IX-FD3-REC-120 PICTURE X(120). IX2154.2 +030000 05 IX-FD3-REC-121-242. IX2154.2 +030100 10 FILLER PICTURE X(8). IX2154.2 +030200 10 IX-FD3-RECKEY-AREA. IX2154.2 +030300 15 IX-FD3-KEY PICTURE X(13). IX2154.2 +030400 10 FILLER PICTURE X(25). IX2154.2 +030500 10 IX-FD3-ALTKEY1-AREA. IX2154.2 +030600 15 IX-FD3-KEY PICTURE X(20). IX2154.2 +030700 10 FILLER PICTURE X(18). IX2154.2 +030800 10 IX-FD3-ALTKEY2-AREA. IX2154.2 +030900 15 IX-FD3-KEY PICTURE X(20). IX2154.2 +031000 10 FILLER PICTURE X(18). IX2154.2 +031100 03 IX-FD3-REC-240 REDEFINES IX-FD3-REC-242. IX2154.2 +031200 05 IX-FD3-240 PICTURE X(240). IX2154.2 +031300 05 FILLER PICTURE XX. IX2154.2 +031400 IX2154.2 +031500 IX2154.2 +031600 WORKING-STORAGE SECTION. IX2154.2 +031700 01 WRK-FDW-RECKEY. IX2154.2 +031800 05 FDW-RECKEY-1-13. IX2154.2 +031900 10 FDW-RECKEY-1-10 PICTURE X(10). IX2154.2 +032000 10 FDW-RECKEY-11-13 PICTURE 9(3). IX2154.2 +032100 05 FILLER PICTURE X(16) VALUE SPACE. IX2154.2 +032200 01 WRK-FDW-ALTKEY1. IX2154.2 +032300 05 FDW-ALTKEY1-1-20. IX2154.2 +032400 10 FDW-ALTKEY1-1-10. IX2154.2 +032500 15 FDW-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +032600 15 FDW-ALTKEY1-6-10 PICTURE X(5). IX2154.2 +032700 10 FDW-ALTKEY1-11-13 PICTURE 9(3). IX2154.2 +032800 10 FDW-ALTKEY1-14-20 PICTURE X(7). IX2154.2 +032900 05 FILLER PICTURE X(9) VALUE SPACE. IX2154.2 +033000 01 WRK-FDW-ALTKEY2. IX2154.2 +033100 05 FDW-ALTKEY2-1-20. IX2154.2 +033200 10 FDW-ALTKEY2-1-10. IX2154.2 +033300 15 FDW-ALTKEY2-1-5 PICTURE X(5). IX2154.2 +033400 15 FDW-ALTKEY2-6-10 PICTURE X(5). IX2154.2 +033500 10 FDW-ALTKEY2-11-13 PICTURE 9(3). IX2154.2 +033600 10 FDW-ALTKEY2-14-20 PICTURE X(7). IX2154.2 +033700 05 FILLER PICTURE X(9) VALUE SPACE. IX2154.2 +033800 01 RECNO PICTURE 9(5) VALUE ZERO. IX2154.2 +033900 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2154.2 +034000 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2154.2 +034100 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2154.2 +034200 01 RECORDS-WRITTEN PICTURE 9(3). IX2154.2 +034300 01 RECKEY-NUM PICTURE 9(3). IX2154.2 +034400 01 ALTKEY1-NUM PICTURE 9(3). IX2154.2 +034500 01 ALTKEY2-NUM PICTURE 9(3). IX2154.2 +034600 01 FAIL-SW PICTURE 9 VALUE ZERO. IX2154.2 +034700 01 RECORD-KEY-CONTENT. IX2154.2 +034800 05 FILLER PIC X(53) VALUE IX2154.2 +034900 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2154.2 +035000 05 FILLER PIC X(53) VALUE IX2154.2 +035100 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2154.2 +035200 05 FILLER PIC X(53) VALUE IX2154.2 +035300 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2154.2 +035400 05 FILLER PIC X(53) VALUE IX2154.2 +035500 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2154.2 +035600 05 FILLER PIC X(53) VALUE IX2154.2 +035700 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2154.2 +035800 05 FILLER PIC X(53) VALUE IX2154.2 +035900 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2154.2 +036000 05 FILLER PIC X(53) VALUE IX2154.2 +036100 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2154.2 +036200 05 FILLER PIC X(53) VALUE IX2154.2 +036300 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2154.2 +036400 05 FILLER PIC X(53) VALUE IX2154.2 +036500 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2154.2 +036600 05 FILLER PIC X(53) VALUE IX2154.2 +036700 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2154.2 +036800 05 FILLER PIC X(53) VALUE IX2154.2 +036900 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2154.2 +037000 05 FILLER PIC X(53) VALUE IX2154.2 +037100 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2154.2 +037200 05 FILLER PIC X(53) VALUE IX2154.2 +037300 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2154.2 +037400 05 FILLER PIC X(53) VALUE IX2154.2 +037500 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2154.2 +037600 05 FILLER PIC X(53) VALUE IX2154.2 +037700 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2154.2 +037800 05 FILLER PIC X(53) VALUE IX2154.2 +037900 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2154.2 +038000 05 FILLER PIC X(53) VALUE IX2154.2 +038100 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2154.2 +038200 05 FILLER PIC X(53) VALUE IX2154.2 +038300 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2154.2 +038400 05 FILLER PIC X(53) VALUE IX2154.2 +038500 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2154.2 +038600 05 FILLER PIC X(53) VALUE IX2154.2 +038700 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2154.2 +038800 05 FILLER PIC X(53) VALUE IX2154.2 +038900 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2154.2 +039000 05 FILLER PIC X(53) VALUE IX2154.2 +039100 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2154.2 +039200 05 FILLER PIC X(53) VALUE IX2154.2 +039300 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2154.2 +039400 05 FILLER PIC X(53) VALUE IX2154.2 +039500 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2154.2 +039600 05 FILLER PIC X(53) VALUE IX2154.2 +039700 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2154.2 +039800 05 FILLER PIC X(53) VALUE IX2154.2 +039900 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2154.2 +040000 05 FILLER PIC X(53) VALUE IX2154.2 +040100 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2154.2 +040200 05 FILLER PIC X(53) VALUE IX2154.2 +040300 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2154.2 +040400 05 FILLER PIC X(53) VALUE IX2154.2 +040500 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2154.2 +040600 05 FILLER PIC X(53) VALUE IX2154.2 +040700 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2154.2 +040800 05 FILLER PIC X(53) VALUE IX2154.2 +040900 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2154.2 +041000 05 FILLER PIC X(53) VALUE IX2154.2 +041100 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2154.2 +041200 05 FILLER PIC X(53) VALUE IX2154.2 +041300 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2154.2 +041400 05 FILLER PIC X(53) VALUE IX2154.2 +041500 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2154.2 +041600 05 FILLER PIC X(53) VALUE IX2154.2 +041700 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2154.2 +041800 05 FILLER PIC X(53) VALUE IX2154.2 +041900 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2154.2 +042000 05 FILLER PIC X(53) VALUE IX2154.2 +042100 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2154.2 +042200 05 FILLER PIC X(53) VALUE IX2154.2 +042300 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2154.2 +042400 05 FILLER PIC X(53) VALUE IX2154.2 +042500 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2154.2 +042600 05 FILLER PIC X(53) VALUE IX2154.2 +042700 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2154.2 +042800 05 FILLER PIC X(53) VALUE IX2154.2 +042900 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2154.2 +043000 05 FILLER PIC X(53) VALUE IX2154.2 +043100 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2154.2 +043200 05 FILLER PIC X(53) VALUE IX2154.2 +043300 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2154.2 +043400 05 FILLER PIC X(53) VALUE IX2154.2 +043500 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2154.2 +043600 05 FILLER PIC X(53) VALUE IX2154.2 +043700 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2154.2 +043800 05 FILLER PIC X(53) VALUE IX2154.2 +043900 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2154.2 +044000 05 FILLER PIC X(53) VALUE IX2154.2 +044100 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2154.2 +044200 05 FILLER PIC X(53) VALUE IX2154.2 +044300 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2154.2 +044400 05 FILLER PIC X(53) VALUE IX2154.2 +044500 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2154.2 +044600 05 FILLER PIC X(53) VALUE IX2154.2 +044700 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2154.2 +044800 05 FILLER PIC X(53) VALUE IX2154.2 +044900 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2154.2 +045000 05 FILLER PIC X(53) VALUE IX2154.2 +045100 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2154.2 +045200 05 FILLER PIC X(53) VALUE IX2154.2 +045300 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2154.2 +045400 05 FILLER PIC X(53) VALUE IX2154.2 +045500 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2154.2 +045600 05 FILLER PIC X(53) VALUE IX2154.2 +045700 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2154.2 +045800 05 FILLER PIC X(53) VALUE IX2154.2 +045900 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2154.2 +046000 05 FILLER PIC X(53) VALUE IX2154.2 +046100 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2154.2 +046200 05 FILLER PIC X(53) VALUE IX2154.2 +046300 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2154.2 +046400 05 FILLER PIC X(53) VALUE IX2154.2 +046500 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2154.2 +046600 05 FILLER PIC X(53) VALUE IX2154.2 +046700 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2154.2 +046800 05 FILLER PIC X(53) VALUE IX2154.2 +046900 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2154.2 +047000 05 FILLER PIC X(53) VALUE IX2154.2 +047100 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2154.2 +047200 05 FILLER PIC X(53) VALUE IX2154.2 +047300 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2154.2 +047400 05 FILLER PIC X(53) VALUE IX2154.2 +047500 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2154.2 +047600 05 FILLER PIC X(53) VALUE IX2154.2 +047700 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2154.2 +047800 05 FILLER PIC X(53) VALUE IX2154.2 +047900 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2154.2 +048000 05 FILLER PIC X(53) VALUE IX2154.2 +048100 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2154.2 +048200 05 FILLER PIC X(53) VALUE IX2154.2 +048300 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2154.2 +048400 05 FILLER PIC X(53) VALUE IX2154.2 +048500 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2154.2 +048600 05 FILLER PIC X(53) VALUE IX2154.2 +048700 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2154.2 +048800 05 FILLER PIC X(53) VALUE IX2154.2 +048900 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2154.2 +049000 05 FILLER PIC X(53) VALUE IX2154.2 +049100 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2154.2 +049200 05 FILLER PIC X(53) VALUE IX2154.2 +049300 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2154.2 +049400 05 FILLER PIC X(53) VALUE IX2154.2 +049500 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2154.2 +049600 05 FILLER PIC X(53) VALUE IX2154.2 +049700 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2154.2 +049800 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2154.2 +049900 05 KEY-VALUES OCCURS 75 TIMES. IX2154.2 +050000 10 RECKEY-VALUE PICTURE X(13). IX2154.2 +050100 10 ALTKEY1-VALUE PICTURE X(20). IX2154.2 +050200 10 ALTKEY2-VALUE PICTURE X(20). IX2154.2 +050300 01 INIT-FLAG PICTURE 9. IX2154.2 +050400 01 FILE-RECORD-INFORMATION-REC. IX2154.2 +050500 03 FILE-RECORD-INFO-SKELETON. IX2154.2 +050600 05 FILLER PICTURE X(48) VALUE IX2154.2 +050700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2154.2 +050800 05 FILLER PICTURE X(46) VALUE IX2154.2 +050900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2154.2 +051000 05 FILLER PICTURE X(26) VALUE IX2154.2 +051100 ",LFIL=000000,ORG= ,LBLR= ". IX2154.2 +051200 05 FILLER PICTURE X(37) VALUE IX2154.2 +051300 ",RECKEY= ". IX2154.2 +051400 05 FILLER PICTURE X(38) VALUE IX2154.2 +051500 ",ALTKEY1= ". IX2154.2 +051600 05 FILLER PICTURE X(38) VALUE IX2154.2 +051700 ",ALTKEY2= ". IX2154.2 +051800 05 FILLER PICTURE X(7) VALUE SPACE.IX2154.2 +051900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2154.2 +052000 05 FILE-RECORD-INFO-P1-120. IX2154.2 +052100 07 FILLER PIC X(5). IX2154.2 +052200 07 XFILE-NAME PIC X(6). IX2154.2 +052300 07 FILLER PIC X(8). IX2154.2 +052400 07 XRECORD-NAME PIC X(6). IX2154.2 +052500 07 FILLER PIC X(1). IX2154.2 +052600 07 REELUNIT-NUMBER PIC 9(1). IX2154.2 +052700 07 FILLER PIC X(7). IX2154.2 +052800 07 XRECORD-NUMBER PIC 9(6). IX2154.2 +052900 07 FILLER PIC X(6). IX2154.2 +053000 07 UPDATE-NUMBER PIC 9(2). IX2154.2 +053100 07 FILLER PIC X(5). IX2154.2 +053200 07 ODO-NUMBER PIC 9(4). IX2154.2 +053300 07 FILLER PIC X(5). IX2154.2 +053400 07 XPROGRAM-NAME PIC X(5). IX2154.2 +053500 07 FILLER PIC X(7). IX2154.2 +053600 07 XRECORD-LENGTH PIC 9(6). IX2154.2 +053700 07 FILLER PIC X(7). IX2154.2 +053800 07 CHARS-OR-RECORDS PIC X(2). IX2154.2 +053900 07 FILLER PIC X(1). IX2154.2 +054000 07 XBLOCK-SIZE PIC 9(4). IX2154.2 +054100 07 FILLER PIC X(6). IX2154.2 +054200 07 RECORDS-IN-FILE PIC 9(6). IX2154.2 +054300 07 FILLER PIC X(5). IX2154.2 +054400 07 XFILE-ORGANIZATION PIC X(2). IX2154.2 +054500 07 FILLER PIC X(6). IX2154.2 +054600 07 XLABEL-TYPE PIC X(1). IX2154.2 +054700 05 FILE-RECORD-INFO-P121-240. IX2154.2 +054800 07 FILLER PIC X(8). IX2154.2 +054900 07 XRECORD-KEY PIC X(29). IX2154.2 +055000 07 FILLER PIC X(9). IX2154.2 +055100 07 ALTERNATE-KEY1 PIC X(29). IX2154.2 +055200 07 FILLER PIC X(9). IX2154.2 +055300 07 ALTERNATE-KEY2 PIC X(29). IX2154.2 +055400 07 FILLER PIC X(7). IX2154.2 +055500 01 TEST-RESULTS. IX2154.2 +055600 02 FILLER PIC X VALUE SPACE. IX2154.2 +055700 02 FEATURE PIC X(20) VALUE SPACE. IX2154.2 +055800 02 FILLER PIC X VALUE SPACE. IX2154.2 +055900 02 P-OR-F PIC X(5) VALUE SPACE. IX2154.2 +056000 02 FILLER PIC X VALUE SPACE. IX2154.2 +056100 02 PAR-NAME. IX2154.2 +056200 03 FILLER PIC X(19) VALUE SPACE. IX2154.2 +056300 03 PARDOT-X PIC X VALUE SPACE. IX2154.2 +056400 03 DOTVALUE PIC 99 VALUE ZERO. IX2154.2 +056500 02 FILLER PIC X(8) VALUE SPACE. IX2154.2 +056600 02 RE-MARK PIC X(61). IX2154.2 +056700 01 TEST-COMPUTED. IX2154.2 +056800 02 FILLER PIC X(30) VALUE SPACE. IX2154.2 +056900 02 FILLER PIC X(17) VALUE IX2154.2 +057000 " COMPUTED=". IX2154.2 +057100 02 COMPUTED-X. IX2154.2 +057200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2154.2 +057300 03 COMPUTED-N REDEFINES COMPUTED-A IX2154.2 +057400 PIC -9(9).9(9). IX2154.2 +057500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2154.2 +057600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2154.2 +057700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2154.2 +057800 03 CM-18V0 REDEFINES COMPUTED-A. IX2154.2 +057900 04 COMPUTED-18V0 PIC -9(18). IX2154.2 +058000 04 FILLER PIC X. IX2154.2 +058100 03 FILLER PIC X(50) VALUE SPACE. IX2154.2 +058200 01 TEST-CORRECT. IX2154.2 +058300 02 FILLER PIC X(30) VALUE SPACE. IX2154.2 +058400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2154.2 +058500 02 CORRECT-X. IX2154.2 +058600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2154.2 +058700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2154.2 +058800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2154.2 +058900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2154.2 +059000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2154.2 +059100 03 CR-18V0 REDEFINES CORRECT-A. IX2154.2 +059200 04 CORRECT-18V0 PIC -9(18). IX2154.2 +059300 04 FILLER PIC X. IX2154.2 +059400 03 FILLER PIC X(2) VALUE SPACE. IX2154.2 +059500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2154.2 +059600 01 CCVS-C-1. IX2154.2 +059700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2154.2 +059800- "SS PARAGRAPH-NAME IX2154.2 +059900- " REMARKS". IX2154.2 +060000 02 FILLER PIC X(20) VALUE SPACE. IX2154.2 +060100 01 CCVS-C-2. IX2154.2 +060200 02 FILLER PIC X VALUE SPACE. IX2154.2 +060300 02 FILLER PIC X(6) VALUE "TESTED". IX2154.2 +060400 02 FILLER PIC X(15) VALUE SPACE. IX2154.2 +060500 02 FILLER PIC X(4) VALUE "FAIL". IX2154.2 +060600 02 FILLER PIC X(94) VALUE SPACE. IX2154.2 +060700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2154.2 +060800 01 REC-CT PIC 99 VALUE ZERO. IX2154.2 +060900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2154.2 +061400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2154.2 +061500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2154.2 +061600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2154.2 +061700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2154.2 +061800 01 CCVS-H-1. IX2154.2 +061900 02 FILLER PIC X(39) VALUE SPACES. IX2154.2 +062000 02 FILLER PIC X(42) VALUE IX2154.2 +062100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2154.2 +062200 02 FILLER PIC X(39) VALUE SPACES. IX2154.2 +062300 01 CCVS-H-2A. IX2154.2 +062400 02 FILLER PIC X(40) VALUE SPACE. IX2154.2 +062500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2154.2 +062600 02 FILLER PIC XXXX VALUE IX2154.2 +062700 "4.2 ". IX2154.2 +062800 02 FILLER PIC X(28) VALUE IX2154.2 +062900 " COPY - NOT FOR DISTRIBUTION". IX2154.2 +063000 02 FILLER PIC X(41) VALUE SPACE. IX2154.2 +063100 IX2154.2 +063200 01 CCVS-H-2B. IX2154.2 +063300 02 FILLER PIC X(15) VALUE IX2154.2 +063400 "TEST RESULT OF ". IX2154.2 +063500 02 TEST-ID PIC X(9). IX2154.2 +063600 02 FILLER PIC X(4) VALUE IX2154.2 +063700 " IN ". IX2154.2 +063800 02 FILLER PIC X(12) VALUE IX2154.2 +063900 " HIGH ". IX2154.2 +064000 02 FILLER PIC X(22) VALUE IX2154.2 +064100 " LEVEL VALIDATION FOR ". IX2154.2 +064200 02 FILLER PIC X(58) VALUE IX2154.2 +064300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +064400 01 CCVS-H-3. IX2154.2 +064500 02 FILLER PIC X(34) VALUE IX2154.2 +064600 " FOR OFFICIAL USE ONLY ". IX2154.2 +064700 02 FILLER PIC X(58) VALUE IX2154.2 +064800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2154.2 +064900 02 FILLER PIC X(28) VALUE IX2154.2 +065000 " COPYRIGHT 1985 ". IX2154.2 +065100 01 CCVS-E-1. IX2154.2 +065200 02 FILLER PIC X(52) VALUE SPACE. IX2154.2 +065300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2154.2 +065400 02 ID-AGAIN PIC X(9). IX2154.2 +065500 02 FILLER PIC X(45) VALUE SPACES. IX2154.2 +065600 01 CCVS-E-2. IX2154.2 +065700 02 FILLER PIC X(31) VALUE SPACE. IX2154.2 +065800 02 FILLER PIC X(21) VALUE SPACE. IX2154.2 +065900 02 CCVS-E-2-2. IX2154.2 +066000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2154.2 +066100 03 FILLER PIC X VALUE SPACE. IX2154.2 +066200 03 ENDER-DESC PIC X(44) VALUE IX2154.2 +066300 "ERRORS ENCOUNTERED". IX2154.2 +066400 01 CCVS-E-3. IX2154.2 +066500 02 FILLER PIC X(22) VALUE IX2154.2 +066600 " FOR OFFICIAL USE ONLY". IX2154.2 +066700 02 FILLER PIC X(12) VALUE SPACE. IX2154.2 +066800 02 FILLER PIC X(58) VALUE IX2154.2 +066900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +067000 02 FILLER PIC X(13) VALUE SPACE. IX2154.2 +067100 02 FILLER PIC X(15) VALUE IX2154.2 +067200 " COPYRIGHT 1985". IX2154.2 +067300 01 CCVS-E-4. IX2154.2 +067400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2154.2 +067500 02 FILLER PIC X(4) VALUE " OF ". IX2154.2 +067600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2154.2 +067700 02 FILLER PIC X(40) VALUE IX2154.2 +067800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2154.2 +067900 01 XXINFO. IX2154.2 +068000 02 FILLER PIC X(19) VALUE IX2154.2 +068100 "*** INFORMATION ***". IX2154.2 +068200 02 INFO-TEXT. IX2154.2 +068300 04 FILLER PIC X(8) VALUE SPACE. IX2154.2 +068400 04 XXCOMPUTED PIC X(20). IX2154.2 +068500 04 FILLER PIC X(5) VALUE SPACE. IX2154.2 +068600 04 XXCORRECT PIC X(20). IX2154.2 +068700 02 INF-ANSI-REFERENCE PIC X(48). IX2154.2 +068800 01 HYPHEN-LINE. IX2154.2 +068900 02 FILLER PIC IS X VALUE IS SPACE. IX2154.2 +069000 02 FILLER PIC IS X(65) VALUE IS "************************IX2154.2 +069100- "*****************************************". IX2154.2 +069200 02 FILLER PIC IS X(54) VALUE IS "************************IX2154.2 +069300- "******************************". IX2154.2 +069400 01 CCVS-PGM-ID PIC X(9) VALUE IX2154.2 +069500 "IX215A". IX2154.2 +069600 PROCEDURE DIVISION. IX2154.2 +069700 CCVS1 SECTION. IX2154.2 +069800 OPEN-FILES. IX2154.2 +069900P OPEN I-O RAW-DATA. IX2154.2 +070000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2154.2 +070100P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2154.2 +070200P MOVE "ABORTED " TO C-ABORT. IX2154.2 +070300P ADD 1 TO C-NO-OF-TESTS. IX2154.2 +070400P ACCEPT C-DATE FROM DATE. IX2154.2 +070500P ACCEPT C-TIME FROM TIME. IX2154.2 +070600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2154.2 +070700PEND-E-1. IX2154.2 +070800P CLOSE RAW-DATA. IX2154.2 +070900 OPEN OUTPUT PRINT-FILE. IX2154.2 +071000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2154.2 +071100 MOVE SPACE TO TEST-RESULTS. IX2154.2 +071200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2154.2 +071300 MOVE ZERO TO REC-SKL-SUB. IX2154.2 +071400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2154.2 +071500 CCVS-INIT-FILE. IX2154.2 +071600 ADD 1 TO REC-SKL-SUB. IX2154.2 +071700 MOVE FILE-RECORD-INFO-SKELETON IX2154.2 +071800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2154.2 +071900 CCVS-INIT-EXIT. IX2154.2 +072000 GO TO CCVS1-EXIT. IX2154.2 +072100 CLOSE-FILES. IX2154.2 +072200P OPEN I-O RAW-DATA. IX2154.2 +072300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2154.2 +072400P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2154.2 +072500P MOVE "OK. " TO C-ABORT. IX2154.2 +072600P MOVE PASS-COUNTER TO C-OK. IX2154.2 +072700P MOVE ERROR-HOLD TO C-ALL. IX2154.2 +072800P MOVE ERROR-COUNTER TO C-FAIL. IX2154.2 +072900P MOVE DELETE-COUNTER TO C-DELETED. IX2154.2 +073000P MOVE INSPECT-COUNTER TO C-INSPECT. IX2154.2 +073100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2154.2 +073200PEND-E-2. IX2154.2 +073300P CLOSE RAW-DATA. IX2154.2 +073400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2154.2 +073500 TERMINATE-CCVS. IX2154.2 +073600S EXIT PROGRAM. IX2154.2 +073700STERMINATE-CALL. IX2154.2 +073800 STOP RUN. IX2154.2 +073900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2154.2 +074000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2154.2 +074100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2154.2 +074200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2154.2 +074300 MOVE "****TEST DELETED****" TO RE-MARK. IX2154.2 +074400 PRINT-DETAIL. IX2154.2 +074500 IF REC-CT NOT EQUAL TO ZERO IX2154.2 +074600 MOVE "." TO PARDOT-X IX2154.2 +074700 MOVE REC-CT TO DOTVALUE. IX2154.2 +074800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2154.2 +074900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2154.2 +075000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2154.2 +075100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2154.2 +075200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2154.2 +075300 MOVE SPACE TO CORRECT-X. IX2154.2 +075400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2154.2 +075500 MOVE SPACE TO RE-MARK. IX2154.2 +075600 HEAD-ROUTINE. IX2154.2 +075700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +075800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +075900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2154.2 +076000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2154.2 +076100 COLUMN-NAMES-ROUTINE. IX2154.2 +076200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +076300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +076400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +076500 END-ROUTINE. IX2154.2 +076600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2154.2 +076700 END-RTN-EXIT. IX2154.2 +076800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +076900 END-ROUTINE-1. IX2154.2 +077000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2154.2 +077100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2154.2 +077200 ADD PASS-COUNTER TO ERROR-HOLD. IX2154.2 +077300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2154.2 +077400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2154.2 +077500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2154.2 +077600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2154.2 +077700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2154.2 +077800 END-ROUTINE-12. IX2154.2 +077900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2154.2 +078000 IF ERROR-COUNTER IS EQUAL TO ZERO IX2154.2 +078100 MOVE "NO " TO ERROR-TOTAL IX2154.2 +078200 ELSE IX2154.2 +078300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2154.2 +078400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2154.2 +078500 PERFORM WRITE-LINE. IX2154.2 +078600 END-ROUTINE-13. IX2154.2 +078700 IF DELETE-COUNTER IS EQUAL TO ZERO IX2154.2 +078800 MOVE "NO " TO ERROR-TOTAL ELSE IX2154.2 +078900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2154.2 +079000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2154.2 +079100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079200 IF INSPECT-COUNTER EQUAL TO ZERO IX2154.2 +079300 MOVE "NO " TO ERROR-TOTAL IX2154.2 +079400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2154.2 +079500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2154.2 +079600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079800 WRITE-LINE. IX2154.2 +079900 ADD 1 TO RECORD-COUNT. IX2154.2 +080000Y IF RECORD-COUNT GREATER 42 IX2154.2 +080100Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2154.2 +080200Y MOVE SPACE TO DUMMY-RECORD IX2154.2 +080300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2154.2 +080400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2154.2 +080500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2154.2 +080600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2154.2 +080700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2154.2 +080800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +080900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +081000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +081100Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2154.2 +081200Y MOVE ZERO TO RECORD-COUNT. IX2154.2 +081300 PERFORM WRT-LN. IX2154.2 +081400 WRT-LN. IX2154.2 +081500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2154.2 +081600 MOVE SPACE TO DUMMY-RECORD. IX2154.2 +081700 BLANK-LINE-PRINT. IX2154.2 +081800 PERFORM WRT-LN. IX2154.2 +081900 FAIL-ROUTINE. IX2154.2 +082000 IF COMPUTED-X NOT EQUAL TO SPACE IX2154.2 +082100 GO TO FAIL-ROUTINE-WRITE. IX2154.2 +082200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2154.2 +082300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2154.2 +082400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2154.2 +082500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +082600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2154.2 +082700 GO TO FAIL-ROUTINE-EX. IX2154.2 +082800 FAIL-ROUTINE-WRITE. IX2154.2 +082900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2154.2 +083000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2154.2 +083100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2154.2 +083200 MOVE SPACES TO COR-ANSI-REFERENCE. IX2154.2 +083300 FAIL-ROUTINE-EX. EXIT. IX2154.2 +083400 BAIL-OUT. IX2154.2 +083500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2154.2 +083600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2154.2 +083700 BAIL-OUT-WRITE. IX2154.2 +083800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2154.2 +083900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2154.2 +084000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +084100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2154.2 +084200 BAIL-OUT-EX. EXIT. IX2154.2 +084300 CCVS1-EXIT. IX2154.2 +084400 EXIT. IX2154.2 +084500 SECT-0001-IX215A SECTION. IX2154.2 +084600 WRITE-INT-GF-01. IX2154.2 +084700 OPEN OUTPUT IX-FD1. IX2154.2 +084800 MOVE "IX-FD1" TO XFILE-NAME (1). IX2154.2 +084900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +085000 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +085100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +085200 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +085300 MOVE 240 TO XRECORD-LENGTH (1). IX2154.2 +085400 MOVE 001 TO XBLOCK-SIZE (1). IX2154.2 +085500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +085600 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +085700 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +085800 MOVE "CREATE-FILE-FD1" TO FEATURE. IX2154.2 +085900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2154.2 +086000 MOVE ZERO TO KEYSUB. IX2154.2 +086100 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +086200 WRITE-INIT-GF-01-01. IX2154.2 +086300 PERFORM WRITE-TEST-GF-01-R1 50 TIMES. IX2154.2 +086400 PERFORM WRITE-TEST-GF-01-R2 125 TIMES. IX2154.2 +086500 PERFORM WRITE-TEST-GF-01-R1 25 TIMES. IX2154.2 +086600 GO TO WRITE-TEST-GF-01. IX2154.2 +086700 WRITE-TEST-GF-01-R1. IX2154.2 +086800 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +086900 ADD 001 TO KEYSUB. IX2154.2 +087000 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +087100 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +087200 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +087300 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +087400 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +087500 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +087600 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2154.2 +087700 WRITE IX-FD1R1-F-G-240 IX2154.2 +087800 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +087900 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +088000 WRITE-TEST-GF-01-R2. IX2154.2 +088100 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +088200 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +088300 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +088400 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +088500 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +088600 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +088700 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +088800 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2154.2 +088900 WRITE IX-FD1R1-F-G-240 IX2154.2 +089000 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +089100 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +089200 WRITE-TEST-GF-01. IX2154.2 +089300 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +089400 GIVING RECORDS-WRITTEN. IX2154.2 +089500 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +089600 PERFORM PASS IX2154.2 +089700 MOVE "FILE IX-FD1 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +089800 ELSE PERFORM FAIL IX2154.2 +089900 MOVE IX2154.2 +090000 "IX-41;WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)"IX2154.2 +090100 TO RE-MARK IX2154.2 +090200 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +090300 GO TO WRITE-TEST-GF-01-END. IX2154.2 +090400 WRITE-DELETE-GF-01. IX2154.2 +090500 PERFORM DE-LETE. IX2154.2 +090600 WRITE-TEST-GF-01-END. IX2154.2 +090700 PERFORM PRINT-DETAIL. IX2154.2 +090800 CLOSE IX-FD1. IX2154.2 +090900 READ-INIT-F1-01. IX2154.2 +091000 OPEN INPUT IX-FD1. IX2154.2 +091100 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2154.2 +091200 MOVE "READ FILE IX-FD1" TO FEATURE. IX2154.2 +091300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +091400 MOVE 02 TO RECKEY-NUM. IX2154.2 +091500 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +091600 READ-TEST-F1-01-R1. IX2154.2 +091700 READ IX-FD1 NEXT RECORD AT END GO TO READ-TEST-F1-01. IX2154.2 +091800 MOVE IX-REC-KEY-AREA TO WRK-FDW-RECKEY. IX2154.2 +091900 MOVE IX-ALT-KEY1-AREA TO WRK-FDW-ALTKEY1. IX2154.2 +092000 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +092100 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +092200 NEXT SENTENCE IX2154.2 +092300 ELSE IX2154.2 +092400 PERFORM READ-FAIL-F1-01. IX2154.2 +092500 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +092600 GO TO READ-TEST-F1-01. IX2154.2 +092700 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +092800 ADD 002 TO RECKEY-NUM IX2154.2 +092900 ADD 002 TO ALTKEY1-NUM. IX2154.2 +093000 GO TO READ-TEST-F1-01-R1. IX2154.2 +093100 READ-TEST-F1-01. IX2154.2 +093200 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-01. IX2154.2 +093300 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +093400 PERFORM PASS IX2154.2 +093500 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +093600 ELSE PERFORM FAIL IX2154.2 +093700 MOVE "INCORRECT NUMBER OF RECORDS; IX-41 OR IX-28" TO RE-MARKIX2154.2 +093800 MOVE 200 TO CORRECT-18V0 IX2154.2 +093900 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +094000 PERFORM PRINT-DETAIL. IX2154.2 +094100 GO TO READ-EXIT-F1-01. IX2154.2 +094200 READ-FAIL-F1-01. IX2154.2 +094300 MOVE 1 TO FAIL-SW. IX2154.2 +094400 PERFORM FAIL. IX2154.2 +094500 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +094600 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +094700 MOVE "READ-FAIL-F1-01; IX-41 OR IX-28" TO RE-MARK. IX2154.2 +094800 READ-EXIT-F1-01. IX2154.2 +094900 CLOSE IX-FD1. IX2154.2 +095000 START-INIT. IX2154.2 +095100 OPEN I-O IX-FD1. IX2154.2 +095200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +095300 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2154.2 +095400 MOVE "START REDF REC-KEY" TO FEATURE. IX2154.2 +095500 MOVE "BBBBBBBBBC002" TO FDW-RECKEY-1-13. IX2154.2 +095600 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +095700 START-TEST-GF-01. IX2154.2 +095800 DELETE IX-FD1 INVALID KEY IX2154.2 +095900 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +096000 GO TO START-FAIL-GF-01. IX2154.2 +096100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +096200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +096300 GO TO START-DELETE-GF-01. IX2154.2 +096400 MOVE "BBBBBBBBBC002" TO FDW-RECKEY-1-13. IX2154.2 +096500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +096600 START IX-FD1 IX2154.2 +096700 KEY IS EQUAL TO IX-REDF-RECKEY IX2154.2 +096800 INVALID KEY PERFORM PASS IX2154.2 +096900 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +097000 TO RE-MARK IX2154.2 +097100 GO TO START-WRITE-GF-01. IX2154.2 +097200 READ IX-FD1 NEXT RECORD AT END IX2154.2 +097300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +097400 GO TO START-FAIL-GF-01. IX2154.2 +097500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +097600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +097700 START-FAIL-GF-01. IX2154.2 +097800 PERFORM FAIL. IX2154.2 +097900 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +098000 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +098100 GO TO START-WRITE-GF-01. IX2154.2 +098200 START-DELETE-GF-01. IX2154.2 +098300 PERFORM DE-LETE. IX2154.2 +098400 START-WRITE-GF-01. IX2154.2 +098500 PERFORM PRINT-DETAIL. IX2154.2 +098600 START-INIT-GF-02. IX2154.2 +098700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +098800 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2154.2 +098900 MOVE "FGGGGGGGGG098" TO FDW-RECKEY-1-13. IX2154.2 +099000 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +099100 START-TEST-GF-02. IX2154.2 +099200 DELETE IX-FD1 INVALID KEY IX2154.2 +099300 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +099400 GO TO START-FAIL-GF-02. IX2154.2 +099500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +099600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +099700 GO TO START-DELETE-GF-02. IX2154.2 +099800 MOVE "FGGGGGGAAA002" TO FDW-RECKEY-1-13. IX2154.2 +099900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +100000 START IX-FD1 IX2154.2 +100100 KEY IS EQUAL TO R-RECKEY-1-7 IX2154.2 +100200 INVALID KEY PERFORM PASS IX2154.2 +100300 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +100400 TO RE-MARK IX2154.2 +100500 GO TO START-WRITE-GF-02. IX2154.2 +100600 READ IX-FD1 NEXT RECORD AT END IX2154.2 +100700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +100800 GO TO START-FAIL-GF-02. IX2154.2 +100900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +101000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +101100 START-FAIL-GF-02. IX2154.2 +101200 PERFORM FAIL. IX2154.2 +101300 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +101400 MOVE "IX-28 OR IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +101500 GO TO START-WRITE-GF-02. IX2154.2 +101600 START-DELETE-GF-02. IX2154.2 +101700 PERFORM DE-LETE. IX2154.2 +101800 START-WRITE-GF-02. IX2154.2 +101900 PERFORM PRINT-DETAIL. IX2154.2 +102000 START-INIT-GF-03. IX2154.2 +102100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +102200 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2154.2 +102300 MOVE "UUUUUUUUUU400" TO FDW-RECKEY-1-13. IX2154.2 +102400 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +102500 START-TEST-GF-03. IX2154.2 +102600 DELETE IX-FD1 INVALID KEY IX2154.2 +102700 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +102800 GO TO START-FAIL-GF-03. IX2154.2 +102900 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +103000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +103100 GO TO START-DELETE-GF-03. IX2154.2 +103200 MOVE "UUUUURRRRR000" TO FDW-RECKEY-1-13. IX2154.2 +103300 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +103400 START IX-FD1 IX2154.2 +103500 KEY IS EQUAL TO R-RECKEY-1-5 IX2154.2 +103600 INVALID KEY PERFORM PASS IX2154.2 +103700 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +103800 TO RE-MARK IX2154.2 +103900 GO TO START-WRITE-GF-03. IX2154.2 +104000 READ IX-FD1 NEXT RECORD AT END IX2154.2 +104100 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +104200 GO TO START-FAIL-GF-03. IX2154.2 +104300 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +104400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +104500 START-FAIL-GF-03. IX2154.2 +104600 PERFORM FAIL. IX2154.2 +104700 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +104800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +104900 GO TO START-WRITE-GF-03. IX2154.2 +105000 START-DELETE-GF-03. IX2154.2 +105100 PERFORM DE-LETE. IX2154.2 +105200 START-WRITE-GF-03. IX2154.2 +105300 PERFORM PRINT-DETAIL. IX2154.2 +105400 START-INIT-GF-04. IX2154.2 +105500 MOVE "START REDF ALT-KEY-1" TO FEATURE. IX2154.2 +105600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +105700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2154.2 +105800 MOVE "TUUUUUUUUU398" TO FDW-RECKEY-1-13. IX2154.2 +105900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +106000 START-TEST-GF-04. IX2154.2 +106100 READ IX-FD1 IX2154.2 +106200 KEY IS IX-FD1-KEY IX2154.2 +106300 INVALID KEY IX2154.2 +106400 MOVE "ERROR IX-28 F2; INVALID KEY PATH TAKEN ON INITIAL READ"IX2154.2 +106500 TO RE-MARK IX2154.2 +106600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +106700 GO TO START-FAIL-GF-04. IX2154.2 +106800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +106900 IF XRECORD-NUMBER (3) NOT EQUAL TO 199 IX2154.2 +107000 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK IX2154.2 +107100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +107200 GO TO START-FAIL-GF-04. IX2154.2 +107300 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +107400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +107500 GO TO START-DELETE-GF-04. IX2154.2 +107600 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +107700 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +107800 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +107900 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +108000 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON REWRITE"IX2154.2 +108100 TO RE-MARK IX2154.2 +108200 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +108300 GO TO START-FAIL-GF-04. IX2154.2 +108400 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +108500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +108600 GO TO START-FAIL-GF-04. IX2154.2 +108700 MOVE "EEEEEEEEEE000ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +108800 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +108900 START IX-FD1 IX2154.2 +109000 KEY IS EQUAL TO IX-REDF-ALTKEY1 IX2154.2 +109100 INVALID KEY IX2154.2 +109200 MOVE "ERROR IX-36; INVALID KEY PATH TAKEN ON START" IX2154.2 +109300 TO RE-MARK IX2154.2 +109400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +109500 GO TO START-FAIL-GF-04. IX2154.2 +109600 READ IX-FD1 NEXT RECORD AT END IX2154.2 +109700 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARKIX2154.2 +109800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +109900 GO TO START-FAIL-GF-04. IX2154.2 +110000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +110100 IF XRECORD-NUMBER (1) EQUAL TO 199 IX2154.2 +110200 PERFORM PASS IX2154.2 +110300 GO TO START-WRITE-GF-04. IX2154.2 +110400 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +110500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +110600 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +110700 MOVE "IX-28 F1; INCORRECT ALTERNATE RECORD KEY1" TO RE-MARK.IX2154.2 +110800 PERFORM PRINT-DETAIL. IX2154.2 +110900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +111000 TO RE-MARK. IX2154.2 +111100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +111200 START-FAIL-GF-04. IX2154.2 +111300 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2154.2 +111400 PERFORM FAIL. IX2154.2 +111500 MOVE 199 TO CORRECT-18V0. IX2154.2 +111600 GO TO START-WRITE-GF-04. IX2154.2 +111700 START-DELETE-GF-04. IX2154.2 +111800 PERFORM DE-LETE. IX2154.2 +111900 START-WRITE-GF-04. IX2154.2 +112000 PERFORM PRINT-DETAIL. IX2154.2 +112100 START-INIT-GF-05. IX2154.2 +112200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +112300 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2154.2 +112400 MOVE "BCCCCCCCCC018" TO FDW-RECKEY-1-13. IX2154.2 +112500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +112600 START-TEST-GF-05. IX2154.2 +112700 READ IX-FD1 IX2154.2 +112800 KEY IS IX-FD1-KEY IX2154.2 +112900 INVALID KEY IX2154.2 +113000 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON READ" IX2154.2 +113100 TO RE-MARK IX2154.2 +113200 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +113300 GO TO START-FAIL-GF-05. IX2154.2 +113400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +113500 IF XRECORD-NUMBER (3) NOT EQUAL TO 9 IX2154.2 +113600 MOVE 9 TO RECNO IX2154.2 +113700 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +113800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK IX2154.2 +113900 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +114000 GO TO START-FAIL-GF-05. IX2154.2 +114100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +114200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +114300 GO TO START-DELETE-GF-05. IX2154.2 +114400 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +114500 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +114600 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +114700 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +114800 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +114900 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +115000 GO TO START-FAIL-GF-05. IX2154.2 +115100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +115200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +115300 GO TO START-FAIL-GF-05. IX2154.2 +115400 MOVE "AAAAAANNNN200ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +115500 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +115600 START IX-FD1 IX2154.2 +115700 KEY IS EQUAL TO R-ALTKEY1-1-6 IX2154.2 +115800 INVALID KEY IX2154.2 +115900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +116000 TO RE-MARK IX2154.2 +116100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +116200 GO TO START-FAIL-GF-05. IX2154.2 +116300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +116400 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARK IX2154.2 +116500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +116600 GO TO START-FAIL-GF-05. IX2154.2 +116700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +116800 IF XRECORD-NUMBER (1) EQUAL TO 9 IX2154.2 +116900 PERFORM PASS IX2154.2 +117000 GO TO START-WRITE-GF-05. IX2154.2 +117100 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +117200 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +117300 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +117400 MOVE "INCORRECT ALTERNATE RECORD KEY1" TO RE-MARK. IX2154.2 +117500 PERFORM PRINT-DETAIL. IX2154.2 +117600 MOVE "IX-28 F1;WRONG RECORD NUMB FOUND READ ALTERN. REC KEY1"IX2154.2 +117700 TO RE-MARK. IX2154.2 +117800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +117900 START-FAIL-GF-05. IX2154.2 +118000 PERFORM FAIL. IX2154.2 +118100 MOVE 9 TO CORRECT-18V0. IX2154.2 +118200 GO TO START-WRITE-GF-05. IX2154.2 +118300 START-DELETE-GF-05. IX2154.2 +118400 PERFORM DE-LETE. IX2154.2 +118500 START-WRITE-GF-05. IX2154.2 +118600 PERFORM PRINT-DETAIL. IX2154.2 +118700 START-INIT-GF-06. IX2154.2 +118800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +118900 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2154.2 +119000 MOVE "GGGGGGGGGG100" TO FDW-RECKEY-1-13. IX2154.2 +119100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +119200 START-TEST-GF-06. IX2154.2 +119300 READ IX-FD1 IX2154.2 +119400 KEY IS IX-FD1-KEY IX2154.2 +119500 INVALID KEY IX2154.2 +119600 MOVE "ERROR IX-28; INVALID KEY PATH TAKEN ON READ" IX2154.2 +119700 TO RE-MARK IX2154.2 +119800 GO TO START-FAIL-GF-06. IX2154.2 +119900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +120000 IF XRECORD-NUMBER (3) NOT EQUAL TO 50 IX2154.2 +120100 MOVE 50 TO RECNO IX2154.2 +120200 MOVE "WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +120300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +120400 GO TO START-FAIL-GF-06. IX2154.2 +120500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +120600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +120700 GO TO START-DELETE-GF-06. IX2154.2 +120800 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +120900 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +121000 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +121100 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +121200 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON REWRITE"IX2154.2 +121300 TO RE-MARK IX2154.2 +121400 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +121500 GO TO START-FAIL-GF-06. IX2154.2 +121600 IX2154.2 +121700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +121800 GO TO START-FAIL-GF-06. IX2154.2 +121900 MOVE "AAGGZZZZZZ100ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +122000 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +122100 START IX-FD1 IX2154.2 +122200 KEY IS EQUAL TO R-ALTKEY1-1-4 IX2154.2 +122300 INVALID KEY IX2154.2 +122400 MOVE "ERROR IX-36; INVALID KEY PATH TAKEN ON START" IX2154.2 +122500 TO RE-MARK IX2154.2 +122600 MOVE "INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +122700 TO RE-MARK IX2154.2 +122800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +122900 GO TO START-FAIL-GF-06. IX2154.2 +123000 READ IX-FD1 NEXT RECORD AT END IX2154.2 +123100 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARK IX2154.2 +123200 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +123300 GO TO START-FAIL-GF-06. IX2154.2 +123400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +123500 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2154.2 +123600 PERFORM PASS IX2154.2 +123700 GO TO START-WRITE-GF-06. IX2154.2 +123800 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +123900 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +124000 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +124100 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +124200 PERFORM PRINT-DETAIL. IX2154.2 +124300 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1" IX2154.2 +124400 TO RE-MARK. IX2154.2 +124500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +124600 START-FAIL-GF-06. IX2154.2 +124700 PERFORM FAIL. IX2154.2 +124800 MOVE 50 TO CORRECT-18V0. IX2154.2 +124900 GO TO START-WRITE-GF-06. IX2154.2 +125000 START-DELETE-GF-06. IX2154.2 +125100 PERFORM DE-LETE. IX2154.2 +125200 START-WRITE-GF-06. IX2154.2 +125300 PERFORM PRINT-DETAIL. IX2154.2 +125400 START-INIT-GF-07. IX2154.2 +125500 MOVE "START REDF ALT-KEY-2" TO FEATURE. IX2154.2 +125600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +125700 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2154.2 +125800 MOVE "DDDDDEEEEE050" TO FDW-RECKEY-1-13. IX2154.2 +125900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +126000 START-TEST-GF-07. IX2154.2 +126100 READ IX-FD1 IX2154.2 +126200 KEY IS IX-FD1-KEY IX2154.2 +126300 INVALID KEY IX2154.2 +126400 MOVE "IX-28 F2; INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +126500 TO RE-MARK IX2154.2 +126600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +126700 GO TO START-FAIL-GF-07. IX2154.2 +126800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +126900 IF XRECORD-NUMBER (3) NOT EQUAL TO 25 IX2154.2 +127000 MOVE 25 TO RECNO IX2154.2 +127100 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +127200 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +127300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +127400 GO TO START-FAIL-GF-07. IX2154.2 +127500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +127600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +127700 GO TO START-DELETE-GF-07. IX2154.2 +127800 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +127900 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +128000 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +128100 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +128200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +128300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +128400 GO TO START-FAIL-GF-07. IX2154.2 +128500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +128600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +128700 GO TO START-FAIL-GF-07. IX2154.2 +128800 MOVE "CBCBCBCBCB100ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +128900 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +129000 START IX-FD1 IX2154.2 +129100 KEY IS EQUAL TO IX-REDF-ALTKEY2 IX2154.2 +129200 INVALID KEY IX2154.2 +129300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +129400 TO RE-MARK IX2154.2 +129500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +129600 GO TO START-FAIL-GF-07. IX2154.2 +129700 READ IX-FD1 NEXT RECORD AT END IX2154.2 +129800 MOVE "IX-28; F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +129900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +130000 GO TO START-FAIL-GF-07. IX2154.2 +130100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +130200 IF XRECORD-NUMBER (1) EQUAL TO 25 IX2154.2 +130300 PERFORM PASS IX2154.2 +130400 GO TO START-WRITE-GF-07. IX2154.2 +130500 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +130600 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +130700 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +130800 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +130900 PERFORM PRINT-DETAIL. IX2154.2 +131000 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +131100 TO RE-MARK. IX2154.2 +131200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +131300 START-FAIL-GF-07. IX2154.2 +131400 PERFORM FAIL. IX2154.2 +131500 MOVE 25 TO CORRECT-18V0. IX2154.2 +131600 GO TO START-WRITE-GF-07. IX2154.2 +131700 START-DELETE-GF-07. IX2154.2 +131800 PERFORM DE-LETE. IX2154.2 +131900 START-WRITE-GF-07. IX2154.2 +132000 PERFORM PRINT-DETAIL. IX2154.2 +132100 START-INIT-GF-08. IX2154.2 +132200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +132300 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2154.2 +132400 MOVE "RRRRSSSSSS352" TO FDW-RECKEY-1-13. IX2154.2 +132500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +132600 START-TEST-GF-08. IX2154.2 +132700 READ IX-FD1 IX2154.2 +132800 KEY IS IX-FD1-KEY IX2154.2 +132900 INVALID KEY IX2154.2 +133000 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +133100 TO RE-MARK IX2154.2 +133200 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +133300 GO TO START-FAIL-GF-08. IX2154.2 +133400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +133500 IF XRECORD-NUMBER (3) NOT EQUAL TO 176 IX2154.2 +133600 MOVE 51 TO RECNO IX2154.2 +133700 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +133800 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +133900 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +134000 GO TO START-FAIL-GF-08. IX2154.2 +134100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +134200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +134300 GO TO START-DELETE-GF-08. IX2154.2 +134400 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +134500 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +134600 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +134700 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +134800 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +134900 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +135000 GO TO START-FAIL-GF-08. IX2154.2 +135100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +135200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +135300 GO TO START-FAIL-GF-08. IX2154.2 +135400 MOVE "DCDAAAAAAA250ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +135500 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +135600 START IX-FD1 IX2154.2 +135700 KEY IS EQUAL TO R-ALTKEY2-1-3 IX2154.2 +135800 INVALID KEY IX2154.2 +135900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +136000 TO RE-MARK IX2154.2 +136100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +136200 GO TO START-FAIL-GF-08. IX2154.2 +136300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +136400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +136500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +136600 GO TO START-FAIL-GF-08. IX2154.2 +136700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +136800 IF XRECORD-NUMBER (1) EQUAL TO 176 IX2154.2 +136900 PERFORM PASS IX2154.2 +137000 GO TO START-WRITE-GF-08. IX2154.2 +137100 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +137200 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +137300 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +137400 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +137500 PERFORM PRINT-DETAIL. IX2154.2 +137600 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +137700 TO RE-MARK. IX2154.2 +137800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +137900 START-FAIL-GF-08. IX2154.2 +138000 PERFORM FAIL. IX2154.2 +138100 MOVE 176 TO CORRECT-18V0. IX2154.2 +138200 GO TO START-WRITE-GF-08. IX2154.2 +138300 START-DELETE-GF-08. IX2154.2 +138400 PERFORM DE-LETE. IX2154.2 +138500 START-WRITE-GF-08. IX2154.2 +138600 PERFORM PRINT-DETAIL. IX2154.2 +138700 START-INIT-GF-09. IX2154.2 +138800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +138900 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2154.2 +139000 MOVE "BBBBBBCCCC008" TO FDW-RECKEY-1-13. IX2154.2 +139100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +139200 START-TEST-GF-09. IX2154.2 +139300 READ IX-FD1 IX2154.2 +139400 KEY IS IX-FD1-KEY IX2154.2 +139500 INVALID KEY IX2154.2 +139600 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +139700 TO RE-MARK IX2154.2 +139800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +139900 MOVE 4 TO CORRECT-18V0 IX2154.2 +140000 GO TO START-FAIL-GF-09. IX2154.2 +140100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +140200 IF XRECORD-NUMBER (3) NOT EQUAL TO 4 IX2154.2 +140300 MOVE 4 TO RECNO IX2154.2 +140400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +140500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +140600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +140700 MOVE 4 TO CORRECT-18V0 IX2154.2 +140800 GO TO START-FAIL-GF-09. IX2154.2 +140900 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +141000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +141100 GO TO START-DELETE-GF-09. IX2154.2 +141200 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +141300 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +141400 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +141500 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +141600 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +141700 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +141800 MOVE 4 TO CORRECT-18V0 IX2154.2 +141900 GO TO START-FAIL-GF-09. IX2154.2 +142000 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +142100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +142200 GO TO START-FAIL-GF-09. IX2154.2 +142300 MOVE "DCZZZZZZZZ400ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +142400 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +142500 START IX-FD1 IX2154.2 +142600 KEY IS EQUAL TO R-ALTKEY2-1-2 IX2154.2 +142700 INVALID KEY IX2154.2 +142800 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +142900 TO RE-MARK IX2154.2 +143000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +143100 MOVE 176 TO CORRECT-18V0 IX2154.2 +143200 GO TO START-FAIL-GF-09. IX2154.2 +143300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +143400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +143500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +143600 MOVE 176 TO CORRECT-18V0 IX2154.2 +143700 GO TO START-FAIL-GF-09. IX2154.2 +143800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +143900 IF XRECORD-NUMBER (1) NOT EQUAL TO 176 IX2154.2 +144000 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +144100 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +144200 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +144300 MOVE IX2154.2 +144400 "IX-28 OR IX-36; INCORR KEY FOUND ON FIRST READ DUPL KEYS" IX2154.2 +144500 TO RE-MARK IX2154.2 +144600 PERFORM PRINT-DETAIL IX2154.2 +144700 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +144800 TO RE-MARK IX2154.2 +144900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +145000 MOVE 176 TO CORRECT-18V0 IX2154.2 +145100 GO TO START-FAIL-GF-09. IX2154.2 +145200 READ IX-FD1 NEXT RECORD AT END IX2154.2 +145300 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +145400 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +145500 MOVE 4 TO CORRECT-18V0 IX2154.2 +145600 GO TO START-FAIL-GF-09. IX2154.2 +145700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +145800 IF XRECORD-NUMBER (1) EQUAL TO 4 IX2154.2 +145900 PERFORM PASS IX2154.2 +146000 PERFORM PRINT-DETAIL IX2154.2 +146100 GO TO START-WRITE-GF-09. IX2154.2 +146200 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +146300 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +146400 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +146500 MOVE IX2154.2 +146600 "IX-28OR IX-36; INCORR KEY FOUND ON SECOND READ DUPL. KEYS" IX2154.2 +146700 TO RE-MARK. IX2154.2 +146800 PERFORM PRINT-DETAIL. IX2154.2 +146900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +147000 MOVE 4 TO CORRECT-18V0. IX2154.2 +147100 START-FAIL-GF-09. IX2154.2 +147200 PERFORM FAIL. IX2154.2 +147300 GO TO START-WRITE-GF-09. IX2154.2 +147400 START-DELETE-GF-09. IX2154.2 +147500 PERFORM DE-LETE. IX2154.2 +147600 START-WRITE-GF-09. IX2154.2 +147700 PERFORM PRINT-DETAIL. IX2154.2 +147800 START-TERM-003. IX2154.2 +147900 CLOSE IX-FD1. IX2154.2 +148000 WRITE-INT-GF-02. IX2154.2 +148100 OPEN OUTPUT IX-FD2. IX2154.2 +148200 MOVE "IX-FD2" TO XFILE-NAME (1). IX2154.2 +148300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +148400 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +148500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +148600 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +148700 MOVE 241 TO XRECORD-LENGTH (1). IX2154.2 +148800 MOVE 004 TO XBLOCK-SIZE (1). IX2154.2 +148900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +149000 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +149100 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +149200 MOVE "CREATE-FILE-FD2" TO FEATURE. IX2154.2 +149300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2154.2 +149400 MOVE ZERO TO KEYSUB. IX2154.2 +149500 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +149600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +149700 WRITE-INIT-GF-02-01. IX2154.2 +149800 PERFORM WRITE-TEST-GF-02-R1 50 TIMES. IX2154.2 +149900 PERFORM WRITE-TEST-GF-02-R2 125 TIMES. IX2154.2 +150000 PERFORM WRITE-TEST-GF-02-R1 25 TIMES. IX2154.2 +150100 GO TO WRITE-TEST-GF-02. IX2154.2 +150200 WRITE-TEST-GF-02-R1. IX2154.2 +150300 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +150400 ADD 001 TO KEYSUB. IX2154.2 +150500 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +150600 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +150700 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +150800 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +150900 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +151000 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +151100 MOVE FILE-RECORD-INFO (1) TO IX-FD2R1-F-G-241. IX2154.2 +151200 WRITE IX-FD2R1-F-G-241 IX2154.2 +151300 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +151400 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +151500 WRITE-TEST-GF-02-R2. IX2154.2 +151600 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +151700 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +151800 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +151900 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +152000 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +152100 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +152200 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +152300 MOVE FILE-RECORD-INFO (1) TO IX-FD2R1-F-G-241. IX2154.2 +152400 WRITE IX-FD2R1-F-G-241 IX2154.2 +152500 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +152600 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +152700 WRITE-TEST-GF-02. IX2154.2 +152800 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +152900 GIVING RECORDS-WRITTEN. IX2154.2 +153000 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +153100 PERFORM PASS IX2154.2 +153200 MOVE "FILE IX-FD2 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +153300 ELSE PERFORM FAIL IX2154.2 +153400 MOVE "IX-41;IX2154.2 +153500- "WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)" IX2154.2 +153600 TO RE-MARK IX2154.2 +153700 MOVE 200 TO CORRECT-18V0 IX2154.2 +153800 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +153900 GO TO WRITE-TEST-GF-02-END. IX2154.2 +154000 WRITE-DELETE-GF-02. IX2154.2 +154100 PERFORM DE-LETE. IX2154.2 +154200 WRITE-TEST-GF-02-END. IX2154.2 +154300 PERFORM PRINT-DETAIL. IX2154.2 +154400 CLOSE IX-FD2. IX2154.2 +154500 READ-INIT-F1-02. IX2154.2 +154600 OPEN INPUT IX-FD2. IX2154.2 +154700 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2154.2 +154800 MOVE "READ FILE IX-FD2" TO FEATURE. IX2154.2 +154900 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +155000 MOVE 02 TO RECKEY-NUM. IX2154.2 +155100 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +155200 READ-TEST-F1-02-R1. IX2154.2 +155300 READ IX-FD2 NEXT RECORD AT END GO TO READ-TEST-F1-02. IX2154.2 +155400 MOVE IX-FD2-KEY TO FDW-RECKEY-1-13. IX2154.2 +155500 MOVE IX-FD2-ALTKEY1 TO FDW-ALTKEY1-1-20. IX2154.2 +155600 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +155700 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +155800 NEXT SENTENCE IX2154.2 +155900 ELSE IX2154.2 +156000 PERFORM READ-FAIL-F1-02. IX2154.2 +156100 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +156200 GO TO READ-TEST-F1-02. IX2154.2 +156300 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +156400 ADD 002 TO RECKEY-NUM IX2154.2 +156500 ADD 002 TO ALTKEY1-NUM. IX2154.2 +156600 GO TO READ-TEST-F1-02-R1. IX2154.2 +156700 READ-TEST-F1-02. IX2154.2 +156800 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-02. IX2154.2 +156900 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +157000 PERFORM PASS IX2154.2 +157100 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +157200 ELSE PERFORM FAIL IX2154.2 +157300 MOVE IX2154.2 +157400 "INCORRECT NUMBER OF RECORDS; IX-28 OR IX-41" TO RE-MARKIX2154.2 +157500 MOVE 200 TO CORRECT-18V0 IX2154.2 +157600 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +157700 PERFORM PRINT-DETAIL. IX2154.2 +157800 GO TO READ-EXIT-F1-02. IX2154.2 +157900 READ-FAIL-F1-02. IX2154.2 +158000 MOVE 1 TO FAIL-SW. IX2154.2 +158100 PERFORM FAIL. IX2154.2 +158200 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +158300 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +158400 MOVE "NUM EMBEDDED IN RECKEY; IX-28 OR IX-41" TO RE-MARK. IX2154.2 +158500 PERFORM PRINT-DETAIL. IX2154.2 +158600 READ-EXIT-F1-02. IX2154.2 +158700 CLOSE IX-FD2. IX2154.2 +158800 START-INIT-GF-10. IX2154.2 +158900 OPEN I-O IX-FD2. IX2154.2 +159000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +159100 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2154.2 +159200 MOVE "START REDF REC-KEY" TO FEATURE. IX2154.2 +159300 MOVE "TTTTUUUUUU392" TO IX-FD2-KEY. IX2154.2 +159400 START-TEST-GF-10. IX2154.2 +159500 DELETE IX-FD2 INVALID KEY IX2154.2 +159600 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +159700 GO TO START-FAIL-GF-10. IX2154.2 +159800 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +159900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +160000 GO TO START-DELETE-GF-10. IX2154.2 +160100 MOVE "TTTTUUUUUU392" TO IX-FD2-KEY. IX2154.2 +160200 START IX-FD2 KEY IS EQUAL TO IX-FD2-KEY IX2154.2 +160300 INVALID KEY PERFORM PASS IX2154.2 +160400 GO TO START-WRITE-GF-10. IX2154.2 +160500 READ IX-FD2 NEXT RECORD AT END IX2154.2 +160600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +160700 GO TO START-FAIL-GF-10. IX2154.2 +160800 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +160900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +161000 START-FAIL-GF-10. IX2154.2 +161100 PERFORM FAIL. IX2154.2 +161200 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +161300 MOVE "IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +161400 GO TO START-WRITE-GF-10. IX2154.2 +161500 START-DELETE-GF-10. IX2154.2 +161600 PERFORM DE-LETE. IX2154.2 +161700 START-WRITE-GF-10. IX2154.2 +161800 PERFORM PRINT-DETAIL. IX2154.2 +161900 START-INIT-GF-11. IX2154.2 +162000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +162100 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2154.2 +162200 MOVE "FFFFFGGGGG090" TO IX-FD2-KEY. IX2154.2 +162300 START-TEST-GF-11. IX2154.2 +162400 DELETE IX-FD2 INVALID KEY IX2154.2 +162500 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +162600 GO TO START-FAIL-GF-11. IX2154.2 +162700 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +162800 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +162900 GO TO START-DELETE-GF-11. IX2154.2 +163000 MOVE "FFFFFGGGGG090" TO IX-FD2-KEY. IX2154.2 +163100 START IX-FD2 KEY IS EQUAL TO IX-FD2-RECKEY-REDF IX2154.2 +163200 INVALID KEY PERFORM PASS IX2154.2 +163300 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +163400 TO RE-MARK IX2154.2 +163500 GO TO START-WRITE-GF-11. IX2154.2 +163600 READ IX-FD2 NEXT RECORD AT END IX2154.2 +163700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +163800 GO TO START-FAIL-GF-11. IX2154.2 +163900 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +164000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +164100 START-FAIL-GF-11. IX2154.2 +164200 PERFORM FAIL. IX2154.2 +164300 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +164400 MOVE "IX-28 OR IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +164500 GO TO START-WRITE-GF-11. IX2154.2 +164600 START-DELETE-GF-11. IX2154.2 +164700 PERFORM DE-LETE. IX2154.2 +164800 START-WRITE-GF-11. IX2154.2 +164900 PERFORM PRINT-DETAIL. IX2154.2 +165000 START-INIT-GF-12. IX2154.2 +165100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +165200 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2154.2 +165300 MOVE "BBBBCCCCCC012" TO IX-FD2-KEY. IX2154.2 +165400 START-TEST-GF-12. IX2154.2 +165500 DELETE IX-FD2 INVALID KEY IX2154.2 +165600 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +165700 GO TO START-FAIL-GF-12. IX2154.2 +165800 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +165900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +166000 GO TO START-DELETE-GF-12. IX2154.2 +166100 MOVE "BBBBCCDDDD015" TO IX-FD2-KEY. IX2154.2 +166200 START IX-FD2 IX2154.2 +166300 KEY IS EQUAL TO IX-FD2-RECKEY-1-6 IX2154.2 +166400 INVALID KEY PERFORM PASS IX2154.2 +166500 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +166600 TO RE-MARK IX2154.2 +166700 GO TO START-WRITE-GF-12. IX2154.2 +166800 READ IX-FD2 NEXT RECORD AT END IX2154.2 +166900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +167000 GO TO START-FAIL-GF-12. IX2154.2 +167100 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +167200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +167300 START-FAIL-GF-12. IX2154.2 +167400 PERFORM FAIL. IX2154.2 +167500 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +167600 MOVE "WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +167700 GO TO START-WRITE-GF-12. IX2154.2 +167800 START-DELETE-GF-12. IX2154.2 +167900 PERFORM DE-LETE. IX2154.2 +168000 START-WRITE-GF-12. IX2154.2 +168100 PERFORM PRINT-DETAIL. IX2154.2 +168200 START-INIT-GF-13. IX2154.2 +168300 MOVE "START REDF ALT-KEY-1" TO FEATURE. IX2154.2 +168400 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +168500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2154.2 +168600 MOVE "RSSSSSSSSS358" TO IX-FD2-KEY. IX2154.2 +168700 START-TEST-GF-13. IX2154.2 +168800 READ IX-FD2 IX2154.2 +168900 KEY IS IX-FD2-KEY IX2154.2 +169000 INVALID KEY IX2154.2 +169100 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +169200 TO RE-MARK IX2154.2 +169300 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +169400 GO TO START-FAIL-GF-13. IX2154.2 +169500 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +169600 IF XRECORD-NUMBER (3) NOT EQUAL TO 179 IX2154.2 +169700 MOVE 54 TO RECNO IX2154.2 +169800 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +169900 MOVE "WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +170000 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +170100 GO TO START-FAIL-GF-13. IX2154.2 +170200 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +170300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +170400 GO TO START-DELETE-GF-13. IX2154.2 +170500 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +170600 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +170700 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +170800 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +170900 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +171000 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +171100 GO TO START-FAIL-GF-13. IX2154.2 +171200 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +171300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +171400 GO TO START-FAIL-GF-13. IX2154.2 +171500 MOVE "EEEEEEEEEE000ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +171600 START IX-FD2 IX2154.2 +171700 KEY IS EQUAL TO IX-FD2-ALTKEY1 IX2154.2 +171800 INVALID KEY IX2154.2 +171900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +172000 TO RE-MARK IX2154.2 +172100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +172200 GO TO START-FAIL-GF-13. IX2154.2 +172300 READ IX-FD2 NEXT RECORD AT END IX2154.2 +172400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +172500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +172600 GO TO START-FAIL-GF-13. IX2154.2 +172700 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +172800 IF XRECORD-NUMBER (1) EQUAL TO 179 IX2154.2 +172900 PERFORM PASS IX2154.2 +173000 GO TO START-WRITE-GF-13. IX2154.2 +173100 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +173200 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +173300 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +173400 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +173500 PERFORM PRINT-DETAIL. IX2154.2 +173600 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +173700 TO RE-MARK. IX2154.2 +173800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +173900 START-FAIL-GF-13. IX2154.2 +174000 PERFORM FAIL. IX2154.2 +174100 MOVE 179 TO CORRECT-18V0. IX2154.2 +174200 GO TO START-WRITE-GF-13. IX2154.2 +174300 START-DELETE-GF-13. IX2154.2 +174400 PERFORM DE-LETE. IX2154.2 +174500 START-WRITE-GF-13. IX2154.2 +174600 PERFORM PRINT-DETAIL. IX2154.2 +174700 START-INIT-GF-14. IX2154.2 +174800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +174900 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2154.2 +175000 MOVE "TTUUUUUUUU396" TO IX-FD2-KEY. IX2154.2 +175100 START-TEST-GF-14. IX2154.2 +175200 READ IX-FD2 IX2154.2 +175300 KEY IS IX-FD2-KEY IX2154.2 +175400 INVALID KEY IX2154.2 +175500 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +175600 TO RE-MARK IX2154.2 +175700 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +175800 GO TO START-FAIL-GF-14. IX2154.2 +175900 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +176000 IF XRECORD-NUMBER (3) NOT EQUAL TO 198 IX2154.2 +176100 MOVE 73 TO RECNO IX2154.2 +176200 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +176300 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +176400 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +176500 GO TO START-FAIL-GF-14. IX2154.2 +176600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +176700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +176800 GO TO START-DELETE-GF-14. IX2154.2 +176900 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +177000 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +177100 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +177200 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +177300 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +177400 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +177500 GO TO START-FAIL-GF-14. IX2154.2 +177600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +177700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +177800 GO TO START-FAIL-GF-14. IX2154.2 +177900 MOVE "AAAAAAAAAA400ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +178000 START IX-FD2 IX2154.2 +178100 KEY IS EQUAL TO IX-FD2-REDF-ALTKEY1 IX2154.2 +178200 INVALID KEY IX2154.2 +178300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +178400 TO RE-MARK IX2154.2 +178500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +178600 GO TO START-FAIL-GF-14. IX2154.2 +178700 READ IX-FD2 NEXT RECORD AT END IX2154.2 +178800 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +178900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +179000 GO TO START-FAIL-GF-14. IX2154.2 +179100 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +179200 IF XRECORD-NUMBER (1) EQUAL TO 198 IX2154.2 +179300 PERFORM PASS IX2154.2 +179400 GO TO START-WRITE-GF-14. IX2154.2 +179500 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +179600 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +179700 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +179800 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +179900 PERFORM PRINT-DETAIL. IX2154.2 +180000 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +180100 TO RE-MARK. IX2154.2 +180200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +180300 START-FAIL-GF-14. IX2154.2 +180400 PERFORM FAIL. IX2154.2 +180500 MOVE 198 TO CORRECT-18V0. IX2154.2 +180600 GO TO START-WRITE-GF-14. IX2154.2 +180700 START-DELETE-GF-14. IX2154.2 +180800 PERFORM DE-LETE. IX2154.2 +180900 START-WRITE-GF-14. IX2154.2 +181000 PERFORM PRINT-DETAIL. IX2154.2 +181100 START-INIT-GF-15. IX2154.2 +181200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +181300 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2154.2 +181400 MOVE "BBBBBBBBBC002" TO IX-FD2-KEY. IX2154.2 +181500 START-TEST-GF-15. IX2154.2 +181600 READ IX-FD2 IX2154.2 +181700 KEY IS IX-FD2-KEY IX2154.2 +181800 INVALID KEY IX2154.2 +181900 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +182000 TO RE-MARK IX2154.2 +182100 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +182200 GO TO START-FAIL-GF-15. IX2154.2 +182300 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +182400 IF XRECORD-NUMBER (3) NOT EQUAL TO 1 IX2154.2 +182500 MOVE 1 TO RECNO IX2154.2 +182600 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +182700 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +182800 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +182900 GO TO START-FAIL-GF-15. IX2154.2 +183000 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +183100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +183200 GO TO START-DELETE-GF-15. IX2154.2 +183300 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +183400 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +183500 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +183600 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +183700 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +183800 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +183900 GO TO START-FAIL-GF-15. IX2154.2 +184000 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +184100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +184200 GO TO START-FAIL-GF-15. IX2154.2 +184300 MOVE "AAGGGZZZZZ100ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +184400 START IX-FD2 IX2154.2 +184500 KEY IS EQUAL TO IX-FD2-ALTKEY1-1-5 IX2154.2 +184600 INVALID KEY IX2154.2 +184700 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +184800 TO RE-MARK IX2154.2 +184900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +185000 GO TO START-FAIL-GF-15. IX2154.2 +185100 READ IX-FD2 NEXT RECORD AT END IX2154.2 +185200 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +185300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +185400 GO TO START-FAIL-GF-15. IX2154.2 +185500 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +185600 IF XRECORD-NUMBER (1) EQUAL TO 1 IX2154.2 +185700 PERFORM PASS IX2154.2 +185800 GO TO START-WRITE-GF-15. IX2154.2 +185900 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +186000 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +186100 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +186200 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +186300 PERFORM PRINT-DETAIL. IX2154.2 +186400 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +186500 TO RE-MARK. IX2154.2 +186600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +186700 START-FAIL-GF-15. IX2154.2 +186800 PERFORM FAIL. IX2154.2 +186900 MOVE 1 TO CORRECT-18V0. IX2154.2 +187000 GO TO START-WRITE-GF-15. IX2154.2 +187100 START-DELETE-GF-15. IX2154.2 +187200 PERFORM DE-LETE. IX2154.2 +187300 START-WRITE-GF-15. IX2154.2 +187400 PERFORM PRINT-DETAIL. IX2154.2 +187500 START-INIT-GF-16. IX2154.2 +187600 MOVE "START REDF ALT-KEY-2" TO FEATURE. IX2154.2 +187700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +187800 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2154.2 +187900 MOVE "SSSSSTTTTT370" TO IX-FD2-KEY. IX2154.2 +188000 START-TEST-GF-16. IX2154.2 +188100 READ IX-FD2 IX2154.2 +188200 KEY IS IX-FD2-KEY IX2154.2 +188300 INVALID KEY IX2154.2 +188400 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +188500 TO RE-MARK IX2154.2 +188600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +188700 GO TO START-FAIL-GF-16. IX2154.2 +188800 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +188900 IF XRECORD-NUMBER (3) NOT EQUAL TO 185 IX2154.2 +189000 MOVE 60 TO RECNO IX2154.2 +189100 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +189200 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +189300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +189400 GO TO START-FAIL-GF-16. IX2154.2 +189500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +189600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +189700 GO TO START-DELETE-GF-16. IX2154.2 +189800 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +189900 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +190000 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +190100 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +190200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +190300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +190400 GO TO START-FAIL-GF-16. IX2154.2 +190500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +190600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +190700 GO TO START-FAIL-GF-16. IX2154.2 +190800 MOVE "CBCBCBCBCB100ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +190900 START IX-FD2 IX2154.2 +191000 KEY IS EQUAL TO IX-FD2-ALTKEY2 IX2154.2 +191100 INVALID KEY IX2154.2 +191200 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +191300 TO RE-MARK IX2154.2 +191400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +191500 GO TO START-FAIL-GF-16. IX2154.2 +191600 READ IX-FD2 NEXT RECORD AT END IX2154.2 +191700 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +191800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +191900 GO TO START-FAIL-GF-16. IX2154.2 +192000 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +192100 IF XRECORD-NUMBER (1) EQUAL TO 185 IX2154.2 +192200 PERFORM PASS IX2154.2 +192300 GO TO START-WRITE-GF-16. IX2154.2 +192400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +192500 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +192600 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +192700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +192800 PERFORM PRINT-DETAIL. IX2154.2 +192900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +193000 TO RE-MARK. IX2154.2 +193100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +193200 START-FAIL-GF-16. IX2154.2 +193300 PERFORM FAIL. IX2154.2 +193400 MOVE 185 TO CORRECT-18V0. IX2154.2 +193500 GO TO START-WRITE-GF-16. IX2154.2 +193600 START-DELETE-GF-16. IX2154.2 +193700 PERFORM DE-LETE. IX2154.2 +193800 START-WRITE-GF-16. IX2154.2 +193900 PERFORM PRINT-DETAIL. IX2154.2 +194000 START-INIT-GF-17. IX2154.2 +194100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +194200 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2154.2 +194300 MOVE "FFFFFFFFFG082" TO IX-FD2-KEY. IX2154.2 +194400 START-TEST-GF-17. IX2154.2 +194500 READ IX-FD2 IX2154.2 +194600 KEY IS IX-FD2-KEY IX2154.2 +194700 INVALID KEY IX2154.2 +194800 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +194900 TO RE-MARK IX2154.2 +195000 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +195100 GO TO START-FAIL-GF-17. IX2154.2 +195200 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +195300 IF XRECORD-NUMBER (3) NOT EQUAL TO 41 IX2154.2 +195400 MOVE 41 TO RECNO IX2154.2 +195500 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +195600 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +195700 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +195800 GO TO START-FAIL-GF-17. IX2154.2 +195900 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +196000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +196100 GO TO START-DELETE-GF-17. IX2154.2 +196200 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +196300 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +196400 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +196500 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +196600 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +196700 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +196800 GO TO START-FAIL-GF-17. IX2154.2 +196900 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +197000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +197100 GO TO START-FAIL-GF-17. IX2154.2 +197200 MOVE "DCDCDCZZZZ999ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +197300 START IX-FD2 IX2154.2 +197400 KEY IS EQUAL TO IX-FD2-ALTKEY2-1-6 IX2154.2 +197500 INVALID KEY IX2154.2 +197600 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +197700 TO RE-MARK IX2154.2 +197800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +197900 GO TO START-FAIL-GF-17. IX2154.2 +198000 READ IX-FD2 NEXT RECORD AT END IX2154.2 +198100 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +198200 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +198300 GO TO START-FAIL-GF-17. IX2154.2 +198400 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +198500 IF XRECORD-NUMBER (1) EQUAL TO 41 IX2154.2 +198600 PERFORM PASS IX2154.2 +198700 GO TO START-WRITE-GF-17. IX2154.2 +198800 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +198900 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +199000 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +199100 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +199200 PERFORM PRINT-DETAIL. IX2154.2 +199300 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +199400 TO RE-MARK. IX2154.2 +199500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +199600 START-FAIL-GF-17. IX2154.2 +199700 PERFORM FAIL. IX2154.2 +199800 MOVE 41 TO CORRECT-18V0. IX2154.2 +199900 GO TO START-WRITE-GF-17. IX2154.2 +200000 START-DELETE-GF-17. IX2154.2 +200100 PERFORM DE-LETE. IX2154.2 +200200 START-WRITE-GF-17. IX2154.2 +200300 PERFORM PRINT-DETAIL. IX2154.2 +200400 START-INIT-GF-18. IX2154.2 +200500 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +200600 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2154.2 +200700 MOVE "TTTTTTTTUU384" TO IX-FD2-KEY. IX2154.2 +200800 START-TEST-GF-18. IX2154.2 +200900 READ IX-FD2 IX2154.2 +201000 KEY IS IX-FD2-KEY IX2154.2 +201100 INVALID KEY IX2154.2 +201200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +201300 TO RE-MARK IX2154.2 +201400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +201500 MOVE 192 TO CORRECT-18V0 IX2154.2 +201600 GO TO START-FAIL-GF-18. IX2154.2 +201700 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +201800 IF XRECORD-NUMBER (3) NOT EQUAL TO 192 IX2154.2 +201900 MOVE 67 TO RECNO IX2154.2 +202000 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +202100 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +202200 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +202300 MOVE 192 TO CORRECT-18V0 IX2154.2 +202400 GO TO START-FAIL-GF-18. IX2154.2 +202500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +202600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +202700 GO TO START-DELETE-GF-18. IX2154.2 +202800 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +202900 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +203000 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +203100 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +203200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +203300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +203400 MOVE 192 TO CORRECT-18V0 IX2154.2 +203500 GO TO START-FAIL-GF-18. IX2154.2 +203600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +203700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +203800 GO TO START-FAIL-GF-18. IX2154.2 +203900 MOVE "DCDZZZZZZZ400ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +204000 START IX-FD2 IX2154.2 +204100 KEY IS EQUAL TO IX-FD2-ALTKEY2-1-3 IX2154.2 +204200 INVALID KEY IX2154.2 +204300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +204400 TO RE-MARK IX2154.2 +204500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +204600 MOVE 41 TO CORRECT-18V0 IX2154.2 +204700 GO TO START-FAIL-GF-18. IX2154.2 +204800 READ IX-FD2 NEXT RECORD AT END IX2154.2 +204900 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +205000 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +205100 MOVE 41 TO CORRECT-18V0 IX2154.2 +205200 GO TO START-FAIL-GF-18. IX2154.2 +205300 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +205400 IF XRECORD-NUMBER (1) NOT EQUAL TO 41 IX2154.2 +205500 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +205600 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +205700 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +205800 MOVE IX2154.2 +205900 "IX-28/36; INCORRECT KEY FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +206000 TO RE-MARK IX2154.2 +206100 PERFORM PRINT-DETAIL IX2154.2 +206200 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +206300 TO RE-MARK IX2154.2 +206400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +206500 MOVE 41 TO CORRECT-18V0 IX2154.2 +206600 GO TO START-FAIL-GF-18. IX2154.2 +206700 READ IX-FD2 NEXT RECORD AT END IX2154.2 +206800 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +206900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +207000 MOVE 192 TO CORRECT-18V0 IX2154.2 +207100 GO TO START-FAIL-GF-18. IX2154.2 +207200 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +207300 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2154.2 +207400 PERFORM PASS IX2154.2 +207500 GO TO START-WRITE-GF-18. IX2154.2 +207600 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +207700 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +207800 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +207900 MOVE IX2154.2 +208000 "IX-28/-36INCORRECT KEY FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +208100 TO RE-MARK. IX2154.2 +208200 PERFORM PRINT-DETAIL. IX2154.2 +208300 MOVE "WRONG REC NUMBER FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +208400 TO RE-MARK. IX2154.2 +208500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +208600 MOVE 192 TO CORRECT-18V0. IX2154.2 +208700 START-FAIL-GF-18. IX2154.2 +208800 PERFORM FAIL. IX2154.2 +208900 GO TO START-WRITE-GF-18. IX2154.2 +209000 START-DELETE-GF-18. IX2154.2 +209100 PERFORM DE-LETE. IX2154.2 +209200 START-WRITE-GF-18. IX2154.2 +209300 PERFORM PRINT-DETAIL. IX2154.2 +209400 WRITE-WRITE-03. IX2154.2 +209500 CLOSE IX-FD2. IX2154.2 +209600 WRITE-INT-GF-03. IX2154.2 +209700 OPEN OUTPUT IX-FD3. IX2154.2 +209800 MOVE "IX-FD3" TO XFILE-NAME (1). IX2154.2 +209900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +210000 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +210100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +210200 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +210300 MOVE 242 TO XRECORD-LENGTH (1). IX2154.2 +210400 MOVE 007 TO XBLOCK-SIZE (1). IX2154.2 +210500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +210600 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +210700 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +210800 MOVE "CREATE-FILE-FD3" TO FEATURE. IX2154.2 +210900 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2154.2 +211000 MOVE ZERO TO KEYSUB. IX2154.2 +211100 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +211200 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +211300 WRITE-INIT-GF-03. IX2154.2 +211400 PERFORM WRITE-TEST-GF-03R1 50 TIMES. IX2154.2 +211500 PERFORM WRITE-TEST-GF-03R2 125 TIMES. IX2154.2 +211600 PERFORM WRITE-TEST-GF-03R1 25 TIMES. IX2154.2 +211700 GO TO WRITE-TEST-GF-03. IX2154.2 +211800 WRITE-TEST-GF-03R1. IX2154.2 +211900 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +212000 ADD 001 TO KEYSUB. IX2154.2 +212100 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +212200 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +212300 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +212400 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +212500 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +212600 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +212700 MOVE FILE-RECORD-INFO (1) TO IX-FD3R1-F-G-242. IX2154.2 +212800 WRITE IX-FD3R1-F-G-242 IX2154.2 +212900 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +213000 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +213100 WRITE-TEST-GF-03R2. IX2154.2 +213200 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +213300 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +213400 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +213500 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +213600 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +213700 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +213800 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +213900 MOVE FILE-RECORD-INFO (1) TO IX-FD3R1-F-G-242. IX2154.2 +214000 WRITE IX-FD3R1-F-G-242 IX2154.2 +214100 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +214200 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +214300 WRITE-TEST-GF-03. IX2154.2 +214400 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +214500 GIVING RECORDS-WRITTEN. IX2154.2 +214600 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +214700 PERFORM PASS IX2154.2 +214800 MOVE "FILE IX-FD3 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +214900 ELSE PERFORM FAIL IX2154.2 +215000 MOVE "IX-41;IX2154.2 +215100- "WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)" IX2154.2 +215200 TO RE-MARK IX2154.2 +215300 MOVE 200 TO CORRECT-18V0 IX2154.2 +215400 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +215500 PERFORM PRINT-DETAIL. IX2154.2 +215600 GO TO WRITE-TEST-GF-03-END. IX2154.2 +215700 WRITE-DELETE-GF-03. IX2154.2 +215800 PERFORM DE-LETE. IX2154.2 +215900 PERFORM PRINT-DETAIL. IX2154.2 +216000 WRITE-TEST-GF-03-END. IX2154.2 +216100 CLOSE IX-FD3. IX2154.2 +216200 READ-INIT-F1-O3. IX2154.2 +216300 OPEN INPUT IX-FD3. IX2154.2 +216400 MOVE "READ-TEST-F1-O3" TO PAR-NAME. IX2154.2 +216500 MOVE "READ FILE IX-FD3" TO FEATURE. IX2154.2 +216600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +216700 MOVE 02 TO RECKEY-NUM. IX2154.2 +216800 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +216900 READ-TEST-F1-O3-R1. IX2154.2 +217000 READ IX-FD3 NEXT RECORD AT END GO TO READ-TEST-F1-O3. IX2154.2 +217100 MOVE IX-FD3-RECKEY-AREA TO FDW-RECKEY-1-13. IX2154.2 +217200 MOVE IX-FD3-ALTKEY1-AREA TO FDW-ALTKEY1-1-20. IX2154.2 +217300 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +217400 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +217500 NEXT SENTENCE IX2154.2 +217600 ELSE IX2154.2 +217700 PERFORM READ-FAIL-F1-O3. IX2154.2 +217800 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +217900 GO TO READ-TEST-F1-O3. IX2154.2 +218000 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +218100 ADD 002 TO RECKEY-NUM IX2154.2 +218200 ADD 002 TO ALTKEY1-NUM. IX2154.2 +218300 GO TO READ-TEST-F1-O3-R1. IX2154.2 +218400 READ-TEST-F1-O3. IX2154.2 +218500 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-O3. IX2154.2 +218600 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +218700 PERFORM PASS IX2154.2 +218800 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +218900 ELSE PERFORM FAIL IX2154.2 +219000 MOVE IX2154.2 +219100 "IX-28 OR IX-41; INCORRECT NUMBER OF RECORDS" TO RE-MARKIX2154.2 +219200 MOVE 200 TO CORRECT-18V0 IX2154.2 +219300 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +219400 PERFORM PRINT-DETAIL. IX2154.2 +219500 GO TO READ-EXIT-F1-O3. IX2154.2 +219600 READ-FAIL-F1-O3. IX2154.2 +219700 MOVE 1 TO FAIL-SW. IX2154.2 +219800 PERFORM FAIL. IX2154.2 +219900 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +220000 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +220100 ADD 01 TO REC-CT. IX2154.2 +220200 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2154.2 +220300 PERFORM PRINT-DETAIL. IX2154.2 +220400 READ-EXIT-F1-O3. IX2154.2 +220500 CLOSE IX-FD3. IX2154.2 +220600 START-INIT-GF-19. IX2154.2 +220700 OPEN I-O IX-FD3. IX2154.2 +220800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +220900 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2154.2 +221000 MOVE "START QUAL REC-KEY" TO FEATURE. IX2154.2 +221100 MOVE "FFGGGGGGGG096" TO IX-FD3-RECKEY-AREA. IX2154.2 +221200 START-TEST-GF-19. IX2154.2 +221300 DELETE IX-FD3 INVALID KEY IX2154.2 +221400 MOVE "IX-21; INVALID KEY " TO COMPUTED-A IX2154.2 +221500 GO TO START-FAIL-GF-19. IX2154.2 +221600 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +221700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +221800 GO TO START-DELETE-GF-19. IX2154.2 +221900 MOVE "FFGGGGGGGG096" TO IX-FD3-RECKEY-AREA. IX2154.2 +222000 START IX-FD3 KEY IS EQUAL TO IX-FD3-KEY IN IX-FD3-RECKEY-AREAIX2154.2 +222100 INVALID KEY PERFORM PASS IX2154.2 +222200 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +222300 TO RE-MARK IX2154.2 +222400 GO TO START-WRITE-GF-19. IX2154.2 +222500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +222600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +222700 GO TO START-FAIL-GF-19. IX2154.2 +222800 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +222900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +223000 START-FAIL-GF-19. IX2154.2 +223100 PERFORM FAIL. IX2154.2 +223200 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +223300 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +223400 GO TO START-WRITE-GF-19. IX2154.2 +223500 START-DELETE-GF-19. IX2154.2 +223600 PERFORM DE-LETE. IX2154.2 +223700 START-WRITE-GF-19. IX2154.2 +223800 PERFORM PRINT-DETAIL. IX2154.2 +223900 START-INIT-GF-20. IX2154.2 +224000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +224100 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2154.2 +224200 MOVE "CCCCCCCCCC020" TO IX-FD3-RECKEY-AREA. IX2154.2 +224300 START-TEST-GF-20. IX2154.2 +224400 DELETE IX-FD3 INVALID KEY IX2154.2 +224500 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +224600 GO TO START-FAIL-GF-20. IX2154.2 +224700 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +224800 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +224900 GO TO START-DELETE-GF-20. IX2154.2 +225000 MOVE "CCCCCCCCCC020" TO IX-FD3-RECKEY-AREA. IX2154.2 +225100 START IX-FD3 KEY IS EQUAL TO IX-FD3-KEY IX2154.2 +225200 OF IX-FD3-RECKEY-AREA IX2154.2 +225300 INVALID KEY PERFORM PASS IX2154.2 +225400 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +225500 TO RE-MARK IX2154.2 +225600 GO TO START-WRITE-GF-20. IX2154.2 +225700 READ IX-FD3 NEXT RECORD AT END IX2154.2 +225800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +225900 GO TO START-FAIL-GF-20. IX2154.2 +226000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +226100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +226200 START-FAIL-GF-20. IX2154.2 +226300 PERFORM FAIL. IX2154.2 +226400 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +226500 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +226600 GO TO START-WRITE-GF-20. IX2154.2 +226700 START-DELETE-GF-20. IX2154.2 +226800 PERFORM DE-LETE. IX2154.2 +226900 START-WRITE-GF-20. IX2154.2 +227000 PERFORM PRINT-DETAIL. IX2154.2 +227100 START-INIT-GF-21. IX2154.2 +227200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +227300 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2154.2 +227400 MOVE "SSSSSSSSST362" TO IX-FD3-RECKEY-AREA. IX2154.2 +227500 START-TEST-GF-21. IX2154.2 +227600 DELETE IX-FD3 INVALID KEY IX2154.2 +227700 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +227800 GO TO START-FAIL-GF-21. IX2154.2 +227900 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +228000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +228100 GO TO START-DELETE-GF-21. IX2154.2 +228200 MOVE "SSSSSSSSST362" TO IX-FD3-RECKEY-AREA. IX2154.2 +228300 START IX-FD3 KEY IS EQUAL TO IX2154.2 +228400 IX-FD3-KEY IN IX2154.2 +228500 IX-FD3-RECKEY-AREA IX2154.2 +228600 INVALID KEY PERFORM PASS IX2154.2 +228700 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +228800 TO RE-MARK IX2154.2 +228900 GO TO START-WRITE-GF-21. IX2154.2 +229000 READ IX-FD3 NEXT RECORD AT END IX2154.2 +229100 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +229200 GO TO START-FAIL-GF-21. IX2154.2 +229300 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +229400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +229500 START-FAIL-GF-21. IX2154.2 +229600 PERFORM FAIL. IX2154.2 +229700 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +229800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +229900 GO TO START-WRITE-GF-21. IX2154.2 +230000 START-DELETE-GF-21. IX2154.2 +230100 PERFORM DE-LETE. IX2154.2 +230200 START-WRITE-GF-21. IX2154.2 +230300 PERFORM PRINT-DETAIL. IX2154.2 +230400 START-INIT-GF-22. IX2154.2 +230500 MOVE "START QUAL ALT-KEY-1" TO FEATURE. IX2154.2 +230600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +230700 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2154.2 +230800 MOVE "EEEEEEEEFF064" TO IX-FD3-RECKEY-AREA. IX2154.2 +230900 START-TEST-GF-22. IX2154.2 +231000 READ IX-FD3 IX2154.2 +231100 INVALID KEY PERFORM FAIL IX2154.2 +231200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +231300 TO RE-MARK IX2154.2 +231400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +231500 GO TO START-FAIL-GF-22. IX2154.2 +231600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +231700 IF XRECORD-NUMBER (3) NOT EQUAL TO 32 IX2154.2 +231800 MOVE 32 TO RECNO IX2154.2 +231900 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +232000 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +232100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +232200 GO TO START-FAIL-GF-22. IX2154.2 +232300 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +232400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +232500 GO TO START-DELETE-GF-22. IX2154.2 +232600 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +232700 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +232800 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +232900 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +233000 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +233100 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +233200 GO TO START-FAIL-GF-22. IX2154.2 +233300 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +233400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +233500 GO TO START-FAIL-GF-22. IX2154.2 +233600 MOVE "EEEEEEEEEE000ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +233700 START IX-FD3 IX2154.2 +233800 KEY IS EQUAL TO IX-FD3-KEY OF IX2154.2 +233900 IX-FD3-ALTKEY1-AREA IX2154.2 +234000 INVALID KEY IX2154.2 +234100 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +234200 TO RE-MARK IX2154.2 +234300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +234400 GO TO START-FAIL-GF-22. IX2154.2 +234500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +234600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +234700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +234800 GO TO START-FAIL-GF-22. IX2154.2 +234900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +235000 IF XRECORD-NUMBER (1) EQUAL TO 32 IX2154.2 +235100 PERFORM PASS IX2154.2 +235200 GO TO START-WRITE-GF-22. IX2154.2 +235300 PERFORM FAIL. IX2154.2 +235400 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +235500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +235600 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +235700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +235800 PERFORM PRINT-DETAIL. IX2154.2 +235900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +236000 TO RE-MARK. IX2154.2 +236100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +236200 START-FAIL-GF-22. IX2154.2 +236300 PERFORM FAIL. IX2154.2 +236400 MOVE 32 TO CORRECT-18V0. IX2154.2 +236500 GO TO START-WRITE-GF-22. IX2154.2 +236600 START-DELETE-GF-22. IX2154.2 +236700 PERFORM DE-LETE. IX2154.2 +236800 START-WRITE-GF-22. IX2154.2 +236900 PERFORM PRINT-DETAIL. IX2154.2 +237000 START-INIT-GF-23. IX2154.2 +237100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +237200 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2154.2 +237300 MOVE "BBBBBBBCCC006" TO IX-FD3-RECKEY-AREA. IX2154.2 +237400 START-TEST-GF-23. IX2154.2 +237500 READ IX-FD3 IX2154.2 +237600 INVALID KEY IX2154.2 +237700 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +237800 TO RE-MARK IX2154.2 +237900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +238000 GO TO START-FAIL-GF-23. IX2154.2 +238100 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +238200 IF XRECORD-NUMBER (3) NOT EQUAL TO 3 IX2154.2 +238300 MOVE 3 TO RECNO IX2154.2 +238400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +238500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +238600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +238700 GO TO START-FAIL-GF-23. IX2154.2 +238800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +238900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +239000 GO TO START-DELETE-GF-23. IX2154.2 +239100 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +239200 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +239300 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +239400 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +239500 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +239600 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +239700 GO TO START-FAIL-GF-23. IX2154.2 +239800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +239900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +240000 GO TO START-FAIL-GF-23. IX2154.2 +240100 MOVE "AAAAAAAAAA400ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +240200 START IX-FD3 IX2154.2 +240300 KEY IS EQUAL TO IX2154.2 +240400 IX-FD3-KEY IX2154.2 +240500 IN IX-FD3-ALTKEY1-AREA IX2154.2 +240600 INVALID KEY IX2154.2 +240700 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +240800 TO RE-MARK IX2154.2 +240900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +241000 GO TO START-FAIL-GF-23. IX2154.2 +241100 READ IX-FD3 NEXT RECORD AT END IX2154.2 +241200 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +241300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +241400 GO TO START-FAIL-GF-23. IX2154.2 +241500 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +241600 IF XRECORD-NUMBER (1) EQUAL TO 3 IX2154.2 +241700 PERFORM PASS IX2154.2 +241800 GO TO START-WRITE-GF-23. IX2154.2 +241900 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +242000 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +242100 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +242200 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +242300 PERFORM PRINT-DETAIL. IX2154.2 +242400 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +242500 TO RE-MARK. IX2154.2 +242600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +242700 START-FAIL-GF-23. IX2154.2 +242800 PERFORM FAIL. IX2154.2 +242900 MOVE 3 TO CORRECT-18V0. IX2154.2 +243000 GO TO START-WRITE-GF-23. IX2154.2 +243100 START-DELETE-GF-23. IX2154.2 +243200 PERFORM DE-LETE. IX2154.2 +243300 START-WRITE-GF-23. IX2154.2 +243400 PERFORM PRINT-DETAIL. IX2154.2 +243500 START-INIT-GF-24. IX2154.2 +243600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +243700 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2154.2 +243800 MOVE "SSSSSSSSSS360" TO IX-FD3-RECKEY-AREA. IX2154.2 +243900 START-TEST-GF-24. IX2154.2 +244000 READ IX-FD3 IX2154.2 +244100 INVALID KEY IX2154.2 +244200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +244300 TO RE-MARK IX2154.2 +244400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +244500 GO TO START-FAIL-GF-24. IX2154.2 +244600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +244700 IF XRECORD-NUMBER (3) NOT EQUAL TO 180 IX2154.2 +244800 MOVE 55 TO RECNO IX2154.2 +244900 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +245000 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +245100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +245200 GO TO START-FAIL-GF-24. IX2154.2 +245300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +245400 GO TO START-DELETE-GF-24. IX2154.2 +245500 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +245600 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +245700 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +245800 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +245900 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +246000 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +246100 GO TO START-FAIL-GF-24. IX2154.2 +246200 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +246300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +246400 GO TO START-FAIL-GF-24. IX2154.2 +246500 MOVE "AAGGGGGGGG100ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +246600 START IX-FD3 IX2154.2 +246700 KEY IS EQUAL TO IX2154.2 +246800 IX-FD3-KEY IX2154.2 +246900 OF IX-FD3-ALTKEY1-AREA IX2154.2 +247000 INVALID KEY PERFORM FAIL IX2154.2 +247100 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +247200 TO RE-MARK IX2154.2 +247300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +247400 GO TO START-FAIL-GF-24. IX2154.2 +247500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +247600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +247700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +247800 GO TO START-FAIL-GF-24. IX2154.2 +247900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +248000 IF XRECORD-NUMBER (1) EQUAL TO 180 IX2154.2 +248100 PERFORM PASS IX2154.2 +248200 GO TO START-WRITE-GF-24. IX2154.2 +248300 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +248400 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +248500 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +248600 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +248700 PERFORM PRINT-DETAIL. IX2154.2 +248800 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +248900 TO RE-MARK. IX2154.2 +249000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +249100 START-FAIL-GF-24. IX2154.2 +249200 PERFORM FAIL. IX2154.2 +249300 MOVE 180 TO CORRECT-18V0. IX2154.2 +249400 GO TO START-WRITE-GF-24. IX2154.2 +249500 START-DELETE-GF-24. IX2154.2 +249600 PERFORM DE-LETE. IX2154.2 +249700 START-WRITE-GF-24. IX2154.2 +249800 PERFORM PRINT-DETAIL. IX2154.2 +249900 START-INIT-GF-25. IX2154.2 +250000 MOVE "START QUAL ALT-KEY-2" TO FEATURE. IX2154.2 +250100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +250200 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2154.2 +250300 MOVE "CCCCCDDDDD030" TO IX-FD3-RECKEY-AREA. IX2154.2 +250400 START-TEST-GF-25. IX2154.2 +250500 READ IX-FD3 IX2154.2 +250600 INVALID KEY IX2154.2 +250700 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +250800 TO RE-MARK IX2154.2 +250900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +251000 GO TO START-FAIL-GF-25. IX2154.2 +251100 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +251200 IF XRECORD-NUMBER (3) NOT EQUAL TO 15 IX2154.2 +251300 MOVE 15 TO RECNO IX2154.2 +251400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +251500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +251600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +251700 GO TO START-FAIL-GF-25. IX2154.2 +251800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +251900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +252000 GO TO START-DELETE-GF-25. IX2154.2 +252100 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +252200 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +252300 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +252400 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +252500 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +252600 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +252700 GO TO START-FAIL-GF-25. IX2154.2 +252800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +252900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +253000 GO TO START-FAIL-GF-25. IX2154.2 +253100 MOVE "CBCBCBCBCB100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +253200 START IX-FD3 IX2154.2 +253300 KEY IS EQUAL TO IX2154.2 +253400 IX-FD3-KEY IX2154.2 +253500 IN IX2154.2 +253600 IX-FD3-ALTKEY2-AREA IX2154.2 +253700 INVALID KEY IX2154.2 +253800 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +253900 TO RE-MARK IX2154.2 +254000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +254100 GO TO START-FAIL-GF-25. IX2154.2 +254200 READ IX-FD3 NEXT RECORD AT END IX2154.2 +254300 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +254400 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +254500 GO TO START-FAIL-GF-25. IX2154.2 +254600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +254700 IF XRECORD-NUMBER (1) EQUAL TO 15 IX2154.2 +254800 PERFORM PASS IX2154.2 +254900 GO TO START-WRITE-GF-25. IX2154.2 +255000 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +255100 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +255200 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +255300 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +255400 PERFORM PRINT-DETAIL. IX2154.2 +255500 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +255600 TO RE-MARK. IX2154.2 +255700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +255800 START-FAIL-GF-25. IX2154.2 +255900 PERFORM FAIL. IX2154.2 +256000 MOVE 15 TO CORRECT-18V0. IX2154.2 +256100 GO TO START-WRITE-GF-25. IX2154.2 +256200 START-DELETE-GF-25. IX2154.2 +256300 PERFORM DE-LETE. IX2154.2 +256400 START-WRITE-GF-25. IX2154.2 +256500 PERFORM PRINT-DETAIL. IX2154.2 +256600 START-INIT-GF-26. IX2154.2 +256700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +256800 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2154.2 +256900 MOVE "TTTTTTTTTT380" TO IX-FD3-RECKEY-AREA. IX2154.2 +257000 START-TEST-GF-26. IX2154.2 +257100 READ IX-FD3 IX2154.2 +257200 INVALID KEY IX2154.2 +257300 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +257400 TO RE-MARK IX2154.2 +257500 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +257600 GO TO START-FAIL-GF-26. IX2154.2 +257700 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +257800 IF XRECORD-NUMBER (3) NOT EQUAL TO 190 IX2154.2 +257900 MOVE 65 TO RECNO IX2154.2 +258000 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +258100 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +258200 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +258300 GO TO START-FAIL-GF-26. IX2154.2 +258400 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +258500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +258600 GO TO START-DELETE-GF-26. IX2154.2 +258700 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +258800 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +258900 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +259000 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +259100 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +259200 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +259300 GO TO START-FAIL-GF-26. IX2154.2 +259400 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +259500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +259600 GO TO START-FAIL-GF-26. IX2154.2 +259700 MOVE "DCDCDCDCDC100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +259800 START IX-FD3 IX2154.2 +259900 KEY IS EQUAL TO IX2154.2 +260000 IX-FD3-KEY OF IX-FD3-ALTKEY2-AREA IX2154.2 +260100 INVALID KEY IX2154.2 +260200 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +260300 TO RE-MARK IX2154.2 +260400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +260500 GO TO START-FAIL-GF-26. IX2154.2 +260600 READ IX-FD3 NEXT RECORD AT END IX2154.2 +260700 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +260800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +260900 GO TO START-FAIL-GF-26. IX2154.2 +261000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +261100 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2154.2 +261200 PERFORM PASS IX2154.2 +261300 GO TO START-WRITE-GF-26. IX2154.2 +261400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +261500 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +261600 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +261700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +261800 PERFORM PRINT-DETAIL. IX2154.2 +261900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +262000 TO RE-MARK. IX2154.2 +262100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +262200 START-FAIL-GF-26. IX2154.2 +262300 PERFORM FAIL. IX2154.2 +262400 MOVE 190 TO CORRECT-18V0. IX2154.2 +262500 GO TO START-WRITE-GF-26. IX2154.2 +262600 START-DELETE-GF-26. IX2154.2 +262700 PERFORM DE-LETE. IX2154.2 +262800 START-WRITE-GF-26. IX2154.2 +262900 PERFORM PRINT-DETAIL. IX2154.2 +263000 START-INIT-GF-27. IX2154.2 +263100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +263200 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2154.2 +263300 MOVE "CCCCCCCCDD024" TO IX-FD3-RECKEY-AREA. IX2154.2 +263400 START-TEST-GF-27. IX2154.2 +263500 READ IX-FD3 IX2154.2 +263600 INVALID KEY IX2154.2 +263700 MOVE "IX-28,F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +263800 TO RE-MARK IX2154.2 +263900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +264000 MOVE 12 TO CORRECT-18V0 IX2154.2 +264100 GO TO START-FAIL-GF-27. IX2154.2 +264200 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +264300 IF XRECORD-NUMBER (3) NOT EQUAL TO 12 IX2154.2 +264400 MOVE 12 TO RECNO IX2154.2 +264500 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +264600 MOVE "IX-28,F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +264700 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +264800 MOVE 4 TO CORRECT-18V0 IX2154.2 +264900 GO TO START-FAIL-GF-27. IX2154.2 +265000 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +265100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +265200 GO TO START-DELETE-GF-27. IX2154.2 +265300 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +265400 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +265500 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +265600 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +265700 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +265800 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +265900 MOVE 12 TO CORRECT-18V0 IX2154.2 +266000 GO TO START-FAIL-GF-27. IX2154.2 +266100 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +266200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +266300 GO TO START-FAIL-GF-27. IX2154.2 +266400 MOVE "DCDCDCDCDC100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +266500 START IX-FD3 IX2154.2 +266600 KEY IS EQUAL TO IX-FD3-KEY IX2154.2 +266700 IN IX2154.2 +266800 IX-FD3-ALTKEY2-AREA IX2154.2 +266900 INVALID KEY IX2154.2 +267000 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +267100 TO RE-MARK IX2154.2 +267200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +267300 MOVE 190 TO CORRECT-18V0 IX2154.2 +267400 GO TO START-FAIL-GF-27. IX2154.2 +267500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +267600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +267700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +267800 MOVE 190 TO CORRECT-18V0 IX2154.2 +267900 GO TO START-FAIL-GF-27. IX2154.2 +268000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +268100 IF XRECORD-NUMBER (1) NOT EQUAL TO 190 IX2154.2 +268200 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +268300 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +268400 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +268500 MOVE IX2154.2 +268600 "IX-28 OR IX-36; INCORR KEY FOUND ON FIRST READ DUPL KEYS" IX2154.2 +268700 TO RE-MARK IX2154.2 +268800 PERFORM PRINT-DETAIL IX2154.2 +268900 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +269000 TO RE-MARK IX2154.2 +269100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +269200 MOVE 190 TO CORRECT-18V0 IX2154.2 +269300 GO TO START-FAIL-GF-27. IX2154.2 +269400 READ IX-FD3 NEXT RECORD AT END IX2154.2 +269500 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +269600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +269700 MOVE 12 TO CORRECT-18V0 IX2154.2 +269800 GO TO START-FAIL-GF-27. IX2154.2 +269900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +270000 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2154.2 +270100 PERFORM PASS IX2154.2 +270200 GO TO START-WRITE-GF-27. IX2154.2 +270300 PERFORM FAIL. IX2154.2 +270400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +270500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +270600 MOVE IX2154.2 +270700 "IX-28 OR IX-36; INCORR KEY FOUND ON SECOND READ DUPL KEYS" IX2154.2 +270800 TO RE-MARK. IX2154.2 +270900 PERFORM PRINT-DETAIL. IX2154.2 +271000 MOVE "WRONG REC NUMBER FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +271100 TO RE-MARK. IX2154.2 +271200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +271300 MOVE 12 TO CORRECT-18V0. IX2154.2 +271400 START-FAIL-GF-27. IX2154.2 +271500 PERFORM FAIL. IX2154.2 +271600 GO TO START-WRITE-GF-27. IX2154.2 +271700 START-DELETE-GF-27. IX2154.2 +271800 PERFORM DE-LETE. IX2154.2 +271900 START-WRITE-GF-27. IX2154.2 +272000 PERFORM PRINT-DETAIL. IX2154.2 +272100 START-TERM-GF. IX2154.2 +272200 CLOSE IX-FD3. IX2154.2 +272300 START-TEST-FINISH. IX2154.2 +272400 GO TO START-TEST-COMPLETE. IX2154.2 +272500 START-INIT-FD1. IX2154.2 +272600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +272700 MOVE ZERO TO INIT-FLAG. IX2154.2 +272800 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +272900 MOVE SPACE TO IX-FD1R1-F-G-240. IX2154.2 +273000 MOVE "GGGGGGGGGG200" TO FDW-RECKEY-1-13. IX2154.2 +273100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +273200 START IX-FD1 KEY IS EQUAL TO IX-FD1-KEY INVALID KEY IX2154.2 +273300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +273400 GO TO START-INIT-FD1-ERROR. IX2154.2 +273500 READ IX-FD1 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +273600 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +273700 GO TO START-INIT-FD1-ERROR. IX2154.2 +273800 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +273900 GO TO START-INIT-FD1-EXIT. IX2154.2 +274000 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +274100 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +274200 START-INIT-FD1-ERROR. IX2154.2 +274300 MOVE 1 TO INIT-FLAG. IX2154.2 +274400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +274500 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +274600 PERFORM PRINT-DETAIL. IX2154.2 +274700 START-INIT-FD1-EXIT. IX2154.2 +274800 EXIT. IX2154.2 +274900 START-INIT-FD2. IX2154.2 +275000 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +275100 MOVE ZERO TO INIT-FLAG. IX2154.2 +275200 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +275300 MOVE SPACE TO IX-FD2R1-F-G-241. IX2154.2 +275400 MOVE "GGGGGGGGGG200" TO IX-FD2-KEY. IX2154.2 +275500 START IX-FD2 KEY IS EQUAL TO IX-FD2-KEY INVALID KEY IX2154.2 +275600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +275700 GO TO START-INIT-FD2-ERROR. IX2154.2 +275800 READ IX-FD2 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +275900 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +276000 GO TO START-INIT-FD2-ERROR. IX2154.2 +276100 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +276200 GO TO START-INIT-FD2-EXIT. IX2154.2 +276300 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +276400 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +276500 START-INIT-FD2-ERROR. IX2154.2 +276600 MOVE 1 TO INIT-FLAG. IX2154.2 +276700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +276800 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +276900 PERFORM PRINT-DETAIL. IX2154.2 +277000 START-INIT-FD2-EXIT. IX2154.2 +277100 EXIT. IX2154.2 +277200 START-INIT-FD3. IX2154.2 +277300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +277400 MOVE ZERO TO INIT-FLAG. IX2154.2 +277500 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +277600 MOVE SPACE TO IX-FD3R1-F-G-242. IX2154.2 +277700 MOVE "GGGGGGGGGG200" TO IX-FD3-RECKEY-AREA. IX2154.2 +277800 START IX-FD3 IX2154.2 +277900 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-AIX2154.2 +278000 GO TO START-INIT-FD3-ERROR. IX2154.2 +278100 READ IX-FD3 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +278200 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +278300 GO TO START-INIT-FD3-ERROR. IX2154.2 +278400 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +278500 GO TO START-INIT-FD3-EXIT. IX2154.2 +278600 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +278700 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +278800 START-INIT-FD3-ERROR. IX2154.2 +278900 MOVE 1 TO INIT-FLAG. IX2154.2 +279000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +279100 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +279200 PERFORM PRINT-DETAIL. IX2154.2 +279300 START-INIT-FD3-EXIT. IX2154.2 +279400 EXIT. IX2154.2 +279500 DISPLAY-RECORD-KEYS. IX2154.2 +279600 MOVE XRECORD-KEY (3) TO WRK-FDW-RECKEY. IX2154.2 +279700 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +279800 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2154.2 +279900 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2154.2 +280000 PERFORM PRINT-DETAIL. IX2154.2 +280100 START-TEST-COMPLETE. IX2154.2 +280200 EXIT. IX2154.2 +280300 CCVS-EXIT SECTION. IX2154.2 +280400 CCVS-999999. IX2154.2 +280500 GO TO CLOSE-FILES. IX2154.2 +*END-OF,IX215A +*HEADER,COBOL,IX216A +000100 IDENTIFICATION DIVISION. IX2164.2 +000200 PROGRAM-ID. IX2164.2 +000300 IX216A. IX2164.2 +000400**************************************************************** IX2164.2 +000500* * IX2164.2 +000600* VALIDATION FOR:- * IX2164.2 +000700* * IX2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +000900* * IX2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2164.2 +001100* * IX2164.2 +001200**************************************************************** IX2164.2 +001300* IX2164.2 +001400* NEW TESTS: IX2164.2 +001500* IX2164.2 +001600* SELECT OPTIONAL ... WITH IX2164.2 +001700* -------- IX2164.2 +001800* OPEN EXTEND ... (FOR A NON-EXISTING FILE) IX2164.2 +001900* ------ ------------ IX2164.2 +002000* THEN THE FILE IS CLOSED AFTER WRITING 300 RECORDS IX2164.2 +002100* AND OPENED WITH: IX2164.2 +002200* IX2164.2 +002300* OPEN EXTEND ... (FOR AN EXISTING FILE) IX2164.2 +002400* ------ -------- IX2164.2 +002500* AND CLOSE IX-FS2 LOCK. IX2164.2 +002600* ---- IX2164.2 +002700* IX2164.2 +002800* ALL OTHER TESTS ARE IDENTICAL WITH THE TESTS IN IX104. IX2164.2 +002900* IX2164.2 +003000* IX2164.2 +003100* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX2164.2 +003200* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX2164.2 +003300* IX2164.2 +003400* (1) FILE STATUS IX2164.2 +003500* (2) USE AFTER EXCEPTION USING FILE-NAME IX2164.2 +003600* (3) READ IX2164.2 +003700* (4) WRITE IX2164.2 +003800* (5) REWRITE IX2164.2 +003900* (6) RECORD KEY IX2164.2 +004000* (7) ACCESS IX2164.2 +004100* IX2164.2 +004200* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX2164.2 +004300* MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RECORDS OF THE IX2164.2 +004400* FILE. THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR IX2164.2 +004500* ACCURACY FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT IX2164.2 +004600* USED. THE READ, WRITE AND REWRITE STATEMENTS ARE USED IX2164.2 +004700* WITHOUT THE APPROPRIATE AT END OR INVALID KEY PHRASES. THE IX2164.2 +004800* OMISSION OF THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE IX2164.2 +004900* PROCEDURE HAS BEEN SPECIFIED. IX2164.2 +005000* IX2164.2 +005100* IX2164.2 +005200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2164.2 +005300* IX2164.2 +005400* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2164.2 +005500* CLAUSE FOR DATA FILE IX-FD2 IX2164.2 +005600* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2164.2 +005700* CLAUSE FOR INDEX FILE IX-FD2 IX2164.2 +005800* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2164.2 +005900* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX2164.2 +006000* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2164.2 +006100* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2164.2 +006200* IX2164.2 +006300* NOTE: X-CARDS 45 AND 62 ARE OPTIONAL IX2164.2 +006400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2164.2 +006500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2164.2 +006600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2164.2 +006700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2164.2 +006800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2164.2 +006900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2164.2 +007000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2164.2 +007100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2164.2 +007200* THEY ARE AS FOLLOWS IX2164.2 +007300* IX2164.2 +007400* J SELECTS X-CARD 45 IX2164.2 +007500* P SELECTS X-CARD 62 IX2164.2 +007600* IX2164.2 +007700****************************************************** IX2164.2 +007800 ENVIRONMENT DIVISION. IX2164.2 +007900 CONFIGURATION SECTION. IX2164.2 +008000 SOURCE-COMPUTER. IX2164.2 +008100 XXXXX082. IX2164.2 +008200 OBJECT-COMPUTER. IX2164.2 +008300 XXXXX083. IX2164.2 +008400 INPUT-OUTPUT SECTION. IX2164.2 +008500 FILE-CONTROL. IX2164.2 +008600P SELECT RAW-DATA ASSIGN TO IX2164.2 +008700P XXXXX062 IX2164.2 +008800P ORGANIZATION IS INDEXED IX2164.2 +008900P ACCESS MODE IS RANDOM IX2164.2 +009000P RECORD KEY IS RAW-DATA-KEY. IX2164.2 +009100 SELECT PRINT-FILE ASSIGN TO IX2164.2 +009200 XXXXX055. IX2164.2 +009300 SELECT OPTIONAL IX-FS2 ASSIGN IX2164.2 +009400 XXXXX025 IX2164.2 +009500J XXXXX045 IX2164.2 +009600 ORGANIZATION IS INDEXED IX2164.2 +009700 ACCESS SEQUENTIAL IX2164.2 +009800 FILE STATUS IS IX-FS2-STATUS IX2164.2 +009900 RECORD IX-FS2-KEY. IX2164.2 +010000 DATA DIVISION. IX2164.2 +010100 FILE SECTION. IX2164.2 +010200P IX2164.2 +010300PFD RAW-DATA. IX2164.2 +010400P IX2164.2 +010500P01 RAW-DATA-SATZ. IX2164.2 +010600P 05 RAW-DATA-KEY PIC X(6). IX2164.2 +010700P 05 C-DATE PIC 9(6). IX2164.2 +010800P 05 C-TIME PIC 9(8). IX2164.2 +010900P 05 C-NO-OF-TESTS PIC 99. IX2164.2 +011000P 05 C-OK PIC 999. IX2164.2 +011100P 05 C-ALL PIC 999. IX2164.2 +011200P 05 C-FAIL PIC 999. IX2164.2 +011300P 05 C-DELETED PIC 999. IX2164.2 +011400P 05 C-INSPECT PIC 999. IX2164.2 +011500P 05 C-NOTE PIC X(13). IX2164.2 +011600P 05 C-INDENT PIC X. IX2164.2 +011700P 05 C-ABORT PIC X(8). IX2164.2 +011800 FD PRINT-FILE. IX2164.2 +011900 01 PRINT-REC PICTURE X(120). IX2164.2 +012000 01 DUMMY-RECORD PICTURE X(120). IX2164.2 +012100 FD IX-FS2 IX2164.2 +012200C LABEL RECORDS ARE STANDARD IX2164.2 +012300C DATA RECORDS IX-FS2R1-F-G-240 IX2164.2 +012400 BLOCK CONTAINS 480 IX2164.2 +012500 RECORD CONTAINS 240 CHARACTERS. IX2164.2 +012600 01 IX-FS2R1-F-G-240. IX2164.2 +012700 05 IX-FS2-REC-120 PIC X(120). IX2164.2 +012800 05 IX-FS2-REC-120-240. IX2164.2 +012900 10 FILLER PICTURE X(8). IX2164.2 +013000 10 IX-FS2-KEY PIC X(29). IX2164.2 +013100 10 FILLER PIC X(83). IX2164.2 +013200 WORKING-STORAGE SECTION. IX2164.2 +013300 01 GRP-0101. IX2164.2 +013400 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX2164.2 +013500 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2164.2 +013600 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX2164.2 +013700 01 GRP-0001. IX2164.2 +013800 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +013900 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014000 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014100 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014200 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014300 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014400 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014500 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX2164.2 +014600 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX2164.2 +014700 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX2164.2 +014800 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX2164.2 +014900 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX2164.2 +015000 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX2164.2 +015100 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX2164.2 +015200 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX2164.2 +015300 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX2164.2 +015400 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX2164.2 +015500 01 DUMMY-WRK-REC. IX2164.2 +015600 02 DUMMY-WRK1 PIC X(120). IX2164.2 +015700 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2164.2 +015800 03 FILLER PIC X(5). IX2164.2 +015900 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2164.2 +016000 01 FILE-RECORD-INFORMATION-REC. IX2164.2 +016100 03 FILE-RECORD-INFO-SKELETON. IX2164.2 +016200 05 FILLER PICTURE X(48) VALUE IX2164.2 +016300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2164.2 +016400 05 FILLER PICTURE X(46) VALUE IX2164.2 +016500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2164.2 +016600 05 FILLER PICTURE X(26) VALUE IX2164.2 +016700 ",LFIL=000000,ORG= ,LBLR= ". IX2164.2 +016800 05 FILLER PICTURE X(37) VALUE IX2164.2 +016900 ",RECKEY= ". IX2164.2 +017000 05 FILLER PICTURE X(38) VALUE IX2164.2 +017100 ",ALTKEY1= ". IX2164.2 +017200 05 FILLER PICTURE X(38) VALUE IX2164.2 +017300 ",ALTKEY2= ". IX2164.2 +017400 05 FILLER PICTURE X(7) VALUE SPACE.IX2164.2 +017500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2164.2 +017600 05 FILE-RECORD-INFO-P1-120. IX2164.2 +017700 07 FILLER PIC X(5). IX2164.2 +017800 07 XFILE-NAME PIC X(6). IX2164.2 +017900 07 FILLER PIC X(8). IX2164.2 +018000 07 XRECORD-NAME PIC X(6). IX2164.2 +018100 07 FILLER PIC X(1). IX2164.2 +018200 07 REELUNIT-NUMBER PIC 9(1). IX2164.2 +018300 07 FILLER PIC X(7). IX2164.2 +018400 07 XRECORD-NUMBER PIC 9(6). IX2164.2 +018500 07 FILLER PIC X(6). IX2164.2 +018600 07 UPDATE-NUMBER PIC 9(2). IX2164.2 +018700 07 FILLER PIC X(5). IX2164.2 +018800 07 ODO-NUMBER PIC 9(4). IX2164.2 +018900 07 FILLER PIC X(5). IX2164.2 +019000 07 XPROGRAM-NAME PIC X(5). IX2164.2 +019100 07 FILLER PIC X(7). IX2164.2 +019200 07 XRECORD-LENGTH PIC 9(6). IX2164.2 +019300 07 FILLER PIC X(7). IX2164.2 +019400 07 CHARS-OR-RECORDS PIC X(2). IX2164.2 +019500 07 FILLER PIC X(1). IX2164.2 +019600 07 XBLOCK-SIZE PIC 9(4). IX2164.2 +019700 07 FILLER PIC X(6). IX2164.2 +019800 07 RECORDS-IN-FILE PIC 9(6). IX2164.2 +019900 07 FILLER PIC X(5). IX2164.2 +020000 07 XFILE-ORGANIZATION PIC X(2). IX2164.2 +020100 07 FILLER PIC X(6). IX2164.2 +020200 07 XLABEL-TYPE PIC X(1). IX2164.2 +020300 05 FILE-RECORD-INFO-P121-240. IX2164.2 +020400 07 FILLER PIC X(8). IX2164.2 +020500 07 XRECORD-KEY PIC X(29). IX2164.2 +020600 07 FILLER PIC X(9). IX2164.2 +020700 07 ALTERNATE-KEY1 PIC X(29). IX2164.2 +020800 07 FILLER PIC X(9). IX2164.2 +020900 07 ALTERNATE-KEY2 PIC X(29). IX2164.2 +021000 07 FILLER PIC X(7). IX2164.2 +021100 01 TEST-RESULTS. IX2164.2 +021200 02 FILLER PIC X VALUE SPACE. IX2164.2 +021300 02 FEATURE PIC X(20) VALUE SPACE. IX2164.2 +021400 02 FILLER PIC X VALUE SPACE. IX2164.2 +021500 02 P-OR-F PIC X(5) VALUE SPACE. IX2164.2 +021600 02 FILLER PIC X VALUE SPACE. IX2164.2 +021700 02 PAR-NAME. IX2164.2 +021800 03 FILLER PIC X(19) VALUE SPACE. IX2164.2 +021900 03 PARDOT-X PIC X VALUE SPACE. IX2164.2 +022000 03 DOTVALUE PIC 99 VALUE ZERO. IX2164.2 +022100 02 FILLER PIC X(8) VALUE SPACE. IX2164.2 +022200 02 RE-MARK PIC X(61). IX2164.2 +022300 01 TEST-COMPUTED. IX2164.2 +022400 02 FILLER PIC X(30) VALUE SPACE. IX2164.2 +022500 02 FILLER PIC X(17) VALUE IX2164.2 +022600 " COMPUTED=". IX2164.2 +022700 02 COMPUTED-X. IX2164.2 +022800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2164.2 +022900 03 COMPUTED-N REDEFINES COMPUTED-A IX2164.2 +023000 PIC -9(9).9(9). IX2164.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2164.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2164.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2164.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. IX2164.2 +023500 04 COMPUTED-18V0 PIC -9(18). IX2164.2 +023600 04 FILLER PIC X. IX2164.2 +023700 03 FILLER PIC X(50) VALUE SPACE. IX2164.2 +023800 01 TEST-CORRECT. IX2164.2 +023900 02 FILLER PIC X(30) VALUE SPACE. IX2164.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2164.2 +024100 02 CORRECT-X. IX2164.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2164.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2164.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2164.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2164.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2164.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. IX2164.2 +024800 04 CORRECT-18V0 PIC -9(18). IX2164.2 +024900 04 FILLER PIC X. IX2164.2 +025000 03 FILLER PIC X(2) VALUE SPACE. IX2164.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2164.2 +025200 01 CCVS-C-1. IX2164.2 +025300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2164.2 +025400- "SS PARAGRAPH-NAME IX2164.2 +025500- " REMARKS". IX2164.2 +025600 02 FILLER PIC X(20) VALUE SPACE. IX2164.2 +025700 01 CCVS-C-2. IX2164.2 +025800 02 FILLER PIC X VALUE SPACE. IX2164.2 +025900 02 FILLER PIC X(6) VALUE "TESTED". IX2164.2 +026000 02 FILLER PIC X(15) VALUE SPACE. IX2164.2 +026100 02 FILLER PIC X(4) VALUE "FAIL". IX2164.2 +026200 02 FILLER PIC X(94) VALUE SPACE. IX2164.2 +026300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2164.2 +026400 01 REC-CT PIC 99 VALUE ZERO. IX2164.2 +026500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2164.2 +027000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2164.2 +027100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2164.2 +027200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2164.2 +027300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2164.2 +027400 01 CCVS-H-1. IX2164.2 +027500 02 FILLER PIC X(39) VALUE SPACES. IX2164.2 +027600 02 FILLER PIC X(42) VALUE IX2164.2 +027700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2164.2 +027800 02 FILLER PIC X(39) VALUE SPACES. IX2164.2 +027900 01 CCVS-H-2A. IX2164.2 +028000 02 FILLER PIC X(40) VALUE SPACE. IX2164.2 +028100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2164.2 +028200 02 FILLER PIC XXXX VALUE IX2164.2 +028300 "4.2 ". IX2164.2 +028400 02 FILLER PIC X(28) VALUE IX2164.2 +028500 " COPY - NOT FOR DISTRIBUTION". IX2164.2 +028600 02 FILLER PIC X(41) VALUE SPACE. IX2164.2 +028700 IX2164.2 +028800 01 CCVS-H-2B. IX2164.2 +028900 02 FILLER PIC X(15) VALUE IX2164.2 +029000 "TEST RESULT OF ". IX2164.2 +029100 02 TEST-ID PIC X(9). IX2164.2 +029200 02 FILLER PIC X(4) VALUE IX2164.2 +029300 " IN ". IX2164.2 +029400 02 FILLER PIC X(12) VALUE IX2164.2 +029500 " HIGH ". IX2164.2 +029600 02 FILLER PIC X(22) VALUE IX2164.2 +029700 " LEVEL VALIDATION FOR ". IX2164.2 +029800 02 FILLER PIC X(58) VALUE IX2164.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +030000 01 CCVS-H-3. IX2164.2 +030100 02 FILLER PIC X(34) VALUE IX2164.2 +030200 " FOR OFFICIAL USE ONLY ". IX2164.2 +030300 02 FILLER PIC X(58) VALUE IX2164.2 +030400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2164.2 +030500 02 FILLER PIC X(28) VALUE IX2164.2 +030600 " COPYRIGHT 1985 ". IX2164.2 +030700 01 CCVS-E-1. IX2164.2 +030800 02 FILLER PIC X(52) VALUE SPACE. IX2164.2 +030900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2164.2 +031000 02 ID-AGAIN PIC X(9). IX2164.2 +031100 02 FILLER PIC X(45) VALUE SPACES. IX2164.2 +031200 01 CCVS-E-2. IX2164.2 +031300 02 FILLER PIC X(31) VALUE SPACE. IX2164.2 +031400 02 FILLER PIC X(21) VALUE SPACE. IX2164.2 +031500 02 CCVS-E-2-2. IX2164.2 +031600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2164.2 +031700 03 FILLER PIC X VALUE SPACE. IX2164.2 +031800 03 ENDER-DESC PIC X(44) VALUE IX2164.2 +031900 "ERRORS ENCOUNTERED". IX2164.2 +032000 01 CCVS-E-3. IX2164.2 +032100 02 FILLER PIC X(22) VALUE IX2164.2 +032200 " FOR OFFICIAL USE ONLY". IX2164.2 +032300 02 FILLER PIC X(12) VALUE SPACE. IX2164.2 +032400 02 FILLER PIC X(58) VALUE IX2164.2 +032500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +032600 02 FILLER PIC X(13) VALUE SPACE. IX2164.2 +032700 02 FILLER PIC X(15) VALUE IX2164.2 +032800 " COPYRIGHT 1985". IX2164.2 +032900 01 CCVS-E-4. IX2164.2 +033000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2164.2 +033100 02 FILLER PIC X(4) VALUE " OF ". IX2164.2 +033200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2164.2 +033300 02 FILLER PIC X(40) VALUE IX2164.2 +033400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2164.2 +033500 01 XXINFO. IX2164.2 +033600 02 FILLER PIC X(19) VALUE IX2164.2 +033700 "*** INFORMATION ***". IX2164.2 +033800 02 INFO-TEXT. IX2164.2 +033900 04 FILLER PIC X(8) VALUE SPACE. IX2164.2 +034000 04 XXCOMPUTED PIC X(20). IX2164.2 +034100 04 FILLER PIC X(5) VALUE SPACE. IX2164.2 +034200 04 XXCORRECT PIC X(20). IX2164.2 +034300 02 INF-ANSI-REFERENCE PIC X(48). IX2164.2 +034400 01 HYPHEN-LINE. IX2164.2 +034500 02 FILLER PIC IS X VALUE IS SPACE. IX2164.2 +034600 02 FILLER PIC IS X(65) VALUE IS "************************IX2164.2 +034700- "*****************************************". IX2164.2 +034800 02 FILLER PIC IS X(54) VALUE IS "************************IX2164.2 +034900- "******************************". IX2164.2 +035000 01 CCVS-PGM-ID PIC X(9) VALUE IX2164.2 +035100 "IX216A". IX2164.2 +035200 PROCEDURE DIVISION. IX2164.2 +035300 DECLARATIVES. IX2164.2 +035400 IX-FS2-01 SECTION. IX2164.2 +035500 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX2164.2 +035600 IX-FS2-01-01. IX2164.2 +035700 ADD 1 TO WRK-CS-09V00-013. IX2164.2 +035800 GO TO IX-FS2-01-03 IX2164.2 +035900 IX-FS2-01-05 IX2164.2 +036000 DEPENDING ON WRK-CS-09V00-012. IX2164.2 +036100 GO TO IX-FS2-01-EXIT. IX2164.2 +036200 IX-FS2-01-03. IX2164.2 +036300*ENTRY FROM SEGMENT INX-TEST-001. IX2164.2 +036400* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX2164.2 +036500 ADD 1 TO WRK-CS-09V00-014. IX2164.2 +036600 IX-FS2-01-05. IX2164.2 +036700 ADD 1 TO WRK-CS-09V00-017. IX2164.2 +036800 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2164.2 +036900 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX2164.2 +037000 MOVE "10" TO WRK-XN-0002-003. IX2164.2 +037100 IX-FS2-01-EXIT. IX2164.2 +037200 EXIT. IX2164.2 +037300 END DECLARATIVES. IX2164.2 +037400 CCVS1 SECTION. IX2164.2 +037500 OPEN-FILES. IX2164.2 +037600P OPEN I-O RAW-DATA. IX2164.2 +037700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2164.2 +037800P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2164.2 +037900P MOVE "ABORTED " TO C-ABORT. IX2164.2 +038000P ADD 1 TO C-NO-OF-TESTS. IX2164.2 +038100P ACCEPT C-DATE FROM DATE. IX2164.2 +038200P ACCEPT C-TIME FROM TIME. IX2164.2 +038300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2164.2 +038400PEND-E-1. IX2164.2 +038500P CLOSE RAW-DATA. IX2164.2 +038600 OPEN OUTPUT PRINT-FILE. IX2164.2 +038700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2164.2 +038800 MOVE SPACE TO TEST-RESULTS. IX2164.2 +038900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2164.2 +039000 MOVE ZERO TO REC-SKL-SUB. IX2164.2 +039100 PERFORM CCVS-INIT-FILE 9 TIMES. IX2164.2 +039200 CCVS-INIT-FILE. IX2164.2 +039300 ADD 1 TO REC-SKL-SUB. IX2164.2 +039400 MOVE FILE-RECORD-INFO-SKELETON IX2164.2 +039500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2164.2 +039600 CCVS-INIT-EXIT. IX2164.2 +039700 GO TO CCVS1-EXIT. IX2164.2 +039800 CLOSE-FILES. IX2164.2 +039900P OPEN I-O RAW-DATA. IX2164.2 +040000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2164.2 +040100P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2164.2 +040200P MOVE "OK. " TO C-ABORT. IX2164.2 +040300P MOVE PASS-COUNTER TO C-OK. IX2164.2 +040400P MOVE ERROR-HOLD TO C-ALL. IX2164.2 +040500P MOVE ERROR-COUNTER TO C-FAIL. IX2164.2 +040600P MOVE DELETE-COUNTER TO C-DELETED. IX2164.2 +040700P MOVE INSPECT-COUNTER TO C-INSPECT. IX2164.2 +040800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2164.2 +040900PEND-E-2. IX2164.2 +041000P CLOSE RAW-DATA. IX2164.2 +041100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2164.2 +041200 TERMINATE-CCVS. IX2164.2 +041300S EXIT PROGRAM. IX2164.2 +041400STERMINATE-CALL. IX2164.2 +041500 STOP RUN. IX2164.2 +041600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2164.2 +041700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2164.2 +041800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2164.2 +041900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2164.2 +042000 MOVE "****TEST DELETED****" TO RE-MARK. IX2164.2 +042100 PRINT-DETAIL. IX2164.2 +042200 IF REC-CT NOT EQUAL TO ZERO IX2164.2 +042300 MOVE "." TO PARDOT-X IX2164.2 +042400 MOVE REC-CT TO DOTVALUE. IX2164.2 +042500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2164.2 +042600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2164.2 +042700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2164.2 +042800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2164.2 +042900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2164.2 +043000 MOVE SPACE TO CORRECT-X. IX2164.2 +043100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2164.2 +043200 MOVE SPACE TO RE-MARK. IX2164.2 +043300 HEAD-ROUTINE. IX2164.2 +043400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +043500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +043600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2164.2 +043700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2164.2 +043800 COLUMN-NAMES-ROUTINE. IX2164.2 +043900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +044000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +044100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +044200 END-ROUTINE. IX2164.2 +044300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2164.2 +044400 END-RTN-EXIT. IX2164.2 +044500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +044600 END-ROUTINE-1. IX2164.2 +044700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2164.2 +044800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2164.2 +044900 ADD PASS-COUNTER TO ERROR-HOLD. IX2164.2 +045000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2164.2 +045100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2164.2 +045200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2164.2 +045300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2164.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2164.2 +045500 END-ROUTINE-12. IX2164.2 +045600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2164.2 +045700 IF ERROR-COUNTER IS EQUAL TO ZERO IX2164.2 +045800 MOVE "NO " TO ERROR-TOTAL IX2164.2 +045900 ELSE IX2164.2 +046000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2164.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2164.2 +046200 PERFORM WRITE-LINE. IX2164.2 +046300 END-ROUTINE-13. IX2164.2 +046400 IF DELETE-COUNTER IS EQUAL TO ZERO IX2164.2 +046500 MOVE "NO " TO ERROR-TOTAL ELSE IX2164.2 +046600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2164.2 +046700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2164.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +046900 IF INSPECT-COUNTER EQUAL TO ZERO IX2164.2 +047000 MOVE "NO " TO ERROR-TOTAL IX2164.2 +047100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2164.2 +047200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2164.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +047400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +047500 WRITE-LINE. IX2164.2 +047600 ADD 1 TO RECORD-COUNT. IX2164.2 +047700Y IF RECORD-COUNT GREATER 42 IX2164.2 +047800Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2164.2 +047900Y MOVE SPACE TO DUMMY-RECORD IX2164.2 +048000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2164.2 +048100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2164.2 +048200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2164.2 +048300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2164.2 +048400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2164.2 +048500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048800Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2164.2 +048900Y MOVE ZERO TO RECORD-COUNT. IX2164.2 +049000 PERFORM WRT-LN. IX2164.2 +049100 WRT-LN. IX2164.2 +049200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2164.2 +049300 MOVE SPACE TO DUMMY-RECORD. IX2164.2 +049400 BLANK-LINE-PRINT. IX2164.2 +049500 PERFORM WRT-LN. IX2164.2 +049600 FAIL-ROUTINE. IX2164.2 +049700 IF COMPUTED-X NOT EQUAL TO SPACE IX2164.2 +049800 GO TO FAIL-ROUTINE-WRITE. IX2164.2 +049900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2164.2 +050000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2164.2 +050100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2164.2 +050200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +050300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2164.2 +050400 GO TO FAIL-ROUTINE-EX. IX2164.2 +050500 FAIL-ROUTINE-WRITE. IX2164.2 +050600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2164.2 +050700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2164.2 +050800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2164.2 +050900 MOVE SPACES TO COR-ANSI-REFERENCE. IX2164.2 +051000 FAIL-ROUTINE-EX. EXIT. IX2164.2 +051100 BAIL-OUT. IX2164.2 +051200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2164.2 +051300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2164.2 +051400 BAIL-OUT-WRITE. IX2164.2 +051500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2164.2 +051600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2164.2 +051700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +051800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2164.2 +051900 BAIL-OUT-EX. EXIT. IX2164.2 +052000 CCVS1-EXIT. IX2164.2 +052100 EXIT. IX2164.2 +052200 SECT-IX-04-001 SECTION. IX2164.2 +052300 INX-INIT-001. IX2164.2 +052400 MOVE "CREATE IX-FS2" TO FEATURE IX2164.2 +052500 MOVE "IX-FS2" TO XFILE-NAME (2). IX2164.2 +052600 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2164.2 +052700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2164.2 +052800 MOVE 000240 TO XRECORD-LENGTH (2). IX2164.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2164.2 +053000 MOVE 0001 TO XBLOCK-SIZE (2). IX2164.2 +053100 MOVE 000500 TO RECORDS-IN-FILE (2). IX2164.2 +053200 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2164.2 +053300 MOVE "S" TO XLABEL-TYPE (2). IX2164.2 +053400 MOVE 000001 TO XRECORD-NUMBER (2). IX2164.2 +053500*INITIALIZE RECORD WORK AREA NUMBER 2. IX2164.2 +053600 MOVE 1 TO WRK-CS-09V00-012. IX2164.2 +053700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX2164.2 +053800 WRK-CS-09V00-015 WRK-CS-09V00-016 IX2164.2 +053900 WRK-CS-09V00-017 WRK-CS-09V00-018. IX2164.2 +054000 OPEN-INIT-GF-01. IX2164.2 +054100 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +054200 MOVE ZERO TO WRK-DU-09V00-001. IX2164.2 +054300 OPEN-TEST-GF-01. IX2164.2 +054400* FILE IX-FS2 DOES NOT EXIST ********************** IX2164.2 +054500 OPEN EXTEND IX-FS2. IX2164.2 +054600 IF IX-FS2-STATUS = "05" IX2164.2 +054700 GO TO OPEN-PASS-GF-01. IX2164.2 +054800 OPEN-FAIL-GF-01. IX2164.2 +054900 PERFORM FAIL. IX2164.2 +055000 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2164.2 +055100 MOVE "05" TO CORRECT-A. IX2164.2 +055200 MOVE "IX-3; 1.3.4 (1) D; STATUS AFTER OPEN EXTEND" TO RE-MARKIX2164.2 +055300 GO TO OPEN-WRITE-GF-01. IX2164.2 +055400 OPEN-PASS-GF-01. IX2164.2 +055500 PERFORM PASS. IX2164.2 +055600 OPEN-WRITE-GF-01. IX2164.2 +055700 MOVE "OPEN-TEST-GF-01" TO PAR-NAME. IX2164.2 +055800 MOVE "OPEN EXTEND: EXP: 05" TO FEATURE. IX2164.2 +055900 PERFORM PRINT-DETAIL. IX2164.2 +056000 MOVE GRP-0101 TO IX-FS2-KEY. IX2164.2 +056100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX2164.2 +056200*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX2164.2 +056300 WRITE-INIT-GF-01. IX2164.2 +056400 MOVE "99" TO IX-FS2-STATUS. IX2164.2 +056500 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX2164.2 +056600 MOVE GRP-0101 TO XRECORD-KEY (2). IX2164.2 +056700 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX2164.2 +056800 WRITE IX-FS2R1-F-G-240. IX2164.2 +056900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +057000 ADD 1 TO WRK-CS-09V00-016. IX2164.2 +057100 IF XRECORD-NUMBER (2) EQUAL TO 300 IX2164.2 +057200 PERFORM WRITE-TEST-GF-01 THRU WRITE-TEST-GF-01-END. IX2164.2 +057300 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2164.2 +057400 GO TO WRITE-TEST-GF-02. IX2164.2 +057500 ADD 01 TO XRECORD-NUMBER (2). IX2164.2 +057600 GO TO WRITE-INIT-GF-01. IX2164.2 +057700 WRITE-TEST-GF-01. IX2164.2 +057800 CLOSE IX-FS2. IX2164.2 +057900 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +058000 OPEN EXTEND IX-FS2. IX2164.2 +058100 WRITE-TEST-GF-01-02. IX2164.2 +058200 IF IX-FS2-STATUS = "00" IX2164.2 +058300 GO TO WRITE-TEST-GF-01-02-PASS. IX2164.2 +058400 WRITE-TEST-GF-01-02-FAIL. IX2164.2 +058500 PERFORM FAIL. IX2164.2 +058600 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2164.2 +058700 MOVE "00" TO CORRECT-A. IX2164.2 +058800 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN EXTEND" TO RE-MARKIX2164.2 +058900 GO TO WRITE-TEST-GF-01-02-WRITE. IX2164.2 +059000 WRITE-TEST-GF-01-02-PASS. IX2164.2 +059100 PERFORM PASS. IX2164.2 +059200 WRITE-TEST-GF-01-02-WRITE. IX2164.2 +059300 MOVE "WRITE-TEST-GF-01 " TO PAR-NAME. IX2164.2 +059400 MOVE "OPEN EXTEND EXISTING" TO FEATURE. IX2164.2 +059500 PERFORM PRINT-DETAIL. IX2164.2 +059600 WRITE-TEST-GF-01-END. IX2164.2 +059700 EXIT. IX2164.2 +059800 IX2164.2 +059900 WRITE-TEST-GF-02. IX2164.2 +060000 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX2164.2 +060100 MOVE "IX-41; EXCEPTIONS/ERRORS" TO RE-MARK IX2164.2 +060200 MOVE ZERO TO CORRECT-18V0 IX2164.2 +060300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2164.2 +060400 PERFORM FAIL IX2164.2 +060500 ELSE IX2164.2 +060600 PERFORM PASS. IX2164.2 +060700 MOVE "OP EXT: ERROR/EXCEPT" TO FEATURE. IX2164.2 +060800 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2164.2 +060900 PERFORM PRINT-DETAIL. IX2164.2 +061000 WRITE-TEST-GF-03. IX2164.2 +061100 MOVE "OP EXT: INCORR COUNT" TO FEATURE. IX2164.2 +061200 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2164.2 +061300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX2164.2 +061400 MOVE "IX-41; INCORRECT COUNT" TO RE-MARK IX2164.2 +061500 MOVE 500 TO CORRECT-18V0 IX2164.2 +061600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX2164.2 +061700 PERFORM FAIL IX2164.2 +061800 ELSE IX2164.2 +061900 PERFORM PASS. IX2164.2 +062000 PERFORM PRINT-DETAIL. IX2164.2 +062100 WRITE-TEST-GF-04. IX2164.2 +062200 MOVE "OP EXT STATUS EXP:00" TO FEATURE. IX2164.2 +062300 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX2164.2 +062400* IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2164.2 +062500* MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN" TO RE-MARKIX2164.2 +062600* MOVE WRK-XN-0002-001 TO COMPUTED-A IX2164.2 +062700* MOVE "00" TO CORRECT-A IX2164.2 +062800* PERFORM FAIL IX2164.2 +062900* ELSE IX2164.2 +063000* PERFORM PASS. IX2164.2 +063100 PERFORM DE-LETE. IX2164.2 +063200 PERFORM PRINT-DETAIL. IX2164.2 +063300 WRITE-TEST-GF-05. IX2164.2 +063400 MOVE "WRITE STATUS EXP: 00" TO FEATURE. IX2164.2 +063500 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX2164.2 +063600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +063700 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER WRITE" TO RE-MARKIX2164.2 +063800 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +063900 MOVE "00" TO CORRECT-A IX2164.2 +064000 PERFORM FAIL IX2164.2 +064100 ELSE IX2164.2 +064200 PERFORM PASS. IX2164.2 +064300 PERFORM PRINT-DETAIL. IX2164.2 +064400 WRITE-TEST-GF-06. IX2164.2 +064500 MOVE "WRITE STATUS EXP: 00" TO FEATURE. IX2164.2 +064600 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX2164.2 +064700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX2164.2 +064800 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER WRITE" TO RE-MARKIX2164.2 +064900 MOVE ZERO TO CORRECT-18V0 IX2164.2 +065000 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX2164.2 +065100 PERFORM FAIL IX2164.2 +065200 ELSE IX2164.2 +065300 PERFORM PASS. IX2164.2 +065400 PERFORM PRINT-DETAIL. IX2164.2 +065500 WRITE-TEST-GF-07. IX2164.2 +065600 MOVE "CLOSE STATUS EXP: 00" TO FEATURE. IX2164.2 +065700 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. IX2164.2 +065800 MOVE 99 TO IX-FS2-STATUS. IX2164.2 +065900 CLOSE IX-FS2. IX2164.2 +066000 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +066100 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER CLOSE" TO RE-MARKIX2164.2 +066200 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +066300 MOVE "00" TO CORRECT-A IX2164.2 +066400 PERFORM FAIL IX2164.2 +066500 ELSE IX2164.2 +066600 PERFORM PASS. IX2164.2 +066700 PERFORM PRINT-DETAIL. IX2164.2 +066800 IX2164.2 +066900 RWRT-INIT-GF-01. IX2164.2 +067000 MOVE 2 TO WRK-CS-09V00-012. IX2164.2 +067100 MOVE ZERO TO WRK-CS-09V00-013. IX2164.2 +067200 MOVE ZERO TO WRK-CS-09V00-014. IX2164.2 +067300 MOVE ZERO TO WRK-CS-09V00-015. IX2164.2 +067400 MOVE ZERO TO WRK-CS-09V00-016. IX2164.2 +067500 MOVE ZERO TO WRK-CS-09V00-017. IX2164.2 +067600 MOVE ZERO TO WRK-CS-09V00-018. IX2164.2 +067700 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +067800 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2164.2 +067900 OPEN I-O IX-FS2. IX2164.2 +068000 MOVE SPACE TO WRK-XN-0002-002 IX2164.2 +068100 MOVE SPACE TO WRK-XN-0002-003 IX2164.2 +068200 MOVE SPACE TO WRK-XN-0002-004 IX2164.2 +068300 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX2164.2 +068400 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +068500 MOVE "UPDATE IX-FS2" TO FEATURE. IX2164.2 +068600*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX2164.2 +068700 RWRT-TEST-GF-01. IX2164.2 +068800 ADD 1 TO WRK-CS-09V00-014. IX2164.2 +068900 ADD 1 TO WRK-CS-09V00-015. IX2164.2 +069000 READ IX-FS2. IX2164.2 +069100 IF IX-FS2-STATUS EQUAL TO "10" IX2164.2 +069200 GO TO RWRT-TEST-GF-01-1. IX2164.2 +069300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2164.2 +069400 IF WRK-CS-09V00-015 EQUAL TO 5 IX2164.2 +069500 ADD 01 TO UPDATE-NUMBER (2) IX2164.2 +069600 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240 IX2164.2 +069700 PERFORM RWRT-010-UPDATE IX2164.2 +069800 MOVE ZERO TO WRK-CS-09V00-015 IX2164.2 +069900 GO TO RWRT-TEST-GF-01-2. IX2164.2 +070000 IF WRK-CS-09V00-014 GREATER 500 IX2164.2 +070100 GO TO RWRT-TEST-GF-01-1. IX2164.2 +070200 GO TO RWRT-TEST-GF-01. IX2164.2 +070300 RWRT-010-UPDATE. IX2164.2 +070400 REWRITE IX-FS2R1-F-G-240. IX2164.2 +070500 RWRT-TEST-GF-01-2. IX2164.2 +070600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +070700 ADD 1 TO WRK-CS-09V00-016. IX2164.2 +070800 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +070900 GO TO RWRT-TEST-GF-01. IX2164.2 +071000 RWRT-TEST-GF-01-1. IX2164.2 +071100 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +071200 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2164.2 +071300 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX2164.2 +071400 MOVE "IX-33; EXCEPTIONS/ERRORS" TO RE-MARK IX2164.2 +071500 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX2164.2 +071600 MOVE 1 TO CORRECT-18V0 IX2164.2 +071700 PERFORM FAIL IX2164.2 +071800 ELSE IX2164.2 +071900 PERFORM PASS. IX2164.2 +072000 PERFORM PRINT-DETAIL. IX2164.2 +072100 RWRT-TEST-GF-02. IX2164.2 +072200 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +072300 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. IX2164.2 +072400 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX2164.2 +072500 MOVE "IX-33;INCORRECT COUNT" TO RE-MARK IX2164.2 +072600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2164.2 +072700 MOVE 501 TO CORRECT-18V0 IX2164.2 +072800 PERFORM FAIL IX2164.2 +072900 ELSE IX2164.2 +073000 PERFORM PASS. IX2164.2 +073100 PERFORM PRINT-DETAIL. IX2164.2 +073200 RWRT-TEST-GF-03. IX2164.2 +073300 MOVE "OPEN STATUS EXP: 00" TO FEATURE. IX2164.2 +073400 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. IX2164.2 +073500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2164.2 +073600 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN" TO RE-MARKIX2164.2 +073700 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2164.2 +073800 MOVE "00" TO CORRECT-A IX2164.2 +073900 PERFORM FAIL IX2164.2 +074000 ELSE IX2164.2 +074100 PERFORM PASS. IX2164.2 +074200 PERFORM PRINT-DETAIL. IX2164.2 +074300 RWRT-TEST-GF-04. IX2164.2 +074400 MOVE "AT END STATUS EXP:10" TO FEATURE. IX2164.2 +074500 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. IX2164.2 +074600 IF IX-FS2-STATUS NOT EQUAL TO "10" IX2164.2 +074700 MOVE "IX-4; 1.3.4 (2) A; STATUS AT END " TO RE-MARKIX2164.2 +074800 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +074900 MOVE "10" TO CORRECT-A IX2164.2 +075000 PERFORM FAIL IX2164.2 +075100 ELSE IX2164.2 +075200 PERFORM PASS. IX2164.2 +075300 PERFORM PRINT-DETAIL. IX2164.2 +075400 RWRT-TEST-GF-05. IX2164.2 +075500 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +075600 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. IX2164.2 +075700 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX2164.2 +075800 MOVE "IX-4; 1.3.4 (2) A; STATUS AFTER END" TO RE-MARKIX2164.2 +075900 MOVE "EXCEPTIN/STATUS" TO RE-MARK IX2164.2 +076000 MOVE WRK-XN-0002-002 TO COMPUTED-A IX2164.2 +076100 MOVE "10" TO CORRECT-A IX2164.2 +076200 PERFORM FAIL IX2164.2 +076300 ELSE IX2164.2 +076400 PERFORM PASS. IX2164.2 +076500 PERFORM PRINT-DETAIL. IX2164.2 +076600 RWRT-TEST-GF-06. IX2164.2 +076700 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +076800 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. IX2164.2 +076900 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX2164.2 +077000 MOVE "IX-4; 1.3.4 (2) A; NO/ EXCEPTION " TO RE-MARKIX2164.2 +077100 MOVE WRK-XN-0002-003 TO COMPUTED-A IX2164.2 +077200 MOVE "10" TO CORRECT-A IX2164.2 +077300 PERFORM FAIL IX2164.2 +077400 ELSE IX2164.2 +077500 PERFORM PASS. IX2164.2 +077600 PERFORM PRINT-DETAIL. IX2164.2 +077700 RWRT-TEST-GF-07. IX2164.2 +077800 MOVE "CLOSE LOCK STAT: 00" TO FEATURE. IX2164.2 +077900 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. IX2164.2 +078000 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +078100 CLOSE IX-FS2 LOCK. IX2164.2 +078200 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +078300 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER CLOSE" TO RE-MARKIX2164.2 +078400 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +078500 MOVE "00" TO CORRECT-A IX2164.2 +078600 PERFORM FAIL IX2164.2 +078700 ELSE IX2164.2 +078800 PERFORM PASS. IX2164.2 +078900 PERFORM PRINT-DETAIL. IX2164.2 +079000 CCVS-EXIT SECTION. IX2164.2 +079100 CCVS-999999. IX2164.2 +079200 GO TO CLOSE-FILES. IX2164.2 +*END-OF,IX216A +*HEADER,COBOL,IX217A +000100 IDENTIFICATION DIVISION. IX2174.2 +000200 PROGRAM-ID. IX2174.2 +000300 IX217A. IX2174.2 +000400**************************************************************** IX2174.2 +000500* * IX2174.2 +000600* VALIDATION FOR:- * IX2174.2 +000700* * IX2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +000900* * IX2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2174.2 +001100* * IX2174.2 +001200**************************************************************** IX2174.2 +001300* IX2174.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO CREATE IX2174.2 +001500* THE OPTIONAL BUT NOT EXISTING INDEXED FILES BY THE OPEN IX2174.2 +001600* I-O AND THE OPEN EXTEND STATEMENTS. THE FILE STATUS CODE IX2174.2 +001700* FOR BOTH FILES MUST BE "05" AFTER PROCESSING THE OPEN IX2174.2 +001800* STATEMENT. FILE IX-FS1 CONTAINS 50 RECORDS AFTER CORRECT IX2174.2 +001900* EXECUTION AND FILE IX-VS1 CONTAINS 25 LONG RECORDS (240) IX2174.2 +002000* AND 25 SHORT RECORDS (200) AFTER CORRECT EXECUTION. IX2174.2 +002100* IX2174.2 +002200* IX2174.2 +002300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2174.2 +002400* IX2174.2 +002500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +002600* CLAUSE FOR DATA FILE IX-FS1 IX2174.2 +002700* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +002800* CLAUSE FOR DATA FILE IX-VS1 IX2174.2 +002900* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +003000* CLAUSE FOR INDEX FILE IX-FS1 IX2174.2 +003100* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +003200* CLAUSE FOR INDEX FILE IX-VS1 IX2174.2 +003300* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2174.2 +003400* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2174.2 +003500* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2174.2 +003600* IX2174.2 +003700* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2174.2 +003800* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2174.2 +003900* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2174.2 +004000* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2174.2 +004100* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2174.2 +004200* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2174.2 +004300* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2174.2 +004400* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2174.2 +004500* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2174.2 +004600* THEY ARE AS FOLLOWS IX2174.2 +004700* IX2174.2 +004800* J SELECTS X-CARD 44 IX2174.2 +004900* J SELECTS X-CARD 45 IX2174.2 +005000* C SELECTS X-CARD 84 IX2174.2 +005100* IX2174.2 +005200****************************************************** IX2174.2 +005300 ENVIRONMENT DIVISION. IX2174.2 +005400 CONFIGURATION SECTION. IX2174.2 +005500 SOURCE-COMPUTER. IX2174.2 +005600 XXXXX082. IX2174.2 +005700 OBJECT-COMPUTER. IX2174.2 +005800 XXXXX083. IX2174.2 +005900 INPUT-OUTPUT SECTION. IX2174.2 +006000 FILE-CONTROL. IX2174.2 +006100 SELECT PRINT-FILE ASSIGN TO IX2174.2 +006200 XXXXX055. IX2174.2 +006300 IX2174.2 +006400 SELECT OPTIONAL IX-FS1 ASSIGN TO IX2174.2 +006500 XXXXP024 IX2174.2 +006600J XXXXP044 IX2174.2 +006700 ORGANIZATION IS INDEXED IX2174.2 +006800 RECORD KEY IS IX-FS1-KEY IX2174.2 +006900 ACCESS MODE IS DYNAMIC IX2174.2 +007000 FILE STATUS IS IX-FS1-STATUS. IX2174.2 +007100 IX2174.2 +007200 SELECT OPTIONAL IX-VS1 ASSIGN TO IX2174.2 +007300 XXXXP025 IX2174.2 +007400J XXXXP045 IX2174.2 +007500 ORGANIZATION IS INDEXED IX2174.2 +007600 RECORD KEY IS IX-VS1-KEY IX2174.2 +007700 ACCESS MODE IS SEQUENTIAL IX2174.2 +007800 FILE STATUS IS IX-VS1-STATUS. IX2174.2 +007900 IX2174.2 +008000 DATA DIVISION. IX2174.2 +008100 FILE SECTION. IX2174.2 +008200 FD PRINT-FILE. IX2174.2 +008300 01 PRINT-REC PICTURE X(120). IX2174.2 +008400 01 DUMMY-RECORD PICTURE X(120). IX2174.2 +008500 IX2174.2 +008600 FD IX-FS1 IX2174.2 +008700C LABEL RECORD IS STANDARD IX2174.2 +008800C DATA RECORD IS IX-FS1R1-F-G-240 IX2174.2 +008900 BLOCK CONTAINS 1 RECORDS IX2174.2 +009000 RECORD CONTAINS 240 CHARACTERS. IX2174.2 +009100 01 IX-FS1R1-F-G-240. IX2174.2 +009200 03 IX-FS1-WRK-120 PIC X(120). IX2174.2 +009300 03 IX-FS1-GRP-120. IX2174.2 +009400 05 FILLER PIC X(8). IX2174.2 +009500 05 IX-FS1-KEY PIC X(29). IX2174.2 +009600 05 FILLER PIC X(83). IX2174.2 +009700 IX2174.2 +009800 FD IX-VS1 IX2174.2 +009900C LABEL RECORD IS STANDARD IX2174.2 +010000C DATA RECORD IS IX-VS1R1-F-G-240 IX-VS1R1-F-G-200 IX2174.2 +010100 BLOCK CONTAINS 1 RECORDS IX2174.2 +010200 RECORD VARYING 200 TO 240 DEPENDING REC-LENGTH. IX2174.2 +010300 IX2174.2 +010400 01 IX-VS1R1-F-G-240. IX2174.2 +010500 03 IX-VS1-WRK-120 PIC X(120). IX2174.2 +010600 03 IX-VS1-GRP-120. IX2174.2 +010700 05 FILLER PIC X(8). IX2174.2 +010800 05 IX-VS1-KEY PIC X(29). IX2174.2 +010900 05 FILLER PIC X(83). IX2174.2 +011000 IX2174.2 +011100 01 IX-VS1R1-F-G-200. IX2174.2 +011200 03 IX-VS1-WRK-120-SHORT PIC X(120). IX2174.2 +011300 03 IX-VS1-GRP-80. IX2174.2 +011400 05 FILLER PIC X(8). IX2174.2 +011500 05 FILLER-KEY PIC X(29). IX2174.2 +011600 05 VIERZIG PIC X(43). IX2174.2 +011700 IX2174.2 +011800 WORKING-STORAGE SECTION. IX2174.2 +011900 01 REC-LENGTH PIC 9999 VALUE ZERO. IX2174.2 +012000 01 STATUS-ERROR PIC 9 VALUE ZERO. IX2174.2 +012100 01 GRP-0101. IX2174.2 +012200 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2174.2 +012300 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2174.2 +012400 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2174.2 +012500 01 FILE-RECORD-INFORMATION-REC. IX2174.2 +012600 03 FILE-RECORD-INFO-SKELETON. IX2174.2 +012700 05 FILLER PICTURE X(48) VALUE IX2174.2 +012800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2174.2 +012900 05 FILLER PICTURE X(46) VALUE IX2174.2 +013000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2174.2 +013100 05 FILLER PICTURE X(26) VALUE IX2174.2 +013200 ",LFIL=000000,ORG= ,LBLR= ". IX2174.2 +013300 05 FILLER PICTURE X(37) VALUE IX2174.2 +013400 ",RECKEY= ". IX2174.2 +013500 05 FILLER PICTURE X(38) VALUE IX2174.2 +013600 ",ALTKEY1= ". IX2174.2 +013700 05 FILLER PICTURE X(38) VALUE IX2174.2 +013800 ",ALTKEY2= ". IX2174.2 +013900 05 FILLER PICTURE X(7) VALUE SPACE.IX2174.2 +014000 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2174.2 +014100 05 FILE-RECORD-INFO-P1-120. IX2174.2 +014200 07 FILLER PIC X(5). IX2174.2 +014300 07 XFILE-NAME PIC X(6). IX2174.2 +014400 07 FILLER PIC X(8). IX2174.2 +014500 07 XRECORD-NAME PIC X(6). IX2174.2 +014600 07 FILLER PIC X(1). IX2174.2 +014700 07 REELUNIT-NUMBER PIC 9(1). IX2174.2 +014800 07 FILLER PIC X(7). IX2174.2 +014900 07 XRECORD-NUMBER PIC 9(6). IX2174.2 +015000 07 FILLER PIC X(6). IX2174.2 +015100 07 UPDATE-NUMBER PIC 9(2). IX2174.2 +015200 07 FILLER PIC X(5). IX2174.2 +015300 07 ODO-NUMBER PIC 9(4). IX2174.2 +015400 07 FILLER PIC X(5). IX2174.2 +015500 07 XPROGRAM-NAME PIC X(5). IX2174.2 +015600 07 FILLER PIC X(7). IX2174.2 +015700 07 XRECORD-LENGTH PIC 9(6). IX2174.2 +015800 07 FILLER PIC X(7). IX2174.2 +015900 07 CHARS-OR-RECORDS PIC X(2). IX2174.2 +016000 07 FILLER PIC X(1). IX2174.2 +016100 07 XBLOCK-SIZE PIC 9(4). IX2174.2 +016200 07 FILLER PIC X(6). IX2174.2 +016300 07 RECORDS-IN-FILE PIC 9(6). IX2174.2 +016400 07 FILLER PIC X(5). IX2174.2 +016500 07 XFILE-ORGANIZATION PIC X(2). IX2174.2 +016600 07 FILLER PIC X(6). IX2174.2 +016700 07 XLABEL-TYPE PIC X(1). IX2174.2 +016800 05 FILE-RECORD-INFO-P121-240. IX2174.2 +016900 07 FILLER PIC X(8). IX2174.2 +017000 07 XRECORD-KEY PIC X(29). IX2174.2 +017100 07 FILLER PIC X(9). IX2174.2 +017200 07 ALTERNATE-KEY1 PIC X(29). IX2174.2 +017300 07 FILLER PIC X(9). IX2174.2 +017400 07 ALTERNATE-KEY2 PIC X(29). IX2174.2 +017500 07 FILLER PIC X(7). IX2174.2 +017600 IX2174.2 +017700 01 IX-FS1-STATUS. IX2174.2 +017800 05 IX-FS1-STAT1 PIC X. IX2174.2 +017900 05 IX-FS1-STAT2 PIC X. IX2174.2 +018000 IX2174.2 +018100 01 IX-VS1-STATUS. IX2174.2 +018200 05 IX-VS1-STAT1 PIC X. IX2174.2 +018300 05 IX-VS1-STAT2 PIC X. IX2174.2 +018400 IX2174.2 +018500 01 TEST-RESULTS. IX2174.2 +018600 02 FILLER PIC X VALUE SPACE. IX2174.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX2174.2 +018800 02 FILLER PIC X VALUE SPACE. IX2174.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX2174.2 +019000 02 FILLER PIC X VALUE SPACE. IX2174.2 +019100 02 PAR-NAME. IX2174.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX2174.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX2174.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX2174.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX2174.2 +019600 02 RE-MARK PIC X(61). IX2174.2 +019700 01 TEST-COMPUTED. IX2174.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2174.2 +019900 02 FILLER PIC X(17) VALUE IX2174.2 +020000 " COMPUTED=". IX2174.2 +020100 02 COMPUTED-X. IX2174.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2174.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX2174.2 +020400 PIC -9(9).9(9). IX2174.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2174.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2174.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2174.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX2174.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX2174.2 +021000 04 FILLER PIC X. IX2174.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX2174.2 +021200 01 TEST-CORRECT. IX2174.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX2174.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2174.2 +021500 02 CORRECT-X. IX2174.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2174.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2174.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2174.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2174.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2174.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX2174.2 +022200 04 CORRECT-18V0 PIC -9(18). IX2174.2 +022300 04 FILLER PIC X. IX2174.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX2174.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2174.2 +022600 01 CCVS-C-1. IX2174.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2174.2 +022800- "SS PARAGRAPH-NAME IX2174.2 +022900- " REMARKS". IX2174.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX2174.2 +023100 01 CCVS-C-2. IX2174.2 +023200 02 FILLER PIC X VALUE SPACE. IX2174.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX2174.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX2174.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX2174.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX2174.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2174.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX2174.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2174.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2174.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2174.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2174.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2174.2 +024800 01 CCVS-H-1. IX2174.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX2174.2 +025000 02 FILLER PIC X(42) VALUE IX2174.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2174.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX2174.2 +025300 01 CCVS-H-2A. IX2174.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX2174.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2174.2 +025600 02 FILLER PIC XXXX VALUE IX2174.2 +025700 "4.2 ". IX2174.2 +025800 02 FILLER PIC X(28) VALUE IX2174.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX2174.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX2174.2 +026100 IX2174.2 +026200 01 CCVS-H-2B. IX2174.2 +026300 02 FILLER PIC X(15) VALUE IX2174.2 +026400 "TEST RESULT OF ". IX2174.2 +026500 02 TEST-ID PIC X(9). IX2174.2 +026600 02 FILLER PIC X(4) VALUE IX2174.2 +026700 " IN ". IX2174.2 +026800 02 FILLER PIC X(12) VALUE IX2174.2 +026900 " HIGH ". IX2174.2 +027000 02 FILLER PIC X(22) VALUE IX2174.2 +027100 " LEVEL VALIDATION FOR ". IX2174.2 +027200 02 FILLER PIC X(58) VALUE IX2174.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +027400 01 CCVS-H-3. IX2174.2 +027500 02 FILLER PIC X(34) VALUE IX2174.2 +027600 " FOR OFFICIAL USE ONLY ". IX2174.2 +027700 02 FILLER PIC X(58) VALUE IX2174.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2174.2 +027900 02 FILLER PIC X(28) VALUE IX2174.2 +028000 " COPYRIGHT 1985 ". IX2174.2 +028100 01 CCVS-E-1. IX2174.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX2174.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2174.2 +028400 02 ID-AGAIN PIC X(9). IX2174.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX2174.2 +028600 01 CCVS-E-2. IX2174.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX2174.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX2174.2 +028900 02 CCVS-E-2-2. IX2174.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2174.2 +029100 03 FILLER PIC X VALUE SPACE. IX2174.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX2174.2 +029300 "ERRORS ENCOUNTERED". IX2174.2 +029400 01 CCVS-E-3. IX2174.2 +029500 02 FILLER PIC X(22) VALUE IX2174.2 +029600 " FOR OFFICIAL USE ONLY". IX2174.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX2174.2 +029800 02 FILLER PIC X(58) VALUE IX2174.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX2174.2 +030100 02 FILLER PIC X(15) VALUE IX2174.2 +030200 " COPYRIGHT 1985". IX2174.2 +030300 01 CCVS-E-4. IX2174.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2174.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX2174.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2174.2 +030700 02 FILLER PIC X(40) VALUE IX2174.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2174.2 +030900 01 XXINFO. IX2174.2 +031000 02 FILLER PIC X(19) VALUE IX2174.2 +031100 "*** INFORMATION ***". IX2174.2 +031200 02 INFO-TEXT. IX2174.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX2174.2 +031400 04 XXCOMPUTED PIC X(20). IX2174.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX2174.2 +031600 04 XXCORRECT PIC X(20). IX2174.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX2174.2 +031800 01 HYPHEN-LINE. IX2174.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX2174.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX2174.2 +032100- "*****************************************". IX2174.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX2174.2 +032300- "******************************". IX2174.2 +032400 01 CCVS-PGM-ID PIC X(9) VALUE IX2174.2 +032500 "IX217A". IX2174.2 +032600 PROCEDURE DIVISION. IX2174.2 +032700 CCVS1 SECTION. IX2174.2 +032800 OPEN-FILES. IX2174.2 +032900 OPEN OUTPUT PRINT-FILE. IX2174.2 +033000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2174.2 +033100 MOVE SPACE TO TEST-RESULTS. IX2174.2 +033200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2174.2 +033300 MOVE ZERO TO REC-SKL-SUB. IX2174.2 +033400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2174.2 +033500 CCVS-INIT-FILE. IX2174.2 +033600 ADD 1 TO REC-SKL-SUB. IX2174.2 +033700 MOVE FILE-RECORD-INFO-SKELETON IX2174.2 +033800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2174.2 +033900 CCVS-INIT-EXIT. IX2174.2 +034000 GO TO CCVS1-EXIT. IX2174.2 +034100 CLOSE-FILES. IX2174.2 +034200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2174.2 +034300 TERMINATE-CCVS. IX2174.2 +034400 STOP RUN. IX2174.2 +034500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2174.2 +034600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2174.2 +034700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2174.2 +034800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2174.2 +034900 MOVE "****TEST DELETED****" TO RE-MARK. IX2174.2 +035000 PRINT-DETAIL. IX2174.2 +035100 IF REC-CT NOT EQUAL TO ZERO IX2174.2 +035200 MOVE "." TO PARDOT-X IX2174.2 +035300 MOVE REC-CT TO DOTVALUE. IX2174.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2174.2 +035500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2174.2 +035600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2174.2 +035700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2174.2 +035800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2174.2 +035900 MOVE SPACE TO CORRECT-X. IX2174.2 +036000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2174.2 +036100 MOVE SPACE TO RE-MARK. IX2174.2 +036200 HEAD-ROUTINE. IX2174.2 +036300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +036400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +036500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2174.2 +036600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2174.2 +036700 COLUMN-NAMES-ROUTINE. IX2174.2 +036800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +036900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +037000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +037100 END-ROUTINE. IX2174.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2174.2 +037300 END-RTN-EXIT. IX2174.2 +037400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +037500 END-ROUTINE-1. IX2174.2 +037600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2174.2 +037700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2174.2 +037800 ADD PASS-COUNTER TO ERROR-HOLD. IX2174.2 +037900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2174.2 +038000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2174.2 +038100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2174.2 +038200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2174.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2174.2 +038400 END-ROUTINE-12. IX2174.2 +038500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2174.2 +038600 IF ERROR-COUNTER IS EQUAL TO ZERO IX2174.2 +038700 MOVE "NO " TO ERROR-TOTAL IX2174.2 +038800 ELSE IX2174.2 +038900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2174.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2174.2 +039100 PERFORM WRITE-LINE. IX2174.2 +039200 END-ROUTINE-13. IX2174.2 +039300 IF DELETE-COUNTER IS EQUAL TO ZERO IX2174.2 +039400 MOVE "NO " TO ERROR-TOTAL ELSE IX2174.2 +039500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2174.2 +039600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2174.2 +039700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +039800 IF INSPECT-COUNTER EQUAL TO ZERO IX2174.2 +039900 MOVE "NO " TO ERROR-TOTAL IX2174.2 +040000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2174.2 +040100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2174.2 +040200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +040300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +040400 WRITE-LINE. IX2174.2 +040500 ADD 1 TO RECORD-COUNT. IX2174.2 +040600Y IF RECORD-COUNT GREATER 42 IX2174.2 +040700Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2174.2 +040800Y MOVE SPACE TO DUMMY-RECORD IX2174.2 +040900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2174.2 +041000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2174.2 +041100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2174.2 +041200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2174.2 +041300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2174.2 +041400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041700Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2174.2 +041800Y MOVE ZERO TO RECORD-COUNT. IX2174.2 +041900 PERFORM WRT-LN. IX2174.2 +042000 WRT-LN. IX2174.2 +042100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2174.2 +042200 MOVE SPACE TO DUMMY-RECORD. IX2174.2 +042300 BLANK-LINE-PRINT. IX2174.2 +042400 PERFORM WRT-LN. IX2174.2 +042500 FAIL-ROUTINE. IX2174.2 +042600 IF COMPUTED-X NOT EQUAL TO SPACE IX2174.2 +042700 GO TO FAIL-ROUTINE-WRITE. IX2174.2 +042800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2174.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2174.2 +043000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2174.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. IX2174.2 +043300 GO TO FAIL-ROUTINE-EX. IX2174.2 +043400 FAIL-ROUTINE-WRITE. IX2174.2 +043500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2174.2 +043600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2174.2 +043700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2174.2 +043800 MOVE SPACES TO COR-ANSI-REFERENCE. IX2174.2 +043900 FAIL-ROUTINE-EX. EXIT. IX2174.2 +044000 BAIL-OUT. IX2174.2 +044100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2174.2 +044200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2174.2 +044300 BAIL-OUT-WRITE. IX2174.2 +044400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2174.2 +044500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2174.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. IX2174.2 +044800 BAIL-OUT-EX. EXIT. IX2174.2 +044900 CCVS1-EXIT. IX2174.2 +045000 EXIT. IX2174.2 +045100 IX2174.2 +045200******************************************************************IX2174.2 +045300* TEST 1 *IX2174.2 +045400* OPEN I-O (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2174.2 +045500* 05 EXPECTED *IX2174.2 +045600* IX-3, 1.3.4 (1) D *IX2174.2 +045700******************************************************************IX2174.2 +045800 SECT-IX-01-001 SECTION. IX2174.2 +045900 OPN-INIT-GF-01. IX2174.2 +046000 MOVE SPACES TO IX-FS1-STATUS. IX2174.2 +046100 MOVE "OPEN I-O: 05 EXP." TO FEATURE. IX2174.2 +046200 MOVE "OPN-TEST-GF-01 " TO PAR-NAME. IX2174.2 +046300 OPN-TEST-GF-01. IX2174.2 +046400 OPEN IX2174.2 +046500 I-O IX-FS1. IX2174.2 +046600 IF IX-FS1-STATUS = "05" IX2174.2 +046700 GO TO OPN-PASS-GF-01. IX2174.2 +046800 OPN-FAIL-GF-01. IX2174.2 +046900 MOVE "IX-3, 1.3.4, (1) D. " TO RE-MARK. IX2174.2 +047000 PERFORM FAIL. IX2174.2 +047100 MOVE IX-FS1-STATUS TO COMPUTED-A. IX2174.2 +047200 MOVE "05" TO CORRECT-X. IX2174.2 +047300 GO TO OPN-WRITE-GF-01. IX2174.2 +047400 OPN-PASS-GF-01. IX2174.2 +047500 PERFORM PASS. IX2174.2 +047600 OPN-WRITE-GF-01. IX2174.2 +047700 PERFORM PRINT-DETAIL. IX2174.2 +047800 IX2174.2 +047900******************************************************************IX2174.2 +048000* TEST 2 *IX2174.2 +048100* WRITE 00 EXPECTED *IX2174.2 +048200* IX-3, 1.3.4 (1) A *IX2174.2 +048300******************************************************************IX2174.2 +048400 WRI-INIT-GF-01. IX2174.2 +048500 MOVE 240 TO REC-LENGTH. IX2174.2 +048600 MOVE ZERO TO STATUS-ERROR. IX2174.2 +048700 MOVE "WRI-TEST-GF-01 " TO PAR-NAME IX2174.2 +048800 MOVE "WRITE (OPT)F 00 EXP." TO FEATURE. IX2174.2 +048900 MOVE "IX-FS1" TO XFILE-NAME (1). IX2174.2 +049000 MOVE "IX-F-G" TO XRECORD-NAME (1). IX2174.2 +049100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2174.2 +049200 MOVE 000240 TO XRECORD-LENGTH (1). IX2174.2 +049300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2174.2 +049400 MOVE 0001 TO XBLOCK-SIZE (1). IX2174.2 +049500 MOVE 000500 TO RECORDS-IN-FILE (1). IX2174.2 +049600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2174.2 +049700 MOVE "S" TO XLABEL-TYPE (1). IX2174.2 +049800 MOVE 000001 TO XRECORD-NUMBER (1). IX2174.2 +049900 WRI-TEST-GF-01. IX2174.2 +050000 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2174.2 +050100 MOVE GRP-0101 TO XRECORD-KEY (1). IX2174.2 +050200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2174.2 +050300 WRITE IX-FS1R1-F-G-240 IX2174.2 +050400 INVALID KEY GO TO WRI-FAIL-GF-01. IX2174.2 +050500 IF IX-FS1-STATUS NOT EQUAL TO "00" IX2174.2 +050600 MOVE 1 TO STATUS-ERROR. IX2174.2 +050700 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2174.2 +050800 GO TO WRI-TEST-GF-01-1. IX2174.2 +050900 ADD 000001 TO XRECORD-NUMBER (1). IX2174.2 +051000 GO TO WRI-TEST-GF-01. IX2174.2 +051100 WRI-TEST-GF-01-1. IX2174.2 +051200 IF STATUS-ERROR EQUAL TO ZERO IX2174.2 +051300 GO TO WRI-PASS-GF-01. IX2174.2 +051400 WRI-FAIL-GF-01. IX2174.2 +051500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX2174.2 +051600 PERFORM FAIL. IX2174.2 +051700 GO TO WRI-WRITE-GF-01. IX2174.2 +051800 WRI-PASS-GF-01. IX2174.2 +051900 PERFORM PASS. IX2174.2 +052000 WRI-WRITE-GF-01. IX2174.2 +052100 PERFORM PRINT-DETAIL. IX2174.2 +052200 IX2174.2 +052300 CLOSE IX-FS1. IX2174.2 +052400******************************************************************IX2174.2 +052500* TEST 3 *IX2174.2 +052600* READ 00 EXPECTED *IX2174.2 +052700* IX-3, 1.3.4 (1) A *IX2174.2 +052800******************************************************************IX2174.2 +052900 READ-INIT-F1-01. IX2174.2 +053000 OPEN INPUT IX-FS1. IX2174.2 +053100 MOVE ZERO TO WRK-DU-09V00-001. IX2174.2 +053200 READ-TEST-F1-01. IX2174.2 +053300 READ IX-FS1 NEXT RECORD IX2174.2 +053400 AT END GO TO READ-TEST-F1-01-1. IX2174.2 +053500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2174.2 +053600 ADD 1 TO WRK-DU-09V00-001. IX2174.2 +053700 IF WRK-DU-09V00-001 GREATER 50 IX2174.2 +053800 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX2174.2 +053900 GO TO READ-TEST-F1-01-1. IX2174.2 +054000 IF XRECORD-NUMBER (1) = WRK-DU-09V00-001 IX2174.2 +054100 GO TO READ-TEST-F1-01 IX2174.2 +054200 ELSE IX2174.2 +054300 MOVE "WRONG RECORD NUMBER" TO RE-MARK IX2174.2 +054400 PERFORM FAIL IX2174.2 +054500 MOVE "READ (TO VERIFY)" TO FEATURE IX2174.2 +054600 MOVE "READ-TEST-F1-01" TO PAR-NAME IX2174.2 +054700 PERFORM PRINT-DETAIL IX2174.2 +054800 GO TO READ-TEST-F1-01-3. IX2174.2 +054900 READ-TEST-F1-01-1. IX2174.2 +055000 IF XRECORD-NUMBER (1) NOT EQUAL TO 50 IX2174.2 +055100 PERFORM FAIL IX2174.2 +055200 ELSE IX2174.2 +055300 PERFORM PASS. IX2174.2 +055400 GO TO READ-TEST-F1-01-2. IX2174.2 +055500 READ-TEST-F1-01-2. IX2174.2 +055600 MOVE "READ (TO VERIFY) " TO FEATURE. IX2174.2 +055700 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2174.2 +055800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2174.2 +055900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2174.2 +056000 PERFORM PRINT-DETAIL. IX2174.2 +056100 READ-TEST-F1-01-3. IX2174.2 +056200 CLOSE IX-FS1. IX2174.2 +056300 IX2174.2 +056400******************************************************************IX2174.2 +056500* TEST 4 *IX2174.2 +056600* OPEN EXTEND (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2174.2 +056700* 05 EXPECTED *IX2174.2 +056800* IX-3, 1.3.4 (1) D *IX2174.2 +056900******************************************************************IX2174.2 +057000 OPN-INIT-GF-02. IX2174.2 +057100 MOVE SPACES TO IX-VS1-STATUS. IX2174.2 +057200 MOVE "OPEN EXTEND: 05 EXP." TO FEATURE. IX2174.2 +057300 MOVE "OPN-TEST-GF-02 " TO PAR-NAME. IX2174.2 +057400 OPN-TEST-GF-02. IX2174.2 +057500 OPEN IX2174.2 +057600 EXTEND IX-VS1. IX2174.2 +057700 IF IX-VS1-STATUS = "05" IX2174.2 +057800 GO TO OPN-PASS-GF-02. IX2174.2 +057900 OPN-FAIL-GF-02. IX2174.2 +058000 MOVE "IX-3, 1.3.4, (1) D. " TO RE-MARK. IX2174.2 +058100 PERFORM FAIL. IX2174.2 +058200 MOVE IX-VS1-STATUS TO COMPUTED-A. IX2174.2 +058300 MOVE "05" TO CORRECT-X. IX2174.2 +058400 GO TO OPN-WRITE-GF-02. IX2174.2 +058500 OPN-PASS-GF-02. IX2174.2 +058600 PERFORM PASS. IX2174.2 +058700 OPN-WRITE-GF-02. IX2174.2 +058800 PERFORM PRINT-DETAIL. IX2174.2 +058900 IX2174.2 +059000******************************************************************IX2174.2 +059100* TEST 5 *IX2174.2 +059200* WRITE 00 EXPECTED *IX2174.2 +059300* IX-3, 1.3.4 (1) A *IX2174.2 +059400******************************************************************IX2174.2 +059500 WRI-INIT-GF-02. IX2174.2 +059600 MOVE 240 TO REC-LENGTH. IX2174.2 +059700 MOVE ZERO TO STATUS-ERROR. IX2174.2 +059800 MOVE "WRI-TEST-GF-02 " TO PAR-NAME IX2174.2 +059900 MOVE "WRITE (OPT)S 00 EXP." TO FEATURE. IX2174.2 +060000 MOVE "IX-VS1" TO XFILE-NAME (1). IX2174.2 +060100 MOVE " LONG " TO XRECORD-NAME (1). IX2174.2 +060200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2174.2 +060300 MOVE 000240 TO XRECORD-LENGTH (1). IX2174.2 +060400 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2174.2 +060500 MOVE 0001 TO XBLOCK-SIZE (1). IX2174.2 +060600 MOVE 000500 TO RECORDS-IN-FILE (1). IX2174.2 +060700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2174.2 +060800 MOVE "S" TO XLABEL-TYPE (1). IX2174.2 +060900 MOVE 000001 TO XRECORD-NUMBER (1). IX2174.2 +061000 WRI-TEST-GF-02. IX2174.2 +061100 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2174.2 +061200 MOVE GRP-0101 TO XRECORD-KEY (1). IX2174.2 +061300 MOVE FILE-RECORD-INFO (1) TO IX-VS1R1-F-G-240. IX2174.2 +061400 IF XRECORD-NUMBER (1) LESS THAN 26 IX2174.2 +061500 WRITE IX-VS1R1-F-G-240 IX2174.2 +061600 INVALID KEY GO TO WRI-FAIL-GF-02. IX2174.2 +061700 IF IX-VS1-STATUS NOT EQUAL TO "00" IX2174.2 +061800 MOVE 1 TO STATUS-ERROR. IX2174.2 +061900 IF XRECORD-NUMBER (1) GREATER THAN 25 IX2174.2 +062000 WRITE IX-VS1R1-F-G-200 IX2174.2 +062100 INVALID KEY GO TO WRI-FAIL-GF-02. IX2174.2 +062200 IF IX-VS1-STATUS NOT EQUAL TO "00" IX2174.2 +062300 MOVE 1 TO STATUS-ERROR. IX2174.2 +062400 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2174.2 +062500 GO TO WRI-TEST-GF-02-1. IX2174.2 +062600 IF XRECORD-NUMBER (1) EQUAL TO 25 IX2174.2 +062700 MOVE " SHORT" TO XRECORD-NAME (1) IX2174.2 +062800 MOVE 200 TO REC-LENGTH IX2174.2 +062900 MOVE 000200 TO XRECORD-LENGTH (1). IX2174.2 +063000 ADD 000001 TO XRECORD-NUMBER (1). IX2174.2 +063100 GO TO WRI-TEST-GF-02. IX2174.2 +063200 WRI-TEST-GF-02-1. IX2174.2 +063300 IF STATUS-ERROR EQUAL TO ZERO IX2174.2 +063400 GO TO WRI-PASS-GF-02. IX2174.2 +063500 WRI-FAIL-GF-02. IX2174.2 +063600 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX2174.2 +063700 PERFORM FAIL. IX2174.2 +063800 GO TO WRI-WRITE-GF-02. IX2174.2 +063900 WRI-PASS-GF-02. IX2174.2 +064000 PERFORM PASS. IX2174.2 +064100 WRI-WRITE-GF-02. IX2174.2 +064200 PERFORM PRINT-DETAIL. IX2174.2 +064300 IX2174.2 +064400 CLOSE IX-VS1. IX2174.2 +064500******************************************************************IX2174.2 +064600* TEST 6 *IX2174.2 +064700* READ 00 EXPECTED *IX2174.2 +064800* IX-3, 1.3.4 (1) A *IX2174.2 +064900******************************************************************IX2174.2 +065000 READ-INIT-F1-02. IX2174.2 +065100 OPEN INPUT IX-VS1. IX2174.2 +065200 MOVE ZERO TO WRK-DU-09V00-001. IX2174.2 +065300 READ-TEST-F1-02. IX2174.2 +065400 READ IX-VS1 NEXT RECORD IX2174.2 +065500 AT END GO TO READ-TEST-F1-02-1. IX2174.2 +065600 MOVE IX-VS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2174.2 +065700 ADD 1 TO WRK-DU-09V00-001. IX2174.2 +065800 IF WRK-DU-09V00-001 GREATER 50 IX2174.2 +065900 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX2174.2 +066000 GO TO READ-TEST-F1-02-1. IX2174.2 +066100 IF XRECORD-NUMBER (1) = WRK-DU-09V00-001 IX2174.2 +066200 GO TO READ-TEST-F1-02 IX2174.2 +066300 ELSE IX2174.2 +066400 MOVE "WRONG RECORD NUMBER" TO RE-MARK IX2174.2 +066500 PERFORM FAIL IX2174.2 +066600 MOVE "READ (TO VERIFY)" TO FEATURE IX2174.2 +066700 MOVE "READ-TEST-F1-02" TO PAR-NAME IX2174.2 +066800 PERFORM PRINT-DETAIL IX2174.2 +066900 GO TO READ-TEST-F1-02-3. IX2174.2 +067000 READ-TEST-F1-02-1. IX2174.2 +067100 IF XRECORD-NUMBER (1) NOT EQUAL TO 50 IX2174.2 +067200 PERFORM FAIL IX2174.2 +067300 ELSE IX2174.2 +067400 PERFORM PASS. IX2174.2 +067500 READ-TEST-F1-02-2. IX2174.2 +067600 MOVE "READ (TO VERIFY) " TO FEATURE. IX2174.2 +067700 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2174.2 +067800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2174.2 +067900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2174.2 +068000 PERFORM PRINT-DETAIL. IX2174.2 +068100 READ-TEST-F1-02-3. IX2174.2 +068200 CLOSE IX-VS1. IX2174.2 +068300 IX2174.2 +068400 IX2174.2 +068500 CCVS-EXIT SECTION. IX2174.2 +068600 CCVS-999999. IX2174.2 +068700 GO TO CLOSE-FILES. IX2174.2 +*END-OF,IX217A +*HEADER,COBOL,IX218A +000100 IDENTIFICATION DIVISION. IX2184.2 +000200 PROGRAM-ID. IX2184.2 +000300 IX218A. IX2184.2 +000400**************************************************************** IX2184.2 +000500* * IX2184.2 +000600* VALIDATION FOR:- * IX2184.2 +000700* * IX2184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +000900* * IX2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2184.2 +001100* * IX2184.2 +001200**************************************************************** IX2184.2 +001300* IX2184.2 +001400* 1. THE FUNCTION OF THIS PROGRAM IS TO CHECK THE SEQUENTIAL IX2184.2 +001500* READ STATEMENT FOR A NOT EXISTING OPTIONAL INDEXED FILE. IX2184.2 +001600* THE READ STATEMENT WITHOUT AN OPEN STATEMENT FOR SUCH A IX2184.2 +001700* FILE MUST CAUSE THE AT END CONDITION AND THE FILE STATUS IX2184.2 +001800* CODE 10. THIS CODE IS CHECKED HERE. THE NAME OF THE FILE IX2184.2 +001900* IS IX-FS1. THE AT END PHRASE IS SPECIFIED. THAT MEANS IX2184.2 +002000* THAT ANY USE AFTER STANDARD EXCEPTION PROCEDURE MUST NOT IX2184.2 +002100* BE EXECUTED. IX2184.2 +002200* IX2184.2 +002300* 2. ANOTHER FUNCTION OF THIS PROGRAM IS TO CHECK THE START IX2184.2 +002400* AND THE RANDOM READ STATEMENTS FOR A NOT EXISTING IX2184.2 +002500* OPTIONAL INDEXED FILE. BOTH ATTEMPTS SHOULD CAUSE THE IX2184.2 +002600* FILE STATUS CODE 23. THE INVALID KEY PHRASE IS SPECIFIED IX2184.2 +002700* AND THE USE AFTER STANDARD EXCEPTION PROCEDURE MUST NOT IX2184.2 +002800* BE EXECUTED. THE NAME OF THE FILE IS IX-FS2. IX2184.2 +002900* IX2184.2 +003000* IX2184.2 +003100* IX2184.2 +003200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2184.2 +003300* IX2184.2 +003400* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2184.2 +003500* CLAUSE FOR DATA FILE IX-FS1 IX2184.2 +003600* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2184.2 +003700* CLAUSE FOR DATA FILE IX-FS1 IX2184.2 +003800* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2184.2 +003900* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX2184.2 +004000* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2184.2 +004100* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2184.2 +004200* X-84 IMPLEMENTOR-NAME FOR PRINT-FILE IX2184.2 +004300* IX2184.2 +004400* NOTE: X-CARDS 44, 45 AND 62 ARE OPTIONAL IX2184.2 +004500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2184.2 +004600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2184.2 +004700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2184.2 +004800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2184.2 +004900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2184.2 +005000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2184.2 +005100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2184.2 +005200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2184.2 +005300* THEY ARE AS FOLLOWS IX2184.2 +005400* IX2184.2 +005500* J SELECTS X-CARD 44 IX2184.2 +005600* J SELECTS X-CARD 45 IX2184.2 +005700* P SELECTS X-CARD 62 IX2184.2 +005800* C SELECTS X-CARD 84 IX2184.2 +005900* IX2184.2 +006000****************************************************** IX2184.2 +006100 ENVIRONMENT DIVISION. IX2184.2 +006200 CONFIGURATION SECTION. IX2184.2 +006300 SOURCE-COMPUTER. IX2184.2 +006400 XXXXX082. IX2184.2 +006500 OBJECT-COMPUTER. IX2184.2 +006600 XXXXX083. IX2184.2 +006700 INPUT-OUTPUT SECTION. IX2184.2 +006800 FILE-CONTROL. IX2184.2 +006900P SELECT RAW-DATA ASSIGN TO IX2184.2 +007000P XXXXX062 IX2184.2 +007100P ORGANIZATION IS INDEXED IX2184.2 +007200P ACCESS MODE IS RANDOM IX2184.2 +007300P RECORD KEY IS RAW-DATA-KEY. IX2184.2 +007400 SELECT PRINT-FILE ASSIGN TO IX2184.2 +007500 XXXXX055. IX2184.2 +007600 IX2184.2 +007700 SELECT OPTIONAL IX-FS1 ASSIGN TO IX2184.2 +007800* SELECT IX-FS1 ASSIGN TO IX2184.2 +007900 XXXXP024 IX2184.2 +008000J XXXXP044 IX2184.2 +008100 ORGANIZATION IS INDEXED IX2184.2 +008200 RECORD KEY IS IX-FS1-KEY IX2184.2 +008300 ACCESS MODE IS SEQUENTIAL IX2184.2 +008400 FILE STATUS IS IX-FS1-STATUS. IX2184.2 +008500 IX2184.2 +008600 SELECT OPTIONAL IX-FS2 ASSIGN TO IX2184.2 +008700* SELECT IX-FS2 ASSIGN TO IX2184.2 +008800 XXXXP025 IX2184.2 +008900J XXXXP045 IX2184.2 +009000 ORGANIZATION IS INDEXED IX2184.2 +009100 RECORD KEY IS IX-FS2-KEY IX2184.2 +009200 ACCESS MODE IS DYNAMIC IX2184.2 +009300 FILE STATUS IS IX-FS2-STATUS. IX2184.2 +009400 IX2184.2 +009500 DATA DIVISION. IX2184.2 +009600 FILE SECTION. IX2184.2 +009700P IX2184.2 +009800PFD RAW-DATA. IX2184.2 +009900P IX2184.2 +010000P01 RAW-DATA-SATZ. IX2184.2 +010100P 05 RAW-DATA-KEY PIC X(6). IX2184.2 +010200P 05 C-DATE PIC 9(6). IX2184.2 +010300P 05 C-TIME PIC 9(8). IX2184.2 +010400P 05 C-NO-OF-TESTS PIC 99. IX2184.2 +010500P 05 C-OK PIC 999. IX2184.2 +010600P 05 C-ALL PIC 999. IX2184.2 +010700P 05 C-FAIL PIC 999. IX2184.2 +010800P 05 C-DELETED PIC 999. IX2184.2 +010900P 05 C-INSPECT PIC 999. IX2184.2 +011000P 05 C-NOTE PIC X(13). IX2184.2 +011100P 05 C-INDENT PIC X. IX2184.2 +011200P 05 C-ABORT PIC X(8). IX2184.2 +011300 FD PRINT-FILE. IX2184.2 +011400 01 PRINT-REC PICTURE X(120). IX2184.2 +011500 01 DUMMY-RECORD PICTURE X(120). IX2184.2 +011600 IX2184.2 +011700 FD IX-FS1 IX2184.2 +011800C LABEL RECORD IS STANDARD IX2184.2 +011900C DATA RECORD IS IX-FS1R1-F-G-240 IX2184.2 +012000 BLOCK CONTAINS 1 RECORDS IX2184.2 +012100 RECORD CONTAINS 240 CHARACTERS. IX2184.2 +012200 01 IX-FS1R1-F-G-240. IX2184.2 +012300 03 IX-FS1-WRK-120 PIC X(120). IX2184.2 +012400 03 IX-FS1-GRP-120. IX2184.2 +012500 05 FILLER PIC X(8). IX2184.2 +012600 05 IX-FS1-KEY PIC X(29). IX2184.2 +012700 05 FILLER PIC X(83). IX2184.2 +012800 IX2184.2 +012900 FD IX-FS2 IX2184.2 +013000C LABEL RECORD IS STANDARD IX2184.2 +013100C DATA RECORD IS IX-FS2R1-F-G-240 IX2184.2 +013200 BLOCK CONTAINS 1 RECORDS IX2184.2 +013300 RECORD CONTAINS 240 CHARACTERS. IX2184.2 +013400 01 IX-FS2R1-F-G-240. IX2184.2 +013500 03 IX-FS2-WRK-120 PIC X(120). IX2184.2 +013600 03 IX-FS2-GRP-120. IX2184.2 +013700 05 FILLER PIC X(8). IX2184.2 +013800 05 IX-FS2-KEY PIC X(29). IX2184.2 +013900 05 FILLER PIC X(83). IX2184.2 +014000 IX2184.2 +014100 WORKING-STORAGE SECTION. IX2184.2 +014200 01 EOF-FLAG PIC 9 VALUE ZERO. IX2184.2 +014300 IX2184.2 +014400 01 IX-FS1-STATUS. IX2184.2 +014500 05 IX-FS1-STAT1 PIC X. IX2184.2 +014600 05 IX-FS1-STAT2 PIC X. IX2184.2 +014700 IX2184.2 +014800 01 IX-FS2-STATUS. IX2184.2 +014900 05 IX-FS2-STAT1 PIC X. IX2184.2 +015000 05 IX-FS2-STAT2 PIC X. IX2184.2 +015100 IX2184.2 +015200 01 TEST-RESULTS. IX2184.2 +015300 02 FILLER PIC X VALUE SPACE. IX2184.2 +015400 02 FEATURE PIC X(20) VALUE SPACE. IX2184.2 +015500 02 FILLER PIC X VALUE SPACE. IX2184.2 +015600 02 P-OR-F PIC X(5) VALUE SPACE. IX2184.2 +015700 02 FILLER PIC X VALUE SPACE. IX2184.2 +015800 02 PAR-NAME. IX2184.2 +015900 03 FILLER PIC X(19) VALUE SPACE. IX2184.2 +016000 03 PARDOT-X PIC X VALUE SPACE. IX2184.2 +016100 03 DOTVALUE PIC 99 VALUE ZERO. IX2184.2 +016200 02 FILLER PIC X(8) VALUE SPACE. IX2184.2 +016300 02 RE-MARK PIC X(61). IX2184.2 +016400 01 TEST-COMPUTED. IX2184.2 +016500 02 FILLER PIC X(30) VALUE SPACE. IX2184.2 +016600 02 FILLER PIC X(17) VALUE IX2184.2 +016700 " COMPUTED=". IX2184.2 +016800 02 COMPUTED-X. IX2184.2 +016900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2184.2 +017000 03 COMPUTED-N REDEFINES COMPUTED-A IX2184.2 +017100 PIC -9(9).9(9). IX2184.2 +017200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2184.2 +017300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2184.2 +017400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2184.2 +017500 03 CM-18V0 REDEFINES COMPUTED-A. IX2184.2 +017600 04 COMPUTED-18V0 PIC -9(18). IX2184.2 +017700 04 FILLER PIC X. IX2184.2 +017800 03 FILLER PIC X(50) VALUE SPACE. IX2184.2 +017900 01 TEST-CORRECT. IX2184.2 +018000 02 FILLER PIC X(30) VALUE SPACE. IX2184.2 +018100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2184.2 +018200 02 CORRECT-X. IX2184.2 +018300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2184.2 +018400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2184.2 +018500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2184.2 +018600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2184.2 +018700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2184.2 +018800 03 CR-18V0 REDEFINES CORRECT-A. IX2184.2 +018900 04 CORRECT-18V0 PIC -9(18). IX2184.2 +019000 04 FILLER PIC X. IX2184.2 +019100 03 FILLER PIC X(2) VALUE SPACE. IX2184.2 +019200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2184.2 +019300 01 CCVS-C-1. IX2184.2 +019400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2184.2 +019500- "SS PARAGRAPH-NAME IX2184.2 +019600- " REMARKS". IX2184.2 +019700 02 FILLER PIC X(20) VALUE SPACE. IX2184.2 +019800 01 CCVS-C-2. IX2184.2 +019900 02 FILLER PIC X VALUE SPACE. IX2184.2 +020000 02 FILLER PIC X(6) VALUE "TESTED". IX2184.2 +020100 02 FILLER PIC X(15) VALUE SPACE. IX2184.2 +020200 02 FILLER PIC X(4) VALUE "FAIL". IX2184.2 +020300 02 FILLER PIC X(94) VALUE SPACE. IX2184.2 +020400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2184.2 +020500 01 REC-CT PIC 99 VALUE ZERO. IX2184.2 +020600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2184.2 +021000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2184.2 +021100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2184.2 +021200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2184.2 +021300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2184.2 +021400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2184.2 +021500 01 CCVS-H-1. IX2184.2 +021600 02 FILLER PIC X(39) VALUE SPACES. IX2184.2 +021700 02 FILLER PIC X(42) VALUE IX2184.2 +021800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2184.2 +021900 02 FILLER PIC X(39) VALUE SPACES. IX2184.2 +022000 01 CCVS-H-2A. IX2184.2 +022100 02 FILLER PIC X(40) VALUE SPACE. IX2184.2 +022200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2184.2 +022300 02 FILLER PIC XXXX VALUE IX2184.2 +022400 "4.2 ". IX2184.2 +022500 02 FILLER PIC X(28) VALUE IX2184.2 +022600 " COPY - NOT FOR DISTRIBUTION". IX2184.2 +022700 02 FILLER PIC X(41) VALUE SPACE. IX2184.2 +022800 IX2184.2 +022900 01 CCVS-H-2B. IX2184.2 +023000 02 FILLER PIC X(15) VALUE IX2184.2 +023100 "TEST RESULT OF ". IX2184.2 +023200 02 TEST-ID PIC X(9). IX2184.2 +023300 02 FILLER PIC X(4) VALUE IX2184.2 +023400 " IN ". IX2184.2 +023500 02 FILLER PIC X(12) VALUE IX2184.2 +023600 " HIGH ". IX2184.2 +023700 02 FILLER PIC X(22) VALUE IX2184.2 +023800 " LEVEL VALIDATION FOR ". IX2184.2 +023900 02 FILLER PIC X(58) VALUE IX2184.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +024100 01 CCVS-H-3. IX2184.2 +024200 02 FILLER PIC X(34) VALUE IX2184.2 +024300 " FOR OFFICIAL USE ONLY ". IX2184.2 +024400 02 FILLER PIC X(58) VALUE IX2184.2 +024500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2184.2 +024600 02 FILLER PIC X(28) VALUE IX2184.2 +024700 " COPYRIGHT 1985 ". IX2184.2 +024800 01 CCVS-E-1. IX2184.2 +024900 02 FILLER PIC X(52) VALUE SPACE. IX2184.2 +025000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2184.2 +025100 02 ID-AGAIN PIC X(9). IX2184.2 +025200 02 FILLER PIC X(45) VALUE SPACES. IX2184.2 +025300 01 CCVS-E-2. IX2184.2 +025400 02 FILLER PIC X(31) VALUE SPACE. IX2184.2 +025500 02 FILLER PIC X(21) VALUE SPACE. IX2184.2 +025600 02 CCVS-E-2-2. IX2184.2 +025700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2184.2 +025800 03 FILLER PIC X VALUE SPACE. IX2184.2 +025900 03 ENDER-DESC PIC X(44) VALUE IX2184.2 +026000 "ERRORS ENCOUNTERED". IX2184.2 +026100 01 CCVS-E-3. IX2184.2 +026200 02 FILLER PIC X(22) VALUE IX2184.2 +026300 " FOR OFFICIAL USE ONLY". IX2184.2 +026400 02 FILLER PIC X(12) VALUE SPACE. IX2184.2 +026500 02 FILLER PIC X(58) VALUE IX2184.2 +026600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +026700 02 FILLER PIC X(13) VALUE SPACE. IX2184.2 +026800 02 FILLER PIC X(15) VALUE IX2184.2 +026900 " COPYRIGHT 1985". IX2184.2 +027000 01 CCVS-E-4. IX2184.2 +027100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2184.2 +027200 02 FILLER PIC X(4) VALUE " OF ". IX2184.2 +027300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2184.2 +027400 02 FILLER PIC X(40) VALUE IX2184.2 +027500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2184.2 +027600 01 XXINFO. IX2184.2 +027700 02 FILLER PIC X(19) VALUE IX2184.2 +027800 "*** INFORMATION ***". IX2184.2 +027900 02 INFO-TEXT. IX2184.2 +028000 04 FILLER PIC X(8) VALUE SPACE. IX2184.2 +028100 04 XXCOMPUTED PIC X(20). IX2184.2 +028200 04 FILLER PIC X(5) VALUE SPACE. IX2184.2 +028300 04 XXCORRECT PIC X(20). IX2184.2 +028400 02 INF-ANSI-REFERENCE PIC X(48). IX2184.2 +028500 01 HYPHEN-LINE. IX2184.2 +028600 02 FILLER PIC IS X VALUE IS SPACE. IX2184.2 +028700 02 FILLER PIC IS X(65) VALUE IS "************************IX2184.2 +028800- "*****************************************". IX2184.2 +028900 02 FILLER PIC IS X(54) VALUE IS "************************IX2184.2 +029000- "******************************". IX2184.2 +029100 01 CCVS-PGM-ID PIC X(9) VALUE IX2184.2 +029200 "IX218A". IX2184.2 +029300 PROCEDURE DIVISION. IX2184.2 +029400 DECLARATIVES. IX2184.2 +029500 IX2184.2 +029600 READ-OPTIONAL-10 SECTION. IX2184.2 +029700 USE AFTER EXCEPTION PROCEDURE ON IX-FS1. IX2184.2 +029800 INPUT-PROCESS. IX2184.2 +029900 MOVE 1 TO EOF-FLAG. IX2184.2 +030000 IX2184.2 +030100 READ-OPTIONAL-23 SECTION. IX2184.2 +030200 USE AFTER EXCEPTION PROCEDURE ON IX-FS2. IX2184.2 +030300 INPUT-PROCESS. IX2184.2 +030400 MOVE 1 TO EOF-FLAG. IX2184.2 +030500 IX2184.2 +030600 END DECLARATIVES. IX2184.2 +030700 IX2184.2 +030800 CCVS1 SECTION. IX2184.2 +030900 OPEN-FILES. IX2184.2 +031000P OPEN I-O RAW-DATA. IX2184.2 +031100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2184.2 +031200P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2184.2 +031300P MOVE "ABORTED " TO C-ABORT. IX2184.2 +031400P ADD 1 TO C-NO-OF-TESTS. IX2184.2 +031500P ACCEPT C-DATE FROM DATE. IX2184.2 +031600P ACCEPT C-TIME FROM TIME. IX2184.2 +031700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2184.2 +031800PEND-E-1. IX2184.2 +031900P CLOSE RAW-DATA. IX2184.2 +032000 OPEN OUTPUT PRINT-FILE. IX2184.2 +032100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2184.2 +032200 MOVE SPACE TO TEST-RESULTS. IX2184.2 +032300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2184.2 +032400 GO TO CCVS1-EXIT. IX2184.2 +032500 CLOSE-FILES. IX2184.2 +032600P OPEN I-O RAW-DATA. IX2184.2 +032700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2184.2 +032800P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2184.2 +032900P MOVE "OK. " TO C-ABORT. IX2184.2 +033000P MOVE PASS-COUNTER TO C-OK. IX2184.2 +033100P MOVE ERROR-HOLD TO C-ALL. IX2184.2 +033200P MOVE ERROR-COUNTER TO C-FAIL. IX2184.2 +033300P MOVE DELETE-COUNTER TO C-DELETED. IX2184.2 +033400P MOVE INSPECT-COUNTER TO C-INSPECT. IX2184.2 +033500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2184.2 +033600PEND-E-2. IX2184.2 +033700P CLOSE RAW-DATA IX-FS1 IX-FS2. IX2184.2 +033800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2184.2 +033900 TERMINATE-CCVS. IX2184.2 +034000S EXIT PROGRAM. IX2184.2 +034100STERMINATE-CALL. IX2184.2 +034200 STOP RUN. IX2184.2 +034300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2184.2 +034400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2184.2 +034500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2184.2 +034600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2184.2 +034700 MOVE "****TEST DELETED****" TO RE-MARK. IX2184.2 +034800 PRINT-DETAIL. IX2184.2 +034900 IF REC-CT NOT EQUAL TO ZERO IX2184.2 +035000 MOVE "." TO PARDOT-X IX2184.2 +035100 MOVE REC-CT TO DOTVALUE. IX2184.2 +035200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2184.2 +035300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2184.2 +035400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2184.2 +035500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2184.2 +035600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2184.2 +035700 MOVE SPACE TO CORRECT-X. IX2184.2 +035800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2184.2 +035900 MOVE SPACE TO RE-MARK. IX2184.2 +036000 HEAD-ROUTINE. IX2184.2 +036100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2184.2 +036400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2184.2 +036500 COLUMN-NAMES-ROUTINE. IX2184.2 +036600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +036700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +036900 END-ROUTINE. IX2184.2 +037000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2184.2 +037100 END-RTN-EXIT. IX2184.2 +037200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +037300 END-ROUTINE-1. IX2184.2 +037400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2184.2 +037500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2184.2 +037600 ADD PASS-COUNTER TO ERROR-HOLD. IX2184.2 +037700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2184.2 +037800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2184.2 +037900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2184.2 +038000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2184.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2184.2 +038200 END-ROUTINE-12. IX2184.2 +038300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2184.2 +038400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2184.2 +038500 MOVE "NO " TO ERROR-TOTAL IX2184.2 +038600 ELSE IX2184.2 +038700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2184.2 +038800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2184.2 +038900 PERFORM WRITE-LINE. IX2184.2 +039000 END-ROUTINE-13. IX2184.2 +039100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2184.2 +039200 MOVE "NO " TO ERROR-TOTAL ELSE IX2184.2 +039300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2184.2 +039400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2184.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +039600 IF INSPECT-COUNTER EQUAL TO ZERO IX2184.2 +039700 MOVE "NO " TO ERROR-TOTAL IX2184.2 +039800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2184.2 +039900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2184.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +040100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +040200 WRITE-LINE. IX2184.2 +040300 ADD 1 TO RECORD-COUNT. IX2184.2 +040400Y IF RECORD-COUNT GREATER 42 IX2184.2 +040500Y MOVE DUMMY-RECORD TO DUMMY-HOLD IX2184.2 +040600Y MOVE SPACE TO DUMMY-RECORD IX2184.2 +040700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2184.2 +040800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2184.2 +040900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2184.2 +041000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2184.2 +041100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2184.2 +041200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041500Y MOVE DUMMY-HOLD TO DUMMY-RECORD IX2184.2 +041600Y MOVE ZERO TO RECORD-COUNT. IX2184.2 +041700 PERFORM WRT-LN. IX2184.2 +041800 WRT-LN. IX2184.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2184.2 +042000 MOVE SPACE TO DUMMY-RECORD. IX2184.2 +042100 BLANK-LINE-PRINT. IX2184.2 +042200 PERFORM WRT-LN. IX2184.2 +042300 FAIL-ROUTINE. IX2184.2 +042400 IF COMPUTED-X NOT EQUAL TO SPACE IX2184.2 +042500 GO TO FAIL-ROUTINE-WRITE. IX2184.2 +042600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2184.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2184.2 +042800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2184.2 +042900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2184.2 +043100 GO TO FAIL-ROUTINE-EX. IX2184.2 +043200 FAIL-ROUTINE-WRITE. IX2184.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2184.2 +043400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2184.2 +043500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2184.2 +043600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2184.2 +043700 FAIL-ROUTINE-EX. EXIT. IX2184.2 +043800 BAIL-OUT. IX2184.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2184.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2184.2 +044100 BAIL-OUT-WRITE. IX2184.2 +044200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2184.2 +044300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2184.2 +044400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +044500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2184.2 +044600 BAIL-OUT-EX. EXIT. IX2184.2 +044700 CCVS1-EXIT. IX2184.2 +044800 EXIT. IX2184.2 +044900 IX2184.2 +045000******************************************************************IX2184.2 +045100* TEST 1 *IX2184.2 +045200* READ (ACCESS IS SEQUENTIAL) OPTIONAL NOT EXISTING FILEIX2184.2 +045300* 10 EXPECTED *IX2184.2 +045400* IX-4, 1.3.4 (2) A 2); *IX2184.2 +045500* IX-29, 4.5.4 GR (4) B; *IX2184.2 +045600* IX-30, 4.5.4 GR (10) A; *IX2184.2 +045700* IX-30, 4.5.4 GR (10) B; *IX2184.2 +045800******************************************************************IX2184.2 +045900 SECT-IX-01-001 SECTION. IX2184.2 +046000 REA-INIT-F1-01. IX2184.2 +046100 MOVE ZERO TO EOF-FLAG. IX2184.2 +046200 MOVE SPACES TO IX-FS1-STATUS. IX2184.2 +046300 MOVE "READ OPTION. 10 EXP." TO FEATURE. IX2184.2 +046400 MOVE "REA-TEST-F1-01 " TO PAR-NAME. IX2184.2 +046500 OPEN INPUT IX-FS1. IX2184.2 +046600 REA-TEST-F1-01. IX2184.2 +046700 READ IX-FS1 AT END GO TO REA-TEST-F1-01-1. IX2184.2 +046800 REA-TEST-F1-01-1. IX2184.2 +046900 IF IX-FS1-STATUS EQUAL TO "10" IX2184.2 +047000 GO TO REA-PASS-F1-01. IX2184.2 +047100 REA-FAIL-F1-01. IX2184.2 +047200 MOVE "IX-4, 1.3.4, (2) A 2); IX-29 GR (4) B IX-30 GR (10) A,IX2184.2 +047300- " B" TO RE-MARK. IX2184.2 +047400 PERFORM FAIL. IX2184.2 +047500 MOVE IX-FS1-STATUS TO COMPUTED-A. IX2184.2 +047600 MOVE "10" TO CORRECT-X. IX2184.2 +047700 GO TO REA-WRITE-F1-01. IX2184.2 +047800 REA-PASS-F1-01. IX2184.2 +047900 PERFORM PASS. IX2184.2 +048000 REA-WRITE-F1-01. IX2184.2 +048100 PERFORM PRINT-DETAIL. IX2184.2 +048200 IX2184.2 +048300******************************************************************IX2184.2 +048400* TEST 2 *IX2184.2 +048500* READ I-O (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2184.2 +048600* *IX2184.2 +048700* IX-30, GR (10) B *IX2184.2 +048800******************************************************************IX2184.2 +048900 REA-INIT-GF-02. IX2184.2 +049000 MOVE "REA-TEST-GF-02 " TO PAR-NAME. IX2184.2 +049100 MOVE "NO USE MUST BE EXEC." TO FEATURE. IX2184.2 +049200 REA-TEST-GF-02. IX2184.2 +049300 IF EOF-FLAG EQUAL TO 0 IX2184.2 +049400 GO TO REA-PASS-GF-02. IX2184.2 +049500 REA-FAIL-GF-02. IX2184.2 +049600 MOVE "IX-30, GR (10) B; 1: USE PROCEDURE HAS BEEN EXECUTED" IX2184.2 +049700 TO RE-MARK. IX2184.2 +049800 PERFORM FAIL. IX2184.2 +049900 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +050000 MOVE " 0" TO CORRECT-X. IX2184.2 +050100 GO TO REA-WRITE-GF-02. IX2184.2 +050200 REA-PASS-GF-02. IX2184.2 +050300 PERFORM PASS. IX2184.2 +050400 REA-WRITE-GF-02. IX2184.2 +050500 PERFORM PRINT-DETAIL. IX2184.2 +050600 IX2184.2 +050700******************************************************************IX2184.2 +050800* TEST 3 *IX2184.2 +050900* START (FOR AN OPTIONAL FILE WHICH IS NOT PRESENT) *IX2184.2 +051000* IX-4, 1.3.4 (3) C 2) 23 EXPECTED *IX2184.2 +051100******************************************************************IX2184.2 +051200 STA-INIT-GF-01. IX2184.2 +051300 MOVE ZERO TO EOF-FLAG. IX2184.2 +051400 MOVE SPACES TO IX-FS2-STATUS. IX2184.2 +051500 MOVE "STA-TEST-GF-01 " TO PAR-NAME. IX2184.2 +051600 MOVE "START OPT. 23 EXP." TO FEATURE. IX2184.2 +051700 OPEN INPUT IX-FS2. IX2184.2 +051800 STA-TEST-GF-01. IX2184.2 +051900 START IX-FS2 INVALID KEY GO TO STA-TEST-GF-01-1. IX2184.2 +052000 STA-TEST-GF-01-1. IX2184.2 +052100 IF IX-FS2-STATUS EQUAL TO "23" IX2184.2 +052200 GO TO STA-PASS-GF-01. IX2184.2 +052300 STA-FAIL-GF-01. IX2184.2 +052400 MOVE "IX-4, 1.3.4,(3) C 2)" TO RE-MARK. IX2184.2 +052500 PERFORM FAIL. IX2184.2 +052600 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2184.2 +052700 MOVE "23" TO CORRECT-X. IX2184.2 +052800 GO TO STA-WRITE-GF-01. IX2184.2 +052900 STA-PASS-GF-01. IX2184.2 +053000 PERFORM PASS. IX2184.2 +053100 STA-WRITE-GF-01. IX2184.2 +053200 PERFORM PRINT-DETAIL. IX2184.2 +053300 IX2184.2 +053400******************************************************************IX2184.2 +053500* TEST 4 *IX2184.2 +053600* START (NO USE PROCEDURE MUST BE EXECUTED BECAUSE *IX2184.2 +053700* THE INVALID KEY PHRASE IS SPECIFIED) *IX2184.2 +053800* IX-37, 4.7.4, (5), (6) AND (7) *IX2184.2 +053900******************************************************************IX2184.2 +054000 STA-INIT-GF-02. IX2184.2 +054100 MOVE "STA-TEST-GF-02 " TO PAR-NAME. IX2184.2 +054200 MOVE "START NO USE EXP." TO FEATURE. IX2184.2 +054300 STA-TEST-GF-02. IX2184.2 +054400 IF EOF-FLAG EQUAL TO ZERO IX2184.2 +054500 GO TO STA-PASS-GF-02. IX2184.2 +054600 STA-FAIL-GF-02. IX2184.2 +054700 MOVE "IX-37 4.7.4,(5,6,7); 1:USE PROCEDURE HAS BEEN EXECUTED"IX2184.2 +054800 TO RE-MARK. IX2184.2 +054900 PERFORM FAIL. IX2184.2 +055000 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +055100 MOVE "0" TO CORRECT-X. IX2184.2 +055200 GO TO STA-WRITE-GF-02. IX2184.2 +055300 STA-PASS-GF-02. IX2184.2 +055400 PERFORM PASS. IX2184.2 +055500 STA-WRITE-GF-02. IX2184.2 +055600 PERFORM PRINT-DETAIL. IX2184.2 +055700 IX2184.2 +055800******************************************************************IX2184.2 +055900* TEST 5 *IX2184.2 +056000* READ (RANDOM) (FOR AN OPTIONAL FILE WHICH IS NOT PRESENT) *IX2184.2 +056100* IX-4, 1.3.4 (3) C 2) *IX2184.2 +056200******************************************************************IX2184.2 +056300 REA-INIT-GF-03. IX2184.2 +056400 MOVE ZERO TO EOF-FLAG. IX2184.2 +056500 MOVE SPACES TO IX-FS2-STATUS. IX2184.2 +056600 MOVE "REA-TEST-GF-03 " TO PAR-NAME. IX2184.2 +056700 MOVE "RANDOM READ 23 EXP." TO FEATURE. IX2184.2 +056800 REA-TEST-GF-03. IX2184.2 +056900 READ IX-FS2 INVALID KEY GO TO REA-TEST-GF-03-1. IX2184.2 +057000 REA-TEST-GF-03-1. IX2184.2 +057100 IF IX-FS2-STATUS EQUAL TO "23" IX2184.2 +057200 GO TO REA-PASS-GF-03. IX2184.2 +057300 REA-FAIL-GF-03. IX2184.2 +057400 MOVE "IX-4, 1.3.4,(3) C 2); IX-36 4.7.4,GR (1), (5), (6) AND IX2184.2 +057500- " (7)" TO RE-MARK. IX2184.2 +057600 PERFORM FAIL. IX2184.2 +057700 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2184.2 +057800 MOVE "23" TO CORRECT-X. IX2184.2 +057900 GO TO REA-WRITE-GF-03. IX2184.2 +058000 REA-PASS-GF-03. IX2184.2 +058100 PERFORM PASS. IX2184.2 +058200 REA-WRITE-GF-03. IX2184.2 +058300 PERFORM PRINT-DETAIL. IX2184.2 +058400 IX2184.2 +058500******************************************************************IX2184.2 +058600* TEST 6 *IX2184.2 +058700* READ (RANDOM) NO USE PROCEDURE MUST BE EXECUTED BECAUSE*IX2184.2 +058800* THE INVALID KEY PHRASE IS SPECIFIED) *IX2184.2 +058900* IX-29, 4.5.4, GR (4) B, (17) *IX2184.2 +059000******************************************************************IX2184.2 +059100 REA-INIT-GF-04. IX2184.2 +059200 MOVE "REA-TEST-GF-04 " TO PAR-NAME. IX2184.2 +059300 MOVE "RANDOM READ (NO USE)" TO FEATURE. IX2184.2 +059400 REA-TEST-GF-04. IX2184.2 +059500 IF EOF-FLAG EQUAL TO ZERO IX2184.2 +059600 GO TO REA-PASS-GF-04. IX2184.2 +059700 REA-FAIL-GF-04. IX2184.2 +059800 MOVE "IX-29 4.5.4, GR (4) B, (17); 1: USE PROCEDURE HAS BEEN IX2184.2 +059900- "EXECUTED" TO RE-MARK. IX2184.2 +060000 PERFORM FAIL. IX2184.2 +060100 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +060200 MOVE "0" TO CORRECT-X. IX2184.2 +060300 GO TO REA-WRITE-GF-04. IX2184.2 +060400 REA-PASS-GF-04. IX2184.2 +060500 PERFORM PASS. IX2184.2 +060600 REA-WRITE-GF-04. IX2184.2 +060700 PERFORM PRINT-DETAIL. IX2184.2 +060800 IX2184.2 +060900 IX2184.2 +061000 IX2184.2 +061100 CCVS-EXIT SECTION. IX2184.2 +061200 CCVS-999999. IX2184.2 +061300 GO TO CLOSE-FILES. IX2184.2 +*END-OF,IX218A +*HEADER,COBOL,IX301M +000100 IDENTIFICATION DIVISION. IX3014.2 +000200 PROGRAM-ID. IX3014.2 +000300 IX301M. IX3014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF INTERMEDIATE IX3014.2 +000500*SUBSET FEATURES THAT ARE USED IN LEVEL 1 INDEXED IX3014.2 +000600*INPUT-OUTPUT. IX3014.2 +000700 ENVIRONMENT DIVISION. IX3014.2 +000800 CONFIGURATION SECTION. IX3014.2 +000900 SOURCE-COMPUTER. IX3014.2 +001000 XXXXX082. IX3014.2 +001100 OBJECT-COMPUTER. IX3014.2 +001200 XXXXX083. IX3014.2 +001300 INPUT-OUTPUT SECTION. IX3014.2 +001400 FILE-CONTROL. IX3014.2 +001500 SELECT TFIL ASSIGN IX3014.2 +001600 XXXXX024 IX3014.2 +001700 ORGANIZATION IS INDEXED IX3014.2 +001800*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +001900 IX3014.2 +002000 ACCESS MODE IS RANDOM IX3014.2 +002100*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +002200 IX3014.2 +002300 RECORD KEY IS RKEY. IX3014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +002500 IX3014.2 +002600 DATA DIVISION. IX3014.2 +002700 FILE SECTION. IX3014.2 +002800 FD TFIL. IX3014.2 +002900 01 FREC. IX3014.2 +003000 03 RKEY PIC X(8). IX3014.2 +003100 IX3014.2 +003200 WORKING-STORAGE SECTION. IX3014.2 +003300 01 VARIABLES. IX3014.2 +003400 03 STATE PIC X(4) VALUE SPACES. IX3014.2 +003500 IX3014.2 +003600 PROCEDURE DIVISION. IX3014.2 +003700 IX3014.2 +003800 IX301M-CONTROL. IX3014.2 +003900 OPEN I-O TFIL. IX3014.2 +004000 PERFORM IX301M-READ THRU IX301M-DELETE 1 TIMES. IX3014.2 +004100 CLOSE TFIL. IX3014.2 +004200 STOP RUN. IX3014.2 +004300 IX3014.2 +004400 IX301M-READ. IX3014.2 +004500 READ TFIL INVALID KEY PERFORM INV-PARA IX3014.2 +004600 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +004700*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +004800 IX3014.2 +004900 IX301M-REWRITE. IX3014.2 +005000 REWRITE FREC INVALID KEY PERFORM INV-PARA IX3014.2 +005100 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +005200*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +005300 IX3014.2 +005400 IX301M-WRITE. IX3014.2 +005500 WRITE FREC INVALID KEY PERFORM INV-PARA IX3014.2 +005600 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +005700*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +005800 IX3014.2 +005900 IX301M-DELETE. IX3014.2 +006000 DELETE TFIL INVALID KEY PERFORM INV-PARA IX3014.2 +006100 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +006200*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +006300 IX3014.2 +006400 INV-PARA. IX3014.2 +006500 MOVE "INVA" TO STATE. IX3014.2 +006600 IX3014.2 +006700 DONE-PARA. IX3014.2 +006800 MOVE "DONE" TO STATE. IX3014.2 +006900 IX3014.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 7. IX3014.2 +*END-OF,IX301M +*HEADER,COBOL,IX302M +000100 IDENTIFICATION DIVISION. IX3024.2 +000200 PROGRAM-ID. IX3024.2 +000300 IX302M. IX3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF IX3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN INTERMEDIATE SUBSET INDEXED IX3024.2 +000600*INPUT-OUTPUT. IX3024.2 +000700 ENVIRONMENT DIVISION. IX3024.2 +000800 CONFIGURATION SECTION. IX3024.2 +000900 SOURCE-COMPUTER. IX3024.2 +001000 XXXXX082. IX3024.2 +001100 OBJECT-COMPUTER. IX3024.2 +001200 XXXXX083. IX3024.2 +001300 INPUT-OUTPUT SECTION. IX3024.2 +001400 FILE-CONTROL. IX3024.2 +001500 SELECT TFIL ASSIGN IX3024.2 +001600 XXXXX024 IX3024.2 +001700 ORGANIZATION IS INDEXED IX3024.2 +001800 ACCESS MODE IS SEQUENTIAL IX3024.2 +001900 RECORD KEY IS RKEY. IX3024.2 +002000 IX3024.2 +002100 SELECT SQ-FRR ASSIGN IX3024.2 +002200 XXXXX013. IX3024.2 +002300 IX3024.2 +002400 IX3024.2 +002500 SELECT RR-FS1 ASSIGN IX3024.2 +002600 XXXXX024 IX3024.2 +002700 ORGANIZATION IS INDEXED IX3024.2 +002800 RECORD KEY IS FKEY. IX3024.2 +002900 I-O-CONTROL. IX3024.2 +003000 XXXXX053. IX3024.2 +003100*Message expected for above statement: OBSOLETE IX3024.2 +003200 IX3024.2 +003300 DATA DIVISION. IX3024.2 +003400 FILE SECTION. IX3024.2 +003500 FD TFIL IX3024.2 +003600 LABEL RECORDS STANDARD IX3024.2 +003700*Message expected for above statement: OBSOLETE IX3024.2 +003800 IX3024.2 +003900 VALUE OF IX3024.2 +004000 XXXXX074 IX3024.2 +004100 IS IX3024.2 +004200 XXXXX075 IX3024.2 +004300*Message expected for above statement: OBSOLETE IX3024.2 +004400 IX3024.2 +004500 DATA RECORDS ARE FREC. IX3024.2 +004600*Message expected for above statement: OBSOLETE IX3024.2 +004700 IX3024.2 +004800 01 FREC. IX3024.2 +004900 03 RKEY PIC X(8). IX3024.2 +005000 IX3024.2 +005100 FD SQ-FRR. IX3024.2 +005200 01 SREC. IX3024.2 +005300 03 SKEY PIC X(8). IX3024.2 +005400 IX3024.2 +005500 IX3024.2 +005600 FD RR-FS1. IX3024.2 +005700 01 RREC. IX3024.2 +005800 03 FKEY PIC X(8). IX3024.2 +005900 IX3024.2 +006000 WORKING-STORAGE SECTION. IX3024.2 +006100 01 VARIABLES. IX3024.2 +006200 03 VKEY PIC 9(8) VALUE ZERO. IX3024.2 +006300 03 DKEY PIC 9(8) VALUE ZERO. IX3024.2 +006400 IX3024.2 +006500 PROCEDURE DIVISION. IX3024.2 +006600 IX3024.2 +006700 IX302M-CONTROL. IX3024.2 +006800 DISPLAY "THIS IS A DUMMY PARAGRAPH". IX3024.2 +006900 STOP RUN. IX3024.2 +007000 IX3024.2 +007100*TOTAL NUMBER OF FLAGS EXPECTED = 4. IX3024.2 +*END-OF,IX302M +*HEADER,COBOL,IX401M +000100 IDENTIFICATION DIVISION. IX4014.2 +000200 PROGRAM-ID. IX4014.2 +000300 IX401M. IX4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH IX4014.2 +000500*SUBSET FEATURES THAT ARE USED IN INDEXED IX4014.2 +000600*INPUT-OUTPUT. IX4014.2 +000700 ENVIRONMENT DIVISION. IX4014.2 +000800 CONFIGURATION SECTION. IX4014.2 +000900 SOURCE-COMPUTER. IX4014.2 +001000 XXXXX082. IX4014.2 +001100 OBJECT-COMPUTER. IX4014.2 +001200 XXXXX083. IX4014.2 +001300 INPUT-OUTPUT SECTION. IX4014.2 +001400 FILE-CONTROL. IX4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN IX4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +001700 IX4014.2 +001800 XXXXX025 IX4014.2 +001900 RESERVE 2 AREAS IX4014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002100 IX4014.2 +002200 ORGANIZATION IS INDEXED IX4014.2 +002300 ACCESS MODE IS DYNAMIC IX4014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002500 IX4014.2 +002600 RECORD KEY IS RKEY IX4014.2 +002700 ALTERNATE RECORD KEY IS BEANO. IX4014.2 +002800*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002900 IX4014.2 +003000 SELECT TFIL2 ASSIGN IX4014.2 +003100 XXXXX026 IX4014.2 +003200 ORGANIZATION IS INDEXED IX4014.2 +003300 ACCESS MODE IS SEQUENTIAL IX4014.2 +003400 RECORD KEY IS RKEY2. IX4014.2 +003500 IX4014.2 +003600 DATA DIVISION. IX4014.2 +003700 FILE SECTION. IX4014.2 +003800 FD TFIL IX4014.2 +003900 RECORD IS VARYING IN SIZE FROM 18 TO 36 CHARACTERS. IX4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +004100 IX4014.2 +004200 01 FREC. IX4014.2 +004300 03 RKEY PIC X(8). IX4014.2 +004400 03 BEANO PIC X(10). IX4014.2 +004500 IX4014.2 +004600 FD TFIL2. IX4014.2 +004700 01 FREC2. IX4014.2 +004800 03 RKEY2 PIC X(8). IX4014.2 +004900 IX4014.2 +005000 PROCEDURE DIVISION. IX4014.2 +005100 IX4014.2 +005200 IX401M-CONTROL. IX4014.2 +005300 OPEN INPUT TFIL. IX4014.2 +005400 PERFORM IX401M-CLOSE THRU IX401M-START. IX4014.2 +005500 CLOSE TFIL. IX4014.2 +005600 CLOSE TFIL2. IX4014.2 +005700 STOP RUN. IX4014.2 +005800 IX4014.2 +005900 IX401M-CLOSE. IX4014.2 +006000 CLOSE TFIL WITH LOCK. IX4014.2 +006100*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +006200 IX4014.2 +006300 IX401M-OPENEXT. IX4014.2 +006400 OPEN EXTEND TFIL2. IX4014.2 +006500*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +006600 IX4014.2 +006700 IX401M-READNEXT. IX4014.2 +006800 OPEN INPUT TFIL. IX4014.2 +006900 READ TFIL NEXT RECORD IX4014.2 +007000 AT END DISPLAY "AT END". IX4014.2 +007100*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +007200 IX4014.2 +007300 IX401M-READKEY. IX4014.2 +007400 READ TFIL RECORD IX4014.2 +007500 KEY IS RKEY IX4014.2 +007600 INVALID KEY DISPLAY "INVALID". IX4014.2 +007700*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +007800 IX4014.2 +007900 IX401M-START. IX4014.2 +008000 START TFIL KEY IS EQUAL TO RKEY IX4014.2 +008100 INVALID KEY DISPLAY "INVALID". IX4014.2 +008200*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +008300 IX4014.2 +008400*TOTAL NUMBER OF FLAGS EXPECTED = 10. IX4014.2 +*END-OF,IX401M +*HEADER,CLBRY,K101A +000100 . K101A4.2 +000200 02 TST-FLD-1 PICTURE 9(5). K101A4.2 +000300 02 FILLER PICTURE X(115). K101A4.2 +*END-OF,K101A +*HEADER,CLBRY,K1DAA +000100 SELECT RL-FS1 K1DAA4.2 +000200 ASSIGN TO K1DAA4.2 +000300 XXXXX021 K1DAA4.2 +000400 ORGANIZATION IS RELATIVE K1DAA4.2 +000500 ACCESS IS SEQUENTIAL. K1DAA4.2 +*END-OF,K1DAA +*HEADER,CLBRY,K1FDA +000100 LABEL RECORDS STANDARD K1FDA4.2 +000200C VALUE OF K1FDA4.2 +000300C XXXXX074 K1FDA4.2 +000400C IS K1FDA4.2 +000500C XXXXX075 K1FDA4.2 +000600G XXXXX069 K1FDA4.2 +000700 DATA RECORD IS TST-TEST. K1FDA4.2 +*END-OF,K1FDA +*HEADER,CLBRY,K1P01 +000100 RCD-1 K1P014.2 +*END-OF,K1P01 +*HEADER,CLBRY,K1PRA +000100 MOVE PROC-1 TO PROC-2. K1PRA4.2 +*END-OF,K1PRA +*HEADER,CLBRY,K1PRB +000100 MOVE WSTR4C TO WSTR91. K1PRB4.2 +000200 MOVE WSTR4B TO WSTR93. K1PRB4.2 +000300 MOVE WSTR4A TO WSTR92. K1PRB4.2 +*END-OF,K1PRB +*HEADER,CLBRY,K1PRC +000100 IF Z-E-R-O-E-S EQUAL TO O-N-E - 1 K1PRC4.2 +*END-OF,K1PRC +*HEADER,CLBRY,K1SEA +000100 SECT-COPY-1. K1SEA4.2 +000200 MOVE 95427 TO COPYSECT-1. K1SEA4.2 +000300 SECT-COPY-2. K1SEA4.2 +000400 MOVE 23121 TO COPYSECT-2. K1SEA4.2 +000500 SECT-COPY-3. K1SEA4.2 +000600 MOVE "LIBCO" TO COPYSECT-3. K1SEA4.2 +000700 SECT-COPY-4. K1SEA4.2 +000800 MOVE "PYTST" TO COPYSECT-4. K1SEA4.2 +*END-OF,K1SEA +*HEADER,CLBRY,K1W01 +000100 PICTURE 9(5) VALUE 97523. K1W014.2 +000200 77 RCD-2 PICTURE 9(5) VALUE 23497. K1W014.2 +*END-OF,K1W01 +*HEADER,CLBRY,K1W02 +000100 RCD-4 PIC 9(5) VALUE 02734. K1W024.2 +000200 77 RCD-5 PICTURE IS 99999 VALUE IS K1W024.2 +*END-OF,K1W02 +*HEADER,CLBRY,K1W03 +000100 RCD-7 PIC 9(5) K1W034.2 +*END-OF,K1W03 +*HEADER,CLBRY,K1W04 +000100 01 GRP-001. K1W044.2 +000200 02 WRK-DS-05V00 PIC S9(5) K1W044.2 +000300 VALUE K1W044.2 +000400 IS K1W044.2 +000500 ZERO. K1W044.2 +*END-OF,K1W04 +*HEADER,CLBRY,K1WKA +000100 02 WSTR-2A PICTURE X(3) VALUE "AK1WKA4.2 +000200- "BC". K1WKA4.2 +*END-OF,K1WKA +*HEADER,CLBRY,K1WKB +000100 02 WSTR4A PICTURE XXX VALUE "ABC". K1WKB4.2 +000200 02 WSTR4B PICTURE XXX VALUE "DEF". K1WKB4.2 +000300 02 WSTR4C PICTURE XXX VALUE "GHI". K1WKB4.2 +*END-OF,K1WKB +*HEADER,CLBRY,K1WKC +000100 01 Z-E-R-O-E-S PICTURE 9(2) VALUE ZEROES. K1WKC4.2 +000200 01 O-N-E PICTURE 9(2) VALUE 01. K1WKC4.2 +*END-OF,K1WKC +*HEADER,CLBRY,K1WKY +000100 02 WSTR-2A PICTURE XXX VALUE "AK1WKY4.2 +000200- "BC". K1WKY4.2 +*END-OF,K1WKY +*HEADER,CLBRY,K1WKZ +000100 02 WSTR4A PICTURE XXX VALUE "ABC". K1WKZ4.2 +000200 02 WSTR4B PICTURE XXX VALUE "DEF". K1WKZ4.2 +000300 02 WSTR4C PICTURE XXX VALUE "GHI". K1WKZ4.2 +*END-OF,K1WKZ +*HEADER,CLBRY,K2PRA +000100 MOVE FALSE-DATA-1 TO AREA-1. K2PRA4.2 +000200 MOVE FALSE-DATA-2 TO AREA-2. K2PRA4.2 +000300 MOVE FALSE-DATA-3 TO AREA-3. K2PRA4.2 +000400 MOVE FALSE-DATA-4 TO AREA-4. K2PRA4.2 +000500 IF TOTAL-AREA EQUAL TO "TRUE TWO + 2 = 4" K2PRA4.2 +000600 PERFORM PASS ELSE PERFORM FAIL. K2PRA4.2 +000700 GO TO COPY-WRITE-16. K2PRA4.2 +*END-OF,K2PRA +*HEADER,CLBRY,K2SEA +000100 PARA-1. K2SEA4.2 +000200 ALTER PARA-X TO PROCEED TO PARA-4. K2SEA4.2 +000300 PARA-2. K2SEA4.2 +000400 GO TO 12345. K2SEA4.2 +000500 12345. K2SEA4.2 +000600 PERFORM FAIL. K2SEA4.2 +000700 GO TO COPY-WRITE-15. K2SEA4.2 +000800 PARA-4. K2SEA4.2 +000900 PERFORM DUMMY-PASS. K2SEA4.2 +001000 GO TO COPY-WRITE-15. K2SEA4.2 +*END-OF,K2SEA +*HEADER,CLBRY,K3FCA +000100 SELECT TEST-FILE ASSIGN TO K3FCA4.2 +000200 XXXXP001. K3FCA4.2 +000300 SELECT TEST-FILE2 ASSIGN TO K3FCA4.2 +000400 XXXXP002. K3FCA4.2 +000500 SELECT PRINT-FILE ASSIGN TO K3FCA4.2 +000600 XXXXX055. K3FCA4.2 +*END-OF,K3FCA +*HEADER,CLBRY,K3FCB +000100 SELECT PRINT-FILE ASSIGN TO K3FCB4.2 +000200 XXXXX055. K3FCB4.2 +000300 SELECT DUMMY-TEST-FILE ASSIGN TO K3FCB4.2 +000400 XXXXP002. K3FCB4.2 +*END-OF,K3FCB +*HEADER,CLBRY,K3IOA +000100 SAME AREA FOR TEST-FILE K3IOA4.2 +000200 TEST-FILE2. K3IOA4.2 +*END-OF,K3IOA +*HEADER,CLBRY,K3IOB +000100 SAME RECORD AREA FOR TEST-FILE, DUMMY-PRINT-FILE. K3IOB4.2 +*END-OF,K3IOB +*HEADER,CLBRY,K3LGE +000100 MOVE 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADDK3LGE4.2 +000200 1 TO WRK-DU-99, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1K3LGE4.2 +000300 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 K3LGE4.2 +000400 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1 TO K3LGE4.2 +000500 WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 10 TO K3LGE4.2 +000600 WRK-DU-99-LONGER. K3LGE4.2 +*END-OF,K3LGE +*HEADER,CLBRY,K3OCA +000100 XXXXX083. K3OCA4.2 +*END-OF,K3OCA +*HEADER,CLBRY,K3SCA +000100 XXXXX082. K3SCA4.2 +*END-OF,K3SCA +*HEADER,CLBRY,K3SML +000100 8 K3SML4.2 +*END-OF,K3SML +*HEADER,CLBRY,K3SNA +000100 DECIMAL-POINT IS COMMA. K3SNA4.2 +*END-OF,K3SNA +*HEADER,CLBRY,K3SNB +000100 XXXXX051 K3SNB4.2 +000200 IS DUMMY-SW-1 K3SNB4.2 +000300 ON STATUS IS DUMMY-ON K3SNB4.2 +000400 OFF STATUS IS DUMMY-OFF. K3SNB4.2 +*END-OF,K3SNB +*HEADER,CLBRY,K4NTA +000100 NOTEPAR1-FAIL. K4NTA4.2 +000200 PERFORM FAIL. K4NTA4.2 +000300 GO TO COPY-WRITE-1. K4NTA4.2 +*END-OF,K4NTA +*HEADER,CLBRY,K501A +000100 02 KEYS-GROUP. K501A4.2 +000200 03 KEY-1 PICTURE 9. K501A4.2 +000300 03 KEY-2 PICTURE 99. K501A4.2 +000400 03 KEY-3 PICTURE 999. K501A4.2 +000500 03 KEY-4 PICTURE 9999. K501A4.2 +000600 03 KEY-5 PICTURE 99999. K501A4.2 +000700 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). K501A4.2 +000800 02 FILLER PICTURE X(105). K501A4.2 +*END-OF,K501A +*HEADER,CLBRY,K501B +000100 02 KEYS-GROUP. K501B4.2 +000200 03 KEY-A PICTURE 9. K501B4.2 +000300 03 KEY-2 PICTURE 99. K501B4.2 +000400 03 KEY-3 PICTURE 999. K501B4.2 +000500 03 KEY-4 PICTURE 9999. K501B4.2 +000600 03 KEY-5 PICTURE 99999. K501B4.2 +000700 02 XYZ-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). K501B4.2 +000800 02 FILLER PICTURE X(105). K501B4.2 +*END-OF,K501B +*HEADER,CLBRY,K5SDA +000100 DATA RECORD S-RECORD. K5SDA4.2 +*END-OF,K5SDA +*HEADER,CLBRY,K5SDB +000100 DATA RECORD J-RECORD. K5SDB4.2 +*END-OF,K5SDB +*HEADER,CLBRY,K6SCA +000100 CONFIGURATION SECTION. K6SCA4.2 +000200 SOURCE-COMPUTER. K6SCA4.2 +000300 XXXXX082. K6SCA4.2 +000400 OBJECT-COMPUTER. K6SCA4.2 +000500 XXXXX083. K6SCA4.2 +000600 INPUT-OUTPUT SECTION. K6SCA4.2 +000700 FILE-CONTROL. K6SCA4.2 +000800 SELECT PRINT-FILE ASSIGN TO K6SCA4.2 +000900 XXXXX055. K6SCA4.2 +001000 DATA DIVISION. K6SCA4.2 +001100 FILE SECTION. K6SCA4.2 +001200 FD PRINT-FILE. K6SCA4.2 +001300 01 PRINT-REC PICTURE X(120). K6SCA4.2 +001400 01 DUMMY-RECORD PICTURE X(120). K6SCA4.2 +001500 WORKING-STORAGE SECTION. K6SCA4.2 +001600 01 TEST-RESULTS. K6SCA4.2 +001700 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +001800 02 FEATURE PIC X(20) VALUE SPACE. K6SCA4.2 +001900 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +002000 02 P-OR-F PIC X(5) VALUE SPACE. K6SCA4.2 +002100 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +002200 02 PAR-NAME. K6SCA4.2 +002300 03 FILLER PIC X(19) VALUE SPACE. K6SCA4.2 +002400 03 PARDOT-X PIC X VALUE SPACE. K6SCA4.2 +002500 03 DOTVALUE PIC 99 VALUE ZERO. K6SCA4.2 +002600 02 FILLER PIC X(8) VALUE SPACE. K6SCA4.2 +002700 02 RE-MARK PIC X(61). K6SCA4.2 +002800 01 TEST-COMPUTED. K6SCA4.2 +002900 02 FILLER PIC X(30) VALUE SPACE. K6SCA4.2 +003000 02 FILLER PIC X(17) VALUE K6SCA4.2 +003100 " COMPUTED=". K6SCA4.2 +003200 02 COMPUTED-X. K6SCA4.2 +003300 03 COMPUTED-A PIC X(20) VALUE SPACE. K6SCA4.2 +003400 03 COMPUTED-N REDEFINES COMPUTED-A K6SCA4.2 +003500 PIC -9(9).9(9). K6SCA4.2 +003600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). K6SCA4.2 +003700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). K6SCA4.2 +003800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). K6SCA4.2 +003900 03 CM-18V0 REDEFINES COMPUTED-A. K6SCA4.2 +004000 04 COMPUTED-18V0 PIC -9(18). K6SCA4.2 +004100 04 FILLER PIC X. K6SCA4.2 +004200 03 FILLER PIC X(50) VALUE SPACE. K6SCA4.2 +004300 01 TEST-CORRECT. K6SCA4.2 +004400 02 FILLER PIC X(30) VALUE SPACE. K6SCA4.2 +004500 02 FILLER PIC X(17) VALUE " CORRECT =". K6SCA4.2 +004600 02 CORRECT-X. K6SCA4.2 +004700 03 CORRECT-A PIC X(20) VALUE SPACE. K6SCA4.2 +004800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). K6SCA4.2 +004900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). K6SCA4.2 +005000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). K6SCA4.2 +005100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). K6SCA4.2 +005200 03 CR-18V0 REDEFINES CORRECT-A. K6SCA4.2 +005300 04 CORRECT-18V0 PIC -9(18). K6SCA4.2 +005400 04 FILLER PIC X. K6SCA4.2 +005500 03 FILLER PIC X(2) VALUE SPACE. K6SCA4.2 +005600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. K6SCA4.2 +005700 01 CCVS-C-1. K6SCA4.2 +005800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAK6SCA4.2 +005900- "SS PARAGRAPH-NAME K6SCA4.2 +006000- " REMARKS". K6SCA4.2 +006100 02 FILLER PIC X(20) VALUE SPACE. K6SCA4.2 +006200 01 CCVS-C-2. K6SCA4.2 +006300 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +006400 02 FILLER PIC X(6) VALUE "TESTED". K6SCA4.2 +006500 02 FILLER PIC X(15) VALUE SPACE. K6SCA4.2 +006600 02 FILLER PIC X(4) VALUE "FAIL". K6SCA4.2 +006700 02 FILLER PIC X(94) VALUE SPACE. K6SCA4.2 +006800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. K6SCA4.2 +006900 01 REC-CT PIC 99 VALUE ZERO. K6SCA4.2 +007000 01 DELETE-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007100 01 ERROR-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007300 01 PASS-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007400 01 TOTAL-ERROR PIC 999 VALUE ZERO. K6SCA4.2 +007500 01 ERROR-HOLD PIC 999 VALUE ZERO. K6SCA4.2 +007600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. K6SCA4.2 +007700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. K6SCA4.2 +007800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. K6SCA4.2 +007900 01 CCVS-H-1. K6SCA4.2 +008000 02 FILLER PIC X(39) VALUE SPACES. K6SCA4.2 +008100 02 FILLER PIC X(42) VALUE K6SCA4.2 +008200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". K6SCA4.2 +008300 02 FILLER PIC X(39) VALUE SPACES. K6SCA4.2 +008400 01 CCVS-H-2A. K6SCA4.2 +008500 02 FILLER PIC X(40) VALUE SPACE. K6SCA4.2 +008600 02 FILLER PIC X(7) VALUE "CCVS85 ". K6SCA4.2 +008700 02 FILLER PIC XXXX VALUE K6SCA4.2 +008800 "4.2 ". K6SCA4.2 +008900 02 FILLER PIC X(28) VALUE K6SCA4.2 +009000 " COPY - NOT FOR DISTRIBUTION". K6SCA4.2 +009100 02 FILLER PIC X(41) VALUE SPACE. K6SCA4.2 +009200 K6SCA4.2 +009300 01 CCVS-H-2B. K6SCA4.2 +009400 02 FILLER PIC X(15) VALUE K6SCA4.2 +009500 "TEST RESULT OF ". K6SCA4.2 +009600 02 TEST-ID PIC X(9). K6SCA4.2 +009700 02 FILLER PIC X(4) VALUE K6SCA4.2 +009800 " IN ". K6SCA4.2 +009900 02 FILLER PIC X(12) VALUE K6SCA4.2 +010000 " HIGH ". K6SCA4.2 +010100 02 FILLER PIC X(22) VALUE K6SCA4.2 +010200 " LEVEL VALIDATION FOR ". K6SCA4.2 +010300 02 FILLER PIC X(58) VALUE K6SCA4.2 +010400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".K6SCA4.2 +010500 01 CCVS-H-3. K6SCA4.2 +010600 02 FILLER PIC X(34) VALUE K6SCA4.2 +010700 " FOR OFFICIAL USE ONLY ". K6SCA4.2 +010800 02 FILLER PIC X(58) VALUE K6SCA4.2 +010900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".K6SCA4.2 +011000 02 FILLER PIC X(28) VALUE K6SCA4.2 +011100 " COPYRIGHT 1985 ". K6SCA4.2 +011200 01 CCVS-E-1. K6SCA4.2 +011300 02 FILLER PIC X(52) VALUE SPACE. K6SCA4.2 +011400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". K6SCA4.2 +011500 02 ID-AGAIN PIC X(9). K6SCA4.2 +011600 02 FILLER PIC X(45) VALUE SPACES. K6SCA4.2 +011700 01 CCVS-E-2. K6SCA4.2 +011800 02 FILLER PIC X(31) VALUE SPACE. K6SCA4.2 +011900 02 FILLER PIC X(21) VALUE SPACE. K6SCA4.2 +012000 02 CCVS-E-2-2. K6SCA4.2 +012100 03 ERROR-TOTAL PIC XXX VALUE SPACE. K6SCA4.2 +012200 03 FILLER PIC X VALUE SPACE. K6SCA4.2 +012300 03 ENDER-DESC PIC X(44) VALUE K6SCA4.2 +012400 "ERRORS ENCOUNTERED". K6SCA4.2 +012500 01 CCVS-E-3. K6SCA4.2 +012600 02 FILLER PIC X(22) VALUE K6SCA4.2 +012700 " FOR OFFICIAL USE ONLY". K6SCA4.2 +012800 02 FILLER PIC X(12) VALUE SPACE. K6SCA4.2 +012900 02 FILLER PIC X(58) VALUE K6SCA4.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".K6SCA4.2 +013100 02 FILLER PIC X(13) VALUE SPACE. K6SCA4.2 +013200 02 FILLER PIC X(15) VALUE K6SCA4.2 +013300 " COPYRIGHT 1985". K6SCA4.2 +013400 01 CCVS-E-4. K6SCA4.2 +013500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. K6SCA4.2 +013600 02 FILLER PIC X(4) VALUE " OF ". K6SCA4.2 +013700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. K6SCA4.2 +013800 02 FILLER PIC X(40) VALUE K6SCA4.2 +013900 " TESTS WERE EXECUTED SUCCESSFULLY". K6SCA4.2 +014000 01 XXINFO. K6SCA4.2 +014100 02 FILLER PIC X(19) VALUE K6SCA4.2 +014200 "*** INFORMATION ***". K6SCA4.2 +014300 02 INFO-TEXT. K6SCA4.2 +014400 04 FILLER PIC X(8) VALUE SPACE. K6SCA4.2 +014500 04 XXCOMPUTED PIC X(20). K6SCA4.2 +014600 04 FILLER PIC X(5) VALUE SPACE. K6SCA4.2 +014700 04 XXCORRECT PIC X(20). K6SCA4.2 +014800 02 INF-ANSI-REFERENCE PIC X(48). K6SCA4.2 +014900 01 HYPHEN-LINE. K6SCA4.2 +015000 02 FILLER PIC IS X VALUE IS SPACE. K6SCA4.2 +015100 02 FILLER PIC IS X(65) VALUE IS "************************K6SCA4.2 +015200- "*****************************************". K6SCA4.2 +015300 02 FILLER PIC IS X(54) VALUE IS "************************K6SCA4.2 +015400- "******************************". K6SCA4.2 +015500 01 CCVS-PGM-ID PIC X(9) VALUE K6SCA4.2 +015600 "K6SCA". K6SCA4.2 +015700 PROCEDURE DIVISION. K6SCA4.2 +015800 CCVS1 SECTION. K6SCA4.2 +015900 OPEN-FILES. K6SCA4.2 +016000 OPEN OUTPUT PRINT-FILE. K6SCA4.2 +016100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. K6SCA4.2 +016200 MOVE SPACE TO TEST-RESULTS. K6SCA4.2 +016300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. K6SCA4.2 +016400 GO TO CCVS1-EXIT. K6SCA4.2 +016500 CLOSE-FILES. K6SCA4.2 +016600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. K6SCA4.2 +016700 TERMINATE-CCVS. K6SCA4.2 +016800S EXIT PROGRAM. K6SCA4.2 +016900STERMINATE-CALL. K6SCA4.2 +017000 STOP RUN. K6SCA4.2 +017100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. K6SCA4.2 +017200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. K6SCA4.2 +017300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. K6SCA4.2 +017400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. K6SCA4.2 +017500 MOVE "****TEST DELETED****" TO RE-MARK. K6SCA4.2 +017600 PRINT-DETAIL. K6SCA4.2 +017700 IF REC-CT NOT EQUAL TO ZERO K6SCA4.2 +017800 MOVE "." TO PARDOT-X K6SCA4.2 +017900 MOVE REC-CT TO DOTVALUE. K6SCA4.2 +018000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. K6SCA4.2 +018100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE K6SCA4.2 +018200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX K6SCA4.2 +018300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. K6SCA4.2 +018400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. K6SCA4.2 +018500 MOVE SPACE TO CORRECT-X. K6SCA4.2 +018600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. K6SCA4.2 +018700 MOVE SPACE TO RE-MARK. K6SCA4.2 +018800 HEAD-ROUTINE. K6SCA4.2 +018900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. K6SCA4.2 +019200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. K6SCA4.2 +019300 COLUMN-NAMES-ROUTINE. K6SCA4.2 +019400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +019500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +019700 END-ROUTINE. K6SCA4.2 +019800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.K6SCA4.2 +019900 END-RTN-EXIT. K6SCA4.2 +020000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +020100 END-ROUTINE-1. K6SCA4.2 +020200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO K6SCA4.2 +020300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. K6SCA4.2 +020400 ADD PASS-COUNTER TO ERROR-HOLD. K6SCA4.2 +020500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. K6SCA4.2 +020600 MOVE PASS-COUNTER TO CCVS-E-4-1. K6SCA4.2 +020700 MOVE ERROR-HOLD TO CCVS-E-4-2. K6SCA4.2 +020800 MOVE CCVS-E-4 TO CCVS-E-2-2. K6SCA4.2 +020900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. K6SCA4.2 +021000 END-ROUTINE-12. K6SCA4.2 +021100 MOVE "TEST(S) FAILED" TO ENDER-DESC. K6SCA4.2 +021200 IF ERROR-COUNTER IS EQUAL TO ZERO K6SCA4.2 +021300 MOVE "NO " TO ERROR-TOTAL K6SCA4.2 +021400 ELSE K6SCA4.2 +021500 MOVE ERROR-COUNTER TO ERROR-TOTAL. K6SCA4.2 +021600 MOVE CCVS-E-2 TO DUMMY-RECORD. K6SCA4.2 +021700 PERFORM WRITE-LINE. K6SCA4.2 +021800 END-ROUTINE-13. K6SCA4.2 +021900 IF DELETE-COUNTER IS EQUAL TO ZERO K6SCA4.2 +022000 MOVE "NO " TO ERROR-TOTAL ELSE K6SCA4.2 +022100 MOVE DELETE-COUNTER TO ERROR-TOTAL. K6SCA4.2 +022200 MOVE "TEST(S) DELETED " TO ENDER-DESC. K6SCA4.2 +022300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +022400 IF INSPECT-COUNTER EQUAL TO ZERO K6SCA4.2 +022500 MOVE "NO " TO ERROR-TOTAL K6SCA4.2 +022600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. K6SCA4.2 +022700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. K6SCA4.2 +022800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +022900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +023000 WRITE-LINE. K6SCA4.2 +023100 ADD 1 TO RECORD-COUNT. K6SCA4.2 +023200Y IF RECORD-COUNT GREATER 42 K6SCA4.2 +023300Y MOVE DUMMY-RECORD TO DUMMY-HOLD K6SCA4.2 +023400Y MOVE SPACE TO DUMMY-RECORD K6SCA4.2 +023500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE K6SCA4.2 +023600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES K6SCA4.2 +023700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES K6SCA4.2 +023800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES K6SCA4.2 +023900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES K6SCA4.2 +024000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024300Y MOVE DUMMY-HOLD TO DUMMY-RECORD K6SCA4.2 +024400Y MOVE ZERO TO RECORD-COUNT. K6SCA4.2 +024500 PERFORM WRT-LN. K6SCA4.2 +024600 WRT-LN. K6SCA4.2 +024700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. K6SCA4.2 +024800 MOVE SPACE TO DUMMY-RECORD. K6SCA4.2 +024900 BLANK-LINE-PRINT. K6SCA4.2 +025000 PERFORM WRT-LN. K6SCA4.2 +025100 FAIL-ROUTINE. K6SCA4.2 +025200 IF COMPUTED-X NOT EQUAL TO SPACE K6SCA4.2 +025300 GO TO FAIL-ROUTINE-WRITE. K6SCA4.2 +025400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.K6SCA4.2 +025500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. K6SCA4.2 +025600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. K6SCA4.2 +025700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +025800 MOVE SPACES TO INF-ANSI-REFERENCE. K6SCA4.2 +025900 GO TO FAIL-ROUTINE-EX. K6SCA4.2 +026000 FAIL-ROUTINE-WRITE. K6SCA4.2 +026100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE K6SCA4.2 +026200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. K6SCA4.2 +026300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +026400 MOVE SPACES TO COR-ANSI-REFERENCE. K6SCA4.2 +026500 FAIL-ROUTINE-EX. EXIT. K6SCA4.2 +026600 BAIL-OUT. K6SCA4.2 +026700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. K6SCA4.2 +026800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. K6SCA4.2 +026900 BAIL-OUT-WRITE. K6SCA4.2 +027000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. K6SCA4.2 +027100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. K6SCA4.2 +027200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +027300 MOVE SPACES TO INF-ANSI-REFERENCE. K6SCA4.2 +027400 BAIL-OUT-EX. EXIT. K6SCA4.2 +027500 CCVS1-EXIT. K6SCA4.2 +027600 EXIT. K6SCA4.2 +027700 LB106A-INIT SECTION. K6SCA4.2 +027800 LB106A-001. K6SCA4.2 +027900 MOVE " REGARDLESS OF WHAT APPEARS ABOVE OR BELOW, THIS IS THK6SCA4.2 +028000- "E REPORT FOR SM106A" TO PRINT-REC. K6SCA4.2 +028100 PERFORM WRITE-LINE. K6SCA4.2 +028200 PERFORM BLANK-LINE-PRINT. K6SCA4.2 +028300 MOVE " THE PRESENCE OF THIS MESSAGE INDICATES THAT TEXT FK6SCA4.2 +028400- "OR ALL 3 DIVISIONS CAN BE GENERATED BY ONE COPY STATEMENT." K6SCA4.2 +028500 TO PRINT-REC. K6SCA4.2 +028600 PERFORM WRITE-LINE. K6SCA4.2 +028700 PERFORM INSPT. K6SCA4.2 +028800 CCVS-EXIT SECTION. K6SCA4.2 +028900 CCVS-999999. K6SCA4.2 +029000 GO TO CLOSE-FILES. K6SCA4.2 +*END-OF,K6SCA +*HEADER,CLBRY,K7SEA +000100 COPY-TEST-1. K7SEA4.2 +000200 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +000300 MOVE "COPY-TEST-1 " TO PAR-NAME. K7SEA4.2 +000400 PERFORM PASS. K7SEA4.2 +000500 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +000600 MOVE SPACE TO CORRECT-A. K7SEA4.2 +000700 MOVE SPACE TO RE-MARK. K7SEA4.2 +000800 PERFORM PRINT-DETAIL. K7SEA4.2 +000900 COPY-TEST-2. K7SEA4.2 +001000 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +001100 MOVE "COPY-TEST-2 " TO PAR-NAME. K7SEA4.2 +001200 PERFORM PASS. K7SEA4.2 +001300 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +001400 MOVE SPACE TO CORRECT-A. K7SEA4.2 +001500 MOVE SPACE TO RE-MARK. K7SEA4.2 +001600 PERFORM PRINT-DETAIL. K7SEA4.2 +001700 COPY-TEST-3. K7SEA4.2 +001800 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +001900 MOVE "COPY-TEST-3 " TO PAR-NAME. K7SEA4.2 +002000 PERFORM PASS. K7SEA4.2 +002100 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +002200 MOVE SPACE TO CORRECT-A. K7SEA4.2 +002300 MOVE SPACE TO RE-MARK. K7SEA4.2 +002400 PERFORM PRINT-DETAIL. K7SEA4.2 +002500 COPY-TEST-4. K7SEA4.2 +002600 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +002700 MOVE "COPY-TEST-4 " TO PAR-NAME. K7SEA4.2 +002800 PERFORM PASS. K7SEA4.2 +002900 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +003000 MOVE SPACE TO CORRECT-A. K7SEA4.2 +003100 MOVE SPACE TO RE-MARK. K7SEA4.2 +003200 PERFORM PRINT-DETAIL. K7SEA4.2 +003300 COPY-TEST-5. K7SEA4.2 +003400 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +003500 MOVE "COPY-TEST-5 " TO PAR-NAME. K7SEA4.2 +003600 PERFORM PASS. K7SEA4.2 +003700 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +003800 MOVE SPACE TO CORRECT-A. K7SEA4.2 +003900 MOVE SPACE TO RE-MARK. K7SEA4.2 +004000 PERFORM PRINT-DETAIL. K7SEA4.2 +004100 COPY-TEST-6. K7SEA4.2 +004200 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +004300 MOVE "COPY-TEST-6 " TO PAR-NAME. K7SEA4.2 +004400 PERFORM PASS. K7SEA4.2 +004500 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +004600 MOVE SPACE TO CORRECT-A. K7SEA4.2 +004700 MOVE SPACE TO RE-MARK. K7SEA4.2 +004800 PERFORM PRINT-DETAIL. K7SEA4.2 +004900 COPY-TEST-7. K7SEA4.2 +005000 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +005100 MOVE "COPY-TEST-7 " TO PAR-NAME. K7SEA4.2 +005200 PERFORM PASS. K7SEA4.2 +005300 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +005400 MOVE SPACE TO CORRECT-A. K7SEA4.2 +005500 MOVE SPACE TO RE-MARK. K7SEA4.2 +005600 PERFORM PRINT-DETAIL. K7SEA4.2 +005700 COPY-TEST-8. K7SEA4.2 +005800 MOVE "COPY-TEST-8 " TO PAR-NAME. K7SEA4.2 +005900 PERFORM PASS. K7SEA4.2 +006000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +006100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +006200 MOVE SPACE TO RE-MARK. K7SEA4.2 +006300 PERFORM PRINT-DETAIL. K7SEA4.2 +006400 COPY-TEST-9. K7SEA4.2 +006500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +006600 MOVE "COPY-TEST-9 " TO PAR-NAME. K7SEA4.2 +006700 PERFORM PASS. K7SEA4.2 +006800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +006900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +007000 MOVE SPACE TO RE-MARK. K7SEA4.2 +007100 PERFORM PRINT-DETAIL. K7SEA4.2 +007200 COPY-TEST-10. K7SEA4.2 +007300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +007400 MOVE "COPY-TEST-10 " TO PAR-NAME. K7SEA4.2 +007500 PERFORM PASS. K7SEA4.2 +007600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +007700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +007800 MOVE SPACE TO RE-MARK. K7SEA4.2 +007900 PERFORM PRINT-DETAIL. K7SEA4.2 +008000 COPY-TEST-11. K7SEA4.2 +008100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +008200 MOVE "COPY-TEST-11 " TO PAR-NAME. K7SEA4.2 +008300 PERFORM PASS. K7SEA4.2 +008400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +008500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +008600 MOVE SPACE TO RE-MARK. K7SEA4.2 +008700 PERFORM PRINT-DETAIL. K7SEA4.2 +008800 COPY-TEST-12. K7SEA4.2 +008900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +009000 MOVE "COPY-TEST-12 " TO PAR-NAME. K7SEA4.2 +009100 PERFORM PASS. K7SEA4.2 +009200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +009300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +009400 MOVE SPACE TO RE-MARK. K7SEA4.2 +009500 PERFORM PRINT-DETAIL. K7SEA4.2 +009600 COPY-TEST-13. K7SEA4.2 +009700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +009800 MOVE "COPY-TEST-13 " TO PAR-NAME. K7SEA4.2 +009900 PERFORM PASS. K7SEA4.2 +010000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +010100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +010200 MOVE SPACE TO RE-MARK. K7SEA4.2 +010300 PERFORM PRINT-DETAIL. K7SEA4.2 +010400 COPY-TEST-14. K7SEA4.2 +010500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +010600 MOVE "COPY-TEST-14 " TO PAR-NAME. K7SEA4.2 +010700 PERFORM PASS. K7SEA4.2 +010800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +010900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +011000 MOVE SPACE TO RE-MARK. K7SEA4.2 +011100 PERFORM PRINT-DETAIL. K7SEA4.2 +011200 COPY-TEST-15. K7SEA4.2 +011300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +011400 MOVE "COPY-TEST-15 " TO PAR-NAME. K7SEA4.2 +011500 PERFORM PASS. K7SEA4.2 +011600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +011700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +011800 MOVE SPACE TO RE-MARK. K7SEA4.2 +011900 PERFORM PRINT-DETAIL. K7SEA4.2 +012000 COPY-TEST-16. K7SEA4.2 +012100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +012200 MOVE "COPY-TEST-16 " TO PAR-NAME. K7SEA4.2 +012300 PERFORM PASS. K7SEA4.2 +012400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +012500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +012600 MOVE SPACE TO RE-MARK. K7SEA4.2 +012700 PERFORM PRINT-DETAIL. K7SEA4.2 +012800 COPY-TEST-17. K7SEA4.2 +012900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +013000 MOVE "COPY-TEST-17 " TO PAR-NAME. K7SEA4.2 +013100 PERFORM PASS. K7SEA4.2 +013200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +013300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +013400 MOVE SPACE TO RE-MARK. K7SEA4.2 +013500 PERFORM PRINT-DETAIL. K7SEA4.2 +013600 COPY-TEST-18. K7SEA4.2 +013700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +013800 MOVE "COPY-TEST-18 " TO PAR-NAME. K7SEA4.2 +013900 PERFORM PASS. K7SEA4.2 +014000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +014100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +014200 MOVE SPACE TO RE-MARK. K7SEA4.2 +014300 PERFORM PRINT-DETAIL. K7SEA4.2 +014400 COPY-TEST-19. K7SEA4.2 +014500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +014600 MOVE "COPY-TEST-19 " TO PAR-NAME. K7SEA4.2 +014700 PERFORM PASS. K7SEA4.2 +014800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +014900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +015000 MOVE SPACE TO RE-MARK. K7SEA4.2 +015100 PERFORM PRINT-DETAIL. K7SEA4.2 +015200 COPY-TEST-20. K7SEA4.2 +015300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +015400 MOVE "COPY-TEST-20 " TO PAR-NAME. K7SEA4.2 +015500 PERFORM PASS. K7SEA4.2 +015600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +015700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +015800 MOVE SPACE TO RE-MARK. K7SEA4.2 +015900 PERFORM PRINT-DETAIL. K7SEA4.2 +016000 COPY-TEST-21. K7SEA4.2 +016100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +016200 MOVE "COPY-TEST-21 " TO PAR-NAME. K7SEA4.2 +016300 PERFORM PASS. K7SEA4.2 +016400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +016500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +016600 MOVE SPACE TO RE-MARK. K7SEA4.2 +016700 PERFORM PRINT-DETAIL. K7SEA4.2 +016800 COPY-TEST-2I. K7SEA4.2 +016900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +017000 MOVE "COPY-TEST-22 " TO PAR-NAME. K7SEA4.2 +017100 PERFORM PASS. K7SEA4.2 +017200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +017300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +017400 MOVE SPACE TO RE-MARK. K7SEA4.2 +017500 PERFORM PRINT-DETAIL. K7SEA4.2 +017600 COPY-TEST-23. K7SEA4.2 +017700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +017800 MOVE "COPY-TEST-23 " TO PAR-NAME. K7SEA4.2 +017900 PERFORM PASS. K7SEA4.2 +018000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +018100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +018200 MOVE SPACE TO RE-MARK. K7SEA4.2 +018300 PERFORM PRINT-DETAIL. K7SEA4.2 +018400 COPY-TEST-24. K7SEA4.2 +018500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +018600 MOVE "COPY-TEST-24 " TO PAR-NAME. K7SEA4.2 +018700 PERFORM PASS. K7SEA4.2 +018800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +018900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +019000 MOVE SPACE TO RE-MARK. K7SEA4.2 +019100 PERFORM PRINT-DETAIL. K7SEA4.2 +019200 COPY-TEST-25. K7SEA4.2 +019300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +019400 MOVE "COPY-TEST-25 " TO PAR-NAME. K7SEA4.2 +019500 PERFORM PASS. K7SEA4.2 +019600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +019700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +019800 MOVE SPACE TO RE-MARK. K7SEA4.2 +019900 PERFORM PRINT-DETAIL. K7SEA4.2 +020000 COPY-TEST-26. K7SEA4.2 +020100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +020200 MOVE "COPY-TEST-26 " TO PAR-NAME. K7SEA4.2 +020300 PERFORM PASS. K7SEA4.2 +020400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +020500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +020600 MOVE SPACE TO RE-MARK. K7SEA4.2 +020700 PERFORM PRINT-DETAIL. K7SEA4.2 +020800 COPY-TEST-27. K7SEA4.2 +020900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +021000 MOVE "COPY-TEST-27 " TO PAR-NAME. K7SEA4.2 +021100 PERFORM PASS. K7SEA4.2 +021200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +021300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +021400 MOVE SPACE TO RE-MARK. K7SEA4.2 +021500 PERFORM PRINT-DETAIL. K7SEA4.2 +021600 COPY-TEST-28. K7SEA4.2 +021700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +021800 MOVE "COPY-TEST-28 " TO PAR-NAME. K7SEA4.2 +021900 PERFORM PASS. K7SEA4.2 +022000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +022100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +022200 MOVE SPACE TO RE-MARK. K7SEA4.2 +022300 PERFORM PRINT-DETAIL. K7SEA4.2 +022400 COPY-TEST-29. K7SEA4.2 +022500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +022600 MOVE "COPY-TEST-29 " TO PAR-NAME. K7SEA4.2 +022700 PERFORM PASS. K7SEA4.2 +022800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +022900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +023000 MOVE SPACE TO RE-MARK. K7SEA4.2 +023100 PERFORM PRINT-DETAIL. K7SEA4.2 +023200 COPY-TEST-30. K7SEA4.2 +023300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +023400 MOVE "COPY-TEST-30 " TO PAR-NAME. K7SEA4.2 +023500 PERFORM PASS. K7SEA4.2 +023600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +023700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +023800 MOVE SPACE TO RE-MARK. K7SEA4.2 +023900 PERFORM PRINT-DETAIL. K7SEA4.2 +024000 COPY-TEST-31. K7SEA4.2 +024100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +024200 MOVE "COPY-TEST-31 " TO PAR-NAME. K7SEA4.2 +024300 PERFORM PASS. K7SEA4.2 +024400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +024500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +024600 MOVE SPACE TO RE-MARK. K7SEA4.2 +024700 PERFORM PRINT-DETAIL. K7SEA4.2 +024800 COPY-TEST-32. K7SEA4.2 +024900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +025000 MOVE "COPY-TEST-32 " TO PAR-NAME. K7SEA4.2 +025100 PERFORM PASS. K7SEA4.2 +025200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +025300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +025400 MOVE SPACE TO RE-MARK. K7SEA4.2 +025500 PERFORM PRINT-DETAIL. K7SEA4.2 +025600 COPY-TEST-33. K7SEA4.2 +025700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +025800 MOVE "COPY-TEST-33 " TO PAR-NAME. K7SEA4.2 +025900 PERFORM PASS. K7SEA4.2 +026000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +026100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +026200 MOVE SPACE TO RE-MARK. K7SEA4.2 +026300 PERFORM PRINT-DETAIL. K7SEA4.2 +026400 COPY-TEST-34. K7SEA4.2 +026500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +026600 MOVE "COPY-TEST-34 " TO PAR-NAME. K7SEA4.2 +026700 PERFORM PASS. K7SEA4.2 +026800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +026900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +027000 MOVE SPACE TO RE-MARK. K7SEA4.2 +027100 PERFORM PRINT-DETAIL. K7SEA4.2 +027200 COPY-TEST-35. K7SEA4.2 +027300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +027400 MOVE "COPY-TEST-35 " TO PAR-NAME. K7SEA4.2 +027500 PERFORM PASS. K7SEA4.2 +027600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +027700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +027800 MOVE SPACE TO RE-MARK. K7SEA4.2 +027900 PERFORM PRINT-DETAIL. K7SEA4.2 +028000 COPY-TEST-36. K7SEA4.2 +028100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +028200 MOVE "COPY-TEST-36 " TO PAR-NAME. K7SEA4.2 +028300 PERFORM PASS. K7SEA4.2 +028400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +028500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +028600 MOVE SPACE TO RE-MARK. K7SEA4.2 +028700 PERFORM PRINT-DETAIL. K7SEA4.2 +028800 COPY-TEST-37. K7SEA4.2 +028900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +029000 MOVE "COPY-TEST-37 " TO PAR-NAME. K7SEA4.2 +029100 PERFORM PASS. K7SEA4.2 +029200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +029300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +029400 MOVE SPACE TO RE-MARK. K7SEA4.2 +029500 PERFORM PRINT-DETAIL. K7SEA4.2 +029600 COPY-TEST-38. K7SEA4.2 +029700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +029800 MOVE "COPY-TEST-38 " TO PAR-NAME. K7SEA4.2 +029900 PERFORM PASS. K7SEA4.2 +030000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +030100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +030200 MOVE SPACE TO RE-MARK. K7SEA4.2 +030300 PERFORM PRINT-DETAIL. K7SEA4.2 +030400 COPY-TEST-39. K7SEA4.2 +030500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +030600 MOVE "COPY-TEST-39 " TO PAR-NAME. K7SEA4.2 +030700 PERFORM PASS. K7SEA4.2 +030800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +030900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +031000 MOVE SPACE TO RE-MARK. K7SEA4.2 +031100 PERFORM PRINT-DETAIL. K7SEA4.2 +031200 COPY-TEST-40. K7SEA4.2 +031300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +031400 MOVE "COPY-TEST-40 " TO PAR-NAME. K7SEA4.2 +031500 PERFORM PASS. K7SEA4.2 +031600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +031700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +031800 MOVE SPACE TO RE-MARK. K7SEA4.2 +031900 PERFORM PRINT-DETAIL. K7SEA4.2 +032000 COPY-TEST-41. K7SEA4.2 +032100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +032200 MOVE "COPY-TEST-41 " TO PAR-NAME. K7SEA4.2 +032300 PERFORM PASS. K7SEA4.2 +032400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +032500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +032600 MOVE SPACE TO RE-MARK. K7SEA4.2 +032700 PERFORM PRINT-DETAIL. K7SEA4.2 +032800 COPY-TEST-42. K7SEA4.2 +032900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +033000 MOVE "COPY-TEST-42 " TO PAR-NAME. K7SEA4.2 +033100 PERFORM PASS. K7SEA4.2 +033200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +033300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +033400 MOVE SPACE TO RE-MARK. K7SEA4.2 +033500 PERFORM PRINT-DETAIL. K7SEA4.2 +033600 COPY-TEST-43. K7SEA4.2 +033700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +033800 MOVE "COPY-TEST-43 " TO PAR-NAME. K7SEA4.2 +033900 PERFORM PASS. K7SEA4.2 +034000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +034100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +034200 MOVE SPACE TO RE-MARK. K7SEA4.2 +034300 PERFORM PRINT-DETAIL. K7SEA4.2 +034400 COPY-TEST-44. K7SEA4.2 +034500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +034600 MOVE "COPY-TEST-44 " TO PAR-NAME. K7SEA4.2 +034700 PERFORM PASS. K7SEA4.2 +034800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +034900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +035000 MOVE SPACE TO RE-MARK. K7SEA4.2 +035100 PERFORM PRINT-DETAIL. K7SEA4.2 +035200 COPY-TEST-45. K7SEA4.2 +035300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +035400 MOVE "COPY-TEST-45 " TO PAR-NAME. K7SEA4.2 +035500 PERFORM PASS. K7SEA4.2 +035600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +035700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +035800 MOVE SPACE TO RE-MARK. K7SEA4.2 +035900 PERFORM PRINT-DETAIL. K7SEA4.2 +036000 COPY-TEST-46. K7SEA4.2 +036100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +036200 MOVE "COPY-TEST-46 " TO PAR-NAME. K7SEA4.2 +036300 PERFORM PASS. K7SEA4.2 +036400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +036500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +036600 MOVE SPACE TO RE-MARK. K7SEA4.2 +036700 PERFORM PRINT-DETAIL. K7SEA4.2 +036800 COPY-TEST-47. K7SEA4.2 +036900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +037000 MOVE "COPY-TEST-47 " TO PAR-NAME. K7SEA4.2 +037100 PERFORM PASS. K7SEA4.2 +037200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +037300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +037400 MOVE SPACE TO RE-MARK. K7SEA4.2 +037500 PERFORM PRINT-DETAIL. K7SEA4.2 +037600 COPY-TEST-48. K7SEA4.2 +037700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +037800 MOVE "COPY-TEST-48 " TO PAR-NAME. K7SEA4.2 +037900 PERFORM PASS. K7SEA4.2 +038000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +038100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +038200 MOVE SPACE TO RE-MARK. K7SEA4.2 +038300 PERFORM PRINT-DETAIL. K7SEA4.2 +038400 COPY-TEST-49. K7SEA4.2 +038500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +038600 MOVE "COPY-TEST-49 " TO PAR-NAME. K7SEA4.2 +038700 PERFORM PASS. K7SEA4.2 +038800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +038900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +039000 MOVE SPACE TO RE-MARK. K7SEA4.2 +039100 PERFORM PRINT-DETAIL. K7SEA4.2 +039200 COPY-TEST-50. K7SEA4.2 +039300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +039400 MOVE "COPY-TEST-50 " TO PAR-NAME. K7SEA4.2 +039500 PERFORM PASS. K7SEA4.2 +039600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +039700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +039800 MOVE SPACE TO RE-MARK. K7SEA4.2 +039900 PERFORM PRINT-DETAIL. K7SEA4.2 +040000 COPY-TEST-51. K7SEA4.2 +040100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +040200 MOVE "COPY-TEST-51 " TO PAR-NAME. K7SEA4.2 +040300 PERFORM PASS. K7SEA4.2 +040400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +040500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +040600 MOVE SPACE TO RE-MARK. K7SEA4.2 +040700 PERFORM PRINT-DETAIL. K7SEA4.2 +040800 COPY-TEST-52. K7SEA4.2 +040900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +041000 MOVE "COPY-TEST-52 " TO PAR-NAME. K7SEA4.2 +041100 PERFORM PASS. K7SEA4.2 +041200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +041300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +041400 MOVE SPACE TO RE-MARK. K7SEA4.2 +041500 PERFORM PRINT-DETAIL. K7SEA4.2 +041600 COPY-TEST-53. K7SEA4.2 +041700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +041800 MOVE "COPY-TEST-53 " TO PAR-NAME. K7SEA4.2 +041900 PERFORM PASS. K7SEA4.2 +042000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +042100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +042200 MOVE SPACE TO RE-MARK. K7SEA4.2 +042300 PERFORM PRINT-DETAIL. K7SEA4.2 +042400 COPY-TEST-54. K7SEA4.2 +042500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +042600 MOVE "COPY-TEST-54 " TO PAR-NAME. K7SEA4.2 +042700 PERFORM PASS. K7SEA4.2 +042800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +042900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +043000 MOVE SPACE TO RE-MARK. K7SEA4.2 +043100 PERFORM PRINT-DETAIL. K7SEA4.2 +043200 COPY-TEST-55. K7SEA4.2 +043300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +043400 MOVE "COPY-TEST-55 " TO PAR-NAME. K7SEA4.2 +043500 PERFORM PASS. K7SEA4.2 +043600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +043700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +043800 MOVE SPACE TO RE-MARK. K7SEA4.2 +043900 PERFORM PRINT-DETAIL. K7SEA4.2 +044000 COPY-TEST-56. K7SEA4.2 +044100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +044200 MOVE "COPY-TEST-56 " TO PAR-NAME. K7SEA4.2 +044300 PERFORM PASS. K7SEA4.2 +044400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +044500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +044600 MOVE SPACE TO RE-MARK. K7SEA4.2 +044700 PERFORM PRINT-DETAIL. K7SEA4.2 +044800 COPY-TEST-57. K7SEA4.2 +044900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +045000 MOVE "COPY-TEST-57 " TO PAR-NAME. K7SEA4.2 +045100 PERFORM PASS. K7SEA4.2 +045200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +045300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +045400 MOVE SPACE TO RE-MARK. K7SEA4.2 +045500 PERFORM PRINT-DETAIL. K7SEA4.2 +045600 COPY-TEST-58. K7SEA4.2 +045700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +045800 MOVE "COPY-TEST-58 " TO PAR-NAME. K7SEA4.2 +045900 PERFORM PASS. K7SEA4.2 +046000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +046100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +046200 MOVE SPACE TO RE-MARK. K7SEA4.2 +046300 PERFORM PRINT-DETAIL. K7SEA4.2 +046400 COPY-TEST-59. K7SEA4.2 +046500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +046600 MOVE "COPY-TEST-59 " TO PAR-NAME. K7SEA4.2 +046700 PERFORM PASS. K7SEA4.2 +046800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +046900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +047000 MOVE SPACE TO RE-MARK. K7SEA4.2 +047100 PERFORM PRINT-DETAIL. K7SEA4.2 +047200 COPY-TEST-60. K7SEA4.2 +047300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +047400 MOVE "COPY-TEST-60 " TO PAR-NAME. K7SEA4.2 +047500 PERFORM PASS. K7SEA4.2 +047600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +047700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +047800 MOVE SPACE TO RE-MARK. K7SEA4.2 +047900 PERFORM PRINT-DETAIL. K7SEA4.2 +048000 COPY-TEST-61. K7SEA4.2 +048100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +048200 MOVE "COPY-TEST-61 " TO PAR-NAME. K7SEA4.2 +048300 PERFORM PASS. K7SEA4.2 +048400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +048500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +048600 MOVE SPACE TO RE-MARK. K7SEA4.2 +048700 PERFORM PRINT-DETAIL. K7SEA4.2 +048800 COPY-TEST-62. K7SEA4.2 +048900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +049000 MOVE "COPY-TEST-62 " TO PAR-NAME. K7SEA4.2 +049100 PERFORM PASS. K7SEA4.2 +049200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +049300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +049400 MOVE SPACE TO RE-MARK. K7SEA4.2 +049500 PERFORM PRINT-DETAIL. K7SEA4.2 +049600 COPY-TEST-63. K7SEA4.2 +049700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +049800 MOVE "COPY-TEST-63 " TO PAR-NAME. K7SEA4.2 +049900 PERFORM PASS. K7SEA4.2 +050000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +050100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +050200 MOVE SPACE TO RE-MARK. K7SEA4.2 +050300 PERFORM PRINT-DETAIL. K7SEA4.2 +050400 COPY-TEST-64. K7SEA4.2 +050500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +050600 MOVE "COPY-TEST-64 " TO PAR-NAME. K7SEA4.2 +050700 PERFORM PASS. K7SEA4.2 +050800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +050900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +051000 MOVE SPACE TO RE-MARK. K7SEA4.2 +051100 PERFORM PRINT-DETAIL. K7SEA4.2 +051200 COPY-TEST-65. K7SEA4.2 +051300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +051400 MOVE "COPY-TEST-65 " TO PAR-NAME. K7SEA4.2 +051500 PERFORM PASS. K7SEA4.2 +051600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +051700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +051800 MOVE SPACE TO RE-MARK. K7SEA4.2 +051900 PERFORM PRINT-DETAIL. K7SEA4.2 +052000 COPY-TEST-66. K7SEA4.2 +052100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +052200 MOVE "COPY-TEST-66 " TO PAR-NAME. K7SEA4.2 +052300 PERFORM PASS. K7SEA4.2 +052400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +052500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +052600 MOVE SPACE TO RE-MARK. K7SEA4.2 +052700 PERFORM PRINT-DETAIL. K7SEA4.2 +052800 COPY-TEST-67. K7SEA4.2 +052900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +053000 MOVE "COPY-TEST-67 " TO PAR-NAME. K7SEA4.2 +053100 PERFORM PASS. K7SEA4.2 +053200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +053300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +053400 MOVE SPACE TO RE-MARK. K7SEA4.2 +053500 PERFORM PRINT-DETAIL. K7SEA4.2 +053600 COPY-TEST-68. K7SEA4.2 +053700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +053800 MOVE "COPY-TEST-68 " TO PAR-NAME. K7SEA4.2 +053900 PERFORM PASS. K7SEA4.2 +054000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +054100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +054200 MOVE SPACE TO RE-MARK. K7SEA4.2 +054300 PERFORM PRINT-DETAIL. K7SEA4.2 +054400 COPY-TEST-69. K7SEA4.2 +054500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +054600 MOVE "COPY-TEST-69 " TO PAR-NAME. K7SEA4.2 +054700 PERFORM PASS. K7SEA4.2 +054800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +054900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +055000 MOVE SPACE TO RE-MARK. K7SEA4.2 +055100 PERFORM PRINT-DETAIL. K7SEA4.2 +055200 COPY-TEST-70. K7SEA4.2 +055300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +055400 MOVE "COPY-TEST-70 " TO PAR-NAME. K7SEA4.2 +055500 PERFORM PASS. K7SEA4.2 +055600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +055700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +055800 MOVE SPACE TO RE-MARK. K7SEA4.2 +055900 PERFORM PRINT-DETAIL. K7SEA4.2 +056000 COPY-TEST-71. K7SEA4.2 +056100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +056200 MOVE "COPY-TEST-71 " TO PAR-NAME. K7SEA4.2 +056300 PERFORM PASS. K7SEA4.2 +056400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +056500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +056600 MOVE SPACE TO RE-MARK. K7SEA4.2 +056700 PERFORM PRINT-DETAIL. K7SEA4.2 +056800 COPY-TEST-72. K7SEA4.2 +056900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +057000 MOVE "COPY-TEST-72 " TO PAR-NAME. K7SEA4.2 +057100 PERFORM PASS. K7SEA4.2 +057200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +057300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +057400 MOVE SPACE TO RE-MARK. K7SEA4.2 +057500 PERFORM PRINT-DETAIL. K7SEA4.2 +057600 COPY-TEST-73. K7SEA4.2 +057700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +057800 MOVE "COPY-TEST-73 " TO PAR-NAME. K7SEA4.2 +057900 PERFORM PASS. K7SEA4.2 +058000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +058100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +058200 MOVE SPACE TO RE-MARK. K7SEA4.2 +058300 PERFORM PRINT-DETAIL. K7SEA4.2 +058400 COPY-TEST-74. K7SEA4.2 +058500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +058600 MOVE "COPY-TEST-74 " TO PAR-NAME. K7SEA4.2 +058700 PERFORM PASS. K7SEA4.2 +058800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +058900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +059000 MOVE SPACE TO RE-MARK. K7SEA4.2 +059100 PERFORM PRINT-DETAIL. K7SEA4.2 +059200 COPY-TEST-75. K7SEA4.2 +059300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +059400 MOVE "COPY-TEST-75 " TO PAR-NAME. K7SEA4.2 +059500 PERFORM PASS. K7SEA4.2 +059600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +059700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +059800 MOVE SPACE TO RE-MARK. K7SEA4.2 +059900 PERFORM PRINT-DETAIL. K7SEA4.2 +060000 COPY-TEST-76. K7SEA4.2 +060100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +060200 MOVE "COPY-TEST-76 " TO PAR-NAME. K7SEA4.2 +060300 PERFORM PASS. K7SEA4.2 +060400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +060500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +060600 MOVE SPACE TO RE-MARK. K7SEA4.2 +060700 PERFORM PRINT-DETAIL. K7SEA4.2 +060800 COPY-TEST-77. K7SEA4.2 +060900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +061000 MOVE "COPY-TEST-77 " TO PAR-NAME. K7SEA4.2 +061100 PERFORM PASS. K7SEA4.2 +061200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +061300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +061400 MOVE SPACE TO RE-MARK. K7SEA4.2 +061500 PERFORM PRINT-DETAIL. K7SEA4.2 +061600 COPY-TEST-78. K7SEA4.2 +061700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +061800 MOVE "COPY-TEST-78 " TO PAR-NAME. K7SEA4.2 +061900 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +062000 MOVE SPACE TO CORRECT-A. K7SEA4.2 +062100 PERFORM PASS. K7SEA4.2 +062200 MOVE SPACE TO RE-MARK. K7SEA4.2 +062300 PERFORM PRINT-DETAIL. K7SEA4.2 +062400 COPY-TEST-79. K7SEA4.2 +062500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +062600 MOVE "COPY-TEST-79 " TO PAR-NAME. K7SEA4.2 +062700 PERFORM PASS. K7SEA4.2 +062800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +062900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +063000 MOVE SPACE TO RE-MARK. K7SEA4.2 +063100 PERFORM PRINT-DETAIL. K7SEA4.2 +063200 COPY-TEST-80. K7SEA4.2 +063300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +063400 MOVE "COPY-TEST-80 " TO PAR-NAME. K7SEA4.2 +063500 PERFORM PASS. K7SEA4.2 +063600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +063700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +063800 MOVE SPACE TO RE-MARK. K7SEA4.2 +063900 PERFORM PRINT-DETAIL. K7SEA4.2 +064000 COPY-TEST-81. K7SEA4.2 +064100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +064200 MOVE "COPY-TEST-81 " TO PAR-NAME. K7SEA4.2 +064300 PERFORM PASS. K7SEA4.2 +064400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +064500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +064600 MOVE SPACE TO RE-MARK. K7SEA4.2 +064700 PERFORM PRINT-DETAIL. K7SEA4.2 +064800 COPY-TEST-82. K7SEA4.2 +064900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +065000 MOVE "COPY-TEST-82 " TO PAR-NAME. K7SEA4.2 +065100 PERFORM PASS. K7SEA4.2 +065200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +065300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +065400 MOVE SPACE TO RE-MARK. K7SEA4.2 +065500 PERFORM PRINT-DETAIL. K7SEA4.2 +065600 COPY-TEST-83. K7SEA4.2 +065700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +065800 MOVE "COPY-TEST-83 " TO PAR-NAME. K7SEA4.2 +065900 PERFORM PASS. K7SEA4.2 +066000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +066100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +066200 MOVE SPACE TO RE-MARK. K7SEA4.2 +066300 PERFORM PRINT-DETAIL. K7SEA4.2 +066400 COPY-TEST-84. K7SEA4.2 +066500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +066600 MOVE "COPY-TEST-84 " TO PAR-NAME. K7SEA4.2 +066700 PERFORM PASS. K7SEA4.2 +066800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +066900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +067000 MOVE SPACE TO RE-MARK. K7SEA4.2 +067100 PERFORM PRINT-DETAIL. K7SEA4.2 +067200 COPY-TEST-85. K7SEA4.2 +067300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +067400 MOVE "COPY-TEST-85 " TO PAR-NAME. K7SEA4.2 +067500 PERFORM PASS. K7SEA4.2 +067600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +067700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +067800 MOVE SPACE TO RE-MARK. K7SEA4.2 +067900 PERFORM PRINT-DETAIL. K7SEA4.2 +068000 COPY-TEST-86. K7SEA4.2 +068100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +068200 MOVE "COPY-TEST-86 " TO PAR-NAME. K7SEA4.2 +068300 PERFORM PASS. K7SEA4.2 +068400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +068500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +068600 MOVE SPACE TO RE-MARK. K7SEA4.2 +068700 PERFORM PRINT-DETAIL. K7SEA4.2 +068800 COPY-TEST-87. K7SEA4.2 +068900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +069000 MOVE "COPY-TEST-87 " TO PAR-NAME. K7SEA4.2 +069100 PERFORM PASS. K7SEA4.2 +069200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +069300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +069400 MOVE SPACE TO RE-MARK. K7SEA4.2 +069500 PERFORM PRINT-DETAIL. K7SEA4.2 +069600 COPY-TEST-88. K7SEA4.2 +069700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +069800 MOVE "COPY-TEST-88 " TO PAR-NAME. K7SEA4.2 +069900 PERFORM PASS. K7SEA4.2 +070000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +070100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +070200 MOVE SPACE TO RE-MARK. K7SEA4.2 +070300 PERFORM PRINT-DETAIL. K7SEA4.2 +070400 COPY-TEST-89. K7SEA4.2 +070500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +070600 MOVE "COPY-TEST-89 " TO PAR-NAME. K7SEA4.2 +070700 PERFORM PASS. K7SEA4.2 +070800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +070900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +071000 MOVE SPACE TO RE-MARK. K7SEA4.2 +071100 PERFORM PRINT-DETAIL. K7SEA4.2 +071200 COPY-TEST-90. K7SEA4.2 +071300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +071400 MOVE "COPY-TEST-90 " TO PAR-NAME. K7SEA4.2 +071500 PERFORM PASS. K7SEA4.2 +071600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +071700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +071800 MOVE SPACE TO RE-MARK. K7SEA4.2 +071900 PERFORM PRINT-DETAIL. K7SEA4.2 +072000 COPY-TEST-91. K7SEA4.2 +072100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +072200 MOVE "COPY-TEST-91 " TO PAR-NAME. K7SEA4.2 +072300 PERFORM PASS. K7SEA4.2 +072400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +072500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +072600 MOVE SPACE TO RE-MARK. K7SEA4.2 +072700 PERFORM PRINT-DETAIL. K7SEA4.2 +072800 COPY-TEST-92. K7SEA4.2 +072900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +073000 MOVE "COPY-TEST-92 " TO PAR-NAME. K7SEA4.2 +073100 PERFORM PASS. K7SEA4.2 +073200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +073300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +073400 MOVE SPACE TO RE-MARK. K7SEA4.2 +073500 PERFORM PRINT-DETAIL. K7SEA4.2 +073600 COPY-TEST-93. K7SEA4.2 +073700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +073800 MOVE "COPY-TEST-93 " TO PAR-NAME. K7SEA4.2 +073900 PERFORM PASS. K7SEA4.2 +074000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +074100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +074200 MOVE SPACE TO RE-MARK. K7SEA4.2 +074300 PERFORM PRINT-DETAIL. K7SEA4.2 +074400 COPY-TEST-94. K7SEA4.2 +074500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +074600 MOVE "COPY-TEST-94 " TO PAR-NAME. K7SEA4.2 +074700 PERFORM PASS. K7SEA4.2 +074800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +074900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +075000 MOVE SPACE TO RE-MARK. K7SEA4.2 +075100 PERFORM PRINT-DETAIL. K7SEA4.2 +075200 COPY-TEST-95. K7SEA4.2 +075300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +075400 MOVE "COPY-TEST-95 " TO PAR-NAME. K7SEA4.2 +075500 PERFORM PASS. K7SEA4.2 +075600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +075700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +075800 MOVE SPACE TO RE-MARK. K7SEA4.2 +075900 PERFORM PRINT-DETAIL. K7SEA4.2 +076000 COPY-TEST-96. K7SEA4.2 +076100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +076200 MOVE "COPY-TEST-96 " TO PAR-NAME. K7SEA4.2 +076300 PERFORM PASS. K7SEA4.2 +076400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +076500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +076600 MOVE SPACE TO RE-MARK. K7SEA4.2 +076700 PERFORM PRINT-DETAIL. K7SEA4.2 +076800 COPY-TEST-97. K7SEA4.2 +076900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +077000 MOVE "COPY-TEST-97 " TO PAR-NAME. K7SEA4.2 +077100 PERFORM PASS. K7SEA4.2 +077200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +077300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +077400 MOVE SPACE TO RE-MARK. K7SEA4.2 +077500 PERFORM PRINT-DETAIL. K7SEA4.2 +077600 COPY-TEST-98. K7SEA4.2 +077700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +077800 MOVE "COPY-TEST-98 " TO PAR-NAME. K7SEA4.2 +077900 PERFORM PASS. K7SEA4.2 +078000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +078100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +078200 MOVE SPACE TO RE-MARK. K7SEA4.2 +078300 PERFORM PRINT-DETAIL. K7SEA4.2 +078400 COPY-TEST-99. K7SEA4.2 +078500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +078600 MOVE "COPY-TEST-99 " TO PAR-NAME. K7SEA4.2 +078700 PERFORM PASS. K7SEA4.2 +078800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +078900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +079000 MOVE SPACE TO RE-MARK. K7SEA4.2 +079100 PERFORM PRINT-DETAIL. K7SEA4.2 +079200 COPY-TEST-100. K7SEA4.2 +079300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +079400 MOVE "COPY-TEST-100" TO PAR-NAME. K7SEA4.2 +079500 PERFORM PASS. K7SEA4.2 +079600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +079700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +079800 MOVE SPACE TO RE-MARK. K7SEA4.2 +079900 PERFORM PRINT-DETAIL. K7SEA4.2 +080000 COPY-TEST-101. K7SEA4.2 +080100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +080200 MOVE "COPY-TEST-101" TO PAR-NAME. K7SEA4.2 +080300 PERFORM PASS. K7SEA4.2 +080400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +080500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +080600 MOVE SPACE TO RE-MARK. K7SEA4.2 +080700 PERFORM PRINT-DETAIL. K7SEA4.2 +080800 COPY-TEST-102. K7SEA4.2 +080900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +081000 MOVE "COPY-TEST-102" TO PAR-NAME. K7SEA4.2 +081100 PERFORM PASS. K7SEA4.2 +081200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +081300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +081400 MOVE SPACE TO RE-MARK. K7SEA4.2 +081500 PERFORM PRINT-DETAIL. K7SEA4.2 +081600 COPY-TEST-103. K7SEA4.2 +081700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +081800 MOVE "COPY-TEST-103" TO PAR-NAME. K7SEA4.2 +081900 PERFORM PASS. K7SEA4.2 +082000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +082100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +082200 MOVE SPACE TO RE-MARK. K7SEA4.2 +082300 PERFORM PRINT-DETAIL. K7SEA4.2 +082400 COPY-TEST-104. K7SEA4.2 +082500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +082600 MOVE "COPY-TEST-104" TO PAR-NAME. K7SEA4.2 +082700 PERFORM PASS. K7SEA4.2 +082800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +082900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +083000 MOVE SPACE TO RE-MARK. K7SEA4.2 +083100 PERFORM PRINT-DETAIL. K7SEA4.2 +083200 COPY-TEST-105. K7SEA4.2 +083300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +083400 MOVE "COPY-TEST-105" TO PAR-NAME. K7SEA4.2 +083500 PERFORM PASS. K7SEA4.2 +083600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +083700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +083800 MOVE SPACE TO RE-MARK. K7SEA4.2 +083900 PERFORM PRINT-DETAIL. K7SEA4.2 +084000 COPY-TEST-106. K7SEA4.2 +084100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +084200 MOVE "COPY-TEST-106" TO PAR-NAME. K7SEA4.2 +084300 PERFORM PASS. K7SEA4.2 +084400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +084500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +084600 MOVE SPACE TO RE-MARK. K7SEA4.2 +084700 PERFORM PRINT-DETAIL. K7SEA4.2 +084800 COPY-TEST-107. K7SEA4.2 +084900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +085000 MOVE "COPY-TEST-107" TO PAR-NAME. K7SEA4.2 +085100 PERFORM PASS. K7SEA4.2 +085200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +085300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +085400 MOVE SPACE TO RE-MARK. K7SEA4.2 +085500 PERFORM PRINT-DETAIL. K7SEA4.2 +085600 COPY-TEST-108. K7SEA4.2 +085700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +085800 MOVE "COPY-TEST-108" TO PAR-NAME. K7SEA4.2 +085900 PERFORM PASS. K7SEA4.2 +086000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +086100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +086200 MOVE SPACE TO RE-MARK. K7SEA4.2 +086300 PERFORM PRINT-DETAIL. K7SEA4.2 +086400 COPY-TEST-109. K7SEA4.2 +086500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +086600 MOVE "COPY-TEST-109" TO PAR-NAME. K7SEA4.2 +086700 PERFORM PASS. K7SEA4.2 +086800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +086900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +087000 MOVE SPACE TO RE-MARK. K7SEA4.2 +087100 PERFORM PRINT-DETAIL. K7SEA4.2 +087200 COPY-TEST-110. K7SEA4.2 +087300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +087400 MOVE "COPY-TEST-110" TO PAR-NAME. K7SEA4.2 +087500 PERFORM PASS. K7SEA4.2 +087600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +087700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +087800 MOVE SPACE TO RE-MARK. K7SEA4.2 +087900 PERFORM PRINT-DETAIL. K7SEA4.2 +088000 COPY-TEST-111. K7SEA4.2 +088100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +088200 MOVE "COPY-TEST-111" TO PAR-NAME. K7SEA4.2 +088300 PERFORM PASS. K7SEA4.2 +088400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +088500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +088600 MOVE SPACE TO RE-MARK. K7SEA4.2 +088700 PERFORM PRINT-DETAIL. K7SEA4.2 +088800 COPY-TEST-112. K7SEA4.2 +088900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +089000 MOVE "COPY-TEST-112" TO PAR-NAME. K7SEA4.2 +089100 PERFORM PASS. K7SEA4.2 +089200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +089300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +089400 MOVE SPACE TO RE-MARK. K7SEA4.2 +089500 PERFORM PRINT-DETAIL. K7SEA4.2 +089600 COPY-TEST-113. K7SEA4.2 +089700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +089800 MOVE "COPY-TEST-113" TO PAR-NAME. K7SEA4.2 +089900 PERFORM PASS. K7SEA4.2 +090000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +090100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +090200 MOVE SPACE TO RE-MARK. K7SEA4.2 +090300 PERFORM PRINT-DETAIL. K7SEA4.2 +090400 COPY-TEST-114. K7SEA4.2 +090500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +090600 MOVE "COPY-TEST-114" TO PAR-NAME. K7SEA4.2 +090700 PERFORM PASS. K7SEA4.2 +090800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +090900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +091000 MOVE SPACE TO RE-MARK. K7SEA4.2 +091100 PERFORM PRINT-DETAIL. K7SEA4.2 +091200 COPY-TEST-115. K7SEA4.2 +091300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +091400 MOVE "COPY-TEST-115" TO PAR-NAME. K7SEA4.2 +091500 PERFORM PASS. K7SEA4.2 +091600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +091700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +091800 MOVE SPACE TO RE-MARK. K7SEA4.2 +091900 PERFORM PRINT-DETAIL. K7SEA4.2 +092000 COPY-TEST-116. K7SEA4.2 +092100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +092200 MOVE "COPY-TEST-116" TO PAR-NAME. K7SEA4.2 +092300 PERFORM PASS. K7SEA4.2 +092400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +092500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +092600 MOVE SPACE TO RE-MARK. K7SEA4.2 +092700 PERFORM PRINT-DETAIL. K7SEA4.2 +092800 COPY-TEST-117. K7SEA4.2 +092900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +093000 MOVE "COPY-TEST-117" TO PAR-NAME. K7SEA4.2 +093100 PERFORM PASS. K7SEA4.2 +093200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +093300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +093400 MOVE SPACE TO RE-MARK. K7SEA4.2 +093500 PERFORM PRINT-DETAIL. K7SEA4.2 +093600 COPY-TEST-118. K7SEA4.2 +093700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +093800 MOVE "COPY-TEST-118" TO PAR-NAME. K7SEA4.2 +093900 PERFORM PASS. K7SEA4.2 +094000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +094100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +094200 MOVE SPACE TO RE-MARK. K7SEA4.2 +094300 PERFORM PRINT-DETAIL. K7SEA4.2 +094400 COPY-TEST-119. K7SEA4.2 +094500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +094600 MOVE "COPY-TEST-119" TO PAR-NAME. K7SEA4.2 +094700 PERFORM PASS. K7SEA4.2 +094800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +094900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +095000 MOVE SPACE TO RE-MARK. K7SEA4.2 +095100 PERFORM PRINT-DETAIL. K7SEA4.2 +095200 COPY-TEST-120. K7SEA4.2 +095300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +095400 MOVE "COPY-TEST-120" TO PAR-NAME. K7SEA4.2 +095500 PERFORM PASS. K7SEA4.2 +095600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +095700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +095800 MOVE SPACE TO RE-MARK. K7SEA4.2 +095900 PERFORM PRINT-DETAIL. K7SEA4.2 +096000 COPY-TEST-121. K7SEA4.2 +096100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +096200 MOVE "COPY-TEST-121" TO PAR-NAME. K7SEA4.2 +096300 PERFORM PASS. K7SEA4.2 +096400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +096500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +096600 MOVE SPACE TO RE-MARK. K7SEA4.2 +096700 PERFORM PRINT-DETAIL. K7SEA4.2 +096800 COPY-TEST-122. K7SEA4.2 +096900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +097000 MOVE "COPY-TEST-122" TO PAR-NAME. K7SEA4.2 +097100 PERFORM PASS. K7SEA4.2 +097200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +097300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +097400 MOVE SPACE TO RE-MARK. K7SEA4.2 +097500 PERFORM PRINT-DETAIL. K7SEA4.2 +097600 COPY-TEST-123. K7SEA4.2 +097700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +097800 MOVE "COPY-TEST-123" TO PAR-NAME. K7SEA4.2 +097900 PERFORM PASS. K7SEA4.2 +098000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +098100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +098200 MOVE SPACE TO RE-MARK. K7SEA4.2 +098300 PERFORM PRINT-DETAIL. K7SEA4.2 +098400 COPY-TEST-124. K7SEA4.2 +098500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +098600 MOVE "COPY-TEST-124" TO PAR-NAME. K7SEA4.2 +098700 PERFORM PASS. K7SEA4.2 +098800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +098900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +099000 MOVE SPACE TO RE-MARK. K7SEA4.2 +099100 PERFORM PRINT-DETAIL. K7SEA4.2 +099200 COPY-TEST-125. K7SEA4.2 +099300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +099400 MOVE "COPY-TEST-125" TO PAR-NAME. K7SEA4.2 +099500 PERFORM PASS. K7SEA4.2 +099600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +099700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +099800 MOVE SPACE TO RE-MARK. K7SEA4.2 +099900 PERFORM PRINT-DETAIL. K7SEA4.2 +100000 COPY-TEST-126. K7SEA4.2 +100100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +100200 MOVE "COPY-TEST-126" TO PAR-NAME. K7SEA4.2 +100300 PERFORM PASS. K7SEA4.2 +100400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +100500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +100600 MOVE SPACE TO RE-MARK. K7SEA4.2 +100700 PERFORM PRINT-DETAIL. K7SEA4.2 +100800 COPY-TEST-127. K7SEA4.2 +100900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +101000 MOVE "COPY-TEST-127" TO PAR-NAME. K7SEA4.2 +101100 PERFORM PASS. K7SEA4.2 +101200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +101300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +101400 MOVE SPACE TO RE-MARK. K7SEA4.2 +101500 PERFORM PRINT-DETAIL. K7SEA4.2 +101600 COPY-TEST-128. K7SEA4.2 +101700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +101800 MOVE "COPY-TEST-128" TO PAR-NAME. K7SEA4.2 +101900 PERFORM PASS. K7SEA4.2 +102000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +102100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +102200 MOVE SPACE TO RE-MARK. K7SEA4.2 +102300 PERFORM PRINT-DETAIL. K7SEA4.2 +102400 COPY-TEST-129. K7SEA4.2 +102500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +102600 MOVE "COPY-TEST-129" TO PAR-NAME. K7SEA4.2 +102700 PERFORM PASS. K7SEA4.2 +102800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +102900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +103000 MOVE SPACE TO RE-MARK. K7SEA4.2 +103100 PERFORM PRINT-DETAIL. K7SEA4.2 +103200 COPY-TEST-130. K7SEA4.2 +103300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +103400 MOVE "COPY-TEST-130" TO PAR-NAME. K7SEA4.2 +103500 PERFORM PASS. K7SEA4.2 +103600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +103700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +103800 MOVE SPACE TO RE-MARK. K7SEA4.2 +103900 PERFORM PRINT-DETAIL. K7SEA4.2 +104000 COPY-TEST-131. K7SEA4.2 +104100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +104200 MOVE "COPY-TEST-131" TO PAR-NAME. K7SEA4.2 +104300 PERFORM PASS. K7SEA4.2 +104400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +104500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +104600 MOVE SPACE TO RE-MARK. K7SEA4.2 +104700 PERFORM PRINT-DETAIL. K7SEA4.2 +104800 COPY-TEST-132. K7SEA4.2 +104900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +105000 MOVE "COPY-TEST-132" TO PAR-NAME. K7SEA4.2 +105100 PERFORM PASS. K7SEA4.2 +105200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +105300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +105400 MOVE SPACE TO RE-MARK. K7SEA4.2 +105500 PERFORM PRINT-DETAIL. K7SEA4.2 +105600 COPY-TEST-133. K7SEA4.2 +105700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +105800 MOVE "COPY-TEST-133" TO PAR-NAME. K7SEA4.2 +105900 PERFORM PASS. K7SEA4.2 +106000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +106100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +106200 MOVE SPACE TO RE-MARK. K7SEA4.2 +106300 PERFORM PRINT-DETAIL. K7SEA4.2 +106400 COPY-TEST-134. K7SEA4.2 +106500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +106600 MOVE "COPY-TEST-134" TO PAR-NAME. K7SEA4.2 +106700 PERFORM PASS. K7SEA4.2 +106800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +106900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +107000 MOVE SPACE TO RE-MARK. K7SEA4.2 +107100 PERFORM PRINT-DETAIL. K7SEA4.2 +107200 COPY-TEST-135. K7SEA4.2 +107300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +107400 MOVE "COPY-TEST-135" TO PAR-NAME. K7SEA4.2 +107500 PERFORM PASS. K7SEA4.2 +107600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +107700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +107800 MOVE SPACE TO RE-MARK. K7SEA4.2 +107900 PERFORM PRINT-DETAIL. K7SEA4.2 +108000 COPY-TEST-136. K7SEA4.2 +108100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +108200 MOVE "COPY-TEST-136" TO PAR-NAME. K7SEA4.2 +108300 PERFORM PASS. K7SEA4.2 +108400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +108500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +108600 MOVE SPACE TO RE-MARK. K7SEA4.2 +108700 PERFORM PRINT-DETAIL. K7SEA4.2 +108800 COPY-TEST-137. K7SEA4.2 +108900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +109000 MOVE "COPY-TEST-137" TO PAR-NAME. K7SEA4.2 +109100 PERFORM PASS. K7SEA4.2 +109200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +109300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +109400 MOVE SPACE TO RE-MARK. K7SEA4.2 +109500 PERFORM PRINT-DETAIL. K7SEA4.2 +109600 COPY-TEST-138. K7SEA4.2 +109700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +109800 MOVE "COPY-TEST-138" TO PAR-NAME. K7SEA4.2 +109900 PERFORM PASS. K7SEA4.2 +110000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +110100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +110200 MOVE SPACE TO RE-MARK. K7SEA4.2 +110300 PERFORM PRINT-DETAIL. K7SEA4.2 +110400 COPY-TEST-139. K7SEA4.2 +110500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +110600 MOVE "COPY-TEST-139" TO PAR-NAME. K7SEA4.2 +110700 PERFORM PASS. K7SEA4.2 +110800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +110900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +111000 MOVE SPACE TO RE-MARK. K7SEA4.2 +111100 PERFORM PRINT-DETAIL. K7SEA4.2 +111200 COPY-TEST-140. K7SEA4.2 +111300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +111400 MOVE "COPY-TEST-140" TO PAR-NAME. K7SEA4.2 +111500 PERFORM PASS. K7SEA4.2 +111600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +111700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +111800 MOVE SPACE TO RE-MARK. K7SEA4.2 +111900 PERFORM PRINT-DETAIL. K7SEA4.2 +112000 COPY-TEST-141. K7SEA4.2 +112100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +112200 MOVE "COPY-TEST-141" TO PAR-NAME. K7SEA4.2 +112300 PERFORM PASS. K7SEA4.2 +112400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +112500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +112600 MOVE SPACE TO RE-MARK. K7SEA4.2 +112700 PERFORM PRINT-DETAIL. K7SEA4.2 +112800 COPY-TEST-142. K7SEA4.2 +112900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +113000 MOVE "COPY-TEST-142" TO PAR-NAME. K7SEA4.2 +113100 PERFORM PASS. K7SEA4.2 +113200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +113300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +113400 MOVE SPACE TO RE-MARK. K7SEA4.2 +113500 PERFORM PRINT-DETAIL. K7SEA4.2 +113600 COPY-TEST-143. K7SEA4.2 +113700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +113800 MOVE "COPY-TEST-143" TO PAR-NAME. K7SEA4.2 +113900 PERFORM PASS. K7SEA4.2 +114000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +114100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +114200 MOVE SPACE TO RE-MARK. K7SEA4.2 +114300 PERFORM PRINT-DETAIL. K7SEA4.2 +114400 COPY-TEST-144. K7SEA4.2 +114500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +114600 MOVE "COPY-TEST-144" TO PAR-NAME. K7SEA4.2 +114700 PERFORM PASS. K7SEA4.2 +114800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +114900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +115000 MOVE SPACE TO RE-MARK. K7SEA4.2 +115100 PERFORM PRINT-DETAIL. K7SEA4.2 +115200 COPY-TEST-145. K7SEA4.2 +115300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +115400 MOVE "COPY-TEST-145" TO PAR-NAME. K7SEA4.2 +115500 PERFORM PASS. K7SEA4.2 +115600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +115700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +115800 MOVE SPACE TO RE-MARK. K7SEA4.2 +115900 PERFORM PRINT-DETAIL. K7SEA4.2 +116000 COPY-TEST-146. K7SEA4.2 +116100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +116200 MOVE "COPY-TEST-146" TO PAR-NAME. K7SEA4.2 +116300 PERFORM PASS. K7SEA4.2 +116400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +116500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +116600 MOVE SPACE TO RE-MARK. K7SEA4.2 +116700 PERFORM PRINT-DETAIL. K7SEA4.2 +116800 COPY-TEST-147. K7SEA4.2 +116900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +117000 MOVE "COPY-TEST-147" TO PAR-NAME. K7SEA4.2 +117100 PERFORM PASS. K7SEA4.2 +117200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +117300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +117400 MOVE SPACE TO RE-MARK. K7SEA4.2 +117500 PERFORM PRINT-DETAIL. K7SEA4.2 +117600 COPY-TEST-148. K7SEA4.2 +117700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +117800 MOVE "COPY-TEST-148" TO PAR-NAME. K7SEA4.2 +117900 PERFORM PASS. K7SEA4.2 +118000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +118100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +118200 MOVE SPACE TO RE-MARK. K7SEA4.2 +118300 PERFORM PRINT-DETAIL. K7SEA4.2 +118400 COPY-TEST-149. K7SEA4.2 +118500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +118600 MOVE "COPY-TEST-149" TO PAR-NAME. K7SEA4.2 +118700 PERFORM PASS. K7SEA4.2 +118800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +118900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +119000 MOVE SPACE TO RE-MARK. K7SEA4.2 +119100 PERFORM PRINT-DETAIL. K7SEA4.2 +119200 COPY-TEST-150. K7SEA4.2 +119300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +119400 MOVE "COPY-TEST-150" TO PAR-NAME. K7SEA4.2 +119500 PERFORM PASS. K7SEA4.2 +119600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +119700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +119800 MOVE SPACE TO RE-MARK. K7SEA4.2 +119900 PERFORM PRINT-DETAIL. K7SEA4.2 +120000 COPY-TEST-151. K7SEA4.2 +120100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +120200 MOVE "COPY-TEST-151" TO PAR-NAME. K7SEA4.2 +120300 PERFORM PASS. K7SEA4.2 +120400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +120500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +120600 MOVE SPACE TO RE-MARK. K7SEA4.2 +120700 PERFORM PRINT-DETAIL. K7SEA4.2 +120800 COPY-TEST-152. K7SEA4.2 +120900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +121000 MOVE "COPY-TEST-152" TO PAR-NAME. K7SEA4.2 +121100 PERFORM PASS. K7SEA4.2 +121200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +121300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +121400 MOVE SPACE TO RE-MARK. K7SEA4.2 +121500 PERFORM PRINT-DETAIL. K7SEA4.2 +121600 COPY-TEST-153. K7SEA4.2 +121700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +121800 MOVE "COPY-TEST-153" TO PAR-NAME. K7SEA4.2 +121900 PERFORM PASS. K7SEA4.2 +122000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +122100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +122200 MOVE SPACE TO RE-MARK. K7SEA4.2 +122300 PERFORM PRINT-DETAIL. K7SEA4.2 +122400 COPY-TEST-154. K7SEA4.2 +122500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +122600 MOVE "COPY-TEST-154" TO PAR-NAME. K7SEA4.2 +122700 PERFORM PASS. K7SEA4.2 +122800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +122900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +123000 MOVE SPACE TO RE-MARK. K7SEA4.2 +123100 PERFORM PRINT-DETAIL. K7SEA4.2 +123200 COPY-TEST-155. K7SEA4.2 +123300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +123400 MOVE "COPY-TEST-155" TO PAR-NAME. K7SEA4.2 +123500 PERFORM PASS. K7SEA4.2 +123600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +123700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +123800 MOVE SPACE TO RE-MARK. K7SEA4.2 +123900 PERFORM PRINT-DETAIL. K7SEA4.2 +124000 COPY-TEST-156. K7SEA4.2 +124100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +124200 MOVE "COPY-TEST-156" TO PAR-NAME. K7SEA4.2 +124300 PERFORM PASS. K7SEA4.2 +124400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +124500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +124600 MOVE SPACE TO RE-MARK. K7SEA4.2 +124700 PERFORM PRINT-DETAIL. K7SEA4.2 +124800 COPY-TEST-157. K7SEA4.2 +124900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +125000 MOVE "COPY-TEST-157" TO PAR-NAME. K7SEA4.2 +125100 PERFORM PASS. K7SEA4.2 +125200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +125300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +125400 MOVE SPACE TO RE-MARK. K7SEA4.2 +125500 PERFORM PRINT-DETAIL. K7SEA4.2 +125600 COPY-TEST-158. K7SEA4.2 +125700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +125800 MOVE "COPY-TEST-158" TO PAR-NAME. K7SEA4.2 +125900 PERFORM PASS. K7SEA4.2 +126000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +126100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +126200 MOVE SPACE TO RE-MARK. K7SEA4.2 +126300 PERFORM PRINT-DETAIL. K7SEA4.2 +126400 COPY-TEST-159. K7SEA4.2 +126500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +126600 MOVE "COPY-TEST-159" TO PAR-NAME. K7SEA4.2 +126700 PERFORM PASS. K7SEA4.2 +126800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +126900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +127000 MOVE SPACE TO RE-MARK. K7SEA4.2 +127100 PERFORM PRINT-DETAIL. K7SEA4.2 +127200 COPY-TEST-160. K7SEA4.2 +127300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +127400 MOVE "COPY-TEST-160" TO PAR-NAME. K7SEA4.2 +127500 PERFORM PASS. K7SEA4.2 +127600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +127700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +127800 MOVE SPACE TO RE-MARK. K7SEA4.2 +127900 PERFORM PRINT-DETAIL. K7SEA4.2 +128000 COPY-TEST-161. K7SEA4.2 +128100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +128200 MOVE "COPY-TEST-161" TO PAR-NAME. K7SEA4.2 +128300 PERFORM PASS. K7SEA4.2 +128400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +128500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +128600 MOVE SPACE TO RE-MARK. K7SEA4.2 +128700 PERFORM PRINT-DETAIL. K7SEA4.2 +128800 COPY-TEST-162. K7SEA4.2 +128900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +129000 MOVE "COPY-TEST-162" TO PAR-NAME. K7SEA4.2 +129100 PERFORM PASS. K7SEA4.2 +129200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +129300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +129400 MOVE SPACE TO RE-MARK. K7SEA4.2 +129500 PERFORM PRINT-DETAIL. K7SEA4.2 +129600 COPY-TEST-163. K7SEA4.2 +129700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +129800 MOVE "COPY-TEST-163" TO PAR-NAME. K7SEA4.2 +129900 PERFORM PASS. K7SEA4.2 +130000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +130100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +130200 MOVE SPACE TO RE-MARK. K7SEA4.2 +130300 PERFORM PRINT-DETAIL. K7SEA4.2 +130400 COPY-TEST-164. K7SEA4.2 +130500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +130600 MOVE "COPY-TEST-164" TO PAR-NAME. K7SEA4.2 +130700 PERFORM PASS. K7SEA4.2 +130800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +130900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +131000 MOVE SPACE TO RE-MARK. K7SEA4.2 +131100 PERFORM PRINT-DETAIL. K7SEA4.2 +131200 COPY-TEST-165. K7SEA4.2 +131300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +131400 MOVE "COPY-TEST-165" TO PAR-NAME. K7SEA4.2 +131500 PERFORM PASS. K7SEA4.2 +131600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +131700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +131800 MOVE SPACE TO RE-MARK. K7SEA4.2 +131900 PERFORM PRINT-DETAIL. K7SEA4.2 +132000 COPY-TEST-166. K7SEA4.2 +132100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +132200 MOVE "COPY-TEST-166" TO PAR-NAME. K7SEA4.2 +132300 PERFORM PASS. K7SEA4.2 +132400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +132500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +132600 MOVE SPACE TO RE-MARK. K7SEA4.2 +132700 PERFORM PRINT-DETAIL. K7SEA4.2 +132800 COPY-TEST-167. K7SEA4.2 +132900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +133000 MOVE "COPY-TEST-167" TO PAR-NAME. K7SEA4.2 +133100 PERFORM PASS. K7SEA4.2 +133200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +133300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +133400 MOVE SPACE TO RE-MARK. K7SEA4.2 +133500 PERFORM PRINT-DETAIL. K7SEA4.2 +133600 COPY-TEST-168. K7SEA4.2 +133700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +133800 MOVE "COPY-TEST-168" TO PAR-NAME. K7SEA4.2 +133900 PERFORM PASS. K7SEA4.2 +134000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +134100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +134200 MOVE SPACE TO RE-MARK. K7SEA4.2 +134300 PERFORM PRINT-DETAIL. K7SEA4.2 +134400 COPY-TEST-169. K7SEA4.2 +134500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +134600 MOVE "COPY-TEST-169" TO PAR-NAME. K7SEA4.2 +134700 PERFORM PASS. K7SEA4.2 +134800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +134900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +135000 MOVE SPACE TO RE-MARK. K7SEA4.2 +135100 PERFORM PRINT-DETAIL. K7SEA4.2 +135200 COPY-TEST-170. K7SEA4.2 +135300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +135400 MOVE "COPY-TEST-170" TO PAR-NAME. K7SEA4.2 +135500 PERFORM PASS. K7SEA4.2 +135600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +135700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +135800 MOVE SPACE TO RE-MARK. K7SEA4.2 +135900 PERFORM PRINT-DETAIL. K7SEA4.2 +136000 COPY-TEST-171. K7SEA4.2 +136100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +136200 MOVE "COPY-TEST-171" TO PAR-NAME. K7SEA4.2 +136300 PERFORM PASS. K7SEA4.2 +136400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +136500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +136600 MOVE SPACE TO RE-MARK. K7SEA4.2 +136700 PERFORM PRINT-DETAIL. K7SEA4.2 +136800 COPY-TEST-172. K7SEA4.2 +136900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +137000 MOVE "COPY-TEST-172" TO PAR-NAME. K7SEA4.2 +137100 PERFORM PASS. K7SEA4.2 +137200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +137300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +137400 MOVE SPACE TO RE-MARK. K7SEA4.2 +137500 PERFORM PRINT-DETAIL. K7SEA4.2 +137600 COPY-TEST-173. K7SEA4.2 +137700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +137800 MOVE "COPY-TEST-173" TO PAR-NAME. K7SEA4.2 +137900 PERFORM PASS. K7SEA4.2 +138000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +138100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +138200 MOVE SPACE TO RE-MARK. K7SEA4.2 +138300 PERFORM PRINT-DETAIL. K7SEA4.2 +138400 COPY-TEST-174. K7SEA4.2 +138500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +138600 MOVE "COPY-TEST-174" TO PAR-NAME. K7SEA4.2 +138700 PERFORM PASS. K7SEA4.2 +138800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +138900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +139000 MOVE SPACE TO RE-MARK. K7SEA4.2 +139100 PERFORM PRINT-DETAIL. K7SEA4.2 +139200 COPY-TEST-175. K7SEA4.2 +139300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +139400 MOVE "COPY-TEST-175" TO PAR-NAME. K7SEA4.2 +139500 PERFORM PASS. K7SEA4.2 +139600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +139700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +139800 MOVE SPACE TO RE-MARK. K7SEA4.2 +139900 PERFORM PRINT-DETAIL. K7SEA4.2 +140000 COPY-TEST-176. K7SEA4.2 +140100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +140200 MOVE "COPY-TEST-176" TO PAR-NAME. K7SEA4.2 +140300 PERFORM PASS. K7SEA4.2 +140400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +140500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +140600 MOVE SPACE TO RE-MARK. K7SEA4.2 +140700 PERFORM PRINT-DETAIL. K7SEA4.2 +140800 COPY-TEST-177. K7SEA4.2 +140900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +141000 MOVE "COPY-TEST-177" TO PAR-NAME. K7SEA4.2 +141100 PERFORM PASS. K7SEA4.2 +141200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +141300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +141400 MOVE SPACE TO RE-MARK. K7SEA4.2 +141500 PERFORM PRINT-DETAIL. K7SEA4.2 +141600 COPY-TEST-178. K7SEA4.2 +141700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +141800 MOVE "COPY-TEST-178" TO PAR-NAME. K7SEA4.2 +141900 PERFORM PASS. K7SEA4.2 +142000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +142100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +142200 MOVE SPACE TO RE-MARK. K7SEA4.2 +142300 PERFORM PRINT-DETAIL. K7SEA4.2 +142400 COPY-TEST-179. K7SEA4.2 +142500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +142600 MOVE "COPY-TEST-179" TO PAR-NAME. K7SEA4.2 +142700 PERFORM PASS. K7SEA4.2 +142800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +142900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +143000 MOVE SPACE TO RE-MARK. K7SEA4.2 +143100 PERFORM PRINT-DETAIL. K7SEA4.2 +143200 COPY-TEST-180. K7SEA4.2 +143300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +143400 MOVE "COPY-TEST-180" TO PAR-NAME. K7SEA4.2 +143500 PERFORM PASS. K7SEA4.2 +143600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +143700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +143800 MOVE SPACE TO RE-MARK. K7SEA4.2 +143900 PERFORM PRINT-DETAIL. K7SEA4.2 +144000 COPY-TEST-181. K7SEA4.2 +144100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +144200 MOVE "COPY-TEST-181" TO PAR-NAME. K7SEA4.2 +144300 PERFORM PASS. K7SEA4.2 +144400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +144500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +144600 MOVE SPACE TO RE-MARK. K7SEA4.2 +144700 PERFORM PRINT-DETAIL. K7SEA4.2 +144800 COPY-TEST-182. K7SEA4.2 +144900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +145000 MOVE "COPY-TEST-182" TO PAR-NAME. K7SEA4.2 +145100 PERFORM PASS. K7SEA4.2 +145200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +145300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +145400 MOVE SPACE TO RE-MARK. K7SEA4.2 +145500 PERFORM PRINT-DETAIL. K7SEA4.2 +145600 COPY-TEST-183. K7SEA4.2 +145700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +145800 MOVE "COPY-TEST-183" TO PAR-NAME. K7SEA4.2 +145900 PERFORM PASS. K7SEA4.2 +146000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +146100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +146200 MOVE SPACE TO RE-MARK. K7SEA4.2 +146300 PERFORM PRINT-DETAIL. K7SEA4.2 +146400 COPY-TEST-184. K7SEA4.2 +146500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +146600 MOVE "COPY-TEST-184" TO PAR-NAME. K7SEA4.2 +146700 PERFORM PASS. K7SEA4.2 +146800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +146900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +147000 MOVE SPACE TO RE-MARK. K7SEA4.2 +147100 PERFORM PRINT-DETAIL. K7SEA4.2 +147200 COPY-TEST-185. K7SEA4.2 +147300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +147400 MOVE "COPY-TEST-185" TO PAR-NAME. K7SEA4.2 +147500 PERFORM PASS. K7SEA4.2 +147600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +147700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +147800 MOVE SPACE TO RE-MARK. K7SEA4.2 +147900 PERFORM PRINT-DETAIL. K7SEA4.2 +148000 COPY-TEST-186. K7SEA4.2 +148100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +148200 MOVE "COPY-TEST-186" TO PAR-NAME. K7SEA4.2 +148300 PERFORM PASS. K7SEA4.2 +148400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +148500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +148600 MOVE SPACE TO RE-MARK. K7SEA4.2 +148700 PERFORM PRINT-DETAIL. K7SEA4.2 +148800 COPY-TEST-187. K7SEA4.2 +148900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +149000 MOVE "COPY-TEST-187" TO PAR-NAME. K7SEA4.2 +149100 PERFORM PASS. K7SEA4.2 +149200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +149300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +149400 MOVE SPACE TO RE-MARK. K7SEA4.2 +149500 PERFORM PRINT-DETAIL. K7SEA4.2 +149600 COPY-TEST-188. K7SEA4.2 +149700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +149800 MOVE "COPY-TEST-188" TO PAR-NAME. K7SEA4.2 +149900 PERFORM PASS. K7SEA4.2 +150000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +150100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +150200 MOVE SPACE TO RE-MARK. K7SEA4.2 +150300 PERFORM PRINT-DETAIL. K7SEA4.2 +150400 COPY-TEST-189. K7SEA4.2 +150500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +150600 MOVE "COPY-TEST-189" TO PAR-NAME. K7SEA4.2 +150700 PERFORM PASS. K7SEA4.2 +150800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +150900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +151000 MOVE SPACE TO RE-MARK. K7SEA4.2 +151100 PERFORM PRINT-DETAIL. K7SEA4.2 +151200 COPY-TEST-190. K7SEA4.2 +151300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +151400 MOVE "COPY-TEST-190" TO PAR-NAME. K7SEA4.2 +151500 PERFORM PASS. K7SEA4.2 +151600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +151700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +151800 MOVE SPACE TO RE-MARK. K7SEA4.2 +151900 PERFORM PRINT-DETAIL. K7SEA4.2 +152000 COPY-TEST-191. K7SEA4.2 +152100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +152200 MOVE "COPY-TEST-191" TO PAR-NAME. K7SEA4.2 +152300 PERFORM PASS. K7SEA4.2 +152400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +152500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +152600 MOVE SPACE TO RE-MARK. K7SEA4.2 +152700 PERFORM PRINT-DETAIL. K7SEA4.2 +152800 COPY-TEST-192. K7SEA4.2 +152900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +153000 MOVE "COPY-TEST-192" TO PAR-NAME. K7SEA4.2 +153100 PERFORM PASS. K7SEA4.2 +153200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +153300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +153400 MOVE SPACE TO RE-MARK. K7SEA4.2 +153500 PERFORM PRINT-DETAIL. K7SEA4.2 +153600 COPY-TEST-193. K7SEA4.2 +153700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +153800 MOVE "COPY-TEST-193" TO PAR-NAME. K7SEA4.2 +153900 PERFORM PASS. K7SEA4.2 +154000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +154100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +154200 MOVE SPACE TO RE-MARK. K7SEA4.2 +154300 PERFORM PRINT-DETAIL. K7SEA4.2 +154400 COPY-TEST-194. K7SEA4.2 +154500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +154600 MOVE "COPY-TEST-194" TO PAR-NAME. K7SEA4.2 +154700 PERFORM PASS. K7SEA4.2 +154800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +154900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +155000 MOVE SPACE TO RE-MARK. K7SEA4.2 +155100 PERFORM PRINT-DETAIL. K7SEA4.2 +155200 COPY-TEST-195. K7SEA4.2 +155300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +155400 MOVE "COPY-TEST-195" TO PAR-NAME. K7SEA4.2 +155500 PERFORM PASS. K7SEA4.2 +155600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +155700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +155800 MOVE SPACE TO RE-MARK. K7SEA4.2 +155900 PERFORM PRINT-DETAIL. K7SEA4.2 +156000 COPY-TEST-196. K7SEA4.2 +156100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +156200 MOVE "COPY-TEST-196" TO PAR-NAME. K7SEA4.2 +156300 PERFORM PASS. K7SEA4.2 +156400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +156500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +156600 MOVE SPACE TO RE-MARK. K7SEA4.2 +156700 PERFORM PRINT-DETAIL. K7SEA4.2 +156800 COPY-TEST-197. K7SEA4.2 +156900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +157000 MOVE "COPY-TEST-197" TO PAR-NAME. K7SEA4.2 +157100 PERFORM PASS. K7SEA4.2 +157200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +157300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +157400 MOVE SPACE TO RE-MARK. K7SEA4.2 +157500 PERFORM PRINT-DETAIL. K7SEA4.2 +157600 COPY-TEST-198. K7SEA4.2 +157700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +157800 MOVE "COPY-TEST-198" TO PAR-NAME. K7SEA4.2 +157900 PERFORM PASS. K7SEA4.2 +158000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +158100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +158200 MOVE SPACE TO RE-MARK. K7SEA4.2 +158300 PERFORM PRINT-DETAIL. K7SEA4.2 +158400 COPY-TEST-199. K7SEA4.2 +158500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +158600 MOVE "COPY-TEST-199" TO PAR-NAME. K7SEA4.2 +158700 PERFORM PASS. K7SEA4.2 +158800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +158900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +159000 MOVE SPACE TO RE-MARK. K7SEA4.2 +159100 PERFORM PRINT-DETAIL. K7SEA4.2 +159200 COPY-TEST-200. K7SEA4.2 +159300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +159400 MOVE "COPY-TEST-200" TO PAR-NAME. K7SEA4.2 +159500 PERFORM PASS. K7SEA4.2 +159600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +159700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +159800 MOVE SPACE TO RE-MARK. K7SEA4.2 +159900 PERFORM PRINT-DETAIL. K7SEA4.2 +*END-OF,K7SEA +*HEADER,CLBRY,KK208A +000100 MOVE "FAIL" TO P-OR-F. KK2084.2 +*END-OF,KK208A +*HEADER,CLBRY,KP001 +000100 PST-TEST-001. KP0014.2 +000200 MOVE "PSEUDO-TEXT" TO FEATURE. KP0014.2 +000300* THIS TEXT IS COPIED INTO A SOURCE PROGRAM THE PSEUDO KP0014.2 +000400* TEXT CONTAINING PERFORM FAIL IS REPLACED WITH A NULL KP0014.2 +000500* PSEUDO TEXT. KP0014.2 +000600 MOVE "PST-TEST-001" TO PAR-NAME KP0014.2 +000700 PERFORM PASS. KP0014.2 +000800 PERFORM FAIL. KP0014.2 +000900 PST-WRITE-001. KP0014.2 +001000 PERFORM PRINT-DETAIL. KP0014.2 +*END-OF,KP001 +*HEADER,CLBRY,KP002 +000100 MOVE +00009 TO WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005FKP0024.2 +000200- -001 OF GRP-006 OF GRP-004 IN GRP-003 ( 2 ). KP0024.2 +000300 ADD KP0024.2 +000400 +00001 TO KP0024.2 +000500 WRK-DS-09V00-901 KP0024.2 +000600 SUBTRACT KP0024.2 +000700 1 KP0024.2 +000800 FROM KP0024.2 +000900 WRK-DS-05V00-O005-001 IN GRP-002 (1). KP0024.2 +*END-OF,KP002 +*HEADER,CLBRY,KP003 +000100 PST-TEST-003. KP0034.2 +000200 MOVE +0009 TO WRK-DS-05V00-O005-001 IN GRP-003 (3). KP0034.2 +000300 ADD +00001 TO WRK-DS-09V00-901. KP0034.2 +000400 SUBTRACT 1 FROM WRK-DS-05V00-O005-001 IN GRP-002 (3). KP0034.2 +000500 PST-EXIT-003-X. KP0034.2 +*END-OF,KP003 +*HEADER,CLBRY,KP004 +000100* THIS COMMENT IS THE FIRST IMAGE IN KP004 KP0044.2 +000200* ADD 1 TO THE LIST. KP0044.2 +000300 PST-INIT-004. KP0044.2 +000400 MOVE "PSEUDO-TEXT/WORD" TO FEATURE. KP0044.2 +000500 MOVE ZERO TO WRK-DS-09V00-901. KP0044.2 +000600 MOVE "PST-TEST-004" TO PAR-NAME. KP0044.2 +000700 PST-TEST-004. KP0044.2 +000800 ADD 5 TO WRK-DS-09V00-901. KP0044.2 +000900 THIS IS NOT REAL COBOL-74 SYNTAX HOWEVER KP0044.2 +001000 SHOVE +2 TO WRK-DS-09V00-902. KP0044.2 +001100 GO TO PST-EXIT-004. KP0044.2 +001200 PST-DELETE-004. KP0044.2 +001300 PERFORM DELETE. KP0044.2 +001400 PST-EXIT-004. KP0044.2 +001500 EXIT. KP0044.2 +*END-OF,KP004 +*HEADER,CLBRY,KP005 +000100 MOVE 1 TO WRK-DS-09V00-901. KP0054.2 +*END-OF,KP005 +*HEADER,CLBRY,KP006 +000100 ADD 001 KP0064.2 +000200- 005 TO WRK-DS-09V00-901. KP0064.2 +*END-OF,KP006 +*HEADER,CLBRY,KP007 +000100 PERFORM FAIL. KP0074.2 +000200* THIS COMMENT SHOULD NOT AFFECT PSEUDO-TEXT MATCHING. KP0074.2 +000300 SUBTRACT 1 FROM ERROR-COUNTER. KP0074.2 +*END-OF,KP007 +*HEADER,CLBRY,KP008 +000100 PERFORM FAIL. KP0084.2 +000200D THIS IS GARBAGE. KP0084.2 +000300 SUBTRACT 1 FROM ERROR-COUNTER. KP0084.2 +*END-OF,KP008 +*HEADER,CLBRY,KP009 +000100 IF WRK-XN-00001 = "G" KP0094.2 +*END-OF,KP009 +*HEADER,CLBRY,KP010 +000100 YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000200- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000300- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000400- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000500- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000600- YYYYYYYYYYYYYYYYY KP0104.2 +*END-OF,KP010 +*HEADER,CLBRY,KSM31 +000100 DISPLAY " ". KSM314.2 +*END-OF,KSM31 +*HEADER,CLBRY,KSM41 +000100 DISPLAY "COW SHEEP PIG HORSE LAMB DOG CAT ". KSM414.2 +*END-OF,KSM41 +*HEADER,COBOL,NC101A +000100 IDENTIFICATION DIVISION. NC1014.2 +000200 PROGRAM-ID. NC1014.2 +000300 NC101A. NC1014.2 +000400**************************************************************** NC1014.2 +000500* * NC1014.2 +000600* VALIDATION FOR:- * NC1014.2 +000700* * NC1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +000900* * NC1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1014.2 +001100* * NC1014.2 +001200**************************************************************** NC1014.2 +001300* * NC1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1014.2 +001500* * NC1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1014.2 +001900* * NC1014.2 +002000**************************************************************** NC1014.2 +002100**************************************************************** NC1014.2 +002200* THIS PROGRAM TESTS THE FORMAT 1 MULTIPLY STATEMENT FOUND NC1014.2 +002300* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1014.2 +002400* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1014.2 +002500* TESTED, AS WELL AS THE ROUNDED OPTION. NC1014.2 +002600* NC1014.2 +002700* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1014.2 +002800* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1014.2 +002900* AS OPERANDS. NC1014.2 +003000* NC1014.2 +003100 NC1014.2 +003200 NC1014.2 +003300 ENVIRONMENT DIVISION. NC1014.2 +003400 CONFIGURATION SECTION. NC1014.2 +003500 SOURCE-COMPUTER. NC1014.2 +003600 XXXXX082. NC1014.2 +003700 OBJECT-COMPUTER. NC1014.2 +003800 XXXXX083. NC1014.2 +003900 INPUT-OUTPUT SECTION. NC1014.2 +004000 FILE-CONTROL. NC1014.2 +004100 SELECT PRINT-FILE ASSIGN TO NC1014.2 +004200 XXXXX055. NC1014.2 +004300 DATA DIVISION. NC1014.2 +004400 FILE SECTION. NC1014.2 +004500 FD PRINT-FILE. NC1014.2 +004600 01 PRINT-REC PICTURE X(120). NC1014.2 +004700 01 DUMMY-RECORD PICTURE X(120). NC1014.2 +004800 WORKING-STORAGE SECTION. NC1014.2 +004900 77 WRK-DS-18V00 PICTURE S9(18). NC1014.2 +005000 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1014.2 +005100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1014.2 +005200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1014.2 +005300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1014.2 +005400 77 WRK-DS-10V00 PICTURE S9(10). NC1014.2 +005500 77 WRK-XN-00001 PICTURE X. NC1014.2 +005600 77 A10ONES-DS-10V00 PICTURE S9(10) NC1014.2 +005700 VALUE 1111111111. NC1014.2 +005800 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1014.2 +005900 VALUE 333333.333333. NC1014.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC1014.2 +006100 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1014.2 +006200 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1014.2 +006300 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1014.2 +006400 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1014.2 +006500 77 A12ONES-DS-12V00 PICTURE S9(12) NC1014.2 +006600 VALUE 111111111111. NC1014.2 +006700 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1014.2 +006800 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1014.2 +006900 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1014.2 +007000 77 A18ONES-DS-18V00 PICTURE S9(18) NC1014.2 +007100 VALUE 111111111111111111. NC1014.2 +007200 77 WRK-DS-0201P PICTURE S99P. NC1014.2 +007300 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1014.2 +007400 77 WRK-DU-18V00 PICTURE 9(18). NC1014.2 +007500 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1014.2 +007600 VALUE 99. NC1014.2 +007700 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1014.2 +007800 VALUE .1. NC1014.2 +007900 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1014.2 +008000 77 WRK-DS-12V00 PICTURE S9(12). NC1014.2 +008100 77 WRK-DS-01V00 PICTURE S9. NC1014.2 +008200 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1014.2 +008300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1014.2 +008400 VALUE 111111111.111111111. NC1014.2 +008500 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1014.2 +008600 77 WRK-DS-05V00 PICTURE S9(5). NC1014.2 +008700 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1014.2 +008800 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1014.2 +008900 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1014.2 +009000 77 XRAY PICTURE X. NC1014.2 +009100 01 WRK-XN-18-1 PIC X(18). NC1014.2 +009200 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1014.2 +009300 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1014.2 +009400 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1014.2 +009500 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1014.2 +009600 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1014.2 +009700 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1014.2 +009800 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1014.2 +009900 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1014.2 +010000 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1014.2 +010100 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1014.2 +010200 01 WRK-DU-1V5-1 PIC 9V9(5). NC1014.2 +010300 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1014.2 +010400 01 WRK-DU-2P4-1 PIC 99P(4) VALUE 990000. NC1014.2 +010500 01 WRK-DU-2V0-1 PIC 99. NC1014.2 +010600 01 WRK-DU-2V0-2 PIC 99. NC1014.2 +010700 01 WRK-DU-2V0-3 PIC 99. NC1014.2 +010800 01 WRK-DU-2V1-1 PIC 99V9. NC1014.2 +010900 01 WRK-DU-2V1-2 PIC 99V9. NC1014.2 +011000 01 WRK-DU-2V1-3 PIC 99V9. NC1014.2 +011100 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1014.2 +011200 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1014.2 +011300 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1014.2 +011400 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1014.2 +011500 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1014.2 +011600 01 WRK-DU-2V5-1 PIC 99V9(5). NC1014.2 +011700 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1014.2 +011800 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1014.2 +011900 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1014.2 +012000 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1014.2 +012100 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1014.2 +012200 01 WRK-NE-X-1 PIC 9(16).99. NC1014.2 +012300 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1014.2 +012400 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1014.2 +012500 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1014.2 +012600 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1014.2 +012700 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1014.2 +012800 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1014.2 +012900 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1014.2 +013000 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1014.2 +013100 01 WRK-NE-X-2 PIC -9(16).99. NC1014.2 +013200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1014.2 +013300 01 WRK-NE-2 PIC $**.99. NC1014.2 +013400 01 WRK-NE-3 PIC $99.99CR. NC1014.2 +013500 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1014.2 +013600 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1014.2 +013700 VALUE +000000000000000001. NC1014.2 +013800 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1014.2 +013900 VALUE -000000000000000033. NC1014.2 +014000 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014100 VALUE 666666666666666666. NC1014.2 +014200 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014300 VALUE 009999999999999999. NC1014.2 +014400 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014500 VALUE 000022222222222222. NC1014.2 +014600 01 MULTIPLY-DATA. NC1014.2 +014700 02 MULT1 PICTURE IS 999V99 NC1014.2 +014800 VALUE IS 80.12. NC1014.2 +014900 02 MULT2 PICTURE IS 999V999. NC1014.2 +015000 02 MULT3 PICTURE IS $$99.99. NC1014.2 +015100 02 MULT4 PICTURE IS S99 NC1014.2 +015200 VALUE IS -56. NC1014.2 +015300 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1014.2 +015400 02 MULT6 PICTURE IS 99 VALUE IS NC1014.2 +015500 20. NC1014.2 +015600 01 DIVIDE-DATA. NC1014.2 +015700 02 DIV1 PICTURE IS 9(4)V99 NC1014.2 +015800 VALUE IS 1620.36. NC1014.2 +015900 02 DIV2 PICTURE IS 99V9 NC1014.2 +016000 VALUE IS 44.1. NC1014.2 +016100 02 DIV3 PICTURE IS 9(4)V9 NC1014.2 +016200 VALUE IS 1661.7. NC1014.2 +016300 02 DIV4 PICTURE IS S9V999 NC1014.2 +016400 VALUE IS -9.642. NC1014.2 +016500 02 DIV-02LEVEL-1. NC1014.2 +016600 03 DIV5 PICTURE IS V99 NC1014.2 +016700 VALUE IS .82. NC1014.2 +016800 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1014.2 +016900 03 DIV7 PICTURE IS 9V9 NC1014.2 +017000 VALUE IS 9.6. NC1014.2 +017100 01 DIV-DATA-2. NC1014.2 +017200 02 DIV8 PICTURE IS 99V9. NC1014.2 +017300 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1014.2 +017400 02 DIV10 PICTURE IS V999. NC1014.2 +017500 01 TEST-RESULTS. NC1014.2 +017600 02 FILLER PIC X VALUE SPACE. NC1014.2 +017700 02 FEATURE PIC X(20) VALUE SPACE. NC1014.2 +017800 02 FILLER PIC X VALUE SPACE. NC1014.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. NC1014.2 +018000 02 FILLER PIC X VALUE SPACE. NC1014.2 +018100 02 PAR-NAME. NC1014.2 +018200 03 FILLER PIC X(19) VALUE SPACE. NC1014.2 +018300 03 PARDOT-X PIC X VALUE SPACE. NC1014.2 +018400 03 DOTVALUE PIC 99 VALUE ZERO. NC1014.2 +018500 02 FILLER PIC X(8) VALUE SPACE. NC1014.2 +018600 02 RE-MARK PIC X(61). NC1014.2 +018700 01 TEST-COMPUTED. NC1014.2 +018800 02 FILLER PIC X(30) VALUE SPACE. NC1014.2 +018900 02 FILLER PIC X(17) VALUE NC1014.2 +019000 " COMPUTED=". NC1014.2 +019100 02 COMPUTED-X. NC1014.2 +019200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1014.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A NC1014.2 +019400 PIC -9(9).9(9). NC1014.2 +019500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1014.2 +019600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1014.2 +019700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1014.2 +019800 03 CM-18V0 REDEFINES COMPUTED-A. NC1014.2 +019900 04 COMPUTED-18V0 PIC -9(18). NC1014.2 +020000 04 FILLER PIC X. NC1014.2 +020100 03 FILLER PIC X(50) VALUE SPACE. NC1014.2 +020200 01 TEST-CORRECT. NC1014.2 +020300 02 FILLER PIC X(30) VALUE SPACE. NC1014.2 +020400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1014.2 +020500 02 CORRECT-X. NC1014.2 +020600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1014.2 +020700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1014.2 +020800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1014.2 +020900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1014.2 +021000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1014.2 +021100 03 CR-18V0 REDEFINES CORRECT-A. NC1014.2 +021200 04 CORRECT-18V0 PIC -9(18). NC1014.2 +021300 04 FILLER PIC X. NC1014.2 +021400 03 FILLER PIC X(2) VALUE SPACE. NC1014.2 +021500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1014.2 +021600 01 CCVS-C-1. NC1014.2 +021700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1014.2 +021800- "SS PARAGRAPH-NAME NC1014.2 +021900- " REMARKS". NC1014.2 +022000 02 FILLER PIC X(20) VALUE SPACE. NC1014.2 +022100 01 CCVS-C-2. NC1014.2 +022200 02 FILLER PIC X VALUE SPACE. NC1014.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". NC1014.2 +022400 02 FILLER PIC X(15) VALUE SPACE. NC1014.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". NC1014.2 +022600 02 FILLER PIC X(94) VALUE SPACE. NC1014.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1014.2 +022800 01 REC-CT PIC 99 VALUE ZERO. NC1014.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1014.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1014.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1014.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1014.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1014.2 +023800 01 CCVS-H-1. NC1014.2 +023900 02 FILLER PIC X(39) VALUE SPACES. NC1014.2 +024000 02 FILLER PIC X(42) VALUE NC1014.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1014.2 +024200 02 FILLER PIC X(39) VALUE SPACES. NC1014.2 +024300 01 CCVS-H-2A. NC1014.2 +024400 02 FILLER PIC X(40) VALUE SPACE. NC1014.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1014.2 +024600 02 FILLER PIC XXXX VALUE NC1014.2 +024700 "4.2 ". NC1014.2 +024800 02 FILLER PIC X(28) VALUE NC1014.2 +024900 " COPY - NOT FOR DISTRIBUTION". NC1014.2 +025000 02 FILLER PIC X(41) VALUE SPACE. NC1014.2 +025100 NC1014.2 +025200 01 CCVS-H-2B. NC1014.2 +025300 02 FILLER PIC X(15) VALUE NC1014.2 +025400 "TEST RESULT OF ". NC1014.2 +025500 02 TEST-ID PIC X(9). NC1014.2 +025600 02 FILLER PIC X(4) VALUE NC1014.2 +025700 " IN ". NC1014.2 +025800 02 FILLER PIC X(12) VALUE NC1014.2 +025900 " HIGH ". NC1014.2 +026000 02 FILLER PIC X(22) VALUE NC1014.2 +026100 " LEVEL VALIDATION FOR ". NC1014.2 +026200 02 FILLER PIC X(58) VALUE NC1014.2 +026300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +026400 01 CCVS-H-3. NC1014.2 +026500 02 FILLER PIC X(34) VALUE NC1014.2 +026600 " FOR OFFICIAL USE ONLY ". NC1014.2 +026700 02 FILLER PIC X(58) VALUE NC1014.2 +026800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1014.2 +026900 02 FILLER PIC X(28) VALUE NC1014.2 +027000 " COPYRIGHT 1985 ". NC1014.2 +027100 01 CCVS-E-1. NC1014.2 +027200 02 FILLER PIC X(52) VALUE SPACE. NC1014.2 +027300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1014.2 +027400 02 ID-AGAIN PIC X(9). NC1014.2 +027500 02 FILLER PIC X(45) VALUE SPACES. NC1014.2 +027600 01 CCVS-E-2. NC1014.2 +027700 02 FILLER PIC X(31) VALUE SPACE. NC1014.2 +027800 02 FILLER PIC X(21) VALUE SPACE. NC1014.2 +027900 02 CCVS-E-2-2. NC1014.2 +028000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1014.2 +028100 03 FILLER PIC X VALUE SPACE. NC1014.2 +028200 03 ENDER-DESC PIC X(44) VALUE NC1014.2 +028300 "ERRORS ENCOUNTERED". NC1014.2 +028400 01 CCVS-E-3. NC1014.2 +028500 02 FILLER PIC X(22) VALUE NC1014.2 +028600 " FOR OFFICIAL USE ONLY". NC1014.2 +028700 02 FILLER PIC X(12) VALUE SPACE. NC1014.2 +028800 02 FILLER PIC X(58) VALUE NC1014.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +029000 02 FILLER PIC X(13) VALUE SPACE. NC1014.2 +029100 02 FILLER PIC X(15) VALUE NC1014.2 +029200 " COPYRIGHT 1985". NC1014.2 +029300 01 CCVS-E-4. NC1014.2 +029400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1014.2 +029500 02 FILLER PIC X(4) VALUE " OF ". NC1014.2 +029600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1014.2 +029700 02 FILLER PIC X(40) VALUE NC1014.2 +029800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1014.2 +029900 01 XXINFO. NC1014.2 +030000 02 FILLER PIC X(19) VALUE NC1014.2 +030100 "*** INFORMATION ***". NC1014.2 +030200 02 INFO-TEXT. NC1014.2 +030300 04 FILLER PIC X(8) VALUE SPACE. NC1014.2 +030400 04 XXCOMPUTED PIC X(20). NC1014.2 +030500 04 FILLER PIC X(5) VALUE SPACE. NC1014.2 +030600 04 XXCORRECT PIC X(20). NC1014.2 +030700 02 INF-ANSI-REFERENCE PIC X(48). NC1014.2 +030800 01 HYPHEN-LINE. NC1014.2 +030900 02 FILLER PIC IS X VALUE IS SPACE. NC1014.2 +031000 02 FILLER PIC IS X(65) VALUE IS "************************NC1014.2 +031100- "*****************************************". NC1014.2 +031200 02 FILLER PIC IS X(54) VALUE IS "************************NC1014.2 +031300- "******************************". NC1014.2 +031400 01 CCVS-PGM-ID PIC X(9) VALUE NC1014.2 +031500 "NC101A". NC1014.2 +031600 PROCEDURE DIVISION. NC1014.2 +031700 CCVS1 SECTION. NC1014.2 +031800 OPEN-FILES. NC1014.2 +031900 OPEN OUTPUT PRINT-FILE. NC1014.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1014.2 +032100 MOVE SPACE TO TEST-RESULTS. NC1014.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1014.2 +032300 GO TO CCVS1-EXIT. NC1014.2 +032400 CLOSE-FILES. NC1014.2 +032500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1014.2 +032600 TERMINATE-CCVS. NC1014.2 +032700S EXIT PROGRAM. NC1014.2 +032800STERMINATE-CALL. NC1014.2 +032900 STOP RUN. NC1014.2 +033000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1014.2 +033100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1014.2 +033200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1014.2 +033300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1014.2 +033400 MOVE "****TEST DELETED****" TO RE-MARK. NC1014.2 +033500 PRINT-DETAIL. NC1014.2 +033600 IF REC-CT NOT EQUAL TO ZERO NC1014.2 +033700 MOVE "." TO PARDOT-X NC1014.2 +033800 MOVE REC-CT TO DOTVALUE. NC1014.2 +033900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1014.2 +034000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1014.2 +034100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1014.2 +034200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1014.2 +034300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1014.2 +034400 MOVE SPACE TO CORRECT-X. NC1014.2 +034500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1014.2 +034600 MOVE SPACE TO RE-MARK. NC1014.2 +034700 HEAD-ROUTINE. NC1014.2 +034800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +034900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +035000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1014.2 +035100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1014.2 +035200 COLUMN-NAMES-ROUTINE. NC1014.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +035600 END-ROUTINE. NC1014.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1014.2 +035800 END-RTN-EXIT. NC1014.2 +035900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +036000 END-ROUTINE-1. NC1014.2 +036100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1014.2 +036200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1014.2 +036300 ADD PASS-COUNTER TO ERROR-HOLD. NC1014.2 +036400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1014.2 +036500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1014.2 +036600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1014.2 +036700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1014.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1014.2 +036900 END-ROUTINE-12. NC1014.2 +037000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1014.2 +037100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1014.2 +037200 MOVE "NO " TO ERROR-TOTAL NC1014.2 +037300 ELSE NC1014.2 +037400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1014.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1014.2 +037600 PERFORM WRITE-LINE. NC1014.2 +037700 END-ROUTINE-13. NC1014.2 +037800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1014.2 +037900 MOVE "NO " TO ERROR-TOTAL ELSE NC1014.2 +038000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1014.2 +038100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1014.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038300 IF INSPECT-COUNTER EQUAL TO ZERO NC1014.2 +038400 MOVE "NO " TO ERROR-TOTAL NC1014.2 +038500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1014.2 +038600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1014.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038900 WRITE-LINE. NC1014.2 +039000 ADD 1 TO RECORD-COUNT. NC1014.2 +039100Y IF RECORD-COUNT GREATER 42 NC1014.2 +039200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1014.2 +039300Y MOVE SPACE TO DUMMY-RECORD NC1014.2 +039400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1014.2 +039500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1014.2 +039600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1014.2 +039700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1014.2 +039800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1014.2 +039900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1014.2 +040300Y MOVE ZERO TO RECORD-COUNT. NC1014.2 +040400 PERFORM WRT-LN. NC1014.2 +040500 WRT-LN. NC1014.2 +040600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1014.2 +040700 MOVE SPACE TO DUMMY-RECORD. NC1014.2 +040800 BLANK-LINE-PRINT. NC1014.2 +040900 PERFORM WRT-LN. NC1014.2 +041000 FAIL-ROUTINE. NC1014.2 +041100 IF COMPUTED-X NOT EQUAL TO SPACE NC1014.2 +041200 GO TO FAIL-ROUTINE-WRITE. NC1014.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1014.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1014.2 +041500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1014.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1014.2 +041800 GO TO FAIL-ROUTINE-EX. NC1014.2 +041900 FAIL-ROUTINE-WRITE. NC1014.2 +042000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1014.2 +042100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1014.2 +042200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1014.2 +042300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1014.2 +042400 FAIL-ROUTINE-EX. EXIT. NC1014.2 +042500 BAIL-OUT. NC1014.2 +042600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1014.2 +042700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1014.2 +042800 BAIL-OUT-WRITE. NC1014.2 +042900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1014.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1014.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1014.2 +043300 BAIL-OUT-EX. EXIT. NC1014.2 +043400 CCVS1-EXIT. NC1014.2 +043500 EXIT. NC1014.2 +043600 SECT-NC101A-001 SECTION. NC1014.2 +043700 MPY-INIT-F1-1. NC1014.2 +043800 MOVE "MULTIPLY BY" TO FEATURE. NC1014.2 +043900 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +044000 MOVE 80.12 TO MULT1. NC1014.2 +044100 MOVE 4 TO MULT5. NC1014.2 +044200 MPY-TEST-F1-1. NC1014.2 +044300 MULTIPLY MULT5 BY MULT1. NC1014.2 +044400 IF MULT1 EQUAL TO 320.48 NC1014.2 +044500 PERFORM PASS NC1014.2 +044600 ELSE NC1014.2 +044700 GO TO MPY-FAIL-F1-1. NC1014.2 +044800 GO TO MPY-WRITE-F1-1. NC1014.2 +044900 MPY-DELETE-F1-1. NC1014.2 +045000 PERFORM DE-LETE. NC1014.2 +045100 GO TO MPY-WRITE-F1-1. NC1014.2 +045200 MPY-FAIL-F1-1. NC1014.2 +045300 PERFORM FAIL. NC1014.2 +045400 MOVE MULT1 TO COMPUTED-N. NC1014.2 +045500 MOVE +320.48 TO CORRECT-N. NC1014.2 +045600 MPY-WRITE-F1-1. NC1014.2 +045700 MOVE "MPY-TEST-F1-1 " TO PAR-NAME. NC1014.2 +045800 PERFORM PRINT-DETAIL. NC1014.2 +045900* NC1014.2 +046000 MPY-INIT-F1-2. NC1014.2 +046100 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +046200 MOVE -56 TO MULT4. NC1014.2 +046300 MPY-TEST-F1-2. NC1014.2 +046400 MULTIPLY -1.3 BY MULT4 ROUNDED. NC1014.2 +046500 IF MULT4 EQUAL TO 73 NC1014.2 +046600 PERFORM PASS NC1014.2 +046700 ELSE NC1014.2 +046800 GO TO MPY-FAIL-F1-2. NC1014.2 +046900 GO TO MPY-WRITE-F1-2. NC1014.2 +047000 MPY-DELETE-F1-2. NC1014.2 +047100 PERFORM DE-LETE. NC1014.2 +047200 GO TO MPY-WRITE-F1-2. NC1014.2 +047300 MPY-FAIL-F1-2. NC1014.2 +047400 PERFORM FAIL. NC1014.2 +047500 MOVE MULT4 TO COMPUTED-N. NC1014.2 +047600 MOVE +73 TO CORRECT-N. NC1014.2 +047700 MPY-WRITE-F1-2. NC1014.2 +047800 MOVE "MPY-TEST-F1-2 " TO PAR-NAME. NC1014.2 +047900 PERFORM PRINT-DETAIL. NC1014.2 +048000 NC1014.2 +048100 MPY-INIT-F1-3-1. NC1014.2 +048200 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +048300 MOVE 4 TO MULT5. NC1014.2 +048400 MOVE "A" TO XRAY. NC1014.2 +048500 MPY-TEST-F1-3-0. NC1014.2 +048600 MULTIPLY MULT5 BY MULT5 ON SIZE ERROR NC1014.2 +048700 MOVE "K" TO XRAY. NC1014.2 +048800 MPY-TEST-F1-3-1. NC1014.2 +048900 IF XRAY EQUAL TO "K" NC1014.2 +049000 PERFORM PASS NC1014.2 +049100 ELSE NC1014.2 +049200 GO TO MPY-FAIL-F1-3-1. NC1014.2 +049300 GO TO MPY-WRITE-F1-3-1. NC1014.2 +049400 MPY-DELETE-F1-3-1. NC1014.2 +049500 PERFORM DE-LETE. NC1014.2 +049600 GO TO MPY-WRITE-F1-3-1. NC1014.2 +049700 MPY-FAIL-F1-3-1. NC1014.2 +049800 MOVE XRAY TO COMPUTED-X. NC1014.2 +049900 MOVE "A" TO CORRECT-X. NC1014.2 +050000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +050100 PERFORM FAIL. NC1014.2 +050200 MPY-WRITE-F1-3-1. NC1014.2 +050300 MOVE "MPY-TEST-F1-3-1 " TO PAR-NAME. NC1014.2 +050400 PERFORM PRINT-DETAIL. NC1014.2 +050500 MPY-TEST-F1-3-2. NC1014.2 +050600 IF MULT5 EQUAL TO 4 NC1014.2 +050700 PERFORM PASS NC1014.2 +050800 ELSE NC1014.2 +050900 GO TO MPY-FAIL-F1-3-2. NC1014.2 +051000 GO TO MPY-WRITE-F1-3-2. NC1014.2 +051100 MPY-DELETE-F1-3-2. NC1014.2 +051200 PERFORM DE-LETE. NC1014.2 +051300 GO TO MPY-WRITE-F1-3-2. NC1014.2 +051400 MPY-FAIL-F1-3-2. NC1014.2 +051500 PERFORM FAIL. NC1014.2 +051600 MOVE MULT5 TO COMPUTED-N. NC1014.2 +051700 MOVE +4 TO CORRECT-N. NC1014.2 +051800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +051900 MPY-WRITE-F1-3-2. NC1014.2 +052000 MOVE "MPY-TEST-F1-3-2" TO PAR-NAME. NC1014.2 +052100 PERFORM PRINT-DETAIL. NC1014.2 +052200 NC1014.2 +052300 MPY-INIT-F1-4-1. NC1014.2 +052400 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +052500 MOVE 20 TO MULT6. NC1014.2 +052600 MOVE "B" TO XRAY. NC1014.2 +052700 MPY-TEST-F1-4-O. NC1014.2 +052800 MULTIPLY 4.99 BY MULT6 ROUNDED ON SIZE ERROR NC1014.2 +052900 MOVE "L" TO XRAY. NC1014.2 +053000 MPY-TEST-F1-4-1. NC1014.2 +053100 IF XRAY EQUAL TO "L" NC1014.2 +053200 PERFORM PASS NC1014.2 +053300 ELSE NC1014.2 +053400 GO TO MPY-FAIL-F1-4-1. NC1014.2 +053500 GO TO MPY-WRITE-F1-4-1. NC1014.2 +053600 MPY-DELETE-F1-4-1. NC1014.2 +053700 PERFORM DE-LETE. NC1014.2 +053800 GO TO MPY-WRITE-F1-4-1. NC1014.2 +053900 MPY-FAIL-F1-4-1. NC1014.2 +054000 MOVE "L" TO CORRECT-X. NC1014.2 +054100 MOVE XRAY TO COMPUTED-X. NC1014.2 +054200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +054300 PERFORM FAIL. NC1014.2 +054400 MPY-WRITE-F1-4-1. NC1014.2 +054500 MOVE "MPY-TEST-F1-4-1" TO PAR-NAME. NC1014.2 +054600 PERFORM PRINT-DETAIL. NC1014.2 +054700 MPY-TEST-F1-4-2. NC1014.2 +054800 IF MULT6 EQUAL TO 20 NC1014.2 +054900 PERFORM PASS NC1014.2 +055000 ELSE NC1014.2 +055100 GO TO MPY-FAIL-F1-4-2. NC1014.2 +055200 GO TO MPY-WRITE-F1-4-2. NC1014.2 +055300 MPY-DELETE-F1-4-2. NC1014.2 +055400 PERFORM DE-LETE. NC1014.2 +055500 GO TO MPY-WRITE-F1-4-2. NC1014.2 +055600 MPY-FAIL-F1-4-2. NC1014.2 +055700 PERFORM FAIL. NC1014.2 +055800 MOVE MULT6 TO COMPUTED-N. NC1014.2 +055900 MOVE +20 TO CORRECT-N. NC1014.2 +056000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +056100 MPY-WRITE-F1-4-2. NC1014.2 +056200 MOVE "MPY-TEST-F1-4-2" TO PAR-NAME. NC1014.2 +056300 PERFORM PRINT-DETAIL. NC1014.2 +056400 NC1014.2 +056500 MPY-INIT-F1-5. NC1014.2 +056600 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +056700 MOVE 222222222222 TO WRK-DS-18V00. NC1014.2 +056800 MPY-TEST-F1-5-0. NC1014.2 +056900 MULTIPLY A06THREES-DS-03V03 BY WRK-DS-18V00. NC1014.2 +057000 MPY-TEST-F1-5-1. NC1014.2 +057100 IF WRK-DS-18V00 EQUAL TO 000074073999999925 NC1014.2 +057200 PERFORM PASS NC1014.2 +057300 GO TO MPY-WRITE-F1-5. NC1014.2 +057400 GO TO MPY-FAIL-F1-5. NC1014.2 +057500 MPY-DELETE-F1-5. NC1014.2 +057600 PERFORM DE-LETE. NC1014.2 +057700 GO TO MPY-WRITE-F1-5. NC1014.2 +057800 MPY-FAIL-F1-5. NC1014.2 +057900 MOVE 000074073999999925 TO CORRECT-18V0. NC1014.2 +058000 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1014.2 +058100 PERFORM FAIL. NC1014.2 +058200 MPY-WRITE-F1-5. NC1014.2 +058300 MOVE "MPY-TEST-F1-5 " TO PAR-NAME. NC1014.2 +058400 PERFORM PRINT-DETAIL. NC1014.2 +058500 NC1014.2 +058600 MPY-INIT-F1-6. NC1014.2 +058700 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +058800 MOVE A08TWOS-DS-02V06 TO WRK-DS-06V06. NC1014.2 +058900 MPY-TEST-F1-6-0. NC1014.2 +059000 MULTIPLY 0.4 BY WRK-DS-06V06 ROUNDED. NC1014.2 +059100 MPY-TEST-F1-6-1. NC1014.2 +059200 IF WRK-DS-12V00-S EQUAL TO 000008888889 NC1014.2 +059300 PERFORM PASS NC1014.2 +059400 GO TO MPY-WRITE-F1-6. NC1014.2 +059500 GO TO MPY-FAIL-F1-6. NC1014.2 +059600 MPY-DELETE-F1-6. NC1014.2 +059700 PERFORM DE-LETE. NC1014.2 +059800 GO TO MPY-WRITE-F1-6. NC1014.2 +059900 MPY-FAIL-F1-6. NC1014.2 +060000 MOVE WRK-DS-12V00-S TO COMPUTED-18V0. NC1014.2 +060100 MOVE 000008888889 TO CORRECT-18V0. NC1014.2 +060200 PERFORM FAIL. NC1014.2 +060300 MPY-WRITE-F1-6. NC1014.2 +060400 MOVE "MPY-TEST-F1-6 " TO PAR-NAME. NC1014.2 +060500 PERFORM PRINT-DETAIL. NC1014.2 +060600 NC1014.2 +060700 MPY-INIT-F1-7. NC1014.2 +060800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +060900 MOVE "0" TO WRK-XN-00001. NC1014.2 +061000 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +061100 MPY-TEST-F1-7-0. NC1014.2 +061200 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +061300 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +061400 MPY-TEST-F1-7-1. NC1014.2 +061500 IF WRK-DS-10V00 EQUAL TO 1111111111 NC1014.2 +061600 PERFORM PASS NC1014.2 +061700 GO TO MPY-WRITE-F1-7-1. NC1014.2 +061800 GO TO MPY-FAIL-F1-7-1. NC1014.2 +061900 MPY-DELETE-F1-7-1. NC1014.2 +062000 PERFORM DE-LETE. NC1014.2 +062100 GO TO MPY-WRITE-F1-7-1. NC1014.2 +062200 MPY-FAIL-F1-7-1. NC1014.2 +062300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1014.2 +062400 MOVE 1111111111 TO CORRECT-18V0. NC1014.2 +062500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +062600 PERFORM FAIL. NC1014.2 +062700 MPY-WRITE-F1-7-1. NC1014.2 +062800 MOVE "MPY-TEST-F1-7-1 " TO PAR-NAME. NC1014.2 +062900 PERFORM PRINT-DETAIL. NC1014.2 +063000 MPY-TEST-F1-7-2. NC1014.2 +063100 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +063200 PERFORM PASS NC1014.2 +063300 GO TO MPY-WRITE-F1-7-2. NC1014.2 +063400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +063500 MOVE "1" TO CORRECT-A. NC1014.2 +063600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +063700 PERFORM FAIL. NC1014.2 +063800 GO TO MPY-WRITE-F1-7-2. NC1014.2 +063900 MPY-DELETE-F1-7-2. NC1014.2 +064000 PERFORM DE-LETE. NC1014.2 +064100 MPY-WRITE-F1-7-2. NC1014.2 +064200 MOVE "MPY-TEST-F1-7-2 " TO PAR-NAME. NC1014.2 +064300 PERFORM PRINT-DETAIL. NC1014.2 +064400 NC1014.2 +064500 MPY-INIT-F1-8. NC1014.2 +064600 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +064700 MOVE "1" TO WRK-XN-00001. NC1014.2 +064800 MOVE -99 TO WRK-DS-02V00. NC1014.2 +064900 MPY-TEST-F1-8-0. NC1014.2 +065000 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +065100 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +065200 MPY-TEST-F1-8-1. NC1014.2 +065300 IF WRK-DS-02V00 EQUAL TO 00 NC1014.2 +065400 PERFORM PASS NC1014.2 +065500 GO TO MPY-WRITE-F1-8-1. NC1014.2 +065600 GO TO MPY-FAIL-F1-8-1. NC1014.2 +065700 MPY-DELETE-F1-8-1. NC1014.2 +065800 PERFORM DE-LETE. NC1014.2 +065900 GO TO MPY-WRITE-F1-8-1. NC1014.2 +066000 MPY-FAIL-F1-8-1. NC1014.2 +066100 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +066200 MOVE 00 TO CORRECT-N. NC1014.2 +066300 PERFORM FAIL. NC1014.2 +066400 MPY-WRITE-F1-8-1. NC1014.2 +066500 MOVE "MPY-TEST-F1-8-1 " TO PAR-NAME. NC1014.2 +066600 PERFORM PRINT-DETAIL. NC1014.2 +066700 MPY-TEST-F1-8-2. NC1014.2 +066800 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +066900 PERFORM PASS NC1014.2 +067000 GO TO MPY-WRITE-F1-8-2. NC1014.2 +067100 MOVE "1" TO CORRECT-A. NC1014.2 +067200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +067300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1014.2 +067400 PERFORM FAIL. NC1014.2 +067500 GO TO MPY-WRITE-F1-8-2. NC1014.2 +067600 MPY-DELETE-F1-8-2. NC1014.2 +067700 PERFORM DE-LETE. NC1014.2 +067800 MPY-WRITE-F1-8-2. NC1014.2 +067900 MOVE "MPY-TEST-F1-8-2 " TO PAR-NAME. NC1014.2 +068000 PERFORM PRINT-DETAIL. NC1014.2 +068100 NC1014.2 +068200 MPY-INIT-F1-9. NC1014.2 +068300 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +068400 MOVE "0" TO WRK-XN-00001. NC1014.2 +068500 MOVE -01 TO WRK-DS-02V00. NC1014.2 +068600 MPY-TEST-F1-9-0. NC1014.2 +068700 MULTIPLY 99.5 BY WRK-DS-02V00 ROUNDED NC1014.2 +068800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +068900 MPY-TEST-F1-9-1. NC1014.2 +069000 IF WRK-DS-02V00 EQUAL TO -01 NC1014.2 +069100 PERFORM PASS NC1014.2 +069200 GO TO MPY-WRITE-F1-9-1. NC1014.2 +069300 GO TO MPY-FAIL-F1-9-1. NC1014.2 +069400 MPY-DELETE-F1-9-1. NC1014.2 +069500 PERFORM DE-LETE. NC1014.2 +069600 GO TO MPY-WRITE-F1-9-1. NC1014.2 +069700 MPY-FAIL-F1-9-1. NC1014.2 +069800 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +069900 MOVE -01 TO CORRECT-N. NC1014.2 +070000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +070100 PERFORM FAIL. NC1014.2 +070200 MPY-WRITE-F1-9-1. NC1014.2 +070300 MOVE "MPY-TEST-F1-9-1 " TO PAR-NAME. NC1014.2 +070400 PERFORM PRINT-DETAIL. NC1014.2 +070500 MPY-TEST-F1-9-2. NC1014.2 +070600 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +070700 PERFORM PASS NC1014.2 +070800 GO TO MPY-WRITE-F1-9-2. NC1014.2 +070900 MOVE "1" TO CORRECT-A. NC1014.2 +071000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +071100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +071200 PERFORM FAIL. NC1014.2 +071300 GO TO MPY-WRITE-F1-9-2. NC1014.2 +071400 MPY-DELETE-F1-9-2. NC1014.2 +071500 PERFORM DE-LETE. NC1014.2 +071600 MPY-WRITE-F1-9-2. NC1014.2 +071700 MOVE "MPY-TEST-F1-9-2 " TO PAR-NAME. NC1014.2 +071800 PERFORM PRINT-DETAIL. NC1014.2 +071900 NC1014.2 +072000 MPY-INIT-F1-10. NC1014.2 +072100 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +072200 MOVE "1" TO WRK-XN-00001. NC1014.2 +072300 MOVE -01 TO WRK-DS-02V00. NC1014.2 +072400 MPY-TEST-F1-10-0. NC1014.2 +072500 MULTIPLY 99.4 BY WRK-DS-02V00 ROUNDED NC1014.2 +072600 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +072700 MPY-TEST-F1-10-1. NC1014.2 +072800 IF WRK-DS-02V00 EQUAL TO -99 NC1014.2 +072900 PERFORM PASS NC1014.2 +073000 GO TO MPY-WRITE-F1-10-1. NC1014.2 +073100 GO TO MPY-FAIL-F1-10-1. NC1014.2 +073200 MPY-DELETE-F1-10-1. NC1014.2 +073300 PERFORM DE-LETE. NC1014.2 +073400 GO TO MPY-WRITE-F1-10-1. NC1014.2 +073500 MPY-FAIL-F1-10-1. NC1014.2 +073600 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +073700 MOVE -99 TO CORRECT-N. NC1014.2 +073800 PERFORM FAIL. NC1014.2 +073900 MPY-WRITE-F1-10-1. NC1014.2 +074000 MOVE "MPY-TEST-F1-10-1 " TO PAR-NAME. NC1014.2 +074100 PERFORM PRINT-DETAIL. NC1014.2 +074200 MPY-TEST-F1-10-2. NC1014.2 +074300 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +074400 PERFORM PASS NC1014.2 +074500 GO TO MPY-WRITE-F1-10-2. NC1014.2 +074600 MOVE "1" TO CORRECT-A. NC1014.2 +074700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +074800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1014.2 +074900 PERFORM FAIL. NC1014.2 +075000 GO TO MPY-WRITE-F1-10-2. NC1014.2 +075100 MPY-DELETE-F1-10-2. NC1014.2 +075200 PERFORM DE-LETE. NC1014.2 +075300 MPY-WRITE-F1-10-2. NC1014.2 +075400 MOVE "MPY-TEST-F1-10-2 " TO PAR-NAME. NC1014.2 +075500 PERFORM PRINT-DETAIL. NC1014.2 +075600 NC1014.2 +075700 MPY-INIT-F1-11. NC1014.2 +075800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +075900 MOVE -990 TO WRK-DS-0201P. NC1014.2 +076000 MPY-TEST-F1-11-0. NC1014.2 +076100 MULTIPLY A01ONE-CS-00V01 BY WRK-DS-0201P. NC1014.2 +076200 MPY-TEST-F1-11. NC1014.2 +076300 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1014.2 +076400 IF WRK-DS-05V00 EQUAL TO -00090 NC1014.2 +076500 PERFORM PASS NC1014.2 +076600 GO TO MPY-WRITE-F1-11. NC1014.2 +076700 MOVE -00090 TO CORRECT-N. NC1014.2 +076800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1014.2 +076900 PERFORM FAIL. NC1014.2 +077000 GO TO MPY-WRITE-F1-11. NC1014.2 +077100 MPY-DELETE-F1-11. NC1014.2 +077200 PERFORM DE-LETE. NC1014.2 +077300 MPY-WRITE-F1-11. NC1014.2 +077400 MOVE "MPY-TEST-F1-11 " TO PAR-NAME. NC1014.2 +077500 PERFORM PRINT-DETAIL. NC1014.2 +077600 NC1014.2 +077700 MPY-INIT-F1-12. NC1014.2 +077800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +077900 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1014.2 +078000 MPY-TEST-F1-12-0. NC1014.2 +078100 MULTIPLY A01ONE-DS-P0801 BY WRK-CS-18V00. NC1014.2 +078200 MPY-TEST-F1-12. NC1014.2 +078300 MOVE WRK-CS-18V00 TO WRK-DU-18V00. NC1014.2 +078400 IF WRK-DU-18V00 EQUAL TO 000000000111111111 NC1014.2 +078500 PERFORM PASS NC1014.2 +078600 GO TO MPY-WRITE-F1-12. NC1014.2 +078700 MOVE 000000000111111111 TO CORRECT-18V0. NC1014.2 +078800 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1014.2 +078900 PERFORM FAIL. NC1014.2 +079000 GO TO MPY-WRITE-F1-12. NC1014.2 +079100 MPY-DELETE-F1-12. NC1014.2 +079200 PERFORM DE-LETE. NC1014.2 +079300 MPY-WRITE-F1-12. NC1014.2 +079400 MOVE "MPY-TEST-F1-12 " TO PAR-NAME. NC1014.2 +079500 PERFORM PRINT-DETAIL. NC1014.2 +079600* NC1014.2 +079700* NC1014.2 +079800 MPY-INIT-F1-13. NC1014.2 +079900* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +080000 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +080100 MOVE "MPY-TEST-F1-13 " TO PAR-NAME. NC1014.2 +080200 MOVE "0" TO WRK-XN-00001. NC1014.2 +080300 MOVE 1111111111 TO WRK-DS-10V00. NC1014.2 +080400 MOVE 1 TO REC-CT. NC1014.2 +080500 MPY-TEST-F1-13-0. NC1014.2 +080600 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +080700 ON SIZE ERROR GO TO MPY-TEST-F1-13-1 NC1014.2 +080800 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +080900 GO TO MPY-TEST-F1-13-1. NC1014.2 +081000 MPY-DELETE-F1-13. NC1014.2 +081100 PERFORM DE-LETE. NC1014.2 +081200 PERFORM PRINT-DETAIL. NC1014.2 +081300 GO TO MPY-INIT-F1-14. NC1014.2 +081400 MPY-TEST-F1-13-1. NC1014.2 +081500 MOVE "MPY-TEST-F1-13-1" TO PAR-NAME NC1014.2 +081600 IF WRK-XN-00001 = "0" NC1014.2 +081700 PERFORM PASS NC1014.2 +081800 PERFORM PRINT-DETAIL NC1014.2 +081900 ELSE NC1014.2 +082000 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +082100 MOVE "0" TO CORRECT-X NC1014.2 +082200 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +082300 PERFORM FAIL NC1014.2 +082400 PERFORM PRINT-DETAIL. NC1014.2 +082500 ADD 1 TO REC-CT. NC1014.2 +082600 MPY-TEST-F1-13-2. NC1014.2 +082700 MOVE "MPY-TEST-F1-13-2" TO PAR-NAME NC1014.2 +082800 IF WRK-DS-10V00 = 1111111111 NC1014.2 +082900 PERFORM PASS NC1014.2 +083000 PERFORM PRINT-DETAIL NC1014.2 +083100 ELSE NC1014.2 +083200 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +083300 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +083400 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +083500 PERFORM FAIL NC1014.2 +083600 PERFORM PRINT-DETAIL. NC1014.2 +083700* NC1014.2 +083800* NC1014.2 +083900 MPY-INIT-F1-14. NC1014.2 +084000* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +084100 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +084200 MOVE "MPY-TEST-F1-14 " TO PAR-NAME. NC1014.2 +084300 MOVE "1" TO WRK-XN-00001. NC1014.2 +084400 MOVE 1 TO REC-CT. NC1014.2 +084500 MOVE -99 TO WRK-DS-02V00. NC1014.2 +084600 MPY-TEST-F1-14-0. NC1014.2 +084700 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +084800 ON SIZE ERROR GO TO MPY-TEST-F1-14-1 NC1014.2 +084900 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +085000 GO TO MPY-TEST-F1-14-1. NC1014.2 +085100 MPY-DELETE-F1-14. NC1014.2 +085200 PERFORM DE-LETE. NC1014.2 +085300 PERFORM PRINT-DETAIL. NC1014.2 +085400 GO TO MPY-INIT-F1-15. NC1014.2 +085500 MPY-TEST-F1-14-1. NC1014.2 +085600 MOVE "MPY-TEST-F1-14-1" TO PAR-NAME. NC1014.2 +085700 IF WRK-XN-00001 = "0" NC1014.2 +085800 PERFORM PASS NC1014.2 +085900 PERFORM PRINT-DETAIL NC1014.2 +086000 ELSE NC1014.2 +086100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +086200 MOVE "0" TO CORRECT-X NC1014.2 +086300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +086400 TO RE-MARK NC1014.2 +086500 PERFORM FAIL NC1014.2 +086600 PERFORM PRINT-DETAIL. NC1014.2 +086700 ADD 1 TO REC-CT. NC1014.2 +086800 MPY-TEST-F1-14-2. NC1014.2 +086900 MOVE "MPY-TEST-F1-14-2" TO PAR-NAME. NC1014.2 +087000 IF WRK-DS-02V00 = 00 NC1014.2 +087100 PERFORM PASS NC1014.2 +087200 PERFORM PRINT-DETAIL NC1014.2 +087300 ELSE NC1014.2 +087400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +087500 MOVE 00 TO CORRECT-N NC1014.2 +087600 PERFORM FAIL NC1014.2 +087700 PERFORM PRINT-DETAIL. NC1014.2 +087800* NC1014.2 +087900* NC1014.2 +088000 MPY-INIT-F1-15. NC1014.2 +088100* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +088200 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +088300 MOVE "0" TO WRK-XN-00001. NC1014.2 +088400 MOVE 1111111111 TO WRK-DS-10V00. NC1014.2 +088500 MOVE 1 TO REC-CT. NC1014.2 +088600 MPY-TEST-F1-15-0. NC1014.2 +088700 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +088800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +088900 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +089000 GO TO MPY-TEST-F1-15-1. NC1014.2 +089100 MPY-DELETE-F1-15. NC1014.2 +089200 PERFORM DE-LETE. NC1014.2 +089300 PERFORM PRINT-DETAIL. NC1014.2 +089400 GO TO MPY-INIT-F1-16. NC1014.2 +089500 MPY-TEST-F1-15-1. NC1014.2 +089600 MOVE "MPY-TEST-F1-15-1" TO PAR-NAME. NC1014.2 +089700 IF WRK-XN-00001 = "1" NC1014.2 +089800 PERFORM PASS NC1014.2 +089900 PERFORM PRINT-DETAIL NC1014.2 +090000 ELSE NC1014.2 +090100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +090200 MOVE "1" TO CORRECT-X NC1014.2 +090300 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +090400 PERFORM FAIL NC1014.2 +090500 PERFORM PRINT-DETAIL. NC1014.2 +090600 ADD 1 TO REC-CT. NC1014.2 +090700 MPY-TEST-F1-15-2. NC1014.2 +090800 MOVE "MPY-TEST-F1-15-2" TO PAR-NAME. NC1014.2 +090900 IF WRK-DS-10V00 = 1111111111 NC1014.2 +091000 PERFORM PASS NC1014.2 +091100 PERFORM PRINT-DETAIL NC1014.2 +091200 ELSE NC1014.2 +091300 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +091400 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +091500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1014.2 +091600 PERFORM FAIL NC1014.2 +091700 PERFORM PRINT-DETAIL. NC1014.2 +091800* NC1014.2 +091900* NC1014.2 +092000 MPY-INIT-F1-16. NC1014.2 +092100* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +092200 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +092300 MOVE "0" TO WRK-XN-00001. NC1014.2 +092400 MOVE -99 TO WRK-DS-02V00. NC1014.2 +092500 MOVE 1 TO REC-CT. NC1014.2 +092600 MPY-TEST-F1-16-0. NC1014.2 +092700 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +092800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +092900 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +093000 GO TO MPY-TEST-F1-16-1. NC1014.2 +093100 MPY-DELETE-F1-16. NC1014.2 +093200 PERFORM DE-LETE. NC1014.2 +093300 PERFORM PRINT-DETAIL. NC1014.2 +093400 GO TO MPY-INIT-F1-17. NC1014.2 +093500 MPY-TEST-F1-16-1. NC1014.2 +093600 MOVE "MPY-TEST-F1-16-1" TO PAR-NAME. NC1014.2 +093700 IF WRK-XN-00001 = "2" NC1014.2 +093800 PERFORM PASS NC1014.2 +093900 PERFORM PRINT-DETAIL NC1014.2 +094000 ELSE NC1014.2 +094100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +094200 MOVE "2" TO CORRECT-X NC1014.2 +094300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +094400 TO RE-MARK NC1014.2 +094500 PERFORM FAIL NC1014.2 +094600 PERFORM PRINT-DETAIL. NC1014.2 +094700 ADD 1 TO REC-CT. NC1014.2 +094800 MPY-TEST-F1-16-2. NC1014.2 +094900 MOVE "MPY-TEST-F1-16-2" TO PAR-NAME. NC1014.2 +095000 IF WRK-DS-02V00 = 00 NC1014.2 +095100 PERFORM PASS NC1014.2 +095200 PERFORM PRINT-DETAIL NC1014.2 +095300 ELSE NC1014.2 +095400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +095500 MOVE 00 TO CORRECT-N NC1014.2 +095600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1014.2 +095700 PERFORM FAIL NC1014.2 +095800 PERFORM PRINT-DETAIL. NC1014.2 +095900* NC1014.2 +096000* NC1014.2 +096100 MPY-INIT-F1-17. NC1014.2 +096200 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +096300* ===--> MULTIPLE RESULT FIELDS <--=== NC1014.2 +096400 MOVE "MPY-TEST-F1-17" TO PAR-NAME. NC1014.2 +096500 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +096600 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +096700 MOVE 1 TO REC-CT. NC1014.2 +096800 MPY-TEST-F1-17-0. NC1014.2 +096900 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +097000 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1. NC1014.2 +097100 GO TO MPY-TEST-F1-17-1. NC1014.2 +097200 MPY-DELETE-F1-17. NC1014.2 +097300 PERFORM DE-LETE. NC1014.2 +097400 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +097500 PERFORM PRINT-DETAIL. NC1014.2 +097600 GO TO MPY-INIT-F1-18. NC1014.2 +097700 MPY-TEST-F1-17-1. NC1014.2 +097800 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +097900 ELSE NC1014.2 +098000 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +098100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +098200 ADD 1 TO REC-CT. NC1014.2 +098300 MPY-TEST-F1-17-2. NC1014.2 +098400 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +098500 ELSE NC1014.2 +098600 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +098700 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +098800 ADD 1 TO REC-CT. NC1014.2 +098900 MPY-TEST-F1-17-3. NC1014.2 +099000 IF WRK-DU-6V0-1 = 1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +099100 ELSE NC1014.2 +099200 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 1 NC1014.2 +099300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +099400 ADD 1 TO REC-CT. NC1014.2 +099500 MPY-TEST-F1-17-4. NC1014.2 +099600 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +099700 ELSE NC1014.2 +099800 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +099900 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +100000 ADD 1 TO REC-CT. NC1014.2 +100100 MPY-TEST-F1-17-5. NC1014.2 +100200 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +100300 PRINT-DETAIL ELSE NC1014.2 +100400 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +100500 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +100600* NC1014.2 +100700 MPY-INIT-F1-18. NC1014.2 +100800* => SIZE ERROR CONDITION. <--== NC1014.2 +100900* ==--> MULTIPLE RESULT FIELDS<--== NC1014.2 +101000* ===--> & SIZE ERROR CONDITIONS<--=== NC1014.2 +101100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +101200 MOVE "MPY-TEST-F1-18" TO PAR-NAME. NC1014.2 +101300 MOVE "0" TO WRK-XN-00001. NC1014.2 +101400 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +101500 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +101600 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +101700 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +101800 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +101900 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +102000 MOVE 1 TO REC-CT. NC1014.2 +102100 MPY-TEST-F1-18-0. NC1014.2 +102200 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +102300 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +102400 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +102500 GO TO MPY-TEST-F1-18-1. NC1014.2 +102600 MPY-DELETE-F1-18. NC1014.2 +102700 PERFORM DE-LETE. NC1014.2 +102800 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +102900 PERFORM PRINT-DETAIL. NC1014.2 +103000 GO TO MPY-INIT-F1-19. NC1014.2 +103100 MPY-TEST-F1-18-1. NC1014.2 +103200 IF WRK-DU-2V0-1 = 99 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +103300 ELSE NC1014.2 +103400 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 99 NC1014.2 +103500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +103600 ADD 1 TO REC-CT. NC1014.2 +103700 MPY-TEST-F1-18-2. NC1014.2 +103800 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +103900 ELSE NC1014.2 +104000 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +104100 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +104200 ADD 1 TO REC-CT. NC1014.2 +104300 MPY-TEST-F1-18-3. NC1014.2 +104400 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +104500 ELSE NC1014.2 +104600 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +104700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +104800 ADD 1 TO REC-CT. NC1014.2 +104900 MPY-TEST-F1-18-4. NC1014.2 +105000 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +105100 ELSE NC1014.2 +105200 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +105300 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +105400 ADD 1 TO REC-CT. NC1014.2 +105500 MPY-TEST-F1-18-5. NC1014.2 +105600 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +105700 PRINT-DETAIL ELSE NC1014.2 +105800 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE 0 NC1014.2 +105900 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +106000 ADD 1 TO REC-CT. NC1014.2 +106100 MPY-TEST-F1-18-6. NC1014.2 +106200 IF WRK-XN-00001 = "1" NC1014.2 +106300 PERFORM PASS NC1014.2 +106400 PERFORM PRINT-DETAIL NC1014.2 +106500 ELSE NC1014.2 +106600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +106700 TO RE-MARK NC1014.2 +106800 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +106900 MOVE "1" TO CORRECT-X NC1014.2 +107000 PERFORM PRINT-DETAIL. NC1014.2 +107100* NC1014.2 +107200 MPY-INIT-F1-19. NC1014.2 +107300* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +107400* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +107500* ===--> & SIZE ERROR CONDITIONS <--=== NC1014.2 +107600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +107700 MOVE "MPY-TEST-F1-19" TO PAR-NAME. NC1014.2 +107800 MOVE "0" TO WRK-XN-00001. NC1014.2 +107900 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +108000 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +108100 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +108200 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +108300 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +108400 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +108500 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +108600 MOVE 1 TO REC-CT. NC1014.2 +108700 MPY-TEST-F1-19-0. NC1014.2 +108800 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +108900 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 NC1014.2 +109000 WRK-DU-0V12-1 NC1014.2 +109100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +109200 GO TO MPY-TEST-F1-19-1. NC1014.2 +109300 MPY-DELETE-F1-19. NC1014.2 +109400 PERFORM DE-LETE. NC1014.2 +109500 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +109600 PERFORM PRINT-DETAIL. NC1014.2 +109700 GO TO MPY-INIT-F1-20. NC1014.2 +109800 MPY-TEST-F1-19-1. NC1014.2 +109900 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +110000 ELSE NC1014.2 +110100 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +110200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +110300 ADD 1 TO REC-CT. NC1014.2 +110400 MPY-TEST-F1-19-2. NC1014.2 +110500 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +110600 ELSE NC1014.2 +110700 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +110800 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +110900 ADD 1 TO REC-CT. NC1014.2 +111000 MPY-TEST-F1-19-3. NC1014.2 +111100 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +111200 ELSE NC1014.2 +111300 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +111400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +111500 ADD 1 TO REC-CT. NC1014.2 +111600 MPY-TEST-F1-19-4. NC1014.2 +111700 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +111800 ELSE NC1014.2 +111900 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +112000 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +112100 ADD 1 TO REC-CT. NC1014.2 +112200 MPY-TEST-F1-19-5. NC1014.2 +112300 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +112400 PRINT-DETAIL ELSE NC1014.2 +112500 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +112600 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +112700 ADD 1 TO REC-CT. NC1014.2 +112800 MPY-TEST-F1-19-6. NC1014.2 +112900 IF WRK-XN-00001 = "0" NC1014.2 +113000 PERFORM PASS NC1014.2 +113100 PERFORM PRINT-DETAIL NC1014.2 +113200 ELSE NC1014.2 +113300 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC1014.2 +113400 TO RE-MARK NC1014.2 +113500 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +113600 MOVE "0" TO CORRECT-X NC1014.2 +113700 PERFORM PRINT-DETAIL. NC1014.2 +113800* NC1014.2 +113900 MPY-INIT-F1-20. NC1014.2 +114000* ==--> SIZE ERROR CONDITION. <--== NC1014.2 +114100* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +114200* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +114300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +114400 MOVE "MPY-TEST-F1-20" TO PAR-NAME. NC1014.2 +114500 MOVE "0" TO WRK-XN-00001. NC1014.2 +114600 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +114700 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +114800 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +114900 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +115000 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +115100 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +115200 MOVE 1 TO REC-CT. NC1014.2 +115300 MPY-TEST-F1-20-0. NC1014.2 +115400 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +115500 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +115600 ON SIZE ERROR GO TO MPY-TEST-F1-20-1 NC1014.2 +115700 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +115800 GO TO MPY-TEST-F1-20-1. NC1014.2 +115900 MPY-DELETE-F1-20. NC1014.2 +116000 PERFORM DE-LETE. NC1014.2 +116100 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +116200 PERFORM PRINT-DETAIL. NC1014.2 +116300 GO TO MPY-INIT-F1-21. NC1014.2 +116400 MPY-TEST-F1-20-1. NC1014.2 +116500 IF WRK-DU-2V0-1 = 99 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +116600 ELSE NC1014.2 +116700 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 99 NC1014.2 +116800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +116900 ADD 1 TO REC-CT. NC1014.2 +117000 MPY-TEST-F1-20-2. NC1014.2 +117100 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +117200 ELSE NC1014.2 +117300 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +117400 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +117500 ADD 1 TO REC-CT. NC1014.2 +117600 MPY-TEST-F1-20-3. NC1014.2 +117700 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +117800 ELSE NC1014.2 +117900 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +118000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +118100 ADD 1 TO REC-CT. NC1014.2 +118200 MPY-TEST-F1-20-4. NC1014.2 +118300 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +118400 ELSE NC1014.2 +118500 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +118600 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +118700 ADD 1 TO REC-CT. NC1014.2 +118800 MPY-TEST-F1-20-5. NC1014.2 +118900 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +119000 PRINT-DETAIL ELSE NC1014.2 +119100 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE 0 NC1014.2 +119200 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +119300 ADD 1 TO REC-CT. NC1014.2 +119400 MPY-TEST-F1-20-6. NC1014.2 +119500 IF WRK-XN-00001 = "0" NC1014.2 +119600 PERFORM PASS NC1014.2 +119700 PERFORM PRINT-DETAIL NC1014.2 +119800 ELSE NC1014.2 +119900 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC1014.2 +120000 TO RE-MARK NC1014.2 +120100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +120200 MOVE "0" TO CORRECT-X NC1014.2 +120300 PERFORM PRINT-DETAIL. NC1014.2 +120400* NC1014.2 +120500 MPY-INIT-F1-21. NC1014.2 +120600* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +120700* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +120800* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +120900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +121000 MOVE "MPY-TEST-F1-21" TO PAR-NAME. NC1014.2 +121100 MOVE "0" TO WRK-XN-00001. NC1014.2 +121200 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +121300 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +121400 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +121500 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +121600 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +121700 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +121800 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +121900 MOVE 1 TO REC-CT. NC1014.2 +122000 MPY-TEST-F1-21-0. NC1014.2 +122100 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +122200 WRK-DU-6V0-1 ROUNDED NC1014.2 +122300 WRK-DU-6V0-2 ROUNDED WRK-DU-0V12-1 NC1014.2 +122400 ON SIZE ERROR GO TO MPY-TEST-F1-21-1 NC1014.2 +122500 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +122600 GO TO MPY-TEST-F1-21-1. NC1014.2 +122700 MPY-DELETE-F1-21. NC1014.2 +122800 PERFORM DE-LETE. NC1014.2 +122900 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +123000 PERFORM PRINT-DETAIL. NC1014.2 +123100 GO TO MPY-INIT-F1-22. NC1014.2 +123200 MPY-TEST-F1-21-1. NC1014.2 +123300 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +123400 ELSE NC1014.2 +123500 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +123600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +123700 ADD 1 TO REC-CT. NC1014.2 +123800 MPY-TEST-F1-21-2. NC1014.2 +123900 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +124000 ELSE NC1014.2 +124100 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +124200 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +124300 ADD 1 TO REC-CT. NC1014.2 +124400 MPY-TEST-F1-21-3. NC1014.2 +124500 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +124600 ELSE NC1014.2 +124700 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 1 NC1014.2 +124800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +124900 ADD 1 TO REC-CT. NC1014.2 +125000 MPY-TEST-F1-21-4. NC1014.2 +125100 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +125200 ELSE NC1014.2 +125300 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +125400 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +125500 ADD 1 TO REC-CT. NC1014.2 +125600 MPY-TEST-F1-21-5. NC1014.2 +125700 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +125800 PRINT-DETAIL ELSE NC1014.2 +125900 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +126000 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +126100 ADD 1 TO REC-CT. NC1014.2 +126200 MPY-TEST-F1-21-6. NC1014.2 +126300 IF WRK-XN-00001 = "1" NC1014.2 +126400 PERFORM PASS NC1014.2 +126500 PERFORM PRINT-DETAIL NC1014.2 +126600 ELSE NC1014.2 +126700 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +126800 TO RE-MARK NC1014.2 +126900 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +127000 MOVE "1" TO CORRECT-X NC1014.2 +127100 PERFORM PRINT-DETAIL. NC1014.2 +127200* NC1014.2 +127300 MPY-INIT-F1-22. NC1014.2 +127400* ==--> SIZE ERROR CONDITION. <--== NC1014.2 +127500* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +127600* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +127700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +127800 MOVE "MPY-TEST-F1-22" TO PAR-NAME. NC1014.2 +127900 MOVE "0" TO WRK-XN-00001. NC1014.2 +128000 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +128100 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +128200 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +128300 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +128400 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +128500 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +128600 MOVE 1 TO REC-CT. NC1014.2 +128700 MPY-TEST-F1-22-0. NC1014.2 +128800 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +128900 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +129000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +129100 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +129200 GO TO MPY-TEST-F1-22-1. NC1014.2 +129300 MPY-DELETE-F1-22. NC1014.2 +129400 PERFORM DE-LETE. NC1014.2 +129500 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +129600 PERFORM PRINT-DETAIL. NC1014.2 +129700 GO TO MPY-INIT-F1-23. NC1014.2 +129800 MPY-TEST-F1-22-1. NC1014.2 +129900 IF WRK-DU-5V1-1 = 12345.6 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +130000 ELSE NC1014.2 +130100 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE 12345.6 NC1014.2 +130200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +130300 ADD 1 TO REC-CT. NC1014.2 +130400 MPY-TEST-F1-22-2. NC1014.2 +130500 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +130600 ELSE NC1014.2 +130700 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +130800 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +130900 ADD 1 TO REC-CT. NC1014.2 +131000 MPY-TEST-F1-22-3. NC1014.2 +131100 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +131200 ELSE NC1014.2 +131300 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +131400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +131500 ADD 1 TO REC-CT. NC1014.2 +131600 MPY-TEST-F1-22-4. NC1014.2 +131700 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +131800 ELSE NC1014.2 +131900 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +132000 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +132100 ADD 1 TO REC-CT. NC1014.2 +132200 MPY-TEST-F1-22-5. NC1014.2 +132300 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +132400 PRINT-DETAIL ELSE NC1014.2 +132500 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +132600 0 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +132700 ADD 1 TO REC-CT. NC1014.2 +132800 MPY-TEST-F1-22-6. NC1014.2 +132900 IF WRK-XN-00001 = "1" NC1014.2 +133000 PERFORM PASS NC1014.2 +133100 PERFORM PRINT-DETAIL NC1014.2 +133200 ELSE NC1014.2 +133300 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +133400 TO RE-MARK NC1014.2 +133500 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +133600 MOVE "1" TO CORRECT-X NC1014.2 +133700 PERFORM PRINT-DETAIL. NC1014.2 +133800* NC1014.2 +133900* NC1014.2 +134000 MPY-INIT-F1-23. NC1014.2 +134100* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +134200* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +134300* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +134400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +134500 MOVE "MPY-TEST-F1-23" TO PAR-NAME. NC1014.2 +134600 MOVE "0" TO WRK-XN-00001. NC1014.2 +134700 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +134800 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +134900 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +135000 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +135100 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +135200 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +135300 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +135400 MOVE 1 TO REC-CT. NC1014.2 +135500 MPY-TEST-F1-23-0. NC1014.2 +135600 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +135700 WRK-DU-6V0-1 ROUNDED NC1014.2 +135800 WRK-DU-6V0-2 ROUNDED WRK-DU-0V12-1 NC1014.2 +135900 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +136000 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +136100 GO TO MPY-TEST-F1-23-1. NC1014.2 +136200 MPY-DELETE-F1-23. NC1014.2 +136300 PERFORM DE-LETE. NC1014.2 +136400 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +136500 PERFORM PRINT-DETAIL. NC1014.2 +136600 GO TO MPY-INIT-F1-24. NC1014.2 +136700 MPY-TEST-F1-23-1. NC1014.2 +136800 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +136900 ELSE NC1014.2 +137000 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +137100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +137200 ADD 1 TO REC-CT. NC1014.2 +137300 MPY-TEST-F1-23-2. NC1014.2 +137400 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +137500 ELSE NC1014.2 +137600 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +137700 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +137800 ADD 1 TO REC-CT. NC1014.2 +137900 MPY-TEST-F1-23-3. NC1014.2 +138000 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +138100 ELSE NC1014.2 +138200 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +138300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +138400 ADD 1 TO REC-CT. NC1014.2 +138500 MPY-TEST-F1-23-4. NC1014.2 +138600 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +138700 ELSE NC1014.2 +138800 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +138900 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +139000 ADD 1 TO REC-CT. NC1014.2 +139100 MPY-TEST-F1-23-5. NC1014.2 +139200 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +139300 PRINT-DETAIL ELSE NC1014.2 +139400 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +139500 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +139600 ADD 1 TO REC-CT. NC1014.2 +139700 MPY-TEST-F1-23-6. NC1014.2 +139800 IF WRK-XN-00001 = "2" NC1014.2 +139900 PERFORM PASS NC1014.2 +140000 PERFORM PRINT-DETAIL NC1014.2 +140100 ELSE NC1014.2 +140200 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +140300 TO RE-MARK NC1014.2 +140400 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +140500 MOVE "1" TO CORRECT-X NC1014.2 +140600 PERFORM PRINT-DETAIL. NC1014.2 +140700* NC1014.2 +140800* NC1014.2 +140900 MPY-INIT-F1-24. NC1014.2 +141000* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +141100* ==--> SIZE ERROR CONDITION <--== NC1014.2 +141200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +141300 MOVE "MPY-TEST-F1-24" TO PAR-NAME NC1014.2 +141400 MOVE "0" TO WRK-XN-00001. NC1014.2 +141500 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +141600 MOVE 0 TO WRK-DS-05V00. NC1014.2 +141700 MOVE 0 TO WRK-DS-02V00. NC1014.2 +141800 MOVE 0 TO WRK-CS-18V00. NC1014.2 +141900 MOVE 1 TO REC-CT. NC1014.2 +142000 MPY-TEST-F1-24-0. NC1014.2 +142100 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +142200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +142300 MOVE 23 TO WRK-DS-05V00 NC1014.2 +142400 MOVE -4 TO WRK-DS-02V00 NC1014.2 +142500 END-MULTIPLY NC1014.2 +142600 MOVE 99 TO WRK-CS-18V00. NC1014.2 +142700 GO TO MPY-TEST-F1-24-1. NC1014.2 +142800 MPY-DELETE-F1-24-1. NC1014.2 +142900 PERFORM DE-LETE. NC1014.2 +143000 PERFORM PRINT-DETAIL. NC1014.2 +143100 GO TO MPY-INIT-F1-25. NC1014.2 +143200 MPY-TEST-F1-24-1. NC1014.2 +143300 MOVE "MPY-TEST-F1-24-1" TO PAR-NAME. NC1014.2 +143400 IF WRK-XN-00001 = "1" NC1014.2 +143500 PERFORM PASS NC1014.2 +143600 PERFORM PRINT-DETAIL NC1014.2 +143700 ELSE NC1014.2 +143800 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +143900 MOVE "1" TO CORRECT-X NC1014.2 +144000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +144100 PERFORM FAIL NC1014.2 +144200 PERFORM PRINT-DETAIL. NC1014.2 +144300 ADD 1 TO REC-CT. NC1014.2 +144400 MPY-TEST-F1-24-2. NC1014.2 +144500 MOVE "MPY-TEST-F1-24-2" TO PAR-NAME. NC1014.2 +144600 IF WRK-DS-05V00 = 23 NC1014.2 +144700 PERFORM PASS NC1014.2 +144800 PERFORM PRINT-DETAIL NC1014.2 +144900 ELSE NC1014.2 +145000 MOVE WRK-DS-05V00 TO COMPUTED-N NC1014.2 +145100 MOVE 23 TO CORRECT-N NC1014.2 +145200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +145300 PERFORM FAIL NC1014.2 +145400 PERFORM PRINT-DETAIL. NC1014.2 +145500 ADD 1 TO REC-CT. NC1014.2 +145600 MPY-TEST-F1-24-3. NC1014.2 +145700 MOVE "MPY-TEST-F1-24-3" TO PAR-NAME. NC1014.2 +145800 IF WRK-DS-02V00 = -4 NC1014.2 +145900 PERFORM PASS NC1014.2 +146000 PERFORM PRINT-DETAIL NC1014.2 +146100 ELSE NC1014.2 +146200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +146300 MOVE -4 TO CORRECT-N NC1014.2 +146400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +146500 PERFORM FAIL NC1014.2 +146600 PERFORM PRINT-DETAIL. NC1014.2 +146700 ADD 1 TO REC-CT. NC1014.2 +146800 MPY-TEST-F1-24-4. NC1014.2 +146900 MOVE "MPY-TEST-F1-24-4" TO PAR-NAME. NC1014.2 +147000 IF WRK-DS-10V00 = 1111111111 NC1014.2 +147100 PERFORM PASS NC1014.2 +147200 PERFORM PRINT-DETAIL NC1014.2 +147300 ELSE NC1014.2 +147400 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +147500 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +147600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +147700 PERFORM FAIL NC1014.2 +147800 PERFORM PRINT-DETAIL. NC1014.2 +147900 ADD 1 TO REC-CT. NC1014.2 +148000 MPY-TEST-F1-24-5. NC1014.2 +148100 MOVE "MPY-TEST-F1-24-5" TO PAR-NAME. NC1014.2 +148200 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +148300 PERFORM PASS NC1014.2 +148400 PERFORM PRINT-DETAIL NC1014.2 +148500 ELSE NC1014.2 +148600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +148700 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +148800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +148900 PERFORM FAIL NC1014.2 +149000 PERFORM PRINT-DETAIL. NC1014.2 +149100* NC1014.2 +149200* NC1014.2 +149300 MPY-INIT-F1-25. NC1014.2 +149400* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +149500 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +149600 MOVE "MPY-TEST-F1-25" TO PAR-NAME NC1014.2 +149700 MOVE "1" TO WRK-XN-00001. NC1014.2 +149800 MOVE -99 TO WRK-DS-02V00. NC1014.2 +149900 MOVE 0 TO WRK-DS-10V00. NC1014.2 +150000 MOVE 0 TO WRK-DS-01V00. NC1014.2 +150100 MOVE 0 TO WRK-CS-18V00. NC1014.2 +150200 MOVE 1 TO REC-CT. NC1014.2 +150300 MPY-TEST-F1-25-0. NC1014.2 +150400 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +150500 ON SIZE ERROR MOVE "0" TO WRK-XN-00001 NC1014.2 +150600 MOVE 23 TO WRK-DS-10V00 NC1014.2 +150700 MOVE -4 TO WRK-DS-01V00 NC1014.2 +150800 END-MULTIPLY NC1014.2 +150900 MOVE 99 TO WRK-CS-18V00. NC1014.2 +151000 GO TO MPY-TEST-F1-25-1. NC1014.2 +151100 MPY-DELETE-F1-25-1. NC1014.2 +151200 PERFORM DE-LETE. NC1014.2 +151300 PERFORM PRINT-DETAIL. NC1014.2 +151400 GO TO MPY-INIT-F1-26. NC1014.2 +151500 MPY-TEST-F1-25-1. NC1014.2 +151600 MOVE "MPY-TEST-F1-25-1" TO PAR-NAME. NC1014.2 +151700 IF WRK-XN-00001 = "1" NC1014.2 +151800 PERFORM PASS NC1014.2 +151900 PERFORM PRINT-DETAIL NC1014.2 +152000 ELSE NC1014.2 +152100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +152200 MOVE "1" TO CORRECT-X NC1014.2 +152300 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +152400 PERFORM FAIL NC1014.2 +152500 PERFORM PRINT-DETAIL. NC1014.2 +152600 ADD 1 TO REC-CT. NC1014.2 +152700 MPY-TEST-F1-25-2. NC1014.2 +152800 MOVE "MPY-TEST-F1-25-2" TO PAR-NAME. NC1014.2 +152900 IF WRK-DS-10V00 = 0000000000 NC1014.2 +153000 PERFORM PASS NC1014.2 +153100 PERFORM PRINT-DETAIL NC1014.2 +153200 ELSE NC1014.2 +153300 MOVE WRK-DS-10V00 TO COMPUTED-N NC1014.2 +153400 MOVE 0000000000 TO CORRECT-N NC1014.2 +153500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +153600 PERFORM FAIL NC1014.2 +153700 PERFORM PRINT-DETAIL. NC1014.2 +153800 ADD 1 TO REC-CT. NC1014.2 +153900 MPY-TEST-F1-25-3. NC1014.2 +154000 MOVE "MPY-TEST-F1-25-3" TO PAR-NAME. NC1014.2 +154100 IF WRK-DS-01V00 = 0 NC1014.2 +154200 PERFORM PASS NC1014.2 +154300 PERFORM PRINT-DETAIL NC1014.2 +154400 ELSE NC1014.2 +154500 MOVE WRK-DS-01V00 TO COMPUTED-N NC1014.2 +154600 MOVE 0 TO CORRECT-N NC1014.2 +154700 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +154800 PERFORM FAIL NC1014.2 +154900 PERFORM PRINT-DETAIL. NC1014.2 +155000 ADD 1 TO REC-CT. NC1014.2 +155100 MPY-TEST-F1-25-4. NC1014.2 +155200 MOVE "MPY-TEST-F1-25-4" TO PAR-NAME. NC1014.2 +155300 IF WRK-DS-02V00 = 00 NC1014.2 +155400 PERFORM PASS NC1014.2 +155500 PERFORM PRINT-DETAIL NC1014.2 +155600 ELSE NC1014.2 +155700 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +155800 MOVE 00 TO CORRECT-N NC1014.2 +155900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +156000 PERFORM FAIL NC1014.2 +156100 PERFORM PRINT-DETAIL. NC1014.2 +156200 ADD 1 TO REC-CT. NC1014.2 +156300 MPY-TEST-F1-25-5. NC1014.2 +156400 MOVE "MPY-TEST-F1-25-5" TO PAR-NAME. NC1014.2 +156500 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +156600 PERFORM PASS NC1014.2 +156700 PERFORM PRINT-DETAIL NC1014.2 +156800 ELSE NC1014.2 +156900 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +157000 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +157100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +157200 PERFORM FAIL NC1014.2 +157300 PERFORM PRINT-DETAIL. NC1014.2 +157400* NC1014.2 +157500* NC1014.2 +157600 MPY-INIT-F1-26. NC1014.2 +157700* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +157800 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +157900 MOVE "MPY-TEST-F1-26" TO PAR-NAME NC1014.2 +158000 MOVE "0" TO WRK-XN-00001. NC1014.2 +158100 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +158200 MOVE 0 TO WRK-DS-05V00. NC1014.2 +158300 MOVE 0 TO WRK-DS-02V00. NC1014.2 +158400 MOVE 0 TO WRK-CS-18V00. NC1014.2 +158500 MOVE 1 TO REC-CT. NC1014.2 +158600 MPY-TEST-F1-26-0. NC1014.2 +158700 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +158800 ON SIZE ERROR GO TO MPY-TEST-F1-26-01 NC1014.2 +158900 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +159000 MOVE 23 TO WRK-DS-05V00 NC1014.2 +159100 MOVE -4 TO WRK-DS-02V00 NC1014.2 +159200 END-MULTIPLY. NC1014.2 +159300 MPY-TEST-F1-26-01. NC1014.2 +159400 MOVE 99 TO WRK-CS-18V00. NC1014.2 +159500 GO TO MPY-TEST-F1-26-1. NC1014.2 +159600 MPY-DELETE-F1-26-1. NC1014.2 +159700 PERFORM DE-LETE. NC1014.2 +159800 PERFORM PRINT-DETAIL. NC1014.2 +159900 GO TO MPY-INIT-F1-27. NC1014.2 +160000 MPY-TEST-F1-26-1. NC1014.2 +160100 MOVE "MPY-TEST-F1-26-1" TO PAR-NAME. NC1014.2 +160200 IF WRK-XN-00001 = "0" NC1014.2 +160300 PERFORM PASS NC1014.2 +160400 PERFORM PRINT-DETAIL NC1014.2 +160500 ELSE NC1014.2 +160600 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +160700 MOVE "0" TO CORRECT-X NC1014.2 +160800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +160900 TO RE-MARK NC1014.2 +161000 PERFORM FAIL NC1014.2 +161100 PERFORM PRINT-DETAIL. NC1014.2 +161200 ADD 1 TO REC-CT. NC1014.2 +161300 MPY-TEST-F1-26-2. NC1014.2 +161400 MOVE "MPY-TEST-F1-26-2" TO PAR-NAME. NC1014.2 +161500 IF WRK-DS-05V00 = 00000 NC1014.2 +161600 PERFORM PASS NC1014.2 +161700 PERFORM PRINT-DETAIL NC1014.2 +161800 ELSE NC1014.2 +161900 MOVE WRK-DS-05V00 TO COMPUTED-N NC1014.2 +162000 MOVE 0 TO CORRECT-N NC1014.2 +162100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +162200 TO RE-MARK NC1014.2 +162300 PERFORM FAIL NC1014.2 +162400 PERFORM PRINT-DETAIL. NC1014.2 +162500 ADD 1 TO REC-CT. NC1014.2 +162600 MPY-TEST-F1-26-3. NC1014.2 +162700 MOVE "MPY-TEST-F1-26-3" TO PAR-NAME. NC1014.2 +162800 IF WRK-DS-02V00 = 0 NC1014.2 +162900 PERFORM PASS NC1014.2 +163000 PERFORM PRINT-DETAIL NC1014.2 +163100 ELSE NC1014.2 +163200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +163300 MOVE 0 TO CORRECT-N NC1014.2 +163400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +163500 TO RE-MARK NC1014.2 +163600 PERFORM FAIL NC1014.2 +163700 PERFORM PRINT-DETAIL. NC1014.2 +163800 ADD 1 TO REC-CT. NC1014.2 +163900 MPY-TEST-F1-26-4. NC1014.2 +164000 MOVE "MPY-TEST-F1-26-4" TO PAR-NAME. NC1014.2 +164100 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +164200 PERFORM PASS NC1014.2 +164300 PERFORM PRINT-DETAIL NC1014.2 +164400 ELSE NC1014.2 +164500 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +164600 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +164700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +164800 PERFORM FAIL NC1014.2 +164900 PERFORM PRINT-DETAIL. NC1014.2 +165000 ADD 1 TO REC-CT. NC1014.2 +165100 MPY-TEST-F1-26-5. NC1014.2 +165200 MOVE "MPY-TEST-F1-26-5" TO PAR-NAME. NC1014.2 +165300 IF WRK-DS-10V00 = 1111111111 NC1014.2 +165400 PERFORM PASS NC1014.2 +165500 PERFORM PRINT-DETAIL NC1014.2 +165600 ELSE NC1014.2 +165700 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +165800 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +165900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +166000 TO RE-MARK NC1014.2 +166100 PERFORM FAIL NC1014.2 +166200 PERFORM PRINT-DETAIL. NC1014.2 +166300* NC1014.2 +166400* NC1014.2 +166500 MPY-INIT-F1-27. NC1014.2 +166600* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +166700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +166800 MOVE "1" TO WRK-XN-00001. NC1014.2 +166900 MOVE -99 TO WRK-DS-02V00. NC1014.2 +167000 MOVE 0 TO WRK-DS-10V00. NC1014.2 +167100 MOVE 0 TO WRK-DS-01V00. NC1014.2 +167200 MOVE 0 TO WRK-DS-18V00. NC1014.2 +167300 MOVE 1 TO REC-CT. NC1014.2 +167400 MPY-TEST-F1-27-0. NC1014.2 +167500 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +167600 ON SIZE ERROR GO TO MPY-TEST-F1-27-01 NC1014.2 +167700 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001 NC1014.2 +167800 MOVE 23 TO WRK-DS-10V00 NC1014.2 +167900 MOVE -4 TO WRK-DS-01V00 NC1014.2 +168000 END-MULTIPLY. NC1014.2 +168100 MPY-TEST-F1-27-01. NC1014.2 +168200 MOVE 99 TO WRK-CS-18V00. NC1014.2 +168300 GO TO MPY-TEST-F1-27-1. NC1014.2 +168400 MPY-DELETE-F1-27-1. NC1014.2 +168500 PERFORM DE-LETE. NC1014.2 +168600 PERFORM PRINT-DETAIL. NC1014.2 +168700 GO TO MPY-INIT-F1-28. NC1014.2 +168800 MPY-TEST-F1-27-1. NC1014.2 +168900 MOVE "MPY-TEST-F1-27-1" TO PAR-NAME. NC1014.2 +169000 IF WRK-XN-00001 = "0" NC1014.2 +169100 PERFORM PASS NC1014.2 +169200 PERFORM PRINT-DETAIL NC1014.2 +169300 ELSE NC1014.2 +169400 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +169500 MOVE "0" TO CORRECT-X NC1014.2 +169600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +169700 TO RE-MARK NC1014.2 +169800 PERFORM FAIL NC1014.2 +169900 PERFORM PRINT-DETAIL. NC1014.2 +170000 ADD 1 TO REC-CT. NC1014.2 +170100 MPY-TEST-F1-27-2. NC1014.2 +170200 MOVE "MPY-TEST-F1-27-2" TO PAR-NAME. NC1014.2 +170300 IF WRK-DS-10V00 = 23 NC1014.2 +170400 PERFORM PASS NC1014.2 +170500 PERFORM PRINT-DETAIL NC1014.2 +170600 ELSE NC1014.2 +170700 MOVE WRK-DS-10V00 TO COMPUTED-N NC1014.2 +170800 MOVE 23 TO CORRECT-N NC1014.2 +170900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +171000 TO RE-MARK NC1014.2 +171100 PERFORM FAIL NC1014.2 +171200 PERFORM PRINT-DETAIL. NC1014.2 +171300 ADD 1 TO REC-CT. NC1014.2 +171400 MPY-TEST-F1-27-3. NC1014.2 +171500 MOVE "MPY-TEST-F1-27-3" TO PAR-NAME. NC1014.2 +171600 IF WRK-DS-02V00 = 00 NC1014.2 +171700 PERFORM PASS NC1014.2 +171800 PERFORM PRINT-DETAIL NC1014.2 +171900 ELSE NC1014.2 +172000 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +172100 MOVE 00 TO CORRECT-N NC1014.2 +172200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +172300 TO RE-MARK NC1014.2 +172400 PERFORM FAIL NC1014.2 +172500 PERFORM PRINT-DETAIL. NC1014.2 +172600 ADD 1 TO REC-CT. NC1014.2 +172700 MPY-TEST-F1-27-4. NC1014.2 +172800 MOVE "MPY-TEST-F1-27-4" TO PAR-NAME. NC1014.2 +172900 IF WRK-DS-01V00 = -4 NC1014.2 +173000 PERFORM PASS NC1014.2 +173100 PERFORM PRINT-DETAIL NC1014.2 +173200 ELSE NC1014.2 +173300 MOVE WRK-DS-01V00 TO COMPUTED-N NC1014.2 +173400 MOVE -4 TO CORRECT-N NC1014.2 +173500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +173600 TO RE-MARK NC1014.2 +173700 PERFORM FAIL NC1014.2 +173800 PERFORM PRINT-DETAIL. NC1014.2 +173900 ADD 1 TO REC-CT. NC1014.2 +174000 MPY-TEST-F1-27-5. NC1014.2 +174100 MOVE "MPY-TEST-F1-27-5" TO PAR-NAME NC1014.2 +174200 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +174300 PERFORM PASS NC1014.2 +174400 PERFORM PRINT-DETAIL NC1014.2 +174500 ELSE NC1014.2 +174600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +174700 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +174800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +174900 PERFORM FAIL NC1014.2 +175000 PERFORM PRINT-DETAIL. NC1014.2 +175100* NC1014.2 +175200* NC1014.2 +175300 MPY-INIT-F1-28. NC1014.2 +175400* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +175500 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +175600 MOVE "0" TO WRK-XN-00001. NC1014.2 +175700 MOVE 0 TO WRK-CS-18V00. NC1014.2 +175800 MOVE 1 TO REC-CT. NC1014.2 +175900 MPY-TEST-F1-28-0. NC1014.2 +176000 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +176100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +176200 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001 NC1014.2 +176300 END-MULTIPLY NC1014.2 +176400 MOVE 99 TO WRK-CS-18V00. NC1014.2 +176500 GO TO MPY-TEST-F1-28-1. NC1014.2 +176600 MPY-DELETE-F1-28-1. NC1014.2 +176700 PERFORM DE-LETE. NC1014.2 +176800 PERFORM PRINT-DETAIL. NC1014.2 +176900 GO TO MPY-INIT-F1-29. NC1014.2 +177000 MPY-TEST-F1-28-1. NC1014.2 +177100 MOVE "MPY-TEST-F1-28-1" TO PAR-NAME. NC1014.2 +177200 IF WRK-XN-00001 = "1" NC1014.2 +177300 PERFORM PASS NC1014.2 +177400 PERFORM PRINT-DETAIL NC1014.2 +177500 ELSE NC1014.2 +177600 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +177700 MOVE "1" TO CORRECT-X NC1014.2 +177800 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1014.2 +177900 TO RE-MARK NC1014.2 +178000 PERFORM FAIL NC1014.2 +178100 PERFORM PRINT-DETAIL. NC1014.2 +178200 ADD 1 TO REC-CT. NC1014.2 +178300 MPY-TEST-F1-28-2. NC1014.2 +178400 MOVE "MPY-TEST-F1-28-2" TO PAR-NAME. NC1014.2 +178500 IF WRK-DS-10V00 = 1111111111 NC1014.2 +178600 PERFORM PASS NC1014.2 +178700 PERFORM PRINT-DETAIL NC1014.2 +178800 ELSE NC1014.2 +178900 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +179000 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +179100 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1014.2 +179200 TO RE-MARK NC1014.2 +179300 PERFORM FAIL NC1014.2 +179400 PERFORM PRINT-DETAIL. NC1014.2 +179500 ADD 1 TO REC-CT. NC1014.2 +179600 MPY-TEST-F1-28-3. NC1014.2 +179700 MOVE "MPY-TEST-F1-28-3" TO PAR-NAME. NC1014.2 +179800 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +179900 PERFORM PASS NC1014.2 +180000 PERFORM PRINT-DETAIL NC1014.2 +180100 ELSE NC1014.2 +180200 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +180300 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +180400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +180500 PERFORM FAIL NC1014.2 +180600 PERFORM PRINT-DETAIL. NC1014.2 +180700* NC1014.2 +180800* NC1014.2 +180900 MPY-INIT-F1-29. NC1014.2 +181000* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +181100 MOVE "0" TO WRK-XN-00001. NC1014.2 +181200 MOVE -99 TO WRK-DS-02V00. NC1014.2 +181300 MOVE ZERO TO WRK-CS-18V00. NC1014.2 +181400 MOVE 1 TO REC-CT. NC1014.2 +181500 MPY-TEST-F1-29-0. NC1014.2 +181600 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +181700 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +181800 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001 NC1014.2 +181900 END-MULTIPLY NC1014.2 +182000 MOVE 99 TO WRK-CS-18V00. NC1014.2 +182100 GO TO MPY-TEST-F1-29-1. NC1014.2 +182200 MPY-DELETE-F1-29-1. NC1014.2 +182300 PERFORM DE-LETE. NC1014.2 +182400 PERFORM PRINT-DETAIL. NC1014.2 +182500 GO TO CCVS-EXIT. NC1014.2 +182600 MPY-TEST-F1-29-1. NC1014.2 +182700 MOVE "MPY-TEST-F1-29-1" TO PAR-NAME. NC1014.2 +182800 IF WRK-XN-00001 = "2" NC1014.2 +182900 PERFORM PASS NC1014.2 +183000 PERFORM PRINT-DETAIL NC1014.2 +183100 ELSE NC1014.2 +183200 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +183300 MOVE "2" TO CORRECT-X NC1014.2 +183400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1014.2 +183500 TO RE-MARK NC1014.2 +183600 PERFORM FAIL NC1014.2 +183700 PERFORM PRINT-DETAIL. NC1014.2 +183800 ADD 1 TO REC-CT. NC1014.2 +183900 MPY-TEST-F1-29-2. NC1014.2 +184000 MOVE "MPY-TEST-F1-29-2" TO PAR-NAME. NC1014.2 +184100 IF WRK-DS-02V00 = 00 NC1014.2 +184200 PERFORM PASS NC1014.2 +184300 PERFORM PRINT-DETAIL NC1014.2 +184400 ELSE NC1014.2 +184500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +184600 MOVE 00 TO CORRECT-N NC1014.2 +184700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1014.2 +184800 TO RE-MARK NC1014.2 +184900 PERFORM FAIL NC1014.2 +185000 PERFORM PRINT-DETAIL. NC1014.2 +185100 ADD 1 TO REC-CT. NC1014.2 +185200 MPY-TEST-F1-29-3. NC1014.2 +185300 MOVE "MPY-TEST-F1-29-3" TO PAR-NAME. NC1014.2 +185400 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +185500 PERFORM PASS NC1014.2 +185600 PERFORM PRINT-DETAIL NC1014.2 +185700 ELSE NC1014.2 +185800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +185900 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +186000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +186100 PERFORM FAIL NC1014.2 +186200 PERFORM PRINT-DETAIL. NC1014.2 +186300* NC1014.2 +186400* NC1014.2 +186500 CCVS-EXIT SECTION. NC1014.2 +186600 CCVS-999999. NC1014.2 +186700 GO TO CLOSE-FILES. NC1014.2 +*END-OF,NC101A +*HEADER,COBOL,NC102A +000100 IDENTIFICATION DIVISION. NC1024.2 +000200 PROGRAM-ID. NC1024.2 +000300 NC102A. NC1024.2 +000400 NC1024.2 +000500**************************************************************** NC1024.2 +000600* * NC1024.2 +000700* VALIDATION FOR:- * NC1024.2 +000800* * NC1024.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +001000* * NC1024.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1024.2 +001200* * NC1024.2 +001300**************************************************************** NC1024.2 +001400* * NC1024.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC1024.2 +001600* * NC1024.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC1024.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC1024.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC1024.2 +002000* * NC1024.2 +002100**************************************************************** NC1024.2 +002200* NC1024.2 +002300* THIS PROGRAM TESTS FORMATS 1, 2 AND 3 OF THE "PERFORM" NC1024.2 +002400* STATEMENT, FORMATS 1 AND 2 OF THE "GO" STATEMENT AND NC1024.2 +002500* THE "EXIT" STATEMENT. NC1024.2 +002600* NC1024.2 +002700 ENVIRONMENT DIVISION. NC1024.2 +002800 CONFIGURATION SECTION. NC1024.2 +002900 SOURCE-COMPUTER. NC1024.2 +003000 XXXXX082. NC1024.2 +003100 OBJECT-COMPUTER. NC1024.2 +003200 XXXXX083. NC1024.2 +003300 INPUT-OUTPUT SECTION. NC1024.2 +003400 FILE-CONTROL. NC1024.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1024.2 +003600 XXXXX055. NC1024.2 +003700 DATA DIVISION. NC1024.2 +003800 FILE SECTION. NC1024.2 +003900 FD PRINT-FILE. NC1024.2 +004000 01 PRINT-REC PICTURE X(120). NC1024.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1024.2 +004200 WORKING-STORAGE SECTION. NC1024.2 +004300 01 PERFORM3 PIC 9 VALUE 5. NC1024.2 +004400 01 WRK-XN-18-1 PIC X(18). NC1024.2 +004500 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1024.2 +004600 01 WRK-DU-X-18V0-1 REDEFINES WRK-XN-18-1 PIC 9(18). NC1024.2 +004700 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1024.2 +004800 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1024.2 +004900 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1024.2 +005000 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1024.2 +005100 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1024.2 +005200 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1024.2 +005300 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1024.2 +005400 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1024.2 +005500 01 WRK-DU-1V5-1 PIC 9V9(5). NC1024.2 +005600 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1024.2 +005700 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1024.2 +005800 01 WRK-DU-2V0-1 PIC 99. NC1024.2 +005900 01 WRK-DU-2V0-2 PIC 99. NC1024.2 +006000 01 WRK-DU-2V0-3 PIC 99. NC1024.2 +006100 01 WRK-DU-2V1-1 PIC 99V9. NC1024.2 +006200 01 WRK-DU-2V1-2 PIC 99V9. NC1024.2 +006300 01 WRK-DU-2V1-3 PIC 99V9. NC1024.2 +006400 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1024.2 +006500 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1024.2 +006600 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1024.2 +006700 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1024.2 +006800 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1024.2 +006900 01 WRK-DU-2V5-1 PIC 99V9(5). NC1024.2 +007000 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1024.2 +007100 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1024.2 +007200 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1024.2 +007300 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1024.2 +007400 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1024.2 +007500 01 WRK-NE-X-1 PIC 9(16).99. NC1024.2 +007600 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1024.2 +007700 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1024.2 +007800 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1024.2 +007900 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1024.2 +008000 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1024.2 +008100 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1024.2 +008200 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1024.2 +008300 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1024.2 +008400 01 WRK-NE-X-2 PIC -9(16).99. NC1024.2 +008500 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1024.2 +008600 01 WRK-NE-2 PIC $**.99. NC1024.2 +008700 01 WRK-NE-3 PIC $99.99CR. NC1024.2 +008800 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1024.2 +008900 77 WRK-DS-02V00 PICTURE S99. NC1024.2 +009000 77 ATWO-DS-01V00 PICTURE S9 NC1024.2 +009100 VALUE 2. NC1024.2 +009200 77 P-COUNT PICTURE 9(6). NC1024.2 +009300 77 THREE PICTURE IS 9 VALUE IS 3. NC1024.2 +009400 77 WS-FOUR PICTURE IS 9 VALUE IS 4. NC1024.2 +009500 77 XRAY PICTURE IS X. NC1024.2 +009600 77 ALTERLOOP PICTURE IS 9 VALUE IS NC1024.2 +009700 ZERO. NC1024.2 +009800 01 NOTE-RECORD. NC1024.2 +009900 02 A PICTURE X VALUE SPACE. NC1024.2 +010000 02 B PICTURE X VALUE SPACE. NC1024.2 +010100 02 C PICTURE X VALUE SPACE. NC1024.2 +010200 02 D PICTURE X VALUE SPACE. NC1024.2 +010300 02 E PICTURE X VALUE SPACE. NC1024.2 +010400 02 F PICTURE X VALUE SPACE. NC1024.2 +010500 02 G PICTURE X VALUE SPACE. NC1024.2 +010600 02 H PICTURE X VALUE SPACE. NC1024.2 +010700 02 I PICTURE X VALUE SPACE. NC1024.2 +010800 02 J PICTURE X VALUE SPACE. NC1024.2 +010900 02 K PICTURE X VALUE SPACE. NC1024.2 +011000 02 L PICTURE X VALUE SPACE. NC1024.2 +011100 02 M PICTURE X VALUE SPACE. NC1024.2 +011200 02 N PICTURE X VALUE SPACE. NC1024.2 +011300 02 O PICTURE X VALUE SPACE. NC1024.2 +011400 02 P PICTURE X VALUE SPACE. NC1024.2 +011500 01 GO-TABLE. NC1024.2 +011600 02 GO-SCRIPT OCCURS 8 TIMES PICTURE 9. NC1024.2 +011700 01 GO-TO-DEPEND PICTURE IS 9 VALUE IS 0. NC1024.2 +011800 01 GO-TO-DEEP PICTURE IS 9 VALUE IS 1. NC1024.2 +011900 01 PERFORM1 PICTURE IS XXX NC1024.2 +012000 VALUE IS SPACE. NC1024.2 +012100 01 PERFORM2 PICTURE IS S999 NC1024.2 +012200 VALUE IS 20. NC1024.2 +012300 01 PERFORM4 PICTURE IS S99V9. NC1024.2 +012400 01 PERFORM5 PICTURE IS 999 NC1024.2 +012500 VALUE IS ZERO. NC1024.2 +012600 01 PERFORM-KEY PICTURE IS 9. NC1024.2 +012700 01 PERFORM-HOLD. NC1024.2 +012800 02 TEST-LETTER OCCURS 20 TIMES PICTURE X. NC1024.2 +012900 01 TEST-RESULTS. NC1024.2 +013000 02 FILLER PIC X VALUE SPACE. NC1024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. NC1024.2 +013200 02 FILLER PIC X VALUE SPACE. NC1024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. NC1024.2 +013400 02 FILLER PIC X VALUE SPACE. NC1024.2 +013500 02 PAR-NAME. NC1024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. NC1024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. NC1024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. NC1024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. NC1024.2 +014000 02 RE-MARK PIC X(61). NC1024.2 +014100 01 TEST-COMPUTED. NC1024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. NC1024.2 +014300 02 FILLER PIC X(17) VALUE NC1024.2 +014400 " COMPUTED=". NC1024.2 +014500 02 COMPUTED-X. NC1024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A NC1024.2 +014800 PIC -9(9).9(9). NC1024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. NC1024.2 +015300 04 COMPUTED-18V0 PIC -9(18). NC1024.2 +015400 04 FILLER PIC X. NC1024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. NC1024.2 +015600 01 TEST-CORRECT. NC1024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. NC1024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1024.2 +015900 02 CORRECT-X. NC1024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. NC1024.2 +016600 04 CORRECT-18V0 PIC -9(18). NC1024.2 +016700 04 FILLER PIC X. NC1024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. NC1024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1024.2 +017000 01 CCVS-C-1. NC1024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1024.2 +017200- "SS PARAGRAPH-NAME NC1024.2 +017300- " REMARKS". NC1024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. NC1024.2 +017500 01 CCVS-C-2. NC1024.2 +017600 02 FILLER PIC X VALUE SPACE. NC1024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". NC1024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. NC1024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". NC1024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. NC1024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. NC1024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1024.2 +019200 01 CCVS-H-1. NC1024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. NC1024.2 +019400 02 FILLER PIC X(42) VALUE NC1024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC1024.2 +019700 01 CCVS-H-2A. NC1024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. NC1024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1024.2 +020000 02 FILLER PIC XXXX VALUE NC1024.2 +020100 "4.2 ". NC1024.2 +020200 02 FILLER PIC X(28) VALUE NC1024.2 +020300 " COPY - NOT FOR DISTRIBUTION". NC1024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. NC1024.2 +020500 NC1024.2 +020600 01 CCVS-H-2B. NC1024.2 +020700 02 FILLER PIC X(15) VALUE NC1024.2 +020800 "TEST RESULT OF ". NC1024.2 +020900 02 TEST-ID PIC X(9). NC1024.2 +021000 02 FILLER PIC X(4) VALUE NC1024.2 +021100 " IN ". NC1024.2 +021200 02 FILLER PIC X(12) VALUE NC1024.2 +021300 " HIGH ". NC1024.2 +021400 02 FILLER PIC X(22) VALUE NC1024.2 +021500 " LEVEL VALIDATION FOR ". NC1024.2 +021600 02 FILLER PIC X(58) VALUE NC1024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +021800 01 CCVS-H-3. NC1024.2 +021900 02 FILLER PIC X(34) VALUE NC1024.2 +022000 " FOR OFFICIAL USE ONLY ". NC1024.2 +022100 02 FILLER PIC X(58) VALUE NC1024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1024.2 +022300 02 FILLER PIC X(28) VALUE NC1024.2 +022400 " COPYRIGHT 1985 ". NC1024.2 +022500 01 CCVS-E-1. NC1024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. NC1024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1024.2 +022800 02 ID-AGAIN PIC X(9). NC1024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. NC1024.2 +023000 01 CCVS-E-2. NC1024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. NC1024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. NC1024.2 +023300 02 CCVS-E-2-2. NC1024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1024.2 +023500 03 FILLER PIC X VALUE SPACE. NC1024.2 +023600 03 ENDER-DESC PIC X(44) VALUE NC1024.2 +023700 "ERRORS ENCOUNTERED". NC1024.2 +023800 01 CCVS-E-3. NC1024.2 +023900 02 FILLER PIC X(22) VALUE NC1024.2 +024000 " FOR OFFICIAL USE ONLY". NC1024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. NC1024.2 +024200 02 FILLER PIC X(58) VALUE NC1024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. NC1024.2 +024500 02 FILLER PIC X(15) VALUE NC1024.2 +024600 " COPYRIGHT 1985". NC1024.2 +024700 01 CCVS-E-4. NC1024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". NC1024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1024.2 +025100 02 FILLER PIC X(40) VALUE NC1024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1024.2 +025300 01 XXINFO. NC1024.2 +025400 02 FILLER PIC X(19) VALUE NC1024.2 +025500 "*** INFORMATION ***". NC1024.2 +025600 02 INFO-TEXT. NC1024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. NC1024.2 +025800 04 XXCOMPUTED PIC X(20). NC1024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. NC1024.2 +026000 04 XXCORRECT PIC X(20). NC1024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). NC1024.2 +026200 01 HYPHEN-LINE. NC1024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. NC1024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************NC1024.2 +026500- "*****************************************". NC1024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************NC1024.2 +026700- "******************************". NC1024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE NC1024.2 +026900 "NC102A". NC1024.2 +027000 PROCEDURE DIVISION. NC1024.2 +027100 CCVS1 SECTION. NC1024.2 +027200 OPEN-FILES. NC1024.2 +027300 OPEN OUTPUT PRINT-FILE. NC1024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1024.2 +027500 MOVE SPACE TO TEST-RESULTS. NC1024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1024.2 +027700 GO TO CCVS1-EXIT. NC1024.2 +027800 CLOSE-FILES. NC1024.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1024.2 +028000 TERMINATE-CCVS. NC1024.2 +028100S EXIT PROGRAM. NC1024.2 +028200STERMINATE-CALL. NC1024.2 +028300 STOP RUN. NC1024.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1024.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1024.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1024.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1024.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. NC1024.2 +028900 PRINT-DETAIL. NC1024.2 +029000 IF REC-CT NOT EQUAL TO ZERO NC1024.2 +029100 MOVE "." TO PARDOT-X NC1024.2 +029200 MOVE REC-CT TO DOTVALUE. NC1024.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1024.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1024.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1024.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1024.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1024.2 +029800 MOVE SPACE TO CORRECT-X. NC1024.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1024.2 +030000 MOVE SPACE TO RE-MARK. NC1024.2 +030100 HEAD-ROUTINE. NC1024.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1024.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1024.2 +030600 COLUMN-NAMES-ROUTINE. NC1024.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +031000 END-ROUTINE. NC1024.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1024.2 +031200 END-RTN-EXIT. NC1024.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +031400 END-ROUTINE-1. NC1024.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1024.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1024.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. NC1024.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1024.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1024.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1024.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1024.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1024.2 +032300 END-ROUTINE-12. NC1024.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1024.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1024.2 +032600 MOVE "NO " TO ERROR-TOTAL NC1024.2 +032700 ELSE NC1024.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1024.2 +033000 PERFORM WRITE-LINE. NC1024.2 +033100 END-ROUTINE-13. NC1024.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1024.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE NC1024.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1024.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO NC1024.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1024.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1024.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1024.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +034300 WRITE-LINE. NC1024.2 +034400 ADD 1 TO RECORD-COUNT. NC1024.2 +034500Y IF RECORD-COUNT GREATER 42 NC1024.2 +034600Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1024.2 +034700Y MOVE SPACE TO DUMMY-RECORD NC1024.2 +034800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1024.2 +034900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1024.2 +035000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1024.2 +035100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1024.2 +035200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1024.2 +035300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1024.2 +035700Y MOVE ZERO TO RECORD-COUNT. NC1024.2 +035800 PERFORM WRT-LN. NC1024.2 +035900 WRT-LN. NC1024.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1024.2 +036100 MOVE SPACE TO DUMMY-RECORD. NC1024.2 +036200 BLANK-LINE-PRINT. NC1024.2 +036300 PERFORM WRT-LN. NC1024.2 +036400 FAIL-ROUTINE. NC1024.2 +036500 IF COMPUTED-X NOT EQUAL TO SPACE NC1024.2 +036600 GO TO FAIL-ROUTINE-WRITE. NC1024.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1024.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1024.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1024.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1024.2 +037200 GO TO FAIL-ROUTINE-EX. NC1024.2 +037300 FAIL-ROUTINE-WRITE. NC1024.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1024.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1024.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1024.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1024.2 +037800 FAIL-ROUTINE-EX. EXIT. NC1024.2 +037900 BAIL-OUT. NC1024.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1024.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1024.2 +038200 BAIL-OUT-WRITE. NC1024.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1024.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1024.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1024.2 +038700 BAIL-OUT-EX. EXIT. NC1024.2 +038800 CCVS1-EXIT. NC1024.2 +038900 EXIT. NC1024.2 +039000 SECT-NC102A-001 SECTION. NC1024.2 +039100 GO--INIT-F1-1. NC1024.2 +039200 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +039300 GO--TEST-F1-1. NC1024.2 +039400 GO TO GO--PASS-F1-1. NC1024.2 +039500 PERFORM FAIL. NC1024.2 +039600 GO TO GO--WRITE-F1-1. NC1024.2 +039700 GO--DELETE-F1-1. NC1024.2 +039800 PERFORM DE-LETE. NC1024.2 +039900 GO TO GO--WRITE-F1-1. NC1024.2 +040000 GO--PASS-F1-1. NC1024.2 +040100 PERFORM PASS. NC1024.2 +040200 GO--WRITE-F1-1. NC1024.2 +040300 MOVE "GO TO " TO FEATURE. NC1024.2 +040400 MOVE "GO--TEST-F1-1" TO PAR-NAME. NC1024.2 +040500 PERFORM PRINT-DETAIL. NC1024.2 +040600 GO--INIT-F2-1. NC1024.2 +040700 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +040800 MOVE "GO--TEST-F2-1" TO PAR-NAME. NC1024.2 +040900 MOVE SPACE TO P-OR-F. NC1024.2 +041000 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +041100 MOVE 0 TO GO-TO-DEPEND. NC1024.2 +041200 GO--TEST-F2-1. NC1024.2 +041300 PERFORM PRINT-DETAIL. NC1024.2 +041400 MOVE SPACE TO FEATURE. NC1024.2 +041500 GO TO GO--B NC1024.2 +041600 GO--D NC1024.2 +041700 GO--C DEPENDING ON GO-TO-DEPEND. NC1024.2 +041800* NOTE GO--TEST-F2-1 THRU GO--E TEST THE GO TO NC1024.2 +041900* DEPENDING OPTION FOR GO-TO-DEPEND EQUAL TO 0,1,3,2,4. NC1024.2 +042000* NOTE INITIAL VALUE OF GO-TO-DEPEND IS ZERO. NC1024.2 +042100 GO TO GO--A. NC1024.2 +042200 GO--DELETE-F2-1. NC1024.2 +042300 MOVE "GO--TEST-F2-1" TO PAR-NAME. NC1024.2 +042400 PERFORM DE-LETE. NC1024.2 +042500 GO TO GO--WRITE-F2-1. NC1024.2 +042600 GO--A. NC1024.2 +042700 MOVE "GO--A" TO PAR-NAME. NC1024.2 +042800 IF GO-TO-DEPEND EQUAL TO 0 NC1024.2 +042900 PERFORM PASS NC1024.2 +043000 ADD 1 TO GO-TO-DEPEND NC1024.2 +043100 GO TO GO--TEST-F2-1. NC1024.2 +043200 IF GO-TO-DEPEND GREATER THAN 3 NC1024.2 +043300 GO TO GO--E. NC1024.2 +043400 PERFORM FAIL NC1024.2 +043500 MOVE 1 TO GO-TO-DEPEND NC1024.2 +043600 GO TO GO--TEST-F2-1. NC1024.2 +043700* NOTE CONTROL SHOULD FALL THRU TO GO--A FOR GO-TO-DEPEND NC1024.2 +043800* EQUAL TO 0, 4. NC1024.2 +043900 GO--B. NC1024.2 +044000 MOVE "GO--B" TO PAR-NAME. NC1024.2 +044100 IF GO-TO-DEPEND NOT EQUAL TO 1 NC1024.2 +044200 PERFORM FAIL NC1024.2 +044300 MOVE 3 TO GO-TO-DEPEND NC1024.2 +044400 GO TO GO--TEST-F2-1. NC1024.2 +044500 PERFORM PASS. NC1024.2 +044600 ADD 2 TO GO-TO-DEPEND. NC1024.2 +044700 GO TO GO--TEST-F2-1. NC1024.2 +044800 GO--C. NC1024.2 +044900 MOVE "GO--C" TO PAR-NAME. NC1024.2 +045000 IF GO-TO-DEPEND NOT EQUAL TO 3 NC1024.2 +045100 PERFORM FAIL NC1024.2 +045200 MOVE 2 TO GO-TO-DEPEND NC1024.2 +045300 GO TO GO--TEST-F2-1. NC1024.2 +045400 PERFORM PASS. NC1024.2 +045500 SUBTRACT 1 FROM GO-TO-DEPEND. NC1024.2 +045600 GO TO GO--TEST-F2-1. NC1024.2 +045700 GO--D. NC1024.2 +045800 MOVE "GO--D" TO PAR-NAME. NC1024.2 +045900 IF GO-TO-DEPEND NOT EQUAL TO 2 NC1024.2 +046000 PERFORM FAIL NC1024.2 +046100 MOVE 4 TO GO-TO-DEPEND NC1024.2 +046200 GO TO GO--TEST-F2-1. NC1024.2 +046300 PERFORM PASS. NC1024.2 +046400 ADD 2 TO GO-TO-DEPEND. NC1024.2 +046500 GO TO GO--TEST-F2-1. NC1024.2 +046600 GO--E. NC1024.2 +046700 MOVE "GO--E" TO PAR-NAME. NC1024.2 +046800 IF GO-TO-DEPEND EQUAL TO 4 NC1024.2 +046900 PERFORM PASS NC1024.2 +047000 GO TO GO--WRITE-F2-1. NC1024.2 +047100 PERFORM FAIL. NC1024.2 +047200 GO--WRITE-F2-1. NC1024.2 +047300 PERFORM PRINT-DETAIL. NC1024.2 +047400 GO--INIT-F1-2. NC1024.2 +047500 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +047600 GO--TEST-F1-2. NC1024.2 +047700 GO TO GO--PASS-F1-2. NC1024.2 +047800* NOTE THAT GO--PASS-F1-2 IS A SECTION-NAME. NC1024.2 +047900 PERFORM FAIL. NC1024.2 +048000 GO TO GO--WRITE-F1-2. NC1024.2 +048100 GO--DELETE-F1-2. NC1024.2 +048200 PERFORM DE-LETE. NC1024.2 +048300 GO TO GO--WRITE-F1-2. NC1024.2 +048400 GO--PASS-F1-2 SECTION. NC1024.2 +048500 GO--PAS-F1-2. NC1024.2 +048600 PERFORM PASS. NC1024.2 +048700 GO--WRITE-F1-2. NC1024.2 +048800 MOVE "GO TO" TO FEATURE. NC1024.2 +048900 MOVE "GO--TEST-F1-2" TO PAR-NAME. NC1024.2 +049000 PERFORM PRINT-DETAIL. NC1024.2 +049100* NC1024.2 +049200* NC1024.2 +049300 GO--INIT-F2-2. NC1024.2 +049400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +049500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +049600 GO--TEST-F2-2. NC1024.2 +049700 GO TO GO--PASS-F2-2 NC1024.2 +049800 GO--FAIL-F2-2 DEPENDING ON GO-TO-DEEP. NC1024.2 +049900* NOTE THAT GO--PASS-F2-2 IS A SECTION-NAME. NC1024.2 +050000 GO TO GO--FAIL-F2-2. NC1024.2 +050100 GO--DELETE-F2-2. NC1024.2 +050200 PERFORM DE-LETE. NC1024.2 +050300 GO TO GO--WRITE-F2-2. NC1024.2 +050400 GO--PASS-F2-2 SECTION. NC1024.2 +050500 GO--PAS-F2-2. NC1024.2 +050600 IF GO-TO-DEEP EQUAL TO 1 NC1024.2 +050700 PERFORM PASS NC1024.2 +050800 GO TO GO--WRITE-F2-2. NC1024.2 +050900 GO--FAIL-F2-2. NC1024.2 +051000 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +051100 MOVE 1 TO CORRECT-N. NC1024.2 +051200 PERFORM FAIL. NC1024.2 +051300 GO--WRITE-F2-2. NC1024.2 +051400 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +051500 MOVE "GO--TEST-F2-2" TO PAR-NAME. NC1024.2 +051600 PERFORM PRINT-DETAIL. NC1024.2 +051700 GO--INIT-F2-3. NC1024.2 +051800 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +051900 MOVE 0 TO GO-TO-DEEP. NC1024.2 +052000 MOVE 2 TO GO-TO-DEPEND. NC1024.2 +052100 GO--TEST-F2-3. NC1024.2 +052200 IF GO-TO-DEPEND EQUAL TO 2 GO TO GO--A-F2-3 GO--B-F2-3 NC1024.2 +052300 DEPENDING ON GO-TO-DEPEND ELSE GO TO GO--C-F2-3 NC1024.2 +052400 GO--D-F2-3 GO--E-F2-3 DEPENDING GO-TO-DEPEND. NC1024.2 +052500 GO--DELETE-F2-3. NC1024.2 +052600 PERFORM DE-LETE. NC1024.2 +052700 GO TO GO--WRITE-F2-3. NC1024.2 +052800 GO--A-F2-3. NC1024.2 +052900 MOVE 1 TO GO-TO-DEEP. NC1024.2 +053000 GO TO GO--F-F2-3. NC1024.2 +053100 GO--B-F2-3. NC1024.2 +053200 MOVE 2 TO GO-TO-DEEP. NC1024.2 +053300 GO TO GO--F-F2-3. NC1024.2 +053400 GO--C-F2-3. NC1024.2 +053500 MOVE 3 TO GO-TO-DEEP. NC1024.2 +053600 GO TO GO--F-F2-3. NC1024.2 +053700 GO--D-F2-3. NC1024.2 +053800 MOVE 4 TO GO-TO-DEEP. NC1024.2 +053900 GO TO GO--F-F2-3. NC1024.2 +054000 GO--E-F2-3. NC1024.2 +054100 MOVE 5 TO GO-TO-DEEP. NC1024.2 +054200 GO TO GO--F-F2-3. NC1024.2 +054300 GO--F-F2-3. NC1024.2 +054400 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +054500 PERFORM PASS GO TO GO--WRITE-F2-3. NC1024.2 +054600 GO--FAIL-F2-3. NC1024.2 +054700 PERFORM FAIL. NC1024.2 +054800 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +054900 MOVE 2 TO CORRECT-N. NC1024.2 +055000 GO--WRITE-F2-3. NC1024.2 +055100 MOVE "GO--TEST-F2-3 " TO PAR-NAME. NC1024.2 +055200 PERFORM PRINT-DETAIL. NC1024.2 +055300 GO--INIT-F2-4. NC1024.2 +055400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +055500 MOVE 0 TO GO-TO-DEEP. NC1024.2 +055600 MOVE 3 TO GO-TO-DEPEND. NC1024.2 +055700 GO--TEST-F2-4. NC1024.2 +055800 IF GO-TO-DEPEND EQUAL TO 2 GO TO GO--A-F2-4 GO--B-F2-4 NC1024.2 +055900 DEPENDING ON GO-TO-DEPEND ELSE GO TO GO--C-F2-4 NC1024.2 +056000 GO--D-F2-4 GO--E-F2-4 DEPENDING GO-TO-DEPEND. NC1024.2 +056100 GO--DELETE-F2-4. NC1024.2 +056200 PERFORM DE-LETE. NC1024.2 +056300 GO TO GO--WRITE-F2-4. NC1024.2 +056400 GO--A-F2-4. NC1024.2 +056500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +056600 GO TO GO--F-F2-4. NC1024.2 +056700 GO--B-F2-4. NC1024.2 +056800 MOVE 2 TO GO-TO-DEEP. NC1024.2 +056900 GO TO GO--F-F2-4. NC1024.2 +057000 GO--C-F2-4. NC1024.2 +057100 MOVE 3 TO GO-TO-DEEP. NC1024.2 +057200 GO TO GO--F-F2-4. NC1024.2 +057300 GO--D-F2-4. NC1024.2 +057400 MOVE 4 TO GO-TO-DEEP. NC1024.2 +057500 GO TO GO--F-F2-4. NC1024.2 +057600 GO--E-F2-4. NC1024.2 +057700 MOVE 5 TO GO-TO-DEEP. NC1024.2 +057800 GO TO GO--F-F2-4. NC1024.2 +057900 GO--F-F2-4. NC1024.2 +058000 IF GO-TO-DEEP EQUAL TO 5 NC1024.2 +058100 PERFORM PASS GO TO GO--WRITE-F2-4. NC1024.2 +058200 GO--FAIL-F2-4. NC1024.2 +058300 PERFORM FAIL. NC1024.2 +058400 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +058500 MOVE 5 TO CORRECT-N. NC1024.2 +058600 GO--WRITE-F2-4. NC1024.2 +058700 MOVE "GO--TEST-F2-4 " TO PAR-NAME. NC1024.2 +058800 PERFORM PRINT-DETAIL. NC1024.2 +058900* NC1024.2 +059000* NC1024.2 +059100 GO--INIT-F2-5. NC1024.2 +059200 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +059300 MOVE "87654321" TO GO-TABLE. NC1024.2 +059400 MOVE 0 TO GO-TO-DEEP. NC1024.2 +059500 GO--TEST-F2-5. NC1024.2 +059600 GO TO GO--A-F2-5 GO--B-F2-5 GO--C-F2-5 DEPENDING ON NC1024.2 +059700 GO-SCRIPT (7). NC1024.2 +059800 GO--DELETE-F2-5. NC1024.2 +059900 PERFORM DE-LETE. NC1024.2 +060000 GO TO GO--WRITE-F2-5. NC1024.2 +060100 GO--A-F2-5. NC1024.2 +060200 MOVE 1 TO GO-TO-DEEP. NC1024.2 +060300 GO TO GO--D-F2-5. NC1024.2 +060400 GO--B-F2-5. NC1024.2 +060500 MOVE 2 TO GO-TO-DEEP. NC1024.2 +060600 GO TO GO--D-F2-5. NC1024.2 +060700 GO--C-F2-5. NC1024.2 +060800 MOVE 3 TO GO-TO-DEEP. NC1024.2 +060900 GO TO GO--D-F2-5. NC1024.2 +061000 GO--D-F2-5. NC1024.2 +061100 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +061200 PERFORM PASS GO TO GO--WRITE-F2-5. NC1024.2 +061300 GO--FAIL-F2-5. NC1024.2 +061400 PERFORM FAIL. NC1024.2 +061500 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +061600 MOVE 2 TO CORRECT-N. NC1024.2 +061700 GO--WRITE-F2-5. NC1024.2 +061800 MOVE "GO--TEST-F2-5 " TO PAR-NAME. NC1024.2 +061900 PERFORM PRINT-DETAIL. NC1024.2 +062000* NC1024.2 +062100* NC1024.2 +062200 GO--INIT-F2-6. NC1024.2 +062300*==--> SINGLE PROCEDURE GO DEPENDING <--== NC1024.2 +062400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +062500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +062600 GO--TEST-F2-6. NC1024.2 +062700 GO TO GO--PASS-F2-6 DEPENDING ON GO-TO-DEEP. NC1024.2 +062800* NOTE THAT GO--PASS-F2-6 IS A SECTION-NAME. NC1024.2 +062900 GO TO GO--FAIL-F2-6. NC1024.2 +063000 GO--DELETE-F2-6. NC1024.2 +063100 PERFORM DE-LETE. NC1024.2 +063200 GO TO GO--WRITE-F2-6. NC1024.2 +063300 GO--PASS-F2-6 SECTION. NC1024.2 +063400 GO--PAS-F2-6. NC1024.2 +063500 IF GO-TO-DEEP EQUAL TO 1 NC1024.2 +063600 PERFORM PASS NC1024.2 +063700 GO TO GO--WRITE-F2-6. NC1024.2 +063800 GO--FAIL-F2-6. NC1024.2 +063900 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +064000 MOVE 1 TO CORRECT-N. NC1024.2 +064100 PERFORM FAIL. NC1024.2 +064200 GO--WRITE-F2-6. NC1024.2 +064300 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +064400 MOVE "GO--TEST-F2-6" TO PAR-NAME. NC1024.2 +064500 PERFORM PRINT-DETAIL. NC1024.2 +064600* NC1024.2 +064700* NC1024.2 +064800 GO--INIT-F2-7. NC1024.2 +064900 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +065000* ==--> OPTIONAL "TO" <--== NC1024.2 +065100 MOVE "87654321" TO GO-TABLE. NC1024.2 +065200 MOVE 0 TO GO-TO-DEEP. NC1024.2 +065300 GO--TEST-F2-7-0. NC1024.2 +065400 GO GO--A-F2-7 GO--B-F2-7 GO--C-F2-7 DEPENDING ON NC1024.2 +065500 GO-SCRIPT (7). NC1024.2 +065600 GO--DELETE-F2-7. NC1024.2 +065700 PERFORM DE-LETE. NC1024.2 +065800 GO TO GO--WRITE-F2-7. NC1024.2 +065900 GO--A-F2-7. NC1024.2 +066000 MOVE 1 TO GO-TO-DEEP. NC1024.2 +066100 GO TO GO--D-F2-7. NC1024.2 +066200 GO--B-F2-7. NC1024.2 +066300 MOVE 2 TO GO-TO-DEEP. NC1024.2 +066400 GO TO GO--D-F2-7. NC1024.2 +066500 GO--C-F2-7. NC1024.2 +066600 MOVE 3 TO GO-TO-DEEP. NC1024.2 +066700 GO TO GO--D-F2-7. NC1024.2 +066800 GO--D-F2-7. NC1024.2 +066900 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +067000 PERFORM PASS GO TO GO--WRITE-F2-7. NC1024.2 +067100 GO--FAIL-F2-7. NC1024.2 +067200 PERFORM FAIL. NC1024.2 +067300 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +067400 MOVE 2 TO CORRECT-N. NC1024.2 +067500 GO--WRITE-F2-7. NC1024.2 +067600 MOVE "GO--TEST-F2-7 " TO PAR-NAME. NC1024.2 +067700 PERFORM PRINT-DETAIL. NC1024.2 +067800* NC1024.2 +067900* NC1024.2 +068000 GO--INIT-F1-3. NC1024.2 +068100 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +068200 GOTO-TEST-F1-3. NC1024.2 +068300 GO P2. NC1024.2 +068400 GOTO-FAIL-F1-3. NC1024.2 +068500 PERFORM FAIL. NC1024.2 +068600 GO TO GOTO-WRITE-F1-3. NC1024.2 +068700 GOTO-DELETE-F1-3. NC1024.2 +068800 PERFORM DE-LETE. NC1024.2 +068900 GO TO GOTO-WRITE-F1-3. NC1024.2 +069000 P2. NC1024.2 +069100 PERFORM PASS. NC1024.2 +069200 GOTO-WRITE-F1-3. NC1024.2 +069300 MOVE "GOTO-TEST-F1-3" TO PAR-NAME. NC1024.2 +069400 MOVE "GO - NO OPTIONAL TO" TO FEATURE. NC1024.2 +069500 PERFORM PRINT-DETAIL. NC1024.2 +069600 EXIT--INIT-GF-1. NC1024.2 +069700 MOVE "V1-87 6.13.2 " TO ANSI-REFERENCE. NC1024.2 +069800 EXIT-TEST-GF-1. NC1024.2 +069900 GO TO EXIT-CHECK-GF-1. NC1024.2 +070000 EXIT-DELETE-GF-1. NC1024.2 +070100 PERFORM DE-LETE. NC1024.2 +070200 GO TO EXIT-WRITE-GF-1. NC1024.2 +070300 EXIT-CHECK-GF-1. NC1024.2 +070400 EXIT. NC1024.2 +070500 EXIT-PASS-GF-1. NC1024.2 +070600 PERFORM PASS. NC1024.2 +070700 EXIT-WRITE-GF-1. NC1024.2 +070800 MOVE "EXIT" TO FEATURE. NC1024.2 +070900 MOVE "EXIT-TEST-GF-1" TO PAR-NAME. NC1024.2 +071000 PERFORM PRINT-DETAIL. NC1024.2 +071100 PFM-INIT-F1-1. NC1024.2 +071200 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +071300 MOVE 1 TO PERFORM-KEY. NC1024.2 +071400 PFM-TEST-F1-1. NC1024.2 +071500* NOTE THIS TEST IS FOR OPTION 1 AND TESTS SIMPLE OUT OF NC1024.2 +071600* LINE PERFORM. NC1024.2 +071700 PERFORM PFM-A. NC1024.2 +071800 IF PERFORM1 EQUAL TO "ABC" NC1024.2 +071900 PERFORM PASS NC1024.2 +072000 ELSE NC1024.2 +072100 PERFORM FAIL. NC1024.2 +072200 GO TO PFM-WRITE-F1-1. NC1024.2 +072300 PFM-DELETE-F1-1. NC1024.2 +072400 PERFORM DE-LETE. NC1024.2 +072500 PFM-WRITE-F1-1. NC1024.2 +072600 MOVE "PERFORM" TO FEATURE. NC1024.2 +072700 MOVE "PFM-TEST-F1-1" TO PAR-NAME. NC1024.2 +072800 PERFORM PRINT-DETAIL. NC1024.2 +072900 PFM-INIT-F1-2. NC1024.2 +073000 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +073100 MOVE 2 TO PERFORM-KEY. NC1024.2 +073200 PFM-TEST-F1-2. NC1024.2 +073300* NOTE THIS TEST IS DESIGNED TO TEST ENTERING A PROCEDURE NC1024.2 +073400* IN LINE WHICH IS ALSO REFERENCED BY AN OUT OF LINE PERFORM. NC1024.2 +073500 GO TO PFM-A. NC1024.2 +073600 PFM-DELETE-F1-2. NC1024.2 +073700 PERFORM DE-LETE. NC1024.2 +073800 GO TO PFM-WRITE-F1-2. NC1024.2 +073900 PFM-A. NC1024.2 +074000 IF PERFORM-KEY EQUAL TO 1 NC1024.2 +074100 MOVE "ABC" TO PERFORM1 NC1024.2 +074200 ELSE NC1024.2 +074300 MOVE "XYZ" TO PERFORM1. NC1024.2 +074400 PFM-B. NC1024.2 +074500 IF PERFORM-KEY EQUAL TO 1 NC1024.2 +074600 PERFORM FAIL NC1024.2 +074700 PERFORM PRINT-DETAIL NC1024.2 +074800 GO TO PFM-TEST-F1-2. NC1024.2 +074900* NOTE FOR PFM-TEST-F1-1 CONTROL SHOULD NOT BE TRANSFERRED NC1024.2 +075000* TO THIS PARAGRAPH BUT FOR PFM-TEST-F1-2 IT SHOULD BE. NC1024.2 +075100 IF PERFORM1 EQUAL TO "XYZ" NC1024.2 +075200 PERFORM PASS NC1024.2 +075300 ELSE NC1024.2 +075400 PERFORM FAIL. NC1024.2 +075500 PFM-WRITE-F1-2. NC1024.2 +075600 MOVE "PERFORM" TO FEATURE. NC1024.2 +075700 MOVE "PFM-TEST-F1-2" TO PAR-NAME. NC1024.2 +075800 PERFORM PRINT-DETAIL. NC1024.2 +075900 PFM-INIT-F2-1. NC1024.2 +076000 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +076100 MOVE 3 TO THREE. NC1024.2 +076200 PFM-TEST-F2-1. NC1024.2 +076300 PERFORM PFM-C 3 TIMES. NC1024.2 +076400 PERFORM PFM-C THREE TIMES. NC1024.2 +076500* NOTE THIS TEST IS FOR OPTION 2. NC1024.2 +076600 IF PERFORM2 EQUAL TO 56 NC1024.2 +076700 PERFORM PASS NC1024.2 +076800 ELSE NC1024.2 +076900 PERFORM FAIL. NC1024.2 +077000 GO TO PFM-WRITE-F2-1. NC1024.2 +077100 PFM-DELETE-F2-1. NC1024.2 +077200 PERFORM DE-LETE. NC1024.2 +077300 PFM-WRITE-F2-1. NC1024.2 +077400 MOVE "PERFORM TIMES" TO FEATURE. NC1024.2 +077500 MOVE "PFM-TEST-F2-1" TO PAR-NAME. NC1024.2 +077600 PERFORM PRINT-DETAIL. NC1024.2 +077700 PFM-INIT-F1-3. NC1024.2 +077800 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +077900 PFM-TEST-F1-3. NC1024.2 +078000 PERFORM PFM-E THRU PFM-H. NC1024.2 +078100* NOTE THIS TEST IS FOR A NESTED PERFORM WITH THE INCLUDED NC1024.2 +078200* PERFORM TOTALLY INCLUDED IN THE SEQUENCE REFERENCED BY THE NC1024.2 +078300* FIRST PERFORM - IT ALSO TESTS THE EXIT VERB AND PERFORM NC1024.2 +078400* THRU. NC1024.2 +078500 IF PERFORM1 NOT EQUAL TO "CSW" NC1024.2 +078600 MOVE "CSW" TO CORRECT-A NC1024.2 +078700 MOVE PERFORM1 TO COMPUTED-A NC1024.2 +078800 PERFORM FAIL NC1024.2 +078900 GO TO PFM-WRITE-F1-3. NC1024.2 +079000 IF PERFORM4 EQUAL TO 70.0 NC1024.2 +079100 PERFORM PASS NC1024.2 +079200 ELSE NC1024.2 +079300 MOVE 70.0 TO CORRECT-N NC1024.2 +079400 MOVE PERFORM4 TO COMPUTED-N NC1024.2 +079500 PERFORM FAIL. NC1024.2 +079600 GO TO PFM-WRITE-F1-3. NC1024.2 +079700 PFM-DELETE-F1-3. NC1024.2 +079800 PERFORM DE-LETE. NC1024.2 +079900 PFM-WRITE-F1-3. NC1024.2 +080000 MOVE "NESTED PERFORM THRU" TO FEATURE. NC1024.2 +080100 MOVE "PFM-TEST-F1-3" TO PAR-NAME. NC1024.2 +080200 PERFORM PRINT-DETAIL. NC1024.2 +080300 PFM-INIT-F1-4. NC1024.2 +080400 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +080500 PFM-TEST-F1-4. NC1024.2 +080600 PERFORM PFM-J. NC1024.2 +080700* NOTE THIS TEST IS FOR A NESTED PERFORM WITH THE INCLUDED NC1024.2 +080800* PERFORM TOTALLY EXCLUDED FROM THE SEQUENCE REFERENCED BY NC1024.2 +080900* THE FIRST PERFORM. NC1024.2 +081000 IF PERFORM1 EQUAL TO "YES" NC1024.2 +081100 PERFORM PASS NC1024.2 +081200 ELSE NC1024.2 +081300 MOVE "YES" TO CORRECT-A NC1024.2 +081400 MOVE PERFORM1 TO COMPUTED-A NC1024.2 +081500 PERFORM FAIL NC1024.2 +081600 GO TO PFM-WRITE-F1-4. NC1024.2 +081700 IF PERFORM2 EQUAL TO 312 NC1024.2 +081800 PERFORM PASS NC1024.2 +081900 ELSE NC1024.2 +082000 MOVE 312 TO CORRECT-N NC1024.2 +082100 MOVE PERFORM2 TO COMPUTED-N NC1024.2 +082200 PERFORM FAIL. NC1024.2 +082300 GO TO PFM-WRITE-F1-4. NC1024.2 +082400 PFM-DELETE-F1-4. NC1024.2 +082500 PERFORM DE-LETE. NC1024.2 +082600 PFM-WRITE-F1-4. NC1024.2 +082700 MOVE "NESTED PERFORM" TO FEATURE. NC1024.2 +082800 MOVE "PFM-TEST-F1-4" TO PAR-NAME. NC1024.2 +082900 PERFORM PRINT-DETAIL. NC1024.2 +083000 PFM-INIT-F1-5. NC1024.2 +083100 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +083200 PFM-TEST-F1-5. NC1024.2 +083300 PERFORM PFM-N. NC1024.2 +083400* NOTE PFM-N IS A SECTION-NAME. NC1024.2 +083500 GO TO PFM-WRITE-F1-5. NC1024.2 +083600 PFM-DELETE-F1-5. NC1024.2 +083700 PERFORM DE-LETE. NC1024.2 +083800 PFM-WRITE-F1-5. NC1024.2 +083900 MOVE "PERFORM SECTION-NAME" TO FEATURE. NC1024.2 +084000 MOVE "PFM-TEST-F1-5" TO PAR-NAME. NC1024.2 +084100 PERFORM PRINT-DETAIL. NC1024.2 +084200 PFM-INIT-F2-2. NC1024.2 +084300 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +084400 PFM-TEST-F2-2. NC1024.2 +084500 PERFORM PFM-V THRU PFM-Z 5 TIMES. NC1024.2 +084600* NOTE THESE ARE ALL EXIT PARAGRAPHS. NC1024.2 +084700 PERFORM PASS. NC1024.2 +084800 GO TO PFM-WRITE-F2-2. NC1024.2 +084900 PFM-DELETE-F2-2. NC1024.2 +085000 PERFORM DE-LETE. NC1024.2 +085100 PFM-WRITE-F2-2. NC1024.2 +085200 MOVE "PERFORM EXIT PARAS" TO FEATURE. NC1024.2 +085300 MOVE "PFM-TEST-F2-2" TO PAR-NAME. NC1024.2 +085400 PERFORM PRINT-DETAIL. NC1024.2 +085500 PFM-INIT-F1-6. NC1024.2 +085600 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +085700 MOVE ZERO TO P-COUNT. NC1024.2 +085800 PFM-TEST-F1-6. NC1024.2 +085900 PERFORM PFM-B-F1-6. NC1024.2 +086000 ADD 1 TO P-COUNT. NC1024.2 +086100 PERFORM PFM-A-F1-6. NC1024.2 +086200 ADD 1 TO P-COUNT. NC1024.2 +086300 PFM-A-F1-6 SECTION. NC1024.2 +086400 PFM-B-F1-6. NC1024.2 +086500 ADD 100 TO P-COUNT. NC1024.2 +086600 PFM-TESTT-F1-6 SECTION. NC1024.2 +086700 PFM-TESTTT-F1-6. NC1024.2 +086800 IF P-COUNT EQUAL TO 000302 NC1024.2 +086900 PERFORM PASS GO TO PFM-WRITE-F1-6. NC1024.2 +087000 GO TO PFM-FAIL-F1-6. NC1024.2 +087100 PFM-DELETE-F1-6. NC1024.2 +087200 PERFORM DE-LETE. NC1024.2 +087300 GO TO PFM-WRITE-F1-6. NC1024.2 +087400 PFM-FAIL-F1-6. NC1024.2 +087500 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +087600 MOVE 000302 TO CORRECT-N. NC1024.2 +087700 PERFORM FAIL. NC1024.2 +087800 PFM-WRITE-F1-6. NC1024.2 +087900 MOVE "PERFORM " TO FEATURE. NC1024.2 +088000 MOVE "PFM-TEST-F1-6" TO PAR-NAME. NC1024.2 +088100 PERFORM PRINT-DETAIL. NC1024.2 +088200 PFM-INIT-F2-3. NC1024.2 +088300 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +088400 MOVE ZERO TO P-COUNT NC1024.2 +088500 MOVE 2 TO ATWO-DS-01V00. NC1024.2 +088600 PFM-TEST-F2-3. NC1024.2 +088700 PERFORM PFM-B-F2-3 2 TIMES. NC1024.2 +088800 ADD 1 TO P-COUNT. NC1024.2 +088900 PERFORM PFM-A-F2-3 ATWO-DS-01V00 TIMES. NC1024.2 +089000 ADD 1 TO P-COUNT. NC1024.2 +089100 PFM-A-F2-3 SECTION. NC1024.2 +089200 PFM-B-F2-3. NC1024.2 +089300 ADD 100 TO P-COUNT. NC1024.2 +089400 PFM-TESTT-F2-3 SECTION. NC1024.2 +089500 PFM-TESTTT-F2-3. NC1024.2 +089600 IF P-COUNT EQUAL TO 000502 NC1024.2 +089700 PERFORM PASS GO TO PFM-WRITE-F2-3. NC1024.2 +089800 GO TO PFM-FAIL-F2-3. NC1024.2 +089900 PFM-DELETE-F2-3. NC1024.2 +090000 PERFORM DE-LETE. NC1024.2 +090100 GO TO PFM-WRITE-F2-3. NC1024.2 +090200 PFM-FAIL-F2-3. NC1024.2 +090300 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +090400 MOVE 000502 TO CORRECT-N. NC1024.2 +090500 PERFORM FAIL. NC1024.2 +090600 PFM-WRITE-F2-3. NC1024.2 +090700 MOVE "PERFORM TIMES " TO FEATURE. NC1024.2 +090800 MOVE "PFM-TEST-F2-3" TO PAR-NAME. NC1024.2 +090900 PERFORM PRINT-DETAIL. NC1024.2 +091000 PFM-INIT-F1-7. NC1024.2 +091100 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +091200 MOVE ZERO TO P-COUNT. NC1024.2 +091300 PFM-TEST-F1-7. NC1024.2 +091400 PERFORM PFM-B-F1-7 THROUGH PFM-D-F1-7. NC1024.2 +091500 ADD 1 TO P-COUNT NC1024.2 +091600 PERFORM PFM-A-F1-7 THRU PFM-C-F1-7. NC1024.2 +091700 ADD 1 TO P-COUNT. NC1024.2 +091800 PERFORM PFM-A-F1-7 THRU PFM-D-F1-7. NC1024.2 +091900 ADD 1 TO P-COUNT. NC1024.2 +092000 PERFORM PFM-B-F1-7 THRU PFM-C-F1-7. NC1024.2 +092100 ADD 1 TO P-COUNT. NC1024.2 +092200 PFM-A-F1-7 SECTION. NC1024.2 +092300 PFM-B-F1-7. NC1024.2 +092400 ADD 100 TO P-COUNT. NC1024.2 +092500 PFM-C-F1-7 SECTION. NC1024.2 +092600 PFM-D-F1-7. NC1024.2 +092700 ADD 10000 TO P-COUNT. NC1024.2 +092800 PFM-TESTT-F1-7 SECTION. NC1024.2 +092900 PFM-TESTTT-F1-7. NC1024.2 +093000 IF P-COUNT EQUAL TO 050504 NC1024.2 +093100 PERFORM PASS NC1024.2 +093200 GO TO PFM-WRITE-F1-7. NC1024.2 +093300 GO TO PFM-FAIL-F1-7. NC1024.2 +093400 PFM-DELETE-F1-7. NC1024.2 +093500 PERFORM DE-LETE. NC1024.2 +093600 GO TO PFM-WRITE-F1-7. NC1024.2 +093700 PFM-FAIL-F1-7. NC1024.2 +093800 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +093900 MOVE 050504 TO CORRECT-N. NC1024.2 +094000 PERFORM FAIL. NC1024.2 +094100 PFM-WRITE-F1-7. NC1024.2 +094200 MOVE "PERFORM THRU " TO FEATURE. NC1024.2 +094300 MOVE "PFM-TEST-F1-7" TO PAR-NAME. NC1024.2 +094400 PERFORM PRINT-DETAIL. NC1024.2 +094500 PFM-INIT-F2-4. NC1024.2 +094600 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +094700 MOVE ZERO TO P-COUNT. NC1024.2 +094800 PFM-TEST-F2-4. NC1024.2 +094900 PERFORM PFM-B-F2-4 THROUGH PFM-D-F2-4 2 TIMES. NC1024.2 +095000 ADD 1 TO P-COUNT. NC1024.2 +095100 PERFORM PFM-A-F2-4 THRU PFM-C-F2-4 2 TIMES. NC1024.2 +095200 ADD 1 TO P-COUNT. NC1024.2 +095300 PERFORM PFM-A-F2-4 THRU PFM-D-F2-4 2 TIMES. NC1024.2 +095400 ADD 1 TO P-COUNT. NC1024.2 +095500 PERFORM PFM-B-F2-4 THRU PFM-D-F2-4 2 TIMES. NC1024.2 +095600 ADD 1 TO P-COUNT. NC1024.2 +095700 PFM-A-F2-4 SECTION. NC1024.2 +095800 PFM-B-F2-4. NC1024.2 +095900 ADD 100 TO P-COUNT. NC1024.2 +096000 PFM-C-F2-4 SECTION. NC1024.2 +096100 PFM-D-F2-4. NC1024.2 +096200 ADD 10000 TO P-COUNT. NC1024.2 +096300 PFM-TESTT-F2-4 SECTION. NC1024.2 +096400 PFM-TESTTT-F2-4. NC1024.2 +096500 IF P-COUNT EQUAL TO 090904 NC1024.2 +096600 PERFORM PASS GO TO PFM-WRITE-F2-4. NC1024.2 +096700 GO TO PFM-FAIL-F2-4. NC1024.2 +096800 PFM-DELETE-F2-4. NC1024.2 +096900 PERFORM DE-LETE. NC1024.2 +097000 GO TO PFM-WRITE-F2-4. NC1024.2 +097100 PFM-FAIL-F2-4. NC1024.2 +097200 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +097300 MOVE 090904 TO CORRECT-N. NC1024.2 +097400 PERFORM FAIL. NC1024.2 +097500 PFM-WRITE-F2-4. NC1024.2 +097600 MOVE "PERFORM THRU, TIMES " TO FEATURE. NC1024.2 +097700 MOVE "PFM-TEST-F2-4" TO PAR-NAME. NC1024.2 +097800 PERFORM PRINT-DETAIL. NC1024.2 +097900 PFM-INIT-F1-8. NC1024.2 +098000 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +098100 MOVE ZERO TO P-COUNT. NC1024.2 +098200 PFM-TEST-F1-8. NC1024.2 +098300 ADD 1 TO P-COUNT. NC1024.2 +098400 PERFORM PFM-A-F1-8. NC1024.2 +098500 ADD 2 TO P-COUNT. NC1024.2 +098600 GO TO PFM-TESTT-F1-8. NC1024.2 +098700 PFM-A-F1-8. NC1024.2 +098800 ADD 10 TO P-COUNT. NC1024.2 +098900 PERFORM PFM-B-F1-8. NC1024.2 +099000 ADD 20 TO P-COUNT. NC1024.2 +099100 PFM-B-F1-8. NC1024.2 +099200 ADD 100 TO P-COUNT. NC1024.2 +099300 PERFORM PFM-C-F1-8. NC1024.2 +099400 ADD 200 TO P-COUNT. NC1024.2 +099500 PFM-C-F1-8. NC1024.2 +099600 ADD 1000 TO P-COUNT. NC1024.2 +099700 PERFORM PFM-D-F1-8. NC1024.2 +099800 ADD 2000 TO P-COUNT. NC1024.2 +099900 PFM-D-F1-8. NC1024.2 +100000 ADD 10000 TO P-COUNT. NC1024.2 +100100 PERFORM PFM-E-F1-8. NC1024.2 +100200 ADD 20000 TO P-COUNT. NC1024.2 +100300 PFM-E-F1-8. NC1024.2 +100400 ADD 100000 TO P-COUNT. NC1024.2 +100500 PFM-TESTT-F1-8. NC1024.2 +100600 IF P-COUNT EQUAL TO 133333 NC1024.2 +100700 PERFORM PASS GO TO PFM-WRITE-F1-8. NC1024.2 +100800 GO TO PFM-FAIL-F1-8. NC1024.2 +100900 PFM-DELETE-F1-8. NC1024.2 +101000 PERFORM DE-LETE. NC1024.2 +101100 GO TO PFM-WRITE-F1-8. NC1024.2 +101200 PFM-FAIL-F1-8. NC1024.2 +101300 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +101400 MOVE 133333 TO CORRECT-N. NC1024.2 +101500 PERFORM FAIL. NC1024.2 +101600 PFM-WRITE-F1-8. NC1024.2 +101700 MOVE "NESTED PERFORM " TO FEATURE. NC1024.2 +101800 MOVE "PFM-TEST-F1-8" TO PAR-NAME. NC1024.2 +101900 PERFORM PRINT-DETAIL. NC1024.2 +102000 PFM-INIT-F2-5. NC1024.2 +102100 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +102200 MOVE ZERO TO P-COUNT. NC1024.2 +102300 PFM-TEST-F2-5. NC1024.2 +102400 PERFORM PFM-A-F2-5 THRU PFM-B-F2-5. NC1024.2 +102500 ADD 1 TO P-COUNT. NC1024.2 +102600 PERFORM PFM-A-F2-5 THRU PFM-B-F2-5 2 TIMES. NC1024.2 +102700 ADD 2 TO P-COUNT. NC1024.2 +102800 PFM-A-F2-5. NC1024.2 +102900 ADD 100 TO P-COUNT. NC1024.2 +103000 PFM-B-F2-5. NC1024.2 +103100 EXIT. NC1024.2 +103200 PFM-TESTT-F2-5. NC1024.2 +103300 IF P-COUNT EQUAL TO 000403 NC1024.2 +103400 PERFORM PASS GO TO PFM-WRITE-F2-5. NC1024.2 +103500 GO TO PFM-FAIL-F2-5. NC1024.2 +103600 PFM-DELETE-F2-5. NC1024.2 +103700 PERFORM DE-LETE. NC1024.2 +103800 GO TO PFM-WRITE-F2-5. NC1024.2 +103900 PFM-FAIL-F2-5. NC1024.2 +104000 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +104100 MOVE 000403 TO CORRECT-N. NC1024.2 +104200 MOVE "PERFORM WITH EXIT" TO FEATURE. NC1024.2 +104300 PERFORM FAIL. NC1024.2 +104400 PFM-WRITE-F2-5. NC1024.2 +104500 MOVE "PFM-TEST-F2-5" TO PAR-NAME. NC1024.2 +104600 PERFORM PRINT-DETAIL. NC1024.2 +104700 PFM-INIT-F1-9. NC1024.2 +104800 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +104900 MOVE SPACES TO PERFORM-HOLD. NC1024.2 +105000 PFM-TEST-F1-9. NC1024.2 +105100 PERFORM A101. NC1024.2 +105200 IF PERFORM-HOLD EQUAL TO "ABCDEFGHIJKLMNOPQRST" NC1024.2 +105300 PERFORM PASS NC1024.2 +105400 GO TO PFM-WRITE-F1-9. NC1024.2 +105500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1024.2 +105600 MOVE PERFORM-HOLD TO COMPUTED-A. NC1024.2 +105700 PERFORM FAIL. NC1024.2 +105800 GO TO PFM-WRITE-F1-9. NC1024.2 +105900 PFM-DELETE-F1-9. NC1024.2 +106000 PERFORM DE-LETE. NC1024.2 +106100 PFM-WRITE-F1-9. NC1024.2 +106200 MOVE "PFM-TEST-F1-9" TO PAR-NAME. NC1024.2 +106300 PERFORM PRINT-DETAIL. NC1024.2 +106400 PFM-A-F1-10 SECTION. NC1024.2 +106500 PFM-INIT-F1-10. NC1024.2 +106600 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +106700 PFM-TEST-F1-10. NC1024.2 +106800 PERFORM PFM-G-F1-10 THRU PFM-B-F1-10. NC1024.2 +106900* NOTE PERFORM SECTION-NAME THRU PARAGRAPH-NAME -- SECOND NC1024.2 +107000* PROCEDURE-NAME PHYSICALLY PRECEEDS THE FIRST BUT NC1024.2 +107100* LOGICALLY FOLLOWS IT. NC1024.2 +107200 GO TO PFM-WRITE-F1-10. NC1024.2 +107300 PFM-DELETE-F1-10. NC1024.2 +107400 PERFORM DE-LETE. NC1024.2 +107500 GO TO PFM-WRITE-F1-10. NC1024.2 +107600 PFM-B-F1-10. NC1024.2 +107700 PERFORM PASS. NC1024.2 +107800 PFM-C-F1-10. NC1024.2 +107900 PERFORM FAIL. NC1024.2 +108000 MOVE "RETURN MECHANISM LOST" TO RE-MARK. NC1024.2 +108100 GO TO PFM-WRITE-F1-10. NC1024.2 +108200 PFM-D-F1-10. NC1024.2 +108300 PERFORM FAIL. NC1024.2 +108400 MOVE "PERFORM GOT LOST IN GO TOS" TO RE-MARK. NC1024.2 +108500 GO TO PFM-WRITE-F1-10. NC1024.2 +108600 PFM-E-F1-10. NC1024.2 +108700 GO TO PFM-L-F1-10. NC1024.2 +108800 PFM-F-F1-10. NC1024.2 +108900 GO TO PFM-D-F1-10. NC1024.2 +109000 PFM-G-F1-10 SECTION. NC1024.2 +109100 PFM-H-F1-10. NC1024.2 +109200 GO TO PFM-E-F1-10. NC1024.2 +109300 PFM-I-F1-10. NC1024.2 +109400 GO TO PFM-D-F1-10. NC1024.2 +109500* NOTE SINCE THIS PARAGRAPH SHOULD NEVER BE ENTERED, IT IS NC1024.2 +109600* NOT POSSIBLE TO EXECUTE THE LAST SENTENCE IN PFM- NC1024.2 +109700* G-F1-10 EVEN THOUGH PFM-G-F1-10 IS A SECTION WHICH NC1024.2 +109800* IS THE OBJECT OF A PERFORM -- ALL THIS IS LEGAL. NC1024.2 +109900 PFM-J-F1-10 SECTION. NC1024.2 +110000 NC1024.2 +110100 PFM-K-F1-10. NC1024.2 +110200 PERFORM FAIL. NC1024.2 +110300 MOVE "PFM-K-F1-10 ENTERED" TO RE-MARK. NC1024.2 +110400 GO TO PFM-WRITE-F1-10. NC1024.2 +110500 PFM-L-F1-10. NC1024.2 +110600 GO TO PFM-B-F1-10. NC1024.2 +110700 PFM-WRITE-F1-10. NC1024.2 +110800 MOVE "PERFORM GO TO PARAS" TO FEATURE. NC1024.2 +110900 MOVE "PFM-TEST-F1-10" TO PAR-NAME. NC1024.2 +111000 PERFORM PRINT-DETAIL. NC1024.2 +111100 PFM-INIT-F2-5. NC1024.2 +111200 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +111300 MOVE ZERO TO PERFORM2. NC1024.2 +111400 PFM-TEST-F2-6. NC1024.2 +111500 PERFORM PFM-S PERFORM2 TIMES. NC1024.2 +111600 MOVE -3 TO PERFORM2. NC1024.2 +111700 PERFORM PFM-T PERFORM2 TIMES. NC1024.2 +111800 MOVE 7 TO PERFORM5. NC1024.2 +111900 PERFORM PFM-U PERFORM5 TIMES. NC1024.2 +112000* NOTE THE STANDARD SPECIFIES THAT THE COMPILER MUST NC1024.2 +112100* SIMPLY IGNORE THE FIRST TWO PERFORM5, AND MUST NC1024.2 +112200* PERFORM PFM-U SEVEN TIMES --- NOTE THAT PERFORM5 NC1024.2 +112300* IS INCREMENTED IN PFM-U, BUT THIS SHOULD HAVE NO NC1024.2 +112400* EFFECT ON THE NUMBER OF TIMES PFM-U IS PERFORMED. NC1024.2 +112500 IF PERFORM5 EQUAL TO 707 NC1024.2 +112600 PERFORM PASS GO TO PFM-WRITE-F2-6. NC1024.2 +112700 GO TO PFM-FAIL-F2-6. NC1024.2 +112800 PFM-DELETE-F2-6. NC1024.2 +112900 PERFORM DE-LETE. NC1024.2 +113000 GO TO PFM-WRITE-F2-6. NC1024.2 +113100 PFM-FAIL-F2-6. NC1024.2 +113200 MOVE PERFORM5 TO COMPUTED-N. NC1024.2 +113300 MOVE 707 TO CORRECT-N. NC1024.2 +113400 PERFORM FAIL. NC1024.2 +113500 PFM-WRITE-F2-6. NC1024.2 +113600 MOVE "PERFORM ... TIMES" TO FEATURE. NC1024.2 +113700 MOVE "PFM-TEST-F2-6" TO PAR-NAME. NC1024.2 +113800 PERFORM PRINT-DETAIL. NC1024.2 +113900* NC1024.2 +114000* NC1024.2 +114100 PFM-INIT-F1-11. NC1024.2 +114200 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +114300* ==--> IN LINE PERFORM <--== NC1024.2 +114400 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +114500 MOVE 0 TO WRK-DU-2V0-2. NC1024.2 +114600 PFM-TEST-F1-11-0. NC1024.2 +114700 PERFORM MOVE 88 TO WRK-DU-2V0-1 NC1024.2 +114800 MOVE 99 TO WRK-DU-2V0-2 NC1024.2 +114900 END-PERFORM. NC1024.2 +115000 PFM-TEST-F1-11-1. NC1024.2 +115100 IF WRK-DU-2V0-1 = 88 NC1024.2 +115200 PERFORM PASS NC1024.2 +115300 ELSE NC1024.2 +115400 MOVE 88 TO CORRECT-N NC1024.2 +115500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +115600 PERFORM FAIL. NC1024.2 +115700 GO TO PFM-WRITE-F1-11-1. NC1024.2 +115800 PFM-DELETE-F1-11-1. NC1024.2 +115900 PERFORM DE-LETE. NC1024.2 +116000 PFM-WRITE-F1-11-1. NC1024.2 +116100 MOVE "PFM-TEST-F1-11-1" TO PAR-NAME. NC1024.2 +116200 PERFORM PRINT-DETAIL. NC1024.2 +116300 PFM-TEST-F1-11-2. NC1024.2 +116400 IF WRK-DU-2V0-2 = 99 NC1024.2 +116500 PERFORM PASS NC1024.2 +116600 ELSE NC1024.2 +116700 MOVE 99 TO CORRECT-N NC1024.2 +116800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1024.2 +116900 PERFORM FAIL. NC1024.2 +117000 GO TO PFM-WRITE-F1-11-2. NC1024.2 +117100 PFM-DELETE-F1-11-2. NC1024.2 +117200 PERFORM DE-LETE. NC1024.2 +117300 PFM-WRITE-F1-11-2. NC1024.2 +117400 MOVE "PFM-TEST-F1-11-2" TO PAR-NAME. NC1024.2 +117500 PERFORM PRINT-DETAIL. NC1024.2 +117600* NC1024.2 +117700* NC1024.2 +117800 PFM-INIT-F2-7. NC1024.2 +117900* ==--> IN LINE PERFORM <--== NC1024.2 +118000 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +118100 MOVE "PERFORM .... TIMES" TO FEATURE. NC1024.2 +118200 MOVE 0 TO P-COUNT. NC1024.2 +118300 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +118400 PFM-TEST-F2-7-0. NC1024.2 +118500 PERFORM 4 TIMES NC1024.2 +118600 ADD 3 TO P-COUNT NC1024.2 +118700 ADD 4 TO P-COUNT NC1024.2 +118800 END-PERFORM NC1024.2 +118900 MOVE 77 TO WRK-DU-2V0-1. NC1024.2 +119000 PFM-TEST-F2-7-1. NC1024.2 +119100 IF P-COUNT = 28 NC1024.2 +119200 PERFORM PASS NC1024.2 +119300 ELSE NC1024.2 +119400 MOVE 28 TO CORRECT-N NC1024.2 +119500 MOVE P-COUNT TO COMPUTED-N NC1024.2 +119600 PERFORM FAIL. NC1024.2 +119700 GO TO PFM-WRITE-F2-7-1. NC1024.2 +119800 PFM-DELETE-F2-7-1. NC1024.2 +119900 PERFORM DE-LETE. NC1024.2 +120000 PFM-WRITE-F2-7-1. NC1024.2 +120100 MOVE "PFM-TEST-F2-7-1" TO PAR-NAME. NC1024.2 +120200 PERFORM PRINT-DETAIL. NC1024.2 +120300 PFM-TEST-F2-7-2. NC1024.2 +120400 IF WRK-DU-2V0-1 = 77 NC1024.2 +120500 PERFORM PASS NC1024.2 +120600 ELSE NC1024.2 +120700 MOVE 77 TO CORRECT-N NC1024.2 +120800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +120900 PERFORM FAIL. NC1024.2 +121000 GO TO PFM-WRITE-F2-7-2. NC1024.2 +121100 PFM-DELETE-F2-7-2. NC1024.2 +121200 PERFORM DE-LETE. NC1024.2 +121300 PFM-WRITE-F2-7-2. NC1024.2 +121400 MOVE "PFM-TEST-F2-7-2" TO PAR-NAME. NC1024.2 +121500 PERFORM PRINT-DETAIL. NC1024.2 +121600* NC1024.2 +121700* NC1024.2 +121800 PFM-INIT-F2-8. NC1024.2 +121900* ==--> IN LINE PERFORM <--== NC1024.2 +122000 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +122100 MOVE "PERFORM .... TIMES" TO FEATURE. NC1024.2 +122200 MOVE 0 TO P-COUNT. NC1024.2 +122300 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +122400 MOVE 4 TO WRK-DU-2V0-2. NC1024.2 +122500 PFM-TEST-F2-8-0. NC1024.2 +122600 PERFORM WRK-DU-2V0-2 TIMES NC1024.2 +122700 ADD 3 TO P-COUNT NC1024.2 +122800 ADD 4 TO P-COUNT NC1024.2 +122900 END-PERFORM NC1024.2 +123000 MOVE 77 TO WRK-DU-2V0-1. NC1024.2 +123100 PFM-TEST-F2-8-1. NC1024.2 +123200 IF P-COUNT = 28 NC1024.2 +123300 PERFORM PASS NC1024.2 +123400 ELSE NC1024.2 +123500 MOVE 28 TO CORRECT-N NC1024.2 +123600 MOVE P-COUNT TO COMPUTED-N NC1024.2 +123700 PERFORM FAIL. NC1024.2 +123800 GO TO PFM-WRITE-F2-8-1. NC1024.2 +123900 PFM-DELETE-F2-8-1. NC1024.2 +124000 PERFORM DE-LETE. NC1024.2 +124100 PFM-WRITE-F2-8-1. NC1024.2 +124200 MOVE "PFM-TEST-F2-8-1" TO PAR-NAME. NC1024.2 +124300 PERFORM PRINT-DETAIL. NC1024.2 +124400 PFM-TEST-F2-8-2. NC1024.2 +124500 IF WRK-DU-2V0-1 = 77 NC1024.2 +124600 PERFORM PASS NC1024.2 +124700 ELSE NC1024.2 +124800 MOVE 77 TO CORRECT-N NC1024.2 +124900 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +125000 PERFORM FAIL. NC1024.2 +125100 GO TO PFM-WRITE-F2-8-2. NC1024.2 +125200 PFM-DELETE-F2-8-2. NC1024.2 +125300 PERFORM DE-LETE. NC1024.2 +125400 PFM-WRITE-F2-8-2. NC1024.2 +125500 MOVE "PFM-TEST-F2-8-2" TO PAR-NAME. NC1024.2 +125600 PERFORM PRINT-DETAIL. NC1024.2 +125700* NC1024.2 +125800* NC1024.2 +125900 PFM-INIT-F3-1. NC1024.2 +126000 MOVE "PERFORM UNTIL" TO FEATURE. NC1024.2 +126100 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +126200 MOVE 1 TO PERFORM2. NC1024.2 +126300 MOVE 5 TO PERFORM3. NC1024.2 +126400 PFM-TEST-F3-1. NC1024.2 +126500 PERFORM PFM-F3-1-A THRU PFM-F3-1-AA NC1024.2 +126600 UNTIL PERFORM2 EQUAL TO 48. NC1024.2 +126700* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC1024.2 +126800* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC1024.2 +126900 IF PERFORM2 = 48 NC1024.2 +127000 PERFORM PASS NC1024.2 +127100 GO TO PFM-WRITE-F3-1. NC1024.2 +127200 GO TO PFM-FAIL-F3-1. NC1024.2 +127300 PFM-DELETE-F3-1. NC1024.2 +127400 PERFORM DE-LETE. NC1024.2 +127500 GO TO PFM-WRITE-F3-1. NC1024.2 +127600 PFM-F3-1-A. NC1024.2 +127700 MULTIPLY PERFORM3 BY 6 GIVING PERFORM2. NC1024.2 +127800 PFM-F3-1-AA. NC1024.2 +127900 ADD 1 TO PERFORM3. NC1024.2 +128000 PFM-FAIL-F3-1. NC1024.2 +128100 MOVE PERFORM2 TO COMPUTED-N. NC1024.2 +128200 MOVE 48 TO CORRECT-N. NC1024.2 +128300 PERFORM FAIL. NC1024.2 +128400 PFM-WRITE-F3-1. NC1024.2 +128500 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC1024.2 +128600 PERFORM PRINT-DETAIL. NC1024.2 +128700* NC1024.2 +128800* NC1024.2 +128900 PFM-INIT-F3-2. NC1024.2 +129000 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +129100 MOVE 50 TO PERFORM2. NC1024.2 +129200* NOTE: IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC1024.2 +129300* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-F3-2-C. NC1024.2 +129400 PFM-TEST-F3-2-0. NC1024.2 +129500 PERFORM PFM-F3-2-C UNTIL PERFORM2 GREATER THAN 25. NC1024.2 +129600 IF PERFORM2 EQUAL TO 50 NC1024.2 +129700 PERFORM PASS NC1024.2 +129800 GO TO PFM-WRITE-F3-2. NC1024.2 +129900 GO TO PFM-FAIL-F3-2. NC1024.2 +130000 PFM-DELETE-F3-2. NC1024.2 +130100 PERFORM DE-LETE. NC1024.2 +130200 GO TO PFM-WRITE-F3-2. NC1024.2 +130300 PFM-F3-2-C. NC1024.2 +130400 ADD 1 TO PERFORM2. NC1024.2 +130500 PFM-FAIL-F3-2. NC1024.2 +130600 MOVE PERFORM2 TO COMPUTED-N. NC1024.2 +130700 MOVE 50 TO CORRECT-N. NC1024.2 +130800 PERFORM FAIL. NC1024.2 +130900 PFM-WRITE-F3-2. NC1024.2 +131000 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC1024.2 +131100 PERFORM PRINT-DETAIL. NC1024.2 +131200* NC1024.2 +131300* NC1024.2 +131400 PFM-INIT-F3-3. NC1024.2 +131500 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +131600 MOVE ZERO TO WRK-DS-02V00. NC1024.2 +131700 PFM-TEST-F3-3. NC1024.2 +131800 PERFORM PFM-A-F3-3 THROUGH PFM-B-F3-3 NC1024.2 +131900 UNTIL WRK-DS-02V00 IS EQUAL TO 99. NC1024.2 +132000 GO TO PFM-TESTT-F3-3. NC1024.2 +132100 PFM-A-F3-3. NC1024.2 +132200 EXIT. NC1024.2 +132300 PFM-B-F3-3. NC1024.2 +132400 ADD 1 TO WRK-DS-02V00. NC1024.2 +132500 PFM-TESTT-F3-3. NC1024.2 +132600 IF WRK-DS-02V00 EQUAL TO 99 NC1024.2 +132700 PERFORM PASS GO TO PFM-WRITE-F3-3. NC1024.2 +132800 GO TO PFM-FAIL-F3-3. NC1024.2 +132900 PFM-DELETE-F3-3. NC1024.2 +133000 PERFORM DE-LETE. NC1024.2 +133100 GO TO PFM-WRITE-F3-3. NC1024.2 +133200 PFM-FAIL-F3-3. NC1024.2 +133300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1024.2 +133400 MOVE 99 TO CORRECT-N. NC1024.2 +133500 PERFORM FAIL. NC1024.2 +133600 PFM-WRITE-F3-3. NC1024.2 +133700 MOVE "PFM-TEST-F3-3 " TO PAR-NAME. NC1024.2 +133800 PERFORM PRINT-DETAIL. NC1024.2 +133900* NC1024.2 +134000* NC1024.2 +134100 PFM-INIT-F3-4. NC1024.2 +134200* ==--> IN-LINE PERFORM <--== NC1024.2 +134300 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +134400 MOVE ZERO TO WRK-DU-6V0-1. NC1024.2 +134500 PFM-TEST-F3-4-0. NC1024.2 +134600 PERFORM UNTIL WRK-DU-6V0-1 = 99 NC1024.2 +134700 ADD 6 TO WRK-DU-6V0-1 NC1024.2 +134800 SUBTRACT 3 FROM WRK-DU-6V0-1 NC1024.2 +134900 END-PERFORM NC1024.2 +135000 SUBTRACT 1 FROM WRK-DU-6V0-1. NC1024.2 +135100 PFM-TESTT-F3-4-1. NC1024.2 +135200 IF WRK-DU-6V0-1 EQUAL TO 98 NC1024.2 +135300 PERFORM PASS GO TO PFM-WRITE-F3-4. NC1024.2 +135400 GO TO PFM-FAIL-F3-4. NC1024.2 +135500 PFM-DELETE-F3-4. NC1024.2 +135600 PERFORM DE-LETE. NC1024.2 +135700 GO TO PFM-WRITE-F3-4. NC1024.2 +135800 PFM-FAIL-F3-4. NC1024.2 +135900 MOVE WRK-DU-6V0-1 TO COMPUTED-N. NC1024.2 +136000 MOVE 98 TO CORRECT-N. NC1024.2 +136100 PERFORM FAIL. NC1024.2 +136200 PFM-WRITE-F3-4. NC1024.2 +136300 MOVE "PFM-TEST-F3-4 " TO PAR-NAME. NC1024.2 +136400 PERFORM PRINT-DETAIL. NC1024.2 +136500 GO TO CCVS-EXIT. NC1024.2 +136600 A121. NC1024.2 +136700 EXIT. NC1024.2 +136800 A120. NC1024.2 +136900 MOVE "T" TO TEST-LETTER (20). NC1024.2 +137000 PERFORM A121. NC1024.2 +137100 A119. NC1024.2 +137200 MOVE "S" TO TEST-LETTER (19). NC1024.2 +137300 PERFORM A120. NC1024.2 +137400 A118. NC1024.2 +137500 MOVE "R" TO TEST-LETTER (18). NC1024.2 +137600 PERFORM A119. NC1024.2 +137700 A117. NC1024.2 +137800 MOVE "Q" TO TEST-LETTER (17). NC1024.2 +137900 PERFORM A118. NC1024.2 +138000 A116. NC1024.2 +138100 MOVE "P" TO TEST-LETTER (16). NC1024.2 +138200 PERFORM A117. NC1024.2 +138300 A115. NC1024.2 +138400 MOVE "O" TO TEST-LETTER (15). NC1024.2 +138500 PERFORM A116. NC1024.2 +138600 A114. NC1024.2 +138700 MOVE "N" TO TEST-LETTER (14). NC1024.2 +138800 PERFORM A115. NC1024.2 +138900 A113. NC1024.2 +139000 MOVE "M" TO TEST-LETTER (13). NC1024.2 +139100 PERFORM A114. NC1024.2 +139200 A112. NC1024.2 +139300 MOVE "L" TO TEST-LETTER (12). NC1024.2 +139400 PERFORM A113. NC1024.2 +139500 A111. NC1024.2 +139600 MOVE "K" TO TEST-LETTER (11). NC1024.2 +139700 PERFORM A112. NC1024.2 +139800 A110. NC1024.2 +139900 MOVE "J" TO TEST-LETTER (10). NC1024.2 +140000 PERFORM A111. NC1024.2 +140100 A109. NC1024.2 +140200 MOVE "I" TO TEST-LETTER (9). NC1024.2 +140300 PERFORM A110. NC1024.2 +140400 A108. NC1024.2 +140500 MOVE "H" TO TEST-LETTER (8). NC1024.2 +140600 PERFORM A109. NC1024.2 +140700 A107. NC1024.2 +140800 MOVE "G" TO TEST-LETTER (7). NC1024.2 +140900 PERFORM A108. NC1024.2 +141000 A106. NC1024.2 +141100 MOVE "F" TO TEST-LETTER (6). NC1024.2 +141200 PERFORM A107. NC1024.2 +141300 A105. NC1024.2 +141400 MOVE "E" TO TEST-LETTER (5). NC1024.2 +141500 PERFORM A106. NC1024.2 +141600 A104. NC1024.2 +141700 MOVE "D" TO TEST-LETTER (4). NC1024.2 +141800 PERFORM A105. NC1024.2 +141900 A103. NC1024.2 +142000 MOVE "C" TO TEST-LETTER (3). NC1024.2 +142100 PERFORM A104. NC1024.2 +142200 A102. NC1024.2 +142300 MOVE "B" TO TEST-LETTER (2). NC1024.2 +142400 PERFORM A103. NC1024.2 +142500 A101. NC1024.2 +142600 MOVE "A" TO TEST-LETTER (1). NC1024.2 +142700 PERFORM A102. NC1024.2 +142800 PFM-C. NC1024.2 +142900 ADD 6 TO PERFORM2. NC1024.2 +143000 PFM-D. NC1024.2 +143100 PERFORM FAIL. NC1024.2 +143200 GO TO PFM-TEST-F1-3. NC1024.2 +143300* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +143400* FROM THE PREVIOUS ONE. NC1024.2 +143500 PFM-E. NC1024.2 +143600 MOVE "CSW" TO PERFORM1. NC1024.2 +143700 PERFORM PFM-F THRU PFM-G. NC1024.2 +143800 SUBTRACT .8 FROM PERFORM4. NC1024.2 +143900 GO TO PFM-H. NC1024.2 +144000 PFM-F. NC1024.2 +144100 MOVE 60.5 TO PERFORM4. NC1024.2 +144200 PFM-G. NC1024.2 +144300 ADD 10.3 TO PERFORM4. NC1024.2 +144400 PFM-H. NC1024.2 +144500 EXIT. NC1024.2 +144600 PFM-I. NC1024.2 +144700 PERFORM FAIL. NC1024.2 +144800 GO TO PFM-WRITE-F3-4. NC1024.2 +144900* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +145000* FROM THE PREVIOUS ONE. NC1024.2 +145100 PFM-J. NC1024.2 +145200 MOVE "YES" TO PERFORM1. NC1024.2 +145300 PERFORM PFM-L. NC1024.2 +145400 MULTIPLY 3 BY PERFORM2. NC1024.2 +145500 PFM-K. NC1024.2 +145600 PERFORM FAIL. NC1024.2 +145700 GO TO PFM-WRITE-F1-4. NC1024.2 +145800* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +145900* FROM THE PREVIOUS ONE. NC1024.2 +146000 PFM-L. NC1024.2 +146100 MOVE 4 TO PERFORM2. NC1024.2 +146200 ADD 100 TO PERFORM2. NC1024.2 +146300 PFM-M. NC1024.2 +146400 PERFORM FAIL. NC1024.2 +146500 GO TO PFM-WRITE-F1-4. NC1024.2 +146600* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +146700* FROM THE PREVIOUS ONE. NC1024.2 +146800 PFM-N SECTION. NC1024.2 +146900 PFM-O. NC1024.2 +147000 PERFORM FAIL. NC1024.2 +147100 PFM-P. NC1024.2 +147200 SUBTRACT 1 FROM ERROR-COUNTER. NC1024.2 +147300 PERFORM PASS. NC1024.2 +147400 PFM-Q SECTION. NC1024.2 +147500 PFM-R. NC1024.2 +147600 PERFORM FAIL. NC1024.2 +147700 GO TO PFM-WRITE-F1-5. NC1024.2 +147800* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH FROM THE NC1024.2 +147900* PREVIOUS ONE. NC1024.2 +148000 PFM-S. NC1024.2 +148100 ADD 1 TO PERFORM5. NC1024.2 +148200 PFM-T. NC1024.2 +148300 ADD 10 TO PERFORM5. NC1024.2 +148400 PFM-U. NC1024.2 +148500 ADD 100 TO PERFORM5. NC1024.2 +148600 IF PERFORM5 GREATER THAN 899 NC1024.2 +148700 MOVE PERFORM5 TO COMPUTED-N NC1024.2 +148800 MOVE 707 TO CORRECT-N NC1024.2 +148900 PERFORM FAIL NC1024.2 +149000 MOVE "PFM-TEST-F2-6" TO PAR-NAME NC1024.2 +149100 MOVE "*** ABORTED *** SEE PFM-U" TO RE-MARK NC1024.2 +149200 PERFORM PRINT-DETAIL NC1024.2 +149300 PERFORM END-ROUTINE THRU END-ROUTINE-13 NC1024.2 +149400 CLOSE PRINT-FILE NC1024.2 +149500 STOP RUN. NC1024.2 +149600 PFM-V. EXIT. NC1024.2 +149700 PFM-W. EXIT. NC1024.2 +149800 PFM-X. EXIT. NC1024.2 +149900 PFM-Y. EXIT. NC1024.2 +150000 PFM-Z. EXIT. NC1024.2 +150100 CCVS-EXIT SECTION. NC1024.2 +150200 CCVS-999999. NC1024.2 +150300 GO TO CLOSE-FILES. NC1024.2 +*END-OF,NC102A +*HEADER,COBOL,NC103A +000100 IDENTIFICATION DIVISION. NC1034.2 +000200 PROGRAM-ID. NC1034.2 +000300 NC103A. NC1034.2 +000400**************************************************************** NC1034.2 +000500* * NC1034.2 +000600* VALIDATION FOR:- * NC1034.2 +000700* * NC1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +000900* * NC1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1034.2 +001100* * NC1034.2 +001200**************************************************************** NC1034.2 +001300* * NC1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1034.2 +001500* * NC1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1034.2 +001900* * NC1034.2 +002000**************************************************************** NC1034.2 +002100* NC1034.2 +002200* PROGRAM NC103A TESTS THE GENERAL FORMAT OF THE "IF" NC1034.2 +002300* STATEMENT AND "NEXT SENTENCE". NC1034.2 +002400* NC1034.2 +002500 ENVIRONMENT DIVISION. NC1034.2 +002600 CONFIGURATION SECTION. NC1034.2 +002700 SOURCE-COMPUTER. NC1034.2 +002800 XXXXX082. NC1034.2 +002900 OBJECT-COMPUTER. NC1034.2 +003000 XXXXX083. NC1034.2 +003100 INPUT-OUTPUT SECTION. NC1034.2 +003200 FILE-CONTROL. NC1034.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1034.2 +003400 XXXXX055. NC1034.2 +003500 DATA DIVISION. NC1034.2 +003600 FILE SECTION. NC1034.2 +003700 FD PRINT-FILE. NC1034.2 +003800 01 PRINT-REC PICTURE X(120). NC1034.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1034.2 +004000 WORKING-STORAGE SECTION. NC1034.2 +004100 01 TEST-RESULTS. NC1034.2 +004200 02 FILLER PIC X VALUE SPACE. NC1034.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. NC1034.2 +004400 02 FILLER PIC X VALUE SPACE. NC1034.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. NC1034.2 +004600 02 FILLER PIC X VALUE SPACE. NC1034.2 +004700 02 PAR-NAME. NC1034.2 +004800 03 FILLER PIC X(19) VALUE SPACE. NC1034.2 +004900 03 PARDOT-X PIC X VALUE SPACE. NC1034.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. NC1034.2 +005100 02 FILLER PIC X(8) VALUE SPACE. NC1034.2 +005200 02 RE-MARK PIC X(61). NC1034.2 +005300 01 TEST-COMPUTED. NC1034.2 +005400 02 FILLER PIC X(30) VALUE SPACE. NC1034.2 +005500 02 FILLER PIC X(17) VALUE NC1034.2 +005600 " COMPUTED=". NC1034.2 +005700 02 COMPUTED-X. NC1034.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1034.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A NC1034.2 +006000 PIC -9(9).9(9). NC1034.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1034.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1034.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1034.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. NC1034.2 +006500 04 COMPUTED-18V0 PIC -9(18). NC1034.2 +006600 04 FILLER PIC X. NC1034.2 +006700 03 FILLER PIC X(50) VALUE SPACE. NC1034.2 +006800 01 TEST-CORRECT. NC1034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1034.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1034.2 +007100 02 CORRECT-X. NC1034.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1034.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1034.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1034.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1034.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1034.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. NC1034.2 +007800 04 CORRECT-18V0 PIC -9(18). NC1034.2 +007900 04 FILLER PIC X. NC1034.2 +008000 03 FILLER PIC X(2) VALUE SPACE. NC1034.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1034.2 +008200 01 CCVS-C-1. NC1034.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1034.2 +008400- "SS PARAGRAPH-NAME NC1034.2 +008500- " REMARKS". NC1034.2 +008600 02 FILLER PIC X(20) VALUE SPACE. NC1034.2 +008700 01 CCVS-C-2. NC1034.2 +008800 02 FILLER PIC X VALUE SPACE. NC1034.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". NC1034.2 +009000 02 FILLER PIC X(15) VALUE SPACE. NC1034.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". NC1034.2 +009200 02 FILLER PIC X(94) VALUE SPACE. NC1034.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1034.2 +009400 01 REC-CT PIC 99 VALUE ZERO. NC1034.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1034.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1034.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1034.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1034.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1034.2 +010400 01 CCVS-H-1. NC1034.2 +010500 02 FILLER PIC X(39) VALUE SPACES. NC1034.2 +010600 02 FILLER PIC X(42) VALUE NC1034.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1034.2 +010800 02 FILLER PIC X(39) VALUE SPACES. NC1034.2 +010900 01 CCVS-H-2A. NC1034.2 +011000 02 FILLER PIC X(40) VALUE SPACE. NC1034.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1034.2 +011200 02 FILLER PIC XXXX VALUE NC1034.2 +011300 "4.2 ". NC1034.2 +011400 02 FILLER PIC X(28) VALUE NC1034.2 +011500 " COPY - NOT FOR DISTRIBUTION". NC1034.2 +011600 02 FILLER PIC X(41) VALUE SPACE. NC1034.2 +011700 NC1034.2 +011800 01 CCVS-H-2B. NC1034.2 +011900 02 FILLER PIC X(15) VALUE NC1034.2 +012000 "TEST RESULT OF ". NC1034.2 +012100 02 TEST-ID PIC X(9). NC1034.2 +012200 02 FILLER PIC X(4) VALUE NC1034.2 +012300 " IN ". NC1034.2 +012400 02 FILLER PIC X(12) VALUE NC1034.2 +012500 " HIGH ". NC1034.2 +012600 02 FILLER PIC X(22) VALUE NC1034.2 +012700 " LEVEL VALIDATION FOR ". NC1034.2 +012800 02 FILLER PIC X(58) VALUE NC1034.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +013000 01 CCVS-H-3. NC1034.2 +013100 02 FILLER PIC X(34) VALUE NC1034.2 +013200 " FOR OFFICIAL USE ONLY ". NC1034.2 +013300 02 FILLER PIC X(58) VALUE NC1034.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1034.2 +013500 02 FILLER PIC X(28) VALUE NC1034.2 +013600 " COPYRIGHT 1985 ". NC1034.2 +013700 01 CCVS-E-1. NC1034.2 +013800 02 FILLER PIC X(52) VALUE SPACE. NC1034.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1034.2 +014000 02 ID-AGAIN PIC X(9). NC1034.2 +014100 02 FILLER PIC X(45) VALUE SPACES. NC1034.2 +014200 01 CCVS-E-2. NC1034.2 +014300 02 FILLER PIC X(31) VALUE SPACE. NC1034.2 +014400 02 FILLER PIC X(21) VALUE SPACE. NC1034.2 +014500 02 CCVS-E-2-2. NC1034.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1034.2 +014700 03 FILLER PIC X VALUE SPACE. NC1034.2 +014800 03 ENDER-DESC PIC X(44) VALUE NC1034.2 +014900 "ERRORS ENCOUNTERED". NC1034.2 +015000 01 CCVS-E-3. NC1034.2 +015100 02 FILLER PIC X(22) VALUE NC1034.2 +015200 " FOR OFFICIAL USE ONLY". NC1034.2 +015300 02 FILLER PIC X(12) VALUE SPACE. NC1034.2 +015400 02 FILLER PIC X(58) VALUE NC1034.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +015600 02 FILLER PIC X(13) VALUE SPACE. NC1034.2 +015700 02 FILLER PIC X(15) VALUE NC1034.2 +015800 " COPYRIGHT 1985". NC1034.2 +015900 01 CCVS-E-4. NC1034.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1034.2 +016100 02 FILLER PIC X(4) VALUE " OF ". NC1034.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1034.2 +016300 02 FILLER PIC X(40) VALUE NC1034.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1034.2 +016500 01 XXINFO. NC1034.2 +016600 02 FILLER PIC X(19) VALUE NC1034.2 +016700 "*** INFORMATION ***". NC1034.2 +016800 02 INFO-TEXT. NC1034.2 +016900 04 FILLER PIC X(8) VALUE SPACE. NC1034.2 +017000 04 XXCOMPUTED PIC X(20). NC1034.2 +017100 04 FILLER PIC X(5) VALUE SPACE. NC1034.2 +017200 04 XXCORRECT PIC X(20). NC1034.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). NC1034.2 +017400 01 HYPHEN-LINE. NC1034.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. NC1034.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************NC1034.2 +017700- "*****************************************". NC1034.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************NC1034.2 +017900- "******************************". NC1034.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE NC1034.2 +018100 "NC103A". NC1034.2 +018200 01 IF-D1 PICTURE IS S9(4)V9(2) NC1034.2 +018300 VALUE IS 0. NC1034.2 +018400 01 IF-D2 PICTURE IS S9(4)V9(2) NC1034.2 +018500 VALUE IS ZERO. NC1034.2 +018600 01 IF-D3 PICTURE IS X(10) NC1034.2 +018700 VALUE IS "0000000000". NC1034.2 +018800 01 IF-D4 PICTURE IS X(15) NC1034.2 +018900 VALUE IS " ". NC1034.2 +019000 01 IF-D6 PICTURE IS A(10) NC1034.2 +019100 VALUE IS "BABABABABA". NC1034.2 +019200 01 IF-D7 PICTURE IS S9(6)V9(4) NC1034.2 +019300 VALUE IS +123.45. NC1034.2 +019400 01 IF-D8 PICTURE IS 9(6)V9(4) NC1034.2 +019500 VALUE IS 12300. NC1034.2 +019600 01 IF-D9 PICTURE IS X(3) NC1034.2 +019700 VALUE IS "123". NC1034.2 +019800 01 IF-D11 PICTURE IS X(6) NC1034.2 +019900 VALUE IS "ABCDEF". NC1034.2 +020000 01 IF-D13 PICTURE IS 9(6)V9(4) NC1034.2 +020100 VALUE IS 12300. NC1034.2 +020200 01 IF-D14 PICTURE IS S9(4)V9(2) NC1034.2 +020300 VALUE IS +123.45. NC1034.2 +020400 01 IF-D15 PICTURE IS S999PP NC1034.2 +020500 VALUE IS 12300. NC1034.2 +020600 01 IF-D16 PICTURE IS PP99 NC1034.2 +020700 VALUE IS .0012. NC1034.2 +020800 01 IF-D17 PICTURE IS SV9(4) NC1034.2 +020900 VALUE IS .0012. NC1034.2 +021000 01 IF-D18 PICTURE IS X(10) NC1034.2 +021100 VALUE IS "BABABABABA". NC1034.2 +021200 01 IF-D19 PICTURE IS X(10) NC1034.2 +021300 VALUE IS "ABCDEF ". NC1034.2 +021400 01 IF-D23 PICTURE IS $9,9B9.90+. NC1034.2 +021500 01 IF-D24 PICTURE IS X(10) NC1034.2 +021600 VALUE IS "$1,2 3.40+". NC1034.2 +021700 01 IF-D25 PICTURE IS ABABX0A. NC1034.2 +021800 01 IF-D26 PIC X(7) NC1034.2 +021900 VALUE IS "A C D0E". NC1034.2 +022000 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC1034.2 +022100 USAGE IS COMPUTATIONAL. NC1034.2 +022200 01 IF-D28 PICTURE IS 999999V9999 NC1034.2 +022300 VALUE IS 2137.45. NC1034.2 +022400 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC1034.2 +022500 01 IF-D33 PICTURE S9 VALUE -0. NC1034.2 +022600 01 IF-D34 PICTURE S9 VALUE +0. NC1034.2 +022700 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC1034.2 +022800 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC1034.2 +022900 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC1034.2 +023000 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC1034.2 +023100 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC1034.2 +023200 XXXXX081. NC1034.2 +023300 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1034.2 +023400 01 A18ONES-DS-18V00 PICTURE S9(18) NC1034.2 +023500 VALUE 111111111111111111. NC1034.2 +023600 01 ONES-XN-00018 PICTURE X(18) NC1034.2 +023700 VALUE "111111111111111111". NC1034.2 +023800 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC1034.2 +023900 01 WRK-DU-02V00 PICTURE 99. NC1034.2 +024000 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC1034.2 +024100 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1034.2 +024200 VALUE 111111111.111111111. NC1034.2 +024300 01 ONES-XN-00002 PICTURE XX VALUE "11". NC1034.2 +024400 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1034.2 +024500 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1034.2 +024600 01 A990-DS-0201P PICTURE S99P VALUE +990. NC1034.2 +024700 01 XDATA-XN-00018 PICTURE X(18) NC1034.2 +024800 VALUE "00ABCDEFGHI 4321 ". NC1034.2 +024900 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC1034.2 +025000 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC1034.2 +025100 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC1034.2 +025200 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC1034.2 +025300 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1034.2 +025400 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC1034.2 +025500 -123456789012345678. NC1034.2 +025600 01 WRK-XN-18-2 PIC X(18) VALUE NC1034.2 +025700 "123456789012345678". NC1034.2 +025800 NC1034.2 +025900 01 IF-D10. NC1034.2 +026000 02 FILLER PICTURE XX VALUE "01". NC1034.2 +026100 02 FILLER PICTURE XX VALUE "23". NC1034.2 +026200 02 IF-D10A. NC1034.2 +026300 03 FILLER PICTURE XXXX VALUE "4567". NC1034.2 +026400 03 FILLER PICTURE XXXX VALUE "8912". NC1034.2 +026500 01 IF-D12. NC1034.2 +026600 02 FILLER PICTURE XXX VALUE "ABC". NC1034.2 +026700 02 IF-D12A. NC1034.2 +026800 03 IF-D12B. NC1034.2 +026900 04 FILLER PICTURE XX VALUE "DE". NC1034.2 +027000 04 FILLER PICTURE X VALUE "F". NC1034.2 +027100 01 IF-D20. NC1034.2 +027200 02 FILLER PICTURE 9(5) VALUE ZERO. NC1034.2 +027300 02 FILLER PICTURE 99 VALUE 12. NC1034.2 +027400 02 FILLER PICTURE 9 VALUE 3. NC1034.2 +027500 02 FILLER PICTURE 99 VALUE 45. NC1034.2 +027600 01 IF-D21. NC1034.2 +027700 02 FILLER PICTURE 9(5) VALUE ZERO. NC1034.2 +027800 02 FILLER PICTURE 9(5) VALUE 12345. NC1034.2 +027900 01 IF-D22. NC1034.2 +028000 02 FILLER PICTURE AA VALUE "AB". NC1034.2 +028100 02 FILLER PICTURE AAAA VALUE "CDEF". NC1034.2 +028200 01 IF-D35. NC1034.2 +028300 02 IF-D35A VALUE "*ASTERISK". NC1034.2 +028400 03 FILLER PICTURE A(6). NC1034.2 +028500 03 FILLER PICTURE AAA. NC1034.2 +028600 02 IF-D35B VALUE "/SLASH". NC1034.2 +028700 03 FILLER PICTURE 9(6). NC1034.2 +028800 01 IF-D36 REDEFINES IF-D35. NC1034.2 +028900 02 IF-D36A PICTURE X(6). NC1034.2 +029000 02 IF-D36B PICTURE XXX. NC1034.2 +029100 02 IF-D36C PICTURE X(6). NC1034.2 +029200 01 IF-D39. NC1034.2 +029300 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC1034.2 +029400 02 FILLER PICTURE A(4) VALUE SPACE. NC1034.2 +029500 01 LEVEL-01. NC1034.2 +029600 02 LEVEL-02. NC1034.2 +029700 03 LEVEL-03. NC1034.2 +029800 04 LEVEL-04. NC1034.2 +029900 05 LEVEL-05. NC1034.2 +030000 06 LEVEL-06. NC1034.2 +030100 07 LEVEL-07. NC1034.2 +030200 08 LEVEL-08. NC1034.2 +030300 09 LEVEL-09. NC1034.2 +030400 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC1034.2 +030500 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC1034.2 +030600 SPACE. NC1034.2 +030700 01 LEVEL-SENDER PICTURE X VALUE "S". NC1034.2 +030800 01 VAL PICTURE IS 9 VALUE IS 0. NC1034.2 +030900 01 A-2 PICTURE IS A VALUE IS "A".NC1034.2 +031000 01 N-27 PICTURE IS 9999V9 NC1034.2 +031100 VALUE IS 9999.9. NC1034.2 +031200 01 N-30 PICTURE IS 9V9 NC1034.2 +031300 VALUE IS 2. NC1034.2 +031400 01 N-31 PICTURE IS 9(6). NC1034.2 +031500 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC1034.2 +031600 01 N-33 PICTURE IS 9(5) NC1034.2 +031700 VALUE IS 29. NC1034.2 +031800 01 A-37 PICTURE IS A VALUE IS "X".NC1034.2 +031900 01 X-38 REDEFINES A-37 PICTURE IS X. NC1034.2 +032000 01 X-43 PIC X(10) VALUE " l75.63". NC1034.2 +032100 01 N-84 PICTURE IS 9999999999. NC1034.2 +032200 01 NUMERIC-GRP-TEST. NC1034.2 +032300 02 NUMERIC-1 PICTURE 9 VALUE 0. NC1034.2 +032400 02 NUMERIC-2. NC1034.2 +032500 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC1034.2 +032600 03 NUMERIC-4. NC1034.2 +032700 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC1034.2 +032800 02 NUMERIC-6. NC1034.2 +032900 03 NUMERIC-7 PICTURE X VALUE "7". NC1034.2 +033000 03 NUMERIC-8 PICTURE 9 VALUE 8. NC1034.2 +033100 01 NUM-GRP. NC1034.2 +033200 02 NUM-SUB-GRP PIC 9. NC1034.2 +033300 01 GROUP-1000. NC1034.2 +033400 02 FILLER PIC X. NC1034.2 +033500 02 GROUP-X1000. NC1034.2 +033600 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC1034.2 +033700 03 XNAME PICTURE X(100) VALUE QUOTE. NC1034.2 +033800 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC1034.2 +033900 03 GROUP-1000-3 PICTURE X VALUE ".". NC1034.2 +034000 02 GROUP-X500-2. NC1034.2 +034100 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC1034.2 +034200 03 GROUP-X500-1. NC1034.2 +034300 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC1034.2 +034400 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC1034.2 +034500 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC1034.2 +034600 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC1034.2 +034700 01 HI-LO-VALUES. NC1034.2 +034800 02 LOW-VAL PIC X VALUE LOW-VALUE. NC1034.2 +034900 02 ZERO-01 PICTURE 9(18) VALUE 1. NC1034.2 +035000 02 ABC PICTURE XXX VALUE "ABC". NC1034.2 +035100 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC1034.2 +035200 02 ZERO-NULL PIC 9(9) VALUE 0. NC1034.2 +035300 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC1034.2 +035400 01 COMP-DATA. NC1034.2 +035500 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC1034.2 +035600 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC1034.2 +035700 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC1034.2 +035800 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC1034.2 +035900 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC1034.2 +036000 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC1034.2 +036100 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC1034.2 +036200 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC1034.2 +036300 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC1034.2 +036400 01 DISP-DATA. NC1034.2 +036500 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC1034.2 +036600 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC1034.2 +036700 02 DISP-DATA3 PICTURE 9 VALUE 9. NC1034.2 +036800 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC1034.2 +036900 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC1034.2 +037000 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC1034.2 +037100 PROCEDURE DIVISION. NC1034.2 +037200 CCVS1 SECTION. NC1034.2 +037300 OPEN-FILES. NC1034.2 +037400 OPEN OUTPUT PRINT-FILE. NC1034.2 +037500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1034.2 +037600 MOVE SPACE TO TEST-RESULTS. NC1034.2 +037700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1034.2 +037800 GO TO CCVS1-EXIT. NC1034.2 +037900 CLOSE-FILES. NC1034.2 +038000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1034.2 +038100 TERMINATE-CCVS. NC1034.2 +038200S EXIT PROGRAM. NC1034.2 +038300STERMINATE-CALL. NC1034.2 +038400 STOP RUN. NC1034.2 +038500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1034.2 +038600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1034.2 +038700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1034.2 +038800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1034.2 +038900 MOVE "****TEST DELETED****" TO RE-MARK. NC1034.2 +039000 PRINT-DETAIL. NC1034.2 +039100 IF REC-CT NOT EQUAL TO ZERO NC1034.2 +039200 MOVE "." TO PARDOT-X NC1034.2 +039300 MOVE REC-CT TO DOTVALUE. NC1034.2 +039400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1034.2 +039500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1034.2 +039600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1034.2 +039700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1034.2 +039800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1034.2 +039900 MOVE SPACE TO CORRECT-X. NC1034.2 +040000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1034.2 +040100 MOVE SPACE TO RE-MARK. NC1034.2 +040200 HEAD-ROUTINE. NC1034.2 +040300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +040400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +040500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1034.2 +040600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1034.2 +040700 COLUMN-NAMES-ROUTINE. NC1034.2 +040800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +040900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +041100 END-ROUTINE. NC1034.2 +041200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1034.2 +041300 END-RTN-EXIT. NC1034.2 +041400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +041500 END-ROUTINE-1. NC1034.2 +041600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1034.2 +041700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1034.2 +041800 ADD PASS-COUNTER TO ERROR-HOLD. NC1034.2 +041900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1034.2 +042000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1034.2 +042100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1034.2 +042200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1034.2 +042300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1034.2 +042400 END-ROUTINE-12. NC1034.2 +042500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1034.2 +042600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1034.2 +042700 MOVE "NO " TO ERROR-TOTAL NC1034.2 +042800 ELSE NC1034.2 +042900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1034.2 +043000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1034.2 +043100 PERFORM WRITE-LINE. NC1034.2 +043200 END-ROUTINE-13. NC1034.2 +043300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1034.2 +043400 MOVE "NO " TO ERROR-TOTAL ELSE NC1034.2 +043500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1034.2 +043600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1034.2 +043700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO NC1034.2 +043900 MOVE "NO " TO ERROR-TOTAL NC1034.2 +044000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1034.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1034.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +044400 WRITE-LINE. NC1034.2 +044500 ADD 1 TO RECORD-COUNT. NC1034.2 +044600Y IF RECORD-COUNT GREATER 42 NC1034.2 +044700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1034.2 +044800Y MOVE SPACE TO DUMMY-RECORD NC1034.2 +044900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1034.2 +045000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1034.2 +045100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1034.2 +045200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1034.2 +045300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1034.2 +045400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1034.2 +045800Y MOVE ZERO TO RECORD-COUNT. NC1034.2 +045900 PERFORM WRT-LN. NC1034.2 +046000 WRT-LN. NC1034.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1034.2 +046200 MOVE SPACE TO DUMMY-RECORD. NC1034.2 +046300 BLANK-LINE-PRINT. NC1034.2 +046400 PERFORM WRT-LN. NC1034.2 +046500 FAIL-ROUTINE. NC1034.2 +046600 IF COMPUTED-X NOT EQUAL TO SPACE NC1034.2 +046700 GO TO FAIL-ROUTINE-WRITE. NC1034.2 +046800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1034.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1034.2 +047000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1034.2 +047100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +047200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1034.2 +047300 GO TO FAIL-ROUTINE-EX. NC1034.2 +047400 FAIL-ROUTINE-WRITE. NC1034.2 +047500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1034.2 +047600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1034.2 +047700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1034.2 +047800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1034.2 +047900 FAIL-ROUTINE-EX. EXIT. NC1034.2 +048000 BAIL-OUT. NC1034.2 +048100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1034.2 +048200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1034.2 +048300 BAIL-OUT-WRITE. NC1034.2 +048400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1034.2 +048500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1034.2 +048600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1034.2 +048800 BAIL-OUT-EX. EXIT. NC1034.2 +048900 CCVS1-EXIT. NC1034.2 +049000 EXIT. NC1034.2 +049100 SECT-NC103A-001 SECTION. NC1034.2 +049200 NC-03-001. NC1034.2 +049300 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC1034.2 +049400 PERFORM PRINT-DETAIL. NC1034.2 +049500 MOVE "COMPARE NUMERIC, ALPHA- " TO RE-MARK. NC1034.2 +049600 PERFORM PRINT-DETAIL. NC1034.2 +049700 MOVE "NUMERIC, ALPHABETIC, AND " TO RE-MARK. NC1034.2 +049800 PERFORM PRINT-DETAIL. NC1034.2 +049900 MOVE "GROUP ITEMS IN VARYING " TO RE-MARK. NC1034.2 +050000 PERFORM PRINT-DETAIL. NC1034.2 +050100 MOVE "COMBINATIONS. " TO RE-MARK. NC1034.2 +050200 PERFORM PRINT-DETAIL. NC1034.2 +050300 MOVE SPACE TO TEST-RESULTS. NC1034.2 +050400 IF--INIT-GF-1. NC1034.2 +050500 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +050600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +050700 MOVE 0 TO IF-D1. NC1034.2 +050800 IF--TEST-GF-1. NC1034.2 +050900 IF ZERO IS EQUAL TO IF-D1 NC1034.2 +051000 PERFORM PASS NC1034.2 +051100 ELSE NC1034.2 +051200 PERFORM FAIL. NC1034.2 +051300 GO TO IF--WRITE-GF-1. NC1034.2 +051400 IF--DELETE-GF-1. NC1034.2 +051500 PERFORM DE-LETE. NC1034.2 +051600 IF--WRITE-GF-1. NC1034.2 +051700 MOVE "IF--TEST-GF-1 " TO PAR-NAME. NC1034.2 +051800 PERFORM PRINT-DETAIL. NC1034.2 +051900 IF--INIT-GF-2. NC1034.2 +052000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +052100 MOVE ZERO TO IF-D2. NC1034.2 +052200 IF--TEST-GF-2. NC1034.2 +052300 IF ZERO IS EQUAL TO IF-D2 NC1034.2 +052400 PERFORM PASS NC1034.2 +052500 ELSE NC1034.2 +052600 PERFORM FAIL. NC1034.2 +052700 GO TO IF--WRITE-GF-2. NC1034.2 +052800 IF--DELETE-GF-2. NC1034.2 +052900 PERFORM DE-LETE. NC1034.2 +053000 IF--WRITE-GF-2. NC1034.2 +053100 MOVE "IF--TEST-GF-2 " TO PAR-NAME. NC1034.2 +053200 PERFORM PRINT-DETAIL. NC1034.2 +053300 IF--INIT-GF-3. NC1034.2 +053400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +053500 MOVE "123" TO IF-D9. NC1034.2 +053600 IF--TEST-GF-3. NC1034.2 +053700 IF IF-D9 EQUAL TO 123 NC1034.2 +053800 PERFORM PASS NC1034.2 +053900 ELSE NC1034.2 +054000 PERFORM FAIL. NC1034.2 +054100 GO TO IF--WRITE-GF-3. NC1034.2 +054200 IF--DELETE-GF-3. NC1034.2 +054300 PERFORM DE-LETE. NC1034.2 +054400 IF--WRITE-GF-3. NC1034.2 +054500 MOVE "IF--TEST-GF-3 " TO PAR-NAME. NC1034.2 +054600 PERFORM PRINT-DETAIL. NC1034.2 +054700 IF--INIT-GF-4. NC1034.2 +054800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +054900 MOVE "012345678912" TO IF-D10. NC1034.2 +055000 IF--TEST-GF-4. NC1034.2 +055100 IF IF-D10 EQUAL TO 012345678912 NC1034.2 +055200 PERFORM PASS NC1034.2 +055300 ELSE NC1034.2 +055400 PERFORM FAIL. NC1034.2 +055500 GO TO IF--WRITE-GF-4. NC1034.2 +055600 IF--DELETE-GF-4. NC1034.2 +055700 PERFORM DE-LETE. NC1034.2 +055800 IF--WRITE-GF-4. NC1034.2 +055900 MOVE "IF--TEST-GF-4 " TO PAR-NAME. NC1034.2 +056000 PERFORM PRINT-DETAIL. NC1034.2 +056100 IF--INIT-GF-5. NC1034.2 +056200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +056300 MOVE "ABCDEF" TO IF-D11. NC1034.2 +056400 IF--TEST-GF-5. NC1034.2 +056500 IF IF-D11 EQUAL TO "ABCDEF" NC1034.2 +056600 PERFORM PASS NC1034.2 +056700 ELSE NC1034.2 +056800 PERFORM FAIL. NC1034.2 +056900 GO TO IF--WRITE-GF-5. NC1034.2 +057000 IF--DELETE-GF-5. NC1034.2 +057100 PERFORM DE-LETE. NC1034.2 +057200 IF--WRITE-GF-5. NC1034.2 +057300 MOVE "IF--TEST-GF-5 " TO PAR-NAME. NC1034.2 +057400 PERFORM PRINT-DETAIL. NC1034.2 +057500 IF--INIT-GF-6. NC1034.2 +057600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +057700 MOVE "ABCDEF" TO IF-D12. NC1034.2 +057800 IF--TEST-GF-6. NC1034.2 +057900 IF IF-D12 EQUAL TO "ABCDEF" NC1034.2 +058000 PERFORM PASS NC1034.2 +058100 ELSE NC1034.2 +058200 PERFORM FAIL. NC1034.2 +058300 GO TO IF--WRITE-GF-6. NC1034.2 +058400 IF--DELETE-GF-6. NC1034.2 +058500 PERFORM DE-LETE. NC1034.2 +058600 IF--WRITE-GF-6. NC1034.2 +058700 MOVE "IF--TEST-GF-6 " TO PAR-NAME. NC1034.2 +058800 PERFORM PRINT-DETAIL. NC1034.2 +058900 IF--INIT-GF-7. NC1034.2 +059000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +059100 MOVE +123.45 TO IF-D7. NC1034.2 +059200 IF--TEST-GF-7. NC1034.2 +059300 IF IF-D7 EQUAL TO +123.45 NC1034.2 +059400 PERFORM PASS NC1034.2 +059500 ELSE NC1034.2 +059600 PERFORM FAIL. NC1034.2 +059700 GO TO IF--WRITE-GF-7. NC1034.2 +059800 IF--DELETE-GF-7. NC1034.2 +059900 PERFORM DE-LETE. NC1034.2 +060000 IF--WRITE-GF-7. NC1034.2 +060100 MOVE "IF--TEST-GF-7 " TO PAR-NAME. NC1034.2 +060200 PERFORM PRINT-DETAIL. NC1034.2 +060300 IF--INIT-GF-8. NC1034.2 +060400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +060500 MOVE 12300 TO IF-D8. NC1034.2 +060600 IF--TEST-GF-8. NC1034.2 +060700 IF IF-D8 EQUAL TO 12300 NC1034.2 +060800 PERFORM PASS NC1034.2 +060900 ELSE NC1034.2 +061000 PERFORM FAIL. NC1034.2 +061100 GO TO IF--WRITE-GF-8. NC1034.2 +061200 IF--DELETE-GF-8. NC1034.2 +061300 PERFORM DE-LETE. NC1034.2 +061400 IF--WRITE-GF-8. NC1034.2 +061500 MOVE "IF--TEST-GF-8 " TO PAR-NAME. NC1034.2 +061600 PERFORM PRINT-DETAIL. NC1034.2 +061700 IF--INIT-GF-9. NC1034.2 +061800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +061900 MOVE 12300 TO IF-D8. NC1034.2 +062000 MOVE 12300 TO IF-D13. NC1034.2 +062100 IF--TEST-GF-9. NC1034.2 +062200 IF IF-D13 EQUAL TO IF-D8 NC1034.2 +062300 PERFORM PASS NC1034.2 +062400 ELSE NC1034.2 +062500 PERFORM FAIL. NC1034.2 +062600 GO TO IF--WRITE-GF-9. NC1034.2 +062700 IF--DELETE-GF-9. NC1034.2 +062800 PERFORM DE-LETE. NC1034.2 +062900 IF--WRITE-GF-9. NC1034.2 +063000 MOVE "IF--TEST-GF-9 " TO PAR-NAME. NC1034.2 +063100 PERFORM PRINT-DETAIL. NC1034.2 +063200 IF--INIT-GF-10. NC1034.2 +063300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +063400 MOVE .0012 TO IF-D16. NC1034.2 +063500 MOVE .0012 TO IF-D17. NC1034.2 +063600 IF--TEST-GF-10. NC1034.2 +063700 IF IF-D16 EQUAL TO IF-D17 NC1034.2 +063800 PERFORM PASS NC1034.2 +063900 ELSE NC1034.2 +064000 PERFORM FAIL. NC1034.2 +064100 GO TO IF--WRITE-GF-10. NC1034.2 +064200 IF--DELETE-GF-10. NC1034.2 +064300 PERFORM DE-LETE. NC1034.2 +064400 IF--WRITE-GF-10. NC1034.2 +064500 MOVE "IF--TEST-GF-10" TO PAR-NAME. NC1034.2 +064600 PERFORM PRINT-DETAIL. NC1034.2 +064700 IF--INIT-GF-11. NC1034.2 +064800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +064900 MOVE 2137.45 TO IF-D27. NC1034.2 +065000 MOVE 2137.45 TO IF-D28. NC1034.2 +065100 IF--TEST-GF-11. NC1034.2 +065200 IF IF-D27 EQUAL TO IF-D28 NC1034.2 +065300 PERFORM PASS ELSE PERFORM FAIL. NC1034.2 +065400 GO TO IF-WRITE-GF-11. NC1034.2 +065500 IF-DELETE-GF-11. NC1034.2 +065600 PERFORM DE-LETE. NC1034.2 +065700 IF-WRITE-GF-11. NC1034.2 +065800 MOVE "IF--TEST-GF-11" TO PAR-NAME. NC1034.2 +065900 PERFORM PRINT-DETAIL. NC1034.2 +066000 IF--INIT-GF-12. NC1034.2 +066100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +066200 MOVE +123.45 TO IF-D14. NC1034.2 +066300 MOVE +123.45 TO IF-D7. NC1034.2 +066400 IF--TEST-GF-12. NC1034.2 +066500 IF IF-D14 EQUAL TO IF-D7 NC1034.2 +066600 PERFORM PASS NC1034.2 +066700 ELSE NC1034.2 +066800 PERFORM FAIL. NC1034.2 +066900 GO TO IF--WRITE-GF-12. NC1034.2 +067000 IF--DELETE-GF-12. NC1034.2 +067100 PERFORM DE-LETE. NC1034.2 +067200 IF--WRITE-GF-12. NC1034.2 +067300 MOVE "IF--TEST-GF-12" TO PAR-NAME. NC1034.2 +067400 PERFORM PRINT-DETAIL. NC1034.2 +067500 IF--INIT-GF-13. NC1034.2 +067600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +067700 MOVE 12300 TO IF-D15. NC1034.2 +067800 MOVE 12300 TO IF-D8. NC1034.2 +067900 IF--TEST-GF-13. NC1034.2 +068000 IF IF-D15 EQUAL TO IF-D8 NC1034.2 +068100 PERFORM PASS NC1034.2 +068200 ELSE NC1034.2 +068300 PERFORM FAIL. NC1034.2 +068400 GO TO IF--WRITE-GF-13. NC1034.2 +068500 IF--DELETE-GF-13. NC1034.2 +068600 PERFORM DE-LETE. NC1034.2 +068700 IF--WRITE-GF-13. NC1034.2 +068800 MOVE "IF--TEST-GF-13" TO PAR-NAME. NC1034.2 +068900 PERFORM PRINT-DETAIL. NC1034.2 +069000 IF--INIT-GF-14. NC1034.2 +069100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +069200 MOVE 0000012345 TO IF-D20. NC1034.2 +069300 MOVE 0000012345 TO IF-D21. NC1034.2 +069400 IF--TEST-GF-14. NC1034.2 +069500 IF IF-D20 EQUAL TO IF-D21 NC1034.2 +069600 PERFORM PASS NC1034.2 +069700 ELSE NC1034.2 +069800 PERFORM FAIL. NC1034.2 +069900 GO TO IF--WRITE-GF-14. NC1034.2 +070000 IF--DELETE-GF-14. NC1034.2 +070100 PERFORM DE-LETE. NC1034.2 +070200 IF--WRITE-GF-14. NC1034.2 +070300 MOVE "IF--TEST-GF-14" TO PAR-NAME. NC1034.2 +070400 PERFORM PRINT-DETAIL. NC1034.2 +070500 IF--INIT-GF-15. NC1034.2 +070600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +070700 MOVE "$1,2 3.40+" TO IF-D24. NC1034.2 +070800 MOVE +123.4 TO IF-D23. NC1034.2 +070900 IF--TEST-GF-15. NC1034.2 +071000 IF IF-D23 EQUAL TO IF-D24 NC1034.2 +071100 PERFORM PASS NC1034.2 +071200 ELSE NC1034.2 +071300 PERFORM FAIL. NC1034.2 +071400 GO TO IF--WRITE-GF-15. NC1034.2 +071500 IF--DELETE-GF-15. NC1034.2 +071600 PERFORM DE-LETE. NC1034.2 +071700 IF--WRITE-GF-15. NC1034.2 +071800 MOVE "IF--TEST-GF-15" TO PAR-NAME. NC1034.2 +071900 PERFORM PRINT-DETAIL. NC1034.2 +072000 IF--INIT-GF-16. NC1034.2 +072100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +072200 MOVE "A C D0E" TO IF-D26. NC1034.2 +072300 MOVE "ACDE" TO IF-D25. NC1034.2 +072400 IF--TEST-GF-16. NC1034.2 +072500 IF IF-D25 EQUAL TO IF-D26 NC1034.2 +072600 PERFORM PASS NC1034.2 +072700 ELSE NC1034.2 +072800 PERFORM FAIL. NC1034.2 +072900 GO TO IF--WRITE-GF-16. NC1034.2 +073000 IF--DELETE-GF-16. NC1034.2 +073100 PERFORM DE-LETE. NC1034.2 +073200 IF--WRITE-GF-16. NC1034.2 +073300 MOVE "IF--TEST-GF-16" TO PAR-NAME. NC1034.2 +073400 PERFORM PRINT-DETAIL. NC1034.2 +073500 IF--INIT-GF-17. NC1034.2 +073600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +073700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +073800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +073900 IF--TEST-GF-17. NC1034.2 +074000 IF IF-D6 EQUAL TO IF-D18 NC1034.2 +074100 PERFORM PASS NC1034.2 +074200 ELSE NC1034.2 +074300 PERFORM FAIL. NC1034.2 +074400 GO TO IF--WRITE-GF-17. NC1034.2 +074500 IF--DELETE-GF-17. NC1034.2 +074600 PERFORM DE-LETE. NC1034.2 +074700 IF--WRITE-GF-17. NC1034.2 +074800 MOVE "IF--TEST-GF-17" TO PAR-NAME. NC1034.2 +074900 PERFORM PRINT-DETAIL. NC1034.2 +075000 IF--INIT-GF-18. NC1034.2 +075100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +075200 MOVE "ABCDEF" TO IF-D22. NC1034.2 +075300 MOVE "ABCDEF" TO IF-D12. NC1034.2 +075400 IF--TEST-GF-18. NC1034.2 +075500 IF IF-D22 EQUAL TO IF-D12 NC1034.2 +075600 PERFORM PASS NC1034.2 +075700 ELSE NC1034.2 +075800 PERFORM FAIL. NC1034.2 +075900 GO TO IF--WRITE-GF-18. NC1034.2 +076000 IF--DELETE-GF-18. NC1034.2 +076100 PERFORM DE-LETE. NC1034.2 +076200 IF--WRITE-GF-18. NC1034.2 +076300 MOVE "IF--TEST-GF-18" TO PAR-NAME. NC1034.2 +076400 PERFORM PRINT-DETAIL. NC1034.2 +076500 IF--INIT-GF-19. NC1034.2 +076600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +076700 MOVE "ABCDEF " TO IF-D39. NC1034.2 +076800 MOVE "ABCDEF " TO IF-D19. NC1034.2 +076900 IF--TEST-GF-19. NC1034.2 +077000 IF IF-D39 EQUAL TO IF-D19 NC1034.2 +077100 PERFORM PASS NC1034.2 +077200 ELSE NC1034.2 +077300 PERFORM FAIL. NC1034.2 +077400 GO TO IF--WRITE-GF-19. NC1034.2 +077500 IF--DELETE-GF-19. NC1034.2 +077600 PERFORM DE-LETE. NC1034.2 +077700 IF--WRITE-GF-19. NC1034.2 +077800 MOVE "IF--TEST-GF-19" TO PAR-NAME. NC1034.2 +077900 PERFORM PRINT-DETAIL. NC1034.2 +078000 IF--INIT-GF-20. NC1034.2 +078100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +078200 MOVE "COMPARE--GREATER" TO FEATURE. NC1034.2 +078300 MOVE 0 TO IF-D1. NC1034.2 +078400 IF--TEST-GF-20. NC1034.2 +078500 IF IF-D1 IS GREATER THAN ZERO NC1034.2 +078600 PERFORM FAIL NC1034.2 +078700 ELSE NC1034.2 +078800 PERFORM PASS. NC1034.2 +078900 GO TO IF--WRITE-GF-20. NC1034.2 +079000 IF--DELETE-GF-20. NC1034.2 +079100 PERFORM DE-LETE. NC1034.2 +079200 IF--WRITE-GF-20. NC1034.2 +079300 MOVE "IF--TEST-GF-20" TO PAR-NAME. NC1034.2 +079400 PERFORM PRINT-DETAIL. NC1034.2 +079500 IF--INIT-GF-21. NC1034.2 +079600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +079700 MOVE "123" TO IF-D9. NC1034.2 +079800 IF--TEST-GF-21. NC1034.2 +079900 IF IF-D9 GREATER THAN 123 NC1034.2 +080000 PERFORM FAIL NC1034.2 +080100 ELSE NC1034.2 +080200 PERFORM PASS. NC1034.2 +080300 GO TO IF--WRITE-GF-21. NC1034.2 +080400 IF--DELETE-GF-21. NC1034.2 +080500 PERFORM DE-LETE. NC1034.2 +080600 IF--WRITE-GF-21. NC1034.2 +080700 MOVE "IF--TEST-GF-21" TO PAR-NAME. NC1034.2 +080800 PERFORM PRINT-DETAIL. NC1034.2 +080900 IF--INIT-GF-22. NC1034.2 +081000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +081100 MOVE "012345678912" TO IF-D10. NC1034.2 +081200 IF--TEST-GF-22. NC1034.2 +081300 IF IF-D10 GREATER THAN 012345678912 NC1034.2 +081400 PERFORM FAIL NC1034.2 +081500 ELSE NC1034.2 +081600 PERFORM PASS. NC1034.2 +081700 GO TO IF--WRITE-GF-22. NC1034.2 +081800 IF--DELETE-GF-22. NC1034.2 +081900 PERFORM DE-LETE. NC1034.2 +082000 IF--WRITE-GF-22. NC1034.2 +082100 MOVE "IF--TEST-GF-22" TO PAR-NAME. NC1034.2 +082200 PERFORM PRINT-DETAIL. NC1034.2 +082300 IF--INIT-GF-23. NC1034.2 +082400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +082500 MOVE "ABCDEF" TO IF-D10. NC1034.2 +082600 IF--TEST-GF-23. NC1034.2 +082700 IF IF-D11 GREATER THAN "ABCDEF" NC1034.2 +082800 PERFORM FAIL NC1034.2 +082900 ELSE NC1034.2 +083000 PERFORM PASS. NC1034.2 +083100 GO TO IF--WRITE-GF-23. NC1034.2 +083200 IF--DELETE-GF-23. NC1034.2 +083300 PERFORM DE-LETE. NC1034.2 +083400 IF--WRITE-GF-23. NC1034.2 +083500 MOVE "IF--TEST-GF-23" TO PAR-NAME. NC1034.2 +083600 PERFORM PRINT-DETAIL. NC1034.2 +083700 IF--INIT-GF-24. NC1034.2 +083800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +083900 MOVE "ABCDEF" TO IF-D12. NC1034.2 +084000 IF--TEST-GF-24. NC1034.2 +084100 IF IF-D12 GREATER THAN "ABCDEF" NC1034.2 +084200 PERFORM FAIL NC1034.2 +084300 ELSE NC1034.2 +084400 PERFORM PASS. NC1034.2 +084500 GO TO IF--WRITE-GF-24. NC1034.2 +084600 IF--DELETE-GF-24. NC1034.2 +084700 PERFORM DE-LETE. NC1034.2 +084800 IF--WRITE-GF-24. NC1034.2 +084900 MOVE "IF--TEST-GF-24" TO PAR-NAME. NC1034.2 +085000 PERFORM PRINT-DETAIL. NC1034.2 +085100 IF--INIT-GF-25. NC1034.2 +085200 MOVE +123.45 TO IF-D7. NC1034.2 +085300 IF--TEST-GF-25. NC1034.2 +085400 IF IF-D7 GREATER THAN +123.45 NC1034.2 +085500 PERFORM FAIL NC1034.2 +085600 ELSE NC1034.2 +085700 PERFORM PASS. NC1034.2 +085800 GO TO IF--WRITE-GF-25. NC1034.2 +085900 IF--DELETE-GF-25. NC1034.2 +086000 PERFORM DE-LETE. NC1034.2 +086100 IF--WRITE-GF-25. NC1034.2 +086200 MOVE "IF--TEST-GF-25" TO PAR-NAME. NC1034.2 +086300 PERFORM PRINT-DETAIL. NC1034.2 +086400 IF--INIT-GF-26. NC1034.2 +086500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +086600 MOVE 12300 TO IF-D8. NC1034.2 +086700 IF--TEST-GF-26. NC1034.2 +086800 IF IF-D8 GREATER THAN 12300 NC1034.2 +086900 PERFORM FAIL NC1034.2 +087000 ELSE NC1034.2 +087100 PERFORM PASS. NC1034.2 +087200 GO TO IF--WRITE-GF-26. NC1034.2 +087300 IF--DELETE-GF-26. NC1034.2 +087400 PERFORM DE-LETE. NC1034.2 +087500 IF--WRITE-GF-26. NC1034.2 +087600 MOVE "IF--TEST-GF-26" TO PAR-NAME. NC1034.2 +087700 PERFORM PRINT-DETAIL. NC1034.2 +087800 IF--INIT-GF-27. NC1034.2 +087900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +088000 MOVE 12300 TO IF-D8. NC1034.2 +088100 MOVE 12300 TO IF-D13. NC1034.2 +088200 IF--TEST-GF-27. NC1034.2 +088300 IF IF-D13 GREATER THAN IF-D8 NC1034.2 +088400 PERFORM FAIL NC1034.2 +088500 ELSE NC1034.2 +088600 PERFORM PASS. NC1034.2 +088700 GO TO IF--WRITE-GF-27. NC1034.2 +088800 IF--DELETE-GF-27. NC1034.2 +088900 PERFORM DE-LETE. NC1034.2 +089000 IF--WRITE-GF-27. NC1034.2 +089100 MOVE "IF--TEST-GF-27" TO PAR-NAME. NC1034.2 +089200 PERFORM PRINT-DETAIL. NC1034.2 +089300 IF--INIT-GF-28. NC1034.2 +089400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +089500 MOVE .0012 TO IF-D16. NC1034.2 +089600 MOVE .0012 TO IF-D17. NC1034.2 +089700 IF--TEST-GF-28. NC1034.2 +089800 IF IF-D16 GREATER THAN IF-D17 NC1034.2 +089900 PERFORM FAIL NC1034.2 +090000 ELSE NC1034.2 +090100 PERFORM PASS. NC1034.2 +090200 GO TO IF--WRITE-GF-28. NC1034.2 +090300 IF--DELETE-GF-28. NC1034.2 +090400 PERFORM DE-LETE. NC1034.2 +090500 IF--WRITE-GF-28. NC1034.2 +090600 MOVE "IF--TEST-GF-28" TO PAR-NAME. NC1034.2 +090700 PERFORM PRINT-DETAIL. NC1034.2 +090800 IF--INIT-GF-29. NC1034.2 +090900 MOVE 2137.45 TO IF-D27. NC1034.2 +091000 MOVE 2137.45 TO IF-D28. NC1034.2 +091100 IF--TEST-GF-29. NC1034.2 +091200 IF IF-D27 GREATER THAN IF-D28 NC1034.2 +091300 PERFORM FAIL NC1034.2 +091400 ELSE NC1034.2 +091500 PERFORM PASS. NC1034.2 +091600 GO TO IF-WRITE-GF-29. NC1034.2 +091700 IF-DELETE-GF-29. NC1034.2 +091800 PERFORM DE-LETE. NC1034.2 +091900 IF-WRITE-GF-29. NC1034.2 +092000 MOVE "IF--TEST-GF-29" TO PAR-NAME. NC1034.2 +092100 PERFORM PRINT-DETAIL. NC1034.2 +092200 IF--INIT-GF-30. NC1034.2 +092300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +092400 MOVE +123.45 TO IF-D7. NC1034.2 +092500 MOVE +123.45 TO IF-D14. NC1034.2 +092600 IF--TEST-GF-30. NC1034.2 +092700 IF IF-D14 GREATER THAN IF-D7 NC1034.2 +092800 PERFORM FAIL NC1034.2 +092900 ELSE NC1034.2 +093000 PERFORM PASS. NC1034.2 +093100 GO TO IF--WRITE-GF-30. NC1034.2 +093200 IF--DELETE-GF-30. NC1034.2 +093300 PERFORM DE-LETE. NC1034.2 +093400 IF--WRITE-GF-30. NC1034.2 +093500 MOVE "IF--TEST-GF-30" TO PAR-NAME. NC1034.2 +093600 PERFORM PRINT-DETAIL. NC1034.2 +093700 IF--INIT-GF-31. NC1034.2 +093800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +093900 MOVE 12300 TO IF-D8. NC1034.2 +094000 MOVE 12300 TO IF-D15. NC1034.2 +094100 IF--TEST-GF-31. NC1034.2 +094200 IF IF-D15 GREATER THAN IF-D8 NC1034.2 +094300 PERFORM FAIL NC1034.2 +094400 ELSE NC1034.2 +094500 PERFORM PASS. NC1034.2 +094600 GO TO IF--WRITE-GF-31. NC1034.2 +094700 IF--DELETE-GF-31. NC1034.2 +094800 PERFORM DE-LETE. NC1034.2 +094900 IF--WRITE-GF-31. NC1034.2 +095000 MOVE "IF--TEST-GF-31" TO PAR-NAME. NC1034.2 +095100 PERFORM PRINT-DETAIL. NC1034.2 +095200 IF--INIT-GF-32. NC1034.2 +095300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +095400 MOVE 0000012345 TO IF-D20. NC1034.2 +095500 MOVE 0000012345 TO IF-D21. NC1034.2 +095600 IF--TEST-GF-32. NC1034.2 +095700 IF IF-D20 GREATER THAN IF-D21 NC1034.2 +095800 PERFORM FAIL NC1034.2 +095900 ELSE NC1034.2 +096000 PERFORM PASS. NC1034.2 +096100 GO TO IF--WRITE-GF-32. NC1034.2 +096200 IF--DELETE-GF-32. NC1034.2 +096300 PERFORM DE-LETE. NC1034.2 +096400 IF--WRITE-GF-32. NC1034.2 +096500 MOVE "IF--TEST-GF-32" TO PAR-NAME. NC1034.2 +096600 PERFORM PRINT-DETAIL. NC1034.2 +096700 IF--INIT-GF-33. NC1034.2 +096800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +096900 MOVE "A C D0E" TO IF-D26. NC1034.2 +097000 MOVE "ABCD" TO IF-D25. NC1034.2 +097100 IF--TEST-GF-33. NC1034.2 +097200 IF IF-D26 GREATER THAN IF-D25 NC1034.2 +097300 PERFORM PASS NC1034.2 +097400 ELSE NC1034.2 +097500 PERFORM FAIL. NC1034.2 +097600 GO TO IF--WRITE-GF-33. NC1034.2 +097700 IF--DELETE-GF-33. NC1034.2 +097800 PERFORM DE-LETE. NC1034.2 +097900 IF--WRITE-GF-33. NC1034.2 +098000 MOVE "IF--TEST-GF-33" TO PAR-NAME. NC1034.2 +098100 PERFORM PRINT-DETAIL. NC1034.2 +098200 IF--INIT-GF-34. NC1034.2 +098300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +098400 MOVE "A C D0E" TO IF-D26. NC1034.2 +098500 MOVE "ABCD" TO IF-D25. NC1034.2 +098600 IF--TEST-GF-34. NC1034.2 +098700 IF IF-D25 GREATER THAN IF-D26 NC1034.2 +098800 PERFORM FAIL NC1034.2 +098900 ELSE NC1034.2 +099000 PERFORM PASS. NC1034.2 +099100 GO TO IF--WRITE-GF-34. NC1034.2 +099200 IF--DELETE-GF-34. NC1034.2 +099300 PERFORM DE-LETE. NC1034.2 +099400 IF--WRITE-GF-34. NC1034.2 +099500 MOVE "IF--TEST-GF-34" TO PAR-NAME. NC1034.2 +099600 PERFORM PRINT-DETAIL. NC1034.2 +099700 IF--INIT-GF-35. NC1034.2 +099800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +099900 MOVE "BABABABABA" TO IF-D6. NC1034.2 +100000 MOVE "BABABABABA" TO IF-D18. NC1034.2 +100100 IF--TEST-GF-35. NC1034.2 +100200 IF IF-D6 GREATER THAN IF-D18 NC1034.2 +100300 PERFORM FAIL NC1034.2 +100400 ELSE NC1034.2 +100500 PERFORM PASS. NC1034.2 +100600 GO TO IF--WRITE-GF-35. NC1034.2 +100700 IF--DELETE-GF-35. NC1034.2 +100800 PERFORM DE-LETE. NC1034.2 +100900 IF--WRITE-GF-35. NC1034.2 +101000 MOVE "IF--TEST-GF-35" TO PAR-NAME. NC1034.2 +101100 PERFORM PRINT-DETAIL. NC1034.2 +101200 IF--INIT-GF-36. NC1034.2 +101300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +101400 MOVE "ABCDEF" TO IF-D12. NC1034.2 +101500 MOVE "ABCDEF" TO IF-D22. NC1034.2 +101600 IF--TEST-GF-36. NC1034.2 +101700 IF IF-D22 GREATER THAN IF-D12 NC1034.2 +101800 PERFORM FAIL NC1034.2 +101900 ELSE NC1034.2 +102000 PERFORM PASS. NC1034.2 +102100 GO TO IF--WRITE-GF-36. NC1034.2 +102200 IF--DELETE-GF-36. NC1034.2 +102300 PERFORM DE-LETE. NC1034.2 +102400 IF--WRITE-GF-36. NC1034.2 +102500 MOVE "IF--TEST-GF-36" TO PAR-NAME. NC1034.2 +102600 PERFORM PRINT-DETAIL. NC1034.2 +102700 IF--INIT-GF-37. NC1034.2 +102800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +102900 MOVE "COMPARE--LESS THAN" TO FEATURE. NC1034.2 +103000 MOVE +123.45 TO IF-D7. NC1034.2 +103100 IF--TEST-GF-37. NC1034.2 +103200 IF IF-D7 IS LESS THAN 123.45 NC1034.2 +103300 PERFORM FAIL NC1034.2 +103400 ELSE NC1034.2 +103500 PERFORM PASS. NC1034.2 +103600 GO TO IF--WRITE-GF-37. NC1034.2 +103700 IF--DELETE-GF-37. NC1034.2 +103800 PERFORM DE-LETE. NC1034.2 +103900 IF--WRITE-GF-37. NC1034.2 +104000 MOVE "IF--TEST-GF-37" TO PAR-NAME. NC1034.2 +104100 PERFORM PRINT-DETAIL. NC1034.2 +104200 IF--INIT-GF-38. NC1034.2 +104300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +104400 MOVE "ABCDEF" TO IF-D11. NC1034.2 +104500 IF--TEST-GF-38. NC1034.2 +104600 IF IF-D11 LESS THAN "ABCDEF" NC1034.2 +104700 PERFORM FAIL NC1034.2 +104800 ELSE NC1034.2 +104900 PERFORM PASS. NC1034.2 +105000 GO TO IF--WRITE-GF-38. NC1034.2 +105100 IF--DELETE-GF-38. NC1034.2 +105200 PERFORM DE-LETE. NC1034.2 +105300 IF--WRITE-GF-38. NC1034.2 +105400 MOVE "IF--TEST-GF-38" TO PAR-NAME. NC1034.2 +105500 PERFORM PRINT-DETAIL. NC1034.2 +105600 IF--INIT-GF-39. NC1034.2 +105700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +105800 MOVE "BABABABABA" TO IF-D6. NC1034.2 +105900 MOVE "BABABABABA" TO IF-D18. NC1034.2 +106000 IF--TEST-GF-39. NC1034.2 +106100 IF IF-D6 LESS THAN IF-D18 NC1034.2 +106200 PERFORM FAIL NC1034.2 +106300 ELSE NC1034.2 +106400 PERFORM PASS. NC1034.2 +106500 GO TO IF--WRITE-GF-39. NC1034.2 +106600 IF--DELETE-GF-39. NC1034.2 +106700 PERFORM DE-LETE. NC1034.2 +106800 IF--WRITE-GF-39. NC1034.2 +106900 MOVE "IF--TEST-GF-39" TO PAR-NAME. NC1034.2 +107000 PERFORM PRINT-DETAIL. NC1034.2 +107100 IF--INIT-GF-40. NC1034.2 +107200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +107300 MOVE 0000012345 TO IF-D20. NC1034.2 +107400 MOVE 0000012345 TO IF-D21. NC1034.2 +107500 IF--TEST-GF-40. NC1034.2 +107600 IF IF-D20 LESS THAN IF-D21 NC1034.2 +107700 PERFORM FAIL NC1034.2 +107800 ELSE NC1034.2 +107900 PERFORM PASS. NC1034.2 +108000 GO TO IF--WRITE-GF-40. NC1034.2 +108100 IF--DELETE-GF-40. NC1034.2 +108200 PERFORM DE-LETE. NC1034.2 +108300 IF--WRITE-GF-40. NC1034.2 +108400 MOVE "IF--TEST-GF-40" TO PAR-NAME. NC1034.2 +108500 PERFORM PRINT-DETAIL. NC1034.2 +108600 IF--INIT-D. NC1034.2 +108700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +108800 MOVE "COMPARE--NOT EQUAL" TO FEATURE. NC1034.2 +108900 MOVE +123.45 TO IF-D7. NC1034.2 +109000 IF--TEST-GF-41. NC1034.2 +109100 IF IF-D7 IS NOT EQUAL TO 23.45 NC1034.2 +109200 PERFORM PASS NC1034.2 +109300 ELSE NC1034.2 +109400 PERFORM FAIL. NC1034.2 +109500 GO TO IF--WRITE-GF-41. NC1034.2 +109600 IF--DELETE-GF-41. NC1034.2 +109700 PERFORM DE-LETE. NC1034.2 +109800 IF--WRITE-GF-41. NC1034.2 +109900 MOVE "IF--TEST-GF-41" TO PAR-NAME. NC1034.2 +110000 PERFORM PRINT-DETAIL. NC1034.2 +110100 IF--INIT-GF-42. NC1034.2 +110200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +110300 MOVE "ABCDEF" TO IF-D11. NC1034.2 +110400 IF--TEST-GF-42. NC1034.2 +110500 IF IF-D11 NOT EQUAL TO "ABCDE " NC1034.2 +110600 PERFORM PASS NC1034.2 +110700 ELSE NC1034.2 +110800 PERFORM FAIL. NC1034.2 +110900 GO TO IF--WRITE-GF-42. NC1034.2 +111000 IF--DELETE-GF-42. NC1034.2 +111100 PERFORM DE-LETE. NC1034.2 +111200 IF--WRITE-GF-42. NC1034.2 +111300 MOVE "IF--TEST-GF-42" TO PAR-NAME. NC1034.2 +111400 PERFORM PRINT-DETAIL. NC1034.2 +111500 IF--INIT-GF-43. NC1034.2 +111600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +111700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +111800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +111900 IF--TEST-GF-43. NC1034.2 +112000 IF IF-D6 NOT EQUAL TO IF-D18 NC1034.2 +112100 PERFORM FAIL NC1034.2 +112200 ELSE NC1034.2 +112300 PERFORM PASS. NC1034.2 +112400 GO TO IF--WRITE-GF-43. NC1034.2 +112500 IF--DELETE-GF-43. NC1034.2 +112600 PERFORM DE-LETE. NC1034.2 +112700 IF--WRITE-GF-43. NC1034.2 +112800 MOVE "IF--TEST-GF-43" TO PAR-NAME. NC1034.2 +112900 PERFORM PRINT-DETAIL. NC1034.2 +113000 IF--INIT-GF-44. NC1034.2 +113100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +113200 MOVE 0000012345 TO IF-D20. NC1034.2 +113300 MOVE 0000012345 TO IF-D21. NC1034.2 +113400 IF--TEST-GF-44. NC1034.2 +113500 IF IF-D20 NOT EQUAL TO IF-D21 NC1034.2 +113600 PERFORM FAIL NC1034.2 +113700 ELSE NC1034.2 +113800 PERFORM PASS. NC1034.2 +113900 GO TO IF--WRITE-GF-44. NC1034.2 +114000 IF--DELETE-GF-44. NC1034.2 +114100 PERFORM DE-LETE. NC1034.2 +114200 IF--WRITE-GF-44. NC1034.2 +114300 MOVE "IF--TEST-GF-44" TO PAR-NAME. NC1034.2 +114400 PERFORM PRINT-DETAIL. NC1034.2 +114500 IF--INIT-GF-45. NC1034.2 +114600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +114700 MOVE "COMPARE--NOT LESS" TO FEATURE. NC1034.2 +114800 MOVE +123.45 TO IF-D7. NC1034.2 +114900 IF--TEST-GF-45. NC1034.2 +115000 IF IF-D7 IS NOT LESS THAN 123.45 NC1034.2 +115100 PERFORM PASS NC1034.2 +115200 ELSE NC1034.2 +115300 PERFORM FAIL. NC1034.2 +115400 GO TO IF--WRITE-GF-45. NC1034.2 +115500 IF--DELETE-GF-45. NC1034.2 +115600 PERFORM DE-LETE. NC1034.2 +115700 IF--WRITE-GF-45. NC1034.2 +115800 MOVE "IF--TEST-GF-45" TO PAR-NAME. NC1034.2 +115900 PERFORM PRINT-DETAIL. NC1034.2 +116000 IF--INIT-GF-46. NC1034.2 +116100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +116200 MOVE "ABCDEF" TO IF-D11. NC1034.2 +116300 IF--TEST-GF-46. NC1034.2 +116400 IF IF-D11 IS NOT LESS THAN "ABCDEF" NC1034.2 +116500 PERFORM PASS NC1034.2 +116600 ELSE NC1034.2 +116700 PERFORM FAIL. NC1034.2 +116800 GO TO IF--WRITE-GF-46. NC1034.2 +116900 IF--DELETE-GF-46. NC1034.2 +117000 PERFORM DE-LETE. NC1034.2 +117100 IF--WRITE-GF-46. NC1034.2 +117200 MOVE "IF--TEST-GF-46" TO PAR-NAME. NC1034.2 +117300 PERFORM PRINT-DETAIL. NC1034.2 +117400 IF--INIT-GF-47. NC1034.2 +117500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +117600 MOVE "BABABABABA" TO IF-D6. NC1034.2 +117700 MOVE "BABABABABA" TO IF-D18. NC1034.2 +117800 IF--TEST-GF-47. NC1034.2 +117900 IF IF-D6 IS NOT LESS THAN IF-D18 NC1034.2 +118000 PERFORM PASS NC1034.2 +118100 ELSE NC1034.2 +118200 PERFORM FAIL. NC1034.2 +118300 GO TO IF--WRITE-GF-47. NC1034.2 +118400 IF--DELETE-GF-47. NC1034.2 +118500 PERFORM DE-LETE. NC1034.2 +118600 IF--WRITE-GF-47. NC1034.2 +118700 MOVE "IF--TEST-GF-47" TO PAR-NAME. NC1034.2 +118800 PERFORM PRINT-DETAIL. NC1034.2 +118900 IF--INIT-GF-48. NC1034.2 +119000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +119100 MOVE 0000012345 TO IF-D20. NC1034.2 +119200 MOVE 0000012345 TO IF-D21. NC1034.2 +119300 IF--TEST-GF-48. NC1034.2 +119400 IF IF-D20 NOT LESS THAN IF-D21 NC1034.2 +119500 PERFORM PASS NC1034.2 +119600 ELSE NC1034.2 +119700 PERFORM FAIL. NC1034.2 +119800 GO TO IF--WRITE-GF-48. NC1034.2 +119900 IF--DELETE-GF-48. NC1034.2 +120000 PERFORM DE-LETE. NC1034.2 +120100 IF--WRITE-GF-48. NC1034.2 +120200 MOVE "IF--TEST-GF-48" TO PAR-NAME. NC1034.2 +120300 PERFORM PRINT-DETAIL. NC1034.2 +120400 IF--INIT-GF-49. NC1034.2 +120500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +120600 MOVE "COMPARE--NOT GREATER" TO FEATURE. NC1034.2 +120700 MOVE +123.45 TO IF-D7. NC1034.2 +120800 IF--TEST-GF-49. NC1034.2 +120900 IF IF-D7 NOT GREATER THAN 123.45 NC1034.2 +121000 PERFORM PASS NC1034.2 +121100 ELSE NC1034.2 +121200 PERFORM FAIL. NC1034.2 +121300 GO TO IF--WRITE-GF-49. NC1034.2 +121400 IF--DELETE-GF-49. NC1034.2 +121500 PERFORM DE-LETE. NC1034.2 +121600 IF--WRITE-GF-49. NC1034.2 +121700 MOVE "IF--TEST-GF-49" TO PAR-NAME. NC1034.2 +121800 PERFORM PRINT-DETAIL. NC1034.2 +121900 IF--INIT-GF-50. NC1034.2 +122000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +122100 MOVE "ABCDEF" TO IF-D11. NC1034.2 +122200 IF--TEST-GF-50. NC1034.2 +122300 IF IF-D11 IS NOT GREATER THAN "ABCD " NC1034.2 +122400 PERFORM FAIL NC1034.2 +122500 ELSE NC1034.2 +122600 PERFORM PASS. NC1034.2 +122700* THIS TEST ASSUMES THAT BLANK PRECEDES THE LETTERS OF NC1034.2 +122800* THE ALPHABET IN THE COLLATING SEQUENCE. NC1034.2 +122900 GO TO IF--WRITE-GF-50. NC1034.2 +123000 IF--DELETE-GF-50. NC1034.2 +123100 PERFORM DE-LETE. NC1034.2 +123200 IF--WRITE-GF-50. NC1034.2 +123300 MOVE "IF--TEST-GF-50" TO PAR-NAME. NC1034.2 +123400 PERFORM PRINT-DETAIL. NC1034.2 +123500 IF--INIT-GF-51. NC1034.2 +123600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +123700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +123800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +123900 IF--TEST-GF-51. NC1034.2 +124000 IF IF-D6 NOT GREATER THAN IF-D18 NC1034.2 +124100 PERFORM PASS NC1034.2 +124200 ELSE NC1034.2 +124300 PERFORM FAIL. NC1034.2 +124400 GO TO IF--WRITE-GF-51. NC1034.2 +124500 IF--DELETE-GF-51. NC1034.2 +124600 PERFORM DE-LETE. NC1034.2 +124700 IF--WRITE-GF-51. NC1034.2 +124800 MOVE "IF--TEST-GF-51" TO PAR-NAME. NC1034.2 +124900 PERFORM PRINT-DETAIL. NC1034.2 +125000 IF--INIT-GF-52. NC1034.2 +125100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +125200 MOVE "ABCDEF" TO IF-D11. NC1034.2 +125300 MOVE "ABCDEF" TO IF-D12. NC1034.2 +125400 IF--TEST-GF-52. NC1034.2 +125500 IF IF-D12 NOT GREATER THAN IF-D11 NC1034.2 +125600 PERFORM PASS NC1034.2 +125700 ELSE NC1034.2 +125800 PERFORM FAIL. NC1034.2 +125900 GO TO IF--WRITE-GF-52. NC1034.2 +126000 IF--DELETE-GF-52. NC1034.2 +126100 PERFORM DE-LETE. NC1034.2 +126200 IF--WRITE-GF-52. NC1034.2 +126300 MOVE "IF--TEST-GF-52" TO PAR-NAME. NC1034.2 +126400 PERFORM PRINT-DETAIL. NC1034.2 +126500 IF--INIT-GF-53. NC1034.2 +126600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +126700 MOVE "COMPARE--HIGH LOW " TO FEATURE. NC1034.2 +126800 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +126900 IF--TEST-GF-53. NC1034.2 +127000 IF HIGH-VALUE NOT GREATER THAN LOW-VAL NC1034.2 +127100 PERFORM FAIL NC1034.2 +127200 ELSE NC1034.2 +127300 PERFORM PASS. NC1034.2 +127400 GO TO IF--WRITE-GF-53. NC1034.2 +127500 IF--DELETE-GF-53. NC1034.2 +127600 PERFORM DE-LETE. NC1034.2 +127700 IF--WRITE-GF-53. NC1034.2 +127800 MOVE "IF--TEST-GF-53" TO PAR-NAME. NC1034.2 +127900 PERFORM PRINT-DETAIL. NC1034.2 +128000 IF--INIT-GF-54. NC1034.2 +128100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +128200 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +128300 IF--TEST-GF-54. NC1034.2 +128400 IF LOW-VAL LESS THAN HIGH-VALUE NC1034.2 +128500 PERFORM PASS NC1034.2 +128600 ELSE NC1034.2 +128700 PERFORM FAIL. NC1034.2 +128800 GO TO IF--WRITE-GF-54. NC1034.2 +128900 IF--DELETE-GF-54. NC1034.2 +129000 PERFORM DE-LETE. NC1034.2 +129100 IF--WRITE-GF-54. NC1034.2 +129200 MOVE "IF--TEST-GF-54" TO PAR-NAME. NC1034.2 +129300 PERFORM PRINT-DETAIL. NC1034.2 +129400 IF--INIT-GF-55. NC1034.2 +129500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +129600 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +129700 MOVE 1 TO ZERO-01. NC1034.2 +129800 IF--TEST-GF-55. NC1034.2 +129900 IF ZERO-01 GREATER THAN LOW-VALUE NC1034.2 +130000 PERFORM PASS NC1034.2 +130100 ELSE NC1034.2 +130200 PERFORM FAIL. NC1034.2 +130300 GO TO IF--WRITE-GF-55. NC1034.2 +130400 IF--DELETE-GF-55. NC1034.2 +130500 PERFORM DE-LETE. NC1034.2 +130600 IF--WRITE-GF-55. NC1034.2 +130700 MOVE "IF--TEST-GF-55" TO PAR-NAME. NC1034.2 +130800 PERFORM PRINT-DETAIL. NC1034.2 +130900 IF--INIT-GF-56. NC1034.2 +131000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +131100 MOVE "ABC" TO ABC. NC1034.2 +131200 IF--TEST-GF-56. NC1034.2 +131300 IF ABC GREATER THAN HIGH-VALUE NC1034.2 +131400 PERFORM FAIL NC1034.2 +131500 ELSE NC1034.2 +131600 PERFORM PASS. NC1034.2 +131700 GO TO IF--WRITE-GF-56. NC1034.2 +131800 IF--DELETE-GF-56. NC1034.2 +131900 PERFORM DE-LETE. NC1034.2 +132000 IF--WRITE-GF-56. NC1034.2 +132100 MOVE "IF--TEST-GF-56" TO PAR-NAME. NC1034.2 +132200 PERFORM PRINT-DETAIL. NC1034.2 +132300 IF--INIT-GF-57. NC1034.2 +132400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +132500 MOVE 999999999999999998 TO NINE-17-8. NC1034.2 +132600 IF--TEST-GF-57. NC1034.2 +132700 IF NINE-17-8 LESS THAN HIGH-VALUE NC1034.2 +132800 PERFORM PASS NC1034.2 +132900 ELSE NC1034.2 +133000 PERFORM FAIL. NC1034.2 +133100 GO TO IF--WRITE-GF-57. NC1034.2 +133200 IF--DELETE-GF-57. NC1034.2 +133300 PERFORM DE-LETE. NC1034.2 +133400 IF--WRITE-GF-57. NC1034.2 +133500 MOVE "IF--TEST-GF-57" TO PAR-NAME. NC1034.2 +133600 PERFORM PRINT-DETAIL. NC1034.2 +133700 IF--INIT-GF-58. NC1034.2 +133800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +133900 MOVE 0 TO ZERO-NULL. NC1034.2 +134000 IF--TEST-GF-58. NC1034.2 +134100 IF ZERO-NULL NOT EQUAL TO HIGH-VALUE NC1034.2 +134200 PERFORM PASS NC1034.2 +134300 ELSE NC1034.2 +134400 PERFORM FAIL. NC1034.2 +134500 GO TO IF--WRITE-GF-58. NC1034.2 +134600 IF--DELETE-GF-58. NC1034.2 +134700 PERFORM DE-LETE. NC1034.2 +134800 IF--WRITE-GF-58. NC1034.2 +134900 MOVE "IF--TEST-GF-58" TO PAR-NAME. NC1034.2 +135000 PERFORM PRINT-DETAIL. NC1034.2 +135100 IF--INIT-GF-59. NC1034.2 +135200 MOVE "ABC" TO ABC. NC1034.2 +135300 IF--TEST-GF-59. NC1034.2 +135400 IF ABC LESS THAN LOW-VALUE NC1034.2 +135500 PERFORM FAIL NC1034.2 +135600 GO TO IF--WRITE-GF-59. NC1034.2 +135700 PERFORM PASS. NC1034.2 +135800 GO TO IF--WRITE-GF-59. NC1034.2 +135900 IF--DELETE-GF-59. NC1034.2 +136000 PERFORM DE-LETE. NC1034.2 +136100 IF--WRITE-GF-59. NC1034.2 +136200 MOVE "IF--TEST-GF-59" TO PAR-NAME. NC1034.2 +136300 PERFORM PRINT-DETAIL. NC1034.2 +136400 IF--INIT-GF-60. NC1034.2 +136500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +136600 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +136700 MOVE 0 TO IF-D32. NC1034.2 +136800 MOVE -0 TO IF-D33. NC1034.2 +136900 IF--TEST-GF-60. NC1034.2 +137000 IF IF-D32 EQUAL TO IF-D33 NC1034.2 +137100 PERFORM PASS NC1034.2 +137200 ELSE NC1034.2 +137300 PERFORM FAIL. NC1034.2 +137400 GO TO IF--WRITE-GF-60. NC1034.2 +137500 IF--DELETE-GF-60. NC1034.2 +137600 PERFORM DE-LETE. NC1034.2 +137700 IF--WRITE-GF-60. NC1034.2 +137800 MOVE "IF--TEST-GF-60" TO PAR-NAME. NC1034.2 +137900 PERFORM PRINT-DETAIL. NC1034.2 +138000 IF--INIT-GF-61. NC1034.2 +138100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +138200 MOVE 0 TO IF-D32. NC1034.2 +138300 MOVE +0 TO IF-D34. NC1034.2 +138400 IF--TEST-GF-61. NC1034.2 +138500 IF IF-D32 EQUAL TO IF-D34 NC1034.2 +138600 PERFORM PASS NC1034.2 +138700 ELSE NC1034.2 +138800 PERFORM FAIL. NC1034.2 +138900 GO TO IF--WRITE-GF-61. NC1034.2 +139000 IF--DELETE-GF-61. NC1034.2 +139100 PERFORM DE-LETE. NC1034.2 +139200 IF--WRITE-GF-61. NC1034.2 +139300 MOVE "IF--TEST-GF-61" TO PAR-NAME. NC1034.2 +139400 PERFORM PRINT-DETAIL. NC1034.2 +139500 IF--INIT-GF-62. NC1034.2 +139600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +139700 MOVE -0 TO IF-D33. NC1034.2 +139800 MOVE +0 TO IF-D34. NC1034.2 +139900 IF--TEST-GF-62. NC1034.2 +140000 IF IF-D33 EQUAL TO IF-D34 NC1034.2 +140100 PERFORM PASS NC1034.2 +140200 ELSE NC1034.2 +140300 PERFORM FAIL. NC1034.2 +140400 GO TO IF--WRITE-GF-62. NC1034.2 +140500 IF--DELETE-GF-62. NC1034.2 +140600 PERFORM DE-LETE. NC1034.2 +140700 IF--WRITE-GF-62. NC1034.2 +140800 MOVE "IF--TEST-GF-62" TO PAR-NAME. NC1034.2 +140900 PERFORM PRINT-DETAIL. NC1034.2 +141000 IF--INIT-GF-63. NC1034.2 +141100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +141200 MOVE ZERO TO AZERO-DS-05V05. NC1034.2 +141300 IF--TEST-GF-63. NC1034.2 +141400 IF AZERO-DS-05V05 EQUAL TO ZERO NC1034.2 +141500 PERFORM PASS NC1034.2 +141600 GO TO IF-WRITE-GF-63. NC1034.2 +141700 GO TO IF-FAIL-GF-63. NC1034.2 +141800 IF-DELETE-GF-63. NC1034.2 +141900 PERFORM DE-LETE. NC1034.2 +142000 GO TO IF-WRITE-GF-63. NC1034.2 +142100 IF-FAIL-GF-63. NC1034.2 +142200 MOVE 00000.00000 TO CORRECT-N. NC1034.2 +142300 MOVE AZERO-DS-05V05 TO COMPUTED-N. NC1034.2 +142400 PERFORM FAIL. NC1034.2 +142500 IF-WRITE-GF-63. NC1034.2 +142600 MOVE "IF--TEST-GF-63 " TO PAR-NAME. NC1034.2 +142700 PERFORM PRINT-DETAIL. NC1034.2 +142800 IF--INIT-GF-64. NC1034.2 +142900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +143000 MOVE SPACE TO CORRECT-A. NC1034.2 +143100 IF--TEST-GF-64. NC1034.2 +143200 IF SPACE EQUAL TO CORRECT-A NC1034.2 +143300 PERFORM PASS NC1034.2 +143400 GO TO IF-WRITE-GF-64. NC1034.2 +143500 GO TO IF-FAIL-GF-64. NC1034.2 +143600 IF-DELETE-GF-64. NC1034.2 +143700 PERFORM DE-LETE. NC1034.2 +143800 GO TO IF-WRITE-GF-64. NC1034.2 +143900 IF-FAIL-GF-64. NC1034.2 +144000 MOVE CORRECT-A TO COMPUTED-A. NC1034.2 +144100 MOVE SPACE TO CORRECT-A. NC1034.2 +144200 PERFORM FAIL. NC1034.2 +144300 IF-WRITE-GF-64. NC1034.2 +144400 MOVE "IF--TEST-GF-64 " TO PAR-NAME. NC1034.2 +144500 PERFORM PRINT-DETAIL. NC1034.2 +144600 IF--INIT-GF-65. NC1034.2 +144700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +144800 MOVE 111111111111111111 TO A18ONES-DS-18V00. NC1034.2 +144900 MOVE "111111111111111111" TO ONES-XN-00018. NC1034.2 +145000 IF--TEST-GF-65. NC1034.2 +145100 IF A18ONES-DS-18V00 EQUAL TO ONES-XN-00018 NC1034.2 +145200 PERFORM PASS NC1034.2 +145300 GO TO IF-WRITE-GF-65. NC1034.2 +145400 GO TO IF-FAIL-GF-65. NC1034.2 +145500 IF-DELETE-GF-65. NC1034.2 +145600 PERFORM DE-LETE. NC1034.2 +145700 GO TO IF-WRITE-GF-65. NC1034.2 +145800 IF-FAIL-GF-65. NC1034.2 +145900 MOVE ONES-XN-00018 TO CORRECT-A. NC1034.2 +146000 MOVE A18ONES-DS-18V00 TO COMPUTED-A. NC1034.2 +146100 MOVE "FIELDS DIDNT COMPARE EQUAL" TO RE-MARK NC1034.2 +146200 PERFORM FAIL. NC1034.2 +146300 IF-WRITE-GF-65. NC1034.2 +146400 MOVE "IF--TEST-GF-65 " TO PAR-NAME. NC1034.2 +146500 PERFORM PRINT-DETAIL. NC1034.2 +146600 IF--INIT-GF-66. NC1034.2 +146700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +146800 MOVE 22 TO TWOS-XN-00002. NC1034.2 +146900 MOVE 99 TO A99-DS-02V00. NC1034.2 +147000 IF--TEST-GF-66. NC1034.2 +147100 IF TWOS-XN-00002 IS EQUAL TO A99-DS-02V00 NC1034.2 +147200 MOVE TWOS-XN-00002 TO COMPUTED-A NC1034.2 +147300 MOVE A99-DS-02V00 TO CORRECT-A NC1034.2 +147400 PERFORM FAIL NC1034.2 +147500 GO TO IF-WRITE-GF-66. NC1034.2 +147600 PERFORM PASS. NC1034.2 +147700 GO TO IF-WRITE-GF-66. NC1034.2 +147800 IF-DELETE-GF-66. NC1034.2 +147900 PERFORM DE-LETE. NC1034.2 +148000 IF-WRITE-GF-66. NC1034.2 +148100 MOVE "IF--TEST-GF-66 " TO PAR-NAME. NC1034.2 +148200 PERFORM PRINT-DETAIL. NC1034.2 +148300 IF--INIT-GF-67. NC1034.2 +148400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +148500 MOVE "COMPARE--LESS THAN " TO FEATURE. NC1034.2 +148600 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1034.2 +148700 MOVE 99 TO A99-DS-02V00. NC1034.2 +148800 IF--TEST-GF-67. NC1034.2 +148900 IF A99-DS-02V00 LESS THAN A18ONES-DS-09V09 NC1034.2 +149000 PERFORM PASS NC1034.2 +149100 GO TO IF-WRITE-GF-67 ELSE NC1034.2 +149200 GO TO IF-FAIL-GF-67. NC1034.2 +149300 IF-DELETE-GF-67. NC1034.2 +149400 PERFORM DE-LETE. NC1034.2 +149500 GO TO IF-WRITE-GF-67. NC1034.2 +149600 IF-FAIL-GF-67. NC1034.2 +149700 MOVE A99-DS-02V00 TO CORRECT-A. NC1034.2 +149800 MOVE A18ONES-DS-09V09 TO COMPUTED-N. NC1034.2 +149900 PERFORM FAIL. NC1034.2 +150000 IF-WRITE-GF-67. NC1034.2 +150100 MOVE "IF--TEST-GF-67 " TO PAR-NAME. NC1034.2 +150200 PERFORM PRINT-DETAIL. NC1034.2 +150300 IF--INIT-GF-68. NC1034.2 +150400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +150500 MOVE "11" TO ONES-XN-00002. NC1034.2 +150600 IF--TEST-GF-68. NC1034.2 +150700 IF "11" LESS THAN ONES-XN-00002 NC1034.2 +150800 MOVE "11" TO CORRECT-A NC1034.2 +150900 MOVE ONES-XN-00002 TO COMPUTED-A NC1034.2 +151000 PERFORM FAIL NC1034.2 +151100 GO TO IF-WRITE-GF-68 ELSE NC1034.2 +151200 PERFORM PASS NC1034.2 +151300 GO TO IF-WRITE-GF-68. NC1034.2 +151400 IF-DELETE-GF-68. NC1034.2 +151500 PERFORM DE-LETE. NC1034.2 +151600 IF-WRITE-GF-68. NC1034.2 +151700 MOVE "IF--TEST-GF-68 " TO PAR-NAME. NC1034.2 +151800 PERFORM PRINT-DETAIL. NC1034.2 +151900 IF--INIT-GF-69. NC1034.2 +152000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +152100 MOVE "11" TO ONES-XN-00002. NC1034.2 +152200 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +152300 IF--TEST-GF-69. NC1034.2 +152400 IF A02TWOS-DU-02V00 LESS THAN ONES-XN-00002 NC1034.2 +152500 MOVE ONES-XN-00002 TO CORRECT-A NC1034.2 +152600 MOVE A02TWOS-DU-02V00 TO COMPUTED-A NC1034.2 +152700 PERFORM FAIL NC1034.2 +152800 GO TO IF-WRITE-GF-69 ELSE NC1034.2 +152900 PERFORM PASS NC1034.2 +153000 GO TO IF-WRITE-GF-69. NC1034.2 +153100 IF-DELETE-GF-69. NC1034.2 +153200 PERFORM DE-LETE. NC1034.2 +153300 IF-WRITE-GF-69. NC1034.2 +153400 MOVE "IF--TEST-GF-69 " TO PAR-NAME. NC1034.2 +153500 PERFORM PRINT-DETAIL. NC1034.2 +153600 IF--INIT-GF-70. NC1034.2 +153700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +153800 MOVE "22" TO TWOS-XN-00002. NC1034.2 +153900 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +154000 IF--TEST-GF-70. NC1034.2 +154100 IF TWOS-XN-00002 LESS THAN A02TWOS-DU-02V00 NC1034.2 +154200 MOVE TWOS-XN-00002 TO CORRECT-A NC1034.2 +154300 MOVE A02TWOS-DU-02V00 TO COMPUTED-A NC1034.2 +154400 PERFORM FAIL NC1034.2 +154500 GO TO IF-WRITE-GF-70 ELSE NC1034.2 +154600 PERFORM PASS NC1034.2 +154700 GO TO IF-WRITE-GF-70. NC1034.2 +154800 IF-DELETE-GF-70. NC1034.2 +154900 PERFORM DE-LETE. NC1034.2 +155000 IF-WRITE-GF-70. NC1034.2 +155100 MOVE "IF--TEST-70 " TO PAR-NAME. NC1034.2 +155200 PERFORM PRINT-DETAIL. NC1034.2 +155300 IF--INIT-GF-71. NC1034.2 +155400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +155500 MOVE "COMPARE--GREATER " TO FEATURE. NC1034.2 +155600 MOVE 99 TO A99-DS-02V00. NC1034.2 +155700 IF--TEST-GF-71. NC1034.2 +155800 IF A99-DS-02V00 GREATER THAN 88.9 NEXT SENTENCE ELSE NC1034.2 +155900 MOVE A99-DS-02V00 TO CORRECT-A NC1034.2 +156000 MOVE "88.9" TO COMPUTED-A NC1034.2 +156100 PERFORM FAIL NC1034.2 +156200 GO TO IF-WRITE-GF-71. NC1034.2 +156300 PERFORM PASS. NC1034.2 +156400 GO TO IF-WRITE-GF-71. NC1034.2 +156500 IF-DELETE-GF-71. NC1034.2 +156600 PERFORM DE-LETE. NC1034.2 +156700 IF-WRITE-GF-71. NC1034.2 +156800 MOVE "IF--TEST-GF-71 " TO PAR-NAME. NC1034.2 +156900 PERFORM PRINT-DETAIL. NC1034.2 +157000 IF--INIT-GF-72. NC1034.2 +157100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +157200 MOVE "11" TO ONES-XN-00002. NC1034.2 +157300 MOVE "22" TO TWOS-XN-00002. NC1034.2 +157400 IF--TEST-GF-72. NC1034.2 +157500 IF ONES-XN-00002 GREATER THAN TWOS-XN-00002 NEXT SENTENCE NC1034.2 +157600 ELSE PERFORM PASS NC1034.2 +157700 GO TO IF-WRITE-GF-72. NC1034.2 +157800 MOVE ONES-XN-00002 TO COMPUTED-A. NC1034.2 +157900 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +158000 PERFORM FAIL. NC1034.2 +158100 GO TO IF-WRITE-GF-72. NC1034.2 +158200 IF-DELETE-GF-72. NC1034.2 +158300 PERFORM DE-LETE. NC1034.2 +158400 IF-WRITE-GF-72. NC1034.2 +158500 MOVE "IF--TEST-GF-72 " TO PAR-NAME. NC1034.2 +158600 PERFORM PRINT-DETAIL. NC1034.2 +158700 IF--INIT-GF-73. NC1034.2 +158800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +158900 MOVE "11" TO ONES-XN-00002. NC1034.2 +159000 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +159100 IF--TEST-GF-73. NC1034.2 +159200 IF A02TWOS-DU-02V00 GREATER THAN ONES-XN-00002 NC1034.2 +159300 NEXT SENTENCE ELSE NC1034.2 +159400 MOVE A02TWOS-DU-02V00 TO CORRECT-A NC1034.2 +159500 MOVE ONES-XN-00002 TO COMPUTED-A NC1034.2 +159600 PERFORM FAIL NC1034.2 +159700 GO TO IF-WRITE-GF-73. NC1034.2 +159800 PERFORM PASS. NC1034.2 +159900 GO TO IF-WRITE-GF-73. NC1034.2 +160000 IF-DELETE-GF-73. NC1034.2 +160100 PERFORM DE-LETE. NC1034.2 +160200 IF-WRITE-GF-73. NC1034.2 +160300 MOVE "IF--TEST-GF-73 " TO PAR-NAME. NC1034.2 +160400 PERFORM PRINT-DETAIL. NC1034.2 +160500 IF--INIT-GF-74. NC1034.2 +160600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +160700 MOVE "22" TO TWOS-XN-00002. NC1034.2 +160800 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +160900 IF--TEST-GF-74. NC1034.2 +161000 IF TWOS-XN-00002 GREATER THAN A02TWOS-DU-02V00 NC1034.2 +161100 NEXT SENTENCE ELSE NC1034.2 +161200 PERFORM PASS NC1034.2 +161300 GO TO IF-WRITE-GF-74. NC1034.2 +161400 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +161500 MOVE A02TWOS-DU-02V00 TO COMPUTED-A. NC1034.2 +161600 PERFORM FAIL. NC1034.2 +161700 GO TO IF-WRITE-GF-74. NC1034.2 +161800 IF-DELETE-GF-74. NC1034.2 +161900 PERFORM DE-LETE. NC1034.2 +162000 IF-WRITE-GF-74. NC1034.2 +162100 MOVE "IF--TEST-GF-74 " TO PAR-NAME. NC1034.2 +162200 PERFORM PRINT-DETAIL. NC1034.2 +162300 IF--INIT-GF-75. NC1034.2 +162400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +162500 MOVE "COMPARE--NOT EQUAL " TO FEATURE. NC1034.2 +162600 MOVE SPACE TO CORRECT-A. NC1034.2 +162700 IF--TEST-GF-75. NC1034.2 +162800 IF ZERO IS NOT EQUAL TO CORRECT-A NC1034.2 +162900 PERFORM PASS NC1034.2 +163000 GO TO IF-WRITE-GF-75. NC1034.2 +163100 MOVE ZERO TO COMPUTED-A. NC1034.2 +163200 PERFORM FAIL. NC1034.2 +163300 GO TO IF-WRITE-GF-75. NC1034.2 +163400 IF-DELETE-GF-75. NC1034.2 +163500 PERFORM DE-LETE. NC1034.2 +163600 IF-WRITE-GF-75. NC1034.2 +163700 MOVE "IF--TEST-75 " TO PAR-NAME. NC1034.2 +163800 PERFORM PRINT-DETAIL. NC1034.2 +163900 IF--INIT-GF-76. NC1034.2 +164000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +164100 MOVE +022.00 TO A02TWOS-DS-03V02. NC1034.2 +164200 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +164300 IF--TEST-GF-76. NC1034.2 +164400 IF A02TWOS-DU-02V00 NOT EQUAL TO A02TWOS-DS-03V02 NC1034.2 +164500 MOVE A02TWOS-DU-02V00 TO CORRECT-N NC1034.2 +164600 MOVE A02TWOS-DS-03V02 TO COMPUTED-N NC1034.2 +164700 PERFORM FAIL NC1034.2 +164800 GO TO IF-WRITE-GF-76 ELSE NEXT SENTENCE. NC1034.2 +164900 PERFORM PASS NC1034.2 +165000 GO TO IF-WRITE-GF-76. NC1034.2 +165100 IF-DELETE-GF-76. NC1034.2 +165200 PERFORM DE-LETE. NC1034.2 +165300 IF-WRITE-GF-76. NC1034.2 +165400 MOVE "IF--TEST-GF-76 " TO PAR-NAME. NC1034.2 +165500 PERFORM PRINT-DETAIL. NC1034.2 +165600 IF--INIT-GF-77. NC1034.2 +165700 MOVE "COMPARE--NOT LESS " TO FEATURE. NC1034.2 +165800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +165900 MOVE "22" TO TWOS-XN-00002. NC1034.2 +166000 MOVE "11" TO ONES-XN-00002. NC1034.2 +166100 IF--TEST-GF-77. NC1034.2 +166200 IF TWOS-XN-00002 NOT LESS THAN ONES-XN-00002 NC1034.2 +166300 PERFORM PASS NC1034.2 +166400 GO TO IF-WRITE-GF-77 ELSE NEXT SENTENCE. NC1034.2 +166500 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +166600 MOVE ONES-XN-00002 TO COMPUTED-A. NC1034.2 +166700 PERFORM FAIL. NC1034.2 +166800 GO TO IF-WRITE-GF-77. NC1034.2 +166900 IF-DELETE-GF-77. NC1034.2 +167000 PERFORM DE-LETE. NC1034.2 +167100 IF-WRITE-GF-77. NC1034.2 +167200 MOVE "IF--TEST-GF-77 " TO PAR-NAME. NC1034.2 +167300 PERFORM PRINT-DETAIL. NC1034.2 +167400 IF--INIT-GF-78. NC1034.2 +167500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +167600 MOVE .000000001 TO A01ONE-DS-P0801. NC1034.2 +167700 IF--TEST-GF-78. NC1034.2 +167800 IF 0.0000000001 IS NOT LESS THAN A01ONE-DS-P0801 NC1034.2 +167900 MOVE "0.0000000001" TO CORRECT-A NC1034.2 +168000 MOVE A01ONE-DS-P0801 TO COMPUTED-N NC1034.2 +168100 PERFORM FAIL NC1034.2 +168200 GO TO IF-WRITE-GF-78 ELSE NC1034.2 +168300 PERFORM PASS NC1034.2 +168400 GO TO IF-WRITE-GF-78. NC1034.2 +168500 IF-DELETE-GF-78. NC1034.2 +168600 PERFORM DE-LETE. NC1034.2 +168700 IF-WRITE-GF-78. NC1034.2 +168800 MOVE "IF--TEST-GF-78 " TO PAR-NAME. NC1034.2 +168900 PERFORM PRINT-DETAIL. NC1034.2 +169000 IF--INIT-GF-79. NC1034.2 +169100 MOVE "COMPARE--NOT GREATER" TO FEATURE. NC1034.2 +169200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +169300 MOVE "11" TO ONES-XN-00002. NC1034.2 +169400 MOVE "22" TO TWOS-XN-00002. NC1034.2 +169500 IF--TEST-GF-79. NC1034.2 +169600 IF ONES-XN-00002 NOT GREATER THAN TWOS-XN-00002 NC1034.2 +169700 PERFORM PASS NC1034.2 +169800 GO TO IF-WRITE-GF-79. NC1034.2 +169900 MOVE ONES-XN-00002 TO CORRECT-A. NC1034.2 +170000 MOVE TWOS-XN-00002 TO COMPUTED-A. NC1034.2 +170100 PERFORM FAIL. NC1034.2 +170200 GO TO IF-WRITE-GF-79. NC1034.2 +170300 IF-DELETE-GF-79. NC1034.2 +170400 PERFORM DE-LETE. NC1034.2 +170500 IF-WRITE-GF-79. NC1034.2 +170600 MOVE "IF--TEST-GF-79 " TO PAR-NAME. NC1034.2 +170700 PERFORM PRINT-DETAIL. NC1034.2 +170800 IF--INIT-GF-80. NC1034.2 +170900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +171000 MOVE +990 TO A990-DS-0201P. NC1034.2 +171100 MOVE 99 TO A99-DS-02V00. NC1034.2 +171200 IF--TEST-GF-80. NC1034.2 +171300 IF A990-DS-0201P NOT GREATER THAN A99-DS-02V00 NC1034.2 +171400 MOVE A990-DS-0201P TO COMPUTED-N NC1034.2 +171500 MOVE A99-DS-02V00 TO CORRECT-N NC1034.2 +171600 PERFORM FAIL NC1034.2 +171700 GO TO IF-WRITE-GF-80. NC1034.2 +171800 PERFORM PASS. NC1034.2 +171900 GO TO IF-WRITE-GF-80. NC1034.2 +172000 IF-DELETE-GF-80. NC1034.2 +172100 PERFORM DE-LETE. NC1034.2 +172200 IF-WRITE-GF-80. NC1034.2 +172300 MOVE "IF--TEST-GF-80 " TO PAR-NAME. NC1034.2 +172400 PERFORM PRINT-DETAIL. NC1034.2 +172500 IF--INIT-GF-81. NC1034.2 +172600 MOVE "COMPARE--GROUP VALUE" TO FEATURE. NC1034.2 +172700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +172800 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +172900 IF--TEST-GF-81. NC1034.2 +173000 IF IF-D36A EQUAL TO "*ASTER" NC1034.2 +173100 PERFORM PASS GO TO IF--WRITE-GF-81. NC1034.2 +173200 GO TO IF--FAIL-GF-81. NC1034.2 +173300 IF--DELETE-GF-81. NC1034.2 +173400 PERFORM DE-LETE. NC1034.2 +173500 GO TO IF--WRITE-GF-81. NC1034.2 +173600 IF--FAIL-GF-81. NC1034.2 +173700 PERFORM FAIL. NC1034.2 +173800 MOVE IF-D36A TO COMPUTED-A. NC1034.2 +173900 MOVE "*ASTER" TO CORRECT-A. NC1034.2 +174000 IF--WRITE-GF-81. NC1034.2 +174100 MOVE "IF--TEST-GF-81" TO PAR-NAME. NC1034.2 +174200 PERFORM PRINT-DETAIL. NC1034.2 +174300 IF--INIT-GF-82. NC1034.2 +174400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +174500 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +174600 IF--TEST-GF-82. NC1034.2 +174700 IF IF-D36B EQUAL TO "ISK" NC1034.2 +174800 PERFORM PASS GO TO IF--WRITE-GF-82. NC1034.2 +174900 GO TO IF--FAIL-GF-82. NC1034.2 +175000 IF--DELETE-GF-82. NC1034.2 +175100 PERFORM DE-LETE. NC1034.2 +175200 GO TO IF--WRITE-GF-82. NC1034.2 +175300 IF--FAIL-GF-82. NC1034.2 +175400 PERFORM FAIL. NC1034.2 +175500 MOVE IF-D36B TO COMPUTED-A. NC1034.2 +175600 MOVE "ISK" TO CORRECT-A. NC1034.2 +175700 IF--WRITE-GF-82. NC1034.2 +175800 MOVE "IF--TEST-GF-82" TO PAR-NAME. NC1034.2 +175900 PERFORM PRINT-DETAIL. NC1034.2 +176000 IF--INIT-GF-83. NC1034.2 +176100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +176200 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +176300 IF--TEST-GF-83. NC1034.2 +176400 IF IF-D36C EQUAL TO "/SLASH" NC1034.2 +176500 PERFORM PASS GO TO IF--WRITE-GF-83. NC1034.2 +176600 GO TO IF--FAIL-GF-83. NC1034.2 +176700 IF--DELETE-GF-83. NC1034.2 +176800 PERFORM DE-LETE. NC1034.2 +176900 GO TO IF--WRITE-GF-83. NC1034.2 +177000 IF--FAIL-GF-83. NC1034.2 +177100 PERFORM FAIL. NC1034.2 +177200 MOVE IF-D36C TO COMPUTED-A. NC1034.2 +177300 MOVE "/SLASH" TO CORRECT-A. NC1034.2 +177400 IF--WRITE-GF-83. NC1034.2 +177500 MOVE "IF--TEST-GF-83" TO PAR-NAME. NC1034.2 +177600 PERFORM PRINT-DETAIL. NC1034.2 +177700 IF--INIT-GF-84. NC1034.2 +177800 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +177900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +178000 MOVE 0001234 TO IF-D37. NC1034.2 +178100 IF--TEST-GF-84. NC1034.2 +178200 IF IF-D37 EQUAL TO 01234 NC1034.2 +178300 PERFORM PASS GO TO IF--WRITE-GF-84. NC1034.2 +178400 GO TO IF--FAIL-GF-84. NC1034.2 +178500 IF--DELETE-GF-84. NC1034.2 +178600 PERFORM DE-LETE. NC1034.2 +178700 GO TO IF--WRITE-GF-84. NC1034.2 +178800 IF--FAIL-GF-84. NC1034.2 +178900 PERFORM FAIL. NC1034.2 +179000 MOVE IF-D37 TO COMPUTED-N. NC1034.2 +179100 MOVE 01234 TO CORRECT-N. NC1034.2 +179200 IF--WRITE-GF-84. NC1034.2 +179300 MOVE "IF--TEST-GF-84" TO PAR-NAME. NC1034.2 +179400 PERFORM PRINT-DETAIL. NC1034.2 +179500 IF--INIT-GF-85. NC1034.2 +179600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +179700 MOVE " BABBAGE" TO IF-D38. NC1034.2 +179800 IF--TEST-GF-85. NC1034.2 +179900 IF IF-D38 EQUAL TO " BABBAGE " NC1034.2 +180000 PERFORM PASS GO TO IF--WRITE-GF-85. NC1034.2 +180100 GO TO IF--FAIL-GF-85. NC1034.2 +180200 IF--DELETE-GF-85. NC1034.2 +180300 PERFORM DE-LETE. NC1034.2 +180400 GO TO IF--WRITE-GF-85. NC1034.2 +180500 IF--FAIL-GF-85. NC1034.2 +180600 PERFORM FAIL. NC1034.2 +180700 MOVE IF-D38 TO COMPUTED-A. NC1034.2 +180800 MOVE " BABBAGE " TO CORRECT-A. NC1034.2 +180900 IF--WRITE-GF-85. NC1034.2 +181000 MOVE "IF--TEST-GF-85" TO PAR-NAME. NC1034.2 +181100 PERFORM PRINT-DETAIL. NC1034.2 +181200 IF--INIT-GF-86. NC1034.2 +181300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +181400 MOVE NC1034.2 +181500 XXXXX081 NC1034.2 +181600 TO NON-COBOL-CHARACTERS. NC1034.2 +181700 IF--TEST-GF-86. NC1034.2 +181800 IF NON-COBOL-CHARACTERS EQUAL TO NC1034.2 +181900 XXXXX081 NC1034.2 +182000 PERFORM PASS GO TO IF--WRITE-GF-86. NC1034.2 +182100 GO TO IF--FAIL-GF-86. NC1034.2 +182200 IF--DELETE-GF-86. NC1034.2 +182300 PERFORM DE-LETE. NC1034.2 +182400 GO TO IF--WRITE-GF-86. NC1034.2 +182500 IF--FAIL-GF-86. NC1034.2 +182600 PERFORM FAIL. NC1034.2 +182700 MOVE NON-COBOL-CHARACTERS TO COMPUTED-A. NC1034.2 +182800 MOVE NC1034.2 +182900 XXXXX081 NC1034.2 +183000 TO CORRECT-A. NC1034.2 +183100 IF--WRITE-GF-86. NC1034.2 +183200 MOVE "IF--TEST-GF-86" TO PAR-NAME. NC1034.2 +183300 MOVE "NON COBOL CHARACTERS" TO RE-MARK. NC1034.2 +183400 PERFORM PRINT-DETAIL. NC1034.2 +183500 IF--INIT-GF-87. NC1034.2 +183600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +183700 MOVE 100000 TO COMP-DATA2. NC1034.2 +183800 MOVE 100000 TO COMP-DATA9. NC1034.2 +183900 IF--TEST-GF-87. NC1034.2 +184000 IF COMP-DATA2 EQUAL TO COMP-DATA9 NC1034.2 +184100 PERFORM PASS NC1034.2 +184200 GO TO IF--WRITE-GF-87. NC1034.2 +184300 MOVE COMP-DATA2 TO COMPUTED-18V0. NC1034.2 +184400 MOVE COMP-DATA9 TO CORRECT-18V0. NC1034.2 +184500 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +184600 PERFORM FAIL. NC1034.2 +184700 GO TO IF--WRITE-GF-87. NC1034.2 +184800 IF--DELETE-GF-87. NC1034.2 +184900 PERFORM DE-LETE. NC1034.2 +185000 IF--WRITE-GF-87. NC1034.2 +185100 MOVE "IF--TEST-GF-87" TO PAR-NAME. NC1034.2 +185200 PERFORM PRINT-DETAIL. NC1034.2 +185300 IF--INIT-GF-88. NC1034.2 +185400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +185500 MOVE 300 TO COMP-DATA1. NC1034.2 +185600 MOVE 300.00 TO COMP-DATA7. NC1034.2 +185700 IF--TEST-GF-88. NC1034.2 +185800 IF COMP-DATA1 EQUAL TO COMP-DATA7 NC1034.2 +185900 PERFORM PASS NC1034.2 +186000 GO TO IF--WRITE-GF-88. NC1034.2 +186100 MOVE COMP-DATA1 TO COMPUTED-18V0. NC1034.2 +186200 MOVE COMP-DATA7 TO CORRECT-N. NC1034.2 +186300 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +186400 PERFORM FAIL. NC1034.2 +186500 GO TO IF--WRITE-GF-88. NC1034.2 +186600 IF--DELETE-GF-88. NC1034.2 +186700 PERFORM DE-LETE. NC1034.2 +186800 IF--WRITE-GF-88. NC1034.2 +186900 MOVE "IF--TEST-GF-88" TO PAR-NAME. NC1034.2 +187000 PERFORM PRINT-DETAIL. NC1034.2 +187100 IF--INIT-GF-89. NC1034.2 +187200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +187300 MOVE 300 TO COMP-DATA1. NC1034.2 +187400 MOVE 300 TO DISP-DATA1. NC1034.2 +187500 IF--TEST-GF-89. NC1034.2 +187600 IF COMP-DATA1 EQUAL TO DISP-DATA1 NC1034.2 +187700 PERFORM PASS NC1034.2 +187800 GO TO IF--WRITE-GF-89. NC1034.2 +187900 MOVE COMP-DATA1 TO COMPUTED-18V0. NC1034.2 +188000 MOVE DISP-DATA1 TO CORRECT-18V0. NC1034.2 +188100 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +188200 PERFORM FAIL. NC1034.2 +188300 GO TO IF--WRITE-GF-89. NC1034.2 +188400 IF--DELETE-GF-89. NC1034.2 +188500 PERFORM DE-LETE. NC1034.2 +188600 IF--WRITE-GF-89. NC1034.2 +188700 MOVE "IF--TEST-GF-89" TO PAR-NAME. NC1034.2 +188800 PERFORM PRINT-DETAIL. NC1034.2 +188900 IF--INIT-GF-90. NC1034.2 +189000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +189100 MOVE 100000 TO COMP-DATA1. NC1034.2 +189200 MOVE 100000 TO DISP-DATA1. NC1034.2 +189300 IF--TEST-GF-90. NC1034.2 +189400 IF COMP-DATA2 EQUAL TO DISP-DATA2 NC1034.2 +189500 PERFORM PASS NC1034.2 +189600 GO TO IF--WRITE-GF-90. NC1034.2 +189700 MOVE COMP-DATA2 TO COMPUTED-N. NC1034.2 +189800 MOVE DISP-DATA2 TO CORRECT-N. NC1034.2 +189900 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +190000 PERFORM FAIL. NC1034.2 +190100 GO TO IF--WRITE-GF-90. NC1034.2 +190200 IF--DELETE-GF-90. NC1034.2 +190300 PERFORM DE-LETE. NC1034.2 +190400 IF--WRITE-GF-90. NC1034.2 +190500 MOVE "IF--TEST-GF-90" TO PAR-NAME. NC1034.2 +190600 PERFORM PRINT-DETAIL. NC1034.2 +190700 IF--INIT-GF-91. NC1034.2 +190800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +190900 MOVE 9 TO COMP-DATA3. NC1034.2 +191000 MOVE 9 TO DISP-DATA3. NC1034.2 +191100 IF--TEST-GF-91. NC1034.2 +191200 IF COMP-DATA3 EQUAL TO DISP-DATA3 NC1034.2 +191300 PERFORM PASS NC1034.2 +191400 GO TO IF--WRITE-GF-91. NC1034.2 +191500 MOVE COMP-DATA3 TO COMPUTED-N. NC1034.2 +191600 MOVE DISP-DATA3 TO CORRECT-N. NC1034.2 +191700 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +191800 PERFORM FAIL. NC1034.2 +191900 GO TO IF--WRITE-GF-91. NC1034.2 +192000 IF--DELETE-GF-91. NC1034.2 +192100 PERFORM DE-LETE. NC1034.2 +192200 IF--WRITE-GF-91. NC1034.2 +192300 MOVE "IF--TEST-GF-91" TO PAR-NAME. NC1034.2 +192400 PERFORM PRINT-DETAIL. NC1034.2 +192500 IF--INIT-GF-92. NC1034.2 +192600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +192700 MOVE 300.00 TO COMP-DATA7. NC1034.2 +192800 MOVE 300 TO DISP-DATA1. NC1034.2 +192900 IF--TEST-GF-92. NC1034.2 +193000 IF COMP-DATA7 EQUAL TO DISP-DATA1 NC1034.2 +193100 PERFORM PASS NC1034.2 +193200 GO TO IF--WRITE-GF-92. NC1034.2 +193300 MOVE COMP-DATA7 TO COMPUTED-N. NC1034.2 +193400 MOVE DISP-DATA1 TO CORRECT-N. NC1034.2 +193500 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +193600 PERFORM FAIL. NC1034.2 +193700 GO TO IF--WRITE-GF-92. NC1034.2 +193800 IF--DELETE-GF-92. NC1034.2 +193900 PERFORM DE-LETE. NC1034.2 +194000 IF--WRITE-GF-92. NC1034.2 +194100 MOVE "IF--TEST-GF-92" TO PAR-NAME. NC1034.2 +194200 PERFORM PRINT-DETAIL. NC1034.2 +194300 IF--INIT-GF-93. NC1034.2 +194400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +194500 MOVE 3.3 TO COMP-DATA4. NC1034.2 +194600 MOVE 3.3000000 TO COMP-DATA8. NC1034.2 +194700 IF--TEST-GF-93. NC1034.2 +194800 IF COMP-DATA4 EQUAL TO COMP-DATA8 NC1034.2 +194900 PERFORM PASS NC1034.2 +195000 GO TO IF--WRITE-GF-93. NC1034.2 +195100 MOVE COMP-DATA4 TO COMPUTED-N. NC1034.2 +195200 MOVE COMP-DATA8 TO CORRECT-N. NC1034.2 +195300 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +195400 PERFORM FAIL. NC1034.2 +195500 GO TO IF--WRITE-GF-93. NC1034.2 +195600 IF--DELETE-GF-93. NC1034.2 +195700 PERFORM DE-LETE. NC1034.2 +195800 IF--WRITE-GF-93. NC1034.2 +195900 MOVE "IF--TEST-GF-93" TO PAR-NAME. NC1034.2 +196000 PERFORM PRINT-DETAIL. NC1034.2 +196100 IF--INIT-GF-94. NC1034.2 +196200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +196300 MOVE 300 TO COMP-DATA7. NC1034.2 +196400 MOVE 300 TO DISP-DATA1. NC1034.2 +196500 IF--TEST-GF-94. NC1034.2 +196600 IF COMP-DATA7 EQUAL TO DISP-DATA1 NC1034.2 +196700 PERFORM PASS NC1034.2 +196800 GO TO IF--WRITE-GF-94. NC1034.2 +196900 MOVE COMP-DATA7 TO COMPUTED-N. NC1034.2 +197000 MOVE DISP-DATA1 TO CORRECT-N. NC1034.2 +197100 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +197200 PERFORM FAIL. NC1034.2 +197300 GO TO IF--WRITE-GF-94. NC1034.2 +197400 IF--DELETE-GF-94. NC1034.2 +197500 PERFORM DE-LETE. NC1034.2 +197600 IF--WRITE-GF-94. NC1034.2 +197700 MOVE "IF--TEST-GF-94" TO PAR-NAME. NC1034.2 +197800 PERFORM PRINT-DETAIL. NC1034.2 +197900 IF--INIT-GF-95. NC1034.2 +198000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +198100 MOVE 3.3000000 TO COMP-DATA8. NC1034.2 +198200 MOVE 3.3 TO DISP-DATA4. NC1034.2 +198300 IF--TEST-GF-95. NC1034.2 +198400 IF DISP-DATA4 EQUAL TO COMP-DATA8 NC1034.2 +198500 PERFORM PASS NC1034.2 +198600 GO TO IF--WRITE-GF-95. NC1034.2 +198700 MOVE DISP-DATA4 TO COMPUTED-N. NC1034.2 +198800 MOVE COMP-DATA8 TO CORRECT-N. NC1034.2 +198900 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +199000 PERFORM FAIL. NC1034.2 +199100 GO TO IF--WRITE-GF-95. NC1034.2 +199200 IF--DELETE-GF-95. NC1034.2 +199300 PERFORM DE-LETE. NC1034.2 +199400 IF--WRITE-GF-95. NC1034.2 +199500 MOVE "IF--TEST-GF-95" TO PAR-NAME. NC1034.2 +199600 PERFORM PRINT-DETAIL. NC1034.2 +199700 MOVE "COMPARE GROUP-LEVEL " TO FEATURE. NC1034.2 +199800 IF--INIT-GF-96. NC1034.2 +199900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +200000 MOVE ZEROS TO GROUP-1000-1. NC1034.2 +200100 MOVE QUOTES TO XNAME. NC1034.2 +200200 MOVE SPACES TO GROUP-1000-2. NC1034.2 +200300 MOVE "." TO GROUP-1000-3. NC1034.2 +200400 MOVE ZEROS TO GROUP-X500-A. NC1034.2 +200500 MOVE QUOTES TO GROUP-X500-1-1. NC1034.2 +200600 MOVE QUOTES TO GROUP-X500-1-2. NC1034.2 +200700 MOVE SPACES TO GROUP-X500-1-3. NC1034.2 +200800 MOVE " ." TO GROUP-X500-1-4. NC1034.2 +200900 IF--TEST-GF-96. NC1034.2 +201000 IF GROUP-X1000 EQUAL TO GROUP-X500-2 NC1034.2 +201100 PERFORM PASS NC1034.2 +201200 GO TO IF--WRITE-GF-96. NC1034.2 +201300 MOVE "GROUP LEVEL X(1000) " TO COMPUTED-A. NC1034.2 +201400 MOVE "GROUP LEVEL X(1000) " TO CORRECT-A. NC1034.2 +201500 MOVE "FIELDS DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +201600 PERFORM FAIL. NC1034.2 +201700 GO TO IF--WRITE-GF-96. NC1034.2 +201800 IF--DELETE-GF-96. NC1034.2 +201900 PERFORM DE-LETE. NC1034.2 +202000 IF--WRITE-GF-96. NC1034.2 +202100 MOVE "IF--TEST-GF-96" TO PAR-NAME. NC1034.2 +202200 PERFORM PRINT-DETAIL. NC1034.2 +202300 IF--INIT-GF-97. NC1034.2 +202400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +202500 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +202600 MOVE ZERO TO VAL. NC1034.2 +202700 IF--TEST-GF-97. NC1034.2 +202800 IF A02TWOS-DU-02V00 LESS THAN "AA" NC1034.2 +202900 ADD 1 TO VAL. NC1034.2 +203000 IF A02TWOS-DU-02V00 GREATER THAN "AA" NC1034.2 +203100 ADD 1 TO VAL. NC1034.2 +203200 IF VAL EQUAL TO 1 NC1034.2 +203300 PERFORM PASS NC1034.2 +203400 GO TO IF--WRITE-GF-97. NC1034.2 +203500 PERFORM FAIL. NC1034.2 +203600 MOVE VAL TO COMPUTED-N. NC1034.2 +203700 MOVE 1 TO CORRECT-N. NC1034.2 +203800 GO TO IF--WRITE-GF-97. NC1034.2 +203900 IF--DELETE-GF-97. NC1034.2 +204000 PERFORM DE-LETE. NC1034.2 +204100 IF--WRITE-GF-97. NC1034.2 +204200 MOVE "COMPARE NUM VS ALPH" TO FEATURE. NC1034.2 +204300 MOVE "IF--TEST-GF-97" TO PAR-NAME. NC1034.2 +204400 PERFORM PRINT-DETAIL. NC1034.2 +204500* NC1034.2 +204600* NC1034.2 +204700 IF--INIT-GF-98. NC1034.2 +204800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +204900 MOVE -123456789012345678 TO WRK-DS-18V0-1. NC1034.2 +205000 MOVE "123456789012345678" TO WRK-XN-18-2. NC1034.2 +205100 IF-TEST-GF-98. NC1034.2 +205200 IF WRK-DS-18V0-1 EQUAL WRK-XN-18-2 PERFORM PASS NC1034.2 +205300 ELSE PERFORM FAIL. NC1034.2 +205400 GO TO IF-WRITE-GF-98. NC1034.2 +205500 IF-DELETE-GF-98. NC1034.2 +205600 PERFORM DE-LETE. NC1034.2 +205700 IF-WRITE-GF-98. NC1034.2 +205800 MOVE "IF-TEST-GF-98" TO PAR-NAME. NC1034.2 +205900 MOVE "EQUAL - NO TO" TO FEATURE. NC1034.2 +206000 MOVE "PSEUDO-MOVE TO STRIP MINUS SIGN" TO RE-MARK. NC1034.2 +206100 PERFORM PRINT-DETAIL. NC1034.2 +206200* NC1034.2 +206300* NC1034.2 +206400 IF--INIT-GF-99. NC1034.2 +206500* ==--> OPTIONAL WORD "THEN" <--== NC1034.2 +206600 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +206700 MOVE "V1-89 6.15.2 " TO ANSI-REFERENCE. NC1034.2 +206800 MOVE 0 TO IF-D1. NC1034.2 +206900 IF--TEST-GF-99. NC1034.2 +207000 IF ZERO IS EQUAL TO IF-D1 NC1034.2 +207100 THEN PERFORM PASS NC1034.2 +207200 ELSE NC1034.2 +207300 PERFORM FAIL. NC1034.2 +207400 GO TO IF--WRITE-GF-99. NC1034.2 +207500 IF--DELETE-GF-99. NC1034.2 +207600 PERFORM DE-LETE. NC1034.2 +207700 IF--WRITE-GF-99. NC1034.2 +207800 MOVE "IF--TEST-GF-99" TO PAR-NAME. NC1034.2 +207900 PERFORM PRINT-DETAIL. NC1034.2 +208000* NC1034.2 +208100* NC1034.2 +208200 IF--INIT-GF-100. NC1034.2 +208300* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1034.2 +208400 MOVE "V1-89 6.4.3 " TO ANSI-REFERENCE. NC1034.2 +208500 MOVE ZERO TO WRK-DU-02V00. NC1034.2 +208600 MOVE ZERO TO IF-D2. NC1034.2 +208700 IF--TEST-GF-100-1. NC1034.2 +208800 IF ZERO IS EQUAL TO IF-D2 NC1034.2 +208900 PERFORM PASS NC1034.2 +209000 ELSE NC1034.2 +209100 PERFORM FAIL NC1034.2 +209200 END-IF NC1034.2 +209300 MOVE 99 TO WRK-DU-02V00. NC1034.2 +209400 GO TO IF--WRITE-GF-100-1. NC1034.2 +209500 IF--DELETE-GF-100-1. NC1034.2 +209600 PERFORM DE-LETE. NC1034.2 +209700 IF--WRITE-GF-100-1. NC1034.2 +209800 MOVE "IF--TEST-GF-100-1" TO PAR-NAME. NC1034.2 +209900 PERFORM PRINT-DETAIL. NC1034.2 +210000 IF--TEST-GF-100-2. NC1034.2 +210100 IF WRK-DU-02V00 = 99 NC1034.2 +210200 PERFORM PASS NC1034.2 +210300 ELSE NC1034.2 +210400 MOVE 99 TO CORRECT-N NC1034.2 +210500 MOVE WRK-DU-02V00 TO COMPUTED-N NC1034.2 +210600 PERFORM FAIL. NC1034.2 +210700 GO TO IF--WRITE-GF-100-2. NC1034.2 +210800 IF--DELETE-GF-100-2. NC1034.2 +210900 PERFORM DE-LETE. NC1034.2 +211000 IF--WRITE-GF-100-2. NC1034.2 +211100 MOVE "IF--TEST-GF-100-2" TO PAR-NAME. NC1034.2 +211200 PERFORM PRINT-DETAIL. NC1034.2 +211300* NC1034.2 +211400* NC1034.2 +211500 IF--INIT-GF-101. NC1034.2 +211600 MOVE " BABBAGE" TO IF-D38. NC1034.2 +211700 IF--TEST-GF-101. NC1034.2 +211800* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1034.2 +211900 MOVE "V1-89 6.4.3 " TO ANSI-REFERENCE. NC1034.2 +212000 IF IF-D38 EQUAL TO " BABBAGE " NC1034.2 +212100 PERFORM PASS NC1034.2 +212200 GO TO IF--WRITE-GF-101 NC1034.2 +212300 END-IF NC1034.2 +212400 GO TO IF--FAIL-GF-101. NC1034.2 +212500 IF--DELETE-GF-101. NC1034.2 +212600 PERFORM DE-LETE. NC1034.2 +212700 GO TO IF--WRITE-GF-101. NC1034.2 +212800 IF--FAIL-GF-101. NC1034.2 +212900 PERFORM FAIL. NC1034.2 +213000 MOVE IF-D38 TO COMPUTED-A. NC1034.2 +213100 MOVE " BABBAGE " TO CORRECT-A. NC1034.2 +213200 IF--WRITE-GF-101. NC1034.2 +213300 MOVE "IF--TEST-GF-101" TO PAR-NAME. NC1034.2 +213400 PERFORM PRINT-DETAIL. NC1034.2 +213500* NC1034.2 +213600* NC1034.2 +213700 CCVS-EXIT SECTION. NC1034.2 +213800 CCVS-999999. NC1034.2 +213900 GO TO CLOSE-FILES. NC1034.2 +*END-OF,NC103A +*HEADER,COBOL,NC104A +000100 IDENTIFICATION DIVISION. NC1044.2 +000200 PROGRAM-ID. NC1044.2 +000300 NC104A. NC1044.2 +000400**************************************************************** NC1044.2 +000500* * NC1044.2 +000600* VALIDATION FOR:- * NC1044.2 +000700* * NC1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +000900* * NC1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1044.2 +001100* * NC1044.2 +001200**************************************************************** NC1044.2 +001300* * NC1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1044.2 +001500* * NC1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1044.2 +001900* * NC1044.2 +002000**************************************************************** NC1044.2 +002100* NC1044.2 +002200* PROGRAM NC104A TESTS FORMAT 1 OF THE MOVE STATEMENT NC1044.2 +002300* WITH VARIOUS COMBINATIONS OF SENDING AND RECEIVING FIELDS. NC1044.2 +002400* NC1044.2 +002500* (SEE ALSO NC105A). NC1044.2 +002600* NC1044.2 +002700 NC1044.2 +002800 ENVIRONMENT DIVISION. NC1044.2 +002900 CONFIGURATION SECTION. NC1044.2 +003000 SOURCE-COMPUTER. NC1044.2 +003100 XXXXX082. NC1044.2 +003200 OBJECT-COMPUTER. NC1044.2 +003300 XXXXX083. NC1044.2 +003400 INPUT-OUTPUT SECTION. NC1044.2 +003500 FILE-CONTROL. NC1044.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1044.2 +003700 XXXXX055. NC1044.2 +003800 DATA DIVISION. NC1044.2 +003900 FILE SECTION. NC1044.2 +004000 FD PRINT-FILE NC1044.2 +004100 LABEL RECORDS NC1044.2 +004200 XXXXX084 NC1044.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. NC1044.2 +004400 01 PRINT-REC PICTURE X(120). NC1044.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC1044.2 +004600 WORKING-STORAGE SECTION. NC1044.2 +004700 01 MOVE1 PICTURE IS 9(5) NC1044.2 +004800 VALUE IS 12345. NC1044.2 +004900 01 MOVE2 PICTURE IS 9(5). NC1044.2 +005000 01 MOVE3 PICTURE IS 99. NC1044.2 +005100 01 MOVE4 PICTURE IS 9(7). NC1044.2 +005200 01 MOVE5 PICTURE IS 99V999. NC1044.2 +005300 01 MOVE6 PICTURE IS V99999. NC1044.2 +005400 01 MOVE8 PICTURE IS 9(5)V99. NC1044.2 +005500 01 MOVE9 PICTURE IS 9(7)V99. NC1044.2 +005600 01 MOVE10 PICTURE IS $999.99. NC1044.2 +005700 01 MOVE11 PICTURE IS $99,999.99. NC1044.2 +005800 01 MOVE12 PICTURE IS $(5)9(3). NC1044.2 +005900 01 MOVE13 PICTURE IS *(5)9(6). NC1044.2 +006000 01 MOVE14 PICTURE IS +9(5). NC1044.2 +006100 01 MOVE15 PICTURE IS 9(5) NC1044.2 +006200 VALUE IS 00000. NC1044.2 +006300 01 MOVE16 PICTURE IS 9(5)CR. NC1044.2 +006400 01 MOVE17 PICTURE IS $99,999.99 NC1044.2 +006500 BLANK WHEN ZERO. NC1044.2 +006600 01 MOVE18 PICTURE IS ZZZZZZ. NC1044.2 +006700 01 MOVE19 PICTURE IS X(5). NC1044.2 +006800 01 MOVE20 PICTURE IS X(4). NC1044.2 +006900 01 MOVE21 PICTURE IS X(7). NC1044.2 +007000 01 MOVE22 PICTURE IS XBX0XBX0X. NC1044.2 +007100 01 MOVE23 PICTURE IS 999V99 NC1044.2 +007200 VALUE IS 123.45. NC1044.2 +007300 01 MOVE24 PICTURE IS XBXXXB000XXXX. NC1044.2 +007400 01 MOVE25 PICTURE IS 999. NC1044.2 +007500 01 MOVE26 PICTURE IS 999V99. NC1044.2 +007600 01 MOVE27 PICTURE IS 99PP. NC1044.2 +007700 01 MOVE29 PICTURE IS 9999V999. NC1044.2 +007800 01 MOVE29A VALUE IS "$123.45". NC1044.2 +007900 02 MOVE30 PICTURE IS $999.99. NC1044.2 +008000 01 MOVE31 PICTURE IS X(9). NC1044.2 +008100 01 MOVE32 PICTURE IS X(5) NC1044.2 +008200 VALUE IS "ABCDE". NC1044.2 +008300 01 MOVE33 PICTURE IS A(5). NC1044.2 +008400 01 MOVE34 PICTURE IS A(7). NC1044.2 +008500 01 MOVE35 PICTURE IS A(3). NC1044.2 +008600 01 MOVE35A VALUE IS "1 A05". NC1044.2 +008700 02 MOVE36 PICTURE IS XBA09. NC1044.2 +008800 01 MOVE37 PICTURE IS AAAAA NC1044.2 +008900 VALUE IS "ABCDE". NC1044.2 +009000 01 MOVE39 PICTURE IS 0XXXXX0. NC1044.2 +009100 01 MOVE47A. NC1044.2 +009200 02 MOVE48 PICTURE IS 9V9(17). NC1044.2 +009300 02 MOVE49 PICTURE IS 9(5) NC1044.2 +009400 VALUE IS 00045. NC1044.2 +009500 02 MOVE50 PICTURE IS X(5) NC1044.2 +009600 VALUE IS "12345". NC1044.2 +009700 02 MOVE51 PICTURE IS S9(5) NC1044.2 +009800 VALUE IS -12345. NC1044.2 +009900 02 MOVE52 PICTURE IS 9(5)-. NC1044.2 +010000 01 AN-DATANAMES. NC1044.2 +010100 02 ANDATA1 PICTURE X VALUE SPACE. NC1044.2 +010200 02 ANDATA2 PICTURE XX VALUE SPACE. NC1044.2 +010300 02 ANDATA3 PICTURE XXX VALUE SPACE. NC1044.2 +010400 02 ANDATA4 PICTURE X(4) VALUE SPACE. NC1044.2 +010500 02 ANDATA5 PICTURE X(5) VALUE SPACE. NC1044.2 +010600 02 ANDATA6 PICTURE X(6) VALUE SPACE. NC1044.2 +010700 02 ANDATA7 PICTURE X(7) VALUE SPACE. NC1044.2 +010800 02 ANDATA8 PICTURE X(8) VALUE SPACE. NC1044.2 +010900 02 ANDATA9 PICTURE X(9) VALUE SPACE. NC1044.2 +011000 02 ANDATA10 PICTURE X(10) VALUE SPACE. NC1044.2 +011100 02 ANDATA11 PICTURE X(11) VALUE SPACE. NC1044.2 +011200 02 ANDATA12 PICTURE X(12) VALUE SPACE. NC1044.2 +011300 02 ANDATA13 PICTURE X(13) VALUE SPACE. NC1044.2 +011400 02 ANDATA14 PICTURE X(14) VALUE SPACE. NC1044.2 +011500 02 ANDATA15 PICTURE X(15) VALUE SPACE. NC1044.2 +011600 02 ANDATA16 PICTURE X(16) VALUE SPACE. NC1044.2 +011700 02 ANDATA17 PICTURE X(17) VALUE SPACE. NC1044.2 +011800 02 ANDATA18 PICTURE X(18) VALUE SPACE. NC1044.2 +011900 02 ANDATA19 PICTURE X(19) VALUE SPACE. NC1044.2 +012000 02 ANDATA20 PICTURE X(20) VALUE SPACE. NC1044.2 +012100 02 ANDATA21 PICTURE X(120) VALUE SPACE. NC1044.2 +012200 01 42-DATANAMES. NC1044.2 +012300 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1044.2 +012400 02 DNAME2 PICTURE 99 VALUE 01 COMPUTATIONAL. NC1044.2 +012500 02 DNAME3 PICTURE 999 VALUE 001 COMPUTATIONAL. NC1044.2 +012600 02 DNAME4 PICTURE 9(4) VALUE 0001 COMPUTATIONAL. NC1044.2 +012700 02 DNAME5 PICTURE 9(5) VALUE 00001 COMPUTATIONAL. NC1044.2 +012800 02 DNAME6 PICTURE 9(6) VALUE 000001 COMPUTATIONAL. NC1044.2 +012900 02 DNAME7 PICTURE 9(7) VALUE 0000001 COMPUTATIONAL. NC1044.2 +013000 02 DNAME8 PICTURE 9(8) VALUE 00000001 COMPUTATIONAL. NC1044.2 +013100 02 DNAME9 PICTURE 9(9) VALUE 000000001. NC1044.2 +013200 02 DNAME10 PICTURE 9(10) VALUE 0000000001. NC1044.2 +013300 02 DNAME11 PICTURE 9(11) VALUE 00000000001. NC1044.2 +013400 02 DNAME12 PICTURE 9(12) VALUE 000000000001. NC1044.2 +013500 02 DNAME13 PICTURE 9(13) VALUE 0000000000001. NC1044.2 +013600 02 DNAME14 PICTURE 9(14) VALUE 00000000000001. NC1044.2 +013700 02 DNAME15 PICTURE 9(15) VALUE 000000000000001. NC1044.2 +013800 02 DNAME16 PICTURE 9(16) VALUE 0000000000000001. NC1044.2 +013900 02 DNAME17 PICTURE 9(17) VALUE 00000000000000001. NC1044.2 +014000 02 DNAME18 PICTURE 9(18) VALUE 000000000000000001. NC1044.2 +014100 02 DNAME19 PICTURE 9 VALUE 1. NC1044.2 +014200 02 DNAME20 PICTURE 99 VALUE 11. NC1044.2 +014300 02 DNAME21 PICTURE 999 VALUE 111. NC1044.2 +014400 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1044.2 +014500 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1044.2 +014600 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1044.2 +014700 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1044.2 +014800 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1044.2 +014900 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1044.2 +015000 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1044.2 +015100 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1044.2 +015200 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015300 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015400 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015500 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015600 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015700 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015800 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015900 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016000 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016100 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016200 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016300 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016400 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016500 01 TEST-RESULTS. NC1044.2 +016600 02 FILLER PIC X VALUE SPACE. NC1044.2 +016700 02 FEATURE PIC X(20) VALUE SPACE. NC1044.2 +016800 02 FILLER PIC X VALUE SPACE. NC1044.2 +016900 02 P-OR-F PIC X(5) VALUE SPACE. NC1044.2 +017000 02 FILLER PIC X VALUE SPACE. NC1044.2 +017100 02 PAR-NAME. NC1044.2 +017200 03 FILLER PIC X(19) VALUE SPACE. NC1044.2 +017300 03 PARDOT-X PIC X VALUE SPACE. NC1044.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. NC1044.2 +017500 02 FILLER PIC X(8) VALUE SPACE. NC1044.2 +017600 02 RE-MARK PIC X(61). NC1044.2 +017700 01 TEST-COMPUTED. NC1044.2 +017800 02 FILLER PIC X(30) VALUE SPACE. NC1044.2 +017900 02 FILLER PIC X(17) VALUE NC1044.2 +018000 " COMPUTED=". NC1044.2 +018100 02 COMPUTED-X. NC1044.2 +018200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1044.2 +018300 03 COMPUTED-N REDEFINES COMPUTED-A NC1044.2 +018400 PIC -9(9).9(9). NC1044.2 +018500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1044.2 +018600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1044.2 +018700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1044.2 +018800 03 CM-18V0 REDEFINES COMPUTED-A. NC1044.2 +018900 04 COMPUTED-18V0 PIC -9(18). NC1044.2 +019000 04 FILLER PIC X. NC1044.2 +019100 03 FILLER PIC X(50) VALUE SPACE. NC1044.2 +019200 01 TEST-CORRECT. NC1044.2 +019300 02 FILLER PIC X(30) VALUE SPACE. NC1044.2 +019400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1044.2 +019500 02 CORRECT-X. NC1044.2 +019600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1044.2 +019700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1044.2 +019800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1044.2 +019900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1044.2 +020000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1044.2 +020100 03 CR-18V0 REDEFINES CORRECT-A. NC1044.2 +020200 04 CORRECT-18V0 PIC -9(18). NC1044.2 +020300 04 FILLER PIC X. NC1044.2 +020400 03 FILLER PIC X(2) VALUE SPACE. NC1044.2 +020500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1044.2 +020600 01 CCVS-C-1. NC1044.2 +020700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1044.2 +020800- "SS PARAGRAPH-NAME NC1044.2 +020900- " REMARKS". NC1044.2 +021000 02 FILLER PIC X(20) VALUE SPACE. NC1044.2 +021100 01 CCVS-C-2. NC1044.2 +021200 02 FILLER PIC X VALUE SPACE. NC1044.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". NC1044.2 +021400 02 FILLER PIC X(15) VALUE SPACE. NC1044.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". NC1044.2 +021600 02 FILLER PIC X(94) VALUE SPACE. NC1044.2 +021700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1044.2 +021800 01 REC-CT PIC 99 VALUE ZERO. NC1044.2 +021900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1044.2 +022400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1044.2 +022500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1044.2 +022600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1044.2 +022700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1044.2 +022800 01 CCVS-H-1. NC1044.2 +022900 02 FILLER PIC X(39) VALUE SPACES. NC1044.2 +023000 02 FILLER PIC X(42) VALUE NC1044.2 +023100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1044.2 +023200 02 FILLER PIC X(39) VALUE SPACES. NC1044.2 +023300 01 CCVS-H-2A. NC1044.2 +023400 02 FILLER PIC X(40) VALUE SPACE. NC1044.2 +023500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1044.2 +023600 02 FILLER PIC XXXX VALUE NC1044.2 +023700 "4.2 ". NC1044.2 +023800 02 FILLER PIC X(28) VALUE NC1044.2 +023900 " COPY - NOT FOR DISTRIBUTION". NC1044.2 +024000 02 FILLER PIC X(41) VALUE SPACE. NC1044.2 +024100 NC1044.2 +024200 01 CCVS-H-2B. NC1044.2 +024300 02 FILLER PIC X(15) VALUE NC1044.2 +024400 "TEST RESULT OF ". NC1044.2 +024500 02 TEST-ID PIC X(9). NC1044.2 +024600 02 FILLER PIC X(4) VALUE NC1044.2 +024700 " IN ". NC1044.2 +024800 02 FILLER PIC X(12) VALUE NC1044.2 +024900 " HIGH ". NC1044.2 +025000 02 FILLER PIC X(22) VALUE NC1044.2 +025100 " LEVEL VALIDATION FOR ". NC1044.2 +025200 02 FILLER PIC X(58) VALUE NC1044.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +025400 01 CCVS-H-3. NC1044.2 +025500 02 FILLER PIC X(34) VALUE NC1044.2 +025600 " FOR OFFICIAL USE ONLY ". NC1044.2 +025700 02 FILLER PIC X(58) VALUE NC1044.2 +025800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1044.2 +025900 02 FILLER PIC X(28) VALUE NC1044.2 +026000 " COPYRIGHT 1985 ". NC1044.2 +026100 01 CCVS-E-1. NC1044.2 +026200 02 FILLER PIC X(52) VALUE SPACE. NC1044.2 +026300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1044.2 +026400 02 ID-AGAIN PIC X(9). NC1044.2 +026500 02 FILLER PIC X(45) VALUE SPACES. NC1044.2 +026600 01 CCVS-E-2. NC1044.2 +026700 02 FILLER PIC X(31) VALUE SPACE. NC1044.2 +026800 02 FILLER PIC X(21) VALUE SPACE. NC1044.2 +026900 02 CCVS-E-2-2. NC1044.2 +027000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1044.2 +027100 03 FILLER PIC X VALUE SPACE. NC1044.2 +027200 03 ENDER-DESC PIC X(44) VALUE NC1044.2 +027300 "ERRORS ENCOUNTERED". NC1044.2 +027400 01 CCVS-E-3. NC1044.2 +027500 02 FILLER PIC X(22) VALUE NC1044.2 +027600 " FOR OFFICIAL USE ONLY". NC1044.2 +027700 02 FILLER PIC X(12) VALUE SPACE. NC1044.2 +027800 02 FILLER PIC X(58) VALUE NC1044.2 +027900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +028000 02 FILLER PIC X(13) VALUE SPACE. NC1044.2 +028100 02 FILLER PIC X(15) VALUE NC1044.2 +028200 " COPYRIGHT 1985". NC1044.2 +028300 01 CCVS-E-4. NC1044.2 +028400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1044.2 +028500 02 FILLER PIC X(4) VALUE " OF ". NC1044.2 +028600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1044.2 +028700 02 FILLER PIC X(40) VALUE NC1044.2 +028800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1044.2 +028900 01 XXINFO. NC1044.2 +029000 02 FILLER PIC X(19) VALUE NC1044.2 +029100 "*** INFORMATION ***". NC1044.2 +029200 02 INFO-TEXT. NC1044.2 +029300 04 FILLER PIC X(8) VALUE SPACE. NC1044.2 +029400 04 XXCOMPUTED PIC X(20). NC1044.2 +029500 04 FILLER PIC X(5) VALUE SPACE. NC1044.2 +029600 04 XXCORRECT PIC X(20). NC1044.2 +029700 02 INF-ANSI-REFERENCE PIC X(48). NC1044.2 +029800 01 HYPHEN-LINE. NC1044.2 +029900 02 FILLER PIC IS X VALUE IS SPACE. NC1044.2 +030000 02 FILLER PIC IS X(65) VALUE IS "************************NC1044.2 +030100- "*****************************************". NC1044.2 +030200 02 FILLER PIC IS X(54) VALUE IS "************************NC1044.2 +030300- "******************************". NC1044.2 +030400 01 CCVS-PGM-ID PIC X(9) VALUE NC1044.2 +030500 "NC104A". NC1044.2 +030600 PROCEDURE DIVISION. NC1044.2 +030700 CCVS1 SECTION. NC1044.2 +030800 OPEN-FILES. NC1044.2 +030900 OPEN OUTPUT PRINT-FILE. NC1044.2 +031000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1044.2 +031100 MOVE SPACE TO TEST-RESULTS. NC1044.2 +031200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1044.2 +031300 GO TO CCVS1-EXIT. NC1044.2 +031400 CLOSE-FILES. NC1044.2 +031500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1044.2 +031600 TERMINATE-CCVS. NC1044.2 +031700S EXIT PROGRAM. NC1044.2 +031800STERMINATE-CALL. NC1044.2 +031900 STOP RUN. NC1044.2 +032000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1044.2 +032100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1044.2 +032200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1044.2 +032300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1044.2 +032400 MOVE "****TEST DELETED****" TO RE-MARK. NC1044.2 +032500 PRINT-DETAIL. NC1044.2 +032600 IF REC-CT NOT EQUAL TO ZERO NC1044.2 +032700 MOVE "." TO PARDOT-X NC1044.2 +032800 MOVE REC-CT TO DOTVALUE. NC1044.2 +032900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1044.2 +033000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1044.2 +033100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1044.2 +033200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1044.2 +033300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1044.2 +033400 MOVE SPACE TO CORRECT-X. NC1044.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1044.2 +033600 MOVE SPACE TO RE-MARK. NC1044.2 +033700 HEAD-ROUTINE. NC1044.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1044.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1044.2 +034200 COLUMN-NAMES-ROUTINE. NC1044.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +034600 END-ROUTINE. NC1044.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1044.2 +034800 END-RTN-EXIT. NC1044.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +035000 END-ROUTINE-1. NC1044.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1044.2 +035200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1044.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. NC1044.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1044.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1044.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1044.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1044.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1044.2 +035900 END-ROUTINE-12. NC1044.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1044.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1044.2 +036200 MOVE "NO " TO ERROR-TOTAL NC1044.2 +036300 ELSE NC1044.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1044.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1044.2 +036600 PERFORM WRITE-LINE. NC1044.2 +036700 END-ROUTINE-13. NC1044.2 +036800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1044.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE NC1044.2 +037000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1044.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1044.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO NC1044.2 +037400 MOVE "NO " TO ERROR-TOTAL NC1044.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1044.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1044.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037900 WRITE-LINE. NC1044.2 +038000 ADD 1 TO RECORD-COUNT. NC1044.2 +038100Y IF RECORD-COUNT GREATER 42 NC1044.2 +038200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1044.2 +038300Y MOVE SPACE TO DUMMY-RECORD NC1044.2 +038400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1044.2 +038500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1044.2 +038600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1044.2 +038700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1044.2 +038800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1044.2 +038900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1044.2 +039300Y MOVE ZERO TO RECORD-COUNT. NC1044.2 +039400 PERFORM WRT-LN. NC1044.2 +039500 WRT-LN. NC1044.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1044.2 +039700 MOVE SPACE TO DUMMY-RECORD. NC1044.2 +039800 BLANK-LINE-PRINT. NC1044.2 +039900 PERFORM WRT-LN. NC1044.2 +040000 FAIL-ROUTINE. NC1044.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE NC1044.2 +040200 GO TO FAIL-ROUTINE-WRITE. NC1044.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1044.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1044.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1044.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1044.2 +040800 GO TO FAIL-ROUTINE-EX. NC1044.2 +040900 FAIL-ROUTINE-WRITE. NC1044.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1044.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1044.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1044.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1044.2 +041400 FAIL-ROUTINE-EX. EXIT. NC1044.2 +041500 BAIL-OUT. NC1044.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1044.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1044.2 +041800 BAIL-OUT-WRITE. NC1044.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1044.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1044.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1044.2 +042300 BAIL-OUT-EX. EXIT. NC1044.2 +042400 CCVS1-EXIT. NC1044.2 +042500 EXIT. NC1044.2 +042600 SECT-NC104A-001 SECTION. NC1044.2 +042700 MOVE-INIT-F1-1. NC1044.2 +042800 MOVE "MOVE NUMERIC INTEGER" TO FEATURE. NC1044.2 +042900 MOVE "V1-102 6.18.2" TO ANSI-REFERENCE. NC1044.2 +043000 MOVE 12345 TO MOVE1. NC1044.2 +043100 MOVE-TEST-F1-1-0. NC1044.2 +043200 MOVE MOVE1 TO MOVE2. NC1044.2 +043300 MOVE-TEST-F1-1-1. NC1044.2 +043400 IF MOVE2 EQUAL TO 12345 NC1044.2 +043500 PERFORM PASS NC1044.2 +043600 ELSE NC1044.2 +043700 GO TO MOVE-FAIL-F1-1. NC1044.2 +043800* NOTE NI TO NI (NUMERIC INTEGRAL) MOVE, EQUAL SIZE. NC1044.2 +043900 GO TO MOVE-WRITE-F1-1. NC1044.2 +044000 MOVE-DELETE-F1-1. NC1044.2 +044100 PERFORM DE-LETE. NC1044.2 +044200 GO TO MOVE-WRITE-F1-1. NC1044.2 +044300 MOVE-FAIL-F1-1. NC1044.2 +044400 MOVE MOVE2 TO COMPUTED-N. NC1044.2 +044500 MOVE 12345 TO CORRECT-N. NC1044.2 +044600 PERFORM FAIL. NC1044.2 +044700 MOVE-WRITE-F1-1. NC1044.2 +044800 MOVE "MOVE-TEST-F1-1 " TO PAR-NAME. NC1044.2 +044900 PERFORM PRINT-DETAIL. NC1044.2 +045000 MOVE-INIT-F1-2. NC1044.2 +045100 MOVE 12345 TO MOVE1. NC1044.2 +045200 MOVE-TEST-F1-2-0. NC1044.2 +045300 MOVE MOVE1 TO MOVE3. NC1044.2 +045400 MOVE-TEST-F1-2-1. NC1044.2 +045500 IF MOVE3 EQUAL TO 45 NC1044.2 +045600 PERFORM PASS NC1044.2 +045700 ELSE NC1044.2 +045800 GO TO MOVE-FAIL-F1-2. NC1044.2 +045900* NOTE NI TO NI MOVE, WITH TRUNCATION. NC1044.2 +046000 GO TO MOVE-WRITE-F1-2. NC1044.2 +046100 MOVE-DELETE-F1-2. NC1044.2 +046200 PERFORM DE-LETE. NC1044.2 +046300 GO TO MOVE-WRITE-F1-2. NC1044.2 +046400 MOVE-FAIL-F1-2. NC1044.2 +046500 MOVE MOVE3 TO COMPUTED-N. NC1044.2 +046600 MOVE 45 TO CORRECT-N. NC1044.2 +046700 PERFORM FAIL. NC1044.2 +046800 MOVE-WRITE-F1-2. NC1044.2 +046900 MOVE "MOVE-TEST-F1-2 " TO PAR-NAME. NC1044.2 +047000 PERFORM PRINT-DETAIL. NC1044.2 +047100 MOVE-INIT-F1-3. NC1044.2 +047200 MOVE 12345 TO MOVE1. NC1044.2 +047300 MOVE-TEST-F1-3-0. NC1044.2 +047400 MOVE MOVE1 TO MOVE4. NC1044.2 +047500 MOVE-TEST-F1-3-1. NC1044.2 +047600 IF MOVE4 EQUAL TO 0012345 NC1044.2 +047700 PERFORM PASS NC1044.2 +047800 ELSE NC1044.2 +047900 GO TO MOVE-FAIL-F1-3. NC1044.2 +048000* NOTE NI TO NI MOVE, WITH ZERO PADDING. NC1044.2 +048100 GO TO MOVE-WRITE-F1-3. NC1044.2 +048200 MOVE-DELETE-F1-3. NC1044.2 +048300 PERFORM DE-LETE. NC1044.2 +048400 GO TO MOVE-WRITE-F1-3. NC1044.2 +048500 MOVE-FAIL-F1-3. NC1044.2 +048600 MOVE MOVE4 TO COMPUTED-N. NC1044.2 +048700 MOVE 0012345 TO CORRECT-N. NC1044.2 +048800 PERFORM FAIL. NC1044.2 +048900 MOVE-WRITE-F1-3. NC1044.2 +049000 MOVE "MOVE-TEST-F1-3 " TO PAR-NAME. NC1044.2 +049100 PERFORM PRINT-DETAIL. NC1044.2 +049200 MOVE-INIT-F1-4. NC1044.2 +049300 MOVE 12345 TO MOVE1. NC1044.2 +049400 MOVE-TEST-F1-4-0. NC1044.2 +049500 MOVE MOVE1 TO MOVE5. NC1044.2 +049600 MOVE-TEST-F1-4-1. NC1044.2 +049700 IF MOVE5 EQUAL TO 45 NC1044.2 +049800 PERFORM PASS NC1044.2 +049900 ELSE NC1044.2 +050000 GO TO MOVE-FAIL-F1-4. NC1044.2 +050100* NOTE NI TO NNI (NUMERIC NON INTEGER), LEFT TRUNCATION NC1044.2 +050200* ZERO FILL ON RIGHT. NC1044.2 +050300 GO TO MOVE-WRITE-F1-4. NC1044.2 +050400 MOVE-DELETE-F1-4. NC1044.2 +050500 PERFORM DE-LETE. NC1044.2 +050600 GO TO MOVE-WRITE-F1-4. NC1044.2 +050700 MOVE-FAIL-F1-4. NC1044.2 +050800 MOVE MOVE5 TO COMPUTED-N. NC1044.2 +050900 MOVE 45 TO CORRECT-N. NC1044.2 +051000 PERFORM FAIL. NC1044.2 +051100 MOVE-WRITE-F1-4. NC1044.2 +051200 MOVE "MOVE-TEST-F1-4 " TO PAR-NAME. NC1044.2 +051300 PERFORM PRINT-DETAIL. NC1044.2 +051400 MOVE-INIT-F1-5. NC1044.2 +051500 MOVE 12345 TO MOVE1. NC1044.2 +051600 MOVE-TEST-F1-5-0. NC1044.2 +051700 MOVE MOVE1 TO MOVE48. NC1044.2 +051800 MOVE-TEST-F1-5-1. NC1044.2 +051900 IF MOVE48 EQUAL TO 5 NC1044.2 +052000 PERFORM PASS NC1044.2 +052100 ELSE NC1044.2 +052200 GO TO MOVE-FAIL-F1-5. NC1044.2 +052300* NOTE NI TO NNI MOVE, RECEIVING FIELD MAX SIZE. NC1044.2 +052400 GO TO MOVE-WRITE-F1-5. NC1044.2 +052500 MOVE-DELETE-F1-5. NC1044.2 +052600 PERFORM DE-LETE. NC1044.2 +052700 GO TO MOVE-WRITE-F1-5. NC1044.2 +052800 MOVE-FAIL-F1-5. NC1044.2 +052900 MOVE MOVE48 TO COMPUTED-N. NC1044.2 +053000 MOVE 5 TO CORRECT-N. NC1044.2 +053100 PERFORM FAIL. NC1044.2 +053200 MOVE-WRITE-F1-5. NC1044.2 +053300 MOVE "MOVE-TEST-F1-5 " TO PAR-NAME. NC1044.2 +053400 PERFORM PRINT-DETAIL. NC1044.2 +053500 MOVE-INIT-F1-6. NC1044.2 +053600 MOVE 12345 TO MOVE1. NC1044.2 +053700 MOVE-TEST-F1-6-0. NC1044.2 +053800 MOVE MOVE1 TO MOVE27. NC1044.2 +053900 MOVE-TEST-F1-6-1. NC1044.2 +054000 IF MOVE27 EQUAL TO 2300 NC1044.2 +054100 PERFORM PASS NC1044.2 +054200 ELSE NC1044.2 +054300 GO TO MOVE-FAIL-F1-6. NC1044.2 +054400* NOTE NI TO NNI MOVE SCALING. NC1044.2 +054500 GO TO MOVE-WRITE-F1-6. NC1044.2 +054600 MOVE-DELETE-F1-6. NC1044.2 +054700 PERFORM DE-LETE. NC1044.2 +054800 GO TO MOVE-WRITE-F1-6. NC1044.2 +054900 MOVE-FAIL-F1-6. NC1044.2 +055000 MOVE MOVE27 TO COMPUTED-N. NC1044.2 +055100 MOVE 2300 TO CORRECT-N. NC1044.2 +055200 PERFORM FAIL. NC1044.2 +055300 MOVE-WRITE-F1-6. NC1044.2 +055400 MOVE "MOVE-TEST-F1-6 " TO PAR-NAME. NC1044.2 +055500 PERFORM PRINT-DETAIL. NC1044.2 +055600 MOVE-INIT-F1-7. NC1044.2 +055700 MOVE 12345 TO MOVE1. NC1044.2 +055800 MOVE-TEST-F1-7-0. NC1044.2 +055900 MOVE MOVE1 TO MOVE8. NC1044.2 +056000 MOVE-TEST-F1-7-1. NC1044.2 +056100 IF MOVE1 EQUAL TO 12345.00 NC1044.2 +056200 PERFORM PASS NC1044.2 +056300 ELSE NC1044.2 +056400 GO TO MOVE-FAIL-F1-7. NC1044.2 +056500* NOTE NI TO NNI MOVE, ZERO PADDING ON RIGHT. NC1044.2 +056600 GO TO MOVE-WRITE-F1-7. NC1044.2 +056700 MOVE-DELETE-F1-7. NC1044.2 +056800 PERFORM DE-LETE. NC1044.2 +056900 GO TO MOVE-WRITE-F1-7. NC1044.2 +057000 MOVE-FAIL-F1-7. NC1044.2 +057100 MOVE MOVE8 TO COMPUTED-N. NC1044.2 +057200 MOVE 12345.00 TO CORRECT-N. NC1044.2 +057300 PERFORM FAIL. NC1044.2 +057400 MOVE-WRITE-F1-7. NC1044.2 +057500 MOVE "MOVE-TEST-F1-7 " TO PAR-NAME. NC1044.2 +057600 PERFORM PRINT-DETAIL. NC1044.2 +057700 MOVE-INIT-F1-8. NC1044.2 +057800 MOVE 12345 TO MOVE1. NC1044.2 +057900 MOVE-TEST-F1-8-0. NC1044.2 +058000 MOVE MOVE1 TO MOVE9. NC1044.2 +058100 MOVE-TEST-F1-8-1. NC1044.2 +058200 IF MOVE9 EQUAL TO 012345.00 NC1044.2 +058300 PERFORM PASS NC1044.2 +058400 ELSE NC1044.2 +058500 GO TO MOVE-FAIL-F1-8. NC1044.2 +058600* NOTE NI TO NNI MOVE, ZERO PADDING LEFT AND RIGHT. NC1044.2 +058700 GO TO MOVE-WRITE-F1-8. NC1044.2 +058800 MOVE-DELETE-F1-8. NC1044.2 +058900 PERFORM DE-LETE. NC1044.2 +059000 GO TO MOVE-WRITE-F1-8. NC1044.2 +059100 MOVE-FAIL-F1-8. NC1044.2 +059200 MOVE MOVE9 TO COMPUTED-N. NC1044.2 +059300 MOVE 0012345.00 TO CORRECT-N. NC1044.2 +059400 PERFORM FAIL. NC1044.2 +059500 MOVE-WRITE-F1-8. NC1044.2 +059600 MOVE "MOVE-TEST-F1-8 " TO PAR-NAME. NC1044.2 +059700 PERFORM PRINT-DETAIL. NC1044.2 +059800 MOVE-INIT-F1-9. NC1044.2 +059900 MOVE 12345 TO MOVE1. NC1044.2 +060000 MOVE-TEST-F1-9-0. NC1044.2 +060100 MOVE MOVE1 TO MOVE10. NC1044.2 +060200 MOVE-TEST-F1-9-1. NC1044.2 +060300 IF MOVE10 EQUAL TO "$345.00" NC1044.2 +060400 PERFORM PASS NC1044.2 +060500 ELSE NC1044.2 +060600 GO TO MOVE-FAIL-F1-9. NC1044.2 +060700* NOTE NI TO NE MOVE, FIXED INSERTION, CURRENCY SIGN, PERIOD. NC1044.2 +060800 GO TO MOVE-WRITE-F1-9. NC1044.2 +060900 MOVE-DELETE-F1-9. NC1044.2 +061000 PERFORM DE-LETE. NC1044.2 +061100 GO TO MOVE-WRITE-F1-9. NC1044.2 +061200 MOVE-FAIL-F1-9. NC1044.2 +061300 MOVE MOVE10 TO COMPUTED-A. NC1044.2 +061400 MOVE "$345.00" TO CORRECT-A. NC1044.2 +061500 PERFORM FAIL. NC1044.2 +061600 MOVE-WRITE-F1-9. NC1044.2 +061700 MOVE "MOVE-TEST-F1-9 " TO PAR-NAME. NC1044.2 +061800 PERFORM PRINT-DETAIL. NC1044.2 +061900 MOVE-INIT-F1-10. NC1044.2 +062000 MOVE 12345 TO MOVE1. NC1044.2 +062100 MOVE-TEST-F1-10-0. NC1044.2 +062200 MOVE MOVE1 TO MOVE11. NC1044.2 +062300 MOVE-TEST-F1-10-1. NC1044.2 +062400 IF MOVE11 EQUAL TO "$12,345.00" NC1044.2 +062500 PERFORM PASS NC1044.2 +062600 ELSE NC1044.2 +062700 GO TO MOVE-FAIL-F1-10. NC1044.2 +062800* NOTE NI TO NE MOVE, FIXED INSERTION (CURRENCY SIGN, NC1044.2 +062900* COMMA, PERIOD) ZERO FILL ON RIGHT. NC1044.2 +063000 GO TO MOVE-WRITE-F1-10. NC1044.2 +063100 MOVE-DELETE-F1-10. NC1044.2 +063200 PERFORM DE-LETE. NC1044.2 +063300 GO TO MOVE-WRITE-F1-10. NC1044.2 +063400 MOVE-FAIL-F1-10. NC1044.2 +063500 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +063600 MOVE "$12,345.00" TO CORRECT-A. NC1044.2 +063700 PERFORM FAIL. NC1044.2 +063800 MOVE-WRITE-F1-10. NC1044.2 +063900 MOVE "MOVE-TEST-F1-10" TO PAR-NAME. NC1044.2 +064000 PERFORM PRINT-DETAIL. NC1044.2 +064100 MOVE-INIT-F1-11. NC1044.2 +064200 MOVE 00045 TO MOVE49. NC1044.2 +064300 MOVE-TEST-F1-11-0. NC1044.2 +064400 MOVE MOVE49 TO MOVE12. NC1044.2 +064500 MOVE-TEST-F1-11-1. NC1044.2 +064600 IF MOVE12 EQUAL TO " $045" NC1044.2 +064700 PERFORM PASS NC1044.2 +064800 ELSE NC1044.2 +064900 GO TO MOVE-FAIL-F1-11. NC1044.2 +065000* NOTE NI TO NE MOVE, FLOAT CURRENCY SIGN. NC1044.2 +065100 GO TO MOVE-WRITE-F1-11. NC1044.2 +065200 MOVE-DELETE-F1-11. NC1044.2 +065300 PERFORM DE-LETE. NC1044.2 +065400 GO TO MOVE-WRITE-F1-11. NC1044.2 +065500 MOVE-FAIL-F1-11. NC1044.2 +065600 MOVE MOVE12 TO COMPUTED-A. NC1044.2 +065700 MOVE " $045" TO CORRECT-A. NC1044.2 +065800 PERFORM FAIL. NC1044.2 +065900 MOVE-WRITE-F1-11. NC1044.2 +066000 MOVE "MOVE-TEST-F1-11" TO PAR-NAME. NC1044.2 +066100 PERFORM PRINT-DETAIL. NC1044.2 +066200 MOVE-INIT-F1-12. NC1044.2 +066300 MOVE 00045 TO MOVE49. NC1044.2 +066400 MOVE-TEST-F1-12-0. NC1044.2 +066500 MOVE MOVE49 TO MOVE13. NC1044.2 +066600 MOVE-TEST-F1-12-1. NC1044.2 +066700 IF MOVE13 EQUAL TO "*****000045" NC1044.2 +066800 PERFORM PASS NC1044.2 +066900 ELSE NC1044.2 +067000 GO TO MOVE-FAIL-F1-12. NC1044.2 +067100* NOTE NI TO NE MOVE, CHECK PROTECT. NC1044.2 +067200 GO TO MOVE-WRITE-F1-12. NC1044.2 +067300 MOVE-DELETE-F1-12. NC1044.2 +067400 PERFORM DE-LETE. NC1044.2 +067500 GO TO MOVE-WRITE-F1-12. NC1044.2 +067600 MOVE-FAIL-F1-12. NC1044.2 +067700 MOVE MOVE13 TO COMPUTED-A. NC1044.2 +067800 MOVE "*****000045" TO CORRECT-A. NC1044.2 +067900 PERFORM FAIL. NC1044.2 +068000 MOVE-WRITE-F1-12. NC1044.2 +068100 MOVE "MOVE-TEST-F1-12" TO PAR-NAME. NC1044.2 +068200 PERFORM PRINT-DETAIL. NC1044.2 +068300 MOVE-INIT-F1-13. NC1044.2 +068400 MOVE 12345 TO MOVE1. NC1044.2 +068500 MOVE-TEST-F1-13-0. NC1044.2 +068600 MOVE MOVE1 TO MOVE14. NC1044.2 +068700 MOVE-TEST-F1-13-1. NC1044.2 +068800 IF MOVE14 EQUAL TO "+12345" NC1044.2 +068900 PERFORM PASS NC1044.2 +069000 ELSE NC1044.2 +069100 GO TO MOVE-FAIL-F1-13. NC1044.2 +069200* NOTE NI TO NE MOVE, REPORT SIGN. NC1044.2 +069300 GO TO MOVE-WRITE-F1-13. NC1044.2 +069400 MOVE-DELETE-F1-13. NC1044.2 +069500 PERFORM DE-LETE. NC1044.2 +069600 GO TO MOVE-WRITE-F1-13. NC1044.2 +069700 MOVE-FAIL-F1-13. NC1044.2 +069800 MOVE MOVE14 TO COMPUTED-A. NC1044.2 +069900 MOVE "+12345" TO CORRECT-A. NC1044.2 +070000 PERFORM FAIL. NC1044.2 +070100 MOVE-WRITE-F1-13. NC1044.2 +070200 MOVE "MOVE-TEST-F1-13" TO PAR-NAME. NC1044.2 +070300 PERFORM PRINT-DETAIL. NC1044.2 +070400 MOVE-INIT-F1-14. NC1044.2 +070500 MOVE -12345 TO MOVE51. NC1044.2 +070600 MOVE-TEST-F1-14-0. NC1044.2 +070700 MOVE MOVE51 TO MOVE16. NC1044.2 +070800 MOVE-TEST-F1-14-1. NC1044.2 +070900 IF MOVE16 EQUAL TO "12345CR" NC1044.2 +071000 PERFORM PASS NC1044.2 +071100 ELSE NC1044.2 +071200 GO TO MOVE-FAIL-F1-14. NC1044.2 +071300* NOTE NI TO NE MOVE, REPORT SYMBOL CR. NC1044.2 +071400 GO TO MOVE-WRITE-F1-14. NC1044.2 +071500 MOVE-DELETE-F1-14. NC1044.2 +071600 PERFORM DE-LETE. NC1044.2 +071700 GO TO MOVE-WRITE-F1-14. NC1044.2 +071800 MOVE-FAIL-F1-14. NC1044.2 +071900 MOVE MOVE16 TO COMPUTED-A. NC1044.2 +072000 MOVE "12345CR" TO CORRECT-A. NC1044.2 +072100 PERFORM FAIL. NC1044.2 +072200 MOVE-WRITE-F1-14. NC1044.2 +072300 MOVE "MOVE-TEST-F1-14" TO PAR-NAME. NC1044.2 +072400 PERFORM PRINT-DETAIL. NC1044.2 +072500 MOVE-INIT-F1-15. NC1044.2 +072600 MOVE -12345 TO MOVE51. NC1044.2 +072700 MOVE-TEST-F1-15-0. NC1044.2 +072800 MOVE MOVE51 TO MOVE52. NC1044.2 +072900 MOVE-TEST-F1-15-1. NC1044.2 +073000 IF MOVE52 EQUAL TO "12345-" NC1044.2 +073100 PERFORM PASS NC1044.2 +073200 ELSE NC1044.2 +073300 GO TO MOVE-FAIL-F1-15. NC1044.2 +073400* NOTE NI TO NE MOVE REPORT SIGN. NC1044.2 +073500 GO TO MOVE-WRITE-F1-15. NC1044.2 +073600 MOVE-DELETE-F1-15. NC1044.2 +073700 PERFORM DE-LETE. NC1044.2 +073800 GO TO MOVE-WRITE-F1-15. NC1044.2 +073900 MOVE-FAIL-F1-15. NC1044.2 +074000 MOVE MOVE52 TO COMPUTED-A. NC1044.2 +074100 MOVE "12345-" TO CORRECT-A. NC1044.2 +074200 PERFORM FAIL. NC1044.2 +074300 MOVE-WRITE-F1-15. NC1044.2 +074400 MOVE "MOVE-TEST-F1-15" TO PAR-NAME. NC1044.2 +074500 PERFORM PRINT-DETAIL. NC1044.2 +074600 MOVE-INIT-F1-16. NC1044.2 +074700 MOVE 00000 TO MOVE15. NC1044.2 +074800 MOVE-TEST-F1-16-0. NC1044.2 +074900 MOVE MOVE15 TO MOVE17. NC1044.2 +075000 MOVE-TEST-F1-16-1. NC1044.2 +075100 IF MOVE17 EQUAL TO SPACE NC1044.2 +075200 PERFORM PASS NC1044.2 +075300 ELSE NC1044.2 +075400 GO TO MOVE-FAIL-F1-16. NC1044.2 +075500* NOTE NI TO NE MOVE, BLANK WHEN ZERO CLAUSE. NC1044.2 +075600 GO TO MOVE-WRITE-F1-16. NC1044.2 +075700 MOVE-DELETE-F1-16. NC1044.2 +075800 PERFORM DE-LETE. NC1044.2 +075900 GO TO MOVE-WRITE-F1-16. NC1044.2 +076000 MOVE-FAIL-F1-16. NC1044.2 +076100 MOVE MOVE17 TO COMPUTED-A. NC1044.2 +076200 MOVE SPACE TO CORRECT-A. NC1044.2 +076300 PERFORM FAIL. NC1044.2 +076400 MOVE-WRITE-F1-16. NC1044.2 +076500 MOVE "MOVE-TEST-F1-16" TO PAR-NAME. NC1044.2 +076600 PERFORM PRINT-DETAIL. NC1044.2 +076700 MOVE-INIT-F1-17. NC1044.2 +076800 MOVE 00000 TO MOVE15. NC1044.2 +076900 MOVE-TEST-F1-17-0. NC1044.2 +077000 MOVE MOVE15 TO MOVE18. NC1044.2 +077100 MOVE-TEST-F1-17-1. NC1044.2 +077200 IF MOVE18 EQUAL TO SPACE NC1044.2 +077300 PERFORM PASS NC1044.2 +077400 ELSE NC1044.2 +077500 GO TO MOVE-FAIL-F1-17. NC1044.2 +077600* NOTE NI TO NE MOVE, BLANK WHEN ZERO PICTURE. NC1044.2 +077700 GO TO MOVE-WRITE-F1-17. NC1044.2 +077800 MOVE-DELETE-F1-17. NC1044.2 +077900 PERFORM DE-LETE. NC1044.2 +078000 GO TO MOVE-WRITE-F1-17. NC1044.2 +078100 MOVE-FAIL-F1-17. NC1044.2 +078200 MOVE MOVE18 TO COMPUTED-A. NC1044.2 +078300 MOVE SPACE TO CORRECT-A. NC1044.2 +078400 PERFORM FAIL. NC1044.2 +078500 MOVE-WRITE-F1-17. NC1044.2 +078600 MOVE "MOVE-TEST-F1-17" TO PAR-NAME. NC1044.2 +078700 PERFORM PRINT-DETAIL. NC1044.2 +078800 MOVE-INIT-F1-18. NC1044.2 +078900 MOVE 12345 TO MOVE1. NC1044.2 +079000 MOVE-TEST-F1-18-0. NC1044.2 +079100 MOVE MOVE1 TO MOVE19. NC1044.2 +079200 MOVE-TEST-F1-18-1. NC1044.2 +079300 IF MOVE19 EQUAL TO 12345 NC1044.2 +079400 PERFORM PASS NC1044.2 +079500 ELSE NC1044.2 +079600 GO TO MOVE-FAIL-F1-18. NC1044.2 +079700* NOTE NI TO AN MOVE, EQUAL SIZE. NC1044.2 +079800 GO TO MOVE-WRITE-F1-18. NC1044.2 +079900 MOVE-DELETE-F1-18. NC1044.2 +080000 PERFORM DE-LETE. NC1044.2 +080100 GO TO MOVE-WRITE-F1-18. NC1044.2 +080200 MOVE-FAIL-F1-18. NC1044.2 +080300 MOVE MOVE19 TO COMPUTED-N. NC1044.2 +080400 MOVE 12345 TO CORRECT-N. NC1044.2 +080500 PERFORM FAIL. NC1044.2 +080600 MOVE-WRITE-F1-18. NC1044.2 +080700 MOVE "MOVE-TEST-F1-18" TO PAR-NAME. NC1044.2 +080800 PERFORM PRINT-DETAIL. NC1044.2 +080900 MOVE-INIT-F1-19. NC1044.2 +081000 MOVE 12345 TO MOVE1. NC1044.2 +081100 MOVE-TEST-F1-19-0. NC1044.2 +081200 MOVE MOVE1 TO MOVE20. NC1044.2 +081300 MOVE-TEST-F1-19-1. NC1044.2 +081400 IF MOVE20 EQUAL TO 1234 NC1044.2 +081500 PERFORM PASS NC1044.2 +081600 ELSE NC1044.2 +081700 GO TO MOVE-FAIL-F1-19. NC1044.2 +081800* NOTE NI TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +081900 GO TO MOVE-WRITE-F1-19. NC1044.2 +082000 MOVE-DELETE-F1-19. NC1044.2 +082100 PERFORM DE-LETE. NC1044.2 +082200 GO TO MOVE-WRITE-F1-19. NC1044.2 +082300 MOVE-FAIL-F1-19. NC1044.2 +082400 MOVE MOVE20 TO COMPUTED-N. NC1044.2 +082500 MOVE 1234 TO CORRECT-N. NC1044.2 +082600 PERFORM FAIL. NC1044.2 +082700 MOVE-WRITE-F1-19. NC1044.2 +082800 MOVE "MOVE-TEST-F1-19" TO PAR-NAME. NC1044.2 +082900 PERFORM PRINT-DETAIL. NC1044.2 +083000 MOVE-INIT-F1-20. NC1044.2 +083100 MOVE 12345 TO MOVE1. NC1044.2 +083200 MOVE-TEST-F1-20-0. NC1044.2 +083300 MOVE MOVE1 TO MOVE21. NC1044.2 +083400 MOVE-TEST-F1-20-1. NC1044.2 +083500 IF MOVE21 EQUAL TO "12345 " NC1044.2 +083600 PERFORM PASS NC1044.2 +083700 ELSE NC1044.2 +083800 GO TO MOVE-FAIL-F1-20. NC1044.2 +083900* NOTE NI TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +084000 GO TO MOVE-WRITE-F1-20. NC1044.2 +084100 MOVE-DELETE-F1-20. NC1044.2 +084200 PERFORM DE-LETE. NC1044.2 +084300 GO TO MOVE-WRITE-F1-20. NC1044.2 +084400 MOVE-FAIL-F1-20. NC1044.2 +084500 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +084600 MOVE "12345 " TO CORRECT-A. NC1044.2 +084700 PERFORM FAIL. NC1044.2 +084800 MOVE-WRITE-F1-20. NC1044.2 +084900 MOVE "MOVE-TEST-F1-20" TO PAR-NAME. NC1044.2 +085000 PERFORM PRINT-DETAIL. NC1044.2 +085100 MOVE-INIT-F1-21. NC1044.2 +085200 MOVE 12345 TO MOVE1. NC1044.2 +085300 MOVE-TEST-F1-21-0. NC1044.2 +085400 MOVE MOVE1 TO MOVE22. NC1044.2 +085500 MOVE-TEST-F1-21-1. NC1044.2 +085600 IF MOVE22 EQUAL TO "1 203 405" NC1044.2 +085700 PERFORM PASS NC1044.2 +085800 ELSE NC1044.2 +085900 GO TO MOVE-FAIL-F1-21. NC1044.2 +086000* NOTE NI TO AE MOVE, ZERO AND SPACE INSERTION. NC1044.2 +086100 GO TO MOVE-WRITE-F1-21. NC1044.2 +086200 MOVE-DELETE-F1-21. NC1044.2 +086300 PERFORM DE-LETE. NC1044.2 +086400 GO TO MOVE-WRITE-F1-21. NC1044.2 +086500 MOVE-FAIL-F1-21. NC1044.2 +086600 MOVE MOVE22 TO COMPUTED-A. NC1044.2 +086700 MOVE "1 203 405" TO CORRECT-A. NC1044.2 +086800 PERFORM FAIL. NC1044.2 +086900 MOVE-WRITE-F1-21. NC1044.2 +087000 MOVE "MOVE-TEST-F1-21" TO PAR-NAME. NC1044.2 +087100 PERFORM PRINT-DETAIL. NC1044.2 +087200 MOVE-INIT-F1-22. NC1044.2 +087300 MOVE 123.45 TO MOVE23. NC1044.2 +087400 MOVE "MOVE NUM NON-INTEGER" TO FEATURE. NC1044.2 +087500 MOVE-TEST-F1-22-0. NC1044.2 +087600 MOVE MOVE23 TO MOVE4. NC1044.2 +087700 MOVE-TEST-F1-22-1. NC1044.2 +087800 IF MOVE4 EQUAL TO 0000123 NC1044.2 +087900 PERFORM PASS NC1044.2 +088000 ELSE NC1044.2 +088100 GO TO MOVE-FAIL-F1-22. NC1044.2 +088200* NOTE NNI TO NI MOVE, ZERO PADDING ON LEFT, TRUNCATION. NC1044.2 +088300 GO TO MOVE-WRITE-F1-22. NC1044.2 +088400 MOVE-DELETE-F1-22. NC1044.2 +088500 PERFORM DE-LETE. NC1044.2 +088600 GO TO MOVE-WRITE-F1-22. NC1044.2 +088700 MOVE-FAIL-F1-22. NC1044.2 +088800 MOVE MOVE23 TO COMPUTED-N. NC1044.2 +088900 MOVE 0000123 TO CORRECT-N. NC1044.2 +089000 PERFORM FAIL. NC1044.2 +089100 MOVE-WRITE-F1-22. NC1044.2 +089200 MOVE "MOVE-TEST-F1-22" TO PAR-NAME. NC1044.2 +089300 PERFORM PRINT-DETAIL. NC1044.2 +089400 MOVE-INIT-F1-23. NC1044.2 +089500 MOVE 123.45 TO MOVE23. NC1044.2 +089600 MOVE-TEST-F1-23-0. NC1044.2 +089700 MOVE MOVE23 TO MOVE25. NC1044.2 +089800 MOVE-TEST-F1-23-1. NC1044.2 +089900 IF MOVE25 EQUAL TO 123 NC1044.2 +090000 PERFORM PASS NC1044.2 +090100 ELSE NC1044.2 +090200 GO TO MOVE-FAIL-F1-23. NC1044.2 +090300* NOTE NNI TO NI MOVE, TRUNCATION ON RIGHT. NC1044.2 +090400 GO TO MOVE-WRITE-F1-23. NC1044.2 +090500 MOVE-DELETE-F1-23. NC1044.2 +090600 PERFORM DE-LETE. NC1044.2 +090700 GO TO MOVE-WRITE-F1-23. NC1044.2 +090800 MOVE-FAIL-F1-23. NC1044.2 +090900 MOVE MOVE25 TO COMPUTED-N. NC1044.2 +091000 MOVE 123 TO CORRECT-N. NC1044.2 +091100 PERFORM FAIL. NC1044.2 +091200 MOVE-WRITE-F1-23. NC1044.2 +091300 MOVE "MOVE-TEST-F1-23" TO PAR-NAME. NC1044.2 +091400 PERFORM PRINT-DETAIL. NC1044.2 +091500 MOVE-INIT-F1-24. NC1044.2 +091600 MOVE 123.45 TO MOVE23. NC1044.2 +091700 MOVE-TEST-F1-24-0. NC1044.2 +091800 MOVE MOVE23 TO MOVE3. NC1044.2 +091900 MOVE-TEST-F1-24-1. NC1044.2 +092000 IF MOVE3 EQUAL TO 23 NC1044.2 +092100 PERFORM PASS NC1044.2 +092200 ELSE NC1044.2 +092300 GO TO MOVE-FAIL-F1-24. NC1044.2 +092400* NOTE NNI TO NI MOVE, TRUNCATION LEFT AND RIGHT. NC1044.2 +092500 GO TO MOVE-WRITE-F1-24. NC1044.2 +092600 MOVE-DELETE-F1-24. NC1044.2 +092700 PERFORM DE-LETE. NC1044.2 +092800 GO TO MOVE-WRITE-F1-24. NC1044.2 +092900 MOVE-FAIL-F1-24. NC1044.2 +093000 MOVE MOVE3 TO COMPUTED-N. NC1044.2 +093100 MOVE 23 TO CORRECT-N. NC1044.2 +093200 PERFORM FAIL. NC1044.2 +093300 MOVE-WRITE-F1-24. NC1044.2 +093400 MOVE "MOVE-TEST-F1-24" TO PAR-NAME. NC1044.2 +093500 PERFORM PRINT-DETAIL. NC1044.2 +093600 MOVE-INIT-F1-25. NC1044.2 +093700 MOVE 123.45 TO MOVE23. NC1044.2 +093800 MOVE-TEST-F1-25-0. NC1044.2 +093900 MOVE MOVE23 TO MOVE27. NC1044.2 +094000 MOVE-TEST-F1-25-1. NC1044.2 +094100 IF MOVE27 EQUAL TO 0100 NC1044.2 +094200 PERFORM PASS NC1044.2 +094300 ELSE NC1044.2 +094400 GO TO MOVE-FAIL-F1-25. NC1044.2 +094500* NOTE NNI TO NNI MOVE, SCALING. NC1044.2 +094600 GO TO MOVE-WRITE-F1-25. NC1044.2 +094700 MOVE-DELETE-F1-25. NC1044.2 +094800 PERFORM DE-LETE. NC1044.2 +094900 GO TO MOVE-WRITE-F1-25. NC1044.2 +095000 MOVE-FAIL-F1-25. NC1044.2 +095100 MOVE MOVE27 TO COMPUTED-N. NC1044.2 +095200 MOVE 0100 TO CORRECT-N. NC1044.2 +095300 PERFORM FAIL. NC1044.2 +095400 MOVE-WRITE-F1-25. NC1044.2 +095500 MOVE "MOVE-TEST-F1-25" TO PAR-NAME. NC1044.2 +095600 PERFORM PRINT-DETAIL. NC1044.2 +095700 MOVE-INIT-F1-26. NC1044.2 +095800 MOVE 123.45 TO MOVE23. NC1044.2 +095900 MOVE-TEST-F1-26-0. NC1044.2 +096000 MOVE MOVE23 TO MOVE6. NC1044.2 +096100 MOVE-TEST-F1-26-1. NC1044.2 +096200 IF MOVE6 EQUAL TO .45000 NC1044.2 +096300 PERFORM PASS NC1044.2 +096400 ELSE NC1044.2 +096500 GO TO MOVE-FAIL-F1-26. NC1044.2 +096600* NOTE NNI TO NNI MOVE, TRUNCATION ON LEFT AND ZERO NC1044.2 +096700* FILL ON RIGHT. NC1044.2 +096800 GO TO MOVE-WRITE-F1-26. NC1044.2 +096900 MOVE-DELETE-F1-26. NC1044.2 +097000 PERFORM DE-LETE. NC1044.2 +097100 GO TO MOVE-WRITE-F1-26. NC1044.2 +097200 MOVE-FAIL-F1-26. NC1044.2 +097300 MOVE MOVE6 TO COMPUTED-N. NC1044.2 +097400 MOVE .45000 TO CORRECT-N. NC1044.2 +097500 PERFORM FAIL. NC1044.2 +097600 MOVE-WRITE-F1-26. NC1044.2 +097700 MOVE "MOVE-TEST-F1-26" TO PAR-NAME. NC1044.2 +097800 PERFORM PRINT-DETAIL. NC1044.2 +097900 MOVE-INIT-F1-27. NC1044.2 +098000 MOVE 123.45 TO MOVE23. NC1044.2 +098100 MOVE-TEST-F1-27-0. NC1044.2 +098200 MOVE MOVE23 TO MOVE29. NC1044.2 +098300 MOVE-TEST-F1-27-1. NC1044.2 +098400 IF MOVE29 EQUAL TO 0123.450 NC1044.2 +098500 PERFORM PASS NC1044.2 +098600 ELSE NC1044.2 +098700 GO TO MOVE-FAIL-F1-27. NC1044.2 +098800* NOTE NNI TO NNI MOVE, ZERO PADDING ON LEFT AND RIGHT. NC1044.2 +098900 GO TO MOVE-WRITE-F1-27. NC1044.2 +099000 MOVE-DELETE-F1-27. NC1044.2 +099100 PERFORM DE-LETE. NC1044.2 +099200 GO TO MOVE-WRITE-F1-27. NC1044.2 +099300 MOVE-FAIL-F1-27. NC1044.2 +099400 MOVE MOVE29 TO COMPUTED-N. NC1044.2 +099500 MOVE 0123.450 TO CORRECT-N. NC1044.2 +099600 PERFORM FAIL. NC1044.2 +099700 MOVE-WRITE-F1-27. NC1044.2 +099800 MOVE "MOVE-TEST-F1-27" TO PAR-NAME. NC1044.2 +099900 PERFORM PRINT-DETAIL. NC1044.2 +100000 MOVE-INIT-F1-28. NC1044.2 +100100 MOVE 123.45 TO MOVE23. NC1044.2 +100200 MOVE-TEST-F1-28-0. NC1044.2 +100300 MOVE MOVE23 TO MOVE11. NC1044.2 +100400 MOVE-TEST-F1-28-1. NC1044.2 +100500 IF MOVE11 EQUAL TO "$00,123.45" NC1044.2 +100600 PERFORM PASS NC1044.2 +100700 ELSE NC1044.2 +100800 GO TO MOVE-FAIL-F1-28. NC1044.2 +100900* NOTE NNI TO NE MOVE, FIXED INSERTION, ZERO PADDING ON LEFT. NC1044.2 +101000 GO TO MOVE-WRITE-F1-28. NC1044.2 +101100 MOVE-DELETE-F1-28. NC1044.2 +101200 PERFORM DE-LETE. NC1044.2 +101300 GO TO MOVE-WRITE-F1-28. NC1044.2 +101400 MOVE-FAIL-F1-28. NC1044.2 +101500 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +101600 MOVE "$00,123.45" TO CORRECT-A. NC1044.2 +101700 PERFORM FAIL. NC1044.2 +101800 MOVE-WRITE-F1-28. NC1044.2 +101900 MOVE "MOVE-TEST-F1-28" TO PAR-NAME. NC1044.2 +102000 PERFORM PRINT-DETAIL. NC1044.2 +102100 MOVE-INIT-F1-29. NC1044.2 +102200 MOVE 123.45 TO MOVE23. NC1044.2 +102300 MOVE-TEST-F1-29-0. NC1044.2 +102400 MOVE MOVE30 TO MOVE21. NC1044.2 +102500 MOVE-TEST-F1-29-1. NC1044.2 +102600 IF MOVE21 EQUAL TO "$123.45" NC1044.2 +102700 PERFORM PASS NC1044.2 +102800 ELSE NC1044.2 +102900 GO TO MOVE-FAIL-F1-29. NC1044.2 +103000* NOTE NE TO AN MOVE, EQUAL SIZE. NC1044.2 +103100 GO TO MOVE-WRITE-F1-29. NC1044.2 +103200 MOVE-DELETE-F1-29. NC1044.2 +103300 PERFORM DE-LETE. NC1044.2 +103400 GO TO MOVE-WRITE-F1-29. NC1044.2 +103500 MOVE-FAIL-F1-29. NC1044.2 +103600 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +103700 MOVE "$123.45" TO CORRECT-A. NC1044.2 +103800 PERFORM FAIL. NC1044.2 +103900 MOVE-WRITE-F1-29. NC1044.2 +104000 MOVE "MOVE-TEST-F1-29" TO PAR-NAME. NC1044.2 +104100 PERFORM PRINT-DETAIL. NC1044.2 +104200 MOVE-INIT-F1-30. NC1044.2 +104300 MOVE "$123.45" TO MOVE29A. NC1044.2 +104400 MOVE-TEST-F1-30-0. NC1044.2 +104500 MOVE MOVE30 TO MOVE31. NC1044.2 +104600 MOVE-TEST-F1-30-1. NC1044.2 +104700 IF MOVE31 EQUAL TO "$123.45 " NC1044.2 +104800 PERFORM PASS NC1044.2 +104900 ELSE NC1044.2 +105000 GO TO MOVE-FAIL-F1-30. NC1044.2 +105100* NOTE NE TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +105200 GO TO MOVE-WRITE-F1-30. NC1044.2 +105300 MOVE-DELETE-F1-30. NC1044.2 +105400 PERFORM DE-LETE. NC1044.2 +105500 GO TO MOVE-WRITE-F1-30. NC1044.2 +105600 MOVE-FAIL-F1-30. NC1044.2 +105700 MOVE MOVE31 TO COMPUTED-A. NC1044.2 +105800 MOVE "$123.45 " TO CORRECT-A. NC1044.2 +105900 PERFORM FAIL. NC1044.2 +106000 MOVE-WRITE-F1-30. NC1044.2 +106100 MOVE "MOVE-TEST-F1-30" TO PAR-NAME. NC1044.2 +106200 PERFORM PRINT-DETAIL. NC1044.2 +106300 MOVE-INIT-F1-31. NC1044.2 +106400 MOVE "$123.45" TO MOVE29A. NC1044.2 +106500 MOVE-TEST-F1-31-0. NC1044.2 +106600 MOVE MOVE30 TO MOVE20. NC1044.2 +106700 MOVE-TEST-F1-31-1. NC1044.2 +106800 IF MOVE20 EQUAL TO "$123" NC1044.2 +106900 PERFORM PASS NC1044.2 +107000 ELSE NC1044.2 +107100 GO TO MOVE-FAIL-F1-31. NC1044.2 +107200* NOTE NE TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +107300 GO TO MOVE-WRITE-F1-31. NC1044.2 +107400 MOVE-DELETE-F1-31. NC1044.2 +107500 PERFORM DE-LETE. NC1044.2 +107600 GO TO MOVE-WRITE-F1-31. NC1044.2 +107700 MOVE-FAIL-F1-31. NC1044.2 +107800 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +107900 MOVE "$123" TO CORRECT-A. NC1044.2 +108000 PERFORM FAIL. NC1044.2 +108100 MOVE-WRITE-F1-31. NC1044.2 +108200 MOVE "MOVE-TEST-F1-31" TO PAR-NAME. NC1044.2 +108300 PERFORM PRINT-DETAIL. NC1044.2 +108400 MOVE-INIT-F1-32. NC1044.2 +108500 MOVE "$123.45" TO MOVE29A. NC1044.2 +108600 MOVE-TEST-F1-32-0. NC1044.2 +108700 MOVE MOVE30 TO MOVE24. NC1044.2 +108800 MOVE-TEST-F1-32-1. NC1044.2 +108900 IF MOVE24 EQUAL TO "$ 123 000.45 " NC1044.2 +109000 PERFORM PASS NC1044.2 +109100 ELSE NC1044.2 +109200 GO TO MOVE-FAIL-F1-32. NC1044.2 +109300* NOTE NE TO AE MOVE, SPACE AND ZERO INSERTION. NC1044.2 +109400 GO TO MOVE-WRITE-F1-32. NC1044.2 +109500 MOVE-DELETE-F1-32. NC1044.2 +109600 PERFORM DE-LETE. NC1044.2 +109700 GO TO MOVE-WRITE-F1-32. NC1044.2 +109800 MOVE-FAIL-F1-32. NC1044.2 +109900 MOVE MOVE24 TO COMPUTED-A. NC1044.2 +110000 MOVE "$ 123 000.45 " TO CORRECT-A. NC1044.2 +110100 PERFORM FAIL. NC1044.2 +110200 MOVE-WRITE-F1-32. NC1044.2 +110300 MOVE "MOVE-TEST-F1-32" TO PAR-NAME. NC1044.2 +110400 PERFORM PRINT-DETAIL. NC1044.2 +110500 MOVE-INIT-F1-33. NC1044.2 +110600 MOVE "MOVE ALPHANUMERIC " TO FEATURE. NC1044.2 +110700 MOVE "12345" TO MOVE50. NC1044.2 +110800 MOVE-TEST-F1-33-0. NC1044.2 +110900 MOVE MOVE50 TO MOVE2. NC1044.2 +111000 MOVE-TEST-F1-33-1. NC1044.2 +111100 IF MOVE2 EQUAL TO 12345 NC1044.2 +111200 PERFORM PASS NC1044.2 +111300 ELSE NC1044.2 +111400 GO TO MOVE-FAIL-F1-33. NC1044.2 +111500* NOTE AN TO NI MOVE, EQUAL SIZE. NC1044.2 +111600 GO TO MOVE-WRITE-F1-33. NC1044.2 +111700 MOVE-DELETE-F1-33. NC1044.2 +111800 PERFORM DE-LETE. NC1044.2 +111900 GO TO MOVE-WRITE-F1-33. NC1044.2 +112000 MOVE-FAIL-F1-33. NC1044.2 +112100 MOVE MOVE2 TO COMPUTED-N. NC1044.2 +112200 MOVE 12345 TO CORRECT-N. NC1044.2 +112300 PERFORM FAIL. NC1044.2 +112400 MOVE-WRITE-F1-33. NC1044.2 +112500 MOVE "MOVE-TEST-F1-33" TO PAR-NAME. NC1044.2 +112600 PERFORM PRINT-DETAIL. NC1044.2 +112700 MOVE-INIT-F1-34. NC1044.2 +112800 MOVE "12345" TO MOVE50. NC1044.2 +112900 MOVE-TEST-F1-34-0. NC1044.2 +113000 MOVE MOVE50 TO MOVE4. NC1044.2 +113100 MOVE-TEST-F1-34-1. NC1044.2 +113200 IF MOVE4 EQUAL TO 0012345 NC1044.2 +113300 PERFORM PASS NC1044.2 +113400 ELSE NC1044.2 +113500 GO TO MOVE-FAIL-F1-34. NC1044.2 +113600* NOTE AN TO NI MOVE, ZERO PADDING ON LEFT. NC1044.2 +113700 GO TO MOVE-WRITE-F1-34. NC1044.2 +113800 MOVE-DELETE-F1-34. NC1044.2 +113900 PERFORM DE-LETE. NC1044.2 +114000 GO TO MOVE-WRITE-F1-34. NC1044.2 +114100 MOVE-FAIL-F1-34. NC1044.2 +114200 MOVE MOVE4 TO COMPUTED-N. NC1044.2 +114300 MOVE 0012345 TO CORRECT-N. NC1044.2 +114400 PERFORM FAIL. NC1044.2 +114500 MOVE-WRITE-F1-34. NC1044.2 +114600 MOVE "MOVE-TEST-F1-34" TO PAR-NAME. NC1044.2 +114700 PERFORM PRINT-DETAIL. NC1044.2 +114800 MOVE-INIT-F1-35. NC1044.2 +114900 MOVE "12345" TO MOVE50. NC1044.2 +115000 MOVE-TEST-F1-35-0. NC1044.2 +115100 MOVE MOVE50 TO MOVE3. NC1044.2 +115200 MOVE-TEST-F1-35-1. NC1044.2 +115300 IF MOVE3 EQUAL TO 45 NC1044.2 +115400 PERFORM PASS NC1044.2 +115500 ELSE NC1044.2 +115600 GO TO MOVE-FAIL-F1-35. NC1044.2 +115700* NOTE AN TO NI MOVE, TRUNCATION ON LEFT. NC1044.2 +115800 GO TO MOVE-WRITE-F1-35. NC1044.2 +115900 MOVE-DELETE-F1-35. NC1044.2 +116000 PERFORM DE-LETE. NC1044.2 +116100 GO TO MOVE-WRITE-F1-35. NC1044.2 +116200 MOVE-FAIL-F1-35. NC1044.2 +116300 MOVE MOVE50 TO COMPUTED-N. NC1044.2 +116400 MOVE 45 TO CORRECT-N. NC1044.2 +116500 PERFORM FAIL. NC1044.2 +116600 MOVE-WRITE-F1-35. NC1044.2 +116700 MOVE "MOVE-TEST-F1-35" TO PAR-NAME. NC1044.2 +116800 PERFORM PRINT-DETAIL. NC1044.2 +116900 MOVE-INIT-F1-36. NC1044.2 +117000 MOVE "12345" TO MOVE50. NC1044.2 +117100 MOVE-TEST-F1-36-0. NC1044.2 +117200 MOVE MOVE50 TO MOVE26. NC1044.2 +117300 MOVE-TEST-F1-36-1. NC1044.2 +117400 IF MOVE26 EQUAL TO 345.00 NC1044.2 +117500 PERFORM PASS NC1044.2 +117600 ELSE NC1044.2 +117700 GO TO MOVE-FAIL-F1-36. NC1044.2 +117800* NOTE AN TO NNI MOVE, ZERO FILL RIGHT, TRUNCATION LEFT. NC1044.2 +117900 GO TO MOVE-WRITE-F1-36. NC1044.2 +118000 MOVE-DELETE-F1-36. NC1044.2 +118100 PERFORM DE-LETE. NC1044.2 +118200 GO TO MOVE-WRITE-F1-36. NC1044.2 +118300 MOVE-FAIL-F1-36. NC1044.2 +118400 MOVE MOVE26 TO COMPUTED-N. NC1044.2 +118500 MOVE 345.00 TO CORRECT-N. NC1044.2 +118600 PERFORM FAIL. NC1044.2 +118700 MOVE-WRITE-F1-36. NC1044.2 +118800 MOVE "MOVE-TEST-F1-36" TO PAR-NAME. NC1044.2 +118900 PERFORM PRINT-DETAIL. NC1044.2 +119000 MOVE-INIT-F1-37. NC1044.2 +119100 MOVE "12345" TO MOVE50. NC1044.2 +119200 MOVE-TEST-F1-37-0. NC1044.2 +119300 MOVE MOVE50 TO MOVE9. NC1044.2 +119400 MOVE-TEST-F1-37-1. NC1044.2 +119500 IF MOVE9 EQUAL TO 0012345.00 NC1044.2 +119600 PERFORM PASS NC1044.2 +119700 ELSE NC1044.2 +119800 GO TO MOVE-FAIL-F1-37. NC1044.2 +119900* NOTE AN TO NNI MOVE, ZERO PADDING LEFT AND RIGHT. NC1044.2 +120000 GO TO MOVE-WRITE-F1-37. NC1044.2 +120100 MOVE-DELETE-F1-37. NC1044.2 +120200 PERFORM DE-LETE. NC1044.2 +120300 GO TO MOVE-WRITE-F1-37. NC1044.2 +120400 MOVE-FAIL-F1-37. NC1044.2 +120500 MOVE MOVE9 TO COMPUTED-N. NC1044.2 +120600 MOVE 0012345.00 TO CORRECT-N. NC1044.2 +120700 PERFORM FAIL. NC1044.2 +120800 MOVE-WRITE-F1-37. NC1044.2 +120900 MOVE "MOVE-TEST-F1-37" TO PAR-NAME. NC1044.2 +121000 PERFORM PRINT-DETAIL. NC1044.2 +121100 MOVE-INIT-F1-38. NC1044.2 +121200 MOVE "12345" TO MOVE50. NC1044.2 +121300 MOVE-TEST-F1-38-0. NC1044.2 +121400 MOVE MOVE50 TO MOVE16. NC1044.2 +121500 MOVE-TEST-F1-38-1. NC1044.2 +121600 IF MOVE16 EQUAL TO "12345 " NC1044.2 +121700 PERFORM PASS NC1044.2 +121800 ELSE NC1044.2 +121900 GO TO MOVE-FAIL-F1-38. NC1044.2 +122000* NOTE AN TO NE WITH CR SYMBOL. NC1044.2 +122100 GO TO MOVE-WRITE-F1-38. NC1044.2 +122200 MOVE-DELETE-F1-38. NC1044.2 +122300 PERFORM DE-LETE. NC1044.2 +122400 GO TO MOVE-WRITE-F1-38. NC1044.2 +122500 MOVE-FAIL-F1-38. NC1044.2 +122600 MOVE MOVE16 TO COMPUTED-A. NC1044.2 +122700 MOVE "12345 " TO CORRECT-A. NC1044.2 +122800 PERFORM FAIL. NC1044.2 +122900 MOVE-WRITE-F1-38. NC1044.2 +123000 MOVE "MOVE-TEST-F1-38" TO PAR-NAME. NC1044.2 +123100 PERFORM PRINT-DETAIL. NC1044.2 +123200 MOVE-INIT-F1-39. NC1044.2 +123300 MOVE "12345" TO MOVE50. NC1044.2 +123400 MOVE-TEST-F1-39-0. NC1044.2 +123500 MOVE MOVE50 TO MOVE11. NC1044.2 +123600 MOVE-TEST-F1-39-1. NC1044.2 +123700 IF MOVE11 EQUAL TO "$12,345.00" NC1044.2 +123800 PERFORM PASS NC1044.2 +123900 ELSE NC1044.2 +124000 GO TO MOVE-FAIL-F1-39. NC1044.2 +124100* NOTE AN TO NNI MOVE, INSERTION CHARACTERS AND ZERO PADDING NC1044.2 +124200* ON RIGHT. NC1044.2 +124300 GO TO MOVE-WRITE-F1-39. NC1044.2 +124400 MOVE-DELETE-F1-39. NC1044.2 +124500 PERFORM DE-LETE. NC1044.2 +124600 GO TO MOVE-WRITE-F1-39. NC1044.2 +124700 MOVE-FAIL-F1-39. NC1044.2 +124800 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +124900 MOVE "$12,345.00" TO CORRECT-A. NC1044.2 +125000 PERFORM FAIL. NC1044.2 +125100 MOVE-WRITE-F1-39. NC1044.2 +125200 MOVE "MOVE-TEST-F1-39" TO PAR-NAME. NC1044.2 +125300 PERFORM PRINT-DETAIL. NC1044.2 +125400 MOVE-INIT-F1-40. NC1044.2 +125500 MOVE "ABCDE" TO MOVE32. NC1044.2 +125600 MOVE-TEST-F1-40-0. NC1044.2 +125700 MOVE MOVE32 TO MOVE21. NC1044.2 +125800 MOVE-TEST-F1-40-1. NC1044.2 +125900 IF MOVE21 EQUAL TO "ABCDE " NC1044.2 +126000 PERFORM PASS NC1044.2 +126100 ELSE NC1044.2 +126200 GO TO MOVE-FAIL-F1-40. NC1044.2 +126300* NOTE AN TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +126400 GO TO MOVE-WRITE-F1-40. NC1044.2 +126500 MOVE-DELETE-F1-40. NC1044.2 +126600 PERFORM DE-LETE. NC1044.2 +126700 GO TO MOVE-WRITE-F1-40. NC1044.2 +126800 MOVE-FAIL-F1-40. NC1044.2 +126900 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +127000 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +127100 PERFORM FAIL. NC1044.2 +127200 MOVE-WRITE-F1-40. NC1044.2 +127300 MOVE "MOVE-TEST-F1-40" TO PAR-NAME. NC1044.2 +127400 PERFORM PRINT-DETAIL. NC1044.2 +127500 MOVE-INIT-F1-41. NC1044.2 +127600 MOVE "ABCDE" TO MOVE32. NC1044.2 +127700 MOVE-TEST-F1-41-0. NC1044.2 +127800 MOVE MOVE32 TO MOVE20. NC1044.2 +127900 MOVE-TEST-F1-41-1. NC1044.2 +128000 IF MOVE20 EQUAL TO "ABCD" NC1044.2 +128100 PERFORM PASS NC1044.2 +128200 ELSE NC1044.2 +128300 GO TO MOVE-FAIL-F1-41. NC1044.2 +128400* NOTE AN TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +128500 GO TO MOVE-WRITE-F1-41. NC1044.2 +128600 MOVE-DELETE-F1-41. NC1044.2 +128700 PERFORM DE-LETE. NC1044.2 +128800 GO TO MOVE-WRITE-F1-41. NC1044.2 +128900 MOVE-FAIL-F1-41. NC1044.2 +129000 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +129100 MOVE "ABCD" TO CORRECT-A. NC1044.2 +129200 PERFORM FAIL. NC1044.2 +129300 MOVE-WRITE-F1-41. NC1044.2 +129400 MOVE "MOVE-TEST-F1-41" TO PAR-NAME. NC1044.2 +129500 PERFORM PRINT-DETAIL. NC1044.2 +129600 MOVE-INIT-F1-42. NC1044.2 +129700 MOVE "ABCDE" TO MOVE32. NC1044.2 +129800 MOVE-TEST-F1-42-0. NC1044.2 +129900 MOVE MOVE32 TO MOVE22. NC1044.2 +130000 MOVE-TEST-F1-42-1. NC1044.2 +130100 IF MOVE22 EQUAL TO "A B0C D0E" NC1044.2 +130200 PERFORM PASS NC1044.2 +130300 ELSE NC1044.2 +130400 GO TO MOVE-FAIL-F1-42. NC1044.2 +130500* NOTE AN TO AE MOVE, ZERO AND SPACE INSERTION. NC1044.2 +130600 GO TO MOVE-WRITE-F1-42. NC1044.2 +130700 MOVE-DELETE-F1-42. NC1044.2 +130800 PERFORM DE-LETE. NC1044.2 +130900 GO TO MOVE-WRITE-F1-42. NC1044.2 +131000 MOVE-FAIL-F1-42. NC1044.2 +131100 MOVE MOVE22 TO COMPUTED-A. NC1044.2 +131200 MOVE "A B0C D0E" TO CORRECT-A. NC1044.2 +131300 PERFORM FAIL. NC1044.2 +131400 MOVE-WRITE-F1-42. NC1044.2 +131500 MOVE "MOVE-TEST-F1-42" TO PAR-NAME. NC1044.2 +131600 PERFORM PRINT-DETAIL. NC1044.2 +131700 MOVE-INIT-F1-43. NC1044.2 +131800 MOVE "ABCDE" TO MOVE32. NC1044.2 +131900 MOVE-TEST-F1-43-0. NC1044.2 +132000 MOVE MOVE32 TO MOVE33. NC1044.2 +132100 MOVE-TEST-F1-43-1. NC1044.2 +132200 IF MOVE33 EQUAL TO "ABCDE" NC1044.2 +132300 PERFORM PASS NC1044.2 +132400 ELSE NC1044.2 +132500 GO TO MOVE-FAIL-F1-43. NC1044.2 +132600* NOTE AN TO A MOVE, EQUAL SIZE. NC1044.2 +132700 GO TO MOVE-WRITE-F1-43. NC1044.2 +132800 MOVE-DELETE-F1-43. NC1044.2 +132900 PERFORM DE-LETE. NC1044.2 +133000 GO TO MOVE-WRITE-F1-43. NC1044.2 +133100 MOVE-FAIL-F1-43. NC1044.2 +133200 MOVE MOVE33 TO COMPUTED-A. NC1044.2 +133300 MOVE "ABCDE" TO CORRECT-A. NC1044.2 +133400 PERFORM FAIL. NC1044.2 +133500 MOVE-WRITE-F1-43. NC1044.2 +133600 MOVE "MOVE-TEST-F1-43" TO PAR-NAME. NC1044.2 +133700 PERFORM PRINT-DETAIL. NC1044.2 +133800 MOVE-INIT-F1-44. NC1044.2 +133900 MOVE "ABCDE" TO MOVE32. NC1044.2 +134000 MOVE-TEST-F1-44-0. NC1044.2 +134100 MOVE MOVE32 TO MOVE34. NC1044.2 +134200 MOVE-TEST-F1-44-1. NC1044.2 +134300 IF MOVE34 EQUAL TO "ABCDE " NC1044.2 +134400 PERFORM PASS NC1044.2 +134500 ELSE NC1044.2 +134600 GO TO MOVE-FAIL-F1-44. NC1044.2 +134700* NOTE AN TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +134800 GO TO MOVE-WRITE-F1-44. NC1044.2 +134900 MOVE-DELETE-F1-44. NC1044.2 +135000 PERFORM DE-LETE. NC1044.2 +135100 GO TO MOVE-WRITE-F1-44. NC1044.2 +135200 MOVE-FAIL-F1-44. NC1044.2 +135300 MOVE MOVE34 TO COMPUTED-A. NC1044.2 +135400 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +135500 PERFORM FAIL. NC1044.2 +135600 MOVE-WRITE-F1-44. NC1044.2 +135700 MOVE "MOVE-TEST-F1-44" TO PAR-NAME. NC1044.2 +135800 PERFORM PRINT-DETAIL. NC1044.2 +135900 MOVE-INIT-F1-45. NC1044.2 +136000 MOVE "ABCDE" TO MOVE32. NC1044.2 +136100 MOVE-TEST-F1-45-0. NC1044.2 +136200 MOVE MOVE32 TO MOVE35. NC1044.2 +136300 MOVE-TEST-F1-45-1. NC1044.2 +136400 IF MOVE35 EQUAL TO "ABC" NC1044.2 +136500 PERFORM PASS NC1044.2 +136600 ELSE NC1044.2 +136700 GO TO MOVE-FAIL-F1-45. NC1044.2 +136800* NOTE AN TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +136900 GO TO MOVE-WRITE-F1-45. NC1044.2 +137000 MOVE-DELETE-F1-45. NC1044.2 +137100 PERFORM DE-LETE. NC1044.2 +137200 GO TO MOVE-WRITE-F1-45. NC1044.2 +137300 MOVE-FAIL-F1-45. NC1044.2 +137400 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +137500 MOVE "ABC" TO CORRECT-A. NC1044.2 +137600 PERFORM FAIL. NC1044.2 +137700 MOVE-WRITE-F1-45. NC1044.2 +137800 MOVE "MOVE-TEST-F1-45" TO PAR-NAME. NC1044.2 +137900 PERFORM PRINT-DETAIL. NC1044.2 +138000 MOVE-INIT-F1-46. NC1044.2 +138100 MOVE "1 A05" TO MOVE35A. NC1044.2 +138200 MOVE-TEST-F1-46-0. NC1044.2 +138300 MOVE MOVE36 TO MOVE21. NC1044.2 +138400 MOVE-TEST-F1-46-1. NC1044.2 +138500 IF MOVE21 EQUAL TO "1 A05 " NC1044.2 +138600 PERFORM PASS NC1044.2 +138700 ELSE NC1044.2 +138800 GO TO MOVE-FAIL-F1-46. NC1044.2 +138900* NOTE AE TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +139000 GO TO MOVE-WRITE-F1-46. NC1044.2 +139100 MOVE-DELETE-F1-46. NC1044.2 +139200 PERFORM DE-LETE. NC1044.2 +139300 GO TO MOVE-WRITE-F1-46. NC1044.2 +139400 MOVE-FAIL-F1-46. NC1044.2 +139500 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +139600 MOVE "1 A05 " TO CORRECT-A. NC1044.2 +139700 PERFORM FAIL. NC1044.2 +139800 MOVE-WRITE-F1-46. NC1044.2 +139900 MOVE "MOVE-TEST-F1-46" TO PAR-NAME. NC1044.2 +140000 PERFORM PRINT-DETAIL. NC1044.2 +140100 MOVE-INIT-F1-47. NC1044.2 +140200 MOVE "1 A05" TO MOVE35A. NC1044.2 +140300 MOVE-TEST-F1-47-0. NC1044.2 +140400 MOVE MOVE36 TO MOVE20. NC1044.2 +140500 MOVE-TEST-F1-47-1. NC1044.2 +140600 IF MOVE20 EQUAL TO "1 A0" NC1044.2 +140700 PERFORM PASS NC1044.2 +140800 ELSE NC1044.2 +140900 GO TO MOVE-FAIL-F1-47. NC1044.2 +141000* NOTE AE TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +141100 GO TO MOVE-WRITE-F1-47. NC1044.2 +141200 MOVE-DELETE-F1-47. NC1044.2 +141300 PERFORM DE-LETE. NC1044.2 +141400 GO TO MOVE-WRITE-F1-47. NC1044.2 +141500 MOVE-FAIL-F1-47. NC1044.2 +141600 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +141700 MOVE "1 A0" TO CORRECT-A. NC1044.2 +141800 PERFORM FAIL. NC1044.2 +141900 MOVE-WRITE-F1-47. NC1044.2 +142000 MOVE "MOVE-TEST-F1-47" TO PAR-NAME. NC1044.2 +142100 PERFORM PRINT-DETAIL. NC1044.2 +142200 MOVE-INIT-F1-48. NC1044.2 +142300 MOVE "1 A05" TO MOVE35A. NC1044.2 +142400 MOVE-TEST-F1-48-0. NC1044.2 +142500 MOVE MOVE36 TO MOVE39. NC1044.2 +142600 MOVE-TEST-F1-48-1. NC1044.2 +142700 IF MOVE39 EQUAL TO "01 A050" NC1044.2 +142800 PERFORM PASS NC1044.2 +142900 ELSE NC1044.2 +143000 GO TO MOVE-FAIL-F1-48. NC1044.2 +143100* NOTE AE TO AE MOVE, ZERO INSERTION. NC1044.2 +143200 GO TO MOVE-WRITE-F1-48. NC1044.2 +143300 MOVE-DELETE-F1-48. NC1044.2 +143400 PERFORM DE-LETE. NC1044.2 +143500 GO TO MOVE-WRITE-F1-48. NC1044.2 +143600 MOVE-FAIL-F1-48. NC1044.2 +143700 MOVE MOVE39 TO COMPUTED-A. NC1044.2 +143800 MOVE "01 A050" TO CORRECT-A. NC1044.2 +143900 PERFORM FAIL. NC1044.2 +144000 MOVE-WRITE-F1-48. NC1044.2 +144100 MOVE "MOVE-TEST-F1-48" TO PAR-NAME. NC1044.2 +144200 PERFORM PRINT-DETAIL. NC1044.2 +144300 MOVE-INIT-F1-49. NC1044.2 +144400 MOVE "1 A05" TO MOVE35A. NC1044.2 +144500 MOVE-TEST-F1-49-0. NC1044.2 +144600 MOVE MOVE35A TO MOVE33. NC1044.2 +144700 MOVE-TEST-F1-49-1. NC1044.2 +144800 IF MOVE33 EQUAL TO "1 A05" NC1044.2 +144900 PERFORM PASS NC1044.2 +145000 ELSE NC1044.2 +145100 GO TO MOVE-FAIL-F1-49. NC1044.2 +145200* NOTE AE TO A MOVE, EQUAL SIZE. NC1044.2 +145300 GO TO MOVE-WRITE-F1-49. NC1044.2 +145400 MOVE-DELETE-F1-49. NC1044.2 +145500 PERFORM DE-LETE. NC1044.2 +145600 GO TO MOVE-WRITE-F1-49. NC1044.2 +145700 MOVE-FAIL-F1-49. NC1044.2 +145800 MOVE MOVE33 TO COMPUTED-A. NC1044.2 +145900 MOVE "1 A05" TO CORRECT-A. NC1044.2 +146000 PERFORM FAIL. NC1044.2 +146100 MOVE-WRITE-F1-49. NC1044.2 +146200 MOVE "MOVE-TEST-F1-49" TO PAR-NAME. NC1044.2 +146300 PERFORM PRINT-DETAIL. NC1044.2 +146400 MOVE-INIT-F1-50. NC1044.2 +146500 MOVE "1 A05" TO MOVE35A. NC1044.2 +146600 MOVE-TEST-F1-50-0. NC1044.2 +146700 MOVE MOVE35A TO MOVE34. NC1044.2 +146800 MOVE-TEST-F1-50-1. NC1044.2 +146900 IF MOVE34 EQUAL TO "1 A05 " NC1044.2 +147000 PERFORM PASS NC1044.2 +147100 ELSE NC1044.2 +147200 GO TO MOVE-FAIL-F1-50. NC1044.2 +147300* NOTE AE TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +147400 GO TO MOVE-WRITE-F1-50. NC1044.2 +147500 MOVE-DELETE-F1-50. NC1044.2 +147600 PERFORM DE-LETE. NC1044.2 +147700 GO TO MOVE-WRITE-F1-50. NC1044.2 +147800 MOVE-FAIL-F1-50. NC1044.2 +147900 MOVE MOVE34 TO COMPUTED-A. NC1044.2 +148000 MOVE "1 A05 " TO CORRECT-A. NC1044.2 +148100 PERFORM FAIL. NC1044.2 +148200 MOVE-WRITE-F1-50. NC1044.2 +148300 MOVE "MOVE-TEST-F1-50" TO PAR-NAME. NC1044.2 +148400 PERFORM PRINT-DETAIL. NC1044.2 +148500 MOVE-INIT-F1-51. NC1044.2 +148600 MOVE "1 A05" TO MOVE35A. NC1044.2 +148700 MOVE-TEST-F1-51-0. NC1044.2 +148800 MOVE MOVE35A TO MOVE35. NC1044.2 +148900 MOVE-TEST-F1-51-1. NC1044.2 +149000 IF MOVE35 EQUAL TO "1 A" NC1044.2 +149100 PERFORM PASS NC1044.2 +149200 ELSE NC1044.2 +149300 GO TO MOVE-FAIL-F1-51. NC1044.2 +149400* NOTE AE TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +149500 GO TO MOVE-WRITE-F1-51. NC1044.2 +149600 MOVE-DELETE-F1-51. NC1044.2 +149700 PERFORM DE-LETE. NC1044.2 +149800 GO TO MOVE-WRITE-F1-51. NC1044.2 +149900 MOVE-FAIL-F1-51. NC1044.2 +150000 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +150100 MOVE "1 A" TO CORRECT-A. NC1044.2 +150200 PERFORM FAIL. NC1044.2 +150300 MOVE-WRITE-F1-51. NC1044.2 +150400 MOVE "MOVE-TEST-F1-51" TO PAR-NAME. NC1044.2 +150500 PERFORM PRINT-DETAIL. NC1044.2 +150600 MOVE-INIT-F1-52. NC1044.2 +150700 MOVE "ABCDE" TO MOVE37. NC1044.2 +150800 MOVE "MOVE ALPHABETIC " TO FEATURE. NC1044.2 +150900 MOVE-TEST-F1-52-0. NC1044.2 +151000 MOVE MOVE37 TO MOVE21. NC1044.2 +151100 MOVE-TEST-F1-52-1. NC1044.2 +151200 IF MOVE21 EQUAL TO "ABCDE " NC1044.2 +151300 PERFORM PASS NC1044.2 +151400 ELSE NC1044.2 +151500 GO TO MOVE-FAIL-F1-52. NC1044.2 +151600* NOTE A TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +151700 GO TO MOVE-WRITE-F1-52. NC1044.2 +151800 MOVE-DELETE-F1-52. NC1044.2 +151900 PERFORM DE-LETE. NC1044.2 +152000 GO TO MOVE-WRITE-F1-52. NC1044.2 +152100 MOVE-FAIL-F1-52. NC1044.2 +152200 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +152300 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +152400 PERFORM FAIL. NC1044.2 +152500 MOVE-WRITE-F1-52. NC1044.2 +152600 MOVE "MOVE-TEST-F1-52" TO PAR-NAME. NC1044.2 +152700 PERFORM PRINT-DETAIL. NC1044.2 +152800 MOVE-INIT-F1-53. NC1044.2 +152900 MOVE "ABCDE" TO MOVE37. NC1044.2 +153000 MOVE-TEST-F1-53-0. NC1044.2 +153100 MOVE MOVE37 TO MOVE20. NC1044.2 +153200 MOVE-TEST-F1-53-1. NC1044.2 +153300 IF MOVE20 EQUAL TO "ABCD" NC1044.2 +153400 PERFORM PASS NC1044.2 +153500 ELSE NC1044.2 +153600 GO TO MOVE-FAIL-F1-53. NC1044.2 +153700* NOTE A TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +153800 GO TO MOVE-WRITE-F1-53. NC1044.2 +153900 MOVE-DELETE-F1-53. NC1044.2 +154000 PERFORM DE-LETE. NC1044.2 +154100 GO TO MOVE-WRITE-F1-53. NC1044.2 +154200 MOVE-FAIL-F1-53. NC1044.2 +154300 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +154400 MOVE "ABCD" TO CORRECT-A. NC1044.2 +154500 PERFORM FAIL. NC1044.2 +154600 MOVE-WRITE-F1-53. NC1044.2 +154700 MOVE "MOVE-TEST-F1-53" TO PAR-NAME. NC1044.2 +154800 PERFORM PRINT-DETAIL. NC1044.2 +154900 MOVE-INIT-F1-54. NC1044.2 +155000 MOVE "ABCDE" TO MOVE37. NC1044.2 +155100 MOVE-TEST-F1-54-0. NC1044.2 +155200 MOVE MOVE37 TO MOVE39. NC1044.2 +155300 MOVE-TEST-F1-54-1. NC1044.2 +155400 IF MOVE39 EQUAL TO "0ABCDE0" NC1044.2 +155500 PERFORM PASS NC1044.2 +155600 ELSE NC1044.2 +155700 GO TO MOVE-FAIL-F1-54. NC1044.2 +155800* NOTE A TO AE MOVE, ZERO INSERTION. NC1044.2 +155900 GO TO MOVE-WRITE-F1-54. NC1044.2 +156000 MOVE-DELETE-F1-54. NC1044.2 +156100 PERFORM DE-LETE. NC1044.2 +156200 GO TO MOVE-WRITE-F1-54. NC1044.2 +156300 MOVE-FAIL-F1-54. NC1044.2 +156400 MOVE MOVE39 TO COMPUTED-A. NC1044.2 +156500 MOVE "0ABCDE0" TO CORRECT-A. NC1044.2 +156600 PERFORM FAIL. NC1044.2 +156700 MOVE-WRITE-F1-54. NC1044.2 +156800 MOVE "MOVE-TEST-F1-54" TO PAR-NAME. NC1044.2 +156900 PERFORM PRINT-DETAIL. NC1044.2 +157000 MOVE-INIT-F1-55. NC1044.2 +157100 MOVE "ABCDE" TO MOVE37. NC1044.2 +157200 MOVE-TEST-F1-55-0. NC1044.2 +157300 MOVE MOVE37 TO MOVE34. NC1044.2 +157400 MOVE-TEST-F1-55-1. NC1044.2 +157500 IF MOVE34 EQUAL TO "ABCDE " NC1044.2 +157600 PERFORM PASS NC1044.2 +157700 ELSE NC1044.2 +157800 GO TO MOVE-FAIL-F1-55. NC1044.2 +157900* NOTE A TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +158000 GO TO MOVE-WRITE-F1-55. NC1044.2 +158100 MOVE-DELETE-F1-55. NC1044.2 +158200 PERFORM DE-LETE. NC1044.2 +158300 GO TO MOVE-WRITE-F1-55. NC1044.2 +158400 MOVE-FAIL-F1-55. NC1044.2 +158500 MOVE MOVE4 TO COMPUTED-A. NC1044.2 +158600 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +158700 PERFORM FAIL. NC1044.2 +158800 MOVE-WRITE-F1-55. NC1044.2 +158900 MOVE "MOVE-TEST-F1-55" TO PAR-NAME. NC1044.2 +159000 PERFORM PRINT-DETAIL. NC1044.2 +159100 MOVE-INIT-F1-56. NC1044.2 +159200 MOVE "ABCDE" TO MOVE37. NC1044.2 +159300 MOVE-TEST-F1-56-0. NC1044.2 +159400 MOVE MOVE37 TO MOVE35. NC1044.2 +159500 MOVE-TEST-F1-56-1. NC1044.2 +159600 IF MOVE35 EQUAL TO "ABC" NC1044.2 +159700 PERFORM PASS NC1044.2 +159800 ELSE NC1044.2 +159900 GO TO MOVE-FAIL-F1-56. NC1044.2 +160000* NOTE A TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +160100 GO TO MOVE-WRITE-F1-56. NC1044.2 +160200 MOVE-DELETE-F1-56. NC1044.2 +160300 PERFORM DE-LETE. NC1044.2 +160400 GO TO MOVE-WRITE-F1-56. NC1044.2 +160500 MOVE-FAIL-F1-56. NC1044.2 +160600 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +160700 MOVE "ABC" TO CORRECT-A. NC1044.2 +160800 PERFORM FAIL. NC1044.2 +160900 MOVE-WRITE-F1-56. NC1044.2 +161000 MOVE "MOVE-TEST-F1-56" TO PAR-NAME. NC1044.2 +161100 PERFORM PRINT-DETAIL. NC1044.2 +161200 NUMERIC-OPERAND-LIMITS-TESTS SECTION. NC1044.2 +161300 MOVE-INIT-F1-57-1. NC1044.2 +161400 MOVE "MOVE LIMITS TESTS " TO FEATURE. NC1044.2 +161500 MOVE 1 TO DNAME1. NC1044.2 +161600* NOTE THE FOLLOWING 44 TESTS WILL TEST THE LIMITS OF NC1044.2 +161700* THE MOVE STATEMENT WITH OVER 20 OPERANDS, A DELETION NC1044.2 +161800* PLACED IN THIS PARAGRAPH WILL SKIP THE LIMITS TESTS NC1044.2 +161900* BUT A NOTE STATEMENT MAY NEED TO BE PLACED IN EACH TEST.NC1044.2 +162000 GO TO MOVE-TEST-F1-57-0. NC1044.2 +162100 MOVE-INIT-DELETE-F1-57-1. NC1044.2 +162200 PERFORM DE-LETE. NC1044.2 +162300 MOVE "MOVE LIMITS TESTS " TO FEATURE. NC1044.2 +162400 MOVE "MOVE-TEST, F1-57-1 THRU F1-58-21" TO PAR-NAME. NC1044.2 +162500 PERFORM PRINT-DETAIL. NC1044.2 +162600 ADD 43 TO DELETE-COUNTER. NC1044.2 +162700 GO TO MOVE-INIT-F1-58. NC1044.2 +162800 MOVE-TEST-F1-57-0. NC1044.2 +162900 MOVE DNAME1 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26 NC1044.2 +163000 DNAME27 DNAME28 DNAME29 DNAME30 DNAME31 DNAME32 NC1044.2 +163100 DNAME33 DNAME34 DNAME35 DNAME36 DNAME37 DNAME38 NC1044.2 +163200 DNAME39 DNAME40 DNAME41 DNAME42 DNAME19. NC1044.2 +163300 MOVE-TEST-F1-57-1. NC1044.2 +163400 IF DNAME19 EQUAL TO 1 NC1044.2 +163500 PERFORM PASS NC1044.2 +163600 GO TO MOVE-WRITE-F1-57-1. NC1044.2 +163700 MOVE 1 TO CORRECT-18V0. NC1044.2 +163800 MOVE DNAME19 TO COMPUTED-18V0. NC1044.2 +163900 PERFORM FAIL. NC1044.2 +164000 GO TO MOVE-WRITE-F1-57-1. NC1044.2 +164100 MOVE-DELETE-F1-57-1. NC1044.2 +164200 PERFORM DE-LETE. NC1044.2 +164300* NOTE *** A DELETE IN THIS TEST WILL CAUSE THE NEXT NC1044.2 +164400* 43 TESTS TO FAIL. NC1044.2 +164500 MOVE-WRITE-F1-57-1. NC1044.2 +164600 MOVE "MOVE-TEST-F1-57-1 " TO PAR-NAME. NC1044.2 +164700 PERFORM PRINT-DETAIL. NC1044.2 +164800 MOVE-TEST-F1-57-2. NC1044.2 +164900 IF DNAME22 EQUAL TO 1 NC1044.2 +165000 PERFORM PASS NC1044.2 +165100 GO TO MOVE-WRITE-F1-57-2. NC1044.2 +165200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +165300 MOVE DNAME22 TO COMPUTED-18V0. NC1044.2 +165400 MOVE 1 TO CORRECT-18V0. NC1044.2 +165500 PERFORM FAIL. NC1044.2 +165600 GO TO MOVE-WRITE-F1-57-2. NC1044.2 +165700 MOVE-DELETE-F1-57-2. NC1044.2 +165800 PERFORM DE-LETE. NC1044.2 +165900 MOVE-WRITE-F1-57-2. NC1044.2 +166000 MOVE "MOVE-TEST-F1-57-2 " TO PAR-NAME. NC1044.2 +166100 PERFORM PRINT-DETAIL. NC1044.2 +166200 MOVE-TEST-F1-57-3. NC1044.2 +166300 IF DNAME23 EQUAL TO 1 NC1044.2 +166400 PERFORM PASS NC1044.2 +166500 GO TO MOVE-WRITE-F1-57-3. NC1044.2 +166600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +166700 MOVE DNAME23 TO COMPUTED-18V0. NC1044.2 +166800 MOVE 1 TO CORRECT-18V0. NC1044.2 +166900 PERFORM FAIL. NC1044.2 +167000 GO TO MOVE-WRITE-F1-57-3. NC1044.2 +167100 MOVE-DELETE-F1-57-3. NC1044.2 +167200 PERFORM DE-LETE. NC1044.2 +167300 MOVE-WRITE-F1-57-3. NC1044.2 +167400 MOVE "MOVE-TEST-F1-57-3 " TO PAR-NAME. NC1044.2 +167500 PERFORM PRINT-DETAIL. NC1044.2 +167600 MOVE-TEST-F1-57-4. NC1044.2 +167700 IF DNAME24 EQUAL TO 1 NC1044.2 +167800 PERFORM PASS NC1044.2 +167900 GO TO MOVE-WRITE-F1-57-4. NC1044.2 +168000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +168100 MOVE DNAME24 TO COMPUTED-18V0. NC1044.2 +168200 MOVE 1 TO CORRECT-18V0. NC1044.2 +168300 PERFORM FAIL. NC1044.2 +168400 GO TO MOVE-WRITE-F1-57-4. NC1044.2 +168500 MOVE-DELETE-F1-57-4. NC1044.2 +168600 PERFORM DE-LETE. NC1044.2 +168700 MOVE-WRITE-F1-57-4. NC1044.2 +168800 MOVE "MOVE-TEST-F1-57-4 " TO PAR-NAME. NC1044.2 +168900 PERFORM PRINT-DETAIL. NC1044.2 +169000 MOVE-TEST-F1-57-5. NC1044.2 +169100 IF DNAME25 EQUAL TO 1 NC1044.2 +169200 PERFORM PASS NC1044.2 +169300 GO TO MOVE-WRITE-F1-57-5. NC1044.2 +169400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +169500 MOVE DNAME25 TO COMPUTED-18V0. NC1044.2 +169600 MOVE 1 TO CORRECT-18V0. NC1044.2 +169700 PERFORM FAIL. NC1044.2 +169800 GO TO MOVE-WRITE-F1-57-5. NC1044.2 +169900 MOVE-DELETE-F1-57-5. NC1044.2 +170000 PERFORM DE-LETE. NC1044.2 +170100 MOVE-WRITE-F1-57-5. NC1044.2 +170200 MOVE "MOVE-TEST-F1-57-5 " TO PAR-NAME. NC1044.2 +170300 PERFORM PRINT-DETAIL. NC1044.2 +170400 MOVE-TEST-F1-57-6. NC1044.2 +170500 IF DNAME26 EQUAL TO 1 NC1044.2 +170600 PERFORM PASS NC1044.2 +170700 GO TO MOVE-WRITE-F1-57-6. NC1044.2 +170800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +170900 MOVE DNAME26 TO COMPUTED-18V0. NC1044.2 +171000 MOVE 1 TO CORRECT-18V0. NC1044.2 +171100 PERFORM FAIL. NC1044.2 +171200 GO TO MOVE-WRITE-F1-57-6. NC1044.2 +171300 MOVE-DELETE-F1-57-6. NC1044.2 +171400 PERFORM DE-LETE. NC1044.2 +171500 MOVE-WRITE-F1-57-6. NC1044.2 +171600 MOVE "MOVE-TEST-F1-57-6 " TO PAR-NAME. NC1044.2 +171700 PERFORM PRINT-DETAIL. NC1044.2 +171800 MOVE-TEST-F1-57-7. NC1044.2 +171900 IF DNAME27 EQUAL TO 1 NC1044.2 +172000 PERFORM PASS NC1044.2 +172100 GO TO MOVE-WRITE-F1-57-7. NC1044.2 +172200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +172300 MOVE DNAME27 TO COMPUTED-18V0. NC1044.2 +172400 MOVE 1 TO CORRECT-18V0. NC1044.2 +172500 PERFORM FAIL. NC1044.2 +172600 GO TO MOVE-WRITE-F1-57-7. NC1044.2 +172700 MOVE-DELETE-F1-57-7. NC1044.2 +172800 PERFORM DE-LETE. NC1044.2 +172900 MOVE-WRITE-F1-57-7. NC1044.2 +173000 MOVE "MOVE-TEST-F1-57-7 " TO PAR-NAME. NC1044.2 +173100 PERFORM PRINT-DETAIL. NC1044.2 +173200 MOVE-TEST-F1-57-8. NC1044.2 +173300 IF DNAME28 EQUAL TO 1 NC1044.2 +173400 PERFORM PASS NC1044.2 +173500 GO TO MOVE-WRITE-F1-57-8. NC1044.2 +173600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +173700 MOVE DNAME28 TO COMPUTED-18V0. NC1044.2 +173800 MOVE 1 TO CORRECT-18V0. NC1044.2 +173900 PERFORM FAIL. NC1044.2 +174000 GO TO MOVE-WRITE-F1-57-8. NC1044.2 +174100 MOVE-DELETE-F1-57-8. NC1044.2 +174200 PERFORM DE-LETE. NC1044.2 +174300 MOVE-WRITE-F1-57-8. NC1044.2 +174400 MOVE "MOVE-TEST-F1-57-8 " TO PAR-NAME. NC1044.2 +174500 PERFORM PRINT-DETAIL. NC1044.2 +174600 MOVE-TEST-F1-57-9. NC1044.2 +174700 IF DNAME29 EQUAL TO 1 NC1044.2 +174800 PERFORM PASS NC1044.2 +174900 GO TO MOVE-WRITE-F1-57-9. NC1044.2 +175000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +175100 MOVE DNAME29 TO COMPUTED-18V0. NC1044.2 +175200 MOVE 1 TO CORRECT-18V0. NC1044.2 +175300 PERFORM FAIL. NC1044.2 +175400 GO TO MOVE-WRITE-F1-57-9. NC1044.2 +175500 MOVE-DELETE-F1-57-9. NC1044.2 +175600 PERFORM DE-LETE. NC1044.2 +175700 MOVE-WRITE-F1-57-9. NC1044.2 +175800 MOVE "MOVE-TEST-F1-57-9 " TO PAR-NAME. NC1044.2 +175900 PERFORM PRINT-DETAIL. NC1044.2 +176000 MOVE-TEST-F1-57-10. NC1044.2 +176100 IF DNAME30 EQUAL TO 1 NC1044.2 +176200 PERFORM PASS NC1044.2 +176300 GO TO MOVE-WRITE-F1-57-10. NC1044.2 +176400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +176500 MOVE DNAME30 TO COMPUTED-18V0. NC1044.2 +176600 MOVE 1 TO CORRECT-18V0. NC1044.2 +176700 PERFORM FAIL. NC1044.2 +176800 GO TO MOVE-WRITE-F1-57-10. NC1044.2 +176900 MOVE-DELETE-F1-57-10. NC1044.2 +177000 PERFORM DE-LETE. NC1044.2 +177100 MOVE-WRITE-F1-57-10. NC1044.2 +177200 MOVE "MOVE-TEST-F1-57-10 " TO PAR-NAME. NC1044.2 +177300 PERFORM PRINT-DETAIL. NC1044.2 +177400 MOVE-TEST-F1-57-11. NC1044.2 +177500 IF DNAME31 EQUAL TO 1 NC1044.2 +177600 PERFORM PASS NC1044.2 +177700 GO TO MOVE-WRITE-F1-57-11. NC1044.2 +177800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +177900 MOVE DNAME31 TO COMPUTED-18V0. NC1044.2 +178000 MOVE 1 TO CORRECT-18V0. NC1044.2 +178100 PERFORM FAIL. NC1044.2 +178200 GO TO MOVE-WRITE-F1-57-11. NC1044.2 +178300 MOVE-DELETE-F1-57-11. NC1044.2 +178400 PERFORM DE-LETE. NC1044.2 +178500 MOVE-WRITE-F1-57-11. NC1044.2 +178600 MOVE "MOVE-TEST-F1-57-11 " TO PAR-NAME. NC1044.2 +178700 PERFORM PRINT-DETAIL. NC1044.2 +178800 MOVE-TEST-F1-57-12. NC1044.2 +178900 IF DNAME32 EQUAL TO 1 NC1044.2 +179000 PERFORM PASS NC1044.2 +179100 GO TO MOVE-WRITE-F1-57-12. NC1044.2 +179200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +179300 MOVE DNAME32 TO COMPUTED-18V0. NC1044.2 +179400 MOVE 1 TO CORRECT-18V0. NC1044.2 +179500 PERFORM FAIL. NC1044.2 +179600 GO TO MOVE-WRITE-F1-57-12. NC1044.2 +179700 MOVE-DELETE-F1-57-12. NC1044.2 +179800 PERFORM DE-LETE. NC1044.2 +179900 MOVE-WRITE-F1-57-12. NC1044.2 +180000 MOVE "MOVE-TEST-F1-57-12 " TO PAR-NAME. NC1044.2 +180100 PERFORM PRINT-DETAIL. NC1044.2 +180200 MOVE-TEST-F1-57-13. NC1044.2 +180300 IF DNAME33 EQUAL TO 1 NC1044.2 +180400 PERFORM PASS NC1044.2 +180500 GO TO MOVE-WRITE-F1-57-13. NC1044.2 +180600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +180700 MOVE DNAME33 TO COMPUTED-18V0. NC1044.2 +180800 MOVE 1 TO CORRECT-18V0. NC1044.2 +180900 PERFORM FAIL. NC1044.2 +181000 GO TO MOVE-WRITE-F1-57-13. NC1044.2 +181100 MOVE-DELETE-F1-57-13. NC1044.2 +181200 PERFORM DE-LETE. NC1044.2 +181300 MOVE-WRITE-F1-57-13. NC1044.2 +181400 MOVE "MOVE-TEST-F1-57-13 " TO PAR-NAME. NC1044.2 +181500 PERFORM PRINT-DETAIL. NC1044.2 +181600 MOVE-TEST-F1-57-14. NC1044.2 +181700 IF DNAME34 EQUAL TO 1 NC1044.2 +181800 PERFORM PASS NC1044.2 +181900 GO TO MOVE-WRITE-F1-57-14. NC1044.2 +182000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +182100 MOVE DNAME34 TO COMPUTED-18V0. NC1044.2 +182200 MOVE 1 TO CORRECT-18V0. NC1044.2 +182300 PERFORM FAIL. NC1044.2 +182400 GO TO MOVE-WRITE-F1-57-14. NC1044.2 +182500 MOVE-DELETE-F1-57-14. NC1044.2 +182600 PERFORM DE-LETE. NC1044.2 +182700 MOVE-WRITE-F1-57-14. NC1044.2 +182800 MOVE "MOVE-TEST-F1-57-14 " TO PAR-NAME. NC1044.2 +182900 PERFORM PRINT-DETAIL. NC1044.2 +183000 MOVE-TEST-F1-57-15. NC1044.2 +183100 IF DNAME35 EQUAL TO 1 NC1044.2 +183200 PERFORM PASS NC1044.2 +183300 GO TO MOVE-WRITE-F1-57-15. NC1044.2 +183400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +183500 MOVE DNAME35 TO COMPUTED-18V0. NC1044.2 +183600 MOVE 1 TO CORRECT-18V0. NC1044.2 +183700 PERFORM FAIL. NC1044.2 +183800 GO TO MOVE-WRITE-F1-57-15. NC1044.2 +183900 MOVE-DELETE-F1-57-15. NC1044.2 +184000 PERFORM DE-LETE. NC1044.2 +184100 MOVE-WRITE-F1-57-15. NC1044.2 +184200 MOVE "MOVE-TEST-F1-57-15 " TO PAR-NAME. NC1044.2 +184300 PERFORM PRINT-DETAIL. NC1044.2 +184400 MOVE-TEST-F1-57-16. NC1044.2 +184500 IF DNAME36 EQUAL TO 1 NC1044.2 +184600 PERFORM PASS NC1044.2 +184700 GO TO MOVE-WRITE-F1-57-16. NC1044.2 +184800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +184900 MOVE DNAME36 TO COMPUTED-18V0. NC1044.2 +185000 MOVE 1 TO CORRECT-18V0. NC1044.2 +185100 PERFORM FAIL. NC1044.2 +185200 GO TO MOVE-WRITE-F1-57-16. NC1044.2 +185300 MOVE-DELETE-F1-57-16. NC1044.2 +185400 PERFORM DE-LETE. NC1044.2 +185500 MOVE-WRITE-F1-57-16. NC1044.2 +185600 MOVE "MOVE-TEST-F1-57-16 " TO PAR-NAME. NC1044.2 +185700 PERFORM PRINT-DETAIL. NC1044.2 +185800 MOVE-TEST-F1-57-17. NC1044.2 +185900 IF DNAME37 EQUAL TO 1 NC1044.2 +186000 PERFORM PASS NC1044.2 +186100 GO TO MOVE-WRITE-F1-57-17. NC1044.2 +186200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +186300 MOVE DNAME37 TO COMPUTED-18V0. NC1044.2 +186400 MOVE 1 TO CORRECT-18V0. NC1044.2 +186500 PERFORM FAIL. NC1044.2 +186600 GO TO MOVE-WRITE-F1-57-17. NC1044.2 +186700 MOVE-DELETE-F1-57-17. NC1044.2 +186800 PERFORM DE-LETE. NC1044.2 +186900 MOVE-WRITE-F1-57-17. NC1044.2 +187000 MOVE "MOVE-TEST-F1-57-17 " TO PAR-NAME. NC1044.2 +187100 PERFORM PRINT-DETAIL. NC1044.2 +187200 MOVE-TEST-F1-57-18. NC1044.2 +187300 IF DNAME38 EQUAL TO 1 NC1044.2 +187400 PERFORM PASS NC1044.2 +187500 GO TO MOVE-WRITE-F1-57-18. NC1044.2 +187600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +187700 MOVE DNAME38 TO COMPUTED-18V0. NC1044.2 +187800 MOVE 1 TO CORRECT-18V0. NC1044.2 +187900 PERFORM FAIL. NC1044.2 +188000 GO TO MOVE-WRITE-F1-57-18. NC1044.2 +188100 MOVE-DELETE-F1-57-18. NC1044.2 +188200 PERFORM DE-LETE. NC1044.2 +188300 MOVE-WRITE-F1-57-18. NC1044.2 +188400 MOVE "MOVE-TEST-F1-57-18 " TO PAR-NAME. NC1044.2 +188500 PERFORM PRINT-DETAIL. NC1044.2 +188600 MOVE-TEST-F1-57-19. NC1044.2 +188700 IF DNAME39 EQUAL TO 1 NC1044.2 +188800 PERFORM PASS NC1044.2 +188900 GO TO MOVE-WRITE-F1-57-19. NC1044.2 +189000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +189100 MOVE DNAME39 TO COMPUTED-18V0. NC1044.2 +189200 MOVE 1 TO CORRECT-18V0. NC1044.2 +189300 PERFORM FAIL. NC1044.2 +189400 GO TO MOVE-WRITE-F1-57-19. NC1044.2 +189500 MOVE-DELETE-F1-57-19. NC1044.2 +189600 PERFORM DE-LETE. NC1044.2 +189700 MOVE-WRITE-F1-57-19. NC1044.2 +189800 MOVE "MOVE-TEST-F1-57-19 " TO PAR-NAME. NC1044.2 +189900 PERFORM PRINT-DETAIL. NC1044.2 +190000 MOVE-TEST-F1-57-20. NC1044.2 +190100 IF DNAME40 EQUAL TO 1 NC1044.2 +190200 PERFORM PASS NC1044.2 +190300 GO TO MOVE-WRITE-F1-57-20. NC1044.2 +190400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +190500 MOVE DNAME40 TO COMPUTED-18V0. NC1044.2 +190600 MOVE 1 TO CORRECT-18V0. NC1044.2 +190700 PERFORM FAIL. NC1044.2 +190800 GO TO MOVE-WRITE-F1-57-20. NC1044.2 +190900 MOVE-DELETE-F1-57-20. NC1044.2 +191000 PERFORM DE-LETE. NC1044.2 +191100 MOVE-WRITE-F1-57-20. NC1044.2 +191200 MOVE "MOVE-TEST-F1-57-20 " TO PAR-NAME. NC1044.2 +191300 PERFORM PRINT-DETAIL. NC1044.2 +191400 MOVE-TEST-F1-57-21. NC1044.2 +191500 IF DNAME41 EQUAL TO 1 NC1044.2 +191600 PERFORM PASS NC1044.2 +191700 GO TO MOVE-WRITE-F1-57-21. NC1044.2 +191800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +191900 MOVE DNAME41 TO COMPUTED-18V0. NC1044.2 +192000 MOVE 1 TO CORRECT-18V0. NC1044.2 +192100 PERFORM FAIL. NC1044.2 +192200 GO TO MOVE-WRITE-F1-57-21. NC1044.2 +192300 MOVE-DELETE-F1-57-21. NC1044.2 +192400 PERFORM DE-LETE. NC1044.2 +192500 MOVE-WRITE-F1-57-21. NC1044.2 +192600 MOVE "MOVE-TEST-F1-57-21 " TO PAR-NAME. NC1044.2 +192700 PERFORM PRINT-DETAIL. NC1044.2 +192800 MOVE-TEST-F1-57-22. NC1044.2 +192900 IF DNAME42 EQUAL TO 1 NC1044.2 +193000 PERFORM PASS NC1044.2 +193100 GO TO MOVE-WRITE-F1-57-22. NC1044.2 +193200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +193300 MOVE DNAME42 TO COMPUTED-18V0. NC1044.2 +193400 MOVE 1 TO CORRECT-18V0. NC1044.2 +193500 PERFORM FAIL. NC1044.2 +193600 GO TO MOVE-WRITE-F1-57-22. NC1044.2 +193700 MOVE-DELETE-F1-57-22. NC1044.2 +193800 PERFORM DE-LETE. NC1044.2 +193900 MOVE-WRITE-F1-57-22. NC1044.2 +194000 MOVE "MOVE-TEST-F1-57-22 " TO PAR-NAME. NC1044.2 +194100 PERFORM PRINT-DETAIL. NC1044.2 +194200 MOVE-INIT-F1-58. NC1044.2 +194300 MOVE 000000000000000001 TO DNAME18. NC1044.2 +194400 MOVE-TEST-F1-58-0. NC1044.2 +194500 MOVE DNAME18 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26 NC1044.2 +194600 DNAME27 DNAME28 DNAME29 DNAME30 DNAME31 DNAME32 NC1044.2 +194700 DNAME33 DNAME34 DNAME35 DNAME36 DNAME37 DNAME38 NC1044.2 +194800 DNAME39 DNAME40 DNAME41 DNAME42. NC1044.2 +194900 MOVE-TEST-F1-58-1. NC1044.2 +195000 IF DNAME22 EQUAL TO 1 NC1044.2 +195100 PERFORM PASS NC1044.2 +195200 GO TO MOVE-WRITE-F1-58-1. NC1044.2 +195300 MOVE DNAME22 TO COMPUTED-18V0. NC1044.2 +195400 MOVE 1 TO CORRECT-18V0. NC1044.2 +195500 PERFORM FAIL. NC1044.2 +195600 GO TO MOVE-WRITE-F1-58-1. NC1044.2 +195700 MOVE-DELETE-F1-58-1. NC1044.2 +195800 PERFORM DE-LETE. NC1044.2 +195900 MOVE-WRITE-F1-58-1. NC1044.2 +196000 MOVE "MOVE-TEST-F1-58-1 " TO PAR-NAME. NC1044.2 +196100 PERFORM PRINT-DETAIL. NC1044.2 +196200 MOVE-TEST-F1-58-2. NC1044.2 +196300 IF DNAME23 EQUAL TO 1 NC1044.2 +196400 PERFORM PASS NC1044.2 +196500 GO TO MOVE-WRITE-F1-58-2. NC1044.2 +196600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +196700 MOVE DNAME23 TO COMPUTED-18V0. NC1044.2 +196800 MOVE 1 TO CORRECT-18V0. NC1044.2 +196900 PERFORM FAIL. NC1044.2 +197000 GO TO MOVE-WRITE-F1-58-2. NC1044.2 +197100 MOVE-DELETE-F1-58-2. NC1044.2 +197200 PERFORM DE-LETE. NC1044.2 +197300 MOVE-WRITE-F1-58-2. NC1044.2 +197400 MOVE "MOVE-TEST-F1-58-2 " TO PAR-NAME. NC1044.2 +197500 PERFORM PRINT-DETAIL. NC1044.2 +197600 MOVE-TEST-F1-58-3. NC1044.2 +197700 IF DNAME24 EQUAL TO 1 NC1044.2 +197800 PERFORM PASS NC1044.2 +197900 GO TO MOVE-WRITE-F1-58-3. NC1044.2 +198000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +198100 MOVE DNAME24 TO COMPUTED-18V0. NC1044.2 +198200 MOVE 1 TO CORRECT-18V0. NC1044.2 +198300 PERFORM FAIL. NC1044.2 +198400 GO TO MOVE-WRITE-F1-58-3. NC1044.2 +198500 MOVE-DELETE-F1-58-3. NC1044.2 +198600 PERFORM DE-LETE. NC1044.2 +198700 MOVE-WRITE-F1-58-3. NC1044.2 +198800 MOVE "MOVE-TEST-F1-58-3 " TO PAR-NAME. NC1044.2 +198900 PERFORM PRINT-DETAIL. NC1044.2 +199000 MOVE-TEST-F1-58-4. NC1044.2 +199100 IF DNAME25 EQUAL TO 1 NC1044.2 +199200 PERFORM PASS NC1044.2 +199300 GO TO MOVE-WRITE-F1-58-4. NC1044.2 +199400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +199500 MOVE DNAME25 TO COMPUTED-18V0. NC1044.2 +199600 MOVE 1 TO CORRECT-18V0. NC1044.2 +199700 PERFORM FAIL. NC1044.2 +199800 GO TO MOVE-WRITE-F1-58-4. NC1044.2 +199900 MOVE-DELETE-F1-58-4. NC1044.2 +200000 PERFORM DE-LETE. NC1044.2 +200100 MOVE-WRITE-F1-58-4. NC1044.2 +200200 MOVE "MOVE-TEST-F1-58-4 " TO PAR-NAME. NC1044.2 +200300 PERFORM PRINT-DETAIL. NC1044.2 +200400 MOVE-TEST-F1-58-5. NC1044.2 +200500 IF DNAME26 EQUAL TO 1 NC1044.2 +200600 PERFORM PASS NC1044.2 +200700 GO TO MOVE-WRITE-F1-58-5. NC1044.2 +200800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +200900 MOVE DNAME26 TO COMPUTED-18V0. NC1044.2 +201000 MOVE 1 TO CORRECT-18V0. NC1044.2 +201100 PERFORM FAIL. NC1044.2 +201200 GO TO MOVE-WRITE-F1-58-5. NC1044.2 +201300 MOVE-DELETE-F1-58-5. NC1044.2 +201400 PERFORM DE-LETE. NC1044.2 +201500 MOVE-WRITE-F1-58-5. NC1044.2 +201600 MOVE "MOVE-TEST-F1-58-5 " TO PAR-NAME. NC1044.2 +201700 PERFORM PRINT-DETAIL. NC1044.2 +201800 MOVE-TEST-F1-58-6. NC1044.2 +201900 IF DNAME27 EQUAL TO 1 NC1044.2 +202000 PERFORM PASS NC1044.2 +202100 GO TO MOVE-WRITE-F1-58-6. NC1044.2 +202200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +202300 MOVE DNAME27 TO COMPUTED-18V0. NC1044.2 +202400 MOVE 1 TO CORRECT-18V0. NC1044.2 +202500 PERFORM FAIL. NC1044.2 +202600 GO TO MOVE-WRITE-F1-58-6. NC1044.2 +202700 MOVE-DELETE-F1-58-6. NC1044.2 +202800 PERFORM DE-LETE. NC1044.2 +202900 MOVE-WRITE-F1-58-6. NC1044.2 +203000 MOVE "MOVE-TEST-F1-58-6 " TO PAR-NAME. NC1044.2 +203100 PERFORM PRINT-DETAIL. NC1044.2 +203200 MOVE-TEST-F1-58-7. NC1044.2 +203300 IF DNAME28 EQUAL TO 1 NC1044.2 +203400 PERFORM PASS NC1044.2 +203500 GO TO MOVE-WRITE-F1-58-7. NC1044.2 +203600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +203700 MOVE DNAME28 TO COMPUTED-18V0. NC1044.2 +203800 MOVE 1 TO CORRECT-18V0. NC1044.2 +203900 PERFORM FAIL. NC1044.2 +204000 GO TO MOVE-WRITE-F1-58-7. NC1044.2 +204100 MOVE-DELETE-F1-58-7. NC1044.2 +204200 PERFORM DE-LETE. NC1044.2 +204300 MOVE-WRITE-F1-58-7. NC1044.2 +204400 MOVE "MOVE-TEST-F1-58-7 " TO PAR-NAME. NC1044.2 +204500 PERFORM PRINT-DETAIL. NC1044.2 +204600 MOVE-TEST-F1-58-8. NC1044.2 +204700 IF DNAME29 EQUAL TO 1 NC1044.2 +204800 PERFORM PASS NC1044.2 +204900 GO TO MOVE-WRITE-F1-58-8. NC1044.2 +205000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +205100 MOVE DNAME29 TO COMPUTED-18V0. NC1044.2 +205200 MOVE 1 TO CORRECT-18V0. NC1044.2 +205300 PERFORM FAIL. NC1044.2 +205400 GO TO MOVE-WRITE-F1-58-8. NC1044.2 +205500 MOVE-DELETE-F1-58-8. NC1044.2 +205600 PERFORM DE-LETE. NC1044.2 +205700 MOVE-WRITE-F1-58-8. NC1044.2 +205800 MOVE "MOVE-TEST-F1-58-8 " TO PAR-NAME. NC1044.2 +205900 PERFORM PRINT-DETAIL. NC1044.2 +206000 MOVE-TEST-F1-58-9. NC1044.2 +206100 IF DNAME30 EQUAL TO 1 NC1044.2 +206200 PERFORM PASS NC1044.2 +206300 GO TO MOVE-WRITE-F1-58-9. NC1044.2 +206400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +206500 MOVE DNAME30 TO COMPUTED-18V0. NC1044.2 +206600 MOVE 1 TO CORRECT-18V0. NC1044.2 +206700 PERFORM FAIL. NC1044.2 +206800 GO TO MOVE-WRITE-F1-58-9. NC1044.2 +206900 MOVE-DELETE-F1-58-9. NC1044.2 +207000 PERFORM DE-LETE. NC1044.2 +207100 MOVE-WRITE-F1-58-9. NC1044.2 +207200 MOVE "MOVE-TEST-F1-58-9 " TO PAR-NAME. NC1044.2 +207300 PERFORM PRINT-DETAIL. NC1044.2 +207400 MOVE-TEST-F1-58-10. NC1044.2 +207500 IF DNAME31 EQUAL TO 1 NC1044.2 +207600 PERFORM PASS NC1044.2 +207700 GO TO MOVE-WRITE-F1-58-10. NC1044.2 +207800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +207900 MOVE DNAME31 TO COMPUTED-18V0. NC1044.2 +208000 MOVE 1 TO CORRECT-18V0. NC1044.2 +208100 PERFORM FAIL. NC1044.2 +208200 GO TO MOVE-WRITE-F1-58-10. NC1044.2 +208300 MOVE-DELETE-F1-58-10. NC1044.2 +208400 PERFORM DE-LETE. NC1044.2 +208500 MOVE-WRITE-F1-58-10. NC1044.2 +208600 MOVE "MOVE-TEST-F1-58-10 " TO PAR-NAME. NC1044.2 +208700 PERFORM PRINT-DETAIL. NC1044.2 +208800 MOVE-TEST-F1-58-11. NC1044.2 +208900 IF DNAME32 EQUAL TO 1 NC1044.2 +209000 PERFORM PASS NC1044.2 +209100 GO TO MOVE-WRITE-F1-58-11. NC1044.2 +209200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +209300 MOVE DNAME32 TO COMPUTED-18V0. NC1044.2 +209400 MOVE 1 TO CORRECT-18V0. NC1044.2 +209500 PERFORM FAIL. NC1044.2 +209600 GO TO MOVE-WRITE-F1-58-11. NC1044.2 +209700 MOVE-DELETE-F1-58-11. NC1044.2 +209800 PERFORM DE-LETE. NC1044.2 +209900 MOVE-WRITE-F1-58-11. NC1044.2 +210000 MOVE "MOVE-TEST-F1-58-11 " TO PAR-NAME. NC1044.2 +210100 PERFORM PRINT-DETAIL. NC1044.2 +210200 MOVE-TEST-F1-58-12. NC1044.2 +210300 IF DNAME33 EQUAL TO 1 NC1044.2 +210400 PERFORM PASS NC1044.2 +210500 GO TO MOVE-WRITE-F1-58-12. NC1044.2 +210600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +210700 MOVE DNAME33 TO COMPUTED-18V0. NC1044.2 +210800 MOVE 1 TO CORRECT-18V0. NC1044.2 +210900 PERFORM FAIL. NC1044.2 +211000 GO TO MOVE-WRITE-F1-58-12. NC1044.2 +211100 MOVE-DELETE-F1-58-12. NC1044.2 +211200 PERFORM DE-LETE. NC1044.2 +211300 MOVE-WRITE-F1-58-12. NC1044.2 +211400 MOVE "MOVE-TEST-F1-58-12 " TO PAR-NAME. NC1044.2 +211500 PERFORM PRINT-DETAIL. NC1044.2 +211600 MOVE-TEST-F1-58-13. NC1044.2 +211700 IF DNAME34 EQUAL TO 1 NC1044.2 +211800 PERFORM PASS NC1044.2 +211900 GO TO MOVE-WRITE-F1-58-13. NC1044.2 +212000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +212100 MOVE DNAME34 TO COMPUTED-18V0. NC1044.2 +212200 MOVE 1 TO CORRECT-18V0. NC1044.2 +212300 PERFORM FAIL. NC1044.2 +212400 GO TO MOVE-WRITE-F1-58-13. NC1044.2 +212500 MOVE-DELETE-F1-58-13. NC1044.2 +212600 PERFORM DE-LETE. NC1044.2 +212700 MOVE-WRITE-F1-58-13. NC1044.2 +212800 MOVE "MOVE-TEST-F1-58-13 " TO PAR-NAME. NC1044.2 +212900 PERFORM PRINT-DETAIL. NC1044.2 +213000 MOVE-TEST-F1-58-14. NC1044.2 +213100 IF DNAME35 EQUAL TO 1 NC1044.2 +213200 PERFORM PASS NC1044.2 +213300 GO TO MOVE-WRITE-F1-58-14. NC1044.2 +213400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +213500 MOVE DNAME35 TO COMPUTED-18V0. NC1044.2 +213600 MOVE 1 TO CORRECT-18V0. NC1044.2 +213700 PERFORM FAIL. NC1044.2 +213800 GO TO MOVE-WRITE-F1-58-14. NC1044.2 +213900 MOVE-DELETE-F1-58-14. NC1044.2 +214000 PERFORM DE-LETE. NC1044.2 +214100 MOVE-WRITE-F1-58-14. NC1044.2 +214200 MOVE "MOVE-TEST-F1-58-14 " TO PAR-NAME. NC1044.2 +214300 PERFORM PRINT-DETAIL. NC1044.2 +214400 MOVE-TEST-F1-58-15. NC1044.2 +214500 IF DNAME36 EQUAL TO 1 NC1044.2 +214600 PERFORM PASS NC1044.2 +214700 GO TO MOVE-WRITE-F1-58-15. NC1044.2 +214800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +214900 MOVE DNAME36 TO COMPUTED-18V0. NC1044.2 +215000 MOVE 1 TO CORRECT-18V0. NC1044.2 +215100 PERFORM FAIL. NC1044.2 +215200 GO TO MOVE-WRITE-F1-58-15. NC1044.2 +215300 MOVE-DELETE-F1-58-15. NC1044.2 +215400 PERFORM DE-LETE. NC1044.2 +215500 MOVE-WRITE-F1-58-15. NC1044.2 +215600 MOVE "MOVE-TEST-F1-58-15 " TO PAR-NAME. NC1044.2 +215700 PERFORM PRINT-DETAIL. NC1044.2 +215800 MOVE-TEST-F1-58-16. NC1044.2 +215900 IF DNAME37 EQUAL TO 1 NC1044.2 +216000 PERFORM PASS NC1044.2 +216100 GO TO MOVE-WRITE-F1-58-16. NC1044.2 +216200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +216300 MOVE DNAME37 TO COMPUTED-18V0. NC1044.2 +216400 MOVE 1 TO CORRECT-18V0. NC1044.2 +216500 PERFORM FAIL. NC1044.2 +216600 GO TO MOVE-WRITE-F1-58-16. NC1044.2 +216700 MOVE-DELETE-F1-58-16. NC1044.2 +216800 PERFORM DE-LETE. NC1044.2 +216900 MOVE-WRITE-F1-58-16. NC1044.2 +217000 MOVE "MOVE-TEST-F1-58-16 " TO PAR-NAME. NC1044.2 +217100 PERFORM PRINT-DETAIL. NC1044.2 +217200 MOVE-TEST-F1-58-17. NC1044.2 +217300 IF DNAME38 EQUAL TO 1 NC1044.2 +217400 PERFORM PASS NC1044.2 +217500 GO TO MOVE-WRITE-F1-58-17. NC1044.2 +217600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +217700 MOVE DNAME38 TO COMPUTED-18V0. NC1044.2 +217800 MOVE 1 TO CORRECT-18V0. NC1044.2 +217900 PERFORM FAIL. NC1044.2 +218000 GO TO MOVE-WRITE-F1-58-17. NC1044.2 +218100 MOVE-DELETE-F1-58-17. NC1044.2 +218200 PERFORM DE-LETE. NC1044.2 +218300 MOVE-WRITE-F1-58-17. NC1044.2 +218400 MOVE "MOVE-TEST-F1-58-17 " TO PAR-NAME. NC1044.2 +218500 PERFORM PRINT-DETAIL. NC1044.2 +218600 MOVE-TEST-F1-58-18. NC1044.2 +218700 IF DNAME39 EQUAL TO 1 NC1044.2 +218800 PERFORM PASS NC1044.2 +218900 GO TO MOVE-WRITE-F1-58-18. NC1044.2 +219000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +219100 MOVE DNAME39 TO COMPUTED-18V0. NC1044.2 +219200 MOVE 1 TO CORRECT-18V0. NC1044.2 +219300 PERFORM FAIL. NC1044.2 +219400 GO TO MOVE-WRITE-F1-58-18. NC1044.2 +219500 MOVE-DELETE-F1-58-18. NC1044.2 +219600 PERFORM DE-LETE. NC1044.2 +219700 MOVE-WRITE-F1-58-18. NC1044.2 +219800 MOVE "MOVE-TEST-F1-58-18 " TO PAR-NAME. NC1044.2 +219900 PERFORM PRINT-DETAIL. NC1044.2 +220000 MOVE-TEST-F1-58-19. NC1044.2 +220100 IF DNAME40 EQUAL TO 1 NC1044.2 +220200 PERFORM PASS NC1044.2 +220300 GO TO MOVE-WRITE-F1-58-19. NC1044.2 +220400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +220500 MOVE DNAME40 TO COMPUTED-18V0. NC1044.2 +220600 MOVE 1 TO CORRECT-18V0. NC1044.2 +220700 PERFORM FAIL. NC1044.2 +220800 GO TO MOVE-WRITE-F1-58-19. NC1044.2 +220900 MOVE-DELETE-F1-58-19. NC1044.2 +221000 PERFORM DE-LETE. NC1044.2 +221100 MOVE-WRITE-F1-58-19. NC1044.2 +221200 MOVE "MOVE-TEST-F1-58-19 " TO PAR-NAME. NC1044.2 +221300 PERFORM PRINT-DETAIL. NC1044.2 +221400 MOVE-TEST-F1-58-20. NC1044.2 +221500 IF DNAME41 EQUAL TO 1 NC1044.2 +221600 PERFORM PASS NC1044.2 +221700 GO TO MOVE-WRITE-F1-58-20. NC1044.2 +221800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +221900 MOVE DNAME41 TO COMPUTED-18V0. NC1044.2 +222000 MOVE 1 TO CORRECT-18V0. NC1044.2 +222100 PERFORM FAIL. NC1044.2 +222200 GO TO MOVE-WRITE-F1-58-20. NC1044.2 +222300 MOVE-DELETE-F1-58-20. NC1044.2 +222400 PERFORM DE-LETE. NC1044.2 +222500 MOVE-WRITE-F1-58-20. NC1044.2 +222600 MOVE "MOVE-TEST-F1-58-20 " TO PAR-NAME. NC1044.2 +222700 PERFORM PRINT-DETAIL. NC1044.2 +222800 MOVE-TEST-F1-58-21. NC1044.2 +222900 IF DNAME42 EQUAL TO 1 NC1044.2 +223000 PERFORM PASS NC1044.2 +223100 GO TO MOVE-WRITE-F1-58-21. NC1044.2 +223200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +223300 MOVE DNAME42 TO COMPUTED-18V0. NC1044.2 +223400 MOVE 1 TO CORRECT-18V0. NC1044.2 +223500 PERFORM FAIL. NC1044.2 +223600 GO TO MOVE-WRITE-F1-58-21. NC1044.2 +223700 MOVE-DELETE-F1-58-21. NC1044.2 +223800 PERFORM DE-LETE. NC1044.2 +223900 MOVE-WRITE-F1-58-21. NC1044.2 +224000 MOVE "MOVE-TEST-F1-58-21 " TO PAR-NAME. NC1044.2 +224100 PERFORM PRINT-DETAIL. NC1044.2 +224200 MOVE-INIT-F1-59-1. NC1044.2 +224300 MOVE ZERO TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1044.2 +224400 MOVE ZERO TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1044.2 +224500 MOVE ZERO TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1044.2 +224600 MOVE ZERO TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1044.2 +224700 MOVE ZERO TO DNAME42. NC1044.2 +224800 MOVE-TEST-F1-59-0. NC1044.2 +224900 MOVE "A" TO ANDATA1 ANDATA2 ANDATA3 ANDATA4 ANDATA5 NC1044.2 +225000 ANDATA6 ANDATA7 ANDATA8 ANDATA9 ANDATA10 ANDATA11 NC1044.2 +225100 ANDATA12 ANDATA13 ANDATA14 ANDATA15 ANDATA16 NC1044.2 +225200 ANDATA17 ANDATA18 ANDATA19 ANDATA20 ANDATA21. NC1044.2 +225300 MOVE-TEST-F1-59-1. NC1044.2 +225400 IF ANDATA1 EQUAL TO "A" NC1044.2 +225500 PERFORM PASS NC1044.2 +225600 GO TO MOVE-WRITE-F1-59-1. NC1044.2 +225700 MOVE ANDATA1 TO COMPUTED-A. NC1044.2 +225800 MOVE "A" TO CORRECT-A. NC1044.2 +225900 PERFORM FAIL. NC1044.2 +226000 GO TO MOVE-WRITE-F1-59-1. NC1044.2 +226100 MOVE-DELETE-F1-59-1. NC1044.2 +226200 PERFORM DE-LETE. NC1044.2 +226300 MOVE-WRITE-F1-59-1. NC1044.2 +226400 MOVE "MOVE-TEST-F1-59-1 " TO PAR-NAME. NC1044.2 +226500 PERFORM PRINT-DETAIL. NC1044.2 +226600 MOVE-TEST-F1-59-2. NC1044.2 +226700 IF ANDATA2 EQUAL TO "A" NC1044.2 +226800 PERFORM PASS NC1044.2 +226900 GO TO MOVE-WRITE-F1-59-2. NC1044.2 +227000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +227100 MOVE ANDATA2 TO COMPUTED-A. NC1044.2 +227200 MOVE "A" TO CORRECT-A. NC1044.2 +227300 PERFORM FAIL. NC1044.2 +227400 GO TO MOVE-WRITE-F1-59-2. NC1044.2 +227500 MOVE-DELETE-F1-59-2. NC1044.2 +227600 PERFORM DE-LETE. NC1044.2 +227700 MOVE-WRITE-F1-59-2. NC1044.2 +227800 MOVE "MOVE-TEST-F1-59-2 " TO PAR-NAME. NC1044.2 +227900 PERFORM PRINT-DETAIL. NC1044.2 +228000 MOVE-TEST-F1-59-3. NC1044.2 +228100 IF ANDATA3 EQUAL TO "A" NC1044.2 +228200 PERFORM PASS NC1044.2 +228300 GO TO MOVE-WRITE-F1-59-3. NC1044.2 +228400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +228500 MOVE ANDATA3 TO COMPUTED-A. NC1044.2 +228600 MOVE "A" TO CORRECT-A. NC1044.2 +228700 PERFORM FAIL. NC1044.2 +228800 GO TO MOVE-WRITE-F1-59-3. NC1044.2 +228900 MOVE-DELETE-F1-59-3. NC1044.2 +229000 PERFORM DE-LETE. NC1044.2 +229100 MOVE-WRITE-F1-59-3. NC1044.2 +229200 MOVE "MOVE-TEST-F1-59-3 " TO PAR-NAME. NC1044.2 +229300 PERFORM PRINT-DETAIL. NC1044.2 +229400 MOVE-TEST-F1-59-4-4. NC1044.2 +229500 IF ANDATA4 EQUAL TO "A" NC1044.2 +229600 PERFORM PASS NC1044.2 +229700 GO TO MOVE-WRITE-F1-59-4. NC1044.2 +229800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +229900 MOVE ANDATA4 TO COMPUTED-A. NC1044.2 +230000 MOVE "A" TO CORRECT-A. NC1044.2 +230100 PERFORM FAIL. NC1044.2 +230200 GO TO MOVE-WRITE-F1-59-4. NC1044.2 +230300 MOVE-DELETE-F1-59-4. NC1044.2 +230400 PERFORM DE-LETE. NC1044.2 +230500 MOVE-WRITE-F1-59-4. NC1044.2 +230600 MOVE "MOVE-TEST-F1-59-4 " TO PAR-NAME. NC1044.2 +230700 PERFORM PRINT-DETAIL. NC1044.2 +230800 MOVE-TEST-F1-59-5. NC1044.2 +230900 IF ANDATA5 EQUAL TO "A" NC1044.2 +231000 PERFORM PASS NC1044.2 +231100 GO TO MOVE-WRITE-F1-59-5. NC1044.2 +231200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +231300 MOVE ANDATA5 TO COMPUTED-A. NC1044.2 +231400 MOVE "A" TO CORRECT-A. NC1044.2 +231500 PERFORM FAIL. NC1044.2 +231600 GO TO MOVE-WRITE-F1-59-5. NC1044.2 +231700 MOVE-DELETE-F1-59-5. NC1044.2 +231800 PERFORM DE-LETE. NC1044.2 +231900 MOVE-WRITE-F1-59-5. NC1044.2 +232000 MOVE "MOVE-TEST-F1-59-5 " TO PAR-NAME. NC1044.2 +232100 PERFORM PRINT-DETAIL. NC1044.2 +232200 MOVE-TEST-F1-59-6. NC1044.2 +232300 IF ANDATA6 EQUAL TO "A" NC1044.2 +232400 PERFORM PASS NC1044.2 +232500 GO TO MOVE-WRITE-F1-59-6. NC1044.2 +232600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +232700 MOVE ANDATA6 TO COMPUTED-A. NC1044.2 +232800 MOVE "A" TO CORRECT-A. NC1044.2 +232900 PERFORM FAIL. NC1044.2 +233000 GO TO MOVE-WRITE-F1-59-6. NC1044.2 +233100 MOVE-DELETE-F1-59-6. NC1044.2 +233200 PERFORM DE-LETE. NC1044.2 +233300 MOVE-WRITE-F1-59-6. NC1044.2 +233400 MOVE "MOVE-TEST-F1-59-6 " TO PAR-NAME. NC1044.2 +233500 PERFORM PRINT-DETAIL. NC1044.2 +233600 MOVE-TEST-F1-59-7. NC1044.2 +233700 IF ANDATA7 EQUAL TO "A" NC1044.2 +233800 PERFORM PASS NC1044.2 +233900 GO TO MOVE-WRITE-F1-59-7. NC1044.2 +234000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +234100 MOVE ANDATA7 TO COMPUTED-A. NC1044.2 +234200 MOVE "A" TO CORRECT-A. NC1044.2 +234300 PERFORM FAIL. NC1044.2 +234400 GO TO MOVE-WRITE-F1-59-7. NC1044.2 +234500 MOVE-DELETE-F1-59-7. NC1044.2 +234600 PERFORM DE-LETE. NC1044.2 +234700 MOVE-WRITE-F1-59-7. NC1044.2 +234800 MOVE "MOVE-TEST-F1-59-7 " TO PAR-NAME. NC1044.2 +234900 PERFORM PRINT-DETAIL. NC1044.2 +235000 MOVE-TEST-F1-59-8. NC1044.2 +235100 IF ANDATA8 EQUAL TO "A" NC1044.2 +235200 PERFORM PASS NC1044.2 +235300 GO TO MOVE-WRITE-F1-59-8. NC1044.2 +235400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +235500 MOVE ANDATA8 TO COMPUTED-A. NC1044.2 +235600 MOVE "A" TO CORRECT-A. NC1044.2 +235700 PERFORM FAIL. NC1044.2 +235800 GO TO MOVE-WRITE-F1-59-8. NC1044.2 +235900 MOVE-DELETE-F1-59-8. NC1044.2 +236000 PERFORM DE-LETE. NC1044.2 +236100 MOVE-WRITE-F1-59-8. NC1044.2 +236200 MOVE "MOVE-TEST-F1-59-8 " TO PAR-NAME. NC1044.2 +236300 PERFORM PRINT-DETAIL. NC1044.2 +236400 MOVE-TEST-F1-59-9. NC1044.2 +236500 IF ANDATA9 EQUAL TO "A" NC1044.2 +236600 PERFORM PASS NC1044.2 +236700 GO TO MOVE-WRITE-F1-59-9. NC1044.2 +236800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +236900 MOVE ANDATA9 TO COMPUTED-A. NC1044.2 +237000 MOVE "A" TO CORRECT-A. NC1044.2 +237100 PERFORM FAIL. NC1044.2 +237200 GO TO MOVE-WRITE-F1-59-9. NC1044.2 +237300 MOVE-DELETE-F1-59-9. NC1044.2 +237400 PERFORM DE-LETE. NC1044.2 +237500 MOVE-WRITE-F1-59-9. NC1044.2 +237600 MOVE "MOVE-TEST-F1-59-9 " TO PAR-NAME. NC1044.2 +237700 PERFORM PRINT-DETAIL. NC1044.2 +237800 MOVE-TEST-F1-59-10. NC1044.2 +237900 IF ANDATA10 EQUAL TO "A" NC1044.2 +238000 PERFORM PASS NC1044.2 +238100 GO TO MOVE-WRITE-F1-59-10. NC1044.2 +238200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +238300 MOVE ANDATA10 TO COMPUTED-A. NC1044.2 +238400 MOVE "A" TO CORRECT-A. NC1044.2 +238500 PERFORM FAIL. NC1044.2 +238600 GO TO MOVE-WRITE-F1-59-10. NC1044.2 +238700 MOVE-DELETE-F1-59-10. NC1044.2 +238800 PERFORM DE-LETE. NC1044.2 +238900 MOVE-WRITE-F1-59-10. NC1044.2 +239000 MOVE "MOVE-TEST-F1-59-10 " TO PAR-NAME. NC1044.2 +239100 PERFORM PRINT-DETAIL. NC1044.2 +239200 MOVE-TEST-F1-59-11. NC1044.2 +239300 IF ANDATA11 EQUAL TO "A" NC1044.2 +239400 PERFORM PASS NC1044.2 +239500 GO TO MOVE-WRITE-F1-59-11. NC1044.2 +239600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +239700 MOVE ANDATA11 TO COMPUTED-A. NC1044.2 +239800 MOVE "A" TO CORRECT-A. NC1044.2 +239900 PERFORM FAIL. NC1044.2 +240000 GO TO MOVE-WRITE-F1-59-11. NC1044.2 +240100 MOVE-DELETE-F1-59-11. NC1044.2 +240200 PERFORM DE-LETE. NC1044.2 +240300 MOVE-WRITE-F1-59-11. NC1044.2 +240400 MOVE "MOVE-TEST-F1-59-11 " TO PAR-NAME. NC1044.2 +240500 PERFORM PRINT-DETAIL. NC1044.2 +240600 MOVE-TEST-F1-59-12. NC1044.2 +240700 IF ANDATA12 EQUAL TO "A" NC1044.2 +240800 PERFORM PASS NC1044.2 +240900 GO TO MOVE-WRITE-F1-59-12. NC1044.2 +241000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +241100 MOVE ANDATA12 TO COMPUTED-A. NC1044.2 +241200 MOVE "A" TO CORRECT-A. NC1044.2 +241300 PERFORM FAIL. NC1044.2 +241400 GO TO MOVE-WRITE-F1-59-12. NC1044.2 +241500 MOVE-DELETE-F1-59-12. NC1044.2 +241600 PERFORM DE-LETE. NC1044.2 +241700 MOVE-WRITE-F1-59-12. NC1044.2 +241800 MOVE "MOVE-TEST-F1-59-12 " TO PAR-NAME. NC1044.2 +241900 PERFORM PRINT-DETAIL. NC1044.2 +242000 MOVE-TEST-F1-59-13. NC1044.2 +242100 IF ANDATA13 EQUAL TO "A" NC1044.2 +242200 PERFORM PASS NC1044.2 +242300 GO TO MOVE-WRITE-F1-59-13. NC1044.2 +242400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +242500 MOVE ANDATA13 TO COMPUTED-A. NC1044.2 +242600 MOVE "A" TO CORRECT-A. NC1044.2 +242700 PERFORM FAIL. NC1044.2 +242800 GO TO MOVE-WRITE-F1-59-13. NC1044.2 +242900 MOVE-DELETE-F1-59-13. NC1044.2 +243000 PERFORM DE-LETE. NC1044.2 +243100 MOVE-WRITE-F1-59-13. NC1044.2 +243200 MOVE "MOVE-TEST-F1-59-13 " TO PAR-NAME. NC1044.2 +243300 PERFORM PRINT-DETAIL. NC1044.2 +243400 MOVE-TEST-F1-59-14. NC1044.2 +243500 IF ANDATA14 EQUAL TO "A" NC1044.2 +243600 PERFORM PASS NC1044.2 +243700 GO TO MOVE-WRITE-F1-59-14. NC1044.2 +243800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +243900 MOVE ANDATA14 TO COMPUTED-A. NC1044.2 +244000 MOVE "A" TO CORRECT-A. NC1044.2 +244100 PERFORM FAIL. NC1044.2 +244200 GO TO MOVE-WRITE-F1-59-14. NC1044.2 +244300 MOVE-DELETE-F1-59-14. NC1044.2 +244400 PERFORM DE-LETE. NC1044.2 +244500 MOVE-WRITE-F1-59-14. NC1044.2 +244600 MOVE "MOVE-TEST-F1-59-14 " TO PAR-NAME. NC1044.2 +244700 PERFORM PRINT-DETAIL. NC1044.2 +244800 MOVE-TEST-F1-59-15. NC1044.2 +244900 IF ANDATA15 EQUAL TO "A" NC1044.2 +245000 PERFORM PASS NC1044.2 +245100 GO TO MOVE-WRITE-F1-59-15. NC1044.2 +245200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +245300 MOVE ANDATA15 TO COMPUTED-A. NC1044.2 +245400 MOVE "A" TO CORRECT-A. NC1044.2 +245500 PERFORM FAIL. NC1044.2 +245600 GO TO MOVE-WRITE-F1-59-15. NC1044.2 +245700 MOVE-DELETE-F1-59-15. NC1044.2 +245800 PERFORM DE-LETE. NC1044.2 +245900 MOVE-WRITE-F1-59-15. NC1044.2 +246000 MOVE "MOVE-TEST-F1-59-15 " TO PAR-NAME. NC1044.2 +246100 PERFORM PRINT-DETAIL. NC1044.2 +246200 MOVE-TEST-F1-59-16. NC1044.2 +246300 IF ANDATA16 EQUAL TO "A" NC1044.2 +246400 PERFORM PASS NC1044.2 +246500 GO TO MOVE-WRITE-F1-59-16. NC1044.2 +246600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +246700 MOVE ANDATA16 TO COMPUTED-A. NC1044.2 +246800 MOVE "A" TO CORRECT-A. NC1044.2 +246900 PERFORM FAIL. NC1044.2 +247000 GO TO MOVE-WRITE-F1-59-16. NC1044.2 +247100 MOVE-DELETE-F1-59-16. NC1044.2 +247200 PERFORM DE-LETE. NC1044.2 +247300 MOVE-WRITE-F1-59-16. NC1044.2 +247400 MOVE "MOVE-TEST-F1-59-16 " TO PAR-NAME. NC1044.2 +247500 PERFORM PRINT-DETAIL. NC1044.2 +247600 MOVE-TEST-F1-59-17. NC1044.2 +247700 IF ANDATA17 EQUAL TO "A" NC1044.2 +247800 PERFORM PASS NC1044.2 +247900 GO TO MOVE-WRITE-F1-59-17. NC1044.2 +248000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +248100 MOVE ANDATA17 TO COMPUTED-A. NC1044.2 +248200 MOVE "A" TO CORRECT-A. NC1044.2 +248300 PERFORM FAIL. NC1044.2 +248400 GO TO MOVE-WRITE-F1-59-17. NC1044.2 +248500 MOVE-DELETE-F1-59-17. NC1044.2 +248600 PERFORM DE-LETE. NC1044.2 +248700 MOVE-WRITE-F1-59-17. NC1044.2 +248800 MOVE "MOVE-TEST-F1-59-17 " TO PAR-NAME. NC1044.2 +248900 PERFORM PRINT-DETAIL. NC1044.2 +249000 MOVE-TEST-F1-59-18. NC1044.2 +249100 IF ANDATA18 EQUAL TO "A" NC1044.2 +249200 PERFORM PASS NC1044.2 +249300 GO TO MOVE-WRITE-F1-59-18. NC1044.2 +249400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +249500 MOVE ANDATA18 TO COMPUTED-A. NC1044.2 +249600 MOVE "A" TO CORRECT-A. NC1044.2 +249700 PERFORM FAIL. NC1044.2 +249800 GO TO MOVE-WRITE-F1-59-18. NC1044.2 +249900 MOVE-DELETE-F1-59-18. NC1044.2 +250000 PERFORM DE-LETE. NC1044.2 +250100 MOVE-WRITE-F1-59-18. NC1044.2 +250200 MOVE "MOVE-TEST-F1-59-18 " TO PAR-NAME. NC1044.2 +250300 PERFORM PRINT-DETAIL. NC1044.2 +250400 MOVE-TEST-F1-59-19. NC1044.2 +250500 IF ANDATA19 EQUAL TO "A" NC1044.2 +250600 PERFORM PASS NC1044.2 +250700 GO TO MOVE-WRITE-F1-59-19. NC1044.2 +250800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +250900 MOVE ANDATA19 TO COMPUTED-A. NC1044.2 +251000 MOVE "A" TO CORRECT-A. NC1044.2 +251100 PERFORM FAIL. NC1044.2 +251200 GO TO MOVE-WRITE-F1-59-19. NC1044.2 +251300 MOVE-DELETE-F1-59-19. NC1044.2 +251400 PERFORM DE-LETE. NC1044.2 +251500 MOVE-WRITE-F1-59-19. NC1044.2 +251600 MOVE "MOVE-TEST-F1-59-19 " TO PAR-NAME. NC1044.2 +251700 PERFORM PRINT-DETAIL. NC1044.2 +251800 MOVE-TEST-F1-59-20. NC1044.2 +251900 IF ANDATA20 EQUAL TO "A" NC1044.2 +252000 PERFORM PASS NC1044.2 +252100 GO TO MOVE-WRITE-F1-59-20. NC1044.2 +252200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +252300 MOVE ANDATA20 TO COMPUTED-A. NC1044.2 +252400 MOVE "A" TO CORRECT-A. NC1044.2 +252500 PERFORM FAIL. NC1044.2 +252600 GO TO MOVE-WRITE-F1-59-20. NC1044.2 +252700 MOVE-DELETE-F1-59-20. NC1044.2 +252800 PERFORM DE-LETE. NC1044.2 +252900 MOVE-WRITE-F1-59-20. NC1044.2 +253000 MOVE "MOVE-TEST-F1-59-20 " TO PAR-NAME. NC1044.2 +253100 PERFORM PRINT-DETAIL. NC1044.2 +253200 MOVE-TEST-F1-59-21. NC1044.2 +253300 IF ANDATA21 EQUAL TO "A" NC1044.2 +253400 PERFORM PASS NC1044.2 +253500 GO TO MOVE-WRITE-F1-59-21. NC1044.2 +253600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +253700 MOVE ANDATA21 TO COMPUTED-A. NC1044.2 +253800 MOVE "A" TO CORRECT-A. NC1044.2 +253900 PERFORM FAIL. NC1044.2 +254000 GO TO MOVE-WRITE-F1-59-21. NC1044.2 +254100 MOVE-DELETE-F1-59-21. NC1044.2 +254200 PERFORM DE-LETE. NC1044.2 +254300 MOVE-WRITE-F1-59-21. NC1044.2 +254400 MOVE "MOVE-TEST-F1-59-21 " TO PAR-NAME. NC1044.2 +254500 PERFORM PRINT-DETAIL. NC1044.2 +254600 MOVE-INIT-F1-60. NC1044.2 +254700* NC1044.2 +254800 MOVE-TEST-F1-60-0. NC1044.2 +254900 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO ANDATA1 ANDATA2 ANDATA3 NC1044.2 +255000 ANDATA4 ANDATA5 ANDATA6 ANDATA7 ANDATA8 ANDATA9 NC1044.2 +255100 ANDATA10 ANDATA11 ANDATA12 ANDATA13 ANDATA14 NC1044.2 +255200 ANDATA15 ANDATA16 ANDATA17 ANDATA18 ANDATA19 NC1044.2 +255300 ANDATA20 ANDATA21. NC1044.2 +255400 MOVE-TEST-F1-60-1. NC1044.2 +255500 IF ANDATA1 EQUAL TO "A" NC1044.2 +255600 PERFORM PASS NC1044.2 +255700 GO TO MOVE-WRITE-F1-60-1. NC1044.2 +255800 MOVE ANDATA1 TO COMPUTED-A. NC1044.2 +255900 MOVE "A" TO CORRECT-A. NC1044.2 +256000 PERFORM FAIL. NC1044.2 +256100 GO TO MOVE-WRITE-F1-60-1. NC1044.2 +256200 MOVE-DELETE-F1-60-1. NC1044.2 +256300 PERFORM DE-LETE. NC1044.2 +256400 MOVE-WRITE-F1-60-1. NC1044.2 +256500 MOVE "MOVE-TEST-F1-60-1 " TO PAR-NAME. NC1044.2 +256600 PERFORM PRINT-DETAIL. NC1044.2 +256700 MOVE-TEST-F1-60-2. NC1044.2 +256800 IF ANDATA2 EQUAL TO "AB" NC1044.2 +256900 PERFORM PASS NC1044.2 +257000 GO TO MOVE-WRITE-F1-60-2. NC1044.2 +257100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +257200 MOVE ANDATA2 TO COMPUTED-A. NC1044.2 +257300 MOVE "AB" TO CORRECT-A. NC1044.2 +257400 PERFORM FAIL. NC1044.2 +257500 GO TO MOVE-WRITE-F1-60-2. NC1044.2 +257600 MOVE-DELETE-F1-60-2. NC1044.2 +257700 PERFORM DE-LETE. NC1044.2 +257800 MOVE-WRITE-F1-60-2. NC1044.2 +257900 MOVE "MOVE-TEST-F1-60-2 " TO PAR-NAME. NC1044.2 +258000 PERFORM PRINT-DETAIL. NC1044.2 +258100 MOVE-TEST-F1-60-3. NC1044.2 +258200 IF ANDATA3 EQUAL TO "ABC" NC1044.2 +258300 PERFORM PASS NC1044.2 +258400 GO TO MOVE-WRITE-F1-60-3. NC1044.2 +258500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +258600 MOVE ANDATA3 TO COMPUTED-A. NC1044.2 +258700 MOVE "ABC" TO CORRECT-A. NC1044.2 +258800 PERFORM FAIL. NC1044.2 +258900 GO TO MOVE-WRITE-F1-60-3. NC1044.2 +259000 MOVE-DELETE-F1-60-3. NC1044.2 +259100 PERFORM DE-LETE. NC1044.2 +259200 MOVE-WRITE-F1-60-3. NC1044.2 +259300 MOVE "MOVE-TEST-F1-60-3 " TO PAR-NAME. NC1044.2 +259400 PERFORM PRINT-DETAIL. NC1044.2 +259500 MOVE-TEST-F1-60-4. NC1044.2 +259600 IF ANDATA4 EQUAL TO "ABCD" NC1044.2 +259700 PERFORM PASS NC1044.2 +259800 GO TO MOVE-WRITE-F1-60-4. NC1044.2 +259900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +260000 MOVE ANDATA4 TO COMPUTED-A. NC1044.2 +260100 MOVE "ABCD" TO CORRECT-A. NC1044.2 +260200 PERFORM FAIL. NC1044.2 +260300 GO TO MOVE-WRITE-F1-60-4. NC1044.2 +260400 MOVE-DELETE-F1-60-4. NC1044.2 +260500 PERFORM DE-LETE. NC1044.2 +260600 MOVE-WRITE-F1-60-4. NC1044.2 +260700 MOVE "MOVE-TEST-F1-60-4 " TO PAR-NAME. NC1044.2 +260800 PERFORM PRINT-DETAIL. NC1044.2 +260900 MOVE-TEST-F1-60-5. NC1044.2 +261000 IF ANDATA5 EQUAL TO "ABCDE" NC1044.2 +261100 PERFORM PASS NC1044.2 +261200 GO TO MOVE-WRITE-F1-60-5. NC1044.2 +261300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +261400 MOVE ANDATA5 TO COMPUTED-A. NC1044.2 +261500 MOVE "ABCDE" TO CORRECT-A. NC1044.2 +261600 PERFORM FAIL. NC1044.2 +261700 GO TO MOVE-WRITE-F1-60-5. NC1044.2 +261800 MOVE-DELETE-F1-60-5. NC1044.2 +261900 PERFORM DE-LETE. NC1044.2 +262000 MOVE-WRITE-F1-60-5. NC1044.2 +262100 MOVE "MOVE-TEST-F1-60-5 " TO PAR-NAME. NC1044.2 +262200 PERFORM PRINT-DETAIL. NC1044.2 +262300 MOVE-TEST-F1-60-6. NC1044.2 +262400 IF ANDATA6 EQUAL TO "ABCDEF" NC1044.2 +262500 PERFORM PASS NC1044.2 +262600 GO TO MOVE-WRITE-F1-60-6. NC1044.2 +262700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +262800 MOVE ANDATA6 TO COMPUTED-A. NC1044.2 +262900 MOVE "ABCDEF" TO CORRECT-A. NC1044.2 +263000 PERFORM FAIL. NC1044.2 +263100 GO TO MOVE-WRITE-F1-60-6. NC1044.2 +263200 MOVE-DELETE-F1-60-6. NC1044.2 +263300 PERFORM DE-LETE. NC1044.2 +263400 MOVE-WRITE-F1-60-6. NC1044.2 +263500 MOVE "MOVE-TEST-F1-60-6 " TO PAR-NAME. NC1044.2 +263600 PERFORM PRINT-DETAIL. NC1044.2 +263700 MOVE-TEST-F1-60-7. NC1044.2 +263800 IF ANDATA7 EQUAL TO "ABCDEFG" NC1044.2 +263900 PERFORM PASS NC1044.2 +264000 GO TO MOVE-WRITE-F1-60-7. NC1044.2 +264100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +264200 MOVE ANDATA7 TO COMPUTED-A. NC1044.2 +264300 MOVE "ABCDEFG" TO CORRECT-A. NC1044.2 +264400 PERFORM FAIL. NC1044.2 +264500 GO TO MOVE-WRITE-F1-60-7. NC1044.2 +264600 MOVE-DELETE-F1-60-7. NC1044.2 +264700 PERFORM DE-LETE. NC1044.2 +264800 MOVE-WRITE-F1-60-7. NC1044.2 +264900 MOVE "MOVE-TEST-F1-60-7 " TO PAR-NAME. NC1044.2 +265000 PERFORM PRINT-DETAIL. NC1044.2 +265100 MOVE-TEST-F1-60-8. NC1044.2 +265200 IF ANDATA8 EQUAL TO "ABCDEFGH" NC1044.2 +265300 PERFORM PASS NC1044.2 +265400 GO TO MOVE-WRITE-F1-60-8. NC1044.2 +265500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +265600 MOVE ANDATA8 TO COMPUTED-A. NC1044.2 +265700 MOVE "ABCDEFGH" TO CORRECT-A. NC1044.2 +265800 PERFORM FAIL. NC1044.2 +265900 GO TO MOVE-WRITE-F1-60-8. NC1044.2 +266000 MOVE-DELETE-F1-60-8. NC1044.2 +266100 PERFORM DE-LETE. NC1044.2 +266200 MOVE-WRITE-F1-60-8. NC1044.2 +266300 MOVE "MOVE-TEST-F1-60-8 " TO PAR-NAME. NC1044.2 +266400 PERFORM PRINT-DETAIL. NC1044.2 +266500 MOVE-TEST-F1-60-9. NC1044.2 +266600 IF ANDATA9 EQUAL TO "ABCDEFGHI" NC1044.2 +266700 PERFORM PASS NC1044.2 +266800 GO TO MOVE-WRITE-F1-60-9. NC1044.2 +266900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +267000 MOVE ANDATA9 TO COMPUTED-A. NC1044.2 +267100 MOVE "ABCDEFGHI" TO CORRECT-A. NC1044.2 +267200 PERFORM FAIL. NC1044.2 +267300 GO TO MOVE-WRITE-F1-60-9. NC1044.2 +267400 MOVE-DELETE-F1-60-9. NC1044.2 +267500 PERFORM DE-LETE. NC1044.2 +267600 MOVE-WRITE-F1-60-9. NC1044.2 +267700 MOVE "MOVE-TEST-F1-60-9 " TO PAR-NAME. NC1044.2 +267800 PERFORM PRINT-DETAIL. NC1044.2 +267900 MOVE-TEST-F1-60-10. NC1044.2 +268000 IF ANDATA10 EQUAL TO "ABCDEFGHIJ" NC1044.2 +268100 PERFORM PASS NC1044.2 +268200 GO TO MOVE-WRITE-F1-60-10. NC1044.2 +268300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +268400 MOVE ANDATA10 TO COMPUTED-A. NC1044.2 +268500 MOVE "ABCDEFGHIJ" TO CORRECT-A. NC1044.2 +268600 PERFORM FAIL. NC1044.2 +268700 GO TO MOVE-WRITE-F1-60-10. NC1044.2 +268800 MOVE-DELETE-F1-60-10. NC1044.2 +268900 PERFORM DE-LETE. NC1044.2 +269000 MOVE-WRITE-F1-60-10. NC1044.2 +269100 MOVE "MOVE-TEST-F1-60-10 " TO PAR-NAME. NC1044.2 +269200 PERFORM PRINT-DETAIL. NC1044.2 +269300 MOVE-TEST-F1-60-11. NC1044.2 +269400 IF ANDATA11 EQUAL TO "ABCDEFGHIJK" NC1044.2 +269500 PERFORM PASS NC1044.2 +269600 GO TO MOVE-WRITE-F1-60-11. NC1044.2 +269700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +269800 MOVE ANDATA11 TO COMPUTED-A. NC1044.2 +269900 MOVE "ABCDEFGHIJK" TO CORRECT-A. NC1044.2 +270000 PERFORM FAIL. NC1044.2 +270100 GO TO MOVE-WRITE-F1-60-11. NC1044.2 +270200 MOVE-DELETE-F1-60-11. NC1044.2 +270300 PERFORM DE-LETE. NC1044.2 +270400 MOVE-WRITE-F1-60-11. NC1044.2 +270500 MOVE "MOVE-TEST-F1-60-11 " TO PAR-NAME. NC1044.2 +270600 PERFORM PRINT-DETAIL. NC1044.2 +270700 MOVE-TEST-F1-60-12. NC1044.2 +270800 IF ANDATA12 EQUAL TO "ABCDEFGHIJKL" NC1044.2 +270900 PERFORM PASS NC1044.2 +271000 GO TO MOVE-WRITE-F1-60-12. NC1044.2 +271100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +271200 MOVE ANDATA12 TO COMPUTED-A. NC1044.2 +271300 MOVE "ABCDEFGHIJKL" TO CORRECT-A. NC1044.2 +271400 PERFORM FAIL. NC1044.2 +271500 GO TO MOVE-WRITE-F1-60-12. NC1044.2 +271600 MOVE-DELETE-F1-60-12. NC1044.2 +271700 PERFORM DE-LETE. NC1044.2 +271800 MOVE-WRITE-F1-60-12. NC1044.2 +271900 MOVE "MOVE-TEST-F1-60-12 " TO PAR-NAME. NC1044.2 +272000 PERFORM PRINT-DETAIL. NC1044.2 +272100 MOVE-TEST-F1-60-13. NC1044.2 +272200 IF ANDATA13 EQUAL TO "ABCDEFGHIJKLM" NC1044.2 +272300 PERFORM PASS NC1044.2 +272400 GO TO MOVE-WRITE-F1-60-13. NC1044.2 +272500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +272600 MOVE ANDATA13 TO COMPUTED-A. NC1044.2 +272700 MOVE "ABCDEFGHIJKLM" TO CORRECT-A. NC1044.2 +272800 PERFORM FAIL. NC1044.2 +272900 GO TO MOVE-WRITE-F1-60-13. NC1044.2 +273000 MOVE-DELETE-F1-60-13. NC1044.2 +273100 PERFORM DE-LETE. NC1044.2 +273200 MOVE-WRITE-F1-60-13. NC1044.2 +273300 MOVE "MOVE-TEST-F1-60-13 " TO PAR-NAME. NC1044.2 +273400 PERFORM PRINT-DETAIL. NC1044.2 +273500 MOVE-TEST-F1-60-14. NC1044.2 +273600 IF ANDATA14 EQUAL TO "ABCDEFGHIJKLMN" NC1044.2 +273700 PERFORM PASS NC1044.2 +273800 GO TO MOVE-WRITE-F1-60-14. NC1044.2 +273900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +274000 MOVE ANDATA14 TO COMPUTED-A. NC1044.2 +274100 MOVE "ABCDEFGHIJKLMN" TO CORRECT-A. NC1044.2 +274200 PERFORM FAIL. NC1044.2 +274300 GO TO MOVE-WRITE-F1-60-14. NC1044.2 +274400 MOVE-DELETE-F1-60-14. NC1044.2 +274500 PERFORM DE-LETE. NC1044.2 +274600 MOVE-WRITE-F1-60-14. NC1044.2 +274700 MOVE "MOVE-TEST-F1-60-14 " TO PAR-NAME. NC1044.2 +274800 PERFORM PRINT-DETAIL. NC1044.2 +274900 MOVE-TEST-F1-60-15. NC1044.2 +275000 IF ANDATA15 EQUAL TO "ABCDEFGHIJKLMNO" NC1044.2 +275100 PERFORM PASS NC1044.2 +275200 GO TO MOVE-WRITE-F1-60-15. NC1044.2 +275300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +275400 MOVE ANDATA15 TO COMPUTED-A. NC1044.2 +275500 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC1044.2 +275600 PERFORM FAIL. NC1044.2 +275700 GO TO MOVE-WRITE-F1-60-15. NC1044.2 +275800 MOVE-DELETE-F1-60-15. NC1044.2 +275900 PERFORM DE-LETE. NC1044.2 +276000 MOVE-WRITE-F1-60-15. NC1044.2 +276100 MOVE "MOVE-TEST-F1-60-15 " TO PAR-NAME. NC1044.2 +276200 PERFORM PRINT-DETAIL. NC1044.2 +276300 MOVE-TEST-F1-60-16. NC1044.2 +276400 IF ANDATA16 EQUAL TO "ABCDEFGHIJKLMNOP" NC1044.2 +276500 PERFORM PASS NC1044.2 +276600 GO TO MOVE-WRITE-F1-60-16. NC1044.2 +276700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +276800 MOVE ANDATA16 TO COMPUTED-A. NC1044.2 +276900 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-A. NC1044.2 +277000 PERFORM FAIL. NC1044.2 +277100 GO TO MOVE-WRITE-F1-60-16. NC1044.2 +277200 MOVE-DELETE-F1-60-16. NC1044.2 +277300 PERFORM DE-LETE. NC1044.2 +277400 MOVE-WRITE-F1-60-16. NC1044.2 +277500 MOVE "MOVE-TEST-F1-60-16 " TO PAR-NAME. NC1044.2 +277600 PERFORM PRINT-DETAIL. NC1044.2 +277700 MOVE-TEST-F1-60-17. NC1044.2 +277800 IF ANDATA17 EQUAL TO "ABCDEFGHIJKLMNOPQ" NC1044.2 +277900 PERFORM PASS NC1044.2 +278000 GO TO MOVE-WRITE-F1-60-17. NC1044.2 +278100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +278200 MOVE ANDATA17 TO COMPUTED-A. NC1044.2 +278300 MOVE "ABCDEFGHIJKLMNOPQ" TO CORRECT-A. NC1044.2 +278400 PERFORM FAIL. NC1044.2 +278500 GO TO MOVE-WRITE-F1-60-17. NC1044.2 +278600 MOVE-DELETE-F1-60-17. NC1044.2 +278700 PERFORM DE-LETE. NC1044.2 +278800 MOVE-WRITE-F1-60-17. NC1044.2 +278900 MOVE "MOVE-TEST-F1-60-17 " TO PAR-NAME. NC1044.2 +279000 PERFORM PRINT-DETAIL. NC1044.2 +279100 MOVE-TEST-F1-60-18. NC1044.2 +279200 IF ANDATA18 EQUAL TO "ABCDEFGHIJKLMNOPQR" NC1044.2 +279300 PERFORM PASS NC1044.2 +279400 GO TO MOVE-WRITE-F1-60-18. NC1044.2 +279500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +279600 MOVE ANDATA18 TO COMPUTED-A. NC1044.2 +279700 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A. NC1044.2 +279800 PERFORM FAIL. NC1044.2 +279900 GO TO MOVE-WRITE-F1-60-18. NC1044.2 +280000 MOVE-DELETE-F1-60-18. NC1044.2 +280100 PERFORM DE-LETE. NC1044.2 +280200 MOVE-WRITE-F1-60-18. NC1044.2 +280300 MOVE "MOVE-TEST-F1-60-18 " TO PAR-NAME. NC1044.2 +280400 PERFORM PRINT-DETAIL. NC1044.2 +280500 MOVE-TEST-F1-60-19. NC1044.2 +280600 IF ANDATA19 EQUAL TO "ABCDEFGHIJKLMNOPQRS" NC1044.2 +280700 PERFORM PASS NC1044.2 +280800 GO TO MOVE-WRITE-F1-60-19. NC1044.2 +280900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +281000 MOVE ANDATA19 TO COMPUTED-A. NC1044.2 +281100 MOVE "ABCDEFGHIJKLMNOPQRS" TO CORRECT-A. NC1044.2 +281200 PERFORM FAIL. NC1044.2 +281300 GO TO MOVE-WRITE-F1-60-19. NC1044.2 +281400 MOVE-DELETE-F1-60-19. NC1044.2 +281500 PERFORM DE-LETE. NC1044.2 +281600 MOVE-WRITE-F1-60-19. NC1044.2 +281700 MOVE "MOVE-TEST-F1-60-19 " TO PAR-NAME. NC1044.2 +281800 PERFORM PRINT-DETAIL. NC1044.2 +281900 MOVE-TEST-F1-60-20. NC1044.2 +282000 IF ANDATA20 EQUAL TO "ABCDEFGHIJKLMNOPQRST" NC1044.2 +282100 PERFORM PASS NC1044.2 +282200 GO TO MOVE-WRITE-F1-60-20. NC1044.2 +282300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +282400 MOVE ANDATA20 TO COMPUTED-A. NC1044.2 +282500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1044.2 +282600 PERFORM FAIL. NC1044.2 +282700 GO TO MOVE-WRITE-F1-60-20. NC1044.2 +282800 MOVE-DELETE-F1-60-20. NC1044.2 +282900 PERFORM DE-LETE. NC1044.2 +283000 MOVE-WRITE-F1-60-20. NC1044.2 +283100 MOVE "MOVE-TEST-F1-60-20 " TO PAR-NAME. NC1044.2 +283200 PERFORM PRINT-DETAIL. NC1044.2 +283300 MOVE-TEST-F1-60-21. NC1044.2 +283400 IF ANDATA21 EQUAL TO "ABCDEFGHIJKLMNOPQRSTU" NC1044.2 +283500 PERFORM PASS NC1044.2 +283600 GO TO MOVE-WRITE-F1-60-21. NC1044.2 +283700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +283800 MOVE "SEE RE-MARK COL" TO COMPUTED-A. NC1044.2 +283900 MOVE ANDATA21 TO RE-MARK. NC1044.2 +284000 MOVE "ALPHABET A THRU U" TO CORRECT-A. NC1044.2 +284100 PERFORM FAIL. NC1044.2 +284200 GO TO MOVE-WRITE-F1-60-21. NC1044.2 +284300 MOVE-DELETE-F1-60-21. NC1044.2 +284400 PERFORM DE-LETE. NC1044.2 +284500 MOVE-WRITE-F1-60-21. NC1044.2 +284600 MOVE "MOVE-TEST-F1-60-21 " TO PAR-NAME. NC1044.2 +284700 PERFORM PRINT-DETAIL. NC1044.2 +284800 PERFORM END-ROUTINE. NC1044.2 +284900 CCVS-EXIT SECTION. NC1044.2 +285000 CCVS-999999. NC1044.2 +285100 GO TO CLOSE-FILES. NC1044.2 +*END-OF,NC104A +*HEADER,COBOL,NC105A +000100 IDENTIFICATION DIVISION. NC1054.2 +000200 PROGRAM-ID. NC1054.2 +000300 NC105A. NC1054.2 +000400**************************************************************** NC1054.2 +000500* * NC1054.2 +000600* VALIDATION FOR:- * NC1054.2 +000700* * NC1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +000900* * NC1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1054.2 +001100* * NC1054.2 +001200**************************************************************** NC1054.2 +001300* * NC1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1054.2 +001500* * NC1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1054.2 +001900* * NC1054.2 +002000**************************************************************** NC1054.2 +002100* NC1054.2 +002200* PROGRAM NC105A CONTAINS FURTHER TESTS OF FORMAT 1 OF NC1054.2 +002300* THE MOVE STATEMENT. NC1054.2 +002400* NC1054.2 +002500* (SEE ALSO NC104A). NC1054.2 +002600* NC1054.2 +002700 ENVIRONMENT DIVISION. NC1054.2 +002800 CONFIGURATION SECTION. NC1054.2 +002900 SOURCE-COMPUTER. NC1054.2 +003000 XXXXX082. NC1054.2 +003100 OBJECT-COMPUTER. NC1054.2 +003200 XXXXX083. NC1054.2 +003300 INPUT-OUTPUT SECTION. NC1054.2 +003400 FILE-CONTROL. NC1054.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1054.2 +003600 XXXXX055. NC1054.2 +003700 DATA DIVISION. NC1054.2 +003800 FILE SECTION. NC1054.2 +003900 FD PRINT-FILE NC1054.2 +004000 LABEL RECORDS NC1054.2 +004100 XXXXX084 NC1054.2 +004200 DATA RECORD IS PRINT-REC DUMMY-RECORD. NC1054.2 +004300 01 PRINT-REC PICTURE X(120). NC1054.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1054.2 +004500 WORKING-STORAGE SECTION. NC1054.2 +004600 77 LENGTH-COUNTER PICTURE 999 VALUE 000. NC1054.2 +004700 77 SPOS-LIT1 PICTURE S9(5) VALUE +60666. NC1054.2 +004800 77 SPOS-LIT2 PICTURE S9(5) VALUE +60667. NC1054.2 +004900 77 SNEG-LIT1 PICTURE S9(5) VALUE -70717. NC1054.2 +005000 77 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC1054.2 +005100 77 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC1054.2 +005200 77 TA--X PIC 9(5) COMPUTATIONAL. NC1054.2 +005300 77 WRK-CS-18V00 VALUE ZERO PICTURE 9(18) COMPUTATIONAL. NC1054.2 +005400 77 WRK-CS-01V00 VALUE ZERO PICTURE 9 COMPUTATIONAL. NC1054.2 +005500 77 WRK-CS-10V00 VALUE ZERO PICTURE 9(10) COMPUTATIONAL. NC1054.2 +005600 77 WRK-DS-18V00 VALUE ZERO PICTURE 9(18). NC1054.2 +005700 77 WRK-DS-01V00 VALUE ZERO PICTURE 9. NC1054.2 +005800 77 WRK-DS-10V00 VALUE ZERO PICTURE 9(10). NC1054.2 +005900 77 WRK-CS-08V08 PIC S9(8)V9(8) VALUE 832.553 COMPUTATIONAL. NC1054.2 +006000 77 WRK-CS-04V08 PIC S9(4)V9(8) VALUE 6382.47 COMPUTATIONAL. NC1054.2 +006100 77 WRK-DS-08V08 PIC S9(8)V9(8) VALUE ZERO. NC1054.2 +006200 77 WRK-DS-04V08 PIC S9(4)V9(8) VALUE ZERO. NC1054.2 +006300 77 WRK-EDIT-Z3VZ3 PIC ZZZ.ZZZ. NC1054.2 +006400 77 WRK-EDIT-05V00 PIC ****9. NC1054.2 +006500 77 WRK-EDIT-18V00 PIC ZZZZZZZZZZZZZZZZZ9. NC1054.2 +006600 77 WRK-EDIT-05V02 PIC -99999.99. NC1054.2 +006700 77 WRK-CS-03V00 PIC S999 COMPUTATIONAL. NC1054.2 +006800 77 MOVE74 PICTURE 9(9)V9 VALUE 234565432.1 NC1054.2 +006900 SYNCHRONIZED RIGHT COMPUTATIONAL. NC1054.2 +007000 77 MOVE75 PICTURE 9(10) NC1054.2 +007100 SYNCHRONIZED RIGHT COMPUTATIONAL. NC1054.2 +007200 77 EDIT-PICTURE-01 PICTURE 9B(15)99. NC1054.2 +007300 77 EDIT-PICTURE-02 PICTURE $0(10)999. NC1054.2 +007400 77 EDIT-DATA-1 PICTURE 999 VALUE 333. NC1054.2 +007500 77 EDIT-DATA-2 PICTURE 999 VALUE 916. NC1054.2 +007600 01 GRP-EDIT-PIC-05. NC1054.2 +007700 02 EDIT-PIC-05 PICTURE $$$,999.99. NC1054.2 +007800 01 GRP-EDIT-PIC-06. NC1054.2 +007900 02 EDIT-PIC-06 PICTURE $$$B999.99. NC1054.2 +008000 01 GRP-EDIT-PIC-07. NC1054.2 +008100 02 EDIT-PIC-07 PICTURE +++,999.99. NC1054.2 +008200 01 GRP-EDIT-PIC-08. NC1054.2 +008300 02 EDIT-PIC-08 PICTURE ---,999.99. NC1054.2 +008400 01 GRP-EDIT-PIC-09. NC1054.2 +008500 02 EDIT-PIC-09 PICTURE ***,999.99. NC1054.2 +008600 01 GRP-EDIT-PIC-10. NC1054.2 +008700 02 EDIT-PIC-10 PICTURE ZZZ,999.99. NC1054.2 +008800 01 GRP-MOVE-CONSTANTS. NC1054.2 +008900 03 GRP-GROUP-MOVE-FROM. NC1054.2 +009000 04 GRP-ALPHABETIC. NC1054.2 +009100 05 ALPHABET-AN-00026 PICTURE A(26) NC1054.2 +009200 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC1054.2 +009300 04 GRP-NUMERIC. NC1054.2 +009400 05 DIGITS-DU-10V00 PICTURE 9(10) NC1054.2 +009500 VALUE 0123456789. NC1054.2 +009600 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DU-10V00 NC1054.2 +009700 PICTURE 9(6)V9999. NC1054.2 +009800 04 GRP-ALPHANUMERIC. NC1054.2 +009900 05 ALPHANUMERIC-XN-00049 PICTURE X(49) NC1054.2 +010000 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789". NC1054.2 +010100 01 GRP-ALPHANUMERIC-1001. NC1054.2 +010200 04 GRP-ALPHANUMERIC-1002. NC1054.2 +010300 05 ALPHANUMERIC-XN-00050 PICTURE X(50) VALUE NC1054.2 +010400 "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789 ". NC1054.2 +010500 01 GRP-MOVE-RECEIVING-FIELDS. NC1054.2 +010600 03 GRP-GROUP-MOVE-TO. NC1054.2 +010700 04 GRP-WRK-AN-00026. NC1054.2 +010800 05 WRK-AN-00026 PICTURE A(26). NC1054.2 +010900 04 GRP-WRK-DU-10V00. NC1054.2 +011000 05 WRK-DU-10V00 PICTURE 9(10). NC1054.2 +011100 04 GRP-WRK-XN-00049. NC1054.2 +011200 05 WRK-XN-00049 PICTURE X(49). NC1054.2 +011300 04 GRP-NE-0001. NC1054.2 +011400 05 NE-0001 PICTURE ZZZ,999.999,9. NC1054.2 +011500 04 GRP-NE-0002. NC1054.2 +011600 05 NE-0002 PICTURE Z(7),999. NC1054.2 +011700 04 GRP-AE-0001. NC1054.2 +011800 05 AE-0001 PICTURE X(26)BX(12)0X(10). NC1054.2 +011900 04 GRP-AE-0002. NC1054.2 +012000 05 AE-0002 PICTURE XX0XXBXXX. NC1054.2 +012100 01 GRP-NUMERIC-99 PICTURE 99 VALUE 99. NC1054.2 +012200 01 GRP-RECEIVING. NC1054.2 +012300 02 RECEIVE-1. NC1054.2 +012400 03 RECEIVE-2 PICTURE 99 VALUE 03. NC1054.2 +012500 03 RECEIVE-3 PICTURE 9A9 VALUE ZERO. NC1054.2 +012600 02 RECEIVE-4 PICTURE 9(5)V99 VALUE ZERO. NC1054.2 +012700 02 RECEIVE-5 PICTURE X(4) VALUE ZERO. NC1054.2 +012800 02 RECEIVE-6. NC1054.2 +012900 03 RECEIVE-7 PICTURE 999 VALUE ZERO. NC1054.2 +013000 03 RECEIVE-8 PICTURE AA VALUE "AA". NC1054.2 +013100 01 SEND-BREAKDOWN. NC1054.2 +013200 02 FIRST-20S PICTURE X(20). NC1054.2 +013300 02 SECOND-20S PICTURE X(20). NC1054.2 +013400 02 THIRD-20S PICTURE X(20). NC1054.2 +013500 02 FOURTH-20S PICTURE X(20). NC1054.2 +013600 02 FIFTH-20S PICTURE X(20). NC1054.2 +013700 02 SIXTH-20S PICTURE X(20). NC1054.2 +013800 01 RECEIVE-BREAKDOWN. NC1054.2 +013900 02 FIRST-20R PICTURE X(20). NC1054.2 +014000 02 SECOND-20R PICTURE X(20). NC1054.2 +014100 02 THIRD-20R PICTURE X(20). NC1054.2 +014200 02 FOURTH-20R PICTURE X(20). NC1054.2 +014300 02 FIFTH-20R PICTURE X(20). NC1054.2 +014400 02 SIXTH-20R PICTURE X(20). NC1054.2 +014500 01 FORTY-NINE-COMPARE. NC1054.2 +014600 02 FIRST-26 PICTURE X(26). NC1054.2 +014700 02 PADD-REST PICTURE X(23). NC1054.2 +014800 01 HIGH-VALUE-EDIT. NC1054.2 +014900 02 HIGH-1 PICTURE XX VALUE HIGH-VALUE. NC1054.2 +015000 02 FILLER PICTURE 9 VALUE 0. NC1054.2 +015100 02 HIGH-2 PICTURE XX VALUE HIGH-VALUE. NC1054.2 +015200 02 FILLER PICTURE X VALUE SPACE. NC1054.2 +015300 02 HIGH-3 PICTURE XXX VALUE HIGH-VALUE. NC1054.2 +015400 01 HIGH-VALU-10LONG PICTURE X(10) VALUE HIGH-VALUE. NC1054.2 +015500 01 LOW-VALU-10LONG PICTURE X(10) VALUE LOW-VALUE. NC1054.2 +015600 01 HIGH-VALU-49LONG PICTURE X(49) VALUE HIGH-VALUE. NC1054.2 +015700 01 LOW-VALU-49LONG PICTURE X(49) VALUE LOW-VALUE. NC1054.2 +015800 01 QUOTE-10LONG PICTURE X(10) VALUE QUOTE. NC1054.2 +015900 01 QUOTE-49LONG PICTURE X(49) VALUE QUOTE. NC1054.2 +016000 01 MOVE1 PICTURE IS 9(5) NC1054.2 +016100 VALUE IS 12345. NC1054.2 +016200 01 MOVE2 PICTURE IS 9(5). NC1054.2 +016300 01 MOVE3 PICTURE IS 99. NC1054.2 +016400 01 MOVE5 PICTURE IS 99V999. NC1054.2 +016500 01 MOVE6 PICTURE IS V99999. NC1054.2 +016600 01 MOVE7 PICTURE IS 9V99. NC1054.2 +016700 01 MOVE16 PICTURE IS 9(5)CR. NC1054.2 +016800 01 MOVE20 PICTURE IS X(4). NC1054.2 +016900 01 MOVE21 PICTURE IS X(7). NC1054.2 +017000 01 MOVE23 PICTURE IS 999V99 NC1054.2 +017100 VALUE IS 123.45. NC1054.2 +017200 01 MOVE29 PICTURE IS 9999V999. NC1054.2 +017300 01 MOVE29X REDEFINES MOVE29 PICTURE IS X(7). NC1054.2 +017400 01 MOVE29A VALUE IS "$123.45". NC1054.2 +017500 02 MOVE30 PICTURE IS $999.99. NC1054.2 +017600 01 MOVE32 PICTURE IS X(5) NC1054.2 +017700 VALUE IS "ABCDE". NC1054.2 +017800 01 MOVE35 PICTURE IS A(3). NC1054.2 +017900 01 MOVE35A VALUE IS "1 A05". NC1054.2 +018000 02 MOVE36 PICTURE IS XBA09. NC1054.2 +018100 01 MOVE37 PICTURE IS AAAAA NC1054.2 +018200 VALUE IS "ABCDE". NC1054.2 +018300 01 MOVE39 PICTURE IS 0XXXXX0. NC1054.2 +018400 01 MOVE40 PICTURE IS 9999V9. NC1054.2 +018500 01 MOVE41 PICTURE IS A(7) NC1054.2 +018600 JUSTIFIED RIGHT. NC1054.2 +018700 01 MOVE42. NC1054.2 +018800 02 MOVE43. NC1054.2 +018900 03 MOVE43A PICTURE IS 999 NC1054.2 +019000 VALUE IS 123. NC1054.2 +019100 03 MOVE43B PICTURE IS AAA NC1054.2 +019200 VALUE IS "ABC". NC1054.2 +019300 02 MOVE43C. NC1054.2 +019400 03 MOVE44 PICTURE IS 999 NC1054.2 +019500 VALUE IS 123. NC1054.2 +019600 03 MOVE45 PICTURE IS AAA NC1054.2 +019700 VALUE IS "ABC". NC1054.2 +019800 02 MOVE46 REDEFINES MOVE43C. NC1054.2 +019900 03 MOVE47 PICTURE IS X OCCURS NC1054.2 +020000 6 TIMES. NC1054.2 +020100 01 MOVE47A. NC1054.2 +020200 02 MOVE48 PICTURE IS 9V9(17). NC1054.2 +020300 02 MOVE49 PICTURE IS 9(5) NC1054.2 +020400 VALUE IS 00045. NC1054.2 +020500 02 MOVE51 PICTURE IS S9(5) NC1054.2 +020600 VALUE IS -12345. NC1054.2 +020700 02 MOVE51A PICTURE IS S9(5) NC1054.2 +020800 VALUE IS -00045. NC1054.2 +020900 02 MOVE52 PICTURE IS 9(5)-. NC1054.2 +021000 01 MOVE66 PICTURE IS 9(5)DB. NC1054.2 +021100 01 MOVE67 PICTURE IS 9(5)+. NC1054.2 +021200 01 MOVE68 PICTURE IS ++++99. NC1054.2 +021300 01 MOVE69 PICTURE IS ----99. NC1054.2 +021400 01 MOVE70 PICTURE IS 9(5). NC1054.2 +021500 01 MOVE71 PICTURE X(20). NC1054.2 +021600 01 MOVE72 PICTURE 9(10) NC1054.2 +021700 VALUE 3344556677. NC1054.2 +021800 01 MOVE73 PICTURE X(5)BA(10)0X. NC1054.2 +021900 01 GRP-LEV-NUMERIC. NC1054.2 +022000 02 NUMERIC-LIT PICTURE 9(5). NC1054.2 +022100 02 CU-05V00-001 PIC 9(5) USAGE COMP. NC1054.2 +022200 02 CU-03V02-001 PIC 999V99 USAGE COMP. NC1054.2 +022300 02 CS-05V00-001 PIC S9(5) USAGE IS COMP. NC1054.2 +022400 01 TEST-RESULTS. NC1054.2 +022500 02 FILLER PIC X VALUE SPACE. NC1054.2 +022600 02 FEATURE PIC X(20) VALUE SPACE. NC1054.2 +022700 02 FILLER PIC X VALUE SPACE. NC1054.2 +022800 02 P-OR-F PIC X(5) VALUE SPACE. NC1054.2 +022900 02 FILLER PIC X VALUE SPACE. NC1054.2 +023000 02 PAR-NAME. NC1054.2 +023100 03 FILLER PIC X(19) VALUE SPACE. NC1054.2 +023200 03 PARDOT-X PIC X VALUE SPACE. NC1054.2 +023300 03 DOTVALUE PIC 99 VALUE ZERO. NC1054.2 +023400 02 FILLER PIC X(8) VALUE SPACE. NC1054.2 +023500 02 RE-MARK PIC X(61). NC1054.2 +023600 01 TEST-COMPUTED. NC1054.2 +023700 02 FILLER PIC X(30) VALUE SPACE. NC1054.2 +023800 02 FILLER PIC X(17) VALUE NC1054.2 +023900 " COMPUTED=". NC1054.2 +024000 02 COMPUTED-X. NC1054.2 +024100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1054.2 +024200 03 COMPUTED-N REDEFINES COMPUTED-A NC1054.2 +024300 PIC -9(9).9(9). NC1054.2 +024400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1054.2 +024500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1054.2 +024600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1054.2 +024700 03 CM-18V0 REDEFINES COMPUTED-A. NC1054.2 +024800 04 COMPUTED-18V0 PIC -9(18). NC1054.2 +024900 04 FILLER PIC X. NC1054.2 +025000 03 FILLER PIC X(50) VALUE SPACE. NC1054.2 +025100 01 TEST-CORRECT. NC1054.2 +025200 02 FILLER PIC X(30) VALUE SPACE. NC1054.2 +025300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1054.2 +025400 02 CORRECT-X. NC1054.2 +025500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1054.2 +025600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1054.2 +025700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1054.2 +025800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1054.2 +025900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1054.2 +026000 03 CR-18V0 REDEFINES CORRECT-A. NC1054.2 +026100 04 CORRECT-18V0 PIC -9(18). NC1054.2 +026200 04 FILLER PIC X. NC1054.2 +026300 03 FILLER PIC X(2) VALUE SPACE. NC1054.2 +026400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1054.2 +026500 01 CCVS-C-1. NC1054.2 +026600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1054.2 +026700- "SS PARAGRAPH-NAME NC1054.2 +026800- " REMARKS". NC1054.2 +026900 02 FILLER PIC X(20) VALUE SPACE. NC1054.2 +027000 01 CCVS-C-2. NC1054.2 +027100 02 FILLER PIC X VALUE SPACE. NC1054.2 +027200 02 FILLER PIC X(6) VALUE "TESTED". NC1054.2 +027300 02 FILLER PIC X(15) VALUE SPACE. NC1054.2 +027400 02 FILLER PIC X(4) VALUE "FAIL". NC1054.2 +027500 02 FILLER PIC X(94) VALUE SPACE. NC1054.2 +027600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1054.2 +027700 01 REC-CT PIC 99 VALUE ZERO. NC1054.2 +027800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1054.2 +027900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1054.2 +028300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1054.2 +028400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1054.2 +028500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1054.2 +028600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1054.2 +028700 01 CCVS-H-1. NC1054.2 +028800 02 FILLER PIC X(39) VALUE SPACES. NC1054.2 +028900 02 FILLER PIC X(42) VALUE NC1054.2 +029000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1054.2 +029100 02 FILLER PIC X(39) VALUE SPACES. NC1054.2 +029200 01 CCVS-H-2A. NC1054.2 +029300 02 FILLER PIC X(40) VALUE SPACE. NC1054.2 +029400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1054.2 +029500 02 FILLER PIC XXXX VALUE NC1054.2 +029600 "4.2 ". NC1054.2 +029700 02 FILLER PIC X(28) VALUE NC1054.2 +029800 " COPY - NOT FOR DISTRIBUTION". NC1054.2 +029900 02 FILLER PIC X(41) VALUE SPACE. NC1054.2 +030000 NC1054.2 +030100 01 CCVS-H-2B. NC1054.2 +030200 02 FILLER PIC X(15) VALUE NC1054.2 +030300 "TEST RESULT OF ". NC1054.2 +030400 02 TEST-ID PIC X(9). NC1054.2 +030500 02 FILLER PIC X(4) VALUE NC1054.2 +030600 " IN ". NC1054.2 +030700 02 FILLER PIC X(12) VALUE NC1054.2 +030800 " HIGH ". NC1054.2 +030900 02 FILLER PIC X(22) VALUE NC1054.2 +031000 " LEVEL VALIDATION FOR ". NC1054.2 +031100 02 FILLER PIC X(58) VALUE NC1054.2 +031200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +031300 01 CCVS-H-3. NC1054.2 +031400 02 FILLER PIC X(34) VALUE NC1054.2 +031500 " FOR OFFICIAL USE ONLY ". NC1054.2 +031600 02 FILLER PIC X(58) VALUE NC1054.2 +031700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1054.2 +031800 02 FILLER PIC X(28) VALUE NC1054.2 +031900 " COPYRIGHT 1985 ". NC1054.2 +032000 01 CCVS-E-1. NC1054.2 +032100 02 FILLER PIC X(52) VALUE SPACE. NC1054.2 +032200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1054.2 +032300 02 ID-AGAIN PIC X(9). NC1054.2 +032400 02 FILLER PIC X(45) VALUE SPACES. NC1054.2 +032500 01 CCVS-E-2. NC1054.2 +032600 02 FILLER PIC X(31) VALUE SPACE. NC1054.2 +032700 02 FILLER PIC X(21) VALUE SPACE. NC1054.2 +032800 02 CCVS-E-2-2. NC1054.2 +032900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1054.2 +033000 03 FILLER PIC X VALUE SPACE. NC1054.2 +033100 03 ENDER-DESC PIC X(44) VALUE NC1054.2 +033200 "ERRORS ENCOUNTERED". NC1054.2 +033300 01 CCVS-E-3. NC1054.2 +033400 02 FILLER PIC X(22) VALUE NC1054.2 +033500 " FOR OFFICIAL USE ONLY". NC1054.2 +033600 02 FILLER PIC X(12) VALUE SPACE. NC1054.2 +033700 02 FILLER PIC X(58) VALUE NC1054.2 +033800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +033900 02 FILLER PIC X(13) VALUE SPACE. NC1054.2 +034000 02 FILLER PIC X(15) VALUE NC1054.2 +034100 " COPYRIGHT 1985". NC1054.2 +034200 01 CCVS-E-4. NC1054.2 +034300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1054.2 +034400 02 FILLER PIC X(4) VALUE " OF ". NC1054.2 +034500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1054.2 +034600 02 FILLER PIC X(40) VALUE NC1054.2 +034700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1054.2 +034800 01 XXINFO. NC1054.2 +034900 02 FILLER PIC X(19) VALUE NC1054.2 +035000 "*** INFORMATION ***". NC1054.2 +035100 02 INFO-TEXT. NC1054.2 +035200 04 FILLER PIC X(8) VALUE SPACE. NC1054.2 +035300 04 XXCOMPUTED PIC X(20). NC1054.2 +035400 04 FILLER PIC X(5) VALUE SPACE. NC1054.2 +035500 04 XXCORRECT PIC X(20). NC1054.2 +035600 02 INF-ANSI-REFERENCE PIC X(48). NC1054.2 +035700 01 HYPHEN-LINE. NC1054.2 +035800 02 FILLER PIC IS X VALUE IS SPACE. NC1054.2 +035900 02 FILLER PIC IS X(65) VALUE IS "************************NC1054.2 +036000- "*****************************************". NC1054.2 +036100 02 FILLER PIC IS X(54) VALUE IS "************************NC1054.2 +036200- "******************************". NC1054.2 +036300 01 CCVS-PGM-ID PIC X(9) VALUE NC1054.2 +036400 "NC105A". NC1054.2 +036500 PROCEDURE DIVISION. NC1054.2 +036600 CCVS1 SECTION. NC1054.2 +036700 OPEN-FILES. NC1054.2 +036800 OPEN OUTPUT PRINT-FILE. NC1054.2 +036900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1054.2 +037000 MOVE SPACE TO TEST-RESULTS. NC1054.2 +037100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1054.2 +037200 GO TO CCVS1-EXIT. NC1054.2 +037300 CLOSE-FILES. NC1054.2 +037400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1054.2 +037500 TERMINATE-CCVS. NC1054.2 +037600S EXIT PROGRAM. NC1054.2 +037700STERMINATE-CALL. NC1054.2 +037800 STOP RUN. NC1054.2 +037900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1054.2 +038000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1054.2 +038100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1054.2 +038200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1054.2 +038300 MOVE "****TEST DELETED****" TO RE-MARK. NC1054.2 +038400 PRINT-DETAIL. NC1054.2 +038500 IF REC-CT NOT EQUAL TO ZERO NC1054.2 +038600 MOVE "." TO PARDOT-X NC1054.2 +038700 MOVE REC-CT TO DOTVALUE. NC1054.2 +038800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1054.2 +038900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1054.2 +039000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1054.2 +039100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1054.2 +039200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1054.2 +039300 MOVE SPACE TO CORRECT-X. NC1054.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1054.2 +039500 MOVE SPACE TO RE-MARK. NC1054.2 +039600 HEAD-ROUTINE. NC1054.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1054.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1054.2 +040100 COLUMN-NAMES-ROUTINE. NC1054.2 +040200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +040300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +040500 END-ROUTINE. NC1054.2 +040600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1054.2 +040700 END-RTN-EXIT. NC1054.2 +040800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +040900 END-ROUTINE-1. NC1054.2 +041000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1054.2 +041100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1054.2 +041200 ADD PASS-COUNTER TO ERROR-HOLD. NC1054.2 +041300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1054.2 +041400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1054.2 +041500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1054.2 +041600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1054.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1054.2 +041800 END-ROUTINE-12. NC1054.2 +041900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1054.2 +042000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1054.2 +042100 MOVE "NO " TO ERROR-TOTAL NC1054.2 +042200 ELSE NC1054.2 +042300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1054.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1054.2 +042500 PERFORM WRITE-LINE. NC1054.2 +042600 END-ROUTINE-13. NC1054.2 +042700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1054.2 +042800 MOVE "NO " TO ERROR-TOTAL ELSE NC1054.2 +042900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1054.2 +043000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1054.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043200 IF INSPECT-COUNTER EQUAL TO ZERO NC1054.2 +043300 MOVE "NO " TO ERROR-TOTAL NC1054.2 +043400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1054.2 +043500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1054.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043800 WRITE-LINE. NC1054.2 +043900 ADD 1 TO RECORD-COUNT. NC1054.2 +044000Y IF RECORD-COUNT GREATER 42 NC1054.2 +044100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1054.2 +044200Y MOVE SPACE TO DUMMY-RECORD NC1054.2 +044300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1054.2 +044400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1054.2 +044500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1054.2 +044600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1054.2 +044700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1054.2 +044800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +044900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +045000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +045100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1054.2 +045200Y MOVE ZERO TO RECORD-COUNT. NC1054.2 +045300 PERFORM WRT-LN. NC1054.2 +045400 WRT-LN. NC1054.2 +045500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1054.2 +045600 MOVE SPACE TO DUMMY-RECORD. NC1054.2 +045700 BLANK-LINE-PRINT. NC1054.2 +045800 PERFORM WRT-LN. NC1054.2 +045900 FAIL-ROUTINE. NC1054.2 +046000 IF COMPUTED-X NOT EQUAL TO SPACE NC1054.2 +046100 GO TO FAIL-ROUTINE-WRITE. NC1054.2 +046200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1054.2 +046300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1054.2 +046400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1054.2 +046500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +046600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1054.2 +046700 GO TO FAIL-ROUTINE-EX. NC1054.2 +046800 FAIL-ROUTINE-WRITE. NC1054.2 +046900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1054.2 +047000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1054.2 +047100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1054.2 +047200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1054.2 +047300 FAIL-ROUTINE-EX. EXIT. NC1054.2 +047400 BAIL-OUT. NC1054.2 +047500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1054.2 +047600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1054.2 +047700 BAIL-OUT-WRITE. NC1054.2 +047800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1054.2 +047900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1054.2 +048000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +048100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1054.2 +048200 BAIL-OUT-EX. EXIT. NC1054.2 +048300 CCVS1-EXIT. NC1054.2 +048400 EXIT. NC1054.2 +048500 SECT-NC105A-001 SECTION. NC1054.2 +048600 MOVE-INIT-F1-1. NC1054.2 +048700 MOVE "VI-102 6.18.2" TO ANSI-REFERENCE. NC1054.2 +048800 MOVE "MOVE LITERAL " TO FEATURE. NC1054.2 +048900 MOVE-TEST-F1-1-0. NC1054.2 +049000 MOVE 123.45 TO MOVE40. NC1054.2 +049100 MOVE-TEST-F1-1-1. NC1054.2 +049200 IF MOVE40 EQUAL TO 123.4 NC1054.2 +049300 PERFORM PASS NC1054.2 +049400 ELSE NC1054.2 +049500 GO TO MOVE-FAIL-F1-1. NC1054.2 +049600* NOTE NUMERIC LITERAL NON INTEGRAL TO NNI MOVE, TRUNCATION ON NC1054.2 +049700* RIGHT, ZERO PADDIND ON LEFT. NC1054.2 +049800 GO TO MOVE-WRITE-F1-1. NC1054.2 +049900 MOVE-DELETE-F1-1. NC1054.2 +050000 PERFORM DE-LETE. NC1054.2 +050100 GO TO MOVE-WRITE-F1-1. NC1054.2 +050200 MOVE-FAIL-F1-1. NC1054.2 +050300 MOVE MOVE40 TO COMPUTED-N. NC1054.2 +050400 MOVE 123.4 TO CORRECT-N. NC1054.2 +050500 PERFORM FAIL. NC1054.2 +050600 MOVE-WRITE-F1-1. NC1054.2 +050700 MOVE "MOVE-TEST-F1-1" TO PAR-NAME. NC1054.2 +050800 PERFORM PRINT-DETAIL. NC1054.2 +050900 MOVE-TEST-F1-2-0. NC1054.2 +051000 MOVE 123.45 TO MOVE5. NC1054.2 +051100 MOVE-TEST-F1-2-1. NC1054.2 +051200 IF MOVE5 EQUAL TO 23.45 NC1054.2 +051300 PERFORM PASS NC1054.2 +051400 ELSE NC1054.2 +051500 GO TO MOVE-FAIL-F1-2. NC1054.2 +051600* NOTE NUMERIC LITERAL NON-INTEGRAL TO NNI MOVE, TRUNCATION ON NC1054.2 +051700* LEFT, ZERO PADDING ON RIGHT. NC1054.2 +051800 GO TO MOVE-WRITE-F1-2. NC1054.2 +051900 MOVE-DELETE-F1-2. NC1054.2 +052000 PERFORM DE-LETE. NC1054.2 +052100 GO TO MOVE-WRITE-F1-2. NC1054.2 +052200 MOVE-FAIL-F1-2. NC1054.2 +052300 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +052400 MOVE 23.45 TO CORRECT-N. NC1054.2 +052500 PERFORM FAIL. NC1054.2 +052600 MOVE-WRITE-F1-2. NC1054.2 +052700 MOVE "MOVE-TEST-F1-2" TO PAR-NAME. NC1054.2 +052800 PERFORM PRINT-DETAIL. NC1054.2 +052900 MOVE-TEST-F1-3-0. NC1054.2 +053000 MOVE "ABCDE" TO MOVE21. NC1054.2 +053100 MOVE-TEST-F1-3-1. NC1054.2 +053200 IF MOVE21 EQUAL TO "ABCDE " NC1054.2 +053300 PERFORM PASS NC1054.2 +053400 ELSE NC1054.2 +053500 GO TO MOVE-FAIL-F1-3. NC1054.2 +053600* NOTE NON-NUMERIC LITERAL TO AN MOVE, SPACE PADDING ON RIGHT. NC1054.2 +053700 GO TO MOVE-WRITE-F1-3. NC1054.2 +053800 MOVE-DELETE-F1-3. NC1054.2 +053900 PERFORM DE-LETE. NC1054.2 +054000 GO TO MOVE-WRITE-F1-3. NC1054.2 +054100 MOVE-FAIL-F1-3. NC1054.2 +054200 MOVE MOVE21 TO COMPUTED-A. NC1054.2 +054300 MOVE "ABCDE " TO CORRECT-A. NC1054.2 +054400 PERFORM FAIL. NC1054.2 +054500 MOVE-WRITE-F1-3. NC1054.2 +054600 MOVE "MOVE-TEST-F1-3" TO PAR-NAME. NC1054.2 +054700 PERFORM PRINT-DETAIL. NC1054.2 +054800 MOVE-TEST-F1-4-0. NC1054.2 +054900 MOVE "ABCDE" TO MOVE20. NC1054.2 +055000 MOVE-TEST-F1-4-1. NC1054.2 +055100 IF MOVE20 EQUAL TO "ABCD" NC1054.2 +055200 PERFORM PASS NC1054.2 +055300 ELSE NC1054.2 +055400 GO TO MOVE-FAIL-F1-4. NC1054.2 +055500* NOTE NON-NUMERIC LITERAL TO AN MOVE, TRUNCATION ON RIGHT. NC1054.2 +055600 GO TO MOVE-WRITE-F1-4. NC1054.2 +055700 MOVE-DELETE-F1-4. NC1054.2 +055800 PERFORM DE-LETE. NC1054.2 +055900 GO TO MOVE-WRITE-F1-4. NC1054.2 +056000 MOVE-FAIL-F1-4. NC1054.2 +056100 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +056200 MOVE "ABCD" TO CORRECT-A. NC1054.2 +056300 PERFORM FAIL. NC1054.2 +056400 MOVE-WRITE-F1-4. NC1054.2 +056500 MOVE "MOVE-TEST-F1-4" TO PAR-NAME. NC1054.2 +056600 PERFORM PRINT-DETAIL. NC1054.2 +056700 MOVE-INIT-F1-5. NC1054.2 +056800 MOVE "MISC MOVE " TO FEATURE. NC1054.2 +056900 MOVE 12345 TO MOVE1. NC1054.2 +057000 MOVE-TEST-F1-5-0. NC1054.2 +057100 MOVE MOVE1 TO TA--X. NC1054.2 +057200 MOVE-TEST-F1-5-1. NC1054.2 +057300 IF TA--X EQUAL TO 12345 NC1054.2 +057400 PERFORM PASS NC1054.2 +057500 ELSE NC1054.2 +057600 GO TO MOVE-FAIL-F1-5. NC1054.2 +057700* NOTE NUMERIC LITERAL TO COMP, ZERO FILL ON LEFT. NC1054.2 +057800 GO TO MOVE-WRITE-F1-5. NC1054.2 +057900 MOVE-DELETE-F1-5. NC1054.2 +058000 PERFORM DE-LETE. NC1054.2 +058100 GO TO MOVE-WRITE-F1-5. NC1054.2 +058200 MOVE-FAIL-F1-5. NC1054.2 +058300 MOVE TA--X TO COMPUTED-N. NC1054.2 +058400 MOVE 12345 TO CORRECT-N. NC1054.2 +058500 PERFORM FAIL. NC1054.2 +058600 MOVE-WRITE-F1-5. NC1054.2 +058700 MOVE "MOVE-TEST-F1-5" TO PAR-NAME. NC1054.2 +058800 PERFORM PRINT-DETAIL. NC1054.2 +058900 MOVE-TEST-F1-6-0. NC1054.2 +059000 MOVE SPACE TO MOVE20. NC1054.2 +059100 MOVE-TEST-F1-6-1. NC1054.2 +059200 IF MOVE20 EQUAL TO " " NC1054.2 +059300 PERFORM PASS NC1054.2 +059400 ELSE NC1054.2 +059500 GO TO MOVE-FAIL-F1-6. NC1054.2 +059600* NOTE FIGURATIVE CONSTANT SPACE TO AN MOVE. NC1054.2 +059700 GO TO MOVE-WRITE-F1-6. NC1054.2 +059800 MOVE-DELETE-F1-6. NC1054.2 +059900 PERFORM DE-LETE. NC1054.2 +060000 GO TO MOVE-WRITE-F1-6. NC1054.2 +060100 MOVE-FAIL-F1-6. NC1054.2 +060200 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +060300 MOVE " " TO CORRECT-A. NC1054.2 +060400 PERFORM FAIL. NC1054.2 +060500 MOVE-WRITE-F1-6. NC1054.2 +060600 MOVE "MOVE-TEST-F1-6" TO PAR-NAME. NC1054.2 +060700 PERFORM PRINT-DETAIL. NC1054.2 +060800 MOVE-TEST-F1-7-0. NC1054.2 +060900 MOVE ZERO TO MOVE2. NC1054.2 +061000 MOVE-TEST-F1-7-1. NC1054.2 +061100 IF MOVE2 EQUAL TO 00000 NC1054.2 +061200 PERFORM PASS NC1054.2 +061300 ELSE NC1054.2 +061400 GO TO MOVE-FAIL-F1-7. NC1054.2 +061500* NOTE FIGURATIVE CONSTANT ZERO TO N MOVE. NC1054.2 +061600 GO TO MOVE-WRITE-F1-7. NC1054.2 +061700 MOVE-DELETE-F1-7. NC1054.2 +061800 PERFORM DE-LETE. NC1054.2 +061900 GO TO MOVE-WRITE-F1-7. NC1054.2 +062000 MOVE-FAIL-F1-7. NC1054.2 +062100 MOVE MOVE2 TO COMPUTED-N. NC1054.2 +062200 MOVE 00000 TO CORRECT-N. NC1054.2 +062300 PERFORM FAIL. NC1054.2 +062400 MOVE-WRITE-F1-7. NC1054.2 +062500 MOVE "MOVE-TEST-F1-7" TO PAR-NAME. NC1054.2 +062600 PERFORM PRINT-DETAIL. NC1054.2 +062700 MOVE-INIT-F1-8. NC1054.2 +062800 MOVE "ABCDE" TO MOVE32. NC1054.2 +062900 MOVE-TEST-F1-8-0. NC1054.2 +063000 MOVE MOVE32 TO MOVE41. NC1054.2 +063100 MOVE-TEST-F1-8-1. NC1054.2 +063200 IF MOVE41 EQUAL TO " ABCDE" NC1054.2 +063300 PERFORM PASS NC1054.2 +063400 ELSE NC1054.2 +063500 GO TO MOVE-FAIL-F1-8. NC1054.2 +063600* NOTE AN TO A MOVE, JUSTIFIED RIGHT. NC1054.2 +063700 GO TO MOVE-WRITE-F1-8. NC1054.2 +063800 MOVE-DELETE-F1-8. NC1054.2 +063900 PERFORM DE-LETE. NC1054.2 +064000 GO TO MOVE-WRITE-F1-8. NC1054.2 +064100 MOVE-FAIL-F1-8. NC1054.2 +064200 MOVE MOVE41 TO COMPUTED-A. NC1054.2 +064300 MOVE " ABCDE" TO CORRECT-A. NC1054.2 +064400 PERFORM FAIL. NC1054.2 +064500 MOVE-WRITE-F1-8. NC1054.2 +064600 MOVE "MOVE-TEST-F1-8" TO PAR-NAME. NC1054.2 +064700 PERFORM PRINT-DETAIL. NC1054.2 +064800 MOVE-INIT-F1-9. NC1054.2 +064900 MOVE "GROUP MOVE " TO FEATURE. NC1054.2 +065000 MOVE 12345 TO MOVE1. NC1054.2 +065100 MOVE-TEST-F1-9-0. NC1054.2 +065200 MOVE MOVE1 TO MOVE46. NC1054.2 +065300 MOVE-TEST-F1-9-1. NC1054.2 +065400 IF MOVE46 EQUAL TO "12345 " NC1054.2 +065500 PERFORM PASS NC1054.2 +065600 ELSE NC1054.2 +065700 GO TO MOVE-FAIL-F1-9. NC1054.2 +065800* NOTE NI TO GROUP MOVE. NC1054.2 +065900 GO TO MOVE-WRITE-F1-9. NC1054.2 +066000 MOVE-DELETE-F1-9. NC1054.2 +066100 PERFORM DE-LETE. NC1054.2 +066200 GO TO MOVE-WRITE-F1-9. NC1054.2 +066300 MOVE-FAIL-F1-9. NC1054.2 +066400 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +066500 MOVE "12345 " TO CORRECT-A. NC1054.2 +066600 PERFORM FAIL. NC1054.2 +066700 MOVE-WRITE-F1-9. NC1054.2 +066800 MOVE "MOVE-TEST-F1-9" TO PAR-NAME. NC1054.2 +066900 PERFORM PRINT-DETAIL. NC1054.2 +067000 MOVE-INIT-F1-10. NC1054.2 +067100 MOVE 123.45 TO MOVE23. NC1054.2 +067200 MOVE-TEST-F1-10-0. NC1054.2 +067300 MOVE MOVE23 TO MOVE46. NC1054.2 +067400 MOVE-TEST-F1-10-1. NC1054.2 +067500 IF MOVE46 EQUAL TO "12345 " NC1054.2 +067600 PERFORM PASS NC1054.2 +067700 ELSE NC1054.2 +067800 GO TO MOVE-FAIL-F1-10. NC1054.2 +067900* NOTE NNI TO GROUP MOVE. NC1054.2 +068000 GO TO MOVE-WRITE-F1-10. NC1054.2 +068100 MOVE-DELETE-F1-10. NC1054.2 +068200 PERFORM DE-LETE. NC1054.2 +068300 GO TO MOVE-WRITE-F1-10. NC1054.2 +068400 MOVE-FAIL-F1-10. NC1054.2 +068500 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +068600 MOVE "12345 " TO CORRECT-A. NC1054.2 +068700 PERFORM FAIL. NC1054.2 +068800 MOVE-WRITE-F1-10. NC1054.2 +068900 MOVE "MOVE-TEST-F1-10" TO PAR-NAME. NC1054.2 +069000 PERFORM PRINT-DETAIL. NC1054.2 +069100 MOVE-INIT-F1-11. NC1054.2 +069200 MOVE "$123.45" TO MOVE29A. NC1054.2 +069300 MOVE-TEST-F1-11-0. NC1054.2 +069400 MOVE MOVE30 TO MOVE46. NC1054.2 +069500 MOVE-TEST-F1-11-1. NC1054.2 +069600 IF MOVE46 EQUAL TO "$123.4" NC1054.2 +069700 PERFORM PASS NC1054.2 +069800 ELSE NC1054.2 +069900 GO TO MOVE-FAIL-F1-11. NC1054.2 +070000* NOTE NE TO GROUP MOVE. NC1054.2 +070100 GO TO MOVE-WRITE-F1-11. NC1054.2 +070200 MOVE-DELETE-F1-11. NC1054.2 +070300 PERFORM DE-LETE. NC1054.2 +070400 GO TO MOVE-WRITE-F1-11. NC1054.2 +070500 MOVE-FAIL-F1-11. NC1054.2 +070600 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +070700 MOVE "$123.4" TO CORRECT-A. NC1054.2 +070800 PERFORM FAIL. NC1054.2 +070900 MOVE-WRITE-F1-11. NC1054.2 +071000 MOVE "MOVE-TEST-F1-11" TO PAR-NAME. NC1054.2 +071100 PERFORM PRINT-DETAIL. NC1054.2 +071200 MOVE-INIT-F1-12. NC1054.2 +071300 MOVE "ABCDE" TO MOVE32. NC1054.2 +071400 MOVE-TEST-F1-12-0. NC1054.2 +071500 MOVE MOVE32 TO MOVE46. NC1054.2 +071600 MOVE-TEST-F1-12-1. NC1054.2 +071700 IF MOVE46 EQUAL TO "ABCDE " NC1054.2 +071800 PERFORM PASS NC1054.2 +071900 ELSE NC1054.2 +072000 GO TO MOVE-FAIL-F1-12. NC1054.2 +072100* NOTE AN TO GROUP MOVE. NC1054.2 +072200 GO TO MOVE-WRITE-F1-12. NC1054.2 +072300 MOVE-DELETE-F1-12. NC1054.2 +072400 PERFORM DE-LETE. NC1054.2 +072500 GO TO MOVE-WRITE-F1-12. NC1054.2 +072600 MOVE-FAIL-F1-12. NC1054.2 +072700 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +072800 MOVE "ABCDE" TO CORRECT-A. NC1054.2 +072900 PERFORM FAIL. NC1054.2 +073000 MOVE-WRITE-F1-12. NC1054.2 +073100 MOVE "MOVE-TEST-F1-12" TO PAR-NAME. NC1054.2 +073200 PERFORM PRINT-DETAIL. NC1054.2 +073300 MOVE-INIT-F1-13. NC1054.2 +073400 MOVE "1 A05" TO MOVE35A. NC1054.2 +073500 MOVE-TEST-F1-13-0. NC1054.2 +073600 MOVE MOVE36 TO MOVE46. NC1054.2 +073700 MOVE-TEST-F1-13-1. NC1054.2 +073800 IF MOVE46 EQUAL TO "1 A05 " NC1054.2 +073900 PERFORM PASS NC1054.2 +074000 ELSE NC1054.2 +074100 GO TO MOVE-FAIL-F1-13. NC1054.2 +074200* NOTE AE TO GROUP MOVE. NC1054.2 +074300 GO TO MOVE-WRITE-F1-13. NC1054.2 +074400 MOVE-DELETE-F1-13. NC1054.2 +074500 PERFORM DE-LETE. NC1054.2 +074600 GO TO MOVE-WRITE-F1-13. NC1054.2 +074700 MOVE-FAIL-F1-13. NC1054.2 +074800 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +074900 MOVE "1 A05 " TO CORRECT-A. NC1054.2 +075000 PERFORM FAIL. NC1054.2 +075100 MOVE-WRITE-F1-13. NC1054.2 +075200 MOVE "MOVE-TEST-F1-13" TO PAR-NAME. NC1054.2 +075300 PERFORM PRINT-DETAIL. NC1054.2 +075400 MOVE-INIT-F1-14. NC1054.2 +075500 MOVE "ABCDE" TO MOVE37. NC1054.2 +075600 MOVE-TEST-F1-14-0. NC1054.2 +075700 MOVE MOVE37 TO MOVE46. NC1054.2 +075800 MOVE-TEST-F1-14-1. NC1054.2 +075900 IF MOVE46 EQUAL TO "ABCDE " NC1054.2 +076000 PERFORM PASS NC1054.2 +076100 ELSE NC1054.2 +076200 GO TO MOVE-FAIL-F1-14. NC1054.2 +076300* NOTE A TO GROUP MOVE. NC1054.2 +076400 GO TO MOVE-WRITE-F1-14. NC1054.2 +076500 MOVE-DELETE-F1-14. NC1054.2 +076600 PERFORM DE-LETE. NC1054.2 +076700 GO TO MOVE-WRITE-F1-14. NC1054.2 +076800 MOVE-FAIL-F1-14. NC1054.2 +076900 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +077000 MOVE "ABCDE " TO CORRECT-A. NC1054.2 +077100 PERFORM FAIL. NC1054.2 +077200 MOVE-WRITE-F1-14. NC1054.2 +077300 MOVE "MOVE-TEST-F1-14" TO PAR-NAME. NC1054.2 +077400 PERFORM PRINT-DETAIL. NC1054.2 +077500 MOVE-INIT-F1-15. NC1054.2 +077600 MOVE "123ABC" TO MOVE43. NC1054.2 +077700 MOVE-TEST-F1-15-0. NC1054.2 +077800 MOVE MOVE43 TO MOVE46. NC1054.2 +077900 MOVE-TEST-F1-15-1. NC1054.2 +078000 IF MOVE46 EQUAL TO "123ABC" NC1054.2 +078100 PERFORM PASS NC1054.2 +078200 ELSE NC1054.2 +078300 GO TO MOVE-FAIL-F1-15. NC1054.2 +078400* NOTE GROUP TO GROUP MOVE. NC1054.2 +078500 GO TO MOVE-WRITE-F1-15. NC1054.2 +078600 MOVE-DELETE-F1-15. NC1054.2 +078700 PERFORM DE-LETE. NC1054.2 +078800 GO TO MOVE-WRITE-F1-15. NC1054.2 +078900 MOVE-FAIL-F1-15. NC1054.2 +079000 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +079100 MOVE "123ABC" TO CORRECT-A. NC1054.2 +079200 PERFORM FAIL. NC1054.2 +079300 MOVE-WRITE-F1-15. NC1054.2 +079400 MOVE "MOVE-TEST-F1-15" TO PAR-NAME. NC1054.2 +079500 PERFORM PRINT-DETAIL. NC1054.2 +079600 MOVE-INIT-F1-16. NC1054.2 +079700 MOVE "123ABC" TO MOVE43. NC1054.2 +079800 MOVE-TEST-F1-16-0. NC1054.2 +079900 MOVE MOVE43 TO MOVE3. NC1054.2 +080000 MOVE-TEST-F1-16-1. NC1054.2 +080100 IF MOVE3 EQUAL TO 12 NC1054.2 +080200 PERFORM PASS NC1054.2 +080300 ELSE NC1054.2 +080400 GO TO MOVE-FAIL-F1-16. NC1054.2 +080500* NOTE GROUP TO NI MOVE. NC1054.2 +080600 GO TO MOVE-WRITE-F1-16. NC1054.2 +080700 MOVE-DELETE-F1-16. NC1054.2 +080800 PERFORM DE-LETE. NC1054.2 +080900 GO TO MOVE-WRITE-F1-16. NC1054.2 +081000 MOVE-FAIL-F1-16. NC1054.2 +081100 MOVE MOVE3 TO COMPUTED-N. NC1054.2 +081200 MOVE 12 TO CORRECT-N. NC1054.2 +081300 PERFORM FAIL. NC1054.2 +081400 MOVE-WRITE-F1-16. NC1054.2 +081500 MOVE "MOVE-TEST-F1-16" TO PAR-NAME. NC1054.2 +081600 PERFORM PRINT-DETAIL. NC1054.2 +081700 MOVE-INIT-F1-17. NC1054.2 +081800 MOVE "123ABC" TO MOVE43. NC1054.2 +081900 MOVE-TEST-F1-17-0. NC1054.2 +082000 MOVE MOVE43 TO MOVE29. NC1054.2 +082100 MOVE-TEST-F1-17-1. NC1054.2 +082200 IF MOVE29X EQUAL TO "123ABC " NC1054.2 +082300 PERFORM PASS NC1054.2 +082400 ELSE NC1054.2 +082500 GO TO MOVE-FAIL-F1-17. NC1054.2 +082600* NOTE GROUP TO NNI MOVE. NC1054.2 +082700 GO TO MOVE-WRITE-F1-17. NC1054.2 +082800 MOVE-DELETE-F1-17. NC1054.2 +082900 PERFORM DE-LETE. NC1054.2 +083000 GO TO MOVE-WRITE-F1-17. NC1054.2 +083100 MOVE-FAIL-F1-17. NC1054.2 +083200 MOVE MOVE29X TO COMPUTED-A. NC1054.2 +083300 MOVE "123ABC" TO CORRECT-A. NC1054.2 +083400 PERFORM FAIL. NC1054.2 +083500 MOVE-WRITE-F1-17. NC1054.2 +083600 MOVE "MOVE-TEST-F1-17" TO PAR-NAME. NC1054.2 +083700 PERFORM PRINT-DETAIL. NC1054.2 +083800 MOVE-INIT-F1-18. NC1054.2 +083900 MOVE "123ABC" TO MOVE43. NC1054.2 +084000 MOVE-TEST-F1-18-0. NC1054.2 +084100 MOVE MOVE43 TO MOVE21. NC1054.2 +084200 MOVE-TEST-F1-18-1. NC1054.2 +084300 IF MOVE21 EQUAL TO "123ABC " NC1054.2 +084400 PERFORM PASS NC1054.2 +084500 ELSE NC1054.2 +084600 GO TO MOVE-FAIL-F1-18. NC1054.2 +084700* NOTE GROUP TO AN MOVE SPACE PADDING ON RIGHT. NC1054.2 +084800 GO TO MOVE-WRITE-F1-18. NC1054.2 +084900 MOVE-DELETE-F1-18. NC1054.2 +085000 PERFORM DE-LETE. NC1054.2 +085100 GO TO MOVE-WRITE-F1-18. NC1054.2 +085200 MOVE-FAIL-F1-18. NC1054.2 +085300 MOVE MOVE21 TO COMPUTED-A. NC1054.2 +085400 MOVE "123ABC" TO CORRECT-A. NC1054.2 +085500 PERFORM FAIL. NC1054.2 +085600 MOVE-WRITE-F1-18. NC1054.2 +085700 MOVE "MOVE-TEST-F1-18" TO PAR-NAME. NC1054.2 +085800 PERFORM PRINT-DETAIL. NC1054.2 +085900 MOVE-INIT-F1-19. NC1054.2 +086000 MOVE "123ABC" TO MOVE43. NC1054.2 +086100 MOVE-TEST-F1-19-0. NC1054.2 +086200 MOVE MOVE43 TO MOVE20. NC1054.2 +086300 MOVE-TEST-F1-19-1. NC1054.2 +086400 IF MOVE20 EQUAL TO "123A" NC1054.2 +086500 PERFORM PASS NC1054.2 +086600 ELSE NC1054.2 +086700 GO TO MOVE-FAIL-F1-19. NC1054.2 +086800* NOTE GROUP TO AN MOVE. NC1054.2 +086900 GO TO MOVE-WRITE-F1-19. NC1054.2 +087000 MOVE-DELETE-F1-19. NC1054.2 +087100 PERFORM DE-LETE. NC1054.2 +087200 GO TO MOVE-WRITE-F1-19. NC1054.2 +087300 MOVE-FAIL-F1-19. NC1054.2 +087400 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +087500 MOVE "123A" TO CORRECT-A. NC1054.2 +087600 PERFORM FAIL. NC1054.2 +087700 MOVE-WRITE-F1-19. NC1054.2 +087800 MOVE "MOVE-TEST-F1-19" TO PAR-NAME. NC1054.2 +087900 PERFORM PRINT-DETAIL. NC1054.2 +088000 MOVE-INIT-F1-20. NC1054.2 +088100 MOVE "123ABC" TO MOVE43. NC1054.2 +088200 MOVE-TEST-F1-20-0. NC1054.2 +088300 MOVE MOVE43 TO MOVE39. NC1054.2 +088400 MOVE-TEST-F1-20-1. NC1054.2 +088500 IF MOVE39 NOT EQUAL TO "123ABC " NC1054.2 +088600 GO TO MOVE-FAIL-F1-20. NC1054.2 +088700* NOTE GROUP TO AE MOVE. NC1054.2 +088800 PERFORM PASS. NC1054.2 +088900 GO TO MOVE-WRITE-F1-20. NC1054.2 +089000 MOVE-DELETE-F1-20. NC1054.2 +089100 PERFORM DE-LETE. NC1054.2 +089200 GO TO MOVE-WRITE-F1-20. NC1054.2 +089300 MOVE-FAIL-F1-20. NC1054.2 +089400 MOVE MOVE39 TO COMPUTED-A. NC1054.2 +089500 MOVE "123ABC" TO CORRECT-A. NC1054.2 +089600 PERFORM FAIL. NC1054.2 +089700 MOVE-WRITE-F1-20. NC1054.2 +089800 MOVE "MOVE-TEST-F1-20" TO PAR-NAME. NC1054.2 +089900 PERFORM PRINT-DETAIL. NC1054.2 +090000 MOVE-INIT-F1-21. NC1054.2 +090100 MOVE "123ABC" TO MOVE43. NC1054.2 +090200 MOVE-TEST-F1-21-0. NC1054.2 +090300 MOVE MOVE43 TO MOVE35. NC1054.2 +090400 MOVE-TEST-F1-21-1. NC1054.2 +090500 IF MOVE35 EQUAL TO "123" NC1054.2 +090600 PERFORM PASS NC1054.2 +090700 ELSE NC1054.2 +090800 GO TO MOVE-FAIL-F1-21. NC1054.2 +090900* NOTE GROUP TO A MOVE. NC1054.2 +091000 GO TO MOVE-WRITE-F1-21. NC1054.2 +091100 MOVE-DELETE-F1-21. NC1054.2 +091200 PERFORM DE-LETE. NC1054.2 +091300 GO TO MOVE-WRITE-F1-21. NC1054.2 +091400 MOVE-FAIL-F1-21. NC1054.2 +091500 MOVE MOVE35 TO COMPUTED-A. NC1054.2 +091600 MOVE "123" TO CORRECT-A. NC1054.2 +091700 PERFORM FAIL. NC1054.2 +091800 MOVE-WRITE-F1-21. NC1054.2 +091900 MOVE "MOVE-TEST-F1-21" TO PAR-NAME. NC1054.2 +092000 PERFORM PRINT-DETAIL. NC1054.2 +092100 MOVE-INIT-F1-22. NC1054.2 +092200 MOVE "EDITED MOVE " TO FEATURE. NC1054.2 +092300 MOVE "12345" TO MOVE1. NC1054.2 +092400 MOVE-TEST-F1-22-0. NC1054.2 +092500 MOVE MOVE1 TO MOVE16. NC1054.2 +092600 MOVE-TEST-F1-22-1. NC1054.2 +092700 IF MOVE16 EQUAL TO "12345 " NC1054.2 +092800 PERFORM PASS NC1054.2 +092900 ELSE NC1054.2 +093000 GO TO MOVE-FAIL-F1-22. NC1054.2 +093100* NOTE NI TO NE MOVE, REPORT SYMBOL CR. NC1054.2 +093200 GO TO MOVE-WRITE-F1-22. NC1054.2 +093300 MOVE-DELETE-F1-22. NC1054.2 +093400 PERFORM DE-LETE. NC1054.2 +093500 GO TO MOVE-WRITE-F1-22. NC1054.2 +093600 MOVE-FAIL-F1-22. NC1054.2 +093700 MOVE MOVE16 TO COMPUTED-A. NC1054.2 +093800 MOVE "12345 " TO CORRECT-A. NC1054.2 +093900 PERFORM FAIL. NC1054.2 +094000 MOVE-WRITE-F1-22. NC1054.2 +094100 MOVE "MOVE-TEST-F1-22" TO PAR-NAME. NC1054.2 +094200 PERFORM PRINT-DETAIL. NC1054.2 +094300 MOVE-INIT-F1-23. NC1054.2 +094400 MOVE "12345" TO MOVE1. NC1054.2 +094500 MOVE-TEST-F1-23-0. NC1054.2 +094600 MOVE MOVE1 TO MOVE52. NC1054.2 +094700 MOVE-TEST-F1-23-1. NC1054.2 +094800 IF MOVE52 EQUAL TO "12345 " NC1054.2 +094900 PERFORM PASS NC1054.2 +095000 ELSE NC1054.2 +095100 GO TO MOVE-FAIL-F1-23. NC1054.2 +095200* NOTE NI TO NE MOVE, REPORT SIGN -. NC1054.2 +095300 GO TO MOVE-WRITE-F1-23. NC1054.2 +095400 MOVE-DELETE-F1-23. NC1054.2 +095500 PERFORM DE-LETE. NC1054.2 +095600 GO TO MOVE-WRITE-F1-23. NC1054.2 +095700 MOVE-FAIL-F1-23. NC1054.2 +095800 MOVE MOVE52 TO COMPUTED-A. NC1054.2 +095900 MOVE "12345 " TO CORRECT-A. NC1054.2 +096000 PERFORM FAIL. NC1054.2 +096100 MOVE-WRITE-F1-23. NC1054.2 +096200 MOVE "MOVE-TEST-F1-23" TO PAR-NAME. NC1054.2 +096300 PERFORM PRINT-DETAIL. NC1054.2 +096400 MOVE-INIT-F1-24. NC1054.2 +096500 MOVE -12345 TO MOVE51. NC1054.2 +096600 MOVE-TEST-F1-24-0. NC1054.2 +096700 MOVE MOVE51 TO MOVE66. NC1054.2 +096800 MOVE-TEST-F1-24-1. NC1054.2 +096900 IF MOVE66 EQUAL TO "12345DB" NC1054.2 +097000 PERFORM PASS NC1054.2 +097100 ELSE NC1054.2 +097200 GO TO MOVE-FAIL-F1-24. NC1054.2 +097300* NOTE NI TO NE MOVE, REPORT SYMBOL DB. NC1054.2 +097400 GO TO MOVE-WRITE-F1-24. NC1054.2 +097500 MOVE-DELETE-F1-24. NC1054.2 +097600 PERFORM DE-LETE. NC1054.2 +097700 GO TO MOVE-WRITE-F1-24. NC1054.2 +097800 MOVE-FAIL-F1-24. NC1054.2 +097900 MOVE MOVE66 TO COMPUTED-A. NC1054.2 +098000 MOVE "12345DB" TO CORRECT-A. NC1054.2 +098100 PERFORM FAIL. NC1054.2 +098200 MOVE-WRITE-F1-24. NC1054.2 +098300 MOVE "MOVE-TEST-F1-24" TO PAR-NAME. NC1054.2 +098400 PERFORM PRINT-DETAIL. NC1054.2 +098500 MOVE-INIT-F1-25. NC1054.2 +098600 MOVE 12345 TO MOVE1. NC1054.2 +098700 MOVE-TEST-F1-25-0. NC1054.2 +098800 MOVE MOVE1 TO MOVE66. NC1054.2 +098900 MOVE-TEST-F1-25-1. NC1054.2 +099000 IF MOVE66 EQUAL TO "12345 " NC1054.2 +099100 PERFORM PASS NC1054.2 +099200 ELSE NC1054.2 +099300 GO TO MOVE-FAIL-F1-25. NC1054.2 +099400* NOTE NI TO NE MOVE, REPORT SYMBOL DB. NC1054.2 +099500 GO TO MOVE-WRITE-F1-25. NC1054.2 +099600 MOVE-DELETE-F1-25. NC1054.2 +099700 PERFORM DE-LETE. NC1054.2 +099800 GO TO MOVE-WRITE-F1-25. NC1054.2 +099900 MOVE-FAIL-F1-25. NC1054.2 +100000 MOVE MOVE66 TO COMPUTED-A. NC1054.2 +100100 MOVE "12345 " TO CORRECT-A. NC1054.2 +100200 PERFORM FAIL. NC1054.2 +100300 MOVE-WRITE-F1-25. NC1054.2 +100400 MOVE "MOVE-TEST-F1-25" TO PAR-NAME. NC1054.2 +100500 PERFORM PRINT-DETAIL. NC1054.2 +100600 MOVE-INIT-F1-26. NC1054.2 +100700 MOVE -12345 TO MOVE51. NC1054.2 +100800 MOVE-TEST-F1-26-0. NC1054.2 +100900 MOVE MOVE51 TO MOVE67. NC1054.2 +101000 MOVE-TEST-F1-26-1. NC1054.2 +101100 IF MOVE67 EQUAL TO "12345-" NC1054.2 +101200 PERFORM PASS NC1054.2 +101300 ELSE NC1054.2 +101400 GO TO MOVE-FAIL-F1-26. NC1054.2 +101500* NOTE NI TO NE MOVE, REPORT SIGN +. NC1054.2 +101600 GO TO MOVE-WRITE-F1-26. NC1054.2 +101700 MOVE-DELETE-F1-26. NC1054.2 +101800 PERFORM DE-LETE. NC1054.2 +101900 GO TO MOVE-WRITE-F1-26. NC1054.2 +102000 MOVE-FAIL-F1-26. NC1054.2 +102100 MOVE MOVE67 TO COMPUTED-A. NC1054.2 +102200 MOVE "12345-" TO CORRECT-A. NC1054.2 +102300 PERFORM FAIL. NC1054.2 +102400 MOVE-WRITE-F1-26. NC1054.2 +102500 MOVE "MOVE-TEST-F1-26" TO PAR-NAME. NC1054.2 +102600 PERFORM PRINT-DETAIL. NC1054.2 +102700 MOVE-INIT-F1-27. NC1054.2 +102800 MOVE 12345 TO MOVE1. NC1054.2 +102900 MOVE-TEST-F1-27-0. NC1054.2 +103000 MOVE MOVE1 TO MOVE67. NC1054.2 +103100 MOVE-TEST-F1-27-1. NC1054.2 +103200 IF MOVE67 EQUAL TO "12345+" NC1054.2 +103300 PERFORM PASS NC1054.2 +103400 ELSE NC1054.2 +103500 GO TO MOVE-FAIL-F1-27. NC1054.2 +103600* NOTE NI TO NE MOVE, REPORT SIGN +. NC1054.2 +103700 GO TO MOVE-WRITE-F1-27. NC1054.2 +103800 MOVE-DELETE-F1-27. NC1054.2 +103900 PERFORM DE-LETE. NC1054.2 +104000 GO TO MOVE-WRITE-F1-27. NC1054.2 +104100 MOVE-FAIL-F1-27. NC1054.2 +104200 MOVE MOVE67 TO COMPUTED-A. NC1054.2 +104300 MOVE "12345+" TO CORRECT-A. NC1054.2 +104400 PERFORM FAIL. NC1054.2 +104500 MOVE-WRITE-F1-27. NC1054.2 +104600 MOVE "MOVE-TEST-F1-27" TO PAR-NAME. NC1054.2 +104700 PERFORM PRINT-DETAIL. NC1054.2 +104800 MOVE-INIT-F1-28. NC1054.2 +104900 MOVE 45 TO MOVE49. NC1054.2 +105000 MOVE-TEST-F1-28-0. NC1054.2 +105100 MOVE MOVE49 TO MOVE68. NC1054.2 +105200 MOVE-TEST-F1-28-1. NC1054.2 +105300 IF MOVE68 EQUAL TO " +45" NC1054.2 +105400 PERFORM PASS NC1054.2 +105500 ELSE NC1054.2 +105600 GO TO MOVE-FAIL-F1-28. NC1054.2 +105700* NOTE NI TO NE MOVE, FLOATING REPORT SIGN. NC1054.2 +105800 GO TO MOVE-WRITE-F1-28. NC1054.2 +105900 MOVE-DELETE-F1-28. NC1054.2 +106000 PERFORM DE-LETE. NC1054.2 +106100 GO TO MOVE-WRITE-F1-28. NC1054.2 +106200 MOVE-FAIL-F1-28. NC1054.2 +106300 MOVE MOVE68 TO COMPUTED-A. NC1054.2 +106400 MOVE " +45" TO CORRECT-A. NC1054.2 +106500 PERFORM FAIL. NC1054.2 +106600 MOVE-WRITE-F1-28. NC1054.2 +106700 MOVE "MOVE-TEST-F1-28" TO PAR-NAME. NC1054.2 +106800 PERFORM PRINT-DETAIL. NC1054.2 +106900 MOVE-INIT-F1-29. NC1054.2 +107000 MOVE -45 TO MOVE51A. NC1054.2 +107100 MOVE-TEST-F1-29-0. NC1054.2 +107200 MOVE MOVE51A TO MOVE69. NC1054.2 +107300 MOVE-TEST-F1-29-1. NC1054.2 +107400 IF MOVE69 EQUAL TO " -45" NC1054.2 +107500 PERFORM PASS NC1054.2 +107600 ELSE NC1054.2 +107700 GO TO MOVE-FAIL-F1-29. NC1054.2 +107800* NOTE NI TO NE MOVE, FLOATING REPORT SIGN. NC1054.2 +107900 GO TO MOVE-WRITE-F1-29. NC1054.2 +108000 MOVE-DELETE-F1-29. NC1054.2 +108100 PERFORM DE-LETE. NC1054.2 +108200 GO TO MOVE-WRITE-F1-29. NC1054.2 +108300 MOVE-FAIL-F1-29. NC1054.2 +108400 MOVE MOVE69 TO COMPUTED-A. NC1054.2 +108500 MOVE " -45" TO CORRECT-A. NC1054.2 +108600 PERFORM FAIL. NC1054.2 +108700 MOVE-WRITE-F1-29. NC1054.2 +108800 MOVE "MOVE-TEST-F1-29" TO PAR-NAME. NC1054.2 +108900 PERFORM PRINT-DETAIL. NC1054.2 +109000 MOVE-INIT-F1-30. NC1054.2 +109100 MOVE 12345 TO MOVE1. NC1054.2 +109200 MOVE-TEST-F1-30-0. NC1054.2 +109300 MOVE MOVE1 TO MOVE70. NC1054.2 +109400 MOVE-TEST-F1-30-1. NC1054.2 +109500 IF MOVE70 EQUAL TO 12345 NC1054.2 +109600 PERFORM PASS NC1054.2 +109700 ELSE NC1054.2 +109800 GO TO MOVE-FAIL-F1-30. NC1054.2 +109900* NOTE, TO AUDIT SYNC OPTION. NC1054.2 +110000 GO TO MOVE-WRITE-F1-30. NC1054.2 +110100 MOVE-DELETE-F1-30. NC1054.2 +110200 PERFORM DE-LETE. NC1054.2 +110300 GO TO MOVE-WRITE-F1-30. NC1054.2 +110400 MOVE-FAIL-F1-30. NC1054.2 +110500 MOVE MOVE70 TO COMPUTED-N. NC1054.2 +110600 MOVE 12345 TO CORRECT-N. NC1054.2 +110700 PERFORM FAIL. NC1054.2 +110800 MOVE-WRITE-F1-30. NC1054.2 +110900 MOVE "MISC MOVE " TO FEATURE. NC1054.2 +111000 MOVE "MOVE-TEST-F1-30" TO PAR-NAME. NC1054.2 +111100 PERFORM PRINT-DETAIL. NC1054.2 +111200 MOVE-INIT-F1-31. NC1054.2 +111300 NC1054.2 +111400 MOVE-TEST-F1-31-0. NC1054.2 +111500 MOVE 1.11115111115111115 TO MOVE48. NC1054.2 +111600 MOVE-TEST-F1-31-1. NC1054.2 +111700 IF MOVE48 EQUAL TO 1.11115111115111115 NC1054.2 +111800 PERFORM PASS NC1054.2 +111900 ELSE NC1054.2 +112000 GO TO MOVE-FAIL-F1-31. NC1054.2 +112100* NOTE MAXIMUM LENGTH NUMERIC LITERAL. NC1054.2 +112200 GO TO MOVE-WRITE-F1-31. NC1054.2 +112300 MOVE-DELETE-F1-31. NC1054.2 +112400 PERFORM DE-LETE. NC1054.2 +112500 GO TO MOVE-WRITE-F1-31. NC1054.2 +112600 MOVE-FAIL-F1-31. NC1054.2 +112700 MOVE MOVE48 TO COMPUTED-N. NC1054.2 +112800 MOVE "1.11115111115111115" TO CORRECT-A. NC1054.2 +112900 PERFORM FAIL. NC1054.2 +113000 MOVE-WRITE-F1-31. NC1054.2 +113100 MOVE "MAXIMUM LENGTH MOVE " TO FEATURE. NC1054.2 +113200 MOVE "MOVE-TEST-F1-31" TO PAR-NAME. NC1054.2 +113300 PERFORM PRINT-DETAIL. NC1054.2 +113400 MOVE-INIT-F1-32. NC1054.2 +113500 MOVE 0 TO TA--X. NC1054.2 +113600 MOVE-TEST-F1-32-0. NC1054.2 +113700 MOVE MOVE23 TO MOVE5 MOVE6 MOVE7. NC1054.2 +113800 MOVE-TEST-F1-32-1. NC1054.2 +113900 IF MOVE5 NOT EQUAL TO 23.45 NC1054.2 +114000 MOVE MOVE5 TO COMPUTED-N NC1054.2 +114100 MOVE 23.45 TO CORRECT-N NC1054.2 +114200 PERFORM FAIL PERFORM MOVE-WRITE-F1-32 NC1054.2 +114300 MOVE 1 TO TA--X. NC1054.2 +114400 IF MOVE6 NOT EQUAL TO .45 NC1054.2 +114500 MOVE MOVE6 TO COMPUTED-N NC1054.2 +114600 MOVE .45 TO CORRECT-N NC1054.2 +114700 PERFORM FAIL PERFORM MOVE-WRITE-F1-32 NC1054.2 +114800 MOVE 1 TO TA--X. NC1054.2 +114900 IF MOVE7 NOT EQUAL TO 3.45 NC1054.2 +115000 MOVE MOVE7 TO COMPUTED-N NC1054.2 +115100 MOVE 3.45 TO CORRECT-N NC1054.2 +115200 GO TO MOVE-FAIL-F1-32. NC1054.2 +115300 IF TA--X IS NOT EQUAL TO 0 GO TO MOVE-INIT-F1-33. NC1054.2 +115400 PERFORM PASS. NC1054.2 +115500 GO TO MOVE-WRITE-F1-32. NC1054.2 +115600 MOVE-DELETE-F1-32. NC1054.2 +115700 PERFORM DE-LETE. NC1054.2 +115800 GO TO MOVE-WRITE-F1-32. NC1054.2 +115900 MOVE-FAIL-F1-32. NC1054.2 +116000 PERFORM FAIL. NC1054.2 +116100 MOVE-WRITE-F1-32. NC1054.2 +116200 MOVE "MOVE-TEST-F1-32" TO PAR-NAME. NC1054.2 +116300 PERFORM PRINT-DETAIL. NC1054.2 +116400 MOVE-INIT-F1-33. NC1054.2 +116500 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC1054.2 +116600 MOVE-TEST-F1-33-0. NC1054.2 +116700 MOVE GRP-GROUP-MOVE-FROM TO GRP-GROUP-MOVE-TO. NC1054.2 +116800 MOVE-TEST-F1-33-1. NC1054.2 +116900 IF ALPHABET-AN-00026 NOT EQUAL TO WRK-AN-00026 NC1054.2 +117000 GO TO MOVE-FAIL-F1-33. NC1054.2 +117100 IF DIGITS-DU-10V00 NOT EQUAL TO WRK-DU-10V00 NC1054.2 +117200 GO TO MOVE-FAIL-F1-33. NC1054.2 +117300 IF ALPHANUMERIC-XN-00049 NOT EQUAL TO WRK-XN-00049 NC1054.2 +117400 GO TO MOVE-FAIL-F1-33. NC1054.2 +117500 IF NE-0001 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117600 IF NE-0002 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117700 IF AE-0001 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117800 IF AE-0002 EQUAL TO SPACE NC1054.2 +117900 PERFORM PASS NC1054.2 +118000 GO TO MOVE-WRITE-F1-33. NC1054.2 +118100 GO TO MOVE-FAIL-F1-33. NC1054.2 +118200 MOVE-DELETE-F1-33. NC1054.2 +118300 PERFORM DE-LETE. NC1054.2 +118400 GO TO MOVE-WRITE-F1-33. NC1054.2 +118500 MOVE-FAIL-F1-33. NC1054.2 +118600 MOVE GRP-MOVE-CONSTANTS TO SEND-BREAKDOWN. NC1054.2 +118700 MOVE GRP-MOVE-RECEIVING-FIELDS TO RECEIVE-BREAKDOWN. NC1054.2 +118800 MOVE 119 TO LENGTH-COUNTER. NC1054.2 +118900 PERFORM FAIL. NC1054.2 +119000 PERFORM A20 THRU A120. NC1054.2 +119100 MOVE-WRITE-F1-33. NC1054.2 +119200 MOVE "MOVE ALPHA GROUP " TO FEATURE. NC1054.2 +119300 MOVE "MOVE-TEST-F1-33 " TO PAR-NAME. NC1054.2 +119400 PERFORM PRINT-DETAIL. NC1054.2 +119500 MOVE-INIT-F1-34. NC1054.2 +119600 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC1054.2 +119700 MOVE-TEST-F1-34-0. NC1054.2 +119800 MOVE GRP-ALPHABETIC TO WRK-AN-00026. NC1054.2 +119900 MOVE-TEST-F1-34-1. NC1054.2 +120000 IF GRP-ALPHABETIC EQUAL TO GRP-WRK-AN-00026 NC1054.2 +120100 PERFORM PASS NC1054.2 +120200 GO TO MOVE-WRITE-F1-34. NC1054.2 +120300 GO TO MOVE-FAIL-F1-34. NC1054.2 +120400 MOVE-DELETE-F1-34. NC1054.2 +120500 PERFORM DE-LETE. NC1054.2 +120600 GO TO MOVE-WRITE-F1-34. NC1054.2 +120700 MOVE-FAIL-F1-34. NC1054.2 +120800 MOVE GRP-ALPHABETIC TO SEND-BREAKDOWN. NC1054.2 +120900 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +121000 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +121100 PERFORM FAIL. NC1054.2 +121200 PERFORM A20 THRU A40. NC1054.2 +121300 MOVE-WRITE-F1-34. NC1054.2 +121400 MOVE "MOVE-TEST-F1-34 " TO PAR-NAME. NC1054.2 +121500 PERFORM PRINT-DETAIL. NC1054.2 +121600 MOVE-INIT-F1-35. NC1054.2 +121700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +121800 TO GRP-ALPHANUMERIC. NC1054.2 +121900 MOVE "MOVE ALPHA-NUM GROUP" TO FEATURE. NC1054.2 +122000 MOVE-TEST-F1-35-0. NC1054.2 +122100 MOVE GRP-ALPHANUMERIC TO WRK-XN-00049. NC1054.2 +122200 MOVE-TEST-F1-35-1. NC1054.2 +122300 IF GRP-ALPHANUMERIC EQUAL TO GRP-WRK-XN-00049 NC1054.2 +122400 PERFORM PASS NC1054.2 +122500 GO TO MOVE-WRITE-F1-35. NC1054.2 +122600 GO TO MOVE-FAIL-F1-35. NC1054.2 +122700 MOVE-DELETE-F1-35. NC1054.2 +122800 PERFORM DE-LETE. NC1054.2 +122900 GO TO MOVE-WRITE-F1-35. NC1054.2 +123000 MOVE-FAIL-F1-35. NC1054.2 +123100 MOVE GRP-ALPHANUMERIC TO SEND-BREAKDOWN. NC1054.2 +123200 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +123300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +123400 PERFORM FAIL. NC1054.2 +123500 PERFORM A20 THRU A60. NC1054.2 +123600 MOVE-WRITE-F1-35. NC1054.2 +123700 MOVE "MOVE-TEST-F1-35 " TO PAR-NAME. NC1054.2 +123800 PERFORM PRINT-DETAIL. NC1054.2 +123900 MOVE-INIT-F1-36. NC1054.2 +124000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +124100 TO GRP-ALPHANUMERIC. NC1054.2 +124200 MOVE "MOVE ALPHA-NUM GROUP" TO FEATURE. NC1054.2 +124300 MOVE-TEST-F1-36-0. NC1054.2 +124400 MOVE GRP-ALPHANUMERIC TO AE-0001. NC1054.2 +124500 MOVE-TEST-F1-36-1. NC1054.2 +124600 IF GRP-ALPHANUMERIC-1002 EQUAL TO GRP-AE-0001 NC1054.2 +124700 PERFORM PASS NC1054.2 +124800 GO TO MOVE-WRITE-F1-36. NC1054.2 +124900 GO TO MOVE-FAIL-F1-36. NC1054.2 +125000 MOVE-DELETE-F1-36. NC1054.2 +125100 PERFORM DE-LETE. NC1054.2 +125200 GO TO MOVE-WRITE-F1-36. NC1054.2 +125300 MOVE-FAIL-F1-36. NC1054.2 +125400 MOVE GRP-ALPHANUMERIC-1002 TO SEND-BREAKDOWN. NC1054.2 +125500 MOVE GRP-AE-0001 TO RECEIVE-BREAKDOWN. NC1054.2 +125600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +125700 PERFORM FAIL. NC1054.2 +125800 PERFORM A20 THRU A60. NC1054.2 +125900 MOVE-WRITE-F1-36. NC1054.2 +126000 MOVE "MOVE-TEST-F1-36 " TO PAR-NAME. NC1054.2 +126100 PERFORM PRINT-DETAIL. NC1054.2 +126200 MOVE-INIT-F1-37. NC1054.2 +126300 MOVE "MOVE NUMERIC GROUP " TO FEATURE. NC1054.2 +126400 MOVE 0123456789 TO GRP-NUMERIC. NC1054.2 +126500 MOVE-TEST-F1-37-0. NC1054.2 +126600 MOVE GRP-NUMERIC TO WRK-DU-10V00. NC1054.2 +126700 MOVE-TEST-F1-37-1. NC1054.2 +126800 IF GRP-NUMERIC EQUAL TO GRP-WRK-DU-10V00 NC1054.2 +126900 PERFORM PASS NC1054.2 +127000 GO TO MOVE-WRITE-F1-37. NC1054.2 +127100 GO TO MOVE-FAIL-F1-37. NC1054.2 +127200 MOVE-DELETE-F1-37. NC1054.2 +127300 PERFORM DE-LETE. NC1054.2 +127400 GO TO MOVE-WRITE-F1-37. NC1054.2 +127500 MOVE-FAIL-F1-37. NC1054.2 +127600 MOVE GRP-NUMERIC TO CORRECT-A. NC1054.2 +127700 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +127800 PERFORM FAIL. NC1054.2 +127900 MOVE-WRITE-F1-37. NC1054.2 +128000 MOVE "MOVE-TEST-F1-37 " TO PAR-NAME. NC1054.2 +128100 PERFORM PRINT-DETAIL. NC1054.2 +128200 MOVE-INIT-F1-38. NC1054.2 +128300 MOVE 0123456789 TO GRP-NUMERIC. NC1054.2 +128400 MOVE-TEST-F1-38-0. NC1054.2 +128500 MOVE GRP-NUMERIC TO NE-0001. NC1054.2 +128600 MOVE-TEST-F1-38-1. NC1054.2 +128700 IF "0123456789 " EQUAL TO GRP-NE-0001 NC1054.2 +128800 PERFORM PASS NC1054.2 +128900 GO TO MOVE-WRITE-F1-38. NC1054.2 +129000 GO TO MOVE-FAIL-F1-38. NC1054.2 +129100 MOVE-DELETE-F1-38. NC1054.2 +129200 PERFORM DE-LETE. NC1054.2 +129300 GO TO MOVE-WRITE-F1-38. NC1054.2 +129400 MOVE-FAIL-F1-38. NC1054.2 +129500 MOVE GRP-NUMERIC TO CORRECT-A. NC1054.2 +129600 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +129700 PERFORM FAIL. NC1054.2 +129800 MOVE-WRITE-F1-38. NC1054.2 +129900 MOVE "MOVE-TEST-F1-38 " TO PAR-NAME. NC1054.2 +130000 PERFORM PRINT-DETAIL. NC1054.2 +130100 MOVE-INIT-F1-39. NC1054.2 +130200 MOVE "MOVE ALPHA ITEM " TO FEATURE. NC1054.2 +130300 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +130400 MOVE-TEST-F1-39-0. NC1054.2 +130500 MOVE ALPHABET-AN-00026 TO GRP-WRK-AN-00026. NC1054.2 +130600 MOVE-TEST-F1-39-1. NC1054.2 +130700 IF ALPHABET-AN-00026 EQUAL TO WRK-AN-00026 NC1054.2 +130800 PERFORM PASS NC1054.2 +130900 GO TO MOVE-WRITE-F1-39. NC1054.2 +131000 GO TO MOVE-FAIL-F1-39. NC1054.2 +131100 MOVE-DELETE-F1-39. NC1054.2 +131200 PERFORM DE-LETE. NC1054.2 +131300 GO TO MOVE-WRITE-F1-39. NC1054.2 +131400 MOVE-FAIL-F1-39. NC1054.2 +131500 MOVE ALPHABET-AN-00026 TO SEND-BREAKDOWN. NC1054.2 +131600 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +131700 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +131800 PERFORM FAIL. NC1054.2 +131900 PERFORM A20 THRU A40. NC1054.2 +132000 MOVE-WRITE-F1-39. NC1054.2 +132100 MOVE "MOVE-TEST-F1-39 " TO PAR-NAME. NC1054.2 +132200 PERFORM PRINT-DETAIL. NC1054.2 +132300 MOVE-INIT-F1-40. NC1054.2 +132400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +132500 MOVE-TEST-F1-40-0. NC1054.2 +132600 MOVE ALPHABET-AN-00026 TO WRK-AN-00026. NC1054.2 +132700 MOVE-TEST-F1-40-1. NC1054.2 +132800 IF ALPHABET-AN-00026 EQUAL TO GRP-WRK-AN-00026 NC1054.2 +132900 PERFORM PASS NC1054.2 +133000 GO TO MOVE-WRITE-F1-40. NC1054.2 +133100 GO TO MOVE-FAIL-F1-40. NC1054.2 +133200 MOVE-DELETE-F1-40. NC1054.2 +133300 PERFORM DE-LETE. NC1054.2 +133400 GO TO MOVE-WRITE-F1-40. NC1054.2 +133500 MOVE-FAIL-F1-40. NC1054.2 +133600 MOVE ALPHABET-AN-00026 TO SEND-BREAKDOWN. NC1054.2 +133700 MOVE WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +133800 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +133900 PERFORM FAIL. NC1054.2 +134000 PERFORM A20 THRU A40. NC1054.2 +134100 MOVE-WRITE-F1-40. NC1054.2 +134200 MOVE "MOVE-TEST-F1-40 " TO PAR-NAME. NC1054.2 +134300 PERFORM PRINT-DETAIL. NC1054.2 +134400 MOVE-INIT-F1-41. NC1054.2 +134500 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +134600 MOVE-TEST-F1-41-0. NC1054.2 +134700 MOVE ALPHABET-AN-00026 TO WRK-XN-00049 FIRST-26. NC1054.2 +134800 MOVE-TEST-F1-41-1. NC1054.2 +134900 MOVE SPACE TO PADD-REST. NC1054.2 +135000 IF FORTY-NINE-COMPARE EQUAL TO GRP-WRK-XN-00049 NC1054.2 +135100 PERFORM PASS NC1054.2 +135200 GO TO MOVE-WRITE-F1-41. NC1054.2 +135300 GO TO MOVE-FAIL-F1-41. NC1054.2 +135400 MOVE-DELETE-F1-41. NC1054.2 +135500 PERFORM DE-LETE. NC1054.2 +135600 GO TO MOVE-WRITE-F1-41. NC1054.2 +135700 MOVE-FAIL-F1-41. NC1054.2 +135800 MOVE FORTY-NINE-COMPARE TO SEND-BREAKDOWN. NC1054.2 +135900 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +136000 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +136100 PERFORM FAIL. NC1054.2 +136200 PERFORM A20 THRU A60. NC1054.2 +136300 MOVE-WRITE-F1-41. NC1054.2 +136400 MOVE "MOVE-TEST-F1-41 " TO PAR-NAME. NC1054.2 +136500 PERFORM PRINT-DETAIL. NC1054.2 +136600 MOVE-INIT-F1-42. NC1054.2 +136700 MOVE "MOVE ALPHA-NUM ITEM " TO FEATURE. NC1054.2 +136800 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +136900 TO ALPHANUMERIC-XN-00049. NC1054.2 +137000 MOVE-TEST-F1-42-0. NC1054.2 +137100 MOVE ALPHANUMERIC-XN-00049 TO GRP-WRK-XN-00049. NC1054.2 +137200 MOVE-TEST-F1-42-1. NC1054.2 +137300 IF ALPHANUMERIC-XN-00049 EQUAL TO WRK-XN-00049 NC1054.2 +137400 PERFORM PASS NC1054.2 +137500 GO TO MOVE-WRITE-F1-42. NC1054.2 +137600 GO TO MOVE-FAIL-F1-42. NC1054.2 +137700 MOVE-DELETE-F1-42. NC1054.2 +137800 PERFORM DE-LETE. NC1054.2 +137900 GO TO MOVE-WRITE-F1-42. NC1054.2 +138000 MOVE-FAIL-F1-42. NC1054.2 +138100 MOVE ALPHANUMERIC-XN-00049 TO SEND-BREAKDOWN. NC1054.2 +138200 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +138300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +138400 PERFORM FAIL. NC1054.2 +138500 PERFORM A20 THRU A60. NC1054.2 +138600 MOVE-WRITE-F1-42. NC1054.2 +138700 MOVE "MOVE-TEST-F1-42 " TO PAR-NAME. NC1054.2 +138800 PERFORM PRINT-DETAIL. NC1054.2 +138900 MOVE-INIT-F1-43. NC1054.2 +139000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +139100 TO ALPHANUMERIC-XN-00049. NC1054.2 +139200 MOVE-TEST-F1-43-0. NC1054.2 +139300 MOVE ALPHANUMERIC-XN-00049 TO WRK-AN-00026 NC1054.2 +139400 FORTY-NINE-COMPARE. NC1054.2 +139500 MOVE SPACE TO PADD-REST. NC1054.2 +139600 MOVE-TEST-F1-43-1. NC1054.2 +139700 IF FIRST-26 EQUAL TO GRP-WRK-AN-00026 NC1054.2 +139800 PERFORM PASS NC1054.2 +139900 GO TO MOVE-WRITE-F1-43. NC1054.2 +140000 GO TO MOVE-FAIL-F1-43. NC1054.2 +140100 MOVE-DELETE-F1-43. NC1054.2 +140200 PERFORM DE-LETE. NC1054.2 +140300 GO TO MOVE-WRITE-F1-43. NC1054.2 +140400 MOVE-FAIL-F1-43. NC1054.2 +140500 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +140600 MOVE FIRST-26 TO SEND-BREAKDOWN. NC1054.2 +140700 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +140800 PERFORM FAIL. NC1054.2 +140900 PERFORM A20 THRU A40. NC1054.2 +141000 MOVE-WRITE-F1-43. NC1054.2 +141100 MOVE "MOVE-TEST-F1-43 " TO PAR-NAME. NC1054.2 +141200 PERFORM PRINT-DETAIL. NC1054.2 +141300 MOVE-INIT-F1-44. NC1054.2 +141400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +141500 TO ALPHANUMERIC-XN-00049. NC1054.2 +141600 MOVE-TEST-F1-44-0. NC1054.2 +141700 MOVE ALPHANUMERIC-XN-00049 TO WRK-XN-00049. NC1054.2 +141800 MOVE-TEST-F1-44-1. NC1054.2 +141900 IF ALPHANUMERIC-XN-00049 EQUAL TO GRP-WRK-XN-00049 NC1054.2 +142000 PERFORM PASS NC1054.2 +142100 GO TO MOVE-WRITE-F1-44. NC1054.2 +142200 GO TO MOVE-FAIL-F1-44. NC1054.2 +142300 MOVE-DELETE-F1-44. NC1054.2 +142400 PERFORM DE-LETE. NC1054.2 +142500 GO TO MOVE-WRITE-F1-44. NC1054.2 +142600 MOVE-FAIL-F1-44. NC1054.2 +142700 MOVE ALPHANUMERIC-XN-00049 TO SEND-BREAKDOWN. NC1054.2 +142800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +142900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +143000 PERFORM FAIL. NC1054.2 +143100 PERFORM A20 THRU A60. NC1054.2 +143200 MOVE-WRITE-F1-44. NC1054.2 +143300 MOVE "MOVE-TEST-F1-44" TO PAR-NAME. NC1054.2 +143400 PERFORM PRINT-DETAIL. NC1054.2 +143500 MOVE-INIT-F1-45. NC1054.2 +143600 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +143700 TO ALPHANUMERIC-XN-00049. NC1054.2 +143800 MOVE-TEST-F1-45-0. NC1054.2 +143900 MOVE ALPHANUMERIC-XN-00049 TO AE-0001. NC1054.2 +144000 MOVE-TEST-F1-45-1. NC1054.2 +144100 IF GRP-AE-0001 EQUAL TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ +- =$, .NC1054.2 +144200- "()/0 012345678" NC1054.2 +144300 PERFORM PASS NC1054.2 +144400 GO TO MOVE-WRITE-F1-45. NC1054.2 +144500 GO TO MOVE-FAIL-F1-45. NC1054.2 +144600 MOVE-DELETE-F1-45. NC1054.2 +144700 PERFORM DE-LETE. NC1054.2 +144800 GO TO MOVE-WRITE-F1-45. NC1054.2 +144900 MOVE-FAIL-F1-45. NC1054.2 +145000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ +- =$, .()/0 012345678" NC1054.2 +145100 TO SEND-BREAKDOWN. NC1054.2 +145200 MOVE AE-0001 TO RECEIVE-BREAKDOWN. NC1054.2 +145300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +145400 PERFORM FAIL. NC1054.2 +145500 PERFORM A20 THRU A60. NC1054.2 +145600 MOVE-WRITE-F1-45. NC1054.2 +145700 MOVE "MOVE-TEST-F1-45" TO PAR-NAME. NC1054.2 +145800 PERFORM PRINT-DETAIL. NC1054.2 +145900 MOVE-INIT-F1-46. NC1054.2 +146000 NC1054.2 +146100 MOVE-TEST-F1-46-0. NC1054.2 +146200 MOVE "4444444444444444440123456789" TO WRK-DU-10V00. NC1054.2 +146300 MOVE-TEST-F1-46-1. NC1054.2 +146400 IF GRP-WRK-DU-10V00 EQUAL TO "0123456789" NC1054.2 +146500 PERFORM PASS NC1054.2 +146600 GO TO MOVE-WRITE-F1-46. NC1054.2 +146700 GO TO MOVE-FAIL-F1-46. NC1054.2 +146800 MOVE-DELETE-F1-46. NC1054.2 +146900 PERFORM DE-LETE. NC1054.2 +147000 GO TO MOVE-WRITE-F1-46. NC1054.2 +147100 MOVE-FAIL-F1-46. NC1054.2 +147200 MOVE "0123456789" TO CORRECT-A. NC1054.2 +147300 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +147400 PERFORM FAIL. NC1054.2 +147500 MOVE-WRITE-F1-46. NC1054.2 +147600 MOVE "MOVE-TEST-F1-46" TO PAR-NAME. NC1054.2 +147700 PERFORM PRINT-DETAIL. NC1054.2 +147800 MOVE-INIT-F1-47. NC1054.2 +147900 MOVE 3344556677 TO MOVE72. NC1054.2 +148000 MOVE-TEST-F1-47-0. NC1054.2 +148100 MOVE MOVE72 TO MOVE73. NC1054.2 +148200 MOVE-TEST-F1-47-1. NC1054.2 +148300 IF MOVE73 EQUAL TO "33445 56677 0 " NC1054.2 +148400 PERFORM PASS NC1054.2 +148500 GO TO MOVE-WRITE-F1-47. NC1054.2 +148600 GO TO MOVE-FAIL-F1-47. NC1054.2 +148700 MOVE-DELETE-F1-47. NC1054.2 +148800 PERFORM DE-LETE. NC1054.2 +148900 GO TO MOVE-WRITE-F1-47. NC1054.2 +149000 MOVE-FAIL-F1-47. NC1054.2 +149100 MOVE MOVE73 TO COMPUTED-A. NC1054.2 +149200 MOVE "33445 56677 0 " TO CORRECT-A. NC1054.2 +149300 PERFORM FAIL. NC1054.2 +149400 MOVE-WRITE-F1-47. NC1054.2 +149500 MOVE "MOVE-TEST-F1-47" TO PAR-NAME. NC1054.2 +149600 PERFORM PRINT-DETAIL. NC1054.2 +149700 MOVE-INIT-F1-48. NC1054.2 +149800 NC1054.2 +149900 MOVE-TEST-F1-48-0. NC1054.2 +150000 MOVE "*" TO AE-0002. NC1054.2 +150100 MOVE-TEST-F1-48-1. NC1054.2 +150200 IF GRP-AE-0002 EQUAL TO "* 0 " NC1054.2 +150300 PERFORM PASS NC1054.2 +150400 GO TO MOVE-WRITE-F1-48. NC1054.2 +150500 GO TO MOVE-FAIL-F1-48. NC1054.2 +150600 MOVE-DELETE-F1-48. NC1054.2 +150700 PERFORM DE-LETE. NC1054.2 +150800 GO TO MOVE-WRITE-F1-48. NC1054.2 +150900 MOVE-FAIL-F1-48. NC1054.2 +151000 MOVE AE-0002 TO COMPUTED-A. NC1054.2 +151100 MOVE "* 0 " TO CORRECT-A. NC1054.2 +151200 PERFORM FAIL. NC1054.2 +151300 PERFORM A20 THRU A60. NC1054.2 +151400 MOVE-WRITE-F1-48. NC1054.2 +151500 MOVE "MOVE-TEST-F1-48" TO PAR-NAME. NC1054.2 +151600 PERFORM PRINT-DETAIL. NC1054.2 +151700 MOVE-INIT-F1-49. NC1054.2 +151800 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +151900 TO ALPHANUMERIC-XN-00049. NC1054.2 +152000 MOVE-TEST-F1-49-0. NC1054.2 +152100 MOVE ALPHANUMERIC-XN-00049 TO AE-0001. NC1054.2 +152200 MOVE-TEST-F1-49-1. NC1054.2 +152300 MOVE AE-0001 TO AE-0002. NC1054.2 +152400 IF AE-0002 EQUAL TO "AB0CD EFG" NC1054.2 +152500 PERFORM PASS NC1054.2 +152600 GO TO MOVE-WRITE-F1-49. NC1054.2 +152700 GO TO MOVE-FAIL-F1-49. NC1054.2 +152800 MOVE-DELETE-F1-49. NC1054.2 +152900 PERFORM DE-LETE. NC1054.2 +153000 GO TO MOVE-WRITE-F1-49. NC1054.2 +153100 MOVE-FAIL-F1-49. NC1054.2 +153200 MOVE AE-0002 TO COMPUTED-A. NC1054.2 +153300 MOVE "AB0CD EFG" TO CORRECT-A. NC1054.2 +153400 PERFORM FAIL. NC1054.2 +153500 MOVE-WRITE-F1-49. NC1054.2 +153600 MOVE "MOVE-TEST-F1-49" TO PAR-NAME. NC1054.2 +153700 PERFORM PRINT-DETAIL. NC1054.2 +153800 MOVE-INIT-F1-50. NC1054.2 +153900 MOVE "MOVE NUMERIC ITEM " TO FEATURE. NC1054.2 +154000 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +154100 MOVE-TEST-F1-50-0. NC1054.2 +154200 MOVE DIGITS-DU-10V00 TO GRP-WRK-DU-10V00. NC1054.2 +154300 MOVE-TEST-F1-50-1. NC1054.2 +154400 IF WRK-DU-10V00 EQUAL TO DIGITS-DU-10V00 NC1054.2 +154500 PERFORM PASS NC1054.2 +154600 GO TO MOVE-WRITE-F1-50. NC1054.2 +154700 GO TO MOVE-FAIL-F1-50. NC1054.2 +154800 MOVE-DELETE-F1-50. NC1054.2 +154900 PERFORM DE-LETE. NC1054.2 +155000 GO TO MOVE-WRITE-F1-50. NC1054.2 +155100 MOVE-FAIL-F1-50. NC1054.2 +155200 MOVE DIGITS-DU-10V00 TO CORRECT-A. NC1054.2 +155300 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +155400 PERFORM FAIL. NC1054.2 +155500 MOVE-WRITE-F1-50. NC1054.2 +155600 MOVE "MOVE-TEST-F1-50" TO PAR-NAME. NC1054.2 +155700 PERFORM PRINT-DETAIL. NC1054.2 +155800 MOVE-INIT-F1-51. NC1054.2 +155900 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +156000 MOVE-TEST-F1-51-0. NC1054.2 +156100 MOVE DIGITS-DU-10V00 TO WRK-XN-00049. NC1054.2 +156200 MOVE-TEST-F1-51-1. NC1054.2 +156300 IF GRP-WRK-XN-00049 EQUAL TO "0123456789 NC1054.2 +156400- " " NC1054.2 +156500 PERFORM PASS NC1054.2 +156600 GO TO MOVE-WRITE-F1-51. NC1054.2 +156700 GO TO MOVE-FAIL-F1-51. NC1054.2 +156800 MOVE-DELETE-F1-51. NC1054.2 +156900 PERFORM DE-LETE. NC1054.2 +157000 GO TO MOVE-WRITE-F1-51. NC1054.2 +157100 MOVE-FAIL-F1-51. NC1054.2 +157200 MOVE "0123456789 " NC1054.2 +157300 TO SEND-BREAKDOWN NC1054.2 +157400 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +157500 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +157600 PERFORM FAIL. NC1054.2 +157700 PERFORM A20 THRU A60. NC1054.2 +157800 MOVE-WRITE-F1-51. NC1054.2 +157900 MOVE "MOVE-TEST-F1-51" TO PAR-NAME. NC1054.2 +158000 PERFORM PRINT-DETAIL. NC1054.2 +158100 MOVE-INIT-F1-52. NC1054.2 +158200 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +158300 MOVE-TEST-F1-52-0. NC1054.2 +158400 MOVE DIGITS-DU-10V00 TO AE-0002. NC1054.2 +158500 MOVE-TEST-F1-52-1. NC1054.2 +158600 IF GRP-AE-0002 EQUAL TO "01023 456" NC1054.2 +158700 PERFORM PASS NC1054.2 +158800 GO TO MOVE-WRITE-F1-52. NC1054.2 +158900 GO TO MOVE-FAIL-F1-52. NC1054.2 +159000 MOVE-DELETE-F1-52. NC1054.2 +159100 PERFORM DE-LETE. NC1054.2 +159200 GO TO MOVE-WRITE-F1-52. NC1054.2 +159300 MOVE-FAIL-F1-52. NC1054.2 +159400 MOVE "01023 456" TO CORRECT-A. NC1054.2 +159500 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +159600 PERFORM FAIL. NC1054.2 +159700 MOVE-WRITE-F1-52. NC1054.2 +159800 MOVE "MOVE-TEST-F1-52" TO PAR-NAME. NC1054.2 +159900 PERFORM PRINT-DETAIL. NC1054.2 +160000 MOVE-INIT-F1-53. NC1054.2 +160100 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +160200 MOVE-TEST-F1-53-0. NC1054.2 +160300 MOVE DIGITS-DU-10V00 TO WRK-DU-10V00. NC1054.2 +160400 MOVE-TEST-F1-53-1. NC1054.2 +160500 IF GRP-WRK-DU-10V00 EQUAL TO DIGITS-DU-10V00 NC1054.2 +160600 PERFORM PASS NC1054.2 +160700 GO TO MOVE-WRITE-F1-53. NC1054.2 +160800 GO TO MOVE-FAIL-F1-53. NC1054.2 +160900 MOVE-DELETE-F1-53. NC1054.2 +161000 PERFORM DE-LETE. NC1054.2 +161100 GO TO MOVE-WRITE-F1-53. NC1054.2 +161200 MOVE-FAIL-F1-53. NC1054.2 +161300 MOVE DIGITS-DU-10V00 TO CORRECT-A. NC1054.2 +161400 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +161500 PERFORM FAIL. NC1054.2 +161600 MOVE-WRITE-F1-53. NC1054.2 +161700 MOVE "MOVE-TEST-F1-53" TO PAR-NAME. NC1054.2 +161800 PERFORM PRINT-DETAIL. NC1054.2 +161900 MOVE-INIT-F1-54. NC1054.2 +162000 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +162100 MOVE-TEST-F1-54-0. NC1054.2 +162200 MOVE DIGITS-DU-06V04-S TO NE-0001. NC1054.2 +162300 MOVE-TEST-F1-54-1. NC1054.2 +162400 IF GRP-NE-0001 EQUAL TO " 12,345.678,9" NC1054.2 +162500 PERFORM PASS NC1054.2 +162600 GO TO MOVE-WRITE-F1-54. NC1054.2 +162700 GO TO MOVE-FAIL-F1-54. NC1054.2 +162800 MOVE-DELETE-F1-54. NC1054.2 +162900 PERFORM DE-LETE. NC1054.2 +163000 GO TO MOVE-WRITE-F1-54. NC1054.2 +163100 MOVE-FAIL-F1-54. NC1054.2 +163200 MOVE " 12,345.678,9" TO CORRECT-A. NC1054.2 +163300 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +163400 PERFORM FAIL. NC1054.2 +163500 MOVE-WRITE-F1-54. NC1054.2 +163600 MOVE "MOVE-TEST-F1-54" TO PAR-NAME. NC1054.2 +163700 PERFORM PRINT-DETAIL. NC1054.2 +163800 MOVE-INIT-F1-55. NC1054.2 +163900 MOVE "MOVE NUMERIC EDITED" TO FEATURE. NC1054.2 +164000 MOVE-TEST-F1-55-0. NC1054.2 +164100 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +164200 MOVE NE-0001 TO GRP-WRK-XN-00049. NC1054.2 +164300 MOVE-TEST-F1-55-1. NC1054.2 +164400 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +164500 " 12,345.678,9 " NC1054.2 +164600 PERFORM PASS NC1054.2 +164700 GO TO MOVE-WRITE-F1-55. NC1054.2 +164800 GO TO MOVE-FAIL-F1-55. NC1054.2 +164900 MOVE-DELETE-F1-55. NC1054.2 +165000 PERFORM DE-LETE. NC1054.2 +165100 GO TO MOVE-WRITE-F1-55. NC1054.2 +165200 MOVE-FAIL-F1-55. NC1054.2 +165300 MOVE " 12,345.678,9 " NC1054.2 +165400 TO SEND-BREAKDOWN. NC1054.2 +165500 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +165600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +165700 PERFORM FAIL. NC1054.2 +165800 PERFORM A20 THRU A60. NC1054.2 +165900 MOVE-WRITE-F1-55. NC1054.2 +166000 MOVE "MOVE-TEST-F1-55" TO PAR-NAME. NC1054.2 +166100 PERFORM PRINT-DETAIL. NC1054.2 +166200 MOVE-INIT-F1-56. NC1054.2 +166300 NC1054.2 +166400 MOVE-TEST-F1-56-0. NC1054.2 +166500 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +166600 MOVE NE-0001 TO WRK-XN-00049. NC1054.2 +166700 MOVE-TEST-F1-56-1. NC1054.2 +166800 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +166900 " 12,345.678,9 " NC1054.2 +167000 PERFORM PASS NC1054.2 +167100 GO TO MOVE-WRITE-F1-56. NC1054.2 +167200 GO TO MOVE-FAIL-F1-56. NC1054.2 +167300 MOVE-DELETE-F1-56. NC1054.2 +167400 PERFORM DE-LETE. NC1054.2 +167500 GO TO MOVE-WRITE-F1-56. NC1054.2 +167600 MOVE-FAIL-F1-56. NC1054.2 +167700 MOVE " 12,345.678,9 " NC1054.2 +167800 TO SEND-BREAKDOWN. NC1054.2 +167900 MOVE WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +168000 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +168100 PERFORM FAIL. NC1054.2 +168200 PERFORM A20 THRU A60. NC1054.2 +168300 MOVE-WRITE-F1-56. NC1054.2 +168400 MOVE "MOVE-TEST-F1-56" TO PAR-NAME. NC1054.2 +168500 PERFORM PRINT-DETAIL. NC1054.2 +168600 MOVE-INIT-F1-57. NC1054.2 +168700 NC1054.2 +168800 MOVE-TEST-F1-57-0. NC1054.2 +168900 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +169000 MOVE NE-0001 TO AE-0002. NC1054.2 +169100 MOVE-TEST-F1-57-1. NC1054.2 +169200 IF GRP-AE-0002 EQUAL TO " 102, 345" NC1054.2 +169300 PERFORM PASS NC1054.2 +169400 GO TO MOVE-WRITE-F1-57. NC1054.2 +169500 GO TO MOVE-FAIL-F1-57. NC1054.2 +169600 MOVE-DELETE-F1-57. NC1054.2 +169700 PERFORM DE-LETE. NC1054.2 +169800 GO TO MOVE-WRITE-F1-57. NC1054.2 +169900 MOVE-FAIL-F1-57. NC1054.2 +170000 MOVE " 102, 345" TO CORRECT-A. NC1054.2 +170100 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +170200 PERFORM FAIL. NC1054.2 +170300 MOVE-WRITE-F1-57. NC1054.2 +170400 MOVE "MOVE-TEST-F1-57" TO PAR-NAME. NC1054.2 +170500 PERFORM PRINT-DETAIL. NC1054.2 +170600 MOVE-INIT-F1-58. NC1054.2 +170700 MOVE "MOVE ZERO LITERAL " TO FEATURE. NC1054.2 +170800 MOVE-TEST-F1-58-0. NC1054.2 +170900 MOVE ZERO TO GRP-WRK-DU-10V00. NC1054.2 +171000 MOVE-TEST-F1-58-1. NC1054.2 +171100 IF WRK-DU-10V00 EQUAL TO "0000000000" NC1054.2 +171200 PERFORM PASS NC1054.2 +171300 GO TO MOVE-WRITE-F1-58. NC1054.2 +171400 GO TO MOVE-FAIL-F1-58. NC1054.2 +171500 MOVE-DELETE-F1-58. NC1054.2 +171600 PERFORM DE-LETE. NC1054.2 +171700 GO TO MOVE-WRITE-F1-58. NC1054.2 +171800 MOVE-FAIL-F1-58. NC1054.2 +171900 MOVE "0000000000" TO CORRECT-A. NC1054.2 +172000 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +172100 PERFORM FAIL. NC1054.2 +172200 MOVE-WRITE-F1-58. NC1054.2 +172300 MOVE "MOVE-TEST-F1-58" TO PAR-NAME. NC1054.2 +172400 PERFORM PRINT-DETAIL. NC1054.2 +172500 MOVE-INIT-F1-59. NC1054.2 +172600 NC1054.2 +172700 MOVE-TEST-F1-59-0. NC1054.2 +172800 MOVE "0000000000000000000000000000000000000000000000000" NC1054.2 +172900 TO WRK-XN-00049. NC1054.2 +173000 MOVE-TEST-F1-59-1. NC1054.2 +173100 IF GRP-WRK-XN-00049 EQUAL TO ZERO NC1054.2 +173200 PERFORM PASS NC1054.2 +173300 GO TO MOVE-WRITE-F1-59. NC1054.2 +173400 GO TO MOVE-FAIL-F1-59. NC1054.2 +173500 MOVE-DELETE-F1-59. NC1054.2 +173600 PERFORM DE-LETE. NC1054.2 +173700 GO TO MOVE-WRITE-F1-59. NC1054.2 +173800 MOVE-FAIL-F1-59. NC1054.2 +173900 MOVE "0000000000000000000000000000000000000000000000000" NC1054.2 +174000 TO SEND-BREAKDOWN. NC1054.2 +174100 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +174200 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +174300 PERFORM FAIL. NC1054.2 +174400 PERFORM A20 THRU A60. NC1054.2 +174500 MOVE-WRITE-F1-59. NC1054.2 +174600 MOVE "MOVE-TEST-F1-59" TO PAR-NAME. NC1054.2 +174700 PERFORM PRINT-DETAIL. NC1054.2 +174800 MOVE-INIT-F1-60. NC1054.2 +174900 NC1054.2 +175000 MOVE-TEST-F1-60-0. NC1054.2 +175100 MOVE ZERO TO AE-0002. NC1054.2 +175200 MOVE-TEST-F1-60-1. NC1054.2 +175300 IF GRP-AE-0002 EQUAL TO "00000 000" NC1054.2 +175400 PERFORM PASS NC1054.2 +175500 GO TO MOVE-WRITE-F1-60. NC1054.2 +175600 GO TO MOVE-FAIL-F1-60. NC1054.2 +175700 MOVE-DELETE-F1-60. NC1054.2 +175800 PERFORM DE-LETE. NC1054.2 +175900 GO TO MOVE-WRITE-F1-60. NC1054.2 +176000 MOVE-FAIL-F1-60. NC1054.2 +176100 MOVE "00000 000" TO CORRECT-A. NC1054.2 +176200 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +176300 PERFORM FAIL. NC1054.2 +176400 MOVE-WRITE-F1-60. NC1054.2 +176500 MOVE "MOVE-TEST-F1-60" TO PAR-NAME. NC1054.2 +176600 PERFORM PRINT-DETAIL. NC1054.2 +176700 MOVE-INIT-F1-61. NC1054.2 +176800 MOVE-TEST-F1-61-0. NC1054.2 +176900 MOVE ZERO TO WRK-DU-10V00. NC1054.2 +177000 MOVE-TEST-F1-61-1. NC1054.2 +177100 IF GRP-WRK-DU-10V00 EQUAL TO "0000000000" NC1054.2 +177200 PERFORM PASS NC1054.2 +177300 GO TO MOVE-WRITE-F1-61. NC1054.2 +177400 GO TO MOVE-FAIL-F1-61. NC1054.2 +177500 MOVE-DELETE-117. NC1054.2 +177600 PERFORM DE-LETE. NC1054.2 +177700 GO TO MOVE-WRITE-F1-61. NC1054.2 +177800 MOVE-FAIL-F1-61. NC1054.2 +177900 MOVE "0000000000" TO CORRECT-A. NC1054.2 +178000 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +178100 PERFORM FAIL. NC1054.2 +178200 MOVE-WRITE-F1-61. NC1054.2 +178300 MOVE "MOVE-TEST-F1-61" TO PAR-NAME. NC1054.2 +178400 PERFORM PRINT-DETAIL. NC1054.2 +178500 MOVE-INIT-F1-62. NC1054.2 +178600 MOVE-TEST-F1-62-0. NC1054.2 +178700 MOVE ZERO TO NE-0001. NC1054.2 +178800 MOVE-TEST-F1-62-1. NC1054.2 +178900 IF GRP-NE-0001 EQUAL TO " 000.000,0" NC1054.2 +179000 PERFORM PASS NC1054.2 +179100 GO TO MOVE-WRITE-F1-62. NC1054.2 +179200 GO TO MOVE-FAIL-F1-62. NC1054.2 +179300 MOVE-DELETE-F1-62. NC1054.2 +179400 PERFORM DE-LETE. NC1054.2 +179500 GO TO MOVE-WRITE-F1-62. NC1054.2 +179600 MOVE-FAIL-F1-62. NC1054.2 +179700 MOVE " 000.000,0" TO CORRECT-A. NC1054.2 +179800 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +179900 PERFORM FAIL. NC1054.2 +180000 MOVE-WRITE-F1-62. NC1054.2 +180100 MOVE "MOVE-TEST-F1-62" TO PAR-NAME. NC1054.2 +180200 PERFORM PRINT-DETAIL. NC1054.2 +180300 MOVE-INIT-F1-63. NC1054.2 +180400 MOVE "MOVE SPACE LITERAL " TO FEATURE. NC1054.2 +180500 MOVE-TEST-F1-63-0. NC1054.2 +180600 MOVE SPACE TO GRP-WRK-DU-10V00. NC1054.2 +180700 MOVE-TEST-F1-63-1. NC1054.2 +180800 IF GRP-WRK-DU-10V00 EQUAL TO SPACE NC1054.2 +180900 PERFORM PASS NC1054.2 +181000 GO TO MOVE-WRITE-F1-63. NC1054.2 +181100 GO TO MOVE-FAIL-F1-63. NC1054.2 +181200 MOVE-DELETE-F1-63. NC1054.2 +181300 PERFORM DE-LETE. NC1054.2 +181400 GO TO MOVE-WRITE-F1-63. NC1054.2 +181500 MOVE-FAIL-F1-63. NC1054.2 +181600 MOVE SPACE TO CORRECT-A. NC1054.2 +181700 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +181800 PERFORM FAIL. NC1054.2 +181900 MOVE-WRITE-F1-63. NC1054.2 +182000 MOVE "MOVE-TEST-F1-63" TO PAR-NAME. NC1054.2 +182100 PERFORM PRINT-DETAIL. NC1054.2 +182200 MOVE-INIT-F1-64. NC1054.2 +182300 MOVE-TEST-F1-64-0. NC1054.2 +182400 MOVE SPACE TO WRK-AN-00026. NC1054.2 +182500 MOVE-TEST-F1-64-1. NC1054.2 +182600 IF GRP-WRK-AN-00026 EQUAL TO " " NC1054.2 +182700 PERFORM PASS NC1054.2 +182800 GO TO MOVE-WRITE-F1-64. NC1054.2 +182900 GO TO MOVE-FAIL-F1-64. NC1054.2 +183000 MOVE-DELETE-F1-64. NC1054.2 +183100 PERFORM DE-LETE. NC1054.2 +183200 GO TO MOVE-WRITE-F1-64. NC1054.2 +183300 MOVE-FAIL-F1-64. NC1054.2 +183400 MOVE SPACE TO SEND-BREAKDOWN. NC1054.2 +183500 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +183600 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +183700 PERFORM FAIL. NC1054.2 +183800 PERFORM A20 THRU A40. NC1054.2 +183900 MOVE-WRITE-F1-64. NC1054.2 +184000 MOVE "MOVE-TEST-F1-64" TO PAR-NAME. NC1054.2 +184100 PERFORM PRINT-DETAIL. NC1054.2 +184200 MOVE-INIT-F1-65. NC1054.2 +184300 MOVE-TEST-F1-65-0. NC1054.2 +184400 MOVE SPACE TO WRK-XN-00049. NC1054.2 +184500 MOVE-TEST-F1-65-1. NC1054.2 +184600 IF GRP-WRK-XN-00049 EQUAL TO SPACE NC1054.2 +184700 PERFORM PASS NC1054.2 +184800 GO TO MOVE-WRITE-F1-65. NC1054.2 +184900 GO TO MOVE-FAIL-F1-65. NC1054.2 +185000 MOVE-DELETE-F1-65. NC1054.2 +185100 PERFORM DE-LETE. NC1054.2 +185200 GO TO MOVE-WRITE-F1-65. NC1054.2 +185300 MOVE-FAIL-F1-65. NC1054.2 +185400 MOVE SPACE TO SEND-BREAKDOWN. NC1054.2 +185500 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +185600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +185700 PERFORM FAIL. NC1054.2 +185800 PERFORM A20 THRU A60. NC1054.2 +185900 MOVE-WRITE-F1-65. NC1054.2 +186000 MOVE "MOVE-TEST-F1-65" TO PAR-NAME. NC1054.2 +186100 PERFORM PRINT-DETAIL. NC1054.2 +186200 MOVE-INIT-F1-66. NC1054.2 +186300 MOVE-TEST-F1-66-0. NC1054.2 +186400 MOVE SPACE TO AE-0002. NC1054.2 +186500 MOVE-TEST-F1-66-1. NC1054.2 +186600 IF GRP-AE-0002 EQUAL TO " 0 " NC1054.2 +186700 PERFORM PASS NC1054.2 +186800 GO TO MOVE-WRITE-F1-66. NC1054.2 +186900 GO TO MOVE-FAIL-F1-66. NC1054.2 +187000 MOVE-DELETE-F1-66. NC1054.2 +187100 PERFORM DE-LETE. NC1054.2 +187200 GO TO MOVE-WRITE-F1-66. NC1054.2 +187300 MOVE-FAIL-F1-66. NC1054.2 +187400 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +187500 MOVE " 0 " TO CORRECT-A. NC1054.2 +187600 PERFORM FAIL. NC1054.2 +187700 MOVE-WRITE-F1-66. NC1054.2 +187800 MOVE "MOVE-TEST-F1-66" TO PAR-NAME. NC1054.2 +187900 PERFORM PRINT-DETAIL. NC1054.2 +188000 MOVE-INIT-F1-67. NC1054.2 +188100 MOVE "MOVE HIGH-VALUE " TO FEATURE. NC1054.2 +188200 MOVE-TEST-F1-67-0. NC1054.2 +188300 MOVE HIGH-VALUE TO GRP-WRK-DU-10V00. NC1054.2 +188400 MOVE-TEST-F1-67-1. NC1054.2 +188500 IF GRP-WRK-DU-10V00 EQUAL TO HIGH-VALUE NC1054.2 +188600 PERFORM PASS NC1054.2 +188700 GO TO MOVE-WRITE-F1-67. NC1054.2 +188800 GO TO MOVE-FAIL-F1-67. NC1054.2 +188900 MOVE-DELETE-F1-67. NC1054.2 +189000 PERFORM DE-LETE. NC1054.2 +189100 GO TO MOVE-WRITE-F1-67. NC1054.2 +189200 MOVE-FAIL-F1-67. NC1054.2 +189300 MOVE HIGH-VALU-10LONG TO CORRECT-A. NC1054.2 +189400 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +189500 PERFORM FAIL. NC1054.2 +189600 MOVE-WRITE-F1-67. NC1054.2 +189700 MOVE "MOVE-TEST-F1-67" TO PAR-NAME. NC1054.2 +189800 PERFORM PRINT-DETAIL. NC1054.2 +189900 MOVE-INIT-F1-68. NC1054.2 +190000 MOVE-TEST-F1-68-0. NC1054.2 +190100 MOVE HIGH-VALUE TO WRK-XN-00049. NC1054.2 +190200 MOVE-TEST-F1-68-1. NC1054.2 +190300 IF GRP-WRK-XN-00049 EQUAL TO HIGH-VALUE NC1054.2 +190400 PERFORM PASS NC1054.2 +190500 GO TO MOVE-WRITE-F1-68. NC1054.2 +190600 MOVE-DELETE-F1-68. NC1054.2 +190700 PERFORM DE-LETE. NC1054.2 +190800 GO TO MOVE-WRITE-F1-68. NC1054.2 +190900 MOVE-FAIL-F1-68. NC1054.2 +191000 MOVE HIGH-VALU-49LONG TO SEND-BREAKDOWN. NC1054.2 +191100 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +191200 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +191300 PERFORM FAIL. NC1054.2 +191400 PERFORM A20 THRU A60. NC1054.2 +191500 MOVE-WRITE-F1-68. NC1054.2 +191600 MOVE "MOVE-TEST-F1-68" TO PAR-NAME. NC1054.2 +191700 PERFORM PRINT-DETAIL. NC1054.2 +191800 MOVE-INIT-F1-69. NC1054.2 +191900 MOVE-TEST-F1-69-0. NC1054.2 +192000 MOVE HIGH-VALUE TO AE-0002. NC1054.2 +192100 MOVE-TEST-F1-69-1. NC1054.2 +192200 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +192300 PERFORM PASS NC1054.2 +192400 GO TO MOVE-WRITE-F1-69. NC1054.2 +192500 GO TO MOVE-FAIL-F1-69. NC1054.2 +192600 MOVE-DELETE-F1-69. NC1054.2 +192700 PERFORM DE-LETE. NC1054.2 +192800 GO TO MOVE-WRITE-F1-69. NC1054.2 +192900 MOVE-FAIL-F1-69. NC1054.2 +193000 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +193100 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +193200 PERFORM FAIL. NC1054.2 +193300 MOVE-WRITE-F1-69. NC1054.2 +193400 MOVE "MOVE-TEST-F1-69" TO PAR-NAME. NC1054.2 +193500 PERFORM PRINT-DETAIL. NC1054.2 +193600 MOVE-INIT-F1-70. NC1054.2 +193700 MOVE "MOVE LOW-VALUE " TO FEATURE. NC1054.2 +193800 MOVE-TEST-F1-70-0. NC1054.2 +193900 MOVE LOW-VALUE TO GRP-WRK-DU-10V00. NC1054.2 +194000 MOVE-TEST-F1-70-1. NC1054.2 +194100 IF GRP-WRK-DU-10V00 EQUAL TO LOW-VALUE NC1054.2 +194200 PERFORM PASS NC1054.2 +194300 GO TO MOVE-WRITE-F1-70. NC1054.2 +194400 GO TO MOVE-FAIL-F1-70. NC1054.2 +194500 MOVE-DELETE-F1-70. NC1054.2 +194600 PERFORM DE-LETE. NC1054.2 +194700 GO TO MOVE-WRITE-F1-70. NC1054.2 +194800 MOVE-FAIL-F1-70. NC1054.2 +194900 MOVE LOW-VALU-10LONG TO CORRECT-A. NC1054.2 +195000 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +195100 PERFORM FAIL. NC1054.2 +195200 MOVE-WRITE-F1-70. NC1054.2 +195300 MOVE "MOVE-TEST-F1-70" TO PAR-NAME. NC1054.2 +195400 PERFORM PRINT-DETAIL. NC1054.2 +195500 MOVE-INIT-F1-71. NC1054.2 +195600 MOVE-TEST-F1-71-0. NC1054.2 +195700 MOVE LOW-VALUE TO WRK-XN-00049. NC1054.2 +195800 MOVE-TEST-F1-71-1. NC1054.2 +195900 IF GRP-WRK-XN-00049 EQUAL TO LOW-VALUE NC1054.2 +196000 PERFORM PASS NC1054.2 +196100 GO TO MOVE-WRITE-F1-71. NC1054.2 +196200 GO TO MOVE-FAIL-F1-71. NC1054.2 +196300 MOVE-DELETE-F1-71. NC1054.2 +196400 PERFORM DE-LETE. NC1054.2 +196500 GO TO MOVE-WRITE-F1-71. NC1054.2 +196600 MOVE-FAIL-F1-71. NC1054.2 +196700 MOVE LOW-VALU-49LONG TO SEND-BREAKDOWN. NC1054.2 +196800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +196900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +197000 PERFORM FAIL. NC1054.2 +197100 PERFORM A20 THRU A60. NC1054.2 +197200 MOVE-WRITE-F1-71. NC1054.2 +197300 MOVE "MOVE-TEST-F1-71" TO PAR-NAME. NC1054.2 +197400 PERFORM PRINT-DETAIL. NC1054.2 +197500 MOVE-INIT-F1-72. NC1054.2 +197600 MOVE LOW-VALUE TO HIGH-1 HIGH-2 HIGH-3. NC1054.2 +197700 MOVE-TEST-F1-72-0. NC1054.2 +197800 MOVE LOW-VALUE TO AE-0002. NC1054.2 +197900 MOVE-TEST-F1-72-1. NC1054.2 +198000 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +198100 PERFORM PASS NC1054.2 +198200 GO TO MOVE-WRITE-F1-72. NC1054.2 +198300 GO TO MOVE-FAIL-F1-72. NC1054.2 +198400 MOVE-DELETE-F1-72. NC1054.2 +198500 PERFORM DE-LETE. NC1054.2 +198600 GO TO MOVE-WRITE-F1-72. NC1054.2 +198700 MOVE-FAIL-F1-72. NC1054.2 +198800 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +198900 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +199000 PERFORM FAIL. NC1054.2 +199100 MOVE-WRITE-F1-72. NC1054.2 +199200 MOVE "MOVE-TEST-F1-72" TO PAR-NAME. NC1054.2 +199300 PERFORM PRINT-DETAIL. NC1054.2 +199400 MOVE-INIT-F1-73. NC1054.2 +199500 MOVE "MOVE QUOTE " TO FEATURE. NC1054.2 +199600 MOVE-TEST-F1-73-0. NC1054.2 +199700 MOVE QUOTE TO GRP-WRK-DU-10V00. NC1054.2 +199800 MOVE-TEST-F1-73-1. NC1054.2 +199900 IF GRP-WRK-DU-10V00 EQUAL TO QUOTE NC1054.2 +200000 PERFORM PASS NC1054.2 +200100 GO TO MOVE-WRITE-F1-73. NC1054.2 +200200 GO TO MOVE-FAIL-F1-73. NC1054.2 +200300 MOVE-DELETE-F1-73. NC1054.2 +200400 PERFORM DE-LETE. NC1054.2 +200500 GO TO MOVE-WRITE-F1-73. NC1054.2 +200600 MOVE-FAIL-F1-73. NC1054.2 +200700 MOVE QUOTE-10LONG TO CORRECT-A. NC1054.2 +200800 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +200900 PERFORM FAIL. NC1054.2 +201000 MOVE-WRITE-F1-73. NC1054.2 +201100 MOVE "MOVE-TEST-F1-73" TO PAR-NAME. NC1054.2 +201200 PERFORM PRINT-DETAIL. NC1054.2 +201300 MOVE-INIT-F1-74. NC1054.2 +201400 MOVE-TEST-F1-74-0. NC1054.2 +201500 MOVE QUOTE TO WRK-XN-00049. NC1054.2 +201600 MOVE-TEST-F1-74-1. NC1054.2 +201700 IF GRP-WRK-XN-00049 EQUAL TO QUOTE NC1054.2 +201800 PERFORM PASS NC1054.2 +201900 GO TO MOVE-WRITE-F1-74. NC1054.2 +202000 GO TO MOVE-FAIL-F1-74. NC1054.2 +202100 MOVE-DELETE-F1-74. NC1054.2 +202200 PERFORM DE-LETE. NC1054.2 +202300 GO TO MOVE-WRITE-F1-74. NC1054.2 +202400 MOVE-FAIL-F1-74. NC1054.2 +202500 MOVE QUOTE-49LONG TO SEND-BREAKDOWN. NC1054.2 +202600 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +202700 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +202800 PERFORM FAIL. NC1054.2 +202900 PERFORM A20 THRU A60. NC1054.2 +203000 MOVE-WRITE-F1-74. NC1054.2 +203100 MOVE "MOVE-TEST-F1-74" TO PAR-NAME. NC1054.2 +203200 PERFORM PRINT-DETAIL. NC1054.2 +203300 MOVE-INIT-F1-75. NC1054.2 +203400 MOVE QUOTE TO HIGH-1 HIGH-2 HIGH-3. NC1054.2 +203500 MOVE-TEST-F1-75-0. NC1054.2 +203600 MOVE QUOTE TO AE-0002. NC1054.2 +203700 MOVE-TEST-F1-75-1. NC1054.2 +203800 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +203900 PERFORM PASS NC1054.2 +204000 GO TO MOVE-WRITE-F1-75. NC1054.2 +204100 GO TO MOVE-FAIL-F1-75. NC1054.2 +204200 MOVE-DELETE-F1-75. NC1054.2 +204300 PERFORM DE-LETE. NC1054.2 +204400 GO TO MOVE-WRITE-F1-75. NC1054.2 +204500 MOVE-FAIL-F1-75. NC1054.2 +204600 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +204700 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +204800 PERFORM FAIL. NC1054.2 +204900 MOVE-WRITE-F1-75. NC1054.2 +205000 MOVE "MOVE-TEST-F1-75" TO PAR-NAME. NC1054.2 +205100 PERFORM PRINT-DETAIL. NC1054.2 +205200 MOVE-INIT-F1-76. NC1054.2 +205300 MOVE-TEST-F1-76-0. NC1054.2 +205400 MOVE "A1B2C3D4E5" TO GRP-WRK-DU-10V00. NC1054.2 +205500 MOVE-TEST-F1-76-1. NC1054.2 +205600 IF GRP-WRK-DU-10V00 EQUAL TO "A1B2C3D4E5" NC1054.2 +205700 PERFORM PASS NC1054.2 +205800 GO TO MOVE-WRITE-F1-76. NC1054.2 +205900 GO TO MOVE-FAIL-F1-76. NC1054.2 +206000 MOVE-DELETE-F1-76. NC1054.2 +206100 PERFORM DE-LETE. NC1054.2 +206200 GO TO MOVE-WRITE-F1-76. NC1054.2 +206300 MOVE-FAIL-F1-76. NC1054.2 +206400 MOVE "A1B2C3D4E5" TO CORRECT-A. NC1054.2 +206500 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +206600 PERFORM FAIL. NC1054.2 +206700 MOVE-WRITE-F1-76. NC1054.2 +206800 MOVE "MOVE ALPHNUM LITERAL" TO FEATURE. NC1054.2 +206900 MOVE "MOVE-TEST-F1-76" TO PAR-NAME. NC1054.2 +207000 PERFORM PRINT-DETAIL. NC1054.2 +207100 MOVE-INIT-F1-77. NC1054.2 +207200 MOVE-TEST-F1-77-0. NC1054.2 +207300 MOVE "ABCDEFGHIJK" TO WRK-AN-00026. NC1054.2 +207400 MOVE-TEST-F1-77-1. NC1054.2 +207500 IF GRP-WRK-AN-00026 EQUAL TO "ABCDEFGHIJK "NC1054.2 +207600 PERFORM PASS NC1054.2 +207700 GO TO MOVE-WRITE-F1-77. NC1054.2 +207800 GO TO MOVE-FAIL-F1-77. NC1054.2 +207900 MOVE-DELETE-F1-77. NC1054.2 +208000 PERFORM DE-LETE. NC1054.2 +208100 GO TO MOVE-WRITE-F1-77. NC1054.2 +208200 MOVE-FAIL-F1-77. NC1054.2 +208300 MOVE "ABCDEFGHIJK " TO SEND-BREAKDOWN. NC1054.2 +208400 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +208500 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +208600 PERFORM FAIL. NC1054.2 +208700 PERFORM A20 THRU A40. NC1054.2 +208800 MOVE-WRITE-F1-77. NC1054.2 +208900 MOVE "MOVE ALPHA LITERAL " TO FEATURE. NC1054.2 +209000 MOVE "MOVE-TEST-F1-77" TO PAR-NAME. NC1054.2 +209100 PERFORM PRINT-DETAIL. NC1054.2 +209200 MOVE-INIT-F1-78. NC1054.2 +209300 MOVE "MOVE ALPHNUM LITERAL" TO FEATURE. NC1054.2 +209400 MOVE-TEST-F1-78-0. NC1054.2 +209500 MOVE "1A2B3C4D5E6F" TO WRK-XN-00049. NC1054.2 +209600 MOVE-TEST-F1-78-1. NC1054.2 +209700 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +209800 "1A2B3C4D5E6F " NC1054.2 +209900 PERFORM PASS NC1054.2 +210000 GO TO MOVE-WRITE-F1-78. NC1054.2 +210100 GO TO MOVE-FAIL-F1-78. NC1054.2 +210200 MOVE-DELETE-F1-78. NC1054.2 +210300 PERFORM DE-LETE. NC1054.2 +210400 GO TO MOVE-WRITE-F1-78. NC1054.2 +210500 MOVE-FAIL-F1-78. NC1054.2 +210600 MOVE "1A2B3C4D5E6F " NC1054.2 +210700 TO SEND-BREAKDOWN. NC1054.2 +210800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +210900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +211000 PERFORM FAIL. NC1054.2 +211100 PERFORM A20 THRU A60. NC1054.2 +211200 MOVE-WRITE-F1-78. NC1054.2 +211300 MOVE "MOVE-TEST-F1-78" TO PAR-NAME. NC1054.2 +211400 PERFORM PRINT-DETAIL. NC1054.2 +211500 MOVE-INIT-F1-79. NC1054.2 +211600 MOVE-TEST-F1-79-0. NC1054.2 +211700 MOVE "1Z2Y3X4W5V" TO AE-0002. NC1054.2 +211800 MOVE-TEST-F1-79-1. NC1054.2 +211900 IF GRP-AE-0002 EQUAL TO "1Z02Y 3X4" NC1054.2 +212000 PERFORM PASS NC1054.2 +212100 GO TO MOVE-WRITE-F1-79. NC1054.2 +212200 GO TO MOVE-FAIL-F1-79. NC1054.2 +212300 MOVE-DELETE-F1-79. NC1054.2 +212400 PERFORM DE-LETE. NC1054.2 +212500 GO TO MOVE-WRITE-F1-79. NC1054.2 +212600 MOVE-FAIL-F1-79. NC1054.2 +212700 MOVE "1Z02Y 3X4" TO CORRECT-A. NC1054.2 +212800 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +212900 PERFORM FAIL. NC1054.2 +213000 MOVE-WRITE-F1-79. NC1054.2 +213100 MOVE "MOVE-TEST-F1-79" TO PAR-NAME. NC1054.2 +213200 PERFORM PRINT-DETAIL. NC1054.2 +213300 MOVE-INIT-F1-80. NC1054.2 +213400 MOVE-TEST-F1-80-0. NC1054.2 +213500 MOVE "9876543210" TO WRK-DU-10V00. NC1054.2 +213600 MOVE-TEST-F1-80-1. NC1054.2 +213700 IF GRP-WRK-DU-10V00 EQUAL TO "9876543210" NC1054.2 +213800 PERFORM PASS NC1054.2 +213900 GO TO MOVE-WRITE-F1-80. NC1054.2 +214000 GO TO MOVE-FAIL-F1-80. NC1054.2 +214100 MOVE-DELETE-F1-80. NC1054.2 +214200 PERFORM DE-LETE. NC1054.2 +214300 GO TO MOVE-WRITE-F1-80. NC1054.2 +214400 MOVE-FAIL-F1-80. NC1054.2 +214500 MOVE "9876543210" TO CORRECT-A. NC1054.2 +214600 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +214700 PERFORM FAIL. NC1054.2 +214800 MOVE-WRITE-F1-80. NC1054.2 +214900 MOVE "MOVE-TEST-F1-80" TO PAR-NAME. NC1054.2 +215000 PERFORM PRINT-DETAIL. NC1054.2 +215100 MOVE-INIT-F1-81. NC1054.2 +215200 MOVE-TEST-F1-81-0. NC1054.2 +215300 MOVE "9876543210" TO NE-0002. NC1054.2 +215400 MOVE-TEST-F1-81-1. NC1054.2 +215500 IF GRP-NE-0002 EQUAL TO "9876543,210" NC1054.2 +215600 PERFORM PASS NC1054.2 +215700 GO TO MOVE-WRITE-F1-81. NC1054.2 +215800 GO TO MOVE-FAIL-F1-81. NC1054.2 +215900 MOVE-DELETE-F1-81. NC1054.2 +216000 PERFORM DE-LETE. NC1054.2 +216100 GO TO MOVE-WRITE-F1-81. NC1054.2 +216200 MOVE-FAIL-F1-81. NC1054.2 +216300 MOVE "9876543,210" TO CORRECT-A. NC1054.2 +216400 MOVE GRP-NE-0002 TO COMPUTED-A. NC1054.2 +216500 PERFORM FAIL. NC1054.2 +216600 MOVE-WRITE-F1-81. NC1054.2 +216700 MOVE "MOVE-TEST-F1-81" TO PAR-NAME. NC1054.2 +216800 PERFORM PRINT-DETAIL. NC1054.2 +216900 MOVE-INIT-F1-82. NC1054.2 +217000 MOVE "MOVE NUMERIC LITERAL" TO FEATURE. NC1054.2 +217100 MOVE-TEST-F1-82-0. NC1054.2 +217200 MOVE 0123456789 TO GRP-WRK-DU-10V00. NC1054.2 +217300 MOVE-TEST-F1-82-1. NC1054.2 +217400 IF GRP-WRK-DU-10V00 EQUAL TO "0123456789" NC1054.2 +217500 PERFORM PASS NC1054.2 +217600 GO TO MOVE-WRITE-F1-82. NC1054.2 +217700 GO TO MOVE-FAIL-F1-82. NC1054.2 +217800 MOVE-DELETE-F1-82. NC1054.2 +217900 PERFORM DE-LETE. NC1054.2 +218000 GO TO MOVE-WRITE-F1-82. NC1054.2 +218100 MOVE-FAIL-F1-82. NC1054.2 +218200 MOVE "0123456789" TO CORRECT-A. NC1054.2 +218300 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +218400 PERFORM FAIL. NC1054.2 +218500 MOVE-WRITE-F1-82. NC1054.2 +218600 MOVE "MOVE-TEST-F1-82" TO PAR-NAME. NC1054.2 +218700 PERFORM PRINT-DETAIL. NC1054.2 +218800 MOVE-INIT-F1-83. NC1054.2 +218900 MOVE-TEST-F1-83-0. NC1054.2 +219000 MOVE 0918273645 TO WRK-XN-00049. NC1054.2 +219100 MOVE-TEST-F1-83-1. NC1054.2 +219200 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +219300 "0918273645 " NC1054.2 +219400 PERFORM PASS NC1054.2 +219500 GO TO MOVE-WRITE-F1-83. NC1054.2 +219600 GO TO MOVE-FAIL-F1-83. NC1054.2 +219700 MOVE-DELETE-F1-83. NC1054.2 +219800 PERFORM DE-LETE. NC1054.2 +219900 GO TO MOVE-WRITE-F1-83. NC1054.2 +220000 MOVE-FAIL-F1-83. NC1054.2 +220100 MOVE "0918273645 " NC1054.2 +220200 TO SEND-BREAKDOWN. NC1054.2 +220300 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +220400 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +220500 PERFORM FAIL. NC1054.2 +220600 PERFORM A20 THRU A60. NC1054.2 +220700 MOVE-WRITE-F1-83. NC1054.2 +220800 MOVE "MOVE-TEST-F1-82" TO PAR-NAME. NC1054.2 +220900 PERFORM PRINT-DETAIL. NC1054.2 +221000 MOVE-INIT-F1-84. NC1054.2 +221100 MOVE-TEST-F1-84-0. NC1054.2 +221200 MOVE 019823 TO AE-0002. NC1054.2 +221300 MOVE-TEST-F1-84-1. NC1054.2 +221400 IF GRP-AE-0002 EQUAL TO "01098 23 " NC1054.2 +221500 PERFORM PASS NC1054.2 +221600 GO TO MOVE-WRITE-F1-84. NC1054.2 +221700 GO TO MOVE-FAIL-F1-84. NC1054.2 +221800 MOVE-DELETE-F1-84. NC1054.2 +221900 PERFORM DE-LETE. NC1054.2 +222000 GO TO MOVE-WRITE-F1-84. NC1054.2 +222100 MOVE-FAIL-F1-84. NC1054.2 +222200 MOVE "01098 23 " TO CORRECT-A. NC1054.2 +222300 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +222400 PERFORM FAIL. NC1054.2 +222500 MOVE-WRITE-F1-84. NC1054.2 +222600 MOVE "MOVE-TEST-F1-84" TO PAR-NAME. NC1054.2 +222700 PERFORM PRINT-DETAIL. NC1054.2 +222800 MOVE-INIT-F1-85. NC1054.2 +222900 MOVE-TEST-F1-85-0. NC1054.2 +223000 MOVE 9876543210 TO WRK-DU-10V00. NC1054.2 +223100 MOVE-TEST-F1-85-1. NC1054.2 +223200 IF GRP-WRK-DU-10V00 EQUAL TO "9876543210" NC1054.2 +223300 PERFORM PASS NC1054.2 +223400 GO TO MOVE-WRITE-F1-85. NC1054.2 +223500 GO TO MOVE-FAIL-F1-85. NC1054.2 +223600 MOVE-DELETE-F1-85. NC1054.2 +223700 PERFORM DE-LETE. NC1054.2 +223800 GO TO MOVE-WRITE-F1-85. NC1054.2 +223900 MOVE-FAIL-F1-85. NC1054.2 +224000 MOVE "9876543210" TO CORRECT-A. NC1054.2 +224100 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +224200 PERFORM FAIL. NC1054.2 +224300 MOVE-WRITE-F1-85. NC1054.2 +224400 MOVE "MOVE-TEST-F1-85" TO PAR-NAME. NC1054.2 +224500 PERFORM PRINT-DETAIL. NC1054.2 +224600 MOVE-INIT-F1-86. NC1054.2 +224700 MOVE-TEST-F1-86-0. NC1054.2 +224800 MOVE 00012345 TO NE-0002. NC1054.2 +224900 MOVE-TEST-F1-86-1. NC1054.2 +225000 IF GRP-NE-0002 EQUAL TO " 12,345" NC1054.2 +225100 PERFORM PASS NC1054.2 +225200 GO TO MOVE-WRITE-F1-86. NC1054.2 +225300 GO TO MOVE-FAIL-F1-86. NC1054.2 +225400 MOVE-DELETE-F1-86. NC1054.2 +225500 PERFORM DE-LETE. NC1054.2 +225600 GO TO MOVE-WRITE-F1-86. NC1054.2 +225700 MOVE-FAIL-F1-86. NC1054.2 +225800 MOVE " 12,345" TO CORRECT-A. NC1054.2 +225900 MOVE GRP-NE-0002 TO COMPUTED-A. NC1054.2 +226000 PERFORM FAIL. NC1054.2 +226100 MOVE-WRITE-F1-86. NC1054.2 +226200 MOVE "MOVE-TEST-F1-86" TO PAR-NAME. NC1054.2 +226300 PERFORM PRINT-DETAIL. NC1054.2 +226400 MOVE-INIT-F1-87. NC1054.2 +226500 MOVE-TEST-F1-87-0. NC1054.2 +226600 MOVE 000011.1223 TO NE-0001. NC1054.2 +226700 MOVE-TEST-F1-87-1. NC1054.2 +226800 IF GRP-NE-0001 EQUAL TO " 011.122,3" NC1054.2 +226900 PERFORM PASS NC1054.2 +227000 GO TO MOVE-WRITE-F1-87. NC1054.2 +227100 GO TO MOVE-FAIL-F1-87. NC1054.2 +227200 MOVE-DELETE-F1-87. NC1054.2 +227300 PERFORM DE-LETE. NC1054.2 +227400 GO TO MOVE-WRITE-F1-87. NC1054.2 +227500 MOVE-FAIL-F1-87. NC1054.2 +227600 MOVE " 011.122,3" TO CORRECT-A. NC1054.2 +227700 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +227800 PERFORM FAIL. NC1054.2 +227900 MOVE-WRITE-F1-87. NC1054.2 +228000 MOVE "MOVE-TEST-F1-87" TO PAR-NAME. NC1054.2 +228100 PERFORM PRINT-DETAIL. NC1054.2 +228200 MOVE-INIT-F1-88. NC1054.2 +228300 MOVE +60666 TO SPOS-LIT1. NC1054.2 +228400 MOVE-TEST-F1-88-0. NC1054.2 +228500 MOVE SPOS-LIT1 TO NUMERIC-LIT. NC1054.2 +228600 MOVE-TEST-F1-88-1. NC1054.2 +228700 IF NUMERIC-LIT EQUAL TO "60666" NC1054.2 +228800 PERFORM PASS NC1054.2 +228900 GO TO MOVE-WRITE-F1-88. NC1054.2 +229000 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +229100 MOVE 60666 TO CORRECT-A. NC1054.2 +229200 PERFORM FAIL. NC1054.2 +229300 GO TO MOVE-WRITE-F1-88. NC1054.2 +229400 MOVE-DELETE-F1-88. NC1054.2 +229500 PERFORM DE-LETE. NC1054.2 +229600 MOVE-WRITE-F1-88. NC1054.2 +229700 MOVE "MOVE-TEST-F1-88" TO PAR-NAME. NC1054.2 +229800 PERFORM PRINT-DETAIL. NC1054.2 +229900 MOVE-INIT-F1-89. NC1054.2 +230000 MOVE -70717 TO SPOS-LIT1. NC1054.2 +230100 MOVE-TEST-F1-89-0. NC1054.2 +230200 MOVE SNEG-LIT1 TO NUMERIC-LIT. NC1054.2 +230300 MOVE-TEST-F1-89-1. NC1054.2 +230400 IF NUMERIC-LIT EQUAL TO "70717" NC1054.2 +230500 PERFORM PASS NC1054.2 +230600 GO TO MOVE-WRITE-F1-89. NC1054.2 +230700 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +230800 MOVE 70717 TO CORRECT-A. NC1054.2 +230900 PERFORM FAIL. NC1054.2 +231000 GO TO MOVE-WRITE-F1-89. NC1054.2 +231100 MOVE-DELETE-F1-89. NC1054.2 +231200 PERFORM DE-LETE. NC1054.2 +231300 MOVE-WRITE-F1-89. NC1054.2 +231400 MOVE "MOVE-TEST-F1-89" TO PAR-NAME. NC1054.2 +231500 PERFORM PRINT-DETAIL. NC1054.2 +231600 MOVE-INIT-F1-90. NC1054.2 +231700 MOVE +60667 TO SPOS-LIT2. NC1054.2 +231800 MOVE-TEST-F1-90-0. NC1054.2 +231900 MOVE SPOS-LIT2 TO NUMERIC-LIT. NC1054.2 +232000 MOVE-TEST-F1-90-1. NC1054.2 +232100 IF NUMERIC-LIT EQUAL TO 60667 NC1054.2 +232200 PERFORM PASS NC1054.2 +232300 GO TO MOVE-WRITE-F1-90. NC1054.2 +232400 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +232500 MOVE 60667 TO CORRECT-A. NC1054.2 +232600 PERFORM FAIL. NC1054.2 +232700 GO TO MOVE-WRITE-F1-90. NC1054.2 +232800 MOVE-DELETE-F1-90. NC1054.2 +232900 PERFORM DE-LETE. NC1054.2 +233000 MOVE-WRITE-F1-90. NC1054.2 +233100 MOVE "MOVE-TEST-F1-90" TO PAR-NAME. NC1054.2 +233200 PERFORM PRINT-DETAIL. NC1054.2 +233300 MOVE-INIT-F1-91. NC1054.2 +233400 MOVE -70718 TO SNEG-LIT2. NC1054.2 +233500 MOVE-TEST-F1-91-0. NC1054.2 +233600 MOVE SNEG-LIT2 TO NUMERIC-LIT. NC1054.2 +233700 MOVE-TEST-F1-91-1. NC1054.2 +233800 IF NUMERIC-LIT EQUAL TO 70718 NC1054.2 +233900 PERFORM PASS NC1054.2 +234000 GO TO MOVE-WRITE-F1-91. NC1054.2 +234100 MOVE "+S9 MOVED TO PICTURE X " TO RE-MARK. NC1054.2 +234200 MOVE NUMERIC-LIT TO COMPUTED-A. NC1054.2 +234300 MOVE "70718" TO CORRECT-A. NC1054.2 +234400 PERFORM FAIL. NC1054.2 +234500 GO TO MOVE-WRITE-F1-91. NC1054.2 +234600 MOVE-DELETE-F1-91. NC1054.2 +234700 PERFORM DE-LETE. NC1054.2 +234800 MOVE-WRITE-F1-91. NC1054.2 +234900 MOVE "MOVE-TEST-F1-91" TO PAR-NAME. NC1054.2 +235000 PERFORM PRINT-DETAIL. NC1054.2 +235100 MOVE-INIT-F1-92. NC1054.2 +235200 MOVE +60666 TO SPOS-LIT1. NC1054.2 +235300 MOVE-TEST-F1-92-0. NC1054.2 +235400 MOVE SPOS-LIT1 TO ALPHA-LIT. NC1054.2 +235500 MOVE-TEST-F1-92-1. NC1054.2 +235600 IF ALPHA-LIT EQUAL TO "60666" NC1054.2 +235700 PERFORM PASS NC1054.2 +235800 GO TO MOVE-WRITE-F1-92. NC1054.2 +235900 MOVE ALPHA-LIT TO COMPUTED-A. NC1054.2 +236000 MOVE "60666" TO CORRECT-A. NC1054.2 +236100 MOVE "SIGN SHOULD NOT BE MOVED" TO RE-MARK. NC1054.2 +236200 PERFORM FAIL. NC1054.2 +236300 GO TO MOVE-WRITE-F1-92. NC1054.2 +236400 MOVE-DELETE-F1-92. NC1054.2 +236500 PERFORM DE-LETE. NC1054.2 +236600 MOVE-WRITE-F1-92. NC1054.2 +236700 MOVE "MOVE-TEST-F1-92" TO PAR-NAME. NC1054.2 +236800 PERFORM PRINT-DETAIL. NC1054.2 +236900 MOVE-INIT-F1-93. NC1054.2 +237000 MOVE -70717 TO SNEG-LIT1. NC1054.2 +237100 MOVE-TEST-F1-93-0. NC1054.2 +237200 MOVE SNEG-LIT1 TO ALPHA-LIT. NC1054.2 +237300 MOVE-TEST-F1-93-1. NC1054.2 +237400 IF ALPHA-LIT EQUAL TO "70717" NC1054.2 +237500 PERFORM PASS NC1054.2 +237600 GO TO MOVE-WRITE-F1-93. NC1054.2 +237700 MOVE ALPHA-LIT TO COMPUTED-A. NC1054.2 +237800 MOVE "70717" TO CORRECT-A. NC1054.2 +237900 MOVE "SIGN SHOULD NOT BE MOVED" TO RE-MARK. NC1054.2 +238000 PERFORM FAIL. NC1054.2 +238100 GO TO MOVE-WRITE-F1-93. NC1054.2 +238200 MOVE-DELETE-F1-93. NC1054.2 +238300 PERFORM DE-LETE. NC1054.2 +238400 MOVE-WRITE-F1-93. NC1054.2 +238500 MOVE "MOVE-TEST-F1-93" TO PAR-NAME. NC1054.2 +238600 PERFORM PRINT-DETAIL. NC1054.2 +238700 MOVE-INIT-F1-94. NC1054.2 +238800 MOVE "JUSTIFIED MOVES " TO FEATURE. NC1054.2 +238900 MOVE 99 TO GRP-NUMERIC-99. NC1054.2 +239000 MOVE-TEST-F1-94-0. NC1054.2 +239100 MOVE GRP-NUMERIC-99 TO RECEIVE-1 RECEIVE-4 RECEIVE-5 NC1054.2 +239200 RECEIVE-6. NC1054.2 +239300 MOVE-TEST-F1-94-1. NC1054.2 +239400 IF RECEIVE-1 EQUAL TO "99 " NC1054.2 +239500 PERFORM PASS NC1054.2 +239600 GO TO MOVE-WRITE-F1-94. NC1054.2 +239700 MOVE RECEIVE-1 TO COMPUTED-A. NC1054.2 +239800 MOVE "99 " TO CORRECT-A. NC1054.2 +239900 PERFORM FAIL. NC1054.2 +240000 GO TO MOVE-WRITE-F1-94. NC1054.2 +240100 MOVE-DELETE-F1-94. NC1054.2 +240200 PERFORM DE-LETE. NC1054.2 +240300 MOVE-WRITE-F1-94. NC1054.2 +240400 MOVE "MOVE-TEST-F1-94" TO PAR-NAME. NC1054.2 +240500 PERFORM PRINT-DETAIL. NC1054.2 +240600 MOVE-TEST-F1-95. NC1054.2 +240700 IF RECEIVE-4 EQUAL TO 99.00 NC1054.2 +240800 PERFORM PASS NC1054.2 +240900 GO TO MOVE-WRITE-F1-95. NC1054.2 +241000 MOVE 99.00 TO CORRECT-N. NC1054.2 +241100 MOVE RECEIVE-4 TO COMPUTED-N. NC1054.2 +241200 PERFORM FAIL. NC1054.2 +241300 GO TO MOVE-WRITE-F1-95. NC1054.2 +241400 MOVE-DELETE-F1-95. NC1054.2 +241500 PERFORM DE-LETE. NC1054.2 +241600 MOVE-WRITE-F1-95. NC1054.2 +241700 MOVE "MOVE-TEST-F1-95" TO PAR-NAME. NC1054.2 +241800 PERFORM PRINT-DETAIL. NC1054.2 +241900 MOVE-TEST-F1-96. NC1054.2 +242000 IF RECEIVE-5 EQUAL TO "99 " NC1054.2 +242100 PERFORM PASS NC1054.2 +242200 GO TO MOVE-WRITE-F1-96. NC1054.2 +242300 MOVE RECEIVE-5 TO COMPUTED-A. NC1054.2 +242400 MOVE "99 " TO CORRECT-A. NC1054.2 +242500 PERFORM FAIL. NC1054.2 +242600 GO TO MOVE-WRITE-F1-96. NC1054.2 +242700 MOVE-DELETE-F1-96. NC1054.2 +242800 PERFORM DE-LETE. NC1054.2 +242900 MOVE-WRITE-F1-96. NC1054.2 +243000 MOVE "MOVE-TEST-F1-96" TO PAR-NAME. NC1054.2 +243100 PERFORM PRINT-DETAIL. NC1054.2 +243200 MOVE-TEST-F1-97. NC1054.2 +243300 IF RECEIVE-6 EQUAL TO "99 " NC1054.2 +243400 PERFORM PASS NC1054.2 +243500 GO TO MOVE-WRITE-F1-97. NC1054.2 +243600 MOVE RECEIVE-6 TO COMPUTED-A. NC1054.2 +243700 MOVE "99 " TO CORRECT-A. NC1054.2 +243800 PERFORM FAIL. NC1054.2 +243900 GO TO MOVE-WRITE-F1-97. NC1054.2 +244000 MOVE-DELETE-F1-97. NC1054.2 +244100 PERFORM DE-LETE. NC1054.2 +244200 MOVE-WRITE-F1-97. NC1054.2 +244300 MOVE "MOVE-TEST-F1-97" TO PAR-NAME. NC1054.2 +244400 PERFORM PRINT-DETAIL. NC1054.2 +244500 MOVE-INIT-F1-98. NC1054.2 +244600 MOVE "MOVE (COMP/DISPLAY)" TO FEATURE. NC1054.2 +244700 MOVE 798 TO WRK-CS-18V00. NC1054.2 +244800 MOVE-TEST-F1-98-0. NC1054.2 +244900 MOVE WRK-CS-18V00 TO WRK-DS-18V00. NC1054.2 +245000 MOVE-TEST-F1-98-1. NC1054.2 +245100 IF WRK-DS-18V00 EQUAL TO WRK-CS-18V00 NC1054.2 +245200 PERFORM PASS NC1054.2 +245300 GO TO MOVE-WRITE-F1-98. NC1054.2 +245400 MOVE WRK-CS-18V00 TO CORRECT-18V0. NC1054.2 +245500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1054.2 +245600 PERFORM FAIL. NC1054.2 +245700 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +245800 GO TO MOVE-WRITE-F1-98. NC1054.2 +245900 MOVE-DELETE-F1-98. NC1054.2 +246000 PERFORM DE-LETE. NC1054.2 +246100 MOVE-WRITE-F1-98. NC1054.2 +246200 MOVE "MOVE-TEST-F1-98" TO PAR-NAME. NC1054.2 +246300 PERFORM PRINT-DETAIL. NC1054.2 +246400 MOVE-INIT-F1-99. NC1054.2 +246500 MOVE 798 TO WRK-CS-18V00. NC1054.2 +246600 MOVE-TEST-F1-99-0. NC1054.2 +246700 MOVE WRK-CS-18V00 TO WRK-DS-10V00. NC1054.2 +246800 MOVE-TEST-F1-99-1. NC1054.2 +246900 IF WRK-DS-10V00 EQUAL TO WRK-CS-18V00 NC1054.2 +247000 PERFORM PASS NC1054.2 +247100 GO TO MOVE-WRITE-F1-99. NC1054.2 +247200 MOVE WRK-DS-10V00 TO CORRECT-18V0. NC1054.2 +247300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1054.2 +247400 PERFORM FAIL. NC1054.2 +247500 GO TO MOVE-WRITE-F1-99. NC1054.2 +247600 MOVE-DELETE-F1-99. NC1054.2 +247700 PERFORM DE-LETE. NC1054.2 +247800 MOVE-WRITE-F1-99. NC1054.2 +247900 MOVE "MOVE-TEST-F1-99" TO PAR-NAME. NC1054.2 +248000 PERFORM PRINT-DETAIL. NC1054.2 +248100 MOVE-INIT-F1-100. NC1054.2 +248200 MOVE 7 TO WRK-DS-18V00. NC1054.2 +248300 MOVE-TEST-F1-100-0. NC1054.2 +248400 MOVE WRK-DS-18V00 TO WRK-CS-01V00. NC1054.2 +248500 MOVE-TEST-F1-100-1. NC1054.2 +248600 IF WRK-CS-01V00 EQUAL TO WRK-DS-18V00 NC1054.2 +248700 PERFORM PASS NC1054.2 +248800 GO TO MOVE-WRITE-F1-100. NC1054.2 +248900 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1054.2 +249000 MOVE WRK-CS-01V00 TO CORRECT-18V0. NC1054.2 +249100 PERFORM FAIL. NC1054.2 +249200 GO TO MOVE-WRITE-F1-100. NC1054.2 +249300 MOVE-DELETE-F1-100. NC1054.2 +249400 PERFORM DE-LETE. NC1054.2 +249500 MOVE-WRITE-F1-100. NC1054.2 +249600 MOVE "MOVE-TEST-F1-100" TO PAR-NAME. NC1054.2 +249700 PERFORM PRINT-DETAIL. NC1054.2 +249800 MOVE-INIT-F1-101. NC1054.2 +249900 MOVE 0123456789 TO WRK-DS-10V00. NC1054.2 +250000 MOVE-TEST-F1-101-0. NC1054.2 +250100 MOVE WRK-DS-10V00 TO WRK-CS-18V00. NC1054.2 +250200 MOVE-TEST-F1-101-1. NC1054.2 +250300 IF WRK-DS-10V00 EQUAL TO WRK-CS-18V00 NC1054.2 +250400 PERFORM PASS NC1054.2 +250500 GO TO MOVE-WRITE-F1-101. NC1054.2 +250600 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1054.2 +250700 MOVE WRK-CS-18V00 TO CORRECT-18V0. NC1054.2 +250800 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +250900 PERFORM FAIL. NC1054.2 +251000 GO TO MOVE-WRITE-F1-101. NC1054.2 +251100 MOVE-DELETE-F1-101. NC1054.2 +251200 PERFORM DE-LETE. NC1054.2 +251300 MOVE-WRITE-F1-101. NC1054.2 +251400 MOVE "MOVE-TEST-F1-101" TO PAR-NAME. NC1054.2 +251500 PERFORM PRINT-DETAIL. NC1054.2 +251600 MOVE-INIT-F1-102. NC1054.2 +251700 MOVE 3 TO WRK-CS-18V00. NC1054.2 +251800 MOVE-TEST-F1-102-0. NC1054.2 +251900 MOVE WRK-CS-18V00 TO WRK-DS-01V00. NC1054.2 +252000 MOVE-TEST-F1-102-1. NC1054.2 +252100 IF WRK-CS-18V00 EQUAL TO WRK-DS-01V00 NC1054.2 +252200 PERFORM PASS NC1054.2 +252300 GO TO MOVE-WRITE-F1-102. NC1054.2 +252400 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1054.2 +252500 MOVE WRK-DS-01V00 TO CORRECT-18V0. NC1054.2 +252600 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +252700 PERFORM FAIL. NC1054.2 +252800 GO TO MOVE-WRITE-F1-102. NC1054.2 +252900 MOVE-DELETE-F1-102. NC1054.2 +253000 PERFORM DE-LETE. NC1054.2 +253100 MOVE-WRITE-F1-102. NC1054.2 +253200 MOVE "MOVE-TEST-F1-102" TO PAR-NAME. NC1054.2 +253300 PERFORM PRINT-DETAIL. NC1054.2 +253400 MOVE-INIT-F1-103. NC1054.2 +253500 MOVE 832.553 TO WRK-CS-08V08. NC1054.2 +253600 MOVE-TEST-F1-103-0. NC1054.2 +253700 MOVE WRK-CS-08V08 TO WRK-EDIT-Z3VZ3. NC1054.2 +253800 MOVE-TEST-F1-103-1. NC1054.2 +253900 IF WRK-EDIT-Z3VZ3 EQUAL TO "832.553" NC1054.2 +254000 PERFORM PASS NC1054.2 +254100 GO TO MOVE-WRITE-F1-103. NC1054.2 +254200 MOVE "832.553" TO CORRECT-A. NC1054.2 +254300 MOVE WRK-EDIT-Z3VZ3 TO COMPUTED-A. NC1054.2 +254400 PERFORM FAIL. NC1054.2 +254500 GO TO MOVE-WRITE-F1-103. NC1054.2 +254600 MOVE-DELETE-F1-103. NC1054.2 +254700 PERFORM DE-LETE. NC1054.2 +254800 MOVE-WRITE-F1-103. NC1054.2 +254900 MOVE "MOVE-TEST-F1-103" TO PAR-NAME. NC1054.2 +255000 PERFORM PRINT-DETAIL. NC1054.2 +255100 MOVE-INIT-F1-104. NC1054.2 +255200 MOVE 6382.47 TO WRK-CS-08V08. NC1054.2 +255300 MOVE-TEST-F1-104-0. NC1054.2 +255400 MOVE WRK-CS-04V08 TO WRK-EDIT-05V02. NC1054.2 +255500 MOVE-TEST-F1-104-1. NC1054.2 +255600 IF WRK-EDIT-05V02 EQUAL TO " 06382.47" NC1054.2 +255700 PERFORM PASS NC1054.2 +255800 GO TO MOVE-WRITE-F1-104. NC1054.2 +255900 MOVE " 06382.47" TO CORRECT-A. NC1054.2 +256000 MOVE WRK-EDIT-05V02 TO COMPUTED-A. NC1054.2 +256100 PERFORM FAIL. NC1054.2 +256200 GO TO MOVE-WRITE-F1-104. NC1054.2 +256300 MOVE-DELETE-F1-104. NC1054.2 +256400 PERFORM DE-LETE. NC1054.2 +256500 MOVE-WRITE-F1-104. NC1054.2 +256600 MOVE "MOVE-TEST-F1-104" TO PAR-NAME. NC1054.2 +256700 PERFORM PRINT-DETAIL. NC1054.2 +256800 MOVE-INIT-F1-105. NC1054.2 +256900 MOVE 832.553 TO WRK-CS-08V08. NC1054.2 +257000 MOVE-TEST-F1-105-0. NC1054.2 +257100 MOVE WRK-CS-08V08 TO WRK-EDIT-05V00. NC1054.2 +257200 MOVE-TEST-F1-105-1. NC1054.2 +257300 IF WRK-EDIT-05V00 EQUAL TO "**832" NC1054.2 +257400 PERFORM PASS NC1054.2 +257500 GO TO MOVE-WRITE-F1-105. NC1054.2 +257600 MOVE "**832" TO CORRECT-A. NC1054.2 +257700 MOVE WRK-EDIT-05V00 TO COMPUTED-A. NC1054.2 +257800 PERFORM FAIL. NC1054.2 +257900 GO TO MOVE-WRITE-F1-105. NC1054.2 +258000 MOVE-DELETE-F1-105. NC1054.2 +258100 PERFORM DE-LETE. NC1054.2 +258200 MOVE-WRITE-F1-105. NC1054.2 +258300 MOVE "MOVE-TEST-F1-105" TO PAR-NAME. NC1054.2 +258400 PERFORM PRINT-DETAIL. NC1054.2 +258500 MOVE-INIT-F1-106. NC1054.2 +258600 MOVE 6382.47 TO WRK-CS-04V08. NC1054.2 +258700 MOVE-TEST-F1-106-0. NC1054.2 +258800 MOVE WRK-CS-04V08 TO WRK-EDIT-05V02. NC1054.2 +258900 MOVE-TEST-F1-106-1. NC1054.2 +259000 IF WRK-EDIT-05V02 EQUAL TO " 06382.47" NC1054.2 +259100 PERFORM PASS NC1054.2 +259200 GO TO MOVE-WRITE-F1-106. NC1054.2 +259300 MOVE WRK-EDIT-05V02 TO COMPUTED-A. NC1054.2 +259400 MOVE " 06382.47" TO CORRECT-A. NC1054.2 +259500 PERFORM FAIL. NC1054.2 +259600 GO TO MOVE-WRITE-F1-106. NC1054.2 +259700 MOVE-DELETE-F1-106. NC1054.2 +259800 PERFORM DE-LETE. NC1054.2 +259900 MOVE-WRITE-F1-106. NC1054.2 +260000 MOVE "MOVE-TEST-F1-106" TO PAR-NAME. NC1054.2 +260100 PERFORM PRINT-DETAIL. NC1054.2 +260200 MOVE-INIT-F1-107. NC1054.2 +260300 MOVE ZERO TO WRK-CS-18V00. NC1054.2 +260400 MOVE-TEST-F1-107-0. NC1054.2 +260500 MOVE WRK-CS-18V00 TO WRK-EDIT-18V00. NC1054.2 +260600 MOVE-TEST-F1-107-1. NC1054.2 +260700 IF WRK-EDIT-18V00 EQUAL TO " 0" NC1054.2 +260800 PERFORM PASS NC1054.2 +260900 GO TO MOVE-WRITE-F1-107. NC1054.2 +261000 MOVE " 0" TO CORRECT-A. NC1054.2 +261100 MOVE WRK-EDIT-18V00 TO COMPUTED-A. NC1054.2 +261200 PERFORM FAIL. NC1054.2 +261300 GO TO MOVE-WRITE-F1-107. NC1054.2 +261400 MOVE-DELETE-F1-107. NC1054.2 +261500 PERFORM DE-LETE. NC1054.2 +261600 MOVE-WRITE-F1-107. NC1054.2 +261700 MOVE "MOVE-TEST-F1-107" TO PAR-NAME. NC1054.2 +261800 PERFORM PRINT-DETAIL. NC1054.2 +261900 MOVE-INIT-F1-108. NC1054.2 +262000 MOVE "MOVE (DISPLAY/COMP)" TO FEATURE. NC1054.2 +262100 MOVE 15 TO WRK-DS-10V00. NC1054.2 +262200 MOVE-TEST-F1-108-0. NC1054.2 +262300 MOVE WRK-DS-10V00 TO WRK-CS-01V00. NC1054.2 +262400 MOVE-TEST-F1-108-1. NC1054.2 +262500 IF WRK-CS-01V00 EQUAL TO 5 NC1054.2 +262600 PERFORM PASS NC1054.2 +262700 GO TO MOVE-WRITE-F1-108. NC1054.2 +262800 MOVE 5 TO CORRECT-N. NC1054.2 +262900 MOVE WRK-CS-01V00 TO COMPUTED-N. NC1054.2 +263000 PERFORM FAIL. NC1054.2 +263100 GO TO MOVE-WRITE-F1-108. NC1054.2 +263200 MOVE-DELETE-F1-108. NC1054.2 +263300 PERFORM DE-LETE. NC1054.2 +263400 MOVE-WRITE-F1-108. NC1054.2 +263500 MOVE "MOVE-TEST-F1-108" TO PAR-NAME. NC1054.2 +263600 PERFORM PRINT-DETAIL. NC1054.2 +263700 MOVE-INIT-F1-109. NC1054.2 +263800 MOVE 1023 TO WRK-DS-10V00. NC1054.2 +263900 MOVE-TEST-F1-109-0. NC1054.2 +264000 MOVE WRK-DS-10V00 TO WRK-CS-03V00. NC1054.2 +264100 MOVE-TEST-F1-109-1. NC1054.2 +264200 IF WRK-CS-03V00 EQUAL TO 023 NC1054.2 +264300 PERFORM PASS NC1054.2 +264400 GO TO MOVE-WRITE-F1-109. NC1054.2 +264500 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1054.2 +264600 MOVE 023 TO CORRECT-N. NC1054.2 +264700 PERFORM FAIL. NC1054.2 +264800 GO TO MOVE-WRITE-F1-109. NC1054.2 +264900 MOVE-DELETE-F1-109. NC1054.2 +265000 PERFORM DE-LETE. NC1054.2 +265100 MOVE-WRITE-F1-109. NC1054.2 +265200 MOVE "MOVE-TEST-F1-109" TO PAR-NAME. NC1054.2 +265300 PERFORM PRINT-DETAIL. NC1054.2 +265400 MOVE-INIT-F1-110. NC1054.2 +265500 MOVE SPACE TO MOVE71. NC1054.2 +265600 MOVE-TEST-F1-110-0. NC1054.2 +265700 MOVE 00000 TO MOVE71. NC1054.2 +265800 MOVE-TEST-F1-110-1. NC1054.2 +265900 IF MOVE71 EQUAL TO "00000 " NC1054.2 +266000 PERFORM PASS GO TO MOVE-WRITE-F1-110. NC1054.2 +266100 GO TO MOVE-FAIL-F1-110. NC1054.2 +266200 MOVE-DELETE-F1-110. NC1054.2 +266300 PERFORM DE-LETE. NC1054.2 +266400 GO TO MOVE-WRITE-F1-110. NC1054.2 +266500 MOVE-FAIL-F1-110. NC1054.2 +266600 PERFORM FAIL. NC1054.2 +266700 MOVE MOVE71 TO COMPUTED-A. NC1054.2 +266800 MOVE "00000 " TO CORRECT-A. NC1054.2 +266900 MOVE-WRITE-F1-110. NC1054.2 +267000 MOVE "MOVE NUMERIC" TO FEATURE. NC1054.2 +267100 MOVE "MOVE-TEST-F1-110" TO PAR-NAME. NC1054.2 +267200 PERFORM PRINT-DETAIL. NC1054.2 +267300 MOVE-INIT-F1-111. NC1054.2 +267400 MOVE 234565432.1 TO MOVE74. NC1054.2 +267500 MOVE-TEST-F1-111-0. NC1054.2 +267600 MOVE MOVE74 TO MOVE75. NC1054.2 +267700 MOVE-TEST-F1-111. NC1054.2 +267800 IF MOVE75 EQUAL TO 234565432 NC1054.2 +267900 PERFORM PASS GO TO MOVE-WRITE-F1-111. NC1054.2 +268000 GO TO MOVE-FAIL-F1-111. NC1054.2 +268100 MOVE-DELETE-F1-111. NC1054.2 +268200 PERFORM DE-LETE. NC1054.2 +268300 GO TO MOVE-WRITE-F1-111. NC1054.2 +268400 MOVE-FAIL-F1-111. NC1054.2 +268500 MOVE MOVE75 TO COMPUTED-N. NC1054.2 +268600 MOVE 234565432 TO CORRECT-N. NC1054.2 +268700 PERFORM FAIL. NC1054.2 +268800 MOVE-WRITE-F1-111. NC1054.2 +268900 MOVE "MOVE -- COMP, SYNC" TO FEATURE. NC1054.2 +269000 MOVE "MOVE-TEST-F1-111" TO PAR-NAME. NC1054.2 +269100 PERFORM PRINT-DETAIL. NC1054.2 +269200 MOVE-INIT-F1-112. NC1054.2 +269300 MOVE "MOVE TO COMP (ABS)" TO FEATURE. NC1054.2 +269400 MOVE +60666 TO SPOS-LIT1. NC1054.2 +269500 MOVE-TEST-F1-112-0. NC1054.2 +269600 MOVE SPOS-LIT1 TO CU-05V00-001. NC1054.2 +269700 MOVE-TEST-F1-112-1. NC1054.2 +269800 IF CU-05V00-001 EQUAL TO 60666 NC1054.2 +269900 PERFORM PASS NC1054.2 +270000 GO TO MOVE-WRITE-F1-112. NC1054.2 +270100 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +270200 MOVE 60666 TO CORRECT-18V0. NC1054.2 +270300 PERFORM FAIL. NC1054.2 +270400 GO TO MOVE-WRITE-F1-112. NC1054.2 +270500 MOVE-DELETE-F1-112. NC1054.2 +270600 PERFORM DE-LETE. NC1054.2 +270700 MOVE-WRITE-F1-112. NC1054.2 +270800 MOVE "MOVE-TEST-F1-112" TO PAR-NAME. NC1054.2 +270900 PERFORM PRINT-DETAIL. NC1054.2 +271000 MOVE-INIT-F1-113. NC1054.2 +271100 MOVE +60667 TO SPOS-LIT2. NC1054.2 +271200 MOVE-TEST-F1-113-0. NC1054.2 +271300 MOVE SPOS-LIT2 TO CU-05V00-001. NC1054.2 +271400 MOVE-TEST-F1-113-1. NC1054.2 +271500 IF CU-05V00-001 EQUAL TO 60667 NC1054.2 +271600 PERFORM PASS NC1054.2 +271700 GO TO MOVE-WRITE-F1-113. NC1054.2 +271800 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +271900 MOVE 60667 TO CORRECT-18V0. NC1054.2 +272000 PERFORM FAIL. NC1054.2 +272100 GO TO MOVE-WRITE-F1-113. NC1054.2 +272200 MOVE-DELETE-F1-113. NC1054.2 +272300 PERFORM DE-LETE. NC1054.2 +272400 MOVE-WRITE-F1-113. NC1054.2 +272500 MOVE "MOVE-TEST-F1-113" TO PAR-NAME. NC1054.2 +272600 PERFORM PRINT-DETAIL. NC1054.2 +272700 MOVE-TEST-F1-114. NC1054.2 +272800 MOVE SNEG-LIT1 TO CU-05V00-001. NC1054.2 +272900 IF CU-05V00-001 EQUAL TO 70717 NC1054.2 +273000 PERFORM PASS NC1054.2 +273100 GO TO MOVE-WRITE-F1-114. NC1054.2 +273200 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +273300 MOVE 70717 TO CORRECT-18V0. NC1054.2 +273400 PERFORM FAIL. NC1054.2 +273500 GO TO MOVE-WRITE-F1-114. NC1054.2 +273600 MOVE-DELETE-F1-114. NC1054.2 +273700 PERFORM DE-LETE. NC1054.2 +273800 MOVE-WRITE-F1-114. NC1054.2 +273900 MOVE "MOVE-TEST-F1-114" TO PAR-NAME. NC1054.2 +274000 PERFORM PRINT-DETAIL. NC1054.2 +274100 MOVE-INIT-F1-115. NC1054.2 +274200 MOVE -70718 TO SNEG-LIT2. NC1054.2 +274300 MOVE-TEST-F1-115-0. NC1054.2 +274400 MOVE SNEG-LIT2 TO CU-05V00-001. NC1054.2 +274500 MOVE-TEST-F1-115. NC1054.2 +274600 IF CU-05V00-001 EQUAL TO 70718 NC1054.2 +274700 PERFORM PASS NC1054.2 +274800 GO TO MOVE-WRITE-F1-115. NC1054.2 +274900 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +275000 MOVE 70718 TO CORRECT-18V0. NC1054.2 +275100 PERFORM FAIL. NC1054.2 +275200 GO TO MOVE-WRITE-F1-115. NC1054.2 +275300 MOVE-DELETE-F1-115. NC1054.2 +275400 PERFORM DE-LETE. NC1054.2 +275500 MOVE-WRITE-F1-115. NC1054.2 +275600 MOVE "MOVE-TEST-F1-115" TO PAR-NAME. NC1054.2 +275700 PERFORM PRINT-DETAIL. NC1054.2 +275800 MOVE-INIT-F1-116. NC1054.2 +275900 MOVE +60666 TO SPOS-LIT1. NC1054.2 +276000 MOVE-TEST-F1-116-0. NC1054.2 +276100 MOVE SPOS-LIT1 TO CS-05V00-001. NC1054.2 +276200 MOVE-TEST-F1-116-1. NC1054.2 +276300 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +276400 IF CU-05V00-001 EQUAL TO 60666 NC1054.2 +276500 PERFORM PASS NC1054.2 +276600 GO TO MOVE-WRITE-F1-116. NC1054.2 +276700 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +276800 MOVE 60666 TO CORRECT-18V0. NC1054.2 +276900 PERFORM FAIL. NC1054.2 +277000 GO TO MOVE-WRITE-F1-116. NC1054.2 +277100 MOVE-DELETE-F1-116. NC1054.2 +277200 PERFORM DE-LETE. NC1054.2 +277300 MOVE-WRITE-F1-116. NC1054.2 +277400 MOVE "MOVE-TEST-F1-116" TO PAR-NAME. NC1054.2 +277500 PERFORM PRINT-DETAIL. NC1054.2 +277600 MOVE-INIT-F1-117. NC1054.2 +277700 MOVE +60667 TO SPOS-LIT2. NC1054.2 +277800 MOVE-TEST-F1-117-0. NC1054.2 +277900 MOVE SPOS-LIT2 TO CS-05V00-001. NC1054.2 +278000 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +278100 MOVE-TEST-F1-117-1. NC1054.2 +278200 IF CU-05V00-001 EQUAL TO 60667 NC1054.2 +278300 PERFORM PASS NC1054.2 +278400 GO TO MOVE-WRITE-F1-117. NC1054.2 +278500 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +278600 MOVE 60667 TO CORRECT-18V0. NC1054.2 +278700 PERFORM FAIL. NC1054.2 +278800 GO TO MOVE-WRITE-F1-117. NC1054.2 +278900 MOVE-DELETE-F1-117. NC1054.2 +279000 PERFORM DE-LETE. NC1054.2 +279100 MOVE-WRITE-F1-117. NC1054.2 +279200 MOVE "MOVE-TEST-F1-117" TO PAR-NAME. NC1054.2 +279300 PERFORM PRINT-DETAIL. NC1054.2 +279400 MOVE-INIT-F1-118. NC1054.2 +279500 MOVE -70717 TO SNEG-LIT1. NC1054.2 +279600 MOVE-TEST-F1-118-0. NC1054.2 +279700 MOVE SNEG-LIT1 TO CS-05V00-001. NC1054.2 +279800 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +279900 MOVE-TEST-F1-118-1. NC1054.2 +280000 IF CU-05V00-001 EQUAL TO 70717 NC1054.2 +280100 PERFORM PASS NC1054.2 +280200 GO TO MOVE-WRITE-F1-118. NC1054.2 +280300 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +280400 MOVE 70717 TO CORRECT-18V0. NC1054.2 +280500 PERFORM FAIL. NC1054.2 +280600 GO TO MOVE-WRITE-F1-118. NC1054.2 +280700 MOVE-DELETE-F1-118. NC1054.2 +280800 PERFORM DE-LETE. NC1054.2 +280900 MOVE-WRITE-F1-118. NC1054.2 +281000 MOVE "MOVE-TEST-F1-118" TO PAR-NAME. NC1054.2 +281100 PERFORM PRINT-DETAIL. NC1054.2 +281200 MOVE-INIT-F1-119. NC1054.2 +281300 MOVE -70718 TO SNEG-LIT2. NC1054.2 +281400 MOVE-TEST-F1-119-0. NC1054.2 +281500 MOVE SNEG-LIT2 TO CS-05V00-001. NC1054.2 +281600 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +281700 MOVE-TEST-F1-119-1. NC1054.2 +281800 IF CU-05V00-001 EQUAL TO 70718 NC1054.2 +281900 PERFORM PASS NC1054.2 +282000 GO TO MOVE-WRITE-F1-119. NC1054.2 +282100 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +282200 MOVE 70718 TO CORRECT-18V0. NC1054.2 +282300 PERFORM FAIL. NC1054.2 +282400 GO TO MOVE-WRITE-F1-119. NC1054.2 +282500 MOVE-DELETE-F1-119. NC1054.2 +282600 PERFORM DE-LETE. NC1054.2 +282700 MOVE-WRITE-F1-119. NC1054.2 +282800 MOVE "MOVE-TEST-F1-119" TO PAR-NAME. NC1054.2 +282900 PERFORM PRINT-DETAIL. NC1054.2 +283000* NC1054.2 +283100* MOVE-TEST-176 THROUGH MOVE-TEST-178 CONTAIN MOVE NC1054.2 +283200* STATEMENTS OF THE FORM NC1054.2 +283300* MOVE ALL LITERAL TO NUMERIC DATA ITEM. NC1054.2 +283400* NC1054.2 +283500* REFERENCES IN X3.23-1974 NC1054.2 +283600* PAGE I-85, 5.3.2.2.2.3(1) NC1054.2 +283700* PAGE II-76, 5.15.4(4)B.3 NC1054.2 +283800* NC1054.2 +283900*MOVE-TEST-176. NC1054.2 +284000* MOVE ZERO TO MOVE5. NC1054.2 +284100* MOVE ALL "123" TO MOVE5. NC1054.2 +284200* IF MOVE5 EQUAL TO 12 NC1054.2 +284300* PERFORM PASS NC1054.2 +284400* GO TO MOVE-WRITE-176 NC1054.2 +284500* ELSE GO TO MOVE-FAIL-176. NC1054.2 +284600 MOVE-DELETE-176. NC1054.2 +284700 PERFORM DE-LETE. NC1054.2 +284800 GO TO MOVE-WRITE-176. NC1054.2 +284900 MOVE-FAIL-176. NC1054.2 +285000 PERFORM FAIL. NC1054.2 +285100 MOVE 12 TO CORRECT-N. NC1054.2 +285200 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +285300 MOVE-WRITE-176. NC1054.2 +285400 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +285500 MOVE "MOVE-TEST-176" TO PAR-NAME. NC1054.2 +285600 PERFORM PRINT-DETAIL. NC1054.2 +285700*MOVE-TEST-177. NC1054.2 +285800* MOVE ZERO TO MOVE5. NC1054.2 +285900* MOVE ALL "ABC123" TO MOVE5. NC1054.2 +286000* IF MOVE5 EQUAL TO 23 NC1054.2 +286100* PERFORM PASS NC1054.2 +286200* GO TO MOVE-WRITE-177 NC1054.2 +286300* ELSE GO TO MOVE-FAIL-177. NC1054.2 +286400 MOVE-DELETE-177. NC1054.2 +286500 PERFORM DE-LETE. NC1054.2 +286600 GO TO MOVE-WRITE-177. NC1054.2 +286700 MOVE-FAIL-177. NC1054.2 +286800 PERFORM FAIL. NC1054.2 +286900 MOVE 23 TO CORRECT-N. NC1054.2 +287000 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +287100 MOVE-WRITE-177. NC1054.2 +287200 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +287300 MOVE "MOVE-TEST-177" TO PAR-NAME. NC1054.2 +287400 PERFORM PRINT-DETAIL. NC1054.2 +287500*MOVE-TEST-178. NC1054.2 +287600* MOVE ZERO TO MOVE7. NC1054.2 +287700* MOVE ALL "2A" TO MOVE7. NC1054.2 +287800* IF MOVE7 EQUAL TO 2 NC1054.2 +287900* PERFORM PASS NC1054.2 +288000* GO TO MOVE-WRITE-178 NC1054.2 +288100* ELSE GO TO MOVE-FAIL-178. NC1054.2 +288200 MOVE-DELETE-178. NC1054.2 +288300 PERFORM DE-LETE. NC1054.2 +288400 GO TO MOVE-WRITE-178. NC1054.2 +288500 MOVE-FAIL-178. NC1054.2 +288600 PERFORM FAIL. NC1054.2 +288700 MOVE 2 TO CORRECT-N. NC1054.2 +288800 MOVE MOVE7 TO COMPUTED-N. NC1054.2 +288900 MOVE-WRITE-178. NC1054.2 +289000 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +289100 MOVE "MOVE-TEST-178" TO PAR-NAME. NC1054.2 +289200 PERFORM PRINT-DETAIL. NC1054.2 +289300 MOVE "EDIT--B(N), 0(N)" TO FEATURE. NC1054.2 +289400 EDIT-INIT-F1-120. NC1054.2 +289500 NC1054.2 +289600 EDIT-TEST-F1-120-0. NC1054.2 +289700 MOVE "926" TO EDIT-PICTURE-01. NC1054.2 +289800 EDIT-TEST-F1-120-1. NC1054.2 +289900 IF EDIT-PICTURE-01 EQUAL TO "9 26" NC1054.2 +290000 PERFORM PASS NC1054.2 +290100 GO TO EDIT-WRITE-F1-120. NC1054.2 +290200 PERFORM FAIL. NC1054.2 +290300 MOVE EDIT-PICTURE-01 TO COMPUTED-A. NC1054.2 +290400 MOVE "9 26" TO CORRECT-A. NC1054.2 +290500 GO TO EDIT-WRITE-F1-120. NC1054.2 +290600 EDIT-DELETE-F1-120. NC1054.2 +290700 PERFORM DE-LETE. NC1054.2 +290800 EDIT-WRITE-F1-120. NC1054.2 +290900 MOVE "EDIT-TEST-F1-120" TO PAR-NAME. NC1054.2 +291000 PERFORM PRINT-DETAIL. NC1054.2 +291100 EDIT-INIT-F1-121. NC1054.2 +291200 NC1054.2 +291300 EDIT-TEST-F1-121-0. NC1054.2 +291400 MOVE "1492" TO EDIT-PICTURE-02. NC1054.2 +291500 EDIT-TEST-F1-121-1. NC1054.2 +291600 IF EDIT-PICTURE-02 EQUAL TO "$0000000000492" NC1054.2 +291700 PERFORM PASS NC1054.2 +291800 GO TO EDIT-WRITE-F1-121. NC1054.2 +291900 PERFORM FAIL. NC1054.2 +292000 MOVE EDIT-PICTURE-02 TO COMPUTED-A. NC1054.2 +292100 MOVE "$0000000000492" TO CORRECT-A. NC1054.2 +292200 GO TO EDIT-WRITE-F1-121. NC1054.2 +292300 EDIT-DELETE-F1-121. NC1054.2 +292400 PERFORM DE-LETE. NC1054.2 +292500 EDIT-WRITE-F1-121. NC1054.2 +292600 MOVE "EDIT-TEST-F1-121" TO PAR-NAME. NC1054.2 +292700 PERFORM PRINT-DETAIL. NC1054.2 +292800 EDIT-INIT-F1-122. NC1054.2 +292900 MOVE 333 TO EDIT-DATA-1. NC1054.2 +293000 EDIT-TEST-F1-122-0. NC1054.2 +293100 MOVE EDIT-DATA-1 TO EDIT-PICTURE-01. NC1054.2 +293200 EDIT-TEST-F1-122-1. NC1054.2 +293300 IF EDIT-PICTURE-01 EQUAL TO "3 33" NC1054.2 +293400 PERFORM PASS NC1054.2 +293500 GO TO EDIT-WRITE-F1-122. NC1054.2 +293600 PERFORM FAIL. NC1054.2 +293700 MOVE EDIT-PICTURE-01 TO COMPUTED-A. NC1054.2 +293800 MOVE "3 33" TO CORRECT-A. NC1054.2 +293900 GO TO EDIT-WRITE-F1-122. NC1054.2 +294000 EDIT-DELETE-F1-122. NC1054.2 +294100 PERFORM DE-LETE. NC1054.2 +294200 EDIT-WRITE-F1-122. NC1054.2 +294300 MOVE "EDIT-TEST-F1-122" TO PAR-NAME. NC1054.2 +294400 PERFORM PRINT-DETAIL. NC1054.2 +294500 EDIT-INIT-F1-123. NC1054.2 +294600 MOVE 916 TO EDIT-DATA-2. NC1054.2 +294700 EDIT-TEST-F1-123-0. NC1054.2 +294800 MOVE EDIT-DATA-2 TO EDIT-PICTURE-02. NC1054.2 +294900 EDIT-TEST-F1-123-1. NC1054.2 +295000 IF EDIT-PICTURE-02 EQUAL TO "$0000000000916" NC1054.2 +295100 PERFORM PASS NC1054.2 +295200 GO TO EDIT-WRITE-F1-123. NC1054.2 +295300 PERFORM FAIL. NC1054.2 +295400 MOVE EDIT-PICTURE-02 TO COMPUTED-A. NC1054.2 +295500 MOVE "$0000000000916 " TO CORRECT-A. NC1054.2 +295600 GO TO EDIT-WRITE-F1-123. NC1054.2 +295700 EDIT-DELETE-F1-123. NC1054.2 +295800 PERFORM DE-LETE. NC1054.2 +295900 EDIT-WRITE-F1-123. NC1054.2 +296000 MOVE "EDIT-TEST-F1-123" TO PAR-NAME. NC1054.2 +296100 PERFORM PRINT-DETAIL. NC1054.2 +296200 EDIT-INIT-F1-124. NC1054.2 +296300 MOVE "EDIT -- MASKED EDIT" TO FEATURE. NC1054.2 +296400 EDIT-TEST-F1-124-0. NC1054.2 +296500 MOVE 000987.65 TO EDIT-PIC-05. NC1054.2 +296600 EDIT-TEST-F1-124-1. NC1054.2 +296700 IF GRP-EDIT-PIC-05 EQUAL TO " $987.65" NC1054.2 +296800 PERFORM PASS NC1054.2 +296900 GO TO EDIT-WRITE-F1-124. NC1054.2 +297000 PERFORM FAIL. NC1054.2 +297100 MOVE EDIT-PIC-05 TO COMPUTED-A. NC1054.2 +297200 MOVE " $987.65" TO CORRECT-A. NC1054.2 +297300 GO TO EDIT-WRITE-F1-124. NC1054.2 +297400 EDIT-DELETE-F1-124. NC1054.2 +297500 PERFORM DE-LETE. NC1054.2 +297600 EDIT-WRITE-F1-124. NC1054.2 +297700 MOVE "EDIT-TEST-F1-124" TO PAR-NAME. NC1054.2 +297800 PERFORM PRINT-DETAIL. NC1054.2 +297900 EDIT-INIT-F1-125. NC1054.2 +298000* NC1054.2 +298100 EDIT-TEST-F1-125-0. NC1054.2 +298200 MOVE 000123.45 TO EDIT-PIC-06. NC1054.2 +298300 EDIT-TEST-F1-125-1. NC1054.2 +298400 IF GRP-EDIT-PIC-06 EQUAL TO " $123.45" NC1054.2 +298500 PERFORM PASS NC1054.2 +298600 GO TO EDIT-WRITE-F1-125. NC1054.2 +298700 PERFORM FAIL. NC1054.2 +298800 MOVE EDIT-PIC-06 TO COMPUTED-A. NC1054.2 +298900 MOVE " $123.45" TO CORRECT-A. NC1054.2 +299000 GO TO EDIT-WRITE-F1-125. NC1054.2 +299100 EDIT-DELETE-F1-125. NC1054.2 +299200 PERFORM DE-LETE. NC1054.2 +299300 EDIT-WRITE-F1-125. NC1054.2 +299400 MOVE "EDIT-TEST-F1-125" TO PAR-NAME. NC1054.2 +299500 PERFORM PRINT-DETAIL. NC1054.2 +299600 EDIT-INIT-F1-126. NC1054.2 +299700* NC1054.2 +299800 EDIT-TEST-F1-126-0. NC1054.2 +299900 MOVE 000321.01 TO EDIT-PIC-07. NC1054.2 +300000 EDIT-TEST-F1-126-1. NC1054.2 +300100 IF GRP-EDIT-PIC-07 EQUAL TO " +321.01" NC1054.2 +300200 PERFORM PASS NC1054.2 +300300 GO TO EDIT-WRITE-F1-126. NC1054.2 +300400 PERFORM FAIL. NC1054.2 +300500 MOVE EDIT-PIC-07 TO COMPUTED-A. NC1054.2 +300600 MOVE " +321.01" TO CORRECT-A. NC1054.2 +300700 GO TO EDIT-WRITE-F1-126. NC1054.2 +300800 EDIT-DELETE-F1-126. NC1054.2 +300900 PERFORM DE-LETE. NC1054.2 +301000 EDIT-WRITE-F1-126. NC1054.2 +301100 MOVE "EDIT-TEST-F1-126" TO PAR-NAME. NC1054.2 +301200 PERFORM PRINT-DETAIL. NC1054.2 +301300 EDIT-INIT-F1-127. NC1054.2 +301400* NC1054.2 +301500 EDIT-TEST-F1-127-0. NC1054.2 +301600 MOVE -0012.98 TO EDIT-PIC-08. NC1054.2 +301700 EDIT-TEST-F1-127-1. NC1054.2 +301800 IF GRP-EDIT-PIC-08 EQUAL TO " -012.98" NC1054.2 +301900 PERFORM PASS NC1054.2 +302000 GO TO EDIT-WRITE-F1-127. NC1054.2 +302100 PERFORM FAIL. NC1054.2 +302200 MOVE EDIT-PIC-08 TO COMPUTED-A. NC1054.2 +302300 MOVE " -012.98" TO CORRECT-A. NC1054.2 +302400 GO TO EDIT-WRITE-F1-127. NC1054.2 +302500 EDIT-DELETE-F1-127. NC1054.2 +302600 PERFORM DE-LETE. NC1054.2 +302700 EDIT-WRITE-F1-127. NC1054.2 +302800 MOVE "EDIT-TEST-F1-127" TO PAR-NAME. NC1054.2 +302900 PERFORM PRINT-DETAIL. NC1054.2 +303000 EDIT-INIT-F1-128. NC1054.2 +303100* NC1054.2 +303200 EDIT-TEST-F1-128-0. NC1054.2 +303300 MOVE 0000567.43 TO EDIT-PIC-09. NC1054.2 +303400 EDIT-TEST-F1-128-1. NC1054.2 +303500 IF GRP-EDIT-PIC-09 EQUAL TO "****567.43" NC1054.2 +303600 PERFORM PASS NC1054.2 +303700 GO TO EDIT-WRITE-F1-128. NC1054.2 +303800 PERFORM FAIL. NC1054.2 +303900 MOVE EDIT-PIC-09 TO COMPUTED-A. NC1054.2 +304000 MOVE "****567.43" TO CORRECT-A. NC1054.2 +304100 GO TO EDIT-WRITE-F1-128. NC1054.2 +304200 EDIT-DELETE-F1-128. NC1054.2 +304300 PERFORM DE-LETE. NC1054.2 +304400 EDIT-WRITE-F1-128. NC1054.2 +304500 MOVE "EDIT-TEST-F1-128" TO PAR-NAME. NC1054.2 +304600 PERFORM PRINT-DETAIL. NC1054.2 +304700 EDIT-INIT-F1-129. NC1054.2 +304800* NC1054.2 +304900 EDIT-TEST-F1-129-0. NC1054.2 +305000 MOVE ZERO TO EDIT-PIC-10. NC1054.2 +305100 EDIT-TEST-F1-129-1. NC1054.2 +305200 IF GRP-EDIT-PIC-10 EQUAL TO " 000.00" NC1054.2 +305300 PERFORM PASS NC1054.2 +305400 GO TO EDIT-WRITE-F1-129. NC1054.2 +305500 PERFORM FAIL. NC1054.2 +305600 MOVE EDIT-PIC-10 TO COMPUTED-A. NC1054.2 +305700 MOVE " 000.00" TO CORRECT-A. NC1054.2 +305800 GO TO EDIT-WRITE-F1-129. NC1054.2 +305900 EDIT-DELETE-F1-129. NC1054.2 +306000 PERFORM DE-LETE. NC1054.2 +306100 EDIT-WRITE-F1-129. NC1054.2 +306200 MOVE "EDIT-TEST-F1-129" TO PAR-NAME. NC1054.2 +306300 PERFORM PRINT-DETAIL. NC1054.2 +306400 GO TO CCVS-EXIT. NC1054.2 +306500 A20. NC1054.2 +306600 MOVE FIRST-20S TO CORRECT-A. NC1054.2 +306700 MOVE FIRST-20R TO COMPUTED-A. NC1054.2 +306800 MOVE "1ST 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +306900 MOVE TEST-RESULTS TO PRINT-REC. NC1054.2 +307000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. NC1054.2 +307100 SUBTRACT 20 FROM LENGTH-COUNTER. NC1054.2 +307200 A40. NC1054.2 +307300 MOVE SECOND-20S TO CORRECT-A. NC1054.2 +307400 MOVE SECOND-20R TO COMPUTED-A. NC1054.2 +307500 MOVE "2ND 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +307600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +307700 MOVE SPACE TO P-OR-F NC1054.2 +307800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +307900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +308000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +308100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +308200 A60. NC1054.2 +308300 MOVE THIRD-20S TO CORRECT-A. NC1054.2 +308400 MOVE THIRD-20R TO COMPUTED-A. NC1054.2 +308500 MOVE "3RD 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +308600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +308700 MOVE SPACE TO P-OR-F NC1054.2 +308800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +308900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +309000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +309100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +309200 A80. NC1054.2 +309300 MOVE FOURTH-20S TO CORRECT-A. NC1054.2 +309400 MOVE FOURTH-20R TO COMPUTED-A. NC1054.2 +309500 MOVE "4TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +309600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +309700 MOVE SPACE TO P-OR-F NC1054.2 +309800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +309900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +310000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +310100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +310200 A100. NC1054.2 +310300 MOVE FIFTH-20S TO CORRECT-A. NC1054.2 +310400 MOVE FIFTH-20R TO COMPUTED-A. NC1054.2 +310500 MOVE "5TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +310600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +310700 MOVE SPACE TO P-OR-F NC1054.2 +310800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +310900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. NC1054.2 +311000 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +311100 A120. NC1054.2 +311200 MOVE SIXTH-20S TO CORRECT-A. NC1054.2 +311300 MOVE SIXTH-20R TO COMPUTED-A. NC1054.2 +311400 MOVE "6TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +311500 CCVS-EXIT SECTION. NC1054.2 +311600 CCVS-999999. NC1054.2 +311700 GO TO CLOSE-FILES. NC1054.2 +*END-OF,NC105A +*HEADER,COBOL,NC106A +000100 IDENTIFICATION DIVISION. NC1064.2 +000200 PROGRAM-ID. NC1064.2 +000300 NC106A. NC1064.2 +000400**************************************************************** NC1064.2 +000500* * NC1064.2 +000600* VALIDATION FOR:- * NC1064.2 +000700* * NC1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +000900* * NC1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1064.2 +001100* * NC1064.2 +001200**************************************************************** NC1064.2 +001300* * NC1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1064.2 +001500* * NC1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1064.2 +001900* * NC1064.2 +002000**************************************************************** NC1064.2 +002100* NC1064.2 +002200* PROGRAM NC106A TESTS FORMAT 1 OF THE SUBTRACT NC1064.2 +002300* STATEMENT. VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1064.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1064.2 +002500* NC1064.2 +002600 NC1064.2 +002700 ENVIRONMENT DIVISION. NC1064.2 +002800 CONFIGURATION SECTION. NC1064.2 +002900 SOURCE-COMPUTER. NC1064.2 +003000 XXXXX082. NC1064.2 +003100 OBJECT-COMPUTER. NC1064.2 +003200 XXXXX083. NC1064.2 +003300 INPUT-OUTPUT SECTION. NC1064.2 +003400 FILE-CONTROL. NC1064.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1064.2 +003600 XXXXX055. NC1064.2 +003700 DATA DIVISION. NC1064.2 +003800 FILE SECTION. NC1064.2 +003900 FD PRINT-FILE. NC1064.2 +004000 01 PRINT-REC PICTURE X(120). NC1064.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1064.2 +004200 WORKING-STORAGE SECTION. NC1064.2 +004300 01 WRK-NE-X-1 PIC 9(16).99. NC1064.2 +004400 01 WRK-NE-X-2 PIC -9(16).99. NC1064.2 +004500 01 WRK-XN-00001 PIC X. NC1064.2 +004600 01 WRK-XN-18-1 PIC X(18). NC1064.2 +004700 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1064.2 +004800 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1064.2 +004900 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1064.2 +005000 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1064.2 +005100 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1064.2 +005200 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1064.2 +005300 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1064.2 +005400 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1064.2 +005500 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1064.2 +005600 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1064.2 +005700 01 WRK-DU-1V5-1 PIC 9V9(5). NC1064.2 +005800 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1064.2 +005900 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1064.2 +006000 01 WRK-DU-2V0-1 PIC 99. NC1064.2 +006100 01 WRK-DU-2V0-2 PIC 99. NC1064.2 +006200 01 WRK-DU-2V0-3 PIC 99. NC1064.2 +006300 01 WRK-DU-2V1-1 PIC 99V9. NC1064.2 +006400 01 WRK-DU-2V1-2 PIC 99V9. NC1064.2 +006500 01 WRK-DU-2V1-3 PIC 99V9. NC1064.2 +006600 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1064.2 +006700 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1064.2 +006800 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1064.2 +006900 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1064.2 +007000 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1064.2 +007100 01 WRK-DU-2V5-1 PIC 99V9(5). NC1064.2 +007200 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1064.2 +007300 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1064.2 +007400 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1064.2 +007500 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1064.2 +007600 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1064.2 +007700 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1064.2 +007800 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1064.2 +007900 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1064.2 +008000 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1064.2 +008100 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1064.2 +008200 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1064.2 +008300 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1064.2 +008400 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1064.2 +008500 01 42-DATANAMES. NC1064.2 +008600 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1064.2 +008700 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC1064.2 +008800 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC1064.2 +008900 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC1064.2 +009000 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC1064.2 +009100 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC1064.2 +009200 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC1064.2 +009300 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC1064.2 +009400 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC1064.2 +009500 02 DNAME10 PICTURE 9(10) VALUE 1. NC1064.2 +009600 02 DNAME11 PICTURE 9(11) VALUE 1. NC1064.2 +009700 02 DNAME12 PICTURE 9(12) VALUE 1. NC1064.2 +009800 02 DNAME13 PICTURE 9(13) VALUE 1. NC1064.2 +009900 02 DNAME14 PICTURE 9(14) VALUE 1. NC1064.2 +010000 02 DNAME15 PICTURE 9(15) VALUE 1. NC1064.2 +010100 02 DNAME16 PICTURE 9(16) VALUE 1. NC1064.2 +010200 02 DNAME17 PICTURE 9(17) VALUE 1. NC1064.2 +010300 02 DNAME18 PICTURE 9(18) VALUE 1. NC1064.2 +010400 02 DNAME19 PICTURE 9 VALUE 1. NC1064.2 +010500 02 DNAME20 PICTURE 99 VALUE 1. NC1064.2 +010600 02 DNAME21 PICTURE 999 VALUE 1. NC1064.2 +010700 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1064.2 +010800 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1064.2 +010900 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1064.2 +011000 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1064.2 +011100 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1064.2 +011200 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1064.2 +011300 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1064.2 +011400 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1064.2 +011500 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011600 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011700 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011800 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011900 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012000 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012100 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012200 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012300 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012400 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012500 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012600 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012700 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012800 77 SIZE-ERR PICTURE X VALUE SPACE. NC1064.2 +012900 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1064.2 +013000 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1064.2 +013100 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1064.2 +013200 77 A18TWOS-DS-18V00 PICTURE S9(18) NC1064.2 +013300 VALUE 222222222222222222. NC1064.2 +013400 77 A18ONES-DS-18V00 PICTURE S9(18) NC1064.2 +013500 VALUE 111111111111111111. NC1064.2 +013600 77 WRK-DS-10V00 PICTURE S9(10). NC1064.2 +013700 77 A10ONES-DS-10V00 PICTURE S9(10) NC1064.2 +013800 VALUE 1111111111. NC1064.2 +013900 77 A05ONES-DS-05V00 PICTURE S9(5) NC1064.2 +014000 VALUE 11111. NC1064.2 +014100 77 A02ONES-DS-02V00 PICTURE S99 NC1064.2 +014200 VALUE 11. NC1064.2 +014300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1064.2 +014400 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1064.2 +014500 PICTURE S9(18). NC1064.2 +014600 77 A06THREES-DS-03V03 PICTURE S999V999 NC1064.2 +014700 VALUE 333.333. NC1064.2 +014800 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1064.2 +014900 VALUE 333333.333333. NC1064.2 +015000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1064.2 +015100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1064.2 +015200 PICTURE S9(12). NC1064.2 +015300 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1064.2 +015400 VALUE .11111. NC1064.2 +015500 77 WRK-DS-05V00 PICTURE S9(5). NC1064.2 +015600 77 WRK-DS-02V00 PICTURE S99. NC1064.2 +015700 77 A12ONES-DS-12V00 PICTURE S9(12) NC1064.2 +015800 VALUE 111111111111. NC1064.2 +015900 77 WRK-DS-03V10 PICTURE S999V9(10). NC1064.2 +016000 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1064.2 +016100 PICTURE S9(13). NC1064.2 +016200 77 A99-DS-02V00 PICTURE S99 NC1064.2 +016300 VALUE 99. NC1064.2 +016400 77 A03ONES-DS-02V01 PICTURE S99V9 NC1064.2 +016500 VALUE 11.1. NC1064.2 +016600 77 A06ONES-DS-03V03 PICTURE S999V999 NC1064.2 +016700 VALUE 111.111. NC1064.2 +016800 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1064.2 +016900 VALUE 22.222222. NC1064.2 +017000 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1064.2 +017100 VALUE .000000001. NC1064.2 +017200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1064.2 +017300 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1064.2 +017400 VALUE 111111111111111111. NC1064.2 +017500 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1064.2 +017600 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1064.2 +017700 VALUE 99. NC1064.2 +017800 77 WRK-DS-0201P PICTURE S99P. NC1064.2 +017900 77 WRK-DS-06V00 PICTURE S9(6). NC1064.2 +018000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1064.2 +018100 VALUE ZERO. NC1064.2 +018200 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1064.2 +018300 VALUE +012345678.876543210. NC1064.2 +018400 77 XDATA-XN-00018 PICTURE X(18) NC1064.2 +018500 VALUE "00ABCDEFGHI 4321 ". NC1064.2 +018600 77 WRK-XN-00018 PICTURE X(18). NC1064.2 +018700 77 ADD-12 PICTURE PP9 VALUE .001. NC1064.2 +018800 77 ADD-13 PICTURE 9PP VALUE 100. NC1064.2 +018900 77 ADD-14 PICTURE 999V999. NC1064.2 +019000 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +019100 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1064.2 +019200 COMPUTATIONAL. NC1064.2 +019300 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1064.2 +019400 COMPUTATIONAL. NC1064.2 +019500 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1064.2 +019600 COMPUTATIONAL. NC1064.2 +019700 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1064.2 +019800 COMPUTATIONAL. NC1064.2 +019900 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1064.2 +020000 COMPUTATIONAL. NC1064.2 +020100 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1064.2 +020200 COMPUTATIONAL. NC1064.2 +020300 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1064.2 +020400 COMPUTATIONAL. NC1064.2 +020500 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1064.2 +020600 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1064.2 +020700 COMPUTATIONAL. NC1064.2 +020800 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1064.2 +020900 01 SUBTRACT-DATA. NC1064.2 +021000 02 SUBTR-1 PICTURE 9 VALUE 1. NC1064.2 +021100 02 SUBTR-2 PICTURE S99 VALUE 99. NC1064.2 +021200 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1064.2 +021300 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1064.2 +021400 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1064.2 +021500 02 SUBTR-6 PICTURE 9 VALUE 1. NC1064.2 +021600 02 SUBTR-7 PICTURE S99 VALUE 99. NC1064.2 +021700 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1064.2 +021800 02 SUBTR-10 PICTURE S999 VALUE 100. NC1064.2 +021900 02 SUBTR-11 PICTURE S999V999. NC1064.2 +022000 01 N-3 PICTURE IS 99999. NC1064.2 +022100 01 N-4 PICTURE IS 9(5) NC1064.2 +022200 VALUE IS 52800. NC1064.2 +022300 01 N-5 PICTURE IS S9(9)V99 NC1064.2 +022400 VALUE IS 000000001.00. NC1064.2 +022500 01 N-7 PICTURE IS S9(7)V9(4) NC1064.2 +022600 VALUE IS 0000001.0000. NC1064.2 +022700 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1064.2 +022800 01 N-10 PICTURE IS S99999V NC1064.2 +022900 VALUE IS -00001. NC1064.2 +023000 01 N-11 PICTURE IS 9 VALUE IS 9. NC1064.2 +023100 01 N-12 PICTURE IS 9 VALUE IS 9. NC1064.2 +023200 01 N-13 PICTURE IS 9(5) NC1064.2 +023300 VALUE IS 99999. NC1064.2 +023400 01 N-14 PICTURE IS 9 VALUE IS 1. NC1064.2 +023500 01 N-15 PICTURE IS 9(16). NC1064.2 +023600 01 N-16 PICTURE IS S999999V99 NC1064.2 +023700 VALUE IS 5.90. NC1064.2 +023800 01 N-17 PICTURE IS S9(3)V99 NC1064.2 +023900 VALUE IS +3.6. NC1064.2 +024000 01 N-18 PICTURE IS S9(10) NC1064.2 +024100 VALUE IS -5. NC1064.2 +024200 01 N-19 PICTURE IS $9.00. NC1064.2 +024300 01 N-20 PICTURE IS S9(9) NC1064.2 +024400 VALUE IS -999999999. NC1064.2 +024500 01 N-21 PICTURE IS 9 VALUE IS 5. NC1064.2 +024600 01 N-22 PICTURE IS 999V99 NC1064.2 +024700 VALUE IS 005.55. NC1064.2 +024800 01 N-23 PICTURE IS $$$.99CR. NC1064.2 +024900 01 N-25 PICTURE IS 9 VALUE IS 1. NC1064.2 +025000 01 N-26 PICTURE 9(5). NC1064.2 +025100 01 N-27 PICTURE IS 9999V9 NC1064.2 +025200 VALUE IS 9999.9. NC1064.2 +025300 01 N-28 PICTURE IS $9999.00. NC1064.2 +025400 01 N-40 PICTURE IS 9(7) NC1064.2 +025500 VALUE IS 7777777. NC1064.2 +025600 01 N-41 PICTURE IS 9(7) NC1064.2 +025700 VALUE IS 1111111. NC1064.2 +025800 01 N-42 PICTURE IS 9(3)P(4). NC1064.2 +025900 01 TRUNC-DATA. NC1064.2 +026000 02 N-43 PICTURE S9V9 VALUE +1.6. NC1064.2 +026100 02 N-44 PICTURE S9V9 VALUE -1.6. NC1064.2 +026200 02 N-45 PICTURE S9. NC1064.2 +026300 01 MINUS-NAMES. NC1064.2 +026400 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1064.2 +026500 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1064.2 +026600 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1064.2 +026700 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1064.2 +026800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1064.2 +026900 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1064.2 +027000 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1064.2 +027100 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1064.2 +027200 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1064.2 +027300 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1064.2 +027400 02 WHOLE-FIELD PICTURE S9(18). NC1064.2 +027500 02 DECMAL-FIELD PICTURE SV9(18). NC1064.2 +027600 01 TEST-RESULTS. NC1064.2 +027700 02 FILLER PIC X VALUE SPACE. NC1064.2 +027800 02 FEATURE PIC X(20) VALUE SPACE. NC1064.2 +027900 02 FILLER PIC X VALUE SPACE. NC1064.2 +028000 02 P-OR-F PIC X(5) VALUE SPACE. NC1064.2 +028100 02 FILLER PIC X VALUE SPACE. NC1064.2 +028200 02 PAR-NAME. NC1064.2 +028300 03 FILLER PIC X(19) VALUE SPACE. NC1064.2 +028400 03 PARDOT-X PIC X VALUE SPACE. NC1064.2 +028500 03 DOTVALUE PIC 99 VALUE ZERO. NC1064.2 +028600 02 FILLER PIC X(8) VALUE SPACE. NC1064.2 +028700 02 RE-MARK PIC X(61). NC1064.2 +028800 01 TEST-COMPUTED. NC1064.2 +028900 02 FILLER PIC X(30) VALUE SPACE. NC1064.2 +029000 02 FILLER PIC X(17) VALUE NC1064.2 +029100 " COMPUTED=". NC1064.2 +029200 02 COMPUTED-X. NC1064.2 +029300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1064.2 +029400 03 COMPUTED-N REDEFINES COMPUTED-A NC1064.2 +029500 PIC -9(9).9(9). NC1064.2 +029600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1064.2 +029700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1064.2 +029800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1064.2 +029900 03 CM-18V0 REDEFINES COMPUTED-A. NC1064.2 +030000 04 COMPUTED-18V0 PIC -9(18). NC1064.2 +030100 04 FILLER PIC X. NC1064.2 +030200 03 FILLER PIC X(50) VALUE SPACE. NC1064.2 +030300 01 TEST-CORRECT. NC1064.2 +030400 02 FILLER PIC X(30) VALUE SPACE. NC1064.2 +030500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1064.2 +030600 02 CORRECT-X. NC1064.2 +030700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1064.2 +030800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1064.2 +030900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1064.2 +031000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1064.2 +031100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1064.2 +031200 03 CR-18V0 REDEFINES CORRECT-A. NC1064.2 +031300 04 CORRECT-18V0 PIC -9(18). NC1064.2 +031400 04 FILLER PIC X. NC1064.2 +031500 03 FILLER PIC X(2) VALUE SPACE. NC1064.2 +031600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1064.2 +031700 01 CCVS-C-1. NC1064.2 +031800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1064.2 +031900- "SS PARAGRAPH-NAME NC1064.2 +032000- " REMARKS". NC1064.2 +032100 02 FILLER PIC X(20) VALUE SPACE. NC1064.2 +032200 01 CCVS-C-2. NC1064.2 +032300 02 FILLER PIC X VALUE SPACE. NC1064.2 +032400 02 FILLER PIC X(6) VALUE "TESTED". NC1064.2 +032500 02 FILLER PIC X(15) VALUE SPACE. NC1064.2 +032600 02 FILLER PIC X(4) VALUE "FAIL". NC1064.2 +032700 02 FILLER PIC X(94) VALUE SPACE. NC1064.2 +032800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1064.2 +032900 01 REC-CT PIC 99 VALUE ZERO. NC1064.2 +033000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1064.2 +033500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1064.2 +033600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1064.2 +033700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1064.2 +033800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1064.2 +033900 01 CCVS-H-1. NC1064.2 +034000 02 FILLER PIC X(39) VALUE SPACES. NC1064.2 +034100 02 FILLER PIC X(42) VALUE NC1064.2 +034200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1064.2 +034300 02 FILLER PIC X(39) VALUE SPACES. NC1064.2 +034400 01 CCVS-H-2A. NC1064.2 +034500 02 FILLER PIC X(40) VALUE SPACE. NC1064.2 +034600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1064.2 +034700 02 FILLER PIC XXXX VALUE NC1064.2 +034800 "4.2 ". NC1064.2 +034900 02 FILLER PIC X(28) VALUE NC1064.2 +035000 " COPY - NOT FOR DISTRIBUTION". NC1064.2 +035100 02 FILLER PIC X(41) VALUE SPACE. NC1064.2 +035200 NC1064.2 +035300 01 CCVS-H-2B. NC1064.2 +035400 02 FILLER PIC X(15) VALUE NC1064.2 +035500 "TEST RESULT OF ". NC1064.2 +035600 02 TEST-ID PIC X(9). NC1064.2 +035700 02 FILLER PIC X(4) VALUE NC1064.2 +035800 " IN ". NC1064.2 +035900 02 FILLER PIC X(12) VALUE NC1064.2 +036000 " HIGH ". NC1064.2 +036100 02 FILLER PIC X(22) VALUE NC1064.2 +036200 " LEVEL VALIDATION FOR ". NC1064.2 +036300 02 FILLER PIC X(58) VALUE NC1064.2 +036400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +036500 01 CCVS-H-3. NC1064.2 +036600 02 FILLER PIC X(34) VALUE NC1064.2 +036700 " FOR OFFICIAL USE ONLY ". NC1064.2 +036800 02 FILLER PIC X(58) VALUE NC1064.2 +036900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1064.2 +037000 02 FILLER PIC X(28) VALUE NC1064.2 +037100 " COPYRIGHT 1985 ". NC1064.2 +037200 01 CCVS-E-1. NC1064.2 +037300 02 FILLER PIC X(52) VALUE SPACE. NC1064.2 +037400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1064.2 +037500 02 ID-AGAIN PIC X(9). NC1064.2 +037600 02 FILLER PIC X(45) VALUE SPACES. NC1064.2 +037700 01 CCVS-E-2. NC1064.2 +037800 02 FILLER PIC X(31) VALUE SPACE. NC1064.2 +037900 02 FILLER PIC X(21) VALUE SPACE. NC1064.2 +038000 02 CCVS-E-2-2. NC1064.2 +038100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1064.2 +038200 03 FILLER PIC X VALUE SPACE. NC1064.2 +038300 03 ENDER-DESC PIC X(44) VALUE NC1064.2 +038400 "ERRORS ENCOUNTERED". NC1064.2 +038500 01 CCVS-E-3. NC1064.2 +038600 02 FILLER PIC X(22) VALUE NC1064.2 +038700 " FOR OFFICIAL USE ONLY". NC1064.2 +038800 02 FILLER PIC X(12) VALUE SPACE. NC1064.2 +038900 02 FILLER PIC X(58) VALUE NC1064.2 +039000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +039100 02 FILLER PIC X(13) VALUE SPACE. NC1064.2 +039200 02 FILLER PIC X(15) VALUE NC1064.2 +039300 " COPYRIGHT 1985". NC1064.2 +039400 01 CCVS-E-4. NC1064.2 +039500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1064.2 +039600 02 FILLER PIC X(4) VALUE " OF ". NC1064.2 +039700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1064.2 +039800 02 FILLER PIC X(40) VALUE NC1064.2 +039900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1064.2 +040000 01 XXINFO. NC1064.2 +040100 02 FILLER PIC X(19) VALUE NC1064.2 +040200 "*** INFORMATION ***". NC1064.2 +040300 02 INFO-TEXT. NC1064.2 +040400 04 FILLER PIC X(8) VALUE SPACE. NC1064.2 +040500 04 XXCOMPUTED PIC X(20). NC1064.2 +040600 04 FILLER PIC X(5) VALUE SPACE. NC1064.2 +040700 04 XXCORRECT PIC X(20). NC1064.2 +040800 02 INF-ANSI-REFERENCE PIC X(48). NC1064.2 +040900 01 HYPHEN-LINE. NC1064.2 +041000 02 FILLER PIC IS X VALUE IS SPACE. NC1064.2 +041100 02 FILLER PIC IS X(65) VALUE IS "************************NC1064.2 +041200- "*****************************************". NC1064.2 +041300 02 FILLER PIC IS X(54) VALUE IS "************************NC1064.2 +041400- "******************************". NC1064.2 +041500 01 CCVS-PGM-ID PIC X(9) VALUE NC1064.2 +041600 "NC106A". NC1064.2 +041700 PROCEDURE DIVISION. NC1064.2 +041800 CCVS1 SECTION. NC1064.2 +041900 OPEN-FILES. NC1064.2 +042000 OPEN OUTPUT PRINT-FILE. NC1064.2 +042100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1064.2 +042200 MOVE SPACE TO TEST-RESULTS. NC1064.2 +042300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1064.2 +042400 GO TO CCVS1-EXIT. NC1064.2 +042500 CLOSE-FILES. NC1064.2 +042600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1064.2 +042700 TERMINATE-CCVS. NC1064.2 +042800S EXIT PROGRAM. NC1064.2 +042900STERMINATE-CALL. NC1064.2 +043000 STOP RUN. NC1064.2 +043100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1064.2 +043200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1064.2 +043300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1064.2 +043400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1064.2 +043500 MOVE "****TEST DELETED****" TO RE-MARK. NC1064.2 +043600 PRINT-DETAIL. NC1064.2 +043700 IF REC-CT NOT EQUAL TO ZERO NC1064.2 +043800 MOVE "." TO PARDOT-X NC1064.2 +043900 MOVE REC-CT TO DOTVALUE. NC1064.2 +044000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1064.2 +044100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1064.2 +044200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1064.2 +044300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1064.2 +044400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1064.2 +044500 MOVE SPACE TO CORRECT-X. NC1064.2 +044600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1064.2 +044700 MOVE SPACE TO RE-MARK. NC1064.2 +044800 HEAD-ROUTINE. NC1064.2 +044900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1064.2 +045200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1064.2 +045300 COLUMN-NAMES-ROUTINE. NC1064.2 +045400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +045500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +045700 END-ROUTINE. NC1064.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1064.2 +045900 END-RTN-EXIT. NC1064.2 +046000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +046100 END-ROUTINE-1. NC1064.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1064.2 +046300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1064.2 +046400 ADD PASS-COUNTER TO ERROR-HOLD. NC1064.2 +046500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1064.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1064.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1064.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1064.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1064.2 +047000 END-ROUTINE-12. NC1064.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1064.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1064.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1064.2 +047400 ELSE NC1064.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1064.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1064.2 +047700 PERFORM WRITE-LINE. NC1064.2 +047800 END-ROUTINE-13. NC1064.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1064.2 +048000 MOVE "NO " TO ERROR-TOTAL ELSE NC1064.2 +048100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1064.2 +048200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1064.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +048400 IF INSPECT-COUNTER EQUAL TO ZERO NC1064.2 +048500 MOVE "NO " TO ERROR-TOTAL NC1064.2 +048600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1064.2 +048700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1064.2 +048800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +048900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +049000 WRITE-LINE. NC1064.2 +049100 ADD 1 TO RECORD-COUNT. NC1064.2 +049200Y IF RECORD-COUNT GREATER 42 NC1064.2 +049300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1064.2 +049400Y MOVE SPACE TO DUMMY-RECORD NC1064.2 +049500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1064.2 +049600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1064.2 +049700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1064.2 +049800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1064.2 +049900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1064.2 +050000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1064.2 +050400Y MOVE ZERO TO RECORD-COUNT. NC1064.2 +050500 PERFORM WRT-LN. NC1064.2 +050600 WRT-LN. NC1064.2 +050700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1064.2 +050800 MOVE SPACE TO DUMMY-RECORD. NC1064.2 +050900 BLANK-LINE-PRINT. NC1064.2 +051000 PERFORM WRT-LN. NC1064.2 +051100 FAIL-ROUTINE. NC1064.2 +051200 IF COMPUTED-X NOT EQUAL TO SPACE NC1064.2 +051300 GO TO FAIL-ROUTINE-WRITE. NC1064.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1064.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1064.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1064.2 +051700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +051800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1064.2 +051900 GO TO FAIL-ROUTINE-EX. NC1064.2 +052000 FAIL-ROUTINE-WRITE. NC1064.2 +052100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1064.2 +052200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1064.2 +052300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1064.2 +052400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1064.2 +052500 FAIL-ROUTINE-EX. EXIT. NC1064.2 +052600 BAIL-OUT. NC1064.2 +052700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1064.2 +052800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1064.2 +052900 BAIL-OUT-WRITE. NC1064.2 +053000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1064.2 +053100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1064.2 +053200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +053300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1064.2 +053400 BAIL-OUT-EX. EXIT. NC1064.2 +053500 CCVS1-EXIT. NC1064.2 +053600 EXIT. NC1064.2 +053700 SECT-NC106A-001 SECTION. NC1064.2 +053800 SUB-INIT-F1-1. NC1064.2 +053900 MOVE "SUBTRACT" TO FEATURE. NC1064.2 +054000 MOVE "VI-134 6.25.4 GR1" TO ANSI-REFERENCE. NC1064.2 +054100 SUB-TEST-F1-1. NC1064.2 +054200 SUBTRACT 1 FROM N-5. NC1064.2 +054300 IF N-5 EQUAL TO 0 NC1064.2 +054400 PERFORM PASS NC1064.2 +054500 GO TO SUB-WRITE-F1-1. NC1064.2 +054600 GO TO SUB-FAIL-F1-1. NC1064.2 +054700 SUB-DELETE-F1-1. NC1064.2 +054800 PERFORM DE-LETE. NC1064.2 +054900 GO TO SUB-WRITE-F1-1. NC1064.2 +055000 SUB-FAIL-F1-1. NC1064.2 +055100 MOVE N-5 TO COMPUTED-N. NC1064.2 +055200 MOVE 0 TO CORRECT-N. NC1064.2 +055300 PERFORM FAIL. NC1064.2 +055400 SUB-WRITE-F1-1. NC1064.2 +055500 MOVE "SUB-TEST-F1-1 " TO PAR-NAME. NC1064.2 +055600 PERFORM PRINT-DETAIL. NC1064.2 +055700 SUB-TEST-F1-2. NC1064.2 +055800 SUBTRACT N-17 FROM N-18 ROUNDED. NC1064.2 +055900 IF N-18 EQUAL TO -9 NC1064.2 +056000 PERFORM PASS NC1064.2 +056100 GO TO SUB-WRITE-F1-2. NC1064.2 +056200 GO TO SUB-FAIL-F1-2. NC1064.2 +056300 SUB-DELETE-F1-2. NC1064.2 +056400 PERFORM DE-LETE. NC1064.2 +056500 GO TO SUB-WRITE-F1-2. NC1064.2 +056600 SUB-FAIL-F1-2. NC1064.2 +056700 MOVE N-18 TO COMPUTED-N. NC1064.2 +056800 MOVE -9 TO CORRECT-N. NC1064.2 +056900 PERFORM FAIL. NC1064.2 +057000 SUB-WRITE-F1-2. NC1064.2 +057100 MOVE "SUB-TEST-F1-2 " TO PAR-NAME. NC1064.2 +057200 PERFORM PRINT-DETAIL. NC1064.2 +057300 SUB-INIT-F1-3. NC1064.2 +057400 MOVE -00001 TO N-10. NC1064.2 +057500 MOVE 99999 TO N-13. NC1064.2 +057600 SUB-TEST-F1-3-0. NC1064.2 +057700 SUBTRACT N-10 FROM N-13 ON SIZE ERROR NC1064.2 +057800 PERFORM PASS NC1064.2 +057900 GO TO SUB-WRITE-F1-3-1. NC1064.2 +058000 GO TO SUB-FAIL-F1-3-1. NC1064.2 +058100 SUB-DELETE-F1-3-1. NC1064.2 +058200 PERFORM DE-LETE. NC1064.2 +058300 GO TO SUB-WRITE-F1-3-1. NC1064.2 +058400 SUB-FAIL-F1-3-1. NC1064.2 +058500 MOVE N-13 TO COMPUTED-N. NC1064.2 +058600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +058700 PERFORM FAIL. NC1064.2 +058800 SUB-WRITE-F1-3-1. NC1064.2 +058900 MOVE "SUB-TEST-F1-3-1 " TO PAR-NAME. NC1064.2 +059000 PERFORM PRINT-DETAIL. NC1064.2 +059100 SUB-TEST-F1-3-2. NC1064.2 +059200 IF N-13 = 99999 NC1064.2 +059300 PERFORM PASS NC1064.2 +059400 GO TO SUB-WRITE-F1-3-2. NC1064.2 +059500 GO TO SUB-FAIL-F1-3-2. NC1064.2 +059600 SUB-DELETE-F1-3-2. NC1064.2 +059700 PERFORM DE-LETE. NC1064.2 +059800 GO TO SUB-WRITE-F1-3-2. NC1064.2 +059900 SUB-FAIL-F1-3-2. NC1064.2 +060000 MOVE N-13 TO COMPUTED-N. NC1064.2 +060100 MOVE 99999 TO CORRECT-N. NC1064.2 +060200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +060300 PERFORM FAIL. NC1064.2 +060400 SUB-WRITE-F1-3-2. NC1064.2 +060500 MOVE "SUB-TEST-F1-3-2 " TO PAR-NAME. NC1064.2 +060600 PERFORM PRINT-DETAIL. NC1064.2 +060700 SUB-INIT-F1-4-1. NC1064.2 +060800 MOVE -999999999 TO N-20. NC1064.2 +060900 SUB-TEST-F1-4-1. NC1064.2 +061000 SUBTRACT .7 FROM N-20 ROUNDED ON SIZE ERROR NC1064.2 +061100 PERFORM PASS NC1064.2 +061200 GO TO SUB-WRITE-F1-4-1. NC1064.2 +061300 GO TO SUB-FAIL-F1-4-1. NC1064.2 +061400 SUB-DELETE-F1-4-1. NC1064.2 +061500 PERFORM DE-LETE. NC1064.2 +061600 GO TO SUB-WRITE-F1-4-1. NC1064.2 +061700 SUB-FAIL-F1-4-1. NC1064.2 +061800 MOVE N-20 TO COMPUTED-N. NC1064.2 +061900 MOVE -999999999 TO CORRECT-N. NC1064.2 +062000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +062100 PERFORM FAIL. NC1064.2 +062200 SUB-WRITE-F1-4-1. NC1064.2 +062300 MOVE "SUB-TEST-F1-4-1 " TO PAR-NAME. NC1064.2 +062400 PERFORM PRINT-DETAIL. NC1064.2 +062500 SUB-TEST-F1-4-2. NC1064.2 +062600 IF N-20 = -999999999 NC1064.2 +062700 PERFORM PASS NC1064.2 +062800 GO TO SUB-WRITE-F1-4-2. NC1064.2 +062900 GO TO SUB-FAIL-F1-4-2. NC1064.2 +063000 SUB-DELETE-F1-4-2. NC1064.2 +063100 PERFORM DE-LETE. NC1064.2 +063200 GO TO SUB-WRITE-F1-4-2. NC1064.2 +063300 SUB-FAIL-F1-4-2. NC1064.2 +063400 MOVE N-20 TO COMPUTED-N. NC1064.2 +063500 MOVE -999999999 TO CORRECT-N. NC1064.2 +063600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +063700 PERFORM FAIL. NC1064.2 +063800 SUB-WRITE-F1-4-2. NC1064.2 +063900 MOVE "SUB-TEST-F1-4-2 " TO PAR-NAME. NC1064.2 +064000 PERFORM PRINT-DETAIL. NC1064.2 +064100 SUB-INIT-F1-5. NC1064.2 +064200 MOVE "SUBTRACT ---" TO FEATURE. NC1064.2 +064300 PERFORM PRINT-DETAIL. NC1064.2 +064400 MOVE " FROM" TO FEATURE. NC1064.2 +064500 SUB-TEST-F1-5. NC1064.2 +064600 MOVE A18TWOS-DS-18V00 TO WRK-DS-18V00. NC1064.2 +064700 SUBTRACT A18ONES-DS-18V00 FROM WRK-DS-18V00. NC1064.2 +064800 IF WRK-DS-18V00 EQUAL TO 111111111111111111 NC1064.2 +064900 PERFORM PASS GO TO SUB-WRITE-F1-5. NC1064.2 +065000 GO TO SUB-FAIL-F1-5. NC1064.2 +065100 SUB-DELETE-F1-5. NC1064.2 +065200 PERFORM DE-LETE. NC1064.2 +065300 GO TO SUB-WRITE-F1-5. NC1064.2 +065400 SUB-FAIL-F1-5. NC1064.2 +065500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1064.2 +065600 MOVE 111111111111111111 TO CORRECT-18V0. NC1064.2 +065700 PERFORM FAIL. NC1064.2 +065800 SUB-WRITE-F1-5. NC1064.2 +065900 MOVE "SUB-TEST-F1-5" TO PAR-NAME. NC1064.2 +066000 PERFORM PRINT-DETAIL. NC1064.2 +066100 SUB-TEST-F1-6. NC1064.2 +066200 MOVE A12THREES-DS-06V06 TO WRK-DS-06V06. NC1064.2 +066300 SUBTRACT A05ONES-DS-05V00 NC1064.2 +066400 A05ONES-DS-00V05 NC1064.2 +066500 A06ONES-DS-03V03 FROM WRK-DS-06V06. NC1064.2 +066600 IF WRK-DS-06V06 EQUAL TO 322111.111223 NC1064.2 +066700 PERFORM PASS GO TO SUB-WRITE-F1-6. NC1064.2 +066800 GO TO SUB-FAIL-F1-6. NC1064.2 +066900 SUB-DELETE-F1-6. NC1064.2 +067000 PERFORM DE-LETE. NC1064.2 +067100 GO TO SUB-WRITE-F1-6. NC1064.2 +067200 SUB-FAIL-F1-6. NC1064.2 +067300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1064.2 +067400 MOVE 322111.111223 TO CORRECT-N. NC1064.2 +067500 PERFORM FAIL. NC1064.2 +067600 SUB-WRITE-F1-6. NC1064.2 +067700 MOVE "SUB-TEST-F1-6" TO PAR-NAME. NC1064.2 +067800 PERFORM PRINT-DETAIL. NC1064.2 +067900 SUB-INIT-F1-7. NC1064.2 +068000 MOVE " ROUNDED" TO FEATURE. NC1064.2 +068100 SUB-TEST-F1-7. NC1064.2 +068200 MOVE ZERO TO WRK-DS-0201P. NC1064.2 +068300 SUBTRACT A99-DS-02V00 FROM WRK-DS-0201P ROUNDED. NC1064.2 +068400 IF WRK-DS-0201P EQUAL TO -100 NC1064.2 +068500 PERFORM PASS GO TO SUB-WRITE-F1-7. NC1064.2 +068600 GO TO SUB-FAIL-F1-7. NC1064.2 +068700 SUB-DELETE-F1-7. NC1064.2 +068800 PERFORM DE-LETE. NC1064.2 +068900 GO TO SUB-WRITE-F1-7. NC1064.2 +069000 SUB-FAIL-F1-7. NC1064.2 +069100 MOVE WRK-DS-0201P TO COMPUTED-N. NC1064.2 +069200 MOVE -100 TO CORRECT-N. NC1064.2 +069300 PERFORM FAIL. NC1064.2 +069400 SUB-WRITE-F1-7. NC1064.2 +069500 MOVE "SUB-TEST-F1-7" TO PAR-NAME. NC1064.2 +069600 PERFORM PRINT-DETAIL. NC1064.2 +069700 SUB-INIT-F1-8-1. NC1064.2 +069800 MOVE " SIZE ERROR" TO FEATURE. NC1064.2 +069900 MOVE -11 TO WRK-DS-02V00. NC1064.2 +070000 SUB-TEST-F1-8-1. NC1064.2 +070100 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 ON SIZE ERROR NC1064.2 +070200 PERFORM PASS GO TO SUB-WRITE-F1-8-1. NC1064.2 +070300 GO TO SUB-FAIL-F1-8-1. NC1064.2 +070400 SUB-DELETE-F1-8-1. NC1064.2 +070500 PERFORM DE-LETE. NC1064.2 +070600 GO TO SUB-WRITE-F1-8-1. NC1064.2 +070700 SUB-FAIL-F1-8-1. NC1064.2 +070800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +070900 PERFORM FAIL. NC1064.2 +071000 SUB-WRITE-F1-8-1. NC1064.2 +071100 MOVE "SUB-TEST-F1-8-1" TO PAR-NAME. NC1064.2 +071200 PERFORM PRINT-DETAIL. NC1064.2 +071300 SUB-TEST-F1-8-2. NC1064.2 +071400 IF WRK-DS-02V00 EQUAL TO -11 NC1064.2 +071500 PERFORM PASS GO TO SUB-WRITE-F1-8-2. NC1064.2 +071600* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-8-1 NC1064.2 +071700 GO TO SUB-FAIL-F1-8-2. NC1064.2 +071800 SUB-DELETE-F1-8-2. NC1064.2 +071900 PERFORM DE-LETE. NC1064.2 +072000 GO TO SUB-WRITE-F1-8-2. NC1064.2 +072100 SUB-FAIL-F1-8-2. NC1064.2 +072200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +072300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1064.2 +072400 MOVE -11 TO CORRECT-N. NC1064.2 +072500 PERFORM FAIL. NC1064.2 +072600 SUB-WRITE-F1-8-2. NC1064.2 +072700 MOVE "SUB-TEST-F1-8-2" TO PAR-NAME. NC1064.2 +072800 PERFORM PRINT-DETAIL. NC1064.2 +072900 SUB-INIT-F1-9-1. NC1064.2 +073000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1064.2 +073100 SUB-TEST-F1-9-1. NC1064.2 +073200 MOVE ZERO TO WRK-DS-05V00. NC1064.2 +073300 SUBTRACT 33333 NC1064.2 +073400 A06THREES-DS-03V03 NC1064.2 +073500 A12THREES-DS-06V06 NC1064.2 +073600 FROM WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1064.2 +073700 PERFORM PASS GO TO SUB-WRITE-F1-9-1. NC1064.2 +073800 GO TO SUB-FAIL-F1-9-1. NC1064.2 +073900 SUB-DELETE-F1-9-1. NC1064.2 +074000 PERFORM DE-LETE. NC1064.2 +074100 GO TO SUB-WRITE-F1-9-1. NC1064.2 +074200 SUB-FAIL-F1-9-1. NC1064.2 +074300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +074400 PERFORM FAIL. NC1064.2 +074500 SUB-WRITE-F1-9-1. NC1064.2 +074600 MOVE "SUB-TEST-F1-9-1" TO PAR-NAME. NC1064.2 +074700 PERFORM PRINT-DETAIL. NC1064.2 +074800 SUB-TEST-F1-9-2. NC1064.2 +074900 IF WRK-DS-05V00 EQUAL TO ZERO NC1064.2 +075000 PERFORM PASS GO TO SUB-WRITE-F1-9-2. NC1064.2 +075100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-9-1 NC1064.2 +075200 GO TO SUB-FAIL-F1-9-2. NC1064.2 +075300 SUB-DELETE-F1-9-2. NC1064.2 +075400 PERFORM DE-LETE. NC1064.2 +075500 GO TO SUB-WRITE-F1-9-2. NC1064.2 +075600 SUB-FAIL-F1-9-2. NC1064.2 +075700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +075800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1064.2 +075900 MOVE ZERO TO CORRECT-N. NC1064.2 +076000 PERFORM FAIL. NC1064.2 +076100 SUB-WRITE-F1-9-2. NC1064.2 +076200 MOVE "SUB-TEST-F1-9-2" TO PAR-NAME. NC1064.2 +076300 PERFORM PRINT-DETAIL. NC1064.2 +076400 SUB-INIT-F1-10. NC1064.2 +076500 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +076600 SUB-TEST-F1-10-1. NC1064.2 +076700 SUBTRACT A12THREES-DS-06V06 NC1064.2 +076800 333333 NC1064.2 +076900 A06THREES-DS-03V03 NC1064.2 +077000 -0000009 NC1064.2 +077100 FROM WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1064.2 +077200 GO TO SUB-FAIL-F1-10-1. NC1064.2 +077300 PERFORM PASS. NC1064.2 +077400 GO TO SUB-WRITE-F1-10-1. NC1064.2 +077500 SUB-DELETE-F1-10-1. NC1064.2 +077600 PERFORM DE-LETE. NC1064.2 +077700 GO TO SUB-WRITE-F1-10-1. NC1064.2 +077800 SUB-FAIL-F1-10-1. NC1064.2 +077900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1064.2 +078000 PERFORM FAIL. NC1064.2 +078100 SUB-WRITE-F1-10-1. NC1064.2 +078200 MOVE "SUB-TEST-F1-10-1" TO PAR-NAME. NC1064.2 +078300 PERFORM PRINT-DETAIL. NC1064.2 +078400 SUB-TEST-F1-10-2. NC1064.2 +078500 IF WRK-DS-06V06 EQUAL TO -666990.666333 NC1064.2 +078600 PERFORM PASS GO TO SUB-WRITE-F1-10-2. NC1064.2 +078700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-10-1 NC1064.2 +078800 GO TO SUB-FAIL-F1-10-2. NC1064.2 +078900 SUB-DELETE-F1-10-2. NC1064.2 +079000 PERFORM DE-LETE. NC1064.2 +079100 GO TO SUB-WRITE-F1-10-2. NC1064.2 +079200 SUB-FAIL-F1-10-2. NC1064.2 +079300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1064.2 +079400 MOVE -666990.666333 TO CORRECT-N. NC1064.2 +079500 PERFORM FAIL. NC1064.2 +079600 SUB-WRITE-F1-10-2. NC1064.2 +079700 MOVE "SUB-TEST-F1-10-2" TO PAR-NAME. NC1064.2 +079800 PERFORM PRINT-DETAIL. NC1064.2 +079900 SUB-INIT-F1-11. NC1064.2 +080000 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1064.2 +080100 SUB-TEST-F1-11. NC1064.2 +080200 MOVE ZERO TO WRK-CS-18V00 NC1064.2 +080300 SUBTRACT A18ONES-DS-18V00 FROM WRK-CS-18V00. NC1064.2 +080400 IF WRK-CS-18V00 EQUAL TO -111111111111111111 NC1064.2 +080500 PERFORM PASS GO TO SUB-WRITE-F1-11. NC1064.2 +080600 GO TO SUB-FAIL-F1-11. NC1064.2 +080700 SUB-DELETE-F1-11. NC1064.2 +080800 PERFORM DE-LETE. NC1064.2 +080900 GO TO SUB-WRITE-F1-11. NC1064.2 +081000 SUB-FAIL-F1-11. NC1064.2 +081100 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1064.2 +081200 MOVE -111111111111111111 TO CORRECT-18V0. NC1064.2 +081300 PERFORM FAIL. NC1064.2 +081400 SUB-WRITE-F1-11. NC1064.2 +081500 MOVE "SUB-TEST-F1-11" TO PAR-NAME. NC1064.2 +081600 PERFORM PRINT-DETAIL. NC1064.2 +081700 SUB-TEST-F1-12. NC1064.2 +081800 MOVE ZERO TO WRK-DS-18V00. NC1064.2 +081900 SUBTRACT A18ONES-CS-18V00 FROM WRK-DS-18V00. NC1064.2 +082000 IF WRK-DS-18V00 EQUAL TO -111111111111111111 NC1064.2 +082100 PERFORM PASS GO TO SUB-WRITE-F1-12. NC1064.2 +082200 GO TO SUB-FAIL-F1-12. NC1064.2 +082300 SUB-DELETE-F1-12. NC1064.2 +082400 PERFORM DE-LETE. NC1064.2 +082500 GO TO SUB-WRITE-F1-12. NC1064.2 +082600 SUB-FAIL-F1-12. NC1064.2 +082700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1064.2 +082800 MOVE -111111111111111111 TO CORRECT-18V0. NC1064.2 +082900 PERFORM FAIL. NC1064.2 +083000 SUB-WRITE-F1-12. NC1064.2 +083100 MOVE "SUB-TEST-F1-12" TO PAR-NAME. NC1064.2 +083200 PERFORM PRINT-DETAIL. NC1064.2 +083300 SUB-TEST-F1-13. NC1064.2 +083400 MOVE ZERO TO WRK-CS-02V02. NC1064.2 +083500 SUBTRACT A99-CS-02V00 FROM WRK-CS-02V02. NC1064.2 +083600 IF WRK-CS-02V02 EQUAL TO -99.00 NC1064.2 +083700 PERFORM PASS GO TO SUB-WRITE-F1-13. NC1064.2 +083800 GO TO SUB-FAIL-F1-13. NC1064.2 +083900 SUB-DELETE-F1-13. NC1064.2 +084000 PERFORM DE-LETE. NC1064.2 +084100 GO TO SUB-WRITE-F1-13. NC1064.2 +084200 SUB-FAIL-F1-13. NC1064.2 +084300 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1064.2 +084400 MOVE -99.00 TO CORRECT-N. NC1064.2 +084500 PERFORM FAIL. NC1064.2 +084600 SUB-WRITE-F1-13. NC1064.2 +084700 MOVE "SUB-TEST-F1-13" TO PAR-NAME. NC1064.2 +084800 PERFORM PRINT-DETAIL. NC1064.2 +084900 SUB-TEST-F1-14-1. NC1064.2 +085000 MOVE A99-CS-02V00 TO WRK-CS-02V02. NC1064.2 +085100 SUBTRACT -99 FROM WRK-CS-02V02 ON SIZE ERROR NC1064.2 +085200 PERFORM PASS GO TO SUB-WRITE-F1-14-1. NC1064.2 +085300 GO TO SUB-FAIL-F1-14-1. NC1064.2 +085400 SUB-DELETE-F1-14-1. NC1064.2 +085500 PERFORM DE-LETE. NC1064.2 +085600 GO TO SUB-WRITE-F1-14-1. NC1064.2 +085700 SUB-FAIL-F1-14-1. NC1064.2 +085800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +085900 PERFORM FAIL. NC1064.2 +086000 SUB-WRITE-F1-14-1. NC1064.2 +086100 MOVE "SUB-TEST-F1-14-1" TO PAR-NAME. NC1064.2 +086200 PERFORM PRINT-DETAIL. NC1064.2 +086300 SUB-TEST-F1-14-2. NC1064.2 +086400 IF WRK-CS-02V02 EQUAL TO 99 NC1064.2 +086500 PERFORM PASS GO TO SUB-WRITE-F1-14-2. NC1064.2 +086600* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-14-1 NC1064.2 +086700 GO TO SUB-FAIL-F1-14-2. NC1064.2 +086800 SUB-DELETE-F1-14-2. NC1064.2 +086900 PERFORM DE-LETE. NC1064.2 +087000 GO TO SUB-WRITE-F1-14-2. NC1064.2 +087100 SUB-FAIL-F1-14-2. NC1064.2 +087200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +087300 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1064.2 +087400 MOVE 99 TO CORRECT-N. NC1064.2 +087500 PERFORM FAIL. NC1064.2 +087600 SUB-WRITE-F1-14-2. NC1064.2 +087700 MOVE "SUB-TEST-F1-14-2" TO PAR-NAME. NC1064.2 +087800 PERFORM PRINT-DETAIL. NC1064.2 +087900 SUB-TEST-F1-15. NC1064.2 +088000 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-7. NC1064.2 +088100 IF SUBTR-7 EQUAL TO 99 NC1064.2 +088200 PERFORM PASS GO TO SUB-WRITE-F1-15. NC1064.2 +088300 GO TO SUB-FAIL-F1-15. NC1064.2 +088400 SUB-DELETE-F1-15. NC1064.2 +088500 PERFORM DE-LETE. NC1064.2 +088600 GO TO SUB-WRITE-F1-15. NC1064.2 +088700 SUB-FAIL-F1-15. NC1064.2 +088800 MOVE SUBTR-7 TO COMPUTED-N. NC1064.2 +088900 MOVE 99 TO CORRECT-N. NC1064.2 +089000 PERFORM FAIL. NC1064.2 +089100 SUB-WRITE-F1-15. NC1064.2 +089200 MOVE "SUB-TEST-F1-15" TO PAR-NAME. NC1064.2 +089300 PERFORM PRINT-DETAIL. NC1064.2 +089400 SUB-TEST-F1-16. NC1064.2 +089500 SUBTRACT SUBTR-5 -98 SUBTR-3 -1 FROM SUBTR-10. NC1064.2 +089600 IF SUBTR-10 EQUAL TO 100 NC1064.2 +089700 PERFORM PASS GO TO SUB-WRITE-F1-16. NC1064.2 +089800 GO TO SUB-FAIL-F1-16. NC1064.2 +089900 SUB-DELETE-F1-16. NC1064.2 +090000 PERFORM DE-LETE. NC1064.2 +090100 GO TO SUB-WRITE-F1-16. NC1064.2 +090200 SUB-FAIL-F1-16. NC1064.2 +090300 MOVE SUBTR-10 TO COMPUTED-N. NC1064.2 +090400 MOVE 100 TO CORRECT-N. NC1064.2 +090500 PERFORM FAIL. NC1064.2 +090600 SUB-WRITE-F1-16. NC1064.2 +090700 MOVE "SUB-TEST-F1-16" TO PAR-NAME. NC1064.2 +090800 PERFORM PRINT-DETAIL. NC1064.2 +090900 SUB-TEST-F1-17. NC1064.2 +091000 SUBTRACT SUBTR-4 FROM SUBTR-6 ROUNDED. NC1064.2 +091100 IF SUBTR-6 EQUAL TO 1 NC1064.2 +091200 PERFORM PASS GO TO SUB-WRITE-F1-17. NC1064.2 +091300 GO TO SUB-FAIL-F1-17. NC1064.2 +091400 SUB-DELETE-F1-17. NC1064.2 +091500 PERFORM DE-LETE. NC1064.2 +091600 GO TO SUB-WRITE-F1-17. NC1064.2 +091700 SUB-FAIL-F1-17. NC1064.2 +091800 MOVE SUBTR-6 TO COMPUTED-N. NC1064.2 +091900 MOVE 1 TO CORRECT-N. NC1064.2 +092000 PERFORM FAIL. NC1064.2 +092100 SUB-WRITE-F1-17. NC1064.2 +092200 MOVE "SUB-TEST-F1-17" TO PAR-NAME. NC1064.2 +092300 PERFORM PRINT-DETAIL. NC1064.2 +092400 SUB-TEST-F1-18-1. NC1064.2 +092500 SUBTRACT .01 FROM SUBTR-8 ON SIZE ERROR NC1064.2 +092600 PERFORM PASS GO TO SUB-WRITE-F1-18-1. NC1064.2 +092700 GO TO SUB-FAIL-F1-18-1. NC1064.2 +092800 SUB-DELETE-F1-18-1. NC1064.2 +092900 PERFORM DE-LETE. NC1064.2 +093000 GO TO SUB-WRITE-F1-18-1. NC1064.2 +093100 SUB-FAIL-F1-18-1. NC1064.2 +093200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +093300 PERFORM FAIL. NC1064.2 +093400 SUB-WRITE-F1-18-1. NC1064.2 +093500 MOVE "SUB-TEST-F1-18-1" TO PAR-NAME. NC1064.2 +093600 PERFORM PRINT-DETAIL. NC1064.2 +093700 SUB-TEST-F1-18-2. NC1064.2 +093800 IF SUBTR-8 EQUAL TO -9.99 NC1064.2 +093900 PERFORM PASS GO TO SUB-WRITE-F1-18-2. NC1064.2 +094000* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-18-1 NC1064.2 +094100 GO TO SUB-FAIL-F1-18-2. NC1064.2 +094200 SUB-DELETE-F1-18-2. NC1064.2 +094300 PERFORM DE-LETE. NC1064.2 +094400 GO TO SUB-WRITE-F1-18-2. NC1064.2 +094500 SUB-FAIL-F1-18-2. NC1064.2 +094600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +094700 MOVE SUBTR-8 TO COMPUTED-N. NC1064.2 +094800 MOVE -9.99 TO CORRECT-N. NC1064.2 +094900 PERFORM FAIL. NC1064.2 +095000 SUB-WRITE-F1-18-2. NC1064.2 +095100 MOVE "SUB-TEST-F1-18-2" TO PAR-NAME. NC1064.2 +095200 PERFORM PRINT-DETAIL. NC1064.2 +095300 SUB-TEST-F1-19. NC1064.2 +095400 MOVE A18FIVES-CS-18V00 TO WRK-CS-18V00. NC1064.2 +095500 SUBTRACT A18THREES-CS-18V00 FROM WRK-CS-18V00. NC1064.2 +095600 IF WRK-CS-18V00 EQUAL TO -222222222222222222 NC1064.2 +095700 PERFORM PASS NC1064.2 +095800 GO TO SUB-WRITE-F1-19. NC1064.2 +095900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1064.2 +096000 MOVE -222222222222222222 TO CORRECT-18V0. NC1064.2 +096100 PERFORM FAIL. NC1064.2 +096200 GO TO SUB-WRITE-F1-19. NC1064.2 +096300 SUB-DELETE-F1-19. NC1064.2 +096400 PERFORM DE-LETE. NC1064.2 +096500 SUB-WRITE-F1-19. NC1064.2 +096600 MOVE "SUB-TEST-F1-19 " TO PAR-NAME. NC1064.2 +096700 PERFORM PRINT-DETAIL. NC1064.2 +096800 SUB-TEST-F1-20. NC1064.2 +096900 MOVE -980 TO WRK-CS-03V00. NC1064.2 +097000 MOVE SPACE TO SIZE-ERR. NC1064.2 +097100* NOTE IN THIS TEST, 1 IS SUBTRACTED FROM A 3-DIGIT COMP NC1064.2 +097200* SYNC FIELD UNTIL A SIZE ERROR OCCURS --- IF THE NC1064.2 +097300* VALUE OF THE FIELD REACHES -1180 WITHOUT A SIZE NC1064.2 +097400* ERROR, THEN THE ATTEMPTED SUBTRACTIONS ARE STOPPED. NC1064.2 +097500 PERFORM SUB-A-F1-20 THRU SUB-B-F1-20 200 TIMES. NC1064.2 +097600 IF SIZE-ERR EQUAL TO SPACE NC1064.2 +097700 MOVE "SIZE ERROR NOT ENCOUNTERED" TO RE-MARK NC1064.2 +097800 MOVE "-1180 OR LESS" TO COMPUTED-A NC1064.2 +097900 MOVE "-999 IN S999 FIELD" TO CORRECT-A NC1064.2 +098000 PERFORM FAIL NC1064.2 +098100 GO TO SUB-WRITE-F1-20. NC1064.2 +098200 IF WRK-CS-03V00 EQUAL TO -999 NC1064.2 +098300 PERFORM PASS GO TO SUB-WRITE-F1-20. NC1064.2 +098400 PERFORM FAIL. NC1064.2 +098500 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1064.2 +098600 MOVE -999 TO CORRECT-N. NC1064.2 +098700 GO TO SUB-WRITE-F1-20. NC1064.2 +098800 SUB-DELETE-F1-20. NC1064.2 +098900 PERFORM DE-LETE. NC1064.2 +099000 GO TO SUB-WRITE-F1-20. NC1064.2 +099100 SUB-A-F1-20. NC1064.2 +099200 IF SIZE-ERR EQUAL TO "E" GO TO SUB-B-F1-20. NC1064.2 +099300 SUBTRACT 1 FROM WRK-CS-03V00 ON SIZE ERROR NC1064.2 +099400 MOVE "E" TO SIZE-ERR. NC1064.2 +099500 SUB-B-F1-20. NC1064.2 +099600 EXIT. NC1064.2 +099700 SUB-WRITE-F1-20. NC1064.2 +099800 MOVE "SUBT, COMP, SIZE ERR" TO FEATURE. NC1064.2 +099900 MOVE "SUB-TEST-F1-20" TO PAR-NAME. NC1064.2 +100000 PERFORM PRINT-DETAIL. NC1064.2 +100100* NC1064.2 +100200 SUB-INIT-F1-21. NC1064.2 +100300* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +100400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +100500 MOVE -11 TO WRK-DS-02V00. NC1064.2 +100600 SUB-TEST-F1-21. NC1064.2 +100700 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +100800 NOT ON SIZE ERROR NC1064.2 +100900 GO TO SUB-FAIL-F1-21. NC1064.2 +101000 PERFORM PASS GO TO SUB-WRITE-F1-21. NC1064.2 +101100 SUB-DELETE-F1-21. NC1064.2 +101200 PERFORM DE-LETE. NC1064.2 +101300 GO TO SUB-WRITE-F1-21. NC1064.2 +101400 SUB-FAIL-F1-21. NC1064.2 +101500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1064.2 +101600 PERFORM FAIL. NC1064.2 +101700 SUB-WRITE-F1-21. NC1064.2 +101800 MOVE "SUB-TEST-F1-21" TO PAR-NAME. NC1064.2 +101900 PERFORM PRINT-DETAIL. NC1064.2 +102000* NC1064.2 +102100 SUB-INIT-F1-22. NC1064.2 +102200* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +102300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +102400 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +102500 SUB-TEST-F1-22. NC1064.2 +102600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +102700 333333 NC1064.2 +102800 A06THREES-DS-03V03 NC1064.2 +102900 -0000009 NC1064.2 +103000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +103100 NOT ON SIZE ERROR NC1064.2 +103200 PERFORM PASS NC1064.2 +103300 GO TO SUB-WRITE-F1-22. NC1064.2 +103400 GO TO SUB-FAIL-F1-22. NC1064.2 +103500 SUB-DELETE-F1-22. NC1064.2 +103600 PERFORM DE-LETE. NC1064.2 +103700 GO TO SUB-WRITE-F1-22. NC1064.2 +103800 SUB-FAIL-F1-22. NC1064.2 +103900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +104000 PERFORM FAIL. NC1064.2 +104100 SUB-WRITE-F1-22. NC1064.2 +104200 MOVE "SUB-TEST-F1-22" TO PAR-NAME. NC1064.2 +104300 PERFORM PRINT-DETAIL. NC1064.2 +104400* NC1064.2 +104500 SUB-INIT-F1-23. NC1064.2 +104600* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +104700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +104800 MOVE -11 TO WRK-DS-02V00. NC1064.2 +104900 SUB-TEST-F1-23. NC1064.2 +105000 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +105100 ON SIZE ERROR NC1064.2 +105200 PERFORM PASS GO TO SUB-WRITE-F1-23 NC1064.2 +105300 NOT ON SIZE ERROR NC1064.2 +105400 GO TO SUB-FAIL-F1-23. NC1064.2 +105500 SUB-DELETE-F1-23. NC1064.2 +105600 PERFORM DE-LETE. NC1064.2 +105700 GO TO SUB-WRITE-F1-23. NC1064.2 +105800 SUB-FAIL-F1-23. NC1064.2 +105900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +106000 PERFORM FAIL. NC1064.2 +106100 SUB-WRITE-F1-23. NC1064.2 +106200 MOVE "SUB-TEST-F1-23" TO PAR-NAME. NC1064.2 +106300 PERFORM PRINT-DETAIL. NC1064.2 +106400* NC1064.2 +106500 SUB-INIT-F1-24. NC1064.2 +106600* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +106700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +106800 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +106900 SUB-TEST-F1-24. NC1064.2 +107000 SUBTRACT A12THREES-DS-06V06 NC1064.2 +107100 333333 NC1064.2 +107200 A06THREES-DS-03V03 NC1064.2 +107300 -0000009 NC1064.2 +107400 FROM WRK-DS-06V06 ROUNDED NC1064.2 +107500 ON SIZE ERROR NC1064.2 +107600 GO TO SUB-FAIL-F1-24 NC1064.2 +107700 NOT ON SIZE ERROR NC1064.2 +107800 PERFORM PASS NC1064.2 +107900 GO TO SUB-WRITE-F1-24. NC1064.2 +108000 SUB-DELETE-F1-24. NC1064.2 +108100 PERFORM DE-LETE. NC1064.2 +108200 GO TO SUB-WRITE-F1-24. NC1064.2 +108300 SUB-FAIL-F1-24. NC1064.2 +108400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +108500 PERFORM FAIL. NC1064.2 +108600 SUB-WRITE-F1-24. NC1064.2 +108700 MOVE "SUB-TEST-F1-24" TO PAR-NAME. NC1064.2 +108800 PERFORM PRINT-DETAIL. NC1064.2 +108900* NC1064.2 +109000 SUB-INIT-F1-25. NC1064.2 +109100* ==--> MULTIPLE OPERANDS <--== NC1064.2 +109200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +109300 MOVE "SUBTR LIMIT TESTS " TO FEATURE. NC1064.2 +109400 MOVE 1 TO DNAME1 DNAME2 DNAME3 DNAME4 DNAME5. NC1064.2 +109500 MOVE 1 TO DNAME6 DNAME7 DNAME8 DNAME9 DNAME10. NC1064.2 +109600 MOVE 1 TO DNAME11 DNAME12 DNAME13 DNAME14 DNAME14. NC1064.2 +109700 MOVE 1 TO DNAME16 DNAME17 DNAME18 DNAME19 DNAME20. NC1064.2 +109800 MOVE 1 TO DNAME21. NC1064.2 +109900 MOVE 21 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1064.2 +110000 MOVE 21 TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1064.2 +110100 MOVE 21 TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1064.2 +110200 MOVE 21 TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1064.2 +110300 MOVE 21 TO DNAME42. NC1064.2 +110400* THE FOLLOWING 22 TESTS VERIFY THE ABILITY OF THE COMPILER NC1064.2 +110500* TO HANDLE A MAXIMUM OF 42 OPERANDS IN A SUBTRACT STATEMENT. NC1064.2 +110600* A DELETION IN THIS PARAGRAPH WILL SKIP THE LIMIT TESTS. NC1064.2 +110700 GO TO SUB-TEST-F1-25-0. NC1064.2 +110800 SUB-DELETE-F1-25-0. NC1064.2 +110900 PERFORM DE-LETE. NC1064.2 +111000 MOVE "SUB-TEST-F1-25 - 26 " TO PAR-NAME. NC1064.2 +111100 MOVE "SUBTR LIMITS TESTS " TO FEATURE. NC1064.2 +111200 ADD 21 TO DELETE-COUNTER. NC1064.2 +111300 PERFORM PRINT-DETAIL. NC1064.2 +111400 GO TO SUB-INIT-F1-26. NC1064.2 +111500 SUB-TEST-F1-25-0. NC1064.2 +111600 SUBTRACT DNAME1 NC1064.2 +111700 DNAME2 NC1064.2 +111800 DNAME3 NC1064.2 +111900 DNAME4 NC1064.2 +112000 DNAME5 NC1064.2 +112100 DNAME6 NC1064.2 +112200 DNAME7 NC1064.2 +112300 DNAME8 NC1064.2 +112400 DNAME9 NC1064.2 +112500 DNAME10 NC1064.2 +112600 DNAME11 NC1064.2 +112700 DNAME12 NC1064.2 +112800 DNAME13 NC1064.2 +112900 DNAME14 NC1064.2 +113000 DNAME15 NC1064.2 +113100 DNAME16 NC1064.2 +113200 DNAME17 NC1064.2 +113300 DNAME18 NC1064.2 +113400 DNAME19 NC1064.2 +113500 DNAME20 NC1064.2 +113600 DNAME21 NC1064.2 +113700 FROM DNAME22. NC1064.2 +113800 SUB-TEST-F1-25-1. NC1064.2 +113900 IF DNAME22 EQUAL TO ZERO NC1064.2 +114000 PERFORM PASS NC1064.2 +114100 GO TO SUB-WRITE-F1-25. NC1064.2 +114200 MOVE DNAME22 TO COMPUTED-18V0. NC1064.2 +114300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +114400 PERFORM FAIL. NC1064.2 +114500 GO TO SUB-WRITE-F1-25. NC1064.2 +114600 SUB-DELETE-F1-25. NC1064.2 +114700 PERFORM DE-LETE. NC1064.2 +114800 SUB-WRITE-F1-25. NC1064.2 +114900 MOVE "SUB-TEST-F1-25" TO PAR-NAME. NC1064.2 +115000 PERFORM PRINT-DETAIL. NC1064.2 +115100 SUB-INIT-F1-26. NC1064.2 +115200 MOVE 21 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1064.2 +115300 MOVE 21 TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1064.2 +115400 MOVE 21 TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1064.2 +115500 MOVE 21 TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1064.2 +115600 MOVE 21 TO DNAME42. NC1064.2 +115700 SUB-TEST-F1-26-0. NC1064.2 +115800 SUBTRACT DNAME1 NC1064.2 +115900 DNAME2 NC1064.2 +116000 DNAME3 NC1064.2 +116100 DNAME4 NC1064.2 +116200 DNAME5 NC1064.2 +116300 DNAME6 NC1064.2 +116400 DNAME7 NC1064.2 +116500 DNAME8 NC1064.2 +116600 DNAME9 NC1064.2 +116700 DNAME10 NC1064.2 +116800 DNAME11 NC1064.2 +116900 DNAME12 NC1064.2 +117000 DNAME13 NC1064.2 +117100 DNAME14 NC1064.2 +117200 DNAME15 NC1064.2 +117300 DNAME16 NC1064.2 +117400 DNAME17 NC1064.2 +117500 DNAME18 NC1064.2 +117600 DNAME19 NC1064.2 +117700 DNAME20 NC1064.2 +117800 DNAME21 NC1064.2 +117900 FROM DNAME22 NC1064.2 +118000 DNAME23 NC1064.2 +118100 DNAME24 NC1064.2 +118200 DNAME25 NC1064.2 +118300 DNAME26 NC1064.2 +118400 DNAME27 NC1064.2 +118500 DNAME28 NC1064.2 +118600 DNAME29 NC1064.2 +118700 DNAME30 NC1064.2 +118800 DNAME31 NC1064.2 +118900 DNAME32 NC1064.2 +119000 DNAME33 NC1064.2 +119100 DNAME34 NC1064.2 +119200 DNAME35 NC1064.2 +119300 DNAME36 NC1064.2 +119400 DNAME37 NC1064.2 +119500 DNAME38 NC1064.2 +119600 DNAME39 NC1064.2 +119700 DNAME40 NC1064.2 +119800 DNAME41 NC1064.2 +119900 DNAME42. NC1064.2 +120000 SUB-TEST-F1-26-1. NC1064.2 +120100 IF DNAME22 EQUAL TO ZERO NC1064.2 +120200 PERFORM PASS NC1064.2 +120300 GO TO SUB-WRITE-F1-26-1. NC1064.2 +120400 MOVE DNAME22 TO COMPUTED-18V0. NC1064.2 +120500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +120600 PERFORM FAIL. NC1064.2 +120700 GO TO SUB-WRITE-F1-26-1. NC1064.2 +120800 SUB-DELETE-F1-26-1. NC1064.2 +120900 PERFORM DE-LETE. NC1064.2 +121000 SUB-WRITE-F1-26-1. NC1064.2 +121100 MOVE "SUB-TEST-F1-26-1" TO PAR-NAME. NC1064.2 +121200 PERFORM PRINT-DETAIL. NC1064.2 +121300 SUB-TEST-F1-26-2. NC1064.2 +121400 IF DNAME23 EQUAL TO ZERO NC1064.2 +121500 PERFORM PASS NC1064.2 +121600 GO TO SUB-WRITE-F1-26-2. NC1064.2 +121700 MOVE ZERO TO CORRECT-18V0. NC1064.2 +121800 MOVE DNAME23 TO COMPUTED-18V0. NC1064.2 +121900 PERFORM FAIL. NC1064.2 +122000 GO TO SUB-WRITE-F1-26-2. NC1064.2 +122100 SUB-DELETE-F1-26-2. NC1064.2 +122200 PERFORM DE-LETE. NC1064.2 +122300 SUB-WRITE-F1-26-2. NC1064.2 +122400 MOVE "SUB-TEST-F1-26-2 " TO PAR-NAME. NC1064.2 +122500 PERFORM PRINT-DETAIL. NC1064.2 +122600 SUB-TEST-F1-26-3. NC1064.2 +122700 IF DNAME24 EQUAL TO ZERO NC1064.2 +122800 PERFORM PASS NC1064.2 +122900 GO TO SUB-WRITE-F1-26-3. NC1064.2 +123000 MOVE ZERO TO CORRECT-18V0. NC1064.2 +123100 MOVE DNAME24 TO COMPUTED-18V0. NC1064.2 +123200 PERFORM FAIL. NC1064.2 +123300 GO TO SUB-WRITE-F1-26-3. NC1064.2 +123400 SUB-DELETE-F1-26-3. NC1064.2 +123500 PERFORM DE-LETE. NC1064.2 +123600 SUB-WRITE-F1-26-3. NC1064.2 +123700 MOVE "SUB-TEST-F1-26-3 " TO PAR-NAME. NC1064.2 +123800 PERFORM PRINT-DETAIL. NC1064.2 +123900 SUB-TEST-F1-26-4. NC1064.2 +124000 IF DNAME25 EQUAL TO ZERO NC1064.2 +124100 PERFORM PASS NC1064.2 +124200 GO TO SUB-WRITE-F1-26-4. NC1064.2 +124300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +124400 MOVE DNAME25 TO COMPUTED-18V0. NC1064.2 +124500 PERFORM FAIL. NC1064.2 +124600 GO TO SUB-WRITE-F1-26-4. NC1064.2 +124700 SUB-DELETE-F1-26-4. NC1064.2 +124800 PERFORM DE-LETE. NC1064.2 +124900 SUB-WRITE-F1-26-4. NC1064.2 +125000 MOVE "SUB-TEST-F1-26-4 " TO PAR-NAME. NC1064.2 +125100 PERFORM PRINT-DETAIL. NC1064.2 +125200 SUB-TEST-F1-26-5. NC1064.2 +125300 IF DNAME26 EQUAL TO ZERO NC1064.2 +125400 PERFORM PASS NC1064.2 +125500 GO TO SUB-WRITE-F1-26-5. NC1064.2 +125600 MOVE ZERO TO CORRECT-18V0. NC1064.2 +125700 MOVE DNAME26 TO COMPUTED-18V0. NC1064.2 +125800 PERFORM FAIL. NC1064.2 +125900 GO TO SUB-WRITE-F1-26-5. NC1064.2 +126000 SUB-DELETE-F1-26-5. NC1064.2 +126100 PERFORM DE-LETE. NC1064.2 +126200 SUB-WRITE-F1-26-5. NC1064.2 +126300 MOVE "SUB-TEST-F1-26-5 " TO PAR-NAME. NC1064.2 +126400 PERFORM PRINT-DETAIL. NC1064.2 +126500 SUB-TEST-F1-26-6. NC1064.2 +126600 IF DNAME27 EQUAL TO ZERO NC1064.2 +126700 PERFORM PASS NC1064.2 +126800 GO TO SUB-WRITE-F1-26-6. NC1064.2 +126900 MOVE ZERO TO CORRECT-18V0. NC1064.2 +127000 MOVE DNAME27 TO COMPUTED-18V0. NC1064.2 +127100 PERFORM FAIL. NC1064.2 +127200 GO TO SUB-WRITE-F1-26-6. NC1064.2 +127300 SUB-DELETE-F1-26-6. NC1064.2 +127400 PERFORM DE-LETE. NC1064.2 +127500 SUB-WRITE-F1-26-6. NC1064.2 +127600 MOVE "SUB-TEST-F1-26-6 " TO PAR-NAME. NC1064.2 +127700 PERFORM PRINT-DETAIL. NC1064.2 +127800 SUB-TEST-F1-26-7. NC1064.2 +127900 IF DNAME28 EQUAL TO ZERO NC1064.2 +128000 PERFORM PASS NC1064.2 +128100 GO TO SUB-WRITE-F1-26-7. NC1064.2 +128200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +128300 MOVE DNAME28 TO COMPUTED-18V0. NC1064.2 +128400 PERFORM FAIL. NC1064.2 +128500 GO TO SUB-WRITE-F1-26-7. NC1064.2 +128600 SUB-DELETE-F1-26-7. NC1064.2 +128700 PERFORM DE-LETE. NC1064.2 +128800 SUB-WRITE-F1-26-7. NC1064.2 +128900 MOVE "SUB-TEST-F1-26-7 " TO PAR-NAME. NC1064.2 +129000 PERFORM PRINT-DETAIL. NC1064.2 +129100 SUB-TEST-F1-26-8. NC1064.2 +129200 IF DNAME29 EQUAL TO ZERO NC1064.2 +129300 PERFORM PASS NC1064.2 +129400 GO TO SUB-WRITE-F1-26-8. NC1064.2 +129500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +129600 MOVE DNAME29 TO COMPUTED-18V0. NC1064.2 +129700 PERFORM FAIL. NC1064.2 +129800 GO TO SUB-WRITE-F1-26-8. NC1064.2 +129900 SUB-DELETE-F1-26-8. NC1064.2 +130000 PERFORM DE-LETE. NC1064.2 +130100 SUB-WRITE-F1-26-8. NC1064.2 +130200 MOVE "SUB-TEST-F1-26-8 " TO PAR-NAME. NC1064.2 +130300 PERFORM PRINT-DETAIL. NC1064.2 +130400 SUB-TEST-F1-26-9. NC1064.2 +130500 IF DNAME30 EQUAL TO ZERO NC1064.2 +130600 PERFORM PASS NC1064.2 +130700 GO TO SUB-WRITE-F1-26-9. NC1064.2 +130800 MOVE ZERO TO CORRECT-18V0. NC1064.2 +130900 MOVE DNAME30 TO COMPUTED-18V0. NC1064.2 +131000 PERFORM FAIL. NC1064.2 +131100 GO TO SUB-WRITE-F1-26-9. NC1064.2 +131200 SUB-DELETE-F1-26-9. NC1064.2 +131300 PERFORM DE-LETE. NC1064.2 +131400 SUB-WRITE-F1-26-9. NC1064.2 +131500 MOVE "SUB-TEST-F1-26-9 " TO PAR-NAME. NC1064.2 +131600 PERFORM PRINT-DETAIL. NC1064.2 +131700 SUB-TEST-F1-26-10. NC1064.2 +131800 IF DNAME31 EQUAL TO ZERO NC1064.2 +131900 PERFORM PASS NC1064.2 +132000 GO TO SUB-WRITE-F1-26-10. NC1064.2 +132100 MOVE ZERO TO CORRECT-18V0. NC1064.2 +132200 MOVE DNAME31 TO COMPUTED-18V0. NC1064.2 +132300 PERFORM FAIL. NC1064.2 +132400 GO TO SUB-WRITE-F1-26-10. NC1064.2 +132500 SUB-DELETE-F1-26-10. NC1064.2 +132600 PERFORM DE-LETE. NC1064.2 +132700 SUB-WRITE-F1-26-10. NC1064.2 +132800 MOVE "SUB-TEST-F1-26-10 " TO PAR-NAME. NC1064.2 +132900 PERFORM PRINT-DETAIL. NC1064.2 +133000 SUB-TEST-F1-26-11. NC1064.2 +133100 IF DNAME32 EQUAL TO ZERO NC1064.2 +133200 PERFORM PASS NC1064.2 +133300 GO TO SUB-WRITE-F1-26-11. NC1064.2 +133400 MOVE ZERO TO CORRECT-18V0. NC1064.2 +133500 MOVE DNAME32 TO COMPUTED-18V0. NC1064.2 +133600 PERFORM FAIL. NC1064.2 +133700 GO TO SUB-WRITE-F1-26-11. NC1064.2 +133800 SUB-DELETE-F1-26-11. NC1064.2 +133900 PERFORM DE-LETE. NC1064.2 +134000 SUB-WRITE-F1-26-11. NC1064.2 +134100 MOVE "SUB-TEST-F1-26-11 " TO PAR-NAME. NC1064.2 +134200 PERFORM PRINT-DETAIL. NC1064.2 +134300 SUB-TEST-F1-26-12. NC1064.2 +134400 IF DNAME33 EQUAL TO ZERO NC1064.2 +134500 PERFORM PASS NC1064.2 +134600 GO TO SUB-WRITE-F1-26-12. NC1064.2 +134700 MOVE ZERO TO CORRECT-18V0. NC1064.2 +134800 MOVE DNAME33 TO COMPUTED-18V0. NC1064.2 +134900 PERFORM FAIL. NC1064.2 +135000 GO TO SUB-WRITE-F1-26-12. NC1064.2 +135100 SUB-DELETE-F1-26-12. NC1064.2 +135200 PERFORM DE-LETE. NC1064.2 +135300 SUB-WRITE-F1-26-12. NC1064.2 +135400 MOVE "SUB-TEST-F1-26-12 " TO PAR-NAME. NC1064.2 +135500 PERFORM PRINT-DETAIL. NC1064.2 +135600 SUB-TEST-F1-26-13. NC1064.2 +135700 IF DNAME34 EQUAL TO ZERO NC1064.2 +135800 PERFORM PASS NC1064.2 +135900 GO TO SUB-WRITE-F1-26-13. NC1064.2 +136000 MOVE ZERO TO CORRECT-18V0. NC1064.2 +136100 MOVE DNAME34 TO COMPUTED-18V0. NC1064.2 +136200 PERFORM FAIL. NC1064.2 +136300 GO TO SUB-WRITE-F1-26-13. NC1064.2 +136400 SUB-DELETE-F1-26-13. NC1064.2 +136500 PERFORM DE-LETE. NC1064.2 +136600 SUB-WRITE-F1-26-13. NC1064.2 +136700 MOVE "SUB-TEST-F1-26-13 " TO PAR-NAME. NC1064.2 +136800 PERFORM PRINT-DETAIL. NC1064.2 +136900 SUB-TEST-F1-26-14. NC1064.2 +137000 IF DNAME35 EQUAL TO ZERO NC1064.2 +137100 PERFORM PASS NC1064.2 +137200 GO TO SUB-WRITE-F1-26-14. NC1064.2 +137300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +137400 MOVE DNAME35 TO COMPUTED-18V0. NC1064.2 +137500 PERFORM FAIL. NC1064.2 +137600 GO TO SUB-WRITE-F1-26-14. NC1064.2 +137700 SUB-DELETE-F1-26-14. NC1064.2 +137800 PERFORM DE-LETE. NC1064.2 +137900 SUB-WRITE-F1-26-14. NC1064.2 +138000 MOVE "SUB-TEST-F1-26-14 " TO PAR-NAME. NC1064.2 +138100 PERFORM PRINT-DETAIL. NC1064.2 +138200 SUB-TEST-F1-26-15. NC1064.2 +138300 IF DNAME36 EQUAL TO ZERO NC1064.2 +138400 PERFORM PASS NC1064.2 +138500 GO TO SUB-WRITE-F1-26-15. NC1064.2 +138600 MOVE ZERO TO CORRECT-18V0. NC1064.2 +138700 MOVE DNAME36 TO COMPUTED-18V0. NC1064.2 +138800 PERFORM FAIL. NC1064.2 +138900 GO TO SUB-WRITE-F1-26-15. NC1064.2 +139000 SUB-DELETE-F1-26-15. NC1064.2 +139100 PERFORM DE-LETE. NC1064.2 +139200 SUB-WRITE-F1-26-15. NC1064.2 +139300 MOVE "SUB-TEST-F1-26-15 " TO PAR-NAME. NC1064.2 +139400 PERFORM PRINT-DETAIL. NC1064.2 +139500 SUB-TEST-F1-26-16. NC1064.2 +139600 IF DNAME37 EQUAL TO ZERO NC1064.2 +139700 PERFORM PASS NC1064.2 +139800 GO TO SUB-WRITE-F1-26-16. NC1064.2 +139900 MOVE ZERO TO CORRECT-18V0. NC1064.2 +140000 MOVE DNAME37 TO COMPUTED-18V0. NC1064.2 +140100 PERFORM FAIL. NC1064.2 +140200 GO TO SUB-WRITE-F1-26-16. NC1064.2 +140300 SUB-DELETE-F1-26-16. NC1064.2 +140400 PERFORM DE-LETE. NC1064.2 +140500 SUB-WRITE-F1-26-16. NC1064.2 +140600 MOVE "SUB-TEST-F1-26-16 " TO PAR-NAME. NC1064.2 +140700 PERFORM PRINT-DETAIL. NC1064.2 +140800 SUB-TEST-F1-26-17. NC1064.2 +140900 IF DNAME38 EQUAL TO ZERO NC1064.2 +141000 PERFORM PASS NC1064.2 +141100 GO TO SUB-WRITE-F1-26-17. NC1064.2 +141200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +141300 MOVE DNAME38 TO COMPUTED-18V0. NC1064.2 +141400 PERFORM FAIL. NC1064.2 +141500 GO TO SUB-WRITE-F1-26-17. NC1064.2 +141600 SUB-DELETE-F1-26-17. NC1064.2 +141700 PERFORM DE-LETE. NC1064.2 +141800 SUB-WRITE-F1-26-17. NC1064.2 +141900 MOVE "SUB-TEST-F1-26-17 " TO PAR-NAME. NC1064.2 +142000 PERFORM PRINT-DETAIL. NC1064.2 +142100 SUB-TEST-F1-26-18. NC1064.2 +142200 IF DNAME39 EQUAL TO ZERO NC1064.2 +142300 PERFORM PASS NC1064.2 +142400 GO TO SUB-WRITE-F1-26-18. NC1064.2 +142500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +142600 MOVE DNAME39 TO COMPUTED-18V0. NC1064.2 +142700 PERFORM FAIL. NC1064.2 +142800 GO TO SUB-WRITE-F1-26-18. NC1064.2 +142900 SUB-DELETE-F1-26-18. NC1064.2 +143000 PERFORM DE-LETE. NC1064.2 +143100 SUB-WRITE-F1-26-18. NC1064.2 +143200 MOVE "SUB-TEST-F1-26-18 " TO PAR-NAME. NC1064.2 +143300 PERFORM PRINT-DETAIL. NC1064.2 +143400 SUB-TEST-F1-26-19. NC1064.2 +143500 IF DNAME40 EQUAL TO ZERO NC1064.2 +143600 PERFORM PASS NC1064.2 +143700 GO TO SUB-WRITE-F1-26-19. NC1064.2 +143800 MOVE ZERO TO CORRECT-18V0. NC1064.2 +143900 MOVE DNAME40 TO COMPUTED-18V0. NC1064.2 +144000 PERFORM FAIL. NC1064.2 +144100 GO TO SUB-WRITE-F1-26-19. NC1064.2 +144200 SUB-DELETE-F1-26-19. NC1064.2 +144300 PERFORM DE-LETE. NC1064.2 +144400 SUB-WRITE-F1-26-19. NC1064.2 +144500 MOVE "SUB-TEST-F1-26-19 " TO PAR-NAME. NC1064.2 +144600 PERFORM PRINT-DETAIL. NC1064.2 +144700 SUB-TEST-F1-26-20. NC1064.2 +144800 IF DNAME41 EQUAL TO ZERO NC1064.2 +144900 PERFORM PASS NC1064.2 +145000 GO TO SUB-WRITE-F1-26-20. NC1064.2 +145100 MOVE DNAME41 TO COMPUTED-18V0. NC1064.2 +145200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +145300 PERFORM FAIL. NC1064.2 +145400 GO TO SUB-WRITE-F1-26-20. NC1064.2 +145500 SUB-DELETE-F1-26-20. NC1064.2 +145600 PERFORM DE-LETE. NC1064.2 +145700 SUB-WRITE-F1-26-20. NC1064.2 +145800 MOVE "SUB-TEST-F1-26-20 " TO PAR-NAME. NC1064.2 +145900 PERFORM PRINT-DETAIL. NC1064.2 +146000 SUB-TEST-F1-26-21. NC1064.2 +146100 IF DNAME42 EQUAL TO ZERO NC1064.2 +146200 PERFORM PASS NC1064.2 +146300 GO TO SUB-WRITE-F1-26-21. NC1064.2 +146400 MOVE DNAME42 TO COMPUTED-18V0. NC1064.2 +146500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +146600 PERFORM FAIL. NC1064.2 +146700 GO TO SUB-WRITE-F1-26-21. NC1064.2 +146800 SUB-DELETE-F1-26-21. NC1064.2 +146900 PERFORM DE-LETE. NC1064.2 +147000 SUB-WRITE-F1-26-21. NC1064.2 +147100 MOVE "SUB-TEST-F1-26-21 " TO PAR-NAME. NC1064.2 +147200 PERFORM PRINT-DETAIL. NC1064.2 +147300* NC1064.2 +147400 SUB-INIT-F1-27. NC1064.2 +147500* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +147600 MOVE "VI-134 6.25.4 GR1" TO ANSI-REFERENCE. NC1064.2 +147700 MOVE "SUB-TEST-F1-27" TO PAR-NAME. NC1064.2 +147800 MOVE ZERO TO REC-CT. NC1064.2 +147900 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +148000 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +148100 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +148200 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +148300 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +148400 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +148500 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +148600 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +148700 SUB-TEST-F1-27-0. NC1064.2 +148800 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +148900 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +149000 ROUNDED WRK-DU-16V2-1. NC1064.2 +149100 GO TO SUB-TEST-F1-27-1. NC1064.2 +149200 SUB-DELETE-F1-27. NC1064.2 +149300 PERFORM DE-LETE. NC1064.2 +149400 PERFORM PRINT-DETAIL. NC1064.2 +149500 GO TO SUB-INIT-F1-28. NC1064.2 +149600 SUB-TEST-F1-27-1. NC1064.2 +149700 MOVE "SUB-TEST-F1-27-1" TO PAR-NAME. NC1064.2 +149800 MOVE 1 TO REC-CT. NC1064.2 +149900 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +150000 ELSE NC1064.2 +150100 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +150200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +150300 ADD 1 TO REC-CT. NC1064.2 +150400 SUB-TEST-F1-27-2. NC1064.2 +150500 MOVE "SUB-TEST-F1-27-2" TO PAR-NAME. NC1064.2 +150600 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +150700 ELSE NC1064.2 +150800 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +150900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +151000 ADD 1 TO REC-CT. NC1064.2 +151100 SUB-TEST-F1-27-3. NC1064.2 +151200 MOVE "SUB-TEST-F1-27-3" TO PAR-NAME. NC1064.2 +151300 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +151400 ELSE NC1064.2 +151500 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +151600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +151700 ADD 1 TO REC-CT. NC1064.2 +151800 SUB-TEST-F1-27-4. NC1064.2 +151900 MOVE "SUB-TEST-F1-27-4" TO PAR-NAME. NC1064.2 +152000 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +152100 ELSE NC1064.2 +152200 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +152300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +152400 ADD 1 TO REC-CT. NC1064.2 +152500 SUB-TEST-F1-27-5. NC1064.2 +152600 MOVE "SUB-TEST-F1-27-5" TO PAR-NAME. NC1064.2 +152700 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +152800 PERFORM PRINT-DETAIL ELSE NC1064.2 +152900 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +153000 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +153100 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +153200* NC1064.2 +153300 SUB-INIT-F1-28. NC1064.2 +153400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +153500* ==--> NO SIZE ERROR <--== NC1064.2 +153600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +153700 MOVE "SUB-TEST-F1-28" TO PAR-NAME. NC1064.2 +153800 MOVE ZERO TO REC-CT. NC1064.2 +153900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +154000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +154100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +154200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +154300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +154400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +154500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +154600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +154700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +154800 SUB-TEST-F1-28-0. NC1064.2 +154900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +155000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +155100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +155200 ON SIZE ERROR NC1064.2 +155300 MOVE "A" TO SIZE-ERR2. NC1064.2 +155400 GO TO SUB-TEST-F1-28-1. NC1064.2 +155500 SUB-DELETE-F1-28. NC1064.2 +155600 PERFORM DE-LETE. NC1064.2 +155700 PERFORM PRINT-DETAIL. NC1064.2 +155800 GO TO SUB-INIT-F1-29. NC1064.2 +155900 SUB-TEST-F1-28-1. NC1064.2 +156000 MOVE "SUB-TEST-F1-28-1" TO PAR-NAME. NC1064.2 +156100 MOVE 1 TO REC-CT. NC1064.2 +156200 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +156300 ELSE NC1064.2 +156400 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +156500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +156600 ADD 1 TO REC-CT. NC1064.2 +156700 SUB-TEST-F1-28-2. NC1064.2 +156800 MOVE "SUB-TEST-F1-28-2" TO PAR-NAME. NC1064.2 +156900 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +157000 ELSE NC1064.2 +157100 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +157200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +157300 ADD 1 TO REC-CT. NC1064.2 +157400 SUB-TEST-F1-28-3. NC1064.2 +157500 MOVE "SUB-TEST-F1-28-3" TO PAR-NAME. NC1064.2 +157600 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +157700 ELSE NC1064.2 +157800 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +157900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +158000 ADD 1 TO REC-CT. NC1064.2 +158100 SUB-TEST-F1-28-4. NC1064.2 +158200 MOVE "SUB-TEST-F1-28-4" TO PAR-NAME. NC1064.2 +158300 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +158400 ELSE NC1064.2 +158500 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +158600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +158700 ADD 1 TO REC-CT. NC1064.2 +158800 SUB-TEST-F1-28-5. NC1064.2 +158900 MOVE "SUB-TEST-F1-28-5" TO PAR-NAME. NC1064.2 +159000 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +159100 PERFORM PRINT-DETAIL ELSE NC1064.2 +159200 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +159300 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +159400 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +159500 ADD 1 TO REC-CT. NC1064.2 +159600 SUB-TEST-F1-28-6. NC1064.2 +159700 MOVE "SUB-TEST-F1-28-6" TO PAR-NAME. NC1064.2 +159800 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +159900 PERFORM PRINT-DETAIL ELSE NC1064.2 +160000 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +160100 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +160200 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +160300 PERFORM PRINT-DETAIL. NC1064.2 +160400 ADD 1 TO REC-CT. NC1064.2 +160500 SUB-TEST-F1-28-7. NC1064.2 +160600 MOVE "SUB-TEST-F1-28-7" TO PAR-NAME. NC1064.2 +160700 IF SIZE-ERR2 = SPACE NC1064.2 +160800 PERFORM PASS NC1064.2 +160900 PERFORM PRINT-DETAIL NC1064.2 +161000 ELSE NC1064.2 +161100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +161200 TO RE-MARK NC1064.2 +161300 MOVE SPACE TO CORRECT-X NC1064.2 +161400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +161500 PERFORM FAIL NC1064.2 +161600 PERFORM PRINT-DETAIL. NC1064.2 +161700* NC1064.2 +161800 SUB-INIT-F1-29. NC1064.2 +161900* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +162000* ==--> SIZE ERROR <--== NC1064.2 +162100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +162200 MOVE "SUB-TEST-F1-29" TO PAR-NAME. NC1064.2 +162300 MOVE ZERO TO REC-CT. NC1064.2 +162400 MOVE SPACE TO SIZE-ERR2. NC1064.2 +162500 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +162600 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +162700 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +162800 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +162900 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +163000 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +163100 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +163200 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +163300 SUB-TEST-F1-29-0. NC1064.2 +163400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +163500 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +163600 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +163700 ON SIZE ERROR NC1064.2 +163800 MOVE "A" TO SIZE-ERR2. NC1064.2 +163900 GO TO SUB-TEST-F1-29-1. NC1064.2 +164000 SUB-DELETE-F1-29. NC1064.2 +164100 PERFORM DE-LETE. NC1064.2 +164200 PERFORM PRINT-DETAIL. NC1064.2 +164300 GO TO SUB-INIT-F1-30. NC1064.2 +164400 SUB-TEST-F1-29-1. NC1064.2 +164500 MOVE "SUB-TEST-F1-29-1" TO PAR-NAME. NC1064.2 +164600 MOVE 1 TO REC-CT. NC1064.2 +164700 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +164800 ELSE NC1064.2 +164900 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +165000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +165100 ADD 1 TO REC-CT. NC1064.2 +165200 SUB-TEST-F1-29-2. NC1064.2 +165300 MOVE "SUB-TEST-F1-29-2" TO PAR-NAME. NC1064.2 +165400 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +165500 ELSE NC1064.2 +165600 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +165700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +165800 ADD 1 TO REC-CT. NC1064.2 +165900 SUB-TEST-F1-29-3. NC1064.2 +166000 MOVE "SUB-TEST-F1-29-3" TO PAR-NAME. NC1064.2 +166100 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +166200 ELSE NC1064.2 +166300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +166400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +166500 ADD 1 TO REC-CT. NC1064.2 +166600 SUB-TEST-F1-29-4. NC1064.2 +166700 MOVE "SUB-TEST-F1-29-4" TO PAR-NAME. NC1064.2 +166800 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +166900 ELSE NC1064.2 +167000 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +167100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +167200 ADD 1 TO REC-CT. NC1064.2 +167300 SUB-TEST-F1-29-5. NC1064.2 +167400 MOVE "SUB-TEST-F1-29-5" TO PAR-NAME. NC1064.2 +167500 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +167600 PERFORM PRINT-DETAIL ELSE NC1064.2 +167700 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +167800 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +167900 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +168000 ADD 1 TO REC-CT. NC1064.2 +168100 SUB-TEST-F1-29-6. NC1064.2 +168200 MOVE "SUB-TEST-F1-29-6" TO PAR-NAME. NC1064.2 +168300 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +168400 PERFORM PRINT-DETAIL ELSE NC1064.2 +168500 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +168600 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +168700 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +168800 PERFORM PRINT-DETAIL. NC1064.2 +168900 ADD 1 TO REC-CT. NC1064.2 +169000 SUB-TEST-F1-29-7. NC1064.2 +169100 MOVE "SUB-TEST-F1-29-7" TO PAR-NAME. NC1064.2 +169200 IF SIZE-ERR2 = "A" NC1064.2 +169300 PERFORM PASS NC1064.2 +169400 PERFORM PRINT-DETAIL NC1064.2 +169500 ELSE NC1064.2 +169600 MOVE "ON SIZE ERROR SHOULD HAVE OCCURED" NC1064.2 +169700 TO RE-MARK NC1064.2 +169800 MOVE "A" TO CORRECT-X NC1064.2 +169900 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +170000 PERFORM FAIL NC1064.2 +170100 PERFORM PRINT-DETAIL. NC1064.2 +170200* NC1064.2 +170300 SUB-INIT-F1-30. NC1064.2 +170400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +170500* ==--> NO SIZE ERROR <--== NC1064.2 +170600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +170700 MOVE "SUB-TEST-F1-30" TO PAR-NAME. NC1064.2 +170800 MOVE ZERO TO REC-CT. NC1064.2 +170900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +171000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +171100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +171200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +171300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +171400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +171500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +171600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +171700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +171800 SUB-TEST-F1-30-0. NC1064.2 +171900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +172000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +172100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +172200 NOT ON SIZE ERROR NC1064.2 +172300 MOVE "A" TO SIZE-ERR2. NC1064.2 +172400 GO TO SUB-TEST-F1-30-1. NC1064.2 +172500 SUB-DELETE-F1-30. NC1064.2 +172600 PERFORM DE-LETE. NC1064.2 +172700 PERFORM PRINT-DETAIL. NC1064.2 +172800 GO TO SUB-INIT-F1-31. NC1064.2 +172900 SUB-TEST-F1-30-1. NC1064.2 +173000 MOVE "SUB-TEST-F1-30-1" TO PAR-NAME. NC1064.2 +173100 MOVE 1 TO REC-CT. NC1064.2 +173200 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +173300 ELSE NC1064.2 +173400 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +173500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +173600 ADD 1 TO REC-CT. NC1064.2 +173700 SUB-TEST-F1-30-2. NC1064.2 +173800 MOVE "SUB-TEST-F1-30-2" TO PAR-NAME. NC1064.2 +173900 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +174000 ELSE NC1064.2 +174100 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +174200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +174300 ADD 1 TO REC-CT. NC1064.2 +174400 SUB-TEST-F1-30-3. NC1064.2 +174500 MOVE "SUB-TEST-F1-30-3" TO PAR-NAME. NC1064.2 +174600 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +174700 ELSE NC1064.2 +174800 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +174900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +175000 ADD 1 TO REC-CT. NC1064.2 +175100 SUB-TEST-F1-30-4. NC1064.2 +175200 MOVE "SUB-TEST-F1-30-4" TO PAR-NAME. NC1064.2 +175300 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +175400 ELSE NC1064.2 +175500 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +175600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +175700 ADD 1 TO REC-CT. NC1064.2 +175800 SUB-TEST-F1-30-5. NC1064.2 +175900 MOVE "SUB-TEST-F1-30-5" TO PAR-NAME. NC1064.2 +176000 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +176100 PERFORM PRINT-DETAIL ELSE NC1064.2 +176200 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +176300 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +176400 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +176500 ADD 1 TO REC-CT. NC1064.2 +176600 SUB-TEST-F1-30-6. NC1064.2 +176700 MOVE "SUB-TEST-F1-30-6" TO PAR-NAME. NC1064.2 +176800 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +176900 PERFORM PRINT-DETAIL ELSE NC1064.2 +177000 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +177100 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +177200 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +177300 PERFORM PRINT-DETAIL. NC1064.2 +177400 ADD 1 TO REC-CT. NC1064.2 +177500 SUB-TEST-F1-30-7. NC1064.2 +177600 MOVE "SUB-TEST-F1-30-7" TO PAR-NAME. NC1064.2 +177700 IF SIZE-ERR2 = "A" NC1064.2 +177800 PERFORM PASS NC1064.2 +177900 PERFORM PRINT-DETAIL NC1064.2 +178000 ELSE NC1064.2 +178100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +178200 TO RE-MARK NC1064.2 +178300 MOVE "A" TO CORRECT-X NC1064.2 +178400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +178500 PERFORM FAIL NC1064.2 +178600 PERFORM PRINT-DETAIL. NC1064.2 +178700* NC1064.2 +178800 SUB-INIT-F1-31. NC1064.2 +178900* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +179000* ==--> SIZE ERROR <--== NC1064.2 +179100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +179200 MOVE "SUB-TEST-F1-31" TO PAR-NAME. NC1064.2 +179300 MOVE ZERO TO REC-CT. NC1064.2 +179400 MOVE SPACE TO SIZE-ERR2. NC1064.2 +179500 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +179600 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +179700 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +179800 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +179900 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +180000 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +180100 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +180200 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +180300 SUB-TEST-F1-31-0. NC1064.2 +180400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +180500 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +180600 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +180700 NOT ON SIZE ERROR NC1064.2 +180800 MOVE "A" TO SIZE-ERR2. NC1064.2 +180900 GO TO SUB-TEST-F1-31-1. NC1064.2 +181000 SUB-DELETE-F1-31. NC1064.2 +181100 PERFORM DE-LETE. NC1064.2 +181200 PERFORM PRINT-DETAIL. NC1064.2 +181300 GO TO SUB-INIT-F1-32. NC1064.2 +181400 SUB-TEST-F1-31-1. NC1064.2 +181500 MOVE "SUB-TEST-F1-31-1" TO PAR-NAME. NC1064.2 +181600 MOVE 1 TO REC-CT. NC1064.2 +181700 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +181800 ELSE NC1064.2 +181900 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +182000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +182100 ADD 1 TO REC-CT. NC1064.2 +182200 SUB-TEST-F1-31-2. NC1064.2 +182300 MOVE "SUB-TEST-F1-31-2" TO PAR-NAME. NC1064.2 +182400 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +182500 ELSE NC1064.2 +182600 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +182700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +182800 ADD 1 TO REC-CT. NC1064.2 +182900 SUB-TEST-F1-31-3. NC1064.2 +183000 MOVE "SUB-TEST-F1-31-3" TO PAR-NAME. NC1064.2 +183100 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +183200 ELSE NC1064.2 +183300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +183400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +183500 ADD 1 TO REC-CT. NC1064.2 +183600 SUB-TEST-F1-31-4. NC1064.2 +183700 MOVE "SUB-TEST-F1-31-4" TO PAR-NAME. NC1064.2 +183800 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +183900 ELSE NC1064.2 +184000 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +184100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +184200 ADD 1 TO REC-CT. NC1064.2 +184300 SUB-TEST-F1-31-5. NC1064.2 +184400 MOVE "SUB-TEST-F1-31-5" TO PAR-NAME. NC1064.2 +184500 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +184600 PERFORM PRINT-DETAIL ELSE NC1064.2 +184700 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +184800 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +184900 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +185000 ADD 1 TO REC-CT. NC1064.2 +185100 SUB-TEST-F1-31-6. NC1064.2 +185200 MOVE "SUB-TEST-F1-31-6" TO PAR-NAME. NC1064.2 +185300 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +185400 PERFORM PRINT-DETAIL ELSE NC1064.2 +185500 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +185600 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +185700 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +185800 PERFORM PRINT-DETAIL. NC1064.2 +185900 ADD 1 TO REC-CT. NC1064.2 +186000 SUB-TEST-F1-31-7. NC1064.2 +186100 MOVE "SUB-TEST-F1-31-7" TO PAR-NAME. NC1064.2 +186200 IF SIZE-ERR2 = SPACE NC1064.2 +186300 PERFORM PASS NC1064.2 +186400 PERFORM PRINT-DETAIL NC1064.2 +186500 ELSE NC1064.2 +186600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +186700 TO RE-MARK NC1064.2 +186800 MOVE SPACE TO CORRECT-X NC1064.2 +186900 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +187000 PERFORM FAIL NC1064.2 +187100 PERFORM PRINT-DETAIL. NC1064.2 +187200* NC1064.2 +187300 SUB-INIT-F1-32. NC1064.2 +187400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +187500* ==--> NO SIZE ERROR <--== NC1064.2 +187600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +187700 MOVE "SUB-TEST-F1-32" TO PAR-NAME. NC1064.2 +187800 MOVE ZERO TO REC-CT. NC1064.2 +187900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +188000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +188100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +188200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +188300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +188400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +188500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +188600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +188700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +188800 SUB-TEST-F1-32-0. NC1064.2 +188900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +189000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +189100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +189200 ON SIZE ERROR NC1064.2 +189300 MOVE "Z" TO SIZE-ERR2 NC1064.2 +189400 NOT ON SIZE ERROR NC1064.2 +189500 MOVE "A" TO SIZE-ERR2. NC1064.2 +189600 GO TO SUB-TEST-F1-32-1. NC1064.2 +189700 SUB-DELETE-F1-32. NC1064.2 +189800 PERFORM DE-LETE. NC1064.2 +189900 PERFORM PRINT-DETAIL. NC1064.2 +190000 GO TO SUB-INIT-F1-33. NC1064.2 +190100 SUB-TEST-F1-32-1. NC1064.2 +190200 MOVE "SUB-TEST-F1-32-1" TO PAR-NAME. NC1064.2 +190300 MOVE 1 TO REC-CT. NC1064.2 +190400 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +190500 ELSE NC1064.2 +190600 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +190700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +190800 ADD 1 TO REC-CT. NC1064.2 +190900 SUB-TEST-F1-32-2. NC1064.2 +191000 MOVE "SUB-TEST-F1-32-2" TO PAR-NAME. NC1064.2 +191100 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +191200 ELSE NC1064.2 +191300 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +191400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +191500 ADD 1 TO REC-CT. NC1064.2 +191600 SUB-TEST-F1-32-3. NC1064.2 +191700 MOVE "SUB-TEST-F1-32-3" TO PAR-NAME. NC1064.2 +191800 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +191900 ELSE NC1064.2 +192000 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +192100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +192200 ADD 1 TO REC-CT. NC1064.2 +192300 SUB-TEST-F1-32-4. NC1064.2 +192400 MOVE "SUB-TEST-F1-32-4" TO PAR-NAME. NC1064.2 +192500 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +192600 ELSE NC1064.2 +192700 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +192800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +192900 ADD 1 TO REC-CT. NC1064.2 +193000 SUB-TEST-F1-32-5. NC1064.2 +193100 MOVE "SUB-TEST-F1-32-5" TO PAR-NAME. NC1064.2 +193200 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +193300 PERFORM PRINT-DETAIL ELSE NC1064.2 +193400 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +193500 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +193600 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +193700 ADD 1 TO REC-CT. NC1064.2 +193800 SUB-TEST-F1-32-6. NC1064.2 +193900 MOVE "SUB-TEST-F1-32-6" TO PAR-NAME. NC1064.2 +194000 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +194100 PERFORM PRINT-DETAIL ELSE NC1064.2 +194200 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +194300 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +194400 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +194500 PERFORM PRINT-DETAIL. NC1064.2 +194600 ADD 1 TO REC-CT. NC1064.2 +194700 SUB-TEST-F1-32-7. NC1064.2 +194800 MOVE "SUB-TEST-F1-32-7" TO PAR-NAME. NC1064.2 +194900 IF SIZE-ERR2 = "A" NC1064.2 +195000 PERFORM PASS NC1064.2 +195100 PERFORM PRINT-DETAIL NC1064.2 +195200 ELSE NC1064.2 +195300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +195400 TO RE-MARK NC1064.2 +195500 MOVE "A" TO CORRECT-X NC1064.2 +195600 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +195700 PERFORM FAIL NC1064.2 +195800 PERFORM PRINT-DETAIL. NC1064.2 +195900* NC1064.2 +196000 SUB-INIT-F1-33. NC1064.2 +196100* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +196200* ==--> SIZE ERROR <--== NC1064.2 +196300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +196400 MOVE "SUB-TEST-F1-33" TO PAR-NAME. NC1064.2 +196500 MOVE ZERO TO REC-CT. NC1064.2 +196600 MOVE SPACE TO SIZE-ERR2. NC1064.2 +196700 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +196800 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +196900 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +197000 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +197100 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +197200 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +197300 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +197400 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +197500 SUB-TEST-F1-33-0. NC1064.2 +197600 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +197700 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +197800 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +197900 ON SIZE ERROR NC1064.2 +198000 MOVE "A" TO SIZE-ERR2 NC1064.2 +198100 NOT ON SIZE ERROR NC1064.2 +198200 MOVE "Z" TO SIZE-ERR2. NC1064.2 +198300 GO TO SUB-TEST-F1-33-1. NC1064.2 +198400 SUB-DELETE-F1-33. NC1064.2 +198500 PERFORM DE-LETE. NC1064.2 +198600 PERFORM PRINT-DETAIL. NC1064.2 +198700 GO TO SUB-INIT-F1-34. NC1064.2 +198800 SUB-TEST-F1-33-1. NC1064.2 +198900 MOVE "SUB-TEST-F1-33-1" TO PAR-NAME. NC1064.2 +199000 MOVE 1 TO REC-CT. NC1064.2 +199100 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +199200 ELSE NC1064.2 +199300 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +199400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +199500 ADD 1 TO REC-CT. NC1064.2 +199600 SUB-TEST-F1-33-2. NC1064.2 +199700 MOVE "SUB-TEST-F1-33-2" TO PAR-NAME. NC1064.2 +199800 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +199900 ELSE NC1064.2 +200000 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +200100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +200200 ADD 1 TO REC-CT. NC1064.2 +200300 SUB-TEST-F1-33-3. NC1064.2 +200400 MOVE "SUB-TEST-F1-33-3" TO PAR-NAME. NC1064.2 +200500 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +200600 ELSE NC1064.2 +200700 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +200800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +200900 ADD 1 TO REC-CT. NC1064.2 +201000 SUB-TEST-F1-33-4. NC1064.2 +201100 MOVE "SUB-TEST-F1-33-4" TO PAR-NAME. NC1064.2 +201200 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +201300 ELSE NC1064.2 +201400 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +201500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +201600 ADD 1 TO REC-CT. NC1064.2 +201700 SUB-TEST-F1-33-5. NC1064.2 +201800 MOVE "SUB-TEST-F1-33-5" TO PAR-NAME. NC1064.2 +201900 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +202000 PERFORM PRINT-DETAIL ELSE NC1064.2 +202100 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +202200 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +202300 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +202400 ADD 1 TO REC-CT. NC1064.2 +202500 SUB-TEST-F1-33-6. NC1064.2 +202600 MOVE "SUB-TEST-F1-33-6" TO PAR-NAME. NC1064.2 +202700 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +202800 PERFORM PRINT-DETAIL ELSE NC1064.2 +202900 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +203000 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +203100 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +203200 PERFORM PRINT-DETAIL. NC1064.2 +203300 ADD 1 TO REC-CT. NC1064.2 +203400 SUB-TEST-F1-33-7. NC1064.2 +203500 MOVE "SUB-TEST-F1-33-7" TO PAR-NAME. NC1064.2 +203600 IF SIZE-ERR2 = "A" NC1064.2 +203700 PERFORM PASS NC1064.2 +203800 PERFORM PRINT-DETAIL NC1064.2 +203900 ELSE NC1064.2 +204000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +204100 TO RE-MARK NC1064.2 +204200 MOVE "A" TO CORRECT-X NC1064.2 +204300 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +204400 PERFORM FAIL NC1064.2 +204500 PERFORM PRINT-DETAIL. NC1064.2 +204600* NC1064.2 +204700 SUB-INIT-F1-34. NC1064.2 +204800* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1064.2 +204900* ==--> SIZE ERROR <--== NC1064.2 +205000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +205100 MOVE -11 TO WRK-DS-02V00. NC1064.2 +205200 MOVE SPACE TO WRK-XN-00001. NC1064.2 +205300 MOVE SPACE TO SIZE-ERR2. NC1064.2 +205400 MOVE SPACE TO SIZE-ERR3. NC1064.2 +205500 MOVE SPACE TO SIZE-ERR4. NC1064.2 +205600 MOVE 1 TO REC-CT. NC1064.2 +205700 SUB-TEST-F1-34-0. NC1064.2 +205800 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +205900 ON SIZE ERROR NC1064.2 +206000 MOVE "1" TO WRK-XN-00001 NC1064.2 +206100 MOVE "A" TO SIZE-ERR2 NC1064.2 +206200 MOVE "B" TO SIZE-ERR3 NC1064.2 +206300 END-SUBTRACT NC1064.2 +206400 MOVE "C" TO SIZE-ERR4. NC1064.2 +206500 GO TO SUB-TEST-F1-34-1. NC1064.2 +206600 SUB-DELETE-F1-34. NC1064.2 +206700 PERFORM DE-LETE. NC1064.2 +206800 PERFORM PRINT-DETAIL. NC1064.2 +206900 GO TO SUB-INIT-F1-35. NC1064.2 +207000 SUB-TEST-F1-34-1. NC1064.2 +207100 MOVE "SUB-TEST-F1-34-1" TO PAR-NAME. NC1064.2 +207200 IF WRK-XN-00001 = "1" NC1064.2 +207300 PERFORM PASS NC1064.2 +207400 PERFORM PRINT-DETAIL NC1064.2 +207500 ELSE NC1064.2 +207600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +207700 TO RE-MARK NC1064.2 +207800 MOVE "1" TO CORRECT-X NC1064.2 +207900 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +208000 PERFORM FAIL NC1064.2 +208100 PERFORM PRINT-DETAIL. NC1064.2 +208200 ADD 1 TO REC-CT. NC1064.2 +208300 SUB-TEST-F1-34-2. NC1064.2 +208400 MOVE "SUB-TEST-F1-34-2" TO PAR-NAME. NC1064.2 +208500 IF SIZE-ERR2 = "A" NC1064.2 +208600 PERFORM PASS NC1064.2 +208700 PERFORM PRINT-DETAIL NC1064.2 +208800 ELSE NC1064.2 +208900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +209000 TO RE-MARK NC1064.2 +209100 MOVE "A" TO CORRECT-X NC1064.2 +209200 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +209300 PERFORM FAIL NC1064.2 +209400 PERFORM PRINT-DETAIL. NC1064.2 +209500 ADD 1 TO REC-CT. NC1064.2 +209600 SUB-TEST-F1-34-3. NC1064.2 +209700 MOVE "SUB-TEST-F1-34-3" TO PAR-NAME. NC1064.2 +209800 IF SIZE-ERR3 = "B" NC1064.2 +209900 PERFORM PASS NC1064.2 +210000 PERFORM PRINT-DETAIL NC1064.2 +210100 ELSE NC1064.2 +210200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +210300 TO RE-MARK NC1064.2 +210400 MOVE "B" TO CORRECT-X NC1064.2 +210500 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +210600 PERFORM FAIL NC1064.2 +210700 PERFORM PRINT-DETAIL. NC1064.2 +210800 ADD 1 TO REC-CT. NC1064.2 +210900 SUB-TEST-F1-34-4. NC1064.2 +211000 MOVE "SUB-TEST-F1-34-4" TO PAR-NAME. NC1064.2 +211100 IF SIZE-ERR4 = "C" NC1064.2 +211200 PERFORM PASS NC1064.2 +211300 PERFORM PRINT-DETAIL NC1064.2 +211400 ELSE NC1064.2 +211500 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +211600 TO RE-MARK NC1064.2 +211700 MOVE "C" TO CORRECT-X NC1064.2 +211800 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +211900 PERFORM FAIL NC1064.2 +212000 PERFORM PRINT-DETAIL. NC1064.2 +212100 ADD 1 TO REC-CT. NC1064.2 +212200 SUB-TEST-F1-34-5. NC1064.2 +212300 MOVE "SUB-TEST-F1-34-5" TO PAR-NAME. NC1064.2 +212400 IF WRK-DS-02V00 = -11 NC1064.2 +212500 PERFORM PASS NC1064.2 +212600 PERFORM PRINT-DETAIL NC1064.2 +212700 ELSE NC1064.2 +212800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +212900 TO RE-MARK NC1064.2 +213000 MOVE -11 TO CORRECT-N NC1064.2 +213100 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +213200 PERFORM FAIL NC1064.2 +213300 PERFORM PRINT-DETAIL. NC1064.2 +213400* NC1064.2 +213500 SUB-INIT-F1-35. NC1064.2 +213600* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +213700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +213800 MOVE "SUB-TEST-F1-35" TO PAR-NAME. NC1064.2 +213900 MOVE SPACE TO WRK-XN-00001. NC1064.2 +214000 MOVE SPACE TO SIZE-ERR2. NC1064.2 +214100 MOVE SPACE TO SIZE-ERR3. NC1064.2 +214200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +214300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +214400 MOVE 1 TO REC-CT. NC1064.2 +214500 SUB-TEST-F1-35-0. NC1064.2 +214600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +214700 333333 NC1064.2 +214800 A06THREES-DS-03V03 NC1064.2 +214900 -0000009 NC1064.2 +215000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +215100 ON SIZE ERROR NC1064.2 +215200 MOVE "1" TO WRK-XN-00001 NC1064.2 +215300 MOVE "A" TO SIZE-ERR2 NC1064.2 +215400 MOVE "B" TO SIZE-ERR3 NC1064.2 +215500 END-SUBTRACT NC1064.2 +215600 MOVE "C" TO SIZE-ERR4. NC1064.2 +215700 GO TO SUB-TEST-F1-35-1. NC1064.2 +215800 SUB-DELETE-F1-35. NC1064.2 +215900 PERFORM DE-LETE. NC1064.2 +216000 PERFORM PRINT-DETAIL. NC1064.2 +216100 GO TO SUB-INIT-F1-36. NC1064.2 +216200 SUB-TEST-F1-35-1. NC1064.2 +216300 MOVE "SUB-TEST-F1-35-1" TO PAR-NAME. NC1064.2 +216400 IF WRK-XN-00001 = SPACE NC1064.2 +216500 PERFORM PASS NC1064.2 +216600 PERFORM PRINT-DETAIL NC1064.2 +216700 ELSE NC1064.2 +216800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +216900 TO RE-MARK NC1064.2 +217000 MOVE SPACE TO CORRECT-X NC1064.2 +217100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +217200 PERFORM FAIL NC1064.2 +217300 PERFORM PRINT-DETAIL. NC1064.2 +217400 ADD 1 TO REC-CT. NC1064.2 +217500 SUB-TEST-F1-35-2. NC1064.2 +217600 MOVE "SUB-TEST-F1-35-2" TO PAR-NAME. NC1064.2 +217700 IF SIZE-ERR2 = SPACE NC1064.2 +217800 PERFORM PASS NC1064.2 +217900 PERFORM PRINT-DETAIL NC1064.2 +218000 ELSE NC1064.2 +218100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +218200 TO RE-MARK NC1064.2 +218300 MOVE SPACE TO CORRECT-X NC1064.2 +218400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +218500 PERFORM FAIL NC1064.2 +218600 PERFORM PRINT-DETAIL. NC1064.2 +218700 ADD 1 TO REC-CT. NC1064.2 +218800 SUB-TEST-F1-35-3. NC1064.2 +218900 MOVE "SUB-TEST-F1-35-3" TO PAR-NAME. NC1064.2 +219000 IF SIZE-ERR3 = SPACE NC1064.2 +219100 PERFORM PASS NC1064.2 +219200 PERFORM PRINT-DETAIL NC1064.2 +219300 ELSE NC1064.2 +219400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +219500 TO RE-MARK NC1064.2 +219600 MOVE SPACE TO CORRECT-X NC1064.2 +219700 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +219800 PERFORM FAIL NC1064.2 +219900 PERFORM PRINT-DETAIL. NC1064.2 +220000 ADD 1 TO REC-CT. NC1064.2 +220100 SUB-TEST-F1-35-4. NC1064.2 +220200 MOVE "SUB-TEST-F1-35-4" TO PAR-NAME. NC1064.2 +220300 IF SIZE-ERR4 = "C" NC1064.2 +220400 PERFORM PASS NC1064.2 +220500 PERFORM PRINT-DETAIL NC1064.2 +220600 ELSE NC1064.2 +220700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +220800 TO RE-MARK NC1064.2 +220900 MOVE "C" TO CORRECT-X NC1064.2 +221000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +221100 PERFORM FAIL NC1064.2 +221200 PERFORM PRINT-DETAIL. NC1064.2 +221300 ADD 1 TO REC-CT. NC1064.2 +221400 SUB-TEST-F1-35-5. NC1064.2 +221500 MOVE "SUB-TEST-F1-35-5" TO PAR-NAME. NC1064.2 +221600 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +221700 PERFORM PASS NC1064.2 +221800 PERFORM PRINT-DETAIL NC1064.2 +221900 ELSE NC1064.2 +222000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +222100 TO RE-MARK NC1064.2 +222200 MOVE -666990.666333 TO CORRECT-N NC1064.2 +222300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +222400 PERFORM FAIL NC1064.2 +222500 PERFORM PRINT-DETAIL. NC1064.2 +222600* NC1064.2 +222700 SUB-INIT-F1-36. NC1064.2 +222800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +222900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +223000 MOVE "SUB-TEST-F1-36" TO PAR-NAME. NC1064.2 +223100 MOVE SPACE TO WRK-XN-00001. NC1064.2 +223200 MOVE SPACE TO SIZE-ERR2. NC1064.2 +223300 MOVE SPACE TO SIZE-ERR3. NC1064.2 +223400 MOVE SPACE TO SIZE-ERR4. NC1064.2 +223500 MOVE -11 TO WRK-DS-02V00. NC1064.2 +223600 MOVE 1 TO REC-CT. NC1064.2 +223700 SUB-TEST-F1-36-0. NC1064.2 +223800 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +223900 NOT ON SIZE ERROR NC1064.2 +224000 MOVE "1" TO WRK-XN-00001 NC1064.2 +224100 MOVE "A" TO SIZE-ERR2 NC1064.2 +224200 MOVE "B" TO SIZE-ERR3 NC1064.2 +224300 END-SUBTRACT NC1064.2 +224400 MOVE "C" TO SIZE-ERR4. NC1064.2 +224500 GO TO SUB-TEST-F1-36-1. NC1064.2 +224600 SUB-DELETE-F1-36. NC1064.2 +224700 PERFORM DE-LETE. NC1064.2 +224800 PERFORM PRINT-DETAIL. NC1064.2 +224900 GO TO SUB-INIT-F1-37. NC1064.2 +225000 SUB-TEST-F1-36-1. NC1064.2 +225100 MOVE "SUB-TEST-F1-36-1" TO PAR-NAME. NC1064.2 +225200 IF WRK-XN-00001 = SPACE NC1064.2 +225300 PERFORM PASS NC1064.2 +225400 PERFORM PRINT-DETAIL NC1064.2 +225500 ELSE NC1064.2 +225600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +225700 TO RE-MARK NC1064.2 +225800 MOVE SPACE TO CORRECT-X NC1064.2 +225900 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +226000 PERFORM FAIL NC1064.2 +226100 PERFORM PRINT-DETAIL. NC1064.2 +226200 ADD 1 TO REC-CT. NC1064.2 +226300 SUB-TEST-F1-36-2. NC1064.2 +226400 MOVE "SUB-TEST-F1-36-2" TO PAR-NAME. NC1064.2 +226500 IF SIZE-ERR2 = SPACE NC1064.2 +226600 PERFORM PASS NC1064.2 +226700 PERFORM PRINT-DETAIL NC1064.2 +226800 ELSE NC1064.2 +226900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +227000 TO RE-MARK NC1064.2 +227100 MOVE SPACE TO CORRECT-X NC1064.2 +227200 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +227300 PERFORM FAIL NC1064.2 +227400 PERFORM PRINT-DETAIL. NC1064.2 +227500 ADD 1 TO REC-CT. NC1064.2 +227600 SUB-TEST-F1-36-3. NC1064.2 +227700 MOVE "SUB-TEST-F1-36-3" TO PAR-NAME. NC1064.2 +227800 IF SIZE-ERR3 = SPACE NC1064.2 +227900 PERFORM PASS NC1064.2 +228000 PERFORM PRINT-DETAIL NC1064.2 +228100 ELSE NC1064.2 +228200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +228300 TO RE-MARK NC1064.2 +228400 MOVE SPACE TO CORRECT-X NC1064.2 +228500 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +228600 PERFORM FAIL NC1064.2 +228700 PERFORM PRINT-DETAIL NC1064.2 +228800 ADD 1 TO REC-CT. NC1064.2 +228900 SUB-TEST-F1-36-4. NC1064.2 +229000 MOVE "SUB-TEST-F1-36-4" TO PAR-NAME. NC1064.2 +229100 IF SIZE-ERR4 = "C" NC1064.2 +229200 PERFORM PASS NC1064.2 +229300 PERFORM PRINT-DETAIL NC1064.2 +229400 ELSE NC1064.2 +229500 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +229600 TO RE-MARK NC1064.2 +229700 MOVE "C" TO CORRECT-X NC1064.2 +229800 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +229900 PERFORM FAIL NC1064.2 +230000 PERFORM PRINT-DETAIL. NC1064.2 +230100 ADD 1 TO REC-CT. NC1064.2 +230200 SUB-TEST-F1-36-5. NC1064.2 +230300 MOVE "SUB-TEST-F1-36-5" TO PAR-NAME. NC1064.2 +230400 IF WRK-DS-02V00 = -11 NC1064.2 +230500 PERFORM PASS NC1064.2 +230600 PERFORM PRINT-DETAIL NC1064.2 +230700 ELSE NC1064.2 +230800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +230900 TO RE-MARK NC1064.2 +231000 MOVE -11 TO CORRECT-N NC1064.2 +231100 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +231200 PERFORM FAIL NC1064.2 +231300 PERFORM PRINT-DETAIL. NC1064.2 +231400* NC1064.2 +231500 SUB-INIT-F1-37. NC1064.2 +231600* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +231700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +231800 MOVE "SUB-TEST-F1-37" TO PAR-NAME. NC1064.2 +231900 MOVE SPACE TO WRK-XN-00001. NC1064.2 +232000 MOVE SPACE TO SIZE-ERR2. NC1064.2 +232100 MOVE SPACE TO SIZE-ERR3. NC1064.2 +232200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +232300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +232400 MOVE 1 TO REC-CT. NC1064.2 +232500 SUB-TEST-F1-37-0. NC1064.2 +232600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +232700 333333 NC1064.2 +232800 A06THREES-DS-03V03 NC1064.2 +232900 -0000009 NC1064.2 +233000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +233100 NOT ON SIZE ERROR NC1064.2 +233200 MOVE "1" TO WRK-XN-00001 NC1064.2 +233300 MOVE "A" TO SIZE-ERR2 NC1064.2 +233400 MOVE "B" TO SIZE-ERR3 NC1064.2 +233500 END-SUBTRACT NC1064.2 +233600 MOVE "C" TO SIZE-ERR4. NC1064.2 +233700 GO TO SUB-TEST-F1-37-1. NC1064.2 +233800 SUB-DELETE-F1-37. NC1064.2 +233900 PERFORM DE-LETE. NC1064.2 +234000 PERFORM PRINT-DETAIL. NC1064.2 +234100 GO TO SUB-INIT-F1-38. NC1064.2 +234200 SUB-TEST-F1-37-1. NC1064.2 +234300 MOVE "SUB-TEST-F1-37-1" TO PAR-NAME. NC1064.2 +234400 IF WRK-XN-00001 = "1" NC1064.2 +234500 PERFORM PASS NC1064.2 +234600 PERFORM PRINT-DETAIL NC1064.2 +234700 ELSE NC1064.2 +234800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +234900 TO RE-MARK NC1064.2 +235000 MOVE "1" TO CORRECT-X NC1064.2 +235100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +235200 PERFORM FAIL NC1064.2 +235300 PERFORM PRINT-DETAIL. NC1064.2 +235400 ADD 1 TO REC-CT. NC1064.2 +235500 SUB-TEST-F1-37-2. NC1064.2 +235600 MOVE "SUB-TEST-F1-37-2" TO PAR-NAME. NC1064.2 +235700 IF SIZE-ERR2 = "A" NC1064.2 +235800 PERFORM PASS NC1064.2 +235900 PERFORM PRINT-DETAIL NC1064.2 +236000 ELSE NC1064.2 +236100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +236200 TO RE-MARK NC1064.2 +236300 MOVE "A" TO CORRECT-X NC1064.2 +236400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +236500 PERFORM FAIL NC1064.2 +236600 PERFORM PRINT-DETAIL. NC1064.2 +236700 ADD 1 TO REC-CT. NC1064.2 +236800 SUB-TEST-F1-37-3. NC1064.2 +236900 MOVE "SUB-TEST-F1-37-3" TO PAR-NAME. NC1064.2 +237000 IF SIZE-ERR3 = "B" NC1064.2 +237100 PERFORM PASS NC1064.2 +237200 PERFORM PRINT-DETAIL NC1064.2 +237300 ELSE NC1064.2 +237400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +237500 TO RE-MARK NC1064.2 +237600 MOVE "B" TO CORRECT-X NC1064.2 +237700 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +237800 PERFORM FAIL NC1064.2 +237900 PERFORM PRINT-DETAIL. NC1064.2 +238000 ADD 1 TO REC-CT. NC1064.2 +238100 SUB-TEST-F1-37-4. NC1064.2 +238200 MOVE "SUB-TEST-F1-37-4" TO PAR-NAME. NC1064.2 +238300 IF SIZE-ERR4 = "C" NC1064.2 +238400 PERFORM PASS NC1064.2 +238500 PERFORM PRINT-DETAIL NC1064.2 +238600 ELSE NC1064.2 +238700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +238800 TO RE-MARK NC1064.2 +238900 MOVE "C" TO CORRECT-X NC1064.2 +239000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +239100 PERFORM FAIL NC1064.2 +239200 PERFORM PRINT-DETAIL. NC1064.2 +239300 ADD 1 TO REC-CT. NC1064.2 +239400 SUB-TEST-F1-37-5. NC1064.2 +239500 MOVE "SUB-TEST-F1-37-5" TO PAR-NAME. NC1064.2 +239600 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +239700 PERFORM PASS NC1064.2 +239800 PERFORM PRINT-DETAIL NC1064.2 +239900 ELSE NC1064.2 +240000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +240100 TO RE-MARK NC1064.2 +240200 MOVE -666990.666333 TO CORRECT-N NC1064.2 +240300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +240400 PERFORM FAIL NC1064.2 +240500 PERFORM PRINT-DETAIL. NC1064.2 +240600* NC1064.2 +240700 SUB-INIT-F1-38. NC1064.2 +240800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +240900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +241000 MOVE "SUB-TEST-F1-38" TO PAR-NAME. NC1064.2 +241100 MOVE "0" TO WRK-XN-00001. NC1064.2 +241200 MOVE "0" TO SIZE-ERR4. NC1064.2 +241300 MOVE -11 TO WRK-DS-02V00. NC1064.2 +241400 MOVE 1 TO REC-CT. NC1064.2 +241500 SUB-TEST-F1-38-0. NC1064.2 +241600 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +241700 ON SIZE ERROR NC1064.2 +241800 MOVE SPACE TO WRK-XN-00001 NC1064.2 +241900 NOT ON SIZE ERROR NC1064.2 +242000 MOVE "1" TO WRK-XN-00001 NC1064.2 +242100 END-SUBTRACT NC1064.2 +242200 MOVE "C" TO SIZE-ERR4. NC1064.2 +242300 GO TO SUB-TEST-F1-38-1. NC1064.2 +242400 SUB-DELETE-F1-38. NC1064.2 +242500 PERFORM DE-LETE. NC1064.2 +242600 PERFORM PRINT-DETAIL. NC1064.2 +242700 GO TO SUB-INIT-F1-39. NC1064.2 +242800 SUB-TEST-F1-38-1. NC1064.2 +242900 MOVE "SUB-TEST-F1-38-1" TO PAR-NAME. NC1064.2 +243000 IF WRK-XN-00001 = SPACE NC1064.2 +243100 PERFORM PASS NC1064.2 +243200 PERFORM PRINT-DETAIL NC1064.2 +243300 ELSE NC1064.2 +243400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +243500 TO RE-MARK NC1064.2 +243600 MOVE SPACE TO CORRECT-X NC1064.2 +243700 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +243800 PERFORM FAIL NC1064.2 +243900 PERFORM PRINT-DETAIL. NC1064.2 +244000 ADD 1 TO REC-CT. NC1064.2 +244100 SUB-TEST-F1-38-2. NC1064.2 +244200 MOVE "SUB-TEST-F1-38-2" TO PAR-NAME. NC1064.2 +244300 IF SIZE-ERR4 = "C" NC1064.2 +244400 PERFORM PASS NC1064.2 +244500 PERFORM PRINT-DETAIL NC1064.2 +244600 ELSE NC1064.2 +244700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +244800 TO RE-MARK NC1064.2 +244900 MOVE "C" TO CORRECT-X NC1064.2 +245000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +245100 PERFORM FAIL NC1064.2 +245200 PERFORM PRINT-DETAIL. NC1064.2 +245300 ADD 1 TO REC-CT. NC1064.2 +245400 SUB-TEST-F1-38-3. NC1064.2 +245500 MOVE "SUB-TEST-F1-38-3" TO PAR-NAME. NC1064.2 +245600 IF WRK-DS-02V00 = -11 NC1064.2 +245700 PERFORM PASS NC1064.2 +245800 PERFORM PRINT-DETAIL NC1064.2 +245900 ELSE NC1064.2 +246000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +246100 TO RE-MARK NC1064.2 +246200 MOVE -11 TO CORRECT-N NC1064.2 +246300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +246400 PERFORM FAIL NC1064.2 +246500 PERFORM PRINT-DETAIL. NC1064.2 +246600* NC1064.2 +246700 SUB-INIT-F1-39. NC1064.2 +246800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +246900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +247000 MOVE "SUB-TEST-F1-39" TO PAR-NAME. NC1064.2 +247100 MOVE SPACE TO WRK-XN-00001. NC1064.2 +247200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +247300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +247400 MOVE 1 TO REC-CT. NC1064.2 +247500 SUB-TEST-F1-39-0. NC1064.2 +247600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +247700 333333 NC1064.2 +247800 A06THREES-DS-03V03 NC1064.2 +247900 -0000009 NC1064.2 +248000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +248100 ON SIZE ERROR NC1064.2 +248200 MOVE "X" TO WRK-XN-00001 NC1064.2 +248300 NOT ON SIZE ERROR NC1064.2 +248400 MOVE "1" TO WRK-XN-00001 NC1064.2 +248500 END-SUBTRACT NC1064.2 +248600 MOVE "C" TO SIZE-ERR4. NC1064.2 +248700 GO TO SUB-TEST-F1-39-1. NC1064.2 +248800 SUB-DELETE-F1-39. NC1064.2 +248900 PERFORM DE-LETE. NC1064.2 +249000 PERFORM PRINT-DETAIL. NC1064.2 +249100 GO TO CCVS-EXIT. NC1064.2 +249200 SUB-TEST-F1-39-1. NC1064.2 +249300 MOVE "SUB-TEST-F1-39-1" TO PAR-NAME. NC1064.2 +249400 IF WRK-XN-00001 = "1" NC1064.2 +249500 PERFORM PASS NC1064.2 +249600 PERFORM PRINT-DETAIL NC1064.2 +249700 ELSE NC1064.2 +249800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +249900 TO RE-MARK NC1064.2 +250000 MOVE "1" TO CORRECT-X NC1064.2 +250100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +250200 PERFORM FAIL NC1064.2 +250300 PERFORM PRINT-DETAIL. NC1064.2 +250400 ADD 1 TO REC-CT. NC1064.2 +250500 SUB-TEST-F1-39-2. NC1064.2 +250600 MOVE "SUB-TEST-F1-39-2" TO PAR-NAME. NC1064.2 +250700 IF SIZE-ERR4 = "C" NC1064.2 +250800 PERFORM PASS NC1064.2 +250900 PERFORM PRINT-DETAIL NC1064.2 +251000 ELSE NC1064.2 +251100 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +251200 TO RE-MARK NC1064.2 +251300 MOVE "C" TO CORRECT-X NC1064.2 +251400 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +251500 PERFORM FAIL NC1064.2 +251600 PERFORM PRINT-DETAIL. NC1064.2 +251700 ADD 1 TO REC-CT. NC1064.2 +251800 SUB-TEST-F1-39-3. NC1064.2 +251900 MOVE "SUB-TEST-F1-39-3" TO PAR-NAME. NC1064.2 +252000 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +252100 PERFORM PASS NC1064.2 +252200 PERFORM PRINT-DETAIL NC1064.2 +252300 ELSE NC1064.2 +252400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +252500 TO RE-MARK NC1064.2 +252600 MOVE -666990.666333 TO CORRECT-N NC1064.2 +252700 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +252800 PERFORM FAIL NC1064.2 +252900 PERFORM PRINT-DETAIL. NC1064.2 +253000* NC1064.2 +253100 CCVS-EXIT SECTION. NC1064.2 +253200 CCVS-999999. NC1064.2 +253300 GO TO CLOSE-FILES. NC1064.2 +*END-OF,NC106A +*HEADER,COBOL,NC107A +000100 IDENTIFICATION DIVISION. NC1074.2 +000200 PROGRAM-ID. NC1074.2 +000300 NC107A. NC1074.2 +000400**************************************************************** NC1074.2 +000500* * NC1074.2 +000600* VALIDATION FOR:- * NC1074.2 +000700* * NC1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +000900* * NC1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1074.2 +001100* * NC1074.2 +001200**************************************************************** NC1074.2 +001300* * NC1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1074.2 +001500* * NC1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1074.2 +001900* * NC1074.2 +002000**************************************************************** NC1074.2 +002100* NC1074.2 +002200* PROGRAM NC107A TESTS THE FOLLOWING FEATURES: NC1074.2 +002300* NC1074.2 +002400* FIGURATIVE CONSTANTS NC1074.2 +002500* CONTINUATION LINES NC1074.2 +002600* SEPARATORS NC1074.2 +002700* JUSTIFIED CLAUSE NC1074.2 +002800* SYNCHRONISED CLAUSE NC1074.2 +002900* BLANK WHEN ZERO CLAUSE NC1074.2 +003000* MAXIMUM LENGTH DATA-NAMES, LITERALS NC1074.2 +003100* AND PARAGRAPH-NAMES. NC1074.2 +003200* REDEFINES CLAUSE NC1074.2 +003300* USAGE CLAUSE NC1074.2 +003400* VALUE CLAUSE NC1074.2 +003500* CURRENCY SIGN CLAUSE NC1074.2 +003600* DECIMAL-POINT IS COMMA CLAUSE NC1074.2 +003700* NUMERIC PARAGRAPH NAMES NC1074.2 +003800* CONTINUE STATEMENT NC1074.2 +003900 NC1074.2 +004000 ENVIRONMENT DIVISION. NC1074.2 +004100 CONFIGURATION SECTION. NC1074.2 +004200 SOURCE-COMPUTER. NC1074.2 +004300 XXXXX082. NC1074.2 +004400 OBJECT-COMPUTER. NC1074.2 +004500 XXXXX083. NC1074.2 +004600 SPECIAL-NAMES. NC1074.2 +004700 CURRENCY SIGN IS "W" NC1074.2 +004800 DECIMAL-POINT IS COMMA. NC1074.2 +004900 INPUT-OUTPUT SECTION. NC1074.2 +005000 FILE-CONTROL. NC1074.2 +005100 SELECT PRINT-FILE ASSIGN TO NC1074.2 +005200 XXXXX055. NC1074.2 +005300 DATA DIVISION. NC1074.2 +005400 FILE SECTION. NC1074.2 +005500 FD PRINT-FILE. NC1074.2 +005600 01 PRINT-REC PICTURE X(120). NC1074.2 +005700 01 DUMMY-RECORD PICTURE X(120). NC1074.2 +005800 WORKING-STORAGE SECTION. NC1074.2 +005900 01 SUB1 PIC S9(3) COMP. NC1074.2 +006000 01 SUB2 PIC S9(3) COMP. NC1074.2 +006100 01 TAB-LOC. NC1074.2 +006200 03 FILLER PIC X(16) VALUE "TABLE LOCATION: ". NC1074.2 +006300 03 TAB1 PIC ZZ9. NC1074.2 +006400 03 FILLER PIC XX VALUE ", ". NC1074.2 +006500 03 TAB2 PIC ZZ9. NC1074.2 +006600 77 DATA-A PICTURE IS X(10). NC1074.2 +006700 77 DATA-B PICTURE IS 9(5). NC1074.2 +006800 77 DATA-C PICTURE IS 9(5). NC1074.2 +006900 77 DATA-D PICTURE IS X(10) NC1074.2 +007000 JUSTIFIED RIGHT. NC1074.2 +007100 77 DATA-E PICTURE IS A(9) NC1074.2 +007200 JUSTIFIED. NC1074.2 +007300 77 DATA-F PICTURE IS 9(10) NC1074.2 +007400 BLANK WHEN ZERO. NC1074.2 +007500 77 DATA-G SYNCHRONIZED RIGHT PICTURE X(5) NC1074.2 +007600 VALUE IS "VWXYZ". NC1074.2 +007700 77 DATA-H PICTURE IS X(5) NC1074.2 +007800 VALUE IS "VWXYZ". NC1074.2 +007900 77 DATA-I PICTURE IS 9999 NC1074.2 +008000 VALUE IS 12. NC1074.2 +008100 77 DATA-J PICTURE IS WWWWW. NC1074.2 +008200 77 DATA-K PICTURE IS 9999999V99 NC1074.2 +008300 VALUE IS 1234567,89. NC1074.2 +008400 77 DATA-L PICTURE IS 9.999.999,99. NC1074.2 +008500 77 DATA-M PICTURE IS W9999 NC1074.2 +008600 BLANK WHEN ZERO. NC1074.2 +008700 77 DATA-N PICTURE IS X(16) NC1074.2 +008800 VALUE IS "4 SPACES ON LEFT". NC1074.2 +008900 77 DATA-O PICTURE IS X(20) NC1074.2 +009000 JUSTIFIED RIGHT. NC1074.2 +009100 77 DATA-P PICTURE 999 VALUE "000" BLANK WHEN ZERO. NC1074.2 +009200 77 DATA-P1 REDEFINES DATA-P PICTURE XXX. NC1074.2 +009300 77 DATA-Q VALUE "QUOTE IN COL. 72"NC1074.2 +009400 PICTURE X(16). NC1074.2 +009500 77 DATA-R VALUE "LITERAL ENDS AT 72NC1074.2 +009600- "" NC1074.2 +009700 PICTURE X(18). NC1074.2 +009800 77 DATA-S PICTURE X(20) VALUE "OFFSET NC1074.2 +009900- "CONTINUATION ". NC1074.2 +010000 77 DATA-T PICTURE X(20) VALUE "OFFSET CONTINUATION NC1074.2 +010100- "". NC1074.2 +010200 77 DATA-U PICTURE X(20) VALUE "OFFNC1074.2 +010300- "SETNC1074.2 +010400- " CONC1074.2 +010500- "NTINC1074.2 +010600- "NUANC1074.2 +010700- "TNC1074.2 +010800- "IONNC1074.2 +010900- " ".NC1074.2 +011000 77 DATA-V PICTURE X(20) VALUE SPACE. NC1074.2 +011100 77 DATA-W PICTURE X(20) VALUE NC1074.2 +011200 "OFFSET CONTINUATION ". NC1074.2 +011300 77 NUM-UTILITY PICTURE 9999 NC1074.2 +011400 VALUE ZERO. NC1074.2 +011500 01 WRK-XN-160-1 PIC X(160) VALUE NC1074.2 +011600 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +012000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +012100- """""""""""""""""""""". NC1074.2 +012200 01 CHARACTER-BREAKDOWN-R. NC1074.2 +012300 02 FIRST-20R PICTURE X(20). NC1074.2 +012400 02 SECOND-20R PICTURE X(20). NC1074.2 +012500 02 THIRD-20R PICTURE X(20). NC1074.2 +012600 02 FOURTH-20R PICTURE X(20). NC1074.2 +012700 01 CHARACTER-BREAKDOWN-S. NC1074.2 +012800 02 FIRST-20S PICTURE X(20). NC1074.2 +012900 02 SECOND-20S PICTURE X(20). NC1074.2 +013000 02 THIRD-20S PICTURE X(20). NC1074.2 +013100 02 FOURTH-20S PICTURE X(20). NC1074.2 +013200 01 X80-CHARACTER-FIELD. NC1074.2 +013300 02 FILLER PICTURE X(80). NC1074.2 +013400 01 A-DATA-NAME-30-CHARACTERS-LONG PICTURE IS X. NC1074.2 +013500 01 LONG-PICTURE PICTURE IS NC1074.2 +013600 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. NC1074.2 +013700 01 LONG-NUMBER PICTURE 999999999V999999999 NC1074.2 +013800 VALUE IS 211113411,114311112. NC1074.2 +013900 01 LONG-LITERAL. NC1074.2 +014000 02 LONG20 PICTURE IS X(20) NC1074.2 +014100 VALUE IS "STANDARD COMPILERS M". NC1074.2 +014200 02 LONG40 PICTURE IS X(20) NC1074.2 +014300 VALUE IS "UST ALLOW NON-NUMERI". NC1074.2 +014400 02 LONG60 PICTURE IS X(20) NC1074.2 +014500 VALUE IS "C LITERALS OF AT LEA". NC1074.2 +014600 02 LONG80 PICTURE IS X(20) NC1074.2 +014700 VALUE IS "ST 120 CHARACTERS AN". NC1074.2 +014800 02 LONG100 PICTURE IS X(20) NC1074.2 +014900 VALUE IS "D NUMERIC LITERALS O". NC1074.2 +015000 02 LONG120 PICTURE IS X(20) NC1074.2 +015100 VALUE IS "F AT LEAST 18 DIGITS". NC1074.2 +015200 02 LONG140 PICTURE IS X(20) NC1074.2 +015300 VALUE IS " BUT NOW EXTENDED UP". NC1074.2 +015400 02 LONG160 PICTURE IS X(20) NC1074.2 +015500 VALUE IS "TO 160 DIGITS FOR 8X". NC1074.2 +015600 01 LONG-PICTURE-A PICTURE X(000000000000000020). NC1074.2 +015700 01 LONG-PICTURE-B PICTURE X(15) JUSTIFIED RIGHT. NC1074.2 +015800 01 LONG-PICTURE-C PICTURE X(000000000000000010). NC1074.2 +015900 01 REDEF1 PICTURE IS 9 VALUE IS 9. NC1074.2 +016000 01 REDEF2 REDEFINES REDEF1 PICTURE IS X. NC1074.2 +016100 01 REDEF3 PICTURE IS XXX NC1074.2 +016200 VALUE IS "ABC". NC1074.2 +016300 01 REDEF4 REDEFINES REDEF3 PICTURE IS A. NC1074.2 +016400 01 REDEF5 PICTURE IS X(6) NC1074.2 +016500 VALUE IS "UVWXYZ". NC1074.2 +016600 01 REDEF6 REDEFINES REDEF5 PICTURE IS 9(6). NC1074.2 +016700 01 REDEF7 REDEFINES REDEF5 PICTURE IS A(6). NC1074.2 +016800 01 REDEF8 REDEFINES REDEF5. NC1074.2 +016900 02 REDEF8X. NC1074.2 +017000 03 REDEF8A PICTURE IS XX. NC1074.2 +017100 03 REDEF8B PICTURE IS 99. NC1074.2 +017200 02 REDEF8C PICTURE IS AA. NC1074.2 +017300 01 REDEF9 REDEFINES REDEF5 PICTURE IS X(6). NC1074.2 +017400 01 REDEF10. NC1074.2 +017500 02 RDFDATA1 PICTURE X(10) VALUE "ABC98765DE".NC1074.2 +017600 02 RDFDATA2 PIC 9(4)V99 VALUE 9116,44. NC1074.2 +017700 02 RDFDATA3. NC1074.2 +017800 08 RDFDATA4 PICTURE X(6) VALUE "ALLDON". NC1074.2 +017900 08 RDFDATA5 PICTURE XX99 VALUE "XX66". NC1074.2 +018000 02 RDFDATA6 PICTURE A(20) VALUE NC1074.2 +018100 NC1074.2 +018200 "ZYXWVUTSRQPONMLKJIHG". NC1074.2 +018300 01 REDEF11 REDEFINES REDEF10. NC1074.2 +018400 02 RDFDATA7 PICTURE X(20). NC1074.2 +018500 02 RDF8. NC1074.2 +018600 03 RDFDATA8 OCCURS 36 TIMES PICTURE XX. NC1074.2 +018700 01 REDEF12 REDEFINES REDEF10. NC1074.2 +018800 02 RDFDATA9 PICTURE A(3). NC1074.2 +018900 02 RDFDATA10 PICTURE 9(5). NC1074.2 +019000 02 RDFDATA11. NC1074.2 +019100 03 RDFDATA12. NC1074.2 +019200 04 RDFDATA13 PICTURE XX. NC1074.2 +019300 04 RDFDATA14 OCCURS 6 TIMES PICTURE 9. NC1074.2 +019400 03 RDFDATA15 PICTURE X(8). NC1074.2 +019500 02 RDFDATA16 PICTURE 99. NC1074.2 +019600 02 RDFDATA17 PICTURE X(80). NC1074.2 +019700 02 RDFDATA18 PICTURE X(14). NC1074.2 +019800 01 REDEF13. NC1074.2 +019900 02 FILLER PICTURE X(57) VALUE NC1074.2 +020000 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC1074.2 +020100 02 FILLER PICTURE X(57) VALUE NC1074.2 +020200 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC1074.2 +020300 02 FILLER PICTURE X(6) VALUE "AAAAAA". NC1074.2 +020400 01 REDEF20. NC1074.2 +020500 03 REDEF21 PICTURE X(10). NC1074.2 +020600 03 REDEF22 REDEFINES REDEF21 NC1074.2 +020700 PIC X(10). NC1074.2 +020800 03 REDEF23 REDEFINES REDEF21 NC1074.2 +020900 PIC X(9). NC1074.2 +021000 01 U1. NC1074.2 +021100 02 U2 PICTURE 9 USAGE IS NC1074.2 +021200 DISPLAY VALUE IS 9. NC1074.2 +021300 02 U3 PICTURE IS 9 USAGE IS NC1074.2 +021400 COMPUTATIONAL VALUE IS 9. NC1074.2 +021500 02 U4 PICTURE IS 9 USAGE IS NC1074.2 +021600 DISPLAY VALUE IS 9. NC1074.2 +021700 02 U5 USAGE IS COMPUTATIONAL. NC1074.2 +021800 03 U6 PICTURE IS 9 USAGE IS NC1074.2 +021900 COMPUTATIONAL VALUE IS 5. NC1074.2 +022000 03 U7 PICTURE IS 9 VALUE IS 6. NC1074.2 +022100 02 U8 PICTURE IS X. NC1074.2 +022200 01 U9 USAGE COMPUTATIONAL. NC1074.2 +022300 02 U10 PICTURE 9. NC1074.2 +022400 02 U11 PICTURE 9 COMPUTATIONAL. NC1074.2 +022500 01 U12. NC1074.2 +022600 02 U13 PICTURE 9 USAGE IS BINARY NC1074.2 +022700 VALUE 3. NC1074.2 +022800 02 U14 PICTURE 9 USAGE IS BINARY NC1074.2 +022900 VALUE 3. NC1074.2 +023000 01 U22. NC1074.2 +023100 02 U23 PICTURE 9 USAGE IS BINARY NC1074.2 +023200 VALUE 4. NC1074.2 +023300 02 U24 PICTURE 9 USAGE IS BINARY NC1074.2 +023400 VALUE 4. NC1074.2 +023500* NC1074.2 +023600* TWO-DIMENSIONAL TABLE USED IN VALUE CLAUSE: NC1074.2 +023700* NC1074.2 +023800 01 VALUE-TABLE. NC1074.2 +023900 03 VALUE-TABLE-1 OCCURS 10. NC1074.2 +024000 05 VALUE-TABLE-2 OCCURS 10 NC1074.2 +024100 PIC XX VALUE "AZ". NC1074.2 +024200* NC1074.2 +024300* NC1074.2 +024400 01 TEST-FIELD PIC X(10). NC1074.2 +024500* NC1074.2 +024600* NC1074.2 +024700 01 SEP-01. 02 SEP-02. 03 SEP-03. 04 SEP-04 PICTURE X(9) VALUE NC1074.2 +024800 "SEPARATOR". NC1074.2 +024900* NC1074.2 +025000* GROUP ITEMS USED IN JUSTIFIED TESTS. NC1074.2 +025100* NC1074.2 +025200 01 GROUP-TO-JUST-1. NC1074.2 +025300 02 FILLER PICTURE X VALUE "A". NC1074.2 +025400 02 FILLER PICTURE X VALUE "B". NC1074.2 +025500 02 FILLER PICTURE X VALUE "C". NC1074.2 +025600 01 GROUP-TO-JUST-2. NC1074.2 +025700 02 GROUP-TO-JUST-21. NC1074.2 +025800 03 FILLER PICTURE X(5) VALUE "ABCDE". NC1074.2 +025900 03 FILLER PICTURE X(2) VALUE "FG". NC1074.2 +026000 02 FILLER PICTURE X(8) VALUE "HIJKLMNO". NC1074.2 +026100 01 GROUP-FOR-JUST-TESTS. NC1074.2 +026200 02 NJUST-XN-3 PICTURE X(3) VALUE "ABC". NC1074.2 +026300 02 NJUST-XN-5 PICTURE X(5) VALUE "CDEFG". NC1074.2 +026400 02 NJUST-XN-15 PICTURE X(15) VALUE "ABCDEFGHIJKLMNO". NC1074.2 +026500* NC1074.2 +026600* DATA ITEMS WITH JUSTIFIED CLAUSE. NC1074.2 +026700* NC1074.2 +026800 01 XJ-00005 PICTURE X(5) JUSTIFIED RIGHT. NC1074.2 +026900 01 AJ-00005 PICTURE A(5) JUSTIFIED RIGHT. NC1074.2 +027000 01 XJ-00007 PICTURE X(7) JUST RIGHT. NC1074.2 +027100 01 AJ-00007 PICTURE A(7) JUSTIFIED. NC1074.2 +027200 01 GROUP-WITH-JUST-ITEMS. NC1074.2 +027300 02 XN-00005-NJUST PICTURE X(5). NC1074.2 +027400 02 XJ-00009 PICTURE X(9) JUST. NC1074.2 +027500 02 AJ-00009 PICTURE A(9) JUST. NC1074.2 +027600* NC1074.2 +027700* INITIALIZATION TAKES PLACE INDEPENDENT OF ANY NC1074.2 +027800* JUSTIFIED CLAUSE. NC1074.2 +027900* NC1074.2 +028000 01 XJ-00002 PICTURE X(2) JUST VALUE "AB". NC1074.2 +028100 01 XJ-00003 PICTURE X(3) JUST VALUE "XY". NC1074.2 +028200 01 TEST-RESULTS. NC1074.2 +028300 02 FILLER PIC X VALUE SPACE. NC1074.2 +028400 02 FEATURE PIC X(20) VALUE SPACE. NC1074.2 +028500 02 FILLER PIC X VALUE SPACE. NC1074.2 +028600 02 P-OR-F PIC X(5) VALUE SPACE. NC1074.2 +028700 02 FILLER PIC X VALUE SPACE. NC1074.2 +028800 02 PAR-NAME. NC1074.2 +028900 03 FILLER PIC X(19) VALUE SPACE. NC1074.2 +029000 03 PARDOT-X PIC X VALUE SPACE. NC1074.2 +029100 03 DOTVALUE PIC 99 VALUE ZERO. NC1074.2 +029200 02 FILLER PIC X(8) VALUE SPACE. NC1074.2 +029300 02 RE-MARK PIC X(61). NC1074.2 +029400 01 TEST-COMPUTED. NC1074.2 +029500 02 FILLER PIC X(30) VALUE SPACE. NC1074.2 +029600 02 FILLER PIC X(17) VALUE NC1074.2 +029700 " COMPUTED=". NC1074.2 +029800 02 COMPUTED-X. NC1074.2 +029900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1074.2 +030000 03 COMPUTED-N REDEFINES COMPUTED-A NC1074.2 +030100 PIC -9(9),9(9). NC1074.2 +030200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -,9(18). NC1074.2 +030300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4),9(14). NC1074.2 +030400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14),9(4). NC1074.2 +030500 03 CM-18V0 REDEFINES COMPUTED-A. NC1074.2 +030600 04 COMPUTED-18V0 PIC -9(18). NC1074.2 +030700 04 FILLER PIC X. NC1074.2 +030800 03 FILLER PIC X(50) VALUE SPACE. NC1074.2 +030900 01 TEST-CORRECT. NC1074.2 +031000 02 FILLER PIC X(30) VALUE SPACE. NC1074.2 +031100 02 FILLER PIC X(17) VALUE " CORRECT =". NC1074.2 +031200 02 CORRECT-X. NC1074.2 +031300 03 CORRECT-A PIC X(20) VALUE SPACE. NC1074.2 +031400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9),9(9). NC1074.2 +031500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -,9(18). NC1074.2 +031600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4),9(14). NC1074.2 +031700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14),9(4). NC1074.2 +031800 03 CR-18V0 REDEFINES CORRECT-A. NC1074.2 +031900 04 CORRECT-18V0 PIC -9(18). NC1074.2 +032000 04 FILLER PIC X. NC1074.2 +032100 03 FILLER PIC X(2) VALUE SPACE. NC1074.2 +032200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1074.2 +032300 01 CCVS-C-1. NC1074.2 +032400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1074.2 +032500- "SS PARAGRAPH-NAME NC1074.2 +032600- " REMARKS". NC1074.2 +032700 02 FILLER PIC X(20) VALUE SPACE. NC1074.2 +032800 01 CCVS-C-2. NC1074.2 +032900 02 FILLER PIC X VALUE SPACE. NC1074.2 +033000 02 FILLER PIC X(6) VALUE "TESTED". NC1074.2 +033100 02 FILLER PIC X(15) VALUE SPACE. NC1074.2 +033200 02 FILLER PIC X(4) VALUE "FAIL". NC1074.2 +033300 02 FILLER PIC X(94) VALUE SPACE. NC1074.2 +033400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1074.2 +033500 01 REC-CT PIC 99 VALUE ZERO. NC1074.2 +033600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1074.2 +034000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1074.2 +034100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1074.2 +034200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1074.2 +034300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1074.2 +034400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1074.2 +034500 01 CCVS-H-1. NC1074.2 +034600 02 FILLER PIC X(39) VALUE SPACES. NC1074.2 +034700 02 FILLER PIC X(42) VALUE NC1074.2 +034800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1074.2 +034900 02 FILLER PIC X(39) VALUE SPACES. NC1074.2 +035000 01 CCVS-H-2A. NC1074.2 +035100 02 FILLER PIC X(40) VALUE SPACE. NC1074.2 +035200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1074.2 +035300 02 FILLER PIC XXXX VALUE NC1074.2 +035400 "4.2 ". NC1074.2 +035500 02 FILLER PIC X(28) VALUE NC1074.2 +035600 " COPY - NOT FOR DISTRIBUTION". NC1074.2 +035700 02 FILLER PIC X(41) VALUE SPACE. NC1074.2 +035800 NC1074.2 +035900 01 CCVS-H-2B. NC1074.2 +036000 02 FILLER PIC X(15) VALUE NC1074.2 +036100 "TEST RESULT OF ". NC1074.2 +036200 02 TEST-ID PIC X(9). NC1074.2 +036300 02 FILLER PIC X(4) VALUE NC1074.2 +036400 " IN ". NC1074.2 +036500 02 FILLER PIC X(12) VALUE NC1074.2 +036600 " HIGH ". NC1074.2 +036700 02 FILLER PIC X(22) VALUE NC1074.2 +036800 " LEVEL VALIDATION FOR ". NC1074.2 +036900 02 FILLER PIC X(58) VALUE NC1074.2 +037000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +037100 01 CCVS-H-3. NC1074.2 +037200 02 FILLER PIC X(34) VALUE NC1074.2 +037300 " FOR OFFICIAL USE ONLY ". NC1074.2 +037400 02 FILLER PIC X(58) VALUE NC1074.2 +037500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1074.2 +037600 02 FILLER PIC X(28) VALUE NC1074.2 +037700 " COPYRIGHT 1985 ". NC1074.2 +037800 01 CCVS-E-1. NC1074.2 +037900 02 FILLER PIC X(52) VALUE SPACE. NC1074.2 +038000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1074.2 +038100 02 ID-AGAIN PIC X(9). NC1074.2 +038200 02 FILLER PIC X(45) VALUE SPACES. NC1074.2 +038300 01 CCVS-E-2. NC1074.2 +038400 02 FILLER PIC X(31) VALUE SPACE. NC1074.2 +038500 02 FILLER PIC X(21) VALUE SPACE. NC1074.2 +038600 02 CCVS-E-2-2. NC1074.2 +038700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1074.2 +038800 03 FILLER PIC X VALUE SPACE. NC1074.2 +038900 03 ENDER-DESC PIC X(44) VALUE NC1074.2 +039000 "ERRORS ENCOUNTERED". NC1074.2 +039100 01 CCVS-E-3. NC1074.2 +039200 02 FILLER PIC X(22) VALUE NC1074.2 +039300 " FOR OFFICIAL USE ONLY". NC1074.2 +039400 02 FILLER PIC X(12) VALUE SPACE. NC1074.2 +039500 02 FILLER PIC X(58) VALUE NC1074.2 +039600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +039700 02 FILLER PIC X(13) VALUE SPACE. NC1074.2 +039800 02 FILLER PIC X(15) VALUE NC1074.2 +039900 " COPYRIGHT 1985". NC1074.2 +040000 01 CCVS-E-4. NC1074.2 +040100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1074.2 +040200 02 FILLER PIC X(4) VALUE " OF ". NC1074.2 +040300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1074.2 +040400 02 FILLER PIC X(40) VALUE NC1074.2 +040500 " TESTS WERE EXECUTED SUCCESSFULLY". NC1074.2 +040600 01 XXINFO. NC1074.2 +040700 02 FILLER PIC X(19) VALUE NC1074.2 +040800 "*** INFORMATION ***". NC1074.2 +040900 02 INFO-TEXT. NC1074.2 +041000 04 FILLER PIC X(8) VALUE SPACE. NC1074.2 +041100 04 XXCOMPUTED PIC X(20). NC1074.2 +041200 04 FILLER PIC X(5) VALUE SPACE. NC1074.2 +041300 04 XXCORRECT PIC X(20). NC1074.2 +041400 02 INF-ANSI-REFERENCE PIC X(48). NC1074.2 +041500 01 HYPHEN-LINE. NC1074.2 +041600 02 FILLER PIC IS X VALUE IS SPACE. NC1074.2 +041700 02 FILLER PIC IS X(65) VALUE IS "************************NC1074.2 +041800- "*****************************************". NC1074.2 +041900 02 FILLER PIC IS X(54) VALUE IS "************************NC1074.2 +042000- "******************************". NC1074.2 +042100 01 CCVS-PGM-ID PIC X(9) VALUE NC1074.2 +042200 "NC107A". NC1074.2 +042300 PROCEDURE DIVISION. NC1074.2 +042400 CCVS1 SECTION. NC1074.2 +042500 OPEN-FILES. NC1074.2 +042600 OPEN OUTPUT PRINT-FILE. NC1074.2 +042700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1074.2 +042800 MOVE SPACE TO TEST-RESULTS. NC1074.2 +042900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1074.2 +043000 GO TO CCVS1-EXIT. NC1074.2 +043100 CLOSE-FILES. NC1074.2 +043200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1074.2 +043300 TERMINATE-CCVS. NC1074.2 +043400S EXIT PROGRAM. NC1074.2 +043500STERMINATE-CALL. NC1074.2 +043600 STOP RUN. NC1074.2 +043700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1074.2 +043800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1074.2 +043900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1074.2 +044000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1074.2 +044100 MOVE "****TEST DELETED****" TO RE-MARK. NC1074.2 +044200 PRINT-DETAIL. NC1074.2 +044300 IF REC-CT NOT EQUAL TO ZERO NC1074.2 +044400 MOVE "." TO PARDOT-X NC1074.2 +044500 MOVE REC-CT TO DOTVALUE. NC1074.2 +044600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1074.2 +044700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1074.2 +044800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1074.2 +044900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1074.2 +045000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1074.2 +045100 MOVE SPACE TO CORRECT-X. NC1074.2 +045200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1074.2 +045300 MOVE SPACE TO RE-MARK. NC1074.2 +045400 HEAD-ROUTINE. NC1074.2 +045500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +045600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +045700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1074.2 +045800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1074.2 +045900 COLUMN-NAMES-ROUTINE. NC1074.2 +046000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +046100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +046200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +046300 END-ROUTINE. NC1074.2 +046400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1074.2 +046500 END-RTN-EXIT. NC1074.2 +046600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +046700 END-ROUTINE-1. NC1074.2 +046800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1074.2 +046900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1074.2 +047000 ADD PASS-COUNTER TO ERROR-HOLD. NC1074.2 +047100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1074.2 +047200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1074.2 +047300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1074.2 +047400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1074.2 +047500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1074.2 +047600 END-ROUTINE-12. NC1074.2 +047700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1074.2 +047800 IF ERROR-COUNTER IS EQUAL TO ZERO NC1074.2 +047900 MOVE "NO " TO ERROR-TOTAL NC1074.2 +048000 ELSE NC1074.2 +048100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1074.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1074.2 +048300 PERFORM WRITE-LINE. NC1074.2 +048400 END-ROUTINE-13. NC1074.2 +048500 IF DELETE-COUNTER IS EQUAL TO ZERO NC1074.2 +048600 MOVE "NO " TO ERROR-TOTAL ELSE NC1074.2 +048700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1074.2 +048800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1074.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049000 IF INSPECT-COUNTER EQUAL TO ZERO NC1074.2 +049100 MOVE "NO " TO ERROR-TOTAL NC1074.2 +049200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1074.2 +049300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1074.2 +049400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049600 WRITE-LINE. NC1074.2 +049700 ADD 1 TO RECORD-COUNT. NC1074.2 +049800Y IF RECORD-COUNT GREATER 42 NC1074.2 +049900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1074.2 +050000Y MOVE SPACE TO DUMMY-RECORD NC1074.2 +050100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1074.2 +050200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1074.2 +050300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1074.2 +050400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1074.2 +050500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1074.2 +050600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1074.2 +051000Y MOVE ZERO TO RECORD-COUNT. NC1074.2 +051100 PERFORM WRT-LN. NC1074.2 +051200 WRT-LN. NC1074.2 +051300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1074.2 +051400 MOVE SPACE TO DUMMY-RECORD. NC1074.2 +051500 BLANK-LINE-PRINT. NC1074.2 +051600 PERFORM WRT-LN. NC1074.2 +051700 FAIL-ROUTINE. NC1074.2 +051800 IF COMPUTED-X NOT EQUAL TO SPACE NC1074.2 +051900 GO TO FAIL-ROUTINE-WRITE. NC1074.2 +052000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1074.2 +052100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1074.2 +052200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1074.2 +052300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1074.2 +052500 GO TO FAIL-ROUTINE-EX. NC1074.2 +052600 FAIL-ROUTINE-WRITE. NC1074.2 +052700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1074.2 +052800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1074.2 +052900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1074.2 +053000 MOVE SPACES TO COR-ANSI-REFERENCE. NC1074.2 +053100 FAIL-ROUTINE-EX. EXIT. NC1074.2 +053200 BAIL-OUT. NC1074.2 +053300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1074.2 +053400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1074.2 +053500 BAIL-OUT-WRITE. NC1074.2 +053600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1074.2 +053700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1074.2 +053800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1074.2 +054000 BAIL-OUT-EX. EXIT. NC1074.2 +054100 CCVS1-EXIT. NC1074.2 +054200 EXIT. NC1074.2 +054300 SECT-NC107A-001 SECTION. NC1074.2 +054400*REMARKS-TEST. NC1074.2 +054500* MOVE "IV-11 7.2.4" TO ANSI-REFERENCE. NC1074.2 +054600* MOVE "COBOL REMARKS PARA" TO FEATURE. NC1074.2 +054700* MOVE "REMARKS" TO PAR-NAME. NC1074.2 +054800* MOVE "PHONY LINES SHOULDNT EXECUT" TO RE-MARK. NC1074.2 +054900* PERFORM PRINT-DETAIL. NC1074.2 +055000*NOTE-TEST-1. NC1074.2 +055100* PERFORM FAIL. NC1074.2 +055200* NOTE ENTER GO TO NOTE-WRITE-1 NC1074.2 +055300* USE GO TO NOTE-WRITE-1 NC1074.2 +055400* DECLARATIVES GO TO NOTE-WRITE-1 NC1074.2 +055500* DATA DIVISION GO TO NOTE-WRITE-1 NC1074.2 +055600* COPY (SEE ALSO PROGRAM LB104) GO TO NOTE-WRITE-1 NC1074.2 +055700* THE COMPILER SHOULD "IGNORE" THE ABOVE WORDS. NC1074.2 +055800* PERFORM PASS NC1074.2 +055900* GO TO NOTE-WRITE-1. NC1074.2 +056000*NOTE-DELETE-1. NC1074.2 +056100* PERFORM DE-LETE. NC1074.2 +056200 NOTE-WRITE-1. NC1074.2 +056300 MOVE "NOTE RESERVED WORDS" TO FEATURE. NC1074.2 +056400 MOVE "NOTE-TEST-1" TO PAR-NAME. NC1074.2 +056500 PERFORM PRINT-DETAIL. NC1074.2 +056600 FIG-INIT. NC1074.2 +056700 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +056800 MOVE SPACE TO TEST-RESULTS. NC1074.2 +056900 MOVE "PLEASE CHECK THE COMPUTED" TO RE-MARK. NC1074.2 +057000 PERFORM PRINT-DETAIL. NC1074.2 +057100 MOVE "COLUMN TO BE CERTAIN THAT" TO RE-MARK. NC1074.2 +057200 PERFORM PRINT-DETAIL. NC1074.2 +057300 MOVE "THE CORRECT VALUES FOR THE" TO RE-MARK. NC1074.2 +057400 PERFORM PRINT-DETAIL. NC1074.2 +057500 MOVE "FIGURATIVE CONSTANTS ARE" TO RE-MARK. NC1074.2 +057600 PERFORM PRINT-DETAIL. NC1074.2 +057700 MOVE "SHOWN" TO RE-MARK. NC1074.2 +057800 PERFORM PRINT-DETAIL. NC1074.2 +057900 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC1074.2 +058000 FIG-TEST-1. NC1074.2 +058100 MOVE ZERO TO COMPUTED-18V0. NC1074.2 +058200 MOVE "ZERO " TO CORRECT-A. NC1074.2 +058300 PERFORM INSPT. NC1074.2 +058400 GO TO FIG-WRITE-1. NC1074.2 +058500 FIG-DELETE-1. NC1074.2 +058600 PERFORM DE-LETE. NC1074.2 +058700 FIG-WRITE-1. NC1074.2 +058800 MOVE "FIG-TEST-1" TO PAR-NAME. NC1074.2 +058900 PERFORM PRINT-DETAIL. NC1074.2 +059000 FIG-TEST-2. NC1074.2 +059100 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +059200 MOVE SPACE TO COMPUTED-A. NC1074.2 +059300 MOVE "SPACE " TO CORRECT-A. NC1074.2 +059400 PERFORM INSPT. NC1074.2 +059500 GO TO FIG-WRITE-2. NC1074.2 +059600 FIG-DELETE-2. NC1074.2 +059700 PERFORM DE-LETE. NC1074.2 +059800 FIG-WRITE-2. NC1074.2 +059900 MOVE "FIG-TEST-2" TO PAR-NAME. NC1074.2 +060000 PERFORM PRINT-DETAIL. NC1074.2 +060100 FIG-TEST-3. NC1074.2 +060200 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +060300 MOVE QUOTE TO COMPUTED-A. NC1074.2 +060400 MOVE "QUOTE " TO CORRECT-A. NC1074.2 +060500 PERFORM INSPT. NC1074.2 +060600 GO TO FIG-WRITE-3. NC1074.2 +060700 FIG-DELETE-3. NC1074.2 +060800 PERFORM DE-LETE. NC1074.2 +060900 FIG-WRITE-3. NC1074.2 +061000 MOVE "FIG-TEST-3" TO PAR-NAME. NC1074.2 +061100 PERFORM PRINT-DETAIL. NC1074.2 +061200 FIG-TEST-4. NC1074.2 +061300 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +061400 MOVE HIGH-VALUE TO COMPUTED-A. NC1074.2 +061500 MOVE "HIGH-VALUE" TO CORRECT-A. NC1074.2 +061600 PERFORM INSPT. NC1074.2 +061700 GO TO FIG-WRITE-4. NC1074.2 +061800 FIG-DELETE-4. NC1074.2 +061900 PERFORM DE-LETE. NC1074.2 +062000 FIG-WRITE-4. NC1074.2 +062100 MOVE "FIG-TEST-4" TO PAR-NAME. NC1074.2 +062200 PERFORM PRINT-DETAIL. NC1074.2 +062300 FIG-TEST-5. NC1074.2 +062400 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +062500 MOVE LOW-VALUE TO COMPUTED-A. NC1074.2 +062600 MOVE "LOW-VALUE " TO CORRECT-A. NC1074.2 +062700 PERFORM INSPT. NC1074.2 +062800 GO TO FIG-WRITE-5. NC1074.2 +062900 FIG-DELETE-5. NC1074.2 +063000 PERFORM DE-LETE. NC1074.2 +063100 FIG-WRITE-5. NC1074.2 +063200 MOVE "FIG-TEST-5" TO PAR-NAME. NC1074.2 +063300 PERFORM PRINT-DETAIL. NC1074.2 +063400 CONTIN-INIT-A. NC1074.2 +063500 MOVE "CONTINUE A.N. LITRLS" TO FEATURE. NC1074.2 +063600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +063700 MOVE "ABCDEFNC1074.2 +063800- "GHIJ" TO DATA-A. NC1074.2 +063900 CONTIN-TEST-1. NC1074.2 +064000 IF DATA-A EQUAL TO "ABCDEFGHIJ" NC1074.2 +064100 PERFORM PASS NC1074.2 +064200 GO TO CONTIN-WRITE-1. NC1074.2 +064300 GO TO CONTIN-FAIL-1. NC1074.2 +064400 CONTIN-DELETE-1. NC1074.2 +064500 PERFORM DE-LETE. NC1074.2 +064600 GO TO CONTIN-WRITE-1. NC1074.2 +064700 CONTIN-FAIL-1. NC1074.2 +064800 MOVE DATA-A TO COMPUTED-A. NC1074.2 +064900 MOVE "ABCDEFGHIJ" TO CORRECT-A. NC1074.2 +065000 PERFORM FAIL. NC1074.2 +065100 CONTIN-WRITE-1. NC1074.2 +065200 MOVE "CONTIN-TEST-1" TO PAR-NAME. NC1074.2 +065300 PERFORM PRINT-DETAIL. NC1074.2 +065400 CONTIN-TEST-2. NC1074.2 +065500 IF DATA-Q EQUAL TO "QUOTE IN COL. 72"NC1074.2 +065600 PERFORM PASS NC1074.2 +065700 GO TO CONTIN-WRITE-2. NC1074.2 +065800 PERFORM FAIL. NC1074.2 +065900 MOVE DATA-Q TO COMPUTED-A. NC1074.2 +066000 MOVE "QUOTE IN COL. 72" TO CORRECT-A. NC1074.2 +066100 GO TO CONTIN-WRITE-2. NC1074.2 +066200 CONTIN-DELETE-2. NC1074.2 +066300 PERFORM DE-LETE. NC1074.2 +066400 CONTIN-WRITE-2. NC1074.2 +066500 MOVE "CONTIN-TEST-2" TO PAR-NAME. NC1074.2 +066600 PERFORM PRINT-DETAIL. NC1074.2 +066700 CONTIN-TEST-3. NC1074.2 +066800 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +066900 IF DATA-R EQUAL TO "LITERAL ENDS AT 72NC1074.2 +067000- "" NC1074.2 +067100 PERFORM PASS NC1074.2 +067200 GO TO CONTIN-WRITE-3. NC1074.2 +067300 PERFORM FAIL. NC1074.2 +067400 MOVE DATA-R TO COMPUTED-A. NC1074.2 +067500 MOVE "LITERAL ENDS AT 72" TO CORRECT-A. NC1074.2 +067600 GO TO CONTIN-WRITE-3. NC1074.2 +067700 CONTIN-DELETE-3. NC1074.2 +067800 PERFORM DE-LETE. NC1074.2 +067900 CONTIN-WRITE-3. NC1074.2 +068000 MOVE "CONTIN-TEST-3" TO PAR-NAME. NC1074.2 +068100 PERFORM PRINT-DETAIL. NC1074.2 +068200 CONTIN-TEST-4. NC1074.2 +068300 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +068400 IF DATA-W EQUAL TO DATA-S NC1074.2 +068500 PERFORM PASS GO TO CONTIN-WRITE-4. NC1074.2 +068600 PERFORM FAIL. NC1074.2 +068700 MOVE DATA-S TO COMPUTED-A. NC1074.2 +068800 MOVE DATA-W TO CORRECT-A. NC1074.2 +068900 GO TO CONTIN-WRITE-4. NC1074.2 +069000 CONTIN-DELETE-4. NC1074.2 +069100 PERFORM DE-LETE. NC1074.2 +069200 CONTIN-WRITE-4. NC1074.2 +069300 MOVE "CONTIN-TEST-4" TO PAR-NAME NC1074.2 +069400 PERFORM PRINT-DETAIL. NC1074.2 +069500 CONTIN-TEST-5. NC1074.2 +069600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +069700 IF DATA-W EQUAL TO DATA-T NC1074.2 +069800 PERFORM PASS GO TO CONTIN-WRITE-5. NC1074.2 +069900 PERFORM FAIL. NC1074.2 +070000 MOVE DATA-T TO COMPUTED-A. NC1074.2 +070100 MOVE DATA-W TO CORRECT-A. NC1074.2 +070200 GO TO CONTIN-WRITE-5. NC1074.2 +070300 CONTIN-DELETE-5. NC1074.2 +070400 PERFORM DE-LETE. NC1074.2 +070500 CONTIN-WRITE-5. NC1074.2 +070600 MOVE "CONTIN-TEST-5" TO PAR-NAME NC1074.2 +070700 PERFORM PRINT-DETAIL. NC1074.2 +070800 CONTIN-TEST-6. NC1074.2 +070900 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +071000 IF DATA-W EQUAL TO DATA-U NC1074.2 +071100 PERFORM PASS GO TO CONTIN-WRITE-6. NC1074.2 +071200 PERFORM FAIL. NC1074.2 +071300 MOVE DATA-U TO COMPUTED-A. NC1074.2 +071400 MOVE DATA-W TO CORRECT-A. NC1074.2 +071500 GO TO CONTIN-WRITE-6. NC1074.2 +071600 CONTIN-DELETE-6. NC1074.2 +071700 PERFORM DE-LETE. NC1074.2 +071800 CONTIN-WRITE-6. NC1074.2 +071900 MOVE "CONTIN-TEST-6" TO PAR-NAME NC1074.2 +072000 PERFORM PRINT-DETAIL. NC1074.2 +072100 CONTIN-TEST-7. NC1074.2 +072200 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +072300 MOVE DATA-S TO DATA-V. NC1074.2 +072400 IF DATA-W EQUAL TO DATA-V NC1074.2 +072500 PERFORM PASS GO TO CONTIN-WRITE-7. NC1074.2 +072600 PERFORM FAIL. NC1074.2 +072700 MOVE DATA-V TO COMPUTED-A. NC1074.2 +072800 MOVE DATA-W TO CORRECT-A. NC1074.2 +072900 GO TO CONTIN-WRITE-7. NC1074.2 +073000 CONTIN-DELETE-7. NC1074.2 +073100 PERFORM DE-LETE. NC1074.2 +073200 CONTIN-WRITE-7. NC1074.2 +073300 MOVE "CONTIN-TEST-7" TO PAR-NAME NC1074.2 +073400 PERFORM PRINT-DETAIL. NC1074.2 +073500 CONTIN-TEST-8. NC1074.2 +073600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +073700 IF DATA-S EQUAL TO "OFFSET CONTINUATION NC1074.2 +073800- ""NC1074.2 +073900 PERFORM PASS GO TO CONTIN-WRITE-8. NC1074.2 +074000 PERFORM FAIL. NC1074.2 +074100 MOVE "OFFSET CONTINUATION NC1074.2 +074200- ""NC1074.2 +074300 TO COMPUTED-A. NC1074.2 +074400 MOVE DATA-S TO CORRECT-A. NC1074.2 +074500 GO TO CONTIN-WRITE-8. NC1074.2 +074600 CONTIN-DELETE-8. NC1074.2 +074700 PERFORM DE-LETE. NC1074.2 +074800 CONTIN-WRITE-8. NC1074.2 +074900 MOVE "CONTIN-TEST-8" TO PAR-NAME NC1074.2 +075000 PERFORM PRINT-DETAIL. NC1074.2 +075100 CONTIN-TEST-9. NC1074.2 +075200 MOVE "IV-10 4.2.2.2.1.2 (2) AND IV-9 4.2.2.2.1" NC1074.2 +075300 TO ANSI-REFERENCE. NC1074.2 +075400 IF WRK-XN-160-1 EQUAL TO NC1074.2 +075500 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +076000- """""""""""""""""""""" PERFORM PASS NC1074.2 +076100 ELSE PERFORM FAIL. NC1074.2 +076200 GO TO CONTIN-WRITE-9. NC1074.2 +076300 CONTIN-DELETE-9. NC1074.2 +076400 PERFORM DE-LETE. NC1074.2 +076500 CONTIN-WRITE-9. NC1074.2 +076600 MOVE "CONTIN-TEST-9" TO PAR-NAME. NC1074.2 +076700 MOVE "160 PAIRS OF QUOTES" TO FEATURE. NC1074.2 +076800 PERFORM PRINT-DETAIL. NC1074.2 +076900 SEP-INIT-A. NC1074.2 +077000 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +077100 MOVE "SEPARATORS (SPACES)" TO FEATURE. NC1074.2 +077200 SEP-TEST-1. NC1074.2 +077300 PERFORM PASS.NC1074.2 +077400 GONC1074.2 +077500 TONC1074.2 +077600 SEP-WRITE-1.NC1074.2 +077700 SEP-TEST-1-1. NC1074.2 +077800 PERFORM FAIL.NC1074.2 +077900 GO TO SEP-WRITE-1.NC1074.2 +078000* NOTENC1074.2 +078100* SEP-TEST-1NC1074.2 +078200* ENTIRE PARAGRAPH IS "NC1074.2 +078300* RIGHT-JUSTIFIED, TO MARGIN R.NC1074.2 +078400 SEP-DELETE-1. NC1074.2 +078500 PERFORM DE-LETE. NC1074.2 +078600 SEP-WRITE-1. NC1074.2 +078700 MOVE "SEP-TEST-1" TO PAR-NAME. NC1074.2 +078800 PERFORM PRINT-DETAIL. NC1074.2 +078900 SEP-TEST-2 SECTION. NC1074.2 +079000 SEP-TEST-2-PARA. NC1074.2 +079100 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +079200 S2. PERFORM PASS. IF P-OR-F EQUAL TO "PASS " GO TO NC1074.2 +079300 SEP-WRITE-2. PERFORM FAIL. GO TO SEP-WRITE-2. NC1074.2 +079400 SEP-DELETE-2. NC1074.2 +079500 PERFORM DE-LETE. NC1074.2 +079600 SEP-WRITE-2. NC1074.2 +079700 MOVE "SEP-TEST-2" TO PAR-NAME. NC1074.2 +079800 PERFORM PRINT-DETAIL. NC1074.2 +079900 SEP-TEST-3. NC1074.2 +080000 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +080100 IF SEP-03 EQUAL TO "SEPARATOR" NC1074.2 +080200 PERFORM PASS NC1074.2 +080300 GO TO SEP-WRITE-3. NC1074.2 +080400 PERFORM FAIL. NC1074.2 +080500 MOVE SEP-03 TO COMPUTED-A. NC1074.2 +080600 MOVE "SEPARATOR" TO CORRECT-A. NC1074.2 +080700 GO TO SEP-WRITE-3. NC1074.2 +080800 SEP-DELETE-3. NC1074.2 +080900 PERFORM DE-LETE. NC1074.2 +081000 SEP-WRITE-3. NC1074.2 +081100 MOVE "SEP-TEST-3" TO PAR-NAME. NC1074.2 +081200 PERFORM PRINT-DETAIL. NC1074.2 +081300 SEP-TEST-4. NC1074.2 +081400 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +081500 PERFORM FAIL. NC1074.2 +081600 NC1074.2 +081700 NC1074.2 +081800 NC1074.2 +081900 NC1074.2 +082000 NC1074.2 +082100 NC1074.2 +082200 NC1074.2 +082300 NC1074.2 +082400 NC1074.2 +082500 NC1074.2 +082600 NC1074.2 +082700 NC1074.2 +082800 NC1074.2 +082900 NC1074.2 +083000 NC1074.2 +083100 NC1074.2 +083200 NC1074.2 +083300 NC1074.2 +083400 NC1074.2 +083500 NC1074.2 +083600 NC1074.2 +083700 NC1074.2 +083800 NC1074.2 +083900 NC1074.2 +084000 NC1074.2 +084100 NC1074.2 +084200 NC1074.2 +084300 NC1074.2 +084400 NC1074.2 +084500 NC1074.2 +084600 NC1074.2 +084700 NC1074.2 +084800 NC1074.2 +084900 NC1074.2 +085000 NC1074.2 +085100 NC1074.2 +085200 NC1074.2 +085300 NC1074.2 +085400 NC1074.2 +085500 NC1074.2 +085600 NC1074.2 +085700 NC1074.2 +085800 NC1074.2 +085900 NC1074.2 +086000 NC1074.2 +086100 NC1074.2 +086200 NC1074.2 +086300 NC1074.2 +086400 NC1074.2 +086500 NC1074.2 +086600 NC1074.2 +086700 NC1074.2 +086800 NC1074.2 +086900 NC1074.2 +087000 NC1074.2 +087100 NC1074.2 +087200 NC1074.2 +087300 NC1074.2 +087400 NC1074.2 +087500 NC1074.2 +087600 NC1074.2 +087700 NC1074.2 +087800 NC1074.2 +087900 NC1074.2 +088000 NC1074.2 +088100 NC1074.2 +088200 NC1074.2 +088300 NC1074.2 +088400 NC1074.2 +088500 NC1074.2 +088600 NC1074.2 +088700 NC1074.2 +088800 NC1074.2 +088900 NC1074.2 +089000 NC1074.2 +089100 NC1074.2 +089200 NC1074.2 +089300 NC1074.2 +089400 NC1074.2 +089500 NC1074.2 +089600 NC1074.2 +089700 NC1074.2 +089800 NC1074.2 +089900 NC1074.2 +090000 NC1074.2 +090100 NC1074.2 +090200 NC1074.2 +090300 NC1074.2 +090400 NC1074.2 +090500 NC1074.2 +090600 NC1074.2 +090700 NC1074.2 +090800 NC1074.2 +090900 NC1074.2 +091000 NC1074.2 +091100 NC1074.2 +091200 NC1074.2 +091300 NC1074.2 +091400 NC1074.2 +091500 NC1074.2 +091600 NC1074.2 +091700 SUBTRACT NC1074.2 +091800 1 FROM ERROR-COUNTER. NC1074.2 +091900 PERFORM PASS. NC1074.2 +092000 GO TO SEP-WRITE-4. NC1074.2 +092100 SEP-DELETE-4. NC1074.2 +092200 PERFORM DE-LETE. NC1074.2 +092300 SEP-WRITE-4. NC1074.2 +092400 MOVE "SEP-TEST-4" TO PAR-NAME. NC1074.2 +092500 PERFORM PRINT-DETAIL. NC1074.2 +092600 SEP-TEST-5 SECTION. NC1074.2 +092700 SEP-TEST-5-PARA. NC1074.2 +092800* ==--> SEMICOLON AS SEPARATOR <--== NC1074.2 +092900 MOVE "IV-4 4.2.1(2)" TO ANSI-REFERENCE. NC1074.2 +093000 S5. PERFORM PASS, IF P-OR-F EQUAL TO "PASS " GO TO NC1074.2 +093100 SEP-WRITE-5; ELSE PERFORM FAIL, GO TO SEP-WRITE-5. NC1074.2 +093200 SEP-DELETE-5. NC1074.2 +093300 PERFORM DE-LETE. NC1074.2 +093400 SEP-WRITE-5. NC1074.2 +093500 MOVE "SEP-TEST-5" TO PAR-NAME. NC1074.2 +093600 PERFORM PRINT-DETAIL. NC1074.2 +093700 JUST-INIT-01. NC1074.2 +093800 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +093900* NC1074.2 +094000* INITIALIZATION TAKES PLACE INDEPENDENT OF ANY JUSTIFIED NC1074.2 +094100* CLAUSE. NC1074.2 +094200* REFERENCE - X3.23-1985, PAGE VI-49, 5.15.4(1)C. NC1074.2 +094300* NC1074.2 +094400 MOVE "JUST WITH VALUE" TO FEATURE. NC1074.2 +094500 MOVE "JUST-TEST-01" TO PAR-NAME. NC1074.2 +094600 JUST-TEST-01-1. NC1074.2 +094700 IF XJ-00002 EQUAL TO "AB" NC1074.2 +094800 PERFORM PASS NC1074.2 +094900 GO TO JUST-WRITE-01-1 NC1074.2 +095000 ELSE GO TO JUST-FAIL-01-1. NC1074.2 +095100 JUST-DELETE-01-1. NC1074.2 +095200 PERFORM DE-LETE. NC1074.2 +095300 GO TO JUST-WRITE-01-1. NC1074.2 +095400 JUST-FAIL-01-1. NC1074.2 +095500 PERFORM FAIL. NC1074.2 +095600 MOVE XJ-00002 TO COMPUTED-A. NC1074.2 +095700 MOVE "AB" TO CORRECT-A. NC1074.2 +095800 JUST-WRITE-01-1. NC1074.2 +095900 MOVE 1 TO REC-CT. NC1074.2 +096000 PERFORM PRINT-DETAIL. NC1074.2 +096100 JUST-TEST-01-2. NC1074.2 +096200 IF XJ-00003 EQUAL TO "XY " NC1074.2 +096300 PERFORM PASS NC1074.2 +096400 GO TO JUST-WRITE-01-2 NC1074.2 +096500 ELSE GO TO JUST-FAIL-01-2. NC1074.2 +096600 JUST-DELETE-01-2. NC1074.2 +096700 PERFORM DE-LETE. NC1074.2 +096800 GO TO JUST-WRITE-01-2. NC1074.2 +096900 JUST-FAIL-01-2. NC1074.2 +097000 PERFORM FAIL. NC1074.2 +097100 MOVE XJ-00003 TO COMPUTED-A. NC1074.2 +097200 MOVE "XY " TO CORRECT-A. NC1074.2 +097300 JUST-WRITE-01-2. NC1074.2 +097400 MOVE 2 TO REC-CT. NC1074.2 +097500 PERFORM PRINT-DETAIL. NC1074.2 +097600 JUST-INIT-02. NC1074.2 +097700 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +097800* NC1074.2 +097900* JUSTIFIED RECEIVING ITEM TESTS NC1074.2 +098000* IF THE SENDING ITEM IS LARGER THAN THE RECEIVING ITEM, NC1074.2 +098100* THEN THE LEFTMOST CHARACTERS ARE TRUNCATED. IF THE SENDING NC1074.2 +098200* ITEM IS SMALLER THAN THE RECEIVING ITEM, THEN THE DATA IS NC1074.2 +098300* ALIGNED TO THE RIGHT WITH SPACES IN THE LEFTMOST CHARACTER NC1074.2 +098400* POSITIONS. NC1074.2 +098500* REFERENCE - X3.23-1985, PAGE VI-24, 6.5.4.(1) NC1074.2 +098600* NC1074.2 +098700* JUST-TEST-02 CONTAINS STATEMENTS OF THE FORM NC1074.2 +098800* MOVE ALPHANUMERIC LITERAL TO ALPHANUMERIC JUSTIFIED ITEM.NC1074.2 +098900* NC1074.2 +099000 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +099100 MOVE "JUST-TEST-02" TO PAR-NAME. NC1074.2 +099200 JUST-TEST-02-1-0. NC1074.2 +099300 MOVE "ABC" TO XJ-00005. NC1074.2 +099400 JUST-TEST-02-1-1. NC1074.2 +099500 IF XJ-00005 EQUAL TO " ABC" NC1074.2 +099600 PERFORM PASS NC1074.2 +099700 GO TO JUST-WRITE-02-1 NC1074.2 +099800 ELSE GO TO JUST-FAIL-02-1. NC1074.2 +099900 JUST-DELETE-02-1. NC1074.2 +100000 PERFORM DE-LETE. NC1074.2 +100100 GO TO JUST-WRITE-02-1. NC1074.2 +100200 JUST-FAIL-02-1. NC1074.2 +100300 PERFORM FAIL. NC1074.2 +100400 MOVE " ABC" TO CORRECT-A. NC1074.2 +100500 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +100600 JUST-WRITE-02-1. NC1074.2 +100700 MOVE 1 TO REC-CT. NC1074.2 +100800 PERFORM PRINT-DETAIL. NC1074.2 +100900 JUST-TEST-02-2-0. NC1074.2 +101000 MOVE "ABCDEFGHI" TO XJ-00005. NC1074.2 +101100 JUST-TEST-02-2-1. NC1074.2 +101200 IF XJ-00005 EQUAL TO "EFGHI" NC1074.2 +101300 PERFORM PASS NC1074.2 +101400 GO TO JUST-WRITE-02-2 NC1074.2 +101500 ELSE GO TO JUST-FAIL-02-2. NC1074.2 +101600 JUST-DELETE-02-2. NC1074.2 +101700 PERFORM DE-LETE. NC1074.2 +101800 GO TO JUST-WRITE-02-2. NC1074.2 +101900 JUST-FAIL-02-2. NC1074.2 +102000 PERFORM FAIL. NC1074.2 +102100 MOVE "EFGHI" TO CORRECT-A. NC1074.2 +102200 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +102300 JUST-WRITE-02-2. NC1074.2 +102400 MOVE 2 TO REC-CT. NC1074.2 +102500 PERFORM PRINT-DETAIL. NC1074.2 +102600 JUST-TEST-02-3-0. NC1074.2 +102700 MOVE "CDEFG" TO XJ-00005. NC1074.2 +102800 JUST-TEST-02-3-1. NC1074.2 +102900 IF XJ-00005 EQUAL TO "CDEFG" NC1074.2 +103000 PERFORM PASS NC1074.2 +103100 GO TO JUST-WRITE-02-3 NC1074.2 +103200 ELSE GO TO JUST-FAIL-02-3. NC1074.2 +103300 JUST-DELETE-02-3. NC1074.2 +103400 PERFORM DE-LETE. NC1074.2 +103500 GO TO JUST-WRITE-02-3. NC1074.2 +103600 JUST-FAIL-02-3. NC1074.2 +103700 PERFORM FAIL. NC1074.2 +103800 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +103900 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +104000 JUST-WRITE-02-3. NC1074.2 +104100 MOVE 3 TO REC-CT. NC1074.2 +104200 PERFORM PRINT-DETAIL. NC1074.2 +104300 JUST-INIT-03. NC1074.2 +104400 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +104500* NC1074.2 +104600* JUST-TEST-03 CONTAINS STATEMENTS OF THE FORM NC1074.2 +104700* MOVE ALPHANUMERIC ITEM TO ALPHABETIC JUSTIFIED ITEM. NC1074.2 +104800* NC1074.2 +104900 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +105000 MOVE "JUST-TEST-03" TO PAR-NAME. NC1074.2 +105100 JUST-TEST-03-1-0. NC1074.2 +105200 MOVE NJUST-XN-3 TO AJ-00005. NC1074.2 +105300 JUST-TEST-03-1-1. NC1074.2 +105400 IF AJ-00005 EQUAL TO " ABC" NC1074.2 +105500 PERFORM PASS NC1074.2 +105600 GO TO JUST-WRITE-03-1 NC1074.2 +105700 ELSE GO TO JUST-FAIL-03-1. NC1074.2 +105800 JUST-DELETE-03-1. NC1074.2 +105900 PERFORM DE-LETE. NC1074.2 +106000 GO TO JUST-WRITE-03-1. NC1074.2 +106100 JUST-FAIL-03-1. NC1074.2 +106200 PERFORM FAIL. NC1074.2 +106300 MOVE " ABC" TO CORRECT-A. NC1074.2 +106400 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +106500 JUST-WRITE-03-1. NC1074.2 +106600 MOVE 1 TO REC-CT. NC1074.2 +106700 PERFORM PRINT-DETAIL. NC1074.2 +106800 JUST-TEST-03-2-0. NC1074.2 +106900 MOVE NJUST-XN-5 TO AJ-00005. NC1074.2 +107000 JUST-TEST-03-2-1. NC1074.2 +107100 IF AJ-00005 EQUAL TO "CDEFG" NC1074.2 +107200 PERFORM PASS NC1074.2 +107300 GO TO JUST-WRITE-03-2 NC1074.2 +107400 ELSE GO TO JUST-FAIL-03-2. NC1074.2 +107500 JUST-DELETE-03-2. NC1074.2 +107600 PERFORM DE-LETE. NC1074.2 +107700 GO TO JUST-WRITE-03-2. NC1074.2 +107800 JUST-FAIL-03-2. NC1074.2 +107900 PERFORM FAIL. NC1074.2 +108000 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +108100 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +108200 JUST-WRITE-03-2. NC1074.2 +108300 MOVE 2 TO REC-CT. NC1074.2 +108400 PERFORM PRINT-DETAIL. NC1074.2 +108500 JUST-TEST-03-3-0. NC1074.2 +108600 MOVE NJUST-XN-15 TO AJ-00005. NC1074.2 +108700 JUST-TEST-03-3-1. NC1074.2 +108800 IF AJ-00005 EQUAL TO "KLMNO" NC1074.2 +108900 PERFORM PASS NC1074.2 +109000 GO TO JUST-WRITE-03-3 NC1074.2 +109100 ELSE GO TO JUST-FAIL-03-3. NC1074.2 +109200 JUST-DELETE-03-3. NC1074.2 +109300 PERFORM DE-LETE. NC1074.2 +109400 GO TO JUST-WRITE-03-3. NC1074.2 +109500 JUST-FAIL-03-3. NC1074.2 +109600 PERFORM FAIL. NC1074.2 +109700 MOVE "KLMNO" TO CORRECT-A. NC1074.2 +109800 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +109900 JUST-WRITE-03-3. NC1074.2 +110000 MOVE 3 TO REC-CT. NC1074.2 +110100 PERFORM PRINT-DETAIL. NC1074.2 +110200 JUST-INIT-04. NC1074.2 +110300 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +110400* NC1074.2 +110500* JUST-TEST-04 CONTAINS STATEMENTS OF THE FORM NC1074.2 +110600* MOVE GROUP ITEM TO ALPHABETIC JUSTIFIED ITEM. NC1074.2 +110700* NC1074.2 +110800 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +110900 MOVE "JUST-TEST-04" TO PAR-NAME. NC1074.2 +111000 JUST-TEST-04-1-0. NC1074.2 +111100 MOVE GROUP-TO-JUST-1 TO AJ-00007. NC1074.2 +111200 JUST-TEST-04-1-1. NC1074.2 +111300 IF AJ-00007 EQUAL TO " ABC" NC1074.2 +111400 PERFORM PASS NC1074.2 +111500 GO TO JUST-WRITE-04-1 NC1074.2 +111600 ELSE GO TO JUST-FAIL-04-1. NC1074.2 +111700 JUST-DELETE-04-1. NC1074.2 +111800 PERFORM DE-LETE. NC1074.2 +111900 GO TO JUST-WRITE-04-1. NC1074.2 +112000 JUST-FAIL-04-1. NC1074.2 +112100 PERFORM FAIL. NC1074.2 +112200 MOVE " ABC" TO CORRECT-A. NC1074.2 +112300 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +112400 JUST-WRITE-04-1. NC1074.2 +112500 MOVE 1 TO REC-CT. NC1074.2 +112600 PERFORM PRINT-DETAIL. NC1074.2 +112700 JUST-TEST-04-2-0. NC1074.2 +112800 MOVE GROUP-TO-JUST-21 TO AJ-00007. NC1074.2 +112900 JUST-TEST-04-2-1. NC1074.2 +113000 IF AJ-00007 EQUAL TO "ABCDEFG" NC1074.2 +113100 PERFORM PASS NC1074.2 +113200 GO TO JUST-WRITE-04-2 NC1074.2 +113300 ELSE GO TO JUST-FAIL-04-2. NC1074.2 +113400 JUST-DELETE-04-2. NC1074.2 +113500 PERFORM DE-LETE. NC1074.2 +113600 GO TO JUST-WRITE-04-2. NC1074.2 +113700 JUST-FAIL-04-2. NC1074.2 +113800 PERFORM FAIL. NC1074.2 +113900 MOVE "ABCDEFG" TO CORRECT-A. NC1074.2 +114000 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +114100 JUST-WRITE-04-2. NC1074.2 +114200 MOVE 2 TO REC-CT. NC1074.2 +114300 PERFORM PRINT-DETAIL. NC1074.2 +114400 JUST-TEST-04-3-0. NC1074.2 +114500 MOVE GROUP-TO-JUST-2 TO AJ-00007. NC1074.2 +114600 JUST-TEST-04-3-1. NC1074.2 +114700 IF AJ-00007 EQUAL TO "IJKLMNO" NC1074.2 +114800 PERFORM PASS NC1074.2 +114900 GO TO JUST-WRITE-04-3 NC1074.2 +115000 ELSE GO TO JUST-FAIL-04-3. NC1074.2 +115100 JUST-DELETE-04-3. NC1074.2 +115200 PERFORM DE-LETE. NC1074.2 +115300 GO TO JUST-WRITE-04-3. NC1074.2 +115400 JUST-FAIL-04-3. NC1074.2 +115500 PERFORM FAIL. NC1074.2 +115600 MOVE "IJKLMNO" TO CORRECT-A. NC1074.2 +115700 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +115800 JUST-WRITE-04-3. NC1074.2 +115900 MOVE 3 TO REC-CT. NC1074.2 +116000 PERFORM PRINT-DETAIL. NC1074.2 +116100 JUST-INIT-05. NC1074.2 +116200 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +116300* NC1074.2 +116400* JUST-TEST-05 CONTAINS MOVE STATEMENTS WITH A JUSTIFIED NC1074.2 +116500* SENDING ITEM. NC1074.2 +116600* NC1074.2 +116700 MOVE "MOVE-JUST SEND ITEM" TO FEATURE. NC1074.2 +116800 MOVE "JUST-TEST-05" TO PAR-NAME. NC1074.2 +116900 MOVE "12345ABCDEFGHUXYZ PQR" TO GROUP-WITH-JUST-ITEMS. NC1074.2 +117000 MOVE SPACE TO GROUP-FOR-JUST-TESTS. NC1074.2 +117100 JUST-TEST-05-1-0. NC1074.2 +117200 MOVE AJ-00009 TO NJUST-XN-15. NC1074.2 +117300 JUST-TEST-05-1-1. NC1074.2 +117400 IF NJUST-XN-15 EQUAL TO "XYZ PQR " NC1074.2 +117500 PERFORM PASS NC1074.2 +117600 GO TO JUST-WRITE-05-1 NC1074.2 +117700 ELSE GO TO JUST-FAIL-05-1. NC1074.2 +117800 JUST-DELETE-05-1. NC1074.2 +117900 PERFORM DE-LETE. NC1074.2 +118000 GO TO JUST-WRITE-05-1. NC1074.2 +118100 JUST-FAIL-05-1. NC1074.2 +118200 PERFORM FAIL. NC1074.2 +118300 MOVE "XYZ PQR " TO CORRECT-A. NC1074.2 +118400 MOVE NJUST-XN-15 TO COMPUTED-A. NC1074.2 +118500 JUST-WRITE-05-1. NC1074.2 +118600 MOVE 1 TO REC-CT. NC1074.2 +118700 PERFORM PRINT-DETAIL. NC1074.2 +118800 JUST-TEST-05-2-0. NC1074.2 +118900 MOVE XJ-00009 TO NJUST-XN-3. NC1074.2 +119000 JUST-TEST-05-2-1. NC1074.2 +119100 IF NJUST-XN-3 EQUAL TO "ABC" NC1074.2 +119200 PERFORM PASS NC1074.2 +119300 GO TO JUST-WRITE-05-2 NC1074.2 +119400 ELSE GO TO JUST-FAIL-05-2. NC1074.2 +119500 JUST-DELETE-05-2. NC1074.2 +119600 PERFORM DE-LETE. NC1074.2 +119700 GO TO JUST-WRITE-05-2. NC1074.2 +119800 JUST-FAIL-05-2. NC1074.2 +119900 PERFORM FAIL. NC1074.2 +120000 MOVE NJUST-XN-3 TO COMPUTED-A. NC1074.2 +120100 MOVE "ABC" TO CORRECT-A. NC1074.2 +120200 JUST-WRITE-05-2. NC1074.2 +120300 MOVE 2 TO REC-CT. NC1074.2 +120400 PERFORM PRINT-DETAIL. NC1074.2 +120500 JUST-INIT-06. NC1074.2 +120600 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +120700* NC1074.2 +120800* JUST-TEST-06 CONTAINS MOVE STATEMENTS WITH A JUSTIFIED NC1074.2 +120900* SENDING ITEM AND A JUSTIFIED RECEIVING ITEM. NC1074.2 +121000* NC1074.2 +121100 MOVE "MOVE - JUST TO JUST" TO FEATURE. NC1074.2 +121200 MOVE "JUST-TEST-06" TO PAR-NAME. NC1074.2 +121300 MOVE "12345ABCDEFGHIXYZ PQR" TO GROUP-WITH-JUST-ITEMS. NC1074.2 +121400 JUST-TEST-06-0. NC1074.2 +121500 MOVE SPACE TO XJ-00005. NC1074.2 +121600 JUST-TEST-06-1. NC1074.2 +121700 MOVE XJ-00009 TO XJ-00005. NC1074.2 +121800 IF XJ-00005 EQUAL TO "EFGHI" NC1074.2 +121900 PERFORM PASS NC1074.2 +122000 GO TO JUST-WRITE-06-1 NC1074.2 +122100 ELSE GO TO JUST-FAIL-06-1. NC1074.2 +122200 JUST-DELETE-06-1. NC1074.2 +122300 PERFORM DE-LETE. NC1074.2 +122400 GO TO JUST-WRITE-06-1. NC1074.2 +122500 JUST-FAIL-06-1. NC1074.2 +122600 PERFORM FAIL. NC1074.2 +122700 MOVE "EFGHI" TO CORRECT-A. NC1074.2 +122800 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +122900 JUST-WRITE-06-1. NC1074.2 +123000 MOVE 1 TO REC-CT. NC1074.2 +123100 PERFORM PRINT-DETAIL. NC1074.2 +123200 JUST-INIT-06-2. NC1074.2 +123300 MOVE SPACE TO AJ-00005. NC1074.2 +123400 JUST-TEST-06-2. NC1074.2 +123500 MOVE AJ-00009 TO AJ-00005. NC1074.2 +123600 IF AJ-00005 EQUAL TO " PQR" NC1074.2 +123700 PERFORM PASS NC1074.2 +123800 GO TO JUST-WRITE-06-2 NC1074.2 +123900 ELSE GO TO JUST-FAIL-06-2. NC1074.2 +124000 JUST-DELETE-06-2. NC1074.2 +124100 PERFORM DE-LETE. NC1074.2 +124200 GO TO JUST-WRITE-06-2. NC1074.2 +124300 JUST-FAIL-06-2. NC1074.2 +124400 PERFORM FAIL. NC1074.2 +124500 MOVE " PQR" TO CORRECT-A. NC1074.2 +124600 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +124700 JUST-WRITE-06-2. NC1074.2 +124800 MOVE 2 TO REC-CT. NC1074.2 +124900 PERFORM PRINT-DETAIL. NC1074.2 +125000 JUST-INIT-06-3. NC1074.2 +125100 MOVE "ABCDEFG" TO XJ-00007. NC1074.2 +125200 MOVE SPACE TO AJ-00007. NC1074.2 +125300 JUST-TEST-06-3. NC1074.2 +125400 MOVE XJ-00007 TO AJ-00007. NC1074.2 +125500 IF AJ-00007 EQUAL TO "ABCDEFG" NC1074.2 +125600 PERFORM PASS NC1074.2 +125700 GO TO JUST-WRITE-06-3 NC1074.2 +125800 ELSE GO TO JUST-FAIL-06-3. NC1074.2 +125900 JUST-DELETE-06-3. NC1074.2 +126000 PERFORM DE-LETE. NC1074.2 +126100 GO TO JUST-WRITE-06-3. NC1074.2 +126200 JUST-FAIL-06-3. NC1074.2 +126300 PERFORM FAIL. NC1074.2 +126400 MOVE "ABCDEFG" TO CORRECT-A. NC1074.2 +126500 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +126600 JUST-WRITE-06-3. NC1074.2 +126700 MOVE 3 TO REC-CT. NC1074.2 +126800 PERFORM PRINT-DETAIL. NC1074.2 +126900 JUST-INIT-06-4. NC1074.2 +127000 MOVE SPACE TO XJ-00005. NC1074.2 +127100 JUST-TEST-06-4. NC1074.2 +127200 MOVE XJ-00007 TO XJ-00005. NC1074.2 +127300 IF XJ-00005 EQUAL TO "CDEFG" NC1074.2 +127400 PERFORM PASS NC1074.2 +127500 GO TO JUST-WRITE-06-4 NC1074.2 +127600 ELSE GO TO JUST-FAIL-06-4. NC1074.2 +127700 JUST-DELETE-06-4. NC1074.2 +127800 PERFORM DE-LETE. NC1074.2 +127900 GO TO JUST-WRITE-06-4. NC1074.2 +128000 JUST-FAIL-06-4. NC1074.2 +128100 PERFORM FAIL. NC1074.2 +128200 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +128300 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +128400 JUST-WRITE-06-4. NC1074.2 +128500 MOVE 4 TO REC-CT. NC1074.2 +128600 PERFORM PRINT-DETAIL. NC1074.2 +128700 JUST-INIT-06-5. NC1074.2 +128800 MOVE SPACE TO XJ-00009. NC1074.2 +128900 JUST-TEST-06-5. NC1074.2 +129000 MOVE XJ-00007 TO XJ-00009. NC1074.2 +129100 IF XJ-00009 EQUAL TO " ABCDEFG" NC1074.2 +129200 PERFORM PASS NC1074.2 +129300 GO TO JUST-WRITE-06-5 NC1074.2 +129400 ELSE GO TO JUST-FAIL-06-5. NC1074.2 +129500 JUST-DELETE-06-5. NC1074.2 +129600 PERFORM DE-LETE. NC1074.2 +129700 GO TO JUST-WRITE-06-5. NC1074.2 +129800 JUST-FAIL-06-5. NC1074.2 +129900 PERFORM FAIL. NC1074.2 +130000 MOVE " ABCDEFG" TO CORRECT-A. NC1074.2 +130100 MOVE XJ-00009 TO COMPUTED-A. NC1074.2 +130200 JUST-WRITE-06-5. NC1074.2 +130300 MOVE 5 TO REC-CT. NC1074.2 +130400 PERFORM PRINT-DETAIL. NC1074.2 +130500 MOVE 0 TO REC-CT. NC1074.2 +130600 SYNC-TEST-1. NC1074.2 +130700 MOVE "VI-44 5.13.4" TO ANSI-REFERENCE. NC1074.2 +130800 IF DATA-G EQUAL TO DATA-H NC1074.2 +130900 PERFORM PASS NC1074.2 +131000 ELSE NC1074.2 +131100 PERFORM FAIL. NC1074.2 +131200 GO TO SYNC-WRITE-1. NC1074.2 +131300 SYNC-DELETE-1. NC1074.2 +131400 PERFORM DE-LETE. NC1074.2 +131500 SYNC-WRITE-1. NC1074.2 +131600 MOVE "SYNCHRONIZED" TO FEATURE. NC1074.2 +131700 MOVE "SYNC-TEST-1" TO PAR-NAME. NC1074.2 +131800 PERFORM PRINT-DETAIL. NC1074.2 +131900 BZERO-INIT. NC1074.2 +132000 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +132100 MOVE "BLANK WHEN ZERO" TO FEATURE. NC1074.2 +132200 BZERO-TEST-1-0. NC1074.2 +132300 MOVE 0000000000 TO DATA-F. NC1074.2 +132400 BZERO-TEST-1-1. NC1074.2 +132500 IF DATA-F EQUAL TO " " NC1074.2 +132600 PERFORM PASS NC1074.2 +132700 ELSE NC1074.2 +132800 GO TO BZERO-FAIL-1. NC1074.2 +132900 GO TO BZERO-WRITE-1. NC1074.2 +133000 BZERO-DELETE-1. NC1074.2 +133100 PERFORM DE-LETE. NC1074.2 +133200 GO TO BZERO-WRITE-1. NC1074.2 +133300 BZERO-FAIL-1. NC1074.2 +133400 MOVE DATA-F TO COMPUTED-A. NC1074.2 +133500 MOVE "SHOULD BE BLANK" TO CORRECT-A. NC1074.2 +133600 PERFORM FAIL. NC1074.2 +133700 BZERO-WRITE-1. NC1074.2 +133800 MOVE "BZERO-TEST-1" TO PAR-NAME. NC1074.2 +133900 PERFORM PRINT-DETAIL. NC1074.2 +134000 BZERO-INIT-2. NC1074.2 +134100 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +134200 MOVE 0000 TO DATA-M. NC1074.2 +134300 BZERO-TEST-2. NC1074.2 +134400 IF DATA-M EQUAL TO SPACE NC1074.2 +134500 PERFORM PASS NC1074.2 +134600 GO TO BZERO-WRITE-2. NC1074.2 +134700 GO TO BZERO-FAIL-2. NC1074.2 +134800 BZERO-DELETE-2. NC1074.2 +134900 PERFORM DE-LETE. NC1074.2 +135000 GO TO BZERO-WRITE-2. NC1074.2 +135100 BZERO-FAIL-2. NC1074.2 +135200 MOVE DATA-M TO COMPUTED-A. NC1074.2 +135300 MOVE "SHOULD BE BLANK" TO CORRECT-A. NC1074.2 +135400 PERFORM FAIL. NC1074.2 +135500 BZERO-WRITE-2. NC1074.2 +135600 MOVE "BZERO-TEST-2" TO PAR-NAME. NC1074.2 +135700 PERFORM PRINT-DETAIL. NC1074.2 +135800 BZERO-INIT-3. NC1074.2 +135900 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +136000 BZERO-TEST-3. NC1074.2 +136100 IF DATA-P1 EQUAL TO "000" NC1074.2 +136200 PERFORM PASS GO TO BZERO-WRITE-3. NC1074.2 +136300 GO TO BZERO-FAIL-3. NC1074.2 +136400 BZERO-DELETE-3. NC1074.2 +136500 PERFORM DE-LETE. NC1074.2 +136600 GO TO BZERO-WRITE-3. NC1074.2 +136700 BZERO-FAIL-3. NC1074.2 +136800 PERFORM FAIL. NC1074.2 +136900 MOVE DATA-P1 TO COMPUTED-A. NC1074.2 +137000 MOVE "000" TO CORRECT-A. NC1074.2 +137100 BZERO-WRITE-3. NC1074.2 +137200 MOVE "BZERO-TEST-3" TO PAR-NAME. NC1074.2 +137300 PERFORM PRINT-DETAIL. NC1074.2 +137400 LONG-PARAGRAPH-NAME-----INIT-1. NC1074.2 +137500 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +137600 LONG-PARAGRAPH-NAME-----TEST-1. NC1074.2 +137700 PERFORM PASS. NC1074.2 +137800 GO TO LONG-WRITE-1. NC1074.2 +137900 LONG-DELETE-1. NC1074.2 +138000 PERFORM DE-LETE. NC1074.2 +138100 LONG-WRITE-1. NC1074.2 +138200 MOVE "LONG PARAGRAPH-NAME" TO FEATURE. NC1074.2 +138300 MOVE "LONG-PARAGRAPH---ETC" TO PAR-NAME. NC1074.2 +138400 PERFORM PRINT-DETAIL. NC1074.2 +138500 LONG-INIT-2. NC1074.2 +138600 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +138700 LONG-TEST-2. NC1074.2 +138800 MOVE SPACE TO A-DATA-NAME-30-CHARACTERS-LONG. NC1074.2 +138900 PERFORM PASS. NC1074.2 +139000 GO TO LONG-WRITE-2. NC1074.2 +139100 LONG-DELETE-2. NC1074.2 +139200 PERFORM DE-LETE. NC1074.2 +139300 LONG-WRITE-2. NC1074.2 +139400 MOVE "LONG DATA-NAME" TO FEATURE. NC1074.2 +139500 MOVE "LONG-TEST-2" TO PAR-NAME. NC1074.2 +139600 PERFORM PRINT-DETAIL. NC1074.2 +139700 LONG-INIT-3. NC1074.2 +139800 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +139900 LONG-TEST-3. NC1074.2 +140000 MOVE SPACE TO LONG-PICTURE. NC1074.2 +140100 PERFORM PASS. NC1074.2 +140200 GO TO LONG-WRITE-3. NC1074.2 +140300 LONG-DELETE-3. NC1074.2 +140400 PERFORM DE-LETE. NC1074.2 +140500 LONG-WRITE-3. NC1074.2 +140600 MOVE "LONG PICTURE" TO FEATURE. NC1074.2 +140700 MOVE "LONG-TEST-3" TO PAR-NAME. NC1074.2 +140800 PERFORM PRINT-DETAIL. NC1074.2 +140900 LONG-INIT-4. NC1074.2 +141000 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +141100 LONG-TEST-4. NC1074.2 +141200 MOVE "LONG-TEST-4" TO PAR-NAME. NC1074.2 +141300 IF LONG-LITERAL EQUAL TO "STANDARD COMPILERS MUST ALLOWNC1074.2 +141400- " NON-NUMERIC LITERALS OF AT LEAST 120 CHARACTERS AND NUMERICNC1074.2 +141500- " LITERALS OF AT LEAST 18 DIGITS BUT NOW EXTENDED UPTO 160 DINC1074.2 +141600- "GITS FOR 8X" NC1074.2 +141700 PERFORM PASS NC1074.2 +141800 ELSE NC1074.2 +141900 GO TO LONG-FAIL-4. NC1074.2 +142000 GO TO LONG-WRITE-4. NC1074.2 +142100 LONG-DELETE-4. NC1074.2 +142200 MOVE "LONG-TEST-4" TO PAR-NAME. NC1074.2 +142300 PERFORM DE-LETE. NC1074.2 +142400 GO TO LONG-WRITE-4. NC1074.2 +142500 LONG-FAIL-4. NC1074.2 +142600 PERFORM FAIL. NC1074.2 +142700 MOVE SPACE TO TEST-RESULTS. NC1074.2 +142800 MOVE LONG20 TO COMPUTED-A. NC1074.2 +142900 PERFORM PRINT-DETAIL. NC1074.2 +143000 MOVE LONG40 TO COMPUTED-A. NC1074.2 +143100 PERFORM PRINT-DETAIL. NC1074.2 +143200 MOVE LONG60 TO COMPUTED-A. NC1074.2 +143300 PERFORM PRINT-DETAIL. NC1074.2 +143400 MOVE LONG80 TO COMPUTED-A. NC1074.2 +143500 PERFORM PRINT-DETAIL. NC1074.2 +143600 MOVE LONG100 TO COMPUTED-A. NC1074.2 +143700 PERFORM PRINT-DETAIL. NC1074.2 +143800 MOVE LONG120 TO COMPUTED-A. NC1074.2 +143900 PERFORM PRINT-DETAIL. NC1074.2 +144000 MOVE LONG140 TO COMPUTED-A. NC1074.2 +144100 PERFORM PRINT-DETAIL. NC1074.2 +144200 MOVE LONG160 TO COMPUTED-A. NC1074.2 +144300 PERFORM PRINT-DETAIL. NC1074.2 +144400 MOVE "SEE PROGRAM" TO RE-MARK. NC1074.2 +144500 LONG-WRITE-4. NC1074.2 +144600 MOVE "LONG NON-NUM LITERAL" TO FEATURE. NC1074.2 +144700 PERFORM PRINT-DETAIL. NC1074.2 +144800 LONG-INIT-5. NC1074.2 +144900 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +145000 MOVE 211113411,114311112 TO LONG-NUMBER. NC1074.2 +145100 LONG-TEST-5. NC1074.2 +145200 IF LONG-NUMBER EQUAL TO 211113411,114311112 PERFORM PASS NC1074.2 +145300 ELSE GO TO LONG-FAIL-5. NC1074.2 +145400 GO TO LONG-WRITE-5. NC1074.2 +145500 LONG-DELETE-5. NC1074.2 +145600 PERFORM DE-LETE. NC1074.2 +145700 GO TO LONG-WRITE-5. NC1074.2 +145800 LONG-FAIL-5. NC1074.2 +145900 MOVE LONG-NUMBER TO COMPUTED-N. NC1074.2 +146000 MOVE " 211113411,114311112" TO CORRECT-A. NC1074.2 +146100 PERFORM FAIL. NC1074.2 +146200 LONG-WRITE-5. NC1074.2 +146300 MOVE "LONG NUMERIC LITERAL" TO FEATURE. NC1074.2 +146400 MOVE "LONG-TEST-5" TO PAR-NAME. NC1074.2 +146500 PERFORM PRINT-DETAIL. NC1074.2 +146600 LONG-INIT-6. NC1074.2 +146700 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +146800 MOVE "ABCDEFGHIJKLMNOPQRST" TO LONG-PICTURE-A. NC1074.2 +146900 LONG-TEST-6. NC1074.2 +147000 MOVE LONG-PICTURE-A TO LONG-PICTURE-B. NC1074.2 +147100 MOVE LONG-PICTURE-B TO LONG-PICTURE-C. NC1074.2 +147200 IF LONG-PICTURE-C EQUAL TO "FGHIJKLMNO" NC1074.2 +147300 PERFORM PASS GO TO LONG-WRITE-6. NC1074.2 +147400 GO TO LONG-FAIL-6. NC1074.2 +147500 LONG-DELETE-6. NC1074.2 +147600 PERFORM DE-LETE. NC1074.2 +147700 GO TO LONG-WRITE-6. NC1074.2 +147800 LONG-FAIL-6. NC1074.2 +147900 MOVE LONG-PICTURE-C TO COMPUTED-A. NC1074.2 +148000 MOVE "FGHIJKLMNO" TO CORRECT-A. NC1074.2 +148100 PERFORM FAIL. NC1074.2 +148200 LONG-WRITE-6. NC1074.2 +148300 MOVE "LONG PICTURE" TO FEATURE. NC1074.2 +148400 MOVE "LONG-TEST-6" TO PAR-NAME. NC1074.2 +148500 PERFORM PRINT-DETAIL. NC1074.2 +148600 RDF-INIT-1. NC1074.2 +148700 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +148800 MOVE "REDEFINES" TO FEATURE. NC1074.2 +148900 RDF-TEST-1-0. NC1074.2 +149000 MOVE "5" TO REDEF2. NC1074.2 +149100 RDF-TEST-1-1. NC1074.2 +149200 IF REDEF1 EQUAL TO 5 PERFORM PASS GO TO RDF-WRITE-1. NC1074.2 +149300 GO TO RDF-FAIL-1. NC1074.2 +149400 RDF-DELETE-1. NC1074.2 +149500 PERFORM DE-LETE. NC1074.2 +149600 GO TO RDF-WRITE-1. NC1074.2 +149700 RDF-FAIL-1. NC1074.2 +149800 MOVE REDEF1 TO COMPUTED-A. NC1074.2 +149900 MOVE "5" TO CORRECT-A. NC1074.2 +150000 PERFORM FAIL. NC1074.2 +150100 RDF-WRITE-1. NC1074.2 +150200 MOVE "RDF-TEST-1" TO PAR-NAME. NC1074.2 +150300 PERFORM PRINT-DETAIL. NC1074.2 +150400 RDF-INIT-2. NC1074.2 +150500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +150600 RDF-TEST-2-0. NC1074.2 +150700 MOVE "W" TO REDEF4. NC1074.2 +150800 RDF-TEST-2-1. NC1074.2 +150900 IF REDEF3 EQUAL TO "WBC" PERFORM PASS GO TO RDF-WRITE-2. NC1074.2 +151000 GO TO RDF-FAIL-2. NC1074.2 +151100 RDF-DELETE-2. NC1074.2 +151200 PERFORM DE-LETE. NC1074.2 +151300 GO TO RDF-WRITE-2. NC1074.2 +151400 RDF-FAIL-2. NC1074.2 +151500 MOVE REDEF3 TO COMPUTED-A. NC1074.2 +151600 MOVE "WBC" TO CORRECT-A. NC1074.2 +151700 PERFORM FAIL. NC1074.2 +151800 RDF-WRITE-2. NC1074.2 +151900 MOVE "RDF-TEST-2" TO PAR-NAME. NC1074.2 +152000 PERFORM PRINT-DETAIL. NC1074.2 +152100 RDF-INIT-3. NC1074.2 +152200 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +152300 MOVE 123456 TO REDEF6. NC1074.2 +152400 MOVE "AB" TO REDEF8A. NC1074.2 +152500 MOVE "EF" TO REDEF8C. NC1074.2 +152600 RDF-TEST-3. NC1074.2 +152700 IF REDEF5 EQUAL TO "AB34EF" PERFORM PASS GO TO RDF-WRITE-3. NC1074.2 +152800 GO TO RDF-FAIL-3. NC1074.2 +152900 RDF-DELETE-3. NC1074.2 +153000 PERFORM DE-LETE. NC1074.2 +153100 GO TO RDF-WRITE-3. NC1074.2 +153200 RDF-FAIL-3. NC1074.2 +153300 MOVE REDEF5 TO COMPUTED-A. NC1074.2 +153400 MOVE "AB34EF" TO CORRECT-A. NC1074.2 +153500 PERFORM FAIL. NC1074.2 +153600 RDF-WRITE-3. NC1074.2 +153700 MOVE "RDF-TEST-3" TO PAR-NAME. NC1074.2 +153800 PERFORM PRINT-DETAIL. NC1074.2 +153900 RDF-INIT-4. NC1074.2 +154000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +154100 RDF-TEST-4. NC1074.2 +154200 IF RDFDATA7 EQUAL TO "ABC98765DE911644ALLD" NC1074.2 +154300 PERFORM PASS NC1074.2 +154400 GO TO RDF-WRITE-4. NC1074.2 +154500 MOVE RDFDATA7 TO COMPUTED-A. NC1074.2 +154600 MOVE "ABC98765DE911644ALLD" TO CORRECT-A. NC1074.2 +154700 PERFORM FAIL. NC1074.2 +154800 GO TO RDF-WRITE-4. NC1074.2 +154900 RDF-DELETE-4. NC1074.2 +155000 PERFORM DE-LETE. NC1074.2 +155100 RDF-WRITE-4. NC1074.2 +155200 MOVE "RDF-TEST-4 " TO PAR-NAME. NC1074.2 +155300 PERFORM PRINT-DETAIL. NC1074.2 +155400 RDF-INIT-5. NC1074.2 +155500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +155600 RDF-TEST-5. NC1074.2 +155700 IF RDFDATA8 (13) EQUAL TO "HG" NC1074.2 +155800 PERFORM PASS NC1074.2 +155900 GO TO RDF-WRITE-5. NC1074.2 +156000 MOVE "HG" TO CORRECT-A. NC1074.2 +156100 MOVE RDFDATA8 (13) TO COMPUTED-A. NC1074.2 +156200 PERFORM FAIL. NC1074.2 +156300 GO TO RDF-WRITE-5. NC1074.2 +156400 RDF-DELETE-5. NC1074.2 +156500 PERFORM DE-LETE. NC1074.2 +156600 RDF-WRITE-5. NC1074.2 +156700 MOVE "RDF-TEST-5 " TO PAR-NAME. NC1074.2 +156800 PERFORM PRINT-DETAIL. NC1074.2 +156900 RDF-INIT-6. NC1074.2 +157000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +157100 RDF-TEST-6. NC1074.2 +157200 IF RDFDATA2 EQUAL TO 9116,44 NC1074.2 +157300 PERFORM PASS NC1074.2 +157400 GO TO RDF-WRITE-6. NC1074.2 +157500 MOVE 9116,44 TO COMPUTED-N. NC1074.2 +157600 MOVE RDFDATA2 TO CORRECT-N. NC1074.2 +157700 PERFORM FAIL. NC1074.2 +157800 GO TO RDF-WRITE-6. NC1074.2 +157900 RDF-DELETE-6. NC1074.2 +158000 PERFORM DE-LETE. NC1074.2 +158100 RDF-WRITE-6. NC1074.2 +158200 MOVE "RDF-TEST-6 " TO PAR-NAME. NC1074.2 +158300 PERFORM PRINT-DETAIL. NC1074.2 +158400 RDF-INIT-7. NC1074.2 +158500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +158600 RDF-TEST-7. NC1074.2 +158700 IF RDFDATA16 EQUAL TO 66 NC1074.2 +158800 PERFORM PASS NC1074.2 +158900 GO TO RDF-WRITE-7. NC1074.2 +159000 MOVE RDFDATA16 TO COMPUTED-A. NC1074.2 +159100 MOVE 66 TO CORRECT-A. NC1074.2 +159200 PERFORM FAIL. NC1074.2 +159300 GO TO RDF-WRITE-7. NC1074.2 +159400 RDF-DELETE-7. NC1074.2 +159500 PERFORM DE-LETE. NC1074.2 +159600 RDF-WRITE-7. NC1074.2 +159700 MOVE "RDF-TEST-7 " TO PAR-NAME. NC1074.2 +159800 PERFORM PRINT-DETAIL. NC1074.2 +159900 RDF-INIT-8. NC1074.2 +160000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +160100 MOVE SPACE TO REDEF12. NC1074.2 +160200 RDF-TEST-8. NC1074.2 +160300 IF REDEF11 EQUAL TO SPACE NC1074.2 +160400 PERFORM PASS NC1074.2 +160500 GO TO RDF-WRITE-8. NC1074.2 +160600 MOVE "SPACE EXPECTED " TO CORRECT-A. NC1074.2 +160700 MOVE "NON BLANK CHARACTERS" TO COMPUTED-A. NC1074.2 +160800 MOVE "REDEF11 CONTAINS NON BLANKS" TO RE-MARK. NC1074.2 +160900 PERFORM FAIL. NC1074.2 +161000 GO TO RDF-WRITE-8. NC1074.2 +161100 RDF-DELETE-8. NC1074.2 +161200 PERFORM DE-LETE. NC1074.2 +161300 RDF-WRITE-8. NC1074.2 +161400 MOVE "RDF-TEST-8 " TO PAR-NAME. NC1074.2 +161500 PERFORM PRINT-DETAIL. NC1074.2 +161600 RDF-INIT-9. NC1074.2 +161700 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +161800 MOVE ZERO TO REDEF12. NC1074.2 +161900 MOVE SPACE TO REDEF11. NC1074.2 +162000 RDF-TEST-9. NC1074.2 +162100 IF RDFDATA18 EQUAL TO ZERO NC1074.2 +162200 PERFORM PASS NC1074.2 +162300 GO TO RDF-WRITE-9. NC1074.2 +162400 MOVE "00000000000000" TO CORRECT-A. NC1074.2 +162500 MOVE RDFDATA18 TO COMPUTED-A. NC1074.2 +162600 PERFORM FAIL. NC1074.2 +162700 GO TO RDF-WRITE-9. NC1074.2 +162800 RDF-DELETE-9. NC1074.2 +162900 PERFORM DE-LETE. NC1074.2 +163000 RDF-WRITE-9. NC1074.2 +163100 MOVE "RDF-TEST-9 " TO PAR-NAME. NC1074.2 +163200 PERFORM PRINT-DETAIL. NC1074.2 +163300 RDF-INIT-10. NC1074.2 +163400 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +163500 MOVE ZERO TO REDEF12. NC1074.2 +163600 MOVE "MOVING DATA TO A REDEFINED FIELD CAN BE RISKY " NC1074.2 +163700 TO REDEF10. NC1074.2 +163800 RDF-TEST-10. NC1074.2 +163900 IF RDFDATA8 (14) EQUAL TO "00" NC1074.2 +164000 PERFORM PASS NC1074.2 +164100 GO TO RDF-WRITE-10. NC1074.2 +164200 MOVE 00 TO CORRECT-A. NC1074.2 +164300 MOVE RDFDATA8 (14) TO COMPUTED-A. NC1074.2 +164400 PERFORM FAIL. NC1074.2 +164500 GO TO RDF-WRITE-10. NC1074.2 +164600 RDF-DELETE-10. NC1074.2 +164700 PERFORM DE-LETE. NC1074.2 +164800 RDF-WRITE-10. NC1074.2 +164900 MOVE "RDF-TEST-10 " TO PAR-NAME. NC1074.2 +165000 PERFORM PRINT-DETAIL. NC1074.2 +165100 RDF-INIT-11. NC1074.2 +165200 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +165300 RDF-TEST-11. NC1074.2 +165400 MOVE REDEF13 TO REDEF12. NC1074.2 +165500 IF REDEF10 EQUAL TO NC1074.2 +165600 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" NC1074.2 +165700 PERFORM PASS NC1074.2 +165800 GO TO RDF-WRITE-11. NC1074.2 +165900 MOVE "ALPHABETIC A 46 LONG" TO CORRECT-A COMPUTED-A. NC1074.2 +166000 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC1074.2 +166100 PERFORM FAIL. NC1074.2 +166200 GO TO RDF-WRITE-11. NC1074.2 +166300 RDF-DELETE-11. NC1074.2 +166400 PERFORM DE-LETE. NC1074.2 +166500 RDF-WRITE-11. NC1074.2 +166600 MOVE "RDF-TEST-11 " TO PAR-NAME. NC1074.2 +166700 PERFORM PRINT-DETAIL. NC1074.2 +166800 RDF-INIT-12. NC1074.2 +166900 MOVE "VI-38 5.10.3 SR6" TO ANSI-REFERENCE. NC1074.2 +167000 MOVE "ABC98765DE" TO REDEF20. NC1074.2 +167100 RDF-TEST-12. NC1074.2 +167200 IF REDEF22 = "ABC98765DE" NC1074.2 +167300 PERFORM PASS NC1074.2 +167400 GO TO RDF-WRITE-12. NC1074.2 +167500 GO TO RDF-FAIL-12. NC1074.2 +167600 RDF-DELETE-12. NC1074.2 +167700 PERFORM DE-LETE. NC1074.2 +167800 GO TO RDF-WRITE-12. NC1074.2 +167900 RDF-FAIL-12. NC1074.2 +168000 MOVE REDEF22 TO COMPUTED-A. NC1074.2 +168100 MOVE "ABC98765DE" TO CORRECT-A. NC1074.2 +168200 PERFORM FAIL. NC1074.2 +168300 RDF-WRITE-12. NC1074.2 +168400 MOVE "RDF-TEST-12 " TO PAR-NAME. NC1074.2 +168500 PERFORM PRINT-DETAIL. NC1074.2 +168600 RDF-INIT-13. NC1074.2 +168700 MOVE "VI-38 5.10.3 SR6" TO ANSI-REFERENCE. NC1074.2 +168800 MOVE "0987654321" TO REDEF22. NC1074.2 +168900 RDF-TEST-13. NC1074.2 +169000 IF REDEF23 = "098765432" NC1074.2 +169100 PERFORM PASS NC1074.2 +169200 GO TO RDF-WRITE-13. NC1074.2 +169300 GO TO RDF-FAIL-13. NC1074.2 +169400 RDF-DELETE-13. NC1074.2 +169500 PERFORM DE-LETE. NC1074.2 +169600 GO TO RDF-WRITE-13. NC1074.2 +169700 RDF-FAIL-13. NC1074.2 +169800 MOVE REDEF22 TO COMPUTED-A. NC1074.2 +169900 MOVE "098765432" TO CORRECT-A. NC1074.2 +170000 PERFORM FAIL. NC1074.2 +170100 RDF-WRITE-13. NC1074.2 +170200 MOVE "RDF-TEST-13" TO PAR-NAME. NC1074.2 +170300 PERFORM PRINT-DETAIL. NC1074.2 +170400 USAGE-INIT-1. NC1074.2 +170500 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +170600 MOVE "USAGE" TO FEATURE. NC1074.2 +170700 USAGE-TEST-1. NC1074.2 +170800 IF U2 GREATER THAN U7 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +170900 GO TO USAGE-WRITE-1. NC1074.2 +171000 USAGE-DELETE-1. NC1074.2 +171100 PERFORM DE-LETE. NC1074.2 +171200 USAGE-WRITE-1. NC1074.2 +171300 MOVE "USAGE-TEST-1" TO PAR-NAME. NC1074.2 +171400 PERFORM PRINT-DETAIL. NC1074.2 +171500 USAGE-INIT-2. NC1074.2 +171600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +171700 USAGE-TEST-2. NC1074.2 +171800 IF U2 EQUAL TO U4 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +171900 GO TO USAGE-WRITE-2. NC1074.2 +172000 USAGE-DELETE-2. NC1074.2 +172100 PERFORM DE-LETE. NC1074.2 +172200 USAGE-WRITE-2. NC1074.2 +172300 MOVE "USAGE-TEST-2" TO PAR-NAME. NC1074.2 +172400 PERFORM PRINT-DETAIL. NC1074.2 +172500 USAGE-INIT-3. NC1074.2 +172600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +172700 USAGE-TEST-3. NC1074.2 +172800 IF U3 EQUAL TO U4 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +172900 GO TO USAGE-WRITE-3. NC1074.2 +173000 USAGE-DELETE-3. NC1074.2 +173100 PERFORM DE-LETE. NC1074.2 +173200 USAGE-WRITE-3. NC1074.2 +173300 MOVE "USAGE-TEST-3" TO PAR-NAME. NC1074.2 +173400 PERFORM PRINT-DETAIL. NC1074.2 +173500 USAGE-INIT-4. NC1074.2 +173600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +173700 USAGE-TEST-4-0. NC1074.2 +173800 MOVE U5 TO U9. NC1074.2 +173900 USAGE-TEST-4-1. NC1074.2 +174000 IF U6 EQUAL TO U10 NC1074.2 +174100 PERFORM PASS NC1074.2 +174200 GO TO USAGE-WRITE-4. NC1074.2 +174300 GO TO USAGE-FAIL-4. NC1074.2 +174400 USAGE-DELETE-4. NC1074.2 +174500 PERFORM DE-LETE. NC1074.2 +174600 GO TO USAGE-WRITE-4. NC1074.2 +174700 USAGE-FAIL-4. NC1074.2 +174800 MOVE U10 TO COMPUTED-N. NC1074.2 +174900 MOVE U6 TO CORRECT-N. NC1074.2 +175000 PERFORM FAIL. NC1074.2 +175100 USAGE-WRITE-4. NC1074.2 +175200 MOVE "USAGE-TEST-4" TO PAR-NAME. NC1074.2 +175300 PERFORM PRINT-DETAIL. NC1074.2 +175400 USAGE-INIT-5. NC1074.2 +175500 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +175600 USAGE-TEST-5-0. NC1074.2 +175700 MOVE U5 TO U9. NC1074.2 +175800 USAGE-TEST-5-1. NC1074.2 +175900 IF U7 EQUAL TO U11 NC1074.2 +176000 PERFORM PASS NC1074.2 +176100 GO TO USAGE-WRITE-5. NC1074.2 +176200 MOVE U7 TO CORRECT-N. NC1074.2 +176300 MOVE U11 TO COMPUTED-N. NC1074.2 +176400 PERFORM FAIL. NC1074.2 +176500 GO TO USAGE-WRITE-5. NC1074.2 +176600 USAGE-DELETE-5. NC1074.2 +176700 PERFORM DE-LETE. NC1074.2 +176800 USAGE-WRITE-5. NC1074.2 +176900 MOVE "USAGE-TEST-5" TO PAR-NAME. NC1074.2 +177000 PERFORM PRINT-DETAIL. NC1074.2 +177100 USAGE-INIT-6. NC1074.2 +177200 MOVE "VI-47 5.14.4 GR3 GR9" TO ANSI-REFERENCE. NC1074.2 +177300 USAGE-TEST-6. NC1074.2 +177400 IF U22 GREATER THAN U12 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +177500 GO TO USAGE-WRITE-6. NC1074.2 +177600 USAGE-DELETE-6. NC1074.2 +177700 PERFORM DE-LETE. NC1074.2 +177800 USAGE-WRITE-6. NC1074.2 +177900 MOVE "USAGE-TEST-6" TO PAR-NAME. NC1074.2 +178000 PERFORM PRINT-DETAIL. NC1074.2 +178100 USAGE-INIT-7. NC1074.2 +178200 MOVE "VI-47 5.14.4 GR3 GR9" TO ANSI-REFERENCE. NC1074.2 +178300 USAGE-TEST-7. NC1074.2 +178400 IF U23 GREATER THAN U13 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +178500 GO TO USAGE-WRITE-7. NC1074.2 +178600 USAGE-DELETE-7. NC1074.2 +178700 PERFORM DE-LETE. NC1074.2 +178800 USAGE-WRITE-7. NC1074.2 +178900 MOVE "USAGE-TEST-7" TO PAR-NAME. NC1074.2 +179000 PERFORM PRINT-DETAIL. NC1074.2 +179100 VALUE-INIT-1. NC1074.2 +179200 MOVE "VI-50 5.15.6 (6)" TO ANSI-REFERENCE. NC1074.2 +179300 MOVE "VALUE FOR OCCURS FIELD" TO FEATURE. NC1074.2 +179400 MOVE "VALUE TESTS 1, 2 & 3" TO PAR-NAME. NC1074.2 +179500 VALUE-TEST-1. NC1074.2 +179600 MOVE 1 TO SUB1. NC1074.2 +179700 PERFORM VALUE-TEST-2 NC1074.2 +179800 UNTIL SUB1 > 10. NC1074.2 +179900 GO TO CURR-TEST-1. NC1074.2 +180000 VALUE-TEST-2. NC1074.2 +180100 MOVE 1 TO SUB2. NC1074.2 +180200 PERFORM VALUE-TEST-3 NC1074.2 +180300 UNTIL SUB2 > 10. NC1074.2 +180400 ADD 1 TO SUB1. NC1074.2 +180500 VALUE-TEST-3. NC1074.2 +180600 MOVE SUB1 TO TAB1. NC1074.2 +180700 MOVE SUB2 TO TAB2. NC1074.2 +180800 MOVE TAB-LOC TO PAR-NAME. NC1074.2 +180900 IF VALUE-TABLE-2 (SUB1 SUB2) = "AZ" NC1074.2 +181000 PERFORM PASS NC1074.2 +181100 ELSE NC1074.2 +181200 MOVE VALUE-TABLE-2 (SUB1 SUB2) TO COMPUTED-A NC1074.2 +181300 MOVE "AZ" TO CORRECT-A NC1074.2 +181400 PERFORM FAIL. NC1074.2 +181500 PERFORM PRINT-DETAIL. NC1074.2 +181600 ADD 1 TO SUB2. NC1074.2 +181700 VALUE-DELETE-1. NC1074.2 +181800 PERFORM DE-LETE. NC1074.2 +181900 PERFORM PRINT-DETAIL. NC1074.2 +182000 CURR-TEST-1. NC1074.2 +182100 MOVE DATA-I TO DATA-J. NC1074.2 +182200 IF DATA-J EQUAL TO " W12" PERFORM PASS GO TO CURR-WRITE-1. NC1074.2 +182300 GO TO CURR-FAIL-1. NC1074.2 +182400 CURR-DELETE-1. NC1074.2 +182500 PERFORM DE-LETE. NC1074.2 +182600 GO TO CURR-WRITE-1. NC1074.2 +182700 CURR-FAIL-1. NC1074.2 +182800 MOVE DATA-J TO COMPUTED-A. NC1074.2 +182900 MOVE " W12" TO CORRECT-A. NC1074.2 +183000 PERFORM FAIL. NC1074.2 +183100 CURR-WRITE-1. NC1074.2 +183200 MOVE "CURRENCY SIGN IS" TO FEATURE. NC1074.2 +183300 MOVE "CURR-TEST-1" TO PAR-NAME. NC1074.2 +183400 PERFORM PRINT-DETAIL. NC1074.2 +183500 DCOM-TEST-1. NC1074.2 +183600 MOVE DATA-K TO DATA-L. NC1074.2 +183700 IF DATA-L EQUAL TO "1.234.567,89" PERFORM PASS NC1074.2 +183800 GO TO DCOM-WRITE-1. NC1074.2 +183900 GO TO DCOM-FAIL-1. NC1074.2 +184000 DCOM-DELETE-1. NC1074.2 +184100 PERFORM DE-LETE. NC1074.2 +184200 GO TO DCOM-WRITE-1. NC1074.2 +184300 DCOM-FAIL-1. NC1074.2 +184400 MOVE DATA-L TO COMPUTED-A. NC1074.2 +184500 MOVE "1.234.567,89" TO CORRECT-A. NC1074.2 +184600 PERFORM FAIL. NC1074.2 +184700 DCOM-WRITE-1. NC1074.2 +184800 MOVE "DECIMAL IS COMMA" TO FEATURE. NC1074.2 +184900 MOVE "DCOM-TEST-1" TO PAR-NAME. NC1074.2 +185000 PERFORM PRINT-DETAIL. NC1074.2 +185100 DCOM-INIT-2. NC1074.2 +185200 MOVE "123456789." TO TEST-FIELD. NC1074.2 +185300 DCOM-TEST-2-1. NC1074.2 +185400 IF TEST-FIELD = "123456789." NC1074.2 +185500 PERFORM PASS NC1074.2 +185600 GO TO DCOM-WRITE-2. NC1074.2 +185700 GO TO DCOM-FAIL-2. NC1074.2 +185800 DCOM-DELETE-2. NC1074.2 +185900 PERFORM DE-LETE. NC1074.2 +186000 GO TO DCOM-WRITE-2. NC1074.2 +186100 DCOM-FAIL-2. NC1074.2 +186200 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +186300 MOVE "123456789." TO CORRECT-A. NC1074.2 +186400 PERFORM FAIL. NC1074.2 +186500 DCOM-WRITE-2. NC1074.2 +186600 MOVE "DCOM-TEST-2" TO PAR-NAME. NC1074.2 +186700 PERFORM PRINT-DETAIL. NC1074.2 +186800 DCOM-INIT-3. NC1074.2 +186900 MOVE "123456789," TO TEST-FIELD. NC1074.2 +187000 DCOM-TEST-3-1. NC1074.2 +187100 IF TEST-FIELD = "123456789," NC1074.2 +187200 PERFORM PASS NC1074.2 +187300 GO TO DCOM-WRITE-3. NC1074.2 +187400 GO TO DCOM-FAIL-3. NC1074.2 +187500 DCOM-DELETE-3. NC1074.2 +187600 PERFORM DE-LETE. NC1074.2 +187700 GO TO DCOM-WRITE-3. NC1074.2 +187800 DCOM-FAIL-3. NC1074.2 +187900 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +188000 MOVE "123456789," TO CORRECT-A. NC1074.2 +188100 PERFORM FAIL. NC1074.2 +188200 DCOM-WRITE-3. NC1074.2 +188300 MOVE "DCOM-TEST-3" TO PAR-NAME. NC1074.2 +188400 PERFORM PRINT-DETAIL. NC1074.2 +188500 NUM-INIT-A. NC1074.2 +188600 MOVE "NUMERIC PARA-NAMES" TO FEATURE. NC1074.2 +188700 PERFORM PRINT-DETAIL. NC1074.2 +188800 NUM-TEST-2. NC1074.2 +188900 MOVE 3 TO NUM-UTILITY. NC1074.2 +189000 GO TO 3 4 5 DEPENDING ON NUM-UTILITY. NC1074.2 +189100 PERFORM FAIL. NC1074.2 +189200 MOVE "GO TO DEPENDING IGNORED" TO RE-MARK. NC1074.2 +189300 GO TO NUM-WRITE-2. NC1074.2 +189400 NUM-DELETE-2. NC1074.2 +189500 PERFORM DE-LETE. NC1074.2 +189600 GO TO NUM-WRITE-2. NC1074.2 +189700 4. NC1074.2 +189800 PERFORM FAIL. NC1074.2 +189900 MOVE "PARAGRAPH 4 ENTERED" TO RE-MARK NC1074.2 +190000 GO TO NUM-WRITE-2. NC1074.2 +190100 5. NC1074.2 +190200 PERFORM PASS. NC1074.2 +190300 GO TO NUM-WRITE-2. NC1074.2 +190400 3. NC1074.2 +190500 PERFORM FAIL. NC1074.2 +190600 MOVE "PARAGRAPH 3 ENTERED" TO RE-MARK. NC1074.2 +190700 NUM-WRITE-2. NC1074.2 +190800 MOVE " GO TO DEPENDING" TO FEATURE. NC1074.2 +190900 MOVE "NUM-TEST-2" TO PAR-NAME. NC1074.2 +191000 PERFORM PRINT-DETAIL. NC1074.2 +191100 NUM-TEST-3. NC1074.2 +191200 MOVE ZERO TO NUM-UTILITY. NC1074.2 +191300 PERFORM 000000000000000000000000001 THRU NC1074.2 +191400 00000000000000000000000000001 2 TIMES. NC1074.2 +191500 IF NUM-UTILITY EQUAL TO 220 NC1074.2 +191600 PERFORM PASS GO TO NUM-WRITE-3. NC1074.2 +191700 GO TO NUM-FAIL-3. NC1074.2 +191800 NUM-DELETE-3. NC1074.2 +191900 PERFORM DE-LETE. NC1074.2 +192000 GO TO NUM-WRITE-3. NC1074.2 +192100 NUM-FAIL-3. NC1074.2 +192200 PERFORM FAIL. NC1074.2 +192300 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +192400 MOVE 220 TO CORRECT-N. NC1074.2 +192500 NC1074.2 +192600 NUM-WRITE-3. NC1074.2 +192700 MOVE " PERFORM THRU TIMES" TO FEATURE. NC1074.2 +192800 MOVE "NUM-TEST-3" TO PAR-NAME. NC1074.2 +192900 PERFORM PRINT-DETAIL. NC1074.2 +193000 NC1074.2 +193100 NUM-TEST-4. NC1074.2 +193200 MOVE ZERO TO NUM-UTILITY. NC1074.2 +193300 PERFORM 0000000000000000000000000001. NC1074.2 +193400 IF NUM-UTILITY EQUAL TO 1100 NC1074.2 +193500 PERFORM PASS GO TO NUM-WRITE-4. NC1074.2 +193600 GO TO NUM-FAIL-4. NC1074.2 +193700 NUM-DELETE-4. NC1074.2 +193800 PERFORM DE-LETE. NC1074.2 +193900 GO TO NUM-WRITE-4. NC1074.2 +194000 NUM-FAIL-4. NC1074.2 +194100 PERFORM FAIL. NC1074.2 +194200 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +194300 MOVE 1100 TO CORRECT-N. NC1074.2 +194400 NUM-WRITE-4. NC1074.2 +194500 MOVE " PERFORM SECT-NAME" TO FEATURE. NC1074.2 +194600 MOVE "NUM-TEST-4" TO PAR-NAME. NC1074.2 +194700 PERFORM PRINT-DETAIL. NC1074.2 +194800 GO TO NUM-EXIT. NC1074.2 +194900 0000000000000000000000001 SECTION. NC1074.2 +195000 00000000000000000000000001. NC1074.2 +195100 ADD 1 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195200 NC1074.2 +195300 000000000000000000000000001. NC1074.2 +195400 ADD 10 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195500 0000000000000000000000000001 SECTION. NC1074.2 +195600 00000000000000000000000000001. NC1074.2 +195700 ADD 100 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195800 000000000000000000000000000001. NC1074.2 +195900 ADD 1000 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +196000 NUM-EXIT-SECT SECTION. NC1074.2 +196100 NUM-ERROR. NC1074.2 +196200 MOVE " PERFORM" TO FEATURE. NC1074.2 +196300 MOVE "NUM-TEST-4 " TO PAR-NAME. NC1074.2 +196400 PERFORM FAIL. NC1074.2 +196500 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +196600 MOVE "SIZE ERROR ENCOUNTERED" TO RE-MARK. NC1074.2 +196700 PERFORM PRINT-DETAIL. NC1074.2 +196800 NUM-EXIT. NC1074.2 +196900 EXIT. NC1074.2 +197000 NUM-TEST-5. NC1074.2 +197100 MOVE " GO TO " TO FEATURE. NC1074.2 +197200 GO TO 000000000000000000000000000002. NC1074.2 +197300 NUM-DELETE-5. NC1074.2 +197400 PERFORM DE-LETE. NC1074.2 +197500 GO TO NUM-WRITE-5. NC1074.2 +197600 000000000000000000000000000002. NC1074.2 +197700 MOVE 2222 TO NUM-UTILITY. NC1074.2 +197800 COMPARE-TEST-5. NC1074.2 +197900 IF NUM-UTILITY EQUAL TO 2222 NC1074.2 +198000 PERFORM PASS NC1074.2 +198100 GO TO NUM-WRITE-5. NC1074.2 +198200 MOVE 2222 TO CORRECT-A. NC1074.2 +198300 MOVE "GO TO PARAGRAPH NOT ENTERED" TO RE-MARK. NC1074.2 +198400 PERFORM FAIL. NC1074.2 +198500 NUM-WRITE-5. NC1074.2 +198600 MOVE "NUM-TEST-5 " TO PAR-NAME. NC1074.2 +198700 PERFORM PRINT-DETAIL. NC1074.2 +198800 CONT-INIT-1. NC1074.2 +198900 MOVE "ABCDEFGHIJ" TO TEST-FIELD. NC1074.2 +199000 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +199100 MOVE "VI-77 6.9" TO ANSI-REFERENCE. NC1074.2 +199200 CONT-TEST-1-1. NC1074.2 +199300 IF TEST-FIELD = "ABCDEFGHIJ" NC1074.2 +199400 CONTINUE NC1074.2 +199500 ELSE NC1074.2 +199600 GO TO CONT-FAIL-1. NC1074.2 +199700 PERFORM PASS. NC1074.2 +199800 GO TO CONT-WRITE-1. NC1074.2 +199900 CONT-DELETE-1. NC1074.2 +200000 PERFORM DE-LETE. NC1074.2 +200100 GO TO CONT-WRITE-1. NC1074.2 +200200 CONT-FAIL-1. NC1074.2 +200300 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +200400 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +200500 MOVE "123456789." TO CORRECT-A. NC1074.2 +200600 PERFORM FAIL. NC1074.2 +200700 CONT-WRITE-1. NC1074.2 +200800 MOVE "CONT-TEST-1" TO PAR-NAME. NC1074.2 +200900 PERFORM PRINT-DETAIL. NC1074.2 +201000 CONT-INIT-2. NC1074.2 +201100 MOVE "ABCDEFGHIJ" TO TEST-FIELD. NC1074.2 +201200 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +201300 MOVE "VI-77 6.9" TO ANSI-REFERENCE. NC1074.2 +201400 CONT-TEST-2-1. NC1074.2 +201500 IF TEST-FIELD = "ABCDEFGHIJ" NC1074.2 +201600 PERFORM PASS NC1074.2 +201700 GO TO CONT-WRITE-2 NC1074.2 +201800 ELSE NC1074.2 +201900 CONTINUE. NC1074.2 +202000 GO TO CONT-FAIL-2. NC1074.2 +202100 CONT-DELETE-2. NC1074.2 +202200 PERFORM DE-LETE. NC1074.2 +202300 GO TO CONT-WRITE-2. NC1074.2 +202400 CONT-FAIL-2. NC1074.2 +202500 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +202600 MOVE "123456789." TO CORRECT-A. NC1074.2 +202700 PERFORM FAIL. NC1074.2 +202800 CONT-WRITE-2. NC1074.2 +202900 MOVE "CONT-TEST-2" TO PAR-NAME. NC1074.2 +203000 PERFORM PRINT-DETAIL. NC1074.2 +203100 CCVS-EXIT SECTION. NC1074.2 +203200 CCVS-999999. NC1074.2 +203300 GO TO CLOSE-FILES. NC1074.2 +*END-OF,NC107A +*HEADER,COBOL,NC108M +000100 IDENTIFICATION DIVISION. NC1084.2 +000200 PROGRAM-ID. NC1084.2 +000300 NC108M. NC1084.2 +000400**************************************************************** NC1084.2 +000500* * NC1084.2 +000600* VALIDATION FOR:- * NC1084.2 +000700* * NC1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +000900* * NC1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1084.2 +001100* * NC1084.2 +001200**************************************************************** NC1084.2 +001300* * NC1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1084.2 +001500* * NC1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1084.2 +001900* * NC1084.2 +002000**************************************************************** NC1084.2 +002100* NC1084.2 +002200* PROGRAM NC108M TESTS THE FOLLOWING FEATURES: NC1084.2 +002300* NC1084.2 +002400* COMPACT IDENTIFICATION DIVISION NC1084.2 +002500* COMBINED DATA DESCRIPTION CLAUSES NC1084.2 +002600* ABBREVIATIONS NC1084.2 +002700* COBOL CHARACTER SET NC1084.2 +002800* ALPHABET CLAUSE NC1084.2 +002900* NC1084.2 +003000 ENVIRONMENT DIVISION. NC1084.2 +003100 CONFIGURATION SECTION. NC1084.2 +003200 SOURCE-COMPUTER. NC1084.2 +003300 XXXXX082. NC1084.2 +003400 OBJECT-COMPUTER. NC1084.2 +003500 XXXXX083. NC1084.2 +003600 SPECIAL-NAMES. NC1084.2 +003700A XXXXX051 NC1084.2 +003800A IS ABBREV-SWITCH NC1084.2 +003900A ON ON-SWITCH NC1084.2 +004000A OFF IS OFF-SWITCH NC1084.2 +004100* ALPHABET THE-WILD-ONE IS NC1084.2 +004200* "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO NC1084.2 +004300* "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9", NC1084.2 +004400* NC1084.2 +004500* NC1084.2 +004600*ALPHABET-TEST-10 ***** THE WHOLE ALPHABET IS ONE LITERAL NC1084.2 +004700* WITH ALL 51 CHARACTERS IN THE COBOL CHARACTER SET. TEST-10 NC1084.2 +004800* IS ONLY A SYNTAX CHECK ON NC1084.2 +004900* ALPHABET-NAME IS LITERAL. NC1084.2 +005000* NC1084.2 +005100* NC1084.2 +005200* THE-BIG-OL-LITERAL-ALPHABET IS "A+0B-1C*2D/3E=4FL5G,6H;7I.8J"NC1084.2 +005300* ""9K(L)M>N<". NC1084.2 +007000 01 CHARACTER-QUOTE PIC X VALUE QUOTE. NC1084.2 +007100 01 CHARACTER-LOW PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz". NC1084.2 +007200 01 COMPLETE-01. NC1084.2 +007300 02 COMPLETE-F. NC1084.2 +007400 03 FILLER PICTURE X(90) VALUE SPACE. NC1084.2 +007500 03 FL-LESS PICTURE <(3),<<<.99 VALUE " <1,111.11". NC1084.2 +007600 02 COMPLETE-FORMAT NC1084.2 +007700 REDEFINES COMPLETE-F NC1084.2 +007800 JUSTIFIED RIGHT NC1084.2 +007900 PICTURE X(5) NC1084.2 +008000 OCCURS 20 TIMES NC1084.2 +008100 USAGE IS DISPLAY. NC1084.2 +008200 02 MORE-COMPLETE-FORMAT NC1084.2 +008300 BLANK WHEN ZERO NC1084.2 +008400 PICTURE IS 9 NC1084.2 +008500 SYNCHRONIZED RIGHT NC1084.2 +008600 DISPLAY NC1084.2 +008700 VALUE IS "5". NC1084.2 +008800 01 PIC-GROUP. NC1084.2 +008900 02 FILLER PICTURE X(4) VALUE "AAAA". NC1084.2 +009000 02 FILLER PIC X(4) VALUE "BBBB". NC1084.2 +009100 02 FILLER PIC IS X(4) VALUE "CCCC". NC1084.2 +009200 02 PICTURE X(4) VALUE "DDDD". NC1084.2 +009300 01 PICTURE-ITEM PICTURE X(16) VALUE "AAAABBBBCCCCDDDD". NC1084.2 +009400 01 SEND-JUST PICTURE X(5) VALUE "RIGHT". NC1084.2 +009500 01 RECEIVE-JUST PICTURE X(10) JUST. NC1084.2 +009600 01 RECEIVE-JUSTRIGHT PICTURE X(10) JUST RIGHT. NC1084.2 +009700 01 SEND-BLANK PICTURE 9(5) VALUE ZERO. NC1084.2 +009800 01 RECEIVE-BLANK PICTURE 9(9) BLANK ZERO. NC1084.2 +009900 01 COMP-GROUP. NC1084.2 +010000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010100 02 FILLER PICTURE 9(5) VALUE 77777 USAGE IS COMP. NC1084.2 +010200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010300 01 COMPUTATIONAL-GROUP. NC1084.2 +010400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010500 02 FILLER PICTURE 9(5) VALUE 77777 COMPUTATIONAL. NC1084.2 +010600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010700 01 SYNC-GROUP. NC1084.2 +010800 02 PICTURE X(5) VALUE SPACE. NC1084.2 +010900 02 PICTURE 9(5) VALUE 55555 SYNC. NC1084.2 +011000 02 PICTURE X(5) VALUE SPACE. NC1084.2 +011100 01 SYNCHRONIZED-GROUP. NC1084.2 +011200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011300 02 FILLER PICTURE 9(5) VALUE 55555 SYNCHRONIZED. NC1084.2 +011400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011500 01 SYNC-RIGHT-GROUP. NC1084.2 +011600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011700 02 FILLER PICTURE 9(5) VALUE 33333 SYNC RIGHT. NC1084.2 +011800 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011900 01 SYNCHRONIZED-RIGHT-GROUP. NC1084.2 +012000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012100 02 FILLER PICTURE 9(5) VALUE 33333 SYNCHRONIZED RIGHT. NC1084.2 +012200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012300 01 SYNC-LEFT-GROUP. NC1084.2 +012400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012500 02 FILLER PICTURE 9(5) VALUE 11111 SYNC LEFT. NC1084.2 +012600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012700 01 SYNCHRONIZED-LEFT-GROUP. NC1084.2 +012800 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012900 02 FILLER PICTURE 9(5) VALUE 11111 SYNCHRONIZED LEFT. NC1084.2 +013000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +013100 01 TEST-FIELD PIC X(10). NC1084.2 +013200 01 REDEFINES TEST-FIELD NC1084.2 +013300 PIC 9(9). NC1084.2 +013400 01 TEST-RESULTS. NC1084.2 +013500 02 FILLER PIC X VALUE SPACE. NC1084.2 +013600 02 FEATURE PIC X(20) VALUE SPACE. NC1084.2 +013700 02 FILLER PIC X VALUE SPACE. NC1084.2 +013800 02 P-OR-F PIC X(5) VALUE SPACE. NC1084.2 +013900 02 FILLER PIC X VALUE SPACE. NC1084.2 +014000 02 PAR-NAME. NC1084.2 +014100 03 FILLER PIC X(19) VALUE SPACE. NC1084.2 +014200 03 PARDOT-X PIC X VALUE SPACE. NC1084.2 +014300 03 DOTVALUE PIC 99 VALUE ZERO. NC1084.2 +014400 02 FILLER PIC X(8) VALUE SPACE. NC1084.2 +014500 02 RE-MARK PIC X(61). NC1084.2 +014600 01 TEST-COMPUTED. NC1084.2 +014700 02 FILLER PIC X(30) VALUE SPACE. NC1084.2 +014800 02 FILLER PIC X(17) VALUE NC1084.2 +014900 " COMPUTED=". NC1084.2 +015000 02 COMPUTED-X. NC1084.2 +015100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1084.2 +015200 03 COMPUTED-N REDEFINES COMPUTED-A NC1084.2 +015300 PIC -9(9).9(9). NC1084.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1084.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1084.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1084.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. NC1084.2 +015800 04 COMPUTED-18V0 PIC -9(18). NC1084.2 +015900 04 FILLER PIC X. NC1084.2 +016000 03 FILLER PIC X(50) VALUE SPACE. NC1084.2 +016100 01 TEST-CORRECT. NC1084.2 +016200 02 FILLER PIC X(30) VALUE SPACE. NC1084.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1084.2 +016400 02 CORRECT-X. NC1084.2 +016500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1084.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1084.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1084.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1084.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1084.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. NC1084.2 +017100 04 CORRECT-18V0 PIC -9(18). NC1084.2 +017200 04 FILLER PIC X. NC1084.2 +017300 03 FILLER PIC X(2) VALUE SPACE. NC1084.2 +017400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1084.2 +017500 01 CCVS-C-1. NC1084.2 +017600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1084.2 +017700- "SS PARAGRAPH-NAME NC1084.2 +017800- " REMARKS". NC1084.2 +017900 02 FILLER PIC X(20) VALUE SPACE. NC1084.2 +018000 01 CCVS-C-2. NC1084.2 +018100 02 FILLER PIC X VALUE SPACE. NC1084.2 +018200 02 FILLER PIC X(6) VALUE "TESTED". NC1084.2 +018300 02 FILLER PIC X(15) VALUE SPACE. NC1084.2 +018400 02 FILLER PIC X(4) VALUE "FAIL". NC1084.2 +018500 02 FILLER PIC X(94) VALUE SPACE. NC1084.2 +018600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1084.2 +018700 01 REC-CT PIC 99 VALUE ZERO. NC1084.2 +018800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1084.2 +018900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1084.2 +019300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1084.2 +019400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1084.2 +019500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1084.2 +019600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1084.2 +019700 01 CCVS-H-1. NC1084.2 +019800 02 FILLER PIC X(39) VALUE SPACES. NC1084.2 +019900 02 FILLER PIC X(42) VALUE NC1084.2 +020000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1084.2 +020100 02 FILLER PIC X(39) VALUE SPACES. NC1084.2 +020200 01 CCVS-H-2A. NC1084.2 +020300 02 FILLER PIC X(40) VALUE SPACE. NC1084.2 +020400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1084.2 +020500 02 FILLER PIC XXXX VALUE NC1084.2 +020600 "4.2 ". NC1084.2 +020700 02 FILLER PIC X(28) VALUE NC1084.2 +020800 " COPY - NOT FOR DISTRIBUTION". NC1084.2 +020900 02 FILLER PIC X(41) VALUE SPACE. NC1084.2 +021000 NC1084.2 +021100 01 CCVS-H-2B. NC1084.2 +021200 02 FILLER PIC X(15) VALUE NC1084.2 +021300 "TEST RESULT OF ". NC1084.2 +021400 02 TEST-ID PIC X(9). NC1084.2 +021500 02 FILLER PIC X(4) VALUE NC1084.2 +021600 " IN ". NC1084.2 +021700 02 FILLER PIC X(12) VALUE NC1084.2 +021800 " HIGH ". NC1084.2 +021900 02 FILLER PIC X(22) VALUE NC1084.2 +022000 " LEVEL VALIDATION FOR ". NC1084.2 +022100 02 FILLER PIC X(58) VALUE NC1084.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +022300 01 CCVS-H-3. NC1084.2 +022400 02 FILLER PIC X(34) VALUE NC1084.2 +022500 " FOR OFFICIAL USE ONLY ". NC1084.2 +022600 02 FILLER PIC X(58) VALUE NC1084.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1084.2 +022800 02 FILLER PIC X(28) VALUE NC1084.2 +022900 " COPYRIGHT 1985 ". NC1084.2 +023000 01 CCVS-E-1. NC1084.2 +023100 02 FILLER PIC X(52) VALUE SPACE. NC1084.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1084.2 +023300 02 ID-AGAIN PIC X(9). NC1084.2 +023400 02 FILLER PIC X(45) VALUE SPACES. NC1084.2 +023500 01 CCVS-E-2. NC1084.2 +023600 02 FILLER PIC X(31) VALUE SPACE. NC1084.2 +023700 02 FILLER PIC X(21) VALUE SPACE. NC1084.2 +023800 02 CCVS-E-2-2. NC1084.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1084.2 +024000 03 FILLER PIC X VALUE SPACE. NC1084.2 +024100 03 ENDER-DESC PIC X(44) VALUE NC1084.2 +024200 "ERRORS ENCOUNTERED". NC1084.2 +024300 01 CCVS-E-3. NC1084.2 +024400 02 FILLER PIC X(22) VALUE NC1084.2 +024500 " FOR OFFICIAL USE ONLY". NC1084.2 +024600 02 FILLER PIC X(12) VALUE SPACE. NC1084.2 +024700 02 FILLER PIC X(58) VALUE NC1084.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +024900 02 FILLER PIC X(13) VALUE SPACE. NC1084.2 +025000 02 FILLER PIC X(15) VALUE NC1084.2 +025100 " COPYRIGHT 1985". NC1084.2 +025200 01 CCVS-E-4. NC1084.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1084.2 +025400 02 FILLER PIC X(4) VALUE " OF ". NC1084.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1084.2 +025600 02 FILLER PIC X(40) VALUE NC1084.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1084.2 +025800 01 XXINFO. NC1084.2 +025900 02 FILLER PIC X(19) VALUE NC1084.2 +026000 "*** INFORMATION ***". NC1084.2 +026100 02 INFO-TEXT. NC1084.2 +026200 04 FILLER PIC X(8) VALUE SPACE. NC1084.2 +026300 04 XXCOMPUTED PIC X(20). NC1084.2 +026400 04 FILLER PIC X(5) VALUE SPACE. NC1084.2 +026500 04 XXCORRECT PIC X(20). NC1084.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). NC1084.2 +026700 01 HYPHEN-LINE. NC1084.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. NC1084.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************NC1084.2 +027000- "*****************************************". NC1084.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************NC1084.2 +027200- "******************************". NC1084.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE NC1084.2 +027400 "NC108M". NC1084.2 +027500 PROCEDURE DIVISION. NC1084.2 +027600 CCVS1 SECTION. NC1084.2 +027700 OPEN-FILES. NC1084.2 +027800 OPEN OUTPUT PRINT-FILE. NC1084.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1084.2 +028000 MOVE SPACE TO TEST-RESULTS. NC1084.2 +028100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1084.2 +028200 GO TO CCVS1-EXIT. NC1084.2 +028300 CLOSE-FILES. NC1084.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1084.2 +028500 TERMINATE-CCVS. NC1084.2 +028600S EXIT PROGRAM. NC1084.2 +028700STERMINATE-CALL. NC1084.2 +028800 STOP RUN. NC1084.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1084.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1084.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1084.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1084.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. NC1084.2 +029400 PRINT-DETAIL. NC1084.2 +029500 IF REC-CT NOT EQUAL TO ZERO NC1084.2 +029600 MOVE "." TO PARDOT-X NC1084.2 +029700 MOVE REC-CT TO DOTVALUE. NC1084.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1084.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1084.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1084.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1084.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1084.2 +030300 MOVE SPACE TO CORRECT-X. NC1084.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1084.2 +030500 MOVE SPACE TO RE-MARK. NC1084.2 +030600 HEAD-ROUTINE. NC1084.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1084.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1084.2 +031100 COLUMN-NAMES-ROUTINE. NC1084.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +031500 END-ROUTINE. NC1084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1084.2 +031700 END-RTN-EXIT. NC1084.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +031900 END-ROUTINE-1. NC1084.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1084.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1084.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. NC1084.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1084.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1084.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1084.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1084.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1084.2 +032800 END-ROUTINE-12. NC1084.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1084.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1084.2 +033100 MOVE "NO " TO ERROR-TOTAL NC1084.2 +033200 ELSE NC1084.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1084.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1084.2 +033500 PERFORM WRITE-LINE. NC1084.2 +033600 END-ROUTINE-13. NC1084.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1084.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE NC1084.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1084.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1084.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO NC1084.2 +034300 MOVE "NO " TO ERROR-TOTAL NC1084.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1084.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1084.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034800 WRITE-LINE. NC1084.2 +034900 ADD 1 TO RECORD-COUNT. NC1084.2 +035000Y IF RECORD-COUNT GREATER 50 NC1084.2 +035100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1084.2 +035200Y MOVE SPACE TO DUMMY-RECORD NC1084.2 +035300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1084.2 +035400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1084.2 +035500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1084.2 +035600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1084.2 +035700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1084.2 +035800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +035900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +036000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +036100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1084.2 +036200Y MOVE ZERO TO RECORD-COUNT. NC1084.2 +036300 PERFORM WRT-LN. NC1084.2 +036400 WRT-LN. NC1084.2 +036500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1084.2 +036600 MOVE SPACE TO DUMMY-RECORD. NC1084.2 +036700 BLANK-LINE-PRINT. NC1084.2 +036800 PERFORM WRT-LN. NC1084.2 +036900 FAIL-ROUTINE. NC1084.2 +037000 IF COMPUTED-X NOT EQUAL TO SPACE NC1084.2 +037100 GO TO FAIL-ROUTINE-WRITE. NC1084.2 +037200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1084.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1084.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1084.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1084.2 +037700 GO TO FAIL-ROUTINE-EX. NC1084.2 +037800 FAIL-ROUTINE-WRITE. NC1084.2 +037900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1084.2 +038000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1084.2 +038100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1084.2 +038200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1084.2 +038300 FAIL-ROUTINE-EX. EXIT. NC1084.2 +038400 BAIL-OUT. NC1084.2 +038500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1084.2 +038600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1084.2 +038700 BAIL-OUT-WRITE. NC1084.2 +038800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1084.2 +038900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1084.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +039100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1084.2 +039200 BAIL-OUT-EX. EXIT. NC1084.2 +039300 CCVS1-EXIT. NC1084.2 +039400 EXIT. NC1084.2 +039500*IDENTIFICATION DIVISION. NC1084.2 +039600* NOTE THE ENTIRE IDENTIFICATION DIVISION IS OPTIONAL, WITH THENC1084.2 +039700* EXCEPTION OF THE IDENTIFICATION DIVISION AND PROGRAM-ID NC1084.2 +039800* CLAUSES. AS A TEST, ALL THE OPTIONAL CLAUSES HAVE BEEN NC1084.2 +039900* REMOVED. INFORMATION NORMALLY GIVEN THERE IS LISTED BELOW NC1084.2 +040000* AS A COMMENT. ADDITIONALLY, KEY WORDS ARE USED IN COMMENT NC1084.2 +040100* LINES TO ASCERTAIN WHETHER COMMENTS ARE BEING SYNTAX CHECKED.NC1084.2 +040200**************************************************************** NC1084.2 +040300* * NC1084.2 +040400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * NC1084.2 +040500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * NC1084.2 +040600* COMFORMANCE WITH THE AMERICAN NATIONAL STANDARD * NC1084.2 +040700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * NC1084.2 +040800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * NC1084.2 +040900* (ISO DOCUMENT REFERENCE: ISO ). * NC1084.2 +041000* * NC1084.2 +041100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * NC1084.2 +041200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * NC1084.2 +041300* DOCUMENT REFERENCE: ). * NC1084.2 +041400* * NC1084.2 +041500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * NC1084.2 +041600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * NC1084.2 +041700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * NC1084.2 +041800* * NC1084.2 +041900* THE FEDERAL SOFTWARE TESTING CENTRE * NC1084.2 +042000* OFFICE OF SOFTWARE DEVELOPMENT * NC1084.2 +042100* & INFORMATION TECHNOLOGY * NC1084.2 +042200* TWO SKYLINE PLACE * NC1084.2 +042300* SUITE 1100 * NC1084.2 +042400* 5203 LEESBURG PIKE * NC1084.2 +042500* FALLS CHURCH * NC1084.2 +042600* VA 22041 * NC1084.2 +042700* U.S.A. * NC1084.2 +042800* * NC1084.2 +042900* THE PROJECT TEAM MEMBERS WERE: * NC1084.2 +043000* * NC1084.2 +043100* BIADI (BUREAU INTER ADMINISTRATION * NC1084.2 +043200* DE DOCUMENTATION INFORMATIQUE) * NC1084.2 +043300* 21 RUE BARA * NC1084.2 +043400* F-92132 ISSY * NC1084.2 +043500* FRANCE * NC1084.2 +043600* * NC1084.2 +043700* * NC1084.2 +043800* GMD (GESELLSCHAFT FUR MATHEMATIK * NC1084.2 +043900* UND DATENVERARBEITUNG MBH) * NC1084.2 +044000* SCHLOSS BIRLINGHOVEN * NC1084.2 +044100* POSTFACH 12 40 * NC1084.2 +044200* D-5205 ST. AUGUSTIN 1 * NC1084.2 +044300* GERMANY FR * NC1084.2 +044400* * NC1084.2 +044500* * NC1084.2 +044600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * NC1084.2 +044700* OXFORD ROAD * NC1084.2 +044800* MANCHESTER * NC1084.2 +044900* M1 7ED * NC1084.2 +045000* UNITED KINGDOM * NC1084.2 +045100* * NC1084.2 +045200* * NC1084.2 +045300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * NC1084.2 +045400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * NC1084.2 +045500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * NC1084.2 +045600* * NC1084.2 +045700**************************************************************** NC1084.2 +045800* * NC1084.2 +045900* VALIDATION FOR:- * NC1084.2 +046000* " HIGH ". NC1084.2 +046100* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * NC1084.2 +046200* * NC1084.2 +046300* CREATION DATE / VALIDATION DATE * NC1084.2 +046400* "4.2 ". NC1084.2 +046500* * NC1084.2 +046600**************************************************************** NC1084.2 +046700* NC1084.2 +046800* PROGRAM NC108M TESTS THE FOLLOWING FEATURES: NC1084.2 +046900* NC1084.2 +047000* COMPACT "IDENTIFICATION DIVISION" NC1084.2 +047100* COMBINED DATA DESCRIPTION CLAUSES NC1084.2 +047200* ABBREVIATIONS NC1084.2 +047300* COBOL CHARACTER SET NC1084.2 +047400* ALPHABET CLAUSE NC1084.2 +047500* NC1084.2 +047600* NC1084.2 +047700* NC1084.2 +047800* THE SOURCE LINES IN THE ENVIRONMENT AND DATA DIVISION NC1084.2 +047900* SHOULD BE REPLACED AS FOLLOWS NC1084.2 +048000* XXXXX36 REPLACE WITH SYSTEM OUTPUT DEVICE (PRINTER) NC1084.2 +048100* FILE-NAME IS PRINT-FILE. NC1084.2 +048200* XXXXX38 REPLACE WITH SYSTEM NAME FOR A SWITCH NC1084.2 +048300* SWITCH-NAME IS ABBREV-SEITCH. NC1084.2 +048400* XXXXX49 REPLACE WITH SOURCE COMPUTER NAME NC1084.2 +048500* XXXXX50 REPLACE WITH OBJECT COMPUTER NAME NC1084.2 +048600* NC1084.2 +048700* THE DOD COBOL TEST ROUTINES HAVE BEEN CREATED TO BE NC1084.2 +048800* USED TO VALIDATE THAT NC1084.2 +048900* NC1084.2 +049000* 1 A COBOL COMPILER CONTAINS THE ELEMENTS OF THE NC1084.2 +049100* ANSI COBOL. NC1084.2 +049200* NC1084.2 +049300* 2 TO PROVIDE EXAMPLES OF THE USES OF THE DIFFERENT NC1084.2 +049400* ELEMENTS OF THE COBOL LANGUAGE. NC1084.2 +049500* NC1084.2 +049600* 3 TO BE USED AS TEST DATA FOR PRE-PROCESSORS NC1084.2 +049700* FLOWCHARTERS ETC. NC1084.2 +049800* NC1084.2 +049900* 4 IT IS HOPED THAT EVALUATIONS CORRECTIONS NC1084.2 +050000* SUGGESTIONS AND COMMENTS WILL BE FORWARDED TO NC1084.2 +050100* NAVY PROGRAMMING LANGUAGES DIVISION NC1084.2 +050200* ROOM 2C319 THE PENTAGON NC1084.2 +050300* WASHINGTON D C 20350. NC1084.2 +050400* * * * * * * * * * * * * * * * * * * * * *.NC1084.2 +050500* NC1084.2 +050600* PHONE (202) 695-4750. NC1084.2 +050700* NC1084.2 +050800* * * * * * * * * * * * * * * * * * * * * *.NC1084.2 +050900 FMT-INIT-GF-1. NC1084.2 +051000 MOVE "COMPLETE DATA FORMAT" TO FEATURE. NC1084.2 +051100 MOVE "V1-6 3.2.1.1" TO ANSI-REFERENCE. NC1084.2 +051200 FMT-TEST-GF-1. NC1084.2 +051300 MOVE COMPLETE-FORMAT (19) TO COMPUTED-A. NC1084.2 +051400 MOVE " <1,1" TO CORRECT-A. NC1084.2 +051500 IF COMPLETE-FORMAT (19) EQUAL TO " <1,1" NC1084.2 +051600 MOVE "FAILURE IF DOLLAR APPEARS" TO RE-MARK NC1084.2 +051700 GO TO FMT-WRITE-GF-1. NC1084.2 +051800 PERFORM FAIL. NC1084.2 +051900 MOVE "LESS THAN SHOULD APPEAR" TO RE-MARK. NC1084.2 +052000 GO TO FMT-WRITE-GF-1. NC1084.2 +052100 FMT-DELETE-GF-1. NC1084.2 +052200 PERFORM DE-LETE. NC1084.2 +052300 FMT-WRITE-GF-1. NC1084.2 +052400 MOVE "FMT-TEST-GF-1" TO PAR-NAME. NC1084.2 +052500 PERFORM PRINT-DETAIL. NC1084.2 +052600 FMT-INIT-GF-2. NC1084.2 +052700 MOVE "V1-20 5.3" TO ANSI-REFERENCE. NC1084.2 +052800 FMT-TEST-GF-2. NC1084.2 +052900 IF MORE-COMPLETE-FORMAT NOT EQUAL TO "5" NC1084.2 +053000 PERFORM FAIL NC1084.2 +053100 ELSE PERFORM PASS NC1084.2 +053200 GO TO FMT-WRITE-GF-2. NC1084.2 +053300 MOVE MORE-COMPLETE-FORMAT TO COMPUTED-A. NC1084.2 +053400 MOVE "5" TO CORRECT-A. NC1084.2 +053500 GO TO FMT-WRITE-GF-2. NC1084.2 +053600 FMT-DELETE-GF-2. NC1084.2 +053700 PERFORM DE-LETE. NC1084.2 +053800 FMT-WRITE-GF-2. NC1084.2 +053900 MOVE "FMT-TEST-GF-2" TO PAR-NAME. NC1084.2 +054000 PERFORM PRINT-DETAIL. NC1084.2 +054100 FMT-TEST-GF-3. NC1084.2 +054200 MOVE ZERO TO MORE-COMPLETE-FORMAT. NC1084.2 +054300 IF MORE-COMPLETE-FORMAT EQUAL TO SPACE NC1084.2 +054400 PERFORM PASS NC1084.2 +054500 GO TO FMT-WRITE-GF-3. NC1084.2 +054600 PERFORM FAIL. NC1084.2 +054700 MOVE MORE-COMPLETE-FORMAT TO COMPUTED-A. NC1084.2 +054800 MOVE " (SPACES)" TO CORRECT-A. NC1084.2 +054900 GO TO FMT-WRITE-GF-3. NC1084.2 +055000 FMT-DELETE-GF-3. NC1084.2 +055100 PERFORM DE-LETE. NC1084.2 +055200 FMT-WRITE-GF-3. NC1084.2 +055300 MOVE "FMT-TEST-GF-3" TO PAR-NAME. NC1084.2 +055400 PERFORM PRINT-DETAIL. NC1084.2 +055500 ABR-INIT-GF-1. NC1084.2 +055600 MOVE "DATA DESCR ABBREVS -" TO FEATURE. NC1084.2 +055700 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +055800 PERFORM PRINT-DETAIL. NC1084.2 +055900 ABR-TEST-GF-1. NC1084.2 +056000 IF PIC-GROUP IS EQUAL TO PICTURE-ITEM NC1084.2 +056100 PERFORM PASS GO TO ABR-WRITE-GF-1. NC1084.2 +056200 GO TO ABR-FAIL-GF-1. NC1084.2 +056300 ABR-DELETE-GF-1. NC1084.2 +056400 PERFORM DE-LETE. NC1084.2 +056500 GO TO ABR-WRITE-GF-1. NC1084.2 +056600 ABR-FAIL-GF-1. NC1084.2 +056700 MOVE PIC-GROUP TO COMPUTED-A. NC1084.2 +056800 MOVE PICTURE-ITEM TO CORRECT-A. NC1084.2 +056900 PERFORM FAIL. NC1084.2 +057000 ABR-WRITE-GF-1. NC1084.2 +057100 MOVE " PIC" TO FEATURE. NC1084.2 +057200 MOVE "ABR-TEST-GF-1 " TO PAR-NAME. NC1084.2 +057300 PERFORM PRINT-DETAIL. NC1084.2 +057400 ABR-INIT-GF-2. NC1084.2 +057500 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +057600 MOVE SEND-JUST TO RECEIVE-JUSTRIGHT. NC1084.2 +057700 ABR-TEST-GF-2. NC1084.2 +057800 IF RECEIVE-JUSTRIGHT EQUAL TO " RIGHT" NC1084.2 +057900 PERFORM PASS GO TO ABR-WRITE-GF-2. NC1084.2 +058000 GO TO ABR-FAIL-GF-2. NC1084.2 +058100 ABR-DELETE-GF-2. NC1084.2 +058200 PERFORM DE-LETE. NC1084.2 +058300 GO TO ABR-WRITE-GF-2. NC1084.2 +058400 ABR-FAIL-GF-2. NC1084.2 +058500 PERFORM FAIL. NC1084.2 +058600 MOVE RECEIVE-JUSTRIGHT TO COMPUTED-A. NC1084.2 +058700 MOVE " RIGHT" TO CORRECT-A. NC1084.2 +058800 ABR-WRITE-GF-2. NC1084.2 +058900 MOVE " JUST" TO FEATURE NC1084.2 +059000 MOVE "ABR-TEST-GF-2 " TO PAR-NAME. NC1084.2 +059100 PERFORM PRINT-DETAIL. NC1084.2 +059200 ABR-INIT-GF-3. NC1084.2 +059300 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +059400 MOVE SEND-JUST TO RECEIVE-JUST. NC1084.2 +059500 ABR-TEST-GF-3. NC1084.2 +059600 IF RECEIVE-JUST EQUAL TO " RIGHT" NC1084.2 +059700 PERFORM PASS GO TO ABR-WRITE-GF-3. NC1084.2 +059800 GO TO ABR-FAIL-GF-3. NC1084.2 +059900 ABR-DELETE-GF-3. NC1084.2 +060000 PERFORM DE-LETE. NC1084.2 +060100 GO TO ABR-WRITE-GF-3. NC1084.2 +060200 ABR-FAIL-GF-3. NC1084.2 +060300 PERFORM FAIL. NC1084.2 +060400 MOVE RECEIVE-JUST TO COMPUTED-A. NC1084.2 +060500 MOVE " RIGHT" TO CORRECT-A. NC1084.2 +060600 ABR-WRITE-GF-3. NC1084.2 +060700 MOVE "ABR-TEST-GF-3 " TO PAR-NAME. NC1084.2 +060800 PERFORM PRINT-DETAIL. NC1084.2 +060900 ABR-INIT-GF-4. NC1084.2 +061000 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +061100 MOVE SEND-BLANK TO RECEIVE-BLANK. NC1084.2 +061200 ABR-TEST-GF-4. NC1084.2 +061300 IF RECEIVE-BLANK EQUAL TO " " NC1084.2 +061400 PERFORM PASS GO TO ABR-WRITE-GF-4. NC1084.2 +061500 GO TO ABR-FAIL-GF-4. NC1084.2 +061600 ABR-DELETE-GF-4. NC1084.2 +061700 PERFORM DE-LETE. NC1084.2 +061800 GO TO ABR-WRITE-GF-4. NC1084.2 +061900 ABR-FAIL-GF-4. NC1084.2 +062000 PERFORM FAIL. NC1084.2 +062100 MOVE RECEIVE-BLANK TO COMPUTED-A. NC1084.2 +062200 MOVE " (SPACES)" TO CORRECT-A. NC1084.2 +062300 ABR-WRITE-GF-4. NC1084.2 +062400 MOVE " BLANK ZERO" TO FEATURE NC1084.2 +062500 MOVE "ABR-TEST-GF-4 " TO PAR-NAME. NC1084.2 +062600 PERFORM PRINT-DETAIL. NC1084.2 +062700 ABR-INIT-GF-5. NC1084.2 +062800 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +062900 ABR-TEST-GF-5. NC1084.2 +063000 IF COMP-GROUP EQUAL TO COMPUTATIONAL-GROUP NC1084.2 +063100 PERFORM PASS GO TO ABR-WRITE-GF-5. NC1084.2 +063200 GO TO ABR-FAIL-GF-5. NC1084.2 +063300 ABR-DELETE-GF-5. NC1084.2 +063400 PERFORM DE-LETE. NC1084.2 +063500 GO TO ABR-WRITE-GF-5. NC1084.2 +063600 ABR-FAIL-GF-5. NC1084.2 +063700 PERFORM FAIL. NC1084.2 +063800 MOVE COMP-GROUP TO COMPUTED-A. NC1084.2 +063900 MOVE COMPUTATIONAL-GROUP TO CORRECT-A. NC1084.2 +064000 ABR-WRITE-GF-5. NC1084.2 +064100 MOVE " COMP" TO FEATURE. NC1084.2 +064200 MOVE "ABR-TEST-GF-5 " TO PAR-NAME. NC1084.2 +064300 PERFORM PRINT-DETAIL. NC1084.2 +064400 ABR-INIT-GF-6. NC1084.2 +064500 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +064600 ABR-TEST-GF-6. NC1084.2 +064700 IF SYNC-GROUP EQUAL TO SYNCHRONIZED-GROUP NC1084.2 +064800 PERFORM PASS GO TO ABR-WRITE-GF-6. NC1084.2 +064900 GO TO ABR-FAIL-GF-6. NC1084.2 +065000 ABR-DELETE-GF-6. NC1084.2 +065100 PERFORM DE-LETE. NC1084.2 +065200 GO TO ABR-WRITE-GF-6. NC1084.2 +065300 ABR-FAIL-GF-6. NC1084.2 +065400 PERFORM FAIL. NC1084.2 +065500 MOVE SYNC-GROUP TO COMPUTED-A. NC1084.2 +065600 MOVE SYNCHRONIZED-GROUP TO CORRECT-A. NC1084.2 +065700 ABR-WRITE-GF-6. NC1084.2 +065800 MOVE " SYNC" TO FEATURE NC1084.2 +065900 MOVE "ABR-TEST-GF-6 " TO PAR-NAME. NC1084.2 +066000 PERFORM PRINT-DETAIL. NC1084.2 +066100 ABR-INIT-GF-7. NC1084.2 +066200 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +066300 ABR-TEST-GF-7. NC1084.2 +066400 IF SYNC-RIGHT-GROUP EQUAL TO SYNCHRONIZED-RIGHT-GROUP NC1084.2 +066500 PERFORM PASS GO TO ABR-WRITE-GF-7. NC1084.2 +066600 GO TO ABR-FAIL-GF-7. NC1084.2 +066700 ABR-DELETE-GF-7. NC1084.2 +066800 PERFORM DE-LETE. NC1084.2 +066900 GO TO ABR-WRITE-GF-7. NC1084.2 +067000 ABR-FAIL-GF-7. NC1084.2 +067100 PERFORM FAIL. NC1084.2 +067200 MOVE SYNC-RIGHT-GROUP TO COMPUTED-A. NC1084.2 +067300 MOVE SYNCHRONIZED-RIGHT-GROUP TO CORRECT-A. NC1084.2 +067400 ABR-WRITE-GF-7. NC1084.2 +067500 MOVE "ABR-TEST-GF-7 " TO PAR-NAME. NC1084.2 +067600 PERFORM PRINT-DETAIL. NC1084.2 +067700 ABR-INIT-GF-8. NC1084.2 +067800 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +067900 ABR-TEST-GF-8. NC1084.2 +068000 IF SYNC-LEFT-GROUP EQUAL TO SYNCHRONIZED-LEFT-GROUP NC1084.2 +068100 PERFORM PASS GO TO ABR-WRITE-GF-8. NC1084.2 +068200 GO TO ABR-FAIL-GF-8. NC1084.2 +068300 ABR-DELETE-GF-8. NC1084.2 +068400 PERFORM DE-LETE. NC1084.2 +068500 GO TO ABR-WRITE-GF-8. NC1084.2 +068600 ABR-FAIL-GF-8. NC1084.2 +068700 PERFORM FAIL. NC1084.2 +068800 MOVE SYNC-LEFT-GROUP TO COMPUTED-A. NC1084.2 +068900 MOVE SYNCHRONIZED-LEFT-GROUP TO CORRECT-A. NC1084.2 +069000 ABR-WRITE-GF-8. NC1084.2 +069100 MOVE "ABR-TEST-GF-8 " TO PAR-NAME. NC1084.2 +069200 PERFORM PRINT-DETAIL. NC1084.2 +069300 ABR-INIT-GF-9. NC1084.2 +069400 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +069500 ABR-TEST-GF-9. NC1084.2 +069600A MOVE ZERO TO ONE NC1084.2 +069700A IF ON-SWITCH ADD 1 TO ONE. NC1084.2 +069800A IF OFF-SWITCH ADD 1 TO ONE. NC1084.2 +069900A IF ONE EQUAL TO 1 PERFORM PASS GO TO ABR-WRITE-GF-9 NC1084.2 +070000A ELSE MOVE 1 TO ONE GO TO ABR-FAIL-GF-9. NC1084.2 +070100 ABR-DELETE-GF-9. NC1084.2 +070200 PERFORM DE-LETE. NC1084.2 +070300 GO TO ABR-WRITE-GF-9. NC1084.2 +070400 ABR-FAIL-GF-9. NC1084.2 +070500 PERFORM FAIL. NC1084.2 +070600 MOVE "NOT BOOLEAN COMPLEMENTS" TO RE-MARK. NC1084.2 +070700 ABR-WRITE-GF-9. NC1084.2 +070800 MOVE "SPECIAL-NAMES SWITCH" TO FEATURE. NC1084.2 +070900 MOVE "ABR-TEST-GF-9 " TO PAR-NAME. NC1084.2 +071000 PERFORM PRINT-DETAIL. NC1084.2 +071100 ABR-INIT-GF-10. NC1084.2 +071200 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +071300 MOVE ZERO TO FL-LESS. NC1084.2 +071400 MOVE FL-LESS TO COMPUTED-A. NC1084.2 +071500 MOVE " <.00" TO CORRECT-A. NC1084.2 +071600 ABR-TEST-GF-10. NC1084.2 +071700 IF FL-LESS EQUAL TO " <.00" NC1084.2 +071800 MOVE "FAILURE IF DOLLAR APPEARS" TO RE-MARK NC1084.2 +071900 GO TO ABR-WRITE-GF-10. NC1084.2 +072000 GO TO ABR-FAIL-GF-10. NC1084.2 +072100 ABR-DELETE-GF-10. NC1084.2 +072200 PERFORM DE-LETE. NC1084.2 +072300 GO TO ABR-WRITE-GF-10. NC1084.2 +072400 ABR-FAIL-GF-10. NC1084.2 +072500 PERFORM FAIL. NC1084.2 +072600 MOVE "LESS THAN SHOULD APPEAR" TO RE-MARK. NC1084.2 +072700 ABR-WRITE-GF-10. NC1084.2 +072800 MOVE "ABR-TEST-GF-10" TO PAR-NAME. NC1084.2 +072900 MOVE "SPECIAL-NAMES CURNCY" TO FEATURE. NC1084.2 +073000 PERFORM PRINT-DETAIL. NC1084.2 +073100 CHA-INIT-1. NC1084.2 +073200 MOVE "III-3" TO ANSI-REFERENCE. NC1084.2 +073300 CHA-GF-1-1. NC1084.2 +073400 IF XCHAR-SET EQUAL TO NC1084.2 +073500 "ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 +-*/=$,.;()><" NC1084.2 +073600 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +073700* NOTE 51 CHARACTER LITERAL INCLUDES TWO SPACES BUT NO NC1084.2 +073800* QUOTE. NC1084.2 +073900 GO TO CHA-WRITE-GF-1-1. NC1084.2 +074000 CHA-DELETE-GF-1-1. NC1084.2 +074100 PERFORM DE-LETE. NC1084.2 +074200 CHA-WRITE-GF-1-1. NC1084.2 +074300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +074400 MOVE "CHA-GF-1-1" TO PAR-NAME. NC1084.2 +074500 PERFORM PRINT-DETAIL. NC1084.2 +074600 CHA-GF-1-2. NC1084.2 +074700 IF CHARACTER-QUOTE = QUOTE NC1084.2 +074800 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +074900 GO TO CHA-WRITE-GF-1-2. NC1084.2 +075000 CHA-DELETE-GF-1-2. NC1084.2 +075100 PERFORM DE-LETE. NC1084.2 +075200 CHA-WRITE-GF-1-2. NC1084.2 +075300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +075400 MOVE "CHA-GF-1-2" TO PAR-NAME. NC1084.2 +075500 PERFORM PRINT-DETAIL. NC1084.2 +075600 CHA-GF-1-3. NC1084.2 +075700 IF CHARACTER-LOW = "abcdefghijklmnopqrstuvwxyz" NC1084.2 +075800 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +075900 GO TO CHA-WRITE-GF-1-3. NC1084.2 +076000 CHA-DELETE-GF-1-3. NC1084.2 +076100 PERFORM DE-LETE. NC1084.2 +076200 CHA-WRITE-GF-1-3. NC1084.2 +076300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +076400 MOVE "CHA-GF-1-3" TO PAR-NAME. NC1084.2 +076500 PERFORM PRINT-DETAIL. NC1084.2 +076600* NC1084.2 +076700 ALPHABET-INIT-10. NC1084.2 +076800 MOVE "VI-15 4.5.4 GR4" TO ANSI-REFERENCE. NC1084.2 +076900 ALPHABET-TEST-10. NC1084.2 +077000 PERFORM END-ROUTINE. NC1084.2 +077100 MOVE " ALPHABET-NAME ***** CHECK THE ALPHABET-NAMENC1084.2 +077200- " IN THE SPECIAL-NAMES PARAGRAPH" TO TEST-RESULTS. NC1084.2 +077300 PERFORM PRINT-DETAIL. NC1084.2 +077400* NC1084.2 +077500 CCVS-EXIT SECTION. NC1084.2 +077600 CCVS-999999. NC1084.2 +077700 GO TO CLOSE-FILES. NC1084.2 +*END-OF,NC108M +*HEADER,COBOL,NC109M +000100 IDENTIFICATION DIVISION. NC1094.2 +000200 PROGRAM-ID. NC1094.2 +000300 NC109M. NC1094.2 +000400**************************************************************** NC1094.2 +000500* * NC1094.2 +000600* VALIDATION FOR:- * NC1094.2 +000700* * NC1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +000900* * NC1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1094.2 +001100* * NC1094.2 +001200**************************************************************** NC1094.2 +001300* * NC1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1094.2 +001500* * NC1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1094.2 +001900* * NC1094.2 +002000**************************************************************** NC1094.2 +002100* NC1094.2 +002200* PROGRAM NC109M TESTS FORMAT 1 OF THE ACCEPT STATEMENT NC1094.2 +002300* AND THE GENERAL FORMAT OF THE DISPLAY STATEMENT. NC1094.2 +002400* NC1094.2 +002500* NC1094.2 +002600 NC1094.2 +002700 ENVIRONMENT DIVISION. NC1094.2 +002800 CONFIGURATION SECTION. NC1094.2 +002900 SOURCE-COMPUTER. NC1094.2 +003000 XXXXX082. NC1094.2 +003100 OBJECT-COMPUTER. NC1094.2 +003200 XXXXX083. NC1094.2 +003300 INPUT-OUTPUT SECTION. NC1094.2 +003400 FILE-CONTROL. NC1094.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1094.2 +003600 XXXXX055. NC1094.2 +003700 DATA DIVISION. NC1094.2 +003800 FILE SECTION. NC1094.2 +003900 FD PRINT-FILE. NC1094.2 +004000 01 PRINT-REC PICTURE X(120). NC1094.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1094.2 +004200 WORKING-STORAGE SECTION. NC1094.2 +004300 01 CHARACTER-BREAKDOWN-R. NC1094.2 +004400 02 FIRST-20R PICTURE X(20). NC1094.2 +004500 02 SECOND-20R PICTURE X(20). NC1094.2 +004600 02 THIRD-20R PICTURE X(20). NC1094.2 +004700 02 FOURTH-20R PICTURE X(20). NC1094.2 +004800 01 CHARACTER-BREAKDOWN-S. NC1094.2 +004900 02 FIRST-20S PICTURE X(20). NC1094.2 +005000 02 SECOND-20S PICTURE X(20). NC1094.2 +005100 02 THIRD-20S PICTURE X(20). NC1094.2 +005200 02 FOURTH-20S PICTURE X(20). NC1094.2 +005300 01 X80-CHARACTER-FIELD. NC1094.2 +005400 02 FILLER PICTURE X(80). NC1094.2 +005500 01 ACCEPT-RESULTS. NC1094.2 +005600 02 FILLER PICTURE X(80) VALUE NC1094.2 +005700 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC1094.2 +005800- "789 ". NC1094.2 +005900 01 DISPLAY-DATA. NC1094.2 +006000 02 DISPLAY-A. NC1094.2 +006100 03 DISPLAY-03 PICTURE A VALUE "A". NC1094.2 +006200 03 DISPLAY-03A. NC1094.2 +006300 04 DISPLAY-04 PICTURE A VALUE "L". NC1094.2 +006400 04 DISPLAY-04A. NC1094.2 +006500 05 DISPLAY-05 PICTURE A VALUE "P". NC1094.2 +006600 05 DISPLAY-05A. NC1094.2 +006700 06 DISPLAY-06 PICTURE A VALUE "H". NC1094.2 +006800 06 DISPLAY-06A. NC1094.2 +006900 07 DISPLAY-07 PICTURE A VALUE "A". NC1094.2 +007000 07 DISPLAY-07A. NC1094.2 +007100 08 DISPLAY-08 PICTURE A VALUE "B". NC1094.2 +007200 08 DISPLAY-08A. NC1094.2 +007300 09 DISPLAY-09 PICTURE A VALUE "E". NC1094.2 +007400 09 DISPLAY-09A. NC1094.2 +007500 10 DISPLAY-10 PICTURE AAA VALUE "TIC". NC1094.2 +007600 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. NC1094.2 +007700 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". NC1094.2 +007800 02 DISPLAY-B PICTURE X(13). NC1094.2 +007900 02 DISPLAY-C REDEFINES DISPLAY-B. NC1094.2 +008000 03 DISPLAY-D PICTURE X(8). NC1094.2 +008100 03 DISPLAY-E PICTURE X(5). NC1094.2 +008200 02 DISPLAY-F. NC1094.2 +008300 03 DISPLAY-G PICTURE X(100) VALUE "*001*002*003*00NC1094.2 +008400- "4*005*006*007*008*009*010*011*012*013*014*015*016*017*018*01NC1094.2 +008500- "9*020*021*022*023*024*025". NC1094.2 +008600 03 DISPLAY-H PICTURE X(100) VALUE "*026*027*028*02NC1094.2 +008700- "9*030*031*032*033*034*035*036*037*038*039*040*041*042*043*04NC1094.2 +008800- "4*045*046*047*048*049*050". NC1094.2 +008900 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". NC1094.2 +009000 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". NC1094.2 +009100 02 CORRECT-FOLLOWS PICTURE X(20) VALUE NC1094.2 +009200 "CORRECT DATA FOLLOWS". NC1094.2 +009300 02 END-CORRECT PICTURE X(16) VALUE NC1094.2 +009400 "END CORRECT DATA". NC1094.2 +009500 02 DISPLAY-WRITER. NC1094.2 +009600 03 DIS-PLAYER. NC1094.2 +009700 04 FILLER PICTURE X(6). NC1094.2 +009800 04 QUOTE-SLOT PICTURE X. NC1094.2 +009900 04 FILLER PICTURE X(112). NC1094.2 +010000 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. NC1094.2 +010100 02 ZERO-SPACE-QUOTE. NC1094.2 +010200 03 FILLER PICTURE X VALUE ZERO. NC1094.2 +010300 03 FILLER PICTURE X VALUE SPACE. NC1094.2 +010400 03 FILLER PICTURE X VALUE QUOTE. NC1094.2 +010500 01 LONG-LITERAL. NC1094.2 +010600 02 LONG20 PICTURE IS X(20) NC1094.2 +010700 VALUE IS "STANDARD COMPILERS M". NC1094.2 +010800 02 LONG40 PICTURE IS X(20) NC1094.2 +010900 VALUE IS "UST ALLOW NON-NUMERI". NC1094.2 +011000 02 LONG60 PICTURE IS X(20) NC1094.2 +011100 VALUE IS "C LITERALS OF AT LEA". NC1094.2 +011200 02 LONG80 PICTURE IS X(20) NC1094.2 +011300 VALUE IS "ST 120 CHARACTERS AN". NC1094.2 +011400 02 LONG100 PICTURE IS X(20) NC1094.2 +011500 VALUE IS "D NUMERIC LITERALS O". NC1094.2 +011600 02 LONG120 PICTURE IS X(20) NC1094.2 +011700 VALUE IS "F AT LEAST 18 DIGITS". NC1094.2 +011800 01 ACCEPT-DATA. NC1094.2 +011900 02 ACCEPT-D1. NC1094.2 +012000 03 ACCEPT-D1-A PICTURE X(20). NC1094.2 +012100 03 ACCEPT-D1-B PICTURE X(7). NC1094.2 +012200 02 ACCEPT-D2 PICTURE X(27) NC1094.2 +012300 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY Z". NC1094.2 +012400 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. NC1094.2 +012500 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. NC1094.2 +012600 02 ACCEPT-D5 PICTURE X(11). NC1094.2 +012700 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/$, =". NC1094.2 +012800 02 ACCEPT-D7 PICTURE X. NC1094.2 +012900 02 ACCEPT-D8 PICTURE X VALUE "9". NC1094.2 +013000 02 ACCEPT-D9 PICTURE X. NC1094.2 +013100 02 ACCEPT-D10 PICTURE X VALUE "0". NC1094.2 +013200 02 ACCEPT-D11 PICTURE A(20). NC1094.2 +013300 02 ACCEPT-D12 PICTURE A(20) NC1094.2 +013400 VALUE " ABC XYZ ". NC1094.2 +013500 02 ACCEPT-D13 PICTURE 9(9). NC1094.2 +013600 02 ACCEPT-D14 PICTURE 9(9) VALUE 012345678. NC1094.2 +013700 02 ACCEPT-D15 PICTURE X. NC1094.2 +013800 02 ACCEPT-D16 PICTURE X VALUE SPACE. NC1094.2 +013900 02 ACCEPT-D17 PICTURE X. NC1094.2 +014000 02 ACCEPT-D18 PICTURE X VALUE QUOTE. NC1094.2 +014100 02 ACCEPT-D21. NC1094.2 +014200 03 TAB-ACCEPT PICTURE XXXX OCCURS 3 TIMES. NC1094.2 +014300 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". NC1094.2 +014400 01 TAB-VALUE PICTURE X(21) NC1094.2 +014500 VALUE "ABCDEFGHIJKLMNOPQRSTU". NC1094.2 +014600 01 NO-TAB-RECORD REDEFINES TAB-VALUE. NC1094.2 +014700 02 X1 PICTURE X. NC1094.2 +014800 02 X2 PICTURE X. NC1094.2 +014900 02 X3 PICTURE X. NC1094.2 +015000 02 X4 PICTURE X. NC1094.2 +015100 02 X5 PICTURE X. NC1094.2 +015200 02 X6 PICTURE X. NC1094.2 +015300 02 X7 PICTURE X. NC1094.2 +015400 02 X8 PICTURE X. NC1094.2 +015500 02 X9 PICTURE X. NC1094.2 +015600 02 X10 PICTURE X. NC1094.2 +015700 02 X11 PICTURE X. NC1094.2 +015800 02 X12 PICTURE X. NC1094.2 +015900 02 X13 PICTURE X. NC1094.2 +016000 02 X14 PICTURE X. NC1094.2 +016100 02 X15 PICTURE X. NC1094.2 +016200 02 X16 PICTURE X. NC1094.2 +016300 02 X17 PICTURE X. NC1094.2 +016400 02 X18 PICTURE X. NC1094.2 +016500 02 X19 PICTURE X. NC1094.2 +016600 02 X20 PICTURE X. NC1094.2 +016700 02 X21 PICTURE X. NC1094.2 +016800 01 TAB-RECORD REDEFINES TAB-VALUE. NC1094.2 +016900 02 XTAB PICTURE X OCCURS 21 TIMES. NC1094.2 +017000 01 DISPLAY-MIXTURE. NC1094.2 +017100 02 I-DATA PICTURE X(17) NC1094.2 +017200 VALUE " IDENTIFIER DATA ". NC1094.2 +017300 02 TA-VALUE PICTURE X(20) NC1094.2 +017400 VALUE "A B C D E 0102030405". NC1094.2 +017500 02 TA-BLE REDEFINES TA-VALUE. NC1094.2 +017600 04 PIECE-A PICTURE XX OCCURS 5 TIMES. NC1094.2 +017700 04 PIECE-N PICTURE 99 OCCURS 5 TIMES. NC1094.2 +017800 02 TRUE-PAIR. NC1094.2 +017900 03 A1 PICTURE X(21) NC1094.2 +018000 VALUE " (TOTAL 21 OPERANDS) ". NC1094.2 +018100 03 A2 PICTURE X(11) NC1094.2 +018200 VALUE "END OF DATA". NC1094.2 +018300 01 TEST-RESULTS. NC1094.2 +018400 02 FILLER PIC X VALUE SPACE. NC1094.2 +018500 02 FEATURE PIC X(20) VALUE SPACE. NC1094.2 +018600 02 FILLER PIC X VALUE SPACE. NC1094.2 +018700 02 P-OR-F PIC X(5) VALUE SPACE. NC1094.2 +018800 02 FILLER PIC X VALUE SPACE. NC1094.2 +018900 02 PAR-NAME. NC1094.2 +019000 03 FILLER PIC X(19) VALUE SPACE. NC1094.2 +019100 03 PARDOT-X PIC X VALUE SPACE. NC1094.2 +019200 03 DOTVALUE PIC 99 VALUE ZERO. NC1094.2 +019300 02 FILLER PIC X(8) VALUE SPACE. NC1094.2 +019400 02 RE-MARK PIC X(61). NC1094.2 +019500 01 TEST-COMPUTED. NC1094.2 +019600 02 FILLER PIC X(30) VALUE SPACE. NC1094.2 +019700 02 FILLER PIC X(17) VALUE NC1094.2 +019800 " COMPUTED=". NC1094.2 +019900 02 COMPUTED-X. NC1094.2 +020000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1094.2 +020100 03 COMPUTED-N REDEFINES COMPUTED-A NC1094.2 +020200 PIC -9(9).9(9). NC1094.2 +020300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1094.2 +020400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1094.2 +020500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1094.2 +020600 03 CM-18V0 REDEFINES COMPUTED-A. NC1094.2 +020700 04 COMPUTED-18V0 PIC -9(18). NC1094.2 +020800 04 FILLER PIC X. NC1094.2 +020900 03 FILLER PIC X(50) VALUE SPACE. NC1094.2 +021000 01 TEST-CORRECT. NC1094.2 +021100 02 FILLER PIC X(30) VALUE SPACE. NC1094.2 +021200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1094.2 +021300 02 CORRECT-X. NC1094.2 +021400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1094.2 +021500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1094.2 +021600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1094.2 +021700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1094.2 +021800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1094.2 +021900 03 CR-18V0 REDEFINES CORRECT-A. NC1094.2 +022000 04 CORRECT-18V0 PIC -9(18). NC1094.2 +022100 04 FILLER PIC X. NC1094.2 +022200 03 FILLER PIC X(2) VALUE SPACE. NC1094.2 +022300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1094.2 +022400 01 CCVS-C-1. NC1094.2 +022500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1094.2 +022600- "SS PARAGRAPH-NAME NC1094.2 +022700- " REMARKS". NC1094.2 +022800 02 FILLER PIC X(20) VALUE SPACE. NC1094.2 +022900 01 CCVS-C-2. NC1094.2 +023000 02 FILLER PIC X VALUE SPACE. NC1094.2 +023100 02 FILLER PIC X(6) VALUE "TESTED". NC1094.2 +023200 02 FILLER PIC X(15) VALUE SPACE. NC1094.2 +023300 02 FILLER PIC X(4) VALUE "FAIL". NC1094.2 +023400 02 FILLER PIC X(94) VALUE SPACE. NC1094.2 +023500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1094.2 +023600 01 REC-CT PIC 99 VALUE ZERO. NC1094.2 +023700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1094.2 +023800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1094.2 +023900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1094.2 +024000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1094.2 +024100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1094.2 +024200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1094.2 +024300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1094.2 +024400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1094.2 +024500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1094.2 +024600 01 CCVS-H-1. NC1094.2 +024700 02 FILLER PIC X(39) VALUE SPACES. NC1094.2 +024800 02 FILLER PIC X(42) VALUE NC1094.2 +024900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1094.2 +025000 02 FILLER PIC X(39) VALUE SPACES. NC1094.2 +025100 01 CCVS-H-2A. NC1094.2 +025200 02 FILLER PIC X(40) VALUE SPACE. NC1094.2 +025300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1094.2 +025400 02 FILLER PIC XXXX VALUE NC1094.2 +025500 "4.2 ". NC1094.2 +025600 02 FILLER PIC X(28) VALUE NC1094.2 +025700 " COPY - NOT FOR DISTRIBUTION". NC1094.2 +025800 02 FILLER PIC X(41) VALUE SPACE. NC1094.2 +025900 NC1094.2 +026000 01 CCVS-H-2B. NC1094.2 +026100 02 FILLER PIC X(15) VALUE NC1094.2 +026200 "TEST RESULT OF ". NC1094.2 +026300 02 TEST-ID PIC X(9). NC1094.2 +026400 02 FILLER PIC X(4) VALUE NC1094.2 +026500 " IN ". NC1094.2 +026600 02 FILLER PIC X(12) VALUE NC1094.2 +026700 " HIGH ". NC1094.2 +026800 02 FILLER PIC X(22) VALUE NC1094.2 +026900 " LEVEL VALIDATION FOR ". NC1094.2 +027000 02 FILLER PIC X(58) VALUE NC1094.2 +027100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +027200 01 CCVS-H-3. NC1094.2 +027300 02 FILLER PIC X(34) VALUE NC1094.2 +027400 " FOR OFFICIAL USE ONLY ". NC1094.2 +027500 02 FILLER PIC X(58) VALUE NC1094.2 +027600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1094.2 +027700 02 FILLER PIC X(28) VALUE NC1094.2 +027800 " COPYRIGHT 1985 ". NC1094.2 +027900 01 CCVS-E-1. NC1094.2 +028000 02 FILLER PIC X(52) VALUE SPACE. NC1094.2 +028100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1094.2 +028200 02 ID-AGAIN PIC X(9). NC1094.2 +028300 02 FILLER PIC X(45) VALUE SPACES. NC1094.2 +028400 01 CCVS-E-2. NC1094.2 +028500 02 FILLER PIC X(31) VALUE SPACE. NC1094.2 +028600 02 FILLER PIC X(21) VALUE SPACE. NC1094.2 +028700 02 CCVS-E-2-2. NC1094.2 +028800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1094.2 +028900 03 FILLER PIC X VALUE SPACE. NC1094.2 +029000 03 ENDER-DESC PIC X(44) VALUE NC1094.2 +029100 "ERRORS ENCOUNTERED". NC1094.2 +029200 01 CCVS-E-3. NC1094.2 +029300 02 FILLER PIC X(22) VALUE NC1094.2 +029400 " FOR OFFICIAL USE ONLY". NC1094.2 +029500 02 FILLER PIC X(12) VALUE SPACE. NC1094.2 +029600 02 FILLER PIC X(58) VALUE NC1094.2 +029700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +029800 02 FILLER PIC X(13) VALUE SPACE. NC1094.2 +029900 02 FILLER PIC X(15) VALUE NC1094.2 +030000 " COPYRIGHT 1985". NC1094.2 +030100 01 CCVS-E-4. NC1094.2 +030200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1094.2 +030300 02 FILLER PIC X(4) VALUE " OF ". NC1094.2 +030400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1094.2 +030500 02 FILLER PIC X(40) VALUE NC1094.2 +030600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1094.2 +030700 01 XXINFO. NC1094.2 +030800 02 FILLER PIC X(19) VALUE NC1094.2 +030900 "*** INFORMATION ***". NC1094.2 +031000 02 INFO-TEXT. NC1094.2 +031100 04 FILLER PIC X(8) VALUE SPACE. NC1094.2 +031200 04 XXCOMPUTED PIC X(20). NC1094.2 +031300 04 FILLER PIC X(5) VALUE SPACE. NC1094.2 +031400 04 XXCORRECT PIC X(20). NC1094.2 +031500 02 INF-ANSI-REFERENCE PIC X(48). NC1094.2 +031600 01 HYPHEN-LINE. NC1094.2 +031700 02 FILLER PIC IS X VALUE IS SPACE. NC1094.2 +031800 02 FILLER PIC IS X(65) VALUE IS "************************NC1094.2 +031900- "*****************************************". NC1094.2 +032000 02 FILLER PIC IS X(54) VALUE IS "************************NC1094.2 +032100- "******************************". NC1094.2 +032200 01 CCVS-PGM-ID PIC X(9) VALUE NC1094.2 +032300 "NC109M". NC1094.2 +032400 PROCEDURE DIVISION. NC1094.2 +032500 CCVS1 SECTION. NC1094.2 +032600 OPEN-FILES. NC1094.2 +032700 OPEN OUTPUT PRINT-FILE. NC1094.2 +032800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1094.2 +032900 MOVE SPACE TO TEST-RESULTS. NC1094.2 +033000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1094.2 +033100 GO TO CCVS1-EXIT. NC1094.2 +033200 CLOSE-FILES. NC1094.2 +033300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1094.2 +033400 TERMINATE-CCVS. NC1094.2 +033500S EXIT PROGRAM. NC1094.2 +033600STERMINATE-CALL. NC1094.2 +033700 STOP RUN. NC1094.2 +033800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1094.2 +033900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1094.2 +034000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1094.2 +034100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1094.2 +034200 MOVE "****TEST DELETED****" TO RE-MARK. NC1094.2 +034300 PRINT-DETAIL. NC1094.2 +034400 IF REC-CT NOT EQUAL TO ZERO NC1094.2 +034500 MOVE "." TO PARDOT-X NC1094.2 +034600 MOVE REC-CT TO DOTVALUE. NC1094.2 +034700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1094.2 +034800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1094.2 +034900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1094.2 +035000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1094.2 +035100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1094.2 +035200 MOVE SPACE TO CORRECT-X. NC1094.2 +035300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1094.2 +035400 MOVE SPACE TO RE-MARK. NC1094.2 +035500 HEAD-ROUTINE. NC1094.2 +035600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +035700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +035800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1094.2 +035900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1094.2 +036000 COLUMN-NAMES-ROUTINE. NC1094.2 +036100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +036200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +036300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +036400 END-ROUTINE. NC1094.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1094.2 +036600 END-RTN-EXIT. NC1094.2 +036700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +036800 END-ROUTINE-1. NC1094.2 +036900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1094.2 +037000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1094.2 +037100 ADD PASS-COUNTER TO ERROR-HOLD. NC1094.2 +037200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1094.2 +037300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1094.2 +037400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1094.2 +037500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1094.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1094.2 +037700 END-ROUTINE-12. NC1094.2 +037800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1094.2 +037900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1094.2 +038000 MOVE "NO " TO ERROR-TOTAL NC1094.2 +038100 ELSE NC1094.2 +038200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1094.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1094.2 +038400 PERFORM WRITE-LINE. NC1094.2 +038500 END-ROUTINE-13. NC1094.2 +038600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1094.2 +038700 MOVE "NO " TO ERROR-TOTAL ELSE NC1094.2 +038800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1094.2 +038900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1094.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039100 IF INSPECT-COUNTER EQUAL TO ZERO NC1094.2 +039200 MOVE "NO " TO ERROR-TOTAL NC1094.2 +039300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1094.2 +039400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1094.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039700 WRITE-LINE. NC1094.2 +039800 ADD 1 TO RECORD-COUNT. NC1094.2 +039900Y IF RECORD-COUNT GREATER 42 NC1094.2 +040000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1094.2 +040100Y MOVE SPACE TO DUMMY-RECORD NC1094.2 +040200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1094.2 +040300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1094.2 +040400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1094.2 +040500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1094.2 +040600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1094.2 +040700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +040800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +040900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +041000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1094.2 +041100Y MOVE ZERO TO RECORD-COUNT. NC1094.2 +041200 PERFORM WRT-LN. NC1094.2 +041300 WRT-LN. NC1094.2 +041400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1094.2 +041500 MOVE SPACE TO DUMMY-RECORD. NC1094.2 +041600 BLANK-LINE-PRINT. NC1094.2 +041700 PERFORM WRT-LN. NC1094.2 +041800 FAIL-ROUTINE. NC1094.2 +041900 IF COMPUTED-X NOT EQUAL TO SPACE NC1094.2 +042000 GO TO FAIL-ROUTINE-WRITE. NC1094.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1094.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1094.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1094.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +042500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1094.2 +042600 GO TO FAIL-ROUTINE-EX. NC1094.2 +042700 FAIL-ROUTINE-WRITE. NC1094.2 +042800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1094.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1094.2 +043000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1094.2 +043100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1094.2 +043200 FAIL-ROUTINE-EX. EXIT. NC1094.2 +043300 BAIL-OUT. NC1094.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1094.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1094.2 +043600 BAIL-OUT-WRITE. NC1094.2 +043700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1094.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1094.2 +043900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +044000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1094.2 +044100 BAIL-OUT-EX. EXIT. NC1094.2 +044200 CCVS1-EXIT. NC1094.2 +044300 EXIT. NC1094.2 +044400 SECT-NC109M-001 SECTION. NC1094.2 +044500 ACC-INIT-GF-1. NC1094.2 +044600 MOVE "ACCEPT" TO FEATURE. NC1094.2 +044700 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +044800 MOVE SPACES TO ACCEPT-D1. NC1094.2 +044900 ACC-TEST-GF-1. NC1094.2 +045000 MOVE "ACC-TEST-GF-1" TO PAR-NAME. NC1094.2 +045100 ACCEPT ACCEPT-D1. NC1094.2 +045200 IF ACCEPT-D1 EQUAL TO ACCEPT-D2 NC1094.2 +045300 PERFORM PASS GO TO ACC-WRITE-GF-1. NC1094.2 +045400* NOTE ACCEPT ALPHABETIC LITERAL TO ALPHANUMERIC FIELD. NC1094.2 +045500 GO TO ACC-FAIL-GF-1. NC1094.2 +045600 ACC-DELETE-GF-1. NC1094.2 +045700 MOVE "ACC-TEST-GF-1" TO PAR-NAME. NC1094.2 +045800 PERFORM DE-LETE. NC1094.2 +045900 GO TO ACC-WRITE-GF-1. NC1094.2 +046000 ACC-FAIL-GF-1. NC1094.2 +046100 PERFORM FAIL. NC1094.2 +046200 MOVE ACCEPT-D1-A TO COMPUTED-A. NC1094.2 +046300 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1094.2 +046400 PERFORM PRINT-DETAIL. NC1094.2 +046500 MOVE ACCEPT-D1-B TO COMPUTED-A. NC1094.2 +046600 MOVE "UVWXY Z" TO CORRECT-A. NC1094.2 +046700 MOVE "LAST 7 OF 27-CHAR FIELD" TO RE-MARK. NC1094.2 +046800 ACC-WRITE-GF-1. NC1094.2 +046900 PERFORM PRINT-DETAIL. NC1094.2 +047000 ACC-INIT-GF-2. NC1094.2 +047100 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +047200 MOVE ZEROES TO ACCEPT-D3. NC1094.2 +047300 ACC-TEST-GF-2. NC1094.2 +047400 ACCEPT ACCEPT-D3. NC1094.2 +047500 IF ACCEPT-D3 EQUAL TO ACCEPT-D4 NC1094.2 +047600 PERFORM PASS GO TO ACC-WRITE-GF-2. NC1094.2 +047700* NOTE ACCEPT NUMERIC LITERAL TO NUMERIC FIELD SAME LENGTH.NC1094.2 +047800 GO TO ACC-FAIL-GF-2. NC1094.2 +047900 ACC-DELETE-GF-2. NC1094.2 +048000 PERFORM DE-LETE. NC1094.2 +048100 GO TO ACC-WRITE-GF-2. NC1094.2 +048200 ACC-FAIL-GF-2. NC1094.2 +048300 MOVE ACCEPT-D3 TO COMPUTED-18V0. NC1094.2 +048400 MOVE ACCEPT-D4 TO CORRECT-18V0. NC1094.2 +048500 PERFORM FAIL. NC1094.2 +048600 ACC-WRITE-GF-2. NC1094.2 +048700 MOVE "ACC-TEST-GF-2 " TO PAR-NAME. NC1094.2 +048800 PERFORM PRINT-DETAIL. NC1094.2 +048900 ACC-INIT-GF-3. NC1094.2 +049000 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +049100 MOVE SPACES TO ACCEPT-D5. NC1094.2 +049200 ACC-TEST-GF-3. NC1094.2 +049300 ACCEPT ACCEPT-D5. NC1094.2 +049400 IF ACCEPT-D5 EQUAL TO ACCEPT-D6 NC1094.2 +049500 PERFORM PASS GO TO ACC-WRITE-GF-3. NC1094.2 +049600* NOTE ACCEPT SPECIAL CHARACTERS. NC1094.2 +049700 GO TO ACC-FAIL-GF-3. NC1094.2 +049800 ACC-DELETE-GF-3. NC1094.2 +049900 PERFORM DE-LETE. NC1094.2 +050000 GO TO ACC-WRITE-GF-3. NC1094.2 +050100 ACC-FAIL-GF-3. NC1094.2 +050200 MOVE ACCEPT-D5 TO COMPUTED-A. NC1094.2 +050300 MOVE ACCEPT-D6 TO CORRECT-A. NC1094.2 +050400 PERFORM FAIL. NC1094.2 +050500 ACC-WRITE-GF-3. NC1094.2 +050600 MOVE "ACC-TEST-GF-3 " TO PAR-NAME. NC1094.2 +050700 PERFORM PRINT-DETAIL. NC1094.2 +050800 ACC-INIT-GF-4. NC1094.2 +050900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +051000 MOVE SPACES TO ACCEPT-D7. NC1094.2 +051100 ACC-TEST-GF-4. NC1094.2 +051200 ACCEPT ACCEPT-D7. NC1094.2 +051300 IF ACCEPT-D7 EQUAL TO ACCEPT-D8 NC1094.2 +051400 PERFORM PASS GO TO ACC-WRITE-GF-4. NC1094.2 +051500* NOTE ACCEPT HIGH-VALUE. NC1094.2 +051600* NOTE CHANGED TO ACCEPT AN ALPHANUMERIC 9. NC1094.2 +051700 GO TO ACC-FAIL-GF-4. NC1094.2 +051800 ACC-DELETE-GF-4. NC1094.2 +051900 PERFORM DE-LETE. NC1094.2 +052000 GO TO ACC-WRITE-GF-4. NC1094.2 +052100 ACC-FAIL-GF-4. NC1094.2 +052200 MOVE ACCEPT-D7 TO COMPUTED-A. NC1094.2 +052300 MOVE ACCEPT-D8 TO CORRECT-A. NC1094.2 +052400 PERFORM FAIL. NC1094.2 +052500 ACC-WRITE-GF-4. NC1094.2 +052600 MOVE "ACC-TEST-GF-4 " TO PAR-NAME. NC1094.2 +052700 PERFORM PRINT-DETAIL. NC1094.2 +052800 ACC-INIT-GF-5. NC1094.2 +052900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +053000 MOVE SPACES TO ACCEPT-D9. NC1094.2 +053100 ACC-TEST-GF-5. NC1094.2 +053200 ACCEPT ACCEPT-D9. NC1094.2 +053300 IF ACCEPT-D9 EQUAL TO ACCEPT-D10 NC1094.2 +053400 PERFORM PASS GO TO ACC-WRITE-GF-5. NC1094.2 +053500* NOTE CHANGED TO ACCEPT AN ALPHANUMERIC 0. NC1094.2 +053600* NOTE ACCEPT LOW-VALUE. NC1094.2 +053700 GO TO ACC-FAIL-GF-5. NC1094.2 +053800 ACC-DELETE-GF-5. NC1094.2 +053900 PERFORM DE-LETE. NC1094.2 +054000 GO TO ACC-WRITE-GF-5. NC1094.2 +054100 ACC-FAIL-GF-5. NC1094.2 +054200 MOVE ACCEPT-D9 TO COMPUTED-A. NC1094.2 +054300 MOVE ACCEPT-D10 TO CORRECT-A. NC1094.2 +054400 PERFORM FAIL. NC1094.2 +054500 ACC-WRITE-GF-5. NC1094.2 +054600 MOVE "ACC-TEST-GF-5 " TO PAR-NAME. NC1094.2 +054700 PERFORM PRINT-DETAIL. NC1094.2 +054800 ACC-INIT-GF-6. NC1094.2 +054900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +055000 MOVE SPACES TO ACCEPT-D11. NC1094.2 +055100 ACC-TEST-GF-6. NC1094.2 +055200 ACCEPT ACCEPT-D11. NC1094.2 +055300 IF ACCEPT-D11 EQUAL TO ACCEPT-D12 NC1094.2 +055400 PERFORM PASS GO TO ACC-WRITE-GF-6. NC1094.2 +055500* NOTE ACCEPT ALPHABETIC LITERAL TO ALPHABETIC FIELD. NC1094.2 +055600 GO TO ACC-FAIL-GF-6. NC1094.2 +055700 ACC-DELETE-GF-6. NC1094.2 +055800 PERFORM DE-LETE. NC1094.2 +055900 GO TO ACC-WRITE-GF-6. NC1094.2 +056000 ACC-FAIL-GF-6. NC1094.2 +056100 MOVE ACCEPT-D11 TO COMPUTED-A. NC1094.2 +056200 MOVE ACCEPT-D12 TO CORRECT-A. NC1094.2 +056300 PERFORM FAIL. NC1094.2 +056400 ACC-WRITE-GF-6. NC1094.2 +056500 MOVE "ACC-TEST-GF-6 " TO PAR-NAME. NC1094.2 +056600 PERFORM PRINT-DETAIL. NC1094.2 +056700 ACC-INIT-GF-7. NC1094.2 +056800 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +056900 MOVE ZEROES TO ACCEPT-D13. NC1094.2 +057000 ACC-TEST-GF-7. NC1094.2 +057100 ACCEPT ACCEPT-D13. NC1094.2 +057200 IF ACCEPT-D13 EQUAL TO ACCEPT-D14 NC1094.2 +057300 PERFORM PASS GO TO ACC-WRITE-GF-7. NC1094.2 +057400* NOTE ACCEPT NUMERIC LITERAL TO NUMERIC FIELD OF DIFFERENTNC1094.2 +057500* LENGTH. NC1094.2 +057600 GO TO ACC-FAIL-GF-7. NC1094.2 +057700 ACC-DELETE-GF-7. NC1094.2 +057800 PERFORM DE-LETE. NC1094.2 +057900 GO TO ACC-WRITE-GF-7. NC1094.2 +058000 ACC-FAIL-GF-7. NC1094.2 +058100 MOVE ACCEPT-D13 TO COMPUTED-A. NC1094.2 +058200 MOVE ACCEPT-D14 TO CORRECT-A. NC1094.2 +058300 PERFORM FAIL. NC1094.2 +058400 ACC-WRITE-GF-7. NC1094.2 +058500 MOVE "ACC-TEST-GF-7 " TO PAR-NAME. NC1094.2 +058600 PERFORM PRINT-DETAIL. NC1094.2 +058700 ACC-INIT-GF-8. NC1094.2 +058800 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +058900 MOVE ZEROES TO ACCEPT-D15. NC1094.2 +059000 ACC-TEST-GF-8. NC1094.2 +059100 ACCEPT ACCEPT-D15. NC1094.2 +059200 IF ACCEPT-D15 EQUAL TO ACCEPT-D16 NC1094.2 +059300 PERFORM PASS GO TO ACC-WRITE-GF-8. NC1094.2 +059400* NOTE ACCEPT SINGLE SPACE. NC1094.2 +059500 GO TO ACC-FAIL-GF-8. NC1094.2 +059600 ACC-DELETE-GF-8. NC1094.2 +059700 PERFORM DE-LETE. NC1094.2 +059800 GO TO ACC-WRITE-GF-8. NC1094.2 +059900 ACC-FAIL-GF-8. NC1094.2 +060000 PERFORM FAIL. NC1094.2 +060100 MOVE ACCEPT-D15 TO COMPUTED-A. NC1094.2 +060200 MOVE " (SPACES)" TO CORRECT-A. NC1094.2 +060300 ACC-WRITE-GF-8. NC1094.2 +060400 MOVE "ACC-TEST-GF-8" TO PAR-NAME. NC1094.2 +060500 PERFORM PRINT-DETAIL. NC1094.2 +060600 ACC-INIT-GF-9. NC1094.2 +060700 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +060800 MOVE ZEROES TO ACCEPT-D17. NC1094.2 +060900 ACC-TEST-GF-9. NC1094.2 +061000 ACCEPT ACCEPT-D17. NC1094.2 +061100 IF ACCEPT-D17 EQUAL TO ACCEPT-D18 NC1094.2 +061200 PERFORM PASS GO TO ACC-WRITE-GF-9. NC1094.2 +061300* NOTE ACCEPT A QUOTE. NC1094.2 +061400 GO TO ACC-FAIL-GF-9. NC1094.2 +061500 ACC-DELETE-GF-9. NC1094.2 +061600 PERFORM DE-LETE. NC1094.2 +061700 GO TO ACC-WRITE-GF-9. NC1094.2 +061800 ACC-FAIL-GF-9. NC1094.2 +061900 PERFORM FAIL. NC1094.2 +062000 MOVE ACCEPT-D17 TO COMPUTED-A. NC1094.2 +062100 MOVE ACCEPT-D18 TO CORRECT-A. NC1094.2 +062200 ACC-WRITE-GF-9. NC1094.2 +062300 MOVE "ACC-TEST-GF-9" TO PAR-NAME. NC1094.2 +062400 PERFORM PRINT-DETAIL. NC1094.2 +062500 ACC-INIT-GF-10. NC1094.2 +062600 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +062700 MOVE "............" TO ACCEPT-D21. NC1094.2 +062800 ACC-TEST-GF-10. NC1094.2 +062900 ACCEPT TAB-ACCEPT (2). NC1094.2 +063000 IF ACCEPT-D21 EQUAL TO ACCEPT-D22 NC1094.2 +063100 PERFORM PASS GO TO ACC-WRITE-GF-10. NC1094.2 +063200* NOTE ACCEPT TO SUBSCRIPTED AREA. NC1094.2 +063300 GO TO ACC-FAIL-GF-10. NC1094.2 +063400 ACC-DELETE-GF-10. NC1094.2 +063500 PERFORM DE-LETE. NC1094.2 +063600 GO TO ACC-WRITE-GF-10. NC1094.2 +063700 ACC-FAIL-GF-10. NC1094.2 +063800 PERFORM FAIL. NC1094.2 +063900 MOVE ACCEPT-D21 TO COMPUTED-A. NC1094.2 +064000 MOVE ACCEPT-D22 TO CORRECT-A. NC1094.2 +064100 ACC-WRITE-GF-10. NC1094.2 +064200 MOVE "ACC-TEST-GF-10" TO PAR-NAME. NC1094.2 +064300 PERFORM PRINT-DETAIL. NC1094.2 +064400 ACC-INIT-GF-11. NC1094.2 +064500 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +064600 MOVE SPACES TO X80-CHARACTER-FIELD. NC1094.2 +064700 ACC-TEST-GF-11. NC1094.2 +064800 ACCEPT X80-CHARACTER-FIELD. NC1094.2 +064900 MOVE "ACC-TEST-GF-11" TO PAR-NAME. NC1094.2 +065000 IF X80-CHARACTER-FIELD EQUAL TO ACCEPT-RESULTS NC1094.2 +065100 PERFORM PASS GO TO ACC-WRITE-GF-11. NC1094.2 +065200* NOTE ACCEPT 80-CHARACTER LITERAL. NC1094.2 +065300 GO TO ACC-FAIL-GF-11. NC1094.2 +065400 ACC-DELETE-GF-11. NC1094.2 +065500 PERFORM DE-LETE. NC1094.2 +065600 MOVE "ACC-TEST-GF-11" TO PAR-NAME. NC1094.2 +065700 GO TO ACC-WRITE-GF-11. NC1094.2 +065800 ACC-FAIL-GF-11. NC1094.2 +065900 MOVE X80-CHARACTER-FIELD TO CHARACTER-BREAKDOWN-R. NC1094.2 +066000 PERFORM FAIL. NC1094.2 +066100 MOVE ACCEPT-RESULTS TO CHARACTER-BREAKDOWN-S. NC1094.2 +066200 MOVE FIRST-20R TO COMPUTED-A. NC1094.2 +066300 MOVE FIRST-20S TO CORRECT-A. NC1094.2 +066400 PERFORM PRINT-DETAIL. NC1094.2 +066500 MOVE SECOND-20R TO COMPUTED-A. NC1094.2 +066600 MOVE SECOND-20S TO CORRECT-A. NC1094.2 +066700 PERFORM PRINT-DETAIL. NC1094.2 +066800 MOVE THIRD-20R TO COMPUTED-A. NC1094.2 +066900 MOVE THIRD-20S TO CORRECT-A. NC1094.2 +067000 PERFORM PRINT-DETAIL. NC1094.2 +067100 MOVE FOURTH-20R TO COMPUTED-A. NC1094.2 +067200 MOVE FOURTH-20S TO CORRECT-A. NC1094.2 +067300 MOVE "LAST 20 OF 80-CHAR FIELD" TO RE-MARK. NC1094.2 +067400 ACC-WRITE-GF-11. NC1094.2 +067500 PERFORM PRINT-DETAIL. NC1094.2 +067600 DISP-INIT-GF-1. NC1094.2 +067700 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +067800 PERFORM BLANK-LINE-PRINT. NC1094.2 +067900 MOVE "DISPLAY TESTS" TO FEATURE. NC1094.2 +068000 MOVE "SEE NOTE IN DISP-INIT-GF-1" TO RE-MARK. NC1094.2 +068100 PERFORM PRINT-DETAIL. NC1094.2 +068200 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1094.2 +068300 MOVE "DISPLAY" TO FEATURE. NC1094.2 +068400* NOTE FOR THE SAKE OF CONVENIENCE IN READING THE OUTPUT, NC1094.2 +068500* THE DISPLAY TESTS ARE CONSTRUCTED ON THE ASSUMPTION NC1094.2 +068600* THAT THE DISPLAYED OUTPUT WILL BE PRINTED ALONG NC1094.2 +068700* WITH THE OUTPUT FROM THE WRITE STATEMENTS --- NC1094.2 +068800* HOWEVER IT IS NOT CONSIDERED NONSTANDARD IF THE NC1094.2 +068900* DISPLAYED DATA APPEARS ELSEWHERE IN THE LISTING, OR NC1094.2 +069000* FOR THAT MATTER, ON SOME OTHER DEVICE. NC1094.2 +069100 DISP-TEST-GF-1. NC1094.2 +069200 MOVE "DISP-TEST-GF-1 " TO PAR-NAME. NC1094.2 +069300 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +069400 DISPLAY DISPLAY-A. NC1094.2 +069500* NOTE GROUP OF ALPHABETIC DATA ITEMS. NC1094.2 +069600 MOVE DISPLAY-A TO DIS-PLAYER. NC1094.2 +069700 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +069800 GO TO DISP-WRITE-GF-1. NC1094.2 +069900 DISP-DELETE-GF-1. NC1094.2 +070000 PERFORM DE-LETE. NC1094.2 +070100 DISP-WRITE-GF-1. NC1094.2 +070200 MOVE "DISP-TEST-GF-1 " TO PAR-NAME. NC1094.2 +070300 PERFORM PRINT-DETAIL. NC1094.2 +070400 DISP-INIT-GF-2. NC1094.2 +070500 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +070600 MOVE "DISP-TEST-GF-2 " TO PAR-NAME. NC1094.2 +070700 DISP-TEST-GF-2. NC1094.2 +070800 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +070900 DISPLAY "ALPHABETIC LITERAL". NC1094.2 +071000* NOTE ALPHABETIC LITERAL. NC1094.2 +071100 MOVE "ALPHABETIC LITERAL" TO DIS-PLAYER. NC1094.2 +071200 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +071300 GO TO DISP-WRITE-GF-2. NC1094.2 +071400 DISP-DELETE-GF-2. NC1094.2 +071500 PERFORM DE-LETE. NC1094.2 +071600 DISP-WRITE-GF-2. NC1094.2 +071700 MOVE "DISP-TEST-GF-2 " TO PAR-NAME. NC1094.2 +071800 PERFORM PRINT-DETAIL. NC1094.2 +071900 DISP-INIT-GF-3. NC1094.2 +072000 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +072100 MOVE "DISP-TEST-GF-3" TO PAR-NAME. NC1094.2 +072200 MOVE 0123456789 TO DISPLAY-N. NC1094.2 +072300 DISP-TEST-GF-3. NC1094.2 +072400 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +072500 DISPLAY DISPLAY-N. NC1094.2 +072600* NOTE NUMERIC DATA ITEM. NC1094.2 +072700 MOVE DISPLAY-N TO DIS-PLAYER. NC1094.2 +072800 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +072900 GO TO DISP-WRITE-GF-3. NC1094.2 +073000 DISP-DELETE-GF-3. NC1094.2 +073100 PERFORM DE-LETE. NC1094.2 +073200 DISP-WRITE-GF-3. NC1094.2 +073300 MOVE "DISP-TEST-GF-3 " TO PAR-NAME. NC1094.2 +073400 PERFORM PRINT-DETAIL. NC1094.2 +073500 DISP-INIT-GF-4. NC1094.2 +073600 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +073700 MOVE "DISP-TEST-GF-4" TO PAR-NAME. NC1094.2 +073800 DISP-TEST-GF-4. NC1094.2 +073900 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +074000 DISPLAY 9876543210. NC1094.2 +074100* NOTE NUMERIC LITERAL. NC1094.2 +074200 MOVE 9876543210 TO DIS-PLAYER. NC1094.2 +074300 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +074400 GO TO DISP-WRITE-GF-4. NC1094.2 +074500 DISP-DELETE-GF-4. NC1094.2 +074600 PERFORM DE-LETE. NC1094.2 +074700 DISP-WRITE-GF-4. NC1094.2 +074800 MOVE "DISP-TEST-GF-4 " TO PAR-NAME. NC1094.2 +074900 PERFORM PRINT-DETAIL. NC1094.2 +075000 DISP-INIT-GF-5. NC1094.2 +075100 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +075200 MOVE "DISP-TEST-GF-5" TO PAR-NAME. NC1094.2 +075300 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC1094.2 +075400 DISP-TEST-GF-5. NC1094.2 +075500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +075600 DISPLAY DISPLAY-X. NC1094.2 +075700* NOTE ALPHANUMERIC DATA ITEM. NC1094.2 +075800 MOVE DISPLAY-X TO DIS-PLAYER. NC1094.2 +075900 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +076000 GO TO DISP-WRITE-GF-5. NC1094.2 +076100 DISP-DELETE-GF-5. NC1094.2 +076200 PERFORM DE-LETE. NC1094.2 +076300 DISP-WRITE-GF-5. NC1094.2 +076400 MOVE "DISP-TEST-GF-5 " TO PAR-NAME. NC1094.2 +076500 PERFORM PRINT-DETAIL. NC1094.2 +076600 DISP-INIT-GF-6. NC1094.2 +076700 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +076800 MOVE "DISP-TEST-GF-6" TO PAR-NAME. NC1094.2 +076900 DISP-TEST-GF-6. NC1094.2 +077000 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +077100 DISPLAY "12345 ///// ALPHANUMERIC LITERAL". NC1094.2 +077200* NOTE ALPHANUMERIC LITERAL. NC1094.2 +077300 MOVE "12345 ///// ALPHANUMERIC LITERAL" TO DIS-PLAYER. NC1094.2 +077400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +077500 GO TO DISP-WRITE-GF-6. NC1094.2 +077600 DISP-DELETE-GF-6. NC1094.2 +077700 PERFORM DE-LETE. NC1094.2 +077800 DISP-WRITE-GF-6. NC1094.2 +077900 MOVE "DISP-TEST-GF-6 " TO PAR-NAME. NC1094.2 +078000 PERFORM PRINT-DETAIL. NC1094.2 +078100 DISP-INIT-GF-7. NC1094.2 +078200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +078300 MOVE "DISP-TEST-GF-7" TO PAR-NAME. NC1094.2 +078400 MOVE "ALPHABETIC" TO DISPLAY-A. NC1094.2 +078500 MOVE 0123456789 TO DISPLAY-N. NC1094.2 +078600 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC1094.2 +078700 DISP-TEST-GF-7. NC1094.2 +078800 MOVE "DISP-TEST-GF-7 " TO PAR-NAME. NC1094.2 +078900 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +079000 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES". NC1094.2 +079100* NOTE SERIES OF THREE DATA ITEMS AND A LITERAL. NC1094.2 +079200 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC1094.2 +079300 TO DIS-PLAYER. NC1094.2 +079400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +079500 GO TO DISP-WRITE-GF-7. NC1094.2 +079600 DISP-DELETE-GF-7. NC1094.2 +079700 PERFORM DE-LETE. NC1094.2 +079800 DISP-WRITE-GF-7. NC1094.2 +079900 MOVE "DISP-TEST-GF-7 " TO PAR-NAME. NC1094.2 +080000 PERFORM PRINT-DETAIL. NC1094.2 +080100 DISP-INIT-GF-8. NC1094.2 +080200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +080300 MOVE "DISP-TEST-GF-8 " TO PAR-NAME. NC1094.2 +080400 DISP-TEST-GF-8. NC1094.2 +080500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +080600 DISPLAY ZERO SPACE QUOTE. NC1094.2 +080700* NOTE SERIES OF FIGURATIVE CONSTANTS --- ONLY ONE OCCUR- NC1094.2 +080800* RANCE OF EACH CHARACTER SHOULD APPEAR. NC1094.2 +080900 MOVE ZERO-SPACE-QUOTE TO DIS-PLAYER. NC1094.2 +081000 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +081100 GO TO DISP-WRITE-GF-8. NC1094.2 +081200 DISP-DELETE-GF-8. NC1094.2 +081300 PERFORM DE-LETE. NC1094.2 +081400 DISP-WRITE-GF-8. NC1094.2 +081500 MOVE "DISP-TEST-GF-8 " TO PAR-NAME. NC1094.2 +081600 PERFORM PRINT-DETAIL. NC1094.2 +081700 DISP-INIT-GF-9. NC1094.2 +081800 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +081900 MOVE "DISP-TEST-GF-9 " TO PAR-NAME. NC1094.2 +082000 MOVE "REDEFINE-INFO" TO DISPLAY-B. NC1094.2 +082100 DISP-TEST-GF-9. NC1094.2 +082200 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +082300 DISPLAY DISPLAY-C. NC1094.2 +082400* NOTE DISPLAY DATA ITEM WHICH CONTAINS A REDEFINES CLAUSE.NC1094.2 +082500 MOVE "REDEFINE-INFO" TO DIS-PLAYER. NC1094.2 +082600 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +082700 GO TO DISP-WRITE-GF-9. NC1094.2 +082800 DISP-DELETE-GF-9. NC1094.2 +082900 PERFORM DE-LETE. NC1094.2 +083000 DISP-WRITE-GF-9. NC1094.2 +083100 MOVE "DISP-TEST-GF-9 " TO PAR-NAME. NC1094.2 +083200 PERFORM PRINT-DETAIL. NC1094.2 +083300 DISP-INIT-GF-10. NC1094.2 +083400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +083500 MOVE "DISP-TEST-GF-10 " TO PAR-NAME. NC1094.2 +083600 DISP-TEST-GF-10. NC1094.2 +083700 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +083800 DISPLAY DISPLAY-F. NC1094.2 +083900* NOTE 200-CHARACTER GROUP ITEM --- ACTUAL NUMBER OF NC1094.2 +084000* CHARACTERS DISPLAYED DEPENDS UPON THE SYSTEM. NC1094.2 +084100 MOVE DISPLAY-G TO DIS-PLAYER. NC1094.2 +084200 MOVE 1 TO DISPLAY-SWITCH. NC1094.2 +084300* NOTE THE "CORRECT" RESULT IS WRITTEN AS TWO 100-CHARACTERNC1094.2 +084400* LINES, BUT THE DIVISION OF THE DISPLAYED "COMPUTED" NC1094.2 +084500* DATA DEPENDS UPON THE SYSTEM. NC1094.2 +084600 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +084700 GO TO DISP-WRITE-GF-10. NC1094.2 +084800 DISP-DELETE-GF-10. NC1094.2 +084900 PERFORM DE-LETE. NC1094.2 +085000 DISP-WRITE-GF-10. NC1094.2 +085100 MOVE "DISP-TEST-GF-10 " TO PAR-NAME. NC1094.2 +085200 PERFORM PRINT-DETAIL. NC1094.2 +085300 DISP-INIT-GF-11. NC1094.2 +085400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +085500 MOVE "DISP-TEST-GF-11 " TO PAR-NAME. NC1094.2 +085600 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO TAB-VALUE. NC1094.2 +085700 DISP-TEST-GF-11. NC1094.2 +085800 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +085900 DISPLAY X21 X20 X19 X18 X17 X16 X15 X14 X13 X12 X11 X10 X9 NC1094.2 +086000 X8 X7 X6 X5 X4 X3 X2 X1. NC1094.2 +086100* NOTE 21 ELEMENTARY ALPHABETIC DATA ITEMS. NC1094.2 +086200 MOVE "UTSRQPONMLKJIHGFEDCBA" TO DIS-PLAYER. NC1094.2 +086300 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +086400 GO TO DISP-WRITE-GF-11. NC1094.2 +086500 DISP-DELETE-GF-11. NC1094.2 +086600 PERFORM DE-LETE. NC1094.2 +086700 DISP-WRITE-GF-11. NC1094.2 +086800 MOVE "DISP-TEST-GF-11 " TO PAR-NAME. NC1094.2 +086900 PERFORM PRINT-DETAIL. NC1094.2 +087000 DISP-INIT-GF-12. NC1094.2 +087100 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +087200 MOVE "DISP-TEST-GF-12 " TO PAR-NAME. NC1094.2 +087300 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO TAB-VALUE. NC1094.2 +087400 DISP-TEST-GF-12. NC1094.2 +087500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +087600 DISPLAY XTAB (1) XTAB (2) XTAB (3) XTAB (4) NC1094.2 +087700 XTAB (5) XTAB (6) XTAB (7) XTAB (8) NC1094.2 +087800 XTAB (9) XTAB (10) XTAB (11) XTAB (12) NC1094.2 +087900 XTAB (13) XTAB (14) XTAB (15) XTAB (16) NC1094.2 +088000 XTAB (17) XTAB (18) XTAB (19) XTAB (20) NC1094.2 +088100 XTAB (21). NC1094.2 +088200* NOTE 21 SUBSCRIPTED DATA ITEMS. NC1094.2 +088300 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO DIS-PLAYER. NC1094.2 +088400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +088500 GO TO DISP-WRITE-GF-12. NC1094.2 +088600 DISP-DELETE-GF-12. NC1094.2 +088700 PERFORM DE-LETE. NC1094.2 +088800 DISP-WRITE-GF-12. NC1094.2 +088900 MOVE "DISP-TEST-GF-12 " TO PAR-NAME. NC1094.2 +089000 PERFORM PRINT-DETAIL. NC1094.2 +089100 DISP-INIT-GF-13. NC1094.2 +089200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +089300 MOVE "DISP-TEST-GF-13 " TO PAR-NAME. NC1094.2 +089400 DISP-TEST-GF-13. NC1094.2 +089500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +089600 DISPLAY "QUOTE " QUOTE " ASTERISK " "*" " NUMERIC LITERALS "NC1094.2 +089700 21 SPACE 35 I-DATA PIECE-A (1) PIECE-A (2) PIECE-ANC1094.2 +089800 (3) PIECE-A (4) PIECE-A (5) PIECE-N (1) PIECE-N (2) NC1094.2 +089900 PIECE-N (3) PIECE-N (4) PIECE-N (5) A1 A2. NC1094.2 +090000 MOVE "QUOTE ASTERISK * NUMERIC LITERALS 21 35 IDENTIFNC1094.2 +090100- "IER DATA A B C D E 0102030405 (TOTAL 21 OPERANDS) END OF DATNC1094.2 +090200- "A" TO DIS-PLAYER. NC1094.2 +090300* NOTE 21 MIXED IDENTIFIERS AND LITERALS. NC1094.2 +090400 MOVE QUOTE TO QUOTE-SLOT. NC1094.2 +090500 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +090600 GO TO DISP-WRITE-GF-13. NC1094.2 +090700 DISP-DELETE-GF-13. NC1094.2 +090800 PERFORM DE-LETE. NC1094.2 +090900 DISP-WRITE-GF-13. NC1094.2 +091000 MOVE "DISP-TEST-GF-13 " TO PAR-NAME. NC1094.2 +091100 PERFORM PRINT-DETAIL. NC1094.2 +091200 DISP-INIT-GF-14. NC1094.2 +091300* ===---> "ALL" LITERAL <--=== NC1094.2 +091400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +091500 MOVE "DISP-TEST-GF-14 GR3 " TO PAR-NAME. NC1094.2 +091600 DISP-TEST-GF-14. NC1094.2 +091700 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +091800 DISPLAY ALL "ABCD" NC1094.2 +091900* NOTE "ALL" LITERAL. NC1094.2 +092000 MOVE "ABCD" TO DIS-PLAYER. NC1094.2 +092100 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +092200 GO TO DISP-WRITE-GF-14. NC1094.2 +092300 DISP-DELETE-GF-14. NC1094.2 +092400 PERFORM DE-LETE. NC1094.2 +092500 DISP-WRITE-GF-14. NC1094.2 +092600 MOVE "DISP-TEST-GF-14 " TO PAR-NAME. NC1094.2 +092700 PERFORM PRINT-DETAIL. NC1094.2 +092800 GO TO CCVS-EXIT. NC1094.2 +092900 DISPLAY-SUPPORT-1. NC1094.2 +093000 PERFORM BLANK-LINE-PRINT. NC1094.2 +093100 MOVE SPACE TO P-OR-F. NC1094.2 +093200 MOVE SEE-BELOW TO COMPUTED-A. NC1094.2 +093300 MOVE SEE-BELOW TO CORRECT-A. NC1094.2 +093400 PERFORM PRINT-DETAIL. NC1094.2 +093500 MOVE SPACE TO FEATURE. NC1094.2 +093600 DISPLAY TEST-RESULTS. NC1094.2 +093700 DISPLAY-SUPPORT-2. NC1094.2 +093800 MOVE SPACE TO TEST-RESULTS. NC1094.2 +093900 DISPLAY TEST-RESULTS. NC1094.2 +094000 MOVE SPACE TO TEST-RESULTS. NC1094.2 +094100 PERFORM PRINT-DETAIL. NC1094.2 +094200 MOVE CORRECT-FOLLOWS TO RE-MARK. NC1094.2 +094300 PERFORM PRINT-DETAIL. NC1094.2 +094400 PERFORM BLANK-LINE-PRINT. NC1094.2 +094500 MOVE DISPLAY-WRITER TO TEST-RESULTS. NC1094.2 +094600 PERFORM PRINT-DETAIL. NC1094.2 +094700 IF DISPLAY-SWITCH EQUAL TO 1 NC1094.2 +094800 MOVE ZERO TO DISPLAY-SWITCH NC1094.2 +094900 MOVE DISPLAY-H TO DIS-PLAYER NC1094.2 +095000 MOVE DISPLAY-WRITER TO TEST-RESULTS NC1094.2 +095100 PERFORM PRINT-DETAIL. NC1094.2 +095200 MOVE SPACE TO TEST-RESULTS. NC1094.2 +095300 PERFORM BLANK-LINE-PRINT. NC1094.2 +095400 IF DISPLAY-SWITCH EQUAL TO 1 NC1094.2 +095500 MOVE "SEE NOTE IN DISP-TEST-GF-10" TO RE-MARK. NC1094.2 +095600 PERFORM PRINT-DETAIL. NC1094.2 +095700 MOVE "DISPLAY" TO FEATURE. NC1094.2 +095800 MOVE SEE-ABOVE TO COMPUTED-A. NC1094.2 +095900 MOVE SEE-ABOVE TO CORRECT-A. NC1094.2 +096000 MOVE END-CORRECT TO RE-MARK. NC1094.2 +096100 MOVE "ERRORS ENCOUNTERED" TO ENDER-DESC. NC1094.2 +096200 CCVS-EXIT SECTION. NC1094.2 +096300 CCVS-999999. NC1094.2 +096400 GO TO CLOSE-FILES. NC1094.2 +*END-OF,NC109M +*HEADER,DATA*,NC109M +ABCDEFGHIJKLMNOPQRSTUVWXY Z +0123456789 +().+-*/$, = +9 +0 + ABC XYZ +0123456789 + +" +ABCD +A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456789 +*END-OF,NC109M +*HEADER,COBOL,NC110M +000100 IDENTIFICATION DIVISION. NC1104.2 +000200 PROGRAM-ID. NC1104.2 +000300 NC110M. NC1104.2 +000400**************************************************************** NC1104.2 +000500* * NC1104.2 +000600* VALIDATION FOR:- * NC1104.2 +000700* * NC1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1104.2 +000900* * NC1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1104.2 +001100* * NC1104.2 +001200**************************************************************** NC1104.2 +001300* * NC1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1104.2 +001500* * NC1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1104.2 +001900* * NC1104.2 +002000**************************************************************** NC1104.2 +002100* NC1104.2 +002200* THE PROCEDURE DIVISION OF NC110M CONSISTS ENTIRELY OF NC1104.2 +002300* PARAGRAPH NAMES AND "DISPLAY" LITERAL STATEMENTS. NC1104.2 +002400* NC1104.2 +002500 ENVIRONMENT DIVISION. NC1104.2 +002600 CONFIGURATION SECTION. NC1104.2 +002700 SOURCE-COMPUTER. NC1104.2 +002800 XXXXX082. NC1104.2 +002900 OBJECT-COMPUTER. NC1104.2 +003000 XXXXX083. NC1104.2 +003100 DATA DIVISION. NC1104.2 +003200 PROCEDURE DIVISION. NC1104.2 +003300 HEADER-PRINT. NC1104.2 +003400 DISPLAY " ". NC1104.2 +003500 DISPLAY NC1104.2 +003600 " FOR OFFICIAL USE ONLY ".NC1104.2 +003700 DISPLAY NC1104.2 +003800 " OFFICIAL COBOL COMPILER TEST SYSTEM. ". NC1104.2 +003900 DISPLAY NC1104.2 +004000 " TEST RESULTS SET- NC110M ".NC1104.2 +004100 DISPLAY NC1104.2 +004200 " ".NC1104.2 +004300 DISPLAY NC1104.2 +004400 " FOR OFFICIAL USE ONLY " NC1104.2 +004500 " ". NC1104.2 +004600 DISPLAY NC1104.2 +004700 "COPYRIGHT 1985". NC1104.2 +004800 DISPLAY NC1104.2 +004900 " ".NC1104.2 +005000 DISPLAY NC1104.2 +005100 " FEATURE RESULTS AND ".NC1104.2 +005200 DISPLAY NC1104.2 +005300 " TESTED REMARKS ".NC1104.2 +005400 DISPLAY NC1104.2 +005500 " ".NC1104.2 +005600 DISPLAY NC1104.2 +005700 " ---------------------------------------------------------".NC1104.2 +005800 GO-TEST. NC1104.2 +005900 DISPLAY NC1104.2 +006000 " GO TO THIS TEST PASSES UNLESS FAIL APPEARS BELOW. ".NC1104.2 +006100 GO TO PERFORM-TEST. NC1104.2 +006200 GO-FAIL. NC1104.2 +006300 DISPLAY NC1104.2 +006400 " FAIL". NC1104.2 +006500 PERFORM-TEST. NC1104.2 +006600 DISPLAY NC1104.2 +006700 " PERFORM THIS TEST FAILS UNLESS PASS APPEARS BELOW. ".NC1104.2 +006800 PERFORM PASS. NC1104.2 +006900 ENDER-PRINT. NC1104.2 +007000 DISPLAY NC1104.2 +007100 " ---------------------------------------------------------".NC1104.2 +007200 DISPLAY NC1104.2 +007300 SPACE. NC1104.2 +007400 DISPLAY NC1104.2 +007500 " END OF TEST - NC110M ".NC1104.2 +007600 DISPLAY NC1104.2 +007700 " CHECK FOR ERRORS ".NC1104.2 +007800 DISPLAY NC1104.2 +007900 " ".NC1104.2 +008000 DISPLAY NC1104.2 +008100 " FOR OFFICIAL USE ONLY " NC1104.2 +008200 DISPLAY NC1104.2 +008300 "COPYRIGHT 1985". NC1104.2 +008400 DISPLAY NC1104.2 +008500 " NTIS DISTRIBUTION COBOL 1985 ". NC1104.2 +008600 STOP RUN. NC1104.2 +008700 PASS. NC1104.2 +008800 DISPLAY NC1104.2 +008900 " PASS". NC1104.2 +*END-OF,NC110M +*HEADER,COBOL,NC111A +000100 IDENTIFICATION DIVISION. NC1114.2 +000200 PROGRAM-ID. NC1114.2 +000300 NC111A. NC1114.2 +000400**************************************************************** NC1114.2 +000500* * NC1114.2 +000600* VALIDATION FOR:- * NC1114.2 +000700* * NC1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +000900* * NC1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1114.2 +001100* * NC1114.2 +001200**************************************************************** NC1114.2 +001300* * NC1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1114.2 +001500* * NC1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1114.2 +001900* * NC1114.2 +002000**************************************************************** NC1114.2 +002100* NC1114.2 +002200* PROGRAM NC111A TESTS THE TRUNCATION OF RESULTANT IDENTIFIERS NC1114.2 +002300* USING ADD SUBTRACT AND MULTIPLY STATEMENTS. NC1114.2 +002400* NC1114.2 +002500* NC1114.2 +002600 NC1114.2 +002700 ENVIRONMENT DIVISION. NC1114.2 +002800 CONFIGURATION SECTION. NC1114.2 +002900 SOURCE-COMPUTER. NC1114.2 +003000 XXXXX082. NC1114.2 +003100 OBJECT-COMPUTER. NC1114.2 +003200 XXXXX083. NC1114.2 +003300 INPUT-OUTPUT SECTION. NC1114.2 +003400 FILE-CONTROL. NC1114.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1114.2 +003600 XXXXX055. NC1114.2 +003700 DATA DIVISION. NC1114.2 +003800 FILE SECTION. NC1114.2 +003900 FD PRINT-FILE. NC1114.2 +004000 01 PRINT-REC PICTURE X(120). NC1114.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1114.2 +004200 WORKING-STORAGE SECTION. NC1114.2 +004300 01 N-11 PICTURE IS 9 VALUE IS 9. NC1114.2 +004400 01 N-12 PICTURE IS 9 VALUE IS 9. NC1114.2 +004500 01 N-40 PICTURE IS 9(7) NC1114.2 +004600 VALUE IS 7777777. NC1114.2 +004700 01 N-41 PICTURE IS 9(7) NC1114.2 +004800 VALUE IS 1111111. NC1114.2 +004900 01 N-42 PICTURE IS 9(3)P(4). NC1114.2 +005000 01 TRUNC-DATA. NC1114.2 +005100 02 N-43 PICTURE S9V9 VALUE +1.6. NC1114.2 +005200 02 N-44 PICTURE S9V9 VALUE -1.6. NC1114.2 +005300 02 N-45 PICTURE S9. NC1114.2 +005400 01 TEST-RESULTS. NC1114.2 +005500 02 FILLER PIC X VALUE SPACE. NC1114.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. NC1114.2 +005700 02 FILLER PIC X VALUE SPACE. NC1114.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. NC1114.2 +005900 02 FILLER PIC X VALUE SPACE. NC1114.2 +006000 02 PAR-NAME. NC1114.2 +006100 03 FILLER PIC X(19) VALUE SPACE. NC1114.2 +006200 03 PARDOT-X PIC X VALUE SPACE. NC1114.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. NC1114.2 +006400 02 FILLER PIC X(8) VALUE SPACE. NC1114.2 +006500 02 RE-MARK PIC X(61). NC1114.2 +006600 01 TEST-COMPUTED. NC1114.2 +006700 02 FILLER PIC X(30) VALUE SPACE. NC1114.2 +006800 02 FILLER PIC X(17) VALUE NC1114.2 +006900 " COMPUTED=". NC1114.2 +007000 02 COMPUTED-X. NC1114.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1114.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A NC1114.2 +007300 PIC -9(9).9(9). NC1114.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1114.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1114.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1114.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. NC1114.2 +007800 04 COMPUTED-18V0 PIC -9(18). NC1114.2 +007900 04 FILLER PIC X. NC1114.2 +008000 03 FILLER PIC X(50) VALUE SPACE. NC1114.2 +008100 01 TEST-CORRECT. NC1114.2 +008200 02 FILLER PIC X(30) VALUE SPACE. NC1114.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1114.2 +008400 02 CORRECT-X. NC1114.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1114.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1114.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1114.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1114.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1114.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. NC1114.2 +009100 04 CORRECT-18V0 PIC -9(18). NC1114.2 +009200 04 FILLER PIC X. NC1114.2 +009300 03 FILLER PIC X(2) VALUE SPACE. NC1114.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1114.2 +009500 01 CCVS-C-1. NC1114.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1114.2 +009700- "SS PARAGRAPH-NAME NC1114.2 +009800- " REMARKS". NC1114.2 +009900 02 FILLER PIC X(20) VALUE SPACE. NC1114.2 +010000 01 CCVS-C-2. NC1114.2 +010100 02 FILLER PIC X VALUE SPACE. NC1114.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". NC1114.2 +010300 02 FILLER PIC X(15) VALUE SPACE. NC1114.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". NC1114.2 +010500 02 FILLER PIC X(94) VALUE SPACE. NC1114.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1114.2 +010700 01 REC-CT PIC 99 VALUE ZERO. NC1114.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1114.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1114.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1114.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1114.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1114.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1114.2 +011700 01 CCVS-H-1. NC1114.2 +011800 02 FILLER PIC X(39) VALUE SPACES. NC1114.2 +011900 02 FILLER PIC X(42) VALUE NC1114.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1114.2 +012100 02 FILLER PIC X(39) VALUE SPACES. NC1114.2 +012200 01 CCVS-H-2A. NC1114.2 +012300 02 FILLER PIC X(40) VALUE SPACE. NC1114.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1114.2 +012500 02 FILLER PIC XXXX VALUE NC1114.2 +012600 "4.2 ". NC1114.2 +012700 02 FILLER PIC X(28) VALUE NC1114.2 +012800 " COPY - NOT FOR DISTRIBUTION". NC1114.2 +012900 02 FILLER PIC X(41) VALUE SPACE. NC1114.2 +013000 NC1114.2 +013100 01 CCVS-H-2B. NC1114.2 +013200 02 FILLER PIC X(15) VALUE NC1114.2 +013300 "TEST RESULT OF ". NC1114.2 +013400 02 TEST-ID PIC X(9). NC1114.2 +013500 02 FILLER PIC X(4) VALUE NC1114.2 +013600 " IN ". NC1114.2 +013700 02 FILLER PIC X(12) VALUE NC1114.2 +013800 " HIGH ". NC1114.2 +013900 02 FILLER PIC X(22) VALUE NC1114.2 +014000 " LEVEL VALIDATION FOR ". NC1114.2 +014100 02 FILLER PIC X(58) VALUE NC1114.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +014300 01 CCVS-H-3. NC1114.2 +014400 02 FILLER PIC X(34) VALUE NC1114.2 +014500 " FOR OFFICIAL USE ONLY ". NC1114.2 +014600 02 FILLER PIC X(58) VALUE NC1114.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1114.2 +014800 02 FILLER PIC X(28) VALUE NC1114.2 +014900 " COPYRIGHT 1985 ". NC1114.2 +015000 01 CCVS-E-1. NC1114.2 +015100 02 FILLER PIC X(52) VALUE SPACE. NC1114.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1114.2 +015300 02 ID-AGAIN PIC X(9). NC1114.2 +015400 02 FILLER PIC X(45) VALUE SPACES. NC1114.2 +015500 01 CCVS-E-2. NC1114.2 +015600 02 FILLER PIC X(31) VALUE SPACE. NC1114.2 +015700 02 FILLER PIC X(21) VALUE SPACE. NC1114.2 +015800 02 CCVS-E-2-2. NC1114.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1114.2 +016000 03 FILLER PIC X VALUE SPACE. NC1114.2 +016100 03 ENDER-DESC PIC X(44) VALUE NC1114.2 +016200 "ERRORS ENCOUNTERED". NC1114.2 +016300 01 CCVS-E-3. NC1114.2 +016400 02 FILLER PIC X(22) VALUE NC1114.2 +016500 " FOR OFFICIAL USE ONLY". NC1114.2 +016600 02 FILLER PIC X(12) VALUE SPACE. NC1114.2 +016700 02 FILLER PIC X(58) VALUE NC1114.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +016900 02 FILLER PIC X(13) VALUE SPACE. NC1114.2 +017000 02 FILLER PIC X(15) VALUE NC1114.2 +017100 " COPYRIGHT 1985". NC1114.2 +017200 01 CCVS-E-4. NC1114.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1114.2 +017400 02 FILLER PIC X(4) VALUE " OF ". NC1114.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1114.2 +017600 02 FILLER PIC X(40) VALUE NC1114.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1114.2 +017800 01 XXINFO. NC1114.2 +017900 02 FILLER PIC X(19) VALUE NC1114.2 +018000 "*** INFORMATION ***". NC1114.2 +018100 02 INFO-TEXT. NC1114.2 +018200 04 FILLER PIC X(8) VALUE SPACE. NC1114.2 +018300 04 XXCOMPUTED PIC X(20). NC1114.2 +018400 04 FILLER PIC X(5) VALUE SPACE. NC1114.2 +018500 04 XXCORRECT PIC X(20). NC1114.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). NC1114.2 +018700 01 HYPHEN-LINE. NC1114.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. NC1114.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************NC1114.2 +019000- "*****************************************". NC1114.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************NC1114.2 +019200- "******************************". NC1114.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE NC1114.2 +019400 "NC111A". NC1114.2 +019500 PROCEDURE DIVISION. NC1114.2 +019600 CCVS1 SECTION. NC1114.2 +019700 OPEN-FILES. NC1114.2 +019800 OPEN OUTPUT PRINT-FILE. NC1114.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1114.2 +020000 MOVE SPACE TO TEST-RESULTS. NC1114.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1114.2 +020200 GO TO CCVS1-EXIT. NC1114.2 +020300 CLOSE-FILES. NC1114.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1114.2 +020500 TERMINATE-CCVS. NC1114.2 +020600S EXIT PROGRAM. NC1114.2 +020700STERMINATE-CALL. NC1114.2 +020800 STOP RUN. NC1114.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1114.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1114.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1114.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1114.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. NC1114.2 +021400 PRINT-DETAIL. NC1114.2 +021500 IF REC-CT NOT EQUAL TO ZERO NC1114.2 +021600 MOVE "." TO PARDOT-X NC1114.2 +021700 MOVE REC-CT TO DOTVALUE. NC1114.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1114.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1114.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1114.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1114.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1114.2 +022300 MOVE SPACE TO CORRECT-X. NC1114.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1114.2 +022500 MOVE SPACE TO RE-MARK. NC1114.2 +022600 HEAD-ROUTINE. NC1114.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1114.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1114.2 +023100 COLUMN-NAMES-ROUTINE. NC1114.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +023500 END-ROUTINE. NC1114.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1114.2 +023700 END-RTN-EXIT. NC1114.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +023900 END-ROUTINE-1. NC1114.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1114.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1114.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. NC1114.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1114.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1114.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1114.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1114.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1114.2 +024800 END-ROUTINE-12. NC1114.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1114.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1114.2 +025100 MOVE "NO " TO ERROR-TOTAL NC1114.2 +025200 ELSE NC1114.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1114.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1114.2 +025500 PERFORM WRITE-LINE. NC1114.2 +025600 END-ROUTINE-13. NC1114.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1114.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE NC1114.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1114.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1114.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO NC1114.2 +026300 MOVE "NO " TO ERROR-TOTAL NC1114.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1114.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1114.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026800 WRITE-LINE. NC1114.2 +026900 ADD 1 TO RECORD-COUNT. NC1114.2 +027000Y IF RECORD-COUNT GREATER 42 NC1114.2 +027100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1114.2 +027200Y MOVE SPACE TO DUMMY-RECORD NC1114.2 +027300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1114.2 +027400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1114.2 +027500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1114.2 +027600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1114.2 +027700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1114.2 +027800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +027900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +028000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +028100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1114.2 +028200Y MOVE ZERO TO RECORD-COUNT. NC1114.2 +028300 PERFORM WRT-LN. NC1114.2 +028400 WRT-LN. NC1114.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1114.2 +028600 MOVE SPACE TO DUMMY-RECORD. NC1114.2 +028700 BLANK-LINE-PRINT. NC1114.2 +028800 PERFORM WRT-LN. NC1114.2 +028900 FAIL-ROUTINE. NC1114.2 +029000 IF COMPUTED-X NOT EQUAL TO SPACE NC1114.2 +029100 GO TO FAIL-ROUTINE-WRITE. NC1114.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1114.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1114.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1114.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1114.2 +029700 GO TO FAIL-ROUTINE-EX. NC1114.2 +029800 FAIL-ROUTINE-WRITE. NC1114.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1114.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1114.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1114.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1114.2 +030300 FAIL-ROUTINE-EX. EXIT. NC1114.2 +030400 BAIL-OUT. NC1114.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1114.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1114.2 +030700 BAIL-OUT-WRITE. NC1114.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1114.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1114.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1114.2 +031200 BAIL-OUT-EX. EXIT. NC1114.2 +031300 CCVS1-EXIT. NC1114.2 +031400 EXIT. NC1114.2 +031500 SECT-NC111A-001 SECTION. NC1114.2 +031600 BLURB-REMARK. NC1114.2 +031700 MOVE SPACE TO TEST-RESULTS. NC1114.2 +031800 MOVE "THE FOLLOWING 3 TESTS TEST " TO RE-MARK. NC1114.2 +031900 PERFORM PRINT-DETAIL. NC1114.2 +032000 MOVE "SOME SPECIFIC FEATURES OF " TO RE-MARK. NC1114.2 +032100 PERFORM PRINT-DETAIL. NC1114.2 +032200 MOVE "THE TRUNCATION, ROUNDED AND" TO RE-MARK. NC1114.2 +032300 PERFORM PRINT-DETAIL. NC1114.2 +032400 MOVE "SIZE ERROR OPTIONS. GENERAL" TO RE-MARK. NC1114.2 +032500 PERFORM PRINT-DETAIL. NC1114.2 +032600 MOVE "FEATURES OF THESE OPTIONS " TO RE-MARK. NC1114.2 +032700 PERFORM PRINT-DETAIL. NC1114.2 +032800 MOVE "ARE TESTED IN THE ADD, SUB-" TO RE-MARK. NC1114.2 +032900 PERFORM PRINT-DETAIL. NC1114.2 +033000 MOVE "TRACT, MULTIPLY, AND DIVIDE" TO RE-MARK. NC1114.2 +033100 PERFORM PRINT-DETAIL. NC1114.2 +033200 MOVE "TESTS. " TO RE-MARK. NC1114.2 +033300 PERFORM PRINT-DETAIL. NC1114.2 +033400 TRU-INIT-GF-1. NC1114.2 +033500 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +033600 MOVE 7777777 TO N-40. NC1114.2 +033700 MOVE 1111111 TO N-41. NC1114.2 +033800 TRU-TEST-GF-1-0. NC1114.2 +033900 ADD N-40 N-41 GIVING N-42. NC1114.2 +034000 TRU-TEST-GF-1-1. NC1114.2 +034100 IF N-42 EQUAL TO 8880000 NC1114.2 +034200 PERFORM PASS NC1114.2 +034300 GO TO TRU-WRITE-GF-1. NC1114.2 +034400 GO TO TRU-FAIL-GF-1. NC1114.2 +034500 TRU-DELETE-GF-1. NC1114.2 +034600 PERFORM DE-LETE. NC1114.2 +034700 GO TO TRU-WRITE-GF-1. NC1114.2 +034800 TRU-FAIL-GF-1. NC1114.2 +034900 MOVE N-42 TO COMPUTED-N. NC1114.2 +035000 MOVE 8880000 TO CORRECT-N. NC1114.2 +035100 PERFORM FAIL. NC1114.2 +035200 TRU-WRITE-GF-1. NC1114.2 +035300 MOVE "TRUNCATION" TO FEATURE. NC1114.2 +035400 MOVE "TRU-TEST-GF-1" TO PAR-NAME. NC1114.2 +035500 PERFORM PRINT-DETAIL. NC1114.2 +035600 TRU-INIT-GF-2. NC1114.2 +035700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +035800 MOVE ZERO TO N-45. NC1114.2 +035900 MOVE +1.6 TO N-43. NC1114.2 +036000 TRU-TEST-GF-2-0. NC1114.2 +036100 ADD N-43 1.4 GIVING N-45. NC1114.2 +036200 TRU-TEST-GF-2-1. NC1114.2 +036300 IF N-45 EQUAL TO +3 NC1114.2 +036400 PERFORM PASS GO TO TRU-WRITE-GF-2. NC1114.2 +036500 GO TO TRU-FAIL-GF-2. NC1114.2 +036600 TRU-DELETE-GF-2. NC1114.2 +036700 PERFORM DE-LETE. NC1114.2 +036800 GO TO TRU-WRITE-GF-2. NC1114.2 +036900 TRU-FAIL-GF-2. NC1114.2 +037000 PERFORM FAIL. NC1114.2 +037100 MOVE N-45 TO COMPUTED-N. NC1114.2 +037200 MOVE 3 TO CORRECT-N. NC1114.2 +037300 TRU-WRITE-GF-2. NC1114.2 +037400 MOVE "TRU-TEST-GF-2 " TO PAR-NAME. NC1114.2 +037500 PERFORM PRINT-DETAIL. NC1114.2 +037600 TRU-INIT-GF-3. NC1114.2 +037700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +037800 MOVE ZERO TO N-45. NC1114.2 +037900 MOVE -1.6 TO N-44. NC1114.2 +038000 TRU-TEST-GF-3-0. NC1114.2 +038100 ADD N-44 -1.4 GIVING N-45. NC1114.2 +038200 TRU-TEST-GF-3-1. NC1114.2 +038300 IF N-45 EQUAL TO -3 NC1114.2 +038400 PERFORM PASS GO TO TRU-WRITE-GF-3. NC1114.2 +038500 GO TO TRU-FAIL-GF-3. NC1114.2 +038600 TRU-DELETE-GF-3. NC1114.2 +038700 PERFORM DE-LETE. NC1114.2 +038800 GO TO TRU-WRITE-GF-3. NC1114.2 +038900 TRU-FAIL-GF-3. NC1114.2 +039000 PERFORM FAIL. NC1114.2 +039100 MOVE N-45 TO COMPUTED-N. NC1114.2 +039200 MOVE -3 TO CORRECT-N. NC1114.2 +039300 TRU-WRITE-GF-3. NC1114.2 +039400 MOVE "TRU-TEST-GF-3 " TO PAR-NAME. NC1114.2 +039500 PERFORM PRINT-DETAIL. NC1114.2 +039600 TRU-INIT-GF-4. NC1114.2 +039700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +039800 MOVE ZERO TO N-45. NC1114.2 +039900 MOVE +1.6 TO N-43. NC1114.2 +040000 TRU-TEST-GF-4-0. NC1114.2 +040100 MULTIPLY 5 BY N-43 GIVING N-45. NC1114.2 +040200 TRU-TEST-GF-4-1. NC1114.2 +040300 IF N-45 EQUAL TO +8 NC1114.2 +040400 PERFORM PASS GO TO TRU-WRITE-GF-4. NC1114.2 +040500 GO TO TRU-FAIL-GF-4. NC1114.2 +040600 TRU-DELETE-GF-4. NC1114.2 +040700 PERFORM DE-LETE. NC1114.2 +040800 GO TO TRU-WRITE-GF-4. NC1114.2 +040900 TRU-FAIL-GF-4. NC1114.2 +041000 PERFORM FAIL. NC1114.2 +041100 MOVE N-45 TO COMPUTED-N. NC1114.2 +041200 MOVE 8 TO CORRECT-N. NC1114.2 +041300 TRU-WRITE-GF-4. NC1114.2 +041400 MOVE "TRU-TEST-GF-4 " TO PAR-NAME. NC1114.2 +041500 PERFORM PRINT-DETAIL. NC1114.2 +041600 TRU-INIT-GF-5. NC1114.2 +041700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +041800 MOVE ZERO TO N-45. NC1114.2 +041900 MOVE -1.6 TO N-44. NC1114.2 +042000 TRU-TEST-GF-5-0. NC1114.2 +042100 MULTIPLY 5 BY N-44 GIVING N-45. NC1114.2 +042200 TRU-TEST-GF-5-1. NC1114.2 +042300 IF N-45 EQUAL TO -8 NC1114.2 +042400 PERFORM PASS GO TO TRU-WRITE-GF-5. NC1114.2 +042500 GO TO TRU-FAIL-GF-5. NC1114.2 +042600 TRU-DELETE-GF-5. NC1114.2 +042700 PERFORM DE-LETE. NC1114.2 +042800 GO TO TRU-WRITE-GF-5. NC1114.2 +042900 TRU-FAIL-GF-5. NC1114.2 +043000 PERFORM FAIL. NC1114.2 +043100 MOVE N-45 TO COMPUTED-N. NC1114.2 +043200 MOVE -8 TO CORRECT-N. NC1114.2 +043300 TRU-WRITE-GF-5. NC1114.2 +043400 MOVE "TRU-TEST-GF-5 " TO PAR-NAME. NC1114.2 +043500 PERFORM PRINT-DETAIL. NC1114.2 +043600 TRU-INIT-GF-6. NC1114.2 +043700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +043800 MOVE ZERO TO N-45. NC1114.2 +043900 MOVE +1.6 TO N-43. NC1114.2 +044000 TRU-TEST-GF-6-0. NC1114.2 +044100 SUBTRACT -1.4 FROM N-43 GIVING N-45. NC1114.2 +044200 TRU-TEST-GF-6-1. NC1114.2 +044300 IF N-45 EQUAL TO +3 NC1114.2 +044400 PERFORM PASS GO TO TRU-WRITE-GF-6. NC1114.2 +044500 GO TO TRU-FAIL-GF-6. NC1114.2 +044600 TRU-DELETE-GF-6. NC1114.2 +044700 PERFORM DE-LETE. NC1114.2 +044800 GO TO TRU-WRITE-GF-6. NC1114.2 +044900 TRU-FAIL-GF-6. NC1114.2 +045000 PERFORM FAIL. NC1114.2 +045100 MOVE N-45 TO COMPUTED-N. NC1114.2 +045200 MOVE 3 TO CORRECT-N. NC1114.2 +045300 TRU-WRITE-GF-6. NC1114.2 +045400 MOVE "TRU-TEST-GF-6 " TO PAR-NAME. NC1114.2 +045500 PERFORM PRINT-DETAIL. NC1114.2 +045600 TRU-INIT-GF-7. NC1114.2 +045700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +045800 MOVE ZERO TO N-45. NC1114.2 +045900 MOVE -1.6 TO N-44. NC1114.2 +046000 TRU-TEST-GF-7-0. NC1114.2 +046100 SUBTRACT +1.4 FROM N-44 GIVING N-45. NC1114.2 +046200 TRU-TEST-GF-7-1. NC1114.2 +046300 IF N-45 EQUAL TO -3 NC1114.2 +046400 PERFORM PASS GO TO TRU-WRITE-GF-7. NC1114.2 +046500 GO TO TRU-FAIL-GF-7. NC1114.2 +046600 TRU-DELETE-GF-7. NC1114.2 +046700 PERFORM DE-LETE. NC1114.2 +046800 GO TO TRU-WRITE-GF-7. NC1114.2 +046900 TRU-FAIL-GF-7. NC1114.2 +047000 PERFORM FAIL. NC1114.2 +047100 MOVE N-45 TO COMPUTED-N. NC1114.2 +047200 MOVE -3 TO CORRECT-N. NC1114.2 +047300 TRU-WRITE-GF-7. NC1114.2 +047400 MOVE "TRU-TEST-GF-7 " TO PAR-NAME. NC1114.2 +047500 PERFORM PRINT-DETAIL. NC1114.2 +047600 CCVS-EXIT SECTION. NC1114.2 +047700 CCVS-999999. NC1114.2 +047800 GO TO CLOSE-FILES. NC1114.2 +*END-OF,NC111A +*HEADER,COBOL,NC112A +000100 IDENTIFICATION DIVISION. NC1124.2 +000200 PROGRAM-ID. NC1124.2 +000300 NC112A. NC1124.2 +000400**************************************************************** NC1124.2 +000500* * NC1124.2 +000600* VALIDATION FOR:- * NC1124.2 +000700* * NC1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +000900* * NC1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1124.2 +001100* * NC1124.2 +001200**************************************************************** NC1124.2 +001300* * NC1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1124.2 +001500* * NC1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1124.2 +001900* * NC1124.2 +002000**************************************************************** NC1124.2 +002100* NC1124.2 +002200* PROGRAM NC112A TESTS THE USE OF MULTIPLE OPERANDS WITH NC1124.2 +002300* THE ADD, SUBTRACT AND MOVE STATEMENTS. NC1124.2 +002400* NC1124.2 +002500 ENVIRONMENT DIVISION. NC1124.2 +002600 CONFIGURATION SECTION. NC1124.2 +002700 SOURCE-COMPUTER. NC1124.2 +002800 XXXXX082. NC1124.2 +002900 OBJECT-COMPUTER. NC1124.2 +003000 XXXXX083. NC1124.2 +003100 INPUT-OUTPUT SECTION. NC1124.2 +003200 FILE-CONTROL. NC1124.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1124.2 +003400 XXXXX055. NC1124.2 +003500 DATA DIVISION. NC1124.2 +003600 FILE SECTION. NC1124.2 +003700 FD PRINT-FILE. NC1124.2 +003800 01 PRINT-REC PICTURE X(120). NC1124.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1124.2 +004000 WORKING-STORAGE SECTION. NC1124.2 +004100 77 ACCUM-1 PICTURE 9(17) VALUE ZERO. NC1124.2 +004200 77 ACCUM-2 PICTURE 9(18) VALUE ZERO. NC1124.2 +004300 77 ACCUM-3 PICTURE 9V9(3) VALUE 1. NC1124.2 +004400 77 ACCUM-4 PICTURE 9V9(3) VALUE ZERO. NC1124.2 +004500 01 D-NAMES. NC1124.2 +004600 02 DNAME-1 PICTURE 9 VALUE 1. NC1124.2 +004700 02 DNAME-2 PICTURE 9(3) VALUE 1. NC1124.2 +004800 02 DNAME-3 PICTURE 9(5) VALUE 1. NC1124.2 +004900 02 DNAME-4 PICTURE 9(7) VALUE 1. NC1124.2 +005000 02 DNAME-5 PICTURE 9(9) VALUE 1. NC1124.2 +005100 02 DNAME-6 PICTURE 9(11) VALUE 1. NC1124.2 +005200 02 DNAME-7 PICTURE 9(13) VALUE 1. NC1124.2 +005300 02 DNAME-8 PICTURE 9(15) VALUE 1. NC1124.2 +005400 02 DNAME-9 PICTURE 9(17) VALUE 1. NC1124.2 +005500 02 DNAME-10 PICTURE 9(18) VALUE 1. NC1124.2 +005600 01 TEST-RESULTS. NC1124.2 +005700 02 FILLER PIC X VALUE SPACE. NC1124.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC1124.2 +005900 02 FILLER PIC X VALUE SPACE. NC1124.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC1124.2 +006100 02 FILLER PIC X VALUE SPACE. NC1124.2 +006200 02 PAR-NAME. NC1124.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC1124.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC1124.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC1124.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC1124.2 +006700 02 RE-MARK PIC X(61). NC1124.2 +006800 01 TEST-COMPUTED. NC1124.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1124.2 +007000 02 FILLER PIC X(17) VALUE NC1124.2 +007100 " COMPUTED=". NC1124.2 +007200 02 COMPUTED-X. NC1124.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1124.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC1124.2 +007500 PIC -9(9).9(9). NC1124.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1124.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1124.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1124.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC1124.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC1124.2 +008100 04 FILLER PIC X. NC1124.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC1124.2 +008300 01 TEST-CORRECT. NC1124.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1124.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1124.2 +008600 02 CORRECT-X. NC1124.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1124.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1124.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1124.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1124.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1124.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC1124.2 +009300 04 CORRECT-18V0 PIC -9(18). NC1124.2 +009400 04 FILLER PIC X. NC1124.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC1124.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1124.2 +009700 01 CCVS-C-1. NC1124.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1124.2 +009900- "SS PARAGRAPH-NAME NC1124.2 +010000- " REMARKS". NC1124.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC1124.2 +010200 01 CCVS-C-2. NC1124.2 +010300 02 FILLER PIC X VALUE SPACE. NC1124.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC1124.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC1124.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC1124.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC1124.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1124.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC1124.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1124.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1124.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1124.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1124.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1124.2 +011900 01 CCVS-H-1. NC1124.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC1124.2 +012100 02 FILLER PIC X(42) VALUE NC1124.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1124.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC1124.2 +012400 01 CCVS-H-2A. NC1124.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC1124.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1124.2 +012700 02 FILLER PIC XXXX VALUE NC1124.2 +012800 "4.2 ". NC1124.2 +012900 02 FILLER PIC X(28) VALUE NC1124.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC1124.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC1124.2 +013200 NC1124.2 +013300 01 CCVS-H-2B. NC1124.2 +013400 02 FILLER PIC X(15) VALUE NC1124.2 +013500 "TEST RESULT OF ". NC1124.2 +013600 02 TEST-ID PIC X(9). NC1124.2 +013700 02 FILLER PIC X(4) VALUE NC1124.2 +013800 " IN ". NC1124.2 +013900 02 FILLER PIC X(12) VALUE NC1124.2 +014000 " HIGH ". NC1124.2 +014100 02 FILLER PIC X(22) VALUE NC1124.2 +014200 " LEVEL VALIDATION FOR ". NC1124.2 +014300 02 FILLER PIC X(58) VALUE NC1124.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +014500 01 CCVS-H-3. NC1124.2 +014600 02 FILLER PIC X(34) VALUE NC1124.2 +014700 " FOR OFFICIAL USE ONLY ". NC1124.2 +014800 02 FILLER PIC X(58) VALUE NC1124.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1124.2 +015000 02 FILLER PIC X(28) VALUE NC1124.2 +015100 " COPYRIGHT 1985 ". NC1124.2 +015200 01 CCVS-E-1. NC1124.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC1124.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1124.2 +015500 02 ID-AGAIN PIC X(9). NC1124.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC1124.2 +015700 01 CCVS-E-2. NC1124.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC1124.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC1124.2 +016000 02 CCVS-E-2-2. NC1124.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1124.2 +016200 03 FILLER PIC X VALUE SPACE. NC1124.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC1124.2 +016400 "ERRORS ENCOUNTERED". NC1124.2 +016500 01 CCVS-E-3. NC1124.2 +016600 02 FILLER PIC X(22) VALUE NC1124.2 +016700 " FOR OFFICIAL USE ONLY". NC1124.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC1124.2 +016900 02 FILLER PIC X(58) VALUE NC1124.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC1124.2 +017200 02 FILLER PIC X(15) VALUE NC1124.2 +017300 " COPYRIGHT 1985". NC1124.2 +017400 01 CCVS-E-4. NC1124.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1124.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC1124.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1124.2 +017800 02 FILLER PIC X(40) VALUE NC1124.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1124.2 +018000 01 XXINFO. NC1124.2 +018100 02 FILLER PIC X(19) VALUE NC1124.2 +018200 "*** INFORMATION ***". NC1124.2 +018300 02 INFO-TEXT. NC1124.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC1124.2 +018500 04 XXCOMPUTED PIC X(20). NC1124.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC1124.2 +018700 04 XXCORRECT PIC X(20). NC1124.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC1124.2 +018900 01 HYPHEN-LINE. NC1124.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC1124.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC1124.2 +019200- "*****************************************". NC1124.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC1124.2 +019400- "******************************". NC1124.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC1124.2 +019600 "NC112A". NC1124.2 +019700 PROCEDURE DIVISION. NC1124.2 +019800 CCVS1 SECTION. NC1124.2 +019900 OPEN-FILES. NC1124.2 +020000 OPEN OUTPUT PRINT-FILE. NC1124.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1124.2 +020200 MOVE SPACE TO TEST-RESULTS. NC1124.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1124.2 +020400 GO TO CCVS1-EXIT. NC1124.2 +020500 CLOSE-FILES. NC1124.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1124.2 +020700 TERMINATE-CCVS. NC1124.2 +020800S EXIT PROGRAM. NC1124.2 +020900STERMINATE-CALL. NC1124.2 +021000 STOP RUN. NC1124.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1124.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1124.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1124.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1124.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC1124.2 +021600 PRINT-DETAIL. NC1124.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC1124.2 +021800 MOVE "." TO PARDOT-X NC1124.2 +021900 MOVE REC-CT TO DOTVALUE. NC1124.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1124.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1124.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1124.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1124.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1124.2 +022500 MOVE SPACE TO CORRECT-X. NC1124.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1124.2 +022700 MOVE SPACE TO RE-MARK. NC1124.2 +022800 HEAD-ROUTINE. NC1124.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1124.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1124.2 +023300 COLUMN-NAMES-ROUTINE. NC1124.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +023700 END-ROUTINE. NC1124.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1124.2 +023900 END-RTN-EXIT. NC1124.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +024100 END-ROUTINE-1. NC1124.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1124.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1124.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC1124.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1124.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1124.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1124.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1124.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1124.2 +025000 END-ROUTINE-12. NC1124.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1124.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1124.2 +025300 MOVE "NO " TO ERROR-TOTAL NC1124.2 +025400 ELSE NC1124.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1124.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1124.2 +025700 PERFORM WRITE-LINE. NC1124.2 +025800 END-ROUTINE-13. NC1124.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1124.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE NC1124.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1124.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1124.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO NC1124.2 +026500 MOVE "NO " TO ERROR-TOTAL NC1124.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1124.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1124.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +027000 WRITE-LINE. NC1124.2 +027100 ADD 1 TO RECORD-COUNT. NC1124.2 +027200Y IF RECORD-COUNT GREATER 42 NC1124.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1124.2 +027400Y MOVE SPACE TO DUMMY-RECORD NC1124.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1124.2 +027600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1124.2 +027700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1124.2 +027800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1124.2 +027900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1124.2 +028000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1124.2 +028400Y MOVE ZERO TO RECORD-COUNT. NC1124.2 +028500 PERFORM WRT-LN. NC1124.2 +028600 WRT-LN. NC1124.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1124.2 +028800 MOVE SPACE TO DUMMY-RECORD. NC1124.2 +028900 BLANK-LINE-PRINT. NC1124.2 +029000 PERFORM WRT-LN. NC1124.2 +029100 FAIL-ROUTINE. NC1124.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE NC1124.2 +029300 GO TO FAIL-ROUTINE-WRITE. NC1124.2 +029400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1124.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1124.2 +029600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1124.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1124.2 +029900 GO TO FAIL-ROUTINE-EX. NC1124.2 +030000 FAIL-ROUTINE-WRITE. NC1124.2 +030100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1124.2 +030200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1124.2 +030300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1124.2 +030400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1124.2 +030500 FAIL-ROUTINE-EX. EXIT. NC1124.2 +030600 BAIL-OUT. NC1124.2 +030700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1124.2 +030800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1124.2 +030900 BAIL-OUT-WRITE. NC1124.2 +031000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1124.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1124.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1124.2 +031400 BAIL-OUT-EX. EXIT. NC1124.2 +031500 CCVS1-EXIT. NC1124.2 +031600 EXIT. NC1124.2 +031700 SECT-NC112A-001 SECTION. NC1124.2 +031800 ADD-INIT-F1-1. NC1124.2 +031900 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +032000 MOVE 0 TO ACCUM-1. NC1124.2 +032100 MOVE 1 TO DNAME-1. NC1124.2 +032200 MOVE 1 TO DNAME-2. NC1124.2 +032300 MOVE 1 TO DNAME-3. NC1124.2 +032400 MOVE 1 TO DNAME-4. NC1124.2 +032500 MOVE 1 TO DNAME-5. NC1124.2 +032600 MOVE 1 TO DNAME-6. NC1124.2 +032700 MOVE 1 TO DNAME-7. NC1124.2 +032800 MOVE 1 TO DNAME-8. NC1124.2 +032900 MOVE 1 TO DNAME-9. NC1124.2 +033000 MOVE 1 TO DNAME-10. NC1124.2 +033100 ADD-TEST-F1-1-0. NC1124.2 +033200 ADD DNAME-1 NC1124.2 +033300 DNAME-2 NC1124.2 +033400 DNAME-3 NC1124.2 +033500 DNAME-4 NC1124.2 +033600 DNAME-5 NC1124.2 +033700 DNAME-6 NC1124.2 +033800 DNAME-7 NC1124.2 +033900 DNAME-8 NC1124.2 +034000 DNAME-9 NC1124.2 +034100 DNAME-10 TO ACCUM-1. NC1124.2 +034200 ADD-TEST-F1-1-1. NC1124.2 +034300 IF ACCUM-1 EQUAL TO 10 NC1124.2 +034400 PERFORM PASS NC1124.2 +034500 GO TO ADD-WRITE-F1-1. NC1124.2 +034600 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +034700 MOVE 10 TO CORRECT-A. NC1124.2 +034800 PERFORM FAIL. NC1124.2 +034900 GO TO ADD-WRITE-F1-1. NC1124.2 +035000 ADD-DELETE-F1-1. NC1124.2 +035100 PERFORM DE-LETE. NC1124.2 +035200 ADD-WRITE-F1-1. NC1124.2 +035300 MOVE "ADD LIMITS TESTS" TO FEATURE. NC1124.2 +035400 MOVE "ADD-TEST-F1-1" TO PAR-NAME. NC1124.2 +035500 PERFORM PRINT-DETAIL. NC1124.2 +035600 ADD-INIT-F1-2. NC1124.2 +035700 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +035800 MOVE 0 TO ACCUM-1. NC1124.2 +035900 MOVE 1 TO DNAME-1. NC1124.2 +036000 MOVE 1 TO DNAME-2. NC1124.2 +036100 MOVE 1 TO DNAME-3. NC1124.2 +036200 MOVE 1 TO DNAME-4. NC1124.2 +036300 MOVE 1 TO DNAME-5. NC1124.2 +036400 MOVE 1 TO DNAME-6. NC1124.2 +036500 MOVE 1 TO DNAME-7. NC1124.2 +036600 MOVE 1 TO DNAME-8. NC1124.2 +036700 MOVE 1 TO DNAME-9. NC1124.2 +036800 MOVE 1 TO DNAME-10. NC1124.2 +036900 ADD-TEST-F1-2-0. NC1124.2 +037000 ADD DNAME-1 NC1124.2 +037100 DNAME-2 NC1124.2 +037200 DNAME-3 NC1124.2 +037300 DNAME-4 NC1124.2 +037400 DNAME-5 NC1124.2 +037500 DNAME-6 NC1124.2 +037600 DNAME-7 NC1124.2 +037700 DNAME-8 NC1124.2 +037800 DNAME-9 NC1124.2 +037900 DNAME-10 TO ACCUM-1 ROUNDED ON SIZE ERROR NC1124.2 +038000 MOVE 0 TO ACCUM-1. NC1124.2 +038100 ADD-TEST-F1-2-1. NC1124.2 +038200 IF ACCUM-1 EQUAL TO 10 NC1124.2 +038300 PERFORM PASS NC1124.2 +038400 GO TO ADD-WRITE-F1-2. NC1124.2 +038500 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +038600 MOVE 10 TO CORRECT-A. NC1124.2 +038700 PERFORM FAIL. NC1124.2 +038800 GO TO ADD-WRITE-F1-2. NC1124.2 +038900 ADD-DELETE-F1-2. NC1124.2 +039000 PERFORM DE-LETE. NC1124.2 +039100 ADD-WRITE-F1-2. NC1124.2 +039200 MOVE "ADD-TEST-F1-2" TO PAR-NAME. NC1124.2 +039300 PERFORM PRINT-DETAIL. NC1124.2 +039400 ADD-INIT-F2-1. NC1124.2 +039500 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +039600 MOVE 0 TO ACCUM-1. NC1124.2 +039700 MOVE 1 TO DNAME-1. NC1124.2 +039800 MOVE 1 TO DNAME-2. NC1124.2 +039900 MOVE 1 TO DNAME-3. NC1124.2 +040000 MOVE 1 TO DNAME-4. NC1124.2 +040100 MOVE 1 TO DNAME-5. NC1124.2 +040200 MOVE 1 TO DNAME-6. NC1124.2 +040300 MOVE 1 TO DNAME-7. NC1124.2 +040400 MOVE 1 TO DNAME-8. NC1124.2 +040500 MOVE 1 TO DNAME-9. NC1124.2 +040600 MOVE 1 TO DNAME-10. NC1124.2 +040700 ADD-TEST-F2-1-0. NC1124.2 +040800 ADD DNAME-1 NC1124.2 +040900 DNAME-2 NC1124.2 +041000 DNAME-3 NC1124.2 +041100 DNAME-4 NC1124.2 +041200 DNAME-5 NC1124.2 +041300 DNAME-6 NC1124.2 +041400 DNAME-7 NC1124.2 +041500 DNAME-8 NC1124.2 +041600 DNAME-9 NC1124.2 +041700 DNAME-10 GIVING ACCUM-1. NC1124.2 +041800 ADD-TEST-F2-1-1. NC1124.2 +041900 IF ACCUM-1 EQUAL TO 10 NC1124.2 +042000 PERFORM PASS NC1124.2 +042100 GO TO ADD-WRITE-F2-1. NC1124.2 +042200 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +042300 MOVE 10 TO CORRECT-A. NC1124.2 +042400 PERFORM FAIL. NC1124.2 +042500 GO TO ADD-WRITE-F2-1. NC1124.2 +042600 ADD-DELETE-F2-1. NC1124.2 +042700 PERFORM DE-LETE. NC1124.2 +042800 ADD-WRITE-F2-1. NC1124.2 +042900 MOVE "ADD-TEST-F2-1" TO PAR-NAME. NC1124.2 +043000 PERFORM PRINT-DETAIL. NC1124.2 +043100 ADD-INIT-F2-2. NC1124.2 +043200 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +043300 MOVE 1 TO ACCUM-1. NC1124.2 +043400 MOVE 1 TO DNAME-1. NC1124.2 +043500 MOVE 1 TO DNAME-2. NC1124.2 +043600 MOVE 1 TO DNAME-3. NC1124.2 +043700 MOVE 1 TO DNAME-4. NC1124.2 +043800 MOVE 1 TO DNAME-5. NC1124.2 +043900 MOVE 1 TO DNAME-6. NC1124.2 +044000 MOVE 1 TO DNAME-7. NC1124.2 +044100 MOVE 1 TO DNAME-8. NC1124.2 +044200 MOVE 1 TO DNAME-9. NC1124.2 +044300 MOVE 1 TO DNAME-10. NC1124.2 +044400 ADD-TEST-F2-2-0. NC1124.2 +044500 ADD DNAME-1 NC1124.2 +044600 DNAME-2 NC1124.2 +044700 DNAME-3 NC1124.2 +044800 DNAME-4 NC1124.2 +044900 DNAME-5 NC1124.2 +045000 DNAME-6 NC1124.2 +045100 DNAME-7 NC1124.2 +045200 DNAME-8 NC1124.2 +045300 DNAME-9 NC1124.2 +045400 DNAME-10 GIVING ACCUM-1 ROUNDED ON SIZE ERROR NC1124.2 +045500 MOVE 0 TO ACCUM-1. NC1124.2 +045600 ADD-TEST-F2-2-1. NC1124.2 +045700 IF ACCUM-1 EQUAL TO 10 NC1124.2 +045800 PERFORM PASS NC1124.2 +045900 GO TO ADD-WRITE-F2-2. NC1124.2 +046000 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +046100 MOVE 10 TO CORRECT-A. NC1124.2 +046200 PERFORM FAIL. NC1124.2 +046300 GO TO ADD-WRITE-F2-2. NC1124.2 +046400 ADD-DELETE-F2-2. NC1124.2 +046500 PERFORM DE-LETE. NC1124.2 +046600 ADD-WRITE-F2-2. NC1124.2 +046700 MOVE "ADD-TEST-F2-2" TO PAR-NAME. NC1124.2 +046800 PERFORM PRINT-DETAIL. NC1124.2 +046900 ADD-INIT-F1-3. NC1124.2 +047000 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +047100 MOVE 1 TO DNAME-1. NC1124.2 +047200 MOVE 1 TO DNAME-2. NC1124.2 +047300 MOVE 1 TO DNAME-3. NC1124.2 +047400 MOVE 1 TO DNAME-4. NC1124.2 +047500 MOVE 1 TO DNAME-5. NC1124.2 +047600 MOVE 1 TO DNAME-6. NC1124.2 +047700 MOVE 1 TO DNAME-7. NC1124.2 +047800 MOVE 1 TO DNAME-8. NC1124.2 +047900 MOVE 1 TO DNAME-9. NC1124.2 +048000 MOVE 1 TO DNAME-10. NC1124.2 +048100 ADD-TEST-F1-3-0. NC1124.2 +048200 ADD DNAME-2 NC1124.2 +048300 DNAME-3 NC1124.2 +048400 DNAME-4 NC1124.2 +048500 DNAME-5 NC1124.2 +048600 DNAME-6 NC1124.2 +048700 DNAME-7 NC1124.2 +048800 DNAME-8 NC1124.2 +048900 DNAME-9 NC1124.2 +049000 DNAME-10 TO DNAME-1 NC1124.2 +049100 ON SIZE ERROR NC1124.2 +049200 PERFORM PASS NC1124.2 +049300 GO TO ADD-WRITE-F1-3. NC1124.2 +049400 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +049500 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +049600 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +049700 PERFORM FAIL. NC1124.2 +049800 GO TO ADD-WRITE-F1-3. NC1124.2 +049900 ADD-DELETE-F1-3. NC1124.2 +050000 PERFORM DE-LETE. NC1124.2 +050100 ADD-WRITE-F1-3. NC1124.2 +050200 MOVE "ADD-TEST-F1-3" TO PAR-NAME. NC1124.2 +050300 PERFORM PRINT-DETAIL. NC1124.2 +050400 ADD-INIT-F2-3. NC1124.2 +050500 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +050600 MOVE 1 TO DNAME-1. NC1124.2 +050700 MOVE 1 TO DNAME-2. NC1124.2 +050800 MOVE 1 TO DNAME-3. NC1124.2 +050900 MOVE 1 TO DNAME-4. NC1124.2 +051000 MOVE 1 TO DNAME-5. NC1124.2 +051100 MOVE 1 TO DNAME-6. NC1124.2 +051200 MOVE 1 TO DNAME-7. NC1124.2 +051300 MOVE 1 TO DNAME-8. NC1124.2 +051400 MOVE 1 TO DNAME-9. NC1124.2 +051500 MOVE 1 TO DNAME-10. NC1124.2 +051600 ADD-TEST-F2-3-0. NC1124.2 +051700 ADD DNAME-1 NC1124.2 +051800 DNAME-2 NC1124.2 +051900 DNAME-3 NC1124.2 +052000 DNAME-4 NC1124.2 +052100 DNAME-5 NC1124.2 +052200 DNAME-6 NC1124.2 +052300 DNAME-7 NC1124.2 +052400 DNAME-8 NC1124.2 +052500 DNAME-9 NC1124.2 +052600 DNAME-10 GIVING DNAME-1 ON SIZE ERROR NC1124.2 +052700 PERFORM PASS NC1124.2 +052800 GO TO ADD-WRITE-F2-3. NC1124.2 +052900 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +053000 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +053100 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +053200 PERFORM FAIL. NC1124.2 +053300 GO TO ADD-WRITE-F2-3. NC1124.2 +053400 ADD-DELETE-F2-3. NC1124.2 +053500 PERFORM DE-LETE. NC1124.2 +053600 ADD-WRITE-F2-3. NC1124.2 +053700 MOVE "ADD-TEST-F2-3" TO PAR-NAME. NC1124.2 +053800 PERFORM PRINT-DETAIL. NC1124.2 +053900 SUB-INIT-F1-1. NC1124.2 +054000 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +054100 MOVE 1 TO DNAME-1. NC1124.2 +054200 MOVE 1 TO DNAME-2. NC1124.2 +054300 MOVE 1 TO DNAME-3. NC1124.2 +054400 MOVE 1 TO DNAME-4. NC1124.2 +054500 MOVE 1 TO DNAME-5. NC1124.2 +054600 MOVE 1 TO DNAME-6. NC1124.2 +054700 MOVE 1 TO DNAME-7. NC1124.2 +054800 MOVE 1 TO DNAME-8. NC1124.2 +054900 MOVE 1 TO DNAME-9. NC1124.2 +055000 MOVE 1 TO DNAME-10. NC1124.2 +055100 MOVE 10 TO ACCUM-1. NC1124.2 +055200 SUB-TEST-F1-1-0. NC1124.2 +055300 SUBTRACT DNAME-1 NC1124.2 +055400 DNAME-2 NC1124.2 +055500 DNAME-3 NC1124.2 +055600 DNAME-4 NC1124.2 +055700 DNAME-5 NC1124.2 +055800 DNAME-6 NC1124.2 +055900 DNAME-7 NC1124.2 +056000 DNAME-8 NC1124.2 +056100 DNAME-9 NC1124.2 +056200 DNAME-10 FROM ACCUM-1. NC1124.2 +056300 SUB-TEST-F1-1-1. NC1124.2 +056400 IF ACCUM-1 EQUAL TO ZERO NC1124.2 +056500 PERFORM PASS NC1124.2 +056600 GO TO SUB-WRITE-F1-1. NC1124.2 +056700 MOVE 0 TO CORRECT-A. NC1124.2 +056800 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +056900 PERFORM FAIL. NC1124.2 +057000 GO TO SUB-WRITE-F1-1. NC1124.2 +057100 SUB-DELETE-F1-1. NC1124.2 +057200 PERFORM DE-LETE. NC1124.2 +057300 SUB-WRITE-F1-1. NC1124.2 +057400 MOVE "SUBTRACT LIMITS" TO FEATURE. NC1124.2 +057500 PERFORM END-ROUTINE. NC1124.2 +057600 MOVE "SUB-TEST-F1-1" TO PAR-NAME. NC1124.2 +057700 PERFORM PRINT-DETAIL. NC1124.2 +057800 SUB-INIT-F2-1. NC1124.2 +057900 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +058000 MOVE 1 TO DNAME-1. NC1124.2 +058100 MOVE 1 TO DNAME-2. NC1124.2 +058200 MOVE 1 TO DNAME-3. NC1124.2 +058300 MOVE 1 TO DNAME-4. NC1124.2 +058400 MOVE 1 TO DNAME-5. NC1124.2 +058500 MOVE 1 TO DNAME-6. NC1124.2 +058600 MOVE 1 TO DNAME-7. NC1124.2 +058700 MOVE 1 TO DNAME-8. NC1124.2 +058800 MOVE 1 TO DNAME-9. NC1124.2 +058900 MOVE 1 TO DNAME-10. NC1124.2 +059000 MOVE 10 TO ACCUM-1. NC1124.2 +059100 SUB-TEST-F2-1-0. NC1124.2 +059200 SUBTRACT DNAME-1 NC1124.2 +059300 DNAME-2 NC1124.2 +059400 DNAME-3 NC1124.2 +059500 DNAME-4 NC1124.2 +059600 DNAME-5 NC1124.2 +059700 DNAME-6 NC1124.2 +059800 DNAME-7 NC1124.2 +059900 DNAME-8 NC1124.2 +060000 DNAME-9 NC1124.2 +060100 DNAME-10 FROM ACCUM-1 GIVING ACCUM-1. NC1124.2 +060200 SUB-TEST-F2-1-1. NC1124.2 +060300 IF ACCUM-1 EQUAL TO 0 NC1124.2 +060400 PERFORM PASS NC1124.2 +060500 GO TO SUB-WRITE-F2-1. NC1124.2 +060600 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +060700 MOVE 0 TO CORRECT-A. NC1124.2 +060800 PERFORM FAIL. NC1124.2 +060900 GO TO SUB-WRITE-F2-1. NC1124.2 +061000 SUB-DELETE-F2-1. NC1124.2 +061100 PERFORM DE-LETE. NC1124.2 +061200 SUB-WRITE-F2-1. NC1124.2 +061300 MOVE "SUB-TEST-F2-1" TO PAR-NAME. NC1124.2 +061400 PERFORM PRINT-DETAIL. NC1124.2 +061500 SUB-INIT-F2-2. NC1124.2 +061600 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +061700 MOVE 1 TO DNAME-1. NC1124.2 +061800 MOVE 1 TO DNAME-2. NC1124.2 +061900 MOVE 1 TO DNAME-3. NC1124.2 +062000 MOVE 1 TO DNAME-4. NC1124.2 +062100 MOVE 1 TO DNAME-5. NC1124.2 +062200 MOVE 1 TO DNAME-6. NC1124.2 +062300 MOVE 1 TO DNAME-7. NC1124.2 +062400 MOVE 1 TO DNAME-8. NC1124.2 +062500 MOVE 1 TO DNAME-9. NC1124.2 +062600 MOVE 1 TO DNAME-10. NC1124.2 +062700 SUB-TEST-F2-2-0. NC1124.2 +062800 SUBTRACT DNAME-2 NC1124.2 +062900 DNAME-3 NC1124.2 +063000 DNAME-4 NC1124.2 +063100 DNAME-5 NC1124.2 +063200 DNAME-6 NC1124.2 +063300 DNAME-7 NC1124.2 +063400 DNAME-8 NC1124.2 +063500 DNAME-9 NC1124.2 +063600 DNAME-10 FROM 100 GIVING DNAME-1 ON SIZE ERROR NC1124.2 +063700 PERFORM PASS NC1124.2 +063800 GO TO SUB-WRITE-F2-2. NC1124.2 +063900 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +064000 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +064100 PERFORM FAIL. NC1124.2 +064200 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +064300 GO TO SUB-WRITE-F2-2. NC1124.2 +064400 SUB-DELETE-F2-2. NC1124.2 +064500 PERFORM DE-LETE. NC1124.2 +064600 SUB-WRITE-F2-2. NC1124.2 +064700 MOVE "SUB-TEST-F2-2" TO PAR-NAME. NC1124.2 +064800 PERFORM PRINT-DETAIL. NC1124.2 +064900 SUB-INIT-F2-3. NC1124.2 +065000 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +065100 MOVE 1 TO DNAME-1. NC1124.2 +065200 MOVE 100 TO ACCUM-1. NC1124.2 +065300 SUB-TEST-F2-3. NC1124.2 +065400 SUBTRACT DNAME-1 NC1124.2 +065500 1 NC1124.2 +065600 DNAME-1 NC1124.2 +065700 DNAME-1 NC1124.2 +065800 DNAME-1 NC1124.2 +065900 1 NC1124.2 +066000 -1 NC1124.2 +066100 1 NC1124.2 +066200 1 FROM 7 GIVING ACCUM-1. NC1124.2 +066300 IF ACCUM-1 EQUAL TO 0 NC1124.2 +066400 PERFORM PASS NC1124.2 +066500 GO TO SUB-WRITE-F2-3. NC1124.2 +066600 MOVE 0 TO CORRECT-A. NC1124.2 +066700 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +066800 PERFORM FAIL. NC1124.2 +066900 GO TO SUB-WRITE-F2-3. NC1124.2 +067000 SUB-DELETE-F2-3. NC1124.2 +067100 PERFORM DE-LETE. NC1124.2 +067200 SUB-WRITE-F2-3. NC1124.2 +067300 MOVE "SUB-TEST-F2-3" TO PAR-NAME. NC1124.2 +067400 PERFORM PRINT-DETAIL. NC1124.2 +067500 SUB-INIT-F1-2. NC1124.2 +067600 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +067700 MOVE 1 TO DNAME-1. NC1124.2 +067800 MOVE 10 TO ACCUM-1. NC1124.2 +067900 MOVE 1 TO ACCUM-3. NC1124.2 +068000 SUB-TEST-F1-2-0. NC1124.2 +068100 SUBTRACT DNAME-1 NC1124.2 +068200 .5 NC1124.2 +068300 .5 NC1124.2 +068400 .5 NC1124.2 +068500 .5 NC1124.2 +068600 .5 NC1124.2 +068700 .5 NC1124.2 +068800 .5 NC1124.2 +068900 .5 NC1124.2 +069000 .5 FROM ACCUM-1 ROUNDED. NC1124.2 +069100 SUB-TEST-F1-2-1. NC1124.2 +069200 IF ACCUM-1 EQUAL TO 5 NC1124.2 +069300 PERFORM PASS NC1124.2 +069400 GO TO SUB-WRITE-F1-2. NC1124.2 +069500 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +069600 MOVE 5 TO CORRECT-A. NC1124.2 +069700 PERFORM FAIL. NC1124.2 +069800 GO TO SUB-WRITE-F1-2. NC1124.2 +069900 SUB-DELETE-F1-2. NC1124.2 +070000 PERFORM DE-LETE. NC1124.2 +070100 SUB-WRITE-F1-2. NC1124.2 +070200 MOVE "SUB-TEST-F1-2" TO PAR-NAME. NC1124.2 +070300 PERFORM PRINT-DETAIL. NC1124.2 +070400 SUB-INIT-F2-4. NC1124.2 +070500 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +070600 MOVE 1 TO DNAME-1. NC1124.2 +070700 MOVE 10 TO ACCUM-1. NC1124.2 +070800 MOVE 1 TO ACCUM-2. NC1124.2 +070900 SUB-TEST-F2-4-0. NC1124.2 +071000 SUBTRACT DNAME-1 NC1124.2 +071100 .5 NC1124.2 +071200 .5 NC1124.2 +071300 .5 NC1124.2 +071400 .5 NC1124.2 +071500 .5 NC1124.2 +071600 .5 NC1124.2 +071700 .5 NC1124.2 +071800 .5 NC1124.2 +071900 .5 FROM ACCUM-1 GIVING ACCUM-2 ROUNDED. NC1124.2 +072000 SUB-TEST-F2-4-1. NC1124.2 +072100 IF ACCUM-2 EQUAL TO 5 NC1124.2 +072200 PERFORM PASS NC1124.2 +072300 GO TO SUB-WRITE-F2-4. NC1124.2 +072400 MOVE ACCUM-2 TO COMPUTED-A. NC1124.2 +072500 MOVE 5 TO CORRECT-A. NC1124.2 +072600 PERFORM FAIL. NC1124.2 +072700 GO TO SUB-WRITE-F2-4. NC1124.2 +072800 SUB-DELETE-F2-4. NC1124.2 +072900 PERFORM DE-LETE. NC1124.2 +073000 SUB-WRITE-F2-4. NC1124.2 +073100 MOVE "SUB-TEST-F2-4" TO PAR-NAME. NC1124.2 +073200 PERFORM PRINT-DETAIL. NC1124.2 +073300 MOVE-INIT-F1-1-1. NC1124.2 +073400 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +073500 MOVE ZERO TO D-NAMES. NC1124.2 +073600 MOVE 1 TO ACCUM-3. NC1124.2 +073700 MOVE-TEST-F1-1-1. NC1124.2 +073800 MOVE ACCUM-3 TO NC1124.2 +073900 DNAME-1 NC1124.2 +074000 DNAME-2 NC1124.2 +074100 DNAME-3 NC1124.2 +074200 DNAME-4 NC1124.2 +074300 DNAME-5 NC1124.2 +074400 DNAME-6 NC1124.2 +074500 DNAME-7 NC1124.2 +074600 DNAME-8 NC1124.2 +074700 DNAME-9 NC1124.2 +074800 DNAME-10. NC1124.2 +074900 MOVE-TEST-F1-1-1-1. NC1124.2 +075000 IF DNAME-1 EQUAL TO 1 NC1124.2 +075100 PERFORM PASS NC1124.2 +075200 GO TO MOVE-WRITE-F1-1-1. NC1124.2 +075300 MOVE 1 TO CORRECT-N. NC1124.2 +075400 MOVE DNAME-1 TO COMPUTED-N. NC1124.2 +075500 PERFORM FAIL. NC1124.2 +075600 GO TO MOVE-WRITE-F1-1-1. NC1124.2 +075700 MOVE-DELETE-F1-1-1. NC1124.2 +075800 PERFORM DE-LETE. NC1124.2 +075900 MOVE-WRITE-F1-1-1. NC1124.2 +076000 MOVE "MOVE LIMITS TESTS" TO FEATURE. NC1124.2 +076100 PERFORM END-ROUTINE. NC1124.2 +076200 MOVE "MOVE-TEST-F1-1-1" TO PAR-NAME. NC1124.2 +076300 PERFORM PRINT-DETAIL. NC1124.2 +076400 MOVE-TEST-F1-1-2. NC1124.2 +076500 IF DNAME-2 EQUAL TO 1 NC1124.2 +076600 PERFORM PASS NC1124.2 +076700 GO TO MOVE-WRITE-F1-1-2. NC1124.2 +076800 MOVE 1 TO CORRECT-N. NC1124.2 +076900 MOVE DNAME-2 TO COMPUTED-N. NC1124.2 +077000 PERFORM FAIL. NC1124.2 +077100 GO TO MOVE-WRITE-F1-1-2. NC1124.2 +077200 MOVE-DELETE-F1-1-2. NC1124.2 +077300 PERFORM DE-LETE. NC1124.2 +077400 MOVE-WRITE-F1-1-2. NC1124.2 +077500 MOVE "MOVE-TEST-F1-1-2" TO PAR-NAME. NC1124.2 +077600 PERFORM PRINT-DETAIL. NC1124.2 +077700 MOVE-TEST-F1-1-3. NC1124.2 +077800 IF DNAME-3 EQUAL TO 1 NC1124.2 +077900 PERFORM PASS NC1124.2 +078000 GO TO MOVE-WRITE-F1-1-3. NC1124.2 +078100 MOVE 1 TO CORRECT-N. NC1124.2 +078200 MOVE DNAME-3 TO COMPUTED-N. NC1124.2 +078300 PERFORM FAIL. NC1124.2 +078400 GO TO MOVE-WRITE-F1-1-3. NC1124.2 +078500 MOVE-DELETE-F1-1-3. NC1124.2 +078600 PERFORM DE-LETE. NC1124.2 +078700 MOVE-WRITE-F1-1-3. NC1124.2 +078800 MOVE "MOVE-TEST-F1-1-3" TO PAR-NAME. NC1124.2 +078900 PERFORM PRINT-DETAIL. NC1124.2 +079000 MOVE-TEST-F1-1-4. NC1124.2 +079100 IF DNAME-4 EQUAL TO 1 NC1124.2 +079200 PERFORM PASS NC1124.2 +079300 GO TO MOVE-WRITE-F1-1-4. NC1124.2 +079400 MOVE 1 TO CORRECT-N. NC1124.2 +079500 MOVE DNAME-4 TO COMPUTED-N. NC1124.2 +079600 PERFORM FAIL. NC1124.2 +079700 GO TO MOVE-WRITE-F1-1-4. NC1124.2 +079800 MOVE-DELETE-F1-1-4. NC1124.2 +079900 PERFORM DE-LETE. NC1124.2 +080000 MOVE-WRITE-F1-1-4. NC1124.2 +080100 MOVE "MOVE-TEST-F1-1-4" TO PAR-NAME. NC1124.2 +080200 PERFORM PRINT-DETAIL. NC1124.2 +080300 MOVE-TEST-F1-1-5. NC1124.2 +080400 IF DNAME-5 EQUAL TO 1 NC1124.2 +080500 PERFORM PASS NC1124.2 +080600 GO TO MOVE-WRITE-F1-1-5. NC1124.2 +080700 MOVE 1 TO CORRECT-N. NC1124.2 +080800 MOVE DNAME-5 TO COMPUTED-N. NC1124.2 +080900 PERFORM FAIL. NC1124.2 +081000 GO TO MOVE-WRITE-F1-1-5. NC1124.2 +081100 MOVE-DELETE-F1-1-5. NC1124.2 +081200 PERFORM DE-LETE. NC1124.2 +081300 MOVE-WRITE-F1-1-5. NC1124.2 +081400 MOVE "MOVE-TEST-F1-1-5 " TO PAR-NAME. NC1124.2 +081500 PERFORM PRINT-DETAIL. NC1124.2 +081600 MOVE-TEST-F1-1-6. NC1124.2 +081700 IF DNAME-6 EQUAL TO 1 NC1124.2 +081800 PERFORM PASS NC1124.2 +081900 GO TO MOVE-WRITE-F1-1-6. NC1124.2 +082000 MOVE 1 TO CORRECT-N. NC1124.2 +082100 MOVE DNAME-6 TO COMPUTED-N. NC1124.2 +082200 PERFORM FAIL. NC1124.2 +082300 GO TO MOVE-WRITE-F1-1-6. NC1124.2 +082400 MOVE-DELETE-F1-1-6. NC1124.2 +082500 PERFORM DE-LETE. NC1124.2 +082600 MOVE-WRITE-F1-1-6. NC1124.2 +082700 MOVE "MOVE-TEST-F1-1-6 " TO PAR-NAME. NC1124.2 +082800 PERFORM PRINT-DETAIL. NC1124.2 +082900 MOVE-TEST-F1-1-7. NC1124.2 +083000 IF DNAME-7 EQUAL TO 1 NC1124.2 +083100 PERFORM PASS NC1124.2 +083200 GO TO MOVE-WRITE-F1-1-7. NC1124.2 +083300 MOVE 1 TO CORRECT-N. NC1124.2 +083400 MOVE DNAME-7 TO COMPUTED-N. NC1124.2 +083500 PERFORM FAIL. NC1124.2 +083600 GO TO MOVE-WRITE-F1-1-7. NC1124.2 +083700 MOVE-DELETE-F1-1-7. NC1124.2 +083800 PERFORM DE-LETE. NC1124.2 +083900 MOVE-WRITE-F1-1-7. NC1124.2 +084000 MOVE "MOVE-TEST-F1-1-7 " TO PAR-NAME. NC1124.2 +084100 PERFORM PRINT-DETAIL. NC1124.2 +084200 MOVE-TEST-F1-1-8. NC1124.2 +084300 IF DNAME-8 EQUAL TO 1 NC1124.2 +084400 PERFORM PASS NC1124.2 +084500 GO TO MOVE-WRITE-F1-1-8. NC1124.2 +084600 MOVE 1 TO CORRECT-N. NC1124.2 +084700 MOVE DNAME-8 TO COMPUTED-N. NC1124.2 +084800 PERFORM FAIL. NC1124.2 +084900 GO TO MOVE-WRITE-F1-1-8. NC1124.2 +085000 MOVE-DELETE-F1-1-8. NC1124.2 +085100 PERFORM DE-LETE. NC1124.2 +085200 MOVE-WRITE-F1-1-8. NC1124.2 +085300 MOVE "MOVE-TEST-F1-1-8 " TO PAR-NAME. NC1124.2 +085400 PERFORM PRINT-DETAIL. NC1124.2 +085500 MOVE-TEST-F1-1-9. NC1124.2 +085600 IF DNAME-9 EQUAL TO 1 NC1124.2 +085700 PERFORM PASS NC1124.2 +085800 GO TO MOVE-WRITE-F1-1-9. NC1124.2 +085900 MOVE 1 TO CORRECT-N. NC1124.2 +086000 MOVE DNAME-9 TO COMPUTED-N. NC1124.2 +086100 PERFORM FAIL. NC1124.2 +086200 GO TO MOVE-WRITE-F1-1-9. NC1124.2 +086300 MOVE-DELETE-F1-1-9. NC1124.2 +086400 PERFORM DE-LETE. NC1124.2 +086500 MOVE-WRITE-F1-1-9. NC1124.2 +086600 MOVE "MOVE-TEST-F1-1-9 " TO PAR-NAME. NC1124.2 +086700 PERFORM PRINT-DETAIL. NC1124.2 +086800 MOVE-TEST-F1-1-10. NC1124.2 +086900 IF DNAME-10 EQUAL TO 1 NC1124.2 +087000 PERFORM PASS NC1124.2 +087100 GO TO MOVE-WRITE-F1-1-10. NC1124.2 +087200 MOVE 1 TO CORRECT-N. NC1124.2 +087300 MOVE DNAME-10 TO COMPUTED-N. NC1124.2 +087400 PERFORM FAIL. NC1124.2 +087500 GO TO MOVE-WRITE-F1-1-10. NC1124.2 +087600 MOVE-DELETE-F1-1-10. NC1124.2 +087700 PERFORM DE-LETE. NC1124.2 +087800 MOVE-WRITE-F1-1-10. NC1124.2 +087900 MOVE "MOVE-TEST-F1-1-10" TO PAR-NAME. NC1124.2 +088000 PERFORM PRINT-DETAIL. NC1124.2 +088100 MOVE-INIT-F1-2-1. NC1124.2 +088200 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +088300 MOVE HIGH-VALUE TO D-NAMES. NC1124.2 +088400 MOVE-TEST-F1-2-0. NC1124.2 +088500 MOVE ZERO TO DNAME-1 NC1124.2 +088600 DNAME-2 NC1124.2 +088700 DNAME-3 NC1124.2 +088800 DNAME-4 NC1124.2 +088900 DNAME-5 NC1124.2 +089000 DNAME-6 NC1124.2 +089100 DNAME-7 NC1124.2 +089200 DNAME-8 NC1124.2 +089300 DNAME-9 NC1124.2 +089400 DNAME-10. NC1124.2 +089500 MOVE-TEST-F1-2-1. NC1124.2 +089600 IF DNAME-1 EQUAL TO 0 NC1124.2 +089700 PERFORM PASS NC1124.2 +089800 GO TO MOVE-WRITE-F1-2-1. NC1124.2 +089900 MOVE 0 TO CORRECT-N. NC1124.2 +090000 MOVE DNAME-1 TO COMPUTED-N. NC1124.2 +090100 PERFORM FAIL. NC1124.2 +090200 GO TO MOVE-WRITE-F1-2-1. NC1124.2 +090300 MOVE-DELETE-F1-2-1. NC1124.2 +090400 PERFORM DE-LETE. NC1124.2 +090500 MOVE-WRITE-F1-2-1. NC1124.2 +090600 MOVE "MOVE-TEST-F1-2-1" TO PAR-NAME. NC1124.2 +090700 PERFORM PRINT-DETAIL. NC1124.2 +090800 MOVE-TEST-F1-2-2. NC1124.2 +090900 IF DNAME-2 EQUAL TO 0 NC1124.2 +091000 PERFORM PASS NC1124.2 +091100 GO TO MOVE-WRITE-F1-2-2. NC1124.2 +091200 MOVE 0 TO CORRECT-N. NC1124.2 +091300 MOVE DNAME-2 TO COMPUTED-N. NC1124.2 +091400 PERFORM FAIL. NC1124.2 +091500 GO TO MOVE-WRITE-F1-2-2. NC1124.2 +091600 MOVE-DELETE-F1-2-2. NC1124.2 +091700 PERFORM DE-LETE. NC1124.2 +091800 MOVE-WRITE-F1-2-2. NC1124.2 +091900 MOVE "MOVE-TEST-F1-2-2" TO PAR-NAME. NC1124.2 +092000 PERFORM PRINT-DETAIL. NC1124.2 +092100 MOVE-TEST-F1-2-3. NC1124.2 +092200 IF DNAME-3 EQUAL TO 0 NC1124.2 +092300 PERFORM PASS NC1124.2 +092400 GO TO MOVE-WRITE-F1-2-3. NC1124.2 +092500 MOVE 0 TO CORRECT-N. NC1124.2 +092600 MOVE DNAME-3 TO COMPUTED-N. NC1124.2 +092700 PERFORM FAIL. NC1124.2 +092800 GO TO MOVE-WRITE-F1-2-3. NC1124.2 +092900 MOVE-DELETE-F1-2-3. NC1124.2 +093000 PERFORM DE-LETE. NC1124.2 +093100 MOVE-WRITE-F1-2-3. NC1124.2 +093200 MOVE "MOVE-TEST-F1-2-3" TO PAR-NAME. NC1124.2 +093300 PERFORM PRINT-DETAIL. NC1124.2 +093400 MOVE-TEST-F1-2-4. NC1124.2 +093500 IF DNAME-4 EQUAL TO 0 NC1124.2 +093600 PERFORM PASS NC1124.2 +093700 GO TO MOVE-WRITE-F1-2-4. NC1124.2 +093800 MOVE 0 TO CORRECT-N. NC1124.2 +093900 MOVE DNAME-4 TO COMPUTED-N. NC1124.2 +094000 PERFORM FAIL. NC1124.2 +094100 GO TO MOVE-WRITE-F1-2-4. NC1124.2 +094200 MOVE-DELETE-F1-2-4. NC1124.2 +094300 PERFORM DE-LETE. NC1124.2 +094400 MOVE-WRITE-F1-2-4. NC1124.2 +094500 MOVE "MOVE-TEST-F1-2-4" TO PAR-NAME. NC1124.2 +094600 PERFORM PRINT-DETAIL. NC1124.2 +094700 MOVE-TEST-F1-2-5. NC1124.2 +094800 IF DNAME-5 EQUAL TO 0 NC1124.2 +094900 PERFORM PASS NC1124.2 +095000 GO TO MOVE-WRITE-F1-2-5. NC1124.2 +095100 MOVE 0 TO CORRECT-N. NC1124.2 +095200 MOVE DNAME-5 TO COMPUTED-N. NC1124.2 +095300 PERFORM FAIL. NC1124.2 +095400 GO TO MOVE-WRITE-F1-2-5. NC1124.2 +095500 MOVE-DELETE-F1-2-5. NC1124.2 +095600 PERFORM DE-LETE. NC1124.2 +095700 MOVE-WRITE-F1-2-5. NC1124.2 +095800 MOVE "MOVE-TEST-F1-2-5" TO PAR-NAME. NC1124.2 +095900 PERFORM PRINT-DETAIL. NC1124.2 +096000 MOVE-TEST-F1-2-6. NC1124.2 +096100 IF DNAME-6 EQUAL TO 0 NC1124.2 +096200 PERFORM PASS NC1124.2 +096300 GO TO MOVE-WRITE-F1-2-6. NC1124.2 +096400 MOVE 0 TO CORRECT-N. NC1124.2 +096500 MOVE DNAME-6 TO COMPUTED-N. NC1124.2 +096600 PERFORM FAIL. NC1124.2 +096700 GO TO MOVE-WRITE-F1-2-6. NC1124.2 +096800 MOVE-DELETE-F1-2-6. NC1124.2 +096900 PERFORM DE-LETE. NC1124.2 +097000 MOVE-WRITE-F1-2-6. NC1124.2 +097100 MOVE "MOVE-TEST-F1-2-6" TO PAR-NAME. NC1124.2 +097200 PERFORM PRINT-DETAIL. NC1124.2 +097300 MOVE-TEST-F1-2-7. NC1124.2 +097400 IF DNAME-7 EQUAL TO 0 NC1124.2 +097500 PERFORM PASS NC1124.2 +097600 GO TO MOVE-WRITE-F1-2-7. NC1124.2 +097700 MOVE 0 TO CORRECT-N. NC1124.2 +097800 MOVE DNAME-7 TO COMPUTED-N. NC1124.2 +097900 PERFORM FAIL. NC1124.2 +098000 GO TO MOVE-WRITE-F1-2-7. NC1124.2 +098100 MOVE-DELETE-F1-2-7. NC1124.2 +098200 PERFORM DE-LETE. NC1124.2 +098300 MOVE-WRITE-F1-2-7. NC1124.2 +098400 MOVE "MOVE-TEST-F1-2-7" TO PAR-NAME. NC1124.2 +098500 PERFORM PRINT-DETAIL. NC1124.2 +098600 MOVE-TEST-F1-2-8. NC1124.2 +098700 IF DNAME-8 EQUAL TO 0 NC1124.2 +098800 PERFORM PASS NC1124.2 +098900 GO TO MOVE-WRITE-F1-2-8. NC1124.2 +099000 MOVE 0 TO CORRECT-N. NC1124.2 +099100 MOVE DNAME-8 TO COMPUTED-N. NC1124.2 +099200 PERFORM FAIL. NC1124.2 +099300 GO TO MOVE-WRITE-F1-2-8. NC1124.2 +099400 MOVE-DELETE-F1-2-8. NC1124.2 +099500 PERFORM DE-LETE. NC1124.2 +099600 MOVE-WRITE-F1-2-8. NC1124.2 +099700 MOVE "MOVE-TEST-F1-2-8" TO PAR-NAME. NC1124.2 +099800 PERFORM PRINT-DETAIL. NC1124.2 +099900 MOVE-TEST-F1-2-9. NC1124.2 +100000 IF DNAME-9 EQUAL TO 0 NC1124.2 +100100 PERFORM PASS NC1124.2 +100200 GO TO MOVE-WRITE-F1-2-9. NC1124.2 +100300 MOVE 0 TO CORRECT-N. NC1124.2 +100400 MOVE DNAME-9 TO COMPUTED-N. NC1124.2 +100500 PERFORM FAIL. NC1124.2 +100600 GO TO MOVE-WRITE-F1-2-9. NC1124.2 +100700 MOVE-DELETE-F1-2-9. NC1124.2 +100800 PERFORM DE-LETE. NC1124.2 +100900 MOVE-WRITE-F1-2-9. NC1124.2 +101000 MOVE "MOVE-TEST-F1-2-9" TO PAR-NAME. NC1124.2 +101100 PERFORM PRINT-DETAIL. NC1124.2 +101200 MOVE-TEST-F1-2-10. NC1124.2 +101300 IF DNAME-10 EQUAL TO 0 NC1124.2 +101400 PERFORM PASS NC1124.2 +101500 GO TO MOVE-WRITE-F1-2-10. NC1124.2 +101600 MOVE 0 TO CORRECT-N. NC1124.2 +101700 MOVE DNAME-10 TO COMPUTED-N. NC1124.2 +101800 PERFORM FAIL. NC1124.2 +101900 GO TO MOVE-WRITE-F1-2-10. NC1124.2 +102000 MOVE-DELETE-F1-2-10. NC1124.2 +102100 PERFORM DE-LETE. NC1124.2 +102200 MOVE-WRITE-F1-2-10. NC1124.2 +102300 MOVE "MOVE-TEST-F1-2-10" TO PAR-NAME. NC1124.2 +102400 PERFORM PRINT-DETAIL. NC1124.2 +102500 CCVS-EXIT SECTION. NC1124.2 +102600 CCVS-999999. NC1124.2 +102700 GO TO CLOSE-FILES. NC1124.2 +*END-OF,NC112A +*HEADER,COBOL,NC113M +000100 IDENTIFICATION DIVISION. NC1134.2 +000200 PROGRAM-ID. NC1134.2 +000300 NC113M. NC1134.2 +000400**************************************************************** NC1134.2 +000500* * NC1134.2 +000600* VALIDATION FOR:- * NC1134.2 +000700* * NC1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1134.2 +000900* * NC1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1134.2 +001100* * NC1134.2 +001200**************************************************************** NC1134.2 +001300* * NC1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1134.2 +001500* * NC1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1134.2 +001900* * NC1134.2 +002000**************************************************************** NC1134.2 +002100* NC1134.2 +002200* PROGRAM NC113M VERIFIES CORRECT USE OF AREA A WITHIN NC1134.2 +002300* A PROGRAM. NC1134.2 +002400* NC1134.2 +002500* NC1134.2 +002600 ENVIRONMENT DIVISION. NC1134.2 +002700 CONFIGURATION SECTION. NC1134.2 +002800 SOURCE-COMPUTER. NC1134.2 +002900 XXXXX082. NC1134.2 +003000 OBJECT-COMPUTER. NC1134.2 +003100 XXXXX083. NC1134.2 +003200 INPUT-OUTPUT SECTION. NC1134.2 +003300 FILE-CONTROL. NC1134.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1134.2 +003500 XXXXX055. NC1134.2 +003600 DATA NC1134.2 +003700 DIVISION. NC1134.2 +003800 FILE SECTION. NC1134.2 +003900 FD PRINT-FILE. NC1134.2 +004000 01 PRINT-REC PICTURE X(120). NC1134.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1134.2 +004200 WORKING-STORAGE SECTION. NC1134.2 +004300 77 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. NC1134.2 +004400 77 DELETE-CNT PICTURE 999 VALUE ZERO. NC1134.2 +004500 01 TEST-RESULTS. NC1134.2 +004600 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +004700 02 FEATURE PICTURE X(20). NC1134.2 +004800 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +004900 02 P-OR-F PICTURE XXXXX. NC1134.2 +005000 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +005100 02 PAR-NAME PICTURE X(19). NC1134.2 +005200 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +005300 02 COMPUTED-A PICTURE X(20). NC1134.2 +005400 02 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). NC1134.2 +005500 02 FILLER PICTURE XX VALUE SPACE. NC1134.2 +005600 02 CORRECT-A PICTURE X(20). NC1134.2 +005700 02 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). NC1134.2 +005800 02 FILLER PICTURE XX VALUE SPACE. NC1134.2 +005900 02 RE-MARK PICTURE X(27). NC1134.2 +006000 01 HEADER-LINE-1. NC1134.2 +006100 02 PAGE-CONTROL-4 PICTURE IS X VALUE IS "1". NC1134.2 +006200 02 FILLER PICTURE X(42) VALUE NC1134.2 +006300 SPACE. NC1134.2 +006400 02 FILLER PICTURE X(42) VALUE NC1134.2 +006500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM ". NC1134.2 +006600 02 FILLER PICTURE X(35) VALUE NC1134.2 +006700 SPACE. NC1134.2 +006800 01 HEADER-LINE-2. NC1134.2 +006900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. NC1134.2 +007000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". NC1134.2 +007100 02 TEST-ID PICTURE IS X(9). NC1134.2 +007200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. NC1134.2 +007300 01 HEADER-LINE-3. NC1134.2 +007400 02 FILLER PICTURE X(34) VALUE NC1134.2 +007500 " FOR OFFICIAL USE ONLY ". NC1134.2 +007600 02 FILLER PICTURE X(58) VALUE NC1134.2 +007700 " ". NC1134.2 +007800 02 FILLER PICTURE X(28) VALUE NC1134.2 +007900 " COPYRIGHT 1985 ". NC1134.2 +008000 01 COLUMNS-LINE-1. NC1134.2 +008100 02 PAGE-CONTROL-C PICTURE IS X VALUE IS SPACE. NC1134.2 +008200 02 FILLER PICTURE IS X(99) VALUE IS "FEATURE PASNC1134.2 +008300- "S PARAGRAPH NAME NC1134.2 +008400- " REMARKS". NC1134.2 +008500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. NC1134.2 +008600 01 COLUMNS-LINE-2. NC1134.2 +008700 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +008800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". NC1134.2 +008900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. NC1134.2 +009000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". NC1134.2 +009100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. NC1134.2 +009200 01 ENDER-LINE-1. NC1134.2 +009300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. NC1134.2 +009400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". NC1134.2 +009500 02 ID-AGAIN PICTURE IS X(9). NC1134.2 +009600 02 FILLER PICTURE IS X(45) VALUE IS SPACE. NC1134.2 +009700 01 ENDER-LINE-2. NC1134.2 +009800 02 FILLER PICTURE X(31) VALUE NC1134.2 +009900 SPACE. NC1134.2 +010000 02 FILLER PICTURE X(21) VALUE IS SPACE. NC1134.2 +010100 02 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. NC1134.2 +010200 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +010300 02 ENDER-DESC PICTURE X(31) VALUE IS "ERRORS ENNC1134.2 +010400- "COUNTERED". NC1134.2 +010500 02 FILLER PICTURE IS X(33) VALUE IS SPACE. NC1134.2 +010600 01 ENDER-LINE-3. NC1134.2 +010700 02 FILLER PICTURE X(22) VALUE NC1134.2 +010800 " FOR OFFICIAL USE ONLY". NC1134.2 +010900 02 FILLER PICTURE X(12) VALUE SPACE. NC1134.2 +011000 02 FILLER PICTURE X(58) VALUE SPACE. NC1134.2 +011100 02 FILLER PICTURE X(13) VALUE SPACE. NC1134.2 +011200 02 FILLER PICTURE X(15) VALUE " COPYRIGHT 1985". NC1134.2 +011300 01 HYPHEN-LINE. NC1134.2 +011400 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +011500 02 FILLER PICTURE IS X(65) VALUE IS "------------------------NC1134.2 +011600- "-----------------------------------------". NC1134.2 +011700 02 FILLER PICTURE IS X(54) VALUE IS "------------------------NC1134.2 +011800- "------------------------------". NC1134.2 +011900 PROCEDURE NC1134.2 +012000 DIVISION NC1134.2 +012100 . NC1134.2 +012200 OPEN-FILES. NC1134.2 +012300 OPEN OUTPUT PRINT-FILE. NC1134.2 +012400 MOVE " NC113M" TO TEST-ID. NC1134.2 +012500 MOVE TEST-ID TO ID-AGAIN. NC1134.2 +012600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1134.2 +012700 MOVE SPACE TO TEST-RESULTS. NC1134.2 +012800 MOVE "MARGIN TESTING" TO FEATURE. NC1134.2 +012900 PERFORM MAR-TEST-1. NC1134.2 +013000 MAR-TEST-2. NC1134.2 +013100 MOVE "VISUALLY CHECKED" TO RE-MARK. NC1134.2 +013200 MOVE "MAR-TEST-2" TO PAR-NAME. NC1134.2 +013300 PERFORM PRINT-DETAIL. NC1134.2 +013400 GO TO MAR-TEST-3. NC1134.2 +013500 MAR-TEST-15. NC1134.2 +013600 MOVE "MAR-TEST-15" TO PAR-NAME. NC1134.2 +013700 PERFORM PRINT-DETAIL. NC1134.2 +013800 MAR-TEST-7. NC1134.2 +013900 MOVE "MAR-TEST-7" TO PAR-NAME. NC1134.2 +014000 PERFORM PRINT-DETAIL. NC1134.2 +014100* GO TO MAR-TEST-8. NC1134.2 +014200 MAR-TEST-12. NC1134.2 +014300 MOVE "MAR-TEST-12" TO PAR-NAME. NC1134.2 +014400 PERFORM PRINT-DETAIL. NC1134.2 +014500 GO TO MAR-TEST-13. NC1134.2 +014600 MAR-TEST-4. NC1134.2 +014700 MOVE "MAR-TEST-4" TO PAR-NAME. NC1134.2 +014800 PERFORM PRINT-DETAIL. NC1134.2 +014900 MAR-TEST-9. NC1134.2 +015000 MOVE "MAR-TEST-9" TO PAR-NAME. NC1134.2 +015100 PERFORM PRINT-DETAIL. NC1134.2 +015200 MAR-TEST-8. NC1134.2 +015300 MOVE "MAR-TEST-8" TO PAR-NAME. NC1134.2 +015400 PERFORM PRINT-DETAIL. NC1134.2 +015500 PERFORM MAR-TEST-9. NC1134.2 +015600 GO TO MAR-TEST-10. NC1134.2 +015700 MAR-TEST-1. NC1134.2 +015800 MOVE "ANSWERS MUST BE" TO RE-MARK. NC1134.2 +015900 MOVE "MAR-TEST-1" TO PAR-NAME. NC1134.2 +016000 PERFORM PRINT-DETAIL. NC1134.2 +016100 MAR-TEST-5. NC1134.2 +016200 MOVE "TESTS MUST BE SEQUENTIAL" TO RE-MARK. NC1134.2 +016300 MOVE "MAR-TEST-5" TO PAR-NAME. NC1134.2 +016400 PERFORM PRINT-DETAIL. NC1134.2 +016500 GO TO MAR-TEST-6. NC1134.2 +016600 MAR-TEST-13. NC1134.2 +016700 MOVE "MAR-TEST-13" TO PAR-NAME. NC1134.2 +016800 PERFORM PRINT-DETAIL. NC1134.2 +016900 GO TO MAR-TEST-14. NC1134.2 +017000 MAR-TEST-3. NC1134.2 +017100 MOVE "FOR CORRECTNESS" TO RE-MARK. NC1134.2 +017200 MOVE "MAR-TEST-3" TO PAR-NAME. NC1134.2 +017300 PERFORM PRINT-DETAIL. NC1134.2 +017400 PERFORM MAR-TEST-4. NC1134.2 +017500 GO TO MAR-TEST-5. NC1134.2 +017600 MAR-TEST-14. NC1134.2 +017700 MOVE "MAR-TEST-14" TO PAR-NAME. NC1134.2 +017800 PERFORM PRINT-DETAIL. NC1134.2 +017900 PERFORM MAR-TEST-15. NC1134.2 +018000 GO TO CLOSE-FILES. NC1134.2 +018100 MAR-TEST-11. NC1134.2 +018200 MOVE "MAR-TEST-11" TO PAR-NAME. NC1134.2 +018300 PERFORM PRINT-DETAIL. NC1134.2 +018400 GO TO MAR-TEST-12. NC1134.2 +018500 MAR-TEST-10. NC1134.2 +018600 MOVE "MAR-TEST-10" TO PAR-NAME. NC1134.2 +018700 PERFORM PRINT-DETAIL. NC1134.2 +018800 GO TO MAR-TEST-11. NC1134.2 +018900 MAR-TEST-6. NC1134.2 +019000 MOVE "MAR-TEST-6" TO PAR-NAME. NC1134.2 +019100 PERFORM PRINT-DETAIL. NC1134.2 +019200 PERFORM MAR-TEST-7. NC1134.2 +019300 GO TO MAR-TEST-8. NC1134.2 +019400 CLOSE-FILES. NC1134.2 +019500 PERFORM END-ROUTINE THRU END-ROUTINE-3. NC1134.2 +019600 CLOSE PRINT-FILE. NC1134.2 +019700 STOP RUN. NC1134.2 +019800 PASS. NC1134.2 +019900 MOVE "PASS" TO P-OR-F. NC1134.2 +020000 FAIL. NC1134.2 +020100 ADD 1 TO ERROR-COUNTER. NC1134.2 +020200 MOVE "FAIL*" TO P-OR-F. NC1134.2 +020300 DE-LETE. NC1134.2 +020400 MOVE SPACE TO P-OR-F. NC1134.2 +020500 MOVE " ************ " TO COMPUTED-A. NC1134.2 +020600 MOVE " ************ " TO CORRECT-A. NC1134.2 +020700 MOVE "****TEST DELETED****" TO RE-MARK. NC1134.2 +020800 ADD 1 TO DELETE-CNT. NC1134.2 +020900 PRINT-DETAIL. NC1134.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. NC1134.2 +021100 WRITE PRINT-REC AFTER 1. NC1134.2 +021200 MOVE SPACE TO P-OR-F. NC1134.2 +021300 MOVE SPACE TO PAR-NAME. NC1134.2 +021400 MOVE SPACE TO COMPUTED-A. NC1134.2 +021500 MOVE SPACE TO CORRECT-A. NC1134.2 +021600 MOVE SPACE TO RE-MARK. NC1134.2 +021700 HEAD-ROUTINE. NC1134.2 +021800 PERFORM BLANK-LINE-PRINT 15 TIMES. NC1134.2 +021900 MOVE HEADER-LINE-1 TO DUMMY-RECORD. NC1134.2 +022000 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022100 PERFORM BLANK-LINE-PRINT. NC1134.2 +022200 MOVE HEADER-LINE-2 TO DUMMY-RECORD. NC1134.2 +022300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022400 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1134.2 +022500 MOVE HEADER-LINE-3 TO DUMMY-RECORD. NC1134.2 +022600 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022700 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1134.2 +022800 COLUMN-NAMES-ROUTINE. NC1134.2 +022900 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. NC1134.2 +023000 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023100 MOVE SPACE TO PAGE-CONTROL-C. NC1134.2 +023200 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. NC1134.2 +023300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023400 PERFORM BLANK-LINE-PRINT. NC1134.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. NC1134.2 +023600 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023700 END-ROUTINE. NC1134.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. NC1134.2 +023900 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +024000 PARA-Z. NC1134.2 +024100 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1134.2 +024200 MOVE ENDER-LINE-1 TO DUMMY-RECORD. NC1134.2 +024300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +024400 END-ROUTINE-1. NC1134.2 +024500 PERFORM BLANK-LINE-PRINT. NC1134.2 +024600 MOVE "TESTS REQUIRE VISUAL INSPECTION" TO ENDER-DESC. NC1134.2 +024700 END-ROUTINE-2. NC1134.2 +024800 MOVE " 15" TO ERROR-TOTAL. NC1134.2 +024900 END-ROUTINE-3. NC1134.2 +025000 MOVE ENDER-LINE-2 TO DUMMY-RECORD. NC1134.2 +025100 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +025200 IF DELETE-CNT IS EQUAL TO ZERO NC1134.2 +025300 MOVE " NO" TO ERROR-TOTAL ELSE NC1134.2 +025400 MOVE DELETE-CNT TO ERROR-TOTAL. NC1134.2 +025500 MOVE "TESTS DELETED " TO ENDER-DESC. NC1134.2 +025600 MOVE ENDER-LINE-2 TO DUMMY-RECORD. NC1134.2 +025700 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +025800 MOVE ENDER-LINE-3 TO DUMMY-RECORD. NC1134.2 +025900 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +026000 BLANK-LINE-PRINT. NC1134.2 +026100 MOVE SPACE TO DUMMY-RECORD. NC1134.2 +026200 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +*END-OF,NC113M +*HEADER,COBOL,NC114M +000100 IDENTIFICATION DIVISION. NC1144.2 +000200 PROGRAM-ID. NC1144.2 +000300 NC114M. NC1144.2 +000400**************************************************************** NC1144.2 +000500* * NC1144.2 +000600* VALIDATION FOR:- * NC1144.2 +000700* * NC1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +000900* * NC1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1144.2 +001100* * NC1144.2 +001200**************************************************************** NC1144.2 +001300* * NC1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1144.2 +001500* * NC1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1144.2 +001900* * NC1144.2 +002000**************************************************************** NC1144.2 +002100* NC1144.2 +002200* PROGRAM NC114M TESTS: NC1144.2 +002300* NC1144.2 +002400* ALPHA-NUMERIC EDITING NC1144.2 +002500* COMMENT LINES NC1144.2 +002600* UNIQUENESS OF REFERENCE (DATA, PARAGRAPH & SECTION NAME) NC1144.2 +002700* SEQUENCE NUMBERING NC1144.2 +002800* NC1144.2 +002900******************************************************************NC1144.2 +003000* NC1144.2 +003100 ENVIRONMENT DIVISION. NC1144.2 +003200 CONFIGURATION SECTION. NC1144.2 +003300 SOURCE-COMPUTER. NC1144.2 +003400 XXXXX082. NC1144.2 +003500 OBJECT-COMPUTER. NC1144.2 +003600 XXXXX083 NC1144.2 +003700 PROGRAM COLLATING SEQUENCE IS AMERICAN-INDIAN. NC1144.2 +003800 SPECIAL-NAMES. NC1144.2 +003900 ALPHABET AMERICAN-INDIAN IS NATIVE. NC1144.2 +004000 INPUT-OUTPUT SECTION. NC1144.2 +004100 FILE-CONTROL. NC1144.2 +004200 SELECT PRINT-FILE ASSIGN TO NC1144.2 +004300 XXXXX055. NC1144.2 +004400 DATA DIVISION. NC1144.2 +004500 FILE SECTION. NC1144.2 +004600 FD PRINT-FILE. NC1144.2 +004700 01 PRINT-REC PICTURE X(120). NC1144.2 +004800 01 DUMMY-RECORD PICTURE X(120). NC1144.2 +004900 WORKING-STORAGE SECTION. NC1144.2 +005000 01 NINE-DU-9 PIC 9 VALUE 9. NC1144.2 +005100 01 WRK-DU-99-1 PIC 99. NC1144.2 +005200 01 WRK-DU-99-2 PIC 99. NC1144.2 +005300 01 WRK-AE-1 PIC ABA VALUE "ABC". NC1144.2 +005400 01 WRK-AE-2 PIC A/AA. NC1144.2 +005500 01 WRK-AE-3 PIC XBXXX/XXX/XXX/XXX/XXXBXX. NC1144.2 +005600 01 WRK-NE-1 PIC 9/99 . NC1144.2 +005700/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +005800/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +005900* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,$*.)-/+> <,....NC1144.2 +006000*SIGN-LEADING-TEST-9 ) , > ; < NC1144.2 +006100 01 WRK-DS-L-18V0-1 PIC S9(18) SIGN IS LEADING . NC1144.2 +006200* SIGN-TRAILING-TEST-10 NC1144.2 +006300 01 WRK-DS-T-18V0-1 PIC S9(18) SIGN TRAILING . NC1144.2 +006400* SIGN-SEPARATE-TEST-11 NC1144.2 +006500 01 WRK-DS-S-18V0-1 PIC S9(18) SIGN TRAILING SEPARATE CHARACTER. NC1144.2 +006600* REDEFINITION-TEST-12 NC1144.2 +006700 01 WRK-XN-18-1 PIC X(18). NC1144.2 +006800 01 WRK-AN-18-X-1 REDEFINES WRK-XN-18-1 PIC A(18). NC1144.2 +006900 01 GRP-X-1 REDEFINES WRK-XN-18-1. NC1144.2 +007000 02 WRK-DU-9V0-1 PIC 9(9). NC1144.2 +007100 02 WRK-DU-9V0-2 PIC 9(9). NC1144.2 +007200 01 WRK-DS-18V0-1 PIC S9(18) NC1144.2 +007300 VALUE -123456789012345678. NC1144.2 +007400 01 WRK-XN-18-2 PIC X(18) VALUE "123456789012345678". NC1144.2 +007500 01 WRK-DS-LS-1P17-1 PIC S9P(17) SIGN LEADING SEPARATE NC1144.2 +007600 CHARACTER VALUE -100000000000000000. NC1144.2 +007700/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +007800 01 PIC-SYNTAX-TEST-19 PIC AB9. NC1144.2 +007900/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +008000 01 TEST-RESULTS. NC1144.2 +008100 02 FILLER PIC X VALUE SPACE. NC1144.2 +008200 02 FEATURE PIC X(20) VALUE SPACE. NC1144.2 +008300 02 FILLER PIC X VALUE SPACE. NC1144.2 +008400 02 P-OR-F PIC X(5) VALUE SPACE. NC1144.2 +008500 02 FILLER PIC X VALUE SPACE. NC1144.2 +008600 02 PAR-NAME. NC1144.2 +008700 03 FILLER PIC X(19) VALUE SPACE. NC1144.2 +008800 03 PARDOT-X PIC X VALUE SPACE. NC1144.2 +008900 03 DOTVALUE PIC 99 VALUE ZERO. NC1144.2 +009000 02 FILLER PIC X(8) VALUE SPACE. NC1144.2 +009100 02 RE-MARK PIC X(61). NC1144.2 +009200 01 TEST-COMPUTED. NC1144.2 +009300 02 FILLER PIC X(30) VALUE SPACE. NC1144.2 +009400 02 FILLER PIC X(17) VALUE NC1144.2 +009500 " COMPUTED=". NC1144.2 +009600 02 COMPUTED-X. NC1144.2 +009700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1144.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A NC1144.2 +009900 PIC -9(9).9(9). NC1144.2 +010000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1144.2 +010100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1144.2 +010200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1144.2 +010300 03 CM-18V0 REDEFINES COMPUTED-A. NC1144.2 +010400 04 COMPUTED-18V0 PIC -9(18). NC1144.2 +010500 04 FILLER PIC X. NC1144.2 +010600 03 FILLER PIC X(50) VALUE SPACE. NC1144.2 +010700 01 TEST-CORRECT. NC1144.2 +010800 02 FILLER PIC X(30) VALUE SPACE. NC1144.2 +010900 02 FILLER PIC X(17) VALUE " CORRECT =". NC1144.2 +011000 02 CORRECT-X. NC1144.2 +011100 03 CORRECT-A PIC X(20) VALUE SPACE. NC1144.2 +011200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1144.2 +011300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1144.2 +011400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1144.2 +011500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1144.2 +011600 03 CR-18V0 REDEFINES CORRECT-A. NC1144.2 +011700 04 CORRECT-18V0 PIC -9(18). NC1144.2 +011800 04 FILLER PIC X. NC1144.2 +011900 03 FILLER PIC X(2) VALUE SPACE. NC1144.2 +012000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1144.2 +012100 01 CCVS-C-1. NC1144.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1144.2 +012300- "SS PARAGRAPH-NAME NC1144.2 +012400- " REMARKS". NC1144.2 +012500 02 FILLER PIC X(20) VALUE SPACE. NC1144.2 +012600 01 CCVS-C-2. NC1144.2 +012700 02 FILLER PIC X VALUE SPACE. NC1144.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". NC1144.2 +012900 02 FILLER PIC X(15) VALUE SPACE. NC1144.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". NC1144.2 +013100 02 FILLER PIC X(94) VALUE SPACE. NC1144.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1144.2 +013300 01 REC-CT PIC 99 VALUE ZERO. NC1144.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1144.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1144.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1144.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1144.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1144.2 +014300 01 CCVS-H-1. NC1144.2 +014400 02 FILLER PIC X(39) VALUE SPACES. NC1144.2 +014500 02 FILLER PIC X(42) VALUE NC1144.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1144.2 +014700 02 FILLER PIC X(39) VALUE SPACES. NC1144.2 +014800 01 CCVS-H-2A. NC1144.2 +014900 02 FILLER PIC X(40) VALUE SPACE. NC1144.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1144.2 +015100 02 FILLER PIC XXXX VALUE NC1144.2 +015200 "4.2 ". NC1144.2 +015300 02 FILLER PIC X(28) VALUE NC1144.2 +015400 " COPY - NOT FOR DISTRIBUTION". NC1144.2 +015500 02 FILLER PIC X(41) VALUE SPACE. NC1144.2 +015600 NC1144.2 +015700 01 CCVS-H-2B. NC1144.2 +015800 02 FILLER PIC X(15) VALUE NC1144.2 +015900 "TEST RESULT OF ". NC1144.2 +016000 02 TEST-ID PIC X(9). NC1144.2 +016100 02 FILLER PIC X(4) VALUE NC1144.2 +016200 " IN ". NC1144.2 +016300 02 FILLER PIC X(12) VALUE NC1144.2 +016400 " HIGH ". NC1144.2 +016500 02 FILLER PIC X(22) VALUE NC1144.2 +016600 " LEVEL VALIDATION FOR ". NC1144.2 +016700 02 FILLER PIC X(58) VALUE NC1144.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +016900 01 CCVS-H-3. NC1144.2 +017000 02 FILLER PIC X(34) VALUE NC1144.2 +017100 " FOR OFFICIAL USE ONLY ". NC1144.2 +017200 02 FILLER PIC X(58) VALUE NC1144.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1144.2 +017400 02 FILLER PIC X(28) VALUE NC1144.2 +017500 " COPYRIGHT 1985 ". NC1144.2 +017600 01 CCVS-E-1. NC1144.2 +017700 02 FILLER PIC X(52) VALUE SPACE. NC1144.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1144.2 +017900 02 ID-AGAIN PIC X(9). NC1144.2 +018000 02 FILLER PIC X(45) VALUE SPACES. NC1144.2 +018100 01 CCVS-E-2. NC1144.2 +018200 02 FILLER PIC X(31) VALUE SPACE. NC1144.2 +018300 02 FILLER PIC X(21) VALUE SPACE. NC1144.2 +018400 02 CCVS-E-2-2. NC1144.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1144.2 +018600 03 FILLER PIC X VALUE SPACE. NC1144.2 +018700 03 ENDER-DESC PIC X(44) VALUE NC1144.2 +018800 "ERRORS ENCOUNTERED". NC1144.2 +018900 01 CCVS-E-3. NC1144.2 +019000 02 FILLER PIC X(22) VALUE NC1144.2 +019100 " FOR OFFICIAL USE ONLY". NC1144.2 +019200 02 FILLER PIC X(12) VALUE SPACE. NC1144.2 +019300 02 FILLER PIC X(58) VALUE NC1144.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +019500 02 FILLER PIC X(13) VALUE SPACE. NC1144.2 +019600 02 FILLER PIC X(15) VALUE NC1144.2 +019700 " COPYRIGHT 1985". NC1144.2 +019800 01 CCVS-E-4. NC1144.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1144.2 +020000 02 FILLER PIC X(4) VALUE " OF ". NC1144.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1144.2 +020200 02 FILLER PIC X(40) VALUE NC1144.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". NC1144.2 +020400 01 XXINFO. NC1144.2 +020500 02 FILLER PIC X(19) VALUE NC1144.2 +020600 "*** INFORMATION ***". NC1144.2 +020700 02 INFO-TEXT. NC1144.2 +020800 04 FILLER PIC X(8) VALUE SPACE. NC1144.2 +020900 04 XXCOMPUTED PIC X(20). NC1144.2 +021000 04 FILLER PIC X(5) VALUE SPACE. NC1144.2 +021100 04 XXCORRECT PIC X(20). NC1144.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). NC1144.2 +021300 01 HYPHEN-LINE. NC1144.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. NC1144.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************NC1144.2 +021600- "*****************************************". NC1144.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************NC1144.2 +021800- "******************************". NC1144.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE NC1144.2 +022000 "NC114M". NC1144.2 +022100 PROCEDURE DIVISION. NC1144.2 +022200 CCVS1 SECTION. NC1144.2 +022300 OPEN-FILES. NC1144.2 +022400 OPEN OUTPUT PRINT-FILE. NC1144.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1144.2 +022600 MOVE SPACE TO TEST-RESULTS. NC1144.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1144.2 +022800 GO TO CCVS1-EXIT. NC1144.2 +022900 CLOSE-FILES. NC1144.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1144.2 +023100 TERMINATE-CCVS. NC1144.2 +023200S EXIT PROGRAM. NC1144.2 +023300STERMINATE-CALL. NC1144.2 +023400 STOP RUN. NC1144.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1144.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1144.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1144.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1144.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. NC1144.2 +024000 PRINT-DETAIL. NC1144.2 +024100 IF REC-CT NOT EQUAL TO ZERO NC1144.2 +024200 MOVE "." TO PARDOT-X NC1144.2 +024300 MOVE REC-CT TO DOTVALUE. NC1144.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1144.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1144.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1144.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1144.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1144.2 +024900 MOVE SPACE TO CORRECT-X. NC1144.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1144.2 +025100 MOVE SPACE TO RE-MARK. NC1144.2 +025200 HEAD-ROUTINE. NC1144.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1144.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1144.2 +025700 COLUMN-NAMES-ROUTINE. NC1144.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +026100 END-ROUTINE. NC1144.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1144.2 +026300 END-RTN-EXIT. NC1144.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +026500 END-ROUTINE-1. NC1144.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1144.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1144.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. NC1144.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1144.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1144.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1144.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1144.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1144.2 +027400 END-ROUTINE-12. NC1144.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1144.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1144.2 +027700 MOVE "NO " TO ERROR-TOTAL NC1144.2 +027800 ELSE NC1144.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1144.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1144.2 +028100 PERFORM WRITE-LINE. NC1144.2 +028200 END-ROUTINE-13. NC1144.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1144.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE NC1144.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1144.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1144.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO NC1144.2 +028900 MOVE "NO " TO ERROR-TOTAL NC1144.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1144.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1144.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +029400 WRITE-LINE. NC1144.2 +029500 ADD 1 TO RECORD-COUNT. NC1144.2 +029600Y IF RECORD-COUNT GREATER 42 NC1144.2 +029700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1144.2 +029800Y MOVE SPACE TO DUMMY-RECORD NC1144.2 +029900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1144.2 +030000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1144.2 +030100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1144.2 +030200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1144.2 +030300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1144.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1144.2 +030800Y MOVE ZERO TO RECORD-COUNT. NC1144.2 +030900 PERFORM WRT-LN. NC1144.2 +031000 WRT-LN. NC1144.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1144.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC1144.2 +031300 BLANK-LINE-PRINT. NC1144.2 +031400 PERFORM WRT-LN. NC1144.2 +031500 FAIL-ROUTINE. NC1144.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE NC1144.2 +031700 GO TO FAIL-ROUTINE-WRITE. NC1144.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1144.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1144.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1144.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1144.2 +032300 GO TO FAIL-ROUTINE-EX. NC1144.2 +032400 FAIL-ROUTINE-WRITE. NC1144.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1144.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1144.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1144.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1144.2 +032900 FAIL-ROUTINE-EX. EXIT. NC1144.2 +033000 BAIL-OUT. NC1144.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1144.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1144.2 +033300 BAIL-OUT-WRITE. NC1144.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1144.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1144.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1144.2 +033800 BAIL-OUT-EX. EXIT. NC1144.2 +033900 CCVS1-EXIT. NC1144.2 +034000 EXIT. NC1144.2 +034100/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +034200* NULL1-NU-L-TEST-13 NC1144.2 +034300 0 SECTION. NC1144.2 +034400 NULL1 SECTION. NC1144.2 +034500 NU-L SECTION .NC1144.2 +034600 A. NC1144.2 +034700 B . NC1144.2 +034800 C . NC1144.2 +034900 D . NC1144.2 +035000 THE-END. NC1144.2 +035100 EXIT. NC1144.2 +035200/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +035300* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +035400 SECT-NC114-1 SECTION. NC1144.2 +035500 ALPHA-EDIT-TEST-4. NC1144.2 +035600 IF WRK-AE-1 EQUAL TO "ABC" NEXT SENTENCE ELSE MOVE "ABC" TO NC1144.2 +035700 CORRECT-A GO TO ALPHA-EDIT-FAIL-4. NC1144.2 +035800 MOVE "DEF" TO WRK-AE-1. NC1144.2 +035900 IF WRK-AE-1 EQUAL TO "D E" PERFORM PASS NC1144.2 +036000 GO TO ALPHA-EDIT-WRITE-4 ELSE MOVE "D E" TO CORRECT-A NC1144.2 +036100 GO TO ALPHA-EDIT-FAIL-4. NC1144.2 +036200 ALPHA-EDIT-DELETE-4. NC1144.2 +036300 PERFORM DE-LETE. NC1144.2 +036400 GO TO ALPHA-EDIT-WRITE-4. NC1144.2 +036500 ALPHA-EDIT-FAIL-4. NC1144.2 +036600 PERFORM FAIL. NC1144.2 +036700 MOVE WRK-AE-1 TO COMPUTED-A. NC1144.2 +036800 ALPHA-EDIT-WRITE-4. NC1144.2 +036900 MOVE "ALPHA-ED-TEST-4" TO PAR-NAME. NC1144.2 +037000 MOVE "B AS EDIT CHARACTER" TO FEATURE. NC1144.2 +037100 PERFORM PRINT-DETAIL. NC1144.2 +037200* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +037300 ALPHA-EDIT-TEST-5. NC1144.2 +037400 MOVE "ABC" TO WRK-AE-2. NC1144.2 +037500 IF WRK-AE-2 EQUAL TO "A/BC" PERFORM PASS NC1144.2 +037600 GO TO ALPHA-EDIT-WRITE-5 ELSE GO TO ALPHA-EDIT-FAIL-5. NC1144.2 +037700 ALPHA-EDIT-DELETE-5. NC1144.2 +037800 PERFORM DE-LETE. NC1144.2 +037900 GO TO ALPHA-EDIT-WRITE-5. NC1144.2 +038000 ALPHA-EDIT-FAIL-5. NC1144.2 +038100 PERFORM FAIL. NC1144.2 +038200 MOVE WRK-AE-2 TO COMPUTED-A. NC1144.2 +038300 MOVE "A/BC" TO CORRECT-A. NC1144.2 +038400 ALPHA-EDIT-WRITE-5. NC1144.2 +038500 MOVE "ALPHA-ED-TEST-5" TO PAR-NAME. NC1144.2 +038600 MOVE "/ AS EDIT CHARACTER" TO FEATURE. NC1144.2 +038700 PERFORM PRINT-DETAIL. NC1144.2 +038800 NUM-EDIT-TEST-6. NC1144.2 +038900 MOVE 123 TO WRK-NE-1. NC1144.2 +039000 IF WRK-NE-1 EQUAL TO "1/23" PERFORM PASS NC1144.2 +039100 GO TO NUM-EDIT-WRITE-6 ELSE GO TO NUM-EDIT-FAIL-6. NC1144.2 +039200 NUM-EDIT-DELETE-6. NC1144.2 +039300 PERFORM DE-LETE. NC1144.2 +039400 GO TO NUM-EDIT-WRITE-6. NC1144.2 +039500 NUM-EDIT-FAIL-6. NC1144.2 +039600 PERFORM FAIL. NC1144.2 +039700 MOVE WRK-NE-1 TO COMPUTED-A. NC1144.2 +039800 MOVE "1/23" TO CORRECT-A. NC1144.2 +039900 NUM-EDIT-WRITE-6. NC1144.2 +040000 MOVE "NUM-EDIT-TEST-6" TO PAR-NAME. NC1144.2 +040100 MOVE "/ AS EDIT CHARACTER" TO FEATURE. NC1144.2 +040200 PERFORM PRINT-DETAIL. NC1144.2 +040300* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +040400 ELEM-MOVE-TEST-16. NC1144.2 +040500 MOVE WRK-DS-LS-1P17-1 TO WRK-XN-18-2. NC1144.2 +040600 IF WRK-XN-18-2 EQUAL TO "100000000000000000" PERFORM PASS NC1144.2 +040700 GO TO ELEM-MOVE-WRITE-16. NC1144.2 +040800 GO TO ELEM-MOVE-FAIL-16. NC1144.2 +040900 ELEM-MOVE-DELETE-16. NC1144.2 +041000 PERFORM DE-LETE. NC1144.2 +041100 GO TO ELEM-MOVE-WRITE-16. NC1144.2 +041200 ELEM-MOVE-FAIL-16. NC1144.2 +041300 PERFORM FAIL. NC1144.2 +041400 MOVE WRK-XN-18-2 TO COMPUTED-A. NC1144.2 +041500 MOVE "100000000000000000" TO CORRECT-A. NC1144.2 +041600 ELEM-MOVE-WRITE-16. NC1144.2 +041700 MOVE "MOVE-TEST-16" TO PAR-NAME. NC1144.2 +041800 MOVE "STRIP MINUS SIGN" TO FEATURE. NC1144.2 +041900 PERFORM PRINT-DETAIL. NC1144.2 +042000 ELEM-MOVE-TEST-17. NC1144.2 +042100 MOVE WRK-DS-LS-1P17-1 TO WRK-AE-3. NC1144.2 +042200 IF WRK-AE-3 EQUAL TO "1 000/000/000/000/000 00" NC1144.2 +042300 PERFORM PASS GO TO ELEM-MOVE-WRITE-17. NC1144.2 +042400 GO TO ELEM-MOVE-FAIL-17. NC1144.2 +042500 ELEM-MOVE-DELETE-17. NC1144.2 +042600 PERFORM DE-LETE. NC1144.2 +042700 GO TO ELEM-MOVE-WRITE-17. NC1144.2 +042800 ELEM-MOVE-FAIL-17. NC1144.2 +042900 PERFORM FAIL. NC1144.2 +043000 MOVE WRK-AE-3 TO COMPUTED-A. NC1144.2 +043100 MOVE "1 000/000/000/000/000 00" TO CORRECT-A. NC1144.2 +043200 ELEM-MOVE-WRITE-17. NC1144.2 +043300 MOVE "MOVE-TEST-17" TO PAR-NAME. NC1144.2 +043400 MOVE "/ AND B EDITS" TO FEATURE. NC1144.2 +043500 PERFORM PRINT-DETAIL. NC1144.2 +043600 TEST-19-SYNTAX. NC1144.2 +043700 PERFORM END-ROUTINE. NC1144.2 +043800 MOVE ZERO TO REC-CT. NC1144.2 +043900 MOVE SPACE TO TEST-RESULTS. NC1144.2 +044000 MOVE " PICTURE AB9 ** CHECK DATA DIV." TO TEST-RESULTS. NC1144.2 +044100 PERFORM PRINT-DETAIL. NC1144.2 +044200* NC1144.2 +044300* THE FOLLOWING LINES HAVE SPECIAL CHARACTERS IN THE NC1144.2 +044400* SEQUENCE AREA (COLS 1-6) AND MANUAL VERIFICATION OF NC1144.2 +044500* THEIR POSITION ON THE COMPILATION LISTING IS REQUESTED NC1144.2 +044600* IN THE REPORT. NC1144.2 +044700* NC1144.2 +044800 SEQ-NUM-TEST-1. NC1144.2 +044900 MOVE "IV-44 7.2.1" TO ANSI-REFERENCE. NC1144.2 +045000 MOVE SPACES TO TEST-RESULTS. NC1144.2 +045100 MOVE "SEQUENCE NUMBER AREA" TO FEATURE. NC1144.2 +045200 MOVE "SEQ-NUM-TEST-1" TO PAR-NAME. NC1144.2 +045300 PERFORM PRINT-DETAIL. NC1144.2 +045400 MOVE " PLEASE VERIFY THAT THE FOLLOWING ENTRIES" NC1144.2 +045500 TO RE-MARK. NC1144.2 +045600 PERFORM PRINT-DETAIL. NC1144.2 +045700 MOVE " ARE PRINTED IN THE SEQUENCE NUMBER AREA" NC1144.2 +045800 TO RE-MARK. NC1144.2 +045900 PERFORM PRINT-DETAIL. NC1144.2 +046000 MOVE " (COLUMNS 1-6) NEAR THE END OF THE " NC1144.2 +046100 TO RE-MARK. NC1144.2 +046200 PERFORM PRINT-DETAIL. NC1144.2 +046300 MOVE " COMPILATION LISTING FOR NC114M: " NC1144.2 +046400 TO RE-MARK. NC1144.2 +046500 PERFORM PRINT-DETAIL. NC1144.2 +046600 MOVE SPACES TO TEST-RESULTS. NC1144.2 +046700 MOVE " COLUMNS: 123456" TO RE-MARK. NC1144.2 +046800 PERFORM PRINT-DETAIL. NC1144.2 +046900 MOVE " =======: ======" TO RE-MARK. NC1144.2 +047000 PERFORM PRINT-DETAIL. NC1144.2 +047100 MOVE " ENTRY-1: ABCDEF" TO RE-MARK. NC1144.2 +047200 PERFORM PRINT-DETAIL. NC1144.2 +047300 MOVE " ENTRY-2: */+(>'" TO RE-MARK. NC1144.2 +047400 PERFORM PRINT-DETAIL. NC1144.2 +047500 MOVE " ENTRY-3: 999-99" TO RE-MARK. NC1144.2 +047600 PERFORM PRINT-DETAIL. NC1144.2 +047700 MOVE " ENTRY-4: Z=.,;<" TO RE-MARK. NC1144.2 +047800 PERFORM PRINT-DETAIL. NC1144.2 +047900 MOVE " ENTRY-5: )14$ X" TO RE-MARK. NC1144.2 +048000 PERFORM PRINT-DETAIL. NC1144.2 +048100 MOVE " ENTRY-6: 23 4" TO RE-MARK. NC1144.2 +048200 PERFORM PRINT-DETAIL. NC1144.2 +048300 PERFORM INSPT. NC1144.2 +048400* NC1144.2 +048500 NC1144.2 +ABCDEF +*/+(>' +999-99 +Z=.,;< +)14$ X + 23 4 +049200 NC1144.2 +049300 NC1144.2 +049400 NC1144.2 +049500 NC1144.2 +049600* NC1144.2 +049700 CCVS-EXIT SECTION. NC1144.2 +049800 CCVS-999999. NC1144.2 +049900 GO TO CLOSE-FILES. NC1144.2 +050000* ASTERISK COMMENT AS THE LAST LINE IN THE SOURCE PROGRAM LISTING NC1144.2 +*END-OF,NC114M +*HEADER,COBOL,NC115A +000100 IDENTIFICATION DIVISION. NC1154.2 +000200 PROGRAM-ID. NC1154.2 +000300 NC115A. NC1154.2 +000400**************************************************************** NC1154.2 +000500* * NC1154.2 +000600* VALIDATION FOR:- * NC1154.2 +000700* * NC1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +000900* * NC1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1154.2 +001100* * NC1154.2 +001200**************************************************************** NC1154.2 +001300* * NC1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1154.2 +001500* * NC1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1154.2 +001900* * NC1154.2 +002000**************************************************************** NC1154.2 +002100* NC1154.2 +002200* PROGRAM NC115A TESTS FORMATS 1, 2, AND 3 OF NC1154.2 +002300* THE INSPECT STATEMENT. NC1154.2 +002400* NC1154.2 +002500******************************************************************NC1154.2 +002600 ENVIRONMENT DIVISION. NC1154.2 +002700 CONFIGURATION SECTION. NC1154.2 +002800 SOURCE-COMPUTER. NC1154.2 +002900 XXXXX082. NC1154.2 +003000 OBJECT-COMPUTER. NC1154.2 +003100 XXXXX083. NC1154.2 +003200 INPUT-OUTPUT SECTION. NC1154.2 +003300 FILE-CONTROL. NC1154.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1154.2 +003500 XXXXX055. NC1154.2 +003600 DATA DIVISION. NC1154.2 +003700 FILE SECTION. NC1154.2 +003800 FD PRINT-FILE. NC1154.2 +003900 01 PRINT-REC PICTURE X(120). NC1154.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1154.2 +004100 WORKING-STORAGE SECTION. NC1154.2 +004200 01 WRK-DU-999-1 PIC 999. NC1154.2 +004300 01 WRK-DU-999-2 PIC 999. NC1154.2 +004400 01 WRK-DU-999-3 PIC 999. NC1154.2 +004500 01 WRK-DU-999-4 PIC 999. NC1154.2 +004600 01 JUST-XN-20-1 PIC X(20) JUSTIFIED. NC1154.2 +004700 01 SPACE-XN-1-1 PIC X VALUE SPACE. NC1154.2 +004800 01 COMMA-XN-1-1 PIC X VALUE ",". NC1154.2 +004900 01 HYPEN-XN-1-1 PIC X VALUE "-". NC1154.2 +005000 01 A-XN-1-1 PIC X VALUE "A". NC1154.2 +005100 01 D-XN-1-1 PIC X VALUE "D". NC1154.2 +005200 01 G-XN-1-1 PIC X VALUE "G". NC1154.2 +005300 01 H-XN-1-1 PIC X VALUE "H". NC1154.2 +005400 01 L-XN-1-1 PIC X VALUE "L". NC1154.2 +005500 01 O-XN-1-1 PIC X VALUE "O". NC1154.2 +005600 01 P-XN-1-1 PIC X VALUE "P". NC1154.2 +005700 01 S-XN-1-1 PIC X VALUE "S". NC1154.2 +005800 01 Z-XN-1-1 PIC X VALUE "Z". NC1154.2 +005900 01 WRK-OK. NC1154.2 +006000 03 WRK-OK-1-20 PIC X(20). NC1154.2 +006100 03 WRK-OK-21-40 PIC X(20). NC1154.2 +006200 03 WRK-OK-41-60 PIC X(20). NC1154.2 +006300 03 WRK-OK-61-80 PIC X(20). NC1154.2 +006400 03 WRK-OK-81-83 PIC X(3). NC1154.2 +006500 01 WRK-ER. NC1154.2 +006600 03 WRK-ER-1-20 PIC X(20). NC1154.2 +006700 03 WRK-ER-21-40 PIC X(20). NC1154.2 +006800 03 WRK-ER-41-60 PIC X(20). NC1154.2 +006900 03 WRK-ER-61-80 PIC X(20). NC1154.2 +007000 03 WRK-ER-81-83 PIC X(3). NC1154.2 +007100 NC1154.2 +007200 01 WRK-XN-83-1 PIC X(83). NC1154.2 +007300 01 WC-XN-83 PIC X(83) VALUE NC1154.2 +007400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +007500- "IDS CAN NOT BE ALL BAD.". NC1154.2 +007600 01 ANS-XN-83-1 PIC X(83) VALUE NC1154.2 +007700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +007800- "IDS CAN NOT BE ALL BAD.". NC1154.2 +007900 01 ANS-XN-83-2 PIC X(83) VALUE NC1154.2 +008000 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008100- "IDS CAN NOT BE ALL BAD.". NC1154.2 +008200 01 ANS-XN-83-3 PIC X(83) VALUE NC1154.2 +008300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008400- "IDS CAN NOT BE ALL-BAD.". NC1154.2 +008500 01 ANS-XN-83-4 PIC X(83) VALUE NC1154.2 +008600 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008700- "IDS CAN NOT BE ALL BAD.". NC1154.2 +008800 01 ANS-XN-83-5 PIC X(83) VALUE NC1154.2 +008900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +009000- "IDS CAN NOT BE ALL BAD.". NC1154.2 +009100 01 ANS-XN-83-6 PIC X(83) VALUE NC1154.2 +009200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +009300- "IDS CAN NOT BE ALZZZZZZ". NC1154.2 +009400 01 ANS-XN-83-7 PIC X(83) VALUE NC1154.2 +009500 "OH-YES-AH-YES-W.P.-ZRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC1154.2 +009600- "IDS-CAN-NOT-BE-ALZZZZZZ". NC1154.2 +009700 01 TEST-RESULTS. NC1154.2 +009800 02 FILLER PIC X VALUE SPACE. NC1154.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. NC1154.2 +010000 02 FILLER PIC X VALUE SPACE. NC1154.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. NC1154.2 +010200 02 FILLER PIC X VALUE SPACE. NC1154.2 +010300 02 PAR-NAME. NC1154.2 +010400 03 FILLER PIC X(19) VALUE SPACE. NC1154.2 +010500 03 PARDOT-X PIC X VALUE SPACE. NC1154.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. NC1154.2 +010700 02 FILLER PIC X(8) VALUE SPACE. NC1154.2 +010800 02 RE-MARK PIC X(61). NC1154.2 +010900 01 TEST-COMPUTED. NC1154.2 +011000 02 FILLER PIC X(30) VALUE SPACE. NC1154.2 +011100 02 FILLER PIC X(17) VALUE NC1154.2 +011200 " COMPUTED=". NC1154.2 +011300 02 COMPUTED-X. NC1154.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1154.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A NC1154.2 +011600 PIC -9(9).9(9). NC1154.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1154.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1154.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1154.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. NC1154.2 +012100 04 COMPUTED-18V0 PIC -9(18). NC1154.2 +012200 04 FILLER PIC X. NC1154.2 +012300 03 FILLER PIC X(50) VALUE SPACE. NC1154.2 +012400 01 TEST-CORRECT. NC1154.2 +012500 02 FILLER PIC X(30) VALUE SPACE. NC1154.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1154.2 +012700 02 CORRECT-X. NC1154.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1154.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1154.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1154.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1154.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1154.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. NC1154.2 +013400 04 CORRECT-18V0 PIC -9(18). NC1154.2 +013500 04 FILLER PIC X. NC1154.2 +013600 03 FILLER PIC X(2) VALUE SPACE. NC1154.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1154.2 +013800 01 CCVS-C-1. NC1154.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1154.2 +014000- "SS PARAGRAPH-NAME NC1154.2 +014100- " REMARKS". NC1154.2 +014200 02 FILLER PIC X(20) VALUE SPACE. NC1154.2 +014300 01 CCVS-C-2. NC1154.2 +014400 02 FILLER PIC X VALUE SPACE. NC1154.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". NC1154.2 +014600 02 FILLER PIC X(15) VALUE SPACE. NC1154.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". NC1154.2 +014800 02 FILLER PIC X(94) VALUE SPACE. NC1154.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1154.2 +015000 01 REC-CT PIC 99 VALUE ZERO. NC1154.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1154.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1154.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1154.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1154.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1154.2 +016000 01 CCVS-H-1. NC1154.2 +016100 02 FILLER PIC X(39) VALUE SPACES. NC1154.2 +016200 02 FILLER PIC X(42) VALUE NC1154.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1154.2 +016400 02 FILLER PIC X(39) VALUE SPACES. NC1154.2 +016500 01 CCVS-H-2A. NC1154.2 +016600 02 FILLER PIC X(40) VALUE SPACE. NC1154.2 +016700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1154.2 +016800 02 FILLER PIC XXXX VALUE NC1154.2 +016900 "4.2 ". NC1154.2 +017000 02 FILLER PIC X(28) VALUE NC1154.2 +017100 " COPY - NOT FOR DISTRIBUTION". NC1154.2 +017200 02 FILLER PIC X(41) VALUE SPACE. NC1154.2 +017300 NC1154.2 +017400 01 CCVS-H-2B. NC1154.2 +017500 02 FILLER PIC X(15) VALUE NC1154.2 +017600 "TEST RESULT OF ". NC1154.2 +017700 02 TEST-ID PIC X(9). NC1154.2 +017800 02 FILLER PIC X(4) VALUE NC1154.2 +017900 " IN ". NC1154.2 +018000 02 FILLER PIC X(12) VALUE NC1154.2 +018100 " HIGH ". NC1154.2 +018200 02 FILLER PIC X(22) VALUE NC1154.2 +018300 " LEVEL VALIDATION FOR ". NC1154.2 +018400 02 FILLER PIC X(58) VALUE NC1154.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +018600 01 CCVS-H-3. NC1154.2 +018700 02 FILLER PIC X(34) VALUE NC1154.2 +018800 " FOR OFFICIAL USE ONLY ". NC1154.2 +018900 02 FILLER PIC X(58) VALUE NC1154.2 +019000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1154.2 +019100 02 FILLER PIC X(28) VALUE NC1154.2 +019200 " COPYRIGHT 1985 ". NC1154.2 +019300 01 CCVS-E-1. NC1154.2 +019400 02 FILLER PIC X(52) VALUE SPACE. NC1154.2 +019500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1154.2 +019600 02 ID-AGAIN PIC X(9). NC1154.2 +019700 02 FILLER PIC X(45) VALUE SPACES. NC1154.2 +019800 01 CCVS-E-2. NC1154.2 +019900 02 FILLER PIC X(31) VALUE SPACE. NC1154.2 +020000 02 FILLER PIC X(21) VALUE SPACE. NC1154.2 +020100 02 CCVS-E-2-2. NC1154.2 +020200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1154.2 +020300 03 FILLER PIC X VALUE SPACE. NC1154.2 +020400 03 ENDER-DESC PIC X(44) VALUE NC1154.2 +020500 "ERRORS ENCOUNTERED". NC1154.2 +020600 01 CCVS-E-3. NC1154.2 +020700 02 FILLER PIC X(22) VALUE NC1154.2 +020800 " FOR OFFICIAL USE ONLY". NC1154.2 +020900 02 FILLER PIC X(12) VALUE SPACE. NC1154.2 +021000 02 FILLER PIC X(58) VALUE NC1154.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +021200 02 FILLER PIC X(13) VALUE SPACE. NC1154.2 +021300 02 FILLER PIC X(15) VALUE NC1154.2 +021400 " COPYRIGHT 1985". NC1154.2 +021500 01 CCVS-E-4. NC1154.2 +021600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1154.2 +021700 02 FILLER PIC X(4) VALUE " OF ". NC1154.2 +021800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1154.2 +021900 02 FILLER PIC X(40) VALUE NC1154.2 +022000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1154.2 +022100 01 XXINFO. NC1154.2 +022200 02 FILLER PIC X(19) VALUE NC1154.2 +022300 "*** INFORMATION ***". NC1154.2 +022400 02 INFO-TEXT. NC1154.2 +022500 04 FILLER PIC X(8) VALUE SPACE. NC1154.2 +022600 04 XXCOMPUTED PIC X(20). NC1154.2 +022700 04 FILLER PIC X(5) VALUE SPACE. NC1154.2 +022800 04 XXCORRECT PIC X(20). NC1154.2 +022900 02 INF-ANSI-REFERENCE PIC X(48). NC1154.2 +023000 01 HYPHEN-LINE. NC1154.2 +023100 02 FILLER PIC IS X VALUE IS SPACE. NC1154.2 +023200 02 FILLER PIC IS X(65) VALUE IS "************************NC1154.2 +023300- "*****************************************". NC1154.2 +023400 02 FILLER PIC IS X(54) VALUE IS "************************NC1154.2 +023500- "******************************". NC1154.2 +023600 01 CCVS-PGM-ID PIC X(9) VALUE NC1154.2 +023700 "NC115A". NC1154.2 +023800 PROCEDURE DIVISION. NC1154.2 +023900 CCVS1 SECTION. NC1154.2 +024000 OPEN-FILES. NC1154.2 +024100 OPEN OUTPUT PRINT-FILE. NC1154.2 +024200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1154.2 +024300 MOVE SPACE TO TEST-RESULTS. NC1154.2 +024400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1154.2 +024500 GO TO CCVS1-EXIT. NC1154.2 +024600 CLOSE-FILES. NC1154.2 +024700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1154.2 +024800 TERMINATE-CCVS. NC1154.2 +024900S EXIT PROGRAM. NC1154.2 +025000STERMINATE-CALL. NC1154.2 +025100 STOP RUN. NC1154.2 +025200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1154.2 +025300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1154.2 +025400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1154.2 +025500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1154.2 +025600 MOVE "****TEST DELETED****" TO RE-MARK. NC1154.2 +025700 PRINT-DETAIL. NC1154.2 +025800 IF REC-CT NOT EQUAL TO ZERO NC1154.2 +025900 MOVE "." TO PARDOT-X NC1154.2 +026000 MOVE REC-CT TO DOTVALUE. NC1154.2 +026100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1154.2 +026200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1154.2 +026300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1154.2 +026400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1154.2 +026500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1154.2 +026600 MOVE SPACE TO CORRECT-X. NC1154.2 +026700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1154.2 +026800 MOVE SPACE TO RE-MARK. NC1154.2 +026900 HEAD-ROUTINE. NC1154.2 +027000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1154.2 +027300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1154.2 +027400 COLUMN-NAMES-ROUTINE. NC1154.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +027800 END-ROUTINE. NC1154.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1154.2 +028000 END-RTN-EXIT. NC1154.2 +028100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +028200 END-ROUTINE-1. NC1154.2 +028300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1154.2 +028400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1154.2 +028500 ADD PASS-COUNTER TO ERROR-HOLD. NC1154.2 +028600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1154.2 +028700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1154.2 +028800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1154.2 +028900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1154.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1154.2 +029100 END-ROUTINE-12. NC1154.2 +029200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1154.2 +029300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1154.2 +029400 MOVE "NO " TO ERROR-TOTAL NC1154.2 +029500 ELSE NC1154.2 +029600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1154.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1154.2 +029800 PERFORM WRITE-LINE. NC1154.2 +029900 END-ROUTINE-13. NC1154.2 +030000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1154.2 +030100 MOVE "NO " TO ERROR-TOTAL ELSE NC1154.2 +030200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1154.2 +030300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1154.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +030500 IF INSPECT-COUNTER EQUAL TO ZERO NC1154.2 +030600 MOVE "NO " TO ERROR-TOTAL NC1154.2 +030700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1154.2 +030800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1154.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +031000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +031100 WRITE-LINE. NC1154.2 +031200 ADD 1 TO RECORD-COUNT. NC1154.2 +031300Y IF RECORD-COUNT GREATER 42 NC1154.2 +031400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1154.2 +031500Y MOVE SPACE TO DUMMY-RECORD NC1154.2 +031600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1154.2 +031700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1154.2 +031800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1154.2 +031900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1154.2 +032000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1154.2 +032100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1154.2 +032500Y MOVE ZERO TO RECORD-COUNT. NC1154.2 +032600 PERFORM WRT-LN. NC1154.2 +032700 WRT-LN. NC1154.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1154.2 +032900 MOVE SPACE TO DUMMY-RECORD. NC1154.2 +033000 BLANK-LINE-PRINT. NC1154.2 +033100 PERFORM WRT-LN. NC1154.2 +033200 FAIL-ROUTINE. NC1154.2 +033300 IF COMPUTED-X NOT EQUAL TO SPACE NC1154.2 +033400 GO TO FAIL-ROUTINE-WRITE. NC1154.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1154.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1154.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1154.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1154.2 +034000 GO TO FAIL-ROUTINE-EX. NC1154.2 +034100 FAIL-ROUTINE-WRITE. NC1154.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1154.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1154.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1154.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1154.2 +034600 FAIL-ROUTINE-EX. EXIT. NC1154.2 +034700 BAIL-OUT. NC1154.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1154.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1154.2 +035000 BAIL-OUT-WRITE. NC1154.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1154.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1154.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1154.2 +035500 BAIL-OUT-EX. EXIT. NC1154.2 +035600 CCVS1-EXIT. NC1154.2 +035700 EXIT. NC1154.2 +035800 SECT-NC115A-001 SECTION. NC1154.2 +035900 INSP-INIT-F1-1. NC1154.2 +036000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +036100 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +036200 INSP-TEST-F1-1-0. NC1154.2 +036300 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS. NC1154.2 +036400 INSP-TEST-F1-1-1. NC1154.2 +036500 IF WRK-DU-999-1 EQUAL TO 83 NC1154.2 +036600 PERFORM PASS NC1154.2 +036700 GO TO INSP-WRITE-F1-1. NC1154.2 +036800 GO TO INSP-FAIL-F1-1. NC1154.2 +036900 INSP-DELETE-F1-1. NC1154.2 +037000 PERFORM DE-LETE. NC1154.2 +037100 GO TO INSP-WRITE-F1-1. NC1154.2 +037200 INSP-FAIL-F1-1. NC1154.2 +037300 PERFORM FAIL. NC1154.2 +037400 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +037500 MOVE 83 TO CORRECT-N. NC1154.2 +037600 INSP-WRITE-F1-1. NC1154.2 +037700 MOVE "INSP-TEST-F1-1" TO PAR-NAME. NC1154.2 +037800 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC1154.2 +037900 PERFORM PRINT-DETAIL. NC1154.2 +038000 INSP-INIT-F1-2. NC1154.2 +038100 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +038200 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +038300 INSP-TEST-F1-2-0. NC1154.2 +038400 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL "A". NC1154.2 +038500 INSP-TEST-F1-2-1. NC1154.2 +038600 IF WRK-DU-999-1 EQUAL TO 8 NC1154.2 +038700 PERFORM PASS NC1154.2 +038800 GO TO INSP-WRITE-F1-2. NC1154.2 +038900 GO TO INSP-FAIL-F1-2. NC1154.2 +039000 INSP-DELETE-F1-2. NC1154.2 +039100 PERFORM DE-LETE. NC1154.2 +039200 GO TO INSP-WRITE-F1-2. NC1154.2 +039300 INSP-FAIL-F1-2. NC1154.2 +039400 PERFORM FAIL. NC1154.2 +039500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +039600 MOVE 8 TO CORRECT-N. NC1154.2 +039700 INSP-WRITE-F1-2. NC1154.2 +039800 MOVE "INSP-TEST-F1-2" TO PAR-NAME. NC1154.2 +039900 MOVE "TALLY ALL LITERAL" TO FEATURE. NC1154.2 +040000 PERFORM PRINT-DETAIL. NC1154.2 +040100 INSP-INIT-F1-3. NC1154.2 +040200 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +040300 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +040400 INSP-TEST-F1-3-0. NC1154.2 +040500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACE. NC1154.2 +040600 INSP-TEST-F1-3-1. NC1154.2 +040700 IF WRK-DU-999-1 EQUAL TO 17 NC1154.2 +040800 PERFORM PASS NC1154.2 +040900 GO TO INSP-WRITE-F1-3. NC1154.2 +041000 GO TO INSP-FAIL-F1-3. NC1154.2 +041100 INSP-DELETE-F1-3. NC1154.2 +041200 PERFORM DE-LETE. NC1154.2 +041300 GO TO INSP-WRITE-F1-3. NC1154.2 +041400 INSP-FAIL-F1-3. NC1154.2 +041500 PERFORM FAIL. NC1154.2 +041600 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +041700 MOVE 17 TO CORRECT-N. NC1154.2 +041800 INSP-WRITE-F1-3. NC1154.2 +041900 MOVE "INSP-TEST-F1-3" TO PAR-NAME. NC1154.2 +042000 MOVE "TALLY FOR ALL SPACE" TO FEATURE. NC1154.2 +042100 PERFORM PRINT-DETAIL. NC1154.2 +042200 INSP-INIT-F1-4. NC1154.2 +042300 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +042400 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +042500 INSP-TEST-F1-4-0. NC1154.2 +042600 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "A". NC1154.2 +042700 INSP-TEST-F1-4-1. NC1154.2 +042800 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +042900 PERFORM PASS NC1154.2 +043000 GO TO INSP-WRITE-F1-4. NC1154.2 +043100 GO TO INSP-FAIL-F1-4. NC1154.2 +043200 INSP-DELETE-F1-4. NC1154.2 +043300 PERFORM DE-LETE. NC1154.2 +043400 GO TO INSP-WRITE-F1-4. NC1154.2 +043500 INSP-FAIL-F1-4. NC1154.2 +043600 PERFORM FAIL. NC1154.2 +043700 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +043800 MOVE 1 TO CORRECT-N. NC1154.2 +043900 INSP-WRITE-F1-4. NC1154.2 +044000 MOVE "INSP-TEST-F1-4" TO PAR-NAME. NC1154.2 +044100 MOVE "TALLY LEADING LIT" TO FEATURE. NC1154.2 +044200 PERFORM PRINT-DETAIL. NC1154.2 +044300 INSP-INIT-F1-5. NC1154.2 +044400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +044500 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +044600 INSP-TEST-F1-5-0. NC1154.2 +044700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +044800 AFTER "W". NC1154.2 +044900 INSP-TEST-F1-5-1. NC1154.2 +045000 IF WRK-DU-999-1 EQUAL TO 68 NC1154.2 +045100 PERFORM PASS NC1154.2 +045200 GO TO INSP-WRITE-F1-5. NC1154.2 +045300 GO TO INSP-FAIL-F1-5. NC1154.2 +045400 INSP-DELETE-F1-5. NC1154.2 +045500 PERFORM DE-LETE. NC1154.2 +045600 GO TO INSP-WRITE-F1-5. NC1154.2 +045700 INSP-FAIL-F1-5. NC1154.2 +045800 PERFORM FAIL. NC1154.2 +045900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +046000 MOVE 68 TO CORRECT-N. NC1154.2 +046100 INSP-WRITE-F1-5. NC1154.2 +046200 MOVE "INSP-TEST-F1-5" TO PAR-NAME. NC1154.2 +046300 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC1154.2 +046400 PERFORM PRINT-DETAIL. NC1154.2 +046500 INSP-INIT-F1-6. NC1154.2 +046600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +046700 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +046800 INSP-TEST-F1-6-0. NC1154.2 +046900 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL " " NC1154.2 +047000 BEFORE INITIAL "W". NC1154.2 +047100 INSP-TEST-F1-6-1. NC1154.2 +047200 IF WRK-DU-999-1 EQUAL TO 4 NC1154.2 +047300 PERFORM PASS NC1154.2 +047400 GO TO INSP-WRITE-F1-6. NC1154.2 +047500 GO TO INSP-FAIL-F1-6. NC1154.2 +047600 INSP-DELETE-F1-6. NC1154.2 +047700 PERFORM DE-LETE. NC1154.2 +047800 GO TO INSP-WRITE-F1-6. NC1154.2 +047900 INSP-FAIL-F1-6. NC1154.2 +048000 PERFORM FAIL. NC1154.2 +048100 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +048200 MOVE 4 TO CORRECT-N. NC1154.2 +048300 INSP-WRITE-F1-6. NC1154.2 +048400 MOVE "INSP-TEST-F1-6" TO PAR-NAME. NC1154.2 +048500 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC1154.2 +048600 PERFORM PRINT-DETAIL. NC1154.2 +048700 INSP-INIT-F1-7. NC1154.2 +048800 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +048900 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +049000 INSP-TEST-F1-7-0. NC1154.2 +049100 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "Y" NC1154.2 +049200 AFTER INITIAL SPACE. NC1154.2 +049300 INSP-TEST-F1-7-1. NC1154.2 +049400 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +049500 PERFORM PASS NC1154.2 +049600 GO TO INSP-WRITE-F1-7. NC1154.2 +049700 GO TO INSP-FAIL-F1-7. NC1154.2 +049800 INSP-DELETE-F1-7. NC1154.2 +049900 PERFORM DE-LETE. NC1154.2 +050000 GO TO INSP-WRITE-F1-7. NC1154.2 +050100 INSP-FAIL-F1-7. NC1154.2 +050200 PERFORM FAIL. NC1154.2 +050300 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +050400 MOVE 1 TO CORRECT-N. NC1154.2 +050500 INSP-WRITE-F1-7. NC1154.2 +050600 MOVE "INSP-TEST-F1-7" TO PAR-NAME. NC1154.2 +050700 MOVE "LEAD LIT INITIAL FIG" TO FEATURE. NC1154.2 +050800 PERFORM PRINT-DETAIL. NC1154.2 +050900 INSP-INIT-F2-1. NC1154.2 +051000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +051100 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +051200 MOVE "INSP-TEST-F2-1" TO PAR-NAME. NC1154.2 +051300 MOVE "REP CHARS BY SPACE" TO FEATURE. NC1154.2 +051400 INSP-TEST-F2-1-0. NC1154.2 +051500 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACE. NC1154.2 +051600 INSP-TEST-F2-1-1. NC1154.2 +051700 IF WRK-XN-83-1 EQUAL TO SPACE NC1154.2 +051800 PERFORM PASS NC1154.2 +051900 PERFORM PRINT-DETAIL NC1154.2 +052000 GO TO INSP-INIT-F2-2. NC1154.2 +052100 GO TO INSP-FAIL-F2-1. NC1154.2 +052200 INSP-DELETE-F2-1. NC1154.2 +052300 PERFORM DE-LETE. NC1154.2 +052400 PERFORM PRINT-DETAIL. NC1154.2 +052500 GO TO INSP-INIT-F2-2. NC1154.2 +052600 INSP-FAIL-F2-1. NC1154.2 +052700 PERFORM FAIL. NC1154.2 +052800 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +052900 MOVE SPACE TO WRK-OK. NC1154.2 +053000 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +053100 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +053200 PERFORM PRINT-DETAIL. NC1154.2 +053300 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +053400 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +053500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +053600 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +053700 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +053800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +053900 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +054000 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +054100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +054200 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +054300 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +054400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +054500 INSP-INIT-F2-2. NC1154.2 +054600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +054700 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +054800 MOVE "INSP-TEST-F2-2" TO PAR-NAME. NC1154.2 +054900 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC1154.2 +055000 INSP-TEST-F2-2-0. NC1154.2 +055100 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY "O" NC1154.2 +055200 BEFORE INITIAL "H". NC1154.2 +055300 INSP-TEST-F2-2-1. NC1154.2 +055400 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +055500 PERFORM PASS NC1154.2 +055600 PERFORM PRINT-DETAIL NC1154.2 +055700 GO TO INSP-INIT-F2-3. NC1154.2 +055800 GO TO INSP-FAIL-F2-2. NC1154.2 +055900 INSP-DELETE-F2-2. NC1154.2 +056000 PERFORM DE-LETE. NC1154.2 +056100 PERFORM PRINT-DETAIL. NC1154.2 +056200 GO TO INSP-INIT-F2-3. NC1154.2 +056300 INSP-FAIL-F2-2. NC1154.2 +056400 PERFORM FAIL. NC1154.2 +056500 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +056600 MOVE ANS-XN-83-1 TO WRK-OK. NC1154.2 +056700 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +056800 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +056900 PERFORM PRINT-DETAIL. NC1154.2 +057000 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +057100 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +057200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057300 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +057400 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +057500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057600 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +057700 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +057800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057900 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +058000 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +058100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +058200 INSP-INIT-F2-3. NC1154.2 +058300 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +058400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +058500 MOVE "INSP-TEST-F2-3" TO PAR-NAME. NC1154.2 +058600 MOVE "LEAD AFTER INIT ID" TO FEATURE. NC1154.2 +058700 INSP-TEST-F2-3-0. NC1154.2 +058800 INSPECT WRK-XN-83-1 REPLACING LEADING SPACE-XN-1-1 NC1154.2 +058900 BY COMMA-XN-1-1 AFTER INITIAL S-XN-1-1. NC1154.2 +059000 INSP-TEST-F2-3-1. NC1154.2 +059100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-2 NC1154.2 +059200 PERFORM PASS NC1154.2 +059300 PERFORM PRINT-DETAIL NC1154.2 +059400 GO TO INSP-INIT-F2-4. NC1154.2 +059500 GO TO INSP-FAIL-F2-3. NC1154.2 +059600 INSP-DELETE-F2-3. NC1154.2 +059700 PERFORM DE-LETE. NC1154.2 +059800 PERFORM PRINT-DETAIL. NC1154.2 +059900 GO TO INSP-INIT-F2-4. NC1154.2 +060000 INSP-FAIL-F2-3. NC1154.2 +060100 PERFORM FAIL. NC1154.2 +060200 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +060300 MOVE ANS-XN-83-2 TO WRK-OK. NC1154.2 +060400 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +060500 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +060600 PERFORM PRINT-DETAIL. NC1154.2 +060700 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +060800 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +060900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061000 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +061100 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +061200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061300 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +061400 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +061500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061600 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +061700 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +061800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061900 INSP-INIT-F2-4. NC1154.2 +062000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +062100 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +062200 MOVE "INSP-TEST-F2-4" TO PAR-NAME. NC1154.2 +062300 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC1154.2 +062400 INSP-TEST-F2-4-0. NC1154.2 +062500 INSPECT WRK-XN-83-1 REPLACING FIRST "A" BY O-XN-1-1 NC1154.2 +062600 BEFORE INITIAL "H". NC1154.2 +062700 INSP-TEST-F2-4-1. NC1154.2 +062800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +062900 PERFORM PASS NC1154.2 +063000 PERFORM PRINT-DETAIL NC1154.2 +063100 GO TO INSP-INIT-F2-5. NC1154.2 +063200 GO TO INSP-FAIL-F2-4. NC1154.2 +063300 INSP-DELETE-F2-4. NC1154.2 +063400 PERFORM DE-LETE. NC1154.2 +063500 PERFORM PRINT-DETAIL. NC1154.2 +063600 GO TO INSP-INIT-F2-5. NC1154.2 +063700 INSP-FAIL-F2-4. NC1154.2 +063800 PERFORM FAIL. NC1154.2 +063900 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +064000 MOVE ANS-XN-83-1 TO WRK-OK. NC1154.2 +064100 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +064200 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +064300 PERFORM PRINT-DETAIL. NC1154.2 +064400 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +064500 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +064600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +064700 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +064800 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +064900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065000 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +065100 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +065200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065300 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +065400 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +065500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065600 INSP-INIT-F2-5. NC1154.2 +065700 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +065800 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +065900 MOVE "INSP-TEST-F2-5" TO PAR-NAME. NC1154.2 +066000 MOVE "ALL ID BY LIT AFTER" TO FEATURE. NC1154.2 +066100 INSP-TEST-F2-5-0. NC1154.2 +066200 INSPECT WRK-XN-83-1 REPLACING ALL SPACE-XN-1-1 BY "-" NC1154.2 +066300 AFTER L-XN-1-1. NC1154.2 +066400 INSP-TEST-F2-5-1. NC1154.2 +066500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-3 NC1154.2 +066600 PERFORM PASS NC1154.2 +066700 PERFORM PRINT-DETAIL NC1154.2 +066800 GO TO INSP-INIT-F3-1. NC1154.2 +066900 GO TO INSP-FAIL-F2-5. NC1154.2 +067000 INSP-DELETE-F2-5. NC1154.2 +067100 PERFORM DE-LETE. NC1154.2 +067200 PERFORM PRINT-DETAIL. NC1154.2 +067300 GO TO INSP-INIT-F3-1. NC1154.2 +067400 INSP-FAIL-F2-5. NC1154.2 +067500 PERFORM FAIL. NC1154.2 +067600 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +067700 MOVE ANS-XN-83-3 TO WRK-OK. NC1154.2 +067800 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +067900 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +068000 PERFORM PRINT-DETAIL. NC1154.2 +068100 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +068200 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +068300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +068400 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +068500 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +068600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +068700 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +068800 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +068900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +069000 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +069100 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +069200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +069300 INSP-INIT-F3-1. NC1154.2 +069400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +069500 MOVE "INSP-TEST-F3-1" TO PAR-NAME. NC1154.2 +069600 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC1154.2 +069700 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +069800 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +069900 MOVE 1 TO REC-CT. NC1154.2 +070000 INSP-TEST-F3-1-0. NC1154.2 +070100 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +070200 REPLACING CHARACTERS BY " ". NC1154.2 +070300 GO TO TEST-F3-1-1. NC1154.2 +070400 INSP-DELETE-F3-1. NC1154.2 +070500 PERFORM DE-LETE. NC1154.2 +070600 PERFORM PRINT-DETAIL. NC1154.2 +070700 GO TO INSP-INIT-F3-2. NC1154.2 +070800 TEST-F3-1-1. NC1154.2 +070900 IF WRK-DU-999-1 EQUAL TO 83 NC1154.2 +071000 PERFORM PASS NC1154.2 +071100 PERFORM PRINT-DETAIL NC1154.2 +071200 ELSE NC1154.2 +071300 PERFORM FAIL NC1154.2 +071400 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +071500 MOVE 83 TO CORRECT-N NC1154.2 +071600 PERFORM PRINT-DETAIL. NC1154.2 +071700 ADD 1 TO REC-CT. NC1154.2 +071800 TEST-F3-1-2. NC1154.2 +071900 IF WRK-XN-83-1 EQUAL TO SPACE NC1154.2 +072000 PERFORM PASS NC1154.2 +072100 PERFORM PRINT-DETAIL NC1154.2 +072200 ELSE NC1154.2 +072300 PERFORM FAIL NC1154.2 +072400 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +072500 MOVE SPACES TO WRK-OK NC1154.2 +072600 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +072700 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +072800 PERFORM PRINT-DETAIL NC1154.2 +072900 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +073000 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +073100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073200 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +073300 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +073400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073500 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +073600 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +073700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073800 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +073900 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +074000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +074100 INSP-INIT-F3-2. NC1154.2 +074200 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +074300 MOVE "INSP-TEST-F3-2" TO PAR-NAME. NC1154.2 +074400 MOVE "LIT BY BEFORE INIT" TO FEATURE. NC1154.2 +074500 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +074600 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +074700 MOVE 1 TO REC-CT. NC1154.2 +074800 INSP-TEST-F3-2-0. NC1154.2 +074900 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +075000 AFTER L-XN-1-1 REPLACING ALL "A" BY "E" BEFORE INITIAL NC1154.2 +075100 H-XN-1-1. NC1154.2 +075200 GO TO TEST-F3-2-1. NC1154.2 +075300 INSP-DELETE-F3-2. NC1154.2 +075400 PERFORM DE-LETE. NC1154.2 +075500 PERFORM PRINT-DETAIL. NC1154.2 +075600 GO TO INSP-INIT-F3-3. NC1154.2 +075700 TEST-F3-2-1. NC1154.2 +075800 IF WRK-DU-999-1 EQUAL TO 6 NC1154.2 +075900 PERFORM PASS NC1154.2 +076000 PERFORM PRINT-DETAIL NC1154.2 +076100 ELSE NC1154.2 +076200 PERFORM FAIL NC1154.2 +076300 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +076400 MOVE 6 TO CORRECT-N NC1154.2 +076500 PERFORM PRINT-DETAIL. NC1154.2 +076600 ADD 1 TO REC-CT. NC1154.2 +076700 TEST-F3-2-2. NC1154.2 +076800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-4 NC1154.2 +076900 PERFORM PASS NC1154.2 +077000 PERFORM PRINT-DETAIL NC1154.2 +077100 ELSE NC1154.2 +077200 PERFORM FAIL NC1154.2 +077300 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +077400 MOVE ANS-XN-83-4 TO WRK-OK NC1154.2 +077500 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +077600 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +077700 PERFORM PRINT-DETAIL NC1154.2 +077800 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +077900 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +078000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078100 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +078200 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +078300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078400 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +078500 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +078600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078700 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +078800 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +078900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +079000 INSP-INIT-F3-3. NC1154.2 +079100 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +079200 MOVE "INSP-TEST-F3-3" TO PAR-NAME. NC1154.2 +079300 MOVE "REPL FIRST AFTER" TO FEATURE. NC1154.2 +079400 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +079500 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +079600 MOVE 1 TO REC-CT. NC1154.2 +079700 INSP-TEST-F3-3-0. NC1154.2 +079800 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" BEFORE NC1154.2 +079900 L-XN-1-1 REPLACING FIRST A-XN-1-1 BY "O" AFTER NC1154.2 +080000 INITIAL H-XN-1-1. NC1154.2 +080100 GO TO TEST-F3-3-1. NC1154.2 +080200 INSP-DELETE-F3-3. NC1154.2 +080300 PERFORM DE-LETE. NC1154.2 +080400 PERFORM PRINT-DETAIL. NC1154.2 +080500 GO TO INSP-INIT-F3-4. NC1154.2 +080600 TEST-F3-3-1. NC1154.2 +080700 IF WRK-DU-999-1 EQUAL TO 7 NC1154.2 +080800 PERFORM PASS NC1154.2 +080900 PERFORM PRINT-DETAIL NC1154.2 +081000 ELSE NC1154.2 +081100 PERFORM FAIL NC1154.2 +081200 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +081300 MOVE 7 TO CORRECT-N NC1154.2 +081400 PERFORM PRINT-DETAIL. NC1154.2 +081500 ADD 1 TO REC-CT. NC1154.2 +081600 TEST-F3-3-2. NC1154.2 +081700 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC1154.2 +081800 PERFORM PASS NC1154.2 +081900 PERFORM PRINT-DETAIL NC1154.2 +082000 ELSE NC1154.2 +082100 PERFORM FAIL NC1154.2 +082200 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +082300 MOVE ANS-XN-83-5 TO WRK-OK NC1154.2 +082400 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +082500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +082600 PERFORM PRINT-DETAIL NC1154.2 +082700 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +082800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +082900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083000 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +083100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +083200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083300 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +083400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +083500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083600 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +083700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +083800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +083900 INSP-INIT-F3-4. NC1154.2 +084000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +084100 MOVE "INSP-TEST-F3-4" TO PAR-NAME. NC1154.2 +084200 MOVE "FOR LEADING" TO FEATURE. NC1154.2 +084300 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +084400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +084500 MOVE 1 TO REC-CT. NC1154.2 +084600 INSP-TEST-F3-4-0. NC1154.2 +084700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR LEADING NC1154.2 +084800 A-XN-1-1 REPLACING LEADING A-XN-1-1 BY "O". NC1154.2 +084900 GO TO TEST-F3-4-1. NC1154.2 +085000 INSP-DELETE-F3-4. NC1154.2 +085100 PERFORM DE-LETE. NC1154.2 +085200 PERFORM PRINT-DETAIL. NC1154.2 +085300 GO TO INSP-INIT-F3-5. NC1154.2 +085400 TEST-F3-4-1. NC1154.2 +085500 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +085600 PERFORM PASS NC1154.2 +085700 PERFORM PRINT-DETAIL NC1154.2 +085800 ELSE NC1154.2 +085900 PERFORM FAIL NC1154.2 +086000 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +086100 MOVE 1 TO CORRECT-N NC1154.2 +086200 PERFORM PRINT-DETAIL. NC1154.2 +086300 ADD 1 TO REC-CT. NC1154.2 +086400 TEST-F3-4-2. NC1154.2 +086500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +086600 PERFORM PASS NC1154.2 +086700 PERFORM PRINT-DETAIL NC1154.2 +086800 ELSE NC1154.2 +086900 PERFORM FAIL NC1154.2 +087000 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +087100 MOVE ANS-XN-83-1 TO WRK-OK NC1154.2 +087200 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +087300 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +087400 PERFORM PRINT-DETAIL NC1154.2 +087500 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +087600 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +087700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +087800 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +087900 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +088000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +088100 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +088200 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +088300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +088400 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +088500 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +088600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +088700 INSP-INIT-F3-5. NC1154.2 +088800 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +088900 MOVE "INSP-TEST-F3-5" TO PAR-NAME. NC1154.2 +089000 MOVE "LIT BY AFTER INIT" TO FEATURE. NC1154.2 +089100 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +089200 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +089300 MOVE 1 TO REC-CT. NC1154.2 +089400 INSP-TEST-F3-5-0. NC1154.2 +089500 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC1154.2 +089600 REPLACING FIRST "A" BY "O" AFTER INITIAL "Y". NC1154.2 +089700 GO TO TEST-F3-5-1. NC1154.2 +089800 INSP-DELETE-F3-5. NC1154.2 +089900 PERFORM DE-LETE. NC1154.2 +090000 PERFORM PRINT-DETAIL. NC1154.2 +090100 GO TO INSP-INIT-F3-6. NC1154.2 +090200 TEST-F3-5-1. NC1154.2 +090300 IF WRK-DU-999-1 EQUAL TO 8 NC1154.2 +090400 PERFORM PASS NC1154.2 +090500 PERFORM PRINT-DETAIL NC1154.2 +090600 ELSE NC1154.2 +090700 PERFORM FAIL NC1154.2 +090800 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +090900 MOVE 8 TO CORRECT-N NC1154.2 +091000 PERFORM PRINT-DETAIL. NC1154.2 +091100 ADD 1 TO REC-CT. NC1154.2 +091200 TEST-F3-5-2. NC1154.2 +091300 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC1154.2 +091400 PERFORM PASS NC1154.2 +091500 PERFORM PRINT-DETAIL NC1154.2 +091600 ELSE NC1154.2 +091700 PERFORM FAIL NC1154.2 +091800 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +091900 MOVE ANS-XN-83-5 TO WRK-OK NC1154.2 +092000 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +092100 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +092200 PERFORM PRINT-DETAIL NC1154.2 +092300 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +092400 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +092500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +092600 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +092700 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +092800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +092900 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +093000 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +093100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +093200 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +093300 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +093400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +093500 INSP-INIT-F3-6. NC1154.2 +093600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +093700 MOVE "INSP-TEST-F3-6" TO PAR-NAME. NC1154.2 +093800 MOVE "CHAR AFTER ALL BEF" TO FEATURE. NC1154.2 +093900 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +094000 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +094100 MOVE 1 TO REC-CT. NC1154.2 +094200 INSP-TEST-F3-6-0. NC1154.2 +094300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +094400 AFTER A-XN-1-1 REPLACING ALL "A" BY "O" BEFORE H-XN-1-1. NC1154.2 +094500 GO TO TEST-F3-6-1. NC1154.2 +094600 INSP-DELETE-F3-6. NC1154.2 +094700 PERFORM DE-LETE. NC1154.2 +094800 PERFORM PRINT-DETAIL. NC1154.2 +094900 GO TO INSP-INIT-F3-7. NC1154.2 +095000 TEST-F3-6-1. NC1154.2 +095100 IF WRK-DU-999-1 EQUAL TO 82 NC1154.2 +095200 PERFORM PASS NC1154.2 +095300 PERFORM PRINT-DETAIL NC1154.2 +095400 ELSE NC1154.2 +095500 PERFORM FAIL NC1154.2 +095600 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +095700 MOVE 82 TO CORRECT-N NC1154.2 +095800 PERFORM PRINT-DETAIL. NC1154.2 +095900 ADD 1 TO REC-CT. NC1154.2 +096000 TEST-F3-6-2. NC1154.2 +096100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +096200 PERFORM PASS NC1154.2 +096300 PERFORM PRINT-DETAIL NC1154.2 +096400 ELSE NC1154.2 +096500 PERFORM FAIL NC1154.2 +096600 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +096700 MOVE ANS-XN-83-1 TO WRK-OK NC1154.2 +096800 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +096900 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +097000 PERFORM PRINT-DETAIL NC1154.2 +097100 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +097200 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +097300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +097400 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +097500 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +097600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +097700 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +097800 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +097900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +098000 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +098100 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +098200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +098300 INSP-INIT-F3-7. NC1154.2 +098400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +098500 MOVE ZERO TO WRK-DU-999-1 WRK-DU-999-2 WRK-DU-999-3 NC1154.2 +098600 WRK-DU-999-4. NC1154.2 +098700 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +098800 MOVE "INSP-TEST-F3-7" TO PAR-NAME. NC1154.2 +098900 MOVE "TALLY SERIES" TO FEATURE. NC1154.2 +099000 MOVE 1 TO REC-CT. NC1154.2 +099100 INSP-TEST-F3-7-0. NC1154.2 +099200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A". NC1154.2 +099300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-2 FOR LEADING "A". NC1154.2 +099400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-3 FOR CHARACTERS NC1154.2 +099500 BEFORE ".". NC1154.2 +099600 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-4 FOR CHARACTERS NC1154.2 +099700 AFTER "L". NC1154.2 +099800 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY "Z" AFTER "L". NC1154.2 +099900 GO TO INSP-TEST-F3-7-1. NC1154.2 +100000 INSP-DELETE-F3-7. NC1154.2 +100100 PERFORM DE-LETE. NC1154.2 +100200 PERFORM PRINT-DETAIL. NC1154.2 +100300 GO TO INSP-INIT-F3-8. NC1154.2 +100400 INSP-TEST-F3-7-1. NC1154.2 +100500 IF WRK-DU-999-1 EQUAL TO 8 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +100600 ELSE NC1154.2 +100700 PERFORM FAIL MOVE WRK-DU-999-1 TO COMPUTED-N MOVE 8 NC1154.2 +100800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +100900 ADD 1 TO REC-CT. NC1154.2 +101000 INSP-TEST-F3-7-2. NC1154.2 +101100 IF WRK-DU-999-2 EQUAL TO 1 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +101200 ELSE NC1154.2 +101300 PERFORM FAIL MOVE WRK-DU-999-2 TO COMPUTED-N MOVE 1 NC1154.2 +101400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +101500 ADD 1 TO REC-CT. NC1154.2 +101600 INSP-TEST-F3-7-3. NC1154.2 +101700 IF WRK-DU-999-3 EQUAL TO 15 PERFORM PASS PERFORM PRINT-DETAILNC1154.2 +101800 ELSE NC1154.2 +101900 PERFORM FAIL MOVE WRK-DU-999-3 TO COMPUTED-N MOVE 15 NC1154.2 +102000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +102100 ADD 1 TO REC-CT. NC1154.2 +102200 INSP-TEST-F3-7-4. NC1154.2 +102300 IF WRK-DU-999-4 EQUAL TO 6 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +102400 ELSE NC1154.2 +102500 PERFORM FAIL MOVE WRK-DU-999-4 TO COMPUTED-N MOVE 6 NC1154.2 +102600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +102700 ADD 1 TO REC-CT. NC1154.2 +102800 INSP-TEST-F3-7-5. NC1154.2 +102900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-6 PERFORM PASS PERFORM NC1154.2 +103000 PRINT-DETAIL ELSE NC1154.2 +103100 PERFORM FAIL NC1154.2 +103200 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +103300 MOVE ANS-XN-83-6 TO WRK-OK NC1154.2 +103400 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +103500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +103600 PERFORM PRINT-DETAIL NC1154.2 +103700 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +103800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +103900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104000 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +104100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +104200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104300 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +104400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +104500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104600 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +104700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +104800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +104900 INSP-INIT-F3-8. NC1154.2 +105000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +105100 MOVE "INSP-TEST-F3-8" TO PAR-NAME. NC1154.2 +105200 MOVE "REPLACE SERIES" TO FEATURE. NC1154.2 +105300 MOVE ZERO TO REC-CT WRK-DU-999-1. NC1154.2 +105400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +105500 MOVE 1 TO REC-CT. NC1154.2 +105600 INSP-TEST-F3-8-0. NC1154.2 +105700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +105800 BEFORE "." REPLACING CHARACTERS BY Z-XN-1-1 AFTER NC1154.2 +105900 L-XN-1-1. NC1154.2 +106000 INSPECT WRK-XN-83-1 REPLACING ALL " " BY HYPEN-XN-1-1. NC1154.2 +106100 INSPECT WRK-XN-83-1 REPLACING FIRST "C" BY P-XN-1-1. NC1154.2 +106200 INSPECT WRK-XN-83-1 REPLACING LEADING A-XN-1-1 BY O-XN-1-1. NC1154.2 +106300 INSPECT WRK-XN-83-1 REPLACING ALL "F" BY "Z" BEFORE G-XN-1-1.NC1154.2 +106400 GO TO TEST-F3-8-1. NC1154.2 +106500 INSP-DELETE-F3-8. NC1154.2 +106600 PERFORM DE-LETE. NC1154.2 +106700 PERFORM PRINT-DETAIL. NC1154.2 +106800 GO TO CCVS-999999. NC1154.2 +106900 TEST-F3-8-1. NC1154.2 +107000 IF WRK-DU-999-1 EQUAL TO 15 NC1154.2 +107100 PERFORM PASS NC1154.2 +107200 PERFORM PRINT-DETAIL NC1154.2 +107300 ELSE NC1154.2 +107400 PERFORM FAIL NC1154.2 +107500 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +107600 MOVE 15 TO CORRECT-N NC1154.2 +107700 PERFORM PRINT-DETAIL. NC1154.2 +107800 ADD 1 TO REC-CT. NC1154.2 +107900 TEST-F3-8-2. NC1154.2 +108000 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-7 NC1154.2 +108100 PERFORM PASS NC1154.2 +108200 PERFORM PRINT-DETAIL NC1154.2 +108300 ELSE NC1154.2 +108400 PERFORM FAIL NC1154.2 +108500 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +108600 MOVE ANS-XN-83-7 TO WRK-OK NC1154.2 +108700 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +108800 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +108900 PERFORM PRINT-DETAIL NC1154.2 +109000 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +109100 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +109200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109300 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +109400 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +109500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109600 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +109700 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +109800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109900 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +110000 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +110100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +110200 CCVS-EXIT SECTION. NC1154.2 +110300 CCVS-999999. NC1154.2 +110400 GO TO CLOSE-FILES. NC1154.2 +*END-OF,NC115A +*HEADER,COBOL,NC116A +000100 IDENTIFICATION DIVISION. NC1164.2 +000200 PROGRAM-ID. NC1164.2 +000300 NC116A. NC1164.2 +000400**************************************************************** NC1164.2 +000500* * NC1164.2 +000600* VALIDATION FOR:- * NC1164.2 +000700* * NC1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +000900* * NC1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1164.2 +001100* * NC1164.2 +001200**************************************************************** NC1164.2 +001300* * NC1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1164.2 +001500* * NC1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1164.2 +001900* * NC1164.2 +002000**************************************************************** NC1164.2 +002100* NC1164.2 +002200* PROGRAM NC116A TESTS THE USE OF THE SIGN CLAUSE NC1164.2 +002300* USING THE "IF" AND "MOVE" STATEMENTS. ALL COMBINATIONS NC1164.2 +002400* OF THE SIGN CLAUSE PHRASES ARE TESTED USING DATA ITEMS OF NC1164.2 +002500* VARIOUS LENGTHS. NC1164.2 +002600* NC1164.2 +002700 ENVIRONMENT DIVISION. NC1164.2 +002800 CONFIGURATION SECTION. NC1164.2 +002900 SOURCE-COMPUTER. NC1164.2 +003000 XXXXX082. NC1164.2 +003100 OBJECT-COMPUTER. NC1164.2 +003200 XXXXX083. NC1164.2 +003300 INPUT-OUTPUT SECTION. NC1164.2 +003400 FILE-CONTROL. NC1164.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1164.2 +003600 XXXXX055. NC1164.2 +003700 DATA DIVISION. NC1164.2 +003800 FILE SECTION. NC1164.2 +003900 FD PRINT-FILE. NC1164.2 +004000 01 PRINT-REC PICTURE X(120). NC1164.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1164.2 +004200 WORKING-STORAGE SECTION. NC1164.2 +004300*======================= NC1164.2 +004400 01 TEST-17-DATA SIGN TRAILING. NC1164.2 +004500 03 TEST-17-A PIC S9(4). NC1164.2 +004600 03 TEST-17-B PIC S9(4). NC1164.2 +004700 03 TEST-17-GROUP SIGN LEADING SEPARATE. NC1164.2 +004800 05 TEST-17-C PIC S9(4). NC1164.2 +004900 05 FILLER REDEFINES TEST-17-C. NC1164.2 +005000 07 TEST-17-C-SIGN PIC X. NC1164.2 +005100 07 FILLER PIC X(4). NC1164.2 +005200 NC1164.2 +005300 01 TEST-18-DATA SIGN TRAILING. NC1164.2 +005400 03 TEST-18-A PIC S9(4). NC1164.2 +005500 03 TEST-18-B PIC S9(4) SIGN LEADING SEPARATE. NC1164.2 +005600 03 TEST-18-BX REDEFINES TEST-18-B. NC1164.2 +005700 05 TEST-18-B-SIGN PIC X. NC1164.2 +005800 05 FILLER PIC X(4). NC1164.2 +005900 03 TEST-18-C PIC S9(4). NC1164.2 +006000 01 DS-LS-5 PICTURE S99999 NC1164.2 +006100 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +006200 VALUE +91275. NC1164.2 +006300 01 GRP-001 REDEFINES DS-LS-5. NC1164.2 +006400 02 TEST1-AN-1 PICTURE X. NC1164.2 +006500 02 TEST1-AN-5 PICTURE X(5). NC1164.2 +006600 01 DS-LS-4 PICTURE S9999 NC1164.2 +006700 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +006800 VALUE -9127. NC1164.2 +006900 01 GRP-002 REDEFINES DS-LS-4. NC1164.2 +007000 02 TEST1N-AN-1 PICTURE X. NC1164.2 +007100 02 TEST1N-AN-4 PICTURE X(4). NC1164.2 +007200 01 DS-TS-5 PICTURE S99999 NC1164.2 +007300 SIGN IS TRAILING SEPARATE CHARACTER NC1164.2 +007400 VALUE +80361. NC1164.2 +007500 01 GRP-003 REDEFINES DS-TS-5. NC1164.2 +007600 02 TEST2-AN-5 PICTURE X(5). NC1164.2 +007700 02 TEST2-AN-1 PICTURE X. NC1164.2 +007800 01 DS-TS-4 PICTURE S9999 NC1164.2 +007900 SIGN IS TRAILING SEPARATE CHARACTER NC1164.2 +008000 VALUE -8036. NC1164.2 +008100 01 GRP-004 REDEFINES DS-TS-4. NC1164.2 +008200 02 TEST2N-AN-4 PICTURE X(4). NC1164.2 +008300 02 TEST2N-AN-1 PICTURE X. NC1164.2 +008400 01 DS-L-5 PICTURE S99999 VALUE +91275 NC1164.2 +008500 SIGN IS LEADING. NC1164.2 +008600 01 GRP-005 REDEFINES DS-L-5. NC1164.2 +008700 02 TEST3-AN-1 PICTURE X. NC1164.2 +008800 02 TEST3-AN-4 PICTURE X(4). NC1164.2 +008900 01 DS-L-4 PICTURE S9999 VALUE -9127 NC1164.2 +009000 SIGN IS LEADING. NC1164.2 +009100 01 GRP-006 REDEFINES DS-L-4. NC1164.2 +009200 02 TEST3N-AN-1 PICTURE X. NC1164.2 +009300 02 TEST3N-AN-3 PICTURE XXX. NC1164.2 +009400 01 DS-T-5 PICTURE S99999 VALUE +83621 NC1164.2 +009500 SIGN IS TRAILING. NC1164.2 +009600 01 GRP-007 REDEFINES DS-T-5. NC1164.2 +009700 02 TEST4-AN-4 PICTURE X(4). NC1164.2 +009800 02 TEST4-AN-1 PICTURE X. NC1164.2 +009900 01 DS-T-4 PICTURE S9999 VALUE -3621 NC1164.2 +010000 SIGN IS TRAILING. NC1164.2 +010100 01 GRP-008 REDEFINES DS-T-4. NC1164.2 +010200 02 TEST4N-AN-3 PICTURE XXX. NC1164.2 +010300 02 TEST4N-AN-1 PICTURE X. NC1164.2 +010400 01 DU-005 PICTURE 9(5) VALUE ZERO. NC1164.2 +010500 01 DS-005 PICTURE S9(5) VALUE 0. NC1164.2 +010600 01 CU-005 PICTURE 9(5) USAGE COMPUTATIONAL VALUE 0. NC1164.2 +010700 01 CS-005 PICTURE S9(5) USAGE COMPUTATIONAL VALUE 0. NC1164.2 +010800 01 WRK-DS-LS-5 PICTURE S99999 VALUE ZERO NC1164.2 +010900 SIGN LEADING SEPARATE. NC1164.2 +011000 01 GRP-09 REDEFINES WRK-DS-LS-5 PICTURE X(6). NC1164.2 +011100 01 WRK-DS-TS-5 PICTURE S99999 VALUE ZERO NC1164.2 +011200 SIGN TRAILING SEPARATE. NC1164.2 +011300 01 GRP-10 REDEFINES WRK-DS-TS-5 PICTURE X(6). NC1164.2 +011400 01 WRK-DS-L-5 PICTURE S99999 VALUE ZERO NC1164.2 +011500 SIGN LEADING. NC1164.2 +011600 01 WRK-DS-T-5 PICTURE S99999 VALUE ZERO NC1164.2 +011700 SIGN TRAILING. NC1164.2 +011800 01 AN-006 PICTURE X(6) VALUE SPACE. NC1164.2 +011900 01 DS-L-00008 PIC S9(8) SIGN LEADING VALUE +01234567. NC1164.2 +012000 01 AN-00008-X-1 REDEFINES DS-L-00008 PIC X(8). NC1164.2 +012100 01 DS-T-00008 PIC S9(8) SIGN TRAILING VALUE -01234567. NC1164.2 +012200 01 AN-00008-X-2 REDEFINES DS-T-00008 PIC X(8). NC1164.2 +012300 01 DS-T-00008-1 PIC S9(8) SIGN TRAILING VALUE +01234567. NC1164.2 +012400 01 AN-00008-X-5 REDEFINES DS-T-00008-1 PIC X(8). NC1164.2 +012500 01 DS-LS-00008 PIC S9(8) NC1164.2 +012600 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +012700 VALUE -07654321. NC1164.2 +012800 01 AN-00009-X-3 REDEFINES DS-LS-00008 PIC X(9). NC1164.2 +012900 01 DS-LS-00008-1 PIC S9(8) NC1164.2 +013000 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +013100 VALUE +07654321. NC1164.2 +013200 01 AN-00009-X-6 REDEFINES DS-LS-00008-1 PIC X(9). NC1164.2 +013300 01 DS-TS-00008 PIC S9(8) NC1164.2 +013400 SIGN TRAILING SEPARATE NC1164.2 +013500 VALUE +07654321. NC1164.2 +013600 01 AN-00009-X-4 REDEFINES DS-TS-00008 PIC X(9). NC1164.2 +013700 01 CS-00007-1 PIC S9(7) COMPUTATIONAL VALUE +1234567. NC1164.2 +013800 01 CU-00007-1 PIC 9(7) COMPUTATIONAL VALUE 1234567. NC1164.2 +013900 01 DS-00007-1 PIC S9(7) DISPLAY VALUE +1234567. NC1164.2 +014000 01 DU-00007-1 PIC 9(7) DISPLAY VALUE 1234567. NC1164.2 +014100 01 CS-00007-2 PIC S9(7) COMPUTATIONAL VALUE -1234567. NC1164.2 +014200 01 CU-00007-2 PIC 9(7) COMPUTATIONAL VALUE 1234567. NC1164.2 +014300 01 DS-00007-2 PIC S9(7) DISPLAY VALUE -1234567. NC1164.2 +014400 01 DU-00007-2 PIC 9(7) DISPLAY VALUE 1234567. NC1164.2 +014500 01 CS-00007-3 PIC S9(7) COMPUTATIONAL VALUE -7654321. NC1164.2 +014600 01 CU-00007-3 PIC 9(7) COMPUTATIONAL VALUE 7654321. NC1164.2 +014700 01 DS-00007-3 PIC S9(7) DISPLAY VALUE -7654321. NC1164.2 +014800 01 DU-00007-3 PIC 9(7) DISPLAY VALUE 7654321. NC1164.2 +014900 01 CS-00007-4 PIC S9(7) COMPUTATIONAL VALUE +7654321. NC1164.2 +015000 01 CU-00007-4 PIC 9(7) COMPUTATIONAL VALUE 7654321. NC1164.2 +015100 01 DS-00007-4 PIC S9(7) DISPLAY VALUE +7654321. NC1164.2 +015200 01 DU-00007-4 PIC 9(7) DISPLAY VALUE 7654321. NC1164.2 +015300 01 TEST-RESULTS. NC1164.2 +015400 02 FILLER PIC X VALUE SPACE. NC1164.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. NC1164.2 +015600 02 FILLER PIC X VALUE SPACE. NC1164.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. NC1164.2 +015800 02 FILLER PIC X VALUE SPACE. NC1164.2 +015900 02 PAR-NAME. NC1164.2 +016000 03 FILLER PIC X(19) VALUE SPACE. NC1164.2 +016100 03 PARDOT-X PIC X VALUE SPACE. NC1164.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. NC1164.2 +016300 02 FILLER PIC X(8) VALUE SPACE. NC1164.2 +016400 02 RE-MARK PIC X(61). NC1164.2 +016500 01 TEST-COMPUTED. NC1164.2 +016600 02 FILLER PIC X(30) VALUE SPACE. NC1164.2 +016700 02 FILLER PIC X(17) VALUE NC1164.2 +016800 " COMPUTED=". NC1164.2 +016900 02 COMPUTED-X. NC1164.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1164.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A NC1164.2 +017200 PIC -9(9).9(9). NC1164.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1164.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1164.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1164.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. NC1164.2 +017700 04 COMPUTED-18V0 PIC -9(18). NC1164.2 +017800 04 FILLER PIC X. NC1164.2 +017900 03 FILLER PIC X(50) VALUE SPACE. NC1164.2 +018000 01 TEST-CORRECT. NC1164.2 +018100 02 FILLER PIC X(30) VALUE SPACE. NC1164.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1164.2 +018300 02 CORRECT-X. NC1164.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1164.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1164.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1164.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1164.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1164.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. NC1164.2 +019000 04 CORRECT-18V0 PIC -9(18). NC1164.2 +019100 04 FILLER PIC X. NC1164.2 +019200 03 FILLER PIC X(2) VALUE SPACE. NC1164.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1164.2 +019400 01 CCVS-C-1. NC1164.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1164.2 +019600- "SS PARAGRAPH-NAME NC1164.2 +019700- " REMARKS". NC1164.2 +019800 02 FILLER PIC X(20) VALUE SPACE. NC1164.2 +019900 01 CCVS-C-2. NC1164.2 +020000 02 FILLER PIC X VALUE SPACE. NC1164.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". NC1164.2 +020200 02 FILLER PIC X(15) VALUE SPACE. NC1164.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". NC1164.2 +020400 02 FILLER PIC X(94) VALUE SPACE. NC1164.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1164.2 +020600 01 REC-CT PIC 99 VALUE ZERO. NC1164.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1164.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1164.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1164.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1164.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1164.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1164.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1164.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1164.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1164.2 +021600 01 CCVS-H-1. NC1164.2 +021700 02 FILLER PIC X(39) VALUE SPACES. NC1164.2 +021800 02 FILLER PIC X(42) VALUE NC1164.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1164.2 +022000 02 FILLER PIC X(39) VALUE SPACES. NC1164.2 +022100 01 CCVS-H-2A. NC1164.2 +022200 02 FILLER PIC X(40) VALUE SPACE. NC1164.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1164.2 +022400 02 FILLER PIC XXXX VALUE NC1164.2 +022500 "4.2 ". NC1164.2 +022600 02 FILLER PIC X(28) VALUE NC1164.2 +022700 " COPY - NOT FOR DISTRIBUTION". NC1164.2 +022800 02 FILLER PIC X(41) VALUE SPACE. NC1164.2 +022900 NC1164.2 +023000 01 CCVS-H-2B. NC1164.2 +023100 02 FILLER PIC X(15) VALUE NC1164.2 +023200 "TEST RESULT OF ". NC1164.2 +023300 02 TEST-ID PIC X(9). NC1164.2 +023400 02 FILLER PIC X(4) VALUE NC1164.2 +023500 " IN ". NC1164.2 +023600 02 FILLER PIC X(12) VALUE NC1164.2 +023700 " HIGH ". NC1164.2 +023800 02 FILLER PIC X(22) VALUE NC1164.2 +023900 " LEVEL VALIDATION FOR ". NC1164.2 +024000 02 FILLER PIC X(58) VALUE NC1164.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +024200 01 CCVS-H-3. NC1164.2 +024300 02 FILLER PIC X(34) VALUE NC1164.2 +024400 " FOR OFFICIAL USE ONLY ". NC1164.2 +024500 02 FILLER PIC X(58) VALUE NC1164.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1164.2 +024700 02 FILLER PIC X(28) VALUE NC1164.2 +024800 " COPYRIGHT 1985 ". NC1164.2 +024900 01 CCVS-E-1. NC1164.2 +025000 02 FILLER PIC X(52) VALUE SPACE. NC1164.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1164.2 +025200 02 ID-AGAIN PIC X(9). NC1164.2 +025300 02 FILLER PIC X(45) VALUE SPACES. NC1164.2 +025400 01 CCVS-E-2. NC1164.2 +025500 02 FILLER PIC X(31) VALUE SPACE. NC1164.2 +025600 02 FILLER PIC X(21) VALUE SPACE. NC1164.2 +025700 02 CCVS-E-2-2. NC1164.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1164.2 +025900 03 FILLER PIC X VALUE SPACE. NC1164.2 +026000 03 ENDER-DESC PIC X(44) VALUE NC1164.2 +026100 "ERRORS ENCOUNTERED". NC1164.2 +026200 01 CCVS-E-3. NC1164.2 +026300 02 FILLER PIC X(22) VALUE NC1164.2 +026400 " FOR OFFICIAL USE ONLY". NC1164.2 +026500 02 FILLER PIC X(12) VALUE SPACE. NC1164.2 +026600 02 FILLER PIC X(58) VALUE NC1164.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +026800 02 FILLER PIC X(13) VALUE SPACE. NC1164.2 +026900 02 FILLER PIC X(15) VALUE NC1164.2 +027000 " COPYRIGHT 1985". NC1164.2 +027100 01 CCVS-E-4. NC1164.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1164.2 +027300 02 FILLER PIC X(4) VALUE " OF ". NC1164.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1164.2 +027500 02 FILLER PIC X(40) VALUE NC1164.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1164.2 +027700 01 XXINFO. NC1164.2 +027800 02 FILLER PIC X(19) VALUE NC1164.2 +027900 "*** INFORMATION ***". NC1164.2 +028000 02 INFO-TEXT. NC1164.2 +028100 04 FILLER PIC X(8) VALUE SPACE. NC1164.2 +028200 04 XXCOMPUTED PIC X(20). NC1164.2 +028300 04 FILLER PIC X(5) VALUE SPACE. NC1164.2 +028400 04 XXCORRECT PIC X(20). NC1164.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). NC1164.2 +028600 01 HYPHEN-LINE. NC1164.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. NC1164.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************NC1164.2 +028900- "*****************************************". NC1164.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************NC1164.2 +029100- "******************************". NC1164.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE NC1164.2 +029300 "NC116A". NC1164.2 +029400 PROCEDURE DIVISION. NC1164.2 +029500 CCVS1 SECTION. NC1164.2 +029600 OPEN-FILES. NC1164.2 +029700 OPEN OUTPUT PRINT-FILE. NC1164.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1164.2 +029900 MOVE SPACE TO TEST-RESULTS. NC1164.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1164.2 +030100 GO TO CCVS1-EXIT. NC1164.2 +030200 CLOSE-FILES. NC1164.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1164.2 +030400 TERMINATE-CCVS. NC1164.2 +030500S EXIT PROGRAM. NC1164.2 +030600STERMINATE-CALL. NC1164.2 +030700 STOP RUN. NC1164.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1164.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1164.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1164.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1164.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. NC1164.2 +031300 PRINT-DETAIL. NC1164.2 +031400 IF REC-CT NOT EQUAL TO ZERO NC1164.2 +031500 MOVE "." TO PARDOT-X NC1164.2 +031600 MOVE REC-CT TO DOTVALUE. NC1164.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1164.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1164.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1164.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1164.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1164.2 +032200 MOVE SPACE TO CORRECT-X. NC1164.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1164.2 +032400 MOVE SPACE TO RE-MARK. NC1164.2 +032500 HEAD-ROUTINE. NC1164.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1164.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1164.2 +033000 COLUMN-NAMES-ROUTINE. NC1164.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +033400 END-ROUTINE. NC1164.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1164.2 +033600 END-RTN-EXIT. NC1164.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +033800 END-ROUTINE-1. NC1164.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1164.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1164.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. NC1164.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1164.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1164.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1164.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1164.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1164.2 +034700 END-ROUTINE-12. NC1164.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1164.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1164.2 +035000 MOVE "NO " TO ERROR-TOTAL NC1164.2 +035100 ELSE NC1164.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1164.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1164.2 +035400 PERFORM WRITE-LINE. NC1164.2 +035500 END-ROUTINE-13. NC1164.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1164.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE NC1164.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1164.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1164.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO NC1164.2 +036200 MOVE "NO " TO ERROR-TOTAL NC1164.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1164.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1164.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036700 WRITE-LINE. NC1164.2 +036800 ADD 1 TO RECORD-COUNT. NC1164.2 +036900Y IF RECORD-COUNT GREATER 42 NC1164.2 +037000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1164.2 +037100Y MOVE SPACE TO DUMMY-RECORD NC1164.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1164.2 +037300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1164.2 +037400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1164.2 +037500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1164.2 +037600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1164.2 +037700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +037800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +037900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +038000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1164.2 +038100Y MOVE ZERO TO RECORD-COUNT. NC1164.2 +038200 PERFORM WRT-LN. NC1164.2 +038300 WRT-LN. NC1164.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1164.2 +038500 MOVE SPACE TO DUMMY-RECORD. NC1164.2 +038600 BLANK-LINE-PRINT. NC1164.2 +038700 PERFORM WRT-LN. NC1164.2 +038800 FAIL-ROUTINE. NC1164.2 +038900 IF COMPUTED-X NOT EQUAL TO SPACE NC1164.2 +039000 GO TO FAIL-ROUTINE-WRITE. NC1164.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1164.2 +039200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1164.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1164.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +039500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1164.2 +039600 GO TO FAIL-ROUTINE-EX. NC1164.2 +039700 FAIL-ROUTINE-WRITE. NC1164.2 +039800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1164.2 +039900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1164.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1164.2 +040100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1164.2 +040200 FAIL-ROUTINE-EX. EXIT. NC1164.2 +040300 BAIL-OUT. NC1164.2 +040400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1164.2 +040500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1164.2 +040600 BAIL-OUT-WRITE. NC1164.2 +040700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1164.2 +040800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1164.2 +040900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1164.2 +041100 BAIL-OUT-EX. EXIT. NC1164.2 +041200 CCVS1-EXIT. NC1164.2 +041300 EXIT. NC1164.2 +041400 SECT-NC116A-001 SECTION. NC1164.2 +041500 SIG-INIT-GF-1. NC1164.2 +041600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +041700 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1164.2 +041800 MOVE 1 TO REC-CT. NC1164.2 +041900 MOVE "SIGN LEADING SEPARATE" TO FEATURE. NC1164.2 +042000 MOVE "LEADING SIGN EQUAL PLUS" TO RE-MARK. NC1164.2 +042100 SIG-TEST-GF-1-1. NC1164.2 +042200* THIS TEST CHECKS THE SIGN AND THE NUMERIC CHARACTERS NC1164.2 +042300* OF AN ITEM DEFINED AS SIGN IS LEADING SEPARATE CHARACTER. NC1164.2 +042400 IF TEST1-AN-1 EQUAL TO "+" NC1164.2 +042500 PERFORM PASS NC1164.2 +042600 GO TO SIG-WRTE-GF-1-1. NC1164.2 +042700 GO TO SIG-FAIL-GF-1-1. NC1164.2 +042800 SIG-DELETE-GF-1-1. NC1164.2 +042900 PERFORM DE-LETE. NC1164.2 +043000 PERFORM PRINT-DETAIL. NC1164.2 +043100 GO TO SIG-INIT-GF-2. NC1164.2 +043200 SIG-FAIL-GF-1-1. NC1164.2 +043300 PERFORM FAIL. NC1164.2 +043400 MOVE "+" TO CORRECT-A. NC1164.2 +043500 MOVE TEST1-AN-1 TO COMPUTED-A. NC1164.2 +043600 SIG-WRTE-GF-1-1. NC1164.2 +043700 PERFORM PRINT-DETAIL. NC1164.2 +043800 SIG-TEST-GF-1-2. NC1164.2 +043900 IF TEST1-AN-5 EQUAL TO "91275" NC1164.2 +044000 PERFORM PASS NC1164.2 +044100 GO TO SIG-WRTE-GF-1-2. NC1164.2 +044200 SIG-FAIL-GF-1-2. NC1164.2 +044300 PERFORM FAIL. NC1164.2 +044400 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +044500 MOVE "91275" TO CORRECT-A. NC1164.2 +044600 MOVE TEST1-AN-5 TO COMPUTED-A. NC1164.2 +044700 SIG-WRTE-GF-1-2. NC1164.2 +044800 MOVE 2 TO REC-CT. NC1164.2 +044900 PERFORM PRINT-DETAIL. NC1164.2 +045000 SIG-TEST-GF-1-3. NC1164.2 +045100 IF TEST1N-AN-1 NOT EQUAL TO "-" NC1164.2 +045200 GO TO SIG-FAIL-GF-1-3. NC1164.2 +045300 PERFORM PASS. NC1164.2 +045400 GO TO SIG-WRTE-GF-1-3. NC1164.2 +045500 SIG-FAIL-GF-1-3. NC1164.2 +045600 PERFORM FAIL. NC1164.2 +045700 MOVE "-" TO CORRECT-A. NC1164.2 +045800 MOVE TEST1N-AN-1 TO COMPUTED-A. NC1164.2 +045900 SIG-WRTE-GF-1-3. NC1164.2 +046000 MOVE 3 TO REC-CT. NC1164.2 +046100 MOVE "LEADING SIGN EQUAL MINUS" TO RE-MARK. NC1164.2 +046200 PERFORM PRINT-DETAIL. NC1164.2 +046300 SIG-TEST-GF-1-4. NC1164.2 +046400 IF TEST1N-AN-4 NOT EQUAL TO "9127" NC1164.2 +046500 GO TO SIG-FAIL-GF-1-4. NC1164.2 +046600 PERFORM PASS. NC1164.2 +046700 GO TO SIG-WRTE-GF-1-4. NC1164.2 +046800 SIG-FAIL-GF-1-4. NC1164.2 +046900 PERFORM FAIL. NC1164.2 +047000 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +047100 MOVE "9127" TO CORRECT-A. NC1164.2 +047200 MOVE TEST1N-AN-4 TO COMPUTED-A. NC1164.2 +047300 SIG-WRTE-GF-1-4. NC1164.2 +047400 MOVE 4 TO REC-CT. NC1164.2 +047500 PERFORM PRINT-DETAIL. NC1164.2 +047600 SIG-INIT-GF-2. NC1164.2 +047700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +047800 MOVE "SIG-TEST-GF-2" TO PAR-NAME. NC1164.2 +047900 MOVE 1 TO REC-CT. NC1164.2 +048000 MOVE "SIGN TRLNG SEPARATE" TO FEATURE. NC1164.2 +048100 MOVE "TRAILING SIGN EQUAL PLUS" TO RE-MARK. NC1164.2 +048200* THIS TEST CHECKS THE SIGN AND THE NUMERIC CHARACTERS NC1164.2 +048300* OF AN ITEM DEFINED AS SIGN IS TRAILING SEPARATE CHARACTER. NC1164.2 +048400 SIG-TEST-GF-2-1. NC1164.2 +048500 IF TEST2-AN-1 EQUAL TO "+" NC1164.2 +048600 PERFORM PASS NC1164.2 +048700 GO TO SIG-WRTE-GF-2-1. NC1164.2 +048800 GO TO SIG-FAIL-GF-2-1. NC1164.2 +048900 SIG-DELETE-GF-2-1. NC1164.2 +049000 PERFORM DE-LETE. NC1164.2 +049100 PERFORM PRINT-DETAIL. NC1164.2 +049200 GO TO SIG-INIT-GF-3. NC1164.2 +049300 SIG-FAIL-GF-2-1. NC1164.2 +049400 PERFORM FAIL. NC1164.2 +049500 MOVE "+" TO CORRECT-A. NC1164.2 +049600 MOVE TEST2-AN-1 TO COMPUTED-A. NC1164.2 +049700 SIG-WRTE-GF-2-1. NC1164.2 +049800 PERFORM PRINT-DETAIL. NC1164.2 +049900 SIGNTEST-GF-2-2. NC1164.2 +050000 IF TEST2-AN-5 EQUAL TO "80361" NC1164.2 +050100 PERFORM PASS NC1164.2 +050200 GO TO SIG-WRTE-GF-2-2. NC1164.2 +050300 GO TO SIG-FAIL-GF-2-2. NC1164.2 +050400 SIG-FAIL-GF-2-2. NC1164.2 +050500 PERFORM FAIL. NC1164.2 +050600 MOVE "80361" TO CORRECT-A. NC1164.2 +050700 MOVE TEST2-AN-5 TO COMPUTED-A. NC1164.2 +050800 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +050900 SIG-WRTE-GF-2-2. NC1164.2 +051000 MOVE 2 TO REC-CT. NC1164.2 +051100 PERFORM PRINT-DETAIL. NC1164.2 +051200 SIG-TEST-GF-2-3. NC1164.2 +051300 IF TEST2N-AN-1 NOT EQUAL TO "-" NC1164.2 +051400 GO TO SIG-FAIL-GF-2-3. NC1164.2 +051500 PERFORM PASS. NC1164.2 +051600 GO TO SIG-WRTE-GF-2-3. NC1164.2 +051700 SIG-FAIL-GF-2-3. NC1164.2 +051800 PERFORM FAIL. NC1164.2 +051900 MOVE "-" TO CORRECT-A. NC1164.2 +052000 MOVE TEST2N-AN-1 TO COMPUTED-A. NC1164.2 +052100 SIG-WRTE-GF-2-3. NC1164.2 +052200 MOVE 3 TO REC-CT. NC1164.2 +052300 MOVE "TRAILING SIGN EQUAL MINUS" TO RE-MARK. NC1164.2 +052400 PERFORM PRINT-DETAIL. NC1164.2 +052500 SIG-TEST-GF-2-4. NC1164.2 +052600 IF TEST2N-AN-4 NOT EQUAL TO "8036" NC1164.2 +052700 GO TO SIG-FAIL-GF-2-4. NC1164.2 +052800 PERFORM PASS. NC1164.2 +052900 GO TO SIG-WRTE-GF-2-4. NC1164.2 +053000 SIG-FAIL-GF-2-4. NC1164.2 +053100 PERFORM FAIL. NC1164.2 +053200 MOVE "8036" TO CORRECT-A. NC1164.2 +053300 MOVE TEST2N-AN-4 TO COMPUTED-A. NC1164.2 +053400 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +053500 SIG-WRTE-GF-2-4. NC1164.2 +053600 MOVE 4 TO REC-CT. NC1164.2 +053700 PERFORM PRINT-DETAIL. NC1164.2 +053800 SIG-INIT-GF-3. NC1164.2 +053900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +054000 MOVE "SIG-TEST-GF-3" TO PAR-NAME. NC1164.2 +054100 MOVE "SIGN LEADING" TO FEATURE. NC1164.2 +054200 MOVE 1 TO REC-CT. NC1164.2 +054300 MOVE "POSITIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +054400* THIS TEST CHECKS ALL BUT THE LEADING CHARACTER OF AN NC1164.2 +054500* ITEM DEFINED AS SIGN IS LEADING. (NOT SEPARATE CHAR.) NC1164.2 +054600 SIG-TEST-GF-3-1. NC1164.2 +054700 IF TEST3-AN-4 EQUAL TO "1275" NC1164.2 +054800 PERFORM PASS NC1164.2 +054900 GO TO SIG-WRTE-GF-3-1. NC1164.2 +055000 GO TO SIG-FAIL-GF-3-1. NC1164.2 +055100 SIG-DELETE-GF-3-1. NC1164.2 +055200 PERFORM DE-LETE. NC1164.2 +055300 PERFORM PRINT-DETAIL. NC1164.2 +055400 GO TO SIG-INIT-GF-4. NC1164.2 +055500 SIG-FAIL-GF-3-1. NC1164.2 +055600 PERFORM FAIL. NC1164.2 +055700 MOVE "1275" TO CORRECT-A. NC1164.2 +055800 MOVE TEST3-AN-4 TO COMPUTED-A. NC1164.2 +055900 SIG-WRTE-GF-3-1. NC1164.2 +056000 PERFORM PRINT-DETAIL. NC1164.2 +056100 SIG-TEST-GF-3-2. NC1164.2 +056200 IF TEST3N-AN-3 NOT EQUAL TO "127" NC1164.2 +056300 GO TO SIG-FAIL-GF-3-2. NC1164.2 +056400 PERFORM PASS. NC1164.2 +056500 GO TO SIG-WRTE-GF-3-2. NC1164.2 +056600 SIG-DELETE-GF-3-2. NC1164.2 +056700 PERFORM DE-LETE. NC1164.2 +056800 SIG-FAIL-GF-3-2. NC1164.2 +056900 PERFORM FAIL. NC1164.2 +057000 MOVE "127" TO CORRECT-A. NC1164.2 +057100 MOVE TEST3N-AN-3 TO COMPUTED-A. NC1164.2 +057200 SIG-WRTE-GF-3-2. NC1164.2 +057300 MOVE 2 TO REC-CT. NC1164.2 +057400 MOVE "NEGATIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +057500 PERFORM PRINT-DETAIL. NC1164.2 +057600 SIG-INIT-GF-4. NC1164.2 +057700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +057800 MOVE "SIG-TEST-GF-4" TO PAR-NAME. NC1164.2 +057900 MOVE "SIGN TRAILING" TO FEATURE. NC1164.2 +058000 MOVE 1 TO REC-CT. NC1164.2 +058100 MOVE "POSITIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +058200* THIS TEST CHECKS ALL BUT THE TRAILING CHARACTER OF AN NC1164.2 +058300* ITEM DEFINED AS SIGN IS TRAILING. (NOT SEPARATE CHAR.) NC1164.2 +058400 SIG-TEST-GF-4-1. NC1164.2 +058500 IF TEST4-AN-4 EQUAL TO "8362" NC1164.2 +058600 PERFORM PASS NC1164.2 +058700 GO TO SIG-WRTE-GF-4-1. NC1164.2 +058800 GO TO SIG-FAIL-GF-4-1. NC1164.2 +058900 SIG-DELETE-GF-4-1. NC1164.2 +059000 PERFORM DE-LETE. NC1164.2 +059100 PERFORM PRINT-DETAIL. NC1164.2 +059200 GO TO SIG-INIT-GF-5. NC1164.2 +059300 SIG-FAIL-GF-4-1. NC1164.2 +059400 PERFORM FAIL. NC1164.2 +059500 MOVE "8362" TO CORRECT-A. NC1164.2 +059600 MOVE TEST4-AN-4 TO COMPUTED-A. NC1164.2 +059700 SIG-WRTE-GF-4-1. NC1164.2 +059800 PERFORM PRINT-DETAIL. NC1164.2 +059900 SIG-TEST-GF-4-2. NC1164.2 +060000 IF TEST4N-AN-3 NOT EQUAL TO "362" NC1164.2 +060100 GO TO SIG-FAIL-GF-4-2. NC1164.2 +060200 PERFORM PASS. NC1164.2 +060300 GO TO SIG-WRTE-GF-4-2. NC1164.2 +060400 SIG-DELETE-GF-4-2. NC1164.2 +060500 PERFORM DE-LETE. NC1164.2 +060600 SIG-FAIL-GF-4-2. NC1164.2 +060700 PERFORM FAIL. NC1164.2 +060800 MOVE "362" TO CORRECT-A. NC1164.2 +060900 MOVE TEST4N-AN-3 TO COMPUTED-A. NC1164.2 +061000 SIG-WRTE-GF-4-2. NC1164.2 +061100 MOVE 2 TO REC-CT. NC1164.2 +061200 MOVE "NEGATIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +061300 PERFORM PRINT-DETAIL. NC1164.2 +061400 SIG-INIT-GF-5. NC1164.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +061600 MOVE "SIG-TEST-GF-5" TO PAR-NAME. NC1164.2 +061700 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +061800 MOVE "LEADING SIGN" TO RE-MARK. NC1164.2 +061900 MOVE 1 TO REC-CT. NC1164.2 +062000* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +062100* LEADING SIGN TO FOUR SIGNED AND UNSIGNED COMPUTATIONAL AND NC1164.2 +062200* DISPLAY ITEMS. NC1164.2 +062300 SIG-TEST-GF-5-1. NC1164.2 +062400 IF DS-L-00008 EQUAL TO CS-00007-1 NC1164.2 +062500 PERFORM PASS NC1164.2 +062600 GO TO SIG-WRITE-GF-5-1. NC1164.2 +062700 GO TO SIG-FAIL-GF-5-1. NC1164.2 +062800 SIG-DELETE-GF-5-1. NC1164.2 +062900 PERFORM DE-LETE. NC1164.2 +063000 PERFORM PRINT-DETAIL. NC1164.2 +063100 GO TO SIG-INIT-GF-6. NC1164.2 +063200 SIG-FAIL-GF-5-1. NC1164.2 +063300 PERFORM FAIL. NC1164.2 +063400 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +063500 MOVE CS-00007-1 TO CORRECT-18V0. NC1164.2 +063600 SIG-WRITE-GF-5-1. NC1164.2 +063700 PERFORM PRINT-DETAIL. NC1164.2 +063800 SIG-TEST-GF-5-2. NC1164.2 +063900 MOVE 2 TO REC-CT. NC1164.2 +064000 IF DS-L-00008 EQUAL TO CU-00007-1 NC1164.2 +064100 PERFORM PASS NC1164.2 +064200 GO TO SIG-WRITE-GF-5-2. NC1164.2 +064300 SIG-FAIL-GF-5-2. NC1164.2 +064400 PERFORM FAIL. NC1164.2 +064500 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +064600 MOVE CU-00007-1 TO CORRECT-18V0. NC1164.2 +064700 SIG-WRITE-GF-5-2. NC1164.2 +064800 PERFORM PRINT-DETAIL. NC1164.2 +064900 SIG-TEST-GF-5-3. NC1164.2 +065000 MOVE 3 TO REC-CT. NC1164.2 +065100 IF DS-L-00008 EQUAL TO DS-00007-1 NC1164.2 +065200 PERFORM PASS NC1164.2 +065300 GO TO SIG-WRITE-GF-5-3. NC1164.2 +065400 SIG-FAIL-GF-5-3. NC1164.2 +065500 PERFORM FAIL. NC1164.2 +065600 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +065700 MOVE DS-00007-1 TO CORRECT-18V0. NC1164.2 +065800 SIG-WRITE-GF-5-3. NC1164.2 +065900 PERFORM PRINT-DETAIL. NC1164.2 +066000 SIG-TEST-GF-5-4. NC1164.2 +066100 MOVE 4 TO REC-CT. NC1164.2 +066200 IF DS-L-00008 EQUAL TO DU-00007-1 NC1164.2 +066300 PERFORM PASS NC1164.2 +066400 GO TO SIG-WRITE-GF-5-4. NC1164.2 +066500 SIG-FAIL-GF-5-4. NC1164.2 +066600 PERFORM FAIL. NC1164.2 +066700 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +066800 MOVE DU-00007-1 TO CORRECT-18V0. NC1164.2 +066900 SIG-WRITE-GF-5-4. NC1164.2 +067000 PERFORM PRINT-DETAIL. NC1164.2 +067100 SIG-INIT-GF-6. NC1164.2 +067200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +067300 MOVE "SIG-TEST-GF-6" TO PAR-NAME. NC1164.2 +067400 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +067500 MOVE "TRAILING SIGN" TO RE-MARK. NC1164.2 +067600* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +067700* TRAILING SIGN TO FOUR SIGNED AND UNSIGNED COMPUTATIONAL AND NC1164.2 +067800* DISPLAY ITEMS. NC1164.2 +067900 SIG-TEST-GF-6-1. NC1164.2 +068000 MOVE 1 TO REC-CT. NC1164.2 +068100 IF DS-T-00008 EQUAL TO CS-00007-2 NC1164.2 +068200 PERFORM PASS NC1164.2 +068300 GO TO SIG-WRITE-GF-6-1. NC1164.2 +068400 GO TO SIG-FAIL-GF-6-1. NC1164.2 +068500 SIG-DELETE-GF-6-1. NC1164.2 +068600 PERFORM DE-LETE. NC1164.2 +068700 PERFORM PRINT-DETAIL. NC1164.2 +068800 GO TO SIG-INIT-GF-7. NC1164.2 +068900 SIG-FAIL-GF-6-1. NC1164.2 +069000 PERFORM FAIL. NC1164.2 +069100 MOVE AN-00008-X-2 TO COMPUTED-A. NC1164.2 +069200 MOVE CS-00007-2 TO CORRECT-18V0. NC1164.2 +069300 SIG-WRITE-GF-6-1. NC1164.2 +069400 PERFORM PRINT-DETAIL. NC1164.2 +069500 SIG-TEST-GF-6-2. NC1164.2 +069600 MOVE 2 TO REC-CT. NC1164.2 +069700 IF DS-T-00008-1 EQUAL TO CU-00007-2 NC1164.2 +069800 PERFORM PASS NC1164.2 +069900 GO TO SIG-WRITE-GF-6-2. NC1164.2 +070000 SIG-FAIL-GF-6-2. NC1164.2 +070100 PERFORM FAIL. NC1164.2 +070200 MOVE AN-00008-X-5 TO COMPUTED-A. NC1164.2 +070300 MOVE CU-00007-2 TO CORRECT-18V0. NC1164.2 +070400 SIG-WRITE-GF-6-2. NC1164.2 +070500 PERFORM PRINT-DETAIL. NC1164.2 +070600 SIG-TEST-GF-6-3. NC1164.2 +070700 MOVE 3 TO REC-CT. NC1164.2 +070800 IF DS-T-00008 EQUAL TO DS-00007-2 NC1164.2 +070900 PERFORM PASS NC1164.2 +071000 GO TO SIG-WRITE-GF-6-3. NC1164.2 +071100 SIG-FAIL-GF-6-3. NC1164.2 +071200 PERFORM FAIL. NC1164.2 +071300 MOVE AN-00008-X-2 TO COMPUTED-A. NC1164.2 +071400 MOVE DS-00007-2 TO CORRECT-18V0. NC1164.2 +071500 SIG-WRITE-GF-6-3. NC1164.2 +071600 PERFORM PRINT-DETAIL. NC1164.2 +071700 SIG-TEST-GF-6-4. NC1164.2 +071800 MOVE 4 TO REC-CT. NC1164.2 +071900 IF DS-T-00008-1 EQUAL TO DU-00007-2 NC1164.2 +072000 PERFORM PASS NC1164.2 +072100 GO TO SIG-WRITE-GF-6-4. NC1164.2 +072200 SIG-FAIL-GF-6-4. NC1164.2 +072300 PERFORM FAIL. NC1164.2 +072400 MOVE AN-00008-X-5 TO COMPUTED-A. NC1164.2 +072500 MOVE DU-00007-2 TO CORRECT-18V0. NC1164.2 +072600 SIG-WRITE-GF-6-4. NC1164.2 +072700 PERFORM PRINT-DETAIL. NC1164.2 +072800 SIG-INIT-GF-7. NC1164.2 +072900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +073000 MOVE "SIG-TEST-GF-7" TO PAR-NAME. NC1164.2 +073100 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +073200 MOVE "LEADING SIGN SEPARATE CHARACTER" TO RE-MARK. NC1164.2 +073300* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +073400* LEADING SIGN AND SEPARATE CHARACTER TO FOUR SIGNED AND NC1164.2 +073500* UNSIGNED COMPUTATIONAL AND DISPLAY ITEMS. NC1164.2 +073600 SIG-TEST-GF-7-1. NC1164.2 +073700 MOVE 1 TO REC-CT. NC1164.2 +073800 IF DS-LS-00008 EQUAL TO CS-00007-3 NC1164.2 +073900 PERFORM PASS NC1164.2 +074000 GO TO SIG-WRITE-GF-7-1. NC1164.2 +074100 GO TO SIG-FAIL-GF-7-1. NC1164.2 +074200 SIG-DELETE-GF-7-1. NC1164.2 +074300 PERFORM DE-LETE. NC1164.2 +074400 PERFORM PRINT-DETAIL. NC1164.2 +074500 GO TO SIG-INIT-GF-8. NC1164.2 +074600 SIG-FAIL-GF-7-1. NC1164.2 +074700 PERFORM FAIL. NC1164.2 +074800 MOVE AN-00009-X-3 TO COMPUTED-A. NC1164.2 +074900 MOVE CS-00007-3 TO CORRECT-18V0. NC1164.2 +075000 SIG-WRITE-GF-7-1. NC1164.2 +075100 PERFORM PRINT-DETAIL. NC1164.2 +075200 SIG-TEST-GF-7-2. NC1164.2 +075300 MOVE 2 TO REC-CT. NC1164.2 +075400 IF DS-LS-00008-1 EQUAL TO CU-00007-3 NC1164.2 +075500 PERFORM PASS NC1164.2 +075600 GO TO SIG-WRITE-GF-7-2. NC1164.2 +075700 SIG-FAIL-GF-7-2. NC1164.2 +075800 PERFORM FAIL. NC1164.2 +075900 MOVE AN-00009-X-6 TO COMPUTED-A. NC1164.2 +076000 MOVE CU-00007-3 TO CORRECT-18V0. NC1164.2 +076100 SIG-WRITE-GF-7-2. NC1164.2 +076200 PERFORM PRINT-DETAIL. NC1164.2 +076300 SIG-TEST-GF-7-3. NC1164.2 +076400 MOVE 3 TO REC-CT. NC1164.2 +076500 IF DS-LS-00008 EQUAL TO DS-00007-3 NC1164.2 +076600 PERFORM PASS. NC1164.2 +076700 GO TO SIG-WRITE-GF-7-3. NC1164.2 +076800 SIG-FAIL-GF-7-3. NC1164.2 +076900 PERFORM FAIL. NC1164.2 +077000 MOVE AN-00009-X-3 TO COMPUTED-A. NC1164.2 +077100 MOVE DS-00007-3 TO CORRECT-18V0. NC1164.2 +077200 SIG-WRITE-GF-7-3. NC1164.2 +077300 PERFORM PRINT-DETAIL. NC1164.2 +077400 SIG-TEST-GF-7-4. NC1164.2 +077500 MOVE 4 TO REC-CT. NC1164.2 +077600 IF DS-LS-00008-1 EQUAL TO DU-00007-3 NC1164.2 +077700 PERFORM PASS NC1164.2 +077800 GO TO SIG-WRITE-GF-7-4. NC1164.2 +077900 SIG-FAIL-GF-7-4. NC1164.2 +078000 PERFORM FAIL. NC1164.2 +078100 MOVE AN-00009-X-6 TO COMPUTED-A. NC1164.2 +078200 MOVE DU-00007-3 TO CORRECT-18V0. NC1164.2 +078300 SIG-WRITE-GF-7-4. NC1164.2 +078400 PERFORM PRINT-DETAIL. NC1164.2 +078500 SIG-INIT-GF-8. NC1164.2 +078600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +078700 MOVE "SIG-TEST-GF-8" TO PAR-NAME. NC1164.2 +078800 MOVE "COMPARE SIGN ITEMS" TO FEATURE. NC1164.2 +078900 MOVE "TRAILING SIGN SEPARATE CHARACTR" TO RE-MARK. NC1164.2 +079000* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +079100* TRAILING SIGN AND SEPARATE CHARACTER TO FOUR SIGNED AND NC1164.2 +079200* UNSIGNED COMPUTATIONAL AND DISPLAY ITEMS. NC1164.2 +079300 SIG-TEST-GF-8-1. NC1164.2 +079400 MOVE 1 TO REC-CT. NC1164.2 +079500 IF DS-TS-00008 EQUAL TO CS-00007-4 NC1164.2 +079600 PERFORM PASS NC1164.2 +079700 GO TO SIG-WRITE-GF-8-1. NC1164.2 +079800 GO TO SIG-FAIL-GF-8-1. NC1164.2 +079900 SIG-DELETE-GF-8-1. NC1164.2 +080000 PERFORM DE-LETE. NC1164.2 +080100 PERFORM PRINT-DETAIL. NC1164.2 +080200 GO TO SIG-INIT-GF-9. NC1164.2 +080300 SIG-FAIL-GF-8-1. NC1164.2 +080400 PERFORM FAIL. NC1164.2 +080500 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +080600 MOVE CS-00007-4 TO CORRECT-18V0. NC1164.2 +080700 SIG-WRITE-GF-8-1. NC1164.2 +080800 PERFORM PRINT-DETAIL. NC1164.2 +080900 SIG-TEST-GF-8-2. NC1164.2 +081000 MOVE 2 TO REC-CT. NC1164.2 +081100 IF DS-TS-00008 EQUAL TO CU-00007-4 NC1164.2 +081200 PERFORM PASS NC1164.2 +081300 GO TO SIG-WRITE-GF-8-2. NC1164.2 +081400 SIG-FAIL-GF-8-2. NC1164.2 +081500 PERFORM FAIL. NC1164.2 +081600 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +081700 MOVE CU-00007-4 TO CORRECT-18V0. NC1164.2 +081800 SIG-WRITE-GF-8-2. NC1164.2 +081900 PERFORM PRINT-DETAIL. NC1164.2 +082000 SIG-TEST-GF-8-3. NC1164.2 +082100 MOVE 3 TO REC-CT. NC1164.2 +082200 IF DS-TS-00008 EQUAL TO DS-00007-4 NC1164.2 +082300 PERFORM PASS NC1164.2 +082400 GO TO SIG-WRITE-GF-8-3. NC1164.2 +082500 SIG-FAIL-GF-8-3. NC1164.2 +082600 PERFORM FAIL. NC1164.2 +082700 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +082800 MOVE DS-00007-4 TO CORRECT-18V0. NC1164.2 +082900 SIG-WRITE-GF-8-3. NC1164.2 +083000 PERFORM PRINT-DETAIL. NC1164.2 +083100 SIG-TEST-GF-8-4. NC1164.2 +083200 MOVE 4 TO REC-CT. NC1164.2 +083300 IF DS-TS-00008 EQUAL TO DU-00007-4 NC1164.2 +083400 PERFORM PASS NC1164.2 +083500 GO TO SIG-WRITE-GF-8-4. NC1164.2 +083600 SIG-FAIL-GF-8-4. NC1164.2 +083700 PERFORM FAIL. NC1164.2 +083800 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +083900 MOVE DU-00007-4 TO CORRECT-18V0. NC1164.2 +084000 SIG-WRITE-GF-8-4. NC1164.2 +084100 PERFORM PRINT-DETAIL. NC1164.2 +084200 SIG-INIT-GF-9. NC1164.2 +084300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +084400 MOVE "SIG-TEST-GF-9" TO PAR-NAME. NC1164.2 +084500 MOVE "SENDING ITEM DS-LS" TO FEATURE. NC1164.2 +084600 MOVE 1 TO REC-CT. NC1164.2 +084700* THIS TEST MOVES A NUMERIC ITEM WITH SIGN IS LEADING NC1164.2 +084800* SEPARATE CHARACTER TO UNSIGNED DISPLAY, SIGNED DISPLAY, NC1164.2 +084900* UNSIGNED COMPUTATIONAL AND SIGNED COMPUTATIONAL ITEMS. NC1164.2 +085000 SIG-TEST-GF-9-1. NC1164.2 +085100 MOVE DS-LS-5 TO DU-005. NC1164.2 +085200 IF DU-005 EQUAL TO 91275 NC1164.2 +085300 PERFORM PASS NC1164.2 +085400 GO TO SIG-WRTE-GF-9-1. NC1164.2 +085500 GO TO SIG-FAIL-GF-9-1. NC1164.2 +085600 SIG-DELETE-GF-9-1. NC1164.2 +085700 PERFORM DE-LETE. NC1164.2 +085800 PERFORM PRINT-DETAIL. NC1164.2 +085900 GO TO SIG-INIT-GF-10. NC1164.2 +086000 SIG-FAIL-GF-9-1. NC1164.2 +086100 PERFORM FAIL. NC1164.2 +086200 MOVE DU-005 TO COMPUTED-18V0. NC1164.2 +086300 MOVE 91275 TO CORRECT-18V0. NC1164.2 +086400 MOVE "MOVE DS-LS-5 TO DU-005" TO RE-MARK. NC1164.2 +086500 SIG-WRTE-GF-9-1. NC1164.2 +086600 PERFORM PRINT-DETAIL. NC1164.2 +086700 SIG-TEST-GF-9-2. NC1164.2 +086800 MOVE DS-LS-5 TO DS-005. NC1164.2 +086900 IF DS-005 EQUAL TO +91275 NC1164.2 +087000 PERFORM PASS NC1164.2 +087100 GO TO SIG-WRTE-GF-9-2. NC1164.2 +087200 SIG-FAIL-GF-9-2. NC1164.2 +087300 PERFORM FAIL. NC1164.2 +087400 MOVE DS-005 TO COMPUTED-18V0. NC1164.2 +087500 MOVE +91275 TO CORRECT-18V0. NC1164.2 +087600 MOVE "MOVE DS-LS-5 TO DS-005" TO RE-MARK. NC1164.2 +087700 SIG-WRTE-GF-9-2. NC1164.2 +087800 MOVE 2 TO REC-CT. NC1164.2 +087900 PERFORM PRINT-DETAIL. NC1164.2 +088000 SIG-TEST-GF-9-3. NC1164.2 +088100 MOVE DS-LS-5 TO CU-005. NC1164.2 +088200 IF CU-005 EQUAL TO 91275 NC1164.2 +088300 PERFORM PASS NC1164.2 +088400 GO TO SIG-WRTE-GF-9-3. NC1164.2 +088500 SIG-FAIL-GF-9-3. NC1164.2 +088600 PERFORM FAIL. NC1164.2 +088700 MOVE CU-005 TO COMPUTED-18V0. NC1164.2 +088800 MOVE 91275 TO CORRECT-18V0. NC1164.2 +088900 MOVE "MOVE DS-LS-5 TO CU-005" TO RE-MARK. NC1164.2 +089000 SIG-WRTE-GF-9-3. NC1164.2 +089100 MOVE 3 TO REC-CT. NC1164.2 +089200 PERFORM PRINT-DETAIL. NC1164.2 +089300 SIG-TEST-GF-9-4. NC1164.2 +089400 MOVE DS-LS-5 TO CS-005. NC1164.2 +089500 IF CS-005 EQUAL TO +91275 NC1164.2 +089600 PERFORM PASS NC1164.2 +089700 GO TO SIG-WRTE-GF-9-4. NC1164.2 +089800 SIG-FAIL-GF-9-4. NC1164.2 +089900 PERFORM FAIL. NC1164.2 +090000 MOVE CS-005 TO COMPUTED-18V0. NC1164.2 +090100 MOVE +91275 TO CORRECT-18V0. NC1164.2 +090200 MOVE "MOVE DS-LS-5 TO CS-005" TO RE-MARK. NC1164.2 +090300 SIG-WRTE-GF-9-4. NC1164.2 +090400 MOVE 4 TO REC-CT. NC1164.2 +090500 PERFORM PRINT-DETAIL. NC1164.2 +090600 SIG-INIT-GF-10. NC1164.2 +090700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +090800 MOVE "SIG-TEST-GF-10" TO PAR-NAME. NC1164.2 +090900 MOVE "SENDING ITEM DS-TS-4" TO FEATURE. NC1164.2 +091000* THIS TEST MOVES A NUMERIC ITEM WITH SIGN IS TRAILING NC1164.2 +091100* SEPARATE CHARACTER TO UNSIGNED DISPLAY, SIGNED DISPLAY, NC1164.2 +091200* UNSIGNED COMPUTATIONAL AND SIGNED COMPUTATIONAL ITEMS. NC1164.2 +091300 SIG-TEST-GF-10-1. NC1164.2 +091400 MOVE DS-TS-4 TO DU-005. NC1164.2 +091500 IF DU-005 NOT EQUAL TO 08036 NC1164.2 +091600 GO TO SIG-FAIL-GF-10-1. NC1164.2 +091700 PERFORM PASS. NC1164.2 +091800 GO TO SIG-WRTE-GF-10-1. NC1164.2 +091900 SIG-DELETE-GF-10-1. NC1164.2 +092000 PERFORM DE-LETE. NC1164.2 +092100 PERFORM PRINT-DETAIL. NC1164.2 +092200 GO TO SIG-INIT-GF-11. NC1164.2 +092300 SIG-FAIL-GF-10-1. NC1164.2 +092400 PERFORM FAIL. NC1164.2 +092500 MOVE DU-005 TO COMPUTED-18V0. NC1164.2 +092600 MOVE 08036 TO CORRECT-18V0. NC1164.2 +092700 MOVE "MOVE DS-TS-4 TO DU-005" TO RE-MARK. NC1164.2 +092800 SIG-WRTE-GF-10-1. NC1164.2 +092900 MOVE 1 TO REC-CT. NC1164.2 +093000 PERFORM PRINT-DETAIL. NC1164.2 +093100 SIG-TEST-GF-10-2. NC1164.2 +093200 MOVE DS-TS-4 TO DS-005. NC1164.2 +093300 IF DS-005 NOT EQUAL TO -08036 NC1164.2 +093400 GO TO SIG-FAIL-GF-10-2. NC1164.2 +093500 PERFORM PASS. NC1164.2 +093600 GO TO SIG-WRTE-GF-10-2. NC1164.2 +093700 SIG-FAIL-GF-10-2. NC1164.2 +093800 PERFORM FAIL. NC1164.2 +093900 MOVE DS-005 TO COMPUTED-18V0. NC1164.2 +094000 MOVE -08036 TO CORRECT-18V0. NC1164.2 +094100 MOVE "MOVE DS-TS-4 TO DS-005" TO RE-MARK. NC1164.2 +094200 SIG-WRTE-GF-10-2. NC1164.2 +094300 MOVE 2 TO REC-CT. NC1164.2 +094400 PERFORM PRINT-DETAIL. NC1164.2 +094500 SIG-TEST-GF-10-3. NC1164.2 +094600 MOVE DS-TS-4 TO CU-005. NC1164.2 +094700 IF CU-005 NOT EQUAL TO 08036 NC1164.2 +094800 GO TO SIG-FAIL-GF-10-3. NC1164.2 +094900 PERFORM PASS. NC1164.2 +095000 GO TO SIG-WRTE-GF-10-3. NC1164.2 +095100 SIG-FAIL-GF-10-3. NC1164.2 +095200 PERFORM FAIL. NC1164.2 +095300 MOVE CU-005 TO COMPUTED-18V0. NC1164.2 +095400 MOVE 08036 TO CORRECT-18V0. NC1164.2 +095500 MOVE "MOVE DS-TS-4 TO CU-005" TO RE-MARK. NC1164.2 +095600 SIG-WRTE-GF-10-3. NC1164.2 +095700 MOVE 3 TO REC-CT. NC1164.2 +095800 PERFORM PRINT-DETAIL. NC1164.2 +095900 SIG-TEST-GF-10-4. NC1164.2 +096000 MOVE DS-TS-4 TO CS-005. NC1164.2 +096100 IF CS-005 NOT EQUAL TO -08036 NC1164.2 +096200 GO TO SIG-FAIL-GF-10-4. NC1164.2 +096300 PERFORM PASS. NC1164.2 +096400 GO TO SIG-WRTE-GF-10-4. NC1164.2 +096500 SIG-FAIL-GF-10-4. NC1164.2 +096600 PERFORM FAIL. NC1164.2 +096700 MOVE CS-005 TO COMPUTED-18V0. NC1164.2 +096800 MOVE -08036 TO CORRECT-18V0. NC1164.2 +096900 MOVE "MOVE DS-TS-4 TO CS-005" TO RE-MARK. NC1164.2 +097000 SIG-WRTE-GF-10-4. NC1164.2 +097100 MOVE 4 TO REC-CT. NC1164.2 +097200 PERFORM PRINT-DETAIL. NC1164.2 +097300 SIG-INIT-GF-11. NC1164.2 +097400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +097500 MOVE "SIG-TEST-GF-11" TO PAR-NAME. NC1164.2 +097600 MOVE "SIGN SEPARATE ITEMS" TO FEATURE. NC1164.2 +097700* THIS TEST CONTAINS MOVE STATEMENTS WHERE BOTH THE NC1164.2 +097800* SENDING AND RECEIVING ITEM HAVE SEPARATE SIGN CHARACTERS. NC1164.2 +097900 SIG-TEST-GF-11-1. NC1164.2 +098000 MOVE DS-LS-4 TO WRK-DS-LS-5. NC1164.2 +098100 IF GRP-09 EQUAL TO "-09127" NC1164.2 +098200 PERFORM PASS NC1164.2 +098300 GO TO SIG-WRTE-GF-11-1. NC1164.2 +098400 GO TO SIG-FAIL-GF-11-1. NC1164.2 +098500 SIG-DELETE-GF-11-1. NC1164.2 +098600 PERFORM DE-LETE. NC1164.2 +098700 PERFORM PRINT-DETAIL. NC1164.2 +098800 GO TO SIG-INIT-GF-12. NC1164.2 +098900 SIG-FAIL-GF-11-1. NC1164.2 +099000 PERFORM FAIL. NC1164.2 +099100 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +099200 MOVE "-09127" TO CORRECT-A. NC1164.2 +099300 MOVE "MOVE DS-LS-4 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +099400 SIG-WRTE-GF-11-1. NC1164.2 +099500 MOVE 1 TO REC-CT. NC1164.2 +099600 PERFORM PRINT-DETAIL. NC1164.2 +099700 SIG-TEST-GF-11-2. NC1164.2 +099800 MOVE DS-LS-4 TO WRK-DS-TS-5. NC1164.2 +099900 IF GRP-10 NOT EQUAL TO "09127-" NC1164.2 +100000 GO TO SIG-FAIL-GF-11-2. NC1164.2 +100100 PERFORM PASS. NC1164.2 +100200 GO TO SIG-WRTE-GF-11-2. NC1164.2 +100300 SIG-FAIL-GF-11-2. NC1164.2 +100400 PERFORM FAIL. NC1164.2 +100500 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +100600 MOVE "09127-" TO CORRECT-A. NC1164.2 +100700 MOVE "MOVE DS-LS-4 TO WRK-DS-TS-S" TO RE-MARK. NC1164.2 +100800 SIG-WRTE-GF-11-2. NC1164.2 +100900 MOVE 2 TO REC-CT. NC1164.2 +101000 PERFORM PRINT-DETAIL. NC1164.2 +101100 SIG-TEST-GF-11-3. NC1164.2 +101200 MOVE DS-TS-5 TO WRK-DS-LS-5. NC1164.2 +101300 IF GRP-09 EQUAL TO "+80361" NC1164.2 +101400 PERFORM PASS NC1164.2 +101500 GO TO SIG-WRTE-GF-11-3. NC1164.2 +101600 SIG-FAIL-GF-11-3. NC1164.2 +101700 PERFORM FAIL. NC1164.2 +101800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +101900 MOVE "+80361" TO CORRECT-A. NC1164.2 +102000 MOVE "MOVE DS-TS-5 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +102100 SIG-WRTE-GF-11-3. NC1164.2 +102200 MOVE 3 TO REC-CT. NC1164.2 +102300 PERFORM PRINT-DETAIL. NC1164.2 +102400 SIG-TEST-GF-11-4. NC1164.2 +102500 MOVE DS-TS-5 TO WRK-DS-TS-5. NC1164.2 +102600 IF GRP-10 NOT EQUAL TO "80361+" NC1164.2 +102700 GO TO SIG-FAIL-GF-11-4. NC1164.2 +102800 PERFORM PASS. NC1164.2 +102900 GO TO SIG-WRTE-GF-11-4. NC1164.2 +103000 SIG-FAIL-GF-11-4. NC1164.2 +103100 PERFORM FAIL. NC1164.2 +103200 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +103300 MOVE "80361+" TO CORRECT-A. NC1164.2 +103400 MOVE "MOVE DS-TS-5 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +103500 SIG-WRTE-GF-11-4. NC1164.2 +103600 MOVE 4 TO REC-CT. NC1164.2 +103700 PERFORM PRINT-DETAIL. NC1164.2 +103800 SIG-INIT-GF-12. NC1164.2 +103900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +104000 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1164.2 +104100 MOVE "SIGN CLAUSE ITEMS" TO FEATURE. NC1164.2 +104200* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGN IS NC1164.2 +104300* SEPARATE SENDING ITEM AND SIGN CLAUSE RECEIVING ITEMS, NC1164.2 +104400* BUT RECEIVING ITEMS SIGNS ARE NOT SEPARATE. NC1164.2 +104500 SIG-TEST-GF-12-1. NC1164.2 +104600 MOVE DS-LS-5 TO WRK-DS-L-5. NC1164.2 +104700 IF WRK-DS-L-5 NOT EQUAL TO +91275 NC1164.2 +104800 GO TO SIG-FAIL-GF-12-1. NC1164.2 +104900 PERFORM PASS. NC1164.2 +105000 GO TO SIG-WRTE-GF-12-1. NC1164.2 +105100 SIG-DELETE-GF-12-1. NC1164.2 +105200 PERFORM DE-LETE. NC1164.2 +105300 PERFORM PRINT-DETAIL. NC1164.2 +105400 GO TO SIG-INIT-GF-13. NC1164.2 +105500 SIG-FAIL-GF-12-1. NC1164.2 +105600 PERFORM FAIL. NC1164.2 +105700 MOVE WRK-DS-L-5 TO COMPUTED-18V0. NC1164.2 +105800 MOVE "+91275" TO CORRECT-A. NC1164.2 +105900 MOVE "MOVE DS-LS-5 TO WRK-DS-L-5" TO RE-MARK. NC1164.2 +106000 SIG-WRTE-GF-12-1. NC1164.2 +106100 MOVE 1 TO REC-CT. NC1164.2 +106200 PERFORM PRINT-DETAIL. NC1164.2 +106300 SIG-TEST-GF-12-2. NC1164.2 +106400 MOVE DS-LS-5 TO WRK-DS-T-5. NC1164.2 +106500 IF WRK-DS-T-5 NOT EQUAL TO +91275 NC1164.2 +106600 GO TO SIG-FAIL-GF-12-2. NC1164.2 +106700 PERFORM PASS. NC1164.2 +106800 GO TO SIG-WRTE-GF-12-2. NC1164.2 +106900 SIG-FAIL-GF-12-2. NC1164.2 +107000 PERFORM FAIL. NC1164.2 +107100 MOVE "+91275" TO CORRECT-A. NC1164.2 +107200 MOVE WRK-DS-T-5 TO COMPUTED-18V0. NC1164.2 +107300 MOVE "MOVE DS-LS-5 TO WRK-DS-T-5" TO RE-MARK. NC1164.2 +107400 SIG-WRTE-GF-12-2. NC1164.2 +107500 MOVE 2 TO REC-CT. NC1164.2 +107600 PERFORM PRINT-DETAIL. NC1164.2 +107700 SIG-TEST-GF-12-3. NC1164.2 +107800 MOVE DS-TS-5 TO WRK-DS-L-5. NC1164.2 +107900 IF WRK-DS-L-5 NOT EQUAL TO +80361 NC1164.2 +108000 GO TO SIG-FAIL-GF-12-3. NC1164.2 +108100 PERFORM PASS. NC1164.2 +108200 GO TO SIG-WRITE-GF-12-3. NC1164.2 +108300 SIG-FAIL-GF-12-3. NC1164.2 +108400 PERFORM FAIL. NC1164.2 +108500 MOVE "+80361" TO CORRECT-A. NC1164.2 +108600 MOVE WRK-DS-L-5 TO COMPUTED-18V0. NC1164.2 +108700 MOVE "MOVE DS-TS-5 TO WRK-DS-L-5" TO RE-MARK. NC1164.2 +108800 SIG-WRITE-GF-12-3. NC1164.2 +108900 MOVE 3 TO REC-CT. NC1164.2 +109000 PERFORM PRINT-DETAIL. NC1164.2 +109100 SIG-TEST-GF-12-4. NC1164.2 +109200 MOVE DS-TS-5 TO WRK-DS-T-5. NC1164.2 +109300 IF WRK-DS-T-5 NOT EQUAL TO +80361 NC1164.2 +109400 GO TO SIG-FAIL-GF-12-4. NC1164.2 +109500 PERFORM PASS. NC1164.2 +109600 GO TO SIG-WRITE-GF-12-4. NC1164.2 +109700 SIG-FAIL-GF-12-4. NC1164.2 +109800 PERFORM FAIL. NC1164.2 +109900 MOVE "+80361" TO CORRECT-A. NC1164.2 +110000 MOVE WRK-DS-T-5 TO COMPUTED-18V0. NC1164.2 +110100 MOVE "MOVE DS-TS-5 TO WRK-DS-T-5" TO RE-MARK. NC1164.2 +110200 SIG-WRITE-GF-12-4. NC1164.2 +110300 MOVE 4 TO REC-CT. NC1164.2 +110400 PERFORM PRINT-DETAIL. NC1164.2 +110500 SIG-INIT-GF-13. NC1164.2 +110600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +110700 MOVE "SIG-TEST-GF-13" TO PAR-NAME. NC1164.2 +110800* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGN IS NC1164.2 +110900* SEPARATE RECEIVING ITEM AND SENDING ITEMS WITH A SIGN NC1164.2 +111000* CLAUSE BUT THE SIGN IS NOT SEPARATE. NC1164.2 +111100 MOVE ZERO TO WRK-DS-LS-5. NC1164.2 +111200 MOVE ZERO TO WRK-DS-TS-5. NC1164.2 +111300 SIG-TEST-GF-13-1. NC1164.2 +111400 MOVE DS-L-5 TO WRK-DS-LS-5. NC1164.2 +111500 IF GRP-09 EQUAL TO "+91275" NC1164.2 +111600 PERFORM PASS NC1164.2 +111700 GO TO SIG-WRITE-GF-13-1. NC1164.2 +111800 GO TO SIG-FAIL-GF-13-1. NC1164.2 +111900 SIG-DELETE-GF-13-1. NC1164.2 +112000 PERFORM DE-LETE. NC1164.2 +112100 PERFORM PRINT-DETAIL. NC1164.2 +112200 GO TO SIG-INIT-GF-14. NC1164.2 +112300 SIG-FAIL-GF-13-1. NC1164.2 +112400 PERFORM FAIL. NC1164.2 +112500 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +112600 MOVE "+91275" TO CORRECT-A. NC1164.2 +112700 MOVE "MOVE DS-L-5 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +112800 SIG-WRITE-GF-13-1. NC1164.2 +112900 MOVE 1 TO REC-CT. NC1164.2 +113000 PERFORM PRINT-DETAIL. NC1164.2 +113100 SIG-TEST-GF-13-2. NC1164.2 +113200 MOVE DS-T-4 TO WRK-DS-LS-5. NC1164.2 +113300 IF GRP-09 EQUAL TO "-03621" NC1164.2 +113400 PERFORM PASS NC1164.2 +113500 GO TO SIG-WRITE-GF-13-2. NC1164.2 +113600 SIG-FAIL-GF-13-2. NC1164.2 +113700 PERFORM FAIL. NC1164.2 +113800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +113900 MOVE "-03621" TO CORRECT-A. NC1164.2 +114000 MOVE "MOVE DS-T-4 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +114100 SIG-WRITE-GF-13-2. NC1164.2 +114200 MOVE 2 TO REC-CT. NC1164.2 +114300 PERFORM PRINT-DETAIL. NC1164.2 +114400 SIG-TEST-GF-13-3. NC1164.2 +114500 MOVE DS-L-5 TO WRK-DS-TS-5. NC1164.2 +114600 IF GRP-10 EQUAL TO "91275+" NC1164.2 +114700 PERFORM PASS NC1164.2 +114800 GO TO SIG-WRITE-GF-13-3. NC1164.2 +114900 SIG-FAIL-GF-13-3. NC1164.2 +115000 PERFORM FAIL. NC1164.2 +115100 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +115200 MOVE "91275+" TO CORRECT-A. NC1164.2 +115300 MOVE "MOVE DS-L-5 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +115400 SIG-WRITE-GF-13-3. NC1164.2 +115500 MOVE 3 TO REC-CT. NC1164.2 +115600 PERFORM PRINT-DETAIL. NC1164.2 +115700 SIG-TEST-GF-13-4. NC1164.2 +115800 MOVE DS-T-4 TO WRK-DS-TS-5. NC1164.2 +115900 IF GRP-10 EQUAL TO "03621-" NC1164.2 +116000 PERFORM PASS NC1164.2 +116100 GO TO SIG-WRITE-GF-13-4. NC1164.2 +116200 SIG-FAIL-GF-13-4. NC1164.2 +116300 PERFORM FAIL. NC1164.2 +116400 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +116500 MOVE "03621-" TO CORRECT-A. NC1164.2 +116600 MOVE "MOVE DS-T-4 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +116700 SIG-WRITE-GF-13-4. NC1164.2 +116800 MOVE 4 TO REC-CT. NC1164.2 +116900 PERFORM PRINT-DETAIL. NC1164.2 +117000 SIG-INIT-GF-14. NC1164.2 +117100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +117200 MOVE "SIG-TEST-GF-14" TO PAR-NAME. NC1164.2 +117300 MOVE "SIGNED NUM. TO ALPHA" TO FEATURE. NC1164.2 +117400* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGNED NC1164.2 +117500* NUMERIC SENDING ITEM AND ALPHANUMERIC RECEIVING ITEM. NC1164.2 +117600* THE OPERATIONAL SIGN SHOULD NOT BE MOVED AND SPACE NC1164.2 +117700* FILLING ON THE RIGHT SHOULD OCCUR. NC1164.2 +117800 SIG-TEST-GF-14-1. NC1164.2 +117900 MOVE DS-LS-5 TO AN-006. NC1164.2 +118000 IF AN-006 EQUAL TO "91275 " NC1164.2 +118100 PERFORM PASS NC1164.2 +118200 GO TO SIG-WRITE-GF-14-1. NC1164.2 +118300 GO TO SIG-FAIL-GF-14-1. NC1164.2 +118400 SIG-DELETE-GF-14-1. NC1164.2 +118500 PERFORM DE-LETE. NC1164.2 +118600 PERFORM PRINT-DETAIL. NC1164.2 +118700 GO TO SIG-INIT-GF-15. NC1164.2 +118800 SIG-FAIL-GF-14-1. NC1164.2 +118900 PERFORM FAIL. NC1164.2 +119000 MOVE AN-006 TO COMPUTED-A. NC1164.2 +119100 MOVE "91275 " TO CORRECT-A. NC1164.2 +119200 MOVE "MOVE DS-LS-5 TO AN-006" TO RE-MARK. NC1164.2 +119300 SIG-WRITE-GF-14-1. NC1164.2 +119400 MOVE 1 TO REC-CT. NC1164.2 +119500 PERFORM PRINT-DETAIL. NC1164.2 +119600 SIG-TEST-GF-14-2. NC1164.2 +119700 MOVE SPACE TO AN-006. NC1164.2 +119800 MOVE DS-TS-4 TO AN-006. NC1164.2 +119900 IF AN-006 NOT EQUAL TO "8036 " NC1164.2 +120000 GO TO SIG-FAIL-GF-14-2. NC1164.2 +120100 PERFORM PASS. NC1164.2 +120200 GO TO SIG-WRITE-GF-14-2. NC1164.2 +120300 SIG-FAIL-GF-14-2. NC1164.2 +120400 PERFORM FAIL. NC1164.2 +120500 MOVE AN-006 TO COMPUTED-A. NC1164.2 +120600 MOVE "8036 " TO CORRECT-A. NC1164.2 +120700 MOVE "MOVE DS-TS-4 TO AN-006" TO RE-MARK. NC1164.2 +120800 SIG-WRITE-GF-14-2. NC1164.2 +120900 MOVE 2 TO REC-CT. NC1164.2 +121000 PERFORM PRINT-DETAIL. NC1164.2 +121100 SIG-TEST-GF-14-3. NC1164.2 +121200 MOVE SPACE TO AN-006. NC1164.2 +121300 MOVE DS-L-4 TO AN-006. NC1164.2 +121400 IF AN-006 EQUAL TO "9127 " NC1164.2 +121500 PERFORM PASS NC1164.2 +121600 GO TO SIG-WRITE-GF-14-3. NC1164.2 +121700 SIG-FAIL-GF-14-3. NC1164.2 +121800 PERFORM FAIL. NC1164.2 +121900 MOVE AN-006 TO COMPUTED-A. NC1164.2 +122000 MOVE "9127 " TO CORRECT-A. NC1164.2 +122100 MOVE "MOVE DS-L-4 TO AN-006" TO RE-MARK. NC1164.2 +122200 SIG-WRITE-GF-14-3. NC1164.2 +122300 MOVE 3 TO REC-CT. NC1164.2 +122400 PERFORM PRINT-DETAIL. NC1164.2 +122500 SIG-TEST-GF-14-4. NC1164.2 +122600 MOVE SPACE TO AN-006. NC1164.2 +122700 MOVE DS-T-5 TO AN-006. NC1164.2 +122800 IF AN-006 NOT EQUAL TO "83621 " NC1164.2 +122900 GO TO SIG-FAIL-GF-14-4. NC1164.2 +123000 PERFORM PASS. NC1164.2 +123100 GO TO SIG-WRITE-GF-14-4. NC1164.2 +123200 SIG-FAIL-GF-14-4. NC1164.2 +123300 PERFORM FAIL. NC1164.2 +123400 MOVE AN-006 TO COMPUTED-A. NC1164.2 +123500 MOVE "83621 " TO CORRECT-A. NC1164.2 +123600 MOVE "MOVE DS-T-5 TO AN-006" TO RE-MARK. NC1164.2 +123700 SIG-WRITE-GF-14-4. NC1164.2 +123800 MOVE 4 TO REC-CT. NC1164.2 +123900 PERFORM PRINT-DETAIL. NC1164.2 +124000 SIG-INIT-GF-15. NC1164.2 +124100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +124200 MOVE "SIG-TEST-GF-15" TO PAR-NAME. NC1164.2 +124300 MOVE 15759 TO DU-005 CU-005. NC1164.2 +124400 MOVE -15759 TO DS-005 CS-005. NC1164.2 +124500* THIS TEST MOVES SIGNED AND UNSIGNED DISPLAY ITEMS, NC1164.2 +124600* SIGNED AND UNSIGNED COMPUTATIONAL ITEMS, AND SIGNED AND NC1164.2 +124700* UNSIGNED NUMERIC LITERALS TO A NUMERIC ITEM WITH SIGN NC1164.2 +124800* LEADING SEPARATE. NC1164.2 +124900 MOVE "RECEIVING ITEM DS-LS" TO FEATURE. NC1164.2 +125000 SIG-TEST-GF-15-1. NC1164.2 +125100 MOVE SPACE TO GRP-09. NC1164.2 +125200 MOVE DU-005 TO WRK-DS-LS-5. NC1164.2 +125300 IF GRP-09 EQUAL TO "+15759" NC1164.2 +125400 PERFORM PASS NC1164.2 +125500 GO TO SIG-WRITE-GF-15-1. NC1164.2 +125600 GO TO SIG-FAIL-GF-15-1. NC1164.2 +125700 SIG-DELETE-GF-15-1. NC1164.2 +125800 PERFORM DE-LETE. NC1164.2 +125900 PERFORM PRINT-DETAIL. NC1164.2 +126000 GO TO SIG-INIT-GF-16. NC1164.2 +126100 SIG-FAIL-GF-15-1. NC1164.2 +126200 PERFORM FAIL. NC1164.2 +126300 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +126400 MOVE "+15759" TO CORRECT-A. NC1164.2 +126500 MOVE "MOVE DU-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +126600 SIG-WRITE-GF-15-1. NC1164.2 +126700 MOVE 1 TO REC-CT. NC1164.2 +126800 PERFORM PRINT-DETAIL. NC1164.2 +126900 SIG-TEST-GF-15-2. NC1164.2 +127000 MOVE SPACE TO GRP-09. NC1164.2 +127100 MOVE CU-005 TO WRK-DS-LS-5. NC1164.2 +127200 IF GRP-09 NOT EQUAL TO "+15759" NC1164.2 +127300 GO TO SIG-FAIL-GF-15-2. NC1164.2 +127400 PERFORM PASS NC1164.2 +127500 GO TO SIG-WRITE-GF-15-2. NC1164.2 +127600 SIG-FAIL-GF-15-2. NC1164.2 +127700 PERFORM FAIL. NC1164.2 +127800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +127900 MOVE "+15759" TO CORRECT-A. NC1164.2 +128000 MOVE "MOVE CU-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +128100 SIG-WRITE-GF-15-2. NC1164.2 +128200 MOVE 2 TO REC-CT. NC1164.2 +128300 PERFORM PRINT-DETAIL. NC1164.2 +128400 SIG-TEST-GF-15-3. NC1164.2 +128500 MOVE SPACE TO GRP-09. NC1164.2 +128600 MOVE DS-005 TO WRK-DS-LS-5. NC1164.2 +128700 IF GRP-09 EQUAL TO "-15759" NC1164.2 +128800 PERFORM PASS NC1164.2 +128900 GO TO SIG-WRITE-GF-15-3. NC1164.2 +129000 SIG-FAIL-GF-15-3. NC1164.2 +129100 PERFORM FAIL. NC1164.2 +129200 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +129300 MOVE "-15759" TO CORRECT-A. NC1164.2 +129400 MOVE "MOVE DS-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +129500 SIG-WRITE-GF-15-3. NC1164.2 +129600 MOVE 3 TO REC-CT. NC1164.2 +129700 PERFORM PRINT-DETAIL. NC1164.2 +129800 SIG-TEST-GF-15-4. NC1164.2 +129900 MOVE SPACE TO GRP-09. NC1164.2 +130000 MOVE CS-005 TO WRK-DS-LS-5. NC1164.2 +130100 IF GRP-09 NOT EQUAL TO "-15759" NC1164.2 +130200 GO TO SIG-FAIL-GF-15-4. NC1164.2 +130300 PERFORM PASS. NC1164.2 +130400 GO TO SIG-WRITE-GF-15-4. NC1164.2 +130500 SIG-FAIL-GF-15-4. NC1164.2 +130600 PERFORM FAIL. NC1164.2 +130700 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +130800 MOVE "-15759" TO CORRECT-A. NC1164.2 +130900 MOVE "MOVE CS-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +131000 SIG-WRITE-GF-15-4. NC1164.2 +131100 MOVE 4 TO REC-CT. NC1164.2 +131200 PERFORM PRINT-DETAIL. NC1164.2 +131300 SIG-TEST-GF-15-5. NC1164.2 +131400 MOVE SPACE TO GRP-09. NC1164.2 +131500 MOVE 15759 TO WRK-DS-LS-5. NC1164.2 +131600 IF GRP-09 EQUAL TO "+15759" NC1164.2 +131700 PERFORM PASS NC1164.2 +131800 GO TO SIG-WRITE-GF-15-5. NC1164.2 +131900 SIG-FAIL-GF-15-5. NC1164.2 +132000 PERFORM FAIL. NC1164.2 +132100 MOVE "+15759" TO CORRECT-A. NC1164.2 +132200 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +132300 MOVE "MOVE 15759 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +132400 SIG-WRITE-GF-15-5. NC1164.2 +132500 MOVE 5 TO REC-CT. NC1164.2 +132600 PERFORM PRINT-DETAIL. NC1164.2 +132700 SIG-TEST-GF-15-6. NC1164.2 +132800 MOVE SPACE TO GRP-09. NC1164.2 +132900 MOVE -15759 TO WRK-DS-LS-5. NC1164.2 +133000 IF GRP-09 NOT EQUAL TO "-15759" NC1164.2 +133100 GO TO SIG-FAIL-GF-15-6. NC1164.2 +133200 PERFORM PASS. NC1164.2 +133300 GO TO SIG-WRITE-GF-15-6. NC1164.2 +133400 SIG-FAIL-GF-15-6. NC1164.2 +133500 PERFORM FAIL. NC1164.2 +133600 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +133700 MOVE "-15759" TO CORRECT-A. NC1164.2 +133800 MOVE "MOVE -15759 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +133900 SIG-WRITE-GF-15-6. NC1164.2 +134000 MOVE 6 TO REC-CT. NC1164.2 +134100 PERFORM PRINT-DETAIL. NC1164.2 +134200 SIG-INIT-GF-16. NC1164.2 +134300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +134400 MOVE "SIG-TEST-GF-16" TO PAR-NAME. NC1164.2 +134500 MOVE "RECEIVING ITEM DS-TS" TO FEATURE. NC1164.2 +134600* THIS TEST MOVES SIGNED AND UNSIGNED DISPLAY ITEMS, NC1164.2 +134700* SIGNED AND UNSIGNED COMPUTATIONAL ITEMS, AND SIGNED AND NC1164.2 +134800* UNSIGNED NUMERIC LITERALS TO A NUMERIC ITEM WITH SIGN NC1164.2 +134900* TRAILING SEPARATE CLAUSE. NC1164.2 +135000 MOVE SPACE TO GRP-10. NC1164.2 +135100 MOVE DU-005 TO WRK-DS-TS-5. NC1164.2 +135200 SIG-TEST-GF-16-1. NC1164.2 +135300 IF GRP-10 EQUAL TO "15759+" NC1164.2 +135400 PERFORM PASS NC1164.2 +135500 GO TO SIG-WRITE-GF-16-1. NC1164.2 +135600 GO TO SIG-FAIL-GF-16-1. NC1164.2 +135700 SIG-DELETE-GF-16-1. NC1164.2 +135800 PERFORM DE-LETE. NC1164.2 +135900 PERFORM PRINT-DETAIL. NC1164.2 +136000 GO TO SIG-INIT-GF-17. NC1164.2 +136100 SIG-FAIL-GF-16-1. NC1164.2 +136200 PERFORM FAIL. NC1164.2 +136300 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +136400 MOVE "15759+" TO CORRECT-A. NC1164.2 +136500 MOVE "MOVE DU-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +136600 SIG-WRITE-GF-16-1. NC1164.2 +136700 MOVE 1 TO REC-CT. NC1164.2 +136800 PERFORM PRINT-DETAIL. NC1164.2 +136900 SIG-TEST-GF-16-2. NC1164.2 +137000 MOVE SPACE TO GRP-10. NC1164.2 +137100 MOVE CU-005 TO WRK-DS-TS-5. NC1164.2 +137200 IF GRP-10 NOT EQUAL TO "15759+" NC1164.2 +137300 GO TO SIG-FAIL-GF-16-2. NC1164.2 +137400 PERFORM PASS. NC1164.2 +137500 GO TO SIG-WRITE-GF-16-2. NC1164.2 +137600 SIG-FAIL-GF-16-2. NC1164.2 +137700 PERFORM FAIL. NC1164.2 +137800 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +137900 MOVE "15759+" TO CORRECT-A. NC1164.2 +138000 MOVE "MOVE CU-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +138100 SIG-WRITE-GF-16-2. NC1164.2 +138200 MOVE 2 TO REC-CT. NC1164.2 +138300 PERFORM PRINT-DETAIL. NC1164.2 +138400 SIG-TEST-GF-16-3. NC1164.2 +138500 MOVE SPACE TO GRP-10. NC1164.2 +138600 MOVE DS-005 TO WRK-DS-TS-5. NC1164.2 +138700 IF GRP-10 EQUAL TO "15759-" NC1164.2 +138800 PERFORM PASS NC1164.2 +138900 GO TO SIG-WRITE-GF-16-3. NC1164.2 +139000 SIG-FAIL-GF-16-3. NC1164.2 +139100 PERFORM FAIL. NC1164.2 +139200 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +139300 MOVE "15759-" TO CORRECT-A. NC1164.2 +139400 MOVE "MOVE DS-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +139500 SIG-WRITE-GF-16-3. NC1164.2 +139600 MOVE 3 TO REC-CT. NC1164.2 +139700 PERFORM PRINT-DETAIL. NC1164.2 +139800 SIG-TEST-GF-16-4. NC1164.2 +139900 MOVE SPACE TO GRP-10. NC1164.2 +140000 MOVE CS-005 TO WRK-DS-TS-5. NC1164.2 +140100 IF GRP-10 NOT EQUAL TO "15759-" NC1164.2 +140200 GO TO SIG-FAIL-GF-16-4. NC1164.2 +140300 PERFORM PASS. NC1164.2 +140400 GO TO SIG-WRITE-GF-16-4. NC1164.2 +140500 SIG-FAIL-GF-16-4. NC1164.2 +140600 PERFORM FAIL. NC1164.2 +140700 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +140800 MOVE "15759-" TO CORRECT-A. NC1164.2 +140900 MOVE "MOVE CS-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +141000 SIG-WRITE-GF-16-4. NC1164.2 +141100 MOVE 4 TO REC-CT. NC1164.2 +141200 PERFORM PRINT-DETAIL. NC1164.2 +141300 SIG-TEST-GF-16-5. NC1164.2 +141400 MOVE SPACE TO GRP-10. NC1164.2 +141500 MOVE 15759 TO WRK-DS-TS-5. NC1164.2 +141600 IF GRP-10 EQUAL TO "15759+" NC1164.2 +141700 PERFORM PASS NC1164.2 +141800 GO TO SIG-WRITE-GF-16-5. NC1164.2 +141900 SIG-FAIL-GF-16-5. NC1164.2 +142000 PERFORM FAIL. NC1164.2 +142100 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +142200 MOVE "15759+" TO CORRECT-A. NC1164.2 +142300 MOVE "MOVE 15759 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +142400 SIG-WRITE-GF-16-5. NC1164.2 +142500 MOVE 5 TO REC-CT. NC1164.2 +142600 PERFORM PRINT-DETAIL. NC1164.2 +142700 SIG-TEST-GF-16-6. NC1164.2 +142800 MOVE SPACE TO GRP-10. NC1164.2 +142900 MOVE -15759 TO WRK-DS-TS-5. NC1164.2 +143000 IF GRP-10 NOT EQUAL TO "15759-" NC1164.2 +143100 GO TO SIG-FAIL-GF-16-6. NC1164.2 +143200 PERFORM PASS. NC1164.2 +143300 GO TO SIG-WRITE-GF-16-6. NC1164.2 +143400 SIG-FAIL-GF-16-6. NC1164.2 +143500 PERFORM FAIL. NC1164.2 +143600 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +143700 MOVE "15759-" TO CORRECT-A. NC1164.2 +143800 MOVE "MOVE -15759 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +143900 SIG-WRITE-GF-16-6. NC1164.2 +144000 MOVE 6 TO REC-CT. NC1164.2 +144100 PERFORM PRINT-DETAIL. NC1164.2 +144200* NC1164.2 +144300 SIG-INIT-GF-17. NC1164.2 +144400 MOVE "VI-42 5.12.4 GR2" TO ANSI-REFERENCE. NC1164.2 +144500 MOVE "SIG-TEST-GF-17" TO PAR-NAME. NC1164.2 +144600 MOVE "PRECEDENCE OF SUBORDINATE SIGN CLAUSE" TO FEATURE. NC1164.2 +144700 MOVE 1234 TO TEST-17-C. NC1164.2 +144800 MOVE 0 TO REC-CT. NC1164.2 +144900 SIG-TEST-GF-17. NC1164.2 +145000 IF TEST-17-C-SIGN = "+" NC1164.2 +145100 PERFORM PASS NC1164.2 +145200 GO TO SIG-WRITE-GF-17 NC1164.2 +145300 ELSE NC1164.2 +145400 GO TO SIG-FAIL-GF-17. NC1164.2 +145500 SIG-DELETE-GF-17. NC1164.2 +145600 PERFORM DE-LETE. NC1164.2 +145700 GO TO SIG-WRITE-GF-17. NC1164.2 +145800 SIG-FAIL-GF-17. NC1164.2 +145900 PERFORM FAIL. NC1164.2 +146000 MOVE "POSITIVE SIGN EXPECTED" TO RE-MARK. NC1164.2 +146100 MOVE "+" TO CORRECT-X. NC1164.2 +146200 MOVE TEST-17-C-SIGN TO COMPUTED-X. NC1164.2 +146300 SIG-WRITE-GF-17. NC1164.2 +146400 PERFORM PRINT-DETAIL. NC1164.2 +146500* NC1164.2 +146600 SIG-INIT-GF-18. NC1164.2 +146700 MOVE "VI-42 5.12.4 GR3" TO ANSI-REFERENCE. NC1164.2 +146800 MOVE "SIG-TEST-GF-18" TO PAR-NAME. NC1164.2 +146900 MOVE "PRECEDENCE OF SUBORDINATE SIGN CLAUSE" TO FEATURE. NC1164.2 +147000 MOVE 1234 TO TEST-18-B. NC1164.2 +147100 MOVE 0 TO REC-CT. NC1164.2 +147200 SIG-TEST-GF-18. NC1164.2 +147300 IF TEST-18-B-SIGN = "+" NC1164.2 +147400 PERFORM PASS NC1164.2 +147500 GO TO SIG-WRITE-GF-18 NC1164.2 +147600 ELSE NC1164.2 +147700 GO TO SIG-FAIL-GF-18. NC1164.2 +147800 SIG-DELETE-GF-18. NC1164.2 +147900 PERFORM DE-LETE. NC1164.2 +148000 GO TO SIG-WRITE-GF-18. NC1164.2 +148100 SIG-FAIL-GF-18. NC1164.2 +148200 PERFORM FAIL. NC1164.2 +148300 MOVE "POSITIVE SIGN EXPECTED" TO RE-MARK. NC1164.2 +148400 MOVE "+" TO CORRECT-X. NC1164.2 +148500 MOVE TEST-18-B-SIGN TO COMPUTED-X. NC1164.2 +148600 SIG-WRITE-GF-18. NC1164.2 +148700 PERFORM PRINT-DETAIL. NC1164.2 +148800* NC1164.2 +148900 TERMINATE-ROUTINE. NC1164.2 +149000 EXIT. NC1164.2 +149100 CCVS-EXIT SECTION. NC1164.2 +149200 CCVS-999999. NC1164.2 +149300 GO TO CLOSE-FILES. NC1164.2 +*END-OF,NC116A +*HEADER,COBOL,NC117A +000100 IDENTIFICATION DIVISION. NC1174.2 +000200 PROGRAM-ID. NC1174.2 +000300 NC117A. NC1174.2 +000400**************************************************************** NC1174.2 +000500* * NC1174.2 +000600* VALIDATION FOR:- * NC1174.2 +000700* * NC1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +000900* * NC1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1174.2 +001100* * NC1174.2 +001200**************************************************************** NC1174.2 +001300* * NC1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1174.2 +001500* * NC1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1174.2 +001900* * NC1174.2 +002000**************************************************************** NC1174.2 +002100* NC1174.2 +002200* PROGRAM NC117A TESTS THE USE OF THE "SIGN" CLAUSE USING NC1174.2 +002300* THE "DIVIDE" STATEMENT. ALL COMBINATIONS OF THE "SIGN" NC1174.2 +002400* CLAUSE PHRASES ARE TESTED USING DATA ITEMS OF NC1174.2 +002500* LENGTHS. NC1174.2 +002600* NC1174.2 +002700* NC1174.2 +002800 NC1174.2 +002900 NC1174.2 +003000 ENVIRONMENT DIVISION. NC1174.2 +003100 CONFIGURATION SECTION. NC1174.2 +003200 SOURCE-COMPUTER. NC1174.2 +003300 XXXXX082. NC1174.2 +003400 OBJECT-COMPUTER. NC1174.2 +003500 XXXXX083. NC1174.2 +003600 INPUT-OUTPUT SECTION. NC1174.2 +003700 FILE-CONTROL. NC1174.2 +003800 SELECT PRINT-FILE ASSIGN TO NC1174.2 +003900 XXXXX055. NC1174.2 +004000 DATA DIVISION. NC1174.2 +004100 FILE SECTION. NC1174.2 +004200 FD PRINT-FILE. NC1174.2 +004300 01 PRINT-REC PICTURE X(120). NC1174.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1174.2 +004500 WORKING-STORAGE SECTION. NC1174.2 +004600 77 WRK-DS-LS-18V00 PICTURE S9(18) NC1174.2 +004700 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +004800 77 A06THREES-DS-LS-03V03 PICTURE S999V999 VALUE 333.333NC1174.2 +004900 SIGN IS LEADING. NC1174.2 +005000 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1174.2 +005100 SIGN IS TRAILING SEPARATE CHARACTER. NC1174.2 +005200 77 WRK-DS-TS-12V00-S-S REDEFINES WRK-DS-TS-06V06 PICTURE S9(12) NC1174.2 +005300 SIGN TRAILING SEPARATE. NC1174.2 +005400 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1174.2 +005500 77 WRK-DS-10V00 PICTURE S9(10). NC1174.2 +005600 77 WRK-XN-00001 PICTURE X. NC1174.2 +005700 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1174.2 +005800 SIGN IS TRAILING NC1174.2 +005900 VALUE 1111111111. NC1174.2 +006000 77 A12THREES-DS-LS-06V06 PICTURE S9(6)V9(6) NC1174.2 +006100 SIGN IS LEADING SEPARATE NC1174.2 +006200 VALUE 333333.333333. NC1174.2 +006300 77 WRK-DS-02V00 PICTURE S99. NC1174.2 +006400 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) VALUE ZERO NC1174.2 +006500 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +006600 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1174.2 +006700 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1174.2 +006800 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) VALUE .11111 NC1174.2 +006900 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +007000 77 A12ONES-DS-12V00 PICTURE S9(12) NC1174.2 +007100 VALUE 111111111111. NC1174.2 +007200 77 A01ONE-DS-TS-P0801 PICTURE SP(8)9 VALUE .000000001NC1174.2 +007300 SIGN IS TRAILING SEPARATE. NC1174.2 +007400 77 WRK-DS-T-09V08 PICTURE S9(9)V9(8) NC1174.2 +007500 SIGN IS TRAILING. NC1174.2 +007600 77 WKR-DS-T-17V00-S REDEFINES WRK-DS-T-09V08 PICTURE S9(17) NC1174.2 +007700 SIGN TRAILING. NC1174.2 +007800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1174.2 +007900 VALUE 111111111111111111. NC1174.2 +008000 77 WRK-DS-LS-0201P PICTURE S99P NC1174.2 +008100 SIGN IS LEADING SEPARATE. NC1174.2 +008200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1174.2 +008300 77 WRK-DU-18V00 PICTURE 9(18). NC1174.2 +008400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1174.2 +008500 VALUE 99. NC1174.2 +008600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1174.2 +008700 VALUE .1. NC1174.2 +008800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1174.2 +008900 77 WRK-DS-TS-12V00-S PICTURE S9(12) NC1174.2 +009000 SIGN IS TRAILING SEPARATE CHARACTER. NC1174.2 +009100 77 WRK-DS-LS-01V00 PICTURE S9 LEADING SEPARATE. NC1174.2 +009200 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1174.2 +009300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1174.2 +009400 LEADING SEPARATE NC1174.2 +009500 VALUE 111111111.111111111. NC1174.2 +009600 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1174.2 +009700 77 WRK-DS-05V00 PICTURE S9(5). NC1174.2 +009800 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1174.2 +009900 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1174.2 +010000 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1174.2 +010100 77 XRAY PICTURE X. NC1174.2 +010200 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1174.2 +010300 VALUE +000000000000000001. NC1174.2 +010400 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1174.2 +010500 VALUE -000000000000000033. NC1174.2 +010600 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +010700 VALUE 666666666666666666. NC1174.2 +010800 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +010900 VALUE 009999999999999999. NC1174.2 +011000 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +011100 VALUE 000022222222222222. NC1174.2 +011200 01 MULTIPLY-DATA LEADING SEPARATE. NC1174.2 +011300 02 MULT1 PICTURE IS 999V99 NC1174.2 +011400 VALUE IS 80.12. NC1174.2 +011500 02 MULT2 PICTURE IS 999V999. NC1174.2 +011600 02 MULT3 PICTURE IS $$99.99. NC1174.2 +011700 02 MULT4 PICTURE IS S99 NC1174.2 +011800 VALUE IS -56. NC1174.2 +011900 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1174.2 +012000 02 MULT6 PICTURE IS 99 VALUE IS NC1174.2 +012100 20. NC1174.2 +012200 01 DIVIDE-DATA TRAILING SEPARATE. NC1174.2 +012300 02 DIV1 PICTURE IS 9(4)V99 NC1174.2 +012400 VALUE IS 1620.36. NC1174.2 +012500 02 DIV2 PICTURE IS 99V9 NC1174.2 +012600 VALUE IS 44.1. NC1174.2 +012700 02 DIV3 PICTURE IS 9(4)V9 NC1174.2 +012800 VALUE IS 1661.7. NC1174.2 +012900 02 DIV4 PICTURE IS S9V999 NC1174.2 +013000 VALUE IS -9.642. NC1174.2 +013100 02 SIG-02LEVEL-1. NC1174.2 +013200 03 DIV5 PICTURE IS V99 NC1174.2 +013300 VALUE IS .82. NC1174.2 +013400 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1174.2 +013500 03 DIV7 PICTURE IS 9V9 NC1174.2 +013600 VALUE IS 9.6. NC1174.2 +013700 01 SIG-DATA-2. NC1174.2 +013800 02 DIV8 PICTURE IS 99V9. NC1174.2 +013900 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1174.2 +014000 02 DIV10 PICTURE IS V999. NC1174.2 +014100 01 TEST-RESULTS. NC1174.2 +014200 02 FILLER PIC X VALUE SPACE. NC1174.2 +014300 02 FEATURE PIC X(20) VALUE SPACE. NC1174.2 +014400 02 FILLER PIC X VALUE SPACE. NC1174.2 +014500 02 P-OR-F PIC X(5) VALUE SPACE. NC1174.2 +014600 02 FILLER PIC X VALUE SPACE. NC1174.2 +014700 02 PAR-NAME. NC1174.2 +014800 03 FILLER PIC X(19) VALUE SPACE. NC1174.2 +014900 03 PARDOT-X PIC X VALUE SPACE. NC1174.2 +015000 03 DOTVALUE PIC 99 VALUE ZERO. NC1174.2 +015100 02 FILLER PIC X(8) VALUE SPACE. NC1174.2 +015200 02 RE-MARK PIC X(61). NC1174.2 +015300 01 TEST-COMPUTED. NC1174.2 +015400 02 FILLER PIC X(30) VALUE SPACE. NC1174.2 +015500 02 FILLER PIC X(17) VALUE NC1174.2 +015600 " COMPUTED=". NC1174.2 +015700 02 COMPUTED-X. NC1174.2 +015800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1174.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A NC1174.2 +016000 PIC -9(9).9(9). NC1174.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1174.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1174.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1174.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. NC1174.2 +016500 04 COMPUTED-18V0 PIC -9(18). NC1174.2 +016600 04 FILLER PIC X. NC1174.2 +016700 03 FILLER PIC X(50) VALUE SPACE. NC1174.2 +016800 01 TEST-CORRECT. NC1174.2 +016900 02 FILLER PIC X(30) VALUE SPACE. NC1174.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1174.2 +017100 02 CORRECT-X. NC1174.2 +017200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1174.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1174.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1174.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1174.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1174.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. NC1174.2 +017800 04 CORRECT-18V0 PIC -9(18). NC1174.2 +017900 04 FILLER PIC X. NC1174.2 +018000 03 FILLER PIC X(2) VALUE SPACE. NC1174.2 +018100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1174.2 +018200 01 CCVS-C-1. NC1174.2 +018300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1174.2 +018400- "SS PARAGRAPH-NAME NC1174.2 +018500- " REMARKS". NC1174.2 +018600 02 FILLER PIC X(20) VALUE SPACE. NC1174.2 +018700 01 CCVS-C-2. NC1174.2 +018800 02 FILLER PIC X VALUE SPACE. NC1174.2 +018900 02 FILLER PIC X(6) VALUE "TESTED". NC1174.2 +019000 02 FILLER PIC X(15) VALUE SPACE. NC1174.2 +019100 02 FILLER PIC X(4) VALUE "FAIL". NC1174.2 +019200 02 FILLER PIC X(94) VALUE SPACE. NC1174.2 +019300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1174.2 +019400 01 REC-CT PIC 99 VALUE ZERO. NC1174.2 +019500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1174.2 +020000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1174.2 +020100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1174.2 +020200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1174.2 +020300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1174.2 +020400 01 CCVS-H-1. NC1174.2 +020500 02 FILLER PIC X(39) VALUE SPACES. NC1174.2 +020600 02 FILLER PIC X(42) VALUE NC1174.2 +020700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1174.2 +020800 02 FILLER PIC X(39) VALUE SPACES. NC1174.2 +020900 01 CCVS-H-2A. NC1174.2 +021000 02 FILLER PIC X(40) VALUE SPACE. NC1174.2 +021100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1174.2 +021200 02 FILLER PIC XXXX VALUE NC1174.2 +021300 "4.2 ". NC1174.2 +021400 02 FILLER PIC X(28) VALUE NC1174.2 +021500 " COPY - NOT FOR DISTRIBUTION". NC1174.2 +021600 02 FILLER PIC X(41) VALUE SPACE. NC1174.2 +021700 NC1174.2 +021800 01 CCVS-H-2B. NC1174.2 +021900 02 FILLER PIC X(15) VALUE NC1174.2 +022000 "TEST RESULT OF ". NC1174.2 +022100 02 TEST-ID PIC X(9). NC1174.2 +022200 02 FILLER PIC X(4) VALUE NC1174.2 +022300 " IN ". NC1174.2 +022400 02 FILLER PIC X(12) VALUE NC1174.2 +022500 " HIGH ". NC1174.2 +022600 02 FILLER PIC X(22) VALUE NC1174.2 +022700 " LEVEL VALIDATION FOR ". NC1174.2 +022800 02 FILLER PIC X(58) VALUE NC1174.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +023000 01 CCVS-H-3. NC1174.2 +023100 02 FILLER PIC X(34) VALUE NC1174.2 +023200 " FOR OFFICIAL USE ONLY ". NC1174.2 +023300 02 FILLER PIC X(58) VALUE NC1174.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1174.2 +023500 02 FILLER PIC X(28) VALUE NC1174.2 +023600 " COPYRIGHT 1985 ". NC1174.2 +023700 01 CCVS-E-1. NC1174.2 +023800 02 FILLER PIC X(52) VALUE SPACE. NC1174.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1174.2 +024000 02 ID-AGAIN PIC X(9). NC1174.2 +024100 02 FILLER PIC X(45) VALUE SPACES. NC1174.2 +024200 01 CCVS-E-2. NC1174.2 +024300 02 FILLER PIC X(31) VALUE SPACE. NC1174.2 +024400 02 FILLER PIC X(21) VALUE SPACE. NC1174.2 +024500 02 CCVS-E-2-2. NC1174.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1174.2 +024700 03 FILLER PIC X VALUE SPACE. NC1174.2 +024800 03 ENDER-DESC PIC X(44) VALUE NC1174.2 +024900 "ERRORS ENCOUNTERED". NC1174.2 +025000 01 CCVS-E-3. NC1174.2 +025100 02 FILLER PIC X(22) VALUE NC1174.2 +025200 " FOR OFFICIAL USE ONLY". NC1174.2 +025300 02 FILLER PIC X(12) VALUE SPACE. NC1174.2 +025400 02 FILLER PIC X(58) VALUE NC1174.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +025600 02 FILLER PIC X(13) VALUE SPACE. NC1174.2 +025700 02 FILLER PIC X(15) VALUE NC1174.2 +025800 " COPYRIGHT 1985". NC1174.2 +025900 01 CCVS-E-4. NC1174.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1174.2 +026100 02 FILLER PIC X(4) VALUE " OF ". NC1174.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1174.2 +026300 02 FILLER PIC X(40) VALUE NC1174.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1174.2 +026500 01 XXINFO. NC1174.2 +026600 02 FILLER PIC X(19) VALUE NC1174.2 +026700 "*** INFORMATION ***". NC1174.2 +026800 02 INFO-TEXT. NC1174.2 +026900 04 FILLER PIC X(8) VALUE SPACE. NC1174.2 +027000 04 XXCOMPUTED PIC X(20). NC1174.2 +027100 04 FILLER PIC X(5) VALUE SPACE. NC1174.2 +027200 04 XXCORRECT PIC X(20). NC1174.2 +027300 02 INF-ANSI-REFERENCE PIC X(48). NC1174.2 +027400 01 HYPHEN-LINE. NC1174.2 +027500 02 FILLER PIC IS X VALUE IS SPACE. NC1174.2 +027600 02 FILLER PIC IS X(65) VALUE IS "************************NC1174.2 +027700- "*****************************************". NC1174.2 +027800 02 FILLER PIC IS X(54) VALUE IS "************************NC1174.2 +027900- "******************************". NC1174.2 +028000 01 CCVS-PGM-ID PIC X(9) VALUE NC1174.2 +028100 "NC117A". NC1174.2 +028200 PROCEDURE DIVISION. NC1174.2 +028300 CCVS1 SECTION. NC1174.2 +028400 OPEN-FILES. NC1174.2 +028500 OPEN OUTPUT PRINT-FILE. NC1174.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1174.2 +028700 MOVE SPACE TO TEST-RESULTS. NC1174.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1174.2 +028900 GO TO CCVS1-EXIT. NC1174.2 +029000 CLOSE-FILES. NC1174.2 +029100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1174.2 +029200 TERMINATE-CCVS. NC1174.2 +029300S EXIT PROGRAM. NC1174.2 +029400STERMINATE-CALL. NC1174.2 +029500 STOP RUN. NC1174.2 +029600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1174.2 +029700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1174.2 +029800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1174.2 +029900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1174.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. NC1174.2 +030100 PRINT-DETAIL. NC1174.2 +030200 IF REC-CT NOT EQUAL TO ZERO NC1174.2 +030300 MOVE "." TO PARDOT-X NC1174.2 +030400 MOVE REC-CT TO DOTVALUE. NC1174.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1174.2 +030600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1174.2 +030700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1174.2 +030800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1174.2 +030900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1174.2 +031000 MOVE SPACE TO CORRECT-X. NC1174.2 +031100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1174.2 +031200 MOVE SPACE TO RE-MARK. NC1174.2 +031300 HEAD-ROUTINE. NC1174.2 +031400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +031500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +031600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1174.2 +031700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1174.2 +031800 COLUMN-NAMES-ROUTINE. NC1174.2 +031900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +032000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +032200 END-ROUTINE. NC1174.2 +032300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1174.2 +032400 END-RTN-EXIT. NC1174.2 +032500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +032600 END-ROUTINE-1. NC1174.2 +032700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1174.2 +032800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1174.2 +032900 ADD PASS-COUNTER TO ERROR-HOLD. NC1174.2 +033000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1174.2 +033100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1174.2 +033200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1174.2 +033300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1174.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1174.2 +033500 END-ROUTINE-12. NC1174.2 +033600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1174.2 +033700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1174.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1174.2 +033900 ELSE NC1174.2 +034000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1174.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1174.2 +034200 PERFORM WRITE-LINE. NC1174.2 +034300 END-ROUTINE-13. NC1174.2 +034400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1174.2 +034500 MOVE "NO " TO ERROR-TOTAL ELSE NC1174.2 +034600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1174.2 +034700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1174.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +034900 IF INSPECT-COUNTER EQUAL TO ZERO NC1174.2 +035000 MOVE "NO " TO ERROR-TOTAL NC1174.2 +035100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1174.2 +035200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1174.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +035400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +035500 WRITE-LINE. NC1174.2 +035600 ADD 1 TO RECORD-COUNT. NC1174.2 +035700Y IF RECORD-COUNT GREATER 42 NC1174.2 +035800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1174.2 +035900Y MOVE SPACE TO DUMMY-RECORD NC1174.2 +036000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1174.2 +036100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1174.2 +036200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1174.2 +036300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1174.2 +036400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1174.2 +036500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1174.2 +036900Y MOVE ZERO TO RECORD-COUNT. NC1174.2 +037000 PERFORM WRT-LN. NC1174.2 +037100 WRT-LN. NC1174.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1174.2 +037300 MOVE SPACE TO DUMMY-RECORD. NC1174.2 +037400 BLANK-LINE-PRINT. NC1174.2 +037500 PERFORM WRT-LN. NC1174.2 +037600 FAIL-ROUTINE. NC1174.2 +037700 IF COMPUTED-X NOT EQUAL TO SPACE NC1174.2 +037800 GO TO FAIL-ROUTINE-WRITE. NC1174.2 +037900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1174.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1174.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1174.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1174.2 +038400 GO TO FAIL-ROUTINE-EX. NC1174.2 +038500 FAIL-ROUTINE-WRITE. NC1174.2 +038600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1174.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1174.2 +038800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1174.2 +038900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1174.2 +039000 FAIL-ROUTINE-EX. EXIT. NC1174.2 +039100 BAIL-OUT. NC1174.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1174.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1174.2 +039400 BAIL-OUT-WRITE. NC1174.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1174.2 +039600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1174.2 +039700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +039800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1174.2 +039900 BAIL-OUT-EX. EXIT. NC1174.2 +040000 CCVS1-EXIT. NC1174.2 +040100 EXIT. NC1174.2 +040200 SECT-NC117A-001 SECTION. NC1174.2 +040300 SIG-INIT-GF-1. NC1174.2 +040400 MOVE "DIVIDE INTO" TO FEATURE. NC1174.2 +040500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +040600 MOVE 1620.36 TO DIV1. NC1174.2 +040700 SIG-TEST-GF-1-0. NC1174.2 +040800 DIVIDE 64.3 INTO DIV1. NC1174.2 +040900 SIG-TEST-GF-1-1. NC1174.2 +041000 IF DIV1 EQUAL TO 25.2 NC1174.2 +041100 PERFORM PASS NC1174.2 +041200 ELSE NC1174.2 +041300 GO TO SIG-FAIL-GF-1. NC1174.2 +041400 GO TO SIG-WRITE-GF-1. NC1174.2 +041500 SIG-DELETE-GF-1. NC1174.2 +041600 PERFORM DE-LETE. NC1174.2 +041700 GO TO SIG-WRITE-GF-1. NC1174.2 +041800 SIG-FAIL-GF-1. NC1174.2 +041900 PERFORM FAIL. NC1174.2 +042000 MOVE DIV1 TO COMPUTED-N. NC1174.2 +042100 MOVE +25.2 TO CORRECT-N. NC1174.2 +042200 SIG-WRITE-GF-1. NC1174.2 +042300 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1174.2 +042400 PERFORM PRINT-DETAIL. NC1174.2 +042500 SIG-INIT-GF-2. NC1174.2 +042600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +042700 MOVE 44.1 TO DIV2. NC1174.2 +042800 MOVE 1661.7 TO DIV3. NC1174.2 +042900 SIG-TEST-GF-2. NC1174.2 +043000 DIVIDE DIV2 INTO DIV3 ROUNDED. NC1174.2 +043100 IF DIV3 EQUAL TO 37.7 NC1174.2 +043200 PERFORM PASS NC1174.2 +043300 ELSE NC1174.2 +043400 GO TO SIG-FAIL-GF-2. NC1174.2 +043500 GO TO SIG-WRITE-GF-2. NC1174.2 +043600 SIG-DELETE-GF-2. NC1174.2 +043700 PERFORM DE-LETE. NC1174.2 +043800 GO TO SIG-WRITE-GF-2. NC1174.2 +043900 SIG-FAIL-GF-2. NC1174.2 +044000 PERFORM FAIL. NC1174.2 +044100 MOVE DIV3 TO COMPUTED-N. NC1174.2 +044200 MOVE +37.7 TO CORRECT-N. NC1174.2 +044300 SIG-WRITE-GF-2. NC1174.2 +044400 MOVE "SIG-TEST-GF-2 " TO PAR-NAME. NC1174.2 +044500 PERFORM PRINT-DETAIL. NC1174.2 +044600 SIG-INIT-GF-3. NC1174.2 +044700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +044800 MOVE -9.642 TO DIV4. NC1174.2 +044900 MOVE .82 TO DIV5. NC1174.2 +045000 MOVE "A" TO XRAY. NC1174.2 +045100 SIG-TEST-GF-3-0. NC1174.2 +045200 DIVIDE DIV5 INTO DIV4 ON SIZE ERROR NC1174.2 +045300 MOVE "M" TO XRAY. NC1174.2 +045400 SIG-TEST-GF-3-1. NC1174.2 +045500 IF XRAY EQUAL TO "M" NC1174.2 +045600 PERFORM PASS NC1174.2 +045700 ELSE NC1174.2 +045800 GO TO SIG-FAIL-GF-3. NC1174.2 +045900 GO TO SIG-WRITE-GF-3. NC1174.2 +046000 SIG-DELETE-GF-3-1. NC1174.2 +046100 PERFORM DE-LETE. NC1174.2 +046200 GO TO SIG-WRITE-GF-3. NC1174.2 +046300 SIG-FAIL-GF-3. NC1174.2 +046400 MOVE DIV4 TO COMPUTED-N. NC1174.2 +046500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +046600 PERFORM FAIL. NC1174.2 +046700 SIG-WRITE-GF-3. NC1174.2 +046800 MOVE "SIG-TEST-GF-3-1" TO PAR-NAME. NC1174.2 +046900 PERFORM PRINT-DETAIL. NC1174.2 +047000 SIG-TEST-GF-3-2. NC1174.2 +047100 IF DIV4 EQUAL TO -9.642 NC1174.2 +047200 PERFORM PASS NC1174.2 +047300 ELSE NC1174.2 +047400 GO TO SIG-FAIL-GF-3-2. NC1174.2 +047500 GO TO SIG-WRITE-GF-3-2. NC1174.2 +047600 SIG-DELETE-GF-3-2. NC1174.2 +047700 PERFORM DE-LETE. NC1174.2 +047800 GO TO SIG-WRITE-GF-3-2. NC1174.2 +047900 SIG-FAIL-GF-3-2. NC1174.2 +048000 PERFORM FAIL. NC1174.2 +048100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +048200 MOVE DIV4 TO COMPUTED-N. NC1174.2 +048300 MOVE -9.642 TO CORRECT-N. NC1174.2 +048400 SIG-WRITE-GF-3-2. NC1174.2 +048500 MOVE "SIG-TEST-GF-3-2 " TO PAR-NAME. NC1174.2 +048600 PERFORM PRINT-DETAIL. NC1174.2 +048700 SIG-INIT-GF-4. NC1174.2 +048800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +048900 MOVE 44.1 TO DIV2. NC1174.2 +049000 MOVE 0 TO DIV6. NC1174.2 +049100 MOVE "A" TO XRAY. NC1174.2 +049200 SIG-TEST-GF-4-1-0. NC1174.2 +049300 DIVIDE DIV6 INTO DIV2 ON SIZE ERROR NC1174.2 +049400 MOVE "N" TO XRAY. NC1174.2 +049500 SIG-TEST-GF-4-1-1. NC1174.2 +049600 IF XRAY EQUAL TO "N" NC1174.2 +049700 PERFORM PASS NC1174.2 +049800 ELSE NC1174.2 +049900 GO TO SIG-FAIL-GF-4-1. NC1174.2 +050000 GO TO SIG-WRITE-GF-4-1. NC1174.2 +050100 SIG-DELETE-GF-4-1. NC1174.2 +050200 PERFORM DE-LETE. NC1174.2 +050300 GO TO SIG-WRITE-GF-4-1. NC1174.2 +050400 SIG-FAIL-GF-4-1. NC1174.2 +050500 MOVE DIV2 TO COMPUTED-N. NC1174.2 +050600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +050700 PERFORM FAIL. NC1174.2 +050800 SIG-WRITE-GF-4-1. NC1174.2 +050900 MOVE "SIG-TEST-GF-4-1 " TO PAR-NAME. NC1174.2 +051000 PERFORM PRINT-DETAIL. NC1174.2 +051100 SIG-TEST-GF-4-2. NC1174.2 +051200 IF DIV2 EQUAL TO 44.1 NC1174.2 +051300 PERFORM PASS NC1174.2 +051400 ELSE NC1174.2 +051500 GO TO SIG-FAIL-GF-4-2. NC1174.2 +051600 GO TO SIG-WRITE-GF-4-2. NC1174.2 +051700 SIG-DELETE-GF-4-2. NC1174.2 +051800 PERFORM DE-LETE. NC1174.2 +051900 GO TO SIG-WRITE-GF-4-2. NC1174.2 +052000 SIG-FAIL-GF-4-2. NC1174.2 +052100 PERFORM FAIL. NC1174.2 +052200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +052300 MOVE DIV2 TO COMPUTED-N. NC1174.2 +052400 MOVE +44.1000 TO CORRECT-N. NC1174.2 +052500 SIG-WRITE-GF-4-2. NC1174.2 +052600 MOVE "SIG-TEST-GF-4-2 " TO PAR-NAME. NC1174.2 +052700 PERFORM PRINT-DETAIL. NC1174.2 +052800 SIG-INIT-GF-5. NC1174.2 +052900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +053000 MOVE 9.6 TO DIV7. NC1174.2 +053100 MOVE "A" TO XRAY. NC1174.2 +053200 SIG-TEST-GF-5-0. NC1174.2 +053300 DIVIDE 0.097 INTO DIV7 ROUNDED ON SIZE ERROR NC1174.2 +053400 MOVE "N" TO XRAY. NC1174.2 +053500 SIG-TEST-GF-5-1. NC1174.2 +053600 IF XRAY EQUAL TO "N" NC1174.2 +053700 PERFORM PASS NC1174.2 +053800 ELSE NC1174.2 +053900 GO TO SIG-FAIL-GF-5-1. NC1174.2 +054000 GO TO SIG-WRITE-GF-5-1. NC1174.2 +054100 SIG-DELETE-GF-5-1. NC1174.2 +054200 PERFORM DE-LETE. NC1174.2 +054300 GO TO SIG-WRITE-GF-5-1. NC1174.2 +054400 SIG-FAIL-GF-5-1. NC1174.2 +054500 MOVE DIV7 TO COMPUTED-N. NC1174.2 +054600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +054700 PERFORM FAIL. NC1174.2 +054800 SIG-WRITE-GF-5-1. NC1174.2 +054900 MOVE "SIG-TEST-GF-5-1 " TO PAR-NAME. NC1174.2 +055000 PERFORM PRINT-DETAIL. NC1174.2 +055100 SIG-TEST-GF-5-2. NC1174.2 +055200 IF DIV7 NOT EQUAL TO 9.6 NC1174.2 +055300 GO TO SIG-FAIL-GF-5-2. NC1174.2 +055400 PERFORM PASS. NC1174.2 +055500 GO TO SIG-WRITE-GF-5-2. NC1174.2 +055600 SIG-DELETE-GF-5-2. NC1174.2 +055700 PERFORM DE-LETE. NC1174.2 +055800 GO TO SIG-WRITE-GF-5-2. NC1174.2 +055900 SIG-FAIL-GF-5-2. NC1174.2 +056000 PERFORM FAIL. NC1174.2 +056100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +056200 MOVE DIV7 TO COMPUTED-N. NC1174.2 +056300 MOVE +9.6 TO CORRECT-N. NC1174.2 +056400 SIG-WRITE-GF-5-2. NC1174.2 +056500 MOVE "SIG-TEST-GF-5-2 " TO PAR-NAME. NC1174.2 +056600 PERFORM PRINT-DETAIL. NC1174.2 +056700 SIG-INIT-GF-11. NC1174.2 +056800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +056900 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1174.2 +057000 MOVE 44.1 TO DIV2. NC1174.2 +057100 MOVE ZERO TO DIV8. NC1174.2 +057200 SIG-TEST-GF-11-0. NC1174.2 +057300 DIVIDE DIV2 INTO 864.36 GIVING DIV8. NC1174.2 +057400 SIG-TEST-GF-11-1. NC1174.2 +057500 IF DIV8 EQUAL TO 19.6 NC1174.2 +057600 PERFORM PASS NC1174.2 +057700 ELSE NC1174.2 +057800 GO TO SIG-FAIL-GF-11. NC1174.2 +057900 GO TO SIG-WRITE-GF-11. NC1174.2 +058000 SIG-DELETE-GF-11. NC1174.2 +058100 PERFORM DE-LETE. NC1174.2 +058200 GO TO SIG-WRITE-GF-11. NC1174.2 +058300 SIG-FAIL-GF-11. NC1174.2 +058400 PERFORM FAIL. NC1174.2 +058500 MOVE DIV8 TO COMPUTED-N. NC1174.2 +058600 MOVE +19.6 TO CORRECT-N. NC1174.2 +058700 SIG-WRITE-GF-11. NC1174.2 +058800 MOVE "SIG-TEST-GF-11 " TO PAR-NAME. NC1174.2 +058900 PERFORM PRINT-DETAIL. NC1174.2 +059000 SIG-INIT-GF-12. NC1174.2 +059100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +059200 MOVE 1620.36 TO DIV1. NC1174.2 +059300 MOVE ZERO TO DIV9. NC1174.2 +059400 SIG-TEST-GF-12-0. NC1174.2 +059500 DIVIDE 0.533 INTO DIV1 GIVING DIV9 ROUNDED. NC1174.2 +059600 SIG-TEST-GF-12-1. NC1174.2 +059700 IF DIV9 EQUAL TO " 3,040.1" NC1174.2 +059800 PERFORM PASS NC1174.2 +059900 ELSE NC1174.2 +060000 GO TO SIG-FAIL-GF-12. NC1174.2 +060100 GO TO SIG-WRITE-GF-12. NC1174.2 +060200 SIG-DELETE-GF-12. NC1174.2 +060300 PERFORM DE-LETE. NC1174.2 +060400 GO TO SIG-WRITE-GF-12. NC1174.2 +060500 SIG-FAIL-GF-12. NC1174.2 +060600 PERFORM FAIL. NC1174.2 +060700 MOVE DIV9 TO COMPUTED-A. NC1174.2 +060800 MOVE " 3,040.1" TO CORRECT-A. NC1174.2 +060900 SIG-WRITE-GF-12. NC1174.2 +061000 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1174.2 +061100 PERFORM PRINT-DETAIL. NC1174.2 +061200 SIG-INIT-GF-13. NC1174.2 +061300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +061400 MOVE -9.642 TO DIV4. NC1174.2 +061500 MOVE ZERO TO DIV10. NC1174.2 +061600 MOVE 44.1 TO DIV2. NC1174.2 +061700 MOVE "A" TO XRAY. NC1174.2 +061800 SIG-TEST-GF-13-0. NC1174.2 +061900 DIVIDE DIV4 INTO DIV2 GIVING DIV10 ON SIZE ERROR NC1174.2 +062000 MOVE "P" TO XRAY. NC1174.2 +062100 SIG-TEST-GF-13-1. NC1174.2 +062200 IF XRAY EQUAL TO "P" NC1174.2 +062300 PERFORM PASS NC1174.2 +062400 ELSE NC1174.2 +062500 GO TO SIG-FAIL-GF-13-1. NC1174.2 +062600 GO TO SIG-WRITE-GF-13-1. NC1174.2 +062700 SIG-DELETE-GF-13-1. NC1174.2 +062800 PERFORM DE-LETE. NC1174.2 +062900 GO TO SIG-WRITE-GF-13-1. NC1174.2 +063000 SIG-FAIL-GF-13-1. NC1174.2 +063100 MOVE DIV10 TO COMPUTED-N. NC1174.2 +063200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +063300 PERFORM FAIL. NC1174.2 +063400 SIG-WRITE-GF-13-1. NC1174.2 +063500 MOVE "SIG-TEST-GF-13-1" TO PAR-NAME. NC1174.2 +063600 PERFORM PRINT-DETAIL. NC1174.2 +063700 SIG-TEST-GF-13-2. NC1174.2 +063800 IF DIV10 NOT EQUAL TO ZERO NC1174.2 +063900 GO TO SIG-FAIL-GF-13-2. NC1174.2 +064000 PERFORM PASS. NC1174.2 +064100 GO TO SIG-WRITE-GF-13-2. NC1174.2 +064200 SIG-DELETE-GF-13-2. NC1174.2 +064300 PERFORM DE-LETE. NC1174.2 +064400 GO TO SIG-WRITE-GF-13-2. NC1174.2 +064500 SIG-FAIL-GF-13-2. NC1174.2 +064600 PERFORM FAIL. NC1174.2 +064700 MOVE DIV10 TO COMPUTED-N. NC1174.2 +064800 MOVE ZERO TO CORRECT-N. NC1174.2 +064900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +065000 SIG-WRITE-GF-13-2. NC1174.2 +065100 MOVE "SIG-TEST-GF-13-2" TO PAR-NAME. NC1174.2 +065200 PERFORM PRINT-DETAIL. NC1174.2 +065300 SIG-INIT-GF-19. NC1174.2 +065400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +065500 MOVE ZERO TO DIV8. NC1174.2 +065600 MOVE 44.1 TO DIV2. NC1174.2 +065700 MOVE "DIVIDE BY" TO FEATURE. NC1174.2 +065800 SIG-TEST-GF-19. NC1174.2 +065900 DIVIDE 864.36 BY DIV2 GIVING DIV8. NC1174.2 +066000 IF DIV8 EQUAL TO 19.6 NC1174.2 +066100 PERFORM PASS NC1174.2 +066200 ELSE NC1174.2 +066300 GO TO SIG-FAIL-GF-19. NC1174.2 +066400 GO TO SIG-WRITE-GF-19. NC1174.2 +066500 SIG-DELETE-GF-19. NC1174.2 +066600 PERFORM DE-LETE. NC1174.2 +066700 GO TO SIG-WRITE-GF-19. NC1174.2 +066800 SIG-FAIL-GF-19. NC1174.2 +066900 PERFORM FAIL. NC1174.2 +067000 MOVE DIV8 TO COMPUTED-N. NC1174.2 +067100 MOVE 19.6 TO CORRECT-N. NC1174.2 +067200 SIG-WRITE-GF-19. NC1174.2 +067300 MOVE "SIG-TEST-GF-19" TO PAR-NAME. NC1174.2 +067400 PERFORM PRINT-DETAIL. NC1174.2 +067500 SIG-INIT-GF-20. NC1174.2 +067600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1174.2 +067700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +067800 MOVE 1620.36 TO DIV1. NC1174.2 +067900 MOVE ZERO TO DIV9. NC1174.2 +068000 SIG-TEST-GF-20-0. NC1174.2 +068100 DIVIDE DIV1 BY 0.533 GIVING DIV9 ROUNDED. NC1174.2 +068200 SIG-TEST-GF-20-1. NC1174.2 +068300 IF DIV9 EQUAL TO " 3,040.1" NC1174.2 +068400 PERFORM PASS NC1174.2 +068500 ELSE NC1174.2 +068600 GO TO SIG-FAIL-GF-20. NC1174.2 +068700 GO TO SIG-WRITE-GF-20. NC1174.2 +068800 SIG-DELETE-GF-20. NC1174.2 +068900 PERFORM DE-LETE. NC1174.2 +069000 GO TO SIG-WRITE-GF-20. NC1174.2 +069100 SIG-FAIL-GF-20. NC1174.2 +069200 PERFORM FAIL. NC1174.2 +069300 MOVE DIV9 TO COMPUTED-A. NC1174.2 +069400 MOVE " 3,040.1" TO CORRECT-A. NC1174.2 +069500 SIG-WRITE-GF-20. NC1174.2 +069600 MOVE "SIG-TEST-GF-20" TO PAR-NAME. NC1174.2 +069700 PERFORM PRINT-DETAIL. NC1174.2 +069800 SIG-INIT-GF-21. NC1174.2 +069900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +070000 MOVE -9.642 TO DIV4. NC1174.2 +070100 MOVE ZERO TO DIV10. NC1174.2 +070200 MOVE 44.1 TO DIV2. NC1174.2 +070300 MOVE "A" TO XRAY. NC1174.2 +070400 SIG-TEST-GF-21-0. NC1174.2 +070500 DIVIDE DIV2 BY DIV4 GIVING DIV10 ON SIZE ERROR NC1174.2 +070600 MOVE "P" TO XRAY. NC1174.2 +070700 SIG-TEST-GF-21-1. NC1174.2 +070800 IF XRAY EQUAL TO "P" NC1174.2 +070900 PERFORM PASS NC1174.2 +071000 ELSE NC1174.2 +071100 GO TO SIG-FAIL-GF-21-1. NC1174.2 +071200 GO TO SIG-WRITE-GF-21-1. NC1174.2 +071300 SIG-DELETE-GF-21-1. NC1174.2 +071400 PERFORM DE-LETE. NC1174.2 +071500 GO TO SIG-WRITE-GF-21-1. NC1174.2 +071600 SIG-FAIL-GF-21-1. NC1174.2 +071700 MOVE DIV10 TO COMPUTED-N. NC1174.2 +071800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +071900 PERFORM FAIL. NC1174.2 +072000 SIG-WRITE-GF-21-1. NC1174.2 +072100 MOVE "SIG-TEST-GF-21-1" TO PAR-NAME. NC1174.2 +072200 PERFORM PRINT-DETAIL. NC1174.2 +072300 SIG-TEST-GF-21-2. NC1174.2 +072400 IF DIV10 = 0 NC1174.2 +072500 PERFORM PASS NC1174.2 +072600 ELSE NC1174.2 +072700 GO TO SIG-FAIL-GF-21-2. NC1174.2 +072800 GO TO SIG-WRITE-GF-21-2. NC1174.2 +072900 SIG-DELETE-GF-21-2. NC1174.2 +073000 PERFORM DE-LETE. NC1174.2 +073100 GO TO SIG-WRITE-GF-21-2. NC1174.2 +073200 SIG-FAIL-GF-21-2. NC1174.2 +073300 MOVE DIV10 TO COMPUTED-N. NC1174.2 +073400 MOVE 0 TO CORRECT-N. NC1174.2 +073500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +073600 PERFORM FAIL. NC1174.2 +073700 SIG-WRITE-GF-21-2. NC1174.2 +073800 MOVE "SIG-TEST-GF-21-2" TO PAR-NAME. NC1174.2 +073900 PERFORM PRINT-DETAIL. NC1174.2 +074000 SIG-INIT-GF-6. NC1174.2 +074100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +074200 MOVE "DIVIDE INTO " TO FEATURE. NC1174.2 +074300 MOVE 99 TO WRK-DS-LS-18V00. NC1174.2 +074400 SIG-TEST-GF-6-0. NC1174.2 +074500 DIVIDE A99-DS-02V00 INTO WRK-DS-LS-18V00. NC1174.2 +074600 SIG-TEST-GF-6-1. NC1174.2 +074700 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000001 NC1174.2 +074800 PERFORM PASS NC1174.2 +074900 GO TO SIG-WRITE-GF-6. NC1174.2 +075000 GO TO SIG-FAIL-GF-6. NC1174.2 +075100 SIG-DELETE-GF-6. NC1174.2 +075200 PERFORM DE-LETE. NC1174.2 +075300 GO TO SIG-WRITE-GF-6. NC1174.2 +075400 SIG-FAIL-GF-6. NC1174.2 +075500 MOVE 000000000000000001 TO CORRECT-18V0. NC1174.2 +075600 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +075700 PERFORM FAIL. NC1174.2 +075800 SIG-WRITE-GF-6. NC1174.2 +075900 MOVE "SIG-TEST-GF-6 " TO PAR-NAME. NC1174.2 +076000 PERFORM PRINT-DETAIL. NC1174.2 +076100 SIG-INIT-GF-7. NC1174.2 +076200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +076300 MOVE 2 TO WRK-DS-TS-12V00-S. NC1174.2 +076400 SIG-TEST-GF-7-0. NC1174.2 +076500 DIVIDE 4 INTO WRK-DS-TS-12V00-S ROUNDED. NC1174.2 +076600 SIG-TEST-GF-7-1. NC1174.2 +076700 IF WRK-DS-TS-12V00-S EQUAL TO 000000000001 NC1174.2 +076800 PERFORM PASS NC1174.2 +076900 GO TO SIG-WRITE-GF-7. NC1174.2 +077000 GO TO SIG-FAIL-GF-7. NC1174.2 +077100 SIG-DELETE-GF-7. NC1174.2 +077200 PERFORM DE-LETE. NC1174.2 +077300 GO TO SIG-WRITE-GF-7. NC1174.2 +077400 SIG-FAIL-GF-7. NC1174.2 +077500 MOVE WRK-DS-TS-12V00-S TO COMPUTED-18V0. NC1174.2 +077600 MOVE 000000000001 TO CORRECT-18V0. NC1174.2 +077700 PERFORM FAIL. NC1174.2 +077800 SIG-WRITE-GF-7. NC1174.2 +077900 MOVE "SIG-TEST-GF-7 " TO PAR-NAME. NC1174.2 +078000 PERFORM PRINT-DETAIL. NC1174.2 +078100 SIG-INIT-GF-8. NC1174.2 +078200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +078300 MOVE 1 TO WRK-DS-LS-01V00. NC1174.2 +078400 MOVE "0" TO WRK-XN-00001. NC1174.2 +078500 SIG-TEST-GF-8-0. NC1174.2 +078600 DIVIDE 0.1 INTO WRK-DS-LS-01V00 ON SIZE ERROR NC1174.2 +078700 MOVE "1" TO WRK-XN-00001. NC1174.2 +078800 SIG-TEST-GF-8-1. NC1174.2 +078900 IF WRK-DS-LS-01V00 EQUAL TO 1 NC1174.2 +079000 PERFORM PASS NC1174.2 +079100 GO TO SIG-WRITE-GF-8-1. NC1174.2 +079200 GO TO SIG-FAIL-GF-8-1. NC1174.2 +079300 SIG-DELETE-GF-8-1. NC1174.2 +079400 PERFORM DE-LETE. NC1174.2 +079500 GO TO SIG-WRITE-GF-8-1. NC1174.2 +079600 SIG-FAIL-GF-8-1. NC1174.2 +079700 MOVE 1 TO CORRECT-N. NC1174.2 +079800 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +079900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +080000 PERFORM FAIL. NC1174.2 +080100 SIG-WRITE-GF-8-1. NC1174.2 +080200 MOVE "SIG-TEST-GF-8-1 " TO PAR-NAME. NC1174.2 +080300 PERFORM PRINT-DETAIL. NC1174.2 +080400 SIG-TEST-GF-8-2. NC1174.2 +080500 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +080600 PERFORM PASS NC1174.2 +080700 GO TO SIG-WRITE-GF-8-2. NC1174.2 +080800 MOVE "1" TO CORRECT-A. NC1174.2 +080900 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +081000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +081100 PERFORM FAIL. NC1174.2 +081200 GO TO SIG-WRITE-GF-8-2. NC1174.2 +081300 SIG-DELETE-GF-8-2. NC1174.2 +081400 PERFORM DE-LETE. NC1174.2 +081500 SIG-WRITE-GF-8-2. NC1174.2 +081600 MOVE "SIG-TEST-GF-8-2 " TO PAR-NAME. NC1174.2 +081700 PERFORM PRINT-DETAIL. NC1174.2 +081800 SIG-INIT-GF-9. NC1174.2 +081900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +082000 MOVE -.000000001 TO WRK-DS-09V09. NC1174.2 +082100 MOVE "1" TO WRK-XN-00001. NC1174.2 +082200 SIG-TEST-GF-9-0. NC1174.2 +082300 DIVIDE A01ONE-DS-TS-P0801 INTO WRK-DS-09V09 ON SIZE ERROR NC1174.2 +082400 MOVE "0" TO WRK-XN-00001. NC1174.2 +082500 SIG-TEST-GF-9-1. NC1174.2 +082600 IF WRK-DS-18V00-S EQUAL TO -000000001000000000 NC1174.2 +082700 PERFORM PASS NC1174.2 +082800 GO TO SIG-WRITE-GF-9-1. NC1174.2 +082900 GO TO SIG-FAIL-GF-9-1. NC1174.2 +083000 SIG-DELETE-GF-9-1. NC1174.2 +083100 PERFORM DE-LETE. NC1174.2 +083200 GO TO SIG-WRITE-GF-9-1. NC1174.2 +083300 SIG-FAIL-GF-9-1. NC1174.2 +083400 MOVE -000000001000000000 TO CORRECT-18V0. NC1174.2 +083500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1174.2 +083600 PERFORM FAIL. NC1174.2 +083700 SIG-WRITE-GF-9-1. NC1174.2 +083800 MOVE "SIG-TEST-GF-9-1 " TO PAR-NAME. NC1174.2 +083900 PERFORM PRINT-DETAIL. NC1174.2 +084000 SIG-TEST-GF-9-2. NC1174.2 +084100 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +084200 MOVE "1" TO CORRECT-A NC1174.2 +084300 MOVE "0" TO COMPUTED-A NC1174.2 +084400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1174.2 +084500 PERFORM FAIL NC1174.2 +084600 GO TO SIG-WRITE-GF-9-2. NC1174.2 +084700 PERFORM PASS. NC1174.2 +084800 GO TO SIG-WRITE-GF-9-2. NC1174.2 +084900 SIG-DELETE-GF-9-2. NC1174.2 +085000 PERFORM DE-LETE. NC1174.2 +085100 SIG-WRITE-GF-9-2. NC1174.2 +085200 MOVE "SIG-TEST-GF-9-2 " TO PAR-NAME. NC1174.2 +085300 PERFORM PRINT-DETAIL. NC1174.2 +085400 SIG-INIT-GF-10. NC1174.2 +085500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +085600 MOVE ZERO TO WRK-DS-LS-01V00 AZERO-DS-LS-05V05. NC1174.2 +085700 MOVE "0" TO WRK-XN-00001. NC1174.2 +085800 SIG-TEST-GF-10-0. NC1174.2 +085900 DIVIDE AZERO-DS-LS-05V05 INTO WRK-DS-LS-01V00 ROUNDED NC1174.2 +086000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1174.2 +086100 SIG-TEST-GF-10-1. NC1174.2 +086200 IF WRK-DS-LS-01V00 EQUAL TO 0 NC1174.2 +086300 PERFORM PASS NC1174.2 +086400 GO TO SIG-WRITE-GF-10-1. NC1174.2 +086500 GO TO SIG-FAIL-GF-10-1. NC1174.2 +086600 SIG-DELETE-GF-10-1. NC1174.2 +086700 PERFORM DE-LETE. NC1174.2 +086800 GO TO SIG-WRITE-GF-10-1. NC1174.2 +086900 SIG-FAIL-GF-10-1. NC1174.2 +087000 MOVE 0 TO CORRECT-N. NC1174.2 +087100 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +087200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +087300 PERFORM FAIL. NC1174.2 +087400 SIG-WRITE-GF-10-1. NC1174.2 +087500 MOVE "SIG-TEST-GF-10-1 " TO PAR-NAME. NC1174.2 +087600 PERFORM PRINT-DETAIL. NC1174.2 +087700 SIG-TEST-GF-10-2. NC1174.2 +087800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +087900 PERFORM PASS NC1174.2 +088000 GO TO SIG-WRITE-GF-10-2. NC1174.2 +088100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +088200 MOVE "1" TO CORRECT-A. NC1174.2 +088300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +088400 PERFORM FAIL. NC1174.2 +088500 GO TO SIG-WRITE-GF-10-2. NC1174.2 +088600 SIG-DELETE-GF-10-2. NC1174.2 +088700 PERFORM DE-LETE. NC1174.2 +088800 SIG-WRITE-GF-10-2. NC1174.2 +088900 MOVE "SIG-TEST-GF-10-2 " TO PAR-NAME. NC1174.2 +089000 PERFORM PRINT-DETAIL. NC1174.2 +089100 SIG-INIT-GF-14. NC1174.2 +089200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +089300 MOVE "DIVIDE INTO GIVING " TO FEATURE. NC1174.2 +089400 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +089500 MOVE 22 TO A02TWOS-DU-02V00. NC1174.2 +089600 SIG-TEST-GF-14-0. NC1174.2 +089700 DIVIDE -10.9 INTO A02TWOS-DU-02V00 GIVING WRK-DS-LS-01V00. NC1174.2 +089800 SIG-TEST-GF-14-1. NC1174.2 +089900 IF WRK-DS-LS-01V00 EQUAL TO -2 NC1174.2 +090000 PERFORM PASS NC1174.2 +090100 GO TO SIG-WRITE-GF-14. NC1174.2 +090200 GO TO SIG-FAIL-GF-14. NC1174.2 +090300 SIG-DELETE-GF-14. NC1174.2 +090400 PERFORM DE-LETE. NC1174.2 +090500 GO TO SIG-WRITE-GF-14. NC1174.2 +090600 SIG-FAIL-GF-14. NC1174.2 +090700 MOVE -2 TO CORRECT-N. NC1174.2 +090800 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +090900 PERFORM FAIL. NC1174.2 +091000 SIG-WRITE-GF-14. NC1174.2 +091100 MOVE "SIG-TEST-GF-14 " TO PAR-NAME. NC1174.2 +091200 PERFORM PRINT-DETAIL. NC1174.2 +091300 SIG-INIT-GF-15. NC1174.2 +091400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +091500 MOVE 0.0000000001 TO WRK-DS-03V10. NC1174.2 +091600 MOVE ZERO TO WRK-DS-LS-18V00. NC1174.2 +091700 MOVE .000000001 TO A01ONE-DS-TS-P0801. NC1174.2 +091800 SIG-TEST-GF-15-0. NC1174.2 +091900 DIVIDE WRK-DS-03V10 INTO A01ONE-DS-TS-P0801 NC1174.2 +092000 GIVING WRK-DS-LS-18V00 ROUNDED. NC1174.2 +092100 SIG-TEST-GF-15-1. NC1174.2 +092200 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000010 NC1174.2 +092300 PERFORM PASS NC1174.2 +092400 GO TO SIG-WRITE-GF-15. NC1174.2 +092500 GO TO SIG-FAIL-GF-15. NC1174.2 +092600 SIG-DELETE-GF-15. NC1174.2 +092700 PERFORM DE-LETE. NC1174.2 +092800 GO TO SIG-WRITE-GF-15. NC1174.2 +092900 SIG-FAIL-GF-15. NC1174.2 +093000 MOVE 000000000000000010 TO CORRECT-18V0. NC1174.2 +093100 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +093200 PERFORM FAIL. NC1174.2 +093300 SIG-WRITE-GF-15. NC1174.2 +093400 MOVE "SIG-TEST-GF-15 " TO PAR-NAME. NC1174.2 +093500 PERFORM PRINT-DETAIL. NC1174.2 +093600 SIG-INIT-GF-16. NC1174.2 +093700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +093800 MOVE ZERO TO WRK-DS-LS-18V00 AZERO-DS-LS-05V05. NC1174.2 +093900 MOVE "0" TO WRK-XN-00001. NC1174.2 +094000 SIG-TEST-GF-16-0. NC1174.2 +094100 DIVIDE AZERO-DS-LS-05V05 INTO A99-DS-02V00 NC1174.2 +094200 GIVING WRK-DS-LS-18V00 ON SIZE ERROR NC1174.2 +094300 MOVE "1" TO WRK-XN-00001. NC1174.2 +094400 SIG-TEST-GF-16-1. NC1174.2 +094500 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000000 NC1174.2 +094600 PERFORM PASS NC1174.2 +094700 GO TO SIG-WRITE-GF-16-1. NC1174.2 +094800 GO TO SIG-FAIL-GF-16-1. NC1174.2 +094900 SIG-DELETE-GF-16-1. NC1174.2 +095000 PERFORM DE-LETE. NC1174.2 +095100 GO TO SIG-WRITE-GF-16-1. NC1174.2 +095200 SIG-FAIL-GF-16-1. NC1174.2 +095300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +095400 MOVE 000000000000000000 TO CORRECT-18V0. NC1174.2 +095500 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +095600 PERFORM FAIL. NC1174.2 +095700 SIG-WRITE-GF-16-1. NC1174.2 +095800 MOVE "SIG-TEST-GF-16-1 " TO PAR-NAME. NC1174.2 +095900 PERFORM PRINT-DETAIL. NC1174.2 +096000 SIG-TEST-GF-16-2. NC1174.2 +096100 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +096200 PERFORM PASS NC1174.2 +096300 GO TO SIG-WRITE-GF-16-2. NC1174.2 +096400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +096500 MOVE "1" TO CORRECT-A. NC1174.2 +096600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +096700 PERFORM FAIL. NC1174.2 +096800 GO TO SIG-WRITE-GF-16-2. NC1174.2 +096900 SIG-DELETE-GF-16-2. NC1174.2 +097000 PERFORM DE-LETE. NC1174.2 +097100 SIG-WRITE-GF-16-2. NC1174.2 +097200 MOVE "SIG-TEST-32 " TO PAR-NAME. NC1174.2 +097300 PERFORM PRINT-DETAIL. NC1174.2 +097400 SIG-INIT-GF-17. NC1174.2 +097500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +097600 MOVE ZERO TO WRK-DS-LS-0201P. NC1174.2 +097700 MOVE -0.005 TO WRK-DS-09V09. NC1174.2 +097800 MOVE "0" TO WRK-XN-00001. NC1174.2 +097900 SIG-TEST-GF-17-0. NC1174.2 +098000 DIVIDE WRK-DS-09V09 INTO A05ONES-DS-LS-00V05 GIVING NC1174.2 +098100 WRK-DS-LS-0201P ROUNDED ON SIZE ERROR NC1174.2 +098200 MOVE "1" TO WRK-XN-00001. NC1174.2 +098300 SIG-TEST-GF-17-1. NC1174.2 +098400 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1174.2 +098500 IF WRK-DS-05V00 EQUAL TO -00020 NC1174.2 +098600 PERFORM PASS NC1174.2 +098700 GO TO SIG-WRITE-GF-17-1. NC1174.2 +098800 GO TO SIG-FAIL-GF-17-1. NC1174.2 +098900 SIG-DELETE-GF-17-1. NC1174.2 +099000 PERFORM DE-LETE. NC1174.2 +099100 GO TO SIG-WRITE-GF-17-1. NC1174.2 +099200 SIG-FAIL-GF-17-1. NC1174.2 +099300 MOVE -00020 TO CORRECT-N. NC1174.2 +099400 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1174.2 +099500 PERFORM FAIL. NC1174.2 +099600 SIG-WRITE-GF-17-1. NC1174.2 +099700 MOVE "SIG-TEST-GF-17-1 " TO PAR-NAME. NC1174.2 +099800 PERFORM PRINT-DETAIL. NC1174.2 +099900 SIG-TEST-GF-17-2. NC1174.2 +100000 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +100100 PERFORM PASS NC1174.2 +100200 GO TO SIG-WRITE-GF-17-2. NC1174.2 +100300 MOVE "0" TO CORRECT-A. NC1174.2 +100400 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +100500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +100600 PERFORM FAIL. NC1174.2 +100700 GO TO SIG-WRITE-GF-17-2. NC1174.2 +100800 SIG-DELETE-GF-17-2. NC1174.2 +100900 PERFORM DE-LETE. NC1174.2 +101000 SIG-WRITE-GF-17-2. NC1174.2 +101100 MOVE "SIG-TEST-GF-17-2 " TO PAR-NAME. NC1174.2 +101200 PERFORM PRINT-DETAIL. NC1174.2 +101300 SIG-INIT-GF-18. NC1174.2 +101400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +101500 MOVE "1" TO WRK-XN-00001. NC1174.2 +101600 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +101700 MOVE 22 TO A02TWOS-DU-02V00 A02TWOS-DS-03V02. NC1174.2 +101800 SIG-TEST-GF-18-0. NC1174.2 +101900 DIVIDE A02TWOS-DU-02V00 INTO A02TWOS-DS-03V02 GIVING NC1174.2 +102000 WRK-DS-LS-01V00 ROUNDED ON SIZE ERROR NC1174.2 +102100 MOVE "0" TO WRK-XN-00001. NC1174.2 +102200 SIG-TEST-GF-18-1. NC1174.2 +102300 IF WRK-DS-LS-01V00 EQUAL TO +1 NC1174.2 +102400 PERFORM PASS NC1174.2 +102500 GO TO SIG-WRITE-GF-18-1. NC1174.2 +102600 GO TO SIG-FAIL-GF-18-1. NC1174.2 +102700 SIG-DELETE-GF-18-1. NC1174.2 +102800 PERFORM DE-LETE. NC1174.2 +102900 GO TO SIG-WRITE-GF-18-1. NC1174.2 +103000 SIG-FAIL-GF-18-1. NC1174.2 +103100 MOVE +1 TO CORRECT-N. NC1174.2 +103200 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +103300 PERFORM FAIL. NC1174.2 +103400 SIG-WRITE-GF-18-1. NC1174.2 +103500 MOVE "SIG-TEST-GF-18-1 " TO PAR-NAME. NC1174.2 +103600 PERFORM PRINT-DETAIL. NC1174.2 +103700 SIG-TEST-GF-18-2. NC1174.2 +103800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +103900 PERFORM PASS NC1174.2 +104000 GO TO SIG-WRITE-GF-18-2. NC1174.2 +104100 MOVE "1" TO CORRECT-A. NC1174.2 +104200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +104300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +104400 PERFORM FAIL. NC1174.2 +104500 GO TO SIG-WRITE-GF-18-2. NC1174.2 +104600 SIG-DELETE-GF-18-2. NC1174.2 +104700 PERFORM DE-LETE. NC1174.2 +104800 SIG-WRITE-GF-18-2. NC1174.2 +104900 MOVE "SIG-TEST-GF-18-2 " TO PAR-NAME. NC1174.2 +105000 PERFORM PRINT-DETAIL. NC1174.2 +105100 SIG-INIT-GF-22. NC1174.2 +105200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +105300 MOVE "DIVIDE BY GIVING " TO FEATURE. NC1174.2 +105400 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +105500 SIG-TEST-GF-22-0. NC1174.2 +105600 DIVIDE A02TWOS-DU-02V00 BY -10.9 GIVING WRK-DS-LS-01V00. NC1174.2 +105700 SIG-TEST-GF-22-1. NC1174.2 +105800 IF WRK-DS-LS-01V00 EQUAL TO -2 NC1174.2 +105900 PERFORM PASS NC1174.2 +106000 GO TO SIG-WRITE-GF-22. NC1174.2 +106100 GO TO SIG-FAIL-GF-22. NC1174.2 +106200 SIG-DELETE-GF-22. NC1174.2 +106300 PERFORM DE-LETE. NC1174.2 +106400 GO TO SIG-WRITE-GF-22. NC1174.2 +106500 SIG-FAIL-GF-22. NC1174.2 +106600 MOVE -2 TO CORRECT-N. NC1174.2 +106700 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +106800 PERFORM FAIL. NC1174.2 +106900 SIG-WRITE-GF-22. NC1174.2 +107000 MOVE "SIG-TEST-GF-22 " TO PAR-NAME. NC1174.2 +107100 PERFORM PRINT-DETAIL. NC1174.2 +107200 SIG-INIT-GF-23. NC1174.2 +107300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +107400 MOVE 0.0000000001 TO WRK-DS-03V10. NC1174.2 +107500 MOVE ZERO TO WRK-DS-LS-18V00. NC1174.2 +107600 MOVE .000000001 TO A01ONE-DS-TS-P0801. NC1174.2 +107700 SIG-TEST-GF-23-0. NC1174.2 +107800 DIVIDE A01ONE-DS-TS-P0801 BY WRK-DS-03V10 GIVING NC1174.2 +107900 WRK-DS-LS-18V00 ROUNDED. NC1174.2 +108000 SIG-TEST-GF-23-1. NC1174.2 +108100 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000010 NC1174.2 +108200 PERFORM PASS NC1174.2 +108300 GO TO SIG-WRITE-GF-23. NC1174.2 +108400 GO TO SIG-FAIL-GF-23. NC1174.2 +108500 SIG-DELETE-GF-23. NC1174.2 +108600 PERFORM DE-LETE. NC1174.2 +108700 GO TO SIG-WRITE-GF-23. NC1174.2 +108800 SIG-FAIL-GF-23. NC1174.2 +108900 MOVE 000000000000000010 TO CORRECT-18V0. NC1174.2 +109000 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +109100 PERFORM FAIL. NC1174.2 +109200 SIG-WRITE-GF-23. NC1174.2 +109300 MOVE "SIG-TEST-GF-23 " TO PAR-NAME. NC1174.2 +109400 PERFORM PRINT-DETAIL. NC1174.2 +109500 SIG-INIT-GF-24. NC1174.2 +109600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +109700 MOVE ZERO TO WRK-DS-LS-18V00 AZERO-DS-LS-05V05. NC1174.2 +109800 MOVE "0" TO WRK-XN-00001. NC1174.2 +109900 MOVE 99 TO A99-DS-02V00. NC1174.2 +110000 SIG-TEST-GF-24-0. NC1174.2 +110100 DIVIDE A99-DS-02V00 BY AZERO-DS-LS-05V05 GIVING NC1174.2 +110200 WRK-DS-LS-18V00 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1174.2 +110300 SIG-TEST-GF-24-1. NC1174.2 +110400 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000000 NC1174.2 +110500 PERFORM PASS NC1174.2 +110600 GO TO SIG-WRITE-GF-24-1. NC1174.2 +110700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +110800 MOVE 000000000000000000 TO CORRECT-18V0. NC1174.2 +110900 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +111000 PERFORM FAIL. NC1174.2 +111100 GO TO SIG-WRITE-GF-24-1. NC1174.2 +111200 SIG-DELETE-GF-24-1. NC1174.2 +111300 PERFORM DE-LETE. NC1174.2 +111400 SIG-WRITE-GF-24-1. NC1174.2 +111500 MOVE "SIG-TEST-GF-24-1 " TO PAR-NAME. NC1174.2 +111600 PERFORM PRINT-DETAIL. NC1174.2 +111700 SIG-TEST-GF-24-2. NC1174.2 +111800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +111900 PERFORM PASS NC1174.2 +112000 GO TO SIG-WRITE-GF-24-2. NC1174.2 +112100 MOVE "1" TO CORRECT-A. NC1174.2 +112200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +112300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +112400 PERFORM FAIL. NC1174.2 +112500 GO TO SIG-WRITE-GF-24-2. NC1174.2 +112600 SIG-DELETE-GF-24-2. NC1174.2 +112700 PERFORM DE-LETE. NC1174.2 +112800 SIG-WRITE-GF-24-2. NC1174.2 +112900 MOVE "SIG-TEST-GF-24-2 " TO PAR-NAME. NC1174.2 +113000 PERFORM PRINT-DETAIL. NC1174.2 +113100 SIG-INIT-GF-25. NC1174.2 +113200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +113300 MOVE .11111 TO A05ONES-DS-LS-00V05. NC1174.2 +113400 MOVE ZERO TO WRK-DS-LS-0201P. NC1174.2 +113500 MOVE -0.005 TO WRK-DS-09V09. NC1174.2 +113600 MOVE "0" TO WRK-XN-00001. NC1174.2 +113700 SIG-TEST-GF-25-0. NC1174.2 +113800 DIVIDE A05ONES-DS-LS-00V05 BY WRK-DS-09V09 GIVING NC1174.2 +113900 WRK-DS-LS-0201P ROUNDED ON SIZE ERROR NC1174.2 +114000 MOVE "1" TO WRK-XN-00001. NC1174.2 +114100 SIG-TEST-GF-25-1. NC1174.2 +114200 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1174.2 +114300 IF WRK-DS-05V00 EQUAL TO -00020 NC1174.2 +114400 PERFORM PASS NC1174.2 +114500 GO TO SIG-WRITE-GF-25-1. NC1174.2 +114600 MOVE -00020 TO CORRECT-N. NC1174.2 +114700 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1174.2 +114800 PERFORM FAIL. NC1174.2 +114900 GO TO SIG-WRITE-GF-25-1. NC1174.2 +115000 SIG-DELETE-GF-25-1. NC1174.2 +115100 PERFORM DE-LETE. NC1174.2 +115200 SIG-WRITE-GF-25-1. NC1174.2 +115300 MOVE "SIG-TEST-GF-25-1 " TO PAR-NAME. NC1174.2 +115400 PERFORM PRINT-DETAIL. NC1174.2 +115500 SIG-TEST-GF-25-2. NC1174.2 +115600 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +115700 PERFORM PASS NC1174.2 +115800 GO TO SIG-WRITE-GF-25-2. NC1174.2 +115900 MOVE "0" TO CORRECT-A. NC1174.2 +116000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +116100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +116200 PERFORM FAIL. NC1174.2 +116300 GO TO SIG-WRITE-GF-25-2. NC1174.2 +116400 SIG-DELETE-GF-25-2. NC1174.2 +116500 PERFORM DE-LETE. NC1174.2 +116600 SIG-WRITE-GF-25-2. NC1174.2 +116700 MOVE "SIG-TEST-GF-25-2 " TO PAR-NAME. NC1174.2 +116800 PERFORM PRINT-DETAIL. NC1174.2 +116900 SIG-INIT-GF-26. NC1174.2 +117000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +117100 MOVE 22 TO A02TWOS-DU-02V00 A02TWOS-DS-03V02. NC1174.2 +117200 MOVE "1" TO WRK-XN-00001. NC1174.2 +117300 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +117400 SIG-TEST-GF-26-0. NC1174.2 +117500 DIVIDE A02TWOS-DS-03V02 BY A02TWOS-DU-02V00 GIVING NC1174.2 +117600 WRK-DS-LS-01V00 ROUNDED ON SIZE ERROR NC1174.2 +117700 MOVE "0" TO WRK-XN-00001. NC1174.2 +117800 SIG-TEST-GF-26-1. NC1174.2 +117900 IF WRK-DS-LS-01V00 EQUAL TO +1 NC1174.2 +118000 PERFORM PASS NC1174.2 +118100 GO TO SIG-WRITE-GF-26-1. NC1174.2 +118200 MOVE +1 TO CORRECT-N. NC1174.2 +118300 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +118400 PERFORM FAIL. NC1174.2 +118500 GO TO SIG-WRITE-GF-26-1. NC1174.2 +118600 SIG-DELETE-GF-26-1. NC1174.2 +118700 PERFORM DE-LETE. NC1174.2 +118800 SIG-WRITE-GF-26-1. NC1174.2 +118900 MOVE "SIG-TEST-GF-26-1 " TO PAR-NAME. NC1174.2 +119000 PERFORM PRINT-DETAIL. NC1174.2 +119100 SIG-TEST-GF-26-2. NC1174.2 +119200 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +119300 MOVE "0" TO COMPUTED-A NC1174.2 +119400 MOVE "1" TO CORRECT-A NC1174.2 +119500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1174.2 +119600 PERFORM FAIL NC1174.2 +119700 GO TO SIG-WRITE-GF-26-2. NC1174.2 +119800 PERFORM PASS. NC1174.2 +119900 GO TO SIG-WRITE-GF-26-2. NC1174.2 +120000 SIG-DELETE-GF-26-2. NC1174.2 +120100 PERFORM DE-LETE. NC1174.2 +120200 SIG-WRITE-GF-26-2. NC1174.2 +120300 MOVE "SIG-TEST-GF-26-2 " TO PAR-NAME. NC1174.2 +120400 PERFORM PRINT-DETAIL. NC1174.2 +120500* NC1174.2 +120600 CCVS-EXIT SECTION. NC1174.2 +120700 CCVS-999999. NC1174.2 +120800 GO TO CLOSE-FILES. NC1174.2 +*END-OF,NC117A +*HEADER,COBOL,NC118A +000100 IDENTIFICATION DIVISION. NC1184.2 +000200 PROGRAM-ID. NC1184.2 +000300 NC118A. NC1184.2 +000400**************************************************************** NC1184.2 +000500* * NC1184.2 +000600* VALIDATION FOR:- * NC1184.2 +000700* * NC1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +000900* * NC1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1184.2 +001100* * NC1184.2 +001200**************************************************************** NC1184.2 +001300* * NC1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1184.2 +001500* * NC1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1184.2 +001900* * NC1184.2 +002000**************************************************************** NC1184.2 +002100* NC1184.2 +002200* PROGRAM NC118A TESTS THE USE OF THE "SIGN" CLAUSE USING NC1184.2 +002300* FORMATS 1 AND 2 OF THE ADD STATEMENT. ALL COMBINATIONS NC1184.2 +002400* OF THE SIGN CLAUSE PHRASES ARE TESTED USING DATA ITEMS NC1184.2 +002500* OF VARIOUS LENGTHS. NC1184.2 +002600* NC1184.2 +002700 NC1184.2 +002800 ENVIRONMENT DIVISION. NC1184.2 +002900 CONFIGURATION SECTION. NC1184.2 +003000 SOURCE-COMPUTER. NC1184.2 +003100 XXXXX082. NC1184.2 +003200 OBJECT-COMPUTER. NC1184.2 +003300 XXXXX083. NC1184.2 +003400 INPUT-OUTPUT SECTION. NC1184.2 +003500 FILE-CONTROL. NC1184.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1184.2 +003700 XXXXX055. NC1184.2 +003800 DATA DIVISION. NC1184.2 +003900 FILE SECTION. NC1184.2 +004000 FD PRINT-FILE. NC1184.2 +004100 01 PRINT-REC PICTURE X(120). NC1184.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC1184.2 +004300 WORKING-STORAGE SECTION. NC1184.2 +004400 77 SIZE-ERR PICTURE X VALUE SPACE. NC1184.2 +004500 77 A18TWOS-DS-LS-18V00 PICTURE S9(18) NC1184.2 +004600 SIGN IS LEADING SEPARATE NC1184.2 +004700 VALUE 222222222222222222. NC1184.2 +004800 77 A18ONES-DS-TS-18V00 PICTURE S9(18) NC1184.2 +004900 SIGN IS TRAILING SEPARATE NC1184.2 +005000 VALUE 111111111111111111. NC1184.2 +005100 77 WRK-DS-10V00 PICTURE S9(10) TRAILING. NC1184.2 +005200 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1184.2 +005300 SIGN TRAILING NC1184.2 +005400 VALUE 1111111111. NC1184.2 +005500 77 A05ONES-DS-L-05V00 PICTURE S9(5) NC1184.2 +005600 SIGN LEADING NC1184.2 +005700 VALUE 11111. NC1184.2 +005800 77 A02ONES-DS-LS-02V00 PICTURE S99 NC1184.2 +005900 LEADING SEPARATE NC1184.2 +006000 VALUE 11. NC1184.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9) TRAILING. NC1184.2 +006200 77 WRK-DS-T-18V00 REDEFINES WRK-DS-09V09 NC1184.2 +006300 PICTURE S9(18) TRAILING. NC1184.2 +006400 77 A06THREES-DS-03V03 PICTURE S999V999 NC1184.2 +006500 VALUE 333.333. NC1184.2 +006600 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1184.2 +006700 VALUE 333333.333333. NC1184.2 +006800 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1184.2 +006900 SIGN IS TRAILING SEPARATE CHARACTER. NC1184.2 +007000 77 WRK-DS-TS-12V00-S REDEFINES WRK-DS-TS-06V06 NC1184.2 +007100 TRAILING SEPARATE NC1184.2 +007200 PICTURE S9(12). NC1184.2 +007300 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) NC1184.2 +007400 LEADING SEPARATE NC1184.2 +007500 VALUE .11111. NC1184.2 +007600 77 WRK-DS-T-05V00 PICTURE S9(5) TRAILING. NC1184.2 +007700 77 WRK-DS-T-06V00 PICTURE S9(6) TRAILING. NC1184.2 +007800 77 WRK-DS-02V00 PICTURE S99. NC1184.2 +007900 77 A12ONES-DS-L-12V00 PICTURE S9(12) NC1184.2 +008000 USAGE IS DISPLAY SIGN IS LEADING NC1184.2 +008100 VALUE 111111111111. NC1184.2 +008200 77 WRK-DS-03V10 PICTURE S999V9(10). NC1184.2 +008300 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1184.2 +008400 PICTURE S9(13). NC1184.2 +008500 77 A99-DS-T-02V00 PICTURE S99 NC1184.2 +008600 USAGE IS DISPLAY SIGN IS TRAILING NC1184.2 +008700 VALUE 99. NC1184.2 +008800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1184.2 +008900 VALUE 11.1. NC1184.2 +009000 77 A06ONES-DS-TS-03V03 PICTURE S999V999 NC1184.2 +009100 USAGE IS DISPLAY TRAILING SEPARATE NC1184.2 +009200 VALUE 111.111. NC1184.2 +009300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1184.2 +009400 VALUE 22.222222. NC1184.2 +009500 77 A01ONES-DS-LS-P0801 PICTURE SP(8)9 NC1184.2 +009600 SIGN IS LEADING SEPARATE NC1184.2 +009700 VALUE .000000001. NC1184.2 +009800 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1184.2 +009900 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1184.2 +010000 VALUE 111111111111111111. NC1184.2 +010100 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1184.2 +010200 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1184.2 +010300 VALUE 99. NC1184.2 +010400 77 WRK-DS-TS-0201P PICTURE S99P TRAILING SEPARATE. NC1184.2 +010500 77 WRK-DS-06V00 PICTURE S9(6). NC1184.2 +010600 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) NC1184.2 +010700 SIGN IS LEADING SEPARATE USAGE DISPLAY NC1184.2 +010800 VALUE ZERO. NC1184.2 +010900 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1184.2 +011000 VALUE +012345678.876543210. NC1184.2 +011100 77 XDATA-XN-00018 PICTURE X(18) NC1184.2 +011200 VALUE "00ABCDEFGHI 4321 ". NC1184.2 +011300 77 WRK-XN-00018 PICTURE X(18). NC1184.2 +011400 77 ADD-12 PICTURE PP9 VALUE .001. NC1184.2 +011500 77 ADD-13 PICTURE 9PP VALUE 100. NC1184.2 +011600 77 ADD-14 PICTURE 999V999. NC1184.2 +011700 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1184.2 +011800 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1184.2 +011900 COMPUTATIONAL. NC1184.2 +012000 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1184.2 +012100 COMPUTATIONAL. NC1184.2 +012200 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1184.2 +012300 COMPUTATIONAL. NC1184.2 +012400 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1184.2 +012500 COMPUTATIONAL. NC1184.2 +012600 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1184.2 +012700 COMPUTATIONAL. NC1184.2 +012800 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1184.2 +012900 COMPUTATIONAL. NC1184.2 +013000 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1184.2 +013100 COMPUTATIONAL. NC1184.2 +013200 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1184.2 +013300 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1184.2 +013400 COMPUTATIONAL. NC1184.2 +013500 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1184.2 +013600 01 SUBTRACT-DATA SIGN IS LEADING SEPARATE DISPLAY. NC1184.2 +013700 02 SUBTR-1 PICTURE 9 VALUE 1. NC1184.2 +013800 02 SUBTR-2 PICTURE S99 VALUE 99. NC1184.2 +013900 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1184.2 +014000 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1184.2 +014100 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1184.2 +014200 02 SUBTR-6 PICTURE 9 VALUE 1. NC1184.2 +014300 02 SUBTR-7 PICTURE S99 VALUE 99. NC1184.2 +014400 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1184.2 +014500 02 SUBTR-10 PICTURE S999 VALUE 100. NC1184.2 +014600 02 SUBTR-11 PICTURE S999V999. NC1184.2 +014700 01 N-3 PICTURE IS 99999. NC1184.2 +014800 01 N-4 PICTURE IS 9(5) NC1184.2 +014900 VALUE IS 52800. NC1184.2 +015000 01 N-5 PICTURE IS S9(9)V99 NC1184.2 +015100 SIGN IS LEADING SEPARATE NC1184.2 +015200 VALUE IS 000000001.00. NC1184.2 +015300 01 N-7 PICTURE IS S9(7)V9(4) NC1184.2 +015400 SIGN IS LEADING SEPARATE CHARACTER NC1184.2 +015500 VALUE IS 0000001.0000. NC1184.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1184.2 +015700 01 N-10 PICTURE IS S99999V NC1184.2 +015800 VALUE IS -00001. NC1184.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1184.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1184.2 +016100 01 N-13 PICTURE IS 9(5) NC1184.2 +016200 VALUE IS 99999. NC1184.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1184.2 +016400 01 N-15 PICTURE IS 9(16). NC1184.2 +016500 01 N-16 PICTURE IS S999999V99 NC1184.2 +016600 VALUE IS 5.90. NC1184.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1184.2 +016800 VALUE IS +3.6. NC1184.2 +016900 01 N-18 PICTURE IS S9(10) NC1184.2 +017000 VALUE IS -5. NC1184.2 +017100 01 N-19 PICTURE IS $9.00. NC1184.2 +017200 01 N-20 PICTURE IS S9(9) NC1184.2 +017300 VALUE IS -999999999. NC1184.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1184.2 +017500 01 N-22 PICTURE IS 999V99 NC1184.2 +017600 VALUE IS 005.55. NC1184.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1184.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1184.2 +017900 01 N-26 PICTURE 9(5). NC1184.2 +018000 01 N-27 PICTURE IS 9999V9 NC1184.2 +018100 VALUE IS 9999.9. NC1184.2 +018200 01 N-28 PICTURE IS $9999.00. NC1184.2 +018300 01 N-40 PICTURE IS 9(7) NC1184.2 +018400 VALUE IS 7777777. NC1184.2 +018500 01 N-41 PICTURE IS 9(7) NC1184.2 +018600 VALUE IS 1111111. NC1184.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1184.2 +018800 01 TRUNC-DATA. NC1184.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1184.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1184.2 +019100 02 N-45 PICTURE S9. NC1184.2 +019200 01 MINUS-NAMES SIGN IS TRAILING SEPARATE CHARACTER. NC1184.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1184.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1184.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1184.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1184.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1184.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1184.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1184.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1184.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1184.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1184.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1184.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1184.2 +020500 01 TEST-RESULTS. NC1184.2 +020600 02 FILLER PIC X VALUE SPACE. NC1184.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1184.2 +020800 02 FILLER PIC X VALUE SPACE. NC1184.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1184.2 +021000 02 FILLER PIC X VALUE SPACE. NC1184.2 +021100 02 PAR-NAME. NC1184.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1184.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1184.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1184.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1184.2 +021600 02 RE-MARK PIC X(61). NC1184.2 +021700 01 TEST-COMPUTED. NC1184.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1184.2 +021900 02 FILLER PIC X(17) VALUE NC1184.2 +022000 " COMPUTED=". NC1184.2 +022100 02 COMPUTED-X. NC1184.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1184.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1184.2 +022400 PIC -9(9).9(9). NC1184.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1184.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1184.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1184.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1184.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1184.2 +023000 04 FILLER PIC X. NC1184.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1184.2 +023200 01 TEST-CORRECT. NC1184.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1184.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1184.2 +023500 02 CORRECT-X. NC1184.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1184.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1184.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1184.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1184.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1184.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1184.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1184.2 +024300 04 FILLER PIC X. NC1184.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1184.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1184.2 +024600 01 CCVS-C-1. NC1184.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1184.2 +024800- "SS PARAGRAPH-NAME NC1184.2 +024900- " REMARKS". NC1184.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1184.2 +025100 01 CCVS-C-2. NC1184.2 +025200 02 FILLER PIC X VALUE SPACE. NC1184.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1184.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1184.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1184.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1184.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1184.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1184.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1184.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1184.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1184.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1184.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1184.2 +026800 01 CCVS-H-1. NC1184.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1184.2 +027000 02 FILLER PIC X(42) VALUE NC1184.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1184.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1184.2 +027300 01 CCVS-H-2A. NC1184.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1184.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1184.2 +027600 02 FILLER PIC XXXX VALUE NC1184.2 +027700 "4.2 ". NC1184.2 +027800 02 FILLER PIC X(28) VALUE NC1184.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1184.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1184.2 +028100 NC1184.2 +028200 01 CCVS-H-2B. NC1184.2 +028300 02 FILLER PIC X(15) VALUE NC1184.2 +028400 "TEST RESULT OF ". NC1184.2 +028500 02 TEST-ID PIC X(9). NC1184.2 +028600 02 FILLER PIC X(4) VALUE NC1184.2 +028700 " IN ". NC1184.2 +028800 02 FILLER PIC X(12) VALUE NC1184.2 +028900 " HIGH ". NC1184.2 +029000 02 FILLER PIC X(22) VALUE NC1184.2 +029100 " LEVEL VALIDATION FOR ". NC1184.2 +029200 02 FILLER PIC X(58) VALUE NC1184.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +029400 01 CCVS-H-3. NC1184.2 +029500 02 FILLER PIC X(34) VALUE NC1184.2 +029600 " FOR OFFICIAL USE ONLY ". NC1184.2 +029700 02 FILLER PIC X(58) VALUE NC1184.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1184.2 +029900 02 FILLER PIC X(28) VALUE NC1184.2 +030000 " COPYRIGHT 1985 ". NC1184.2 +030100 01 CCVS-E-1. NC1184.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1184.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1184.2 +030400 02 ID-AGAIN PIC X(9). NC1184.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1184.2 +030600 01 CCVS-E-2. NC1184.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1184.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1184.2 +030900 02 CCVS-E-2-2. NC1184.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1184.2 +031100 03 FILLER PIC X VALUE SPACE. NC1184.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1184.2 +031300 "ERRORS ENCOUNTERED". NC1184.2 +031400 01 CCVS-E-3. NC1184.2 +031500 02 FILLER PIC X(22) VALUE NC1184.2 +031600 " FOR OFFICIAL USE ONLY". NC1184.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1184.2 +031800 02 FILLER PIC X(58) VALUE NC1184.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1184.2 +032100 02 FILLER PIC X(15) VALUE NC1184.2 +032200 " COPYRIGHT 1985". NC1184.2 +032300 01 CCVS-E-4. NC1184.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1184.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1184.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1184.2 +032700 02 FILLER PIC X(40) VALUE NC1184.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1184.2 +032900 01 XXINFO. NC1184.2 +033000 02 FILLER PIC X(19) VALUE NC1184.2 +033100 "*** INFORMATION ***". NC1184.2 +033200 02 INFO-TEXT. NC1184.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1184.2 +033400 04 XXCOMPUTED PIC X(20). NC1184.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1184.2 +033600 04 XXCORRECT PIC X(20). NC1184.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1184.2 +033800 01 HYPHEN-LINE. NC1184.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1184.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1184.2 +034100- "*****************************************". NC1184.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1184.2 +034300- "******************************". NC1184.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1184.2 +034500 "NC118A". NC1184.2 +034600 PROCEDURE DIVISION. NC1184.2 +034700 CCVS1 SECTION. NC1184.2 +034800 OPEN-FILES. NC1184.2 +034900 OPEN OUTPUT PRINT-FILE. NC1184.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1184.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1184.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1184.2 +035300 GO TO CCVS1-EXIT. NC1184.2 +035400 CLOSE-FILES. NC1184.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1184.2 +035600 TERMINATE-CCVS. NC1184.2 +035700S EXIT PROGRAM. NC1184.2 +035800STERMINATE-CALL. NC1184.2 +035900 STOP RUN. NC1184.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1184.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1184.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1184.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1184.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1184.2 +036500 PRINT-DETAIL. NC1184.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1184.2 +036700 MOVE "." TO PARDOT-X NC1184.2 +036800 MOVE REC-CT TO DOTVALUE. NC1184.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1184.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1184.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1184.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1184.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1184.2 +037400 MOVE SPACE TO CORRECT-X. NC1184.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1184.2 +037600 MOVE SPACE TO RE-MARK. NC1184.2 +037700 HEAD-ROUTINE. NC1184.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1184.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1184.2 +038200 COLUMN-NAMES-ROUTINE. NC1184.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +038600 END-ROUTINE. NC1184.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1184.2 +038800 END-RTN-EXIT. NC1184.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +039000 END-ROUTINE-1. NC1184.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1184.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1184.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1184.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1184.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1184.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1184.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1184.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1184.2 +039900 END-ROUTINE-12. NC1184.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1184.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1184.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1184.2 +040300 ELSE NC1184.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1184.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1184.2 +040600 PERFORM WRITE-LINE. NC1184.2 +040700 END-ROUTINE-13. NC1184.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1184.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1184.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1184.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1184.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1184.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1184.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1184.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1184.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041900 WRITE-LINE. NC1184.2 +042000 ADD 1 TO RECORD-COUNT. NC1184.2 +042100Y IF RECORD-COUNT GREATER 42 NC1184.2 +042200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1184.2 +042300Y MOVE SPACE TO DUMMY-RECORD NC1184.2 +042400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1184.2 +042500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1184.2 +042600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1184.2 +042700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1184.2 +042800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1184.2 +042900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1184.2 +043300Y MOVE ZERO TO RECORD-COUNT. NC1184.2 +043400 PERFORM WRT-LN. NC1184.2 +043500 WRT-LN. NC1184.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1184.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1184.2 +043800 BLANK-LINE-PRINT. NC1184.2 +043900 PERFORM WRT-LN. NC1184.2 +044000 FAIL-ROUTINE. NC1184.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1184.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1184.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1184.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1184.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1184.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1184.2 +044800 GO TO FAIL-ROUTINE-EX. NC1184.2 +044900 FAIL-ROUTINE-WRITE. NC1184.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1184.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1184.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1184.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1184.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1184.2 +045500 BAIL-OUT. NC1184.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1184.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1184.2 +045800 BAIL-OUT-WRITE. NC1184.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1184.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1184.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1184.2 +046300 BAIL-OUT-EX. EXIT. NC1184.2 +046400 CCVS1-EXIT. NC1184.2 +046500 EXIT. NC1184.2 +046600 SECT-NC118A-001 SECTION. NC1184.2 +046700 SIG-INIT-GF-1. NC1184.2 +046800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +046900 MOVE "ADD " TO FEATURE. NC1184.2 +047000 MOVE 000000001.00 TO N-5. NC1184.2 +047100 MOVE 0000001.0000 TO N-7. NC1184.2 +047200 SIG-TEST-GF-1-0. NC1184.2 +047300 ADD N-5 TO N-7. NC1184.2 +047400 SIG-TEST-GF-1-1. NC1184.2 +047500 IF N-7 = 2 NC1184.2 +047600 PERFORM PASS GO TO SIG-WRITE-GF-1. NC1184.2 +047700 GO TO SIG-FAIL-GF-1. NC1184.2 +047800 SIG-DELETE-GF-1. NC1184.2 +047900 PERFORM DE-LETE. NC1184.2 +048000 GO TO SIG-WRITE-GF-1. NC1184.2 +048100 SIG-FAIL-GF-1. NC1184.2 +048200 MOVE N-7 TO COMPUTED-N NC1184.2 +048300 MOVE 2 TO CORRECT-N. NC1184.2 +048400 PERFORM FAIL. NC1184.2 +048500 SIG-WRITE-GF-1. NC1184.2 +048600 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1184.2 +048700 PERFORM PRINT-DETAIL. NC1184.2 +048800 SIG-INIT-GF-2. NC1184.2 +048900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +049000 MOVE "ADD ---" TO FEATURE. NC1184.2 +049100 PERFORM PRINT-DETAIL. NC1184.2 +049200 MOVE " TO" TO FEATURE. NC1184.2 +049300 MOVE A18TWOS-DS-LS-18V00 TO WRK-DS-T-18V00. NC1184.2 +049400 SIG-TEST-GF-2-0. NC1184.2 +049500 ADD A18ONES-DS-TS-18V00 TO WRK-DS-T-18V00. NC1184.2 +049600 SIG-TEST-GF-2-1. NC1184.2 +049700 IF WRK-DS-T-18V00 EQUAL TO 333333333333333333 NC1184.2 +049800 PERFORM PASS GO TO SIG-WRITE-GF-2. NC1184.2 +049900 GO TO SIG-FAIL-GF-2. NC1184.2 +050000 SIG-DELETE-GF-2. NC1184.2 +050100 PERFORM DE-LETE. NC1184.2 +050200 GO TO SIG-WRITE-GF-2. NC1184.2 +050300 SIG-FAIL-GF-2. NC1184.2 +050400 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +050500 MOVE 333333333333333333 TO CORRECT-18V0. NC1184.2 +050600 PERFORM FAIL. NC1184.2 +050700 SIG-WRITE-GF-2. NC1184.2 +050800 MOVE "SIG-TEST-GF-2" TO PAR-NAME. NC1184.2 +050900 PERFORM PRINT-DETAIL. NC1184.2 +051000 SIG-INIT-GF-3. NC1184.2 +051100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +051200 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +051300 SIG-TEST-GF-3-0. NC1184.2 +051400 ADD A10ONES-DS-T-10V00 A05ONES-DS-L-05V00 NC1184.2 +051500 TO WRK-DS-10V00. NC1184.2 +051600 SIG-TEST-GF-3-1. NC1184.2 +051700 IF WRK-DS-10V00 EQUAL TO 1111122222 NC1184.2 +051800 PERFORM PASS GO TO SIG-WRITE-GF-3. NC1184.2 +051900 GO TO SIG-FAIL-GF-3. NC1184.2 +052000 SIG-DELETE-GF-3. NC1184.2 +052100 PERFORM DE-LETE. NC1184.2 +052200 GO TO SIG-WRITE-GF-3. NC1184.2 +052300 SIG-FAIL-GF-3. NC1184.2 +052400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1184.2 +052500 MOVE 1111122222 TO CORRECT-18V0. NC1184.2 +052600 PERFORM FAIL. NC1184.2 +052700 SIG-WRITE-GF-3. NC1184.2 +052800 MOVE "SIG-TEST-GF-3" TO PAR-NAME. NC1184.2 +052900 PERFORM PRINT-DETAIL. NC1184.2 +053000 SIG-INIT-GF-4. NC1184.2 +053100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +053200 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +053300 SIG-TEST-GF-4-0. NC1184.2 +053400 ADD A02ONES-DS-LS-02V00 NC1184.2 +053500 A10ONES-DS-T-10V00 NC1184.2 +053600 A05ONES-DS-L-05V00 TO WRK-DS-10V00. NC1184.2 +053700 SIG-TEST-GF-4-1. NC1184.2 +053800 IF WRK-DS-10V00 EQUAL TO 1111122233 NC1184.2 +053900 PERFORM PASS GO TO SIG-WRITE-GF-4. NC1184.2 +054000 GO TO SIG-FAIL-GF-4. NC1184.2 +054100 SIG-DELETE-GF-4. NC1184.2 +054200 PERFORM DE-LETE. NC1184.2 +054300 GO TO SIG-WRITE-GF-4. NC1184.2 +054400 SIG-FAIL-GF-4. NC1184.2 +054500 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1184.2 +054600 MOVE 1111122233 TO CORRECT-18V0. NC1184.2 +054700 PERFORM FAIL. NC1184.2 +054800 SIG-WRITE-GF-4. NC1184.2 +054900 MOVE "SIG-TEST-GF-4" TO PAR-NAME. NC1184.2 +055000 PERFORM PRINT-DETAIL. NC1184.2 +055100 SIG-INIT-GF-10. NC1184.2 +055200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +055300 MOVE " GIVING" TO FEATURE. NC1184.2 +055400 MOVE ZERO TO WRK-DS-09V09. NC1184.2 +055500 SIG-TEST-GF-10-0. NC1184.2 +055600 ADD A06THREES-DS-03V03 NC1184.2 +055700 A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1184.2 +055800 SIG-TEST-GF-10-1. NC1184.2 +055900 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1184.2 +056000 PERFORM PASS GO TO SIG-WRITE-GF-10. NC1184.2 +056100 GO TO SIG-FAIL-GF-10. NC1184.2 +056200 SIG-DELETE-GF-10. NC1184.2 +056300 PERFORM DE-LETE. NC1184.2 +056400 GO TO SIG-WRITE-GF-10. NC1184.2 +056500 SIG-FAIL-GF-10. NC1184.2 +056600 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1184.2 +056700 MOVE 000333666.666333000 TO CORRECT-N. NC1184.2 +056800 PERFORM FAIL. NC1184.2 +056900 SIG-WRITE-GF-10. NC1184.2 +057000 MOVE "SIG-TEST-GF-10" TO PAR-NAME. NC1184.2 +057100 PERFORM PRINT-DETAIL. NC1184.2 +057200 SIG-INIT-GF-11. NC1184.2 +057300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +057400 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +057500 SIG-TEST-GF-11-0. NC1184.2 +057600 ADD A05ONES-DS-L-05V00 NC1184.2 +057700 A05ONES-DS-LS-00V05 NC1184.2 +057800 A12THREES-DS-06V06 NC1184.2 +057900 A06THREES-DS-03V03 GIVING WRK-DS-TS-06V06. NC1184.2 +058000 SIG-TEST-GF-11-1. NC1184.2 +058100 IF WRK-DS-TS-06V06 EQUAL TO 344777.777443 NC1184.2 +058200 PERFORM PASS GO TO SIG-WRITE-GF-11. NC1184.2 +058300 GO TO SIG-FAIL-GF-11. NC1184.2 +058400 SIG-DELETE-GF-11. NC1184.2 +058500 PERFORM DE-LETE. NC1184.2 +058600 GO TO SIG-WRITE-GF-11. NC1184.2 +058700 SIG-FAIL-GF-11. NC1184.2 +058800 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +058900 MOVE 344777.777443 TO CORRECT-N. NC1184.2 +059000 PERFORM FAIL. NC1184.2 +059100 SIG-WRITE-GF-11. NC1184.2 +059200 MOVE "SIG-TEST-GF-11" TO PAR-NAME. NC1184.2 +059300 PERFORM PRINT-DETAIL. NC1184.2 +059400 SIG-INIT-GF-5. NC1184.2 +059500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +059600 MOVE " ROUNDED" TO FEATURE. NC1184.2 +059700 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +059800 SIG-TEST-GF-5-0. NC1184.2 +059900 ADD 55554.5 TO WRK-DS-T-05V00 ROUNDED. NC1184.2 +060000 SIG-TEST-GF-5-1. NC1184.2 +060100 IF WRK-DS-T-05V00 EQUAL TO 55555 NC1184.2 +060200 PERFORM PASS GO TO SIG-WRITE-GF-5. NC1184.2 +060300 GO TO SIG-FAIL-GF-5. NC1184.2 +060400 SIG-DELETE-GF-5. NC1184.2 +060500 PERFORM DE-LETE. NC1184.2 +060600 GO TO SIG-WRITE-GF-5. NC1184.2 +060700 SIG-FAIL-GF-5. NC1184.2 +060800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +060900 MOVE 55555 TO CORRECT-N. NC1184.2 +061000 PERFORM FAIL. NC1184.2 +061100 SIG-WRITE-GF-5. NC1184.2 +061200 MOVE "SIG-TEST-GF-5" TO PAR-NAME. NC1184.2 +061300 PERFORM PRINT-DETAIL. NC1184.2 +061400 SIG-INIT-GF-12. NC1184.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +061600 MOVE ZERO TO WRK-DS-T-06V00. NC1184.2 +061700 SIG-TEST-GF-12-0. NC1184.2 +061800 ADD A05ONES-DS-LS-00V05 NC1184.2 +061900 A12THREES-DS-06V06 NC1184.2 +062000 A05ONES-DS-LS-00V05 GIVING WRK-DS-T-06V00 ROUNDED. NC1184.2 +062100 SIG-TEST-GF-12-1. NC1184.2 +062200 IF WRK-DS-T-06V00 EQUAL TO 333334 NC1184.2 +062300 PERFORM PASS GO TO SIG-WRITE-GF-12. NC1184.2 +062400 GO TO SIG-FAIL-GF-12. NC1184.2 +062500 SIG-DELETE-GF-12. NC1184.2 +062600 PERFORM DE-LETE. NC1184.2 +062700 GO TO SIG-WRITE-GF-12. NC1184.2 +062800 SIG-FAIL-GF-12. NC1184.2 +062900 MOVE WRK-DS-T-06V00 TO COMPUTED-N. NC1184.2 +063000 MOVE 333334 TO CORRECT-N. NC1184.2 +063100 PERFORM FAIL. NC1184.2 +063200 SIG-WRITE-GF-12. NC1184.2 +063300 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1184.2 +063400 PERFORM PRINT-DETAIL. NC1184.2 +063500 SIG-INIT-GF-13. NC1184.2 +063600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +063700 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +063800 SIG-TEST-GF-13-1-0. NC1184.2 +063900 ADD A12ONES-DS-L-12V00 NC1184.2 +064000 ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1184.2 +064100 PERFORM PASS GO TO SIG-WRITE-GF-13-1. NC1184.2 +064200 GO TO SIG-FAIL-GF-13-1. NC1184.2 +064300 SIG-DELETE-GF-13-1. NC1184.2 +064400 PERFORM DE-LETE. NC1184.2 +064500 GO TO SIG-WRITE-GF-13-1. NC1184.2 +064600 SIG-FAIL-GF-13-1. NC1184.2 +064700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +064800 PERFORM FAIL. NC1184.2 +064900 SIG-WRITE-GF-13-1. NC1184.2 +065000 MOVE "SIG-TEST-GF-13-1" TO PAR-NAME. NC1184.2 +065100 PERFORM PRINT-DETAIL. NC1184.2 +065200 SIG-TEST-GF-13-2. NC1184.2 +065300 IF WRK-DS-10V00 EQUAL TO ZERO NC1184.2 +065400 PERFORM PASS GO TO SIG-WRITE-GF-13-2. NC1184.2 +065500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-13-1 NC1184.2 +065600 GO TO SIG-FAIL-GF-13-2. NC1184.2 +065700 SIG-DELETE-GF-13-2. NC1184.2 +065800 PERFORM DE-LETE. NC1184.2 +065900 GO TO SIG-WRITE-GF-13-2. NC1184.2 +066000 SIG-FAIL-GF-13-2. NC1184.2 +066100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +066200 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1184.2 +066300 MOVE ZERO TO CORRECT-14V4. NC1184.2 +066400 PERFORM FAIL. NC1184.2 +066500 SIG-WRITE-GF-13-2. NC1184.2 +066600 MOVE "SIG-TEST-GF-13-2" TO PAR-NAME. NC1184.2 +066700 PERFORM PRINT-DETAIL. NC1184.2 +066800 SIG-INIT-GF-6. NC1184.2 +066900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +067000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1184.2 +067100 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +067200 SIG-TEST-GF-6-1. NC1184.2 +067300 ADD 33333 NC1184.2 +067400 A06THREES-DS-03V03 NC1184.2 +067500 A12THREES-DS-06V06 NC1184.2 +067600 TO WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1184.2 +067700 PERFORM PASS GO TO SIG-WRITE-GF-6-1. NC1184.2 +067800 GO TO SIG-FAIL-GF-6-1. NC1184.2 +067900 SIG-DELETE-GF-6-1. NC1184.2 +068000 PERFORM DE-LETE. NC1184.2 +068100 GO TO SIG-WRITE-GF-6-1. NC1184.2 +068200 SIG-FAIL-GF-6-1. NC1184.2 +068300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +068400 PERFORM FAIL. NC1184.2 +068500 SIG-WRITE-GF-6-1. NC1184.2 +068600 MOVE "SIG-TEST-GF-6-1" TO PAR-NAME. NC1184.2 +068700 PERFORM PRINT-DETAIL. NC1184.2 +068800 SIG-TEST-GF-6-2. NC1184.2 +068900 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1184.2 +069000 PERFORM PASS GO TO SIG-WRITE-GF-6-2. NC1184.2 +069100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-6-1 NC1184.2 +069200 GO TO SIG-FAIL-GF-6-2. NC1184.2 +069300 SIG-DELETE-GF-6-2. NC1184.2 +069400 PERFORM DE-LETE. NC1184.2 +069500 GO TO SIG-WRITE-GF-6-2. NC1184.2 +069600 SIG-FAIL-GF-6-2. NC1184.2 +069700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +069800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +069900 MOVE ZERO TO CORRECT-N. NC1184.2 +070000 PERFORM FAIL. NC1184.2 +070100 SIG-WRITE-GF-6-2. NC1184.2 +070200 MOVE "SIG-TEST-GF-6-2" TO PAR-NAME. NC1184.2 +070300 PERFORM PRINT-DETAIL. NC1184.2 +070400 SIG-INIT-GF-7. NC1184.2 +070500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +070600 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +070700 SIG-TEST-GF-7-1. NC1184.2 +070800 ADD A12THREES-DS-06V06 NC1184.2 +070900 333333 NC1184.2 +071000 A06THREES-DS-03V03 NC1184.2 +071100 TO WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1184.2 +071200 GO TO SIG-FAIL-GF-7-1. NC1184.2 +071300 PERFORM PASS. NC1184.2 +071400 GO TO SIG-WRITE-GF-7-1. NC1184.2 +071500 SIG-DELETE-GF-7-1. NC1184.2 +071600 PERFORM DE-LETE. NC1184.2 +071700 GO TO SIG-WRITE-GF-7-1. NC1184.2 +071800 SIG-FAIL-GF-7-1. NC1184.2 +071900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1184.2 +072000 PERFORM FAIL. NC1184.2 +072100 SIG-WRITE-GF-7-1. NC1184.2 +072200 MOVE "SIG-TEST-GF-7-1" TO PAR-NAME. NC1184.2 +072300 PERFORM PRINT-DETAIL. NC1184.2 +072400 SIG-TEST-GF-7-2. NC1184.2 +072500 IF WRK-DS-TS-06V06 EQUAL TO 666999.666333 NC1184.2 +072600 PERFORM PASS GO TO SIG-WRITE-GF-7-2. NC1184.2 +072700* NOTE THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-7-1NC1184.2 +072800 GO TO SIG-FAIL-GF-7-2. NC1184.2 +072900 SIG-DELETE-GF-7-2. NC1184.2 +073000 PERFORM DE-LETE. NC1184.2 +073100 GO TO SIG-WRITE-GF-7-2. NC1184.2 +073200 SIG-FAIL-GF-7-2. NC1184.2 +073300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +073400 MOVE 666999.666333 TO CORRECT-N. NC1184.2 +073500 PERFORM FAIL. NC1184.2 +073600 SIG-WRITE-GF-7-2. NC1184.2 +073700 MOVE "SIG-TEST-GF-7-2" TO PAR-NAME. NC1184.2 +073800 PERFORM PRINT-DETAIL. NC1184.2 +073900 SIG-INIT-GF-14. NC1184.2 +074000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +074100 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +074200 SIG-TEST-GF-14-1. NC1184.2 +074300 ADD 33333 NC1184.2 +074400 A06THREES-DS-03V03 NC1184.2 +074500 A12THREES-DS-06V06 NC1184.2 +074600 GIVING WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1184.2 +074700 PERFORM PASS GO TO SIG-WRITE-GF-14-1. NC1184.2 +074800 GO TO SIG-FAIL-GF-14-1. NC1184.2 +074900 SIG-DELETE-GF-14-1. NC1184.2 +075000 PERFORM DE-LETE. NC1184.2 +075100 GO TO SIG-WRITE-GF-14-1. NC1184.2 +075200 SIG-FAIL-GF-14-1. NC1184.2 +075300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +075400 PERFORM FAIL. NC1184.2 +075500 SIG-WRITE-GF-14-1. NC1184.2 +075600 MOVE "SIG-TEST-GF-14-1" TO PAR-NAME. NC1184.2 +075700 PERFORM PRINT-DETAIL. NC1184.2 +075800 SIG-TEST-GF-14-2. NC1184.2 +075900 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1184.2 +076000 PERFORM PASS GO TO SIG-WRITE-GF-14-2. NC1184.2 +076100 GO TO SIG-FAIL-GF-14-2. NC1184.2 +076200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-14-1 NC1184.2 +076300 SIG-DELETE-GF-14-2. NC1184.2 +076400 PERFORM DE-LETE. NC1184.2 +076500 GO TO SIG-WRITE-GF-14-2. NC1184.2 +076600 SIG-FAIL-GF-14-2. NC1184.2 +076700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +076800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +076900 MOVE ZERO TO CORRECT-N. NC1184.2 +077000 PERFORM FAIL. NC1184.2 +077100 SIG-WRITE-GF-14-2. NC1184.2 +077200 MOVE "SIG-TEST-GF-14-2" TO PAR-NAME. NC1184.2 +077300 PERFORM PRINT-DETAIL. NC1184.2 +077400 SIG-INIT-GF-15. NC1184.2 +077500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +077600 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +077700 SIG-TEST-GF-15-1-0. NC1184.2 +077800 ADD A12THREES-DS-06V06 NC1184.2 +077900 333333 NC1184.2 +078000 A06THREES-DS-03V03 NC1184.2 +078100 GIVING WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1184.2 +078200 GO TO SIG-FAIL-GF-15-1. NC1184.2 +078300 PERFORM PASS. NC1184.2 +078400 GO TO SIG-WRITE-GF-15-1. NC1184.2 +078500 SIG-DELETE-GF-15-1. NC1184.2 +078600 PERFORM DE-LETE. NC1184.2 +078700 GO TO SIG-WRITE-GF-15-1. NC1184.2 +078800 SIG-FAIL-GF-15-1. NC1184.2 +078900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1184.2 +079000 PERFORM FAIL. NC1184.2 +079100 SIG-WRITE-GF-15-1. NC1184.2 +079200 MOVE "SIG-TEST-GF-15-1" TO PAR-NAME. NC1184.2 +079300 PERFORM PRINT-DETAIL. NC1184.2 +079400 SIG-TEST-GF-15-2. NC1184.2 +079500 IF WRK-DS-TS-06V06 EQUAL TO 666999.666333 NC1184.2 +079600 PERFORM PASS GO TO SIG-WRITE-GF-15-2. NC1184.2 +079700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-15-1 NC1184.2 +079800 GO TO SIG-FAIL-GF-15-2. NC1184.2 +079900 SIG-DELETE-GF-15-2. NC1184.2 +080000 PERFORM DE-LETE. NC1184.2 +080100 GO TO SIG-WRITE-GF-15-2. NC1184.2 +080200 SIG-FAIL-GF-15-2. NC1184.2 +080300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +080400 MOVE 666999.666333 TO CORRECT-N. NC1184.2 +080500 PERFORM FAIL. NC1184.2 +080600 SIG-WRITE-GF-15-2. NC1184.2 +080700 MOVE "SIG-TEST-GF-15-2" TO PAR-NAME. NC1184.2 +080800 PERFORM PRINT-DETAIL. NC1184.2 +080900 SIG-INIT-GF-16. NC1184.2 +081000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +081100 MOVE " SERIES" TO FEATURE. NC1184.2 +081200 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +081300 SIG-TEST-GF-16-0. NC1184.2 +081400 ADD A99-DS-T-02V00 NC1184.2 +081500 A03ONES-DS-02V01 NC1184.2 +081600 A06ONES-DS-TS-03V03 NC1184.2 +081700 A08TWOS-DS-02V06 NC1184.2 +081800 -1.1111111 NC1184.2 +081900 +.11111111 NC1184.2 +082000 A01ONES-DS-LS-P0801 GIVING WRK-DS-03V10. NC1184.2 +082100 SIG-TEST-GF-16-1. NC1184.2 +082200 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +082300 PERFORM PASS GO TO SIG-WRITE-GF-16. NC1184.2 +082400 GO TO SIG-FAIL-GF-16. NC1184.2 +082500 SIG-DELETE-GF-16. NC1184.2 +082600 PERFORM DE-LETE. NC1184.2 +082700 GO TO SIG-WRITE-GF-16. NC1184.2 +082800 SIG-FAIL-GF-16. NC1184.2 +082900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +083000 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +083100 PERFORM FAIL. NC1184.2 +083200 SIG-WRITE-GF-16. NC1184.2 +083300 MOVE "SIG-TEST-GF-16" TO PAR-NAME. NC1184.2 +083400 PERFORM PRINT-DETAIL. NC1184.2 +083500 SIG-INIT-GF-17. NC1184.2 +083600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +083700 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +083800 SIG-TEST-GF-17-0. NC1184.2 +083900 ADD A01ONES-DS-LS-P0801 NC1184.2 +084000 +.11111111 NC1184.2 +084100 -1.1111111 NC1184.2 +084200 A08TWOS-DS-02V06 NC1184.2 +084300 A06ONES-DS-TS-03V03 NC1184.2 +084400 A03ONES-DS-02V01 NC1184.2 +084500 A99-DS-T-02V00 GIVING WRK-DS-03V10. NC1184.2 +084600 SIG-TEST-GF-17-1. NC1184.2 +084700 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +084800 PERFORM PASS GO TO SIG-WRITE-GF-17. NC1184.2 +084900 GO TO SIG-FAIL-GF-17. NC1184.2 +085000 SIG-DELETE-GF-17. NC1184.2 +085100 PERFORM DE-LETE. NC1184.2 +085200 GO TO SIG-WRITE-GF-17. NC1184.2 +085300 SIG-FAIL-GF-17. NC1184.2 +085400 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +085500 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +085600 PERFORM FAIL. NC1184.2 +085700 SIG-WRITE-GF-17. NC1184.2 +085800 MOVE "SIG-TEST-GF-17" TO PAR-NAME. NC1184.2 +085900 PERFORM PRINT-DETAIL. NC1184.2 +086000 SIG-INIT-GF-18. NC1184.2 +086100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +086200 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +086300 SIG-TEST-GF-18-0. NC1184.2 +086400 ADD A08TWOS-DS-02V06 NC1184.2 +086500 A99-DS-T-02V00 NC1184.2 +086600 -1.1111111 NC1184.2 +086700 A03ONES-DS-02V01 NC1184.2 +086800 A01ONES-DS-LS-P0801 NC1184.2 +086900 +.11111111 NC1184.2 +087000 A06ONES-DS-TS-03V03 GIVING WRK-DS-03V10. NC1184.2 +087100 SIG-TEST-GF-18-1. NC1184.2 +087200 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +087300 PERFORM PASS GO TO SIG-WRITE-GF-18. NC1184.2 +087400 GO TO SIG-FAIL-GF-18. NC1184.2 +087500 SIG-DELETE-GF-18. NC1184.2 +087600 PERFORM DE-LETE. NC1184.2 +087700 GO TO SIG-WRITE-GF-18. NC1184.2 +087800 SIG-FAIL-GF-18. NC1184.2 +087900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +088000 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +088100 PERFORM FAIL. NC1184.2 +088200 SIG-WRITE-GF-18. NC1184.2 +088300 MOVE "SIG-TEST-GF-18" TO PAR-NAME. NC1184.2 +088400 PERFORM PRINT-DETAIL. NC1184.2 +088500 SIG-INIT-GF-8. NC1184.2 +088600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +088700 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1184.2 +088800 MOVE A18ONES-DS-TS-18V00 TO WRK-CS-18V00. NC1184.2 +088900 SIG-TEST-GF-8-0. NC1184.2 +089000 ADD A18ONES-DS-TS-18V00 TO WRK-CS-18V00. NC1184.2 +089100 SIG-TEST-GF-8-1. NC1184.2 +089200 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1184.2 +089300 PERFORM PASS GO TO SIG-WRITE-GF-8. NC1184.2 +089400 GO TO SIG-FAIL-GF-8. NC1184.2 +089500 SIG-DELETE-GF-8. NC1184.2 +089600 PERFORM DE-LETE. NC1184.2 +089700 GO TO SIG-WRITE-GF-8. NC1184.2 +089800 SIG-FAIL-GF-8. NC1184.2 +089900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1184.2 +090000 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +090100 PERFORM FAIL. NC1184.2 +090200 SIG-WRITE-GF-8. NC1184.2 +090300 MOVE "SIG-TEST-GF-8" TO PAR-NAME. NC1184.2 +090400 PERFORM PRINT-DETAIL. NC1184.2 +090500 SIG-INIT-GF-9. NC1184.2 +090600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +090700 MOVE A18ONES-DS-TS-18V00 TO WRK-DS-T-18V00. NC1184.2 +090800 SIG-TEST-GF-9-0. NC1184.2 +090900 ADD A18ONES-CS-18V00 TO WRK-DS-T-18V00. NC1184.2 +091000 SIG-TEST-GF-9-1. NC1184.2 +091100 IF WRK-DS-T-18V00 EQUAL TO 222222222222222222 NC1184.2 +091200 PERFORM PASS GO TO SIG-WRITE-GF-9. NC1184.2 +091300 GO TO SIG-FAIL-GF-9. NC1184.2 +091400 SIG-DELETE-GF-9. NC1184.2 +091500 PERFORM DE-LETE. NC1184.2 +091600 GO TO SIG-WRITE-GF-9. NC1184.2 +091700 SIG-FAIL-GF-9. NC1184.2 +091800 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +091900 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +092000 PERFORM FAIL. NC1184.2 +092100 SIG-WRITE-GF-9. NC1184.2 +092200 MOVE "SIG-TEST-GF-9" TO PAR-NAME. NC1184.2 +092300 PERFORM PRINT-DETAIL. NC1184.2 +092400 SIG-INIT-GF-19. NC1184.2 +092500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +092600 MOVE SPACE TO SIZE-ERR. NC1184.2 +092700 SIG-TEST-GF-19-0. NC1184.2 +092800 ADD MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1184.2 +092900 PLUS-NAME2 EVEN-NAME1 35 GIVING WHOLE-FIELD NC1184.2 +093000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1184.2 +093100 SIG-TEST-GF-19-1. NC1184.2 +093200 IF WHOLE-FIELD EQUAL TO +1 NC1184.2 +093300 PERFORM PASS NC1184.2 +093400 GO TO SIG-WRITE-GF-19-1. NC1184.2 +093500 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1184.2 +093600 MOVE +1 TO CORRECT-18V0. NC1184.2 +093700 PERFORM FAIL. NC1184.2 +093800 GO TO SIG-WRITE-GF-19-1. NC1184.2 +093900 SIG-DELETE-GF-19-1. NC1184.2 +094000 PERFORM DE-LETE. NC1184.2 +094100 SIG-WRITE-GF-19-1. NC1184.2 +094200 MOVE "SIG-TEST-GF-19-1" TO PAR-NAME. NC1184.2 +094300 PERFORM PRINT-DETAIL. NC1184.2 +094400 SIG-TEST-GF-19-2. NC1184.2 +094500 IF SIZE-ERR EQUAL TO "1" NC1184.2 +094600 PERFORM FAIL NC1184.2 +094700 MOVE SPACE TO CORRECT-A NC1184.2 +094800 MOVE 1 TO COMPUTED-A NC1184.2 +094900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1184.2 +095000 GO TO SIG-WRITE-GF-19-2. NC1184.2 +095100 PERFORM PASS. NC1184.2 +095200 GO TO SIG-WRITE-GF-19-2. NC1184.2 +095300 SIG-DELETE-GF-19-2. NC1184.2 +095400 PERFORM DE-LETE. NC1184.2 +095500 SIG-WRITE-GF-19-2. NC1184.2 +095600 MOVE "SIG-TEST-GF-19-2" TO PAR-NAME. NC1184.2 +095700 PERFORM PRINT-DETAIL. NC1184.2 +095800 SIG-INIT-GF-20. NC1184.2 +095900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +096000 MOVE SPACE TO SIZE-ERR. NC1184.2 +096100 MOVE ZERO TO DECMAL-FIELD. NC1184.2 +096200 MOVE -.999999999999999999 TO MINUS-NAME3. NC1184.2 +096300 MOVE -.999999999999999999 TO MINUS-NAME4. NC1184.2 +096400 MOVE +.1 TO EVEN-NAME2. NC1184.2 +096500 MOVE +.999999999999999999 TO PLUS-NAME3. NC1184.2 +096600 MOVE +.999999999999999999 TO PLUS-NAME4. NC1184.2 +096700 SIG-TEST-GF-20-0. NC1184.2 +096800 ADD MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1184.2 +096900 PLUS-NAME4 EVEN-NAME2 .35 GIVING DECMAL-FIELD NC1184.2 +097000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1184.2 +097100 SIG-TEST-GF-20-1. NC1184.2 +097200 IF DECMAL-FIELD EQUAL TO +.1 NC1184.2 +097300 PERFORM PASS NC1184.2 +097400 GO TO SIG-WRITE-GF-20-1. NC1184.2 +097500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1184.2 +097600 MOVE +.1 TO CORRECT-0V18. NC1184.2 +097700 PERFORM FAIL. NC1184.2 +097800 GO TO SIG-WRITE-GF-20-1. NC1184.2 +097900 SIG-DELETE-GF-20-1. NC1184.2 +098000 PERFORM DE-LETE. NC1184.2 +098100 SIG-WRITE-GF-20-1. NC1184.2 +098200 MOVE "SIG-TEST-GF-20-1" TO PAR-NAME. NC1184.2 +098300 PERFORM PRINT-DETAIL. NC1184.2 +098400 SIG-TEST-GF-20-2. NC1184.2 +098500 IF SIZE-ERR EQUAL TO "1" NC1184.2 +098600 PERFORM FAIL NC1184.2 +098700 MOVE SPACE TO CORRECT-A NC1184.2 +098800 MOVE 1 TO COMPUTED-A NC1184.2 +098900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1184.2 +099000 GO TO SIG-WRITE-GF-20-2. NC1184.2 +099100 PERFORM PASS. NC1184.2 +099200 GO TO SIG-WRITE-GF-20-2. NC1184.2 +099300 SIG-DELETE-GF-20-2. NC1184.2 +099400 PERFORM DE-LETE. NC1184.2 +099500 SIG-WRITE-GF-20-2. NC1184.2 +099600 MOVE "SIG-TEST-GF-20-2" TO PAR-NAME. NC1184.2 +099700 PERFORM PRINT-DETAIL. NC1184.2 +099800 SIG-INIT-GF-21. NC1184.2 +099900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +100000 MOVE ZERO TO WRK-CS-18V00. NC1184.2 +100100 SIG-TEST-GF-21-0. NC1184.2 +100200 ADD A18ONES-CS-18V00 A18ONES-DS-TS-18V00 GIVING WRK-CS-18V00.NC1184.2 +100300 SIG-TEST-GF-21-1. NC1184.2 +100400 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1184.2 +100500 PERFORM PASS NC1184.2 +100600 GO TO SIG-WRITE-GF-21. NC1184.2 +100700 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +100800 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1184.2 +100900 PERFORM FAIL. NC1184.2 +101000 GO TO SIG-WRITE-GF-21. NC1184.2 +101100 SIG-DELETE-GF-21. NC1184.2 +101200 PERFORM DE-LETE. NC1184.2 +101300 SIG-WRITE-GF-21. NC1184.2 +101400 MOVE "SIG-TEST-GF-21 " TO PAR-NAME. NC1184.2 +101500 PERFORM PRINT-DETAIL. NC1184.2 +101600 SIG-INIT-GF-22. NC1184.2 +101700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +101800 MOVE ZERO TO WRK-DS-T-18V00. NC1184.2 +101900 SIG-TEST-GF-22-0. NC1184.2 +102000 ADD A18SIXES-CS-18V00 A12SEVENS-CU-18V00 GIVING NC1184.2 +102100 WRK-DS-T-18V00. NC1184.2 +102200 SIG-TEST-GF-22-1. NC1184.2 +102300 IF WRK-DS-T-18V00 EQUAL TO 666667444444444443 NC1184.2 +102400 PERFORM PASS NC1184.2 +102500 GO TO SIG-WRITE-GF-22. NC1184.2 +102600 MOVE 666667444444444443 TO CORRECT-18V0. NC1184.2 +102700 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +102800 PERFORM FAIL. NC1184.2 +102900 GO TO SIG-WRITE-GF-22. NC1184.2 +103000 SIG-DELETE-GF-22. NC1184.2 +103100 PERFORM DE-LETE. NC1184.2 +103200 SIG-WRITE-GF-22. NC1184.2 +103300 MOVE "SIG-TEST-GF-22 " TO PAR-NAME. NC1184.2 +103400 PERFORM PRINT-DETAIL. NC1184.2 +103500 CCVS-EXIT SECTION. NC1184.2 +103600 CCVS-999999. NC1184.2 +103700 GO TO CLOSE-FILES. NC1184.2 +*END-OF,NC118A +*HEADER,COBOL,NC119A +000100 IDENTIFICATION DIVISION. NC1194.2 +000200 PROGRAM-ID. NC1194.2 +000300 NC119A. NC1194.2 +000400**************************************************************** NC1194.2 +000500* * NC1194.2 +000600* VALIDATION FOR:- * NC1194.2 +000700* * NC1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +000900* * NC1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1194.2 +001100* * NC1194.2 +001200**************************************************************** NC1194.2 +001300* * NC1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1194.2 +001500* * NC1194.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1194.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1194.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1194.2 +001900* * NC1194.2 +002000**************************************************************** NC1194.2 +002100* NC1194.2 +002200* PROGRAM NC119A TESTS THE USE OF THE "SIGN" CLAUSE WITH NC1194.2 +002300* FORMATS 1 AND 2 OF THE SUBTRACT STATEMENT. NC1194.2 +002400* ALL COMBINATIONS OF THE SIGN CLAUSE PHRASES ARE USED NC1194.2 +002500* WITH DATA ITEMS OF VARIOUS LENGTHS. NC1194.2 +002600* NC1194.2 +002700* NC1194.2 +002800 NC1194.2 +002900 ENVIRONMENT DIVISION. NC1194.2 +003000 CONFIGURATION SECTION. NC1194.2 +003100 SOURCE-COMPUTER. NC1194.2 +003200 XXXXX082. NC1194.2 +003300 OBJECT-COMPUTER. NC1194.2 +003400 XXXXX083. NC1194.2 +003500 INPUT-OUTPUT SECTION. NC1194.2 +003600 FILE-CONTROL. NC1194.2 +003700 SELECT PRINT-FILE ASSIGN TO NC1194.2 +003800 XXXXX055. NC1194.2 +003900 DATA DIVISION. NC1194.2 +004000 FILE SECTION. NC1194.2 +004100 FD PRINT-FILE. NC1194.2 +004200 01 PRINT-REC PICTURE X(120). NC1194.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC1194.2 +004400 WORKING-STORAGE SECTION. NC1194.2 +004500 77 SIZE-ERR PICTURE X VALUE SPACE. NC1194.2 +004600 77 A18TWOS-DS-LS-18V00 PICTURE S9(18) NC1194.2 +004700 SIGN IS LEADING SEPARATE NC1194.2 +004800 VALUE 222222222222222222. NC1194.2 +004900 77 A18ONES-DS-TS-18V00 PICTURE S9(18) NC1194.2 +005000 SIGN IS TRAILING SEPARATE NC1194.2 +005100 VALUE 111111111111111111. NC1194.2 +005200 77 WRK-DS-10V00 PICTURE S9(10) TRAILING. NC1194.2 +005300 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1194.2 +005400 SIGN TRAILING NC1194.2 +005500 VALUE 1111111111. NC1194.2 +005600 77 A05ONES-DS-L-05V00 PICTURE S9(5) NC1194.2 +005700 SIGN LEADING NC1194.2 +005800 VALUE 11111. NC1194.2 +005900 77 A02ONES-DS-LS-02V00 PICTURE S99 NC1194.2 +006000 LEADING SEPARATE NC1194.2 +006100 VALUE 11. NC1194.2 +006200 77 WRK-DS-09V09 PICTURE S9(9)V9(9) TRAILING. NC1194.2 +006300 77 WRK-DS-T-18V00 REDEFINES WRK-DS-09V09 NC1194.2 +006400 PICTURE S9(18) TRAILING. NC1194.2 +006500 77 A06THREES-DS-03V03 PICTURE S999V999 NC1194.2 +006600 VALUE 333.333. NC1194.2 +006700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1194.2 +006800 VALUE 333333.333333. NC1194.2 +006900 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1194.2 +007000 SIGN IS TRAILING SEPARATE CHARACTER. NC1194.2 +007100 77 WRK-DS-TS-12V00-S REDEFINES WRK-DS-TS-06V06 NC1194.2 +007200 TRAILING SEPARATE NC1194.2 +007300 PICTURE S9(12). NC1194.2 +007400 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) NC1194.2 +007500 LEADING SEPARATE NC1194.2 +007600 VALUE .11111. NC1194.2 +007700 77 WRK-DS-T-05V00 PICTURE S9(5) TRAILING. NC1194.2 +007800 77 WRK-DS-02V00 PICTURE S99. NC1194.2 +007900 77 A12ONES-DS-L-12V00 PICTURE S9(12) NC1194.2 +008000 USAGE IS DISPLAY SIGN IS LEADING NC1194.2 +008100 VALUE 111111111111. NC1194.2 +008200 77 WRK-DS-03V10 PICTURE S999V9(10). NC1194.2 +008300 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1194.2 +008400 PICTURE S9(13). NC1194.2 +008500 77 A99-DS-T-02V00 PICTURE S99 NC1194.2 +008600 USAGE IS DISPLAY SIGN IS TRAILING NC1194.2 +008700 VALUE 99. NC1194.2 +008800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1194.2 +008900 VALUE 11.1. NC1194.2 +009000 77 A06ONES-DS-TS-03V03 PICTURE S999V999 NC1194.2 +009100 USAGE IS DISPLAY TRAILING SEPARATE NC1194.2 +009200 VALUE 111.111. NC1194.2 +009300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1194.2 +009400 VALUE 22.222222. NC1194.2 +009500 77 A01ONES-DS-LS-P0801 PICTURE SP(8)9 NC1194.2 +009600 SIGN IS LEADING SEPARATE NC1194.2 +009700 VALUE .000000001. NC1194.2 +009800 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1194.2 +009900 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1194.2 +010000 VALUE 111111111111111111. NC1194.2 +010100 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1194.2 +010200 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1194.2 +010300 VALUE 99. NC1194.2 +010400 77 WRK-DS-TS-0201P PICTURE S99P TRAILING SEPARATE. NC1194.2 +010500 77 WRK-DS-06V00 PICTURE S9(6). NC1194.2 +010600 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) NC1194.2 +010700 SIGN IS LEADING SEPARATE USAGE DISPLAY NC1194.2 +010800 VALUE ZERO. NC1194.2 +010900 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1194.2 +011000 VALUE +012345678.876543210. NC1194.2 +011100 77 XDATA-XN-00018 PICTURE X(18) NC1194.2 +011200 VALUE "00ABCDEFGHI 4321 ". NC1194.2 +011300 77 WRK-XN-00018 PICTURE X(18). NC1194.2 +011400 77 ADD-12 PICTURE PP9 VALUE .001. NC1194.2 +011500 77 ADD-13 PICTURE 9PP VALUE 100. NC1194.2 +011600 77 ADD-14 PICTURE 999V999. NC1194.2 +011700 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1194.2 +011800 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1194.2 +011900 COMPUTATIONAL. NC1194.2 +012000 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1194.2 +012100 COMPUTATIONAL. NC1194.2 +012200 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1194.2 +012300 COMPUTATIONAL. NC1194.2 +012400 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1194.2 +012500 COMPUTATIONAL. NC1194.2 +012600 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1194.2 +012700 COMPUTATIONAL. NC1194.2 +012800 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1194.2 +012900 COMPUTATIONAL. NC1194.2 +013000 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1194.2 +013100 COMPUTATIONAL. NC1194.2 +013200 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1194.2 +013300 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1194.2 +013400 COMPUTATIONAL. NC1194.2 +013500 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1194.2 +013600 01 SUBTRACT-DATA SIGN IS LEADING SEPARATE DISPLAY. NC1194.2 +013700 02 SUBTR-1 PICTURE 9 VALUE 1. NC1194.2 +013800 02 SUBTR-2 PICTURE S99 VALUE 99. NC1194.2 +013900 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1194.2 +014000 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1194.2 +014100 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1194.2 +014200 02 SUBTR-6 PICTURE 9 VALUE 1. NC1194.2 +014300 02 SUBTR-7 PICTURE S99 VALUE 99. NC1194.2 +014400 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1194.2 +014500 02 SUBTR-10 PICTURE S999 VALUE 100. NC1194.2 +014600 02 SUBTR-11 PICTURE S999V999. NC1194.2 +014700 01 N-3 PICTURE IS 99999. NC1194.2 +014800 01 N-4 PICTURE IS 9(5) NC1194.2 +014900 VALUE IS 52800. NC1194.2 +015000 01 N-5 PICTURE IS S9(9)V99 NC1194.2 +015100 SIGN IS LEADING SEPARATE NC1194.2 +015200 VALUE IS 000000001.00. NC1194.2 +015300 01 N-7 PICTURE IS S9(7)V9(4) NC1194.2 +015400 SIGN IS LEADING SEPARATE CHARACTER NC1194.2 +015500 VALUE IS 0000001.0000. NC1194.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1194.2 +015700 01 N-10 PICTURE IS S99999V NC1194.2 +015800 VALUE IS -00001. NC1194.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1194.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1194.2 +016100 01 N-13 PICTURE IS 9(5) NC1194.2 +016200 VALUE IS 99999. NC1194.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1194.2 +016400 01 N-15 PICTURE IS 9(16). NC1194.2 +016500 01 N-16 PICTURE IS S999999V99 NC1194.2 +016600 VALUE IS 5.90. NC1194.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1194.2 +016800 VALUE IS +3.6. NC1194.2 +016900 01 N-18 PICTURE IS S9(10) NC1194.2 +017000 VALUE IS -5. NC1194.2 +017100 01 N-19 PICTURE IS $9.00. NC1194.2 +017200 01 N-20 PICTURE IS S9(9) NC1194.2 +017300 VALUE IS -999999999. NC1194.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1194.2 +017500 01 N-22 PICTURE IS 999V99 NC1194.2 +017600 VALUE IS 005.55. NC1194.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1194.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1194.2 +017900 01 N-26 PICTURE 9(5). NC1194.2 +018000 01 N-27 PICTURE IS 9999V9 NC1194.2 +018100 VALUE IS 9999.9. NC1194.2 +018200 01 N-28 PICTURE IS $9999.00. NC1194.2 +018300 01 N-40 PICTURE IS 9(7) NC1194.2 +018400 VALUE IS 7777777. NC1194.2 +018500 01 N-41 PICTURE IS 9(7) NC1194.2 +018600 VALUE IS 1111111. NC1194.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1194.2 +018800 01 TRUNC-DATA. NC1194.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1194.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1194.2 +019100 02 N-45 PICTURE S9. NC1194.2 +019200 01 MINUS-NAMES SIGN IS LEADING SEPARATE CHARACTER. NC1194.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1194.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1194.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1194.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1194.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1194.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1194.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1194.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1194.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1194.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1194.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1194.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1194.2 +020500 01 TEST-RESULTS. NC1194.2 +020600 02 FILLER PIC X VALUE SPACE. NC1194.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1194.2 +020800 02 FILLER PIC X VALUE SPACE. NC1194.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1194.2 +021000 02 FILLER PIC X VALUE SPACE. NC1194.2 +021100 02 PAR-NAME. NC1194.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1194.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1194.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1194.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1194.2 +021600 02 RE-MARK PIC X(61). NC1194.2 +021700 01 TEST-COMPUTED. NC1194.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1194.2 +021900 02 FILLER PIC X(17) VALUE NC1194.2 +022000 " COMPUTED=". NC1194.2 +022100 02 COMPUTED-X. NC1194.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1194.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1194.2 +022400 PIC -9(9).9(9). NC1194.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1194.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1194.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1194.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1194.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1194.2 +023000 04 FILLER PIC X. NC1194.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1194.2 +023200 01 TEST-CORRECT. NC1194.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1194.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1194.2 +023500 02 CORRECT-X. NC1194.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1194.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1194.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1194.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1194.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1194.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1194.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1194.2 +024300 04 FILLER PIC X. NC1194.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1194.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1194.2 +024600 01 CCVS-C-1. NC1194.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1194.2 +024800- "SS PARAGRAPH-NAME NC1194.2 +024900- " REMARKS". NC1194.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1194.2 +025100 01 CCVS-C-2. NC1194.2 +025200 02 FILLER PIC X VALUE SPACE. NC1194.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1194.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1194.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1194.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1194.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1194.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1194.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1194.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1194.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1194.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1194.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1194.2 +026800 01 CCVS-H-1. NC1194.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1194.2 +027000 02 FILLER PIC X(42) VALUE NC1194.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1194.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1194.2 +027300 01 CCVS-H-2A. NC1194.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1194.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1194.2 +027600 02 FILLER PIC XXXX VALUE NC1194.2 +027700 "4.2 ". NC1194.2 +027800 02 FILLER PIC X(28) VALUE NC1194.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1194.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1194.2 +028100 NC1194.2 +028200 01 CCVS-H-2B. NC1194.2 +028300 02 FILLER PIC X(15) VALUE NC1194.2 +028400 "TEST RESULT OF ". NC1194.2 +028500 02 TEST-ID PIC X(9). NC1194.2 +028600 02 FILLER PIC X(4) VALUE NC1194.2 +028700 " IN ". NC1194.2 +028800 02 FILLER PIC X(12) VALUE NC1194.2 +028900 " HIGH ". NC1194.2 +029000 02 FILLER PIC X(22) VALUE NC1194.2 +029100 " LEVEL VALIDATION FOR ". NC1194.2 +029200 02 FILLER PIC X(58) VALUE NC1194.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +029400 01 CCVS-H-3. NC1194.2 +029500 02 FILLER PIC X(34) VALUE NC1194.2 +029600 " FOR OFFICIAL USE ONLY ". NC1194.2 +029700 02 FILLER PIC X(58) VALUE NC1194.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1194.2 +029900 02 FILLER PIC X(28) VALUE NC1194.2 +030000 " COPYRIGHT 1985 ". NC1194.2 +030100 01 CCVS-E-1. NC1194.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1194.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1194.2 +030400 02 ID-AGAIN PIC X(9). NC1194.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1194.2 +030600 01 CCVS-E-2. NC1194.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1194.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1194.2 +030900 02 CCVS-E-2-2. NC1194.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1194.2 +031100 03 FILLER PIC X VALUE SPACE. NC1194.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1194.2 +031300 "ERRORS ENCOUNTERED". NC1194.2 +031400 01 CCVS-E-3. NC1194.2 +031500 02 FILLER PIC X(22) VALUE NC1194.2 +031600 " FOR OFFICIAL USE ONLY". NC1194.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1194.2 +031800 02 FILLER PIC X(58) VALUE NC1194.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1194.2 +032100 02 FILLER PIC X(15) VALUE NC1194.2 +032200 " COPYRIGHT 1985". NC1194.2 +032300 01 CCVS-E-4. NC1194.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1194.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1194.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1194.2 +032700 02 FILLER PIC X(40) VALUE NC1194.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1194.2 +032900 01 XXINFO. NC1194.2 +033000 02 FILLER PIC X(19) VALUE NC1194.2 +033100 "*** INFORMATION ***". NC1194.2 +033200 02 INFO-TEXT. NC1194.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1194.2 +033400 04 XXCOMPUTED PIC X(20). NC1194.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1194.2 +033600 04 XXCORRECT PIC X(20). NC1194.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1194.2 +033800 01 HYPHEN-LINE. NC1194.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1194.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1194.2 +034100- "*****************************************". NC1194.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1194.2 +034300- "******************************". NC1194.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1194.2 +034500 "NC119A". NC1194.2 +034600 PROCEDURE DIVISION. NC1194.2 +034700 CCVS1 SECTION. NC1194.2 +034800 OPEN-FILES. NC1194.2 +034900 OPEN OUTPUT PRINT-FILE. NC1194.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1194.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1194.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1194.2 +035300 GO TO CCVS1-EXIT. NC1194.2 +035400 CLOSE-FILES. NC1194.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1194.2 +035600 TERMINATE-CCVS. NC1194.2 +035700S EXIT PROGRAM. NC1194.2 +035800STERMINATE-CALL. NC1194.2 +035900 STOP RUN. NC1194.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1194.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1194.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1194.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1194.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1194.2 +036500 PRINT-DETAIL. NC1194.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1194.2 +036700 MOVE "." TO PARDOT-X NC1194.2 +036800 MOVE REC-CT TO DOTVALUE. NC1194.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1194.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1194.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1194.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1194.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1194.2 +037400 MOVE SPACE TO CORRECT-X. NC1194.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1194.2 +037600 MOVE SPACE TO RE-MARK. NC1194.2 +037700 HEAD-ROUTINE. NC1194.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1194.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1194.2 +038200 COLUMN-NAMES-ROUTINE. NC1194.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +038600 END-ROUTINE. NC1194.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1194.2 +038800 END-RTN-EXIT. NC1194.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +039000 END-ROUTINE-1. NC1194.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1194.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1194.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1194.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1194.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1194.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1194.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1194.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1194.2 +039900 END-ROUTINE-12. NC1194.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1194.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1194.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1194.2 +040300 ELSE NC1194.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1194.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1194.2 +040600 PERFORM WRITE-LINE. NC1194.2 +040700 END-ROUTINE-13. NC1194.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1194.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1194.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1194.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1194.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1194.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1194.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1194.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1194.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041900 WRITE-LINE. NC1194.2 +042000 ADD 1 TO RECORD-COUNT. NC1194.2 +042100Y IF RECORD-COUNT GREATER 42 NC1194.2 +042200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1194.2 +042300Y MOVE SPACE TO DUMMY-RECORD NC1194.2 +042400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1194.2 +042500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1194.2 +042600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1194.2 +042700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1194.2 +042800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1194.2 +042900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1194.2 +043300Y MOVE ZERO TO RECORD-COUNT. NC1194.2 +043400 PERFORM WRT-LN. NC1194.2 +043500 WRT-LN. NC1194.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1194.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1194.2 +043800 BLANK-LINE-PRINT. NC1194.2 +043900 PERFORM WRT-LN. NC1194.2 +044000 FAIL-ROUTINE. NC1194.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1194.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1194.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1194.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1194.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1194.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1194.2 +044800 GO TO FAIL-ROUTINE-EX. NC1194.2 +044900 FAIL-ROUTINE-WRITE. NC1194.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1194.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1194.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1194.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1194.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1194.2 +045500 BAIL-OUT. NC1194.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1194.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1194.2 +045800 BAIL-OUT-WRITE. NC1194.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1194.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1194.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1194.2 +046300 BAIL-OUT-EX. EXIT. NC1194.2 +046400 CCVS1-EXIT. NC1194.2 +046500 EXIT. NC1194.2 +046600 SECT-NC119A-001 SECTION. NC1194.2 +046700 SUB-INIT-GF-1. NC1194.2 +046800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +046900 PERFORM END-ROUTINE. NC1194.2 +047000 MOVE "SUBTRACT" TO FEATURE. NC1194.2 +047100 MOVE 1 TO N-5. NC1194.2 +047200 SUB-TEST-GF-1-0. NC1194.2 +047300 SUBTRACT 1 FROM N-5. NC1194.2 +047400 SUB-TEST-GF-1-1. NC1194.2 +047500 IF N-5 EQUAL TO 0 NC1194.2 +047600 PERFORM PASS NC1194.2 +047700 GO TO SUB-WRITE-GF-1. NC1194.2 +047800 GO TO SUB-FAIL-GF-1. NC1194.2 +047900 SUB-DELETE-GF-1. NC1194.2 +048000 PERFORM DE-LETE. NC1194.2 +048100 GO TO SUB-WRITE-GF-1. NC1194.2 +048200 SUB-FAIL-GF-1. NC1194.2 +048300 MOVE N-5 TO COMPUTED-N. NC1194.2 +048400 MOVE 0 TO CORRECT-N. NC1194.2 +048500 PERFORM FAIL. NC1194.2 +048600 SUB-WRITE-GF-1. NC1194.2 +048700 MOVE "SUB-TEST-GF-1 " TO PAR-NAME. NC1194.2 +048800 PERFORM PRINT-DETAIL. NC1194.2 +048900 SUB-INIT-GF-2. NC1194.2 +049000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +049100 MOVE A18TWOS-DS-LS-18V00 TO WRK-DS-T-18V00. NC1194.2 +049200 SUB-TEST-GF-2-0. NC1194.2 +049300 SUBTRACT A18ONES-DS-TS-18V00 FROM WRK-DS-T-18V00. NC1194.2 +049400 SUB-TEST-GF-2-1. NC1194.2 +049500 IF WRK-DS-T-18V00 EQUAL TO 111111111111111111 NC1194.2 +049600 PERFORM PASS GO TO SUB-WRITE-GF-2. NC1194.2 +049700 GO TO SUB-FAIL-GF-2. NC1194.2 +049800 SUB-DELETE-GF-2. NC1194.2 +049900 PERFORM DE-LETE. NC1194.2 +050000 GO TO SUB-WRITE-GF-2. NC1194.2 +050100 SUB-FAIL-GF-2. NC1194.2 +050200 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1194.2 +050300 MOVE 111111111111111111 TO CORRECT-18V0. NC1194.2 +050400 PERFORM FAIL. NC1194.2 +050500 SUB-WRITE-GF-2. NC1194.2 +050600 MOVE "SUB-TEST-GF-2" TO PAR-NAME. NC1194.2 +050700 PERFORM PRINT-DETAIL. NC1194.2 +050800 SUB-INIT-GF-3. NC1194.2 +050900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +051000 MOVE A12THREES-DS-06V06 TO WRK-DS-TS-06V06. NC1194.2 +051100 SUB-TEST-GF-3-0. NC1194.2 +051200 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +051300 A05ONES-DS-LS-00V05 NC1194.2 +051400 A06ONES-DS-TS-03V03 FROM WRK-DS-TS-06V06. NC1194.2 +051500 SUB-TEST-GF-3-1. NC1194.2 +051600 IF WRK-DS-TS-06V06 EQUAL TO 322111.111223 NC1194.2 +051700 PERFORM PASS GO TO SUB-WRITE-GF-3. NC1194.2 +051800 GO TO SUB-FAIL-GF-3. NC1194.2 +051900 SUB-DELETE-GF-3. NC1194.2 +052000 PERFORM DE-LETE. NC1194.2 +052100 GO TO SUB-WRITE-GF-3. NC1194.2 +052200 SUB-FAIL-GF-3. NC1194.2 +052300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +052400 MOVE 322111.111223 TO CORRECT-N. NC1194.2 +052500 PERFORM FAIL. NC1194.2 +052600 SUB-WRITE-GF-3. NC1194.2 +052700 MOVE "SUB-TEST-GF-3" TO PAR-NAME. NC1194.2 +052800 PERFORM PRINT-DETAIL. NC1194.2 +052900 SUB-INIT-GF-13. NC1194.2 +053000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +053100 MOVE " GIVING" TO FEATURE. NC1194.2 +053200 MOVE ZERO TO WRK-DS-09V09. NC1194.2 +053300 SUB-TEST-GF-13-0. NC1194.2 +053400 SUBTRACT A06THREES-DS-03V03 FROM A12THREES-DS-06V06 NC1194.2 +053500 GIVING WRK-DS-TS-06V06. NC1194.2 +053600 SUB-TEST-GF-13-1. NC1194.2 +053700 IF WRK-DS-TS-06V06 EQUAL TO 333000.000333 NC1194.2 +053800 PERFORM PASS GO TO SUB-WRITE-GF-13. NC1194.2 +053900 GO TO SUB-FAIL-GF-13. NC1194.2 +054000 SUB-DELETE-GF-13. NC1194.2 +054100 PERFORM DE-LETE. NC1194.2 +054200 GO TO SUB-WRITE-GF-13. NC1194.2 +054300 SUB-FAIL-GF-13. NC1194.2 +054400 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +054500 MOVE 333000.000333 TO CORRECT-N. NC1194.2 +054600 PERFORM FAIL. NC1194.2 +054700 SUB-WRITE-GF-13. NC1194.2 +054800 MOVE "SUB-TEST-GF-13" TO PAR-NAME. NC1194.2 +054900 PERFORM PRINT-DETAIL. NC1194.2 +055000 SUB-INIT-GF-14. NC1194.2 +055100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +055200 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +055300 SUB-TEST-GF-14. NC1194.2 +055400 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +055500 A05ONES-DS-LS-00V05 NC1194.2 +055600 A12THREES-DS-06V06 NC1194.2 +055700 A06THREES-DS-03V03 FROM ZERO GIVING WRK-DS-TS-06V06.NC1194.2 +055800 IF WRK-DS-TS-06V06 EQUAL TO -344777.777443 NC1194.2 +055900 PERFORM PASS GO TO SUB-WRITE-GF-14. NC1194.2 +056000 GO TO SUB-FAIL-GF-14. NC1194.2 +056100 SUB-DELETE-GF-14. NC1194.2 +056200 PERFORM DE-LETE. NC1194.2 +056300 GO TO SUB-WRITE-GF-14. NC1194.2 +056400 SUB-FAIL-GF-14. NC1194.2 +056500 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +056600 MOVE -344777.777443 TO CORRECT-N. NC1194.2 +056700 PERFORM FAIL. NC1194.2 +056800 SUB-WRITE-GF-14. NC1194.2 +056900 MOVE "SUB-TEST-GF-14" TO PAR-NAME. NC1194.2 +057000 PERFORM PRINT-DETAIL. NC1194.2 +057100 SUB-INIT-GF-4. NC1194.2 +057200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +057300 MOVE " ROUNDED" TO FEATURE. NC1194.2 +057400 MOVE ZERO TO WRK-DS-TS-0201P. NC1194.2 +057500 SUB-TEST-GF-4-0. NC1194.2 +057600 SUBTRACT A99-DS-T-02V00 FROM WRK-DS-TS-0201P ROUNDED. NC1194.2 +057700 SUB-TEST-GF-4-1. NC1194.2 +057800 IF WRK-DS-TS-0201P EQUAL TO -100 NC1194.2 +057900 PERFORM PASS GO TO SUB-WRITE-GF-4. NC1194.2 +058000 GO TO SUB-FAIL-GF-4. NC1194.2 +058100 SUB-DELETE-GF-4. NC1194.2 +058200 PERFORM DE-LETE. NC1194.2 +058300 GO TO SUB-WRITE-GF-4. NC1194.2 +058400 SUB-FAIL-GF-4. NC1194.2 +058500 MOVE WRK-DS-TS-0201P TO COMPUTED-N. NC1194.2 +058600 MOVE -100 TO CORRECT-N. NC1194.2 +058700 PERFORM FAIL. NC1194.2 +058800 SUB-WRITE-GF-4. NC1194.2 +058900 MOVE "SUB-TEST-GF-4" TO PAR-NAME. NC1194.2 +059000 PERFORM PRINT-DETAIL. NC1194.2 +059100 SUB-INIT-GF-15. NC1194.2 +059200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +059300 MOVE -099999.999999 TO WRK-DS-TS-06V06. NC1194.2 +059400 MOVE ZERO TO WRK-DS-06V00. NC1194.2 +059500 SUB-TEST-GF-15-0. NC1194.2 +059600 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +059700 -11111 NC1194.2 +059800 AZERO-DS-LS-05V05 FROM WRK-DS-TS-06V06 NC1194.2 +059900 GIVING WRK-DS-06V00 ROUNDED. NC1194.2 +060000 SUB-TEST-GF-15-1. NC1194.2 +060100 IF WRK-DS-06V00 EQUAL TO -100000 NC1194.2 +060200 PERFORM PASS GO TO SUB-WRITE-GF-15. NC1194.2 +060300 GO TO SUB-FAIL-GF-15. NC1194.2 +060400 SUB-DELETE-GF-15. NC1194.2 +060500 PERFORM DE-LETE. NC1194.2 +060600 GO TO SUB-WRITE-GF-15. NC1194.2 +060700 SUB-FAIL-GF-15. NC1194.2 +060800 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1194.2 +060900 MOVE -100000 TO CORRECT-N. NC1194.2 +061000 PERFORM FAIL. NC1194.2 +061100 SUB-WRITE-GF-15. NC1194.2 +061200 MOVE "SUB-TEST-GF-15" TO PAR-NAME. NC1194.2 +061300 PERFORM PRINT-DETAIL. NC1194.2 +061400 SUB-INIT-GF-5-1. NC1194.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +061600 MOVE " SIZE ERROR" TO FEATURE. NC1194.2 +061700 MOVE -11 TO WRK-DS-02V00. NC1194.2 +061800 SUB-TEST-GF-5-1-0. NC1194.2 +061900 SUBTRACT A99-DS-T-02V00 FROM WRK-DS-02V00 ON SIZE ERROR NC1194.2 +062000 PERFORM PASS GO TO SUB-WRITE-GF-5-1. NC1194.2 +062100 GO TO SUB-FAIL-GF-5-1. NC1194.2 +062200 SUB-DELETE-GF-5-1. NC1194.2 +062300 PERFORM DE-LETE. NC1194.2 +062400 GO TO SUB-WRITE-GF-5-1. NC1194.2 +062500 SUB-FAIL-GF-5-1. NC1194.2 +062600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +062700 PERFORM FAIL. NC1194.2 +062800 SUB-WRITE-GF-5-1. NC1194.2 +062900 MOVE "SUB-TEST-GF-5-1" TO PAR-NAME. NC1194.2 +063000 PERFORM PRINT-DETAIL. NC1194.2 +063100 SUB-TEST-GF-5-2. NC1194.2 +063200 IF WRK-DS-02V00 EQUAL TO -11 NC1194.2 +063300 PERFORM PASS GO TO SUB-WRITE-GF-5-2. NC1194.2 +063400* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-5-1 NC1194.2 +063500 GO TO SUB-FAIL-GF-5-2. NC1194.2 +063600 SUB-DELETE-GF-5-2. NC1194.2 +063700 PERFORM DE-LETE. NC1194.2 +063800 GO TO SUB-WRITE-GF-5-2. NC1194.2 +063900 SUB-FAIL-GF-5-2. NC1194.2 +064000 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1194.2 +064100 MOVE -11 TO CORRECT-N. NC1194.2 +064200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +064300 PERFORM FAIL. NC1194.2 +064400 SUB-WRITE-GF-5-2. NC1194.2 +064500 MOVE "SUB-TEST-GF-5-2" TO PAR-NAME. NC1194.2 +064600 PERFORM PRINT-DETAIL. NC1194.2 +064700 SUB-INIT-GF-16-1. NC1194.2 +064800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +064900 MOVE ZERO TO WRK-DS-10V00. NC1194.2 +065000 SUB-TEST-GF-16-1-0. NC1194.2 +065100 SUBTRACT A12ONES-DS-L-12V00 NC1194.2 +065200 FROM ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1194.2 +065300 PERFORM PASS GO TO SUB-WRITE-GF-16-1. NC1194.2 +065400 GO TO SUB-FAIL-GF-16-1. NC1194.2 +065500 SUB-DELETE-GF-16-1. NC1194.2 +065600 PERFORM DE-LETE. NC1194.2 +065700 GO TO SUB-WRITE-GF-16-1. NC1194.2 +065800 SUB-FAIL-GF-16-1. NC1194.2 +065900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +066000 PERFORM FAIL. NC1194.2 +066100 SUB-WRITE-GF-16-1. NC1194.2 +066200 MOVE "SUB-TEST-GF-16-1" TO PAR-NAME. NC1194.2 +066300 PERFORM PRINT-DETAIL. NC1194.2 +066400 SUB-TEST-GF-16-2. NC1194.2 +066500 IF WRK-DS-10V00 EQUAL TO ZERO NC1194.2 +066600 PERFORM PASS GO TO SUB-WRITE-GF-16-2. NC1194.2 +066700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-GF-16-1 NC1194.2 +066800 GO TO SUB-FAIL-GF-16-2. NC1194.2 +066900 SUB-DELETE-GF-16-2. NC1194.2 +067000 PERFORM DE-LETE. NC1194.2 +067100 GO TO SUB-WRITE-GF-16-2. NC1194.2 +067200 SUB-FAIL-GF-16-2. NC1194.2 +067300 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1194.2 +067400 MOVE ZERO TO CORRECT-14V4. NC1194.2 +067500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +067600 PERFORM FAIL. NC1194.2 +067700 SUB-WRITE-GF-16-2. NC1194.2 +067800 MOVE "SUB-TEST-GF-16-2" TO PAR-NAME. NC1194.2 +067900 PERFORM PRINT-DETAIL. NC1194.2 +068000 SUB-INIT-GF-17-1. NC1194.2 +068100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +068200 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1194.2 +068300 MOVE ZERO TO WRK-DS-T-05V00. NC1194.2 +068400 SUB-TEST-GF-17-1-0. NC1194.2 +068500 SUBTRACT 33333 NC1194.2 +068600 A06THREES-DS-03V03 NC1194.2 +068700 A12THREES-DS-06V06 NC1194.2 +068800 FROM WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1194.2 +068900 PERFORM PASS GO TO SUB-WRITE-GF-17-1. NC1194.2 +069000 GO TO SUB-FAIL-GF-17-1. NC1194.2 +069100 SUB-DELETE-GF-17-1. NC1194.2 +069200 PERFORM DE-LETE. NC1194.2 +069300 GO TO SUB-WRITE-GF-17-1. NC1194.2 +069400 SUB-FAIL-GF-17-1. NC1194.2 +069500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +069600 PERFORM FAIL. NC1194.2 +069700 SUB-WRITE-GF-17-1. NC1194.2 +069800 MOVE "SUB-TEST-GF-17-1" TO PAR-NAME. NC1194.2 +069900 PERFORM PRINT-DETAIL. NC1194.2 +070000 SUB-TEST-GF-17-2. NC1194.2 +070100 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1194.2 +070200 PERFORM PASS GO TO SUB-WRITE-GF-17-2. NC1194.2 +070300* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-17-1 NC1194.2 +070400 GO TO SUB-FAIL-GF-17-2. NC1194.2 +070500 SUB-DELETE-GF-17-2. NC1194.2 +070600 PERFORM DE-LETE. NC1194.2 +070700 GO TO SUB-WRITE-GF-17-2. NC1194.2 +070800 SUB-FAIL-GF-17-2. NC1194.2 +070900 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1194.2 +071000 MOVE ZERO TO CORRECT-N. NC1194.2 +071100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +071200 PERFORM FAIL. NC1194.2 +071300 SUB-WRITE-GF-17-2. NC1194.2 +071400 MOVE "SUB-TEST-GF-17-2" TO PAR-NAME. NC1194.2 +071500 PERFORM PRINT-DETAIL. NC1194.2 +071600 SUB-INIT-GF-6-1. NC1194.2 +071700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +071800 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +071900 SUB-TEST-GF-6-1. NC1194.2 +072000 SUBTRACT A12THREES-DS-06V06 NC1194.2 +072100 333333 NC1194.2 +072200 A06THREES-DS-03V03 NC1194.2 +072300 -0000009 NC1194.2 +072400 FROM WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1194.2 +072500 GO TO SUB-FAIL-GF-6-1. NC1194.2 +072600 PERFORM PASS. NC1194.2 +072700 GO TO SUB-WRITE-GF-6-1. NC1194.2 +072800 SUB-DELETE-GF-6-1. NC1194.2 +072900 PERFORM DE-LETE. NC1194.2 +073000 GO TO SUB-WRITE-GF-6-1. NC1194.2 +073100 SUB-FAIL-GF-6-1. NC1194.2 +073200 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1194.2 +073300 PERFORM FAIL. NC1194.2 +073400 SUB-WRITE-GF-6-1. NC1194.2 +073500 MOVE "SUB-TEST-GF-6-1" TO PAR-NAME. NC1194.2 +073600 PERFORM PRINT-DETAIL. NC1194.2 +073700 SUB-TEST-GF-6-2. NC1194.2 +073800 IF WRK-DS-TS-06V06 EQUAL TO -666990.666333 NC1194.2 +073900 PERFORM PASS GO TO SUB-WRITE-GF-6-2. NC1194.2 +074000* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-6-1 NC1194.2 +074100 GO TO SUB-FAIL-GF-6-2. NC1194.2 +074200 SUB-DELETE-GF-6-2. NC1194.2 +074300 PERFORM DE-LETE. NC1194.2 +074400 GO TO SUB-WRITE-GF-6-2. NC1194.2 +074500 SUB-FAIL-GF-6-2. NC1194.2 +074600 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +074700 MOVE -666990.666333 TO CORRECT-N. NC1194.2 +074800 PERFORM FAIL. NC1194.2 +074900 SUB-WRITE-GF-6-2. NC1194.2 +075000 MOVE "SUB-TEST-GF-6-2" TO PAR-NAME. NC1194.2 +075100 PERFORM PRINT-DETAIL. NC1194.2 +075200 SUB-INIT-GF-18-1. NC1194.2 +075300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +075400 MOVE ZERO TO WRK-DS-T-05V00. NC1194.2 +075500 SUB-TEST-GF-18-1. NC1194.2 +075600 SUBTRACT 33333 NC1194.2 +075700 A06THREES-DS-03V03 NC1194.2 +075800 A12THREES-DS-06V06 NC1194.2 +075900 FROM -1000000 GIVING WRK-DS-T-05V00 NC1194.2 +076000 ROUNDED ON SIZE ERROR NC1194.2 +076100 PERFORM PASS GO TO SUB-WRITE-GF-18-1. NC1194.2 +076200 GO TO SUB-FAIL-GF-18-1. NC1194.2 +076300 SUB-DELETE-GF-18-1. NC1194.2 +076400 PERFORM DE-LETE. NC1194.2 +076500 GO TO SUB-WRITE-GF-18-1. NC1194.2 +076600 SUB-FAIL-GF-18-1. NC1194.2 +076700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +076800 PERFORM FAIL. NC1194.2 +076900 SUB-WRITE-GF-18-1. NC1194.2 +077000 MOVE "SUB-TEST-GF-18-1" TO PAR-NAME. NC1194.2 +077100 PERFORM PRINT-DETAIL. NC1194.2 +077200 SUB-TEST-GF-18-2. NC1194.2 +077300 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1194.2 +077400 PERFORM PASS GO TO SUB-WRITE-GF-18-2. NC1194.2 +077500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-18-1 NC1194.2 +077600 GO TO SUB-FAIL-GF-18-2. NC1194.2 +077700 SUB-DELETE-GF-18-2. NC1194.2 +077800 PERFORM DE-LETE. NC1194.2 +077900 GO TO SUB-WRITE-GF-18-2. NC1194.2 +078000 SUB-FAIL-GF-18-2. NC1194.2 +078100 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1194.2 +078200 MOVE ZERO TO CORRECT-N. NC1194.2 +078300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +078400 PERFORM FAIL. NC1194.2 +078500 SUB-WRITE-GF-18-2. NC1194.2 +078600 MOVE "SUB-TEST-GF-18-2" TO PAR-NAME. NC1194.2 +078700 PERFORM PRINT-DETAIL. NC1194.2 +078800 SUB-INIT-GF-19-1. NC1194.2 +078900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +079000 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +079100 SUB-TEST-GF-19-1. NC1194.2 +079200 SUBTRACT A12THREES-DS-06V06 NC1194.2 +079300 333333 NC1194.2 +079400 A06THREES-DS-03V03 NC1194.2 +079500 -.0000009 FROM 0000000 NC1194.2 +079600 GIVING WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1194.2 +079700 GO TO SUB-FAIL-GF-19-1. NC1194.2 +079800 PERFORM PASS. NC1194.2 +079900 GO TO SUB-WRITE-GF-19-1. NC1194.2 +080000 SUB-DELETE-GF-19-1. NC1194.2 +080100 PERFORM DE-LETE. NC1194.2 +080200 GO TO SUB-WRITE-GF-19-1. NC1194.2 +080300 SUB-FAIL-GF-19-1. NC1194.2 +080400 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1194.2 +080500 PERFORM FAIL. NC1194.2 +080600 SUB-WRITE-GF-19-1. NC1194.2 +080700 MOVE "SUB-TEST-GF-19-1" TO PAR-NAME. NC1194.2 +080800 PERFORM PRINT-DETAIL. NC1194.2 +080900 SUB-TEST-GF-19-2. NC1194.2 +081000 IF WRK-DS-TS-06V06 EQUAL TO -666999.666332 NC1194.2 +081100 PERFORM PASS GO TO SUB-WRITE-GF-19-2. NC1194.2 +081200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-19-1 NC1194.2 +081300 GO TO SUB-FAIL-GF-19-2. NC1194.2 +081400 SUB-DELETE-GF-19-2. NC1194.2 +081500 PERFORM DE-LETE. NC1194.2 +081600 GO TO SUB-WRITE-GF-19-2. NC1194.2 +081700 SUB-FAIL-GF-19-2. NC1194.2 +081800 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +081900 MOVE -666999.666332 TO CORRECT-N. NC1194.2 +082000 PERFORM FAIL. NC1194.2 +082100 SUB-WRITE-GF-19-2. NC1194.2 +082200 MOVE "SUB-TEST-GF-19-2" TO PAR-NAME. NC1194.2 +082300 PERFORM PRINT-DETAIL. NC1194.2 +082400 SUB-INIT-GF-20. NC1194.2 +082500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +082600 MOVE " SERIES" TO FEATURE. NC1194.2 +082700 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +082800 SUB-TEST-GF-20. NC1194.2 +082900 SUBTRACT A99-DS-T-02V00 NC1194.2 +083000 A03ONES-DS-02V01 NC1194.2 +083100 A06ONES-DS-TS-03V03 NC1194.2 +083200 A08TWOS-DS-02V06 NC1194.2 +083300 -1.1111111 NC1194.2 +083400 +.11111111 NC1194.2 +083500 A01ONES-DS-LS-P0801 FROM 0000.000000 NC1194.2 +083600 GIVING WRK-DS-03V10. NC1194.2 +083700 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +083800 PERFORM PASS GO TO SUB-WRITE-GF-20. NC1194.2 +083900 GO TO SUB-FAIL-GF-20. NC1194.2 +084000 SUB-DELETE-GF-20. NC1194.2 +084100 PERFORM DE-LETE. NC1194.2 +084200 GO TO SUB-WRITE-GF-20. NC1194.2 +084300 SUB-FAIL-GF-20. NC1194.2 +084400 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +084500 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +084600 PERFORM FAIL. NC1194.2 +084700 SUB-WRITE-GF-20. NC1194.2 +084800 MOVE "SUB-TEST-GF-20" TO PAR-NAME. NC1194.2 +084900 PERFORM PRINT-DETAIL. NC1194.2 +085000 SUB-INIT-GF-21. NC1194.2 +085100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +085200 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +085300 SUB-TEST-GF-21-0. NC1194.2 +085400 SUBTRACT A01ONES-DS-LS-P0801 NC1194.2 +085500 +.11111111 NC1194.2 +085600 -1.1111111 NC1194.2 +085700 A08TWOS-DS-02V06 NC1194.2 +085800 A06ONES-DS-TS-03V03 NC1194.2 +085900 A03ONES-DS-02V01 NC1194.2 +086000 A99-DS-T-02V00 FROM 0000.000000 GIVING WRK-DS-03V10.NC1194.2 +086100 SUB-TEST-GF-21-1. NC1194.2 +086200 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +086300 PERFORM PASS GO TO SUB-WRITE-GF-21. NC1194.2 +086400 GO TO SUB-FAIL-GF-21. NC1194.2 +086500 SUB-DELETE-GF-21. NC1194.2 +086600 PERFORM DE-LETE. NC1194.2 +086700 GO TO SUB-WRITE-GF-21. NC1194.2 +086800 SUB-FAIL-GF-21. NC1194.2 +086900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +087000 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +087100 PERFORM FAIL. NC1194.2 +087200 SUB-WRITE-GF-21. NC1194.2 +087300 MOVE "SUB-TEST-GF-21" TO PAR-NAME. NC1194.2 +087400 PERFORM PRINT-DETAIL. NC1194.2 +087500 SUB-INIT-GF-22. NC1194.2 +087600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +087700 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +087800 SUB-TEST-GF-22-0. NC1194.2 +087900 SUBTRACT A08TWOS-DS-02V06 NC1194.2 +088000 A99-DS-T-02V00 NC1194.2 +088100 -1.1111111 NC1194.2 +088200 A03ONES-DS-02V01 NC1194.2 +088300 A01ONES-DS-LS-P0801 NC1194.2 +088400 +.11111111 NC1194.2 +088500 A06ONES-DS-TS-03V03 FROM 0000.000000 NC1194.2 +088600 GIVING WRK-DS-03V10. NC1194.2 +088700 SUB-TEST-GF-22-1. NC1194.2 +088800 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +088900 PERFORM PASS GO TO SUB-WRITE-GF-22. NC1194.2 +089000 GO TO SUB-FAIL-GF-22. NC1194.2 +089100 SUB-DELETE-GF-22. NC1194.2 +089200 PERFORM DE-LETE. NC1194.2 +089300 GO TO SUB-WRITE-GF-22. NC1194.2 +089400 SUB-FAIL-GF-22. NC1194.2 +089500 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +089600 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +089700 PERFORM FAIL. NC1194.2 +089800 SUB-WRITE-GF-22. NC1194.2 +089900 MOVE "SUB-TEST-GF-22" TO PAR-NAME. NC1194.2 +090000 PERFORM PRINT-DETAIL. NC1194.2 +090100 SUB-INIT-GF-7. NC1194.2 +090200 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1194.2 +090300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +090400 MOVE ZERO TO WRK-CS-18V00. NC1194.2 +090500 SUB-TEST-GF-7-0. NC1194.2 +090600 SUBTRACT A18ONES-DS-TS-18V00 FROM WRK-CS-18V00. NC1194.2 +090700 SUB-TEST-GF-7-1. NC1194.2 +090800 IF WRK-CS-18V00 EQUAL TO -111111111111111111 NC1194.2 +090900 PERFORM PASS GO TO SUB-WRITE-GF-7. NC1194.2 +091000 GO TO SUB-FAIL-GF-7. NC1194.2 +091100 SUB-DELETE-GF-7. NC1194.2 +091200 PERFORM DE-LETE. NC1194.2 +091300 GO TO SUB-WRITE-GF-7. NC1194.2 +091400 SUB-FAIL-GF-7. NC1194.2 +091500 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1194.2 +091600 MOVE -111111111111111111 TO CORRECT-18V0. NC1194.2 +091700 PERFORM FAIL. NC1194.2 +091800 SUB-WRITE-GF-7. NC1194.2 +091900 MOVE "SUB-TEST-GF-7" TO PAR-NAME. NC1194.2 +092000 PERFORM PRINT-DETAIL. NC1194.2 +092100 SUB-INIT-GF-8. NC1194.2 +092200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +092300 MOVE ZERO TO WRK-DS-T-18V00. NC1194.2 +092400 SUB-TEST-GF-8-0. NC1194.2 +092500 SUBTRACT A18ONES-CS-18V00 FROM WRK-DS-T-18V00. NC1194.2 +092600 SUB-TEST-GF-8-1. NC1194.2 +092700 IF WRK-DS-T-18V00 EQUAL TO -111111111111111111 NC1194.2 +092800 PERFORM PASS GO TO SUB-WRITE-GF-8. NC1194.2 +092900 GO TO SUB-FAIL-GF-8. NC1194.2 +093000 SUB-DELETE-GF-8. NC1194.2 +093100 PERFORM DE-LETE. NC1194.2 +093200 GO TO SUB-WRITE-GF-8. NC1194.2 +093300 SUB-FAIL-GF-8. NC1194.2 +093400 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1194.2 +093500 MOVE -111111111111111111 TO CORRECT-18V0. NC1194.2 +093600 PERFORM FAIL. NC1194.2 +093700 SUB-WRITE-GF-8. NC1194.2 +093800 MOVE "SUB-TEST-GF-8" TO PAR-NAME. NC1194.2 +093900 PERFORM PRINT-DETAIL. NC1194.2 +094000 SUB-INIT-GF-9. NC1194.2 +094100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +094200 MOVE 1 TO SUBTR-1. NC1194.2 +094300 MOVE -1 TO SUBTR-3. NC1194.2 +094400 MOVE 99 TO SUBTR-7. NC1194.2 +094500 SUB-TEST-GF-9-0. NC1194.2 +094600 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-7. NC1194.2 +094700 SUB-TEST-GF-9-1. NC1194.2 +094800 IF SUBTR-7 EQUAL TO 99 NC1194.2 +094900 PERFORM PASS GO TO SUB-WRITE-GF-9. NC1194.2 +095000 GO TO SUB-FAIL-GF-9. NC1194.2 +095100 SUB-DELETE-GF-9. NC1194.2 +095200 PERFORM DE-LETE. NC1194.2 +095300 GO TO SUB-WRITE-GF-9. NC1194.2 +095400 SUB-FAIL-GF-9. NC1194.2 +095500 MOVE SUBTR-7 TO COMPUTED-N. NC1194.2 +095600 MOVE 99 TO CORRECT-N. NC1194.2 +095700 PERFORM FAIL. NC1194.2 +095800 SUB-WRITE-GF-9. NC1194.2 +095900 MOVE "SUB-TEST-GF-9" TO PAR-NAME. NC1194.2 +096000 PERFORM PRINT-DETAIL. NC1194.2 +096100 SUB-INIT-GF-10. NC1194.2 +096200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +096300 MOVE 100 TO SUBTR-5. NC1194.2 +096400 MOVE -1 TO SUBTR-3. NC1194.2 +096500 MOVE 100 TO SUBTR-10. NC1194.2 +096600 SUB-TEST-GF-10-0. NC1194.2 +096700 SUBTRACT SUBTR-5 -98 SUBTR-3 -1 FROM SUBTR-10. NC1194.2 +096800 SUB-TEST-GF-10-1. NC1194.2 +096900 IF SUBTR-10 EQUAL TO 100 NC1194.2 +097000 PERFORM PASS GO TO SUB-WRITE-GF-10. NC1194.2 +097100 GO TO SUB-FAIL-GF-10. NC1194.2 +097200 SUB-DELETE-GF-10. NC1194.2 +097300 PERFORM DE-LETE. NC1194.2 +097400 GO TO SUB-WRITE-GF-10. NC1194.2 +097500 SUB-FAIL-GF-10. NC1194.2 +097600 MOVE SUBTR-10 TO COMPUTED-N. NC1194.2 +097700 MOVE 100 TO CORRECT-N. NC1194.2 +097800 PERFORM FAIL. NC1194.2 +097900 SUB-WRITE-GF-10. NC1194.2 +098000 MOVE "SUB-TEST-GF-10" TO PAR-NAME. NC1194.2 +098100 PERFORM PRINT-DETAIL. NC1194.2 +098200 SUB-INIT-GF-23. NC1194.2 +098300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +098400 MOVE 100 TO SUBTR-5. NC1194.2 +098500 MOVE .001 TO SUBTR-4. NC1194.2 +098600 MOVE 99 TO SUBTR-2. NC1194.2 +098700 MOVE 0 TO SUBTR-11. NC1194.2 +098800 SUB-TEST-GF-23-0. NC1194.2 +098900 SUBTRACT SUBTR-4 SUBTR-5 .499 FROM SUBTR-2 GIVING SUBTR-11. NC1194.2 +099000 SUB-TEST-GF-23-1. NC1194.2 +099100 IF SUBTR-11 EQUAL TO -1.5 NC1194.2 +099200 PERFORM PASS GO TO SUB-WRITE-GF-23. NC1194.2 +099300 GO TO SUB-FAIL-GF-23. NC1194.2 +099400 SUB-DELETE-GF-23. NC1194.2 +099500 PERFORM DE-LETE. NC1194.2 +099600 GO TO SUB-WRITE-GF-23. NC1194.2 +099700 SUB-FAIL-GF-23. NC1194.2 +099800 MOVE SUBTR-11 TO COMPUTED-N. NC1194.2 +099900 MOVE -1.5 TO CORRECT-N. NC1194.2 +100000 PERFORM FAIL. NC1194.2 +100100 SUB-WRITE-GF-23. NC1194.2 +100200 MOVE "SUB-TEST-GF-23" TO PAR-NAME. NC1194.2 +100300 PERFORM PRINT-DETAIL. NC1194.2 +100400 SUB-INIT-GF-11. NC1194.2 +100500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +100600 MOVE 1 TO SUBTR-6. NC1194.2 +100700 MOVE .001 TO SUBTR-4. NC1194.2 +100800 SUB-TEST-GF-11-0. NC1194.2 +100900 SUBTRACT SUBTR-4 FROM SUBTR-6 ROUNDED. NC1194.2 +101000 SUB-TEST-GF-11-1. NC1194.2 +101100 IF SUBTR-6 EQUAL TO 1 NC1194.2 +101200 PERFORM PASS GO TO SUB-WRITE-GF-11. NC1194.2 +101300 GO TO SUB-FAIL-GF-11. NC1194.2 +101400 SUB-DELETE-GF-11. NC1194.2 +101500 PERFORM DE-LETE. NC1194.2 +101600 GO TO SUB-WRITE-GF-11. NC1194.2 +101700 SUB-FAIL-GF-11. NC1194.2 +101800 MOVE SUBTR-6 TO COMPUTED-N. NC1194.2 +101900 MOVE 1 TO CORRECT-N. NC1194.2 +102000 PERFORM FAIL. NC1194.2 +102100 SUB-WRITE-GF-11. NC1194.2 +102200 MOVE "SUB-TEST-GF-11" TO PAR-NAME. NC1194.2 +102300 PERFORM PRINT-DETAIL. NC1194.2 +102400 SUB-INIT-GF-12. NC1194.2 +102500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +102600 MOVE -9.99 TO SUBTR-8. NC1194.2 +102700 SUB-TEST-GF-12-0. NC1194.2 +102800 SUBTRACT .01 FROM SUBTR-8 ON SIZE ERROR NC1194.2 +102900 PERFORM PASS GO TO SUB-WRITE-GF-12-1. NC1194.2 +103000 GO TO SUB-FAIL-GF-12-1. NC1194.2 +103100 SUB-DELETE-GF-12-1. NC1194.2 +103200 PERFORM DE-LETE. NC1194.2 +103300 GO TO SUB-WRITE-GF-12-1. NC1194.2 +103400 SUB-FAIL-GF-12-1. NC1194.2 +103500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +103600 PERFORM FAIL. NC1194.2 +103700 SUB-WRITE-GF-12-1. NC1194.2 +103800 MOVE "SUB-TEST-GF-12-1" TO PAR-NAME. NC1194.2 +103900 PERFORM PRINT-DETAIL. NC1194.2 +104000 SUB-TEST-GF-12-2. NC1194.2 +104100 IF SUBTR-8 EQUAL TO -9.99 NC1194.2 +104200 PERFORM PASS GO TO SUB-WRITE-GF-12-2. NC1194.2 +104300* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-12-1 NC1194.2 +104400 GO TO SUB-FAIL-GF-12-2. NC1194.2 +104500 SUB-DELETE-GF-12-2. NC1194.2 +104600 PERFORM DE-LETE. NC1194.2 +104700 GO TO SUB-WRITE-GF-12-2. NC1194.2 +104800 SUB-FAIL-GF-12-2. NC1194.2 +104900 MOVE SUBTR-8 TO COMPUTED-N. NC1194.2 +105000 MOVE -9.99 TO CORRECT-N. NC1194.2 +105100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +105200 PERFORM FAIL. NC1194.2 +105300 SUB-WRITE-GF-12-2. NC1194.2 +105400 MOVE "SUB-TEST-GF-12-2" TO PAR-NAME. NC1194.2 +105500 PERFORM PRINT-DETAIL. NC1194.2 +105600 SUB-INIT-GF-24. NC1194.2 +105700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +105800 MOVE 1 TO SUBTR-1. NC1194.2 +105900 MOVE -1 TO SUBTR-3. NC1194.2 +106000 MOVE 100 TO SUBTR-5. NC1194.2 +106100 MOVE 99 TO SUBTR-7. NC1194.2 +106200 SUB-TEST-GF-24-1. NC1194.2 +106300 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-5 GIVING SUBTR-7 ON NC1194.2 +106400 SIZE ERROR NC1194.2 +106500 PERFORM PASS GO TO SUB-WRITE-GF-24-1. NC1194.2 +106600 GO TO SUB-FAIL-GF-24-1. NC1194.2 +106700 SUB-DELETE-GF-24-1. NC1194.2 +106800 PERFORM DE-LETE. NC1194.2 +106900 GO TO SUB-WRITE-GF-24-1. NC1194.2 +107000 SUB-FAIL-GF-24-1. NC1194.2 +107100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +107200 PERFORM FAIL. NC1194.2 +107300 SUB-WRITE-GF-24-1. NC1194.2 +107400 MOVE "SUB-TEST-GF-24-1" TO PAR-NAME. NC1194.2 +107500 PERFORM PRINT-DETAIL. NC1194.2 +107600 SUB-TEST-GF-24-2. NC1194.2 +107700 IF SUBTR-7 EQUAL TO 99 NC1194.2 +107800 PERFORM PASS GO TO SUB-WRITE-GF-24-2. NC1194.2 +107900* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-24-1 NC1194.2 +108000 GO TO SUB-FAIL-GF-24-2. NC1194.2 +108100 SUB-DELETE-GF-24-2. NC1194.2 +108200 PERFORM DE-LETE. NC1194.2 +108300 GO TO SUB-WRITE-GF-24-2. NC1194.2 +108400 SUB-FAIL-GF-24-2. NC1194.2 +108500 MOVE SUBTR-7 TO COMPUTED-N. NC1194.2 +108600 MOVE 99 TO CORRECT-N. NC1194.2 +108700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +108800 PERFORM FAIL. NC1194.2 +108900 SUB-WRITE-GF-24-2. NC1194.2 +109000 MOVE "SUB-TEST-GF-24-2" TO PAR-NAME. NC1194.2 +109100 PERFORM PRINT-DETAIL. NC1194.2 +109200 SUB-INIT-GF-25. NC1194.2 +109300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +109400 MOVE -999999999999999999 TO MINUS-NAME1. NC1194.2 +109500 MOVE -999999999999999999 TO MINUS-NAME2. NC1194.2 +109600 MOVE +999999999999999999 TO PLUS-NAME1. NC1194.2 +109700 MOVE +999999999999999999 TO PLUS-NAME1. NC1194.2 +109800 MOVE +1 TO EVEN-NAME1. NC1194.2 +109900 MOVE 0 TO WHOLE-FIELD. NC1194.2 +110000 MOVE SPACE TO SIZE-ERR. NC1194.2 +110100 SUB-TEST-GF-25-0. NC1194.2 +110200 SUBTRACT MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1194.2 +110300 PLUS-NAME2 EVEN-NAME1 35 FROM EVEN-NAME1 GIVING NC1194.2 +110400 WHOLE-FIELD NC1194.2 +110500 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1194.2 +110600 SUB-TEST-GF-25-1. NC1194.2 +110700 IF WHOLE-FIELD EQUAL TO 0 NC1194.2 +110800 PERFORM PASS NC1194.2 +110900 GO TO SUB-WRITE-GF-25-1. NC1194.2 +111000 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1194.2 +111100 MOVE 0 TO CORRECT-18V0. NC1194.2 +111200 PERFORM FAIL. NC1194.2 +111300 GO TO SUB-WRITE-GF-25-1. NC1194.2 +111400 SUB-DELETE-GF-25-1. NC1194.2 +111500 PERFORM DE-LETE. NC1194.2 +111600 SUB-WRITE-GF-25-1. NC1194.2 +111700 MOVE "SUB-TEST-GF-25-1" TO PAR-NAME. NC1194.2 +111800 PERFORM PRINT-DETAIL. NC1194.2 +111900 SUB-TEST-GF-25-2. NC1194.2 +112000 IF SIZE-ERR EQUAL TO "1" NC1194.2 +112100 PERFORM FAIL NC1194.2 +112200 MOVE SPACE TO CORRECT-A NC1194.2 +112300 MOVE 1 TO COMPUTED-A NC1194.2 +112400 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1194.2 +112500 GO TO SUB-WRITE-GF-25-2. NC1194.2 +112600 PERFORM PASS. NC1194.2 +112700 GO TO SUB-WRITE-GF-25-2. NC1194.2 +112800 SUB-DELETE-GF-25-2. NC1194.2 +112900 PERFORM DE-LETE. NC1194.2 +113000 SUB-WRITE-GF-25-2. NC1194.2 +113100 MOVE "SUB-TEST-GF-25-2" TO PAR-NAME. NC1194.2 +113200 PERFORM PRINT-DETAIL. NC1194.2 +113300 SUB-INIT-GF-26. NC1194.2 +113400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +113500 MOVE SPACE TO SIZE-ERR. NC1194.2 +113600 MOVE -.999999999999999999 TO MINUS-NAME3. NC1194.2 +113700 MOVE -.999999999999999999 TO MINUS-NAME4. NC1194.2 +113800 MOVE +.999999999999999999 TO PLUS-NAME3. NC1194.2 +113900 MOVE +.999999999999999999 TO PLUS-NAME4. NC1194.2 +114000 MOVE +1 TO EVEN-NAME2. NC1194.2 +114100 MOVE 0 TO DECMAL-FIELD. NC1194.2 +114200 SUB-TEST-GF-26-0. NC1194.2 +114300 SUBTRACT MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1194.2 +114400 PLUS-NAME4 EVEN-NAME2 .35 FROM EVEN-NAME2 NC1194.2 +114500 GIVING DECMAL-FIELD NC1194.2 +114600 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1194.2 +114700 SUB-TEST-GF-26-1. NC1194.2 +114800 IF DECMAL-FIELD EQUAL TO .0 NC1194.2 +114900 PERFORM PASS NC1194.2 +115000 GO TO SUB-WRITE-GF-26-1. NC1194.2 +115100 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1194.2 +115200 MOVE .0 TO CORRECT-0V18. NC1194.2 +115300 PERFORM FAIL. NC1194.2 +115400 GO TO SUB-WRITE-GF-26-1. NC1194.2 +115500 SUB-DELETE-GF-26-1. NC1194.2 +115600 PERFORM DE-LETE. NC1194.2 +115700 SUB-WRITE-GF-26-1. NC1194.2 +115800 MOVE "SUB-TEST-GF-26-1" TO PAR-NAME. NC1194.2 +115900 PERFORM PRINT-DETAIL. NC1194.2 +116000 SUB-TEST-GF-26-2. NC1194.2 +116100 IF SIZE-ERR EQUAL TO "1" NC1194.2 +116200 PERFORM FAIL NC1194.2 +116300 MOVE SPACE TO CORRECT-A NC1194.2 +116400 MOVE 1 TO COMPUTED-A NC1194.2 +116500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1194.2 +116600 GO TO SUB-WRITE-GF-26-2. NC1194.2 +116700 PERFORM PASS. NC1194.2 +116800 GO TO SUB-WRITE-GF-26-2. NC1194.2 +116900 SUB-DELETE-GF-26-2. NC1194.2 +117000 PERFORM DE-LETE. NC1194.2 +117100 SUB-WRITE-GF-26-2. NC1194.2 +117200 MOVE "SUB-TEST-GF-26-2" TO PAR-NAME. NC1194.2 +117300 PERFORM PRINT-DETAIL. NC1194.2 +117400 CCVS-EXIT SECTION. NC1194.2 +117500 CCVS-999999. NC1194.2 +117600 GO TO CLOSE-FILES. NC1194.2 +*END-OF,NC119A +*HEADER,COBOL,NC120A +000100 IDENTIFICATION DIVISION. NC1204.2 +000200 PROGRAM-ID. NC1204.2 +000300 NC120A. NC1204.2 +000400**************************************************************** NC1204.2 +000500* * NC1204.2 +000600* VALIDATION FOR:- * NC1204.2 +000700* * NC1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +000900* * NC1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1204.2 +001100* * NC1204.2 +001200**************************************************************** NC1204.2 +001300* * NC1204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1204.2 +001500* * NC1204.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1204.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1204.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1204.2 +001900* * NC1204.2 +002000**************************************************************** NC1204.2 +002100* NC1204.2 +002200* PROGRAM NC120A TESTS THE USE OF THE "SIGN" CLAUSE WITH NC1204.2 +002300* FORMATS 1 AND 2 OF THE MULTIPLY STATEMENT. NC1204.2 +002400* ALL COMBINATIONS OF THE SIGN CLAUSE ARE USED WITH NC1204.2 +002500* DATA ITEMS OF VARIOUS LENGTHS. NC1204.2 +002600* NC1204.2 +002700 ENVIRONMENT DIVISION. NC1204.2 +002800 CONFIGURATION SECTION. NC1204.2 +002900 SOURCE-COMPUTER. NC1204.2 +003000 XXXXX082. NC1204.2 +003100 OBJECT-COMPUTER. NC1204.2 +003200 XXXXX083. NC1204.2 +003300 INPUT-OUTPUT SECTION. NC1204.2 +003400 FILE-CONTROL. NC1204.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1204.2 +003600 XXXXX055. NC1204.2 +003700 DATA DIVISION. NC1204.2 +003800 FILE SECTION. NC1204.2 +003900 FD PRINT-FILE. NC1204.2 +004000 01 PRINT-REC PICTURE X(120). NC1204.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1204.2 +004200 WORKING-STORAGE SECTION. NC1204.2 +004300 77 WRK-DS-LS-18V00 PICTURE S9(18) NC1204.2 +004400 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +004500 77 A06THREES-DS-LS-03V03 PICTURE S999V999 VALUE 333.333NC1204.2 +004600 SIGN IS LEADING. NC1204.2 +004700 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1204.2 +004800 SIGN IS TRAILING SEPARATE CHARACTER. NC1204.2 +004900 77 WRK-DS-TS-12V00-S-S REDEFINES WRK-DS-TS-06V06 PICTURE S9(12) NC1204.2 +005000 SIGN TRAILING SEPARATE. NC1204.2 +005100 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1204.2 +005200 77 WRK-DS-10V00 PICTURE S9(10). NC1204.2 +005300 77 WRK-XN-00001 PICTURE X. NC1204.2 +005400 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1204.2 +005500 SIGN IS TRAILING NC1204.2 +005600 VALUE 1111111111. NC1204.2 +005700 77 A12THREES-DS-LS-06V06 PICTURE S9(6)V9(6) NC1204.2 +005800 SIGN IS LEADING SEPARATE NC1204.2 +005900 VALUE 333333.333333. NC1204.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC1204.2 +006100 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) VALUE ZERO NC1204.2 +006200 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +006300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1204.2 +006400 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1204.2 +006500 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) VALUE .11111 NC1204.2 +006600 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +006700 77 A12ONES-DS-12V00 PICTURE S9(12) NC1204.2 +006800 VALUE 111111111111. NC1204.2 +006900 77 A01ONE-DS-TS-P0801 PICTURE SP(8)9 VALUE .000000001NC1204.2 +007000 SIGN IS TRAILING SEPARATE. NC1204.2 +007100 77 WRK-DS-T-09V08 PICTURE S9(9)V9(8) NC1204.2 +007200 SIGN IS TRAILING. NC1204.2 +007300 77 WKR-DS-T-17V00-S REDEFINES WRK-DS-T-09V08 PICTURE S9(17) NC1204.2 +007400 SIGN TRAILING. NC1204.2 +007500 77 A18ONES-DS-18V00 PICTURE S9(18) NC1204.2 +007600 VALUE 111111111111111111. NC1204.2 +007700 77 WRK-DS-LS-0201P PICTURE S99P NC1204.2 +007800 SIGN IS LEADING SEPARATE. NC1204.2 +007900 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1204.2 +008000 77 WRK-DU-18V00 PICTURE 9(18). NC1204.2 +008100 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1204.2 +008200 VALUE 99. NC1204.2 +008300 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1204.2 +008400 VALUE .1. NC1204.2 +008500 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1204.2 +008600 77 WRK-DS-TS-12V00-S PICTURE S9(12). NC1204.2 +008700 77 WRK-DS-LS-01V00 PICTURE S9 LEADING SEPARATE. NC1204.2 +008800 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1204.2 +008900 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1204.2 +009000 VALUE 111111111.111111111. NC1204.2 +009100 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1204.2 +009200 77 WRK-DS-05V00 PICTURE S9(5). NC1204.2 +009300 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1204.2 +009400 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1204.2 +009500 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1204.2 +009600 77 XRAY PICTURE X. NC1204.2 +009700 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1204.2 +009800 VALUE +000000000000000001. NC1204.2 +009900 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1204.2 +010000 VALUE -000000000000000033. NC1204.2 +010100 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010200 VALUE 666666666666666666. NC1204.2 +010300 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010400 VALUE 009999999999999999. NC1204.2 +010500 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010600 VALUE 000022222222222222. NC1204.2 +010700 01 MULTIPLY-DATA LEADING SEPARATE. NC1204.2 +010800 02 MULT1 PICTURE IS 999V99 NC1204.2 +010900 VALUE IS 80.12. NC1204.2 +011000 02 MULT2 PICTURE IS 999V999. NC1204.2 +011100 02 MULT3 PICTURE IS $$99.99. NC1204.2 +011200 02 MULT4 PICTURE IS S99 NC1204.2 +011300 VALUE IS -56. NC1204.2 +011400 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1204.2 +011500 02 MULT6 PICTURE IS 99 VALUE IS NC1204.2 +011600 20. NC1204.2 +011700 01 DIVIDE-DATA TRAILING SEPARATE. NC1204.2 +011800 02 DIV1 PICTURE IS 9(4)V99 NC1204.2 +011900 VALUE IS 1620.36. NC1204.2 +012000 02 DIV2 PICTURE IS 99V9 NC1204.2 +012100 VALUE IS 44.1. NC1204.2 +012200 02 DIV3 PICTURE IS 9(4)V9 NC1204.2 +012300 VALUE IS 1661.7. NC1204.2 +012400 02 DIV4 PICTURE IS S9V999 NC1204.2 +012500 VALUE IS -9.642. NC1204.2 +012600 02 DIV-02LEVEL-1. NC1204.2 +012700 03 DIV5 PICTURE IS V99 NC1204.2 +012800 VALUE IS .82. NC1204.2 +012900 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1204.2 +013000 03 DIV7 PICTURE IS 9V9 NC1204.2 +013100 VALUE IS 9.6. NC1204.2 +013200 01 DIV-DATA-2. NC1204.2 +013300 02 DIV8 PICTURE IS 99V9. NC1204.2 +013400 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1204.2 +013500 02 DIV10 PICTURE IS V999. NC1204.2 +013600 01 TEST-RESULTS. NC1204.2 +013700 02 FILLER PIC X VALUE SPACE. NC1204.2 +013800 02 FEATURE PIC X(20) VALUE SPACE. NC1204.2 +013900 02 FILLER PIC X VALUE SPACE. NC1204.2 +014000 02 P-OR-F PIC X(5) VALUE SPACE. NC1204.2 +014100 02 FILLER PIC X VALUE SPACE. NC1204.2 +014200 02 PAR-NAME. NC1204.2 +014300 03 FILLER PIC X(19) VALUE SPACE. NC1204.2 +014400 03 PARDOT-X PIC X VALUE SPACE. NC1204.2 +014500 03 DOTVALUE PIC 99 VALUE ZERO. NC1204.2 +014600 02 FILLER PIC X(8) VALUE SPACE. NC1204.2 +014700 02 RE-MARK PIC X(61). NC1204.2 +014800 01 TEST-COMPUTED. NC1204.2 +014900 02 FILLER PIC X(30) VALUE SPACE. NC1204.2 +015000 02 FILLER PIC X(17) VALUE NC1204.2 +015100 " COMPUTED=". NC1204.2 +015200 02 COMPUTED-X. NC1204.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1204.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A NC1204.2 +015500 PIC -9(9).9(9). NC1204.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1204.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1204.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1204.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. NC1204.2 +016000 04 COMPUTED-18V0 PIC -9(18). NC1204.2 +016100 04 FILLER PIC X. NC1204.2 +016200 03 FILLER PIC X(50) VALUE SPACE. NC1204.2 +016300 01 TEST-CORRECT. NC1204.2 +016400 02 FILLER PIC X(30) VALUE SPACE. NC1204.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1204.2 +016600 02 CORRECT-X. NC1204.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1204.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1204.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1204.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1204.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1204.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. NC1204.2 +017300 04 CORRECT-18V0 PIC -9(18). NC1204.2 +017400 04 FILLER PIC X. NC1204.2 +017500 03 FILLER PIC X(2) VALUE SPACE. NC1204.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1204.2 +017700 01 CCVS-C-1. NC1204.2 +017800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1204.2 +017900- "SS PARAGRAPH-NAME NC1204.2 +018000- " REMARKS". NC1204.2 +018100 02 FILLER PIC X(20) VALUE SPACE. NC1204.2 +018200 01 CCVS-C-2. NC1204.2 +018300 02 FILLER PIC X VALUE SPACE. NC1204.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". NC1204.2 +018500 02 FILLER PIC X(15) VALUE SPACE. NC1204.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". NC1204.2 +018700 02 FILLER PIC X(94) VALUE SPACE. NC1204.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1204.2 +018900 01 REC-CT PIC 99 VALUE ZERO. NC1204.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1204.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1204.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1204.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1204.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1204.2 +019900 01 CCVS-H-1. NC1204.2 +020000 02 FILLER PIC X(39) VALUE SPACES. NC1204.2 +020100 02 FILLER PIC X(42) VALUE NC1204.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1204.2 +020300 02 FILLER PIC X(39) VALUE SPACES. NC1204.2 +020400 01 CCVS-H-2A. NC1204.2 +020500 02 FILLER PIC X(40) VALUE SPACE. NC1204.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1204.2 +020700 02 FILLER PIC XXXX VALUE NC1204.2 +020800 "4.2 ". NC1204.2 +020900 02 FILLER PIC X(28) VALUE NC1204.2 +021000 " COPY - NOT FOR DISTRIBUTION". NC1204.2 +021100 02 FILLER PIC X(41) VALUE SPACE. NC1204.2 +021200 NC1204.2 +021300 01 CCVS-H-2B. NC1204.2 +021400 02 FILLER PIC X(15) VALUE NC1204.2 +021500 "TEST RESULT OF ". NC1204.2 +021600 02 TEST-ID PIC X(9). NC1204.2 +021700 02 FILLER PIC X(4) VALUE NC1204.2 +021800 " IN ". NC1204.2 +021900 02 FILLER PIC X(12) VALUE NC1204.2 +022000 " HIGH ". NC1204.2 +022100 02 FILLER PIC X(22) VALUE NC1204.2 +022200 " LEVEL VALIDATION FOR ". NC1204.2 +022300 02 FILLER PIC X(58) VALUE NC1204.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +022500 01 CCVS-H-3. NC1204.2 +022600 02 FILLER PIC X(34) VALUE NC1204.2 +022700 " FOR OFFICIAL USE ONLY ". NC1204.2 +022800 02 FILLER PIC X(58) VALUE NC1204.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1204.2 +023000 02 FILLER PIC X(28) VALUE NC1204.2 +023100 " COPYRIGHT 1985 ". NC1204.2 +023200 01 CCVS-E-1. NC1204.2 +023300 02 FILLER PIC X(52) VALUE SPACE. NC1204.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1204.2 +023500 02 ID-AGAIN PIC X(9). NC1204.2 +023600 02 FILLER PIC X(45) VALUE SPACES. NC1204.2 +023700 01 CCVS-E-2. NC1204.2 +023800 02 FILLER PIC X(31) VALUE SPACE. NC1204.2 +023900 02 FILLER PIC X(21) VALUE SPACE. NC1204.2 +024000 02 CCVS-E-2-2. NC1204.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1204.2 +024200 03 FILLER PIC X VALUE SPACE. NC1204.2 +024300 03 ENDER-DESC PIC X(44) VALUE NC1204.2 +024400 "ERRORS ENCOUNTERED". NC1204.2 +024500 01 CCVS-E-3. NC1204.2 +024600 02 FILLER PIC X(22) VALUE NC1204.2 +024700 " FOR OFFICIAL USE ONLY". NC1204.2 +024800 02 FILLER PIC X(12) VALUE SPACE. NC1204.2 +024900 02 FILLER PIC X(58) VALUE NC1204.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +025100 02 FILLER PIC X(13) VALUE SPACE. NC1204.2 +025200 02 FILLER PIC X(15) VALUE NC1204.2 +025300 " COPYRIGHT 1985". NC1204.2 +025400 01 CCVS-E-4. NC1204.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1204.2 +025600 02 FILLER PIC X(4) VALUE " OF ". NC1204.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1204.2 +025800 02 FILLER PIC X(40) VALUE NC1204.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1204.2 +026000 01 XXINFO. NC1204.2 +026100 02 FILLER PIC X(19) VALUE NC1204.2 +026200 "*** INFORMATION ***". NC1204.2 +026300 02 INFO-TEXT. NC1204.2 +026400 04 FILLER PIC X(8) VALUE SPACE. NC1204.2 +026500 04 XXCOMPUTED PIC X(20). NC1204.2 +026600 04 FILLER PIC X(5) VALUE SPACE. NC1204.2 +026700 04 XXCORRECT PIC X(20). NC1204.2 +026800 02 INF-ANSI-REFERENCE PIC X(48). NC1204.2 +026900 01 HYPHEN-LINE. NC1204.2 +027000 02 FILLER PIC IS X VALUE IS SPACE. NC1204.2 +027100 02 FILLER PIC IS X(65) VALUE IS "************************NC1204.2 +027200- "*****************************************". NC1204.2 +027300 02 FILLER PIC IS X(54) VALUE IS "************************NC1204.2 +027400- "******************************". NC1204.2 +027500 01 CCVS-PGM-ID PIC X(9) VALUE NC1204.2 +027600 "NC120A". NC1204.2 +027700 PROCEDURE DIVISION. NC1204.2 +027800 CCVS1 SECTION. NC1204.2 +027900 OPEN-FILES. NC1204.2 +028000 OPEN OUTPUT PRINT-FILE. NC1204.2 +028100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1204.2 +028200 MOVE SPACE TO TEST-RESULTS. NC1204.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1204.2 +028400 GO TO CCVS1-EXIT. NC1204.2 +028500 CLOSE-FILES. NC1204.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1204.2 +028700 TERMINATE-CCVS. NC1204.2 +028800S EXIT PROGRAM. NC1204.2 +028900STERMINATE-CALL. NC1204.2 +029000 STOP RUN. NC1204.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1204.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1204.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1204.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1204.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. NC1204.2 +029600 PRINT-DETAIL. NC1204.2 +029700 IF REC-CT NOT EQUAL TO ZERO NC1204.2 +029800 MOVE "." TO PARDOT-X NC1204.2 +029900 MOVE REC-CT TO DOTVALUE. NC1204.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1204.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1204.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1204.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1204.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1204.2 +030500 MOVE SPACE TO CORRECT-X. NC1204.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1204.2 +030700 MOVE SPACE TO RE-MARK. NC1204.2 +030800 HEAD-ROUTINE. NC1204.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1204.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1204.2 +031300 COLUMN-NAMES-ROUTINE. NC1204.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +031700 END-ROUTINE. NC1204.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1204.2 +031900 END-RTN-EXIT. NC1204.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +032100 END-ROUTINE-1. NC1204.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1204.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1204.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. NC1204.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1204.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1204.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1204.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1204.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1204.2 +033000 END-ROUTINE-12. NC1204.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1204.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1204.2 +033300 MOVE "NO " TO ERROR-TOTAL NC1204.2 +033400 ELSE NC1204.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1204.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1204.2 +033700 PERFORM WRITE-LINE. NC1204.2 +033800 END-ROUTINE-13. NC1204.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1204.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE NC1204.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1204.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1204.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO NC1204.2 +034500 MOVE "NO " TO ERROR-TOTAL NC1204.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1204.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1204.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +035000 WRITE-LINE. NC1204.2 +035100 ADD 1 TO RECORD-COUNT. NC1204.2 +035200Y IF RECORD-COUNT GREATER 42 NC1204.2 +035300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1204.2 +035400Y MOVE SPACE TO DUMMY-RECORD NC1204.2 +035500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1204.2 +035600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1204.2 +035700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1204.2 +035800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1204.2 +035900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1204.2 +036000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1204.2 +036400Y MOVE ZERO TO RECORD-COUNT. NC1204.2 +036500 PERFORM WRT-LN. NC1204.2 +036600 WRT-LN. NC1204.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1204.2 +036800 MOVE SPACE TO DUMMY-RECORD. NC1204.2 +036900 BLANK-LINE-PRINT. NC1204.2 +037000 PERFORM WRT-LN. NC1204.2 +037100 FAIL-ROUTINE. NC1204.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE NC1204.2 +037300 GO TO FAIL-ROUTINE-WRITE. NC1204.2 +037400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1204.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1204.2 +037600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1204.2 +037700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +037800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1204.2 +037900 GO TO FAIL-ROUTINE-EX. NC1204.2 +038000 FAIL-ROUTINE-WRITE. NC1204.2 +038100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1204.2 +038200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1204.2 +038300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1204.2 +038400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1204.2 +038500 FAIL-ROUTINE-EX. EXIT. NC1204.2 +038600 BAIL-OUT. NC1204.2 +038700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1204.2 +038800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1204.2 +038900 BAIL-OUT-WRITE. NC1204.2 +039000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1204.2 +039100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1204.2 +039200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +039300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1204.2 +039400 BAIL-OUT-EX. EXIT. NC1204.2 +039500 CCVS1-EXIT. NC1204.2 +039600 EXIT. NC1204.2 +039700 SECTION-NC120A-001 SECTION. NC1204.2 +039800 SIG-INIT-GF-14. NC1204.2 +039900 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1204.2 +040000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +040100 MOVE 80.12 TO MULT1. NC1204.2 +040200 MOVE 0 TO MULT2. NC1204.2 +040300 SIG-TEST-GF-14-0. NC1204.2 +040400 MULTIPLY MULT1 BY 4.3 GIVING MULT2. NC1204.2 +040500 SIG-TEST-GF-14-1. NC1204.2 +040600 IF MULT2 NOT EQUAL TO 344.516 NC1204.2 +040700 GO TO SIG-FAIL-GF-14. NC1204.2 +040800 PERFORM PASS NC1204.2 +040900 GO TO SIG-WRITE-GF-14. NC1204.2 +041000 SIG-DELETE-GF-14. NC1204.2 +041100 PERFORM DE-LETE. NC1204.2 +041200 GO TO SIG-WRITE-GF-14. NC1204.2 +041300 SIG-FAIL-GF-14. NC1204.2 +041400 PERFORM FAIL. NC1204.2 +041500 MOVE MULT2 TO COMPUTED-N. NC1204.2 +041600 MOVE +344.516 TO CORRECT-N. NC1204.2 +041700 SIG-WRITE-GF-14. NC1204.2 +041800 MOVE "SIG-TEST-GF-14" TO PAR-NAME. NC1204.2 +041900 PERFORM PRINT-DETAIL. NC1204.2 +042000 SIG-INIT-GF-15. NC1204.2 +042100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +042200 MOVE 80.12 TO MULT1. NC1204.2 +042300 MOVE 0 TO MULT3. NC1204.2 +042400 SIG-TEST-GF-15-0. NC1204.2 +042500 MULTIPLY .9 BY MULT1 GIVING MULT3 ROUNDED. NC1204.2 +042600 SIG-TEST-GF-15-1. NC1204.2 +042700 IF MULT3 NOT EQUAL TO " $72.11" NC1204.2 +042800 GO TO SIG-FAIL-GF-15. NC1204.2 +042900 PERFORM PASS. NC1204.2 +043000 GO TO SIG-WRITE-GF-15. NC1204.2 +043100 SIG-DELETE-GF-15. NC1204.2 +043200 PERFORM DE-LETE. NC1204.2 +043300 GO TO SIG-WRITE-GF-15. NC1204.2 +043400 SIG-FAIL-GF-15. NC1204.2 +043500 PERFORM FAIL. NC1204.2 +043600 MOVE MULT3 TO COMPUTED-A. NC1204.2 +043700 MOVE " l72.11" TO CORRECT-A. NC1204.2 +043800 SIG-WRITE-GF-15. NC1204.2 +043900 MOVE "SIG-TEST-GF-15 " TO PAR-NAME. NC1204.2 +044000 PERFORM PRINT-DETAIL. NC1204.2 +044100 SIG-INIT-GF-16. NC1204.2 +044200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +044300 MOVE -56 TO MULT4. NC1204.2 +044400 MOVE 80.12 TO MULT1. NC1204.2 +044500 MOVE 4 TO MULT5. NC1204.2 +044600 SIG-TEST-GF-16-0. NC1204.2 +044700 MULTIPLY MULT4 BY MULT1 GIVING MULT5 ON SIZE ERROR NC1204.2 +044800 MOVE "H" TO XRAY. NC1204.2 +044900 SIG-TEST-GF-16-1. NC1204.2 +045000 IF XRAY EQUAL TO "H" NC1204.2 +045100 PERFORM PASS NC1204.2 +045200 ELSE NC1204.2 +045300 GO TO SIG-FAIL-GF-16-1. NC1204.2 +045400 GO TO SIG-WRITE-GF-16-1. NC1204.2 +045500 SIG-DELETE-GF-16-1. NC1204.2 +045600 PERFORM DE-LETE. NC1204.2 +045700 GO TO SIG-WRITE-GF-16-1. NC1204.2 +045800 SIG-FAIL-GF-16-1. NC1204.2 +045900 MOVE MULT5 TO COMPUTED-N. NC1204.2 +046000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +046100 PERFORM FAIL. NC1204.2 +046200 SIG-WRITE-GF-16-1. NC1204.2 +046300 MOVE "SIG-TEST-GF-16-1 " TO PAR-NAME. NC1204.2 +046400 PERFORM PRINT-DETAIL. NC1204.2 +046500 SIG-TEST-GF-16-2. NC1204.2 +046600 IF MULT5 NOT EQUAL TO 4 NC1204.2 +046700 GO TO SIG-FAIL-GF-16-2. NC1204.2 +046800 PERFORM PASS. NC1204.2 +046900 GO TO SIG-WRITE-GF-16-2. NC1204.2 +047000 SIG-DELETE-GF-16-2. NC1204.2 +047100 PERFORM DE-LETE. NC1204.2 +047200 GO TO SIG-WRITE-GF-16-2. NC1204.2 +047300 SIG-FAIL-GF-16-2. NC1204.2 +047400 PERFORM FAIL. NC1204.2 +047500 MOVE MULT5 TO COMPUTED-N. NC1204.2 +047600 MOVE +4 TO CORRECT-N. NC1204.2 +047700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +047800 SIG-WRITE-GF-16-2. NC1204.2 +047900 MOVE "SIG-TEST-GF-16-2 " TO PAR-NAME. NC1204.2 +048000 PERFORM PRINT-DETAIL. NC1204.2 +048100 SIG-INIT-GF-1. NC1204.2 +048200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +048300 MOVE 4 TO MULT5. NC1204.2 +048400 MOVE "A" TO XRAY. NC1204.2 +048500 SIG-TEST-GF-1-0. NC1204.2 +048600 MULTIPLY 3.3 BY -3 GIVING MULT5 ROUNDED ON SIZE ERROR NC1204.2 +048700 MOVE "J" TO XRAY. NC1204.2 +048800 SIG-TEST-GF-1-1. NC1204.2 +048900 IF XRAY NOT EQUAL TO "J" NC1204.2 +049000 GO TO SIG-FAIL-GF-1-1 NC1204.2 +049100 ELSE NC1204.2 +049200 PERFORM PASS. NC1204.2 +049300 GO TO SIG-WRITE-GF-1-1. NC1204.2 +049400 SIG-DELETE-GF-1-1. NC1204.2 +049500 PERFORM DE-LETE. NC1204.2 +049600 GO TO SIG-WRITE-GF-1-1. NC1204.2 +049700 SIG-FAIL-GF-1-1. NC1204.2 +049800 MOVE MULT5 TO COMPUTED-N. NC1204.2 +049900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +050000 PERFORM FAIL. NC1204.2 +050100 SIG-WRITE-GF-1-1. NC1204.2 +050200 MOVE "SIG-TEST-GF-1-1 " TO PAR-NAME. NC1204.2 +050300 PERFORM PRINT-DETAIL. NC1204.2 +050400 SIG-TEST-GF-1-2. NC1204.2 +050500 IF MULT5 EQUAL TO 4 NC1204.2 +050600 PERFORM PASS NC1204.2 +050700 ELSE NC1204.2 +050800 GO TO SIG-FAIL-GF-1-2. NC1204.2 +050900 GO TO SIG-WRITE-GF-1-2. NC1204.2 +051000 SIG-DELETE-GF-1-2. NC1204.2 +051100 PERFORM DE-LETE. NC1204.2 +051200 GO TO SIG-WRITE-GF-1-2. NC1204.2 +051300 SIG-FAIL-GF-1-2. NC1204.2 +051400 PERFORM FAIL. NC1204.2 +051500 MOVE MULT5 TO COMPUTED-N. NC1204.2 +051600 MOVE +4 TO CORRECT-N. NC1204.2 +051700 MOVE 4 TO MULT5. NC1204.2 +051800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +051900 SIG-WRITE-GF-1-2. NC1204.2 +052000 MOVE "SIG-TEST-GF-1-2 " TO PAR-NAME. NC1204.2 +052100 PERFORM PRINT-DETAIL. NC1204.2 +052200 SIG-INIT-GF-2. NC1204.2 +052300 MOVE "MULTIPLY BY" TO FEATURE. NC1204.2 +052400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +052500 MOVE 4 TO MULT5. NC1204.2 +052600 SIG-TEST-GF-2-0. NC1204.2 +052700 MULTIPLY MULT5 BY MULT1. NC1204.2 +052800 SIG-TEST-GF-2-1. NC1204.2 +052900 IF MULT1 EQUAL TO 320.48 NC1204.2 +053000 PERFORM PASS NC1204.2 +053100 ELSE NC1204.2 +053200 GO TO SIG-FAIL-GF-2. NC1204.2 +053300 GO TO SIG-WRITE-GF-2. NC1204.2 +053400 SIG-DELETE-GF-2. NC1204.2 +053500 PERFORM DE-LETE. NC1204.2 +053600 GO TO SIG-WRITE-GF-2. NC1204.2 +053700 SIG-FAIL-GF-2. NC1204.2 +053800 PERFORM FAIL. NC1204.2 +053900 MOVE MULT1 TO COMPUTED-N. NC1204.2 +054000 MOVE +320.48 TO CORRECT-N. NC1204.2 +054100 SIG-WRITE-GF-2. NC1204.2 +054200 MOVE "SIG-TEST-GF-2 " TO PAR-NAME. NC1204.2 +054300 PERFORM PRINT-DETAIL. NC1204.2 +054400 SIG-INIT-GF-3. NC1204.2 +054500 MOVE "MULTIPLY BY" TO FEATURE. NC1204.2 +054600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +054700 MOVE -56 TO MULT4. NC1204.2 +054800 SIG-TEST-GF-3-0. NC1204.2 +054900 MULTIPLY -1.3 BY MULT4 ROUNDED. NC1204.2 +055000 SIG-TEST-GF-3-1. NC1204.2 +055100 IF MULT4 EQUAL TO 73 NC1204.2 +055200 PERFORM PASS NC1204.2 +055300 ELSE NC1204.2 +055400 GO TO SIG-FAIL-GF-3. NC1204.2 +055500 GO TO SIG-WRITE-GF-3. NC1204.2 +055600 SIG-DELETE-GF-3. NC1204.2 +055700 PERFORM DE-LETE. NC1204.2 +055800 GO TO SIG-WRITE-GF-3. NC1204.2 +055900 SIG-FAIL-GF-3. NC1204.2 +056000 PERFORM FAIL. NC1204.2 +056100 MOVE MULT4 TO COMPUTED-N. NC1204.2 +056200 MOVE +73 TO CORRECT-N. NC1204.2 +056300 SIG-WRITE-GF-3. NC1204.2 +056400 MOVE "SIG-TEST-GF-3 " TO PAR-NAME. NC1204.2 +056500 PERFORM PRINT-DETAIL. NC1204.2 +056600 SIG-INIT-GF-4. NC1204.2 +056700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +056800 MOVE 4 TO MULT5. NC1204.2 +056900 MOVE "B" TO XRAY. NC1204.2 +057000 SIG-TEST-GF-4-0. NC1204.2 +057100 MULTIPLY MULT5 BY MULT5 ON SIZE ERROR NC1204.2 +057200 MOVE "K" TO XRAY. NC1204.2 +057300 SIG-TEST-GF-4-1. NC1204.2 +057400 IF XRAY EQUAL TO "K" NC1204.2 +057500 PERFORM PASS NC1204.2 +057600 ELSE NC1204.2 +057700 GO TO SIG-FAIL-GF-4-1. NC1204.2 +057800 GO TO SIG-WRITE-GF-4-1. NC1204.2 +057900 SIG-DELETE-GF-4-1. NC1204.2 +058000 PERFORM DE-LETE. NC1204.2 +058100 GO TO SIG-WRITE-GF-4-1. NC1204.2 +058200 SIG-FAIL-GF-4-1. NC1204.2 +058300 MOVE MULT5 TO COMPUTED-N. NC1204.2 +058400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +058500 PERFORM FAIL. NC1204.2 +058600 SIG-WRITE-GF-4-1. NC1204.2 +058700 MOVE "SIG-TEST-GF-4-1 " TO PAR-NAME. NC1204.2 +058800 PERFORM PRINT-DETAIL. NC1204.2 +058900 SIG-TEST-GF-4-2. NC1204.2 +059000 IF MULT5 EQUAL TO 4 NC1204.2 +059100 PERFORM PASS NC1204.2 +059200 ELSE NC1204.2 +059300 GO TO SIG-FAIL-GF-4-2. NC1204.2 +059400 GO TO SIG-WRITE-GF-4-2. NC1204.2 +059500 SIG-DELETE-GF-4-2. NC1204.2 +059600 PERFORM DE-LETE. NC1204.2 +059700 GO TO SIG-WRITE-GF-4-2. NC1204.2 +059800 SIG-FAIL-GF-4-2. NC1204.2 +059900 PERFORM FAIL. NC1204.2 +060000 MOVE MULT5 TO COMPUTED-N. NC1204.2 +060100 MOVE +4 TO CORRECT-N. NC1204.2 +060200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +060300 SIG-WRITE-GF-4-2. NC1204.2 +060400 MOVE "SIG-TEST-GF-4-2" TO PAR-NAME. NC1204.2 +060500 PERFORM PRINT-DETAIL. NC1204.2 +060600 SIG-INIT-GF-5. NC1204.2 +060700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +060800 MOVE 20 TO MULT6. NC1204.2 +060900 MOVE "C" TO XRAY. NC1204.2 +061000 SIG-TEST-GF-5-0. NC1204.2 +061100 MULTIPLY 4.99 BY MULT6 ROUNDED ON SIZE ERROR NC1204.2 +061200 MOVE "L" TO XRAY. NC1204.2 +061300 SIG-TEST-GF-5-1. NC1204.2 +061400 IF XRAY EQUAL TO "L" NC1204.2 +061500 PERFORM PASS NC1204.2 +061600 ELSE NC1204.2 +061700 GO TO SIG-FAIL-GF-5-1. NC1204.2 +061800 GO TO SIG-WRITE-GF-5-1. NC1204.2 +061900 SIG-DELETE-GF-5-1. NC1204.2 +062000 PERFORM DE-LETE. NC1204.2 +062100 GO TO SIG-WRITE-GF-5-1. NC1204.2 +062200 SIG-FAIL-GF-5-1. NC1204.2 +062300 MOVE MULT6 TO COMPUTED-N. NC1204.2 +062400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +062500 PERFORM FAIL. NC1204.2 +062600 SIG-WRITE-GF-5-1. NC1204.2 +062700 MOVE "SIG-TEST-GF-5-1" TO PAR-NAME. NC1204.2 +062800 PERFORM PRINT-DETAIL. NC1204.2 +062900 SIG-TEST-GF-5-2. NC1204.2 +063000 IF MULT6 EQUAL TO 20 NC1204.2 +063100 PERFORM PASS NC1204.2 +063200 ELSE NC1204.2 +063300 GO TO SIG-FAIL-GF-5-2. NC1204.2 +063400 GO TO SIG-WRITE-GF-5-2. NC1204.2 +063500 SIG-DELETE-GF-5-2. NC1204.2 +063600 PERFORM DE-LETE. NC1204.2 +063700 GO TO SIG-WRITE-GF-5-2. NC1204.2 +063800 SIG-FAIL-GF-5-2. NC1204.2 +063900 PERFORM FAIL. NC1204.2 +064000 MOVE MULT6 TO COMPUTED-N. NC1204.2 +064100 MOVE +20 TO CORRECT-N. NC1204.2 +064200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +064300 SIG-WRITE-GF-5-2. NC1204.2 +064400 MOVE "SIG-TEST-GF-5-2" TO PAR-NAME. NC1204.2 +064500 PERFORM PRINT-DETAIL. NC1204.2 +064600 SIG-INIT-GF-6. NC1204.2 +064700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +064800 MOVE 222222222222 TO WRK-DS-LS-18V00. NC1204.2 +064900 SIG-TEST-GF-6-0. NC1204.2 +065000 MULTIPLY A06THREES-DS-LS-03V03 BY WRK-DS-LS-18V00. NC1204.2 +065100 SIG-TEST-GF-6-1. NC1204.2 +065200 IF WRK-DS-LS-18V00 EQUAL TO 000074073999999925 NC1204.2 +065300 PERFORM PASS NC1204.2 +065400 GO TO SIG-WRITE-GF-6. NC1204.2 +065500 GO TO SIG-FAIL-GF-6. NC1204.2 +065600 SIG-DELETE-GF-6. NC1204.2 +065700 PERFORM DE-LETE. NC1204.2 +065800 GO TO SIG-WRITE-GF-6. NC1204.2 +065900 SIG-FAIL-GF-6. NC1204.2 +066000 MOVE 000074073999999925 TO CORRECT-18V0. NC1204.2 +066100 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1204.2 +066200 PERFORM FAIL. NC1204.2 +066300 SIG-WRITE-GF-6. NC1204.2 +066400 MOVE "SIG-TEST-GF-6 " TO PAR-NAME. NC1204.2 +066500 PERFORM PRINT-DETAIL. NC1204.2 +066600 SIG-INIT-GF-7. NC1204.2 +066700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +066800 MOVE A08TWOS-DS-02V06 TO WRK-DS-TS-06V06. NC1204.2 +066900 SIG-TEST-GF-7-0. NC1204.2 +067000 MULTIPLY 0.4 BY WRK-DS-TS-06V06 ROUNDED. NC1204.2 +067100 SIG-TEST-GF-7-1. NC1204.2 +067200 IF WRK-DS-TS-12V00-S-S EQUAL TO 000008888889 NC1204.2 +067300 PERFORM PASS NC1204.2 +067400 GO TO SIG-WRITE-GF-7. NC1204.2 +067500 GO TO SIG-FAIL-GF-7. NC1204.2 +067600 SIG-DELETE-GF-7. NC1204.2 +067700 PERFORM DE-LETE. NC1204.2 +067800 GO TO SIG-WRITE-GF-7. NC1204.2 +067900 SIG-FAIL-GF-7. NC1204.2 +068000 MOVE WRK-DS-TS-12V00-S-S TO COMPUTED-18V0. NC1204.2 +068100 MOVE 000008888889 TO CORRECT-18V0. NC1204.2 +068200 PERFORM FAIL. NC1204.2 +068300 SIG-WRITE-GF-7. NC1204.2 +068400 MOVE "SIG-TEST-GF-7 " TO PAR-NAME. NC1204.2 +068500 PERFORM PRINT-DETAIL. NC1204.2 +068600 SIG-INIT-GF-8. NC1204.2 +068700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +068800 MOVE "0" TO WRK-XN-00001. NC1204.2 +068900 MOVE A10ONES-DS-T-10V00 TO WRK-DS-10V00. NC1204.2 +069000 SIG-TEST-GF-8-0. NC1204.2 +069100 MULTIPLY A12THREES-DS-LS-06V06 BY WRK-DS-10V00 NC1204.2 +069200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1204.2 +069300 SIG-TEST-GF-8-1. NC1204.2 +069400 IF WRK-DS-10V00 EQUAL TO 1111111111 NC1204.2 +069500 PERFORM PASS NC1204.2 +069600 GO TO SIG-WRITE-GF-8-1. NC1204.2 +069700 GO TO SIG-FAIL-GF-8-1. NC1204.2 +069800 SIG-DELETE-GF-8-1. NC1204.2 +069900 PERFORM DE-LETE. NC1204.2 +070000 GO TO SIG-WRITE-GF-8-1. NC1204.2 +070100 SIG-FAIL-GF-8-1. NC1204.2 +070200 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +070300 MOVE 1111111111 TO CORRECT-18V0. NC1204.2 +070400 PERFORM FAIL. NC1204.2 +070500 SIG-WRITE-GF-8-1. NC1204.2 +070600 MOVE "SIG-TEST-GF-8-1 " TO PAR-NAME. NC1204.2 +070700 PERFORM PRINT-DETAIL. NC1204.2 +070800 SIG-TEST-GF-8-2. NC1204.2 +070900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +071000 PERFORM PASS NC1204.2 +071100 GO TO SIG-WRITE-GF-8-2. NC1204.2 +071200 MOVE "1" TO CORRECT-A. NC1204.2 +071300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +071400 PERFORM FAIL. NC1204.2 +071500 GO TO SIG-WRITE-GF-8-2. NC1204.2 +071600 SIG-DELETE-GF-8-2. NC1204.2 +071700 PERFORM DE-LETE. NC1204.2 +071800 SIG-WRITE-GF-8-2. NC1204.2 +071900 MOVE "SIG-TEST-GF-8-2 " TO PAR-NAME. NC1204.2 +072000 PERFORM PRINT-DETAIL. NC1204.2 +072100 SIG-INIT-GF-9. NC1204.2 +072200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +072300 MOVE "1" TO WRK-XN-00001. NC1204.2 +072400 MOVE -99 TO WRK-DS-02V00. NC1204.2 +072500 SIG-TEST-GF-9-0. NC1204.2 +072600 MULTIPLY AZERO-DS-LS-05V05 BY WRK-DS-02V00 NC1204.2 +072700 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1204.2 +072800 SIG-TEST-GF-9-1. NC1204.2 +072900 IF WRK-DS-02V00 EQUAL TO 00 NC1204.2 +073000 PERFORM PASS NC1204.2 +073100 GO TO SIG-WRITE-GF-9-1. NC1204.2 +073200 GO TO SIG-FAIL-GF-9-1. NC1204.2 +073300 SIG-DELETE-GF-9-1. NC1204.2 +073400 PERFORM DE-LETE. NC1204.2 +073500 GO TO SIG-WRITE-GF-9-1. NC1204.2 +073600 SIG-FAIL-GF-9-1. NC1204.2 +073700 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +073800 MOVE 00 TO CORRECT-N. NC1204.2 +073900 PERFORM FAIL. NC1204.2 +074000 SIG-WRITE-GF-9-1. NC1204.2 +074100 MOVE "SIG-TEST-GF-9-1 " TO PAR-NAME. NC1204.2 +074200 PERFORM PRINT-DETAIL. NC1204.2 +074300 SIG-TEST-GF-9-2. NC1204.2 +074400 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +074500 PERFORM PASS NC1204.2 +074600 GO TO SIG-WRITE-GF-9-2. NC1204.2 +074700 MOVE "1" TO CORRECT-A. NC1204.2 +074800 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +074900 PERFORM FAIL. NC1204.2 +075000 GO TO SIG-WRITE-GF-9-2. NC1204.2 +075100 SIG-DELETE-GF-9-2. NC1204.2 +075200 PERFORM DE-LETE. NC1204.2 +075300 SIG-WRITE-GF-9-2. NC1204.2 +075400 MOVE "SIG-TEST-GF-9-2 " TO PAR-NAME. NC1204.2 +075500 PERFORM PRINT-DETAIL. NC1204.2 +075600 SIG-INIT-GF-10. NC1204.2 +075700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +075800 MOVE "0" TO WRK-XN-00001. NC1204.2 +075900 MOVE -01 TO WRK-DS-02V00. NC1204.2 +076000 SIG-TEST-GF-10-0. NC1204.2 +076100 MULTIPLY 99.5 BY WRK-DS-02V00 ROUNDED NC1204.2 +076200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1204.2 +076300 SIG-TEST-GF-10-1. NC1204.2 +076400 IF WRK-DS-02V00 EQUAL TO -01 NC1204.2 +076500 PERFORM PASS NC1204.2 +076600 GO TO SIG-WRITE-GF-10-1. NC1204.2 +076700 GO TO SIG-FAIL-GF-10-1. NC1204.2 +076800 SIG-DELETE-GF-10-1. NC1204.2 +076900 PERFORM DE-LETE. NC1204.2 +077000 GO TO SIG-WRITE-GF-10-1. NC1204.2 +077100 SIG-FAIL-GF-10-1. NC1204.2 +077200 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +077300 MOVE -01 TO CORRECT-N. NC1204.2 +077400 PERFORM FAIL. NC1204.2 +077500 SIG-WRITE-GF-10-1. NC1204.2 +077600 MOVE "SIG-TEST-GF-10-1 " TO PAR-NAME. NC1204.2 +077700 PERFORM PRINT-DETAIL. NC1204.2 +077800 SIG-TEST-GF-10-2. NC1204.2 +077900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +078000 PERFORM PASS NC1204.2 +078100 GO TO SIG-WRITE-GF-10-2. NC1204.2 +078200 MOVE "1" TO CORRECT-A. NC1204.2 +078300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +078400 PERFORM FAIL. NC1204.2 +078500 GO TO SIG-WRITE-GF-10-2. NC1204.2 +078600 SIG-DELETE-GF-10-2. NC1204.2 +078700 PERFORM DE-LETE. NC1204.2 +078800 SIG-WRITE-GF-10-2. NC1204.2 +078900 MOVE "SIG-TEST-GF-10-2 " TO PAR-NAME. NC1204.2 +079000 PERFORM PRINT-DETAIL. NC1204.2 +079100 SIG-INIT-GF-11. NC1204.2 +079200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +079300 MOVE "1" TO WRK-XN-00001. NC1204.2 +079400 MOVE -01 TO WRK-DS-02V00. NC1204.2 +079500 SIG-TEST-GF-11-0. NC1204.2 +079600 MULTIPLY 99.4 BY WRK-DS-02V00 ROUNDED NC1204.2 +079700 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1204.2 +079800 SIG-TEST-GF-11-1. NC1204.2 +079900 IF WRK-DS-02V00 EQUAL TO -99 NC1204.2 +080000 PERFORM PASS NC1204.2 +080100 GO TO SIG-WRITE-GF-11-1. NC1204.2 +080200 GO TO SIG-FAIL-GF-11-1. NC1204.2 +080300 SIG-DELETE-GF-11-1. NC1204.2 +080400 PERFORM DE-LETE. NC1204.2 +080500 GO TO SIG-WRITE-GF-11-1. NC1204.2 +080600 SIG-FAIL-GF-11-1. NC1204.2 +080700 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +080800 MOVE -99 TO CORRECT-N. NC1204.2 +080900 PERFORM FAIL. NC1204.2 +081000 SIG-WRITE-GF-11-1. NC1204.2 +081100 MOVE "SIG-TEST-GF-11-1 " TO PAR-NAME. NC1204.2 +081200 PERFORM PRINT-DETAIL. NC1204.2 +081300 SIG-TEST-GF-11-2. NC1204.2 +081400 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +081500 PERFORM PASS NC1204.2 +081600 GO TO SIG-WRITE-GF-11-2. NC1204.2 +081700 MOVE "1" TO CORRECT-A. NC1204.2 +081800 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +081900 PERFORM FAIL. NC1204.2 +082000 GO TO SIG-WRITE-GF-11-2. NC1204.2 +082100 SIG-DELETE-GF-11-2. NC1204.2 +082200 PERFORM DE-LETE. NC1204.2 +082300 SIG-WRITE-GF-11-2. NC1204.2 +082400 MOVE "SIG-TEST-GF-11-2 " TO PAR-NAME. NC1204.2 +082500 PERFORM PRINT-DETAIL. NC1204.2 +082600 SIG-INIT-GF-17. NC1204.2 +082700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +082800 MOVE "MULTIPLY BY GIVING " TO FEATURE. NC1204.2 +082900 MOVE ZERO TO WRK-DS-09V09. NC1204.2 +083000 SIG-TEST-GF-17-0. NC1204.2 +083100 MULTIPLY A06THREES-DS-LS-03V03 BY A12THREES-DS-LS-06V06 NC1204.2 +083200 GIVING WRK-DS-09V09. NC1204.2 +083300 SIG-TEST-GF-17-1. NC1204.2 +083400 IF WRK-DS-18V00-S EQUAL TO 111110999999888889 NC1204.2 +083500 PERFORM PASS NC1204.2 +083600 GO TO SIG-WRITE-GF-17. NC1204.2 +083700 GO TO SIG-FAIL-GF-17. NC1204.2 +083800 SIG-DELETE-GF-17. NC1204.2 +083900 PERFORM DE-LETE. NC1204.2 +084000 GO TO SIG-WRITE-GF-17. NC1204.2 +084100 SIG-FAIL-GF-17. NC1204.2 +084200 MOVE 111110999999888889 TO CORRECT-18V0. NC1204.2 +084300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1204.2 +084400 PERFORM FAIL. NC1204.2 +084500 SIG-WRITE-GF-17. NC1204.2 +084600 MOVE "SIG-TEST-GF-17 " TO PAR-NAME. NC1204.2 +084700 PERFORM PRINT-DETAIL. NC1204.2 +084800 SIG-INIT-GF-18. NC1204.2 +084900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +085000 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +085100 SIG-TEST-GF-18-0. NC1204.2 +085200 MULTIPLY A06THREES-DS-LS-03V03 BY A06THREES-DS-LS-03V03 NC1204.2 +085300 GIVING WRK-DS-10V00 ROUNDED. NC1204.2 +085400 SIG-TEST-GF-18-1. NC1204.2 +085500 IF WRK-DS-10V00 EQUAL TO 0000111111 NC1204.2 +085600 PERFORM PASS NC1204.2 +085700 GO TO SIG-WRITE-GF-18. NC1204.2 +085800 GO TO SIG-FAIL-GF-18. NC1204.2 +085900 SIG-DELETE-GF-18. NC1204.2 +086000 PERFORM DE-LETE. NC1204.2 +086100 GO TO SIG-WRITE-GF-18. NC1204.2 +086200 SIG-FAIL-GF-18. NC1204.2 +086300 MOVE 0000111111 TO CORRECT-18V0. NC1204.2 +086400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +086500 PERFORM FAIL. NC1204.2 +086600 SIG-WRITE-GF-18. NC1204.2 +086700 MOVE "SIG-TEST-GF-18 " TO PAR-NAME. NC1204.2 +086800 PERFORM PRINT-DETAIL. NC1204.2 +086900 SIG-INIT-GF-19. NC1204.2 +087000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +087100 MOVE "0" TO WRK-XN-00001. NC1204.2 +087200 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +087300 SIG-TEST-GF-19-0. NC1204.2 +087400 MULTIPLY A05ONES-DS-LS-00V05 BY A12ONES-DS-12V00 NC1204.2 +087500 GIVING WRK-DS-10V00 ON SIZE ERROR NC1204.2 +087600 MOVE "1" TO WRK-XN-00001. NC1204.2 +087700 SIG-TEST-GF-19-1. NC1204.2 +087800 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1204.2 +087900 PERFORM PASS NC1204.2 +088000 GO TO SIG-WRITE-GF-19-1. NC1204.2 +088100 GO TO SIG-FAIL-GF-19-1. NC1204.2 +088200 SIG-DELETE-GF-19-1. NC1204.2 +088300 PERFORM DE-LETE. NC1204.2 +088400 GO TO SIG-WRITE-GF-19-1. NC1204.2 +088500 SIG-FAIL-GF-19-1. NC1204.2 +088600 MOVE 0000000000 TO CORRECT-18V0. NC1204.2 +088700 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +088800 PERFORM FAIL. NC1204.2 +088900 SIG-WRITE-GF-19-1. NC1204.2 +089000 MOVE "SIG-TEST-GF-19-1 " TO PAR-NAME. NC1204.2 +089100 PERFORM PRINT-DETAIL. NC1204.2 +089200 SIG-TEST-GF-19-2. NC1204.2 +089300 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +089400 PERFORM PASS NC1204.2 +089500 GO TO SIG-WRITE-GF-19-2. NC1204.2 +089600 MOVE "1" TO CORRECT-A. NC1204.2 +089700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +089800 PERFORM FAIL. NC1204.2 +089900 GO TO SIG-WRITE-GF-19-2. NC1204.2 +090000 SIG-DELETE-GF-19-2. NC1204.2 +090100 PERFORM DE-LETE. NC1204.2 +090200 SIG-WRITE-GF-19-2. NC1204.2 +090300 MOVE "SIG-TEST-GF-19-2 " TO PAR-NAME. NC1204.2 +090400 PERFORM PRINT-DETAIL. NC1204.2 +090500 SIG-INIT-GF-20. NC1204.2 +090600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +090700 MOVE "1" TO WRK-XN-00001. NC1204.2 +090800 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +090900 SIG-TEST-GF-20-0. NC1204.2 +091000 MULTIPLY A01ONE-DS-TS-P0801 BY A12ONES-DS-12V00 NC1204.2 +091100 GIVING WRK-DS-10V00 ON SIZE ERROR NC1204.2 +091200 MOVE "0" TO WRK-XN-00001. NC1204.2 +091300 SIG-TEST-GF-20-1. NC1204.2 +091400 IF WRK-DS-10V00 EQUAL TO 0000000111 NC1204.2 +091500 PERFORM PASS NC1204.2 +091600 GO TO SIG-WRITE-GF-20-1. NC1204.2 +091700 GO TO SIG-FAIL-GF-20-1. NC1204.2 +091800 SIG-DELETE-GF-20-1. NC1204.2 +091900 PERFORM DE-LETE. NC1204.2 +092000 GO TO SIG-WRITE-GF-20-1. NC1204.2 +092100 SIG-FAIL-GF-20-1. NC1204.2 +092200 MOVE 0000000111 TO CORRECT-18V0. NC1204.2 +092300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +092400 PERFORM FAIL. NC1204.2 +092500 SIG-WRITE-GF-20-1. NC1204.2 +092600 MOVE "SIG-TEST-GF-20-1 " TO PAR-NAME. NC1204.2 +092700 PERFORM PRINT-DETAIL. NC1204.2 +092800 SIG-TEST-GF-20-2. NC1204.2 +092900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +093000 PERFORM PASS NC1204.2 +093100 GO TO SIG-WRITE-GF-20-2. NC1204.2 +093200 MOVE "1" TO CORRECT-A. NC1204.2 +093300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +093400 PERFORM FAIL. NC1204.2 +093500 GO TO SIG-WRITE-GF-20-2. NC1204.2 +093600 SIG-DELETE-GF-20-2. NC1204.2 +093700 PERFORM DE-LETE. NC1204.2 +093800 SIG-WRITE-GF-20-2. NC1204.2 +093900 MOVE "SIG-TEST-GF-20-2 " TO PAR-NAME. NC1204.2 +094000 PERFORM PRINT-DETAIL. NC1204.2 +094100 SIG-INIT-GF-21. NC1204.2 +094200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +094300 MOVE "0" TO WRK-XN-00001. NC1204.2 +094400 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +094500 SIG-TEST-GF-21-0. NC1204.2 +094600 MULTIPLY 9.5 BY A10ONES-DS-T-10V00 NC1204.2 +094700 GIVING WRK-DS-10V00 ROUNDED ON SIZE ERROR NC1204.2 +094800 MOVE "1" TO WRK-XN-00001. NC1204.2 +094900 SIG-TEST-GF-21-1. NC1204.2 +095000 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1204.2 +095100 PERFORM PASS NC1204.2 +095200 GO TO SIG-WRITE-GF-21-1. NC1204.2 +095300 MOVE 0000000000 TO CORRECT-18V0. NC1204.2 +095400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +095500 PERFORM FAIL. NC1204.2 +095600 GO TO SIG-WRITE-GF-21-1. NC1204.2 +095700 SIG-DELETE-GF-21-1. NC1204.2 +095800 PERFORM DE-LETE. NC1204.2 +095900 SIG-WRITE-GF-21-1. NC1204.2 +096000 MOVE "SIG-TEST-GF-21-1 " TO PAR-NAME. NC1204.2 +096100 PERFORM PRINT-DETAIL. NC1204.2 +096200 SIG-TEST-GF-21-2. NC1204.2 +096300 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +096400 PERFORM PASS NC1204.2 +096500 GO TO SIG-WRITE-GF-21-2. NC1204.2 +096600 MOVE "1" TO CORRECT-A. NC1204.2 +096700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +096800 PERFORM FAIL. NC1204.2 +096900 GO TO SIG-WRITE-GF-21-2. NC1204.2 +097000 SIG-DELETE-GF-21-2. NC1204.2 +097100 PERFORM DE-LETE. NC1204.2 +097200 SIG-WRITE-GF-21-2. NC1204.2 +097300 MOVE "SIG-TEST-GF-21-2 " TO PAR-NAME. NC1204.2 +097400 PERFORM PRINT-DETAIL. NC1204.2 +097500 SIG-INIT-GF-22. NC1204.2 +097600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +097700 MOVE "1" TO WRK-XN-00001. NC1204.2 +097800 MOVE ZERO TO WRK-DS-T-09V08. NC1204.2 +097900 SIG-TEST-GF-22-0. NC1204.2 +098000 MULTIPLY A01ONE-DS-TS-P0801 BY A18ONES-DS-18V00 NC1204.2 +098100 GIVING WRK-DS-T-09V08 ROUNDED ON SIZE ERROR NC1204.2 +098200 MOVE "0" TO WRK-XN-00001. NC1204.2 +098300 SIG-TEST-GF-22-1. NC1204.2 +098400 IF WKR-DS-T-17V00-S EQUAL TO 11111111111111111 NC1204.2 +098500 PERFORM PASS NC1204.2 +098600 GO TO SIG-WRITE-GF-22-1. NC1204.2 +098700 MOVE 11111111111111111 TO CORRECT-18V0. NC1204.2 +098800 MOVE WKR-DS-T-17V00-S TO COMPUTED-18V0. NC1204.2 +098900 PERFORM FAIL. NC1204.2 +099000 GO TO SIG-WRITE-GF-22-1. NC1204.2 +099100 SIG-DELETE-GF-22-1. NC1204.2 +099200 PERFORM DE-LETE. NC1204.2 +099300 SIG-WRITE-GF-22-1. NC1204.2 +099400 MOVE "SIG-TEST-GF-22-1 " TO PAR-NAME. NC1204.2 +099500 PERFORM PRINT-DETAIL. NC1204.2 +099600 SIG-TEST-GF-22-2. NC1204.2 +099700 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +099800 PERFORM PASS NC1204.2 +099900 GO TO SIG-WRITE-GF-22-2. NC1204.2 +100000 MOVE "1" TO CORRECT-A. NC1204.2 +100100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +100200 PERFORM FAIL. NC1204.2 +100300 GO TO SIG-WRITE-GF-22-2. NC1204.2 +100400 SIG-DELETE-GF-22-2. NC1204.2 +100500 PERFORM DE-LETE. NC1204.2 +100600 SIG-WRITE-GF-22-2. NC1204.2 +100700 MOVE "SIG-TEST-GF-22-2 " TO PAR-NAME. NC1204.2 +100800 PERFORM PRINT-DETAIL. NC1204.2 +100900 SIG-INIT-GF-12. NC1204.2 +101000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +101100 MOVE "MULTIPLY BY " TO FEATURE. NC1204.2 +101200 MOVE -990 TO WRK-DS-LS-0201P. NC1204.2 +101300 SIG-TEST-GF-12-0. NC1204.2 +101400 MULTIPLY A01ONE-CS-00V01 BY WRK-DS-LS-0201P. NC1204.2 +101500 SIG-TEST-GF-12-1. NC1204.2 +101600 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1204.2 +101700 IF WRK-DS-05V00 EQUAL TO -00090 NC1204.2 +101800 PERFORM PASS NC1204.2 +101900 GO TO SIG-WRITE-GF-12. NC1204.2 +102000 MOVE -00090 TO CORRECT-N. NC1204.2 +102100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1204.2 +102200 PERFORM FAIL. NC1204.2 +102300 GO TO SIG-WRITE-GF-12. NC1204.2 +102400 SIG-DELETE-GF-12. NC1204.2 +102500 PERFORM DE-LETE. NC1204.2 +102600 SIG-WRITE-GF-12. NC1204.2 +102700 MOVE "SIG-TEST-GF-12 " TO PAR-NAME. NC1204.2 +102800 PERFORM PRINT-DETAIL. NC1204.2 +102900 SIG-INIT-GF-13. NC1204.2 +103000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +103100 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1204.2 +103200 SIG-TEST-GF-13-0. NC1204.2 +103300 MULTIPLY A01ONE-DS-TS-P0801 BY WRK-CS-18V00. NC1204.2 +103400 SIG-TEST-GF-13-1. NC1204.2 +103500 MOVE WRK-CS-18V00 TO WRK-DU-18V00. NC1204.2 +103600 IF WRK-DU-18V00 EQUAL TO 000000000111111111 NC1204.2 +103700 PERFORM PASS NC1204.2 +103800 GO TO SIG-WRITE-GF-13. NC1204.2 +103900 MOVE 000000000111111111 TO CORRECT-18V0. NC1204.2 +104000 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +104100 PERFORM FAIL. NC1204.2 +104200 GO TO SIG-WRITE-GF-13. NC1204.2 +104300 SIG-DELETE-GF-13. NC1204.2 +104400 PERFORM DE-LETE. NC1204.2 +104500 SIG-WRITE-GF-13. NC1204.2 +104600 MOVE "SIG-TEST-GF-13 " TO PAR-NAME. NC1204.2 +104700 PERFORM PRINT-DETAIL. NC1204.2 +104800 SIG-INIT-GF-23. NC1204.2 +104900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +105000 MOVE ZERO TO WRK-CS-02V02. NC1204.2 +105100 SIG-TEST-GF-23-0. NC1204.2 +105200 MULTIPLY A99-CS-02V00 BY A01ONE-CS-00V01 GIVING WRK-CS-02V02.NC1204.2 +105300 SIG-TEST-GF-23-1. NC1204.2 +105400 MOVE WRK-CS-02V02 TO WRK-DS-TS-06V06. NC1204.2 +105500 IF WRK-DS-TS-12V00-S-S EQUAL TO 000009900000 NC1204.2 +105600 PERFORM PASS NC1204.2 +105700 GO TO SIG-WRITE-GF-23. NC1204.2 +105800 MOVE 000009900000 TO CORRECT-18V0. NC1204.2 +105900 MOVE WRK-DS-TS-12V00-S-S TO COMPUTED-18V0. NC1204.2 +106000 PERFORM FAIL. NC1204.2 +106100 GO TO SIG-WRITE-GF-23. NC1204.2 +106200 SIG-DELETE-GF-23. NC1204.2 +106300 PERFORM DE-LETE. NC1204.2 +106400 SIG-WRITE-GF-23. NC1204.2 +106500 MOVE "MULTIPLY BY GIVING " TO FEATURE. NC1204.2 +106600 MOVE "SIG-TEST-GF-23 " TO PAR-NAME. NC1204.2 +106700 PERFORM PRINT-DETAIL. NC1204.2 +106800 SIG-INIT-GF-24. NC1204.2 +106900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +107000 MOVE ZERO TO WRK-CS-18V00. NC1204.2 +107100 SIG-TEST-GF-24-0. NC1204.2 +107200 MULTIPLY A01ONES-CS-18V00 BY A02THREES-CS-18V00 NC1204.2 +107300 GIVING WRK-CS-18V00. NC1204.2 +107400 SIG-TEST-GF-24-1. NC1204.2 +107500 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1204.2 +107600 PERFORM PASS NC1204.2 +107700 GO TO SIG-WRITE-GF-24. NC1204.2 +107800 MOVE -000000000000000033 TO CORRECT-18V0. NC1204.2 +107900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1204.2 +108000 PERFORM FAIL. NC1204.2 +108100 GO TO SIG-WRITE-GF-24. NC1204.2 +108200 SIG-DELETE-GF-24. NC1204.2 +108300 PERFORM DE-LETE. NC1204.2 +108400 SIG-WRITE-GF-24. NC1204.2 +108500 MOVE "SIG-TEST-GF-24 " TO PAR-NAME. NC1204.2 +108600 PERFORM PRINT-DETAIL. NC1204.2 +108700 SIG-INIT-GF-25. NC1204.2 +108800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +108900 MOVE ZERO TO WRK-DU-18V00. NC1204.2 +109000 SIG-TEST-GF-25-0. NC1204.2 +109100 MULTIPLY A02THREES-CS-18V00 BY A14TWOS-CU-18V00 NC1204.2 +109200 GIVING WRK-DU-18V00. NC1204.2 +109300 SIG-TEST-GF-25-1. NC1204.2 +109400 IF WRK-DU-18V00 EQUAL TO 000733333333333326 NC1204.2 +109500 PERFORM PASS NC1204.2 +109600 GO TO SIG-WRITE-GF-25. NC1204.2 +109700 MOVE 000733333333333326 TO CORRECT-18V0. NC1204.2 +109800 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +109900 PERFORM FAIL. NC1204.2 +110000 GO TO SIG-WRITE-GF-25. NC1204.2 +110100 SIG-DELETE-GF-25. NC1204.2 +110200 PERFORM DE-LETE. NC1204.2 +110300 SIG-WRITE-GF-25. NC1204.2 +110400 MOVE "SIG-TEST-GF-25 " TO PAR-NAME. NC1204.2 +110500 PERFORM PRINT-DETAIL. NC1204.2 +110600 SIG-INIT-GF-26. NC1204.2 +110700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +110800 MOVE ZERO TO WRK-CS-18V00. NC1204.2 +110900 SIG-TEST-GF-26-0. NC1204.2 +111000 MULTIPLY A02THREES-CS-18V00 BY A16NINES-CU-18V00 NC1204.2 +111100 GIVING WRK-CS-18V00. NC1204.2 +111200 SIG-TEST-GF-26-1. NC1204.2 +111300 IF WRK-CS-18V00 EQUAL TO -329999999999999967 NC1204.2 +111400 PERFORM PASS NC1204.2 +111500 GO TO SIG-WRITE-GF-26. NC1204.2 +111600 MOVE -329999999999999967 TO CORRECT-18V0. NC1204.2 +111700 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1204.2 +111800 PERFORM FAIL. NC1204.2 +111900 GO TO SIG-WRITE-GF-26. NC1204.2 +112000 SIG-DELETE-GF-26. NC1204.2 +112100 PERFORM DE-LETE. NC1204.2 +112200 SIG-WRITE-GF-26. NC1204.2 +112300 MOVE "SIG-TEST-GF-26 " TO PAR-NAME. NC1204.2 +112400 PERFORM PRINT-DETAIL. NC1204.2 +112500 SIG-INIT-GF-27. NC1204.2 +112600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +112700 MOVE ZERO TO WRK-DU-18V00. NC1204.2 +112800 SIG-TEST-GF-27-0. NC1204.2 +112900 MULTIPLY A01ONES-CS-18V00 BY A18SIXES-CU-18V00 NC1204.2 +113000 GIVING WRK-DU-18V00. NC1204.2 +113100 SIG-TEST-GF-27-1. NC1204.2 +113200 IF WRK-DU-18V00 EQUAL TO 666666666666666666 NC1204.2 +113300 PERFORM PASS NC1204.2 +113400 GO TO SIG-WRITE-GF-27. NC1204.2 +113500 MOVE 666666666666666666 TO CORRECT-18V0. NC1204.2 +113600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +113700 PERFORM FAIL. NC1204.2 +113800 GO TO SIG-WRITE-GF-27. NC1204.2 +113900 SIG-DELETE-GF-27. NC1204.2 +114000 PERFORM DE-LETE. NC1204.2 +114100 SIG-WRITE-GF-27. NC1204.2 +114200 MOVE "SIG-TEST-GF-27 " TO PAR-NAME. NC1204.2 +114300 PERFORM PRINT-DETAIL. NC1204.2 +114400 PERFORM END-ROUTINE. NC1204.2 +114500 CCVS-EXIT SECTION. NC1204.2 +114600 CCVS-999999. NC1204.2 +114700 GO TO CLOSE-FILES. NC1204.2 +*END-OF,NC120A +*HEADER,COBOL,NC121M +000100 IDENTIFICATION DIVISION. NC1214.2 +000200 PROGRAM-ID. NC1214.2 +000300 NC121M. NC1214.2 +000400**************************************************************** NC1214.2 +000500* * NC1214.2 +000600* VALIDATION FOR:- * NC1214.2 +000700* * NC1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +000900* * NC1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1214.2 +001100* * NC1214.2 +001200**************************************************************** NC1214.2 +001300* * NC1214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1214.2 +001500* * NC1214.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1214.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1214.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1214.2 +001900* * NC1214.2 +002000**************************************************************** NC1214.2 +002100* NC1214.2 +002200* PROGRAM NC121M TESTS THE USE OF INDEXED IDENTIFIERS WITH NC1214.2 +002300* FORMATS 1 AND 2 OF THE "MULTIPLY" STATEMENT, FORMATS NC1214.2 +002400* 1, 2 AND 3 OF THE "DIVIDE" STATEMENT, FORMATS 1 AND 2 OF NC1214.2 +002500* THE "PERFORM" STATEMENT AND THE "DISPLAY" STATEMENT NC1214.2 +002600* GENERAL FORMAT. NC1214.2 +002700* ONE AND TWO LEVELS OF INDEXING ARE USED AS WELL AS NC1214.2 +002800* RELATIVE INDEXING. NC1214.2 +002900* NC1214.2 +003000 ENVIRONMENT DIVISION. NC1214.2 +003100 CONFIGURATION SECTION. NC1214.2 +003200 SOURCE-COMPUTER. NC1214.2 +003300 XXXXX082. NC1214.2 +003400 OBJECT-COMPUTER. NC1214.2 +003500 XXXXX083. NC1214.2 +003600 INPUT-OUTPUT SECTION. NC1214.2 +003700 FILE-CONTROL. NC1214.2 +003800 SELECT PRINT-FILE ASSIGN TO NC1214.2 +003900 XXXXX055. NC1214.2 +004000 DATA DIVISION. NC1214.2 +004100 FILE SECTION. NC1214.2 +004200 FD PRINT-FILE. NC1214.2 +004300 01 PRINT-REC PICTURE X(120). NC1214.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1214.2 +004500 WORKING-STORAGE SECTION. NC1214.2 +004600 01 TABLE1. NC1214.2 +004700 02 TABLE1-NUM PICTURE S9V99 NC1214.2 +004800 OCCURS 10 TIMES NC1214.2 +004900 INDEXED BY INDEX1. NC1214.2 +005000 01 TABLE2. NC1214.2 +005100 02 TABLE2-NUM PICTURE 9V9 NC1214.2 +005200 OCCURS 6 TIMES NC1214.2 +005300 INDEXED BY INDEX2. NC1214.2 +005400 01 TABLE3. NC1214.2 +005500 02 TABLE3-NUM PICTURE 99V9 NC1214.2 +005600 OCCURS 6 TIMES NC1214.2 +005700 INDEXED BY INDEX3. NC1214.2 +005800 01 TABLE4. NC1214.2 +005900 02 TABLE4-NUM1 OCCURS 3 TIMES NC1214.2 +006000 INDEXED BY INDEX4-1. NC1214.2 +006100 03 TABLE4-NUM2 PICTURE 99 NC1214.2 +006200 OCCURS 3 TIMES NC1214.2 +006300 INDEXED BY INDEX4-2. NC1214.2 +006400 01 TABLE5. NC1214.2 +006500 02 TABLE5-NUM PIC 9 NC1214.2 +006600 OCCURS 2 TIMES NC1214.2 +006700 INDEXED BY INDEX5. NC1214.2 +006800 01 TABLE6. NC1214.2 +006900 02 TABLE6-REC PICTURE X(10) NC1214.2 +007000 OCCURS 2 TIMES NC1214.2 +007100 INDEXED BY INDEX6. NC1214.2 +007200 01 NUM-9V9 PICTURE 9V9. NC1214.2 +007300 01 TEST-RESULTS. NC1214.2 +007400 02 FILLER PIC X VALUE SPACE. NC1214.2 +007500 02 FEATURE PIC X(20) VALUE SPACE. NC1214.2 +007600 02 FILLER PIC X VALUE SPACE. NC1214.2 +007700 02 P-OR-F PIC X(5) VALUE SPACE. NC1214.2 +007800 02 FILLER PIC X VALUE SPACE. NC1214.2 +007900 02 PAR-NAME. NC1214.2 +008000 03 FILLER PIC X(19) VALUE SPACE. NC1214.2 +008100 03 PARDOT-X PIC X VALUE SPACE. NC1214.2 +008200 03 DOTVALUE PIC 99 VALUE ZERO. NC1214.2 +008300 02 FILLER PIC X(8) VALUE SPACE. NC1214.2 +008400 02 RE-MARK PIC X(61). NC1214.2 +008500 01 TEST-COMPUTED. NC1214.2 +008600 02 FILLER PIC X(30) VALUE SPACE. NC1214.2 +008700 02 FILLER PIC X(17) VALUE NC1214.2 +008800 " COMPUTED=". NC1214.2 +008900 02 COMPUTED-X. NC1214.2 +009000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1214.2 +009100 03 COMPUTED-N REDEFINES COMPUTED-A NC1214.2 +009200 PIC -9(9).9(9). NC1214.2 +009300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1214.2 +009400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1214.2 +009500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1214.2 +009600 03 CM-18V0 REDEFINES COMPUTED-A. NC1214.2 +009700 04 COMPUTED-18V0 PIC -9(18). NC1214.2 +009800 04 FILLER PIC X. NC1214.2 +009900 03 FILLER PIC X(50) VALUE SPACE. NC1214.2 +010000 01 TEST-CORRECT. NC1214.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC1214.2 +010200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1214.2 +010300 02 CORRECT-X. NC1214.2 +010400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1214.2 +010500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1214.2 +010600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1214.2 +010700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1214.2 +010800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1214.2 +010900 03 CR-18V0 REDEFINES CORRECT-A. NC1214.2 +011000 04 CORRECT-18V0 PIC -9(18). NC1214.2 +011100 04 FILLER PIC X. NC1214.2 +011200 03 FILLER PIC X(2) VALUE SPACE. NC1214.2 +011300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1214.2 +011400 01 CCVS-C-1. NC1214.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1214.2 +011600- "SS PARAGRAPH-NAME NC1214.2 +011700- " REMARKS". NC1214.2 +011800 02 FILLER PIC X(20) VALUE SPACE. NC1214.2 +011900 01 CCVS-C-2. NC1214.2 +012000 02 FILLER PIC X VALUE SPACE. NC1214.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". NC1214.2 +012200 02 FILLER PIC X(15) VALUE SPACE. NC1214.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". NC1214.2 +012400 02 FILLER PIC X(94) VALUE SPACE. NC1214.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1214.2 +012600 01 REC-CT PIC 99 VALUE ZERO. NC1214.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1214.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1214.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1214.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1214.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1214.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1214.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1214.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1214.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1214.2 +013600 01 CCVS-H-1. NC1214.2 +013700 02 FILLER PIC X(39) VALUE SPACES. NC1214.2 +013800 02 FILLER PIC X(42) VALUE NC1214.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1214.2 +014000 02 FILLER PIC X(39) VALUE SPACES. NC1214.2 +014100 01 CCVS-H-2A. NC1214.2 +014200 02 FILLER PIC X(40) VALUE SPACE. NC1214.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1214.2 +014400 02 FILLER PIC XXXX VALUE NC1214.2 +014500 "4.2 ". NC1214.2 +014600 02 FILLER PIC X(28) VALUE NC1214.2 +014700 " COPY - NOT FOR DISTRIBUTION". NC1214.2 +014800 02 FILLER PIC X(41) VALUE SPACE. NC1214.2 +014900 NC1214.2 +015000 01 CCVS-H-2B. NC1214.2 +015100 02 FILLER PIC X(15) VALUE NC1214.2 +015200 "TEST RESULT OF ". NC1214.2 +015300 02 TEST-ID PIC X(9). NC1214.2 +015400 02 FILLER PIC X(4) VALUE NC1214.2 +015500 " IN ". NC1214.2 +015600 02 FILLER PIC X(12) VALUE NC1214.2 +015700 " HIGH ". NC1214.2 +015800 02 FILLER PIC X(22) VALUE NC1214.2 +015900 " LEVEL VALIDATION FOR ". NC1214.2 +016000 02 FILLER PIC X(58) VALUE NC1214.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +016200 01 CCVS-H-3. NC1214.2 +016300 02 FILLER PIC X(34) VALUE NC1214.2 +016400 " FOR OFFICIAL USE ONLY ". NC1214.2 +016500 02 FILLER PIC X(58) VALUE NC1214.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1214.2 +016700 02 FILLER PIC X(28) VALUE NC1214.2 +016800 " COPYRIGHT 1985 ". NC1214.2 +016900 01 CCVS-E-1. NC1214.2 +017000 02 FILLER PIC X(52) VALUE SPACE. NC1214.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1214.2 +017200 02 ID-AGAIN PIC X(9). NC1214.2 +017300 02 FILLER PIC X(45) VALUE SPACES. NC1214.2 +017400 01 CCVS-E-2. NC1214.2 +017500 02 FILLER PIC X(31) VALUE SPACE. NC1214.2 +017600 02 FILLER PIC X(21) VALUE SPACE. NC1214.2 +017700 02 CCVS-E-2-2. NC1214.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1214.2 +017900 03 FILLER PIC X VALUE SPACE. NC1214.2 +018000 03 ENDER-DESC PIC X(44) VALUE NC1214.2 +018100 "ERRORS ENCOUNTERED". NC1214.2 +018200 01 CCVS-E-3. NC1214.2 +018300 02 FILLER PIC X(22) VALUE NC1214.2 +018400 " FOR OFFICIAL USE ONLY". NC1214.2 +018500 02 FILLER PIC X(12) VALUE SPACE. NC1214.2 +018600 02 FILLER PIC X(58) VALUE NC1214.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +018800 02 FILLER PIC X(13) VALUE SPACE. NC1214.2 +018900 02 FILLER PIC X(15) VALUE NC1214.2 +019000 " COPYRIGHT 1985". NC1214.2 +019100 01 CCVS-E-4. NC1214.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1214.2 +019300 02 FILLER PIC X(4) VALUE " OF ". NC1214.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1214.2 +019500 02 FILLER PIC X(40) VALUE NC1214.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1214.2 +019700 01 XXINFO. NC1214.2 +019800 02 FILLER PIC X(19) VALUE NC1214.2 +019900 "*** INFORMATION ***". NC1214.2 +020000 02 INFO-TEXT. NC1214.2 +020100 04 FILLER PIC X(8) VALUE SPACE. NC1214.2 +020200 04 XXCOMPUTED PIC X(20). NC1214.2 +020300 04 FILLER PIC X(5) VALUE SPACE. NC1214.2 +020400 04 XXCORRECT PIC X(20). NC1214.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). NC1214.2 +020600 01 HYPHEN-LINE. NC1214.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. NC1214.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************NC1214.2 +020900- "*****************************************". NC1214.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************NC1214.2 +021100- "******************************". NC1214.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE NC1214.2 +021300 "NC121M". NC1214.2 +021400 PROCEDURE DIVISION. NC1214.2 +021500 CCVS1 SECTION. NC1214.2 +021600 OPEN-FILES. NC1214.2 +021700 OPEN OUTPUT PRINT-FILE. NC1214.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1214.2 +021900 MOVE SPACE TO TEST-RESULTS. NC1214.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1214.2 +022100 GO TO CCVS1-EXIT. NC1214.2 +022200 CLOSE-FILES. NC1214.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1214.2 +022400 TERMINATE-CCVS. NC1214.2 +022500S EXIT PROGRAM. NC1214.2 +022600STERMINATE-CALL. NC1214.2 +022700 STOP RUN. NC1214.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1214.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1214.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1214.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1214.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. NC1214.2 +023300 PRINT-DETAIL. NC1214.2 +023400 IF REC-CT NOT EQUAL TO ZERO NC1214.2 +023500 MOVE "." TO PARDOT-X NC1214.2 +023600 MOVE REC-CT TO DOTVALUE. NC1214.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1214.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1214.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1214.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1214.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1214.2 +024200 MOVE SPACE TO CORRECT-X. NC1214.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1214.2 +024400 MOVE SPACE TO RE-MARK. NC1214.2 +024500 HEAD-ROUTINE. NC1214.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1214.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1214.2 +025000 COLUMN-NAMES-ROUTINE. NC1214.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +025400 END-ROUTINE. NC1214.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1214.2 +025600 END-RTN-EXIT. NC1214.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +025800 END-ROUTINE-1. NC1214.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1214.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1214.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. NC1214.2 +026200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1214.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1214.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1214.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1214.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1214.2 +026700 END-ROUTINE-12. NC1214.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1214.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1214.2 +027000 MOVE "NO " TO ERROR-TOTAL NC1214.2 +027100 ELSE NC1214.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1214.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1214.2 +027400 PERFORM WRITE-LINE. NC1214.2 +027500 END-ROUTINE-13. NC1214.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1214.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE NC1214.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1214.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1214.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO NC1214.2 +028200 MOVE "NO " TO ERROR-TOTAL NC1214.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1214.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1214.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028700 WRITE-LINE. NC1214.2 +028800 ADD 1 TO RECORD-COUNT. NC1214.2 +028900Y IF RECORD-COUNT GREATER 42 NC1214.2 +029000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1214.2 +029100Y MOVE SPACE TO DUMMY-RECORD NC1214.2 +029200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1214.2 +029300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1214.2 +029400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1214.2 +029500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1214.2 +029600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1214.2 +029700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +029800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +029900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +030000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1214.2 +030100Y MOVE ZERO TO RECORD-COUNT. NC1214.2 +030200 PERFORM WRT-LN. NC1214.2 +030300 WRT-LN. NC1214.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1214.2 +030500 MOVE SPACE TO DUMMY-RECORD. NC1214.2 +030600 BLANK-LINE-PRINT. NC1214.2 +030700 PERFORM WRT-LN. NC1214.2 +030800 FAIL-ROUTINE. NC1214.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE NC1214.2 +031000 GO TO FAIL-ROUTINE-WRITE. NC1214.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1214.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1214.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1214.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1214.2 +031600 GO TO FAIL-ROUTINE-EX. NC1214.2 +031700 FAIL-ROUTINE-WRITE. NC1214.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1214.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1214.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1214.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1214.2 +032200 FAIL-ROUTINE-EX. EXIT. NC1214.2 +032300 BAIL-OUT. NC1214.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1214.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1214.2 +032600 BAIL-OUT-WRITE. NC1214.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1214.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1214.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1214.2 +033100 BAIL-OUT-EX. EXIT. NC1214.2 +033200 CCVS1-EXIT. NC1214.2 +033300 EXIT. NC1214.2 +033400 SECT-NC121M-001 SECTION. NC1214.2 +033500 BUILD-TABLE1. NC1214.2 +033600 MOVE 4.00 TO TABLE1-NUM (1). NC1214.2 +033700 MOVE 1.34 TO TABLE1-NUM (2). NC1214.2 +033800 MOVE 7.00 TO TABLE1-NUM (3). NC1214.2 +033900 MOVE 3.00 TO TABLE1-NUM (4). NC1214.2 +034000 MOVE 2.00 TO TABLE1-NUM (5). NC1214.2 +034100 MOVE 1.50 TO TABLE1-NUM (6). NC1214.2 +034200 MOVE 3.50 TO TABLE1-NUM (7). NC1214.2 +034300 MOVE 0.00 TO TABLE1-NUM (8). NC1214.2 +034400 MOVE 5.00 TO TABLE1-NUM (9). NC1214.2 +034500 MOVE -9.00 TO TABLE1-NUM (10). NC1214.2 +034600 BUILD-TABLE2. NC1214.2 +034700 MOVE 1.0 TO TABLE2-NUM (1). NC1214.2 +034800 MOVE 6.0 TO TABLE2-NUM (2). NC1214.2 +034900 MOVE 3.0 TO TABLE2-NUM (3). NC1214.2 +035000 MOVE 2.0 TO TABLE2-NUM (4). NC1214.2 +035100 MOVE 9.7 TO TABLE2-NUM (5). NC1214.2 +035200 MOVE 1.2 TO TABLE2-NUM (6). NC1214.2 +035300 BUILD-TABLE4. NC1214.2 +035400 MOVE 01 TO TABLE4-NUM2 (1 1). NC1214.2 +035500 MOVE 02 TO TABLE4-NUM2 (1 2). NC1214.2 +035600 MOVE 03 TO TABLE4-NUM2 (1 3). NC1214.2 +035700 MOVE 12 TO TABLE4-NUM2 (2 1). NC1214.2 +035800 MOVE 24 TO TABLE4-NUM2 (2 2). NC1214.2 +035900 MOVE 25 TO TABLE4-NUM2 (2 3). NC1214.2 +036000 MOVE 14 TO TABLE4-NUM2 (3 1). NC1214.2 +036100 MOVE 15 TO TABLE4-NUM2 (3 2). NC1214.2 +036200 MOVE 16 TO TABLE4-NUM2 (3 3). NC1214.2 +036300 BUILD-TABLE5. NC1214.2 +036400 MOVE 3 TO TABLE5-NUM (1). NC1214.2 +036500 MOVE 2 TO TABLE5-NUM (2). NC1214.2 +036600 BUILD-TABLE6. NC1214.2 +036700 MOVE "LITERAL-01" TO TABLE6-REC (1). NC1214.2 +036800 MOVE "0123456789" TO TABLE6-REC (2). NC1214.2 +036900 IND-INIT-GF-1. NC1214.2 +037000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +037100 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +037200 MOVE 2.0 TO NUM-9V9. NC1214.2 +037300 SET INDEX1 TO 1. NC1214.2 +037400 IND-TEST-GF-1-0. NC1214.2 +037500 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9. NC1214.2 +037600 IND-TEST-GF-1-1. NC1214.2 +037700 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +037800 PERFORM PASS NC1214.2 +037900 ELSE GO TO IND-FAIL-GF-1. NC1214.2 +038000 GO TO IND-WRITE-GF-1. NC1214.2 +038100 IND-DELETE-GF-1. NC1214.2 +038200 PERFORM DE-LETE. NC1214.2 +038300 GO TO IND-WRITE-GF-1. NC1214.2 +038400 IND-FAIL-GF-1. NC1214.2 +038500 PERFORM FAIL. NC1214.2 +038600 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +038700 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +038800 IND-WRITE-GF-1. NC1214.2 +038900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1214.2 +039000 PERFORM PRINT-DETAIL. NC1214.2 +039100 IND-INIT-GF-2. NC1214.2 +039200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +039300 MOVE "MULTIPLY ROUNDED" TO FEATURE. NC1214.2 +039400 MOVE 4.0 TO NUM-9V9. NC1214.2 +039500 SET INDEX1 TO 2. NC1214.2 +039600 IND-TEST-GF-2-0. NC1214.2 +039700 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9 ROUNDED. NC1214.2 +039800 IND-TEST-GF-2-1. NC1214.2 +039900 IF NUM-9V9 EQUAL TO 5.4 NC1214.2 +040000 PERFORM PASS NC1214.2 +040100 ELSE GO TO IND-FAIL-GF-2. NC1214.2 +040200 GO TO IND-WRITE-GF-2. NC1214.2 +040300 IND-DELETE-GF-2. NC1214.2 +040400 PERFORM DE-LETE. NC1214.2 +040500 GO TO IND-WRITE-GF-2. NC1214.2 +040600 IND-FAIL-GF-2. NC1214.2 +040700 PERFORM FAIL. NC1214.2 +040800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +040900 MOVE 5.4 TO CORRECT-14V4. NC1214.2 +041000 IND-WRITE-GF-2. NC1214.2 +041100 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1214.2 +041200 PERFORM PRINT-DETAIL. NC1214.2 +041300 IND-INIT-GF-3. NC1214.2 +041400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +041500 MOVE "MULTIPLY ON SIZE ERR" TO FEATURE. NC1214.2 +041600 MOVE 6.0 TO NUM-9V9. NC1214.2 +041700 SET INDEX1 TO 3. NC1214.2 +041800 IND-TEST-GF-3-1. NC1214.2 +041900 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9 ON SIZE ERROR NC1214.2 +042000 PERFORM PASS NC1214.2 +042100 GO TO IND-WRITE-GF-3-1. NC1214.2 +042200 GO TO IND-FAIL-GF-3-1. NC1214.2 +042300 IND-DELETE-GF-3-1. NC1214.2 +042400 PERFORM DE-LETE. NC1214.2 +042500 GO TO IND-WRITE-GF-3-1. NC1214.2 +042600 IND-FAIL-GF-3-1. NC1214.2 +042700 PERFORM FAIL. NC1214.2 +042800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +042900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +043000 IND-WRITE-GF-3-1. NC1214.2 +043100 MOVE "IND-TEST-GF-3-1" TO PAR-NAME. NC1214.2 +043200 PERFORM PRINT-DETAIL. NC1214.2 +043300 IND-TEST-GF-3-2. NC1214.2 +043400 IF NUM-9V9 = 6.0 NC1214.2 +043500 PERFORM PASS NC1214.2 +043600 GO TO IND-WRITE-GF-3-2. NC1214.2 +043700 GO TO IND-FAIL-GF-3-2. NC1214.2 +043800 IND-DELETE-GF-3-2. NC1214.2 +043900 PERFORM DE-LETE. NC1214.2 +044000 GO TO IND-WRITE-GF-3-2. NC1214.2 +044100 IND-FAIL-GF-3-2. NC1214.2 +044200 PERFORM FAIL. NC1214.2 +044300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +044400 MOVE 6.0 TO CORRECT-14V4. NC1214.2 +044500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +044600 IND-WRITE-GF-3-2. NC1214.2 +044700 MOVE "IND-TEST-GF-3-2" TO PAR-NAME. NC1214.2 +044800 PERFORM PRINT-DETAIL. NC1214.2 +044900 IND-INIT-GF-4. NC1214.2 +045000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +045100 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +045200 SET INDEX1 TO 1. NC1214.2 +045300 SET INDEX2 TO 1. NC1214.2 +045400 IND-TEST-GF-4-0. NC1214.2 +045500 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2). NC1214.2 +045600 IND-TEST-GF-4-1. NC1214.2 +045700 IF TABLE2-NUM (INDEX2) EQUAL TO 4.0 NC1214.2 +045800 PERFORM PASS NC1214.2 +045900 ELSE GO TO IND-FAIL-GF-4. NC1214.2 +046000 GO TO IND-WRITE-GF-4. NC1214.2 +046100 IND-DELETE-GF-4. NC1214.2 +046200 PERFORM DE-LETE. NC1214.2 +046300 GO TO IND-WRITE-GF-4. NC1214.2 +046400 IND-FAIL-GF-4. NC1214.2 +046500 PERFORM FAIL. NC1214.2 +046600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +046700 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +046800 IND-WRITE-GF-4. NC1214.2 +046900 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1214.2 +047000 PERFORM PRINT-DETAIL. NC1214.2 +047100 IND-INIT-GF-5. NC1214.2 +047200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +047300 MOVE "MULTIPLY ROUNDED" TO FEATURE. NC1214.2 +047400 PERFORM BUILD-TABLE2. NC1214.2 +047500 SET INDEX1 TO 2. NC1214.2 +047600 SET INDEX2 TO 2. NC1214.2 +047700 IND-TEST-GF-5-0. NC1214.2 +047800 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) ROUNDED. NC1214.2 +047900 IND-TEST-GF-5-1. NC1214.2 +048000 IF TABLE2-NUM (INDEX2) EQUAL TO 8.0 NC1214.2 +048100 PERFORM PASS NC1214.2 +048200 ELSE GO TO IND-FAIL-GF-5. NC1214.2 +048300 GO TO IND-WRITE-GF-5. NC1214.2 +048400 IND-DELETE-GF-5. NC1214.2 +048500 PERFORM DE-LETE. NC1214.2 +048600 GO TO IND-WRITE-GF-5. NC1214.2 +048700 IND-FAIL-GF-5. NC1214.2 +048800 PERFORM FAIL. NC1214.2 +048900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +049000 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +049100 IND-WRITE-GF-5. NC1214.2 +049200 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1214.2 +049300 PERFORM PRINT-DETAIL. NC1214.2 +049400 IND-INIT-GF-6. NC1214.2 +049500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +049600 MOVE "MULTIPLY ON SIZE ERR" TO FEATURE. NC1214.2 +049700 PERFORM BUILD-TABLE2. NC1214.2 +049800 SET INDEX1 TO 3. NC1214.2 +049900 SET INDEX2 TO 3. NC1214.2 +050000 IND-TEST-GF-6-1. NC1214.2 +050100 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +050200 ON SIZE ERROR NC1214.2 +050300 PERFORM PASS NC1214.2 +050400 GO TO IND-WRITE-GF-6-1. NC1214.2 +050500 GO TO IND-FAIL-GF-6-1. NC1214.2 +050600 IND-DELETE-GF-6-1. NC1214.2 +050700 PERFORM DE-LETE. NC1214.2 +050800 GO TO IND-WRITE-GF-6-1. NC1214.2 +050900 IND-FAIL-GF-6-1. NC1214.2 +051000 PERFORM FAIL. NC1214.2 +051100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +051200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +051300 IND-WRITE-GF-6-1. NC1214.2 +051400 MOVE "IND-TEST-GF-6-1" TO PAR-NAME. NC1214.2 +051500 PERFORM PRINT-DETAIL. NC1214.2 +051600 IND-TEST-GF-6-2. NC1214.2 +051700 IF TABLE2-NUM (INDEX2) = 3.0 NC1214.2 +051800 PERFORM PASS NC1214.2 +051900 GO TO IND-WRITE-GF-6-2. NC1214.2 +052000 GO TO IND-FAIL-GF-6-2. NC1214.2 +052100 IND-DELETE-GF-6-2. NC1214.2 +052200 PERFORM DE-LETE. NC1214.2 +052300 GO TO IND-WRITE-GF-6-2. NC1214.2 +052400 IND-FAIL-GF-6-2. NC1214.2 +052500 PERFORM FAIL. NC1214.2 +052600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +052700 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +052800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +052900 IND-WRITE-GF-6-2. NC1214.2 +053000 MOVE "IND-TEST-GF-6-2" TO PAR-NAME. NC1214.2 +053100 PERFORM PRINT-DETAIL. NC1214.2 +053200 IND-INIT-GF-7. NC1214.2 +053300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +053400 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +053500 PERFORM BUILD-TABLE2. NC1214.2 +053600 MOVE ZERO TO NUM-9V9. NC1214.2 +053700 SET INDEX1 TO 1. NC1214.2 +053800 IND-TEST-GF-7-0. NC1214.2 +053900 MULTIPLY 2 BY TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +054000 IND-TEST-GF-7-1. NC1214.2 +054100 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +054200 PERFORM PASS NC1214.2 +054300 ELSE GO TO IND-FAIL-GF-7. NC1214.2 +054400 GO TO IND-WRITE-GF-7. NC1214.2 +054500 IND-DELETE-GF-7. NC1214.2 +054600 PERFORM DE-LETE. NC1214.2 +054700 GO TO IND-WRITE-GF-7. NC1214.2 +054800 IND-FAIL-GF-7. NC1214.2 +054900 PERFORM FAIL. NC1214.2 +055000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +055100 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +055200 IND-WRITE-GF-7. NC1214.2 +055300 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1214.2 +055400 PERFORM PRINT-DETAIL. NC1214.2 +055500 IND-INIT-GF-8. NC1214.2 +055600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +055700 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +055800 PERFORM BUILD-TABLE2. NC1214.2 +055900 MOVE ZERO TO NUM-9V9. NC1214.2 +056000 SET INDEX1 TO 4. NC1214.2 +056100 SET INDEX2 TO 4. NC1214.2 +056200 IND-TEST-GF-8-0. NC1214.2 +056300 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +056400 GIVING NUM-9V9. NC1214.2 +056500 IND-TEST-GF-8-1. NC1214.2 +056600 IF NUM-9V9 EQUAL TO 6.0 NC1214.2 +056700 PERFORM PASS NC1214.2 +056800 ELSE GO TO IND-FAIL-GF-8. NC1214.2 +056900 GO TO IND-WRITE-GF-8. NC1214.2 +057000 IND-DELETE-GF-8. NC1214.2 +057100 PERFORM DE-LETE. NC1214.2 +057200 GO TO IND-WRITE-GF-8. NC1214.2 +057300 IND-FAIL-GF-8. NC1214.2 +057400 PERFORM FAIL. NC1214.2 +057500 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +057600 MOVE 6.0 TO CORRECT-14V4. NC1214.2 +057700 IND-WRITE-GF-8. NC1214.2 +057800 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1214.2 +057900 PERFORM PRINT-DETAIL. NC1214.2 +058000 IND-INIT-GF-9. NC1214.2 +058100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +058200 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +058300 PERFORM BUILD-TABLE2. NC1214.2 +058400 MOVE ZERO TO TABLE3. NC1214.2 +058500 SET INDEX1 TO 3. NC1214.2 +058600 SET INDEX2 TO 2. NC1214.2 +058700 SET INDEX3 TO 1. NC1214.2 +058800 IND-TEST-GF-9-0. NC1214.2 +058900 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +059000 GIVING TABLE3-NUM (INDEX3). NC1214.2 +059100 IND-TEST-GF-9-1. NC1214.2 +059200 IF TABLE3-NUM (INDEX3) EQUAL TO 42.0 NC1214.2 +059300 PERFORM PASS NC1214.2 +059400 ELSE GO TO IND-FAIL-GF-9. NC1214.2 +059500 GO TO IND-WRITE-GF-9. NC1214.2 +059600 IND-DELETE-GF-9. NC1214.2 +059700 PERFORM DE-LETE. NC1214.2 +059800 GO TO IND-WRITE-GF-9. NC1214.2 +059900 IND-FAIL-GF-9. NC1214.2 +060000 PERFORM FAIL. NC1214.2 +060100 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +060200 MOVE 42.0 TO CORRECT-14V4. NC1214.2 +060300 IND-WRITE-GF-9. NC1214.2 +060400 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1214.2 +060500 PERFORM PRINT-DETAIL. NC1214.2 +060600 IND-INIT-GF-10. NC1214.2 +060700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +060800 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +060900 MOVE 2.0 TO NUM-9V9. NC1214.2 +061000 SET INDEX1 TO 3. NC1214.2 +061100 IND-TEST-GF-10-0. NC1214.2 +061200 MULTIPLY TABLE1-NUM (INDEX1 - 2) BY NUM-9V9. NC1214.2 +061300 IND-TEST-GF-10-1. NC1214.2 +061400 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +061500 PERFORM PASS NC1214.2 +061600 ELSE GO TO IND-FAIL-GF-10. NC1214.2 +061700 GO TO IND-WRITE-GF-10. NC1214.2 +061800 IND-DELETE-GF-10. NC1214.2 +061900 PERFORM DE-LETE. NC1214.2 +062000 GO TO IND-WRITE-GF-10. NC1214.2 +062100 IND-FAIL-GF-10. NC1214.2 +062200 PERFORM FAIL. NC1214.2 +062300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +062400 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +062500 IND-WRITE-GF-10. NC1214.2 +062600 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1214.2 +062700 PERFORM PRINT-DETAIL. NC1214.2 +062800 IND-INIT-GF-11. NC1214.2 +062900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +063000 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +063100 PERFORM BUILD-TABLE2. NC1214.2 +063200 SET INDEX1 TO 2. NC1214.2 +063300 SET INDEX2 TO 5. NC1214.2 +063400 IND-TEST-GF-11-0. NC1214.2 +063500 MULTIPLY TABLE1-NUM (INDEX1 - 1) BY TABLE2-NUM (INDEX2 + 1). NC1214.2 +063600 IND-TEST-GF-11-1. NC1214.2 +063700 IF TABLE2-NUM (INDEX2 + 1) EQUAL TO 4.8 NC1214.2 +063800 PERFORM PASS NC1214.2 +063900 ELSE GO TO IND-FAIL-GF-11. NC1214.2 +064000 GO TO IND-WRITE-GF-11. NC1214.2 +064100 IND-DELETE-GF-11. NC1214.2 +064200 PERFORM DE-LETE. NC1214.2 +064300 GO TO IND-WRITE-GF-11. NC1214.2 +064400 IND-FAIL-GF-11. NC1214.2 +064500 PERFORM FAIL. NC1214.2 +064600 MOVE TABLE2-NUM (INDEX2 + 1) TO COMPUTED-14V4. NC1214.2 +064700 MOVE 4.8 TO CORRECT-14V4. NC1214.2 +064800 IND-WRITE-GF-11. NC1214.2 +064900 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1214.2 +065000 PERFORM PRINT-DETAIL. NC1214.2 +065100 IND-INIT-GF-12. NC1214.2 +065200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +065300 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +065400 PERFORM BUILD-TABLE2. NC1214.2 +065500 MOVE ZERO TO NUM-9V9. NC1214.2 +065600 SET INDEX1 TO 6. NC1214.2 +065700 SET INDEX2 TO 3. NC1214.2 +065800 IND-TEST-GF-12-0. NC1214.2 +065900 MULTIPLY TABLE1-NUM (INDEX1 - 2) BY TABLE2-NUM (INDEX2 - 2) NC1214.2 +066000 GIVING NUM-9V9. NC1214.2 +066100 IND-TEST-GF-12-1. NC1214.2 +066200 IF NUM-9V9 EQUAL TO 3.0 NC1214.2 +066300 PERFORM PASS NC1214.2 +066400 ELSE GO TO IND-FAIL-GF-12. NC1214.2 +066500 GO TO IND-WRITE-GF-12. NC1214.2 +066600 IND-DELETE-GF-12. NC1214.2 +066700 PERFORM DE-LETE. NC1214.2 +066800 GO TO IND-WRITE-GF-12. NC1214.2 +066900 IND-FAIL-GF-12. NC1214.2 +067000 PERFORM FAIL. NC1214.2 +067100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +067200 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +067300 IND-WRITE-GF-12. NC1214.2 +067400 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1214.2 +067500 PERFORM PRINT-DETAIL. NC1214.2 +067600 IND-INIT-GF-13. NC1214.2 +067700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +067800 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +067900 PERFORM BUILD-TABLE2. NC1214.2 +068000 MOVE ZERO TO TABLE3. NC1214.2 +068100 SET INDEX1 TO 1. NC1214.2 +068200 SET INDEX2 TO 3. NC1214.2 +068300 SET INDEX3 TO 1. NC1214.2 +068400 IND-TEST-GF-13-0. NC1214.2 +068500 MULTIPLY TABLE1-NUM (INDEX1 + 2) BY TABLE2-NUM (INDEX2 - 1) NC1214.2 +068600 GIVING TABLE3-NUM (INDEX3 + 1). NC1214.2 +068700 IND-TEST-GF-13-1. NC1214.2 +068800 IF TABLE3-NUM (INDEX3 + 1) EQUAL TO 42.0 NC1214.2 +068900 PERFORM PASS NC1214.2 +069000 ELSE GO TO IND-FAIL-GF-13. NC1214.2 +069100 GO TO IND-WRITE-GF-13. NC1214.2 +069200 IND-DELETE-GF-13. NC1214.2 +069300 PERFORM DE-LETE. NC1214.2 +069400 GO TO IND-WRITE-GF-13. NC1214.2 +069500 IND-FAIL-GF-13. NC1214.2 +069600 PERFORM FAIL. NC1214.2 +069700 MOVE TABLE3-NUM (INDEX3 + 1) TO COMPUTED-14V4. NC1214.2 +069800 MOVE 42.0 TO CORRECT-14V4. NC1214.2 +069900 IND-WRITE-GF-13. NC1214.2 +070000 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1214.2 +070100 PERFORM PRINT-DETAIL. NC1214.2 +070200 IND-INIT-GF-14. NC1214.2 +070300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +070400 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +070500 MOVE 9.0 TO NUM-9V9. NC1214.2 +070600 SET INDEX1 TO 4. NC1214.2 +070700 IND-TEST-GF-14-0. NC1214.2 +070800 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9. NC1214.2 +070900 IND-TEST-GF-14-1. NC1214.2 +071000 IF NUM-9V9 EQUAL TO 3.0 NC1214.2 +071100 PERFORM PASS NC1214.2 +071200 GO TO IND-WRITE-GF-14. NC1214.2 +071300 GO TO IND-FAIL-GF-14. NC1214.2 +071400 IND-DELETE-GF-14. NC1214.2 +071500 PERFORM DE-LETE. NC1214.2 +071600 GO TO IND-WRITE-GF-14. NC1214.2 +071700 IND-FAIL-GF-14. NC1214.2 +071800 PERFORM FAIL. NC1214.2 +071900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +072000 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +072100 IND-WRITE-GF-14. NC1214.2 +072200 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1214.2 +072300 PERFORM PRINT-DETAIL. NC1214.2 +072400 IND-INIT-GF-15. NC1214.2 +072500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +072600 MOVE "DIVIDE ROUNDED" TO FEATURE. NC1214.2 +072700 MOVE 8.1 TO NUM-9V9. NC1214.2 +072800 SET INDEX1 TO 9. NC1214.2 +072900 IND-TEST-GF-15-0. NC1214.2 +073000 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9 ROUNDED. NC1214.2 +073100 IND-TEST-GF-15-1. NC1214.2 +073200 IF NUM-9V9 EQUAL TO 1.6 NC1214.2 +073300 PERFORM PASS NC1214.2 +073400 GO TO IND-WRITE-GF-15. NC1214.2 +073500 GO TO IND-FAIL-GF-15. NC1214.2 +073600 IND-DELETE-GF-15. NC1214.2 +073700 PERFORM DE-LETE. NC1214.2 +073800 GO TO IND-WRITE-GF-15. NC1214.2 +073900 IND-FAIL-GF-15. NC1214.2 +074000 PERFORM FAIL. NC1214.2 +074100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +074200 MOVE 1.6 TO CORRECT-14V4. NC1214.2 +074300 IND-WRITE-GF-15. NC1214.2 +074400 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1214.2 +074500 PERFORM PRINT-DETAIL. NC1214.2 +074600 IND-INIT-GF-16. NC1214.2 +074700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +074800 MOVE "DIVIDE ON SIZE ERROR" TO FEATURE. NC1214.2 +074900 MOVE 9.9 TO NUM-9V9. NC1214.2 +075000 SET INDEX1 TO 8. NC1214.2 +075100 IND-TEST-GF-16-1. NC1214.2 +075200 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9 ON SIZE ERROR NC1214.2 +075300 PERFORM PASS NC1214.2 +075400 GO TO IND-WRITE-GF-16-1. NC1214.2 +075500 GO TO IND-FAIL-GF-16-1. NC1214.2 +075600 IND-DELETE-GF-16-1. NC1214.2 +075700 PERFORM DE-LETE. NC1214.2 +075800 GO TO IND-WRITE-GF-16-1. NC1214.2 +075900 IND-FAIL-GF-16-1. NC1214.2 +076000 PERFORM FAIL. NC1214.2 +076100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +076200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1214.2 +076300 IND-WRITE-GF-16-1. NC1214.2 +076400 MOVE "IND-TEST-GF-16-1" TO PAR-NAME. NC1214.2 +076500 PERFORM PRINT-DETAIL. NC1214.2 +076600 IND-TEST-GF-16-2. NC1214.2 +076700 MOVE 9.9 TO NUM-9V9. NC1214.2 +076800 IF NUM-9V9 = 9.9 NC1214.2 +076900 PERFORM PASS NC1214.2 +077000 GO TO IND-WRITE-GF-16-2. NC1214.2 +077100 GO TO IND-FAIL-GF-16-2. NC1214.2 +077200 IND-DELETE-GF-16-2. NC1214.2 +077300 PERFORM DE-LETE. NC1214.2 +077400 GO TO IND-WRITE-GF-16-2. NC1214.2 +077500 IND-FAIL-GF-16-2. NC1214.2 +077600 PERFORM FAIL. NC1214.2 +077700 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +077800 MOVE 9.9 TO CORRECT-14V4. NC1214.2 +077900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +078000 IND-WRITE-GF-16-2. NC1214.2 +078100 MOVE "IND-TEST-GF-16-2" TO PAR-NAME. NC1214.2 +078200 PERFORM PRINT-DETAIL. NC1214.2 +078300 IND-INIT-GF-17. NC1214.2 +078400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +078500 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +078600 PERFORM BUILD-TABLE2. NC1214.2 +078700 SET INDEX1 TO 4. NC1214.2 +078800 SET INDEX2 TO 2. NC1214.2 +078900 IND-TEST-GF-17-0. NC1214.2 +079000 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2). NC1214.2 +079100 IND-TEST-GF-17-1. NC1214.2 +079200 IF TABLE2-NUM (INDEX2) EQUAL TO 2.0 NC1214.2 +079300 PERFORM PASS NC1214.2 +079400 GO TO IND-WRITE-GF-17. NC1214.2 +079500 GO TO IND-FAIL-GF-17. NC1214.2 +079600 IND-DELETE-GF-17. NC1214.2 +079700 PERFORM DE-LETE. NC1214.2 +079800 GO TO IND-WRITE-GF-17. NC1214.2 +079900 IND-FAIL-GF-17. NC1214.2 +080000 PERFORM FAIL. NC1214.2 +080100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +080200 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +080300 IND-WRITE-GF-17. NC1214.2 +080400 MOVE "IND-TEST-GF-17" TO PAR-NAME. NC1214.2 +080500 PERFORM PRINT-DETAIL. NC1214.2 +080600 IND-INIT-GF-18. NC1214.2 +080700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +080800 MOVE "DIVIDE ROUNDED" TO FEATURE. NC1214.2 +080900 PERFORM BUILD-TABLE2. NC1214.2 +081000 SET INDEX1 TO 9. NC1214.2 +081100 SET INDEX2 TO 5. NC1214.2 +081200 IND-TEST-GF-18-0. NC1214.2 +081300 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) ROUNDED. NC1214.2 +081400 IND-TEST-GF-18-1. NC1214.2 +081500 IF TABLE2-NUM (INDEX2) EQUAL TO 1.9 NC1214.2 +081600 PERFORM PASS NC1214.2 +081700 GO TO IND-WRITE-GF-18. NC1214.2 +081800 GO TO IND-FAIL-GF-18. NC1214.2 +081900 IND-DELETE-GF-18. NC1214.2 +082000 PERFORM DE-LETE. NC1214.2 +082100 GO TO IND-WRITE-GF-18. NC1214.2 +082200 IND-FAIL-GF-18. NC1214.2 +082300 PERFORM FAIL. NC1214.2 +082400 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +082500 MOVE 1.9 TO CORRECT-14V4. NC1214.2 +082600 IND-WRITE-GF-18. NC1214.2 +082700 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1214.2 +082800 PERFORM PRINT-DETAIL. NC1214.2 +082900 IND-INIT-GF-19. NC1214.2 +083000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +083100 MOVE "DIVIDE ON SIZE ERROR" TO FEATURE. NC1214.2 +083200 PERFORM BUILD-TABLE2. NC1214.2 +083300 SET INDEX1 TO 8. NC1214.2 +083400 SET INDEX2 TO 5. NC1214.2 +083500 IND-TEST-GF-19-1. NC1214.2 +083600 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +083700 ON SIZE ERROR NC1214.2 +083800 PERFORM PASS NC1214.2 +083900 GO TO IND-WRITE-GF-19-1. NC1214.2 +084000 GO TO IND-FAIL-GF-19-1. NC1214.2 +084100 IND-DELETE-GF-19-1. NC1214.2 +084200 PERFORM DE-LETE. NC1214.2 +084300 GO TO IND-WRITE-GF-19-1. NC1214.2 +084400 IND-FAIL-GF-19-1. NC1214.2 +084500 PERFORM FAIL. NC1214.2 +084600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +084700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +084800 IND-WRITE-GF-19-1. NC1214.2 +084900 MOVE "IND-TEST-GF-19-1" TO PAR-NAME. NC1214.2 +085000 PERFORM PRINT-DETAIL. NC1214.2 +085100 IND-TEST-GF-19-2. NC1214.2 +085200 IF TABLE2-NUM (INDEX2) = 9.7 NC1214.2 +085300 PERFORM PASS NC1214.2 +085400 GO TO IND-WRITE-GF-19-2. NC1214.2 +085500 GO TO IND-FAIL-GF-19-2. NC1214.2 +085600 IND-DELETE-GF-19-2. NC1214.2 +085700 PERFORM DE-LETE. NC1214.2 +085800 GO TO IND-WRITE-GF-19-2. NC1214.2 +085900 IND-FAIL-GF-19-2. NC1214.2 +086000 PERFORM FAIL. NC1214.2 +086100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +086200 MOVE 9.7 TO CORRECT-14V4. NC1214.2 +086300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +086400 IND-WRITE-GF-19-2. NC1214.2 +086500 MOVE "IND-TEST-GF-19-2" TO PAR-NAME. NC1214.2 +086600 PERFORM PRINT-DETAIL. NC1214.2 +086700 IND-INIT-GF-22. NC1214.2 +086800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +086900 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +087000 MOVE ZERO TO NUM-9V9. NC1214.2 +087100 SET INDEX1 TO 4. NC1214.2 +087200 IND-TEST-GF-22-0. NC1214.2 +087300 DIVIDE 3 INTO TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +087400 IND-TEST-GF-22-1. NC1214.2 +087500 IF NUM-9V9 EQUAL TO 1.0 NC1214.2 +087600 PERFORM PASS NC1214.2 +087700 GO TO IND-WRITE-GF-22. NC1214.2 +087800 GO TO IND-FAIL-GF-22. NC1214.2 +087900 IND-DELETE-GF-22. NC1214.2 +088000 PERFORM DE-LETE. NC1214.2 +088100 GO TO IND-WRITE-GF-22. NC1214.2 +088200 IND-FAIL-GF-22. NC1214.2 +088300 PERFORM FAIL. NC1214.2 +088400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +088500 MOVE 1.0 TO CORRECT-14V4. NC1214.2 +088600 IND-WRITE-GF-22. NC1214.2 +088700 MOVE "IND-TEST-GF-22" TO PAR-NAME. NC1214.2 +088800 PERFORM PRINT-DETAIL. NC1214.2 +088900 IND-INIT-GF-23. NC1214.2 +089000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +089100 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +089200 PERFORM BUILD-TABLE2. NC1214.2 +089300 MOVE ZERO TO NUM-9V9. NC1214.2 +089400 SET INDEX1 TO 4. NC1214.2 +089500 SET INDEX2 TO 2. NC1214.2 +089600 IND-TEST-GF-23-0. NC1214.2 +089700 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +089800 GIVING NUM-9V9. NC1214.2 +089900 IND-TEST-GF-23-1. NC1214.2 +090000 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +090100 PERFORM PASS NC1214.2 +090200 GO TO IND-WRITE-GF-23. NC1214.2 +090300 GO TO IND-FAIL-GF-23. NC1214.2 +090400 IND-DELETE-GF-23. NC1214.2 +090500 PERFORM DE-LETE. NC1214.2 +090600 GO TO IND-WRITE-GF-23. NC1214.2 +090700 IND-FAIL-GF-23. NC1214.2 +090800 PERFORM FAIL. NC1214.2 +090900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +091000 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +091100 IND-WRITE-GF-23. NC1214.2 +091200 MOVE "IND-TEST-GF-23" TO PAR-NAME. NC1214.2 +091300 PERFORM PRINT-DETAIL. NC1214.2 +091400 IND-INIT-GF-24. NC1214.2 +091500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +091600 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +091700 PERFORM BUILD-TABLE2. NC1214.2 +091800 MOVE ZERO TO TABLE3. NC1214.2 +091900 SET INDEX1 TO 4. NC1214.2 +092000 SET INDEX2 TO 2. NC1214.2 +092100 SET INDEX3 TO 3. NC1214.2 +092200 IND-TEST-GF-24-0. NC1214.2 +092300 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +092400 GIVING TABLE3-NUM (INDEX3). NC1214.2 +092500 IND-TEST-GF-24-1. NC1214.2 +092600 IF TABLE3-NUM (INDEX3) EQUAL TO 2.0 NC1214.2 +092700 PERFORM PASS NC1214.2 +092800 GO TO IND-WRITE-GF-24. NC1214.2 +092900 GO TO IND-FAIL-GF-24. NC1214.2 +093000 IND-DELETE-GF-24. NC1214.2 +093100 PERFORM DE-LETE. NC1214.2 +093200 GO TO IND-WRITE-GF-24. NC1214.2 +093300 IND-FAIL-GF-24. NC1214.2 +093400 PERFORM FAIL. NC1214.2 +093500 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +093600 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +093700 IND-WRITE-GF-24. NC1214.2 +093800 MOVE "IND-TEST-GF-24" TO PAR-NAME. NC1214.2 +093900 PERFORM PRINT-DETAIL. NC1214.2 +094000 IND-INIT-GF-25. NC1214.2 +094100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +094200 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +094300 PERFORM BUILD-TABLE4. NC1214.2 +094400 SET INDEX4-1 TO 3. NC1214.2 +094500 SET INDEX4-2 TO 1. NC1214.2 +094600 IND-TEST-GF-25-0. NC1214.2 +094700 DIVIDE TABLE4-NUM2 (1 2) INTO NC1214.2 +094800 TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1214.2 +094900 IND-TEST-GF-25-1. NC1214.2 +095000 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 7 NC1214.2 +095100 PERFORM PASS NC1214.2 +095200 GO TO IND-WRITE-GF-25. NC1214.2 +095300 GO TO IND-FAIL-GF-25. NC1214.2 +095400 IND-DELETE-GF-25. NC1214.2 +095500 PERFORM DE-LETE. NC1214.2 +095600 GO TO IND-WRITE-GF-25. NC1214.2 +095700 IND-FAIL-GF-25. NC1214.2 +095800 PERFORM FAIL. NC1214.2 +095900 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1214.2 +096000 MOVE 7 TO CORRECT-14V4. NC1214.2 +096100 IND-WRITE-GF-25. NC1214.2 +096200 MOVE "IND-TEST-GF-25" TO PAR-NAME. NC1214.2 +096300 PERFORM PRINT-DETAIL. NC1214.2 +096400 IND-INIT-GF-20. NC1214.2 +096500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +096600 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +096700 MOVE 9.5 TO NUM-9V9. NC1214.2 +096800 SET INDEX1 TO 8. NC1214.2 +096900 IND-TEST-GF-20-0. NC1214.2 +097000 DIVIDE TABLE1-NUM (INDEX1 + 1) INTO NUM-9V9. NC1214.2 +097100 IND-TEST-GF-20-1. NC1214.2 +097200 IF NUM-9V9 EQUAL TO 1.9 NC1214.2 +097300 PERFORM PASS NC1214.2 +097400 GO TO IND-WRITE-GF-20. NC1214.2 +097500 GO TO IND-FAIL-GF-20. NC1214.2 +097600 IND-DELETE-GF-20. NC1214.2 +097700 PERFORM DE-LETE. NC1214.2 +097800 GO TO IND-WRITE-GF-20. NC1214.2 +097900 IND-FAIL-GF-20. NC1214.2 +098000 PERFORM FAIL. NC1214.2 +098100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +098200 MOVE 1.9 TO CORRECT-14V4. NC1214.2 +098300 IND-WRITE-GF-20. NC1214.2 +098400 MOVE "IND-TEST-GF-20" TO PAR-NAME. NC1214.2 +098500 PERFORM PRINT-DETAIL. NC1214.2 +098600 IND-INIT-GF-21. NC1214.2 +098700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +098800 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +098900 PERFORM BUILD-TABLE2. NC1214.2 +099000 SET INDEX1 TO 6. NC1214.2 +099100 SET INDEX2 TO 4. NC1214.2 +099200 IND-TEST-GF-21-0. NC1214.2 +099300 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +099400 TABLE2-NUM (INDEX2 + 2). NC1214.2 +099500 IND-TEST-GF-21-1. NC1214.2 +099600 IF TABLE2-NUM (INDEX2 + 2) EQUAL TO .4 NC1214.2 +099700 PERFORM PASS NC1214.2 +099800 GO TO IND-WRITE-GF-21. NC1214.2 +099900 GO TO IND-FAIL-GF-21. NC1214.2 +100000 IND-DELETE-GF-21. NC1214.2 +100100 PERFORM DE-LETE. NC1214.2 +100200 GO TO IND-WRITE-GF-21. NC1214.2 +100300 IND-FAIL-GF-21. NC1214.2 +100400 PERFORM FAIL. NC1214.2 +100500 MOVE TABLE2-NUM (INDEX2 + 2) TO COMPUTED-14V4. NC1214.2 +100600 MOVE .4 TO CORRECT-14V4. NC1214.2 +100700 IND-WRITE-GF-21. NC1214.2 +100800 MOVE "IND-TEST-GF-21" TO PAR-NAME. NC1214.2 +100900 PERFORM PRINT-DETAIL. NC1214.2 +101000 IND-INIT-GF-26. NC1214.2 +101100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +101200 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +101300 PERFORM BUILD-TABLE2. NC1214.2 +101400 MOVE ZERO TO NUM-9V9. NC1214.2 +101500 SET INDEX1 TO 6. NC1214.2 +101600 SET INDEX2 TO 1. NC1214.2 +101700 IND-TEST-GF-26-0. NC1214.2 +101800 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +101900 TABLE2-NUM (INDEX2 + 1) GIVING NUM-9V9. NC1214.2 +102000 IND-TEST-GF-26-1. NC1214.2 +102100 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +102200 PERFORM PASS NC1214.2 +102300 GO TO IND-WRITE-GF-26. NC1214.2 +102400 GO TO IND-FAIL-GF-26. NC1214.2 +102500 IND-DELETE-GF-26. NC1214.2 +102600 PERFORM DE-LETE. NC1214.2 +102700 GO TO IND-WRITE-GF-26. NC1214.2 +102800 IND-FAIL-GF-26. NC1214.2 +102900 PERFORM FAIL. NC1214.2 +103000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +103100 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +103200 IND-WRITE-GF-26. NC1214.2 +103300 MOVE "IND-TEST-GF-26" TO PAR-NAME. NC1214.2 +103400 PERFORM PRINT-DETAIL. NC1214.2 +103500 IND-INIT-GF-27. NC1214.2 +103600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +103700 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +103800 PERFORM BUILD-TABLE2. NC1214.2 +103900 MOVE ZERO TO TABLE3. NC1214.2 +104000 SET INDEX1 TO 8. NC1214.2 +104100 SET INDEX2 TO 1. NC1214.2 +104200 SET INDEX3 TO 4. NC1214.2 +104300 IND-TEST-GF-27-0. NC1214.2 +104400 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +104500 TABLE2-NUM (INDEX2 + 1) GIVING TABLE3-NUM (INDEX3 - 1). NC1214.2 +104600 IND-TEST-GF-27-1. NC1214.2 +104700 IF TABLE3-NUM (INDEX3 - 1) EQUAL TO 4 NC1214.2 +104800 PERFORM PASS NC1214.2 +104900 GO TO IND-WRITE-GF-27. NC1214.2 +105000 GO TO IND-FAIL-GF-27. NC1214.2 +105100 IND-DELETE-GF-27. NC1214.2 +105200 PERFORM DE-LETE. NC1214.2 +105300 GO TO IND-WRITE-GF-27. NC1214.2 +105400 IND-FAIL-GF-27. NC1214.2 +105500 PERFORM FAIL. NC1214.2 +105600 MOVE TABLE3-NUM (INDEX3 - 1) TO COMPUTED-14V4. NC1214.2 +105700 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +105800 IND-WRITE-GF-27. NC1214.2 +105900 MOVE "IND-TEST-GF-27" TO PAR-NAME. NC1214.2 +106000 PERFORM PRINT-DETAIL. NC1214.2 +106100 IND-INIT-GF-28. NC1214.2 +106200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +106300 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +106400 PERFORM BUILD-TABLE4. NC1214.2 +106500 SET INDEX4-1 TO 2. NC1214.2 +106600 SET INDEX4-2 TO 1. NC1214.2 +106700 IND-TEST-GF-28-0. NC1214.2 +106800 DIVIDE TABLE4-NUM2 (INDEX4-1 INDEX4-2) BY NC1214.2 +106900 TABLE4-NUM2 (1 3) GIVING TABLE4-NUM2 (3 3). NC1214.2 +107000 IND-TEST-GF-28-1. NC1214.2 +107100 IF TABLE4-NUM2 (3 3) EQUAL TO 4 NC1214.2 +107200 PERFORM PASS NC1214.2 +107300 GO TO IND-WRITE-GF-28. NC1214.2 +107400 GO TO IND-FAIL-GF-28. NC1214.2 +107500 IND-DELETE-GF-28. NC1214.2 +107600 PERFORM DE-LETE. NC1214.2 +107700 GO TO IND-WRITE-GF-28. NC1214.2 +107800 IND-FAIL-GF-28. NC1214.2 +107900 PERFORM FAIL. NC1214.2 +108000 MOVE TABLE4-NUM2 (3 3) TO COMPUTED-14V4. NC1214.2 +108100 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +108200 IND-WRITE-GF-28. NC1214.2 +108300 MOVE "IND-TEST-GF-28" TO PAR-NAME. NC1214.2 +108400 PERFORM PRINT-DETAIL. NC1214.2 +108500 IND-INIT-GF-29. NC1214.2 +108600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +108700 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +108800 PERFORM BUILD-TABLE2. NC1214.2 +108900 MOVE ZERO TO NUM-9V9. NC1214.2 +109000 SET INDEX2 TO 2. NC1214.2 +109100 IND-TEST-GF-29-0. NC1214.2 +109200 DIVIDE TABLE2-NUM (INDEX2) BY TABLE2-NUM (INDEX2 + 1) NC1214.2 +109300 GIVING NUM-9V9. NC1214.2 +109400 IND-TEST-GF-29-1. NC1214.2 +109500 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +109600 PERFORM PASS NC1214.2 +109700 GO TO IND-WRITE-GF-29. NC1214.2 +109800 GO TO IND-FAIL-GF-29. NC1214.2 +109900 IND-DELETE-GF-29. NC1214.2 +110000 PERFORM DE-LETE. NC1214.2 +110100 GO TO IND-WRITE-GF-29. NC1214.2 +110200 IND-FAIL-GF-29. NC1214.2 +110300 PERFORM FAIL. NC1214.2 +110400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +110500 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +110600 IND-WRITE-GF-29. NC1214.2 +110700 MOVE "IND-TEST-GF-29" TO PAR-NAME. NC1214.2 +110800 PERFORM PRINT-DETAIL. NC1214.2 +110900 IND-INIT-GF-30. NC1214.2 +111000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +111100 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +111200 PERFORM BUILD-TABLE2. NC1214.2 +111300 SET INDEX2 TO 6. NC1214.2 +111400 IND-TEST-GF-30-0. NC1214.2 +111500 DIVIDE TABLE2-NUM (INDEX2) BY TABLE2-NUM (INDEX2 - 3) NC1214.2 +111600 GIVING TABLE2-NUM (INDEX2 - 1). NC1214.2 +111700 IND-TEST-GF-30-1. NC1214.2 +111800 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 0.4 NC1214.2 +111900 PERFORM PASS NC1214.2 +112000 GO TO IND-WRITE-GF-30. NC1214.2 +112100 GO TO IND-FAIL-GF-30. NC1214.2 +112200 IND-DELETE-GF-30. NC1214.2 +112300 PERFORM DE-LETE. NC1214.2 +112400 GO TO IND-WRITE-GF-30. NC1214.2 +112500 IND-FAIL-GF-30. NC1214.2 +112600 PERFORM FAIL. NC1214.2 +112700 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1214.2 +112800 MOVE 0.4 TO CORRECT-14V4. NC1214.2 +112900 IND-WRITE-GF-30. NC1214.2 +113000 MOVE "IND-TEST-GF-30" TO PAR-NAME. NC1214.2 +113100 PERFORM PRINT-DETAIL. NC1214.2 +113200 IND-INIT-GF-31. NC1214.2 +113300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +113400 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +113500 MOVE ZERO TO NUM-9V9. NC1214.2 +113600 SET INDEX1 TO 1. NC1214.2 +113700 IND-TEST-GF-31-0. NC1214.2 +113800 DIVIDE 8 BY TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +113900 IND-TEST-GF-31-1. NC1214.2 +114000 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +114100 PERFORM PASS NC1214.2 +114200 GO TO IND-WRITE-GF-31. NC1214.2 +114300 GO TO IND-FAIL-GF-31. NC1214.2 +114400 IND-DELETE-GF-31. NC1214.2 +114500 PERFORM DE-LETE. NC1214.2 +114600 GO TO IND-WRITE-GF-31. NC1214.2 +114700 IND-FAIL-GF-31. NC1214.2 +114800 PERFORM FAIL. NC1214.2 +114900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +115000 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +115100 IND-WRITE-GF-31. NC1214.2 +115200 MOVE "IND-TEST-GF-31" TO PAR-NAME. NC1214.2 +115300 PERFORM PRINT-DETAIL. NC1214.2 +115400 IND-INIT-GF-32. NC1214.2 +115500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +115600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +115700 MOVE ZERO TO NUM-9V9. NC1214.2 +115800 PERFORM BUILD-TABLE2. NC1214.2 +115900 SET INDEX1 TO 3. NC1214.2 +116000 SET INDEX2 TO 4. NC1214.2 +116100 IND-TEST-GF-32-0. NC1214.2 +116200 DIVIDE TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +116300 GIVING NUM-9V9. NC1214.2 +116400 IND-TEST-GF-32-1. NC1214.2 +116500 IF NUM-9V9 EQUAL TO 3.5 NC1214.2 +116600 PERFORM PASS NC1214.2 +116700 GO TO IND-WRITE-GF-32. NC1214.2 +116800 GO TO IND-FAIL-GF-32. NC1214.2 +116900 IND-DELETE-GF-32. NC1214.2 +117000 PERFORM DE-LETE. NC1214.2 +117100 GO TO IND-WRITE-GF-32. NC1214.2 +117200 IND-FAIL-GF-32. NC1214.2 +117300 PERFORM FAIL. NC1214.2 +117400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +117500 MOVE 3.5 TO CORRECT-14V4. NC1214.2 +117600 IND-WRITE-GF-32. NC1214.2 +117700 MOVE "IND-TEST-GF-32" TO PAR-NAME. NC1214.2 +117800 PERFORM PRINT-DETAIL. NC1214.2 +117900 IND-INIT-GF-33. NC1214.2 +118000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +118100 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +118200 MOVE ZERO TO TABLE3. NC1214.2 +118300 PERFORM BUILD-TABLE2. NC1214.2 +118400 SET INDEX1 TO 4. NC1214.2 +118500 SET INDEX2 TO 3. NC1214.2 +118600 SET INDEX3 TO 2. NC1214.2 +118700 IND-TEST-GF-33-0. NC1214.2 +118800 DIVIDE TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +118900 GIVING TABLE3-NUM (INDEX3). NC1214.2 +119000 IND-TEST-GF-33-1. NC1214.2 +119100 IF TABLE3-NUM (INDEX3) EQUAL TO 1.0 NC1214.2 +119200 PERFORM PASS NC1214.2 +119300 GO TO IND-WRITE-GF-33. NC1214.2 +119400 GO TO IND-FAIL-GF-33. NC1214.2 +119500 IND-DELETE-GF-33. NC1214.2 +119600 PERFORM DE-LETE. NC1214.2 +119700 GO TO IND-WRITE-GF-33. NC1214.2 +119800 IND-FAIL-GF-33. NC1214.2 +119900 PERFORM FAIL. NC1214.2 +120000 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +120100 MOVE 1.0 TO CORRECT-14V4. NC1214.2 +120200 IND-WRITE-GF-33. NC1214.2 +120300 MOVE "IND-TEST-GF-33" TO PAR-NAME. NC1214.2 +120400 PERFORM PRINT-DETAIL. NC1214.2 +120500 IND-INIT-GF-34. NC1214.2 +120600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +120700 MOVE "PERFORM" TO FEATURE. NC1214.2 +120800 MOVE ZERO TO NUM-9V9. NC1214.2 +120900 SET INDEX5 TO 1. NC1214.2 +121000 IND-TEST-GF-34-0. NC1214.2 +121100 PERFORM PARAGRAPH-A TABLE5-NUM (INDEX5) TIMES. NC1214.2 +121200 IND-TEST-GF-34-1. NC1214.2 +121300 IF NUM-9V9 EQUAL TO 3 NC1214.2 +121400 PERFORM PASS NC1214.2 +121500 ELSE GO TO IND-FAIL-GF-34. NC1214.2 +121600 GO TO IND-WRITE-GF-34. NC1214.2 +121700 IND-DELETE-GF-34. NC1214.2 +121800 PERFORM DE-LETE. NC1214.2 +121900 GO TO IND-WRITE-GF-34. NC1214.2 +122000 IND-FAIL-GF-34. NC1214.2 +122100 PERFORM FAIL. NC1214.2 +122200 MOVE NUM-9V9 TO COMPUTED-18V0. NC1214.2 +122300 MOVE 3 TO CORRECT-18V0. NC1214.2 +122400 IND-WRITE-GF-34. NC1214.2 +122500 MOVE "IND-TEST-GF-34" TO PAR-NAME. NC1214.2 +122600 PERFORM PRINT-DETAIL. NC1214.2 +122700 IND-INIT-GF-35. NC1214.2 +122800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +122900 MOVE "PERFORM THRU" TO FEATURE. NC1214.2 +123000 MOVE ZERO TO NUM-9V9. NC1214.2 +123100 SET INDEX5 TO 2. NC1214.2 +123200 IND-TEST-GF-35-0. NC1214.2 +123300 PERFORM PARAGRAPH-A THRU PARAGRAPH-B NC1214.2 +123400 TABLE5-NUM (INDEX5) TIMES. NC1214.2 +123500 IND-TEST-GF-35-1. NC1214.2 +123600 IF NUM-9V9 EQUAL TO 4 NC1214.2 +123700 PERFORM PASS NC1214.2 +123800 ELSE GO TO IND-FAIL-GF-35. NC1214.2 +123900 GO TO IND-WRITE-GF-35. NC1214.2 +124000 IND-DELETE-GF-35. NC1214.2 +124100 PERFORM DE-LETE. NC1214.2 +124200 GO TO IND-WRITE-GF-35. NC1214.2 +124300 IND-FAIL-GF-35. NC1214.2 +124400 PERFORM FAIL. NC1214.2 +124500 MOVE NUM-9V9 TO COMPUTED-18V0. NC1214.2 +124600 MOVE 4 TO CORRECT-18V0. NC1214.2 +124700 IND-WRITE-GF-35. NC1214.2 +124800 MOVE "IND-TEST-GF-35" TO PAR-NAME. NC1214.2 +124900 PERFORM PRINT-DETAIL. NC1214.2 +125000 IND-INIT-GF-36. NC1214.2 +125100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +125200 MOVE "DISPLAY" TO FEATURE. NC1214.2 +125300 MOVE "RESULTS MUST BE" TO RE-MARK. NC1214.2 +125400 MOVE "LITERAL-01" TO CORRECT-A. NC1214.2 +125500 SET INDEX6 TO 1. NC1214.2 +125600 IND-TEST-GF-36. NC1214.2 +125700 DISPLAY " ". NC1214.2 +125800 DISPLAY TABLE6-REC (INDEX6). NC1214.2 +125900 PERFORM INSPT. NC1214.2 +126000 GO TO IND-WRITE-GF-36. NC1214.2 +126100 IND-DELETE-GF-36. NC1214.2 +126200 PERFORM DE-LETE. NC1214.2 +126300 IND-WRITE-GF-36. NC1214.2 +126400 MOVE "IND-TEST-GF-36" TO PAR-NAME. NC1214.2 +126500 PERFORM PRINT-DETAIL. NC1214.2 +126600 IND-INIT-GF-37. NC1214.2 +126700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +126800 MOVE "DISPLAY" TO FEATURE. NC1214.2 +126900 MOVE "VISUALLY CHECKED" TO RE-MARK. NC1214.2 +127000 MOVE "0123456789" TO CORRECT-A. NC1214.2 +127100 SET INDEX6 TO 1. NC1214.2 +127200 IND-TEST-GF-37. NC1214.2 +127300 DISPLAY TABLE6-REC (INDEX6 + 1). NC1214.2 +127400 PERFORM INSPT. NC1214.2 +127500 GO TO IND-WRITE-GF-37. NC1214.2 +127600 IND-DELETE-GF-37. NC1214.2 +127700 PERFORM DE-LETE. NC1214.2 +127800 IND-WRITE-GF-37. NC1214.2 +127900 MOVE "IND-TEST-GF-37" TO PAR-NAME. NC1214.2 +128000 PERFORM PRINT-DETAIL. NC1214.2 +128100 GO TO CCVS-999999. NC1214.2 +128200 PARAGRAPH-A. NC1214.2 +128300 ADD 1 TO NUM-9V9. NC1214.2 +128400 PARAGRAPH-B. NC1214.2 +128500 ADD 1 TO NUM-9V9. NC1214.2 +128600 CCVS-EXIT SECTION. NC1214.2 +128700 CCVS-999999. NC1214.2 +128800 GO TO CLOSE-FILES. NC1214.2 +*END-OF,NC121M +*HEADER,COBOL,NC122A +000100 IDENTIFICATION DIVISION. NC1224.2 +000200 PROGRAM-ID. NC1224.2 +000300 NC122A. NC1224.2 +000400**************************************************************** NC1224.2 +000500* * NC1224.2 +000600* VALIDATION FOR:- * NC1224.2 +000700* * NC1224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +000900* * NC1224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1224.2 +001100* * NC1224.2 +001200**************************************************************** NC1224.2 +001300* * NC1224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1224.2 +001500* * NC1224.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1224.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1224.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1224.2 +001900* * NC1224.2 +002000**************************************************************** NC1224.2 +002100* NC1224.2 +002200* PROGRAM NC122A TESTS THE USE OF INDEXED IDENTIFIERS USING NC1224.2 +002300* FORMATS 1, 2 AND 3 OF THE "INSPECT" STATEMENT. NC1224.2 +002400* SINGLE LEVEL AND RELATIVE INDEXING ARE USED. NC1224.2 +002500* NC1224.2 +002600 ENVIRONMENT DIVISION. NC1224.2 +002700 CONFIGURATION SECTION. NC1224.2 +002800 SOURCE-COMPUTER. NC1224.2 +002900 XXXXX082. NC1224.2 +003000 OBJECT-COMPUTER. NC1224.2 +003100 XXXXX083. NC1224.2 +003200 INPUT-OUTPUT SECTION. NC1224.2 +003300 FILE-CONTROL. NC1224.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1224.2 +003500 XXXXX055. NC1224.2 +003600 DATA DIVISION. NC1224.2 +003700 FILE SECTION. NC1224.2 +003800 FD PRINT-FILE. NC1224.2 +003900 01 PRINT-REC PICTURE X(120). NC1224.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1224.2 +004100 WORKING-STORAGE SECTION. NC1224.2 +004200 01 WRK-OK. NC1224.2 +004300 03 WRK-OK-1-20 PIC X(20). NC1224.2 +004400 03 WRK-OK-21-40 PIC X(20). NC1224.2 +004500 03 WRK-OK-41-60 PIC X(20). NC1224.2 +004600 03 WRK-OK-61-80 PIC X(20). NC1224.2 +004700 03 WRK-OK-81-83 PIC X(3). NC1224.2 +004800 01 WRK-ER. NC1224.2 +004900 03 WRK-ER-1-20 PIC X(20). NC1224.2 +005000 03 WRK-ER-21-40 PIC X(20). NC1224.2 +005100 03 WRK-ER-41-60 PIC X(20). NC1224.2 +005200 03 WRK-ER-61-80 PIC X(20). NC1224.2 +005300 03 WRK-ER-81-83 PIC X(3). NC1224.2 +005400 01 TABLE1. NC1224.2 +005500 02 TABLE1-REC PICTURE X(83) NC1224.2 +005600 OCCURS 4 TIMES NC1224.2 +005700 INDEXED BY INDEX1. NC1224.2 +005800 01 TABLE2. NC1224.2 +005900 02 WRK-DU-999 PICTURE 999 NC1224.2 +006000 OCCURS 4 TIMES NC1224.2 +006100 INDEXED BY INDEX2. NC1224.2 +006200 01 TABLE3. NC1224.2 +006300 02 TABLE3-SYMBOL PICTURE X NC1224.2 +006400 OCCURS 3 TIMES NC1224.2 +006500 INDEXED BY INDEX3. NC1224.2 +006600 01 TABLE4. NC1224.2 +006700 02 TABLE4-LETTER PICTURE X NC1224.2 +006800 OCCURS 9 TIMES NC1224.2 +006900 INDEXED BY INDEX4. NC1224.2 +007000 01 WC-XN-83 PIC X(83) VALUE NC1224.2 +007100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007200- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007300 01 ANS-XN-83-1 PIC X(83) VALUE NC1224.2 +007400 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007500- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007600 01 ANS-XN-83-2 PIC X(83) VALUE NC1224.2 +007700 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007800- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007900 01 ANS-XN-83-3 PIC X(83) VALUE NC1224.2 +008000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +008100- "IDS CAN NOT BE ALL-BAD.". NC1224.2 +008200 01 ANS-XN-83-4 PIC X(83) VALUE NC1224.2 +008300 "EH YES EH YES W.C. FRITOES HERE. ENYONE WHO HETES DOGS END KNC1224.2 +008400- "IDS CEN NOT BE ELL BAD.". NC1224.2 +008500 01 ANS-XN-83-5 PIC X(83) VALUE NC1224.2 +008600 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +008700- "IDS CAN NOT BE ALL BAD.". NC1224.2 +008800 01 TEST-RESULTS. NC1224.2 +008900 02 FILLER PIC X VALUE SPACE. NC1224.2 +009000 02 FEATURE PIC X(20) VALUE SPACE. NC1224.2 +009100 02 FILLER PIC X VALUE SPACE. NC1224.2 +009200 02 P-OR-F PIC X(5) VALUE SPACE. NC1224.2 +009300 02 FILLER PIC X VALUE SPACE. NC1224.2 +009400 02 PAR-NAME. NC1224.2 +009500 03 FILLER PIC X(19) VALUE SPACE. NC1224.2 +009600 03 PARDOT-X PIC X VALUE SPACE. NC1224.2 +009700 03 DOTVALUE PIC 99 VALUE ZERO. NC1224.2 +009800 02 FILLER PIC X(8) VALUE SPACE. NC1224.2 +009900 02 RE-MARK PIC X(61). NC1224.2 +010000 01 TEST-COMPUTED. NC1224.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC1224.2 +010200 02 FILLER PIC X(17) VALUE NC1224.2 +010300 " COMPUTED=". NC1224.2 +010400 02 COMPUTED-X. NC1224.2 +010500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1224.2 +010600 03 COMPUTED-N REDEFINES COMPUTED-A NC1224.2 +010700 PIC -9(9).9(9). NC1224.2 +010800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1224.2 +010900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1224.2 +011000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1224.2 +011100 03 CM-18V0 REDEFINES COMPUTED-A. NC1224.2 +011200 04 COMPUTED-18V0 PIC -9(18). NC1224.2 +011300 04 FILLER PIC X. NC1224.2 +011400 03 FILLER PIC X(50) VALUE SPACE. NC1224.2 +011500 01 TEST-CORRECT. NC1224.2 +011600 02 FILLER PIC X(30) VALUE SPACE. NC1224.2 +011700 02 FILLER PIC X(17) VALUE " CORRECT =". NC1224.2 +011800 02 CORRECT-X. NC1224.2 +011900 03 CORRECT-A PIC X(20) VALUE SPACE. NC1224.2 +012000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1224.2 +012100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1224.2 +012200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1224.2 +012300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1224.2 +012400 03 CR-18V0 REDEFINES CORRECT-A. NC1224.2 +012500 04 CORRECT-18V0 PIC -9(18). NC1224.2 +012600 04 FILLER PIC X. NC1224.2 +012700 03 FILLER PIC X(2) VALUE SPACE. NC1224.2 +012800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1224.2 +012900 01 CCVS-C-1. NC1224.2 +013000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1224.2 +013100- "SS PARAGRAPH-NAME NC1224.2 +013200- " REMARKS". NC1224.2 +013300 02 FILLER PIC X(20) VALUE SPACE. NC1224.2 +013400 01 CCVS-C-2. NC1224.2 +013500 02 FILLER PIC X VALUE SPACE. NC1224.2 +013600 02 FILLER PIC X(6) VALUE "TESTED". NC1224.2 +013700 02 FILLER PIC X(15) VALUE SPACE. NC1224.2 +013800 02 FILLER PIC X(4) VALUE "FAIL". NC1224.2 +013900 02 FILLER PIC X(94) VALUE SPACE. NC1224.2 +014000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1224.2 +014100 01 REC-CT PIC 99 VALUE ZERO. NC1224.2 +014200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1224.2 +014700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1224.2 +014800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1224.2 +014900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1224.2 +015000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1224.2 +015100 01 CCVS-H-1. NC1224.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC1224.2 +015300 02 FILLER PIC X(42) VALUE NC1224.2 +015400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1224.2 +015500 02 FILLER PIC X(39) VALUE SPACES. NC1224.2 +015600 01 CCVS-H-2A. NC1224.2 +015700 02 FILLER PIC X(40) VALUE SPACE. NC1224.2 +015800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1224.2 +015900 02 FILLER PIC XXXX VALUE NC1224.2 +016000 "4.2 ". NC1224.2 +016100 02 FILLER PIC X(28) VALUE NC1224.2 +016200 " COPY - NOT FOR DISTRIBUTION". NC1224.2 +016300 02 FILLER PIC X(41) VALUE SPACE. NC1224.2 +016400 NC1224.2 +016500 01 CCVS-H-2B. NC1224.2 +016600 02 FILLER PIC X(15) VALUE NC1224.2 +016700 "TEST RESULT OF ". NC1224.2 +016800 02 TEST-ID PIC X(9). NC1224.2 +016900 02 FILLER PIC X(4) VALUE NC1224.2 +017000 " IN ". NC1224.2 +017100 02 FILLER PIC X(12) VALUE NC1224.2 +017200 " HIGH ". NC1224.2 +017300 02 FILLER PIC X(22) VALUE NC1224.2 +017400 " LEVEL VALIDATION FOR ". NC1224.2 +017500 02 FILLER PIC X(58) VALUE NC1224.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +017700 01 CCVS-H-3. NC1224.2 +017800 02 FILLER PIC X(34) VALUE NC1224.2 +017900 " FOR OFFICIAL USE ONLY ". NC1224.2 +018000 02 FILLER PIC X(58) VALUE NC1224.2 +018100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1224.2 +018200 02 FILLER PIC X(28) VALUE NC1224.2 +018300 " COPYRIGHT 1985 ". NC1224.2 +018400 01 CCVS-E-1. NC1224.2 +018500 02 FILLER PIC X(52) VALUE SPACE. NC1224.2 +018600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1224.2 +018700 02 ID-AGAIN PIC X(9). NC1224.2 +018800 02 FILLER PIC X(45) VALUE SPACES. NC1224.2 +018900 01 CCVS-E-2. NC1224.2 +019000 02 FILLER PIC X(31) VALUE SPACE. NC1224.2 +019100 02 FILLER PIC X(21) VALUE SPACE. NC1224.2 +019200 02 CCVS-E-2-2. NC1224.2 +019300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1224.2 +019400 03 FILLER PIC X VALUE SPACE. NC1224.2 +019500 03 ENDER-DESC PIC X(44) VALUE NC1224.2 +019600 "ERRORS ENCOUNTERED". NC1224.2 +019700 01 CCVS-E-3. NC1224.2 +019800 02 FILLER PIC X(22) VALUE NC1224.2 +019900 " FOR OFFICIAL USE ONLY". NC1224.2 +020000 02 FILLER PIC X(12) VALUE SPACE. NC1224.2 +020100 02 FILLER PIC X(58) VALUE NC1224.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +020300 02 FILLER PIC X(13) VALUE SPACE. NC1224.2 +020400 02 FILLER PIC X(15) VALUE NC1224.2 +020500 " COPYRIGHT 1985". NC1224.2 +020600 01 CCVS-E-4. NC1224.2 +020700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1224.2 +020800 02 FILLER PIC X(4) VALUE " OF ". NC1224.2 +020900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1224.2 +021000 02 FILLER PIC X(40) VALUE NC1224.2 +021100 " TESTS WERE EXECUTED SUCCESSFULLY". NC1224.2 +021200 01 XXINFO. NC1224.2 +021300 02 FILLER PIC X(19) VALUE NC1224.2 +021400 "*** INFORMATION ***". NC1224.2 +021500 02 INFO-TEXT. NC1224.2 +021600 04 FILLER PIC X(8) VALUE SPACE. NC1224.2 +021700 04 XXCOMPUTED PIC X(20). NC1224.2 +021800 04 FILLER PIC X(5) VALUE SPACE. NC1224.2 +021900 04 XXCORRECT PIC X(20). NC1224.2 +022000 02 INF-ANSI-REFERENCE PIC X(48). NC1224.2 +022100 01 HYPHEN-LINE. NC1224.2 +022200 02 FILLER PIC IS X VALUE IS SPACE. NC1224.2 +022300 02 FILLER PIC IS X(65) VALUE IS "************************NC1224.2 +022400- "*****************************************". NC1224.2 +022500 02 FILLER PIC IS X(54) VALUE IS "************************NC1224.2 +022600- "******************************". NC1224.2 +022700 01 CCVS-PGM-ID PIC X(9) VALUE NC1224.2 +022800 "NC122A". NC1224.2 +022900 PROCEDURE DIVISION. NC1224.2 +023000 CCVS1 SECTION. NC1224.2 +023100 OPEN-FILES. NC1224.2 +023200 OPEN OUTPUT PRINT-FILE. NC1224.2 +023300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1224.2 +023400 MOVE SPACE TO TEST-RESULTS. NC1224.2 +023500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1224.2 +023600 GO TO CCVS1-EXIT. NC1224.2 +023700 CLOSE-FILES. NC1224.2 +023800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1224.2 +023900 TERMINATE-CCVS. NC1224.2 +024000S EXIT PROGRAM. NC1224.2 +024100STERMINATE-CALL. NC1224.2 +024200 STOP RUN. NC1224.2 +024300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1224.2 +024400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1224.2 +024500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1224.2 +024600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1224.2 +024700 MOVE "****TEST DELETED****" TO RE-MARK. NC1224.2 +024800 PRINT-DETAIL. NC1224.2 +024900 IF REC-CT NOT EQUAL TO ZERO NC1224.2 +025000 MOVE "." TO PARDOT-X NC1224.2 +025100 MOVE REC-CT TO DOTVALUE. NC1224.2 +025200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1224.2 +025300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1224.2 +025400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1224.2 +025500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1224.2 +025600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1224.2 +025700 MOVE SPACE TO CORRECT-X. NC1224.2 +025800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1224.2 +025900 MOVE SPACE TO RE-MARK. NC1224.2 +026000 HEAD-ROUTINE. NC1224.2 +026100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1224.2 +026400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1224.2 +026500 COLUMN-NAMES-ROUTINE. NC1224.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +026900 END-ROUTINE. NC1224.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1224.2 +027100 END-RTN-EXIT. NC1224.2 +027200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +027300 END-ROUTINE-1. NC1224.2 +027400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1224.2 +027500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1224.2 +027600 ADD PASS-COUNTER TO ERROR-HOLD. NC1224.2 +027700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1224.2 +027800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1224.2 +027900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1224.2 +028000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1224.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1224.2 +028200 END-ROUTINE-12. NC1224.2 +028300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1224.2 +028400 IF ERROR-COUNTER IS EQUAL TO ZERO NC1224.2 +028500 MOVE "NO " TO ERROR-TOTAL NC1224.2 +028600 ELSE NC1224.2 +028700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1224.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1224.2 +028900 PERFORM WRITE-LINE. NC1224.2 +029000 END-ROUTINE-13. NC1224.2 +029100 IF DELETE-COUNTER IS EQUAL TO ZERO NC1224.2 +029200 MOVE "NO " TO ERROR-TOTAL ELSE NC1224.2 +029300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1224.2 +029400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1224.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +029600 IF INSPECT-COUNTER EQUAL TO ZERO NC1224.2 +029700 MOVE "NO " TO ERROR-TOTAL NC1224.2 +029800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1224.2 +029900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1224.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +030100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +030200 WRITE-LINE. NC1224.2 +030300 ADD 1 TO RECORD-COUNT. NC1224.2 +030400Y IF RECORD-COUNT GREATER 42 NC1224.2 +030500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1224.2 +030600Y MOVE SPACE TO DUMMY-RECORD NC1224.2 +030700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1224.2 +030800Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1224.2 +030900Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1224.2 +031000Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1224.2 +031100Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1224.2 +031200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1224.2 +031600Y MOVE ZERO TO RECORD-COUNT. NC1224.2 +031700 PERFORM WRT-LN. NC1224.2 +031800 WRT-LN. NC1224.2 +031900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1224.2 +032000 MOVE SPACE TO DUMMY-RECORD. NC1224.2 +032100 BLANK-LINE-PRINT. NC1224.2 +032200 PERFORM WRT-LN. NC1224.2 +032300 FAIL-ROUTINE. NC1224.2 +032400 IF COMPUTED-X NOT EQUAL TO SPACE NC1224.2 +032500 GO TO FAIL-ROUTINE-WRITE. NC1224.2 +032600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1224.2 +032700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1224.2 +032800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1224.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1224.2 +033100 GO TO FAIL-ROUTINE-EX. NC1224.2 +033200 FAIL-ROUTINE-WRITE. NC1224.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1224.2 +033400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1224.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1224.2 +033600 MOVE SPACES TO COR-ANSI-REFERENCE. NC1224.2 +033700 FAIL-ROUTINE-EX. EXIT. NC1224.2 +033800 BAIL-OUT. NC1224.2 +033900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1224.2 +034000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1224.2 +034100 BAIL-OUT-WRITE. NC1224.2 +034200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1224.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1224.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1224.2 +034600 BAIL-OUT-EX. EXIT. NC1224.2 +034700 CCVS1-EXIT. NC1224.2 +034800 EXIT. NC1224.2 +034900 BUILD-TABLE1. NC1224.2 +035000 MOVE WC-XN-83 TO TABLE1-REC (1). NC1224.2 +035100 MOVE WC-XN-83 TO TABLE1-REC (2). NC1224.2 +035200 MOVE WC-XN-83 TO TABLE1-REC (3). NC1224.2 +035300 MOVE WC-XN-83 TO TABLE1-REC (4). NC1224.2 +035400 BUILD-TABLE3. NC1224.2 +035500 MOVE " " TO TABLE3-SYMBOL (1). NC1224.2 +035600 MOVE "," TO TABLE3-SYMBOL (2). NC1224.2 +035700 MOVE "-" TO TABLE3-SYMBOL (3). NC1224.2 +035800 BUILD-TABLE4. NC1224.2 +035900 MOVE "A" TO TABLE4-LETTER (1). NC1224.2 +036000 MOVE "D" TO TABLE4-LETTER (2). NC1224.2 +036100 MOVE "G" TO TABLE4-LETTER (3). NC1224.2 +036200 MOVE "H" TO TABLE4-LETTER (4). NC1224.2 +036300 MOVE "L" TO TABLE4-LETTER (5). NC1224.2 +036400 MOVE "O" TO TABLE4-LETTER (6). NC1224.2 +036500 MOVE "Y" TO TABLE4-LETTER (7). NC1224.2 +036600 MOVE "S" TO TABLE4-LETTER (8). NC1224.2 +036700 MOVE "Z" TO TABLE4-LETTER (9). NC1224.2 +036800 IND-INIT-GF-1. NC1224.2 +036900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +037000 MOVE ZERO TO TABLE2. NC1224.2 +037100 SET INDEX1 TO 1. NC1224.2 +037200 SET INDEX2 TO 1. NC1224.2 +037300 IND-TEST-GF-1-0. NC1224.2 +037400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +037500 FOR CHARACTERS. NC1224.2 +037600 IND-TEST-GF-1-1. NC1224.2 +037700 IF WRK-DU-999 (INDEX2) EQUAL TO 83 NC1224.2 +037800 PERFORM PASS NC1224.2 +037900 GO TO IND-WRITE-GF-1. NC1224.2 +038000 GO TO IND-FAIL-GF-1. NC1224.2 +038100 IND-DELETE-GF-1. NC1224.2 +038200 PERFORM DE-LETE. NC1224.2 +038300 GO TO IND-WRITE-GF-1. NC1224.2 +038400 IND-FAIL-GF-1. NC1224.2 +038500 PERFORM FAIL. NC1224.2 +038600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +038700 MOVE 83 TO CORRECT-N. NC1224.2 +038800 IND-WRITE-GF-1. NC1224.2 +038900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1224.2 +039000 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC1224.2 +039100 PERFORM PRINT-DETAIL. NC1224.2 +039200 IND-INIT-GF-2. NC1224.2 +039300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +039400 MOVE ZERO TO TABLE2. NC1224.2 +039500 SET INDEX1 TO 2. NC1224.2 +039600 SET INDEX2 TO 2. NC1224.2 +039700 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +039800 IND-TEST-GF-2-0. NC1224.2 +039900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +040000 FOR ALL "A". NC1224.2 +040100 IND-TEST-GF-2-1. NC1224.2 +040200 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC1224.2 +040300 PERFORM PASS NC1224.2 +040400 GO TO IND-WRITE-GF-2. NC1224.2 +040500 GO TO IND-FAIL-GF-2. NC1224.2 +040600 IND-DELETE-GF-2. NC1224.2 +040700 PERFORM DE-LETE. NC1224.2 +040800 GO TO IND-WRITE-GF-2. NC1224.2 +040900 IND-FAIL-GF-2. NC1224.2 +041000 PERFORM FAIL. NC1224.2 +041100 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +041200 MOVE 8 TO CORRECT-N. NC1224.2 +041300 IND-WRITE-GF-2. NC1224.2 +041400 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1224.2 +041500 MOVE "TALLY FOR LITERAL" TO FEATURE. NC1224.2 +041600 PERFORM PRINT-DETAIL. NC1224.2 +041700 IND-INIT-GF-3. NC1224.2 +041800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +041900 MOVE ZERO TO TABLE2. NC1224.2 +042000 SET INDEX1 TO 3. NC1224.2 +042100 SET INDEX2 TO 3. NC1224.2 +042200 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +042300 IND-TEST-GF-3-0. NC1224.2 +042400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +042500 FOR ALL SPACE. NC1224.2 +042600 IND-TEST-GF-3-1. NC1224.2 +042700 IF WRK-DU-999 (INDEX2) EQUAL TO 17 NC1224.2 +042800 PERFORM PASS NC1224.2 +042900 GO TO IND-WRITE-GF-3. NC1224.2 +043000 GO TO IND-FAIL-GF-3. NC1224.2 +043100 IND-DELETE-GF-3. NC1224.2 +043200 PERFORM DE-LETE. NC1224.2 +043300 GO TO IND-WRITE-GF-3. NC1224.2 +043400 IND-FAIL-GF-3. NC1224.2 +043500 PERFORM FAIL. NC1224.2 +043600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +043700 MOVE 17 TO CORRECT-N. NC1224.2 +043800 IND-WRITE-GF-3. NC1224.2 +043900 MOVE "IND-TEST-GF-3" TO PAR-NAME. NC1224.2 +044000 MOVE "TALLY FOR ALL SPACE" TO FEATURE. NC1224.2 +044100 PERFORM PRINT-DETAIL. NC1224.2 +044200 IND-INIT-GF-4. NC1224.2 +044300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +044400 MOVE ZERO TO TABLE2. NC1224.2 +044500 SET INDEX1 TO 4. NC1224.2 +044600 SET INDEX2 TO 4. NC1224.2 +044700 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +044800 IND-TEST-GF-4-0. NC1224.2 +044900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +045000 FOR LEADING "A". NC1224.2 +045100 IND-TEST-GF-4-1. NC1224.2 +045200 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +045300 PERFORM PASS NC1224.2 +045400 GO TO IND-WRITE-GF-4. NC1224.2 +045500 GO TO IND-FAIL-GF-4. NC1224.2 +045600 IND-DELETE-GF-4. NC1224.2 +045700 PERFORM DE-LETE. NC1224.2 +045800 GO TO IND-WRITE-GF-4. NC1224.2 +045900 IND-FAIL-GF-4. NC1224.2 +046000 PERFORM FAIL. NC1224.2 +046100 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +046200 MOVE 1 TO CORRECT-N. NC1224.2 +046300 IND-WRITE-GF-4. NC1224.2 +046400 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1224.2 +046500 MOVE "TALLY LEADING LIT." TO FEATURE. NC1224.2 +046600 PERFORM PRINT-DETAIL. NC1224.2 +046700 IND-INIT-GF-5. NC1224.2 +046800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +046900 SET INDEX1 TO 1. NC1224.2 +047000 SET INDEX2 TO 2. NC1224.2 +047100 MOVE ZERO TO TABLE2. NC1224.2 +047200 MOVE ZERO TO WRK-DU-999 (INDEX2 + 1). NC1224.2 +047300 IND-TEST-GF-5-0. NC1224.2 +047400 INSPECT TABLE1-REC (INDEX1 + 1) TALLYING NC1224.2 +047500 WRK-DU-999 (INDEX2 + 1) NC1224.2 +047600 FOR CHARACTERS AFTER "W". NC1224.2 +047700 IND-TEST-GF-5-1. NC1224.2 +047800 IF WRK-DU-999 (INDEX2 + 1) EQUAL TO 68 NC1224.2 +047900 PERFORM PASS NC1224.2 +048000 GO TO IND-WRITE-GF-5. NC1224.2 +048100 GO TO IND-FAIL-GF-5. NC1224.2 +048200 IND-DELETE-GF-5. NC1224.2 +048300 PERFORM DE-LETE. NC1224.2 +048400 GO TO IND-WRITE-GF-5. NC1224.2 +048500 IND-FAIL-GF-5. NC1224.2 +048600 PERFORM FAIL. NC1224.2 +048700 MOVE WRK-DU-999 (INDEX2 + 1) TO COMPUTED-N. NC1224.2 +048800 MOVE 68 TO CORRECT-N. NC1224.2 +048900 IND-WRITE-GF-5. NC1224.2 +049000 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1224.2 +049100 MOVE "FOR CHARS AFTER LIT." TO FEATURE. NC1224.2 +049200 PERFORM PRINT-DETAIL. NC1224.2 +049300 IND-INIT-GF-6. NC1224.2 +049400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +049500 MOVE ZERO TO TABLE2. NC1224.2 +049600 SET INDEX1 TO 3. NC1224.2 +049700 SET INDEX2 TO 4. NC1224.2 +049800 MOVE ZERO TO WRK-DU-999 (INDEX2 - 2). NC1224.2 +049900 IND-TEST-GF-6-0. NC1224.2 +050000 INSPECT TABLE1-REC (INDEX1 - 1) NC1224.2 +050100 TALLYING WRK-DU-999 (INDEX2 - 2) NC1224.2 +050200 FOR ALL " " BEFORE INITIAL "W". NC1224.2 +050300 IND-TEST-GF-6-1. NC1224.2 +050400 IF WRK-DU-999 (INDEX2 - 2) EQUAL TO 4 NC1224.2 +050500 PERFORM PASS NC1224.2 +050600 GO TO IND-WRITE-GF-6. NC1224.2 +050700 GO TO IND-FAIL-GF-6. NC1224.2 +050800 IND-DELETE-GF-6. NC1224.2 +050900 PERFORM DE-LETE. NC1224.2 +051000 GO TO IND-WRITE-GF-6. NC1224.2 +051100 IND-FAIL-GF-6. NC1224.2 +051200 PERFORM FAIL. NC1224.2 +051300 MOVE WRK-DU-999 (INDEX2 - 2) TO COMPUTED-N. NC1224.2 +051400 MOVE 4 TO CORRECT-N. NC1224.2 +051500 IND-WRITE-GF-6. NC1224.2 +051600 MOVE "IND-TEST-GF-6" TO PAR-NAME. NC1224.2 +051700 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC1224.2 +051800 PERFORM PRINT-DETAIL. NC1224.2 +051900 IND-INIT-GF-7. NC1224.2 +052000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +052100 MOVE ZERO TO TABLE2. NC1224.2 +052200 SET INDEX1 TO 1. NC1224.2 +052300 SET INDEX2 TO 1. NC1224.2 +052400 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +052500 IND-TEST-GF-7-0. NC1224.2 +052600 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +052700 FOR LEADING "Y" AFTER INITIAL SPACE. NC1224.2 +052800 IND-TEST-GF-7-1. NC1224.2 +052900 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +053000 PERFORM PASS NC1224.2 +053100 GO TO IND-WRITE-GF-7. NC1224.2 +053200 GO TO IND-FAIL-GF-7. NC1224.2 +053300 IND-DELETE-GF-7. NC1224.2 +053400 PERFORM DE-LETE. NC1224.2 +053500 GO TO IND-WRITE-GF-7. NC1224.2 +053600 IND-FAIL-GF-7. NC1224.2 +053700 PERFORM FAIL. NC1224.2 +053800 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +053900 MOVE 1 TO CORRECT-N. NC1224.2 +054000 IND-WRITE-GF-7. NC1224.2 +054100 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1224.2 +054200 MOVE "LEAD. LIT. INITIAL" TO FEATURE. NC1224.2 +054300 PERFORM PRINT-DETAIL. NC1224.2 +054400 IND-INIT-GF-8. NC1224.2 +054500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +054600 PERFORM BUILD-TABLE1. NC1224.2 +054700 SET INDEX1 TO 1. NC1224.2 +054800 IND-TEST-GF-8-0. NC1224.2 +054900 INSPECT TABLE1-REC (INDEX1) REPLACING CHARACTERS BY SPACE. NC1224.2 +055000 IND-TEST-GF-8-1. NC1224.2 +055100 IF TABLE1-REC (INDEX1) EQUAL TO SPACE NC1224.2 +055200 PERFORM PASS NC1224.2 +055300 GO TO IND-WRITE-GF-8. NC1224.2 +055400 GO TO IND-FAIL-GF-8. NC1224.2 +055500 IND-DELETE-GF-8. NC1224.2 +055600 PERFORM DE-LETE. NC1224.2 +055700 GO TO IND-WRITE-GF-8. NC1224.2 +055800 IND-FAIL-GF-8. NC1224.2 +055900 PERFORM FAIL. NC1224.2 +056000 MOVE TABLE1-REC (INDEX1) TO COMPUTED-A. NC1224.2 +056100 MOVE "SPACES" TO CORRECT-A. NC1224.2 +056200 IND-WRITE-GF-8. NC1224.2 +056300 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1224.2 +056400 MOVE "REP. CHARS BY SPACE" TO FEATURE. NC1224.2 +056500 PERFORM PRINT-DETAIL. NC1224.2 +056600 IND-INIT-GF-9. NC1224.2 +056700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +056800 PERFORM BUILD-TABLE1. NC1224.2 +056900 SET INDEX1 TO 2. NC1224.2 +057000 IND-TEST-GF-9-0. NC1224.2 +057100 INSPECT TABLE1-REC (INDEX1) REPLACING CHARACTERS NC1224.2 +057200 BY "O" BEFORE INITIAL "H". NC1224.2 +057300 IND-TEST-GF-9-1. NC1224.2 +057400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +057500 PERFORM PASS NC1224.2 +057600 GO TO IND-WRITE-GF-9. NC1224.2 +057700 GO TO IND-FAIL-GF-9. NC1224.2 +057800 IND-DELETE-GF-9. NC1224.2 +057900 PERFORM DE-LETE. NC1224.2 +058000 GO TO IND-WRITE-GF-9. NC1224.2 +058100 IND-FAIL-GF-9. NC1224.2 +058200 PERFORM FAIL. NC1224.2 +058300 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +058400 MOVE ANS-XN-83-1 TO WRK-OK. NC1224.2 +058500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +058600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +058700 PERFORM PRINT-DETAIL. NC1224.2 +058800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +058900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +059000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +059200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +059300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +059500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +059600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +059800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +059900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +060000 IND-WRITE-GF-9. NC1224.2 +060100 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1224.2 +060200 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC1224.2 +060300 PERFORM PRINT-DETAIL. NC1224.2 +060400 IND-INIT-GF-10. NC1224.2 +060500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +060600 PERFORM BUILD-TABLE1. NC1224.2 +060700 SET INDEX1 TO 3. NC1224.2 +060800 SET INDEX3 TO 1. NC1224.2 +060900 SET INDEX4 TO 8. NC1224.2 +061000 IND-TEST-GF-10-0. NC1224.2 +061100 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC1224.2 +061200 TABLE3-SYMBOL (INDEX3) BY TABLE3-SYMBOL (INDEX3 + 1) NC1224.2 +061300 AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +061400 IND-TEST-GF-10-1. NC1224.2 +061500 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-2 NC1224.2 +061600 PERFORM PASS NC1224.2 +061700 GO TO IND-WRITE-GF-10. NC1224.2 +061800 GO TO IND-FAIL-GF-10. NC1224.2 +061900 IND-DELETE-GF-10. NC1224.2 +062000 PERFORM DE-LETE. NC1224.2 +062100 GO TO IND-WRITE-GF-10. NC1224.2 +062200 IND-FAIL-GF-10. NC1224.2 +062300 PERFORM FAIL. NC1224.2 +062400 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +062500 MOVE ANS-XN-83-2 TO WRK-OK. NC1224.2 +062600 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +062700 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +062800 PERFORM PRINT-DETAIL. NC1224.2 +062900 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +063000 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +063100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063200 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +063300 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +063400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063500 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +063600 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +063700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063800 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +063900 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +064000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +064100 IND-WRITE-GF-10. NC1224.2 +064200 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1224.2 +064300 MOVE "LEAD. AFTER INIT. ID" TO FEATURE. NC1224.2 +064400 PERFORM PRINT-DETAIL. NC1224.2 +064500 IND-INIT-GF-11. NC1224.2 +064600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +064700 PERFORM BUILD-TABLE1. NC1224.2 +064800 SET INDEX1 TO 4. NC1224.2 +064900 SET INDEX4 TO 6. NC1224.2 +065000 IND-TEST-GF-11-0. NC1224.2 +065100 INSPECT TABLE1-REC (INDEX1) REPLACING FIRST "A" NC1224.2 +065200 BY TABLE4-LETTER (INDEX4) BEFORE INITIAL "H". NC1224.2 +065300 IND-TEST-GF-11-1. NC1224.2 +065400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +065500 PERFORM PASS NC1224.2 +065600 GO TO IND-WRITE-GF-11. NC1224.2 +065700 GO TO IND-FAIL-GF-11. NC1224.2 +065800 IND-DELETE-GF-11. NC1224.2 +065900 PERFORM DE-LETE. NC1224.2 +066000 GO TO IND-WRITE-GF-11. NC1224.2 +066100 IND-FAIL-GF-11. NC1224.2 +066200 PERFORM FAIL. NC1224.2 +066300 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +066400 MOVE ANS-XN-83-1 TO WRK-OK. NC1224.2 +066500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +066600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +066700 PERFORM PRINT-DETAIL. NC1224.2 +066800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +066900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +067000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +067200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +067300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +067500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +067600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +067800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +067900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +068000 IND-WRITE-GF-11. NC1224.2 +068100 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1224.2 +068200 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC1224.2 +068300 PERFORM PRINT-DETAIL. NC1224.2 +068400 IND-INIT-GF-12. NC1224.2 +068500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +068600 PERFORM BUILD-TABLE1. NC1224.2 +068700 SET INDEX1 TO 1. NC1224.2 +068800 SET INDEX3 TO 1. NC1224.2 +068900 SET INDEX4 TO 5. NC1224.2 +069000 IND-TEST-GF-12-0. NC1224.2 +069100 INSPECT TABLE1-REC (INDEX1 + 1) REPLACING ALL NC1224.2 +069200 TABLE3-SYMBOL (INDEX3) BY "-" AFTER TABLE4-LETTER (INDEX4). NC1224.2 +069300 IND-TEST-GF-12-1. NC1224.2 +069400 IF TABLE1-REC (INDEX1 + 1) EQUAL TO ANS-XN-83-3 NC1224.2 +069500 PERFORM PASS NC1224.2 +069600 GO TO IND-WRITE-GF-12. NC1224.2 +069700 GO TO IND-FAIL-GF-12. NC1224.2 +069800 IND-DELETE-GF-12. NC1224.2 +069900 PERFORM DE-LETE. NC1224.2 +070000 GO TO IND-WRITE-GF-12. NC1224.2 +070100 IND-FAIL-GF-12. NC1224.2 +070200 PERFORM FAIL. NC1224.2 +070300 MOVE TABLE1-REC (INDEX1 + 1) TO WRK-ER. NC1224.2 +070400 MOVE ANS-XN-83-3 TO WRK-OK. NC1224.2 +070500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +070600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +070700 PERFORM PRINT-DETAIL. NC1224.2 +070800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +070900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +071000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +071200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +071300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +071500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +071600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +071800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +071900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +072000 IND-WRITE-GF-12. NC1224.2 +072100 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1224.2 +072200 MOVE "ALL ID BY LIT. AFTER" TO FEATURE. NC1224.2 +072300 PERFORM PRINT-DETAIL. NC1224.2 +072400 IND-INIT-GF-13. NC1224.2 +072500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +072600 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1224.2 +072700 MOVE "TALLY REPLACE CHARS" TO FEATURE. NC1224.2 +072800 MOVE 1 TO REC-CT. NC1224.2 +072900 PERFORM BUILD-TABLE1. NC1224.2 +073000 MOVE ZERO TO TABLE2. NC1224.2 +073100 SET INDEX1 TO 1. NC1224.2 +073200 SET INDEX2 TO 1. NC1224.2 +073300 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +073400 IND-TEST-GF-13-0. NC1224.2 +073500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +073600 FOR CHARACTERS REPLACING CHARACTERS BY " ". NC1224.2 +073700 GO TO IND-TEST-GF-13-1. NC1224.2 +073800 IND-DELETE-GF-13. NC1224.2 +073900 PERFORM DE-LETE. NC1224.2 +074000 PERFORM PRINT-DETAIL. NC1224.2 +074100 GO TO IND-INIT-GF-14. NC1224.2 +074200 IND-TEST-GF-13-1. NC1224.2 +074300 IF WRK-DU-999 (INDEX2) EQUAL TO 83 NC1224.2 +074400 PERFORM PASS NC1224.2 +074500 PERFORM PRINT-DETAIL NC1224.2 +074600 ELSE PERFORM FAIL NC1224.2 +074700 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +074800 MOVE 83 TO CORRECT-N NC1224.2 +074900 PERFORM PRINT-DETAIL. NC1224.2 +075000 ADD 1 TO REC-CT. NC1224.2 +075100 IND-TEST-GF-13-2. NC1224.2 +075200 IF TABLE1-REC (INDEX1) EQUAL TO SPACE NC1224.2 +075300 PERFORM PASS NC1224.2 +075400 PERFORM PRINT-DETAIL NC1224.2 +075500 ELSE NC1224.2 +075600 PERFORM FAIL NC1224.2 +075700 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +075800 MOVE SPACES TO WRK-OK NC1224.2 +075900 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +076000 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +076100 PERFORM PRINT-DETAIL NC1224.2 +076200 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +076300 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +076400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +076500 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +076600 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +076700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +076800 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +076900 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +077000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +077100 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +077200 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +077300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +077400 IND-INIT-GF-14. NC1224.2 +077500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +077600 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1224.2 +077700 MOVE "LIT. BY BEFORE INIT." TO FEATURE. NC1224.2 +077800 MOVE 1 TO REC-CT. NC1224.2 +077900 PERFORM BUILD-TABLE1. NC1224.2 +078000 MOVE ZERO TO TABLE2. NC1224.2 +078100 SET INDEX1 TO 4. NC1224.2 +078200 SET INDEX2 TO 2. NC1224.2 +078300 SET INDEX4 TO 5. NC1224.2 +078400 IND-TEST-GF-14-0. NC1224.2 +078500 INSPECT TABLE1-REC (INDEX1 - 2) TALLYING NC1224.2 +078600 WRK-DU-999 (INDEX2 + 2) FOR CHARACTERS NC1224.2 +078700 AFTER TABLE4-LETTER (INDEX4 - 1) REPLACING ALL NC1224.2 +078800 "A" BY "E" BEFORE INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +078900 GO TO IND-TEST-GF-14-1. NC1224.2 +079000 IND-DELETE-GF-14. NC1224.2 +079100 PERFORM DE-LETE. NC1224.2 +079200 PERFORM PRINT-DETAIL. NC1224.2 +079300 GO TO IND-INIT-GF-15. NC1224.2 +079400 IND-TEST-GF-14-1. NC1224.2 +079500 IF WRK-DU-999 (INDEX2 + 2) EQUAL TO 81 NC1224.2 +079600 PERFORM PASS NC1224.2 +079700 PERFORM PRINT-DETAIL NC1224.2 +079800 ELSE PERFORM FAIL NC1224.2 +079900 MOVE WRK-DU-999 (INDEX2 + 2) TO COMPUTED-N NC1224.2 +080000 MOVE 6 TO CORRECT-N NC1224.2 +080100 PERFORM PRINT-DETAIL. NC1224.2 +080200 ADD 1 TO REC-CT. NC1224.2 +080300 IND-TEST-GF-14-2. NC1224.2 +080400 IF TABLE1-REC (INDEX1 - 2) EQUAL TO ANS-XN-83-4 NC1224.2 +080500 PERFORM PASS NC1224.2 +080600 PERFORM PRINT-DETAIL NC1224.2 +080700 ELSE NC1224.2 +080800 PERFORM FAIL NC1224.2 +080900 MOVE TABLE1-REC (INDEX1 - 2) TO WRK-ER NC1224.2 +081000 MOVE ANS-XN-83-4 TO WRK-OK NC1224.2 +081100 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +081200 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +081300 PERFORM PRINT-DETAIL NC1224.2 +081400 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +081500 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +081600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +081700 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +081800 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +081900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +082000 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +082100 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +082200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +082300 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +082400 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +082500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +082600 IND-INIT-GF-15. NC1224.2 +082700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +082800 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1224.2 +082900 MOVE "REPL. FIRST AFTER" TO FEATURE. NC1224.2 +083000 MOVE 1 TO REC-CT. NC1224.2 +083100 PERFORM BUILD-TABLE1. NC1224.2 +083200 MOVE ZERO TO TABLE2. NC1224.2 +083300 SET INDEX1 TO 1. NC1224.2 +083400 SET INDEX2 TO 1. NC1224.2 +083500 SET INDEX4 TO 4. NC1224.2 +083600 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +083700 IND-TEST-GF-15-0. NC1224.2 +083800 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +083900 FOR ALL "A" BEFORE TABLE4-LETTER (INDEX4 + 1) NC1224.2 +084000 REPLACING FIRST TABLE4-LETTER (INDEX4 - 3) NC1224.2 +084100 BY "O" AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +084200 GO TO IND-TEST-GF-15-1. NC1224.2 +084300 IND-DELETE-GF-15. NC1224.2 +084400 PERFORM DE-LETE. NC1224.2 +084500 PERFORM PRINT-DETAIL. NC1224.2 +084600 GO TO IND-INIT-GF-16. NC1224.2 +084700 IND-TEST-GF-15-1. NC1224.2 +084800 IF WRK-DU-999 (INDEX2) EQUAL TO 7 NC1224.2 +084900 PERFORM PASS NC1224.2 +085000 PERFORM PRINT-DETAIL NC1224.2 +085100 ELSE PERFORM FAIL NC1224.2 +085200 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +085300 MOVE 7 TO CORRECT-N NC1224.2 +085400 PERFORM PRINT-DETAIL. NC1224.2 +085500 ADD 1 TO REC-CT. NC1224.2 +085600 IND-TEST-GF-15-2. NC1224.2 +085700 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-5 NC1224.2 +085800 PERFORM PASS NC1224.2 +085900 PERFORM PRINT-DETAIL NC1224.2 +086000 ELSE NC1224.2 +086100 PERFORM FAIL NC1224.2 +086200 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +086300 MOVE ANS-XN-83-5 TO WRK-OK NC1224.2 +086400 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +086500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +086600 PERFORM PRINT-DETAIL NC1224.2 +086700 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +086800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +086900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087000 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +087100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +087200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087300 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +087400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +087500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087600 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +087700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +087800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +087900 IND-INIT-GF-16. NC1224.2 +088000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +088100 MOVE "IND-TEST-GF-16" TO PAR-NAME. NC1224.2 +088200 MOVE "FOR LEADING" TO FEATURE. NC1224.2 +088300 MOVE 1 TO REC-CT. NC1224.2 +088400 PERFORM BUILD-TABLE1. NC1224.2 +088500 MOVE ZERO TO TABLE2. NC1224.2 +088600 SET INDEX1 TO 2. NC1224.2 +088700 SET INDEX2 TO 2. NC1224.2 +088800 SET INDEX4 TO 1. NC1224.2 +088900 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +089000 IND-TEST-GF-16-0. NC1224.2 +089100 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +089200 FOR LEADING TABLE4-LETTER (INDEX4) REPLACING NC1224.2 +089300 LEADING TABLE4-LETTER (INDEX4) BY "O". NC1224.2 +089400 GO TO IND-TEST-GF-16-1. NC1224.2 +089500 IND-DELETE-GF-16. NC1224.2 +089600 PERFORM DE-LETE. NC1224.2 +089700 PERFORM PRINT-DETAIL. NC1224.2 +089800 GO TO IND-INIT-GF-17. NC1224.2 +089900 IND-TEST-GF-16-1. NC1224.2 +090000 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +090100 PERFORM PASS NC1224.2 +090200 PERFORM PRINT-DETAIL NC1224.2 +090300 ELSE PERFORM FAIL NC1224.2 +090400 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +090500 MOVE 1 TO CORRECT-N NC1224.2 +090600 PERFORM PRINT-DETAIL. NC1224.2 +090700 ADD 1 TO REC-CT. NC1224.2 +090800 IND-TEST-GF-16-2. NC1224.2 +090900 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +091000 PERFORM PASS NC1224.2 +091100 PERFORM PRINT-DETAIL NC1224.2 +091200 ELSE NC1224.2 +091300 PERFORM FAIL NC1224.2 +091400 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +091500 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +091600 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +091700 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +091800 PERFORM PRINT-DETAIL NC1224.2 +091900 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +092000 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +092100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092200 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +092300 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +092400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092500 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +092600 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +092700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092800 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +092900 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +093000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +093100 IND-INIT-GF-17. NC1224.2 +093200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +093300 MOVE "IND-TEST-GF-17" TO PAR-NAME. NC1224.2 +093400 MOVE "LIT. BY AFTER INIT." TO FEATURE. NC1224.2 +093500 MOVE 1 TO REC-CT. NC1224.2 +093600 PERFORM BUILD-TABLE1. NC1224.2 +093700 MOVE ZERO TO TABLE2. NC1224.2 +093800 SET INDEX1 TO 3. NC1224.2 +093900 SET INDEX2 TO 3. NC1224.2 +094000 SET INDEX4 TO 7. NC1224.2 +094100 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +094200 IND-TEST-GF-17-0. NC1224.2 +094300 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +094400 FOR ALL "A" REPLACING FIRST "A" BY "O" NC1224.2 +094500 AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +094600 GO TO IND-TEST-GF-17-1. NC1224.2 +094700 IND-DELETE-GF-17. NC1224.2 +094800 PERFORM DE-LETE. NC1224.2 +094900 PERFORM PRINT-DETAIL. NC1224.2 +095000 GO TO IND-INIT-GF-18. NC1224.2 +095100 IND-TEST-GF-17-1. NC1224.2 +095200 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC1224.2 +095300 PERFORM PASS NC1224.2 +095400 PERFORM PRINT-DETAIL NC1224.2 +095500 ELSE PERFORM FAIL NC1224.2 +095600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +095700 MOVE 8 TO CORRECT-N NC1224.2 +095800 PERFORM PRINT-DETAIL. NC1224.2 +095900 ADD 1 TO REC-CT. NC1224.2 +096000 IND-TEST-GF-17-2. NC1224.2 +096100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-5 NC1224.2 +096200 PERFORM PASS NC1224.2 +096300 PERFORM PRINT-DETAIL NC1224.2 +096400 ELSE NC1224.2 +096500 PERFORM FAIL NC1224.2 +096600 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +096700 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +096800 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +096900 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +097000 PERFORM PRINT-DETAIL NC1224.2 +097100 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +097200 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +097300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +097400 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +097500 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +097600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +097700 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +097800 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +097900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +098000 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +098100 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +098200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +098300 IND-INIT-GF-18. NC1224.2 +098400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +098500 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1224.2 +098600 MOVE "CHARS AFTER ALL BEF." TO FEATURE. NC1224.2 +098700 MOVE 1 TO REC-CT. NC1224.2 +098800 PERFORM BUILD-TABLE1. NC1224.2 +098900 MOVE ZERO TO TABLE2. NC1224.2 +099000 SET INDEX1 TO 4. NC1224.2 +099100 SET INDEX2 TO 4. NC1224.2 +099200 SET INDEX4 TO 1. NC1224.2 +099300 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +099400 IND-TEST-GF-18-0. NC1224.2 +099500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +099600 FOR CHARACTERS AFTER TABLE4-LETTER (INDEX4) NC1224.2 +099700 REPLACING ALL "A" BY "O" NC1224.2 +099800 BEFORE TABLE4-LETTER (INDEX4 + 3). NC1224.2 +099900 GO TO IND-TEST-GF-18-1. NC1224.2 +100000 IND-DELETE-GF-18. NC1224.2 +100100 PERFORM DE-LETE. NC1224.2 +100200 PERFORM PRINT-DETAIL. NC1224.2 +100300 GO TO CCVS-999999. NC1224.2 +100400 IND-TEST-GF-18-1. NC1224.2 +100500 IF WRK-DU-999 (INDEX2) EQUAL TO 82 NC1224.2 +100600 PERFORM PASS NC1224.2 +100700 PERFORM PRINT-DETAIL NC1224.2 +100800 ELSE PERFORM FAIL NC1224.2 +100900 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +101000 MOVE 82 TO CORRECT-N NC1224.2 +101100 PERFORM PRINT-DETAIL. NC1224.2 +101200 ADD 1 TO REC-CT. NC1224.2 +101300 IND-TEST-GF-18-2. NC1224.2 +101400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +101500 PERFORM PASS NC1224.2 +101600 PERFORM PRINT-DETAIL NC1224.2 +101700 ELSE NC1224.2 +101800 PERFORM FAIL NC1224.2 +101900 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +102000 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +102100 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +102200 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +102300 PERFORM PRINT-DETAIL NC1224.2 +102400 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +102500 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +102600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +102700 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +102800 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +102900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +103000 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +103100 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +103200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +103300 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +103400 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +103500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +103600 CCVS-EXIT SECTION. NC1224.2 +103700 CCVS-999999. NC1224.2 +103800 GO TO CLOSE-FILES. NC1224.2 +*END-OF,NC122A +*HEADER,COBOL,NC123A +000100 IDENTIFICATION DIVISION. NC1234.2 +000200 PROGRAM-ID. NC1234.2 +000300 NC123A. NC1234.2 +000400**************************************************************** NC1234.2 +000500* * NC1234.2 +000600* VALIDATION FOR:- * NC1234.2 +000700* * NC1234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +000900* * NC1234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1234.2 +001100* * NC1234.2 +001200**************************************************************** NC1234.2 +001300* * NC1234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1234.2 +001500* * NC1234.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1234.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1234.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1234.2 +001900* * NC1234.2 +002000**************************************************************** NC1234.2 +002100* NC1234.2 +002200* PROGRAM NC123A TESTS THE USE OF INDEXED IDENTIFIERS WITH NC1234.2 +002300* FORMATS 1 AND 2 OF THE "ADD" AND "SUBTRACT" STATEMENTS AND NC1234.2 +002400* FORMAT 2 OF THE "GO" STATEMENT. NC1234.2 +002500* ONE AND TWO LEVELS OF INDEXING ARE USED AS WELL AS NC1234.2 +002600* RELATIVE INDEXING. NC1234.2 +002700* NC1234.2 +002800 ENVIRONMENT DIVISION. NC1234.2 +002900 CONFIGURATION SECTION. NC1234.2 +003000 SOURCE-COMPUTER. NC1234.2 +003100 XXXXX082. NC1234.2 +003200 OBJECT-COMPUTER. NC1234.2 +003300 XXXXX083. NC1234.2 +003400 INPUT-OUTPUT SECTION. NC1234.2 +003500 FILE-CONTROL. NC1234.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1234.2 +003700 XXXXX055. NC1234.2 +003800 DATA DIVISION. NC1234.2 +003900 FILE SECTION. NC1234.2 +004000 FD PRINT-FILE. NC1234.2 +004100 01 PRINT-REC PICTURE X(120). NC1234.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC1234.2 +004300 WORKING-STORAGE SECTION. NC1234.2 +004400 01 TABLE1. NC1234.2 +004500 02 TABLE1-NUM PICTURE S9V99 NC1234.2 +004600 OCCURS 10 TIMES NC1234.2 +004700 INDEXED BY INDEX1. NC1234.2 +004800 01 TABLE2. NC1234.2 +004900 02 TABLE2-NUM PICTURE 9V9 NC1234.2 +005000 OCCURS 6 TIMES NC1234.2 +005100 INDEXED BY INDEX2. NC1234.2 +005200 01 TABLE3. NC1234.2 +005300 02 TABLE3-NUM PICTURE 99V9 NC1234.2 +005400 OCCURS 6 TIMES NC1234.2 +005500 INDEXED BY INDEX3. NC1234.2 +005600 01 TABLE4. NC1234.2 +005700 02 TABLE4-NUM1 OCCURS 3 TIMES NC1234.2 +005800 INDEXED BY INDEX4-1. NC1234.2 +005900 03 TABLE4-NUM2 PICTURE 99 NC1234.2 +006000 OCCURS 3 TIMES NC1234.2 +006100 INDEXED BY INDEX4-2. NC1234.2 +006200 01 TABLE5. NC1234.2 +006300 02 TABLE5-NUM PIC 999 NC1234.2 +006400 OCCURS 2 TIMES NC1234.2 +006500 INDEXED BY INDEX5. NC1234.2 +006600 01 NUM-9V9 PICTURE 9V9. NC1234.2 +006700 01 TEST-RESULTS. NC1234.2 +006800 02 FILLER PIC X VALUE SPACE. NC1234.2 +006900 02 FEATURE PIC X(20) VALUE SPACE. NC1234.2 +007000 02 FILLER PIC X VALUE SPACE. NC1234.2 +007100 02 P-OR-F PIC X(5) VALUE SPACE. NC1234.2 +007200 02 FILLER PIC X VALUE SPACE. NC1234.2 +007300 02 PAR-NAME. NC1234.2 +007400 03 FILLER PIC X(19) VALUE SPACE. NC1234.2 +007500 03 PARDOT-X PIC X VALUE SPACE. NC1234.2 +007600 03 DOTVALUE PIC 99 VALUE ZERO. NC1234.2 +007700 02 FILLER PIC X(8) VALUE SPACE. NC1234.2 +007800 02 RE-MARK PIC X(61). NC1234.2 +007900 01 TEST-COMPUTED. NC1234.2 +008000 02 FILLER PIC X(30) VALUE SPACE. NC1234.2 +008100 02 FILLER PIC X(17) VALUE NC1234.2 +008200 " COMPUTED=". NC1234.2 +008300 02 COMPUTED-X. NC1234.2 +008400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1234.2 +008500 03 COMPUTED-N REDEFINES COMPUTED-A NC1234.2 +008600 PIC -9(9).9(9). NC1234.2 +008700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1234.2 +008800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1234.2 +008900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1234.2 +009000 03 CM-18V0 REDEFINES COMPUTED-A. NC1234.2 +009100 04 COMPUTED-18V0 PIC -9(18). NC1234.2 +009200 04 FILLER PIC X. NC1234.2 +009300 03 FILLER PIC X(50) VALUE SPACE. NC1234.2 +009400 01 TEST-CORRECT. NC1234.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC1234.2 +009600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1234.2 +009700 02 CORRECT-X. NC1234.2 +009800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1234.2 +009900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1234.2 +010000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1234.2 +010100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1234.2 +010200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1234.2 +010300 03 CR-18V0 REDEFINES CORRECT-A. NC1234.2 +010400 04 CORRECT-18V0 PIC -9(18). NC1234.2 +010500 04 FILLER PIC X. NC1234.2 +010600 03 FILLER PIC X(2) VALUE SPACE. NC1234.2 +010700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1234.2 +010800 01 CCVS-C-1. NC1234.2 +010900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1234.2 +011000- "SS PARAGRAPH-NAME NC1234.2 +011100- " REMARKS". NC1234.2 +011200 02 FILLER PIC X(20) VALUE SPACE. NC1234.2 +011300 01 CCVS-C-2. NC1234.2 +011400 02 FILLER PIC X VALUE SPACE. NC1234.2 +011500 02 FILLER PIC X(6) VALUE "TESTED". NC1234.2 +011600 02 FILLER PIC X(15) VALUE SPACE. NC1234.2 +011700 02 FILLER PIC X(4) VALUE "FAIL". NC1234.2 +011800 02 FILLER PIC X(94) VALUE SPACE. NC1234.2 +011900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1234.2 +012000 01 REC-CT PIC 99 VALUE ZERO. NC1234.2 +012100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1234.2 +012600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1234.2 +012700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1234.2 +012800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1234.2 +012900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1234.2 +013000 01 CCVS-H-1. NC1234.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC1234.2 +013200 02 FILLER PIC X(42) VALUE NC1234.2 +013300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1234.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC1234.2 +013500 01 CCVS-H-2A. NC1234.2 +013600 02 FILLER PIC X(40) VALUE SPACE. NC1234.2 +013700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1234.2 +013800 02 FILLER PIC XXXX VALUE NC1234.2 +013900 "4.2 ". NC1234.2 +014000 02 FILLER PIC X(28) VALUE NC1234.2 +014100 " COPY - NOT FOR DISTRIBUTION". NC1234.2 +014200 02 FILLER PIC X(41) VALUE SPACE. NC1234.2 +014300 NC1234.2 +014400 01 CCVS-H-2B. NC1234.2 +014500 02 FILLER PIC X(15) VALUE NC1234.2 +014600 "TEST RESULT OF ". NC1234.2 +014700 02 TEST-ID PIC X(9). NC1234.2 +014800 02 FILLER PIC X(4) VALUE NC1234.2 +014900 " IN ". NC1234.2 +015000 02 FILLER PIC X(12) VALUE NC1234.2 +015100 " HIGH ". NC1234.2 +015200 02 FILLER PIC X(22) VALUE NC1234.2 +015300 " LEVEL VALIDATION FOR ". NC1234.2 +015400 02 FILLER PIC X(58) VALUE NC1234.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +015600 01 CCVS-H-3. NC1234.2 +015700 02 FILLER PIC X(34) VALUE NC1234.2 +015800 " FOR OFFICIAL USE ONLY ". NC1234.2 +015900 02 FILLER PIC X(58) VALUE NC1234.2 +016000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1234.2 +016100 02 FILLER PIC X(28) VALUE NC1234.2 +016200 " COPYRIGHT 1985 ". NC1234.2 +016300 01 CCVS-E-1. NC1234.2 +016400 02 FILLER PIC X(52) VALUE SPACE. NC1234.2 +016500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1234.2 +016600 02 ID-AGAIN PIC X(9). NC1234.2 +016700 02 FILLER PIC X(45) VALUE SPACES. NC1234.2 +016800 01 CCVS-E-2. NC1234.2 +016900 02 FILLER PIC X(31) VALUE SPACE. NC1234.2 +017000 02 FILLER PIC X(21) VALUE SPACE. NC1234.2 +017100 02 CCVS-E-2-2. NC1234.2 +017200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1234.2 +017300 03 FILLER PIC X VALUE SPACE. NC1234.2 +017400 03 ENDER-DESC PIC X(44) VALUE NC1234.2 +017500 "ERRORS ENCOUNTERED". NC1234.2 +017600 01 CCVS-E-3. NC1234.2 +017700 02 FILLER PIC X(22) VALUE NC1234.2 +017800 " FOR OFFICIAL USE ONLY". NC1234.2 +017900 02 FILLER PIC X(12) VALUE SPACE. NC1234.2 +018000 02 FILLER PIC X(58) VALUE NC1234.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +018200 02 FILLER PIC X(13) VALUE SPACE. NC1234.2 +018300 02 FILLER PIC X(15) VALUE NC1234.2 +018400 " COPYRIGHT 1985". NC1234.2 +018500 01 CCVS-E-4. NC1234.2 +018600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1234.2 +018700 02 FILLER PIC X(4) VALUE " OF ". NC1234.2 +018800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1234.2 +018900 02 FILLER PIC X(40) VALUE NC1234.2 +019000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1234.2 +019100 01 XXINFO. NC1234.2 +019200 02 FILLER PIC X(19) VALUE NC1234.2 +019300 "*** INFORMATION ***". NC1234.2 +019400 02 INFO-TEXT. NC1234.2 +019500 04 FILLER PIC X(8) VALUE SPACE. NC1234.2 +019600 04 XXCOMPUTED PIC X(20). NC1234.2 +019700 04 FILLER PIC X(5) VALUE SPACE. NC1234.2 +019800 04 XXCORRECT PIC X(20). NC1234.2 +019900 02 INF-ANSI-REFERENCE PIC X(48). NC1234.2 +020000 01 HYPHEN-LINE. NC1234.2 +020100 02 FILLER PIC IS X VALUE IS SPACE. NC1234.2 +020200 02 FILLER PIC IS X(65) VALUE IS "************************NC1234.2 +020300- "*****************************************". NC1234.2 +020400 02 FILLER PIC IS X(54) VALUE IS "************************NC1234.2 +020500- "******************************". NC1234.2 +020600 01 CCVS-PGM-ID PIC X(9) VALUE NC1234.2 +020700 "NC123A". NC1234.2 +020800 PROCEDURE DIVISION. NC1234.2 +020900 CCVS1 SECTION. NC1234.2 +021000 OPEN-FILES. NC1234.2 +021100 OPEN OUTPUT PRINT-FILE. NC1234.2 +021200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1234.2 +021300 MOVE SPACE TO TEST-RESULTS. NC1234.2 +021400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1234.2 +021500 GO TO CCVS1-EXIT. NC1234.2 +021600 CLOSE-FILES. NC1234.2 +021700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1234.2 +021800 TERMINATE-CCVS. NC1234.2 +021900S EXIT PROGRAM. NC1234.2 +022000STERMINATE-CALL. NC1234.2 +022100 STOP RUN. NC1234.2 +022200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1234.2 +022300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1234.2 +022400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1234.2 +022500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1234.2 +022600 MOVE "****TEST DELETED****" TO RE-MARK. NC1234.2 +022700 PRINT-DETAIL. NC1234.2 +022800 IF REC-CT NOT EQUAL TO ZERO NC1234.2 +022900 MOVE "." TO PARDOT-X NC1234.2 +023000 MOVE REC-CT TO DOTVALUE. NC1234.2 +023100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1234.2 +023200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1234.2 +023300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1234.2 +023400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1234.2 +023500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1234.2 +023600 MOVE SPACE TO CORRECT-X. NC1234.2 +023700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1234.2 +023800 MOVE SPACE TO RE-MARK. NC1234.2 +023900 HEAD-ROUTINE. NC1234.2 +024000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1234.2 +024300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1234.2 +024400 COLUMN-NAMES-ROUTINE. NC1234.2 +024500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +024600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +024800 END-ROUTINE. NC1234.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1234.2 +025000 END-RTN-EXIT. NC1234.2 +025100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +025200 END-ROUTINE-1. NC1234.2 +025300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1234.2 +025400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1234.2 +025500 ADD PASS-COUNTER TO ERROR-HOLD. NC1234.2 +025600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1234.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1234.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1234.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1234.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1234.2 +026100 END-ROUTINE-12. NC1234.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1234.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1234.2 +026400 MOVE "NO " TO ERROR-TOTAL NC1234.2 +026500 ELSE NC1234.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1234.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1234.2 +026800 PERFORM WRITE-LINE. NC1234.2 +026900 END-ROUTINE-13. NC1234.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1234.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE NC1234.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1234.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1234.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO NC1234.2 +027600 MOVE "NO " TO ERROR-TOTAL NC1234.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1234.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1234.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +028100 WRITE-LINE. NC1234.2 +028200 ADD 1 TO RECORD-COUNT. NC1234.2 +028300Y IF RECORD-COUNT GREATER 42 NC1234.2 +028400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1234.2 +028500Y MOVE SPACE TO DUMMY-RECORD NC1234.2 +028600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1234.2 +028700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1234.2 +028800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1234.2 +028900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1234.2 +029000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1234.2 +029100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1234.2 +029500Y MOVE ZERO TO RECORD-COUNT. NC1234.2 +029600 PERFORM WRT-LN. NC1234.2 +029700 WRT-LN. NC1234.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1234.2 +029900 MOVE SPACE TO DUMMY-RECORD. NC1234.2 +030000 BLANK-LINE-PRINT. NC1234.2 +030100 PERFORM WRT-LN. NC1234.2 +030200 FAIL-ROUTINE. NC1234.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE NC1234.2 +030400 GO TO FAIL-ROUTINE-WRITE. NC1234.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1234.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1234.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1234.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1234.2 +031000 GO TO FAIL-ROUTINE-EX. NC1234.2 +031100 FAIL-ROUTINE-WRITE. NC1234.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1234.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1234.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1234.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1234.2 +031600 FAIL-ROUTINE-EX. EXIT. NC1234.2 +031700 BAIL-OUT. NC1234.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1234.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1234.2 +032000 BAIL-OUT-WRITE. NC1234.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1234.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1234.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1234.2 +032500 BAIL-OUT-EX. EXIT. NC1234.2 +032600 CCVS1-EXIT. NC1234.2 +032700 EXIT. NC1234.2 +032800 BUILD-TABLE1. NC1234.2 +032900 MOVE 1.00 TO TABLE1-NUM (1). NC1234.2 +033000 MOVE 0.68 TO TABLE1-NUM (2). NC1234.2 +033100 MOVE 9.00 TO TABLE1-NUM (3). NC1234.2 +033200 MOVE 5.00 TO TABLE1-NUM (4). NC1234.2 +033300 MOVE 2.00 TO TABLE1-NUM (5). NC1234.2 +033400 MOVE 1.50 TO TABLE1-NUM (6). NC1234.2 +033500 MOVE 3.50 TO TABLE1-NUM (7). NC1234.2 +033600 MOVE 6.60 TO TABLE1-NUM (8). NC1234.2 +033700 MOVE 2.56 TO TABLE1-NUM (9). NC1234.2 +033800 MOVE -9.00 TO TABLE1-NUM (10). NC1234.2 +033900 BUILD-TABLE2. NC1234.2 +034000 MOVE 5.0 TO TABLE2-NUM (1). NC1234.2 +034100 MOVE 4.0 TO TABLE2-NUM (2). NC1234.2 +034200 MOVE 9.0 TO TABLE2-NUM (3). NC1234.2 +034300 MOVE 4.0 TO TABLE2-NUM (4). NC1234.2 +034400 MOVE 4.6 TO TABLE2-NUM (5). NC1234.2 +034500 MOVE 1.3 TO TABLE2-NUM (6). NC1234.2 +034600 BUILD-TABLE4. NC1234.2 +034700 MOVE 20 TO TABLE4-NUM2 (1 1). NC1234.2 +034800 MOVE 21 TO TABLE4-NUM2 (1 2). NC1234.2 +034900 MOVE 22 TO TABLE4-NUM2 (1 3). NC1234.2 +035000 MOVE 23 TO TABLE4-NUM2 (2 1). NC1234.2 +035100 MOVE 24 TO TABLE4-NUM2 (2 2). NC1234.2 +035200 MOVE 25 TO TABLE4-NUM2 (2 3). NC1234.2 +035300 MOVE 26 TO TABLE4-NUM2 (3 1). NC1234.2 +035400 MOVE 27 TO TABLE4-NUM2 (3 2). NC1234.2 +035500 MOVE 28 TO TABLE4-NUM2 (3 3). NC1234.2 +035600 BUILD-TABLE5. NC1234.2 +035700 MOVE 003 TO TABLE5-NUM (1). NC1234.2 +035800 MOVE 002 TO TABLE5-NUM (2). NC1234.2 +035900 IND-INIT-GF-1. NC1234.2 +036000 MOVE "ADD TO" TO FEATURE. NC1234.2 +036100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +036200 MOVE 1.0 TO NUM-9V9. NC1234.2 +036300 SET INDEX1 TO 1. NC1234.2 +036400 IND-TEST-GF-1-0. NC1234.2 +036500 ADD TABLE1-NUM (INDEX1) TO NUM-9V9. NC1234.2 +036600 IND-TEST-GF-1-1. NC1234.2 +036700 IF NUM-9V9 EQUAL TO 2.0 NC1234.2 +036800 PERFORM PASS NC1234.2 +036900 ELSE GO TO IND-FAIL-GF-1. NC1234.2 +037000 GO TO IND-WRITE-GF-1. NC1234.2 +037100 IND-DELETE-GF-1. NC1234.2 +037200 PERFORM DE-LETE. NC1234.2 +037300 GO TO IND-WRITE-GF-1. NC1234.2 +037400 IND-FAIL-GF-1. NC1234.2 +037500 PERFORM FAIL. NC1234.2 +037600 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +037700 MOVE 2.0 TO CORRECT-14V4. NC1234.2 +037800 IND-WRITE-GF-1. NC1234.2 +037900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1234.2 +038000 PERFORM PRINT-DETAIL. NC1234.2 +038100 IND-INIT-GF-2. NC1234.2 +038200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +038300 MOVE "ADD ROUNDED" TO FEATURE. NC1234.2 +038400 MOVE 2.0 TO NUM-9V9. NC1234.2 +038500 SET INDEX1 TO 2. NC1234.2 +038600 IND-TEST-GF-2-0. NC1234.2 +038700 ADD TABLE1-NUM (INDEX1) TO NUM-9V9 ROUNDED. NC1234.2 +038800 IND-TEST-GF-2-1. NC1234.2 +038900 IF NUM-9V9 EQUAL TO 2.7 NC1234.2 +039000 PERFORM PASS NC1234.2 +039100 ELSE GO TO IND-FAIL-GF-2. NC1234.2 +039200 GO TO IND-WRITE-GF-2. NC1234.2 +039300 IND-DELETE-GF-2. NC1234.2 +039400 PERFORM DE-LETE. NC1234.2 +039500 GO TO IND-WRITE-GF-2. NC1234.2 +039600 IND-FAIL-GF-2. NC1234.2 +039700 PERFORM FAIL. NC1234.2 +039800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +039900 MOVE 2.7 TO CORRECT-14V4. NC1234.2 +040000 IND-WRITE-GF-2. NC1234.2 +040100 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1234.2 +040200 PERFORM PRINT-DETAIL. NC1234.2 +040300 IND-INIT-GF-3. NC1234.2 +040400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +040500 MOVE "ADD ON SIZE ERROR" TO FEATURE. NC1234.2 +040600 MOVE 5.0 TO NUM-9V9. NC1234.2 +040700 SET INDEX1 TO 3. NC1234.2 +040800 IND-TEST-GF-3-1. NC1234.2 +040900 ADD TABLE1-NUM (INDEX1) TO NUM-9V9 ON SIZE ERROR NC1234.2 +041000 PERFORM PASS NC1234.2 +041100 GO TO IND-WRITE-GF-3-1. NC1234.2 +041200 GO TO IND-FAIL-GF-3-1. NC1234.2 +041300 IND-DELETE-GF-3-1. NC1234.2 +041400 PERFORM DE-LETE. NC1234.2 +041500 GO TO IND-WRITE-GF-3-1. NC1234.2 +041600 IND-FAIL-GF-3-1. NC1234.2 +041700 PERFORM FAIL. NC1234.2 +041800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +041900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +042000 IND-WRITE-GF-3-1. NC1234.2 +042100 MOVE "IND-TEST-GF-3-1" TO PAR-NAME. NC1234.2 +042200 PERFORM PRINT-DETAIL. NC1234.2 +042300 IND-TEST-GF-3-2. NC1234.2 +042400 IF NUM-9V9 = 5.0 NC1234.2 +042500 PERFORM PASS NC1234.2 +042600 GO TO IND-WRITE-GF-3-2. NC1234.2 +042700 GO TO IND-FAIL-GF-3-2. NC1234.2 +042800 IND-DELETE-GF-3-2. NC1234.2 +042900 PERFORM DE-LETE. NC1234.2 +043000 GO TO IND-WRITE-GF-3-2. NC1234.2 +043100 IND-FAIL-GF-3-2. NC1234.2 +043200 PERFORM FAIL. NC1234.2 +043300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +043400 MOVE 5.0 TO CORRECT-14V4. NC1234.2 +043500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1234.2 +043600 IND-WRITE-GF-3-2. NC1234.2 +043700 MOVE "IND-TEST-GF-3-2" TO PAR-NAME. NC1234.2 +043800 PERFORM PRINT-DETAIL. NC1234.2 +043900 IND-INIT-GF-4. NC1234.2 +044000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +044100 MOVE "ADD TO" TO FEATURE. NC1234.2 +044200 SET INDEX1 TO 1. NC1234.2 +044300 SET INDEX2 TO 1. NC1234.2 +044400 IND-TEST-GF-4-0. NC1234.2 +044500 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2). NC1234.2 +044600 IND-TEST-GF-4-1. NC1234.2 +044700 IF TABLE2-NUM (INDEX2) EQUAL TO 6.0 NC1234.2 +044800 PERFORM PASS NC1234.2 +044900 ELSE GO TO IND-FAIL-GF-4. NC1234.2 +045000 GO TO IND-WRITE-GF-4. NC1234.2 +045100 IND-DELETE-GF-4. NC1234.2 +045200 PERFORM DE-LETE. NC1234.2 +045300 GO TO IND-WRITE-GF-4. NC1234.2 +045400 IND-FAIL-GF-4. NC1234.2 +045500 PERFORM FAIL. NC1234.2 +045600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +045700 MOVE 6.0 TO CORRECT-14V4. NC1234.2 +045800 IND-WRITE-GF-4. NC1234.2 +045900 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1234.2 +046000 PERFORM PRINT-DETAIL. NC1234.2 +046100 IND-INIT-GF-5. NC1234.2 +046200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +046300 MOVE "ADD ROUNDED" TO FEATURE. NC1234.2 +046400 PERFORM BUILD-TABLE2. NC1234.2 +046500 SET INDEX1 TO 2. NC1234.2 +046600 SET INDEX2 TO 2. NC1234.2 +046700 IND-TEST-GF-5-0. NC1234.2 +046800 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2) ROUNDED. NC1234.2 +046900 IND-TEST-GF-5-1. NC1234.2 +047000 IF TABLE2-NUM (INDEX2) EQUAL TO 4.7 NC1234.2 +047100 PERFORM PASS NC1234.2 +047200 ELSE GO TO IND-FAIL-GF-5. NC1234.2 +047300 GO TO IND-WRITE-GF-5. NC1234.2 +047400 IND-DELETE-GF-5. NC1234.2 +047500 PERFORM DE-LETE. NC1234.2 +047600 GO TO IND-WRITE-GF-5. NC1234.2 +047700 IND-FAIL-GF-5. NC1234.2 +047800 PERFORM FAIL. NC1234.2 +047900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +048000 MOVE 4.7 TO CORRECT-14V4. NC1234.2 +048100 IND-WRITE-GF-5. NC1234.2 +048200 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1234.2 +048300 PERFORM PRINT-DETAIL. NC1234.2 +048400 IND-INIT-GF-6. NC1234.2 +048500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +048600 MOVE "ADD ON SIZE ERROR" TO FEATURE. NC1234.2 +048700 PERFORM BUILD-TABLE2. NC1234.2 +048800 SET INDEX1 TO 3. NC1234.2 +048900 SET INDEX2 TO 3. NC1234.2 +049000 IND-TEST-GF-6-1. NC1234.2 +049100 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2) ON SIZE ERROR NC1234.2 +049200 PERFORM PASS NC1234.2 +049300 GO TO IND-WRITE-GF-6-1. NC1234.2 +049400 GO TO IND-FAIL-GF-6-1. NC1234.2 +049500 IND-DELETE-GF-6-1. NC1234.2 +049600 PERFORM DE-LETE. NC1234.2 +049700 GO TO IND-WRITE-GF-6-1. NC1234.2 +049800 IND-FAIL-GF-6-1. NC1234.2 +049900 PERFORM FAIL. NC1234.2 +050000 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +050100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +050200 IND-WRITE-GF-6-1. NC1234.2 +050300 MOVE "IND-TEST-GF-6-1" TO PAR-NAME. NC1234.2 +050400 PERFORM PRINT-DETAIL. NC1234.2 +050500 IND-TEST-GF-6-2. NC1234.2 +050600 IF TABLE2-NUM (INDEX2) = 9.0 NC1234.2 +050700 PERFORM PASS NC1234.2 +050800 GO TO IND-WRITE-GF-6-2. NC1234.2 +050900 GO TO IND-FAIL-GF-6-2. NC1234.2 +051000 IND-DELETE-GF-6-2. NC1234.2 +051100 PERFORM DE-LETE. NC1234.2 +051200 GO TO IND-WRITE-GF-6-2. NC1234.2 +051300 IND-FAIL-GF-6-2. NC1234.2 +051400 PERFORM FAIL. NC1234.2 +051500 MOVE 9.0 TO CORRECT-14V4. NC1234.2 +051600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +051700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +051800 IND-WRITE-GF-6-2. NC1234.2 +051900 MOVE "IND-TEST-GF-6-2" TO PAR-NAME. NC1234.2 +052000 PERFORM PRINT-DETAIL. NC1234.2 +052100 IND-INIT-GF-10. NC1234.2 +052200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +052300 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +052400 MOVE ZERO TO NUM-9V9. NC1234.2 +052500 SET INDEX1 TO 4. NC1234.2 +052600 IND-TEST-GF-10-0. NC1234.2 +052700 ADD 3 TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1234.2 +052800 IND-TEST-GF-10-1. NC1234.2 +052900 IF NUM-9V9 EQUAL TO 8.0 NC1234.2 +053000 PERFORM PASS NC1234.2 +053100 ELSE GO TO IND-FAIL-GF-10. NC1234.2 +053200 GO TO IND-WRITE-GF-10. NC1234.2 +053300 IND-DELETE-GF-10. NC1234.2 +053400 PERFORM DE-LETE. NC1234.2 +053500 GO TO IND-WRITE-GF-10. NC1234.2 +053600 IND-FAIL-GF-10. NC1234.2 +053700 PERFORM FAIL. NC1234.2 +053800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +053900 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +054000 IND-WRITE-GF-10. NC1234.2 +054100 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1234.2 +054200 PERFORM PRINT-DETAIL. NC1234.2 +054300 IND-INIT-GF-11. NC1234.2 +054400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +054500 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +054600 MOVE ZERO TO NUM-9V9. NC1234.2 +054700 PERFORM BUILD-TABLE2. NC1234.2 +054800 SET INDEX1 TO 1. NC1234.2 +054900 SET INDEX2 TO 4. NC1234.2 +055000 IND-TEST-GF-11-0. NC1234.2 +055100 ADD TABLE1-NUM (INDEX1) TABLE2-NUM (INDEX2) GIVING NUM-9V9. NC1234.2 +055200 IND-TEST-GF-11-1. NC1234.2 +055300 IF NUM-9V9 EQUAL TO 5.0 NC1234.2 +055400 PERFORM PASS NC1234.2 +055500 ELSE GO TO IND-FAIL-GF-11. NC1234.2 +055600 GO TO IND-WRITE-GF-11. NC1234.2 +055700 IND-DELETE-GF-11. NC1234.2 +055800 PERFORM DE-LETE. NC1234.2 +055900 GO TO IND-WRITE-GF-11. NC1234.2 +056000 IND-FAIL-GF-11. NC1234.2 +056100 PERFORM FAIL. NC1234.2 +056200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +056300 MOVE 5.0 TO CORRECT-14V4. NC1234.2 +056400 IND-WRITE-GF-11. NC1234.2 +056500 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1234.2 +056600 PERFORM PRINT-DETAIL. NC1234.2 +056700 IND-INIT-GF-12. NC1234.2 +056800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +056900 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +057000 PERFORM BUILD-TABLE2. NC1234.2 +057100 MOVE ZERO TO TABLE3. NC1234.2 +057200 SET INDEX1 TO 5. NC1234.2 +057300 SET INDEX2 TO 1. NC1234.2 +057400 SET INDEX3 TO 3. NC1234.2 +057500 IND-TEST-GF-12-0. NC1234.2 +057600 ADD TABLE1-NUM (INDEX1) TABLE2-NUM (INDEX2) NC1234.2 +057700 GIVING TABLE3-NUM (INDEX3). NC1234.2 +057800 IND-TEST-GF-12-1. NC1234.2 +057900 IF TABLE3-NUM (INDEX3) EQUAL TO 7.0 NC1234.2 +058000 PERFORM PASS NC1234.2 +058100 ELSE GO TO IND-FAIL-GF-12. NC1234.2 +058200 GO TO IND-WRITE-GF-12. NC1234.2 +058300 IND-DELETE-GF-12. NC1234.2 +058400 PERFORM DE-LETE. NC1234.2 +058500 GO TO IND-WRITE-GF-12. NC1234.2 +058600 IND-FAIL-GF-12. NC1234.2 +058700 PERFORM FAIL. NC1234.2 +058800 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1234.2 +058900 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +059000 IND-WRITE-GF-12. NC1234.2 +059100 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1234.2 +059200 PERFORM PRINT-DETAIL. NC1234.2 +059300 IND-INIT-GF-7. NC1234.2 +059400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +059500 MOVE "ADD TO" TO FEATURE. NC1234.2 +059600 SET INDEX4-1 TO 3. NC1234.2 +059700 SET INDEX4-2 TO 2. NC1234.2 +059800 IND-TEST-GF-7-0. NC1234.2 +059900 ADD TABLE4-NUM2 (3 1) TO TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1234.2 +060000 IND-TEST-GF-7-1. NC1234.2 +060100 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 53 NC1234.2 +060200 PERFORM PASS NC1234.2 +060300 ELSE GO TO IND-FAIL-GF-7. NC1234.2 +060400 GO TO IND-WRITE-GF-7. NC1234.2 +060500 IND-DELETE-GF-7. NC1234.2 +060600 PERFORM DE-LETE. NC1234.2 +060700 GO TO IND-WRITE-GF-7. NC1234.2 +060800 IND-FAIL-GF-7. NC1234.2 +060900 PERFORM FAIL. NC1234.2 +061000 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1234.2 +061100 MOVE 53 TO CORRECT-14V4. NC1234.2 +061200 IND-WRITE-GF-7. NC1234.2 +061300 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1234.2 +061400 PERFORM PRINT-DETAIL. NC1234.2 +061500 IND-INIT-GF-8. NC1234.2 +061600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +061700 MOVE "ADD TO" TO FEATURE. NC1234.2 +061800 MOVE 1.6 TO NUM-9V9. NC1234.2 +061900 SET INDEX1 TO 5. NC1234.2 +062000 IND-TEST-GF-8-0. NC1234.2 +062100 ADD TABLE1-NUM (INDEX1 + 1) TO NUM-9V9. NC1234.2 +062200 IND-TEST-GF-8-1. NC1234.2 +062300 IF NUM-9V9 EQUAL TO 3.1 NC1234.2 +062400 PERFORM PASS NC1234.2 +062500 ELSE GO TO IND-FAIL-GF-8. NC1234.2 +062600 GO TO IND-WRITE-GF-8. NC1234.2 +062700 IND-DELETE-GF-8. NC1234.2 +062800 PERFORM DE-LETE. NC1234.2 +062900 GO TO IND-WRITE-GF-8. NC1234.2 +063000 IND-FAIL-GF-8. NC1234.2 +063100 PERFORM FAIL. NC1234.2 +063200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +063300 MOVE 3.1 TO CORRECT-14V4. NC1234.2 +063400 IND-WRITE-GF-8. NC1234.2 +063500 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1234.2 +063600 PERFORM PRINT-DETAIL. NC1234.2 +063700 IND-INIT-GF-9. NC1234.2 +063800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +063900 MOVE "ADD TO" TO FEATURE. NC1234.2 +064000 PERFORM BUILD-TABLE2. NC1234.2 +064100 SET INDEX1 TO 6. NC1234.2 +064200 SET INDEX2 TO 6. NC1234.2 +064300 IND-TEST-GF-9-0. NC1234.2 +064400 ADD TABLE1-NUM (INDEX1 + 1) TO TABLE2-NUM (INDEX2 - 1). NC1234.2 +064500 IND-TEST-GF-9-1. NC1234.2 +064600 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 8.1 NC1234.2 +064700 PERFORM PASS NC1234.2 +064800 ELSE GO TO IND-FAIL-GF-9. NC1234.2 +064900 GO TO IND-WRITE-GF-9. NC1234.2 +065000 IND-DELETE-GF-9. NC1234.2 +065100 PERFORM DE-LETE. NC1234.2 +065200 GO TO IND-WRITE-GF-9. NC1234.2 +065300 IND-FAIL-GF-9. NC1234.2 +065400 PERFORM FAIL. NC1234.2 +065500 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1234.2 +065600 MOVE 8.1 TO CORRECT-14V4. NC1234.2 +065700 IND-WRITE-GF-9. NC1234.2 +065800 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1234.2 +065900 PERFORM PRINT-DETAIL. NC1234.2 +066000 IND-INIT-GF-13. NC1234.2 +066100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +066200 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +066300 PERFORM BUILD-TABLE2. NC1234.2 +066400 MOVE ZERO TO NUM-9V9. NC1234.2 +066500 SET INDEX1 TO 7. NC1234.2 +066600 SET INDEX2 TO 4. NC1234.2 +066700 IND-TEST-GF-13-0. NC1234.2 +066800 ADD TABLE1-NUM (INDEX1 + 1) TABLE2-NUM (INDEX2 + 2) NC1234.2 +066900 GIVING NUM-9V9. NC1234.2 +067000 IND-TEST-GF-13-1. NC1234.2 +067100 IF NUM-9V9 EQUAL TO 7.9 NC1234.2 +067200 PERFORM PASS NC1234.2 +067300 ELSE GO TO IND-FAIL-GF-13. NC1234.2 +067400 GO TO IND-WRITE-GF-13. NC1234.2 +067500 IND-DELETE-GF-13. NC1234.2 +067600 PERFORM DE-LETE. NC1234.2 +067700 GO TO IND-WRITE-GF-13. NC1234.2 +067800 IND-FAIL-GF-13. NC1234.2 +067900 PERFORM FAIL. NC1234.2 +068000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +068100 MOVE 7.9 TO CORRECT-14V4. NC1234.2 +068200 IND-WRITE-GF-13. NC1234.2 +068300 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1234.2 +068400 PERFORM PRINT-DETAIL. NC1234.2 +068500 IND-INIT-GF-14. NC1234.2 +068600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +068700 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +068800 PERFORM BUILD-TABLE2. NC1234.2 +068900 MOVE ZERO TO TABLE3. NC1234.2 +069000 SET INDEX1 TO 3. NC1234.2 +069100 SET INDEX2 TO 2. NC1234.2 +069200 SET INDEX3 TO 6. NC1234.2 +069300 IND-TEST-GF-14-0. NC1234.2 +069400 ADD TABLE1-NUM (INDEX1 + 1) TABLE2-NUM (INDEX2 + 1) NC1234.2 +069500 GIVING TABLE3-NUM (INDEX3 - 2). NC1234.2 +069600 IND-TEST-GF-14-1. NC1234.2 +069700 IF TABLE3-NUM (INDEX3 - 2) EQUAL TO 14.0 NC1234.2 +069800 PERFORM PASS NC1234.2 +069900 ELSE GO TO IND-FAIL-GF-14. NC1234.2 +070000 GO TO IND-WRITE-GF-14. NC1234.2 +070100 IND-DELETE-GF-14. NC1234.2 +070200 PERFORM DE-LETE. NC1234.2 +070300 GO TO IND-WRITE-GF-14. NC1234.2 +070400 IND-FAIL-GF-14. NC1234.2 +070500 PERFORM FAIL. NC1234.2 +070600 MOVE TABLE3-NUM (INDEX3 - 2) TO COMPUTED-14V4. NC1234.2 +070700 MOVE 14.0 TO CORRECT-14V4. NC1234.2 +070800 IND-WRITE-GF-14. NC1234.2 +070900 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1234.2 +071000 PERFORM PRINT-DETAIL. NC1234.2 +071100 IND-INIT-GF-15. NC1234.2 +071200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +071300 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +071400 MOVE 3.0 TO NUM-9V9. NC1234.2 +071500 SET INDEX1 TO 1. NC1234.2 +071600 IND-TEST-GF-15-0. NC1234.2 +071700 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9. NC1234.2 +071800 IND-TEST-GF-15-1. NC1234.2 +071900 IF NUM-9V9 EQUAL TO 2.0 NC1234.2 +072000 PERFORM PASS NC1234.2 +072100 ELSE GO TO IND-FAIL-GF-15. NC1234.2 +072200 GO TO IND-WRITE-GF-15. NC1234.2 +072300 IND-DELETE-GF-15. NC1234.2 +072400 PERFORM DE-LETE. NC1234.2 +072500 GO TO IND-WRITE-GF-15. NC1234.2 +072600 IND-FAIL-GF-15. NC1234.2 +072700 PERFORM FAIL. NC1234.2 +072800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +072900 MOVE 2.0 TO CORRECT-14V4. NC1234.2 +073000 IND-WRITE-GF-15. NC1234.2 +073100 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1234.2 +073200 PERFORM PRINT-DETAIL. NC1234.2 +073300 IND-INIT-GF-16. NC1234.2 +073400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +073500 MOVE "SUBTRACT ROUNDED" TO FEATURE. NC1234.2 +073600 MOVE 5.0 TO NUM-9V9. NC1234.2 +073700 SET INDEX1 TO 9. NC1234.2 +073800 IND-TEST-GF-16-0. NC1234.2 +073900 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9 ROUNDED. NC1234.2 +074000 IND-TEST-GF-16-1. NC1234.2 +074100 IF NUM-9V9 EQUAL TO 2.4 NC1234.2 +074200 PERFORM PASS NC1234.2 +074300 ELSE GO TO IND-FAIL-GF-16. NC1234.2 +074400 GO TO IND-WRITE-GF-16. NC1234.2 +074500 IND-DELETE-GF-16. NC1234.2 +074600 PERFORM DE-LETE. NC1234.2 +074700 GO TO IND-WRITE-GF-16. NC1234.2 +074800 IND-FAIL-GF-16. NC1234.2 +074900 PERFORM FAIL. NC1234.2 +075000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +075100 MOVE 2.4 TO CORRECT-14V4. NC1234.2 +075200 IND-WRITE-GF-16. NC1234.2 +075300 MOVE "IND-TEST-GF-16" TO PAR-NAME. NC1234.2 +075400 PERFORM PRINT-DETAIL. NC1234.2 +075500 IND-INIT-GF-17. NC1234.2 +075600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +075700 MOVE "SUBTRACT ON SIZE ERROR" TO FEATURE. NC1234.2 +075800 MOVE 9.0 TO NUM-9V9. NC1234.2 +075900 SET INDEX1 TO 10. NC1234.2 +076000 IND-TEST-GF-17-1. NC1234.2 +076100 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9 ON SIZE ERROR NC1234.2 +076200 PERFORM PASS NC1234.2 +076300 GO TO IND-WRITE-GF-17-1. NC1234.2 +076400 GO TO IND-FAIL-GF-17-1. NC1234.2 +076500 IND-DELETE-GF-17-1. NC1234.2 +076600 PERFORM DE-LETE. NC1234.2 +076700 GO TO IND-WRITE-GF-17-1. NC1234.2 +076800 IND-FAIL-GF-17-1. NC1234.2 +076900 PERFORM FAIL. NC1234.2 +077000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +077100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +077200 IND-WRITE-GF-17-1. NC1234.2 +077300 MOVE "IND-TEST-GF-17-1" TO PAR-NAME. NC1234.2 +077400 PERFORM PRINT-DETAIL. NC1234.2 +077500 IND-TEST-GF-17-2. NC1234.2 +077600 IF NUM-9V9 = 9.0 NC1234.2 +077700 PERFORM PASS NC1234.2 +077800 GO TO IND-WRITE-GF-17-2. NC1234.2 +077900 GO TO IND-FAIL-GF-17-2. NC1234.2 +078000 IND-DELETE-GF-17-2. NC1234.2 +078100 PERFORM DE-LETE. NC1234.2 +078200 GO TO IND-WRITE-GF-17-2. NC1234.2 +078300 IND-FAIL-GF-17-2. NC1234.2 +078400 PERFORM FAIL. NC1234.2 +078500 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +078600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1234.2 +078700 IND-WRITE-GF-17-2. NC1234.2 +078800 MOVE "IND-TEST-GF-17-2" TO PAR-NAME. NC1234.2 +078900 PERFORM PRINT-DETAIL. NC1234.2 +079000 IND-INIT-GF-18. NC1234.2 +079100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +079200 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +079300 PERFORM BUILD-TABLE2. NC1234.2 +079400 SET INDEX1 TO 1. NC1234.2 +079500 SET INDEX2 TO 1. NC1234.2 +079600 IND-TEST-GF-18-0. NC1234.2 +079700 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2). NC1234.2 +079800 IND-TEST-GF-18-1. NC1234.2 +079900 IF TABLE2-NUM (INDEX2) EQUAL TO 4.0 NC1234.2 +080000 PERFORM PASS NC1234.2 +080100 ELSE GO TO IND-FAIL-GF-18. NC1234.2 +080200 GO TO IND-WRITE-GF-18. NC1234.2 +080300 IND-DELETE-GF-18. NC1234.2 +080400 PERFORM DE-LETE. NC1234.2 +080500 GO TO IND-WRITE-GF-18. NC1234.2 +080600 IND-FAIL-GF-18. NC1234.2 +080700 PERFORM FAIL. NC1234.2 +080800 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +080900 MOVE 4.0 TO CORRECT-14V4. NC1234.2 +081000 IND-WRITE-GF-18. NC1234.2 +081100 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1234.2 +081200 PERFORM PRINT-DETAIL. NC1234.2 +081300 IND-INIT-GF-19. NC1234.2 +081400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +081500 MOVE "SUBTRACT ROUNDED" TO FEATURE. NC1234.2 +081600 PERFORM BUILD-TABLE2. NC1234.2 +081700 SET INDEX1 TO 9. NC1234.2 +081800 SET INDEX2 TO 3. NC1234.2 +081900 IND-TEST-GF-19-0. NC1234.2 +082000 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +082100 ROUNDED. NC1234.2 +082200 IND-TEST-GF-19-1. NC1234.2 +082300 IF TABLE2-NUM (INDEX2) EQUAL TO 6.4 NC1234.2 +082400 PERFORM PASS NC1234.2 +082500 ELSE GO TO IND-FAIL-GF-19. NC1234.2 +082600 GO TO IND-WRITE-GF-19. NC1234.2 +082700 IND-DELETE-GF-19. NC1234.2 +082800 PERFORM DE-LETE. NC1234.2 +082900 GO TO IND-WRITE-GF-19. NC1234.2 +083000 IND-FAIL-GF-19. NC1234.2 +083100 PERFORM FAIL. NC1234.2 +083200 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +083300 MOVE 6.4 TO CORRECT-14V4. NC1234.2 +083400 IND-WRITE-GF-19. NC1234.2 +083500 MOVE "IND-TEST-GF-19" TO PAR-NAME. NC1234.2 +083600 PERFORM PRINT-DETAIL. NC1234.2 +083700 IND-INIT-GF-20. NC1234.2 +083800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +083900 MOVE "SUBTRACT ON SIZE ERROR" TO FEATURE. NC1234.2 +084000 PERFORM BUILD-TABLE2. NC1234.2 +084100 SET INDEX1 TO 10. NC1234.2 +084200 SET INDEX2 TO 4. NC1234.2 +084300 IND-TEST-GF-20-1. NC1234.2 +084400 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +084500 ON SIZE ERROR NC1234.2 +084600 PERFORM PASS NC1234.2 +084700 GO TO IND-WRITE-GF-20-1. NC1234.2 +084800 GO TO IND-FAIL-GF-20-1. NC1234.2 +084900 IND-DELETE-GF-20-1. NC1234.2 +085000 PERFORM DE-LETE. NC1234.2 +085100 GO TO IND-WRITE-GF-20-1. NC1234.2 +085200 IND-FAIL-GF-20-1. NC1234.2 +085300 PERFORM FAIL. NC1234.2 +085400 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +085500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +085600 IND-WRITE-GF-20-1. NC1234.2 +085700 MOVE "IND-TEST-GF-20-1" TO PAR-NAME. NC1234.2 +085800 PERFORM PRINT-DETAIL. NC1234.2 +085900 IND-TEST-GF-20-2. NC1234.2 +086000 IF TABLE2-NUM (INDEX2) = 4.0 NC1234.2 +086100 PERFORM PASS NC1234.2 +086200 GO TO IND-WRITE-GF-20-2. NC1234.2 +086300 GO TO IND-FAIL-GF-20-2. NC1234.2 +086400 IND-DELETE-GF-20-2. NC1234.2 +086500 PERFORM DE-LETE. NC1234.2 +086600 GO TO IND-WRITE-GF-20-2. NC1234.2 +086700 IND-FAIL-GF-20-2. NC1234.2 +086800 PERFORM FAIL. NC1234.2 +086900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +087000 MOVE 4 TO CORRECT-14V4. NC1234.2 +087100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +087200 IND-WRITE-GF-20-2. NC1234.2 +087300 MOVE "IND-TEST-GF-20-2" TO PAR-NAME. NC1234.2 +087400 PERFORM PRINT-DETAIL. NC1234.2 +087500 IND-INIT-GF-24. NC1234.2 +087600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +087700 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +087800 MOVE ZERO TO NUM-9V9. NC1234.2 +087900 SET INDEX1 TO 1. NC1234.2 +088000 IND-TEST-GF-24-0. NC1234.2 +088100 SUBTRACT TABLE1-NUM (INDEX1) FROM 8 GIVING NUM-9V9. NC1234.2 +088200 IND-TEST-GF-24-1. NC1234.2 +088300 IF NUM-9V9 EQUAL TO 7.0 NC1234.2 +088400 PERFORM PASS NC1234.2 +088500 ELSE GO TO IND-FAIL-GF-24. NC1234.2 +088600 GO TO IND-WRITE-GF-24. NC1234.2 +088700 IND-DELETE-GF-24. NC1234.2 +088800 PERFORM DE-LETE. NC1234.2 +088900 GO TO IND-WRITE-GF-24. NC1234.2 +089000 IND-FAIL-GF-24. NC1234.2 +089100 PERFORM FAIL. NC1234.2 +089200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +089300 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +089400 IND-WRITE-GF-24. NC1234.2 +089500 MOVE "IND-TEST-GF-24" TO PAR-NAME. NC1234.2 +089600 PERFORM PRINT-DETAIL. NC1234.2 +089700 IND-INIT-GF-25. NC1234.2 +089800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +089900 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +090000 MOVE ZERO TO NUM-9V9. NC1234.2 +090100 PERFORM BUILD-TABLE2. NC1234.2 +090200 SET INDEX1 TO 1. NC1234.2 +090300 SET INDEX2 TO 3. NC1234.2 +090400 IND-TEST-GF-25-0. NC1234.2 +090500 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +090600 GIVING NUM-9V9. NC1234.2 +090700 IND-TEST-GF-25-1. NC1234.2 +090800 IF NUM-9V9 EQUAL TO 8.0 NC1234.2 +090900 PERFORM PASS NC1234.2 +091000 ELSE GO TO IND-FAIL-GF-25. NC1234.2 +091100 GO TO IND-WRITE-GF-25. NC1234.2 +091200 IND-DELETE-GF-25. NC1234.2 +091300 PERFORM DE-LETE. NC1234.2 +091400 GO TO IND-WRITE-GF-25. NC1234.2 +091500 IND-FAIL-GF-25. NC1234.2 +091600 PERFORM FAIL. NC1234.2 +091700 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +091800 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +091900 IND-WRITE-GF-25. NC1234.2 +092000 MOVE "IND-TEST-GF-25" TO PAR-NAME. NC1234.2 +092100 PERFORM PRINT-DETAIL. NC1234.2 +092200 IND-INIT-GF-26. NC1234.2 +092300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +092400 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +092500 MOVE ZERO TO TABLE3. NC1234.2 +092600 PERFORM BUILD-TABLE2. NC1234.2 +092700 SET INDEX1 TO 10. NC1234.2 +092800 SET INDEX2 TO 1. NC1234.2 +092900 SET INDEX3 TO 3. NC1234.2 +093000 IND-TEST-GF-26-0. NC1234.2 +093100 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +093200 GIVING TABLE3-NUM (INDEX3). NC1234.2 +093300 IND-TEST-GF-26-1. NC1234.2 +093400 IF TABLE3-NUM (INDEX3) EQUAL TO 14.0 NC1234.2 +093500 PERFORM PASS NC1234.2 +093600 ELSE GO TO IND-FAIL-GF-26. NC1234.2 +093700 GO TO IND-WRITE-GF-26. NC1234.2 +093800 IND-DELETE-GF-26. NC1234.2 +093900 PERFORM DE-LETE. NC1234.2 +094000 GO TO IND-WRITE-GF-26. NC1234.2 +094100 IND-FAIL-GF-26. NC1234.2 +094200 PERFORM FAIL. NC1234.2 +094300 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1234.2 +094400 MOVE 14.0 TO CORRECT-14V4. NC1234.2 +094500 IND-WRITE-GF-26. NC1234.2 +094600 MOVE "IND-TEST-GF-26" TO PAR-NAME. NC1234.2 +094700 PERFORM PRINT-DETAIL. NC1234.2 +094800 IND-INIT-GF-21. NC1234.2 +094900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +095000 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +095100 PERFORM BUILD-TABLE4. NC1234.2 +095200 SET INDEX4-1 TO 3. NC1234.2 +095300 SET INDEX4-2 TO 3. NC1234.2 +095400 IND-TEST-GF-21-0. NC1234.2 +095500 SUBTRACT TABLE4-NUM2 (1 1) FROM NC1234.2 +095600 TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1234.2 +095700 IND-TEST-GF-21-1. NC1234.2 +095800 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 8 NC1234.2 +095900 PERFORM PASS NC1234.2 +096000 ELSE GO TO IND-FAIL-GF-21. NC1234.2 +096100 GO TO IND-WRITE-GF-21. NC1234.2 +096200 IND-DELETE-GF-21. NC1234.2 +096300 PERFORM DE-LETE. NC1234.2 +096400 GO TO IND-WRITE-GF-21. NC1234.2 +096500 IND-FAIL-GF-21. NC1234.2 +096600 PERFORM FAIL. NC1234.2 +096700 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1234.2 +096800 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +096900 IND-WRITE-GF-21. NC1234.2 +097000 MOVE "SUBTRCT-TEST-GF-21" TO PAR-NAME. NC1234.2 +097100 PERFORM PRINT-DETAIL. NC1234.2 +097200 IND-INIT-GF-22. NC1234.2 +097300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +097400 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +097500 MOVE 0.0 TO NUM-9V9. NC1234.2 +097600 SET INDEX1 TO 9. NC1234.2 +097700 IND-TEST-GF-22-0. NC1234.2 +097800 SUBTRACT TABLE1-NUM (INDEX1 + 1) FROM NUM-9V9. NC1234.2 +097900 IND-TEST-GF-22-1. NC1234.2 +098000 IF NUM-9V9 EQUAL TO 9.0 NC1234.2 +098100 PERFORM PASS NC1234.2 +098200 ELSE GO TO IND-FAIL-GF-22. NC1234.2 +098300 GO TO IND-WRITE-GF-22. NC1234.2 +098400 IND-DELETE-GF-22. NC1234.2 +098500 PERFORM DE-LETE. NC1234.2 +098600 GO TO IND-WRITE-GF-22. NC1234.2 +098700 IND-FAIL-GF-22. NC1234.2 +098800 PERFORM FAIL. NC1234.2 +098900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +099000 MOVE 9.0 TO CORRECT-14V4. NC1234.2 +099100 IND-WRITE-GF-22. NC1234.2 +099200 MOVE "SUBTRCT-TEST-GF-22" TO PAR-NAME. NC1234.2 +099300 PERFORM PRINT-DETAIL. NC1234.2 +099400 IND-INIT-GF-23. NC1234.2 +099500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +099600 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +099700 PERFORM BUILD-TABLE2. NC1234.2 +099800 SET INDEX1 TO 9. NC1234.2 +099900 SET INDEX2 TO 6. NC1234.2 +100000 IND-TEST-GF-23-0. NC1234.2 +100100 SUBTRACT TABLE1-NUM (INDEX1 - 2) FROM NC1234.2 +100200 TABLE2-NUM (INDEX2 - 1). NC1234.2 +100300 IND-TEST-GF-23-1. NC1234.2 +100400 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 1.1 NC1234.2 +100500 PERFORM PASS NC1234.2 +100600 ELSE GO TO IND-FAIL-GF-23. NC1234.2 +100700 GO TO IND-WRITE-GF-23. NC1234.2 +100800 IND-DELETE-GF-23. NC1234.2 +100900 PERFORM DE-LETE. NC1234.2 +101000 GO TO IND-WRITE-GF-23. NC1234.2 +101100 IND-FAIL-GF-23. NC1234.2 +101200 PERFORM FAIL. NC1234.2 +101300 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1234.2 +101400 MOVE 1.1 TO CORRECT-14V4. NC1234.2 +101500 IND-WRITE-GF-23. NC1234.2 +101600 MOVE "SUBTRCT-TEST-GF-23" TO PAR-NAME. NC1234.2 +101700 PERFORM PRINT-DETAIL. NC1234.2 +101800 IND-INIT-GF-27. NC1234.2 +101900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +102000 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +102100 MOVE ZERO TO NUM-9V9. NC1234.2 +102200 PERFORM BUILD-TABLE2. NC1234.2 +102300 SET INDEX1 TO 7. NC1234.2 +102400 SET INDEX2 TO 4. NC1234.2 +102500 IND-TEST-GF-27-0. NC1234.2 +102600 SUBTRACT TABLE1-NUM (INDEX1 - 2) FROM NC1234.2 +102700 TABLE2-NUM (INDEX2 - 1) GIVING NUM-9V9. NC1234.2 +102800 IND-TEST-GF-27-1. NC1234.2 +102900 IF NUM-9V9 EQUAL TO 7.0 NC1234.2 +103000 PERFORM PASS NC1234.2 +103100 ELSE GO TO IND-FAIL-GF-27. NC1234.2 +103200 GO TO IND-WRITE-GF-27. NC1234.2 +103300 IND-DELETE-GF-27. NC1234.2 +103400 PERFORM DE-LETE. NC1234.2 +103500 GO TO IND-WRITE-GF-27. NC1234.2 +103600 IND-FAIL-GF-27. NC1234.2 +103700 PERFORM FAIL. NC1234.2 +103800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +103900 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +104000 IND-WRITE-GF-27. NC1234.2 +104100 MOVE "SUBTRCT-TEST-GF-27" TO PAR-NAME. NC1234.2 +104200 PERFORM PRINT-DETAIL. NC1234.2 +104300 IND-INIT-GF-28. NC1234.2 +104400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +104500 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +104600 MOVE ZERO TO TABLE3. NC1234.2 +104700 PERFORM BUILD-TABLE2. NC1234.2 +104800 SET INDEX1 TO 8. NC1234.2 +104900 SET INDEX2 TO 2. NC1234.2 +105000 SET INDEX3 TO 6. NC1234.2 +105100 IND-TEST-GF-28-0. NC1234.2 +105200 SUBTRACT TABLE1-NUM (INDEX1 + 2) FROM NC1234.2 +105300 TABLE2-NUM (INDEX2 + 1) GIVING TABLE3-NUM (INDEX3 - 1). NC1234.2 +105400 IND-TEST-GF-28-1. NC1234.2 +105500 IF TABLE3-NUM (INDEX3 - 1) EQUAL TO 18.0 NC1234.2 +105600 PERFORM PASS NC1234.2 +105700 ELSE GO TO IND-FAIL-GF-28. NC1234.2 +105800 GO TO IND-WRITE-GF-28. NC1234.2 +105900 IND-DELETE-GF-28. NC1234.2 +106000 PERFORM DE-LETE. NC1234.2 +106100 GO TO IND-WRITE-GF-28. NC1234.2 +106200 IND-FAIL-GF-28. NC1234.2 +106300 PERFORM FAIL. NC1234.2 +106400 MOVE TABLE3-NUM (INDEX3 - 1) TO COMPUTED-14V4. NC1234.2 +106500 MOVE 18.0 TO CORRECT-14V4. NC1234.2 +106600 IND-WRITE-GF-28. NC1234.2 +106700 MOVE "SUBTRCT-TEST-GF-28" TO PAR-NAME. NC1234.2 +106800 PERFORM PRINT-DETAIL. NC1234.2 +106900 IND-INIT-GF-29. NC1234.2 +107000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +107100 MOVE "GO TO DEPENDING ON" TO FEATURE. NC1234.2 +107200 SET INDEX5 TO 1. NC1234.2 +107300 IND-TEST-GF-29. NC1234.2 +107400 GO TO IND-A NC1234.2 +107500 IND-B NC1234.2 +107600 IND-C DEPENDING ON TABLE5-NUM (INDEX5). NC1234.2 +107700 GO TO IND-FAIL-GF-29. NC1234.2 +107800 IND-DELETE-GF-29. NC1234.2 +107900 PERFORM DE-LETE. NC1234.2 +108000 GO TO IND-WRITE-GF-29. NC1234.2 +108100 IND-FAIL-GF-29. NC1234.2 +108200 PERFORM FAIL. NC1234.2 +108300 MOVE "TRANSFERED CONTROL TO WRONG PAR" TO RE-MARK. NC1234.2 +108400 GO TO IND-WRITE-GF-29. NC1234.2 +108500 IND-A. NC1234.2 +108600 MOVE "IND-A" TO COMPUTED-A. NC1234.2 +108700 MOVE "IND-C" TO CORRECT-A. NC1234.2 +108800 GO TO IND-FAIL-GF-29. NC1234.2 +108900 IND-B. NC1234.2 +109000 MOVE "IND-B" TO COMPUTED-A. NC1234.2 +109100 MOVE "IND-C" TO CORRECT-A. NC1234.2 +109200 GO TO IND-FAIL-GF-29. NC1234.2 +109300 IND-C. NC1234.2 +109400 PERFORM PASS. NC1234.2 +109500 IND-WRITE-GF-29. NC1234.2 +109600 MOVE "IND-TEST-GF-29" TO PAR-NAME. NC1234.2 +109700 PERFORM PRINT-DETAIL. NC1234.2 +109800 IND-INIT-GF-30. NC1234.2 +109900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +110000 MOVE "GO TO DEPENDING ON" TO FEATURE. NC1234.2 +110100 SET INDEX5 TO 1. NC1234.2 +110200 IND-TEST-GF-30. NC1234.2 +110300 GO TO IND-D NC1234.2 +110400 IND-E NC1234.2 +110500 IND-F DEPENDING ON TABLE5-NUM (INDEX5 + 1). NC1234.2 +110600 GO TO IND-FAIL-GF-30. NC1234.2 +110700 IND-DELETE-GF-30. NC1234.2 +110800 PERFORM DE-LETE. NC1234.2 +110900 GO TO IND-WRITE-GF-30. NC1234.2 +111000 IND-FAIL-GF-30. NC1234.2 +111100 PERFORM FAIL. NC1234.2 +111200 MOVE "TRANSFERED CONTROL TO WRONG PAR" TO RE-MARK. NC1234.2 +111300 GO TO IND-WRITE-GF-30. NC1234.2 +111400 IND-D. NC1234.2 +111500 MOVE "IND-D" TO COMPUTED-A. NC1234.2 +111600 MOVE "IND-E" TO CORRECT-A. NC1234.2 +111700 GO TO IND-FAIL-GF-30. NC1234.2 +111800 IND-F. NC1234.2 +111900 MOVE "IND-F" TO COMPUTED-A. NC1234.2 +112000 MOVE "IND-E" TO CORRECT-A. NC1234.2 +112100 GO TO IND-FAIL-GF-30. NC1234.2 +112200 IND-E. NC1234.2 +112300 PERFORM PASS. NC1234.2 +112400 IND-WRITE-GF-30. NC1234.2 +112500 MOVE "IND-TEST-GF-30" TO PAR-NAME. NC1234.2 +112600 PERFORM PRINT-DETAIL. NC1234.2 +112700 CCVS-EXIT SECTION. NC1234.2 +112800 CCVS-999999. NC1234.2 +112900 GO TO CLOSE-FILES. NC1234.2 +*END-OF,NC123A +*HEADER,COBOL,NC124A +000100 IDENTIFICATION DIVISION. NC1244.2 +000200 PROGRAM-ID. NC1244.2 +000300 NC1244.2 +000400 NC124A. NC1244.2 +000500**************************************************************** NC1244.2 +000600* * NC1244.2 +000700* VALIDATION FOR:- * NC1244.2 +000800* * NC1244.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +001000* * NC1244.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1244.2 +001200* * NC1244.2 +001300**************************************************************** NC1244.2 +001400* * NC1244.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC1244.2 +001600* * NC1244.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC1244.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC1244.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC1244.2 +002000* * NC1244.2 +002100**************************************************************** NC1244.2 +002200* NC1244.2 +002300* PROGRAM NC124A TESTS THE USE OF NC1244.2 +002400* PICTURE CHARACTERS P, S, +, -, Z AND *. NC1244.2 +002500* NC1244.2 +002600 ENVIRONMENT DIVISION. NC1244.2 +002700 CONFIGURATION SECTION. NC1244.2 +002800 SOURCE-COMPUTER. NC1244.2 +002900 XXXXX082. NC1244.2 +003000 OBJECT-COMPUTER. NC1244.2 +003100 XXXXX083. NC1244.2 +003200 INPUT-OUTPUT SECTION. NC1244.2 +003300 FILE-CONTROL. NC1244.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1244.2 +003500 XXXXX055. NC1244.2 +003600 DATA DIVISION. NC1244.2 +003700 FILE SECTION. NC1244.2 +003800 FD PRINT-FILE. NC1244.2 +003900 01 PRINT-REC PICTURE X(120). NC1244.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1244.2 +004100 WORKING-STORAGE SECTION. NC1244.2 +004200 01 WORK-AREA-1 PICTURE 9 VALUE 0. NC1244.2 +004300 01 WORK-AREA-2 PICTURE 99 VALUE 12. NC1244.2 +004400 01 WORK-AREA-3 PICTURE S99 VALUE -12. NC1244.2 +004500 01 WORK-AREA-4 PICTURE S999 VALUE 123. NC1244.2 +004600 01 WORK-AREA-5 PICTURE S999 VALUE -123. NC1244.2 +004700 01 WORK-AREA-6 PICTURE 9999 VALUE 1234. NC1244.2 +004800 01 WORK-AREA-7 PICTURE S9999 VALUE -1234. NC1244.2 +004900 01 WORK-AREA-8 PICTURE S99V99 VALUE 12.34. NC1244.2 +005000 01 WORK-AREA-9 PICTURE S99V99 VALUE -12.34. NC1244.2 +005100 01 WORK-AREA-10 PICTURE 9 VALUE 0. NC1244.2 +005200 01 WORK-AREA-11 PICTURE V99 VALUE .02. NC1244.2 +005300 01 WORK-AREA-12 PICTURE 99 VALUE 12. NC1244.2 +005400 01 WORK-AREA-13 PICTURE 99V99 VALUE 12.34. NC1244.2 +005500 01 WORK-AREA-14 PICTURE 9999 VALUE 1234. NC1244.2 +005600 01 WORK-AREA-15 PICTURE 9999V99 VALUE 1234.56. NC1244.2 +005700 01 WORK-AREA-16 PICTURE 9 VALUE 0. NC1244.2 +005800 01 WORK-AREA-17 PICTURE 99 VALUE 13. NC1244.2 +005900 01 WORK-AREA-18 PICTURE 999 VALUE 123. NC1244.2 +006000 01 WORK-AREA-19 PICTURE 9999 VALUE 2010. NC1244.2 +006100 01 WORK-AREA-20 PICTURE 9999V9 VALUE 1010.2. NC1244.2 +006200 01 WORK-AREA-21 PICTURE V99 VALUE .01. NC1244.2 +006300 01 WORK-AREA-22 PICTURE 9 VALUE 0. NC1244.2 +006400 01 WORK-AREA-23 PICTURE 9V99 VALUE 1.01. NC1244.2 +006500 01 WORK-AREA-24 PICTURE 999V VALUE 217. NC1244.2 +006600 01 WORK-AREA-25 PICTURE 9999V99 VALUE 1010.20. NC1244.2 +006700 01 WORK-AREA-26 PICTURE V99 VALUE .01. NC1244.2 +006800 01 WORK-AREA-27 PICTURE S9PP VALUE 200. NC1244.2 +006900 01 WORK-AREA-27A PICTURE X(3) VALUE SPACE. NC1244.2 +007000 01 WORK-AREA-28 PICTURE 999 VALUE 567. NC1244.2 +007100 01 WORK-AREA-28A PICTURE S9PP VALUE ZERO. NC1244.2 +007200 01 WORK-AREA-29 PICTURE 999 VALUE 123. NC1244.2 +007300 01 WORK-AREA-29A PICTURE 9PP VALUE ZERO. NC1244.2 +007400 01 WORK-AREA-29B PICTURE X(3) VALUE SPACE. NC1244.2 +007500 01 WORK-AREA-30 PICTURE 999PP VALUE 00900. NC1244.2 +007600 01 WORK-AREA-30A PICTURE ZZZPP VALUE ZERO. NC1244.2 +007700 01 WORK-AREA-31 PICTURE 999PP VALUE 01200. NC1244.2 +007800 01 WORK-AREA-31A PICTURE ZZZPP VALUE ZERO. NC1244.2 +007900 01 WORK-AREA-31B PICTURE X(5) VALUE SPACE. NC1244.2 +008000 01 WORK-AREA-32 PICTURE PP9 VALUE .001. NC1244.2 +008100 01 WORK-AREA-32A PICTURE V999 VALUE ZERO. NC1244.2 +008200 01 WORK-AREA-33 PICTURE V999 VALUE .567. NC1244.2 +008300 01 WORK-AREA-33A PICTURE PP9 VALUE ZERO. NC1244.2 +008400 01 WORK-AREA-34 PICTURE V999 VALUE .123. NC1244.2 +008500 01 WORK-AREA-34A PICTURE PP9 VALUE ZERO. NC1244.2 +008600 01 WORK-AREA-34B PICTURE V999 VALUE ZERO. NC1244.2 +008700 01 EDIT-AREA-1 PICTURE +9999. NC1244.2 +008800 01 EDIT-AREA-2 PICTURE -9999. NC1244.2 +008900 01 EDIT-AREA-3 PICTURE ++++9. NC1244.2 +009000 01 EDIT-AREA-4 PICTURE ----9. NC1244.2 +009100 01 EDIT-AREA-5 PICTURE +++++. NC1244.2 +009200 01 EDIT-AREA-6 PICTURE -----. NC1244.2 +009300 01 EDIT-AREA-7 PICTURE +++++.++. NC1244.2 +009400 01 EDIT-AREA-8 PICTURE --,---.--. NC1244.2 +009500 01 EDIT-AREA-9 PICTURE $$99. NC1244.2 +009600 01 EDIT-AREA-10 PICTURE $$$$9. NC1244.2 +009700 01 EDIT-AREA-11 PICTURE $$$$$.99. NC1244.2 +009800 01 EDIT-AREA-12 PICTURE $$,$$$.$$. NC1244.2 +009900 01 EDIT-AREA-13 PICTURE *999. NC1244.2 +010000 01 EDIT-AREA-14 PICTURE **99. NC1244.2 +010100 01 EDIT-AREA-15 PICTURE ***9. NC1244.2 +010200 01 EDIT-AREA-16 PICTURE **.**. NC1244.2 +010300 01 EDIT-AREA-17 PICTURE *,***.**. NC1244.2 +010400 01 EDIT-AREA-18 PICTURE 9999. NC1244.2 +010500 01 EDIT-AREA-19 PICTURE Z999. NC1244.2 +010600 01 EDIT-AREA-20 PICTURE ZZ99. NC1244.2 +010700 01 EDIT-AREA-21 PICTURE ZZZ9. NC1244.2 +010800 01 EDIT-AREA-22 PICTURE ZZZZ. NC1244.2 +010900 01 EDIT-AREA-23 PICTURE ZZ.ZZ. NC1244.2 +011000 01 EDIT-AREA-24 PICTURE Z,ZZZ. NC1244.2 +011100 01 TEST-RESULTS. NC1244.2 +011200 02 FILLER PIC X VALUE SPACE. NC1244.2 +011300 02 FEATURE PIC X(20) VALUE SPACE. NC1244.2 +011400 02 FILLER PIC X VALUE SPACE. NC1244.2 +011500 02 P-OR-F PIC X(5) VALUE SPACE. NC1244.2 +011600 02 FILLER PIC X VALUE SPACE. NC1244.2 +011700 02 PAR-NAME. NC1244.2 +011800 03 FILLER PIC X(19) VALUE SPACE. NC1244.2 +011900 03 PARDOT-X PIC X VALUE SPACE. NC1244.2 +012000 03 DOTVALUE PIC 99 VALUE ZERO. NC1244.2 +012100 02 FILLER PIC X(8) VALUE SPACE. NC1244.2 +012200 02 RE-MARK PIC X(61). NC1244.2 +012300 01 TEST-COMPUTED. NC1244.2 +012400 02 FILLER PIC X(30) VALUE SPACE. NC1244.2 +012500 02 FILLER PIC X(17) VALUE NC1244.2 +012600 " COMPUTED=". NC1244.2 +012700 02 COMPUTED-X. NC1244.2 +012800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1244.2 +012900 03 COMPUTED-N REDEFINES COMPUTED-A NC1244.2 +013000 PIC -9(9).9(9). NC1244.2 +013100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1244.2 +013200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1244.2 +013300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1244.2 +013400 03 CM-18V0 REDEFINES COMPUTED-A. NC1244.2 +013500 04 COMPUTED-18V0 PIC -9(18). NC1244.2 +013600 04 FILLER PIC X. NC1244.2 +013700 03 FILLER PIC X(50) VALUE SPACE. NC1244.2 +013800 01 TEST-CORRECT. NC1244.2 +013900 02 FILLER PIC X(30) VALUE SPACE. NC1244.2 +014000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1244.2 +014100 02 CORRECT-X. NC1244.2 +014200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1244.2 +014300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1244.2 +014400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1244.2 +014500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1244.2 +014600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1244.2 +014700 03 CR-18V0 REDEFINES CORRECT-A. NC1244.2 +014800 04 CORRECT-18V0 PIC -9(18). NC1244.2 +014900 04 FILLER PIC X. NC1244.2 +015000 03 FILLER PIC X(2) VALUE SPACE. NC1244.2 +015100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1244.2 +015200 01 CCVS-C-1. NC1244.2 +015300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1244.2 +015400- "SS PARAGRAPH-NAME NC1244.2 +015500- " REMARKS". NC1244.2 +015600 02 FILLER PIC X(20) VALUE SPACE. NC1244.2 +015700 01 CCVS-C-2. NC1244.2 +015800 02 FILLER PIC X VALUE SPACE. NC1244.2 +015900 02 FILLER PIC X(6) VALUE "TESTED". NC1244.2 +016000 02 FILLER PIC X(15) VALUE SPACE. NC1244.2 +016100 02 FILLER PIC X(4) VALUE "FAIL". NC1244.2 +016200 02 FILLER PIC X(94) VALUE SPACE. NC1244.2 +016300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1244.2 +016400 01 REC-CT PIC 99 VALUE ZERO. NC1244.2 +016500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1244.2 +017000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1244.2 +017100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1244.2 +017200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1244.2 +017300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1244.2 +017400 01 CCVS-H-1. NC1244.2 +017500 02 FILLER PIC X(39) VALUE SPACES. NC1244.2 +017600 02 FILLER PIC X(42) VALUE NC1244.2 +017700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1244.2 +017800 02 FILLER PIC X(39) VALUE SPACES. NC1244.2 +017900 01 CCVS-H-2A. NC1244.2 +018000 02 FILLER PIC X(40) VALUE SPACE. NC1244.2 +018100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1244.2 +018200 02 FILLER PIC XXXX VALUE NC1244.2 +018300 "4.2 ". NC1244.2 +018400 02 FILLER PIC X(28) VALUE NC1244.2 +018500 " COPY - NOT FOR DISTRIBUTION". NC1244.2 +018600 02 FILLER PIC X(41) VALUE SPACE. NC1244.2 +018700 NC1244.2 +018800 01 CCVS-H-2B. NC1244.2 +018900 02 FILLER PIC X(15) VALUE NC1244.2 +019000 "TEST RESULT OF ". NC1244.2 +019100 02 TEST-ID PIC X(9). NC1244.2 +019200 02 FILLER PIC X(4) VALUE NC1244.2 +019300 " IN ". NC1244.2 +019400 02 FILLER PIC X(12) VALUE NC1244.2 +019500 " HIGH ". NC1244.2 +019600 02 FILLER PIC X(22) VALUE NC1244.2 +019700 " LEVEL VALIDATION FOR ". NC1244.2 +019800 02 FILLER PIC X(58) VALUE NC1244.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +020000 01 CCVS-H-3. NC1244.2 +020100 02 FILLER PIC X(34) VALUE NC1244.2 +020200 " FOR OFFICIAL USE ONLY ". NC1244.2 +020300 02 FILLER PIC X(58) VALUE NC1244.2 +020400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1244.2 +020500 02 FILLER PIC X(28) VALUE NC1244.2 +020600 " COPYRIGHT 1985 ". NC1244.2 +020700 01 CCVS-E-1. NC1244.2 +020800 02 FILLER PIC X(52) VALUE SPACE. NC1244.2 +020900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1244.2 +021000 02 ID-AGAIN PIC X(9). NC1244.2 +021100 02 FILLER PIC X(45) VALUE SPACES. NC1244.2 +021200 01 CCVS-E-2. NC1244.2 +021300 02 FILLER PIC X(31) VALUE SPACE. NC1244.2 +021400 02 FILLER PIC X(21) VALUE SPACE. NC1244.2 +021500 02 CCVS-E-2-2. NC1244.2 +021600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1244.2 +021700 03 FILLER PIC X VALUE SPACE. NC1244.2 +021800 03 ENDER-DESC PIC X(44) VALUE NC1244.2 +021900 "ERRORS ENCOUNTERED". NC1244.2 +022000 01 CCVS-E-3. NC1244.2 +022100 02 FILLER PIC X(22) VALUE NC1244.2 +022200 " FOR OFFICIAL USE ONLY". NC1244.2 +022300 02 FILLER PIC X(12) VALUE SPACE. NC1244.2 +022400 02 FILLER PIC X(58) VALUE NC1244.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +022600 02 FILLER PIC X(13) VALUE SPACE. NC1244.2 +022700 02 FILLER PIC X(15) VALUE NC1244.2 +022800 " COPYRIGHT 1985". NC1244.2 +022900 01 CCVS-E-4. NC1244.2 +023000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1244.2 +023100 02 FILLER PIC X(4) VALUE " OF ". NC1244.2 +023200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1244.2 +023300 02 FILLER PIC X(40) VALUE NC1244.2 +023400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1244.2 +023500 01 XXINFO. NC1244.2 +023600 02 FILLER PIC X(19) VALUE NC1244.2 +023700 "*** INFORMATION ***". NC1244.2 +023800 02 INFO-TEXT. NC1244.2 +023900 04 FILLER PIC X(8) VALUE SPACE. NC1244.2 +024000 04 XXCOMPUTED PIC X(20). NC1244.2 +024100 04 FILLER PIC X(5) VALUE SPACE. NC1244.2 +024200 04 XXCORRECT PIC X(20). NC1244.2 +024300 02 INF-ANSI-REFERENCE PIC X(48). NC1244.2 +024400 01 HYPHEN-LINE. NC1244.2 +024500 02 FILLER PIC IS X VALUE IS SPACE. NC1244.2 +024600 02 FILLER PIC IS X(65) VALUE IS "************************NC1244.2 +024700- "*****************************************". NC1244.2 +024800 02 FILLER PIC IS X(54) VALUE IS "************************NC1244.2 +024900- "******************************". NC1244.2 +025000 01 CCVS-PGM-ID PIC X(9) VALUE NC1244.2 +025100 "NC124A". NC1244.2 +025200 PROCEDURE DIVISION. NC1244.2 +025300 CCVS1 SECTION. NC1244.2 +025400 OPEN-FILES. NC1244.2 +025500 OPEN OUTPUT PRINT-FILE. NC1244.2 +025600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1244.2 +025700 MOVE SPACE TO TEST-RESULTS. NC1244.2 +025800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1244.2 +025900 GO TO CCVS1-EXIT. NC1244.2 +026000 CLOSE-FILES. NC1244.2 +026100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1244.2 +026200 TERMINATE-CCVS. NC1244.2 +026300S EXIT PROGRAM. NC1244.2 +026400STERMINATE-CALL. NC1244.2 +026500 STOP RUN. NC1244.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1244.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1244.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1244.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1244.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. NC1244.2 +027100 PRINT-DETAIL. NC1244.2 +027200 IF REC-CT NOT EQUAL TO ZERO NC1244.2 +027300 MOVE "." TO PARDOT-X NC1244.2 +027400 MOVE REC-CT TO DOTVALUE. NC1244.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1244.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1244.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1244.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1244.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1244.2 +028000 MOVE SPACE TO CORRECT-X. NC1244.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1244.2 +028200 MOVE SPACE TO RE-MARK. NC1244.2 +028300 HEAD-ROUTINE. NC1244.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +028500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +028600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1244.2 +028700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1244.2 +028800 COLUMN-NAMES-ROUTINE. NC1244.2 +028900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +029000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +029200 END-ROUTINE. NC1244.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1244.2 +029400 END-RTN-EXIT. NC1244.2 +029500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +029600 END-ROUTINE-1. NC1244.2 +029700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1244.2 +029800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1244.2 +029900 ADD PASS-COUNTER TO ERROR-HOLD. NC1244.2 +030000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1244.2 +030100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1244.2 +030200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1244.2 +030300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1244.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1244.2 +030500 END-ROUTINE-12. NC1244.2 +030600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1244.2 +030700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1244.2 +030800 MOVE "NO " TO ERROR-TOTAL NC1244.2 +030900 ELSE NC1244.2 +031000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1244.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1244.2 +031200 PERFORM WRITE-LINE. NC1244.2 +031300 END-ROUTINE-13. NC1244.2 +031400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1244.2 +031500 MOVE "NO " TO ERROR-TOTAL ELSE NC1244.2 +031600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1244.2 +031700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1244.2 +031800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +031900 IF INSPECT-COUNTER EQUAL TO ZERO NC1244.2 +032000 MOVE "NO " TO ERROR-TOTAL NC1244.2 +032100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1244.2 +032200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1244.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +032400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +032500 WRITE-LINE. NC1244.2 +032600 ADD 1 TO RECORD-COUNT. NC1244.2 +032700Y IF RECORD-COUNT GREATER 42 NC1244.2 +032800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1244.2 +032900Y MOVE SPACE TO DUMMY-RECORD NC1244.2 +033000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1244.2 +033100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1244.2 +033200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1244.2 +033300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1244.2 +033400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1244.2 +033500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1244.2 +033900Y MOVE ZERO TO RECORD-COUNT. NC1244.2 +034000 PERFORM WRT-LN. NC1244.2 +034100 WRT-LN. NC1244.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1244.2 +034300 MOVE SPACE TO DUMMY-RECORD. NC1244.2 +034400 BLANK-LINE-PRINT. NC1244.2 +034500 PERFORM WRT-LN. NC1244.2 +034600 FAIL-ROUTINE. NC1244.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE NC1244.2 +034800 GO TO FAIL-ROUTINE-WRITE. NC1244.2 +034900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1244.2 +035000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1244.2 +035100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1244.2 +035200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +035300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1244.2 +035400 GO TO FAIL-ROUTINE-EX. NC1244.2 +035500 FAIL-ROUTINE-WRITE. NC1244.2 +035600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1244.2 +035700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1244.2 +035800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1244.2 +035900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1244.2 +036000 FAIL-ROUTINE-EX. EXIT. NC1244.2 +036100 BAIL-OUT. NC1244.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1244.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1244.2 +036400 BAIL-OUT-WRITE. NC1244.2 +036500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1244.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1244.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1244.2 +036900 BAIL-OUT-EX. EXIT. NC1244.2 +037000 CCVS1-EXIT. NC1244.2 +037100 EXIT. NC1244.2 +037200 PICTURE-INIT-1. NC1244.2 +037300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +037400 MOVE "PICTRE-TST-1" TO PAR-NAME. NC1244.2 +037500 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +037600 MOVE 0 TO WORK-AREA-1. NC1244.2 +037700 MOVE 1 TO REC-CT. NC1244.2 +037800 PICTURE-TEST-1. NC1244.2 +037900 MOVE WORK-AREA-1 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +038000 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +038100 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +038200 GO TO PICTURE-TEST-1-A. NC1244.2 +038300 PICTURE-DELETE-1. NC1244.2 +038400 PERFORM DE-LETE. NC1244.2 +038500 PERFORM PRINT-DETAIL. NC1244.2 +038600 GO TO PICTURE-INIT-2. NC1244.2 +038700 PICTURE-TEST-1-A. NC1244.2 +038800 IF EDIT-AREA-1 EQUAL TO "+0000" NC1244.2 +038900 PERFORM PASS NC1244.2 +039000 PERFORM PRINT-DETAIL NC1244.2 +039100 ELSE PERFORM FAIL NC1244.2 +039200 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +039300 MOVE "+0000" TO CORRECT-A NC1244.2 +039400 PERFORM PRINT-DETAIL. NC1244.2 +039500 ADD 1 TO REC-CT. NC1244.2 +039600 PICTURE-TEST-1-B. NC1244.2 +039700 IF EDIT-AREA-2 EQUAL TO " 0000" NC1244.2 +039800 PERFORM PASS NC1244.2 +039900 PERFORM PRINT-DETAIL NC1244.2 +040000 ELSE PERFORM FAIL NC1244.2 +040100 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +040200 MOVE " 0000" TO CORRECT-A NC1244.2 +040300 PERFORM PRINT-DETAIL. NC1244.2 +040400 ADD 1 TO REC-CT. NC1244.2 +040500 PICTURE-TEST-1-C. NC1244.2 +040600 IF EDIT-AREA-3 EQUAL TO " +0" NC1244.2 +040700 PERFORM PASS NC1244.2 +040800 PERFORM PRINT-DETAIL NC1244.2 +040900 ELSE PERFORM FAIL NC1244.2 +041000 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +041100 MOVE " +0" TO CORRECT-A NC1244.2 +041200 PERFORM PRINT-DETAIL. NC1244.2 +041300 ADD 1 TO REC-CT. NC1244.2 +041400 PICTURE-TEST-1-D. NC1244.2 +041500 IF EDIT-AREA-4 EQUAL TO " 0" NC1244.2 +041600 PERFORM PASS NC1244.2 +041700 PERFORM PRINT-DETAIL NC1244.2 +041800 ELSE PERFORM FAIL NC1244.2 +041900 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +042000 MOVE " 0" TO CORRECT-A NC1244.2 +042100 PERFORM PRINT-DETAIL. NC1244.2 +042200 ADD 1 TO REC-CT. NC1244.2 +042300 PICTURE-TEST-1-E. NC1244.2 +042400 IF EDIT-AREA-5 EQUAL TO " " NC1244.2 +042500 PERFORM PASS NC1244.2 +042600 PERFORM PRINT-DETAIL NC1244.2 +042700 ELSE PERFORM FAIL NC1244.2 +042800 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +042900 MOVE "SPACES" TO CORRECT-A NC1244.2 +043000 PERFORM PRINT-DETAIL. NC1244.2 +043100 ADD 1 TO REC-CT. NC1244.2 +043200 PICTURE-TEST-1-F. NC1244.2 +043300 IF EDIT-AREA-6 EQUAL TO " " NC1244.2 +043400 PERFORM PASS NC1244.2 +043500 PERFORM PRINT-DETAIL NC1244.2 +043600 ELSE PERFORM FAIL NC1244.2 +043700 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +043800 MOVE "SPACES" TO CORRECT-A NC1244.2 +043900 PERFORM PRINT-DETAIL. NC1244.2 +044000 ADD 1 TO REC-CT. NC1244.2 +044100 PICTURE-TEST-1-G. NC1244.2 +044200 IF EDIT-AREA-7 EQUAL TO " " NC1244.2 +044300 PERFORM PASS NC1244.2 +044400 PERFORM PRINT-DETAIL NC1244.2 +044500 ELSE PERFORM FAIL NC1244.2 +044600 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +044700 MOVE "SPACES" TO CORRECT-A NC1244.2 +044800 PERFORM PRINT-DETAIL. NC1244.2 +044900 ADD 1 TO REC-CT. NC1244.2 +045000 PICTURE-TEST-1-H. NC1244.2 +045100 IF EDIT-AREA-8 EQUAL TO " " NC1244.2 +045200 PERFORM PASS NC1244.2 +045300 PERFORM PRINT-DETAIL NC1244.2 +045400 ELSE PERFORM FAIL NC1244.2 +045500 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +045600 MOVE "SPACES" TO CORRECT-A NC1244.2 +045700 PERFORM PRINT-DETAIL. NC1244.2 +045800 PICTURE-INIT-2. NC1244.2 +045900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +046000 MOVE "PICTRE-TST-2" TO PAR-NAME. NC1244.2 +046100 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +046200 MOVE 12 TO WORK-AREA-2. NC1244.2 +046300 MOVE 1 TO REC-CT. NC1244.2 +046400 PICTURE-TEST-2. NC1244.2 +046500 MOVE WORK-AREA-2 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +046600 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +046700 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +046800 GO TO PICTURE-TEST-2-A. NC1244.2 +046900 PICTURE-DELETE-2. NC1244.2 +047000 PERFORM DE-LETE. NC1244.2 +047100 PERFORM PRINT-DETAIL. NC1244.2 +047200 GO TO PICTURE-INIT-3. NC1244.2 +047300 PICTURE-TEST-2-A. NC1244.2 +047400 IF EDIT-AREA-1 EQUAL TO "+0012" NC1244.2 +047500 PERFORM PASS NC1244.2 +047600 PERFORM PRINT-DETAIL NC1244.2 +047700 ELSE PERFORM FAIL NC1244.2 +047800 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +047900 MOVE "+0012" TO CORRECT-A NC1244.2 +048000 PERFORM PRINT-DETAIL. NC1244.2 +048100 ADD 1 TO REC-CT. NC1244.2 +048200 PICTURE-TEST-2-B. NC1244.2 +048300 IF EDIT-AREA-2 EQUAL TO " 0012" NC1244.2 +048400 PERFORM PASS NC1244.2 +048500 PERFORM PRINT-DETAIL NC1244.2 +048600 ELSE PERFORM FAIL NC1244.2 +048700 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +048800 MOVE " 0012" TO CORRECT-A NC1244.2 +048900 PERFORM PRINT-DETAIL. NC1244.2 +049000 ADD 1 TO REC-CT. NC1244.2 +049100 PICTURE-TEST-2-C. NC1244.2 +049200 IF EDIT-AREA-3 EQUAL TO " +12" NC1244.2 +049300 PERFORM PASS NC1244.2 +049400 PERFORM PRINT-DETAIL NC1244.2 +049500 ELSE PERFORM FAIL NC1244.2 +049600 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +049700 MOVE " +12" TO CORRECT-A NC1244.2 +049800 PERFORM PRINT-DETAIL. NC1244.2 +049900 ADD 1 TO REC-CT. NC1244.2 +050000 PICTURE-TEST-2-D. NC1244.2 +050100 IF EDIT-AREA-4 EQUAL TO " 12" NC1244.2 +050200 PERFORM PASS NC1244.2 +050300 PERFORM PRINT-DETAIL NC1244.2 +050400 ELSE PERFORM FAIL NC1244.2 +050500 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +050600 MOVE " 12" TO CORRECT-A NC1244.2 +050700 PERFORM PRINT-DETAIL. NC1244.2 +050800 ADD 1 TO REC-CT. NC1244.2 +050900 PICTURE-TEST-2-E. NC1244.2 +051000 IF EDIT-AREA-5 EQUAL TO " +12" NC1244.2 +051100 PERFORM PASS NC1244.2 +051200 PERFORM PRINT-DETAIL NC1244.2 +051300 ELSE PERFORM FAIL NC1244.2 +051400 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +051500 MOVE " +12" TO CORRECT-A NC1244.2 +051600 PERFORM PRINT-DETAIL. NC1244.2 +051700 ADD 1 TO REC-CT. NC1244.2 +051800 PICTURE-TEST-2-F. NC1244.2 +051900 IF EDIT-AREA-6 EQUAL TO " 12" NC1244.2 +052000 PERFORM PASS NC1244.2 +052100 PERFORM PRINT-DETAIL NC1244.2 +052200 ELSE PERFORM FAIL NC1244.2 +052300 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +052400 MOVE " 12" TO CORRECT-A NC1244.2 +052500 PERFORM PRINT-DETAIL. NC1244.2 +052600 ADD 1 TO REC-CT. NC1244.2 +052700 PICTURE-TEST-2-G. NC1244.2 +052800 IF EDIT-AREA-7 EQUAL TO " +12.00" NC1244.2 +052900 PERFORM PASS NC1244.2 +053000 PERFORM PRINT-DETAIL NC1244.2 +053100 ELSE PERFORM FAIL NC1244.2 +053200 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +053300 MOVE " +12.00" TO CORRECT-A NC1244.2 +053400 PERFORM PRINT-DETAIL. NC1244.2 +053500 ADD 1 TO REC-CT. NC1244.2 +053600 PICTURE-TEST-2-H. NC1244.2 +053700 IF EDIT-AREA-8 EQUAL TO " 12.00" NC1244.2 +053800 PERFORM PASS NC1244.2 +053900 PERFORM PRINT-DETAIL NC1244.2 +054000 ELSE PERFORM FAIL NC1244.2 +054100 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +054200 MOVE " 12.00" TO CORRECT-A NC1244.2 +054300 PERFORM PRINT-DETAIL. NC1244.2 +054400 PICTURE-INIT-3. NC1244.2 +054500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +054600 MOVE "PICTRE-TST-3" TO PAR-NAME. NC1244.2 +054700 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +054800 MOVE -12 TO WORK-AREA-3. NC1244.2 +054900 MOVE 1 TO REC-CT. NC1244.2 +055000 PICTURE-TEST-3. NC1244.2 +055100 MOVE WORK-AREA-3 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +055200 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +055300 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +055400 GO TO PICTURE-TEST-3-A. NC1244.2 +055500 PICTURE-DELETE-3. NC1244.2 +055600 PERFORM DE-LETE. NC1244.2 +055700 PERFORM PRINT-DETAIL. NC1244.2 +055800 GO TO PICTURE-INIT-4. NC1244.2 +055900 PICTURE-TEST-3-A. NC1244.2 +056000 IF EDIT-AREA-1 EQUAL TO "-0012" NC1244.2 +056100 PERFORM PASS NC1244.2 +056200 PERFORM PRINT-DETAIL NC1244.2 +056300 ELSE PERFORM FAIL NC1244.2 +056400 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +056500 MOVE "-0012" TO CORRECT-A NC1244.2 +056600 PERFORM PRINT-DETAIL. NC1244.2 +056700 ADD 1 TO REC-CT. NC1244.2 +056800 PICTURE-TEST-3-B. NC1244.2 +056900 IF EDIT-AREA-2 EQUAL TO "-0012" NC1244.2 +057000 PERFORM PASS NC1244.2 +057100 PERFORM PRINT-DETAIL NC1244.2 +057200 ELSE PERFORM FAIL NC1244.2 +057300 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +057400 MOVE "-0012" TO CORRECT-A NC1244.2 +057500 PERFORM PRINT-DETAIL. NC1244.2 +057600 ADD 1 TO REC-CT. NC1244.2 +057700 PICTURE-TEST-3-C. NC1244.2 +057800 IF EDIT-AREA-3 EQUAL TO " -12" NC1244.2 +057900 PERFORM PASS NC1244.2 +058000 PERFORM PRINT-DETAIL NC1244.2 +058100 ELSE PERFORM FAIL NC1244.2 +058200 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +058300 MOVE " -12" TO CORRECT-A NC1244.2 +058400 PERFORM PRINT-DETAIL. NC1244.2 +058500 ADD 1 TO REC-CT. NC1244.2 +058600 PICTURE-TEST-3-D. NC1244.2 +058700 IF EDIT-AREA-4 EQUAL TO " -12" NC1244.2 +058800 PERFORM PASS NC1244.2 +058900 PERFORM PRINT-DETAIL NC1244.2 +059000 ELSE PERFORM FAIL NC1244.2 +059100 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +059200 MOVE " -12" TO CORRECT-A NC1244.2 +059300 PERFORM PRINT-DETAIL. NC1244.2 +059400 ADD 1 TO REC-CT. NC1244.2 +059500 PICTURE-TEST-3-E. NC1244.2 +059600 IF EDIT-AREA-5 EQUAL TO " -12" NC1244.2 +059700 PERFORM PASS NC1244.2 +059800 PERFORM PRINT-DETAIL NC1244.2 +059900 ELSE PERFORM FAIL NC1244.2 +060000 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +060100 MOVE " -12" TO CORRECT-A NC1244.2 +060200 PERFORM PRINT-DETAIL. NC1244.2 +060300 ADD 1 TO REC-CT. NC1244.2 +060400 PICTURE-TEST-3-F. NC1244.2 +060500 IF EDIT-AREA-6 EQUAL TO " -12" NC1244.2 +060600 PERFORM PASS NC1244.2 +060700 PERFORM PRINT-DETAIL NC1244.2 +060800 ELSE PERFORM FAIL NC1244.2 +060900 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +061000 MOVE " -12" TO CORRECT-A NC1244.2 +061100 PERFORM PRINT-DETAIL. NC1244.2 +061200 ADD 1 TO REC-CT. NC1244.2 +061300 PICTURE-TEST-3-G. NC1244.2 +061400 IF EDIT-AREA-7 EQUAL TO " -12.00" NC1244.2 +061500 PERFORM PASS NC1244.2 +061600 PERFORM PRINT-DETAIL NC1244.2 +061700 ELSE PERFORM FAIL NC1244.2 +061800 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +061900 MOVE " -12.00" TO CORRECT-A NC1244.2 +062000 PERFORM PRINT-DETAIL. NC1244.2 +062100 ADD 1 TO REC-CT. NC1244.2 +062200 PICTURE-TEST-3-H. NC1244.2 +062300 IF EDIT-AREA-8 EQUAL TO " -12.00" NC1244.2 +062400 PERFORM PASS NC1244.2 +062500 PERFORM PRINT-DETAIL NC1244.2 +062600 ELSE PERFORM FAIL NC1244.2 +062700 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +062800 MOVE " -12.00" TO CORRECT-A NC1244.2 +062900 PERFORM PRINT-DETAIL. NC1244.2 +063000 PICTURE-INIT-4. NC1244.2 +063100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +063200 MOVE "PICTRE-TST-4" TO PAR-NAME. NC1244.2 +063300 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +063400 MOVE 123 TO WORK-AREA-4. NC1244.2 +063500 MOVE 1 TO REC-CT. NC1244.2 +063600 PICTURE-TEST-4. NC1244.2 +063700 MOVE WORK-AREA-4 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +063800 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +063900 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +064000 GO TO PICTURE-TEST-4-A. NC1244.2 +064100 PICTURE-DELETE-4. NC1244.2 +064200 PERFORM DE-LETE. NC1244.2 +064300 PERFORM PRINT-DETAIL. NC1244.2 +064400 GO TO PICTURE-INIT-5. NC1244.2 +064500 PICTURE-TEST-4-A. NC1244.2 +064600 IF EDIT-AREA-1 EQUAL TO "+0123" NC1244.2 +064700 PERFORM PASS NC1244.2 +064800 PERFORM PRINT-DETAIL NC1244.2 +064900 ELSE PERFORM FAIL NC1244.2 +065000 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +065100 MOVE "+0123" TO CORRECT-A NC1244.2 +065200 PERFORM PRINT-DETAIL. NC1244.2 +065300 ADD 1 TO REC-CT. NC1244.2 +065400 PICTURE-TEST-4-B. NC1244.2 +065500 IF EDIT-AREA-2 EQUAL TO " 0123" NC1244.2 +065600 PERFORM PASS NC1244.2 +065700 PERFORM PRINT-DETAIL NC1244.2 +065800 ELSE PERFORM FAIL NC1244.2 +065900 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +066000 MOVE " 0123" TO CORRECT-A NC1244.2 +066100 PERFORM PRINT-DETAIL. NC1244.2 +066200 ADD 1 TO REC-CT. NC1244.2 +066300 PICTURE-TEST-4-C. NC1244.2 +066400 IF EDIT-AREA-3 EQUAL TO " +123" NC1244.2 +066500 PERFORM PASS NC1244.2 +066600 PERFORM PRINT-DETAIL NC1244.2 +066700 ELSE PERFORM FAIL NC1244.2 +066800 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +066900 MOVE " +123" TO CORRECT-A NC1244.2 +067000 PERFORM PRINT-DETAIL. NC1244.2 +067100 ADD 1 TO REC-CT. NC1244.2 +067200 PICTURE-TEST-4-D. NC1244.2 +067300 IF EDIT-AREA-4 EQUAL TO " 123" NC1244.2 +067400 PERFORM PASS NC1244.2 +067500 PERFORM PRINT-DETAIL NC1244.2 +067600 ELSE PERFORM FAIL NC1244.2 +067700 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +067800 MOVE " 123" TO CORRECT-A NC1244.2 +067900 PERFORM PRINT-DETAIL. NC1244.2 +068000 ADD 1 TO REC-CT. NC1244.2 +068100 PICTURE-TEST-4-E. NC1244.2 +068200 IF EDIT-AREA-5 EQUAL TO " +123" NC1244.2 +068300 PERFORM PASS NC1244.2 +068400 PERFORM PRINT-DETAIL NC1244.2 +068500 ELSE PERFORM FAIL NC1244.2 +068600 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +068700 MOVE " +123" TO CORRECT-A NC1244.2 +068800 PERFORM PRINT-DETAIL. NC1244.2 +068900 ADD 1 TO REC-CT. NC1244.2 +069000 PICTURE-TEST-4-F. NC1244.2 +069100 IF EDIT-AREA-6 EQUAL TO " 123" NC1244.2 +069200 PERFORM PASS NC1244.2 +069300 PERFORM PRINT-DETAIL NC1244.2 +069400 ELSE PERFORM FAIL NC1244.2 +069500 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +069600 MOVE " 123" TO CORRECT-A NC1244.2 +069700 PERFORM PRINT-DETAIL. NC1244.2 +069800 ADD 1 TO REC-CT. NC1244.2 +069900 PICTURE-TEST-4-G. NC1244.2 +070000 IF EDIT-AREA-7 EQUAL TO " +123.00" NC1244.2 +070100 PERFORM PASS NC1244.2 +070200 PERFORM PRINT-DETAIL NC1244.2 +070300 ELSE PERFORM FAIL NC1244.2 +070400 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +070500 MOVE " +123.00" TO CORRECT-A NC1244.2 +070600 PERFORM PRINT-DETAIL. NC1244.2 +070700 ADD 1 TO REC-CT. NC1244.2 +070800 PICTURE-TEST-4-H. NC1244.2 +070900 IF EDIT-AREA-8 EQUAL TO " 123.00" NC1244.2 +071000 PERFORM PASS NC1244.2 +071100 PERFORM PRINT-DETAIL NC1244.2 +071200 ELSE PERFORM FAIL NC1244.2 +071300 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +071400 MOVE " 123.00" TO CORRECT-A NC1244.2 +071500 PERFORM PRINT-DETAIL. NC1244.2 +071600 PICTURE-INIT-5. NC1244.2 +071700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +071800 MOVE "PICTRE-TST-5" TO PAR-NAME. NC1244.2 +071900 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +072000 MOVE -123 TO WORK-AREA-5. NC1244.2 +072100 MOVE 1 TO REC-CT. NC1244.2 +072200 PICTURE-TEST-5. NC1244.2 +072300 MOVE WORK-AREA-5 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +072400 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +072500 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +072600 GO TO PICTURE-TEST-5-A. NC1244.2 +072700 PICTURE-DELETE-5. NC1244.2 +072800 PERFORM DE-LETE. NC1244.2 +072900 PERFORM PRINT-DETAIL. NC1244.2 +073000 GO TO PICTURE-INIT-6. NC1244.2 +073100 PICTURE-TEST-5-A. NC1244.2 +073200 IF EDIT-AREA-1 EQUAL TO "-0123" NC1244.2 +073300 PERFORM PASS NC1244.2 +073400 PERFORM PRINT-DETAIL NC1244.2 +073500 ELSE PERFORM FAIL NC1244.2 +073600 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +073700 MOVE "-0123" TO CORRECT-A NC1244.2 +073800 PERFORM PRINT-DETAIL. NC1244.2 +073900 ADD 1 TO REC-CT. NC1244.2 +074000 PICTURE-TEST-5-B. NC1244.2 +074100 IF EDIT-AREA-2 EQUAL TO "-0123" NC1244.2 +074200 PERFORM PASS NC1244.2 +074300 PERFORM PRINT-DETAIL NC1244.2 +074400 ELSE PERFORM FAIL NC1244.2 +074500 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +074600 MOVE "-0123" TO CORRECT-A NC1244.2 +074700 PERFORM PRINT-DETAIL. NC1244.2 +074800 ADD 1 TO REC-CT. NC1244.2 +074900 PICTURE-TEST-5-C. NC1244.2 +075000 IF EDIT-AREA-3 EQUAL TO " -123" NC1244.2 +075100 PERFORM PASS NC1244.2 +075200 PERFORM PRINT-DETAIL NC1244.2 +075300 ELSE PERFORM FAIL NC1244.2 +075400 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +075500 MOVE " -123" TO CORRECT-A NC1244.2 +075600 PERFORM PRINT-DETAIL. NC1244.2 +075700 ADD 1 TO REC-CT. NC1244.2 +075800 PICTURE-TEST-5-D. NC1244.2 +075900 IF EDIT-AREA-4 EQUAL TO " -123" NC1244.2 +076000 PERFORM PASS NC1244.2 +076100 PERFORM PRINT-DETAIL NC1244.2 +076200 ELSE PERFORM FAIL NC1244.2 +076300 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +076400 MOVE " -123" TO CORRECT-A NC1244.2 +076500 PERFORM PRINT-DETAIL. NC1244.2 +076600 ADD 1 TO REC-CT. NC1244.2 +076700 PICTURE-TEST-5-E. NC1244.2 +076800 IF EDIT-AREA-5 EQUAL TO " -123" NC1244.2 +076900 PERFORM PASS NC1244.2 +077000 PERFORM PRINT-DETAIL NC1244.2 +077100 ELSE PERFORM FAIL NC1244.2 +077200 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +077300 MOVE " -123" TO CORRECT-A NC1244.2 +077400 PERFORM PRINT-DETAIL. NC1244.2 +077500 ADD 1 TO REC-CT. NC1244.2 +077600 PICTURE-TEST-5-F. NC1244.2 +077700 IF EDIT-AREA-6 EQUAL TO " -123" NC1244.2 +077800 PERFORM PASS NC1244.2 +077900 PERFORM PRINT-DETAIL NC1244.2 +078000 ELSE PERFORM FAIL NC1244.2 +078100 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +078200 MOVE " -123" TO CORRECT-A NC1244.2 +078300 PERFORM PRINT-DETAIL. NC1244.2 +078400 ADD 1 TO REC-CT. NC1244.2 +078500 PICTURE-TEST-5-G. NC1244.2 +078600 IF EDIT-AREA-7 EQUAL TO " -123.00" NC1244.2 +078700 PERFORM PASS NC1244.2 +078800 PERFORM PRINT-DETAIL NC1244.2 +078900 ELSE PERFORM FAIL NC1244.2 +079000 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +079100 MOVE " -123.00" TO CORRECT-A NC1244.2 +079200 PERFORM PRINT-DETAIL. NC1244.2 +079300 ADD 1 TO REC-CT. NC1244.2 +079400 PICTURE-TEST-5-H. NC1244.2 +079500 IF EDIT-AREA-8 EQUAL TO " -123.00" NC1244.2 +079600 PERFORM PASS NC1244.2 +079700 PERFORM PRINT-DETAIL NC1244.2 +079800 ELSE PERFORM FAIL NC1244.2 +079900 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +080000 MOVE " -123.00" TO CORRECT-A NC1244.2 +080100 PERFORM PRINT-DETAIL. NC1244.2 +080200 PICTURE-INIT-6. NC1244.2 +080300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +080400 MOVE "PICTRE-TST-6" TO PAR-NAME. NC1244.2 +080500 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +080600 MOVE 1234 TO WORK-AREA-6. NC1244.2 +080700 MOVE 1 TO REC-CT. NC1244.2 +080800 PICTURE-TEST-6. NC1244.2 +080900 MOVE WORK-AREA-6 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +081000 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +081100 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +081200 GO TO PICTURE-TEST-6-A. NC1244.2 +081300 PICTURE-DELETE-6. NC1244.2 +081400 PERFORM DE-LETE. NC1244.2 +081500 PERFORM PRINT-DETAIL. NC1244.2 +081600 GO TO PICTURE-INIT-7. NC1244.2 +081700 PICTURE-TEST-6-A. NC1244.2 +081800 IF EDIT-AREA-1 EQUAL TO "+1234" NC1244.2 +081900 PERFORM PASS NC1244.2 +082000 PERFORM PRINT-DETAIL NC1244.2 +082100 ELSE PERFORM FAIL NC1244.2 +082200 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +082300 MOVE "+1234" TO CORRECT-A NC1244.2 +082400 PERFORM PRINT-DETAIL. NC1244.2 +082500 ADD 1 TO REC-CT. NC1244.2 +082600 PICTURE-TEST-6-B. NC1244.2 +082700 IF EDIT-AREA-2 EQUAL TO " 1234" NC1244.2 +082800 PERFORM PASS NC1244.2 +082900 PERFORM PRINT-DETAIL NC1244.2 +083000 ELSE PERFORM FAIL NC1244.2 +083100 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +083200 MOVE " 1234" TO CORRECT-A NC1244.2 +083300 PERFORM PRINT-DETAIL. NC1244.2 +083400 ADD 1 TO REC-CT. NC1244.2 +083500 PICTURE-TEST-6-C. NC1244.2 +083600 IF EDIT-AREA-3 EQUAL TO "+1234" NC1244.2 +083700 PERFORM PASS NC1244.2 +083800 PERFORM PRINT-DETAIL NC1244.2 +083900 ELSE PERFORM FAIL NC1244.2 +084000 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +084100 MOVE "+1234" TO CORRECT-A NC1244.2 +084200 PERFORM PRINT-DETAIL. NC1244.2 +084300 ADD 1 TO REC-CT. NC1244.2 +084400 PICTURE-TEST-6-D. NC1244.2 +084500 IF EDIT-AREA-4 EQUAL TO " 1234" NC1244.2 +084600 PERFORM PASS NC1244.2 +084700 PERFORM PRINT-DETAIL NC1244.2 +084800 ELSE PERFORM FAIL NC1244.2 +084900 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +085000 MOVE " 1234" TO CORRECT-A NC1244.2 +085100 PERFORM PRINT-DETAIL. NC1244.2 +085200 ADD 1 TO REC-CT. NC1244.2 +085300 PICTURE-TEST-6-E. NC1244.2 +085400 IF EDIT-AREA-5 EQUAL TO "+1234" NC1244.2 +085500 PERFORM PASS NC1244.2 +085600 PERFORM PRINT-DETAIL NC1244.2 +085700 ELSE PERFORM FAIL NC1244.2 +085800 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +085900 MOVE "+1234" TO CORRECT-A NC1244.2 +086000 PERFORM PRINT-DETAIL. NC1244.2 +086100 ADD 1 TO REC-CT. NC1244.2 +086200 PICTURE-TEST-6-F. NC1244.2 +086300 IF EDIT-AREA-6 EQUAL TO " 1234" NC1244.2 +086400 PERFORM PASS NC1244.2 +086500 PERFORM PRINT-DETAIL NC1244.2 +086600 ELSE PERFORM FAIL NC1244.2 +086700 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +086800 MOVE " 1234" TO CORRECT-A NC1244.2 +086900 PERFORM PRINT-DETAIL. NC1244.2 +087000 ADD 1 TO REC-CT. NC1244.2 +087100 PICTURE-TEST-6-G. NC1244.2 +087200 IF EDIT-AREA-7 EQUAL TO "+1234.00" NC1244.2 +087300 PERFORM PASS NC1244.2 +087400 PERFORM PRINT-DETAIL NC1244.2 +087500 ELSE PERFORM FAIL NC1244.2 +087600 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +087700 MOVE "+1234.00" TO CORRECT-A NC1244.2 +087800 PERFORM PRINT-DETAIL. NC1244.2 +087900 ADD 1 TO REC-CT. NC1244.2 +088000 PICTURE-TEST-6-H. NC1244.2 +088100 IF EDIT-AREA-8 EQUAL TO " 1,234.00" NC1244.2 +088200 PERFORM PASS NC1244.2 +088300 PERFORM PRINT-DETAIL NC1244.2 +088400 ELSE PERFORM FAIL NC1244.2 +088500 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +088600 MOVE " 1,234.00" TO CORRECT-A NC1244.2 +088700 PERFORM PRINT-DETAIL. NC1244.2 +088800 PICTURE-INIT-7. NC1244.2 +088900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +089000 MOVE "PICTRE-TST-7" TO PAR-NAME. NC1244.2 +089100 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +089200 MOVE -1234 TO WORK-AREA-7. NC1244.2 +089300 MOVE 1 TO REC-CT. NC1244.2 +089400 PICTURE-TEST-7. NC1244.2 +089500 MOVE WORK-AREA-7 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +089600 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +089700 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +089800 GO TO PICTURE-TEST-7-A. NC1244.2 +089900 PICTURE-DELETE-7. NC1244.2 +090000 PERFORM DE-LETE. NC1244.2 +090100 PERFORM PRINT-DETAIL. NC1244.2 +090200 GO TO PICTURE-INIT-8. NC1244.2 +090300 PICTURE-TEST-7-A. NC1244.2 +090400 IF EDIT-AREA-1 EQUAL TO "-1234" NC1244.2 +090500 PERFORM PASS NC1244.2 +090600 PERFORM PRINT-DETAIL NC1244.2 +090700 ELSE PERFORM FAIL NC1244.2 +090800 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +090900 MOVE "-1234" TO CORRECT-A NC1244.2 +091000 PERFORM PRINT-DETAIL. NC1244.2 +091100 ADD 1 TO REC-CT. NC1244.2 +091200 PICTURE-TEST-7-B. NC1244.2 +091300 IF EDIT-AREA-2 EQUAL TO "-1234" NC1244.2 +091400 PERFORM PASS NC1244.2 +091500 PERFORM PRINT-DETAIL NC1244.2 +091600 ELSE PERFORM FAIL NC1244.2 +091700 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +091800 MOVE "-1234" TO CORRECT-A NC1244.2 +091900 PERFORM PRINT-DETAIL. NC1244.2 +092000 ADD 1 TO REC-CT. NC1244.2 +092100 PICTURE-TEST-7-C. NC1244.2 +092200 IF EDIT-AREA-3 EQUAL TO "-1234" NC1244.2 +092300 PERFORM PASS NC1244.2 +092400 PERFORM PRINT-DETAIL NC1244.2 +092500 ELSE PERFORM FAIL NC1244.2 +092600 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +092700 MOVE "-1234" TO CORRECT-A NC1244.2 +092800 PERFORM PRINT-DETAIL. NC1244.2 +092900 ADD 1 TO REC-CT. NC1244.2 +093000 PICTURE-TEST-7-D. NC1244.2 +093100 IF EDIT-AREA-4 EQUAL TO "-1234" NC1244.2 +093200 PERFORM PASS NC1244.2 +093300 PERFORM PRINT-DETAIL NC1244.2 +093400 ELSE PERFORM FAIL NC1244.2 +093500 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +093600 MOVE "-1234" TO CORRECT-A NC1244.2 +093700 PERFORM PRINT-DETAIL. NC1244.2 +093800 ADD 1 TO REC-CT. NC1244.2 +093900 PICTURE-TEST-7-E. NC1244.2 +094000 IF EDIT-AREA-5 EQUAL TO "-1234" NC1244.2 +094100 PERFORM PASS NC1244.2 +094200 PERFORM PRINT-DETAIL NC1244.2 +094300 ELSE PERFORM FAIL NC1244.2 +094400 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +094500 MOVE "-1234" TO CORRECT-A NC1244.2 +094600 PERFORM PRINT-DETAIL. NC1244.2 +094700 ADD 1 TO REC-CT. NC1244.2 +094800 PICTURE-TEST-7-F. NC1244.2 +094900 IF EDIT-AREA-6 EQUAL TO "-1234" NC1244.2 +095000 PERFORM PASS NC1244.2 +095100 PERFORM PRINT-DETAIL NC1244.2 +095200 ELSE PERFORM FAIL NC1244.2 +095300 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +095400 MOVE "-1234" TO CORRECT-A NC1244.2 +095500 PERFORM PRINT-DETAIL. NC1244.2 +095600 ADD 1 TO REC-CT. NC1244.2 +095700 PICTURE-TEST-7-G. NC1244.2 +095800 IF EDIT-AREA-7 EQUAL TO "-1234.00" NC1244.2 +095900 PERFORM PASS NC1244.2 +096000 PERFORM PRINT-DETAIL NC1244.2 +096100 ELSE PERFORM FAIL NC1244.2 +096200 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +096300 MOVE "-1234.00" TO CORRECT-A NC1244.2 +096400 PERFORM PRINT-DETAIL. NC1244.2 +096500 ADD 1 TO REC-CT. NC1244.2 +096600 PICTURE-TEST-7-H. NC1244.2 +096700 IF EDIT-AREA-8 EQUAL TO "-1,234.00" NC1244.2 +096800 PERFORM PASS NC1244.2 +096900 PERFORM PRINT-DETAIL NC1244.2 +097000 ELSE PERFORM FAIL NC1244.2 +097100 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +097200 MOVE "-1,234.00" TO CORRECT-A NC1244.2 +097300 PERFORM PRINT-DETAIL. NC1244.2 +097400 PICTURE-INIT-8. NC1244.2 +097500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +097600 MOVE "PICTRE-TST-8" TO PAR-NAME. NC1244.2 +097700 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +097800 MOVE 12.34 TO WORK-AREA-8. NC1244.2 +097900 MOVE 1 TO REC-CT. NC1244.2 +098000 PICTURE-TEST-8. NC1244.2 +098100 MOVE WORK-AREA-8 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +098200 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +098300 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +098400 GO TO PICTURE-TEST-8-A. NC1244.2 +098500 PICTURE-DELETE-8. NC1244.2 +098600 PERFORM DE-LETE. NC1244.2 +098700 PERFORM PRINT-DETAIL. NC1244.2 +098800 GO TO PICTURE-INIT-9. NC1244.2 +098900 PICTURE-TEST-8-A. NC1244.2 +099000 IF EDIT-AREA-1 EQUAL TO "+0012" NC1244.2 +099100 PERFORM PASS NC1244.2 +099200 PERFORM PRINT-DETAIL NC1244.2 +099300 ELSE PERFORM FAIL NC1244.2 +099400 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +099500 MOVE "+0012" TO CORRECT-A NC1244.2 +099600 PERFORM PRINT-DETAIL. NC1244.2 +099700 ADD 1 TO REC-CT. NC1244.2 +099800 PICTURE-TEST-8-B. NC1244.2 +099900 IF EDIT-AREA-2 EQUAL TO " 0012" NC1244.2 +100000 PERFORM PASS NC1244.2 +100100 PERFORM PRINT-DETAIL NC1244.2 +100200 ELSE PERFORM FAIL NC1244.2 +100300 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +100400 MOVE " 0012" TO CORRECT-A NC1244.2 +100500 PERFORM PRINT-DETAIL. NC1244.2 +100600 ADD 1 TO REC-CT. NC1244.2 +100700 PICTURE-TEST-8-C. NC1244.2 +100800 IF EDIT-AREA-3 EQUAL TO " +12" NC1244.2 +100900 PERFORM PASS NC1244.2 +101000 PERFORM PRINT-DETAIL NC1244.2 +101100 ELSE PERFORM FAIL NC1244.2 +101200 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +101300 MOVE " +12" TO CORRECT-A NC1244.2 +101400 PERFORM PRINT-DETAIL. NC1244.2 +101500 ADD 1 TO REC-CT. NC1244.2 +101600 PICTURE-TEST-8-D. NC1244.2 +101700 IF EDIT-AREA-4 EQUAL TO " 12" NC1244.2 +101800 PERFORM PASS NC1244.2 +101900 PERFORM PRINT-DETAIL NC1244.2 +102000 ELSE PERFORM FAIL NC1244.2 +102100 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +102200 MOVE " 12" TO CORRECT-A NC1244.2 +102300 PERFORM PRINT-DETAIL. NC1244.2 +102400 ADD 1 TO REC-CT. NC1244.2 +102500 PICTURE-TEST-8-E. NC1244.2 +102600 IF EDIT-AREA-5 EQUAL TO " +12" NC1244.2 +102700 PERFORM PASS NC1244.2 +102800 PERFORM PRINT-DETAIL NC1244.2 +102900 ELSE PERFORM FAIL NC1244.2 +103000 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +103100 MOVE " +12" TO CORRECT-A NC1244.2 +103200 PERFORM PRINT-DETAIL. NC1244.2 +103300 ADD 1 TO REC-CT. NC1244.2 +103400 PICTURE-TEST-8-F. NC1244.2 +103500 IF EDIT-AREA-6 EQUAL TO " 12" NC1244.2 +103600 PERFORM PASS NC1244.2 +103700 PERFORM PRINT-DETAIL NC1244.2 +103800 ELSE PERFORM FAIL NC1244.2 +103900 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +104000 MOVE " 12" TO CORRECT-A NC1244.2 +104100 PERFORM PRINT-DETAIL. NC1244.2 +104200 ADD 1 TO REC-CT. NC1244.2 +104300 PICTURE-TEST-8-G. NC1244.2 +104400 IF EDIT-AREA-7 EQUAL TO " +12.34" NC1244.2 +104500 PERFORM PASS NC1244.2 +104600 PERFORM PRINT-DETAIL NC1244.2 +104700 ELSE PERFORM FAIL NC1244.2 +104800 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +104900 MOVE " +12.34" TO CORRECT-A NC1244.2 +105000 PERFORM PRINT-DETAIL. NC1244.2 +105100 ADD 1 TO REC-CT. NC1244.2 +105200 PICTURE-TEST-8-H. NC1244.2 +105300 IF EDIT-AREA-8 EQUAL TO " 12.34" NC1244.2 +105400 PERFORM PASS NC1244.2 +105500 PERFORM PRINT-DETAIL NC1244.2 +105600 ELSE PERFORM FAIL NC1244.2 +105700 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +105800 MOVE " 12.34" TO CORRECT-A NC1244.2 +105900 PERFORM PRINT-DETAIL. NC1244.2 +106000 PICTURE-INIT-9. NC1244.2 +106100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +106200 MOVE "PICTRE-TST-9" TO PAR-NAME. NC1244.2 +106300 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +106400 MOVE -12.34 TO WORK-AREA-9. NC1244.2 +106500 MOVE 1 TO REC-CT. NC1244.2 +106600 PICTURE-TEST-9. NC1244.2 +106700 MOVE WORK-AREA-9 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +106800 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +106900 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +107000 GO TO PICTURE-TEST-9-A. NC1244.2 +107100 PICTURE-DELETE-9. NC1244.2 +107200 PERFORM DE-LETE. NC1244.2 +107300 PERFORM PRINT-DETAIL. NC1244.2 +107400 GO TO PICTURE-INIT-10. NC1244.2 +107500 PICTURE-TEST-9-A. NC1244.2 +107600 IF EDIT-AREA-1 EQUAL TO "-0012" NC1244.2 +107700 PERFORM PASS NC1244.2 +107800 PERFORM PRINT-DETAIL NC1244.2 +107900 ELSE PERFORM FAIL NC1244.2 +108000 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +108100 MOVE "-0012" TO CORRECT-A NC1244.2 +108200 PERFORM PRINT-DETAIL. NC1244.2 +108300 ADD 1 TO REC-CT. NC1244.2 +108400 PICTURE-TEST-9-B. NC1244.2 +108500 IF EDIT-AREA-2 EQUAL TO "-0012" NC1244.2 +108600 PERFORM PASS NC1244.2 +108700 PERFORM PRINT-DETAIL NC1244.2 +108800 ELSE PERFORM FAIL NC1244.2 +108900 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +109000 MOVE "-0012" TO CORRECT-A NC1244.2 +109100 PERFORM PRINT-DETAIL. NC1244.2 +109200 ADD 1 TO REC-CT. NC1244.2 +109300 PICTURE-TEST-9-C. NC1244.2 +109400 IF EDIT-AREA-3 EQUAL TO " -12" NC1244.2 +109500 PERFORM PASS NC1244.2 +109600 PERFORM PRINT-DETAIL NC1244.2 +109700 ELSE PERFORM FAIL NC1244.2 +109800 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +109900 MOVE " -12" TO CORRECT-A NC1244.2 +110000 PERFORM PRINT-DETAIL. NC1244.2 +110100 ADD 1 TO REC-CT. NC1244.2 +110200 PICTURE-TEST-9-D. NC1244.2 +110300 IF EDIT-AREA-4 EQUAL TO " -12" NC1244.2 +110400 PERFORM PASS NC1244.2 +110500 PERFORM PRINT-DETAIL NC1244.2 +110600 ELSE PERFORM FAIL NC1244.2 +110700 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +110800 MOVE " -12" TO CORRECT-A NC1244.2 +110900 PERFORM PRINT-DETAIL. NC1244.2 +111000 ADD 1 TO REC-CT. NC1244.2 +111100 PICTURE-TEST-9-E. NC1244.2 +111200 IF EDIT-AREA-5 EQUAL TO " -12" NC1244.2 +111300 PERFORM PASS NC1244.2 +111400 PERFORM PRINT-DETAIL NC1244.2 +111500 ELSE PERFORM FAIL NC1244.2 +111600 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +111700 MOVE " -12" TO CORRECT-A NC1244.2 +111800 PERFORM PRINT-DETAIL. NC1244.2 +111900 ADD 1 TO REC-CT. NC1244.2 +112000 PICTURE-TEST-9-F. NC1244.2 +112100 IF EDIT-AREA-6 EQUAL TO " -12" NC1244.2 +112200 PERFORM PASS NC1244.2 +112300 PERFORM PRINT-DETAIL NC1244.2 +112400 ELSE PERFORM FAIL NC1244.2 +112500 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +112600 MOVE " -12" TO CORRECT-A NC1244.2 +112700 PERFORM PRINT-DETAIL. NC1244.2 +112800 ADD 1 TO REC-CT. NC1244.2 +112900 PICTURE-TEST-9-G. NC1244.2 +113000 IF EDIT-AREA-7 EQUAL TO " -12.34" NC1244.2 +113100 PERFORM PASS NC1244.2 +113200 PERFORM PRINT-DETAIL NC1244.2 +113300 ELSE PERFORM FAIL NC1244.2 +113400 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +113500 MOVE " -12.34" TO CORRECT-A NC1244.2 +113600 PERFORM PRINT-DETAIL. NC1244.2 +113700 ADD 1 TO REC-CT. NC1244.2 +113800 PICTURE-TEST-9-H. NC1244.2 +113900 IF EDIT-AREA-8 EQUAL TO " -12.34" NC1244.2 +114000 PERFORM PASS NC1244.2 +114100 PERFORM PRINT-DETAIL NC1244.2 +114200 ELSE PERFORM FAIL NC1244.2 +114300 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +114400 MOVE " -12.34" TO CORRECT-A NC1244.2 +114500 PERFORM PRINT-DETAIL. NC1244.2 +114600 PICTURE-INIT-10. NC1244.2 +114700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +114800 MOVE "PCTRE-TST-10" TO PAR-NAME. NC1244.2 +114900 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +115000 MOVE 0 TO WORK-AREA-10. NC1244.2 +115100 MOVE 1 TO REC-CT. NC1244.2 +115200 PICTURE-TEST-10. NC1244.2 +115300 MOVE WORK-AREA-10 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +115400 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +115500 GO TO PICTURE-TEST-10-A. NC1244.2 +115600 PICTURE-DELETE-10. NC1244.2 +115700 PERFORM DE-LETE. NC1244.2 +115800 PERFORM PRINT-DETAIL. NC1244.2 +115900 GO TO PICTURE-INIT-11. NC1244.2 +116000 PICTURE-TEST-10-A. NC1244.2 +116100 IF EDIT-AREA-9 EQUAL TO " $00" NC1244.2 +116200 PERFORM PASS NC1244.2 +116300 PERFORM PRINT-DETAIL NC1244.2 +116400 ELSE PERFORM FAIL NC1244.2 +116500 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +116600 MOVE " $00" TO CORRECT-A NC1244.2 +116700 PERFORM PRINT-DETAIL. NC1244.2 +116800 ADD 1 TO REC-CT. NC1244.2 +116900 PICTURE-TEST-10-B. NC1244.2 +117000 IF EDIT-AREA-10 EQUAL TO " $0" NC1244.2 +117100 PERFORM PASS NC1244.2 +117200 PERFORM PRINT-DETAIL NC1244.2 +117300 ELSE PERFORM FAIL NC1244.2 +117400 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +117500 MOVE " $0" TO CORRECT-A NC1244.2 +117600 PERFORM PRINT-DETAIL. NC1244.2 +117700 ADD 1 TO REC-CT. NC1244.2 +117800 PICTURE-TEST-10-C. NC1244.2 +117900 IF EDIT-AREA-11 EQUAL TO " $.00" NC1244.2 +118000 PERFORM PASS NC1244.2 +118100 PERFORM PRINT-DETAIL NC1244.2 +118200 ELSE PERFORM FAIL NC1244.2 +118300 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +118400 MOVE " $.00" TO CORRECT-A NC1244.2 +118500 PERFORM PRINT-DETAIL. NC1244.2 +118600 ADD 1 TO REC-CT. NC1244.2 +118700 PICTURE-TEST-10-D. NC1244.2 +118800 IF EDIT-AREA-12 EQUAL TO " " NC1244.2 +118900 PERFORM PASS NC1244.2 +119000 PERFORM PRINT-DETAIL NC1244.2 +119100 ELSE PERFORM FAIL NC1244.2 +119200 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +119300 MOVE "SPACES" TO CORRECT-A NC1244.2 +119400 PERFORM PRINT-DETAIL. NC1244.2 +119500 PICTURE-INIT-11. NC1244.2 +119600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +119700 MOVE "PCTRE-TST-11" TO PAR-NAME. NC1244.2 +119800 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +119900 MOVE .02 TO WORK-AREA-11. NC1244.2 +120000 MOVE 1 TO REC-CT. NC1244.2 +120100 PICTURE-TEST-11. NC1244.2 +120200 MOVE WORK-AREA-11 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +120300 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +120400 GO TO PICTURE-TEST-11-A. NC1244.2 +120500 PICTURE-DELETE-11. NC1244.2 +120600 PERFORM DE-LETE. NC1244.2 +120700 PERFORM PRINT-DETAIL. NC1244.2 +120800 GO TO PICTURE-INIT-12. NC1244.2 +120900 PICTURE-TEST-11-A. NC1244.2 +121000 IF EDIT-AREA-9 EQUAL TO " $00" NC1244.2 +121100 PERFORM PASS NC1244.2 +121200 PERFORM PRINT-DETAIL NC1244.2 +121300 ELSE PERFORM FAIL NC1244.2 +121400 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +121500 MOVE " $00" TO CORRECT-A NC1244.2 +121600 PERFORM PRINT-DETAIL. NC1244.2 +121700 ADD 1 TO REC-CT. NC1244.2 +121800 PICTURE-TEST-11-B. NC1244.2 +121900 IF EDIT-AREA-10 EQUAL TO " $0" NC1244.2 +122000 PERFORM PASS NC1244.2 +122100 PERFORM PRINT-DETAIL NC1244.2 +122200 ELSE PERFORM FAIL NC1244.2 +122300 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +122400 MOVE " $0" TO CORRECT-A NC1244.2 +122500 PERFORM PRINT-DETAIL. NC1244.2 +122600 ADD 1 TO REC-CT. NC1244.2 +122700 PICTURE-TEST-11-C. NC1244.2 +122800 IF EDIT-AREA-11 EQUAL TO " $.02" NC1244.2 +122900 PERFORM PASS NC1244.2 +123000 PERFORM PRINT-DETAIL NC1244.2 +123100 ELSE PERFORM FAIL NC1244.2 +123200 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +123300 MOVE " $.02" TO CORRECT-A NC1244.2 +123400 PERFORM PRINT-DETAIL. NC1244.2 +123500 ADD 1 TO REC-CT. NC1244.2 +123600 PICTURE-TEST-11-D. NC1244.2 +123700 IF EDIT-AREA-12 EQUAL TO " $.02" NC1244.2 +123800 PERFORM PASS NC1244.2 +123900 PERFORM PRINT-DETAIL NC1244.2 +124000 ELSE PERFORM FAIL NC1244.2 +124100 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +124200 MOVE " $.02" TO CORRECT-A NC1244.2 +124300 PERFORM PRINT-DETAIL. NC1244.2 +124400 PICTURE-INIT-12. NC1244.2 +124500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +124600 MOVE "PCTRE-TST-12" TO PAR-NAME. NC1244.2 +124700 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +124800 MOVE 12 TO WORK-AREA-12. NC1244.2 +124900 MOVE 1 TO REC-CT. NC1244.2 +125000 PICTURE-TEST-12. NC1244.2 +125100 MOVE WORK-AREA-12 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +125200 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +125300 GO TO PICTURE-TEST-12-A. NC1244.2 +125400 PICTURE-DELETE-12. NC1244.2 +125500 PERFORM DE-LETE. NC1244.2 +125600 PERFORM PRINT-DETAIL. NC1244.2 +125700 GO TO PICTURE-INIT-13. NC1244.2 +125800 PICTURE-TEST-12-A. NC1244.2 +125900 IF EDIT-AREA-9 EQUAL TO " $12" NC1244.2 +126000 PERFORM PASS NC1244.2 +126100 PERFORM PRINT-DETAIL NC1244.2 +126200 ELSE PERFORM FAIL NC1244.2 +126300 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +126400 MOVE " $12" TO CORRECT-A NC1244.2 +126500 PERFORM PRINT-DETAIL. NC1244.2 +126600 ADD 1 TO REC-CT. NC1244.2 +126700 PICTURE-TEST-12-B. NC1244.2 +126800 IF EDIT-AREA-10 EQUAL TO " $12" NC1244.2 +126900 PERFORM PASS NC1244.2 +127000 PERFORM PRINT-DETAIL NC1244.2 +127100 ELSE PERFORM FAIL NC1244.2 +127200 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +127300 MOVE " $12" TO CORRECT-A NC1244.2 +127400 PERFORM PRINT-DETAIL. NC1244.2 +127500 ADD 1 TO REC-CT. NC1244.2 +127600 PICTURE-TEST-12-C. NC1244.2 +127700 IF EDIT-AREA-11 EQUAL TO " $12.00" NC1244.2 +127800 PERFORM PASS NC1244.2 +127900 PERFORM PRINT-DETAIL NC1244.2 +128000 ELSE PERFORM FAIL NC1244.2 +128100 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +128200 MOVE " $12.00" TO CORRECT-A NC1244.2 +128300 PERFORM PRINT-DETAIL. NC1244.2 +128400 ADD 1 TO REC-CT. NC1244.2 +128500 PICTURE-TEST-12-D. NC1244.2 +128600 IF EDIT-AREA-12 EQUAL TO " $12.00" NC1244.2 +128700 PERFORM PASS NC1244.2 +128800 PERFORM PRINT-DETAIL NC1244.2 +128900 ELSE PERFORM FAIL NC1244.2 +129000 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +129100 MOVE " $12.00" TO CORRECT-A NC1244.2 +129200 PERFORM PRINT-DETAIL. NC1244.2 +129300 PICTURE-INIT-13. NC1244.2 +129400 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +129500 MOVE "PCTRE-TST-13" TO PAR-NAME. NC1244.2 +129600 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +129700 MOVE 12.34 TO WORK-AREA-13. NC1244.2 +129800 MOVE 1 TO REC-CT. NC1244.2 +129900 PICTURE-TEST-13. NC1244.2 +130000 MOVE WORK-AREA-13 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +130100 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +130200 GO TO PICTURE-TEST-13-A. NC1244.2 +130300 PICTURE-DELETE-13. NC1244.2 +130400 PERFORM DE-LETE. NC1244.2 +130500 PERFORM PRINT-DETAIL. NC1244.2 +130600 GO TO PICTURE-INIT-14. NC1244.2 +130700 PICTURE-TEST-13-A. NC1244.2 +130800 IF EDIT-AREA-9 EQUAL TO " $12" NC1244.2 +130900 PERFORM PASS NC1244.2 +131000 PERFORM PRINT-DETAIL NC1244.2 +131100 ELSE PERFORM FAIL NC1244.2 +131200 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +131300 MOVE " $12" TO CORRECT-A NC1244.2 +131400 PERFORM PRINT-DETAIL. NC1244.2 +131500 ADD 1 TO REC-CT. NC1244.2 +131600 PICTURE-TEST-13-B. NC1244.2 +131700 IF EDIT-AREA-10 EQUAL TO " $12" NC1244.2 +131800 PERFORM PASS NC1244.2 +131900 PERFORM PRINT-DETAIL NC1244.2 +132000 ELSE PERFORM FAIL NC1244.2 +132100 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +132200 MOVE " $12" TO CORRECT-A NC1244.2 +132300 PERFORM PRINT-DETAIL. NC1244.2 +132400 ADD 1 TO REC-CT. NC1244.2 +132500 PICTURE-TEST-13-C. NC1244.2 +132600 IF EDIT-AREA-11 EQUAL TO " $12.34" NC1244.2 +132700 PERFORM PASS NC1244.2 +132800 PERFORM PRINT-DETAIL NC1244.2 +132900 ELSE PERFORM FAIL NC1244.2 +133000 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +133100 MOVE " $12.34" TO CORRECT-A NC1244.2 +133200 PERFORM PRINT-DETAIL. NC1244.2 +133300 ADD 1 TO REC-CT. NC1244.2 +133400 PICTURE-TEST-13-D. NC1244.2 +133500 IF EDIT-AREA-12 EQUAL TO " $12.34" NC1244.2 +133600 PERFORM PASS NC1244.2 +133700 PERFORM PRINT-DETAIL NC1244.2 +133800 ELSE PERFORM FAIL NC1244.2 +133900 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +134000 MOVE " $12.34" TO CORRECT-A NC1244.2 +134100 PERFORM PRINT-DETAIL. NC1244.2 +134200 PICTURE-INIT-14. NC1244.2 +134300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +134400 MOVE "PCTRE-TST-14" TO PAR-NAME. NC1244.2 +134500 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +134600 MOVE 1234 TO WORK-AREA-14. NC1244.2 +134700 MOVE 1 TO REC-CT. NC1244.2 +134800 PICTURE-TEST-14. NC1244.2 +134900 MOVE WORK-AREA-14 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +135000 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +135100 GO TO PICTURE-TEST-14-A. NC1244.2 +135200 PICTURE-DELETE-14. NC1244.2 +135300 PERFORM DE-LETE. NC1244.2 +135400 PERFORM PRINT-DETAIL. NC1244.2 +135500 GO TO PICTURE-INIT-15. NC1244.2 +135600 PICTURE-TEST-14-A. NC1244.2 +135700 IF EDIT-AREA-9 EQUAL TO "$234" NC1244.2 +135800 PERFORM PASS NC1244.2 +135900 PERFORM PRINT-DETAIL NC1244.2 +136000 ELSE PERFORM FAIL NC1244.2 +136100 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +136200 MOVE "$234" TO CORRECT-A NC1244.2 +136300 PERFORM PRINT-DETAIL. NC1244.2 +136400 ADD 1 TO REC-CT. NC1244.2 +136500 PICTURE-TEST-14-B. NC1244.2 +136600 IF EDIT-AREA-10 EQUAL TO "$1234" NC1244.2 +136700 PERFORM PASS NC1244.2 +136800 PERFORM PRINT-DETAIL NC1244.2 +136900 ELSE PERFORM FAIL NC1244.2 +137000 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +137100 MOVE "$1234" TO CORRECT-A NC1244.2 +137200 PERFORM PRINT-DETAIL. NC1244.2 +137300 ADD 1 TO REC-CT. NC1244.2 +137400 PICTURE-TEST-14-C. NC1244.2 +137500 IF EDIT-AREA-11 EQUAL TO "$1234.00" NC1244.2 +137600 PERFORM PASS NC1244.2 +137700 PERFORM PRINT-DETAIL NC1244.2 +137800 ELSE PERFORM FAIL NC1244.2 +137900 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +138000 MOVE "$1234.00" TO CORRECT-A NC1244.2 +138100 PERFORM PRINT-DETAIL. NC1244.2 +138200 ADD 1 TO REC-CT. NC1244.2 +138300 PICTURE-TEST-14-D. NC1244.2 +138400 IF EDIT-AREA-12 EQUAL TO "$1,234.00" NC1244.2 +138500 PERFORM PASS NC1244.2 +138600 PERFORM PRINT-DETAIL NC1244.2 +138700 ELSE PERFORM FAIL NC1244.2 +138800 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +138900 MOVE "$1,234.00" TO CORRECT-A NC1244.2 +139000 PERFORM PRINT-DETAIL. NC1244.2 +139100 PICTURE-INIT-15. NC1244.2 +139200 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +139300 MOVE "PCTRE-TST-15" TO PAR-NAME. NC1244.2 +139400 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +139500 MOVE 1234.56 TO WORK-AREA-15. NC1244.2 +139600 MOVE 1 TO REC-CT. NC1244.2 +139700 PICTURE-TEST-15. NC1244.2 +139800 MOVE WORK-AREA-15 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +139900 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +140000 GO TO PICTURE-TEST-15-A. NC1244.2 +140100 PICTURE-DELETE-15. NC1244.2 +140200 PERFORM DE-LETE. NC1244.2 +140300 PERFORM PRINT-DETAIL. NC1244.2 +140400 GO TO PICTURE-INIT-16. NC1244.2 +140500 PICTURE-TEST-15-A. NC1244.2 +140600 IF EDIT-AREA-9 EQUAL TO "$234" NC1244.2 +140700 PERFORM PASS NC1244.2 +140800 PERFORM PRINT-DETAIL NC1244.2 +140900 ELSE PERFORM FAIL NC1244.2 +141000 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +141100 MOVE "$234" TO CORRECT-A NC1244.2 +141200 PERFORM PRINT-DETAIL. NC1244.2 +141300 ADD 1 TO REC-CT. NC1244.2 +141400 PICTURE-TEST-15-B. NC1244.2 +141500 IF EDIT-AREA-10 EQUAL TO "$1234" NC1244.2 +141600 PERFORM PASS NC1244.2 +141700 PERFORM PRINT-DETAIL NC1244.2 +141800 ELSE PERFORM FAIL NC1244.2 +141900 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +142000 MOVE "$1234" TO CORRECT-A NC1244.2 +142100 PERFORM PRINT-DETAIL. NC1244.2 +142200 ADD 1 TO REC-CT. NC1244.2 +142300 PICTURE-TEST-15-C. NC1244.2 +142400 IF EDIT-AREA-11 EQUAL TO "$1234.56" NC1244.2 +142500 PERFORM PASS NC1244.2 +142600 PERFORM PRINT-DETAIL NC1244.2 +142700 ELSE PERFORM FAIL NC1244.2 +142800 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +142900 MOVE "$1234.56" TO CORRECT-A NC1244.2 +143000 PERFORM PRINT-DETAIL. NC1244.2 +143100 ADD 1 TO REC-CT. NC1244.2 +143200 PICTURE-TEST-15-D. NC1244.2 +143300 IF EDIT-AREA-12 EQUAL TO "$1,234.56" NC1244.2 +143400 PERFORM PASS NC1244.2 +143500 PERFORM PRINT-DETAIL NC1244.2 +143600 ELSE PERFORM FAIL NC1244.2 +143700 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +143800 MOVE "$1,234.56" TO CORRECT-A NC1244.2 +143900 PERFORM PRINT-DETAIL. NC1244.2 +144000 PICTURE-INIT-16. NC1244.2 +144100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +144200 MOVE "PCTRE-TST-16" TO PAR-NAME. NC1244.2 +144300 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +144400 MOVE 0 TO WORK-AREA-16. NC1244.2 +144500 MOVE 1 TO REC-CT. NC1244.2 +144600 PICTURE-TEST-16. NC1244.2 +144700 MOVE WORK-AREA-16 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +144800 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +144900 GO TO PICTURE-TEST-16-A. NC1244.2 +145000 PICTURE-DELETE-16. NC1244.2 +145100 PERFORM DE-LETE. NC1244.2 +145200 PERFORM PRINT-DETAIL. NC1244.2 +145300 GO TO PICTURE-INIT-17. NC1244.2 +145400 PICTURE-TEST-16-A. NC1244.2 +145500 IF EDIT-AREA-13 EQUAL TO "*000" NC1244.2 +145600 PERFORM PASS NC1244.2 +145700 PERFORM PRINT-DETAIL NC1244.2 +145800 ELSE PERFORM FAIL NC1244.2 +145900 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +146000 MOVE "*000" TO CORRECT-A NC1244.2 +146100 PERFORM PRINT-DETAIL. NC1244.2 +146200 ADD 1 TO REC-CT. NC1244.2 +146300 PICTURE-TEST-16-B. NC1244.2 +146400 IF EDIT-AREA-14 EQUAL TO "**00" NC1244.2 +146500 PERFORM PASS NC1244.2 +146600 PERFORM PRINT-DETAIL NC1244.2 +146700 ELSE PERFORM FAIL NC1244.2 +146800 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +146900 MOVE "**00" TO CORRECT-A NC1244.2 +147000 PERFORM PRINT-DETAIL. NC1244.2 +147100 ADD 1 TO REC-CT. NC1244.2 +147200 PICTURE-TEST-16-C. NC1244.2 +147300 IF EDIT-AREA-15 EQUAL TO "***0" NC1244.2 +147400 PERFORM PASS NC1244.2 +147500 PERFORM PRINT-DETAIL NC1244.2 +147600 ELSE PERFORM FAIL NC1244.2 +147700 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +147800 MOVE "***0" TO CORRECT-A NC1244.2 +147900 PERFORM PRINT-DETAIL. NC1244.2 +148000 ADD 1 TO REC-CT. NC1244.2 +148100 PICTURE-TEST-16-D. NC1244.2 +148200 IF EDIT-AREA-16 EQUAL TO "**.**" NC1244.2 +148300 PERFORM PASS NC1244.2 +148400 PERFORM PRINT-DETAIL NC1244.2 +148500 ELSE PERFORM FAIL NC1244.2 +148600 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +148700 MOVE "**.**" TO CORRECT-A NC1244.2 +148800 PERFORM PRINT-DETAIL. NC1244.2 +148900 ADD 1 TO REC-CT. NC1244.2 +149000 PICTURE-TEST-16-E. NC1244.2 +149100 IF EDIT-AREA-17 EQUAL TO "*****.**" NC1244.2 +149200 PERFORM PASS NC1244.2 +149300 PERFORM PRINT-DETAIL NC1244.2 +149400 ELSE PERFORM FAIL NC1244.2 +149500 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +149600 MOVE "*****.**" TO CORRECT-A NC1244.2 +149700 PERFORM PRINT-DETAIL. NC1244.2 +149800 PICTURE-INIT-17. NC1244.2 +149900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +150000 MOVE "PCTRE-TST-17" TO PAR-NAME. NC1244.2 +150100 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +150200 MOVE 13 TO WORK-AREA-17. NC1244.2 +150300 MOVE 1 TO REC-CT. NC1244.2 +150400 PICTURE-TEST-17. NC1244.2 +150500 MOVE WORK-AREA-17 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +150600 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +150700 GO TO PICTURE-TEST-17-A. NC1244.2 +150800 PICTURE-DELETE-17. NC1244.2 +150900 PERFORM DE-LETE. NC1244.2 +151000 PERFORM PRINT-DETAIL. NC1244.2 +151100 GO TO PICTURE-INIT-18. NC1244.2 +151200 PICTURE-TEST-17-A. NC1244.2 +151300 IF EDIT-AREA-13 EQUAL TO "*013" NC1244.2 +151400 PERFORM PASS NC1244.2 +151500 PERFORM PRINT-DETAIL NC1244.2 +151600 ELSE PERFORM FAIL NC1244.2 +151700 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +151800 MOVE "*013" TO CORRECT-A NC1244.2 +151900 PERFORM PRINT-DETAIL. NC1244.2 +152000 ADD 1 TO REC-CT. NC1244.2 +152100 PICTURE-TEST-17-B. NC1244.2 +152200 IF EDIT-AREA-14 EQUAL TO "**13" NC1244.2 +152300 PERFORM PASS NC1244.2 +152400 PERFORM PRINT-DETAIL NC1244.2 +152500 ELSE PERFORM FAIL NC1244.2 +152600 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +152700 MOVE "**13" TO CORRECT-A NC1244.2 +152800 PERFORM PRINT-DETAIL. NC1244.2 +152900 ADD 1 TO REC-CT. NC1244.2 +153000 PICTURE-TEST-17-C. NC1244.2 +153100 IF EDIT-AREA-15 EQUAL TO "**13" NC1244.2 +153200 PERFORM PASS NC1244.2 +153300 PERFORM PRINT-DETAIL NC1244.2 +153400 ELSE PERFORM FAIL NC1244.2 +153500 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +153600 MOVE "**13" TO CORRECT-A NC1244.2 +153700 PERFORM PRINT-DETAIL. NC1244.2 +153800 ADD 1 TO REC-CT. NC1244.2 +153900 PICTURE-TEST-17-D. NC1244.2 +154000 IF EDIT-AREA-16 EQUAL TO "13.00" NC1244.2 +154100 PERFORM PASS NC1244.2 +154200 PERFORM PRINT-DETAIL NC1244.2 +154300 ELSE PERFORM FAIL NC1244.2 +154400 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +154500 MOVE "13.00" TO CORRECT-A NC1244.2 +154600 PERFORM PRINT-DETAIL. NC1244.2 +154700 ADD 1 TO REC-CT. NC1244.2 +154800 PICTURE-TEST-17-E. NC1244.2 +154900 IF EDIT-AREA-17 EQUAL TO "***13.00" NC1244.2 +155000 PERFORM PASS NC1244.2 +155100 PERFORM PRINT-DETAIL NC1244.2 +155200 ELSE PERFORM FAIL NC1244.2 +155300 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +155400 MOVE "***13.00" TO CORRECT-A NC1244.2 +155500 PERFORM PRINT-DETAIL. NC1244.2 +155600 PICTURE-INIT-18. NC1244.2 +155700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +155800 MOVE "PCTRE-TST-18" TO PAR-NAME. NC1244.2 +155900 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +156000 MOVE 123 TO WORK-AREA-18. NC1244.2 +156100 MOVE 1 TO REC-CT. NC1244.2 +156200 PICTURE-TEST-18. NC1244.2 +156300 MOVE WORK-AREA-18 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +156400 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +156500 GO TO PICTURE-TEST-18-A. NC1244.2 +156600 PICTURE-DELETE-18. NC1244.2 +156700 PERFORM DE-LETE. NC1244.2 +156800 PERFORM PRINT-DETAIL. NC1244.2 +156900 GO TO PICTURE-INIT-19. NC1244.2 +157000 PICTURE-TEST-18-A. NC1244.2 +157100 IF EDIT-AREA-13 EQUAL TO "*123" NC1244.2 +157200 PERFORM PASS NC1244.2 +157300 PERFORM PRINT-DETAIL NC1244.2 +157400 ELSE PERFORM FAIL NC1244.2 +157500 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +157600 MOVE "*123" TO CORRECT-A NC1244.2 +157700 PERFORM PRINT-DETAIL. NC1244.2 +157800 ADD 1 TO REC-CT. NC1244.2 +157900 PICTURE-TEST-18-B. NC1244.2 +158000 IF EDIT-AREA-14 EQUAL TO "*123" NC1244.2 +158100 PERFORM PASS NC1244.2 +158200 PERFORM PRINT-DETAIL NC1244.2 +158300 ELSE PERFORM FAIL NC1244.2 +158400 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +158500 MOVE "*123" TO CORRECT-A NC1244.2 +158600 PERFORM PRINT-DETAIL. NC1244.2 +158700 ADD 1 TO REC-CT. NC1244.2 +158800 PICTURE-TEST-18-C. NC1244.2 +158900 IF EDIT-AREA-15 EQUAL TO "*123" NC1244.2 +159000 PERFORM PASS NC1244.2 +159100 PERFORM PRINT-DETAIL NC1244.2 +159200 ELSE PERFORM FAIL NC1244.2 +159300 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +159400 MOVE "*123" TO CORRECT-A NC1244.2 +159500 PERFORM PRINT-DETAIL. NC1244.2 +159600 ADD 1 TO REC-CT. NC1244.2 +159700 PICTURE-TEST-18-D. NC1244.2 +159800 IF EDIT-AREA-16 EQUAL TO "23.00" NC1244.2 +159900 PERFORM PASS NC1244.2 +160000 PERFORM PRINT-DETAIL NC1244.2 +160100 ELSE PERFORM FAIL NC1244.2 +160200 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +160300 MOVE "23.00" TO CORRECT-A NC1244.2 +160400 PERFORM PRINT-DETAIL. NC1244.2 +160500 ADD 1 TO REC-CT. NC1244.2 +160600 PICTURE-TEST-18-E. NC1244.2 +160700 IF EDIT-AREA-17 EQUAL TO "**123.00" NC1244.2 +160800 PERFORM PASS NC1244.2 +160900 PERFORM PRINT-DETAIL NC1244.2 +161000 ELSE PERFORM FAIL NC1244.2 +161100 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +161200 MOVE "**123.00" TO CORRECT-A NC1244.2 +161300 PERFORM PRINT-DETAIL. NC1244.2 +161400 PICTURE-INIT-19. NC1244.2 +161500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +161600 MOVE "PCTRE-TST-19" TO PAR-NAME. NC1244.2 +161700 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +161800 MOVE 2010 TO WORK-AREA-19. NC1244.2 +161900 MOVE 1 TO REC-CT. NC1244.2 +162000 PICTURE-TEST-19. NC1244.2 +162100 MOVE WORK-AREA-19 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +162200 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +162300 GO TO PICTURE-TEST-19-A. NC1244.2 +162400 PICTURE-DELETE-19. NC1244.2 +162500 PERFORM DE-LETE. NC1244.2 +162600 PERFORM PRINT-DETAIL. NC1244.2 +162700 GO TO PICTURE-INIT-20. NC1244.2 +162800 PICTURE-TEST-19-A. NC1244.2 +162900 IF EDIT-AREA-13 EQUAL TO "2010" NC1244.2 +163000 PERFORM PASS NC1244.2 +163100 PERFORM PRINT-DETAIL NC1244.2 +163200 ELSE PERFORM FAIL NC1244.2 +163300 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +163400 MOVE "2010" TO CORRECT-A NC1244.2 +163500 PERFORM PRINT-DETAIL. NC1244.2 +163600 ADD 1 TO REC-CT. NC1244.2 +163700 PICTURE-TEST-19-B. NC1244.2 +163800 IF EDIT-AREA-14 EQUAL TO "2010" NC1244.2 +163900 PERFORM PASS NC1244.2 +164000 PERFORM PRINT-DETAIL NC1244.2 +164100 ELSE PERFORM FAIL NC1244.2 +164200 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +164300 MOVE "2010" TO CORRECT-A NC1244.2 +164400 PERFORM PRINT-DETAIL. NC1244.2 +164500 ADD 1 TO REC-CT. NC1244.2 +164600 PICTURE-TEST-19-C. NC1244.2 +164700 IF EDIT-AREA-15 EQUAL TO "2010" NC1244.2 +164800 PERFORM PASS NC1244.2 +164900 PERFORM PRINT-DETAIL NC1244.2 +165000 ELSE PERFORM FAIL NC1244.2 +165100 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +165200 MOVE "2010" TO CORRECT-A NC1244.2 +165300 PERFORM PRINT-DETAIL. NC1244.2 +165400 ADD 1 TO REC-CT. NC1244.2 +165500 PICTURE-TEST-19-D. NC1244.2 +165600 IF EDIT-AREA-16 EQUAL TO "10.00" NC1244.2 +165700 PERFORM PASS NC1244.2 +165800 PERFORM PRINT-DETAIL NC1244.2 +165900 ELSE PERFORM FAIL NC1244.2 +166000 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +166100 MOVE "10.00" TO CORRECT-A NC1244.2 +166200 PERFORM PRINT-DETAIL. NC1244.2 +166300 ADD 1 TO REC-CT. NC1244.2 +166400 PICTURE-TEST-19-E. NC1244.2 +166500 IF EDIT-AREA-17 EQUAL TO "2,010.00" NC1244.2 +166600 PERFORM PASS NC1244.2 +166700 PERFORM PRINT-DETAIL NC1244.2 +166800 ELSE PERFORM FAIL NC1244.2 +166900 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +167000 MOVE "2,010.00" TO CORRECT-A NC1244.2 +167100 PERFORM PRINT-DETAIL. NC1244.2 +167200 PICTURE-INIT-20. NC1244.2 +167300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +167400 MOVE "PCTRE-TST-20" TO PAR-NAME. NC1244.2 +167500 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +167600 MOVE 1 TO REC-CT. NC1244.2 +167700 MOVE 1010.2 TO WORK-AREA-20. NC1244.2 +167800 PICTURE-TEST-20. NC1244.2 +167900 MOVE WORK-AREA-20 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +168000 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +168100 GO TO PICTURE-TEST-20-A. NC1244.2 +168200 PICTURE-DELETE-20. NC1244.2 +168300 PERFORM DE-LETE. NC1244.2 +168400 PERFORM PRINT-DETAIL. NC1244.2 +168500 GO TO PICTURE-INIT-21. NC1244.2 +168600 PICTURE-TEST-20-A. NC1244.2 +168700 IF EDIT-AREA-13 EQUAL TO "1010" NC1244.2 +168800 PERFORM PASS NC1244.2 +168900 PERFORM PRINT-DETAIL NC1244.2 +169000 ELSE PERFORM FAIL NC1244.2 +169100 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +169200 MOVE "1010" TO CORRECT-A NC1244.2 +169300 PERFORM PRINT-DETAIL. NC1244.2 +169400 ADD 1 TO REC-CT. NC1244.2 +169500 PICTURE-TEST-20-B. NC1244.2 +169600 IF EDIT-AREA-14 EQUAL TO "1010" NC1244.2 +169700 PERFORM PASS NC1244.2 +169800 PERFORM PRINT-DETAIL NC1244.2 +169900 ELSE PERFORM FAIL NC1244.2 +170000 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +170100 MOVE "1010" TO CORRECT-A NC1244.2 +170200 PERFORM PRINT-DETAIL. NC1244.2 +170300 ADD 1 TO REC-CT. NC1244.2 +170400 PICTURE-TEST-20-C. NC1244.2 +170500 IF EDIT-AREA-15 EQUAL TO "1010" NC1244.2 +170600 PERFORM PASS NC1244.2 +170700 PERFORM PRINT-DETAIL NC1244.2 +170800 ELSE PERFORM FAIL NC1244.2 +170900 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +171000 MOVE "1010" TO CORRECT-A NC1244.2 +171100 PERFORM PRINT-DETAIL. NC1244.2 +171200 ADD 1 TO REC-CT. NC1244.2 +171300 PICTURE-TEST-20-D. NC1244.2 +171400 IF EDIT-AREA-16 EQUAL TO "10.20" NC1244.2 +171500 PERFORM PASS NC1244.2 +171600 PERFORM PRINT-DETAIL NC1244.2 +171700 ELSE PERFORM FAIL NC1244.2 +171800 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +171900 MOVE "10.20" TO CORRECT-A NC1244.2 +172000 PERFORM PRINT-DETAIL. NC1244.2 +172100 ADD 1 TO REC-CT. NC1244.2 +172200 PICTURE-TEST-20-E. NC1244.2 +172300 IF EDIT-AREA-17 EQUAL TO "1,010.20" NC1244.2 +172400 PERFORM PASS NC1244.2 +172500 PERFORM PRINT-DETAIL NC1244.2 +172600 ELSE PERFORM FAIL NC1244.2 +172700 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +172800 MOVE "1,010.20" TO CORRECT-A NC1244.2 +172900 PERFORM PRINT-DETAIL. NC1244.2 +173000 PICTURE-INIT-21. NC1244.2 +173100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +173200 MOVE "PCTRE-TST-21" TO PAR-NAME. NC1244.2 +173300 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +173400 MOVE .01 TO WORK-AREA-21. NC1244.2 +173500 MOVE 1 TO REC-CT. NC1244.2 +173600 PICTURE-TEST-21. NC1244.2 +173700 MOVE WORK-AREA-21 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +173800 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +173900 GO TO PICTURE-TEST-21-A. NC1244.2 +174000 PICTURE-DELETE-21. NC1244.2 +174100 PERFORM DE-LETE. NC1244.2 +174200 PERFORM PRINT-DETAIL. NC1244.2 +174300 GO TO PICTURE-INIT-22. NC1244.2 +174400 PICTURE-TEST-21-A. NC1244.2 +174500 IF EDIT-AREA-13 EQUAL TO "*000" NC1244.2 +174600 PERFORM PASS NC1244.2 +174700 PERFORM PRINT-DETAIL NC1244.2 +174800 ELSE PERFORM FAIL NC1244.2 +174900 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +175000 MOVE "*000" TO CORRECT-A NC1244.2 +175100 PERFORM PRINT-DETAIL. NC1244.2 +175200 ADD 1 TO REC-CT. NC1244.2 +175300 PICTURE-TEST-21-B. NC1244.2 +175400 IF EDIT-AREA-14 EQUAL TO "**00" NC1244.2 +175500 PERFORM PASS NC1244.2 +175600 PERFORM PRINT-DETAIL NC1244.2 +175700 ELSE PERFORM FAIL NC1244.2 +175800 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +175900 MOVE "**00" TO CORRECT-A NC1244.2 +176000 PERFORM PRINT-DETAIL. NC1244.2 +176100 ADD 1 TO REC-CT. NC1244.2 +176200 PICTURE-TEST-21-C. NC1244.2 +176300 IF EDIT-AREA-15 EQUAL TO "***0" NC1244.2 +176400 PERFORM PASS NC1244.2 +176500 PERFORM PRINT-DETAIL NC1244.2 +176600 ELSE PERFORM FAIL NC1244.2 +176700 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +176800 MOVE "***0" TO CORRECT-A NC1244.2 +176900 PERFORM PRINT-DETAIL. NC1244.2 +177000 ADD 1 TO REC-CT. NC1244.2 +177100 PICTURE-TEST-21-D. NC1244.2 +177200 IF EDIT-AREA-16 EQUAL TO "**.01" NC1244.2 +177300 PERFORM PASS NC1244.2 +177400 PERFORM PRINT-DETAIL NC1244.2 +177500 ELSE PERFORM FAIL NC1244.2 +177600 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +177700 MOVE "**.01" TO CORRECT-A NC1244.2 +177800 PERFORM PRINT-DETAIL. NC1244.2 +177900 ADD 1 TO REC-CT. NC1244.2 +178000 PICTURE-TEST-21-E. NC1244.2 +178100 IF EDIT-AREA-17 EQUAL TO "*****.01" NC1244.2 +178200 PERFORM PASS NC1244.2 +178300 PERFORM PRINT-DETAIL NC1244.2 +178400 ELSE PERFORM FAIL NC1244.2 +178500 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +178600 MOVE "*****.01" TO CORRECT-A NC1244.2 +178700 PERFORM PRINT-DETAIL. NC1244.2 +178800 PICTURE-INIT-22. NC1244.2 +178900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +179000 MOVE "PCTRE-TST-22" TO PAR-NAME. NC1244.2 +179100 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +179200 MOVE 0 TO WORK-AREA-22. NC1244.2 +179300 MOVE 1 TO REC-CT. NC1244.2 +179400 PICTURE-TEST-22. NC1244.2 +179500 MOVE WORK-AREA-22 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +179600 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +179700 EDIT-AREA-24. NC1244.2 +179800 GO TO PICTURE-TEST-22-A. NC1244.2 +179900 PICTURE-DELETE-22. NC1244.2 +180000 PERFORM DE-LETE. NC1244.2 +180100 PERFORM PRINT-DETAIL. NC1244.2 +180200 GO TO PICTURE-INIT-23. NC1244.2 +180300 PICTURE-TEST-22-A. NC1244.2 +180400 IF EDIT-AREA-18 EQUAL TO "0000" NC1244.2 +180500 PERFORM PASS NC1244.2 +180600 PERFORM PRINT-DETAIL NC1244.2 +180700 ELSE PERFORM FAIL NC1244.2 +180800 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +180900 MOVE "0000" TO CORRECT-A NC1244.2 +181000 PERFORM PRINT-DETAIL. NC1244.2 +181100 ADD 1 TO REC-CT. NC1244.2 +181200 PICTURE-TEST-22-B. NC1244.2 +181300 IF EDIT-AREA-19 EQUAL TO " 000" NC1244.2 +181400 PERFORM PASS NC1244.2 +181500 PERFORM PRINT-DETAIL NC1244.2 +181600 ELSE PERFORM FAIL NC1244.2 +181700 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +181800 MOVE " 000" TO CORRECT-A NC1244.2 +181900 PERFORM PRINT-DETAIL. NC1244.2 +182000 ADD 1 TO REC-CT. NC1244.2 +182100 PICTURE-TEST-22-C. NC1244.2 +182200 IF EDIT-AREA-20 EQUAL TO " 00" NC1244.2 +182300 PERFORM PASS NC1244.2 +182400 PERFORM PRINT-DETAIL NC1244.2 +182500 ELSE PERFORM FAIL NC1244.2 +182600 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +182700 MOVE " 00" TO CORRECT-A NC1244.2 +182800 PERFORM PRINT-DETAIL. NC1244.2 +182900 ADD 1 TO REC-CT. NC1244.2 +183000 PICTURE-TEST-22-D. NC1244.2 +183100 IF EDIT-AREA-21 EQUAL TO " 0" NC1244.2 +183200 PERFORM PASS NC1244.2 +183300 PERFORM PRINT-DETAIL NC1244.2 +183400 ELSE PERFORM FAIL NC1244.2 +183500 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +183600 MOVE " 0" TO CORRECT-A NC1244.2 +183700 PERFORM PRINT-DETAIL. NC1244.2 +183800 ADD 1 TO REC-CT. NC1244.2 +183900 PICTURE-TEST-22-E. NC1244.2 +184000 IF EDIT-AREA-22 EQUAL TO " " NC1244.2 +184100 PERFORM PASS NC1244.2 +184200 PERFORM PRINT-DETAIL NC1244.2 +184300 ELSE PERFORM FAIL NC1244.2 +184400 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +184500 MOVE "SPACES" TO CORRECT-A NC1244.2 +184600 PERFORM PRINT-DETAIL. NC1244.2 +184700 ADD 1 TO REC-CT. NC1244.2 +184800 PICTURE-TEST-22-F. NC1244.2 +184900 IF EDIT-AREA-23 EQUAL TO " " NC1244.2 +185000 PERFORM PASS NC1244.2 +185100 PERFORM PRINT-DETAIL NC1244.2 +185200 ELSE PERFORM FAIL NC1244.2 +185300 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +185400 MOVE "SPACES" TO CORRECT-A NC1244.2 +185500 PERFORM PRINT-DETAIL. NC1244.2 +185600 ADD 1 TO REC-CT. NC1244.2 +185700 PICTURE-TEST-22-G. NC1244.2 +185800 IF EDIT-AREA-24 EQUAL TO " " NC1244.2 +185900 PERFORM PASS NC1244.2 +186000 PERFORM PRINT-DETAIL NC1244.2 +186100 ELSE PERFORM FAIL NC1244.2 +186200 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +186300 MOVE "SPACES" TO CORRECT-A NC1244.2 +186400 PERFORM PRINT-DETAIL. NC1244.2 +186500 PICTURE-INIT-23. NC1244.2 +186600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +186700 MOVE "PCTRE-TST-23" TO PAR-NAME. NC1244.2 +186800 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +186900 MOVE 1.01 TO WORK-AREA-23. NC1244.2 +187000 MOVE 1 TO REC-CT. NC1244.2 +187100 PICTURE-TEST-23. NC1244.2 +187200 MOVE WORK-AREA-23 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +187300 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +187400 EDIT-AREA-24. NC1244.2 +187500 GO TO PICTURE-TEST-23-A. NC1244.2 +187600 PICTURE-DELETE-23. NC1244.2 +187700 PERFORM DE-LETE. NC1244.2 +187800 PERFORM PRINT-DETAIL. NC1244.2 +187900 GO TO PICTURE-INIT-24. NC1244.2 +188000 PICTURE-TEST-23-A. NC1244.2 +188100 IF EDIT-AREA-18 EQUAL TO "0001" NC1244.2 +188200 PERFORM PASS NC1244.2 +188300 PERFORM PRINT-DETAIL NC1244.2 +188400 ELSE PERFORM FAIL NC1244.2 +188500 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +188600 MOVE "0001" TO CORRECT-A NC1244.2 +188700 PERFORM PRINT-DETAIL. NC1244.2 +188800 ADD 1 TO REC-CT. NC1244.2 +188900 PICTURE-TEST-23-B. NC1244.2 +189000 IF EDIT-AREA-19 EQUAL TO " 001" NC1244.2 +189100 PERFORM PASS NC1244.2 +189200 PERFORM PRINT-DETAIL NC1244.2 +189300 ELSE PERFORM FAIL NC1244.2 +189400 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +189500 MOVE " 001" TO CORRECT-A NC1244.2 +189600 PERFORM PRINT-DETAIL. NC1244.2 +189700 ADD 1 TO REC-CT. NC1244.2 +189800 PICTURE-TEST-23-C. NC1244.2 +189900 IF EDIT-AREA-20 EQUAL TO " 01" NC1244.2 +190000 PERFORM PASS NC1244.2 +190100 PERFORM PRINT-DETAIL NC1244.2 +190200 ELSE PERFORM FAIL NC1244.2 +190300 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +190400 MOVE " 01" TO CORRECT-A NC1244.2 +190500 PERFORM PRINT-DETAIL. NC1244.2 +190600 ADD 1 TO REC-CT. NC1244.2 +190700 PICTURE-TEST-23-D. NC1244.2 +190800 IF EDIT-AREA-21 EQUAL TO " 1" NC1244.2 +190900 PERFORM PASS NC1244.2 +191000 PERFORM PRINT-DETAIL NC1244.2 +191100 ELSE PERFORM FAIL NC1244.2 +191200 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +191300 MOVE " 1" TO CORRECT-A NC1244.2 +191400 PERFORM PRINT-DETAIL. NC1244.2 +191500 ADD 1 TO REC-CT. NC1244.2 +191600 PICTURE-TEST-23-E. NC1244.2 +191700 IF EDIT-AREA-22 EQUAL TO " 1" NC1244.2 +191800 PERFORM PASS NC1244.2 +191900 PERFORM PRINT-DETAIL NC1244.2 +192000 ELSE PERFORM FAIL NC1244.2 +192100 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +192200 MOVE " 1" TO CORRECT-A NC1244.2 +192300 PERFORM PRINT-DETAIL. NC1244.2 +192400 ADD 1 TO REC-CT. NC1244.2 +192500 PICTURE-TEST-23-F. NC1244.2 +192600 IF EDIT-AREA-23 EQUAL TO " 1.01" NC1244.2 +192700 PERFORM PASS NC1244.2 +192800 PERFORM PRINT-DETAIL NC1244.2 +192900 ELSE PERFORM FAIL NC1244.2 +193000 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +193100 MOVE " 1.01" TO CORRECT-A NC1244.2 +193200 PERFORM PRINT-DETAIL. NC1244.2 +193300 ADD 1 TO REC-CT. NC1244.2 +193400 PICTURE-TEST-23-G. NC1244.2 +193500 IF EDIT-AREA-24 EQUAL TO " 1" NC1244.2 +193600 PERFORM PASS NC1244.2 +193700 PERFORM PRINT-DETAIL NC1244.2 +193800 ELSE PERFORM FAIL NC1244.2 +193900 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +194000 MOVE " 1" TO CORRECT-A NC1244.2 +194100 PERFORM PRINT-DETAIL. NC1244.2 +194200 PICTURE-INIT-24. NC1244.2 +194300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +194400 MOVE "PCTRE-TST-24" TO PAR-NAME. NC1244.2 +194500 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +194600 MOVE 217 TO WORK-AREA-24. NC1244.2 +194700 MOVE 1 TO REC-CT. NC1244.2 +194800 PICTURE-TEST-24. NC1244.2 +194900 MOVE WORK-AREA-24 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +195000 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +195100 EDIT-AREA-24. NC1244.2 +195200 GO TO PICTURE-TEST-24-A. NC1244.2 +195300 PICTURE-DELETE-24. NC1244.2 +195400 PERFORM DE-LETE. NC1244.2 +195500 PERFORM PRINT-DETAIL. NC1244.2 +195600 GO TO PICTURE-INIT-25. NC1244.2 +195700 PICTURE-TEST-24-A. NC1244.2 +195800 IF EDIT-AREA-18 EQUAL TO "0217" NC1244.2 +195900 PERFORM PASS NC1244.2 +196000 PERFORM PRINT-DETAIL NC1244.2 +196100 ELSE PERFORM FAIL NC1244.2 +196200 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +196300 MOVE "0217" TO CORRECT-A NC1244.2 +196400 PERFORM PRINT-DETAIL. NC1244.2 +196500 ADD 1 TO REC-CT. NC1244.2 +196600 PICTURE-TEST-24-B. NC1244.2 +196700 IF EDIT-AREA-19 EQUAL TO " 217" NC1244.2 +196800 PERFORM PASS NC1244.2 +196900 PERFORM PRINT-DETAIL NC1244.2 +197000 ELSE PERFORM FAIL NC1244.2 +197100 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +197200 MOVE " 217" TO CORRECT-A NC1244.2 +197300 PERFORM PRINT-DETAIL. NC1244.2 +197400 ADD 1 TO REC-CT. NC1244.2 +197500 PICTURE-TEST-24-C. NC1244.2 +197600 IF EDIT-AREA-20 EQUAL TO " 217" NC1244.2 +197700 PERFORM PASS NC1244.2 +197800 PERFORM PRINT-DETAIL NC1244.2 +197900 ELSE PERFORM FAIL NC1244.2 +198000 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +198100 MOVE " 217" TO CORRECT-A NC1244.2 +198200 PERFORM PRINT-DETAIL. NC1244.2 +198300 ADD 1 TO REC-CT. NC1244.2 +198400 PICTURE-TEST-24-D. NC1244.2 +198500 IF EDIT-AREA-21 EQUAL TO " 217" NC1244.2 +198600 PERFORM PASS NC1244.2 +198700 PERFORM PRINT-DETAIL NC1244.2 +198800 ELSE PERFORM FAIL NC1244.2 +198900 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +199000 MOVE " 217" TO CORRECT-A NC1244.2 +199100 PERFORM PRINT-DETAIL. NC1244.2 +199200 ADD 1 TO REC-CT. NC1244.2 +199300 PICTURE-TEST-24-E. NC1244.2 +199400 IF EDIT-AREA-22 EQUAL TO " 217" NC1244.2 +199500 PERFORM PASS NC1244.2 +199600 PERFORM PRINT-DETAIL NC1244.2 +199700 ELSE PERFORM FAIL NC1244.2 +199800 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +199900 MOVE " 217" TO CORRECT-A NC1244.2 +200000 PERFORM PRINT-DETAIL. NC1244.2 +200100 ADD 1 TO REC-CT. NC1244.2 +200200 PICTURE-TEST-24-F. NC1244.2 +200300 IF EDIT-AREA-23 EQUAL TO "17.00" NC1244.2 +200400 PERFORM PASS NC1244.2 +200500 PERFORM PRINT-DETAIL NC1244.2 +200600 ELSE PERFORM FAIL NC1244.2 +200700 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +200800 MOVE "17.00" TO CORRECT-A NC1244.2 +200900 PERFORM PRINT-DETAIL. NC1244.2 +201000 ADD 1 TO REC-CT. NC1244.2 +201100 PICTURE-TEST-24-G. NC1244.2 +201200 IF EDIT-AREA-24 EQUAL TO " 217" NC1244.2 +201300 PERFORM PASS NC1244.2 +201400 PERFORM PRINT-DETAIL NC1244.2 +201500 ELSE PERFORM FAIL NC1244.2 +201600 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +201700 MOVE " 217" TO CORRECT-A NC1244.2 +201800 PERFORM PRINT-DETAIL. NC1244.2 +201900 PICTURE-INIT-25. NC1244.2 +202000 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +202100 MOVE "PCTRE-TST-25" TO PAR-NAME. NC1244.2 +202200 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +202300 MOVE 1010.20 TO WORK-AREA-25. NC1244.2 +202400 MOVE 1 TO REC-CT. NC1244.2 +202500 PICTURE-TEST-25. NC1244.2 +202600 MOVE WORK-AREA-25 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +202700 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +202800 EDIT-AREA-24. NC1244.2 +202900 GO TO PICTURE-TEST-25-A. NC1244.2 +203000 PICTURE-DELETE-25. NC1244.2 +203100 PERFORM DE-LETE. NC1244.2 +203200 PERFORM PRINT-DETAIL. NC1244.2 +203300 GO TO PICTURE-INIT-26. NC1244.2 +203400 PICTURE-TEST-25-A. NC1244.2 +203500 IF EDIT-AREA-18 EQUAL TO "1010" NC1244.2 +203600 PERFORM PASS NC1244.2 +203700 PERFORM PRINT-DETAIL NC1244.2 +203800 ELSE PERFORM FAIL NC1244.2 +203900 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +204000 MOVE "1010" TO CORRECT-A NC1244.2 +204100 PERFORM PRINT-DETAIL. NC1244.2 +204200 ADD 1 TO REC-CT. NC1244.2 +204300 PICTURE-TEST-25-B. NC1244.2 +204400 IF EDIT-AREA-19 EQUAL TO "1010" NC1244.2 +204500 PERFORM PASS NC1244.2 +204600 PERFORM PRINT-DETAIL NC1244.2 +204700 ELSE PERFORM FAIL NC1244.2 +204800 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +204900 MOVE "1010" TO CORRECT-A NC1244.2 +205000 PERFORM PRINT-DETAIL. NC1244.2 +205100 ADD 1 TO REC-CT. NC1244.2 +205200 PICTURE-TEST-25-C. NC1244.2 +205300 IF EDIT-AREA-20 EQUAL TO "1010" NC1244.2 +205400 PERFORM PASS NC1244.2 +205500 PERFORM PRINT-DETAIL NC1244.2 +205600 ELSE PERFORM FAIL NC1244.2 +205700 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +205800 MOVE "1010" TO CORRECT-A NC1244.2 +205900 PERFORM PRINT-DETAIL. NC1244.2 +206000 ADD 1 TO REC-CT. NC1244.2 +206100 PICTURE-TEST-25-D. NC1244.2 +206200 IF EDIT-AREA-21 EQUAL TO "1010" NC1244.2 +206300 PERFORM PASS NC1244.2 +206400 PERFORM PRINT-DETAIL NC1244.2 +206500 ELSE PERFORM FAIL NC1244.2 +206600 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +206700 MOVE "1010" TO CORRECT-A NC1244.2 +206800 PERFORM PRINT-DETAIL. NC1244.2 +206900 ADD 1 TO REC-CT. NC1244.2 +207000 PICTURE-TEST-25-E. NC1244.2 +207100 IF EDIT-AREA-22 EQUAL TO "1010" NC1244.2 +207200 PERFORM PASS NC1244.2 +207300 PERFORM PRINT-DETAIL NC1244.2 +207400 ELSE PERFORM FAIL NC1244.2 +207500 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +207600 MOVE "1010" TO CORRECT-A NC1244.2 +207700 PERFORM PRINT-DETAIL. NC1244.2 +207800 ADD 1 TO REC-CT. NC1244.2 +207900 PICTURE-TEST-25-F. NC1244.2 +208000 IF EDIT-AREA-23 EQUAL TO "10.20" NC1244.2 +208100 PERFORM PASS NC1244.2 +208200 PERFORM PRINT-DETAIL NC1244.2 +208300 ELSE PERFORM FAIL NC1244.2 +208400 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +208500 MOVE "10.20" TO CORRECT-A NC1244.2 +208600 PERFORM PRINT-DETAIL. NC1244.2 +208700 ADD 1 TO REC-CT. NC1244.2 +208800 PICTURE-TEST-25-G. NC1244.2 +208900 IF EDIT-AREA-24 EQUAL TO "1,010" NC1244.2 +209000 PERFORM PASS NC1244.2 +209100 PERFORM PRINT-DETAIL NC1244.2 +209200 ELSE PERFORM FAIL NC1244.2 +209300 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +209400 MOVE "1,010" TO CORRECT-A NC1244.2 +209500 PERFORM PRINT-DETAIL. NC1244.2 +209600 PICTURE-INIT-26. NC1244.2 +209700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +209800 MOVE "PCTRE-TST-26" TO PAR-NAME. NC1244.2 +209900 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +210000 MOVE .01 TO WORK-AREA-26. NC1244.2 +210100 MOVE 1 TO REC-CT. NC1244.2 +210200 PICTURE-TEST-26. NC1244.2 +210300 MOVE WORK-AREA-26 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +210400 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +210500 EDIT-AREA-24. NC1244.2 +210600 GO TO PICTURE-TEST-26-A. NC1244.2 +210700 PICTURE-DELETE-26. NC1244.2 +210800 PERFORM DE-LETE. NC1244.2 +210900 PERFORM PRINT-DETAIL. NC1244.2 +211000 GO TO PICTURE-INIT-27. NC1244.2 +211100 PICTURE-TEST-26-A. NC1244.2 +211200 IF EDIT-AREA-18 EQUAL TO "0000" NC1244.2 +211300 PERFORM PASS NC1244.2 +211400 PERFORM PRINT-DETAIL NC1244.2 +211500 ELSE PERFORM FAIL NC1244.2 +211600 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +211700 MOVE "0000" TO CORRECT-A NC1244.2 +211800 PERFORM PRINT-DETAIL. NC1244.2 +211900 ADD 1 TO REC-CT. NC1244.2 +212000 PICTURE-TEST-26-B. NC1244.2 +212100 IF EDIT-AREA-19 EQUAL TO " 000" NC1244.2 +212200 PERFORM PASS NC1244.2 +212300 PERFORM PRINT-DETAIL NC1244.2 +212400 ELSE PERFORM FAIL NC1244.2 +212500 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +212600 MOVE " 000" TO CORRECT-A NC1244.2 +212700 PERFORM PRINT-DETAIL. NC1244.2 +212800 ADD 1 TO REC-CT. NC1244.2 +212900 PICTURE-TEST-26-C. NC1244.2 +213000 IF EDIT-AREA-20 EQUAL TO " 00" NC1244.2 +213100 PERFORM PASS NC1244.2 +213200 PERFORM PRINT-DETAIL NC1244.2 +213300 ELSE PERFORM FAIL NC1244.2 +213400 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +213500 MOVE " 00" TO CORRECT-A NC1244.2 +213600 PERFORM PRINT-DETAIL. NC1244.2 +213700 ADD 1 TO REC-CT. NC1244.2 +213800 IF EDIT-AREA-21 EQUAL TO " 0" NC1244.2 +213900 PERFORM PASS NC1244.2 +214000 PERFORM PRINT-DETAIL NC1244.2 +214100 ELSE PERFORM FAIL NC1244.2 +214200 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +214300 MOVE " 0" TO CORRECT-A NC1244.2 +214400 PERFORM PRINT-DETAIL. NC1244.2 +214500 ADD 1 TO REC-CT. NC1244.2 +214600 PICTURE-TEST-26-E. NC1244.2 +214700 IF EDIT-AREA-22 EQUAL TO " " NC1244.2 +214800 PERFORM PASS NC1244.2 +214900 PERFORM PRINT-DETAIL NC1244.2 +215000 ELSE PERFORM FAIL NC1244.2 +215100 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +215200 MOVE "SPACES" TO CORRECT-A NC1244.2 +215300 PERFORM PRINT-DETAIL. NC1244.2 +215400 ADD 1 TO REC-CT. NC1244.2 +215500 PICTURE-TEST-26-F. NC1244.2 +215600 IF EDIT-AREA-23 EQUAL TO " .01" NC1244.2 +215700 PERFORM PASS NC1244.2 +215800 PERFORM PRINT-DETAIL NC1244.2 +215900 ELSE PERFORM FAIL NC1244.2 +216000 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +216100 MOVE " .01" TO CORRECT-A NC1244.2 +216200 PERFORM PRINT-DETAIL. NC1244.2 +216300 ADD 1 TO REC-CT. NC1244.2 +216400 PICTURE-TEST-26-G. NC1244.2 +216500 IF EDIT-AREA-24 EQUAL TO " " NC1244.2 +216600 PERFORM PASS NC1244.2 +216700 PERFORM PRINT-DETAIL NC1244.2 +216800 ELSE PERFORM FAIL NC1244.2 +216900 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +217000 MOVE "SPACES" TO CORRECT-A NC1244.2 +217100 PERFORM PRINT-DETAIL. NC1244.2 +217200 PICTURE-INIT-27. NC1244.2 +217300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +217400 MOVE ZERO TO REC-CT. NC1244.2 +217500 MOVE 200 TO WORK-AREA-27. NC1244.2 +217600 MOVE SPACE TO WORK-AREA-27A. NC1244.2 +217700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +217800 PICTURE-TEST-27-0. NC1244.2 +217900 MOVE WORK-AREA-27 TO WORK-AREA-27A. NC1244.2 +218000 PICTURE-TEST-27-1. NC1244.2 +218100 IF WORK-AREA-27A EQUAL TO "200" NC1244.2 +218200 PERFORM PASS NC1244.2 +218300 ELSE GO TO PICTURE-FAIL-27. NC1244.2 +218400 GO TO PICTURE-WRITE-27. NC1244.2 +218500 PICTURE-DELETE-27. NC1244.2 +218600 PERFORM DE-LETE. NC1244.2 +218700 GO TO PICTURE-WRITE-27. NC1244.2 +218800 PICTURE-FAIL-27. NC1244.2 +218900 PERFORM FAIL. NC1244.2 +219000 MOVE WORK-AREA-27A TO COMPUTED-A. NC1244.2 +219100 MOVE "200" TO CORRECT-A. NC1244.2 +219200 PICTURE-WRITE-27. NC1244.2 +219300 MOVE "PICTURE-TEST-27" TO PAR-NAME. NC1244.2 +219400 PERFORM PRINT-DETAIL. NC1244.2 +219500 PICTURE-INIT-28. NC1244.2 +219600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +219700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +219800 MOVE 567 TO WORK-AREA-28. NC1244.2 +219900 MOVE ZERO TO WORK-AREA-28A. NC1244.2 +220000 PICTURE-TEST-28-0. NC1244.2 +220100 MOVE WORK-AREA-28 TO WORK-AREA-28A. NC1244.2 +220200 PICTURE-TEST-28-1. NC1244.2 +220300 IF WORK-AREA-28A EQUAL TO 500 NC1244.2 +220400 PERFORM PASS NC1244.2 +220500 ELSE GO TO PICTURE-FAIL-28. NC1244.2 +220600 GO TO PICTURE-WRITE-28. NC1244.2 +220700 PICTURE-DELETE-28. NC1244.2 +220800 PERFORM DE-LETE. NC1244.2 +220900 GO TO PICTURE-WRITE-28. NC1244.2 +221000 PICTURE-FAIL-28. NC1244.2 +221100 PERFORM FAIL. NC1244.2 +221200 MOVE WORK-AREA-28A TO COMPUTED-A. NC1244.2 +221300 MOVE 500 TO CORRECT-18V0. NC1244.2 +221400 PICTURE-WRITE-28. NC1244.2 +221500 MOVE "PICTURE-TEST-28" TO PAR-NAME. NC1244.2 +221600 PERFORM PRINT-DETAIL. NC1244.2 +221700 PICTURE-INIT-29. NC1244.2 +221800 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +221900 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +222000 MOVE 123 TO WORK-AREA-29. NC1244.2 +222100 MOVE ZERO TO WORK-AREA-29A. NC1244.2 +222200 MOVE SPACE TO WORK-AREA-29B. NC1244.2 +222300 PICTURE-TEST-29. NC1244.2 +222400 MOVE WORK-AREA-29 TO WORK-AREA-29A. NC1244.2 +222500 MOVE WORK-AREA-29A TO WORK-AREA-29B. NC1244.2 +222600 IF WORK-AREA-29B EQUAL TO "100" NC1244.2 +222700 PERFORM PASS NC1244.2 +222800 ELSE GO TO PICTURE-FAIL-29. NC1244.2 +222900 GO TO PICTURE-WRITE-29. NC1244.2 +223000 PICTURE-DELETE-29. NC1244.2 +223100 PERFORM DE-LETE. NC1244.2 +223200 GO TO PICTURE-WRITE-29. NC1244.2 +223300 PICTURE-FAIL-29. NC1244.2 +223400 PERFORM FAIL. NC1244.2 +223500 MOVE WORK-AREA-29B TO COMPUTED-A. NC1244.2 +223600 MOVE "100" TO CORRECT-A. NC1244.2 +223700 PICTURE-WRITE-29. NC1244.2 +223800 MOVE "PICTURE-TEST-29" TO PAR-NAME. NC1244.2 +223900 PERFORM PRINT-DETAIL. NC1244.2 +224000 PICTURE-INIT-30. NC1244.2 +224100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +224200 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +224300 MOVE 00900 TO WORK-AREA-30. NC1244.2 +224400 MOVE ZERO TO WORK-AREA-30A. NC1244.2 +224500 PICTURE-TEST-30-0. NC1244.2 +224600 MOVE WORK-AREA-30 TO WORK-AREA-30A. NC1244.2 +224700 PICTURE-TEST-30-1. NC1244.2 +224800 IF WORK-AREA-30A EQUAL TO " 9" NC1244.2 +224900 PERFORM PASS NC1244.2 +225000 ELSE GO TO PICTURE-FAIL-30. NC1244.2 +225100 GO TO PICTURE-WRITE-30. NC1244.2 +225200 PICTURE-DELETE-30. NC1244.2 +225300 PERFORM DE-LETE. NC1244.2 +225400 GO TO PICTURE-WRITE-30. NC1244.2 +225500 PICTURE-FAIL-30. NC1244.2 +225600 PERFORM FAIL. NC1244.2 +225700 MOVE WORK-AREA-30A TO COMPUTED-A. NC1244.2 +225800 MOVE " 9" TO CORRECT-A. NC1244.2 +225900 PICTURE-WRITE-30. NC1244.2 +226000 MOVE "PICTURE-TEST-30" TO PAR-NAME. NC1244.2 +226100 PERFORM PRINT-DETAIL. NC1244.2 +226200 PICTURE-INIT-31. NC1244.2 +226300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +226400 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +226500 MOVE 01200 TO WORK-AREA-31. NC1244.2 +226600 MOVE ZERO TO WORK-AREA-31A. NC1244.2 +226700 MOVE SPACE TO WORK-AREA-31B. NC1244.2 +226800 PICTURE-TEST-31. NC1244.2 +226900 MOVE WORK-AREA-31 TO WORK-AREA-31A. NC1244.2 +227000 MOVE WORK-AREA-31A TO WORK-AREA-31B. NC1244.2 +227100 IF WORK-AREA-31B EQUAL TO " 12 " NC1244.2 +227200 PERFORM PASS NC1244.2 +227300 ELSE GO TO PICTURE-FAIL-31. NC1244.2 +227400 GO TO PICTURE-WRITE-31. NC1244.2 +227500 PICTURE-DELETE-31. NC1244.2 +227600 PERFORM DE-LETE. NC1244.2 +227700 GO TO PICTURE-WRITE-31. NC1244.2 +227800 PICTURE-FAIL-31. NC1244.2 +227900 PERFORM FAIL. NC1244.2 +228000 MOVE WORK-AREA-31B TO COMPUTED-A. NC1244.2 +228100 MOVE " 12 " TO CORRECT-A. NC1244.2 +228200 PICTURE-WRITE-31. NC1244.2 +228300 MOVE "PICTURE-TEST-31" TO PAR-NAME. NC1244.2 +228400 PERFORM PRINT-DETAIL. NC1244.2 +228500 PICTURE-INIT-32. NC1244.2 +228600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +228700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +228800 MOVE .001 TO WORK-AREA-32. NC1244.2 +228900 MOVE ZERO TO WORK-AREA-32A. NC1244.2 +229000 PICTURE-TEST-32-0. NC1244.2 +229100 MOVE WORK-AREA-32 TO WORK-AREA-32A. NC1244.2 +229200 PICTURE-TEST-32-1. NC1244.2 +229300 IF WORK-AREA-32A EQUAL TO .001 NC1244.2 +229400 PERFORM PASS NC1244.2 +229500 ELSE GO TO PICTURE-FAIL-32. NC1244.2 +229600 GO TO PICTURE-WRITE-32. NC1244.2 +229700 PICTURE-DELETE-32. NC1244.2 +229800 PERFORM DE-LETE. NC1244.2 +229900 GO TO PICTURE-WRITE-32. NC1244.2 +230000 PICTURE-FAIL-32. NC1244.2 +230100 PERFORM FAIL. NC1244.2 +230200 MOVE WORK-AREA-32A TO COMPUTED-0V18. NC1244.2 +230300 MOVE .001 TO CORRECT-0V18. NC1244.2 +230400 PICTURE-WRITE-32. NC1244.2 +230500 MOVE "PICTURE-TEST-32" TO PAR-NAME. NC1244.2 +230600 PERFORM PRINT-DETAIL. NC1244.2 +230700 PICTURE-INIT-33. NC1244.2 +230800 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +230900 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +231000 MOVE .567 TO WORK-AREA-33. NC1244.2 +231100 MOVE ZERO TO WORK-AREA-33A. NC1244.2 +231200 PICTURE-TEST-33-0. NC1244.2 +231300 MOVE WORK-AREA-33 TO WORK-AREA-33A. NC1244.2 +231400 PICTURE-TEST-33-1. NC1244.2 +231500 IF WORK-AREA-33A EQUAL TO .007 NC1244.2 +231600 PERFORM PASS NC1244.2 +231700 ELSE GO TO PICTURE-FAIL-33. NC1244.2 +231800 GO TO PICTURE-WRITE-33. NC1244.2 +231900 PICTURE-DELETE-33. NC1244.2 +232000 PERFORM DE-LETE. NC1244.2 +232100 GO TO PICTURE-WRITE-33. NC1244.2 +232200 PICTURE-FAIL-33. NC1244.2 +232300 PERFORM FAIL. NC1244.2 +232400 MOVE WORK-AREA-33A TO COMPUTED-0V18. NC1244.2 +232500 MOVE .007 TO CORRECT-0V18. NC1244.2 +232600 PICTURE-WRITE-33. NC1244.2 +232700 MOVE "PICTURE-TEST-33" TO PAR-NAME. NC1244.2 +232800 PERFORM PRINT-DETAIL. NC1244.2 +232900 PICTURE-INIT-34. NC1244.2 +233000 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +233100 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +233200 MOVE .123 TO WORK-AREA-34. NC1244.2 +233300 MOVE ZERO TO WORK-AREA-34A. NC1244.2 +233400 MOVE ZERO TO WORK-AREA-34B. NC1244.2 +233500 PICTURE-TEST-34. NC1244.2 +233600 MOVE WORK-AREA-34 TO WORK-AREA-34A. NC1244.2 +233700 MOVE WORK-AREA-34A TO WORK-AREA-34B. NC1244.2 +233800 IF WORK-AREA-34B EQUAL TO .003 NC1244.2 +233900 PERFORM PASS NC1244.2 +234000 ELSE GO TO PICTURE-FAIL-34. NC1244.2 +234100 GO TO PICTURE-WRITE-34. NC1244.2 +234200 PICTURE-DELETE-34. NC1244.2 +234300 PERFORM DE-LETE. NC1244.2 +234400 GO TO PICTURE-WRITE-34. NC1244.2 +234500 PICTURE-FAIL-34. NC1244.2 +234600 PERFORM FAIL. NC1244.2 +234700 MOVE WORK-AREA-34B TO COMPUTED-0V18. NC1244.2 +234800 MOVE .003 TO CORRECT-0V18. NC1244.2 +234900 PICTURE-WRITE-34. NC1244.2 +235000 MOVE "PICTURE-TEST-34" TO PAR-NAME. NC1244.2 +235100 PERFORM PRINT-DETAIL. NC1244.2 +235200 CCVS-EXIT SECTION. NC1244.2 +235300 CCVS-999999. NC1244.2 +235400 GO TO CLOSE-FILES. NC1244.2 +*END-OF,NC124A +*HEADER,COBOL,NC125A +000100 IDENTIFICATION DIVISION. NC1254.2 +000200 PROGRAM-ID. NC1254.2 +000300 NC125A. NC1254.2 +000400**************************************************************** NC1254.2 +000500* * NC1254.2 +000600* VALIDATION FOR:- * NC1254.2 +000700* * NC1254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +000900* * NC1254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1254.2 +001100* * NC1254.2 +001200**************************************************************** NC1254.2 +001300* * NC1254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1254.2 +001500* * NC1254.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1254.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1254.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1254.2 +001900* * NC1254.2 +002000**************************************************************** NC1254.2 +002100* NC1254.2 +002200* PROGRAM NC125A TESTS THE USE OF PICTURE CHARACTERS NC1254.2 +002300* $ + * . , WITH FORMAT 1 OF THE "MOVE" STATEMENT AND NC1254.2 +002400* FORMAT 2 OF THE "ADD" AND "SUBTRACT" STATEMENTS. NC1254.2 +002500* NC1254.2 +002600 ENVIRONMENT DIVISION. NC1254.2 +002700 CONFIGURATION SECTION. NC1254.2 +002800 SOURCE-COMPUTER. NC1254.2 +002900 XXXXX082. NC1254.2 +003000 OBJECT-COMPUTER. NC1254.2 +003100 XXXXX083. NC1254.2 +003200 INPUT-OUTPUT SECTION. NC1254.2 +003300 FILE-CONTROL. NC1254.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1254.2 +003500 XXXXX055. NC1254.2 +003600 DATA DIVISION. NC1254.2 +003700 FILE SECTION. NC1254.2 +003800 FD PRINT-FILE. NC1254.2 +003900 01 PRINT-REC PICTURE X(120). NC1254.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1254.2 +004100 WORKING-STORAGE SECTION. NC1254.2 +004200 01 W1. NC1254.2 +004300 02 WRK-EDIT-001 PIC $$,$$$,$$$,$$$,$$$,$$$.99. NC1254.2 +004400 01 W2. NC1254.2 +004500 02 WRK-EDIT-002 PIC ++,+++,+++,+++,+++,+++.99. NC1254.2 +004600 01 W3. NC1254.2 +004700 02 WRK-EDIT-003 PIC --,---,---,---,---,---.99. NC1254.2 +004800 01 W4. NC1254.2 +004900 02 WRK-EDIT-004 PIC *,***,***,***,***,***.99. NC1254.2 +005000 01 W5. NC1254.2 +005100 02 WRK-EDIT-005 PIC 9,9,9,9,9,9,9,9,9,9,9,9,. NC1254.2 +005200 01 W6. NC1254.2 +005300 02 WRK-EDIT-006 PIC 999999999999.. NC1254.2 +005400 01 TBL-001. NC1254.2 +005500 02 FILLER PIC S9(16)V99 VALUE ZERO. NC1254.2 +005600 02 FILLER PIC S9(16)V99 VALUE .01. NC1254.2 +005700 02 FILLER PIC S9(16)V99 VALUE .19. NC1254.2 +005800 02 FILLER PIC S9(16)V99 VALUE 1.00. NC1254.2 +005900 02 FILLER PIC S9(16)V99 VALUE 111.11. NC1254.2 +006000 02 FILLER PIC S9(16)V99 VALUE 9999.11. NC1254.2 +006100 02 FILLER PIC S9(16)V99 VALUE 1010101.99. NC1254.2 +006200 02 FILLER PIC S9(16)V99 VALUE 900000000.11. NC1254.2 +006300 02 FILLER PIC S9(16)V99 VALUE 9999999999.99. NC1254.2 +006400 01 TBL-001-R REDEFINES TBL-001. NC1254.2 +006500 02 TBL-001-O PIC S9(16)V99 OCCURS 9 TIMES. NC1254.2 +006600 01 TBL-002. NC1254.2 +006700 02 FILLER PIC X(25) VALUE " $.00". NC1254.2 +006800 02 FILLER PIC X(25) VALUE " $.01". NC1254.2 +006900 02 FILLER PIC X(25) VALUE " $.19". NC1254.2 +007000 02 FILLER PIC X(25) VALUE " $1.00". NC1254.2 +007100 02 FILLER PIC X(25) VALUE " $111.11". NC1254.2 +007200 02 FILLER PIC X(25) VALUE " $9,999.11". NC1254.2 +007300 02 FILLER PIC X(25) VALUE " $1,010,101.99". NC1254.2 +007400 02 FILLER PIC X(25) VALUE " $900,000,000.11". NC1254.2 +007500 02 FILLER PIC X(25) VALUE " $9,999,999,999.99". NC1254.2 +007600 01 TBL-002-R REDEFINES TBL-002. NC1254.2 +007700 02 TBL-002-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +007800 01 TBL-003. NC1254.2 +007900 02 FILLER PIC X(25) VALUE " +.00". NC1254.2 +008000 02 FILLER PIC X(25) VALUE " +.01". NC1254.2 +008100 02 FILLER PIC X(25) VALUE " +.19". NC1254.2 +008200 02 FILLER PIC X(25) VALUE " +1.00". NC1254.2 +008300 02 FILLER PIC X(25) VALUE " +111.11". NC1254.2 +008400 02 FILLER PIC X(25) VALUE " +9,999.11". NC1254.2 +008500 02 FILLER PIC X(25) VALUE " +1,010,101.99". NC1254.2 +008600 02 FILLER PIC X(25) VALUE " +900,000,000.11". NC1254.2 +008700 02 FILLER PIC X(25) VALUE " +9,999,999,999.99". NC1254.2 +008800 01 TBL-003-R REDEFINES TBL-003. NC1254.2 +008900 02 TBL-003-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +009000 01 TBL-004. NC1254.2 +009100 02 FILLER PIC X(25) VALUE " .00". NC1254.2 +009200 02 FILLER PIC X(25) VALUE " .01". NC1254.2 +009300 02 FILLER PIC X(25) VALUE " .19". NC1254.2 +009400 02 FILLER PIC X(25) VALUE " 1.00". NC1254.2 +009500 02 FILLER PIC X(25) VALUE " 111.11". NC1254.2 +009600 02 FILLER PIC X(25) VALUE " 9,999.11". NC1254.2 +009700 02 FILLER PIC X(25) VALUE " 1,010,101.99". NC1254.2 +009800 02 FILLER PIC X(25) VALUE " 900,000,000.11". NC1254.2 +009900 02 FILLER PIC X(25) VALUE " 9,999,999,999.99". NC1254.2 +010000 01 TBL-004-R REDEFINES TBL-004. NC1254.2 +010100 02 TBL-004-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +010200 01 TBL-005. NC1254.2 +010300 02 FILLER PIC X(24) VALUE "*********************.00". NC1254.2 +010400 02 FILLER PIC X(24) VALUE "*********************.01". NC1254.2 +010500 02 FILLER PIC X(24) VALUE "*********************.19". NC1254.2 +010600 02 FILLER PIC X(24) VALUE "********************1.00". NC1254.2 +010700 02 FILLER PIC X(24) VALUE "******************111.11". NC1254.2 +010800 02 FILLER PIC X(24) VALUE "****************9,999.11". NC1254.2 +010900 02 FILLER PIC X(24) VALUE "************1,010,101.99". NC1254.2 +011000 02 FILLER PIC X(24) VALUE "**********900,000,000.11". NC1254.2 +011100 02 FILLER PIC X(24) VALUE "********9,999,999,999.99". NC1254.2 +011200 01 TBL-005-R REDEFINES TBL-005. NC1254.2 +011300 02 TBL-005-O PIC X(24) OCCURS 9 TIMES. NC1254.2 +011400 01 TBL-006. NC1254.2 +011500 02 FILLER PIC X(25) VALUE " .00". NC1254.2 +011600 02 FILLER PIC X(25) VALUE " -.01". NC1254.2 +011700 02 FILLER PIC X(25) VALUE " -.19". NC1254.2 +011800 02 FILLER PIC X(25) VALUE " -1.00". NC1254.2 +011900 02 FILLER PIC X(25) VALUE " -111.11". NC1254.2 +012000 02 FILLER PIC X(25) VALUE " -9,999.11". NC1254.2 +012100 02 FILLER PIC X(25) VALUE " -1,010,101.99". NC1254.2 +012200 02 FILLER PIC X(25) VALUE " -900,000,000.11". NC1254.2 +012300 02 FILLER PIC X(25) VALUE " -9,999,999,999.99". NC1254.2 +012400 01 TBL-006-R REDEFINES TBL-006. NC1254.2 +012500 02 TBL-006-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +012600 01 CTR-1 PIC 999 VALUE 0. NC1254.2 +012700 01 CRT-2 PIC 999 VALUE 9. NC1254.2 +012800 01 CTR-3 PIC 999 VALUE 0. NC1254.2 +012900 01 TEST-RESULTS. NC1254.2 +013000 02 FILLER PIC X VALUE SPACE. NC1254.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. NC1254.2 +013200 02 FILLER PIC X VALUE SPACE. NC1254.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. NC1254.2 +013400 02 FILLER PIC X VALUE SPACE. NC1254.2 +013500 02 PAR-NAME. NC1254.2 +013600 03 FILLER PIC X(19) VALUE SPACE. NC1254.2 +013700 03 PARDOT-X PIC X VALUE SPACE. NC1254.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. NC1254.2 +013900 02 FILLER PIC X(8) VALUE SPACE. NC1254.2 +014000 02 RE-MARK PIC X(61). NC1254.2 +014100 01 TEST-COMPUTED. NC1254.2 +014200 02 FILLER PIC X(30) VALUE SPACE. NC1254.2 +014300 02 FILLER PIC X(17) VALUE NC1254.2 +014400 " COMPUTED=". NC1254.2 +014500 02 COMPUTED-X. NC1254.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1254.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A NC1254.2 +014800 PIC -9(9).9(9). NC1254.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1254.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1254.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1254.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. NC1254.2 +015300 04 COMPUTED-18V0 PIC -9(18). NC1254.2 +015400 04 FILLER PIC X. NC1254.2 +015500 03 FILLER PIC X(50) VALUE SPACE. NC1254.2 +015600 01 TEST-CORRECT. NC1254.2 +015700 02 FILLER PIC X(30) VALUE SPACE. NC1254.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1254.2 +015900 02 CORRECT-X. NC1254.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1254.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1254.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1254.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1254.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1254.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. NC1254.2 +016600 04 CORRECT-18V0 PIC -9(18). NC1254.2 +016700 04 FILLER PIC X. NC1254.2 +016800 03 FILLER PIC X(2) VALUE SPACE. NC1254.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1254.2 +017000 01 CCVS-C-1. NC1254.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1254.2 +017200- "SS PARAGRAPH-NAME NC1254.2 +017300- " REMARKS". NC1254.2 +017400 02 FILLER PIC X(20) VALUE SPACE. NC1254.2 +017500 01 CCVS-C-2. NC1254.2 +017600 02 FILLER PIC X VALUE SPACE. NC1254.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". NC1254.2 +017800 02 FILLER PIC X(15) VALUE SPACE. NC1254.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". NC1254.2 +018000 02 FILLER PIC X(94) VALUE SPACE. NC1254.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1254.2 +018200 01 REC-CT PIC 99 VALUE ZERO. NC1254.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1254.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1254.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1254.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1254.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1254.2 +019200 01 CCVS-H-1. NC1254.2 +019300 02 FILLER PIC X(39) VALUE SPACES. NC1254.2 +019400 02 FILLER PIC X(42) VALUE NC1254.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1254.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC1254.2 +019700 01 CCVS-H-2A. NC1254.2 +019800 02 FILLER PIC X(40) VALUE SPACE. NC1254.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1254.2 +020000 02 FILLER PIC XXXX VALUE NC1254.2 +020100 "4.2 ". NC1254.2 +020200 02 FILLER PIC X(28) VALUE NC1254.2 +020300 " COPY - NOT FOR DISTRIBUTION". NC1254.2 +020400 02 FILLER PIC X(41) VALUE SPACE. NC1254.2 +020500 NC1254.2 +020600 01 CCVS-H-2B. NC1254.2 +020700 02 FILLER PIC X(15) VALUE NC1254.2 +020800 "TEST RESULT OF ". NC1254.2 +020900 02 TEST-ID PIC X(9). NC1254.2 +021000 02 FILLER PIC X(4) VALUE NC1254.2 +021100 " IN ". NC1254.2 +021200 02 FILLER PIC X(12) VALUE NC1254.2 +021300 " HIGH ". NC1254.2 +021400 02 FILLER PIC X(22) VALUE NC1254.2 +021500 " LEVEL VALIDATION FOR ". NC1254.2 +021600 02 FILLER PIC X(58) VALUE NC1254.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +021800 01 CCVS-H-3. NC1254.2 +021900 02 FILLER PIC X(34) VALUE NC1254.2 +022000 " FOR OFFICIAL USE ONLY ". NC1254.2 +022100 02 FILLER PIC X(58) VALUE NC1254.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1254.2 +022300 02 FILLER PIC X(28) VALUE NC1254.2 +022400 " COPYRIGHT 1985 ". NC1254.2 +022500 01 CCVS-E-1. NC1254.2 +022600 02 FILLER PIC X(52) VALUE SPACE. NC1254.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1254.2 +022800 02 ID-AGAIN PIC X(9). NC1254.2 +022900 02 FILLER PIC X(45) VALUE SPACES. NC1254.2 +023000 01 CCVS-E-2. NC1254.2 +023100 02 FILLER PIC X(31) VALUE SPACE. NC1254.2 +023200 02 FILLER PIC X(21) VALUE SPACE. NC1254.2 +023300 02 CCVS-E-2-2. NC1254.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1254.2 +023500 03 FILLER PIC X VALUE SPACE. NC1254.2 +023600 03 ENDER-DESC PIC X(44) VALUE NC1254.2 +023700 "ERRORS ENCOUNTERED". NC1254.2 +023800 01 CCVS-E-3. NC1254.2 +023900 02 FILLER PIC X(22) VALUE NC1254.2 +024000 " FOR OFFICIAL USE ONLY". NC1254.2 +024100 02 FILLER PIC X(12) VALUE SPACE. NC1254.2 +024200 02 FILLER PIC X(58) VALUE NC1254.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +024400 02 FILLER PIC X(13) VALUE SPACE. NC1254.2 +024500 02 FILLER PIC X(15) VALUE NC1254.2 +024600 " COPYRIGHT 1985". NC1254.2 +024700 01 CCVS-E-4. NC1254.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1254.2 +024900 02 FILLER PIC X(4) VALUE " OF ". NC1254.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1254.2 +025100 02 FILLER PIC X(40) VALUE NC1254.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1254.2 +025300 01 XXINFO. NC1254.2 +025400 02 FILLER PIC X(19) VALUE NC1254.2 +025500 "*** INFORMATION ***". NC1254.2 +025600 02 INFO-TEXT. NC1254.2 +025700 04 FILLER PIC X(8) VALUE SPACE. NC1254.2 +025800 04 XXCOMPUTED PIC X(20). NC1254.2 +025900 04 FILLER PIC X(5) VALUE SPACE. NC1254.2 +026000 04 XXCORRECT PIC X(20). NC1254.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). NC1254.2 +026200 01 HYPHEN-LINE. NC1254.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. NC1254.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************NC1254.2 +026500- "*****************************************". NC1254.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************NC1254.2 +026700- "******************************". NC1254.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE NC1254.2 +026900 "NC125A". NC1254.2 +027000 PROCEDURE DIVISION. NC1254.2 +027100 CCVS1 SECTION. NC1254.2 +027200 OPEN-FILES. NC1254.2 +027300 OPEN OUTPUT PRINT-FILE. NC1254.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1254.2 +027500 MOVE SPACE TO TEST-RESULTS. NC1254.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1254.2 +027700 GO TO CCVS1-EXIT. NC1254.2 +027800 CLOSE-FILES. NC1254.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1254.2 +028000 TERMINATE-CCVS. NC1254.2 +028100S EXIT PROGRAM. NC1254.2 +028200STERMINATE-CALL. NC1254.2 +028300 STOP RUN. NC1254.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1254.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1254.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1254.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1254.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. NC1254.2 +028900 PRINT-DETAIL. NC1254.2 +029000 IF REC-CT NOT EQUAL TO ZERO NC1254.2 +029100 MOVE "." TO PARDOT-X NC1254.2 +029200 MOVE REC-CT TO DOTVALUE. NC1254.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1254.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1254.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1254.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1254.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1254.2 +029800 MOVE SPACE TO CORRECT-X. NC1254.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1254.2 +030000 MOVE SPACE TO RE-MARK. NC1254.2 +030100 HEAD-ROUTINE. NC1254.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1254.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1254.2 +030600 COLUMN-NAMES-ROUTINE. NC1254.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +031000 END-ROUTINE. NC1254.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1254.2 +031200 END-RTN-EXIT. NC1254.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +031400 END-ROUTINE-1. NC1254.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1254.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1254.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. NC1254.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1254.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1254.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1254.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1254.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1254.2 +032300 END-ROUTINE-12. NC1254.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1254.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1254.2 +032600 MOVE "NO " TO ERROR-TOTAL NC1254.2 +032700 ELSE NC1254.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1254.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1254.2 +033000 PERFORM WRITE-LINE. NC1254.2 +033100 END-ROUTINE-13. NC1254.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1254.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE NC1254.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1254.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1254.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO NC1254.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1254.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1254.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1254.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +034300 WRITE-LINE. NC1254.2 +034400 ADD 1 TO RECORD-COUNT. NC1254.2 +034500Y IF RECORD-COUNT GREATER 42 NC1254.2 +034600Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1254.2 +034700Y MOVE SPACE TO DUMMY-RECORD NC1254.2 +034800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1254.2 +034900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1254.2 +035000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1254.2 +035100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1254.2 +035200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1254.2 +035300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1254.2 +035700Y MOVE ZERO TO RECORD-COUNT. NC1254.2 +035800 PERFORM WRT-LN. NC1254.2 +035900 WRT-LN. NC1254.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1254.2 +036100 MOVE SPACE TO DUMMY-RECORD. NC1254.2 +036200 BLANK-LINE-PRINT. NC1254.2 +036300 PERFORM WRT-LN. NC1254.2 +036400 FAIL-ROUTINE. NC1254.2 +036500 IF COMPUTED-X NOT EQUAL TO SPACE NC1254.2 +036600 GO TO FAIL-ROUTINE-WRITE. NC1254.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1254.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1254.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1254.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1254.2 +037200 GO TO FAIL-ROUTINE-EX. NC1254.2 +037300 FAIL-ROUTINE-WRITE. NC1254.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1254.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1254.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1254.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1254.2 +037800 FAIL-ROUTINE-EX. EXIT. NC1254.2 +037900 BAIL-OUT. NC1254.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1254.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1254.2 +038200 BAIL-OUT-WRITE. NC1254.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1254.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1254.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1254.2 +038700 BAIL-OUT-EX. EXIT. NC1254.2 +038800 CCVS1-EXIT. NC1254.2 +038900 EXIT. NC1254.2 +039000 SECT-NC125A-001 SECTION. NC1254.2 +039100 EDI-TEST-GF1. NC1254.2 +039200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +039300 MOVE "EDI-TEST-GF1" TO PAR-NAME. NC1254.2 +039400 MOVE "l EDIT MOVE" TO FEATURE. NC1254.2 +039500 MOVE 0 TO REC-CT. NC1254.2 +039600 MOVE 0 TO CTR-1. NC1254.2 +039700 MOVE ZERO TO TBL-001-O (1). NC1254.2 +039800 MOVE .01 TO TBL-001-O (2). NC1254.2 +039900 PERFORM EDI-TEST-GF1-R CRT-2 TIMES NC1254.2 +040000 GO TO EDI-TEST-GF1-EXIT. NC1254.2 +040100 EDI-TEST-GF1-DELETE. NC1254.2 +040200 PERFORM DE-LETE. NC1254.2 +040300 PERFORM PRINT-DETAIL. NC1254.2 +040400 GO TO EDI-TEST-GF1-EXIT. NC1254.2 +040500 EDI-TEST-GF1-R. NC1254.2 +040600 ADD 1 TO REC-CT. NC1254.2 +040700 ADD 1 TO CTR-1. NC1254.2 +040800 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-001. NC1254.2 +040900 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +041000 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +041100 CORRECT-X NC1254.2 +041200 PERFORM FAIL. NC1254.2 +041300 PERFORM PRINT-DETAIL. NC1254.2 +041400 EDI-TEST-GF1-EXIT. NC1254.2 +041500 EXIT. NC1254.2 +041600 EDI-TEST-GF2. NC1254.2 +041700 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +041800 MOVE "EDI-TEST-GF2" TO PAR-NAME. NC1254.2 +041900 MOVE "+ EDIT MOVE" TO FEATURE. NC1254.2 +042000 MOVE 0 TO REC-CT. NC1254.2 +042100 MOVE 0 TO CTR-1. NC1254.2 +042200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +042300 MOVE .01 TO TBL-001-O (2). NC1254.2 +042400 PERFORM EDI-TEST-GF2-R CRT-2 TIMES NC1254.2 +042500 GO TO EDI-TEST-GF2-EXIT. NC1254.2 +042600 EDI-TEST-GF2-DELETE. NC1254.2 +042700 PERFORM DE-LETE. NC1254.2 +042800 PERFORM PRINT-DETAIL. NC1254.2 +042900 GO TO EDI-TEST-GF2-EXIT. NC1254.2 +043000 EDI-TEST-GF2-R. NC1254.2 +043100 ADD 1 TO REC-CT. NC1254.2 +043200 ADD 1 TO CTR-1. NC1254.2 +043300 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-002. NC1254.2 +043400 IF WRK-EDIT-002 EQUAL TO TBL-003-O (CTR-1) PERFORM PASS NC1254.2 +043500 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-003-O (CTR-1) TO NC1254.2 +043600 CORRECT-X NC1254.2 +043700 PERFORM FAIL. NC1254.2 +043800 PERFORM PRINT-DETAIL. NC1254.2 +043900 EDI-TEST-GF2-EXIT. NC1254.2 +044000 EXIT. NC1254.2 +044100 EDI-TEST-GF3. NC1254.2 +044200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +044300 MOVE "EDI-TEST-GF3" TO PAR-NAME. NC1254.2 +044400 MOVE "- EDIT MOVE" TO FEATURE. NC1254.2 +044500 MOVE 0 TO REC-CT. NC1254.2 +044600 MOVE 0 TO CTR-1. NC1254.2 +044700 MOVE ZERO TO TBL-001-O (1). NC1254.2 +044800 MOVE .01 TO TBL-001-O (2). NC1254.2 +044900 PERFORM EDI-TEST-GF3-R CRT-2 TIMES NC1254.2 +045000 GO TO EDI-TEST-GF3-EXIT. NC1254.2 +045100 EDI-TEST-GF3-DELETE. NC1254.2 +045200 PERFORM DE-LETE. NC1254.2 +045300 PERFORM PRINT-DETAIL. NC1254.2 +045400 GO TO EDI-TEST-GF3-EXIT. NC1254.2 +045500 EDI-TEST-GF3-R. NC1254.2 +045600 ADD 1 TO REC-CT. NC1254.2 +045700 ADD 1 TO CTR-1. NC1254.2 +045800 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-003. NC1254.2 +045900 IF WRK-EDIT-003 EQUAL TO TBL-004-O (CTR-1) PERFORM PASS NC1254.2 +046000 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-004-O (CTR-1) TO NC1254.2 +046100 CORRECT-X NC1254.2 +046200 PERFORM FAIL. NC1254.2 +046300 PERFORM PRINT-DETAIL. NC1254.2 +046400 EDI-TEST-GF3-EXIT. NC1254.2 +046500 EXIT. NC1254.2 +046600 EDI-TEST-GF4. NC1254.2 +046700 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +046800 MOVE "EDI-TEST-GF4" TO PAR-NAME. NC1254.2 +046900 MOVE "* EDIT MOVE" TO FEATURE. NC1254.2 +047000 MOVE 0 TO REC-CT. NC1254.2 +047100 MOVE 0 TO CTR-1. NC1254.2 +047200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +047300 MOVE .01 TO TBL-001-O (2). NC1254.2 +047400 PERFORM EDI-TEST-GF4-R CRT-2 TIMES NC1254.2 +047500 GO TO EDI-TEST-GF4-EXIT. NC1254.2 +047600 EDI-TEST-GF4-DELETE. NC1254.2 +047700 PERFORM DE-LETE. NC1254.2 +047800 PERFORM PRINT-DETAIL. NC1254.2 +047900 GO TO EDI-TEST-GF4-EXIT. NC1254.2 +048000 EDI-TEST-GF4-R. NC1254.2 +048100 ADD 1 TO REC-CT. NC1254.2 +048200 ADD 1 TO CTR-1. NC1254.2 +048300 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-004. NC1254.2 +048400 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +048500 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +048600 CORRECT-X NC1254.2 +048700 PERFORM FAIL. NC1254.2 +048800 PERFORM PRINT-DETAIL. NC1254.2 +048900 EDI-TEST-GF4-EXIT. NC1254.2 +049000 EXIT. NC1254.2 +049100 EDI-TEST-GF5. NC1254.2 +049200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +049300 MOVE "EDI-TEST-GF5" TO PAR-NAME. NC1254.2 +049400 MOVE "l EDIT ADD" TO FEATURE. NC1254.2 +049500 MOVE 0 TO CTR-1. NC1254.2 +049600 MOVE 0 TO CTR-3. NC1254.2 +049700 MOVE 0 TO REC-CT. NC1254.2 +049800 MOVE ZERO TO TBL-001-O (1). NC1254.2 +049900 MOVE .01 TO TBL-001-O (2). NC1254.2 +050000 PERFORM EDI-TEST-GF5-R CRT-2 TIMES NC1254.2 +050100 GO TO EDI-TEST-GF5-EXIT. NC1254.2 +050200 EDI-TEST-GF5-DELETE. NC1254.2 +050300 PERFORM DE-LETE. NC1254.2 +050400 PERFORM PRINT-DETAIL. NC1254.2 +050500 GO TO EDI-TEST-GF5-EXIT. NC1254.2 +050600 EDI-TEST-GF5-R. NC1254.2 +050700 ADD 1 TO REC-CT. NC1254.2 +050800 ADD 1 TO CTR-1. NC1254.2 +050900 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-001. NC1254.2 +051000 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +051100 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +051200 CORRECT-X NC1254.2 +051300 PERFORM FAIL. NC1254.2 +051400 PERFORM PRINT-DETAIL. NC1254.2 +051500 EDI-TEST-GF5-EXIT. NC1254.2 +051600 EXIT. NC1254.2 +051700 EDI-TEST-GF6. NC1254.2 +051800 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +051900 MOVE "EDI-TEST-GF6" TO PAR-NAME. NC1254.2 +052000 MOVE "+ EDIT ADD" TO FEATURE. NC1254.2 +052100 MOVE 0 TO CTR-1. NC1254.2 +052200 MOVE 0 TO CTR-3. NC1254.2 +052300 MOVE 0 TO REC-CT. NC1254.2 +052400 MOVE ZERO TO TBL-001-O (1). NC1254.2 +052500 MOVE .01 TO TBL-001-O (2). NC1254.2 +052600 PERFORM EDI-TEST-GF6-R CRT-2 TIMES NC1254.2 +052700 GO TO EDI-TEST-GF6-EXIT. NC1254.2 +052800 EDI-TEST-GF6-DELETE. NC1254.2 +052900 PERFORM DE-LETE. NC1254.2 +053000 PERFORM PRINT-DETAIL. NC1254.2 +053100 GO TO EDI-TEST-GF6-EXIT. NC1254.2 +053200 EDI-TEST-GF6-R. NC1254.2 +053300 ADD 1 TO REC-CT. NC1254.2 +053400 ADD 1 TO CTR-1. NC1254.2 +053500 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-002. NC1254.2 +053600 IF WRK-EDIT-002 EQUAL TO TBL-003-O (CTR-1) PERFORM PASS NC1254.2 +053700 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-003-O (CTR-1) TO NC1254.2 +053800 CORRECT-X NC1254.2 +053900 PERFORM FAIL. NC1254.2 +054000 PERFORM PRINT-DETAIL. NC1254.2 +054100 EDI-TEST-GF6-EXIT. NC1254.2 +054200 EXIT. NC1254.2 +054300 EDI-TEST-GF7. NC1254.2 +054400 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +054500 MOVE "EDI-TEST-GF7" TO PAR-NAME. NC1254.2 +054600 MOVE "- EDIT ADD" TO FEATURE. NC1254.2 +054700 MOVE 0 TO CTR-1. NC1254.2 +054800 MOVE 0 TO CTR-3. NC1254.2 +054900 MOVE 0 TO REC-CT. NC1254.2 +055000 MOVE ZERO TO TBL-001-O (1). NC1254.2 +055100 MOVE .01 TO TBL-001-O (2). NC1254.2 +055200 PERFORM EDI-TEST-GF7-R CRT-2 TIMES NC1254.2 +055300 GO TO EDI-TEST-GF7-EXIT. NC1254.2 +055400 EDI-TEST-GF7-DELETE. NC1254.2 +055500 PERFORM DE-LETE. NC1254.2 +055600 PERFORM PRINT-DETAIL. NC1254.2 +055700 GO TO EDI-TEST-GF7-EXIT. NC1254.2 +055800 EDI-TEST-GF7-R. NC1254.2 +055900 ADD 1 TO REC-CT. NC1254.2 +056000 ADD 1 TO CTR-1. NC1254.2 +056100 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-003. NC1254.2 +056200 IF WRK-EDIT-003 EQUAL TO TBL-004-O (CTR-1) PERFORM PASS NC1254.2 +056300 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-004-O (CTR-1) TO NC1254.2 +056400 CORRECT-X NC1254.2 +056500 PERFORM FAIL. NC1254.2 +056600 PERFORM PRINT-DETAIL. NC1254.2 +056700 EDI-TEST-GF7-EXIT. NC1254.2 +056800 EXIT. NC1254.2 +056900 EDI-TEST-GF8. NC1254.2 +057000 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +057100 MOVE "EDI-TEST-GF8" TO PAR-NAME. NC1254.2 +057200 MOVE "* EDIT ADD" TO FEATURE. NC1254.2 +057300 MOVE 0 TO CTR-1. NC1254.2 +057400 MOVE 0 TO CTR-3. NC1254.2 +057500 MOVE 0 TO REC-CT. NC1254.2 +057600 MOVE ZERO TO TBL-001-O (1). NC1254.2 +057700 MOVE .01 TO TBL-001-O (2). NC1254.2 +057800 PERFORM EDI-TEST-GF8-R CRT-2 TIMES NC1254.2 +057900 GO TO EDI-TEST-GF8-EXIT. NC1254.2 +058000 EDI-TEST-GF8-DELETE. NC1254.2 +058100 PERFORM DE-LETE. NC1254.2 +058200 PERFORM PRINT-DETAIL. NC1254.2 +058300 GO TO EDI-TEST-GF8-EXIT. NC1254.2 +058400 EDI-TEST-GF8-R. NC1254.2 +058500 ADD 1 TO REC-CT. NC1254.2 +058600 ADD 1 TO CTR-1. NC1254.2 +058700 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-004. NC1254.2 +058800 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +058900 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +059000 CORRECT-X NC1254.2 +059100 PERFORM FAIL. NC1254.2 +059200 PERFORM PRINT-DETAIL. NC1254.2 +059300 EDI-TEST-GF8-EXIT. NC1254.2 +059400 EXIT. NC1254.2 +059500 EDI-TEST-GF9. NC1254.2 +059600 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +059700 MOVE "EDI-TEST-GF9" TO PAR-NAME. NC1254.2 +059800 MOVE "l EDIT SUB" TO FEATURE. NC1254.2 +059900 MOVE 0 TO CTR-1. NC1254.2 +060000 MOVE 0 TO CTR-3. NC1254.2 +060100 MOVE 0 TO REC-CT. NC1254.2 +060200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +060300 MOVE .01 TO TBL-001-O (2). NC1254.2 +060400 PERFORM EDI-TEST-GF9-R CRT-2 TIMES NC1254.2 +060500 GO TO EDI-TEST-GF9-EXIT. NC1254.2 +060600 EDI-TEST-GF9-DELETE. NC1254.2 +060700 PERFORM DE-LETE. NC1254.2 +060800 PERFORM PRINT-DETAIL. NC1254.2 +060900 GO TO EDI-TEST-GF9-EXIT. NC1254.2 +061000 EDI-TEST-GF9-R. NC1254.2 +061100 ADD 1 TO REC-CT. NC1254.2 +061200 ADD 1 TO CTR-1. NC1254.2 +061300 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-001. NC1254.2 +061400 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +061500 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +061600 CORRECT-X NC1254.2 +061700 PERFORM FAIL. NC1254.2 +061800 PERFORM PRINT-DETAIL. NC1254.2 +061900 EDI-TEST-GF9-EXIT. NC1254.2 +062000 EXIT. NC1254.2 +062100 EDI-TEST-GF10. NC1254.2 +062200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +062300 MOVE "EDI-TEST-GF10" TO PAR-NAME. NC1254.2 +062400 MOVE "+ EDIT SUB" TO FEATURE. NC1254.2 +062500 MOVE 0 TO CTR-1. NC1254.2 +062600 MOVE 0 TO CTR-3. NC1254.2 +062700 MOVE 0 TO REC-CT. NC1254.2 +062800 MOVE ZERO TO TBL-001-O (1). NC1254.2 +062900 MOVE .01 TO TBL-001-O (2). NC1254.2 +063000 MOVE " +.00" TO TBL-006-O (1). NC1254.2 +063100 PERFORM EDI-TEST-GF10-R CRT-2 TIMES NC1254.2 +063200 GO TO EDI-TEST-GF10-EXIT. NC1254.2 +063300 EDI-TEST-GF10-DELETE. NC1254.2 +063400 PERFORM DE-LETE. NC1254.2 +063500 PERFORM PRINT-DETAIL. NC1254.2 +063600 GO TO EDI-TEST-GF10-EXIT. NC1254.2 +063700 EDI-TEST-GF10-R. NC1254.2 +063800 ADD 1 TO REC-CT. NC1254.2 +063900 ADD 1 TO CTR-1. NC1254.2 +064000 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-002. NC1254.2 +064100 IF WRK-EDIT-002 EQUAL TO TBL-006-O (CTR-1) PERFORM PASS NC1254.2 +064200 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-006-O (CTR-1) TO NC1254.2 +064300 CORRECT-X NC1254.2 +064400 PERFORM FAIL. NC1254.2 +064500 PERFORM PRINT-DETAIL. NC1254.2 +064600 EDI-TEST-GF10-EXIT. NC1254.2 +064700 EXIT. NC1254.2 +064800 EDI-TEST-GF11. NC1254.2 +064900 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +065000 MOVE "EDI-TEST-GF11" TO PAR-NAME. NC1254.2 +065100 MOVE "- EDIT SUB" TO FEATURE. NC1254.2 +065200 MOVE 0 TO CTR-1. NC1254.2 +065300 MOVE 0 TO CTR-3. NC1254.2 +065400 MOVE 0 TO REC-CT. NC1254.2 +065500 MOVE ZERO TO TBL-001-O (1). NC1254.2 +065600 MOVE .01 TO TBL-001-O (2). NC1254.2 +065700 MOVE " .00" TO TBL-006-O (1). NC1254.2 +065800 PERFORM EDI-TEST-GF11-R CRT-2 TIMES NC1254.2 +065900 GO TO EDI-TEST-GF11-EXIT. NC1254.2 +066000 EDI-TEST-GF11-DELETE. NC1254.2 +066100 PERFORM DE-LETE. NC1254.2 +066200 PERFORM PRINT-DETAIL. NC1254.2 +066300 GO TO EDI-TEST-GF11-EXIT. NC1254.2 +066400 EDI-TEST-GF11-R. NC1254.2 +066500 ADD 1 TO REC-CT. NC1254.2 +066600 ADD 1 TO CTR-1. NC1254.2 +066700 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-003. NC1254.2 +066800 IF WRK-EDIT-003 EQUAL TO TBL-006-O (CTR-1) PERFORM PASS NC1254.2 +066900 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-006-O (CTR-1) TO NC1254.2 +067000 CORRECT-X NC1254.2 +067100 PERFORM FAIL. NC1254.2 +067200 PERFORM PRINT-DETAIL. NC1254.2 +067300 EDI-TEST-GF11-EXIT. NC1254.2 +067400 EXIT. NC1254.2 +067500 EDI-TEST-GF12. NC1254.2 +067600 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +067700 MOVE "EDI-TEST-GF12" TO PAR-NAME. NC1254.2 +067800 MOVE "* EDIT SUB" TO FEATURE. NC1254.2 +067900 MOVE 0 TO CTR-1. NC1254.2 +068000 MOVE 0 TO CTR-3. NC1254.2 +068100 MOVE 0 TO REC-CT. NC1254.2 +068200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +068300 MOVE .01 TO TBL-001-O (2). NC1254.2 +068400 PERFORM EDI-TEST-GF12-R CRT-2 TIMES NC1254.2 +068500 GO TO EDI-TEST-GF12-EXIT. NC1254.2 +068600 EDI-TEST-GF12-DELETE. NC1254.2 +068700 PERFORM DE-LETE. NC1254.2 +068800 PERFORM PRINT-DETAIL. NC1254.2 +068900 GO TO EDI-TEST-GF12-EXIT. NC1254.2 +069000 EDI-TEST-GF12-R. NC1254.2 +069100 ADD 1 TO REC-CT. NC1254.2 +069200 ADD 1 TO CTR-1. NC1254.2 +069300 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-004. NC1254.2 +069400 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +069500 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +069600 CORRECT-X NC1254.2 +069700 PERFORM FAIL. NC1254.2 +069800 PERFORM PRINT-DETAIL. NC1254.2 +069900 EDI-TEST-GF12-EXIT. NC1254.2 +070000 EXIT. NC1254.2 +070100* NC1254.2 +070200 EDI-INIT-GF-13. NC1254.2 +070300 MOVE "VI-33 5.9.5 (4), (5)" TO ANSI-REFERENCE. NC1254.2 +070400 MOVE "EDI-TEST-GF-13" TO PAR-NAME. NC1254.2 +070500 MOVE "COMMA AS LAST SYMBOL" TO FEATURE. NC1254.2 +070600 EDI-TEST-GF-13-0. NC1254.2 +070700 MOVE 123456789012 TO WRK-EDIT-005. NC1254.2 +070800 EDI-TEST-GF-13-1. NC1254.2 +070900 IF WRK-EDIT-005 = "1,2,3,4,5,6,7,8,9,0,1,2," NC1254.2 +071000 PERFORM PASS NC1254.2 +071100 ELSE NC1254.2 +071200 GO TO EDI-FAIL-GF-13. NC1254.2 +071300 GO TO EDI-WRITE-GF-13. NC1254.2 +071400 EDI-DELETE-GF-13. NC1254.2 +071500 PERFORM DE-LETE. NC1254.2 +071600 PERFORM PRINT-DETAIL. NC1254.2 +071700 GO TO EDI-INIT-GF-14. NC1254.2 +071800 EDI-FAIL-GF-13. NC1254.2 +071900 MOVE "1,2,3,4,5,6,7,8,9,0,1,2," TO CORRECT-X. NC1254.2 +072000 MOVE W5 TO COMPUTED-X. NC1254.2 +072100 PERFORM FAIL. NC1254.2 +072200 EDI-WRITE-GF-13. NC1254.2 +072300 PERFORM PRINT-DETAIL. NC1254.2 +072400* NC1254.2 +072500 EDI-INIT-GF-14. NC1254.2 +072600 MOVE "VI-34 5.9.5 (4), (5)" TO ANSI-REFERENCE. NC1254.2 +072700 MOVE "EDI-TEST-GF-14" TO PAR-NAME. NC1254.2 +072800 MOVE "PERIOD LAST SYMBOL" TO FEATURE. NC1254.2 +072900 EDI-TEST-GF-14-0. NC1254.2 +073000 MOVE 123456789012 TO WRK-EDIT-006. NC1254.2 +073100 EDI-TEST-GF-14-1. NC1254.2 +073200 IF WRK-EDIT-006 = "123456789012." NC1254.2 +073300 PERFORM PASS NC1254.2 +073400 ELSE NC1254.2 +073500 GO TO EDI-FAIL-GF-14. NC1254.2 +073600 GO TO EDI-WRITE-GF-14. NC1254.2 +073700 EDI-DELETE-GF-14. NC1254.2 +073800 PERFORM DE-LETE. NC1254.2 +073900 PERFORM PRINT-DETAIL. NC1254.2 +074000 GO TO EDI-INIT-GF-14. NC1254.2 +074100 EDI-FAIL-GF-14. NC1254.2 +074200 MOVE "123456789012." TO CORRECT-X. NC1254.2 +074300 MOVE W6 TO COMPUTED-X. NC1254.2 +074400 PERFORM FAIL. NC1254.2 +074500 EDI-WRITE-GF-14. NC1254.2 +074600 PERFORM PRINT-DETAIL. NC1254.2 +074700* NC1254.2 +074800 CCVS-EXIT SECTION. NC1254.2 +074900 CCVS-999999. NC1254.2 +075000 GO TO CLOSE-FILES. NC1254.2 +*END-OF,NC125A +*HEADER,COBOL,NC126A +000100 IDENTIFICATION DIVISION. NC1264.2 +000200 PROGRAM-ID. NC1264.2 +000300 NC126A. NC1264.2 +000400**************************************************************** NC1264.2 +000500* * NC1264.2 +000600* VALIDATION FOR:- * NC1264.2 +000700* * NC1264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +000900* * NC1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1264.2 +001100* * NC1264.2 +001200**************************************************************** NC1264.2 +001300* * NC1264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1264.2 +001500* * NC1264.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1264.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1264.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1264.2 +001900* * NC1264.2 +002000**************************************************************** NC1264.2 +002100* NC1264.2 +002200* PROGRAM NC126A TESTS THE USE OF LEVEL NUMBERS 01 THROUGH 49 NC1264.2 +002300* INCLUSIVE WITH A VARIETY OF PICTURE CLAUSES AND GROUP AND NC1264.2 +002400* ELEMENTARY COMPARISONS. NC1264.2 +002500* NC1264.2 +002600 ENVIRONMENT DIVISION. NC1264.2 +002700 CONFIGURATION SECTION. NC1264.2 +002800 SOURCE-COMPUTER. NC1264.2 +002900 XXXXX082. NC1264.2 +003000 OBJECT-COMPUTER. NC1264.2 +003100 XXXXX083. NC1264.2 +003200 INPUT-OUTPUT SECTION. NC1264.2 +003300 FILE-CONTROL. NC1264.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1264.2 +003500 XXXXX055. NC1264.2 +003600 DATA DIVISION. NC1264.2 +003700 FILE SECTION. NC1264.2 +003800 FD PRINT-FILE. NC1264.2 +003900 01 PRINT-REC PICTURE X(120). NC1264.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1264.2 +004100 WORKING-STORAGE SECTION. NC1264.2 +004200 01 TEST-GROUP-1. NC1264.2 +004300 02 GP-1 PICTURE ZZZ999. NC1264.2 +004400 02 GPLEVEL-1. NC1264.2 +004500 03 GP-2 PICTURE 9(9).99. NC1264.2 +004600 03 GPLEVEL-2. NC1264.2 +004700 04 GP-3 PICTURE 0009(9). NC1264.2 +004800 04 GPLEVEL-3. NC1264.2 +004900 05 GP-4 PICTURE ZBZBZ9. NC1264.2 +005000 05 GPLEVEL-4. NC1264.2 +005100 06 GP-5 PICTURE $$$,$99.99. NC1264.2 +005200 06 GPLEVEL-5. NC1264.2 +005300 07 GP-6 PICTURE ******99. NC1264.2 +005400 07 GPLEVEL-6. NC1264.2 +005500 08 GP-7 PICTURE +999,999. NC1264.2 +005600 08 GPLEVEL-7. NC1264.2 +005700 09 GP-8 PICTURE X(14). NC1264.2 +005800 09 GPLEVEL-8. NC1264.2 +005900 10 GP-9 PICTURE XBXBXBX. NC1264.2 +006000 10 GPLEVEL-9. NC1264.2 +006100 11 GP-10 PICTURE 9090900. NC1264.2 +006200 11 GPLEVEL-10. NC1264.2 +006300 12 GP-11 PICTURE $999,999.00. NC1264.2 +006400 12 GPLEVEL-11. NC1264.2 +006500 13 GP-12 PICTURE ZZZ.9. NC1264.2 +006600 13 GPLEVEL-12. NC1264.2 +006700 14 GP-13 PICTURE ZZ9B900. NC1264.2 +006800 14 GPLEVEL-13. NC1264.2 +006900 15 GP-14 PICTURE XXXX. NC1264.2 +007000 15 GPLEVEL-14. NC1264.2 +007100 16 GP-15 PICTURE 9(10). NC1264.2 +007200 16 GPLEVEL-15. NC1264.2 +007300 17 GP-16 PICTURE Z(11). NC1264.2 +007400 17 GPLEVEL-16. NC1264.2 +007500 18 GP-17 PICTURE 99BB909. NC1264.2 +007600 18 GPLEVEL-17. NC1264.2 +007700 19 GP-18 PICTURE -*B*99. NC1264.2 +007800 19 GPLEVEL-18. NC1264.2 +007900 20 GP-19 PICTURE 0009999. NC1264.2 +008000 20 GPLEVEL-19. NC1264.2 +008100 21 GP-20 PICTURE 999DB. NC1264.2 +008200 21 GPLEVEL-20. NC1264.2 +008300 22 GP-21 PICTURE ABABABA. NC1264.2 +008400 22 GPLEVEL-21. NC1264.2 +008500 23 GP-22 PICTURE *999999. NC1264.2 +008600 23 GPLEVEL-22. NC1264.2 +008700 24 GP-23 PICTURE XXXXXA. NC1264.2 +008800 24 GPLEVEL-23. NC1264.2 +008900 25 GP-24 PICTURE $$$,$$$.99. NC1264.2 +009000 25 GPLEVEL-24. NC1264.2 +009100 26 GP-25 PICTURE 9BB9BBB9BBB. NC1264.2 +009200 26 GPLEVEL-25. NC1264.2 +009300 27 GP-26 PICTURE 9990009. NC1264.2 +009400 27 GPLEVEL-26. NC1264.2 +009500 28 GP-27 PICTURE 9,999,999. NC1264.2 +009600 28 GPLEVEL-27. NC1264.2 +009700 29 GP-28 PICTURE 9(7),9. NC1264.2 +009800 29 GPLEVEL-28. NC1264.2 +009900 30 GP-29 PICTURE $***.99. NC1264.2 +010000 30 GPLEVEL-29. NC1264.2 +010100 31 GP-30 PICTURE X(15). NC1264.2 +010200 31 GPLEVEL-30. NC1264.2 +010300 32 GP-31 PICTURE 9(10). NC1264.2 +010400 32 GPLEVEL-31. NC1264.2 +010500 33 GP-32 PICTURE *99. NC1264.2 +010600 33 GPLEVEL-32. NC1264.2 +010700 34 GP-33 PICTURE ZZZ9. NC1264.2 +010800 34 GPLEVEL-33. NC1264.2 +010900 35 GP-34 PICTURE BB9BB9. NC1264.2 +011000 35 GPLEVEL-34. NC1264.2 +011100 36 GP-35 PICTURE $99,999.99. NC1264.2 +011200 36 GPLEVEL-35. NC1264.2 +011300 37 GP-36 PICTURE 090909. NC1264.2 +011400 37 GPLEVEL-36. NC1264.2 +011500 38 GP-37 PICTURE ZZZZ. NC1264.2 +011600 38 GPLEVEL-37. NC1264.2 +011700 39 GP-38 PICTURE +99. NC1264.2 +011800 39 GPLEVEL-38. NC1264.2 +011900 40 GP-39 PICTURE -99. NC1264.2 +012000 40 GPLEVEL-39. NC1264.2 +012100 41 GP-40 PICTURE 99CR. NC1264.2 +012200 41 GPLEVEL-40. NC1264.2 +012300 42 GP-41 PICTURE 99DB. NC1264.2 +012400 42 GPLEVEL-41. NC1264.2 +012500 43 GP-42 PICTURE ****. NC1264.2 +012600 43 GPLEVEL-42. NC1264.2 +012700 44 GP-43 PICTURE AAA. NC1264.2 +012800 44 GPLEVEL-43. NC1264.2 +012900 45 GP-44 PICTURE XXX. NC1264.2 +013000 45 GPLEVEL-44. NC1264.2 +013100 46 GP-45 PICTURE *9999. NC1264.2 +013200 46 GPLEVEL-45. NC1264.2 +013300 47 GP-46 PICTURE 9(10).99. NC1264.2 +013400 47 GPLEVEL-46. NC1264.2 +013500 48 GP-47 OCCURS 2 TIMES PICTURE 9. NC1264.2 +013600 48 GPLEVEL-47. NC1264.2 +013700 49 GP-48 OCCURS 2 TIMES PICTURE X. NC1264.2 +013800 01 TABLE-GROUP. NC1264.2 +013900 02 TB-1 PICTURE XX. NC1264.2 +014000 02 TBGRP-1. NC1264.2 +014100 03 TB-2 PICTURE XX. NC1264.2 +014200 03 TBGRP-2. NC1264.2 +014300 04 TB-3 PICTURE XX. NC1264.2 +014400 04 TBGRP-3. NC1264.2 +014500 05 TB-4 PICTURE XX. NC1264.2 +014600 05 TBGRP-4. NC1264.2 +014700 06 TB-5 PICTURE XX. NC1264.2 +014800 06 TBGRP-5. NC1264.2 +014900 07 TB-6 PICTURE XX. NC1264.2 +015000 07 TBGRP-6. NC1264.2 +015100 08 TB-7 PICTURE XX. NC1264.2 +015200 08 TBGRP-7. NC1264.2 +015300 09 TB-8 PICTURE XX. NC1264.2 +015400 09 TBGRP-8. NC1264.2 +015500 10 TB-9 PICTURE XX. NC1264.2 +015600 10 TBGRP-9. NC1264.2 +015700 11 TB-10 PICTURE XX. NC1264.2 +015800 11 TBGRP-10. NC1264.2 +015900 12 TB-11 PICTURE XX. NC1264.2 +016000 12 TBGRP-11. NC1264.2 +016100 13 TB-12 PICTURE XX. NC1264.2 +016200 13 TBGRP-12. NC1264.2 +016300 14 TB-13 PICTURE XX. NC1264.2 +016400 14 TBGRP-13. NC1264.2 +016500 15 TB-14 PICTURE XX. NC1264.2 +016600 15 TBGRP-14. NC1264.2 +016700 16 TB-15 PICTURE XX. NC1264.2 +016800 16 TBGRP-15. NC1264.2 +016900 17 TB-16 PICTURE XX. NC1264.2 +017000 17 TBGRP-16. NC1264.2 +017100 18 TB-17 PICTURE XX. NC1264.2 +017200 18 TBGRP-17. NC1264.2 +017300 19 TB-18 PICTURE XX. NC1264.2 +017400 19 TBGRP-18. NC1264.2 +017500 20 TB-19 PICTURE XX. NC1264.2 +017600 20 TBGRP-19. NC1264.2 +017700 21 TB-20 PICTURE XX. NC1264.2 +017800 21 TBGRP-20. NC1264.2 +017900 22 TB-21 PICTURE XX. NC1264.2 +018000 22 TBGRP-21. NC1264.2 +018100 23 TB-22 PICTURE XX. NC1264.2 +018200 23 TBGRP-22. NC1264.2 +018300 24 TB-23 PICTURE XX. NC1264.2 +018400 24 TBGRP-23. NC1264.2 +018500 25 TB-24 PICTURE XX. NC1264.2 +018600 25 TBGRP-24. NC1264.2 +018700 26 TB-25 PICTURE XX. NC1264.2 +018800 26 TBGRP-25. NC1264.2 +018900 27 TB-26 PICTURE XX. NC1264.2 +019000 27 TBGRP-26. NC1264.2 +019100 28 TB-27 PICTURE XX. NC1264.2 +019200 28 TBGRP-27. NC1264.2 +019300 29 TB-28 PICTURE XX. NC1264.2 +019400 29 TBGRP-28. NC1264.2 +019500 30 TB-29 PICTURE XX. NC1264.2 +019600 30 TBGRP-29. NC1264.2 +019700 31 TB-30 PICTURE XX. NC1264.2 +019800 31 TBGRP-30. NC1264.2 +019900 32 TB-31 PICTURE XX. NC1264.2 +020000 32 TBGRP-31. NC1264.2 +020100 33 TB-32 PICTURE XX. NC1264.2 +020200 33 TBGRP-32. NC1264.2 +020300 34 TB-33 PICTURE XX. NC1264.2 +020400 34 TBGRP-33. NC1264.2 +020500 35 TB-34 PICTURE XX. NC1264.2 +020600 35 TBGRP-34. NC1264.2 +020700 36 TB-35 PICTURE XX. NC1264.2 +020800 36 TBGRP-35. NC1264.2 +020900 37 TB-36 PICTURE XX. NC1264.2 +021000 37 TBGRP-36. NC1264.2 +021100 38 TB-37 PICTURE XX. NC1264.2 +021200 38 TBGRP-37. NC1264.2 +021300 39 TB-38 PICTURE XX. NC1264.2 +021400 39 TBGRP-38. NC1264.2 +021500 40 TB-39 PICTURE XX. NC1264.2 +021600 40 TBGRP-39. NC1264.2 +021700 41 TB-40 PICTURE XX. NC1264.2 +021800 41 TBGRP-40. NC1264.2 +021900 42 TB-41 PICTURE XX. NC1264.2 +022000 42 TBGRP-41. NC1264.2 +022100 43 TB-42 PICTURE XX. NC1264.2 +022200 43 TBGRP-42. NC1264.2 +022300 44 TB-43 PICTURE XX. NC1264.2 +022400 44 TBGRP-43. NC1264.2 +022500 45 TB-44 PICTURE XX. NC1264.2 +022600 45 TBGRP-44. NC1264.2 +022700 46 TB-45 PICTURE XX. NC1264.2 +022800 46 TBGRP-45. NC1264.2 +022900 47 TB-46 PICTURE XX. NC1264.2 +023000 47 TBGRP-46. NC1264.2 +023100 48 TB-47 PICTURE XX. NC1264.2 +023200 48 TBGRP-47. NC1264.2 +023300 49 TB-48 PICTURE XX. NC1264.2 +023400 01 LITERAL-98. NC1264.2 +023500 02 A-PART-98 PICTURE X(20) VALUE "ABCDEFGHIJKLMNOPQRST". NC1264.2 +023600 02 B-PART-98 PICTURE X(20) VALUE "01234567899876543210". NC1264.2 +023700 02 C-PART-98 PICTURE X(20) VALUE "SUPERCALIFRAGILISTIC". NC1264.2 +023800 02 D-PART-98 PICTURE X(20) VALUE "THAT LITERAL WAS BAD". NC1264.2 +023900 02 E-PART-98 PICTURE X(16) VALUE "UP ON THE ROOFS". NC1264.2 +024000 01 BREAKDOWN-RECORD. NC1264.2 +024100 02 LENGTH-COUNTER PICTURE 999 VALUE ZERO. NC1264.2 +024200 02 COMPUTED-BREAKDOWN. NC1264.2 +024300 03 CM-20 PICTURE X(20). NC1264.2 +024400 03 CM-40 PICTURE X(20). NC1264.2 +024500 03 CM-60 PICTURE X(20). NC1264.2 +024600 03 CM-80 PICTURE X(20). NC1264.2 +024700 03 CM-100 PICTURE X(20). NC1264.2 +024800 03 CM-120 PICTURE X(20). NC1264.2 +024900 03 CM-140 PICTURE X(20). NC1264.2 +025000 03 CM-160 PICTURE X(20). NC1264.2 +025100 03 CM-180 PICTURE X(20). NC1264.2 +025200 03 CM-200 PICTURE X(20). NC1264.2 +025300 02 CORRECT-BREAKDOWN. NC1264.2 +025400 03 CR-20 PICTURE X(20). NC1264.2 +025500 03 CR-40 PICTURE X(20). NC1264.2 +025600 03 CR-60 PICTURE X(20). NC1264.2 +025700 03 CR-80 PICTURE X(20). NC1264.2 +025800 03 CR-100 PICTURE X(20). NC1264.2 +025900 03 CR-120 PICTURE X(20). NC1264.2 +026000 03 CR-140 PICTURE X(20). NC1264.2 +026100 03 CR-160 PICTURE X(20). NC1264.2 +026200 03 CR-180 PICTURE X(20). NC1264.2 +026300 03 CR-200 PICTURE X(20). NC1264.2 +026400 01 TEST-RESULTS. NC1264.2 +026500 02 FILLER PIC X VALUE SPACE. NC1264.2 +026600 02 FEATURE PIC X(20) VALUE SPACE. NC1264.2 +026700 02 FILLER PIC X VALUE SPACE. NC1264.2 +026800 02 P-OR-F PIC X(5) VALUE SPACE. NC1264.2 +026900 02 FILLER PIC X VALUE SPACE. NC1264.2 +027000 02 PAR-NAME. NC1264.2 +027100 03 FILLER PIC X(19) VALUE SPACE. NC1264.2 +027200 03 PARDOT-X PIC X VALUE SPACE. NC1264.2 +027300 03 DOTVALUE PIC 99 VALUE ZERO. NC1264.2 +027400 02 FILLER PIC X(8) VALUE SPACE. NC1264.2 +027500 02 RE-MARK PIC X(61). NC1264.2 +027600 01 TEST-COMPUTED. NC1264.2 +027700 02 FILLER PIC X(30) VALUE SPACE. NC1264.2 +027800 02 FILLER PIC X(17) VALUE NC1264.2 +027900 " COMPUTED=". NC1264.2 +028000 02 COMPUTED-X. NC1264.2 +028100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1264.2 +028200 03 COMPUTED-N REDEFINES COMPUTED-A NC1264.2 +028300 PIC -9(9).9(9). NC1264.2 +028400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1264.2 +028500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1264.2 +028600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1264.2 +028700 03 CM-18V0 REDEFINES COMPUTED-A. NC1264.2 +028800 04 COMPUTED-18V0 PIC -9(18). NC1264.2 +028900 04 FILLER PIC X. NC1264.2 +029000 03 FILLER PIC X(50) VALUE SPACE. NC1264.2 +029100 01 TEST-CORRECT. NC1264.2 +029200 02 FILLER PIC X(30) VALUE SPACE. NC1264.2 +029300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1264.2 +029400 02 CORRECT-X. NC1264.2 +029500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1264.2 +029600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1264.2 +029700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1264.2 +029800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1264.2 +029900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1264.2 +030000 03 CR-18V0 REDEFINES CORRECT-A. NC1264.2 +030100 04 CORRECT-18V0 PIC -9(18). NC1264.2 +030200 04 FILLER PIC X. NC1264.2 +030300 03 FILLER PIC X(2) VALUE SPACE. NC1264.2 +030400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1264.2 +030500 01 CCVS-C-1. NC1264.2 +030600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1264.2 +030700- "SS PARAGRAPH-NAME NC1264.2 +030800- " REMARKS". NC1264.2 +030900 02 FILLER PIC X(20) VALUE SPACE. NC1264.2 +031000 01 CCVS-C-2. NC1264.2 +031100 02 FILLER PIC X VALUE SPACE. NC1264.2 +031200 02 FILLER PIC X(6) VALUE "TESTED". NC1264.2 +031300 02 FILLER PIC X(15) VALUE SPACE. NC1264.2 +031400 02 FILLER PIC X(4) VALUE "FAIL". NC1264.2 +031500 02 FILLER PIC X(94) VALUE SPACE. NC1264.2 +031600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1264.2 +031700 01 REC-CT PIC 99 VALUE ZERO. NC1264.2 +031800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1264.2 +031900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1264.2 +032300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1264.2 +032400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1264.2 +032500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1264.2 +032600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1264.2 +032700 01 CCVS-H-1. NC1264.2 +032800 02 FILLER PIC X(39) VALUE SPACES. NC1264.2 +032900 02 FILLER PIC X(42) VALUE NC1264.2 +033000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1264.2 +033100 02 FILLER PIC X(39) VALUE SPACES. NC1264.2 +033200 01 CCVS-H-2A. NC1264.2 +033300 02 FILLER PIC X(40) VALUE SPACE. NC1264.2 +033400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1264.2 +033500 02 FILLER PIC XXXX VALUE NC1264.2 +033600 "4.2 ". NC1264.2 +033700 02 FILLER PIC X(28) VALUE NC1264.2 +033800 " COPY - NOT FOR DISTRIBUTION". NC1264.2 +033900 02 FILLER PIC X(41) VALUE SPACE. NC1264.2 +034000 NC1264.2 +034100 01 CCVS-H-2B. NC1264.2 +034200 02 FILLER PIC X(15) VALUE NC1264.2 +034300 "TEST RESULT OF ". NC1264.2 +034400 02 TEST-ID PIC X(9). NC1264.2 +034500 02 FILLER PIC X(4) VALUE NC1264.2 +034600 " IN ". NC1264.2 +034700 02 FILLER PIC X(12) VALUE NC1264.2 +034800 " HIGH ". NC1264.2 +034900 02 FILLER PIC X(22) VALUE NC1264.2 +035000 " LEVEL VALIDATION FOR ". NC1264.2 +035100 02 FILLER PIC X(58) VALUE NC1264.2 +035200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +035300 01 CCVS-H-3. NC1264.2 +035400 02 FILLER PIC X(34) VALUE NC1264.2 +035500 " FOR OFFICIAL USE ONLY ". NC1264.2 +035600 02 FILLER PIC X(58) VALUE NC1264.2 +035700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1264.2 +035800 02 FILLER PIC X(28) VALUE NC1264.2 +035900 " COPYRIGHT 1985 ". NC1264.2 +036000 01 CCVS-E-1. NC1264.2 +036100 02 FILLER PIC X(52) VALUE SPACE. NC1264.2 +036200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1264.2 +036300 02 ID-AGAIN PIC X(9). NC1264.2 +036400 02 FILLER PIC X(45) VALUE SPACES. NC1264.2 +036500 01 CCVS-E-2. NC1264.2 +036600 02 FILLER PIC X(31) VALUE SPACE. NC1264.2 +036700 02 FILLER PIC X(21) VALUE SPACE. NC1264.2 +036800 02 CCVS-E-2-2. NC1264.2 +036900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1264.2 +037000 03 FILLER PIC X VALUE SPACE. NC1264.2 +037100 03 ENDER-DESC PIC X(44) VALUE NC1264.2 +037200 "ERRORS ENCOUNTERED". NC1264.2 +037300 01 CCVS-E-3. NC1264.2 +037400 02 FILLER PIC X(22) VALUE NC1264.2 +037500 " FOR OFFICIAL USE ONLY". NC1264.2 +037600 02 FILLER PIC X(12) VALUE SPACE. NC1264.2 +037700 02 FILLER PIC X(58) VALUE NC1264.2 +037800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +037900 02 FILLER PIC X(13) VALUE SPACE. NC1264.2 +038000 02 FILLER PIC X(15) VALUE NC1264.2 +038100 " COPYRIGHT 1985". NC1264.2 +038200 01 CCVS-E-4. NC1264.2 +038300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1264.2 +038400 02 FILLER PIC X(4) VALUE " OF ". NC1264.2 +038500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1264.2 +038600 02 FILLER PIC X(40) VALUE NC1264.2 +038700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1264.2 +038800 01 XXINFO. NC1264.2 +038900 02 FILLER PIC X(19) VALUE NC1264.2 +039000 "*** INFORMATION ***". NC1264.2 +039100 02 INFO-TEXT. NC1264.2 +039200 04 FILLER PIC X(8) VALUE SPACE. NC1264.2 +039300 04 XXCOMPUTED PIC X(20). NC1264.2 +039400 04 FILLER PIC X(5) VALUE SPACE. NC1264.2 +039500 04 XXCORRECT PIC X(20). NC1264.2 +039600 02 INF-ANSI-REFERENCE PIC X(48). NC1264.2 +039700 01 HYPHEN-LINE. NC1264.2 +039800 02 FILLER PIC IS X VALUE IS SPACE. NC1264.2 +039900 02 FILLER PIC IS X(65) VALUE IS "************************NC1264.2 +040000- "*****************************************". NC1264.2 +040100 02 FILLER PIC IS X(54) VALUE IS "************************NC1264.2 +040200- "******************************". NC1264.2 +040300 01 CCVS-PGM-ID PIC X(9) VALUE NC1264.2 +040400 "NC126A". NC1264.2 +040500 PROCEDURE DIVISION. NC1264.2 +040600 CCVS1 SECTION. NC1264.2 +040700 OPEN-FILES. NC1264.2 +040800 OPEN OUTPUT PRINT-FILE. NC1264.2 +040900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1264.2 +041000 MOVE SPACE TO TEST-RESULTS. NC1264.2 +041100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1264.2 +041200 GO TO CCVS1-EXIT. NC1264.2 +041300 CLOSE-FILES. NC1264.2 +041400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1264.2 +041500 TERMINATE-CCVS. NC1264.2 +041600S EXIT PROGRAM. NC1264.2 +041700STERMINATE-CALL. NC1264.2 +041800 STOP RUN. NC1264.2 +041900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1264.2 +042000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1264.2 +042100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1264.2 +042200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1264.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. NC1264.2 +042400 PRINT-DETAIL. NC1264.2 +042500 IF REC-CT NOT EQUAL TO ZERO NC1264.2 +042600 MOVE "." TO PARDOT-X NC1264.2 +042700 MOVE REC-CT TO DOTVALUE. NC1264.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1264.2 +042900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1264.2 +043000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1264.2 +043100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1264.2 +043200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1264.2 +043300 MOVE SPACE TO CORRECT-X. NC1264.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1264.2 +043500 MOVE SPACE TO RE-MARK. NC1264.2 +043600 HEAD-ROUTINE. NC1264.2 +043700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +043800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +043900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1264.2 +044000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1264.2 +044100 COLUMN-NAMES-ROUTINE. NC1264.2 +044200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +044300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +044500 END-ROUTINE. NC1264.2 +044600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1264.2 +044700 END-RTN-EXIT. NC1264.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +044900 END-ROUTINE-1. NC1264.2 +045000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1264.2 +045100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1264.2 +045200 ADD PASS-COUNTER TO ERROR-HOLD. NC1264.2 +045300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1264.2 +045400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1264.2 +045500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1264.2 +045600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1264.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1264.2 +045800 END-ROUTINE-12. NC1264.2 +045900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1264.2 +046000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1264.2 +046100 MOVE "NO " TO ERROR-TOTAL NC1264.2 +046200 ELSE NC1264.2 +046300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1264.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1264.2 +046500 PERFORM WRITE-LINE. NC1264.2 +046600 END-ROUTINE-13. NC1264.2 +046700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1264.2 +046800 MOVE "NO " TO ERROR-TOTAL ELSE NC1264.2 +046900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1264.2 +047000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1264.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047200 IF INSPECT-COUNTER EQUAL TO ZERO NC1264.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1264.2 +047400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1264.2 +047500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1264.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047800 WRITE-LINE. NC1264.2 +047900 ADD 1 TO RECORD-COUNT. NC1264.2 +048000Y IF RECORD-COUNT GREATER 42 NC1264.2 +048100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1264.2 +048200Y MOVE SPACE TO DUMMY-RECORD NC1264.2 +048300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1264.2 +048400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1264.2 +048500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1264.2 +048600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1264.2 +048700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1264.2 +048800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +048900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +049000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +049100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1264.2 +049200Y MOVE ZERO TO RECORD-COUNT. NC1264.2 +049300 PERFORM WRT-LN. NC1264.2 +049400 WRT-LN. NC1264.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1264.2 +049600 MOVE SPACE TO DUMMY-RECORD. NC1264.2 +049700 BLANK-LINE-PRINT. NC1264.2 +049800 PERFORM WRT-LN. NC1264.2 +049900 FAIL-ROUTINE. NC1264.2 +050000 IF COMPUTED-X NOT EQUAL TO SPACE NC1264.2 +050100 GO TO FAIL-ROUTINE-WRITE. NC1264.2 +050200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1264.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1264.2 +050400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1264.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1264.2 +050700 GO TO FAIL-ROUTINE-EX. NC1264.2 +050800 FAIL-ROUTINE-WRITE. NC1264.2 +050900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1264.2 +051000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1264.2 +051100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1264.2 +051200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1264.2 +051300 FAIL-ROUTINE-EX. EXIT. NC1264.2 +051400 BAIL-OUT. NC1264.2 +051500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1264.2 +051600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1264.2 +051700 BAIL-OUT-WRITE. NC1264.2 +051800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1264.2 +051900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1264.2 +052000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +052100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1264.2 +052200 BAIL-OUT-EX. EXIT. NC1264.2 +052300 CCVS1-EXIT. NC1264.2 +052400 EXIT. NC1264.2 +052500 SECT-NC126A-001 SECTION. NC1264.2 +052600 LEV-INIT-GF-1-1. NC1264.2 +052700 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +052800 MOVE "SPACE MOVED TO GRP" TO FEATURE. NC1264.2 +052900 PERFORM PRINT-DETAIL. NC1264.2 +053000 MOVE "GROUP ITEM CHECK " TO FEATURE. NC1264.2 +053100 LEV-TEST-GF-1-0. NC1264.2 +053200 MOVE SPACE TO TABLE-GROUP. NC1264.2 +053300 LEV-TEST-GF-1-1. NC1264.2 +053400 IF TBGRP-1 EQUAL TO SPACE NC1264.2 +053500 PERFORM PASS NC1264.2 +053600 GO TO LEV-WRITE-GF-1-1. NC1264.2 +053700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +053800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +053900 MOVE 94 TO LENGTH-COUNTER. NC1264.2 +054000 GO TO LEV-WRITE-GF-1-1. NC1264.2 +054100 LEV-DELETE-GF-1-1. NC1264.2 +054200 PERFORM DE-LETE. NC1264.2 +054300 LEV-WRITE-GF-1-1. NC1264.2 +054400 MOVE "LEV-TEST-GF-1-1" TO PAR-NAME. NC1264.2 +054500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +054600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +054700 PERFORM PRINT-DETAIL. NC1264.2 +054800 LEV-TEST-GF-1-2. NC1264.2 +054900 IF TBGRP-2 EQUAL TO SPACE NC1264.2 +055000 PERFORM PASS NC1264.2 +055100 GO TO LEV-WRITE-GF-1-2. NC1264.2 +055200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +055300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +055400 MOVE 92 TO LENGTH-COUNTER. NC1264.2 +055500 GO TO LEV-WRITE-GF-1-2. NC1264.2 +055600 LEV-DELETE-GF-1-2. NC1264.2 +055700 PERFORM DE-LETE. NC1264.2 +055800 LEV-WRITE-GF-1-2. NC1264.2 +055900 MOVE "LEV-TEST-GF-1-2" TO PAR-NAME. NC1264.2 +056000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +056100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +056200 PERFORM PRINT-DETAIL. NC1264.2 +056300 LEV-TEST-GF-1-3. NC1264.2 +056400 IF TBGRP-3 EQUAL TO SPACE NC1264.2 +056500 PERFORM PASS NC1264.2 +056600 GO TO LEV-WRITE-GF-1-3. NC1264.2 +056700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +056800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +056900 MOVE 90 TO LENGTH-COUNTER. NC1264.2 +057000 GO TO LEV-WRITE-GF-1-3. NC1264.2 +057100 LEV-DELETE-GF-1-3. NC1264.2 +057200 PERFORM DE-LETE. NC1264.2 +057300 LEV-WRITE-GF-1-3. NC1264.2 +057400 MOVE "LEV-TEST-GF-1-3" TO PAR-NAME. NC1264.2 +057500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +057600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +057700 PERFORM PRINT-DETAIL. NC1264.2 +057800 LEV-TEST-GF-1-4. NC1264.2 +057900 IF TBGRP-4 EQUAL TO SPACE NC1264.2 +058000 PERFORM PASS NC1264.2 +058100 GO TO LEV-WRITE-GF-1-4. NC1264.2 +058200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +058300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +058400 MOVE 88 TO LENGTH-COUNTER. NC1264.2 +058500 GO TO LEV-WRITE-GF-1-4. NC1264.2 +058600 LEV-DELETE-GF-1-4. NC1264.2 +058700 PERFORM DE-LETE. NC1264.2 +058800 LEV-WRITE-GF-1-4. NC1264.2 +058900 MOVE "LEV-TEST-GF-1-4" TO PAR-NAME. NC1264.2 +059000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +059100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +059200 PERFORM PRINT-DETAIL. NC1264.2 +059300 LEV-TEST-GF-1-5. NC1264.2 +059400 IF TBGRP-5 EQUAL TO SPACE NC1264.2 +059500 PERFORM PASS NC1264.2 +059600 GO TO LEV-WRITE-GF-1-5. NC1264.2 +059700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +059800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +059900 MOVE 86 TO LENGTH-COUNTER. NC1264.2 +060000 GO TO LEV-WRITE-GF-1-5. NC1264.2 +060100 LEV-DELETE-GF-1-5. NC1264.2 +060200 PERFORM DE-LETE. NC1264.2 +060300 LEV-WRITE-GF-1-5. NC1264.2 +060400 MOVE "LEV-TEST-GF-1-5" TO PAR-NAME. NC1264.2 +060500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +060600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +060700 PERFORM PRINT-DETAIL. NC1264.2 +060800 LEV-TEST-GF-1-6. NC1264.2 +060900 IF TBGRP-6 EQUAL TO SPACE NC1264.2 +061000 PERFORM PASS NC1264.2 +061100 GO TO LEV-WRITE-GF-1-6. NC1264.2 +061200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +061300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +061400 MOVE 84 TO LENGTH-COUNTER. NC1264.2 +061500 GO TO LEV-WRITE-GF-1-6. NC1264.2 +061600 LEV-DELETE-GF-1-6. NC1264.2 +061700 PERFORM DE-LETE. NC1264.2 +061800 LEV-WRITE-GF-1-6. NC1264.2 +061900 MOVE "LEV-TEST-GF-1-6" TO PAR-NAME. NC1264.2 +062000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +062100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +062200 PERFORM PRINT-DETAIL. NC1264.2 +062300 LEV-TEST-GF-1-7. NC1264.2 +062400 IF TBGRP-7 EQUAL TO SPACE NC1264.2 +062500 PERFORM PASS NC1264.2 +062600 GO TO LEV-WRITE-GF-1-7. NC1264.2 +062700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +062800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +062900 MOVE 82 TO LENGTH-COUNTER. NC1264.2 +063000 GO TO LEV-WRITE-GF-1-7. NC1264.2 +063100 LEV-DELETE-GF-1-7. NC1264.2 +063200 PERFORM DE-LETE. NC1264.2 +063300 LEV-WRITE-GF-1-7. NC1264.2 +063400 MOVE "LEV-TEST-GF-1-7" TO PAR-NAME. NC1264.2 +063500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +063600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +063700 PERFORM PRINT-DETAIL. NC1264.2 +063800 LEV-TEST-GF-1-8. NC1264.2 +063900 IF TBGRP-8 EQUAL TO SPACE NC1264.2 +064000 PERFORM PASS NC1264.2 +064100 GO TO LEV-WRITE-GF-1-8. NC1264.2 +064200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +064300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +064400 MOVE 80 TO LENGTH-COUNTER. NC1264.2 +064500 GO TO LEV-WRITE-GF-1-8. NC1264.2 +064600 LEV-DELETE-GF-1-8. NC1264.2 +064700 PERFORM DE-LETE. NC1264.2 +064800 LEV-WRITE-GF-1-8. NC1264.2 +064900 MOVE "LEV-TEST-GF-1-8" TO PAR-NAME. NC1264.2 +065000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +065100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +065200 PERFORM PRINT-DETAIL. NC1264.2 +065300 LEV-TEST-GF-1-9. NC1264.2 +065400 IF TBGRP-9 EQUAL TO SPACE NC1264.2 +065500 PERFORM PASS NC1264.2 +065600 GO TO LEV-WRITE-GF-1-9. NC1264.2 +065700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +065800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +065900 MOVE 78 TO LENGTH-COUNTER. NC1264.2 +066000 GO TO LEV-WRITE-GF-1-9. NC1264.2 +066100 LEV-DELETE-GF-1-9. NC1264.2 +066200 PERFORM DE-LETE. NC1264.2 +066300 LEV-WRITE-GF-1-9. NC1264.2 +066400 MOVE "LEV-TEST-GF-1-9" TO PAR-NAME. NC1264.2 +066500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +066600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +066700 PERFORM PRINT-DETAIL. NC1264.2 +066800 LEV-TEST-GF-10. NC1264.2 +066900 IF TBGRP-10 EQUAL TO SPACE NC1264.2 +067000 PERFORM PASS NC1264.2 +067100 GO TO LEV-WRITE-GF-1-10. NC1264.2 +067200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +067300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +067400 MOVE 76 TO LENGTH-COUNTER. NC1264.2 +067500 GO TO LEV-WRITE-GF-1-10. NC1264.2 +067600 LEV-DELETE-GF-1-10. NC1264.2 +067700 PERFORM DE-LETE. NC1264.2 +067800 LEV-WRITE-GF-1-10. NC1264.2 +067900 MOVE "LEV-TEST-GF-1-10" TO PAR-NAME. NC1264.2 +068000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +068100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +068200 PERFORM PRINT-DETAIL. NC1264.2 +068300 LEV-TEST-GF-1-11. NC1264.2 +068400 IF TBGRP-11 EQUAL TO SPACE NC1264.2 +068500 PERFORM PASS NC1264.2 +068600 GO TO LEV-WRITE-GF-1-11. NC1264.2 +068700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +068800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +068900 MOVE 74 TO LENGTH-COUNTER. NC1264.2 +069000 GO TO LEV-WRITE-GF-1-11. NC1264.2 +069100 LEV-DELETE-GF-1-11. NC1264.2 +069200 PERFORM DE-LETE. NC1264.2 +069300 LEV-WRITE-GF-1-11. NC1264.2 +069400 MOVE "LEV-TEST-GF-1-11" TO PAR-NAME. NC1264.2 +069500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +069600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +069700 PERFORM PRINT-DETAIL. NC1264.2 +069800 LEV-TEST-GF-1-12. NC1264.2 +069900 IF TBGRP-12 EQUAL TO SPACE NC1264.2 +070000 PERFORM PASS NC1264.2 +070100 GO TO LEV-WRITE-GF-1-12. NC1264.2 +070200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +070300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +070400 MOVE 72 TO LENGTH-COUNTER. NC1264.2 +070500 GO TO LEV-WRITE-GF-1-12. NC1264.2 +070600 LEV-DELETE-GF-1-12. NC1264.2 +070700 PERFORM DE-LETE. NC1264.2 +070800 LEV-WRITE-GF-1-12. NC1264.2 +070900 MOVE "LEV-TEST-GF-1-12" TO PAR-NAME. NC1264.2 +071000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +071100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +071200 PERFORM PRINT-DETAIL. NC1264.2 +071300 LEV-TEST-GF-13. NC1264.2 +071400 IF TBGRP-13 EQUAL TO SPACE NC1264.2 +071500 PERFORM PASS NC1264.2 +071600 GO TO LEV-WRITE-GF-1-13. NC1264.2 +071700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +071800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +071900 MOVE 70 TO LENGTH-COUNTER. NC1264.2 +072000 GO TO LEV-WRITE-GF-1-13. NC1264.2 +072100 LEV-DELETE-GF-1-13. NC1264.2 +072200 PERFORM DE-LETE. NC1264.2 +072300 LEV-WRITE-GF-1-13. NC1264.2 +072400 MOVE "LEV-TEST-GF-1-13" TO PAR-NAME. NC1264.2 +072500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +072600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +072700 PERFORM PRINT-DETAIL. NC1264.2 +072800 LEV-TEST-GF-1-14. NC1264.2 +072900 IF TBGRP-14 EQUAL TO SPACE NC1264.2 +073000 PERFORM PASS NC1264.2 +073100 GO TO LEV-WRITE-GF-1-14. NC1264.2 +073200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +073300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +073400 MOVE 68 TO LENGTH-COUNTER. NC1264.2 +073500 GO TO LEV-WRITE-GF-1-14. NC1264.2 +073600 LEV-DELETE-GF-1-14. NC1264.2 +073700 PERFORM DE-LETE. NC1264.2 +073800 LEV-WRITE-GF-1-14. NC1264.2 +073900 MOVE "LEV-TEST-GF-1-14" TO PAR-NAME. NC1264.2 +074000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +074100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +074200 PERFORM PRINT-DETAIL. NC1264.2 +074300 LEV-TEST-GF-1-15. NC1264.2 +074400 IF TBGRP-15 EQUAL TO SPACE NC1264.2 +074500 PERFORM PASS NC1264.2 +074600 GO TO LEV-WRITE-GF-1-15. NC1264.2 +074700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +074800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +074900 MOVE 66 TO LENGTH-COUNTER. NC1264.2 +075000 GO TO LEV-WRITE-GF-1-15. NC1264.2 +075100 LEV-DELETE-GF-1-15. NC1264.2 +075200 PERFORM DE-LETE. NC1264.2 +075300 LEV-WRITE-GF-1-15. NC1264.2 +075400 MOVE "LEV-TEST-GF-1-15" TO PAR-NAME. NC1264.2 +075500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +075600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +075700 PERFORM PRINT-DETAIL. NC1264.2 +075800 LEV-TEST-GF-1-16. NC1264.2 +075900 IF TBGRP-16 EQUAL TO SPACE NC1264.2 +076000 PERFORM PASS NC1264.2 +076100 GO TO LEV-WRITE-GF-1-16. NC1264.2 +076200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +076300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +076400 MOVE 64 TO LENGTH-COUNTER. NC1264.2 +076500 GO TO LEV-WRITE-GF-1-16. NC1264.2 +076600 LEV-DELETE-GF-1-16. NC1264.2 +076700 PERFORM DE-LETE. NC1264.2 +076800 LEV-WRITE-GF-1-16. NC1264.2 +076900 MOVE "LEV-TEST-GF-1-16" TO PAR-NAME. NC1264.2 +077000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +077100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +077200 PERFORM PRINT-DETAIL. NC1264.2 +077300 LEV-TEST-GF-1-17. NC1264.2 +077400 IF TBGRP-17 EQUAL TO SPACE NC1264.2 +077500 PERFORM PASS NC1264.2 +077600 GO TO LEV-WRITE-GF-1-17. NC1264.2 +077700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +077800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +077900 MOVE 62 TO LENGTH-COUNTER. NC1264.2 +078000 GO TO LEV-WRITE-GF-1-17. NC1264.2 +078100 LEV-DELETE-GF-1-17. NC1264.2 +078200 PERFORM DE-LETE. NC1264.2 +078300 LEV-WRITE-GF-1-17. NC1264.2 +078400 MOVE "LEV-TEST-GF-1-17" TO PAR-NAME. NC1264.2 +078500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +078600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +078700 PERFORM PRINT-DETAIL. NC1264.2 +078800 LEV-TEST-GF-1-18. NC1264.2 +078900 IF TBGRP-18 EQUAL TO SPACE NC1264.2 +079000 PERFORM PASS NC1264.2 +079100 GO TO LEV-WRITE-GF-1-18. NC1264.2 +079200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +079300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +079400 MOVE 60 TO LENGTH-COUNTER. NC1264.2 +079500 GO TO LEV-WRITE-GF-1-18. NC1264.2 +079600 LEV-DELETE-GF-1-18. NC1264.2 +079700 PERFORM DE-LETE. NC1264.2 +079800 LEV-WRITE-GF-1-18. NC1264.2 +079900 MOVE "LEV-TEST-GF-1-18" TO PAR-NAME. NC1264.2 +080000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +080100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +080200 PERFORM PRINT-DETAIL. NC1264.2 +080300 LEV-TEST-GF-1-19. NC1264.2 +080400 IF TBGRP-19 EQUAL TO SPACE NC1264.2 +080500 PERFORM PASS NC1264.2 +080600 GO TO LEV-WRITE-GF-1-19. NC1264.2 +080700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +080800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +080900 MOVE 58 TO LENGTH-COUNTER. NC1264.2 +081000 GO TO LEV-WRITE-GF-1-19. NC1264.2 +081100 LEV-DELETE-GF-1-19. NC1264.2 +081200 PERFORM DE-LETE. NC1264.2 +081300 LEV-WRITE-GF-1-19. NC1264.2 +081400 MOVE "LEV-TEST-GF-1-19" TO PAR-NAME. NC1264.2 +081500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +081600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +081700 PERFORM PRINT-DETAIL. NC1264.2 +081800 LEV-TEST-GF-1-20. NC1264.2 +081900 IF TBGRP-20 EQUAL TO SPACE NC1264.2 +082000 PERFORM PASS NC1264.2 +082100 GO TO LEV-WRITE-GF-1-20. NC1264.2 +082200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +082300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +082400 MOVE 56 TO LENGTH-COUNTER. NC1264.2 +082500 GO TO LEV-WRITE-GF-1-20. NC1264.2 +082600 LEV-DELETE-GF-1-20. NC1264.2 +082700 PERFORM DE-LETE. NC1264.2 +082800 LEV-WRITE-GF-1-20. NC1264.2 +082900 MOVE "LEV-TEST-GF-1-20" TO PAR-NAME. NC1264.2 +083000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +083100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +083200 PERFORM PRINT-DETAIL. NC1264.2 +083300 LEV-TEST-GF-1-21. NC1264.2 +083400 IF TBGRP-21 EQUAL TO SPACE NC1264.2 +083500 PERFORM PASS NC1264.2 +083600 GO TO LEV-WRITE-GF-1-21. NC1264.2 +083700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +083800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +083900 MOVE 54 TO LENGTH-COUNTER. NC1264.2 +084000 GO TO LEV-WRITE-GF-1-21. NC1264.2 +084100 LEV-DELETE-GF-1-21. NC1264.2 +084200 PERFORM DE-LETE. NC1264.2 +084300 LEV-WRITE-GF-1-21. NC1264.2 +084400 MOVE "LEV-TEST-GF-1-21" TO PAR-NAME. NC1264.2 +084500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +084600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +084700 PERFORM PRINT-DETAIL. NC1264.2 +084800 LEV-TEST-GF-1-22. NC1264.2 +084900 IF TBGRP-22 EQUAL TO SPACE NC1264.2 +085000 PERFORM PASS NC1264.2 +085100 GO TO LEV-WRITE-GF-1-22. NC1264.2 +085200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +085300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +085400 MOVE 52 TO LENGTH-COUNTER. NC1264.2 +085500 GO TO LEV-WRITE-GF-1-22. NC1264.2 +085600 LEV-DELETE-GF-1-22. NC1264.2 +085700 PERFORM DE-LETE. NC1264.2 +085800 LEV-WRITE-GF-1-22. NC1264.2 +085900 MOVE "LEV-TEST-GF-1-22" TO PAR-NAME. NC1264.2 +086000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +086100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +086200 PERFORM PRINT-DETAIL. NC1264.2 +086300 LEV-TEST-GF-1-23. NC1264.2 +086400 IF TBGRP-23 EQUAL TO SPACE NC1264.2 +086500 PERFORM PASS NC1264.2 +086600 GO TO LEV-WRITE-GF-1-23. NC1264.2 +086700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +086800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +086900 MOVE 50 TO LENGTH-COUNTER. NC1264.2 +087000 GO TO LEV-WRITE-GF-1-23. NC1264.2 +087100 LEV-DELETE-GF-1-23. NC1264.2 +087200 PERFORM DE-LETE. NC1264.2 +087300 LEV-WRITE-GF-1-23. NC1264.2 +087400 MOVE "LEV-TEST-GF-1-23" TO PAR-NAME. NC1264.2 +087500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +087600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +087700 PERFORM PRINT-DETAIL. NC1264.2 +087800 LEV-TEST-GF-1-24. NC1264.2 +087900 IF TBGRP-24 EQUAL TO SPACE NC1264.2 +088000 PERFORM PASS NC1264.2 +088100 GO TO LEV-WRITE-GF-1-24. NC1264.2 +088200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +088300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +088400 MOVE 48 TO LENGTH-COUNTER. NC1264.2 +088500 GO TO LEV-WRITE-GF-1-24. NC1264.2 +088600 LEV-DELETE-GF-1-24. NC1264.2 +088700 PERFORM DE-LETE. NC1264.2 +088800 LEV-WRITE-GF-1-24. NC1264.2 +088900 MOVE "LEV-TEST-GF-1-24" TO PAR-NAME. NC1264.2 +089000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +089100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +089200 PERFORM PRINT-DETAIL. NC1264.2 +089300 LEV-TEST-GF-1-25. NC1264.2 +089400 IF TBGRP-25 EQUAL TO SPACE NC1264.2 +089500 PERFORM PASS NC1264.2 +089600 GO TO LEV-WRITE-GF-1-25. NC1264.2 +089700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +089800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +089900 MOVE 46 TO LENGTH-COUNTER. NC1264.2 +090000 GO TO LEV-WRITE-GF-1-25. NC1264.2 +090100 LEV-DELETE-GF-1-25. NC1264.2 +090200 PERFORM DE-LETE. NC1264.2 +090300 LEV-WRITE-GF-1-25. NC1264.2 +090400 MOVE "LEV-TEST-GF-1-25" TO PAR-NAME. NC1264.2 +090500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +090600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +090700 PERFORM PRINT-DETAIL. NC1264.2 +090800 LEV-TEST-GF-1-26. NC1264.2 +090900 IF TBGRP-26 EQUAL TO SPACE NC1264.2 +091000 PERFORM PASS NC1264.2 +091100 GO TO LEV-WRITE-GF-1-26. NC1264.2 +091200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +091300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +091400 MOVE 44 TO LENGTH-COUNTER. NC1264.2 +091500 GO TO LEV-WRITE-GF-1-26. NC1264.2 +091600 LEV-DELETE-GF-1-26. NC1264.2 +091700 PERFORM DE-LETE. NC1264.2 +091800 LEV-WRITE-GF-1-26. NC1264.2 +091900 MOVE "LEV-TEST-GF-1-26" TO PAR-NAME. NC1264.2 +092000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +092100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +092200 PERFORM PRINT-DETAIL. NC1264.2 +092300 LEV-TEST-GF-1-27. NC1264.2 +092400 IF TBGRP-27 EQUAL TO SPACE NC1264.2 +092500 PERFORM PASS NC1264.2 +092600 GO TO LEV-WRITE-GF-1-27. NC1264.2 +092700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +092800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +092900 MOVE 42 TO LENGTH-COUNTER. NC1264.2 +093000 GO TO LEV-WRITE-GF-1-27. NC1264.2 +093100 LEV-DELETE-GF-1-27. NC1264.2 +093200 PERFORM DE-LETE. NC1264.2 +093300 LEV-WRITE-GF-1-27. NC1264.2 +093400 MOVE "LEV-TEST-GF-1-27" TO PAR-NAME. NC1264.2 +093500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +093600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +093700 PERFORM PRINT-DETAIL. NC1264.2 +093800 LEV-TEST-GF-1-28. NC1264.2 +093900 IF TBGRP-28 EQUAL TO SPACE NC1264.2 +094000 PERFORM PASS NC1264.2 +094100 GO TO LEV-WRITE-GF-1-28. NC1264.2 +094200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +094300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +094400 MOVE 40 TO LENGTH-COUNTER. NC1264.2 +094500 GO TO LEV-WRITE-GF-1-28. NC1264.2 +094600 LEV-DELETE-GF-1-28. NC1264.2 +094700 PERFORM DE-LETE. NC1264.2 +094800 LEV-WRITE-GF-1-28. NC1264.2 +094900 MOVE "LEV-TEST-GF-1-28" TO PAR-NAME. NC1264.2 +095000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +095100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +095200 PERFORM PRINT-DETAIL. NC1264.2 +095300 LEV-TEST-GF-1-29. NC1264.2 +095400 IF TBGRP-29 EQUAL TO SPACE NC1264.2 +095500 PERFORM PASS NC1264.2 +095600 GO TO LEV-WRITE-GF-1-29. NC1264.2 +095700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +095800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +095900 MOVE 38 TO LENGTH-COUNTER. NC1264.2 +096000 GO TO LEV-WRITE-GF-1-29. NC1264.2 +096100 LEV-DELETE-GF-1-29. NC1264.2 +096200 PERFORM DE-LETE. NC1264.2 +096300 LEV-WRITE-GF-1-29. NC1264.2 +096400 MOVE "LEV-TEST-GF-1-29" TO PAR-NAME. NC1264.2 +096500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +096600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +096700 PERFORM PRINT-DETAIL. NC1264.2 +096800 LEV-TEST-GF-1-30. NC1264.2 +096900 IF TBGRP-30 EQUAL TO SPACE NC1264.2 +097000 PERFORM PASS NC1264.2 +097100 GO TO LEV-WRITE-GF-1-30. NC1264.2 +097200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +097300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +097400 MOVE 36 TO LENGTH-COUNTER. NC1264.2 +097500 GO TO LEV-WRITE-GF-1-30. NC1264.2 +097600 LEV-DELETE-GF-1-30. NC1264.2 +097700 PERFORM DE-LETE. NC1264.2 +097800 LEV-WRITE-GF-1-30. NC1264.2 +097900 MOVE "LEV-TEST-GF-1-30" TO PAR-NAME. NC1264.2 +098000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +098100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +098200 PERFORM PRINT-DETAIL. NC1264.2 +098300 LEV-TEST-GF-1-31. NC1264.2 +098400 IF TBGRP-31 EQUAL TO SPACE NC1264.2 +098500 PERFORM PASS NC1264.2 +098600 GO TO LEV-WRITE-GF-1-31. NC1264.2 +098700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +098800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +098900 MOVE 34 TO LENGTH-COUNTER. NC1264.2 +099000 GO TO LEV-WRITE-GF-1-31. NC1264.2 +099100 LEV-DELETE-GF-1-31. NC1264.2 +099200 PERFORM DE-LETE. NC1264.2 +099300 LEV-WRITE-GF-1-31. NC1264.2 +099400 MOVE "LEV-TEST-GF-1-31" TO PAR-NAME. NC1264.2 +099500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +099600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +099700 PERFORM PRINT-DETAIL. NC1264.2 +099800 LEV-TEST-GF-1-32. NC1264.2 +099900 IF TBGRP-32 EQUAL TO SPACE NC1264.2 +100000 PERFORM PASS NC1264.2 +100100 GO TO LEV-WRITE-GF-1-32. NC1264.2 +100200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +100300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +100400 MOVE 32 TO LENGTH-COUNTER. NC1264.2 +100500 GO TO LEV-WRITE-GF-1-32. NC1264.2 +100600 LEV-DELETE-GF-1-32. NC1264.2 +100700 PERFORM DE-LETE. NC1264.2 +100800 LEV-WRITE-GF-1-32. NC1264.2 +100900 MOVE "LEV-TEST-GF-1-32" TO PAR-NAME. NC1264.2 +101000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +101100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +101200 PERFORM PRINT-DETAIL. NC1264.2 +101300 LEV-TEST-GF-1-33. NC1264.2 +101400 IF TBGRP-33 EQUAL TO SPACE NC1264.2 +101500 PERFORM PASS NC1264.2 +101600 GO TO LEV-WRITE-GF-1-33. NC1264.2 +101700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +101800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +101900 MOVE 30 TO LENGTH-COUNTER. NC1264.2 +102000 GO TO LEV-WRITE-GF-1-33. NC1264.2 +102100 LEV-DELETE-GF-1-33. NC1264.2 +102200 PERFORM DE-LETE. NC1264.2 +102300 LEV-WRITE-GF-1-33. NC1264.2 +102400 MOVE "LEV-TEST-GF-1-33" TO PAR-NAME. NC1264.2 +102500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +102600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +102700 PERFORM PRINT-DETAIL. NC1264.2 +102800 LEV-TEST-GF-1-34. NC1264.2 +102900 IF TBGRP-34 EQUAL TO SPACE NC1264.2 +103000 PERFORM PASS NC1264.2 +103100 GO TO LEV-WRITE-GF-1-34. NC1264.2 +103200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +103300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +103400 MOVE 28 TO LENGTH-COUNTER. NC1264.2 +103500 GO TO LEV-WRITE-GF-1-34. NC1264.2 +103600 LEV-DELETE-GF-1-34. NC1264.2 +103700 PERFORM DE-LETE. NC1264.2 +103800 LEV-WRITE-GF-1-34. NC1264.2 +103900 MOVE "LEV-TEST-GF-1-34" TO PAR-NAME. NC1264.2 +104000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +104100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +104200 PERFORM PRINT-DETAIL. NC1264.2 +104300 LEV-TEST-GF-1-35. NC1264.2 +104400 IF TBGRP-35 EQUAL TO SPACE NC1264.2 +104500 PERFORM PASS NC1264.2 +104600 GO TO LEV-WRITE-GF-1-35. NC1264.2 +104700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +104800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +104900 MOVE 26 TO LENGTH-COUNTER. NC1264.2 +105000 GO TO LEV-WRITE-GF-1-35. NC1264.2 +105100 LEV-DELETE-GF-1-35. NC1264.2 +105200 PERFORM DE-LETE. NC1264.2 +105300 LEV-WRITE-GF-1-35. NC1264.2 +105400 MOVE "LEV-TEST-GF-1-35" TO PAR-NAME. NC1264.2 +105500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +105600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +105700 PERFORM PRINT-DETAIL. NC1264.2 +105800 LEV-TEST-GF-1-36. NC1264.2 +105900 IF TBGRP-36 EQUAL TO SPACE NC1264.2 +106000 PERFORM PASS NC1264.2 +106100 GO TO LEV-WRITE-GF-1-36. NC1264.2 +106200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +106300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +106400 MOVE 24 TO LENGTH-COUNTER. NC1264.2 +106500 GO TO LEV-WRITE-GF-1-36. NC1264.2 +106600 LEV-DELETE-GF-1-36. NC1264.2 +106700 PERFORM DE-LETE. NC1264.2 +106800 LEV-WRITE-GF-1-36. NC1264.2 +106900 MOVE "LEV-TEST-GF-1-36" TO PAR-NAME. NC1264.2 +107000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +107100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +107200 PERFORM PRINT-DETAIL. NC1264.2 +107300 LEV-TEST-GF-1-37. NC1264.2 +107400 IF TBGRP-37 EQUAL TO SPACE NC1264.2 +107500 PERFORM PASS NC1264.2 +107600 GO TO LEV-WRITE-GF-1-37. NC1264.2 +107700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +107800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +107900 MOVE 22 TO LENGTH-COUNTER. NC1264.2 +108000 GO TO LEV-WRITE-GF-1-37. NC1264.2 +108100 LEV-DELETE-GF-1-37. NC1264.2 +108200 PERFORM DE-LETE. NC1264.2 +108300 LEV-WRITE-GF-1-37. NC1264.2 +108400 MOVE "LEV-TEST-GF-1-37" TO PAR-NAME. NC1264.2 +108500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +108600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +108700 PERFORM PRINT-DETAIL. NC1264.2 +108800 LEV-TEST-GF-1-38. NC1264.2 +108900 IF TBGRP-38 EQUAL TO SPACE NC1264.2 +109000 PERFORM PASS NC1264.2 +109100 GO TO LEV-WRITE-GF-1-38. NC1264.2 +109200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +109300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +109400 MOVE 20 TO LENGTH-COUNTER. NC1264.2 +109500 GO TO LEV-WRITE-GF-1-38. NC1264.2 +109600 LEV-DELETE-GF-1-38. NC1264.2 +109700 PERFORM DE-LETE. NC1264.2 +109800 LEV-WRITE-GF-1-38. NC1264.2 +109900 MOVE "LEV-TEST-GF-1-38" TO PAR-NAME. NC1264.2 +110000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +110100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +110200 PERFORM PRINT-DETAIL. NC1264.2 +110300 LEV-TEST-GF-1-39. NC1264.2 +110400 IF TBGRP-39 EQUAL TO SPACE NC1264.2 +110500 PERFORM PASS NC1264.2 +110600 GO TO LEV-WRITE-GF-1-39. NC1264.2 +110700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +110800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +110900 MOVE 18 TO LENGTH-COUNTER. NC1264.2 +111000 GO TO LEV-WRITE-GF-1-39. NC1264.2 +111100 LEV-DELETE-GF-1-39. NC1264.2 +111200 PERFORM DE-LETE. NC1264.2 +111300 LEV-WRITE-GF-1-39. NC1264.2 +111400 MOVE "LEV-TEST-GF-1-39" TO PAR-NAME. NC1264.2 +111500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +111600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +111700 PERFORM PRINT-DETAIL. NC1264.2 +111800 LEV-TEST-GF-1-40. NC1264.2 +111900 IF TBGRP-40 EQUAL TO SPACE NC1264.2 +112000 PERFORM PASS NC1264.2 +112100 GO TO LEV-WRITE-GF-1-40. NC1264.2 +112200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +112300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +112400 MOVE 16 TO LENGTH-COUNTER. NC1264.2 +112500 GO TO LEV-WRITE-GF-1-40. NC1264.2 +112600 LEV-DELETE-GF-1-40. NC1264.2 +112700 PERFORM DE-LETE. NC1264.2 +112800 LEV-WRITE-GF-1-40. NC1264.2 +112900 MOVE "LEV-TEST-GF-1-40" TO PAR-NAME. NC1264.2 +113000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +113100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +113200 PERFORM PRINT-DETAIL. NC1264.2 +113300 LEV-TEST-GF-1-41. NC1264.2 +113400 IF TBGRP-41 EQUAL TO SPACE NC1264.2 +113500 PERFORM PASS NC1264.2 +113600 GO TO LEV-WRITE-GF-1-41. NC1264.2 +113700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +113800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +113900 MOVE 14 TO LENGTH-COUNTER. NC1264.2 +114000 GO TO LEV-WRITE-GF-1-41. NC1264.2 +114100 LEV-DELETE-GF-1-41. NC1264.2 +114200 PERFORM DE-LETE. NC1264.2 +114300 LEV-WRITE-GF-1-41. NC1264.2 +114400 MOVE "LEV-TEST-GF-1-41" TO PAR-NAME. NC1264.2 +114500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +114600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +114700 PERFORM PRINT-DETAIL. NC1264.2 +114800 LEV-TEST-GF-1-42. NC1264.2 +114900 IF TBGRP-42 EQUAL TO SPACE NC1264.2 +115000 PERFORM PASS NC1264.2 +115100 GO TO LEV-WRITE-GF-1-42. NC1264.2 +115200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +115300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +115400 MOVE 12 TO LENGTH-COUNTER. NC1264.2 +115500 GO TO LEV-WRITE-GF-1-42. NC1264.2 +115600 LEV-DELETE-GF-1-42. NC1264.2 +115700 PERFORM DE-LETE. NC1264.2 +115800 LEV-WRITE-GF-1-42. NC1264.2 +115900 MOVE "LEV-TEST-GF-1-42" TO PAR-NAME. NC1264.2 +116000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +116100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +116200 PERFORM PRINT-DETAIL. NC1264.2 +116300 LEV-TEST-GF-1-43. NC1264.2 +116400 IF TBGRP-43 EQUAL TO SPACE NC1264.2 +116500 PERFORM PASS NC1264.2 +116600 GO TO LEV-WRITE-GF-1-43. NC1264.2 +116700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +116800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +116900 MOVE 10 TO LENGTH-COUNTER. NC1264.2 +117000 GO TO LEV-WRITE-GF-1-43. NC1264.2 +117100 LEV-DELETE-GF-1-43. NC1264.2 +117200 PERFORM DE-LETE. NC1264.2 +117300 LEV-WRITE-GF-1-43. NC1264.2 +117400 MOVE "LEV-TEST-GF-1-43" TO PAR-NAME. NC1264.2 +117500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +117600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +117700 PERFORM PRINT-DETAIL. NC1264.2 +117800 LEV-TEST-GF-1-44. NC1264.2 +117900 IF TBGRP-44 EQUAL TO SPACE NC1264.2 +118000 PERFORM PASS NC1264.2 +118100 GO TO LEV-WRITE-GF-1-44. NC1264.2 +118200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +118300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +118400 MOVE 8 TO LENGTH-COUNTER. NC1264.2 +118500 GO TO LEV-WRITE-GF-1-44. NC1264.2 +118600 LEV-DELETE-GF-1-44. NC1264.2 +118700 PERFORM DE-LETE. NC1264.2 +118800 LEV-WRITE-GF-1-44. NC1264.2 +118900 MOVE "LEV-TEST-GF-1-44" TO PAR-NAME. NC1264.2 +119000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +119100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +119200 PERFORM PRINT-DETAIL. NC1264.2 +119300 LEV-TEST-GF-1-45. NC1264.2 +119400 IF TBGRP-45 EQUAL TO SPACE NC1264.2 +119500 PERFORM PASS NC1264.2 +119600 GO TO LEV-WRITE-GF-1-45. NC1264.2 +119700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +119800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +119900 MOVE 6 TO LENGTH-COUNTER. NC1264.2 +120000 GO TO LEV-WRITE-GF-1-45. NC1264.2 +120100 LEV-DELETE-GF-1-45. NC1264.2 +120200 PERFORM DE-LETE. NC1264.2 +120300 LEV-WRITE-GF-1-45. NC1264.2 +120400 MOVE "LEV-TEST-GF-1-45" TO PAR-NAME. NC1264.2 +120500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +120600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +120700 PERFORM PRINT-DETAIL. NC1264.2 +120800 LEV-TEST-GF-1-46. NC1264.2 +120900 IF TBGRP-46 EQUAL TO SPACE NC1264.2 +121000 PERFORM PASS NC1264.2 +121100 GO TO LEV-WRITE-GF-1-46. NC1264.2 +121200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +121300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +121400 MOVE 4 TO LENGTH-COUNTER. NC1264.2 +121500 GO TO LEV-WRITE-GF-1-46. NC1264.2 +121600 LEV-DELETE-GF-1-46. NC1264.2 +121700 PERFORM DE-LETE. NC1264.2 +121800 LEV-WRITE-GF-1-46. NC1264.2 +121900 MOVE "LEV-TEST-GF-1-46" TO PAR-NAME. NC1264.2 +122000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +122100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +122200 PERFORM PRINT-DETAIL. NC1264.2 +122300 LEV-TEST-GF-1-47. NC1264.2 +122400 IF TBGRP-47 EQUAL TO SPACE NC1264.2 +122500 PERFORM PASS NC1264.2 +122600 GO TO LEV-WRITE-GF-1-47. NC1264.2 +122700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +122800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +122900 MOVE 2 TO LENGTH-COUNTER. NC1264.2 +123000 GO TO LEV-WRITE-GF-1-47. NC1264.2 +123100 LEV-DELETE-GF-1-47. NC1264.2 +123200 PERFORM DE-LETE. NC1264.2 +123300 LEV-WRITE-GF-1-47. NC1264.2 +123400 MOVE "LEV-TEST-GF-1-47" TO PAR-NAME. NC1264.2 +123500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +123600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +123700 PERFORM PRINT-DETAIL. NC1264.2 +123800 LEV-INIT-GF-2-1. NC1264.2 +123900 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +124000 PERFORM END-ROUTINE. NC1264.2 +124100 MOVE SPACE TO PRINT-REC. NC1264.2 +124200 MOVE "ALPHA MOVED TO GROUP" TO FEATURE. NC1264.2 +124300 PERFORM PRINT-DETAIL. NC1264.2 +124400 MOVE "ELEMENTRY ITEM CHK" TO FEATURE. NC1264.2 +124500 MOVE "ABCDEFGHIJKLMNOPQRST" TO A-PART-98. NC1264.2 +124600 MOVE "01234567899876543210" TO B-PART-98. NC1264.2 +124700 MOVE "SUPERCALIFRAGILISTIC" TO C-PART-98. NC1264.2 +124800 MOVE "THAT LITERAL WAS BAD" TO D-PART-98. NC1264.2 +124900 MOVE "UP ON THE ROOFS" TO E-PART-98. NC1264.2 +125000 MOVE LITERAL-98 TO TABLE-GROUP. NC1264.2 +125100 LEV-TEST-GF-2-1. NC1264.2 +125200 IF TB-1 EQUAL TO "AB" NC1264.2 +125300 PERFORM PASS NC1264.2 +125400 GO TO LEV-WRITE-GF-2-1. NC1264.2 +125500 PERFORM FAIL. NC1264.2 +125600 MOVE TB-1 TO COMPUTED-A. NC1264.2 +125700 MOVE "AB" TO CORRECT-A. NC1264.2 +125800 GO TO LEV-WRITE-GF-2-1. NC1264.2 +125900 LEV-DELETE-GF-2-1. NC1264.2 +126000 PERFORM DE-LETE. NC1264.2 +126100 LEV-WRITE-GF-2-1. NC1264.2 +126200 MOVE "LEV-TEST-GF-2-1" TO PAR-NAME. NC1264.2 +126300 PERFORM PRINT-DETAIL. NC1264.2 +126400 LEV-TEST-GF-2-2. NC1264.2 +126500 IF TB-2 EQUAL TO "CD" NC1264.2 +126600 PERFORM PASS NC1264.2 +126700 GO TO LEV-WRITE-GF-2-2. NC1264.2 +126800 PERFORM FAIL. NC1264.2 +126900 MOVE TB-2 TO COMPUTED-A. NC1264.2 +127000 MOVE "CD" TO CORRECT-A. NC1264.2 +127100 GO TO LEV-WRITE-GF-2-2. NC1264.2 +127200 LEV-DELETE-GF-2-2. NC1264.2 +127300 PERFORM DE-LETE. NC1264.2 +127400 LEV-WRITE-GF-2-2. NC1264.2 +127500 MOVE "LEV-TEST-GF-2-2" TO PAR-NAME. NC1264.2 +127600 PERFORM PRINT-DETAIL. NC1264.2 +127700 LEV-TEST-GF-2-3. NC1264.2 +127800 IF TB-3 EQUAL TO "EF" NC1264.2 +127900 PERFORM PASS NC1264.2 +128000 GO TO LEV-WRITE-GF-2-3. NC1264.2 +128100 PERFORM FAIL. NC1264.2 +128200 MOVE TB-3 TO COMPUTED-A. NC1264.2 +128300 MOVE "EF" TO CORRECT-A. NC1264.2 +128400 GO TO LEV-WRITE-GF-2-3. NC1264.2 +128500 LEV-DELETE-GF-2-3. NC1264.2 +128600 PERFORM DE-LETE. NC1264.2 +128700 LEV-WRITE-GF-2-3. NC1264.2 +128800 MOVE "LEV-TEST-GF-2-3" TO PAR-NAME. NC1264.2 +128900 PERFORM PRINT-DETAIL. NC1264.2 +129000 LEV-TEST-GF-2-4. NC1264.2 +129100 IF TB-4 EQUAL TO "GH" NC1264.2 +129200 PERFORM PASS NC1264.2 +129300 GO TO LEV-WRITE-GF-2-4. NC1264.2 +129400 PERFORM FAIL. NC1264.2 +129500 MOVE TB-4 TO COMPUTED-A. NC1264.2 +129600 MOVE "GH" TO CORRECT-A. NC1264.2 +129700 GO TO LEV-WRITE-GF-2-4. NC1264.2 +129800 LEV-DELETE-GF-2-4. NC1264.2 +129900 PERFORM DE-LETE. NC1264.2 +130000 LEV-WRITE-GF-2-4. NC1264.2 +130100 MOVE "LEV-TEST-GF-2-4" TO PAR-NAME. NC1264.2 +130200 PERFORM PRINT-DETAIL. NC1264.2 +130300 LEV-TEST-GF-2-5. NC1264.2 +130400 IF TB-5 EQUAL TO "IJ" NC1264.2 +130500 PERFORM PASS NC1264.2 +130600 GO TO LEV-WRITE-GF-2-5. NC1264.2 +130700 PERFORM FAIL. NC1264.2 +130800 MOVE TB-5 TO COMPUTED-A. NC1264.2 +130900 MOVE "IJ" TO CORRECT-A. NC1264.2 +131000 GO TO LEV-WRITE-GF-2-5. NC1264.2 +131100 LEV-DELETE-GF-2-5. NC1264.2 +131200 PERFORM DE-LETE. NC1264.2 +131300 LEV-WRITE-GF-2-5. NC1264.2 +131400 MOVE "LEV-TEST-GF-2-5" TO PAR-NAME. NC1264.2 +131500 PERFORM PRINT-DETAIL. NC1264.2 +131600 LEV-TEST-GF-2-6. NC1264.2 +131700 IF TB-6 EQUAL TO "KL" NC1264.2 +131800 PERFORM PASS NC1264.2 +131900 GO TO LEV-WRITE-GF-2-6. NC1264.2 +132000 PERFORM FAIL. NC1264.2 +132100 MOVE TB-6 TO COMPUTED-A. NC1264.2 +132200 MOVE "KL" TO CORRECT-A. NC1264.2 +132300 GO TO LEV-WRITE-GF-2-6. NC1264.2 +132400 LEV-DELETE-GF-2-6. NC1264.2 +132500 PERFORM DE-LETE. NC1264.2 +132600 LEV-WRITE-GF-2-6. NC1264.2 +132700 MOVE "LEV-TEST-GF-2-6" TO PAR-NAME. NC1264.2 +132800 PERFORM PRINT-DETAIL. NC1264.2 +132900 LEV-TEST-GF-2-7. NC1264.2 +133000 IF TB-7 EQUAL TO "MN" NC1264.2 +133100 PERFORM PASS NC1264.2 +133200 GO TO LEV-WRITE-GF-2-7. NC1264.2 +133300 PERFORM FAIL. NC1264.2 +133400 MOVE TB-7 TO COMPUTED-A. NC1264.2 +133500 MOVE "MN" TO CORRECT-A. NC1264.2 +133600 GO TO LEV-WRITE-GF-2-7. NC1264.2 +133700 LEV-DELETE-GF-2-7. NC1264.2 +133800 PERFORM DE-LETE. NC1264.2 +133900 LEV-WRITE-GF-2-7. NC1264.2 +134000 MOVE "LEV-TEST-GF-2-7" TO PAR-NAME. NC1264.2 +134100 PERFORM PRINT-DETAIL. NC1264.2 +134200 LEV-TEST-GF-2-8. NC1264.2 +134300 IF TB-8 EQUAL TO "OP" NC1264.2 +134400 PERFORM PASS NC1264.2 +134500 GO TO LEV-WRITE-GF-2-8. NC1264.2 +134600 PERFORM FAIL. NC1264.2 +134700 MOVE TB-8 TO COMPUTED-A. NC1264.2 +134800 MOVE "OP" TO CORRECT-A. NC1264.2 +134900 GO TO LEV-WRITE-GF-2-8. NC1264.2 +135000 LEV-DELETE-GF-2-8. NC1264.2 +135100 PERFORM DE-LETE. NC1264.2 +135200 LEV-WRITE-GF-2-8. NC1264.2 +135300 MOVE "LEV-TEST-GF-2-8" TO PAR-NAME. NC1264.2 +135400 PERFORM PRINT-DETAIL. NC1264.2 +135500 LEV-TEST-GF-2-9. NC1264.2 +135600 IF TB-9 EQUAL TO "QR" NC1264.2 +135700 PERFORM PASS NC1264.2 +135800 GO TO LEV-WRITE-GF-2-9. NC1264.2 +135900 PERFORM FAIL. NC1264.2 +136000 MOVE TB-9 TO COMPUTED-A. NC1264.2 +136100 MOVE "QR" TO CORRECT-A. NC1264.2 +136200 GO TO LEV-WRITE-GF-2-9. NC1264.2 +136300 LEV-DELETE-GF-2-9. NC1264.2 +136400 PERFORM DE-LETE. NC1264.2 +136500 LEV-WRITE-GF-2-9. NC1264.2 +136600 MOVE "LEV-TEST-GF-2-9" TO PAR-NAME. NC1264.2 +136700 PERFORM PRINT-DETAIL. NC1264.2 +136800 LEV-TEST-GF-2-10. NC1264.2 +136900 IF TB-10 EQUAL TO "ST" NC1264.2 +137000 PERFORM PASS NC1264.2 +137100 GO TO LEV-WRITE-GF-2-10. NC1264.2 +137200 PERFORM FAIL. NC1264.2 +137300 MOVE TB-10 TO COMPUTED-A. NC1264.2 +137400 MOVE "ST" TO CORRECT-A. NC1264.2 +137500 GO TO LEV-WRITE-GF-2-10. NC1264.2 +137600 LEV-DELETE-GF-2-10. NC1264.2 +137700 PERFORM DE-LETE. NC1264.2 +137800 LEV-WRITE-GF-2-10. NC1264.2 +137900 MOVE "LEV-TEST-GF-2-10" TO PAR-NAME. NC1264.2 +138000 PERFORM PRINT-DETAIL. NC1264.2 +138100 LEV-TEST-GF-2-11. NC1264.2 +138200 IF TB-11 EQUAL TO "01" NC1264.2 +138300 PERFORM PASS NC1264.2 +138400 GO TO LEV-WRITE-GF-2-11. NC1264.2 +138500 PERFORM FAIL. NC1264.2 +138600 MOVE TB-11 TO COMPUTED-A. NC1264.2 +138700 MOVE "01" TO CORRECT-A. NC1264.2 +138800 GO TO LEV-WRITE-GF-2-11. NC1264.2 +138900 LEV-DELETE-GF-2-11. NC1264.2 +139000 PERFORM DE-LETE. NC1264.2 +139100 LEV-WRITE-GF-2-11. NC1264.2 +139200 MOVE "LEV-TEST-GF-2-11" TO PAR-NAME. NC1264.2 +139300 PERFORM PRINT-DETAIL. NC1264.2 +139400 LEV-TEST-GF-2-12. NC1264.2 +139500 IF TB-12 EQUAL TO "23" NC1264.2 +139600 PERFORM PASS NC1264.2 +139700 GO TO LEV-WRITE-GF-2-12. NC1264.2 +139800 PERFORM FAIL. NC1264.2 +139900 MOVE TB-12 TO COMPUTED-A. NC1264.2 +140000 MOVE "23" TO CORRECT-A. NC1264.2 +140100 GO TO LEV-WRITE-GF-2-12. NC1264.2 +140200 LEV-DELETE-GF-2-12. NC1264.2 +140300 PERFORM DE-LETE. NC1264.2 +140400 LEV-WRITE-GF-2-12. NC1264.2 +140500 MOVE "LEV-TEST-GF-2-12" TO PAR-NAME. NC1264.2 +140600 PERFORM PRINT-DETAIL. NC1264.2 +140700 LEV-TEST-GF-2-13. NC1264.2 +140800 IF TB-13 EQUAL TO "45" NC1264.2 +140900 PERFORM PASS NC1264.2 +141000 GO TO LEV-WRITE-GF-2-13. NC1264.2 +141100 PERFORM FAIL. NC1264.2 +141200 MOVE TB-13 TO COMPUTED-A. NC1264.2 +141300 MOVE "45" TO CORRECT-A. NC1264.2 +141400 GO TO LEV-WRITE-GF-2-13. NC1264.2 +141500 LEV-DELETE-GF-2-13. NC1264.2 +141600 PERFORM DE-LETE. NC1264.2 +141700 LEV-WRITE-GF-2-13. NC1264.2 +141800 MOVE "LEV-TEST-GF-2-13" TO PAR-NAME. NC1264.2 +141900 PERFORM PRINT-DETAIL. NC1264.2 +142000 LEV-TEST-GF-2-14. NC1264.2 +142100 IF TB-14 EQUAL TO "67" NC1264.2 +142200 PERFORM PASS NC1264.2 +142300 GO TO LEV-WRITE-GF-2-14. NC1264.2 +142400 PERFORM FAIL. NC1264.2 +142500 MOVE TB-14 TO COMPUTED-A. NC1264.2 +142600 MOVE "67" TO CORRECT-A. NC1264.2 +142700 GO TO LEV-WRITE-GF-2-14. NC1264.2 +142800 LEV-DELETE-GF-2-14. NC1264.2 +142900 PERFORM DE-LETE. NC1264.2 +143000 LEV-WRITE-GF-2-14. NC1264.2 +143100 MOVE "LEV-TEST-GF-2-14" TO PAR-NAME. NC1264.2 +143200 PERFORM PRINT-DETAIL. NC1264.2 +143300 LEV-TEST-GF-2-15. NC1264.2 +143400 IF TB-15 EQUAL TO "89" NC1264.2 +143500 PERFORM PASS NC1264.2 +143600 GO TO LEV-WRITE-GF-2-15. NC1264.2 +143700 PERFORM FAIL. NC1264.2 +143800 MOVE TB-15 TO COMPUTED-A. NC1264.2 +143900 MOVE "89" TO CORRECT-A. NC1264.2 +144000 GO TO LEV-WRITE-GF-2-15. NC1264.2 +144100 LEV-DELETE-GF-2-15. NC1264.2 +144200 PERFORM DE-LETE. NC1264.2 +144300 LEV-WRITE-GF-2-15. NC1264.2 +144400 MOVE "LEV-TEST-GF-2-15" TO PAR-NAME. NC1264.2 +144500 PERFORM PRINT-DETAIL. NC1264.2 +144600 LEV-TEST-GF-2-16. NC1264.2 +144700 IF TB-16 EQUAL TO "98" NC1264.2 +144800 PERFORM PASS NC1264.2 +144900 GO TO LEV-WRITE-GF-2-16. NC1264.2 +145000 PERFORM FAIL. NC1264.2 +145100 MOVE TB-16 TO COMPUTED-A. NC1264.2 +145200 MOVE "98" TO CORRECT-A. NC1264.2 +145300 GO TO LEV-WRITE-GF-2-16. NC1264.2 +145400 LEV-DELETE-GF-2-16. NC1264.2 +145500 PERFORM DE-LETE. NC1264.2 +145600 LEV-WRITE-GF-2-16. NC1264.2 +145700 MOVE "LEV-TEST-GF-2-16" TO PAR-NAME. NC1264.2 +145800 PERFORM PRINT-DETAIL. NC1264.2 +145900 LEV-TEST-GF-2-17. NC1264.2 +146000 IF TB-17 EQUAL TO "76" NC1264.2 +146100 PERFORM PASS NC1264.2 +146200 GO TO LEV-WRITE-GF-2-17. NC1264.2 +146300 PERFORM FAIL. NC1264.2 +146400 MOVE TB-17 TO COMPUTED-A. NC1264.2 +146500 MOVE "76" TO CORRECT-A. NC1264.2 +146600 GO TO LEV-WRITE-GF-2-17. NC1264.2 +146700 LEV-DELETE-GF-2-17. NC1264.2 +146800 PERFORM DE-LETE. NC1264.2 +146900 LEV-WRITE-GF-2-17. NC1264.2 +147000 MOVE "LEV-TEST-GF-2-17" TO PAR-NAME. NC1264.2 +147100 PERFORM PRINT-DETAIL. NC1264.2 +147200 LEV-TEST-GF-2-18. NC1264.2 +147300 IF TB-18 EQUAL TO "54" NC1264.2 +147400 PERFORM PASS NC1264.2 +147500 GO TO LEV-WRITE-GF-2-18. NC1264.2 +147600 PERFORM FAIL. NC1264.2 +147700 MOVE TB-18 TO COMPUTED-A. NC1264.2 +147800 MOVE "54" TO CORRECT-A. NC1264.2 +147900 GO TO LEV-WRITE-GF-2-18. NC1264.2 +148000 LEV-DELETE-GF-2-18. NC1264.2 +148100 PERFORM DE-LETE. NC1264.2 +148200 LEV-WRITE-GF-2-18. NC1264.2 +148300 MOVE "LEV-TEST-GF-2-18" TO PAR-NAME. NC1264.2 +148400 PERFORM PRINT-DETAIL. NC1264.2 +148500 LEV-TEST-GF-2-19. NC1264.2 +148600 IF TB-19 EQUAL TO "32" NC1264.2 +148700 PERFORM PASS NC1264.2 +148800 GO TO LEV-WRITE-GF-2-19. NC1264.2 +148900 PERFORM FAIL. NC1264.2 +149000 MOVE TB-19 TO COMPUTED-A. NC1264.2 +149100 MOVE "32" TO CORRECT-A. NC1264.2 +149200 GO TO LEV-WRITE-GF-2-19. NC1264.2 +149300 LEV-DELETE-GF-2-19. NC1264.2 +149400 PERFORM DE-LETE. NC1264.2 +149500 LEV-WRITE-GF-2-19. NC1264.2 +149600 MOVE "LEV-TEST-GF-2-19" TO PAR-NAME. NC1264.2 +149700 PERFORM PRINT-DETAIL. NC1264.2 +149800 LEV-TEST-GF-2-20. NC1264.2 +149900 IF TB-20 EQUAL TO "10" NC1264.2 +150000 PERFORM PASS NC1264.2 +150100 GO TO LEV-WRITE-GF-2-20. NC1264.2 +150200 PERFORM FAIL. NC1264.2 +150300 MOVE TB-20 TO COMPUTED-A. NC1264.2 +150400 MOVE "10" TO CORRECT-A. NC1264.2 +150500 GO TO LEV-WRITE-GF-2-20. NC1264.2 +150600 LEV-DELETE-GF-2-20. NC1264.2 +150700 PERFORM DE-LETE. NC1264.2 +150800 LEV-WRITE-GF-2-20. NC1264.2 +150900 MOVE "LEV-TEST-GF-2-20" TO PAR-NAME. NC1264.2 +151000 PERFORM PRINT-DETAIL. NC1264.2 +151100 LEV-TEST-GF-2-21. NC1264.2 +151200 IF TB-21 EQUAL TO "SU" NC1264.2 +151300 PERFORM PASS NC1264.2 +151400 GO TO LEV-WRITE-GF-2-21. NC1264.2 +151500 PERFORM FAIL. NC1264.2 +151600 MOVE TB-21 TO COMPUTED-A. NC1264.2 +151700 MOVE "SU" TO CORRECT-A. NC1264.2 +151800 GO TO LEV-WRITE-GF-2-21. NC1264.2 +151900 LEV-DELETE-GF-2-21. NC1264.2 +152000 PERFORM DE-LETE. NC1264.2 +152100 LEV-WRITE-GF-2-21. NC1264.2 +152200 MOVE "LEV-TEST-GF-2-21" TO PAR-NAME. NC1264.2 +152300 PERFORM PRINT-DETAIL. NC1264.2 +152400 LEV-TEST-GF-2-22. NC1264.2 +152500 IF TB-22 EQUAL TO "PE" NC1264.2 +152600 PERFORM PASS NC1264.2 +152700 GO TO LEV-WRITE-GF-2-22. NC1264.2 +152800 PERFORM FAIL. NC1264.2 +152900 MOVE TB-22 TO COMPUTED-A. NC1264.2 +153000 MOVE "PE" TO CORRECT-A. NC1264.2 +153100 GO TO LEV-WRITE-GF-2-22. NC1264.2 +153200 LEV-DELETE-GF-2-22. NC1264.2 +153300 PERFORM DE-LETE. NC1264.2 +153400 LEV-WRITE-GF-2-22. NC1264.2 +153500 MOVE "LEV-TEST-GF-2-22" TO PAR-NAME. NC1264.2 +153600 PERFORM PRINT-DETAIL. NC1264.2 +153700 LEV-TEST-GF-2-23. NC1264.2 +153800 IF TB-23 EQUAL TO "RC" NC1264.2 +153900 PERFORM PASS NC1264.2 +154000 GO TO LEV-WRITE-GF-2-23. NC1264.2 +154100 PERFORM FAIL. NC1264.2 +154200 MOVE TB-23 TO COMPUTED-A. NC1264.2 +154300 MOVE "RC" TO CORRECT-A. NC1264.2 +154400 GO TO LEV-WRITE-GF-2-23. NC1264.2 +154500 LEV-DELETE-GF-2-23. NC1264.2 +154600 PERFORM DE-LETE. NC1264.2 +154700 LEV-WRITE-GF-2-23. NC1264.2 +154800 MOVE "LEV-TEST-GF-2-23" TO PAR-NAME. NC1264.2 +154900 PERFORM PRINT-DETAIL. NC1264.2 +155000 LEV-TEST-GF-2-24. NC1264.2 +155100 IF TB-24 EQUAL TO "AL" NC1264.2 +155200 PERFORM PASS NC1264.2 +155300 GO TO LEV-WRITE-GF-2-24. NC1264.2 +155400 PERFORM FAIL. NC1264.2 +155500 MOVE TB-24 TO COMPUTED-A. NC1264.2 +155600 MOVE "AL" TO CORRECT-A. NC1264.2 +155700 GO TO LEV-WRITE-GF-2-24. NC1264.2 +155800 LEV-DELETE-GF-2-24. NC1264.2 +155900 PERFORM DE-LETE. NC1264.2 +156000 LEV-WRITE-GF-2-24. NC1264.2 +156100 MOVE "LEV-TEST-GF-2-24" TO PAR-NAME. NC1264.2 +156200 PERFORM PRINT-DETAIL. NC1264.2 +156300 LEV-TEST-GF-2-25. NC1264.2 +156400 IF TB-25 EQUAL TO "IF" NC1264.2 +156500 PERFORM PASS NC1264.2 +156600 GO TO LEV-WRITE-GF-2-25. NC1264.2 +156700 PERFORM FAIL. NC1264.2 +156800 MOVE TB-25 TO COMPUTED-A. NC1264.2 +156900 MOVE "IF" TO CORRECT-A. NC1264.2 +157000 GO TO LEV-WRITE-GF-2-25. NC1264.2 +157100 LEV-DELETE-GF-2-25. NC1264.2 +157200 PERFORM DE-LETE. NC1264.2 +157300 LEV-WRITE-GF-2-25. NC1264.2 +157400 MOVE "LEV-TEST-GF-2-25" TO PAR-NAME. NC1264.2 +157500 PERFORM PRINT-DETAIL. NC1264.2 +157600 LEV-TEST-GF-2-26. NC1264.2 +157700 IF TB-26 EQUAL TO "RA" NC1264.2 +157800 PERFORM PASS NC1264.2 +157900 GO TO LEV-WRITE-GF-2-26. NC1264.2 +158000 PERFORM FAIL. NC1264.2 +158100 MOVE TB-26 TO COMPUTED-A. NC1264.2 +158200 MOVE "RA" TO CORRECT-A. NC1264.2 +158300 GO TO LEV-WRITE-GF-2-26. NC1264.2 +158400 LEV-DELETE-GF-2-26. NC1264.2 +158500 PERFORM DE-LETE. NC1264.2 +158600 LEV-WRITE-GF-2-26. NC1264.2 +158700 MOVE "LEV-TEST-GF-2-26" TO PAR-NAME. NC1264.2 +158800 PERFORM PRINT-DETAIL. NC1264.2 +158900 LEV-TEST-GF-2-27. NC1264.2 +159000 IF TB-27 EQUAL TO "GI" NC1264.2 +159100 PERFORM PASS NC1264.2 +159200 GO TO LEV-WRITE-GF-2-27. NC1264.2 +159300 PERFORM FAIL. NC1264.2 +159400 MOVE TB-27 TO COMPUTED-A. NC1264.2 +159500 MOVE "GI" TO CORRECT-A. NC1264.2 +159600 GO TO LEV-WRITE-GF-2-27. NC1264.2 +159700 LEV-DELETE-GF-2-27. NC1264.2 +159800 PERFORM DE-LETE. NC1264.2 +159900 LEV-WRITE-GF-2-27. NC1264.2 +160000 MOVE "LEV-TEST-GF-2-27" TO PAR-NAME. NC1264.2 +160100 PERFORM PRINT-DETAIL. NC1264.2 +160200 LEV-TEST-GF-2-28. NC1264.2 +160300 IF TB-28 EQUAL TO "LI" NC1264.2 +160400 PERFORM PASS NC1264.2 +160500 GO TO LEV-WRITE-GF-2-28. NC1264.2 +160600 PERFORM FAIL. NC1264.2 +160700 MOVE TB-29 TO COMPUTED-A. NC1264.2 +160800 MOVE "LI" TO CORRECT-A. NC1264.2 +160900 GO TO LEV-WRITE-GF-2-28. NC1264.2 +161000 LEV-DELETE-GF-2-28. NC1264.2 +161100 PERFORM DE-LETE. NC1264.2 +161200 LEV-WRITE-GF-2-28. NC1264.2 +161300 MOVE "LEV-TEST-GF-2-28" TO PAR-NAME. NC1264.2 +161400 PERFORM PRINT-DETAIL. NC1264.2 +161500 LEV-TEST-GF-2-29. NC1264.2 +161600 IF TB-29 EQUAL TO "ST" NC1264.2 +161700 PERFORM PASS NC1264.2 +161800 GO TO LEV-WRITE-GF-2-29. NC1264.2 +161900 PERFORM FAIL. NC1264.2 +162000 MOVE TB-29 TO COMPUTED-A. NC1264.2 +162100 MOVE "ST" TO CORRECT-A. NC1264.2 +162200 GO TO LEV-WRITE-GF-2-29. NC1264.2 +162300 LEV-DELETE-GF-2-29. NC1264.2 +162400 PERFORM DE-LETE. NC1264.2 +162500 LEV-WRITE-GF-2-29. NC1264.2 +162600 MOVE "LEV-TEST-GF-2-29" TO PAR-NAME. NC1264.2 +162700 PERFORM PRINT-DETAIL. NC1264.2 +162800 LEV-TEST-GF-2-30. NC1264.2 +162900 IF TB-30 EQUAL TO "IC" NC1264.2 +163000 PERFORM PASS NC1264.2 +163100 GO TO LEV-WRITE-GF-2-30. NC1264.2 +163200 PERFORM FAIL. NC1264.2 +163300 MOVE TB-30 TO COMPUTED-A. NC1264.2 +163400 MOVE "IC" TO CORRECT-A. NC1264.2 +163500 GO TO LEV-WRITE-GF-2-30. NC1264.2 +163600 LEV-DELETE-GF-2-30. NC1264.2 +163700 PERFORM DE-LETE. NC1264.2 +163800 LEV-WRITE-GF-2-30. NC1264.2 +163900 MOVE "LEV-TEST-GF-2-30" TO PAR-NAME. NC1264.2 +164000 PERFORM PRINT-DETAIL. NC1264.2 +164100 LEV-TEST-GF-2-31. NC1264.2 +164200 IF TB-31 EQUAL TO "TH" NC1264.2 +164300 PERFORM PASS NC1264.2 +164400 GO TO LEV-WRITE-GF-2-31. NC1264.2 +164500 PERFORM FAIL. NC1264.2 +164600 MOVE TB-31 TO COMPUTED-A. NC1264.2 +164700 MOVE "TH" TO CORRECT-A. NC1264.2 +164800 GO TO LEV-WRITE-GF-2-31. NC1264.2 +164900 LEV-DELETE-GF-2-31. NC1264.2 +165000 PERFORM DE-LETE. NC1264.2 +165100 LEV-WRITE-GF-2-31. NC1264.2 +165200 MOVE "LEV-TEST-GF-2-31" TO PAR-NAME. NC1264.2 +165300 PERFORM PRINT-DETAIL. NC1264.2 +165400 LEV-TEST-GF-2-32. NC1264.2 +165500 IF TB-32 EQUAL TO "AT" NC1264.2 +165600 PERFORM PASS NC1264.2 +165700 GO TO LEV-WRITE-GF-2-32. NC1264.2 +165800 PERFORM FAIL. NC1264.2 +165900 MOVE TB-32 TO COMPUTED-A. NC1264.2 +166000 MOVE "AT" TO CORRECT-A. NC1264.2 +166100 GO TO LEV-WRITE-GF-2-32. NC1264.2 +166200 LEV-DELETE-GF-2-32. NC1264.2 +166300 PERFORM DE-LETE. NC1264.2 +166400 LEV-WRITE-GF-2-32. NC1264.2 +166500 MOVE "LEV-TEST-GF-2-32" TO PAR-NAME. NC1264.2 +166600 PERFORM PRINT-DETAIL. NC1264.2 +166700 LEV-TEST-GF-2-33. NC1264.2 +166800 IF TB-33 EQUAL TO " L" NC1264.2 +166900 PERFORM PASS NC1264.2 +167000 GO TO LEV-WRITE-GF-2-33. NC1264.2 +167100 PERFORM FAIL. NC1264.2 +167200 MOVE TB-33 TO COMPUTED-A. NC1264.2 +167300 MOVE " L" TO CORRECT-A. NC1264.2 +167400 GO TO LEV-WRITE-GF-2-33. NC1264.2 +167500 LEV-DELETE-GF-2-33. NC1264.2 +167600 PERFORM DE-LETE. NC1264.2 +167700 LEV-WRITE-GF-2-33. NC1264.2 +167800 MOVE "LEV-TEST-GF-2-33" TO PAR-NAME. NC1264.2 +167900 PERFORM PRINT-DETAIL. NC1264.2 +168000 LEV-TEST-GF-2-34. NC1264.2 +168100 IF TB-34 EQUAL TO "IT" NC1264.2 +168200 PERFORM PASS NC1264.2 +168300 GO TO LEV-WRITE-GF-2-34. NC1264.2 +168400 PERFORM FAIL. NC1264.2 +168500 MOVE TB-34 TO COMPUTED-A. NC1264.2 +168600 MOVE "IT" TO CORRECT-A. NC1264.2 +168700 GO TO LEV-WRITE-GF-2-34. NC1264.2 +168800 LEV-DELETE-GF-2-34. NC1264.2 +168900 PERFORM DE-LETE. NC1264.2 +169000 LEV-WRITE-GF-2-34. NC1264.2 +169100 MOVE "LEV-TEST-GF-2-34" TO PAR-NAME. NC1264.2 +169200 PERFORM PRINT-DETAIL. NC1264.2 +169300 LEV-TEST-GF-2-35. NC1264.2 +169400 IF TB-35 EQUAL TO "ER" NC1264.2 +169500 PERFORM PASS NC1264.2 +169600 GO TO LEV-WRITE-GF-2-35. NC1264.2 +169700 PERFORM FAIL. NC1264.2 +169800 MOVE TB-35 TO COMPUTED-A. NC1264.2 +169900 MOVE "ER" TO CORRECT-A. NC1264.2 +170000 GO TO LEV-WRITE-GF-2-35. NC1264.2 +170100 LEV-DELETE-GF-2-35. NC1264.2 +170200 PERFORM DE-LETE. NC1264.2 +170300 LEV-WRITE-GF-2-35. NC1264.2 +170400 MOVE "LEV-TEST-GF-2-35" TO PAR-NAME. NC1264.2 +170500 PERFORM PRINT-DETAIL. NC1264.2 +170600 LEV-TEST-GF-2-36. NC1264.2 +170700 IF TB-36 EQUAL TO "AL" NC1264.2 +170800 PERFORM PASS NC1264.2 +170900 GO TO LEV-WRITE-GF-2-36. NC1264.2 +171000 PERFORM FAIL. NC1264.2 +171100 MOVE TB-36 TO COMPUTED-A. NC1264.2 +171200 MOVE "AL" TO CORRECT-A. NC1264.2 +171300 GO TO LEV-WRITE-GF-2-36. NC1264.2 +171400 LEV-DELETE-GF-2-36. NC1264.2 +171500 PERFORM DE-LETE. NC1264.2 +171600 LEV-WRITE-GF-2-36. NC1264.2 +171700 MOVE "LEV-TEST-GF-2-36" TO PAR-NAME. NC1264.2 +171800 PERFORM PRINT-DETAIL. NC1264.2 +171900 LEV-TEST-GF-2-37. NC1264.2 +172000 IF TB-37 EQUAL TO " W" NC1264.2 +172100 PERFORM PASS NC1264.2 +172200 GO TO LEV-WRITE-GF-2-37. NC1264.2 +172300 PERFORM FAIL. NC1264.2 +172400 MOVE TB-37 TO COMPUTED-A. NC1264.2 +172500 MOVE " W" TO CORRECT-A. NC1264.2 +172600 GO TO LEV-WRITE-GF-2-37. NC1264.2 +172700 LEV-DELETE-GF-2-37. NC1264.2 +172800 PERFORM DE-LETE. NC1264.2 +172900 LEV-WRITE-GF-2-37. NC1264.2 +173000 MOVE "LEV-TEST-GF-2-37" TO PAR-NAME. NC1264.2 +173100 PERFORM PRINT-DETAIL. NC1264.2 +173200 LEV-TEST-GF-2-38. NC1264.2 +173300 IF TB-38 EQUAL TO "AS" NC1264.2 +173400 PERFORM PASS NC1264.2 +173500 GO TO LEV-WRITE-GF-2-38. NC1264.2 +173600 PERFORM FAIL. NC1264.2 +173700 MOVE TB-38 TO COMPUTED-A. NC1264.2 +173800 MOVE "AS" TO CORRECT-A. NC1264.2 +173900 GO TO LEV-WRITE-GF-2-38. NC1264.2 +174000 LEV-DELETE-GF-2-38. NC1264.2 +174100 PERFORM DE-LETE. NC1264.2 +174200 LEV-WRITE-GF-2-38. NC1264.2 +174300 MOVE "LEV-TEST-GF-2-38" TO PAR-NAME. NC1264.2 +174400 PERFORM PRINT-DETAIL. NC1264.2 +174500 LEV-TEST-GF-2-39. NC1264.2 +174600 IF TB-39 EQUAL TO " B" NC1264.2 +174700 PERFORM PASS NC1264.2 +174800 GO TO LEV-WRITE-GF-2-39. NC1264.2 +174900 PERFORM FAIL. NC1264.2 +175000 MOVE TB-39 TO COMPUTED-A. NC1264.2 +175100 MOVE " B" TO CORRECT-A. NC1264.2 +175200 GO TO LEV-WRITE-GF-2-39. NC1264.2 +175300 LEV-DELETE-GF-2-39. NC1264.2 +175400 PERFORM DE-LETE. NC1264.2 +175500 LEV-WRITE-GF-2-39. NC1264.2 +175600 MOVE "LEV-TEST-GF-2-39" TO PAR-NAME. NC1264.2 +175700 PERFORM PRINT-DETAIL. NC1264.2 +175800 LEV-TEST-GF-2-40. NC1264.2 +175900 IF TB-40 EQUAL TO "AD" NC1264.2 +176000 PERFORM PASS NC1264.2 +176100 GO TO LEV-WRITE-GF-2-40. NC1264.2 +176200 PERFORM FAIL. NC1264.2 +176300 MOVE TB-40 TO COMPUTED-A. NC1264.2 +176400 MOVE "AD" TO CORRECT-A. NC1264.2 +176500 GO TO LEV-WRITE-GF-2-40. NC1264.2 +176600 LEV-DELETE-GF-2-40. NC1264.2 +176700 PERFORM DE-LETE. NC1264.2 +176800 LEV-WRITE-GF-2-40. NC1264.2 +176900 MOVE "LEV-TEST-GF-2-40" TO PAR-NAME. NC1264.2 +177000 PERFORM PRINT-DETAIL. NC1264.2 +177100 LEV-TEST-GF-2-41. NC1264.2 +177200 IF TB-41 EQUAL TO "UP" NC1264.2 +177300 PERFORM PASS NC1264.2 +177400 GO TO LEV-WRITE-GF-2-41. NC1264.2 +177500 PERFORM FAIL. NC1264.2 +177600 MOVE TB-41 TO COMPUTED-A. NC1264.2 +177700 MOVE "UP" TO CORRECT-A. NC1264.2 +177800 GO TO LEV-WRITE-GF-2-41. NC1264.2 +177900 LEV-DELETE-GF-2-41. NC1264.2 +178000 PERFORM DE-LETE. NC1264.2 +178100 LEV-WRITE-GF-2-41. NC1264.2 +178200 MOVE "LEV-TEST-GF-2-41" TO PAR-NAME. NC1264.2 +178300 PERFORM PRINT-DETAIL. NC1264.2 +178400 LEV-TEST-GF-2-42. NC1264.2 +178500 IF TB-42 EQUAL TO " O" NC1264.2 +178600 PERFORM PASS NC1264.2 +178700 GO TO LEV-WRITE-GF-2-42. NC1264.2 +178800 PERFORM FAIL. NC1264.2 +178900 MOVE TB-42 TO COMPUTED-A. NC1264.2 +179000 MOVE " O" TO CORRECT-A. NC1264.2 +179100 GO TO LEV-WRITE-GF-2-42. NC1264.2 +179200 LEV-DELETE-GF-2-42. NC1264.2 +179300 PERFORM DE-LETE. NC1264.2 +179400 LEV-WRITE-GF-2-42. NC1264.2 +179500 MOVE "LEV-TEST-GF-2-42" TO PAR-NAME. NC1264.2 +179600 PERFORM PRINT-DETAIL. NC1264.2 +179700 LEV-TEST-GF-2-43. NC1264.2 +179800 IF TB-43 EQUAL TO "N " NC1264.2 +179900 PERFORM PASS NC1264.2 +180000 GO TO LEV-WRITE-GF-2-43. NC1264.2 +180100 PERFORM FAIL. NC1264.2 +180200 MOVE TB-43 TO COMPUTED-A. NC1264.2 +180300 MOVE "N " TO CORRECT-A. NC1264.2 +180400 GO TO LEV-WRITE-GF-2-43. NC1264.2 +180500 LEV-DELETE-GF-2-43. NC1264.2 +180600 PERFORM DE-LETE. NC1264.2 +180700 LEV-WRITE-GF-2-43. NC1264.2 +180800 MOVE "LEV-TEST-GF-2-43" TO PAR-NAME. NC1264.2 +180900 PERFORM PRINT-DETAIL. NC1264.2 +181000 LEV-TEST-GF-2-44. NC1264.2 +181100 IF TB-44 EQUAL TO "TH" NC1264.2 +181200 PERFORM PASS NC1264.2 +181300 GO TO LEV-WRITE-GF-2-44. NC1264.2 +181400 PERFORM FAIL. NC1264.2 +181500 MOVE TB-44 TO COMPUTED-A. NC1264.2 +181600 MOVE "TH" TO CORRECT-A. NC1264.2 +181700 GO TO LEV-WRITE-GF-2-44. NC1264.2 +181800 LEV-DELETE-GF-2-44. NC1264.2 +181900 PERFORM DE-LETE. NC1264.2 +182000 LEV-WRITE-GF-2-44. NC1264.2 +182100 MOVE "LEV-TEST-GF-2-44" TO PAR-NAME. NC1264.2 +182200 PERFORM PRINT-DETAIL. NC1264.2 +182300 LEV-TEST-GF-2-45. NC1264.2 +182400 IF TB-45 EQUAL TO "E " NC1264.2 +182500 PERFORM PASS NC1264.2 +182600 GO TO LEV-WRITE-GF-2-45. NC1264.2 +182700 PERFORM FAIL. NC1264.2 +182800 MOVE TB-45 TO COMPUTED-A. NC1264.2 +182900 MOVE "E " TO CORRECT-A. NC1264.2 +183000 GO TO LEV-WRITE-GF-2-45. NC1264.2 +183100 LEV-DELETE-GF-2-45. NC1264.2 +183200 PERFORM DE-LETE. NC1264.2 +183300 LEV-WRITE-GF-2-45. NC1264.2 +183400 MOVE "LEV-TEST-GF-2-45" TO PAR-NAME. NC1264.2 +183500 PERFORM PRINT-DETAIL. NC1264.2 +183600 LEV-TEST-GF-2-46. NC1264.2 +183700 IF TB-46 EQUAL TO "RO" NC1264.2 +183800 PERFORM PASS NC1264.2 +183900 GO TO LEV-WRITE-GF-2-46. NC1264.2 +184000 PERFORM FAIL. NC1264.2 +184100 MOVE TB-46 TO COMPUTED-A. NC1264.2 +184200 MOVE "RO" TO CORRECT-A. NC1264.2 +184300 GO TO LEV-WRITE-GF-2-46. NC1264.2 +184400 LEV-DELETE-GF-2-46. NC1264.2 +184500 PERFORM DE-LETE. NC1264.2 +184600 LEV-WRITE-GF-2-46. NC1264.2 +184700 MOVE "LEV-TEST-GF-2-46" TO PAR-NAME. NC1264.2 +184800 PERFORM PRINT-DETAIL. NC1264.2 +184900 LEV-TEST-GF-2-47. NC1264.2 +185000 IF TB-47 EQUAL TO "OF" NC1264.2 +185100 PERFORM PASS NC1264.2 +185200 GO TO LEV-WRITE-GF-2-47. NC1264.2 +185300 PERFORM FAIL. NC1264.2 +185400 MOVE TB-47 TO COMPUTED-A. NC1264.2 +185500 MOVE "OF" TO CORRECT-A. NC1264.2 +185600 GO TO LEV-WRITE-GF-2-47. NC1264.2 +185700 LEV-DELETE-GF-2-47. NC1264.2 +185800 PERFORM DE-LETE. NC1264.2 +185900 LEV-WRITE-GF-2-47. NC1264.2 +186000 MOVE "LEV-TEST-GF-2-47" TO PAR-NAME. NC1264.2 +186100 PERFORM PRINT-DETAIL. NC1264.2 +186200 LEV-TEST-GF-2-48. NC1264.2 +186300 IF TB-48 EQUAL TO "S " NC1264.2 +186400 PERFORM PASS NC1264.2 +186500 GO TO LEV-WRITE-GF-2-48. NC1264.2 +186600 PERFORM FAIL. NC1264.2 +186700 MOVE TB-48 TO COMPUTED-A. NC1264.2 +186800 MOVE "S " TO CORRECT-A. NC1264.2 +186900 GO TO LEV-WRITE-GF-2-48. NC1264.2 +187000 LEV-DELETE-GF-2-48. NC1264.2 +187100 PERFORM DE-LETE. NC1264.2 +187200 LEV-WRITE-GF-2-48. NC1264.2 +187300 MOVE "LEV-TEST-GF-2-48" TO PAR-NAME. NC1264.2 +187400 PERFORM PRINT-DETAIL. NC1264.2 +187500 LEV-INIT-GF-3-1. NC1264.2 +187600 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +187700 PERFORM END-ROUTINE. NC1264.2 +187800 MOVE SPACE TO PRINT-REC. NC1264.2 +187900 MOVE "NUMERIC MOVED TO GRP" TO FEATURE. NC1264.2 +188000 PERFORM PRINT-DETAIL. NC1264.2 +188100 MOVE "ELEMENTRY ITEM CHK" TO FEATURE. NC1264.2 +188200 MOVE 000046 TO GP-1. NC1264.2 +188300 MOVE 12345678902 TO GP-2. NC1264.2 +188400 MOVE 121619492 TO GP-3. NC1264.2 +188500 MOVE 0109 TO GP-4. NC1264.2 +188600 MOVE 6645143 TO GP-5. NC1264.2 +188700 MOVE 000096 TO GP-6. NC1264.2 +188800 MOVE -4361 TO GP-7. NC1264.2 +188900 MOVE "PROGRAM DIVISI" TO GP-8. NC1264.2 +189000 MOVE "NPLD" TO GP-9. NC1264.2 +189100 MOVE 770 TO GP-10. NC1264.2 +189200 MOVE 5604 TO GP-11. NC1264.2 +189300 MOVE ZERO TO GP-12. NC1264.2 +189400 MOVE 0004 TO GP-13. NC1264.2 +189500 MOVE "KLOP" TO GP-14. NC1264.2 +189600 MOVE 12345678902 TO GP-15. NC1264.2 +189700 MOVE ZERO TO GP-16. NC1264.2 +189800 MOVE 1972 TO GP-17. NC1264.2 +189900 MOVE -0042 TO GP-18. NC1264.2 +190000 MOVE ZERO TO GP-19. NC1264.2 +190100 MOVE 492 TO GP-20. NC1264.2 +190200 MOVE SPACE TO GP-21. NC1264.2 +190300 MOVE 040290 TO GP-22. NC1264.2 +190400 MOVE "9A8B7C" TO GP-23. NC1264.2 +190500 MOVE 040290 TO GP-24. NC1264.2 +190600 MOVE 289 TO GP-25. NC1264.2 +190700 MOVE 2251 TO GP-26. NC1264.2 +190800 MOVE 1692 TO GP-27. NC1264.2 +190900 MOVE 00000041 TO GP-28. NC1264.2 +191000 MOVE 00001 TO GP-29. NC1264.2 +191100 MOVE ZERO TO GP-30. NC1264.2 +191200 MOVE ZERO TO GP-31. NC1264.2 +191300 MOVE 000 TO GP-32. NC1264.2 +191400 MOVE ZERO TO GP-33. NC1264.2 +191500 MOVE 21 TO GP-34. NC1264.2 +191600 MOVE 36 TO GP-35. NC1264.2 +191700 MOVE 918 TO GP-36. NC1264.2 +191800 MOVE ZERO TO GP-37. NC1264.2 +191900 MOVE -36 TO GP-38. NC1264.2 +192000 MOVE 24 TO GP-39. NC1264.2 +192100 MOVE 36 TO GP-40. NC1264.2 +192200 MOVE -1 TO GP-41. NC1264.2 +192300 MOVE ZERO TO GP-42. NC1264.2 +192400 MOVE "AIR" TO GP-43. NC1264.2 +192500 MOVE "9ZX" TO GP-44. NC1264.2 +192600 MOVE 01000 TO GP-45. NC1264.2 +192700 MOVE 93 TO GP-46. NC1264.2 +192800 MOVE 5 TO GP-47 (1). NC1264.2 +192900 MOVE ZERO TO GP-47 (2). NC1264.2 +193000 MOVE "Y" TO GP-48 (1). NC1264.2 +193100 MOVE SPACE TO GP-48 (2). NC1264.2 +193200 LEV-TEST-GF-3-1. NC1264.2 +193300 IF GP-1 EQUAL TO " 046" NC1264.2 +193400 PERFORM PASS NC1264.2 +193500 GO TO LEV-WRITE-GF-3-1. NC1264.2 +193600 PERFORM FAIL. NC1264.2 +193700 MOVE GP-1 TO COMPUTED-A. NC1264.2 +193800 MOVE " 046" TO CORRECT-A. NC1264.2 +193900 GO TO LEV-WRITE-GF-3-1. NC1264.2 +194000 LEV-DELETE-GF-3-1. NC1264.2 +194100 PERFORM DE-LETE. NC1264.2 +194200 LEV-WRITE-GF-3-1. NC1264.2 +194300 MOVE "LEV-TEST-GF-3-1" TO PAR-NAME. NC1264.2 +194400 PERFORM PRINT-DETAIL. NC1264.2 +194500 LEV-TEST-GF-3-2. NC1264.2 +194600 IF GP-2 EQUAL TO "345678902.00" NC1264.2 +194700 PERFORM PASS NC1264.2 +194800 GO TO LEV-WRITE-GF-3-2. NC1264.2 +194900 PERFORM FAIL. NC1264.2 +195000 MOVE GP-2 TO COMPUTED-A NC1264.2 +195100 MOVE "345678902.00" TO CORRECT-A. NC1264.2 +195200 GO TO LEV-WRITE-GF-3-2. NC1264.2 +195300 LEV-DELETE-GF-3-2. NC1264.2 +195400 PERFORM DE-LETE. NC1264.2 +195500 LEV-WRITE-GF-3-2. NC1264.2 +195600 MOVE "LEV-TEST-GF-3-2" TO PAR-NAME. NC1264.2 +195700 PERFORM PRINT-DETAIL. NC1264.2 +195800 LEV-TEST-GF-3-3. NC1264.2 +195900 IF GP-3 EQUAL TO "000121619492" NC1264.2 +196000 PERFORM PASS NC1264.2 +196100 GO TO LEV-WRITE-GF-3-3. NC1264.2 +196200 PERFORM FAIL. NC1264.2 +196300 MOVE GP-3 TO COMPUTED-A NC1264.2 +196400 MOVE "000121619492" TO CORRECT-A. NC1264.2 +196500 GO TO LEV-WRITE-GF-3-3. NC1264.2 +196600 LEV-DELETE-GF-3-3. NC1264.2 +196700 PERFORM DE-LETE. NC1264.2 +196800 LEV-WRITE-GF-3-3. NC1264.2 +196900 MOVE "LEV-TEST-GF-3-3" TO PAR-NAME. NC1264.2 +197000 PERFORM PRINT-DETAIL. NC1264.2 +197100 LEV-TEST-GF-3-4. NC1264.2 +197200 IF GP-4 EQUAL TO " 1 09" NC1264.2 +197300 PERFORM PASS NC1264.2 +197400 GO TO LEV-WRITE-GF-3-4. NC1264.2 +197500 PERFORM FAIL. NC1264.2 +197600 MOVE GP-4 TO COMPUTED-A NC1264.2 +197700 MOVE " 1 09" TO CORRECT-A. NC1264.2 +197800 GO TO LEV-WRITE-GF-3-4. NC1264.2 +197900 LEV-DELETE-GF-3-4. NC1264.2 +198000 PERFORM DE-LETE. NC1264.2 +198100 LEV-WRITE-GF-3-4. NC1264.2 +198200 MOVE "LEV-TEST-GF-3-4" TO PAR-NAME. NC1264.2 +198300 PERFORM PRINT-DETAIL. NC1264.2 +198400 LEV-TEST-GF-3-5. NC1264.2 +198500 IF GP-5 EQUAL TO "$45,143.00" NC1264.2 +198600 PERFORM PASS NC1264.2 +198700 GO TO LEV-WRITE-GF-3-5. NC1264.2 +198800 PERFORM FAIL. NC1264.2 +198900 MOVE GP-5 TO COMPUTED-A NC1264.2 +199000 MOVE "$45,143.00" TO CORRECT-A. NC1264.2 +199100 GO TO LEV-WRITE-GF-3-5. NC1264.2 +199200 LEV-DELETE-GF-3-5. NC1264.2 +199300 PERFORM DE-LETE. NC1264.2 +199400 LEV-WRITE-GF-3-5. NC1264.2 +199500 MOVE "LEV-TEST-GF-3-5" TO PAR-NAME. NC1264.2 +199600 PERFORM PRINT-DETAIL. NC1264.2 +199700 LEV-TEST-GF-3-6. NC1264.2 +199800 IF GP-6 EQUAL TO "******96" NC1264.2 +199900 PERFORM PASS NC1264.2 +200000 GO TO LEV-WRITE-GF-3-6. NC1264.2 +200100 PERFORM FAIL. NC1264.2 +200200 MOVE GP-6 TO COMPUTED-A NC1264.2 +200300 MOVE "******96" TO CORRECT-A. NC1264.2 +200400 GO TO LEV-WRITE-GF-3-6. NC1264.2 +200500 LEV-DELETE-GF-3-6. NC1264.2 +200600 PERFORM DE-LETE. NC1264.2 +200700 LEV-WRITE-GF-3-6. NC1264.2 +200800 MOVE "LEV-TEST-GF-3-6" TO PAR-NAME. NC1264.2 +200900 PERFORM PRINT-DETAIL. NC1264.2 +201000 LEV-TEST-GF-3-7. NC1264.2 +201100 IF GP-7 EQUAL TO "-004,361" NC1264.2 +201200 PERFORM PASS NC1264.2 +201300 GO TO LEV-WRITE-GF-3-7. NC1264.2 +201400 PERFORM FAIL. NC1264.2 +201500 MOVE GP-7 TO COMPUTED-A NC1264.2 +201600 MOVE "-004,361" TO CORRECT-A. NC1264.2 +201700 GO TO LEV-WRITE-GF-3-7. NC1264.2 +201800 LEV-DELETE-GF-3-7. NC1264.2 +201900 PERFORM DE-LETE. NC1264.2 +202000 LEV-WRITE-GF-3-7. NC1264.2 +202100 MOVE "LEV-TEST-GF-3-7" TO PAR-NAME. NC1264.2 +202200 PERFORM PRINT-DETAIL. NC1264.2 +202300 LEV-TEST-GF-3-8. NC1264.2 +202400 IF GP-8 EQUAL TO "PROGRAM DIVISI" NC1264.2 +202500 PERFORM PASS NC1264.2 +202600 GO TO LEV-WRITE-GF-3-8. NC1264.2 +202700 PERFORM FAIL. NC1264.2 +202800 MOVE "PROGRAM DIVISI" TO CORRECT-A. NC1264.2 +202900 GO TO LEV-WRITE-GF-3-8. NC1264.2 +203000 LEV-DELETE-GF-3-8. NC1264.2 +203100 PERFORM DE-LETE. NC1264.2 +203200 LEV-WRITE-GF-3-8. NC1264.2 +203300 MOVE "LEV-TEST-GF-3-8" TO PAR-NAME. NC1264.2 +203400 PERFORM PRINT-DETAIL. NC1264.2 +203500 LEV-TEST-GF-3-9. NC1264.2 +203600 IF GP-9 EQUAL TO "N P L D" NC1264.2 +203700 PERFORM PASS NC1264.2 +203800 GO TO LEV-WRITE-GF-3-9. NC1264.2 +203900 PERFORM FAIL. NC1264.2 +204000 MOVE GP-9 TO COMPUTED-A NC1264.2 +204100 MOVE "N P L D" TO CORRECT-A. NC1264.2 +204200 GO TO LEV-WRITE-GF-3-9. NC1264.2 +204300 LEV-DELETE-GF-3-9. NC1264.2 +204400 PERFORM DE-LETE. NC1264.2 +204500 LEV-WRITE-GF-3-9. NC1264.2 +204600 MOVE "LEV-TEST-GF-3-9" TO PAR-NAME. NC1264.2 +204700 PERFORM PRINT-DETAIL. NC1264.2 +204800 LEV-TEST-GF-3-10. NC1264.2 +204900 IF GP-10 EQUAL TO "7070000" NC1264.2 +205000 PERFORM PASS NC1264.2 +205100 GO TO LEV-WRITE-GF-3-10. NC1264.2 +205200 PERFORM FAIL. NC1264.2 +205300 MOVE GP-10 TO COMPUTED-A NC1264.2 +205400 MOVE "7070000" TO CORRECT-A. NC1264.2 +205500 GO TO LEV-WRITE-GF-3-10. NC1264.2 +205600 LEV-DELETE-GF-3-10. NC1264.2 +205700 PERFORM DE-LETE. NC1264.2 +205800 LEV-WRITE-GF-3-10. NC1264.2 +205900 MOVE "LEV-TEST-GF-3-10" TO PAR-NAME. NC1264.2 +206000 PERFORM PRINT-DETAIL. NC1264.2 +206100 LEV-TEST-GF-3-11. NC1264.2 +206200 IF GP-11 EQUAL TO "$005,604.00" NC1264.2 +206300 PERFORM PASS NC1264.2 +206400 GO TO LEV-WRITE-GF-3-11. NC1264.2 +206500 PERFORM FAIL. NC1264.2 +206600 MOVE GP-11 TO COMPUTED-A. NC1264.2 +206700 MOVE "$005,604.00" TO CORRECT-A. NC1264.2 +206800 GO TO LEV-WRITE-GF-3-11. NC1264.2 +206900 LEV-DELETE-GF-3-11. NC1264.2 +207000 PERFORM DE-LETE. NC1264.2 +207100 LEV-WRITE-GF-3-11. NC1264.2 +207200 MOVE "LEV-TEST-GF-3-11" TO PAR-NAME. NC1264.2 +207300 PERFORM PRINT-DETAIL. NC1264.2 +207400 LEV-TEST-GF-3-12. NC1264.2 +207500 IF GP-12 EQUAL TO " .0" NC1264.2 +207600 PERFORM PASS NC1264.2 +207700 GO TO LEV-WRITE-GF-3-12. NC1264.2 +207800 PERFORM FAIL. NC1264.2 +207900 MOVE GP-12 TO COMPUTED-A NC1264.2 +208000 MOVE " .0" TO CORRECT-A. NC1264.2 +208100 GO TO LEV-WRITE-GF-3-12. NC1264.2 +208200 LEV-DELETE-GF-3-12. NC1264.2 +208300 PERFORM DE-LETE. NC1264.2 +208400 LEV-WRITE-GF-3-12. NC1264.2 +208500 MOVE "LEV-TEST-GF-3-12" TO PAR-NAME. NC1264.2 +208600 PERFORM PRINT-DETAIL. NC1264.2 +208700 LEV-TEST-GF-3-13. NC1264.2 +208800 IF GP-13 EQUAL TO " 0 400" NC1264.2 +208900 PERFORM PASS NC1264.2 +209000 GO TO LEV-WRITE-GF-3-13. NC1264.2 +209100 PERFORM FAIL. NC1264.2 +209200 MOVE GP-13 TO COMPUTED-A. NC1264.2 +209300 MOVE " 0 400" TO CORRECT-A. NC1264.2 +209400 GO TO LEV-WRITE-GF-3-13. NC1264.2 +209500 LEV-DELETE-GF-3-13. NC1264.2 +209600 PERFORM DE-LETE. NC1264.2 +209700 LEV-WRITE-GF-3-13. NC1264.2 +209800 MOVE "LEV-TEST-GF-3-13" TO PAR-NAME. NC1264.2 +209900 PERFORM PRINT-DETAIL. NC1264.2 +210000 LEV-TEST-GF-3-14. NC1264.2 +210100 IF GP-14 EQUAL TO "KLOP" NC1264.2 +210200 PERFORM PASS NC1264.2 +210300 GO TO LEV-WRITE-GF-3-14. NC1264.2 +210400 PERFORM FAIL. NC1264.2 +210500 MOVE GP-14 TO COMPUTED-A NC1264.2 +210600 MOVE "KLOP" TO CORRECT-A. NC1264.2 +210700 GO TO LEV-WRITE-GF-3-14. NC1264.2 +210800 LEV-DELETE-GF-3-14. NC1264.2 +210900 PERFORM DE-LETE. NC1264.2 +211000 LEV-WRITE-GF-3-14. NC1264.2 +211100 MOVE "LEV-TEST-GF-3-14" TO PAR-NAME. NC1264.2 +211200 PERFORM PRINT-DETAIL. NC1264.2 +211300 LEV-TEST-GF-3-15. NC1264.2 +211400 IF GP-15 EQUAL TO "2345678902" NC1264.2 +211500 PERFORM PASS NC1264.2 +211600 GO TO LEV-WRITE-GF-3-15. NC1264.2 +211700 PERFORM FAIL. NC1264.2 +211800 MOVE GP-15 TO COMPUTED-A. NC1264.2 +211900 MOVE "2345678902" TO CORRECT-A. NC1264.2 +212000 GO TO LEV-WRITE-GF-3-15. NC1264.2 +212100 LEV-DELETE-GF-3-15. NC1264.2 +212200 PERFORM DE-LETE. NC1264.2 +212300 LEV-WRITE-GF-3-15. NC1264.2 +212400 MOVE "LEV-TEST-GF-3-15" TO PAR-NAME. NC1264.2 +212500 PERFORM PRINT-DETAIL. NC1264.2 +212600 LEV-TEST-GF-3-16. NC1264.2 +212700 IF GP-16 EQUAL TO SPACE NC1264.2 +212800 PERFORM PASS NC1264.2 +212900 GO TO LEV-WRITE-GF-3-16. NC1264.2 +213000 PERFORM FAIL. NC1264.2 +213100 MOVE GP-16 TO COMPUTED-A NC1264.2 +213200 MOVE "SPACE" TO CORRECT-A. NC1264.2 +213300 GO TO LEV-WRITE-GF-3-16. NC1264.2 +213400 LEV-DELETE-GF-3-16. NC1264.2 +213500 PERFORM DE-LETE. NC1264.2 +213600 LEV-WRITE-GF-3-16. NC1264.2 +213700 MOVE "LEV-TEST-GF-3-16" TO PAR-NAME. NC1264.2 +213800 PERFORM PRINT-DETAIL. NC1264.2 +213900 LEV-TEST-GF-3-17. NC1264.2 +214000 IF GP-17 EQUAL TO "19 702" NC1264.2 +214100 PERFORM PASS NC1264.2 +214200 GO TO LEV-WRITE-GF-3-17. NC1264.2 +214300 PERFORM FAIL. NC1264.2 +214400 MOVE GP-17 TO COMPUTED-A. NC1264.2 +214500 MOVE "19 702" TO CORRECT-A. NC1264.2 +214600 GO TO LEV-WRITE-GF-3-17. NC1264.2 +214700 LEV-DELETE-GF-3-17. NC1264.2 +214800 PERFORM DE-LETE. NC1264.2 +214900 LEV-WRITE-GF-3-17. NC1264.2 +215000 MOVE "LEV-TEST-GF-3-17" TO PAR-NAME. NC1264.2 +215100 PERFORM PRINT-DETAIL. NC1264.2 +215200 LEV-TEST-GF-3-18. NC1264.2 +215300 IF GP-18 EQUAL TO "-***42" NC1264.2 +215400 PERFORM PASS NC1264.2 +215500 GO TO LEV-WRITE-GF-3-18. NC1264.2 +215600 PERFORM FAIL. NC1264.2 +215700 MOVE GP-18 TO COMPUTED-A NC1264.2 +215800 MOVE "-***42" TO CORRECT-A. NC1264.2 +215900 GO TO LEV-WRITE-GF-3-18. NC1264.2 +216000 LEV-DELETE-GF-3-18. NC1264.2 +216100 PERFORM DE-LETE. NC1264.2 +216200 LEV-WRITE-GF-3-18. NC1264.2 +216300 MOVE "LEV-TEST-GF-3-18" TO PAR-NAME. NC1264.2 +216400 PERFORM PRINT-DETAIL. NC1264.2 +216500 LEV-TEST-GF-3-19. NC1264.2 +216600 IF GP-19 EQUAL TO ZERO NC1264.2 +216700 PERFORM PASS NC1264.2 +216800 GO TO LEV-WRITE-GF-3-19. NC1264.2 +216900 PERFORM FAIL. NC1264.2 +217000 MOVE GP-19 TO COMPUTED-A. NC1264.2 +217100 MOVE "0000000" TO CORRECT-A. NC1264.2 +217200 GO TO LEV-WRITE-GF-3-19. NC1264.2 +217300 LEV-DELETE-GF-3-19. NC1264.2 +217400 PERFORM DE-LETE. NC1264.2 +217500 LEV-WRITE-GF-3-19. NC1264.2 +217600 MOVE "LEV-TEST-GF-3-19" TO PAR-NAME. NC1264.2 +217700 PERFORM PRINT-DETAIL. NC1264.2 +217800 LEV-TEST-GF-3-20. NC1264.2 +217900 IF GP-20 EQUAL TO "492 " NC1264.2 +218000 PERFORM PASS NC1264.2 +218100 GO TO LEV-WRITE-GF-3-20. NC1264.2 +218200 PERFORM FAIL. NC1264.2 +218300 MOVE GP-20 TO COMPUTED-A NC1264.2 +218400 MOVE "492 " TO CORRECT-A. NC1264.2 +218500 GO TO LEV-WRITE-GF-3-20. NC1264.2 +218600 LEV-DELETE-GF-3-20. NC1264.2 +218700 PERFORM DE-LETE. NC1264.2 +218800 LEV-WRITE-GF-3-20. NC1264.2 +218900 MOVE "LEV-TEST-GF-3-20" TO PAR-NAME. NC1264.2 +219000 PERFORM PRINT-DETAIL. NC1264.2 +219100 LEV-TEST-GF-3-21. NC1264.2 +219200 IF GP-21 EQUAL TO SPACE NC1264.2 +219300 PERFORM PASS NC1264.2 +219400 GO TO LEV-WRITE-GF-3-21. NC1264.2 +219500 PERFORM FAIL. NC1264.2 +219600 MOVE GP-20 TO COMPUTED-A NC1264.2 +219700 MOVE "SPACE" TO CORRECT-A. NC1264.2 +219800 GO TO LEV-WRITE-GF-3-21. NC1264.2 +219900 LEV-DELETE-GF-3-21. NC1264.2 +220000 PERFORM DE-LETE. NC1264.2 +220100 LEV-WRITE-GF-3-21. NC1264.2 +220200 MOVE "LEV-TEST-GF-3-21" TO PAR-NAME. NC1264.2 +220300 PERFORM PRINT-DETAIL. NC1264.2 +220400 LEV-TEST-GF-3-22. NC1264.2 +220500 IF GP-22 EQUAL TO "*040290" NC1264.2 +220600 PERFORM PASS NC1264.2 +220700 GO TO LEV-WRITE-GF-3-22. NC1264.2 +220800 PERFORM FAIL NC1264.2 +220900 MOVE GP-22 TO COMPUTED-A NC1264.2 +221000 MOVE "*040290" TO CORRECT-A. NC1264.2 +221100 GO TO LEV-WRITE-GF-3-22. NC1264.2 +221200 LEV-DELETE-GF-3-22. NC1264.2 +221300 PERFORM DE-LETE. NC1264.2 +221400 LEV-WRITE-GF-3-22. NC1264.2 +221500 MOVE "LEV-TEST-GF-3-22" TO PAR-NAME. NC1264.2 +221600 PERFORM PRINT-DETAIL. NC1264.2 +221700 LEV-TEST-GF-3-23. NC1264.2 +221800 IF GP-23 EQUAL TO "9A8B7C" NC1264.2 +221900 PERFORM PASS NC1264.2 +222000 GO TO LEV-WRITE-GF-3-23. NC1264.2 +222100 PERFORM FAIL. NC1264.2 +222200 MOVE GP-23 TO COMPUTED-A NC1264.2 +222300 MOVE "9A8B7C" TO CORRECT-A. NC1264.2 +222400 GO TO LEV-WRITE-GF-3-23. NC1264.2 +222500 LEV-DELETE-GF-3-23. NC1264.2 +222600 PERFORM DE-LETE. NC1264.2 +222700 LEV-WRITE-GF-3-23. NC1264.2 +222800 MOVE "LEV-TEST-GF-3-23" TO PAR-NAME. NC1264.2 +222900 PERFORM PRINT-DETAIL. NC1264.2 +223000 LEV-TEST-GF-3-24. NC1264.2 +223100 IF GP-24 EQUAL TO "$40,290.00" NC1264.2 +223200 PERFORM PASS NC1264.2 +223300 GO TO LEV-WRITE-GF-3-24. NC1264.2 +223400 PERFORM FAIL. NC1264.2 +223500 MOVE GP-24 TO COMPUTED-A NC1264.2 +223600 MOVE "$40,290.00" TO CORRECT-A. NC1264.2 +223700 GO TO LEV-WRITE-GF-3-24. NC1264.2 +223800 LEV-DELETE-GF-3-24. NC1264.2 +223900 PERFORM DE-LETE. NC1264.2 +224000 LEV-WRITE-GF-3-24. NC1264.2 +224100 MOVE "LEV-TEST-GF-3-24" TO PAR-NAME. NC1264.2 +224200 PERFORM PRINT-DETAIL. NC1264.2 +224300 LEV-TEST-GF-3-25. NC1264.2 +224400 IF GP-25 EQUAL TO "2 8 9 " NC1264.2 +224500 PERFORM PASS NC1264.2 +224600 GO TO LEV-WRITE-GF-3-25. NC1264.2 +224700 PERFORM FAIL. NC1264.2 +224800 MOVE GP-25 TO COMPUTED-A NC1264.2 +224900 MOVE "2 8 9 " TO CORRECT-A. NC1264.2 +225000 GO TO LEV-WRITE-GF-3-25. NC1264.2 +225100 LEV-DELETE-GF-3-25. NC1264.2 +225200 PERFORM DE-LETE. NC1264.2 +225300 LEV-WRITE-GF-3-25. NC1264.2 +225400 MOVE "LEV-TEST-GF-3-25" TO PAR-NAME. NC1264.2 +225500 PERFORM PRINT-DETAIL. NC1264.2 +225600 LEV-TEST-GF-3-26. NC1264.2 +225700 IF GP-26 EQUAL TO "2250001" NC1264.2 +225800 PERFORM PASS NC1264.2 +225900 GO TO LEV-WRITE-GF-3-26. NC1264.2 +226000 PERFORM FAIL. NC1264.2 +226100 MOVE GP-26 TO COMPUTED-A NC1264.2 +226200 MOVE "2250001" TO CORRECT-A. NC1264.2 +226300 GO TO LEV-WRITE-GF-3-26. NC1264.2 +226400 LEV-DELETE-GF-3-26. NC1264.2 +226500 PERFORM DE-LETE. NC1264.2 +226600 LEV-WRITE-GF-3-26. NC1264.2 +226700 MOVE "LEV-TEST-GF-3-26" TO PAR-NAME. NC1264.2 +226800 PERFORM PRINT-DETAIL. NC1264.2 +226900 LEV-TEST-GF-3-27. NC1264.2 +227000 IF GP-27 EQUAL TO "0,001,692" NC1264.2 +227100 PERFORM PASS NC1264.2 +227200 GO TO LEV-WRITE-GF-3-27. NC1264.2 +227300 PERFORM FAIL. NC1264.2 +227400 MOVE GP-27 TO COMPUTED-A NC1264.2 +227500 MOVE "0,001,692" TO CORRECT-A. NC1264.2 +227600 GO TO LEV-WRITE-GF-3-27. NC1264.2 +227700 LEV-DELETE-GF-3-27. NC1264.2 +227800 PERFORM DE-LETE. NC1264.2 +227900 LEV-WRITE-GF-3-27. NC1264.2 +228000 MOVE "LEV-TEST-GF-3-27" TO PAR-NAME. NC1264.2 +228100 PERFORM PRINT-DETAIL. NC1264.2 +228200 LEV-TEST-GF-3-28. NC1264.2 +228300 IF GP-28 EQUAL TO "0000004,1" NC1264.2 +228400 PERFORM PASS NC1264.2 +228500 GO TO LEV-WRITE-GF-3-28. NC1264.2 +228600 PERFORM FAIL. NC1264.2 +228700 MOVE GP-28 TO COMPUTED-A. NC1264.2 +228800 MOVE "0000004,1" TO CORRECT-A. NC1264.2 +228900 GO TO LEV-WRITE-GF-3-28. NC1264.2 +229000 LEV-DELETE-GF-3-28. NC1264.2 +229100 PERFORM DE-LETE. NC1264.2 +229200 LEV-WRITE-GF-3-28. NC1264.2 +229300 MOVE "LEV-TEST-GF-3-28" TO PAR-NAME. NC1264.2 +229400 PERFORM PRINT-DETAIL. NC1264.2 +229500 LEV-TEST-GF-3-29. NC1264.2 +229600 IF GP-29 EQUAL TO "$**1.00" NC1264.2 +229700 PERFORM PASS NC1264.2 +229800 GO TO LEV-WRITE-GF-3-29. NC1264.2 +229900 PERFORM FAIL. NC1264.2 +230000 MOVE GP-29 TO COMPUTED-A NC1264.2 +230100 MOVE "$**1.00" TO CORRECT-A. NC1264.2 +230200 GO TO LEV-WRITE-GF-3-29. NC1264.2 +230300 LEV-DELETE-GF-3-29. NC1264.2 +230400 PERFORM DE-LETE. NC1264.2 +230500 LEV-WRITE-GF-3-29. NC1264.2 +230600 MOVE "LEV-TEST-GF-3-29" TO PAR-NAME. NC1264.2 +230700 PERFORM PRINT-DETAIL. NC1264.2 +230800 LEV-TEST-GF-3-30. NC1264.2 +230900 IF GP-30 EQUAL TO ZERO NC1264.2 +231000 PERFORM PASS NC1264.2 +231100 GO TO LEV-WRITE-GF-3-30. NC1264.2 +231200 PERFORM FAIL. NC1264.2 +231300 MOVE GP-30 TO COMPUTED-A NC1264.2 +231400 MOVE "000000000000000" TO CORRECT-A. NC1264.2 +231500 GO TO LEV-WRITE-GF-3-30. NC1264.2 +231600 LEV-DELETE-GF-3-30. NC1264.2 +231700 PERFORM DE-LETE. NC1264.2 +231800 LEV-WRITE-GF-3-30. NC1264.2 +231900 MOVE "LEV-TEST-GF-3-30" TO PAR-NAME. NC1264.2 +232000 PERFORM PRINT-DETAIL. NC1264.2 +232100 LEV-TEST-GF-3-31. NC1264.2 +232200 IF GP-31 EQUAL TO ZERO NC1264.2 +232300 PERFORM PASS NC1264.2 +232400 GO TO LEV-WRITE-GF-3-31. NC1264.2 +232500 PERFORM FAIL. NC1264.2 +232600 MOVE GP-31 TO COMPUTED-A NC1264.2 +232700 MOVE "SPACE" TO CORRECT-A. NC1264.2 +232800 GO TO LEV-WRITE-GF-3-31. NC1264.2 +232900 LEV-DELETE-GF-3-31. NC1264.2 +233000 PERFORM DE-LETE. NC1264.2 +233100 LEV-WRITE-GF-3-31. NC1264.2 +233200 MOVE "LEV-TEST-GF-3-31" TO PAR-NAME. NC1264.2 +233300 PERFORM PRINT-DETAIL. NC1264.2 +233400 LEV-TEST-GF-3-32. NC1264.2 +233500 IF GP-32 EQUAL TO "*00" NC1264.2 +233600 PERFORM PASS NC1264.2 +233700 GO TO LEV-WRITE-GF-3-32. NC1264.2 +233800 PERFORM FAIL. NC1264.2 +233900 MOVE GP-32 TO COMPUTED-A NC1264.2 +234000 MOVE "*00" TO CORRECT-A. NC1264.2 +234100 GO TO LEV-WRITE-GF-3-32. NC1264.2 +234200 LEV-DELETE-GF-3-32. NC1264.2 +234300 PERFORM DE-LETE. NC1264.2 +234400 LEV-WRITE-GF-3-32. NC1264.2 +234500 MOVE "LEV-TEST-GF-3-32" TO PAR-NAME. NC1264.2 +234600 PERFORM PRINT-DETAIL. NC1264.2 +234700 LEV-TEST-GF-3-33. NC1264.2 +234800 IF GP-33 EQUAL TO " 0" NC1264.2 +234900 PERFORM PASS NC1264.2 +235000 GO TO LEV-WRITE-GF-3-33. NC1264.2 +235100 PERFORM FAIL. NC1264.2 +235200 MOVE GP-33 TO COMPUTED-A NC1264.2 +235300 MOVE " 0" TO CORRECT-A. NC1264.2 +235400 GO TO LEV-WRITE-GF-3-33. NC1264.2 +235500 LEV-DELETE-GF-3-33. NC1264.2 +235600 PERFORM DE-LETE. NC1264.2 +235700 LEV-WRITE-GF-3-33. NC1264.2 +235800 MOVE "LEV-TEST-GF-3-33" TO PAR-NAME. NC1264.2 +235900 PERFORM PRINT-DETAIL. NC1264.2 +236000 LEV-TEST-GF-3-34. NC1264.2 +236100 IF GP-34 EQUAL TO " 2 1" NC1264.2 +236200 PERFORM PASS NC1264.2 +236300 GO TO LEV-WRITE-GF-3-34. NC1264.2 +236400 PERFORM FAIL. NC1264.2 +236500 MOVE GP-34 TO COMPUTED-A. NC1264.2 +236600 MOVE " 2 1" TO CORRECT-A. NC1264.2 +236700 GO TO LEV-WRITE-GF-3-34. NC1264.2 +236800 LEV-DELETE-GF-3-34. NC1264.2 +236900 PERFORM DE-LETE. NC1264.2 +237000 LEV-WRITE-GF-3-34. NC1264.2 +237100 MOVE "LEV-TEST-GF-3-34" TO PAR-NAME. NC1264.2 +237200 PERFORM PRINT-DETAIL. NC1264.2 +237300 LEV-TEST-GF-3-35. NC1264.2 +237400 IF GP-35 EQUAL TO "$00,036.00" NC1264.2 +237500 PERFORM PASS NC1264.2 +237600 GO TO LEV-WRITE-GF-3-35. NC1264.2 +237700 PERFORM FAIL. NC1264.2 +237800 MOVE GP-35 TO COMPUTED-A. NC1264.2 +237900 MOVE "$00,036.00" TO CORRECT-A. NC1264.2 +238000 GO TO LEV-WRITE-GF-3-35. NC1264.2 +238100 LEV-DELETE-GF-3-35. NC1264.2 +238200 PERFORM DE-LETE. NC1264.2 +238300 LEV-WRITE-GF-3-35. NC1264.2 +238400 MOVE "LEV-TEST-GF-3-35" TO PAR-NAME. NC1264.2 +238500 PERFORM PRINT-DETAIL. NC1264.2 +238600 LEV-TEST-GF-3-36. NC1264.2 +238700 IF GP-36 EQUAL TO "090108" NC1264.2 +238800 PERFORM PASS NC1264.2 +238900 GO TO LEV-WRITE-GF-3-36. NC1264.2 +239000 PERFORM FAIL. NC1264.2 +239100 MOVE GP-36 TO COMPUTED-A NC1264.2 +239200 MOVE "090108" TO CORRECT-A. NC1264.2 +239300 GO TO LEV-WRITE-GF-3-36. NC1264.2 +239400 LEV-DELETE-GF-3-36. NC1264.2 +239500 PERFORM DE-LETE. NC1264.2 +239600 LEV-WRITE-GF-3-36. NC1264.2 +239700 MOVE "LEV-TEST-GF-3-36" TO PAR-NAME. NC1264.2 +239800 PERFORM PRINT-DETAIL. NC1264.2 +239900 LEV-TEST-GF-3-37. NC1264.2 +240000 IF GP-37 EQUAL TO SPACE NC1264.2 +240100 PERFORM PASS NC1264.2 +240200 GO TO LEV-WRITE-GF-3-37. NC1264.2 +240300 PERFORM FAIL. NC1264.2 +240400 MOVE GP-37 TO COMPUTED-A NC1264.2 +240500 MOVE "SPACE" TO CORRECT-A. NC1264.2 +240600 GO TO LEV-WRITE-GF-3-37. NC1264.2 +240700 LEV-DELETE-GF-3-37. NC1264.2 +240800 PERFORM DE-LETE. NC1264.2 +240900 LEV-WRITE-GF-3-37. NC1264.2 +241000 MOVE "LEV-TEST-GF-3-37" TO PAR-NAME. NC1264.2 +241100 PERFORM PRINT-DETAIL. NC1264.2 +241200 LEV-TEST-GF-3-38. NC1264.2 +241300 IF GP-38 EQUAL TO "-36" NC1264.2 +241400 PERFORM PASS NC1264.2 +241500 GO TO LEV-WRITE-GF-3-38. NC1264.2 +241600 PERFORM FAIL. NC1264.2 +241700 MOVE GP-38 TO COMPUTED-A NC1264.2 +241800 MOVE "-36" TO CORRECT-A. NC1264.2 +241900 GO TO LEV-WRITE-GF-3-38. NC1264.2 +242000 LEV-DELETE-GF-3-38. NC1264.2 +242100 PERFORM DE-LETE. NC1264.2 +242200 LEV-WRITE-GF-3-38. NC1264.2 +242300 MOVE "LEV-TEST-GF-3-38" TO PAR-NAME. NC1264.2 +242400 PERFORM PRINT-DETAIL. NC1264.2 +242500 LEV-TEST-GF-3-39. NC1264.2 +242600 IF GP-39 EQUAL TO " 24" NC1264.2 +242700 PERFORM PASS NC1264.2 +242800 GO TO LEV-WRITE-GF-3-39. NC1264.2 +242900 PERFORM FAIL. NC1264.2 +243000 MOVE GP-39 TO COMPUTED-A NC1264.2 +243100 MOVE " 24" TO CORRECT-A. NC1264.2 +243200 GO TO LEV-WRITE-GF-3-39. NC1264.2 +243300 LEV-DELETE-GF-3-39. NC1264.2 +243400 PERFORM DE-LETE. NC1264.2 +243500 LEV-WRITE-GF-3-39. NC1264.2 +243600 MOVE "LEV-TEST-GF-3-39" TO PAR-NAME. NC1264.2 +243700 PERFORM PRINT-DETAIL. NC1264.2 +243800 LEV-TEST-GF-3-40. NC1264.2 +243900 IF GP-40 EQUAL TO "36 " NC1264.2 +244000 PERFORM PASS NC1264.2 +244100 GO TO LEV-WRITE-GF-3-40. NC1264.2 +244200 PERFORM FAIL. NC1264.2 +244300 MOVE GP-40 TO COMPUTED-A NC1264.2 +244400 MOVE "36 " TO CORRECT-A. NC1264.2 +244500 GO TO LEV-WRITE-GF-3-40. NC1264.2 +244600 LEV-DELETE-GF-3-40. NC1264.2 +244700 PERFORM DE-LETE. NC1264.2 +244800 LEV-WRITE-GF-3-40. NC1264.2 +244900 MOVE "LEV-TEST-GF-3-40" TO PAR-NAME. NC1264.2 +245000 PERFORM PRINT-DETAIL. NC1264.2 +245100 LEV-TEST-GF-3-41. NC1264.2 +245200 IF GP-41 EQUAL TO "01DB" NC1264.2 +245300 PERFORM PASS NC1264.2 +245400 GO TO LEV-WRITE-GF-3-41. NC1264.2 +245500 PERFORM FAIL. NC1264.2 +245600 MOVE GP-41 TO COMPUTED-A NC1264.2 +245700 MOVE "01DB" TO CORRECT-A. NC1264.2 +245800 GO TO LEV-WRITE-GF-3-41. NC1264.2 +245900 LEV-DELETE-GF-3-41. NC1264.2 +246000 PERFORM DE-LETE. NC1264.2 +246100 LEV-WRITE-GF-3-41. NC1264.2 +246200 MOVE "LEV-TEST-GF-3-41" TO PAR-NAME. NC1264.2 +246300 PERFORM PRINT-DETAIL. NC1264.2 +246400 LEV-TEST-GF-3-42. NC1264.2 +246500 IF GP-42 EQUAL TO "****" NC1264.2 +246600 PERFORM PASS NC1264.2 +246700 GO TO LEV-WRITE-GF-3-42. NC1264.2 +246800 PERFORM FAIL. NC1264.2 +246900 MOVE GP-42 TO COMPUTED-A. NC1264.2 +247000 MOVE "****" TO CORRECT-A. NC1264.2 +247100 GO TO LEV-WRITE-GF-3-42. NC1264.2 +247200 LEV-DELETE-GF-3-42. NC1264.2 +247300 PERFORM DE-LETE. NC1264.2 +247400 LEV-WRITE-GF-3-42. NC1264.2 +247500 MOVE "LEV-TEST-GF-3-42" TO PAR-NAME. NC1264.2 +247600 PERFORM PRINT-DETAIL. NC1264.2 +247700 LEV-TEST-GF-3-43. NC1264.2 +247800 IF GP-43 EQUAL TO "AIR" NC1264.2 +247900 PERFORM PASS NC1264.2 +248000 GO TO LEV-WRITE-GF-3-43. NC1264.2 +248100 PERFORM FAIL. NC1264.2 +248200 MOVE GP-43 TO COMPUTED-A NC1264.2 +248300 MOVE "AIR" TO CORRECT-A. NC1264.2 +248400 GO TO LEV-WRITE-GF-3-43. NC1264.2 +248500 LEV-DELETE-GF-3-43. NC1264.2 +248600 PERFORM DE-LETE. NC1264.2 +248700 LEV-WRITE-GF-3-43. NC1264.2 +248800 MOVE "LEV-TEST-GF-3-43" TO PAR-NAME. NC1264.2 +248900 PERFORM PRINT-DETAIL. NC1264.2 +249000 LEV-TEST-GF-3-44. NC1264.2 +249100 IF GP-44 EQUAL TO "9ZX" NC1264.2 +249200 PERFORM PASS NC1264.2 +249300 GO TO LEV-WRITE-GF-3-44. NC1264.2 +249400 PERFORM FAIL. NC1264.2 +249500 MOVE GP-44 TO COMPUTED-A NC1264.2 +249600 MOVE "9ZX" TO CORRECT-A. NC1264.2 +249700 GO TO LEV-WRITE-GF-3-44. NC1264.2 +249800 LEV-DELETE-GF-3-44. NC1264.2 +249900 PERFORM DE-LETE. NC1264.2 +250000 LEV-WRITE-GF-3-44. NC1264.2 +250100 MOVE "LEV-TEST-GF-3-44" TO PAR-NAME. NC1264.2 +250200 PERFORM PRINT-DETAIL. NC1264.2 +250300 LEV-TEST-GF-3-45. NC1264.2 +250400 IF GP-45 EQUAL TO "*1000" NC1264.2 +250500 PERFORM PASS NC1264.2 +250600 GO TO LEV-WRITE-GF-3-45. NC1264.2 +250700 PERFORM FAIL. NC1264.2 +250800 MOVE GP-45 TO COMPUTED-A NC1264.2 +250900 MOVE "*1000" TO CORRECT-A. NC1264.2 +251000 GO TO LEV-WRITE-GF-3-45. NC1264.2 +251100 LEV-DELETE-GF-3-45. NC1264.2 +251200 PERFORM DE-LETE. NC1264.2 +251300 LEV-WRITE-GF-3-45. NC1264.2 +251400 MOVE "LEV-TEST-GF-3-45" TO PAR-NAME. NC1264.2 +251500 PERFORM PRINT-DETAIL. NC1264.2 +251600 LEV-TEST-GF-3-46. NC1264.2 +251700 IF GP-46 EQUAL TO "0000000093.00" NC1264.2 +251800 PERFORM PASS NC1264.2 +251900 GO TO LEV-WRITE-GF-3-46. NC1264.2 +252000 PERFORM FAIL. NC1264.2 +252100 MOVE GP-46 TO COMPUTED-A NC1264.2 +252200 MOVE "0000000093.00" TO CORRECT-A. NC1264.2 +252300 GO TO LEV-WRITE-GF-3-46. NC1264.2 +252400 LEV-DELETE-GF-3-46. NC1264.2 +252500 PERFORM DE-LETE. NC1264.2 +252600 LEV-WRITE-GF-3-46. NC1264.2 +252700 MOVE "LEV-TEST-GF-3-46" TO PAR-NAME. NC1264.2 +252800 PERFORM PRINT-DETAIL. NC1264.2 +252900 LEV-TEST-GF-3-47. NC1264.2 +253000 IF GP-47 (1) EQUAL TO "5" NC1264.2 +253100 PERFORM PASS NC1264.2 +253200 GO TO LEV-WRITE-GF-3-47. NC1264.2 +253300 PERFORM FAIL. NC1264.2 +253400 MOVE GP-47 (1) TO COMPUTED-A. NC1264.2 +253500 MOVE "5" TO CORRECT-A. NC1264.2 +253600 GO TO LEV-WRITE-GF-3-47. NC1264.2 +253700 LEV-DELETE-GF-3-47. NC1264.2 +253800 PERFORM DE-LETE. NC1264.2 +253900 LEV-WRITE-GF-3-47. NC1264.2 +254000 MOVE "LEV-TEST-GF-3-47" TO PAR-NAME. NC1264.2 +254100 PERFORM PRINT-DETAIL. NC1264.2 +254200 LEV-TEST-GF-3-48. NC1264.2 +254300 IF GP-47 (2) EQUAL TO ZERO NC1264.2 +254400 PERFORM PASS NC1264.2 +254500 GO TO LEV-WRITE-GF-3-48. NC1264.2 +254600 PERFORM FAIL. NC1264.2 +254700 MOVE GP-47 (2) TO COMPUTED-A. NC1264.2 +254800 MOVE ZERO TO CORRECT-A. NC1264.2 +254900 GO TO LEV-WRITE-GF-3-48. NC1264.2 +255000 LEV-DELETE-GF-3-48. NC1264.2 +255100 PERFORM DE-LETE. NC1264.2 +255200 LEV-WRITE-GF-3-48. NC1264.2 +255300 MOVE "LEV-TEST-GF-3-48" TO PAR-NAME. NC1264.2 +255400 PERFORM PRINT-DETAIL. NC1264.2 +255500 LEV-TEST-GF-3-49. NC1264.2 +255600 IF GP-48 (1) EQUAL TO "Y" NC1264.2 +255700 PERFORM PASS NC1264.2 +255800 GO TO LEV-WRITE-GF-3-49. NC1264.2 +255900 PERFORM FAIL. NC1264.2 +256000 MOVE GP-48 (1) TO COMPUTED-A. NC1264.2 +256100 MOVE "Y" TO CORRECT-A. NC1264.2 +256200 GO TO LEV-WRITE-GF-3-49. NC1264.2 +256300 LEV-DELETE-GF-3-49. NC1264.2 +256400 PERFORM DE-LETE. NC1264.2 +256500 LEV-WRITE-GF-3-49. NC1264.2 +256600 MOVE "LEV-TEST-GF-3-49" TO PAR-NAME. NC1264.2 +256700 PERFORM PRINT-DETAIL. NC1264.2 +256800 LEV-TEST-GF-3-50. NC1264.2 +256900 IF GP-48 (2) EQUAL TO " " NC1264.2 +257000 PERFORM PASS NC1264.2 +257100 GO TO LEV-WRITE-GF-3-50. NC1264.2 +257200 PERFORM FAIL. NC1264.2 +257300 MOVE GP-48 (2) TO COMPUTED-A. NC1264.2 +257400 MOVE " " TO CORRECT-A. NC1264.2 +257500 GO TO LEV-WRITE-GF-3-50. NC1264.2 +257600 LEV-DELETE-GF-3-50. NC1264.2 +257700 PERFORM DE-LETE. NC1264.2 +257800 LEV-WRITE-GF-3-50. NC1264.2 +257900 MOVE "LEV-TEST-GF-3-50" TO PAR-NAME. NC1264.2 +258000 PERFORM PRINT-DETAIL. NC1264.2 +258100 GO TO CCVS-EXIT. NC1264.2 +258200 BREAKDOWN-PARA. NC1264.2 +258300 PERFORM FAIL. NC1264.2 +258400 MOVE CM-20 TO COMPUTED-A. NC1264.2 +258500 MOVE CR-20 TO CORRECT-A. NC1264.2 +258600 MOVE " 1ST 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +258700 IF LENGTH-COUNTER LESS THAN 21 GO TO BREAKDOWN-EXIT. NC1264.2 +258800 PERFORM PRINT-DETAIL. NC1264.2 +258900 MOVE CM-40 TO COMPUTED-A. NC1264.2 +259000 MOVE CR-40 TO CORRECT-A. NC1264.2 +259100 MOVE " 2ND 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +259200 IF LENGTH-COUNTER LESS THAN 41 GO TO BREAKDOWN-EXIT. NC1264.2 +259300 PERFORM PRINT-DETAIL. NC1264.2 +259400 MOVE CM-60 TO COMPUTED-A. NC1264.2 +259500 MOVE CR-60 TO CORRECT-A. NC1264.2 +259600 MOVE " 3RD 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +259700 IF LENGTH-COUNTER LESS THAN 61 GO TO BREAKDOWN-EXIT. NC1264.2 +259800 PERFORM PRINT-DETAIL. NC1264.2 +259900 MOVE CM-80 TO COMPUTED-A. NC1264.2 +260000 MOVE CR-80 TO CORRECT-A. NC1264.2 +260100 MOVE " 4TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +260200 IF LENGTH-COUNTER LESS THAN 81 GO TO BREAKDOWN-EXIT. NC1264.2 +260300 PERFORM PRINT-DETAIL. NC1264.2 +260400 MOVE CM-100 TO COMPUTED-A. NC1264.2 +260500 MOVE CR-100 TO CORRECT-A. NC1264.2 +260600 MOVE " 5TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +260700 IF LENGTH-COUNTER LESS THAN 101 GO TO BREAKDOWN-EXIT. NC1264.2 +260800 PERFORM PRINT-DETAIL. NC1264.2 +260900 MOVE CM-120 TO COMPUTED-A. NC1264.2 +261000 MOVE CR-120 TO CORRECT-A. NC1264.2 +261100 MOVE " 6TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +261200 IF LENGTH-COUNTER LESS THAN 121 GO TO BREAKDOWN-EXIT. NC1264.2 +261300 PERFORM PRINT-DETAIL. NC1264.2 +261400 MOVE CM-140 TO COMPUTED-A. NC1264.2 +261500 MOVE CR-140 TO CORRECT-A. NC1264.2 +261600 MOVE " 7TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +261700 IF LENGTH-COUNTER LESS THAN 141 GO TO BREAKDOWN-EXIT. NC1264.2 +261800 PERFORM PRINT-DETAIL. NC1264.2 +261900 MOVE CM-160 TO COMPUTED-A. NC1264.2 +262000 MOVE CR-160 TO CORRECT-A. NC1264.2 +262100 MOVE " 8TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +262200 IF LENGTH-COUNTER LESS THAN 161 GO TO BREAKDOWN-EXIT. NC1264.2 +262300 PERFORM PRINT-DETAIL. NC1264.2 +262400 MOVE CM-180 TO COMPUTED-A. NC1264.2 +262500 MOVE CR-180 TO CORRECT-A. NC1264.2 +262600 MOVE " 9TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +262700 IF LENGTH-COUNTER LESS THAN 181 GO TO BREAKDOWN-EXIT. NC1264.2 +262800 PERFORM PRINT-DETAIL. NC1264.2 +262900 MOVE CM-200 TO COMPUTED-A. NC1264.2 +263000 MOVE CR-200 TO CORRECT-A. NC1264.2 +263100 MOVE "10TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +263200 BREAKDOWN-EXIT. NC1264.2 +263300 MOVE ZERO TO LENGTH-COUNTER. NC1264.2 +263400 CCVS-EXIT SECTION. NC1264.2 +263500 CCVS-999999. NC1264.2 +263600 GO TO CLOSE-FILES. NC1264.2 +*END-OF,NC126A +*HEADER,COBOL,NC127A +000100 identification division. NC1274.2 +000200 program-id. NC1274.2 +000300 nc127A. NC1274.2 +000400**************************************************************** NC1274.2 +000500* * NC1274.2 +000600* VALIDATION FOR:- * NC1274.2 +000700* * NC1274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +000900* * NC1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1274.2 +001100* * NC1274.2 +001200**************************************************************** NC1274.2 +001300* * NC1274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1274.2 +001500* * NC1274.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1274.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1274.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1274.2 +001900* * NC1274.2 +002000**************************************************************** NC1274.2 +002100* NC1274.2 +002200* program nc127a is written using lower case letters NC1274.2 +002300* throughout, with the exception of standard COBOL text NC1274.2 +002400* which is copied into every CCVS8x program from a library NC1274.2 +002500* and some alphanumeric literals. NC1274.2 +002600* NC1274.2 +002700 environment division. NC1274.2 +002800 configuration section. NC1274.2 +002900 source-computer. NC1274.2 +003000 XXXXX082. NC1274.2 +003100 object-computer. NC1274.2 +003200 XXXXX083. NC1274.2 +003300 input-output section. NC1274.2 +003400 file-control. NC1274.2 +003500 select print-file assign to NC1274.2 +003600 XXXXX055. NC1274.2 +003700 data division. NC1274.2 +003800 file section. NC1274.2 +003900 FD PRINT-FILE. NC1274.2 +004000 01 print-rec picture x(120). NC1274.2 +004100 01 dummy-record picture x(120). NC1274.2 +004200 working-storage section. NC1274.2 +004300 01 alphabetic-lit-upper pic x(9) value "ABCRSTXYZ". NC1274.2 +004400 01 alphabetic-lit-lower pic x(9) value "abcrstxyz". NC1274.2 +004500 01 alpha-lit-upper-lower pic x(9) value "dEfJkLuVw". NC1274.2 +004600 01 TEST-RESULTS. NC1274.2 +004700 02 FILLER PIC X VALUE SPACE. NC1274.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. NC1274.2 +004900 02 FILLER PIC X VALUE SPACE. NC1274.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. NC1274.2 +005100 02 FILLER PIC X VALUE SPACE. NC1274.2 +005200 02 PAR-NAME. NC1274.2 +005300 03 FILLER PIC X(19) VALUE SPACE. NC1274.2 +005400 03 PARDOT-X PIC X VALUE SPACE. NC1274.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. NC1274.2 +005600 02 FILLER PIC X(8) VALUE SPACE. NC1274.2 +005700 02 RE-MARK PIC X(61). NC1274.2 +005800 01 TEST-COMPUTED. NC1274.2 +005900 02 FILLER PIC X(30) VALUE SPACE. NC1274.2 +006000 02 FILLER PIC X(17) VALUE NC1274.2 +006100 " COMPUTED=". NC1274.2 +006200 02 COMPUTED-X. NC1274.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1274.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A NC1274.2 +006500 PIC -9(9).9(9). NC1274.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1274.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1274.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1274.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. NC1274.2 +007000 04 COMPUTED-18V0 PIC -9(18). NC1274.2 +007100 04 FILLER PIC X. NC1274.2 +007200 03 FILLER PIC X(50) VALUE SPACE. NC1274.2 +007300 01 TEST-CORRECT. NC1274.2 +007400 02 FILLER PIC X(30) VALUE SPACE. NC1274.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1274.2 +007600 02 CORRECT-X. NC1274.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1274.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1274.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1274.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1274.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1274.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. NC1274.2 +008300 04 CORRECT-18V0 PIC -9(18). NC1274.2 +008400 04 FILLER PIC X. NC1274.2 +008500 03 FILLER PIC X(2) VALUE SPACE. NC1274.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1274.2 +008700 01 CCVS-C-1. NC1274.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1274.2 +008900- "SS PARAGRAPH-NAME NC1274.2 +009000- " REMARKS". NC1274.2 +009100 02 FILLER PIC X(20) VALUE SPACE. NC1274.2 +009200 01 CCVS-C-2. NC1274.2 +009300 02 FILLER PIC X VALUE SPACE. NC1274.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". NC1274.2 +009500 02 FILLER PIC X(15) VALUE SPACE. NC1274.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". NC1274.2 +009700 02 FILLER PIC X(94) VALUE SPACE. NC1274.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1274.2 +009900 01 REC-CT PIC 99 VALUE ZERO. NC1274.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1274.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1274.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1274.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1274.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1274.2 +010900 01 CCVS-H-1. NC1274.2 +011000 02 FILLER PIC X(39) VALUE SPACES. NC1274.2 +011100 02 FILLER PIC X(42) VALUE NC1274.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1274.2 +011300 02 FILLER PIC X(39) VALUE SPACES. NC1274.2 +011400 01 CCVS-H-2A. NC1274.2 +011500 02 FILLER PIC X(40) VALUE SPACE. NC1274.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1274.2 +011700 02 FILLER PIC XXXX VALUE NC1274.2 +011800 "4.2 ". NC1274.2 +011900 02 FILLER PIC X(28) VALUE NC1274.2 +012000 " COPY - NOT FOR DISTRIBUTION". NC1274.2 +012100 02 FILLER PIC X(41) VALUE SPACE. NC1274.2 +012200 NC1274.2 +012300 01 CCVS-H-2B. NC1274.2 +012400 02 FILLER PIC X(15) VALUE NC1274.2 +012500 "TEST RESULT OF ". NC1274.2 +012600 02 TEST-ID PIC X(9). NC1274.2 +012700 02 FILLER PIC X(4) VALUE NC1274.2 +012800 " IN ". NC1274.2 +012900 02 FILLER PIC X(12) VALUE NC1274.2 +013000 " HIGH ". NC1274.2 +013100 02 FILLER PIC X(22) VALUE NC1274.2 +013200 " LEVEL VALIDATION FOR ". NC1274.2 +013300 02 FILLER PIC X(58) VALUE NC1274.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +013500 01 CCVS-H-3. NC1274.2 +013600 02 FILLER PIC X(34) VALUE NC1274.2 +013700 " FOR OFFICIAL USE ONLY ". NC1274.2 +013800 02 FILLER PIC X(58) VALUE NC1274.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1274.2 +014000 02 FILLER PIC X(28) VALUE NC1274.2 +014100 " COPYRIGHT 1985 ". NC1274.2 +014200 01 CCVS-E-1. NC1274.2 +014300 02 FILLER PIC X(52) VALUE SPACE. NC1274.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1274.2 +014500 02 ID-AGAIN PIC X(9). NC1274.2 +014600 02 FILLER PIC X(45) VALUE SPACES. NC1274.2 +014700 01 CCVS-E-2. NC1274.2 +014800 02 FILLER PIC X(31) VALUE SPACE. NC1274.2 +014900 02 FILLER PIC X(21) VALUE SPACE. NC1274.2 +015000 02 CCVS-E-2-2. NC1274.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1274.2 +015200 03 FILLER PIC X VALUE SPACE. NC1274.2 +015300 03 ENDER-DESC PIC X(44) VALUE NC1274.2 +015400 "ERRORS ENCOUNTERED". NC1274.2 +015500 01 CCVS-E-3. NC1274.2 +015600 02 FILLER PIC X(22) VALUE NC1274.2 +015700 " FOR OFFICIAL USE ONLY". NC1274.2 +015800 02 FILLER PIC X(12) VALUE SPACE. NC1274.2 +015900 02 FILLER PIC X(58) VALUE NC1274.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +016100 02 FILLER PIC X(13) VALUE SPACE. NC1274.2 +016200 02 FILLER PIC X(15) VALUE NC1274.2 +016300 " COPYRIGHT 1985". NC1274.2 +016400 01 CCVS-E-4. NC1274.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1274.2 +016600 02 FILLER PIC X(4) VALUE " OF ". NC1274.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1274.2 +016800 02 FILLER PIC X(40) VALUE NC1274.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1274.2 +017000 01 XXINFO. NC1274.2 +017100 02 FILLER PIC X(19) VALUE NC1274.2 +017200 "*** INFORMATION ***". NC1274.2 +017300 02 INFO-TEXT. NC1274.2 +017400 04 FILLER PIC X(8) VALUE SPACE. NC1274.2 +017500 04 XXCOMPUTED PIC X(20). NC1274.2 +017600 04 FILLER PIC X(5) VALUE SPACE. NC1274.2 +017700 04 XXCORRECT PIC X(20). NC1274.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). NC1274.2 +017900 01 HYPHEN-LINE. NC1274.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. NC1274.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************NC1274.2 +018200- "*****************************************". NC1274.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************NC1274.2 +018400- "******************************". NC1274.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE NC1274.2 +018600 "NC127A". NC1274.2 +018700 PROCEDURE DIVISION. NC1274.2 +018800 CCVS1 SECTION. NC1274.2 +018900 OPEN-FILES. NC1274.2 +019000 OPEN OUTPUT PRINT-FILE. NC1274.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1274.2 +019200 MOVE SPACE TO TEST-RESULTS. NC1274.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1274.2 +019400 GO TO CCVS1-EXIT. NC1274.2 +019500 CLOSE-FILES. NC1274.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1274.2 +019700 TERMINATE-CCVS. NC1274.2 +019800S EXIT PROGRAM. NC1274.2 +019900STERMINATE-CALL. NC1274.2 +020000 STOP RUN. NC1274.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1274.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1274.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1274.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1274.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. NC1274.2 +020600 PRINT-DETAIL. NC1274.2 +020700 IF REC-CT NOT EQUAL TO ZERO NC1274.2 +020800 MOVE "." TO PARDOT-X NC1274.2 +020900 MOVE REC-CT TO DOTVALUE. NC1274.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1274.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1274.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1274.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1274.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1274.2 +021500 MOVE SPACE TO CORRECT-X. NC1274.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1274.2 +021700 MOVE SPACE TO RE-MARK. NC1274.2 +021800 HEAD-ROUTINE. NC1274.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1274.2 +022200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1274.2 +022300 COLUMN-NAMES-ROUTINE. NC1274.2 +022400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +022500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +022700 END-ROUTINE. NC1274.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1274.2 +022900 END-RTN-EXIT. NC1274.2 +023000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +023100 END-ROUTINE-1. NC1274.2 +023200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1274.2 +023300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1274.2 +023400 ADD PASS-COUNTER TO ERROR-HOLD. NC1274.2 +023500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1274.2 +023600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1274.2 +023700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1274.2 +023800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1274.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1274.2 +024000 END-ROUTINE-12. NC1274.2 +024100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1274.2 +024200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1274.2 +024300 MOVE "NO " TO ERROR-TOTAL NC1274.2 +024400 ELSE NC1274.2 +024500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1274.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1274.2 +024700 PERFORM WRITE-LINE. NC1274.2 +024800 END-ROUTINE-13. NC1274.2 +024900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1274.2 +025000 MOVE "NO " TO ERROR-TOTAL ELSE NC1274.2 +025100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1274.2 +025200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1274.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +025400 IF INSPECT-COUNTER EQUAL TO ZERO NC1274.2 +025500 MOVE "NO " TO ERROR-TOTAL NC1274.2 +025600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1274.2 +025700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1274.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +025900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +026000 WRITE-LINE. NC1274.2 +026100 ADD 1 TO RECORD-COUNT. NC1274.2 +026200Y IF RECORD-COUNT GREATER 42 NC1274.2 +026300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1274.2 +026400Y MOVE SPACE TO DUMMY-RECORD NC1274.2 +026500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1274.2 +026600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1274.2 +026700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1274.2 +026800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1274.2 +026900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1274.2 +027000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1274.2 +027400Y MOVE ZERO TO RECORD-COUNT. NC1274.2 +027500 PERFORM WRT-LN. NC1274.2 +027600 WRT-LN. NC1274.2 +027700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1274.2 +027800 MOVE SPACE TO DUMMY-RECORD. NC1274.2 +027900 BLANK-LINE-PRINT. NC1274.2 +028000 PERFORM WRT-LN. NC1274.2 +028100 FAIL-ROUTINE. NC1274.2 +028200 IF COMPUTED-X NOT EQUAL TO SPACE NC1274.2 +028300 GO TO FAIL-ROUTINE-WRITE. NC1274.2 +028400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1274.2 +028500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1274.2 +028600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1274.2 +028700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +028800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1274.2 +028900 GO TO FAIL-ROUTINE-EX. NC1274.2 +029000 FAIL-ROUTINE-WRITE. NC1274.2 +029100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1274.2 +029200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1274.2 +029300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1274.2 +029400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1274.2 +029500 FAIL-ROUTINE-EX. EXIT. NC1274.2 +029600 BAIL-OUT. NC1274.2 +029700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1274.2 +029800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1274.2 +029900 BAIL-OUT-WRITE. NC1274.2 +030000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1274.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1274.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1274.2 +030400 BAIL-OUT-EX. EXIT. NC1274.2 +030500 CCVS1-EXIT. NC1274.2 +030600 EXIT. NC1274.2 +030700 sect-nc127a-001 section. NC1274.2 +030800 low-init-gf-1. NC1274.2 +030900 move "III-4 NOTE-2" to ansi-reference. NC1274.2 +031000 low-test-gf-1-1. NC1274.2 +031100 if alphabetic-lit-upper not = alphabetic-lit-lower NC1274.2 +031200 perform pass NC1274.2 +031300 go to low-write-gf-1. NC1274.2 +031400 go to low-fail-gf-1. NC1274.2 +031500 low-delete-gf-1. NC1274.2 +031600 perform de-lete. NC1274.2 +031700 go to low-write-GF-1. NC1274.2 +031800 low-fail-gf-1. NC1274.2 +031900 move alphabetic-lit-upper to correct-x. NC1274.2 +032000 move alphabetic-lit-lower to computed-x. NC1274.2 +032100 move "upper and lower case should not be equal" NC1274.2 +032200 to re-mark. NC1274.2 +032300 perform fail. NC1274.2 +032400 low-write-gf-1. NC1274.2 +032500 move "lower case program" to feature. NC1274.2 +032600 MOVE "low-test-gf-1" to par-name. NC1274.2 +032700 perform print-detail. NC1274.2 +032800 low-init-gf-2. NC1274.2 +032900 move "vi-67 6.4.1" to ansi-reference. NC1274.2 +033000 low-test-gf-2. NC1274.2 +033100 if alpha-lit-upper-lower = "dEfJkLuVw" NC1274.2 +033200 perform pass NC1274.2 +033300 go to low-write-gf-2. NC1274.2 +033400 go to low-fail-gf-2. NC1274.2 +033500 low-delete-gf-2. NC1274.2 +033600 perform de-lete. NC1274.2 +033700 go to low-write-GF-2. NC1274.2 +033800 low-fail-gf-2. NC1274.2 +033900 move alpha-lit-upper-lower to correct-x. NC1274.2 +034000 move alpha-lit-upper-lower to computed-x. NC1274.2 +034100 move "identical literals should be equal" NC1274.2 +034200 to re-mark. NC1274.2 +034300 perform fail. NC1274.2 +034400 low-write-gf-2. NC1274.2 +034500 MOVE "low-test-gf-2" to par-name. NC1274.2 +034600 perform print-detail. NC1274.2 +034700 CCVS-EXIT SECTION. NC1274.2 +034800 CCVS-999999. NC1274.2 +034900 GO TO CLOSE-FILES. NC1274.2 +*END-OF,NC127A +*HEADER,COBOL,NC131A +000100 IDENTIFICATION DIVISION. NC1314.2 +000200 PROGRAM-ID. NC1314.2 +000300 NC131A. NC1314.2 +000400**************************************************************** NC1314.2 +000500* * NC1314.2 +000600* VALIDATION FOR:- * NC1314.2 +000700* * NC1314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +000900* * NC1314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1314.2 +001100* * NC1314.2 +001200**************************************************************** NC1314.2 +001300* * NC1314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1314.2 +001500* * NC1314.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1314.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1314.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1314.2 +001900* * NC1314.2 +002000**************************************************************** NC1314.2 +002100* NC1314.2 +002200* PROGRAM NC131A TESTS FORMAT 1 OF THE SET STATEMENT USING NC1314.2 +002300* VARIOUS COMBINATIONS OF INDEX-NAMES, IDENTIFIERS & INTEGERS NC1314.2 +002400* NC1314.2 +002500 ENVIRONMENT DIVISION. NC1314.2 +002600 CONFIGURATION SECTION. NC1314.2 +002700 SOURCE-COMPUTER. NC1314.2 +002800 XXXXX082. NC1314.2 +002900 OBJECT-COMPUTER. NC1314.2 +003000 XXXXX083. NC1314.2 +003100 INPUT-OUTPUT SECTION. NC1314.2 +003200 FILE-CONTROL. NC1314.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1314.2 +003400 XXXXX055. NC1314.2 +003500 DATA DIVISION. NC1314.2 +003600 FILE SECTION. NC1314.2 +003700 FD PRINT-FILE. NC1314.2 +003800 01 PRINT-REC PICTURE X(120). NC1314.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1314.2 +004000 WORKING-STORAGE SECTION. NC1314.2 +004100 77 I-DATA-1 USAGE IS INDEX. NC1314.2 +004200 77 IDENT-1 PICTURE 9 VALUE IS 4. NC1314.2 +004300 77 IDENT-2 PICTURE 9. NC1314.2 +004400 77 IDENT-3 PICTURE S99 USAGE COMPUTATIONAL. NC1314.2 +004500 77 SGN-IDX PICTURE 9(18). NC1314.2 +004600 01 INDEX-VALUE PIC 9999. NC1314.2 +004700 01 I-DATA-GROUP USAGE IS INDEX. NC1314.2 +004800 02 I-DATA-2 USAGE IS INDEX. NC1314.2 +004900 02 I-DATA-3 USAGE IS INDEX. NC1314.2 +005000 01 TABLE-1. NC1314.2 +005100 02 TAB1-REC PICTURE 99 OCCURS 100 TIMES NC1314.2 +005200 INDEXED BY INDEX1. NC1314.2 +005300 01 TABLE-2. NC1314.2 +005400 02 TAB2-REC PICTURE 999 OCCURS 100 TIMES NC1314.2 +005500 INDEXED BY INDEX2. NC1314.2 +005600 01 TEST-RESULTS. NC1314.2 +005700 02 FILLER PIC X VALUE SPACE. NC1314.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC1314.2 +005900 02 FILLER PIC X VALUE SPACE. NC1314.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC1314.2 +006100 02 FILLER PIC X VALUE SPACE. NC1314.2 +006200 02 PAR-NAME. NC1314.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC1314.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC1314.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC1314.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC1314.2 +006700 02 RE-MARK PIC X(61). NC1314.2 +006800 01 TEST-COMPUTED. NC1314.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1314.2 +007000 02 FILLER PIC X(17) VALUE NC1314.2 +007100 " COMPUTED=". NC1314.2 +007200 02 COMPUTED-X. NC1314.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1314.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC1314.2 +007500 PIC -9(9).9(9). NC1314.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1314.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1314.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1314.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC1314.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC1314.2 +008100 04 FILLER PIC X. NC1314.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC1314.2 +008300 01 TEST-CORRECT. NC1314.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1314.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1314.2 +008600 02 CORRECT-X. NC1314.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1314.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1314.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1314.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1314.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1314.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC1314.2 +009300 04 CORRECT-18V0 PIC -9(18). NC1314.2 +009400 04 FILLER PIC X. NC1314.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC1314.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1314.2 +009700 01 CCVS-C-1. NC1314.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1314.2 +009900- "SS PARAGRAPH-NAME NC1314.2 +010000- " REMARKS". NC1314.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC1314.2 +010200 01 CCVS-C-2. NC1314.2 +010300 02 FILLER PIC X VALUE SPACE. NC1314.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC1314.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC1314.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC1314.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC1314.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1314.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC1314.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1314.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1314.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1314.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1314.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1314.2 +011900 01 CCVS-H-1. NC1314.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC1314.2 +012100 02 FILLER PIC X(42) VALUE NC1314.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1314.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC1314.2 +012400 01 CCVS-H-2A. NC1314.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC1314.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1314.2 +012700 02 FILLER PIC XXXX VALUE NC1314.2 +012800 "4.2 ". NC1314.2 +012900 02 FILLER PIC X(28) VALUE NC1314.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC1314.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC1314.2 +013200 NC1314.2 +013300 01 CCVS-H-2B. NC1314.2 +013400 02 FILLER PIC X(15) VALUE NC1314.2 +013500 "TEST RESULT OF ". NC1314.2 +013600 02 TEST-ID PIC X(9). NC1314.2 +013700 02 FILLER PIC X(4) VALUE NC1314.2 +013800 " IN ". NC1314.2 +013900 02 FILLER PIC X(12) VALUE NC1314.2 +014000 " HIGH ". NC1314.2 +014100 02 FILLER PIC X(22) VALUE NC1314.2 +014200 " LEVEL VALIDATION FOR ". NC1314.2 +014300 02 FILLER PIC X(58) VALUE NC1314.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +014500 01 CCVS-H-3. NC1314.2 +014600 02 FILLER PIC X(34) VALUE NC1314.2 +014700 " FOR OFFICIAL USE ONLY ". NC1314.2 +014800 02 FILLER PIC X(58) VALUE NC1314.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1314.2 +015000 02 FILLER PIC X(28) VALUE NC1314.2 +015100 " COPYRIGHT 1985 ". NC1314.2 +015200 01 CCVS-E-1. NC1314.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC1314.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1314.2 +015500 02 ID-AGAIN PIC X(9). NC1314.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC1314.2 +015700 01 CCVS-E-2. NC1314.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC1314.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC1314.2 +016000 02 CCVS-E-2-2. NC1314.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1314.2 +016200 03 FILLER PIC X VALUE SPACE. NC1314.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC1314.2 +016400 "ERRORS ENCOUNTERED". NC1314.2 +016500 01 CCVS-E-3. NC1314.2 +016600 02 FILLER PIC X(22) VALUE NC1314.2 +016700 " FOR OFFICIAL USE ONLY". NC1314.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC1314.2 +016900 02 FILLER PIC X(58) VALUE NC1314.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC1314.2 +017200 02 FILLER PIC X(15) VALUE NC1314.2 +017300 " COPYRIGHT 1985". NC1314.2 +017400 01 CCVS-E-4. NC1314.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1314.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC1314.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1314.2 +017800 02 FILLER PIC X(40) VALUE NC1314.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1314.2 +018000 01 XXINFO. NC1314.2 +018100 02 FILLER PIC X(19) VALUE NC1314.2 +018200 "*** INFORMATION ***". NC1314.2 +018300 02 INFO-TEXT. NC1314.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC1314.2 +018500 04 XXCOMPUTED PIC X(20). NC1314.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC1314.2 +018700 04 XXCORRECT PIC X(20). NC1314.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC1314.2 +018900 01 HYPHEN-LINE. NC1314.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC1314.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC1314.2 +019200- "*****************************************". NC1314.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC1314.2 +019400- "******************************". NC1314.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC1314.2 +019600 "NC131A". NC1314.2 +019700 PROCEDURE DIVISION. NC1314.2 +019800 CCVS1 SECTION. NC1314.2 +019900 OPEN-FILES. NC1314.2 +020000 OPEN OUTPUT PRINT-FILE. NC1314.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1314.2 +020200 MOVE SPACE TO TEST-RESULTS. NC1314.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1314.2 +020400 GO TO CCVS1-EXIT. NC1314.2 +020500 CLOSE-FILES. NC1314.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1314.2 +020700 TERMINATE-CCVS. NC1314.2 +020800S EXIT PROGRAM. NC1314.2 +020900STERMINATE-CALL. NC1314.2 +021000 STOP RUN. NC1314.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1314.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1314.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1314.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1314.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC1314.2 +021600 PRINT-DETAIL. NC1314.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC1314.2 +021800 MOVE "." TO PARDOT-X NC1314.2 +021900 MOVE REC-CT TO DOTVALUE. NC1314.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1314.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1314.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1314.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1314.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1314.2 +022500 MOVE SPACE TO CORRECT-X. NC1314.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1314.2 +022700 MOVE SPACE TO RE-MARK. NC1314.2 +022800 HEAD-ROUTINE. NC1314.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1314.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1314.2 +023300 COLUMN-NAMES-ROUTINE. NC1314.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +023700 END-ROUTINE. NC1314.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1314.2 +023900 END-RTN-EXIT. NC1314.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +024100 END-ROUTINE-1. NC1314.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1314.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1314.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC1314.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1314.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1314.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1314.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1314.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1314.2 +025000 END-ROUTINE-12. NC1314.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1314.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1314.2 +025300 MOVE "NO " TO ERROR-TOTAL NC1314.2 +025400 ELSE NC1314.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1314.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1314.2 +025700 PERFORM WRITE-LINE. NC1314.2 +025800 END-ROUTINE-13. NC1314.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1314.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE NC1314.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1314.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1314.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO NC1314.2 +026500 MOVE "NO " TO ERROR-TOTAL NC1314.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1314.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1314.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +027000 WRITE-LINE. NC1314.2 +027100 ADD 1 TO RECORD-COUNT. NC1314.2 +027200Y IF RECORD-COUNT GREATER 42 NC1314.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1314.2 +027400Y MOVE SPACE TO DUMMY-RECORD NC1314.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1314.2 +027600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1314.2 +027700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1314.2 +027800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1314.2 +027900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1314.2 +028000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1314.2 +028400Y MOVE ZERO TO RECORD-COUNT. NC1314.2 +028500 PERFORM WRT-LN. NC1314.2 +028600 WRT-LN. NC1314.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1314.2 +028800 MOVE SPACE TO DUMMY-RECORD. NC1314.2 +028900 BLANK-LINE-PRINT. NC1314.2 +029000 PERFORM WRT-LN. NC1314.2 +029100 FAIL-ROUTINE. NC1314.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE NC1314.2 +029300 GO TO FAIL-ROUTINE-WRITE. NC1314.2 +029400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1314.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1314.2 +029600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1314.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1314.2 +029900 GO TO FAIL-ROUTINE-EX. NC1314.2 +030000 FAIL-ROUTINE-WRITE. NC1314.2 +030100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1314.2 +030200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1314.2 +030300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1314.2 +030400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1314.2 +030500 FAIL-ROUTINE-EX. EXIT. NC1314.2 +030600 BAIL-OUT. NC1314.2 +030700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1314.2 +030800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1314.2 +030900 BAIL-OUT-WRITE. NC1314.2 +031000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1314.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1314.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1314.2 +031400 BAIL-OUT-EX. EXIT. NC1314.2 +031500 CCVS1-EXIT. NC1314.2 +031600 EXIT. NC1314.2 +031700 SECT-NC131A-001 SECTION. NC1314.2 +031800 TEST-1. NC1314.2 +031900 MOVE "VI-127 6.23.4" TO ANSI-REFERENCE. NC1314.2 +032000 SET INDEX1 TO 5. NC1314.2 +032100 IF INDEX1 EQUAL TO 5 PERFORM PASS GO TO OK1. NC1314.2 +032200 SET SGN-IDX TO INDEX1. NC1314.2 +032300 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +032400 MOVE 5 TO CORRECT-18V0. NC1314.2 +032500 PERFORM FAIL. NC1314.2 +032600 OK1. NC1314.2 +032700 MOVE "TEST-1" TO PAR-NAME. NC1314.2 +032800 MOVE "SET OPT 1" TO FEATURE. NC1314.2 +032900 PERFORM PRINT-DETAIL. NC1314.2 +033000 TEST-2. NC1314.2 +033100 SET INDEX1 TO IDENT-1. NC1314.2 +033200 IF INDEX1 EQUAL TO 4 PERFORM PASS GO TO OK2. NC1314.2 +033300 SET SGN-IDX TO INDEX1. NC1314.2 +033400 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +033500 MOVE IDENT-1 TO CORRECT-18V0. NC1314.2 +033600 PERFORM FAIL. NC1314.2 +033700 OK2. NC1314.2 +033800 MOVE "TEST-2" TO PAR-NAME. NC1314.2 +033900 MOVE "SET OPT 2" TO FEATURE. NC1314.2 +034000 PERFORM PRINT-DETAIL. NC1314.2 +034100 TEST-3. NC1314.2 +034200 SET INDEX1 TO 4. NC1314.2 +034300 SET INDEX2 TO INDEX1. NC1314.2 +034400 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK3. NC1314.2 +034500 SET SGN-IDX TO INDEX2. NC1314.2 +034600 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +034700 MOVE 4 TO CORRECT-18V0. NC1314.2 +034800 PERFORM FAIL. NC1314.2 +034900 OK3. NC1314.2 +035000 MOVE "TEST-3" TO PAR-NAME. NC1314.2 +035100 MOVE "SET OPT 3" TO FEATURE. NC1314.2 +035200 PERFORM PRINT-DETAIL. NC1314.2 +035300 TEST-4. NC1314.2 +035400 SET INDEX2 TO 4. NC1314.2 +035500 SET I-DATA-1 TO INDEX2. NC1314.2 +035600 IF I-DATA-1 EQUAL TO INDEX2 PERFORM PASS GO TO OK4. NC1314.2 +035700 SET INDEX-VALUE TO INDEX2. NC1314.2 +035800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +035900 MOVE 4 TO CORRECT-18V0. NC1314.2 +036000 PERFORM FAIL. NC1314.2 +036100 OK4. NC1314.2 +036200 MOVE "TEST-4" TO PAR-NAME. NC1314.2 +036300 MOVE "SET OPT 4" TO FEATURE. NC1314.2 +036400 PERFORM PRINT-DETAIL. NC1314.2 +036500 TEST-5. NC1314.2 +036600 SET INDEX2 TO 4. NC1314.2 +036700 SET I-DATA-1 TO INDEX2. NC1314.2 +036800 SET I-DATA-2 TO I-DATA-1. NC1314.2 +036900 IF I-DATA-2 EQUAL TO I-DATA-1 PERFORM PASS GO TO OK5. NC1314.2 +037000 SET INDEX-VALUE TO INDEX2. NC1314.2 +037100 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +037200 MOVE 4 TO CORRECT-18V0. NC1314.2 +037300 PERFORM FAIL. NC1314.2 +037400 OK5. NC1314.2 +037500 MOVE "TEST-5" TO PAR-NAME. NC1314.2 +037600 MOVE "SET OPT 5" TO FEATURE. NC1314.2 +037700 PERFORM PRINT-DETAIL. NC1314.2 +037800 TEST-6. NC1314.2 +037900 SET INDEX2 TO 6. NC1314.2 +038000 SET IDENT-2 TO INDEX2. NC1314.2 +038100 IF IDENT-2 EQUAL TO INDEX2 PERFORM PASS GO TO OK6. NC1314.2 +038200 SET SGN-IDX TO INDEX2. NC1314.2 +038300 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +038400 MOVE 6 TO CORRECT-18V0. NC1314.2 +038500 PERFORM FAIL. NC1314.2 +038600 OK6. NC1314.2 +038700 MOVE "TEST-6" TO PAR-NAME. NC1314.2 +038800 MOVE "SET OPT 6" TO FEATURE. NC1314.2 +038900 PERFORM PRINT-DETAIL. NC1314.2 +039000 MOVE SPACE TO FEATURE. NC1314.2 +039100 END-TEST. NC1314.2 +039200 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1314.2 +039300 MOVE "ASCENDING NUMBER LIST" TO RE-MARK. NC1314.2 +039400 PERFORM PRINT-DETAIL. NC1314.2 +039500 PERFORM BLANK-LINE-PRINT. NC1314.2 +039600 SET INDEX1 TO 1. NC1314.2 +039700 MOVE 1 TO IDENT-3. NC1314.2 +039800 L. MOVE IDENT-3 TO TAB1-REC (INDEX1). NC1314.2 +039900 IF IDENT-3 EQUAL TO 99 GO TO P-LIST. NC1314.2 +040000 ADD 1 TO IDENT-3. NC1314.2 +040100 SET INDEX1 TO IDENT-3. NC1314.2 +040200 GO TO L. NC1314.2 +040300 P-LIST. NC1314.2 +040400 SET INDEX1 TO 1. NC1314.2 +040500 MOVE 1 TO IDENT-3. NC1314.2 +040600 M. NC1314.2 +040700 MOVE TAB1-REC (INDEX1) TO RE-MARK. NC1314.2 +040800 PERFORM PRINT-DETAIL. NC1314.2 +040900 IF IDENT-3 EQUAL TO 99 GO TO CL-OSE. NC1314.2 +041000 ADD 1 TO IDENT-3. NC1314.2 +041100 SET INDEX1 TO IDENT-3. NC1314.2 +041200 GO TO M. NC1314.2 +041300 CL-OSE. NC1314.2 +041400 PERFORM BLANK-LINE-PRINT. NC1314.2 +041500 MOVE "END OF TABLE LIST" TO RE-MARK. NC1314.2 +041600 PERFORM PRINT-DETAIL. NC1314.2 +041700* NC1314.2 +041800 IDX-INIT-8. NC1314.2 +041900 MOVE "VI-127 6.23.4 GR3(c)" TO ANSI-REFERENCE. NC1314.2 +042000 SET INDEX1 TO 4. NC1314.2 +042100 IDX-TEST-8-0. NC1314.2 +042200 SET INDEX2 NC1314.2 +042300 IDENT-1 TO INDEX1. NC1314.2 +042400 IDX-TEST-8-1. NC1314.2 +042500 IF IDENT-1 EQUAL TO 4 PERFORM PASS GO TO OK8-1. NC1314.2 +042600 MOVE IDENT-1 TO COMPUTED-18V0. NC1314.2 +042700 MOVE 4 TO CORRECT-18V0. NC1314.2 +042800 PERFORM FAIL. NC1314.2 +042900 OK8-1. NC1314.2 +043000 MOVE "IDX-TEST-8-1" TO PAR-NAME. NC1314.2 +043100 PERFORM PRINT-DETAIL. NC1314.2 +043200 IDX-TEST-8-2. NC1314.2 +043300 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK8-2. NC1314.2 +043400 SET INDEX-VALUE TO INDEX2. NC1314.2 +043500 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +043600 MOVE 4 TO CORRECT-18V0. NC1314.2 +043700 PERFORM FAIL. NC1314.2 +043800 OK8-2. NC1314.2 +043900 MOVE "IDX-TEST-8-2" TO PAR-NAME. NC1314.2 +044000 PERFORM PRINT-DETAIL. NC1314.2 +044100* NC1314.2 +044200 IDX-INIT-9. NC1314.2 +044300 MOVE "VI-127 6.23.4 GR3(c)" TO ANSI-REFERENCE. NC1314.2 +044400 SET INDEX1 TO 4. NC1314.2 +044500 IDX-TEST-9-0. NC1314.2 +044600 SET IDENT-1 NC1314.2 +044700 INDEX2 TO INDEX1. NC1314.2 +044800 IDX-TEST-9-1. NC1314.2 +044900 IF IDENT-1 EQUAL TO 4 PERFORM PASS GO TO OK9-1. NC1314.2 +045000 MOVE IDENT-1 TO COMPUTED-18V0. NC1314.2 +045100 MOVE 4 TO CORRECT-18V0. NC1314.2 +045200 PERFORM FAIL. NC1314.2 +045300 OK9-1. NC1314.2 +045400 MOVE "IDX-TEST-9-1" TO PAR-NAME. NC1314.2 +045500 PERFORM PRINT-DETAIL. NC1314.2 +045600 IDX-TEST-9-2. NC1314.2 +045700 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK9-2. NC1314.2 +045800 SET INDEX-VALUE TO INDEX2. NC1314.2 +045900 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +046000 MOVE 4 TO CORRECT-18V0. NC1314.2 +046100 PERFORM FAIL. NC1314.2 +046200 OK9-2. NC1314.2 +046300 MOVE "IDX-TEST-9-2" TO PAR-NAME. NC1314.2 +046400 PERFORM PRINT-DETAIL. NC1314.2 +046500* NC1314.2 +046600 CCVS-EXIT SECTION. NC1314.2 +046700 CCVS-999999. NC1314.2 +046800 GO TO CLOSE-FILES. NC1314.2 +*END-OF,NC131A +*HEADER,COBOL,NC132A +000100 IDENTIFICATION DIVISION. NC1324.2 +000200 PROGRAM-ID. NC1324.2 +000300 NC132A. NC1324.2 +000400**************************************************************** NC1324.2 +000500* * NC1324.2 +000600* VALIDATION FOR:- * NC1324.2 +000700* * NC1324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +000900* * NC1324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1324.2 +001100* * NC1324.2 +001200**************************************************************** NC1324.2 +001300* * NC1324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1324.2 +001500* * NC1324.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1324.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1324.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1324.2 +001900* * NC1324.2 +002000**************************************************************** NC1324.2 +002100* NC1324.2 +002200* PROGRAM NC132A TESTS THE USE OF SUBSCRIPTS TO ACCESS A NC1324.2 +002300* SINGLE LEVEL TABLE USING INTEGER DISPLAY AND COMPUTATIONAL NC1324.2 +002400* FIELDS AS SUBSCRIPTS. NC1324.2 +002500* NC1324.2 +002600 ENVIRONMENT DIVISION. NC1324.2 +002700 CONFIGURATION SECTION. NC1324.2 +002800 SOURCE-COMPUTER. NC1324.2 +002900 XXXXX082. NC1324.2 +003000 OBJECT-COMPUTER. NC1324.2 +003100 XXXXX083. NC1324.2 +003200 INPUT-OUTPUT SECTION. NC1324.2 +003300 FILE-CONTROL. NC1324.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1324.2 +003500 XXXXX055. NC1324.2 +003600 DATA DIVISION. NC1324.2 +003700 FILE SECTION. NC1324.2 +003800 FD PRINT-FILE. NC1324.2 +003900 01 PRINT-REC PICTURE X(120). NC1324.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1324.2 +004100 WORKING-STORAGE SECTION. NC1324.2 +004200 77 CON-1 PICTURE 9 VALUE 1. NC1324.2 +004300 77 CON-2 PICTURE 9 VALUE 2. NC1324.2 +004400 77 CON-3 PICTURE 9 VALUE 3. NC1324.2 +004500 77 CON-4 PICTURE 9 VALUE 4. NC1324.2 +004600 77 SUB-3 PICTURE S9(18) COMPUTATIONAL VALUE 2. NC1324.2 +004700 77 SUB-4 PICTURE 9(18) COMPUTATIONAL VALUE 4. NC1324.2 +004800 01 CONSTANTS-77. NC1324.2 +004900 02 SUB1 PICTURE 9 VALUE 1. NC1324.2 +005000 02 SUB2 PICTURE S9 VALUE +4. NC1324.2 +005100 02 TABLE-A-VALUES PICTURE X(20) VALUE "1112223334441122334NC1324.2 +005200- "4". NC1324.2 +005300 01 TABLE-A. NC1324.2 +005400 02 ENTRY-A-1 PICTURE XXX OCCURS 4 TIMES. NC1324.2 +005500 02 ENTRY-A-2 OCCURS 4 TIMES. NC1324.2 +005600 03 ENTRY-A-3 PICTURE X. NC1324.2 +005700 03 ENTRY-A-4 PICTURE X. NC1324.2 +005800 01 TABLE-B. NC1324.2 +005900 02 ENTRY-B-1 PICTURE X(4) VALUE "1234". NC1324.2 +006000 02 ENTRY-B-2 REDEFINES ENTRY-B-1 PICTURE 9 OCCURS 4. NC1324.2 +006100 01 TABLE-C. NC1324.2 +006200 02 ENTRY-C PICTURE 9 OCCURS 4 TIMES. NC1324.2 +006300 01 TEST-RESULTS. NC1324.2 +006400 02 FILLER PIC X VALUE SPACE. NC1324.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. NC1324.2 +006600 02 FILLER PIC X VALUE SPACE. NC1324.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. NC1324.2 +006800 02 FILLER PIC X VALUE SPACE. NC1324.2 +006900 02 PAR-NAME. NC1324.2 +007000 03 FILLER PIC X(19) VALUE SPACE. NC1324.2 +007100 03 PARDOT-X PIC X VALUE SPACE. NC1324.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. NC1324.2 +007300 02 FILLER PIC X(8) VALUE SPACE. NC1324.2 +007400 02 RE-MARK PIC X(61). NC1324.2 +007500 01 TEST-COMPUTED. NC1324.2 +007600 02 FILLER PIC X(30) VALUE SPACE. NC1324.2 +007700 02 FILLER PIC X(17) VALUE NC1324.2 +007800 " COMPUTED=". NC1324.2 +007900 02 COMPUTED-X. NC1324.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1324.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A NC1324.2 +008200 PIC -9(9).9(9). NC1324.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1324.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1324.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1324.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. NC1324.2 +008700 04 COMPUTED-18V0 PIC -9(18). NC1324.2 +008800 04 FILLER PIC X. NC1324.2 +008900 03 FILLER PIC X(50) VALUE SPACE. NC1324.2 +009000 01 TEST-CORRECT. NC1324.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC1324.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1324.2 +009300 02 CORRECT-X. NC1324.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1324.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1324.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1324.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1324.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1324.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. NC1324.2 +010000 04 CORRECT-18V0 PIC -9(18). NC1324.2 +010100 04 FILLER PIC X. NC1324.2 +010200 03 FILLER PIC X(2) VALUE SPACE. NC1324.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1324.2 +010400 01 CCVS-C-1. NC1324.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1324.2 +010600- "SS PARAGRAPH-NAME NC1324.2 +010700- " REMARKS". NC1324.2 +010800 02 FILLER PIC X(20) VALUE SPACE. NC1324.2 +010900 01 CCVS-C-2. NC1324.2 +011000 02 FILLER PIC X VALUE SPACE. NC1324.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". NC1324.2 +011200 02 FILLER PIC X(15) VALUE SPACE. NC1324.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". NC1324.2 +011400 02 FILLER PIC X(94) VALUE SPACE. NC1324.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1324.2 +011600 01 REC-CT PIC 99 VALUE ZERO. NC1324.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1324.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1324.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1324.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1324.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1324.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1324.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1324.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1324.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1324.2 +012600 01 CCVS-H-1. NC1324.2 +012700 02 FILLER PIC X(39) VALUE SPACES. NC1324.2 +012800 02 FILLER PIC X(42) VALUE NC1324.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1324.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC1324.2 +013100 01 CCVS-H-2A. NC1324.2 +013200 02 FILLER PIC X(40) VALUE SPACE. NC1324.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1324.2 +013400 02 FILLER PIC XXXX VALUE NC1324.2 +013500 "4.2 ". NC1324.2 +013600 02 FILLER PIC X(28) VALUE NC1324.2 +013700 " COPY - NOT FOR DISTRIBUTION". NC1324.2 +013800 02 FILLER PIC X(41) VALUE SPACE. NC1324.2 +013900 NC1324.2 +014000 01 CCVS-H-2B. NC1324.2 +014100 02 FILLER PIC X(15) VALUE NC1324.2 +014200 "TEST RESULT OF ". NC1324.2 +014300 02 TEST-ID PIC X(9). NC1324.2 +014400 02 FILLER PIC X(4) VALUE NC1324.2 +014500 " IN ". NC1324.2 +014600 02 FILLER PIC X(12) VALUE NC1324.2 +014700 " HIGH ". NC1324.2 +014800 02 FILLER PIC X(22) VALUE NC1324.2 +014900 " LEVEL VALIDATION FOR ". NC1324.2 +015000 02 FILLER PIC X(58) VALUE NC1324.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +015200 01 CCVS-H-3. NC1324.2 +015300 02 FILLER PIC X(34) VALUE NC1324.2 +015400 " FOR OFFICIAL USE ONLY ". NC1324.2 +015500 02 FILLER PIC X(58) VALUE NC1324.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1324.2 +015700 02 FILLER PIC X(28) VALUE NC1324.2 +015800 " COPYRIGHT 1985 ". NC1324.2 +015900 01 CCVS-E-1. NC1324.2 +016000 02 FILLER PIC X(52) VALUE SPACE. NC1324.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1324.2 +016200 02 ID-AGAIN PIC X(9). NC1324.2 +016300 02 FILLER PIC X(45) VALUE SPACES. NC1324.2 +016400 01 CCVS-E-2. NC1324.2 +016500 02 FILLER PIC X(31) VALUE SPACE. NC1324.2 +016600 02 FILLER PIC X(21) VALUE SPACE. NC1324.2 +016700 02 CCVS-E-2-2. NC1324.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1324.2 +016900 03 FILLER PIC X VALUE SPACE. NC1324.2 +017000 03 ENDER-DESC PIC X(44) VALUE NC1324.2 +017100 "ERRORS ENCOUNTERED". NC1324.2 +017200 01 CCVS-E-3. NC1324.2 +017300 02 FILLER PIC X(22) VALUE NC1324.2 +017400 " FOR OFFICIAL USE ONLY". NC1324.2 +017500 02 FILLER PIC X(12) VALUE SPACE. NC1324.2 +017600 02 FILLER PIC X(58) VALUE NC1324.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +017800 02 FILLER PIC X(13) VALUE SPACE. NC1324.2 +017900 02 FILLER PIC X(15) VALUE NC1324.2 +018000 " COPYRIGHT 1985". NC1324.2 +018100 01 CCVS-E-4. NC1324.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1324.2 +018300 02 FILLER PIC X(4) VALUE " OF ". NC1324.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1324.2 +018500 02 FILLER PIC X(40) VALUE NC1324.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1324.2 +018700 01 XXINFO. NC1324.2 +018800 02 FILLER PIC X(19) VALUE NC1324.2 +018900 "*** INFORMATION ***". NC1324.2 +019000 02 INFO-TEXT. NC1324.2 +019100 04 FILLER PIC X(8) VALUE SPACE. NC1324.2 +019200 04 XXCOMPUTED PIC X(20). NC1324.2 +019300 04 FILLER PIC X(5) VALUE SPACE. NC1324.2 +019400 04 XXCORRECT PIC X(20). NC1324.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). NC1324.2 +019600 01 HYPHEN-LINE. NC1324.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. NC1324.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************NC1324.2 +019900- "*****************************************". NC1324.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************NC1324.2 +020100- "******************************". NC1324.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE NC1324.2 +020300 "NC132A". NC1324.2 +020400 PROCEDURE DIVISION. NC1324.2 +020500 CCVS1 SECTION. NC1324.2 +020600 OPEN-FILES. NC1324.2 +020700 OPEN OUTPUT PRINT-FILE. NC1324.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1324.2 +020900 MOVE SPACE TO TEST-RESULTS. NC1324.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1324.2 +021100 GO TO CCVS1-EXIT. NC1324.2 +021200 CLOSE-FILES. NC1324.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1324.2 +021400 TERMINATE-CCVS. NC1324.2 +021500S EXIT PROGRAM. NC1324.2 +021600STERMINATE-CALL. NC1324.2 +021700 STOP RUN. NC1324.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1324.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1324.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1324.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1324.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. NC1324.2 +022300 PRINT-DETAIL. NC1324.2 +022400 IF REC-CT NOT EQUAL TO ZERO NC1324.2 +022500 MOVE "." TO PARDOT-X NC1324.2 +022600 MOVE REC-CT TO DOTVALUE. NC1324.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1324.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1324.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1324.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1324.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1324.2 +023200 MOVE SPACE TO CORRECT-X. NC1324.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1324.2 +023400 MOVE SPACE TO RE-MARK. NC1324.2 +023500 HEAD-ROUTINE. NC1324.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1324.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1324.2 +024000 COLUMN-NAMES-ROUTINE. NC1324.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +024400 END-ROUTINE. NC1324.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1324.2 +024600 END-RTN-EXIT. NC1324.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +024800 END-ROUTINE-1. NC1324.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1324.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1324.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. NC1324.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1324.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1324.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1324.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1324.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1324.2 +025700 END-ROUTINE-12. NC1324.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1324.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1324.2 +026000 MOVE "NO " TO ERROR-TOTAL NC1324.2 +026100 ELSE NC1324.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1324.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1324.2 +026400 PERFORM WRITE-LINE. NC1324.2 +026500 END-ROUTINE-13. NC1324.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1324.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE NC1324.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1324.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1324.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO NC1324.2 +027200 MOVE "NO " TO ERROR-TOTAL NC1324.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1324.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1324.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027700 WRITE-LINE. NC1324.2 +027800 ADD 1 TO RECORD-COUNT. NC1324.2 +027900Y IF RECORD-COUNT GREATER 42 NC1324.2 +028000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1324.2 +028100Y MOVE SPACE TO DUMMY-RECORD NC1324.2 +028200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1324.2 +028300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1324.2 +028400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1324.2 +028500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1324.2 +028600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1324.2 +028700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +028800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +028900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +029000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1324.2 +029100Y MOVE ZERO TO RECORD-COUNT. NC1324.2 +029200 PERFORM WRT-LN. NC1324.2 +029300 WRT-LN. NC1324.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1324.2 +029500 MOVE SPACE TO DUMMY-RECORD. NC1324.2 +029600 BLANK-LINE-PRINT. NC1324.2 +029700 PERFORM WRT-LN. NC1324.2 +029800 FAIL-ROUTINE. NC1324.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE NC1324.2 +030000 GO TO FAIL-ROUTINE-WRITE. NC1324.2 +030100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1324.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1324.2 +030300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1324.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1324.2 +030600 GO TO FAIL-ROUTINE-EX. NC1324.2 +030700 FAIL-ROUTINE-WRITE. NC1324.2 +030800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1324.2 +030900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1324.2 +031000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1324.2 +031100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1324.2 +031200 FAIL-ROUTINE-EX. EXIT. NC1324.2 +031300 BAIL-OUT. NC1324.2 +031400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1324.2 +031500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1324.2 +031600 BAIL-OUT-WRITE. NC1324.2 +031700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1324.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1324.2 +031900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +032000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1324.2 +032100 BAIL-OUT-EX. EXIT. NC1324.2 +032200 CCVS1-EXIT. NC1324.2 +032300 EXIT. NC1324.2 +032400 SECT-TH132A-001 SECTION. NC1324.2 +032500 TH-02-001. NC1324.2 +032600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1324.2 +032700 MOVE TABLE-A-VALUES TO TABLE-A. NC1324.2 +032800 MOVE "SUBSCRIPTING" TO FEATURE. NC1324.2 +032900 SUB-SCRIPT-1. NC1324.2 +033000 IF TABLE-A IS NOT EQUAL TO TABLE-A-VALUES NC1324.2 +033100 GO TO SUB-SCRIPT-1B. NC1324.2 +033200 PERFORM PASS. NC1324.2 +033300 GO TO SUB-SCRIPT-1C. NC1324.2 +033400 SUB-SCRIPT-1A. NC1324.2 +033500 PERFORM DE-LETE. NC1324.2 +033600 GO TO SUB-SCRIPT-1C. NC1324.2 +033700 SUB-SCRIPT-1B. NC1324.2 +033800 PERFORM FAIL. NC1324.2 +033900 MOVE TABLE-A TO COMPUTED-A. NC1324.2 +034000 MOVE "11122233344411223344" TO CORRECT-A. NC1324.2 +034100 SUB-SCRIPT-1C. NC1324.2 +034200 MOVE "SUB-SCRIPT-1" TO PAR-NAME. NC1324.2 +034300 PERFORM PRINT-DETAIL. NC1324.2 +034400* NOTE ******* THIS TEST CHECKS TO SEE THAT THE TABLE NC1324.2 +034500* TO BE USED IN THE PROGRAM IS SET UP NC1324.2 +034600* CORRECTLY. NC1324.2 +034700 SUB-SCRIPT-2. NC1324.2 +034800 IF ENTRY-A-1 (1) NOT EQUAL TO "111" NC1324.2 +034900 GO TO SUB-SCRIPT-2B. NC1324.2 +035000 PERFORM PASS. NC1324.2 +035100 GO TO SUB-SCRIPT-2C. NC1324.2 +035200 SUB-SCRIPT-2A. NC1324.2 +035300 PERFORM DE-LETE. NC1324.2 +035400 GO TO SUB-SCRIPT-2C. NC1324.2 +035500 SUB-SCRIPT-2B. NC1324.2 +035600 PERFORM FAIL. NC1324.2 +035700 MOVE ENTRY-A-1 (1) TO COMPUTED-A NC1324.2 +035800 MOVE "111" TO CORRECT-A. NC1324.2 +035900 SUB-SCRIPT-2C. NC1324.2 +036000 MOVE "SUB-SCRIPT-2" TO PAR-NAME. NC1324.2 +036100 PERFORM PRINT-DETAIL. NC1324.2 +036200* NOTE ****** THIS CHECKS THE USE OF NUMERIC LITERALS NC1324.2 +036300* AS SUBSCRIPTS. NC1324.2 +036400 SUB-SCRIPT-3. NC1324.2 +036500 IF ENTRY-A-1 (SUB1) NOT EQUAL TO "111" NC1324.2 +036600 GO TO SUB-SCRIPT-3B. NC1324.2 +036700 PERFORM PASS. NC1324.2 +036800 GO TO SUB-SCRIPT-3C. NC1324.2 +036900 SUB-SCRIPT-3A. NC1324.2 +037000 PERFORM DE-LETE. NC1324.2 +037100 GO TO SUB-SCRIPT-3C. NC1324.2 +037200 SUB-SCRIPT-3B. NC1324.2 +037300 PERFORM FAIL. NC1324.2 +037400 MOVE ENTRY-A-1 (SUB1) TO COMPUTED-A. NC1324.2 +037500 MOVE "111" TO CORRECT-A. NC1324.2 +037600 SUB-SCRIPT-3C. NC1324.2 +037700 MOVE "SUB-SCRIPT-3" TO PAR-NAME. NC1324.2 +037800 PERFORM PRINT-DETAIL. NC1324.2 +037900* NOTE ******* THIS CHECKS THE USE OF UNSIGNED NC1324.2 +038000* CONSTANTS AS SUBSCRIPTS. NC1324.2 +038100 SUB-SCRIPT-4. NC1324.2 +038200 ADD 1 TO SUB1. NC1324.2 +038300 IF ENTRY-A-1 (SUB1) NOT EQUAL TO "222" NC1324.2 +038400 GO TO SUB-SCRIPT-4B. NC1324.2 +038500 PERFORM PASS. NC1324.2 +038600 GO TO SUB-SCRIPT-4C. NC1324.2 +038700 SUB-SCRIPT-4A. NC1324.2 +038800 PERFORM DE-LETE. NC1324.2 +038900 GO TO SUB-SCRIPT-4C. NC1324.2 +039000 SUB-SCRIPT-4B. NC1324.2 +039100 PERFORM FAIL. NC1324.2 +039200 MOVE ENTRY-A-1 (SUB1) TO COMPUTED-A. NC1324.2 +039300 MOVE "222" TO CORRECT-A. NC1324.2 +039400 SUB-SCRIPT-4C. NC1324.2 +039500 MOVE "SUB-SCRIPT-4" TO PAR-NAME. NC1324.2 +039600 PERFORM PRINT-DETAIL. NC1324.2 +039700* NOTE ******* THIS CHECKS THE VARYING OF AN NC1324.2 +039800* UNSIGNED SUBSCRIPT. NC1324.2 +039900 SUB-SCRIPT-5. NC1324.2 +040000 MOVE +4 TO SUB2. NC1324.2 +040100 IF ENTRY-A-1 (SUB2) NOT EQUAL TO "444" NC1324.2 +040200 GO TO SUB-SCRIPT-5B. NC1324.2 +040300 PERFORM PASS. NC1324.2 +040400 GO TO SUB-SCRIPT-5C. NC1324.2 +040500 SUB-SCRIPT-5A. NC1324.2 +040600 PERFORM DE-LETE. NC1324.2 +040700 GO TO SUB-SCRIPT-5C. NC1324.2 +040800 SUB-SCRIPT-5B. NC1324.2 +040900 PERFORM FAIL. NC1324.2 +041000 MOVE ENTRY-A-1 (SUB2) TO COMPUTED-A. NC1324.2 +041100 MOVE "444" TO CORRECT-A. NC1324.2 +041200 SUB-SCRIPT-5C. NC1324.2 +041300 MOVE "SUB-SCRIPT-5" TO PAR-NAME. NC1324.2 +041400 PERFORM PRINT-DETAIL. NC1324.2 +041500* NOTE ****** THIS CHECKS THE USE OF A SIGNED NC1324.2 +041600* CONSTANT AS SUBSCRIPTS. NC1324.2 +041700 SUB-SCRIPT-6. NC1324.2 +041800 SUBTRACT +1 FROM SUB2. NC1324.2 +041900 IF ENTRY-A-1 (SUB2) NOT EQUAL TO "333" NC1324.2 +042000 GO TO SUB-SCRIPT-6B. NC1324.2 +042100 PERFORM PASS. NC1324.2 +042200 GO TO SUB-SCRIPT-6C. NC1324.2 +042300 SUB-SCRIPT-6A. NC1324.2 +042400 PERFORM DE-LETE. NC1324.2 +042500 GO TO SUB-SCRIPT-6C. NC1324.2 +042600 SUB-SCRIPT-6B. NC1324.2 +042700 PERFORM FAIL. NC1324.2 +042800 MOVE ENTRY-A-1 (SUB2) TO COMPUTED-A. NC1324.2 +042900 MOVE "333" TO CORRECT-A. NC1324.2 +043000 SUB-SCRIPT-6C. NC1324.2 +043100 MOVE "SUB-SCRIPT-6" TO PAR-NAME. NC1324.2 +043200 PERFORM PRINT-DETAIL. NC1324.2 +043300* NOTE ****** THIS CHECKS THE VARYING OF A NC1324.2 +043400* SIGNED SUBSCRIPT. NC1324.2 +043500*SUB-SCRIPT-7. NC1324.2 +043600* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1324.2 +043700* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1324.2 +043800 SUB-SCRIPT-8. NC1324.2 +043900 IF ENTRY-A-3 (2) NOT EQUAL TO "2" NC1324.2 +044000 GO TO SUB-SCRIPT-8B. NC1324.2 +044100 PERFORM PASS. NC1324.2 +044200 GO TO SUB-SCRIPT-8C. NC1324.2 +044300 SUB-SCRIPT-8A. NC1324.2 +044400 PERFORM DE-LETE. NC1324.2 +044500 GO TO SUB-SCRIPT-8C. NC1324.2 +044600 SUB-SCRIPT-8B. NC1324.2 +044700 PERFORM FAIL. NC1324.2 +044800 MOVE ENTRY-A-3 (2) TO COMPUTED-A. NC1324.2 +044900 MOVE "2" TO CORRECT-A. NC1324.2 +045000 SUB-SCRIPT-8C. NC1324.2 +045100 MOVE "SUB-SCRIPT-8" TO PAR-NAME. NC1324.2 +045200 PERFORM PRINT-DETAIL. NC1324.2 +045300* NOTE ***** THIS CHECKS THE USE OF AN ELEMENTARY ITEM NC1324.2 +045400* WHEN THE GROUP ITEM HAS THE OCCURS. NC1324.2 +045500 SUB-SCRIPT-9. NC1324.2 +045600 IF ENTRY-A-2 (4) NOT EQUAL TO "44" NC1324.2 +045700 GO TO SUB-SCRIPT-9B. NC1324.2 +045800 PERFORM PASS. NC1324.2 +045900 GO TO SUB-SCRIPT-9C. NC1324.2 +046000 SUB-SCRIPT-9A. NC1324.2 +046100 PERFORM DE-LETE. NC1324.2 +046200 GO TO SUB-SCRIPT-9C. NC1324.2 +046300 SUB-SCRIPT-9B. NC1324.2 +046400 PERFORM FAIL. NC1324.2 +046500 MOVE ENTRY-A-2 (4) TO COMPUTED-A. NC1324.2 +046600 MOVE "44" TO CORRECT-A. NC1324.2 +046700 SUB-SCRIPT-9C. NC1324.2 +046800 MOVE "SUB-SCRIPT-9" TO PAR-NAME. NC1324.2 +046900 PERFORM PRINT-DETAIL. NC1324.2 +047000* NOTE ******* THIS CHECKS A GROUP ITEM WHEN IT NC1324.2 +047100* HAS THE OCCURS. NC1324.2 +047200 SUB-SCRIPT-10. NC1324.2 +047300 IF ENTRY-B-2 (1) NOT EQUAL TO "1" NC1324.2 +047400 GO TO SUB-SCRIPT-10B. NC1324.2 +047500 PERFORM PASS. NC1324.2 +047600 GO TO SUB-SCRIPT-10C. NC1324.2 +047700 SUB-SCRIPT-10A. NC1324.2 +047800 PERFORM DE-LETE. NC1324.2 +047900 GO TO SUB-SCRIPT-10C. NC1324.2 +048000 SUB-SCRIPT-10B. NC1324.2 +048100 PERFORM FAIL. NC1324.2 +048200 MOVE ENTRY-B-2 (1) TO COMPUTED-A. NC1324.2 +048300 MOVE "1" TO CORRECT-A. NC1324.2 +048400 SUB-SCRIPT-10C. NC1324.2 +048500 MOVE "SUB-SCRIPT-10" TO PAR-NAME. NC1324.2 +048600 PERFORM PRINT-DETAIL. NC1324.2 +048700* NOTE ****** THIS CHECKS THE USE OF THE REDEFINE. NC1324.2 +048800 SUB-SCRIPT-11. NC1324.2 +048900 MOVE ENTRY-B-2 (1) TO ENTRY-C (4). NC1324.2 +049000 MOVE ENTRY-B-2 (2) TO ENTRY-C (3). NC1324.2 +049100 MOVE ENTRY-B-2 (3) TO ENTRY-C (2). NC1324.2 +049200 MOVE ENTRY-B-2 (4) TO ENTRY-C (1). NC1324.2 +049300 IF TABLE-C NOT EQUAL TO "4321" NC1324.2 +049400 GO TO SUB-SCRIPT-11B. NC1324.2 +049500 PERFORM PASS. NC1324.2 +049600 GO TO SUB-SCRIPT-11C. NC1324.2 +049700 SUB-SCRIPT-11A. NC1324.2 +049800 PERFORM DE-LETE. NC1324.2 +049900 GO TO SUB-SCRIPT-11C. NC1324.2 +050000 SUB-SCRIPT-11B. NC1324.2 +050100 PERFORM FAIL. NC1324.2 +050200 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +050300 MOVE "4321" TO CORRECT-A. NC1324.2 +050400 SUB-SCRIPT-11C. NC1324.2 +050500 MOVE "SUB-SCRIPT-11" TO PAR-NAME. NC1324.2 +050600 PERFORM PRINT-DETAIL. NC1324.2 +050700 SUB-SCRIPT-12. NC1324.2 +050800 MOVE "0000" TO TABLE-C. NC1324.2 +050900 ADD ENTRY-B-2 (1) TO ENTRY-C (1). NC1324.2 +051000 ADD ENTRY-B-2 (2) TO ENTRY-C (2). NC1324.2 +051100 ADD ENTRY-B-2 (3) TO ENTRY-C (3). NC1324.2 +051200 ADD ENTRY-B-2 (4) TO ENTRY-C (4). NC1324.2 +051300 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +051400 GO TO SUB-SCRIPT-12B. NC1324.2 +051500 PERFORM PASS. NC1324.2 +051600 GO TO SUB-SCRIPT-12C. NC1324.2 +051700 SUB-SCRIPT-12A. NC1324.2 +051800 PERFORM DE-LETE. NC1324.2 +051900 GO TO SUB-SCRIPT-12C. NC1324.2 +052000 SUB-SCRIPT-12B. NC1324.2 +052100 PERFORM FAIL. NC1324.2 +052200 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +052300 MOVE "1234" TO CORRECT-A. NC1324.2 +052400 SUB-SCRIPT-12C. NC1324.2 +052500 MOVE "SUB-SCRIPT-12" TO PAR-NAME. NC1324.2 +052600 PERFORM PRINT-DETAIL. NC1324.2 +052700* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +052800* IN AN ADD STATEMENT NC1324.2 +052900 SUB-SCRIPT-13. NC1324.2 +053000 MOVE "1234" TO TABLE-C. NC1324.2 +053100 SUBTRACT ENTRY-B-2 (1) FROM ENTRY-C (1). NC1324.2 +053200 SUBTRACT ENTRY-B-2 (2) FROM ENTRY-C (2). NC1324.2 +053300 SUBTRACT ENTRY-B-2 (3) FROM ENTRY-C (3). NC1324.2 +053400 SUBTRACT ENTRY-B-2 (4) FROM ENTRY-C (4). NC1324.2 +053500 IF TABLE-C NOT EQUAL TO "0000" NC1324.2 +053600 GO TO SUB-SCRIPT-13B. NC1324.2 +053700 PERFORM PASS. NC1324.2 +053800 GO TO SUB-SCRIPT-13C. NC1324.2 +053900 SUB-SCRIPT-13A. NC1324.2 +054000 PERFORM DE-LETE. NC1324.2 +054100 GO TO SUB-SCRIPT-13C. NC1324.2 +054200 SUB-SCRIPT-13B. NC1324.2 +054300 PERFORM FAIL. NC1324.2 +054400 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +054500 MOVE "0000" TO CORRECT-A. NC1324.2 +054600 SUB-SCRIPT-13C. NC1324.2 +054700 MOVE "SUB-SCRIPT-13" TO PAR-NAME. NC1324.2 +054800 PERFORM PRINT-DETAIL. NC1324.2 +054900* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +055000* IN A SUBTRACT STATEMENT. NC1324.2 +055100 SUB-SCRIPT-14. NC1324.2 +055200 MOVE "1111" TO TABLE-C. NC1324.2 +055300 MULTIPLY ENTRY-B-2 (1) BY ENTRY-C (1). NC1324.2 +055400 MULTIPLY ENTRY-B-2 (2) BY ENTRY-C (2). NC1324.2 +055500 MULTIPLY ENTRY-B-2 (3) BY ENTRY-C (3). NC1324.2 +055600 MULTIPLY ENTRY-B-2 (4) BY ENTRY-C (4). NC1324.2 +055700 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +055800 GO TO SUB-SCRIPT-14B. NC1324.2 +055900 PERFORM PASS. NC1324.2 +056000 GO TO SUB-SCRIPT-14C. NC1324.2 +056100 SUB-SCRIPT-14A. NC1324.2 +056200 PERFORM DE-LETE. NC1324.2 +056300 GO TO SUB-SCRIPT-14C. NC1324.2 +056400 SUB-SCRIPT-14B. NC1324.2 +056500 PERFORM FAIL. NC1324.2 +056600 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +056700 MOVE "1234" TO CORRECT-A. NC1324.2 +056800 SUB-SCRIPT-14C. NC1324.2 +056900 MOVE "SUB-SCRIPT-14" TO PAR-NAME. NC1324.2 +057000 PERFORM PRINT-DETAIL. NC1324.2 +057100* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +057200* IN A MULTIPLY STATEMENT. NC1324.2 +057300 SUB-SCRIPT-15. NC1324.2 +057400 MOVE "1234" TO TABLE-C. NC1324.2 +057500 DIVIDE ENTRY-B-2 (1) INTO ENTRY-C (1). NC1324.2 +057600 DIVIDE ENTRY-B-2 (2) INTO ENTRY-C (2). NC1324.2 +057700 DIVIDE ENTRY-B-2 (3) INTO ENTRY-C (3). NC1324.2 +057800 DIVIDE ENTRY-B-2 (4) INTO ENTRY-C (4). NC1324.2 +057900 IF TABLE-C NOT EQUAL TO "1111" NC1324.2 +058000 GO TO SUB-SCRIPT-15B. NC1324.2 +058100 PERFORM PASS. NC1324.2 +058200 GO TO SUB-SCRIPT-15C. NC1324.2 +058300 SUB-SCRIPT-15A. NC1324.2 +058400 PERFORM DE-LETE. NC1324.2 +058500 GO TO SUB-SCRIPT-15C. NC1324.2 +058600 SUB-SCRIPT-15B. NC1324.2 +058700 PERFORM FAIL. NC1324.2 +058800 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +058900 MOVE "1111" TO CORRECT-A. NC1324.2 +059000 SUB-SCRIPT-15C. NC1324.2 +059100 MOVE "SUB-SCRIPT-15" TO PAR-NAME. NC1324.2 +059200 PERFORM PRINT-DETAIL. NC1324.2 +059300* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +059400* IN A DIVIDE STATEMENT. NC1324.2 +059500 MOVE TABLE-A-VALUES TO TABLE-A. NC1324.2 +059600 SUB-SCRIPT-16. NC1324.2 +059700 IF ENTRY-A-1 (SUB-3) EQUAL TO "222" NC1324.2 +059800 PERFORM PASS NC1324.2 +059900 GO TO SUB-SCRIPT-16B. NC1324.2 +060000 MOVE "222" TO CORRECT-A. NC1324.2 +060100 MOVE ENTRY-A-1 (SUB-3) TO COMPUTED-A. NC1324.2 +060200 PERFORM FAIL. NC1324.2 +060300 GO TO SUB-SCRIPT-16B. NC1324.2 +060400 SUB-SCRIPT-16A. NC1324.2 +060500 PERFORM DE-LETE. NC1324.2 +060600 SUB-SCRIPT-16B. NC1324.2 +060700 MOVE "SUB-SCRIPT-16" TO PAR-NAME. NC1324.2 +060800* NOTE COMPUTATIONAL SUBSCRIPT USED S9(18). NC1324.2 +060900 PERFORM PRINT-DETAIL. NC1324.2 +061000 SUB-SCRIPT-17. NC1324.2 +061100 IF ENTRY-A-2 (SUB-4) EQUAL TO "44" NC1324.2 +061200 PERFORM PASS NC1324.2 +061300 GO TO SUB-SCRIPT-17B. NC1324.2 +061400 MOVE "44" TO CORRECT-A. NC1324.2 +061500 MOVE ENTRY-A-2 (SUB-4) TO COMPUTED-A. NC1324.2 +061600 PERFORM FAIL. NC1324.2 +061700 GO TO SUB-SCRIPT-17B. NC1324.2 +061800 SUB-SCRIPT-17A. NC1324.2 +061900 PERFORM DE-LETE. NC1324.2 +062000 SUB-SCRIPT-17B. NC1324.2 +062100 MOVE "SUB-SCRIPT-17" TO PAR-NAME. NC1324.2 +062200* NOTE COMPUTATIONAL SUBSCRIPT USED 9(18). NC1324.2 +062300 PERFORM PRINT-DETAIL. NC1324.2 +062400 SUB-SCRIPT-18. NC1324.2 +062500 IF ENTRY-A-2 (+4) EQUAL TO "44" NC1324.2 +062600 PERFORM PASS NC1324.2 +062700 GO TO SUB-SCRIPT-18B. NC1324.2 +062800 MOVE "44" TO CORRECT-A. NC1324.2 +062900 MOVE ENTRY-A-2 (+4) TO COMPUTED-A. NC1324.2 +063000 PERFORM FAIL. NC1324.2 +063100 GO TO SUB-SCRIPT-18B. NC1324.2 +063200 SUB-SCRIPT-18A. NC1324.2 +063300 PERFORM DE-LETE. NC1324.2 +063400 SUB-SCRIPT-18B. NC1324.2 +063500 MOVE "SUB-SCRIPT-18" TO PAR-NAME. NC1324.2 +063600* NOTE SIGNED NUMERIC LITERAL SUBSCRIPT. NC1324.2 +063700 PERFORM PRINT-DETAIL. NC1324.2 +063800 SUB-SCRIPT-19. NC1324.2 +063900 IF ENTRY-A-3 (CON-2) NOT EQUAL TO "2" NC1324.2 +064000 GO TO SUB-SCRIPT-19B. NC1324.2 +064100 PERFORM PASS. NC1324.2 +064200 GO TO SUB-SCRIPT-19C. NC1324.2 +064300 SUB-SCRIPT-19A. NC1324.2 +064400 PERFORM DE-LETE. NC1324.2 +064500 GO TO SUB-SCRIPT-19C. NC1324.2 +064600 SUB-SCRIPT-19B. NC1324.2 +064700 PERFORM FAIL. NC1324.2 +064800 MOVE ENTRY-A-3 (CON-2) TO COMPUTED-A. NC1324.2 +064900 MOVE "2" TO CORRECT-A. NC1324.2 +065000 SUB-SCRIPT-19C. NC1324.2 +065100 MOVE "SUB-SCRIPT-19" TO PAR-NAME. NC1324.2 +065200 PERFORM PRINT-DETAIL. NC1324.2 +065300* NOTE ***** THIS CHECKS THE USE OF AN ELEMENTARY ITEM NC1324.2 +065400* WHEN THE GROUP ITEM HAS THE OCCURS. NC1324.2 +065500 SUB-SCRIPT-20. NC1324.2 +065600 IF ENTRY-A-2 (CON-4) NOT EQUAL TO "44" NC1324.2 +065700 GO TO SUB-SCRIPT-20B. NC1324.2 +065800 PERFORM PASS. NC1324.2 +065900 GO TO SUB-SCRIPT-20C. NC1324.2 +066000 SUB-SCRIPT-20A. NC1324.2 +066100 PERFORM DE-LETE. NC1324.2 +066200 GO TO SUB-SCRIPT-20C. NC1324.2 +066300 SUB-SCRIPT-20B. NC1324.2 +066400 PERFORM FAIL. NC1324.2 +066500 MOVE ENTRY-A-2 (CON-4) TO COMPUTED-A. NC1324.2 +066600 MOVE "44" TO CORRECT-A. NC1324.2 +066700 SUB-SCRIPT-20C. NC1324.2 +066800 MOVE "SUB-SCRIPT-20" TO PAR-NAME. NC1324.2 +066900 PERFORM PRINT-DETAIL. NC1324.2 +067000* NOTE ******* THIS CHECKS A GROUP ITEM WHEN IT NC1324.2 +067100* HAS THE OCCURS. NC1324.2 +067200 SUB-SCRIPT-21. NC1324.2 +067300 IF ENTRY-B-2 (CON-1) NOT EQUAL TO "1" NC1324.2 +067400 GO TO SUB-SCRIPT-21B. NC1324.2 +067500 PERFORM PASS. NC1324.2 +067600 GO TO SUB-SCRIPT-21C. NC1324.2 +067700 SUB-SCRIPT-21A. NC1324.2 +067800 PERFORM DE-LETE. NC1324.2 +067900 GO TO SUB-SCRIPT-21C. NC1324.2 +068000 SUB-SCRIPT-21B. NC1324.2 +068100 PERFORM FAIL. NC1324.2 +068200 MOVE ENTRY-B-2 (CON-1) TO COMPUTED-A. NC1324.2 +068300 MOVE "1" TO CORRECT-A. NC1324.2 +068400 SUB-SCRIPT-21C. NC1324.2 +068500 MOVE "SUB-SCRIPT-21" TO PAR-NAME. NC1324.2 +068600 PERFORM PRINT-DETAIL. NC1324.2 +068700* USE OF ITEM WHICH IS DEFINED WITH BOTH THE REDEFINES NC1324.2 +068800* AND THE OCCURS CLAUSE. NC1324.2 +068900 SUB-SCRIPT-22. NC1324.2 +069000 MOVE ENTRY-B-2 (CON-1) TO ENTRY-C (CON-4). NC1324.2 +069100 MOVE ENTRY-B-2 (CON-2) TO ENTRY-C (CON-3). NC1324.2 +069200 MOVE ENTRY-B-2 (CON-3) TO ENTRY-C (CON-2). NC1324.2 +069300 MOVE ENTRY-B-2 (CON-4) TO ENTRY-C (CON-1). NC1324.2 +069400 IF TABLE-C NOT EQUAL TO "4321" NC1324.2 +069500 GO TO SUB-SCRIPT-22B. NC1324.2 +069600 PERFORM PASS. NC1324.2 +069700 GO TO SUB-SCRIPT-22C. NC1324.2 +069800 SUB-SCRIPT-22A. NC1324.2 +069900 PERFORM DE-LETE. NC1324.2 +070000 GO TO SUB-SCRIPT-22C. NC1324.2 +070100 SUB-SCRIPT-22B. NC1324.2 +070200 PERFORM FAIL. NC1324.2 +070300 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +070400 MOVE "4321" TO CORRECT-A. NC1324.2 +070500 SUB-SCRIPT-22C. NC1324.2 +070600 MOVE "SUB-SCRIPT-22" TO PAR-NAME. NC1324.2 +070700 PERFORM PRINT-DETAIL. NC1324.2 +070800 SUB-SCRIPT-23. NC1324.2 +070900 MOVE "0000" TO TABLE-C. NC1324.2 +071000 ADD ENTRY-B-2 (CON-1) TO ENTRY-C (CON-1). NC1324.2 +071100 ADD ENTRY-B-2 (CON-2) TO ENTRY-C (CON-2). NC1324.2 +071200 ADD ENTRY-B-2 (CON-3) TO ENTRY-C (CON-3). NC1324.2 +071300 ADD ENTRY-B-2 (CON-4) TO ENTRY-C (CON-4). NC1324.2 +071400 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +071500 GO TO SUB-SCRIPT-23B. NC1324.2 +071600 PERFORM PASS. NC1324.2 +071700 GO TO SUB-SCRIPT-23C. NC1324.2 +071800 SUB-SCRIPT-23A. NC1324.2 +071900 PERFORM DE-LETE. NC1324.2 +072000 GO TO SUB-SCRIPT-23C. NC1324.2 +072100 SUB-SCRIPT-23B. NC1324.2 +072200 PERFORM FAIL. NC1324.2 +072300 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +072400 MOVE "1234" TO CORRECT-A. NC1324.2 +072500 SUB-SCRIPT-23C. NC1324.2 +072600 MOVE "SUB-SCRIPT-23" TO PAR-NAME. NC1324.2 +072700 PERFORM PRINT-DETAIL. NC1324.2 +072800* ADD STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTS. NC1324.2 +072900 SUB-SCRIPT-24. NC1324.2 +073000 MOVE "1234" TO TABLE-C. NC1324.2 +073100 SUBTRACT ENTRY-B-2 (CON-1) FROM ENTRY-C (CON-1). NC1324.2 +073200 SUBTRACT ENTRY-B-2 (CON-2) FROM ENTRY-C (CON-2). NC1324.2 +073300 SUBTRACT ENTRY-B-2 (CON-3) FROM ENTRY-C (CON-3). NC1324.2 +073400 SUBTRACT ENTRY-B-2 (CON-4) FROM ENTRY-C (CON-4). NC1324.2 +073500 IF TABLE-C NOT EQUAL TO "0000" NC1324.2 +073600 GO TO SUB-SCRIPT-24B. NC1324.2 +073700 PERFORM PASS. NC1324.2 +073800 GO TO SUB-SCRIPT-24C. NC1324.2 +073900 SUB-SCRIPT-24A. NC1324.2 +074000 PERFORM DE-LETE. NC1324.2 +074100 GO TO SUB-SCRIPT-24C. NC1324.2 +074200 SUB-SCRIPT-24B. NC1324.2 +074300 PERFORM FAIL. NC1324.2 +074400 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +074500 MOVE "0000" TO CORRECT-A. NC1324.2 +074600 SUB-SCRIPT-24C. NC1324.2 +074700 MOVE "SUB-SCRIPT-24" TO PAR-NAME. NC1324.2 +074800 PERFORM PRINT-DETAIL. NC1324.2 +074900* SUBSTRACT STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTNC1324.2 +075000 SUB-SCRIPT-25. NC1324.2 +075100 MOVE "1111" TO TABLE-C. NC1324.2 +075200 MULTIPLY ENTRY-B-2 (CON-1) BY ENTRY-C (CON-1). NC1324.2 +075300 MULTIPLY ENTRY-B-2 (CON-2) BY ENTRY-C (CON-2). NC1324.2 +075400 MULTIPLY ENTRY-B-2 (CON-3) BY ENTRY-C (CON-3). NC1324.2 +075500 MULTIPLY ENTRY-B-2 (CON-4) BY ENTRY-C (CON-4). NC1324.2 +075600 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +075700 GO TO SUB-SCRIPT-25B. NC1324.2 +075800 PERFORM PASS. NC1324.2 +075900 GO TO SUB-SCRIPT-25C. NC1324.2 +076000 SUB-SCRIPT-25A. NC1324.2 +076100 PERFORM DE-LETE. NC1324.2 +076200 GO TO SUB-SCRIPT-25C. NC1324.2 +076300 SUB-SCRIPT-25B. NC1324.2 +076400 PERFORM FAIL. NC1324.2 +076500 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +076600 MOVE "1234" TO CORRECT-A. NC1324.2 +076700 SUB-SCRIPT-25C. NC1324.2 +076800 MOVE "SUB-SCRIPT-25" TO PAR-NAME. NC1324.2 +076900 PERFORM PRINT-DETAIL. NC1324.2 +077000* MULTIPLY STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTSNC1324.2 +077100 SUB-SCRIPT-26. NC1324.2 +077200 MOVE "1234" TO TABLE-C. NC1324.2 +077300 DIVIDE ENTRY-B-2 (CON-1) INTO ENTRY-C (CON-1). NC1324.2 +077400 DIVIDE ENTRY-B-2 (CON-2) INTO ENTRY-C (CON-2). NC1324.2 +077500 DIVIDE ENTRY-B-2 (CON-3) INTO ENTRY-C (CON-3). NC1324.2 +077600 DIVIDE ENTRY-B-2 (CON-4) INTO ENTRY-C (CON-4). NC1324.2 +077700 IF TABLE-C NOT EQUAL TO "1111" NC1324.2 +077800 GO TO SUB-SCRIPT-26B. NC1324.2 +077900 PERFORM PASS. NC1324.2 +078000 GO TO SUB-SCRIPT-26C. NC1324.2 +078100 SUB-SCRIPT-26A. NC1324.2 +078200 PERFORM DE-LETE. NC1324.2 +078300 GO TO SUB-SCRIPT-26C. NC1324.2 +078400 SUB-SCRIPT-26B. NC1324.2 +078500 PERFORM FAIL. NC1324.2 +078600 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +078700 MOVE "1111" TO CORRECT-A. NC1324.2 +078800 SUB-SCRIPT-26C. NC1324.2 +078900 MOVE "SUB-SCRIPT-26" TO PAR-NAME. NC1324.2 +079000 PERFORM PRINT-DETAIL. NC1324.2 +079100* DIVIDE STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTS. NC1324.2 +079200 CCVS-EXIT SECTION. NC1324.2 +079300 CCVS-999999. NC1324.2 +079400 GO TO CLOSE-FILES. NC1324.2 +*END-OF,NC132A +*HEADER,COBOL,NC133A +000100 IDENTIFICATION DIVISION. NC1334.2 +000200 PROGRAM-ID. NC1334.2 +000300 NC133A. NC1334.2 +000400**************************************************************** NC1334.2 +000500* * NC1334.2 +000600* VALIDATION FOR:- * NC1334.2 +000700* * NC1334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +000900* * NC1334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1334.2 +001100* * NC1334.2 +001200**************************************************************** NC1334.2 +001300* * NC1334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1334.2 +001500* * NC1334.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1334.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1334.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1334.2 +001900* * NC1334.2 +002000**************************************************************** NC1334.2 +002100* NC1334.2 +002200* PROGRAM NC133A TESTS THE USE OF FORMAT 1 OF THE SET NC1334.2 +002300* STATEMENT USING VARIOUS INTEGERS, INDEX-NAMES AND NC1334.2 +002400* IDENTIFIERS. NC1334.2 +002500* REDEFINED SINGLE LEVEL TABLES ARE USED. NC1334.2 +002600* NC1334.2 +002700 ENVIRONMENT DIVISION. NC1334.2 +002800 CONFIGURATION SECTION. NC1334.2 +002900 SOURCE-COMPUTER. NC1334.2 +003000 XXXXX082. NC1334.2 +003100 OBJECT-COMPUTER. NC1334.2 +003200 XXXXX083. NC1334.2 +003300 INPUT-OUTPUT SECTION. NC1334.2 +003400 FILE-CONTROL. NC1334.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1334.2 +003600 XXXXX055. NC1334.2 +003700 DATA DIVISION. NC1334.2 +003800 FILE SECTION. NC1334.2 +003900 FD PRINT-FILE. NC1334.2 +004000 01 PRINT-REC PICTURE X(120). NC1334.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1334.2 +004200 WORKING-STORAGE SECTION. NC1334.2 +004300 77 SGN-IDX PIC S9(18) VALUE ZERO. NC1334.2 +004400 77 UNSGN-IDX PIC 9(18) VALUE ZERO. NC1334.2 +004500 77 USE-IDX USAGE INDEX. NC1334.2 +004600 77 COMP-U-IDX18 PICTURE 9(18) COMPUTATIONAL VALUE ZERO. NC1334.2 +004700 77 COMP-S-IDX18 PICTURE S9(18) COMPUTATIONAL VALUE ZERO. NC1334.2 +004800 77 COMP-U-IDX1 PICTURE 9 COMPUTATIONAL VALUE ZERO. NC1334.2 +004900 77 COMP-S-IDX1 PICTURE S9 COMPUTATIONAL VALUE ZERO. NC1334.2 +005000 01 INDEX-VALUE PIC 9999. NC1334.2 +005100 01 TABLE-A-VALUES PIC X(20) VALUE "11122233344415263748". NC1334.2 +005200 01 TABLE-A. NC1334.2 +005300 02 ENTRY-A-1 PICTURE XXX OCCURS 4 TIMES INDEXED IDX-1. NC1334.2 +005400 02 ENTRY-A-2 OCCURS 4 TIMES INDEXED BY IDX-2. NC1334.2 +005500 03 ENTRY-A-3 PIC X. NC1334.2 +005600 03 ENTRY-A-4 PIC X. NC1334.2 +005700 01 TABLE-A1 REDEFINES TABLE-A. NC1334.2 +005800 02 ENTRY-A-5 PICTURE XXX OCCURS 4 TIMES. NC1334.2 +005900 02 ENTRY-A-6 OCCURS 4 TIMES INDEXED BY IDX-X2. NC1334.2 +006000 03 ENTRY-A-7 PIC X. NC1334.2 +006100 03 ENTRY-A-8 PIC X. NC1334.2 +006200 01 TABLE-B. NC1334.2 +006300 02 ENTRY-B-1 PIC X(4) VALUE "1234". NC1334.2 +006400 02 ENTRY-B-2 REDEFINES ENTRY-B-1 PIC 9 OCCURS 4 INDEXED NC1334.2 +006500 BY IDX-3. NC1334.2 +006600 01 TEST-RESULTS. NC1334.2 +006700 02 FILLER PIC X VALUE SPACE. NC1334.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. NC1334.2 +006900 02 FILLER PIC X VALUE SPACE. NC1334.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. NC1334.2 +007100 02 FILLER PIC X VALUE SPACE. NC1334.2 +007200 02 PAR-NAME. NC1334.2 +007300 03 FILLER PIC X(19) VALUE SPACE. NC1334.2 +007400 03 PARDOT-X PIC X VALUE SPACE. NC1334.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. NC1334.2 +007600 02 FILLER PIC X(8) VALUE SPACE. NC1334.2 +007700 02 RE-MARK PIC X(61). NC1334.2 +007800 01 TEST-COMPUTED. NC1334.2 +007900 02 FILLER PIC X(30) VALUE SPACE. NC1334.2 +008000 02 FILLER PIC X(17) VALUE NC1334.2 +008100 " COMPUTED=". NC1334.2 +008200 02 COMPUTED-X. NC1334.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1334.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A NC1334.2 +008500 PIC -9(9).9(9). NC1334.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1334.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1334.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1334.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. NC1334.2 +009000 04 COMPUTED-18V0 PIC -9(18). NC1334.2 +009100 04 FILLER PIC X. NC1334.2 +009200 03 FILLER PIC X(50) VALUE SPACE. NC1334.2 +009300 01 TEST-CORRECT. NC1334.2 +009400 02 FILLER PIC X(30) VALUE SPACE. NC1334.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1334.2 +009600 02 CORRECT-X. NC1334.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1334.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1334.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1334.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1334.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1334.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. NC1334.2 +010300 04 CORRECT-18V0 PIC -9(18). NC1334.2 +010400 04 FILLER PIC X. NC1334.2 +010500 03 FILLER PIC X(2) VALUE SPACE. NC1334.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1334.2 +010700 01 CCVS-C-1. NC1334.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1334.2 +010900- "SS PARAGRAPH-NAME NC1334.2 +011000- " REMARKS". NC1334.2 +011100 02 FILLER PIC X(20) VALUE SPACE. NC1334.2 +011200 01 CCVS-C-2. NC1334.2 +011300 02 FILLER PIC X VALUE SPACE. NC1334.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". NC1334.2 +011500 02 FILLER PIC X(15) VALUE SPACE. NC1334.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". NC1334.2 +011700 02 FILLER PIC X(94) VALUE SPACE. NC1334.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1334.2 +011900 01 REC-CT PIC 99 VALUE ZERO. NC1334.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1334.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1334.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1334.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1334.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1334.2 +012900 01 CCVS-H-1. NC1334.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC1334.2 +013100 02 FILLER PIC X(42) VALUE NC1334.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1334.2 +013300 02 FILLER PIC X(39) VALUE SPACES. NC1334.2 +013400 01 CCVS-H-2A. NC1334.2 +013500 02 FILLER PIC X(40) VALUE SPACE. NC1334.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1334.2 +013700 02 FILLER PIC XXXX VALUE NC1334.2 +013800 "4.2 ". NC1334.2 +013900 02 FILLER PIC X(28) VALUE NC1334.2 +014000 " COPY - NOT FOR DISTRIBUTION". NC1334.2 +014100 02 FILLER PIC X(41) VALUE SPACE. NC1334.2 +014200 NC1334.2 +014300 01 CCVS-H-2B. NC1334.2 +014400 02 FILLER PIC X(15) VALUE NC1334.2 +014500 "TEST RESULT OF ". NC1334.2 +014600 02 TEST-ID PIC X(9). NC1334.2 +014700 02 FILLER PIC X(4) VALUE NC1334.2 +014800 " IN ". NC1334.2 +014900 02 FILLER PIC X(12) VALUE NC1334.2 +015000 " HIGH ". NC1334.2 +015100 02 FILLER PIC X(22) VALUE NC1334.2 +015200 " LEVEL VALIDATION FOR ". NC1334.2 +015300 02 FILLER PIC X(58) VALUE NC1334.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +015500 01 CCVS-H-3. NC1334.2 +015600 02 FILLER PIC X(34) VALUE NC1334.2 +015700 " FOR OFFICIAL USE ONLY ". NC1334.2 +015800 02 FILLER PIC X(58) VALUE NC1334.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1334.2 +016000 02 FILLER PIC X(28) VALUE NC1334.2 +016100 " COPYRIGHT 1985 ". NC1334.2 +016200 01 CCVS-E-1. NC1334.2 +016300 02 FILLER PIC X(52) VALUE SPACE. NC1334.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1334.2 +016500 02 ID-AGAIN PIC X(9). NC1334.2 +016600 02 FILLER PIC X(45) VALUE SPACES. NC1334.2 +016700 01 CCVS-E-2. NC1334.2 +016800 02 FILLER PIC X(31) VALUE SPACE. NC1334.2 +016900 02 FILLER PIC X(21) VALUE SPACE. NC1334.2 +017000 02 CCVS-E-2-2. NC1334.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1334.2 +017200 03 FILLER PIC X VALUE SPACE. NC1334.2 +017300 03 ENDER-DESC PIC X(44) VALUE NC1334.2 +017400 "ERRORS ENCOUNTERED". NC1334.2 +017500 01 CCVS-E-3. NC1334.2 +017600 02 FILLER PIC X(22) VALUE NC1334.2 +017700 " FOR OFFICIAL USE ONLY". NC1334.2 +017800 02 FILLER PIC X(12) VALUE SPACE. NC1334.2 +017900 02 FILLER PIC X(58) VALUE NC1334.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +018100 02 FILLER PIC X(13) VALUE SPACE. NC1334.2 +018200 02 FILLER PIC X(15) VALUE NC1334.2 +018300 " COPYRIGHT 1985". NC1334.2 +018400 01 CCVS-E-4. NC1334.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1334.2 +018600 02 FILLER PIC X(4) VALUE " OF ". NC1334.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1334.2 +018800 02 FILLER PIC X(40) VALUE NC1334.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1334.2 +019000 01 XXINFO. NC1334.2 +019100 02 FILLER PIC X(19) VALUE NC1334.2 +019200 "*** INFORMATION ***". NC1334.2 +019300 02 INFO-TEXT. NC1334.2 +019400 04 FILLER PIC X(8) VALUE SPACE. NC1334.2 +019500 04 XXCOMPUTED PIC X(20). NC1334.2 +019600 04 FILLER PIC X(5) VALUE SPACE. NC1334.2 +019700 04 XXCORRECT PIC X(20). NC1334.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). NC1334.2 +019900 01 HYPHEN-LINE. NC1334.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. NC1334.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************NC1334.2 +020200- "*****************************************". NC1334.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************NC1334.2 +020400- "******************************". NC1334.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE NC1334.2 +020600 "NC133A". NC1334.2 +020700 PROCEDURE DIVISION. NC1334.2 +020800 CCVS1 SECTION. NC1334.2 +020900 OPEN-FILES. NC1334.2 +021000 OPEN OUTPUT PRINT-FILE. NC1334.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1334.2 +021200 MOVE SPACE TO TEST-RESULTS. NC1334.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1334.2 +021400 GO TO CCVS1-EXIT. NC1334.2 +021500 CLOSE-FILES. NC1334.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1334.2 +021700 TERMINATE-CCVS. NC1334.2 +021800S EXIT PROGRAM. NC1334.2 +021900STERMINATE-CALL. NC1334.2 +022000 STOP RUN. NC1334.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1334.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1334.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1334.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1334.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. NC1334.2 +022600 PRINT-DETAIL. NC1334.2 +022700 IF REC-CT NOT EQUAL TO ZERO NC1334.2 +022800 MOVE "." TO PARDOT-X NC1334.2 +022900 MOVE REC-CT TO DOTVALUE. NC1334.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1334.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1334.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1334.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1334.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1334.2 +023500 MOVE SPACE TO CORRECT-X. NC1334.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1334.2 +023700 MOVE SPACE TO RE-MARK. NC1334.2 +023800 HEAD-ROUTINE. NC1334.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1334.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1334.2 +024300 COLUMN-NAMES-ROUTINE. NC1334.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +024700 END-ROUTINE. NC1334.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1334.2 +024900 END-RTN-EXIT. NC1334.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +025100 END-ROUTINE-1. NC1334.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1334.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1334.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. NC1334.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1334.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1334.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1334.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1334.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1334.2 +026000 END-ROUTINE-12. NC1334.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1334.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1334.2 +026300 MOVE "NO " TO ERROR-TOTAL NC1334.2 +026400 ELSE NC1334.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1334.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1334.2 +026700 PERFORM WRITE-LINE. NC1334.2 +026800 END-ROUTINE-13. NC1334.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1334.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE NC1334.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1334.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1334.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO NC1334.2 +027500 MOVE "NO " TO ERROR-TOTAL NC1334.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1334.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1334.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +028000 WRITE-LINE. NC1334.2 +028100 ADD 1 TO RECORD-COUNT. NC1334.2 +028200Y IF RECORD-COUNT GREATER 42 NC1334.2 +028300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1334.2 +028400Y MOVE SPACE TO DUMMY-RECORD NC1334.2 +028500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1334.2 +028600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1334.2 +028700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1334.2 +028800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1334.2 +028900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1334.2 +029000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1334.2 +029400Y MOVE ZERO TO RECORD-COUNT. NC1334.2 +029500 PERFORM WRT-LN. NC1334.2 +029600 WRT-LN. NC1334.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1334.2 +029800 MOVE SPACE TO DUMMY-RECORD. NC1334.2 +029900 BLANK-LINE-PRINT. NC1334.2 +030000 PERFORM WRT-LN. NC1334.2 +030100 FAIL-ROUTINE. NC1334.2 +030200 IF COMPUTED-X NOT EQUAL TO SPACE NC1334.2 +030300 GO TO FAIL-ROUTINE-WRITE. NC1334.2 +030400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1334.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1334.2 +030600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1334.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1334.2 +030900 GO TO FAIL-ROUTINE-EX. NC1334.2 +031000 FAIL-ROUTINE-WRITE. NC1334.2 +031100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1334.2 +031200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1334.2 +031300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1334.2 +031400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1334.2 +031500 FAIL-ROUTINE-EX. EXIT. NC1334.2 +031600 BAIL-OUT. NC1334.2 +031700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1334.2 +031800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1334.2 +031900 BAIL-OUT-WRITE. NC1334.2 +032000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1334.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1334.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1334.2 +032400 BAIL-OUT-EX. EXIT. NC1334.2 +032500 CCVS1-EXIT. NC1334.2 +032600 EXIT. NC1334.2 +032700 SECT-TH133A-001 SECTION. NC1334.2 +032800 TH-04-001. NC1334.2 +032900 IDX-INIT-A. NC1334.2 +033000 MOVE "INDEXING " TO FEATURE. NC1334.2 +033100 MOVE TABLE-A-VALUES TO TABLE-A. NC1334.2 +033200 IF TABLE-A EQUAL TO TABLE-A-VALUES NC1334.2 +033300 PERFORM PASS NC1334.2 +033400 MOVE "TABLE CREATED CORRECTLY" TO RE-MARK NC1334.2 +033500 GO TO INIT-WRITE. NC1334.2 +033600 MOVE "TABLE CREATED INCORRECTLY" TO RE-MARK. NC1334.2 +033700 PERFORM FAIL. NC1334.2 +033800 PERFORM INIT-WRITE. NC1334.2 +033900 GO TO CCVS-EXIT. NC1334.2 +034000 INIT-WRITE. NC1334.2 +034100 MOVE "TABLE BUILD" TO PAR-NAME. NC1334.2 +034200 PERFORM PRINT-DETAIL. NC1334.2 +034300 IDX-TEST-1. NC1334.2 +034400 SET IDX-1 TO 3. NC1334.2 +034500 IF ENTRY-A-1 (IDX-1) EQUAL TO "333" NC1334.2 +034600 PERFORM PASS NC1334.2 +034700 GO TO IDX-WRITE-1. NC1334.2 +034800 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +034900 MOVE "333" TO CORRECT-A. NC1334.2 +035000 PERFORM FAIL. NC1334.2 +035100 GO TO IDX-WRITE-1. NC1334.2 +035200 IDX-DELETE-1. NC1334.2 +035300 PERFORM DE-LETE. NC1334.2 +035400 IDX-WRITE-1. NC1334.2 +035500 MOVE "IDX-TEST-1 " TO PAR-NAME. NC1334.2 +035600 PERFORM PRINT-DETAIL. NC1334.2 +035700 IDX-TEST-2. NC1334.2 +035800 SET IDX-1 TO 2. NC1334.2 +035900 IF ENTRY-A-1 (IDX-1) EQUAL TO "222" NC1334.2 +036000 PERFORM PASS NC1334.2 +036100 GO TO IDX-WRITE-2. NC1334.2 +036200 MOVE 222 TO CORRECT-A. NC1334.2 +036300 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +036400 PERFORM FAIL. NC1334.2 +036500 GO TO IDX-WRITE-2. NC1334.2 +036600 IDX-DELETE-2. NC1334.2 +036700 PERFORM DE-LETE. NC1334.2 +036800 IDX-WRITE-2. NC1334.2 +036900 MOVE "IDX-TEST-2" TO PAR-NAME. NC1334.2 +037000 PERFORM PRINT-DETAIL. NC1334.2 +037100 IDX-TEST-3. NC1334.2 +037200 SET IDX-1 TO 000001. NC1334.2 +037300 IF ENTRY-A-1 (IDX-1) EQUAL TO "111" NC1334.2 +037400 PERFORM PASS NC1334.2 +037500 GO TO IDX-WRITE-3. NC1334.2 +037600 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +037700 MOVE 111 TO CORRECT-A. NC1334.2 +037800 PERFORM FAIL. NC1334.2 +037900 GO TO IDX-WRITE-3. NC1334.2 +038000 IDX-DELETE-3. NC1334.2 +038100 PERFORM DE-LETE. NC1334.2 +038200 IDX-WRITE-3. NC1334.2 +038300 MOVE "IDX-TEST-3" TO PAR-NAME. NC1334.2 +038400 PERFORM PRINT-DETAIL. NC1334.2 +038500 IDX-TEST-4. NC1334.2 +038600 SET IDX-1 TO 000000000000000004. NC1334.2 +038700 IF ENTRY-A-1 (IDX-1) EQUAL TO "444" NC1334.2 +038800 PERFORM PASS NC1334.2 +038900 GO TO IDX-WRITE-4. NC1334.2 +039000 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +039100 MOVE 444 TO CORRECT-A. NC1334.2 +039200 PERFORM FAIL. NC1334.2 +039300 GO TO IDX-WRITE-4. NC1334.2 +039400 IDX-DELETE-4. NC1334.2 +039500 PERFORM DE-LETE. NC1334.2 +039600 IDX-WRITE-4. NC1334.2 +039700 MOVE "IDX-TEST-4" TO PAR-NAME. NC1334.2 +039800 PERFORM PRINT-DETAIL. NC1334.2 +039900 IDX-TEST-5. NC1334.2 +040000 MOVE 3 TO SGN-IDX. NC1334.2 +040100 SET IDX-2 TO SGN-IDX. NC1334.2 +040200 IF ENTRY-A-4 (IDX-2) EQUAL TO "7" NC1334.2 +040300 PERFORM PASS NC1334.2 +040400 GO TO IDX-WRITE-5. NC1334.2 +040500 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +040600 MOVE 7 TO CORRECT-A. NC1334.2 +040700 PERFORM FAIL. NC1334.2 +040800 GO TO IDX-WRITE-5. NC1334.2 +040900 IDX-DELETE-5. NC1334.2 +041000 PERFORM DE-LETE. NC1334.2 +041100 IDX-WRITE-5. NC1334.2 +041200 MOVE "IDX-TEST-5" TO PAR-NAME. NC1334.2 +041300 PERFORM PRINT-DETAIL. NC1334.2 +041400 MOVE "SET STATEMENT" TO FEATURE. NC1334.2 +041500 IDX-TEST-6. NC1334.2 +041600 MOVE 1 TO UNSGN-IDX. NC1334.2 +041700 SET IDX-2 TO UNSGN-IDX. NC1334.2 +041800 IF ENTRY-A-2 (IDX-2) EQUAL TO "15" NC1334.2 +041900 PERFORM PASS NC1334.2 +042000 GO TO IDX-WRITE-6. NC1334.2 +042100 MOVE ENTRY-A-2 (IDX-2) TO COMPUTED-A. NC1334.2 +042200 MOVE 15 TO CORRECT-A. NC1334.2 +042300 PERFORM FAIL. NC1334.2 +042400 GO TO IDX-WRITE-6. NC1334.2 +042500 IDX-DELETE-6. NC1334.2 +042600 PERFORM DE-LETE. NC1334.2 +042700 IDX-WRITE-6. NC1334.2 +042800 MOVE "IDX-TEST-6" TO PAR-NAME. NC1334.2 +042900 PERFORM PRINT-DETAIL. NC1334.2 +043000 IDX-TEST-7. NC1334.2 +043100 SET IDX-1 TO 4. NC1334.2 +043200 SET IDX-2 TO IDX-1. NC1334.2 +043300 IF IDX-2 EQUAL TO 4 NC1334.2 +043400 PERFORM PASS NC1334.2 +043500 GO TO IDX-WRITE-7. NC1334.2 +043600 MOVE 4 TO CORRECT-A. NC1334.2 +043700 SET INDEX-VALUE TO IDX-2. NC1334.2 +043800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +043900 PERFORM FAIL. NC1334.2 +044000 GO TO IDX-WRITE-7. NC1334.2 +044100 IDX-DELETE-7. NC1334.2 +044200 PERFORM DE-LETE. NC1334.2 +044300 IDX-WRITE-7. NC1334.2 +044400 MOVE "IDX-TEST-7" TO PAR-NAME. NC1334.2 +044500 PERFORM PRINT-DETAIL. NC1334.2 +044600 IDX-TEST-8. NC1334.2 +044700 SET IDX-1 TO 4. NC1334.2 +044800 SET IDX-2 TO IDX-1. NC1334.2 +044900 IF ENTRY-A-4 (IDX-2) EQUAL TO "8" NC1334.2 +045000 PERFORM PASS NC1334.2 +045100 GO TO IDX-WRITE-8. NC1334.2 +045200 MOVE 8 TO CORRECT-A. NC1334.2 +045300 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +045400 PERFORM FAIL. NC1334.2 +045500 GO TO IDX-WRITE-8. NC1334.2 +045600 IDX-DELETE-8. NC1334.2 +045700 PERFORM DE-LETE. NC1334.2 +045800 IDX-WRITE-8. NC1334.2 +045900 MOVE "IDX-TEST-8" TO PAR-NAME. NC1334.2 +046000 PERFORM PRINT-DETAIL. NC1334.2 +046100 IDX-TEST-9. NC1334.2 +046200 SET IDX-X2 TO 02. NC1334.2 +046300 SET USE-IDX TO IDX-X2. NC1334.2 +046400 SET IDX-2 TO USE-IDX. NC1334.2 +046500 IF IDX-2 EQUAL TO 2 NC1334.2 +046600 PERFORM PASS NC1334.2 +046700 GO TO IDX-WRITE-9. NC1334.2 +046800 MOVE 2 TO CORRECT-A. NC1334.2 +046900 SET INDEX-VALUE TO IDX-2. NC1334.2 +047000 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +047100 PERFORM FAIL. NC1334.2 +047200 GO TO IDX-WRITE-9. NC1334.2 +047300 IDX-DELETE-9. NC1334.2 +047400 PERFORM DE-LETE. NC1334.2 +047500 IDX-WRITE-9. NC1334.2 +047600 MOVE "IDX-TEST-9" TO PAR-NAME. NC1334.2 +047700 PERFORM PRINT-DETAIL. NC1334.2 +047800 IDX-TEST-10. NC1334.2 +047900 SET IDX-2 TO 4. NC1334.2 +048000 SET USE-IDX TO IDX-2. NC1334.2 +048100 SET IDX-X2 TO USE-IDX. NC1334.2 +048200 IF ENTRY-A-8 (IDX-X2) EQUAL TO ENTRY-A-4 (IDX-2) NC1334.2 +048300 PERFORM PASS NC1334.2 +048400 GO TO IDX-WRITE-10. NC1334.2 +048500 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +048600 MOVE ENTRY-A-8 (IDX-X2) TO CORRECT-A. NC1334.2 +048700 MOVE "TABLE ENTRIES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +048800 PERFORM FAIL. NC1334.2 +048900 GO TO IDX-WRITE-10. NC1334.2 +049000 IDX-DELETE-10. NC1334.2 +049100 PERFORM DE-LETE. NC1334.2 +049200 IDX-WRITE-10. NC1334.2 +049300 MOVE "IDX-TEST-10" TO PAR-NAME. NC1334.2 +049400 PERFORM PRINT-DETAIL. NC1334.2 +049500 IDX-TEST-11. NC1334.2 +049600 SET IDX-3 TO 0004. NC1334.2 +049700 IF ENTRY-B-2 (IDX-3) EQUAL TO 4 NC1334.2 +049800 PERFORM PASS NC1334.2 +049900 GO TO IDX-WRITE-11. NC1334.2 +050000 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +050100 MOVE 4 TO CORRECT-A. NC1334.2 +050200 PERFORM FAIL. NC1334.2 +050300 GO TO IDX-WRITE-11. NC1334.2 +050400 IDX-DELETE-11. NC1334.2 +050500 PERFORM DE-LETE. NC1334.2 +050600 IDX-WRITE-11. NC1334.2 +050700 MOVE "IDX-TEST-11" TO PAR-NAME. NC1334.2 +050800 PERFORM PRINT-DETAIL. NC1334.2 +050900 IDX-TEST-12. NC1334.2 +051000 SET IDX-3 TO 0000002. NC1334.2 +051100 IF ENTRY-B-2 (IDX-3) EQUAL TO 2 NC1334.2 +051200 PERFORM PASS NC1334.2 +051300 GO TO IDX-WRITE-12. NC1334.2 +051400 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +051500 MOVE 2 TO CORRECT-A. NC1334.2 +051600 PERFORM FAIL. NC1334.2 +051700 GO TO IDX-WRITE-12. NC1334.2 +051800 IDX-DELETE-12. NC1334.2 +051900 PERFORM DE-LETE. NC1334.2 +052000 IDX-WRITE-12. NC1334.2 +052100 MOVE "IDX-TEST-12" TO PAR-NAME. NC1334.2 +052200 PERFORM PRINT-DETAIL. NC1334.2 +052300 IDX-TEST-13. NC1334.2 +052400 SET IDX-3 TO 000000000000000003. NC1334.2 +052500 IF ENTRY-B-2 (IDX-3) EQUAL TO 3 NC1334.2 +052600 PERFORM PASS NC1334.2 +052700 GO TO IDX-WRITE-13. NC1334.2 +052800 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +052900 MOVE 3 TO CORRECT-A. NC1334.2 +053000 PERFORM FAIL. NC1334.2 +053100 GO TO IDX-WRITE-13. NC1334.2 +053200 IDX-DELETE-13. NC1334.2 +053300 PERFORM DE-LETE. NC1334.2 +053400 IDX-WRITE-13. NC1334.2 +053500 MOVE "IDX-TEST-13" TO PAR-NAME. NC1334.2 +053600 PERFORM PRINT-DETAIL. NC1334.2 +053700 IDX-TEST-14. NC1334.2 +053800 SET IDX-3 TO 000000000000000004. NC1334.2 +053900 IF ENTRY-B-2 (IDX-3) EQUAL TO 4 NC1334.2 +054000 PERFORM PASS NC1334.2 +054100 GO TO IDX-WRITE-14. NC1334.2 +054200 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +054300 MOVE 4 TO CORRECT-A. NC1334.2 +054400 PERFORM FAIL. NC1334.2 +054500 GO TO IDX-WRITE-14. NC1334.2 +054600 IDX-DELETE-14. NC1334.2 +054700 PERFORM DE-LETE. NC1334.2 +054800 IDX-WRITE-14. NC1334.2 +054900 MOVE "IDX-TEST-14" TO PAR-NAME. NC1334.2 +055000 PERFORM PRINT-DETAIL. NC1334.2 +055100 IDX-TEST-15. NC1334.2 +055200 SET IDX-3 TO 000000000000000002. NC1334.2 +055300 IF ENTRY-B-2 (IDX-3) EQUAL TO 2 NC1334.2 +055400 PERFORM PASS NC1334.2 +055500 GO TO IDX-WRITE-15. NC1334.2 +055600 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +055700 MOVE 2 TO CORRECT-A. NC1334.2 +055800 PERFORM FAIL. NC1334.2 +055900 GO TO IDX-WRITE-15. NC1334.2 +056000 IDX-DELETE-15. NC1334.2 +056100 PERFORM DE-LETE. NC1334.2 +056200 IDX-WRITE-15. NC1334.2 +056300 MOVE "IDX-TEST-15" TO PAR-NAME. NC1334.2 +056400 PERFORM PRINT-DETAIL. NC1334.2 +056500 IDX-TEST-16. NC1334.2 +056600 SET IDX-3 TO 03. NC1334.2 +056700 SET IDX-2 TO 03. NC1334.2 +056800 IF ENTRY-A-3 (IDX-2) EQUAL TO ENTRY-B-2 (IDX-3) NC1334.2 +056900 PERFORM PASS NC1334.2 +057000 GO TO IDX-WRITE-16. NC1334.2 +057100 MOVE ENTRY-A-3 (IDX-2) TO COMPUTED-A. NC1334.2 +057200 MOVE ENTRY-B-2 (IDX-3) TO CORRECT-A. NC1334.2 +057300 MOVE "TABLE ENTRIES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +057400 PERFORM FAIL. NC1334.2 +057500 GO TO IDX-WRITE-16. NC1334.2 +057600 IDX-DELETE-16. NC1334.2 +057700 PERFORM DE-LETE. NC1334.2 +057800 IDX-WRITE-16. NC1334.2 +057900 MOVE "IDX-TEST-16" TO PAR-NAME. NC1334.2 +058000 PERFORM PRINT-DETAIL. NC1334.2 +058100 IDX-TEST-17. NC1334.2 +058200 MOVE 3 TO COMP-U-IDX18. NC1334.2 +058300 SET IDX-1 TO COMP-U-IDX18. NC1334.2 +058400 IF ENTRY-A-1 (IDX-1) EQUAL TO "333" NC1334.2 +058500 PERFORM PASS NC1334.2 +058600 GO TO IDX-WRITE-17. NC1334.2 +058700 MOVE "333" TO CORRECT-A. NC1334.2 +058800 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +058900 PERFORM FAIL. NC1334.2 +059000 GO TO IDX-WRITE-17. NC1334.2 +059100 IDX-DELETE-17. NC1334.2 +059200 PERFORM DE-LETE. NC1334.2 +059300 IDX-WRITE-17. NC1334.2 +059400 MOVE "IDX-TEST-17" TO PAR-NAME. NC1334.2 +059500 PERFORM PRINT-DETAIL. NC1334.2 +059600 IDX-TEST-18. NC1334.2 +059700 MOVE 4 TO COMP-S-IDX18. NC1334.2 +059800 SET IDX-2 TO COMP-S-IDX18. NC1334.2 +059900 IF ENTRY-A-2 (IDX-2) EQUAL TO "48" NC1334.2 +060000 PERFORM PASS NC1334.2 +060100 GO TO IDX-WRITE-18. NC1334.2 +060200 MOVE "48" TO CORRECT-A. NC1334.2 +060300 MOVE ENTRY-A-2 (IDX-2) TO COMPUTED-A. NC1334.2 +060400 PERFORM FAIL. NC1334.2 +060500 GO TO IDX-WRITE-18. NC1334.2 +060600 IDX-DELETE-18. NC1334.2 +060700 PERFORM DE-LETE. NC1334.2 +060800 IDX-WRITE-18. NC1334.2 +060900 MOVE "IDX-TEST-18" TO PAR-NAME. NC1334.2 +061000 PERFORM PRINT-DETAIL. NC1334.2 +061100 IDX-TEST-19. NC1334.2 +061200 MOVE 1 TO COMP-U-IDX1. NC1334.2 +061300 SET IDX-3 TO COMP-U-IDX1. NC1334.2 +061400 IF ENTRY-B-2 (IDX-3) EQUAL TO 1 NC1334.2 +061500 PERFORM PASS NC1334.2 +061600 GO TO IDX-WRITE-19. NC1334.2 +061700 MOVE "1" TO CORRECT-A. NC1334.2 +061800 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +061900 PERFORM FAIL. NC1334.2 +062000 GO TO IDX-WRITE-19. NC1334.2 +062100 IDX-DELETE-19. NC1334.2 +062200 PERFORM DE-LETE. NC1334.2 +062300 IDX-WRITE-19. NC1334.2 +062400 MOVE "IDX-TEST-19" TO PAR-NAME. NC1334.2 +062500 PERFORM PRINT-DETAIL. NC1334.2 +062600 IDX-TEST-20. NC1334.2 +062700 MOVE 2 TO COMP-S-IDX1. NC1334.2 +062800 SET IDX-2 TO COMP-S-IDX1. NC1334.2 +062900 IF ENTRY-A-3 (IDX-2) EQUAL TO "2" NC1334.2 +063000 PERFORM PASS NC1334.2 +063100 GO TO IDX-WRITE-20. NC1334.2 +063200 MOVE "2" TO CORRECT-A. NC1334.2 +063300 MOVE ENTRY-A-3 (IDX-2) TO COMPUTED-A. NC1334.2 +063400 PERFORM FAIL. NC1334.2 +063500 GO TO IDX-WRITE-20. NC1334.2 +063600 IDX-DELETE-20. NC1334.2 +063700 PERFORM DE-LETE. NC1334.2 +063800 IDX-WRITE-20. NC1334.2 +063900 MOVE "IDX-TEST-20" TO PAR-NAME. NC1334.2 +064000 PERFORM PRINT-DETAIL. NC1334.2 +064100 IDX-TEST-21. NC1334.2 +064200 SET IDX-1 TO 3. NC1334.2 +064300 SET COMP-S-IDX18 TO IDX-1. NC1334.2 +064400 IF COMP-S-IDX18 EQUAL TO +3 NC1334.2 +064500 PERFORM PASS NC1334.2 +064600 GO TO IDX-WRITE-21. NC1334.2 +064700 MOVE +3 TO CORRECT-N. NC1334.2 +064800 MOVE COMP-S-IDX18 TO COMPUTED-N. NC1334.2 +064900 PERFORM FAIL. NC1334.2 +065000 GO TO IDX-WRITE-21. NC1334.2 +065100 IDX-DELETE-21. NC1334.2 +065200 PERFORM DE-LETE. NC1334.2 +065300 IDX-WRITE-21. NC1334.2 +065400 MOVE "IDX-TEST-21" TO PAR-NAME. NC1334.2 +065500 PERFORM PRINT-DETAIL. NC1334.2 +065600 IDX-TEST-22. NC1334.2 +065700 SET IDX-2 TO 2. NC1334.2 +065800 SET COMP-U-IDX1 TO IDX-2. NC1334.2 +065900 IF COMP-U-IDX1 EQUAL TO 2 NC1334.2 +066000 PERFORM PASS NC1334.2 +066100 GO TO IDX-WRITE-22. NC1334.2 +066200 MOVE COMP-U-IDX1 TO COMPUTED-N. NC1334.2 +066300 MOVE 2 TO CORRECT-N. NC1334.2 +066400 PERFORM FAIL. NC1334.2 +066500 GO TO IDX-WRITE-22. NC1334.2 +066600 IDX-DELETE-22. NC1334.2 +066700 PERFORM DE-LETE. NC1334.2 +066800 IDX-WRITE-22. NC1334.2 +066900 MOVE "IDX-TEST-22" TO PAR-NAME. NC1334.2 +067000 PERFORM PRINT-DETAIL. NC1334.2 +067100 IDX-TEST-23. NC1334.2 +067200 MOVE 4 TO COMP-S-IDX18. NC1334.2 +067300 SET IDX-2 TO COMP-S-IDX18. NC1334.2 +067400 IF COMP-S-IDX18 EQUAL TO IDX-2 NC1334.2 +067500 PERFORM PASS NC1334.2 +067600 GO TO IDX-WRITE-23. NC1334.2 +067700 SET INDEX-VALUE TO IDX-2. NC1334.2 +067800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +067900 MOVE COMP-S-IDX18 TO CORRECT-18V0. NC1334.2 +068000 MOVE "INDEX VALUES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +068100 PERFORM FAIL. NC1334.2 +068200 GO TO IDX-WRITE-23. NC1334.2 +068300 IDX-DELETE-23. NC1334.2 +068400 PERFORM DE-LETE. NC1334.2 +068500 IDX-WRITE-23. NC1334.2 +068600 MOVE "IDX-TEST-23" TO PAR-NAME. NC1334.2 +068700 PERFORM PRINT-DETAIL. NC1334.2 +068800 IDX-TEST-24. NC1334.2 +068900 MOVE 2 TO COMP-U-IDX1. NC1334.2 +069000 SET IDX-3 TO COMP-U-IDX1. NC1334.2 +069100 IF IDX-3 EQUAL TO COMP-U-IDX1 NC1334.2 +069200 PERFORM PASS NC1334.2 +069300 GO TO IDX-WRITE-24. NC1334.2 +069400 MOVE COMP-U-IDX1 TO CORRECT-18V0. NC1334.2 +069500 SET INDEX-VALUE TO IDX-3. NC1334.2 +069600 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +069700 MOVE "INDEX VALUES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +069800 PERFORM FAIL. NC1334.2 +069900 GO TO IDX-WRITE-24. NC1334.2 +070000 IDX-DELETE-24. NC1334.2 +070100 PERFORM DE-LETE. NC1334.2 +070200 IDX-WRITE-24. NC1334.2 +070300 MOVE "IDX-TEST-24" TO PAR-NAME. NC1334.2 +070400 PERFORM PRINT-DETAIL. NC1334.2 +070500*IDX-TEST-25. NC1334.2 +070600* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1334.2 +070700* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1334.2 +070800*IDX-TEST-26. NC1334.2 +070900* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1334.2 +071000* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1334.2 +071100 CCVS-EXIT SECTION. NC1334.2 +071200 CCVS-999999. NC1334.2 +071300 GO TO CLOSE-FILES. NC1334.2 +*END-OF,NC133A +*HEADER,COBOL,NC134A +000100 IDENTIFICATION DIVISION. NC1344.2 +000200 PROGRAM-ID. NC1344.2 +000300 NC134A. NC1344.2 +000400**************************************************************** NC1344.2 +000500* * NC1344.2 +000600* VALIDATION FOR:- * NC1344.2 +000700* * NC1344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +000900* * NC1344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1344.2 +001100* * NC1344.2 +001200**************************************************************** NC1344.2 +001300* * NC1344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1344.2 +001500* * NC1344.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1344.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1344.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1344.2 +001900* * NC1344.2 +002000**************************************************************** NC1344.2 +002100* NC1344.2 +002200* PROGRAM NC134A TESTS THE ACCESSING OF A THREE-DIMENSIONAL NC1344.2 +002300* TABLE USING NUMERIC LITERALS AND DATA-NAMES AS SUBSCRIPTS. NC1344.2 +002400* RELATIVE SUBSCRIPTING IS ALSO USED. NC1344.2 +002500* NC1344.2 +002600 ENVIRONMENT DIVISION. NC1344.2 +002700 CONFIGURATION SECTION. NC1344.2 +002800 SOURCE-COMPUTER. NC1344.2 +002900 XXXXX082. NC1344.2 +003000 OBJECT-COMPUTER. NC1344.2 +003100 XXXXX083. NC1344.2 +003200 INPUT-OUTPUT SECTION. NC1344.2 +003300 FILE-CONTROL. NC1344.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1344.2 +003500 XXXXX055. NC1344.2 +003600 DATA DIVISION. NC1344.2 +003700 FILE SECTION. NC1344.2 +003800 FD PRINT-FILE. NC1344.2 +003900 01 PRINT-REC PICTURE X(120). NC1344.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1344.2 +004100 WORKING-STORAGE SECTION. NC1344.2 +004200 77 A-NAME-30-CHARACTERS-IN-LENGTH PICTURE IS XXX VALUE IS "END".NC1344.2 +004300 77 LONG-PICTURE PICTURE IS XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. NC1344.2 +004400 77 ONE PICTURE IS 9 VALUE IS 1 USAGE IS COMPUTATIONAL. NC1344.2 +004500 77 TWO PICTURE IS 9 VALUE IS 2 USAGE IS COMPUTATIONAL. NC1344.2 +004600 77 THREE PICTURE IS 9 VALUE IS 3 COMPUTATIONAL. NC1344.2 +004700 77 FOUR PICTURE IS 9 VALUE IS 4 COMPUTATIONAL. NC1344.2 +004800 77 FIVE PICTURE IS 9 VALUE IS 5 COMPUTATIONAL. NC1344.2 +004900 77 SIX PICTURE IS 9 VALUE IS 6 COMPUTATIONAL. NC1344.2 +005000 77 SEVEN PICTURE IS 9 VALUE IS 7 COMPUTATIONAL. NC1344.2 +005100 77 EIGHT PICTURE IS 9 VALUE 8 COMPUTATIONAL. NC1344.2 +005200 77 NINE PICTURE IS 9 VALUE 9 USAGE IS COMPUTATIONAL. NC1344.2 +005300 77 TEN PICTURE 99 VALUE 10 USAGE COMPUTATIONAL. NC1344.2 +005400 77 FIFTEEN PICTURE 99 VALUE 15 USAGE COMPUTATIONAL. NC1344.2 +005500 77 TWENTY PICTURE 99 VALUE 20 USAGE IS COMPUTATIONAL. NC1344.2 +005600 77 TWENTY-5 PICTURE 99 VALUE 25. NC1344.2 +005700 77 D-1 PICTURE IS S9V99 VALUE IS 1.06. NC1344.2 +005800 77 D-2 PICTURE IS S9V99 VALUE IS -1.06. NC1344.2 +005900 77 D-3 PICTURE IS 9(18) VALUE IS 979797979797979798. NC1344.2 +006000 77 D-4 PICTURE IS S99V99 VALUE IS +10.1. NC1344.2 +006100 77 D-5 PICTURE IS S999 VALUE IS -1. NC1344.2 +006200 77 D-6 PICTURE IS S999P VALUE IS 10. NC1344.2 +006300 77 D-7 PICTURE IS S99V99 VALUE IS 1.09. NC1344.2 +006400 77 D-8 PICTURE IS S999V9 VALUE 175. NC1344.2 +006500 77 D-9 PICTURE IS 9(4)V9(4) VALUE IS 111.1189. NC1344.2 +006600 77 D-10 PICTURE 999 VALUE 100. NC1344.2 +006700 77 D-11 PICTURE 999 VALUE 300. NC1344.2 +006800 77 D-12 PICTURE 999 VALUE 900. NC1344.2 +006900 77 W-1 PICTURE IS 9. NC1344.2 +007000 77 W-2 PICTURE IS 99. NC1344.2 +007100 77 W-3 PICTURE IS 999. NC1344.2 +007200 77 W-4 PICTURE IS 9 VALUE IS ZERO. NC1344.2 +007300 77 W-5 PICTURE IS 99 VALUE IS ZERO. NC1344.2 +007400 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC1344.2 +007500 77 W-7 PICTURE IS 9. NC1344.2 +007600 77 W-8 PICTURE 99 BLANK ZERO. NC1344.2 +007700 77 W-9 PICTURE 999. NC1344.2 +007800 77 W-10 PICTURE 99V9. NC1344.2 +007900 77 W-11 PICTURE S99V9. NC1344.2 +008000 77 W-12 PICTURE S9V99. NC1344.2 +008100 77 W-13 PICTURE S9(2)V9(2). NC1344.2 +008200 77 W-14 PICTURE IS S99V99. NC1344.2 +008300 77 XRAY PICTURE IS 9. NC1344.2 +008400 77 CTR-1 PICTURE IS 999. NC1344.2 +008500 77 SUBSCRIPT-1 PICTURE IS 999. NC1344.2 +008600 77 SUBSCRIPT-2 PICTURE IS 999. NC1344.2 +008700 77 SUBSCRIPT-3 PICTURE IS 999. NC1344.2 +008800 01 TABLE-10. NC1344.2 +008900 02 STATE-1 OCCURS 10 TIMES. NC1344.2 +009000 03 YEAR-1 OCCURS 10 TIMES. NC1344.2 +009100 04 ANIMAL PICTURE IS 999 OCCURS 03 TIMES. NC1344.2 +009200 01 NUMBER-LIST. NC1344.2 +009300 02 FILLER PICTURE IS X VALUE IS SPACE. NC1344.2 +009400 02 LINE-1 OCCURS 20 TIMES. NC1344.2 +009500 03 BLANKSPACE PICTURE IS XX. NC1344.2 +009600 03 PRINT-ELE PICTURE IS 999. NC1344.2 +009700 01 TABLE-1. NC1344.2 +009800 02 TAB-ELE PICTURE IS 999 OCCURS 100 TIMES. NC1344.2 +009900 01 TEST-RESULTS. NC1344.2 +010000 02 FILLER PIC X VALUE SPACE. NC1344.2 +010100 02 FEATURE PIC X(20) VALUE SPACE. NC1344.2 +010200 02 FILLER PIC X VALUE SPACE. NC1344.2 +010300 02 P-OR-F PIC X(5) VALUE SPACE. NC1344.2 +010400 02 FILLER PIC X VALUE SPACE. NC1344.2 +010500 02 PAR-NAME. NC1344.2 +010600 03 FILLER PIC X(19) VALUE SPACE. NC1344.2 +010700 03 PARDOT-X PIC X VALUE SPACE. NC1344.2 +010800 03 DOTVALUE PIC 99 VALUE ZERO. NC1344.2 +010900 02 FILLER PIC X(8) VALUE SPACE. NC1344.2 +011000 02 RE-MARK PIC X(61). NC1344.2 +011100 01 TEST-COMPUTED. NC1344.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC1344.2 +011300 02 FILLER PIC X(17) VALUE NC1344.2 +011400 " COMPUTED=". NC1344.2 +011500 02 COMPUTED-X. NC1344.2 +011600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1344.2 +011700 03 COMPUTED-N REDEFINES COMPUTED-A NC1344.2 +011800 PIC -9(9).9(9). NC1344.2 +011900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1344.2 +012000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1344.2 +012100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1344.2 +012200 03 CM-18V0 REDEFINES COMPUTED-A. NC1344.2 +012300 04 COMPUTED-18V0 PIC -9(18). NC1344.2 +012400 04 FILLER PIC X. NC1344.2 +012500 03 FILLER PIC X(50) VALUE SPACE. NC1344.2 +012600 01 TEST-CORRECT. NC1344.2 +012700 02 FILLER PIC X(30) VALUE SPACE. NC1344.2 +012800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1344.2 +012900 02 CORRECT-X. NC1344.2 +013000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1344.2 +013100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1344.2 +013200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1344.2 +013300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1344.2 +013400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1344.2 +013500 03 CR-18V0 REDEFINES CORRECT-A. NC1344.2 +013600 04 CORRECT-18V0 PIC -9(18). NC1344.2 +013700 04 FILLER PIC X. NC1344.2 +013800 03 FILLER PIC X(2) VALUE SPACE. NC1344.2 +013900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1344.2 +014000 01 CCVS-C-1. NC1344.2 +014100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1344.2 +014200- "SS PARAGRAPH-NAME NC1344.2 +014300- " REMARKS". NC1344.2 +014400 02 FILLER PIC X(20) VALUE SPACE. NC1344.2 +014500 01 CCVS-C-2. NC1344.2 +014600 02 FILLER PIC X VALUE SPACE. NC1344.2 +014700 02 FILLER PIC X(6) VALUE "TESTED". NC1344.2 +014800 02 FILLER PIC X(15) VALUE SPACE. NC1344.2 +014900 02 FILLER PIC X(4) VALUE "FAIL". NC1344.2 +015000 02 FILLER PIC X(94) VALUE SPACE. NC1344.2 +015100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1344.2 +015200 01 REC-CT PIC 99 VALUE ZERO. NC1344.2 +015300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1344.2 +015800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1344.2 +015900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1344.2 +016000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1344.2 +016100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1344.2 +016200 01 CCVS-H-1. NC1344.2 +016300 02 FILLER PIC X(39) VALUE SPACES. NC1344.2 +016400 02 FILLER PIC X(42) VALUE NC1344.2 +016500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1344.2 +016600 02 FILLER PIC X(39) VALUE SPACES. NC1344.2 +016700 01 CCVS-H-2A. NC1344.2 +016800 02 FILLER PIC X(40) VALUE SPACE. NC1344.2 +016900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1344.2 +017000 02 FILLER PIC XXXX VALUE NC1344.2 +017100 "4.2 ". NC1344.2 +017200 02 FILLER PIC X(28) VALUE NC1344.2 +017300 " COPY - NOT FOR DISTRIBUTION". NC1344.2 +017400 02 FILLER PIC X(41) VALUE SPACE. NC1344.2 +017500 NC1344.2 +017600 01 CCVS-H-2B. NC1344.2 +017700 02 FILLER PIC X(15) VALUE NC1344.2 +017800 "TEST RESULT OF ". NC1344.2 +017900 02 TEST-ID PIC X(9). NC1344.2 +018000 02 FILLER PIC X(4) VALUE NC1344.2 +018100 " IN ". NC1344.2 +018200 02 FILLER PIC X(12) VALUE NC1344.2 +018300 " HIGH ". NC1344.2 +018400 02 FILLER PIC X(22) VALUE NC1344.2 +018500 " LEVEL VALIDATION FOR ". NC1344.2 +018600 02 FILLER PIC X(58) VALUE NC1344.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +018800 01 CCVS-H-3. NC1344.2 +018900 02 FILLER PIC X(34) VALUE NC1344.2 +019000 " FOR OFFICIAL USE ONLY ". NC1344.2 +019100 02 FILLER PIC X(58) VALUE NC1344.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1344.2 +019300 02 FILLER PIC X(28) VALUE NC1344.2 +019400 " COPYRIGHT 1985 ". NC1344.2 +019500 01 CCVS-E-1. NC1344.2 +019600 02 FILLER PIC X(52) VALUE SPACE. NC1344.2 +019700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1344.2 +019800 02 ID-AGAIN PIC X(9). NC1344.2 +019900 02 FILLER PIC X(45) VALUE SPACES. NC1344.2 +020000 01 CCVS-E-2. NC1344.2 +020100 02 FILLER PIC X(31) VALUE SPACE. NC1344.2 +020200 02 FILLER PIC X(21) VALUE SPACE. NC1344.2 +020300 02 CCVS-E-2-2. NC1344.2 +020400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1344.2 +020500 03 FILLER PIC X VALUE SPACE. NC1344.2 +020600 03 ENDER-DESC PIC X(44) VALUE NC1344.2 +020700 "ERRORS ENCOUNTERED". NC1344.2 +020800 01 CCVS-E-3. NC1344.2 +020900 02 FILLER PIC X(22) VALUE NC1344.2 +021000 " FOR OFFICIAL USE ONLY". NC1344.2 +021100 02 FILLER PIC X(12) VALUE SPACE. NC1344.2 +021200 02 FILLER PIC X(58) VALUE NC1344.2 +021300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +021400 02 FILLER PIC X(13) VALUE SPACE. NC1344.2 +021500 02 FILLER PIC X(15) VALUE NC1344.2 +021600 " COPYRIGHT 1985". NC1344.2 +021700 01 CCVS-E-4. NC1344.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1344.2 +021900 02 FILLER PIC X(4) VALUE " OF ". NC1344.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1344.2 +022100 02 FILLER PIC X(40) VALUE NC1344.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1344.2 +022300 01 XXINFO. NC1344.2 +022400 02 FILLER PIC X(19) VALUE NC1344.2 +022500 "*** INFORMATION ***". NC1344.2 +022600 02 INFO-TEXT. NC1344.2 +022700 04 FILLER PIC X(8) VALUE SPACE. NC1344.2 +022800 04 XXCOMPUTED PIC X(20). NC1344.2 +022900 04 FILLER PIC X(5) VALUE SPACE. NC1344.2 +023000 04 XXCORRECT PIC X(20). NC1344.2 +023100 02 INF-ANSI-REFERENCE PIC X(48). NC1344.2 +023200 01 HYPHEN-LINE. NC1344.2 +023300 02 FILLER PIC IS X VALUE IS SPACE. NC1344.2 +023400 02 FILLER PIC IS X(65) VALUE IS "************************NC1344.2 +023500- "*****************************************". NC1344.2 +023600 02 FILLER PIC IS X(54) VALUE IS "************************NC1344.2 +023700- "******************************". NC1344.2 +023800 01 CCVS-PGM-ID PIC X(9) VALUE NC1344.2 +023900 "NC134A". NC1344.2 +024000 PROCEDURE DIVISION. NC1344.2 +024100 CCVS1 SECTION. NC1344.2 +024200 OPEN-FILES. NC1344.2 +024300 OPEN OUTPUT PRINT-FILE. NC1344.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1344.2 +024500 MOVE SPACE TO TEST-RESULTS. NC1344.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1344.2 +024700 GO TO CCVS1-EXIT. NC1344.2 +024800 CLOSE-FILES. NC1344.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1344.2 +025000 TERMINATE-CCVS. NC1344.2 +025100S EXIT PROGRAM. NC1344.2 +025200STERMINATE-CALL. NC1344.2 +025300 STOP RUN. NC1344.2 +025400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1344.2 +025500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1344.2 +025600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1344.2 +025700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1344.2 +025800 MOVE "****TEST DELETED****" TO RE-MARK. NC1344.2 +025900 PRINT-DETAIL. NC1344.2 +026000 IF REC-CT NOT EQUAL TO ZERO NC1344.2 +026100 MOVE "." TO PARDOT-X NC1344.2 +026200 MOVE REC-CT TO DOTVALUE. NC1344.2 +026300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1344.2 +026400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1344.2 +026500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1344.2 +026600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1344.2 +026700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1344.2 +026800 MOVE SPACE TO CORRECT-X. NC1344.2 +026900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1344.2 +027000 MOVE SPACE TO RE-MARK. NC1344.2 +027100 HEAD-ROUTINE. NC1344.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1344.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1344.2 +027600 COLUMN-NAMES-ROUTINE. NC1344.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +028000 END-ROUTINE. NC1344.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1344.2 +028200 END-RTN-EXIT. NC1344.2 +028300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +028400 END-ROUTINE-1. NC1344.2 +028500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1344.2 +028600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1344.2 +028700 ADD PASS-COUNTER TO ERROR-HOLD. NC1344.2 +028800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1344.2 +028900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1344.2 +029000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1344.2 +029100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1344.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1344.2 +029300 END-ROUTINE-12. NC1344.2 +029400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1344.2 +029500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1344.2 +029600 MOVE "NO " TO ERROR-TOTAL NC1344.2 +029700 ELSE NC1344.2 +029800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1344.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1344.2 +030000 PERFORM WRITE-LINE. NC1344.2 +030100 END-ROUTINE-13. NC1344.2 +030200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1344.2 +030300 MOVE "NO " TO ERROR-TOTAL ELSE NC1344.2 +030400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1344.2 +030500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1344.2 +030600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +030700 IF INSPECT-COUNTER EQUAL TO ZERO NC1344.2 +030800 MOVE "NO " TO ERROR-TOTAL NC1344.2 +030900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1344.2 +031000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1344.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +031200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +031300 WRITE-LINE. NC1344.2 +031400 ADD 1 TO RECORD-COUNT. NC1344.2 +031500Y IF RECORD-COUNT GREATER 42 NC1344.2 +031600Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1344.2 +031700Y MOVE SPACE TO DUMMY-RECORD NC1344.2 +031800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1344.2 +031900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1344.2 +032000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1344.2 +032100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1344.2 +032200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1344.2 +032300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1344.2 +032700Y MOVE ZERO TO RECORD-COUNT. NC1344.2 +032800 PERFORM WRT-LN. NC1344.2 +032900 WRT-LN. NC1344.2 +033000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1344.2 +033100 MOVE SPACE TO DUMMY-RECORD. NC1344.2 +033200 BLANK-LINE-PRINT. NC1344.2 +033300 PERFORM WRT-LN. NC1344.2 +033400 FAIL-ROUTINE. NC1344.2 +033500 IF COMPUTED-X NOT EQUAL TO SPACE NC1344.2 +033600 GO TO FAIL-ROUTINE-WRITE. NC1344.2 +033700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1344.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1344.2 +033900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1344.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1344.2 +034200 GO TO FAIL-ROUTINE-EX. NC1344.2 +034300 FAIL-ROUTINE-WRITE. NC1344.2 +034400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1344.2 +034500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1344.2 +034600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1344.2 +034700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1344.2 +034800 FAIL-ROUTINE-EX. EXIT. NC1344.2 +034900 BAIL-OUT. NC1344.2 +035000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1344.2 +035100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1344.2 +035200 BAIL-OUT-WRITE. NC1344.2 +035300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1344.2 +035400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1344.2 +035500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +035600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1344.2 +035700 BAIL-OUT-EX. EXIT. NC1344.2 +035800 CCVS1-EXIT. NC1344.2 +035900 EXIT. NC1344.2 +036000 SECT-NC134A-001 SECTION. NC1344.2 +036100 NC-05-001. NC1344.2 +036200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1344.2 +036300 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +036400 MOVE 1 TO W-3. NC1344.2 +036500 PERFORM BUILD-TABLE 100 TIMES. NC1344.2 +036600* NOTE TABLE IS CONSTRUCTED WITH VALUES FROM 1 TO 100. NC1344.2 +036700 MOVE "SUBSCRIPTING" TO FEATURE. NC1344.2 +036800 TEST-1. NC1344.2 +036900 IF TAB-ELE (50) EQUAL TO 50 PERFORM PASS ELSE GO TO TST-11. NC1344.2 +037000 GO TO TST-12. NC1344.2 +037100 TST-11. NC1344.2 +037200 PERFORM FAIL. NC1344.2 +037300 MOVE TAB-ELE (50) TO COMPUTED-A. NC1344.2 +037400 MOVE "50" TO CORRECT-A. NC1344.2 +037500 TST-12. NC1344.2 +037600 MOVE "TEST-1" TO PAR-NAME. NC1344.2 +037700 PERFORM PRINT-DETAIL. NC1344.2 +037800 TEST-2. NC1344.2 +037900 IF TAB-ELE (TWENTY-5) EQUAL TO 25 PERFORM PASS ELSE GO TO NC1344.2 +038000 TST-21. NC1344.2 +038100 GO TO TST-22. NC1344.2 +038200 TST-21. NC1344.2 +038300 PERFORM FAIL. NC1344.2 +038400 MOVE TAB-ELE (TWENTY-5) TO COMPUTED-A. NC1344.2 +038500 MOVE "25" TO CORRECT-A. NC1344.2 +038600 TST-22. NC1344.2 +038700 MOVE "TEST-2" TO PAR-NAME. NC1344.2 +038800 PERFORM PRINT-DETAIL. NC1344.2 +038900 TEST-3. NC1344.2 +039000 IF TAB-ELE (99) EQUAL TO 99 PERFORM PASS ELSE GO TO TST-31. NC1344.2 +039100 GO TO TST-32. NC1344.2 +039200 TST-31. NC1344.2 +039300 PERFORM FAIL. NC1344.2 +039400 MOVE TAB-ELE (99) TO COMPUTED-A. NC1344.2 +039500 MOVE "99" TO CORRECT-A. NC1344.2 +039600 TST-32. NC1344.2 +039700 MOVE "TEST-3" TO PAR-NAME. NC1344.2 +039800 PERFORM PRINT-DETAIL. NC1344.2 +039900 WRITE-TABLE-OUT. NC1344.2 +040000 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +040100 MOVE 1 TO CTR-1. NC1344.2 +040200 PERFORM TABLE-WRITE THRU END-OF 100 TIMES. NC1344.2 +040300 GO TO CONSTRUCTION. NC1344.2 +040400 BUILD-TABLE. NC1344.2 +040500 MOVE W-3 TO TAB-ELE (SUBSCRIPT-1). NC1344.2 +040600 ADD 1 TO SUBSCRIPT-1. NC1344.2 +040700 ADD 1 TO W-3. NC1344.2 +040800 TABLE-WRITE. NC1344.2 +040900 MOVE TAB-ELE (SUBSCRIPT-2) TO PRINT-ELE (CTR-1) NC1344.2 +041000 MOVE SPACE TO BLANKSPACE (CTR-1). NC1344.2 +041100 ADD 1 TO SUBSCRIPT-2. NC1344.2 +041200 ADD 1 TO CTR-1. NC1344.2 +041300 IF CTR-1 IS EQUAL TO 21 PERFORM TABLE-DUMP. NC1344.2 +041400 END-OF. NC1344.2 +041500 EXIT. NC1344.2 +041600 TABLE-DUMP. NC1344.2 +041700 MOVE SPACE TO PRINT-REC. NC1344.2 +041800 MOVE NUMBER-LIST TO PRINT-REC. NC1344.2 +041900 PERFORM WRITE-LINE. NC1344.2 +042000 MOVE 01 TO CTR-1. NC1344.2 +042100 CONSTRUCTION. NC1344.2 +042200 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +042300 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +042400 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +042500 MOVE 1 TO W-3. NC1344.2 +042600 PERFORM TABLE-BUILD-2 THROUGH FINE 300 TIMES. NC1344.2 +042700 TABTEST-1. NC1344.2 +042800 IF ANIMAL (1 1 1) EQUAL TO 1 PERFORM PASS ELSE GO TO NC1344.2 +042900 TTST-11. NC1344.2 +043000 GO TO TTST-12. NC1344.2 +043100 TTST-11. NC1344.2 +043200 PERFORM FAIL. NC1344.2 +043300 MOVE ANIMAL (1 1 1) TO COMPUTED-A. NC1344.2 +043400 MOVE "001" TO CORRECT-A. NC1344.2 +043500 TTST-12. NC1344.2 +043600 MOVE "TABTEST-1" TO PAR-NAME. NC1344.2 +043700 PERFORM PRINT-DETAIL. NC1344.2 +043800 TABTEST-2. NC1344.2 +043900 MOVE 1 TO W-1. NC1344.2 +044000 MOVE 1 TO W-2. NC1344.2 +044100 MOVE 1 TO W-3. NC1344.2 +044200 IF ANIMAL (W-1 W-2 W-3) EQUAL TO 1 PERFORM PASS ELSE GO NC1344.2 +044300 TO TTST-21. NC1344.2 +044400 GO TO TTST-22. NC1344.2 +044500 TTST-21. NC1344.2 +044600 PERFORM FAIL. NC1344.2 +044700 MOVE ANIMAL (W-1 W-2 W-3) TO COMPUTED-A. NC1344.2 +044800 MOVE "001" TO CORRECT-A. NC1344.2 +044900 TTST-22. NC1344.2 +045000 MOVE "TABTEST-2" TO PAR-NAME. NC1344.2 +045100 PERFORM PRINT-DETAIL. NC1344.2 +045200 TABTEST-3. NC1344.2 +045300 MOVE 3 TO W-3. NC1344.2 +045400 MOVE 3 TO W-2. NC1344.2 +045500 MOVE 1 TO W-1. NC1344.2 +045600 IF ANIMAL (W-1 W-2 W-3) EQUAL TO 9 PERFORM PASS ELSE GO NC1344.2 +045700 TO TTST-31. NC1344.2 +045800 GO TO TTST-32. NC1344.2 +045900 TTST-31. NC1344.2 +046000 PERFORM FAIL. NC1344.2 +046100 MOVE ANIMAL (W-1 W-2 W-3) TO COMPUTED-A. NC1344.2 +046200 MOVE "009" TO CORRECT-A. NC1344.2 +046300 TTST-32. NC1344.2 +046400 MOVE "TABTEST-3" TO PAR-NAME. NC1344.2 +046500 PERFORM PRINT-DETAIL. NC1344.2 +046600 TABTEST-4. NC1344.2 +046700 IF ANIMAL (10 10 1) EQUAL TO 298 PERFORM PASS ELSE GO TONC1344.2 +046800 TTST-41. NC1344.2 +046900 GO TO TTST-42. NC1344.2 +047000 TTST-41. NC1344.2 +047100 PERFORM FAIL. NC1344.2 +047200 MOVE ANIMAL (10 10 1) TO COMPUTED-A. NC1344.2 +047300 MOVE "298" TO CORRECT-A. NC1344.2 +047400 TTST-42. NC1344.2 +047500 MOVE "TABTEST-4" TO PAR-NAME. NC1344.2 +047600 PERFORM PRINT-DETAIL. NC1344.2 +047700 TABTEST-5. NC1344.2 +047800 MOVE 3 TO W-1. NC1344.2 +047900 MOVE 10 TO W-2. NC1344.2 +048000 MOVE 10 TO W-3. NC1344.2 +048100 IF ANIMAL (W-3 W-2 W-1) EQUAL TO 300 PERFORM PASS ELSE GO NC1344.2 +048200 TO TTST-51. NC1344.2 +048300 GO TO TTST-52. NC1344.2 +048400 TTST-51. NC1344.2 +048500 PERFORM FAIL. NC1344.2 +048600 MOVE ANIMAL (W-3 W-2 W-1) TO COMPUTED-A. NC1344.2 +048700 MOVE "300" TO CORRECT-A. NC1344.2 +048800 TTST-52. NC1344.2 +048900 MOVE "TABTEST-5" TO PAR-NAME. NC1344.2 +049000 PERFORM PRINT-DETAIL. NC1344.2 +049100 TABTEST-6. NC1344.2 +049200 IF YEAR-1 (1 1) EQUAL TO "001002003" PERFORM PASS ELSE GO NC1344.2 +049300 TO TTST-61. NC1344.2 +049400 GO TO TTST-62. NC1344.2 +049500 TTST-61. NC1344.2 +049600 PERFORM FAIL. NC1344.2 +049700 MOVE YEAR-1 (1 1) TO COMPUTED-A. NC1344.2 +049800 MOVE "001002003" TO CORRECT-A. NC1344.2 +049900 TTST-62. NC1344.2 +050000 MOVE "TABTEST-6" TO PAR-NAME. NC1344.2 +050100 PERFORM PRINT-DETAIL. NC1344.2 +050200 TABTEST-7. NC1344.2 +050300 IF YEAR-1 (10 10) EQUAL TO "298299300" PERFORM PASS ELSE GONC1344.2 +050400 TO TTST-71. NC1344.2 +050500 GO TO TTST-72. NC1344.2 +050600 TTST-71. NC1344.2 +050700 MOVE YEAR-1 (10 10) TO COMPUTED-A. NC1344.2 +050800 MOVE "298299300" TO CORRECT-A. NC1344.2 +050900 PERFORM FAIL. NC1344.2 +051000 TTST-72. NC1344.2 +051100 MOVE "TABTEST-7" TO PAR-NAME. NC1344.2 +051200 PERFORM PRINT-DETAIL. NC1344.2 +051300 TABTEST-8. NC1344.2 +051400 MOVE 02 TO W-1. NC1344.2 +051500 MOVE 07 TO W-2. NC1344.2 +051600 IF ANIMAL (W-1 W-2 1) EQUAL TO 49 PERFORM PASS ELSE GO TO NC1344.2 +051700 TTST-81. NC1344.2 +051800 GO TO TTST-82. NC1344.2 +051900 TTST-81. NC1344.2 +052000 PERFORM FAIL. NC1344.2 +052100 MOVE ANIMAL (W-1 W-2 1) TO COMPUTED-A. NC1344.2 +052200 MOVE "049" TO CORRECT-A. NC1344.2 +052300 TTST-82. NC1344.2 +052400 MOVE "TABTEST-8" TO PAR-NAME. NC1344.2 +052500 PERFORM PRINT-DETAIL. NC1344.2 +052600 TABTEST-9. NC1344.2 +052700 MOVE 08 TO W-1. NC1344.2 +052800 MOVE 03 TO W-3. NC1344.2 +052900 IF ANIMAL (W-1 1 W-3) EQUAL TO 213 PERFORM PASS ELSE GO TO NC1344.2 +053000 TTST-91. NC1344.2 +053100 GO TO TTST-92. NC1344.2 +053200 TTST-91. NC1344.2 +053300 PERFORM FAIL. NC1344.2 +053400 MOVE ANIMAL (W-1 1 W-3) TO COMPUTED-A. NC1344.2 +053500 MOVE "213" TO CORRECT-A. NC1344.2 +053600 TTST-92. NC1344.2 +053700 MOVE "TABTEST-9" TO PAR-NAME. NC1344.2 +053800 PERFORM PRINT-DETAIL. NC1344.2 +053900 TABTEST-10. NC1344.2 +054000 MOVE 5 TO W-1. NC1344.2 +054100 IF YEAR-1 (W-1 10) EQUAL TO "148149150" PERFORM PASS ELSE NC1344.2 +054200 GO TO TTST-101. NC1344.2 +054300 GO TO TTST-102. NC1344.2 +054400 TTST-101. NC1344.2 +054500 PERFORM FAIL. NC1344.2 +054600 MOVE YEAR-1 (W-1 10) TO COMPUTED-A. NC1344.2 +054700 MOVE "148149150" TO CORRECT-A. NC1344.2 +054800 TTST-102. NC1344.2 +054900 MOVE "TABTEST-10" TO PAR-NAME. NC1344.2 +055000 PERFORM PRINT-DETAIL. NC1344.2 +055100 TABTEST-11. NC1344.2 +055200 IF YEAR-1 (+10 +10) EQUAL TO "298299300" NC1344.2 +055300 PERFORM PASS NC1344.2 +055400 GO TO TABTEST-11B. NC1344.2 +055500 MOVE YEAR-1 (+10 +10) TO COMPUTED-A. NC1344.2 +055600 MOVE "298299300" TO CORRECT-A. NC1344.2 +055700 PERFORM FAIL. NC1344.2 +055800 GO TO TABTEST-11B. NC1344.2 +055900 TABTEST-11A. NC1344.2 +056000 PERFORM DE-LETE. NC1344.2 +056100 TABTEST-11B. NC1344.2 +056200 MOVE "TABTEST-11" TO PAR-NAME. NC1344.2 +056300* NOTE SIGNED NUMERIC LITERALS AS SUBSCRIPTS. NC1344.2 +056400 PERFORM PRINT-DETAIL. NC1344.2 +056500 TABTEST-12. NC1344.2 +056600 MOVE 1 TO W-1. NC1344.2 +056700 IF YEAR-1 (W-1 +1) EQUAL TO "001002003" NC1344.2 +056800 PERFORM PASS NC1344.2 +056900 GO TO TABTEST-12B. NC1344.2 +057000 MOVE YEAR-1 (W-1 +1) TO COMPUTED-A. NC1344.2 +057100 MOVE "001002003" TO CORRECT-A. NC1344.2 +057200 PERFORM FAIL. NC1344.2 +057300 GO TO TABTEST-12B. NC1344.2 +057400 TABTEST-12A. NC1344.2 +057500 PERFORM DE-LETE. NC1344.2 +057600 TABTEST-12B. NC1344.2 +057700 MOVE "TABTEST-12" TO PAR-NAME. NC1344.2 +057800* NOTE SIGNED NUMERIC LITERAL AND NC1344.2 +057900* UNSIGNED NUMERIC ITEM AS SUBSCRIPTS. NC1344.2 +058000 PERFORM PRINT-DETAIL. NC1344.2 +058100 TABTEST-13. NC1344.2 +058200 IF ANIMAL (+8 +1 +3) EQUAL TO 213 NC1344.2 +058300 PERFORM PASS NC1344.2 +058400 GO TO TABTEST-13B. NC1344.2 +058500 MOVE ANIMAL (+8 +1 +3) TO COMPUTED-A. NC1344.2 +058600 MOVE "213" TO CORRECT-A. NC1344.2 +058700 PERFORM FAIL. NC1344.2 +058800 GO TO TABTEST-13B. NC1344.2 +058900 TABTEST-13A. NC1344.2 +059000 PERFORM DE-LETE. NC1344.2 +059100 TABTEST-13B. NC1344.2 +059200 MOVE "TABTEST-13" TO PAR-NAME. NC1344.2 +059300* NOTE SIGNED NUMERIC LITERALS AS SUBSCRIPTS. NC1344.2 +059400 PERFORM PRINT-DETAIL. NC1344.2 +059500 TABTEST-14. NC1344.2 +059600 MOVE 1 TO W-2. NC1344.2 +059700 IF ANIMAL (+8 W-2 +3) EQUAL TO 213 NC1344.2 +059800 PERFORM PASS NC1344.2 +059900 GO TO TABTEST-14B. NC1344.2 +060000 MOVE ANIMAL (+8 W-2 +3) TO COMPUTED-A. NC1344.2 +060100 MOVE "213" TO CORRECT-A. NC1344.2 +060200 PERFORM FAIL. NC1344.2 +060300 GO TO TABTEST-14B. NC1344.2 +060400 TABTEST-14A. NC1344.2 +060500 PERFORM DE-LETE. NC1344.2 +060600 TABTEST-14B. NC1344.2 +060700 MOVE "TABTEST-14" TO PAR-NAME. NC1344.2 +060800* NOTE SIGNED NUMERIC LITERALS AND NC1344.2 +060900* UNSIGNED NUMERIC ITEM AS SUBSCRIPTS. NC1344.2 +061000 PERFORM PRINT-DETAIL. NC1344.2 +061100 TABTEST-15. NC1344.2 +061200 MOVE 8 TO W-1. NC1344.2 +061300 MOVE 3 TO W-3. NC1344.2 +061400 IF ANIMAL (W-1 +1 W-3) EQUAL TO 213 NC1344.2 +061500 PERFORM PASS NC1344.2 +061600 GO TO TABTEST-15B. NC1344.2 +061700 MOVE ANIMAL (W-1 +1 W-3) TO COMPUTED-A. NC1344.2 +061800 MOVE "213" TO CORRECT-A. NC1344.2 +061900 PERFORM FAIL. NC1344.2 +062000 GO TO TABTEST-15B. NC1344.2 +062100 TABTEST-15A. NC1344.2 +062200 PERFORM DE-LETE. NC1344.2 +062300 TABTEST-15B. NC1344.2 +062400 MOVE "TABTEST-15" TO PAR-NAME. NC1344.2 +062500* NOTE UNSIGNED NUMERIC ITEMS AND SIGNED NUMERIC LITERAL NC1344.2 +062600 PERFORM PRINT-DETAIL. NC1344.2 +062700 TABINIT-16. NC1344.2 +062800* ==--> RELATIVE SUBSCRIPTING <--== NC1344.2 +062900 MOVE "IV-22 4.3.8.4 GR4" TO ANSI-REFERENCE. NC1344.2 +063000 MOVE 1 TO W-1. NC1344.2 +063100 MOVE 20 TO W-2. NC1344.2 +063200 MOVE 5 TO W-3. NC1344.2 +063300 TABTEST-16. NC1344.2 +063400 IF ANIMAL (W-3 + 5 W-2 - 10 W-1 + 2) = 300 NC1344.2 +063500 PERFORM PASS NC1344.2 +063600 ELSE NC1344.2 +063700 GO TO TTST-161. NC1344.2 +063800 GO TO TTST-162. NC1344.2 +063900 TTST-161. NC1344.2 +064000 PERFORM FAIL. NC1344.2 +064100 MOVE ANIMAL (W-3 + 5 W-2 - 10 W-1 + 2) TO COMPUTED-A. NC1344.2 +064200 MOVE "300" TO CORRECT-A. NC1344.2 +064300 TTST-162. NC1344.2 +064400 MOVE "TABTEST-16" TO PAR-NAME. NC1344.2 +064500 PERFORM PRINT-DETAIL. NC1344.2 +064600 TABINIT-17. NC1344.2 +064700* ==--> RELATIVE SUBSCRIPTING <--== NC1344.2 +064800 MOVE "IV-22 4.3.8.4 GR4" TO ANSI-REFERENCE. NC1344.2 +064900 MOVE 9 TO W-1. NC1344.2 +065000 MOVE 6 TO W-2. NC1344.2 +065100 MOVE 999 TO W-3. NC1344.2 +065200 TABTEST-17. NC1344.2 +065300 IF ANIMAL (W-1 - 7 W-2 + 1 W-3 - 998) EQUAL TO 49 NC1344.2 +065400 PERFORM PASS NC1344.2 +065500 ELSE NC1344.2 +065600 GO TO TTST-171. NC1344.2 +065700 GO TO TTST-172. NC1344.2 +065800 TTST-171. NC1344.2 +065900 PERFORM FAIL. NC1344.2 +066000 MOVE ANIMAL (W-1 - 7 W-2 + 1 W-3 - 998) TO COMPUTED-A. NC1344.2 +066100 MOVE "049" TO CORRECT-A. NC1344.2 +066200 TTST-172. NC1344.2 +066300 MOVE "TABTEST-17" TO PAR-NAME. NC1344.2 +066400 PERFORM PRINT-DETAIL. NC1344.2 +066500* USED AS SUBSCRIPT. NC1344.2 +066600 WRITE-TABLE. NC1344.2 +066700 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1344.2 +066800 MOVE 1 TO SUBSCRIPT-3 NC1344.2 +066900 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +067000 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +067100 MOVE 1 TO CTR-1 NC1344.2 +067200 PERFORM PRINT-TABLE THROUGH END-TAB 300 TIMES. NC1344.2 +067300 GO TO EXIT-NOTE. NC1344.2 +067400 EXIT-NOTE. NC1344.2 +067500 GO TO FIN-WRAPUP. NC1344.2 +067600 PRINT-TABLE. NC1344.2 +067700 MOVE ANIMAL (SUBSCRIPT-1 SUBSCRIPT-2 SUBSCRIPT-3) TO NC1344.2 +067800 PRINT-ELE (CTR-1). NC1344.2 +067900 ADD 1 TO CTR-1 NC1344.2 +068000 IF CTR-1 EQUAL TO 21 PERFORM TABLE-DUMP. NC1344.2 +068100 ADD 1 TO SUBSCRIPT-3. NC1344.2 +068200 IF SUBSCRIPT-3 GREATER THAN 3 GO TO CCCC ELSE GO TO END-TAB. NC1344.2 +068300 CCCC. NC1344.2 +068400 ADD 1 TO SUBSCRIPT-2 NC1344.2 +068500 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +068600 IF SUBSCRIPT-2 GREATER THAN 10 GO TO DDD ELSE GO TO END-TAB. NC1344.2 +068700 DDD. NC1344.2 +068800 ADD 1 TO SUBSCRIPT-1. NC1344.2 +068900 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +069000 END-TAB. NC1344.2 +069100 EXIT. NC1344.2 +069200 NC1344.2 +069300 TABLE-BUILD-2. NC1344.2 +069400 MOVE W-3 TO ANIMAL (SUBSCRIPT-1 SUBSCRIPT-2 SUBSCRIPT-3). NC1344.2 +069500 ADD 01 TO W-3. NC1344.2 +069600 ADD 01 TO SUBSCRIPT-3. NC1344.2 +069700 IF SUBSCRIPT-3 IS GREATER THAN 3 GO TO AAAA ELSE GO TO NC1344.2 +069800 FINE. NC1344.2 +069900 AAAA. NC1344.2 +070000 ADD 1 TO SUBSCRIPT-2. NC1344.2 +070100 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +070200 IF SUBSCRIPT-2 IS GREATER THAN 10 GO TO BBB ELSE GO TO FINE. NC1344.2 +070300 BBB. NC1344.2 +070400 ADD 1 TO SUBSCRIPT-1. NC1344.2 +070500 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +070600 FINE. NC1344.2 +070700 EXIT. NC1344.2 +070800 FIN-WRAPUP. NC1344.2 +070900 EXIT. NC1344.2 +071000 END-JOB. NC1344.2 +071100 CCVS-EXIT SECTION. NC1344.2 +071200 CCVS-999999. NC1344.2 +071300 GO TO CLOSE-FILES. NC1344.2 +*END-OF,NC134A +*HEADER,COBOL,NC135A +000100 IDENTIFICATION DIVISION. NC1354.2 +000200 PROGRAM-ID. NC1354.2 +000300 NC135A. NC1354.2 +000400**************************************************************** NC1354.2 +000500* * NC1354.2 +000600* VALIDATION FOR:- * NC1354.2 +000700* * NC1354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +000900* * NC1354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1354.2 +001100* * NC1354.2 +001200**************************************************************** NC1354.2 +001300* * NC1354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1354.2 +001500* * NC1354.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1354.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1354.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1354.2 +001900* * NC1354.2 +002000**************************************************************** NC1354.2 +002100* NC1354.2 +002200* PROGRAM NC135A TESTS THE USE OF INDEX-NAMES TO REFERENCE NC1354.2 +002300* 3 DIMENSIONAL TABLE WHICH HAS BEEN REDEFINED. NC1354.2 +002400* FORMAT 2 OF THE SET STATEMENT AND RELATIVE INDEXING ARE NC1354.2 +002500* ALSO TESTED. NC1354.2 +002600* NC1354.2 +002700 ENVIRONMENT DIVISION. NC1354.2 +002800 CONFIGURATION SECTION. NC1354.2 +002900 SOURCE-COMPUTER. NC1354.2 +003000 XXXXX082. NC1354.2 +003100 OBJECT-COMPUTER. NC1354.2 +003200 XXXXX083. NC1354.2 +003300 INPUT-OUTPUT SECTION. NC1354.2 +003400 FILE-CONTROL. NC1354.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1354.2 +003600 XXXXX055. NC1354.2 +003700 DATA DIVISION. NC1354.2 +003800 FILE SECTION. NC1354.2 +003900 FD PRINT-FILE. NC1354.2 +004000 01 PRINT-REC PICTURE X(120). NC1354.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1354.2 +004200 WORKING-STORAGE SECTION. NC1354.2 +004300 77 ONE PICTURE 999 VALUE IS 001. NC1354.2 +004400 77 CTR-1 PICTURE 999 VALUE IS ZERO. NC1354.2 +004500 77 W-3 PICTURE 999 VALUE ZERO. NC1354.2 +004600 01 IDEN-1 PICTURE 99 VALUE 03. NC1354.2 +004700 01 TABLE-9. NC1354.2 +004800 02 TABLE-8 OCCURS 10 TIMES INDEXED BY INXEX1. NC1354.2 +004900 03 TABLE-7 OCCURS 10 TIMES INDEXED BY INXEX2. NC1354.2 +005000 04 TABLE-1 PICTURE 999 OCCURS 3 TIMES INDEXED BY INXEX3. NC1354.2 +005100 01 TABLE-6 REDEFINES TABLE-9. NC1354.2 +005200 02 TABLE-5 OCCURS 10 TIMES. NC1354.2 +005300 03 TABLE-4 OCCURS 10 TIMES. NC1354.2 +005400 04 TABLE-2 PICTURE 999 OCCURS 3 TIMES. NC1354.2 +005500 01 NUMBER-LIST. NC1354.2 +005600 02 FILLER PICTURE IS X VALUE IS SPACE. NC1354.2 +005700 02 LINE-1 OCCURS 20 TIMES. NC1354.2 +005800 03 BLANKSPACE PICTURE IS XX. NC1354.2 +005900 03 PRINT-ELE PICTURE IS 999. NC1354.2 +006000 01 DATA-NAMES USAGE IS INDEX. NC1354.2 +006100 02 KEY-1. NC1354.2 +006200 02 KEY-2. NC1354.2 +006300 02 KEY-3. NC1354.2 +006400 01 TEST-RESULTS. NC1354.2 +006500 02 FILLER PIC X VALUE SPACE. NC1354.2 +006600 02 FEATURE PIC X(20) VALUE SPACE. NC1354.2 +006700 02 FILLER PIC X VALUE SPACE. NC1354.2 +006800 02 P-OR-F PIC X(5) VALUE SPACE. NC1354.2 +006900 02 FILLER PIC X VALUE SPACE. NC1354.2 +007000 02 PAR-NAME. NC1354.2 +007100 03 FILLER PIC X(19) VALUE SPACE. NC1354.2 +007200 03 PARDOT-X PIC X VALUE SPACE. NC1354.2 +007300 03 DOTVALUE PIC 99 VALUE ZERO. NC1354.2 +007400 02 FILLER PIC X(8) VALUE SPACE. NC1354.2 +007500 02 RE-MARK PIC X(61). NC1354.2 +007600 01 TEST-COMPUTED. NC1354.2 +007700 02 FILLER PIC X(30) VALUE SPACE. NC1354.2 +007800 02 FILLER PIC X(17) VALUE NC1354.2 +007900 " COMPUTED=". NC1354.2 +008000 02 COMPUTED-X. NC1354.2 +008100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1354.2 +008200 03 COMPUTED-N REDEFINES COMPUTED-A NC1354.2 +008300 PIC -9(9).9(9). NC1354.2 +008400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1354.2 +008500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1354.2 +008600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1354.2 +008700 03 CM-18V0 REDEFINES COMPUTED-A. NC1354.2 +008800 04 COMPUTED-18V0 PIC -9(18). NC1354.2 +008900 04 FILLER PIC X. NC1354.2 +009000 03 FILLER PIC X(50) VALUE SPACE. NC1354.2 +009100 01 TEST-CORRECT. NC1354.2 +009200 02 FILLER PIC X(30) VALUE SPACE. NC1354.2 +009300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1354.2 +009400 02 CORRECT-X. NC1354.2 +009500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1354.2 +009600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1354.2 +009700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1354.2 +009800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1354.2 +009900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1354.2 +010000 03 CR-18V0 REDEFINES CORRECT-A. NC1354.2 +010100 04 CORRECT-18V0 PIC -9(18). NC1354.2 +010200 04 FILLER PIC X. NC1354.2 +010300 03 FILLER PIC X(2) VALUE SPACE. NC1354.2 +010400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1354.2 +010500 01 CCVS-C-1. NC1354.2 +010600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1354.2 +010700- "SS PARAGRAPH-NAME NC1354.2 +010800- " REMARKS". NC1354.2 +010900 02 FILLER PIC X(20) VALUE SPACE. NC1354.2 +011000 01 CCVS-C-2. NC1354.2 +011100 02 FILLER PIC X VALUE SPACE. NC1354.2 +011200 02 FILLER PIC X(6) VALUE "TESTED". NC1354.2 +011300 02 FILLER PIC X(15) VALUE SPACE. NC1354.2 +011400 02 FILLER PIC X(4) VALUE "FAIL". NC1354.2 +011500 02 FILLER PIC X(94) VALUE SPACE. NC1354.2 +011600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1354.2 +011700 01 REC-CT PIC 99 VALUE ZERO. NC1354.2 +011800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1354.2 +011900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1354.2 +012300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1354.2 +012400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1354.2 +012500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1354.2 +012600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1354.2 +012700 01 CCVS-H-1. NC1354.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC1354.2 +012900 02 FILLER PIC X(42) VALUE NC1354.2 +013000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1354.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC1354.2 +013200 01 CCVS-H-2A. NC1354.2 +013300 02 FILLER PIC X(40) VALUE SPACE. NC1354.2 +013400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1354.2 +013500 02 FILLER PIC XXXX VALUE NC1354.2 +013600 "4.2 ". NC1354.2 +013700 02 FILLER PIC X(28) VALUE NC1354.2 +013800 " COPY - NOT FOR DISTRIBUTION". NC1354.2 +013900 02 FILLER PIC X(41) VALUE SPACE. NC1354.2 +014000 NC1354.2 +014100 01 CCVS-H-2B. NC1354.2 +014200 02 FILLER PIC X(15) VALUE NC1354.2 +014300 "TEST RESULT OF ". NC1354.2 +014400 02 TEST-ID PIC X(9). NC1354.2 +014500 02 FILLER PIC X(4) VALUE NC1354.2 +014600 " IN ". NC1354.2 +014700 02 FILLER PIC X(12) VALUE NC1354.2 +014800 " HIGH ". NC1354.2 +014900 02 FILLER PIC X(22) VALUE NC1354.2 +015000 " LEVEL VALIDATION FOR ". NC1354.2 +015100 02 FILLER PIC X(58) VALUE NC1354.2 +015200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +015300 01 CCVS-H-3. NC1354.2 +015400 02 FILLER PIC X(34) VALUE NC1354.2 +015500 " FOR OFFICIAL USE ONLY ". NC1354.2 +015600 02 FILLER PIC X(58) VALUE NC1354.2 +015700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1354.2 +015800 02 FILLER PIC X(28) VALUE NC1354.2 +015900 " COPYRIGHT 1985 ". NC1354.2 +016000 01 CCVS-E-1. NC1354.2 +016100 02 FILLER PIC X(52) VALUE SPACE. NC1354.2 +016200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1354.2 +016300 02 ID-AGAIN PIC X(9). NC1354.2 +016400 02 FILLER PIC X(45) VALUE SPACES. NC1354.2 +016500 01 CCVS-E-2. NC1354.2 +016600 02 FILLER PIC X(31) VALUE SPACE. NC1354.2 +016700 02 FILLER PIC X(21) VALUE SPACE. NC1354.2 +016800 02 CCVS-E-2-2. NC1354.2 +016900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1354.2 +017000 03 FILLER PIC X VALUE SPACE. NC1354.2 +017100 03 ENDER-DESC PIC X(44) VALUE NC1354.2 +017200 "ERRORS ENCOUNTERED". NC1354.2 +017300 01 CCVS-E-3. NC1354.2 +017400 02 FILLER PIC X(22) VALUE NC1354.2 +017500 " FOR OFFICIAL USE ONLY". NC1354.2 +017600 02 FILLER PIC X(12) VALUE SPACE. NC1354.2 +017700 02 FILLER PIC X(58) VALUE NC1354.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +017900 02 FILLER PIC X(13) VALUE SPACE. NC1354.2 +018000 02 FILLER PIC X(15) VALUE NC1354.2 +018100 " COPYRIGHT 1985". NC1354.2 +018200 01 CCVS-E-4. NC1354.2 +018300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1354.2 +018400 02 FILLER PIC X(4) VALUE " OF ". NC1354.2 +018500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1354.2 +018600 02 FILLER PIC X(40) VALUE NC1354.2 +018700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1354.2 +018800 01 XXINFO. NC1354.2 +018900 02 FILLER PIC X(19) VALUE NC1354.2 +019000 "*** INFORMATION ***". NC1354.2 +019100 02 INFO-TEXT. NC1354.2 +019200 04 FILLER PIC X(8) VALUE SPACE. NC1354.2 +019300 04 XXCOMPUTED PIC X(20). NC1354.2 +019400 04 FILLER PIC X(5) VALUE SPACE. NC1354.2 +019500 04 XXCORRECT PIC X(20). NC1354.2 +019600 02 INF-ANSI-REFERENCE PIC X(48). NC1354.2 +019700 01 HYPHEN-LINE. NC1354.2 +019800 02 FILLER PIC IS X VALUE IS SPACE. NC1354.2 +019900 02 FILLER PIC IS X(65) VALUE IS "************************NC1354.2 +020000- "*****************************************". NC1354.2 +020100 02 FILLER PIC IS X(54) VALUE IS "************************NC1354.2 +020200- "******************************". NC1354.2 +020300 01 CCVS-PGM-ID PIC X(9) VALUE NC1354.2 +020400 "NC135A". NC1354.2 +020500 PROCEDURE DIVISION. NC1354.2 +020600 CCVS1 SECTION. NC1354.2 +020700 OPEN-FILES. NC1354.2 +020800 OPEN OUTPUT PRINT-FILE. NC1354.2 +020900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1354.2 +021000 MOVE SPACE TO TEST-RESULTS. NC1354.2 +021100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1354.2 +021200 GO TO CCVS1-EXIT. NC1354.2 +021300 CLOSE-FILES. NC1354.2 +021400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1354.2 +021500 TERMINATE-CCVS. NC1354.2 +021600S EXIT PROGRAM. NC1354.2 +021700STERMINATE-CALL. NC1354.2 +021800 STOP RUN. NC1354.2 +021900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1354.2 +022000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1354.2 +022100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1354.2 +022200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1354.2 +022300 MOVE "****TEST DELETED****" TO RE-MARK. NC1354.2 +022400 PRINT-DETAIL. NC1354.2 +022500 IF REC-CT NOT EQUAL TO ZERO NC1354.2 +022600 MOVE "." TO PARDOT-X NC1354.2 +022700 MOVE REC-CT TO DOTVALUE. NC1354.2 +022800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1354.2 +022900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1354.2 +023000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1354.2 +023100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1354.2 +023200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1354.2 +023300 MOVE SPACE TO CORRECT-X. NC1354.2 +023400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1354.2 +023500 MOVE SPACE TO RE-MARK. NC1354.2 +023600 HEAD-ROUTINE. NC1354.2 +023700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +023800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +023900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1354.2 +024000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1354.2 +024100 COLUMN-NAMES-ROUTINE. NC1354.2 +024200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +024300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +024500 END-ROUTINE. NC1354.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1354.2 +024700 END-RTN-EXIT. NC1354.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +024900 END-ROUTINE-1. NC1354.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1354.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1354.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. NC1354.2 +025300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1354.2 +025400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1354.2 +025500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1354.2 +025600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1354.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1354.2 +025800 END-ROUTINE-12. NC1354.2 +025900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1354.2 +026000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1354.2 +026100 MOVE "NO " TO ERROR-TOTAL NC1354.2 +026200 ELSE NC1354.2 +026300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1354.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1354.2 +026500 PERFORM WRITE-LINE. NC1354.2 +026600 END-ROUTINE-13. NC1354.2 +026700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1354.2 +026800 MOVE "NO " TO ERROR-TOTAL ELSE NC1354.2 +026900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1354.2 +027000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1354.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027200 IF INSPECT-COUNTER EQUAL TO ZERO NC1354.2 +027300 MOVE "NO " TO ERROR-TOTAL NC1354.2 +027400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1354.2 +027500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1354.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027800 WRITE-LINE. NC1354.2 +027900 ADD 1 TO RECORD-COUNT. NC1354.2 +028000Y IF RECORD-COUNT GREATER 42 NC1354.2 +028100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1354.2 +028200Y MOVE SPACE TO DUMMY-RECORD NC1354.2 +028300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1354.2 +028400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1354.2 +028500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1354.2 +028600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1354.2 +028700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1354.2 +028800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +028900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +029000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +029100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1354.2 +029200Y MOVE ZERO TO RECORD-COUNT. NC1354.2 +029300 PERFORM WRT-LN. NC1354.2 +029400 WRT-LN. NC1354.2 +029500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1354.2 +029600 MOVE SPACE TO DUMMY-RECORD. NC1354.2 +029700 BLANK-LINE-PRINT. NC1354.2 +029800 PERFORM WRT-LN. NC1354.2 +029900 FAIL-ROUTINE. NC1354.2 +030000 IF COMPUTED-X NOT EQUAL TO SPACE NC1354.2 +030100 GO TO FAIL-ROUTINE-WRITE. NC1354.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1354.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1354.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1354.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1354.2 +030700 GO TO FAIL-ROUTINE-EX. NC1354.2 +030800 FAIL-ROUTINE-WRITE. NC1354.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1354.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1354.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1354.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1354.2 +031300 FAIL-ROUTINE-EX. EXIT. NC1354.2 +031400 BAIL-OUT. NC1354.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1354.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1354.2 +031700 BAIL-OUT-WRITE. NC1354.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1354.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1354.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1354.2 +032200 BAIL-OUT-EX. EXIT. NC1354.2 +032300 CCVS1-EXIT. NC1354.2 +032400 EXIT. NC1354.2 +032500 SECT-NC135A-001 SECTION. NC1354.2 +032600 PARAGRAPH-NAME-4. NC1354.2 +032700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1354.2 +032800 SET INXEX1 INXEX2 INXEX3 TO 001. NC1354.2 +032900 MOVE 001 TO W-3. NC1354.2 +033000 PARAGRAPH-NAME-5. NC1354.2 +033100 MOVE W-3 TO TABLE-1 (INXEX1 INXEX2 INXEX3). NC1354.2 +033200 ADD 01 TO W-3. NC1354.2 +033300 IF INXEX3 EQUAL TO 3 NC1354.2 +033400 GO TO PARAGRAPH-NAME-6. NC1354.2 +033500 SET INXEX3 UP BY 1. NC1354.2 +033600 GO TO PARAGRAPH-NAME-5. NC1354.2 +033700 PARAGRAPH-NAME-6. NC1354.2 +033800 SET INXEX3 TO 1 NC1354.2 +033900 IF INXEX2 EQUAL TO 10 NC1354.2 +034000 GO TO PARAGRAPH-NAME-7. NC1354.2 +034100 SET INXEX2 UP BY 001. NC1354.2 +034200 GO TO PARAGRAPH-NAME-5. NC1354.2 +034300 PARAGRAPH-NAME-7. NC1354.2 +034400 SET INXEX2 TO 1 NC1354.2 +034500 IF INXEX1 EQUAL TO 10 NC1354.2 +034600 GO TO PARAGRAPH-NAME-8. NC1354.2 +034700 SET INXEX1 UP BY 001. NC1354.2 +034800 GO TO PARAGRAPH-NAME-5. NC1354.2 +034900* THIS SECTION GENERATES VALUES FOR A 10X10X3 TABLE NC1354.2 +035000* AND THE TABLE IS USED IN THE TESTS IN THIS ROUTINE. NC1354.2 +035100 PARAGRAPH-NAME-8. NC1354.2 +035200 EXIT. NC1354.2 +035300 SECTION-NAME-2 SECTION. NC1354.2 +035400 PARAGRAPH-NAME-9. NC1354.2 +035500* NC1354.2 +035600 MOVE SPACE TO COMPUTED-A CORRECT-A. NC1354.2 +035700 MOVE "INDEXING" TO FEATURE. NC1354.2 +035800 SET INXEX1 INXEX2 INXEX3 TO 01. NC1354.2 +035900 INDEX-TEST-1. NC1354.2 +036000 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 001 NC1354.2 +036100 PERFORM PASS NC1354.2 +036200 GO TO WRITE-1. NC1354.2 +036300 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +036400 MOVE 001 TO CORRECT-A. NC1354.2 +036500 PERFORM FAIL. NC1354.2 +036600 GO TO WRITE-1. NC1354.2 +036700 DELETE-1. NC1354.2 +036800 PERFORM DE-LETE. NC1354.2 +036900 WRITE-1. NC1354.2 +037000 MOVE "INDEX-TEST-1" TO PAR-NAME. NC1354.2 +037100 PERFORM PRINT-DETAIL. NC1354.2 +037200 INDEX-TEST-2. NC1354.2 +037300 SET INXEX1 INXEX2 INXEX3 TO 01. NC1354.2 +037400 IF TABLE-1 (INXEX1 INXEX2 + 1 INXEX3 + 1) EQUAL TO 005 NC1354.2 +037500 PERFORM PASS NC1354.2 +037600 GO TO WRITE-2. NC1354.2 +037700 MOVE TABLE-1 (INXEX1 INXEX2 + 1 INXEX3 + 1) TO NC1354.2 +037800 COMPUTED-A. NC1354.2 +037900 MOVE "005" TO CORRECT-A. NC1354.2 +038000 PERFORM FAIL. NC1354.2 +038100 GO TO WRITE-2. NC1354.2 +038200 DELETE-2. NC1354.2 +038300 PERFORM DE-LETE. NC1354.2 +038400 WRITE-2. NC1354.2 +038500 MOVE "INDEX-TEST-2" TO PAR-NAME. NC1354.2 +038600 PERFORM PRINT-DETAIL. NC1354.2 +038700 INDEX-TEST-3. NC1354.2 +038800 SET INXEX1 INXEX2 TO 10. NC1354.2 +038900 SET INXEX3 TO 03. NC1354.2 +039000 IF TABLE-1 (INXEX1 INXEX2 INXEX3 - 1) EQUAL TO 299 NC1354.2 +039100 PERFORM PASS NC1354.2 +039200 GO TO WRITE-3. NC1354.2 +039300 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3 - 1) TO COMPUTED-A. NC1354.2 +039400 MOVE "299" TO CORRECT-A. NC1354.2 +039500 PERFORM FAIL. NC1354.2 +039600 GO TO WRITE-3. NC1354.2 +039700 DELETE-3. NC1354.2 +039800 PERFORM DE-LETE. NC1354.2 +039900 WRITE-3. NC1354.2 +040000 MOVE "INDEX-TEST-3" TO PAR-NAME. NC1354.2 +040100 PERFORM PRINT-DETAIL. NC1354.2 +040200 INDEX-TEST-4. NC1354.2 +040300 SET INXEX1 INXEX2 TO 10. NC1354.2 +040400 SET INXEX3 TO 03. NC1354.2 +040500 IF TABLE-1 (INXEX1 - 5 INXEX2 - 7 INXEX3) EQUAL TO 129 NC1354.2 +040600 PERFORM PASS NC1354.2 +040700 GO TO WRITE-4. NC1354.2 +040800 MOVE TABLE-1 (INXEX1 - 5 INXEX2 - 7 INXEX3) TO NC1354.2 +040900 COMPUTED-A. NC1354.2 +041000 MOVE "129" TO CORRECT-A. NC1354.2 +041100 PERFORM FAIL. NC1354.2 +041200 GO TO WRITE-4. NC1354.2 +041300 DELETE-4. NC1354.2 +041400 PERFORM DE-LETE. NC1354.2 +041500 WRITE-4. NC1354.2 +041600 MOVE "INDEX-TEST-4" TO PAR-NAME. NC1354.2 +041700 PERFORM PRINT-DETAIL. NC1354.2 +041800 INDEX-TEST-5. NC1354.2 +041900 SET INXEX1 TO 10. NC1354.2 +042000 SET KEY-1 TO INXEX1. NC1354.2 +042100 SET INXEX1 TO 05. NC1354.2 +042200 SET INXEX2 TO 10. NC1354.2 +042300 SET INXEX3 TO 03. NC1354.2 +042400 SET INXEX1 TO KEY-1. NC1354.2 +042500 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 300 NC1354.2 +042600 PERFORM PASS NC1354.2 +042700 GO TO WRITE-5. NC1354.2 +042800 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +042900 MOVE "300" TO CORRECT-A. NC1354.2 +043000 PERFORM FAIL. NC1354.2 +043100 GO TO WRITE-5. NC1354.2 +043200 DELETE-5. NC1354.2 +043300 PERFORM DE-LETE. NC1354.2 +043400 WRITE-5. NC1354.2 +043500 MOVE "INDEX-TEST-5" TO PAR-NAME. NC1354.2 +043600 PERFORM PRINT-DETAIL. NC1354.2 +043700 INDEX-TEST-6. NC1354.2 +043800 SET INXEX1 INXEX2 TO 10. NC1354.2 +043900 SET INXEX3 TO 03. NC1354.2 +044000 SET INXEX1 DOWN BY 01. NC1354.2 +044100 SET INXEX2 DOWN BY IDEN-1. NC1354.2 +044200* NOTE IDEN-1 IS EQUAL TO 03. NC1354.2 +044300 SET INXEX3 DOWN BY 2. NC1354.2 +044400 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 259 NC1354.2 +044500 PERFORM PASS NC1354.2 +044600 GO TO WRITE-6. NC1354.2 +044700 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +044800 MOVE "259" TO CORRECT-A. NC1354.2 +044900 PERFORM FAIL. NC1354.2 +045000 GO TO WRITE-6. NC1354.2 +045100 DELETE-6. NC1354.2 +045200 PERFORM DE-LETE. NC1354.2 +045300 WRITE-6. NC1354.2 +045400 MOVE "INDEX-TEST-6" TO PAR-NAME. NC1354.2 +045500 PERFORM PRINT-DETAIL. NC1354.2 +045600 INDEX-TEST-7. NC1354.2 +045700 SET INXEX1 TO ONE. NC1354.2 +045800 SET INXEX2 INXEX3 TO INXEX1. NC1354.2 +045900 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 001 NC1354.2 +046000 PERFORM PASS NC1354.2 +046100 GO TO WRITE-7. NC1354.2 +046200 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +046300 MOVE "001" TO CORRECT-A. NC1354.2 +046400 PERFORM FAIL. NC1354.2 +046500 GO TO WRITE-7. NC1354.2 +046600 DELETE-7. NC1354.2 +046700 PERFORM DE-LETE. NC1354.2 +046800 WRITE-7. NC1354.2 +046900 MOVE "INDEX-TEST-7" TO PAR-NAME. NC1354.2 +047000 PERFORM PRINT-DETAIL. NC1354.2 +047100 SECTION-NAME-3 SECTION. NC1354.2 +047200 PARAGRAPH-NAME-10. NC1354.2 +047300 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1354.2 +047400 PERFORM INSPT. NC1354.2 +047500 MOVE SPACES TO PRINT-REC. NC1354.2 +047600 WRITE PRINT-REC. NC1354.2 +047700 MOVE "NOTE THIS SECTION WRITES A 20X15 TABLE OF THREE-DIGIT NC1354.2 +047800- "NUMBERS 001 TO 300 --- THERE SHOULD BE TWO" TO PRINT-REC.NC1354.2 +047900 WRITE PRINT-REC. NC1354.2 +048000 MOVE SPACES TO PRINT-REC. NC1354.2 +048100 MOVE "SPACES BETWEEN EACH NUMBER ON A LINE --- THE NUMBERS NC1354.2 +048200- "001 THRU 020 SHOULD FORM THE FIRST LINE ---" TO PRINT-REC.NC1354.2 +048300 WRITE PRINT-REC. NC1354.2 +048400 MOVE SPACES TO PRINT-REC. NC1354.2 +048500 MOVE "THE VALUES IN THIS TABLE WERE GENERATED IN NC1354.2 +048600- "SECTION-NAME-1 SECTION." TO PRINT-REC. NC1354.2 +048700 WRITE PRINT-REC. NC1354.2 +048800 MOVE SPACES TO PRINT-REC. NC1354.2 +048900 SET INXEX1 INXEX2 INXEX3 TO ONE. NC1354.2 +049000 MOVE 01 TO CTR-1. NC1354.2 +049100 PARAGRAPH-NAME-11. NC1354.2 +049200 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO NC1354.2 +049300 PRINT-ELE (CTR-1) NC1354.2 +049400 MOVE SPACE TO BLANKSPACE (CTR-1). NC1354.2 +049500 ADD 1 TO CTR-1 NC1354.2 +049600 IF CTR-1 EQUAL TO 21 PERFORM PARAGRAPH-NAME-15. NC1354.2 +049700 IF INXEX3 EQUAL TO 3 GO TO PARAGRAPH-NAME-12. NC1354.2 +049800 SET INXEX3 UP BY 1. NC1354.2 +049900 GO TO PARAGRAPH-NAME-11. NC1354.2 +050000 PARAGRAPH-NAME-12. NC1354.2 +050100 SET INXEX3 TO 1. NC1354.2 +050200 IF INXEX2 EQUAL TO 10 GO TO PARAGRAPH-NAME-13. NC1354.2 +050300 SET INXEX2 UP BY 1. NC1354.2 +050400 GO TO PARAGRAPH-NAME-11. NC1354.2 +050500 PARAGRAPH-NAME-13. NC1354.2 +050600 SET INXEX2 TO 1. NC1354.2 +050700 IF INXEX1 EQUAL TO 10 GO TO PARAGRAPH-NAME-14. NC1354.2 +050800 SET INXEX1 UP BY 1. NC1354.2 +050900 GO TO PARAGRAPH-NAME-11. NC1354.2 +051000 PARAGRAPH-NAME-14. NC1354.2 +051100 GO TO PARAGRAPH-NAME-16. NC1354.2 +051200 PARAGRAPH-NAME-15. NC1354.2 +051300 MOVE SPACE TO PRINT-REC. NC1354.2 +051400 MOVE NUMBER-LIST TO PRINT-REC. NC1354.2 +051500 WRITE PRINT-REC AFTER 1. NC1354.2 +051600 MOVE 01 TO CTR-1. NC1354.2 +051700 PARAGRAPH-NAME-16. NC1354.2 +051800 EXIT. NC1354.2 +051900 CCVS-EXIT SECTION. NC1354.2 +052000 CCVS-999999. NC1354.2 +052100 GO TO CLOSE-FILES. NC1354.2 +*END-OF,NC135A +*HEADER,COBOL,NC136A +000100 IDENTIFICATION DIVISION. NC1364.2 +000200 PROGRAM-ID. NC1364.2 +000300 NC136A. NC1364.2 +000400**************************************************************** NC1364.2 +000500* * NC1364.2 +000600* VALIDATION FOR:- * NC1364.2 +000700* * NC1364.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +000900* * NC1364.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1364.2 +001100* * NC1364.2 +001200**************************************************************** NC1364.2 +001300* * NC1364.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1364.2 +001500* * NC1364.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1364.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1364.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1364.2 +001900* * NC1364.2 +002000**************************************************************** NC1364.2 +002100* NC1364.2 +002200* PROGRAM NC136A VERIFIES THE ACCURACY OF BUILDING AND NC1364.2 +002300* ACCESSING A 3 DIMENSIONAL TABLE USING VARIOUS COMBINATIONS NC1364.2 +002400* OF NUMERIC LITERAL AND DATA-NAME SUBSCRIPTS. NC1364.2 +002500* NC1364.2 +002600 ENVIRONMENT DIVISION. NC1364.2 +002700 CONFIGURATION SECTION. NC1364.2 +002800 SOURCE-COMPUTER. NC1364.2 +002900 XXXXX082. NC1364.2 +003000 OBJECT-COMPUTER. NC1364.2 +003100 XXXXX083. NC1364.2 +003200 INPUT-OUTPUT SECTION. NC1364.2 +003300 FILE-CONTROL. NC1364.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1364.2 +003500 XXXXX055. NC1364.2 +003600 DATA DIVISION. NC1364.2 +003700 FILE SECTION. NC1364.2 +003800 FD PRINT-FILE. NC1364.2 +003900 01 PRINT-REC PICTURE X(120). NC1364.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1364.2 +004100 WORKING-STORAGE SECTION. NC1364.2 +004200 77 SUB-1 PICTURE S99 VALUE ZERO. NC1364.2 +004300 77 SUB-2 PICTURE 99 VALUE ZERO. NC1364.2 +004400 77 SUB-3 PICTURE 99 VALUE ZERO. NC1364.2 +004500 77 CON-7 PICTURE 99 VALUE 07. NC1364.2 +004600 77 CON-10 PICTURE 99 VALUE 10. NC1364.2 +004700 77 CON-5 PICTURE 99 VALUE 05. NC1364.2 +004800 77 CON-6 PICTURE 99 VALUE 06. NC1364.2 +004900 01 GRP-NAME. NC1364.2 +005000 02 FILLER PICTURE XXX VALUE "GRP". NC1364.2 +005100 02 ADD-GRP PICTURE 99 VALUE 01. NC1364.2 +005200 NC1364.2 +005300 01 SEC-NAME. NC1364.2 +005400 02 FILLER PICTURE X(5) VALUE "SEC (". NC1364.2 +005500 02 SEC-GRP PICTURE 99 VALUE 00. NC1364.2 +005600 02 FILLER PICTURE X VALUE " ". NC1364.2 +005700 02 ADD-SEC PICTURE 99 VALUE 01. NC1364.2 +005800 02 FILLER PICTURE X VALUE ")". NC1364.2 +005900 NC1364.2 +006000 01 ELEM-NAME. NC1364.2 +006100 02 FILLER PICTURE X(6) VALUE "ELEM (". NC1364.2 +006200 02 ELEM-GRP PICTURE 99 VALUE 00. NC1364.2 +006300 02 FILLER PICTURE X VALUE " ". NC1364.2 +006400 02 ELEM-SEC PICTURE 99 VALUE 00. NC1364.2 +006500 02 FILLER PICTURE X VALUE " ". NC1364.2 +006600 02 ADD-ELEM PICTURE 99 VALUE 01. NC1364.2 +006700 02 FILLER PICTURE X VALUE ")". NC1364.2 +006800 NC1364.2 +006900 01 THREE-DIMENSION-TBL. NC1364.2 +007000 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC1364.2 +007100 03 ENTRY-1 PICTURE X(5). NC1364.2 +007200 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC1364.2 +007300 04 ENTRY-2 PICTURE X(11). NC1364.2 +007400 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC1364.2 +007500 05 ENTRY-3 PICTURE X(15). NC1364.2 +007600 NC1364.2 +007700 01 TEST-RESULTS. NC1364.2 +007800 02 FILLER PIC X VALUE SPACE. NC1364.2 +007900 02 FEATURE PIC X(20) VALUE SPACE. NC1364.2 +008000 02 FILLER PIC X VALUE SPACE. NC1364.2 +008100 02 P-OR-F PIC X(5) VALUE SPACE. NC1364.2 +008200 02 FILLER PIC X VALUE SPACE. NC1364.2 +008300 02 PAR-NAME. NC1364.2 +008400 03 FILLER PIC X(19) VALUE SPACE. NC1364.2 +008500 03 PARDOT-X PIC X VALUE SPACE. NC1364.2 +008600 03 DOTVALUE PIC 99 VALUE ZERO. NC1364.2 +008700 02 FILLER PIC X(8) VALUE SPACE. NC1364.2 +008800 02 RE-MARK PIC X(61). NC1364.2 +008900 01 TEST-COMPUTED. NC1364.2 +009000 02 FILLER PIC X(30) VALUE SPACE. NC1364.2 +009100 02 FILLER PIC X(17) VALUE NC1364.2 +009200 " COMPUTED=". NC1364.2 +009300 02 COMPUTED-X. NC1364.2 +009400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1364.2 +009500 03 COMPUTED-N REDEFINES COMPUTED-A NC1364.2 +009600 PIC -9(9).9(9). NC1364.2 +009700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1364.2 +009800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1364.2 +009900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1364.2 +010000 03 CM-18V0 REDEFINES COMPUTED-A. NC1364.2 +010100 04 COMPUTED-18V0 PIC -9(18). NC1364.2 +010200 04 FILLER PIC X. NC1364.2 +010300 03 FILLER PIC X(50) VALUE SPACE. NC1364.2 +010400 01 TEST-CORRECT. NC1364.2 +010500 02 FILLER PIC X(30) VALUE SPACE. NC1364.2 +010600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1364.2 +010700 02 CORRECT-X. NC1364.2 +010800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1364.2 +010900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1364.2 +011000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1364.2 +011100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1364.2 +011200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1364.2 +011300 03 CR-18V0 REDEFINES CORRECT-A. NC1364.2 +011400 04 CORRECT-18V0 PIC -9(18). NC1364.2 +011500 04 FILLER PIC X. NC1364.2 +011600 03 FILLER PIC X(2) VALUE SPACE. NC1364.2 +011700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1364.2 +011800 01 CCVS-C-1. NC1364.2 +011900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1364.2 +012000- "SS PARAGRAPH-NAME NC1364.2 +012100- " REMARKS". NC1364.2 +012200 02 FILLER PIC X(20) VALUE SPACE. NC1364.2 +012300 01 CCVS-C-2. NC1364.2 +012400 02 FILLER PIC X VALUE SPACE. NC1364.2 +012500 02 FILLER PIC X(6) VALUE "TESTED". NC1364.2 +012600 02 FILLER PIC X(15) VALUE SPACE. NC1364.2 +012700 02 FILLER PIC X(4) VALUE "FAIL". NC1364.2 +012800 02 FILLER PIC X(94) VALUE SPACE. NC1364.2 +012900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1364.2 +013000 01 REC-CT PIC 99 VALUE ZERO. NC1364.2 +013100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1364.2 +013600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1364.2 +013700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1364.2 +013800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1364.2 +013900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1364.2 +014000 01 CCVS-H-1. NC1364.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC1364.2 +014200 02 FILLER PIC X(42) VALUE NC1364.2 +014300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1364.2 +014400 02 FILLER PIC X(39) VALUE SPACES. NC1364.2 +014500 01 CCVS-H-2A. NC1364.2 +014600 02 FILLER PIC X(40) VALUE SPACE. NC1364.2 +014700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1364.2 +014800 02 FILLER PIC XXXX VALUE NC1364.2 +014900 "4.2 ". NC1364.2 +015000 02 FILLER PIC X(28) VALUE NC1364.2 +015100 " COPY - NOT FOR DISTRIBUTION". NC1364.2 +015200 02 FILLER PIC X(41) VALUE SPACE. NC1364.2 +015300 NC1364.2 +015400 01 CCVS-H-2B. NC1364.2 +015500 02 FILLER PIC X(15) VALUE NC1364.2 +015600 "TEST RESULT OF ". NC1364.2 +015700 02 TEST-ID PIC X(9). NC1364.2 +015800 02 FILLER PIC X(4) VALUE NC1364.2 +015900 " IN ". NC1364.2 +016000 02 FILLER PIC X(12) VALUE NC1364.2 +016100 " HIGH ". NC1364.2 +016200 02 FILLER PIC X(22) VALUE NC1364.2 +016300 " LEVEL VALIDATION FOR ". NC1364.2 +016400 02 FILLER PIC X(58) VALUE NC1364.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +016600 01 CCVS-H-3. NC1364.2 +016700 02 FILLER PIC X(34) VALUE NC1364.2 +016800 " FOR OFFICIAL USE ONLY ". NC1364.2 +016900 02 FILLER PIC X(58) VALUE NC1364.2 +017000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1364.2 +017100 02 FILLER PIC X(28) VALUE NC1364.2 +017200 " COPYRIGHT 1985 ". NC1364.2 +017300 01 CCVS-E-1. NC1364.2 +017400 02 FILLER PIC X(52) VALUE SPACE. NC1364.2 +017500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1364.2 +017600 02 ID-AGAIN PIC X(9). NC1364.2 +017700 02 FILLER PIC X(45) VALUE SPACES. NC1364.2 +017800 01 CCVS-E-2. NC1364.2 +017900 02 FILLER PIC X(31) VALUE SPACE. NC1364.2 +018000 02 FILLER PIC X(21) VALUE SPACE. NC1364.2 +018100 02 CCVS-E-2-2. NC1364.2 +018200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1364.2 +018300 03 FILLER PIC X VALUE SPACE. NC1364.2 +018400 03 ENDER-DESC PIC X(44) VALUE NC1364.2 +018500 "ERRORS ENCOUNTERED". NC1364.2 +018600 01 CCVS-E-3. NC1364.2 +018700 02 FILLER PIC X(22) VALUE NC1364.2 +018800 " FOR OFFICIAL USE ONLY". NC1364.2 +018900 02 FILLER PIC X(12) VALUE SPACE. NC1364.2 +019000 02 FILLER PIC X(58) VALUE NC1364.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +019200 02 FILLER PIC X(13) VALUE SPACE. NC1364.2 +019300 02 FILLER PIC X(15) VALUE NC1364.2 +019400 " COPYRIGHT 1985". NC1364.2 +019500 01 CCVS-E-4. NC1364.2 +019600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1364.2 +019700 02 FILLER PIC X(4) VALUE " OF ". NC1364.2 +019800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1364.2 +019900 02 FILLER PIC X(40) VALUE NC1364.2 +020000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1364.2 +020100 01 XXINFO. NC1364.2 +020200 02 FILLER PIC X(19) VALUE NC1364.2 +020300 "*** INFORMATION ***". NC1364.2 +020400 02 INFO-TEXT. NC1364.2 +020500 04 FILLER PIC X(8) VALUE SPACE. NC1364.2 +020600 04 XXCOMPUTED PIC X(20). NC1364.2 +020700 04 FILLER PIC X(5) VALUE SPACE. NC1364.2 +020800 04 XXCORRECT PIC X(20). NC1364.2 +020900 02 INF-ANSI-REFERENCE PIC X(48). NC1364.2 +021000 01 HYPHEN-LINE. NC1364.2 +021100 02 FILLER PIC IS X VALUE IS SPACE. NC1364.2 +021200 02 FILLER PIC IS X(65) VALUE IS "************************NC1364.2 +021300- "*****************************************". NC1364.2 +021400 02 FILLER PIC IS X(54) VALUE IS "************************NC1364.2 +021500- "******************************". NC1364.2 +021600 01 CCVS-PGM-ID PIC X(9) VALUE NC1364.2 +021700 "NC136A". NC1364.2 +021800 PROCEDURE DIVISION. NC1364.2 +021900 CCVS1 SECTION. NC1364.2 +022000 OPEN-FILES. NC1364.2 +022100 OPEN OUTPUT PRINT-FILE. NC1364.2 +022200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1364.2 +022300 MOVE SPACE TO TEST-RESULTS. NC1364.2 +022400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1364.2 +022500 GO TO CCVS1-EXIT. NC1364.2 +022600 CLOSE-FILES. NC1364.2 +022700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1364.2 +022800 TERMINATE-CCVS. NC1364.2 +022900S EXIT PROGRAM. NC1364.2 +023000STERMINATE-CALL. NC1364.2 +023100 STOP RUN. NC1364.2 +023200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1364.2 +023300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1364.2 +023400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1364.2 +023500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1364.2 +023600 MOVE "****TEST DELETED****" TO RE-MARK. NC1364.2 +023700 PRINT-DETAIL. NC1364.2 +023800 IF REC-CT NOT EQUAL TO ZERO NC1364.2 +023900 MOVE "." TO PARDOT-X NC1364.2 +024000 MOVE REC-CT TO DOTVALUE. NC1364.2 +024100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1364.2 +024200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1364.2 +024300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1364.2 +024400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1364.2 +024500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1364.2 +024600 MOVE SPACE TO CORRECT-X. NC1364.2 +024700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1364.2 +024800 MOVE SPACE TO RE-MARK. NC1364.2 +024900 HEAD-ROUTINE. NC1364.2 +025000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1364.2 +025300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1364.2 +025400 COLUMN-NAMES-ROUTINE. NC1364.2 +025500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +025600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +025800 END-ROUTINE. NC1364.2 +025900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1364.2 +026000 END-RTN-EXIT. NC1364.2 +026100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +026200 END-ROUTINE-1. NC1364.2 +026300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1364.2 +026400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1364.2 +026500 ADD PASS-COUNTER TO ERROR-HOLD. NC1364.2 +026600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1364.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1364.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1364.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1364.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1364.2 +027100 END-ROUTINE-12. NC1364.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1364.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1364.2 +027400 MOVE "NO " TO ERROR-TOTAL NC1364.2 +027500 ELSE NC1364.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1364.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1364.2 +027800 PERFORM WRITE-LINE. NC1364.2 +027900 END-ROUTINE-13. NC1364.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1364.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE NC1364.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1364.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1364.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO NC1364.2 +028600 MOVE "NO " TO ERROR-TOTAL NC1364.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1364.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1364.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +029100 WRITE-LINE. NC1364.2 +029200 ADD 1 TO RECORD-COUNT. NC1364.2 +029300Y IF RECORD-COUNT GREATER 42 NC1364.2 +029400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1364.2 +029500Y MOVE SPACE TO DUMMY-RECORD NC1364.2 +029600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1364.2 +029700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1364.2 +029800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1364.2 +029900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1364.2 +030000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1364.2 +030100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1364.2 +030500Y MOVE ZERO TO RECORD-COUNT. NC1364.2 +030600 PERFORM WRT-LN. NC1364.2 +030700 WRT-LN. NC1364.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1364.2 +030900 MOVE SPACE TO DUMMY-RECORD. NC1364.2 +031000 BLANK-LINE-PRINT. NC1364.2 +031100 PERFORM WRT-LN. NC1364.2 +031200 FAIL-ROUTINE. NC1364.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE NC1364.2 +031400 GO TO FAIL-ROUTINE-WRITE. NC1364.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1364.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1364.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1364.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1364.2 +032000 GO TO FAIL-ROUTINE-EX. NC1364.2 +032100 FAIL-ROUTINE-WRITE. NC1364.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1364.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1364.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1364.2 +032500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1364.2 +032600 FAIL-ROUTINE-EX. EXIT. NC1364.2 +032700 BAIL-OUT. NC1364.2 +032800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1364.2 +032900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1364.2 +033000 BAIL-OUT-WRITE. NC1364.2 +033100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1364.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1364.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1364.2 +033500 BAIL-OUT-EX. EXIT. NC1364.2 +033600 CCVS1-EXIT. NC1364.2 +033700 EXIT. NC1364.2 +033800 SECT-NC136A-001 SECTION. NC1364.2 +033900 NC136-001. NC1364.2 +034000 NC1364.2 +034100 BUILD-LEVEL-1. NC1364.2 +034200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1364.2 +034300 ADD 1 TO SUB-1. NC1364.2 +034400 IF SUB-1 EQUAL TO 11 GO TO CHECK-ENTRIES. NC1364.2 +034500 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC1364.2 +034600 ADD 1 TO ADD-GRP. NC1364.2 +034700 NC1364.2 +034800 BUILD-LEVEL-2. NC1364.2 +034900 ADD 1 TO SUB-2. NC1364.2 +035000 IF SUB-2 EQUAL TO 11 NC1364.2 +035100 MOVE ZERO TO SUB-2 NC1364.2 +035200 MOVE 01 TO ADD-SEC NC1364.2 +035300 GO TO BUILD-LEVEL-1. NC1364.2 +035400 MOVE SUB-1 TO SEC-GRP. NC1364.2 +035500 MOVE SEC-NAME TO ENTRY-2 (SUB-1 SUB-2). NC1364.2 +035600 ADD 1 TO ADD-SEC. NC1364.2 +035700 NC1364.2 +035800 BUILD-LEVEL-3. NC1364.2 +035900 ADD 1 TO SUB-3. NC1364.2 +036000 IF SUB-3 EQUAL TO 11 NC1364.2 +036100 MOVE ZERO TO SUB-3 NC1364.2 +036200 MOVE 01 TO ADD-ELEM NC1364.2 +036300 GO TO BUILD-LEVEL-2. NC1364.2 +036400 MOVE SUB-1 TO ELEM-GRP. NC1364.2 +036500 MOVE SUB-2 TO ELEM-SEC. NC1364.2 +036600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1 SUB-2 SUB-3). NC1364.2 +036700 ADD 1 TO ADD-ELEM. NC1364.2 +036800 GO TO BUILD-LEVEL-3. NC1364.2 +036900 NC1364.2 +037000 CHECK-ENTRIES. NC1364.2 +037100 MOVE "LEVEL 1 TBL SUBSCRPT" TO FEATURE. NC1364.2 +037200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC1364.2 +037300 IF ENTRY-1 (5) IS NOT EQUAL TO "GRP05" NC1364.2 +037400 MOVE "GRP05" TO CORRECT-A NC1364.2 +037500 MOVE ENTRY-1 (5) TO COMPUTED-A NC1364.2 +037600 NC1364.2 +037700 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC1364.2 +037800 PERFORM FAIL NC1364.2 +037900 GO TO TEST-1-WRITE. NC1364.2 +038000 NC1364.2 +038100 PERFORM PASS. NC1364.2 +038200 TEST-1-WRITE. NC1364.2 +038300 PERFORM PRINT-DETAIL. NC1364.2 +038400 NC1364.2 +038500 TEST-1-2. NC1364.2 +038600 MOVE "TEST-1-2 " TO PAR-NAME. NC1364.2 +038700 IF ENTRY-1 (CON-5) IS NOT EQUAL TO "GRP05" NC1364.2 +038800 MOVE "GRP05" TO CORRECT-A NC1364.2 +038900 MOVE ENTRY-1 (CON-5) TO COMPUTED-A NC1364.2 +039000 NC1364.2 +039100 MOVE "NUMERIC CONSTANT SUBSCRIPT " TO RE-MARK NC1364.2 +039200 PERFORM FAIL NC1364.2 +039300 GO TO TEST-1-2-WRITE. NC1364.2 +039400 NC1364.2 +039500 PERFORM PASS. NC1364.2 +039600 TEST-1-2-WRITE. NC1364.2 +039700 PERFORM PRINT-DETAIL. NC1364.2 +039800 NC1364.2 +039900 TEST-2. NC1364.2 +040000 MOVE "LEVEL 2 TBL SUBSCRPT" TO FEATURE. NC1364.2 +040100 MOVE "TEST-2 " TO PAR-NAME. NC1364.2 +040200 IF ENTRY-2 (5 6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +040300 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +040400 MOVE ENTRY-2 (5 6) TO COMPUTED-A NC1364.2 +040500 NC1364.2 +040600 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC1364.2 +040700 PERFORM FAIL NC1364.2 +040800 GO TO TEST-2-WRITE. NC1364.2 +040900 NC1364.2 +041000 PERFORM PASS. NC1364.2 +041100 TEST-2-WRITE. NC1364.2 +041200 PERFORM PRINT-DETAIL. NC1364.2 +041300 NC1364.2 +041400 TEST-2-2. NC1364.2 +041500 MOVE "TEST-2-2 " TO PAR-NAME. NC1364.2 +041600 IF ENTRY-2 (05 CON-6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +041700 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +041800 MOVE ENTRY-2 (05 CON-6) TO COMPUTED-A NC1364.2 +041900 NC1364.2 +042000 MOVE "NUM LITRL/CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +042100 PERFORM FAIL NC1364.2 +042200 GO TO TEST-2-2-WRITE. NC1364.2 +042300 NC1364.2 +042400 PERFORM PASS. NC1364.2 +042500 TEST-2-2-WRITE. NC1364.2 +042600 PERFORM PRINT-DETAIL. NC1364.2 +042700 NC1364.2 +042800 TEST-2-3. NC1364.2 +042900 MOVE "TEST-2-3 " TO PAR-NAME. NC1364.2 +043000 IF ENTRY-2 (CON-5 CON-6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +043100 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +043200 MOVE ENTRY-2 (CON-5 CON-6) TO COMPUTED-A NC1364.2 +043300 NC1364.2 +043400 MOVE "2 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +043500 PERFORM FAIL NC1364.2 +043600 GO TO TEST-2-3-WRITE. NC1364.2 +043700 NC1364.2 +043800 PERFORM PASS. NC1364.2 +043900 TEST-2-3-WRITE. NC1364.2 +044000 PERFORM PRINT-DETAIL. NC1364.2 +044100 NC1364.2 +044200 TEST-3. NC1364.2 +044300 MOVE "LEVEL 3 TBL SUBSCRPT" TO FEATURE. NC1364.2 +044400 MOVE "TEST-3 " TO PAR-NAME. NC1364.2 +044500 IF ENTRY-3 (10 05 06) IS NOT EQUAL TO "ELEM (10 05 06)" NC1364.2 +044600 MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +044700 MOVE ENTRY-3 (10 05 06) TO COMPUTED-A NC1364.2 +044800 NC1364.2 +044900 MOVE "3 NUMERIC LITERAL SUBSCRPTS" TO RE-MARK NC1364.2 +045000 PERFORM FAIL NC1364.2 +045100 GO TO TEST-3-WRITE. NC1364.2 +045200 NC1364.2 +045300 PERFORM PASS. NC1364.2 +045400 TEST-3-WRITE. NC1364.2 +045500 PERFORM PRINT-DETAIL. NC1364.2 +045600 NC1364.2 +045700 TEST-3-2. NC1364.2 +045800 MOVE "TEST-3-2 " TO PAR-NAME. NC1364.2 +045900 IF ENTRY-3 (10 CON-5 CON-6) IS NOT EQUAL TO NC1364.2 +046000 "ELEM (10 05 06)" NC1364.2 +046100 MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +046200 MOVE ENTRY-3 (10 CON-5 CON-6) TO COMPUTED-A NC1364.2 +046300 NC1364.2 +046400 MOVE "1 NUM LTRL/2 CONSTANT SUBS " TO RE-MARK NC1364.2 +046500 PERFORM FAIL NC1364.2 +046600 GO TO TEST-3-2-WRITE. NC1364.2 +046700 NC1364.2 +046800 PERFORM PASS. NC1364.2 +046900 TEST-3-2-WRITE. NC1364.2 +047000 PERFORM PRINT-DETAIL. NC1364.2 +047100 NC1364.2 +047200 TEST-3-3. NC1364.2 +047300 MOVE "TEST-3-3 " TO PAR-NAME. NC1364.2 +047400 IF ENTRY-3 (CON-10 CON-5 CON-6) IS NOT EQUAL TO NC1364.2 +047500 "ELEM (10 05 06)" MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +047600 MOVE ENTRY-3 (CON-10 CON-5 CON-6) TO COMPUTED-A NC1364.2 +047700 NC1364.2 +047800 MOVE "3 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +047900 PERFORM FAIL NC1364.2 +048000 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048100 NC1364.2 +048200 PERFORM PASS. NC1364.2 +048300 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048400 NC1364.2 +048500 END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048600 PERFORM PRINT-DETAIL. NC1364.2 +048700 CCVS-EXIT SECTION. NC1364.2 +048800 CCVS-999999. NC1364.2 +048900 GO TO CLOSE-FILES. NC1364.2 +*END-OF,NC136A +*HEADER,COBOL,NC137A +000100 IDENTIFICATION DIVISION. NC1374.2 +000200 PROGRAM-ID. NC1374.2 +000300 NC137A. NC1374.2 +000400**************************************************************** NC1374.2 +000500* * NC1374.2 +000600* VALIDATION FOR:- * NC1374.2 +000700* * NC1374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +000900* * NC1374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1374.2 +001100* * NC1374.2 +001200**************************************************************** NC1374.2 +001300* * NC1374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1374.2 +001500* * NC1374.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1374.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1374.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1374.2 +001900* * NC1374.2 +002000**************************************************************** NC1374.2 +002100* NC1374.2 +002200* PROGRAM NC137A VERIFIES THE ACCURACY OF BUILDING AND NC1374.2 +002300* ACCESSING A 3 DIMENSIONAL TABLE USING INDEXES. NC1374.2 +002400* NC1374.2 +002500 ENVIRONMENT DIVISION. NC1374.2 +002600 CONFIGURATION SECTION. NC1374.2 +002700 SOURCE-COMPUTER. NC1374.2 +002800 XXXXX082. NC1374.2 +002900 OBJECT-COMPUTER. NC1374.2 +003000 XXXXX083. NC1374.2 +003100 INPUT-OUTPUT SECTION. NC1374.2 +003200 FILE-CONTROL. NC1374.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1374.2 +003400 XXXXX055. NC1374.2 +003500 DATA DIVISION. NC1374.2 +003600 FILE SECTION. NC1374.2 +003700 FD PRINT-FILE. NC1374.2 +003800 01 PRINT-REC PICTURE X(120). NC1374.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1374.2 +004000 WORKING-STORAGE SECTION. NC1374.2 +004100 77 SUB-1 PICTURE S99 VALUE ZERO. NC1374.2 +004200 77 SUB-2 PICTURE 99 VALUE ZERO. NC1374.2 +004300 77 SUB-3 PICTURE 99 VALUE ZERO. NC1374.2 +004400 77 CON-7 PICTURE 99 VALUE 07. NC1374.2 +004500 77 CON-10 PICTURE 99 VALUE 10. NC1374.2 +004600 77 CON-5 PICTURE 99 VALUE 05. NC1374.2 +004700 77 CON-6 PICTURE 99 VALUE 06. NC1374.2 +004800 01 GRP-NAME. NC1374.2 +004900 02 FILLER PICTURE XXX VALUE "GRP". NC1374.2 +005000 02 ADD-GRP PICTURE 99 VALUE 01. NC1374.2 +005100 NC1374.2 +005200 01 SEC-NAME. NC1374.2 +005300 02 FILLER PICTURE X(5) VALUE "SEC (". NC1374.2 +005400 02 SEC-GRP PICTURE 99 VALUE 00. NC1374.2 +005500 02 FILLER PICTURE X VALUE " ". NC1374.2 +005600 02 ADD-SEC PICTURE 99 VALUE 01. NC1374.2 +005700 02 FILLER PICTURE X VALUE ")". NC1374.2 +005800 NC1374.2 +005900 01 ELEM-NAME. NC1374.2 +006000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC1374.2 +006100 02 ELEM-GRP PICTURE 99 VALUE 00. NC1374.2 +006200 02 FILLER PICTURE X VALUE " ". NC1374.2 +006300 02 ELEM-SEC PICTURE 99 VALUE 00. NC1374.2 +006400 02 FILLER PICTURE X VALUE " ". NC1374.2 +006500 02 ADD-ELEM PICTURE 99 VALUE 01. NC1374.2 +006600 02 FILLER PICTURE X VALUE ")". NC1374.2 +006700 NC1374.2 +006800 01 THREE-DIMENSION-TBL. NC1374.2 +006900 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC1374.2 +007000 03 ENTRY-1 PICTURE X(5). NC1374.2 +007100 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC1374.2 +007200 04 ENTRY-2 PICTURE X(11). NC1374.2 +007300 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC1374.2 +007400 05 ENTRY-3 PICTURE X(15). NC1374.2 +007500 NC1374.2 +007600 01 TEST-RESULTS. NC1374.2 +007700 02 FILLER PIC X VALUE SPACE. NC1374.2 +007800 02 FEATURE PIC X(20) VALUE SPACE. NC1374.2 +007900 02 FILLER PIC X VALUE SPACE. NC1374.2 +008000 02 P-OR-F PIC X(5) VALUE SPACE. NC1374.2 +008100 02 FILLER PIC X VALUE SPACE. NC1374.2 +008200 02 PAR-NAME. NC1374.2 +008300 03 FILLER PIC X(19) VALUE SPACE. NC1374.2 +008400 03 PARDOT-X PIC X VALUE SPACE. NC1374.2 +008500 03 DOTVALUE PIC 99 VALUE ZERO. NC1374.2 +008600 02 FILLER PIC X(8) VALUE SPACE. NC1374.2 +008700 02 RE-MARK PIC X(61). NC1374.2 +008800 01 TEST-COMPUTED. NC1374.2 +008900 02 FILLER PIC X(30) VALUE SPACE. NC1374.2 +009000 02 FILLER PIC X(17) VALUE NC1374.2 +009100 " COMPUTED=". NC1374.2 +009200 02 COMPUTED-X. NC1374.2 +009300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1374.2 +009400 03 COMPUTED-N REDEFINES COMPUTED-A NC1374.2 +009500 PIC -9(9).9(9). NC1374.2 +009600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1374.2 +009700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1374.2 +009800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1374.2 +009900 03 CM-18V0 REDEFINES COMPUTED-A. NC1374.2 +010000 04 COMPUTED-18V0 PIC -9(18). NC1374.2 +010100 04 FILLER PIC X. NC1374.2 +010200 03 FILLER PIC X(50) VALUE SPACE. NC1374.2 +010300 01 TEST-CORRECT. NC1374.2 +010400 02 FILLER PIC X(30) VALUE SPACE. NC1374.2 +010500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1374.2 +010600 02 CORRECT-X. NC1374.2 +010700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1374.2 +010800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1374.2 +010900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1374.2 +011000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1374.2 +011100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1374.2 +011200 03 CR-18V0 REDEFINES CORRECT-A. NC1374.2 +011300 04 CORRECT-18V0 PIC -9(18). NC1374.2 +011400 04 FILLER PIC X. NC1374.2 +011500 03 FILLER PIC X(2) VALUE SPACE. NC1374.2 +011600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1374.2 +011700 01 CCVS-C-1. NC1374.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1374.2 +011900- "SS PARAGRAPH-NAME NC1374.2 +012000- " REMARKS". NC1374.2 +012100 02 FILLER PIC X(20) VALUE SPACE. NC1374.2 +012200 01 CCVS-C-2. NC1374.2 +012300 02 FILLER PIC X VALUE SPACE. NC1374.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". NC1374.2 +012500 02 FILLER PIC X(15) VALUE SPACE. NC1374.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". NC1374.2 +012700 02 FILLER PIC X(94) VALUE SPACE. NC1374.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1374.2 +012900 01 REC-CT PIC 99 VALUE ZERO. NC1374.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1374.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1374.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1374.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1374.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1374.2 +013900 01 CCVS-H-1. NC1374.2 +014000 02 FILLER PIC X(39) VALUE SPACES. NC1374.2 +014100 02 FILLER PIC X(42) VALUE NC1374.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1374.2 +014300 02 FILLER PIC X(39) VALUE SPACES. NC1374.2 +014400 01 CCVS-H-2A. NC1374.2 +014500 02 FILLER PIC X(40) VALUE SPACE. NC1374.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1374.2 +014700 02 FILLER PIC XXXX VALUE NC1374.2 +014800 "4.2 ". NC1374.2 +014900 02 FILLER PIC X(28) VALUE NC1374.2 +015000 " COPY - NOT FOR DISTRIBUTION". NC1374.2 +015100 02 FILLER PIC X(41) VALUE SPACE. NC1374.2 +015200 NC1374.2 +015300 01 CCVS-H-2B. NC1374.2 +015400 02 FILLER PIC X(15) VALUE NC1374.2 +015500 "TEST RESULT OF ". NC1374.2 +015600 02 TEST-ID PIC X(9). NC1374.2 +015700 02 FILLER PIC X(4) VALUE NC1374.2 +015800 " IN ". NC1374.2 +015900 02 FILLER PIC X(12) VALUE NC1374.2 +016000 " HIGH ". NC1374.2 +016100 02 FILLER PIC X(22) VALUE NC1374.2 +016200 " LEVEL VALIDATION FOR ". NC1374.2 +016300 02 FILLER PIC X(58) VALUE NC1374.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +016500 01 CCVS-H-3. NC1374.2 +016600 02 FILLER PIC X(34) VALUE NC1374.2 +016700 " FOR OFFICIAL USE ONLY ". NC1374.2 +016800 02 FILLER PIC X(58) VALUE NC1374.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1374.2 +017000 02 FILLER PIC X(28) VALUE NC1374.2 +017100 " COPYRIGHT 1985 ". NC1374.2 +017200 01 CCVS-E-1. NC1374.2 +017300 02 FILLER PIC X(52) VALUE SPACE. NC1374.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1374.2 +017500 02 ID-AGAIN PIC X(9). NC1374.2 +017600 02 FILLER PIC X(45) VALUE SPACES. NC1374.2 +017700 01 CCVS-E-2. NC1374.2 +017800 02 FILLER PIC X(31) VALUE SPACE. NC1374.2 +017900 02 FILLER PIC X(21) VALUE SPACE. NC1374.2 +018000 02 CCVS-E-2-2. NC1374.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1374.2 +018200 03 FILLER PIC X VALUE SPACE. NC1374.2 +018300 03 ENDER-DESC PIC X(44) VALUE NC1374.2 +018400 "ERRORS ENCOUNTERED". NC1374.2 +018500 01 CCVS-E-3. NC1374.2 +018600 02 FILLER PIC X(22) VALUE NC1374.2 +018700 " FOR OFFICIAL USE ONLY". NC1374.2 +018800 02 FILLER PIC X(12) VALUE SPACE. NC1374.2 +018900 02 FILLER PIC X(58) VALUE NC1374.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +019100 02 FILLER PIC X(13) VALUE SPACE. NC1374.2 +019200 02 FILLER PIC X(15) VALUE NC1374.2 +019300 " COPYRIGHT 1985". NC1374.2 +019400 01 CCVS-E-4. NC1374.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1374.2 +019600 02 FILLER PIC X(4) VALUE " OF ". NC1374.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1374.2 +019800 02 FILLER PIC X(40) VALUE NC1374.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1374.2 +020000 01 XXINFO. NC1374.2 +020100 02 FILLER PIC X(19) VALUE NC1374.2 +020200 "*** INFORMATION ***". NC1374.2 +020300 02 INFO-TEXT. NC1374.2 +020400 04 FILLER PIC X(8) VALUE SPACE. NC1374.2 +020500 04 XXCOMPUTED PIC X(20). NC1374.2 +020600 04 FILLER PIC X(5) VALUE SPACE. NC1374.2 +020700 04 XXCORRECT PIC X(20). NC1374.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). NC1374.2 +020900 01 HYPHEN-LINE. NC1374.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. NC1374.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************NC1374.2 +021200- "*****************************************". NC1374.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************NC1374.2 +021400- "******************************". NC1374.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE NC1374.2 +021600 "NC137A". NC1374.2 +021700 PROCEDURE DIVISION. NC1374.2 +021800 CCVS1 SECTION. NC1374.2 +021900 OPEN-FILES. NC1374.2 +022000 OPEN OUTPUT PRINT-FILE. NC1374.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1374.2 +022200 MOVE SPACE TO TEST-RESULTS. NC1374.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1374.2 +022400 GO TO CCVS1-EXIT. NC1374.2 +022500 CLOSE-FILES. NC1374.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1374.2 +022700 TERMINATE-CCVS. NC1374.2 +022800S EXIT PROGRAM. NC1374.2 +022900STERMINATE-CALL. NC1374.2 +023000 STOP RUN. NC1374.2 +023100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1374.2 +023200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1374.2 +023300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1374.2 +023400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1374.2 +023500 MOVE "****TEST DELETED****" TO RE-MARK. NC1374.2 +023600 PRINT-DETAIL. NC1374.2 +023700 IF REC-CT NOT EQUAL TO ZERO NC1374.2 +023800 MOVE "." TO PARDOT-X NC1374.2 +023900 MOVE REC-CT TO DOTVALUE. NC1374.2 +024000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1374.2 +024100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1374.2 +024200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1374.2 +024300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1374.2 +024400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1374.2 +024500 MOVE SPACE TO CORRECT-X. NC1374.2 +024600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1374.2 +024700 MOVE SPACE TO RE-MARK. NC1374.2 +024800 HEAD-ROUTINE. NC1374.2 +024900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1374.2 +025200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1374.2 +025300 COLUMN-NAMES-ROUTINE. NC1374.2 +025400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +025500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +025700 END-ROUTINE. NC1374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1374.2 +025900 END-RTN-EXIT. NC1374.2 +026000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +026100 END-ROUTINE-1. NC1374.2 +026200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1374.2 +026300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1374.2 +026400 ADD PASS-COUNTER TO ERROR-HOLD. NC1374.2 +026500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1374.2 +026600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1374.2 +026700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1374.2 +026800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1374.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1374.2 +027000 END-ROUTINE-12. NC1374.2 +027100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1374.2 +027200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1374.2 +027300 MOVE "NO " TO ERROR-TOTAL NC1374.2 +027400 ELSE NC1374.2 +027500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1374.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1374.2 +027700 PERFORM WRITE-LINE. NC1374.2 +027800 END-ROUTINE-13. NC1374.2 +027900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1374.2 +028000 MOVE "NO " TO ERROR-TOTAL ELSE NC1374.2 +028100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1374.2 +028200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1374.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +028400 IF INSPECT-COUNTER EQUAL TO ZERO NC1374.2 +028500 MOVE "NO " TO ERROR-TOTAL NC1374.2 +028600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1374.2 +028700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1374.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +028900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +029000 WRITE-LINE. NC1374.2 +029100 ADD 1 TO RECORD-COUNT. NC1374.2 +029200Y IF RECORD-COUNT GREATER 42 NC1374.2 +029300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1374.2 +029400Y MOVE SPACE TO DUMMY-RECORD NC1374.2 +029500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1374.2 +029600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1374.2 +029700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1374.2 +029800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1374.2 +029900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1374.2 +030000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1374.2 +030400Y MOVE ZERO TO RECORD-COUNT. NC1374.2 +030500 PERFORM WRT-LN. NC1374.2 +030600 WRT-LN. NC1374.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1374.2 +030800 MOVE SPACE TO DUMMY-RECORD. NC1374.2 +030900 BLANK-LINE-PRINT. NC1374.2 +031000 PERFORM WRT-LN. NC1374.2 +031100 FAIL-ROUTINE. NC1374.2 +031200 IF COMPUTED-X NOT EQUAL TO SPACE NC1374.2 +031300 GO TO FAIL-ROUTINE-WRITE. NC1374.2 +031400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1374.2 +031500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1374.2 +031600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1374.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1374.2 +031900 GO TO FAIL-ROUTINE-EX. NC1374.2 +032000 FAIL-ROUTINE-WRITE. NC1374.2 +032100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1374.2 +032200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1374.2 +032300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1374.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1374.2 +032500 FAIL-ROUTINE-EX. EXIT. NC1374.2 +032600 BAIL-OUT. NC1374.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1374.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1374.2 +032900 BAIL-OUT-WRITE. NC1374.2 +033000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1374.2 +033100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1374.2 +033200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +033300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1374.2 +033400 BAIL-OUT-EX. EXIT. NC1374.2 +033500 CCVS1-EXIT. NC1374.2 +033600 EXIT. NC1374.2 +033700 SECT-NC137A-001 SECTION. NC1374.2 +033800 NC137A-001. NC1374.2 +033900 NC1374.2 +034000 BUILD-LEVEL-1. NC1374.2 +034100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1374.2 +034200 ADD 1 TO SUB-1. NC1374.2 +034300 IF SUB-1 EQUAL TO 11 GO TO CHECK-ENTRIES. NC1374.2 +034400 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC1374.2 +034500 ADD 1 TO ADD-GRP. NC1374.2 +034600 NC1374.2 +034700 BUILD-LEVEL-2. NC1374.2 +034800 ADD 1 TO SUB-2. NC1374.2 +034900 IF SUB-2 EQUAL TO 11 NC1374.2 +035000 MOVE ZERO TO SUB-2 NC1374.2 +035100 MOVE 01 TO ADD-SEC NC1374.2 +035200 GO TO BUILD-LEVEL-1. NC1374.2 +035300 MOVE SUB-1 TO SEC-GRP. NC1374.2 +035400 MOVE SEC-NAME TO ENTRY-2 (SUB-1 SUB-2). NC1374.2 +035500 ADD 1 TO ADD-SEC. NC1374.2 +035600 NC1374.2 +035700 BUILD-LEVEL-3. NC1374.2 +035800 ADD 1 TO SUB-3. NC1374.2 +035900 IF SUB-3 EQUAL TO 11 NC1374.2 +036000 MOVE ZERO TO SUB-3 NC1374.2 +036100 MOVE 01 TO ADD-ELEM NC1374.2 +036200 GO TO BUILD-LEVEL-2. NC1374.2 +036300 MOVE SUB-1 TO ELEM-GRP. NC1374.2 +036400 MOVE SUB-2 TO ELEM-SEC. NC1374.2 +036500 MOVE ELEM-NAME TO ENTRY-3 (SUB-1 SUB-2 SUB-3). NC1374.2 +036600 ADD 1 TO ADD-ELEM. NC1374.2 +036700 GO TO BUILD-LEVEL-3. NC1374.2 +036800 NC1374.2 +036900 CHECK-ENTRIES. NC1374.2 +037000 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC1374.2 +037100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC1374.2 +037200 SET IDX-1 TO 5. NC1374.2 +037300 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP05" NC1374.2 +037400 MOVE "GRP05" TO CORRECT-A NC1374.2 +037500 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC1374.2 +037600 NC1374.2 +037700 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC1374.2 +037800 PERFORM FAIL NC1374.2 +037900 GO TO TEST-1-WRITE. NC1374.2 +038000 NC1374.2 +038100 PERFORM PASS. NC1374.2 +038200 TEST-1-WRITE. NC1374.2 +038300 PERFORM PRINT-DETAIL. NC1374.2 +038400 NC1374.2 +038500 TEST-1-2. NC1374.2 +038600 MOVE "TEST-1-2 " TO PAR-NAME. NC1374.2 +038700 SET IDX-1 TO 8. NC1374.2 +038800 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP08" NC1374.2 +038900 MOVE "GRP08" TO CORRECT-A NC1374.2 +039000 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC1374.2 +039100 NC1374.2 +039200 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC1374.2 +039300 PERFORM FAIL NC1374.2 +039400 GO TO TEST-1-2-WRITE. NC1374.2 +039500 NC1374.2 +039600 PERFORM PASS. NC1374.2 +039700 TEST-1-2-WRITE. NC1374.2 +039800 PERFORM PRINT-DETAIL. NC1374.2 +039900 NC1374.2 +040000 TEST-2. NC1374.2 +040100 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC1374.2 +040200 MOVE "TEST-2 " TO PAR-NAME. NC1374.2 +040300 SET IDX-1 TO 5. NC1374.2 +040400 SET IDX-2 TO 6. NC1374.2 +040500 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (05 06)" NC1374.2 +040600 MOVE "SEC (05 06)" TO CORRECT-A NC1374.2 +040700 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +040800 NC1374.2 +040900 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +041000 PERFORM FAIL NC1374.2 +041100 GO TO TEST-2-WRITE. NC1374.2 +041200 NC1374.2 +041300 PERFORM PASS. NC1374.2 +041400 TEST-2-WRITE. NC1374.2 +041500 PERFORM PRINT-DETAIL. NC1374.2 +041600 NC1374.2 +041700 TEST-2-2. NC1374.2 +041800 MOVE "TEST-2-2 " TO PAR-NAME. NC1374.2 +041900 SET IDX-1 IDX-2 TO 8. NC1374.2 +042000 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (08 08)" NC1374.2 +042100 MOVE "SEC (08 08)" TO CORRECT-A NC1374.2 +042200 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +042300 NC1374.2 +042400 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +042500 PERFORM FAIL NC1374.2 +042600 GO TO TEST-2-2-WRITE. NC1374.2 +042700 NC1374.2 +042800 PERFORM PASS. NC1374.2 +042900 TEST-2-2-WRITE. NC1374.2 +043000 PERFORM PRINT-DETAIL. NC1374.2 +043100 NC1374.2 +043200 TEST-2-3. NC1374.2 +043300 MOVE "TEST-2-3 " TO PAR-NAME. NC1374.2 +043400 SET IDX-1 TO 3. NC1374.2 +043500 SET IDX-2 TO 7. NC1374.2 +043600 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (03 07)" NC1374.2 +043700 MOVE "SEC (03 07)" TO CORRECT-A NC1374.2 +043800 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +043900 NC1374.2 +044000 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +044100 PERFORM FAIL NC1374.2 +044200 GO TO TEST-2-3-WRITE. NC1374.2 +044300 NC1374.2 +044400 PERFORM PASS. NC1374.2 +044500 TEST-2-3-WRITE. NC1374.2 +044600 PERFORM PRINT-DETAIL. NC1374.2 +044700 NC1374.2 +044800 TEST-3. NC1374.2 +044900 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC1374.2 +045000 MOVE "TEST-3 " TO PAR-NAME. NC1374.2 +045100 SET IDX-1 TO 2. NC1374.2 +045200 SET IDX-2 TO 6. NC1374.2 +045300 SET IDX-3 TO 10. NC1374.2 +045400 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +045500 "ELEM (02 06 10)" NC1374.2 +045600 MOVE "ELEM (02 06 10)" TO CORRECT-A NC1374.2 +045700 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +045800 NC1374.2 +045900 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +046000 PERFORM FAIL NC1374.2 +046100 GO TO TEST-3-WRITE. NC1374.2 +046200 NC1374.2 +046300 PERFORM PASS. NC1374.2 +046400 TEST-3-WRITE. NC1374.2 +046500 PERFORM PRINT-DETAIL. NC1374.2 +046600 NC1374.2 +046700 TEST-3-2. NC1374.2 +046800 MOVE "TEST-3-2 " TO PAR-NAME. NC1374.2 +046900 SET IDX-1 IDX-2 IDX-3 TO 6. NC1374.2 +047000 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +047100 "ELEM (06 06 06)" NC1374.2 +047200 MOVE "ELEM (06 06 06)" TO CORRECT-A NC1374.2 +047300 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +047400 NC1374.2 +047500 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +047600 PERFORM FAIL NC1374.2 +047700 GO TO TEST-3-2-WRITE. NC1374.2 +047800 NC1374.2 +047900 PERFORM PASS. NC1374.2 +048000 TEST-3-2-WRITE. NC1374.2 +048100 PERFORM PRINT-DETAIL. NC1374.2 +048200 NC1374.2 +048300 TEST-3-3. NC1374.2 +048400 MOVE "TEST-3-3 " TO PAR-NAME. NC1374.2 +048500 SET IDX-1 TO 9. NC1374.2 +048600 SET IDX-2 TO 8. NC1374.2 +048700 SET IDX-3 TO 7. NC1374.2 +048800 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +048900 "ELEM (09 08 07)" MOVE "ELEM (09 08 07)" TO CORRECT-A NC1374.2 +049000 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +049100 NC1374.2 +049200 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +049300 PERFORM FAIL NC1374.2 +049400 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +049500 NC1374.2 +049600 PERFORM PASS. NC1374.2 +049700 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +049800 NC1374.2 +049900 END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +050000 PERFORM PRINT-DETAIL. NC1374.2 +050100 CCVS-EXIT SECTION. NC1374.2 +050200 CCVS-999999. NC1374.2 +050300 GO TO CLOSE-FILES. NC1374.2 +*END-OF,NC137A +*HEADER,COBOL,NC138A +000100 IDENTIFICATION DIVISION. NC1384.2 +000200 PROGRAM-ID. NC1384.2 +000300 NC138A. NC1384.2 +000400**************************************************************** NC1384.2 +000500* * NC1384.2 +000600* VALIDATION FOR:- * NC1384.2 +000700* * NC1384.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +000900* * NC1384.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1384.2 +001100* * NC1384.2 +001200**************************************************************** NC1384.2 +001300* * NC1384.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1384.2 +001500* * NC1384.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1384.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1384.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1384.2 +001900* * NC1384.2 +002000**************************************************************** NC1384.2 +002100* NC1384.2 +002200* PROGRAM NC138A TESTS THE USE OF SPACES, COMMAS, NC1384.2 +002300* SEMI-COLONS AND LEFT AND RIGHT PARENTHESIS AS SEPARATORS NC1384.2 +002400* IN STATEMENTS WHICH REFERENCE TABLE ITEMS. NC1384.2 +002500* NC1384.2 +002600 ENVIRONMENT DIVISION. NC1384.2 +002700 CONFIGURATION SECTION. NC1384.2 +002800 SOURCE-COMPUTER. NC1384.2 +002900 XXXXX082. NC1384.2 +003000 OBJECT-COMPUTER. NC1384.2 +003100 XXXXX083. NC1384.2 +003200 INPUT-OUTPUT SECTION. NC1384.2 +003300 FILE-CONTROL. NC1384.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1384.2 +003500 XXXXX055. NC1384.2 +003600 DATA DIVISION. NC1384.2 +003700 FILE SECTION. NC1384.2 +003800 FD PRINT-FILE. NC1384.2 +003900 01 PRINT-REC PICTURE X(120). NC1384.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1384.2 +004100 WORKING-STORAGE SECTION. NC1384.2 +004200 77 WRK1 PIC S999 VALUE ZERO. NC1384.2 +004300 77 TEMP PIC S9(5). NC1384.2 +004400 77 EXPECTED-VALUE PIC S9(5). NC1384.2 +004500* SUBSCRIPTS FOR REFERENCING TABLE ITEMS. NC1384.2 +004600 77 S1 PIC S999 VALUE 1. NC1384.2 +004700 77 S21 PIC S999 VALUE 1. NC1384.2 +004800 77 S22 PIC S999 SIGN IS LEADING SEPARATE CHARACTER NC1384.2 +004900 VALUE 1. NC1384.2 +005000 77 S31 PIC S999 COMPUTATIONAL VALUE 1. NC1384.2 +005100 77 S32 PIC S999 SYNC LEFT VALUE 1. NC1384.2 +005200 77 S33 PIC S999 VALUE 1. NC1384.2 +005300* ONE DIMENSIONAL TABLE. NC1384.2 +005400 01 GRP-TAB1. NC1384.2 +005500 02 ELEM1 PIC 99 NC1384.2 +005600 OCCURS 60 TIMES. NC1384.2 +005700* TWO DIMENSIONAL TABLE, 12 BY 5. NC1384.2 +005800 01 GRP-TAP2. NC1384.2 +005900 02 GRP-LEV2-O012F OCCURS 12 TIMES. NC1384.2 +006000 03 ELEM2 PIC 9999 COMPUTATIONAL NC1384.2 +006100 OCCURS 5 TIMES. NC1384.2 +006200* THREE DIMENSIONAL TABLE, 4 BY 3 BY 5. NC1384.2 +006300 01 GRP-TAB3. NC1384.2 +006400 02 GRP-LEV2-00004F NC1384.2 +006500 OCCURS 4 TIMES NC1384.2 +006600 INDEXED BY WRK-IX-0001. NC1384.2 +006700 03 GRP-LEV3-O0003F OCCURS 3 TIMES. NC1384.2 +006800 04 ELEM3 PICTURE IS S999 NC1384.2 +006900 USAGE IS DISPLAY SIGN IS LEADING SEPARATE CHARACTER NC1384.2 +007000 OCCURS 5 TIMES. NC1384.2 +007100 01 TEST-RESULTS. NC1384.2 +007200 02 FILLER PIC X VALUE SPACE. NC1384.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC1384.2 +007400 02 FILLER PIC X VALUE SPACE. NC1384.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC1384.2 +007600 02 FILLER PIC X VALUE SPACE. NC1384.2 +007700 02 PAR-NAME. NC1384.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC1384.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC1384.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC1384.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC1384.2 +008200 02 RE-MARK PIC X(61). NC1384.2 +008300 01 TEST-COMPUTED. NC1384.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1384.2 +008500 02 FILLER PIC X(17) VALUE NC1384.2 +008600 " COMPUTED=". NC1384.2 +008700 02 COMPUTED-X. NC1384.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1384.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC1384.2 +009000 PIC -9(9).9(9). NC1384.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1384.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1384.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1384.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC1384.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC1384.2 +009600 04 FILLER PIC X. NC1384.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC1384.2 +009800 01 TEST-CORRECT. NC1384.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC1384.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1384.2 +010100 02 CORRECT-X. NC1384.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1384.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1384.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1384.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1384.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1384.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC1384.2 +010800 04 CORRECT-18V0 PIC -9(18). NC1384.2 +010900 04 FILLER PIC X. NC1384.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC1384.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1384.2 +011200 01 CCVS-C-1. NC1384.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1384.2 +011400- "SS PARAGRAPH-NAME NC1384.2 +011500- " REMARKS". NC1384.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC1384.2 +011700 01 CCVS-C-2. NC1384.2 +011800 02 FILLER PIC X VALUE SPACE. NC1384.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC1384.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC1384.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC1384.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC1384.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1384.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC1384.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1384.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1384.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1384.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1384.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1384.2 +013400 01 CCVS-H-1. NC1384.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC1384.2 +013600 02 FILLER PIC X(42) VALUE NC1384.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1384.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC1384.2 +013900 01 CCVS-H-2A. NC1384.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC1384.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1384.2 +014200 02 FILLER PIC XXXX VALUE NC1384.2 +014300 "4.2 ". NC1384.2 +014400 02 FILLER PIC X(28) VALUE NC1384.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC1384.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC1384.2 +014700 NC1384.2 +014800 01 CCVS-H-2B. NC1384.2 +014900 02 FILLER PIC X(15) VALUE NC1384.2 +015000 "TEST RESULT OF ". NC1384.2 +015100 02 TEST-ID PIC X(9). NC1384.2 +015200 02 FILLER PIC X(4) VALUE NC1384.2 +015300 " IN ". NC1384.2 +015400 02 FILLER PIC X(12) VALUE NC1384.2 +015500 " HIGH ". NC1384.2 +015600 02 FILLER PIC X(22) VALUE NC1384.2 +015700 " LEVEL VALIDATION FOR ". NC1384.2 +015800 02 FILLER PIC X(58) VALUE NC1384.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +016000 01 CCVS-H-3. NC1384.2 +016100 02 FILLER PIC X(34) VALUE NC1384.2 +016200 " FOR OFFICIAL USE ONLY ". NC1384.2 +016300 02 FILLER PIC X(58) VALUE NC1384.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1384.2 +016500 02 FILLER PIC X(28) VALUE NC1384.2 +016600 " COPYRIGHT 1985 ". NC1384.2 +016700 01 CCVS-E-1. NC1384.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC1384.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1384.2 +017000 02 ID-AGAIN PIC X(9). NC1384.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC1384.2 +017200 01 CCVS-E-2. NC1384.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC1384.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC1384.2 +017500 02 CCVS-E-2-2. NC1384.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1384.2 +017700 03 FILLER PIC X VALUE SPACE. NC1384.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC1384.2 +017900 "ERRORS ENCOUNTERED". NC1384.2 +018000 01 CCVS-E-3. NC1384.2 +018100 02 FILLER PIC X(22) VALUE NC1384.2 +018200 " FOR OFFICIAL USE ONLY". NC1384.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC1384.2 +018400 02 FILLER PIC X(58) VALUE NC1384.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC1384.2 +018700 02 FILLER PIC X(15) VALUE NC1384.2 +018800 " COPYRIGHT 1985". NC1384.2 +018900 01 CCVS-E-4. NC1384.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1384.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC1384.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1384.2 +019300 02 FILLER PIC X(40) VALUE NC1384.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1384.2 +019500 01 XXINFO. NC1384.2 +019600 02 FILLER PIC X(19) VALUE NC1384.2 +019700 "*** INFORMATION ***". NC1384.2 +019800 02 INFO-TEXT. NC1384.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC1384.2 +020000 04 XXCOMPUTED PIC X(20). NC1384.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC1384.2 +020200 04 XXCORRECT PIC X(20). NC1384.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC1384.2 +020400 01 HYPHEN-LINE. NC1384.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC1384.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC1384.2 +020700- "*****************************************". NC1384.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC1384.2 +020900- "******************************". NC1384.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC1384.2 +021100 "NC138A". NC1384.2 +021200 PROCEDURE DIVISION. NC1384.2 +021300 CCVS1 SECTION. NC1384.2 +021400 OPEN-FILES. NC1384.2 +021500 OPEN OUTPUT PRINT-FILE. NC1384.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1384.2 +021700 MOVE SPACE TO TEST-RESULTS. NC1384.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1384.2 +021900 GO TO CCVS1-EXIT. NC1384.2 +022000 CLOSE-FILES. NC1384.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1384.2 +022200 TERMINATE-CCVS. NC1384.2 +022300S EXIT PROGRAM. NC1384.2 +022400STERMINATE-CALL. NC1384.2 +022500 STOP RUN. NC1384.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1384.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1384.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1384.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1384.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC1384.2 +023100 PRINT-DETAIL. NC1384.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC1384.2 +023300 MOVE "." TO PARDOT-X NC1384.2 +023400 MOVE REC-CT TO DOTVALUE. NC1384.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1384.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1384.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1384.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1384.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1384.2 +024000 MOVE SPACE TO CORRECT-X. NC1384.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1384.2 +024200 MOVE SPACE TO RE-MARK. NC1384.2 +024300 HEAD-ROUTINE. NC1384.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1384.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1384.2 +024800 COLUMN-NAMES-ROUTINE. NC1384.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +025200 END-ROUTINE. NC1384.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1384.2 +025400 END-RTN-EXIT. NC1384.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +025600 END-ROUTINE-1. NC1384.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1384.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1384.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC1384.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1384.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1384.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1384.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1384.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1384.2 +026500 END-ROUTINE-12. NC1384.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1384.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1384.2 +026800 MOVE "NO " TO ERROR-TOTAL NC1384.2 +026900 ELSE NC1384.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1384.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1384.2 +027200 PERFORM WRITE-LINE. NC1384.2 +027300 END-ROUTINE-13. NC1384.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1384.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC1384.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1384.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1384.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC1384.2 +028000 MOVE "NO " TO ERROR-TOTAL NC1384.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1384.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1384.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +028500 WRITE-LINE. NC1384.2 +028600 ADD 1 TO RECORD-COUNT. NC1384.2 +028700Y IF RECORD-COUNT GREATER 42 NC1384.2 +028800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1384.2 +028900Y MOVE SPACE TO DUMMY-RECORD NC1384.2 +029000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1384.2 +029100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1384.2 +029200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1384.2 +029300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1384.2 +029400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1384.2 +029500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1384.2 +029900Y MOVE ZERO TO RECORD-COUNT. NC1384.2 +030000 PERFORM WRT-LN. NC1384.2 +030100 WRT-LN. NC1384.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1384.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC1384.2 +030400 BLANK-LINE-PRINT. NC1384.2 +030500 PERFORM WRT-LN. NC1384.2 +030600 FAIL-ROUTINE. NC1384.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC1384.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC1384.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1384.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1384.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1384.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1384.2 +031400 GO TO FAIL-ROUTINE-EX. NC1384.2 +031500 FAIL-ROUTINE-WRITE. NC1384.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1384.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1384.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1384.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1384.2 +032000 FAIL-ROUTINE-EX. EXIT. NC1384.2 +032100 BAIL-OUT. NC1384.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1384.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1384.2 +032400 BAIL-OUT-WRITE. NC1384.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1384.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1384.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1384.2 +032900 BAIL-OUT-EX. EXIT. NC1384.2 +033000 CCVS1-EXIT. NC1384.2 +033100 EXIT. NC1384.2 +033200 SECT-NC138A-0001 SECTION. NC1384.2 +033300 NC138A-0001. NC1384.2 +033400 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1384.2 +033500* THIS SECTION STORES THE NUMBERS 1 THROUGH 60 IN THE 3 TABLES.NC1384.2 +033600 MOVE-VALUE. NC1384.2 +033700 ADD 1 TO WRK1. NC1384.2 +033800 MOVE WRK1 TO ELEM1 (S1) ELEM2 (S21, S22) NC1384.2 +033900 ELEM3 (S31, S32, S33). NC1384.2 +034000 IF WRK1 EQUAL TO 60 GO TO SECT-TH109-0002. NC1384.2 +034100 INCRE-SUBS. NC1384.2 +034200 ADD 1 TO S1. NC1384.2 +034300 ADD 1 TO S22. NC1384.2 +034400 ADD 1 TO S33. NC1384.2 +034500 IF S22 LESS THAN 6 GO TO MOVE-VALUE. NC1384.2 +034600 MOVE 1 TO S22 S33. NC1384.2 +034700 ADD 1 TO S21. NC1384.2 +034800 ADD 1 TO S32. NC1384.2 +034900 IF S32 LESS THAN 4 GO TO MOVE-VALUE. NC1384.2 +035000 MOVE 1 TO S32. NC1384.2 +035100 ADD 1 TO S31. NC1384.2 +035200 GO TO MOVE-VALUE. NC1384.2 +035300 SECT-TH109-0002 SECTION. NC1384.2 +035400 SECT-0002-INIT. NC1384.2 +035500 MOVE "LEFT PAREN SEPARATOR" TO FEATURE. NC1384.2 +035600* THIS SECTION TESTS THE USE OF LEFT PARENTHESIS AS A NC1384.2 +035700* SEPARATOR IN REFERENCING TABLE ITEMS. NC1384.2 +035800 SEP-INIT-001. NC1384.2 +035900 MOVE 6 TO S1. NC1384.2 +036000 SEP-TEST-001. NC1384.2 +036100 IF ELEM1(S1) IS EQUAL TO 6 NC1384.2 +036200 PERFORM PASS NC1384.2 +036300 GO TO SEP-WRITE-001. NC1384.2 +036400 PERFORM FAIL. NC1384.2 +036500 GO TO SEP-FAIL-001. NC1384.2 +036600 SEP-DELETE-001. NC1384.2 +036700 PERFORM DE-LETE. NC1384.2 +036800 GO TO SEP-WRITE-001. NC1384.2 +036900 SEP-FAIL-001. NC1384.2 +037000 MOVE ELEM1 (S1) TO COMPUTED-18V0. NC1384.2 +037100 MOVE 6 TO CORRECT-18V0. NC1384.2 +037200 SEP-WRITE-001. NC1384.2 +037300 MOVE "SEP-TEST-001" TO PAR-NAME. NC1384.2 +037400 PERFORM PRINT-DETAIL. NC1384.2 +037500 SEP-INIT-002. NC1384.2 +037600 MOVE 2 TO S21 S22. NC1384.2 +037700 SEP-TEST-002. NC1384.2 +037800 MOVE ELEM2(S21, S22) TO TEMP. NC1384.2 +037900 IF TEMP EQUAL TO 7 NC1384.2 +038000 PERFORM PASS NC1384.2 +038100 GO TO SEP-WRITE-002. NC1384.2 +038200 PERFORM FAIL. NC1384.2 +038300 GO TO SEP-FAIL-002. NC1384.2 +038400 SEP-DELETE-002. NC1384.2 +038500 PERFORM DE-LETE. NC1384.2 +038600 GO TO SEP-WRITE-002. NC1384.2 +038700 SEP-FAIL-002. NC1384.2 +038800 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +038900 MOVE 7 TO CORRECT-18V0. NC1384.2 +039000 SEP-WRITE-002. NC1384.2 +039100 MOVE "SEP-TEST-002" TO PAR-NAME. NC1384.2 +039200 PERFORM PRINT-DETAIL. NC1384.2 +039300 SEP-INIT-003. NC1384.2 +039400 MOVE 3 TO S31 S32 S33. NC1384.2 +039500 SEP-TEST-003. NC1384.2 +039600 MOVE ELEM3(S31, S32, S33) TO TEMP. NC1384.2 +039700 IF TEMP EQUAL TO 43 NC1384.2 +039800 PERFORM PASS NC1384.2 +039900 GO TO SEP-WRITE-003. NC1384.2 +040000 PERFORM FAIL. NC1384.2 +040100 GO TO SEP-FAIL-003. NC1384.2 +040200 SEP-DELETE-003. NC1384.2 +040300 PERFORM DE-LETE. NC1384.2 +040400 GO TO SEP-WRITE-003. NC1384.2 +040500 SEP-FAIL-003. NC1384.2 +040600 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +040700 MOVE 43 TO CORRECT-18V0. NC1384.2 +040800 SEP-WRITE-003. NC1384.2 +040900 MOVE "SEP-TEST-003" TO PAR-NAME. NC1384.2 +041000 PERFORM PRINT-DETAIL. NC1384.2 +041100 SEP-INIT-004. NC1384.2 +041200 MOVE "SPACES AS SEPARATOR" TO FEATURE. NC1384.2 +041300 MOVE "SEP-TEST-004" TO PAR-NAME. NC1384.2 +041400 MOVE 0 TO REC-CT. NC1384.2 +041500 MOVE 19 TO S1. NC1384.2 +041600* THIS TEST USES SPACES AS SEPARATORS IN REFERENCING NC1384.2 +041700* ONE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +041800 MOVE ZERO TO TEMP. NC1384.2 +041900 MOVE 19 TO EXPECTED-VALUE. NC1384.2 +042000 SEP-TEST-004-01. NC1384.2 +042100 MOVE ELEM1 (S1 ) TO TEMP. NC1384.2 +042200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042300 SEP-TEST-004-02. NC1384.2 +042400 MOVE ELEM1 (S1) TO TEMP. NC1384.2 +042500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042600 SEP-TEST-004-03. NC1384.2 +042700 MOVE ELEM1 (S1 ) TO TEMP. NC1384.2 +042800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042900 SEP-TEST-004-04. NC1384.2 +043000 MOVE ELEM1( S1) TO TEMP. NC1384.2 +043100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043200 SEP-TEST-004-05. NC1384.2 +043300 MOVE ELEM1 ( S1) TO TEMP. NC1384.2 +043400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043500 SEP-TEST-004-06. NC1384.2 +043600 MOVE ELEM1 ( S1 ) TO TEMP. NC1384.2 +043700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043800 SEP-TEST-004-07. NC1384.2 +043900 MOVE ELEM1 ( 19) TO TEMP. NC1384.2 +044000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044100 SEP-TEST-004-08. NC1384.2 +044200 MOVE ELEM1(S1 ) TO TEMP. NC1384.2 +044300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044400 SEP-TEST-004-09. NC1384.2 +044500 MOVE ELEM1 ( 19 ) TO TEMP. NC1384.2 +044600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044700 GO TO SEP-INIT-005. NC1384.2 +044800* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +044900* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +045000* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +045100* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +045200* OUTPUT REPORT. NC1384.2 +045300 SEP-DELETE-004. NC1384.2 +045400 PERFORM DE-LETE. NC1384.2 +045500 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +045600 SEP-INIT-005. NC1384.2 +045700 MOVE "SEP-TEST-005" TO PAR-NAME. NC1384.2 +045800 MOVE 0 TO REC-CT. NC1384.2 +045900 MOVE 10 TO S21. NC1384.2 +046000 MOVE 03 TO S22. NC1384.2 +046100 MOVE ZERO TO TEMP. NC1384.2 +046200 MOVE 48 TO EXPECTED-VALUE. NC1384.2 +046300* THIS TEST USES SPACES AND COMMAS AS SEPARATORS IN NC1384.2 +046400* REFERENCING TWO DIMENSIONAL TABLE ELEMENTS. NC1384.2 +046500 SEP-TEST-005-01. NC1384.2 +046600 MOVE ELEM2 (S21 S22) TO TEMP. NC1384.2 +046700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +046800 SEP-TEST-005-02. NC1384.2 +046900 MOVE ELEM2 (S21, S22) TO TEMP. NC1384.2 +047000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047100 SEP-TEST-005-03. NC1384.2 +047200 MOVE ELEM2 (S21, S22) TO TEMP. NC1384.2 +047300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047400 SEP-TEST-005-04. NC1384.2 +047500 ADD ELEM2 ( S21 S22 ) TO TEMP. NC1384.2 +047600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047700 SEP-TEST-005-05. NC1384.2 +047800 MOVE 96 TO TEMP. NC1384.2 +047900 SUBTRACT ELEM2(S21 S22) FROM TEMP. NC1384.2 +048000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048100 SEP-TEST-005-06. NC1384.2 +048200 MOVE ELEM2( S21, S22) TO TEMP. NC1384.2 +048300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048400 SEP-TEST-005-07. NC1384.2 +048500 MOVE ELEM2 ( S21 S22 ) TO TEMP. NC1384.2 +048600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048700 SEP-TEST-005-08. NC1384.2 +048800 MOVE ELEM2 (S21 , S22) TO TEMP. NC1384.2 +048900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049000 SEP-TEST-005-09. NC1384.2 +049100 ADD ELEM2 (3 5) ELEM2(7, 3) TO TEMP. NC1384.2 +049200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049300 SEP-TEST-005-10. NC1384.2 +049400 ADD ELEM2( 3 5 ) ELEM2 ( 7 3 ) TO TEMP. NC1384.2 +049500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049600 GO TO SEP-INIT-006. NC1384.2 +049700* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +049800* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +049900* AN ASTERISK IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +050000* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +050100* OUTPUT REPORT. NC1384.2 +050200 SEP-DELETE-005. NC1384.2 +050300 PERFORM DE-LETE. NC1384.2 +050400 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +050500 SEP-INIT-006. NC1384.2 +050600 MOVE "SEP-TEST-006" TO PAR-NAME. NC1384.2 +050700 MOVE 0 TO REC-CT. NC1384.2 +050800 MOVE ZERO TO TEMP. NC1384.2 +050900 MOVE 3 TO S31. NC1384.2 +051000 MOVE 2 TO S32 S33. NC1384.2 +051100 MOVE 37 TO EXPECTED-VALUE. NC1384.2 +051200* THIS TEST USES SPACES AND COMMAS AS SEPARATORS IN NC1384.2 +051300* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +051400 SEP-TEST-006-01. NC1384.2 +051500 MOVE ELEM3(S31 S32 S33) TO TEMP. NC1384.2 +051600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +051700 SEP-TEST-006-02. NC1384.2 +051800 MOVE ELEM3(S31, S32 S33) TO TEMP. NC1384.2 +051900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052000 SEP-TEST-006-03. NC1384.2 +052100 ADD ELEM3 ( S31 S32 S33 ) TO TEMP. NC1384.2 +052200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052300 SEP-TEST-006-04. NC1384.2 +052400 MOVE 74 TO TEMP. NC1384.2 +052500 SUBTRACT ELEM3(S31 , S32 , S33) FROM TEMP. NC1384.2 +052600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052700 SEP-TEST-006-05. NC1384.2 +052800 MOVE 37 TO TEMP. NC1384.2 +052900 IF ELEM3 ( S31, S32, S33 ) NC1384.2 +053000 NOT EQUAL TO TEMP NC1384.2 +053100 MOVE ZERO TO TEMP. NC1384.2 +053200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +053300 SEP-TEST-006-06. NC1384.2 +053400 MULTIPLY ELEM3 (3 2 2) BY 1 NC1384.2 +053500 GIVING TEMP. NC1384.2 +053600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +053700 SEP-TEST-006-07. NC1384.2 +053800 ADD ELEM3 (1, 1, 1) ELEM3( 3 2 1 ) NC1384.2 +053900 GIVING TEMP. NC1384.2 +054000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +054100 GO TO SEP-INIT-007. NC1384.2 +054200* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +054300* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +054400* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +054500* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +054600* OUTPUT REPORT. NC1384.2 +054700 SEP-DELETE-006. NC1384.2 +054800 PERFORM DE-LETE. NC1384.2 +054900 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +055000 SEP-INIT-007. NC1384.2 +055100 MOVE "SEP-TEST-007" TO PAR-NAME. NC1384.2 +055200 MOVE ZERO TO REC-CT. NC1384.2 +055300 MOVE ZERO TO TEMP. NC1384.2 +055400 MOVE 12 TO EXPECTED-VALUE. NC1384.2 +055500* THIS TEST USES SIGNED POSITIVE INTEGERS AS NC1384.2 +055600* SUBSCRIPTS AND SPACES AND COMMAS AS SEPARATORS. NC1384.2 +055700 SEP-TEST-007-01. NC1384.2 +055800 MOVE ELEM1(+12) TO TEMP. NC1384.2 +055900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056000 SEP-TEST-007-02. NC1384.2 +056100 IF ELEM2(+3 +2) EQUAL TO 12 NC1384.2 +056200 MOVE 12 TO TEMP. NC1384.2 +056300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056400 SEP-TEST-007-03. NC1384.2 +056500 ADD ELEM2 (+3, +2) TO TEMP. NC1384.2 +056600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056700 SEP-TEST-007-04. NC1384.2 +056800 MOVE 24 TO TEMP. NC1384.2 +056900 SUBTRACT ELEM2 ( +3 +2 ) FROM TEMP. NC1384.2 +057000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057100 SEP-TEST-007-05. NC1384.2 +057200 MULTIPLY ELEM3(+1, +3, +2) BY +1 NC1384.2 +057300 GIVING TEMP. NC1384.2 +057400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057500 SEP-TEST-007-06. NC1384.2 +057600 DIVIDE ELEM3(+1 +3 +2) BY 1 NC1384.2 +057700 GIVING TEMP. NC1384.2 +057800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057900 SEP-TEST-007-07. NC1384.2 +058000 MOVE ELEM3 ( +1, +3, +2 ) TO TEMP. NC1384.2 +058100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +058200 GO TO CCVS-EXIT. NC1384.2 +058300* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +058400* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +058500* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +058600* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +058700* OUTPUT REPORT. NC1384.2 +058800 SEP-DELETE-007. NC1384.2 +058900 PERFORM DE-LETE. NC1384.2 +059000 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +059100 GO TO CCVS-EXIT. NC1384.2 +059200 SEP-INIT-008. NC1384.2 +059300 MOVE "IV-4 4.2.1(2)" TO ANSI-REFERENCE. NC1384.2 +059400 MOVE "SEP-TEST-008" TO PAR-NAME. NC1384.2 +059500 MOVE 0 TO REC-CT. NC1384.2 +059600 MOVE ZERO TO TEMP. NC1384.2 +059700 MOVE 3 TO S31. NC1384.2 +059800 MOVE 2 TO S32 S33. NC1384.2 +059900 MOVE 37 TO EXPECTED-VALUE. NC1384.2 +060000* THIS TEST USES SPACES AND COMMAS AND SEMI-COLONS NC1384.2 +060100* AS SEPARATORS IN NC1384.2 +060200* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +060300 SEP-TEST-008-01. NC1384.2 +060400 MOVE ELEM3(S31 S32; S33) TO TEMP. NC1384.2 +060500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +060600 SEP-TEST-008-02. NC1384.2 +060700 MOVE ELEM3(S31, S32; S33) TO TEMP. NC1384.2 +060800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +060900 SEP-TEST-008-03. NC1384.2 +061000 ADD ELEM3 ( S31; S32 S33 ) TO TEMP. NC1384.2 +061100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +061200 SEP-TEST-008-04. NC1384.2 +061300 MOVE 74 TO TEMP. NC1384.2 +061400 SUBTRACT ELEM3(S31; S32 , S33) FROM TEMP. NC1384.2 +061500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +061600 SEP-TEST-008-05. NC1384.2 +061700 MOVE 37 TO TEMP. NC1384.2 +061800 IF ELEM3 ( S31; S32; S33 ) NC1384.2 +061900 NOT EQUAL TO TEMP NC1384.2 +062000 MOVE ZERO TO TEMP. NC1384.2 +062100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +062200 SEP-TEST-008-06. NC1384.2 +062300 MULTIPLY ELEM3 (3; 2, 2) BY 1 NC1384.2 +062400 GIVING TEMP. NC1384.2 +062500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +062600 SEP-TEST-008-07. NC1384.2 +062700 ADD ELEM3 (1; 1, 1) ELEM3( 3 2; 1 ) NC1384.2 +062800 GIVING TEMP. NC1384.2 +062900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +063000 GO TO SEP-INIT-007. NC1384.2 +063100* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +063200* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +063300* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +063400* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +063500* OUTPUT REPORT. NC1384.2 +063600 SEP-DELETE-008. NC1384.2 +063700 PERFORM DE-LETE. NC1384.2 +063800 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +063900 SECT-TH109-0003 SECTION. NC1384.2 +064000 SYNTAX-CHECK. NC1384.2 +064100 ADD 1 TO REC-CT. NC1384.2 +064200 IF TEMP EQUAL TO EXPECTED-VALUE NC1384.2 +064300 PERFORM PASS NC1384.2 +064400 GO TO SYNTAX-CHECK-WRITE. NC1384.2 +064500 SYNTAX-FAIL. NC1384.2 +064600 PERFORM FAIL. NC1384.2 +064700 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +064800 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC1384.2 +064900 SYNTAX-CHECK-WRITE. NC1384.2 +065000 PERFORM PRINT-DETAIL. NC1384.2 +065100 MOVE ZERO TO TEMP. NC1384.2 +065200 CCVS-EXIT SECTION. NC1384.2 +065300 CCVS-999999. NC1384.2 +065400 GO TO CLOSE-FILES. NC1384.2 +*END-OF,NC138A +*HEADER,COBOL,NC139A +000100 IDENTIFICATION DIVISION. NC1394.2 +000200 PROGRAM-ID. NC1394.2 +000300 NC139A. NC1394.2 +000400**************************************************************** NC1394.2 +000500* * NC1394.2 +000600* VALIDATION FOR:- * NC1394.2 +000700* * NC1394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +000900* * NC1394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1394.2 +001100* * NC1394.2 +001200**************************************************************** NC1394.2 +001300* * NC1394.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1394.2 +001500* * NC1394.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1394.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1394.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1394.2 +001900* * NC1394.2 +002000**************************************************************** NC1394.2 +002100* NC1394.2 +002200* PROGRAM NC139A TESTS THE USE OF NUMERIC LITERALS WITH NC1394.2 +002300* RELATIVE INDEXING WHEN ACCESSING 2 AND 3 DIMENSIONAL NC1394.2 +002400* TABLES. NC1394.2 +002500* THE USE OF INDEXES AND SUBSCRIPTS TOGETHER IS ALSO TESTED. NC1394.2 +002600* NC1394.2 +002700 ENVIRONMENT DIVISION. NC1394.2 +002800 CONFIGURATION SECTION. NC1394.2 +002900 SOURCE-COMPUTER. NC1394.2 +003000 XXXXX082. NC1394.2 +003100 OBJECT-COMPUTER. NC1394.2 +003200 XXXXX083. NC1394.2 +003300 INPUT-OUTPUT SECTION. NC1394.2 +003400 FILE-CONTROL. NC1394.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1394.2 +003600 XXXXX055. NC1394.2 +003700 DATA DIVISION. NC1394.2 +003800 FILE SECTION. NC1394.2 +003900 FD PRINT-FILE. NC1394.2 +004000 01 PRINT-REC PICTURE X(120). NC1394.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1394.2 +004200 WORKING-STORAGE SECTION. NC1394.2 +004300* LITERALS AND INDEX-NAMES MAY BE MIXED IN A TABLE NC1394.2 +004400* REFERENCE. THE LITERALS MAY BE SIGNED BUT MUST BE POSITIVE. NC1394.2 +004500* RELATIVE INDEXING WITH BOTH POSITIVE AND NEGATIVE INTEGERS NC1394.2 +004600* IS PERMITTED. NC1394.2 +004700 01 WS-2 PIC 9. NC1394.2 +004800 01 WS-PLUS-2 PIC S9. NC1394.2 +004900 01 WS-4 PIC 9. NC1394.2 +005000 01 WS-PLUS-4 PIC S9. NC1394.2 +005100 77 TEMP PIC XXX. NC1394.2 +005200 77 EXPECTED-VALUE PIC XXX. NC1394.2 +005300* TWO DIMENSIONAL TABLE, 6X4, WITH INDEXES. NC1394.2 +005400 01 GRP-TAB1. NC1394.2 +005500 02 GRP-1 OCCURS 6 TIMES NC1394.2 +005600 INDEXED BY IN1. NC1394.2 +005700 03 ELEM1 PIC XXX NC1394.2 +005800 OCCURS 4 TIMES NC1394.2 +005900 INDEXED BY IN2. NC1394.2 +006000* THREE DIMENSIONAL TABLE, 3X2X4, WITH INDEXES. NC1394.2 +006100 01 GRP-TAB2. NC1394.2 +006200 02 GRP-2 OCCURS 3 TIMES NC1394.2 +006300 INDEXED BY INDEX1. NC1394.2 +006400 03 GRP-3 OCCURS 2 TIMES NC1394.2 +006500 INDEXED BY INDEX2. NC1394.2 +006600 04 ELEM2 PIC XXX NC1394.2 +006700 OCCURS 4 TIMES NC1394.2 +006800 INDEXED BY INDEX3. NC1394.2 +006900 01 TABLE-VALUES. NC1394.2 +007000 02 VALUES-1 PIC X(12) NC1394.2 +007100 VALUE "AAABBBCCCDDD". NC1394.2 +007200 02 VALUES-2 PIC X(12) NC1394.2 +007300 VALUE "EEEFFFGGGHHH". NC1394.2 +007400 02 VALUES-3 PIC X(12) NC1394.2 +007500 VALUE "IIIJJJKKKLLL". NC1394.2 +007600 02 VALUES-4 PIC X(12) NC1394.2 +007700 VALUE "MMMNNNOOOPPP". NC1394.2 +007800 02 VALUES-5 PIC X(12) NC1394.2 +007900 VALUE "QQQRRRSSSTTT". NC1394.2 +008000 02 VALUES-6 PIC X(12) NC1394.2 +008100 VALUE "UUUVVVWWWXXX". NC1394.2 +008200 01 TEST-RESULTS. NC1394.2 +008300 02 FILLER PIC X VALUE SPACE. NC1394.2 +008400 02 FEATURE PIC X(20) VALUE SPACE. NC1394.2 +008500 02 FILLER PIC X VALUE SPACE. NC1394.2 +008600 02 P-OR-F PIC X(5) VALUE SPACE. NC1394.2 +008700 02 FILLER PIC X VALUE SPACE. NC1394.2 +008800 02 PAR-NAME. NC1394.2 +008900 03 FILLER PIC X(19) VALUE SPACE. NC1394.2 +009000 03 PARDOT-X PIC X VALUE SPACE. NC1394.2 +009100 03 DOTVALUE PIC 99 VALUE ZERO. NC1394.2 +009200 02 FILLER PIC X(8) VALUE SPACE. NC1394.2 +009300 02 RE-MARK PIC X(61). NC1394.2 +009400 01 TEST-COMPUTED. NC1394.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC1394.2 +009600 02 FILLER PIC X(17) VALUE NC1394.2 +009700 " COMPUTED=". NC1394.2 +009800 02 COMPUTED-X. NC1394.2 +009900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1394.2 +010000 03 COMPUTED-N REDEFINES COMPUTED-A NC1394.2 +010100 PIC -9(9).9(9). NC1394.2 +010200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1394.2 +010300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1394.2 +010400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1394.2 +010500 03 CM-18V0 REDEFINES COMPUTED-A. NC1394.2 +010600 04 COMPUTED-18V0 PIC -9(18). NC1394.2 +010700 04 FILLER PIC X. NC1394.2 +010800 03 FILLER PIC X(50) VALUE SPACE. NC1394.2 +010900 01 TEST-CORRECT. NC1394.2 +011000 02 FILLER PIC X(30) VALUE SPACE. NC1394.2 +011100 02 FILLER PIC X(17) VALUE " CORRECT =". NC1394.2 +011200 02 CORRECT-X. NC1394.2 +011300 03 CORRECT-A PIC X(20) VALUE SPACE. NC1394.2 +011400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1394.2 +011500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1394.2 +011600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1394.2 +011700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1394.2 +011800 03 CR-18V0 REDEFINES CORRECT-A. NC1394.2 +011900 04 CORRECT-18V0 PIC -9(18). NC1394.2 +012000 04 FILLER PIC X. NC1394.2 +012100 03 FILLER PIC X(2) VALUE SPACE. NC1394.2 +012200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1394.2 +012300 01 CCVS-C-1. NC1394.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1394.2 +012500- "SS PARAGRAPH-NAME NC1394.2 +012600- " REMARKS". NC1394.2 +012700 02 FILLER PIC X(20) VALUE SPACE. NC1394.2 +012800 01 CCVS-C-2. NC1394.2 +012900 02 FILLER PIC X VALUE SPACE. NC1394.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". NC1394.2 +013100 02 FILLER PIC X(15) VALUE SPACE. NC1394.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". NC1394.2 +013300 02 FILLER PIC X(94) VALUE SPACE. NC1394.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1394.2 +013500 01 REC-CT PIC 99 VALUE ZERO. NC1394.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1394.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1394.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1394.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1394.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1394.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1394.2 +014500 01 CCVS-H-1. NC1394.2 +014600 02 FILLER PIC X(39) VALUE SPACES. NC1394.2 +014700 02 FILLER PIC X(42) VALUE NC1394.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1394.2 +014900 02 FILLER PIC X(39) VALUE SPACES. NC1394.2 +015000 01 CCVS-H-2A. NC1394.2 +015100 02 FILLER PIC X(40) VALUE SPACE. NC1394.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1394.2 +015300 02 FILLER PIC XXXX VALUE NC1394.2 +015400 "4.2 ". NC1394.2 +015500 02 FILLER PIC X(28) VALUE NC1394.2 +015600 " COPY - NOT FOR DISTRIBUTION". NC1394.2 +015700 02 FILLER PIC X(41) VALUE SPACE. NC1394.2 +015800 NC1394.2 +015900 01 CCVS-H-2B. NC1394.2 +016000 02 FILLER PIC X(15) VALUE NC1394.2 +016100 "TEST RESULT OF ". NC1394.2 +016200 02 TEST-ID PIC X(9). NC1394.2 +016300 02 FILLER PIC X(4) VALUE NC1394.2 +016400 " IN ". NC1394.2 +016500 02 FILLER PIC X(12) VALUE NC1394.2 +016600 " HIGH ". NC1394.2 +016700 02 FILLER PIC X(22) VALUE NC1394.2 +016800 " LEVEL VALIDATION FOR ". NC1394.2 +016900 02 FILLER PIC X(58) VALUE NC1394.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +017100 01 CCVS-H-3. NC1394.2 +017200 02 FILLER PIC X(34) VALUE NC1394.2 +017300 " FOR OFFICIAL USE ONLY ". NC1394.2 +017400 02 FILLER PIC X(58) VALUE NC1394.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1394.2 +017600 02 FILLER PIC X(28) VALUE NC1394.2 +017700 " COPYRIGHT 1985 ". NC1394.2 +017800 01 CCVS-E-1. NC1394.2 +017900 02 FILLER PIC X(52) VALUE SPACE. NC1394.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1394.2 +018100 02 ID-AGAIN PIC X(9). NC1394.2 +018200 02 FILLER PIC X(45) VALUE SPACES. NC1394.2 +018300 01 CCVS-E-2. NC1394.2 +018400 02 FILLER PIC X(31) VALUE SPACE. NC1394.2 +018500 02 FILLER PIC X(21) VALUE SPACE. NC1394.2 +018600 02 CCVS-E-2-2. NC1394.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1394.2 +018800 03 FILLER PIC X VALUE SPACE. NC1394.2 +018900 03 ENDER-DESC PIC X(44) VALUE NC1394.2 +019000 "ERRORS ENCOUNTERED". NC1394.2 +019100 01 CCVS-E-3. NC1394.2 +019200 02 FILLER PIC X(22) VALUE NC1394.2 +019300 " FOR OFFICIAL USE ONLY". NC1394.2 +019400 02 FILLER PIC X(12) VALUE SPACE. NC1394.2 +019500 02 FILLER PIC X(58) VALUE NC1394.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +019700 02 FILLER PIC X(13) VALUE SPACE. NC1394.2 +019800 02 FILLER PIC X(15) VALUE NC1394.2 +019900 " COPYRIGHT 1985". NC1394.2 +020000 01 CCVS-E-4. NC1394.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1394.2 +020200 02 FILLER PIC X(4) VALUE " OF ". NC1394.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1394.2 +020400 02 FILLER PIC X(40) VALUE NC1394.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". NC1394.2 +020600 01 XXINFO. NC1394.2 +020700 02 FILLER PIC X(19) VALUE NC1394.2 +020800 "*** INFORMATION ***". NC1394.2 +020900 02 INFO-TEXT. NC1394.2 +021000 04 FILLER PIC X(8) VALUE SPACE. NC1394.2 +021100 04 XXCOMPUTED PIC X(20). NC1394.2 +021200 04 FILLER PIC X(5) VALUE SPACE. NC1394.2 +021300 04 XXCORRECT PIC X(20). NC1394.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). NC1394.2 +021500 01 HYPHEN-LINE. NC1394.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. NC1394.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************NC1394.2 +021800- "*****************************************". NC1394.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************NC1394.2 +022000- "******************************". NC1394.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE NC1394.2 +022200 "NC139A". NC1394.2 +022300 PROCEDURE DIVISION. NC1394.2 +022400 CCVS1 SECTION. NC1394.2 +022500 OPEN-FILES. NC1394.2 +022600 OPEN OUTPUT PRINT-FILE. NC1394.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1394.2 +022800 MOVE SPACE TO TEST-RESULTS. NC1394.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1394.2 +023000 GO TO CCVS1-EXIT. NC1394.2 +023100 CLOSE-FILES. NC1394.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1394.2 +023300 TERMINATE-CCVS. NC1394.2 +023400S EXIT PROGRAM. NC1394.2 +023500STERMINATE-CALL. NC1394.2 +023600 STOP RUN. NC1394.2 +023700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1394.2 +023800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1394.2 +023900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1394.2 +024000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1394.2 +024100 MOVE "****TEST DELETED****" TO RE-MARK. NC1394.2 +024200 PRINT-DETAIL. NC1394.2 +024300 IF REC-CT NOT EQUAL TO ZERO NC1394.2 +024400 MOVE "." TO PARDOT-X NC1394.2 +024500 MOVE REC-CT TO DOTVALUE. NC1394.2 +024600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1394.2 +024700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1394.2 +024800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1394.2 +024900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1394.2 +025000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1394.2 +025100 MOVE SPACE TO CORRECT-X. NC1394.2 +025200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1394.2 +025300 MOVE SPACE TO RE-MARK. NC1394.2 +025400 HEAD-ROUTINE. NC1394.2 +025500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +025600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +025700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1394.2 +025800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1394.2 +025900 COLUMN-NAMES-ROUTINE. NC1394.2 +026000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +026100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +026300 END-ROUTINE. NC1394.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1394.2 +026500 END-RTN-EXIT. NC1394.2 +026600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +026700 END-ROUTINE-1. NC1394.2 +026800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1394.2 +026900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1394.2 +027000 ADD PASS-COUNTER TO ERROR-HOLD. NC1394.2 +027100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1394.2 +027200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1394.2 +027300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1394.2 +027400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1394.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1394.2 +027600 END-ROUTINE-12. NC1394.2 +027700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1394.2 +027800 IF ERROR-COUNTER IS EQUAL TO ZERO NC1394.2 +027900 MOVE "NO " TO ERROR-TOTAL NC1394.2 +028000 ELSE NC1394.2 +028100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1394.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1394.2 +028300 PERFORM WRITE-LINE. NC1394.2 +028400 END-ROUTINE-13. NC1394.2 +028500 IF DELETE-COUNTER IS EQUAL TO ZERO NC1394.2 +028600 MOVE "NO " TO ERROR-TOTAL ELSE NC1394.2 +028700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1394.2 +028800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1394.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029000 IF INSPECT-COUNTER EQUAL TO ZERO NC1394.2 +029100 MOVE "NO " TO ERROR-TOTAL NC1394.2 +029200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1394.2 +029300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1394.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029600 WRITE-LINE. NC1394.2 +029700 ADD 1 TO RECORD-COUNT. NC1394.2 +029800Y IF RECORD-COUNT GREATER 42 NC1394.2 +029900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1394.2 +030000Y MOVE SPACE TO DUMMY-RECORD NC1394.2 +030100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1394.2 +030200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1394.2 +030300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1394.2 +030400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1394.2 +030500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1394.2 +030600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1394.2 +031000Y MOVE ZERO TO RECORD-COUNT. NC1394.2 +031100 PERFORM WRT-LN. NC1394.2 +031200 WRT-LN. NC1394.2 +031300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1394.2 +031400 MOVE SPACE TO DUMMY-RECORD. NC1394.2 +031500 BLANK-LINE-PRINT. NC1394.2 +031600 PERFORM WRT-LN. NC1394.2 +031700 FAIL-ROUTINE. NC1394.2 +031800 IF COMPUTED-X NOT EQUAL TO SPACE NC1394.2 +031900 GO TO FAIL-ROUTINE-WRITE. NC1394.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1394.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1394.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1394.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1394.2 +032500 GO TO FAIL-ROUTINE-EX. NC1394.2 +032600 FAIL-ROUTINE-WRITE. NC1394.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1394.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1394.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1394.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC1394.2 +033100 FAIL-ROUTINE-EX. EXIT. NC1394.2 +033200 BAIL-OUT. NC1394.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1394.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1394.2 +033500 BAIL-OUT-WRITE. NC1394.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1394.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1394.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1394.2 +034000 BAIL-OUT-EX. EXIT. NC1394.2 +034100 CCVS1-EXIT. NC1394.2 +034200 EXIT. NC1394.2 +034300********************************* NC1394.2 +034400* STATEMENT DELETION INSTRUCTIONS NC1394.2 +034500* IF THE COMPILER REJECTS ANY OF THE TABLE REFERENCES IN NC1394.2 +034600* THIS ROUTINE, DELETE THAT LINE OF CODE BY PLACING AN * IN NC1394.2 +034700* COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. THE TEST NC1394.2 +034800* ELEMENT DELETED APPEARS AS A FAILURE ON THE OUTPUT REPORT. NC1394.2 +034900***************************************** NC1394.2 +035000 SECT-NC139A-001 SECTION. NC1394.2 +035100 NC139A-001. NC1394.2 +035200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1394.2 +035300* THIS SECTION STORES AAA THRU XXX IN THE TWO TABLES NC1394.2 +035400* REFERENCED IN THE TESTS. NC1394.2 +035500 BUILD-TABLE. NC1394.2 +035600 SET IN1 TO 1. NC1394.2 +035700 MOVE VALUES-1 TO GRP-1 (IN1). NC1394.2 +035800 MOVE VALUES-2 TO GRP-1 (IN1 + 1). NC1394.2 +035900 MOVE VALUES-3 TO GRP-1 (IN1 + 2). NC1394.2 +036000 MOVE VALUES-4 TO GRP-1 (IN1 + 3). NC1394.2 +036100 MOVE VALUES-5 TO GRP-1 (IN1 + 4). NC1394.2 +036200 MOVE VALUES-6 TO GRP-1 (IN1 + 5). NC1394.2 +036300 MOVE GRP-TAB1 TO GRP-TAB2. NC1394.2 +036400 SECT-TH110-0002 SECTION. NC1394.2 +036500* THIS SECTION CONTAINS THE TESTS WHICH VALIDATE NC1394.2 +036600* THE HANDLING OF LITERALS MIXED WITH INDEX-NAMES NC1394.2 +036700* IN REFERENCING TWO AND THREE DIMENSIONAL TABLES. NC1394.2 +036800 IND-INIT-001. NC1394.2 +036900* THIS TEST MIXES UNSIGNED LITERALS WITH INDEX-NAMES. NC1394.2 +037000 SET IN1 IN2 TO 1. NC1394.2 +037100 SET INDEX1 INDEX2 INDEX3 TO 1. NC1394.2 +037200 MOVE "AAA" TO EXPECTED-VALUE. NC1394.2 +037300 MOVE SPACE TO TEMP. NC1394.2 +037400 MOVE ZERO TO REC-CT. NC1394.2 +037500 MOVE "IND-TEST-001" TO PAR-NAME. NC1394.2 +037600 MOVE "INDEXES AND LITERALS" TO FEATURE. NC1394.2 +037700 IND-TEST-001-01. NC1394.2 +037800 MOVE ELEM1 (IN1, 1) TO TEMP. NC1394.2 +037900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038000 IND-TEST-001-02. NC1394.2 +038100 MOVE ELEM1(1 IN2) TO TEMP. NC1394.2 +038200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038300 IND-TEST-001-03. NC1394.2 +038400 MOVE ELEM1(1, IN2) TO TEMP. NC1394.2 +038500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038600 IND-TEST-001-04. NC1394.2 +038700 MOVE ELEM2 (1 INDEX2 1) TO TEMP. NC1394.2 +038800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038900 IND-TEST-001-05. NC1394.2 +039000 MOVE ELEM2(INDEX1 INDEX2 1) TO TEMP. NC1394.2 +039100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039200 IND-TEST-001-06. NC1394.2 +039300 MOVE ELEM2 (INDEX1, 1 INDEX3) TO TEMP. NC1394.2 +039400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039500 IND-TEST-001-07. NC1394.2 +039600 MOVE ELEM2 (1 1 INDEX3) TO TEMP. NC1394.2 +039700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039800 GO TO IND-INIT-002. NC1394.2 +039900 IND-DELETE-001. NC1394.2 +040000 PERFORM DE-LETE. NC1394.2 +040100 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +040200 IND-INIT-002. NC1394.2 +040300* THIS TEST MIXES SIGNED LITERALS WITH INDEX-NAMES. NC1394.2 +040400 MOVE ZERO TO REC-CT. NC1394.2 +040500 MOVE SPACE TO TEMP. NC1394.2 +040600 MOVE "GGG" TO EXPECTED-VALUE. NC1394.2 +040700 MOVE "IND-TEST-002" TO PAR-NAME. NC1394.2 +040800 SET INDEX1 TO 1. NC1394.2 +040900 SET IN1 INDEX2 TO 2. NC1394.2 +041000 SET IN2 INDEX3 TO 3. NC1394.2 +041100 IND-TEST-002-01. NC1394.2 +041200 MOVE ELEM1(IN1, +3) TO TEMP. NC1394.2 +041300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +041400 IND-TEST-002-02. NC1394.2 +041500 MOVE ELEM1(+2, IN2) TO TEMP. NC1394.2 +041600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +041700 IND-TEST-002-03. NC1394.2 +041800 IF ELEM1 (+2 IN2) EQUAL TO "GGG" NC1394.2 +041900 MOVE "GGG" TO TEMP. NC1394.2 +042000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042100 IND-TEST-002-04. NC1394.2 +042200 IF ELEM1 (IN1 +3) IS EQUAL TO EXPECTED-VALUE NC1394.2 +042300 MOVE "GGG" TO TEMP. NC1394.2 +042400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042500 IND-TEST-002-05. NC1394.2 +042600 MOVE ELEM2(+1, INDEX2, +3) TO TEMP. NC1394.2 +042700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042800 IND-TEST-002-06. NC1394.2 +042900 MOVE ELEM2(+1 INDEX2 +3) TO TEMP. NC1394.2 +043000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043100 IND-TEST-002-07. NC1394.2 +043200 MOVE ELEM2 (INDEX1 +2, +3) TO TEMP. NC1394.2 +043300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043400 IND-TEST-002-08. NC1394.2 +043500 MOVE ELEM2 (INDEX1 INDEX2 +3) TO TEMP. NC1394.2 +043600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043700 GO TO IND-INIT-003. NC1394.2 +043800 IND-DELETE-002. NC1394.2 +043900 PERFORM DE-LETE. NC1394.2 +044000 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +044100 IND-INIT-003. NC1394.2 +044200* THIS TEST MIXES UNSIGNED LITERALS WITH RELATIVE INDEXING. NC1394.2 +044300 MOVE ZERO TO REC-CT. NC1394.2 +044400 MOVE SPACE TO TEMP. NC1394.2 +044500 MOVE "SSS" TO EXPECTED-VALUE. NC1394.2 +044600 MOVE "IND-TEST-003" TO PAR-NAME. NC1394.2 +044700 SET IN1 TO 6. NC1394.2 +044800 SET INDEX3 TO 4. NC1394.2 +044900 SET INDEX2 TO 1. NC1394.2 +045000 SET IN2 INDEX1 TO 2. NC1394.2 +045100 IND-TEST-003-01. NC1394.2 +045200 MOVE ELEM1(IN1 - 1, 3) TO TEMP. NC1394.2 +045300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +045400 IND-TEST-003-02. NC1394.2 +045500 MOVE ELEM1 ( 5, IN2 + 1) TO TEMP. NC1394.2 +045600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +045700 IND-TEST-003-03. NC1394.2 +045800 MOVE ELEM1(IN1 - 1 3) TO TEMP. NC1394.2 +045900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046000 IND-TEST-003-04. NC1394.2 +046100 MOVE ELEM1 (5 IN2 + 1) TO TEMP. NC1394.2 +046200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046300 IND-TEST-003-05. NC1394.2 +046400 MOVE ELEM2 (3, INDEX2, INDEX3 - 1) TO TEMP. NC1394.2 +046500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046600 IND-TEST-003-06. NC1394.2 +046700 MOVE ELEM2 (3 INDEX2 INDEX3 - 1) TO TEMP. NC1394.2 +046800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046900 IND-TEST-003-07. NC1394.2 +047000 MOVE ELEM2(INDEX1 + 1, 1, 3) TO TEMP. NC1394.2 +047100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047200 IND-TEST-003-08. NC1394.2 +047300 IF ELEM2(INDEX1 + 1 1 3) IS EQUAL TO "SSS" NC1394.2 +047400 MOVE "SSS" TO TEMP. NC1394.2 +047500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047600 IND-TEST-003-09. NC1394.2 +047700 MOVE ELEM2 (INDEX1 + 1 INDEX2 3) TO TEMP. NC1394.2 +047800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047900 IND-TEST-003-10. NC1394.2 +048000 MOVE ELEM2 (3 1 INDEX3 - 1) TO TEMP. NC1394.2 +048100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +048200 IND-TEST-003-11. NC1394.2 +048300 MOVE ELEM2(INDEX1 + 1 1 INDEX3 - 1) TO TEMP. NC1394.2 +048400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +048500 GO TO IND-INIT-004. NC1394.2 +048600 IND-DELETE-003. NC1394.2 +048700 PERFORM DE-LETE. NC1394.2 +048800 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +048900 IND-INIT-004. NC1394.2 +049000* THIS TEST MIXES SIGNED LITERALS WITH RELATIVE INDEXING. NC1394.2 +049100 MOVE ZERO TO REC-CT. NC1394.2 +049200 MOVE SPACE TO TEMP. NC1394.2 +049300 MOVE "VVV" TO EXPECTED-VALUE. NC1394.2 +049400 MOVE "IND-TEST-004" TO PAR-NAME. NC1394.2 +049500 SET IN1 TO 2. NC1394.2 +049600 SET IN2 TO 4. NC1394.2 +049700 SET INDEX1 TO 2. NC1394.2 +049800 SET INDEX2 TO 1. NC1394.2 +049900 SET INDEX3 TO 4. NC1394.2 +050000 IND-TEST-004-01. NC1394.2 +050100 MOVE ELEM1(IN1 + 4, +2) TO TEMP. NC1394.2 +050200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050300 IND-TEST-004-02. NC1394.2 +050400 MOVE ELEM1 (IN1 + 4 +2) TO TEMP. NC1394.2 +050500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050600 IND-TEST-004-03. NC1394.2 +050700 MOVE ELEM1 (+6, IN2 - 2) TO TEMP. NC1394.2 +050800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050900 IND-TEST-004-04. NC1394.2 +051000 IF ELEM1(+6 IN2 - 2) IS EQUAL TO "VVV" NC1394.2 +051100 MOVE "VVV" TO TEMP. NC1394.2 +051200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +051300 IND-TEST-004-05. NC1394.2 +051400 IF ELEM2 (INDEX1 + 1, +2, INDEX3 - 2) NC1394.2 +051500 IS EQUAL TO EXPECTED-VALUE NC1394.2 +051600 MOVE "VVV" TO TEMP. NC1394.2 +051700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +051800 IND-TEST-004-06. NC1394.2 +051900 MOVE ELEM2(INDEX1 + 1 +2 INDEX3 - 2) TO TEMP. NC1394.2 +052000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052100 IND-TEST-004-07. NC1394.2 +052200 MOVE ELEM2 (+3 +2 INDEX3 - 2) TO TEMP. NC1394.2 +052300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052400 IND-TEST-004-08. NC1394.2 +052500 MOVE ELEM2 (INDEX1 + 1 +2 +2) TO TEMP. NC1394.2 +052600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052700 IND-TEST-004-09. NC1394.2 +052800 MOVE ELEM2(INDEX1 + 1, INDEX2 + 1, +2) TO TEMP. NC1394.2 +052900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +053000 IND-TEST-004-10. NC1394.2 +053100 MOVE ELEM2 (+3 INDEX2 + 1 +2) TO TEMP. NC1394.2 +053200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +053300 GO TO IND-INIT-005. NC1394.2 +053400 IND-DELETE-004. NC1394.2 +053500 PERFORM DE-LETE. NC1394.2 +053600 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +053700 IND-INIT-005. NC1394.2 +053800* THIS TEST MIXES SIGNED AND UNSIGNED LITERALS NC1394.2 +053900* WITH RELATIVE INDEXING. NC1394.2 +054000 MOVE ZERO TO REC-CT. NC1394.2 +054100 MOVE SPACE TO TEMP. NC1394.2 +054200 MOVE "PPP" TO EXPECTED-VALUE. NC1394.2 +054300 MOVE "IND-TEST-005" TO PAR-NAME. NC1394.2 +054400 SET INDEX1 TO 3. NC1394.2 +054500 SET INDEX2 TO 1. NC1394.2 +054600 SET INDEX3 TO 2. NC1394.2 +054700 IND-TEST-005-01. NC1394.2 +054800 MOVE ELEM2 (+2, INDEX2 + 1, 4) TO TEMP. NC1394.2 +054900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055000 IND-TEST-005-02. NC1394.2 +055100 MOVE ELEM2(+2 INDEX2 + 1 4) TO TEMP. NC1394.2 +055200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055300 IND-TEST-005-03. NC1394.2 +055400 MOVE ELEM2 (2 +2 INDEX3 + 2) TO TEMP. NC1394.2 +055500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055600 IND-TEST-005-04. NC1394.2 +055700 IF ELEM2 (INDEX1 - 1, 2 +4) IS EQUAL TO EXPECTED-VALUE NC1394.2 +055800 MOVE "PPP" TO TEMP. NC1394.2 +055900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +056000 IND-TEST-005-05. NC1394.2 +056100 MOVE ELEM2(+2 2 INDEX3 + 2) TO TEMP. NC1394.2 +056200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +056300 GO TO CCVS-EXIT. NC1394.2 +056400 IND-DELETE-005. NC1394.2 +056500 PERFORM DE-LETE. NC1394.2 +056600 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +056700 IND-INIT-006. NC1394.2 +056800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1394.2 +056900* THIS TEST MIXES DATA-NAMES WITH RELATIVE INDEXING. NC1394.2 +057000 MOVE ZERO TO REC-CT. NC1394.2 +057100 MOVE SPACE TO TEMP. NC1394.2 +057200 MOVE "PPP" TO EXPECTED-VALUE. NC1394.2 +057300 MOVE "IND-TEST-006" TO PAR-NAME. NC1394.2 +057400 SET INDEX1 TO 3. NC1394.2 +057500 SET INDEX2 TO 1. NC1394.2 +057600 SET INDEX3 TO 2. NC1394.2 +057700 MOVE 2 TO WS-2. NC1394.2 +057800 MOVE +2 TO WS-PLUS-2. NC1394.2 +057900 MOVE 4 TO WS-4. NC1394.2 +058000 MOVE +4 TO WS-PLUS-4. NC1394.2 +058100 IND-TEST-006-01. NC1394.2 +058200 MOVE ELEM2 (WS-PLUS-2, INDEX2 + 1, WS-4) TO TEMP. NC1394.2 +058300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +058400 IND-TEST-006-02. NC1394.2 +058500 MOVE ELEM2(WS-PLUS-2 INDEX2 + 1 WS-4) TO TEMP. NC1394.2 +058600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +058700 IND-TEST-006-03. NC1394.2 +058800 MOVE ELEM2 ( WS-2 WS-PLUS-2 INDEX3 + 2) TO TEMP. NC1394.2 +058900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059000 IND-TEST-006-04. NC1394.2 +059100 IF ELEM2 (INDEX1 - 1, WS-2 WS-PLUS-4) = EXPECTED-VALUE NC1394.2 +059200 MOVE "PPP" TO TEMP. NC1394.2 +059300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059400 IND-TEST-006-05. NC1394.2 +059500 MOVE ELEM2(WS-PLUS-2 WS-2 INDEX3 + 2) TO TEMP. NC1394.2 +059600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059700 GO TO CCVS-EXIT. NC1394.2 +059800 IND-DELETE-006. NC1394.2 +059900 PERFORM DE-LETE. NC1394.2 +060000 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +060100 GO TO CCVS-EXIT. NC1394.2 +060200 SECT-TH110-0003 SECTION. NC1394.2 +060300 SYNTAX-CHECK. NC1394.2 +060400 ADD 1 TO REC-CT. NC1394.2 +060500 IF TEMP IS EQUAL TO EXPECTED-VALUE NC1394.2 +060600 PERFORM PASS NC1394.2 +060700 GO TO SYNTAX-CHECK-WRITE. NC1394.2 +060800 SYNTAX-FAIL. NC1394.2 +060900 PERFORM FAIL. NC1394.2 +061000 MOVE TEMP TO COMPUTED-A. NC1394.2 +061100 MOVE EXPECTED-VALUE TO CORRECT-A. NC1394.2 +061200 SYNTAX-CHECK-WRITE. NC1394.2 +061300 PERFORM PRINT-DETAIL. NC1394.2 +061400 MOVE SPACE TO TEMP. NC1394.2 +061500 CCVS-EXIT SECTION. NC1394.2 +061600 CCVS-999999. NC1394.2 +061700 GO TO CLOSE-FILES. NC1394.2 +*END-OF,NC139A +*HEADER,COBOL,NC140A +000100 IDENTIFICATION DIVISION. NC1404.2 +000200 PROGRAM-ID. NC1404.2 +000300 NC140A. NC1404.2 +000400**************************************************************** NC1404.2 +000500* * NC1404.2 +000600* VALIDATION FOR:- * NC1404.2 +000700* * NC1404.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +000900* * NC1404.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1404.2 +001100* * NC1404.2 +001200**************************************************************** NC1404.2 +001300* * NC1404.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1404.2 +001500* * NC1404.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1404.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1404.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1404.2 +001900* * NC1404.2 +002000**************************************************************** NC1404.2 +002100* NC1404.2 +002200* PROGRAM NC140A TESTS FORMAT 2 OF THE "SET" STATEMENT NC1404.2 +002300* USING A VARIETY OF DATA-NAMES CONTAINING POSITIVE AND NC1404.2 +002400* NEGATIVE VALUES, AS WELL AS POSITIVE AND NEGATIVE INTEGERS. NC1404.2 +002500* NC1404.2 +002600**************************************************************** NC1404.2 +002700 ENVIRONMENT DIVISION. NC1404.2 +002800 CONFIGURATION SECTION. NC1404.2 +002900 SOURCE-COMPUTER. NC1404.2 +003000 XXXXX082. NC1404.2 +003100 OBJECT-COMPUTER. NC1404.2 +003200 XXXXX083. NC1404.2 +003300 INPUT-OUTPUT SECTION. NC1404.2 +003400 FILE-CONTROL. NC1404.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1404.2 +003600 XXXXX055. NC1404.2 +003700 DATA DIVISION. NC1404.2 +003800 FILE SECTION. NC1404.2 +003900 FD PRINT-FILE. NC1404.2 +004000 01 PRINT-REC PICTURE X(120). NC1404.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1404.2 +004200 WORKING-STORAGE SECTION. NC1404.2 +004300 01 GRP-TABLE1. NC1404.2 +004400 02 ELEM1 PIC S999 OCCURS 100 TIMES NC1404.2 +004500 INDEXED BY INDEX1. NC1404.2 +004600* TWO DIMENSIONAL TABLE. NC1404.2 +004700 01 GRP-TABLE2. NC1404.2 +004800 02 GROUP1 OCCURS 10 TIMES NC1404.2 +004900 INDEXED BY IN1. NC1404.2 +005000 03 ELEM2 PIC S9999 NC1404.2 +005100 USAGE IS COMPUTATIONAL NC1404.2 +005200 OCCURS 10 TIMES NC1404.2 +005300 INDEXED BY IN2. NC1404.2 +005400* SUBSCRIPTS FOR TABLE REFERENCES. NC1404.2 +005500 01 GRP-SUB. NC1404.2 +005600 02 S1 PIC S999 VALUE 1. NC1404.2 +005700 02 S21 PIC S999 VALUE 1. NC1404.2 +005800 02 S22 PIC S999 VALUE 1. NC1404.2 +005900* DATA ITEMS USED IN SET STATEMENTS, FORMAT 2. NC1404.2 +006000 77 CS-3 PICTURE S999 COMPUTATIONAL VALUE ZERO. NC1404.2 +006100 77 CU-3 PICTURE 999 COMPUTATIONAL VALUE ZERO. NC1404.2 +006200 77 DS-3 PICTURE S999 DISPLAY VALUE ZERO. NC1404.2 +006300 77 DU-3 PICTURE 999 DISPLAY VALUE ZERO. NC1404.2 +006400 77 DS-LS-3 PICTURE S999 SIGN IS LEADING SEPARATE CHARACTER NC1404.2 +006500 VALUE ZERO. NC1404.2 +006600 77 DS-TS-3 PICTURE S999 SIGN IS TRAILING SEPARATE NC1404.2 +006700 CHARACTER VALUE ZERO. NC1404.2 +006800 77 EXPECTED-VALUE PIC S999. NC1404.2 +006900 77 TEMP PICTURE S999. NC1404.2 +007000 77 WRK1 PIC S999 VALUE ZERO. NC1404.2 +007100 01 TEST-RESULTS. NC1404.2 +007200 02 FILLER PIC X VALUE SPACE. NC1404.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC1404.2 +007400 02 FILLER PIC X VALUE SPACE. NC1404.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC1404.2 +007600 02 FILLER PIC X VALUE SPACE. NC1404.2 +007700 02 PAR-NAME. NC1404.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC1404.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC1404.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC1404.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC1404.2 +008200 02 RE-MARK PIC X(61). NC1404.2 +008300 01 TEST-COMPUTED. NC1404.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1404.2 +008500 02 FILLER PIC X(17) VALUE NC1404.2 +008600 " COMPUTED=". NC1404.2 +008700 02 COMPUTED-X. NC1404.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1404.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC1404.2 +009000 PIC -9(9).9(9). NC1404.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1404.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1404.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1404.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC1404.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC1404.2 +009600 04 FILLER PIC X. NC1404.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC1404.2 +009800 01 TEST-CORRECT. NC1404.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC1404.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1404.2 +010100 02 CORRECT-X. NC1404.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1404.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1404.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1404.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1404.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1404.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC1404.2 +010800 04 CORRECT-18V0 PIC -9(18). NC1404.2 +010900 04 FILLER PIC X. NC1404.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC1404.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1404.2 +011200 01 CCVS-C-1. NC1404.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1404.2 +011400- "SS PARAGRAPH-NAME NC1404.2 +011500- " REMARKS". NC1404.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC1404.2 +011700 01 CCVS-C-2. NC1404.2 +011800 02 FILLER PIC X VALUE SPACE. NC1404.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC1404.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC1404.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC1404.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC1404.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1404.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC1404.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1404.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1404.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1404.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1404.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1404.2 +013400 01 CCVS-H-1. NC1404.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC1404.2 +013600 02 FILLER PIC X(42) VALUE NC1404.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1404.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC1404.2 +013900 01 CCVS-H-2A. NC1404.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC1404.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1404.2 +014200 02 FILLER PIC XXXX VALUE NC1404.2 +014300 "4.2 ". NC1404.2 +014400 02 FILLER PIC X(28) VALUE NC1404.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC1404.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC1404.2 +014700 NC1404.2 +014800 01 CCVS-H-2B. NC1404.2 +014900 02 FILLER PIC X(15) VALUE NC1404.2 +015000 "TEST RESULT OF ". NC1404.2 +015100 02 TEST-ID PIC X(9). NC1404.2 +015200 02 FILLER PIC X(4) VALUE NC1404.2 +015300 " IN ". NC1404.2 +015400 02 FILLER PIC X(12) VALUE NC1404.2 +015500 " HIGH ". NC1404.2 +015600 02 FILLER PIC X(22) VALUE NC1404.2 +015700 " LEVEL VALIDATION FOR ". NC1404.2 +015800 02 FILLER PIC X(58) VALUE NC1404.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +016000 01 CCVS-H-3. NC1404.2 +016100 02 FILLER PIC X(34) VALUE NC1404.2 +016200 " FOR OFFICIAL USE ONLY ". NC1404.2 +016300 02 FILLER PIC X(58) VALUE NC1404.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1404.2 +016500 02 FILLER PIC X(28) VALUE NC1404.2 +016600 " COPYRIGHT 1985 ". NC1404.2 +016700 01 CCVS-E-1. NC1404.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC1404.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1404.2 +017000 02 ID-AGAIN PIC X(9). NC1404.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC1404.2 +017200 01 CCVS-E-2. NC1404.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC1404.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC1404.2 +017500 02 CCVS-E-2-2. NC1404.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1404.2 +017700 03 FILLER PIC X VALUE SPACE. NC1404.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC1404.2 +017900 "ERRORS ENCOUNTERED". NC1404.2 +018000 01 CCVS-E-3. NC1404.2 +018100 02 FILLER PIC X(22) VALUE NC1404.2 +018200 " FOR OFFICIAL USE ONLY". NC1404.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC1404.2 +018400 02 FILLER PIC X(58) VALUE NC1404.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC1404.2 +018700 02 FILLER PIC X(15) VALUE NC1404.2 +018800 " COPYRIGHT 1985". NC1404.2 +018900 01 CCVS-E-4. NC1404.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1404.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC1404.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1404.2 +019300 02 FILLER PIC X(40) VALUE NC1404.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1404.2 +019500 01 XXINFO. NC1404.2 +019600 02 FILLER PIC X(19) VALUE NC1404.2 +019700 "*** INFORMATION ***". NC1404.2 +019800 02 INFO-TEXT. NC1404.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC1404.2 +020000 04 XXCOMPUTED PIC X(20). NC1404.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC1404.2 +020200 04 XXCORRECT PIC X(20). NC1404.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC1404.2 +020400 01 HYPHEN-LINE. NC1404.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC1404.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC1404.2 +020700- "*****************************************". NC1404.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC1404.2 +020900- "******************************". NC1404.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC1404.2 +021100 "NC140A". NC1404.2 +021200 PROCEDURE DIVISION. NC1404.2 +021300 CCVS1 SECTION. NC1404.2 +021400 OPEN-FILES. NC1404.2 +021500 OPEN OUTPUT PRINT-FILE. NC1404.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1404.2 +021700 MOVE SPACE TO TEST-RESULTS. NC1404.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1404.2 +021900 GO TO CCVS1-EXIT. NC1404.2 +022000 CLOSE-FILES. NC1404.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1404.2 +022200 TERMINATE-CCVS. NC1404.2 +022300S EXIT PROGRAM. NC1404.2 +022400STERMINATE-CALL. NC1404.2 +022500 STOP RUN. NC1404.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1404.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1404.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1404.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1404.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC1404.2 +023100 PRINT-DETAIL. NC1404.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC1404.2 +023300 MOVE "." TO PARDOT-X NC1404.2 +023400 MOVE REC-CT TO DOTVALUE. NC1404.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1404.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1404.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1404.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1404.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1404.2 +024000 MOVE SPACE TO CORRECT-X. NC1404.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1404.2 +024200 MOVE SPACE TO RE-MARK. NC1404.2 +024300 HEAD-ROUTINE. NC1404.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1404.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1404.2 +024800 COLUMN-NAMES-ROUTINE. NC1404.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +025200 END-ROUTINE. NC1404.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1404.2 +025400 END-RTN-EXIT. NC1404.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +025600 END-ROUTINE-1. NC1404.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1404.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1404.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC1404.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1404.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1404.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1404.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1404.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1404.2 +026500 END-ROUTINE-12. NC1404.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1404.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1404.2 +026800 MOVE "NO " TO ERROR-TOTAL NC1404.2 +026900 ELSE NC1404.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1404.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1404.2 +027200 PERFORM WRITE-LINE. NC1404.2 +027300 END-ROUTINE-13. NC1404.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1404.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC1404.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1404.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1404.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC1404.2 +028000 MOVE "NO " TO ERROR-TOTAL NC1404.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1404.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1404.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +028500 WRITE-LINE. NC1404.2 +028600 ADD 1 TO RECORD-COUNT. NC1404.2 +028700Y IF RECORD-COUNT GREATER 42 NC1404.2 +028800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1404.2 +028900Y MOVE SPACE TO DUMMY-RECORD NC1404.2 +029000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1404.2 +029100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1404.2 +029200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1404.2 +029300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1404.2 +029400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1404.2 +029500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1404.2 +029900Y MOVE ZERO TO RECORD-COUNT. NC1404.2 +030000 PERFORM WRT-LN. NC1404.2 +030100 WRT-LN. NC1404.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1404.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC1404.2 +030400 BLANK-LINE-PRINT. NC1404.2 +030500 PERFORM WRT-LN. NC1404.2 +030600 FAIL-ROUTINE. NC1404.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC1404.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC1404.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1404.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1404.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1404.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1404.2 +031400 GO TO FAIL-ROUTINE-EX. NC1404.2 +031500 FAIL-ROUTINE-WRITE. NC1404.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1404.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1404.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1404.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1404.2 +032000 FAIL-ROUTINE-EX. EXIT. NC1404.2 +032100 BAIL-OUT. NC1404.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1404.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1404.2 +032400 BAIL-OUT-WRITE. NC1404.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1404.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1404.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1404.2 +032900 BAIL-OUT-EX. EXIT. NC1404.2 +033000 CCVS1-EXIT. NC1404.2 +033100 EXIT. NC1404.2 +033200********************************** NC1404.2 +033300*STATEMENT DELETION INSTRUCTIONS NC1404.2 +033400* IF THE COMPILER REJECTS ANY SET STATEMENTS IN THESE TESTS,NC1404.2 +033500* DELETE THAT LINE OF CODE BY PLACING AN * IN COLUMN 7. LEAVE NC1404.2 +033600* THE PERFORM ... THRU STATEMENT. THE TEST DELETED APPEARS AS NC1404.2 +033700* A FAILURE ON THE OUTPUT REPORT. NC1404.2 +033800********************************** NC1404.2 +033900 SECT-NC140A-0001 SECTION. NC1404.2 +034000 NC140A-0001. NC1404.2 +034100 MOVE "VI-127 6.22.4" TO ANSI-REFERENCE. NC1404.2 +034200* THIS SECTION STORES VALUES IN THE TWO TABLES NC1404.2 +034300* USED IN TESTING THE INDEX VALUES. NC1404.2 +034400 MOVE-VALUE. NC1404.2 +034500 ADD 1 TO WRK1. NC1404.2 +034600 MOVE WRK1 TO ELEM1 (S1) ELEM2 (S21 S22). NC1404.2 +034700 IF WRK1 IS EQUAL TO 100 NC1404.2 +034800 GO TO SECT-TH111-0002. NC1404.2 +034900 INCRE-SUBS. NC1404.2 +035000 ADD 1 TO S1. NC1404.2 +035100 ADD 1 TO S22. NC1404.2 +035200 IF S22 LESS THAN 11 NC1404.2 +035300 GO TO MOVE-VALUE. NC1404.2 +035400 MOVE 1 TO S22. NC1404.2 +035500 ADD 1 TO S21. NC1404.2 +035600 GO TO MOVE-VALUE. NC1404.2 +035700 SECT-TH111-0002 SECTION. NC1404.2 +035800 SET-INIT-001. NC1404.2 +035900 MOVE ZERO TO REC-CT. NC1404.2 +036000* THIS TEST VERIFIES THAT THE SET INDEX-NAME UP BY INTEGER NC1404.2 +036100* FUNCTIONS CORRECTLY. THE INTEGER MAY BE POSITIVE, NEGATIVE, NC1404.2 +036200* OR UNSIGNED. NC1404.2 +036300 MOVE ZERO TO TEMP. NC1404.2 +036400 MOVE 6 TO EXPECTED-VALUE. NC1404.2 +036500 MOVE "SET IN UP BY INTEGER" TO FEATURE. NC1404.2 +036600 MOVE "SET-TEST-001" TO PAR-NAME. NC1404.2 +036700 SET-TEST-001-01. NC1404.2 +036800 SET INDEX1 TO 1. NC1404.2 +036900 SET INDEX1 UP BY 5. NC1404.2 +037000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037100 SET-TEST-001-02. NC1404.2 +037200 SET INDEX1 TO 1. NC1404.2 +037300 SET INDEX1 UP BY +5. NC1404.2 +037400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037500 SET-TEST-001-03. NC1404.2 +037600 SET INDEX1 TO 11. NC1404.2 +037700 SET INDEX1 UP BY -5. NC1404.2 +037800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037900 SET-TEST-001-04. NC1404.2 +038000 SET IN1 TO 1. NC1404.2 +038100 SET IN2 INDEX1 TO 2. NC1404.2 +038200 SET IN2 INDEX1 UP BY 4. NC1404.2 +038300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +038400 SET-TEST-001-05. NC1404.2 +038500 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +038600 SET-TEST-001-06. NC1404.2 +038700 SET IN2 INDEX1 TO 2. NC1404.2 +038800 SET IN2 INDEX1 UP BY +4. NC1404.2 +038900 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +039000 SET-TEST-001-07. NC1404.2 +039100 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +039200 SET-TEST-001-08. NC1404.2 +039300 SET IN2 INDEX1 TO 10. NC1404.2 +039400 SET IN2 INDEX1 UP BY -4. NC1404.2 +039500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +039600 SET-TEST-001-09. NC1404.2 +039700 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +039800 SET-TEST-001-10. NC1404.2 +039900 SET IN1 TO 5. NC1404.2 +040000 SET IN2 TO 10. NC1404.2 +040100 SET IN1 IN2 UP BY -4. NC1404.2 +040200 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +040300 SET-TEST-001-11. NC1404.2 +040400 SET IN2 INDEX1 TO 10. NC1404.2 +040500 SET IN1 TO 5. NC1404.2 +040600 SET IN1 IN2 INDEX1 UP BY -4. NC1404.2 +040700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +040800 SET-TEST-001-12. NC1404.2 +040900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +041000 GO TO SET-INIT-002. NC1404.2 +041100 SET-DELETE-001. NC1404.2 +041200 PERFORM DE-LETE. NC1404.2 +041300 PERFORM TEST-WRITE. NC1404.2 +041400 SET-INIT-002. NC1404.2 +041500 MOVE ZERO TO REC-CT. NC1404.2 +041600 MOVE "SET-TEST-002" TO PAR-NAME. NC1404.2 +041700 MOVE ZERO TO TEMP. NC1404.2 +041800 MOVE 54 TO EXPECTED-VALUE. NC1404.2 +041900 MOVE "SET IN DOWN BY INTEG" TO FEATURE. NC1404.2 +042000* THIS TEST VERIFIES THAT THE SET INDEX-NAME DOWN BY NC1404.2 +042100* INTEGER FUNCTIONS CORRECTLY. THE INTEGER MAY BE POSITIVE, NC1404.2 +042200* NEGATIVE, OR UNSIGNED. NC1404.2 +042300 SET-TEST-002-01. NC1404.2 +042400 SET INDEX1 TO 95. NC1404.2 +042500 SET INDEX1 DOWN BY 41. NC1404.2 +042600 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +042700 SET-TEST-002-02. NC1404.2 +042800 SET INDEX1 TO 95. NC1404.2 +042900 SET INDEX1 DOWN BY +41. NC1404.2 +043000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +043100 SET-TEST-002-03. NC1404.2 +043200 SET INDEX1 TO 21. NC1404.2 +043300 SET INDEX1 DOWN BY -33. NC1404.2 +043400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +043500 SET-TEST-002-04. NC1404.2 +043600 SET IN1 TO 9. NC1404.2 +043700 SET IN2 TO 4. NC1404.2 +043800 SET INDEX1 TO 57. NC1404.2 +043900 SET IN1 INDEX1 DOWN BY 3. NC1404.2 +044000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +044100 SET-TEST-002-05. NC1404.2 +044200 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +044300 SET-TEST-002-06. NC1404.2 +044400 SET IN1 TO 9. NC1404.2 +044500 SET INDEX1 TO 57. NC1404.2 +044600 SET IN1 INDEX1 DOWN BY +3. NC1404.2 +044700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +044800 SET-TEST-002-07. NC1404.2 +044900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +045000 SET-TEST-002-08. NC1404.2 +045100 SET IN1 TO 3. NC1404.2 +045200 SET INDEX1 TO 51. NC1404.2 +045300 SET INDEX1 IN1 DOWN BY -3. NC1404.2 +045400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +045500 SET-TEST-002-09. NC1404.2 +045600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +045700 SET-TEST-002-10. NC1404.2 +045800 SET IN1 TO 4. NC1404.2 +045900 SET IN2 TO 2. NC1404.2 +046000 SET IN1 IN2 DOWN BY -2. NC1404.2 +046100 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +046200 SET-TEST-002-11. NC1404.2 +046300 SET IN1 TO 5. NC1404.2 +046400 SET IN2 TO 3. NC1404.2 +046500 SET INDEX1 TO 53. NC1404.2 +046600 SET IN1 IN2 INDEX1 DOWN BY -1. NC1404.2 +046700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +046800 SET-TEST-002-12. NC1404.2 +046900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +047000 GO TO SET-INIT-003. NC1404.2 +047100 SET-DELETE-002. NC1404.2 +047200 PERFORM DE-LETE. NC1404.2 +047300 PERFORM TEST-WRITE. NC1404.2 +047400 SET-INIT-003. NC1404.2 +047500 MOVE ZERO TO REC-CT. NC1404.2 +047600 MOVE "SET-TEST-003" TO PAR-NAME. NC1404.2 +047700 MOVE ZERO TO TEMP. NC1404.2 +047800 MOVE 39 TO EXPECTED-VALUE. NC1404.2 +047900 MOVE "SET IN UP BY DATA-NM" TO FEATURE. NC1404.2 +048000* THIS TEST VERIFIES THAT THE SET INDEX-NAME UP BY NC1404.2 +048100* DATA-NAME FUNCTIONS CORRECTLY. THE VALUE STORED IN DATA-NAMENC1404.2 +048200* MAY BE POSITIVE, NEGATIVE OR ZERO. VARIOUS DATA TYPES ARE NC1404.2 +048300* USED IN THE TEST. NC1404.2 +048400 SET-TEST-003-01. NC1404.2 +048500 SET INDEX1 TO 21. NC1404.2 +048600 MOVE +18 TO CS-3. NC1404.2 +048700 SET INDEX1 UP BY CS-3. NC1404.2 +048800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +048900 SET-TEST-003-02. NC1404.2 +049000 SET INDEX1 TO 21. NC1404.2 +049100 MOVE +18 TO DS-3. NC1404.2 +049200 SET INDEX1 UP BY DS-3. NC1404.2 +049300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +049400 SET-TEST-003-03. NC1404.2 +049500 SET INDEX1 TO 21. NC1404.2 +049600 MOVE +18 TO DS-LS-3. NC1404.2 +049700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +049800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +049900 SET-TEST-003-04. NC1404.2 +050000 SET INDEX1 TO 21. NC1404.2 +050100 MOVE +18 TO DS-TS-3. NC1404.2 +050200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +050300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +050400 SET-TEST-003-05. NC1404.2 +050500 SET INDEX1 TO 21. NC1404.2 +050600 MOVE 18 TO CU-3. NC1404.2 +050700 SET INDEX1 UP BY CU-3. NC1404.2 +050800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +050900 SET-TEST-003-06. NC1404.2 +051000 SET INDEX1 TO 21. NC1404.2 +051100 MOVE 18 TO DU-3. NC1404.2 +051200 SET INDEX1 UP BY DU-3. NC1404.2 +051300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +051400 SET-TEST-003-07. NC1404.2 +051500 SET INDEX1 TO 39. NC1404.2 +051600 MOVE 0 TO CS-3. NC1404.2 +051700 SET INDEX1 UP BY CS-3. NC1404.2 +051800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +051900 SET-TEST-003-08. NC1404.2 +052000 SET INDEX1 TO 39. NC1404.2 +052100 MOVE ZERO TO DS-3. NC1404.2 +052200 SET INDEX1 UP BY DS-3. NC1404.2 +052300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +052400 SET-TEST-003-09. NC1404.2 +052500 SET INDEX1 TO 39. NC1404.2 +052600 MOVE 0 TO DS-LS-3. NC1404.2 +052700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +052800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +052900 SET-TEST-003-10. NC1404.2 +053000 SET INDEX1 TO 39. NC1404.2 +053100 MOVE ZERO TO DS-TS-3. NC1404.2 +053200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +053300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +053400 SET-TEST-003-11. NC1404.2 +053500 SET INDEX1 TO 39. NC1404.2 +053600 MOVE 0 TO CU-3. NC1404.2 +053700 SET INDEX1 UP BY CU-3. NC1404.2 +053800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +053900 SET-TEST-003-12. NC1404.2 +054000 SET INDEX1 TO 39. NC1404.2 +054100 MOVE ZERO TO DU-3. NC1404.2 +054200 SET INDEX1 UP BY DU-3. NC1404.2 +054300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +054400 SET-TEST-003-13. NC1404.2 +054500 SET INDEX1 TO 70. NC1404.2 +054600 MOVE -31 TO CS-3. NC1404.2 +054700 SET INDEX1 UP BY CS-3. NC1404.2 +054800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +054900 SET-TEST-003-14. NC1404.2 +055000 SET INDEX1 TO 70. NC1404.2 +055100 MOVE -31 TO DS-3. NC1404.2 +055200 SET INDEX1 UP BY DS-3. NC1404.2 +055300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +055400 SET-TEST-003-15. NC1404.2 +055500 SET INDEX1 TO 70. NC1404.2 +055600 MOVE -31 TO DS-LS-3. NC1404.2 +055700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +055800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +055900 SET-TEST-003-16. NC1404.2 +056000 SET INDEX1 TO 70. NC1404.2 +056100 MOVE -31 TO DS-TS-3. NC1404.2 +056200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +056300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +056400 SET-TEST-003-17. NC1404.2 +056500 SET IN1 TO 1. NC1404.2 +056600 SET IN2 TO 6. NC1404.2 +056700 MOVE +3 TO DS-LS-3. NC1404.2 +056800 SET IN1 IN2 UP BY DS-LS-3. NC1404.2 +056900 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +057000 SET-TEST-003-18. NC1404.2 +057100 SET IN1 TO 1. NC1404.2 +057200 SET IN2 TO 6. NC1404.2 +057300 MOVE +3 TO CS-3. NC1404.2 +057400 SET INDEX1 TO 36. NC1404.2 +057500 SET IN1 IN2 INDEX1 UP BY CS-3. NC1404.2 +057600 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +057700 SET-TEST-003-19. NC1404.2 +057800 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +057900 SET-TEST-003-20. NC1404.2 +058000 SET IN1 TO 5. NC1404.2 +058100 SET IN2 TO 10. NC1404.2 +058200 SET INDEX1 TO 40. NC1404.2 +058300 MOVE -1 TO DS-TS-3. NC1404.2 +058400 SET IN1 IN2 INDEX1 UP BY DS-TS-3. NC1404.2 +058500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +058600 SET-TEST-003-21. NC1404.2 +058700 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +058800 SET-TEST-003-22. NC1404.2 +058900 SET IN1 TO 4. NC1404.2 +059000 SET IN2 TO 9. NC1404.2 +059100 SET INDEX1 TO 39. NC1404.2 +059200 MOVE ZERO TO CU-3. NC1404.2 +059300 SET IN1 IN2 INDEX1 UP BY CU-3. NC1404.2 +059400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +059500 SET-TEST-003-23. NC1404.2 +059600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +059700 GO TO SET-INIT-004. NC1404.2 +059800 SET-DELETE-003. NC1404.2 +059900 PERFORM DE-LETE. NC1404.2 +060000 PERFORM TEST-WRITE. NC1404.2 +060100 SET-INIT-004. NC1404.2 +060200 MOVE ZERO TO REC-CT. NC1404.2 +060300 MOVE "SET-TEST-004" TO PAR-NAME. NC1404.2 +060400 MOVE ZERO TO TEMP. NC1404.2 +060500 MOVE 77 TO EXPECTED-VALUE. NC1404.2 +060600 MOVE "SET IN DOWN BY DNAME" TO FEATURE. NC1404.2 +060700* THIS TEST VERIFIES THAT THE SET INDEX-NAME DOWN BY NC1404.2 +060800* DATA-NAME FUNCTIONS CORRECTLY. THE VALUE STORED IN DATA-NAMENC1404.2 +060900* MAY BE POSITIVE, NEGATIVE OR ZERO. VARIOUS DATA TYPES ARE NC1404.2 +061000* USED IN THE TEST. NC1404.2 +061100 SET-TEST-004-01. NC1404.2 +061200 SET INDEX1 TO 100. NC1404.2 +061300 MOVE +23 TO CS-3. NC1404.2 +061400 SET INDEX1 DOWN BY CS-3. NC1404.2 +061500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +061600 SET-TEST-004-02. NC1404.2 +061700 SET INDEX1 TO 100. NC1404.2 +061800 MOVE +23 TO DS-3. NC1404.2 +061900 SET INDEX1 DOWN BY DS-3. NC1404.2 +062000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +062100 SET-TEST-004-03. NC1404.2 +062200 SET INDEX1 TO 100. NC1404.2 +062300 MOVE +23 TO DS-LS-3. NC1404.2 +062400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +062500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +062600 SET-TEST-004-04. NC1404.2 +062700 SET INDEX1 TO 100. NC1404.2 +062800 MOVE +23 TO DS-TS-3. NC1404.2 +062900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +063000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +063100 SET-TEST-004-05. NC1404.2 +063200 SET INDEX1 TO 100. NC1404.2 +063300 MOVE 23 TO CU-3. NC1404.2 +063400 SET INDEX1 DOWN BY CU-3. NC1404.2 +063500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +063600 SET-TEST-004-06. NC1404.2 +063700 SET INDEX1 TO 100. NC1404.2 +063800 MOVE 23 TO DU-3. NC1404.2 +063900 SET INDEX1 DOWN BY DU-3. NC1404.2 +064000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +064100 SET-TEST-004-07. NC1404.2 +064200 MOVE ZERO TO CS-3. NC1404.2 +064300 SET INDEX1 TO 77. NC1404.2 +064400 SET INDEX1 DOWN BY CS-3. NC1404.2 +064500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +064600 SET-TEST-004-08. NC1404.2 +064700 MOVE 0 TO DS-3. NC1404.2 +064800 SET INDEX1 TO 77. NC1404.2 +064900 SET INDEX1 DOWN BY DS-3. NC1404.2 +065000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +065100 SET-TEST-004-09. NC1404.2 +065200 MOVE 0 TO DS-LS-3. NC1404.2 +065300 SET INDEX1 TO 77. NC1404.2 +065400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +065500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +065600 SET-TEST-004-10. NC1404.2 +065700 MOVE ZERO TO DS-TS-3. NC1404.2 +065800 SET INDEX1 TO 77. NC1404.2 +065900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +066000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +066100 SET-TEST-004-11. NC1404.2 +066200 MOVE 0 TO CU-3. NC1404.2 +066300 SET INDEX1 TO 77. NC1404.2 +066400 SET INDEX1 DOWN BY CU-3. NC1404.2 +066500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +066600 SET-TEST-004-12. NC1404.2 +066700 MOVE ZERO TO DU-3. NC1404.2 +066800 SET INDEX1 TO 77. NC1404.2 +066900 SET INDEX1 DOWN BY DU-3. NC1404.2 +067000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +067100 SET-TEST-004-13. NC1404.2 +067200 SET INDEX1 TO 2. NC1404.2 +067300 MOVE -75 TO CS-3. NC1404.2 +067400 SET INDEX1 DOWN BY CS-3. NC1404.2 +067500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +067600 SET-TEST-004-14. NC1404.2 +067700 SET INDEX1 TO 2. NC1404.2 +067800 MOVE -75 TO DS-3. NC1404.2 +067900 SET INDEX1 DOWN BY DS-3. NC1404.2 +068000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +068100 SET-TEST-004-15. NC1404.2 +068200 SET INDEX1 TO 2. NC1404.2 +068300 MOVE -75 TO DS-LS-3. NC1404.2 +068400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +068500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +068600 SET-TEST-004-16. NC1404.2 +068700 SET INDEX1 TO 2. NC1404.2 +068800 MOVE -75 TO DS-TS-3. NC1404.2 +068900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +069000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +069100 SET-TEST-004-17. NC1404.2 +069200 SET IN1 TO 10. NC1404.2 +069300 SET IN2 TO 9. NC1404.2 +069400 MOVE +2 TO DS-TS-3. NC1404.2 +069500 SET IN1 IN2 DOWN BY DS-TS-3. NC1404.2 +069600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +069700 SET-TEST-004-18. NC1404.2 +069800 SET IN1 TO 10. NC1404.2 +069900 SET IN2 TO 9. NC1404.2 +070000 SET INDEX1 TO 79. NC1404.2 +070100 MOVE 2 TO CU-3. NC1404.2 +070200 SET IN1 IN2 INDEX1 DOWN BY CU-3. NC1404.2 +070300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +070400 SET-TEST-004-19. NC1404.2 +070500 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +070600 SET-TEST-004-20. NC1404.2 +070700 SET IN1 TO 3. NC1404.2 +070800 SET IN2 TO 2. NC1404.2 +070900 SET INDEX1 TO 72. NC1404.2 +071000 MOVE -5 TO DS-3. NC1404.2 +071100 SET INDEX1 IN1 IN2 DOWN BY DS-3. NC1404.2 +071200 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +071300 SET-TEST-004-21. NC1404.2 +071400 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +071500 SET-TEST-004-22. NC1404.2 +071600 MOVE ZERO TO DS-TS-3. NC1404.2 +071700 SET IN1 TO 8. NC1404.2 +071800 SET IN2 TO 7. NC1404.2 +071900 SET INDEX1 TO 77. NC1404.2 +072000 SET IN1 IN2 INDEX1 DOWN BY DS-TS-3. NC1404.2 +072100 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +072200 SET-TEST-004-23. NC1404.2 +072300 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +072400 GO TO CCVS-EXIT. NC1404.2 +072500 SET-DELETE-004. NC1404.2 +072600 PERFORM DE-LETE. NC1404.2 +072700 PERFORM TEST-WRITE. NC1404.2 +072800 GO TO CCVS-EXIT. NC1404.2 +072900 SECT-TH111-0003 SECTION. NC1404.2 +073000 TEST-CHECK1. NC1404.2 +073100 MOVE ELEM1 (INDEX1) TO TEMP. NC1404.2 +073200 GO TO TEST-CHECK. NC1404.2 +073300 TEST-CHECK2. NC1404.2 +073400 MOVE ELEM2 (IN1 IN2) TO TEMP. NC1404.2 +073500 TEST-CHECK. NC1404.2 +073600 ADD 1 TO REC-CT. NC1404.2 +073700 IF TEMP IS EQUAL TO EXPECTED-VALUE NC1404.2 +073800 PERFORM PASS NC1404.2 +073900 GO TO TEST-WRITE. NC1404.2 +074000 TEST-FAIL. NC1404.2 +074100 PERFORM FAIL. NC1404.2 +074200 MOVE TEMP TO COMPUTED-18V0. NC1404.2 +074300 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC1404.2 +074400 TEST-WRITE. NC1404.2 +074500 PERFORM PRINT-DETAIL. NC1404.2 +074600 MOVE ZERO TO TEMP. NC1404.2 +074700 CCVS-EXIT SECTION. NC1404.2 +074800 CCVS-999999. NC1404.2 +074900 GO TO CLOSE-FILES. NC1404.2 +*END-OF,NC140A +*HEADER,COBOL,NC141A +000100 IDENTIFICATION DIVISION. NC1414.2 +000200 PROGRAM-ID. NC1414.2 +000300 NC141A. NC1414.2 +000400**************************************************************** NC1414.2 +000500* * NC1414.2 +000600* VALIDATION FOR:- * NC1414.2 +000700* * NC1414.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +000900* * NC1414.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1414.2 +001100* * NC1414.2 +001200**************************************************************** NC1414.2 +001300* * NC1414.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1414.2 +001500* * NC1414.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1414.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1414.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1414.2 +001900* * NC1414.2 +002000**************************************************************** NC1414.2 +002100* NC1414.2 +002200* PROGRAM NC141A TESTS FORMAT 1 AND 2 OF THE "SET" NC1414.2 +002300* STATEMENT USING IDENTIFIERS INDEXED BY RELATIVE INDEXES NC1414.2 +002400* AND NUMERIC LITERALS. NC1414.2 +002500* NC1414.2 +002600 ENVIRONMENT DIVISION. NC1414.2 +002700 CONFIGURATION SECTION. NC1414.2 +002800 SOURCE-COMPUTER. NC1414.2 +002900 XXXXX082. NC1414.2 +003000 OBJECT-COMPUTER. NC1414.2 +003100 XXXXX083. NC1414.2 +003200 INPUT-OUTPUT SECTION. NC1414.2 +003300 FILE-CONTROL. NC1414.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1414.2 +003500 XXXXX055. NC1414.2 +003600 DATA DIVISION. NC1414.2 +003700 FILE SECTION. NC1414.2 +003800 FD PRINT-FILE. NC1414.2 +003900 01 PRINT-REC PICTURE X(120). NC1414.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1414.2 +004100 WORKING-STORAGE SECTION. NC1414.2 +004200 01 TABLE1. NC1414.2 +004300 02 TABLE1-REC PICTURE 99 NC1414.2 +004400 OCCURS 100 TIMES NC1414.2 +004500 INDEXED BY INDEX1. NC1414.2 +004600 01 TABLE2. NC1414.2 +004700 02 TABLE2-REC PICTURE 99 NC1414.2 +004800 OCCURS 12 TIMES NC1414.2 +004900 INDEXED BY INDEX2. NC1414.2 +005000 01 INDEX-ID PIC 999 VALUE ZERO. NC1414.2 +005100 01 TEST-RESULTS. NC1414.2 +005200 02 FILLER PIC X VALUE SPACE. NC1414.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. NC1414.2 +005400 02 FILLER PIC X VALUE SPACE. NC1414.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. NC1414.2 +005600 02 FILLER PIC X VALUE SPACE. NC1414.2 +005700 02 PAR-NAME. NC1414.2 +005800 03 FILLER PIC X(19) VALUE SPACE. NC1414.2 +005900 03 PARDOT-X PIC X VALUE SPACE. NC1414.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. NC1414.2 +006100 02 FILLER PIC X(8) VALUE SPACE. NC1414.2 +006200 02 RE-MARK PIC X(61). NC1414.2 +006300 01 TEST-COMPUTED. NC1414.2 +006400 02 FILLER PIC X(30) VALUE SPACE. NC1414.2 +006500 02 FILLER PIC X(17) VALUE NC1414.2 +006600 " COMPUTED=". NC1414.2 +006700 02 COMPUTED-X. NC1414.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1414.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A NC1414.2 +007000 PIC -9(9).9(9). NC1414.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1414.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1414.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1414.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. NC1414.2 +007500 04 COMPUTED-18V0 PIC -9(18). NC1414.2 +007600 04 FILLER PIC X. NC1414.2 +007700 03 FILLER PIC X(50) VALUE SPACE. NC1414.2 +007800 01 TEST-CORRECT. NC1414.2 +007900 02 FILLER PIC X(30) VALUE SPACE. NC1414.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1414.2 +008100 02 CORRECT-X. NC1414.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1414.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1414.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1414.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1414.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1414.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. NC1414.2 +008800 04 CORRECT-18V0 PIC -9(18). NC1414.2 +008900 04 FILLER PIC X. NC1414.2 +009000 03 FILLER PIC X(2) VALUE SPACE. NC1414.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1414.2 +009200 01 CCVS-C-1. NC1414.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1414.2 +009400- "SS PARAGRAPH-NAME NC1414.2 +009500- " REMARKS". NC1414.2 +009600 02 FILLER PIC X(20) VALUE SPACE. NC1414.2 +009700 01 CCVS-C-2. NC1414.2 +009800 02 FILLER PIC X VALUE SPACE. NC1414.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". NC1414.2 +010000 02 FILLER PIC X(15) VALUE SPACE. NC1414.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". NC1414.2 +010200 02 FILLER PIC X(94) VALUE SPACE. NC1414.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1414.2 +010400 01 REC-CT PIC 99 VALUE ZERO. NC1414.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1414.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1414.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1414.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1414.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1414.2 +011400 01 CCVS-H-1. NC1414.2 +011500 02 FILLER PIC X(39) VALUE SPACES. NC1414.2 +011600 02 FILLER PIC X(42) VALUE NC1414.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1414.2 +011800 02 FILLER PIC X(39) VALUE SPACES. NC1414.2 +011900 01 CCVS-H-2A. NC1414.2 +012000 02 FILLER PIC X(40) VALUE SPACE. NC1414.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1414.2 +012200 02 FILLER PIC XXXX VALUE NC1414.2 +012300 "4.2 ". NC1414.2 +012400 02 FILLER PIC X(28) VALUE NC1414.2 +012500 " COPY - NOT FOR DISTRIBUTION". NC1414.2 +012600 02 FILLER PIC X(41) VALUE SPACE. NC1414.2 +012700 NC1414.2 +012800 01 CCVS-H-2B. NC1414.2 +012900 02 FILLER PIC X(15) VALUE NC1414.2 +013000 "TEST RESULT OF ". NC1414.2 +013100 02 TEST-ID PIC X(9). NC1414.2 +013200 02 FILLER PIC X(4) VALUE NC1414.2 +013300 " IN ". NC1414.2 +013400 02 FILLER PIC X(12) VALUE NC1414.2 +013500 " HIGH ". NC1414.2 +013600 02 FILLER PIC X(22) VALUE NC1414.2 +013700 " LEVEL VALIDATION FOR ". NC1414.2 +013800 02 FILLER PIC X(58) VALUE NC1414.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +014000 01 CCVS-H-3. NC1414.2 +014100 02 FILLER PIC X(34) VALUE NC1414.2 +014200 " FOR OFFICIAL USE ONLY ". NC1414.2 +014300 02 FILLER PIC X(58) VALUE NC1414.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1414.2 +014500 02 FILLER PIC X(28) VALUE NC1414.2 +014600 " COPYRIGHT 1985 ". NC1414.2 +014700 01 CCVS-E-1. NC1414.2 +014800 02 FILLER PIC X(52) VALUE SPACE. NC1414.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1414.2 +015000 02 ID-AGAIN PIC X(9). NC1414.2 +015100 02 FILLER PIC X(45) VALUE SPACES. NC1414.2 +015200 01 CCVS-E-2. NC1414.2 +015300 02 FILLER PIC X(31) VALUE SPACE. NC1414.2 +015400 02 FILLER PIC X(21) VALUE SPACE. NC1414.2 +015500 02 CCVS-E-2-2. NC1414.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1414.2 +015700 03 FILLER PIC X VALUE SPACE. NC1414.2 +015800 03 ENDER-DESC PIC X(44) VALUE NC1414.2 +015900 "ERRORS ENCOUNTERED". NC1414.2 +016000 01 CCVS-E-3. NC1414.2 +016100 02 FILLER PIC X(22) VALUE NC1414.2 +016200 " FOR OFFICIAL USE ONLY". NC1414.2 +016300 02 FILLER PIC X(12) VALUE SPACE. NC1414.2 +016400 02 FILLER PIC X(58) VALUE NC1414.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +016600 02 FILLER PIC X(13) VALUE SPACE. NC1414.2 +016700 02 FILLER PIC X(15) VALUE NC1414.2 +016800 " COPYRIGHT 1985". NC1414.2 +016900 01 CCVS-E-4. NC1414.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1414.2 +017100 02 FILLER PIC X(4) VALUE " OF ". NC1414.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1414.2 +017300 02 FILLER PIC X(40) VALUE NC1414.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1414.2 +017500 01 XXINFO. NC1414.2 +017600 02 FILLER PIC X(19) VALUE NC1414.2 +017700 "*** INFORMATION ***". NC1414.2 +017800 02 INFO-TEXT. NC1414.2 +017900 04 FILLER PIC X(8) VALUE SPACE. NC1414.2 +018000 04 XXCOMPUTED PIC X(20). NC1414.2 +018100 04 FILLER PIC X(5) VALUE SPACE. NC1414.2 +018200 04 XXCORRECT PIC X(20). NC1414.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). NC1414.2 +018400 01 HYPHEN-LINE. NC1414.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. NC1414.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************NC1414.2 +018700- "*****************************************". NC1414.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************NC1414.2 +018900- "******************************". NC1414.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE NC1414.2 +019100 "NC141A". NC1414.2 +019200 PROCEDURE DIVISION. NC1414.2 +019300 CCVS1 SECTION. NC1414.2 +019400 OPEN-FILES. NC1414.2 +019500 OPEN OUTPUT PRINT-FILE. NC1414.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1414.2 +019700 MOVE SPACE TO TEST-RESULTS. NC1414.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1414.2 +019900 GO TO CCVS1-EXIT. NC1414.2 +020000 CLOSE-FILES. NC1414.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1414.2 +020200 TERMINATE-CCVS. NC1414.2 +020300S EXIT PROGRAM. NC1414.2 +020400STERMINATE-CALL. NC1414.2 +020500 STOP RUN. NC1414.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1414.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1414.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1414.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1414.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. NC1414.2 +021100 PRINT-DETAIL. NC1414.2 +021200 IF REC-CT NOT EQUAL TO ZERO NC1414.2 +021300 MOVE "." TO PARDOT-X NC1414.2 +021400 MOVE REC-CT TO DOTVALUE. NC1414.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1414.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1414.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1414.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1414.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1414.2 +022000 MOVE SPACE TO CORRECT-X. NC1414.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1414.2 +022200 MOVE SPACE TO RE-MARK. NC1414.2 +022300 HEAD-ROUTINE. NC1414.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1414.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1414.2 +022800 COLUMN-NAMES-ROUTINE. NC1414.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +023200 END-ROUTINE. NC1414.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1414.2 +023400 END-RTN-EXIT. NC1414.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +023600 END-ROUTINE-1. NC1414.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1414.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1414.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. NC1414.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1414.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1414.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1414.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1414.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1414.2 +024500 END-ROUTINE-12. NC1414.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1414.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1414.2 +024800 MOVE "NO " TO ERROR-TOTAL NC1414.2 +024900 ELSE NC1414.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1414.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1414.2 +025200 PERFORM WRITE-LINE. NC1414.2 +025300 END-ROUTINE-13. NC1414.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1414.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE NC1414.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1414.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1414.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO NC1414.2 +026000 MOVE "NO " TO ERROR-TOTAL NC1414.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1414.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1414.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +026500 WRITE-LINE. NC1414.2 +026600 ADD 1 TO RECORD-COUNT. NC1414.2 +026700Y IF RECORD-COUNT GREATER 42 NC1414.2 +026800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1414.2 +026900Y MOVE SPACE TO DUMMY-RECORD NC1414.2 +027000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1414.2 +027100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1414.2 +027200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1414.2 +027300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1414.2 +027400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1414.2 +027500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1414.2 +027900Y MOVE ZERO TO RECORD-COUNT. NC1414.2 +028000 PERFORM WRT-LN. NC1414.2 +028100 WRT-LN. NC1414.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1414.2 +028300 MOVE SPACE TO DUMMY-RECORD. NC1414.2 +028400 BLANK-LINE-PRINT. NC1414.2 +028500 PERFORM WRT-LN. NC1414.2 +028600 FAIL-ROUTINE. NC1414.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE NC1414.2 +028800 GO TO FAIL-ROUTINE-WRITE. NC1414.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1414.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1414.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1414.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1414.2 +029400 GO TO FAIL-ROUTINE-EX. NC1414.2 +029500 FAIL-ROUTINE-WRITE. NC1414.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1414.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1414.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1414.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1414.2 +030000 FAIL-ROUTINE-EX. EXIT. NC1414.2 +030100 BAIL-OUT. NC1414.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1414.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1414.2 +030400 BAIL-OUT-WRITE. NC1414.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1414.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1414.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1414.2 +030900 BAIL-OUT-EX. EXIT. NC1414.2 +031000 CCVS1-EXIT. NC1414.2 +031100 EXIT. NC1414.2 +031200 SECT-NC141A-001 SECTION. NC1414.2 +031300 INIT-PARA. NC1414.2 +031400 MOVE "VI-127 6.22.4" TO ANSI-REFERENCE. NC1414.2 +031500 BUILD-TABLE2. NC1414.2 +031600 MOVE 21 TO TABLE2-REC (1). NC1414.2 +031700 MOVE 02 TO TABLE2-REC (2). NC1414.2 +031800 MOVE 03 TO TABLE2-REC (3). NC1414.2 +031900 MOVE 11 TO TABLE2-REC (4). NC1414.2 +032000 MOVE 05 TO TABLE2-REC (5). NC1414.2 +032100 MOVE 10 TO TABLE2-REC (6). NC1414.2 +032200 MOVE 26 TO TABLE2-REC (7). NC1414.2 +032300 MOVE 02 TO TABLE2-REC (8). NC1414.2 +032400 MOVE 16 TO TABLE2-REC (9). NC1414.2 +032500 MOVE 62 TO TABLE2-REC (10). NC1414.2 +032600 MOVE 10 TO TABLE2-REC (11). NC1414.2 +032700 MOVE 04 TO TABLE2-REC (12). NC1414.2 +032800 SET-TEST-1. NC1414.2 +032900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +033000 SET INDEX1 TO 1. NC1414.2 +033100 SET INDEX2 TO 7. NC1414.2 +033200 SET INDEX1 TO TABLE2-REC (INDEX2). NC1414.2 +033300 IF INDEX1 EQUAL TO 26 NC1414.2 +033400 PERFORM PASS NC1414.2 +033500 ELSE GO TO SET-FAIL-1. NC1414.2 +033600 GO TO SET-WRITE-1. NC1414.2 +033700 SET-DELETE-1. NC1414.2 +033800 PERFORM DE-LETE. NC1414.2 +033900 GO TO SET-WRITE-1. NC1414.2 +034000 SET-FAIL-1. NC1414.2 +034100 PERFORM FAIL. NC1414.2 +034200 SET INDEX-ID TO INDEX1. NC1414.2 +034300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +034400 MOVE 26 TO CORRECT-18V0. NC1414.2 +034500 SET-WRITE-1. NC1414.2 +034600 MOVE "SET-TEST-1" TO PAR-NAME. NC1414.2 +034700 PERFORM PRINT-DETAIL. NC1414.2 +034800 SET-TEST-2. NC1414.2 +034900 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +035000 SET INDEX1 TO 7. NC1414.2 +035100 SET INDEX2 TO 8. NC1414.2 +035200 SET INDEX1 UP BY TABLE2-REC (INDEX2). NC1414.2 +035300 IF INDEX1 EQUAL TO 9 NC1414.2 +035400 PERFORM PASS NC1414.2 +035500 ELSE GO TO SET-FAIL-2. NC1414.2 +035600 GO TO SET-WRITE-2. NC1414.2 +035700 SET-DELETE-2. NC1414.2 +035800 PERFORM DE-LETE. NC1414.2 +035900 GO TO SET-WRITE-2. NC1414.2 +036000 SET-FAIL-2. NC1414.2 +036100 PERFORM FAIL. NC1414.2 +036200 SET INDEX-ID TO INDEX1. NC1414.2 +036300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +036400 MOVE 09 TO CORRECT-18V0. NC1414.2 +036500 SET-WRITE-2. NC1414.2 +036600 MOVE "SET-TEST-2" TO PAR-NAME. NC1414.2 +036700 PERFORM PRINT-DETAIL. NC1414.2 +036800 SET-TEST-3. NC1414.2 +036900 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +037000 SET INDEX1 TO 56. NC1414.2 +037100 SET INDEX2 TO 9. NC1414.2 +037200 SET INDEX1 DOWN BY TABLE2-REC (INDEX2). NC1414.2 +037300 IF INDEX1 EQUAL TO 40 NC1414.2 +037400 PERFORM PASS NC1414.2 +037500 ELSE GO TO SET-FAIL-3. NC1414.2 +037600 GO TO SET-WRITE-3. NC1414.2 +037700 SET-DELETE-3. NC1414.2 +037800 PERFORM DE-LETE. NC1414.2 +037900 GO TO SET-WRITE-3. NC1414.2 +038000 SET-FAIL-3. NC1414.2 +038100 PERFORM FAIL. NC1414.2 +038200 SET INDEX-ID TO INDEX1. NC1414.2 +038300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +038400 MOVE 40 TO CORRECT-18V0. NC1414.2 +038500 SET-WRITE-3. NC1414.2 +038600 MOVE "SET-TEST-3" TO PAR-NAME. NC1414.2 +038700 PERFORM PRINT-DETAIL. NC1414.2 +038800 SET-TEST-4. NC1414.2 +038900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +039000 SET INDEX1 TO 1. NC1414.2 +039100 SET INDEX2 TO 9. NC1414.2 +039200 SET INDEX1 TO TABLE2-REC (INDEX2 + 1). NC1414.2 +039300 IF INDEX1 EQUAL TO 62 NC1414.2 +039400 PERFORM PASS NC1414.2 +039500 ELSE GO TO SET-FAIL-4. NC1414.2 +039600 GO TO SET-WRITE-4. NC1414.2 +039700 SET-DELETE-4. NC1414.2 +039800 PERFORM DE-LETE. NC1414.2 +039900 GO TO SET-WRITE-4. NC1414.2 +040000 SET-FAIL-4. NC1414.2 +040100 PERFORM FAIL. NC1414.2 +040200 SET INDEX-ID TO INDEX1. NC1414.2 +040300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +040400 MOVE 62 TO CORRECT-18V0. NC1414.2 +040500 SET-WRITE-4. NC1414.2 +040600 MOVE "SET-TEST-4" TO PAR-NAME. NC1414.2 +040700 PERFORM PRINT-DETAIL. NC1414.2 +040800 SET-TEST-5. NC1414.2 +040900 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +041000 SET INDEX1 TO 10. NC1414.2 +041100 SET INDEX2 TO 12. NC1414.2 +041200 SET INDEX1 UP BY TABLE2-REC (INDEX2 - 1). NC1414.2 +041300 IF INDEX1 EQUAL TO 20 NC1414.2 +041400 PERFORM PASS NC1414.2 +041500 ELSE GO TO SET-FAIL-5. NC1414.2 +041600 GO TO SET-WRITE-5. NC1414.2 +041700 SET-DELETE-5. NC1414.2 +041800 PERFORM DE-LETE. NC1414.2 +041900 GO TO SET-WRITE-5. NC1414.2 +042000 SET-FAIL-5. NC1414.2 +042100 PERFORM FAIL. NC1414.2 +042200 SET INDEX-ID TO INDEX1. NC1414.2 +042300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +042400 MOVE 20 TO CORRECT-18V0. NC1414.2 +042500 SET-WRITE-5. NC1414.2 +042600 MOVE "SET-TEST-5" TO PAR-NAME. NC1414.2 +042700 PERFORM PRINT-DETAIL. NC1414.2 +042800 SET-TEST-6. NC1414.2 +042900 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +043000 SET INDEX1 TO 15. NC1414.2 +043100 SET INDEX2 TO 8. NC1414.2 +043200 SET INDEX1 DOWN BY TABLE2-REC (INDEX2 + 4). NC1414.2 +043300 IF INDEX1 EQUAL TO 11 NC1414.2 +043400 PERFORM PASS NC1414.2 +043500 ELSE GO TO SET-FAIL-6. NC1414.2 +043600 GO TO SET-WRITE-6. NC1414.2 +043700 SET-DELETE-6. NC1414.2 +043800 PERFORM DE-LETE. NC1414.2 +043900 GO TO SET-WRITE-6. NC1414.2 +044000 SET-FAIL-6. NC1414.2 +044100 PERFORM FAIL. NC1414.2 +044200 SET INDEX-ID TO INDEX1. NC1414.2 +044300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +044400 MOVE 11 TO CORRECT-18V0. NC1414.2 +044500 SET-WRITE-6. NC1414.2 +044600 MOVE "SET-TEST-6" TO PAR-NAME. NC1414.2 +044700 PERFORM PRINT-DETAIL. NC1414.2 +044800 SET-TEST-7. NC1414.2 +044900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +045000 SET INDEX1 TO 1. NC1414.2 +045100 SET INDEX1 TO TABLE2-REC (1). NC1414.2 +045200 IF INDEX1 EQUAL TO 21 NC1414.2 +045300 PERFORM PASS NC1414.2 +045400 ELSE GO TO SET-FAIL-7. NC1414.2 +045500 GO TO SET-WRITE-7. NC1414.2 +045600 SET-DELETE-7. NC1414.2 +045700 PERFORM DE-LETE. NC1414.2 +045800 GO TO SET-WRITE-7. NC1414.2 +045900 SET-FAIL-7. NC1414.2 +046000 PERFORM FAIL. NC1414.2 +046100 SET INDEX-ID TO INDEX1. NC1414.2 +046200 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +046300 MOVE 21 TO CORRECT-18V0. NC1414.2 +046400 SET-WRITE-7. NC1414.2 +046500 MOVE "SET-TEST-7" TO PAR-NAME. NC1414.2 +046600 PERFORM PRINT-DETAIL. NC1414.2 +046700 SET-TEST-8. NC1414.2 +046800 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +046900 SET INDEX1 TO 21. NC1414.2 +047000 SET INDEX1 UP BY TABLE2-REC (2). NC1414.2 +047100 IF INDEX1 EQUAL TO 23 NC1414.2 +047200 PERFORM PASS NC1414.2 +047300 ELSE GO TO SET-FAIL-8. NC1414.2 +047400 GO TO SET-WRITE-8. NC1414.2 +047500 SET-DELETE-8. NC1414.2 +047600 PERFORM DE-LETE. NC1414.2 +047700 GO TO SET-WRITE-8. NC1414.2 +047800 SET-FAIL-8. NC1414.2 +047900 PERFORM FAIL. NC1414.2 +048000 SET INDEX-ID TO INDEX1. NC1414.2 +048100 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +048200 MOVE 23 TO CORRECT-18V0. NC1414.2 +048300 SET-WRITE-8. NC1414.2 +048400 MOVE "SET-TEST-8" TO PAR-NAME. NC1414.2 +048500 PERFORM PRINT-DETAIL. NC1414.2 +048600 SET-TEST-9. NC1414.2 +048700 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +048800 SET INDEX1 TO 23. NC1414.2 +048900 SET INDEX1 DOWN BY TABLE2-REC (3). NC1414.2 +049000 IF INDEX1 EQUAL TO 20 NC1414.2 +049100 PERFORM PASS NC1414.2 +049200 ELSE GO TO SET-FAIL-9. NC1414.2 +049300 GO TO SET-WRITE-9. NC1414.2 +049400 SET-DELETE-9. NC1414.2 +049500 PERFORM DE-LETE. NC1414.2 +049600 GO TO SET-WRITE-9. NC1414.2 +049700 SET-FAIL-9. NC1414.2 +049800 PERFORM FAIL. NC1414.2 +049900 SET INDEX-ID TO INDEX1. NC1414.2 +050000 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +050100 MOVE 20 TO CORRECT-18V0. NC1414.2 +050200 SET-WRITE-9. NC1414.2 +050300 MOVE "SET-TEST-9" TO PAR-NAME. NC1414.2 +050400 PERFORM PRINT-DETAIL. NC1414.2 +050500 CCVS-EXIT SECTION. NC1414.2 +050600 CCVS-999999. NC1414.2 +050700 GO TO CLOSE-FILES. NC1414.2 +*END-OF,NC141A +*HEADER,COBOL,NC170A +000100 IDENTIFICATION DIVISION. NC1704.2 +000200 PROGRAM-ID. NC1704.2 +000300 NC170A. NC1704.2 +000400**************************************************************** NC1704.2 +000500* * NC1704.2 +000600* VALIDATION FOR:- * NC1704.2 +000700* * NC1704.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +000900* * NC1704.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1704.2 +001100* * NC1704.2 +001200**************************************************************** NC1704.2 +001300* * NC1704.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1704.2 +001500* * NC1704.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1704.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1704.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1704.2 +001900* * NC1704.2 +002000**************************************************************** NC1704.2 +002100* NC1704.2 +002200* THIS PROGRAM TESTS THE FORMAT 2 MULTIPLY STATEMENT FOUND NC1704.2 +002300* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1704.2 +002400* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1704.2 +002500* TESTED, AS WELL AS THE ROUNDED OPTION. NC1704.2 +002600* NC1704.2 +002700* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1704.2 +002800* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1704.2 +002900* AS OPERANDS. NC1704.2 +003000* NC1704.2 +003100 NC1704.2 +003200 ENVIRONMENT DIVISION. NC1704.2 +003300 CONFIGURATION SECTION. NC1704.2 +003400 SOURCE-COMPUTER. NC1704.2 +003500 XXXXX082. NC1704.2 +003600 OBJECT-COMPUTER. NC1704.2 +003700 XXXXX083. NC1704.2 +003800 INPUT-OUTPUT SECTION. NC1704.2 +003900 FILE-CONTROL. NC1704.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1704.2 +004100 XXXXX055. NC1704.2 +004200 DATA DIVISION. NC1704.2 +004300 FILE SECTION. NC1704.2 +004400 FD PRINT-FILE. NC1704.2 +004500 01 PRINT-REC PICTURE X(120). NC1704.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1704.2 +004700 WORKING-STORAGE SECTION. NC1704.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1704.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1704.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1704.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1704.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1704.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1704.2 +005400 77 WRK-XN-00001 PICTURE X. NC1704.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1704.2 +005600 VALUE 1111111111. NC1704.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1704.2 +005800 VALUE 333333.333333. NC1704.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1704.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1704.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1704.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1704.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1704.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1704.2 +006500 VALUE 111111111111. NC1704.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1704.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1704.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1704.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1704.2 +007000 VALUE 111111111111111111. NC1704.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1704.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1704.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1704.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1704.2 +007500 VALUE 99. NC1704.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1704.2 +007700 VALUE .1. NC1704.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1704.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1704.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1704.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1704.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1704.2 +008300 VALUE 111111111.111111111. NC1704.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1704.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1704.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1704.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1704.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1704.2 +008900 77 XRAY PICTURE X. NC1704.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1704.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1704.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1704.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1704.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1704.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1704.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1704.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1704.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1704.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1704.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1704.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1704.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1704.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1704.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1704.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1704.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1704.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1704.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1704.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1704.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1704.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1704.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1704.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1704.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1704.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1704.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1704.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1704.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1704.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1704.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1704.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1704.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1704.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1704.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1704.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1704.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1704.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1704.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1704.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1704.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1704.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1704.2 +013200 01 WRK-NE-2 PIC $**.99. NC1704.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1704.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1704.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1704.2 +013600 VALUE +000000000000000001. NC1704.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1704.2 +013800 VALUE -000000000000000033. NC1704.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014000 VALUE 666666666666666666. NC1704.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014200 VALUE 009999999999999999. NC1704.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014400 VALUE 000022222222222222. NC1704.2 +014500 01 MULTIPLY-DATA. NC1704.2 +014600 02 MULT1 PICTURE IS 999V99 NC1704.2 +014700 VALUE IS 80.12. NC1704.2 +014800 02 MULT2 PICTURE IS 999V999. NC1704.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1704.2 +015000 02 MULT4 PICTURE IS S99 NC1704.2 +015100 VALUE IS -56. NC1704.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1704.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1704.2 +015400 20. NC1704.2 +015500 01 DIVIDE-DATA. NC1704.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1704.2 +015700 VALUE IS 1620.36. NC1704.2 +015800 02 DIV2 PICTURE IS 99V9 NC1704.2 +015900 VALUE IS 44.1. NC1704.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1704.2 +016100 VALUE IS 1661.7. NC1704.2 +016200 02 DIV4 PICTURE IS S9V999 NC1704.2 +016300 VALUE IS -9.642. NC1704.2 +016400 02 DIV-02LEVEL-1. NC1704.2 +016500 03 DIV5 PICTURE IS V99 NC1704.2 +016600 VALUE IS .82. NC1704.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1704.2 +016800 03 DIV7 PICTURE IS 9V9 NC1704.2 +016900 VALUE IS 9.6. NC1704.2 +017000 01 DIV-DATA-2. NC1704.2 +017100 02 DIV8 PICTURE IS 99V9. NC1704.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1704.2 +017300 02 DIV10 PICTURE IS V999. NC1704.2 +017400 01 TEST-RESULTS. NC1704.2 +017500 02 FILLER PIC X VALUE SPACE. NC1704.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1704.2 +017700 02 FILLER PIC X VALUE SPACE. NC1704.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1704.2 +017900 02 FILLER PIC X VALUE SPACE. NC1704.2 +018000 02 PAR-NAME. NC1704.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1704.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1704.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1704.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1704.2 +018500 02 RE-MARK PIC X(61). NC1704.2 +018600 01 TEST-COMPUTED. NC1704.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1704.2 +018800 02 FILLER PIC X(17) VALUE NC1704.2 +018900 " COMPUTED=". NC1704.2 +019000 02 COMPUTED-X. NC1704.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1704.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1704.2 +019300 PIC -9(9).9(9). NC1704.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1704.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1704.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1704.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1704.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1704.2 +019900 04 FILLER PIC X. NC1704.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1704.2 +020100 01 TEST-CORRECT. NC1704.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1704.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1704.2 +020400 02 CORRECT-X. NC1704.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1704.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1704.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1704.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1704.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1704.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1704.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1704.2 +021200 04 FILLER PIC X. NC1704.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1704.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1704.2 +021500 01 CCVS-C-1. NC1704.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1704.2 +021700- "SS PARAGRAPH-NAME NC1704.2 +021800- " REMARKS". NC1704.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1704.2 +022000 01 CCVS-C-2. NC1704.2 +022100 02 FILLER PIC X VALUE SPACE. NC1704.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1704.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1704.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1704.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1704.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1704.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1704.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1704.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1704.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1704.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1704.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1704.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1704.2 +023700 01 CCVS-H-1. NC1704.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1704.2 +023900 02 FILLER PIC X(42) VALUE NC1704.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1704.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1704.2 +024200 01 CCVS-H-2A. NC1704.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1704.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1704.2 +024500 02 FILLER PIC XXXX VALUE NC1704.2 +024600 "4.2 ". NC1704.2 +024700 02 FILLER PIC X(28) VALUE NC1704.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1704.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1704.2 +025000 NC1704.2 +025100 01 CCVS-H-2B. NC1704.2 +025200 02 FILLER PIC X(15) VALUE NC1704.2 +025300 "TEST RESULT OF ". NC1704.2 +025400 02 TEST-ID PIC X(9). NC1704.2 +025500 02 FILLER PIC X(4) VALUE NC1704.2 +025600 " IN ". NC1704.2 +025700 02 FILLER PIC X(12) VALUE NC1704.2 +025800 " HIGH ". NC1704.2 +025900 02 FILLER PIC X(22) VALUE NC1704.2 +026000 " LEVEL VALIDATION FOR ". NC1704.2 +026100 02 FILLER PIC X(58) VALUE NC1704.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +026300 01 CCVS-H-3. NC1704.2 +026400 02 FILLER PIC X(34) VALUE NC1704.2 +026500 " FOR OFFICIAL USE ONLY ". NC1704.2 +026600 02 FILLER PIC X(58) VALUE NC1704.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1704.2 +026800 02 FILLER PIC X(28) VALUE NC1704.2 +026900 " COPYRIGHT 1985 ". NC1704.2 +027000 01 CCVS-E-1. NC1704.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1704.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1704.2 +027300 02 ID-AGAIN PIC X(9). NC1704.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1704.2 +027500 01 CCVS-E-2. NC1704.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1704.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1704.2 +027800 02 CCVS-E-2-2. NC1704.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1704.2 +028000 03 FILLER PIC X VALUE SPACE. NC1704.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1704.2 +028200 "ERRORS ENCOUNTERED". NC1704.2 +028300 01 CCVS-E-3. NC1704.2 +028400 02 FILLER PIC X(22) VALUE NC1704.2 +028500 " FOR OFFICIAL USE ONLY". NC1704.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1704.2 +028700 02 FILLER PIC X(58) VALUE NC1704.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1704.2 +029000 02 FILLER PIC X(15) VALUE NC1704.2 +029100 " COPYRIGHT 1985". NC1704.2 +029200 01 CCVS-E-4. NC1704.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1704.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1704.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1704.2 +029600 02 FILLER PIC X(40) VALUE NC1704.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1704.2 +029800 01 XXINFO. NC1704.2 +029900 02 FILLER PIC X(19) VALUE NC1704.2 +030000 "*** INFORMATION ***". NC1704.2 +030100 02 INFO-TEXT. NC1704.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1704.2 +030300 04 XXCOMPUTED PIC X(20). NC1704.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1704.2 +030500 04 XXCORRECT PIC X(20). NC1704.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1704.2 +030700 01 HYPHEN-LINE. NC1704.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1704.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1704.2 +031000- "*****************************************". NC1704.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1704.2 +031200- "******************************". NC1704.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1704.2 +031400 "NC170A". NC1704.2 +031500 PROCEDURE DIVISION. NC1704.2 +031600 CCVS1 SECTION. NC1704.2 +031700 OPEN-FILES. NC1704.2 +031800 OPEN OUTPUT PRINT-FILE. NC1704.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1704.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1704.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1704.2 +032200 GO TO CCVS1-EXIT. NC1704.2 +032300 CLOSE-FILES. NC1704.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1704.2 +032500 TERMINATE-CCVS. NC1704.2 +032600S EXIT PROGRAM. NC1704.2 +032700STERMINATE-CALL. NC1704.2 +032800 STOP RUN. NC1704.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1704.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1704.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1704.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1704.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1704.2 +033400 PRINT-DETAIL. NC1704.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1704.2 +033600 MOVE "." TO PARDOT-X NC1704.2 +033700 MOVE REC-CT TO DOTVALUE. NC1704.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1704.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1704.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1704.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1704.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1704.2 +034300 MOVE SPACE TO CORRECT-X. NC1704.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1704.2 +034500 MOVE SPACE TO RE-MARK. NC1704.2 +034600 HEAD-ROUTINE. NC1704.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1704.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1704.2 +035100 COLUMN-NAMES-ROUTINE. NC1704.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +035500 END-ROUTINE. NC1704.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1704.2 +035700 END-RTN-EXIT. NC1704.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +035900 END-ROUTINE-1. NC1704.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1704.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1704.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1704.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1704.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1704.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1704.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1704.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1704.2 +036800 END-ROUTINE-12. NC1704.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1704.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1704.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1704.2 +037200 ELSE NC1704.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1704.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1704.2 +037500 PERFORM WRITE-LINE. NC1704.2 +037600 END-ROUTINE-13. NC1704.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1704.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1704.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1704.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1704.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1704.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1704.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1704.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1704.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038800 WRITE-LINE. NC1704.2 +038900 ADD 1 TO RECORD-COUNT. NC1704.2 +039000Y IF RECORD-COUNT GREATER 42 NC1704.2 +039100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1704.2 +039200Y MOVE SPACE TO DUMMY-RECORD NC1704.2 +039300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1704.2 +039400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1704.2 +039500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1704.2 +039600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1704.2 +039700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1704.2 +039800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +039900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +040000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +040100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1704.2 +040200Y MOVE ZERO TO RECORD-COUNT. NC1704.2 +040300 PERFORM WRT-LN. NC1704.2 +040400 WRT-LN. NC1704.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1704.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1704.2 +040700 BLANK-LINE-PRINT. NC1704.2 +040800 PERFORM WRT-LN. NC1704.2 +040900 FAIL-ROUTINE. NC1704.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1704.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1704.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1704.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1704.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1704.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1704.2 +041700 GO TO FAIL-ROUTINE-EX. NC1704.2 +041800 FAIL-ROUTINE-WRITE. NC1704.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1704.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1704.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1704.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1704.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1704.2 +042400 BAIL-OUT. NC1704.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1704.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1704.2 +042700 BAIL-OUT-WRITE. NC1704.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1704.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1704.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1704.2 +043200 BAIL-OUT-EX. EXIT. NC1704.2 +043300 CCVS1-EXIT. NC1704.2 +043400 EXIT. NC1704.2 +043500 SECT-NC170A-001 SECTION. NC1704.2 +043600 NC1704.2 +043700 MPY-INIT-F2-1. NC1704.2 +043800 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +043900 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1704.2 +044000 MOVE 80.12 TO MULT1. NC1704.2 +044100 MOVE ZERO TO MULT2. NC1704.2 +044200 MPY-TEST-F2-1-0. NC1704.2 +044300 MULTIPLY MULT1 BY 4.3 GIVING MULT2. NC1704.2 +044400 MPY-TEST-F2-1-1. NC1704.2 +044500 IF MULT2 NOT EQUAL TO 344.516 NC1704.2 +044600 GO TO MPY-FAIL-F2-1-1. NC1704.2 +044700 PERFORM PASS NC1704.2 +044800 GO TO MPY-WRITE-F2-1-1. NC1704.2 +044900 MPY-DELETE-F2-1-1. NC1704.2 +045000 PERFORM DE-LETE. NC1704.2 +045100 GO TO MPY-WRITE-F2-1-1. NC1704.2 +045200 MPY-FAIL-F2-1-1. NC1704.2 +045300 PERFORM FAIL. NC1704.2 +045400 MOVE MULT2 TO COMPUTED-N. NC1704.2 +045500 MOVE +344.516 TO CORRECT-N. NC1704.2 +045600 MPY-WRITE-F2-1-1. NC1704.2 +045700 MOVE "MPY-TEST-F2-1-1" TO PAR-NAME. NC1704.2 +045800 PERFORM PRINT-DETAIL. NC1704.2 +045900 NC1704.2 +046000 MPY-INIT-F2-2. NC1704.2 +046100 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +046200 MOVE 80.12 TO MULT1. NC1704.2 +046300 MOVE ZERO TO MULT3. NC1704.2 +046400 MPY-TEST-F2-2-0. NC1704.2 +046500 MULTIPLY .9 BY MULT1 GIVING MULT3 ROUNDED. NC1704.2 +046600 MPY-TEST-F2-2-1. NC1704.2 +046700 IF MULT3 NOT EQUAL TO " $72.11" NC1704.2 +046800 GO TO MPY-FAIL-F2-2-1. NC1704.2 +046900 PERFORM PASS. NC1704.2 +047000 GO TO MPY-WRITE-F2-2-1. NC1704.2 +047100 MPY-DELETE-F2-2-1. NC1704.2 +047200 PERFORM DE-LETE. NC1704.2 +047300 GO TO MPY-WRITE-F2-2-1. NC1704.2 +047400 MPY-FAIL-F2-2-1. NC1704.2 +047500 PERFORM FAIL. NC1704.2 +047600 MOVE MULT3 TO COMPUTED-A. NC1704.2 +047700 MOVE " $72.11" TO CORRECT-A. NC1704.2 +047800 MPY-WRITE-F2-2-1. NC1704.2 +047900 MOVE "MPY-TEST-F2-2-1" TO PAR-NAME. NC1704.2 +048000 PERFORM PRINT-DETAIL. NC1704.2 +048100 NC1704.2 +048200 MPY-INIT-F2-3. NC1704.2 +048300 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +048400 MOVE 80.12 TO MULT1. NC1704.2 +048500 MOVE -56 TO MULT4. NC1704.2 +048600 MOVE 4 TO MULT5. NC1704.2 +048700 MOVE "A" TO XRAY. NC1704.2 +048800 MPY-TEST-F2-3-0. NC1704.2 +048900 MULTIPLY MULT4 BY MULT1 GIVING MULT5 ON SIZE ERROR NC1704.2 +049000 MOVE "H" TO XRAY. NC1704.2 +049100 MPY-TEST-F2-3-1. NC1704.2 +049200 IF XRAY EQUAL TO "H" NC1704.2 +049300 PERFORM PASS NC1704.2 +049400 ELSE NC1704.2 +049500 GO TO MPY-FAIL-F2-3-1. NC1704.2 +049600 GO TO MPY-WRITE-F2-3-1. NC1704.2 +049700 MPY-DELETE-F2-3-1. NC1704.2 +049800 PERFORM DE-LETE. NC1704.2 +049900 GO TO MPY-WRITE-F2-3-1. NC1704.2 +050000 MPY-FAIL-F2-3-1. NC1704.2 +050100 MOVE XRAY TO COMPUTED-X. NC1704.2 +050200 MOVE "H" TO CORRECT-X. NC1704.2 +050300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +050400 PERFORM FAIL. NC1704.2 +050500 MPY-WRITE-F2-3-1. NC1704.2 +050600 MOVE "MPY-TEST-F2-3-1 " TO PAR-NAME. NC1704.2 +050700 PERFORM PRINT-DETAIL. NC1704.2 +050800 MPY-TEST-F2-3-2. NC1704.2 +050900 IF MULT5 NOT EQUAL TO 4 NC1704.2 +051000 GO TO MPY-FAIL-F2-3-2. NC1704.2 +051100 PERFORM PASS. NC1704.2 +051200 GO TO MPY-WRITE-F2-3-2. NC1704.2 +051300 MPY-DELETE-F2-3-2. NC1704.2 +051400 PERFORM DE-LETE. NC1704.2 +051500 GO TO MPY-WRITE-F2-3-2. NC1704.2 +051600 MPY-FAIL-F2-3-2. NC1704.2 +051700 PERFORM FAIL. NC1704.2 +051800 MOVE MULT5 TO COMPUTED-N. NC1704.2 +051900 MOVE +4 TO CORRECT-N. NC1704.2 +052000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +052100 MPY-WRITE-F2-3-2. NC1704.2 +052200 MOVE "MPY-TEST-F2-3-2 " TO PAR-NAME. NC1704.2 +052300 PERFORM PRINT-DETAIL. NC1704.2 +052400 NC1704.2 +052500 MPY-INIT-F2-4. NC1704.2 +052600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +052700 MOVE 80.12 TO MULT1. NC1704.2 +052800 MOVE "A" TO XRAY. NC1704.2 +052900 MOVE 4 TO MULT5. NC1704.2 +053000 MPY-TEST-F2-4-0. NC1704.2 +053100 MULTIPLY 3.3 BY -3 GIVING MULT5 ROUNDED ON SIZE ERROR NC1704.2 +053200 MOVE "J" TO XRAY. NC1704.2 +053300 MPY-TEST-F2-4-1. NC1704.2 +053400 IF XRAY NOT EQUAL TO "J" NC1704.2 +053500 GO TO MPY-FAIL-F2-4-1 NC1704.2 +053600 ELSE NC1704.2 +053700 PERFORM PASS. NC1704.2 +053800 GO TO MPY-WRITE-F2-4-1. NC1704.2 +053900 MPY-DELETE-F2-4-1. NC1704.2 +054000 PERFORM DE-LETE. NC1704.2 +054100 GO TO MPY-WRITE-F2-4-1. NC1704.2 +054200 MPY-FAIL-F2-4-1. NC1704.2 +054300 MOVE XRAY TO COMPUTED-X. NC1704.2 +054400 MOVE "J" TO CORRECT-X. NC1704.2 +054500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +054600 PERFORM FAIL. NC1704.2 +054700 MPY-WRITE-F2-4-1. NC1704.2 +054800 MOVE "MPY-TEST-F2-4-1 " TO PAR-NAME. NC1704.2 +054900 PERFORM PRINT-DETAIL. NC1704.2 +055000 MPY-TEST-F2-4-2. NC1704.2 +055100 IF MULT5 EQUAL TO 4 NC1704.2 +055200 PERFORM PASS NC1704.2 +055300 ELSE NC1704.2 +055400 GO TO MPY-FAIL-F2-4-2. NC1704.2 +055500 GO TO MPY-WRITE-F2-4-2. NC1704.2 +055600 MPY-DELETE-F2-4-2. NC1704.2 +055700 PERFORM DE-LETE. NC1704.2 +055800 GO TO MPY-WRITE-F2-4-2. NC1704.2 +055900 MPY-FAIL-F2-4-2. NC1704.2 +056000 PERFORM FAIL. NC1704.2 +056100 MOVE MULT5 TO COMPUTED-N. NC1704.2 +056200 MOVE +4 TO CORRECT-N. NC1704.2 +056300 MOVE 4 TO MULT5. NC1704.2 +056400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +056500 MPY-WRITE-F2-4-2. NC1704.2 +056600 MOVE "MPY-TEST-F2-4-2 " TO PAR-NAME. NC1704.2 +056700 PERFORM PRINT-DETAIL. NC1704.2 +056800 NC1704.2 +056900 MPY-INIT-F2-5. NC1704.2 +057000 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +057100 MOVE ZERO TO WRK-DS-09V09. NC1704.2 +057200 MPY-TEST-F2-5-0. NC1704.2 +057300 MULTIPLY A06THREES-DS-03V03 BY A12THREES-DS-06V06 NC1704.2 +057400 GIVING WRK-DS-09V09. NC1704.2 +057500 MPY-TEST-F2-5-1. NC1704.2 +057600 IF WRK-DS-18V00-S EQUAL TO 111110999999888889 NC1704.2 +057700 PERFORM PASS NC1704.2 +057800 GO TO MPY-WRITE-F2-5. NC1704.2 +057900 GO TO MPY-FAIL-F2-5. NC1704.2 +058000 MPY-DELETE-F2-5. NC1704.2 +058100 PERFORM DE-LETE. NC1704.2 +058200 GO TO MPY-WRITE-F2-5. NC1704.2 +058300 MPY-FAIL-F2-5. NC1704.2 +058400 MOVE 111110999999888889 TO CORRECT-18V0. NC1704.2 +058500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1704.2 +058600 PERFORM FAIL. NC1704.2 +058700 MPY-WRITE-F2-5. NC1704.2 +058800 MOVE "MPY-TEST-F2-5 " TO PAR-NAME. NC1704.2 +058900 PERFORM PRINT-DETAIL. NC1704.2 +059000 NC1704.2 +059100 MPY-INIT-F2-6. NC1704.2 +059200 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +059300 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +059400 MPY-TEST-F2-6-0. NC1704.2 +059500 MULTIPLY A06THREES-DS-03V03 BY A06THREES-DS-03V03 NC1704.2 +059600 GIVING WRK-DS-10V00 ROUNDED. NC1704.2 +059700 MPY-TEST-F2-6. NC1704.2 +059800 IF WRK-DS-10V00 EQUAL TO 0000111111 NC1704.2 +059900 PERFORM PASS NC1704.2 +060000 GO TO MPY-WRITE-F2-6. NC1704.2 +060100 GO TO MPY-FAIL-F2-6. NC1704.2 +060200 MPY-DELETE-F2-6. NC1704.2 +060300 PERFORM DE-LETE. NC1704.2 +060400 GO TO MPY-WRITE-F2-6. NC1704.2 +060500 MPY-FAIL-F2-6. NC1704.2 +060600 MOVE 0000111111 TO CORRECT-18V0. NC1704.2 +060700 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +060800 PERFORM FAIL. NC1704.2 +060900 MPY-WRITE-F2-6. NC1704.2 +061000 MOVE "MPY-TEST-F2-6 " TO PAR-NAME. NC1704.2 +061100 PERFORM PRINT-DETAIL. NC1704.2 +061200 NC1704.2 +061300 MPY-INIT-F2-7. NC1704.2 +061400 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +061500 MOVE "0" TO WRK-XN-00001. NC1704.2 +061600 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +061700 MPY-TEST-F2-7-0. NC1704.2 +061800 MULTIPLY A05ONES-DS-00V05 BY A12ONES-DS-12V00 NC1704.2 +061900 GIVING WRK-DS-10V00 NC1704.2 +062000 ON SIZE ERROR NC1704.2 +062100 MOVE "1" TO WRK-XN-00001. NC1704.2 +062200 MPY-TEST-F2-7-1. NC1704.2 +062300 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1704.2 +062400 PERFORM PASS NC1704.2 +062500 GO TO MPY-WRITE-F2-7-1. NC1704.2 +062600 GO TO MPY-FAIL-F2-7-1. NC1704.2 +062700 MPY-DELETE-F2-7-1. NC1704.2 +062800 PERFORM DE-LETE. NC1704.2 +062900 GO TO MPY-WRITE-F2-7-1. NC1704.2 +063000 MPY-FAIL-F2-7-1. NC1704.2 +063100 MOVE 0000000000 TO CORRECT-18V0. NC1704.2 +063200 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +063300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +063400 PERFORM FAIL. NC1704.2 +063500 MPY-WRITE-F2-7-1. NC1704.2 +063600 MOVE "MPY-TEST-F2-7-1 " TO PAR-NAME. NC1704.2 +063700 PERFORM PRINT-DETAIL. NC1704.2 +063800 MPY-TEST-F2-7-2. NC1704.2 +063900 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +064000 PERFORM PASS NC1704.2 +064100 GO TO MPY-WRITE-F2-7-2. NC1704.2 +064200 MOVE "1" TO CORRECT-A. NC1704.2 +064300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +064400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +064500 PERFORM FAIL. NC1704.2 +064600 GO TO MPY-WRITE-F2-7-2. NC1704.2 +064700 MPY-DELETE-F2-7-2. NC1704.2 +064800 PERFORM DE-LETE. NC1704.2 +064900 MPY-WRITE-F2-7-2. NC1704.2 +065000 MOVE "MPY-TEST-F2-7-2 " TO PAR-NAME. NC1704.2 +065100 PERFORM PRINT-DETAIL. NC1704.2 +065200 NC1704.2 +065300 MPY-INIT-F2-8. NC1704.2 +065400 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +065500 MOVE "1" TO WRK-XN-00001. NC1704.2 +065600 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +065700 MPY-TEST-F2-8-0. NC1704.2 +065800 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +065900 GIVING WRK-DS-10V00 ON SIZE ERROR NC1704.2 +066000 MOVE "0" TO WRK-XN-00001. NC1704.2 +066100 MPY-TEST-F2-8-1. NC1704.2 +066200 IF WRK-DS-10V00 EQUAL TO 0000000111 NC1704.2 +066300 PERFORM PASS NC1704.2 +066400 GO TO MPY-WRITE-F2-8-1. NC1704.2 +066500 GO TO MPY-FAIL-F2-8-1. NC1704.2 +066600 MPY-DELETE-F2-8-1. NC1704.2 +066700 PERFORM DE-LETE. NC1704.2 +066800 GO TO MPY-WRITE-F2-8-1. NC1704.2 +066900 MPY-FAIL-F2-8-1. NC1704.2 +067000 MOVE 0000000111 TO CORRECT-18V0. NC1704.2 +067100 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +067200 PERFORM FAIL. NC1704.2 +067300 MPY-WRITE-F2-8-1. NC1704.2 +067400 MOVE "MPY-TEST-F2-8-1 " TO PAR-NAME. NC1704.2 +067500 PERFORM PRINT-DETAIL. NC1704.2 +067600 MPY-TEST-F2-8-2. NC1704.2 +067700 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +067800 PERFORM PASS NC1704.2 +067900 GO TO MPY-WRITE-F2-8-2. NC1704.2 +068000 MOVE "1" TO CORRECT-A. NC1704.2 +068100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +068200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1704.2 +068300 PERFORM FAIL. NC1704.2 +068400 GO TO MPY-WRITE-F2-8-2. NC1704.2 +068500 MPY-DELETE-F2-8-2. NC1704.2 +068600 PERFORM DE-LETE. NC1704.2 +068700 MPY-WRITE-F2-8-2. NC1704.2 +068800 MOVE "MPY-TEST-F2-8-2 " TO PAR-NAME. NC1704.2 +068900 PERFORM PRINT-DETAIL. NC1704.2 +069000 NC1704.2 +069100 MPY-INIT-F2-9. NC1704.2 +069200 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +069300 MOVE "0" TO WRK-XN-00001. NC1704.2 +069400 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +069500 MPY-TEST-F2-9-0. NC1704.2 +069600 MULTIPLY 9.5 BY A10ONES-DS-10V00 NC1704.2 +069700 GIVING WRK-DS-10V00 ROUNDED ON SIZE ERROR NC1704.2 +069800 MOVE "1" TO WRK-XN-00001. NC1704.2 +069900 MPY-TEST-F2-9-1. NC1704.2 +070000 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1704.2 +070100 PERFORM PASS NC1704.2 +070200 GO TO MPY-WRITE-F2-9-1. NC1704.2 +070300 MOVE 0000000000 TO CORRECT-18V0. NC1704.2 +070400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +070500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +070600 PERFORM FAIL. NC1704.2 +070700 GO TO MPY-WRITE-F2-9-1. NC1704.2 +070800 MPY-DELETE-F2-9-1. NC1704.2 +070900 PERFORM DE-LETE. NC1704.2 +071000 MPY-WRITE-F2-9-1. NC1704.2 +071100 MOVE "MPY-TEST-F2-9-1 " TO PAR-NAME. NC1704.2 +071200 PERFORM PRINT-DETAIL. NC1704.2 +071300 MPY-TEST-F2-9-2. NC1704.2 +071400 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +071500 PERFORM PASS NC1704.2 +071600 GO TO MPY-WRITE-F2-9-2. NC1704.2 +071700 MPY-FAIL-F2-9-2. NC1704.2 +071800 MOVE "1" TO CORRECT-A. NC1704.2 +071900 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +072000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +072100 PERFORM FAIL. NC1704.2 +072200 GO TO MPY-WRITE-F2-9-2. NC1704.2 +072300 MPY-DELETE-F2-9-2. NC1704.2 +072400 PERFORM DE-LETE. NC1704.2 +072500 MPY-WRITE-F2-9-2. NC1704.2 +072600 MOVE "MPY-TEST-F2-9-2 " TO PAR-NAME. NC1704.2 +072700 PERFORM PRINT-DETAIL. NC1704.2 +072800 NC1704.2 +072900 MPY-INIT-F2-10-1. NC1704.2 +073000 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +073100 MOVE "1" TO WRK-XN-00001. NC1704.2 +073200 MOVE ZERO TO WRK-DS-09V08. NC1704.2 +073300 MPY-TEST-F2-10-0. NC1704.2 +073400 MULTIPLY A01ONE-DS-P0801 BY A18ONES-DS-18V00 NC1704.2 +073500 GIVING WRK-DS-09V08 ROUNDED ON SIZE ERROR NC1704.2 +073600 MOVE "0" TO WRK-XN-00001. NC1704.2 +073700 MPY-TEST-F2-10-1. NC1704.2 +073800 IF WRK-DS-17V00-S EQUAL TO 11111111111111111 NC1704.2 +073900 PERFORM PASS NC1704.2 +074000 GO TO MPY-WRITE-F2-10-1. NC1704.2 +074100 MOVE 11111111111111111 TO CORRECT-18V0. NC1704.2 +074200 MOVE WRK-DS-17V00-S TO COMPUTED-18V0. NC1704.2 +074300 PERFORM FAIL. NC1704.2 +074400 GO TO MPY-WRITE-F2-10-1. NC1704.2 +074500 MPY-DELETE-F2-10-1. NC1704.2 +074600 PERFORM DE-LETE. NC1704.2 +074700 MPY-WRITE-F2-10-1. NC1704.2 +074800 MOVE "MPY-TEST-F2-10-1 " TO PAR-NAME. NC1704.2 +074900 PERFORM PRINT-DETAIL. NC1704.2 +075000 MPY-TEST-F2-10-2. NC1704.2 +075100 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +075200 PERFORM PASS NC1704.2 +075300 GO TO MPY-WRITE-F2-10-2. NC1704.2 +075400 MOVE "1" TO CORRECT-A. NC1704.2 +075500 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +075600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1704.2 +075700 PERFORM FAIL. NC1704.2 +075800 GO TO MPY-WRITE-F2-10-2. NC1704.2 +075900 MPY-DELETE-F2-10-2. NC1704.2 +076000 PERFORM DE-LETE. NC1704.2 +076100 MPY-WRITE-F2-10-2. NC1704.2 +076200 MOVE "MPY-TEST-F2-10-2 " TO PAR-NAME. NC1704.2 +076300 PERFORM PRINT-DETAIL. NC1704.2 +076400 NC1704.2 +076500 MPY-INIT-F2-11. NC1704.2 +076600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +076700 MOVE ZERO TO WRK-CS-02V02. NC1704.2 +076800 MPY-TEST-F2-11-0. NC1704.2 +076900 MULTIPLY A99-CS-02V00 BY A01ONE-CS-00V01 GIVING WRK-CS-02V02.NC1704.2 +077000 MPY-TEST-F2-11-1. NC1704.2 +077100 MOVE WRK-CS-02V02 TO WRK-DS-06V06. NC1704.2 +077200 IF WRK-DS-12V00-S EQUAL TO 000009900000 NC1704.2 +077300 PERFORM PASS NC1704.2 +077400 GO TO MPY-WRITE-F2-11. NC1704.2 +077500 MOVE 000009900000 TO CORRECT-18V0. NC1704.2 +077600 MOVE WRK-DS-12V00-S TO COMPUTED-18V0. NC1704.2 +077700 PERFORM FAIL. NC1704.2 +077800 GO TO MPY-WRITE-F2-11. NC1704.2 +077900 MPY-DELETE-F2-11. NC1704.2 +078000 PERFORM DE-LETE. NC1704.2 +078100 MPY-WRITE-F2-11. NC1704.2 +078200 MOVE "MPY-TEST-F2-11 " TO PAR-NAME. NC1704.2 +078300 PERFORM PRINT-DETAIL. NC1704.2 +078400 NC1704.2 +078500 MPY-INIT-F2-12. NC1704.2 +078600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +078700 MOVE ZERO TO WRK-CS-18V00. NC1704.2 +078800 MPY-TEST-F2-12-0. NC1704.2 +078900 MULTIPLY A01ONES-CS-18V00 BY A02THREES-CS-18V00 NC1704.2 +079000 GIVING WRK-CS-18V00. NC1704.2 +079100 MPY-TEST-F2-12-1. NC1704.2 +079200 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1704.2 +079300 PERFORM PASS NC1704.2 +079400 GO TO MPY-WRITE-F2-12. NC1704.2 +079500 MOVE -000000000000000033 TO CORRECT-18V0. NC1704.2 +079600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1704.2 +079700 PERFORM FAIL. NC1704.2 +079800 GO TO MPY-WRITE-F2-12. NC1704.2 +079900 MPY-DELETE-F2-12. NC1704.2 +080000 PERFORM DE-LETE. NC1704.2 +080100 MPY-WRITE-F2-12. NC1704.2 +080200 MOVE "MPY-TEST-F2-12 " TO PAR-NAME. NC1704.2 +080300 PERFORM PRINT-DETAIL. NC1704.2 +080400 NC1704.2 +080500 MPY-INIT-F2-13. NC1704.2 +080600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +080700 MOVE ZERO TO WRK-DU-18V00. NC1704.2 +080800 MPY-TEST-F2-13-0. NC1704.2 +080900 MULTIPLY A02THREES-CS-18V00 BY A14TWOS-CU-18V00 NC1704.2 +081000 GIVING WRK-DU-18V00. NC1704.2 +081100 MPY-TEST-F2-13. NC1704.2 +081200 IF WRK-DU-18V00 EQUAL TO 000733333333333326 NC1704.2 +081300 PERFORM PASS NC1704.2 +081400 GO TO MPY-WRITE-F2-13. NC1704.2 +081500 MOVE 000733333333333326 TO CORRECT-18V0. NC1704.2 +081600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1704.2 +081700 PERFORM FAIL. NC1704.2 +081800 GO TO MPY-WRITE-F2-13. NC1704.2 +081900 MPY-DELETE-F2-13. NC1704.2 +082000 PERFORM DE-LETE. NC1704.2 +082100 MPY-WRITE-F2-13. NC1704.2 +082200 MOVE "MPY-TEST-F2-13 " TO PAR-NAME. NC1704.2 +082300 PERFORM PRINT-DETAIL. NC1704.2 +082400 NC1704.2 +082500 MPY-INIT-F2-14. NC1704.2 +082600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +082700 MOVE ZERO TO WRK-CS-18V00. NC1704.2 +082800 MPY-TEST-F2-14-0. NC1704.2 +082900 MULTIPLY A02THREES-CS-18V00 BY A16NINES-CU-18V00 NC1704.2 +083000 GIVING WRK-CS-18V00. NC1704.2 +083100 MPY-TEST-F2-14. NC1704.2 +083200 IF WRK-CS-18V00 EQUAL TO -329999999999999967 NC1704.2 +083300 PERFORM PASS NC1704.2 +083400 GO TO MPY-WRITE-F2-14. NC1704.2 +083500 MOVE -329999999999999967 TO CORRECT-18V0. NC1704.2 +083600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1704.2 +083700 PERFORM FAIL. NC1704.2 +083800 GO TO MPY-WRITE-F2-14. NC1704.2 +083900 MPY-DELETE-F2-14. NC1704.2 +084000 PERFORM DE-LETE. NC1704.2 +084100 MPY-WRITE-F2-14. NC1704.2 +084200 MOVE "MPY-TEST-F2-14 " TO PAR-NAME. NC1704.2 +084300 PERFORM PRINT-DETAIL. NC1704.2 +084400 NC1704.2 +084500 MPY-INIT-F2-15. NC1704.2 +084600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +084700 MOVE ZERO TO WRK-DU-18V00. NC1704.2 +084800 MPY-TEST-F2-15-0. NC1704.2 +084900 MULTIPLY A01ONES-CS-18V00 BY A18SIXES-CU-18V00 NC1704.2 +085000 GIVING WRK-DU-18V00. NC1704.2 +085100 MPY-TEST-F2-15. NC1704.2 +085200 IF WRK-DU-18V00 EQUAL TO 666666666666666666 NC1704.2 +085300 PERFORM PASS NC1704.2 +085400 GO TO MPY-WRITE-F2-15. NC1704.2 +085500 MOVE 666666666666666666 TO CORRECT-18V0. NC1704.2 +085600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1704.2 +085700 PERFORM FAIL. NC1704.2 +085800 GO TO MPY-WRITE-F2-15. NC1704.2 +085900 MPY-DELETE-F2-15. NC1704.2 +086000 PERFORM DE-LETE. NC1704.2 +086100 MPY-WRITE-F2-15. NC1704.2 +086200 MOVE "MPY-TEST-F2-15 " TO PAR-NAME. NC1704.2 +086300 PERFORM PRINT-DETAIL. NC1704.2 +086400* NC1704.2 +086500* NC1704.2 +086600 MPY-INIT-F2-16. NC1704.2 +086700* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +086800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +086900 MOVE "H" TO XRAY. NC1704.2 +087000 MOVE 80.12 TO MULT1. NC1704.2 +087100 MOVE -56 TO MULT4. NC1704.2 +087200 MOVE 0 TO MULT5. NC1704.2 +087300 MOVE 1 TO REC-CT. NC1704.2 +087400 MPY-TEST-F2-16-0. NC1704.2 +087500 MULTIPLY MULT4 BY MULT1 GIVING MULT5 NC1704.2 +087600 NOT ON SIZE ERROR MOVE "X" TO XRAY. NC1704.2 +087700 MPY-TEST-F2-16-1. NC1704.2 +087800 GO TO MPY-TEST-F2-16-2. NC1704.2 +087900 MPY-DELETE-F2-16-1. NC1704.2 +088000 PERFORM DE-LETE. NC1704.2 +088100 PERFORM PRINT-DETAIL. NC1704.2 +088200 GO TO MPY-INIT-F2-17. NC1704.2 +088300 MPY-TEST-F2-16-2. NC1704.2 +088400 MOVE "MPY-TEST-F2-16-2 " TO PAR-NAME. NC1704.2 +088500 IF XRAY = "H" NC1704.2 +088600 PERFORM PASS NC1704.2 +088700 PERFORM PRINT-DETAIL NC1704.2 +088800 ELSE NC1704.2 +088900 MOVE XRAY TO COMPUTED-X NC1704.2 +089000 MOVE "H" TO CORRECT-X NC1704.2 +089100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +089200 PERFORM FAIL NC1704.2 +089300 PERFORM PRINT-DETAIL. NC1704.2 +089400 ADD 1 TO REC-CT. NC1704.2 +089500 MPY-TEST-F2-16-3. NC1704.2 +089600 MOVE "MPY-TEST-F2-16-3 " TO PAR-NAME. NC1704.2 +089700 IF MULT5 = 0 NC1704.2 +089800 PERFORM PASS NC1704.2 +089900 PERFORM PRINT-DETAIL NC1704.2 +090000 ELSE NC1704.2 +090100 MOVE MULT5 TO COMPUTED-N NC1704.2 +090200 MOVE 0 TO CORRECT-N NC1704.2 +090300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +090400 PERFORM FAIL NC1704.2 +090500 PERFORM PRINT-DETAIL. NC1704.2 +090600* NC1704.2 +090700* NC1704.2 +090800 MPY-INIT-F2-17. NC1704.2 +090900* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +091000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +091100 MOVE "1" TO WRK-XN-00001. NC1704.2 +091200 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +091300 MOVE 1 TO REC-CT. NC1704.2 +091400 MPY-TEST-F2-17-0. NC1704.2 +091500 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +091600 GIVING WRK-DS-10V00 NC1704.2 +091700 NOT ON SIZE ERROR NC1704.2 +091800 MOVE "0" TO WRK-XN-00001. NC1704.2 +091900 MPY-TEST-F2-17-1. NC1704.2 +092000 GO TO MPY-TEST-F2-17-2. NC1704.2 +092100 MPY-DELETE-F2-17. NC1704.2 +092200 PERFORM DE-LETE. NC1704.2 +092300 PERFORM PRINT-DETAIL. NC1704.2 +092400 GO TO MPY-INIT-F2-18. NC1704.2 +092500 MPY-TEST-F2-17-2. NC1704.2 +092600 MOVE "MPY-TEST-F2-17-2 " TO PAR-NAME. NC1704.2 +092700 IF WRK-XN-00001 = "0" NC1704.2 +092800 PERFORM PASS NC1704.2 +092900 PERFORM PRINT-DETAIL NC1704.2 +093000 ELSE NC1704.2 +093100 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +093200 MOVE "0" TO CORRECT-X NC1704.2 +093300 MOVE "NOT ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC1704.2 +093400 TO RE-MARK NC1704.2 +093500 PERFORM FAIL NC1704.2 +093600 PERFORM PRINT-DETAIL. NC1704.2 +093700 ADD 1 TO REC-CT. NC1704.2 +093800 MPY-TEST-F2-17-3. NC1704.2 +093900 MOVE "MPY-TEST-F2-17-3 " TO PAR-NAME. NC1704.2 +094000 IF WRK-DS-10V00 = 0000000111 NC1704.2 +094100 PERFORM PASS NC1704.2 +094200 PERFORM PRINT-DETAIL NC1704.2 +094300 ELSE NC1704.2 +094400 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +094500 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +094600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +094700 PERFORM FAIL NC1704.2 +094800 PERFORM PRINT-DETAIL. NC1704.2 +094900* NC1704.2 +095000* NC1704.2 +095100 MPY-INIT-F2-18. NC1704.2 +095200* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +095300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +095400 MOVE 1 TO REC-CT. NC1704.2 +095500 MOVE 80.12 TO MULT1. NC1704.2 +095600 MOVE -56 TO MULT4. NC1704.2 +095700 MOVE 0 TO MULT5. NC1704.2 +095800 MOVE "H" TO XRAY. NC1704.2 +095900 MPY-TEST-F2-18-0. NC1704.2 +096000 MULTIPLY MULT4 BY MULT1 GIVING MULT5 NC1704.2 +096100 ON SIZE ERROR MOVE "A" TO XRAY NC1704.2 +096200 NOT ON SIZE ERROR MOVE "B" TO XRAY. NC1704.2 +096300 MPY-TEST-F2-18-1. NC1704.2 +096400 GO TO MPY-TEST-F2-18-2. NC1704.2 +096500 MPY-DELETE-F2-18. NC1704.2 +096600 PERFORM DE-LETE. NC1704.2 +096700 PERFORM PRINT-DETAIL. NC1704.2 +096800 GO TO MPY-INIT-F2-19. NC1704.2 +096900 MPY-TEST-F2-18-2. NC1704.2 +097000 MOVE "MPY-TEST-F2-18-2 " TO PAR-NAME. NC1704.2 +097100 IF XRAY = "A" NC1704.2 +097200 PERFORM PASS NC1704.2 +097300 PERFORM PRINT-DETAIL NC1704.2 +097400 ELSE NC1704.2 +097500 MOVE XRAY TO COMPUTED-X NC1704.2 +097600 MOVE "A" TO CORRECT-X NC1704.2 +097700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +097800 PERFORM FAIL NC1704.2 +097900 PERFORM PRINT-DETAIL. NC1704.2 +098000 ADD 1 TO REC-CT. NC1704.2 +098100 MPY-TEST-F2-18-3. NC1704.2 +098200 MOVE "MPY-TEST-F2-18-3 " TO PAR-NAME. NC1704.2 +098300 IF MULT5 = 0 NC1704.2 +098400 PERFORM PASS NC1704.2 +098500 PERFORM PRINT-DETAIL NC1704.2 +098600 ELSE NC1704.2 +098700 MOVE MULT5 TO COMPUTED-N NC1704.2 +098800 MOVE 0 TO CORRECT-N NC1704.2 +098900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +099000 PERFORM FAIL NC1704.2 +099100 PERFORM PRINT-DETAIL. NC1704.2 +099200* NC1704.2 +099300* NC1704.2 +099400 MPY-INIT-F2-19. NC1704.2 +099500* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +099600 MOVE 1 TO REC-CT. NC1704.2 +099700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +099800 MOVE "0" TO WRK-XN-00001. NC1704.2 +099900 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +100000 MPY-TEST-F2-19-0. NC1704.2 +100100 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +100200 GIVING WRK-DS-10V00 NC1704.2 +100300 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +100400 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +100500 MPY-TEST-F2-19-1. NC1704.2 +100600 GO TO MPY-TEST-F2-19-2. NC1704.2 +100700 MPY-DELETE-F2-19. NC1704.2 +100800 PERFORM DE-LETE. NC1704.2 +100900 PERFORM PRINT-DETAIL. NC1704.2 +101000 GO TO MPY-INIT-F2-20. NC1704.2 +101100 MPY-TEST-F2-19-2. NC1704.2 +101200 MOVE "MPY-TEST-F2-19-2" TO PAR-NAME. NC1704.2 +101300 IF WRK-XN-00001 = "2" NC1704.2 +101400 PERFORM PASS NC1704.2 +101500 PERFORM PRINT-DETAIL NC1704.2 +101600 ELSE NC1704.2 +101700 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +101800 MOVE "2" TO CORRECT-X NC1704.2 +101900 MOVE "NOT ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC1704.2 +102000 TO RE-MARK NC1704.2 +102100 PERFORM FAIL NC1704.2 +102200 PERFORM PRINT-DETAIL. NC1704.2 +102300 ADD 1 TO REC-CT. NC1704.2 +102400 MPY-TEST-F2-19-3. NC1704.2 +102500 MOVE "MPY-TEST-F2-19-3 " TO PAR-NAME. NC1704.2 +102600 IF WRK-DS-10V00 = 0000000111 NC1704.2 +102700 PERFORM PASS NC1704.2 +102800 PERFORM PRINT-DETAIL NC1704.2 +102900 ELSE NC1704.2 +103000 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +103100 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +103200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +103300 PERFORM FAIL NC1704.2 +103400 PERFORM PRINT-DETAIL. NC1704.2 +103500* NC1704.2 +103600* NC1704.2 +103700 MPY-INIT-F2-20. NC1704.2 +103800* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +103900 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +104000 MOVE "MPY-TEST-F2-20" TO PAR-NAME. NC1704.2 +104100 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +104200 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +104300 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +104400 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +104500 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +104600 MOVE 0 TO WRK-NE-2. NC1704.2 +104700 MOVE 0 TO WRK-NE-3. NC1704.2 +104800 MOVE 1 TO REC-CT. NC1704.2 +104900 MPY-TEST-F2-20-0. NC1704.2 +105000 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 GIVING WRK-DU-2V0-1 NC1704.2 +105100 WRK-DU-2V0-2 ROUNDED WRK-DU-2V5-1 WRK-NE-2 ROUNDED NC1704.2 +105200 WRK-NE-3. NC1704.2 +105300 GO TO MPY-TEST-F2-20-1. NC1704.2 +105400 MPY-DELETE-F2-20. NC1704.2 +105500 PERFORM DE-LETE. NC1704.2 +105600 GO TO MPY-INIT-F2-21. NC1704.2 +105700 MPY-TEST-F2-20-1. NC1704.2 +105800 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +105900 ELSE NC1704.2 +106000 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 TO NC1704.2 +106100 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +106200 ADD 1 TO REC-CT. NC1704.2 +106300 MPY-TEST-F2-20-2. NC1704.2 +106400 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +106500 ELSE NC1704.2 +106600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 NC1704.2 +106700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +106800 ADD 1 TO REC-CT. NC1704.2 +106900 MPY-TEST-F2-20-3. NC1704.2 +107000 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +107100 ELSE NC1704.2 +107200 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +107300 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +107400 ADD 1 TO REC-CT. NC1704.2 +107500 MPY-TEST-F2-20-4. NC1704.2 +107600 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +107700 ELSE NC1704.2 +107800 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +107900 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +108000 ADD 1 TO REC-CT. NC1704.2 +108100 MPY-TEST-F2-20-5. NC1704.2 +108200 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +108300 ELSE NC1704.2 +108400 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +108500 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +108600* NC1704.2 +108700* NC1704.2 +108800 MPY-INIT-F2-21. NC1704.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1704.2 +109000* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +109100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +109200 MOVE "MPY-TEST-F2-21" TO PAR-NAME. NC1704.2 +109300 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +109400 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +109600 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +109700 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +109800 MOVE 0 TO WRK-NE-2. NC1704.2 +109900 MOVE 0 TO WRK-NE-3. NC1704.2 +110000 MOVE 1 TO REC-CT. NC1704.2 +110100 MOVE "0" TO WRK-XN-00001. NC1704.2 +110200 MPY-TEST-F2-21-0. NC1704.2 +110300 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +110400 GIVING WRK-DU-2V0-1 NC1704.2 +110500 WRK-DU-2V0-2 ROUNDED NC1704.2 +110600 WRK-DU-2V5-1 NC1704.2 +110700 WRK-NE-2 ROUNDED NC1704.2 +110800 WRK-NE-3 NC1704.2 +110900 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +111000 GO TO MPY-TEST-F2-21-1. NC1704.2 +111100 MPY-DELETE-F2-21. NC1704.2 +111200 PERFORM DE-LETE. NC1704.2 +111300 GO TO MPY-INIT-F2-22. NC1704.2 +111400 MPY-TEST-F2-21-1. NC1704.2 +111500 IF WRK-DU-2V0-1 = 0 NC1704.2 +111600 PERFORM PASS NC1704.2 +111700 PERFORM PRINT-DETAIL NC1704.2 +111800 ELSE NC1704.2 +111900 PERFORM FAIL NC1704.2 +112000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +112100 MOVE 0 TO CORRECT-N NC1704.2 +112200 PERFORM PRINT-DETAIL. NC1704.2 +112300 ADD 1 TO REC-CT. NC1704.2 +112400 MPY-TEST-F2-21-2. NC1704.2 +112500 IF WRK-DU-2V0-2 = 0 NC1704.2 +112600 PERFORM PASS NC1704.2 +112700 PERFORM PRINT-DETAIL NC1704.2 +112800 ELSE NC1704.2 +112900 PERFORM FAIL NC1704.2 +113000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +113100 MOVE 0 TO CORRECT-N NC1704.2 +113200 PERFORM PRINT-DETAIL. NC1704.2 +113300 ADD 1 TO REC-CT. NC1704.2 +113400 MPY-TEST-F2-21-3. NC1704.2 +113500 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +113600 ELSE NC1704.2 +113700 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +113800 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +113900 ADD 1 TO REC-CT. NC1704.2 +114000 MPY-TEST-F2-21-4. NC1704.2 +114100 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +114200 ELSE NC1704.2 +114300 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +114400 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +114500 ADD 1 TO REC-CT. NC1704.2 +114600 MPY-TEST-F2-21-5. NC1704.2 +114700 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +114800 ELSE NC1704.2 +114900 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +115000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +115100 ADD 1 TO REC-CT. NC1704.2 +115200 MPY-TEST-F2-21-6. NC1704.2 +115300 IF WRK-XN-00001 = "1" NC1704.2 +115400 PERFORM PASS NC1704.2 +115500 PERFORM PRINT-DETAIL NC1704.2 +115600 ELSE NC1704.2 +115700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +115800 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +115900 MOVE "1" TO CORRECT-X NC1704.2 +116000 PERFORM FAIL NC1704.2 +116100 PERFORM PRINT-DETAIL. NC1704.2 +116200* NC1704.2 +116300 MPY-INIT-F2-22. NC1704.2 +116400* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +116500* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +116600 MOVE "MPY-TEST-F2-22" TO PAR-NAME. NC1704.2 +116700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +116800 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +116900 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +117000 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +117100 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +117200 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +117300 MOVE 0 TO WRK-NE-2. NC1704.2 +117400 MOVE 0 TO WRK-NE-3. NC1704.2 +117500 MOVE 1 TO REC-CT. NC1704.2 +117600 MOVE "0" TO WRK-XN-00001. NC1704.2 +117700 MPY-TEST-F2-22-0. NC1704.2 +117800 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +117900 GIVING WRK-DU-2V0-1 NC1704.2 +118000 WRK-DU-2V0-2 ROUNDED NC1704.2 +118100 WRK-DU-2V5-1 NC1704.2 +118200 WRK-NE-2 ROUNDED NC1704.2 +118300 WRK-NE-3 NC1704.2 +118400 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +118500 GO TO MPY-TEST-F2-22-1. NC1704.2 +118600 MPY-DELETE-F2-22. NC1704.2 +118700 PERFORM DE-LETE. NC1704.2 +118800 PERFORM PRINT-DETAIL. NC1704.2 +118900 GO TO MPY-INIT-F2-23. NC1704.2 +119000 MPY-TEST-F2-22-1. NC1704.2 +119100 IF WRK-DU-2V0-1 = 9 NC1704.2 +119200 PERFORM PASS NC1704.2 +119300 PERFORM PRINT-DETAIL NC1704.2 +119400 ELSE NC1704.2 +119500 PERFORM FAIL NC1704.2 +119600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +119700 MOVE 9 TO CORRECT-N NC1704.2 +119800 PERFORM PRINT-DETAIL. NC1704.2 +119900 ADD 1 TO REC-CT. NC1704.2 +120000 MPY-TEST-F2-22-2. NC1704.2 +120100 IF WRK-DU-2V0-2 = 10 NC1704.2 +120200 PERFORM PASS NC1704.2 +120300 PERFORM PRINT-DETAIL NC1704.2 +120400 ELSE NC1704.2 +120500 PERFORM FAIL NC1704.2 +120600 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +120700 MOVE 10 TO CORRECT-N NC1704.2 +120800 PERFORM PRINT-DETAIL. NC1704.2 +120900 ADD 1 TO REC-CT. NC1704.2 +121000 MPY-TEST-F2-22-3. NC1704.2 +121100 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +121200 ELSE NC1704.2 +121300 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +121400 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +121500 ADD 1 TO REC-CT. NC1704.2 +121600 MPY-TEST-F2-22-4. NC1704.2 +121700 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +121800 ELSE NC1704.2 +121900 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +122000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +122100 ADD 1 TO REC-CT. NC1704.2 +122200 MPY-TEST-F2-22-5. NC1704.2 +122300 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +122400 ELSE NC1704.2 +122500 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +122600 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +122700 ADD 1 TO REC-CT. NC1704.2 +122800 MPY-TEST-F2-22-6. NC1704.2 +122900 IF WRK-XN-00001 = "0" NC1704.2 +123000 PERFORM PASS NC1704.2 +123100 PERFORM PRINT-DETAIL NC1704.2 +123200 ELSE NC1704.2 +123300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +123400 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +123500 MOVE "0" TO CORRECT-X NC1704.2 +123600 PERFORM FAIL NC1704.2 +123700 PERFORM PRINT-DETAIL. NC1704.2 +123800* NC1704.2 +123900 MPY-INIT-F2-23. NC1704.2 +124000* ==--> SIZE ERROR CONDITION <--== NC1704.2 +124100* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +124200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +124300 MOVE "MPY-TEST-F2-23" TO PAR-NAME. NC1704.2 +124400 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +124500 MOVE 1 TO REC-CT. NC1704.2 +124600 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +124700 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +124800 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +124900 MOVE 0 TO WRK-NE-2. NC1704.2 +125000 MOVE 0 TO WRK-NE-3. NC1704.2 +125100 MOVE "0" TO WRK-XN-00001. NC1704.2 +125200 MPY-TEST-F2-23-0. NC1704.2 +125300 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +125400 GIVING WRK-DU-2V0-1 NC1704.2 +125500 WRK-DU-2V0-2 ROUNDED NC1704.2 +125600 WRK-DU-2V5-1 NC1704.2 +125700 WRK-NE-2 ROUNDED NC1704.2 +125800 WRK-NE-3 NC1704.2 +125900 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +126000 GO TO MPY-TEST-F2-23-1. NC1704.2 +126100 MPY-DELETE-F2-23. NC1704.2 +126200 PERFORM DE-LETE. NC1704.2 +126300 PERFORM PRINT-DETAIL. NC1704.2 +126400 GO TO MPY-INIT-F2-24. NC1704.2 +126500 MPY-TEST-F2-23-1. NC1704.2 +126600 IF WRK-DU-2V0-1 = 0 NC1704.2 +126700 PERFORM PASS NC1704.2 +126800 PERFORM PRINT-DETAIL NC1704.2 +126900 ELSE NC1704.2 +127000 PERFORM FAIL NC1704.2 +127100 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +127200 MOVE 0 TO CORRECT-N NC1704.2 +127300 PERFORM PRINT-DETAIL. NC1704.2 +127400 ADD 1 TO REC-CT. NC1704.2 +127500 MPY-TEST-F2-23-2. NC1704.2 +127600 IF WRK-DU-2V0-2 = 0 NC1704.2 +127700 PERFORM PASS NC1704.2 +127800 PERFORM PRINT-DETAIL NC1704.2 +127900 ELSE NC1704.2 +128000 PERFORM FAIL NC1704.2 +128100 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +128200 MOVE 0 TO CORRECT-N NC1704.2 +128300 PERFORM PRINT-DETAIL. NC1704.2 +128400 ADD 1 TO REC-CT. NC1704.2 +128500 MPY-TEST-F2-23-3. NC1704.2 +128600 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +128700 ELSE NC1704.2 +128800 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +128900 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +129000 ADD 1 TO REC-CT. NC1704.2 +129100 MPY-TEST-F2-23-4. NC1704.2 +129200 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +129300 ELSE NC1704.2 +129400 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +129500 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +129600 ADD 1 TO REC-CT. NC1704.2 +129700 MPY-TEST-F2-23-5. NC1704.2 +129800 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +129900 ELSE NC1704.2 +130000 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +130100 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +130200 ADD 1 TO REC-CT. NC1704.2 +130300 MPY-TEST-F2-23-6. NC1704.2 +130400 IF WRK-XN-00001 = "0" NC1704.2 +130500 PERFORM PASS NC1704.2 +130600 PERFORM PRINT-DETAIL NC1704.2 +130700 ELSE NC1704.2 +130800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +130900 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +131000 MOVE "0" TO CORRECT-X NC1704.2 +131100 PERFORM FAIL NC1704.2 +131200 PERFORM PRINT-DETAIL. NC1704.2 +131300* NC1704.2 +131400 MPY-INIT-F2-24. NC1704.2 +131500* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +131600* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +131700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +131800 MOVE "MPY-TEST-F2-24" TO PAR-NAME. NC1704.2 +131900 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +132000 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +132100 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +132200 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +132300 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +132400 MOVE 0 TO WRK-NE-2. NC1704.2 +132500 MOVE 0 TO WRK-NE-3. NC1704.2 +132600 MOVE 1 TO REC-CT. NC1704.2 +132700 MOVE "0" TO WRK-XN-00001. NC1704.2 +132800 MPY-TEST-F2-24-0. NC1704.2 +132900 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +133000 GIVING WRK-DU-2V0-1 NC1704.2 +133100 WRK-DU-2V0-2 ROUNDED NC1704.2 +133200 WRK-DU-2V5-1 NC1704.2 +133300 WRK-NE-2 ROUNDED NC1704.2 +133400 WRK-NE-3 NC1704.2 +133500 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +133600 GO TO MPY-TEST-F2-24-1. NC1704.2 +133700 MPY-DELETE-F2-24. NC1704.2 +133800 PERFORM DE-LETE. NC1704.2 +133900 PERFORM PRINT-DETAIL. NC1704.2 +134000 GO TO MPY-INIT-F2-25. NC1704.2 +134100 MPY-TEST-F2-24-1. NC1704.2 +134200 IF WRK-DU-2V0-1 = 9 NC1704.2 +134300 PERFORM PASS NC1704.2 +134400 PERFORM PRINT-DETAIL NC1704.2 +134500 ELSE NC1704.2 +134600 PERFORM FAIL NC1704.2 +134700 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +134800 MOVE 9 TO CORRECT-N NC1704.2 +134900 PERFORM PRINT-DETAIL. NC1704.2 +135000 ADD 1 TO REC-CT. NC1704.2 +135100 MPY-TEST-F2-24-2. NC1704.2 +135200 IF WRK-DU-2V0-2 = 10 NC1704.2 +135300 PERFORM PASS NC1704.2 +135400 PERFORM PRINT-DETAIL NC1704.2 +135500 ELSE NC1704.2 +135600 PERFORM FAIL NC1704.2 +135700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +135800 MOVE 10 TO CORRECT-N NC1704.2 +135900 PERFORM PRINT-DETAIL. NC1704.2 +136000 ADD 1 TO REC-CT. NC1704.2 +136100 MPY-TEST-F2-24-3. NC1704.2 +136200 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +136300 ELSE NC1704.2 +136400 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +136500 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +136600 ADD 1 TO REC-CT. NC1704.2 +136700 MPY-TEST-F2-24-4. NC1704.2 +136800 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +136900 ELSE NC1704.2 +137000 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +137100 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +137200 ADD 1 TO REC-CT. NC1704.2 +137300 MPY-TEST-F2-24-5. NC1704.2 +137400 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +137500 ELSE NC1704.2 +137600 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +137700 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +137800 ADD 1 TO REC-CT. NC1704.2 +137900 MPY-TEST-F2-24-6. NC1704.2 +138000 IF WRK-XN-00001 = "1" NC1704.2 +138100 PERFORM PASS NC1704.2 +138200 PERFORM PRINT-DETAIL NC1704.2 +138300 ELSE NC1704.2 +138400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +138500 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +138600 MOVE "1" TO CORRECT-X NC1704.2 +138700 PERFORM FAIL NC1704.2 +138800 PERFORM PRINT-DETAIL. NC1704.2 +138900* NC1704.2 +139000 MPY-INIT-F2-25. NC1704.2 +139100* ==--> SIZE ERROR CONDITION <--== NC1704.2 +139200* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +139300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +139400 MOVE "MPY-TEST-F2-25" TO PAR-NAME. NC1704.2 +139500 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +139600 MOVE 1 TO REC-CT. NC1704.2 +139700 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +139800 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +139900 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +140000 MOVE 0 TO WRK-NE-2. NC1704.2 +140100 MOVE 0 TO WRK-NE-3. NC1704.2 +140200 MOVE "0" TO WRK-XN-00001. NC1704.2 +140300 MPY-TEST-F2-25-0. NC1704.2 +140400 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +140500 GIVING WRK-DU-2V0-1 NC1704.2 +140600 WRK-DU-2V0-2 ROUNDED NC1704.2 +140700 WRK-DU-2V5-1 NC1704.2 +140800 WRK-NE-2 ROUNDED NC1704.2 +140900 WRK-NE-3 NC1704.2 +141000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +141100 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +141200 GO TO MPY-TEST-F2-25-1. NC1704.2 +141300 MPY-DELETE-F2-25. NC1704.2 +141400 PERFORM DE-LETE. NC1704.2 +141500 PERFORM PRINT-DETAIL. NC1704.2 +141600 GO TO MPY-INIT-F2-26. NC1704.2 +141700 MPY-TEST-F2-25-1. NC1704.2 +141800 IF WRK-DU-2V0-1 = 0 NC1704.2 +141900 PERFORM PASS NC1704.2 +142000 PERFORM PRINT-DETAIL NC1704.2 +142100 ELSE NC1704.2 +142200 PERFORM FAIL NC1704.2 +142300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +142400 MOVE 0 TO CORRECT-N NC1704.2 +142500 PERFORM PRINT-DETAIL. NC1704.2 +142600 ADD 1 TO REC-CT. NC1704.2 +142700 MPY-TEST-F2-25-2. NC1704.2 +142800 IF WRK-DU-2V0-2 = 00 NC1704.2 +142900 PERFORM PASS NC1704.2 +143000 PERFORM PRINT-DETAIL NC1704.2 +143100 ELSE NC1704.2 +143200 PERFORM FAIL NC1704.2 +143300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +143400 MOVE 00 TO CORRECT-N NC1704.2 +143500 PERFORM PRINT-DETAIL. NC1704.2 +143600 ADD 1 TO REC-CT. NC1704.2 +143700 MPY-TEST-F2-25-3. NC1704.2 +143800 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +143900 ELSE NC1704.2 +144000 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +144100 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +144200 ADD 1 TO REC-CT. NC1704.2 +144300 MPY-TEST-F2-25-4. NC1704.2 +144400 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +144500 ELSE NC1704.2 +144600 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +144700 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +144800 ADD 1 TO REC-CT. NC1704.2 +144900 MPY-TEST-F2-25-5. NC1704.2 +145000 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +145100 ELSE NC1704.2 +145200 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +145300 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +145400 ADD 1 TO REC-CT. NC1704.2 +145500 MPY-TEST-F2-25-6. NC1704.2 +145600 IF WRK-XN-00001 = "1" NC1704.2 +145700 PERFORM PASS NC1704.2 +145800 PERFORM PRINT-DETAIL NC1704.2 +145900 ELSE NC1704.2 +146000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +146100 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +146200 MOVE "1" TO CORRECT-X NC1704.2 +146300 PERFORM FAIL NC1704.2 +146400 PERFORM PRINT-DETAIL. NC1704.2 +146500* NC1704.2 +146600* NC1704.2 +146700 MPY-INIT-F2-26. NC1704.2 +146800* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +146900* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +147000 MOVE "MPY-TEST-F2-26" TO PAR-NAME. NC1704.2 +147100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +147200 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +147300 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +147400 MOVE 1 TO REC-CT. NC1704.2 +147500 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +147600 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +147700 MOVE 0 TO WRK-NE-2. NC1704.2 +147800 MOVE 0 TO WRK-NE-3. NC1704.2 +147900 MOVE "0" TO WRK-XN-00001. NC1704.2 +148000 MPY-TEST-F2-26-0. NC1704.2 +148100 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +148200 GIVING WRK-DU-2V0-1 NC1704.2 +148300 WRK-DU-2V0-2 ROUNDED NC1704.2 +148400 WRK-DU-2V5-1 NC1704.2 +148500 WRK-NE-2 ROUNDED NC1704.2 +148600 WRK-NE-3 NC1704.2 +148700 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +148800 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +148900 GO TO MPY-TEST-F2-26-1. NC1704.2 +149000 MPY-DELETE-F2-26. NC1704.2 +149100 PERFORM DE-LETE. NC1704.2 +149200 PERFORM PRINT-DETAIL. NC1704.2 +149300 GO TO MPY-INIT-F2-27. NC1704.2 +149400 MPY-TEST-F2-26-1. NC1704.2 +149500 IF WRK-DU-2V0-1 = 9 NC1704.2 +149600 PERFORM PASS NC1704.2 +149700 PERFORM PRINT-DETAIL NC1704.2 +149800 ELSE NC1704.2 +149900 PERFORM FAIL NC1704.2 +150000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +150100 MOVE 9 TO CORRECT-N NC1704.2 +150200 PERFORM PRINT-DETAIL. NC1704.2 +150300 ADD 1 TO REC-CT. NC1704.2 +150400 MPY-TEST-F2-26-2. NC1704.2 +150500 IF WRK-DU-2V0-2 = 10 NC1704.2 +150600 PERFORM PASS NC1704.2 +150700 PERFORM PRINT-DETAIL NC1704.2 +150800 ELSE NC1704.2 +150900 PERFORM FAIL NC1704.2 +151000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +151100 MOVE 10 TO CORRECT-N NC1704.2 +151200 PERFORM PRINT-DETAIL. NC1704.2 +151300 ADD 1 TO REC-CT. NC1704.2 +151400 MPY-TEST-F2-26-3. NC1704.2 +151500 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +151600 ELSE NC1704.2 +151700 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +151800 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +151900 ADD 1 TO REC-CT. NC1704.2 +152000 MPY-TEST-F2-26-4. NC1704.2 +152100 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +152200 ELSE NC1704.2 +152300 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +152400 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +152500 ADD 1 TO REC-CT. NC1704.2 +152600 MPY-TEST-F2-26-5. NC1704.2 +152700 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +152800 ELSE NC1704.2 +152900 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +153000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +153100 ADD 1 TO REC-CT. NC1704.2 +153200 MPY-TEST-F2-26-6. NC1704.2 +153300 IF WRK-XN-00001 = "2" NC1704.2 +153400 PERFORM PASS NC1704.2 +153500 PERFORM PRINT-DETAIL NC1704.2 +153600 ELSE NC1704.2 +153700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +153800 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +153900 MOVE "2" TO CORRECT-X NC1704.2 +154000 PERFORM FAIL NC1704.2 +154100 PERFORM PRINT-DETAIL. NC1704.2 +154200* NC1704.2 +154300 MPY-INIT-F2-27. NC1704.2 +154400* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +154500 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +154600 MOVE "MPY-TEST-F2-27" TO PAR-NAME. NC1704.2 +154700 MOVE "A" TO XRAY. NC1704.2 +154800 MOVE 80.12 TO MULT1. NC1704.2 +154900 MOVE -56 TO MULT4. NC1704.2 +155000 MOVE 4 TO MULT5. NC1704.2 +155100 MOVE 0 TO WRK-DS-10V00. NC1704.2 +155200 MOVE 0 TO WRK-DS-02V00. NC1704.2 +155300 MOVE 1 TO REC-CT. NC1704.2 +155400 MPY-TEST-F2-27-0. NC1704.2 +155500 MULTIPLY MULT4 BY MULT1 NC1704.2 +155600 GIVING MULT5 NC1704.2 +155700 ON SIZE ERROR NC1704.2 +155800 MOVE "H" TO XRAY NC1704.2 +155900 MOVE 28 TO WRK-DS-10V00 NC1704.2 +156000 MOVE -19 TO WRK-DS-02V00 NC1704.2 +156100 END-MULTIPLY NC1704.2 +156200 MOVE 99 TO WRK-CS-18V00. NC1704.2 +156300 GO TO MPY-TEST-F2-27-1. NC1704.2 +156400 MPY-DELETE-F2-27-1. NC1704.2 +156500 PERFORM DE-LETE. NC1704.2 +156600 PERFORM PRINT-DETAIL. NC1704.2 +156700 GO TO MPY-INIT-F2-28. NC1704.2 +156800 MPY-TEST-F2-27-1. NC1704.2 +156900 MOVE "MPY-TEST-F2-27-1" TO PAR-NAME. NC1704.2 +157000 IF XRAY = "H" NC1704.2 +157100 PERFORM PASS NC1704.2 +157200 PERFORM PRINT-DETAIL NC1704.2 +157300 ELSE NC1704.2 +157400 MOVE XRAY TO COMPUTED-X NC1704.2 +157500 MOVE "H" TO CORRECT-X NC1704.2 +157600 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +157700 PERFORM FAIL NC1704.2 +157800 PERFORM PRINT-DETAIL. NC1704.2 +157900 ADD 1 TO REC-CT. NC1704.2 +158000 MPY-TEST-F2-27-2. NC1704.2 +158100 MOVE "MPY-TEST-F2-27-2" TO PAR-NAME. NC1704.2 +158200 IF WRK-DS-10V00 = 0000000028 NC1704.2 +158300 PERFORM PASS NC1704.2 +158400 PERFORM PRINT-DETAIL NC1704.2 +158500 ELSE NC1704.2 +158600 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +158700 MOVE 28 TO CORRECT-N NC1704.2 +158800 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +158900 PERFORM FAIL NC1704.2 +159000 PERFORM PRINT-DETAIL. NC1704.2 +159100 ADD 1 TO REC-CT. NC1704.2 +159200 MPY-TEST-F2-27-3. NC1704.2 +159300 MOVE "MPY-TEST-F2-27-3" TO PAR-NAME. NC1704.2 +159400 IF WRK-DS-02V00 = -19 NC1704.2 +159500 PERFORM PASS NC1704.2 +159600 PERFORM PRINT-DETAIL NC1704.2 +159700 ELSE NC1704.2 +159800 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +159900 MOVE -19 TO CORRECT-N NC1704.2 +160000 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +160100 PERFORM FAIL NC1704.2 +160200 PERFORM PRINT-DETAIL. NC1704.2 +160300 ADD 1 TO REC-CT. NC1704.2 +160400 MPY-TEST-F2-27-4. NC1704.2 +160500 MOVE "MPY-TEST-F2-27-4" TO PAR-NAME. NC1704.2 +160600 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +160700 PERFORM PASS NC1704.2 +160800 PERFORM PRINT-DETAIL NC1704.2 +160900 ELSE NC1704.2 +161000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +161100 MOVE 99 TO CORRECT-N NC1704.2 +161200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +161300 PERFORM FAIL NC1704.2 +161400 PERFORM PRINT-DETAIL. NC1704.2 +161500 ADD 1 TO REC-CT. NC1704.2 +161600 MPY-TEST-F2-27-5. NC1704.2 +161700 MOVE "MPY-TEST-F2-27-5" TO PAR-NAME. NC1704.2 +161800 IF MULT5 = 4 NC1704.2 +161900 PERFORM PASS NC1704.2 +162000 PERFORM PRINT-DETAIL NC1704.2 +162100 ELSE NC1704.2 +162200 MOVE MULT5 TO COMPUTED-N NC1704.2 +162300 MOVE 4 TO CORRECT-N NC1704.2 +162400 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +162500 PERFORM FAIL NC1704.2 +162600 PERFORM PRINT-DETAIL. NC1704.2 +162700* NC1704.2 +162800 MPY-INIT-F2-28. NC1704.2 +162900* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +163000 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +163100 MOVE "MPY-TEST-F2-28" TO PAR-NAME. NC1704.2 +163200 MOVE "1" TO WRK-XN-00001. NC1704.2 +163300 MOVE 0 TO WRK-DS-05V00. NC1704.2 +163400 MOVE 0 TO WRK-DS-02V00. NC1704.2 +163500 MOVE 0 TO WRK-DS-10V00. NC1704.2 +163600 MOVE 1 TO REC-CT. NC1704.2 +163700 MPY-TEST-F2-28-0. NC1704.2 +163800 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +163900 GIVING WRK-DS-10V00 NC1704.2 +164000 ON SIZE ERROR NC1704.2 +164100 MOVE "0" TO WRK-XN-00001 NC1704.2 +164200 MOVE 38 TO WRK-DS-05V00 NC1704.2 +164300 MOVE -19 TO WRK-DS-02V00 NC1704.2 +164400 END-MULTIPLY NC1704.2 +164500 MOVE 99 TO WRK-CS-18V00. NC1704.2 +164600 GO TO MPY-TEST-F2-28-1. NC1704.2 +164700 MPY-DELETE-F2-28-1. NC1704.2 +164800 PERFORM DE-LETE. NC1704.2 +164900 PERFORM PRINT-DETAIL. NC1704.2 +165000 GO TO MPY-INIT-F2-29. NC1704.2 +165100 MPY-TEST-F2-28-1. NC1704.2 +165200 MOVE "MPY-TEST-F2-28-1" TO PAR-NAME. NC1704.2 +165300 IF WRK-XN-00001 = "1" NC1704.2 +165400 PERFORM PASS NC1704.2 +165500 PERFORM PRINT-DETAIL NC1704.2 +165600 ELSE NC1704.2 +165700 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +165800 MOVE "1" TO CORRECT-X NC1704.2 +165900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +166000 TO RE-MARK NC1704.2 +166100 PERFORM FAIL NC1704.2 +166200 PERFORM PRINT-DETAIL. NC1704.2 +166300 ADD 1 TO REC-CT. NC1704.2 +166400 MPY-TEST-F2-28-2. NC1704.2 +166500 MOVE "MPY-TEST-F2-28-2" TO PAR-NAME. NC1704.2 +166600 IF WRK-DS-10V00 = 0000000111 NC1704.2 +166700 PERFORM PASS NC1704.2 +166800 PERFORM PRINT-DETAIL NC1704.2 +166900 ELSE NC1704.2 +167000 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +167100 MOVE 0000000111 TO CORRECT-N NC1704.2 +167200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +167300 PERFORM FAIL NC1704.2 +167400 PERFORM PRINT-DETAIL. NC1704.2 +167500 ADD 1 TO REC-CT. NC1704.2 +167600 MPY-TEST-F2-28-3. NC1704.2 +167700 MOVE "MPY-TEST-F2-28-3" TO PAR-NAME. NC1704.2 +167800 IF WRK-DS-05V00 = 0 NC1704.2 +167900 PERFORM PASS NC1704.2 +168000 PERFORM PRINT-DETAIL NC1704.2 +168100 ELSE NC1704.2 +168200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1704.2 +168300 MOVE 0 TO CORRECT-N NC1704.2 +168400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +168500 TO RE-MARK NC1704.2 +168600 PERFORM FAIL NC1704.2 +168700 PERFORM PRINT-DETAIL. NC1704.2 +168800 ADD 1 TO REC-CT. NC1704.2 +168900 MPY-TEST-F2-28-4. NC1704.2 +169000 MOVE "MPY-TEST-F2-28-4" TO PAR-NAME. NC1704.2 +169100 IF WRK-DS-02V00 = 0 NC1704.2 +169200 PERFORM PASS NC1704.2 +169300 PERFORM PRINT-DETAIL NC1704.2 +169400 ELSE NC1704.2 +169500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +169600 MOVE 0 TO CORRECT-N NC1704.2 +169700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +169800 TO RE-MARK NC1704.2 +169900 PERFORM FAIL NC1704.2 +170000 PERFORM PRINT-DETAIL. NC1704.2 +170100 ADD 1 TO REC-CT. NC1704.2 +170200 MPY-TEST-F2-28-5. NC1704.2 +170300 MOVE "MPY-TEST-F2-28-5" TO PAR-NAME. NC1704.2 +170400 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +170500 PERFORM PASS NC1704.2 +170600 PERFORM PRINT-DETAIL NC1704.2 +170700 ELSE NC1704.2 +170800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +170900 MOVE 99 TO CORRECT-N NC1704.2 +171000 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +171100 TO RE-MARK NC1704.2 +171200 PERFORM FAIL NC1704.2 +171300 PERFORM PRINT-DETAIL. NC1704.2 +171400* NC1704.2 +171500 MPY-INIT-F2-29. NC1704.2 +171600* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +171700* ==--> SIZE ERROR CONDITION <--== NC1704.2 +171800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +171900 MOVE "MPY-TEST-F2-29" TO PAR-NAME. NC1704.2 +172000 MOVE "A" TO XRAY. NC1704.2 +172100 MOVE 80.12 TO MULT1. NC1704.2 +172200 MOVE -56 TO MULT4. NC1704.2 +172300 MOVE 4 TO MULT5. NC1704.2 +172400 MOVE 1 TO REC-CT. NC1704.2 +172500 MOVE 0 TO WRK-DS-10V00. NC1704.2 +172600 MOVE 0 TO WRK-DS-02V00. NC1704.2 +172700 MPY-TEST-F2-29-0. NC1704.2 +172800 MULTIPLY MULT4 BY MULT1 NC1704.2 +172900 GIVING MULT5 NC1704.2 +173000 NOT ON SIZE ERROR NC1704.2 +173100 MOVE "H" TO XRAY NC1704.2 +173200 MOVE 38 TO WRK-DS-10V00 NC1704.2 +173300 MOVE -19 TO WRK-DS-02V00 NC1704.2 +173400 END-MULTIPLY NC1704.2 +173500 MOVE 99 TO WRK-CS-18V00. NC1704.2 +173600 GO TO MPY-TEST-F2-29-1. NC1704.2 +173700 MPY-DELETE-F2-29-1. NC1704.2 +173800 PERFORM DE-LETE. NC1704.2 +173900 PERFORM PRINT-DETAIL. NC1704.2 +174000 GO TO MPY-INIT-F2-30. NC1704.2 +174100 MPY-TEST-F2-29-1. NC1704.2 +174200 MOVE "MPY-TEST-F2-29-1" TO PAR-NAME. NC1704.2 +174300 IF XRAY = "A" NC1704.2 +174400 PERFORM PASS NC1704.2 +174500 PERFORM PRINT-DETAIL NC1704.2 +174600 ELSE NC1704.2 +174700 MOVE XRAY TO COMPUTED-X NC1704.2 +174800 MOVE "A" TO CORRECT-X NC1704.2 +174900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +175000 TO RE-MARK NC1704.2 +175100 PERFORM FAIL NC1704.2 +175200 PERFORM PRINT-DETAIL. NC1704.2 +175300 ADD 1 TO REC-CT. NC1704.2 +175400 MPY-TEST-F2-29-2. NC1704.2 +175500 MOVE "MPY-TEST-F2-29-2" TO PAR-NAME. NC1704.2 +175600 IF WRK-DS-10V00 = 0 NC1704.2 +175700 PERFORM PASS NC1704.2 +175800 PERFORM PRINT-DETAIL NC1704.2 +175900 ELSE NC1704.2 +176000 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +176100 MOVE 0 TO CORRECT-N NC1704.2 +176200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +176300 TO RE-MARK NC1704.2 +176400 PERFORM FAIL NC1704.2 +176500 PERFORM PRINT-DETAIL. NC1704.2 +176600 ADD 1 TO REC-CT. NC1704.2 +176700 MPY-TEST-F2-29-3. NC1704.2 +176800 MOVE "MPY-TEST-F2-29-3" TO PAR-NAME. NC1704.2 +176900 IF WRK-DS-02V00 = 0 NC1704.2 +177000 PERFORM PASS NC1704.2 +177100 PERFORM PRINT-DETAIL NC1704.2 +177200 ELSE NC1704.2 +177300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +177400 MOVE 0 TO CORRECT-N NC1704.2 +177500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +177600 TO RE-MARK NC1704.2 +177700 PERFORM FAIL NC1704.2 +177800 PERFORM PRINT-DETAIL. NC1704.2 +177900 ADD 1 TO REC-CT. NC1704.2 +178000 MPY-TEST-F2-29-4. NC1704.2 +178100 MOVE "MPY-TEST-F2-29-4" TO PAR-NAME. NC1704.2 +178200 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +178300 PERFORM PASS NC1704.2 +178400 PERFORM PRINT-DETAIL NC1704.2 +178500 ELSE NC1704.2 +178600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +178700 MOVE 99 TO CORRECT-N NC1704.2 +178800 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +178900 TO RE-MARK NC1704.2 +179000 PERFORM FAIL NC1704.2 +179100 PERFORM PRINT-DETAIL. NC1704.2 +179200 ADD 1 TO REC-CT. NC1704.2 +179300 MPY-TEST-F2-29-5. NC1704.2 +179400 MOVE "MPY-TEST-F2-29-5" TO PAR-NAME. NC1704.2 +179500 IF MULT5 = 4 NC1704.2 +179600 PERFORM PASS NC1704.2 +179700 PERFORM PRINT-DETAIL NC1704.2 +179800 ELSE NC1704.2 +179900 MOVE MULT5 TO COMPUTED-N NC1704.2 +180000 MOVE 4 TO CORRECT-N NC1704.2 +180100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1704.2 +180200 TO RE-MARK NC1704.2 +180300 PERFORM FAIL NC1704.2 +180400 PERFORM PRINT-DETAIL. NC1704.2 +180500* NC1704.2 +180600 MPY-INIT-F2-30. NC1704.2 +180700* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +180800* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +180900 MOVE "MPY-TEST-F2-30" TO PAR-NAME NC1704.2 +181000 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +181100 MOVE "1" TO WRK-XN-00001. NC1704.2 +181200 MOVE 0 TO WRK-DS-05V00. NC1704.2 +181300 MOVE 0 TO WRK-DS-02V00. NC1704.2 +181400 MOVE 0 TO WRK-DS-10V00. NC1704.2 +181500 MOVE 1 TO REC-CT. NC1704.2 +181600 MPY-TEST-F2-30-0. NC1704.2 +181700 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +181800 GIVING WRK-DS-10V00 NC1704.2 +181900 NOT ON SIZE ERROR NC1704.2 +182000 MOVE "0" TO WRK-XN-00001 NC1704.2 +182100 MOVE 38 TO WRK-DS-05V00 NC1704.2 +182200 MOVE -19 TO WRK-DS-02V00 NC1704.2 +182300 END-MULTIPLY NC1704.2 +182400 MOVE 99 TO WRK-CS-18V00. NC1704.2 +182500 GO TO MPY-TEST-F2-30-1. NC1704.2 +182600 MPY-DELETE-F2-30-1. NC1704.2 +182700 PERFORM DE-LETE. NC1704.2 +182800 PERFORM PRINT-DETAIL. NC1704.2 +182900 GO TO MPY-INIT-F2-31. NC1704.2 +183000 MPY-TEST-F2-30-1. NC1704.2 +183100 MOVE "MPY-TEST-F2-30-1" TO PAR-NAME. NC1704.2 +183200 IF WRK-XN-00001 = "0" NC1704.2 +183300 PERFORM PASS NC1704.2 +183400 PERFORM PRINT-DETAIL NC1704.2 +183500 ELSE NC1704.2 +183600 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +183700 MOVE "0" TO CORRECT-X NC1704.2 +183800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +183900 TO RE-MARK NC1704.2 +184000 PERFORM FAIL NC1704.2 +184100 PERFORM PRINT-DETAIL. NC1704.2 +184200 ADD 1 TO REC-CT. NC1704.2 +184300 MPY-TEST-F2-30-2. NC1704.2 +184400 MOVE "MPY-TEST-F2-30-2" TO PAR-NAME. NC1704.2 +184500 IF WRK-DS-10V00 = 0000000111 NC1704.2 +184600 PERFORM PASS NC1704.2 +184700 PERFORM PRINT-DETAIL NC1704.2 +184800 ELSE NC1704.2 +184900 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +185000 MOVE 28 TO CORRECT-N NC1704.2 +185100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +185200 PERFORM FAIL NC1704.2 +185300 PERFORM PRINT-DETAIL. NC1704.2 +185400 ADD 1 TO REC-CT. NC1704.2 +185500 MPY-TEST-F2-30-3. NC1704.2 +185600 MOVE "MPY-TEST-F2-30-3" TO PAR-NAME. NC1704.2 +185700 IF WRK-DS-05V00 = 38 NC1704.2 +185800 PERFORM PASS NC1704.2 +185900 PERFORM PRINT-DETAIL NC1704.2 +186000 ELSE NC1704.2 +186100 MOVE WRK-DS-05V00 TO COMPUTED-N NC1704.2 +186200 MOVE 38 TO CORRECT-N NC1704.2 +186300 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1704.2 +186400 TO RE-MARK NC1704.2 +186500 PERFORM FAIL NC1704.2 +186600 PERFORM PRINT-DETAIL. NC1704.2 +186700 ADD 1 TO REC-CT. NC1704.2 +186800 MPY-TEST-F2-30-4. NC1704.2 +186900 MOVE "MPY-TEST-F2-30-4" TO PAR-NAME. NC1704.2 +187000 IF WRK-DS-02V00 = -19 NC1704.2 +187100 PERFORM PASS NC1704.2 +187200 PERFORM PRINT-DETAIL NC1704.2 +187300 ELSE NC1704.2 +187400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +187500 MOVE -19 TO CORRECT-N NC1704.2 +187600 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1704.2 +187700 TO RE-MARK NC1704.2 +187800 PERFORM FAIL NC1704.2 +187900 PERFORM PRINT-DETAIL. NC1704.2 +188000 ADD 1 TO REC-CT. NC1704.2 +188100 MPY-TEST-F2-30-5. NC1704.2 +188200 MOVE "MPY-TEST-F2-30-5" TO PAR-NAME. NC1704.2 +188300 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +188400 PERFORM PASS NC1704.2 +188500 PERFORM PRINT-DETAIL NC1704.2 +188600 ELSE NC1704.2 +188700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +188800 MOVE 99 TO CORRECT-N NC1704.2 +188900 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +189000 TO RE-MARK NC1704.2 +189100 PERFORM FAIL NC1704.2 +189200 PERFORM PRINT-DETAIL. NC1704.2 +189300* NC1704.2 +189400 MPY-INIT-F2-31. NC1704.2 +189500* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +189600* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +189700 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +189800 MOVE "MPY-TEST-F2-31" TO PAR-NAME NC1704.2 +189900 MOVE 80.12 TO MULT1. NC1704.2 +190000 MOVE -56 TO MULT4. NC1704.2 +190100 MOVE 4 TO MULT5. NC1704.2 +190200 MOVE 1 TO REC-CT. NC1704.2 +190300 MOVE "A" TO XRAY. NC1704.2 +190400 MPY-TEST-F2-31-0. NC1704.2 +190500 MULTIPLY MULT4 BY MULT1 NC1704.2 +190600 GIVING MULT5 NC1704.2 +190700 ON SIZE ERROR NC1704.2 +190800 MOVE "B" TO XRAY NC1704.2 +190900 NOT ON SIZE ERROR NC1704.2 +191000 MOVE "C" TO XRAY NC1704.2 +191100 END-MULTIPLY NC1704.2 +191200 MOVE 99 TO WRK-CS-18V00. NC1704.2 +191300 GO TO MPY-TEST-F2-31-1. NC1704.2 +191400 MPY-DELETE-F2-31-1. NC1704.2 +191500 PERFORM DE-LETE. NC1704.2 +191600 PERFORM PRINT-DETAIL. NC1704.2 +191700 GO TO MPY-INIT-F2-32. NC1704.2 +191800 MPY-TEST-F2-31-1. NC1704.2 +191900 MOVE "MPY-TEST-F2-31-1" TO PAR-NAME. NC1704.2 +192000 IF XRAY = "B" NC1704.2 +192100 PERFORM PASS NC1704.2 +192200 PERFORM PRINT-DETAIL NC1704.2 +192300 ELSE NC1704.2 +192400 MOVE XRAY TO COMPUTED-X NC1704.2 +192500 MOVE "B" TO CORRECT-X NC1704.2 +192600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +192700 PERFORM FAIL NC1704.2 +192800 PERFORM PRINT-DETAIL. NC1704.2 +192900 ADD 1 TO REC-CT. NC1704.2 +193000 MPY-TEST-F2-31-2. NC1704.2 +193100 MOVE "MPY-TEST-F2-31-2" TO PAR-NAME. NC1704.2 +193200 IF MULT5 = 4 NC1704.2 +193300 PERFORM PASS NC1704.2 +193400 PERFORM PRINT-DETAIL NC1704.2 +193500 ELSE NC1704.2 +193600 MOVE MULT5 TO COMPUTED-N NC1704.2 +193700 MOVE 4 TO CORRECT-N NC1704.2 +193800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +193900 PERFORM FAIL NC1704.2 +194000 PERFORM PRINT-DETAIL. NC1704.2 +194100 ADD 1 TO REC-CT. NC1704.2 +194200 MPY-TEST-F2-31-3. NC1704.2 +194300 MOVE "MPY-TEST-F2-31-3" TO PAR-NAME. NC1704.2 +194400 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +194500 PERFORM PASS NC1704.2 +194600 PERFORM PRINT-DETAIL NC1704.2 +194700 ELSE NC1704.2 +194800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +194900 MOVE 99 TO CORRECT-N NC1704.2 +195000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +195100 PERFORM FAIL NC1704.2 +195200 PERFORM PRINT-DETAIL. NC1704.2 +195300* NC1704.2 +195400 MPY-INIT-F2-32. NC1704.2 +195500* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +195600 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +195700 MOVE "MPY-TEST-F2-32" TO PAR-NAME NC1704.2 +195800 MOVE "0" TO WRK-XN-00001. NC1704.2 +195900 MOVE 0 TO WRK-DS-10V00. NC1704.2 +196000 MOVE 1 TO REC-CT. NC1704.2 +196100 MPY-TEST-F2-32-0. NC1704.2 +196200 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +196300 GIVING WRK-DS-10V00 NC1704.2 +196400 ON SIZE ERROR NC1704.2 +196500 MOVE "1" TO WRK-XN-00001 NC1704.2 +196600 NOT ON SIZE ERROR NC1704.2 +196700 MOVE "2" TO WRK-XN-00001 NC1704.2 +196800 END-MULTIPLY NC1704.2 +196900 MOVE 99 TO WRK-CS-18V00. NC1704.2 +197000 GO TO MPY-TEST-F2-32-1. NC1704.2 +197100 MPY-DELETE-F2-32-1. NC1704.2 +197200 PERFORM DE-LETE. NC1704.2 +197300 PERFORM PRINT-DETAIL. NC1704.2 +197400 GO TO CCVS-EXIT. NC1704.2 +197500 MPY-TEST-F2-32-1. NC1704.2 +197600 MOVE "MPY-TEST-F2-32-1" TO PAR-NAME. NC1704.2 +197700 IF WRK-DS-10V00 = 0000000111 NC1704.2 +197800 PERFORM PASS NC1704.2 +197900 PERFORM PRINT-DETAIL NC1704.2 +198000 ELSE NC1704.2 +198100 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +198200 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +198300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +198400 PERFORM FAIL NC1704.2 +198500 PERFORM PRINT-DETAIL. NC1704.2 +198600 ADD 1 TO REC-CT. NC1704.2 +198700 MPY-TEST-F2-32-2. NC1704.2 +198800 MOVE "MPY-TEST-F2-32-2" TO PAR-NAME. NC1704.2 +198900 IF WRK-XN-00001 = "2" NC1704.2 +199000 PERFORM PASS NC1704.2 +199100 PERFORM PRINT-DETAIL NC1704.2 +199200 ELSE NC1704.2 +199300 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +199400 MOVE "2" TO CORRECT-X NC1704.2 +199500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +199600 TO RE-MARK NC1704.2 +199700 PERFORM FAIL NC1704.2 +199800 PERFORM PRINT-DETAIL. NC1704.2 +199900 ADD 1 TO REC-CT. NC1704.2 +200000 MPY-TEST-F2-32-3. NC1704.2 +200100 MOVE "MPY-TEST-F2-32-3" TO PAR-NAME. NC1704.2 +200200 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +200300 PERFORM PASS NC1704.2 +200400 PERFORM PRINT-DETAIL NC1704.2 +200500 ELSE NC1704.2 +200600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +200700 MOVE 99 TO CORRECT-N NC1704.2 +200800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +200900 PERFORM FAIL NC1704.2 +201000 PERFORM PRINT-DETAIL. NC1704.2 +201100* NC1704.2 +201200* NC1704.2 +201300 CCVS-EXIT SECTION. NC1704.2 +201400 CCVS-999999. NC1704.2 +201500 GO TO CLOSE-FILES. NC1704.2 +*END-OF,NC170A +*HEADER,COBOL,NC171A +000100 IDENTIFICATION DIVISION. NC1714.2 +000200 PROGRAM-ID. NC1714.2 +000300 NC171A. NC1714.2 +000400**************************************************************** NC1714.2 +000500* * NC1714.2 +000600* VALIDATION FOR:- * NC1714.2 +000700* * NC1714.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +000900* * NC1714.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1714.2 +001100* * NC1714.2 +001200**************************************************************** NC1714.2 +001300* * NC1714.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1714.2 +001500* * NC1714.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1714.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1714.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1714.2 +001900* * NC1714.2 +002000**************************************************************** NC1714.2 +002100* THIS PROGRAM TESTS THE FORMAT 1 DIVIDE STATEMENT FOUND NC1714.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1714.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1714.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1714.2 +002500* NC1714.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1714.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1714.2 +002800* AS OPERANDS. NC1714.2 +002900* NC1714.2 +003000 NC1714.2 +003100 NC1714.2 +003200 ENVIRONMENT DIVISION. NC1714.2 +003300 CONFIGURATION SECTION. NC1714.2 +003400 SOURCE-COMPUTER. NC1714.2 +003500 XXXXX082. NC1714.2 +003600 OBJECT-COMPUTER. NC1714.2 +003700 XXXXX083. NC1714.2 +003800 INPUT-OUTPUT SECTION. NC1714.2 +003900 FILE-CONTROL. NC1714.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1714.2 +004100 XXXXX055. NC1714.2 +004200 DATA DIVISION. NC1714.2 +004300 FILE SECTION. NC1714.2 +004400 FD PRINT-FILE. NC1714.2 +004500 01 PRINT-REC PICTURE X(120). NC1714.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1714.2 +004700 WORKING-STORAGE SECTION. NC1714.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1714.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1714.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1714.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1714.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1714.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1714.2 +005400 77 WRK-XN-00001 PICTURE X. NC1714.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1714.2 +005600 VALUE 1111111111. NC1714.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1714.2 +005800 VALUE 333333.333333. NC1714.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1714.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1714.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1714.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1714.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1714.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1714.2 +006500 VALUE 111111111111. NC1714.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1714.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1714.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1714.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1714.2 +007000 VALUE 111111111111111111. NC1714.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1714.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1714.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1714.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1714.2 +007500 VALUE 99. NC1714.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1714.2 +007700 VALUE .1. NC1714.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1714.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1714.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1714.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1714.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1714.2 +008300 VALUE 111111111.111111111. NC1714.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1714.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1714.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1714.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1714.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1714.2 +008900 77 XRAY PICTURE X. NC1714.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1714.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1714.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1714.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1714.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1714.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1714.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1714.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1714.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1714.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1714.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1714.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1714.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1714.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1714.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1714.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1714.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1714.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1714.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1714.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1714.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1714.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1714.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1714.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1714.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1714.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1714.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1714.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1714.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1714.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1714.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1714.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1714.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1714.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1714.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1714.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1714.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1714.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1714.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1714.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1714.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1714.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1714.2 +013200 01 WRK-NE-2 PIC $**.99. NC1714.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1714.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1714.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1714.2 +013600 VALUE +000000000000000001. NC1714.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1714.2 +013800 VALUE -000000000000000033. NC1714.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014000 VALUE 666666666666666666. NC1714.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014200 VALUE 009999999999999999. NC1714.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014400 VALUE 000022222222222222. NC1714.2 +014500 01 MULTIPLY-DATA. NC1714.2 +014600 02 MULT1 PICTURE IS 999V99 NC1714.2 +014700 VALUE IS 80.12. NC1714.2 +014800 02 MULT2 PICTURE IS 999V999. NC1714.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1714.2 +015000 02 MULT4 PICTURE IS S99 NC1714.2 +015100 VALUE IS -56. NC1714.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1714.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1714.2 +015400 20. NC1714.2 +015500 01 DIVIDE-DATA. NC1714.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1714.2 +015700 VALUE IS 1620.36. NC1714.2 +015800 02 DIV2 PICTURE IS 99V9 NC1714.2 +015900 VALUE IS 44.1. NC1714.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1714.2 +016100 VALUE IS 1661.7. NC1714.2 +016200 02 DIV4 PICTURE IS S9V999 NC1714.2 +016300 VALUE IS -9.642. NC1714.2 +016400 02 DIV-02LEVEL-1. NC1714.2 +016500 03 DIV5 PICTURE IS V99 NC1714.2 +016600 VALUE IS .82. NC1714.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1714.2 +016800 03 DIV7 PICTURE IS 9V9 NC1714.2 +016900 VALUE IS 9.6. NC1714.2 +017000 01 DIV-DATA-2. NC1714.2 +017100 02 DIV8 PICTURE IS 99V9. NC1714.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1714.2 +017300 02 DIV10 PICTURE IS V999. NC1714.2 +017400 01 TEST-RESULTS. NC1714.2 +017500 02 FILLER PIC X VALUE SPACE. NC1714.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1714.2 +017700 02 FILLER PIC X VALUE SPACE. NC1714.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1714.2 +017900 02 FILLER PIC X VALUE SPACE. NC1714.2 +018000 02 PAR-NAME. NC1714.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1714.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1714.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1714.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1714.2 +018500 02 RE-MARK PIC X(61). NC1714.2 +018600 01 TEST-COMPUTED. NC1714.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1714.2 +018800 02 FILLER PIC X(17) VALUE NC1714.2 +018900 " COMPUTED=". NC1714.2 +019000 02 COMPUTED-X. NC1714.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1714.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1714.2 +019300 PIC -9(9).9(9). NC1714.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1714.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1714.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1714.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1714.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1714.2 +019900 04 FILLER PIC X. NC1714.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1714.2 +020100 01 TEST-CORRECT. NC1714.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1714.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1714.2 +020400 02 CORRECT-X. NC1714.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1714.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1714.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1714.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1714.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1714.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1714.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1714.2 +021200 04 FILLER PIC X. NC1714.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1714.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1714.2 +021500 01 CCVS-C-1. NC1714.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1714.2 +021700- "SS PARAGRAPH-NAME NC1714.2 +021800- " REMARKS". NC1714.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1714.2 +022000 01 CCVS-C-2. NC1714.2 +022100 02 FILLER PIC X VALUE SPACE. NC1714.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1714.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1714.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1714.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1714.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1714.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1714.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1714.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1714.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1714.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1714.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1714.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1714.2 +023700 01 CCVS-H-1. NC1714.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1714.2 +023900 02 FILLER PIC X(42) VALUE NC1714.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1714.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1714.2 +024200 01 CCVS-H-2A. NC1714.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1714.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1714.2 +024500 02 FILLER PIC XXXX VALUE NC1714.2 +024600 "4.2 ". NC1714.2 +024700 02 FILLER PIC X(28) VALUE NC1714.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1714.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1714.2 +025000 NC1714.2 +025100 01 CCVS-H-2B. NC1714.2 +025200 02 FILLER PIC X(15) VALUE NC1714.2 +025300 "TEST RESULT OF ". NC1714.2 +025400 02 TEST-ID PIC X(9). NC1714.2 +025500 02 FILLER PIC X(4) VALUE NC1714.2 +025600 " IN ". NC1714.2 +025700 02 FILLER PIC X(12) VALUE NC1714.2 +025800 " HIGH ". NC1714.2 +025900 02 FILLER PIC X(22) VALUE NC1714.2 +026000 " LEVEL VALIDATION FOR ". NC1714.2 +026100 02 FILLER PIC X(58) VALUE NC1714.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +026300 01 CCVS-H-3. NC1714.2 +026400 02 FILLER PIC X(34) VALUE NC1714.2 +026500 " FOR OFFICIAL USE ONLY ". NC1714.2 +026600 02 FILLER PIC X(58) VALUE NC1714.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1714.2 +026800 02 FILLER PIC X(28) VALUE NC1714.2 +026900 " COPYRIGHT 1985 ". NC1714.2 +027000 01 CCVS-E-1. NC1714.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1714.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1714.2 +027300 02 ID-AGAIN PIC X(9). NC1714.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1714.2 +027500 01 CCVS-E-2. NC1714.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1714.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1714.2 +027800 02 CCVS-E-2-2. NC1714.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1714.2 +028000 03 FILLER PIC X VALUE SPACE. NC1714.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1714.2 +028200 "ERRORS ENCOUNTERED". NC1714.2 +028300 01 CCVS-E-3. NC1714.2 +028400 02 FILLER PIC X(22) VALUE NC1714.2 +028500 " FOR OFFICIAL USE ONLY". NC1714.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1714.2 +028700 02 FILLER PIC X(58) VALUE NC1714.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1714.2 +029000 02 FILLER PIC X(15) VALUE NC1714.2 +029100 " COPYRIGHT 1985". NC1714.2 +029200 01 CCVS-E-4. NC1714.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1714.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1714.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1714.2 +029600 02 FILLER PIC X(40) VALUE NC1714.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1714.2 +029800 01 XXINFO. NC1714.2 +029900 02 FILLER PIC X(19) VALUE NC1714.2 +030000 "*** INFORMATION ***". NC1714.2 +030100 02 INFO-TEXT. NC1714.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1714.2 +030300 04 XXCOMPUTED PIC X(20). NC1714.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1714.2 +030500 04 XXCORRECT PIC X(20). NC1714.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1714.2 +030700 01 HYPHEN-LINE. NC1714.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1714.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1714.2 +031000- "*****************************************". NC1714.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1714.2 +031200- "******************************". NC1714.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1714.2 +031400 "NC171A". NC1714.2 +031500 PROCEDURE DIVISION. NC1714.2 +031600 CCVS1 SECTION. NC1714.2 +031700 OPEN-FILES. NC1714.2 +031800 OPEN OUTPUT PRINT-FILE. NC1714.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1714.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1714.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1714.2 +032200 GO TO CCVS1-EXIT. NC1714.2 +032300 CLOSE-FILES. NC1714.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1714.2 +032500 TERMINATE-CCVS. NC1714.2 +032600S EXIT PROGRAM. NC1714.2 +032700STERMINATE-CALL. NC1714.2 +032800 STOP RUN. NC1714.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1714.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1714.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1714.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1714.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1714.2 +033400 PRINT-DETAIL. NC1714.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1714.2 +033600 MOVE "." TO PARDOT-X NC1714.2 +033700 MOVE REC-CT TO DOTVALUE. NC1714.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1714.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1714.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1714.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1714.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1714.2 +034300 MOVE SPACE TO CORRECT-X. NC1714.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1714.2 +034500 MOVE SPACE TO RE-MARK. NC1714.2 +034600 HEAD-ROUTINE. NC1714.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1714.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1714.2 +035100 COLUMN-NAMES-ROUTINE. NC1714.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +035500 END-ROUTINE. NC1714.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1714.2 +035700 END-RTN-EXIT. NC1714.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +035900 END-ROUTINE-1. NC1714.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1714.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1714.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1714.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1714.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1714.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1714.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1714.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1714.2 +036800 END-ROUTINE-12. NC1714.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1714.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1714.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1714.2 +037200 ELSE NC1714.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1714.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1714.2 +037500 PERFORM WRITE-LINE. NC1714.2 +037600 END-ROUTINE-13. NC1714.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1714.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1714.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1714.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1714.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1714.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1714.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1714.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1714.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038800 WRITE-LINE. NC1714.2 +038900 ADD 1 TO RECORD-COUNT. NC1714.2 +039000Y IF RECORD-COUNT GREATER 42 NC1714.2 +039100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1714.2 +039200Y MOVE SPACE TO DUMMY-RECORD NC1714.2 +039300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1714.2 +039400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1714.2 +039500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1714.2 +039600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1714.2 +039700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1714.2 +039800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +039900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +040000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +040100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1714.2 +040200Y MOVE ZERO TO RECORD-COUNT. NC1714.2 +040300 PERFORM WRT-LN. NC1714.2 +040400 WRT-LN. NC1714.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1714.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1714.2 +040700 BLANK-LINE-PRINT. NC1714.2 +040800 PERFORM WRT-LN. NC1714.2 +040900 FAIL-ROUTINE. NC1714.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1714.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1714.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1714.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1714.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1714.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1714.2 +041700 GO TO FAIL-ROUTINE-EX. NC1714.2 +041800 FAIL-ROUTINE-WRITE. NC1714.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1714.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1714.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1714.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1714.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1714.2 +042400 BAIL-OUT. NC1714.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1714.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1714.2 +042700 BAIL-OUT-WRITE. NC1714.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1714.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1714.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1714.2 +043200 BAIL-OUT-EX. EXIT. NC1714.2 +043300 CCVS1-EXIT. NC1714.2 +043400 EXIT. NC1714.2 +043500 SECT-NC171A-001 SECTION. NC1714.2 +043600* NC1714.2 +043700* NC1714.2 +043800 DIV-INIT-F1-1. NC1714.2 +043900 MOVE "DIVIDE INTO" TO FEATURE. NC1714.2 +044000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +044100 MOVE 1620.36 TO DIV1. NC1714.2 +044200 DIV-TEST-F1-1. NC1714.2 +044300 DIVIDE 64.3 INTO DIV1. NC1714.2 +044400 IF DIV1 EQUAL TO 25.2 NC1714.2 +044500 PERFORM PASS NC1714.2 +044600 ELSE NC1714.2 +044700 GO TO DIV-FAIL-F1-1. NC1714.2 +044800 GO TO DIV-WRITE-F1-1. NC1714.2 +044900 DIV-DELETE-F1-1. NC1714.2 +045000 PERFORM DE-LETE. NC1714.2 +045100 GO TO DIV-WRITE-F1-1. NC1714.2 +045200 DIV-FAIL-F1-1. NC1714.2 +045300 PERFORM FAIL. NC1714.2 +045400 MOVE DIV1 TO COMPUTED-N. NC1714.2 +045500 MOVE +25.2 TO CORRECT-N. NC1714.2 +045600 DIV-WRITE-F1-1. NC1714.2 +045700 MOVE "DIV-TEST-F1-1" TO PAR-NAME. NC1714.2 +045800 PERFORM PRINT-DETAIL. NC1714.2 +045900 DIV-INIT-F1-2. NC1714.2 +046000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +046100 MOVE 44.1 TO DIV2. NC1714.2 +046200 MOVE 1661.7 TO DIV3. NC1714.2 +046300 DIV-TEST-F1-2. NC1714.2 +046400 DIVIDE DIV2 INTO DIV3 ROUNDED. NC1714.2 +046500 IF DIV3 EQUAL TO 37.7 NC1714.2 +046600 PERFORM PASS NC1714.2 +046700 ELSE NC1714.2 +046800 GO TO DIV-FAIL-F1-2. NC1714.2 +046900 GO TO DIV-WRITE-F1-2. NC1714.2 +047000 DIV-DELETE-F1-2. NC1714.2 +047100 PERFORM DE-LETE. NC1714.2 +047200 GO TO DIV-WRITE-F1-2. NC1714.2 +047300 DIV-FAIL-F1-2. NC1714.2 +047400 PERFORM FAIL. NC1714.2 +047500 MOVE DIV3 TO COMPUTED-N. NC1714.2 +047600 MOVE +37.7 TO CORRECT-N. NC1714.2 +047700 DIV-WRITE-F1-2. NC1714.2 +047800 MOVE "DIV-TEST-F1-2 " TO PAR-NAME. NC1714.2 +047900 PERFORM PRINT-DETAIL. NC1714.2 +048000 DIV-INIT-F1-3. NC1714.2 +048100 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +048200 MOVE -9.642 TO DIV4. NC1714.2 +048300 MOVE .82 TO DIV5. NC1714.2 +048400 DIV-TEST-F1-3-1. NC1714.2 +048500 DIVIDE DIV5 INTO DIV4 ON SIZE ERROR NC1714.2 +048600 MOVE "M" TO XRAY. NC1714.2 +048700 IF XRAY EQUAL TO "M" NC1714.2 +048800 PERFORM PASS NC1714.2 +048900 ELSE NC1714.2 +049000 GO TO DIV-FAIL-F1-3-1. NC1714.2 +049100 GO TO DIV-WRITE-F1-3-1. NC1714.2 +049200 DIV-DELETE-F1-3-1. NC1714.2 +049300 PERFORM DE-LETE. NC1714.2 +049400 GO TO DIV-WRITE-F1-3-1. NC1714.2 +049500 DIV-FAIL-F1-3-1. NC1714.2 +049600 MOVE XRAY TO COMPUTED-X. NC1714.2 +049700 MOVE "M" TO CORRECT-X. NC1714.2 +049800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +049900 PERFORM FAIL. NC1714.2 +050000 DIV-WRITE-F1-3-1. NC1714.2 +050100 MOVE "DIV-TEST-F1-3-1 " TO PAR-NAME. NC1714.2 +050200 PERFORM PRINT-DETAIL. NC1714.2 +050300 DIV-TEST-F1-3-2. NC1714.2 +050400 IF DIV4 EQUAL TO -9.642 NC1714.2 +050500 PERFORM PASS NC1714.2 +050600 ELSE NC1714.2 +050700 GO TO DIV-FAIL-F1-3-2. NC1714.2 +050800 GO TO DIV-WRITE-F1-3-2. NC1714.2 +050900 DIV-DELETE-F1-3-2. NC1714.2 +051000 PERFORM DE-LETE. NC1714.2 +051100 GO TO DIV-WRITE-F1-3-2. NC1714.2 +051200 DIV-FAIL-F1-3-2. NC1714.2 +051300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +051400 PERFORM FAIL. NC1714.2 +051500 MOVE DIV4 TO COMPUTED-N. NC1714.2 +051600 MOVE -9.642 TO CORRECT-N. NC1714.2 +051700 DIV-WRITE-F1-3-2. NC1714.2 +051800 MOVE "DIV-TEST-F1-3-2 " TO PAR-NAME. NC1714.2 +051900 PERFORM PRINT-DETAIL. NC1714.2 +052000 DIV-INIT-F1-4. NC1714.2 +052100 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +052200 MOVE 44.1 TO DIV2. NC1714.2 +052300 MOVE 0 TO DIV6. NC1714.2 +052400 MOVE "A" TO XRAY. NC1714.2 +052500 DIV-TEST-F1-4-0. NC1714.2 +052600 DIVIDE DIV6 INTO DIV2 ON SIZE ERROR NC1714.2 +052700 MOVE "N" TO XRAY. NC1714.2 +052800 DIV-TEST-F1-4-1. NC1714.2 +052900 IF XRAY EQUAL TO "N" NC1714.2 +053000 PERFORM PASS NC1714.2 +053100 ELSE NC1714.2 +053200 GO TO DIV-FAIL-F1-4-1. NC1714.2 +053300 GO TO DIV-WRITE-F1-4-1. NC1714.2 +053400 DIV-DELETE-F1-4-1. NC1714.2 +053500 PERFORM DE-LETE. NC1714.2 +053600 GO TO DIV-WRITE-F1-4-1. NC1714.2 +053700 DIV-FAIL-F1-4-1. NC1714.2 +053800 MOVE XRAY TO COMPUTED-X. NC1714.2 +053900 MOVE "N" TO CORRECT-X. NC1714.2 +054000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +054100 PERFORM FAIL. NC1714.2 +054200 DIV-WRITE-F1-4-1. NC1714.2 +054300 MOVE "DIV-TEST-F1-4-1 " TO PAR-NAME. NC1714.2 +054400 PERFORM PRINT-DETAIL. NC1714.2 +054500 DIV-TEST-F1-4-2. NC1714.2 +054600 IF DIV2 EQUAL TO 44.1 NC1714.2 +054700 PERFORM PASS NC1714.2 +054800 ELSE NC1714.2 +054900 GO TO DIV-FAIL-F1-4-2. NC1714.2 +055000 GO TO DIV-WRITE-F1-4-2. NC1714.2 +055100 DIV-DELETE-F1-4-2. NC1714.2 +055200 PERFORM DE-LETE. NC1714.2 +055300 GO TO DIV-WRITE-F1-4-2. NC1714.2 +055400 DIV-FAIL-F1-4-2. NC1714.2 +055500 PERFORM FAIL. NC1714.2 +055600 MOVE DIV2 TO COMPUTED-N. NC1714.2 +055700 MOVE +44.1000 TO CORRECT-N. NC1714.2 +055800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +055900 DIV-WRITE-F1-4-2. NC1714.2 +056000 MOVE "DIV-TEST-F1-4-2 " TO PAR-NAME. NC1714.2 +056100 PERFORM PRINT-DETAIL. NC1714.2 +056200 DIV-INIT-F1-5. NC1714.2 +056300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +056400 MOVE 9.6 TO DIV7. NC1714.2 +056500 MOVE "B" TO XRAY. NC1714.2 +056600 DIV-TEST-F1-5-1. NC1714.2 +056700 DIVIDE 0.097 INTO DIV7 ROUNDED ON SIZE ERROR NC1714.2 +056800 MOVE "N" TO XRAY. NC1714.2 +056900 IF XRAY EQUAL TO "N" NC1714.2 +057000 PERFORM PASS NC1714.2 +057100 ELSE NC1714.2 +057200 GO TO DIV-FAIL-F1-5-1. NC1714.2 +057300 GO TO DIV-WRITE-F1-5-1. NC1714.2 +057400 DIV-DELETE-F1-5-1. NC1714.2 +057500 PERFORM DE-LETE. NC1714.2 +057600 GO TO DIV-WRITE-F1-5-1. NC1714.2 +057700 DIV-FAIL-F1-5-1. NC1714.2 +057800 MOVE XRAY TO COMPUTED-X. NC1714.2 +057900 MOVE "N" TO CORRECT-X. NC1714.2 +058000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +058100 PERFORM FAIL. NC1714.2 +058200 DIV-WRITE-F1-5-1. NC1714.2 +058300 MOVE "DIV-TEST-F1-5-1 " TO PAR-NAME. NC1714.2 +058400 PERFORM PRINT-DETAIL. NC1714.2 +058500 DIV-TEST-F1-5-2. NC1714.2 +058600 IF DIV7 NOT EQUAL TO 9.6 NC1714.2 +058700 GO TO DIV-FAIL-F1-5-2. NC1714.2 +058800 PERFORM PASS. NC1714.2 +058900 GO TO DIV-WRITE-F1-5-2. NC1714.2 +059000 DIV-DELETE-F1-5-2. NC1714.2 +059100 PERFORM DE-LETE. NC1714.2 +059200 GO TO DIV-WRITE-F1-5-2. NC1714.2 +059300 DIV-FAIL-F1-5-2. NC1714.2 +059400 PERFORM FAIL. NC1714.2 +059500 MOVE DIV7 TO COMPUTED-N. NC1714.2 +059600 MOVE +9.6 TO CORRECT-N. NC1714.2 +059700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +059800 DIV-WRITE-F1-5-2. NC1714.2 +059900 MOVE "DIV-TEST-F1-5-2 " TO PAR-NAME. NC1714.2 +060000 PERFORM PRINT-DETAIL. NC1714.2 +060100 DIV-INIT-F1-6. NC1714.2 +060200 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +060300 MOVE 99 TO WRK-DS-18V00. NC1714.2 +060400 MOVE 99 TO A99-DS-02V00. NC1714.2 +060500 DIV-TEST-F1-6-0. NC1714.2 +060600 DIVIDE A99-DS-02V00 INTO WRK-DS-18V00. NC1714.2 +060700 DIV-TEST-F1-6-1. NC1714.2 +060800 IF WRK-DS-18V00 EQUAL TO 000000000000000001 NC1714.2 +060900 PERFORM PASS NC1714.2 +061000 GO TO DIV-WRITE-F1-6. NC1714.2 +061100 GO TO DIV-FAIL-F1-6. NC1714.2 +061200 DIV-DELETE-F1-6. NC1714.2 +061300 PERFORM DE-LETE. NC1714.2 +061400 GO TO DIV-WRITE-F1-6. NC1714.2 +061500 DIV-FAIL-F1-6. NC1714.2 +061600 MOVE 000000000000000001 TO CORRECT-18V0. NC1714.2 +061700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1714.2 +061800 PERFORM FAIL. NC1714.2 +061900 DIV-WRITE-F1-6. NC1714.2 +062000 MOVE "DIV-TEST-F1-6 " TO PAR-NAME. NC1714.2 +062100 PERFORM PRINT-DETAIL. NC1714.2 +062200 DIV-INIT-F1-7. NC1714.2 +062300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +062400 MOVE 2 TO WRK-DS-12V00. NC1714.2 +062500 DIV-TEST-F1-7-0. NC1714.2 +062600 DIVIDE 4 INTO WRK-DS-12V00 ROUNDED. NC1714.2 +062700 DIV-TEST-F1-7-1. NC1714.2 +062800 IF WRK-DS-12V00 EQUAL TO 000000000001 NC1714.2 +062900 PERFORM PASS NC1714.2 +063000 GO TO DIV-WRITE-F1-7. NC1714.2 +063100 GO TO DIV-FAIL-F1-7. NC1714.2 +063200 DIV-DELETE-F1-7. NC1714.2 +063300 PERFORM DE-LETE. NC1714.2 +063400 GO TO DIV-WRITE-F1-7. NC1714.2 +063500 DIV-FAIL-F1-7. NC1714.2 +063600 MOVE WRK-DS-12V00 TO COMPUTED-18V0. NC1714.2 +063700 MOVE 000000000001 TO CORRECT-18V0. NC1714.2 +063800 PERFORM FAIL. NC1714.2 +063900 DIV-WRITE-F1-7. NC1714.2 +064000 MOVE "DIV-TEST-F1-7 " TO PAR-NAME. NC1714.2 +064100 PERFORM PRINT-DETAIL. NC1714.2 +064200 DIV-INIT-F1-8. NC1714.2 +064300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +064400 MOVE 1 TO WRK-DS-01V00. NC1714.2 +064500 MOVE "0" TO WRK-XN-00001. NC1714.2 +064600 DIV-TEST-F1-8-0. NC1714.2 +064700 DIVIDE 0.1 INTO WRK-DS-01V00 ON SIZE ERROR NC1714.2 +064800 MOVE "1" TO WRK-XN-00001. NC1714.2 +064900 DIV-TEST-F1-8-1. NC1714.2 +065000 IF WRK-DS-01V00 EQUAL TO 1 NC1714.2 +065100 PERFORM PASS NC1714.2 +065200 GO TO DIV-WRITE-F1-8-1. NC1714.2 +065300 GO TO DIV-FAIL-F1-8-1. NC1714.2 +065400 DIV-DELETE-F1-8-1. NC1714.2 +065500 PERFORM DE-LETE. NC1714.2 +065600 GO TO DIV-WRITE-F1-8-1. NC1714.2 +065700 DIV-FAIL-F1-8-1. NC1714.2 +065800 MOVE 1 TO CORRECT-N. NC1714.2 +065900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1714.2 +066000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +066100 PERFORM FAIL. NC1714.2 +066200 DIV-WRITE-F1-8-1. NC1714.2 +066300 MOVE "DIV-TEST-F1-8-1 " TO PAR-NAME. NC1714.2 +066400 PERFORM PRINT-DETAIL. NC1714.2 +066500 DIV-TEST-F1-8-2. NC1714.2 +066600 IF WRK-XN-00001 EQUAL TO "1" NC1714.2 +066700 PERFORM PASS NC1714.2 +066800 GO TO DIV-WRITE-F1-8-2. NC1714.2 +066900 MOVE "1" TO CORRECT-A. NC1714.2 +067000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1714.2 +067100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +067200 PERFORM FAIL. NC1714.2 +067300 GO TO DIV-WRITE-F1-8-2. NC1714.2 +067400 DIV-DELETE-F1-8-2. NC1714.2 +067500 PERFORM DE-LETE. NC1714.2 +067600 DIV-WRITE-F1-8-2. NC1714.2 +067700 MOVE "DIV-TEST-F1-8-2 " TO PAR-NAME. NC1714.2 +067800 PERFORM PRINT-DETAIL. NC1714.2 +067900 DIV-INIT-F1-9. NC1714.2 +068000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +068100 MOVE -.000000001 TO WRK-DS-09V09. NC1714.2 +068200 MOVE "1" TO WRK-XN-00001. NC1714.2 +068300 DIV-TEST-F1-9-0. NC1714.2 +068400 DIVIDE A01ONE-DS-P0801 INTO WRK-DS-09V09 ON SIZE ERROR NC1714.2 +068500 MOVE "0" TO WRK-XN-00001. NC1714.2 +068600 DIV-TEST-F1-9-1. NC1714.2 +068700 IF WRK-DS-18V00-S EQUAL TO -000000001000000000 NC1714.2 +068800 PERFORM PASS NC1714.2 +068900 GO TO DIV-WRITE-F1-9-1. NC1714.2 +069000 GO TO DIV-FAIL-F1-9-1. NC1714.2 +069100 DIV-DELETE-F1-9-1. NC1714.2 +069200 PERFORM DE-LETE. NC1714.2 +069300 GO TO DIV-WRITE-F1-9-1. NC1714.2 +069400 DIV-FAIL-F1-9-1. NC1714.2 +069500 MOVE -000000001000000000 TO CORRECT-18V0. NC1714.2 +069600 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1714.2 +069700 PERFORM FAIL. NC1714.2 +069800 DIV-WRITE-F1-9-1. NC1714.2 +069900 MOVE "DIV-TEST-F1-9-1 " TO PAR-NAME. NC1714.2 +070000 PERFORM PRINT-DETAIL. NC1714.2 +070100 DIV-TEST-F1-9-2. NC1714.2 +070200 IF WRK-XN-00001 EQUAL TO "0" NC1714.2 +070300 MOVE "1" TO CORRECT-A NC1714.2 +070400 MOVE "0" TO COMPUTED-A NC1714.2 +070500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1714.2 +070600 PERFORM FAIL NC1714.2 +070700 GO TO DIV-WRITE-F1-9-2. NC1714.2 +070800 PERFORM PASS. NC1714.2 +070900 GO TO DIV-WRITE-F1-9-2. NC1714.2 +071000 DIV-DELETE-F1-9-2. NC1714.2 +071100 PERFORM DE-LETE. NC1714.2 +071200 DIV-WRITE-F1-9-2. NC1714.2 +071300 MOVE "DIV-TEST-F1-9-2 " TO PAR-NAME. NC1714.2 +071400 PERFORM PRINT-DETAIL. NC1714.2 +071500 DIV-INIT-F1-10. NC1714.2 +071600 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +071700 MOVE ZERO TO WRK-DS-01V00 AZERO-DS-05V05. NC1714.2 +071800 MOVE "0" TO WRK-XN-00001. NC1714.2 +071900 DIV-TEST-F1-10-0. NC1714.2 +072000 DIVIDE AZERO-DS-05V05 INTO WRK-DS-01V00 ROUNDED NC1714.2 +072100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1714.2 +072200 DIV-TEST-F1-10-1. NC1714.2 +072300 IF WRK-DS-01V00 EQUAL TO 0 NC1714.2 +072400 PERFORM PASS NC1714.2 +072500 GO TO DIV-WRITE-F1-10-1. NC1714.2 +072600 GO TO DIV-FAIL-F1-10-1. NC1714.2 +072700 DIV-DELETE-F1-10-1. NC1714.2 +072800 PERFORM DE-LETE. NC1714.2 +072900 GO TO DIV-WRITE-F1-10-1. NC1714.2 +073000 DIV-FAIL-F1-10-1. NC1714.2 +073100 MOVE 0 TO CORRECT-N. NC1714.2 +073200 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1714.2 +073300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +073400 PERFORM FAIL. NC1714.2 +073500 DIV-WRITE-F1-10-1. NC1714.2 +073600 MOVE "DIV-TEST-F1-10-1 " TO PAR-NAME. NC1714.2 +073700 PERFORM PRINT-DETAIL. NC1714.2 +073800 DIV-TEST-F1-10-2. NC1714.2 +073900 IF WRK-XN-00001 EQUAL TO "1" NC1714.2 +074000 PERFORM PASS NC1714.2 +074100 GO TO DIV-WRITE-F1-10-2. NC1714.2 +074200 DIV-FAIL-F1-10-2. NC1714.2 +074300 MOVE "1" TO CORRECT-A. NC1714.2 +074400 MOVE WRK-XN-00001 TO COMPUTED-A. NC1714.2 +074500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +074600 PERFORM FAIL. NC1714.2 +074700 GO TO DIV-WRITE-F1-10-2. NC1714.2 +074800 DIV-DELETE-F1-10-2. NC1714.2 +074900 PERFORM DE-LETE. NC1714.2 +075000 DIV-WRITE-F1-10-2. NC1714.2 +075100 MOVE "DIV-TEST-F1-10-2 " TO PAR-NAME. NC1714.2 +075200 PERFORM PRINT-DETAIL. NC1714.2 +075300 DIV-INIT-F1-11. NC1714.2 +075400 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +075500 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +075600 MOVE "1" TO WRK-XN-00001. NC1714.2 +075700 DIV-TEST-F1-11-0. NC1714.2 +075800 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 ROUNDED NC1714.2 +075900 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1714.2 +076000 DIV-TEST-F1-11-1. NC1714.2 +076100 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1714.2 +076200 PERFORM PASS NC1714.2 +076300 GO TO DIV-WRITE-F1-11-1. NC1714.2 +076400 GO TO DIV-FAIL-F1-11-1. NC1714.2 +076500 DIV-DELETE-F1-11-1. NC1714.2 +076600 PERFORM DE-LETE. NC1714.2 +076700 GO TO DIV-WRITE-F1-11-1. NC1714.2 +076800 DIV-FAIL-F1-11-1. NC1714.2 +076900 MOVE 000000001000000000 TO CORRECT-18V0. NC1714.2 +077000 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1714.2 +077100 PERFORM FAIL. NC1714.2 +077200 DIV-WRITE-F1-11-1. NC1714.2 +077300 MOVE "DIV-TEST-F1-11-1 " TO PAR-NAME. NC1714.2 +077400 PERFORM PRINT-DETAIL. NC1714.2 +077500 DIV-TEST-F1-11-2. NC1714.2 +077600 IF WRK-XN-00001 EQUAL TO "0" NC1714.2 +077700 MOVE WRK-XN-00001 TO COMPUTED-A NC1714.2 +077800 MOVE "1" TO CORRECT-A NC1714.2 +077900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1714.2 +078000 PERFORM FAIL NC1714.2 +078100 GO TO DIV-WRITE-F1-11-2. NC1714.2 +078200 PERFORM PASS. NC1714.2 +078300 GO TO DIV-WRITE-F1-11-2. NC1714.2 +078400 DIV-DELETE-F1-11-2. NC1714.2 +078500 PERFORM DE-LETE. NC1714.2 +078600 DIV-WRITE-F1-11-2. NC1714.2 +078700 MOVE "DIV-TEST-F1-11-2 " TO PAR-NAME. NC1714.2 +078800 PERFORM PRINT-DETAIL. NC1714.2 +078900 DIV-INIT-F1-12. NC1714.2 +079000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +079100 MOVE -99 TO WRK-DS-02V00. NC1714.2 +079200 DIV-TEST-F1-12-0. NC1714.2 +079300 DIVIDE A99-DS-02V00 INTO WRK-DS-02V00. NC1714.2 +079400 DIV-TEST-F1-12-1. NC1714.2 +079500 IF WRK-DS-02V00 EQUAL TO -01 NC1714.2 +079600 PERFORM PASS NC1714.2 +079700 GO TO DIV-WRITE-F1-12. NC1714.2 +079800 DIV-FAIL-F1-12. NC1714.2 +079900 MOVE -01 TO CORRECT-N. NC1714.2 +080000 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1714.2 +080100 PERFORM FAIL. NC1714.2 +080200 GO TO DIV-WRITE-F1-12. NC1714.2 +080300 DIV-DELETE-F1-12. NC1714.2 +080400 PERFORM DE-LETE. NC1714.2 +080500 DIV-WRITE-F1-12. NC1714.2 +080600 MOVE "DIV-TEST-F1-12 " TO PAR-NAME. NC1714.2 +080700 PERFORM PRINT-DETAIL. NC1714.2 +080800 DIV-INIT-F1-13. NC1714.2 +080900 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +081000 MOVE -99.00 TO WRK-CS-02V02. NC1714.2 +081100 DIV-TEST-F1-13-0. NC1714.2 +081200 DIVIDE A990-DS-0201P INTO WRK-CS-02V02. NC1714.2 +081300 DIV-TEST-F1-13-1. NC1714.2 +081400 MOVE WRK-CS-02V02 TO WRK-DS-06V06. NC1714.2 +081500 IF WRK-DS-12V00-S EQUAL TO -000000100000 NC1714.2 +081600 PERFORM PASS NC1714.2 +081700 GO TO DIV-WRITE-F1-13. NC1714.2 +081800 MOVE -000000.100000 TO CORRECT-N. NC1714.2 +081900 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1714.2 +082000 PERFORM FAIL. NC1714.2 +082100 GO TO DIV-WRITE-F1-13. NC1714.2 +082200 DIV-DELETE-F1-13. NC1714.2 +082300 PERFORM DE-LETE. NC1714.2 +082400 DIV-WRITE-F1-13. NC1714.2 +082500 MOVE "DIV-TEST-F1-13 " TO PAR-NAME. NC1714.2 +082600 PERFORM PRINT-DETAIL. NC1714.2 +082700* NC1714.2 +082800* NC1714.2 +082900 DIV-INIT-F1-14. NC1714.2 +083000* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +083100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +083200 MOVE "DIV-TEST-F1-14 " TO PAR-NAME NC1714.2 +083300 MOVE "Z" TO XRAY. NC1714.2 +083400 MOVE 1 TO REC-CT. NC1714.2 +083500 MOVE 1620.36 TO DIV1. NC1714.2 +083600 MOVE 44.1 TO DIV2. NC1714.2 +083700 DIV-TEST-F1-14-0. NC1714.2 +083800 DIVIDE DIV2 INTO DIV1 NC1714.2 +083900 NOT ON SIZE ERROR NC1714.2 +084000 MOVE "N" TO XRAY. NC1714.2 +084100 GO TO DIV-TEST-F1-14-1. NC1714.2 +084200 DIV-DELETE-F1-14-1. NC1714.2 +084300 PERFORM DE-LETE. NC1714.2 +084400 PERFORM PRINT-DETAIL. NC1714.2 +084500 GO TO DIV-INIT-F1-15. NC1714.2 +084600 DIV-TEST-F1-14-1. NC1714.2 +084700 MOVE "DIV-TEST-F1-14-1 " TO PAR-NAME. NC1714.2 +084800 IF DIV1 = 36.74 NC1714.2 +084900 PERFORM PASS NC1714.2 +085000 PERFORM PRINT-DETAIL NC1714.2 +085100 ELSE NC1714.2 +085200 MOVE DIV1 TO COMPUTED-N NC1714.2 +085300 MOVE 36.74 TO CORRECT-N NC1714.2 +085400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +085500 PERFORM FAIL NC1714.2 +085600 PERFORM PRINT-DETAIL. NC1714.2 +085700 ADD 1 TO REC-CT. NC1714.2 +085800 DIV-TEST-F1-14-2. NC1714.2 +085900 MOVE "DIV-TEST-F1-14-2 " TO PAR-NAME. NC1714.2 +086000 IF XRAY = "N" NC1714.2 +086100 PERFORM PASS NC1714.2 +086200 PERFORM PRINT-DETAIL NC1714.2 +086300 ELSE NC1714.2 +086400 MOVE XRAY TO COMPUTED-X NC1714.2 +086500 MOVE "N" TO CORRECT-X NC1714.2 +086600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1714.2 +086700 TO RE-MARK NC1714.2 +086800 PERFORM FAIL NC1714.2 +086900 PERFORM PRINT-DETAIL. NC1714.2 +087000* NC1714.2 +087100* NC1714.2 +087200 DIV-INIT-F1-15. NC1714.2 +087300* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +087400 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +087500 MOVE "DIV-TEST-F1-15 " TO PAR-NAME NC1714.2 +087600 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +087700 MOVE "1" TO WRK-XN-00001. NC1714.2 +087800 MOVE 1 TO REC-CT. NC1714.2 +087900 DIV-TEST-F1-15-0. NC1714.2 +088000 DIVIDE A18ONES-DS-09V09 NC1714.2 +088100 INTO WRK-DS-09V09 ROUNDED NC1714.2 +088200 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1714.2 +088300 GO TO DIV-TEST-F1-15-1. NC1714.2 +088400 DIV-DELETE-F1-15-1. NC1714.2 +088500 PERFORM DE-LETE. NC1714.2 +088600 PERFORM PRINT-DETAIL. NC1714.2 +088700 GO TO DIV-INIT-F1-16. NC1714.2 +088800 DIV-TEST-F1-15-1. NC1714.2 +088900 MOVE "DIV-TEST-F1-15-1 " TO PAR-NAME. NC1714.2 +089000 IF WRK-XN-00001 = "0" NC1714.2 +089100 PERFORM PASS NC1714.2 +089200 PERFORM PRINT-DETAIL NC1714.2 +089300 ELSE NC1714.2 +089400 MOVE "0" TO CORRECT-X NC1714.2 +089500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +089600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +089700 TO RE-MARK NC1714.2 +089800 PERFORM FAIL NC1714.2 +089900 PERFORM PRINT-DETAIL. NC1714.2 +090000 ADD 1 TO REC-CT. NC1714.2 +090100 DIV-TEST-F1-15-2. NC1714.2 +090200 MOVE "DIV-TEST-F1-15-2 " TO PAR-NAME. NC1714.2 +090300 IF WRK-DS-09V09 = 1 NC1714.2 +090400 PERFORM PASS NC1714.2 +090500 PERFORM PRINT-DETAIL NC1714.2 +090600 ELSE NC1714.2 +090700 MOVE 1 TO CORRECT-N NC1714.2 +090800 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +090900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +091000 TO RE-MARK NC1714.2 +091100 PERFORM FAIL NC1714.2 +091200 PERFORM PRINT-DETAIL. NC1714.2 +091300* NC1714.2 +091400* NC1714.2 +091500 DIV-INIT-F1-16. NC1714.2 +091600* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +091700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +091800 MOVE "DIV-TEST-F1-16 " TO PAR-NAME. NC1714.2 +091900 MOVE "Z" TO XRAY. NC1714.2 +092000 MOVE 1620.36 TO DIV1. NC1714.2 +092100 MOVE 44.1 TO DIV2. NC1714.2 +092200 MOVE 1 TO REC-CT. NC1714.2 +092300 DIV-TEST-F1-16-0. NC1714.2 +092400 DIVIDE DIV2 INTO DIV1 NC1714.2 +092500 ON SIZE ERROR NC1714.2 +092600 MOVE "E" TO XRAY NC1714.2 +092700 NOT ON SIZE ERROR NC1714.2 +092800 MOVE "N" TO XRAY. NC1714.2 +092900 GO TO DIV-TEST-F1-16-1. NC1714.2 +093000 DIV-DELETE-F1-16-1. NC1714.2 +093100 PERFORM DE-LETE. NC1714.2 +093200 PERFORM PRINT-DETAIL. NC1714.2 +093300 GO TO DIV-INIT-F1-17. NC1714.2 +093400 DIV-TEST-F1-16-1. NC1714.2 +093500 MOVE "DIV-TEST-F1-16-1 " TO PAR-NAME. NC1714.2 +093600 IF XRAY = "N" NC1714.2 +093700 PERFORM PASS NC1714.2 +093800 PERFORM PRINT-DETAIL NC1714.2 +093900 ELSE NC1714.2 +094000 MOVE "N" TO CORRECT-X NC1714.2 +094100 MOVE XRAY TO COMPUTED-X NC1714.2 +094200 MOVE "NOT SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK NC1714.2 +094300 PERFORM FAIL NC1714.2 +094400 PERFORM PRINT-DETAIL. NC1714.2 +094500 ADD 1 TO REC-CT. NC1714.2 +094600 DIV-TEST-F1-16-2. NC1714.2 +094700 MOVE "DIV-TEST-F1-16-2" TO PAR-NAME. NC1714.2 +094800 IF DIV1 = 36.74 NC1714.2 +094900 PERFORM PASS NC1714.2 +095000 PERFORM PRINT-DETAIL NC1714.2 +095100 ELSE NC1714.2 +095200 ADD 1 TO REC-CT NC1714.2 +095300 MOVE DIV1 TO COMPUTED-N NC1714.2 +095400 MOVE 36.74 TO CORRECT-N NC1714.2 +095500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +095600 PERFORM FAIL NC1714.2 +095700 PERFORM PRINT-DETAIL. NC1714.2 +095800* NC1714.2 +095900* NC1714.2 +096000 DIV-INIT-F1-17. NC1714.2 +096100* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +096200 MOVE "DIV-TEST-F1-17 " TO PAR-NAME NC1714.2 +096300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +096400 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +096500 MOVE "0" TO WRK-XN-00001. NC1714.2 +096600 MOVE 1 TO REC-CT. NC1714.2 +096700 DIV-TEST-F1-17-0. NC1714.2 +096800 DIVIDE A18ONES-DS-09V09 NC1714.2 +096900 INTO WRK-DS-09V09 ROUNDED NC1714.2 +097000 ON SIZE ERROR NC1714.2 +097100 MOVE "1" TO WRK-XN-00001 NC1714.2 +097200 NOT ON SIZE ERROR NC1714.2 +097300 MOVE "2" TO WRK-XN-00001. NC1714.2 +097400 GO TO DIV-TEST-F1-17-1. NC1714.2 +097500 DIV-DELETE-F1-17-1. NC1714.2 +097600 PERFORM DE-LETE. NC1714.2 +097700 PERFORM PRINT-DETAIL. NC1714.2 +097800 GO TO DIV-INIT-F1-18. NC1714.2 +097900 DIV-TEST-F1-17-1. NC1714.2 +098000 MOVE "DIV-TEST-F1-17-1 " TO PAR-NAME. NC1714.2 +098100 IF WRK-XN-00001 = "2" NC1714.2 +098200 PERFORM PASS NC1714.2 +098300 PERFORM PRINT-DETAIL NC1714.2 +098400 ELSE NC1714.2 +098500 MOVE "2" TO CORRECT-X NC1714.2 +098600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +098700 PERFORM FAIL NC1714.2 +098800 PERFORM PRINT-DETAIL. NC1714.2 +098900 ADD 1 TO REC-CT. NC1714.2 +099000 DIV-TEST-F1-17-2. NC1714.2 +099100 MOVE "DIV-TEST-F1-17-2 " TO PAR-NAME. NC1714.2 +099200 IF WRK-DS-09V09 = 1 NC1714.2 +099300 PERFORM PASS NC1714.2 +099400 PERFORM PRINT-DETAIL NC1714.2 +099500 ELSE NC1714.2 +099600 MOVE 1 TO CORRECT-18V0 NC1714.2 +099700 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +099800 PERFORM FAIL NC1714.2 +099900 PERFORM PRINT-DETAIL. NC1714.2 +100000* NC1714.2 +100100* NC1714.2 +100200 DIV-INIT-F1-18. NC1714.2 +100300* ==--> MULTIPLE RESULT FIELDS <--== NC1714.2 +100400 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +100500 MOVE "DIV-TEST-F1-18" TO PAR-NAME. NC1714.2 +100600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +100700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +100800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +100900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +101000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +101100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +101200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +101300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +101400 MOVE 1 TO REC-CT. NC1714.2 +101500 DIV-TEST-F1-18-0. NC1714.2 +101600 DIVIDE WRK-DU-1V3-1 NC1714.2 +101700 INTO WRK-DU-2V2-1 NC1714.2 +101800 WRK-DU-2V2-2 ROUNDED NC1714.2 +101900 WRK-DU-2V2-3 NC1714.2 +102000 WRK-DU-2V2-4 ROUNDED NC1714.2 +102100 WRK-DU-1V3-2 NC1714.2 +102200 WRK-DU-2V2-5 NC1714.2 +102300 WRK-DU-2V1-1 ROUNDED. NC1714.2 +102400 GO TO DIV-TEST-F1-18-1. NC1714.2 +102500 DIV-DELETE-F1-18. NC1714.2 +102600 PERFORM DE-LETE. NC1714.2 +102700 PERFORM PRINT-DETAIL. NC1714.2 +102800 GO TO DIV-INIT-F1-19. NC1714.2 +102900 DIV-TEST-F1-18-1. NC1714.2 +103000 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +103100 PERFORM PASS NC1714.2 +103200 PERFORM PRINT-DETAIL NC1714.2 +103300 ELSE NC1714.2 +103400 PERFORM FAIL NC1714.2 +103500 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +103600 MOVE 15.42 TO CORRECT-N NC1714.2 +103700 PERFORM PRINT-DETAIL. NC1714.2 +103800 ADD 1 TO REC-CT. NC1714.2 +103900 DIV-TEST-F1-18-2. NC1714.2 +104000 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +104100 PERFORM PASS NC1714.2 +104200 PERFORM PRINT-DETAIL NC1714.2 +104300 ELSE NC1714.2 +104400 PERFORM FAIL NC1714.2 +104500 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +104600 MOVE 60.83 TO CORRECT-N NC1714.2 +104700 PERFORM PRINT-DETAIL. NC1714.2 +104800 ADD 1 TO REC-CT. NC1714.2 +104900 DIV-TEST-F1-18-3. NC1714.2 +105000 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +105100 PERFORM PASS NC1714.2 +105200 PERFORM PRINT-DETAIL NC1714.2 +105300 ELSE NC1714.2 +105400 PERFORM FAIL NC1714.2 +105500 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +105600 MOVE 60.92 TO CORRECT-N NC1714.2 +105700 PERFORM PRINT-DETAIL. NC1714.2 +105800 ADD 1 TO REC-CT. NC1714.2 +105900 DIV-TEST-F1-18-4. NC1714.2 +106000 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +106100 PERFORM PASS NC1714.2 +106200 PERFORM PRINT-DETAIL NC1714.2 +106300 ELSE NC1714.2 +106400 PERFORM FAIL NC1714.2 +106500 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +106600 MOVE 60.93 TO CORRECT-N NC1714.2 +106700 PERFORM PRINT-DETAIL. NC1714.2 +106800 ADD 1 TO REC-CT. NC1714.2 +106900 DIV-TEST-F1-18-5. NC1714.2 +107000 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +107100 PERFORM PASS NC1714.2 +107200 PERFORM PRINT-DETAIL NC1714.2 +107300 ELSE NC1714.2 +107400 PERFORM FAIL NC1714.2 +107500 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +107600 MOVE 1.000 TO CORRECT-N NC1714.2 +107700 PERFORM PRINT-DETAIL. NC1714.2 +107800 ADD 1 TO REC-CT. NC1714.2 +107900 DIV-TEST-F1-18-6. NC1714.2 +108000 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +108100 PERFORM PASS NC1714.2 +108200 PERFORM PRINT-DETAIL NC1714.2 +108300 ELSE NC1714.2 +108400 PERFORM FAIL NC1714.2 +108500 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +108600 MOVE 09.99 TO CORRECT-N NC1714.2 +108700 PERFORM PRINT-DETAIL. NC1714.2 +108800 ADD 1 TO REC-CT. NC1714.2 +108900 DIV-TEST-F1-18-7. NC1714.2 +109000 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +109100 PERFORM PASS NC1714.2 +109200 PERFORM PRINT-DETAIL NC1714.2 +109300 ELSE NC1714.2 +109400 PERFORM FAIL NC1714.2 +109500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +109600 MOVE 10.00 TO CORRECT-N NC1714.2 +109700 PERFORM PRINT-DETAIL. NC1714.2 +109800* NC1714.2 +109900* NC1714.2 +110000 DIV-INIT-F1-19. NC1714.2 +110100* ==--> SIZE ERROR CONDITION <--== NC1714.2 +110200* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +110300 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +110400 MOVE "DIV-TEST-F1-19" TO PAR-NAME. NC1714.2 +110500 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +110600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +110700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +110800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +110900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +111000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +111100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +111200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +111300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +111400 MOVE "0" TO WRK-XN-00001. NC1714.2 +111500 MOVE 1 TO REC-CT. NC1714.2 +111600 DIV-TEST-F1-19-0. NC1714.2 +111700 DIVIDE WRK-DU-0V2-1 NC1714.2 +111800 INTO WRK-DU-2V2-1 NC1714.2 +111900 WRK-DU-2V2-2 NC1714.2 +112000 WRK-DU-2V2-3 NC1714.2 +112100 WRK-DU-2V2-4 NC1714.2 +112200 WRK-DU-1V3-2 NC1714.2 +112300 WRK-DU-2V2-5 NC1714.2 +112400 WRK-DU-2V1-1 NC1714.2 +112500 ON SIZE ERROR NC1714.2 +112600 MOVE "1" TO WRK-XN-00001. NC1714.2 +112700 GO TO DIV-TEST-F1-19-1. NC1714.2 +112800 DIV-DELETE-F1-19. NC1714.2 +112900 PERFORM DE-LETE. NC1714.2 +113000 PERFORM PRINT-DETAIL. NC1714.2 +113100 GO TO DIV-INIT-F1-20. NC1714.2 +113200 DIV-TEST-F1-19-1. NC1714.2 +113300 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +113400 PERFORM PASS NC1714.2 +113500 PERFORM PRINT-DETAIL NC1714.2 +113600 ELSE NC1714.2 +113700 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +113800 PERFORM FAIL NC1714.2 +113900 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +114000 MOVE 15.44 TO CORRECT-N NC1714.2 +114100 PERFORM PRINT-DETAIL. NC1714.2 +114200 ADD 1 TO REC-CT. NC1714.2 +114300 DIV-TEST-F1-19-2. NC1714.2 +114400 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +114500 PERFORM PASS NC1714.2 +114600 PERFORM PRINT-DETAIL NC1714.2 +114700 ELSE NC1714.2 +114800 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +114900 PERFORM FAIL NC1714.2 +115000 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +115100 MOVE 60.89 TO CORRECT-N NC1714.2 +115200 PERFORM PRINT-DETAIL. NC1714.2 +115300 ADD 1 TO REC-CT. NC1714.2 +115400 DIV-TEST-F1-19-3. NC1714.2 +115500 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +115600 PERFORM PASS NC1714.2 +115700 PERFORM PRINT-DETAIL NC1714.2 +115800 ELSE NC1714.2 +115900 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +116000 PERFORM FAIL NC1714.2 +116100 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +116200 MOVE 60.92 TO CORRECT-N NC1714.2 +116300 PERFORM PRINT-DETAIL. NC1714.2 +116400 ADD 1 TO REC-CT. NC1714.2 +116500 DIV-TEST-F1-19-4. NC1714.2 +116600 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +116700 PERFORM PASS NC1714.2 +116800 PERFORM PRINT-DETAIL NC1714.2 +116900 ELSE NC1714.2 +117000 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +117100 PERFORM FAIL NC1714.2 +117200 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +117300 MOVE 60.99 TO CORRECT-N NC1714.2 +117400 PERFORM PRINT-DETAIL. NC1714.2 +117500 ADD 1 TO REC-CT. NC1714.2 +117600 DIV-TEST-F1-19-5. NC1714.2 +117700 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +117800 PERFORM PASS NC1714.2 +117900 PERFORM PRINT-DETAIL NC1714.2 +118000 ELSE NC1714.2 +118100 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +118200 PERFORM FAIL NC1714.2 +118300 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +118400 MOVE 1.001 TO CORRECT-N NC1714.2 +118500 PERFORM PRINT-DETAIL. NC1714.2 +118600 ADD 1 TO REC-CT. NC1714.2 +118700 DIV-TEST-F1-19-6. NC1714.2 +118800 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +118900 PERFORM PASS NC1714.2 +119000 PERFORM PRINT-DETAIL NC1714.2 +119100 ELSE NC1714.2 +119200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +119300 PERFORM FAIL NC1714.2 +119400 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +119500 MOVE 09.99 TO CORRECT-N NC1714.2 +119600 PERFORM PRINT-DETAIL. NC1714.2 +119700 ADD 1 TO REC-CT. NC1714.2 +119800 DIV-TEST-F1-19-7. NC1714.2 +119900 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +120000 PERFORM PASS NC1714.2 +120100 PERFORM PRINT-DETAIL NC1714.2 +120200 ELSE NC1714.2 +120300 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +120400 PERFORM FAIL NC1714.2 +120500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +120600 MOVE 10.0 TO CORRECT-N NC1714.2 +120700 PERFORM PRINT-DETAIL. NC1714.2 +120800 ADD 1 TO REC-CT. NC1714.2 +120900 DIV-TEST-F1-19-8. NC1714.2 +121000 IF WRK-XN-00001 = "1" NC1714.2 +121100 PERFORM PASS NC1714.2 +121200 PERFORM PRINT-DETAIL NC1714.2 +121300 ELSE NC1714.2 +121400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1714.2 +121500 PERFORM FAIL NC1714.2 +121600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +121700 MOVE "1" TO CORRECT-X NC1714.2 +121800 PERFORM PRINT-DETAIL. NC1714.2 +121900* NC1714.2 +122000* NC1714.2 +122100 DIV-INIT-F1-20. NC1714.2 +122200* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +122300* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +122400 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +122500 MOVE "DIV-TEST-F1-20" TO PAR-NAME. NC1714.2 +122600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +122700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +122800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +122900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +123000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +123100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +123200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +123300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +123400 MOVE "0" TO WRK-XN-00001. NC1714.2 +123500 MOVE 1 TO REC-CT. NC1714.2 +123600 DIV-TEST-F1-20-0. NC1714.2 +123700 DIVIDE WRK-DU-1V3-1 NC1714.2 +123800 INTO WRK-DU-2V2-1 NC1714.2 +123900 WRK-DU-2V2-2 ROUNDED NC1714.2 +124000 WRK-DU-2V2-3 NC1714.2 +124100 WRK-DU-2V2-4 ROUNDED NC1714.2 +124200 WRK-DU-1V3-2 NC1714.2 +124300 WRK-DU-2V2-5 NC1714.2 +124400 WRK-DU-2V1-1 ROUNDED NC1714.2 +124500 ON SIZE ERROR NC1714.2 +124600 MOVE "1" TO WRK-XN-00001. NC1714.2 +124700 GO TO DIV-TEST-F1-20-1. NC1714.2 +124800 DIV-DELETE-F1-20. NC1714.2 +124900 PERFORM DE-LETE. NC1714.2 +125000 PERFORM PRINT-DETAIL. NC1714.2 +125100 GO TO DIV-INIT-F1-21. NC1714.2 +125200 DIV-TEST-F1-20-1. NC1714.2 +125300 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +125400 PERFORM PASS NC1714.2 +125500 PERFORM PRINT-DETAIL NC1714.2 +125600 ELSE NC1714.2 +125700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +125800 PERFORM FAIL NC1714.2 +125900 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +126000 MOVE 15.42 TO CORRECT-N NC1714.2 +126100 PERFORM PRINT-DETAIL. NC1714.2 +126200 ADD 1 TO REC-CT. NC1714.2 +126300 DIV-TEST-F1-20-2. NC1714.2 +126400 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +126500 PERFORM PASS NC1714.2 +126600 PERFORM PRINT-DETAIL NC1714.2 +126700 ELSE NC1714.2 +126800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +126900 PERFORM FAIL NC1714.2 +127000 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +127100 MOVE 60.83 TO CORRECT-N NC1714.2 +127200 PERFORM PRINT-DETAIL. NC1714.2 +127300 ADD 1 TO REC-CT. NC1714.2 +127400 DIV-TEST-F1-20-3. NC1714.2 +127500 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +127600 PERFORM PASS NC1714.2 +127700 PERFORM PRINT-DETAIL NC1714.2 +127800 ELSE NC1714.2 +127900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +128000 PERFORM FAIL NC1714.2 +128100 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +128200 MOVE 60.92 TO CORRECT-N NC1714.2 +128300 PERFORM PRINT-DETAIL. NC1714.2 +128400 ADD 1 TO REC-CT. NC1714.2 +128500 DIV-TEST-F1-20-4. NC1714.2 +128600 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +128700 PERFORM PASS NC1714.2 +128800 PERFORM PRINT-DETAIL NC1714.2 +128900 ELSE NC1714.2 +129000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +129100 PERFORM FAIL NC1714.2 +129200 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +129300 MOVE 60.93 TO CORRECT-N NC1714.2 +129400 PERFORM PRINT-DETAIL. NC1714.2 +129500 ADD 1 TO REC-CT. NC1714.2 +129600 DIV-TEST-F1-20-5. NC1714.2 +129700 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +129800 PERFORM PASS NC1714.2 +129900 PERFORM PRINT-DETAIL NC1714.2 +130000 ELSE NC1714.2 +130100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +130200 PERFORM FAIL NC1714.2 +130300 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +130400 MOVE 1.000 TO CORRECT-N NC1714.2 +130500 PERFORM PRINT-DETAIL. NC1714.2 +130600 ADD 1 TO REC-CT. NC1714.2 +130700 DIV-TEST-F1-20-6. NC1714.2 +130800 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +130900 PERFORM PASS NC1714.2 +131000 PERFORM PRINT-DETAIL NC1714.2 +131100 ELSE NC1714.2 +131200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +131300 PERFORM FAIL NC1714.2 +131400 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +131500 MOVE 09.99 TO CORRECT-N NC1714.2 +131600 PERFORM PRINT-DETAIL. NC1714.2 +131700 ADD 1 TO REC-CT. NC1714.2 +131800 DIV-TEST-F1-20-7. NC1714.2 +131900 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +132000 PERFORM PASS NC1714.2 +132100 PERFORM PRINT-DETAIL NC1714.2 +132200 ELSE NC1714.2 +132300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +132400 PERFORM FAIL NC1714.2 +132500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +132600 MOVE 10.00 TO CORRECT-N NC1714.2 +132700 PERFORM PRINT-DETAIL. NC1714.2 +132800 ADD 1 TO REC-CT. NC1714.2 +132900 DIV-TEST-F1-20-8. NC1714.2 +133000 IF WRK-XN-00001 = "0" NC1714.2 +133100 PERFORM PASS NC1714.2 +133200 PERFORM PRINT-DETAIL NC1714.2 +133300 ELSE NC1714.2 +133400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +133500 TO RE-MARK NC1714.2 +133600 PERFORM FAIL NC1714.2 +133700 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +133800 MOVE "0" TO CORRECT-X NC1714.2 +133900 PERFORM PRINT-DETAIL. NC1714.2 +134000* NC1714.2 +134100* NC1714.2 +134200 DIV-INIT-F1-21. NC1714.2 +134300* ==--> SIZE ERROR CONDITION <--== NC1714.2 +134400* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +134500 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +134600 MOVE "DIV-TEST-F1-21" TO PAR-NAME. NC1714.2 +134700 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +134800 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +134900 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +135000 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +135100 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +135200 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +135300 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +135400 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +135500 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +135600 MOVE "0" TO WRK-XN-00001. NC1714.2 +135700 MOVE 1 TO REC-CT. NC1714.2 +135800 DIV-TEST-F1-21-0. NC1714.2 +135900 DIVIDE WRK-DU-0V2-1 NC1714.2 +136000 INTO WRK-DU-2V2-1 NC1714.2 +136100 WRK-DU-2V2-2 NC1714.2 +136200 WRK-DU-2V2-3 NC1714.2 +136300 WRK-DU-2V2-4 NC1714.2 +136400 WRK-DU-1V3-2 NC1714.2 +136500 WRK-DU-2V2-5 NC1714.2 +136600 WRK-DU-2V1-1 NC1714.2 +136700 NOT ON SIZE ERROR NC1714.2 +136800 MOVE "1" TO WRK-XN-00001. NC1714.2 +136900 GO TO DIV-TEST-F1-21-1. NC1714.2 +137000 DIV-DELETE-F1-21. NC1714.2 +137100 PERFORM DE-LETE. NC1714.2 +137200 PERFORM PRINT-DETAIL. NC1714.2 +137300 GO TO DIV-INIT-F1-22. NC1714.2 +137400 DIV-TEST-F1-21-1. NC1714.2 +137500 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +137600 PERFORM PASS NC1714.2 +137700 PERFORM PRINT-DETAIL NC1714.2 +137800 ELSE NC1714.2 +137900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +138000 PERFORM FAIL NC1714.2 +138100 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +138200 MOVE 15.44 TO CORRECT-N NC1714.2 +138300 PERFORM PRINT-DETAIL. NC1714.2 +138400 ADD 1 TO REC-CT. NC1714.2 +138500 DIV-TEST-F1-21-2. NC1714.2 +138600 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +138700 PERFORM PASS NC1714.2 +138800 PERFORM PRINT-DETAIL NC1714.2 +138900 ELSE NC1714.2 +139000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +139100 PERFORM FAIL NC1714.2 +139200 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +139300 MOVE 60.89 TO CORRECT-N NC1714.2 +139400 PERFORM PRINT-DETAIL. NC1714.2 +139500 ADD 1 TO REC-CT. NC1714.2 +139600 DIV-TEST-F1-21-3. NC1714.2 +139700 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +139800 PERFORM PASS NC1714.2 +139900 PERFORM PRINT-DETAIL NC1714.2 +140000 ELSE NC1714.2 +140100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +140200 PERFORM FAIL NC1714.2 +140300 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +140400 MOVE 60.99 TO CORRECT-N NC1714.2 +140500 PERFORM PRINT-DETAIL. NC1714.2 +140600 ADD 1 TO REC-CT. NC1714.2 +140700 DIV-TEST-F1-21-4. NC1714.2 +140800 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +140900 PERFORM PASS NC1714.2 +141000 PERFORM PRINT-DETAIL NC1714.2 +141100 ELSE NC1714.2 +141200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +141300 PERFORM FAIL NC1714.2 +141400 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +141500 MOVE 60.99 TO CORRECT-N NC1714.2 +141600 PERFORM PRINT-DETAIL. NC1714.2 +141700 ADD 1 TO REC-CT. NC1714.2 +141800 DIV-TEST-F1-21-5. NC1714.2 +141900 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +142000 PERFORM PASS NC1714.2 +142100 PERFORM PRINT-DETAIL NC1714.2 +142200 ELSE NC1714.2 +142300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +142400 PERFORM FAIL NC1714.2 +142500 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +142600 MOVE 1.001 TO CORRECT-N NC1714.2 +142700 PERFORM PRINT-DETAIL. NC1714.2 +142800 ADD 1 TO REC-CT. NC1714.2 +142900 DIV-TEST-F1-21-6. NC1714.2 +143000 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +143100 PERFORM PASS NC1714.2 +143200 PERFORM PRINT-DETAIL NC1714.2 +143300 ELSE NC1714.2 +143400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +143500 PERFORM FAIL NC1714.2 +143600 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +143700 MOVE 10.00 TO CORRECT-N NC1714.2 +143800 PERFORM PRINT-DETAIL. NC1714.2 +143900 ADD 1 TO REC-CT. NC1714.2 +144000 DIV-TEST-F1-21-7. NC1714.2 +144100 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +144200 PERFORM PASS NC1714.2 +144300 PERFORM PRINT-DETAIL NC1714.2 +144400 ELSE NC1714.2 +144500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +144600 PERFORM FAIL NC1714.2 +144700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +144800 MOVE 10.0 TO CORRECT-N NC1714.2 +144900 PERFORM PRINT-DETAIL. NC1714.2 +145000 ADD 1 TO REC-CT. NC1714.2 +145100 DIV-TEST-F1-21-8. NC1714.2 +145200 IF WRK-XN-00001 = "0" NC1714.2 +145300 PERFORM PASS NC1714.2 +145400 PERFORM PRINT-DETAIL NC1714.2 +145500 ELSE NC1714.2 +145600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +145700 TO RE-MARK NC1714.2 +145800 PERFORM FAIL NC1714.2 +145900 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +146000 MOVE "0" TO CORRECT-X NC1714.2 +146100 PERFORM PRINT-DETAIL. NC1714.2 +146200* NC1714.2 +146300* NC1714.2 +146400 DIV-INIT-F1-22. NC1714.2 +146500* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +146600* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +146700 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +146800 MOVE "DIV-TEST-F1-22" TO PAR-NAME. NC1714.2 +146900 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +147000 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +147100 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +147200 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +147300 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +147400 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +147500 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +147600 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +147700 MOVE "0" TO WRK-XN-00001. NC1714.2 +147800 MOVE 1 TO REC-CT. NC1714.2 +147900 DIV-TEST-F1-22-0. NC1714.2 +148000 DIVIDE WRK-DU-1V3-1 NC1714.2 +148100 INTO WRK-DU-2V2-1 NC1714.2 +148200 WRK-DU-2V2-2 ROUNDED NC1714.2 +148300 WRK-DU-2V2-3 NC1714.2 +148400 WRK-DU-2V2-4 ROUNDED NC1714.2 +148500 WRK-DU-1V3-2 NC1714.2 +148600 WRK-DU-2V2-5 NC1714.2 +148700 WRK-DU-2V1-1 ROUNDED NC1714.2 +148800 NOT ON SIZE ERROR NC1714.2 +148900 MOVE "1" TO WRK-XN-00001. NC1714.2 +149000 GO TO DIV-TEST-F1-22-1. NC1714.2 +149100 DIV-DELETE-F1-22. NC1714.2 +149200 PERFORM DE-LETE. NC1714.2 +149300 PERFORM PRINT-DETAIL. NC1714.2 +149400 GO TO DIV-INIT-F1-23. NC1714.2 +149500 DIV-TEST-F1-22-1. NC1714.2 +149600 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +149700 PERFORM PASS NC1714.2 +149800 PERFORM PRINT-DETAIL NC1714.2 +149900 ELSE NC1714.2 +150000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +150100 PERFORM FAIL NC1714.2 +150200 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +150300 MOVE 15.42 TO CORRECT-N NC1714.2 +150400 PERFORM PRINT-DETAIL. NC1714.2 +150500 ADD 1 TO REC-CT. NC1714.2 +150600 DIV-TEST-F1-22-2. NC1714.2 +150700 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +150800 PERFORM PASS NC1714.2 +150900 PERFORM PRINT-DETAIL NC1714.2 +151000 ELSE NC1714.2 +151100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +151200 PERFORM FAIL NC1714.2 +151300 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +151400 MOVE 60.83 TO CORRECT-N NC1714.2 +151500 PERFORM PRINT-DETAIL. NC1714.2 +151600 ADD 1 TO REC-CT. NC1714.2 +151700 DIV-TEST-F1-22-3. NC1714.2 +151800 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +151900 PERFORM PASS NC1714.2 +152000 PERFORM PRINT-DETAIL NC1714.2 +152100 ELSE NC1714.2 +152200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +152300 PERFORM FAIL NC1714.2 +152400 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +152500 MOVE 60.92 TO CORRECT-N NC1714.2 +152600 PERFORM PRINT-DETAIL. NC1714.2 +152700 ADD 1 TO REC-CT. NC1714.2 +152800 DIV-TEST-F1-22-4. NC1714.2 +152900 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +153000 PERFORM PASS NC1714.2 +153100 PERFORM PRINT-DETAIL NC1714.2 +153200 ELSE NC1714.2 +153300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +153400 PERFORM FAIL NC1714.2 +153500 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +153600 MOVE 60.93 TO CORRECT-N NC1714.2 +153700 PERFORM PRINT-DETAIL. NC1714.2 +153800 ADD 1 TO REC-CT. NC1714.2 +153900 DIV-TEST-F1-22-5. NC1714.2 +154000 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +154100 PERFORM PASS NC1714.2 +154200 PERFORM PRINT-DETAIL NC1714.2 +154300 ELSE NC1714.2 +154400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +154500 PERFORM FAIL NC1714.2 +154600 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +154700 MOVE 1.000 TO CORRECT-N NC1714.2 +154800 PERFORM PRINT-DETAIL. NC1714.2 +154900 ADD 1 TO REC-CT. NC1714.2 +155000 DIV-TEST-F1-22-6. NC1714.2 +155100 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +155200 PERFORM PASS NC1714.2 +155300 PERFORM PRINT-DETAIL NC1714.2 +155400 ELSE NC1714.2 +155500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +155600 PERFORM FAIL NC1714.2 +155700 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +155800 MOVE 09.99 TO CORRECT-N NC1714.2 +155900 PERFORM PRINT-DETAIL. NC1714.2 +156000 ADD 1 TO REC-CT. NC1714.2 +156100 DIV-TEST-F1-22-7. NC1714.2 +156200 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +156300 PERFORM PASS NC1714.2 +156400 PERFORM PRINT-DETAIL NC1714.2 +156500 ELSE NC1714.2 +156600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +156700 PERFORM FAIL NC1714.2 +156800 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +156900 MOVE 10.00 TO CORRECT-N NC1714.2 +157000 PERFORM PRINT-DETAIL. NC1714.2 +157100 ADD 1 TO REC-CT. NC1714.2 +157200 DIV-TEST-F1-22-8. NC1714.2 +157300 IF WRK-XN-00001 = "1" NC1714.2 +157400 PERFORM PASS NC1714.2 +157500 PERFORM PRINT-DETAIL NC1714.2 +157600 ELSE NC1714.2 +157700 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +157800 TO RE-MARK NC1714.2 +157900 PERFORM FAIL NC1714.2 +158000 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +158100 MOVE "1" TO CORRECT-X NC1714.2 +158200 PERFORM PRINT-DETAIL. NC1714.2 +158300* NC1714.2 +158400* NC1714.2 +158500 DIV-INIT-F1-23. NC1714.2 +158600* ==--> SIZE ERROR CONDITION <--== NC1714.2 +158700* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +158800 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +158900 MOVE "DIV-TEST-F1-23" TO PAR-NAME. NC1714.2 +159000 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +159100 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +159200 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +159300 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +159400 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +159500 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +159600 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +159700 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +159800 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +159900 MOVE "0" TO WRK-XN-00001. NC1714.2 +160000 MOVE 1 TO REC-CT. NC1714.2 +160100 DIV-TEST-F1-23-0. NC1714.2 +160200 DIVIDE WRK-DU-0V2-1 NC1714.2 +160300 INTO WRK-DU-2V2-1 NC1714.2 +160400 WRK-DU-2V2-2 NC1714.2 +160500 WRK-DU-2V2-3 NC1714.2 +160600 WRK-DU-2V2-4 NC1714.2 +160700 WRK-DU-1V3-2 NC1714.2 +160800 WRK-DU-2V2-5 NC1714.2 +160900 WRK-DU-2V1-1 NC1714.2 +161000 ON SIZE ERROR NC1714.2 +161100 MOVE "1" TO WRK-XN-00001 NC1714.2 +161200 NOT ON SIZE ERROR NC1714.2 +161300 MOVE "2" TO WRK-XN-00001. NC1714.2 +161400 GO TO DIV-TEST-F1-23-1. NC1714.2 +161500 DIV-DELETE-F1-23. NC1714.2 +161600 PERFORM DE-LETE. NC1714.2 +161700 PERFORM PRINT-DETAIL. NC1714.2 +161800 GO TO DIV-INIT-F1-24. NC1714.2 +161900 DIV-TEST-F1-23-1. NC1714.2 +162000 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +162100 PERFORM PASS NC1714.2 +162200 PERFORM PRINT-DETAIL NC1714.2 +162300 ELSE NC1714.2 +162400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +162500 PERFORM FAIL NC1714.2 +162600 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +162700 MOVE 15.44 TO CORRECT-N NC1714.2 +162800 PERFORM PRINT-DETAIL. NC1714.2 +162900 ADD 1 TO REC-CT. NC1714.2 +163000 DIV-TEST-F1-23-2. NC1714.2 +163100 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +163200 PERFORM PASS NC1714.2 +163300 PERFORM PRINT-DETAIL NC1714.2 +163400 ELSE NC1714.2 +163500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +163600 PERFORM FAIL NC1714.2 +163700 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +163800 MOVE 60.89 TO CORRECT-N NC1714.2 +163900 PERFORM PRINT-DETAIL. NC1714.2 +164000 ADD 1 TO REC-CT. NC1714.2 +164100 DIV-TEST-F1-23-3. NC1714.2 +164200 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +164300 PERFORM PASS NC1714.2 +164400 PERFORM PRINT-DETAIL NC1714.2 +164500 ELSE NC1714.2 +164600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +164700 PERFORM FAIL NC1714.2 +164800 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +164900 MOVE 60.99 TO CORRECT-N NC1714.2 +165000 PERFORM PRINT-DETAIL. NC1714.2 +165100 ADD 1 TO REC-CT. NC1714.2 +165200 DIV-TEST-F1-23-4. NC1714.2 +165300 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +165400 PERFORM PASS NC1714.2 +165500 PERFORM PRINT-DETAIL NC1714.2 +165600 ELSE NC1714.2 +165700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +165800 PERFORM FAIL NC1714.2 +165900 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +166000 MOVE 60.99 TO CORRECT-N NC1714.2 +166100 PERFORM PRINT-DETAIL. NC1714.2 +166200 ADD 1 TO REC-CT. NC1714.2 +166300 DIV-TEST-F1-23-5. NC1714.2 +166400 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +166500 PERFORM PASS NC1714.2 +166600 PERFORM PRINT-DETAIL NC1714.2 +166700 ELSE NC1714.2 +166800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +166900 PERFORM FAIL NC1714.2 +167000 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +167100 MOVE 1.001 TO CORRECT-N NC1714.2 +167200 PERFORM PRINT-DETAIL. NC1714.2 +167300 ADD 1 TO REC-CT. NC1714.2 +167400 DIV-TEST-F1-23-6. NC1714.2 +167500 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +167600 PERFORM PASS NC1714.2 +167700 PERFORM PRINT-DETAIL NC1714.2 +167800 ELSE NC1714.2 +167900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +168000 PERFORM FAIL NC1714.2 +168100 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +168200 MOVE 10.00 TO CORRECT-N NC1714.2 +168300 PERFORM PRINT-DETAIL. NC1714.2 +168400 ADD 1 TO REC-CT. NC1714.2 +168500 DIV-TEST-F1-23-7. NC1714.2 +168600 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +168700 PERFORM PASS NC1714.2 +168800 PERFORM PRINT-DETAIL NC1714.2 +168900 ELSE NC1714.2 +169000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +169100 PERFORM FAIL NC1714.2 +169200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +169300 MOVE 10.0 TO CORRECT-N NC1714.2 +169400 PERFORM PRINT-DETAIL. NC1714.2 +169500 ADD 1 TO REC-CT. NC1714.2 +169600 DIV-TEST-F1-23-8. NC1714.2 +169700 IF WRK-XN-00001 = "1" NC1714.2 +169800 PERFORM PASS NC1714.2 +169900 PERFORM PRINT-DETAIL NC1714.2 +170000 ELSE NC1714.2 +170100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1714.2 +170200 PERFORM FAIL NC1714.2 +170300 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +170400 MOVE "1" TO CORRECT-X NC1714.2 +170500 PERFORM PRINT-DETAIL. NC1714.2 +170600* NC1714.2 +170700* NC1714.2 +170800 DIV-INIT-F1-24. NC1714.2 +170900* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +171000* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +171100 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +171200 MOVE "DIV-TEST-F1-24" TO PAR-NAME. NC1714.2 +171300 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +171400 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +171500 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +171600 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +171700 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +171800 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +171900 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +172000 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +172100 MOVE 1 TO REC-CT. NC1714.2 +172200 DIV-TEST-F1-24-0. NC1714.2 +172300 DIVIDE WRK-DU-1V3-1 NC1714.2 +172400 INTO WRK-DU-2V2-1 NC1714.2 +172500 WRK-DU-2V2-2 ROUNDED NC1714.2 +172600 WRK-DU-2V2-3 NC1714.2 +172700 WRK-DU-2V2-4 ROUNDED NC1714.2 +172800 WRK-DU-1V3-2 NC1714.2 +172900 WRK-DU-2V2-5 NC1714.2 +173000 WRK-DU-2V1-1 ROUNDED NC1714.2 +173100 ON SIZE ERROR NC1714.2 +173200 MOVE "1" TO WRK-XN-00001 NC1714.2 +173300 NOT ON SIZE ERROR NC1714.2 +173400 MOVE "2" TO WRK-XN-00001. NC1714.2 +173500 GO TO DIV-TEST-F1-24-1. NC1714.2 +173600 DIV-DELETE-F1-24. NC1714.2 +173700 PERFORM DE-LETE. NC1714.2 +173800 PERFORM PRINT-DETAIL. NC1714.2 +173900 GO TO DIV-INIT-F1-25. NC1714.2 +174000 DIV-TEST-F1-24-1. NC1714.2 +174100 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +174200 PERFORM PASS NC1714.2 +174300 PERFORM PRINT-DETAIL NC1714.2 +174400 ELSE NC1714.2 +174500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +174600 PERFORM FAIL NC1714.2 +174700 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +174800 MOVE 15.42 TO CORRECT-N NC1714.2 +174900 PERFORM PRINT-DETAIL. NC1714.2 +175000 ADD 1 TO REC-CT. NC1714.2 +175100 DIV-TEST-F1-24-2. NC1714.2 +175200 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +175300 PERFORM PASS NC1714.2 +175400 PERFORM PRINT-DETAIL NC1714.2 +175500 ELSE NC1714.2 +175600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +175700 PERFORM FAIL NC1714.2 +175800 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +175900 MOVE 60.83 TO CORRECT-N NC1714.2 +176000 PERFORM PRINT-DETAIL. NC1714.2 +176100 ADD 1 TO REC-CT. NC1714.2 +176200 DIV-TEST-F1-24-3. NC1714.2 +176300 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +176400 PERFORM PASS NC1714.2 +176500 PERFORM PRINT-DETAIL NC1714.2 +176600 ELSE NC1714.2 +176700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +176800 PERFORM FAIL NC1714.2 +176900 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +177000 MOVE 60.92 TO CORRECT-N NC1714.2 +177100 PERFORM PRINT-DETAIL. NC1714.2 +177200 ADD 1 TO REC-CT. NC1714.2 +177300 DIV-TEST-F1-24-4. NC1714.2 +177400 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +177500 PERFORM PASS NC1714.2 +177600 PERFORM PRINT-DETAIL NC1714.2 +177700 ELSE NC1714.2 +177800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +177900 PERFORM FAIL NC1714.2 +178000 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +178100 MOVE 60.93 TO CORRECT-N NC1714.2 +178200 PERFORM PRINT-DETAIL. NC1714.2 +178300 ADD 1 TO REC-CT. NC1714.2 +178400 DIV-TEST-F1-24-5. NC1714.2 +178500 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +178600 PERFORM PASS NC1714.2 +178700 PERFORM PRINT-DETAIL NC1714.2 +178800 ELSE NC1714.2 +178900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +179000 PERFORM FAIL NC1714.2 +179100 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +179200 MOVE 1.000 TO CORRECT-N NC1714.2 +179300 PERFORM PRINT-DETAIL. NC1714.2 +179400 ADD 1 TO REC-CT. NC1714.2 +179500 DIV-TEST-F1-24-6. NC1714.2 +179600 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +179700 PERFORM PASS NC1714.2 +179800 PERFORM PRINT-DETAIL NC1714.2 +179900 ELSE NC1714.2 +180000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +180100 PERFORM FAIL NC1714.2 +180200 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +180300 MOVE 09.99 TO CORRECT-N NC1714.2 +180400 PERFORM PRINT-DETAIL. NC1714.2 +180500 ADD 1 TO REC-CT. NC1714.2 +180600 DIV-TEST-F1-24-7. NC1714.2 +180700 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +180800 PERFORM PASS NC1714.2 +180900 PERFORM PRINT-DETAIL NC1714.2 +181000 ELSE NC1714.2 +181100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +181200 PERFORM FAIL NC1714.2 +181300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +181400 MOVE 10.00 TO CORRECT-N NC1714.2 +181500 PERFORM PRINT-DETAIL. NC1714.2 +181600 ADD 1 TO REC-CT. NC1714.2 +181700 DIV-TEST-F1-24-8. NC1714.2 +181800 IF WRK-XN-00001 = "2" NC1714.2 +181900 PERFORM PASS NC1714.2 +182000 PERFORM PRINT-DETAIL NC1714.2 +182100 ELSE NC1714.2 +182200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +182300 TO RE-MARK NC1714.2 +182400 PERFORM FAIL NC1714.2 +182500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +182600 MOVE "2" TO CORRECT-X NC1714.2 +182700 PERFORM PRINT-DETAIL. NC1714.2 +182800* NC1714.2 +182900* NC1714.2 +183000 DIV-INIT-F1-25. NC1714.2 +183100* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +183200* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +183300 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +183400 MOVE "DIV-TEST-F1-25 " TO PAR-NAME. NC1714.2 +183500 MOVE "0" TO WRK-XN-00001. NC1714.2 +183600 MOVE 0 TO WRK-DS-05V00. NC1714.2 +183700 MOVE 0 TO WRK-DS-02V00. NC1714.2 +183800 MOVE 0 TO WRK-CS-18V00. NC1714.2 +183900 MOVE 1620.36 TO DIV1. NC1714.2 +184000 MOVE 44.1 TO DIV2. NC1714.2 +184100 MOVE 1 TO REC-CT. NC1714.2 +184200 DIV-TEST-F1-25-0. NC1714.2 +184300 DIVIDE DIV2 INTO DIV1 NC1714.2 +184400 ON SIZE ERROR NC1714.2 +184500 MOVE "1" TO WRK-XN-00001 NC1714.2 +184600 MOVE 23 TO WRK-DS-05V00 NC1714.2 +184700 MOVE -4 TO WRK-DS-02V00 NC1714.2 +184800 END-DIVIDE NC1714.2 +184900 MOVE 99 TO WRK-CS-18V00. NC1714.2 +185000 GO TO DIV-TEST-F1-25-1. NC1714.2 +185100 DIV-DELETE-F1-25-1. NC1714.2 +185200 PERFORM DE-LETE. NC1714.2 +185300 PERFORM PRINT-DETAIL. NC1714.2 +185400 GO TO DIV-INIT-F1-26. NC1714.2 +185500 DIV-TEST-F1-25-1. NC1714.2 +185600 IF WRK-XN-00001 = "0" NC1714.2 +185700 PERFORM PASS NC1714.2 +185800 PERFORM PRINT-DETAIL NC1714.2 +185900 ELSE NC1714.2 +186000 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +186100 MOVE "0" TO CORRECT-X NC1714.2 +186200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +186300 TO RE-MARK NC1714.2 +186400 PERFORM FAIL NC1714.2 +186500 PERFORM PRINT-DETAIL. NC1714.2 +186600 ADD 1 TO REC-CT. NC1714.2 +186700 DIV-TEST-F1-25-2. NC1714.2 +186800 IF WRK-DS-05V00 = 0 NC1714.2 +186900 PERFORM PASS NC1714.2 +187000 PERFORM PRINT-DETAIL NC1714.2 +187100 ELSE NC1714.2 +187200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1714.2 +187300 MOVE 0 TO CORRECT-N NC1714.2 +187400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +187500 TO RE-MARK NC1714.2 +187600 PERFORM FAIL NC1714.2 +187700 PERFORM PRINT-DETAIL. NC1714.2 +187800 ADD 1 TO REC-CT. NC1714.2 +187900 DIV-TEST-F1-25-3. NC1714.2 +188000 IF WRK-DS-02V00 = 0 NC1714.2 +188100 PERFORM PASS NC1714.2 +188200 PERFORM PRINT-DETAIL NC1714.2 +188300 ELSE NC1714.2 +188400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1714.2 +188500 MOVE 0 TO CORRECT-N NC1714.2 +188600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +188700 TO RE-MARK NC1714.2 +188800 PERFORM FAIL NC1714.2 +188900 PERFORM PRINT-DETAIL. NC1714.2 +189000 DIV-TEST-F1-25-4. NC1714.2 +189100 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +189200 PERFORM PASS NC1714.2 +189300 PERFORM PRINT-DETAIL NC1714.2 +189400 ELSE NC1714.2 +189500 MOVE WRK-CS-18V00 TO COMPUTED-N NC1714.2 +189600 MOVE 0 TO CORRECT-N NC1714.2 +189700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +189800 PERFORM FAIL NC1714.2 +189900 PERFORM PRINT-DETAIL. NC1714.2 +190000* NC1714.2 +190100* NC1714.2 +190200 DIV-INIT-F1-26. NC1714.2 +190300* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +190400* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +190500 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +190600 MOVE "DIV-TEST-F1-26 " TO PAR-NAME. NC1714.2 +190700 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1714.2 +190800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +190900 MOVE "0" TO WRK-XN-00001. NC1714.2 +191000 MOVE 0 TO WRK-DS-05V00. NC1714.2 +191100 MOVE 0 TO WRK-DS-02V00. NC1714.2 +191200 MOVE 0 TO WRK-CS-18V00. NC1714.2 +191300 MOVE 1 TO REC-CT. NC1714.2 +191400 DIV-TEST-F1-26-0. NC1714.2 +191500 DIVIDE A18ONES-DS-09V09 NC1714.2 +191600 INTO WRK-DS-09V09 ROUNDED NC1714.2 +191700 ON SIZE ERROR NC1714.2 +191800 MOVE "1" TO WRK-XN-00001 NC1714.2 +191900 MOVE 23 TO WRK-DS-05V00 NC1714.2 +192000 MOVE -4 TO WRK-DS-02V00 NC1714.2 +192100 END-DIVIDE NC1714.2 +192200 MOVE 99 TO WRK-CS-18V00. NC1714.2 +192300 GO TO DIV-TEST-F1-26-1. NC1714.2 +192400 DIV-DELETE-F1-26-1. NC1714.2 +192500 PERFORM DE-LETE. NC1714.2 +192600 PERFORM PRINT-DETAIL. NC1714.2 +192700 GO TO DIV-INIT-F1-27. NC1714.2 +192800 DIV-TEST-F1-26-1. NC1714.2 +192900 IF WRK-DS-18V00-S = 000000001000000000 NC1714.2 +193000 PERFORM PASS NC1714.2 +193100 PERFORM PRINT-DETAIL NC1714.2 +193200 ELSE NC1714.2 +193300 MOVE 000000001000000000 TO CORRECT-18V0 NC1714.2 +193400 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1714.2 +193500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +193600 TO RE-MARK NC1714.2 +193700 PERFORM FAIL NC1714.2 +193800 PERFORM PRINT-DETAIL. NC1714.2 +193900 ADD 1 TO REC-CT. NC1714.2 +194000 DIV-TEST-F1-26-2. NC1714.2 +194100 IF WRK-XN-00001 = "0" NC1714.2 +194200 PERFORM PASS NC1714.2 +194300 PERFORM PRINT-DETAIL NC1714.2 +194400 ELSE NC1714.2 +194500 MOVE "0" TO CORRECT-X NC1714.2 +194600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +194700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +194800 TO RE-MARK NC1714.2 +194900 PERFORM FAIL NC1714.2 +195000 PERFORM PRINT-DETAIL. NC1714.2 +195100 ADD 1 TO REC-CT. NC1714.2 +195200 DIV-TEST-F1-26-3. NC1714.2 +195300 IF WRK-DS-05V00 = 0 NC1714.2 +195400 PERFORM PASS NC1714.2 +195500 PERFORM PRINT-DETAIL NC1714.2 +195600 ELSE NC1714.2 +195700 MOVE 0 TO CORRECT-18V0 NC1714.2 +195800 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +195900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +196000 TO RE-MARK NC1714.2 +196100 PERFORM FAIL NC1714.2 +196200 PERFORM PRINT-DETAIL. NC1714.2 +196300 ADD 1 TO REC-CT. NC1714.2 +196400 DIV-TEST-F1-26-4. NC1714.2 +196500 IF WRK-DS-02V00 = 0 NC1714.2 +196600 PERFORM PASS NC1714.2 +196700 PERFORM PRINT-DETAIL NC1714.2 +196800 ELSE NC1714.2 +196900 MOVE 0 TO CORRECT-18V0 NC1714.2 +197000 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +197100 PERFORM FAIL NC1714.2 +197200 PERFORM PRINT-DETAIL. NC1714.2 +197300 ADD 1 TO REC-CT. NC1714.2 +197400 DIV-TEST-F1-26-5. NC1714.2 +197500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +197600 PERFORM PASS NC1714.2 +197700 PERFORM PRINT-DETAIL NC1714.2 +197800 ELSE NC1714.2 +197900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +198000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +198100 PERFORM FAIL NC1714.2 +198200 PERFORM PRINT-DETAIL. NC1714.2 +198300* NC1714.2 +198400* NC1714.2 +198500 DIV-INIT-F1-27. NC1714.2 +198600* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +198700* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +198800 MOVE "DIV-TEST-F1-27 " TO PAR-NAME. NC1714.2 +198900 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +199000 MOVE "0" TO WRK-XN-00001. NC1714.2 +199100 MOVE 0 TO WRK-DS-05V00. NC1714.2 +199200 MOVE 0 TO WRK-DS-02V00. NC1714.2 +199300 MOVE 0 TO WRK-CS-18V00. NC1714.2 +199400 MOVE 1620.36 TO DIV1. NC1714.2 +199500 MOVE 44.1 TO DIV2. NC1714.2 +199600 MOVE 1 TO REC-CT. NC1714.2 +199700 DIV-TEST-F1-27-0. NC1714.2 +199800 DIVIDE DIV2 INTO DIV1 NC1714.2 +199900 NOT ON SIZE ERROR NC1714.2 +200000 MOVE "1" TO WRK-XN-00001 NC1714.2 +200100 MOVE 23 TO WRK-DS-05V00 NC1714.2 +200200 MOVE -4 TO WRK-DS-02V00 NC1714.2 +200300 END-DIVIDE NC1714.2 +200400 MOVE 99 TO WRK-CS-18V00. NC1714.2 +200500 GO TO DIV-TEST-F1-27-1. NC1714.2 +200600 DIV-DELETE-F1-27-1. NC1714.2 +200700 PERFORM DE-LETE. NC1714.2 +200800 PERFORM PRINT-DETAIL. NC1714.2 +200900 GO TO DIV-INIT-F1-28. NC1714.2 +201000 DIV-TEST-F1-27-1. NC1714.2 +201100 IF WRK-XN-00001 = "1" NC1714.2 +201200 PERFORM PASS NC1714.2 +201300 PERFORM PRINT-DETAIL NC1714.2 +201400 ELSE NC1714.2 +201500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +201600 MOVE "1" TO CORRECT-X NC1714.2 +201700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +201800 TO RE-MARK NC1714.2 +201900 PERFORM FAIL NC1714.2 +202000 PERFORM PRINT-DETAIL. NC1714.2 +202100 ADD 1 TO REC-CT. NC1714.2 +202200 DIV-TEST-F1-27-2. NC1714.2 +202300 IF WRK-DS-05V00 = 23 NC1714.2 +202400 PERFORM PASS NC1714.2 +202500 PERFORM PRINT-DETAIL NC1714.2 +202600 ELSE NC1714.2 +202700 MOVE 23 TO CORRECT-18V0 NC1714.2 +202800 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +202900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +203000 TO RE-MARK NC1714.2 +203100 PERFORM FAIL NC1714.2 +203200 PERFORM PRINT-DETAIL. NC1714.2 +203300 ADD 1 TO REC-CT. NC1714.2 +203400 DIV-TEST-F1-27-3. NC1714.2 +203500 IF WRK-DS-02V00 = -4 NC1714.2 +203600 PERFORM PASS NC1714.2 +203700 PERFORM PRINT-DETAIL NC1714.2 +203800 ELSE NC1714.2 +203900 MOVE -4 TO CORRECT-18V0 NC1714.2 +204000 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +204100 PERFORM FAIL NC1714.2 +204200 PERFORM PRINT-DETAIL. NC1714.2 +204300 ADD 1 TO REC-CT. NC1714.2 +204400 DIV-TEST-F1-27-4. NC1714.2 +204500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +204600 PERFORM PASS NC1714.2 +204700 PERFORM PRINT-DETAIL NC1714.2 +204800 ELSE NC1714.2 +204900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +205000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +205100 PERFORM FAIL NC1714.2 +205200 PERFORM PRINT-DETAIL. NC1714.2 +205300 ADD 1 TO REC-CT. NC1714.2 +205400 DIV-TEST-F1-27-5. NC1714.2 +205500 IF DIV1 = 36.74 NC1714.2 +205600 PERFORM PASS NC1714.2 +205700 PERFORM PRINT-DETAIL NC1714.2 +205800 ELSE NC1714.2 +205900 MOVE DIV1 TO COMPUTED-N NC1714.2 +206000 MOVE 36.74 TO CORRECT-N NC1714.2 +206100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +206200 PERFORM FAIL NC1714.2 +206300 PERFORM PRINT-DETAIL. NC1714.2 +206400* NC1714.2 +206500* NC1714.2 +206600 DIV-INIT-F1-28. NC1714.2 +206700 MOVE "DIV-TEST-F1-28 " TO PAR-NAME. NC1714.2 +206800 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +206900 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +207000 MOVE "0" TO WRK-XN-00001. NC1714.2 +207100 MOVE 0 TO WRK-DS-05V00. NC1714.2 +207200 MOVE 0 TO WRK-DS-02V00. NC1714.2 +207300 MOVE 0 TO WRK-CS-18V00. NC1714.2 +207400 MOVE 1 TO REC-CT. NC1714.2 +207500 DIV-TEST-F1-28-0. NC1714.2 +207600 DIVIDE A18ONES-DS-09V09 NC1714.2 +207700 INTO WRK-DS-09V09 ROUNDED NC1714.2 +207800 NOT ON SIZE ERROR NC1714.2 +207900 MOVE "1" TO WRK-XN-00001 NC1714.2 +208000 MOVE 23 TO WRK-DS-05V00 NC1714.2 +208100 MOVE -4 TO WRK-DS-02V00 NC1714.2 +208200 END-DIVIDE NC1714.2 +208300 MOVE 99 TO WRK-CS-18V00. NC1714.2 +208400 GO TO DIV-TEST-F1-28-1. NC1714.2 +208500 DIV-DELETE-F1-28-1. NC1714.2 +208600 PERFORM DE-LETE. NC1714.2 +208700 PERFORM PRINT-DETAIL. NC1714.2 +208800 GO TO DIV-INIT-F1-29. NC1714.2 +208900 DIV-TEST-F1-28-1. NC1714.2 +209000 IF WRK-XN-00001 = "1" NC1714.2 +209100 PERFORM PASS NC1714.2 +209200 PERFORM PRINT-DETAIL NC1714.2 +209300 ELSE NC1714.2 +209400 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +209500 MOVE "1" TO CORRECT-X NC1714.2 +209600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +209700 TO RE-MARK NC1714.2 +209800 PERFORM FAIL NC1714.2 +209900 PERFORM PRINT-DETAIL. NC1714.2 +210000 ADD 1 TO REC-CT. NC1714.2 +210100 DIV-TEST-F1-28-2. NC1714.2 +210200 IF WRK-DS-05V00 = 23 NC1714.2 +210300 PERFORM PASS NC1714.2 +210400 PERFORM PRINT-DETAIL NC1714.2 +210500 ELSE NC1714.2 +210600 MOVE 23 TO CORRECT-18V0 NC1714.2 +210700 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +210800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +210900 TO RE-MARK NC1714.2 +211000 PERFORM FAIL NC1714.2 +211100 PERFORM PRINT-DETAIL. NC1714.2 +211200 ADD 1 TO REC-CT. NC1714.2 +211300 DIV-TEST-F1-28-3. NC1714.2 +211400 IF WRK-DS-02V00 = -4 NC1714.2 +211500 PERFORM PASS NC1714.2 +211600 PERFORM PRINT-DETAIL NC1714.2 +211700 ELSE NC1714.2 +211800 MOVE -4 TO CORRECT-18V0 NC1714.2 +211900 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +212000 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +212100 TO RE-MARK NC1714.2 +212200 PERFORM FAIL NC1714.2 +212300 PERFORM PRINT-DETAIL. NC1714.2 +212400 ADD 1 TO REC-CT. NC1714.2 +212500 DIV-TEST-F1-28-4. NC1714.2 +212600 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +212700 PERFORM PASS NC1714.2 +212800 PERFORM PRINT-DETAIL NC1714.2 +212900 ELSE NC1714.2 +213000 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +213100 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +213200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +213300 PERFORM FAIL NC1714.2 +213400 PERFORM PRINT-DETAIL. NC1714.2 +213500 ADD 1 TO REC-CT. NC1714.2 +213600 DIV-TEST-F1-28-5. NC1714.2 +213700 IF WRK-DS-09V09 = 1 NC1714.2 +213800 PERFORM PASS NC1714.2 +213900 PERFORM PRINT-DETAIL NC1714.2 +214000 ELSE NC1714.2 +214100 MOVE 1 TO CORRECT-18V0 NC1714.2 +214200 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +214300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +214400 TO RE-MARK NC1714.2 +214500 PERFORM FAIL NC1714.2 +214600 PERFORM PRINT-DETAIL. NC1714.2 +214700* NC1714.2 +214800* NC1714.2 +214900 DIV-INIT-F1-29. NC1714.2 +215000* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +215100* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +215200 MOVE "DIV-TEST-F1-29 " TO PAR-NAME. NC1714.2 +215300 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +215400 MOVE "0" TO WRK-XN-00001. NC1714.2 +215500 MOVE 0 TO WRK-CS-18V00. NC1714.2 +215600 MOVE 1620.36 TO DIV1. NC1714.2 +215700 MOVE 44.1 TO DIV2. NC1714.2 +215800 MOVE 1 TO REC-CT. NC1714.2 +215900 DIV-TEST-F1-29-0. NC1714.2 +216000 DIVIDE DIV2 INTO DIV1 NC1714.2 +216100 ON SIZE ERROR NC1714.2 +216200 MOVE "1" TO WRK-XN-00001 NC1714.2 +216300 NOT ON SIZE ERROR NC1714.2 +216400 MOVE "2" TO WRK-XN-00001 NC1714.2 +216500 END-DIVIDE NC1714.2 +216600 MOVE 99 TO WRK-CS-18V00. NC1714.2 +216700 GO TO DIV-TEST-F1-29-1. NC1714.2 +216800 DIV-DELETE-F1-29-1. NC1714.2 +216900 PERFORM DE-LETE. NC1714.2 +217000 PERFORM PRINT-DETAIL. NC1714.2 +217100 GO TO DIV-INIT-F1-30. NC1714.2 +217200 DIV-TEST-F1-29-1. NC1714.2 +217300 IF WRK-XN-00001 = "2" NC1714.2 +217400 PERFORM PASS NC1714.2 +217500 PERFORM PRINT-DETAIL NC1714.2 +217600 ELSE NC1714.2 +217700 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +217800 MOVE "2" TO CORRECT-X NC1714.2 +217900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +218000 TO RE-MARK NC1714.2 +218100 PERFORM FAIL NC1714.2 +218200 PERFORM PRINT-DETAIL. NC1714.2 +218300 ADD 1 TO REC-CT. NC1714.2 +218400 DIV-TEST-F1-29-2. NC1714.2 +218500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +218600 PERFORM PASS NC1714.2 +218700 PERFORM PRINT-DETAIL NC1714.2 +218800 ELSE NC1714.2 +218900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +219000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +219100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +219200 PERFORM FAIL NC1714.2 +219300 PERFORM PRINT-DETAIL. NC1714.2 +219400 ADD 1 TO REC-CT. NC1714.2 +219500 DIV-TEST-F1-29-3. NC1714.2 +219600 IF DIV1 = 36.74 NC1714.2 +219700 PERFORM PASS NC1714.2 +219800 PERFORM PRINT-DETAIL NC1714.2 +219900 ELSE NC1714.2 +220000 MOVE DIV1 TO COMPUTED-N NC1714.2 +220100 MOVE 36.74 TO CORRECT-N NC1714.2 +220200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +220300 PERFORM FAIL NC1714.2 +220400 PERFORM PRINT-DETAIL. NC1714.2 +220500* NC1714.2 +220600* NC1714.2 +220700 DIV-INIT-F1-30. NC1714.2 +220800* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +220900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +221000 MOVE "DIV-TEST-F1-30 " TO PAR-NAME. NC1714.2 +221100 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +221200 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1714.2 +221300 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +221400 MOVE "0" TO WRK-XN-00001. NC1714.2 +221500 MOVE 0 TO WRK-CS-18V00. NC1714.2 +221600 MOVE 1 TO REC-CT. NC1714.2 +221700 DIV-TEST-F1-30-0. NC1714.2 +221800 DIVIDE A18ONES-DS-09V09 NC1714.2 +221900 INTO WRK-DS-09V09 ROUNDED NC1714.2 +222000 ON SIZE ERROR NC1714.2 +222100 MOVE "1" TO WRK-XN-00001 NC1714.2 +222200 NOT ON SIZE ERROR NC1714.2 +222300 MOVE "2" TO WRK-XN-00001 NC1714.2 +222400 END-DIVIDE NC1714.2 +222500 MOVE 99 TO WRK-CS-18V00. NC1714.2 +222600 GO TO DIV-TEST-F1-30-1. NC1714.2 +222700 DIV-DELETE-F1-30-1. NC1714.2 +222800 PERFORM DE-LETE. NC1714.2 +222900 PERFORM PRINT-DETAIL. NC1714.2 +223000 GO TO CCVS-EXIT. NC1714.2 +223100 DIV-TEST-F1-30-1. NC1714.2 +223200 IF WRK-XN-00001 = "2" NC1714.2 +223300 PERFORM PASS NC1714.2 +223400 PERFORM PRINT-DETAIL NC1714.2 +223500 ELSE NC1714.2 +223600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +223700 MOVE "2" TO CORRECT-X NC1714.2 +223800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +223900 TO RE-MARK NC1714.2 +224000 PERFORM FAIL NC1714.2 +224100 PERFORM PRINT-DETAIL. NC1714.2 +224200 ADD 1 TO REC-CT. NC1714.2 +224300 DIV-TEST-F1-30-2. NC1714.2 +224400 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +224500 PERFORM PASS NC1714.2 +224600 PERFORM PRINT-DETAIL NC1714.2 +224700 ELSE NC1714.2 +224800 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +224900 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +225000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +225100 PERFORM FAIL NC1714.2 +225200 PERFORM PRINT-DETAIL. NC1714.2 +225300 ADD 1 TO REC-CT. NC1714.2 +225400 DIV-TEST-F1-30-3. NC1714.2 +225500 IF WRK-DS-18V00 = 1 NC1714.2 +225600 PERFORM PASS NC1714.2 +225700 PERFORM PRINT-DETAIL NC1714.2 +225800 ELSE NC1714.2 +225900 MOVE 1 TO CORRECT-18V0 NC1714.2 +226000 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1714.2 +226100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +226200 PERFORM FAIL NC1714.2 +226300 PERFORM PRINT-DETAIL. NC1714.2 +226400* NC1714.2 +226500* NC1714.2 +226600 CCVS-EXIT SECTION. NC1714.2 +226700 CCVS-999999. NC1714.2 +226800 GO TO CLOSE-FILES. NC1714.2 +*END-OF,NC171A +*HEADER,COBOL,NC172A +000100 IDENTIFICATION DIVISION. NC1724.2 +000200 PROGRAM-ID. NC1724.2 +000300 NC172A. NC1724.2 +000400**************************************************************** NC1724.2 +000500* * NC1724.2 +000600* VALIDATION FOR:- * NC1724.2 +000700* * NC1724.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +000900* * NC1724.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1724.2 +001100* * NC1724.2 +001200**************************************************************** NC1724.2 +001300* * NC1724.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1724.2 +001500* * NC1724.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1724.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1724.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1724.2 +001900* * NC1724.2 +002000**************************************************************** NC1724.2 +002100* THIS PROGRAM TESTS THE FORMAT 2 DIVIDE STATEMENT FOUND NC1724.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1724.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1724.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1724.2 +002500* NC1724.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1724.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1724.2 +002800* AS OPERANDS. NC1724.2 +002900* NC1724.2 +003000 NC1724.2 +003100 NC1724.2 +003200 ENVIRONMENT DIVISION. NC1724.2 +003300 CONFIGURATION SECTION. NC1724.2 +003400 SOURCE-COMPUTER. NC1724.2 +003500 XXXXX082. NC1724.2 +003600 OBJECT-COMPUTER. NC1724.2 +003700 XXXXX083. NC1724.2 +003800 INPUT-OUTPUT SECTION. NC1724.2 +003900 FILE-CONTROL. NC1724.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1724.2 +004100 XXXXX055. NC1724.2 +004200 DATA DIVISION. NC1724.2 +004300 FILE SECTION. NC1724.2 +004400 FD PRINT-FILE. NC1724.2 +004500 01 PRINT-REC PICTURE X(120). NC1724.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1724.2 +004700 WORKING-STORAGE SECTION. NC1724.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1724.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1724.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1724.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1724.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1724.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1724.2 +005400 77 WRK-XN-00001 PICTURE X. NC1724.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1724.2 +005600 VALUE 1111111111. NC1724.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1724.2 +005800 VALUE 333333.333333. NC1724.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1724.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1724.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1724.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1724.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1724.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1724.2 +006500 VALUE 111111111111. NC1724.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1724.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1724.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1724.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1724.2 +007000 VALUE 111111111111111111. NC1724.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1724.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1724.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1724.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1724.2 +007500 VALUE 99. NC1724.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1724.2 +007700 VALUE .1. NC1724.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1724.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1724.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1724.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1724.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1724.2 +008300 VALUE 111111111.111111111. NC1724.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1724.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1724.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1724.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1724.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1724.2 +008900 77 XRAY PICTURE X. NC1724.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1724.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1724.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1724.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1724.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1724.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1724.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1724.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1724.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1724.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1724.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1724.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1724.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1724.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1724.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1724.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1724.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1724.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1724.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1724.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1724.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1724.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1724.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1724.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1724.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1724.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1724.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1724.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1724.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1724.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1724.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1724.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1724.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1724.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1724.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1724.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1724.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1724.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1724.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1724.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1724.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1724.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1724.2 +013200 01 WRK-NE-2 PIC $**.99. NC1724.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1724.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1724.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1724.2 +013600 VALUE +000000000000000001. NC1724.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1724.2 +013800 VALUE -000000000000000033. NC1724.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014000 VALUE 666666666666666666. NC1724.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014200 VALUE 009999999999999999. NC1724.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014400 VALUE 000022222222222222. NC1724.2 +014500 01 MULTIPLY-DATA. NC1724.2 +014600 02 MULT1 PICTURE IS 999V99 NC1724.2 +014700 VALUE IS 80.12. NC1724.2 +014800 02 MULT2 PICTURE IS 999V999. NC1724.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1724.2 +015000 02 MULT4 PICTURE IS S99 NC1724.2 +015100 VALUE IS -56. NC1724.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1724.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1724.2 +015400 20. NC1724.2 +015500 01 DIVIDE-DATA. NC1724.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1724.2 +015700 VALUE IS 1620.36. NC1724.2 +015800 02 DIV2 PICTURE IS 99V9 NC1724.2 +015900 VALUE IS 44.1. NC1724.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1724.2 +016100 VALUE IS 1661.7. NC1724.2 +016200 02 DIV4 PICTURE IS S9V999 NC1724.2 +016300 VALUE IS -9.642. NC1724.2 +016400 02 DIV-02LEVEL-1. NC1724.2 +016500 03 DIV5 PICTURE IS V99 NC1724.2 +016600 VALUE IS .82. NC1724.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1724.2 +016800 03 DIV7 PICTURE IS 9V9 NC1724.2 +016900 VALUE IS 9.6. NC1724.2 +017000 01 DIV-DATA-2. NC1724.2 +017100 02 DIV8 PICTURE IS 99V9. NC1724.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1724.2 +017300 02 DIV10 PICTURE IS V999. NC1724.2 +017400 01 TEST-RESULTS. NC1724.2 +017500 02 FILLER PIC X VALUE SPACE. NC1724.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1724.2 +017700 02 FILLER PIC X VALUE SPACE. NC1724.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1724.2 +017900 02 FILLER PIC X VALUE SPACE. NC1724.2 +018000 02 PAR-NAME. NC1724.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1724.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1724.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1724.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1724.2 +018500 02 RE-MARK PIC X(61). NC1724.2 +018600 01 TEST-COMPUTED. NC1724.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1724.2 +018800 02 FILLER PIC X(17) VALUE NC1724.2 +018900 " COMPUTED=". NC1724.2 +019000 02 COMPUTED-X. NC1724.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1724.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1724.2 +019300 PIC -9(9).9(9). NC1724.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1724.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1724.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1724.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1724.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1724.2 +019900 04 FILLER PIC X. NC1724.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1724.2 +020100 01 TEST-CORRECT. NC1724.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1724.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1724.2 +020400 02 CORRECT-X. NC1724.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1724.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1724.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1724.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1724.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1724.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1724.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1724.2 +021200 04 FILLER PIC X. NC1724.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1724.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1724.2 +021500 01 CCVS-C-1. NC1724.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1724.2 +021700- "SS PARAGRAPH-NAME NC1724.2 +021800- " REMARKS". NC1724.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1724.2 +022000 01 CCVS-C-2. NC1724.2 +022100 02 FILLER PIC X VALUE SPACE. NC1724.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1724.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1724.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1724.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1724.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1724.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1724.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1724.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1724.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1724.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1724.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1724.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1724.2 +023700 01 CCVS-H-1. NC1724.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1724.2 +023900 02 FILLER PIC X(42) VALUE NC1724.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1724.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1724.2 +024200 01 CCVS-H-2A. NC1724.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1724.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1724.2 +024500 02 FILLER PIC XXXX VALUE NC1724.2 +024600 "4.2 ". NC1724.2 +024700 02 FILLER PIC X(28) VALUE NC1724.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1724.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1724.2 +025000 NC1724.2 +025100 01 CCVS-H-2B. NC1724.2 +025200 02 FILLER PIC X(15) VALUE NC1724.2 +025300 "TEST RESULT OF ". NC1724.2 +025400 02 TEST-ID PIC X(9). NC1724.2 +025500 02 FILLER PIC X(4) VALUE NC1724.2 +025600 " IN ". NC1724.2 +025700 02 FILLER PIC X(12) VALUE NC1724.2 +025800 " HIGH ". NC1724.2 +025900 02 FILLER PIC X(22) VALUE NC1724.2 +026000 " LEVEL VALIDATION FOR ". NC1724.2 +026100 02 FILLER PIC X(58) VALUE NC1724.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +026300 01 CCVS-H-3. NC1724.2 +026400 02 FILLER PIC X(34) VALUE NC1724.2 +026500 " FOR OFFICIAL USE ONLY ". NC1724.2 +026600 02 FILLER PIC X(58) VALUE NC1724.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1724.2 +026800 02 FILLER PIC X(28) VALUE NC1724.2 +026900 " COPYRIGHT 1985 ". NC1724.2 +027000 01 CCVS-E-1. NC1724.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1724.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1724.2 +027300 02 ID-AGAIN PIC X(9). NC1724.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1724.2 +027500 01 CCVS-E-2. NC1724.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1724.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1724.2 +027800 02 CCVS-E-2-2. NC1724.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1724.2 +028000 03 FILLER PIC X VALUE SPACE. NC1724.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1724.2 +028200 "ERRORS ENCOUNTERED". NC1724.2 +028300 01 CCVS-E-3. NC1724.2 +028400 02 FILLER PIC X(22) VALUE NC1724.2 +028500 " FOR OFFICIAL USE ONLY". NC1724.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1724.2 +028700 02 FILLER PIC X(58) VALUE NC1724.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1724.2 +029000 02 FILLER PIC X(15) VALUE NC1724.2 +029100 " COPYRIGHT 1985". NC1724.2 +029200 01 CCVS-E-4. NC1724.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1724.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1724.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1724.2 +029600 02 FILLER PIC X(40) VALUE NC1724.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1724.2 +029800 01 XXINFO. NC1724.2 +029900 02 FILLER PIC X(19) VALUE NC1724.2 +030000 "*** INFORMATION ***". NC1724.2 +030100 02 INFO-TEXT. NC1724.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1724.2 +030300 04 XXCOMPUTED PIC X(20). NC1724.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1724.2 +030500 04 XXCORRECT PIC X(20). NC1724.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1724.2 +030700 01 HYPHEN-LINE. NC1724.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1724.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1724.2 +031000- "*****************************************". NC1724.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1724.2 +031200- "******************************". NC1724.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1724.2 +031400 "NC172A". NC1724.2 +031500 PROCEDURE DIVISION. NC1724.2 +031600 CCVS1 SECTION. NC1724.2 +031700 OPEN-FILES. NC1724.2 +031800 OPEN OUTPUT PRINT-FILE. NC1724.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1724.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1724.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1724.2 +032200 GO TO CCVS1-EXIT. NC1724.2 +032300 CLOSE-FILES. NC1724.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1724.2 +032500 TERMINATE-CCVS. NC1724.2 +032600S EXIT PROGRAM. NC1724.2 +032700STERMINATE-CALL. NC1724.2 +032800 STOP RUN. NC1724.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1724.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1724.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1724.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1724.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1724.2 +033400 PRINT-DETAIL. NC1724.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1724.2 +033600 MOVE "." TO PARDOT-X NC1724.2 +033700 MOVE REC-CT TO DOTVALUE. NC1724.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1724.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1724.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1724.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1724.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1724.2 +034300 MOVE SPACE TO CORRECT-X. NC1724.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1724.2 +034500 MOVE SPACE TO RE-MARK. NC1724.2 +034600 HEAD-ROUTINE. NC1724.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1724.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1724.2 +035100 COLUMN-NAMES-ROUTINE. NC1724.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +035500 END-ROUTINE. NC1724.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1724.2 +035700 END-RTN-EXIT. NC1724.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +035900 END-ROUTINE-1. NC1724.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1724.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1724.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1724.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1724.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1724.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1724.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1724.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1724.2 +036800 END-ROUTINE-12. NC1724.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1724.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1724.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1724.2 +037200 ELSE NC1724.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1724.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1724.2 +037500 PERFORM WRITE-LINE. NC1724.2 +037600 END-ROUTINE-13. NC1724.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1724.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1724.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1724.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1724.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1724.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1724.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1724.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1724.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038800 WRITE-LINE. NC1724.2 +038900 ADD 1 TO RECORD-COUNT. NC1724.2 +039000Y IF RECORD-COUNT GREATER 42 NC1724.2 +039100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1724.2 +039200Y MOVE SPACE TO DUMMY-RECORD NC1724.2 +039300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1724.2 +039400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1724.2 +039500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1724.2 +039600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1724.2 +039700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1724.2 +039800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +039900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +040000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +040100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1724.2 +040200Y MOVE ZERO TO RECORD-COUNT. NC1724.2 +040300 PERFORM WRT-LN. NC1724.2 +040400 WRT-LN. NC1724.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1724.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1724.2 +040700 BLANK-LINE-PRINT. NC1724.2 +040800 PERFORM WRT-LN. NC1724.2 +040900 FAIL-ROUTINE. NC1724.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1724.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1724.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1724.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1724.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1724.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1724.2 +041700 GO TO FAIL-ROUTINE-EX. NC1724.2 +041800 FAIL-ROUTINE-WRITE. NC1724.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1724.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1724.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1724.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1724.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1724.2 +042400 BAIL-OUT. NC1724.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1724.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1724.2 +042700 BAIL-OUT-WRITE. NC1724.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1724.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1724.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1724.2 +043200 BAIL-OUT-EX. EXIT. NC1724.2 +043300 CCVS1-EXIT. NC1724.2 +043400 EXIT. NC1724.2 +043500 SECT-NC172A-001 SECTION. NC1724.2 +043600 DIV-INIT-F2-1. NC1724.2 +043700 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1724.2 +043800 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +043900 MOVE 44.1 TO DIV2. NC1724.2 +044000 MOVE ZERO TO DIV8. NC1724.2 +044100 DIV-TEST-F2-0. NC1724.2 +044200 DIVIDE DIV2 INTO 864.36 GIVING DIV8. NC1724.2 +044300 DIV-TEST-F2-1. NC1724.2 +044400 IF DIV8 EQUAL TO 19.6 NC1724.2 +044500 PERFORM PASS NC1724.2 +044600 ELSE NC1724.2 +044700 GO TO DIV-FAIL-F2-1. NC1724.2 +044800 GO TO DIV-WRITE-F2-1. NC1724.2 +044900 DIV-DELETE-F2-1. NC1724.2 +045000 PERFORM DE-LETE. NC1724.2 +045100 GO TO DIV-WRITE-F2-1. NC1724.2 +045200 DIV-FAIL-F2-1. NC1724.2 +045300 PERFORM FAIL. NC1724.2 +045400 MOVE DIV8 TO COMPUTED-N. NC1724.2 +045500 MOVE +19.6 TO CORRECT-N. NC1724.2 +045600 DIV-WRITE-F2-1. NC1724.2 +045700 MOVE "DIV-TEST-F2-1 " TO PAR-NAME. NC1724.2 +045800 PERFORM PRINT-DETAIL. NC1724.2 +045900 DIV-INIT-F2-2. NC1724.2 +046000 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +046100 MOVE 1620.36 TO DIV1. NC1724.2 +046200 MOVE ZERO TO DIV9. NC1724.2 +046300 DIV-TEST-F2-2-0. NC1724.2 +046400 DIVIDE 0.533 INTO DIV1 GIVING DIV9 ROUNDED. NC1724.2 +046500 DIV-TEST-F2-2-1. NC1724.2 +046600 IF DIV9 EQUAL TO " 3,040.1" NC1724.2 +046700 PERFORM PASS NC1724.2 +046800 ELSE NC1724.2 +046900 GO TO DIV-FAIL-F2-2. NC1724.2 +047000 GO TO DIV-WRITE-F2-2. NC1724.2 +047100 DIV-DELETE-F2-2. NC1724.2 +047200 PERFORM DE-LETE. NC1724.2 +047300 GO TO DIV-WRITE-F2-2. NC1724.2 +047400 DIV-FAIL-F2-2. NC1724.2 +047500 PERFORM FAIL. NC1724.2 +047600 MOVE DIV9 TO COMPUTED-A. NC1724.2 +047700 MOVE " 3,040.1" TO CORRECT-A. NC1724.2 +047800 DIV-WRITE-F2-2. NC1724.2 +047900 MOVE "DIV-TEST-F2-2" TO PAR-NAME. NC1724.2 +048000 PERFORM PRINT-DETAIL. NC1724.2 +048100 DIV-INIT-F2-3. NC1724.2 +048200 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +048300 MOVE -9.642 TO DIV4. NC1724.2 +048400 MOVE 44.1 TO DIV2. NC1724.2 +048500 MOVE ZERO TO DIV10. NC1724.2 +048600 MOVE "A" TO XRAY. NC1724.2 +048700 DIV-TEST-F2-3-0. NC1724.2 +048800 DIVIDE DIV4 INTO DIV2 GIVING DIV10 ON SIZE ERROR NC1724.2 +048900 MOVE "P" TO XRAY. NC1724.2 +049000 DIV-TEST-F2-3-1. NC1724.2 +049100 IF XRAY EQUAL TO "P" NC1724.2 +049200 PERFORM PASS NC1724.2 +049300 ELSE NC1724.2 +049400 GO TO DIV-FAIL-F2-3-1. NC1724.2 +049500 GO TO DIV-WRITE-F2-3-1. NC1724.2 +049600 DIV-DELETE-F2-3-1. NC1724.2 +049700 PERFORM DE-LETE. NC1724.2 +049800 GO TO DIV-WRITE-F2-3-1. NC1724.2 +049900 DIV-FAIL-F2-3-1. NC1724.2 +050000 MOVE XRAY TO COMPUTED-X. NC1724.2 +050100 MOVE "A" TO CORRECT-X. NC1724.2 +050200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +050300 PERFORM FAIL. NC1724.2 +050400 DIV-WRITE-F2-3-1. NC1724.2 +050500 MOVE "DIV-TEST-F2-3-1" TO PAR-NAME. NC1724.2 +050600 PERFORM PRINT-DETAIL. NC1724.2 +050700 DIV-TEST-F2-3-2. NC1724.2 +050800 IF DIV10 NOT EQUAL TO ZERO NC1724.2 +050900 GO TO DIV-FAIL-F2-3-2. NC1724.2 +051000 PERFORM PASS. NC1724.2 +051100 GO TO DIV-WRITE-F2-3-2. NC1724.2 +051200 DIV-DELETE-F2-3-2. NC1724.2 +051300 PERFORM DE-LETE. NC1724.2 +051400 GO TO DIV-WRITE-F2-3-2. NC1724.2 +051500 DIV-FAIL-F2-3-2. NC1724.2 +051600 PERFORM FAIL. NC1724.2 +051700 MOVE DIV10 TO COMPUTED-N. NC1724.2 +051800 MOVE ZERO TO CORRECT-N. NC1724.2 +051900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +052000 DIV-WRITE-F2-3-2. NC1724.2 +052100 MOVE "DIV-TEST-F2-3-2" TO PAR-NAME. NC1724.2 +052200 PERFORM PRINT-DETAIL. NC1724.2 +052300 DIV-INIT-F2-4. NC1724.2 +052400 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +052500 MOVE ZERO TO DIV8. NC1724.2 +052600 MOVE "B" TO XRAY. NC1724.2 +052700 DIV-TEST-F2-4-0. NC1724.2 +052800 DIVIDE 1.0051 INTO 100.50 GIVING DIV8 ROUNDED NC1724.2 +052900 ON SIZE ERROR NC1724.2 +053000 MOVE "Q" TO XRAY. NC1724.2 +053100 DIV-TEST-F2-4-1. NC1724.2 +053200 IF XRAY EQUAL TO "Q" NC1724.2 +053300 PERFORM PASS NC1724.2 +053400 ELSE NC1724.2 +053500 GO TO DIV-FAIL-F2-4-1. NC1724.2 +053600 GO TO DIV-WRITE-F2-4-1. NC1724.2 +053700 DIV-DELETE-F2-4-1. NC1724.2 +053800 PERFORM DE-LETE. NC1724.2 +053900 GO TO DIV-WRITE-F2-4-1. NC1724.2 +054000 DIV-FAIL-F2-4-1. NC1724.2 +054100 MOVE XRAY TO COMPUTED-X. NC1724.2 +054200 MOVE "B" TO COMPUTED-X. NC1724.2 +054300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +054400 PERFORM FAIL. NC1724.2 +054500 DIV-WRITE-F2-4-1. NC1724.2 +054600 MOVE "DIV-TEST-F2-4-1" TO PAR-NAME. NC1724.2 +054700 PERFORM PRINT-DETAIL. NC1724.2 +054800 DIV-TEST-F2-4-2. NC1724.2 +054900 IF DIV8 NOT EQUAL TO ZERO NC1724.2 +055000 GO TO DIV-FAIL-F2-4-2. NC1724.2 +055100 PERFORM PASS. NC1724.2 +055200 GO TO DIV-WRITE-F2-4-2. NC1724.2 +055300 DIV-DELETE-F2-4-2. NC1724.2 +055400 PERFORM DE-LETE. NC1724.2 +055500 GO TO DIV-WRITE-F2-4-2. NC1724.2 +055600 DIV-FAIL-F2-4-2. NC1724.2 +055700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +055800 PERFORM FAIL. NC1724.2 +055900 MOVE DIV8 TO COMPUTED-N. NC1724.2 +056000 MOVE 000 TO CORRECT-N. NC1724.2 +056100 DIV-WRITE-F2-4-2. NC1724.2 +056200 MOVE "DIV-TEST-F2-4-2" TO PAR-NAME. NC1724.2 +056300 PERFORM PRINT-DETAIL. NC1724.2 +056400 DIV-INIT-F2-5. NC1724.2 +056500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +056600 MOVE ZERO TO WRK-DS-01V00. NC1724.2 +056700 DIV-TEST-F2-5-0. NC1724.2 +056800 DIVIDE -10.9 INTO A02TWOS-DU-02V00 GIVING WRK-DS-01V00. NC1724.2 +056900 DIV-TEST-F2-5-1. NC1724.2 +057000 IF WRK-DS-01V00 EQUAL TO -2 NC1724.2 +057100 PERFORM PASS NC1724.2 +057200 GO TO DIV-WRITE-F2-5. NC1724.2 +057300 GO TO DIV-FAIL-F2-5. NC1724.2 +057400 DIV-DELETE-F2-5. NC1724.2 +057500 PERFORM DE-LETE. NC1724.2 +057600 GO TO DIV-WRITE-F2-5. NC1724.2 +057700 DIV-FAIL-F2-5. NC1724.2 +057800 MOVE -2 TO CORRECT-N. NC1724.2 +057900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1724.2 +058000 PERFORM FAIL. NC1724.2 +058100 DIV-WRITE-F2-5. NC1724.2 +058200 MOVE "DIV-TEST-F2-5 " TO PAR-NAME. NC1724.2 +058300 PERFORM PRINT-DETAIL. NC1724.2 +058400 DIV-INIT-F2-6. NC1724.2 +058500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +058600 MOVE 0.0000000001 TO WRK-DS-03V10. NC1724.2 +058700 MOVE ZERO TO WRK-DS-18V00. NC1724.2 +058800 DIV-TEST-F2-6-0. NC1724.2 +058900 DIVIDE WRK-DS-03V10 INTO A01ONE-DS-P0801 NC1724.2 +059000 GIVING WRK-DS-18V00 ROUNDED. NC1724.2 +059100 DIV-TEST-F2-6-1. NC1724.2 +059200 IF WRK-DS-18V00 EQUAL TO 000000000000000010 NC1724.2 +059300 PERFORM PASS NC1724.2 +059400 GO TO DIV-WRITE-F2-6. NC1724.2 +059500 GO TO DIV-FAIL-F2-6. NC1724.2 +059600 DIV-DELETE-F2-6. NC1724.2 +059700 PERFORM DE-LETE. NC1724.2 +059800 GO TO DIV-WRITE-F2-6. NC1724.2 +059900 DIV-FAIL-F2-6. NC1724.2 +060000 MOVE 000000000000000010 TO CORRECT-18V0. NC1724.2 +060100 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1724.2 +060200 PERFORM FAIL. NC1724.2 +060300 DIV-WRITE-F2-6. NC1724.2 +060400 MOVE "DIV-TEST-F2-6 " TO PAR-NAME. NC1724.2 +060500 PERFORM PRINT-DETAIL. NC1724.2 +060600 DIV-INIT-F2-7. NC1724.2 +060700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +060800 MOVE ZERO TO WRK-DS-18V00 AZERO-DS-05V05. NC1724.2 +060900 MOVE "0" TO WRK-XN-00001. NC1724.2 +061000 MOVE 99 TO A99-DS-02V00. NC1724.2 +061100 DIV-TEST-F2-7-0. NC1724.2 +061200 DIVIDE AZERO-DS-05V05 INTO A99-DS-02V00 NC1724.2 +061300 GIVING WRK-DS-18V00 ON SIZE ERROR NC1724.2 +061400 MOVE "1" TO WRK-XN-00001. NC1724.2 +061500 DIV-TEST-F2-7-1. NC1724.2 +061600 IF WRK-DS-18V00 EQUAL TO 000000000000000000 NC1724.2 +061700 PERFORM PASS NC1724.2 +061800 GO TO DIV-WRITE-F2-7-1. NC1724.2 +061900 GO TO DIV-FAIL-F2-7-1. NC1724.2 +062000 DIV-DELETE-F2-7-1. NC1724.2 +062100 PERFORM DE-LETE. NC1724.2 +062200 GO TO DIV-WRITE-F2-7-1. NC1724.2 +062300 DIV-FAIL-F2-7-1. NC1724.2 +062400 MOVE 000000000000000000 TO CORRECT-18V0. NC1724.2 +062500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1724.2 +062600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +062700 PERFORM FAIL. NC1724.2 +062800 DIV-WRITE-F2-7-1. NC1724.2 +062900 MOVE "DIV-TEST-F2-7-1 " TO PAR-NAME. NC1724.2 +063000 PERFORM PRINT-DETAIL. NC1724.2 +063100 DIV-TEST-F2-7-2. NC1724.2 +063200 IF WRK-XN-00001 EQUAL TO "1" NC1724.2 +063300 PERFORM PASS NC1724.2 +063400 GO TO DIV-WRITE-F2-7-2. NC1724.2 +063500 MOVE "1" TO CORRECT-A. NC1724.2 +063600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +063700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +063800 PERFORM FAIL. NC1724.2 +063900 GO TO DIV-WRITE-F2-7-2. NC1724.2 +064000 DIV-DELETE-F2-7-2. NC1724.2 +064100 PERFORM DE-LETE. NC1724.2 +064200 DIV-WRITE-F2-7-2. NC1724.2 +064300 MOVE "DIV-TEST-F2-7-2 " TO PAR-NAME. NC1724.2 +064400 PERFORM PRINT-DETAIL. NC1724.2 +064500 DIV-INIT-F2-8. NC1724.2 +064600 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +064700 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +064800 MOVE "1" TO WRK-XN-00001. NC1724.2 +064900 DIV-TEST-F2-8-0. NC1724.2 +065000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 GIVING NC1724.2 +065100 WRK-DS-09V09 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1724.2 +065200 DIV-TEST-F2-8-1. NC1724.2 +065300 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1724.2 +065400 PERFORM PASS NC1724.2 +065500 GO TO DIV-WRITE-F2-8-1. NC1724.2 +065600 GO TO DIV-FAIL-F2-8-1. NC1724.2 +065700 DIV-DELETE-F2-8-1. NC1724.2 +065800 PERFORM DE-LETE. NC1724.2 +065900 GO TO DIV-WRITE-F2-8-1. NC1724.2 +066000 DIV-FAIL-F2-8-1. NC1724.2 +066100 MOVE 000000001000000000 TO CORRECT-18V0. NC1724.2 +066200 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1724.2 +066300 PERFORM FAIL. NC1724.2 +066400 DIV-WRITE-F2-8-1. NC1724.2 +066500 MOVE "DIV-TEST-F2-8-1 " TO PAR-NAME. NC1724.2 +066600 PERFORM PRINT-DETAIL. NC1724.2 +066700 DIV-TEST-F2-8-2. NC1724.2 +066800 IF WRK-XN-00001 EQUAL TO "0" NC1724.2 +066900 MOVE "0" TO COMPUTED-A NC1724.2 +067000 MOVE "1" TO CORRECT-A NC1724.2 +067100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1724.2 +067200 PERFORM FAIL NC1724.2 +067300 GO TO DIV-WRITE-F2-8-2. NC1724.2 +067400 PERFORM PASS. NC1724.2 +067500 GO TO DIV-WRITE-F2-8-2. NC1724.2 +067600 DIV-DELETE-F2-8-2. NC1724.2 +067700 PERFORM DE-LETE. NC1724.2 +067800 DIV-WRITE-F2-8-2. NC1724.2 +067900 MOVE "DIV-TEST-F2-8-2 " TO PAR-NAME. NC1724.2 +068000 PERFORM PRINT-DETAIL. NC1724.2 +068100 DIV-INIT-F2-9. NC1724.2 +068200 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +068300 MOVE ZERO TO WRK-DS-0201P. NC1724.2 +068400 MOVE -0.005 TO WRK-DS-09V09. NC1724.2 +068500 MOVE "0" TO WRK-XN-00001. NC1724.2 +068600 DIV-TEST-F2-9-0. NC1724.2 +068700 DIVIDE WRK-DS-09V09 INTO A05ONES-DS-00V05 GIVING NC1724.2 +068800 WRK-DS-0201P ROUNDED ON SIZE ERROR NC1724.2 +068900 MOVE "1" TO WRK-XN-00001. NC1724.2 +069000 DIV-TEST-F2-9-1. NC1724.2 +069100 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1724.2 +069200 IF WRK-DS-05V00 EQUAL TO -00020 NC1724.2 +069300 PERFORM PASS NC1724.2 +069400 GO TO DIV-WRITE-F2-9-1. NC1724.2 +069500 GO TO DIV-FAIL-F2-9-1. NC1724.2 +069600 DIV-DELETE-F2-9-1. NC1724.2 +069700 PERFORM DE-LETE. NC1724.2 +069800 GO TO DIV-WRITE-F2-9-1. NC1724.2 +069900 DIV-FAIL-F2-9-1. NC1724.2 +070000 MOVE -00020 TO CORRECT-N. NC1724.2 +070100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1724.2 +070200 PERFORM FAIL. NC1724.2 +070300 DIV-WRITE-F2-9-1. NC1724.2 +070400 MOVE "DIV-TEST-F2-9-1 " TO PAR-NAME. NC1724.2 +070500 PERFORM PRINT-DETAIL. NC1724.2 +070600 DIV-TEST-F2-9-2. NC1724.2 +070700 IF WRK-XN-00001 EQUAL TO "0" NC1724.2 +070800 PERFORM PASS NC1724.2 +070900 GO TO DIV-WRITE-F2-9-2. NC1724.2 +071000 MOVE "0" TO CORRECT-A. NC1724.2 +071100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +071200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1724.2 +071300 PERFORM FAIL. NC1724.2 +071400 GO TO DIV-WRITE-F2-9-2. NC1724.2 +071500 DIV-DELETE-F2-9-2. NC1724.2 +071600 PERFORM DE-LETE. NC1724.2 +071700 DIV-WRITE-F2-9-2. NC1724.2 +071800 MOVE "DIV-TEST-F2-9-2 " TO PAR-NAME. NC1724.2 +071900 PERFORM PRINT-DETAIL. NC1724.2 +072000 DIV-INIT-F2-10. NC1724.2 +072100 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +072200 MOVE "1" TO WRK-XN-00001. NC1724.2 +072300 MOVE ZERO TO WRK-DS-01V00. NC1724.2 +072400 DIV-TEST-F2-10-1. NC1724.2 +072500 DIVIDE A02TWOS-DU-02V00 INTO A02TWOS-DS-03V02 GIVING NC1724.2 +072600 WRK-DS-01V00 ROUNDED ON SIZE ERROR NC1724.2 +072700 MOVE "0" TO WRK-XN-00001. NC1724.2 +072800 IF WRK-DS-01V00 EQUAL TO +1 NC1724.2 +072900 PERFORM PASS NC1724.2 +073000 GO TO DIV-WRITE-F2-10-1. NC1724.2 +073100 GO TO DIV-FAIL-F2-10-1. NC1724.2 +073200 DIV-DELETE-F2-10-1. NC1724.2 +073300 PERFORM DE-LETE. NC1724.2 +073400 GO TO DIV-WRITE-F2-10-1. NC1724.2 +073500 DIV-FAIL-F2-10-1. NC1724.2 +073600 MOVE +1 TO CORRECT-N. NC1724.2 +073700 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1724.2 +073800 PERFORM FAIL. NC1724.2 +073900 DIV-WRITE-F2-10-1. NC1724.2 +074000 MOVE "DIV-TEST-F2-10-1 " TO PAR-NAME. NC1724.2 +074100 PERFORM PRINT-DETAIL. NC1724.2 +074200 DIV-TEST-F2-10-2. NC1724.2 +074300 IF WRK-XN-00001 EQUAL TO "1" NC1724.2 +074400 PERFORM PASS NC1724.2 +074500 GO TO DIV-WRITE-F2-10-2. NC1724.2 +074600 MOVE "1" TO CORRECT-A. NC1724.2 +074700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +074800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1724.2 +074900 PERFORM FAIL. NC1724.2 +075000 GO TO DIV-WRITE-F2-10-2. NC1724.2 +075100 DIV-DELETE-F2-10-2. NC1724.2 +075200 PERFORM DE-LETE. NC1724.2 +075300 DIV-WRITE-F2-10-2. NC1724.2 +075400 MOVE "DIV-TEST-F2-10-2 " TO PAR-NAME. NC1724.2 +075500 PERFORM PRINT-DETAIL. NC1724.2 +075600 DIV-INIT-F2-11. NC1724.2 +075700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +075800 MOVE 0 TO WRK-DS-05V00. NC1724.2 +075900 DIV-TEST-F2-11. NC1724.2 +076000 DIVIDE A01ONE-CS-00V01 INTO A99-CS-02V00 GIVING NC1724.2 +076100 WRK-DS-05V00. NC1724.2 +076200 IF WRK-DS-05V00 EQUAL TO 00990 NC1724.2 +076300 PERFORM PASS NC1724.2 +076400 GO TO DIV-WRITE-F2-11. NC1724.2 +076500 GO TO DIV-FAIL-F2-11. NC1724.2 +076600 DIV-DELETE-F2-11. NC1724.2 +076700 PERFORM DE-LETE. NC1724.2 +076800 GO TO DIV-WRITE-F2-11. NC1724.2 +076900 DIV-FAIL-F2-11. NC1724.2 +077000 MOVE 00990 TO CORRECT-N. NC1724.2 +077100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1724.2 +077200 PERFORM FAIL. NC1724.2 +077300 DIV-WRITE-F2-11. NC1724.2 +077400 MOVE "DIVIDE INTO GIVING " TO FEATURE. NC1724.2 +077500 MOVE "DIV-TEST-F2-11 " TO PAR-NAME. NC1724.2 +077600 PERFORM PRINT-DETAIL. NC1724.2 +077700 DIV-INIT-F2-12. NC1724.2 +077800 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +077900 MOVE ZERO TO WRK-CS-18V00. NC1724.2 +078000 DIV-TEST-F2-12-0. NC1724.2 +078100 DIVIDE A02THREES-CS-18V00 INTO A18SIXES-CU-18V00 GIVING NC1724.2 +078200 WRK-CS-18V00. NC1724.2 +078300 DIV-TEST-F2-12-1. NC1724.2 +078400 IF WRK-CS-18V00 EQUAL TO -020202020202020202 NC1724.2 +078500 PERFORM PASS NC1724.2 +078600 GO TO DIV-WRITE-F2-12. NC1724.2 +078700 MOVE -020202020202020202 TO CORRECT-18V0. NC1724.2 +078800 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1724.2 +078900 PERFORM FAIL. NC1724.2 +079000 GO TO DIV-WRITE-F2-12. NC1724.2 +079100 DIV-DELETE-F2-12. NC1724.2 +079200 PERFORM DE-LETE. NC1724.2 +079300 DIV-WRITE-F2-12. NC1724.2 +079400 MOVE "DIV-TEST-F2-12 " TO PAR-NAME. NC1724.2 +079500 PERFORM PRINT-DETAIL. NC1724.2 +079600 DIV-INIT-F2-13. NC1724.2 +079700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +079800 MOVE ZERO TO WRK-CS-18V00. NC1724.2 +079900 DIV-TEST-F2-13. NC1724.2 +080000 DIVIDE A02THREES-CS-18V00 INTO A02THREES-CS-18V00 NC1724.2 +080100 GIVING WRK-CS-18V00. NC1724.2 +080200 IF WRK-CS-18V00 EQUAL TO 000000000000000001 NC1724.2 +080300 PERFORM PASS NC1724.2 +080400 GO TO DIV-WRITE-F2-13. NC1724.2 +080500 MOVE 000000000000000001 TO CORRECT-18V0. NC1724.2 +080600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1724.2 +080700 PERFORM FAIL. NC1724.2 +080800 GO TO DIV-WRITE-F2-13. NC1724.2 +080900 DIV-DELETE-F2-13. NC1724.2 +081000 PERFORM DE-LETE. NC1724.2 +081100 DIV-WRITE-F2-13. NC1724.2 +081200 MOVE "DIV-TEST-F2-13 " TO PAR-NAME. NC1724.2 +081300 PERFORM PRINT-DETAIL. NC1724.2 +081400* NC1724.2 +081500* NC1724.2 +081600 DIV-INIT-F2-14. NC1724.2 +081700* ==--> SIZE ERROR CONDITION <--== NC1724.2 +081800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +081900 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +082000 MOVE "DIV-TEST-F2-14-1" TO PAR-NAME. NC1724.2 +082100 MOVE "P" TO XRAY. NC1724.2 +082200 MOVE 0 TO DIV10. NC1724.2 +082300 MOVE 1 TO REC-CT. NC1724.2 +082400 MOVE 44.1 TO DIV2. NC1724.2 +082500 MOVE -9.642 TO DIV4. NC1724.2 +082600 DIV-TEST-F2-14-0. NC1724.2 +082700 DIVIDE DIV4 INTO DIV2 NC1724.2 +082800 GIVING DIV10 NC1724.2 +082900 NOT ON SIZE ERROR NC1724.2 +083000 MOVE "N" TO XRAY. NC1724.2 +083100 GO TO DIV-TEST-F2-14-1. NC1724.2 +083200 DIV-DELETE-F2-14-1. NC1724.2 +083300 PERFORM DE-LETE. NC1724.2 +083400 PERFORM PRINT-DETAIL. NC1724.2 +083500 GO TO DIV-INIT-F2-15. NC1724.2 +083600 DIV-TEST-F2-14-1. NC1724.2 +083700 MOVE "DIV-TEST-F2-14-1" TO PAR-NAME. NC1724.2 +083800 IF DIV10 NOT = 0 NC1724.2 +083900 MOVE DIV10 TO COMPUTED-N NC1724.2 +084000 MOVE 0 TO CORRECT-N NC1724.2 +084100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +084200 PERFORM FAIL NC1724.2 +084300 PERFORM PRINT-DETAIL NC1724.2 +084400 ELSE NC1724.2 +084500 PERFORM PASS NC1724.2 +084600 PERFORM PRINT-DETAIL. NC1724.2 +084700 ADD 1 TO REC-CT. NC1724.2 +084800 DIV-TEST-F2-14-2. NC1724.2 +084900 MOVE "DIV-TEST-F2-14-2" TO PAR-NAME. NC1724.2 +085000 IF XRAY NOT = "P" NC1724.2 +085100 MOVE XRAY TO COMPUTED-X NC1724.2 +085200 MOVE "P" TO CORRECT-X NC1724.2 +085300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +085400 PERFORM FAIL NC1724.2 +085500 PERFORM PRINT-DETAIL NC1724.2 +085600 ELSE NC1724.2 +085700 PERFORM PASS NC1724.2 +085800 PERFORM PRINT-DETAIL. NC1724.2 +085900* NC1724.2 +086000* NC1724.2 +086100 DIV-INIT-F2-15. NC1724.2 +086200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +086300* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +086400 MOVE "DIV-TEST-F2-15-1" TO PAR-NAME. NC1724.2 +086500 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +086600 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +086700 MOVE 1 TO REC-CT. NC1724.2 +086800 MOVE "1" TO WRK-XN-00001. NC1724.2 +086900 DIV-TEST-F2-15-0. NC1724.2 +087000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +087100 GIVING WRK-DS-09V09 NC1724.2 +087200 NOT ON SIZE ERROR NC1724.2 +087300 MOVE "0" TO WRK-XN-00001. NC1724.2 +087400 GO TO DIV-TEST-F2-15-1. NC1724.2 +087500 DIV-DELETE-F2-15-1. NC1724.2 +087600 PERFORM DE-LETE. NC1724.2 +087700 PERFORM PRINT-DETAIL. NC1724.2 +087800 GO TO DIV-INIT-F2-16. NC1724.2 +087900 DIV-TEST-F2-15-1. NC1724.2 +088000 MOVE "DIV-TEST-F2-15-1 " TO PAR-NAME. NC1724.2 +088100 IF WRK-DS-18V00-S NOT = 000000001000000000 NC1724.2 +088200 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +088300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1724.2 +088400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1724.2 +088500 TO RE-MARK NC1724.2 +088600 PERFORM FAIL NC1724.2 +088700 PERFORM PRINT-DETAIL NC1724.2 +088800 ELSE NC1724.2 +088900 PERFORM PASS NC1724.2 +089000 PERFORM PRINT-DETAIL. NC1724.2 +089100 ADD 1 TO REC-CT. NC1724.2 +089200 DIV-TEST-F2-15-2. NC1724.2 +089300 MOVE "DIV-TEST-F2-15-2" TO PAR-NAME. NC1724.2 +089400 IF WRK-XN-00001 NOT = "0" NC1724.2 +089500 MOVE "0" TO CORRECT-X NC1724.2 +089600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +089700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +089800 TO RE-MARK NC1724.2 +089900 PERFORM FAIL NC1724.2 +090000 PERFORM PRINT-DETAIL NC1724.2 +090100 ELSE NC1724.2 +090200 PERFORM PASS NC1724.2 +090300 PERFORM PRINT-DETAIL. NC1724.2 +090400* NC1724.2 +090500* NC1724.2 +090600 DIV-INIT-F2-16. NC1724.2 +090700* ==--> SIZE ERROR CONDITION <--== NC1724.2 +090800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +090900 MOVE "DIV-TEST-F2-16-1" TO PAR-NAME. NC1724.2 +091000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +091100 MOVE "P" TO XRAY. NC1724.2 +091200 MOVE 0 TO DIV10. NC1724.2 +091300 MOVE 1 TO REC-CT. NC1724.2 +091400 MOVE 44.1 TO DIV2. NC1724.2 +091500 MOVE -9.642 TO DIV4. NC1724.2 +091600 DIV-TEST-F2-16-0. NC1724.2 +091700 DIVIDE DIV4 INTO DIV2 NC1724.2 +091800 GIVING DIV10 NC1724.2 +091900 ON SIZE ERROR NC1724.2 +092000 MOVE "E" TO XRAY NC1724.2 +092100 NOT ON SIZE ERROR NC1724.2 +092200 MOVE "N" TO XRAY. NC1724.2 +092300 GO TO DIV-TEST-F2-16-1. NC1724.2 +092400 DIV-DELETE-F2-16-1. NC1724.2 +092500 PERFORM DE-LETE. NC1724.2 +092600 PERFORM PRINT-DETAIL. NC1724.2 +092700 GO TO DIV-INIT-F2-17. NC1724.2 +092800 DIV-TEST-F2-16-1. NC1724.2 +092900 MOVE "DIV-TEST-F2-16-1" TO PAR-NAME. NC1724.2 +093000 IF DIV10 NOT = 0 NC1724.2 +093100 MOVE DIV10 TO COMPUTED-N NC1724.2 +093200 MOVE 0 TO CORRECT-N NC1724.2 +093300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +093400 PERFORM FAIL NC1724.2 +093500 PERFORM PRINT-DETAIL NC1724.2 +093600 ELSE NC1724.2 +093700 PERFORM PASS NC1724.2 +093800 PERFORM PRINT-DETAIL. NC1724.2 +093900 ADD 1 TO REC-CT. NC1724.2 +094000 DIV-TEST-F2-16-2. NC1724.2 +094100 MOVE "DIV-TEST-F2-16-2" TO PAR-NAME. NC1724.2 +094200 IF XRAY NOT = "E" NC1724.2 +094300 MOVE XRAY TO COMPUTED-X NC1724.2 +094400 MOVE "E" TO CORRECT-X NC1724.2 +094500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +094600 PERFORM FAIL NC1724.2 +094700 PERFORM PRINT-DETAIL NC1724.2 +094800 ELSE NC1724.2 +094900 PERFORM PASS NC1724.2 +095000 PERFORM PRINT-DETAIL. NC1724.2 +095100* NC1724.2 +095200* NC1724.2 +095300 DIV-INIT-F2-17. NC1724.2 +095400* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +095500* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +095600 MOVE "DIV-TEST-F2-17-1" TO PAR-NAME. NC1724.2 +095700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +095800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +095900 MOVE "0" TO WRK-XN-00001. NC1724.2 +096000 MOVE 1 TO REC-CT. NC1724.2 +096100 DIV-TEST-F2-17-0. NC1724.2 +096200 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +096300 GIVING WRK-DS-09V09 NC1724.2 +096400 ON SIZE ERROR NC1724.2 +096500 MOVE "1" TO WRK-XN-00001 NC1724.2 +096600 NOT ON SIZE ERROR NC1724.2 +096700 MOVE "2" TO WRK-XN-00001. NC1724.2 +096800 GO TO DIV-TEST-F2-17-1. NC1724.2 +096900 DIV-DELETE-F2-17-1. NC1724.2 +097000 PERFORM DE-LETE. NC1724.2 +097100 PERFORM PRINT-DETAIL. NC1724.2 +097200 GO TO DIV-INIT-F2-18. NC1724.2 +097300 DIV-TEST-F2-17-1. NC1724.2 +097400 MOVE "DIV-TEST-F2-17-1" TO PAR-NAME. NC1724.2 +097500 IF WRK-DS-18V00-S NOT = 000000001000000000 NC1724.2 +097600 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +097700 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1724.2 +097800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1724.2 +097900 TO RE-MARK NC1724.2 +098000 PERFORM FAIL NC1724.2 +098100 PERFORM PRINT-DETAIL NC1724.2 +098200 ELSE NC1724.2 +098300 PERFORM PASS NC1724.2 +098400 PERFORM PRINT-DETAIL. NC1724.2 +098500 ADD 1 TO REC-CT. NC1724.2 +098600 DIV-TEST-F2-17-2. NC1724.2 +098700 MOVE "DIV-TEST-F2-17-2" TO PAR-NAME. NC1724.2 +098800 IF WRK-XN-00001 NOT = "2" NC1724.2 +098900 MOVE "2" TO CORRECT-X NC1724.2 +099000 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +099100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +099200 TO RE-MARK NC1724.2 +099300 PERFORM FAIL NC1724.2 +099400 PERFORM PRINT-DETAIL NC1724.2 +099500 ELSE NC1724.2 +099600 PERFORM PASS NC1724.2 +099700 PERFORM PRINT-DETAIL. NC1724.2 +099800* NC1724.2 +099900* NC1724.2 +100000 DIV-INIT-F2-18. NC1724.2 +100100 MOVE "DIVIDE-INTO-GIVING" TO FEATURE. NC1724.2 +100200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +100300* ==--> MULTIPLE RESULT FIELDS <--== NC1724.2 +100400 MOVE "DIV-TEST-F2-18" TO PAR-NAME. NC1724.2 +100500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +100600 MOVE 1 TO REC-CT. NC1724.2 +100700 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +100800 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +100900 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +101000 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +101100 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +101200 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +101300 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +101400 DIV-TEST-F2-18-0. NC1724.2 +101500 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +101600 GIVING WRK-DU-2V1-1 NC1724.2 +101700 WRK-DU-2V0-1 ROUNDED NC1724.2 +101800 WRK-DU-2V1-2 NC1724.2 +101900 WRK-DU-2V0-2 ROUNDED NC1724.2 +102000 WRK-DU-2V1-3 NC1724.2 +102100 WRK-DU-2V0-3. NC1724.2 +102200 GO TO DIV-TEST-F2-18-1. NC1724.2 +102300 DIV-DELETE-F2-18. NC1724.2 +102400 PERFORM DE-LETE. NC1724.2 +102500 PERFORM PRINT-DETAIL. NC1724.2 +102600 GO TO DIV-INIT-F2-19. NC1724.2 +102700 DIV-TEST-F2-18-1. NC1724.2 +102800 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +102900 PERFORM PASS NC1724.2 +103000 PERFORM PRINT-DETAIL NC1724.2 +103100 ELSE NC1724.2 +103200 PERFORM FAIL NC1724.2 +103300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +103400 MOVE 2.5 TO CORRECT-N NC1724.2 +103500 PERFORM PRINT-DETAIL. NC1724.2 +103600 ADD 1 TO REC-CT. NC1724.2 +103700 DIV-TEST-F2-18-2. NC1724.2 +103800 IF WRK-DU-2V0-1 = 3 NC1724.2 +103900 PERFORM PASS NC1724.2 +104000 PERFORM PRINT-DETAIL NC1724.2 +104100 ELSE NC1724.2 +104200 PERFORM FAIL NC1724.2 +104300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +104400 MOVE 3 TO CORRECT-N NC1724.2 +104500 PERFORM PRINT-DETAIL. NC1724.2 +104600 ADD 1 TO REC-CT. NC1724.2 +104700 DIV-TEST-F2-18-3. NC1724.2 +104800 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +104900 PERFORM PASS NC1724.2 +105000 PERFORM PRINT-DETAIL NC1724.2 +105100 ELSE NC1724.2 +105200 PERFORM FAIL NC1724.2 +105300 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +105400 MOVE 2.5 TO CORRECT-N NC1724.2 +105500 PERFORM PRINT-DETAIL. NC1724.2 +105600 ADD 1 TO REC-CT. NC1724.2 +105700 DIV-TEST-F2-18-4. NC1724.2 +105800 IF WRK-DU-2V0-2 = 3 NC1724.2 +105900 PERFORM PASS NC1724.2 +106000 PERFORM PRINT-DETAIL NC1724.2 +106100 ELSE NC1724.2 +106200 PERFORM FAIL NC1724.2 +106300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +106400 MOVE 3 TO CORRECT-N NC1724.2 +106500 PERFORM PRINT-DETAIL. NC1724.2 +106600 ADD 1 TO REC-CT. NC1724.2 +106700 DIV-TEST-F2-18-5. NC1724.2 +106800 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +106900 PERFORM PASS NC1724.2 +107000 PERFORM PRINT-DETAIL NC1724.2 +107100 ELSE NC1724.2 +107200 PERFORM FAIL NC1724.2 +107300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +107400 MOVE 2.5 TO CORRECT-N NC1724.2 +107500 PERFORM PRINT-DETAIL. NC1724.2 +107600 ADD 1 TO REC-CT. NC1724.2 +107700 DIV-TEST-F2-18-6. NC1724.2 +107800 IF WRK-DU-2V0-3 = 2 NC1724.2 +107900 PERFORM PASS NC1724.2 +108000 PERFORM PRINT-DETAIL NC1724.2 +108100 ELSE NC1724.2 +108200 PERFORM FAIL NC1724.2 +108300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +108400 MOVE 2 TO CORRECT-N NC1724.2 +108500 PERFORM PRINT-DETAIL. NC1724.2 +108600* NC1724.2 +108700* NC1724.2 +108800 DIV-INIT-F2-19. NC1724.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1724.2 +109000* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +109100 MOVE "DIV-TEST-F2-19" TO PAR-NAME. NC1724.2 +109200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +109300 MOVE "0" TO WRK-XN-00001. NC1724.2 +109400 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +109600 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +109700 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +109800 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +109900 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +110000 MOVE 1 TO REC-CT. NC1724.2 +110100 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +110200 MOVE .1 TO A01ONE-CS-00V01. NC1724.2 +110300 DIV-TEST-F2-19-0. NC1724.2 +110400 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +110500 GIVING WRK-DU-2V1-1 NC1724.2 +110600 WRK-DU-2V0-1 ROUNDED NC1724.2 +110700 WRK-DU-2V1-2 NC1724.2 +110800 WRK-DU-2V0-2 ROUNDED NC1724.2 +110900 WRK-DU-2V1-3 NC1724.2 +111000 WRK-DU-2V0-3 NC1724.2 +111100 ON SIZE ERROR NC1724.2 +111200 MOVE "1" TO WRK-XN-00001. NC1724.2 +111300 GO TO DIV-TEST-F2-19-1. NC1724.2 +111400 DIV-DELETE-F2-19. NC1724.2 +111500 PERFORM DE-LETE. NC1724.2 +111600 PERFORM PRINT-DETAIL. NC1724.2 +111700 GO TO DIV-INIT-F2-20. NC1724.2 +111800 DIV-TEST-F2-19-1. NC1724.2 +111900 IF WRK-DU-2V1-1 = 0 NC1724.2 +112000 PERFORM PASS NC1724.2 +112100 PERFORM PRINT-DETAIL NC1724.2 +112200 ELSE NC1724.2 +112300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +112400 PERFORM FAIL NC1724.2 +112500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +112600 MOVE 0 TO CORRECT-N NC1724.2 +112700 PERFORM PRINT-DETAIL. NC1724.2 +112800 ADD 1 TO REC-CT. NC1724.2 +112900 DIV-TEST-F2-19-2. NC1724.2 +113000 IF WRK-DU-2V0-1 = 99 NC1724.2 +113100 PERFORM PASS NC1724.2 +113200 PERFORM PRINT-DETAIL NC1724.2 +113300 ELSE NC1724.2 +113400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +113500 PERFORM FAIL NC1724.2 +113600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +113700 MOVE 99 TO CORRECT-N NC1724.2 +113800 PERFORM PRINT-DETAIL. NC1724.2 +113900 ADD 1 TO REC-CT. NC1724.2 +114000 DIV-TEST-F2-19-3. NC1724.2 +114100 IF WRK-DU-2V1-2 = 0 NC1724.2 +114200 PERFORM PASS NC1724.2 +114300 PERFORM PRINT-DETAIL NC1724.2 +114400 ELSE NC1724.2 +114500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +114600 PERFORM FAIL NC1724.2 +114700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +114800 MOVE 0 TO CORRECT-N NC1724.2 +114900 PERFORM PRINT-DETAIL. NC1724.2 +115000 ADD 1 TO REC-CT. NC1724.2 +115100 DIV-TEST-F2-19-4. NC1724.2 +115200 IF WRK-DU-2V0-2 = 0 NC1724.2 +115300 PERFORM PASS NC1724.2 +115400 PERFORM PRINT-DETAIL NC1724.2 +115500 ELSE NC1724.2 +115600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +115700 PERFORM FAIL NC1724.2 +115800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +115900 MOVE 0 TO CORRECT-N NC1724.2 +116000 PERFORM PRINT-DETAIL. NC1724.2 +116100 ADD 1 TO REC-CT. NC1724.2 +116200 DIV-TEST-F2-19-5. NC1724.2 +116300 IF WRK-DU-2V1-3 = 0 NC1724.2 +116400 PERFORM PASS NC1724.2 +116500 PERFORM PRINT-DETAIL NC1724.2 +116600 ELSE NC1724.2 +116700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +116800 PERFORM FAIL NC1724.2 +116900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +117000 MOVE 0 TO CORRECT-N NC1724.2 +117100 PERFORM PRINT-DETAIL. NC1724.2 +117200 ADD 1 TO REC-CT. NC1724.2 +117300 DIV-TEST-F2-19-6. NC1724.2 +117400 IF WRK-DU-2V0-3 = 0 NC1724.2 +117500 PERFORM PASS NC1724.2 +117600 PERFORM PRINT-DETAIL NC1724.2 +117700 ELSE NC1724.2 +117800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +117900 PERFORM FAIL NC1724.2 +118000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +118100 MOVE 0 TO CORRECT-N NC1724.2 +118200 PERFORM PRINT-DETAIL. NC1724.2 +118300 ADD 1 TO REC-CT. NC1724.2 +118400 DIV-TEST-F2-19-7. NC1724.2 +118500 IF WRK-XN-00001 = "1" NC1724.2 +118600 PERFORM PASS NC1724.2 +118700 PERFORM PRINT-DETAIL NC1724.2 +118800 ELSE NC1724.2 +118900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +119000 PERFORM FAIL NC1724.2 +119100 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +119200 MOVE "1" TO CORRECT-X NC1724.2 +119300 PERFORM PRINT-DETAIL. NC1724.2 +119400* NC1724.2 +119500* NC1724.2 +119600 DIV-INIT-F2-20. NC1724.2 +119700* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +119800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +119900 MOVE "DIV-TEST-F2-20" TO PAR-NAME. NC1724.2 +120000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +120100 MOVE "0" TO WRK-XN-00001. NC1724.2 +120200 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +120300 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +120400 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +120500 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +120600 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +120700 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +120800 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +120900 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +121000 MOVE 1 TO REC-CT. NC1724.2 +121100 DIV-TEST-F2-20-0. NC1724.2 +121200 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +121300 GIVING WRK-DU-2V1-1 NC1724.2 +121400 WRK-DU-2V0-1 ROUNDED NC1724.2 +121500 WRK-DU-2V1-2 NC1724.2 +121600 WRK-DU-2V0-2 ROUNDED NC1724.2 +121700 WRK-DU-2V1-3 NC1724.2 +121800 WRK-DU-2V0-3 NC1724.2 +121900 ON SIZE ERROR NC1724.2 +122000 MOVE "1" TO WRK-XN-00001. NC1724.2 +122100 GO TO DIV-TEST-F2-20-1. NC1724.2 +122200 DIV-DELETE-F2-20. NC1724.2 +122300 PERFORM DE-LETE. NC1724.2 +122400 PERFORM PRINT-DETAIL. NC1724.2 +122500 GO TO DIV-INIT-F2-21. NC1724.2 +122600 DIV-TEST-F2-20-1. NC1724.2 +122700 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +122800 PERFORM PASS NC1724.2 +122900 PERFORM PRINT-DETAIL NC1724.2 +123000 ELSE NC1724.2 +123100 PERFORM FAIL NC1724.2 +123200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +123300 MOVE 2.5 TO CORRECT-N NC1724.2 +123400 PERFORM PRINT-DETAIL. NC1724.2 +123500 ADD 1 TO REC-CT. NC1724.2 +123600 DIV-TEST-F2-20-2. NC1724.2 +123700 IF WRK-DU-2V0-1 = 3 NC1724.2 +123800 PERFORM PASS NC1724.2 +123900 PERFORM PRINT-DETAIL NC1724.2 +124000 ELSE NC1724.2 +124100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +124200 PERFORM FAIL NC1724.2 +124300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +124400 MOVE 3 TO CORRECT-N NC1724.2 +124500 PERFORM PRINT-DETAIL. NC1724.2 +124600 ADD 1 TO REC-CT. NC1724.2 +124700 DIV-TEST-F2-20-3. NC1724.2 +124800 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +124900 PERFORM PASS NC1724.2 +125000 PERFORM PRINT-DETAIL NC1724.2 +125100 ELSE NC1724.2 +125200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +125300 PERFORM FAIL NC1724.2 +125400 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +125500 MOVE 2.5 TO CORRECT-N NC1724.2 +125600 PERFORM PRINT-DETAIL. NC1724.2 +125700 ADD 1 TO REC-CT. NC1724.2 +125800 DIV-TEST-F2-20-4. NC1724.2 +125900 IF WRK-DU-2V0-2 = 3 NC1724.2 +126000 PERFORM PASS NC1724.2 +126100 PERFORM PRINT-DETAIL NC1724.2 +126200 ELSE NC1724.2 +126300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +126400 PERFORM FAIL NC1724.2 +126500 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +126600 MOVE 3 TO CORRECT-N NC1724.2 +126700 PERFORM PRINT-DETAIL. NC1724.2 +126800 ADD 1 TO REC-CT. NC1724.2 +126900 DIV-TEST-F2-20-5. NC1724.2 +127000 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +127100 PERFORM PASS NC1724.2 +127200 PERFORM PRINT-DETAIL NC1724.2 +127300 ELSE NC1724.2 +127400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +127500 PERFORM FAIL NC1724.2 +127600 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +127700 MOVE 2.5 TO CORRECT-N NC1724.2 +127800 PERFORM PRINT-DETAIL. NC1724.2 +127900 ADD 1 TO REC-CT. NC1724.2 +128000 DIV-TEST-F2-20-6. NC1724.2 +128100 IF WRK-DU-2V0-3 = 2 NC1724.2 +128200 PERFORM PASS NC1724.2 +128300 PERFORM PRINT-DETAIL NC1724.2 +128400 ELSE NC1724.2 +128500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +128600 PERFORM FAIL NC1724.2 +128700 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +128800 MOVE 2 TO CORRECT-N NC1724.2 +128900 PERFORM PRINT-DETAIL. NC1724.2 +129000 ADD 1 TO REC-CT. NC1724.2 +129100 DIV-TEST-F2-20-7. NC1724.2 +129200 IF WRK-XN-00001 = "0" NC1724.2 +129300 PERFORM PASS NC1724.2 +129400 PERFORM PRINT-DETAIL NC1724.2 +129500 ELSE NC1724.2 +129600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +129700 TO RE-MARK NC1724.2 +129800 PERFORM FAIL NC1724.2 +129900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +130000 MOVE "0" TO CORRECT-X NC1724.2 +130100 PERFORM PRINT-DETAIL. NC1724.2 +130200* NC1724.2 +130300* NC1724.2 +130400 DIV-INIT-F2-21. NC1724.2 +130500* ==--> SIZE ERROR CONDITION <--== NC1724.2 +130600* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +130700 MOVE "DIV-TEST-F2-21" TO PAR-NAME. NC1724.2 +130800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +130900 MOVE "0" TO WRK-XN-00001. NC1724.2 +131000 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +131100 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +131200 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +131300 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +131400 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +131500 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +131600 MOVE 1 TO REC-CT. NC1724.2 +131700 DIV-TEST-F2-21-0. NC1724.2 +131800 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +131900 GIVING WRK-DU-2V1-1 NC1724.2 +132000 WRK-DU-2V0-1 ROUNDED NC1724.2 +132100 WRK-DU-2V1-2 NC1724.2 +132200 WRK-DU-2V0-2 ROUNDED NC1724.2 +132300 WRK-DU-2V1-3 NC1724.2 +132400 WRK-DU-2V0-3 NC1724.2 +132500 NOT ON SIZE ERROR NC1724.2 +132600 MOVE "1" TO WRK-XN-00001. NC1724.2 +132700 GO TO DIV-TEST-F2-21-1. NC1724.2 +132800 DIV-DELETE-F2-21. NC1724.2 +132900 PERFORM DE-LETE. NC1724.2 +133000 PERFORM PRINT-DETAIL. NC1724.2 +133100 GO TO DIV-INIT-F2-22. NC1724.2 +133200 DIV-TEST-F2-21-1. NC1724.2 +133300 IF WRK-DU-2V1-1 = 0 NC1724.2 +133400 PERFORM PASS NC1724.2 +133500 PERFORM PRINT-DETAIL NC1724.2 +133600 ELSE NC1724.2 +133700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +133800 PERFORM FAIL NC1724.2 +133900 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +134000 MOVE 0 TO CORRECT-N NC1724.2 +134100 PERFORM PRINT-DETAIL. NC1724.2 +134200 ADD 1 TO REC-CT. NC1724.2 +134300 DIV-TEST-F2-21-2. NC1724.2 +134400 IF WRK-DU-2V0-1 = 99 NC1724.2 +134500 PERFORM PASS NC1724.2 +134600 PERFORM PRINT-DETAIL NC1724.2 +134700 ELSE NC1724.2 +134800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +134900 PERFORM FAIL NC1724.2 +135000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +135100 MOVE 99 TO CORRECT-N NC1724.2 +135200 PERFORM PRINT-DETAIL. NC1724.2 +135300 ADD 1 TO REC-CT. NC1724.2 +135400 DIV-TEST-F2-21-3. NC1724.2 +135500 IF WRK-DU-2V1-2 = 0 NC1724.2 +135600 PERFORM PASS NC1724.2 +135700 PERFORM PRINT-DETAIL NC1724.2 +135800 ELSE NC1724.2 +135900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +136000 PERFORM FAIL NC1724.2 +136100 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +136200 MOVE 0 TO CORRECT-N NC1724.2 +136300 PERFORM PRINT-DETAIL. NC1724.2 +136400 ADD 1 TO REC-CT. NC1724.2 +136500 DIV-TEST-F2-21-4. NC1724.2 +136600 IF WRK-DU-2V0-2 = 0 NC1724.2 +136700 PERFORM PASS NC1724.2 +136800 PERFORM PRINT-DETAIL NC1724.2 +136900 ELSE NC1724.2 +137000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +137100 PERFORM FAIL NC1724.2 +137200 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +137300 MOVE 0 TO CORRECT-N NC1724.2 +137400 PERFORM PRINT-DETAIL. NC1724.2 +137500 ADD 1 TO REC-CT. NC1724.2 +137600 DIV-TEST-F2-21-5. NC1724.2 +137700 IF WRK-DU-2V1-3 = 0 NC1724.2 +137800 PERFORM PASS NC1724.2 +137900 PERFORM PRINT-DETAIL NC1724.2 +138000 ELSE NC1724.2 +138100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +138200 PERFORM FAIL NC1724.2 +138300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +138400 MOVE 0 TO CORRECT-N NC1724.2 +138500 PERFORM PRINT-DETAIL. NC1724.2 +138600 ADD 1 TO REC-CT. NC1724.2 +138700 DIV-TEST-F2-21-6. NC1724.2 +138800 IF WRK-DU-2V0-3 = 0 NC1724.2 +138900 PERFORM PASS NC1724.2 +139000 PERFORM PRINT-DETAIL NC1724.2 +139100 ELSE NC1724.2 +139200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +139300 PERFORM FAIL NC1724.2 +139400 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +139500 MOVE 0 TO CORRECT-N NC1724.2 +139600 PERFORM PRINT-DETAIL. NC1724.2 +139700 ADD 1 TO REC-CT. NC1724.2 +139800 DIV-TEST-F2-21-7. NC1724.2 +139900 IF WRK-XN-00001 = "0" NC1724.2 +140000 PERFORM PASS NC1724.2 +140100 PERFORM PRINT-DETAIL NC1724.2 +140200 ELSE NC1724.2 +140300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +140400 TO RE-MARK NC1724.2 +140500 PERFORM FAIL NC1724.2 +140600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +140700 MOVE "0" TO CORRECT-X NC1724.2 +140800 PERFORM PRINT-DETAIL. NC1724.2 +140900* NC1724.2 +141000* NC1724.2 +141100 DIV-INIT-F2-22. NC1724.2 +141200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +141300* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +141400 MOVE "DIV-TEST-F2-22" TO PAR-NAME. NC1724.2 +141500 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +141600 MOVE "0" TO WRK-XN-00001. NC1724.2 +141700 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +141800 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +141900 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +142000 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +142100 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +142200 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +142300 MOVE 1 TO REC-CT. NC1724.2 +142400 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +142500 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +142600 DIV-TEST-F2-22-0. NC1724.2 +142700 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +142800 GIVING WRK-DU-2V1-1 NC1724.2 +142900 WRK-DU-2V0-1 ROUNDED NC1724.2 +143000 WRK-DU-2V1-2 NC1724.2 +143100 WRK-DU-2V0-2 ROUNDED NC1724.2 +143200 WRK-DU-2V1-3 NC1724.2 +143300 WRK-DU-2V0-3 NC1724.2 +143400 NOT ON SIZE ERROR NC1724.2 +143500 MOVE "1" TO WRK-XN-00001. NC1724.2 +143600 GO TO DIV-TEST-F2-22-1. NC1724.2 +143700 DIV-DELETE-F2-22. NC1724.2 +143800 PERFORM DE-LETE. NC1724.2 +143900 PERFORM PRINT-DETAIL. NC1724.2 +144000 GO TO DIV-INIT-F2-23. NC1724.2 +144100 DIV-TEST-F2-22-1. NC1724.2 +144200 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +144300 PERFORM PASS NC1724.2 +144400 PERFORM PRINT-DETAIL NC1724.2 +144500 ELSE NC1724.2 +144600 PERFORM FAIL NC1724.2 +144700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +144800 MOVE 2.5 TO CORRECT-N NC1724.2 +144900 PERFORM PRINT-DETAIL. NC1724.2 +145000 ADD 1 TO REC-CT. NC1724.2 +145100 DIV-TEST-F2-22-2. NC1724.2 +145200 IF WRK-DU-2V0-1 = 3 NC1724.2 +145300 PERFORM PASS NC1724.2 +145400 PERFORM PRINT-DETAIL NC1724.2 +145500 ELSE NC1724.2 +145600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +145700 PERFORM FAIL NC1724.2 +145800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +145900 MOVE 3 TO CORRECT-N NC1724.2 +146000 PERFORM PRINT-DETAIL. NC1724.2 +146100 ADD 1 TO REC-CT. NC1724.2 +146200 DIV-TEST-F2-22-3. NC1724.2 +146300 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +146400 PERFORM PASS NC1724.2 +146500 PERFORM PRINT-DETAIL NC1724.2 +146600 ELSE NC1724.2 +146700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +146800 PERFORM FAIL NC1724.2 +146900 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +147000 MOVE 2.5 TO CORRECT-N NC1724.2 +147100 PERFORM PRINT-DETAIL. NC1724.2 +147200 ADD 1 TO REC-CT. NC1724.2 +147300 DIV-TEST-F2-22-4. NC1724.2 +147400 IF WRK-DU-2V0-2 = 3 NC1724.2 +147500 PERFORM PASS NC1724.2 +147600 PERFORM PRINT-DETAIL NC1724.2 +147700 ELSE NC1724.2 +147800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +147900 PERFORM FAIL NC1724.2 +148000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +148100 MOVE 3 TO CORRECT-N NC1724.2 +148200 PERFORM PRINT-DETAIL. NC1724.2 +148300 ADD 1 TO REC-CT. NC1724.2 +148400 DIV-TEST-F2-22-5. NC1724.2 +148500 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +148600 PERFORM PASS NC1724.2 +148700 PERFORM PRINT-DETAIL NC1724.2 +148800 ELSE NC1724.2 +148900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +149000 PERFORM FAIL NC1724.2 +149100 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +149200 MOVE 2.5 TO CORRECT-N NC1724.2 +149300 PERFORM PRINT-DETAIL. NC1724.2 +149400 ADD 1 TO REC-CT. NC1724.2 +149500 DIV-TEST-F2-22-6. NC1724.2 +149600 IF WRK-DU-2V0-3 = 2 NC1724.2 +149700 PERFORM PASS NC1724.2 +149800 PERFORM PRINT-DETAIL NC1724.2 +149900 ELSE NC1724.2 +150000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +150100 PERFORM FAIL NC1724.2 +150200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +150300 MOVE 2 TO CORRECT-N NC1724.2 +150400 PERFORM PRINT-DETAIL. NC1724.2 +150500 ADD 1 TO REC-CT. NC1724.2 +150600 DIV-TEST-F2-22-7. NC1724.2 +150700 IF WRK-XN-00001 = "1" NC1724.2 +150800 PERFORM PASS NC1724.2 +150900 PERFORM PRINT-DETAIL NC1724.2 +151000 ELSE NC1724.2 +151100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +151200 TO RE-MARK NC1724.2 +151300 PERFORM FAIL NC1724.2 +151400 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +151500 MOVE "0" TO CORRECT-X NC1724.2 +151600 PERFORM PRINT-DETAIL. NC1724.2 +151700* NC1724.2 +151800* NC1724.2 +151900 DIV-INIT-F2-23. NC1724.2 +152000* ==--> SIZE ERROR CONDITION <--== NC1724.2 +152100* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +152200 MOVE "DIV-TEST-F2-23" TO PAR-NAME. NC1724.2 +152300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +152400 MOVE "0" TO WRK-XN-00001. NC1724.2 +152500 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +152600 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +152700 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +152800 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +152900 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +153000 MOVE 1 TO REC-CT. NC1724.2 +153100 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +153200 MOVE .1 TO A01ONE-CS-00V01. NC1724.2 +153300 DIV-TEST-F2-23-0. NC1724.2 +153400 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +153500 GIVING WRK-DU-2V1-1 NC1724.2 +153600 WRK-DU-2V0-1 ROUNDED NC1724.2 +153700 WRK-DU-2V1-2 NC1724.2 +153800 WRK-DU-2V0-2 ROUNDED NC1724.2 +153900 WRK-DU-2V1-3 NC1724.2 +154000 WRK-DU-2V0-3 NC1724.2 +154100 ON SIZE ERROR NC1724.2 +154200 MOVE "1" TO WRK-XN-00001 NC1724.2 +154300 NOT ON SIZE ERROR NC1724.2 +154400 MOVE "2" TO WRK-XN-00001. NC1724.2 +154500 GO TO DIV-TEST-F2-23-1. NC1724.2 +154600 DIV-DELETE-F2-23. NC1724.2 +154700 PERFORM DE-LETE. NC1724.2 +154800 PERFORM PRINT-DETAIL. NC1724.2 +154900 GO TO DIV-INIT-F2-24. NC1724.2 +155000 DIV-TEST-F2-23-1. NC1724.2 +155100 IF WRK-DU-2V1-1 = 0 NC1724.2 +155200 PERFORM PASS NC1724.2 +155300 PERFORM PRINT-DETAIL NC1724.2 +155400 ELSE NC1724.2 +155500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +155600 PERFORM FAIL NC1724.2 +155700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +155800 MOVE 0 TO CORRECT-N NC1724.2 +155900 PERFORM PRINT-DETAIL. NC1724.2 +156000 ADD 1 TO REC-CT. NC1724.2 +156100 DIV-TEST-F2-23-2. NC1724.2 +156200 IF WRK-DU-2V0-1 = 99 NC1724.2 +156300 PERFORM PASS NC1724.2 +156400 PERFORM PRINT-DETAIL NC1724.2 +156500 ELSE NC1724.2 +156600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +156700 PERFORM FAIL NC1724.2 +156800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +156900 MOVE 99 TO CORRECT-N NC1724.2 +157000 PERFORM PRINT-DETAIL. NC1724.2 +157100 ADD 1 TO REC-CT. NC1724.2 +157200 DIV-TEST-F2-23-3. NC1724.2 +157300 IF WRK-DU-2V1-2 = 0 NC1724.2 +157400 PERFORM PASS NC1724.2 +157500 PERFORM PRINT-DETAIL NC1724.2 +157600 ELSE NC1724.2 +157700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +157800 PERFORM FAIL NC1724.2 +157900 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +158000 MOVE 0 TO CORRECT-N NC1724.2 +158100 PERFORM PRINT-DETAIL. NC1724.2 +158200 ADD 1 TO REC-CT. NC1724.2 +158300 DIV-TEST-F2-23-4. NC1724.2 +158400 IF WRK-DU-2V0-2 = 0 NC1724.2 +158500 PERFORM PASS NC1724.2 +158600 PERFORM PRINT-DETAIL NC1724.2 +158700 ELSE NC1724.2 +158800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +158900 PERFORM FAIL NC1724.2 +159000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +159100 MOVE 0 TO CORRECT-N NC1724.2 +159200 PERFORM PRINT-DETAIL. NC1724.2 +159300 ADD 1 TO REC-CT. NC1724.2 +159400 DIV-TEST-F2-23-5. NC1724.2 +159500 IF WRK-DU-2V1-3 = 0 NC1724.2 +159600 PERFORM PASS NC1724.2 +159700 PERFORM PRINT-DETAIL NC1724.2 +159800 ELSE NC1724.2 +159900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +160000 PERFORM FAIL NC1724.2 +160100 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +160200 MOVE 0 TO CORRECT-N NC1724.2 +160300 PERFORM PRINT-DETAIL. NC1724.2 +160400 ADD 1 TO REC-CT. NC1724.2 +160500 DIV-TEST-F2-23-6. NC1724.2 +160600 IF WRK-DU-2V0-3 = 0 NC1724.2 +160700 PERFORM PASS NC1724.2 +160800 PERFORM PRINT-DETAIL NC1724.2 +160900 ELSE NC1724.2 +161000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +161100 PERFORM FAIL NC1724.2 +161200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +161300 MOVE 0 TO CORRECT-N NC1724.2 +161400 PERFORM PRINT-DETAIL. NC1724.2 +161500 ADD 1 TO REC-CT. NC1724.2 +161600 DIV-TEST-F2-23-7. NC1724.2 +161700 IF WRK-XN-00001 = "1" NC1724.2 +161800 PERFORM PASS NC1724.2 +161900 PERFORM PRINT-DETAIL NC1724.2 +162000 ELSE NC1724.2 +162100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +162200 TO RE-MARK NC1724.2 +162300 PERFORM FAIL NC1724.2 +162400 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +162500 MOVE "0" TO CORRECT-X NC1724.2 +162600 PERFORM PRINT-DETAIL. NC1724.2 +162700* NC1724.2 +162800* NC1724.2 +162900 DIV-INIT-F2-24. NC1724.2 +163000* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +163100* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +163200 MOVE "DIV-TEST-F2-24" TO PAR-NAME. NC1724.2 +163300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +163400 MOVE "0" TO WRK-XN-00001. NC1724.2 +163500 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +163600 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +163700 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +163800 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +163900 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +164000 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +164100 MOVE 1 TO REC-CT. NC1724.2 +164200 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +164300 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +164400 DIV-TEST-F2-24-0. NC1724.2 +164500 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +164600 GIVING WRK-DU-2V1-1 NC1724.2 +164700 WRK-DU-2V0-1 ROUNDED NC1724.2 +164800 WRK-DU-2V1-2 NC1724.2 +164900 WRK-DU-2V0-2 ROUNDED NC1724.2 +165000 WRK-DU-2V1-3 NC1724.2 +165100 WRK-DU-2V0-3 NC1724.2 +165200 ON SIZE ERROR NC1724.2 +165300 MOVE "1" TO WRK-XN-00001 NC1724.2 +165400 NOT ON SIZE ERROR NC1724.2 +165500 MOVE "2" TO WRK-XN-00001. NC1724.2 +165600 GO TO DIV-TEST-F2-24-1. NC1724.2 +165700 DIV-DELETE-F2-24. NC1724.2 +165800 PERFORM DE-LETE. NC1724.2 +165900 PERFORM PRINT-DETAIL. NC1724.2 +166000 GO TO DIV-INIT-F2-25. NC1724.2 +166100 DIV-TEST-F2-24-1. NC1724.2 +166200 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +166300 PERFORM PASS NC1724.2 +166400 PERFORM PRINT-DETAIL NC1724.2 +166500 ELSE NC1724.2 +166600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +166700 PERFORM FAIL NC1724.2 +166800 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +166900 MOVE 2.5 TO CORRECT-N NC1724.2 +167000 PERFORM PRINT-DETAIL. NC1724.2 +167100 ADD 1 TO REC-CT. NC1724.2 +167200 DIV-TEST-F2-24-2. NC1724.2 +167300 IF WRK-DU-2V0-1 = 3 NC1724.2 +167400 PERFORM PASS NC1724.2 +167500 PERFORM PRINT-DETAIL NC1724.2 +167600 ELSE NC1724.2 +167700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +167800 PERFORM FAIL NC1724.2 +167900 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +168000 MOVE 3 TO CORRECT-N NC1724.2 +168100 PERFORM PRINT-DETAIL. NC1724.2 +168200 ADD 1 TO REC-CT. NC1724.2 +168300 DIV-TEST-F2-24-3. NC1724.2 +168400 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +168500 PERFORM PASS NC1724.2 +168600 PERFORM PRINT-DETAIL NC1724.2 +168700 ELSE NC1724.2 +168800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +168900 PERFORM FAIL NC1724.2 +169000 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +169100 MOVE 2.5 TO CORRECT-N NC1724.2 +169200 PERFORM PRINT-DETAIL. NC1724.2 +169300 ADD 1 TO REC-CT. NC1724.2 +169400 DIV-TEST-F2-24-4. NC1724.2 +169500 IF WRK-DU-2V0-2 = 3 NC1724.2 +169600 PERFORM PASS NC1724.2 +169700 PERFORM PRINT-DETAIL NC1724.2 +169800 ELSE NC1724.2 +169900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +170000 PERFORM FAIL NC1724.2 +170100 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +170200 MOVE 3 TO CORRECT-N NC1724.2 +170300 PERFORM PRINT-DETAIL. NC1724.2 +170400 ADD 1 TO REC-CT. NC1724.2 +170500 DIV-TEST-F2-24-5. NC1724.2 +170600 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +170700 PERFORM PASS NC1724.2 +170800 PERFORM PRINT-DETAIL NC1724.2 +170900 ELSE NC1724.2 +171000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +171100 PERFORM FAIL NC1724.2 +171200 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +171300 MOVE 2.5 TO CORRECT-N NC1724.2 +171400 PERFORM PRINT-DETAIL. NC1724.2 +171500 ADD 1 TO REC-CT. NC1724.2 +171600 DIV-TEST-F2-24-6. NC1724.2 +171700 IF WRK-DU-2V0-3 = 2 NC1724.2 +171800 PERFORM PASS NC1724.2 +171900 PERFORM PRINT-DETAIL NC1724.2 +172000 ELSE NC1724.2 +172100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +172200 PERFORM FAIL NC1724.2 +172300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +172400 MOVE 2 TO CORRECT-N NC1724.2 +172500 PERFORM PRINT-DETAIL. NC1724.2 +172600 ADD 1 TO REC-CT. NC1724.2 +172700 DIV-TEST-F2-24-7. NC1724.2 +172800 IF WRK-XN-00001 = "2" NC1724.2 +172900 PERFORM PASS NC1724.2 +173000 PERFORM PRINT-DETAIL NC1724.2 +173100 ELSE NC1724.2 +173200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +173300 TO RE-MARK NC1724.2 +173400 PERFORM FAIL NC1724.2 +173500 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +173600 MOVE "2" TO CORRECT-X NC1724.2 +173700 PERFORM PRINT-DETAIL. NC1724.2 +173800* NC1724.2 +173900* NC1724.2 +174000 DIV-INIT-F2-25. NC1724.2 +174100* ==--> SIZE ERROR CONDITION <--== NC1724.2 +174200* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +174300 MOVE "DIV-TEST-F2-25" TO PAR-NAME. NC1724.2 +174400 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1724.2 +174500 MOVE "0" TO WRK-XN-00001. NC1724.2 +174600 MOVE 0 TO WRK-DS-05V00. NC1724.2 +174700 MOVE 0 TO WRK-DS-02V00. NC1724.2 +174800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +174900 MOVE 0 TO DIV10. NC1724.2 +175000 MOVE 1 TO REC-CT. NC1724.2 +175100 MOVE 44.1 TO DIV2. NC1724.2 +175200 MOVE -9.642 TO DIV4. NC1724.2 +175300 DIV-TEST-F2-25-0. NC1724.2 +175400 DIVIDE DIV4 INTO DIV2 NC1724.2 +175500 GIVING DIV10 NC1724.2 +175600 ON SIZE ERROR NC1724.2 +175700 MOVE "1" TO WRK-XN-00001 NC1724.2 +175800 MOVE 23 TO WRK-DS-05V00 NC1724.2 +175900 MOVE -4 TO WRK-DS-02V00 NC1724.2 +176000 END-DIVIDE NC1724.2 +176100 MOVE 99 TO WRK-CS-18V00. NC1724.2 +176200 GO TO DIV-TEST-F2-25-1. NC1724.2 +176300 DIV-DELETE-F2-25-1. NC1724.2 +176400 PERFORM DE-LETE. NC1724.2 +176500 PERFORM PRINT-DETAIL. NC1724.2 +176600 GO TO DIV-INIT-F2-26. NC1724.2 +176700 DIV-TEST-F2-25-1. NC1724.2 +176800 MOVE "DIV-TEST-F2-25-1" TO PAR-NAME. NC1724.2 +176900 IF WRK-XN-00001 = "1" NC1724.2 +177000 PERFORM PASS NC1724.2 +177100 PERFORM PRINT-DETAIL NC1724.2 +177200 ELSE NC1724.2 +177300 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +177400 MOVE "1" TO CORRECT-X NC1724.2 +177500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +177600 PERFORM FAIL NC1724.2 +177700 PERFORM PRINT-DETAIL. NC1724.2 +177800 ADD 1 TO REC-CT. NC1724.2 +177900 DIV-TEST-F2-25-2. NC1724.2 +178000 MOVE "DIV-TEST-F2-25-2" TO PAR-NAME. NC1724.2 +178100 IF WRK-DS-02V00 = -4 NC1724.2 +178200 PERFORM PASS NC1724.2 +178300 PERFORM PRINT-DETAIL NC1724.2 +178400 ELSE NC1724.2 +178500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +178600 MOVE -4 TO CORRECT-N NC1724.2 +178700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +178800 PERFORM FAIL NC1724.2 +178900 PERFORM PRINT-DETAIL. NC1724.2 +179000 ADD 1 TO REC-CT. NC1724.2 +179100 DIV-TEST-F2-25-3. NC1724.2 +179200 MOVE "DIV-TEST-F2-25-3" TO PAR-NAME. NC1724.2 +179300 IF WRK-DS-05V00 = 23 NC1724.2 +179400 PERFORM PASS NC1724.2 +179500 PERFORM PRINT-DETAIL NC1724.2 +179600 ELSE NC1724.2 +179700 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +179800 MOVE 23 TO CORRECT-N NC1724.2 +179900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +180000 PERFORM FAIL NC1724.2 +180100 PERFORM PRINT-DETAIL. NC1724.2 +180200 ADD 1 TO REC-CT. NC1724.2 +180300 DIV-TEST-F2-25-4. NC1724.2 +180400 MOVE "DIV-TEST-F2-25-4" TO PAR-NAME. NC1724.2 +180500 IF DIV10 = 0 NC1724.2 +180600 PERFORM PASS NC1724.2 +180700 PERFORM PRINT-DETAIL NC1724.2 +180800 ELSE NC1724.2 +180900 MOVE DIV10 TO COMPUTED-N NC1724.2 +181000 MOVE 0 TO CORRECT-N NC1724.2 +181100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +181200 PERFORM FAIL NC1724.2 +181300 PERFORM PRINT-DETAIL. NC1724.2 +181400 ADD 1 TO REC-CT. NC1724.2 +181500 DIV-TEST-F2-25-5. NC1724.2 +181600 MOVE "DIV-TEST-F2-25-5" TO PAR-NAME. NC1724.2 +181700 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +181800 PERFORM PASS NC1724.2 +181900 PERFORM PRINT-DETAIL NC1724.2 +182000 ELSE NC1724.2 +182100 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +182200 MOVE 99 TO CORRECT-N NC1724.2 +182300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +182400 PERFORM FAIL NC1724.2 +182500 PERFORM PRINT-DETAIL. NC1724.2 +182600* NC1724.2 +182700* NC1724.2 +182800 DIV-INIT-F2-26. NC1724.2 +182900* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +183000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +183100 MOVE "DIV-TEST-F2-26" TO PAR-NAME. NC1724.2 +183200 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1724.2 +183300 MOVE 1 TO REC-CT. NC1724.2 +183400 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +183500 MOVE 0 TO WRK-DS-05V00. NC1724.2 +183600 MOVE 0 TO WRK-DS-02V00. NC1724.2 +183700 MOVE "0" TO WRK-XN-00001. NC1724.2 +183800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +183900 DIV-TEST-F2-26-0. NC1724.2 +184000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +184100 GIVING WRK-DS-09V09 NC1724.2 +184200 ON SIZE ERROR NC1724.2 +184300 MOVE "1" TO WRK-XN-00001 NC1724.2 +184400 MOVE 23 TO WRK-DS-05V00 NC1724.2 +184500 MOVE -4 TO WRK-DS-02V00 NC1724.2 +184600 END-DIVIDE NC1724.2 +184700 MOVE 99 TO WRK-CS-18V00. NC1724.2 +184800 GO TO DIV-TEST-F2-26-1. NC1724.2 +184900 DIV-DELETE-F2-26-1. NC1724.2 +185000 PERFORM DE-LETE. NC1724.2 +185100 PERFORM PRINT-DETAIL. NC1724.2 +185200 GO TO DIV-INIT-F2-27. NC1724.2 +185300 DIV-TEST-F2-26-1. NC1724.2 +185400 MOVE "DIV-TEST-F2-26-1" TO PAR-NAME. NC1724.2 +185500 IF WRK-XN-00001 = "0" NC1724.2 +185600 PERFORM PASS NC1724.2 +185700 PERFORM PRINT-DETAIL NC1724.2 +185800 ELSE NC1724.2 +185900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +186000 MOVE "0" TO CORRECT-X NC1724.2 +186100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +186200 TO RE-MARK NC1724.2 +186300 PERFORM FAIL NC1724.2 +186400 PERFORM PRINT-DETAIL. NC1724.2 +186500 ADD 1 TO REC-CT. NC1724.2 +186600 DIV-TEST-F2-26-2. NC1724.2 +186700 MOVE "DIV-TEST-F2-26-2" TO PAR-NAME. NC1724.2 +186800 IF WRK-DS-02V00 = 0 NC1724.2 +186900 PERFORM PASS NC1724.2 +187000 PERFORM PRINT-DETAIL NC1724.2 +187100 ELSE NC1724.2 +187200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +187300 MOVE 0 TO CORRECT-N NC1724.2 +187400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +187500 TO RE-MARK NC1724.2 +187600 PERFORM FAIL NC1724.2 +187700 PERFORM PRINT-DETAIL. NC1724.2 +187800 ADD 1 TO REC-CT. NC1724.2 +187900 DIV-TEST-F2-26-3. NC1724.2 +188000 MOVE "DIV-TEST-F2-26-3" TO PAR-NAME. NC1724.2 +188100 IF WRK-DS-05V00 = 0 NC1724.2 +188200 PERFORM PASS NC1724.2 +188300 PERFORM PRINT-DETAIL NC1724.2 +188400 ELSE NC1724.2 +188500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +188600 MOVE 0 TO CORRECT-N NC1724.2 +188700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +188800 TO RE-MARK NC1724.2 +188900 PERFORM FAIL NC1724.2 +189000 PERFORM PRINT-DETAIL. NC1724.2 +189100 ADD 1 TO REC-CT. NC1724.2 +189200 DIV-TEST-F2-26-4. NC1724.2 +189300 MOVE "DIV-TEST-F2-26-4" TO PAR-NAME. NC1724.2 +189400 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +189500 PERFORM PASS NC1724.2 +189600 PERFORM PRINT-DETAIL NC1724.2 +189700 ELSE NC1724.2 +189800 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +189900 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +190000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +190100 PERFORM FAIL NC1724.2 +190200 PERFORM PRINT-DETAIL. NC1724.2 +190300 ADD 1 TO REC-CT. NC1724.2 +190400 DIV-TEST-F2-26-5. NC1724.2 +190500 MOVE "DIV-TEST-F2-26-5" TO PAR-NAME. NC1724.2 +190600 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +190700 PERFORM PASS NC1724.2 +190800 PERFORM PRINT-DETAIL NC1724.2 +190900 ELSE NC1724.2 +191000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +191100 MOVE 99 TO CORRECT-N NC1724.2 +191200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +191300 PERFORM FAIL NC1724.2 +191400 PERFORM PRINT-DETAIL. NC1724.2 +191500* NC1724.2 +191600* NC1724.2 +191700 DIV-INIT-F2-27. NC1724.2 +191800 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1724.2 +191900* ==--> SIZE ERROR CONDITION <--== NC1724.2 +192000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +192100 MOVE 0 TO WRK-CS-18V00. NC1724.2 +192200 MOVE "0" TO WRK-XN-00001. NC1724.2 +192300 MOVE 0 TO WRK-DS-05V00. NC1724.2 +192400 MOVE 0 TO WRK-DS-02V00. NC1724.2 +192500 MOVE 0 TO DIV10. NC1724.2 +192600 MOVE 1 TO REC-CT. NC1724.2 +192700 MOVE 44.1 TO DIV2. NC1724.2 +192800 MOVE -9.642 TO DIV4. NC1724.2 +192900 DIV-TEST-F2-27-0. NC1724.2 +193000 DIVIDE DIV4 INTO DIV2 NC1724.2 +193100 GIVING DIV10 NC1724.2 +193200 NOT ON SIZE ERROR NC1724.2 +193300 MOVE "1" TO WRK-XN-00001 NC1724.2 +193400 MOVE 23 TO WRK-DS-05V00 NC1724.2 +193500 MOVE -4 TO WRK-DS-02V00 NC1724.2 +193600 END-DIVIDE NC1724.2 +193700 MOVE 99 TO WRK-CS-18V00. NC1724.2 +193800 GO TO DIV-TEST-F2-27-1. NC1724.2 +193900 DIV-DELETE-F2-27-1. NC1724.2 +194000 PERFORM DE-LETE. NC1724.2 +194100 PERFORM PRINT-DETAIL. NC1724.2 +194200 GO TO DIV-INIT-F2-28. NC1724.2 +194300 DIV-TEST-F2-27-1. NC1724.2 +194400 MOVE "DIV-TEST-F2-27-1" TO PAR-NAME. NC1724.2 +194500 IF WRK-XN-00001 = "0" NC1724.2 +194600 PERFORM PASS NC1724.2 +194700 PERFORM PRINT-DETAIL NC1724.2 +194800 ELSE NC1724.2 +194900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +195000 MOVE "0" TO CORRECT-X NC1724.2 +195100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +195200 TO RE-MARK NC1724.2 +195300 PERFORM FAIL NC1724.2 +195400 PERFORM PRINT-DETAIL. NC1724.2 +195500 ADD 1 TO REC-CT. NC1724.2 +195600 DIV-TEST-F2-27-2. NC1724.2 +195700 MOVE "DIV-TEST-F2-27-2" TO PAR-NAME. NC1724.2 +195800 IF WRK-DS-02V00 = 0 NC1724.2 +195900 PERFORM PASS NC1724.2 +196000 PERFORM PRINT-DETAIL NC1724.2 +196100 ELSE NC1724.2 +196200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +196300 MOVE 0 TO CORRECT-N NC1724.2 +196400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +196500 TO RE-MARK NC1724.2 +196600 PERFORM FAIL NC1724.2 +196700 PERFORM PRINT-DETAIL. NC1724.2 +196800 ADD 1 TO REC-CT. NC1724.2 +196900 DIV-TEST-F2-27-3. NC1724.2 +197000 MOVE "DIV-TEST-F2-27-3" TO PAR-NAME. NC1724.2 +197100 IF WRK-DS-05V00 = 0 NC1724.2 +197200 PERFORM PASS NC1724.2 +197300 PERFORM PRINT-DETAIL NC1724.2 +197400 ELSE NC1724.2 +197500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +197600 MOVE 0 TO CORRECT-N NC1724.2 +197700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +197800 TO RE-MARK NC1724.2 +197900 PERFORM FAIL NC1724.2 +198000 PERFORM PRINT-DETAIL. NC1724.2 +198100 ADD 1 TO REC-CT. NC1724.2 +198200 DIV-TEST-F2-27-4. NC1724.2 +198300 MOVE "DIV-TEST-F2-27-4" TO PAR-NAME. NC1724.2 +198400 IF DIV10 = 0 NC1724.2 +198500 PERFORM PASS NC1724.2 +198600 PERFORM PRINT-DETAIL NC1724.2 +198700 ELSE NC1724.2 +198800 MOVE DIV10 TO COMPUTED-N NC1724.2 +198900 MOVE 0 TO CORRECT-N NC1724.2 +199000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +199100 PERFORM FAIL NC1724.2 +199200 PERFORM PRINT-DETAIL. NC1724.2 +199300 ADD 1 TO REC-CT. NC1724.2 +199400 DIV-TEST-F2-27-5. NC1724.2 +199500 MOVE "DIV-TEST-F2-27-5" TO PAR-NAME. NC1724.2 +199600 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +199700 PERFORM PASS NC1724.2 +199800 PERFORM PRINT-DETAIL NC1724.2 +199900 ELSE NC1724.2 +200000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +200100 MOVE 99 TO CORRECT-N NC1724.2 +200200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +200300 PERFORM FAIL NC1724.2 +200400 PERFORM PRINT-DETAIL. NC1724.2 +200500* NC1724.2 +200600* NC1724.2 +200700 DIV-INIT-F2-28. NC1724.2 +200800* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +200900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +201000 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +201100 MOVE 1 TO REC-CT. NC1724.2 +201200 MOVE 0 TO WRK-DS-05V00. NC1724.2 +201300 MOVE 0 TO WRK-DS-02V00. NC1724.2 +201400 MOVE "0" TO WRK-XN-00001. NC1724.2 +201500 MOVE 0 TO WRK-CS-18V00. NC1724.2 +201600 DIV-TEST-F2-28-0. NC1724.2 +201700 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +201800 GIVING WRK-DS-09V09 NC1724.2 +201900 NOT ON SIZE ERROR NC1724.2 +202000 MOVE "1" TO WRK-XN-00001 NC1724.2 +202100 MOVE 23 TO WRK-DS-05V00 NC1724.2 +202200 MOVE -4 TO WRK-DS-02V00 NC1724.2 +202300 END-DIVIDE NC1724.2 +202400 MOVE 99 TO WRK-CS-18V00. NC1724.2 +202500 GO TO DIV-TEST-F2-28-1. NC1724.2 +202600 DIV-DELETE-F2-28-1. NC1724.2 +202700 PERFORM DE-LETE. NC1724.2 +202800 PERFORM PRINT-DETAIL. NC1724.2 +202900 GO TO DIV-INIT-F2-29. NC1724.2 +203000 DIV-TEST-F2-28-1. NC1724.2 +203100 MOVE "DIV-TEST-F2-28-1" TO PAR-NAME. NC1724.2 +203200 IF WRK-XN-00001 = "1" NC1724.2 +203300 PERFORM PASS NC1724.2 +203400 PERFORM PRINT-DETAIL NC1724.2 +203500 ELSE NC1724.2 +203600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +203700 MOVE "1" TO CORRECT-X NC1724.2 +203800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +203900 TO RE-MARK NC1724.2 +204000 PERFORM FAIL NC1724.2 +204100 PERFORM PRINT-DETAIL. NC1724.2 +204200 ADD 1 TO REC-CT. NC1724.2 +204300 DIV-TEST-F2-28-2. NC1724.2 +204400 MOVE "DIV-TEST-F2-28-2" TO PAR-NAME. NC1724.2 +204500 IF WRK-DS-02V00 = -4 NC1724.2 +204600 PERFORM PASS NC1724.2 +204700 PERFORM PRINT-DETAIL NC1724.2 +204800 ELSE NC1724.2 +204900 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +205000 MOVE -4 TO CORRECT-N NC1724.2 +205100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +205200 TO RE-MARK NC1724.2 +205300 PERFORM FAIL NC1724.2 +205400 PERFORM PRINT-DETAIL. NC1724.2 +205500 ADD 1 TO REC-CT. NC1724.2 +205600 DIV-TEST-F2-28-3. NC1724.2 +205700 MOVE "DIV-TEST-F2-28-3" TO PAR-NAME. NC1724.2 +205800 IF WRK-DS-05V00 = 23 NC1724.2 +205900 PERFORM PASS NC1724.2 +206000 PERFORM PRINT-DETAIL NC1724.2 +206100 ELSE NC1724.2 +206200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +206300 MOVE 23 TO CORRECT-N NC1724.2 +206400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +206500 TO RE-MARK NC1724.2 +206600 PERFORM FAIL NC1724.2 +206700 PERFORM PRINT-DETAIL. NC1724.2 +206800 ADD 1 TO REC-CT. NC1724.2 +206900 DIV-TEST-F2-28-4. NC1724.2 +207000 MOVE "DIV-TEST-F2-28-4" TO PAR-NAME. NC1724.2 +207100 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +207200 PERFORM PASS NC1724.2 +207300 PERFORM PRINT-DETAIL NC1724.2 +207400 ELSE NC1724.2 +207500 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +207600 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +207700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +207800 PERFORM FAIL NC1724.2 +207900 PERFORM PRINT-DETAIL. NC1724.2 +208000 ADD 1 TO REC-CT. NC1724.2 +208100 DIV-TEST-F2-28-5. NC1724.2 +208200 MOVE "DIV-TEST-F2-28-5" TO PAR-NAME. NC1724.2 +208300 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +208400 PERFORM PASS NC1724.2 +208500 PERFORM PRINT-DETAIL NC1724.2 +208600 ELSE NC1724.2 +208700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +208800 MOVE 99 TO CORRECT-N NC1724.2 +208900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +209000 PERFORM FAIL NC1724.2 +209100 PERFORM PRINT-DETAIL. NC1724.2 +209200* NC1724.2 +209300* NC1724.2 +209400 DIV-INIT-F2-29. NC1724.2 +209500* ==--> SIZE ERROR CONDITION <--== NC1724.2 +209600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +209700 MOVE 1 TO REC-CT. NC1724.2 +209800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +209900 MOVE "0" TO WRK-XN-00001. NC1724.2 +210000 MOVE 0 TO DIV10. NC1724.2 +210100 MOVE 44.1 TO DIV2. NC1724.2 +210200 MOVE -9.642 TO DIV4. NC1724.2 +210300 DIV-TEST-F2-29-0. NC1724.2 +210400 DIVIDE DIV4 INTO DIV2 NC1724.2 +210500 GIVING DIV10 NC1724.2 +210600 ON SIZE ERROR NC1724.2 +210700 MOVE "1" TO WRK-XN-00001 NC1724.2 +210800 NOT ON SIZE ERROR NC1724.2 +210900 MOVE "2" TO WRK-XN-00001 NC1724.2 +211000 END-DIVIDE NC1724.2 +211100 MOVE 99 TO WRK-CS-18V00. NC1724.2 +211200 GO TO DIV-TEST-F2-29-1. NC1724.2 +211300 DIV-DELETE-F2-29-1. NC1724.2 +211400 PERFORM DE-LETE. NC1724.2 +211500 PERFORM PRINT-DETAIL. NC1724.2 +211600 GO TO DIV-INIT-F2-30. NC1724.2 +211700 DIV-TEST-F2-29-1. NC1724.2 +211800 MOVE "DIV-TEST-F2-29-1" TO PAR-NAME. NC1724.2 +211900 IF WRK-XN-00001 = "1" NC1724.2 +212000 PERFORM PASS NC1724.2 +212100 PERFORM PRINT-DETAIL NC1724.2 +212200 ELSE NC1724.2 +212300 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +212400 MOVE "1" TO CORRECT-X NC1724.2 +212500 MOVE "ON SIZE ERROR NOT EXECUTED" NC1724.2 +212600 TO RE-MARK NC1724.2 +212700 PERFORM FAIL NC1724.2 +212800 PERFORM PRINT-DETAIL. NC1724.2 +212900 ADD 1 TO REC-CT. NC1724.2 +213000 DIV-TEST-F2-29-2. NC1724.2 +213100 MOVE "DIV-TEST-F2-29-2" TO PAR-NAME. NC1724.2 +213200 IF DIV10 = 0 NC1724.2 +213300 PERFORM PASS NC1724.2 +213400 PERFORM PRINT-DETAIL NC1724.2 +213500 ELSE NC1724.2 +213600 MOVE DIV10 TO COMPUTED-N NC1724.2 +213700 MOVE 0 TO CORRECT-N NC1724.2 +213800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +213900 PERFORM FAIL NC1724.2 +214000 PERFORM PRINT-DETAIL. NC1724.2 +214100 ADD 1 TO REC-CT. NC1724.2 +214200 DIV-TEST-F2-29-3. NC1724.2 +214300 MOVE "DIV-TEST-F2-29-3" TO PAR-NAME. NC1724.2 +214400 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +214500 PERFORM PASS NC1724.2 +214600 PERFORM PRINT-DETAIL NC1724.2 +214700 ELSE NC1724.2 +214800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +214900 MOVE 99 TO CORRECT-N NC1724.2 +215000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +215100 PERFORM FAIL NC1724.2 +215200 PERFORM PRINT-DETAIL. NC1724.2 +215300* NC1724.2 +215400* NC1724.2 +215500 DIV-INIT-F2-30. NC1724.2 +215600* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +215700* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +215800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +215900 MOVE "0" TO WRK-XN-00001. NC1724.2 +216000 MOVE 0 TO WRK-CS-18V00. NC1724.2 +216100 DIV-TEST-F2-30-0. NC1724.2 +216200 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +216300 GIVING WRK-DS-09V09 NC1724.2 +216400 ON SIZE ERROR NC1724.2 +216500 MOVE "1" TO WRK-XN-00001 NC1724.2 +216600 NOT ON SIZE ERROR NC1724.2 +216700 MOVE "2" TO WRK-XN-00001 NC1724.2 +216800 END-DIVIDE NC1724.2 +216900 MOVE 99 TO WRK-CS-18V00. NC1724.2 +217000 GO TO DIV-TEST-F2-30-1. NC1724.2 +217100 DIV-DELETE-F2-30-1. NC1724.2 +217200 PERFORM DE-LETE. NC1724.2 +217300 PERFORM PRINT-DETAIL. NC1724.2 +217400 GO TO CCVS-EXIT. NC1724.2 +217500 DIV-TEST-F2-30-1. NC1724.2 +217600 MOVE "DIV-TEST-F2-30-1" TO PAR-NAME. NC1724.2 +217700 IF WRK-XN-00001 = "2" NC1724.2 +217800 PERFORM PASS NC1724.2 +217900 PERFORM PRINT-DETAIL NC1724.2 +218000 ELSE NC1724.2 +218100 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +218200 MOVE "2" TO CORRECT-X NC1724.2 +218300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +218400 TO RE-MARK NC1724.2 +218500 PERFORM FAIL NC1724.2 +218600 PERFORM PRINT-DETAIL. NC1724.2 +218700 ADD 1 TO REC-CT. NC1724.2 +218800 DIV-TEST-F2-30-2. NC1724.2 +218900 MOVE "DIV-TEST-F2-30-2" TO PAR-NAME. NC1724.2 +219000 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +219100 PERFORM PASS NC1724.2 +219200 PERFORM PRINT-DETAIL NC1724.2 +219300 ELSE NC1724.2 +219400 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +219500 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +219600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +219700 PERFORM FAIL NC1724.2 +219800 PERFORM PRINT-DETAIL. NC1724.2 +219900 ADD 1 TO REC-CT. NC1724.2 +220000 DIV-TEST-F2-30-3. NC1724.2 +220100 MOVE "DIV-TEST-F2-30-3" TO PAR-NAME. NC1724.2 +220200 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +220300 PERFORM PASS NC1724.2 +220400 PERFORM PRINT-DETAIL NC1724.2 +220500 ELSE NC1724.2 +220600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +220700 MOVE 99 TO CORRECT-N NC1724.2 +220800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +220900 PERFORM FAIL NC1724.2 +221000 PERFORM PRINT-DETAIL. NC1724.2 +221100* NC1724.2 +221200* NC1724.2 +221300 CCVS-EXIT SECTION. NC1724.2 +221400 CCVS-999999. NC1724.2 +221500 GO TO CLOSE-FILES. NC1724.2 +*END-OF,NC172A +*HEADER,COBOL,NC173A +000100 IDENTIFICATION DIVISION. NC1734.2 +000200 PROGRAM-ID. NC1734.2 +000300 NC173A. NC1734.2 +000400**************************************************************** NC1734.2 +000500* * NC1734.2 +000600* VALIDATION FOR:- * NC1734.2 +000700* * NC1734.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +000900* * NC1734.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1734.2 +001100* * NC1734.2 +001200**************************************************************** NC1734.2 +001300* * NC1734.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1734.2 +001500* * NC1734.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1734.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1734.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1734.2 +001900* * NC1734.2 +002000**************************************************************** NC1734.2 +002100* THIS PROGRAM TESTS THE FORMAT 3 DIVIDE STATEMENT FOUND NC1734.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1734.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1734.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1734.2 +002500* NC1734.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1734.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1734.2 +002800* AS OPERANDS. NC1734.2 +002900* NC1734.2 +003000* NC1734.2 +003100 ENVIRONMENT DIVISION. NC1734.2 +003200 CONFIGURATION SECTION. NC1734.2 +003300 SOURCE-COMPUTER. NC1734.2 +003400 XXXXX082. NC1734.2 +003500 OBJECT-COMPUTER. NC1734.2 +003600 XXXXX083. NC1734.2 +003700 INPUT-OUTPUT SECTION. NC1734.2 +003800 FILE-CONTROL. NC1734.2 +003900 SELECT PRINT-FILE ASSIGN TO NC1734.2 +004000 XXXXX055. NC1734.2 +004100 DATA DIVISION. NC1734.2 +004200 FILE SECTION. NC1734.2 +004300 FD PRINT-FILE. NC1734.2 +004400 01 PRINT-REC PICTURE X(120). NC1734.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC1734.2 +004600 WORKING-STORAGE SECTION. NC1734.2 +004700 77 WRK-DS-18V00 PICTURE S9(18). NC1734.2 +004800 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1734.2 +004900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1734.2 +005000 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1734.2 +005100 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1734.2 +005200 77 WRK-DS-10V00 PICTURE S9(10). NC1734.2 +005300 77 WRK-XN-00001 PICTURE X. NC1734.2 +005400 77 A10ONES-DS-10V00 PICTURE S9(10) NC1734.2 +005500 VALUE 1111111111. NC1734.2 +005600 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1734.2 +005700 VALUE 333333.333333. NC1734.2 +005800 77 WRK-DS-02V00 PICTURE S99. NC1734.2 +005900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1734.2 +006000 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1734.2 +006100 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1734.2 +006200 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1734.2 +006300 77 A12ONES-DS-12V00 PICTURE S9(12) NC1734.2 +006400 VALUE 111111111111. NC1734.2 +006500 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1734.2 +006600 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1734.2 +006700 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1734.2 +006800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1734.2 +006900 VALUE 111111111111111111. NC1734.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC1734.2 +007100 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1734.2 +007200 77 WRK-DU-18V00 PICTURE 9(18). NC1734.2 +007300 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1734.2 +007400 VALUE 99. NC1734.2 +007500 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1734.2 +007600 VALUE .1. NC1734.2 +007700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1734.2 +007800 77 WRK-DS-12V00 PICTURE S9(12). NC1734.2 +007900 77 WRK-DS-01V00 PICTURE S9. NC1734.2 +008000 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1734.2 +008100 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1734.2 +008200 VALUE 111111111.111111111. NC1734.2 +008300 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1734.2 +008400 77 WRK-DS-05V00 PICTURE S9(5). NC1734.2 +008500 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1734.2 +008600 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1734.2 +008700 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1734.2 +008800 77 XRAY PICTURE X. NC1734.2 +008900 01 WRK-XN-18-1 PIC X(18). NC1734.2 +009000 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1734.2 +009100 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1734.2 +009200 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1734.2 +009300 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1734.2 +009400 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1734.2 +009500 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1734.2 +009600 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1734.2 +009700 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1734.2 +009800 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1734.2 +009900 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1734.2 +010000 01 WRK-DU-1V5-1 PIC 9V9(5). NC1734.2 +010100 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1734.2 +010200 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1734.2 +010300 01 WRK-DU-2V0-1 PIC 99. NC1734.2 +010400 01 WRK-DU-2V0-2 PIC 99. NC1734.2 +010500 01 WRK-DU-2V0-3 PIC 99. NC1734.2 +010600 01 WRK-DU-2V1-1 PIC 99V9. NC1734.2 +010700 01 WRK-DU-2V1-2 PIC 99V9. NC1734.2 +010800 01 WRK-DU-2V1-3 PIC 99V9. NC1734.2 +010900 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1734.2 +011000 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1734.2 +011100 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1734.2 +011200 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1734.2 +011300 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1734.2 +011400 01 WRK-DU-2V5-1 PIC 99V9(5). NC1734.2 +011500 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1734.2 +011600 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1734.2 +011700 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1734.2 +011800 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1734.2 +011900 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1734.2 +012000 01 WRK-NE-X-1 PIC 9(16).99. NC1734.2 +012100 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1734.2 +012200 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1734.2 +012300 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1734.2 +012400 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1734.2 +012500 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1734.2 +012600 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1734.2 +012700 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1734.2 +012800 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1734.2 +012900 01 WRK-NE-X-2 PIC -9(16).99. NC1734.2 +013000 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1734.2 +013100 01 WRK-NE-2 PIC $**.99. NC1734.2 +013200 01 WRK-NE-3 PIC $99.99CR. NC1734.2 +013300 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1734.2 +013400 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1734.2 +013500 VALUE +000000000000000001. NC1734.2 +013600 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1734.2 +013700 VALUE -000000000000000033. NC1734.2 +013800 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +013900 VALUE 666666666666666666. NC1734.2 +014000 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +014100 VALUE 009999999999999999. NC1734.2 +014200 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +014300 VALUE 000022222222222222. NC1734.2 +014400 01 MULTIPLY-DATA. NC1734.2 +014500 02 MULT1 PICTURE IS 999V99 NC1734.2 +014600 VALUE IS 80.12. NC1734.2 +014700 02 MULT2 PICTURE IS 999V999. NC1734.2 +014800 02 MULT3 PICTURE IS $$99.99. NC1734.2 +014900 02 MULT4 PICTURE IS S99 NC1734.2 +015000 VALUE IS -56. NC1734.2 +015100 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1734.2 +015200 02 MULT6 PICTURE IS 99 VALUE IS NC1734.2 +015300 20. NC1734.2 +015400 01 DIVIDE-DATA. NC1734.2 +015500 02 DIV1 PICTURE IS 9(4)V99 NC1734.2 +015600 VALUE IS 1620.36. NC1734.2 +015700 02 DIV2 PICTURE IS 99V9 NC1734.2 +015800 VALUE IS 44.1. NC1734.2 +015900 02 DIV3 PICTURE IS 9(4)V9 NC1734.2 +016000 VALUE IS 1661.7. NC1734.2 +016100 02 DIV4 PICTURE IS S9V999 NC1734.2 +016200 VALUE IS -9.642. NC1734.2 +016300 02 DIV-02LEVEL-1. NC1734.2 +016400 03 DIV5 PICTURE IS V99 NC1734.2 +016500 VALUE IS .82. NC1734.2 +016600 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1734.2 +016700 03 DIV7 PICTURE IS 9V9 NC1734.2 +016800 VALUE IS 9.6. NC1734.2 +016900 01 DIV-DATA-2. NC1734.2 +017000 02 DIV8 PICTURE IS 99V9. NC1734.2 +017100 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1734.2 +017200 02 DIV10 PICTURE IS V999. NC1734.2 +017300 01 TEST-RESULTS. NC1734.2 +017400 02 FILLER PIC X VALUE SPACE. NC1734.2 +017500 02 FEATURE PIC X(20) VALUE SPACE. NC1734.2 +017600 02 FILLER PIC X VALUE SPACE. NC1734.2 +017700 02 P-OR-F PIC X(5) VALUE SPACE. NC1734.2 +017800 02 FILLER PIC X VALUE SPACE. NC1734.2 +017900 02 PAR-NAME. NC1734.2 +018000 03 FILLER PIC X(19) VALUE SPACE. NC1734.2 +018100 03 PARDOT-X PIC X VALUE SPACE. NC1734.2 +018200 03 DOTVALUE PIC 99 VALUE ZERO. NC1734.2 +018300 02 FILLER PIC X(8) VALUE SPACE. NC1734.2 +018400 02 RE-MARK PIC X(61). NC1734.2 +018500 01 TEST-COMPUTED. NC1734.2 +018600 02 FILLER PIC X(30) VALUE SPACE. NC1734.2 +018700 02 FILLER PIC X(17) VALUE NC1734.2 +018800 " COMPUTED=". NC1734.2 +018900 02 COMPUTED-X. NC1734.2 +019000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1734.2 +019100 03 COMPUTED-N REDEFINES COMPUTED-A NC1734.2 +019200 PIC -9(9).9(9). NC1734.2 +019300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1734.2 +019400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1734.2 +019500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1734.2 +019600 03 CM-18V0 REDEFINES COMPUTED-A. NC1734.2 +019700 04 COMPUTED-18V0 PIC -9(18). NC1734.2 +019800 04 FILLER PIC X. NC1734.2 +019900 03 FILLER PIC X(50) VALUE SPACE. NC1734.2 +020000 01 TEST-CORRECT. NC1734.2 +020100 02 FILLER PIC X(30) VALUE SPACE. NC1734.2 +020200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1734.2 +020300 02 CORRECT-X. NC1734.2 +020400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1734.2 +020500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1734.2 +020600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1734.2 +020700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1734.2 +020800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1734.2 +020900 03 CR-18V0 REDEFINES CORRECT-A. NC1734.2 +021000 04 CORRECT-18V0 PIC -9(18). NC1734.2 +021100 04 FILLER PIC X. NC1734.2 +021200 03 FILLER PIC X(2) VALUE SPACE. NC1734.2 +021300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1734.2 +021400 01 CCVS-C-1. NC1734.2 +021500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1734.2 +021600- "SS PARAGRAPH-NAME NC1734.2 +021700- " REMARKS". NC1734.2 +021800 02 FILLER PIC X(20) VALUE SPACE. NC1734.2 +021900 01 CCVS-C-2. NC1734.2 +022000 02 FILLER PIC X VALUE SPACE. NC1734.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". NC1734.2 +022200 02 FILLER PIC X(15) VALUE SPACE. NC1734.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". NC1734.2 +022400 02 FILLER PIC X(94) VALUE SPACE. NC1734.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1734.2 +022600 01 REC-CT PIC 99 VALUE ZERO. NC1734.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1734.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1734.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1734.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1734.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1734.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1734.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1734.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1734.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1734.2 +023600 01 CCVS-H-1. NC1734.2 +023700 02 FILLER PIC X(39) VALUE SPACES. NC1734.2 +023800 02 FILLER PIC X(42) VALUE NC1734.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1734.2 +024000 02 FILLER PIC X(39) VALUE SPACES. NC1734.2 +024100 01 CCVS-H-2A. NC1734.2 +024200 02 FILLER PIC X(40) VALUE SPACE. NC1734.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1734.2 +024400 02 FILLER PIC XXXX VALUE NC1734.2 +024500 "4.2 ". NC1734.2 +024600 02 FILLER PIC X(28) VALUE NC1734.2 +024700 " COPY - NOT FOR DISTRIBUTION". NC1734.2 +024800 02 FILLER PIC X(41) VALUE SPACE. NC1734.2 +024900 NC1734.2 +025000 01 CCVS-H-2B. NC1734.2 +025100 02 FILLER PIC X(15) VALUE NC1734.2 +025200 "TEST RESULT OF ". NC1734.2 +025300 02 TEST-ID PIC X(9). NC1734.2 +025400 02 FILLER PIC X(4) VALUE NC1734.2 +025500 " IN ". NC1734.2 +025600 02 FILLER PIC X(12) VALUE NC1734.2 +025700 " HIGH ". NC1734.2 +025800 02 FILLER PIC X(22) VALUE NC1734.2 +025900 " LEVEL VALIDATION FOR ". NC1734.2 +026000 02 FILLER PIC X(58) VALUE NC1734.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +026200 01 CCVS-H-3. NC1734.2 +026300 02 FILLER PIC X(34) VALUE NC1734.2 +026400 " FOR OFFICIAL USE ONLY ". NC1734.2 +026500 02 FILLER PIC X(58) VALUE NC1734.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1734.2 +026700 02 FILLER PIC X(28) VALUE NC1734.2 +026800 " COPYRIGHT 1985 ". NC1734.2 +026900 01 CCVS-E-1. NC1734.2 +027000 02 FILLER PIC X(52) VALUE SPACE. NC1734.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1734.2 +027200 02 ID-AGAIN PIC X(9). NC1734.2 +027300 02 FILLER PIC X(45) VALUE SPACES. NC1734.2 +027400 01 CCVS-E-2. NC1734.2 +027500 02 FILLER PIC X(31) VALUE SPACE. NC1734.2 +027600 02 FILLER PIC X(21) VALUE SPACE. NC1734.2 +027700 02 CCVS-E-2-2. NC1734.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1734.2 +027900 03 FILLER PIC X VALUE SPACE. NC1734.2 +028000 03 ENDER-DESC PIC X(44) VALUE NC1734.2 +028100 "ERRORS ENCOUNTERED". NC1734.2 +028200 01 CCVS-E-3. NC1734.2 +028300 02 FILLER PIC X(22) VALUE NC1734.2 +028400 " FOR OFFICIAL USE ONLY". NC1734.2 +028500 02 FILLER PIC X(12) VALUE SPACE. NC1734.2 +028600 02 FILLER PIC X(58) VALUE NC1734.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +028800 02 FILLER PIC X(13) VALUE SPACE. NC1734.2 +028900 02 FILLER PIC X(15) VALUE NC1734.2 +029000 " COPYRIGHT 1985". NC1734.2 +029100 01 CCVS-E-4. NC1734.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1734.2 +029300 02 FILLER PIC X(4) VALUE " OF ". NC1734.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1734.2 +029500 02 FILLER PIC X(40) VALUE NC1734.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1734.2 +029700 01 XXINFO. NC1734.2 +029800 02 FILLER PIC X(19) VALUE NC1734.2 +029900 "*** INFORMATION ***". NC1734.2 +030000 02 INFO-TEXT. NC1734.2 +030100 04 FILLER PIC X(8) VALUE SPACE. NC1734.2 +030200 04 XXCOMPUTED PIC X(20). NC1734.2 +030300 04 FILLER PIC X(5) VALUE SPACE. NC1734.2 +030400 04 XXCORRECT PIC X(20). NC1734.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). NC1734.2 +030600 01 HYPHEN-LINE. NC1734.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. NC1734.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************NC1734.2 +030900- "*****************************************". NC1734.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************NC1734.2 +031100- "******************************". NC1734.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE NC1734.2 +031300 "NC173A". NC1734.2 +031400 PROCEDURE DIVISION. NC1734.2 +031500 CCVS1 SECTION. NC1734.2 +031600 OPEN-FILES. NC1734.2 +031700 OPEN OUTPUT PRINT-FILE. NC1734.2 +031800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1734.2 +031900 MOVE SPACE TO TEST-RESULTS. NC1734.2 +032000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1734.2 +032100 GO TO CCVS1-EXIT. NC1734.2 +032200 CLOSE-FILES. NC1734.2 +032300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1734.2 +032400 TERMINATE-CCVS. NC1734.2 +032500S EXIT PROGRAM. NC1734.2 +032600STERMINATE-CALL. NC1734.2 +032700 STOP RUN. NC1734.2 +032800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1734.2 +032900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1734.2 +033000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1734.2 +033100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1734.2 +033200 MOVE "****TEST DELETED****" TO RE-MARK. NC1734.2 +033300 PRINT-DETAIL. NC1734.2 +033400 IF REC-CT NOT EQUAL TO ZERO NC1734.2 +033500 MOVE "." TO PARDOT-X NC1734.2 +033600 MOVE REC-CT TO DOTVALUE. NC1734.2 +033700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1734.2 +033800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1734.2 +033900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1734.2 +034000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1734.2 +034100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1734.2 +034200 MOVE SPACE TO CORRECT-X. NC1734.2 +034300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1734.2 +034400 MOVE SPACE TO RE-MARK. NC1734.2 +034500 HEAD-ROUTINE. NC1734.2 +034600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +034700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +034800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1734.2 +034900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1734.2 +035000 COLUMN-NAMES-ROUTINE. NC1734.2 +035100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +035200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +035400 END-ROUTINE. NC1734.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1734.2 +035600 END-RTN-EXIT. NC1734.2 +035700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +035800 END-ROUTINE-1. NC1734.2 +035900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1734.2 +036000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1734.2 +036100 ADD PASS-COUNTER TO ERROR-HOLD. NC1734.2 +036200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1734.2 +036300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1734.2 +036400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1734.2 +036500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1734.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1734.2 +036700 END-ROUTINE-12. NC1734.2 +036800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1734.2 +036900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1734.2 +037000 MOVE "NO " TO ERROR-TOTAL NC1734.2 +037100 ELSE NC1734.2 +037200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1734.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1734.2 +037400 PERFORM WRITE-LINE. NC1734.2 +037500 END-ROUTINE-13. NC1734.2 +037600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1734.2 +037700 MOVE "NO " TO ERROR-TOTAL ELSE NC1734.2 +037800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1734.2 +037900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1734.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038100 IF INSPECT-COUNTER EQUAL TO ZERO NC1734.2 +038200 MOVE "NO " TO ERROR-TOTAL NC1734.2 +038300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1734.2 +038400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1734.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038700 WRITE-LINE. NC1734.2 +038800 ADD 1 TO RECORD-COUNT. NC1734.2 +038900Y IF RECORD-COUNT GREATER 42 NC1734.2 +039000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1734.2 +039100Y MOVE SPACE TO DUMMY-RECORD NC1734.2 +039200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1734.2 +039300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1734.2 +039400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1734.2 +039500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1734.2 +039600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1734.2 +039700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +039800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +039900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +040000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1734.2 +040100Y MOVE ZERO TO RECORD-COUNT. NC1734.2 +040200 PERFORM WRT-LN. NC1734.2 +040300 WRT-LN. NC1734.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1734.2 +040500 MOVE SPACE TO DUMMY-RECORD. NC1734.2 +040600 BLANK-LINE-PRINT. NC1734.2 +040700 PERFORM WRT-LN. NC1734.2 +040800 FAIL-ROUTINE. NC1734.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE NC1734.2 +041000 GO TO FAIL-ROUTINE-WRITE. NC1734.2 +041100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1734.2 +041200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1734.2 +041300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1734.2 +041400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +041500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1734.2 +041600 GO TO FAIL-ROUTINE-EX. NC1734.2 +041700 FAIL-ROUTINE-WRITE. NC1734.2 +041800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1734.2 +041900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1734.2 +042000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1734.2 +042100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1734.2 +042200 FAIL-ROUTINE-EX. EXIT. NC1734.2 +042300 BAIL-OUT. NC1734.2 +042400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1734.2 +042500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1734.2 +042600 BAIL-OUT-WRITE. NC1734.2 +042700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1734.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1734.2 +042900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1734.2 +043100 BAIL-OUT-EX. EXIT. NC1734.2 +043200 CCVS1-EXIT. NC1734.2 +043300 EXIT. NC1734.2 +043400 SECT-NC173A-001 SECTION. NC1734.2 +043500 DIV-INIT-F3-1. NC1734.2 +043600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1734.2 +043700 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +043800 MOVE 44.1 TO DIV2. NC1734.2 +043900 MOVE 0 TO DIV8. NC1734.2 +044000 DIV-TEST-F3-1-0. NC1734.2 +044100 DIVIDE 864.36 BY DIV2 GIVING DIV8. NC1734.2 +044200 DIV-TEST-F3-1. NC1734.2 +044300 IF DIV8 EQUAL TO 19.6 NC1734.2 +044400 PERFORM PASS NC1734.2 +044500 ELSE NC1734.2 +044600 GO TO DIV-FAIL-F3-1. NC1734.2 +044700 GO TO DIV-WRITE-F3-1. NC1734.2 +044800 DIV-DELETE-F3-1. NC1734.2 +044900 PERFORM DE-LETE. NC1734.2 +045000 GO TO DIV-WRITE-F3-1. NC1734.2 +045100 DIV-FAIL-F3-1. NC1734.2 +045200 PERFORM FAIL. NC1734.2 +045300 MOVE DIV8 TO COMPUTED-N. NC1734.2 +045400 MOVE 19.6 TO CORRECT-N. NC1734.2 +045500 DIV-WRITE-F3-1. NC1734.2 +045600 MOVE "DIV-TEST-F3-1" TO PAR-NAME. NC1734.2 +045700 PERFORM PRINT-DETAIL. NC1734.2 +045800 DIV-INIT-F3-2. NC1734.2 +045900 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +046000 MOVE 0 TO DIV9. NC1734.2 +046100 DIV-TEST-F3-2. NC1734.2 +046200 DIVIDE DIV1 BY 0.533 GIVING DIV9 ROUNDED. NC1734.2 +046300 IF DIV9 EQUAL TO " 3,040.1" NC1734.2 +046400 PERFORM PASS NC1734.2 +046500 ELSE NC1734.2 +046600 GO TO DIV-FAIL-F3-2. NC1734.2 +046700 GO TO DIV-WRITE-F3-2. NC1734.2 +046800 DIV-DELETE-F3-2. NC1734.2 +046900 PERFORM DE-LETE. NC1734.2 +047000 GO TO DIV-WRITE-F3-2. NC1734.2 +047100 DIV-FAIL-F3-2. NC1734.2 +047200 PERFORM FAIL. NC1734.2 +047300 MOVE DIV9 TO COMPUTED-A. NC1734.2 +047400 MOVE " 3,040.1" TO CORRECT-A. NC1734.2 +047500 DIV-WRITE-F3-2. NC1734.2 +047600 MOVE "DIV-TEST-F3-2" TO PAR-NAME. NC1734.2 +047700 PERFORM PRINT-DETAIL. NC1734.2 +047800 DIV-INIT-F3-3. NC1734.2 +047900 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +048000 MOVE 44.1 TO DIV2. NC1734.2 +048100 MOVE -9.642 TO DIV4. NC1734.2 +048200 MOVE 0 TO DIV10. NC1734.2 +048300 MOVE 1 TO REC-CT. NC1734.2 +048400 DIV-TEST-F3-3-0. NC1734.2 +048500 DIVIDE DIV2 BY DIV4 GIVING DIV10 ON SIZE ERROR NC1734.2 +048600 MOVE "P" TO XRAY. NC1734.2 +048700 GO TO DIV-TEST-F3-3-1. NC1734.2 +048800 DIV-DELETE-F3-3-1. NC1734.2 +048900 PERFORM DE-LETE. NC1734.2 +049000 PERFORM PRINT-DETAIL. NC1734.2 +049100 GO TO DIV-INIT-F3-4. NC1734.2 +049200 DIV-TEST-F3-3-1. NC1734.2 +049300 MOVE "DIV-TEST-F3-3-1" TO PAR-NAME. NC1734.2 +049400 IF XRAY = "P" NC1734.2 +049500 PERFORM PASS NC1734.2 +049600 PERFORM PRINT-DETAIL NC1734.2 +049700 ELSE NC1734.2 +049800 MOVE XRAY TO COMPUTED-X NC1734.2 +049900 MOVE "P" TO CORRECT-X NC1734.2 +050000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +050100 PERFORM FAIL NC1734.2 +050200 PERFORM PRINT-DETAIL. NC1734.2 +050300 ADD 1 TO REC-CT. NC1734.2 +050400 DIV-TEST-F3-3-2. NC1734.2 +050500 MOVE "DIV-TEST-F3-3-2" TO PAR-NAME. NC1734.2 +050600 IF DIV10 = 0 NC1734.2 +050700 PERFORM PASS NC1734.2 +050800 PERFORM PRINT-DETAIL NC1734.2 +050900 ELSE NC1734.2 +051000 MOVE DIV10 TO COMPUTED-N NC1734.2 +051100 MOVE 0 TO CORRECT-N NC1734.2 +051200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +051300 PERFORM FAIL NC1734.2 +051400 PERFORM PRINT-DETAIL. NC1734.2 +051500 DIV-INIT-F3-4. NC1734.2 +051600 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +051700 MOVE 0 TO DIV8. NC1734.2 +051800 MOVE 1 TO REC-CT. NC1734.2 +051900 DIV-TEST-F3-4-0. NC1734.2 +052000 DIVIDE 100.50 BY 1.0051 GIVING DIV8 ROUNDED ON SIZE ERROR NC1734.2 +052100 MOVE "Q" TO XRAY. NC1734.2 +052200 GO TO DIV-TEST-F3-4-1. NC1734.2 +052300 DIV-DELETE-F3-4. NC1734.2 +052400 PERFORM DE-LETE. NC1734.2 +052500 PERFORM PRINT-DETAIL. NC1734.2 +052600 GO TO DIV-INIT-F3-5. NC1734.2 +052700 DIV-TEST-F3-4-1. NC1734.2 +052800 MOVE "DIV-TEST-F3-4-1" TO PAR-NAME. NC1734.2 +052900 IF XRAY = "Q" NC1734.2 +053000 PERFORM PASS NC1734.2 +053100 PERFORM PRINT-DETAIL NC1734.2 +053200 ELSE NC1734.2 +053300 MOVE XRAY TO COMPUTED-X NC1734.2 +053400 MOVE "Q" TO CORRECT-X NC1734.2 +053500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +053600 PERFORM FAIL NC1734.2 +053700 PERFORM PRINT-DETAIL. NC1734.2 +053800 ADD 1 TO REC-CT. NC1734.2 +053900 DIV-TEST-F3-4-2. NC1734.2 +054000 MOVE "DIV-TEST-F3-4-2" TO PAR-NAME. NC1734.2 +054100 IF DIV8 = 0 NC1734.2 +054200 PERFORM PASS NC1734.2 +054300 PERFORM PRINT-DETAIL NC1734.2 +054400 ELSE NC1734.2 +054500 MOVE DIV8 TO COMPUTED-N NC1734.2 +054600 MOVE 0 TO CORRECT-N NC1734.2 +054700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +054800 PERFORM FAIL NC1734.2 +054900 PERFORM PRINT-DETAIL. NC1734.2 +055000 DIV-INIT-F3-5. NC1734.2 +055100 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +055200 MOVE ZERO TO REC-CT. NC1734.2 +055300 MOVE ZERO TO WRK-DS-01V00. NC1734.2 +055400 DIV-TEST-F3-5-0. NC1734.2 +055500 DIVIDE A02TWOS-DU-02V00 BY -10.9 GIVING WRK-DS-01V00. NC1734.2 +055600 DIV-TEST-F3-5-1. NC1734.2 +055700 IF WRK-DS-01V00 EQUAL TO -2 NC1734.2 +055800 PERFORM PASS NC1734.2 +055900 GO TO DIV-WRITE-F3-5. NC1734.2 +056000 GO TO DIV-FAIL-F3-5. NC1734.2 +056100 DIV-DELETE-F3-5. NC1734.2 +056200 PERFORM DE-LETE. NC1734.2 +056300 GO TO DIV-WRITE-F3-5. NC1734.2 +056400 DIV-FAIL-F3-5. NC1734.2 +056500 MOVE -2 TO CORRECT-N. NC1734.2 +056600 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1734.2 +056700 PERFORM FAIL. NC1734.2 +056800 DIV-WRITE-F3-5. NC1734.2 +056900 MOVE "DIV-TEST-F3-5 " TO PAR-NAME. NC1734.2 +057000 PERFORM PRINT-DETAIL. NC1734.2 +057100 DIV-INIT-F3-6. NC1734.2 +057200 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +057300 MOVE 0.0000000001 TO WRK-DS-03V10. NC1734.2 +057400 MOVE ZERO TO WRK-DS-18V00. NC1734.2 +057500 DIV-TEST-F3-6-0. NC1734.2 +057600 DIVIDE A01ONE-DS-P0801 BY WRK-DS-03V10 GIVING NC1734.2 +057700 WRK-DS-18V00 ROUNDED. NC1734.2 +057800 DIV-TEST-F3-6-1. NC1734.2 +057900 IF WRK-DS-18V00 EQUAL TO 000000000000000010 NC1734.2 +058000 PERFORM PASS NC1734.2 +058100 GO TO DIV-WRITE-F3-6. NC1734.2 +058200 GO TO DIV-FAIL-F3-6. NC1734.2 +058300 DIV-DELETE-F3-6. NC1734.2 +058400 PERFORM DE-LETE. NC1734.2 +058500 GO TO DIV-WRITE-F3-6. NC1734.2 +058600 DIV-FAIL-F3-6. NC1734.2 +058700 MOVE 000000000000000010 TO CORRECT-18V0. NC1734.2 +058800 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1734.2 +058900 PERFORM FAIL. NC1734.2 +059000 DIV-WRITE-F3-6. NC1734.2 +059100 MOVE "DIV-TEST-F3-6 " TO PAR-NAME. NC1734.2 +059200 PERFORM PRINT-DETAIL. NC1734.2 +059300 DIV-INIT-F3-7. NC1734.2 +059400 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +059500 MOVE ZERO TO WRK-DS-18V00. NC1734.2 +059600 MOVE "0" TO WRK-XN-00001. NC1734.2 +059700 MOVE 1 TO REC-CT. NC1734.2 +059800 DIV-TEST-F3-7-0. NC1734.2 +059900 DIVIDE A99-DS-02V00 BY AZERO-DS-05V05 GIVING NC1734.2 +060000 WRK-DS-18V00 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1734.2 +060100 DIV-TEST-F3-7-1. NC1734.2 +060200 IF WRK-DS-18V00 EQUAL TO 000000000000000000 NC1734.2 +060300 PERFORM PASS NC1734.2 +060400 GO TO DIV-WRITE-F3-7-1. NC1734.2 +060500 MOVE 000000000000000000 TO CORRECT-18V0. NC1734.2 +060600 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1734.2 +060700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1734.2 +060800 PERFORM FAIL. NC1734.2 +060900 GO TO DIV-WRITE-F3-7-1. NC1734.2 +061000 DIV-DELETE-F3-7-1. NC1734.2 +061100 PERFORM DE-LETE. NC1734.2 +061200 DIV-WRITE-F3-7-1. NC1734.2 +061300 MOVE "DIV-TEST-F3-7-1" TO PAR-NAME. NC1734.2 +061400 PERFORM PRINT-DETAIL. NC1734.2 +061500 ADD 1 TO REC-CT. NC1734.2 +061600 DIV-TEST-F3-7-2. NC1734.2 +061700 IF WRK-XN-00001 EQUAL TO "1" NC1734.2 +061800 PERFORM PASS NC1734.2 +061900 GO TO DIV-WRITE-F3-7-2. NC1734.2 +062000 MOVE "1" TO CORRECT-A. NC1734.2 +062100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1734.2 +062200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1734.2 +062300 PERFORM FAIL. NC1734.2 +062400 GO TO DIV-WRITE-F3-7-2. NC1734.2 +062500 DIV-DELETE-F3-7-2. NC1734.2 +062600 PERFORM DE-LETE. NC1734.2 +062700 DIV-WRITE-F3-7-2. NC1734.2 +062800 MOVE "DIV-TEST-F3-7-2 " TO PAR-NAME. NC1734.2 +062900 PERFORM PRINT-DETAIL. NC1734.2 +063000 DIV-INIT-F3-8. NC1734.2 +063100 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +063200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +063300 MOVE "1" TO WRK-XN-00001. NC1734.2 +063400 MOVE 1 TO REC-CT. NC1734.2 +063500 DIV-TEST-F3-8-1. NC1734.2 +063600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 GIVING NC1734.2 +063700 WRK-DS-09V09 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1734.2 +063800 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1734.2 +063900 PERFORM PASS NC1734.2 +064000 GO TO DIV-WRITE-F3-8-1. NC1734.2 +064100 DIV-FAIL-F3-8-1. NC1734.2 +064200 MOVE 000000001000000000 TO CORRECT-18V0. NC1734.2 +064300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1734.2 +064400 PERFORM FAIL. NC1734.2 +064500 GO TO DIV-WRITE-F3-8-1. NC1734.2 +064600 DIV-DELETE-F3-8-1. NC1734.2 +064700 PERFORM DE-LETE. NC1734.2 +064800 DIV-WRITE-F3-8-1. NC1734.2 +064900 MOVE "DIV-TEST-F3-8-1 " TO PAR-NAME. NC1734.2 +065000 PERFORM PRINT-DETAIL. NC1734.2 +065100 ADD 1 TO REC-CT. NC1734.2 +065200 DIV-TEST-F3-8-2. NC1734.2 +065300 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +065400 MOVE WRK-XN-00001 TO COMPUTED-A NC1734.2 +065500 MOVE "1" TO CORRECT-A NC1734.2 +065600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1734.2 +065700 PERFORM FAIL NC1734.2 +065800 GO TO DIV-WRITE-F3-8-2. NC1734.2 +065900 PERFORM PASS. NC1734.2 +066000 GO TO DIV-WRITE-F3-8-2. NC1734.2 +066100 DIV-DELETE-F3-8-2. NC1734.2 +066200 PERFORM DE-LETE. NC1734.2 +066300 DIV-WRITE-F3-8-2. NC1734.2 +066400 MOVE "DIV-TEST-F3-8-2 " TO PAR-NAME. NC1734.2 +066500 PERFORM PRINT-DETAIL. NC1734.2 +066600 DIV-INIT-F3-9. NC1734.2 +066700 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +066800 MOVE ZERO TO WRK-DS-0201P. NC1734.2 +066900 MOVE -0.005 TO WRK-DS-09V09. NC1734.2 +067000 MOVE "0" TO WRK-XN-00001. NC1734.2 +067100 MOVE 1 TO REC-CT. NC1734.2 +067200 DIV-TEST-F3-9-1-0. NC1734.2 +067300 DIVIDE A05ONES-DS-00V05 BY WRK-DS-09V09 GIVING NC1734.2 +067400 WRK-DS-0201P ROUNDED ON SIZE ERROR NC1734.2 +067500 MOVE "1" TO WRK-XN-00001. NC1734.2 +067600 DIV-TEST-F3-9-1-1. NC1734.2 +067700 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1734.2 +067800 IF WRK-DS-05V00 EQUAL TO -00020 NC1734.2 +067900 PERFORM PASS NC1734.2 +068000 GO TO DIV-WRITE-F3-9-1. NC1734.2 +068100 MOVE -00020 TO CORRECT-N. NC1734.2 +068200 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1734.2 +068300 PERFORM FAIL. NC1734.2 +068400 GO TO DIV-WRITE-F3-9-1. NC1734.2 +068500 DIV-DELETE-F3-9-1. NC1734.2 +068600 PERFORM DE-LETE. NC1734.2 +068700 DIV-WRITE-F3-9-1. NC1734.2 +068800 MOVE "DIV-TEST-F3-9-1 " TO PAR-NAME. NC1734.2 +068900 PERFORM PRINT-DETAIL. NC1734.2 +069000 ADD 1 TO REC-CT. NC1734.2 +069100 DIV-TEST-F3-9-2-1. NC1734.2 +069200 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +069300 PERFORM PASS NC1734.2 +069400 GO TO DIV-WRITE-F3-9-2. NC1734.2 +069500 MOVE "0" TO CORRECT-A. NC1734.2 +069600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1734.2 +069700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1734.2 +069800 PERFORM FAIL. NC1734.2 +069900 GO TO DIV-WRITE-F3-9-2. NC1734.2 +070000 DIV-DELETE-F3-9-2. NC1734.2 +070100 PERFORM DE-LETE. NC1734.2 +070200 DIV-WRITE-F3-9-2. NC1734.2 +070300 MOVE "DIV-TEST-F3-9-2 " TO PAR-NAME. NC1734.2 +070400 PERFORM PRINT-DETAIL. NC1734.2 +070500 DIV-INIT-F3-10. NC1734.2 +070600 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +070700 MOVE "1" TO WRK-XN-00001. NC1734.2 +070800 MOVE ZERO TO WRK-DS-01V00. NC1734.2 +070900 MOVE 1 TO REC-CT. NC1734.2 +071000 DIV-TEST-F3-10-0. NC1734.2 +071100 DIVIDE A02TWOS-DS-03V02 BY A02TWOS-DU-02V00 GIVING NC1734.2 +071200 WRK-DS-01V00 ROUNDED ON SIZE ERROR NC1734.2 +071300 MOVE "0" TO WRK-XN-00001. NC1734.2 +071400 DIV-TEST-F3-10-1. NC1734.2 +071500 IF WRK-DS-01V00 EQUAL TO +1 NC1734.2 +071600 PERFORM PASS NC1734.2 +071700 GO TO DIV-WRITE-F3-10-1. NC1734.2 +071800 MOVE +1 TO CORRECT-N. NC1734.2 +071900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1734.2 +072000 PERFORM FAIL. NC1734.2 +072100 GO TO DIV-WRITE-F3-10-1. NC1734.2 +072200 DIV-DELETE-F3-10-1. NC1734.2 +072300 PERFORM DE-LETE. NC1734.2 +072400 DIV-WRITE-F3-10-1. NC1734.2 +072500 MOVE "DIV-TEST-F3-10-1" TO PAR-NAME. NC1734.2 +072600 PERFORM PRINT-DETAIL. NC1734.2 +072700 ADD 1 TO REC-CT. NC1734.2 +072800 DIV-TEST-F3-10-2. NC1734.2 +072900 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +073000 MOVE "0" TO COMPUTED-A NC1734.2 +073100 MOVE "1" TO CORRECT-A NC1734.2 +073200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1734.2 +073300 PERFORM FAIL NC1734.2 +073400 GO TO DIV-WRITE-F3-10-2. NC1734.2 +073500 PERFORM PASS. NC1734.2 +073600 GO TO DIV-WRITE-F3-10-2. NC1734.2 +073700 DIV-DELETE-F3-10-2. NC1734.2 +073800 PERFORM DE-LETE. NC1734.2 +073900 DIV-WRITE-F3-10-2. NC1734.2 +074000 MOVE "DIV-TEST-F3-10-2 " TO PAR-NAME. NC1734.2 +074100 PERFORM PRINT-DETAIL. NC1734.2 +074200 DIV-INIT-F3-11. NC1734.2 +074300 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +074400 MOVE 0 TO WRK-DS-05V00. NC1734.2 +074500 DIV-TEST-F3-11-0. NC1734.2 +074600 DIVIDE A99-CS-02V00 BY A01ONE-CS-00V01 GIVING NC1734.2 +074700 WRK-DS-05V00. NC1734.2 +074800 DIV-TEST-F3-11-1. NC1734.2 +074900 IF WRK-DS-05V00 EQUAL TO 00990 NC1734.2 +075000 PERFORM PASS NC1734.2 +075100 GO TO DIV-WRITE-F3-11. NC1734.2 +075200 GO TO DIV-FAIL-F3-11. NC1734.2 +075300 DIV-DELETE-F3-11. NC1734.2 +075400 PERFORM DE-LETE. NC1734.2 +075500 GO TO DIV-WRITE-F3-11. NC1734.2 +075600 DIV-FAIL-F3-11. NC1734.2 +075700 MOVE 00990 TO CORRECT-N. NC1734.2 +075800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1734.2 +075900 PERFORM FAIL. NC1734.2 +076000 DIV-WRITE-F3-11. NC1734.2 +076100 MOVE "DIV-TEST-F3-11 " TO PAR-NAME. NC1734.2 +076200 PERFORM PRINT-DETAIL. NC1734.2 +076300 DIV-INIT-F3-12. NC1734.2 +076400 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +076500 MOVE ZERO TO WRK-CS-18V00. NC1734.2 +076600 DIV-TEST-F3-12-0. NC1734.2 +076700 DIVIDE A16NINES-CU-18V00 BY A02THREES-CS-18V00 NC1734.2 +076800 GIVING WRK-CS-18V00. NC1734.2 +076900 DIV-TEST-F3-12-1. NC1734.2 +077000 IF WRK-CS-18V00 EQUAL TO -000303030303030303 NC1734.2 +077100 PERFORM PASS NC1734.2 +077200 GO TO DIV-WRITE-F3-12. NC1734.2 +077300 MOVE -00303030303030303 TO CORRECT-18V0. NC1734.2 +077400 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1734.2 +077500 PERFORM FAIL. NC1734.2 +077600 GO TO DIV-WRITE-F3-12. NC1734.2 +077700 DIV-DELETE-F3-12. NC1734.2 +077800 PERFORM DE-LETE. NC1734.2 +077900 DIV-WRITE-F3-12. NC1734.2 +078000 MOVE "DIV-TEST-F3-12 " TO PAR-NAME. NC1734.2 +078100 PERFORM PRINT-DETAIL. NC1734.2 +078200 DIV-INIT-F3-13. NC1734.2 +078300 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +078400 MOVE ZERO TO WRK-DU-18V00. NC1734.2 +078500 DIV-TEST-F3-13-0. NC1734.2 +078600 DIVIDE A18SIXES-CU-18V00 BY A14TWOS-CU-18V00 GIVING NC1734.2 +078700 WRK-DU-18V00. NC1734.2 +078800 DIV-TEST-F3-13-1. NC1734.2 +078900 IF WRK-DU-18V00 EQUAL TO 000000000000030000 NC1734.2 +079000 PERFORM PASS NC1734.2 +079100 GO TO DIV-WRITE-F3-13. NC1734.2 +079200 MOVE 000000000000030000 TO CORRECT-18V0. NC1734.2 +079300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1734.2 +079400 PERFORM FAIL. NC1734.2 +079500 GO TO DIV-WRITE-F3-13. NC1734.2 +079600 DIV-DELETE-F3-13. NC1734.2 +079700 PERFORM DE-LETE. NC1734.2 +079800 DIV-WRITE-F3-13. NC1734.2 +079900 MOVE "DIV-TEST-F3-13 " TO PAR-NAME. NC1734.2 +080000 PERFORM PRINT-DETAIL. NC1734.2 +080100 DIV-INIT-F3-14. NC1734.2 +080200 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +080300 MOVE ZERO TO WRK-CS-18V00. NC1734.2 +080400 DIV-TEST-F3-14-0. NC1734.2 +080500 DIVIDE A02THREES-CS-18V00 BY A01ONES-CS-18V00 GIVING NC1734.2 +080600 WRK-CS-18V00 ROUNDED. NC1734.2 +080700 DIV-TEST-F3-14-1. NC1734.2 +080800 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1734.2 +080900 PERFORM PASS NC1734.2 +081000 GO TO DIV-WRITE-F3-14. NC1734.2 +081100 MOVE -000000000000000033 TO CORRECT-18V0. NC1734.2 +081200 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1734.2 +081300 PERFORM FAIL. NC1734.2 +081400 GO TO DIV-WRITE-F3-14. NC1734.2 +081500 DIV-DELETE-F3-14. NC1734.2 +081600 PERFORM DE-LETE. NC1734.2 +081700 DIV-WRITE-F3-14. NC1734.2 +081800 MOVE "DIV-TEST-F3-14 " TO PAR-NAME. NC1734.2 +081900 PERFORM PRINT-DETAIL. NC1734.2 +082000* NC1734.2 +082100* NC1734.2 +082200 DIV-INIT-F3-15. NC1734.2 +082300* ==--> SIZE ERROR CONDITION <--== NC1734.2 +082400* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +082500 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +082600 MOVE "DIV-TEST-F3-15" TO PAR-NAME. NC1734.2 +082700 MOVE 44.1 TO DIV2. NC1734.2 +082800 MOVE -9.642 TO DIV4. NC1734.2 +082900 MOVE 0 TO DIV10. NC1734.2 +083000 MOVE 1 TO REC-CT. NC1734.2 +083100 MOVE "A" TO XRAY. NC1734.2 +083200 DIV-TEST-F3-15-0. NC1734.2 +083300 DIVIDE DIV2 BY DIV4 NC1734.2 +083400 GIVING DIV10 NC1734.2 +083500 NOT ON SIZE ERROR NC1734.2 +083600 MOVE "P" TO XRAY. NC1734.2 +083700 GO TO DIV-TEST-F3-15-1. NC1734.2 +083800 DIV-DELETE-F3-15-1. NC1734.2 +083900 PERFORM DE-LETE. NC1734.2 +084000 PERFORM PRINT-DETAIL. NC1734.2 +084100 GO TO DIV-INIT-F3-16. NC1734.2 +084200 DIV-TEST-F3-15-1. NC1734.2 +084300 MOVE "DIV-TEST-F3-15-1" TO PAR-NAME. NC1734.2 +084400 IF XRAY = "A" NC1734.2 +084500 PERFORM PASS NC1734.2 +084600 PERFORM PRINT-DETAIL NC1734.2 +084700 ELSE NC1734.2 +084800 MOVE XRAY TO COMPUTED-X NC1734.2 +084900 MOVE "A" TO CORRECT-X NC1734.2 +085000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +085100 PERFORM FAIL NC1734.2 +085200 PERFORM PRINT-DETAIL. NC1734.2 +085300 ADD 1 TO REC-CT. NC1734.2 +085400 DIV-TEST-F3-15-2. NC1734.2 +085500 MOVE "DIV-TEST-F3-15-2" TO PAR-NAME. NC1734.2 +085600 IF DIV10 = 0 NC1734.2 +085700 PERFORM PASS NC1734.2 +085800 PERFORM PRINT-DETAIL NC1734.2 +085900 ELSE NC1734.2 +086000 MOVE DIV10 TO COMPUTED-N NC1734.2 +086100 MOVE 0 TO CORRECT-N NC1734.2 +086200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +086300 PERFORM FAIL NC1734.2 +086400 PERFORM PRINT-DETAIL. NC1734.2 +086500* NC1734.2 +086600* NC1734.2 +086700 DIV-INIT-F3-16. NC1734.2 +086800 MOVE "DIV-TEST-F3-16" TO PAR-NAME. NC1734.2 +086900 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +087000* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +087100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +087200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +087300 MOVE 1 TO REC-CT. NC1734.2 +087400 MOVE "1" TO WRK-XN-00001. NC1734.2 +087500 DIV-TEST-F3-16-0. NC1734.2 +087600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +087700 GIVING WRK-DS-09V09 NC1734.2 +087800 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1734.2 +087900 GO TO DIV-TEST-F3-16-1. NC1734.2 +088000 DIV-DELETE-F3-16-1. NC1734.2 +088100 PERFORM DE-LETE. NC1734.2 +088200 PERFORM PRINT-DETAIL. NC1734.2 +088300 GO TO DIV-INIT-F3-17. NC1734.2 +088400 DIV-TEST-F3-16-1. NC1734.2 +088500 MOVE "DIV-TEST-F3-16-1" TO PAR-NAME. NC1734.2 +088600 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1734.2 +088700 PERFORM PASS NC1734.2 +088800 PERFORM PRINT-DETAIL NC1734.2 +088900 ELSE NC1734.2 +089000 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +089100 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +089200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +089300 PERFORM FAIL NC1734.2 +089400 PERFORM PRINT-DETAIL. NC1734.2 +089500 ADD 1 TO REC-CT. NC1734.2 +089600 DIV-TEST-F3-16-2. NC1734.2 +089700 MOVE "DIV-TEST-F3-16-2" TO PAR-NAME. NC1734.2 +089800 IF WRK-XN-00001 = "0" NC1734.2 +089900 PERFORM PASS NC1734.2 +090000 PERFORM PRINT-DETAIL NC1734.2 +090100 ELSE NC1734.2 +090200 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +090300 MOVE "0" TO CORRECT-X NC1734.2 +090400 MOVE "NOT ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +090500 PERFORM FAIL NC1734.2 +090600 PERFORM PRINT-DETAIL. NC1734.2 +090700* NC1734.2 +090800* NC1734.2 +090900 DIV-INIT-F3-17. NC1734.2 +091000* ==--> SIZE ERROR CONDITION <--== NC1734.2 +091100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +091200 MOVE "DIV-TEST-F3-17" TO PAR-NAME. NC1734.2 +091300 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +091400 MOVE 44.1 TO DIV2. NC1734.2 +091500 MOVE -9.642 TO DIV4. NC1734.2 +091600 MOVE 0 TO DIV10. NC1734.2 +091700 MOVE 1 TO REC-CT. NC1734.2 +091800 MOVE "A" TO XRAY. NC1734.2 +091900 DIV-TEST-F3-17-0. NC1734.2 +092000 DIVIDE DIV2 BY DIV4 NC1734.2 +092100 GIVING DIV10 NC1734.2 +092200 ON SIZE ERROR NC1734.2 +092300 MOVE "E" TO XRAY NC1734.2 +092400 NOT ON SIZE ERROR NC1734.2 +092500 MOVE "N" TO XRAY. NC1734.2 +092600 GO TO DIV-TEST-F3-17-1. NC1734.2 +092700 DIV-DELETE-F3-17-1. NC1734.2 +092800 PERFORM DE-LETE. NC1734.2 +092900 PERFORM PRINT-DETAIL. NC1734.2 +093000 GO TO DIV-INIT-F3-18. NC1734.2 +093100 DIV-TEST-F3-17-1. NC1734.2 +093200 MOVE "DIV-TEST-F3-17-1" TO PAR-NAME. NC1734.2 +093300 IF XRAY = "E" NC1734.2 +093400 PERFORM PASS NC1734.2 +093500 PERFORM PRINT-DETAIL NC1734.2 +093600 ELSE NC1734.2 +093700 MOVE XRAY TO COMPUTED-X NC1734.2 +093800 MOVE "E" TO CORRECT-X NC1734.2 +093900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +094000 PERFORM FAIL NC1734.2 +094100 PERFORM PRINT-DETAIL. NC1734.2 +094200 ADD 1 TO REC-CT. NC1734.2 +094300 DIV-TEST-F3-17-2. NC1734.2 +094400 MOVE "DIV-TEST-F3-17-2" TO PAR-NAME. NC1734.2 +094500 IF DIV10 = 0 NC1734.2 +094600 PERFORM PASS NC1734.2 +094700 PERFORM PRINT-DETAIL NC1734.2 +094800 ELSE NC1734.2 +094900 MOVE DIV10 TO COMPUTED-N NC1734.2 +095000 MOVE 0 TO CORRECT-N NC1734.2 +095100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +095200 PERFORM FAIL NC1734.2 +095300 PERFORM PRINT-DETAIL. NC1734.2 +095400* NC1734.2 +095500* NC1734.2 +095600 DIV-INIT-F3-18. NC1734.2 +095700* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +095800* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +095900 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +096000 MOVE 1 TO REC-CT. NC1734.2 +096100 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +096200 MOVE "1" TO WRK-XN-00001. NC1734.2 +096300 DIV-TEST-F3-18-0. NC1734.2 +096400 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +096500 GIVING WRK-DS-09V09 NC1734.2 +096600 ON SIZE ERROR NC1734.2 +096700 MOVE "1" TO WRK-XN-00001 NC1734.2 +096800 NOT ON SIZE ERROR NC1734.2 +096900 MOVE "2" TO WRK-XN-00001. NC1734.2 +097000 GO TO DIV-TEST-F3-18-1. NC1734.2 +097100 DIV-DELETE-F3-18-1. NC1734.2 +097200 PERFORM DE-LETE. NC1734.2 +097300 PERFORM PRINT-DETAIL. NC1734.2 +097400 GO TO DIV-INIT-F3-19. NC1734.2 +097500 DIV-TEST-F3-18-1. NC1734.2 +097600 MOVE "DIV-TEST-F3-18-1" TO PAR-NAME. NC1734.2 +097700 IF WRK-DS-09V09 EQUAL TO 1 NC1734.2 +097800 PERFORM PASS NC1734.2 +097900 PERFORM PRINT-DETAIL NC1734.2 +098000 ELSE NC1734.2 +098100 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +098200 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +098300 MOVE "DIV-TEST-F3-18-2" TO PAR-NAME NC1734.2 +098400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +098500 PERFORM FAIL NC1734.2 +098600 PERFORM PRINT-DETAIL. NC1734.2 +098700 MOVE 1 TO REC-CT. NC1734.2 +098800 DIV-TEST-F3-18-2. NC1734.2 +098900 MOVE "DIV-TEST-F3-18-2" TO PAR-NAME. NC1734.2 +099000 IF WRK-XN-00001 = "2" NC1734.2 +099100 PERFORM PASS NC1734.2 +099200 PERFORM PRINT-DETAIL NC1734.2 +099300 ELSE NC1734.2 +099400 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +099500 MOVE "2" TO CORRECT-X NC1734.2 +099600 MOVE "NOT ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +099700 PERFORM FAIL NC1734.2 +099800 PERFORM PRINT-DETAIL. NC1734.2 +099900* NC1734.2 +100000* NC1734.2 +100100 DIV-INIT-F3-19. NC1734.2 +100200 MOVE "DIV-TEST-F3-19" TO PAR-NAME. NC1734.2 +100300* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +100400* ==--> MULTIPLE RESULT FIELDS <--== NC1734.2 +100500 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +100600 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +100700 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +100800 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +100900 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +101000 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +101100 MOVE 1 TO REC-CT. NC1734.2 +101200 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +101300 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +101400 DIV-TEST-F3-19-0. NC1734.2 +101500 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +101600 GIVING WRK-DU-2V1-1 NC1734.2 +101700 WRK-DU-2V0-1 ROUNDED NC1734.2 +101800 WRK-DU-2V1-2 NC1734.2 +101900 WRK-DU-2V0-2 ROUNDED NC1734.2 +102000 WRK-DU-2V1-3 NC1734.2 +102100 WRK-DU-2V0-3. NC1734.2 +102200 GO TO DIV-TEST-F3-19-1. NC1734.2 +102300 DIV-DELETE-F3-19. NC1734.2 +102400 PERFORM DE-LETE. NC1734.2 +102500 PERFORM PRINT-DETAIL. NC1734.2 +102600 GO TO DIV-INIT-F3-20. NC1734.2 +102700 DIV-TEST-F3-19-1. NC1734.2 +102800 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +102900 PERFORM PASS NC1734.2 +103000 PERFORM PRINT-DETAIL NC1734.2 +103100 ELSE NC1734.2 +103200 PERFORM FAIL NC1734.2 +103300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +103400 MOVE 2.5 TO CORRECT-N NC1734.2 +103500 PERFORM PRINT-DETAIL. NC1734.2 +103600 ADD 1 TO REC-CT. NC1734.2 +103700 DIV-TEST-F3-19-2. NC1734.2 +103800 IF WRK-DU-2V0-1 = 3 NC1734.2 +103900 PERFORM PASS NC1734.2 +104000 PERFORM PRINT-DETAIL NC1734.2 +104100 ELSE NC1734.2 +104200 PERFORM FAIL NC1734.2 +104300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +104400 MOVE 3 TO CORRECT-N NC1734.2 +104500 PERFORM PRINT-DETAIL. NC1734.2 +104600 ADD 1 TO REC-CT. NC1734.2 +104700 DIV-TEST-F3-19-3. NC1734.2 +104800 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +104900 PERFORM PASS NC1734.2 +105000 PERFORM PRINT-DETAIL NC1734.2 +105100 ELSE NC1734.2 +105200 PERFORM FAIL NC1734.2 +105300 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +105400 MOVE 2.5 TO CORRECT-N NC1734.2 +105500 PERFORM PRINT-DETAIL. NC1734.2 +105600 ADD 1 TO REC-CT. NC1734.2 +105700 DIV-TEST-F3-19-4. NC1734.2 +105800 IF WRK-DU-2V0-2 = 3 NC1734.2 +105900 PERFORM PASS NC1734.2 +106000 PERFORM PRINT-DETAIL NC1734.2 +106100 ELSE NC1734.2 +106200 PERFORM FAIL NC1734.2 +106300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +106400 MOVE 3 TO CORRECT-N NC1734.2 +106500 PERFORM PRINT-DETAIL. NC1734.2 +106600 ADD 1 TO REC-CT. NC1734.2 +106700 DIV-TEST-F3-19-5. NC1734.2 +106800 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +106900 PERFORM PASS NC1734.2 +107000 PERFORM PRINT-DETAIL NC1734.2 +107100 ELSE NC1734.2 +107200 PERFORM FAIL NC1734.2 +107300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +107400 MOVE 2.5 TO CORRECT-N NC1734.2 +107500 PERFORM PRINT-DETAIL. NC1734.2 +107600 ADD 1 TO REC-CT. NC1734.2 +107700 DIV-TEST-F3-19-6. NC1734.2 +107800 IF WRK-DU-2V0-3 = 2 NC1734.2 +107900 PERFORM PASS NC1734.2 +108000 PERFORM PRINT-DETAIL NC1734.2 +108100 ELSE NC1734.2 +108200 PERFORM FAIL NC1734.2 +108300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +108400 MOVE 2 TO CORRECT-N NC1734.2 +108500 PERFORM PRINT-DETAIL. NC1734.2 +108600* NC1734.2 +108700* NC1734.2 +108800 DIV-INIT-F3-20. NC1734.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1734.2 +109000* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +109100 MOVE "DIV-TEST-F3-20" TO PAR-NAME. NC1734.2 +109200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +109300 MOVE "0" TO WRK-XN-00001. NC1734.2 +109400 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +109600 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +109700 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +109800 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +109900 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +110000 MOVE 1 TO REC-CT. NC1734.2 +110100 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +110200 DIV-TEST-F3-20-0. NC1734.2 +110300 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +110400 GIVING WRK-DU-2V1-1 NC1734.2 +110500 WRK-DU-2V0-1 ROUNDED NC1734.2 +110600 WRK-DU-2V1-2 NC1734.2 +110700 WRK-DU-2V0-2 ROUNDED NC1734.2 +110800 WRK-DU-2V1-3 NC1734.2 +110900 WRK-DU-2V0-3 NC1734.2 +111000 ON SIZE ERROR NC1734.2 +111100 MOVE "1" TO WRK-XN-00001. NC1734.2 +111200 GO TO DIV-TEST-F3-20-1. NC1734.2 +111300 DIV-DELETE-F3-20. NC1734.2 +111400 PERFORM DE-LETE. NC1734.2 +111500 PERFORM PRINT-DETAIL. NC1734.2 +111600 GO TO DIV-INIT-F3-21. NC1734.2 +111700 DIV-TEST-F3-20-1. NC1734.2 +111800 IF WRK-DU-2V1-1 = 0 NC1734.2 +111900 PERFORM PASS NC1734.2 +112000 PERFORM PRINT-DETAIL NC1734.2 +112100 ELSE NC1734.2 +112200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +112300 PERFORM FAIL NC1734.2 +112400 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +112500 MOVE 0 TO CORRECT-N NC1734.2 +112600 PERFORM PRINT-DETAIL. NC1734.2 +112700 ADD 1 TO REC-CT. NC1734.2 +112800 DIV-TEST-F3-20-2. NC1734.2 +112900 IF WRK-DU-2V0-1 = 99 NC1734.2 +113000 PERFORM PASS NC1734.2 +113100 PERFORM PRINT-DETAIL NC1734.2 +113200 ELSE NC1734.2 +113300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +113400 PERFORM FAIL NC1734.2 +113500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +113600 MOVE 99 TO CORRECT-N NC1734.2 +113700 PERFORM PRINT-DETAIL. NC1734.2 +113800 ADD 1 TO REC-CT. NC1734.2 +113900 DIV-TEST-F3-20-3. NC1734.2 +114000 IF WRK-DU-2V1-2 = 0 NC1734.2 +114100 PERFORM PASS NC1734.2 +114200 PERFORM PRINT-DETAIL NC1734.2 +114300 ELSE NC1734.2 +114400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +114500 PERFORM FAIL NC1734.2 +114600 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +114700 MOVE 0 TO CORRECT-N NC1734.2 +114800 PERFORM PRINT-DETAIL. NC1734.2 +114900 ADD 1 TO REC-CT. NC1734.2 +115000 DIV-TEST-F3-20-4. NC1734.2 +115100 IF WRK-DU-2V0-2 = 0 NC1734.2 +115200 PERFORM PASS NC1734.2 +115300 PERFORM PRINT-DETAIL NC1734.2 +115400 ELSE NC1734.2 +115500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +115600 PERFORM FAIL NC1734.2 +115700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +115800 MOVE 0 TO CORRECT-N NC1734.2 +115900 PERFORM PRINT-DETAIL. NC1734.2 +116000 ADD 1 TO REC-CT. NC1734.2 +116100 DIV-TEST-F3-20-5. NC1734.2 +116200 IF WRK-DU-2V1-3 = 0 NC1734.2 +116300 PERFORM PASS NC1734.2 +116400 PERFORM PRINT-DETAIL NC1734.2 +116500 ELSE NC1734.2 +116600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +116700 PERFORM FAIL NC1734.2 +116800 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +116900 MOVE 0 TO CORRECT-N NC1734.2 +117000 PERFORM PRINT-DETAIL. NC1734.2 +117100 ADD 1 TO REC-CT. NC1734.2 +117200 DIV-TEST-F3-20-6. NC1734.2 +117300 IF WRK-DU-2V0-3 = 0 NC1734.2 +117400 PERFORM PASS NC1734.2 +117500 PERFORM PRINT-DETAIL NC1734.2 +117600 ELSE NC1734.2 +117700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +117800 PERFORM FAIL NC1734.2 +117900 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +118000 MOVE 0 TO CORRECT-N NC1734.2 +118100 PERFORM PRINT-DETAIL. NC1734.2 +118200 ADD 1 TO REC-CT. NC1734.2 +118300 DIV-TEST-F3-20-7. NC1734.2 +118400 IF WRK-XN-00001 = "1" NC1734.2 +118500 PERFORM PASS NC1734.2 +118600 PERFORM PRINT-DETAIL NC1734.2 +118700 ELSE NC1734.2 +118800 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +118900 MOVE "1" TO CORRECT-X NC1734.2 +119000 MOVE "DIV-TEST-F3-20-7" TO PAR-NAME NC1734.2 +119100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +119200 PERFORM FAIL NC1734.2 +119300 PERFORM PRINT-DETAIL. NC1734.2 +119400* NC1734.2 +119500* NC1734.2 +119600 DIV-INIT-F3-21. NC1734.2 +119700* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +119800* ==--> MULTIPLE RESULT FIELDS <--== NC1734.2 +119900 MOVE "DIV-TEST-F3-21" TO PAR-NAME. NC1734.2 +120000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +120100 MOVE "0" TO WRK-XN-00001. NC1734.2 +120200 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +120300 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +120400 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +120500 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +120600 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +120700 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +120800 MOVE 1 TO REC-CT. NC1734.2 +120900 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +121000 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +121100 DIV-TEST-F3-21-0. NC1734.2 +121200 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +121300 GIVING WRK-DU-2V1-1 NC1734.2 +121400 WRK-DU-2V0-1 ROUNDED NC1734.2 +121500 WRK-DU-2V1-2 NC1734.2 +121600 WRK-DU-2V0-2 ROUNDED NC1734.2 +121700 WRK-DU-2V1-3 NC1734.2 +121800 WRK-DU-2V0-3 NC1734.2 +121900 ON SIZE ERROR NC1734.2 +122000 MOVE "1" TO WRK-XN-00001. NC1734.2 +122100 GO TO DIV-TEST-F3-21-1. NC1734.2 +122200 DIV-DELETE-F3-21. NC1734.2 +122300 PERFORM DE-LETE. NC1734.2 +122400 PERFORM PRINT-DETAIL. NC1734.2 +122500 GO TO DIV-INIT-F3-22. NC1734.2 +122600 DIV-TEST-F3-21-1. NC1734.2 +122700 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +122800 PERFORM PASS NC1734.2 +122900 PERFORM PRINT-DETAIL NC1734.2 +123000 ELSE NC1734.2 +123100 PERFORM FAIL NC1734.2 +123200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +123300 MOVE 2.5 TO CORRECT-N NC1734.2 +123400 PERFORM PRINT-DETAIL. NC1734.2 +123500 ADD 1 TO REC-CT. NC1734.2 +123600 DIV-TEST-F3-21-2. NC1734.2 +123700 IF WRK-DU-2V0-1 = 3 NC1734.2 +123800 PERFORM PASS NC1734.2 +123900 PERFORM PRINT-DETAIL NC1734.2 +124000 ELSE NC1734.2 +124100 PERFORM FAIL NC1734.2 +124200 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +124300 MOVE 3 TO CORRECT-N NC1734.2 +124400 PERFORM PRINT-DETAIL. NC1734.2 +124500 ADD 1 TO REC-CT. NC1734.2 +124600 DIV-TEST-F3-21-3. NC1734.2 +124700 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +124800 PERFORM PASS NC1734.2 +124900 PERFORM PRINT-DETAIL NC1734.2 +125000 ELSE NC1734.2 +125100 PERFORM FAIL NC1734.2 +125200 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +125300 MOVE 2.5 TO CORRECT-N NC1734.2 +125400 PERFORM PRINT-DETAIL. NC1734.2 +125500 ADD 1 TO REC-CT. NC1734.2 +125600 DIV-TEST-F3-21-4. NC1734.2 +125700 IF WRK-DU-2V0-2 = 3 NC1734.2 +125800 PERFORM PASS NC1734.2 +125900 PERFORM PRINT-DETAIL NC1734.2 +126000 ELSE NC1734.2 +126100 PERFORM FAIL NC1734.2 +126200 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +126300 MOVE 3 TO CORRECT-N NC1734.2 +126400 PERFORM PRINT-DETAIL. NC1734.2 +126500 ADD 1 TO REC-CT. NC1734.2 +126600 DIV-TEST-F3-21-5. NC1734.2 +126700 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +126800 PERFORM PASS NC1734.2 +126900 PERFORM PRINT-DETAIL NC1734.2 +127000 ELSE NC1734.2 +127100 PERFORM FAIL NC1734.2 +127200 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +127300 MOVE 2.5 TO CORRECT-N NC1734.2 +127400 PERFORM PRINT-DETAIL. NC1734.2 +127500 ADD 1 TO REC-CT. NC1734.2 +127600 DIV-TEST-F3-21-6. NC1734.2 +127700 IF WRK-DU-2V0-3 = 2 NC1734.2 +127800 PERFORM PASS NC1734.2 +127900 PERFORM PRINT-DETAIL NC1734.2 +128000 ELSE NC1734.2 +128100 PERFORM FAIL NC1734.2 +128200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +128300 MOVE 2 TO CORRECT-N NC1734.2 +128400 PERFORM PRINT-DETAIL. NC1734.2 +128500 ADD 1 TO REC-CT. NC1734.2 +128600 DIV-TEST-F3-21-7. NC1734.2 +128700 IF WRK-XN-00001 = "0" NC1734.2 +128800 PERFORM PASS NC1734.2 +128900 PERFORM PRINT-DETAIL NC1734.2 +129000 ELSE NC1734.2 +129100 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +129200 MOVE "0" TO CORRECT-X NC1734.2 +129300 MOVE "DIV-TEST-F3-21-7" TO PAR-NAME NC1734.2 +129400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +129500 TO RE-MARK NC1734.2 +129600 PERFORM FAIL NC1734.2 +129700 PERFORM PRINT-DETAIL. NC1734.2 +129800* NC1734.2 +129900* NC1734.2 +130000 DIV-INIT-F3-22. NC1734.2 +130100* ==--> SIZE ERROR CONDITION <--== NC1734.2 +130200* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +130300 MOVE "DIV-TEST-F3-22" TO PAR-NAME. NC1734.2 +130400 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +130500 MOVE "0" TO WRK-XN-00001. NC1734.2 +130600 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +130700 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +130800 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +130900 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +131000 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +131100 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +131200 MOVE 1 TO REC-CT. NC1734.2 +131300 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +131400 DIV-TEST-F3-22-0. NC1734.2 +131500 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +131600 GIVING WRK-DU-2V1-1 NC1734.2 +131700 WRK-DU-2V0-1 ROUNDED NC1734.2 +131800 WRK-DU-2V1-2 NC1734.2 +131900 WRK-DU-2V0-2 ROUNDED NC1734.2 +132000 WRK-DU-2V1-3 NC1734.2 +132100 WRK-DU-2V0-3 NC1734.2 +132200 NOT ON SIZE ERROR NC1734.2 +132300 MOVE "1" TO WRK-XN-00001. NC1734.2 +132400 GO TO DIV-TEST-F3-22-1. NC1734.2 +132500 DIV-DELETE-F3-22. NC1734.2 +132600 PERFORM DE-LETE. NC1734.2 +132700 PERFORM PRINT-DETAIL. NC1734.2 +132800 GO TO DIV-INIT-F3-23. NC1734.2 +132900 DIV-TEST-F3-22-1. NC1734.2 +133000 IF WRK-DU-2V1-1 = 0 NC1734.2 +133100 PERFORM PASS NC1734.2 +133200 PERFORM PRINT-DETAIL NC1734.2 +133300 ELSE NC1734.2 +133400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +133500 PERFORM FAIL NC1734.2 +133600 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +133700 MOVE 0 TO CORRECT-N NC1734.2 +133800 PERFORM PRINT-DETAIL. NC1734.2 +133900 ADD 1 TO REC-CT. NC1734.2 +134000 DIV-TEST-F3-22-2. NC1734.2 +134100 IF WRK-DU-2V0-1 = 99 NC1734.2 +134200 PERFORM PASS NC1734.2 +134300 PERFORM PRINT-DETAIL NC1734.2 +134400 ELSE NC1734.2 +134500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +134600 PERFORM FAIL NC1734.2 +134700 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +134800 MOVE 99 TO CORRECT-N NC1734.2 +134900 PERFORM PRINT-DETAIL. NC1734.2 +135000 ADD 1 TO REC-CT. NC1734.2 +135100 DIV-TEST-F3-22-3. NC1734.2 +135200 IF WRK-DU-2V1-2 = 0 NC1734.2 +135300 PERFORM PASS NC1734.2 +135400 PERFORM PRINT-DETAIL NC1734.2 +135500 ELSE NC1734.2 +135600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +135700 PERFORM FAIL NC1734.2 +135800 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +135900 MOVE 0 TO CORRECT-N NC1734.2 +136000 PERFORM PRINT-DETAIL. NC1734.2 +136100 ADD 1 TO REC-CT. NC1734.2 +136200 DIV-TEST-F3-22-4. NC1734.2 +136300 IF WRK-DU-2V0-2 = 0 NC1734.2 +136400 PERFORM PASS NC1734.2 +136500 PERFORM PRINT-DETAIL NC1734.2 +136600 ELSE NC1734.2 +136700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +136800 PERFORM FAIL NC1734.2 +136900 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +137000 MOVE 0 TO CORRECT-N NC1734.2 +137100 PERFORM PRINT-DETAIL. NC1734.2 +137200 ADD 1 TO REC-CT. NC1734.2 +137300 DIV-TEST-F3-22-5. NC1734.2 +137400 IF WRK-DU-2V1-3 = 0 NC1734.2 +137500 PERFORM PASS NC1734.2 +137600 PERFORM PRINT-DETAIL NC1734.2 +137700 ELSE NC1734.2 +137800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +137900 PERFORM FAIL NC1734.2 +138000 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +138100 MOVE 0 TO CORRECT-N NC1734.2 +138200 PERFORM PRINT-DETAIL. NC1734.2 +138300 ADD 1 TO REC-CT. NC1734.2 +138400 DIV-TEST-F3-22-6. NC1734.2 +138500 IF WRK-DU-2V0-3 = 0 NC1734.2 +138600 PERFORM PASS NC1734.2 +138700 PERFORM PRINT-DETAIL NC1734.2 +138800 ELSE NC1734.2 +138900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +139000 PERFORM FAIL NC1734.2 +139100 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +139200 MOVE 0 TO CORRECT-N NC1734.2 +139300 PERFORM PRINT-DETAIL. NC1734.2 +139400 ADD 1 TO REC-CT. NC1734.2 +139500 DIV-TEST-F3-22-7. NC1734.2 +139600 IF WRK-XN-00001 = "0" NC1734.2 +139700 PERFORM PASS NC1734.2 +139800 PERFORM PRINT-DETAIL NC1734.2 +139900 ELSE NC1734.2 +140000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +140100 MOVE "0" TO CORRECT-X NC1734.2 +140200 MOVE "DIV-TEST-F3-22-7" TO PAR-NAME NC1734.2 +140300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +140400 TO RE-MARK NC1734.2 +140500 PERFORM FAIL NC1734.2 +140600 PERFORM PRINT-DETAIL. NC1734.2 +140700* NC1734.2 +140800* NC1734.2 +140900 DIV-INIT-F3-23. NC1734.2 +141000* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +141100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +141200 MOVE "DIV-TEST-F3-23" TO PAR-NAME. NC1734.2 +141300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +141400 MOVE "0" TO WRK-XN-00001. NC1734.2 +141500 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +141600 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +141700 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +141800 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +141900 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +142000 MOVE 1 TO REC-CT. NC1734.2 +142100 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +142200 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +142300 DIV-TEST-F3-23-0. NC1734.2 +142400 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +142500 GIVING WRK-DU-2V1-1 NC1734.2 +142600 WRK-DU-2V0-1 ROUNDED NC1734.2 +142700 WRK-DU-2V1-2 NC1734.2 +142800 WRK-DU-2V0-2 ROUNDED NC1734.2 +142900 WRK-DU-2V1-3 NC1734.2 +143000 WRK-DU-2V0-3 NC1734.2 +143100 NOT ON SIZE ERROR NC1734.2 +143200 MOVE "1" TO WRK-XN-00001. NC1734.2 +143300 GO TO DIV-TEST-F3-23-1. NC1734.2 +143400 DIV-DELETE-F3-23. NC1734.2 +143500 PERFORM DE-LETE. NC1734.2 +143600 PERFORM PRINT-DETAIL. NC1734.2 +143700 GO TO DIV-INIT-F3-24. NC1734.2 +143800 DIV-TEST-F3-23-1. NC1734.2 +143900 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +144000 PERFORM PASS NC1734.2 +144100 PERFORM PRINT-DETAIL NC1734.2 +144200 ELSE NC1734.2 +144300 PERFORM FAIL NC1734.2 +144400 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +144500 MOVE 2.5 TO CORRECT-N NC1734.2 +144600 PERFORM PRINT-DETAIL. NC1734.2 +144700 ADD 1 TO REC-CT. NC1734.2 +144800 DIV-TEST-F3-23-2. NC1734.2 +144900 IF WRK-DU-2V0-1 = 3 NC1734.2 +145000 PERFORM PASS NC1734.2 +145100 PERFORM PRINT-DETAIL NC1734.2 +145200 ELSE NC1734.2 +145300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +145400 PERFORM FAIL NC1734.2 +145500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +145600 MOVE 3 TO CORRECT-N NC1734.2 +145700 PERFORM PRINT-DETAIL. NC1734.2 +145800 ADD 1 TO REC-CT. NC1734.2 +145900 DIV-TEST-F3-23-3. NC1734.2 +146000 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +146100 PERFORM PASS NC1734.2 +146200 PERFORM PRINT-DETAIL NC1734.2 +146300 ELSE NC1734.2 +146400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +146500 PERFORM FAIL NC1734.2 +146600 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +146700 MOVE 2.5 TO CORRECT-N NC1734.2 +146800 PERFORM PRINT-DETAIL. NC1734.2 +146900 ADD 1 TO REC-CT. NC1734.2 +147000 DIV-TEST-F3-23-4. NC1734.2 +147100 IF WRK-DU-2V0-2 = 3 NC1734.2 +147200 PERFORM PASS NC1734.2 +147300 PERFORM PRINT-DETAIL NC1734.2 +147400 ELSE NC1734.2 +147500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +147600 PERFORM FAIL NC1734.2 +147700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +147800 MOVE 3 TO CORRECT-N NC1734.2 +147900 PERFORM PRINT-DETAIL. NC1734.2 +148000 ADD 1 TO REC-CT. NC1734.2 +148100 DIV-TEST-F3-23-5. NC1734.2 +148200 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +148300 PERFORM PASS NC1734.2 +148400 PERFORM PRINT-DETAIL NC1734.2 +148500 ELSE NC1734.2 +148600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +148700 PERFORM FAIL NC1734.2 +148800 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +148900 MOVE 2.5 TO CORRECT-N NC1734.2 +149000 PERFORM PRINT-DETAIL. NC1734.2 +149100 ADD 1 TO REC-CT. NC1734.2 +149200 DIV-TEST-F3-23-6. NC1734.2 +149300 IF WRK-DU-2V0-3 = 2 NC1734.2 +149400 PERFORM PASS NC1734.2 +149500 PERFORM PRINT-DETAIL NC1734.2 +149600 ELSE NC1734.2 +149700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +149800 PERFORM FAIL NC1734.2 +149900 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +150000 MOVE 2 TO CORRECT-N NC1734.2 +150100 PERFORM PRINT-DETAIL. NC1734.2 +150200 ADD 1 TO REC-CT. NC1734.2 +150300 DIV-TEST-F3-23-7. NC1734.2 +150400 IF WRK-XN-00001 = "1" NC1734.2 +150500 PERFORM PASS NC1734.2 +150600 PERFORM PRINT-DETAIL NC1734.2 +150700 ELSE NC1734.2 +150800 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +150900 MOVE "1" TO CORRECT-X NC1734.2 +151000 MOVE "DIV-TEST-F3-23-7" TO PAR-NAME NC1734.2 +151100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +151200 TO RE-MARK NC1734.2 +151300 PERFORM FAIL NC1734.2 +151400 PERFORM PRINT-DETAIL. NC1734.2 +151500* NC1734.2 +151600* NC1734.2 +151700 DIV-INIT-F3-24. NC1734.2 +151800* ==--> SIZE ERROR CONDITION <--== NC1734.2 +151900* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +152000 MOVE "DIV-TEST-F3-24" TO PAR-NAME. NC1734.2 +152100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +152200 MOVE "0" TO WRK-XN-00001. NC1734.2 +152300 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +152400 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +152500 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +152600 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +152700 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +152800 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +152900 MOVE 1 TO REC-CT. NC1734.2 +153000 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +153100 DIV-TEST-F3-24-0. NC1734.2 +153200 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +153300 GIVING WRK-DU-2V1-1 NC1734.2 +153400 WRK-DU-2V0-1 ROUNDED NC1734.2 +153500 WRK-DU-2V1-2 NC1734.2 +153600 WRK-DU-2V0-2 ROUNDED NC1734.2 +153700 WRK-DU-2V1-3 NC1734.2 +153800 WRK-DU-2V0-3 NC1734.2 +153900 ON SIZE ERROR NC1734.2 +154000 MOVE "1" TO WRK-XN-00001 NC1734.2 +154100 NOT ON SIZE ERROR NC1734.2 +154200 MOVE "2" TO WRK-XN-00001. NC1734.2 +154300 GO TO DIV-TEST-F3-24-1. NC1734.2 +154400 DIV-DELETE-F3-24. NC1734.2 +154500 PERFORM DE-LETE. NC1734.2 +154600 PERFORM PRINT-DETAIL. NC1734.2 +154700 GO TO DIV-INIT-F3-25. NC1734.2 +154800 DIV-TEST-F3-24-1. NC1734.2 +154900 IF WRK-DU-2V1-1 = 0 NC1734.2 +155000 PERFORM PASS NC1734.2 +155100 PERFORM PRINT-DETAIL NC1734.2 +155200 ELSE NC1734.2 +155300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +155400 PERFORM FAIL NC1734.2 +155500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +155600 MOVE 0 TO CORRECT-N NC1734.2 +155700 PERFORM PRINT-DETAIL. NC1734.2 +155800 ADD 1 TO REC-CT. NC1734.2 +155900 DIV-TEST-F3-24-2. NC1734.2 +156000 IF WRK-DU-2V0-1 = 99 NC1734.2 +156100 PERFORM PASS NC1734.2 +156200 PERFORM PRINT-DETAIL NC1734.2 +156300 ELSE NC1734.2 +156400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +156500 PERFORM FAIL NC1734.2 +156600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +156700 MOVE 99 TO CORRECT-N NC1734.2 +156800 PERFORM PRINT-DETAIL. NC1734.2 +156900 ADD 1 TO REC-CT. NC1734.2 +157000 DIV-TEST-F3-24-3. NC1734.2 +157100 IF WRK-DU-2V1-2 = 0 NC1734.2 +157200 PERFORM PASS NC1734.2 +157300 PERFORM PRINT-DETAIL NC1734.2 +157400 ELSE NC1734.2 +157500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +157600 PERFORM FAIL NC1734.2 +157700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +157800 MOVE 0 TO CORRECT-N NC1734.2 +157900 PERFORM PRINT-DETAIL. NC1734.2 +158000 ADD 1 TO REC-CT. NC1734.2 +158100 DIV-TEST-F3-24-4. NC1734.2 +158200 IF WRK-DU-2V0-2 = 0 NC1734.2 +158300 PERFORM PASS NC1734.2 +158400 PERFORM PRINT-DETAIL NC1734.2 +158500 ELSE NC1734.2 +158600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +158700 PERFORM FAIL NC1734.2 +158800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +158900 MOVE 0 TO CORRECT-N NC1734.2 +159000 PERFORM PRINT-DETAIL. NC1734.2 +159100 ADD 1 TO REC-CT. NC1734.2 +159200 DIV-TEST-F3-24-5. NC1734.2 +159300 IF WRK-DU-2V1-3 = 0 NC1734.2 +159400 PERFORM PASS NC1734.2 +159500 PERFORM PRINT-DETAIL NC1734.2 +159600 ELSE NC1734.2 +159700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +159800 PERFORM FAIL NC1734.2 +159900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +160000 MOVE 0 TO CORRECT-N NC1734.2 +160100 PERFORM PRINT-DETAIL. NC1734.2 +160200 ADD 1 TO REC-CT. NC1734.2 +160300 DIV-TEST-F3-24-6. NC1734.2 +160400 IF WRK-DU-2V0-3 = 0 NC1734.2 +160500 PERFORM PASS NC1734.2 +160600 PERFORM PRINT-DETAIL NC1734.2 +160700 ELSE NC1734.2 +160800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +160900 PERFORM FAIL NC1734.2 +161000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +161100 MOVE 0 TO CORRECT-N NC1734.2 +161200 PERFORM PRINT-DETAIL. NC1734.2 +161300 ADD 1 TO REC-CT. NC1734.2 +161400 DIV-TEST-F3-24-7. NC1734.2 +161500 IF WRK-XN-00001 = "1" NC1734.2 +161600 PERFORM PASS NC1734.2 +161700 PERFORM PRINT-DETAIL NC1734.2 +161800 ELSE NC1734.2 +161900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +162000 MOVE "1" TO CORRECT-X NC1734.2 +162100 MOVE "DIV-TEST-F3-24-7" TO PAR-NAME NC1734.2 +162200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +162300 TO RE-MARK NC1734.2 +162400 PERFORM FAIL NC1734.2 +162500 PERFORM PRINT-DETAIL. NC1734.2 +162600* NC1734.2 +162700* NC1734.2 +162800 DIV-INIT-F3-25. NC1734.2 +162900* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +163000* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +163100 MOVE "DIV-TEST-F3-25" TO PAR-NAME. NC1734.2 +163200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +163300 MOVE "0" TO WRK-XN-00001. NC1734.2 +163400 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +163500 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +163600 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +163700 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +163800 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +163900 MOVE 1 TO REC-CT. NC1734.2 +164000 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +164100 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +164200 DIV-TEST-F3-25-0. NC1734.2 +164300 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +164400 GIVING WRK-DU-2V1-1 NC1734.2 +164500 WRK-DU-2V0-1 ROUNDED NC1734.2 +164600 WRK-DU-2V1-2 NC1734.2 +164700 WRK-DU-2V0-2 ROUNDED NC1734.2 +164800 WRK-DU-2V1-3 NC1734.2 +164900 WRK-DU-2V0-3 NC1734.2 +165000 ON SIZE ERROR NC1734.2 +165100 MOVE "1" TO WRK-XN-00001 NC1734.2 +165200 NOT ON SIZE ERROR NC1734.2 +165300 MOVE "2" TO WRK-XN-00001. NC1734.2 +165400 GO TO DIV-TEST-F3-25-1. NC1734.2 +165500 DIV-DELETE-F3-25. NC1734.2 +165600 PERFORM DE-LETE. NC1734.2 +165700 PERFORM PRINT-DETAIL. NC1734.2 +165800 GO TO DIV-INIT-F3-26. NC1734.2 +165900 DIV-TEST-F3-25-1. NC1734.2 +166000 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +166100 PERFORM PASS NC1734.2 +166200 PERFORM PRINT-DETAIL NC1734.2 +166300 ELSE NC1734.2 +166400 PERFORM FAIL NC1734.2 +166500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +166600 MOVE 2.5 TO CORRECT-N NC1734.2 +166700 PERFORM PRINT-DETAIL. NC1734.2 +166800 ADD 1 TO REC-CT. NC1734.2 +166900 DIV-TEST-F3-25-2. NC1734.2 +167000 IF WRK-DU-2V0-1 = 3 NC1734.2 +167100 PERFORM PASS NC1734.2 +167200 PERFORM PRINT-DETAIL NC1734.2 +167300 ELSE NC1734.2 +167400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +167500 PERFORM FAIL NC1734.2 +167600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +167700 MOVE 3 TO CORRECT-N NC1734.2 +167800 PERFORM PRINT-DETAIL. NC1734.2 +167900 ADD 1 TO REC-CT. NC1734.2 +168000 DIV-TEST-F3-25-3. NC1734.2 +168100 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +168200 PERFORM PASS NC1734.2 +168300 PERFORM PRINT-DETAIL NC1734.2 +168400 ELSE NC1734.2 +168500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +168600 PERFORM FAIL NC1734.2 +168700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +168800 MOVE 2.5 TO CORRECT-N NC1734.2 +168900 PERFORM PRINT-DETAIL. NC1734.2 +169000 ADD 1 TO REC-CT. NC1734.2 +169100 DIV-TEST-F3-25-4. NC1734.2 +169200 IF WRK-DU-2V0-2 = 3 NC1734.2 +169300 PERFORM PASS NC1734.2 +169400 PERFORM PRINT-DETAIL NC1734.2 +169500 ELSE NC1734.2 +169600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +169700 PERFORM FAIL NC1734.2 +169800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +169900 MOVE 3 TO CORRECT-N NC1734.2 +170000 PERFORM PRINT-DETAIL. NC1734.2 +170100 ADD 1 TO REC-CT. NC1734.2 +170200 DIV-TEST-F3-25-5. NC1734.2 +170300 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +170400 PERFORM PASS NC1734.2 +170500 PERFORM PRINT-DETAIL NC1734.2 +170600 ELSE NC1734.2 +170700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +170800 PERFORM FAIL NC1734.2 +170900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +171000 MOVE 2.5 TO CORRECT-N NC1734.2 +171100 PERFORM PRINT-DETAIL. NC1734.2 +171200 ADD 1 TO REC-CT. NC1734.2 +171300 DIV-TEST-F3-25-6. NC1734.2 +171400 IF WRK-DU-2V0-3 = 2 NC1734.2 +171500 PERFORM PASS NC1734.2 +171600 PERFORM PRINT-DETAIL NC1734.2 +171700 ELSE NC1734.2 +171800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +171900 PERFORM FAIL NC1734.2 +172000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +172100 MOVE 2 TO CORRECT-N NC1734.2 +172200 PERFORM PRINT-DETAIL. NC1734.2 +172300 ADD 1 TO REC-CT. NC1734.2 +172400 DIV-TEST-F3-25-7. NC1734.2 +172500 IF WRK-XN-00001 = "2" NC1734.2 +172600 PERFORM PASS NC1734.2 +172700 PERFORM PRINT-DETAIL NC1734.2 +172800 ELSE NC1734.2 +172900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +173000 MOVE "2" TO CORRECT-X NC1734.2 +173100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +173200 TO RE-MARK NC1734.2 +173300 PERFORM FAIL NC1734.2 +173400 PERFORM PRINT-DETAIL. NC1734.2 +173500* NC1734.2 +173600* NC1734.2 +173700 DIV-INIT-F3-26. NC1734.2 +173800* ==--> SIZE ERROR CONDITION <--== NC1734.2 +173900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +174000 MOVE "DIV-TEST-F3-26" TO PAR-NAME. NC1734.2 +174100 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +174200 MOVE 44.1 TO DIV2. NC1734.2 +174300 MOVE -9.642 TO DIV4. NC1734.2 +174400 MOVE 0 TO DIV10. NC1734.2 +174500 MOVE 0 TO WRK-XN-00001. NC1734.2 +174600 MOVE 0 TO WRK-DS-05V00. NC1734.2 +174700 MOVE "A" TO XRAY. NC1734.2 +174800 MOVE 1 TO REC-CT. NC1734.2 +174900 DIV-TEST-F3-26-0. NC1734.2 +175000 DIVIDE DIV2 BY DIV4 NC1734.2 +175100 GIVING DIV10 NC1734.2 +175200 ON SIZE ERROR NC1734.2 +175300 MOVE "P" TO XRAY NC1734.2 +175400 MOVE "1" TO WRK-XN-00001 NC1734.2 +175500 MOVE 23 TO WRK-DS-05V00 NC1734.2 +175600 END-DIVIDE NC1734.2 +175700 MOVE 99 TO WRK-CS-18V00. NC1734.2 +175800 GO TO DIV-TEST-F3-26-1. NC1734.2 +175900 DIV-DELETE-F3-26. NC1734.2 +176000 PERFORM DE-LETE. NC1734.2 +176100 PERFORM PRINT-DETAIL. NC1734.2 +176200 GO TO DIV-INIT-F3-27. NC1734.2 +176300 DIV-TEST-F3-26-1. NC1734.2 +176400 MOVE "DIV-TEST-F3-26-1" TO PAR-NAME. NC1734.2 +176500 IF DIV10 = 0 NC1734.2 +176600 PERFORM PASS NC1734.2 +176700 PERFORM PRINT-DETAIL NC1734.2 +176800 ELSE NC1734.2 +176900 MOVE DIV10 TO COMPUTED-N NC1734.2 +177000 MOVE 0 TO CORRECT-N NC1734.2 +177100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +177200 PERFORM FAIL NC1734.2 +177300 PERFORM PRINT-DETAIL. NC1734.2 +177400 ADD 1 TO REC-CT. NC1734.2 +177500 DIV-TEST-F3-26-2. NC1734.2 +177600 MOVE "DIV-TEST-F3-26-2" TO PAR-NAME. NC1734.2 +177700 IF XRAY = "P" NC1734.2 +177800 PERFORM PASS NC1734.2 +177900 PERFORM PRINT-DETAIL NC1734.2 +178000 ELSE NC1734.2 +178100 MOVE XRAY TO COMPUTED-X NC1734.2 +178200 MOVE "P" TO CORRECT-X NC1734.2 +178300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +178400 PERFORM FAIL NC1734.2 +178500 PERFORM PRINT-DETAIL. NC1734.2 +178600 ADD 1 TO REC-CT. NC1734.2 +178700 DIV-TEST-F3-26-3. NC1734.2 +178800 MOVE "DIV-TEST-F3-26-3" TO PAR-NAME. NC1734.2 +178900 IF WRK-XN-00001 = "1" NC1734.2 +179000 PERFORM PASS NC1734.2 +179100 PERFORM PRINT-DETAIL NC1734.2 +179200 ELSE NC1734.2 +179300 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +179400 MOVE "1" TO CORRECT-X NC1734.2 +179500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +179600 PERFORM FAIL NC1734.2 +179700 PERFORM PRINT-DETAIL. NC1734.2 +179800 ADD 1 TO REC-CT. NC1734.2 +179900 DIV-TEST-F3-26-4. NC1734.2 +180000 MOVE "DIV-TEST-F3-26-4" TO PAR-NAME. NC1734.2 +180100 IF WRK-DS-05V00 = 23 NC1734.2 +180200 PERFORM PASS NC1734.2 +180300 PERFORM PRINT-DETAIL NC1734.2 +180400 ELSE NC1734.2 +180500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +180600 MOVE 23 TO CORRECT-N NC1734.2 +180700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +180800 PERFORM FAIL NC1734.2 +180900 PERFORM PRINT-DETAIL. NC1734.2 +181000 ADD 1 TO REC-CT. NC1734.2 +181100 DIV-TEST-F3-26-5. NC1734.2 +181200 MOVE "DIV-TEST-F3-26-5" TO PAR-NAME. NC1734.2 +181300 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +181400 PERFORM PASS NC1734.2 +181500 PERFORM PRINT-DETAIL NC1734.2 +181600 ELSE NC1734.2 +181700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1734.2 +181800 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +181900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +182000 PERFORM FAIL NC1734.2 +182100 PERFORM PRINT-DETAIL. NC1734.2 +182200* NC1734.2 +182300* NC1734.2 +182400 DIV-INIT-F3-27. NC1734.2 +182500* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +182600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +182700 MOVE "DIV-TEST-F3-27" TO PAR-NAME. NC1734.2 +182800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +182900 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +183000 MOVE "0" TO WRK-XN-00001. NC1734.2 +183100 MOVE 0 TO WRK-DS-05V00. NC1734.2 +183200 MOVE 0 TO WRK-DS-02V00. NC1734.2 +183300 MOVE 0 TO WRK-CS-18V00. NC1734.2 +183400 MOVE 1 TO REC-CT. NC1734.2 +183500 DIV-TEST-F3-27-0. NC1734.2 +183600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +183700 GIVING WRK-DS-09V09 NC1734.2 +183800 ON SIZE ERROR NC1734.2 +183900 MOVE "1" TO WRK-XN-00001 NC1734.2 +184000 MOVE 23 TO WRK-DS-05V00 NC1734.2 +184100 MOVE -4 TO WRK-DS-02V00 NC1734.2 +184200 END-DIVIDE NC1734.2 +184300 MOVE 99 TO WRK-CS-18V00. NC1734.2 +184400 GO TO DIV-TEST-F3-27-1. NC1734.2 +184500 DIV-DELETE-F3-27-1. NC1734.2 +184600 PERFORM DE-LETE. NC1734.2 +184700 PERFORM PRINT-DETAIL. NC1734.2 +184800 GO TO DIV-INIT-F3-28. NC1734.2 +184900 DIV-TEST-F3-27-1. NC1734.2 +185000 MOVE "DIV-TEST-F3-27-1" TO PAR-NAME. NC1734.2 +185100 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +185200 PERFORM PASS NC1734.2 +185300 PERFORM PRINT-DETAIL NC1734.2 +185400 ELSE NC1734.2 +185500 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +185600 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +185700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +185800 PERFORM FAIL NC1734.2 +185900 PERFORM PRINT-DETAIL. NC1734.2 +186000 ADD 1 TO REC-CT. NC1734.2 +186100 DIV-TEST-F3-27-2. NC1734.2 +186200 MOVE "DIV-TEST-F3-27-2" TO PAR-NAME. NC1734.2 +186300 IF WRK-DS-02V00 = 00 NC1734.2 +186400 PERFORM PASS NC1734.2 +186500 PERFORM PRINT-DETAIL NC1734.2 +186600 ELSE NC1734.2 +186700 MOVE WRK-DS-02V00 TO COMPUTED-N NC1734.2 +186800 MOVE 00 TO CORRECT-N NC1734.2 +186900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +187000 TO RE-MARK NC1734.2 +187100 PERFORM FAIL NC1734.2 +187200 PERFORM PRINT-DETAIL. NC1734.2 +187300 ADD 1 TO REC-CT. NC1734.2 +187400 DIV-TEST-F3-27-3. NC1734.2 +187500 MOVE "DIV-TEST-F3-27-3" TO PAR-NAME. NC1734.2 +187600 IF WRK-XN-00001 = "0" NC1734.2 +187700 PERFORM PASS NC1734.2 +187800 PERFORM PRINT-DETAIL NC1734.2 +187900 ELSE NC1734.2 +188000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +188100 MOVE "0" TO CORRECT-X NC1734.2 +188200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +188300 TO RE-MARK NC1734.2 +188400 PERFORM FAIL NC1734.2 +188500 PERFORM PRINT-DETAIL. NC1734.2 +188600 ADD 1 TO REC-CT. NC1734.2 +188700 DIV-TEST-F3-27-4. NC1734.2 +188800 MOVE "DIV-TEST-F3-27-4" TO PAR-NAME. NC1734.2 +188900 IF WRK-DS-05V00 = 0 NC1734.2 +189000 PERFORM PASS NC1734.2 +189100 PERFORM PRINT-DETAIL NC1734.2 +189200 ELSE NC1734.2 +189300 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +189400 MOVE 0 TO CORRECT-N NC1734.2 +189500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +189600 TO RE-MARK NC1734.2 +189700 PERFORM FAIL NC1734.2 +189800 PERFORM PRINT-DETAIL. NC1734.2 +189900 ADD 1 TO REC-CT. NC1734.2 +190000 DIV-TEST-F3-27-5. NC1734.2 +190100 MOVE "DIV-TEST-F3-27-5" TO PAR-NAME. NC1734.2 +190200 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +190300 PERFORM PASS NC1734.2 +190400 PERFORM PRINT-DETAIL NC1734.2 +190500 ELSE NC1734.2 +190600 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +190700 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +190800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +190900 PERFORM FAIL NC1734.2 +191000 PERFORM PRINT-DETAIL. NC1734.2 +191100* NC1734.2 +191200 DIV-INIT-F3-28. NC1734.2 +191300* ==--> SIZE ERROR CONDITION <--== NC1734.2 +191400* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +191500 MOVE "DIV-TEST-F3-28" TO PAR-NAME. NC1734.2 +191600 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +191700 MOVE 44.1 TO DIV2. NC1734.2 +191800 MOVE -9.642 TO DIV4. NC1734.2 +191900 MOVE 0 TO DIV10. NC1734.2 +192000 MOVE "0" TO WRK-XN-00001. NC1734.2 +192100 MOVE 0 TO WRK-DS-05V00. NC1734.2 +192200 MOVE "A" TO XRAY. NC1734.2 +192300 MOVE 1 TO REC-CT. NC1734.2 +192400 DIV-TEST-F3-28-0. NC1734.2 +192500 DIVIDE DIV2 BY DIV4 NC1734.2 +192600 GIVING DIV10 NC1734.2 +192700 NOT ON SIZE ERROR NC1734.2 +192800 MOVE "P" TO XRAY NC1734.2 +192900 MOVE "1" TO WRK-XN-00001 NC1734.2 +193000 MOVE 23 TO WRK-DS-05V00 NC1734.2 +193100 END-DIVIDE NC1734.2 +193200 MOVE 99 TO WRK-CS-18V00. NC1734.2 +193300 GO TO DIV-TEST-F3-28-1. NC1734.2 +193400 DIV-DELETE-F3-28-1. NC1734.2 +193500 PERFORM DE-LETE. NC1734.2 +193600 PERFORM PRINT-DETAIL. NC1734.2 +193700 GO TO DIV-INIT-F3-29. NC1734.2 +193800 DIV-TEST-F3-28-1. NC1734.2 +193900 MOVE "DIV-TEST-F3-28-1" TO PAR-NAME. NC1734.2 +194000 IF DIV10 = 0 NC1734.2 +194100 PERFORM PASS NC1734.2 +194200 PERFORM PRINT-DETAIL NC1734.2 +194300 ELSE NC1734.2 +194400 MOVE DIV10 TO COMPUTED-N NC1734.2 +194500 MOVE 0 TO CORRECT-N NC1734.2 +194600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1734.2 +194700 TO RE-MARK NC1734.2 +194800 PERFORM FAIL NC1734.2 +194900 PERFORM PRINT-DETAIL. NC1734.2 +195000 ADD 1 TO REC-CT. NC1734.2 +195100 DIV-TEST-F3-28-2. NC1734.2 +195200 MOVE "DIV-TEST-F3-28-2" TO PAR-NAME. NC1734.2 +195300 IF XRAY = "A" NC1734.2 +195400 PERFORM PASS NC1734.2 +195500 PERFORM PRINT-DETAIL NC1734.2 +195600 ELSE NC1734.2 +195700 MOVE XRAY TO COMPUTED-X NC1734.2 +195800 MOVE "A" TO CORRECT-X NC1734.2 +195900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +196000 TO RE-MARK NC1734.2 +196100 PERFORM FAIL NC1734.2 +196200 PERFORM PRINT-DETAIL. NC1734.2 +196300 ADD 1 TO REC-CT. NC1734.2 +196400 DIV-TEST-F3-28-3. NC1734.2 +196500 MOVE "DIV-TEST-F3-28-3" TO PAR-NAME. NC1734.2 +196600 IF WRK-XN-00001 = "0" NC1734.2 +196700 PERFORM PASS NC1734.2 +196800 PERFORM PRINT-DETAIL NC1734.2 +196900 ELSE NC1734.2 +197000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +197100 MOVE "0" TO CORRECT-X NC1734.2 +197200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +197300 TO RE-MARK NC1734.2 +197400 PERFORM FAIL NC1734.2 +197500 PERFORM PRINT-DETAIL. NC1734.2 +197600 ADD 1 TO REC-CT. NC1734.2 +197700 DIV-TEST-F3-28-4. NC1734.2 +197800 MOVE "DIV-TEST-F3-28-4" TO PAR-NAME. NC1734.2 +197900 IF WRK-DS-05V00 = 00000 NC1734.2 +198000 PERFORM PASS NC1734.2 +198100 PERFORM PRINT-DETAIL NC1734.2 +198200 ELSE NC1734.2 +198300 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +198400 MOVE 00000 TO CORRECT-N NC1734.2 +198500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +198600 TO RE-MARK NC1734.2 +198700 PERFORM FAIL NC1734.2 +198800 PERFORM PRINT-DETAIL. NC1734.2 +198900 ADD 1 TO REC-CT. NC1734.2 +199000 DIV-TEST-F3-28-5. NC1734.2 +199100 MOVE "DIV-TEST-F3-28-5" TO PAR-NAME. NC1734.2 +199200 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +199300 PERFORM PASS NC1734.2 +199400 PERFORM PRINT-DETAIL NC1734.2 +199500 ELSE NC1734.2 +199600 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +199700 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +199800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +199900 PERFORM FAIL NC1734.2 +200000 PERFORM PRINT-DETAIL. NC1734.2 +200100* NC1734.2 +200200* NC1734.2 +200300 DIV-INIT-F3-29. NC1734.2 +200400* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +200500* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +200600 MOVE "DIV-TEST-F3-29" TO PAR-NAME. NC1734.2 +200700 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +200800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +200900 MOVE "0" TO WRK-XN-00001. NC1734.2 +201000 MOVE 0 TO WRK-DS-05V00. NC1734.2 +201100 MOVE 0 TO WRK-DS-02V00. NC1734.2 +201200 MOVE 0 TO WRK-CS-18V00. NC1734.2 +201300 MOVE 1 TO REC-CT. NC1734.2 +201400 DIV-TEST-F3-29-0. NC1734.2 +201500 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +201600 GIVING WRK-DS-09V09 NC1734.2 +201700 NOT ON SIZE ERROR NC1734.2 +201800 MOVE "1" TO WRK-XN-00001 NC1734.2 +201900 MOVE 23 TO WRK-DS-05V00 NC1734.2 +202000 MOVE -4 TO WRK-DS-02V00 NC1734.2 +202100 END-DIVIDE NC1734.2 +202200 MOVE 99 TO WRK-CS-18V00. NC1734.2 +202300 GO TO DIV-TEST-F3-29-1. NC1734.2 +202400 DIV-DELETE-F3-29-1. NC1734.2 +202500 PERFORM DE-LETE. NC1734.2 +202600 PERFORM PRINT-DETAIL. NC1734.2 +202700 GO TO DIV-INIT-F3-30. NC1734.2 +202800 DIV-TEST-F3-29-1. NC1734.2 +202900 MOVE "DIV-TEST-F3-29-1" TO PAR-NAME. NC1734.2 +203000 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +203100 PERFORM PASS NC1734.2 +203200 PERFORM PRINT-DETAIL NC1734.2 +203300 ELSE NC1734.2 +203400 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +203500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +203600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +203700 PERFORM FAIL NC1734.2 +203800 PERFORM PRINT-DETAIL. NC1734.2 +203900 ADD 1 TO REC-CT. NC1734.2 +204000 DIV-TEST-F3-29-2. NC1734.2 +204100 MOVE "DIV-TEST-F3-29-2" TO PAR-NAME. NC1734.2 +204200 IF WRK-DS-02V00 = -4 NC1734.2 +204300 PERFORM PASS NC1734.2 +204400 PERFORM PRINT-DETAIL NC1734.2 +204500 ELSE NC1734.2 +204600 MOVE WRK-DS-02V00 TO COMPUTED-N NC1734.2 +204700 MOVE -4 TO CORRECT-N NC1734.2 +204800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +204900 TO RE-MARK NC1734.2 +205000 PERFORM FAIL NC1734.2 +205100 PERFORM PRINT-DETAIL. NC1734.2 +205200 ADD 1 TO REC-CT. NC1734.2 +205300 DIV-TEST-F3-29-3. NC1734.2 +205400 MOVE "DIV-TEST-F3-29-3" TO PAR-NAME. NC1734.2 +205500 IF WRK-XN-00001 = "1" NC1734.2 +205600 PERFORM PASS NC1734.2 +205700 PERFORM PRINT-DETAIL NC1734.2 +205800 ELSE NC1734.2 +205900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +206000 MOVE "1" TO CORRECT-X NC1734.2 +206100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +206200 TO RE-MARK NC1734.2 +206300 PERFORM FAIL NC1734.2 +206400 PERFORM PRINT-DETAIL. NC1734.2 +206500 ADD 1 TO REC-CT. NC1734.2 +206600 DIV-TEST-F3-29-4. NC1734.2 +206700 MOVE "DIV-TEST-F3-29-4" TO PAR-NAME. NC1734.2 +206800 IF WRK-DS-05V00 = 23 NC1734.2 +206900 PERFORM PASS NC1734.2 +207000 PERFORM PRINT-DETAIL NC1734.2 +207100 ELSE NC1734.2 +207200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +207300 MOVE 23 TO CORRECT-N NC1734.2 +207400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +207500 TO RE-MARK NC1734.2 +207600 PERFORM FAIL NC1734.2 +207700 PERFORM PRINT-DETAIL. NC1734.2 +207800 ADD 1 TO REC-CT. NC1734.2 +207900 DIV-TEST-F3-29-5. NC1734.2 +208000 MOVE "DIV-TEST-F3-29-5" TO PAR-NAME. NC1734.2 +208100 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +208200 PERFORM PASS NC1734.2 +208300 PERFORM PRINT-DETAIL NC1734.2 +208400 ELSE NC1734.2 +208500 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +208600 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +208700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +208800 PERFORM FAIL NC1734.2 +208900 PERFORM PRINT-DETAIL. NC1734.2 +209000* NC1734.2 +209100 DIV-INIT-F3-30. NC1734.2 +209200* ==--> SIZE ERROR CONDITION <--== NC1734.2 +209300* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +209400 MOVE "DIV-TEST-F3-30" TO PAR-NAME. NC1734.2 +209500 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +209600 MOVE 44.1 TO DIV2. NC1734.2 +209700 MOVE -9.642 TO DIV4. NC1734.2 +209800 MOVE 0 TO DIV10. NC1734.2 +209900 MOVE 0 TO WRK-CS-18V00. NC1734.2 +210000 MOVE "A" TO XRAY. NC1734.2 +210100 MOVE 1 TO REC-CT. NC1734.2 +210200 DIV-TEST-F3-30-0. NC1734.2 +210300 DIVIDE DIV2 BY DIV4 NC1734.2 +210400 GIVING DIV10 NC1734.2 +210500 ON SIZE ERROR NC1734.2 +210600 MOVE "E" TO XRAY NC1734.2 +210700 NOT ON SIZE ERROR NC1734.2 +210800 MOVE "N" TO XRAY NC1734.2 +210900 END-DIVIDE NC1734.2 +211000 MOVE 99 TO WRK-CS-18V00. NC1734.2 +211100 GO TO DIV-TEST-F3-30-1. NC1734.2 +211200 DIV-DELETE-F3-30. NC1734.2 +211300 PERFORM DE-LETE. NC1734.2 +211400 PERFORM PRINT-DETAIL. NC1734.2 +211500 GO TO DIV-INIT-F3-31. NC1734.2 +211600 DIV-TEST-F3-30-1. NC1734.2 +211700 MOVE "DIV-TEST-F3-30-1" TO PAR-NAME. NC1734.2 +211800 IF DIV10 = 0 NC1734.2 +211900 PERFORM PASS NC1734.2 +212000 PERFORM PRINT-DETAIL NC1734.2 +212100 ELSE NC1734.2 +212200 MOVE DIV10 TO COMPUTED-N NC1734.2 +212300 MOVE 0 TO CORRECT-N NC1734.2 +212400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1734.2 +212500 TO RE-MARK NC1734.2 +212600 PERFORM FAIL NC1734.2 +212700 PERFORM PRINT-DETAIL. NC1734.2 +212800 ADD 1 TO REC-CT. NC1734.2 +212900 DIV-TEST-F3-30-2. NC1734.2 +213000 MOVE "DIV-TEST-F3-30-2" TO PAR-NAME. NC1734.2 +213100 IF XRAY = "E" NC1734.2 +213200 PERFORM PASS NC1734.2 +213300 PERFORM PRINT-DETAIL NC1734.2 +213400 ELSE NC1734.2 +213500 MOVE XRAY TO COMPUTED-X NC1734.2 +213600 MOVE "E" TO CORRECT-X NC1734.2 +213700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +213800 TO RE-MARK NC1734.2 +213900 PERFORM FAIL NC1734.2 +214000 PERFORM PRINT-DETAIL. NC1734.2 +214100 ADD 1 TO REC-CT. NC1734.2 +214200 DIV-TEST-F3-30-3. NC1734.2 +214300 MOVE "DIV-TEST-F3-30-3" TO PAR-NAME. NC1734.2 +214400 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +214500 PERFORM PASS NC1734.2 +214600 PERFORM PRINT-DETAIL NC1734.2 +214700 ELSE NC1734.2 +214800 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +214900 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +215000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +215100 PERFORM FAIL NC1734.2 +215200 PERFORM PRINT-DETAIL. NC1734.2 +215300* NC1734.2 +215400 DIV-INIT-F3-31. NC1734.2 +215500* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +215600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +215700 MOVE "DIV-TEST-F3-31" TO PAR-NAME. NC1734.2 +215800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +215900 MOVE 0 TO WRK-CS-18V00. NC1734.2 +216000 MOVE "A" TO XRAY. NC1734.2 +216100 MOVE 1 TO REC-CT. NC1734.2 +216200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +216300 DIV-TEST-F3-31-0. NC1734.2 +216400 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +216500 GIVING WRK-DS-09V09 NC1734.2 +216600 ON SIZE ERROR NC1734.2 +216700 MOVE "E" TO XRAY NC1734.2 +216800 NOT ON SIZE ERROR NC1734.2 +216900 MOVE "N" TO XRAY NC1734.2 +217000 END-DIVIDE NC1734.2 +217100 MOVE 99 TO WRK-CS-18V00. NC1734.2 +217200 GO TO DIV-TEST-F3-31-1. NC1734.2 +217300 DIV-DELETE-F3-31. NC1734.2 +217400 PERFORM DE-LETE. NC1734.2 +217500 PERFORM PRINT-DETAIL. NC1734.2 +217600 GO TO CCVS-EXIT. NC1734.2 +217700 DIV-TEST-F3-31-1. NC1734.2 +217800 MOVE "DIV-TEST-F3-31-1" TO PAR-NAME. NC1734.2 +217900 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +218000 PERFORM PASS NC1734.2 +218100 PERFORM PRINT-DETAIL NC1734.2 +218200 ELSE NC1734.2 +218300 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +218400 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +218500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +218600 PERFORM FAIL NC1734.2 +218700 PERFORM PRINT-DETAIL. NC1734.2 +218800 ADD 1 TO REC-CT. NC1734.2 +218900 DIV-TEST-F3-31-2. NC1734.2 +219000 MOVE "DIV-TEST-F3-31-2" TO PAR-NAME. NC1734.2 +219100 IF XRAY = "N" NC1734.2 +219200 PERFORM PASS NC1734.2 +219300 PERFORM PRINT-DETAIL NC1734.2 +219400 ELSE NC1734.2 +219500 MOVE XRAY TO COMPUTED-X NC1734.2 +219600 MOVE "N" TO CORRECT-X NC1734.2 +219700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +219800 TO RE-MARK NC1734.2 +219900 PERFORM FAIL NC1734.2 +220000 PERFORM PRINT-DETAIL. NC1734.2 +220100 ADD 1 TO REC-CT. NC1734.2 +220200 DIV-TEST-F3-31-3. NC1734.2 +220300 MOVE "DIV-TEST-F3-31-3" TO PAR-NAME. NC1734.2 +220400 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +220500 PERFORM PASS NC1734.2 +220600 PERFORM PRINT-DETAIL NC1734.2 +220700 ELSE NC1734.2 +220800 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +220900 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +221000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +221100 PERFORM FAIL NC1734.2 +221200 PERFORM PRINT-DETAIL. NC1734.2 +221300* NC1734.2 +221400* NC1734.2 +221500* NC1734.2 +221600 CCVS-EXIT SECTION. NC1734.2 +221700 CCVS-999999. NC1734.2 +221800 GO TO CLOSE-FILES. NC1734.2 +*END-OF,NC173A +*HEADER,COBOL,NC174A +000100 IDENTIFICATION DIVISION. NC1744.2 +000200 PROGRAM-ID. NC1744.2 +000300 NC174A. NC1744.2 +000400**************************************************************** NC1744.2 +000500* * NC1744.2 +000600* VALIDATION FOR:- * NC1744.2 +000700* * NC1744.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +000900* * NC1744.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1744.2 +001100* * NC1744.2 +001200**************************************************************** NC1744.2 +001300* * NC1744.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1744.2 +001500* * NC1744.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1744.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1744.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1744.2 +001900* * NC1744.2 +002000**************************************************************** NC1744.2 +002100* NC1744.2 +002200* PROGRAM NC174A TESTS THE FOLLOWING GENERAL FEATURES: NC1744.2 +002300* RELATIONAL OPERATORS NC1744.2 +002400* CLASS CONDITIONS NC1744.2 +002500* SWITCH SETTINGS NC1744.2 +002600* NC1744.2 +002700 ENVIRONMENT DIVISION. NC1744.2 +002800 CONFIGURATION SECTION. NC1744.2 +002900 SOURCE-COMPUTER. NC1744.2 +003000 XXXXX082. NC1744.2 +003100 OBJECT-COMPUTER. NC1744.2 +003200 XXXXX083. NC1744.2 +003300ASPECIAL-NAMES. NC1744.2 +003400A XXXXX051 NC1744.2 +003500A IS SW-1 NC1744.2 +003600A ON STATUS IS ON-SWITCH-1 NC1744.2 +003700A OFF STATUS IS OFF-SWITCH-1 NC1744.2 +003800A XXXXX052 NC1744.2 +003900A IS SW-2 NC1744.2 +004000A ON IS ON-SWITCH-2 NC1744.2 +004100A OFF IS OFF-SWITCH-2 NC1744.2 +004200 CLASS ORDINAL-A-ONLY IS NC1744.2 +004300 XXXXX090 NC1744.2 +004400 CLASS ORDINAL-A-THROUGH-D IS NC1744.2 +004500 XXXXX090 NC1744.2 +004600 THROUGH NC1744.2 +004700 XXXXX091 NC1744.2 +004800 CLASS ORDINAL-D-THRU-A NC1744.2 +004900 XXXXX091 NC1744.2 +005000 THRU NC1744.2 +005100 XXXXX090 NC1744.2 +005200 CLASS ACTUAL-A-ONLY "A" NC1744.2 +005300 CLASS ACTUAL-A-THRU-D IS "A" THRU "D" NC1744.2 +005400 CLASS ACTUAL-D-THROUGH-A IS "D" THROUGH "A" NC1744.2 +005500 CLASS ACTUAL-ABCD "ABCD". NC1744.2 +005600 INPUT-OUTPUT SECTION. NC1744.2 +005700 FILE-CONTROL. NC1744.2 +005800 SELECT PRINT-FILE ASSIGN TO NC1744.2 +005900 XXXXX055. NC1744.2 +006000 DATA DIVISION. NC1744.2 +006100 FILE SECTION. NC1744.2 +006200 FD PRINT-FILE. NC1744.2 +006300 01 PRINT-REC PICTURE X(120). NC1744.2 +006400 01 DUMMY-RECORD PICTURE X(120). NC1744.2 +006500 WORKING-STORAGE SECTION. NC1744.2 +006600 01 WS-A PIC X. NC1744.2 +006700 01 WS-B PIC X(5). NC1744.2 +006800 01 IF-D1 PICTURE IS S9(4)V9(2) NC1744.2 +006900 VALUE IS 0. NC1744.2 +007000 01 IF-D2 PICTURE IS S9(4)V9(2) NC1744.2 +007100 VALUE IS ZERO. NC1744.2 +007200 01 IF-D3 PICTURE IS X(10) NC1744.2 +007300 VALUE IS "0000000000". NC1744.2 +007400 01 IF-D4 PICTURE IS X(15) NC1744.2 +007500 VALUE IS " ". NC1744.2 +007600 01 IF-D6 PICTURE IS A(10) NC1744.2 +007700 VALUE IS "BABABABABA". NC1744.2 +007800 01 IF-D7 PICTURE IS S9(6)V9(4) NC1744.2 +007900 VALUE IS +123.45. NC1744.2 +008000 01 IF-D8 PICTURE IS 9(6)V9(4) NC1744.2 +008100 VALUE IS 12300. NC1744.2 +008200 01 IF-D9 PICTURE IS X(3) NC1744.2 +008300 VALUE IS "123". NC1744.2 +008400 01 IF-D11 PICTURE IS X(6) NC1744.2 +008500 VALUE IS "ABCDEF". NC1744.2 +008600 01 IF-D13 PICTURE IS 9(6)V9(4) NC1744.2 +008700 VALUE IS 12300. NC1744.2 +008800 01 IF-D14 PICTURE IS S9(4)V9(2) NC1744.2 +008900 VALUE IS +123.45. NC1744.2 +009000 01 IF-D15 PICTURE IS S999PP NC1744.2 +009100 VALUE IS 12300. NC1744.2 +009200 01 IF-D16 PICTURE IS PP99 NC1744.2 +009300 VALUE IS .0012. NC1744.2 +009400 01 IF-D17 PICTURE IS SV9(4) NC1744.2 +009500 VALUE IS .0012. NC1744.2 +009600 01 IF-D18 PICTURE IS X(10) NC1744.2 +009700 VALUE IS "BABABABABA". NC1744.2 +009800 01 IF-D19 PICTURE IS X(10) NC1744.2 +009900 VALUE IS "ABCDEF ". NC1744.2 +010000 01 IF-D23 PICTURE IS $9,9B9.90+. NC1744.2 +010100 01 IF-D24 PICTURE IS X(10) NC1744.2 +010200 VALUE IS "$1,2 3.40+". NC1744.2 +010300 01 IF-D25 PICTURE IS ABABX0A. NC1744.2 +010400 01 IF-D26 PIC X(7) NC1744.2 +010500 VALUE IS "A C D0E". NC1744.2 +010600 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC1744.2 +010700 USAGE IS COMPUTATIONAL. NC1744.2 +010800 01 IF-D28 PICTURE IS 999999V9999 NC1744.2 +010900 VALUE IS 2137.45. NC1744.2 +011000 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC1744.2 +011100 01 IF-D33 PICTURE S9 VALUE -0. NC1744.2 +011200 01 IF-D34 PICTURE S9 VALUE +0. NC1744.2 +011300 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC1744.2 +011400 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC1744.2 +011500 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC1744.2 +011600 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC1744.2 +011700 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC1744.2 +011800 XXXXX081. NC1744.2 +011900 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1744.2 +012000 01 A18ONES-DS-18V00 PICTURE S9(18) NC1744.2 +012100 VALUE 111111111111111111. NC1744.2 +012200 01 ONES-XN-00018 PICTURE X(18) NC1744.2 +012300 VALUE "111111111111111111". NC1744.2 +012400 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC1744.2 +012500 01 WRK-DU-02V00 PICTURE 99. NC1744.2 +012600 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC1744.2 +012700 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1744.2 +012800 VALUE 111111111.111111111. NC1744.2 +012900 01 ONES-XN-00002 PICTURE XX VALUE "11". NC1744.2 +013000 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1744.2 +013100 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1744.2 +013200 01 A990-DS-0201P PICTURE S99P VALUE +990. NC1744.2 +013300 01 XDATA-XN-00018 PICTURE X(18) NC1744.2 +013400 VALUE "00ABCDEFGHI 4321 ". NC1744.2 +013500 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC1744.2 +013600 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC1744.2 +013700 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC1744.2 +013800 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC1744.2 +013900 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1744.2 +014000 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC1744.2 +014100 -123456789012345678. NC1744.2 +014200 01 WRK-XN-18-2 PIC X(18) VALUE NC1744.2 +014300 "123456789012345678". NC1744.2 +014400 NC1744.2 +014500 01 IF-D10. NC1744.2 +014600 02 FILLER PICTURE XX VALUE "01". NC1744.2 +014700 02 FILLER PICTURE XX VALUE "23". NC1744.2 +014800 02 IF-D10A. NC1744.2 +014900 03 FILLER PICTURE XXXX VALUE "4567". NC1744.2 +015000 03 FILLER PICTURE XXXX VALUE "8912". NC1744.2 +015100 01 IF-D12. NC1744.2 +015200 02 FILLER PICTURE XXX VALUE "ABC". NC1744.2 +015300 02 IF-D12A. NC1744.2 +015400 03 IF-D12B. NC1744.2 +015500 04 FILLER PICTURE XX VALUE "DE". NC1744.2 +015600 04 FILLER PICTURE X VALUE "F". NC1744.2 +015700 01 IF-D20. NC1744.2 +015800 02 FILLER PICTURE 9(5) VALUE ZERO. NC1744.2 +015900 02 FILLER PICTURE 99 VALUE 12. NC1744.2 +016000 02 FILLER PICTURE 9 VALUE 3. NC1744.2 +016100 02 FILLER PICTURE 99 VALUE 45. NC1744.2 +016200 01 IF-D21. NC1744.2 +016300 02 FILLER PICTURE 9(5) VALUE ZERO. NC1744.2 +016400 02 FILLER PICTURE 9(5) VALUE 12345. NC1744.2 +016500 01 IF-D22. NC1744.2 +016600 02 FILLER PICTURE AA VALUE "AB". NC1744.2 +016700 02 FILLER PICTURE AAAA VALUE "CDEF". NC1744.2 +016800 01 IF-D35. NC1744.2 +016900 02 IF-D35A VALUE "*ASTERISK". NC1744.2 +017000 03 FILLER PICTURE A(6). NC1744.2 +017100 03 FILLER PICTURE AAA. NC1744.2 +017200 02 IF-D35B VALUE "/SLASH". NC1744.2 +017300 03 FILLER PICTURE 9(6). NC1744.2 +017400 01 IF-D36 REDEFINES IF-D35. NC1744.2 +017500 02 IF-D36A PICTURE X(6). NC1744.2 +017600 02 IF-D36B PICTURE XXX. NC1744.2 +017700 02 IF-D36C PICTURE X(6). NC1744.2 +017800 01 IF-D39. NC1744.2 +017900 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC1744.2 +018000 02 FILLER PICTURE A(4) VALUE SPACE. NC1744.2 +018100 01 LEVEL-01. NC1744.2 +018200 02 LEVEL-02. NC1744.2 +018300 03 LEVEL-03. NC1744.2 +018400 04 LEVEL-04. NC1744.2 +018500 05 LEVEL-05. NC1744.2 +018600 06 LEVEL-06. NC1744.2 +018700 07 LEVEL-07. NC1744.2 +018800 08 LEVEL-08. NC1744.2 +018900 09 LEVEL-09. NC1744.2 +019000 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC1744.2 +019100 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC1744.2 +019200 SPACE. NC1744.2 +019300 01 LEVEL-SENDER PICTURE X VALUE "S". NC1744.2 +019400 01 VAL PICTURE IS 9 VALUE IS 0. NC1744.2 +019500 01 A-2 PICTURE IS A VALUE IS "A".NC1744.2 +019600 01 N-27 PICTURE IS 9999V9 NC1744.2 +019700 VALUE IS 9999.9. NC1744.2 +019800 01 N-30 PICTURE IS 9V9 NC1744.2 +019900 VALUE IS 2. NC1744.2 +020000 01 N-31 PICTURE IS 9(6). NC1744.2 +020100 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC1744.2 +020200 01 N-33 PICTURE IS 9(5) NC1744.2 +020300 VALUE IS 29. NC1744.2 +020400 01 A-37 PICTURE IS A VALUE IS "X".NC1744.2 +020500 01 X-38 REDEFINES A-37 PICTURE IS X. NC1744.2 +020600 01 X-43 PIC X(10) VALUE " l75.63". NC1744.2 +020700 01 N-84 PICTURE IS 9999999999. NC1744.2 +020800 01 NUMERIC-GRP-TEST. NC1744.2 +020900 02 NUMERIC-1 PICTURE 9 VALUE 0. NC1744.2 +021000 02 NUMERIC-2. NC1744.2 +021100 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC1744.2 +021200 03 NUMERIC-4. NC1744.2 +021300 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC1744.2 +021400 02 NUMERIC-6. NC1744.2 +021500 03 NUMERIC-7 PICTURE X VALUE "7". NC1744.2 +021600 03 NUMERIC-8 PICTURE 9 VALUE 8. NC1744.2 +021700 01 NUM-GRP. NC1744.2 +021800 02 NUM-SUB-GRP PIC 9. NC1744.2 +021900 01 GROUP-1000. NC1744.2 +022000 02 FILLER PIC X. NC1744.2 +022100 02 GROUP-X1000. NC1744.2 +022200 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC1744.2 +022300 03 XNAME PICTURE X(100) VALUE QUOTE. NC1744.2 +022400 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC1744.2 +022500 03 GROUP-1000-3 PICTURE X VALUE ".". NC1744.2 +022600 02 GROUP-X500-2. NC1744.2 +022700 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC1744.2 +022800 03 GROUP-X500-1. NC1744.2 +022900 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC1744.2 +023000 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC1744.2 +023100 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC1744.2 +023200 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC1744.2 +023300 01 HI-LO-VALUES. NC1744.2 +023400 02 LOW-VAL PIC X VALUE LOW-VALUE. NC1744.2 +023500 02 ZERO-01 PICTURE 9(18) VALUE 1. NC1744.2 +023600 02 ABC PICTURE XXX VALUE "ABC". NC1744.2 +023700 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC1744.2 +023800 02 ZERO-NULL PIC 9(9) VALUE 0. NC1744.2 +023900 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC1744.2 +024000 01 COMP-DATA. NC1744.2 +024100 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC1744.2 +024200 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC1744.2 +024300 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC1744.2 +024400 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC1744.2 +024500 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC1744.2 +024600 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC1744.2 +024700 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC1744.2 +024800 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC1744.2 +024900 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC1744.2 +025000 01 DISP-DATA. NC1744.2 +025100 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC1744.2 +025200 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC1744.2 +025300 02 DISP-DATA3 PICTURE 9 VALUE 9. NC1744.2 +025400 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC1744.2 +025500 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC1744.2 +025600 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC1744.2 +025700 01 DATA-5 PICTURE 9 VALUE 5. NC1744.2 +025800 01 DATA-99999 PICTURE S9(5) VALUE +99999. NC1744.2 +025900 01 DATA-Z PICTURE X VALUE "Z". NC1744.2 +026000 01 DATA-4 PICTURE 9 VALUE 4. NC1744.2 +026100 01 DATA-Y PICTURE X VALUE "Y". NC1744.2 +026200 01 DATA-VWXYZ PICTURE X(5) VALUE "VWXYZ". NC1744.2 +026300 01 DATA-ADCBA PICTURE X(5) VALUE "ADCBA". NC1744.2 +026400 01 TEST-RESULTS. NC1744.2 +026500 02 FILLER PIC X VALUE SPACE. NC1744.2 +026600 02 FEATURE PIC X(20) VALUE SPACE. NC1744.2 +026700 02 FILLER PIC X VALUE SPACE. NC1744.2 +026800 02 P-OR-F PIC X(5) VALUE SPACE. NC1744.2 +026900 02 FILLER PIC X VALUE SPACE. NC1744.2 +027000 02 PAR-NAME. NC1744.2 +027100 03 FILLER PIC X(19) VALUE SPACE. NC1744.2 +027200 03 PARDOT-X PIC X VALUE SPACE. NC1744.2 +027300 03 DOTVALUE PIC 99 VALUE ZERO. NC1744.2 +027400 02 FILLER PIC X(8) VALUE SPACE. NC1744.2 +027500 02 RE-MARK PIC X(61). NC1744.2 +027600 01 TEST-COMPUTED. NC1744.2 +027700 02 FILLER PIC X(30) VALUE SPACE. NC1744.2 +027800 02 FILLER PIC X(17) VALUE NC1744.2 +027900 " COMPUTED=". NC1744.2 +028000 02 COMPUTED-X. NC1744.2 +028100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1744.2 +028200 03 COMPUTED-N REDEFINES COMPUTED-A NC1744.2 +028300 PIC -9(9).9(9). NC1744.2 +028400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1744.2 +028500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1744.2 +028600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1744.2 +028700 03 CM-18V0 REDEFINES COMPUTED-A. NC1744.2 +028800 04 COMPUTED-18V0 PIC -9(18). NC1744.2 +028900 04 FILLER PIC X. NC1744.2 +029000 03 FILLER PIC X(50) VALUE SPACE. NC1744.2 +029100 01 TEST-CORRECT. NC1744.2 +029200 02 FILLER PIC X(30) VALUE SPACE. NC1744.2 +029300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1744.2 +029400 02 CORRECT-X. NC1744.2 +029500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1744.2 +029600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1744.2 +029700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1744.2 +029800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1744.2 +029900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1744.2 +030000 03 CR-18V0 REDEFINES CORRECT-A. NC1744.2 +030100 04 CORRECT-18V0 PIC -9(18). NC1744.2 +030200 04 FILLER PIC X. NC1744.2 +030300 03 FILLER PIC X(2) VALUE SPACE. NC1744.2 +030400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1744.2 +030500 01 CCVS-C-1. NC1744.2 +030600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1744.2 +030700- "SS PARAGRAPH-NAME NC1744.2 +030800- " REMARKS". NC1744.2 +030900 02 FILLER PIC X(20) VALUE SPACE. NC1744.2 +031000 01 CCVS-C-2. NC1744.2 +031100 02 FILLER PIC X VALUE SPACE. NC1744.2 +031200 02 FILLER PIC X(6) VALUE "TESTED". NC1744.2 +031300 02 FILLER PIC X(15) VALUE SPACE. NC1744.2 +031400 02 FILLER PIC X(4) VALUE "FAIL". NC1744.2 +031500 02 FILLER PIC X(94) VALUE SPACE. NC1744.2 +031600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1744.2 +031700 01 REC-CT PIC 99 VALUE ZERO. NC1744.2 +031800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1744.2 +031900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1744.2 +032300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1744.2 +032400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1744.2 +032500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1744.2 +032600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1744.2 +032700 01 CCVS-H-1. NC1744.2 +032800 02 FILLER PIC X(39) VALUE SPACES. NC1744.2 +032900 02 FILLER PIC X(42) VALUE NC1744.2 +033000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1744.2 +033100 02 FILLER PIC X(39) VALUE SPACES. NC1744.2 +033200 01 CCVS-H-2A. NC1744.2 +033300 02 FILLER PIC X(40) VALUE SPACE. NC1744.2 +033400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1744.2 +033500 02 FILLER PIC XXXX VALUE NC1744.2 +033600 "4.2 ". NC1744.2 +033700 02 FILLER PIC X(28) VALUE NC1744.2 +033800 " COPY - NOT FOR DISTRIBUTION". NC1744.2 +033900 02 FILLER PIC X(41) VALUE SPACE. NC1744.2 +034000 NC1744.2 +034100 01 CCVS-H-2B. NC1744.2 +034200 02 FILLER PIC X(15) VALUE NC1744.2 +034300 "TEST RESULT OF ". NC1744.2 +034400 02 TEST-ID PIC X(9). NC1744.2 +034500 02 FILLER PIC X(4) VALUE NC1744.2 +034600 " IN ". NC1744.2 +034700 02 FILLER PIC X(12) VALUE NC1744.2 +034800 " HIGH ". NC1744.2 +034900 02 FILLER PIC X(22) VALUE NC1744.2 +035000 " LEVEL VALIDATION FOR ". NC1744.2 +035100 02 FILLER PIC X(58) VALUE NC1744.2 +035200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +035300 01 CCVS-H-3. NC1744.2 +035400 02 FILLER PIC X(34) VALUE NC1744.2 +035500 " FOR OFFICIAL USE ONLY ". NC1744.2 +035600 02 FILLER PIC X(58) VALUE NC1744.2 +035700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1744.2 +035800 02 FILLER PIC X(28) VALUE NC1744.2 +035900 " COPYRIGHT 1985 ". NC1744.2 +036000 01 CCVS-E-1. NC1744.2 +036100 02 FILLER PIC X(52) VALUE SPACE. NC1744.2 +036200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1744.2 +036300 02 ID-AGAIN PIC X(9). NC1744.2 +036400 02 FILLER PIC X(45) VALUE SPACES. NC1744.2 +036500 01 CCVS-E-2. NC1744.2 +036600 02 FILLER PIC X(31) VALUE SPACE. NC1744.2 +036700 02 FILLER PIC X(21) VALUE SPACE. NC1744.2 +036800 02 CCVS-E-2-2. NC1744.2 +036900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1744.2 +037000 03 FILLER PIC X VALUE SPACE. NC1744.2 +037100 03 ENDER-DESC PIC X(44) VALUE NC1744.2 +037200 "ERRORS ENCOUNTERED". NC1744.2 +037300 01 CCVS-E-3. NC1744.2 +037400 02 FILLER PIC X(22) VALUE NC1744.2 +037500 " FOR OFFICIAL USE ONLY". NC1744.2 +037600 02 FILLER PIC X(12) VALUE SPACE. NC1744.2 +037700 02 FILLER PIC X(58) VALUE NC1744.2 +037800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +037900 02 FILLER PIC X(13) VALUE SPACE. NC1744.2 +038000 02 FILLER PIC X(15) VALUE NC1744.2 +038100 " COPYRIGHT 1985". NC1744.2 +038200 01 CCVS-E-4. NC1744.2 +038300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1744.2 +038400 02 FILLER PIC X(4) VALUE " OF ". NC1744.2 +038500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1744.2 +038600 02 FILLER PIC X(40) VALUE NC1744.2 +038700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1744.2 +038800 01 XXINFO. NC1744.2 +038900 02 FILLER PIC X(19) VALUE NC1744.2 +039000 "*** INFORMATION ***". NC1744.2 +039100 02 INFO-TEXT. NC1744.2 +039200 04 FILLER PIC X(8) VALUE SPACE. NC1744.2 +039300 04 XXCOMPUTED PIC X(20). NC1744.2 +039400 04 FILLER PIC X(5) VALUE SPACE. NC1744.2 +039500 04 XXCORRECT PIC X(20). NC1744.2 +039600 02 INF-ANSI-REFERENCE PIC X(48). NC1744.2 +039700 01 HYPHEN-LINE. NC1744.2 +039800 02 FILLER PIC IS X VALUE IS SPACE. NC1744.2 +039900 02 FILLER PIC IS X(65) VALUE IS "************************NC1744.2 +040000- "*****************************************". NC1744.2 +040100 02 FILLER PIC IS X(54) VALUE IS "************************NC1744.2 +040200- "******************************". NC1744.2 +040300 01 CCVS-PGM-ID PIC X(9) VALUE NC1744.2 +040400 "NC174A". NC1744.2 +040500 PROCEDURE DIVISION. NC1744.2 +040600 CCVS1 SECTION. NC1744.2 +040700 OPEN-FILES. NC1744.2 +040800 OPEN OUTPUT PRINT-FILE. NC1744.2 +040900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1744.2 +041000 MOVE SPACE TO TEST-RESULTS. NC1744.2 +041100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1744.2 +041200 GO TO CCVS1-EXIT. NC1744.2 +041300 CLOSE-FILES. NC1744.2 +041400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1744.2 +041500 TERMINATE-CCVS. NC1744.2 +041600S EXIT PROGRAM. NC1744.2 +041700STERMINATE-CALL. NC1744.2 +041800 STOP RUN. NC1744.2 +041900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1744.2 +042000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1744.2 +042100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1744.2 +042200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1744.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. NC1744.2 +042400 PRINT-DETAIL. NC1744.2 +042500 IF REC-CT NOT EQUAL TO ZERO NC1744.2 +042600 MOVE "." TO PARDOT-X NC1744.2 +042700 MOVE REC-CT TO DOTVALUE. NC1744.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1744.2 +042900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1744.2 +043000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1744.2 +043100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1744.2 +043200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1744.2 +043300 MOVE SPACE TO CORRECT-X. NC1744.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1744.2 +043500 MOVE SPACE TO RE-MARK. NC1744.2 +043600 HEAD-ROUTINE. NC1744.2 +043700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +043800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +043900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1744.2 +044000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1744.2 +044100 COLUMN-NAMES-ROUTINE. NC1744.2 +044200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +044300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +044500 END-ROUTINE. NC1744.2 +044600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1744.2 +044700 END-RTN-EXIT. NC1744.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +044900 END-ROUTINE-1. NC1744.2 +045000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1744.2 +045100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1744.2 +045200 ADD PASS-COUNTER TO ERROR-HOLD. NC1744.2 +045300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1744.2 +045400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1744.2 +045500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1744.2 +045600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1744.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1744.2 +045800 END-ROUTINE-12. NC1744.2 +045900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1744.2 +046000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1744.2 +046100 MOVE "NO " TO ERROR-TOTAL NC1744.2 +046200 ELSE NC1744.2 +046300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1744.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1744.2 +046500 PERFORM WRITE-LINE. NC1744.2 +046600 END-ROUTINE-13. NC1744.2 +046700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1744.2 +046800 MOVE "NO " TO ERROR-TOTAL ELSE NC1744.2 +046900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1744.2 +047000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1744.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047200 IF INSPECT-COUNTER EQUAL TO ZERO NC1744.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1744.2 +047400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1744.2 +047500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1744.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047800 WRITE-LINE. NC1744.2 +047900 ADD 1 TO RECORD-COUNT. NC1744.2 +048000Y IF RECORD-COUNT GREATER 42 NC1744.2 +048100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1744.2 +048200Y MOVE SPACE TO DUMMY-RECORD NC1744.2 +048300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1744.2 +048400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1744.2 +048500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1744.2 +048600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1744.2 +048700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1744.2 +048800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +048900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +049000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +049100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1744.2 +049200Y MOVE ZERO TO RECORD-COUNT. NC1744.2 +049300 PERFORM WRT-LN. NC1744.2 +049400 WRT-LN. NC1744.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1744.2 +049600 MOVE SPACE TO DUMMY-RECORD. NC1744.2 +049700 BLANK-LINE-PRINT. NC1744.2 +049800 PERFORM WRT-LN. NC1744.2 +049900 FAIL-ROUTINE. NC1744.2 +050000 IF COMPUTED-X NOT EQUAL TO SPACE NC1744.2 +050100 GO TO FAIL-ROUTINE-WRITE. NC1744.2 +050200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1744.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1744.2 +050400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1744.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1744.2 +050700 GO TO FAIL-ROUTINE-EX. NC1744.2 +050800 FAIL-ROUTINE-WRITE. NC1744.2 +050900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1744.2 +051000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1744.2 +051100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1744.2 +051200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1744.2 +051300 FAIL-ROUTINE-EX. EXIT. NC1744.2 +051400 BAIL-OUT. NC1744.2 +051500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1744.2 +051600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1744.2 +051700 BAIL-OUT-WRITE. NC1744.2 +051800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1744.2 +051900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1744.2 +052000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +052100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1744.2 +052200 BAIL-OUT-EX. EXIT. NC1744.2 +052300 CCVS1-EXIT. NC1744.2 +052400 EXIT. NC1744.2 +052500 SECT-NC174A-001 SECTION. NC1744.2 +052600* NC1744.2 +052700* NC1744.2 +052800 NEXT-INIT-GF-1. NC1744.2 +052900* ==--> NEXT SENTENCE <--== NC1744.2 +053000 MOVE "V1-89 6.15.4 GR2 " TO ANSI-REFERENCE. NC1744.2 +053100 MOVE "A" TO A-2. NC1744.2 +053200 NEXT-TEST-GF-1. NC1744.2 +053300 IF A-2 EQUAL TO "A" NC1744.2 +053400 NEXT SENTENCE NC1744.2 +053500 ELSE NC1744.2 +053600 NEXT SENTENCE. NC1744.2 +053700 PERFORM PASS. NC1744.2 +053800 GO TO NEXT-WRITE-GF-1. NC1744.2 +053900 NEXT-DELETE-GF-1. NC1744.2 +054000 PERFORM DE-LETE. NC1744.2 +054100 NEXT-WRITE-GF-1. NC1744.2 +054200 MOVE "NEXT-TEST-1" TO PAR-NAME. NC1744.2 +054300 PERFORM PRINT-DETAIL. NC1744.2 +054400* NC1744.2 +054500* NC1744.2 +054600 ANOTHER-REMARK. NC1744.2 +054700 MOVE SPACE TO TEST-RESULTS. NC1744.2 +054800 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC1744.2 +054900 PERFORM PRINT-DETAIL. NC1744.2 +055000 MOVE "TEST THE COMPARISONS IN " TO RE-MARK. NC1744.2 +055100 PERFORM PRINT-DETAIL. NC1744.2 +055200 MOVE "SWITCH-STATUS, RELATION " TO RE-MARK. NC1744.2 +055300 PERFORM PRINT-DETAIL. NC1744.2 +055400 MOVE "AND CLASS CONDITIONALS. " TO RE-MARK. NC1744.2 +055500 PERFORM PRINT-DETAIL. NC1744.2 +055600 SWH-INIT-GF-1. NC1744.2 +055700 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +055800 MOVE "SWITCH-STATUS" TO FEATURE. NC1744.2 +055900 SWH-TEST-GF-1. NC1744.2 +056000A IF ON-SWITCH-1 NC1744.2 +056100A PERFORM PASS NC1744.2 +056200A ELSE NC1744.2 +056300A PERFORM FAIL. NC1744.2 +056400A GO TO SWH-WRITE-GF-1. NC1744.2 +056500 SWH-DELETE-GF-1. NC1744.2 +056600B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +056700 PERFORM DE-LETE. NC1744.2 +056800 SWH-WRITE-GF-1. NC1744.2 +056900 MOVE "SWH-TEST-GF-1" TO PAR-NAME. NC1744.2 +057000 PERFORM PRINT-DETAIL. NC1744.2 +057100 SWH-INIT-GF-2. NC1744.2 +057200 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +057300 SWH-TEST-GF-2. NC1744.2 +057400A IF OFF-SWITCH-1 NC1744.2 +057500A PERFORM FAIL NC1744.2 +057600A ELSE NC1744.2 +057700A PERFORM PASS. NC1744.2 +057800A GO TO SWH-WRITE-GF-2. NC1744.2 +057900 SWH-DELETE-GF-2. NC1744.2 +058000B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +058100 PERFORM DE-LETE. NC1744.2 +058200 SWH-WRITE-GF-2. NC1744.2 +058300 MOVE "SWH-TEST-GF-2" TO PAR-NAME. NC1744.2 +058400 PERFORM PRINT-DETAIL. NC1744.2 +058500 SWH-INIT-GF-3. NC1744.2 +058600 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +058700 SWH-TEST-GF-3. NC1744.2 +058800A IF OFF-SWITCH-2 NC1744.2 +058900A PERFORM PASS NC1744.2 +059000A ELSE NC1744.2 +059100A PERFORM FAIL. NC1744.2 +059200A GO TO SWH-WRITE-GF-3. NC1744.2 +059300 SWH-DELETE-GF-3. NC1744.2 +059400B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +059500 PERFORM DE-LETE. NC1744.2 +059600 SWH-WRITE-GF-3. NC1744.2 +059700 MOVE "SWH-TEST-GF-3" TO PAR-NAME. NC1744.2 +059800 PERFORM PRINT-DETAIL. NC1744.2 +059900 SWH-INIT-GF-4. NC1744.2 +060000 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +060100 SWH-TEST-GF-4. NC1744.2 +060200A IF ON-SWITCH-2 NC1744.2 +060300A PERFORM FAIL NC1744.2 +060400A ELSE NC1744.2 +060500A PERFORM PASS. NC1744.2 +060600A GO TO SWH-WRITE-GF-4. NC1744.2 +060700 SWH-DELETE-GF-4. NC1744.2 +060800B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +060900 PERFORM DE-LETE. NC1744.2 +061000 SWH-WRITE-GF-4. NC1744.2 +061100 MOVE "SWH-TEST-GF-4" TO PAR-NAME. NC1744.2 +061200 PERFORM PRINT-DETAIL. NC1744.2 +061300 SWH-TEST-5. NC1744.2 +061400* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +061500 GO TO SWH-TEST-5-B. NC1744.2 +061600 SWH-TEST-5-A. NC1744.2 +061700 GO TO SWH-DELETE-5. NC1744.2 +061800 SWH-TEST-5-B. NC1744.2 +061900A IF NOT ON-SWITCH-1 NC1744.2 +062000A MOVE "SWITCH-1 OFF " TO COMPUTED-A NC1744.2 +062100A MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A NC1744.2 +062200A PERFORM FAIL NC1744.2 +062300A GO TO SWH-WRITE-5. NC1744.2 +062400A PERFORM PASS. NC1744.2 +062500A GO TO SWH-WRITE-5. NC1744.2 +062600 SWH-DELETE-5. NC1744.2 +062700B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +062800 PERFORM DE-LETE. NC1744.2 +062900 SWH-WRITE-5. NC1744.2 +063000 MOVE "SWH-TEST-5" TO PAR-NAME. NC1744.2 +063100 PERFORM PRINT-DETAIL. NC1744.2 +063200 SWH-TEST-6. NC1744.2 +063300* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +063400 GO TO SWH-TEST-6-B. NC1744.2 +063500 SWH-TEST-6-A. NC1744.2 +063600 GO TO SWH-DELETE-6. NC1744.2 +063700 SWH-TEST-6-B. NC1744.2 +063800A IF NOT OFF-SWITCH-1 NC1744.2 +063900A PERFORM PASS NC1744.2 +064000A GO TO SWH-WRITE-6. NC1744.2 +064100A MOVE "SWITCH-1 OFF " TO COMPUTED-A. NC1744.2 +064200A MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A. NC1744.2 +064300A PERFORM FAIL. NC1744.2 +064400A GO TO SWH-WRITE-6. NC1744.2 +064500 SWH-DELETE-6. NC1744.2 +064600B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +064700 PERFORM DE-LETE. NC1744.2 +064800 SWH-WRITE-6. NC1744.2 +064900 MOVE "SWH-TEST-6" TO PAR-NAME. NC1744.2 +065000 PERFORM PRINT-DETAIL. NC1744.2 +065100 SWH-TEST-7. NC1744.2 +065200 GO TO SWH-DELETE-7. NC1744.2 +065300A IF NOT ON-SWITCH-2 NC1744.2 +065400A PERFORM PASS NC1744.2 +065500A GO TO SWH-WRITE-7. NC1744.2 +065600A MOVE "SWITCH-2 ON " TO COMPUTED-A. NC1744.2 +065700A MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A. NC1744.2 +065800A PERFORM FAIL. NC1744.2 +065900A GO TO SWH-WRITE-7. NC1744.2 +066000 SWH-DELETE-7. NC1744.2 +066100B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +066200 PERFORM DE-LETE. NC1744.2 +066300 SWH-WRITE-7. NC1744.2 +066400 MOVE "SWH-TEST-7" TO PAR-NAME. NC1744.2 +066500 PERFORM PRINT-DETAIL. NC1744.2 +066600 SWH-TEST-8. NC1744.2 +066700* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +066800 GO TO SWH-TEST-8-B. NC1744.2 +066900 SWH-TEST-8-A. NC1744.2 +067000 GO TO SWH-DELETE-8. NC1744.2 +067100 SWH-TEST-8-B. NC1744.2 +067200A IF NOT OFF-SWITCH-2 NC1744.2 +067300A MOVE "SWITCH-2 ON " TO COMPUTED-A NC1744.2 +067400A MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A NC1744.2 +067500A PERFORM FAIL NC1744.2 +067600A GO TO SWH-WRITE-8. NC1744.2 +067700A PERFORM PASS. NC1744.2 +067800A GO TO SWH-WRITE-8. NC1744.2 +067900 SWH-DELETE-8. NC1744.2 +068000B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +068100 PERFORM DE-LETE. NC1744.2 +068200 SWH-WRITE-8. NC1744.2 +068300 MOVE "SWH-TEST-8" TO PAR-NAME. NC1744.2 +068400 PERFORM PRINT-DETAIL. NC1744.2 +068500* NC1744.2 +068600* NC1744.2 +068700 SWH-INIT-GF-9. NC1744.2 +068800 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +068900 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +069000 SET SW-1 TO ON. NC1744.2 +069100 SWH-TEST-GF-9. NC1744.2 +069200A IF ON-SWITCH-1 NC1744.2 +069300A PERFORM PASS NC1744.2 +069400A ELSE NC1744.2 +069500A PERFORM FAIL. NC1744.2 +069600A GO TO SWH-WRITE-GF-9. NC1744.2 +069700 SWH-DELETE-GF-9. NC1744.2 +069800B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +069900 PERFORM DE-LETE. NC1744.2 +070000 SWH-WRITE-GF-9. NC1744.2 +070100 MOVE "SWH-TEST-GF-9" TO PAR-NAME. NC1744.2 +070200 PERFORM PRINT-DETAIL. NC1744.2 +070300* NC1744.2 +070400* NC1744.2 +070500 SWH-INIT-GF-10. NC1744.2 +070600 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +070700 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +070800 SET SW-1 SW-2 TO OFF. NC1744.2 +070900 SWH-TEST-GF-10-1. NC1744.2 +071000A IF OFF-SWITCH-1 NC1744.2 +071100A PERFORM PASS NC1744.2 +071200A ELSE NC1744.2 +071300A PERFORM FAIL. NC1744.2 +071400A GO TO SWH-WRITE-GF-10-1. NC1744.2 +071500 SWH-DELETE-GF-10-1. NC1744.2 +071600B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +071700 PERFORM DE-LETE. NC1744.2 +071800 SWH-WRITE-GF-10-1. NC1744.2 +071900 MOVE "SWH-TEST-GF-10-1" TO PAR-NAME. NC1744.2 +072000 PERFORM PRINT-DETAIL. NC1744.2 +072100 SWH-TEST-GF-10-2. NC1744.2 +072200A IF OFF-SWITCH-2 NC1744.2 +072300A PERFORM PASS NC1744.2 +072400A ELSE NC1744.2 +072500A PERFORM FAIL. NC1744.2 +072600A GO TO SWH-WRITE-GF-10-2. NC1744.2 +072700 SWH-DELETE-GF-10-2. NC1744.2 +072800B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +072900 PERFORM DE-LETE. NC1744.2 +073000 SWH-WRITE-GF-10-2. NC1744.2 +073100 MOVE "SWH-TEST-GF-10-2" TO PAR-NAME. NC1744.2 +073200 PERFORM PRINT-DETAIL. NC1744.2 +073300* NC1744.2 +073400* NC1744.2 +073500 SWH-INIT-GF-11. NC1744.2 +073600 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +073700 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +073800 SET SW-1 TO ON NC1744.2 +073900 SW-2 TO OFF. NC1744.2 +074000 SWH-TEST-GF-11-1. NC1744.2 +074100A IF ON-SWITCH-1 NC1744.2 +074200A PERFORM PASS NC1744.2 +074300A ELSE NC1744.2 +074400A PERFORM FAIL. NC1744.2 +074500A GO TO SWH-WRITE-GF-11-1. NC1744.2 +074600 SWH-DELETE-GF-11-1. NC1744.2 +074700B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +074800 PERFORM DE-LETE. NC1744.2 +074900 SWH-WRITE-GF-11-1. NC1744.2 +075000 MOVE "SWH-TEST-GF-11-1" TO PAR-NAME. NC1744.2 +075100 PERFORM PRINT-DETAIL. NC1744.2 +075200 SWH-TEST-GF-11-2. NC1744.2 +075300A IF OFF-SWITCH-2 NC1744.2 +075400A PERFORM PASS NC1744.2 +075500A ELSE NC1744.2 +075600A PERFORM FAIL. NC1744.2 +075700A GO TO SWH-WRITE-GF-11-2. NC1744.2 +075800 SWH-DELETE-GF-11-2. NC1744.2 +075900B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +076000 PERFORM DE-LETE. NC1744.2 +076100 SWH-WRITE-GF-11-2. NC1744.2 +076200 MOVE "SWH-TEST-GF-11-2" TO PAR-NAME. NC1744.2 +076300 PERFORM PRINT-DETAIL. NC1744.2 +076400* NC1744.2 +076500* NC1744.2 +076600 SWH-INIT-GF-12. NC1744.2 +076700 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +076800 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +076900 SET SW-2 TO OFF. NC1744.2 +077000 SWH-TEST-GF-12. NC1744.2 +077100A IF OFF-SWITCH-2 NC1744.2 +077200A PERFORM PASS NC1744.2 +077300A ELSE NC1744.2 +077400A PERFORM FAIL. NC1744.2 +077500A GO TO SWH-WRITE-GF-12. NC1744.2 +077600 SWH-DELETE-GF-12. NC1744.2 +077700B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +077800 PERFORM DE-LETE. NC1744.2 +077900 SWH-WRITE-GF-12. NC1744.2 +078000 MOVE "SWH-TEST-GF-12" TO PAR-NAME. NC1744.2 +078100 PERFORM PRINT-DETAIL. NC1744.2 +078200* NC1744.2 +078300* NC1744.2 +078400 RELAT-INIT-GF-1. NC1744.2 +078500 MOVE "RELATION" TO FEATURE. NC1744.2 +078600 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +078700 MOVE ZERO TO VAL. NC1744.2 +078800 MOVE "A" TO A-2. NC1744.2 +078900 RELAT-TEST-GF-1. NC1744.2 +079000 IF "Z" GREATER THAN A-2 NC1744.2 +079100 ADD 1 VAL GIVING VAL. NC1744.2 +079200 NC1744.2 +079300 IF A-2 GREATER THAN "Z" NC1744.2 +079400 GO TO RELAT-CHECK-GF-1. NC1744.2 +079500 ADD 2 VAL GIVING VAL. NC1744.2 +079600 GO TO RELAT-CHECK-GF-1. NC1744.2 +079700 RELAT-DELETE-GF-1. NC1744.2 +079800 PERFORM DE-LETE. NC1744.2 +079900 GO TO RELAT-WRITE-GF-1. NC1744.2 +080000 RELAT-CHECK-GF-1. NC1744.2 +080100 IF VAL EQUAL TO 3 NC1744.2 +080200 PERFORM PASS NC1744.2 +080300 GO TO RELAT-WRITE-GF-1. NC1744.2 +080400 MOVE VAL TO COMPUTED-A. NC1744.2 +080500 MOVE 3 TO CORRECT-A. NC1744.2 +080600 PERFORM FAIL. NC1744.2 +080700 RELAT-WRITE-GF-1. NC1744.2 +080800 MOVE "RELAT-TEST-GF-1" TO PAR-NAME. NC1744.2 +080900 PERFORM PRINT-DETAIL. NC1744.2 +081000 RELAT-INIT-GF-2. NC1744.2 +081100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +081200 MOVE ZERO TO VAL. NC1744.2 +081300 MOVE "A" TO A-2. NC1744.2 +081400 RELAT-TEST-GF-2. NC1744.2 +081500 IF A-2 NOT GREATER THAN "Z" NC1744.2 +081600 ADD 1 VAL GIVING VAL. NC1744.2 +081700 IF "Z" NOT GREATER THAN A-2 NC1744.2 +081800 GO TO RELAT-CHECK-GF-2. NC1744.2 +081900 ADD 2 VAL GIVING VAL. NC1744.2 +082000 GO TO RELAT-CHECK-GF-2. NC1744.2 +082100 RELAT-DELETE-GF-2. NC1744.2 +082200 PERFORM DE-LETE. NC1744.2 +082300 GO TO RELAT-WRITE-GF-2. NC1744.2 +082400 RELAT-CHECK-GF-2. NC1744.2 +082500 IF VAL EQUAL TO 3 NC1744.2 +082600 PERFORM PASS NC1744.2 +082700 GO TO RELAT-WRITE-GF-2. NC1744.2 +082800 MOVE VAL TO COMPUTED-A. NC1744.2 +082900 MOVE 3 TO CORRECT-A. NC1744.2 +083000 PERFORM FAIL. NC1744.2 +083100 RELAT-WRITE-GF-2. NC1744.2 +083200 MOVE "RELAT-TEST-GF-2" TO PAR-NAME. NC1744.2 +083300 PERFORM PRINT-DETAIL. NC1744.2 +083400 RELAT-INIT-GF-3. NC1744.2 +083500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +083600 MOVE ZERO TO VAL. NC1744.2 +083700 MOVE 2 TO N-30. NC1744.2 +083800 MOVE 29 TO N-33. NC1744.2 +083900 RELAT-TEST-GF-3. NC1744.2 +084000 IF N-30 LESS THAN N-33 NC1744.2 +084100 ADD 1 VAL GIVING VAL. NC1744.2 +084200 IF N-33 LESS THAN N-30 NC1744.2 +084300 GO TO RELAT-CHECK-GF-3. NC1744.2 +084400 ADD 2 VAL GIVING VAL. NC1744.2 +084500 GO TO RELAT-CHECK-GF-3. NC1744.2 +084600 RELAT-DELETE-GF-3. NC1744.2 +084700 PERFORM DE-LETE. NC1744.2 +084800 GO TO RELAT-WRITE-GF-3. NC1744.2 +084900 RELAT-CHECK-GF-3. NC1744.2 +085000 IF VAL EQUAL TO 3 NC1744.2 +085100 PERFORM PASS NC1744.2 +085200 GO TO RELAT-WRITE-GF-3. NC1744.2 +085300 MOVE VAL TO COMPUTED-A. NC1744.2 +085400 MOVE 3 TO CORRECT-A. NC1744.2 +085500 PERFORM FAIL. NC1744.2 +085600 RELAT-WRITE-GF-3. NC1744.2 +085700 MOVE "RELAT-TEST-GF-3" TO PAR-NAME. NC1744.2 +085800 PERFORM PRINT-DETAIL. NC1744.2 +085900 RELAT-INIT-GF-4. NC1744.2 +086000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +086100 MOVE ZERO TO VAL. NC1744.2 +086200 MOVE 9999.9 TO N-27. NC1744.2 +086300 RELAT-TEST-GF-4. NC1744.2 +086400 IF 5280 NOT LESS THAN N-27 NC1744.2 +086500 ADD 1 VAL GIVING VAL. NC1744.2 +086600 IF N-27 NOT LESS THAN 5280 NC1744.2 +086700 GO TO RELAT-CHECK-GF-4. NC1744.2 +086800 ADD 2 VAL GIVING VAL. NC1744.2 +086900 GO TO RELAT-CHECK-GF-4. NC1744.2 +087000 RELAT-DELETE-GF-4. NC1744.2 +087100 PERFORM DE-LETE. NC1744.2 +087200 GO TO RELAT-WRITE-GF-4. NC1744.2 +087300 RELAT-CHECK-GF-4. NC1744.2 +087400 IF VAL EQUAL TO ZERO NC1744.2 +087500 PERFORM PASS NC1744.2 +087600 GO TO RELAT-WRITE-GF-4. NC1744.2 +087700 MOVE VAL TO COMPUTED-A. NC1744.2 +087800 MOVE ZERO TO CORRECT-A. NC1744.2 +087900 PERFORM FAIL. NC1744.2 +088000 RELAT-WRITE-GF-4. NC1744.2 +088100 MOVE "RELAT-TEST-GF-4" TO PAR-NAME. NC1744.2 +088200 PERFORM PRINT-DETAIL. NC1744.2 +088300 RELAT-INIT-GF-5. NC1744.2 +088400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +088500 MOVE ZERO TO VAL. NC1744.2 +088600 MOVE 29 TO N-33. NC1744.2 +088700 MOVE " $75.63" TO X-43. NC1744.2 +088800 RELAT-TEST-GF-5. NC1744.2 +088900 MOVE N-33 TO N-84. NC1744.2 +089000 IF N-33 EQUAL TO N-84 NC1744.2 +089100 ADD 1 VAL GIVING VAL. NC1744.2 +089200 IF N-84 EQUAL TO X-43 NC1744.2 +089300 GO TO RELAT-CHECK-GF-5. NC1744.2 +089400 ADD 2 VAL GIVING VAL. NC1744.2 +089500 GO TO RELAT-CHECK-GF-5. NC1744.2 +089600 RELAT-DELETE-GF-5. NC1744.2 +089700 PERFORM DE-LETE. NC1744.2 +089800 GO TO RELAT-WRITE-GF-5. NC1744.2 +089900 RELAT-CHECK-GF-5. NC1744.2 +090000 IF VAL EQUAL TO 3 NC1744.2 +090100 PERFORM PASS NC1744.2 +090200 GO TO RELAT-WRITE-GF-5. NC1744.2 +090300 MOVE VAL TO COMPUTED-A. NC1744.2 +090400 MOVE 3 TO CORRECT-A. NC1744.2 +090500 PERFORM FAIL. NC1744.2 +090600 RELAT-WRITE-GF-5. NC1744.2 +090700 MOVE "RELAT-TEST-GF-5" TO PAR-NAME. NC1744.2 +090800 PERFORM PRINT-DETAIL. NC1744.2 +090900 RELAT-INIT-GF-6. NC1744.2 +091000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +091100 MOVE ZERO TO VAL. NC1744.2 +091200 MOVE 29 TO N-33. NC1744.2 +091300 MOVE 29 TO N-84. NC1744.2 +091400 MOVE " $75.63" TO X-43. NC1744.2 +091500 RELAT-TEST-GF-6. NC1744.2 +091600 IF N-84 NOT EQUAL TO X-43 NC1744.2 +091700 ADD 1 VAL GIVING VAL. NC1744.2 +091800 IF N-33 NOT EQUAL TO N-84 NC1744.2 +091900 GO TO RELAT-CHECK-GF-6. NC1744.2 +092000 ADD 2 VAL GIVING VAL. NC1744.2 +092100 GO TO RELAT-CHECK-GF-6. NC1744.2 +092200 RELAT-DELETE-GF-6. NC1744.2 +092300 PERFORM DE-LETE. NC1744.2 +092400 GO TO RELAT-WRITE-GF-6. NC1744.2 +092500 RELAT-CHECK-GF-6. NC1744.2 +092600 IF VAL EQUAL TO 3 NC1744.2 +092700 PERFORM PASS NC1744.2 +092800 GO TO RELAT-WRITE-GF-6. NC1744.2 +092900 MOVE VAL TO COMPUTED-A. NC1744.2 +093000 MOVE 3 TO CORRECT-A. NC1744.2 +093100 PERFORM FAIL. NC1744.2 +093200 RELAT-WRITE-GF-6. NC1744.2 +093300 MOVE "RELAT-TEST-GF-6" TO PAR-NAME. NC1744.2 +093400 PERFORM PRINT-DETAIL. NC1744.2 +093500 RELAT-INIT-GF-7. NC1744.2 +093600 MOVE "ABBREV. RELATION" TO FEATURE. NC1744.2 +093700 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +093800 MOVE ZERO TO VAL. NC1744.2 +093900 MOVE 29 TO N-33. NC1744.2 +094000 RELAT-TEST-GF-7. NC1744.2 +094100 IF N-33 GREATER 2 NC1744.2 +094200 PERFORM PASS NC1744.2 +094300 ELSE NC1744.2 +094400 PERFORM FAIL. NC1744.2 +094500 GO TO RELAT-WRITE-GF-7. NC1744.2 +094600 RELAT-DELETE-GF-7. NC1744.2 +094700 PERFORM DE-LETE. NC1744.2 +094800 RELAT-WRITE-GF-7. NC1744.2 +094900 MOVE "RELAT-TEST-GF-7" TO PAR-NAME. NC1744.2 +095000 PERFORM PRINT-DETAIL. NC1744.2 +095100 RELAT-INIT-GF-8. NC1744.2 +095200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +095300 MOVE 29 TO N-33. NC1744.2 +095400 RELAT-TEST-GF-8. NC1744.2 +095500 IF 2 LESS N-33 NC1744.2 +095600 PERFORM PASS NC1744.2 +095700 ELSE NC1744.2 +095800 PERFORM FAIL. NC1744.2 +095900 GO TO RELAT-WRITE-GF-8. NC1744.2 +096000 RELAT-DELETE-GF-8. NC1744.2 +096100 PERFORM DE-LETE. NC1744.2 +096200 RELAT-WRITE-GF-8. NC1744.2 +096300 MOVE "RELAT-TEST-GF-8" TO PAR-NAME. NC1744.2 +096400 PERFORM PRINT-DETAIL. NC1744.2 +096500* NC1744.2 +096600* NC1744.2 +096700 RELAT-INIT-GF-9. NC1744.2 +096800 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +096900 MOVE 29 TO N-33. NC1744.2 +097000 RELAT-TEST-GF-9. NC1744.2 +097100 IF N-33 >= 2 NC1744.2 +097200 PERFORM PASS NC1744.2 +097300 ELSE NC1744.2 +097400 PERFORM FAIL. NC1744.2 +097500 GO TO RELAT-WRITE-GF-9. NC1744.2 +097600 RELAT-DELETE-GF-9. NC1744.2 +097700 PERFORM DE-LETE. NC1744.2 +097800 RELAT-WRITE-GF-9. NC1744.2 +097900 MOVE "RELAT-TEST-GF-9" TO PAR-NAME. NC1744.2 +098000 PERFORM PRINT-DETAIL. NC1744.2 +098100* NC1744.2 +098200* NC1744.2 +098300 RELAT-INIT-GF-10. NC1744.2 +098400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +098500 RELAT-TEST-GF-10. NC1744.2 +098600 IF DATA-5 IS GREATER THAN OR EQUAL TO 4 NC1744.2 +098700 PERFORM PASS NC1744.2 +098800 ELSE NC1744.2 +098900 PERFORM FAIL. NC1744.2 +099000 GO TO RELAT-WRITE-GF-10. NC1744.2 +099100 RELAT-DELETE-GF-10. NC1744.2 +099200 PERFORM DE-LETE. NC1744.2 +099300 RELAT-WRITE-GF-10. NC1744.2 +099400 MOVE "RELAT-TEST-GF-10" TO PAR-NAME. NC1744.2 +099500 PERFORM PRINT-DETAIL. NC1744.2 +099600* NC1744.2 +099700* NC1744.2 +099800 RELAT-INIT-GF-11. NC1744.2 +099900 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +100000 MOVE "X" TO A-37. NC1744.2 +100100 RELAT-TEST-GF-11. NC1744.2 +100200 IF A-37 GREATER OR EQUAL "A" NC1744.2 +100300 PERFORM PASS NC1744.2 +100400 ELSE NC1744.2 +100500 PERFORM FAIL. NC1744.2 +100600 GO TO RELAT-WRITE-GF-11. NC1744.2 +100700 RELAT-DELETE-GF-11. NC1744.2 +100800 PERFORM DE-LETE. NC1744.2 +100900 RELAT-WRITE-GF-11. NC1744.2 +101000 MOVE "RELAT-TEST-GF-11" TO PAR-NAME. NC1744.2 +101100 PERFORM PRINT-DETAIL. NC1744.2 +101200* NC1744.2 +101300* NC1744.2 +101400 RELAT-INIT-GF-12. NC1744.2 +101500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +101600 MOVE 29 TO N-33. NC1744.2 +101700 RELAT-TEST-GF-12. NC1744.2 +101800 IF N-33 GREATER THAN OR EQUAL 2 NC1744.2 +101900 PERFORM PASS NC1744.2 +102000 ELSE NC1744.2 +102100 PERFORM FAIL. NC1744.2 +102200 GO TO RELAT-WRITE-GF-12. NC1744.2 +102300 RELAT-DELETE-GF-12. NC1744.2 +102400 PERFORM DE-LETE. NC1744.2 +102500 RELAT-WRITE-GF-12. NC1744.2 +102600 MOVE "RELAT-TEST-GF-12" TO PAR-NAME. NC1744.2 +102700 PERFORM PRINT-DETAIL. NC1744.2 +102800* NC1744.2 +102900* NC1744.2 +103000 RELAT-INIT-GF-13. NC1744.2 +103100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +103200 RELAT-TEST-GF-13. NC1744.2 +103300 IF DATA-99999 GREATER THAN OR EQUAL TO +99999 NC1744.2 +103400 PERFORM PASS NC1744.2 +103500 ELSE NC1744.2 +103600 PERFORM FAIL. NC1744.2 +103700 GO TO RELAT-WRITE-GF-13. NC1744.2 +103800 RELAT-DELETE-GF-13. NC1744.2 +103900 PERFORM DE-LETE. NC1744.2 +104000 RELAT-WRITE-GF-13. NC1744.2 +104100 MOVE "RELAT-TEST-GF-13" TO PAR-NAME. NC1744.2 +104200 PERFORM PRINT-DETAIL. NC1744.2 +104300* NC1744.2 +104400* NC1744.2 +104500 RELAT-INIT-GF-14. NC1744.2 +104600 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +104700 MOVE "X" TO A-37. NC1744.2 +104800 RELAT-TEST-GF-14. NC1744.2 +104900 IF A-37 IS GREATER OR EQUAL "A" NC1744.2 +105000 PERFORM PASS NC1744.2 +105100 ELSE NC1744.2 +105200 PERFORM FAIL. NC1744.2 +105300 GO TO RELAT-WRITE-GF-14. NC1744.2 +105400 RELAT-DELETE-GF-14. NC1744.2 +105500 PERFORM DE-LETE. NC1744.2 +105600 RELAT-WRITE-GF-14. NC1744.2 +105700 MOVE "RELAT-TEST-GF-14" TO PAR-NAME. NC1744.2 +105800 PERFORM PRINT-DETAIL. NC1744.2 +105900* NC1744.2 +106000* NC1744.2 +106100 RELAT-INIT-GF-15. NC1744.2 +106200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +106300 MOVE "A" TO A-2. NC1744.2 +106400 MOVE "X" TO A-37. NC1744.2 +106500 RELAT-TEST-GF-15. NC1744.2 +106600 IF A-37 IS GREATER THAN OR EQUAL A-2 NC1744.2 +106700 PERFORM PASS NC1744.2 +106800 ELSE NC1744.2 +106900 PERFORM FAIL. NC1744.2 +107000 GO TO RELAT-WRITE-GF-15. NC1744.2 +107100 RELAT-DELETE-GF-15. NC1744.2 +107200 PERFORM DE-LETE. NC1744.2 +107300 RELAT-WRITE-GF-15. NC1744.2 +107400 MOVE "RELAT-TEST-GF-15" TO PAR-NAME. NC1744.2 +107500 PERFORM PRINT-DETAIL. NC1744.2 +107600* NC1744.2 +107700* NC1744.2 +107800 RELAT-INIT-GF-16. NC1744.2 +107900 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +108000 RELAT-TEST-GF-16. NC1744.2 +108100 IF DATA-Z IS >= "Y" NC1744.2 +108200 PERFORM PASS NC1744.2 +108300 ELSE NC1744.2 +108400 PERFORM FAIL. NC1744.2 +108500 GO TO RELAT-WRITE-GF-16. NC1744.2 +108600 RELAT-DELETE-GF-16. NC1744.2 +108700 PERFORM DE-LETE. NC1744.2 +108800 RELAT-WRITE-GF-16. NC1744.2 +108900 MOVE "RELAT-TEST-GF-16" TO PAR-NAME. NC1744.2 +109000 PERFORM PRINT-DETAIL. NC1744.2 +109100* NC1744.2 +109200* NC1744.2 +109300 RELAT-INIT-GF-17. NC1744.2 +109400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +109500 MOVE 29 TO N-33. NC1744.2 +109600 RELAT-TEST-GF-17. NC1744.2 +109700 IF 2 <= N-33 NC1744.2 +109800 PERFORM PASS NC1744.2 +109900 ELSE NC1744.2 +110000 PERFORM FAIL. NC1744.2 +110100 GO TO RELAT-WRITE-GF-17. NC1744.2 +110200 RELAT-DELETE-GF-17. NC1744.2 +110300 PERFORM DE-LETE. NC1744.2 +110400 RELAT-WRITE-GF-17. NC1744.2 +110500 MOVE "RELAT-TEST-GF-17" TO PAR-NAME. NC1744.2 +110600 PERFORM PRINT-DETAIL. NC1744.2 +110700* NC1744.2 +110800* NC1744.2 +110900 RELAT-INIT-GF-18. NC1744.2 +111000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +111100 RELAT-TEST-GF-18. NC1744.2 +111200 IF DATA-4 IS LESS THAN OR EQUAL TO 5 NC1744.2 +111300 PERFORM PASS NC1744.2 +111400 ELSE NC1744.2 +111500 PERFORM FAIL. NC1744.2 +111600 GO TO RELAT-WRITE-GF-18. NC1744.2 +111700 RELAT-DELETE-GF-18. NC1744.2 +111800 PERFORM DE-LETE. NC1744.2 +111900 RELAT-WRITE-GF-18. NC1744.2 +112000 MOVE "RELAT-TEST-GF-18" TO PAR-NAME. NC1744.2 +112100 PERFORM PRINT-DETAIL. NC1744.2 +112200* NC1744.2 +112300* NC1744.2 +112400 RELAT-INIT-GF-19. NC1744.2 +112500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +112600 MOVE "X" TO A-37. NC1744.2 +112700 RELAT-TEST-GF-19. NC1744.2 +112800 IF "A" LESS OR EQUAL A-37 NC1744.2 +112900 PERFORM PASS NC1744.2 +113000 ELSE NC1744.2 +113100 PERFORM FAIL. NC1744.2 +113200 GO TO RELAT-WRITE-GF-19. NC1744.2 +113300 RELAT-DELETE-GF-19. NC1744.2 +113400 PERFORM DE-LETE. NC1744.2 +113500 RELAT-WRITE-GF-19. NC1744.2 +113600 MOVE "RELAT-TEST-GF-19" TO PAR-NAME. NC1744.2 +113700 PERFORM PRINT-DETAIL. NC1744.2 +113800* NC1744.2 +113900* NC1744.2 +114000 RELAT-INIT-GF-20. NC1744.2 +114100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +114200 MOVE 29 TO N-33. NC1744.2 +114300 RELAT-TEST-GF-20. NC1744.2 +114400 IF 2 LESS THAN OR EQUAL N-33 NC1744.2 +114500 PERFORM PASS NC1744.2 +114600 ELSE NC1744.2 +114700 PERFORM FAIL. NC1744.2 +114800 GO TO RELAT-WRITE-GF-20. NC1744.2 +114900 RELAT-DELETE-GF-20. NC1744.2 +115000 PERFORM DE-LETE. NC1744.2 +115100 RELAT-WRITE-GF-20. NC1744.2 +115200 MOVE "RELAT-TEST-GF-20" TO PAR-NAME. NC1744.2 +115300 PERFORM PRINT-DETAIL. NC1744.2 +115400* NC1744.2 +115500* NC1744.2 +115600 RELAT-INIT-GF-21. NC1744.2 +115700 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +115800 RELAT-TEST-GF-21. NC1744.2 +115900 IF DATA-99999 LESS THAN OR EQUAL TO +99999 NC1744.2 +116000 PERFORM PASS NC1744.2 +116100 ELSE NC1744.2 +116200 PERFORM FAIL. NC1744.2 +116300 GO TO RELAT-WRITE-GF-21. NC1744.2 +116400 RELAT-DELETE-GF-21. NC1744.2 +116500 PERFORM DE-LETE. NC1744.2 +116600 RELAT-WRITE-GF-21. NC1744.2 +116700 MOVE "RELAT-TEST-GF-21" TO PAR-NAME. NC1744.2 +116800 PERFORM PRINT-DETAIL. NC1744.2 +116900* NC1744.2 +117000* NC1744.2 +117100 RELAT-INIT-GF-22. NC1744.2 +117200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +117300 MOVE "X" TO A-37. NC1744.2 +117400 RELAT-TEST-GF-22. NC1744.2 +117500 IF "A" IS LESS OR EQUAL A-37 NC1744.2 +117600 PERFORM PASS NC1744.2 +117700 ELSE NC1744.2 +117800 PERFORM FAIL. NC1744.2 +117900 GO TO RELAT-WRITE-GF-22. NC1744.2 +118000 RELAT-DELETE-GF-22. NC1744.2 +118100 PERFORM DE-LETE. NC1744.2 +118200 RELAT-WRITE-GF-22. NC1744.2 +118300 MOVE "RELAT-TEST-GF-22" TO PAR-NAME. NC1744.2 +118400 PERFORM PRINT-DETAIL. NC1744.2 +118500* NC1744.2 +118600* NC1744.2 +118700 RELAT-INIT-GF-23. NC1744.2 +118800 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +118900 MOVE "A" TO A-2. NC1744.2 +119000 MOVE "X" TO A-37. NC1744.2 +119100 RELAT-TEST-GF-23. NC1744.2 +119200 IF A-2 IS LESS THAN OR EQUAL A-37 NC1744.2 +119300 PERFORM PASS NC1744.2 +119400 ELSE NC1744.2 +119500 PERFORM FAIL. NC1744.2 +119600 GO TO RELAT-WRITE-GF-23. NC1744.2 +119700 RELAT-DELETE-GF-23. NC1744.2 +119800 PERFORM DE-LETE. NC1744.2 +119900 RELAT-WRITE-GF-23. NC1744.2 +120000 MOVE "RELAT-TEST-GF-23" TO PAR-NAME. NC1744.2 +120100 PERFORM PRINT-DETAIL. NC1744.2 +120200* NC1744.2 +120300* NC1744.2 +120400 RELAT-INIT-GF-24. NC1744.2 +120500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +120600 RELAT-TEST-GF-24. NC1744.2 +120700 IF DATA-Y IS <= "Z" NC1744.2 +120800 PERFORM PASS NC1744.2 +120900 ELSE NC1744.2 +121000 PERFORM FAIL. NC1744.2 +121100 GO TO RELAT-WRITE-GF-24. NC1744.2 +121200 RELAT-DELETE-GF-24. NC1744.2 +121300 PERFORM DE-LETE. NC1744.2 +121400 RELAT-WRITE-GF-24. NC1744.2 +121500 MOVE "RELAT-TEST-GF-24" TO PAR-NAME. NC1744.2 +121600 PERFORM PRINT-DETAIL. NC1744.2 +121700* NC1744.2 +121800* NC1744.2 +121900 CLASS-INIT-GF-1. NC1744.2 +122000 PERFORM END-ROUTINE. NC1744.2 +122100 MOVE "CLASS ---" TO FEATURE. NC1744.2 +122200 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +122300 PERFORM PRINT-DETAIL. NC1744.2 +122400 MOVE ZERO TO N-31. NC1744.2 +122500 CLASS-TEST-GF-1. NC1744.2 +122600 IF X-32 NUMERIC NC1744.2 +122700 PERFORM PASS NC1744.2 +122800 GO TO CLASS-WRITE-GF-1. NC1744.2 +122900 PERFORM FAIL. NC1744.2 +123000 GO TO CLASS-WRITE-GF-1. NC1744.2 +123100 CLASS-DELETE-GF-1. NC1744.2 +123200 PERFORM DE-LETE. NC1744.2 +123300 CLASS-WRITE-GF-1. NC1744.2 +123400 MOVE " NUMERIC " TO FEATURE. NC1744.2 +123500 MOVE "CLASS-TEST-GF-1" TO PAR-NAME. NC1744.2 +123600 PERFORM PRINT-DETAIL. NC1744.2 +123700 CLASS-INIT-GF-2. NC1744.2 +123800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +123900 MOVE "X" TO A-37. NC1744.2 +124000 CLASS-TEST-GF-2. NC1744.2 +124100 IF X-38 NOT NUMERIC NC1744.2 +124200 PERFORM PASS NC1744.2 +124300 GO TO CLASS-WRITE-GF-2. NC1744.2 +124400 PERFORM FAIL. NC1744.2 +124500 GO TO CLASS-WRITE-GF-2. NC1744.2 +124600 CLASS-DELETE-GF-2. NC1744.2 +124700 PERFORM DE-LETE. NC1744.2 +124800 CLASS-WRITE-GF-2. NC1744.2 +124900 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +125000 MOVE "CLASS-TEST-GF-2" TO PAR-NAME. NC1744.2 +125100 PERFORM PRINT-DETAIL. NC1744.2 +125200 CLASS-INIT-GF-3. NC1744.2 +125300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +125400 MOVE "X" TO A-37. NC1744.2 +125500 CLASS-TEST-GF-3. NC1744.2 +125600 IF X-38 IS NOT NUMERIC NC1744.2 +125700 PERFORM PASS NC1744.2 +125800 GO TO CLASS-WRITE-GF-3. NC1744.2 +125900 PERFORM FAIL. NC1744.2 +126000 GO TO CLASS-WRITE-GF-3. NC1744.2 +126100 CLASS-DELETE-GF-3. NC1744.2 +126200 PERFORM DE-LETE. NC1744.2 +126300 CLASS-WRITE-GF-3. NC1744.2 +126400 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +126500 MOVE "CLASS-TEST-GF-3" TO PAR-NAME. NC1744.2 +126600 PERFORM PRINT-DETAIL. NC1744.2 +126700 CLASS-INIT-GF-4. NC1744.2 +126800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +126900 MOVE -1 TO DUMMY-DS-00001. NC1744.2 +127000 CLASS-TEST-GF-4. NC1744.2 +127100 IF DUMMY-DS-00001 IS NUMERIC NC1744.2 +127200 PERFORM PASS NC1744.2 +127300 GO TO CLASS-WRITE-GF-4. NC1744.2 +127400 PERFORM FAIL. NC1744.2 +127500 GO TO CLASS-WRITE-GF-4. NC1744.2 +127600 CLASS-DELETE-GF-4. NC1744.2 +127700 PERFORM DE-LETE. NC1744.2 +127800 CLASS-WRITE-GF-4. NC1744.2 +127900 MOVE "CLASS-TEST-GF-4" TO PAR-NAME. NC1744.2 +128000 PERFORM PRINT-DETAIL. NC1744.2 +128100 CLASS-INIT-GF-5. NC1744.2 +128200 MOVE " NUMERIC " TO FEATURE. NC1744.2 +128300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +128400 MOVE "111111111111111111" TO ONES-XN-00018. NC1744.2 +128500 CLASS-TEST-GF-5. NC1744.2 +128600 IF ONES-XN-00018 IS NUMERIC NC1744.2 +128700 PERFORM PASS NC1744.2 +128800 GO TO CLASS-WRITE-GF-5. NC1744.2 +128900 MOVE ONES-XN-00018 TO COMPUTED-A. NC1744.2 +129000 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +129100 PERFORM FAIL. NC1744.2 +129200 GO TO CLASS-WRITE-GF-5. NC1744.2 +129300 CLASS-DELETE-GF-5. NC1744.2 +129400 PERFORM DE-LETE. NC1744.2 +129500 CLASS-WRITE-GF-5. NC1744.2 +129600 MOVE "CLASS-TEST-GF-5 " TO PAR-NAME. NC1744.2 +129700 PERFORM PRINT-DETAIL. NC1744.2 +129800 CLASS-INIT-GF-6. NC1744.2 +129900 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +130000 MOVE +022.00 TO A02TWOS-DS-03V02. NC1744.2 +130100 CLASS-TEST-GF-6. NC1744.2 +130200 IF A02TWOS-DS-03V02 IS NUMERIC NC1744.2 +130300 PERFORM PASS NC1744.2 +130400 GO TO CLASS-WRITE-GF-6. NC1744.2 +130500 MOVE A02TWOS-DS-03V02 TO COMPUTED-N. NC1744.2 +130600 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +130700 PERFORM FAIL. NC1744.2 +130800 GO TO CLASS-WRITE-GF-6. NC1744.2 +130900 CLASS-DELETE-GF-6. NC1744.2 +131000 PERFORM DE-LETE. NC1744.2 +131100 CLASS-WRITE-GF-6. NC1744.2 +131200 MOVE "CLASS-TEST-GF-6 " TO PAR-NAME. NC1744.2 +131300 PERFORM PRINT-DETAIL. NC1744.2 +131400 CLASS-INIT-GF-7. NC1744.2 +131500 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +131600 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +131700 CLASS-TEST-GF-7. NC1744.2 +131800 IF XDATA-XN-00018 IS NUMERIC NC1744.2 +131900 MOVE XDATA-XN-00018 TO COMPUTED-A NC1744.2 +132000 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +132100 PERFORM FAIL NC1744.2 +132200 GO TO CLASS-WRITE-GF-7. NC1744.2 +132300 PERFORM PASS. NC1744.2 +132400 GO TO CLASS-WRITE-GF-7. NC1744.2 +132500 CLASS-DELETE-GF-7. NC1744.2 +132600 PERFORM DE-LETE. NC1744.2 +132700 CLASS-WRITE-GF-7. NC1744.2 +132800 MOVE "CLASS-TEST-GF-7 " TO PAR-NAME. NC1744.2 +132900 PERFORM PRINT-DETAIL. NC1744.2 +133000 CLASS-INIT-GF-8. NC1744.2 +133100 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +133200 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +133300 CLASS-TEST-GF-8. NC1744.2 +133400 IF XDATA-DS-18V00-S IS NUMERIC NC1744.2 +133500 MOVE XDATA-DS-18V00-S TO COMPUTED-A NC1744.2 +133600 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +133700 PERFORM FAIL NC1744.2 +133800 GO TO CLASS-WRITE-GF-8. NC1744.2 +133900 PERFORM PASS. NC1744.2 +134000 GO TO CLASS-WRITE-GF-8. NC1744.2 +134100 CLASS-DELETE-GF-8. NC1744.2 +134200 PERFORM DE-LETE. NC1744.2 +134300 CLASS-WRITE-GF-8. NC1744.2 +134400 MOVE "CLASS-TEST-GF-8 " TO PAR-NAME. NC1744.2 +134500 PERFORM PRINT-DETAIL. NC1744.2 +134600 CLASS-INIT-GF-9. NC1744.2 +134700 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +134800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +134900 MOVE SPACE TO CORRECT-A. NC1744.2 +135000 CLASS-TEST-GF-9. NC1744.2 +135100 IF CORRECT-A NOT NUMERIC NC1744.2 +135200 PERFORM PASS NC1744.2 +135300 GO TO CLASS-WRITE-GF-9. NC1744.2 +135400 MOVE CORRECT-A TO COMPUTED-A. NC1744.2 +135500 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +135600 PERFORM FAIL. NC1744.2 +135700 GO TO CLASS-WRITE-GF-9. NC1744.2 +135800 CLASS-DELETE-GF-9. NC1744.2 +135900 PERFORM DE-LETE. NC1744.2 +136000 CLASS-WRITE-GF-9. NC1744.2 +136100 MOVE "CLASS-TEST-GF-9 " TO PAR-NAME. NC1744.2 +136200 PERFORM PRINT-DETAIL. NC1744.2 +136300 CLASS-INIT-GF-10. NC1744.2 +136400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +136500 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +136600 CLASS-TEST-GF-10. NC1744.2 +136700 IF XDATA-DS-18V00-S NOT NUMERIC NC1744.2 +136800 PERFORM PASS NC1744.2 +136900 GO TO CLASS-WRITE-GF-10. NC1744.2 +137000 MOVE XDATA-DS-18V00-S TO COMPUTED-A NC1744.2 +137100 MOVE "NONNUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +137200 PERFORM FAIL. NC1744.2 +137300 GO TO CLASS-WRITE-GF-10. NC1744.2 +137400 CLASS-DELETE-GF-10. NC1744.2 +137500 PERFORM DE-LETE. NC1744.2 +137600 CLASS-WRITE-GF-10. NC1744.2 +137700 MOVE "CLASS-TEST-GF-10" TO PAR-NAME. NC1744.2 +137800 PERFORM PRINT-DETAIL. NC1744.2 +137900 CLASS-INIT-GF-11. NC1744.2 +138000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +138100 MOVE ZERO TO CORRECT-A. NC1744.2 +138200 CLASS-TEST-GF-11. NC1744.2 +138300 IF CORRECT-A IS NOT NUMERIC NC1744.2 +138400 MOVE CORRECT-A TO COMPUTED-A NC1744.2 +138500 MOVE "NUMERIC EXPECTED" TO CORRECT-A NC1744.2 +138600 PERFORM FAIL NC1744.2 +138700 GO TO CLASS-WRITE-GF-11. NC1744.2 +138800 PERFORM PASS. NC1744.2 +138900 MOVE SPACE TO CORRECT-A. NC1744.2 +139000 GO TO CLASS-WRITE-GF-11. NC1744.2 +139100 CLASS-DELETE-GF-11. NC1744.2 +139200 PERFORM DE-LETE. NC1744.2 +139300 CLASS-WRITE-GF-11. NC1744.2 +139400 MOVE "CLASS-TEST-GF-11" TO PAR-NAME. NC1744.2 +139500 PERFORM PRINT-DETAIL. NC1744.2 +139600 CLASS-INIT-GF-12. NC1744.2 +139700 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +139800 MOVE +990 TO A990-DS-0201P. NC1744.2 +139900 CLASS-TEST-GF-12. NC1744.2 +140000 IF A990-DS-0201P IS NOT NUMERIC NC1744.2 +140100 MOVE A990-DS-0201P TO CORRECT-N NC1744.2 +140200 MOVE "NUMERIC EXPECTED" TO COMPUTED-A NC1744.2 +140300 PERFORM FAIL NC1744.2 +140400 GO TO CLASS-WRITE-GF-12. NC1744.2 +140500 PERFORM PASS. NC1744.2 +140600 GO TO CLASS-WRITE-GF-12. NC1744.2 +140700 CLASS-DELETE-GF-12. NC1744.2 +140800 PERFORM DE-LETE. NC1744.2 +140900 CLASS-WRITE-GF-12. NC1744.2 +141000 MOVE "CLASS-TEST-GF-12" TO PAR-NAME. NC1744.2 +141100 PERFORM PRINT-DETAIL. NC1744.2 +141200 CLASS-INIT-13. NC1744.2 +141300 MOVE " ALPHABETIC " TO FEATURE. NC1744.2 +141400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +141500 MOVE "ABCDEFGHIJ" TO YADATA-XN-00010. NC1744.2 +141600 CLASS-TEST-GF-13. NC1744.2 +141700 IF YADATA-XN-00010 IS ALPHABETIC NC1744.2 +141800 PERFORM PASS NC1744.2 +141900 GO TO CLASS-WRITE-GF-13. NC1744.2 +142000 MOVE YADATA-XN-00010 TO COMPUTED-A. NC1744.2 +142100 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +142200 PERFORM FAIL. NC1744.2 +142300 GO TO CLASS-WRITE-GF-13. NC1744.2 +142400 CLASS-DELETE-GF-13. NC1744.2 +142500 PERFORM DE-LETE. NC1744.2 +142600 CLASS-WRITE-GF-13. NC1744.2 +142700 MOVE "CLASS-TEST-GF-13" TO PAR-NAME. NC1744.2 +142800 PERFORM PRINT-DETAIL. NC1744.2 +142900 CLASS-INIT-14. NC1744.2 +143000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +143100 MOVE ZERO TO CORRECT-A. NC1744.2 +143200 CLASS-TEST-GF-14. NC1744.2 +143300 IF CORRECT-A ALPHABETIC NC1744.2 +143400 MOVE CORRECT-A TO COMPUTED-A NC1744.2 +143500 MOVE "NUMERIC EXPECTED" TO CORRECT-A NC1744.2 +143600 PERFORM FAIL NC1744.2 +143700 GO TO CLASS-WRITE-GF-14. NC1744.2 +143800 PERFORM PASS. NC1744.2 +143900 MOVE SPACE TO CORRECT-A NC1744.2 +144000 GO TO CLASS-WRITE-GF-14. NC1744.2 +144100 CLASS-DELETE-GF-14. NC1744.2 +144200 PERFORM DE-LETE. NC1744.2 +144300 CLASS-WRITE-GF-14. NC1744.2 +144400 MOVE "CLASS-TEST-GF-14" TO PAR-NAME. NC1744.2 +144500 PERFORM PRINT-DETAIL. NC1744.2 +144600 CLASS-INIT-GF-15. NC1744.2 +144700 MOVE " NOT ALPHABETIC " TO FEATURE. NC1744.2 +144800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +144900 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +145000 CLASS-TEST-GF-15. NC1744.2 +145100 IF XDATA-XN-00018 IS NOT ALPHABETIC NC1744.2 +145200 PERFORM PASS NC1744.2 +145300 GO TO CLASS-WRITE-GF-15. NC1744.2 +145400 MOVE XDATA-XN-00018 TO COMPUTED-A. NC1744.2 +145500 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +145600 PERFORM FAIL. NC1744.2 +145700 GO TO CLASS-WRITE-GF-15. NC1744.2 +145800 CLASS-DELETE-GF-15. NC1744.2 +145900 PERFORM DE-LETE. NC1744.2 +146000 CLASS-WRITE-GF-15. NC1744.2 +146100 MOVE "CLASS-TEST-GF-15" TO PAR-NAME. NC1744.2 +146200 PERFORM PRINT-DETAIL. NC1744.2 +146300 CLASS-INIT-GF-16. NC1744.2 +146400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +146500 MOVE "ABCDEFGHIJ" TO YADATA-XN-00010. NC1744.2 +146600 CLASS-TEST-GF-16. NC1744.2 +146700 IF YADATA-XN-00010 IS NOT ALPHABETIC NC1744.2 +146800 MOVE YADATA-XN-00010 TO COMPUTED-A NC1744.2 +146900 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +147000 PERFORM FAIL NC1744.2 +147100 GO TO CLASS-WRITE-GF-16. NC1744.2 +147200 PERFORM PASS. NC1744.2 +147300 GO TO CLASS-WRITE-GF-16. NC1744.2 +147400 CLASS-DELETE-GF-16. NC1744.2 +147500 PERFORM DE-LETE. NC1744.2 +147600 CLASS-WRITE-GF-16. NC1744.2 +147700 MOVE "CLASS-TEST-GF-16" TO PAR-NAME. NC1744.2 +147800 PERFORM PRINT-DETAIL. NC1744.2 +147900*CLASS-TEST-17. NC1744.2 +148000* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1744.2 +148100* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1744.2 +148200 CLASS-INIT-GF-17. NC1744.2 +148300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +148400 MOVE 0 TO NUMERIC-1. NC1744.2 +148500 MOVE ZERO TO NUMERIC-3. NC1744.2 +148600 MOVE 1 TO NUMERIC-5. NC1744.2 +148700 MOVE "7" TO NUMERIC-7. NC1744.2 +148800 MOVE 8 TO NUMERIC-8. NC1744.2 +148900 CLASS-TEST-GF-17. NC1744.2 +149000 IF NUMERIC-GRP-TEST NUMERIC NC1744.2 +149100 PERFORM PASS NC1744.2 +149200 GO TO CLASS-WRITE-GF-17. NC1744.2 +149300 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +149400 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +149500 PERFORM FAIL. NC1744.2 +149600 GO TO CLASS-WRITE-GF-17. NC1744.2 +149700 CLASS-DELETE-GF-17. NC1744.2 +149800 PERFORM DE-LETE. NC1744.2 +149900 CLASS-WRITE-GF-17. NC1744.2 +150000 MOVE "CLASS-TEST-GF-17" TO PAR-NAME. NC1744.2 +150100 PERFORM PRINT-DETAIL. NC1744.2 +150200 CLASS-INIT-GF-18. NC1744.2 +150300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +150400 MOVE ZERO TO NUMERIC-3. NC1744.2 +150500 MOVE 1 TO NUMERIC-5. NC1744.2 +150600 CLASS-TEST-GF-18. NC1744.2 +150700 IF NUMERIC-2 NUMERIC NC1744.2 +150800 PERFORM PASS NC1744.2 +150900 GO TO CLASS-WRITE-GF-18. NC1744.2 +151000 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +151100 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +151200 PERFORM FAIL. NC1744.2 +151300 GO TO CLASS-WRITE-GF-18. NC1744.2 +151400 CLASS-DELETE-GF-18. NC1744.2 +151500 PERFORM DE-LETE. NC1744.2 +151600 CLASS-WRITE-GF-18. NC1744.2 +151700 MOVE "CLASS-TEST-GF-18" TO PAR-NAME. NC1744.2 +151800 PERFORM PRINT-DETAIL. NC1744.2 +151900 CLASS-INIT-GF-19. NC1744.2 +152000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +152100 MOVE 1 TO NUMERIC-5. NC1744.2 +152200 CLASS-TEST-GF-19. NC1744.2 +152300 IF NUMERIC-4 NUMERIC NC1744.2 +152400 PERFORM PASS NC1744.2 +152500 GO TO CLASS-WRITE-GF-19. NC1744.2 +152600 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +152700 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +152800 PERFORM FAIL. NC1744.2 +152900 GO TO CLASS-WRITE-GF-19. NC1744.2 +153000 CLASS-DELETE-GF-19. NC1744.2 +153100 PERFORM DE-LETE. NC1744.2 +153200 CLASS-WRITE-GF-19. NC1744.2 +153300 MOVE "CLASS-TEST-GF-19" TO PAR-NAME. NC1744.2 +153400 PERFORM PRINT-DETAIL. NC1744.2 +153500 CLASS-INIT-GF-20. NC1744.2 +153600 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +153700 MOVE "7" TO NUMERIC-7. NC1744.2 +153800 MOVE 8 TO NUMERIC-8. NC1744.2 +153900 CLASS-TEST-GF-20. NC1744.2 +154000 IF NUMERIC-6 NUMERIC NC1744.2 +154100 PERFORM PASS NC1744.2 +154200 GO TO CLASS-WRITE-GF-20. NC1744.2 +154300 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +154400 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +154500 PERFORM FAIL. NC1744.2 +154600 GO TO CLASS-WRITE-GF-20. NC1744.2 +154700 CLASS-DELETE-GF-20. NC1744.2 +154800 PERFORM DE-LETE. NC1744.2 +154900 CLASS-WRITE-GF-20. NC1744.2 +155000 MOVE "CLASS-TEST-GF-20" TO PAR-NAME. NC1744.2 +155100 PERFORM PRINT-DETAIL. NC1744.2 +155200*CLASS-TEST-22. NC1744.2 +155300* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1744.2 +155400* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1744.2 +155500* NC1744.2 +155600* NC1744.2 +155700 CLASS-INIT-35. NC1744.2 +155800 MOVE "V1-56 6.3.1.2(3,4)" TO ANSI-REFERENCE. NC1744.2 +155900 MOVE " ALPHABETIC-UPPER " TO FEATURE. NC1744.2 +156000 MOVE " UPPERCASE CHARS" TO ALPHA-UPPER. NC1744.2 +156100 CLASS-TEST-GF-35. NC1744.2 +156200 IF ALPHA-UPPER ALPHABETIC-UPPER NC1744.2 +156300 PERFORM PASS NC1744.2 +156400 GO TO CLASS-WRITE-GF-35. NC1744.2 +156500 MOVE "SEE PROGRAM FOR RESULTS " TO CORRECT-A. NC1744.2 +156600 MOVE "UPPERCASE CHARS " TO COMPUTED-A. NC1744.2 +156700 MOVE "UPPERCASE CHARS NOT ACCEPTED AS ALPHABETIC-UPPER" NC1744.2 +156800 TO RE-MARK. NC1744.2 +156900 PERFORM FAIL. NC1744.2 +157000 GO TO CLASS-WRITE-GF-35. NC1744.2 +157100 CLASS-DELETE-GF-35. NC1744.2 +157200 PERFORM DE-LETE. NC1744.2 +157300 CLASS-WRITE-GF-35. NC1744.2 +157400 MOVE "CLASS-TEST-GF-35" TO PAR-NAME. NC1744.2 +157500 PERFORM PRINT-DETAIL. NC1744.2 +157600* NC1744.2 +157700* NC1744.2 +157800* NC1744.2 +157900* NC1744.2 +158000 CLASS-INIT-36. NC1744.2 +158100 MOVE " ALPHABETIC-LOWER " TO FEATURE. NC1744.2 +158200 MOVE " lowercase chars" TO ALPHA-LOWER. NC1744.2 +158300 MOVE "V1-56 6.3.1.2(3,4)" TO ANSI-REFERENCE. NC1744.2 +158400 CLASS-TEST-GF-36. NC1744.2 +158500 IF ALPHA-LOWER ALPHABETIC-LOWER NC1744.2 +158600 PERFORM PASS NC1744.2 +158700 GO TO CLASS-WRITE-GF-36. NC1744.2 +158800 MOVE "SEE PROGRAM" TO CORRECT-A. NC1744.2 +158900 MOVE "lowercase chars" TO COMPUTED-A. NC1744.2 +159000 MOVE "LOWERCASE CHARS NOT ACCEPTED AS ALPHABETIC-LOWER" NC1744.2 +159100 TO RE-MARK. NC1744.2 +159200 PERFORM FAIL. NC1744.2 +159300 GO TO CLASS-WRITE-GF-36. NC1744.2 +159400 CLASS-DELETE-GF-36. NC1744.2 +159500 PERFORM DE-LETE. NC1744.2 +159600 CLASS-WRITE-GF-36. NC1744.2 +159700 MOVE "CLASS-TEST-GF-36" TO PAR-NAME. NC1744.2 +159800 PERFORM PRINT-DETAIL. NC1744.2 +159900* NC1744.2 +160000* NC1744.2 +160100 CLASS-INIT-37. NC1744.2 +160200 MOVE "V1-56 6.3.1.2(2)" TO ANSI-REFERENCE. NC1744.2 +160300 MOVE "UPPER & LOWER CASE " TO FEATURE. NC1744.2 +160400 move "AbCdEfGhIj" TO YADATA-XN-00010-U-AND-L. NC1744.2 +160500 CLASS-TEST-GF-37. NC1744.2 +160600 IF YADATA-XN-00010-U-AND-L IS ALPHABETIC NC1744.2 +160700 PERFORM PASS NC1744.2 +160800 GO TO CLASS-WRITE-GF-37. NC1744.2 +160900 MOVE YADATA-XN-00010-U-AND-L TO COMPUTED-A. NC1744.2 +161000 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +161100 MOVE "UPPER & LOWER CASE NOT ACCEPTED AS ALPHABETIC" NC1744.2 +161200 TO RE-MARK. NC1744.2 +161300 PERFORM FAIL. NC1744.2 +161400 GO TO CLASS-WRITE-GF-37. NC1744.2 +161500 CLASS-DELETE-GF-37. NC1744.2 +161600 PERFORM DE-LETE. NC1744.2 +161700 CLASS-WRITE-GF-37. NC1744.2 +161800 MOVE "CLASS-TEST-GF-37" TO PAR-NAME. NC1744.2 +161900 PERFORM PRINT-DETAIL. NC1744.2 +162000* NC1744.2 +162100* NC1744.2 +162200 CLASS-INIT-38. NC1744.2 +162300 MOVE "V1-56 6.3.1.2(2)" TO ANSI-REFERENCE. NC1744.2 +162400 move "AbCdEfGhIj" TO YADATA-XN-00010-U-AND-L. NC1744.2 +162500 CLASS-TEST-GF-38. NC1744.2 +162600 IF YADATA-XN-00010-U-AND-L IS NOT ALPHABETIC NC1744.2 +162700 MOVE YADATA-XN-00010-U-AND-L TO COMPUTED-A NC1744.2 +162800 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +162900 MOVE "UPPER & LOWER CASE NOT ACCEPTED AS ALPHABETIC"NC1744.2 +163000 TO RE-MARK NC1744.2 +163100 PERFORM FAIL NC1744.2 +163200 GO TO CLASS-WRITE-GF-38. NC1744.2 +163300 PERFORM PASS. NC1744.2 +163400 GO TO CLASS-WRITE-GF-38. NC1744.2 +163500 CLASS-DELETE-GF-38. NC1744.2 +163600 PERFORM DE-LETE. NC1744.2 +163700 CLASS-WRITE-GF-38. NC1744.2 +163800 MOVE "CLASS-TEST-GF-38" TO PAR-NAME. NC1744.2 +163900 PERFORM PRINT-DETAIL. NC1744.2 +164000* NC1744.2 +164100* NC1744.2 +164200 CLASS-INIT-39. NC1744.2 +164300 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +164400 TO ANSI-REFERENCE. NC1744.2 +164500 MOVE "NEW CLASS TESTS" TO FEATURE. NC1744.2 +164600 MOVE "CLASS-TEST-GF-39" TO PAR-NAME. NC1744.2 +164700 MOVE "A" TO WS-A. NC1744.2 +164800 GO TO CLASS-TEST-GF-39. NC1744.2 +164900 CLASS-DELETE-GF-39. NC1744.2 +165000 PERFORM DE-LETE. NC1744.2 +165100 PERFORM PRINT-DETAIL. NC1744.2 +165200 GO TO CLASS-INIT-40. NC1744.2 +165300 CLASS-TEST-GF-39. NC1744.2 +165400 IF WS-A ORDINAL-A-ONLY NC1744.2 +165500 PERFORM PASS NC1744.2 +165600 PERFORM PRINT-DETAIL NC1744.2 +165700 ELSE NC1744.2 +165800 MOVE "LETTER 'A' SHOULD BE ORDINAL-A-ONLY" NC1744.2 +165900 TO RE-MARK NC1744.2 +166000 PERFORM FAIL NC1744.2 +166100 PERFORM PRINT-DETAIL. NC1744.2 +166200* NC1744.2 +166300* NC1744.2 +166400 CLASS-INIT-40. NC1744.2 +166500 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +166600 TO ANSI-REFERENCE. NC1744.2 +166700 MOVE "CLASS-TEST-GF-40" TO PAR-NAME. NC1744.2 +166800 MOVE "Z" TO WS-A. NC1744.2 +166900 GO TO CLASS-TEST-GF-40. NC1744.2 +167000 CLASS-DELETE-GF-40. NC1744.2 +167100 PERFORM DE-LETE. NC1744.2 +167200 PERFORM PRINT-DETAIL. NC1744.2 +167300 GO TO CLASS-INIT-41. NC1744.2 +167400 CLASS-TEST-GF-40. NC1744.2 +167500 IF WS-A NOT ORDINAL-A-ONLY NC1744.2 +167600 PERFORM PASS NC1744.2 +167700 PERFORM PRINT-DETAIL NC1744.2 +167800 ELSE NC1744.2 +167900 MOVE "LETTER 'Z' SHOULD NOT BE ORDINAL-A-ONLY" NC1744.2 +168000 TO RE-MARK NC1744.2 +168100 PERFORM FAIL NC1744.2 +168200 PERFORM PRINT-DETAIL. NC1744.2 +168300* NC1744.2 +168400* NC1744.2 +168500 CLASS-INIT-41. NC1744.2 +168600 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +168700 TO ANSI-REFERENCE. NC1744.2 +168800 MOVE "CLASS-TEST-GF-41" TO PAR-NAME. NC1744.2 +168900 MOVE "ADCBA" TO WS-B. NC1744.2 +169000 GO TO CLASS-TEST-GF-41. NC1744.2 +169100 CLASS-DELETE-GF-41. NC1744.2 +169200 PERFORM DE-LETE. NC1744.2 +169300 PERFORM PRINT-DETAIL. NC1744.2 +169400 GO TO CLASS-INIT-42. NC1744.2 +169500 CLASS-TEST-GF-41. NC1744.2 +169600 IF WS-B ORDINAL-A-THROUGH-D NC1744.2 +169700 PERFORM PASS NC1744.2 +169800 PERFORM PRINT-DETAIL NC1744.2 +169900 ELSE NC1744.2 +170000 MOVE "'ADCBA' SHOULD BE ORDINAL-A-THROUGH-D" NC1744.2 +170100 TO RE-MARK NC1744.2 +170200 PERFORM FAIL NC1744.2 +170300 PERFORM PRINT-DETAIL. NC1744.2 +170400* NC1744.2 +170500* NC1744.2 +170600 CLASS-INIT-42. NC1744.2 +170700 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +170800 TO ANSI-REFERENCE. NC1744.2 +170900 MOVE "CLASS-TEST-GF-42" TO PAR-NAME. NC1744.2 +171000 MOVE "VWXYZ" TO WS-B. NC1744.2 +171100 GO TO CLASS-TEST-GF-42. NC1744.2 +171200 CLASS-DELETE-GF-42. NC1744.2 +171300 PERFORM DE-LETE. NC1744.2 +171400 PERFORM PRINT-DETAIL. NC1744.2 +171500 GO TO CLASS-INIT-43. NC1744.2 +171600 CLASS-TEST-GF-42. NC1744.2 +171700 IF WS-B NOT ORDINAL-A-THROUGH-D NC1744.2 +171800 PERFORM PASS NC1744.2 +171900 PERFORM PRINT-DETAIL NC1744.2 +172000 ELSE NC1744.2 +172100 MOVE "'VWXYZ' SHOULD NOT BE ORDINAL-A-THROUGH-D" NC1744.2 +172200 TO RE-MARK NC1744.2 +172300 PERFORM FAIL NC1744.2 +172400 PERFORM PRINT-DETAIL. NC1744.2 +172500* NC1744.2 +172600* NC1744.2 +172700 CLASS-INIT-43. NC1744.2 +172800 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +172900 TO ANSI-REFERENCE. NC1744.2 +173000 MOVE "CLASS-TEST-GF-43" TO PAR-NAME. NC1744.2 +173100 MOVE "ADCBA" TO WS-B. NC1744.2 +173200 GO TO CLASS-TEST-GF-43. NC1744.2 +173300 CLASS-DELETE-GF-43. NC1744.2 +173400 PERFORM DE-LETE. NC1744.2 +173500 PERFORM PRINT-DETAIL. NC1744.2 +173600 GO TO CLASS-INIT-44. NC1744.2 +173700 CLASS-TEST-GF-43. NC1744.2 +173800 IF WS-B ORDINAL-D-THRU-A NC1744.2 +173900 PERFORM PASS NC1744.2 +174000 PERFORM PRINT-DETAIL NC1744.2 +174100 ELSE NC1744.2 +174200 MOVE "'ADCBA' SHOULD BE ORDINAL-D-THRU-A" NC1744.2 +174300 TO RE-MARK NC1744.2 +174400 PERFORM FAIL NC1744.2 +174500 PERFORM PRINT-DETAIL. NC1744.2 +174600* NC1744.2 +174700* NC1744.2 +174800 CLASS-INIT-44. NC1744.2 +174900 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +175000 TO ANSI-REFERENCE. NC1744.2 +175100 MOVE "CLASS-TEST-GF-44" TO PAR-NAME. NC1744.2 +175200 MOVE "VWXYZ" TO WS-B. NC1744.2 +175300 GO TO CLASS-TEST-GF-44. NC1744.2 +175400 CLASS-DELETE-GF-44. NC1744.2 +175500 PERFORM DE-LETE. NC1744.2 +175600 PERFORM PRINT-DETAIL. NC1744.2 +175700 GO TO CLASS-INIT-45. NC1744.2 +175800 CLASS-TEST-GF-44. NC1744.2 +175900 IF WS-B NOT ORDINAL-D-THRU-A NC1744.2 +176000 PERFORM PASS NC1744.2 +176100 PERFORM PRINT-DETAIL NC1744.2 +176200 ELSE NC1744.2 +176300 MOVE "'VWXYZ' SHOULD NOT BE ORDINAL-D-THRU-A" NC1744.2 +176400 TO RE-MARK NC1744.2 +176500 PERFORM FAIL NC1744.2 +176600 PERFORM PRINT-DETAIL. NC1744.2 +176700* NC1744.2 +176800* NC1744.2 +176900 CLASS-INIT-45. NC1744.2 +177000 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +177100 TO ANSI-REFERENCE. NC1744.2 +177200 MOVE "CLASS-TEST-GF-45" TO PAR-NAME. NC1744.2 +177300 MOVE "A" TO WS-A. NC1744.2 +177400 GO TO CLASS-TEST-GF-45. NC1744.2 +177500 CLASS-DELETE-GF-45. NC1744.2 +177600 PERFORM DE-LETE. NC1744.2 +177700 PERFORM PRINT-DETAIL. NC1744.2 +177800 GO TO CLASS-INIT-46. NC1744.2 +177900 CLASS-TEST-GF-45. NC1744.2 +178000 IF WS-A ACTUAL-A-ONLY NC1744.2 +178100 PERFORM PASS NC1744.2 +178200 PERFORM PRINT-DETAIL NC1744.2 +178300 ELSE NC1744.2 +178400 MOVE "'A' SHOULD BE ACTUAL-A-ONLY" NC1744.2 +178500 TO RE-MARK NC1744.2 +178600 PERFORM FAIL NC1744.2 +178700 PERFORM PRINT-DETAIL. NC1744.2 +178800* NC1744.2 +178900* NC1744.2 +179000 CLASS-INIT-46. NC1744.2 +179100 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +179200 TO ANSI-REFERENCE. NC1744.2 +179300 MOVE "CLASS-TEST-GF-46" TO PAR-NAME. NC1744.2 +179400 GO TO CLASS-TEST-GF-46. NC1744.2 +179500 CLASS-DELETE-GF-46. NC1744.2 +179600 PERFORM DE-LETE. NC1744.2 +179700 PERFORM PRINT-DETAIL. NC1744.2 +179800 GO TO CLASS-INIT-47. NC1744.2 +179900 CLASS-TEST-GF-46. NC1744.2 +180000 IF DATA-Z NOT ACTUAL-A-ONLY NC1744.2 +180100 PERFORM PASS NC1744.2 +180200 PERFORM PRINT-DETAIL NC1744.2 +180300 ELSE NC1744.2 +180400 MOVE "'Z' SHOULD NOT BE ACTUAL-A-ONLY" NC1744.2 +180500 TO RE-MARK NC1744.2 +180600 PERFORM FAIL NC1744.2 +180700 PERFORM PRINT-DETAIL. NC1744.2 +180800* NC1744.2 +180900* NC1744.2 +181000 CLASS-INIT-47. NC1744.2 +181100 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +181200 TO ANSI-REFERENCE. NC1744.2 +181300 MOVE "CLASS-TEST-GF-47" TO PAR-NAME. NC1744.2 +181400 MOVE "ADCBA" TO WS-B. NC1744.2 +181500 GO TO CLASS-TEST-GF-47. NC1744.2 +181600 CLASS-DELETE-GF-47. NC1744.2 +181700 PERFORM DE-LETE. NC1744.2 +181800 PERFORM PRINT-DETAIL. NC1744.2 +181900 GO TO CLASS-INIT-48. NC1744.2 +182000 CLASS-TEST-GF-47. NC1744.2 +182100 IF WS-B ACTUAL-A-THRU-D NC1744.2 +182200 PERFORM PASS NC1744.2 +182300 PERFORM PRINT-DETAIL NC1744.2 +182400 ELSE NC1744.2 +182500 MOVE "'ADCBA' SHOULD BE ACTUAL-A-THRU-D" NC1744.2 +182600 TO RE-MARK NC1744.2 +182700 PERFORM FAIL NC1744.2 +182800 PERFORM PRINT-DETAIL. NC1744.2 +182900* NC1744.2 +183000* NC1744.2 +183100 CLASS-INIT-48. NC1744.2 +183200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +183300 TO ANSI-REFERENCE. NC1744.2 +183400 MOVE "CLASS-TEST-GF-48" TO PAR-NAME. NC1744.2 +183500 GO TO CLASS-TEST-GF-48. NC1744.2 +183600 CLASS-DELETE-GF-48. NC1744.2 +183700 PERFORM DE-LETE. NC1744.2 +183800 PERFORM PRINT-DETAIL. NC1744.2 +183900 GO TO CLASS-INIT-49. NC1744.2 +184000 CLASS-TEST-GF-48. NC1744.2 +184100 IF DATA-VWXYZ NOT ACTUAL-A-THRU-D NC1744.2 +184200 PERFORM PASS NC1744.2 +184300 PERFORM PRINT-DETAIL NC1744.2 +184400 ELSE NC1744.2 +184500 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-A-THRU-D" NC1744.2 +184600 TO RE-MARK NC1744.2 +184700 PERFORM FAIL NC1744.2 +184800 PERFORM PRINT-DETAIL. NC1744.2 +184900* NC1744.2 +185000* NC1744.2 +185100 CLASS-INIT-49. NC1744.2 +185200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +185300 TO ANSI-REFERENCE. NC1744.2 +185400 MOVE "CLASS-TEST-GF-49" TO PAR-NAME. NC1744.2 +185500 GO TO CLASS-TEST-GF-49. NC1744.2 +185600 CLASS-DELETE-GF-49. NC1744.2 +185700 PERFORM DE-LETE. NC1744.2 +185800 PERFORM PRINT-DETAIL. NC1744.2 +185900 GO TO CLASS-INIT-50. NC1744.2 +186000 CLASS-TEST-GF-49. NC1744.2 +186100 IF DATA-ADCBA ACTUAL-D-THROUGH-A NC1744.2 +186200 PERFORM PASS NC1744.2 +186300 PERFORM PRINT-DETAIL NC1744.2 +186400 ELSE NC1744.2 +186500 MOVE "'ADCBA' SHOULD BE ACTUAL-D-THROUGH-A" NC1744.2 +186600 TO RE-MARK NC1744.2 +186700 PERFORM FAIL NC1744.2 +186800 PERFORM PRINT-DETAIL. NC1744.2 +186900* NC1744.2 +187000* NC1744.2 +187100 CLASS-INIT-50. NC1744.2 +187200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +187300 TO ANSI-REFERENCE. NC1744.2 +187400 MOVE "CLASS-TEST-GF-50" TO PAR-NAME. NC1744.2 +187500 MOVE "VWXYZ" TO WS-B. NC1744.2 +187600 GO TO CLASS-TEST-GF-50. NC1744.2 +187700 CLASS-DELETE-GF-50. NC1744.2 +187800 PERFORM DE-LETE. NC1744.2 +187900 PERFORM PRINT-DETAIL. NC1744.2 +188000 GO TO CLASS-INIT-51. NC1744.2 +188100 CLASS-TEST-GF-50. NC1744.2 +188200 IF WS-B NOT ACTUAL-D-THROUGH-A NC1744.2 +188300 PERFORM PASS NC1744.2 +188400 PERFORM PRINT-DETAIL NC1744.2 +188500 ELSE NC1744.2 +188600 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-D-THROUGH-A" NC1744.2 +188700 TO RE-MARK NC1744.2 +188800 PERFORM FAIL NC1744.2 +188900 PERFORM PRINT-DETAIL. NC1744.2 +189000* NC1744.2 +189100* NC1744.2 +189200 CLASS-INIT-51. NC1744.2 +189300 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +189400 TO ANSI-REFERENCE. NC1744.2 +189500 MOVE "CLASS-TEST-GF-51" TO PAR-NAME. NC1744.2 +189600 MOVE "ADCBA" TO WS-B. NC1744.2 +189700 GO TO CLASS-TEST-GF-51. NC1744.2 +189800 CLASS-DELETE-GF-51. NC1744.2 +189900 PERFORM DE-LETE. NC1744.2 +190000 PERFORM PRINT-DETAIL. NC1744.2 +190100 GO TO CLASS-INIT-52. NC1744.2 +190200 CLASS-TEST-GF-51. NC1744.2 +190300 IF WS-B ACTUAL-ABCD NC1744.2 +190400 PERFORM PASS NC1744.2 +190500 PERFORM PRINT-DETAIL NC1744.2 +190600 ELSE NC1744.2 +190700 MOVE "'ADCBA' SHOULD BE ACTUAL-ABCD" NC1744.2 +190800 TO RE-MARK NC1744.2 +190900 PERFORM FAIL NC1744.2 +191000 PERFORM PRINT-DETAIL. NC1744.2 +191100* NC1744.2 +191200* NC1744.2 +191300 CLASS-INIT-52. NC1744.2 +191400 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +191500 TO ANSI-REFERENCE. NC1744.2 +191600 MOVE "CLASS-TEST-GF-52" TO PAR-NAME. NC1744.2 +191700 GO TO CLASS-TEST-GF-52. NC1744.2 +191800 CLASS-DELETE-GF-52. NC1744.2 +191900 PERFORM DE-LETE. NC1744.2 +192000 PERFORM PRINT-DETAIL. NC1744.2 +192100 GO TO CCVS-EXIT. NC1744.2 +192200 CLASS-TEST-GF-52. NC1744.2 +192300 IF DATA-VWXYZ NOT ACTUAL-ABCD NC1744.2 +192400 PERFORM PASS NC1744.2 +192500 PERFORM PRINT-DETAIL NC1744.2 +192600 ELSE NC1744.2 +192700 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-ABCD" NC1744.2 +192800 TO RE-MARK NC1744.2 +192900 PERFORM FAIL NC1744.2 +193000 PERFORM PRINT-DETAIL. NC1744.2 +193100* NC1744.2 +193200* NC1744.2 +193300 CCVS-EXIT SECTION. NC1744.2 +193400 CCVS-999999. NC1744.2 +193500 GO TO CLOSE-FILES. NC1744.2 +*END-OF,NC174A +*HEADER,COBOL,NC175A +000100 IDENTIFICATION DIVISION. NC1754.2 +000200 PROGRAM-ID. NC1754.2 +000300 NC175A. NC1754.2 +000400**************************************************************** NC1754.2 +000500* * NC1754.2 +000600* VALIDATION FOR:- * NC1754.2 +000700* * NC1754.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +000900* * NC1754.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1754.2 +001100* * NC1754.2 +001200**************************************************************** NC1754.2 +001300* * NC1754.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1754.2 +001500* * NC1754.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1754.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1754.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1754.2 +001900* * NC1754.2 +002000**************************************************************** NC1754.2 +002100* NC1754.2 +002200* PROGRAM NC175A TESTS FORMAT 2 OF THE SUBTRACT NC1754.2 +002300* STATEMENT. VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1754.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1754.2 +002500* NC1754.2 +002600 NC1754.2 +002700 ENVIRONMENT DIVISION. NC1754.2 +002800 CONFIGURATION SECTION. NC1754.2 +002900 SOURCE-COMPUTER. NC1754.2 +003000 XXXXX082. NC1754.2 +003100 OBJECT-COMPUTER. NC1754.2 +003200 XXXXX083. NC1754.2 +003300 INPUT-OUTPUT SECTION. NC1754.2 +003400 FILE-CONTROL. NC1754.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1754.2 +003600 XXXXX055. NC1754.2 +003700 DATA DIVISION. NC1754.2 +003800 FILE SECTION. NC1754.2 +003900 FD PRINT-FILE. NC1754.2 +004000 01 PRINT-REC PICTURE X(120). NC1754.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1754.2 +004200 WORKING-STORAGE SECTION. NC1754.2 +004300 01 WRK-XN-00001 PIC X. NC1754.2 +004400 01 WRK-DU-0V1-1 PIC V9. NC1754.2 +004500 01 WRK-DU-2V0-1 PIC 99. NC1754.2 +004600 01 WRK-DU-2V0-2 PIC 99. NC1754.2 +004700 01 WRK-DU-2V0-3 PIC 99. NC1754.2 +004800 01 WRK-DU-2V1-1 PIC 99V9. NC1754.2 +004900 01 WRK-DU-2V1-2 PIC 99V9. NC1754.2 +005000 01 WRK-DU-2V1-3 PIC 99V9. NC1754.2 +005100 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1754.2 +005200 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1754.2 +005300 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1754.2 +005400 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1754.2 +005500 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1754.2 +005600 01 WRK-DU-2V5-1 PIC 99V9(5). NC1754.2 +005700 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1754.2 +005800 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1754.2 +005900 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1754.2 +006000 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1754.2 +006100 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1754.2 +006200 01 WRK-NE-X-1 PIC 9(16).99. NC1754.2 +006300 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1754.2 +006400 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1754.2 +006500 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1754.2 +006600 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1754.2 +006700 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1754.2 +006800 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1754.2 +006900 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1754.2 +007000 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1754.2 +007100 01 WRK-NE-X-2 PIC -9(16).99. NC1754.2 +007200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1754.2 +007300 01 WRK-NE-2 PIC $**.99. NC1754.2 +007400 01 WRK-NE-3 PIC $99.99CR. NC1754.2 +007500 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1754.2 +007600 01 WRK-NE-5 PIC $.** VALUE ZERO. NC1754.2 +007700 01 WRK-NE-6 PIC $**.**CR VALUE ZERO. NC1754.2 +007800 01 WRK-NE-7 PIC $*9.99DB VALUE ZERO. NC1754.2 +007900 77 SIZE-ERR PICTURE X VALUE SPACE. NC1754.2 +008000 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1754.2 +008100 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1754.2 +008200 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1754.2 +008300 77 A16TWOS-DS-16V00 PICTURE S9(16) NC1754.2 +008400 VALUE 2222222222222222. NC1754.2 +008500 77 A18ONES-DS-18V00 PICTURE S9(18) NC1754.2 +008600 VALUE 111111111111111111. NC1754.2 +008700 77 WRK-DS-10V00 PICTURE S9(10). NC1754.2 +008800 77 A10ONES-DS-10V00 PICTURE S9(10) NC1754.2 +008900 VALUE 1111111111. NC1754.2 +009000 77 A05ONES-DS-05V00 PICTURE S9(5) NC1754.2 +009100 VALUE 11111. NC1754.2 +009200 77 A02ONES-DS-02V00 PICTURE S99 NC1754.2 +009300 VALUE 11. NC1754.2 +009400 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1754.2 +009500 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1754.2 +009600 PICTURE S9(18). NC1754.2 +009700 77 A06THREES-DS-03V03 PICTURE S999V999 NC1754.2 +009800 VALUE 333.333. NC1754.2 +009900 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1754.2 +010000 VALUE 333333.333333. NC1754.2 +010100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1754.2 +010200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1754.2 +010300 PICTURE S9(12). NC1754.2 +010400 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1754.2 +010500 VALUE .11111. NC1754.2 +010600 77 WRK-DS-05V00 PICTURE S9(5). NC1754.2 +010700 77 WRK-DS-02V00 PICTURE S99. NC1754.2 +010800 77 A12ONES-DS-12V00 PICTURE S9(12) NC1754.2 +010900 VALUE 111111111111. NC1754.2 +011000 77 WRK-DS-03V10 PICTURE S999V9(10). NC1754.2 +011100 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1754.2 +011200 PICTURE S9(13). NC1754.2 +011300 77 A99-DS-02V00 PICTURE S99 NC1754.2 +011400 VALUE 99. NC1754.2 +011500 77 A03ONES-DS-02V01 PICTURE S99V9 NC1754.2 +011600 VALUE 11.1. NC1754.2 +011700 77 A06ONES-DS-03V03 PICTURE S999V999 NC1754.2 +011800 VALUE 111.111. NC1754.2 +011900 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1754.2 +012000 VALUE 22.222222. NC1754.2 +012100 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1754.2 +012200 VALUE .000000001. NC1754.2 +012300 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1754.2 +012400 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1754.2 +012500 VALUE 111111111111111111. NC1754.2 +012600 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1754.2 +012700 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1754.2 +012800 VALUE 99. NC1754.2 +012900 77 WRK-DS-0201P PICTURE S99P. NC1754.2 +013000 77 WRK-DS-06V00 PICTURE S9(6). NC1754.2 +013100 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1754.2 +013200 VALUE ZERO. NC1754.2 +013300 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1754.2 +013400 VALUE +012345678.876543210. NC1754.2 +013500 77 XDATA-XN-00018 PICTURE X(18) NC1754.2 +013600 VALUE "00ABCDEFGHI 4321 ". NC1754.2 +013700 77 WRK-XN-00018 PICTURE X(18). NC1754.2 +013800 77 ADD-12 PICTURE PP9 VALUE .001. NC1754.2 +013900 77 ADD-13 PICTURE 9PP VALUE 100. NC1754.2 +014000 77 ADD-14 PICTURE 999V999. NC1754.2 +014100 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1754.2 +014200 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1754.2 +014300 COMPUTATIONAL. NC1754.2 +014400 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1754.2 +014500 COMPUTATIONAL. NC1754.2 +014600 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1754.2 +014700 COMPUTATIONAL. NC1754.2 +014800 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1754.2 +014900 COMPUTATIONAL. NC1754.2 +015000 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1754.2 +015100 COMPUTATIONAL. NC1754.2 +015200 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1754.2 +015300 COMPUTATIONAL. NC1754.2 +015400 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1754.2 +015500 COMPUTATIONAL. NC1754.2 +015600 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1754.2 +015700 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1754.2 +015800 COMPUTATIONAL. NC1754.2 +015900 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1754.2 +016000 01 SUBTRACT-DATA. NC1754.2 +016100 02 SUBTR-1 PICTURE 9 VALUE 1. NC1754.2 +016200 02 SUBTR-2 PICTURE S99 VALUE 99. NC1754.2 +016300 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1754.2 +016400 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1754.2 +016500 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1754.2 +016600 02 SUBTR-6 PICTURE 9 VALUE 1. NC1754.2 +016700 02 SUBTR-7 PICTURE S99 VALUE 99. NC1754.2 +016800 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1754.2 +016900 02 SUBTR-10 PICTURE S999 VALUE 100. NC1754.2 +017000 02 SUBTR-11 PICTURE S999V999. NC1754.2 +017100 01 N-3 PICTURE IS 99999. NC1754.2 +017200 01 N-4 PICTURE IS 9(5) NC1754.2 +017300 VALUE IS 52800. NC1754.2 +017400 01 N-5 PICTURE IS S9(9)V99 NC1754.2 +017500 VALUE IS 000000001.00. NC1754.2 +017600 01 N-7 PICTURE IS S9(7)V9(4) NC1754.2 +017700 VALUE IS 0000001.0000. NC1754.2 +017800 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1754.2 +017900 01 N-10 PICTURE IS S99999V NC1754.2 +018000 VALUE IS -00001. NC1754.2 +018100 01 N-11 PICTURE IS 9 VALUE IS 9. NC1754.2 +018200 01 N-12 PICTURE IS 9 VALUE IS 9. NC1754.2 +018300 01 N-13 PICTURE IS 9(5) NC1754.2 +018400 VALUE IS 99999. NC1754.2 +018500 01 N-14 PICTURE IS 9 VALUE IS 1. NC1754.2 +018600 01 N-15 PICTURE IS 9(16). NC1754.2 +018700 01 N-16 PICTURE IS S999999V99 NC1754.2 +018800 VALUE IS 5.90. NC1754.2 +018900 01 N-17 PICTURE IS S9(3)V99 NC1754.2 +019000 VALUE IS +3.6. NC1754.2 +019100 01 N-18 PICTURE IS S9(10) NC1754.2 +019200 VALUE IS -5. NC1754.2 +019300 01 N-19 PICTURE IS $9.00. NC1754.2 +019400 01 N-20 PICTURE IS S9(9) NC1754.2 +019500 VALUE IS -999999999. NC1754.2 +019600 01 N-21 PICTURE IS 9 VALUE IS 5. NC1754.2 +019700 01 N-22 PICTURE IS 999V99 NC1754.2 +019800 VALUE IS 005.55. NC1754.2 +019900 01 N-23 PICTURE IS $$$.99CR. NC1754.2 +020000 01 N-25 PICTURE IS 9 VALUE IS 1. NC1754.2 +020100 01 N-26 PICTURE 9(5). NC1754.2 +020200 01 N-27 PICTURE IS 9999V9 NC1754.2 +020300 VALUE IS 9999.9. NC1754.2 +020400 01 N-28 PICTURE IS $9999.00. NC1754.2 +020500 01 N-40 PICTURE IS 9(7) NC1754.2 +020600 VALUE IS 7777777. NC1754.2 +020700 01 N-41 PICTURE IS 9(7) NC1754.2 +020800 VALUE IS 1111111. NC1754.2 +020900 01 N-42 PICTURE IS 9(3)P(4). NC1754.2 +021000 01 TRUNC-DATA. NC1754.2 +021100 02 N-43 PICTURE S9V9 VALUE +1.6. NC1754.2 +021200 02 N-44 PICTURE S9V9 VALUE -1.6. NC1754.2 +021300 02 N-45 PICTURE S9. NC1754.2 +021400 01 MINUS-NAMES. NC1754.2 +021500 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1754.2 +021600 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1754.2 +021700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1754.2 +021800 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1754.2 +021900 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1754.2 +022000 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1754.2 +022100 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1754.2 +022200 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1754.2 +022300 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1754.2 +022400 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1754.2 +022500 02 WHOLE-FIELD PICTURE S9(18). NC1754.2 +022600 02 DECMAL-FIELD PICTURE SV9(18). NC1754.2 +022700 01 TEST-RESULTS. NC1754.2 +022800 02 FILLER PIC X VALUE SPACE. NC1754.2 +022900 02 FEATURE PIC X(20) VALUE SPACE. NC1754.2 +023000 02 FILLER PIC X VALUE SPACE. NC1754.2 +023100 02 P-OR-F PIC X(5) VALUE SPACE. NC1754.2 +023200 02 FILLER PIC X VALUE SPACE. NC1754.2 +023300 02 PAR-NAME. NC1754.2 +023400 03 FILLER PIC X(19) VALUE SPACE. NC1754.2 +023500 03 PARDOT-X PIC X VALUE SPACE. NC1754.2 +023600 03 DOTVALUE PIC 99 VALUE ZERO. NC1754.2 +023700 02 FILLER PIC X(8) VALUE SPACE. NC1754.2 +023800 02 RE-MARK PIC X(61). NC1754.2 +023900 01 TEST-COMPUTED. NC1754.2 +024000 02 FILLER PIC X(30) VALUE SPACE. NC1754.2 +024100 02 FILLER PIC X(17) VALUE NC1754.2 +024200 " COMPUTED=". NC1754.2 +024300 02 COMPUTED-X. NC1754.2 +024400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1754.2 +024500 03 COMPUTED-N REDEFINES COMPUTED-A NC1754.2 +024600 PIC -9(9).9(9). NC1754.2 +024700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1754.2 +024800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1754.2 +024900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1754.2 +025000 03 CM-18V0 REDEFINES COMPUTED-A. NC1754.2 +025100 04 COMPUTED-18V0 PIC -9(18). NC1754.2 +025200 04 FILLER PIC X. NC1754.2 +025300 03 FILLER PIC X(50) VALUE SPACE. NC1754.2 +025400 01 TEST-CORRECT. NC1754.2 +025500 02 FILLER PIC X(30) VALUE SPACE. NC1754.2 +025600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1754.2 +025700 02 CORRECT-X. NC1754.2 +025800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1754.2 +025900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1754.2 +026000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1754.2 +026100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1754.2 +026200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1754.2 +026300 03 CR-18V0 REDEFINES CORRECT-A. NC1754.2 +026400 04 CORRECT-18V0 PIC -9(18). NC1754.2 +026500 04 FILLER PIC X. NC1754.2 +026600 03 FILLER PIC X(2) VALUE SPACE. NC1754.2 +026700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1754.2 +026800 01 CCVS-C-1. NC1754.2 +026900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1754.2 +027000- "SS PARAGRAPH-NAME NC1754.2 +027100- " REMARKS". NC1754.2 +027200 02 FILLER PIC X(20) VALUE SPACE. NC1754.2 +027300 01 CCVS-C-2. NC1754.2 +027400 02 FILLER PIC X VALUE SPACE. NC1754.2 +027500 02 FILLER PIC X(6) VALUE "TESTED". NC1754.2 +027600 02 FILLER PIC X(15) VALUE SPACE. NC1754.2 +027700 02 FILLER PIC X(4) VALUE "FAIL". NC1754.2 +027800 02 FILLER PIC X(94) VALUE SPACE. NC1754.2 +027900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1754.2 +028000 01 REC-CT PIC 99 VALUE ZERO. NC1754.2 +028100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1754.2 +028600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1754.2 +028700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1754.2 +028800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1754.2 +028900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1754.2 +029000 01 CCVS-H-1. NC1754.2 +029100 02 FILLER PIC X(39) VALUE SPACES. NC1754.2 +029200 02 FILLER PIC X(42) VALUE NC1754.2 +029300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1754.2 +029400 02 FILLER PIC X(39) VALUE SPACES. NC1754.2 +029500 01 CCVS-H-2A. NC1754.2 +029600 02 FILLER PIC X(40) VALUE SPACE. NC1754.2 +029700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1754.2 +029800 02 FILLER PIC XXXX VALUE NC1754.2 +029900 "4.2 ". NC1754.2 +030000 02 FILLER PIC X(28) VALUE NC1754.2 +030100 " COPY - NOT FOR DISTRIBUTION". NC1754.2 +030200 02 FILLER PIC X(41) VALUE SPACE. NC1754.2 +030300 NC1754.2 +030400 01 CCVS-H-2B. NC1754.2 +030500 02 FILLER PIC X(15) VALUE NC1754.2 +030600 "TEST RESULT OF ". NC1754.2 +030700 02 TEST-ID PIC X(9). NC1754.2 +030800 02 FILLER PIC X(4) VALUE NC1754.2 +030900 " IN ". NC1754.2 +031000 02 FILLER PIC X(12) VALUE NC1754.2 +031100 " HIGH ". NC1754.2 +031200 02 FILLER PIC X(22) VALUE NC1754.2 +031300 " LEVEL VALIDATION FOR ". NC1754.2 +031400 02 FILLER PIC X(58) VALUE NC1754.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +031600 01 CCVS-H-3. NC1754.2 +031700 02 FILLER PIC X(34) VALUE NC1754.2 +031800 " FOR OFFICIAL USE ONLY ". NC1754.2 +031900 02 FILLER PIC X(58) VALUE NC1754.2 +032000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1754.2 +032100 02 FILLER PIC X(28) VALUE NC1754.2 +032200 " COPYRIGHT 1985 ". NC1754.2 +032300 01 CCVS-E-1. NC1754.2 +032400 02 FILLER PIC X(52) VALUE SPACE. NC1754.2 +032500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1754.2 +032600 02 ID-AGAIN PIC X(9). NC1754.2 +032700 02 FILLER PIC X(45) VALUE SPACES. NC1754.2 +032800 01 CCVS-E-2. NC1754.2 +032900 02 FILLER PIC X(31) VALUE SPACE. NC1754.2 +033000 02 FILLER PIC X(21) VALUE SPACE. NC1754.2 +033100 02 CCVS-E-2-2. NC1754.2 +033200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1754.2 +033300 03 FILLER PIC X VALUE SPACE. NC1754.2 +033400 03 ENDER-DESC PIC X(44) VALUE NC1754.2 +033500 "ERRORS ENCOUNTERED". NC1754.2 +033600 01 CCVS-E-3. NC1754.2 +033700 02 FILLER PIC X(22) VALUE NC1754.2 +033800 " FOR OFFICIAL USE ONLY". NC1754.2 +033900 02 FILLER PIC X(12) VALUE SPACE. NC1754.2 +034000 02 FILLER PIC X(58) VALUE NC1754.2 +034100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +034200 02 FILLER PIC X(13) VALUE SPACE. NC1754.2 +034300 02 FILLER PIC X(15) VALUE NC1754.2 +034400 " COPYRIGHT 1985". NC1754.2 +034500 01 CCVS-E-4. NC1754.2 +034600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1754.2 +034700 02 FILLER PIC X(4) VALUE " OF ". NC1754.2 +034800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1754.2 +034900 02 FILLER PIC X(40) VALUE NC1754.2 +035000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1754.2 +035100 01 XXINFO. NC1754.2 +035200 02 FILLER PIC X(19) VALUE NC1754.2 +035300 "*** INFORMATION ***". NC1754.2 +035400 02 INFO-TEXT. NC1754.2 +035500 04 FILLER PIC X(8) VALUE SPACE. NC1754.2 +035600 04 XXCOMPUTED PIC X(20). NC1754.2 +035700 04 FILLER PIC X(5) VALUE SPACE. NC1754.2 +035800 04 XXCORRECT PIC X(20). NC1754.2 +035900 02 INF-ANSI-REFERENCE PIC X(48). NC1754.2 +036000 01 HYPHEN-LINE. NC1754.2 +036100 02 FILLER PIC IS X VALUE IS SPACE. NC1754.2 +036200 02 FILLER PIC IS X(65) VALUE IS "************************NC1754.2 +036300- "*****************************************". NC1754.2 +036400 02 FILLER PIC IS X(54) VALUE IS "************************NC1754.2 +036500- "******************************". NC1754.2 +036600 01 CCVS-PGM-ID PIC X(9) VALUE NC1754.2 +036700 "NC175A". NC1754.2 +036800 PROCEDURE DIVISION. NC1754.2 +036900 CCVS1 SECTION. NC1754.2 +037000 OPEN-FILES. NC1754.2 +037100 OPEN OUTPUT PRINT-FILE. NC1754.2 +037200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1754.2 +037300 MOVE SPACE TO TEST-RESULTS. NC1754.2 +037400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1754.2 +037500 GO TO CCVS1-EXIT. NC1754.2 +037600 CLOSE-FILES. NC1754.2 +037700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1754.2 +037800 TERMINATE-CCVS. NC1754.2 +037900S EXIT PROGRAM. NC1754.2 +038000STERMINATE-CALL. NC1754.2 +038100 STOP RUN. NC1754.2 +038200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1754.2 +038300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1754.2 +038400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1754.2 +038500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1754.2 +038600 MOVE "****TEST DELETED****" TO RE-MARK. NC1754.2 +038700 PRINT-DETAIL. NC1754.2 +038800 IF REC-CT NOT EQUAL TO ZERO NC1754.2 +038900 MOVE "." TO PARDOT-X NC1754.2 +039000 MOVE REC-CT TO DOTVALUE. NC1754.2 +039100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1754.2 +039200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1754.2 +039300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1754.2 +039400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1754.2 +039500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1754.2 +039600 MOVE SPACE TO CORRECT-X. NC1754.2 +039700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1754.2 +039800 MOVE SPACE TO RE-MARK. NC1754.2 +039900 HEAD-ROUTINE. NC1754.2 +040000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1754.2 +040300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1754.2 +040400 COLUMN-NAMES-ROUTINE. NC1754.2 +040500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +040600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +040800 END-ROUTINE. NC1754.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1754.2 +041000 END-RTN-EXIT. NC1754.2 +041100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +041200 END-ROUTINE-1. NC1754.2 +041300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1754.2 +041400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1754.2 +041500 ADD PASS-COUNTER TO ERROR-HOLD. NC1754.2 +041600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1754.2 +041700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1754.2 +041800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1754.2 +041900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1754.2 +042000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1754.2 +042100 END-ROUTINE-12. NC1754.2 +042200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1754.2 +042300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1754.2 +042400 MOVE "NO " TO ERROR-TOTAL NC1754.2 +042500 ELSE NC1754.2 +042600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1754.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1754.2 +042800 PERFORM WRITE-LINE. NC1754.2 +042900 END-ROUTINE-13. NC1754.2 +043000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1754.2 +043100 MOVE "NO " TO ERROR-TOTAL ELSE NC1754.2 +043200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1754.2 +043300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1754.2 +043400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +043500 IF INSPECT-COUNTER EQUAL TO ZERO NC1754.2 +043600 MOVE "NO " TO ERROR-TOTAL NC1754.2 +043700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1754.2 +043800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1754.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +044000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +044100 WRITE-LINE. NC1754.2 +044200 ADD 1 TO RECORD-COUNT. NC1754.2 +044300Y IF RECORD-COUNT GREATER 42 NC1754.2 +044400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1754.2 +044500Y MOVE SPACE TO DUMMY-RECORD NC1754.2 +044600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1754.2 +044700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1754.2 +044800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1754.2 +044900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1754.2 +045000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1754.2 +045100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1754.2 +045500Y MOVE ZERO TO RECORD-COUNT. NC1754.2 +045600 PERFORM WRT-LN. NC1754.2 +045700 WRT-LN. NC1754.2 +045800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1754.2 +045900 MOVE SPACE TO DUMMY-RECORD. NC1754.2 +046000 BLANK-LINE-PRINT. NC1754.2 +046100 PERFORM WRT-LN. NC1754.2 +046200 FAIL-ROUTINE. NC1754.2 +046300 IF COMPUTED-X NOT EQUAL TO SPACE NC1754.2 +046400 GO TO FAIL-ROUTINE-WRITE. NC1754.2 +046500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1754.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1754.2 +046700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1754.2 +046800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +046900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1754.2 +047000 GO TO FAIL-ROUTINE-EX. NC1754.2 +047100 FAIL-ROUTINE-WRITE. NC1754.2 +047200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1754.2 +047300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1754.2 +047400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1754.2 +047500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1754.2 +047600 FAIL-ROUTINE-EX. EXIT. NC1754.2 +047700 BAIL-OUT. NC1754.2 +047800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1754.2 +047900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1754.2 +048000 BAIL-OUT-WRITE. NC1754.2 +048100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1754.2 +048200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1754.2 +048300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1754.2 +048500 BAIL-OUT-EX. EXIT. NC1754.2 +048600 CCVS1-EXIT. NC1754.2 +048700 EXIT. NC1754.2 +048800 SECT-NC175A-001 SECTION. NC1754.2 +048900 SUB-INIT-F2-1. NC1754.2 +049000 MOVE "VI-134 6.25.4 GR2" TO ANSI-REFERENCE. NC1754.2 +049100 MOVE "SUBTRACT FROM GIVING" TO FEATURE. NC1754.2 +049200 SUB-TEST-F2-1. NC1754.2 +049300 MOVE -2 TO N-10. NC1754.2 +049400 SUBTRACT N-10 FROM 0 GIVING N-19. NC1754.2 +049500 IF N-19 EQUAL TO "$2.00" NC1754.2 +049600 PERFORM PASS NC1754.2 +049700 GO TO SUB-WRITE-F2-1. NC1754.2 +049800 GO TO SUB-FAIL-F2-1. NC1754.2 +049900 SUB-DELETE-F2-1. NC1754.2 +050000 PERFORM DE-LETE. NC1754.2 +050100 GO TO SUB-WRITE-F2-1. NC1754.2 +050200 SUB-FAIL-F2-1. NC1754.2 +050300 MOVE N-19 TO COMPUTED-A. NC1754.2 +050400 MOVE " $2.00" TO CORRECT-A. NC1754.2 +050500 PERFORM FAIL. NC1754.2 +050600 SUB-WRITE-F2-1. NC1754.2 +050700 MOVE "SUB-TEST-F2-1 " TO PAR-NAME. NC1754.2 +050800 PERFORM PRINT-DETAIL. NC1754.2 +050900 SUB-TEST-F2-2. NC1754.2 +051000 SUBTRACT N-21 FROM N-22 GIVING N-23 ROUNDED. NC1754.2 +051100 IF N-23 EQUAL TO " $.55 " NC1754.2 +051200 PERFORM PASS NC1754.2 +051300 GO TO SUB-WRITE-F2-2. NC1754.2 +051400 GO TO SUB-FAIL-F2-2. NC1754.2 +051500 SUB-DELETE-F2-2. NC1754.2 +051600 PERFORM DE-LETE. NC1754.2 +051700 GO TO SUB-WRITE-F2-2. NC1754.2 +051800 SUB-FAIL-F2-2. NC1754.2 +051900 MOVE N-23 TO COMPUTED-A. NC1754.2 +052000 MOVE " $.55" TO CORRECT-A. NC1754.2 +052100 PERFORM FAIL. NC1754.2 +052200 SUB-WRITE-F2-2. NC1754.2 +052300 MOVE "SUB-TEST-F2-2 " TO PAR-NAME. NC1754.2 +052400 PERFORM PRINT-DETAIL. NC1754.2 +052500 SUB-INIT-F2-3-1. NC1754.2 +052600 MOVE 1 TO N-25. NC1754.2 +052700 MOVE ZERO TO N-26. NC1754.2 +052800 SUB-TEST-F2-3-1. NC1754.2 +052900 SUBTRACT N-25 FROM -99999 GIVING N-26 ON SIZE ERROR NC1754.2 +053000 PERFORM PASS NC1754.2 +053100 GO TO SUB-WRITE-F2-3-1. NC1754.2 +053200 GO TO SUB-FAIL-F2-3-1. NC1754.2 +053300 SUB-DELETE-F2-3-1. NC1754.2 +053400 PERFORM DE-LETE. NC1754.2 +053500 GO TO SUB-WRITE-F2-3-1. NC1754.2 +053600 SUB-FAIL-F2-3-1. NC1754.2 +053700 MOVE N-26 TO COMPUTED-N. NC1754.2 +053800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +053900 PERFORM FAIL. NC1754.2 +054000 SUB-WRITE-F2-3-1. NC1754.2 +054100 MOVE "SUB-TEST-F2-3-1 " TO PAR-NAME. NC1754.2 +054200 PERFORM PRINT-DETAIL. NC1754.2 +054300 SUB-TEST-F2-3-2. NC1754.2 +054400 IF N-26 = ZERO NC1754.2 +054500 PERFORM PASS NC1754.2 +054600 GO TO SUB-WRITE-F2-3-2. NC1754.2 +054700 GO TO SUB-FAIL-F2-3-2. NC1754.2 +054800 SUB-DELETE-F2-3-2. NC1754.2 +054900 PERFORM DE-LETE. NC1754.2 +055000 GO TO SUB-WRITE-F2-3-2. NC1754.2 +055100 SUB-FAIL-F2-3-2. NC1754.2 +055200 MOVE N-26 TO COMPUTED-N. NC1754.2 +055300 MOVE ZERO TO CORRECT-N. NC1754.2 +055400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +055500 PERFORM FAIL. NC1754.2 +055600 SUB-WRITE-F2-3-2. NC1754.2 +055700 MOVE "SUB-TEST-F2-3-2 " TO PAR-NAME. NC1754.2 +055800 PERFORM PRINT-DETAIL. NC1754.2 +055900 SUB-INIT-F2-4-1. NC1754.2 +056000 MOVE 9999.9 TO N-27. NC1754.2 +056100 MOVE ZERO TO N-28. NC1754.2 +056200 SUB-TEST-F2-4-1. NC1754.2 +056300 SUBTRACT -9 FROM N-27 GIVING N-28 ROUNDED ON SIZE ERROR NC1754.2 +056400 PERFORM PASS NC1754.2 +056500 GO TO SUB-WRITE-F2-4-1. NC1754.2 +056600 GO TO SUB-FAIL-F2-4-1. NC1754.2 +056700 SUB-DELETE-F2-4-1. NC1754.2 +056800 PERFORM DE-LETE. NC1754.2 +056900 GO TO SUB-WRITE-F2-4-1. NC1754.2 +057000 SUB-FAIL-F2-4-1. NC1754.2 +057100 MOVE N-28 TO COMPUTED-A. NC1754.2 +057200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +057300 PERFORM FAIL. NC1754.2 +057400 SUB-WRITE-F2-4-1. NC1754.2 +057500 MOVE "SUB-TEST-F2-4-1 " TO PAR-NAME. NC1754.2 +057600 PERFORM PRINT-DETAIL. NC1754.2 +057700 SUB-TEST-F2-4-2. NC1754.2 +057800 IF N-28 = "$0000.00" NC1754.2 +057900 PERFORM PASS NC1754.2 +058000 GO TO SUB-WRITE-F2-4-2. NC1754.2 +058100 GO TO SUB-FAIL-F2-4-2. NC1754.2 +058200 SUB-DELETE-F2-4-2. NC1754.2 +058300 PERFORM DE-LETE. NC1754.2 +058400 GO TO SUB-WRITE-F2-4-2. NC1754.2 +058500 SUB-FAIL-F2-4-2. NC1754.2 +058600 MOVE N-28 TO COMPUTED-X. NC1754.2 +058700 MOVE "$0000.00" TO CORRECT-X. NC1754.2 +058800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +058900 PERFORM FAIL. NC1754.2 +059000 SUB-WRITE-F2-4-2. NC1754.2 +059100 MOVE "SUB-TEST-F2-4-2 " TO PAR-NAME. NC1754.2 +059200 PERFORM PRINT-DETAIL. NC1754.2 +059300 SUB-INIT-F2-5. NC1754.2 +059400 MOVE " GIVING" TO FEATURE. NC1754.2 +059500 SUB-TEST-F2-5. NC1754.2 +059600 MOVE ZERO TO WRK-DS-09V09. NC1754.2 +059700 SUBTRACT A06THREES-DS-03V03 FROM A12THREES-DS-06V06 NC1754.2 +059800 GIVING WRK-DS-06V06. NC1754.2 +059900 IF WRK-DS-06V06 EQUAL TO 333000.000333 NC1754.2 +060000 PERFORM PASS GO TO SUB-WRITE-F2-5. NC1754.2 +060100 GO TO SUB-FAIL-F2-5. NC1754.2 +060200 SUB-DELETE-F2-5. NC1754.2 +060300 PERFORM DE-LETE. NC1754.2 +060400 GO TO SUB-WRITE-F2-5. NC1754.2 +060500 SUB-FAIL-F2-5. NC1754.2 +060600 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +060700 MOVE 333000.000333 TO CORRECT-N. NC1754.2 +060800 PERFORM FAIL. NC1754.2 +060900 SUB-WRITE-F2-5. NC1754.2 +061000 MOVE "SUB-TEST-F2-5" TO PAR-NAME. NC1754.2 +061100 PERFORM PRINT-DETAIL. NC1754.2 +061200 SUB-TEST-F2-6. NC1754.2 +061300 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +061400 SUBTRACT A05ONES-DS-05V00 NC1754.2 +061500 A05ONES-DS-00V05 NC1754.2 +061600 A12THREES-DS-06V06 NC1754.2 +061700 A06THREES-DS-03V03 FROM ZERO GIVING WRK-DS-06V06. NC1754.2 +061800 IF WRK-DS-06V06 EQUAL TO -344777.777443 NC1754.2 +061900 PERFORM PASS GO TO SUB-WRITE-F2-6. NC1754.2 +062000 GO TO SUB-FAIL-F2-6. NC1754.2 +062100 SUB-DELETE-F2-6. NC1754.2 +062200 PERFORM DE-LETE. NC1754.2 +062300 GO TO SUB-WRITE-F2-6. NC1754.2 +062400 SUB-FAIL-F2-6. NC1754.2 +062500 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +062600 MOVE -344777.777443 TO CORRECT-N. NC1754.2 +062700 PERFORM FAIL. NC1754.2 +062800 SUB-WRITE-F2-6. NC1754.2 +062900 MOVE "SUB-TEST-F2-6" TO PAR-NAME. NC1754.2 +063000 PERFORM PRINT-DETAIL. NC1754.2 +063100 SUB-TEST-F2-7. NC1754.2 +063200 MOVE -099999.999999 TO WRK-DS-06V06. NC1754.2 +063300 SUBTRACT A05ONES-DS-05V00 NC1754.2 +063400 -11111 NC1754.2 +063500 AZERO-DS-05V05 FROM WRK-DS-06V06 NC1754.2 +063600 GIVING WRK-DS-06V00 ROUNDED. NC1754.2 +063700 IF WRK-DS-06V00 EQUAL TO -100000 NC1754.2 +063800 PERFORM PASS GO TO SUB-WRITE-F2-7. NC1754.2 +063900 GO TO SUB-FAIL-F2-7. NC1754.2 +064000 SUB-DELETE-F2-7. NC1754.2 +064100 PERFORM DE-LETE. NC1754.2 +064200 GO TO SUB-WRITE-F2-7. NC1754.2 +064300 SUB-FAIL-F2-7. NC1754.2 +064400 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1754.2 +064500 MOVE -100000 TO CORRECT-N. NC1754.2 +064600 PERFORM FAIL. NC1754.2 +064700 SUB-WRITE-F2-7. NC1754.2 +064800 MOVE "SUB-TEST-F2-7" TO PAR-NAME. NC1754.2 +064900 PERFORM PRINT-DETAIL. NC1754.2 +065000 SUB-TEST-F2-8-1. NC1754.2 +065100 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +065200 SUBTRACT A12ONES-DS-12V00 NC1754.2 +065300 FROM ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1754.2 +065400 PERFORM PASS GO TO SUB-WRITE-F2-8-1. NC1754.2 +065500 GO TO SUB-FAIL-F2-8-1. NC1754.2 +065600 SUB-DELETE-F2-8-1. NC1754.2 +065700 PERFORM DE-LETE. NC1754.2 +065800 GO TO SUB-WRITE-F2-8-1. NC1754.2 +065900 SUB-FAIL-F2-8-1. NC1754.2 +066000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +066100 PERFORM FAIL. NC1754.2 +066200 SUB-WRITE-F2-8-1. NC1754.2 +066300 MOVE "SUB-TEST-F2-8-1" TO PAR-NAME. NC1754.2 +066400 PERFORM PRINT-DETAIL. NC1754.2 +066500 SUB-TEST-F2-8-2. NC1754.2 +066600 IF WRK-DS-10V00 EQUAL TO ZERO NC1754.2 +066700 PERFORM PASS GO TO SUB-WRITE-F2-8-2. NC1754.2 +066800* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-8-1 NC1754.2 +066900 GO TO SUB-FAIL-F2-8-2. NC1754.2 +067000 SUB-DELETE-F2-8-2. NC1754.2 +067100 PERFORM DE-LETE. NC1754.2 +067200 GO TO SUB-WRITE-F2-8-2. NC1754.2 +067300 SUB-FAIL-F2-8-2. NC1754.2 +067400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +067500 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1754.2 +067600 MOVE ZERO TO CORRECT-14V4. NC1754.2 +067700 PERFORM FAIL. NC1754.2 +067800 SUB-WRITE-F2-8-2. NC1754.2 +067900 MOVE "SUB-TEST-F2-8-2" TO PAR-NAME. NC1754.2 +068000 PERFORM PRINT-DETAIL. NC1754.2 +068100 SUB-TEST-F2-9-1. NC1754.2 +068200 MOVE ZERO TO WRK-DS-05V00. NC1754.2 +068300 SUBTRACT 33333 NC1754.2 +068400 A06THREES-DS-03V03 NC1754.2 +068500 A12THREES-DS-06V06 NC1754.2 +068600 FROM -1000000 GIVING WRK-DS-05V00 NC1754.2 +068700 ROUNDED ON SIZE ERROR NC1754.2 +068800 PERFORM PASS GO TO SUB-WRITE-F2-9-1. NC1754.2 +068900 GO TO SUB-FAIL-F2-9-1. NC1754.2 +069000 SUB-DELETE-F2-9-1. NC1754.2 +069100 PERFORM DE-LETE. NC1754.2 +069200 GO TO SUB-WRITE-F2-9-1. NC1754.2 +069300 SUB-FAIL-F2-9-1. NC1754.2 +069400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +069500 PERFORM FAIL. NC1754.2 +069600 SUB-WRITE-F2-9-1. NC1754.2 +069700 MOVE "SUB-TEST-F2-9-1" TO PAR-NAME. NC1754.2 +069800 PERFORM PRINT-DETAIL. NC1754.2 +069900 SUB-TEST-F2-9-2. NC1754.2 +070000 IF WRK-DS-05V00 EQUAL TO ZERO NC1754.2 +070100 PERFORM PASS GO TO SUB-WRITE-F2-9-2. NC1754.2 +070200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-9-1 NC1754.2 +070300 GO TO SUB-FAIL-F2-9-2. NC1754.2 +070400 SUB-DELETE-F2-9-2. NC1754.2 +070500 PERFORM DE-LETE. NC1754.2 +070600 GO TO SUB-WRITE-F2-9-2. NC1754.2 +070700 SUB-FAIL-F2-9-2. NC1754.2 +070800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +070900 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1754.2 +071000 MOVE ZERO TO CORRECT-N. NC1754.2 +071100 PERFORM FAIL. NC1754.2 +071200 SUB-WRITE-F2-9-2. NC1754.2 +071300 MOVE "SUB-TEST-F2-9-2" TO PAR-NAME. NC1754.2 +071400 PERFORM PRINT-DETAIL. NC1754.2 +071500 SUB-TEST-F2-10-1. NC1754.2 +071600 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +071700 SUBTRACT A12THREES-DS-06V06 NC1754.2 +071800 333333 NC1754.2 +071900 A06THREES-DS-03V03 NC1754.2 +072000 -.0000009 FROM 0000000 NC1754.2 +072100 GIVING WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1754.2 +072200 GO TO SUB-FAIL-F2-10-1. NC1754.2 +072300 PERFORM PASS. NC1754.2 +072400 GO TO SUB-WRITE-F2-10-1. NC1754.2 +072500 SUB-DELETE-F2-10-1. NC1754.2 +072600 PERFORM DE-LETE. NC1754.2 +072700 GO TO SUB-WRITE-F2-10-1. NC1754.2 +072800 SUB-FAIL-F2-10-1. NC1754.2 +072900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1754.2 +073000 PERFORM FAIL. NC1754.2 +073100 SUB-WRITE-F2-10-1. NC1754.2 +073200 MOVE "SUB-TEST-F2-10-1" TO PAR-NAME. NC1754.2 +073300 PERFORM PRINT-DETAIL. NC1754.2 +073400 SUB-TEST-F2-10-2. NC1754.2 +073500 IF WRK-DS-06V06 EQUAL TO -666999.666332 NC1754.2 +073600 PERFORM PASS GO TO SUB-WRITE-F2-10-2. NC1754.2 +073700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-10-1 NC1754.2 +073800 GO TO SUB-FAIL-F2-10-2. NC1754.2 +073900 SUB-DELETE-F2-10-2. NC1754.2 +074000 PERFORM DE-LETE. NC1754.2 +074100 GO TO SUB-WRITE-F2-10-2. NC1754.2 +074200 SUB-FAIL-F2-10-2. NC1754.2 +074300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +074400 MOVE -666999.666332 TO CORRECT-N. NC1754.2 +074500 PERFORM FAIL. NC1754.2 +074600 SUB-WRITE-F2-10-2. NC1754.2 +074700 MOVE "SUB-TEST-F2-10-2" TO PAR-NAME. NC1754.2 +074800 PERFORM PRINT-DETAIL. NC1754.2 +074900 SUB-INIT-F2-11. NC1754.2 +075000 MOVE " SERIES" TO FEATURE. NC1754.2 +075100 SUB-TEST-F2-11. NC1754.2 +075200 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +075300 SUBTRACT A99-DS-02V00 NC1754.2 +075400 A03ONES-DS-02V01 NC1754.2 +075500 A06ONES-DS-03V03 NC1754.2 +075600 A08TWOS-DS-02V06 NC1754.2 +075700 -1.1111111 NC1754.2 +075800 +.11111111 NC1754.2 +075900 A01ONE-DS-P0801 FROM 0000.000000 NC1754.2 +076000 GIVING WRK-DS-03V10. NC1754.2 +076100 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +076200 PERFORM PASS GO TO SUB-WRITE-F2-11. NC1754.2 +076300 GO TO SUB-FAIL-F2-11. NC1754.2 +076400 SUB-DELETE-F2-11. NC1754.2 +076500 PERFORM DE-LETE. NC1754.2 +076600 GO TO SUB-WRITE-F2-11. NC1754.2 +076700 SUB-FAIL-F2-11. NC1754.2 +076800 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +076900 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +077000 PERFORM FAIL. NC1754.2 +077100 SUB-WRITE-F2-11. NC1754.2 +077200 MOVE "SUB-TEST-F2-11" TO PAR-NAME. NC1754.2 +077300 PERFORM PRINT-DETAIL. NC1754.2 +077400 SUB-TEST-F2-12. NC1754.2 +077500 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +077600 SUBTRACT A01ONE-DS-P0801 NC1754.2 +077700 +.11111111 NC1754.2 +077800 -1.1111111 NC1754.2 +077900 A08TWOS-DS-02V06 NC1754.2 +078000 A06ONES-DS-03V03 NC1754.2 +078100 A03ONES-DS-02V01 NC1754.2 +078200 A99-DS-02V00 FROM 0000.000000 GIVING WRK-DS-03V10. NC1754.2 +078300 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +078400 PERFORM PASS GO TO SUB-WRITE-F2-12. NC1754.2 +078500 GO TO SUB-FAIL-F2-12. NC1754.2 +078600 SUB-DELETE-F2-12. NC1754.2 +078700 PERFORM DE-LETE. NC1754.2 +078800 GO TO SUB-WRITE-F2-12. NC1754.2 +078900 SUB-FAIL-F2-12. NC1754.2 +079000 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +079100 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +079200 PERFORM FAIL. NC1754.2 +079300 SUB-WRITE-F2-12. NC1754.2 +079400 MOVE "SUB-TEST-F2-12" TO PAR-NAME. NC1754.2 +079500 PERFORM PRINT-DETAIL. NC1754.2 +079600 SUB-TEST-F2-13. NC1754.2 +079700 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +079800 SUBTRACT A08TWOS-DS-02V06 NC1754.2 +079900 A99-DS-02V00 NC1754.2 +080000 -1.1111111 NC1754.2 +080100 A03ONES-DS-02V01 NC1754.2 +080200 A01ONE-DS-P0801 NC1754.2 +080300 +.11111111 NC1754.2 +080400 A06ONES-DS-03V03 FROM 0000.000000 NC1754.2 +080500 GIVING WRK-DS-03V10. NC1754.2 +080600 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +080700 PERFORM PASS GO TO SUB-WRITE-F2-13. NC1754.2 +080800 GO TO SUB-FAIL-F2-13. NC1754.2 +080900 SUB-DELETE-F2-13. NC1754.2 +081000 PERFORM DE-LETE. NC1754.2 +081100 GO TO SUB-WRITE-F2-13. NC1754.2 +081200 SUB-FAIL-F2-13. NC1754.2 +081300 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +081400 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +081500 PERFORM FAIL. NC1754.2 +081600 SUB-WRITE-F2-13. NC1754.2 +081700 MOVE "SUB-TEST-F2-13" TO PAR-NAME. NC1754.2 +081800 PERFORM PRINT-DETAIL. NC1754.2 +081900 SUB-TEST-F2-14. NC1754.2 +082000 SUBTRACT SUBTR-4 SUBTR-5 .499 FROM SUBTR-2 GIVING SUBTR-11. NC1754.2 +082100 IF SUBTR-11 EQUAL TO -1.5 NC1754.2 +082200 PERFORM PASS GO TO SUB-WRITE-F2-14. NC1754.2 +082300 GO TO SUB-FAIL-F2-14. NC1754.2 +082400 SUB-DELETE-F2-14. NC1754.2 +082500 PERFORM DE-LETE. NC1754.2 +082600 GO TO SUB-WRITE-F2-14. NC1754.2 +082700 SUB-FAIL-F2-14. NC1754.2 +082800 MOVE SUBTR-11 TO COMPUTED-N. NC1754.2 +082900 MOVE -1.5 TO CORRECT-N. NC1754.2 +083000 PERFORM FAIL. NC1754.2 +083100 SUB-WRITE-F2-14. NC1754.2 +083200 MOVE "SUB-TEST-F2-14" TO PAR-NAME. NC1754.2 +083300 PERFORM PRINT-DETAIL. NC1754.2 +083400 SUB-TEST-F2-15-1. NC1754.2 +083500 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-5 GIVING SUBTR-7 ON NC1754.2 +083600 SIZE ERROR NC1754.2 +083700 PERFORM PASS GO TO SUB-WRITE-F2-15-1. NC1754.2 +083800 GO TO SUB-FAIL-F2-15-1. NC1754.2 +083900 SUB-DELETE-F2-15-1. NC1754.2 +084000 PERFORM DE-LETE. NC1754.2 +084100 GO TO SUB-WRITE-F2-15-1. NC1754.2 +084200 SUB-FAIL-F2-15-1. NC1754.2 +084300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +084400 PERFORM FAIL. NC1754.2 +084500 SUB-WRITE-F2-15-1. NC1754.2 +084600 MOVE "SUB-TEST-F2-15-1" TO PAR-NAME. NC1754.2 +084700 PERFORM PRINT-DETAIL. NC1754.2 +084800 SUB-TEST-F2-15-2. NC1754.2 +084900 IF SUBTR-7 EQUAL TO 99 NC1754.2 +085000 PERFORM PASS GO TO SUB-WRITE-F2-15-2. NC1754.2 +085100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-15-2 NC1754.2 +085200 GO TO SUB-FAIL-F2-15-2. NC1754.2 +085300 SUB-DELETE-F2-15-2. NC1754.2 +085400 PERFORM DE-LETE. NC1754.2 +085500 GO TO SUB-WRITE-F2-15-2. NC1754.2 +085600 SUB-FAIL-F2-15-2. NC1754.2 +085700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +085800 MOVE SUBTR-7 TO COMPUTED-N. NC1754.2 +085900 MOVE ZERO TO CORRECT-N. NC1754.2 +086000 PERFORM FAIL. NC1754.2 +086100 SUB-WRITE-F2-15-2. NC1754.2 +086200 MOVE "SUB-TEST-F2-15-2" TO PAR-NAME. NC1754.2 +086300 PERFORM PRINT-DETAIL. NC1754.2 +086400 SUB-TEST-F2-16-1. NC1754.2 +086500 MOVE SPACE TO SIZE-ERR. NC1754.2 +086600 SUBTRACT MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1754.2 +086700 PLUS-NAME2 EVEN-NAME1 35 FROM EVEN-NAME1 GIVING NC1754.2 +086800 WHOLE-FIELD NC1754.2 +086900 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1754.2 +087000 IF WHOLE-FIELD EQUAL TO 0 NC1754.2 +087100 PERFORM PASS NC1754.2 +087200 GO TO SUB-WRITE-F2-16-1. NC1754.2 +087300 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1754.2 +087400 MOVE 0 TO CORRECT-18V0. NC1754.2 +087500 PERFORM FAIL. NC1754.2 +087600 GO TO SUB-WRITE-F2-16-1. NC1754.2 +087700 SUB-DELETE-F2-16-1. NC1754.2 +087800 PERFORM DE-LETE. NC1754.2 +087900 SUB-WRITE-F2-16-1. NC1754.2 +088000 MOVE "SUB-TEST-F2-16-1" TO PAR-NAME. NC1754.2 +088100 PERFORM PRINT-DETAIL. NC1754.2 +088200 SUB-TEST-F2-16-2. NC1754.2 +088300 IF SIZE-ERR EQUAL TO "1" NC1754.2 +088400 PERFORM FAIL NC1754.2 +088500 MOVE SPACE TO CORRECT-A NC1754.2 +088600 MOVE 1 TO COMPUTED-A NC1754.2 +088700 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1754.2 +088800 GO TO SUB-WRITE-F2-16-2. NC1754.2 +088900 PERFORM PASS. NC1754.2 +089000 GO TO SUB-WRITE-F2-16-2. NC1754.2 +089100 SUB-DELETE-F2-16-2. NC1754.2 +089200 PERFORM DE-LETE. NC1754.2 +089300 SUB-WRITE-F2-16-2. NC1754.2 +089400 MOVE "SUB-TEST-F2-16-2" TO PAR-NAME. NC1754.2 +089500 PERFORM PRINT-DETAIL. NC1754.2 +089600 SUB-TEST-F2-17-1. NC1754.2 +089700 MOVE SPACE TO SIZE-ERR. NC1754.2 +089800 SUBTRACT MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1754.2 +089900 PLUS-NAME4 EVEN-NAME2 .35 FROM EVEN-NAME2 NC1754.2 +090000 GIVING DECMAL-FIELD NC1754.2 +090100 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1754.2 +090200 IF DECMAL-FIELD EQUAL TO .0 NC1754.2 +090300 PERFORM PASS NC1754.2 +090400 GO TO SUB-WRITE-F2-17-1. NC1754.2 +090500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1754.2 +090600 MOVE .0 TO CORRECT-0V18. NC1754.2 +090700 PERFORM FAIL. NC1754.2 +090800 GO TO SUB-WRITE-F2-17-1. NC1754.2 +090900 SUB-DELETE-F2-17-1. NC1754.2 +091000 PERFORM DE-LETE. NC1754.2 +091100 SUB-WRITE-F2-17-1. NC1754.2 +091200 MOVE "SUB-TEST-F2-17-1" TO PAR-NAME. NC1754.2 +091300 PERFORM PRINT-DETAIL. NC1754.2 +091400 SUB-TEST-F2-17-2. NC1754.2 +091500 IF SIZE-ERR EQUAL TO "1" NC1754.2 +091600 PERFORM FAIL NC1754.2 +091700 MOVE SPACE TO CORRECT-A NC1754.2 +091800 MOVE 1 TO COMPUTED-A NC1754.2 +091900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1754.2 +092000 GO TO SUB-WRITE-F2-17-2. NC1754.2 +092100 PERFORM PASS. NC1754.2 +092200 GO TO SUB-WRITE-F2-17-2. NC1754.2 +092300 SUB-DELETE-F2-17-2. NC1754.2 +092400 PERFORM DE-LETE. NC1754.2 +092500 SUB-WRITE-F2-17-2. NC1754.2 +092600 MOVE "SUB-TEST-F2-17-2" TO PAR-NAME. NC1754.2 +092700 PERFORM PRINT-DETAIL. NC1754.2 +092800 SUB-TEST-F2-18. NC1754.2 +092900 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +093000 SUBTRACT A12THREES-CU-18V00 FROM A14TWOS-CS-18V00 NC1754.2 +093100 GIVING WRK-CS-18V00. NC1754.2 +093200 IF WRK-CS-18V00 EQUAL TO -000022555555555555 NC1754.2 +093300 PERFORM PASS NC1754.2 +093400 GO TO SUB-WRITE-F2-18. NC1754.2 +093500 MOVE -000022555555555555 TO CORRECT-18V0. NC1754.2 +093600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +093700 PERFORM FAIL. NC1754.2 +093800 GO TO SUB-WRITE-F2-18. NC1754.2 +093900 SUB-DELETE-F2-18. NC1754.2 +094000 PERFORM DE-LETE. NC1754.2 +094100 SUB-WRITE-F2-18. NC1754.2 +094200 MOVE "SUB-TEST-F2-18 " TO PAR-NAME. NC1754.2 +094300 PERFORM PRINT-DETAIL. NC1754.2 +094400 SUB-TEST-F2-19. NC1754.2 +094500 MOVE ZERO TO WRK-DU-18V00. NC1754.2 +094600 SUBTRACT A18SIXES-CS-18V00 FROM A18THREES-CS-18V00 NC1754.2 +094700 GIVING WRK-DU-18V00. NC1754.2 +094800 IF WRK-DU-18V00 EQUAL TO 999999999999999999 NC1754.2 +094900 PERFORM PASS NC1754.2 +095000 GO TO SUB-WRITE-F2-19. NC1754.2 +095100 MOVE 999999999999999999 TO CORRECT-18V0. NC1754.2 +095200 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1754.2 +095300 PERFORM FAIL. NC1754.2 +095400 GO TO SUB-WRITE-F2-19. NC1754.2 +095500 SUB-DELETE-F2-19. NC1754.2 +095600 PERFORM DE-LETE. NC1754.2 +095700 SUB-WRITE-F2-19. NC1754.2 +095800 MOVE "SUB-TEST-F2-19 " TO PAR-NAME. NC1754.2 +095900 PERFORM PRINT-DETAIL. NC1754.2 +096000 SUB-TEST-F2-20. NC1754.2 +096100 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +096200 SUBTRACT A16FOURS-CS-18V00 FROM A12THREES-CU-18V00 NC1754.2 +096300 GIVING WRK-CS-18V00. NC1754.2 +096400 IF WRK-CS-18V00 EQUAL TO -004444111111111111 NC1754.2 +096500 PERFORM PASS NC1754.2 +096600 GO TO SUB-WRITE-F2-20. NC1754.2 +096700 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +096800 MOVE -004444111111111111 TO CORRECT-18V0. NC1754.2 +096900 PERFORM FAIL. NC1754.2 +097000 GO TO SUB-WRITE-F2-20. NC1754.2 +097100 SUB-DELETE-F2-20. NC1754.2 +097200 PERFORM DE-LETE. NC1754.2 +097300 SUB-WRITE-F2-20. NC1754.2 +097400 MOVE "SUB-TEST-F2-20 " TO PAR-NAME. NC1754.2 +097500 PERFORM PRINT-DETAIL. NC1754.2 +097600 SUB-TEST-F2-21. NC1754.2 +097700 MOVE ZERO TO WRK-DU-18V00. NC1754.2 +097800 SUBTRACT A18THREES-CS-18V00 FROM A18ONES-CS-18V00 NC1754.2 +097900 GIVING WRK-DU-18V00. NC1754.2 +098000 IF WRK-DU-18V00 EQUAL TO 444444444444444444 NC1754.2 +098100 PERFORM PASS NC1754.2 +098200 GO TO SUB-WRITE-F2-21. NC1754.2 +098300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1754.2 +098400 MOVE 444444444444444444 TO CORRECT-18V0. NC1754.2 +098500 PERFORM FAIL. NC1754.2 +098600 GO TO SUB-WRITE-F2-21. NC1754.2 +098700 SUB-DELETE-F2-21. NC1754.2 +098800 PERFORM DE-LETE. NC1754.2 +098900 SUB-WRITE-F2-21. NC1754.2 +099000 MOVE "SUB-TEST-F2-21 " TO PAR-NAME. NC1754.2 +099100 PERFORM PRINT-DETAIL. NC1754.2 +099200 SUB-TEST-F2-22. NC1754.2 +099300 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +099400 SUBTRACT A18SIXES-CS-18V00 FROM A18THREES-CS-18V00 NC1754.2 +099500 GIVING WRK-CS-18V00. NC1754.2 +099600 IF WRK-CS-18V00 EQUAL TO -999999999999999999 NC1754.2 +099700 PERFORM PASS NC1754.2 +099800 GO TO SUB-WRITE-F2-22. NC1754.2 +099900 MOVE -999999999999999999 TO CORRECT-18V0. NC1754.2 +100000 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +100100 PERFORM FAIL. NC1754.2 +100200 GO TO SUB-WRITE-F2-22. NC1754.2 +100300 SUB-DELETE-F2-22. NC1754.2 +100400 PERFORM DE-LETE. NC1754.2 +100500 SUB-WRITE-F2-22. NC1754.2 +100600 MOVE "SUB-TEST-F2-22 " TO PAR-NAME. NC1754.2 +100700 PERFORM PRINT-DETAIL. NC1754.2 +100800* NC1754.2 +100900 SUB-INIT-F2-23. NC1754.2 +101000* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +101100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +101200 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +101300 SUB-TEST-F2-23. NC1754.2 +101400 SUBTRACT A12ONES-DS-12V00 NC1754.2 +101500 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +101600 NOT ON SIZE ERROR NC1754.2 +101700 MOVE "NOT ON SIZE ERROR SHOULD NOT EXECUTED" NC1754.2 +101800 TO RE-MARK NC1754.2 +101900 PERFORM FAIL GO TO SUB-WRITE-F2-23. NC1754.2 +102000 GO TO SUB-PASS-F2-23. NC1754.2 +102100 SUB-DELETE-F2-23. NC1754.2 +102200 PERFORM DE-LETE. NC1754.2 +102300 GO TO SUB-WRITE-F2-23. NC1754.2 +102400 SUB-PASS-F2-23. NC1754.2 +102500 PERFORM PASS. NC1754.2 +102600 SUB-WRITE-F2-23. NC1754.2 +102700 MOVE "SUB-TEST-F2-23" TO PAR-NAME. NC1754.2 +102800 PERFORM PRINT-DETAIL. NC1754.2 +102900* NC1754.2 +103000 SUB-INIT-F2-24. NC1754.2 +103100* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +103200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +103300 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +103400 SUB-TEST-F2-24. NC1754.2 +103500 SUBTRACT A12THREES-DS-06V06 NC1754.2 +103600 333333 NC1754.2 +103700 A06THREES-DS-03V03 NC1754.2 +103800 -.0000009 FROM 0000000 NC1754.2 +103900 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +104000 NOT ON SIZE ERROR NC1754.2 +104100 PERFORM PASS NC1754.2 +104200 GO TO SUB-WRITE-F2-24. NC1754.2 +104300 GO TO SUB-FAIL-F2-24. NC1754.2 +104400 SUB-DELETE-F2-24. NC1754.2 +104500 PERFORM DE-LETE. NC1754.2 +104600 GO TO SUB-WRITE-F2-24. NC1754.2 +104700 SUB-FAIL-F2-24. NC1754.2 +104800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1754.2 +104900 PERFORM FAIL. NC1754.2 +105000 SUB-WRITE-F2-24. NC1754.2 +105100 MOVE "SUB-TEST-F2-24" TO PAR-NAME. NC1754.2 +105200 PERFORM PRINT-DETAIL. NC1754.2 +105300* NC1754.2 +105400 SUB-INIT-F2-25. NC1754.2 +105500* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +105600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +105700 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +105800 SUB-TEST-F2-25. NC1754.2 +105900 SUBTRACT A12ONES-DS-12V00 NC1754.2 +106000 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +106100 ON SIZE ERROR NC1754.2 +106200 GO TO SUB-PASS-F2-25 NC1754.2 +106300 NOT ON SIZE ERROR NC1754.2 +106400 MOVE "NOT ON SIZE ERROR SHOULD NOT EXECUTED" NC1754.2 +106500 TO RE-MARK NC1754.2 +106600 PERFORM FAIL GO TO SUB-WRITE-F2-25. NC1754.2 +106700 SUB-DELETE-F2-25. NC1754.2 +106800 PERFORM DE-LETE. NC1754.2 +106900 GO TO SUB-WRITE-F2-25. NC1754.2 +107000 SUB-PASS-F2-25. NC1754.2 +107100 PERFORM PASS. NC1754.2 +107200 SUB-WRITE-F2-25. NC1754.2 +107300 MOVE "SUB-TEST-F2-25" TO PAR-NAME. NC1754.2 +107400 PERFORM PRINT-DETAIL. NC1754.2 +107500* NC1754.2 +107600 SUB-INIT-F2-26. NC1754.2 +107700* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +107800 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +107900 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +108000 SUB-TEST-F2-26. NC1754.2 +108100 SUBTRACT A12THREES-DS-06V06 NC1754.2 +108200 333333 NC1754.2 +108300 A06THREES-DS-03V03 NC1754.2 +108400 -.0000009 FROM 0000000 NC1754.2 +108500 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +108600 ON SIZE ERROR NC1754.2 +108700 GO TO SUB-FAIL-F2-26 NC1754.2 +108800 NOT ON SIZE ERROR NC1754.2 +108900 PERFORM PASS NC1754.2 +109000 GO TO SUB-WRITE-F2-26. NC1754.2 +109100 SUB-DELETE-F2-26. NC1754.2 +109200 PERFORM DE-LETE. NC1754.2 +109300 GO TO SUB-WRITE-F2-26. NC1754.2 +109400 SUB-FAIL-F2-26. NC1754.2 +109500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1754.2 +109600 PERFORM FAIL. NC1754.2 +109700 SUB-WRITE-F2-26. NC1754.2 +109800 MOVE "SUB-TEST-F2-26" TO PAR-NAME. NC1754.2 +109900 PERFORM PRINT-DETAIL. NC1754.2 +110000* NC1754.2 +110100 SUB-INIT-F2-27. NC1754.2 +110200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +110300 MOVE "VI-134 6.25.4 GR2" TO ANSI-REFERENCE. NC1754.2 +110400 MOVE "SUB-TEST-F2-27" TO PAR-NAME. NC1754.2 +110500 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +110600 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +110700 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +110800 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +110900 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +111000 MOVE ZERO TO WRK-NE-4. NC1754.2 +111100 MOVE ZERO TO WRK-NE-6. NC1754.2 +111200 MOVE ZERO TO REC-CT. NC1754.2 +111300 SUB-TEST-F2-27-0. NC1754.2 +111400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +111500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +111600 WRK-NE-6 ROUNDED NC1754.2 +111700 GO TO SUB-TEST-F2-27-1. NC1754.2 +111800 SUB-DELETE-F2-27. NC1754.2 +111900 PERFORM DE-LETE. NC1754.2 +112000 PERFORM PRINT-DETAIL. NC1754.2 +112100 GO TO SUB-INIT-F2-28. NC1754.2 +112200 SUB-TEST-F2-27-1. NC1754.2 +112300 MOVE "SUB-TEST-F2-27-1" TO PAR-NAME. NC1754.2 +112400 MOVE 1 TO REC-CT. NC1754.2 +112500 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +112600 ELSE NC1754.2 +112700 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +112800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +112900 ADD 1 TO REC-CT. NC1754.2 +113000 SUB-TEST-F2-27-2. NC1754.2 +113100 MOVE "SUB-TEST-F2-27-2" TO PAR-NAME. NC1754.2 +113200 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +113300 ELSE NC1754.2 +113400 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +113500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +113600 ADD 1 TO REC-CT. NC1754.2 +113700 SUB-TEST-F2-27-3. NC1754.2 +113800 MOVE "SUB-TEST-F2-27-3" TO PAR-NAME. NC1754.2 +113900 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +114000 ELSE NC1754.2 +114100 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" TO NC1754.2 +114200 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +114300 ADD 1 TO REC-CT. NC1754.2 +114400 SUB-TEST-F2-27-4. NC1754.2 +114500 MOVE "SUB-TEST-F2-27-4" TO PAR-NAME. NC1754.2 +114600 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +114700 ELSE NC1754.2 +114800 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +114900 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +115000* NC1754.2 +115100 SUB-INIT-F2-28. NC1754.2 +115200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +115300* ==--> SIZE ERROR <--== NC1754.2 +115400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +115500 MOVE "SUB-TEST-F2-28" TO PAR-NAME. NC1754.2 +115600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +115700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +115800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +115900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +116000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +116100 MOVE ZERO TO WRK-NE-4. NC1754.2 +116200 MOVE ZERO TO WRK-NE-5 NC1754.2 +116300 MOVE ZERO TO WRK-NE-6. NC1754.2 +116400 MOVE ZERO TO REC-CT. NC1754.2 +116500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +116600 SUB-TEST-F2-28-0. NC1754.2 +116700 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +116800 2 WRK-DU-0V1-1 .04 NC1754.2 +116900 FROM WRK-DS-2V2-1 NC1754.2 +117000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +117100 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +117200 ON SIZE ERROR NC1754.2 +117300 MOVE "A" TO SIZE-ERR2. NC1754.2 +117400 GO TO SUB-TEST-F2-28-1. NC1754.2 +117500 SUB-DELETE-F2-28. NC1754.2 +117600 PERFORM DE-LETE. NC1754.2 +117700 PERFORM PRINT-DETAIL. NC1754.2 +117800 GO TO SUB-INIT-F2-29. NC1754.2 +117900 SUB-TEST-F2-28-1. NC1754.2 +118000 MOVE "SUB-TEST-F2-28-1" TO PAR-NAME. NC1754.2 +118100 MOVE 1 TO REC-CT. NC1754.2 +118200 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +118300 ELSE NC1754.2 +118400 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +118500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +118600 ADD 1 TO REC-CT. NC1754.2 +118700 SUB-TEST-F2-28-2. NC1754.2 +118800 MOVE "SUB-TEST-F2-28-2" TO PAR-NAME. NC1754.2 +118900 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +119000 ELSE NC1754.2 +119100 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +119200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +119300 ADD 1 TO REC-CT. NC1754.2 +119400 SUB-TEST-F2-28-3. NC1754.2 +119500 MOVE "SUB-TEST-F2-28-3" TO PAR-NAME. NC1754.2 +119600 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +119700 ELSE NC1754.2 +119800 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" TO NC1754.2 +119900 CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +120000 ADD 1 TO REC-CT. NC1754.2 +120100 SUB-TEST-F2-28-4. NC1754.2 +120200 MOVE "SUB-TEST-F2-28-4" TO PAR-NAME. NC1754.2 +120300 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +120400 ELSE NC1754.2 +120500 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +120600 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +120700 ADD 1 TO REC-CT. NC1754.2 +120800 SUB-TEST-F2-28-5. NC1754.2 +120900 MOVE "SUB-TEST-F2-28-5" TO PAR-NAME. NC1754.2 +121000 IF WRK-NE-6 = "***.****" NC1754.2 +121100 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +121200 ELSE NC1754.2 +121300 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +121400 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +121500 ADD 1 TO REC-CT. NC1754.2 +121600 SUB-TEST-F2-28-6. NC1754.2 +121700 MOVE "SUB-TEST-F2-28-6" TO PAR-NAME. NC1754.2 +121800 IF SIZE-ERR2 = "A" NC1754.2 +121900 PERFORM PASS NC1754.2 +122000 PERFORM PRINT-DETAIL NC1754.2 +122100 ELSE NC1754.2 +122200 MOVE "A" TO CORRECT-X NC1754.2 +122300 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +122400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +122500 TO RE-MARK NC1754.2 +122600 PERFORM FAIL NC1754.2 +122700 PERFORM PRINT-DETAIL. NC1754.2 +122800* NC1754.2 +122900 SUB-INIT-F2-29. NC1754.2 +123000* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +123100* ==--> NO SIZE ERROR <--== NC1754.2 +123200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +123300 MOVE "SUB-TEST-F2-29" TO PAR-NAME. NC1754.2 +123400 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +123500 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +123600 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +123700 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +123800 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +123900 MOVE ZERO TO WRK-NE-4. NC1754.2 +124000 MOVE ZERO TO WRK-NE-6. NC1754.2 +124100 MOVE ZERO TO REC-CT. NC1754.2 +124200 MOVE SPACE TO SIZE-ERR2. NC1754.2 +124300 SUB-TEST-F2-29-0. NC1754.2 +124400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +124500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +124600 WRK-NE-6 ROUNDED NC1754.2 +124700 ON SIZE ERROR NC1754.2 +124800 MOVE "A" TO SIZE-ERR2. NC1754.2 +124900 GO TO SUB-TEST-F2-29-1. NC1754.2 +125000 SUB-DELETE-F2-29. NC1754.2 +125100 PERFORM DE-LETE. NC1754.2 +125200 PERFORM PRINT-DETAIL. NC1754.2 +125300 GO TO SUB-INIT-F2-30. NC1754.2 +125400 SUB-TEST-F2-29-1. NC1754.2 +125500 MOVE "SUB-TEST-F2-29-1" TO PAR-NAME. NC1754.2 +125600 MOVE 1 TO REC-CT. NC1754.2 +125700 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +125800 ELSE NC1754.2 +125900 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +126000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +126100 ADD 1 TO REC-CT. NC1754.2 +126200 SUB-TEST-F2-29-2. NC1754.2 +126300 MOVE "SUB-TEST-F2-29-2" TO PAR-NAME. NC1754.2 +126400 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +126500 ELSE NC1754.2 +126600 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +126700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +126800 ADD 1 TO REC-CT. NC1754.2 +126900 SUB-TEST-F2-29-3. NC1754.2 +127000 MOVE "SUB-TEST-F2-29-3" TO PAR-NAME. NC1754.2 +127100 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +127200 ELSE NC1754.2 +127300 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +127400 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +127500 ADD 1 TO REC-CT. NC1754.2 +127600 SUB-TEST-F2-29-4. NC1754.2 +127700 MOVE "SUB-TEST-F2-29-4" TO PAR-NAME. NC1754.2 +127800 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +127900 ELSE NC1754.2 +128000 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +128100 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +128200 ADD 1 TO REC-CT. NC1754.2 +128300 SUB-TEST-F2-29-5. NC1754.2 +128400 MOVE "SUB-TEST-F2-29-5" TO PAR-NAME. NC1754.2 +128500 IF SIZE-ERR2 = SPACE NC1754.2 +128600 PERFORM PASS NC1754.2 +128700 PERFORM PRINT-DETAIL NC1754.2 +128800 ELSE NC1754.2 +128900 MOVE SPACE TO CORRECT-X NC1754.2 +129000 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +129100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +129200 TO RE-MARK NC1754.2 +129300 PERFORM FAIL NC1754.2 +129400 PERFORM PRINT-DETAIL. NC1754.2 +129500* NC1754.2 +129600 SUB-INIT-F2-30. NC1754.2 +129700* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +129800* ==--> SIZE ERROR <--== NC1754.2 +129900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +130000 MOVE "SUB-TEST-F2-30" TO PAR-NAME. NC1754.2 +130100 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +130200 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +130300 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +130400 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +130500 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +130600 MOVE ZERO TO WRK-NE-4. NC1754.2 +130700 MOVE ZERO TO WRK-NE-5 NC1754.2 +130800 MOVE ZERO TO WRK-NE-6. NC1754.2 +130900 MOVE ZERO TO REC-CT. NC1754.2 +131000 MOVE SPACE TO SIZE-ERR2. NC1754.2 +131100 SUB-TEST-F2-30-0. NC1754.2 +131200 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +131300 2 WRK-DU-0V1-1 .04 NC1754.2 +131400 FROM WRK-DS-2V2-1 NC1754.2 +131500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +131600 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +131700 NOT ON SIZE ERROR NC1754.2 +131800 MOVE "A" TO SIZE-ERR2. NC1754.2 +131900 GO TO SUB-TEST-F2-30-1. NC1754.2 +132000 SUB-DELETE-F2-30. NC1754.2 +132100 PERFORM DE-LETE. NC1754.2 +132200 PERFORM PRINT-DETAIL. NC1754.2 +132300 GO TO SUB-INIT-F2-31. NC1754.2 +132400 SUB-TEST-F2-30-1. NC1754.2 +132500 MOVE "SUB-TEST-F2-30-1" TO PAR-NAME. NC1754.2 +132600 MOVE 1 TO REC-CT. NC1754.2 +132700 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +132800 ELSE NC1754.2 +132900 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +133000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +133100 ADD 1 TO REC-CT. NC1754.2 +133200 SUB-TEST-F2-30-2. NC1754.2 +133300 MOVE "SUB-TEST-F2-30-2" TO PAR-NAME. NC1754.2 +133400 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +133500 ELSE NC1754.2 +133600 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +133700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +133800 ADD 1 TO REC-CT. NC1754.2 +133900 SUB-TEST-F2-30-3. NC1754.2 +134000 MOVE "SUB-TEST-F2-30-3" TO PAR-NAME. NC1754.2 +134100 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +134200 ELSE NC1754.2 +134300 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" to NC1754.2 +134400 CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +134500 ADD 1 TO REC-CT. NC1754.2 +134600 SUB-TEST-F2-30-4. NC1754.2 +134700 MOVE "SUB-TEST-F2-30-4" TO PAR-NAME. NC1754.2 +134800 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +134900 ELSE NC1754.2 +135000 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +135100 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +135200 ADD 1 TO REC-CT. NC1754.2 +135300 SUB-TEST-F2-30-5. NC1754.2 +135400 MOVE "SUB-TEST-F2-30-5" TO PAR-NAME. NC1754.2 +135500 IF WRK-NE-6 = "***.****" NC1754.2 +135600 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +135700 ELSE NC1754.2 +135800 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +135900 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +136000 ADD 1 TO REC-CT. NC1754.2 +136100 SUB-TEST-F2-30-6. NC1754.2 +136200 MOVE "SUB-TEST-F2-30-6" TO PAR-NAME. NC1754.2 +136300 IF SIZE-ERR2 = SPACE NC1754.2 +136400 PERFORM PASS NC1754.2 +136500 PERFORM PRINT-DETAIL NC1754.2 +136600 ELSE NC1754.2 +136700 MOVE SPACE TO CORRECT-X NC1754.2 +136800 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +136900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +137000 TO RE-MARK NC1754.2 +137100 PERFORM FAIL NC1754.2 +137200 PERFORM PRINT-DETAIL. NC1754.2 +137300* NC1754.2 +137400 SUB-INIT-F2-31. NC1754.2 +137500* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +137600* ==--> NO SIZE ERROR <--== NC1754.2 +137700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +137800 MOVE "SUB-TEST-F2-31" TO PAR-NAME. NC1754.2 +137900 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +138000 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +138100 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +138200 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +138300 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +138400 MOVE ZERO TO WRK-NE-4. NC1754.2 +138500 MOVE ZERO TO WRK-NE-6. NC1754.2 +138600 MOVE ZERO TO REC-CT. NC1754.2 +138700 MOVE SPACE TO SIZE-ERR2. NC1754.2 +138800 SUB-TEST-F2-31-0. NC1754.2 +138900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +139000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +139100 WRK-NE-6 ROUNDED NC1754.2 +139200 NOT ON SIZE ERROR NC1754.2 +139300 MOVE "A" TO SIZE-ERR2. NC1754.2 +139400 GO TO SUB-TEST-F2-31-1. NC1754.2 +139500 SUB-DELETE-F2-31. NC1754.2 +139600 PERFORM DE-LETE. NC1754.2 +139700 PERFORM PRINT-DETAIL. NC1754.2 +139800 GO TO SUB-INIT-F2-32. NC1754.2 +139900 SUB-TEST-F2-31-1. NC1754.2 +140000 MOVE "SUB-TEST-F2-31-1" TO PAR-NAME. NC1754.2 +140100 MOVE 1 TO REC-CT. NC1754.2 +140200 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +140300 ELSE NC1754.2 +140400 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +140500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +140600 ADD 1 TO REC-CT. NC1754.2 +140700 SUB-TEST-F2-31-2. NC1754.2 +140800 MOVE "SUB-TEST-F2-31-2" TO PAR-NAME. NC1754.2 +140900 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +141000 ELSE NC1754.2 +141100 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +141200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +141300 ADD 1 TO REC-CT. NC1754.2 +141400 SUB-TEST-F2-31-3. NC1754.2 +141500 MOVE "SUB-TEST-F2-31-3" TO PAR-NAME. NC1754.2 +141600 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +141700 ELSE NC1754.2 +141800 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +141900 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +142000 ADD 1 TO REC-CT. NC1754.2 +142100 SUB-TEST-F2-31-4. NC1754.2 +142200 MOVE "SUB-TEST-F2-31-4" TO PAR-NAME. NC1754.2 +142300 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +142400 ELSE NC1754.2 +142500 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +142600 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +142700 ADD 1 TO REC-CT. NC1754.2 +142800 SUB-TEST-F2-31-5. NC1754.2 +142900 MOVE "SUB-TEST-F2-31-5" TO PAR-NAME. NC1754.2 +143000 IF SIZE-ERR2 = "A" NC1754.2 +143100 PERFORM PASS NC1754.2 +143200 PERFORM PRINT-DETAIL NC1754.2 +143300 ELSE NC1754.2 +143400 MOVE "A" TO CORRECT-X NC1754.2 +143500 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +143600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +143700 TO RE-MARK NC1754.2 +143800 PERFORM FAIL NC1754.2 +143900 PERFORM PRINT-DETAIL. NC1754.2 +144000* NC1754.2 +144100 SUB-INIT-F2-32. NC1754.2 +144200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +144300* ==--> SIZE ERROR <--== NC1754.2 +144400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +144500 MOVE "SUB-TEST-F2-32" TO PAR-NAME. NC1754.2 +144600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +144700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +144800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +144900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +145000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +145100 MOVE ZERO TO WRK-NE-4. NC1754.2 +145200 MOVE ZERO TO WRK-NE-5 NC1754.2 +145300 MOVE ZERO TO WRK-NE-6. NC1754.2 +145400 MOVE ZERO TO REC-CT. NC1754.2 +145500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +145600 SUB-TEST-F2-32-0. NC1754.2 +145700 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +145800 2 WRK-DU-0V1-1 .04 NC1754.2 +145900 FROM WRK-DS-2V2-1 NC1754.2 +146000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +146100 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +146200 ON SIZE ERROR NC1754.2 +146300 MOVE "A" TO SIZE-ERR2 NC1754.2 +146400 NOT ON SIZE ERROR NC1754.2 +146500 MOVE "B" TO SIZE-ERR2. NC1754.2 +146600 GO TO SUB-TEST-F2-32-1. NC1754.2 +146700 SUB-DELETE-F2-32. NC1754.2 +146800 PERFORM DE-LETE. NC1754.2 +146900 PERFORM PRINT-DETAIL. NC1754.2 +147000 GO TO SUB-INIT-F2-33. NC1754.2 +147100 SUB-TEST-F2-32-1. NC1754.2 +147200 MOVE "SUB-TEST-F2-32-1" TO PAR-NAME. NC1754.2 +147300 MOVE 1 TO REC-CT. NC1754.2 +147400 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +147500 ELSE NC1754.2 +147600 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +147700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +147800 ADD 1 TO REC-CT. NC1754.2 +147900 SUB-TEST-F2-32-2. NC1754.2 +148000 MOVE "SUB-TEST-F2-32-2" TO PAR-NAME. NC1754.2 +148100 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +148200 ELSE NC1754.2 +148300 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +148400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +148500 ADD 1 TO REC-CT. NC1754.2 +148600 SUB-TEST-F2-32-3. NC1754.2 +148700 MOVE "SUB-TEST-F2-32-3" TO PAR-NAME. NC1754.2 +148800 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +148900 ELSE NC1754.2 +149000 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" NC1754.2 +149100 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +149200 ADD 1 TO REC-CT. NC1754.2 +149300 SUB-TEST-F2-32-4. NC1754.2 +149400 MOVE "SUB-TEST-F2-32-4" TO PAR-NAME. NC1754.2 +149500 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +149600 ELSE NC1754.2 +149700 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +149800 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +149900 ADD 1 TO REC-CT. NC1754.2 +150000 SUB-TEST-F2-32-5. NC1754.2 +150100 MOVE "SUB-TEST-F2-32-5" TO PAR-NAME. NC1754.2 +150200 IF WRK-NE-6 = "***.****" NC1754.2 +150300 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +150400 ELSE NC1754.2 +150500 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +150600 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +150700 ADD 1 TO REC-CT. NC1754.2 +150800 SUB-TEST-F2-32-6. NC1754.2 +150900 MOVE "SUB-TEST-F2-32-6" TO PAR-NAME. NC1754.2 +151000 IF SIZE-ERR2 = "A" NC1754.2 +151100 PERFORM PASS NC1754.2 +151200 PERFORM PRINT-DETAIL NC1754.2 +151300 ELSE NC1754.2 +151400 MOVE "A" TO CORRECT-X NC1754.2 +151500 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +151600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +151700 TO RE-MARK NC1754.2 +151800 PERFORM FAIL NC1754.2 +151900 PERFORM PRINT-DETAIL. NC1754.2 +152000* NC1754.2 +152100 SUB-INIT-F2-33. NC1754.2 +152200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +152300* ==--> NO SIZE ERROR <--== NC1754.2 +152400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +152500 MOVE "SUB-TEST-F2-33" TO PAR-NAME. NC1754.2 +152600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +152700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +152800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +152900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +153000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +153100 MOVE ZERO TO WRK-NE-4. NC1754.2 +153200 MOVE ZERO TO WRK-NE-6. NC1754.2 +153300 MOVE ZERO TO REC-CT. NC1754.2 +153400 MOVE SPACE TO SIZE-ERR2. NC1754.2 +153500 SUB-TEST-F2-33-0. NC1754.2 +153600 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +153700 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +153800 WRK-NE-6 ROUNDED NC1754.2 +153900 ON SIZE ERROR NC1754.2 +154000 MOVE "A" TO SIZE-ERR2 NC1754.2 +154100 NOT ON SIZE ERROR NC1754.2 +154200 MOVE "B" TO SIZE-ERR2. NC1754.2 +154300 GO TO SUB-TEST-F2-33-1. NC1754.2 +154400 SUB-DELETE-F2-33. NC1754.2 +154500 PERFORM DE-LETE. NC1754.2 +154600 PERFORM PRINT-DETAIL. NC1754.2 +154700 GO TO SUB-INIT-F2-34. NC1754.2 +154800 SUB-TEST-F2-33-1. NC1754.2 +154900 MOVE "SUB-TEST-F2-33-1" TO PAR-NAME. NC1754.2 +155000 MOVE 1 TO REC-CT. NC1754.2 +155100 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +155200 ELSE NC1754.2 +155300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +155400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +155500 ADD 1 TO REC-CT. NC1754.2 +155600 SUB-TEST-F2-33-2. NC1754.2 +155700 MOVE "SUB-TEST-F2-33-2" TO PAR-NAME. NC1754.2 +155800 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +155900 ELSE NC1754.2 +156000 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +156100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +156200 ADD 1 TO REC-CT. NC1754.2 +156300 SUB-TEST-F2-33-3. NC1754.2 +156400 MOVE "SUB-TEST-F2-33-3" TO PAR-NAME. NC1754.2 +156500 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +156600 ELSE NC1754.2 +156700 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +156800 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +156900 ADD 1 TO REC-CT. NC1754.2 +157000 SUB-TEST-F2-33-4. NC1754.2 +157100 MOVE "SUB-TEST-F2-33-4" TO PAR-NAME. NC1754.2 +157200 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +157300 ELSE NC1754.2 +157400 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +157500 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +157600 ADD 1 TO REC-CT. NC1754.2 +157700 SUB-TEST-F2-33-5. NC1754.2 +157800 MOVE "SUB-TEST-F2-33-5" TO PAR-NAME. NC1754.2 +157900 IF SIZE-ERR2 = "B" NC1754.2 +158000 PERFORM PASS NC1754.2 +158100 PERFORM PRINT-DETAIL NC1754.2 +158200 ELSE NC1754.2 +158300 MOVE "B" TO CORRECT-X NC1754.2 +158400 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +158500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +158600 TO RE-MARK NC1754.2 +158700 PERFORM FAIL NC1754.2 +158800 PERFORM PRINT-DETAIL. NC1754.2 +158900* NC1754.2 +159000 SUB-INIT-F2-34. NC1754.2 +159100* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1754.2 +159200* ==--> SIZE ERROR <--== NC1754.2 +159300 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +159400 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +159500 MOVE SPACE TO WRK-XN-00001. NC1754.2 +159600 MOVE SPACE TO SIZE-ERR2. NC1754.2 +159700 MOVE SPACE TO SIZE-ERR3. NC1754.2 +159800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +159900 MOVE 1 TO REC-CT. NC1754.2 +160000 SUB-TEST-F2-34-0. NC1754.2 +160100 SUBTRACT A12ONES-DS-12V00 NC1754.2 +160200 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +160300 ON SIZE ERROR NC1754.2 +160400 MOVE "1" TO WRK-XN-00001 NC1754.2 +160500 MOVE "A" TO SIZE-ERR2 NC1754.2 +160600 MOVE "B" TO SIZE-ERR3 NC1754.2 +160700 END-SUBTRACT NC1754.2 +160800 MOVE "C" TO SIZE-ERR4. NC1754.2 +160900 GO TO SUB-TEST-F2-34-1. NC1754.2 +161000 SUB-DELETE-F2-34. NC1754.2 +161100 PERFORM DE-LETE. NC1754.2 +161200 PERFORM PRINT-DETAIL. NC1754.2 +161300 GO TO SUB-INIT-F2-35. NC1754.2 +161400 SUB-TEST-F2-34-1. NC1754.2 +161500 MOVE "SUB-TEST-F2-34-1" TO PAR-NAME. NC1754.2 +161600 IF WRK-XN-00001 = "1" NC1754.2 +161700 PERFORM PASS NC1754.2 +161800 PERFORM PRINT-DETAIL NC1754.2 +161900 ELSE NC1754.2 +162000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +162100 TO RE-MARK NC1754.2 +162200 MOVE "1" TO CORRECT-X NC1754.2 +162300 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +162400 PERFORM FAIL NC1754.2 +162500 PERFORM PRINT-DETAIL. NC1754.2 +162600 ADD 1 TO REC-CT. NC1754.2 +162700 SUB-TEST-F2-34-2. NC1754.2 +162800 MOVE "SUB-TEST-F2-34-2" TO PAR-NAME. NC1754.2 +162900 IF SIZE-ERR2 = "A" NC1754.2 +163000 PERFORM PASS NC1754.2 +163100 PERFORM PRINT-DETAIL NC1754.2 +163200 ELSE NC1754.2 +163300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +163400 TO RE-MARK NC1754.2 +163500 MOVE "A" TO CORRECT-X NC1754.2 +163600 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +163700 PERFORM FAIL NC1754.2 +163800 PERFORM PRINT-DETAIL. NC1754.2 +163900 ADD 1 TO REC-CT. NC1754.2 +164000 SUB-TEST-F2-34-3. NC1754.2 +164100 MOVE "SUB-TEST-F2-34-3" TO PAR-NAME. NC1754.2 +164200 IF SIZE-ERR3 = "B" NC1754.2 +164300 PERFORM PASS NC1754.2 +164400 PERFORM PRINT-DETAIL NC1754.2 +164500 ELSE NC1754.2 +164600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +164700 TO RE-MARK NC1754.2 +164800 MOVE "B" TO CORRECT-X NC1754.2 +164900 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +165000 PERFORM FAIL NC1754.2 +165100 PERFORM PRINT-DETAIL. NC1754.2 +165200 ADD 1 TO REC-CT. NC1754.2 +165300 SUB-TEST-F2-34-4. NC1754.2 +165400 MOVE "SUB-TEST-F2-34-4" TO PAR-NAME. NC1754.2 +165500 IF SIZE-ERR4 = "C" NC1754.2 +165600 PERFORM PASS NC1754.2 +165700 PERFORM PRINT-DETAIL NC1754.2 +165800 ELSE NC1754.2 +165900 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +166000 TO RE-MARK NC1754.2 +166100 MOVE "C" TO CORRECT-X NC1754.2 +166200 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +166300 PERFORM FAIL NC1754.2 +166400 PERFORM PRINT-DETAIL NC1754.2 +166500 ADD 1 TO REC-CT. NC1754.2 +166600 SUB-TEST-F2-34-5. NC1754.2 +166700 MOVE "SUB-TEST-F2-34-5" TO PAR-NAME. NC1754.2 +166800 IF WRK-DS-10V00 = ZERO NC1754.2 +166900 PERFORM PASS NC1754.2 +167000 PERFORM PRINT-DETAIL NC1754.2 +167100 ELSE NC1754.2 +167200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +167300 TO RE-MARK NC1754.2 +167400 MOVE ZERO TO CORRECT-N NC1754.2 +167500 MOVE WRK-DS-10V00 TO COMPUTED-N NC1754.2 +167600 PERFORM FAIL NC1754.2 +167700 PERFORM PRINT-DETAIL. NC1754.2 +167800* NC1754.2 +167900 SUB-INIT-F2-35. NC1754.2 +168000* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +168100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +168200 MOVE "SUB-TEST-F2-35" TO PAR-NAME. NC1754.2 +168300 MOVE SPACE TO WRK-XN-00001. NC1754.2 +168400 MOVE SPACE TO SIZE-ERR2. NC1754.2 +168500 MOVE SPACE TO SIZE-ERR3. NC1754.2 +168600 MOVE SPACE TO SIZE-ERR4. NC1754.2 +168700 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +168800 MOVE 1 TO REC-CT. NC1754.2 +168900 SUB-TEST-F2-35-0. NC1754.2 +169000 SUBTRACT A12THREES-DS-06V06 NC1754.2 +169100 333333 NC1754.2 +169200 A06THREES-DS-03V03 NC1754.2 +169300 -.0000009 FROM 0000000 NC1754.2 +169400 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +169500 ON SIZE ERROR NC1754.2 +169600 MOVE "1" TO WRK-XN-00001 NC1754.2 +169700 MOVE "A" TO SIZE-ERR2 NC1754.2 +169800 MOVE "B" TO SIZE-ERR3 NC1754.2 +169900 END-SUBTRACT NC1754.2 +170000 MOVE "C" TO SIZE-ERR4. NC1754.2 +170100 GO TO SUB-TEST-F2-35-1. NC1754.2 +170200 SUB-DELETE-F2-35. NC1754.2 +170300 PERFORM DE-LETE. NC1754.2 +170400 PERFORM PRINT-DETAIL. NC1754.2 +170500 GO TO SUB-INIT-F2-36. NC1754.2 +170600 SUB-TEST-F2-35-1. NC1754.2 +170700 MOVE "SUB-TEST-F2-35-1" TO PAR-NAME. NC1754.2 +170800 IF WRK-XN-00001 = SPACE NC1754.2 +170900 PERFORM PASS NC1754.2 +171000 PERFORM PRINT-DETAIL NC1754.2 +171100 ELSE NC1754.2 +171200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +171300 TO RE-MARK NC1754.2 +171400 MOVE SPACE TO CORRECT-X NC1754.2 +171500 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +171600 PERFORM FAIL NC1754.2 +171700 PERFORM PRINT-DETAIL. NC1754.2 +171800 ADD 1 TO REC-CT. NC1754.2 +171900 SUB-TEST-F2-35-2. NC1754.2 +172000 MOVE "SUB-TEST-F2-35-2" TO PAR-NAME. NC1754.2 +172100 IF SIZE-ERR2 = SPACE NC1754.2 +172200 PERFORM PASS NC1754.2 +172300 PERFORM PRINT-DETAIL NC1754.2 +172400 ELSE NC1754.2 +172500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +172600 TO RE-MARK NC1754.2 +172700 MOVE SPACE TO CORRECT-X NC1754.2 +172800 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +172900 PERFORM FAIL NC1754.2 +173000 PERFORM PRINT-DETAIL. NC1754.2 +173100 ADD 1 TO REC-CT. NC1754.2 +173200 SUB-TEST-F2-35-3. NC1754.2 +173300 MOVE "SUB-TEST-F2-35-3" TO PAR-NAME. NC1754.2 +173400 IF SIZE-ERR3 = SPACE NC1754.2 +173500 PERFORM PASS NC1754.2 +173600 PERFORM PRINT-DETAIL NC1754.2 +173700 ELSE NC1754.2 +173800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +173900 TO RE-MARK NC1754.2 +174000 MOVE SPACE TO CORRECT-X NC1754.2 +174100 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +174200 PERFORM FAIL NC1754.2 +174300 PERFORM PRINT-DETAIL. NC1754.2 +174400 ADD 1 TO REC-CT. NC1754.2 +174500 SUB-TEST-F2-35-4. NC1754.2 +174600 MOVE "SUB-TEST-F2-35-4" TO PAR-NAME. NC1754.2 +174700 IF SIZE-ERR4 = "C" NC1754.2 +174800 PERFORM PASS NC1754.2 +174900 PERFORM PRINT-DETAIL NC1754.2 +175000 ELSE NC1754.2 +175100 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +175200 TO RE-MARK NC1754.2 +175300 MOVE "C" TO CORRECT-X NC1754.2 +175400 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +175500 PERFORM FAIL NC1754.2 +175600 PERFORM PRINT-DETAIL. NC1754.2 +175700 ADD 1 TO REC-CT. NC1754.2 +175800 SUB-TEST-F2-35-5. NC1754.2 +175900 MOVE "SUB-TEST-F1-35-5" TO PAR-NAME. NC1754.2 +176000 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +176100 PERFORM PASS NC1754.2 +176200 PERFORM PRINT-DETAIL NC1754.2 +176300 ELSE NC1754.2 +176400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +176500 TO RE-MARK NC1754.2 +176600 MOVE -666999.666332 TO CORRECT-N NC1754.2 +176700 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +176800 PERFORM FAIL NC1754.2 +176900 PERFORM PRINT-DETAIL. NC1754.2 +177000* NC1754.2 +177100 SUB-INIT-F2-36. NC1754.2 +177200* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +177300 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +177400 MOVE "SUB-TEST-F2-36" TO PAR-NAME. NC1754.2 +177500 MOVE SPACE TO WRK-XN-00001. NC1754.2 +177600 MOVE SPACE TO SIZE-ERR2. NC1754.2 +177700 MOVE SPACE TO SIZE-ERR3. NC1754.2 +177800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +177900 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +178000 MOVE 1 TO REC-CT. NC1754.2 +178100 SUB-TEST-F2-36-0. NC1754.2 +178200 SUBTRACT A12ONES-DS-12V00 NC1754.2 +178300 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +178400 NOT ON SIZE ERROR NC1754.2 +178500 MOVE "1" TO WRK-XN-00001 NC1754.2 +178600 MOVE "A" TO SIZE-ERR2 NC1754.2 +178700 MOVE "B" TO SIZE-ERR3 NC1754.2 +178800 END-SUBTRACT NC1754.2 +178900 MOVE "C" TO SIZE-ERR4. NC1754.2 +179000 GO TO SUB-TEST-F2-36-1. NC1754.2 +179100 SUB-DELETE-F2-36. NC1754.2 +179200 PERFORM DE-LETE. NC1754.2 +179300 PERFORM PRINT-DETAIL. NC1754.2 +179400 GO TO SUB-INIT-F2-37. NC1754.2 +179500 SUB-TEST-F2-36-1. NC1754.2 +179600 MOVE "SUB-TEST-F2-36-1" TO PAR-NAME. NC1754.2 +179700 IF WRK-XN-00001 = SPACE NC1754.2 +179800 PERFORM PASS NC1754.2 +179900 PERFORM PRINT-DETAIL NC1754.2 +180000 ELSE NC1754.2 +180100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +180200 TO RE-MARK NC1754.2 +180300 MOVE SPACE TO CORRECT-X NC1754.2 +180400 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +180500 PERFORM FAIL NC1754.2 +180600 PERFORM PRINT-DETAIL. NC1754.2 +180700 ADD 1 TO REC-CT. NC1754.2 +180800 SUB-TEST-F2-36-2. NC1754.2 +180900 MOVE "SUB-TEST-F2-36-2" TO PAR-NAME. NC1754.2 +181000 IF SIZE-ERR2 = SPACE NC1754.2 +181100 PERFORM PASS NC1754.2 +181200 PERFORM PRINT-DETAIL NC1754.2 +181300 ELSE NC1754.2 +181400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +181500 TO RE-MARK NC1754.2 +181600 MOVE SPACE TO CORRECT-X NC1754.2 +181700 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +181800 PERFORM FAIL NC1754.2 +181900 PERFORM PRINT-DETAIL. NC1754.2 +182000 ADD 1 TO REC-CT. NC1754.2 +182100 SUB-TEST-F2-36-3. NC1754.2 +182200 MOVE "SUB-TEST-F2-36-3" TO PAR-NAME. NC1754.2 +182300 IF SIZE-ERR3 = SPACE NC1754.2 +182400 PERFORM PASS NC1754.2 +182500 PERFORM PRINT-DETAIL NC1754.2 +182600 ELSE NC1754.2 +182700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +182800 TO RE-MARK NC1754.2 +182900 MOVE SPACE TO CORRECT-X NC1754.2 +183000 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +183100 PERFORM FAIL NC1754.2 +183200 PERFORM PRINT-DETAIL. NC1754.2 +183300 ADD 1 TO REC-CT. NC1754.2 +183400 SUB-TEST-F2-36-4. NC1754.2 +183500 MOVE "SUB-TEST-F2-36-4" TO PAR-NAME. NC1754.2 +183600 IF SIZE-ERR4 = "C" NC1754.2 +183700 PERFORM PASS NC1754.2 +183800 PERFORM PRINT-DETAIL NC1754.2 +183900 ELSE NC1754.2 +184000 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +184100 TO RE-MARK NC1754.2 +184200 MOVE "C" TO CORRECT-X NC1754.2 +184300 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +184400 PERFORM FAIL NC1754.2 +184500 PERFORM PRINT-DETAIL NC1754.2 +184600 ADD 1 TO REC-CT. NC1754.2 +184700 SUB-TEST-F2-36-5. NC1754.2 +184800 MOVE "SUB-TEST-F2-36-5" TO PAR-NAME. NC1754.2 +184900 IF WRK-DS-10V00 = ZERO NC1754.2 +185000 PERFORM PASS NC1754.2 +185100 PERFORM PRINT-DETAIL NC1754.2 +185200 ELSE NC1754.2 +185300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +185400 TO RE-MARK NC1754.2 +185500 MOVE ZERO TO CORRECT-N NC1754.2 +185600 MOVE WRK-DS-10V00 TO COMPUTED-N NC1754.2 +185700 PERFORM FAIL NC1754.2 +185800 PERFORM PRINT-DETAIL. NC1754.2 +185900* NC1754.2 +186000 SUB-INIT-F2-37. NC1754.2 +186100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +186200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +186300 MOVE "SUB-TEST-F2-37" TO PAR-NAME. NC1754.2 +186400 MOVE SPACE TO WRK-XN-00001. NC1754.2 +186500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +186600 MOVE SPACE TO SIZE-ERR3. NC1754.2 +186700 MOVE SPACE TO SIZE-ERR4. NC1754.2 +186800 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +186900 MOVE 1 TO REC-CT. NC1754.2 +187000 SUB-TEST-F2-37-0. NC1754.2 +187100 SUBTRACT A12THREES-DS-06V06 NC1754.2 +187200 333333 NC1754.2 +187300 A06THREES-DS-03V03 NC1754.2 +187400 -.0000009 FROM 0000000 NC1754.2 +187500 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +187600 NOT ON SIZE ERROR NC1754.2 +187700 MOVE "1" TO WRK-XN-00001 NC1754.2 +187800 MOVE "A" TO SIZE-ERR2 NC1754.2 +187900 MOVE "B" TO SIZE-ERR3 NC1754.2 +188000 END-SUBTRACT NC1754.2 +188100 MOVE "C" TO SIZE-ERR4. NC1754.2 +188200 GO TO SUB-TEST-F2-37-1. NC1754.2 +188300 SUB-DELETE-F2-37. NC1754.2 +188400 PERFORM DE-LETE. NC1754.2 +188500 PERFORM PRINT-DETAIL. NC1754.2 +188600 GO TO SUB-INIT-F2-38. NC1754.2 +188700 SUB-TEST-F2-37-1. NC1754.2 +188800 MOVE "SUB-TEST-F2-37-1" TO PAR-NAME. NC1754.2 +188900 IF WRK-XN-00001 = "1" NC1754.2 +189000 PERFORM PASS NC1754.2 +189100 PERFORM PRINT-DETAIL NC1754.2 +189200 ELSE NC1754.2 +189300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +189400 TO RE-MARK NC1754.2 +189500 MOVE "1" TO CORRECT-X NC1754.2 +189600 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +189700 PERFORM FAIL NC1754.2 +189800 PERFORM PRINT-DETAIL. NC1754.2 +189900 ADD 1 TO REC-CT. NC1754.2 +190000 SUB-TEST-F2-37-2. NC1754.2 +190100 MOVE "SUB-TEST-F2-37-2" TO PAR-NAME. NC1754.2 +190200 IF SIZE-ERR2 = "A" NC1754.2 +190300 PERFORM PASS NC1754.2 +190400 PERFORM PRINT-DETAIL NC1754.2 +190500 ELSE NC1754.2 +190600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +190700 TO RE-MARK NC1754.2 +190800 MOVE "A" TO CORRECT-X NC1754.2 +190900 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +191000 PERFORM FAIL NC1754.2 +191100 PERFORM PRINT-DETAIL. NC1754.2 +191200 ADD 1 TO REC-CT. NC1754.2 +191300 SUB-TEST-F2-37-3. NC1754.2 +191400 MOVE "SUB-TEST-F2-37-3" TO PAR-NAME. NC1754.2 +191500 IF SIZE-ERR3 = "B" NC1754.2 +191600 PERFORM PASS NC1754.2 +191700 PERFORM PRINT-DETAIL NC1754.2 +191800 ELSE NC1754.2 +191900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +192000 TO RE-MARK NC1754.2 +192100 MOVE "B" TO CORRECT-X NC1754.2 +192200 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +192300 PERFORM FAIL NC1754.2 +192400 PERFORM PRINT-DETAIL. NC1754.2 +192500 ADD 1 TO REC-CT. NC1754.2 +192600 SUB-TEST-F2-37-4. NC1754.2 +192700 MOVE "SUB-TEST-F2-37-4" TO PAR-NAME. NC1754.2 +192800 IF SIZE-ERR4 = "C" NC1754.2 +192900 PERFORM PASS NC1754.2 +193000 PERFORM PRINT-DETAIL NC1754.2 +193100 ELSE NC1754.2 +193200 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +193300 TO RE-MARK NC1754.2 +193400 MOVE "C" TO CORRECT-X NC1754.2 +193500 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +193600 PERFORM FAIL NC1754.2 +193700 PERFORM PRINT-DETAIL. NC1754.2 +193800 ADD 1 TO REC-CT. NC1754.2 +193900 SUB-TEST-F2-37-5. NC1754.2 +194000 MOVE "SUB-TEST-F2-37-5" TO PAR-NAME. NC1754.2 +194100 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +194200 PERFORM PASS NC1754.2 +194300 PERFORM PRINT-DETAIL NC1754.2 +194400 ELSE NC1754.2 +194500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +194600 TO RE-MARK NC1754.2 +194700 MOVE -666999.666332 TO CORRECT-N NC1754.2 +194800 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +194900 PERFORM FAIL NC1754.2 +195000 PERFORM PRINT-DETAIL. NC1754.2 +195100* NC1754.2 +195200 SUB-INIT-F2-38. NC1754.2 +195300* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +195400 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +195500 MOVE "SUB-TEST-F2-38" TO PAR-NAME. NC1754.2 +195600 MOVE "0" TO WRK-XN-00001. NC1754.2 +195700 MOVE "0" TO SIZE-ERR4. NC1754.2 +195800 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +195900 MOVE 1 TO REC-CT. NC1754.2 +196000 SUB-TEST-F2-38-0. NC1754.2 +196100 SUBTRACT A12ONES-DS-12V00 NC1754.2 +196200 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +196300 ON SIZE ERROR NC1754.2 +196400 MOVE SPACE TO WRK-XN-00001 NC1754.2 +196500 NOT ON SIZE ERROR NC1754.2 +196600 MOVE "1" TO WRK-XN-00001 NC1754.2 +196700 END-SUBTRACT NC1754.2 +196800 MOVE "C" TO SIZE-ERR4. NC1754.2 +196900 GO TO SUB-TEST-F2-38-1. NC1754.2 +197000 SUB-DELETE-F2-38. NC1754.2 +197100 PERFORM DE-LETE. NC1754.2 +197200 PERFORM PRINT-DETAIL. NC1754.2 +197300 GO TO SUB-INIT-F2-39. NC1754.2 +197400 SUB-TEST-F2-38-1. NC1754.2 +197500 MOVE "SUB-TEST-F2-38-1" TO PAR-NAME. NC1754.2 +197600 IF WRK-XN-00001 = SPACE NC1754.2 +197700 PERFORM PASS NC1754.2 +197800 PERFORM PRINT-DETAIL NC1754.2 +197900 ELSE NC1754.2 +198000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +198100 TO RE-MARK NC1754.2 +198200 MOVE SPACE TO CORRECT-X NC1754.2 +198300 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +198400 PERFORM FAIL NC1754.2 +198500 PERFORM PRINT-DETAIL. NC1754.2 +198600 ADD 1 TO REC-CT. NC1754.2 +198700 SUB-TEST-F2-38-2. NC1754.2 +198800 MOVE "SUB-TEST-F2-38-2" TO PAR-NAME. NC1754.2 +198900 IF SIZE-ERR4 = "C" NC1754.2 +199000 PERFORM PASS NC1754.2 +199100 PERFORM PRINT-DETAIL NC1754.2 +199200 ELSE NC1754.2 +199300 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +199400 TO RE-MARK NC1754.2 +199500 MOVE "C" TO CORRECT-X NC1754.2 +199600 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +199700 PERFORM FAIL NC1754.2 +199800 PERFORM PRINT-DETAIL. NC1754.2 +199900 ADD 1 TO REC-CT. NC1754.2 +200000 SUB-TEST-F2-38-3. NC1754.2 +200100 MOVE "SUB-TEST-F2-38-3" TO PAR-NAME. NC1754.2 +200200 IF WRK-DS-10V00 = ZERO NC1754.2 +200300 PERFORM PASS NC1754.2 +200400 PERFORM PRINT-DETAIL NC1754.2 +200500 ELSE NC1754.2 +200600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +200700 TO RE-MARK NC1754.2 +200800 MOVE ZERO TO CORRECT-N NC1754.2 +200900 MOVE WRK-DS-02V00 TO COMPUTED-N NC1754.2 +201000 PERFORM FAIL NC1754.2 +201100 PERFORM PRINT-DETAIL. NC1754.2 +201200* NC1754.2 +201300 SUB-INIT-F2-39. NC1754.2 +201400* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +201500 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +201600 MOVE "SUB-TEST-F2-39" TO PAR-NAME. NC1754.2 +201700 MOVE SPACE TO WRK-XN-00001. NC1754.2 +201800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +201900 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +202000 MOVE 1 TO REC-CT. NC1754.2 +202100 SUB-TEST-F2-39-0. NC1754.2 +202200 SUBTRACT A12THREES-DS-06V06 NC1754.2 +202300 333333 NC1754.2 +202400 A06THREES-DS-03V03 NC1754.2 +202500 -.0000009 FROM 0000000 NC1754.2 +202600 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +202700 ON SIZE ERROR NC1754.2 +202800 MOVE "X" TO WRK-XN-00001 NC1754.2 +202900 NOT ON SIZE ERROR NC1754.2 +203000 MOVE "1" TO WRK-XN-00001 NC1754.2 +203100 END-SUBTRACT NC1754.2 +203200 MOVE "C" TO SIZE-ERR4. NC1754.2 +203300 GO TO SUB-TEST-F2-39-1. NC1754.2 +203400 SUB-DELETE-F2-39. NC1754.2 +203500 PERFORM DE-LETE. NC1754.2 +203600 PERFORM PRINT-DETAIL. NC1754.2 +203700 GO TO CCVS-EXIT. NC1754.2 +203800 SUB-TEST-F2-39-1. NC1754.2 +203900 MOVE "SUB-TEST-F2-39-1" TO PAR-NAME. NC1754.2 +204000 IF WRK-XN-00001 = "1" NC1754.2 +204100 PERFORM PASS NC1754.2 +204200 PERFORM PRINT-DETAIL NC1754.2 +204300 ELSE NC1754.2 +204400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +204500 TO RE-MARK NC1754.2 +204600 MOVE "1" TO CORRECT-X NC1754.2 +204700 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +204800 PERFORM FAIL NC1754.2 +204900 PERFORM PRINT-DETAIL. NC1754.2 +205000 ADD 1 TO REC-CT. NC1754.2 +205100 SUB-TEST-F2-39-2. NC1754.2 +205200 MOVE "SUB-TEST-F2-39-2" TO PAR-NAME. NC1754.2 +205300 IF SIZE-ERR4 = "C" NC1754.2 +205400 PERFORM PASS NC1754.2 +205500 PERFORM PRINT-DETAIL NC1754.2 +205600 ELSE NC1754.2 +205700 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +205800 TO RE-MARK NC1754.2 +205900 MOVE "C" TO CORRECT-X NC1754.2 +206000 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +206100 PERFORM FAIL NC1754.2 +206200 PERFORM PRINT-DETAIL. NC1754.2 +206300 ADD 1 TO REC-CT. NC1754.2 +206400 SUB-TEST-F2-39-3. NC1754.2 +206500 MOVE "SUB-TEST-F2-39-3" TO PAR-NAME. NC1754.2 +206600 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +206700 PERFORM PASS NC1754.2 +206800 PERFORM PRINT-DETAIL NC1754.2 +206900 ELSE NC1754.2 +207000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +207100 TO RE-MARK NC1754.2 +207200 MOVE -666999.666332 TO CORRECT-N NC1754.2 +207300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +207400 PERFORM FAIL NC1754.2 +207500 PERFORM PRINT-DETAIL. NC1754.2 +207600* NC1754.2 +207700 CCVS-EXIT SECTION. NC1754.2 +207800 CCVS-999999. NC1754.2 +207900 GO TO CLOSE-FILES. NC1754.2 +*END-OF,NC175A +*HEADER,COBOL,NC176A +000100 IDENTIFICATION DIVISION. NC1764.2 +000200 PROGRAM-ID. NC1764.2 +000300 NC176A. NC1764.2 +000400**************************************************************** NC1764.2 +000500* * NC1764.2 +000600* VALIDATION FOR:- * NC1764.2 +000700* * NC1764.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +000900* * NC1764.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1764.2 +001100* * NC1764.2 +001200**************************************************************** NC1764.2 +001300* * NC1764.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1764.2 +001500* * NC1764.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1764.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1764.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1764.2 +001900* * NC1764.2 +002000**************************************************************** NC1764.2 +002100* NC1764.2 +002200* PROGRAM NC176A TESTS FORMAT 1 OF THE ADD STATEMENT. NC1764.2 +002300* VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1764.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1764.2 +002500* NC1764.2 +002600 ENVIRONMENT DIVISION. NC1764.2 +002700 CONFIGURATION SECTION. NC1764.2 +002800 SOURCE-COMPUTER. NC1764.2 +002900 XXXXX082. NC1764.2 +003000 OBJECT-COMPUTER. NC1764.2 +003100 XXXXX083. NC1764.2 +003200 INPUT-OUTPUT SECTION. NC1764.2 +003300 FILE-CONTROL. NC1764.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1764.2 +003500 XXXXX055. NC1764.2 +003600 DATA DIVISION. NC1764.2 +003700 FILE SECTION. NC1764.2 +003800 FD PRINT-FILE. NC1764.2 +003900 01 PRINT-REC PICTURE X(120). NC1764.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1764.2 +004100 WORKING-STORAGE SECTION. NC1764.2 +004200 01 42-DATANAMES. NC1764.2 +004300 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1764.2 +004400 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC1764.2 +004500 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC1764.2 +004600 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC1764.2 +004700 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC1764.2 +004800 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC1764.2 +004900 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC1764.2 +005000 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC1764.2 +005100 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC1764.2 +005200 02 DNAME10 PICTURE 9(10) VALUE 1. NC1764.2 +005300 02 DNAME11 PICTURE 9(11) VALUE 1. NC1764.2 +005400 02 DNAME12 PICTURE 9(12) VALUE 1. NC1764.2 +005500 02 DNAME13 PICTURE 9(13) VALUE 1. NC1764.2 +005600 02 DNAME14 PICTURE 9(14) VALUE 1. NC1764.2 +005700 02 DNAME15 PICTURE 9(15) VALUE 1. NC1764.2 +005800 02 DNAME16 PICTURE 9(16) VALUE 1. NC1764.2 +005900 02 DNAME17 PICTURE 9(17) VALUE 1. NC1764.2 +006000 02 DNAME18 PICTURE 9(18) VALUE 1. NC1764.2 +006100 02 DNAME19 PICTURE 9 VALUE 1. NC1764.2 +006200 02 DNAME20 PICTURE 99 VALUE 1. NC1764.2 +006300 02 DNAME21 PICTURE 999 VALUE 1. NC1764.2 +006400 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1764.2 +006500 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1764.2 +006600 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1764.2 +006700 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1764.2 +006800 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1764.2 +006900 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1764.2 +007000 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1764.2 +007100 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1764.2 +007200 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007300 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007400 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007500 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007600 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007700 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007800 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007900 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008000 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008100 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008200 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008300 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008400 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008500 77 SIZE-ERR PICTURE X VALUE SPACE. NC1764.2 +008600 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1764.2 +008700 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1764.2 +008800 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1764.2 +008900 77 A18TWOS-DS-18V00 PICTURE S9(18) NC1764.2 +009000 VALUE 222222222222222222. NC1764.2 +009100 77 A18ONES-DS-18V00 PICTURE S9(18) NC1764.2 +009200 VALUE 111111111111111111. NC1764.2 +009300 77 WRK-DS-10V00 PICTURE S9(10). NC1764.2 +009400 77 A17TWOS-DS-17V00 PICTURE S9(17) NC1764.2 +009500 VALUE 22222222222222222. NC1764.2 +009600 77 A10ONES-DS-10V00 PICTURE S9(10) NC1764.2 +009700 VALUE 1111111111. NC1764.2 +009800 77 A05ONES-DS-05V00 PICTURE S9(5) NC1764.2 +009900 VALUE 11111. NC1764.2 +010000 77 A02ONES-DS-02V00 PICTURE S99 NC1764.2 +010100 VALUE 11. NC1764.2 +010200 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1764.2 +010300 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1764.2 +010400 PICTURE S9(18). NC1764.2 +010500 77 A06THREES-DS-03V03 PICTURE S999V999 NC1764.2 +010600 VALUE 333.333. NC1764.2 +010700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1764.2 +010800 VALUE 333333.333333. NC1764.2 +010900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1764.2 +011000 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1764.2 +011100 PICTURE S9(12). NC1764.2 +011200 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1764.2 +011300 VALUE .11111. NC1764.2 +011400 77 WRK-DS-05V00 PICTURE S9(5). NC1764.2 +011500 77 WRK-DS-02V00 PICTURE S99. NC1764.2 +011600 77 A12ONES-DS-12V00 PICTURE S9(12) NC1764.2 +011700 VALUE 111111111111. NC1764.2 +011800 77 WRK-DS-03V10 PICTURE S999V9(10). NC1764.2 +011900 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1764.2 +012000 PICTURE S9(13). NC1764.2 +012100 77 A99-DS-02V00 PICTURE S99 NC1764.2 +012200 VALUE 99. NC1764.2 +012300 77 A03ONES-DS-02V01 PICTURE S99V9 NC1764.2 +012400 VALUE 11.1. NC1764.2 +012500 77 A06ONES-DS-03V03 PICTURE S999V999 NC1764.2 +012600 VALUE 111.111. NC1764.2 +012700 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1764.2 +012800 VALUE 22.222222. NC1764.2 +012900 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1764.2 +013000 VALUE .000000001. NC1764.2 +013100 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1764.2 +013200 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1764.2 +013300 VALUE 111111111111111111. NC1764.2 +013400 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1764.2 +013500 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1764.2 +013600 VALUE 99. NC1764.2 +013700 77 WRK-DS-0201P PICTURE S99P. NC1764.2 +013800 77 WRK-DS-06V00 PICTURE S9(6). NC1764.2 +013900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1764.2 +014000 VALUE ZERO. NC1764.2 +014100 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1764.2 +014200 VALUE +012345678.876543210. NC1764.2 +014300 77 XDATA-XN-00018 PICTURE X(18) NC1764.2 +014400 VALUE "00ABCDEFGHI 4321 ". NC1764.2 +014500 77 WRK-XN-00018 PICTURE X(18). NC1764.2 +014600 77 WRK-XN-00001 PICTURE X. NC1764.2 +014700 77 ADD-12 PICTURE PP9 VALUE .001. NC1764.2 +014800 77 ADD-13 PICTURE 9PP VALUE 100. NC1764.2 +014900 77 ADD-14 PICTURE 999V999. NC1764.2 +015000 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +015100 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1764.2 +015200 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1764.2 +015300 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1764.2 +015400 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1764.2 +015500 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1764.2 +015600 01 WRK-DU-1V5-1 PIC 9V9(5). NC1764.2 +015700 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1764.2 +015800 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1764.2 +015900 01 WRK-DU-2V0-1 PIC 99. NC1764.2 +016000 01 WRK-DU-2V0-2 PIC 99. NC1764.2 +016100 01 WRK-DU-2V0-3 PIC 99. NC1764.2 +016200 01 WRK-DU-2V1-1 PIC 99V9. NC1764.2 +016300 01 WRK-DU-2V1-2 PIC 99V9. NC1764.2 +016400 01 WRK-DU-2V1-3 PIC 99V9. NC1764.2 +016500 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1764.2 +016600 COMPUTATIONAL. NC1764.2 +016700 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1764.2 +016800 COMPUTATIONAL. NC1764.2 +016900 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1764.2 +017000 COMPUTATIONAL. NC1764.2 +017100 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1764.2 +017200 COMPUTATIONAL. NC1764.2 +017300 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1764.2 +017400 COMPUTATIONAL. NC1764.2 +017500 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1764.2 +017600 COMPUTATIONAL. NC1764.2 +017700 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1764.2 +017800 COMPUTATIONAL. NC1764.2 +017900 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1764.2 +018000 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1764.2 +018100 COMPUTATIONAL. NC1764.2 +018200 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1764.2 +018300 01 SUBTRACT-DATA. NC1764.2 +018400 02 SUBTR-1 PICTURE 9 VALUE 1. NC1764.2 +018500 02 SUBTR-2 PICTURE S99 VALUE 99. NC1764.2 +018600 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1764.2 +018700 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1764.2 +018800 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1764.2 +018900 02 SUBTR-6 PICTURE 9 VALUE 1. NC1764.2 +019000 02 SUBTR-7 PICTURE S99 VALUE 99. NC1764.2 +019100 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1764.2 +019200 02 SUBTR-10 PICTURE S999 VALUE 100. NC1764.2 +019300 02 SUBTR-11 PICTURE S999V999. NC1764.2 +019400 01 N-3 PICTURE IS 99999. NC1764.2 +019500 01 N-4 PICTURE IS 9(5) NC1764.2 +019600 VALUE IS 52800. NC1764.2 +019700 01 N-5 PICTURE IS S9(9)V99 NC1764.2 +019800 VALUE IS 000000001.00. NC1764.2 +019900 01 N-7 PICTURE IS S9(7)V9(4) NC1764.2 +020000 VALUE IS 0000001.0000. NC1764.2 +020100 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1764.2 +020200 01 N-10 PICTURE IS S99999V NC1764.2 +020300 VALUE IS -00001. NC1764.2 +020400 01 N-11 PICTURE IS 9 VALUE IS 9. NC1764.2 +020500 01 N-12 PICTURE IS 9 VALUE IS 9. NC1764.2 +020600 01 N-13 PICTURE IS 9(5) NC1764.2 +020700 VALUE IS 99999. NC1764.2 +020800 01 N-14 PICTURE IS 9 VALUE IS 1. NC1764.2 +020900 01 N-15 PICTURE IS 9(16). NC1764.2 +021000 01 N-16 PICTURE IS S999999V99 NC1764.2 +021100 VALUE IS 5.90. NC1764.2 +021200 01 N-17 PICTURE IS S9(3)V99 NC1764.2 +021300 VALUE IS +3.6. NC1764.2 +021400 01 N-18 PICTURE IS S9(10) NC1764.2 +021500 VALUE IS -5. NC1764.2 +021600 01 N-19 PICTURE IS $9.00. NC1764.2 +021700 01 N-20 PICTURE IS S9(9) NC1764.2 +021800 VALUE IS -999999999. NC1764.2 +021900 01 N-21 PICTURE IS 9 VALUE IS 5. NC1764.2 +022000 01 N-22 PICTURE IS 999V99 NC1764.2 +022100 VALUE IS 005.55. NC1764.2 +022200 01 N-23 PICTURE IS $$$.99CR. NC1764.2 +022300 01 N-25 PICTURE IS 9 VALUE IS 1. NC1764.2 +022400 01 N-26 PICTURE 9(5). NC1764.2 +022500 01 N-27 PICTURE IS 9999V9 NC1764.2 +022600 VALUE IS 9999.9. NC1764.2 +022700 01 N-28 PICTURE IS $9999.00. NC1764.2 +022800 01 N-40 PICTURE IS 9(7) NC1764.2 +022900 VALUE IS 7777777. NC1764.2 +023000 01 N-41 PICTURE IS 9(7) NC1764.2 +023100 VALUE IS 1111111. NC1764.2 +023200 01 N-42 PICTURE IS 9(3)P(4). NC1764.2 +023300 01 TRUNC-DATA. NC1764.2 +023400 02 N-43 PICTURE S9V9 VALUE +1.6. NC1764.2 +023500 02 N-44 PICTURE S9V9 VALUE -1.6. NC1764.2 +023600 02 N-45 PICTURE S9. NC1764.2 +023700 01 MINUS-NAMES. NC1764.2 +023800 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1764.2 +023900 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1764.2 +024000 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1764.2 +024100 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1764.2 +024200 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1764.2 +024300 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1764.2 +024400 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1764.2 +024500 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1764.2 +024600 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1764.2 +024700 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1764.2 +024800 02 WHOLE-FIELD PICTURE S9(18). NC1764.2 +024900 02 DECMAL-FIELD PICTURE SV9(18). NC1764.2 +025000 01 TEST-RESULTS. NC1764.2 +025100 02 FILLER PIC X VALUE SPACE. NC1764.2 +025200 02 FEATURE PIC X(20) VALUE SPACE. NC1764.2 +025300 02 FILLER PIC X VALUE SPACE. NC1764.2 +025400 02 P-OR-F PIC X(5) VALUE SPACE. NC1764.2 +025500 02 FILLER PIC X VALUE SPACE. NC1764.2 +025600 02 PAR-NAME. NC1764.2 +025700 03 FILLER PIC X(19) VALUE SPACE. NC1764.2 +025800 03 PARDOT-X PIC X VALUE SPACE. NC1764.2 +025900 03 DOTVALUE PIC 99 VALUE ZERO. NC1764.2 +026000 02 FILLER PIC X(8) VALUE SPACE. NC1764.2 +026100 02 RE-MARK PIC X(61). NC1764.2 +026200 01 TEST-COMPUTED. NC1764.2 +026300 02 FILLER PIC X(30) VALUE SPACE. NC1764.2 +026400 02 FILLER PIC X(17) VALUE NC1764.2 +026500 " COMPUTED=". NC1764.2 +026600 02 COMPUTED-X. NC1764.2 +026700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1764.2 +026800 03 COMPUTED-N REDEFINES COMPUTED-A NC1764.2 +026900 PIC -9(9).9(9). NC1764.2 +027000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1764.2 +027100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1764.2 +027200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1764.2 +027300 03 CM-18V0 REDEFINES COMPUTED-A. NC1764.2 +027400 04 COMPUTED-18V0 PIC -9(18). NC1764.2 +027500 04 FILLER PIC X. NC1764.2 +027600 03 FILLER PIC X(50) VALUE SPACE. NC1764.2 +027700 01 TEST-CORRECT. NC1764.2 +027800 02 FILLER PIC X(30) VALUE SPACE. NC1764.2 +027900 02 FILLER PIC X(17) VALUE " CORRECT =". NC1764.2 +028000 02 CORRECT-X. NC1764.2 +028100 03 CORRECT-A PIC X(20) VALUE SPACE. NC1764.2 +028200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1764.2 +028300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1764.2 +028400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1764.2 +028500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1764.2 +028600 03 CR-18V0 REDEFINES CORRECT-A. NC1764.2 +028700 04 CORRECT-18V0 PIC -9(18). NC1764.2 +028800 04 FILLER PIC X. NC1764.2 +028900 03 FILLER PIC X(2) VALUE SPACE. NC1764.2 +029000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1764.2 +029100 01 CCVS-C-1. NC1764.2 +029200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1764.2 +029300- "SS PARAGRAPH-NAME NC1764.2 +029400- " REMARKS". NC1764.2 +029500 02 FILLER PIC X(20) VALUE SPACE. NC1764.2 +029600 01 CCVS-C-2. NC1764.2 +029700 02 FILLER PIC X VALUE SPACE. NC1764.2 +029800 02 FILLER PIC X(6) VALUE "TESTED". NC1764.2 +029900 02 FILLER PIC X(15) VALUE SPACE. NC1764.2 +030000 02 FILLER PIC X(4) VALUE "FAIL". NC1764.2 +030100 02 FILLER PIC X(94) VALUE SPACE. NC1764.2 +030200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1764.2 +030300 01 REC-CT PIC 99 VALUE ZERO. NC1764.2 +030400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1764.2 +030900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1764.2 +031000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1764.2 +031100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1764.2 +031200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1764.2 +031300 01 CCVS-H-1. NC1764.2 +031400 02 FILLER PIC X(39) VALUE SPACES. NC1764.2 +031500 02 FILLER PIC X(42) VALUE NC1764.2 +031600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1764.2 +031700 02 FILLER PIC X(39) VALUE SPACES. NC1764.2 +031800 01 CCVS-H-2A. NC1764.2 +031900 02 FILLER PIC X(40) VALUE SPACE. NC1764.2 +032000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1764.2 +032100 02 FILLER PIC XXXX VALUE NC1764.2 +032200 "4.2 ". NC1764.2 +032300 02 FILLER PIC X(28) VALUE NC1764.2 +032400 " COPY - NOT FOR DISTRIBUTION". NC1764.2 +032500 02 FILLER PIC X(41) VALUE SPACE. NC1764.2 +032600 NC1764.2 +032700 01 CCVS-H-2B. NC1764.2 +032800 02 FILLER PIC X(15) VALUE NC1764.2 +032900 "TEST RESULT OF ". NC1764.2 +033000 02 TEST-ID PIC X(9). NC1764.2 +033100 02 FILLER PIC X(4) VALUE NC1764.2 +033200 " IN ". NC1764.2 +033300 02 FILLER PIC X(12) VALUE NC1764.2 +033400 " HIGH ". NC1764.2 +033500 02 FILLER PIC X(22) VALUE NC1764.2 +033600 " LEVEL VALIDATION FOR ". NC1764.2 +033700 02 FILLER PIC X(58) VALUE NC1764.2 +033800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +033900 01 CCVS-H-3. NC1764.2 +034000 02 FILLER PIC X(34) VALUE NC1764.2 +034100 " FOR OFFICIAL USE ONLY ". NC1764.2 +034200 02 FILLER PIC X(58) VALUE NC1764.2 +034300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1764.2 +034400 02 FILLER PIC X(28) VALUE NC1764.2 +034500 " COPYRIGHT 1985 ". NC1764.2 +034600 01 CCVS-E-1. NC1764.2 +034700 02 FILLER PIC X(52) VALUE SPACE. NC1764.2 +034800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1764.2 +034900 02 ID-AGAIN PIC X(9). NC1764.2 +035000 02 FILLER PIC X(45) VALUE SPACES. NC1764.2 +035100 01 CCVS-E-2. NC1764.2 +035200 02 FILLER PIC X(31) VALUE SPACE. NC1764.2 +035300 02 FILLER PIC X(21) VALUE SPACE. NC1764.2 +035400 02 CCVS-E-2-2. NC1764.2 +035500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1764.2 +035600 03 FILLER PIC X VALUE SPACE. NC1764.2 +035700 03 ENDER-DESC PIC X(44) VALUE NC1764.2 +035800 "ERRORS ENCOUNTERED". NC1764.2 +035900 01 CCVS-E-3. NC1764.2 +036000 02 FILLER PIC X(22) VALUE NC1764.2 +036100 " FOR OFFICIAL USE ONLY". NC1764.2 +036200 02 FILLER PIC X(12) VALUE SPACE. NC1764.2 +036300 02 FILLER PIC X(58) VALUE NC1764.2 +036400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +036500 02 FILLER PIC X(13) VALUE SPACE. NC1764.2 +036600 02 FILLER PIC X(15) VALUE NC1764.2 +036700 " COPYRIGHT 1985". NC1764.2 +036800 01 CCVS-E-4. NC1764.2 +036900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1764.2 +037000 02 FILLER PIC X(4) VALUE " OF ". NC1764.2 +037100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1764.2 +037200 02 FILLER PIC X(40) VALUE NC1764.2 +037300 " TESTS WERE EXECUTED SUCCESSFULLY". NC1764.2 +037400 01 XXINFO. NC1764.2 +037500 02 FILLER PIC X(19) VALUE NC1764.2 +037600 "*** INFORMATION ***". NC1764.2 +037700 02 INFO-TEXT. NC1764.2 +037800 04 FILLER PIC X(8) VALUE SPACE. NC1764.2 +037900 04 XXCOMPUTED PIC X(20). NC1764.2 +038000 04 FILLER PIC X(5) VALUE SPACE. NC1764.2 +038100 04 XXCORRECT PIC X(20). NC1764.2 +038200 02 INF-ANSI-REFERENCE PIC X(48). NC1764.2 +038300 01 HYPHEN-LINE. NC1764.2 +038400 02 FILLER PIC IS X VALUE IS SPACE. NC1764.2 +038500 02 FILLER PIC IS X(65) VALUE IS "************************NC1764.2 +038600- "*****************************************". NC1764.2 +038700 02 FILLER PIC IS X(54) VALUE IS "************************NC1764.2 +038800- "******************************". NC1764.2 +038900 01 CCVS-PGM-ID PIC X(9) VALUE NC1764.2 +039000 "NC176A". NC1764.2 +039100 PROCEDURE DIVISION. NC1764.2 +039200 CCVS1 SECTION. NC1764.2 +039300 OPEN-FILES. NC1764.2 +039400 OPEN OUTPUT PRINT-FILE. NC1764.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1764.2 +039600 MOVE SPACE TO TEST-RESULTS. NC1764.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1764.2 +039800 GO TO CCVS1-EXIT. NC1764.2 +039900 CLOSE-FILES. NC1764.2 +040000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1764.2 +040100 TERMINATE-CCVS. NC1764.2 +040200S EXIT PROGRAM. NC1764.2 +040300STERMINATE-CALL. NC1764.2 +040400 STOP RUN. NC1764.2 +040500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1764.2 +040600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1764.2 +040700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1764.2 +040800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1764.2 +040900 MOVE "****TEST DELETED****" TO RE-MARK. NC1764.2 +041000 PRINT-DETAIL. NC1764.2 +041100 IF REC-CT NOT EQUAL TO ZERO NC1764.2 +041200 MOVE "." TO PARDOT-X NC1764.2 +041300 MOVE REC-CT TO DOTVALUE. NC1764.2 +041400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1764.2 +041500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1764.2 +041600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1764.2 +041700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1764.2 +041800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1764.2 +041900 MOVE SPACE TO CORRECT-X. NC1764.2 +042000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1764.2 +042100 MOVE SPACE TO RE-MARK. NC1764.2 +042200 HEAD-ROUTINE. NC1764.2 +042300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +042400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +042500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1764.2 +042600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1764.2 +042700 COLUMN-NAMES-ROUTINE. NC1764.2 +042800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +042900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +043000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +043100 END-ROUTINE. NC1764.2 +043200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1764.2 +043300 END-RTN-EXIT. NC1764.2 +043400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +043500 END-ROUTINE-1. NC1764.2 +043600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1764.2 +043700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1764.2 +043800 ADD PASS-COUNTER TO ERROR-HOLD. NC1764.2 +043900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1764.2 +044000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1764.2 +044100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1764.2 +044200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1764.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1764.2 +044400 END-ROUTINE-12. NC1764.2 +044500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1764.2 +044600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1764.2 +044700 MOVE "NO " TO ERROR-TOTAL NC1764.2 +044800 ELSE NC1764.2 +044900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1764.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1764.2 +045100 PERFORM WRITE-LINE. NC1764.2 +045200 END-ROUTINE-13. NC1764.2 +045300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1764.2 +045400 MOVE "NO " TO ERROR-TOTAL ELSE NC1764.2 +045500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1764.2 +045600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1764.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +045800 IF INSPECT-COUNTER EQUAL TO ZERO NC1764.2 +045900 MOVE "NO " TO ERROR-TOTAL NC1764.2 +046000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1764.2 +046100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1764.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +046300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +046400 WRITE-LINE. NC1764.2 +046500 ADD 1 TO RECORD-COUNT. NC1764.2 +046600Y IF RECORD-COUNT GREATER 42 NC1764.2 +046700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1764.2 +046800Y MOVE SPACE TO DUMMY-RECORD NC1764.2 +046900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1764.2 +047000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1764.2 +047100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1764.2 +047200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1764.2 +047300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1764.2 +047400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1764.2 +047800Y MOVE ZERO TO RECORD-COUNT. NC1764.2 +047900 PERFORM WRT-LN. NC1764.2 +048000 WRT-LN. NC1764.2 +048100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1764.2 +048200 MOVE SPACE TO DUMMY-RECORD. NC1764.2 +048300 BLANK-LINE-PRINT. NC1764.2 +048400 PERFORM WRT-LN. NC1764.2 +048500 FAIL-ROUTINE. NC1764.2 +048600 IF COMPUTED-X NOT EQUAL TO SPACE NC1764.2 +048700 GO TO FAIL-ROUTINE-WRITE. NC1764.2 +048800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1764.2 +048900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1764.2 +049000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1764.2 +049100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +049200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1764.2 +049300 GO TO FAIL-ROUTINE-EX. NC1764.2 +049400 FAIL-ROUTINE-WRITE. NC1764.2 +049500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1764.2 +049600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1764.2 +049700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1764.2 +049800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1764.2 +049900 FAIL-ROUTINE-EX. EXIT. NC1764.2 +050000 BAIL-OUT. NC1764.2 +050100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1764.2 +050200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1764.2 +050300 BAIL-OUT-WRITE. NC1764.2 +050400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1764.2 +050500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1764.2 +050600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +050700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1764.2 +050800 BAIL-OUT-EX. EXIT. NC1764.2 +050900 CCVS1-EXIT. NC1764.2 +051000 EXIT. NC1764.2 +051100 SECT-NC176A-001 SECTION. NC1764.2 +051200 ADD-INIT-F1-1. NC1764.2 +051300 MOVE "ADD" TO FEATURE. NC1764.2 +051400 MOVE "VI-74 6.6.4 GR4" TO ANSI-REFERENCE. NC1764.2 +051500 ADD-TEST-F1-1. NC1764.2 +051600 ADD N-5 TO N-7. NC1764.2 +051700 IF N-7 IS EQUAL TO 2 NC1764.2 +051800 PERFORM PASS NC1764.2 +051900 GO TO ADD-WRITE-F1-1. NC1764.2 +052000 GO TO ADD-FAIL-F1-1. NC1764.2 +052100 ADD-DELETE-F1-1. NC1764.2 +052200 PERFORM DE-LETE. NC1764.2 +052300 GO TO ADD-WRITE-F1-1. NC1764.2 +052400 ADD-FAIL-F1-1. NC1764.2 +052500 MOVE N-7 TO COMPUTED-N. NC1764.2 +052600 MOVE 2 TO CORRECT-N. NC1764.2 +052700 PERFORM FAIL. NC1764.2 +052800 ADD-WRITE-F1-1. NC1764.2 +052900 MOVE "ADD-TEST-F1-1 " TO PAR-NAME. NC1764.2 +053000 PERFORM PRINT-DETAIL. NC1764.2 +053100 ADD-TEST-F1-2. NC1764.2 +053200 ADD -.6 TO N-10 ROUNDED. NC1764.2 +053300 IF N-10 EQUAL TO -2 NC1764.2 +053400 PERFORM PASS NC1764.2 +053500 GO TO ADD-WRITE-F1-2. NC1764.2 +053600 GO TO ADD-FAIL-F1-2. NC1764.2 +053700 ADD-DELETE-F1-2. NC1764.2 +053800 PERFORM DE-LETE. NC1764.2 +053900 GO TO ADD-WRITE-F1-2. NC1764.2 +054000 ADD-FAIL-F1-2. NC1764.2 +054100 MOVE N-10 TO COMPUTED-N. NC1764.2 +054200 MOVE -2 TO CORRECT-N. NC1764.2 +054300 PERFORM FAIL. NC1764.2 +054400 ADD-WRITE-F1-2. NC1764.2 +054500 MOVE "ADD-TEST-F1-2 " TO PAR-NAME. NC1764.2 +054600 PERFORM PRINT-DETAIL. NC1764.2 +054700 MOVE -2 TO N-10. NC1764.2 +054800 ADD-TEST-F1-3-0. NC1764.2 +054900 ADD N-11 TO N-12 ON SIZE ERROR NC1764.2 +055000 PERFORM PASS NC1764.2 +055100 GO TO ADD-WRITE-F1-3. NC1764.2 +055200 GO TO ADD-FAIL-F1-3. NC1764.2 +055300 ADD-DELETE-F1-3. NC1764.2 +055400 PERFORM DE-LETE. NC1764.2 +055500 GO TO ADD-WRITE-F1-3. NC1764.2 +055600 ADD-FAIL-F1-3. NC1764.2 +055700 MOVE N-12 TO COMPUTED-N. NC1764.2 +055800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +055900 PERFORM FAIL. NC1764.2 +056000 ADD-WRITE-F1-3. NC1764.2 +056100 MOVE "ADD-TEST-F1-3 " TO PAR-NAME. NC1764.2 +056200 PERFORM PRINT-DETAIL. NC1764.2 +056300 ADD-TEST-F1-4-1. NC1764.2 +056400 ADD 1.5 TO N-13 ROUNDED ON SIZE ERROR NC1764.2 +056500 PERFORM PASS NC1764.2 +056600 GO TO ADD-WRITE-F1-4-1. NC1764.2 +056700* NOTE WHEN SIZE ERROR CONDITION OCCURS, VALUE OF NC1764.2 +056800* N-13 SHOULD NOT BE CHANGED. NC1764.2 +056900 GO TO ADD-FAIL-F1-4-1. NC1764.2 +057000 ADD-DELETE-F1-4-1. NC1764.2 +057100 PERFORM DE-LETE. NC1764.2 +057200 GO TO ADD-WRITE-F1-4-1. NC1764.2 +057300 ADD-FAIL-F1-4-1. NC1764.2 +057400 MOVE N-13 TO COMPUTED-N. NC1764.2 +057500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +057600 PERFORM FAIL. NC1764.2 +057700 ADD-WRITE-F1-4-1. NC1764.2 +057800 MOVE "ADD-TEST-F1-4-1 " TO PAR-NAME. NC1764.2 +057900 PERFORM PRINT-DETAIL. NC1764.2 +058000 ADD-TEST-F1-4-2. NC1764.2 +058100 IF N-13 IS EQUAL TO 99999 NC1764.2 +058200 PERFORM PASS NC1764.2 +058300 GO TO ADD-WRITE-F1-4-2. NC1764.2 +058400 GO TO ADD-FAIL-F1-4-2. NC1764.2 +058500 ADD-DELETE-F1-4-2. NC1764.2 +058600 PERFORM DE-LETE. NC1764.2 +058700 GO TO ADD-WRITE-F1-4-2. NC1764.2 +058800 ADD-FAIL-F1-4-2. NC1764.2 +058900 MOVE N-13 TO COMPUTED-N. NC1764.2 +059000 MOVE 99999 TO CORRECT-N. NC1764.2 +059100 PERFORM FAIL. NC1764.2 +059200 ADD-WRITE-F1-4-2. NC1764.2 +059300 MOVE "ADD-TEST-F1-4-2 " TO PAR-NAME. NC1764.2 +059400 PERFORM PRINT-DETAIL. NC1764.2 +059500 ADD-INIT-F1-5. NC1764.2 +059600 MOVE "ADD ---" TO FEATURE. NC1764.2 +059700 PERFORM PRINT-DETAIL. NC1764.2 +059800 MOVE " TO" TO FEATURE. NC1764.2 +059900 ADD-TEST-F1-5. NC1764.2 +060000 MOVE A18TWOS-DS-18V00 TO WRK-DS-18V00. NC1764.2 +060100 ADD A18ONES-DS-18V00 TO WRK-DS-18V00. NC1764.2 +060200 IF WRK-DS-18V00 EQUAL TO 333333333333333333 NC1764.2 +060300 PERFORM PASS GO TO ADD-WRITE-F1-5. NC1764.2 +060400 GO TO ADD-FAIL-F1-5. NC1764.2 +060500 ADD-DELETE-F1-5. NC1764.2 +060600 PERFORM DE-LETE. NC1764.2 +060700 GO TO ADD-WRITE-F1-5. NC1764.2 +060800 ADD-FAIL-F1-5. NC1764.2 +060900 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1764.2 +061000 MOVE 333333333333333333 TO CORRECT-18V0. NC1764.2 +061100 PERFORM FAIL. NC1764.2 +061200 ADD-WRITE-F1-5. NC1764.2 +061300 MOVE "ADD-TEST-F1-5" TO PAR-NAME. NC1764.2 +061400 PERFORM PRINT-DETAIL. NC1764.2 +061500 ADD-TEST-F1-6. NC1764.2 +061600 MOVE ZERO TO WRK-DS-10V00. NC1764.2 +061700 ADD A10ONES-DS-10V00 A05ONES-DS-05V00 TO WRK-DS-10V00. NC1764.2 +061800 IF WRK-DS-10V00 EQUAL TO 1111122222 NC1764.2 +061900 PERFORM PASS GO TO ADD-WRITE-F1-6. NC1764.2 +062000 GO TO ADD-FAIL-F1-6. NC1764.2 +062100 ADD-DELETE-F1-6. NC1764.2 +062200 PERFORM DE-LETE. NC1764.2 +062300 GO TO ADD-WRITE-F1-6. NC1764.2 +062400 ADD-FAIL-F1-6. NC1764.2 +062500 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1764.2 +062600 MOVE 1111122222 TO CORRECT-18V0. NC1764.2 +062700 PERFORM FAIL. NC1764.2 +062800 ADD-WRITE-F1-6. NC1764.2 +062900 MOVE "ADD-TEST-F1-6" TO PAR-NAME. NC1764.2 +063000 PERFORM PRINT-DETAIL. NC1764.2 +063100 ADD-TEST-F1-7. NC1764.2 +063200 MOVE ZERO TO WRK-DS-10V00. NC1764.2 +063300 ADD A02ONES-DS-02V00 NC1764.2 +063400 A10ONES-DS-10V00 NC1764.2 +063500 A05ONES-DS-05V00 TO WRK-DS-10V00. NC1764.2 +063600 IF WRK-DS-10V00 EQUAL TO 1111122233 NC1764.2 +063700 PERFORM PASS GO TO ADD-WRITE-F1-7. NC1764.2 +063800 GO TO ADD-FAIL-F1-7. NC1764.2 +063900 ADD-DELETE-F1-7. NC1764.2 +064000 PERFORM DE-LETE. NC1764.2 +064100 GO TO ADD-WRITE-F1-7. NC1764.2 +064200 ADD-FAIL-F1-7. NC1764.2 +064300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1764.2 +064400 MOVE 1111122233 TO CORRECT-18V0. NC1764.2 +064500 PERFORM FAIL. NC1764.2 +064600 ADD-WRITE-F1-7. NC1764.2 +064700 MOVE "ADD-TEST-F1-7" TO PAR-NAME. NC1764.2 +064800 PERFORM PRINT-DETAIL. NC1764.2 +064900 ADD-INIT-F1-8. NC1764.2 +065000 MOVE " ROUNDED" TO FEATURE. NC1764.2 +065100 ADD-TEST-F1-8. NC1764.2 +065200 MOVE ZERO TO WRK-DS-05V00. NC1764.2 +065300 ADD 55554.5 TO WRK-DS-05V00 ROUNDED. NC1764.2 +065400 IF WRK-DS-05V00 EQUAL TO 55555 NC1764.2 +065500 PERFORM PASS GO TO ADD-WRITE-F1-8. NC1764.2 +065600 GO TO ADD-FAIL-F1-8. NC1764.2 +065700 ADD-DELETE-F1-8. NC1764.2 +065800 PERFORM DE-LETE. NC1764.2 +065900 GO TO ADD-WRITE-F1-8. NC1764.2 +066000 ADD-FAIL-F1-8. NC1764.2 +066100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1764.2 +066200 MOVE 55555 TO CORRECT-N. NC1764.2 +066300 PERFORM FAIL. NC1764.2 +066400 ADD-WRITE-F1-8. NC1764.2 +066500 MOVE "ADD-TEST-F1-8" TO PAR-NAME. NC1764.2 +066600 PERFORM PRINT-DETAIL. NC1764.2 +066700 ADD-INIT-F1-9-1. NC1764.2 +066800 MOVE " SIZE ERROR" TO FEATURE. NC1764.2 +066900 MOVE -11 TO WRK-DS-02V00. NC1764.2 +067000 ADD-TEST-F1-9-1. NC1764.2 +067100 ADD -99 TO WRK-DS-02V00 ON SIZE ERROR NC1764.2 +067200 PERFORM PASS GO TO ADD-WRITE-F1-9-1. NC1764.2 +067300 GO TO ADD-FAIL-F1-9-1. NC1764.2 +067400 ADD-DELETE-F1-9-1. NC1764.2 +067500 PERFORM DE-LETE. NC1764.2 +067600 GO TO ADD-WRITE-F1-9-1. NC1764.2 +067700 ADD-FAIL-F1-9-1. NC1764.2 +067800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +067900 PERFORM FAIL. NC1764.2 +068000 ADD-WRITE-F1-9-1. NC1764.2 +068100 MOVE "ADD-TEST-F1-9-1" TO PAR-NAME. NC1764.2 +068200 PERFORM PRINT-DETAIL. NC1764.2 +068300 ADD-TEST-F1-9-2. NC1764.2 +068400 IF WRK-DS-02V00 EQUAL TO -11 NC1764.2 +068500 PERFORM PASS GO TO ADD-WRITE-F1-9-2. NC1764.2 +068600* THIS TEST DEPENDS ON THE RESULTS OF TEST-F1-9-1 ABOVE. NC1764.2 +068700 GO TO ADD-FAIL-F1-9-2. NC1764.2 +068800 ADD-DELETE-F1-9-2. NC1764.2 +068900 PERFORM DE-LETE. NC1764.2 +069000 GO TO ADD-WRITE-F1-9-2. NC1764.2 +069100 ADD-FAIL-F1-9-2. NC1764.2 +069200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +069300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1764.2 +069400 MOVE -11 TO CORRECT-N. NC1764.2 +069500 PERFORM FAIL. NC1764.2 +069600 ADD-WRITE-F1-9-2. NC1764.2 +069700 MOVE "ADD-TEST-F1-9-2" TO PAR-NAME. NC1764.2 +069800 PERFORM PRINT-DETAIL. NC1764.2 +069900 ADD-INIT-F1-10-1. NC1764.2 +070000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1764.2 +070100 ADD-TEST-F1-10-1. NC1764.2 +070200 MOVE ZERO TO WRK-DS-05V00 NC1764.2 +070300 ADD 33333 NC1764.2 +070400 A06THREES-DS-03V03 NC1764.2 +070500 A12THREES-DS-06V06 NC1764.2 +070600 TO WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1764.2 +070700 PERFORM PASS GO TO ADD-WRITE-F1-10-1. NC1764.2 +070800 GO TO ADD-FAIL-F1-10-1. NC1764.2 +070900 ADD-DELETE-F1-10-1. NC1764.2 +071000 PERFORM DE-LETE. NC1764.2 +071100 GO TO ADD-WRITE-F1-10-1. NC1764.2 +071200 ADD-FAIL-F1-10-1. NC1764.2 +071300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +071400 PERFORM FAIL. NC1764.2 +071500 ADD-WRITE-F1-10-1. NC1764.2 +071600 MOVE "ADD-TEST-F1-10-1" TO PAR-NAME. NC1764.2 +071700 PERFORM PRINT-DETAIL. NC1764.2 +071800 ADD-TEST-F1-10-2. NC1764.2 +071900 IF WRK-DS-05V00 EQUAL TO ZERO NC1764.2 +072000 PERFORM PASS GO TO ADD-WRITE-F1-10-2. NC1764.2 +072100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-10-1 NC1764.2 +072200 GO TO ADD-FAIL-F1-10-2. NC1764.2 +072300 ADD-DELETE-F1-10-2. NC1764.2 +072400 PERFORM DE-LETE. NC1764.2 +072500 GO TO ADD-WRITE-F1-10-2. NC1764.2 +072600 ADD-FAIL-F1-10-2. NC1764.2 +072700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +072800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1764.2 +072900 MOVE ZERO TO CORRECT-N. NC1764.2 +073000 PERFORM FAIL. NC1764.2 +073100 ADD-WRITE-F1-10-2. NC1764.2 +073200 MOVE "ADD-TEST-F1-10-2" TO PAR-NAME. NC1764.2 +073300 PERFORM PRINT-DETAIL. NC1764.2 +073400 ADD-TEST-F1-11-1. NC1764.2 +073500 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +073600 ADD A12THREES-DS-06V06 NC1764.2 +073700 333333 NC1764.2 +073800 A06THREES-DS-03V03 NC1764.2 +073900 TO WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1764.2 +074000 GO TO ADD-FAIL-F1-11-1. NC1764.2 +074100 PERFORM PASS. NC1764.2 +074200 GO TO ADD-WRITE-F1-11-1. NC1764.2 +074300 ADD-DELETE-F1-11-1. NC1764.2 +074400 PERFORM DE-LETE. NC1764.2 +074500 GO TO ADD-WRITE-F1-11-1. NC1764.2 +074600 ADD-FAIL-F1-11-1. NC1764.2 +074700 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1764.2 +074800 PERFORM FAIL. NC1764.2 +074900 ADD-WRITE-F1-11-1. NC1764.2 +075000 MOVE "ADD-TEST-F1-11-1" TO PAR-NAME. NC1764.2 +075100 PERFORM PRINT-DETAIL. NC1764.2 +075200 ADD-TEST-F1-11-2. NC1764.2 +075300 IF WRK-DS-06V06 EQUAL TO 666999.666333 NC1764.2 +075400 PERFORM PASS GO TO ADD-WRITE-F1-11-2. NC1764.2 +075500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-11-1 NC1764.2 +075600 GO TO ADD-FAIL-F1-11-2. NC1764.2 +075700 ADD-DELETE-F1-11-2. NC1764.2 +075800 PERFORM DE-LETE. NC1764.2 +075900 GO TO ADD-WRITE-F1-11-2. NC1764.2 +076000 ADD-FAIL-F1-11-2. NC1764.2 +076100 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1764.2 +076200 MOVE 666999.666333 TO CORRECT-N. NC1764.2 +076300 PERFORM FAIL. NC1764.2 +076400 ADD-WRITE-F1-11-2. NC1764.2 +076500 MOVE "ADD-TEST-F1-11-2" TO PAR-NAME. NC1764.2 +076600 PERFORM PRINT-DETAIL. NC1764.2 +076700 ADD-INIT-F1-12. NC1764.2 +076800 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1764.2 +076900 ADD-TEST-F1-12. NC1764.2 +077000 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1764.2 +077100 ADD A18ONES-DS-18V00 TO WRK-CS-18V00. NC1764.2 +077200 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1764.2 +077300 PERFORM PASS GO TO ADD-WRITE-F1-12. NC1764.2 +077400 GO TO ADD-FAIL-F1-12. NC1764.2 +077500 ADD-DELETE-F1-12. NC1764.2 +077600 PERFORM DE-LETE. NC1764.2 +077700 GO TO ADD-WRITE-F1-12. NC1764.2 +077800 ADD-FAIL-F1-12. NC1764.2 +077900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +078000 MOVE 222222222222222222 TO CORRECT-18V0. NC1764.2 +078100 PERFORM FAIL. NC1764.2 +078200 ADD-WRITE-F1-12. NC1764.2 +078300 MOVE "ADD-TEST-F1-12" TO PAR-NAME. NC1764.2 +078400 PERFORM PRINT-DETAIL. NC1764.2 +078500 ADD-TEST-F1-13. NC1764.2 +078600 MOVE A18ONES-DS-18V00 TO WRK-DS-18V00. NC1764.2 +078700 ADD A18ONES-CS-18V00 TO WRK-DS-18V00. NC1764.2 +078800 IF WRK-DS-18V00 EQUAL TO 222222222222222222 NC1764.2 +078900 PERFORM PASS GO TO ADD-WRITE-F1-13. NC1764.2 +079000 GO TO ADD-FAIL-F1-13. NC1764.2 +079100 ADD-DELETE-F1-13. NC1764.2 +079200 PERFORM DE-LETE. NC1764.2 +079300 GO TO ADD-WRITE-F1-13. NC1764.2 +079400 ADD-FAIL-F1-13. NC1764.2 +079500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1764.2 +079600 MOVE 222222222222222222 TO CORRECT-18V0. NC1764.2 +079700 PERFORM FAIL. NC1764.2 +079800 ADD-WRITE-F1-13. NC1764.2 +079900 MOVE "ADD-TEST-F1-13" TO PAR-NAME. NC1764.2 +080000 PERFORM PRINT-DETAIL. NC1764.2 +080100 ADD-TEST-F1-14. NC1764.2 +080200 MOVE ZERO TO WRK-CS-02V02. NC1764.2 +080300 ADD A99-CS-02V00 TO WRK-CS-02V02. NC1764.2 +080400 IF WRK-CS-02V02 EQUAL TO 99.00 NC1764.2 +080500 PERFORM PASS GO TO ADD-WRITE-F1-14. NC1764.2 +080600 GO TO ADD-FAIL-F1-14. NC1764.2 +080700 ADD-DELETE-F1-14. NC1764.2 +080800 PERFORM DE-LETE. NC1764.2 +080900 GO TO ADD-WRITE-F1-14. NC1764.2 +081000 ADD-FAIL-F1-14. NC1764.2 +081100 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1764.2 +081200 MOVE 99.00 TO CORRECT-N. NC1764.2 +081300 PERFORM FAIL. NC1764.2 +081400 ADD-WRITE-F1-14. NC1764.2 +081500 MOVE "ADD-TEST-F1-14" TO PAR-NAME. NC1764.2 +081600 PERFORM PRINT-DETAIL. NC1764.2 +081700 ADD-TEST-F1-15-1. NC1764.2 +081800 MOVE A99-CS-02V00 TO WRK-CS-02V02. NC1764.2 +081900 ADD A99-CS-02V00 TO WRK-CS-02V02 ON SIZE ERROR NC1764.2 +082000 PERFORM PASS GO TO ADD-WRITE-F1-15-1. NC1764.2 +082100 GO TO ADD-FAIL-F1-15-1. NC1764.2 +082200 ADD-DELETE-F1-15-1. NC1764.2 +082300 PERFORM DE-LETE. NC1764.2 +082400 GO TO ADD-WRITE-F1-15-1. NC1764.2 +082500 ADD-FAIL-F1-15-1. NC1764.2 +082600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +082700 PERFORM FAIL. NC1764.2 +082800 ADD-WRITE-F1-15-1. NC1764.2 +082900 MOVE "ADD-TEST-F1-15-1" TO PAR-NAME. NC1764.2 +083000 PERFORM PRINT-DETAIL. NC1764.2 +083100 ADD-TEST-F1-15-2. NC1764.2 +083200 IF WRK-CS-02V02 EQUAL TO 99.00 NC1764.2 +083300 PERFORM PASS GO TO ADD-WRITE-F1-15-2. NC1764.2 +083400* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-15-1 NC1764.2 +083500 GO TO ADD-FAIL-F1-15-2. NC1764.2 +083600 ADD-DELETE-F1-15-2. NC1764.2 +083700 PERFORM DE-LETE. NC1764.2 +083800 GO TO ADD-WRITE-F1-15-2. NC1764.2 +083900 ADD-FAIL-F1-15-2. NC1764.2 +084000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +084100 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1764.2 +084200 MOVE 99.00 TO CORRECT-N. NC1764.2 +084300 PERFORM FAIL. NC1764.2 +084400 ADD-WRITE-F1-15-2. NC1764.2 +084500 MOVE "ADD-TEST-F1-15-2" TO PAR-NAME. NC1764.2 +084600 PERFORM PRINT-DETAIL. NC1764.2 +084700 ADD-TEST-F1-16. NC1764.2 +084800 MOVE A14TWOS-CS-18V00 TO WRK-CS-18V00. NC1764.2 +084900 ADD A18FIVES-CS-18V00 TO WRK-CS-18V00. NC1764.2 +085000 IF WRK-CS-18V00 EQUAL TO -555577777777777777 NC1764.2 +085100 PERFORM PASS NC1764.2 +085200 GO TO ADD-WRITE-F1-16. NC1764.2 +085300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +085400 MOVE -555577777777777777 TO CORRECT-18V0. NC1764.2 +085500 PERFORM FAIL. NC1764.2 +085600 GO TO ADD-WRITE-F1-16. NC1764.2 +085700 ADD-DELETE-F1-16. NC1764.2 +085800 PERFORM DE-LETE. NC1764.2 +085900 ADD-WRITE-F1-16. NC1764.2 +086000 MOVE "ADD-TEST-F1-16 " TO PAR-NAME. NC1764.2 +086100 PERFORM PRINT-DETAIL. NC1764.2 +086200 ADD-TEST-F1-17. NC1764.2 +086300 MOVE A12SEVENS-CU-18V00 TO WRK-CS-18V00. NC1764.2 +086400 ADD A18SIXES-CS-18V00 TO WRK-CS-18V00. NC1764.2 +086500 IF WRK-CS-18V00 EQUAL TO +666667444444444443 NC1764.2 +086600 PERFORM PASS NC1764.2 +086700 GO TO ADD-WRITE-F1-17. NC1764.2 +086800 MOVE +666667444444444443 TO CORRECT-18V0. NC1764.2 +086900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +087000 PERFORM FAIL. NC1764.2 +087100 GO TO ADD-WRITE-F1-17. NC1764.2 +087200 ADD-DELETE-F1-17. NC1764.2 +087300 PERFORM DE-LETE. NC1764.2 +087400 ADD-WRITE-F1-17. NC1764.2 +087500 MOVE "ADD-TEST-F1-17 " TO PAR-NAME. NC1764.2 +087600 PERFORM PRINT-DETAIL. NC1764.2 +087700 ADD-TEST-F1-18. NC1764.2 +087800 MOVE A12SEVENS-CU-18V00 TO WRK-DU-18V00. NC1764.2 +087900 ADD A18FIVES-CS-18V00 TO WRK-DU-18V00. NC1764.2 +088000 IF WRK-DU-18V00 EQUAL TO 555554777777777778 NC1764.2 +088100 PERFORM PASS NC1764.2 +088200 GO TO ADD-WRITE-F1-18. NC1764.2 +088300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1764.2 +088400 MOVE 555554777777777778 TO CORRECT-18V0. NC1764.2 +088500 PERFORM FAIL. NC1764.2 +088600 GO TO ADD-WRITE-F1-18. NC1764.2 +088700 ADD-DELETE-F1-18. NC1764.2 +088800 PERFORM DE-LETE. NC1764.2 +088900 ADD-WRITE-F1-18. NC1764.2 +089000 MOVE "ADD-TEST-F1-18 " TO PAR-NAME. NC1764.2 +089100 PERFORM PRINT-DETAIL. NC1764.2 +089200 ADD-TEST-F1-19. NC1764.2 +089300 MOVE +980 TO WRK-CS-03V00. NC1764.2 +089400 MOVE SPACE TO SIZE-ERR. NC1764.2 +089500* NOTE IN THIS TEST, 1 IS ADDED TO A 3-DIGIT COMP SYNC NC1764.2 +089600* FIELD UNTIL A SIZE ERROR OCCURS --- IF THE VALUE OF NC1764.2 +089700* THE FIELD REACHES 1180 WITHOUT A SIZE ERROR THE NC1764.2 +089800* ATTEMPTED ADDITIONS ARE TERMINATED. NC1764.2 +089900 PERFORM ADD-A-F1-19 THRU ADD-B-F1-19 200 TIMES. NC1764.2 +090000 IF SIZE-ERR EQUAL TO SPACE NC1764.2 +090100 MOVE "SIZE ERROR NOT ENCOUNTERED" TO RE-MARK NC1764.2 +090200 MOVE "AT LEAST 1180" TO COMPUTED-A NC1764.2 +090300 MOVE "999 IN PIC 999 FIELD" TO CORRECT-A NC1764.2 +090400 PERFORM FAIL NC1764.2 +090500 GO TO ADD-WRITE-F1-19. NC1764.2 +090600 IF WRK-CS-03V00 EQUAL TO 999 NC1764.2 +090700 PERFORM PASS GO TO ADD-WRITE-F1-19. NC1764.2 +090800 PERFORM FAIL. NC1764.2 +090900 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1764.2 +091000 MOVE 999 TO CORRECT-N. NC1764.2 +091100 GO TO ADD-WRITE-F1-19. NC1764.2 +091200 ADD-DELETE-F1-19. NC1764.2 +091300 PERFORM DE-LETE. NC1764.2 +091400 GO TO ADD-WRITE-F1-19. NC1764.2 +091500 ADD-A-F1-19. NC1764.2 +091600 IF SIZE-ERR EQUAL TO "E" GO TO ADD-B-F1-19. NC1764.2 +091700 ADD 1 TO WRK-CS-03V00 ON SIZE ERROR NC1764.2 +091800 MOVE "E" TO SIZE-ERR. NC1764.2 +091900 ADD-B-F1-19. NC1764.2 +092000 EXIT. NC1764.2 +092100 ADD-WRITE-F1-19. NC1764.2 +092200 MOVE "ADD, COMP, SIZE ERR" TO FEATURE. NC1764.2 +092300 MOVE "ADD-TEST-F1-19" TO PAR-NAME. NC1764.2 +092400 PERFORM PRINT-DETAIL. NC1764.2 +092500* NC1764.2 +092600 ADD-INIT-F1-20. NC1764.2 +092700* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +092800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +092900 MOVE -11 TO WRK-DS-02V00. NC1764.2 +093000 ADD-TEST-F1-20. NC1764.2 +093100 ADD -99 TO WRK-DS-02V00 NC1764.2 +093200 NOT ON SIZE ERROR NC1764.2 +093300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +093400 TO RE-MARK NC1764.2 +093500 PERFORM FAIL NC1764.2 +093600 GO TO ADD-WRITE-F1-20. NC1764.2 +093700 GO TO ADD-PASS-F1-20. NC1764.2 +093800 ADD-DELETE-F1-20. NC1764.2 +093900 PERFORM DE-LETE. NC1764.2 +094000 GO TO ADD-WRITE-F1-20. NC1764.2 +094100 ADD-PASS-F1-20. NC1764.2 +094200 PERFORM PASS. NC1764.2 +094300 ADD-WRITE-F1-20. NC1764.2 +094400 MOVE "ADD-TEST-F1-20" TO PAR-NAME. NC1764.2 +094500 PERFORM PRINT-DETAIL. NC1764.2 +094600* NC1764.2 +094700 ADD-INIT-F1-21. NC1764.2 +094800* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +094900 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +095000 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +095100 ADD-TEST-F1-21-0. NC1764.2 +095200 ADD A12THREES-DS-06V06 NC1764.2 +095300 333333 NC1764.2 +095400 A06THREES-DS-03V03 NC1764.2 +095500 TO WRK-DS-06V06 ROUNDED NC1764.2 +095600 NOT ON SIZE ERROR NC1764.2 +095700 GO TO ADD-PASS-F1-21. NC1764.2 +095800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1764.2 +095900 PERFORM FAIL. NC1764.2 +096000 GO TO ADD-WRITE-F1-21. NC1764.2 +096100 ADD-DELETE-F1-21. NC1764.2 +096200 PERFORM DE-LETE. NC1764.2 +096300 GO TO ADD-WRITE-F1-21. NC1764.2 +096400 ADD-PASS-F1-21. NC1764.2 +096500 PERFORM PASS. NC1764.2 +096600 ADD-WRITE-F1-21. NC1764.2 +096700 MOVE "ADD-TEST-F1-21" TO PAR-NAME. NC1764.2 +096800 PERFORM PRINT-DETAIL. NC1764.2 +096900* NC1764.2 +097000 ADD-INIT-F1-22. NC1764.2 +097100* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +097200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +097300 MOVE -11 TO WRK-DS-02V00. NC1764.2 +097400 ADD-TEST-F1-22-0. NC1764.2 +097500 ADD -99 TO WRK-DS-02V00 NC1764.2 +097600 ON SIZE ERROR NC1764.2 +097700 PERFORM PASS NC1764.2 +097800 GO TO ADD-WRITE-F1-22 NC1764.2 +097900 NOT ON SIZE ERROR NC1764.2 +098000 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +098100 TO RE-MARK NC1764.2 +098200 PERFORM FAIL NC1764.2 +098300 GO TO ADD-WRITE-F1-22. NC1764.2 +098400 ADD-DELETE-F1-22. NC1764.2 +098500 PERFORM DE-LETE. NC1764.2 +098600 ADD-WRITE-F1-22. NC1764.2 +098700 MOVE "ADD-TEST-F1-22" TO PAR-NAME. NC1764.2 +098800 PERFORM PRINT-DETAIL. NC1764.2 +098900* NC1764.2 +099000 ADD-INIT-F1-23. NC1764.2 +099100* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +099200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +099300 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +099400 ADD-TEST-F1-23-0. NC1764.2 +099500 ADD A12THREES-DS-06V06 NC1764.2 +099600 333333 NC1764.2 +099700 A06THREES-DS-03V03 NC1764.2 +099800 TO WRK-DS-06V06 ROUNDED NC1764.2 +099900 ON SIZE ERROR NC1764.2 +100000 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +100100 TO RE-MARK NC1764.2 +100200 PERFORM FAIL NC1764.2 +100300 GO TO ADD-WRITE-F1-23 NC1764.2 +100400 NOT ON SIZE ERROR NC1764.2 +100500 GO TO ADD-PASS-F1-23. NC1764.2 +100600 ADD-DELETE-F1-23. NC1764.2 +100700 PERFORM DE-LETE. NC1764.2 +100800 GO TO ADD-WRITE-F1-23. NC1764.2 +100900 ADD-PASS-F1-23. NC1764.2 +101000 PERFORM PASS. NC1764.2 +101100 ADD-WRITE-F1-23. NC1764.2 +101200 MOVE "ADD-TEST-F1-23" TO PAR-NAME. NC1764.2 +101300 PERFORM PRINT-DETAIL. NC1764.2 +101400* NC1764.2 +101500 ADD-INIT-F1-24. NC1764.2 +101600* ==--> MULTIPLE OPERANDS <--== NC1764.2 +101700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +101800 MOVE "ADD LIMIT TESTS " TO FEATURE. NC1764.2 +101900 MOVE 1 TO DNAME1 DNAME2 DNAME3 DNAME4 DNAME5. NC1764.2 +102000 MOVE 1 TO DNAME6 DNAME7 DNAME8 DNAME9 DNAME10. NC1764.2 +102100 MOVE 1 TO DNAME11 DNAME12 DNAME13 DNAME14 DNAME15. NC1764.2 +102200 MOVE 1 TO DNAME16 DNAME17 DNAME18 DNAME19 DNAME20. NC1764.2 +102300 MOVE 1 TO DNAME21. NC1764.2 +102400 MOVE 0 TO DNAME22. NC1764.2 +102500* THE FOLLOWING 22 TESTS VERIFY THE ABILITY OF THE COMPILER NC1764.2 +102600* TO HANDLE A MAXIMUM OF 42 OPERANDS. A DELETION IN THIS NC1764.2 +102700* PARAGRAPH WILL SKIP THE LIMIT TESTS. NC1764.2 +102800 GO TO ADD-TEST-F1-24. NC1764.2 +102900 ADD-INIT-DELETE. NC1764.2 +103000 PERFORM DE-LETE. NC1764.2 +103100 MOVE "ADD-TEST-F1-24 TO F1-45" TO PAR-NAME. NC1764.2 +103200 MOVE "ADD LIMIT TESTS " TO FEATURE. NC1764.2 +103300 ADD 21 TO DELETE-COUNTER. NC1764.2 +103400 PERFORM PRINT-DETAIL. NC1764.2 +103500 GO TO ADD-INIT-F1-46. NC1764.2 +103600 ADD-TEST-F1-24. NC1764.2 +103700 ADD DNAME1 NC1764.2 +103800 DNAME2 NC1764.2 +103900 DNAME3 NC1764.2 +104000 DNAME4 NC1764.2 +104100 DNAME5 NC1764.2 +104200 DNAME6 NC1764.2 +104300 DNAME7 NC1764.2 +104400 DNAME8 NC1764.2 +104500 DNAME9 NC1764.2 +104600 DNAME10 NC1764.2 +104700 DNAME11 NC1764.2 +104800 DNAME12 NC1764.2 +104900 DNAME13 NC1764.2 +105000 DNAME14 NC1764.2 +105100 DNAME15 NC1764.2 +105200 DNAME16 NC1764.2 +105300 DNAME17 NC1764.2 +105400 DNAME18 NC1764.2 +105500 DNAME19 NC1764.2 +105600 DNAME20 NC1764.2 +105700 DNAME21 NC1764.2 +105800 TO DNAME22. NC1764.2 +105900* THE NUMBER OF OPERANDS CAPABLE OF BEING ADDED TO ONE NC1764.2 +106000* DATANAME WILL BE REFLECTED BY THE COMPUTED-ANSWER. NC1764.2 +106100 IF DNAME22 EQUAL TO 21 NC1764.2 +106200 PERFORM PASS NC1764.2 +106300 GO TO ADD-WRITE-F1-24. NC1764.2 +106400 MOVE 21 TO CORRECT-18V0. NC1764.2 +106500 MOVE DNAME22 TO COMPUTED-18V0. NC1764.2 +106600 PERFORM FAIL. NC1764.2 +106700 GO TO ADD-WRITE-F1-24. NC1764.2 +106800 ADD-DELETE-F1-24. NC1764.2 +106900 PERFORM DE-LETE. NC1764.2 +107000 ADD-WRITE-F1-24. NC1764.2 +107100 MOVE "ADD-TEST-F1-24 " TO PAR-NAME. NC1764.2 +107200 PERFORM PRINT-DETAIL. NC1764.2 +107300 ADD-INIT-F1-25. NC1764.2 +107400 MOVE ZERO TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1764.2 +107500 MOVE ZERO TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1764.2 +107600 MOVE ZERO TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1764.2 +107700 MOVE ZERO TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1764.2 +107800 MOVE ZERO TO DNAME42. NC1764.2 +107900 ADD-TEST-F1-25. NC1764.2 +108000 ADD DNAME1 NC1764.2 +108100 DNAME2 NC1764.2 +108200 DNAME3 NC1764.2 +108300 DNAME4 NC1764.2 +108400 DNAME5 NC1764.2 +108500 DNAME6 NC1764.2 +108600 DNAME7 NC1764.2 +108700 DNAME8 NC1764.2 +108800 DNAME9 NC1764.2 +108900 DNAME10 NC1764.2 +109000 DNAME11 NC1764.2 +109100 DNAME12 NC1764.2 +109200 DNAME13 NC1764.2 +109300 DNAME14 NC1764.2 +109400 DNAME15 NC1764.2 +109500 DNAME16 NC1764.2 +109600 DNAME17 NC1764.2 +109700 DNAME18 NC1764.2 +109800 DNAME19 NC1764.2 +109900 DNAME20 NC1764.2 +110000 DNAME21 NC1764.2 +110100 TO DNAME22 NC1764.2 +110200 DNAME23 NC1764.2 +110300 DNAME24 NC1764.2 +110400 DNAME25 NC1764.2 +110500 DNAME26 NC1764.2 +110600 DNAME27 NC1764.2 +110700 DNAME28 NC1764.2 +110800 DNAME29 NC1764.2 +110900 DNAME30 NC1764.2 +111000 DNAME31 NC1764.2 +111100 DNAME32 NC1764.2 +111200 DNAME33 NC1764.2 +111300 DNAME34 NC1764.2 +111400 DNAME35 NC1764.2 +111500 DNAME36 NC1764.2 +111600 DNAME37 NC1764.2 +111700 DNAME38 NC1764.2 +111800 DNAME39 NC1764.2 +111900 DNAME40 NC1764.2 +112000 DNAME41 NC1764.2 +112100 DNAME42. NC1764.2 +112200 IF DNAME22 EQUAL TO 21 NC1764.2 +112300 PERFORM PASS NC1764.2 +112400 GO TO ADD-WRITE-F1-25. NC1764.2 +112500 MOVE 21 TO CORRECT-18V0. NC1764.2 +112600 MOVE DNAME22 TO COMPUTED-18V0. NC1764.2 +112700 PERFORM FAIL. NC1764.2 +112800 GO TO ADD-WRITE-F1-25. NC1764.2 +112900 ADD-DELETE-F1-25. NC1764.2 +113000 PERFORM DE-LETE. NC1764.2 +113100 ADD-WRITE-F1-25. NC1764.2 +113200 MOVE "ADD-TEST-F1-25 " TO PAR-NAME. NC1764.2 +113300 PERFORM PRINT-DETAIL. NC1764.2 +113400 ADD-TEST-F1-26. NC1764.2 +113500 IF DNAME23 EQUAL TO 21 NC1764.2 +113600 PERFORM PASS NC1764.2 +113700 GO TO ADD-WRITE-F1-26. NC1764.2 +113800 MOVE 21 TO CORRECT-18V0. NC1764.2 +113900 MOVE DNAME23 TO COMPUTED-18V0. NC1764.2 +114000 PERFORM FAIL. NC1764.2 +114100 GO TO ADD-WRITE-F1-26. NC1764.2 +114200 ADD-DELETE-F1-26. NC1764.2 +114300 PERFORM DE-LETE. NC1764.2 +114400 ADD-WRITE-F1-26. NC1764.2 +114500 MOVE "ADD-TEST-F1-26 " TO PAR-NAME. NC1764.2 +114600 PERFORM PRINT-DETAIL. NC1764.2 +114700 ADD-TEST-F1-27. NC1764.2 +114800 IF DNAME24 EQUAL TO 21 NC1764.2 +114900 PERFORM PASS NC1764.2 +115000 GO TO ADD-WRITE-F1-27. NC1764.2 +115100 MOVE 21 TO CORRECT-18V0. NC1764.2 +115200 MOVE DNAME24 TO COMPUTED-18V0. NC1764.2 +115300 PERFORM FAIL. NC1764.2 +115400 GO TO ADD-WRITE-F1-27. NC1764.2 +115500 ADD-DELETE-F1-27. NC1764.2 +115600 PERFORM DE-LETE. NC1764.2 +115700 ADD-WRITE-F1-27. NC1764.2 +115800 MOVE "ADD-TEST-F1-27 " TO PAR-NAME. NC1764.2 +115900 PERFORM PRINT-DETAIL. NC1764.2 +116000 ADD-TEST-F1-28. NC1764.2 +116100 IF DNAME25 EQUAL TO 21 NC1764.2 +116200 PERFORM PASS NC1764.2 +116300 GO TO ADD-WRITE-F1-28. NC1764.2 +116400 MOVE 21 TO CORRECT-18V0. NC1764.2 +116500 MOVE DNAME25 TO COMPUTED-18V0. NC1764.2 +116600 PERFORM FAIL. NC1764.2 +116700 GO TO ADD-WRITE-F1-28. NC1764.2 +116800 ADD-DELETE-F1-28. NC1764.2 +116900 PERFORM DE-LETE. NC1764.2 +117000 ADD-WRITE-F1-28. NC1764.2 +117100 MOVE "ADD-TEST-F1-28 " TO PAR-NAME. NC1764.2 +117200 PERFORM PRINT-DETAIL. NC1764.2 +117300 ADD-TEST-F1-29. NC1764.2 +117400 IF DNAME26 EQUAL TO 21 NC1764.2 +117500 PERFORM PASS NC1764.2 +117600 GO TO ADD-WRITE-F1-29. NC1764.2 +117700 MOVE 21 TO CORRECT-18V0. NC1764.2 +117800 MOVE DNAME26 TO COMPUTED-18V0. NC1764.2 +117900 PERFORM FAIL. NC1764.2 +118000 GO TO ADD-WRITE-F1-29. NC1764.2 +118100 ADD-DELETE-F1-29. NC1764.2 +118200 PERFORM DE-LETE. NC1764.2 +118300 ADD-WRITE-F1-29. NC1764.2 +118400 MOVE "ADD-TEST-F1-29 " TO PAR-NAME. NC1764.2 +118500 PERFORM PRINT-DETAIL. NC1764.2 +118600 ADD-TEST-F1-30. NC1764.2 +118700 IF DNAME27 EQUAL TO 21 NC1764.2 +118800 PERFORM PASS NC1764.2 +118900 GO TO ADD-WRITE-F1-30. NC1764.2 +119000 MOVE 21 TO CORRECT-18V0. NC1764.2 +119100 MOVE DNAME27 TO COMPUTED-18V0. NC1764.2 +119200 PERFORM FAIL. NC1764.2 +119300 GO TO ADD-WRITE-F1-30. NC1764.2 +119400 ADD-DELETE-F1-30. NC1764.2 +119500 PERFORM DE-LETE. NC1764.2 +119600 ADD-WRITE-F1-30. NC1764.2 +119700 MOVE "ADD-TEST-F1-30 " TO PAR-NAME. NC1764.2 +119800 PERFORM PRINT-DETAIL. NC1764.2 +119900 ADD-TEST-F1-31. NC1764.2 +120000 IF DNAME28 EQUAL TO 21 NC1764.2 +120100 PERFORM PASS NC1764.2 +120200 GO TO ADD-WRITE-F1-31. NC1764.2 +120300 MOVE 21 TO CORRECT-18V0. NC1764.2 +120400 MOVE DNAME28 TO COMPUTED-18V0. NC1764.2 +120500 PERFORM FAIL. NC1764.2 +120600 GO TO ADD-WRITE-F1-31. NC1764.2 +120700 ADD-DELETE-F1-31. NC1764.2 +120800 PERFORM DE-LETE. NC1764.2 +120900 ADD-WRITE-F1-31. NC1764.2 +121000 MOVE "ADD-TEST-F1-31 " TO PAR-NAME. NC1764.2 +121100 PERFORM PRINT-DETAIL. NC1764.2 +121200 ADD-TEST-F1-32. NC1764.2 +121300 IF DNAME29 EQUAL TO 21 NC1764.2 +121400 PERFORM PASS NC1764.2 +121500 GO TO ADD-WRITE-F1-32. NC1764.2 +121600 MOVE 21 TO CORRECT-18V0. NC1764.2 +121700 MOVE DNAME29 TO COMPUTED-18V0. NC1764.2 +121800 PERFORM FAIL. NC1764.2 +121900 GO TO ADD-WRITE-F1-32. NC1764.2 +122000 ADD-DELETE-F1-32. NC1764.2 +122100 PERFORM DE-LETE. NC1764.2 +122200 ADD-WRITE-F1-32. NC1764.2 +122300 MOVE "ADD-TEST-F1-32 " TO PAR-NAME. NC1764.2 +122400 PERFORM PRINT-DETAIL. NC1764.2 +122500 ADD-TEST-F1-33. NC1764.2 +122600 IF DNAME30 EQUAL TO 21 NC1764.2 +122700 PERFORM PASS NC1764.2 +122800 GO TO ADD-WRITE-F1-33. NC1764.2 +122900 MOVE 21 TO CORRECT-18V0. NC1764.2 +123000 MOVE DNAME30 TO COMPUTED-18V0. NC1764.2 +123100 PERFORM FAIL. NC1764.2 +123200 GO TO ADD-WRITE-F1-33. NC1764.2 +123300 ADD-DELETE-F1-33. NC1764.2 +123400 PERFORM DE-LETE. NC1764.2 +123500 ADD-WRITE-F1-33. NC1764.2 +123600 MOVE "ADD-TEST-F1-33 " TO PAR-NAME. NC1764.2 +123700 PERFORM PRINT-DETAIL. NC1764.2 +123800 ADD-TEST-F1-34. NC1764.2 +123900 IF DNAME31 EQUAL TO 21 NC1764.2 +124000 PERFORM PASS NC1764.2 +124100 GO TO ADD-WRITE-F1-34. NC1764.2 +124200 MOVE 21 TO CORRECT-18V0. NC1764.2 +124300 MOVE DNAME31 TO COMPUTED-18V0. NC1764.2 +124400 PERFORM FAIL. NC1764.2 +124500 GO TO ADD-WRITE-F1-34. NC1764.2 +124600 ADD-DELETE-F1-34. NC1764.2 +124700 PERFORM DE-LETE. NC1764.2 +124800 ADD-WRITE-F1-34. NC1764.2 +124900 MOVE "ADD-TEST-F1-34 " TO PAR-NAME. NC1764.2 +125000 PERFORM PRINT-DETAIL. NC1764.2 +125100 ADD-TEST-F1-35. NC1764.2 +125200 IF DNAME32 EQUAL TO 21 NC1764.2 +125300 PERFORM PASS NC1764.2 +125400 GO TO ADD-WRITE-F1-35. NC1764.2 +125500 MOVE 21 TO CORRECT-18V0. NC1764.2 +125600 MOVE DNAME32 TO COMPUTED-18V0. NC1764.2 +125700 PERFORM FAIL. NC1764.2 +125800 GO TO ADD-WRITE-F1-35. NC1764.2 +125900 ADD-DELETE-F1-35. NC1764.2 +126000 PERFORM DE-LETE. NC1764.2 +126100 ADD-WRITE-F1-35. NC1764.2 +126200 MOVE "ADD-TEST-F1-35 " TO PAR-NAME. NC1764.2 +126300 PERFORM PRINT-DETAIL. NC1764.2 +126400 ADD-TEST-F1-36. NC1764.2 +126500 IF DNAME33 EQUAL TO 21 NC1764.2 +126600 PERFORM PASS NC1764.2 +126700 GO TO ADD-WRITE-F1-36. NC1764.2 +126800 MOVE 21 TO CORRECT-18V0. NC1764.2 +126900 MOVE DNAME33 TO COMPUTED-18V0. NC1764.2 +127000 PERFORM FAIL. NC1764.2 +127100 GO TO ADD-WRITE-F1-36. NC1764.2 +127200 ADD-DELETE-F1-36. NC1764.2 +127300 PERFORM DE-LETE. NC1764.2 +127400 ADD-WRITE-F1-36. NC1764.2 +127500 MOVE "ADD-TEST-F1-36 " TO PAR-NAME. NC1764.2 +127600 PERFORM PRINT-DETAIL. NC1764.2 +127700 ADD-TEST-F1-37. NC1764.2 +127800 IF DNAME34 EQUAL TO 21 NC1764.2 +127900 PERFORM PASS NC1764.2 +128000 GO TO ADD-WRITE-F1-37. NC1764.2 +128100 MOVE 21 TO CORRECT-18V0. NC1764.2 +128200 MOVE DNAME34 TO COMPUTED-18V0. NC1764.2 +128300 PERFORM FAIL. NC1764.2 +128400 GO TO ADD-WRITE-F1-37. NC1764.2 +128500 ADD-DELETE-F1-37. NC1764.2 +128600 PERFORM DE-LETE. NC1764.2 +128700 ADD-WRITE-F1-37. NC1764.2 +128800 MOVE "ADD-TEST-F1-37 " TO PAR-NAME. NC1764.2 +128900 PERFORM PRINT-DETAIL. NC1764.2 +129000 ADD-TEST-F1-38. NC1764.2 +129100 IF DNAME35 EQUAL TO 21 NC1764.2 +129200 PERFORM PASS NC1764.2 +129300 GO TO ADD-WRITE-F1-38. NC1764.2 +129400 MOVE 21 TO CORRECT-18V0. NC1764.2 +129500 MOVE DNAME35 TO COMPUTED-18V0. NC1764.2 +129600 PERFORM FAIL. NC1764.2 +129700 GO TO ADD-WRITE-F1-38. NC1764.2 +129800 ADD-DELETE-F1-38. NC1764.2 +129900 PERFORM DE-LETE. NC1764.2 +130000 ADD-WRITE-F1-38. NC1764.2 +130100 MOVE "ADD-TEST-F1-38 " TO PAR-NAME. NC1764.2 +130200 PERFORM PRINT-DETAIL. NC1764.2 +130300 ADD-TEST-F1-39. NC1764.2 +130400 IF DNAME36 EQUAL TO 21 NC1764.2 +130500 PERFORM PASS NC1764.2 +130600 GO TO ADD-WRITE-F1-39. NC1764.2 +130700 MOVE 21 TO CORRECT-18V0. NC1764.2 +130800 MOVE DNAME36 TO COMPUTED-18V0. NC1764.2 +130900 PERFORM FAIL. NC1764.2 +131000 GO TO ADD-WRITE-F1-39. NC1764.2 +131100 ADD-DELETE-F1-39. NC1764.2 +131200 PERFORM DE-LETE. NC1764.2 +131300 ADD-WRITE-F1-39. NC1764.2 +131400 MOVE "ADD-TEST-F1-39 " TO PAR-NAME. NC1764.2 +131500 PERFORM PRINT-DETAIL. NC1764.2 +131600 ADD-TEST-F1-40. NC1764.2 +131700 IF DNAME37 EQUAL TO 21 NC1764.2 +131800 PERFORM PASS NC1764.2 +131900 GO TO ADD-WRITE-F1-40. NC1764.2 +132000 MOVE 21 TO CORRECT-18V0. NC1764.2 +132100 MOVE DNAME37 TO COMPUTED-18V0. NC1764.2 +132200 PERFORM FAIL. NC1764.2 +132300 GO TO ADD-WRITE-F1-40. NC1764.2 +132400 ADD-DELETE-F1-40. NC1764.2 +132500 PERFORM DE-LETE. NC1764.2 +132600 ADD-WRITE-F1-40. NC1764.2 +132700 MOVE "ADD-TEST-F1-40 " TO PAR-NAME. NC1764.2 +132800 PERFORM PRINT-DETAIL. NC1764.2 +132900 ADD-TEST-F1-41. NC1764.2 +133000 IF DNAME38 EQUAL TO 21 NC1764.2 +133100 PERFORM PASS NC1764.2 +133200 GO TO ADD-WRITE-F1-41. NC1764.2 +133300 MOVE 21 TO CORRECT-18V0. NC1764.2 +133400 MOVE DNAME38 TO COMPUTED-18V0. NC1764.2 +133500 PERFORM FAIL. NC1764.2 +133600 GO TO ADD-WRITE-F1-41. NC1764.2 +133700 ADD-DELETE-F1-41. NC1764.2 +133800 PERFORM DE-LETE. NC1764.2 +133900 ADD-WRITE-F1-41. NC1764.2 +134000 MOVE "ADD-TEST-F1-41 " TO PAR-NAME. NC1764.2 +134100 PERFORM PRINT-DETAIL. NC1764.2 +134200 ADD-TEST-F1-42. NC1764.2 +134300 IF DNAME39 EQUAL TO 21 NC1764.2 +134400 PERFORM PASS NC1764.2 +134500 GO TO ADD-WRITE-F1-42. NC1764.2 +134600 MOVE 21 TO CORRECT-18V0. NC1764.2 +134700 MOVE DNAME39 TO COMPUTED-18V0. NC1764.2 +134800 PERFORM FAIL. NC1764.2 +134900 GO TO ADD-WRITE-F1-42. NC1764.2 +135000 ADD-DELETE-F1-42. NC1764.2 +135100 PERFORM DE-LETE. NC1764.2 +135200 ADD-WRITE-F1-42. NC1764.2 +135300 MOVE "ADD-TEST-F1-42 " TO PAR-NAME. NC1764.2 +135400 PERFORM PRINT-DETAIL. NC1764.2 +135500 ADD-TEST-F1-43. NC1764.2 +135600 IF DNAME40 EQUAL TO 21 NC1764.2 +135700 PERFORM PASS NC1764.2 +135800 GO TO ADD-WRITE-F1-43. NC1764.2 +135900 MOVE 21 TO CORRECT-18V0. NC1764.2 +136000 MOVE DNAME40 TO COMPUTED-18V0. NC1764.2 +136100 PERFORM FAIL. NC1764.2 +136200 GO TO ADD-WRITE-F1-43. NC1764.2 +136300 ADD-DELETE-F1-43. NC1764.2 +136400 PERFORM DE-LETE. NC1764.2 +136500 ADD-WRITE-F1-43. NC1764.2 +136600 MOVE "ADD-TEST-F1-43 " TO PAR-NAME. NC1764.2 +136700 PERFORM PRINT-DETAIL. NC1764.2 +136800 ADD-TEST-F1-44. NC1764.2 +136900 IF DNAME41 EQUAL TO 21 NC1764.2 +137000 PERFORM PASS NC1764.2 +137100 GO TO ADD-WRITE-F1-44. NC1764.2 +137200 MOVE 21 TO CORRECT-18V0. NC1764.2 +137300 MOVE DNAME41 TO COMPUTED-18V0. NC1764.2 +137400 PERFORM FAIL. NC1764.2 +137500 GO TO ADD-WRITE-F1-44. NC1764.2 +137600 ADD-DELETE-F1-44. NC1764.2 +137700 PERFORM DE-LETE. NC1764.2 +137800 ADD-WRITE-F1-44. NC1764.2 +137900 MOVE "ADD-TEST-F1-44 " TO PAR-NAME. NC1764.2 +138000 PERFORM PRINT-DETAIL. NC1764.2 +138100 ADD-TEST-F1-45. NC1764.2 +138200 IF DNAME42 EQUAL TO 21 NC1764.2 +138300 PERFORM PASS NC1764.2 +138400 GO TO ADD-WRITE-F1-45. NC1764.2 +138500 MOVE 21 TO CORRECT-18V0. NC1764.2 +138600 MOVE DNAME42 TO COMPUTED-18V0. NC1764.2 +138700 PERFORM FAIL. NC1764.2 +138800 GO TO ADD-WRITE-F1-45. NC1764.2 +138900 ADD-DELETE-F1-45. NC1764.2 +139000 PERFORM DE-LETE. NC1764.2 +139100 ADD-WRITE-F1-45. NC1764.2 +139200 MOVE "ADD-TEST-F1-45 " TO PAR-NAME. NC1764.2 +139300 PERFORM PRINT-DETAIL. NC1764.2 +139400* NC1764.2 +139500 ADD-INIT-F1-46. NC1764.2 +139600* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +139700 MOVE "VI-74 6.6.4 GR1" TO ANSI-REFERENCE. NC1764.2 +139800 MOVE "ADD-TEST-F1-46" TO PAR-NAME. NC1764.2 +139900 MOVE "ADD-TO-SERIES" TO FEATURE. NC1764.2 +140000 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +140100 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +140200 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +140300 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +140400 MOVE 1 TO REC-CT. NC1764.2 +140500 ADD-TEST-F1-46-0. NC1764.2 +140600 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +140700 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +140800 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +140900 GO TO ADD-TEST-F1-46-1. NC1764.2 +141000 ADD-DELETE-F1-46. NC1764.2 +141100 PERFORM DE-LETE. NC1764.2 +141200 PERFORM PRINT-DETAIL. NC1764.2 +141300 GO TO ADD-INIT-F1-47. NC1764.2 +141400 ADD-TEST-F1-46-1. NC1764.2 +141500 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +141600 ELSE NC1764.2 +141700 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +141800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +141900 ADD 1 TO REC-CT. NC1764.2 +142000 ADD-TEST-F1-46-2. NC1764.2 +142100 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +142200 ELSE NC1764.2 +142300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +142400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +142500 ADD 1 TO REC-CT. NC1764.2 +142600 ADD-TEST-F1-46-3. NC1764.2 +142700 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +142800 ELSE NC1764.2 +142900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +143000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +143100 ADD 1 TO REC-CT. NC1764.2 +143200 ADD-TEST-F1-46-4. NC1764.2 +143300 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +143400 ELSE NC1764.2 +143500 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +143600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +143700 ADD 1 TO REC-CT. NC1764.2 +143800 ADD-TEST-F1-46-5. NC1764.2 +143900 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +144000 ELSE NC1764.2 +144100 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +144200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +144300 ADD 1 TO REC-CT. NC1764.2 +144400 ADD-TEST-F1-46-6. NC1764.2 +144500 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +144600 ELSE NC1764.2 +144700 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +144800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +144900* NC1764.2 +145000 ADD-INIT-F1-47. NC1764.2 +145100* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +145200* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +145300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +145400 MOVE "ADD-TEST-F1-47" TO PAR-NAME. NC1764.2 +145500 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +145600 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +145700 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +145800 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +145900 MOVE "0" TO WRK-XN-00001. NC1764.2 +146000 MOVE 1 TO REC-CT. NC1764.2 +146100 ADD-TEST-F1-47-0. NC1764.2 +146200 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +146300 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +146400 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +146500 ON SIZE ERROR NC1764.2 +146600 MOVE "1" TO WRK-XN-00001. NC1764.2 +146700 GO TO ADD-TEST-F1-47-1. NC1764.2 +146800 ADD-DELETE-F1-47. NC1764.2 +146900 PERFORM DE-LETE. NC1764.2 +147000 PERFORM PRINT-DETAIL. NC1764.2 +147100 GO TO ADD-INIT-F1-48. NC1764.2 +147200 ADD-TEST-F1-47-1. NC1764.2 +147300 MOVE "ADD-TEST-F1-47-1" TO PAR-NAME. NC1764.2 +147400 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +147500 ELSE NC1764.2 +147600 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +147700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +147800 ADD 1 TO REC-CT. NC1764.2 +147900 ADD-TEST-F1-47-2. NC1764.2 +148000 MOVE "ADD-TEST-F1-47-2" TO PAR-NAME. NC1764.2 +148100 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +148200 ELSE NC1764.2 +148300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +148400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +148500 ADD 1 TO REC-CT. NC1764.2 +148600 ADD-TEST-F1-47-3. NC1764.2 +148700 MOVE "ADD-TEST-F1-47-3" TO PAR-NAME. NC1764.2 +148800 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +148900 ELSE NC1764.2 +149000 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +149100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +149200 ADD 1 TO REC-CT. NC1764.2 +149300 ADD-TEST-F1-47-4. NC1764.2 +149400 MOVE "ADD-TEST-F1-47-4" TO PAR-NAME. NC1764.2 +149500 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +149600 ELSE NC1764.2 +149700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +149800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +149900 ADD 1 TO REC-CT. NC1764.2 +150000 ADD-TEST-F1-47-5. NC1764.2 +150100 MOVE "ADD-TEST-F1-47-5" TO PAR-NAME. NC1764.2 +150200 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +150300 ELSE NC1764.2 +150400 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +150500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +150600 ADD 1 TO REC-CT. NC1764.2 +150700 ADD-TEST-F1-47-6. NC1764.2 +150800 MOVE "ADD-TEST-F1-47-6" TO PAR-NAME. NC1764.2 +150900 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +151000 ELSE NC1764.2 +151100 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +151200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +151300 ADD 1 TO REC-CT. NC1764.2 +151400 ADD-TEST-F1-47-7. NC1764.2 +151500 MOVE "ADD-TEST-F1-47-7" TO PAR-NAME. NC1764.2 +151600 IF WRK-XN-00001 = "0" NC1764.2 +151700 PERFORM PASS NC1764.2 +151800 PERFORM PRINT-DETAIL NC1764.2 +151900 ELSE NC1764.2 +152000 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +152100 TO RE-MARK NC1764.2 +152200 MOVE "0" TO CORRECT-X NC1764.2 +152300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +152400 PERFORM FAIL NC1764.2 +152500 PERFORM PRINT-DETAIL. NC1764.2 +152600* NC1764.2 +152700 ADD-INIT-F1-48. NC1764.2 +152800* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +152900* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +153000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +153100 MOVE "ADD-TEST-F1-48" TO PAR-NAME. NC1764.2 +153200 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +153300 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +153400 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +153500 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +153600 MOVE "0" TO WRK-XN-00001. NC1764.2 +153700 MOVE 1 TO REC-CT. NC1764.2 +153800 ADD-TEST-F1-48-0. NC1764.2 +153900 ADD A17TWOS-DS-17V00 NC1764.2 +154000 WRK-DU-1V1-2 6 NC1764.2 +154100 TO WRK-DU-2V1-1 NC1764.2 +154200 WRK-DU-2V0-1 ROUNDED NC1764.2 +154300 WRK-DU-2V1-2 NC1764.2 +154400 WRK-DU-2V0-2 ROUNDED NC1764.2 +154500 WRK-DU-2V1-3 NC1764.2 +154600 WRK-DU-2V0-3 NC1764.2 +154700 ON SIZE ERROR NC1764.2 +154800 MOVE "1" TO WRK-XN-00001. NC1764.2 +154900 GO TO ADD-TEST-F1-48-1. NC1764.2 +155000 ADD-DELETE-F1-48. NC1764.2 +155100 PERFORM DE-LETE. NC1764.2 +155200 PERFORM PRINT-DETAIL. NC1764.2 +155300 GO TO ADD-INIT-F1-49. NC1764.2 +155400 ADD-TEST-F1-48-1. NC1764.2 +155500 MOVE "ADD-TEST-F1-48-1" TO PAR-NAME. NC1764.2 +155600 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +155700 ELSE NC1764.2 +155800 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +155900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +156000 ADD 1 TO REC-CT. NC1764.2 +156100 ADD-TEST-F1-48-2. NC1764.2 +156200 MOVE "ADD-TEST-F1-48-2" TO PAR-NAME. NC1764.2 +156300 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +156400 ELSE NC1764.2 +156500 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +156600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +156700 ADD 1 TO REC-CT. NC1764.2 +156800 ADD-TEST-F1-48-3. NC1764.2 +156900 MOVE "ADD-TEST-F1-48-3" TO PAR-NAME. NC1764.2 +157000 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +157100 ELSE NC1764.2 +157200 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +157300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +157400 ADD 1 TO REC-CT. NC1764.2 +157500 ADD-TEST-F1-48-4. NC1764.2 +157600 MOVE "ADD-TEST-F1-48-4" TO PAR-NAME. NC1764.2 +157700 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +157800 ELSE NC1764.2 +157900 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +158000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +158100 ADD 1 TO REC-CT. NC1764.2 +158200 ADD-TEST-F1-48-5. NC1764.2 +158300 MOVE "ADD-TEST-F1-48-5" TO PAR-NAME. NC1764.2 +158400 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +158500 ELSE NC1764.2 +158600 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +158700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +158800 ADD 1 TO REC-CT. NC1764.2 +158900 ADD-TEST-F1-48-6. NC1764.2 +159000 MOVE "ADD-TEST-F1-48-6" TO PAR-NAME. NC1764.2 +159100 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +159200 ELSE NC1764.2 +159300 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +159400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +159500 ADD 1 TO REC-CT. NC1764.2 +159600 ADD-TEST-F1-48-7. NC1764.2 +159700 MOVE "ADD-TEST-F1-48-7" TO PAR-NAME. NC1764.2 +159800 IF WRK-XN-00001 = "1" NC1764.2 +159900 PERFORM PASS NC1764.2 +160000 PERFORM PRINT-DETAIL NC1764.2 +160100 ELSE NC1764.2 +160200 MOVE "SIZE ERROR NOT EXECUTED" TO RE-MARK NC1764.2 +160300 MOVE "1" TO CORRECT-X NC1764.2 +160400 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +160500 PERFORM FAIL NC1764.2 +160600 PERFORM PRINT-DETAIL. NC1764.2 +160700* NC1764.2 +160800 ADD-INIT-F1-49. NC1764.2 +160900* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +161000* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +161100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +161200 MOVE "ADD-TEST-F1-49" TO PAR-NAME. NC1764.2 +161300 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +161400 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +161500 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +161600 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +161700 MOVE "0" TO WRK-XN-00001. NC1764.2 +161800 MOVE 1 TO REC-CT. NC1764.2 +161900 ADD-TEST-F1-49-0. NC1764.2 +162000 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +162100 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +162200 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +162300 NOT ON SIZE ERROR NC1764.2 +162400 MOVE "1" TO WRK-XN-00001. NC1764.2 +162500 GO TO ADD-TEST-F1-49-1. NC1764.2 +162600 ADD-DELETE-F1-49. NC1764.2 +162700 PERFORM DE-LETE. NC1764.2 +162800 PERFORM PRINT-DETAIL. NC1764.2 +162900 GO TO ADD-INIT-F1-50. NC1764.2 +163000 ADD-TEST-F1-49-1. NC1764.2 +163100 MOVE "ADD-TEST-F1-49-1" TO PAR-NAME. NC1764.2 +163200 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +163300 ELSE NC1764.2 +163400 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +163500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +163600 ADD 1 TO REC-CT. NC1764.2 +163700 ADD-TEST-F1-49-2. NC1764.2 +163800 MOVE "ADD-TEST-F1-49-2" TO PAR-NAME. NC1764.2 +163900 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +164000 ELSE NC1764.2 +164100 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +164200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +164300 ADD 1 TO REC-CT. NC1764.2 +164400 ADD-TEST-F1-49-3. NC1764.2 +164500 MOVE "ADD-TEST-F1-49-3" TO PAR-NAME. NC1764.2 +164600 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +164700 ELSE NC1764.2 +164800 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +164900 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +165000 ADD 1 TO REC-CT. NC1764.2 +165100 ADD-TEST-F1-49-4. NC1764.2 +165200 MOVE "ADD-TEST-F1-49-4" TO PAR-NAME. NC1764.2 +165300 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +165400 ELSE NC1764.2 +165500 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +165600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +165700 ADD 1 TO REC-CT. NC1764.2 +165800 ADD-TEST-F1-49-5. NC1764.2 +165900 MOVE "ADD-TEST-F1-49-5" TO PAR-NAME. NC1764.2 +166000 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +166100 ELSE NC1764.2 +166200 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +166300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +166400 ADD 1 TO REC-CT. NC1764.2 +166500 ADD-TEST-F1-49-6. NC1764.2 +166600 MOVE "ADD-TEST-F1-49-6" TO PAR-NAME. NC1764.2 +166700 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +166800 ELSE NC1764.2 +166900 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +167000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +167100 ADD 1 TO REC-CT. NC1764.2 +167200 ADD-TEST-F1-49-7. NC1764.2 +167300 MOVE "ADD-TEST-F1-49-7" TO PAR-NAME. NC1764.2 +167400 IF WRK-XN-00001 = "1" NC1764.2 +167500 PERFORM PASS NC1764.2 +167600 PERFORM PRINT-DETAIL NC1764.2 +167700 ELSE NC1764.2 +167800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +167900 TO RE-MARK NC1764.2 +168000 MOVE "1" TO CORRECT-X NC1764.2 +168100 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +168200 PERFORM FAIL NC1764.2 +168300 PERFORM PRINT-DETAIL. NC1764.2 +168400* NC1764.2 +168500 ADD-INIT-F1-50. NC1764.2 +168600* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +168700* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +168800 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +168900 MOVE "ADD-TEST-F1-50" TO PAR-NAME. NC1764.2 +169000 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +169100 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +169200 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +169300 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +169400 MOVE "0" TO WRK-XN-00001. NC1764.2 +169500 MOVE 1 TO REC-CT. NC1764.2 +169600 ADD-TEST-F1-50-0. NC1764.2 +169700 ADD A17TWOS-DS-17V00 NC1764.2 +169800 WRK-DU-1V1-2 6 NC1764.2 +169900 TO WRK-DU-2V1-1 NC1764.2 +170000 WRK-DU-2V0-1 ROUNDED NC1764.2 +170100 WRK-DU-2V1-2 NC1764.2 +170200 WRK-DU-2V0-2 ROUNDED NC1764.2 +170300 WRK-DU-2V1-3 NC1764.2 +170400 WRK-DU-2V0-3 NC1764.2 +170500 NOT ON SIZE ERROR NC1764.2 +170600 MOVE "1" TO WRK-XN-00001. NC1764.2 +170700 GO TO ADD-TEST-F1-50-1. NC1764.2 +170800 ADD-DELETE-F1-50. NC1764.2 +170900 PERFORM DE-LETE. NC1764.2 +171000 PERFORM PRINT-DETAIL. NC1764.2 +171100 GO TO ADD-INIT-F1-51. NC1764.2 +171200 ADD-TEST-F1-50-1. NC1764.2 +171300 MOVE "ADD-TEST-F1-50-1" TO PAR-NAME. NC1764.2 +171400 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +171500 ELSE NC1764.2 +171600 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +171700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +171800 ADD 1 TO REC-CT. NC1764.2 +171900 ADD-TEST-F1-50-2. NC1764.2 +172000 MOVE "ADD-TEST-F1-50-2" TO PAR-NAME. NC1764.2 +172100 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +172200 ELSE NC1764.2 +172300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +172400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +172500 ADD 1 TO REC-CT. NC1764.2 +172600 ADD-TEST-F1-50-3. NC1764.2 +172700 MOVE "ADD-TEST-F1-50-3" TO PAR-NAME. NC1764.2 +172800 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +172900 ELSE NC1764.2 +173000 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +173100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +173200 ADD 1 TO REC-CT. NC1764.2 +173300 ADD-TEST-F1-50-4. NC1764.2 +173400 MOVE "ADD-TEST-F1-50-4" TO PAR-NAME. NC1764.2 +173500 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +173600 ELSE NC1764.2 +173700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +173800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +173900 ADD 1 TO REC-CT. NC1764.2 +174000 ADD-TEST-F1-50-5. NC1764.2 +174100 MOVE "ADD-TEST-F1-50-5" TO PAR-NAME. NC1764.2 +174200 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +174300 ELSE NC1764.2 +174400 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +174500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +174600 ADD 1 TO REC-CT. NC1764.2 +174700 ADD-TEST-F1-50-6. NC1764.2 +174800 MOVE "ADD-TEST-F1-50-6" TO PAR-NAME. NC1764.2 +174900 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +175000 ELSE NC1764.2 +175100 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +175200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +175300 ADD 1 TO REC-CT. NC1764.2 +175400 ADD-TEST-F1-50-7. NC1764.2 +175500 MOVE "ADD-TEST-F1-50-7" TO PAR-NAME. NC1764.2 +175600 IF WRK-XN-00001 = "0" NC1764.2 +175700 PERFORM PASS NC1764.2 +175800 PERFORM PRINT-DETAIL NC1764.2 +175900 ELSE NC1764.2 +176000 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +176100 TO RE-MARK NC1764.2 +176200 MOVE "0" TO CORRECT-X NC1764.2 +176300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +176400 PERFORM FAIL NC1764.2 +176500 PERFORM PRINT-DETAIL. NC1764.2 +176600* NC1764.2 +176700 ADD-INIT-F1-51. NC1764.2 +176800* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +176900* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +177000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +177100 MOVE "ADD-TEST-F1-51" TO PAR-NAME. NC1764.2 +177200 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +177300 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +177400 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +177500 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +177600 MOVE "0" TO WRK-XN-00001. NC1764.2 +177700 MOVE 1 TO REC-CT. NC1764.2 +177800 ADD-TEST-F1-51-0. NC1764.2 +177900 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +178000 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +178100 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +178200 ON SIZE ERROR NC1764.2 +178300 MOVE "1" TO WRK-XN-00001 NC1764.2 +178400 NOT ON SIZE ERROR NC1764.2 +178500 MOVE "2" TO WRK-XN-00001. NC1764.2 +178600 GO TO ADD-TEST-F1-51-1. NC1764.2 +178700 ADD-DELETE-F1-51. NC1764.2 +178800 PERFORM DE-LETE. NC1764.2 +178900 PERFORM PRINT-DETAIL. NC1764.2 +179000 GO TO ADD-INIT-F1-52. NC1764.2 +179100 ADD-TEST-F1-51-1. NC1764.2 +179200 MOVE "ADD-TEST-F1-51-1" TO PAR-NAME. NC1764.2 +179300 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +179400 ELSE NC1764.2 +179500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +179600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +179700 ADD 1 TO REC-CT. NC1764.2 +179800 ADD-TEST-F1-51-2. NC1764.2 +179900 MOVE "ADD-TEST-F1-51-2" TO PAR-NAME. NC1764.2 +180000 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +180100 ELSE NC1764.2 +180200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +180300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +180400 ADD 1 TO REC-CT. NC1764.2 +180500 ADD-TEST-F1-51-3. NC1764.2 +180600 MOVE "ADD-TEST-F1-51-3" TO PAR-NAME. NC1764.2 +180700 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +180800 ELSE NC1764.2 +180900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +181000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +181100 ADD 1 TO REC-CT. NC1764.2 +181200 ADD-TEST-F1-51-4. NC1764.2 +181300 MOVE "ADD-TEST-F1-51-4" TO PAR-NAME. NC1764.2 +181400 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +181500 ELSE NC1764.2 +181600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +181700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +181800 ADD 1 TO REC-CT. NC1764.2 +181900 ADD-TEST-F1-51-5. NC1764.2 +182000 MOVE "ADD-TEST-F1-51-5" TO PAR-NAME. NC1764.2 +182100 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +182200 ELSE NC1764.2 +182300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +182400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +182500 ADD 1 TO REC-CT. NC1764.2 +182600 ADD-TEST-F1-51-6. NC1764.2 +182700 MOVE "ADD-TEST-F1-51-6" TO PAR-NAME. NC1764.2 +182800 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +182900 ELSE NC1764.2 +183000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +183100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +183200 ADD 1 TO REC-CT. NC1764.2 +183300 ADD-TEST-F1-51-7. NC1764.2 +183400 MOVE "ADD-TEST-F1-51-7" TO PAR-NAME. NC1764.2 +183500 IF WRK-XN-00001 = "2" NC1764.2 +183600 PERFORM PASS NC1764.2 +183700 PERFORM PRINT-DETAIL NC1764.2 +183800 ELSE NC1764.2 +183900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +184000 TO RE-MARK NC1764.2 +184100 MOVE "2" TO CORRECT-X NC1764.2 +184200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +184300 PERFORM FAIL NC1764.2 +184400 PERFORM PRINT-DETAIL. NC1764.2 +184500* NC1764.2 +184600 ADD-INIT-F1-52. NC1764.2 +184700* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +184800* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +184900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +185000 MOVE "ADD-TEST-F1-52" TO PAR-NAME. NC1764.2 +185100 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +185200 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +185300 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +185400 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +185500 MOVE "0" TO WRK-XN-00001. NC1764.2 +185600 MOVE 1 TO REC-CT. NC1764.2 +185700 ADD-TEST-F1-52-0. NC1764.2 +185800 ADD A17TWOS-DS-17V00 NC1764.2 +185900 WRK-DU-1V1-2 6 NC1764.2 +186000 TO WRK-DU-2V1-1 NC1764.2 +186100 WRK-DU-2V0-1 ROUNDED NC1764.2 +186200 WRK-DU-2V1-2 NC1764.2 +186300 WRK-DU-2V0-2 ROUNDED NC1764.2 +186400 WRK-DU-2V1-3 NC1764.2 +186500 WRK-DU-2V0-3 NC1764.2 +186600 ON SIZE ERROR NC1764.2 +186700 MOVE "1" TO WRK-XN-00001 NC1764.2 +186800 NOT ON SIZE ERROR NC1764.2 +186900 MOVE "2" TO WRK-XN-00001. NC1764.2 +187000 GO TO ADD-TEST-F1-52-1. NC1764.2 +187100 ADD-DELETE-F1-52. NC1764.2 +187200 PERFORM DE-LETE. NC1764.2 +187300 PERFORM PRINT-DETAIL. NC1764.2 +187400 GO TO ADD-INIT-F1-53. NC1764.2 +187500 ADD-TEST-F1-52-1. NC1764.2 +187600 MOVE "ADD-TEST-F1-52-1" TO PAR-NAME. NC1764.2 +187700 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +187800 ELSE NC1764.2 +187900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +188000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +188100 ADD 1 TO REC-CT. NC1764.2 +188200 ADD-TEST-F1-52-2. NC1764.2 +188300 MOVE "ADD-TEST-F1-52-2" TO PAR-NAME. NC1764.2 +188400 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +188500 ELSE NC1764.2 +188600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +188700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +188800 ADD 1 TO REC-CT. NC1764.2 +188900 ADD-TEST-F1-52-3. NC1764.2 +189000 MOVE "ADD-TEST-F1-52-3" TO PAR-NAME. NC1764.2 +189100 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +189200 ELSE NC1764.2 +189300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +189400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +189500 ADD 1 TO REC-CT. NC1764.2 +189600 ADD-TEST-F1-52-4. NC1764.2 +189700 MOVE "ADD-TEST-F1-52-4" TO PAR-NAME. NC1764.2 +189800 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +189900 ELSE NC1764.2 +190000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +190100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +190200 ADD 1 TO REC-CT. NC1764.2 +190300 ADD-TEST-F1-52-5. NC1764.2 +190400 MOVE "ADD-TEST-F1-52-5" TO PAR-NAME. NC1764.2 +190500 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +190600 ELSE NC1764.2 +190700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +190800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +190900 ADD 1 TO REC-CT. NC1764.2 +191000 ADD-TEST-F1-52-6. NC1764.2 +191100 MOVE "ADD-TEST-F1-52-6" TO PAR-NAME. NC1764.2 +191200 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +191300 ELSE NC1764.2 +191400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +191500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +191600 ADD 1 TO REC-CT. NC1764.2 +191700 ADD-TEST-F1-52-7. NC1764.2 +191800 MOVE "ADD-TEST-F1-52-7" TO PAR-NAME. NC1764.2 +191900 IF WRK-XN-00001 = "1" NC1764.2 +192000 PERFORM PASS NC1764.2 +192100 PERFORM PRINT-DETAIL NC1764.2 +192200 ELSE NC1764.2 +192300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +192400 TO RE-MARK NC1764.2 +192500 MOVE "1" TO CORRECT-X NC1764.2 +192600 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +192700 PERFORM FAIL NC1764.2 +192800 PERFORM PRINT-DETAIL. NC1764.2 +192900* NC1764.2 +193000 ADD-INIT-F1-53. NC1764.2 +193100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +193200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +193300 MOVE "ADD-TEST-F1-53" TO PAR-NAME. NC1764.2 +193400 MOVE SPACE TO WRK-XN-00001. NC1764.2 +193500 MOVE SPACE TO SIZE-ERR2. NC1764.2 +193600 MOVE SPACE TO SIZE-ERR3. NC1764.2 +193700 MOVE SPACE TO SIZE-ERR4. NC1764.2 +193800 MOVE -11 TO WRK-DS-02V00. NC1764.2 +193900 MOVE 1 TO REC-CT. NC1764.2 +194000 ADD-TEST-F1-53-0. NC1764.2 +194100 ADD -99 TO WRK-DS-02V00 NC1764.2 +194200 ON SIZE ERROR NC1764.2 +194300 MOVE "1" TO WRK-XN-00001 NC1764.2 +194400 MOVE "A" TO SIZE-ERR2 NC1764.2 +194500 MOVE "B" TO SIZE-ERR3 NC1764.2 +194600 END-ADD NC1764.2 +194700 MOVE "C" TO SIZE-ERR4. NC1764.2 +194800 GO TO ADD-TEST-F1-53-1. NC1764.2 +194900 ADD-DELETE-F1-53. NC1764.2 +195000 PERFORM DE-LETE. NC1764.2 +195100 PERFORM PRINT-DETAIL. NC1764.2 +195200 GO TO ADD-INIT-F1-54. NC1764.2 +195300 ADD-TEST-F1-53-1. NC1764.2 +195400 MOVE "ADD-TEST-F1-53-1" TO PAR-NAME. NC1764.2 +195500 IF WRK-XN-00001 = "1" NC1764.2 +195600 PERFORM PASS NC1764.2 +195700 PERFORM PRINT-DETAIL NC1764.2 +195800 ELSE NC1764.2 +195900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +196000 TO RE-MARK NC1764.2 +196100 MOVE "1" TO CORRECT-X NC1764.2 +196200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +196300 PERFORM FAIL NC1764.2 +196400 PERFORM PRINT-DETAIL. NC1764.2 +196500 ADD 1 TO REC-CT. NC1764.2 +196600 ADD-TEST-F1-53-2. NC1764.2 +196700 MOVE "ADD-TEST-F1-53-2" TO PAR-NAME. NC1764.2 +196800 IF SIZE-ERR2 = "A" NC1764.2 +196900 PERFORM PASS NC1764.2 +197000 PERFORM PRINT-DETAIL NC1764.2 +197100 ELSE NC1764.2 +197200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +197300 TO RE-MARK NC1764.2 +197400 MOVE "A" TO CORRECT-X NC1764.2 +197500 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +197600 PERFORM FAIL NC1764.2 +197700 PERFORM PRINT-DETAIL. NC1764.2 +197800 ADD 1 TO REC-CT. NC1764.2 +197900 ADD-TEST-F1-53-3. NC1764.2 +198000 MOVE "ADD-TEST-F1-53-3" TO PAR-NAME. NC1764.2 +198100 IF SIZE-ERR3 = "B" NC1764.2 +198200 PERFORM PASS NC1764.2 +198300 PERFORM PRINT-DETAIL NC1764.2 +198400 ELSE NC1764.2 +198500 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +198600 TO RE-MARK NC1764.2 +198700 MOVE "B" TO CORRECT-X NC1764.2 +198800 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +198900 PERFORM FAIL NC1764.2 +199000 PERFORM PRINT-DETAIL. NC1764.2 +199100 ADD 1 TO REC-CT. NC1764.2 +199200 ADD-TEST-F1-53-4. NC1764.2 +199300 MOVE "ADD-TEST-F1-53-4" TO PAR-NAME. NC1764.2 +199400 IF SIZE-ERR4 = "C" NC1764.2 +199500 PERFORM PASS NC1764.2 +199600 PERFORM PRINT-DETAIL NC1764.2 +199700 ELSE NC1764.2 +199800 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +199900 TO RE-MARK NC1764.2 +200000 MOVE "C" TO CORRECT-X NC1764.2 +200100 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +200200 PERFORM FAIL NC1764.2 +200300 PERFORM PRINT-DETAIL. NC1764.2 +200400 ADD 1 TO REC-CT. NC1764.2 +200500 ADD-TEST-F1-53-5. NC1764.2 +200600 MOVE "ADD-TEST-F1-53-5" TO PAR-NAME. NC1764.2 +200700 IF WRK-DS-02V00 = -11 NC1764.2 +200800 PERFORM PASS NC1764.2 +200900 PERFORM PRINT-DETAIL NC1764.2 +201000 ELSE NC1764.2 +201100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +201200 TO RE-MARK NC1764.2 +201300 MOVE -11 TO CORRECT-N NC1764.2 +201400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +201500 PERFORM FAIL NC1764.2 +201600 PERFORM PRINT-DETAIL. NC1764.2 +201700* NC1764.2 +201800 ADD-INIT-F1-54. NC1764.2 +201900* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +202000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +202100 MOVE "ADD-TEST-F1-54" TO PAR-NAME. NC1764.2 +202200 MOVE SPACE TO WRK-XN-00001. NC1764.2 +202300 MOVE SPACE TO SIZE-ERR2. NC1764.2 +202400 MOVE SPACE TO SIZE-ERR3. NC1764.2 +202500 MOVE SPACE TO SIZE-ERR4. NC1764.2 +202600 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +202700 MOVE 1 TO REC-CT. NC1764.2 +202800 ADD-TEST-F1-54-0. NC1764.2 +202900 ADD A12THREES-DS-06V06 NC1764.2 +203000 333333 NC1764.2 +203100 A06THREES-DS-03V03 NC1764.2 +203200 TO WRK-DS-06V06 ROUNDED NC1764.2 +203300 ON SIZE ERROR NC1764.2 +203400 MOVE "1" TO WRK-XN-00001 NC1764.2 +203500 MOVE "A" TO SIZE-ERR2 NC1764.2 +203600 MOVE "B" TO SIZE-ERR3 NC1764.2 +203700 END-ADD NC1764.2 +203800 MOVE "C" TO SIZE-ERR4. NC1764.2 +203900 GO TO ADD-TEST-F1-54-1. NC1764.2 +204000 ADD-DELETE-F1-54. NC1764.2 +204100 PERFORM DE-LETE. NC1764.2 +204200 PERFORM PRINT-DETAIL. NC1764.2 +204300 GO TO ADD-INIT-F1-55. NC1764.2 +204400 ADD-TEST-F1-54-1. NC1764.2 +204500 MOVE "ADD-TEST-F1-54-1" TO PAR-NAME. NC1764.2 +204600 IF WRK-XN-00001 = SPACE NC1764.2 +204700 PERFORM PASS NC1764.2 +204800 PERFORM PRINT-DETAIL NC1764.2 +204900 ELSE NC1764.2 +205000 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +205100 TO RE-MARK NC1764.2 +205200 MOVE SPACE TO CORRECT-X NC1764.2 +205300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +205400 PERFORM FAIL NC1764.2 +205500 PERFORM PRINT-DETAIL. NC1764.2 +205600 ADD 1 TO REC-CT. NC1764.2 +205700 ADD-TEST-F1-54-2. NC1764.2 +205800 MOVE "ADD-TEST-F1-54-2" TO PAR-NAME. NC1764.2 +205900 IF SIZE-ERR2 = SPACE NC1764.2 +206000 PERFORM PASS NC1764.2 +206100 PERFORM PRINT-DETAIL NC1764.2 +206200 ELSE NC1764.2 +206300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +206400 TO RE-MARK NC1764.2 +206500 MOVE SPACE TO CORRECT-X NC1764.2 +206600 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +206700 PERFORM FAIL NC1764.2 +206800 PERFORM PRINT-DETAIL. NC1764.2 +206900 ADD 1 TO REC-CT. NC1764.2 +207000 ADD-TEST-F1-54-3. NC1764.2 +207100 MOVE "ADD-TEST-F1-54-3" TO PAR-NAME. NC1764.2 +207200 IF SIZE-ERR3 = SPACE NC1764.2 +207300 PERFORM PASS NC1764.2 +207400 PERFORM PRINT-DETAIL NC1764.2 +207500 ELSE NC1764.2 +207600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +207700 TO RE-MARK NC1764.2 +207800 MOVE SPACE TO CORRECT-X NC1764.2 +207900 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +208000 PERFORM FAIL NC1764.2 +208100 PERFORM PRINT-DETAIL. NC1764.2 +208200 ADD 1 TO REC-CT. NC1764.2 +208300 ADD-TEST-F1-54-4. NC1764.2 +208400 MOVE "ADD-TEST-F1-54-4" TO PAR-NAME. NC1764.2 +208500 IF SIZE-ERR4 = "C" NC1764.2 +208600 PERFORM PASS NC1764.2 +208700 PERFORM PRINT-DETAIL NC1764.2 +208800 ELSE NC1764.2 +208900 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +209000 TO RE-MARK NC1764.2 +209100 MOVE "C" TO CORRECT-X NC1764.2 +209200 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +209300 PERFORM FAIL NC1764.2 +209400 PERFORM PRINT-DETAIL NC1764.2 +209500 ADD 1 TO REC-CT. NC1764.2 +209600 ADD-TEST-F1-54-5. NC1764.2 +209700 MOVE "ADD-TEST-F1-54-5" TO PAR-NAME. NC1764.2 +209800 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +209900 PERFORM PASS NC1764.2 +210000 PERFORM PRINT-DETAIL NC1764.2 +210100 ELSE NC1764.2 +210200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +210300 TO RE-MARK NC1764.2 +210400 MOVE 666999.666333 TO CORRECT-N NC1764.2 +210500 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +210600 PERFORM FAIL NC1764.2 +210700 PERFORM PRINT-DETAIL. NC1764.2 +210800* NC1764.2 +210900 ADD-INIT-F1-55. NC1764.2 +211000* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +211100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +211200 MOVE "ADD-TEST-F1-55" TO PAR-NAME. NC1764.2 +211300 MOVE SPACE TO WRK-XN-00001. NC1764.2 +211400 MOVE SPACE TO SIZE-ERR2. NC1764.2 +211500 MOVE SPACE TO SIZE-ERR3. NC1764.2 +211600 MOVE SPACE TO SIZE-ERR4. NC1764.2 +211700 MOVE -11 TO WRK-DS-02V00. NC1764.2 +211800 MOVE 1 TO REC-CT. NC1764.2 +211900 ADD-TEST-F1-55-0. NC1764.2 +212000 ADD -99 TO WRK-DS-02V00 NC1764.2 +212100 NOT ON SIZE ERROR NC1764.2 +212200 MOVE "1" TO WRK-XN-00001 NC1764.2 +212300 MOVE "A" TO SIZE-ERR2 NC1764.2 +212400 MOVE "B" TO SIZE-ERR3 NC1764.2 +212500 END-ADD NC1764.2 +212600 MOVE "C" TO SIZE-ERR4. NC1764.2 +212700 GO TO ADD-TEST-F1-55-1. NC1764.2 +212800 ADD-DELETE-F1-55. NC1764.2 +212900 PERFORM DE-LETE. NC1764.2 +213000 PERFORM PRINT-DETAIL. NC1764.2 +213100 GO TO ADD-INIT-F1-56. NC1764.2 +213200 ADD-TEST-F1-55-1. NC1764.2 +213300 MOVE "ADD-TEST-F1-55-1" TO PAR-NAME. NC1764.2 +213400 IF WRK-XN-00001 = SPACE NC1764.2 +213500 PERFORM PASS NC1764.2 +213600 PERFORM PRINT-DETAIL NC1764.2 +213700 ELSE NC1764.2 +213800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +213900 TO RE-MARK NC1764.2 +214000 MOVE SPACE TO CORRECT-X NC1764.2 +214100 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +214200 PERFORM FAIL NC1764.2 +214300 PERFORM PRINT-DETAIL. NC1764.2 +214400 ADD 1 TO REC-CT. NC1764.2 +214500 ADD-TEST-F1-55-2. NC1764.2 +214600 MOVE "ADD-TEST-F1-55-2" TO PAR-NAME. NC1764.2 +214700 IF SIZE-ERR2 = SPACE NC1764.2 +214800 PERFORM PASS NC1764.2 +214900 PERFORM PRINT-DETAIL NC1764.2 +215000 ELSE NC1764.2 +215100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +215200 TO RE-MARK NC1764.2 +215300 MOVE SPACE TO CORRECT-X NC1764.2 +215400 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +215500 PERFORM FAIL NC1764.2 +215600 PERFORM PRINT-DETAIL. NC1764.2 +215700 ADD 1 TO REC-CT. NC1764.2 +215800 ADD-TEST-F1-55-3. NC1764.2 +215900 MOVE "ADD-TEST-F1-55-3" TO PAR-NAME. NC1764.2 +216000 IF SIZE-ERR3 = SPACE NC1764.2 +216100 PERFORM PASS NC1764.2 +216200 PERFORM PRINT-DETAIL NC1764.2 +216300 ELSE NC1764.2 +216400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +216500 TO RE-MARK NC1764.2 +216600 MOVE SPACE TO CORRECT-X NC1764.2 +216700 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +216800 PERFORM FAIL NC1764.2 +216900 PERFORM PRINT-DETAIL. NC1764.2 +217000 ADD 1 TO REC-CT. NC1764.2 +217100 ADD-TEST-F1-55-4. NC1764.2 +217200 MOVE "ADD-TEST-F1-55-4" TO PAR-NAME. NC1764.2 +217300 IF SIZE-ERR4 = "C" NC1764.2 +217400 PERFORM PASS NC1764.2 +217500 PERFORM PRINT-DETAIL NC1764.2 +217600 ELSE NC1764.2 +217700 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +217800 TO RE-MARK NC1764.2 +217900 MOVE "C" TO CORRECT-X NC1764.2 +218000 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +218100 PERFORM FAIL NC1764.2 +218200 PERFORM PRINT-DETAIL. NC1764.2 +218300 ADD 1 TO REC-CT. NC1764.2 +218400 ADD-TEST-F1-55-5. NC1764.2 +218500 MOVE "ADD-TEST-F1-55-5" TO PAR-NAME. NC1764.2 +218600 IF WRK-DS-02V00 = -11 NC1764.2 +218700 PERFORM PASS NC1764.2 +218800 PERFORM PRINT-DETAIL NC1764.2 +218900 ELSE NC1764.2 +219000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +219100 TO RE-MARK NC1764.2 +219200 MOVE -11 TO CORRECT-N NC1764.2 +219300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +219400 PERFORM FAIL NC1764.2 +219500 PERFORM PRINT-DETAIL. NC1764.2 +219600* NC1764.2 +219700 ADD-INIT-F1-56. NC1764.2 +219800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +219900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +220000 MOVE "ADD-TEST-F1-56" TO PAR-NAME. NC1764.2 +220100 MOVE SPACE TO WRK-XN-00001. NC1764.2 +220200 MOVE SPACE TO SIZE-ERR2. NC1764.2 +220300 MOVE SPACE TO SIZE-ERR3. NC1764.2 +220400 MOVE SPACE TO SIZE-ERR4. NC1764.2 +220500 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +220600 MOVE 1 TO REC-CT. NC1764.2 +220700 ADD-TEST-F1-56-0. NC1764.2 +220800 ADD A12THREES-DS-06V06 NC1764.2 +220900 333333 NC1764.2 +221000 A06THREES-DS-03V03 NC1764.2 +221100 TO WRK-DS-06V06 ROUNDED NC1764.2 +221200 NOT ON SIZE ERROR NC1764.2 +221300 MOVE "1" TO WRK-XN-00001 NC1764.2 +221400 MOVE "A" TO SIZE-ERR2 NC1764.2 +221500 MOVE "B" TO SIZE-ERR3 NC1764.2 +221600 END-ADD NC1764.2 +221700 MOVE "C" TO SIZE-ERR4. NC1764.2 +221800 GO TO ADD-TEST-F1-56-1. NC1764.2 +221900 ADD-DELETE-F1-56. NC1764.2 +222000 PERFORM DE-LETE. NC1764.2 +222100 PERFORM PRINT-DETAIL. NC1764.2 +222200 GO TO ADD-INIT-F1-57. NC1764.2 +222300 ADD-TEST-F1-56-1. NC1764.2 +222400 MOVE "ADD-TEST-F1-56-1" TO PAR-NAME. NC1764.2 +222500 IF WRK-XN-00001 = "1" NC1764.2 +222600 PERFORM PASS NC1764.2 +222700 PERFORM PRINT-DETAIL NC1764.2 +222800 ELSE NC1764.2 +222900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +223000 TO RE-MARK NC1764.2 +223100 MOVE "1" TO CORRECT-X NC1764.2 +223200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +223300 PERFORM FAIL NC1764.2 +223400 PERFORM PRINT-DETAIL. NC1764.2 +223500 ADD 1 TO REC-CT. NC1764.2 +223600 ADD-TEST-F1-56-2. NC1764.2 +223700 MOVE "ADD-TEST-F1-56-2" TO PAR-NAME. NC1764.2 +223800 IF SIZE-ERR2 = "A" NC1764.2 +223900 PERFORM PASS NC1764.2 +224000 PERFORM PRINT-DETAIL NC1764.2 +224100 ELSE NC1764.2 +224200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +224300 TO RE-MARK NC1764.2 +224400 MOVE "A" TO CORRECT-X NC1764.2 +224500 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +224600 PERFORM FAIL NC1764.2 +224700 PERFORM PRINT-DETAIL. NC1764.2 +224800 ADD 1 TO REC-CT. NC1764.2 +224900 ADD-TEST-F1-56-3. NC1764.2 +225000 MOVE "ADD-TEST-F1-56-3" TO PAR-NAME. NC1764.2 +225100 IF SIZE-ERR3 = "B" NC1764.2 +225200 PERFORM PASS NC1764.2 +225300 PERFORM PRINT-DETAIL NC1764.2 +225400 ELSE NC1764.2 +225500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +225600 TO RE-MARK NC1764.2 +225700 MOVE "B" TO CORRECT-X NC1764.2 +225800 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +225900 PERFORM FAIL NC1764.2 +226000 PERFORM PRINT-DETAIL. NC1764.2 +226100 ADD 1 TO REC-CT. NC1764.2 +226200 ADD-TEST-F1-56-4. NC1764.2 +226300 MOVE "ADD-TEST-F1-56-4" TO PAR-NAME. NC1764.2 +226400 IF SIZE-ERR4 = "C" NC1764.2 +226500 PERFORM PASS NC1764.2 +226600 PERFORM PRINT-DETAIL NC1764.2 +226700 ELSE NC1764.2 +226800 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +226900 TO RE-MARK NC1764.2 +227000 MOVE "C" TO CORRECT-X NC1764.2 +227100 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +227200 PERFORM FAIL NC1764.2 +227300 PERFORM PRINT-DETAIL. NC1764.2 +227400 ADD 1 TO REC-CT. NC1764.2 +227500 ADD-TEST-F1-56-5. NC1764.2 +227600 MOVE "ADD-TEST-F1-56-5" TO PAR-NAME. NC1764.2 +227700 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +227800 PERFORM PASS NC1764.2 +227900 PERFORM PRINT-DETAIL NC1764.2 +228000 ELSE NC1764.2 +228100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +228200 TO RE-MARK NC1764.2 +228300 MOVE 666999.666333 TO CORRECT-N NC1764.2 +228400 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +228500 PERFORM FAIL NC1764.2 +228600 PERFORM PRINT-DETAIL. NC1764.2 +228700* NC1764.2 +228800 ADD-INIT-F1-57. NC1764.2 +228900* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +229000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +229100 MOVE "ADD-TEST-F1-57" TO PAR-NAME. NC1764.2 +229200 MOVE "0" TO WRK-XN-00001. NC1764.2 +229300 MOVE "0" TO SIZE-ERR2. NC1764.2 +229400 MOVE "0" TO SIZE-ERR3. NC1764.2 +229500 MOVE "0" TO SIZE-ERR4. NC1764.2 +229600 MOVE -11 TO WRK-DS-02V00. NC1764.2 +229700 MOVE 1 TO REC-CT. NC1764.2 +229800 ADD-TEST-F1-57-0. NC1764.2 +229900 ADD -99 TO WRK-DS-02V00 NC1764.2 +230000 ON SIZE ERROR NC1764.2 +230100 MOVE SPACE TO WRK-XN-00001 NC1764.2 +230200 NOT ON SIZE ERROR NC1764.2 +230300 MOVE "1" TO WRK-XN-00001 NC1764.2 +230400 END-ADD NC1764.2 +230500 MOVE "C" TO SIZE-ERR4. NC1764.2 +230600 GO TO ADD-TEST-F1-57-1. NC1764.2 +230700 ADD-DELETE-F1-57. NC1764.2 +230800 PERFORM DE-LETE. NC1764.2 +230900 PERFORM PRINT-DETAIL. NC1764.2 +231000 GO TO ADD-INIT-F1-58. NC1764.2 +231100 ADD-TEST-F1-57-1. NC1764.2 +231200 MOVE "ADD-TEST-F1-57-1" TO PAR-NAME. NC1764.2 +231300 IF WRK-XN-00001 = SPACE NC1764.2 +231400 PERFORM PASS NC1764.2 +231500 PERFORM PRINT-DETAIL NC1764.2 +231600 ELSE NC1764.2 +231700 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +231800 TO RE-MARK NC1764.2 +231900 MOVE SPACE TO CORRECT-X NC1764.2 +232000 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +232100 PERFORM FAIL NC1764.2 +232200 PERFORM PRINT-DETAIL. NC1764.2 +232300 ADD 1 TO REC-CT. NC1764.2 +232400 ADD-TEST-F1-57-2. NC1764.2 +232500 MOVE "ADD-TEST-F1-57-2" TO PAR-NAME. NC1764.2 +232600 IF SIZE-ERR4 = "C" NC1764.2 +232700 PERFORM PASS NC1764.2 +232800 PERFORM PRINT-DETAIL NC1764.2 +232900 ELSE NC1764.2 +233000 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +233100 TO RE-MARK NC1764.2 +233200 MOVE "C" TO CORRECT-X NC1764.2 +233300 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +233400 PERFORM FAIL NC1764.2 +233500 PERFORM PRINT-DETAIL. NC1764.2 +233600 ADD 1 TO REC-CT. NC1764.2 +233700 ADD-TEST-F1-57-3. NC1764.2 +233800 MOVE "ADD-TEST-F1-57-3" TO PAR-NAME. NC1764.2 +233900 IF WRK-DS-02V00 = -11 NC1764.2 +234000 PERFORM PASS NC1764.2 +234100 PERFORM PRINT-DETAIL NC1764.2 +234200 ELSE NC1764.2 +234300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +234400 TO RE-MARK NC1764.2 +234500 MOVE -11 TO CORRECT-N NC1764.2 +234600 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +234700 PERFORM FAIL NC1764.2 +234800 PERFORM PRINT-DETAIL. NC1764.2 +234900* NC1764.2 +235000 ADD-INIT-F1-58. NC1764.2 +235100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +235200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +235300 MOVE "ADD-TEST-F1-58" TO PAR-NAME. NC1764.2 +235400 MOVE SPACE TO WRK-XN-00001. NC1764.2 +235500 MOVE SPACE TO SIZE-ERR2. NC1764.2 +235600 MOVE SPACE TO SIZE-ERR3. NC1764.2 +235700 MOVE SPACE TO SIZE-ERR4. NC1764.2 +235800 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +235900 MOVE 1 TO REC-CT. NC1764.2 +236000 ADD-TEST-F1-58-0. NC1764.2 +236100 ADD A12THREES-DS-06V06 NC1764.2 +236200 333333 NC1764.2 +236300 A06THREES-DS-03V03 NC1764.2 +236400 TO WRK-DS-06V06 ROUNDED NC1764.2 +236500 ON SIZE ERROR NC1764.2 +236600 MOVE "X" TO WRK-XN-00001 NC1764.2 +236700 NOT ON SIZE ERROR NC1764.2 +236800 MOVE "1" TO WRK-XN-00001 NC1764.2 +236900 END-ADD NC1764.2 +237000 MOVE "C" TO SIZE-ERR4. NC1764.2 +237100 GO TO ADD-TEST-F1-58-1. NC1764.2 +237200 ADD-DELETE-F1-58. NC1764.2 +237300 PERFORM DE-LETE. NC1764.2 +237400 PERFORM PRINT-DETAIL. NC1764.2 +237500 GO TO CCVS-EXIT. NC1764.2 +237600 ADD-TEST-F1-58-1. NC1764.2 +237700 MOVE "ADD-TEST-F1-58-1" TO PAR-NAME. NC1764.2 +237800 IF WRK-XN-00001 = "1" NC1764.2 +237900 PERFORM PASS NC1764.2 +238000 PERFORM PRINT-DETAIL NC1764.2 +238100 ELSE NC1764.2 +238200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +238300 TO RE-MARK NC1764.2 +238400 MOVE "1" TO CORRECT-X NC1764.2 +238500 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +238600 PERFORM FAIL NC1764.2 +238700 PERFORM PRINT-DETAIL. NC1764.2 +238800 ADD 1 TO REC-CT. NC1764.2 +238900 ADD-TEST-F1-58-2. NC1764.2 +239000 MOVE "ADD-TEST-F1-58-2" TO PAR-NAME. NC1764.2 +239100 IF SIZE-ERR4 = "C" NC1764.2 +239200 PERFORM PASS NC1764.2 +239300 PERFORM PRINT-DETAIL NC1764.2 +239400 ELSE NC1764.2 +239500 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +239600 TO RE-MARK NC1764.2 +239700 MOVE "C" TO CORRECT-X NC1764.2 +239800 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +239900 PERFORM FAIL NC1764.2 +240000 PERFORM PRINT-DETAIL. NC1764.2 +240100 ADD 1 TO REC-CT. NC1764.2 +240200 ADD-TEST-F1-58-3. NC1764.2 +240300 MOVE "ADD-TEST-F1-58-3" TO PAR-NAME. NC1764.2 +240400 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +240500 PERFORM PASS NC1764.2 +240600 PERFORM PRINT-DETAIL NC1764.2 +240700 ELSE NC1764.2 +240800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +240900 TO RE-MARK NC1764.2 +241000 MOVE 666999.666333 TO CORRECT-N NC1764.2 +241100 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +241200 PERFORM FAIL NC1764.2 +241300 PERFORM PRINT-DETAIL. NC1764.2 +241400* NC1764.2 +241500 CCVS-EXIT SECTION. NC1764.2 +241600 CCVS-999999. NC1764.2 +241700 GO TO CLOSE-FILES. NC1764.2 +*END-OF,NC176A +*HEADER,COBOL,NC177A +000100 IDENTIFICATION DIVISION. NC1774.2 +000200 PROGRAM-ID. NC1774.2 +000300 NC177A. NC1774.2 +000400**************************************************************** NC1774.2 +000500* * NC1774.2 +000600* VALIDATION FOR:- * NC1774.2 +000700* * NC1774.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +000900* * NC1774.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1774.2 +001100* * NC1774.2 +001200**************************************************************** NC1774.2 +001300* * NC1774.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1774.2 +001500* * NC1774.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1774.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1774.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1774.2 +001900* * NC1774.2 +002000**************************************************************** NC1774.2 +002100* NC1774.2 +002200* PROGRAM NC177A TESTS FORMAT 2 OF THE ADD STATEMENT. NC1774.2 +002300* VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1774.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1774.2 +002500* NC1774.2 +002600 ENVIRONMENT DIVISION. NC1774.2 +002700 CONFIGURATION SECTION. NC1774.2 +002800 SOURCE-COMPUTER. NC1774.2 +002900 XXXXX082. NC1774.2 +003000 OBJECT-COMPUTER. NC1774.2 +003100 XXXXX083. NC1774.2 +003200 INPUT-OUTPUT SECTION. NC1774.2 +003300 FILE-CONTROL. NC1774.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1774.2 +003500 XXXXX055. NC1774.2 +003600 DATA DIVISION. NC1774.2 +003700 FILE SECTION. NC1774.2 +003800 FD PRINT-FILE. NC1774.2 +003900 01 PRINT-REC PICTURE X(120). NC1774.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1774.2 +004100 WORKING-STORAGE SECTION. NC1774.2 +004200 77 SIZE-ERR PICTURE X VALUE SPACE. NC1774.2 +004300 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1774.2 +004400 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1774.2 +004500 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1774.2 +004600 77 A17TWOS-DS-17V00 PICTURE S9(17) NC1774.2 +004700 VALUE 22222222222222222. NC1774.2 +004800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1774.2 +004900 VALUE 111111111111111111. NC1774.2 +005000 77 WRK-DS-10V00 PICTURE S9(10). NC1774.2 +005100 77 A10ONES-DS-10V00 PICTURE S9(10) NC1774.2 +005200 VALUE 1111111111. NC1774.2 +005300 77 A05ONES-DS-05V00 PICTURE S9(5) NC1774.2 +005400 VALUE 11111. NC1774.2 +005500 77 A02ONES-DS-02V00 PICTURE S99 NC1774.2 +005600 VALUE 11. NC1774.2 +005700 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1774.2 +005800 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1774.2 +005900 PICTURE S9(18). NC1774.2 +006000 77 A06THREES-DS-03V03 PICTURE S999V999 NC1774.2 +006100 VALUE 333.333. NC1774.2 +006200 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1774.2 +006300 VALUE 333333.333333. NC1774.2 +006400 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1774.2 +006500 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1774.2 +006600 PICTURE S9(12). NC1774.2 +006700 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1774.2 +006800 VALUE .11111. NC1774.2 +006900 77 WRK-DS-05V00 PICTURE S9(5). NC1774.2 +007000 77 WRK-DS-02V00 PICTURE S99. NC1774.2 +007100 77 A12ONES-DS-12V00 PICTURE S9(12) NC1774.2 +007200 VALUE 111111111111. NC1774.2 +007300 77 WRK-DS-03V10 PICTURE S999V9(10). NC1774.2 +007400 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1774.2 +007500 PICTURE S9(13). NC1774.2 +007600 77 A99-DS-02V00 PICTURE S99 NC1774.2 +007700 VALUE 99. NC1774.2 +007800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1774.2 +007900 VALUE 11.1. NC1774.2 +008000 77 A06ONES-DS-03V03 PICTURE S999V999 NC1774.2 +008100 VALUE 111.111. NC1774.2 +008200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1774.2 +008300 VALUE 22.222222. NC1774.2 +008400 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1774.2 +008500 VALUE .000000001. NC1774.2 +008600 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1774.2 +008700 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1774.2 +008800 VALUE 111111111111111111. NC1774.2 +008900 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1774.2 +009000 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1774.2 +009100 VALUE 99. NC1774.2 +009200 77 WRK-DS-0201P PICTURE S99P. NC1774.2 +009300 77 WRK-DS-06V00 PICTURE S9(6). NC1774.2 +009400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1774.2 +009500 VALUE ZERO. NC1774.2 +009600 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1774.2 +009700 VALUE +012345678.876543210. NC1774.2 +009800 77 XDATA-XN-00018 PICTURE X(18) NC1774.2 +009900 VALUE "00ABCDEFGHI 4321 ". NC1774.2 +010000 77 WRK-XN-00018 PICTURE X(18). NC1774.2 +010100 77 WRK-XN-00001 PICTURE X. NC1774.2 +010200 77 ADD-12 PICTURE PP9 VALUE .001. NC1774.2 +010300 77 ADD-13 PICTURE 9PP VALUE 100. NC1774.2 +010400 77 ADD-14 PICTURE 999V999. NC1774.2 +010500 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1774.2 +010600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1774.2 +010700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1774.2 +010800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1774.2 +010900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1774.2 +011000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1774.2 +011100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1774.2 +011200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1774.2 +011300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1774.2 +011400 01 WRK-DU-2V0-1 PIC 99. NC1774.2 +011500 01 WRK-DU-2V0-2 PIC 99. NC1774.2 +011600 01 WRK-DU-2V0-3 PIC 99. NC1774.2 +011700 01 WRK-DU-2V1-1 PIC 99V9. NC1774.2 +011800 01 WRK-DU-2V1-2 PIC 99V9. NC1774.2 +011900 01 WRK-DU-2V1-3 PIC 99V9. NC1774.2 +012000 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1774.2 +012100 COMPUTATIONAL. NC1774.2 +012200 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1774.2 +012300 COMPUTATIONAL. NC1774.2 +012400 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1774.2 +012500 COMPUTATIONAL. NC1774.2 +012600 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1774.2 +012700 COMPUTATIONAL. NC1774.2 +012800 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1774.2 +012900 COMPUTATIONAL. NC1774.2 +013000 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1774.2 +013100 COMPUTATIONAL. NC1774.2 +013200 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1774.2 +013300 COMPUTATIONAL. NC1774.2 +013400 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1774.2 +013500 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1774.2 +013600 COMPUTATIONAL. NC1774.2 +013700 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1774.2 +013800 01 SUBTRACT-DATA. NC1774.2 +013900 02 SUBTR-1 PICTURE 9 VALUE 1. NC1774.2 +014000 02 SUBTR-2 PICTURE S99 VALUE 99. NC1774.2 +014100 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1774.2 +014200 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1774.2 +014300 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1774.2 +014400 02 SUBTR-6 PICTURE 9 VALUE 1. NC1774.2 +014500 02 SUBTR-7 PICTURE S99 VALUE 99. NC1774.2 +014600 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1774.2 +014700 02 SUBTR-10 PICTURE S999 VALUE 100. NC1774.2 +014800 02 SUBTR-11 PICTURE S999V999. NC1774.2 +014900 01 N-3 PICTURE IS 99999. NC1774.2 +015000 01 N-4 PICTURE IS 9(5) NC1774.2 +015100 VALUE IS 52800. NC1774.2 +015200 01 N-5 PICTURE IS S9(9)V99 NC1774.2 +015300 VALUE IS 000000001.00. NC1774.2 +015400 01 N-7 PICTURE IS S9(7)V9(4) NC1774.2 +015500 VALUE IS 0000001.0000. NC1774.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1774.2 +015700 01 N-10 PICTURE IS S99999V NC1774.2 +015800 VALUE IS -00001. NC1774.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1774.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1774.2 +016100 01 N-13 PICTURE IS 9(5) NC1774.2 +016200 VALUE IS 99999. NC1774.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1774.2 +016400 01 N-15 PICTURE IS 9(16). NC1774.2 +016500 01 N-16 PICTURE IS S999999V99 NC1774.2 +016600 VALUE IS 5.90. NC1774.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1774.2 +016800 VALUE IS +3.6. NC1774.2 +016900 01 N-18 PICTURE IS S9(10) NC1774.2 +017000 VALUE IS -5. NC1774.2 +017100 01 N-19 PICTURE IS $9.00. NC1774.2 +017200 01 N-20 PICTURE IS S9(9) NC1774.2 +017300 VALUE IS -999999999. NC1774.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1774.2 +017500 01 N-22 PICTURE IS 999V99 NC1774.2 +017600 VALUE IS 005.55. NC1774.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1774.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1774.2 +017900 01 N-26 PICTURE 9(5). NC1774.2 +018000 01 N-27 PICTURE IS 9999V9 NC1774.2 +018100 VALUE IS 9999.9. NC1774.2 +018200 01 N-28 PICTURE IS $9999.00. NC1774.2 +018300 01 N-40 PICTURE IS 9(7) NC1774.2 +018400 VALUE IS 7777777. NC1774.2 +018500 01 N-41 PICTURE IS 9(7) NC1774.2 +018600 VALUE IS 1111111. NC1774.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1774.2 +018800 01 TRUNC-DATA. NC1774.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1774.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1774.2 +019100 02 N-45 PICTURE S9. NC1774.2 +019200 01 MINUS-NAMES. NC1774.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1774.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1774.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1774.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1774.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1774.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1774.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1774.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1774.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1774.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1774.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1774.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1774.2 +020500 01 TEST-RESULTS. NC1774.2 +020600 02 FILLER PIC X VALUE SPACE. NC1774.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1774.2 +020800 02 FILLER PIC X VALUE SPACE. NC1774.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1774.2 +021000 02 FILLER PIC X VALUE SPACE. NC1774.2 +021100 02 PAR-NAME. NC1774.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1774.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1774.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1774.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1774.2 +021600 02 RE-MARK PIC X(61). NC1774.2 +021700 01 TEST-COMPUTED. NC1774.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1774.2 +021900 02 FILLER PIC X(17) VALUE NC1774.2 +022000 " COMPUTED=". NC1774.2 +022100 02 COMPUTED-X. NC1774.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1774.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1774.2 +022400 PIC -9(9).9(9). NC1774.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1774.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1774.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1774.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1774.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1774.2 +023000 04 FILLER PIC X. NC1774.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1774.2 +023200 01 TEST-CORRECT. NC1774.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1774.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1774.2 +023500 02 CORRECT-X. NC1774.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1774.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1774.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1774.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1774.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1774.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1774.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1774.2 +024300 04 FILLER PIC X. NC1774.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1774.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1774.2 +024600 01 CCVS-C-1. NC1774.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1774.2 +024800- "SS PARAGRAPH-NAME NC1774.2 +024900- " REMARKS". NC1774.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1774.2 +025100 01 CCVS-C-2. NC1774.2 +025200 02 FILLER PIC X VALUE SPACE. NC1774.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1774.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1774.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1774.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1774.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1774.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1774.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1774.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1774.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1774.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1774.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1774.2 +026800 01 CCVS-H-1. NC1774.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1774.2 +027000 02 FILLER PIC X(42) VALUE NC1774.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1774.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1774.2 +027300 01 CCVS-H-2A. NC1774.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1774.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1774.2 +027600 02 FILLER PIC XXXX VALUE NC1774.2 +027700 "4.2 ". NC1774.2 +027800 02 FILLER PIC X(28) VALUE NC1774.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1774.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1774.2 +028100 NC1774.2 +028200 01 CCVS-H-2B. NC1774.2 +028300 02 FILLER PIC X(15) VALUE NC1774.2 +028400 "TEST RESULT OF ". NC1774.2 +028500 02 TEST-ID PIC X(9). NC1774.2 +028600 02 FILLER PIC X(4) VALUE NC1774.2 +028700 " IN ". NC1774.2 +028800 02 FILLER PIC X(12) VALUE NC1774.2 +028900 " HIGH ". NC1774.2 +029000 02 FILLER PIC X(22) VALUE NC1774.2 +029100 " LEVEL VALIDATION FOR ". NC1774.2 +029200 02 FILLER PIC X(58) VALUE NC1774.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +029400 01 CCVS-H-3. NC1774.2 +029500 02 FILLER PIC X(34) VALUE NC1774.2 +029600 " FOR OFFICIAL USE ONLY ". NC1774.2 +029700 02 FILLER PIC X(58) VALUE NC1774.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1774.2 +029900 02 FILLER PIC X(28) VALUE NC1774.2 +030000 " COPYRIGHT 1985 ". NC1774.2 +030100 01 CCVS-E-1. NC1774.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1774.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1774.2 +030400 02 ID-AGAIN PIC X(9). NC1774.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1774.2 +030600 01 CCVS-E-2. NC1774.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1774.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1774.2 +030900 02 CCVS-E-2-2. NC1774.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1774.2 +031100 03 FILLER PIC X VALUE SPACE. NC1774.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1774.2 +031300 "ERRORS ENCOUNTERED". NC1774.2 +031400 01 CCVS-E-3. NC1774.2 +031500 02 FILLER PIC X(22) VALUE NC1774.2 +031600 " FOR OFFICIAL USE ONLY". NC1774.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1774.2 +031800 02 FILLER PIC X(58) VALUE NC1774.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1774.2 +032100 02 FILLER PIC X(15) VALUE NC1774.2 +032200 " COPYRIGHT 1985". NC1774.2 +032300 01 CCVS-E-4. NC1774.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1774.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1774.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1774.2 +032700 02 FILLER PIC X(40) VALUE NC1774.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1774.2 +032900 01 XXINFO. NC1774.2 +033000 02 FILLER PIC X(19) VALUE NC1774.2 +033100 "*** INFORMATION ***". NC1774.2 +033200 02 INFO-TEXT. NC1774.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1774.2 +033400 04 XXCOMPUTED PIC X(20). NC1774.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1774.2 +033600 04 XXCORRECT PIC X(20). NC1774.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1774.2 +033800 01 HYPHEN-LINE. NC1774.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1774.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1774.2 +034100- "*****************************************". NC1774.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1774.2 +034300- "******************************". NC1774.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1774.2 +034500 "NC177A". NC1774.2 +034600 PROCEDURE DIVISION. NC1774.2 +034700 CCVS1 SECTION. NC1774.2 +034800 OPEN-FILES. NC1774.2 +034900 OPEN OUTPUT PRINT-FILE. NC1774.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1774.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1774.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1774.2 +035300 GO TO CCVS1-EXIT. NC1774.2 +035400 CLOSE-FILES. NC1774.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1774.2 +035600 TERMINATE-CCVS. NC1774.2 +035700S EXIT PROGRAM. NC1774.2 +035800STERMINATE-CALL. NC1774.2 +035900 STOP RUN. NC1774.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1774.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1774.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1774.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1774.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1774.2 +036500 PRINT-DETAIL. NC1774.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1774.2 +036700 MOVE "." TO PARDOT-X NC1774.2 +036800 MOVE REC-CT TO DOTVALUE. NC1774.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1774.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1774.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1774.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1774.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1774.2 +037400 MOVE SPACE TO CORRECT-X. NC1774.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1774.2 +037600 MOVE SPACE TO RE-MARK. NC1774.2 +037700 HEAD-ROUTINE. NC1774.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1774.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1774.2 +038200 COLUMN-NAMES-ROUTINE. NC1774.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +038600 END-ROUTINE. NC1774.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1774.2 +038800 END-RTN-EXIT. NC1774.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +039000 END-ROUTINE-1. NC1774.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1774.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1774.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1774.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1774.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1774.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1774.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1774.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1774.2 +039900 END-ROUTINE-12. NC1774.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1774.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1774.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1774.2 +040300 ELSE NC1774.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1774.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1774.2 +040600 PERFORM WRITE-LINE. NC1774.2 +040700 END-ROUTINE-13. NC1774.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1774.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1774.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1774.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1774.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1774.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1774.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1774.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1774.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041900 WRITE-LINE. NC1774.2 +042000 ADD 1 TO RECORD-COUNT. NC1774.2 +042100Y IF RECORD-COUNT GREATER 42 NC1774.2 +042200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC1774.2 +042300Y MOVE SPACE TO DUMMY-RECORD NC1774.2 +042400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1774.2 +042500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1774.2 +042600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1774.2 +042700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1774.2 +042800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1774.2 +042900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC1774.2 +043300Y MOVE ZERO TO RECORD-COUNT. NC1774.2 +043400 PERFORM WRT-LN. NC1774.2 +043500 WRT-LN. NC1774.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1774.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1774.2 +043800 BLANK-LINE-PRINT. NC1774.2 +043900 PERFORM WRT-LN. NC1774.2 +044000 FAIL-ROUTINE. NC1774.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1774.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1774.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1774.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1774.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1774.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1774.2 +044800 GO TO FAIL-ROUTINE-EX. NC1774.2 +044900 FAIL-ROUTINE-WRITE. NC1774.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1774.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1774.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1774.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1774.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1774.2 +045500 BAIL-OUT. NC1774.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1774.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1774.2 +045800 BAIL-OUT-WRITE. NC1774.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1774.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1774.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1774.2 +046300 BAIL-OUT-EX. EXIT. NC1774.2 +046400 CCVS1-EXIT. NC1774.2 +046500 EXIT. NC1774.2 +046600 SECT-NC177A-001 SECTION. NC1774.2 +046700 ADD-INIT-F2-1. NC1774.2 +046800 MOVE "ADD GIVING" TO FEATURE. NC1774.2 +046900 MOVE "VI-74 6.6.4 GR2" TO ANSI-REFERENCE. NC1774.2 +047000 ADD-TEST-F2-1. NC1774.2 +047100 ADD 1 N-14 GIVING N-15. NC1774.2 +047200 IF N-15 EQUAL TO 2 NC1774.2 +047300 PERFORM PASS NC1774.2 +047400 GO TO ADD-WRITE-F2-1. NC1774.2 +047500 GO TO ADD-FAIL-F2-1. NC1774.2 +047600 ADD-DELETE-F2-1. NC1774.2 +047700 PERFORM DE-LETE. NC1774.2 +047800 GO TO ADD-WRITE-F2-1. NC1774.2 +047900 ADD-FAIL-F2-1. NC1774.2 +048000 MOVE N-15 TO COMPUTED-N. NC1774.2 +048100 MOVE 2 TO CORRECT-N. NC1774.2 +048200 PERFORM FAIL. NC1774.2 +048300 ADD-WRITE-F2-1. NC1774.2 +048400 MOVE "ADD-TEST-F2-1 " TO PAR-NAME. NC1774.2 +048500 PERFORM PRINT-DETAIL. NC1774.2 +048600 ADD-TEST-F2-2. NC1774.2 +048700 ADD N-16 N-4 GIVING N-3 ROUNDED. NC1774.2 +048800 IF N-3 EQUAL TO 52806 NC1774.2 +048900 PERFORM PASS NC1774.2 +049000 GO TO ADD-WRITE-F2-2. NC1774.2 +049100 GO TO ADD-FAIL-F2-2. NC1774.2 +049200 ADD-DELETE-F2-2. NC1774.2 +049300 PERFORM DE-LETE. NC1774.2 +049400 GO TO ADD-WRITE-F2-2. NC1774.2 +049500 ADD-FAIL-F2-2. NC1774.2 +049600 MOVE N-3 TO COMPUTED-N. NC1774.2 +049700 MOVE 52806 TO CORRECT-N. NC1774.2 +049800 PERFORM FAIL. NC1774.2 +049900 ADD-WRITE-F2-2. NC1774.2 +050000 MOVE "ADD-TEST-F2-2 " TO PAR-NAME. NC1774.2 +050100 PERFORM PRINT-DETAIL. NC1774.2 +050200 MOVE 52806 TO N-3. NC1774.2 +050300 ADD-TEST-F2-3-1. NC1774.2 +050400 ADD N-13 1 GIVING N-3 ON SIZE ERROR NC1774.2 +050500 PERFORM PASS NC1774.2 +050600 GO TO ADD-WRITE-F2-3-1. NC1774.2 +050700* NOTE WHEN SIZE ERROR CONDITION OCCURS, VALUE OF NC1774.2 +050800* N-3 SHOULD NOT BE CHANGED. NC1774.2 +050900 GO TO ADD-FAIL-F2-3-1. NC1774.2 +051000 ADD-DELETE-F2-3-1. NC1774.2 +051100 PERFORM DE-LETE. NC1774.2 +051200 GO TO ADD-WRITE-F2-3-1. NC1774.2 +051300 ADD-FAIL-F2-3-1. NC1774.2 +051400 MOVE N-3 TO COMPUTED-N. NC1774.2 +051500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +051600 PERFORM FAIL. NC1774.2 +051700 ADD-WRITE-F2-3-1. NC1774.2 +051800 MOVE "ADD-TEST-F2-3-1 " TO PAR-NAME. NC1774.2 +051900 PERFORM PRINT-DETAIL. NC1774.2 +052000 ADD-TEST-F2-3-2. NC1774.2 +052100 IF N-3 NOT = 52806 NC1774.2 +052200 MOVE N-3 TO COMPUTED-N NC1774.2 +052300 MOVE 42806 TO CORRECT-N NC1774.2 +052400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1774.2 +052500 MOVE "ADD-TEST-F2-3-2 " TO PAR-NAME NC1774.2 +052600 PERFORM FAIL NC1774.2 +052700 PERFORM PRINT-DETAIL. NC1774.2 +052800 ADD-TEST-F2-4-1. NC1774.2 +052900 ADD 1.6 N-13 GIVING N-3 ROUNDED ON SIZE ERROR NC1774.2 +053000 PERFORM PASS NC1774.2 +053100 GO TO ADD-WRITE-F2-4-1. NC1774.2 +053200 GO TO ADD-FAIL-F2-4-1. NC1774.2 +053300 ADD-DELETE-F2-4-1. NC1774.2 +053400 PERFORM DE-LETE. NC1774.2 +053500 GO TO ADD-WRITE-F2-4-1. NC1774.2 +053600 ADD-FAIL-F2-4-1. NC1774.2 +053700 MOVE N-3 TO COMPUTED-N. NC1774.2 +053800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +053900 PERFORM FAIL. NC1774.2 +054000 ADD-WRITE-F2-4-1. NC1774.2 +054100 MOVE "ADD-TEST-F2-4-1 " TO PAR-NAME. NC1774.2 +054200 PERFORM PRINT-DETAIL. NC1774.2 +054300 ADD-TEST-F2-4-2. NC1774.2 +054400 IF N-3 EQUAL TO 52806 NC1774.2 +054500 PERFORM PASS NC1774.2 +054600 GO TO ADD-WRITE-F2-4-2. NC1774.2 +054700 GO TO ADD-FAIL-F2-4-2. NC1774.2 +054800 ADD-DELETE-F2-4-2. NC1774.2 +054900 PERFORM DE-LETE. NC1774.2 +055000 GO TO ADD-WRITE-F2-4-2. NC1774.2 +055100 ADD-FAIL-F2-4-2. NC1774.2 +055200 MOVE N-3 TO COMPUTED-N. NC1774.2 +055300 MOVE 52806 TO CORRECT-N. NC1774.2 +055400 PERFORM FAIL. NC1774.2 +055500 ADD-WRITE-F2-4-2. NC1774.2 +055600 MOVE "ADD-TEST-F2-4-2" TO PAR-NAME. NC1774.2 +055700 PERFORM PRINT-DETAIL. NC1774.2 +055800 ADD-INIT-F2-5. NC1774.2 +055900 MOVE " GIVING" TO FEATURE. NC1774.2 +056000 ADD-TEST-F2-5. NC1774.2 +056100 MOVE ZERO TO WRK-DS-09V09. NC1774.2 +056200 ADD A06THREES-DS-03V03 NC1774.2 +056300 A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1774.2 +056400 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1774.2 +056500 PERFORM PASS GO TO ADD-WRITE-F2-5. NC1774.2 +056600 GO TO ADD-FAIL-F2-5. NC1774.2 +056700 ADD-DELETE-F2-5. NC1774.2 +056800 PERFORM DE-LETE. NC1774.2 +056900 GO TO ADD-WRITE-F2-5. NC1774.2 +057000 ADD-FAIL-F2-5. NC1774.2 +057100 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1774.2 +057200 MOVE 000333666.666333000 TO CORRECT-N. NC1774.2 +057300 PERFORM FAIL. NC1774.2 +057400 ADD-WRITE-F2-5. NC1774.2 +057500 MOVE "ADD-TEST-F2-5" TO PAR-NAME. NC1774.2 +057600 PERFORM PRINT-DETAIL. NC1774.2 +057700 ADD-TEST-F2-6. NC1774.2 +057800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +057900 ADD A05ONES-DS-05V00 NC1774.2 +058000 A05ONES-DS-00V05 NC1774.2 +058100 A12THREES-DS-06V06 NC1774.2 +058200 A06THREES-DS-03V03 GIVING WRK-DS-06V06. NC1774.2 +058300 IF WRK-DS-06V06 EQUAL TO 344777.777443 NC1774.2 +058400 PERFORM PASS GO TO ADD-WRITE-F2-6. NC1774.2 +058500 GO TO ADD-FAIL-F2-6. NC1774.2 +058600 ADD-DELETE-F2-6. NC1774.2 +058700 PERFORM DE-LETE. NC1774.2 +058800 GO TO ADD-WRITE-F2-6. NC1774.2 +058900 ADD-FAIL-F2-6. NC1774.2 +059000 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +059100 MOVE 344777.777443 TO CORRECT-N. NC1774.2 +059200 PERFORM FAIL. NC1774.2 +059300 ADD-WRITE-F2-6. NC1774.2 +059400 MOVE "ADD-TEST-F2-6" TO PAR-NAME. NC1774.2 +059500 PERFORM PRINT-DETAIL. NC1774.2 +059600 ADD-TEST-F2-7. NC1774.2 +059700 MOVE ZERO TO WRK-DS-06V00. NC1774.2 +059800 ADD A05ONES-DS-00V05 NC1774.2 +059900 A12THREES-DS-06V06 NC1774.2 +060000 A05ONES-DS-00V05 GIVING WRK-DS-06V00 ROUNDED. NC1774.2 +060100 IF WRK-DS-06V00 EQUAL TO 333334 NC1774.2 +060200 PERFORM PASS GO TO ADD-WRITE-F2-7. NC1774.2 +060300 GO TO ADD-FAIL-F2-7. NC1774.2 +060400 ADD-DELETE-F2-7. NC1774.2 +060500 PERFORM DE-LETE. NC1774.2 +060600 GO TO ADD-WRITE-F2-7. NC1774.2 +060700 ADD-FAIL-F2-7. NC1774.2 +060800 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1774.2 +060900 MOVE 333334 TO CORRECT-N. NC1774.2 +061000 PERFORM FAIL. NC1774.2 +061100 ADD-WRITE-F2-7. NC1774.2 +061200 MOVE "ADD-TEST-F2-7" TO PAR-NAME. NC1774.2 +061300 PERFORM PRINT-DETAIL. NC1774.2 +061400 ADD-INIT-F2-8-1. NC1774.2 +061500 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +061600 ADD-TEST-F2-8-1. NC1774.2 +061700 ADD A12ONES-DS-12V00 NC1774.2 +061800 ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1774.2 +061900 PERFORM PASS GO TO ADD-WRITE-F2-8-1. NC1774.2 +062000 GO TO ADD-FAIL-F2-8-1. NC1774.2 +062100 ADD-DELETE-F2-8-1. NC1774.2 +062200 PERFORM DE-LETE. NC1774.2 +062300 GO TO ADD-WRITE-F2-8-1. NC1774.2 +062400 ADD-FAIL-F2-8-1. NC1774.2 +062500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +062600 PERFORM FAIL. NC1774.2 +062700 ADD-WRITE-F2-8-1. NC1774.2 +062800 MOVE "ADD-TEST-F2-8-1" TO PAR-NAME. NC1774.2 +062900 PERFORM PRINT-DETAIL. NC1774.2 +063000 ADD-TEST-F2-8-2. NC1774.2 +063100 IF WRK-DS-10V00 EQUAL TO ZERO NC1774.2 +063200 PERFORM PASS GO TO ADD-WRITE-F2-8-2. NC1774.2 +063300* NOTE THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-8-1NC1774.2 +063400 GO TO ADD-FAIL-F2-8-2. NC1774.2 +063500 ADD-DELETE-F2-8-2. NC1774.2 +063600 PERFORM DE-LETE. NC1774.2 +063700 GO TO ADD-WRITE-F2-8-2. NC1774.2 +063800 ADD-FAIL-F2-8-2. NC1774.2 +063900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1774.2 +064000 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1774.2 +064100 MOVE ZERO TO CORRECT-14V4. NC1774.2 +064200 PERFORM FAIL. NC1774.2 +064300 ADD-WRITE-F2-8-2. NC1774.2 +064400 MOVE "ADD-TEST-F2-8-2" TO PAR-NAME. NC1774.2 +064500 PERFORM PRINT-DETAIL. NC1774.2 +064600 ADD-TEST-F2-9-1. NC1774.2 +064700 MOVE ZERO TO WRK-DS-05V00 NC1774.2 +064800 ADD 33333 NC1774.2 +064900 A06THREES-DS-03V03 NC1774.2 +065000 A12THREES-DS-06V06 NC1774.2 +065100 GIVING WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1774.2 +065200 PERFORM PASS GO TO ADD-WRITE-F2-9-1. NC1774.2 +065300 GO TO ADD-FAIL-F2-9-1. NC1774.2 +065400 ADD-DELETE-F2-9-1. NC1774.2 +065500 PERFORM DE-LETE. NC1774.2 +065600 GO TO ADD-WRITE-F2-9-1. NC1774.2 +065700 ADD-FAIL-F2-9-1. NC1774.2 +065800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +065900 PERFORM FAIL. NC1774.2 +066000 ADD-WRITE-F2-9-1. NC1774.2 +066100 MOVE "ADD-TEST-F2-9-1" TO PAR-NAME. NC1774.2 +066200 PERFORM PRINT-DETAIL. NC1774.2 +066300 ADD-TEST-F2-9-2. NC1774.2 +066400 IF WRK-DS-05V00 EQUAL TO ZERO NC1774.2 +066500 PERFORM PASS GO TO ADD-WRITE-F2-9-2. NC1774.2 +066600 GO TO ADD-FAIL-F2-9-2. NC1774.2 +066700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-9-1 NC1774.2 +066800 ADD-DELETE-F2-9-2. NC1774.2 +066900 PERFORM DE-LETE. NC1774.2 +067000 GO TO ADD-WRITE-F2-9-2. NC1774.2 +067100 ADD-FAIL-F2-9-2. NC1774.2 +067200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1774.2 +067300 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1774.2 +067400 MOVE ZERO TO CORRECT-N. NC1774.2 +067500 PERFORM FAIL. NC1774.2 +067600 ADD-WRITE-F2-9-2. NC1774.2 +067700 MOVE "ADD-TEST-F2-9-2" TO PAR-NAME. NC1774.2 +067800 PERFORM PRINT-DETAIL. NC1774.2 +067900 ADD-INIT-F2-10. NC1774.2 +068000 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +068100 ADD-TEST-F2-10-1. NC1774.2 +068200 ADD A12THREES-DS-06V06 NC1774.2 +068300 333333 NC1774.2 +068400 A06THREES-DS-03V03 NC1774.2 +068500 GIVING WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1774.2 +068600 GO TO ADD-FAIL-F2-10-1. NC1774.2 +068700 PERFORM PASS. NC1774.2 +068800 GO TO ADD-WRITE-F2-10-1. NC1774.2 +068900 ADD-DELETE-F2-10-1. NC1774.2 +069000 PERFORM DE-LETE. NC1774.2 +069100 GO TO ADD-WRITE-F2-10-1. NC1774.2 +069200 ADD-FAIL-F2-10-1. NC1774.2 +069300 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1774.2 +069400 PERFORM FAIL. NC1774.2 +069500 ADD-WRITE-F2-10-1. NC1774.2 +069600 MOVE "ADD-TEST-F2-10-1" TO PAR-NAME. NC1774.2 +069700 PERFORM PRINT-DETAIL. NC1774.2 +069800 ADD-TEST-F2-10-2. NC1774.2 +069900 IF WRK-DS-06V06 EQUAL TO 666999.666333 NC1774.2 +070000 PERFORM PASS GO TO ADD-WRITE-F2-10-2. NC1774.2 +070100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-10-1 NC1774.2 +070200 GO TO ADD-FAIL-F2-10-2. NC1774.2 +070300 ADD-DELETE-F2-10-2. NC1774.2 +070400 PERFORM DE-LETE. NC1774.2 +070500 GO TO ADD-WRITE-F2-10-2. NC1774.2 +070600 ADD-FAIL-F2-10-2. NC1774.2 +070700 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +070800 MOVE 666999.666333 TO CORRECT-N. NC1774.2 +070900 PERFORM FAIL. NC1774.2 +071000 ADD-WRITE-F2-10-2. NC1774.2 +071100 MOVE "ADD-TEST-F2-10-2" TO PAR-NAME. NC1774.2 +071200 PERFORM PRINT-DETAIL. NC1774.2 +071300 ADD-INIT-F2-11. NC1774.2 +071400 MOVE " SERIES" TO FEATURE. NC1774.2 +071500 ADD-TEST-F2-11. NC1774.2 +071600 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +071700 ADD A99-DS-02V00 NC1774.2 +071800 A03ONES-DS-02V01 NC1774.2 +071900 A06ONES-DS-03V03 NC1774.2 +072000 A08TWOS-DS-02V06 NC1774.2 +072100 -1.1111111 NC1774.2 +072200 +.11111111 NC1774.2 +072300 A01ONE-DS-P0801 GIVING WRK-DS-03V10. NC1774.2 +072400 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +072500 PERFORM PASS GO TO ADD-WRITE-F2-11. NC1774.2 +072600 GO TO ADD-FAIL-F2-11. NC1774.2 +072700 ADD-DELETE-F2-11. NC1774.2 +072800 PERFORM DE-LETE. NC1774.2 +072900 GO TO ADD-WRITE-F2-11. NC1774.2 +073000 ADD-FAIL-F2-11. NC1774.2 +073100 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +073200 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +073300 PERFORM FAIL. NC1774.2 +073400 ADD-WRITE-F2-11. NC1774.2 +073500 MOVE "ADD-TEST-F2-11" TO PAR-NAME. NC1774.2 +073600 PERFORM PRINT-DETAIL. NC1774.2 +073700 ADD-TEST-F2-12. NC1774.2 +073800 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +073900 ADD A01ONE-DS-P0801 NC1774.2 +074000 +.11111111 NC1774.2 +074100 -1.1111111 NC1774.2 +074200 A08TWOS-DS-02V06 NC1774.2 +074300 A06ONES-DS-03V03 NC1774.2 +074400 A03ONES-DS-02V01 NC1774.2 +074500 A99-DS-02V00 GIVING WRK-DS-03V10. NC1774.2 +074600 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +074700 PERFORM PASS GO TO ADD-WRITE-F2-12. NC1774.2 +074800 GO TO ADD-FAIL-F2-12. NC1774.2 +074900 ADD-DELETE-F2-12. NC1774.2 +075000 PERFORM DE-LETE. NC1774.2 +075100 GO TO ADD-WRITE-F2-12. NC1774.2 +075200 ADD-FAIL-F2-12. NC1774.2 +075300 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +075400 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +075500 PERFORM FAIL. NC1774.2 +075600 ADD-WRITE-F2-12. NC1774.2 +075700 MOVE "ADD-TEST-F2-12" TO PAR-NAME. NC1774.2 +075800 PERFORM PRINT-DETAIL. NC1774.2 +075900 ADD-TEST-F2-13. NC1774.2 +076000 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +076100 ADD A08TWOS-DS-02V06 NC1774.2 +076200 A99-DS-02V00 NC1774.2 +076300 -1.1111111 NC1774.2 +076400 A03ONES-DS-02V01 NC1774.2 +076500 A01ONE-DS-P0801 NC1774.2 +076600 +.11111111 NC1774.2 +076700 A06ONES-DS-03V03 GIVING WRK-DS-03V10. NC1774.2 +076800 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +076900 PERFORM PASS GO TO ADD-WRITE-F2-13. NC1774.2 +077000 GO TO ADD-FAIL-F2-13. NC1774.2 +077100 ADD-DELETE-F2-13. NC1774.2 +077200 PERFORM DE-LETE. NC1774.2 +077300 GO TO ADD-WRITE-F2-13. NC1774.2 +077400 ADD-FAIL-F2-13. NC1774.2 +077500 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +077600 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +077700 PERFORM FAIL. NC1774.2 +077800 ADD-WRITE-F2-13. NC1774.2 +077900 MOVE "ADD-TEST-F2-13" TO PAR-NAME. NC1774.2 +078000 PERFORM PRINT-DETAIL. NC1774.2 +078100 ADD-TEST-F2-14. NC1774.2 +078200 ADD ADD-12 ADD-13 GIVING ADD-14. NC1774.2 +078300 IF ADD-14 EQUAL TO 100.001 NC1774.2 +078400 PERFORM PASS GO TO ADD-WRITE-F2-14. NC1774.2 +078500 GO TO ADD-FAIL-F2-14. NC1774.2 +078600 ADD-DELETE-F2-14. NC1774.2 +078700 PERFORM DE-LETE. NC1774.2 +078800 GO TO ADD-WRITE-F2-14. NC1774.2 +078900 ADD-FAIL-F2-14. NC1774.2 +079000 MOVE ADD-14 TO COMPUTED-N. NC1774.2 +079100 MOVE 100.001 TO CORRECT-N. NC1774.2 +079200 PERFORM FAIL. NC1774.2 +079300 ADD-WRITE-F2-14. NC1774.2 +079400 MOVE "ADD-TEST-F2-14" TO PAR-NAME. NC1774.2 +079500 PERFORM PRINT-DETAIL. NC1774.2 +079600 ADD-TEST-F2-15-1. NC1774.2 +079700 MOVE SPACE TO SIZE-ERR. NC1774.2 +079800 ADD MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1774.2 +079900 PLUS-NAME2 EVEN-NAME1 35 GIVING WHOLE-FIELD NC1774.2 +080000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1774.2 +080100 IF WHOLE-FIELD EQUAL TO +1 NC1774.2 +080200 PERFORM PASS NC1774.2 +080300 GO TO ADD-WRITE-F2-15-1. NC1774.2 +080400 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1774.2 +080500 MOVE +1 TO CORRECT-18V0. NC1774.2 +080600 PERFORM FAIL. NC1774.2 +080700 GO TO ADD-WRITE-F2-15-1. NC1774.2 +080800 ADD-DELETE-F2-15-1. NC1774.2 +080900 PERFORM DE-LETE. NC1774.2 +081000 ADD-WRITE-F2-15-1. NC1774.2 +081100 MOVE "ADD-TEST-F2-15-1" TO PAR-NAME. NC1774.2 +081200 PERFORM PRINT-DETAIL. NC1774.2 +081300 ADD-TEST-F2-15-2. NC1774.2 +081400 IF SIZE-ERR EQUAL TO "1" NC1774.2 +081500 PERFORM FAIL NC1774.2 +081600 MOVE SPACE TO CORRECT-A NC1774.2 +081700 MOVE 1 TO COMPUTED-A NC1774.2 +081800 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1774.2 +081900 GO TO ADD-WRITE-F2-15-2. NC1774.2 +082000 PERFORM PASS. NC1774.2 +082100 GO TO ADD-WRITE-F2-15-2. NC1774.2 +082200 ADD-DELETE-F2-15-2. NC1774.2 +082300 PERFORM DE-LETE. NC1774.2 +082400 ADD-WRITE-F2-15-2. NC1774.2 +082500 MOVE "ADD-TEST-F2-15-2" TO PAR-NAME. NC1774.2 +082600 PERFORM PRINT-DETAIL. NC1774.2 +082700 ADD-TEST-F2-16-1. NC1774.2 +082800 MOVE SPACE TO SIZE-ERR. NC1774.2 +082900 ADD MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1774.2 +083000 PLUS-NAME4 EVEN-NAME2 .35 GIVING DECMAL-FIELD NC1774.2 +083100 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1774.2 +083200 IF DECMAL-FIELD EQUAL TO +.1 NC1774.2 +083300 PERFORM PASS NC1774.2 +083400 GO TO ADD-WRITE-F2-16-1. NC1774.2 +083500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1774.2 +083600 MOVE +.1 TO CORRECT-0V18. NC1774.2 +083700 PERFORM FAIL. NC1774.2 +083800 GO TO ADD-WRITE-F2-16-1. NC1774.2 +083900 ADD-DELETE-F2-16-1. NC1774.2 +084000 PERFORM DE-LETE. NC1774.2 +084100 ADD-WRITE-F2-16-1. NC1774.2 +084200 MOVE "ADD-TEST-F2-16-1" TO PAR-NAME. NC1774.2 +084300 PERFORM PRINT-DETAIL. NC1774.2 +084400 ADD-TEST-F2-16-2. NC1774.2 +084500 IF SIZE-ERR EQUAL TO "1" NC1774.2 +084600 PERFORM FAIL NC1774.2 +084700 MOVE SPACE TO CORRECT-A NC1774.2 +084800 MOVE 1 TO COMPUTED-A NC1774.2 +084900 MOVE "SIZE ERROR PRECEDING TEST " TO RE-MARK NC1774.2 +085000 GO TO ADD-WRITE-F2-16-2. NC1774.2 +085100 PERFORM PASS. NC1774.2 +085200 GO TO ADD-WRITE-F2-16-2. NC1774.2 +085300 ADD-DELETE-F2-16-2. NC1774.2 +085400 PERFORM DE-LETE. NC1774.2 +085500 ADD-WRITE-F2-16-2. NC1774.2 +085600 MOVE "ADD-TEST-F2-16-2" TO PAR-NAME. NC1774.2 +085700 PERFORM PRINT-DETAIL. NC1774.2 +085800 ADD-TEST-F2-17. NC1774.2 +085900 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +086000 ADD A18ONES-CS-18V00 A18ONES-DS-18V00 GIVING WRK-CS-18V00. NC1774.2 +086100 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1774.2 +086200 PERFORM PASS NC1774.2 +086300 GO TO ADD-WRITE-F2-17. NC1774.2 +086400 MOVE 222222222222222222 TO CORRECT-18V0. NC1774.2 +086500 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +086600 PERFORM FAIL. NC1774.2 +086700 GO TO ADD-WRITE-F2-17. NC1774.2 +086800 ADD-DELETE-F2-17. NC1774.2 +086900 PERFORM DE-LETE. NC1774.2 +087000 ADD-WRITE-F2-17. NC1774.2 +087100 MOVE "ADD-TEST-F2-17 " TO PAR-NAME. NC1774.2 +087200 PERFORM PRINT-DETAIL. NC1774.2 +087300 ADD-TEST-F2-18. NC1774.2 +087400 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +087500 ADD A18FIVES-CS-18V00 A18SIXES-CS-18V00 GIVING NC1774.2 +087600 WRK-CS-18V00. NC1774.2 +087700 IF WRK-CS-18V00 EQUAL TO 111111111111111111 NC1774.2 +087800 PERFORM PASS NC1774.2 +087900 GO TO ADD-WRITE-F2-18. NC1774.2 +088000 MOVE 111111111111111111 TO CORRECT-18V0. NC1774.2 +088100 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +088200 PERFORM FAIL. NC1774.2 +088300 GO TO ADD-WRITE-F2-18. NC1774.2 +088400 ADD-DELETE-F2-18. NC1774.2 +088500 PERFORM DE-LETE. NC1774.2 +088600 ADD-WRITE-F2-18. NC1774.2 +088700 MOVE "ADD-TEST-F2-18 " TO PAR-NAME. NC1774.2 +088800 PERFORM PRINT-DETAIL. NC1774.2 +088900 ADD-TEST-F2-19. NC1774.2 +089000 MOVE ZERO TO WRK-DS-18V00. NC1774.2 +089100 ADD A18SIXES-CS-18V00 A12SEVENS-CU-18V00 GIVING NC1774.2 +089200 WRK-DS-18V00. NC1774.2 +089300 IF WRK-DS-18V00 EQUAL TO 666667444444444443 NC1774.2 +089400 PERFORM PASS NC1774.2 +089500 GO TO ADD-WRITE-F2-19. NC1774.2 +089600 MOVE 666667444444444443 TO CORRECT-18V0. NC1774.2 +089700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1774.2 +089800 PERFORM FAIL. NC1774.2 +089900 GO TO ADD-WRITE-F2-19. NC1774.2 +090000 ADD-DELETE-F2-19. NC1774.2 +090100 PERFORM DE-LETE. NC1774.2 +090200 ADD-WRITE-F2-19. NC1774.2 +090300 MOVE "ADD-TEST-F2-19 " TO PAR-NAME. NC1774.2 +090400 PERFORM PRINT-DETAIL. NC1774.2 +090500 ADD-TEST-F2-20. NC1774.2 +090600 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +090700 ADD A14TWOS-CS-18V00 A12THREES-CU-18V00 GIVING NC1774.2 +090800 WRK-CS-18V00 ROUNDED. NC1774.2 +090900 IF WRK-CS-18V00 EQUAL TO -000021888888888889 NC1774.2 +091000 PERFORM PASS NC1774.2 +091100 GO TO ADD-WRITE-F2-20. NC1774.2 +091200 MOVE -000021888888888889 TO CORRECT-18V0. NC1774.2 +091300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +091400 PERFORM FAIL. NC1774.2 +091500 GO TO ADD-WRITE-F2-20. NC1774.2 +091600 ADD-DELETE-F2-20. NC1774.2 +091700 PERFORM DE-LETE. NC1774.2 +091800 ADD-WRITE-F2-20. NC1774.2 +091900 MOVE "ADD-TEST-F2-20 " TO PAR-NAME. NC1774.2 +092000 PERFORM PRINT-DETAIL. NC1774.2 +092100 ADD-TEST-F2-21. NC1774.2 +092200 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +092300 ADD A14TWOS-CS-18V00 A14TWOS-CS-18V00 NC1774.2 +092400 GIVING WRK-CS-18V00. NC1774.2 +092500 IF WRK-CS-18V00 EQUAL TO -000044444444444444 NC1774.2 +092600 PERFORM PASS NC1774.2 +092700 GO TO ADD-WRITE-F2-21. NC1774.2 +092800 MOVE -000044444444444444 TO CORRECT-18V0. NC1774.2 +092900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +093000 PERFORM FAIL. NC1774.2 +093100 GO TO ADD-WRITE-F2-21. NC1774.2 +093200 ADD-DELETE-F2-21. NC1774.2 +093300 PERFORM DE-LETE. NC1774.2 +093400 ADD-WRITE-F2-21. NC1774.2 +093500 MOVE "ADD-TEST-F2-21 " TO PAR-NAME. NC1774.2 +093600 PERFORM PRINT-DETAIL. NC1774.2 +093700 ADD-TEST-F2-22. NC1774.2 +093800 MOVE ZERO TO WRK-DU-18V00. NC1774.2 +093900 ADD A14TWOS-CS-18V00 A18FIVES-CS-18V00 GIVING NC1774.2 +094000 WRK-DU-18V00. NC1774.2 +094100 IF WRK-DU-18V00 EQUAL TO 555577777777777777 NC1774.2 +094200 PERFORM PASS NC1774.2 +094300 GO TO ADD-WRITE-F2-22. NC1774.2 +094400 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1774.2 +094500 MOVE 555577777777777777 TO CORRECT-18V0. NC1774.2 +094600 PERFORM FAIL. NC1774.2 +094700 GO TO ADD-WRITE-F2-22. NC1774.2 +094800 ADD-DELETE-F2-22. NC1774.2 +094900 PERFORM DE-LETE. NC1774.2 +095000 ADD-WRITE-F2-22. NC1774.2 +095100 MOVE "ADD-TEST-F2-22 " TO PAR-NAME. NC1774.2 +095200 PERFORM PRINT-DETAIL. NC1774.2 +095300* NC1774.2 +095400 ADD-INIT-F2-23. NC1774.2 +095500* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +095600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +095700 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +095800 ADD-TEST-F2-23. NC1774.2 +095900 ADD A12ONES-DS-12V00 NC1774.2 +096000 ZERO GIVING WRK-DS-10V00 NC1774.2 +096100 NOT ON SIZE ERROR NC1774.2 +096200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +096300 TO RE-MARK NC1774.2 +096400 PERFORM FAIL GO TO ADD-WRITE-F2-23. NC1774.2 +096500 GO TO ADD-PASS-F2-23. NC1774.2 +096600 ADD-DELETE-F2-23. NC1774.2 +096700 PERFORM DE-LETE. NC1774.2 +096800 GO TO ADD-WRITE-F2-23. NC1774.2 +096900 ADD-PASS-F2-23. NC1774.2 +097000 PERFORM PASS. NC1774.2 +097100 ADD-WRITE-F2-23. NC1774.2 +097200 MOVE "ADD-TEST-F2-23" TO PAR-NAME. NC1774.2 +097300 PERFORM PRINT-DETAIL. NC1774.2 +097400* NC1774.2 +097500 ADD-INIT-F2-24. NC1774.2 +097600* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +097700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +097800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +097900 ADD-TEST-F2-24. NC1774.2 +098000 ADD A12THREES-DS-06V06 NC1774.2 +098100 333333 NC1774.2 +098200 A06THREES-DS-03V03 NC1774.2 +098300 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +098400 NOT ON SIZE ERROR NC1774.2 +098500 PERFORM PASS NC1774.2 +098600 GO TO ADD-WRITE-F2-24. NC1774.2 +098700 GO TO ADD-FAIL-F2-24. NC1774.2 +098800 ADD-DELETE-F2-24. NC1774.2 +098900 PERFORM DE-LETE. NC1774.2 +099000 GO TO ADD-WRITE-F2-24. NC1774.2 +099100 ADD-FAIL-F2-24. NC1774.2 +099200 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC1774.2 +099300 PERFORM FAIL. NC1774.2 +099400 ADD-WRITE-F2-24. NC1774.2 +099500 MOVE "ADD-TEST-F2-24" TO PAR-NAME. NC1774.2 +099600 PERFORM PRINT-DETAIL. NC1774.2 +099700* NC1774.2 +099800 ADD-INIT-F2-25. NC1774.2 +099900* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +100000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +100100 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +100200 ADD-TEST-F2-25. NC1774.2 +100300 ADD A12ONES-DS-12V00 NC1774.2 +100400 ZERO GIVING WRK-DS-10V00 NC1774.2 +100500 ON SIZE ERROR NC1774.2 +100600 GO TO ADD-PASS-F2-25 NC1774.2 +100700 NOT ON SIZE ERROR NC1774.2 +100800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +100900 TO RE-MARK NC1774.2 +101000 PERFORM FAIL GO TO ADD-WRITE-F2-25. NC1774.2 +101100 ADD-DELETE-F2-25. NC1774.2 +101200 PERFORM DE-LETE. NC1774.2 +101300 GO TO ADD-WRITE-F2-25. NC1774.2 +101400 ADD-PASS-F2-25. NC1774.2 +101500 PERFORM PASS. NC1774.2 +101600 ADD-WRITE-F2-25. NC1774.2 +101700 MOVE "ADD-TEST-F2-25" TO PAR-NAME. NC1774.2 +101800 PERFORM PRINT-DETAIL. NC1774.2 +101900* NC1774.2 +102000 ADD-INIT-F2-26. NC1774.2 +102100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +102200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +102300 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +102400 ADD-TEST-F2-26. NC1774.2 +102500 ADD A12THREES-DS-06V06 NC1774.2 +102600 333333 NC1774.2 +102700 A06THREES-DS-03V03 NC1774.2 +102800 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +102900 ON SIZE ERROR NC1774.2 +103000 GO TO ADD-FAIL-F2-26 NC1774.2 +103100 NOT ON SIZE ERROR NC1774.2 +103200 PERFORM PASS NC1774.2 +103300 GO TO ADD-WRITE-F2-26. NC1774.2 +103400 ADD-DELETE-F2-26. NC1774.2 +103500 PERFORM DE-LETE. NC1774.2 +103600 GO TO ADD-WRITE-F2-26. NC1774.2 +103700 ADD-FAIL-F2-26. NC1774.2 +103800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC1774.2 +103900 PERFORM FAIL. NC1774.2 +104000 ADD-WRITE-F2-26. NC1774.2 +104100 MOVE "ADD-TEST-F2-26" TO PAR-NAME. NC1774.2 +104200 PERFORM PRINT-DETAIL. NC1774.2 +104300* NC1774.2 +104400 ADD-INIT-F2-27. NC1774.2 +104500* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +104600 MOVE "VI-74 6.6.4 GR2" TO ANSI-REFERENCE. NC1774.2 +104700 MOVE "ADD-TEST-F2-27" TO PAR-NAME. NC1774.2 +104800 MOVE 1 TO REC-CT. NC1774.2 +104900 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +105000 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +105100 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +105200 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +105300 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +105400 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +105500 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +105600 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +105700 ADD-GIVING-TEST-F2-27-0. NC1774.2 +105800 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +105900 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +106000 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1774.2 +106100 GO TO ADD-TEST-F2-27-1. NC1774.2 +106200 ADD-DELETE-F2-27. NC1774.2 +106300 PERFORM DE-LETE. NC1774.2 +106400 PERFORM PRINT-DETAIL. NC1774.2 +106500 GO TO ADD-INIT-F2-28. NC1774.2 +106600 ADD-TEST-F2-27-1. NC1774.2 +106700 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +106800 ELSE NC1774.2 +106900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +107000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +107100 ADD 1 TO REC-CT. NC1774.2 +107200 ADD-TEST-F2-27-2. NC1774.2 +107300 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +107400 ELSE NC1774.2 +107500 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +107600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +107700 ADD 1 TO REC-CT. NC1774.2 +107800 ADD-ADD-TEST-F2-27-3. NC1774.2 +107900 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +108000 ELSE NC1774.2 +108100 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +108200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +108300 ADD 1 TO REC-CT. NC1774.2 +108400 ADD-TEST-F2-27-4. NC1774.2 +108500 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +108600 ELSE NC1774.2 +108700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +108800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +108900 ADD 1 TO REC-CT. NC1774.2 +109000 ADD-TEST-F2-27-5. NC1774.2 +109100 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +109200 ELSE NC1774.2 +109300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +109400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +109500 ADD 1 TO REC-CT. NC1774.2 +109600 ADD-TEST-F2-27-6. NC1774.2 +109700 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +109800 ELSE NC1774.2 +109900 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +110000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +110100* NC1774.2 +110200 ADD-INIT-F2-28. NC1774.2 +110300* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +110400* ==--> SIZE ERROR <--== NC1774.2 +110500 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +110600 MOVE 1 TO REC-CT. NC1774.2 +110700 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +110800 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +110900 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +111000 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +111100 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +111200 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +111300 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +111400 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +111500 MOVE SPACE TO SIZE-ERR2. NC1774.2 +111600 ADD-GIVING-TEST-F2-28-0. NC1774.2 +111700 ADD A17TWOS-DS-17V00 NC1774.2 +111800 WRK-DU-1V1-1 NC1774.2 +111900 6 NC1774.2 +112000 WRK-DU-1V1-2 NC1774.2 +112100 GIVING WRK-DU-2V1-1 NC1774.2 +112200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +112300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +112400 ON SIZE ERROR NC1774.2 +112500 MOVE "A" TO SIZE-ERR2. NC1774.2 +112600 GO TO ADD-TEST-F2-28-1. NC1774.2 +112700 ADD-DELETE-F2-28. NC1774.2 +112800 PERFORM DE-LETE. NC1774.2 +112900 PERFORM PRINT-DETAIL. NC1774.2 +113000 GO TO ADD-INIT-F2-29. NC1774.2 +113100 ADD-TEST-F2-28-1. NC1774.2 +113200 MOVE "ADD-TEST-F2-28-1" TO PAR-NAME. NC1774.2 +113300 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +113400 ELSE NC1774.2 +113500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +113600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +113700 ADD 1 TO REC-CT. NC1774.2 +113800 ADD-TEST-F2-28-2. NC1774.2 +113900 MOVE "ADD-TEST-F2-28-2" TO PAR-NAME. NC1774.2 +114000 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +114100 ELSE NC1774.2 +114200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +114300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +114400 ADD 1 TO REC-CT. NC1774.2 +114500 ADD-ADD-TEST-F2-28-3. NC1774.2 +114600 MOVE "ADD-TEST-F2-28-3" TO PAR-NAME. NC1774.2 +114700 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +114800 ELSE NC1774.2 +114900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +115000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +115100 ADD 1 TO REC-CT. NC1774.2 +115200 ADD-TEST-F2-28-4. NC1774.2 +115300 MOVE "ADD-TEST-F2-28-4" TO PAR-NAME. NC1774.2 +115400 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +115500 ELSE NC1774.2 +115600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +115700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +115800 ADD 1 TO REC-CT. NC1774.2 +115900 ADD-TEST-F2-28-5. NC1774.2 +116000 MOVE "ADD-TEST-F2-28-5" TO PAR-NAME. NC1774.2 +116100 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +116200 ELSE NC1774.2 +116300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +116400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +116500 ADD 1 TO REC-CT. NC1774.2 +116600 ADD-TEST-F2-28-6. NC1774.2 +116700 MOVE "ADD-TEST-F2-28-6" TO PAR-NAME. NC1774.2 +116800 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +116900 ELSE NC1774.2 +117000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +117100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +117200 ADD 1 TO REC-CT. NC1774.2 +117300 ADD-TEST-F2-28-7. NC1774.2 +117400 MOVE "ADD-TEST-F2-28-7" TO PAR-NAME. NC1774.2 +117500 IF SIZE-ERR2 = "A" NC1774.2 +117600 PERFORM PASS NC1774.2 +117700 PERFORM PRINT-DETAIL NC1774.2 +117800 ELSE NC1774.2 +117900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +118000 TO RE-MARK NC1774.2 +118100 MOVE "A" TO CORRECT-X NC1774.2 +118200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +118300 PERFORM FAIL NC1774.2 +118400 PERFORM PRINT-DETAIL. NC1774.2 +118500* NC1774.2 +118600 ADD-INIT-F2-29. NC1774.2 +118700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +118800* ==--> NO SIZE ERROR <--== NC1774.2 +118900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +119000 MOVE 1 TO REC-CT. NC1774.2 +119100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +119200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +119300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +119400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +119500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +119600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +119700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +119800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +119900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +120000 ADD-GIVING-TEST-F2-29-0. NC1774.2 +120100 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +120200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +120300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +120400 ON SIZE ERROR NC1774.2 +120500 MOVE "A" TO SIZE-ERR2. NC1774.2 +120600 GO TO ADD-TEST-F2-29-1. NC1774.2 +120700 ADD-DELETE-F2-29. NC1774.2 +120800 PERFORM DE-LETE. NC1774.2 +120900 PERFORM PRINT-DETAIL. NC1774.2 +121000 GO TO ADD-INIT-F2-30. NC1774.2 +121100 ADD-TEST-F2-29-1. NC1774.2 +121200 MOVE "ADD-TEST-F2-29-1" TO PAR-NAME. NC1774.2 +121300 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +121400 ELSE NC1774.2 +121500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +121600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +121700 ADD 1 TO REC-CT. NC1774.2 +121800 ADD-TEST-F2-29-2. NC1774.2 +121900 MOVE "ADD-TEST-F2-29-2" TO PAR-NAME. NC1774.2 +122000 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +122100 ELSE NC1774.2 +122200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +122300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +122400 ADD 1 TO REC-CT. NC1774.2 +122500 ADD-ADD-TEST-F2-29-3. NC1774.2 +122600 MOVE "ADD-TEST-F2-29-3" TO PAR-NAME. NC1774.2 +122700 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +122800 ELSE NC1774.2 +122900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +123000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +123100 ADD 1 TO REC-CT. NC1774.2 +123200 ADD-TEST-F2-29-4. NC1774.2 +123300 MOVE "ADD-TEST-F2-29-4" TO PAR-NAME. NC1774.2 +123400 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +123500 ELSE NC1774.2 +123600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +123700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +123800 ADD 1 TO REC-CT. NC1774.2 +123900 ADD-TEST-F2-29-5. NC1774.2 +124000 MOVE "ADD-TEST-F2-29-5" TO PAR-NAME. NC1774.2 +124100 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +124200 ELSE NC1774.2 +124300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +124400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +124500 ADD 1 TO REC-CT. NC1774.2 +124600 ADD-TEST-F2-29-6. NC1774.2 +124700 MOVE "ADD-TEST-F2-29-6" TO PAR-NAME. NC1774.2 +124800 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +124900 ELSE NC1774.2 +125000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +125100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +125200 ADD 1 TO REC-CT. NC1774.2 +125300 ADD-TEST-F2-29-7. NC1774.2 +125400 MOVE "ADD-TEST-F2-29-7" TO PAR-NAME. NC1774.2 +125500 IF SIZE-ERR2 = SPACE NC1774.2 +125600 PERFORM PASS NC1774.2 +125700 PERFORM PRINT-DETAIL NC1774.2 +125800 ELSE NC1774.2 +125900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +126000 TO RE-MARK NC1774.2 +126100 MOVE SPACE TO CORRECT-X NC1774.2 +126200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +126300 PERFORM FAIL NC1774.2 +126400 PERFORM PRINT-DETAIL. NC1774.2 +126500* NC1774.2 +126600 ADD-INIT-F2-30. NC1774.2 +126700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +126800* ==--> SIZE ERROR <--== NC1774.2 +126900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +127000 MOVE 1 TO REC-CT. NC1774.2 +127100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +127200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +127300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +127400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +127500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +127600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +127700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +127800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +127900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +128000 ADD-GIVING-TEST-F2-30-0. NC1774.2 +128100 ADD A17TWOS-DS-17V00 NC1774.2 +128200 WRK-DU-1V1-1 NC1774.2 +128300 6 NC1774.2 +128400 WRK-DU-1V1-2 NC1774.2 +128500 GIVING WRK-DU-2V1-1 NC1774.2 +128600 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +128700 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +128800 NOT ON SIZE ERROR NC1774.2 +128900 MOVE "A" TO SIZE-ERR2. NC1774.2 +129000 GO TO ADD-TEST-F2-30-1. NC1774.2 +129100 ADD-DELETE-F2-30. NC1774.2 +129200 PERFORM DE-LETE. NC1774.2 +129300 PERFORM PRINT-DETAIL. NC1774.2 +129400 GO TO ADD-INIT-F2-31. NC1774.2 +129500 ADD-TEST-F2-30-1. NC1774.2 +129600 MOVE "ADD-TEST-F2-30-1" TO PAR-NAME. NC1774.2 +129700 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +129800 ELSE NC1774.2 +129900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +130000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +130100 ADD 1 TO REC-CT. NC1774.2 +130200 ADD-TEST-F2-30-2. NC1774.2 +130300 MOVE "ADD-TEST-F2-30-2" TO PAR-NAME. NC1774.2 +130400 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +130500 ELSE NC1774.2 +130600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +130700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +130800 ADD 1 TO REC-CT. NC1774.2 +130900 ADD-ADD-TEST-F2-30-3. NC1774.2 +131000 MOVE "ADD-TEST-F2-30-3" TO PAR-NAME. NC1774.2 +131100 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +131200 ELSE NC1774.2 +131300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +131400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +131500 ADD 1 TO REC-CT. NC1774.2 +131600 ADD-TEST-F2-30-4. NC1774.2 +131700 MOVE "ADD-TEST-F2-30-4" TO PAR-NAME. NC1774.2 +131800 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +131900 ELSE NC1774.2 +132000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +132100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +132200 ADD 1 TO REC-CT. NC1774.2 +132300 ADD-TEST-F2-30-5. NC1774.2 +132400 MOVE "ADD-TEST-F2-30-5" TO PAR-NAME. NC1774.2 +132500 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +132600 ELSE NC1774.2 +132700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +132800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +132900 ADD 1 TO REC-CT. NC1774.2 +133000 ADD-TEST-F2-30-6. NC1774.2 +133100 MOVE "ADD-TEST-F2-30-6" TO PAR-NAME. NC1774.2 +133200 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +133300 ELSE NC1774.2 +133400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +133500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +133600 ADD 1 TO REC-CT. NC1774.2 +133700 ADD-TEST-F2-30-7. NC1774.2 +133800 MOVE "ADD-TEST-F2-30-7" TO PAR-NAME. NC1774.2 +133900 IF SIZE-ERR2 = SPACE NC1774.2 +134000 PERFORM PASS NC1774.2 +134100 PERFORM PRINT-DETAIL NC1774.2 +134200 ELSE NC1774.2 +134300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +134400 TO RE-MARK NC1774.2 +134500 MOVE SPACE TO CORRECT-X NC1774.2 +134600 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +134700 PERFORM FAIL NC1774.2 +134800 PERFORM PRINT-DETAIL. NC1774.2 +134900* NC1774.2 +135000 ADD-INIT-F2-31. NC1774.2 +135100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +135200* ==--> NO SIZE ERROR <--== NC1774.2 +135300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +135400 MOVE 1 TO REC-CT. NC1774.2 +135500 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +135600 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +135700 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +135800 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +135900 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +136000 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +136100 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +136200 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +136300 MOVE SPACE TO SIZE-ERR2. NC1774.2 +136400 ADD-GIVING-TEST-F2-31-0. NC1774.2 +136500 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +136600 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +136700 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +136800 NOT ON SIZE ERROR NC1774.2 +136900 MOVE "A" TO SIZE-ERR2. NC1774.2 +137000 GO TO ADD-TEST-F2-31-1. NC1774.2 +137100 ADD-DELETE-F2-31. NC1774.2 +137200 PERFORM DE-LETE. NC1774.2 +137300 PERFORM PRINT-DETAIL. NC1774.2 +137400 GO TO ADD-INIT-F2-32. NC1774.2 +137500 ADD-TEST-F2-31-1. NC1774.2 +137600 MOVE "ADD-TEST-F2-31-1" TO PAR-NAME. NC1774.2 +137700 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +137800 ELSE NC1774.2 +137900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +138000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +138100 ADD 1 TO REC-CT. NC1774.2 +138200 ADD-TEST-F2-31-2. NC1774.2 +138300 MOVE "ADD-TEST-F2-31-2" TO PAR-NAME. NC1774.2 +138400 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +138500 ELSE NC1774.2 +138600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +138700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +138800 ADD 1 TO REC-CT. NC1774.2 +138900 ADD-ADD-TEST-F2-31-3. NC1774.2 +139000 MOVE "ADD-TEST-F2-31-3" TO PAR-NAME. NC1774.2 +139100 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +139200 ELSE NC1774.2 +139300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +139400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +139500 ADD 1 TO REC-CT. NC1774.2 +139600 ADD-TEST-F2-31-4. NC1774.2 +139700 MOVE "ADD-TEST-F2-31-4" TO PAR-NAME. NC1774.2 +139800 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +139900 ELSE NC1774.2 +140000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +140100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +140200 ADD 1 TO REC-CT. NC1774.2 +140300 ADD-TEST-F2-31-5. NC1774.2 +140400 MOVE "ADD-TEST-F2-31-5" TO PAR-NAME. NC1774.2 +140500 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +140600 ELSE NC1774.2 +140700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +140800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +140900 ADD 1 TO REC-CT. NC1774.2 +141000 ADD-TEST-F2-31-6. NC1774.2 +141100 MOVE "ADD-TEST-F2-31-6" TO PAR-NAME. NC1774.2 +141200 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +141300 ELSE NC1774.2 +141400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +141500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +141600 ADD 1 TO REC-CT. NC1774.2 +141700 ADD-TEST-F2-31-7. NC1774.2 +141800 MOVE "ADD-TEST-F2-31-7" TO PAR-NAME. NC1774.2 +141900 IF SIZE-ERR2 = "A" NC1774.2 +142000 PERFORM PASS NC1774.2 +142100 PERFORM PRINT-DETAIL NC1774.2 +142200 ELSE NC1774.2 +142300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +142400 TO RE-MARK NC1774.2 +142500 MOVE "A" TO CORRECT-X NC1774.2 +142600 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +142700 PERFORM FAIL NC1774.2 +142800 PERFORM PRINT-DETAIL. NC1774.2 +142900* NC1774.2 +143000 ADD-INIT-F2-32. NC1774.2 +143100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +143200* ==--> SIZE ERROR <--== NC1774.2 +143300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +143400 MOVE 1 TO REC-CT. NC1774.2 +143500 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +143600 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +143700 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +143800 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +143900 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +144000 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +144100 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +144200 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +144300 MOVE SPACE TO SIZE-ERR2. NC1774.2 +144400 ADD-GIVING-TEST-F2-32-0. NC1774.2 +144500 ADD A17TWOS-DS-17V00 NC1774.2 +144600 WRK-DU-1V1-1 NC1774.2 +144700 6 NC1774.2 +144800 WRK-DU-1V1-2 NC1774.2 +144900 GIVING WRK-DU-2V1-1 NC1774.2 +145000 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +145100 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +145200 ON SIZE ERROR NC1774.2 +145300 MOVE "A" TO SIZE-ERR2 NC1774.2 +145400 NOT ON SIZE ERROR NC1774.2 +145500 MOVE "B" TO SIZE-ERR2. NC1774.2 +145600 GO TO ADD-TEST-F2-32-1. NC1774.2 +145700 ADD-DELETE-F2-32. NC1774.2 +145800 PERFORM DE-LETE. NC1774.2 +145900 PERFORM PRINT-DETAIL. NC1774.2 +146000 GO TO ADD-INIT-F2-33. NC1774.2 +146100 ADD-TEST-F2-32-1. NC1774.2 +146200 MOVE "ADD-TEST-F2-32-1" TO PAR-NAME. NC1774.2 +146300 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +146400 ELSE NC1774.2 +146500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +146600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +146700 ADD 1 TO REC-CT. NC1774.2 +146800 ADD-TEST-F2-32-2. NC1774.2 +146900 MOVE "ADD-TEST-F2-32-2" TO PAR-NAME. NC1774.2 +147000 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +147100 ELSE NC1774.2 +147200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +147300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +147400 ADD 1 TO REC-CT. NC1774.2 +147500 ADD-ADD-TEST-F2-32-3. NC1774.2 +147600 MOVE "ADD-TEST-F2-32-3" TO PAR-NAME. NC1774.2 +147700 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +147800 ELSE NC1774.2 +147900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +148000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +148100 ADD 1 TO REC-CT. NC1774.2 +148200 ADD-TEST-F2-32-4. NC1774.2 +148300 MOVE "ADD-TEST-F2-32-4" TO PAR-NAME. NC1774.2 +148400 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +148500 ELSE NC1774.2 +148600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +148700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +148800 ADD 1 TO REC-CT. NC1774.2 +148900 ADD-TEST-F2-32-5. NC1774.2 +149000 MOVE "ADD-TEST-F2-32-5" TO PAR-NAME. NC1774.2 +149100 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +149200 ELSE NC1774.2 +149300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +149400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +149500 ADD 1 TO REC-CT. NC1774.2 +149600 ADD-TEST-F2-32-6. NC1774.2 +149700 MOVE "ADD-TEST-F2-32-6" TO PAR-NAME. NC1774.2 +149800 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +149900 ELSE NC1774.2 +150000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +150100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +150200 ADD 1 TO REC-CT. NC1774.2 +150300 ADD-TEST-F2-32-7. NC1774.2 +150400 MOVE "ADD-TEST-F2-32-7" TO PAR-NAME. NC1774.2 +150500 IF SIZE-ERR2 = "A" NC1774.2 +150600 PERFORM PASS NC1774.2 +150700 PERFORM PRINT-DETAIL NC1774.2 +150800 ELSE NC1774.2 +150900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +151000 TO RE-MARK NC1774.2 +151100 MOVE "A" TO CORRECT-X NC1774.2 +151200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +151300 PERFORM FAIL NC1774.2 +151400 PERFORM PRINT-DETAIL. NC1774.2 +151500* NC1774.2 +151600 ADD-INIT-F2-33. NC1774.2 +151700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +151800* ==--> NO SIZE ERROR <--== NC1774.2 +151900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +152000 MOVE 1 TO REC-CT. NC1774.2 +152100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +152200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +152300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +152400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +152500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +152600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +152700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +152800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +152900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +153000 ADD-GIVING-TEST-F2-33-0. NC1774.2 +153100 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +153200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +153300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +153400 ON SIZE ERROR NC1774.2 +153500 MOVE "A" TO SIZE-ERR2 NC1774.2 +153600 NOT ON SIZE ERROR NC1774.2 +153700 MOVE "B" TO SIZE-ERR2. NC1774.2 +153800 GO TO ADD-TEST-F2-33-1. NC1774.2 +153900 ADD-DELETE-F2-33. NC1774.2 +154000 PERFORM DE-LETE. NC1774.2 +154100 PERFORM PRINT-DETAIL. NC1774.2 +154200 GO TO ADD-INIT-F2-34. NC1774.2 +154300 ADD-TEST-F2-33-1. NC1774.2 +154400 MOVE "ADD-TEST-F2-33-1" TO PAR-NAME. NC1774.2 +154500 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +154600 ELSE NC1774.2 +154700 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +154800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +154900 ADD 1 TO REC-CT. NC1774.2 +155000 ADD-TEST-F2-33-2. NC1774.2 +155100 MOVE "ADD-TEST-F2-33-2" TO PAR-NAME. NC1774.2 +155200 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +155300 ELSE NC1774.2 +155400 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +155500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +155600 ADD 1 TO REC-CT. NC1774.2 +155700 ADD-ADD-TEST-F2-33-3. NC1774.2 +155800 MOVE "ADD-TEST-F2-33-3" TO PAR-NAME. NC1774.2 +155900 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +156000 ELSE NC1774.2 +156100 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +156200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +156300 ADD 1 TO REC-CT. NC1774.2 +156400 ADD-TEST-F2-33-4. NC1774.2 +156500 MOVE "ADD-TEST-F2-33-4" TO PAR-NAME. NC1774.2 +156600 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +156700 ELSE NC1774.2 +156800 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +156900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +157000 ADD 1 TO REC-CT. NC1774.2 +157100 ADD-TEST-F2-33-5. NC1774.2 +157200 MOVE "ADD-TEST-F2-33-5" TO PAR-NAME. NC1774.2 +157300 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +157400 ELSE NC1774.2 +157500 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +157600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +157700 ADD 1 TO REC-CT. NC1774.2 +157800 ADD-TEST-F2-33-6. NC1774.2 +157900 MOVE "ADD-TEST-F2-33-6" TO PAR-NAME. NC1774.2 +158000 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +158100 ELSE NC1774.2 +158200 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +158300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +158400 ADD 1 TO REC-CT. NC1774.2 +158500 ADD-TEST-F2-33-7. NC1774.2 +158600 MOVE "ADD-TEST-F2-33-7" TO PAR-NAME. NC1774.2 +158700 IF SIZE-ERR2 = "B" NC1774.2 +158800 PERFORM PASS NC1774.2 +158900 PERFORM PRINT-DETAIL NC1774.2 +159000 ELSE NC1774.2 +159100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +159200 TO RE-MARK NC1774.2 +159300 MOVE "B" TO CORRECT-X NC1774.2 +159400 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +159500 PERFORM FAIL NC1774.2 +159600 PERFORM PRINT-DETAIL. NC1774.2 +159700* NC1774.2 +159800 ADD-INIT-F2-34. NC1774.2 +159900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +160000* ==--> SIZE ERROR <--== NC1774.2 +160100 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +160200 MOVE "ADD-TEST-F2-34" TO PAR-NAME. NC1774.2 +160300 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +160400 MOVE 1 TO REC-CT. NC1774.2 +160500 MOVE SPACE TO WRK-XN-00001. NC1774.2 +160600 MOVE SPACE TO SIZE-ERR2. NC1774.2 +160700 MOVE SPACE TO SIZE-ERR3. NC1774.2 +160800 MOVE SPACE TO SIZE-ERR4. NC1774.2 +160900 ADD-TEST-F2-34-0. NC1774.2 +161000 ADD A12ONES-DS-12V00 NC1774.2 +161100 ZERO NC1774.2 +161200 GIVING WRK-DS-10V00 NC1774.2 +161300 ON SIZE ERROR NC1774.2 +161400 MOVE "A" TO SIZE-ERR2 NC1774.2 +161500 MOVE "B" TO SIZE-ERR3 NC1774.2 +161600 MOVE "C" TO SIZE-ERR4 NC1774.2 +161700 END-ADD NC1774.2 +161800 MOVE "1" TO WRK-XN-00001. NC1774.2 +161900 GO TO ADD-TEST-F2-34-1. NC1774.2 +162000 ADD-DELETE-F2-34. NC1774.2 +162100 PERFORM DE-LETE. NC1774.2 +162200 PERFORM PRINT-DETAIL. NC1774.2 +162300 GO TO ADD-INIT-F2-35. NC1774.2 +162400 ADD-TEST-F2-34-1. NC1774.2 +162500 MOVE "ADD-TEST-F2-34-1" TO PAR-NAME. NC1774.2 +162600 IF SIZE-ERR2 = "A" NC1774.2 +162700 PERFORM PASS NC1774.2 +162800 PERFORM PRINT-DETAIL NC1774.2 +162900 ELSE NC1774.2 +163000 MOVE "A" TO CORRECT-X NC1774.2 +163100 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +163200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +163300 TO RE-MARK NC1774.2 +163400 PERFORM FAIL NC1774.2 +163500 PERFORM PRINT-DETAIL. NC1774.2 +163600 ADD 1 TO REC-CT. NC1774.2 +163700 ADD-TEST-F2-34-2. NC1774.2 +163800 MOVE "ADD-TEST-F2-34-2" TO PAR-NAME. NC1774.2 +163900 IF SIZE-ERR3 = "B" NC1774.2 +164000 PERFORM PASS NC1774.2 +164100 PERFORM PRINT-DETAIL NC1774.2 +164200 ELSE NC1774.2 +164300 MOVE "B" TO CORRECT-X NC1774.2 +164400 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +164500 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +164600 TO RE-MARK NC1774.2 +164700 PERFORM FAIL NC1774.2 +164800 PERFORM PRINT-DETAIL. NC1774.2 +164900 ADD 1 TO REC-CT. NC1774.2 +165000 ADD-TEST-F2-34-3. NC1774.2 +165100 MOVE "ADD-TEST-F2-34-3" TO PAR-NAME. NC1774.2 +165200 IF SIZE-ERR4 = "C" NC1774.2 +165300 PERFORM PASS NC1774.2 +165400 PERFORM PRINT-DETAIL NC1774.2 +165500 ELSE NC1774.2 +165600 MOVE "C" TO CORRECT-X NC1774.2 +165700 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +165800 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +165900 TO RE-MARK NC1774.2 +166000 PERFORM FAIL NC1774.2 +166100 PERFORM PRINT-DETAIL. NC1774.2 +166200 ADD 1 TO REC-CT. NC1774.2 +166300 ADD-TEST-F2-34-4. NC1774.2 +166400 MOVE "ADD-TEST-F2-34-4" TO PAR-NAME. NC1774.2 +166500 IF WRK-XN-00001 = "1" NC1774.2 +166600 PERFORM PASS NC1774.2 +166700 PERFORM PRINT-DETAIL NC1774.2 +166800 ELSE NC1774.2 +166900 MOVE "1" TO CORRECT-X NC1774.2 +167000 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +167100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +167200 PERFORM FAIL NC1774.2 +167300 PERFORM PRINT-DETAIL. NC1774.2 +167400 ADD 1 TO REC-CT. NC1774.2 +167500 ADD-TEST-F2-34-5. NC1774.2 +167600 MOVE "ADD-TEST-F2-34-5" TO PAR-NAME. NC1774.2 +167700 IF WRK-DS-10V00 = ZERO NC1774.2 +167800 PERFORM PASS NC1774.2 +167900 PERFORM PRINT-DETAIL NC1774.2 +168000 ELSE NC1774.2 +168100 MOVE ZERO TO CORRECT-N NC1774.2 +168200 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +168300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +168400 TO RE-MARK NC1774.2 +168500 PERFORM FAIL NC1774.2 +168600 PERFORM PRINT-DETAIL. NC1774.2 +168700* NC1774.2 +168800 ADD-INIT-F2-35. NC1774.2 +168900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +169000* ==--> NO SIZE ERROR <--== NC1774.2 +169100 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +169200 MOVE "ADD-TEST-F2-35" TO PAR-NAME. NC1774.2 +169300 MOVE 1 TO REC-CT. NC1774.2 +169400 MOVE SPACE TO WRK-XN-00001. NC1774.2 +169500 MOVE SPACE TO SIZE-ERR2. NC1774.2 +169600 MOVE SPACE TO SIZE-ERR3. NC1774.2 +169700 MOVE SPACE TO SIZE-ERR4. NC1774.2 +169800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +169900 ADD-TEST-F2-35-0. NC1774.2 +170000 ADD A12THREES-DS-06V06 NC1774.2 +170100 333333 NC1774.2 +170200 A06THREES-DS-03V03 NC1774.2 +170300 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +170400 ON SIZE ERROR NC1774.2 +170500 MOVE "A" TO SIZE-ERR2 NC1774.2 +170600 MOVE "B" TO SIZE-ERR3 NC1774.2 +170700 MOVE "C" TO SIZE-ERR4 NC1774.2 +170800 END-ADD NC1774.2 +170900 MOVE "1" TO WRK-XN-00001. NC1774.2 +171000 GO TO ADD-TEST-F2-35-1. NC1774.2 +171100 ADD-DELETE-F2-35. NC1774.2 +171200 PERFORM DE-LETE. NC1774.2 +171300 PERFORM PRINT-DETAIL. NC1774.2 +171400 GO TO ADD-INIT-F2-36. NC1774.2 +171500 ADD-TEST-F2-35-1. NC1774.2 +171600 MOVE "ADD-TEST-F2-35-1" TO PAR-NAME. NC1774.2 +171700 IF SIZE-ERR2 = SPACE NC1774.2 +171800 PERFORM PASS NC1774.2 +171900 PERFORM PRINT-DETAIL NC1774.2 +172000 ELSE NC1774.2 +172100 MOVE SPACE TO CORRECT-X NC1774.2 +172200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +172300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +172400 TO RE-MARK NC1774.2 +172500 PERFORM FAIL NC1774.2 +172600 PERFORM PRINT-DETAIL. NC1774.2 +172700 ADD 1 TO REC-CT. NC1774.2 +172800 ADD-TEST-F2-35-2. NC1774.2 +172900 MOVE "ADD-TEST-F2-35-2" TO PAR-NAME. NC1774.2 +173000 IF SIZE-ERR3 = SPACE NC1774.2 +173100 PERFORM PASS NC1774.2 +173200 PERFORM PRINT-DETAIL NC1774.2 +173300 ELSE NC1774.2 +173400 MOVE SPACE TO CORRECT-X NC1774.2 +173500 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +173600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +173700 TO RE-MARK NC1774.2 +173800 PERFORM FAIL NC1774.2 +173900 PERFORM PRINT-DETAIL. NC1774.2 +174000 ADD 1 TO REC-CT. NC1774.2 +174100 ADD-TEST-F2-35-3. NC1774.2 +174200 MOVE "ADD-TEST-F2-35-3" TO PAR-NAME. NC1774.2 +174300 IF SIZE-ERR4 = SPACE NC1774.2 +174400 PERFORM PASS NC1774.2 +174500 PERFORM PRINT-DETAIL NC1774.2 +174600 ELSE NC1774.2 +174700 MOVE "C" TO CORRECT-X NC1774.2 +174800 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +174900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +175000 TO RE-MARK NC1774.2 +175100 PERFORM FAIL NC1774.2 +175200 PERFORM PRINT-DETAIL. NC1774.2 +175300 ADD 1 TO REC-CT. NC1774.2 +175400 ADD-TEST-F2-35-4. NC1774.2 +175500 MOVE "ADD-TEST-F2-35-4" TO PAR-NAME. NC1774.2 +175600 IF WRK-XN-00001 = "1" NC1774.2 +175700 PERFORM PASS NC1774.2 +175800 PERFORM PRINT-DETAIL NC1774.2 +175900 ELSE NC1774.2 +176000 MOVE "1" TO CORRECT-X NC1774.2 +176100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +176200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +176300 PERFORM FAIL NC1774.2 +176400 PERFORM PRINT-DETAIL NC1774.2 +176500 ADD 1 TO REC-CT. NC1774.2 +176600 ADD-TEST-F2-35-5. NC1774.2 +176700 MOVE "ADD-TEST-F2-35-5" TO PAR-NAME. NC1774.2 +176800 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +176900 PERFORM PASS NC1774.2 +177000 PERFORM PRINT-DETAIL NC1774.2 +177100 ELSE NC1774.2 +177200 MOVE 666999.666333 TO CORRECT-N NC1774.2 +177300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +177400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +177500 TO RE-MARK NC1774.2 +177600 PERFORM FAIL NC1774.2 +177700 PERFORM PRINT-DETAIL. NC1774.2 +177800* NC1774.2 +177900 ADD-INIT-F2-36. NC1774.2 +178000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +178100* ==--> SIZE ERROR <--== NC1774.2 +178200 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +178300 MOVE "ADD-TEST-F2-36" TO PAR-NAME. NC1774.2 +178400 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +178500 MOVE 1 TO REC-CT. NC1774.2 +178600 MOVE SPACE TO WRK-XN-00001. NC1774.2 +178700 MOVE SPACE TO SIZE-ERR2. NC1774.2 +178800 MOVE SPACE TO SIZE-ERR3. NC1774.2 +178900 MOVE SPACE TO SIZE-ERR4. NC1774.2 +179000 ADD-TEST-F2-36-0. NC1774.2 +179100 ADD A12ONES-DS-12V00 NC1774.2 +179200 ZERO NC1774.2 +179300 GIVING WRK-DS-10V00 NC1774.2 +179400 NOT ON SIZE ERROR NC1774.2 +179500 MOVE "A" TO SIZE-ERR2 NC1774.2 +179600 MOVE "B" TO SIZE-ERR3 NC1774.2 +179700 MOVE "C" TO SIZE-ERR4 NC1774.2 +179800 END-ADD NC1774.2 +179900 MOVE "1" TO WRK-XN-00001. NC1774.2 +180000 GO TO ADD-TEST-F2-36-1. NC1774.2 +180100 ADD-DELETE-F2-36. NC1774.2 +180200 PERFORM DE-LETE. NC1774.2 +180300 PERFORM PRINT-DETAIL. NC1774.2 +180400 GO TO ADD-INIT-F2-37. NC1774.2 +180500 ADD-TEST-F2-36-1. NC1774.2 +180600 MOVE "ADD-TEST-F2-36-1" TO PAR-NAME. NC1774.2 +180700 IF SIZE-ERR2 = SPACE NC1774.2 +180800 PERFORM PASS NC1774.2 +180900 PERFORM PRINT-DETAIL NC1774.2 +181000 ELSE NC1774.2 +181100 MOVE SPACE TO CORRECT-X NC1774.2 +181200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +181300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +181400 TO RE-MARK NC1774.2 +181500 PERFORM FAIL NC1774.2 +181600 PERFORM PRINT-DETAIL. NC1774.2 +181700 ADD 1 TO REC-CT. NC1774.2 +181800 ADD-TEST-F2-36-2. NC1774.2 +181900 MOVE "ADD-TEST-F2-36-2" TO PAR-NAME. NC1774.2 +182000 IF SIZE-ERR3 = SPACE NC1774.2 +182100 PERFORM PASS NC1774.2 +182200 PERFORM PRINT-DETAIL NC1774.2 +182300 ELSE NC1774.2 +182400 MOVE SPACE TO CORRECT-X NC1774.2 +182500 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +182600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +182700 TO RE-MARK NC1774.2 +182800 PERFORM FAIL NC1774.2 +182900 PERFORM PRINT-DETAIL. NC1774.2 +183000 ADD 1 TO REC-CT. NC1774.2 +183100 ADD-TEST-F2-36-3. NC1774.2 +183200 MOVE "ADD-TEST-F2-36-3" TO PAR-NAME. NC1774.2 +183300 IF SIZE-ERR4 = SPACE NC1774.2 +183400 PERFORM PASS NC1774.2 +183500 PERFORM PRINT-DETAIL NC1774.2 +183600 ELSE NC1774.2 +183700 MOVE SPACE TO CORRECT-X NC1774.2 +183800 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +183900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +184000 TO RE-MARK NC1774.2 +184100 PERFORM FAIL NC1774.2 +184200 PERFORM PRINT-DETAIL. NC1774.2 +184300 ADD 1 TO REC-CT. NC1774.2 +184400 ADD-TEST-F2-36-4. NC1774.2 +184500 MOVE "ADD-TEST-F2-36-4" TO PAR-NAME. NC1774.2 +184600 IF WRK-XN-00001 = "1" NC1774.2 +184700 PERFORM PASS NC1774.2 +184800 PERFORM PRINT-DETAIL NC1774.2 +184900 ELSE NC1774.2 +185000 MOVE "1" TO CORRECT-X NC1774.2 +185100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +185200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +185300 PERFORM FAIL NC1774.2 +185400 PERFORM PRINT-DETAIL. NC1774.2 +185500 ADD 1 TO REC-CT. NC1774.2 +185600 ADD-TEST-F2-36-5. NC1774.2 +185700 MOVE "ADD-TEST-F2-36-5" TO PAR-NAME. NC1774.2 +185800 IF WRK-DS-10V00 = ZERO NC1774.2 +185900 PERFORM PASS NC1774.2 +186000 PERFORM PRINT-DETAIL NC1774.2 +186100 ELSE NC1774.2 +186200 MOVE ZERO TO CORRECT-N NC1774.2 +186300 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +186400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +186500 TO RE-MARK NC1774.2 +186600 PERFORM FAIL NC1774.2 +186700 PERFORM PRINT-DETAIL. NC1774.2 +186800* NC1774.2 +186900 ADD-INIT-F2-37. NC1774.2 +187000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +187100* ==--> NO SIZE ERROR <--== NC1774.2 +187200 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +187300 MOVE "ADD-TEST-F2-37" TO PAR-NAME. NC1774.2 +187400 MOVE 1 TO REC-CT. NC1774.2 +187500 MOVE SPACE TO WRK-XN-00001. NC1774.2 +187600 MOVE SPACE TO SIZE-ERR2. NC1774.2 +187700 MOVE SPACE TO SIZE-ERR3. NC1774.2 +187800 MOVE SPACE TO SIZE-ERR4. NC1774.2 +187900 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +188000 ADD-TEST-F2-37-0. NC1774.2 +188100 ADD A12THREES-DS-06V06 NC1774.2 +188200 333333 NC1774.2 +188300 A06THREES-DS-03V03 NC1774.2 +188400 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +188500 NOT ON SIZE ERROR NC1774.2 +188600 MOVE "A" TO SIZE-ERR2 NC1774.2 +188700 MOVE "B" TO SIZE-ERR3 NC1774.2 +188800 MOVE "C" TO SIZE-ERR4 NC1774.2 +188900 END-ADD NC1774.2 +189000 MOVE "1" TO WRK-XN-00001. NC1774.2 +189100 GO TO ADD-TEST-F2-37-1. NC1774.2 +189200 ADD-DELETE-F2-37. NC1774.2 +189300 PERFORM DE-LETE. NC1774.2 +189400 PERFORM PRINT-DETAIL. NC1774.2 +189500 GO TO ADD-INIT-F2-38. NC1774.2 +189600 ADD-TEST-F2-37-1. NC1774.2 +189700 MOVE "ADD-TEST-F2-37-1" TO PAR-NAME. NC1774.2 +189800 IF SIZE-ERR2 = "A" NC1774.2 +189900 PERFORM PASS NC1774.2 +190000 PERFORM PRINT-DETAIL NC1774.2 +190100 ELSE NC1774.2 +190200 MOVE "A" TO CORRECT-X NC1774.2 +190300 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +190400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +190500 TO RE-MARK NC1774.2 +190600 PERFORM FAIL NC1774.2 +190700 PERFORM PRINT-DETAIL. NC1774.2 +190800 ADD 1 TO REC-CT. NC1774.2 +190900 ADD-TEST-F2-37-2. NC1774.2 +191000 MOVE "ADD-TEST-F2-37-2" TO PAR-NAME. NC1774.2 +191100 IF SIZE-ERR3 = "B" NC1774.2 +191200 PERFORM PASS NC1774.2 +191300 PERFORM PRINT-DETAIL NC1774.2 +191400 ELSE NC1774.2 +191500 MOVE "B" TO CORRECT-X NC1774.2 +191600 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +191700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +191800 TO RE-MARK NC1774.2 +191900 PERFORM FAIL NC1774.2 +192000 PERFORM PRINT-DETAIL. NC1774.2 +192100 ADD 1 TO REC-CT. NC1774.2 +192200 ADD-TEST-F2-37-3. NC1774.2 +192300 MOVE "ADD-TEST-F2-37-3" TO PAR-NAME NC1774.2 +192400 IF SIZE-ERR4 = "C" NC1774.2 +192500 PERFORM PASS NC1774.2 +192600 PERFORM PRINT-DETAIL NC1774.2 +192700 ELSE NC1774.2 +192800 MOVE "C" TO CORRECT-X NC1774.2 +192900 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +193000 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +193100 TO RE-MARK NC1774.2 +193200 PERFORM FAIL NC1774.2 +193300 PERFORM PRINT-DETAIL. NC1774.2 +193400 ADD 1 TO REC-CT. NC1774.2 +193500 ADD-TEST-F2-37-4. NC1774.2 +193600 MOVE "ADD-TEST-F2-37-4" TO PAR-NAME. NC1774.2 +193700 IF WRK-XN-00001 = "1" NC1774.2 +193800 PERFORM PASS NC1774.2 +193900 PERFORM PRINT-DETAIL NC1774.2 +194000 ELSE NC1774.2 +194100 MOVE "1" TO CORRECT-X NC1774.2 +194200 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +194300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +194400 PERFORM FAIL NC1774.2 +194500 PERFORM PRINT-DETAIL. NC1774.2 +194600 ADD 1 TO REC-CT. NC1774.2 +194700 ADD-TEST-F2-37-5. NC1774.2 +194800 MOVE "ADD-TEST-F2-37-5" TO PAR-NAME. NC1774.2 +194900 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +195000 PERFORM PASS NC1774.2 +195100 PERFORM PRINT-DETAIL NC1774.2 +195200 ELSE NC1774.2 +195300 MOVE 666999.666333 TO CORRECT-N NC1774.2 +195400 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +195500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +195600 TO RE-MARK NC1774.2 +195700 PERFORM FAIL NC1774.2 +195800 PERFORM PRINT-DETAIL. NC1774.2 +195900* NC1774.2 +196000 ADD-INIT-F2-38. NC1774.2 +196100* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +196200* ==--> SIZE ERROR <--== NC1774.2 +196300 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +196400 MOVE "ADD-TEST-F2-38" TO PAR-NAME. NC1774.2 +196500 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +196600 MOVE 1 TO REC-CT. NC1774.2 +196700 MOVE SPACE TO WRK-XN-00001. NC1774.2 +196800 MOVE SPACE TO SIZE-ERR2. NC1774.2 +196900 MOVE SPACE TO SIZE-ERR3. NC1774.2 +197000 MOVE SPACE TO SIZE-ERR4. NC1774.2 +197100 ADD-TEST-F2-38-0. NC1774.2 +197200 ADD A12ONES-DS-12V00 NC1774.2 +197300 ZERO NC1774.2 +197400 GIVING WRK-DS-10V00 NC1774.2 +197500 ON SIZE ERROR NC1774.2 +197600 MOVE "A" TO SIZE-ERR2 NC1774.2 +197700 NOT ON SIZE ERROR NC1774.2 +197800 MOVE "X" TO SIZE-ERR2 NC1774.2 +197900 END-ADD NC1774.2 +198000 MOVE "1" TO WRK-XN-00001. NC1774.2 +198100 GO TO ADD-TEST-F2-38-1. NC1774.2 +198200 ADD-DELETE-F2-38. NC1774.2 +198300 PERFORM DE-LETE. NC1774.2 +198400 PERFORM PRINT-DETAIL. NC1774.2 +198500 GO TO ADD-INIT-F2-39. NC1774.2 +198600 ADD-TEST-F2-38-1. NC1774.2 +198700 MOVE "ADD-TEST-F2-38-1" TO PAR-NAME. NC1774.2 +198800 IF SIZE-ERR2 = "A" NC1774.2 +198900 PERFORM PASS NC1774.2 +199000 PERFORM PRINT-DETAIL NC1774.2 +199100 ELSE NC1774.2 +199200 MOVE "A" TO CORRECT-X NC1774.2 +199300 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +199400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +199500 TO RE-MARK NC1774.2 +199600 PERFORM FAIL NC1774.2 +199700 PERFORM PRINT-DETAIL. NC1774.2 +199800 ADD 1 TO REC-CT. NC1774.2 +199900 ADD-TEST-F2-38-2. NC1774.2 +200000 MOVE "ADD-TEST-F2-38-2" TO PAR-NAME. NC1774.2 +200100 IF WRK-XN-00001 = "1" NC1774.2 +200200 PERFORM PASS NC1774.2 +200300 PERFORM PRINT-DETAIL NC1774.2 +200400 ELSE NC1774.2 +200500 MOVE "1" TO CORRECT-X NC1774.2 +200600 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +200700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +200800 PERFORM FAIL NC1774.2 +200900 PERFORM PRINT-DETAIL. NC1774.2 +201000 ADD 1 TO REC-CT. NC1774.2 +201100 ADD-TEST-F2-38-3. NC1774.2 +201200 MOVE "ADD-TEST-F2-38-3" TO PAR-NAME. NC1774.2 +201300 IF WRK-DS-10V00 = ZERO NC1774.2 +201400 PERFORM PASS NC1774.2 +201500 PERFORM PRINT-DETAIL NC1774.2 +201600 ELSE NC1774.2 +201700 MOVE ZERO TO CORRECT-N NC1774.2 +201800 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +201900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +202000 TO RE-MARK NC1774.2 +202100 PERFORM FAIL NC1774.2 +202200 PERFORM PRINT-DETAIL. NC1774.2 +202300* NC1774.2 +202400 ADD-INIT-F2-39. NC1774.2 +202500* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +202600* ==--> NO SIZE ERROR <--== NC1774.2 +202700 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +202800 MOVE "ADD-TEST-F2-39" TO PAR-NAME. NC1774.2 +202900 MOVE 1 TO REC-CT. NC1774.2 +203000 MOVE SPACE TO WRK-XN-00001. NC1774.2 +203100 MOVE SPACE TO SIZE-ERR2. NC1774.2 +203200 MOVE SPACE TO SIZE-ERR3. NC1774.2 +203300 MOVE SPACE TO SIZE-ERR4. NC1774.2 +203400 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +203500 ADD-TEST-F2-39-0. NC1774.2 +203600 ADD A12THREES-DS-06V06 NC1774.2 +203700 333333 NC1774.2 +203800 A06THREES-DS-03V03 NC1774.2 +203900 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +204000 ON SIZE ERROR NC1774.2 +204100 MOVE "1" TO SIZE-ERR2 NC1774.2 +204200 NOT ON SIZE ERROR NC1774.2 +204300 MOVE "A" TO SIZE-ERR2 NC1774.2 +204400 END-ADD NC1774.2 +204500 MOVE "1" TO WRK-XN-00001. NC1774.2 +204600 GO TO ADD-TEST-F2-39-1. NC1774.2 +204700 ADD-DELETE-F2-39. NC1774.2 +204800 PERFORM DE-LETE. NC1774.2 +204900 PERFORM PRINT-DETAIL. NC1774.2 +205000 GO TO ADD-INIT-F2-40. NC1774.2 +205100 ADD-TEST-F2-39-1. NC1774.2 +205200 MOVE "ADD-TEST-F2-39-1" TO PAR-NAME. NC1774.2 +205300 IF SIZE-ERR2 = "A" NC1774.2 +205400 PERFORM PASS NC1774.2 +205500 PERFORM PRINT-DETAIL NC1774.2 +205600 ELSE NC1774.2 +205700 MOVE "A" TO CORRECT-X NC1774.2 +205800 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +205900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +206000 TO RE-MARK NC1774.2 +206100 PERFORM FAIL NC1774.2 +206200 PERFORM PRINT-DETAIL. NC1774.2 +206300 ADD 1 TO REC-CT. NC1774.2 +206400 ADD-TEST-F2-39-2. NC1774.2 +206500 MOVE "ADD-TEST-F2-39-2" TO PAR-NAME. NC1774.2 +206600 IF WRK-XN-00001 = "1" NC1774.2 +206700 PERFORM PASS NC1774.2 +206800 PERFORM PRINT-DETAIL NC1774.2 +206900 ELSE NC1774.2 +207000 MOVE "1" TO CORRECT-X NC1774.2 +207100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +207200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +207300 PERFORM FAIL NC1774.2 +207400 PERFORM PRINT-DETAIL. NC1774.2 +207500 ADD 1 TO REC-CT. NC1774.2 +207600 ADD-TEST-F2-39-3. NC1774.2 +207700 MOVE "ADD-TEST-F2-39-3" TO PAR-NAME. NC1774.2 +207800 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +207900 PERFORM PASS NC1774.2 +208000 PERFORM PRINT-DETAIL NC1774.2 +208100 ELSE NC1774.2 +208200 MOVE 666999.666333 TO CORRECT-N NC1774.2 +208300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +208400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +208500 TO RE-MARK NC1774.2 +208600 PERFORM FAIL NC1774.2 +208700 PERFORM PRINT-DETAIL. NC1774.2 +208800* NC1774.2 +208900 ADD-INIT-F2-40. NC1774.2 +209000 MOVE "VI-73 6.6.2" TO ANSI-REFERENCE. NC1774.2 +209100* ==--> OPTIONAL WORD "TO" <--== NC1774.2 +209200 MOVE ZERO TO WRK-DS-09V09. NC1774.2 +209300 ADD-TEST-F2-40-0. NC1774.2 +209400 ADD A06THREES-DS-03V03 NC1774.2 +209500 TO A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1774.2 +209600 ADD-TEST-F2-40-1. NC1774.2 +209700 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1774.2 +209800 PERFORM PASS GO TO ADD-WRITE-F2-40. NC1774.2 +209900 GO TO ADD-FAIL-F2-40. NC1774.2 +210000 ADD-DELETE-F2-40. NC1774.2 +210100 PERFORM DE-LETE. NC1774.2 +210200 GO TO ADD-WRITE-F2-40. NC1774.2 +210300 ADD-FAIL-F2-40. NC1774.2 +210400 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1774.2 +210500 MOVE 000333666.666333000 TO CORRECT-N. NC1774.2 +210600 PERFORM FAIL. NC1774.2 +210700 ADD-WRITE-F2-40. NC1774.2 +210800 MOVE "ADD-TEST-F2-40" TO PAR-NAME. NC1774.2 +210900 PERFORM PRINT-DETAIL. NC1774.2 +211000* NC1774.2 +211100 ADD-INIT-F2-41. NC1774.2 +211200 MOVE "VI-73 6.6.2" TO ANSI-REFERENCE. NC1774.2 +211300* ==--> OPTIONAL WORD "TO" <--== NC1774.2 +211400 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +211500 ADD-TEST-F2-41-0. NC1774.2 +211600 ADD A05ONES-DS-05V00 NC1774.2 +211700 A05ONES-DS-00V05 NC1774.2 +211800 A12THREES-DS-06V06 NC1774.2 +211900 TO A06THREES-DS-03V03 GIVING WRK-DS-06V06. NC1774.2 +212000 ADD-TEST-F2-41-1. NC1774.2 +212100 IF WRK-DS-06V06 EQUAL TO 344777.777443 NC1774.2 +212200 PERFORM PASS GO TO ADD-WRITE-F2-41. NC1774.2 +212300 GO TO ADD-FAIL-F2-41. NC1774.2 +212400 ADD-DELETE-F2-41. NC1774.2 +212500 PERFORM DE-LETE. NC1774.2 +212600 GO TO ADD-WRITE-F2-41. NC1774.2 +212700 ADD-FAIL-F2-41. NC1774.2 +212800 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +212900 MOVE 344777.777443 TO CORRECT-N. NC1774.2 +213000 PERFORM FAIL. NC1774.2 +213100 ADD-WRITE-F2-41. NC1774.2 +213200 MOVE "ADD-TEST-F2-41" TO PAR-NAME. NC1774.2 +213300 PERFORM PRINT-DETAIL. NC1774.2 +213400* NC1774.2 +213500 CCVS-EXIT SECTION. NC1774.2 +213600 CCVS-999999. NC1774.2 +213700 GO TO CLOSE-FILES. NC1774.2 +*END-OF,NC177A +*HEADER,COBOL,NC201A +000100 IDENTIFICATION DIVISION. NC2014.2 +000200 PROGRAM-ID. NC2014.2 +000300 NC201A. NC2014.2 +000400**************************************************************** NC2014.2 +000500* * NC2014.2 +000600* VALIDATION FOR:- * NC2014.2 +000700* * NC2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +000900* * NC2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2014.2 +001100* * NC2014.2 +001200**************************************************************** NC2014.2 +001300* * NC2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2014.2 +001500* * NC2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2014.2 +001900* * NC2014.2 +002000**************************************************************** NC2014.2 +002100* PROGRAM NC201A TESTS FORMAT 3 AND 4 OF THE "PERFORM" NC2014.2 +002200* STATEMENT. NC2014.2 +002300* A VARIETY OF QUALIFIED DATA-NAMES AND CONDITION-NAMES NC2014.2 +002400* ARE USED. NC2014.2 +002500* NC2014.2 +002600* NC2014.2 +002700 NC2014.2 +002800 ENVIRONMENT DIVISION. NC2014.2 +002900 CONFIGURATION SECTION. NC2014.2 +003000 SOURCE-COMPUTER. NC2014.2 +003100 XXXXX082. NC2014.2 +003200 OBJECT-COMPUTER. NC2014.2 +003300 XXXXX083. NC2014.2 +003400 INPUT-OUTPUT SECTION. NC2014.2 +003500 FILE-CONTROL. NC2014.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2014.2 +003700 XXXXX055. NC2014.2 +003800 DATA DIVISION. NC2014.2 +003900 FILE SECTION. NC2014.2 +004000 FD PRINT-FILE. NC2014.2 +004100 01 PRINT-REC PICTURE X(120). NC2014.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2014.2 +004300 WORKING-STORAGE SECTION. NC2014.2 +004400 01 WRK-DU-2V1-1 PIC 99V9 VALUE ZERO. NC2014.2 +004500 01 WRK-DU-0V1-1 PIC V9 VALUE .1. NC2014.2 +004600 01 WRK-DU-2V1-2 PIC 99V9 VALUE 0.1. NC2014.2 +004700 01 WRK-DU-2V1-3 PIC 99V9 VALUE 11.1. NC2014.2 +004800 01 WRK-DU-1V0-1 PIC 9 VALUE 1. NC2014.2 +004900 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2014.2 +005000 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2014.2 +005100 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2014.2 +005200 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2014.2 +005300 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2014.2 +005400 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2014.2 +005500 01 COUNT-DU-6V0 PIC 9(6). NC2014.2 +005600 77 SMALL-VALU PICTURE 99 VALUE 7. NC2014.2 +005700 77 SMALLER-VALU PICTURE 99 VALUE 6. NC2014.2 +005800 77 SMALLEST-VALU PICTURE 99 VALUE 5. NC2014.2 +005900 77 EVEN-SMALLER PICTURE 99 VALUE 1. NC2014.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC2014.2 +006100 88 TEST-2NUC-COND-99 VALUE 99. NC2014.2 +006200 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2014.2 +006300 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2014.2 +006400 PICTURE S9(12). NC2014.2 +006500 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2014.2 +006600 77 WRK-DS-01V00 PICTURE S9. NC2014.2 +006700 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2014.2 +006800 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2014.2 +006900 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2014.2 +007000 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2014.2 +007100 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2014.2 +007200 77 WRK-XN-00001 PICTURE X. NC2014.2 +007300 77 WRK-XN-00005 PICTURE X(5). NC2014.2 +007400 77 TWO PICTURE 9 VALUE 2. NC2014.2 +007500 77 THREE PICTURE 9 VALUE 3. NC2014.2 +007600 77 SEVEN PICTURE 9 VALUE 7. NC2014.2 +007700 77 NINE PICTURE 9 VALUE 9. NC2014.2 +007800 77 TEN PICTURE 99 VALUE 10. NC2014.2 +007900 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2014.2 +008000 77 XRAY PICTURE IS X. NC2014.2 +008100 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2014.2 +008200 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2014.2 +008300 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2014.2 +008400 77 IF-D4 PICTURE X(15) VALUE " ". NC2014.2 +008500 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2014.2 +008600 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2014.2 +008700 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2014.2 +008800 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2014.2 +008900 77 IF-D9 PICTURE X(3) VALUE "123". NC2014.2 +009000 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2014.2 +009100 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2014.2 +009200 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2014.2 +009300 77 IF-D15 PICTURE S999PP VALUE 12300. NC2014.2 +009400 77 IF-D16 PICTURE PP99 VALUE .0012. NC2014.2 +009500 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2014.2 +009600 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2014.2 +009700 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2014.2 +009800 77 IF-D23 PICTURE $9,9B9.90+. NC2014.2 +009900 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". NC2014.2 +010000 77 IF-D25 PICTURE ABABX0A. NC2014.2 +010100 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2014.2 +010200 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2014.2 +010300 USAGE IS COMPUTATIONAL. NC2014.2 +010400 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2014.2 +010500 77 IF-D31 PICTURE S9(6) VALUE -123. NC2014.2 +010600 77 IF-D32 PICTURE S9(4)V99. NC2014.2 +010700 88 A VALUE 1. NC2014.2 +010800 88 B VALUES ARE 2 THRU 4. NC2014.2 +010900 88 C VALUE IS ZERO. NC2014.2 +011000 88 D VALUE IS +12.34. NC2014.2 +011100 88 E VALUE IS .01, .11, .21 .81. NC2014.2 +011200 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2014.2 +011300 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2014.2 +011400 77 IF-D33 PICTURE X(4). NC2014.2 +011500 88 B VALUE QUOTE. NC2014.2 +011600 88 C VALUE SPACE. NC2014.2 +011700 88 D VALUE ALL "BAC". NC2014.2 +011800 77 IF-D34 PICTURE A(4). NC2014.2 +011900 88 B VALUE "A A ". NC2014.2 +012000 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2014.2 +012100 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2014.2 +012200 77 CCON-1 PICTURE 99 VALUE 11. NC2014.2 +012300 77 CCON-2 PICTURE 99 VALUE 12. NC2014.2 +012400 77 CCON-3 PICTURE 99 VALUE 13. NC2014.2 +012500 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. NC2014.2 +012600 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. NC2014.2 +012700 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. NC2014.2 +012800 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.NC2014.2 +012900 77 START-POINT PICTURE 9(6) COMPUTATIONAL. NC2014.2 +013000 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. NC2014.2 +013100 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. NC2014.2 +013200 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. NC2014.2 +013300 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. NC2014.2 +013400 77 PFM-12-COUNTER PICTURE 999 VALUE 100. NC2014.2 +013500 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. NC2014.2 +013600 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. NC2014.2 +013700 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2014.2 +013800 01 IF-TABLE. NC2014.2 +013900 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2014.2 +014000 01 QUOTE-DATA. NC2014.2 +014100 02 QU-1 PICTURE X(3) VALUE "123". NC2014.2 +014200 02 QU-2 PICTURE X VALUE QUOTE. NC2014.2 +014300 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2014.2 +014400 01 IF-D10. NC2014.2 +014500 02 D1 PICTURE X(2) VALUE "01". NC2014.2 +014600 02 D2 PICTURE X(2) VALUE "23". NC2014.2 +014700 02 D3. NC2014.2 +014800 03 D4 PICTURE X(4) VALUE "4567". NC2014.2 +014900 03 D5 PICTURE X(4) VALUE "8912". NC2014.2 +015000 01 IF-D12. NC2014.2 +015100 02 D1 PICTURE X(3) VALUE "ABC". NC2014.2 +015200 02 D2. NC2014.2 +015300 03 D3. NC2014.2 +015400 04 D4 PICTURE XX VALUE "DE". NC2014.2 +015500 04 D5 PICTURE X VALUE "F". NC2014.2 +015600 01 IF-D20. NC2014.2 +015700 02 FILLER PICTURE 9(5) VALUE ZERO. NC2014.2 +015800 02 D1 PICTURE 9(2) VALUE 12. NC2014.2 +015900 02 D2 PICTURE 9 VALUE 3. NC2014.2 +016000 02 D3 PICTURE 9(2) VALUE 45. NC2014.2 +016100 01 IF-D21. NC2014.2 +016200 02 D1 PICTURE 9(5) VALUE ZEROS. NC2014.2 +016300 02 D2 PICTURE 9(5) VALUE 12345. NC2014.2 +016400 01 IF-D22. NC2014.2 +016500 02 D1 PICTURE A(2) VALUE "AB". NC2014.2 +016600 02 D2 PICTURE A(4) VALUE "CDEF". NC2014.2 +016700 01 IF-D35. NC2014.2 +016800 02 AA PICTURE X(2). NC2014.2 +016900 88 A1 VALUE "AA". NC2014.2 +017000 88 A2 VALUE "AB". NC2014.2 +017100 02 BB PICTURE IS X(2). NC2014.2 +017200 88 B1 VALUE "CC". NC2014.2 +017300 88 B2 VALUE "CD". NC2014.2 +017400 02 BB-2 REDEFINES BB. NC2014.2 +017500 03 AAA PICTURE X. NC2014.2 +017600 88 AA1 VALUE "A". NC2014.2 +017700 88 AA2 VALUE "C". NC2014.2 +017800 03 BBB PICTURE X. NC2014.2 +017900 88 BB1 VALUE "B". NC2014.2 +018000 88 BB2 VALUE "D". NC2014.2 +018100 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2014.2 +018200- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2014.2 +018300- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2014.2 +018400 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2014.2 +018500 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2014.2 +018600 88 IF-D40A VALUE ZERO THRU 10000. NC2014.2 +018700 88 IF-D40B VALUE 10001 THRU 99999. NC2014.2 +018800 88 IF-D40C VALUE 99999. NC2014.2 +018900 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2014.2 +019000 01 PERFORM2 PICTURE S999 VALUE 20. NC2014.2 +019100 01 PERFORM3 PICTURE 9 VALUE 5. NC2014.2 +019200 01 PERFORM4 PICTURE S99V9. NC2014.2 +019300 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2014.2 +019400 01 PERFORM6 PICTURE 99V9. NC2014.2 +019500 01 PERFORM7. NC2014.2 +019600 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2014.2 +019700 01 PERFORM9 PICTURE 9 VALUE 3. NC2014.2 +019800 01 PERFORM10 PICTURE S9 VALUE -1. NC2014.2 +019900 01 PERFORM11 PICTURE 99 VALUE 6. NC2014.2 +020000 01 PERFORM12. NC2014.2 +020100 02 PERFORM13 OCCURS 4 TIMES. NC2014.2 +020200 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2014.2 +020300 03 PERFORM15 OCCURS 10 TIMES. NC2014.2 +020400 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2014.2 +020500 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. NC2014.2 +020600 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. NC2014.2 +020700 01 PERFORM-KEY PICTURE 9. NC2014.2 +020800 01 PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +020900 03 PFM71 OCCURS 2. NC2014.2 +021000 05 PFM72 OCCURS 2. NC2014.2 +021100 07 PFM73 OCCURS 2. NC2014.2 +021200 09 PFM74 OCCURS 2. NC2014.2 +021300 11 PFM75 OCCURS 2. NC2014.2 +021400 13 PFM76 OCCURS 2. NC2014.2 +021500 15 PFM77 OCCURS 2. NC2014.2 +021600 17 PFM77-1 PIC X. NC2014.2 +021700 01 S1 PIC S9(5) COMP. NC2014.2 +021800 01 S2 PIC S9(5) COMP. NC2014.2 +021900 01 S3 PIC S9(5) COMP. NC2014.2 +022000 01 S4 PIC S9(5) COMP. NC2014.2 +022100 01 S5 PIC S9(5) COMP. NC2014.2 +022200 01 S6 PIC S9(5) COMP. NC2014.2 +022300 01 S7 PIC S9(5) COMP. NC2014.2 +022400 01 PFM-7-TOT PIC S9(5) COMP. NC2014.2 +022500 01 PFM-F4-23-TOT PIC S9(5) COMP. NC2014.2 +022600 01 PFM-A1 PIC S9(5) COMP. NC2014.2 +022700 01 PFM-B1 PIC S9(5) COMP. NC2014.2 +022800 01 FILLER-A. NC2014.2 +022900 03 PFM-F4-24-A PIC S9(3) COMP OCCURS 10. NC2014.2 +023000 01 FILLER-B. NC2014.2 +023100 03 PFM-F4-24-B PIC S9(3) COMP OCCURS 10. NC2014.2 +023200 01 FILLER-C. NC2014.2 +023300 03 PFM-F4-24-C PIC S9(3) COMP OCCURS 10. NC2014.2 +023400 01 RECEIVING-TABLE. NC2014.2 +023500 03 TBL-ELEMEN-A. NC2014.2 +023600 05 TBL-ELEMEN-B PICTURE X(18). NC2014.2 +023700 05 TBL-ELEMEN-C PICTURE X(18). NC2014.2 +023800 03 TBL-ELEMEN-D. NC2014.2 +023900 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2014.2 +024000 01 LITERAL-SPLITTER. NC2014.2 +024100 02 PART1 PICTURE X(20). NC2014.2 +024200 02 PART2 PICTURE X(20). NC2014.2 +024300 02 PART3 PICTURE X(20). NC2014.2 +024400 02 PART4 PICTURE X(20). NC2014.2 +024500 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2014.2 +024600 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2014.2 +024700 01 GRP-FOR-88-LEVELS. NC2014.2 +024800 03 WRK-DS-02V00-COND PICTURE 99. NC2014.2 +024900 88 COND-1 VALUE IS 01 THRU 05. NC2014.2 +025000 88 COND-2 VALUES ARE 06 THRU 10 NC2014.2 +025100 16 THRU 20 00. NC2014.2 +025200 88 COND-3 VALUES 11 THRU 15. NC2014.2 +025300 01 GRP-MOVE-CONSTANTS. NC2014.2 +025400 03 GRP-GROUP-MOVE-FROM. NC2014.2 +025500 04 GRP-ALPHABETIC. NC2014.2 +025600 05 ALPHABET-AN-00026 PICTURE A(26) NC2014.2 +025700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2014.2 +025800 04 GRP-NUMERIC. NC2014.2 +025900 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2014.2 +026000 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2014.2 +026100 PICTURE 9(6)V9999. NC2014.2 +026200 04 GRP-ALPHANUMERIC. NC2014.2 +026300 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2014.2 +026400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=$,;.()/* 0123456789". NC2014.2 +026500 05 FILLER PICTURE X VALUE QUOTE. NC2014.2 +026600 01 GRP-FOR-2N058. NC2014.2 +026700 02 SUB-GRP-FOR-2N058-A. NC2014.2 +026800 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2014.2 +026900 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2014.2 +027000 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2014.2 +027100 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2014.2 +027200 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2014.2 +027300 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2014.2 +027400 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2014.2 +027500 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2014.2 +027600 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2014.2 +027700 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2014.2 +027800 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2014.2 +027900 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2014.2 +028000 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2014.2 +028100 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2014.2 +028200 02 SUB-GRP-FOR-2N058-B. NC2014.2 +028300 03 SUB-SUB-BA. NC2014.2 +028400 04 ELEM-FOR-2N058-A PICTURE 999. NC2014.2 +028500 04 ELEM-FOR-2N058-B PICTURE XXX. NC2014.2 +028600 04 ELEM-FOR-2N058-C PICTURE XXX. NC2014.2 +028700 04 ELEM-FOR-2N058-D PICTURE X(6). NC2014.2 +028800 03 SUB-SUB-BB. NC2014.2 +028900 04 ELEM-FOR-2N058-E PICTURE XXX. NC2014.2 +029000 04 ELEM-FOR-2N058-F PICTURE XXX. NC2014.2 +029100 04 ELEM-FOR-2N058-G PICTURE XXX. NC2014.2 +029200 04 ELEM-FOR-2N058-H PICTURE 999. NC2014.2 +029300 03 SUB-SUB-BC. NC2014.2 +029400 04 ELEM-FOR-2N058-I PICTURE XXX. NC2014.2 +029500 04 ELEM-FOR-2N058-J PICTURE XXX. NC2014.2 +029600 04 ELEM-FOR-2N058-K PICTURE XXX. NC2014.2 +029700 04 ELEM-FOR-2N058-L PICTURE XXX. NC2014.2 +029800 04 ELEM-FOR-2N058-M PICTURE XXX. NC2014.2 +029900 04 ELEM-FOR-2N058-N PICTURE XXX. NC2014.2 +030000 01 CHARACTER-BREAKDOWN-S. NC2014.2 +030100 02 FIRST-20S PICTURE X(20). NC2014.2 +030200 02 SECOND-20S PICTURE X(20). NC2014.2 +030300 02 THIRD-20S PICTURE X(20). NC2014.2 +030400 02 FOURTH-20S PICTURE X(20). NC2014.2 +030500 02 FIFTH-20S PICTURE X(20). NC2014.2 +030600 02 SIXTH-20S PICTURE X(20). NC2014.2 +030700 02 SEVENTH-20S PICTURE X(20). NC2014.2 +030800 02 EIGHTH-20S PICTURE X(20). NC2014.2 +030900 02 NINTH-20S PICTURE X(20). NC2014.2 +031000 02 TENTH-20S PICTURE X(20). NC2014.2 +031100 01 CHARACTER-BREAKDOWN-R. NC2014.2 +031200 02 FIRST-20R PICTURE X(20). NC2014.2 +031300 02 SECOND-20R PICTURE X(20). NC2014.2 +031400 02 THIRD-20R PICTURE X(20). NC2014.2 +031500 02 FOURTH-20R PICTURE X(20). NC2014.2 +031600 02 FIFTH-20R PICTURE X(20). NC2014.2 +031700 02 SIXTH-20R PICTURE X(20). NC2014.2 +031800 02 SEVENTH-20R PICTURE X(20). NC2014.2 +031900 02 EIGHTH-20R PICTURE X(20). NC2014.2 +032000 02 NINTH-20R PICTURE X(20). NC2014.2 +032100 02 TENTH-20R PICTURE X(20). NC2014.2 +032200 01 TABLE-80. NC2014.2 +032300 02 ELMT OCCURS 3 TIMES PIC 9. NC2014.2 +032400 88 A80 VALUES ARE ZERO THRU 7. NC2014.2 +032500 88 B80 VALUE 8. NC2014.2 +032600 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2014.2 +032700 NC2014.2 +032800 01 TABLE-86. NC2014.2 +032900 88 A86 VALUE "ABC". NC2014.2 +033000 88 B86 VALUE "ABCABC". NC2014.2 +033100 88 C86 VALUE " ABC". NC2014.2 +033200 02 DATANAME-86 PIC XXX VALUE "ABC". NC2014.2 +033300 02 DNAME-86. NC2014.2 +033400 03 FILLER PIC X VALUE "A". NC2014.2 +033500 03 FILLER PIC X VALUE "B". NC2014.2 +033600 03 FILLER PIC X VALUE "C". NC2014.2 +033700 01 FIGCON-DATA. NC2014.2 +033800 02 SPACE-X PICTURE X(10) VALUE " ". NC2014.2 +033900 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2014.2 +034000 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2014.2 +034100 02 ABC PICTURE XXX VALUE "ABC". NC2014.2 +034200 02 ONE23 PICTURE 9999 VALUE 123. NC2014.2 +034300 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2014.2 +034400 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2014.2 +034500 01 TEST-RESULTS. NC2014.2 +034600 02 FILLER PIC X VALUE SPACE. NC2014.2 +034700 02 FEATURE PIC X(20) VALUE SPACE. NC2014.2 +034800 02 FILLER PIC X VALUE SPACE. NC2014.2 +034900 02 P-OR-F PIC X(5) VALUE SPACE. NC2014.2 +035000 02 FILLER PIC X VALUE SPACE. NC2014.2 +035100 02 PAR-NAME. NC2014.2 +035200 03 FILLER PIC X(19) VALUE SPACE. NC2014.2 +035300 03 PARDOT-X PIC X VALUE SPACE. NC2014.2 +035400 03 DOTVALUE PIC 99 VALUE ZERO. NC2014.2 +035500 02 FILLER PIC X(8) VALUE SPACE. NC2014.2 +035600 02 RE-MARK PIC X(61). NC2014.2 +035700 01 TEST-COMPUTED. NC2014.2 +035800 02 FILLER PIC X(30) VALUE SPACE. NC2014.2 +035900 02 FILLER PIC X(17) VALUE NC2014.2 +036000 " COMPUTED=". NC2014.2 +036100 02 COMPUTED-X. NC2014.2 +036200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2014.2 +036300 03 COMPUTED-N REDEFINES COMPUTED-A NC2014.2 +036400 PIC -9(9).9(9). NC2014.2 +036500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2014.2 +036600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2014.2 +036700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2014.2 +036800 03 CM-18V0 REDEFINES COMPUTED-A. NC2014.2 +036900 04 COMPUTED-18V0 PIC -9(18). NC2014.2 +037000 04 FILLER PIC X. NC2014.2 +037100 03 FILLER PIC X(50) VALUE SPACE. NC2014.2 +037200 01 TEST-CORRECT. NC2014.2 +037300 02 FILLER PIC X(30) VALUE SPACE. NC2014.2 +037400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2014.2 +037500 02 CORRECT-X. NC2014.2 +037600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2014.2 +037700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2014.2 +037800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2014.2 +037900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2014.2 +038000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2014.2 +038100 03 CR-18V0 REDEFINES CORRECT-A. NC2014.2 +038200 04 CORRECT-18V0 PIC -9(18). NC2014.2 +038300 04 FILLER PIC X. NC2014.2 +038400 03 FILLER PIC X(2) VALUE SPACE. NC2014.2 +038500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2014.2 +038600 01 CCVS-C-1. NC2014.2 +038700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2014.2 +038800- "SS PARAGRAPH-NAME NC2014.2 +038900- " REMARKS". NC2014.2 +039000 02 FILLER PIC X(20) VALUE SPACE. NC2014.2 +039100 01 CCVS-C-2. NC2014.2 +039200 02 FILLER PIC X VALUE SPACE. NC2014.2 +039300 02 FILLER PIC X(6) VALUE "TESTED". NC2014.2 +039400 02 FILLER PIC X(15) VALUE SPACE. NC2014.2 +039500 02 FILLER PIC X(4) VALUE "FAIL". NC2014.2 +039600 02 FILLER PIC X(94) VALUE SPACE. NC2014.2 +039700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2014.2 +039800 01 REC-CT PIC 99 VALUE ZERO. NC2014.2 +039900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2014.2 +040400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2014.2 +040500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2014.2 +040600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2014.2 +040700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2014.2 +040800 01 CCVS-H-1. NC2014.2 +040900 02 FILLER PIC X(39) VALUE SPACES. NC2014.2 +041000 02 FILLER PIC X(42) VALUE NC2014.2 +041100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2014.2 +041200 02 FILLER PIC X(39) VALUE SPACES. NC2014.2 +041300 01 CCVS-H-2A. NC2014.2 +041400 02 FILLER PIC X(40) VALUE SPACE. NC2014.2 +041500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2014.2 +041600 02 FILLER PIC XXXX VALUE NC2014.2 +041700 "4.2 ". NC2014.2 +041800 02 FILLER PIC X(28) VALUE NC2014.2 +041900 " COPY - NOT FOR DISTRIBUTION". NC2014.2 +042000 02 FILLER PIC X(41) VALUE SPACE. NC2014.2 +042100 NC2014.2 +042200 01 CCVS-H-2B. NC2014.2 +042300 02 FILLER PIC X(15) VALUE NC2014.2 +042400 "TEST RESULT OF ". NC2014.2 +042500 02 TEST-ID PIC X(9). NC2014.2 +042600 02 FILLER PIC X(4) VALUE NC2014.2 +042700 " IN ". NC2014.2 +042800 02 FILLER PIC X(12) VALUE NC2014.2 +042900 " HIGH ". NC2014.2 +043000 02 FILLER PIC X(22) VALUE NC2014.2 +043100 " LEVEL VALIDATION FOR ". NC2014.2 +043200 02 FILLER PIC X(58) VALUE NC2014.2 +043300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +043400 01 CCVS-H-3. NC2014.2 +043500 02 FILLER PIC X(34) VALUE NC2014.2 +043600 " FOR OFFICIAL USE ONLY ". NC2014.2 +043700 02 FILLER PIC X(58) VALUE NC2014.2 +043800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2014.2 +043900 02 FILLER PIC X(28) VALUE NC2014.2 +044000 " COPYRIGHT 1985 ". NC2014.2 +044100 01 CCVS-E-1. NC2014.2 +044200 02 FILLER PIC X(52) VALUE SPACE. NC2014.2 +044300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2014.2 +044400 02 ID-AGAIN PIC X(9). NC2014.2 +044500 02 FILLER PIC X(45) VALUE SPACES. NC2014.2 +044600 01 CCVS-E-2. NC2014.2 +044700 02 FILLER PIC X(31) VALUE SPACE. NC2014.2 +044800 02 FILLER PIC X(21) VALUE SPACE. NC2014.2 +044900 02 CCVS-E-2-2. NC2014.2 +045000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2014.2 +045100 03 FILLER PIC X VALUE SPACE. NC2014.2 +045200 03 ENDER-DESC PIC X(44) VALUE NC2014.2 +045300 "ERRORS ENCOUNTERED". NC2014.2 +045400 01 CCVS-E-3. NC2014.2 +045500 02 FILLER PIC X(22) VALUE NC2014.2 +045600 " FOR OFFICIAL USE ONLY". NC2014.2 +045700 02 FILLER PIC X(12) VALUE SPACE. NC2014.2 +045800 02 FILLER PIC X(58) VALUE NC2014.2 +045900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +046000 02 FILLER PIC X(13) VALUE SPACE. NC2014.2 +046100 02 FILLER PIC X(15) VALUE NC2014.2 +046200 " COPYRIGHT 1985". NC2014.2 +046300 01 CCVS-E-4. NC2014.2 +046400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2014.2 +046500 02 FILLER PIC X(4) VALUE " OF ". NC2014.2 +046600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2014.2 +046700 02 FILLER PIC X(40) VALUE NC2014.2 +046800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2014.2 +046900 01 XXINFO. NC2014.2 +047000 02 FILLER PIC X(19) VALUE NC2014.2 +047100 "*** INFORMATION ***". NC2014.2 +047200 02 INFO-TEXT. NC2014.2 +047300 04 FILLER PIC X(8) VALUE SPACE. NC2014.2 +047400 04 XXCOMPUTED PIC X(20). NC2014.2 +047500 04 FILLER PIC X(5) VALUE SPACE. NC2014.2 +047600 04 XXCORRECT PIC X(20). NC2014.2 +047700 02 INF-ANSI-REFERENCE PIC X(48). NC2014.2 +047800 01 HYPHEN-LINE. NC2014.2 +047900 02 FILLER PIC IS X VALUE IS SPACE. NC2014.2 +048000 02 FILLER PIC IS X(65) VALUE IS "************************NC2014.2 +048100- "*****************************************". NC2014.2 +048200 02 FILLER PIC IS X(54) VALUE IS "************************NC2014.2 +048300- "******************************". NC2014.2 +048400 01 CCVS-PGM-ID PIC X(9) VALUE NC2014.2 +048500 "NC201A". NC2014.2 +048600 PROCEDURE DIVISION. NC2014.2 +048700 CCVS1 SECTION. NC2014.2 +048800 OPEN-FILES. NC2014.2 +048900 OPEN OUTPUT PRINT-FILE. NC2014.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2014.2 +049100 MOVE SPACE TO TEST-RESULTS. NC2014.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2014.2 +049300 GO TO CCVS1-EXIT. NC2014.2 +049400 CLOSE-FILES. NC2014.2 +049500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2014.2 +049600 TERMINATE-CCVS. NC2014.2 +049700S EXIT PROGRAM. NC2014.2 +049800STERMINATE-CALL. NC2014.2 +049900 STOP RUN. NC2014.2 +050000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2014.2 +050100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2014.2 +050200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2014.2 +050300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2014.2 +050400 MOVE "****TEST DELETED****" TO RE-MARK. NC2014.2 +050500 PRINT-DETAIL. NC2014.2 +050600 IF REC-CT NOT EQUAL TO ZERO NC2014.2 +050700 MOVE "." TO PARDOT-X NC2014.2 +050800 MOVE REC-CT TO DOTVALUE. NC2014.2 +050900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2014.2 +051000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2014.2 +051100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2014.2 +051200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2014.2 +051300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2014.2 +051400 MOVE SPACE TO CORRECT-X. NC2014.2 +051500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2014.2 +051600 MOVE SPACE TO RE-MARK. NC2014.2 +051700 HEAD-ROUTINE. NC2014.2 +051800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +051900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +052000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2014.2 +052100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2014.2 +052200 COLUMN-NAMES-ROUTINE. NC2014.2 +052300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +052400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +052500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +052600 END-ROUTINE. NC2014.2 +052700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2014.2 +052800 END-RTN-EXIT. NC2014.2 +052900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +053000 END-ROUTINE-1. NC2014.2 +053100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2014.2 +053200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2014.2 +053300 ADD PASS-COUNTER TO ERROR-HOLD. NC2014.2 +053400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2014.2 +053500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2014.2 +053600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2014.2 +053700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2014.2 +053800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2014.2 +053900 END-ROUTINE-12. NC2014.2 +054000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2014.2 +054100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2014.2 +054200 MOVE "NO " TO ERROR-TOTAL NC2014.2 +054300 ELSE NC2014.2 +054400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2014.2 +054500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2014.2 +054600 PERFORM WRITE-LINE. NC2014.2 +054700 END-ROUTINE-13. NC2014.2 +054800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2014.2 +054900 MOVE "NO " TO ERROR-TOTAL ELSE NC2014.2 +055000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2014.2 +055100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2014.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055300 IF INSPECT-COUNTER EQUAL TO ZERO NC2014.2 +055400 MOVE "NO " TO ERROR-TOTAL NC2014.2 +055500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2014.2 +055600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2014.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055900 WRITE-LINE. NC2014.2 +056000 ADD 1 TO RECORD-COUNT. NC2014.2 +056100Y IF RECORD-COUNT GREATER 50 NC2014.2 +056200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2014.2 +056300Y MOVE SPACE TO DUMMY-RECORD NC2014.2 +056400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2014.2 +056500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2014.2 +056600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2014.2 +056700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2014.2 +056800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2014.2 +056900Y MOVE ZERO TO RECORD-COUNT. NC2014.2 +057000 PERFORM WRT-LN. NC2014.2 +057100 WRT-LN. NC2014.2 +057200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2014.2 +057300 MOVE SPACE TO DUMMY-RECORD. NC2014.2 +057400 BLANK-LINE-PRINT. NC2014.2 +057500 PERFORM WRT-LN. NC2014.2 +057600 FAIL-ROUTINE. NC2014.2 +057700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2014.2 +057800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2014.2 +057900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2014.2 +058000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2014.2 +058100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +058200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2014.2 +058300 GO TO FAIL-ROUTINE-EX. NC2014.2 +058400 FAIL-ROUTINE-WRITE. NC2014.2 +058500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2014.2 +058600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2014.2 +058700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2014.2 +058800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2014.2 +058900 FAIL-ROUTINE-EX. EXIT. NC2014.2 +059000 BAIL-OUT. NC2014.2 +059100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2014.2 +059200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2014.2 +059300 BAIL-OUT-WRITE. NC2014.2 +059400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2014.2 +059500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2014.2 +059600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2014.2 +059800 BAIL-OUT-EX. EXIT. NC2014.2 +059900 CCVS1-EXIT. NC2014.2 +060000 EXIT. NC2014.2 +060100 SECT-NC201A-001 SECTION. NC2014.2 +060200 PFM-INIT-F3-1. NC2014.2 +060300 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC2014.2 +060400 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE. NC2014.2 +060500 MOVE "PERFORM UNTIL" TO FEATURE. NC2014.2 +060600 MOVE 1 TO PERFORM2. NC2014.2 +060700 PFM-TEST-F3-0. NC2014.2 +060800 PERFORM PFM-A THRU PFM-AA UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +060900* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +061000* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +061100 PFM-TEST-F3-1. NC2014.2 +061200 IF PERFORM2 EQUAL TO 48 PERFORM PASS NC2014.2 +061300 GO TO PFM-WRITE-F3-1. NC2014.2 +061400 GO TO PFM-FAIL-F3-1. NC2014.2 +061500 PFM-DELETE-F3-1. NC2014.2 +061600 PERFORM DE-LETE. NC2014.2 +061700 GO TO PFM-WRITE-F3-1. NC2014.2 +061800 PFM-FAIL-F3-1. NC2014.2 +061900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +062000 MOVE 48 TO CORRECT-N. NC2014.2 +062100 PERFORM FAIL. NC2014.2 +062200 PFM-WRITE-F3-1. NC2014.2 +062300 PERFORM PRINT-DETAIL. NC2014.2 +062400* NC2014.2 +062500 PFM-INIT-F3-2. NC2014.2 +062600 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC2014.2 +062700 MOVE 50 TO PERFORM2. NC2014.2 +062800* NOTE IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC2014.2 +062900* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-C. NC2014.2 +063000 PFM-TEST-F3-2. NC2014.2 +063100 PERFORM PFM-C UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +063200 IF PERFORM2 EQUAL TO 50 PERFORM PASS NC2014.2 +063300 GO TO PFM-WRITE-F3-2. NC2014.2 +063400 GO TO PFM-FAIL-F3-2. NC2014.2 +063500 PFM-DELETE-F3-2. NC2014.2 +063600 PERFORM DE-LETE. NC2014.2 +063700 GO TO PFM-WRITE-F3-2. NC2014.2 +063800 PFM-FAIL-F3-2. NC2014.2 +063900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +064000 MOVE 50 TO CORRECT-N. NC2014.2 +064100 PERFORM FAIL. NC2014.2 +064200 PFM-WRITE-F3-2. NC2014.2 +064300 PERFORM PRINT-DETAIL. NC2014.2 +064400* NC2014.2 +064500 PFM-INIT-F4-1. NC2014.2 +064600 MOVE "PFM-TEST-F4-1" TO PAR-NAME. NC2014.2 +064700 MOVE "PERFORM VARYING" TO FEATURE. NC2014.2 +064800 PFM-TEST-F4-1. NC2014.2 +064900 PERFORM PFM-E VARYING PERFORM4 FROM PERFORM5 BY -0.2 NC2014.2 +065000 UNTIL PERFORM4 LESS THAN 9.0. NC2014.2 +065100 IF PERFORM4 EQUAL TO 8.8 AND PERFORM6 EQUAL TO 12.5 NC2014.2 +065200 PERFORM PASS NC2014.2 +065300 GO TO PFM-WRITE-F4-1. NC2014.2 +065400 GO TO PFM-FAIL-F4-1. NC2014.2 +065500 PFM-DELETE-F4-1. NC2014.2 +065600 PERFORM PRINT-DETAIL. NC2014.2 +065700 GO TO PFM-WRITE-F4-1. NC2014.2 +065800 PFM-FAIL-F4-1. NC2014.2 +065900 MOVE PERFORM4 TO COMPUTED-N. NC2014.2 +066000 MOVE 8.8 TO CORRECT-N. NC2014.2 +066100 PERFORM FAIL. NC2014.2 +066200 PERFORM PRINT-DETAIL. NC2014.2 +066300 MOVE SPACE TO P-OR-F. NC2014.2 +066400 MOVE PERFORM6 TO COMPUTED-N. NC2014.2 +066500 MOVE 12.5 TO CORRECT-N. NC2014.2 +066600 PFM-WRITE-F4-1. NC2014.2 +066700 PERFORM PRINT-DETAIL. NC2014.2 +066800* NC2014.2 +066900 PFM-INIT-F4-2. NC2014.2 +067000 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +067100 MOVE 5.5 TO PERFORM4. NC2014.2 +067200 MOVE 5.5 TO PERFORM8 (7). NC2014.2 +067300 PFM-TEST-F4-2. NC2014.2 +067400* NOTE IN THIS TEST ONE SUBSCRIPT IS VARIED. NC2014.2 +067500* NOTE THIS ALSO TESTS THAT WHEN THE CONDITION IS TRUE, NC2014.2 +067600* CONTROL FALLS THRU AND THE PROCEDURE IS NOT EXECUTED. NC2014.2 +067700 PERFORM PFM-G VARYING PERFORM3 FROM 1 BY 2 UNTIL NC2014.2 +067800 PERFORM3 GREATER THAN 5. NC2014.2 +067900 IF PERFORM8 (1) EQUAL TO 13.5 AND PERFORM8 (3) EQUAL TO 13.8 NC2014.2 +068000 AND PERFORM8 (5) EQUAL TO 14.1 AND PERFORM8 (7) EQUAL TO NC2014.2 +068100 5.5 AND PERFORM3 EQUAL TO 7 NC2014.2 +068200 PERFORM PASS NC2014.2 +068300 GO TO PFM-WRITE-F4-2. NC2014.2 +068400* NOTE THE OCCURS CLAUSE IS NEEDED IN THE DATA DESCRIPTION NC2014.2 +068500* FOR THESE PERFORM TESTS --- MORE EXHAUSTIVE TESTS OF THE NC2014.2 +068600* OCCURS CLAUSE CAN BE FOUND IN THE TABLE HANDLING TESTS. NC2014.2 +068700 GO TO PFM-FAIL-F4-2. NC2014.2 +068800 PFM-DELETE-F4-2. NC2014.2 +068900 PERFORM DE-LETE. NC2014.2 +069000 GO TO PFM-WRITE-F4-2. NC2014.2 +069100 PFM-FAIL-F4-2. NC2014.2 +069200 MOVE PERFORM8 (1) TO COMPUTED-N. NC2014.2 +069300 MOVE 13.5 TO CORRECT-N. NC2014.2 +069400 PERFORM FAIL. NC2014.2 +069500 PERFORM PRINT-DETAIL. NC2014.2 +069600 MOVE SPACE TO P-OR-F. NC2014.2 +069700 MOVE PERFORM8 (3) TO COMPUTED-N. NC2014.2 +069800 MOVE 13.8 TO CORRECT-N. NC2014.2 +069900 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070000 PERFORM PRINT-DETAIL. NC2014.2 +070100 MOVE PERFORM8 (5) TO COMPUTED-N. NC2014.2 +070200 MOVE 14.1 TO CORRECT-N. NC2014.2 +070300 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070400 PERFORM PRINT-DETAIL. NC2014.2 +070500 MOVE PERFORM8 (7) TO COMPUTED-N. NC2014.2 +070600 MOVE 5.5 TO CORRECT-N. NC2014.2 +070700 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070800 PERFORM PRINT-DETAIL. NC2014.2 +070900 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +071000 MOVE 7 TO CORRECT-N. NC2014.2 +071100 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +071200 PFM-WRITE-F4-2. NC2014.2 +071300 PERFORM PRINT-DETAIL. NC2014.2 +071400* NC2014.2 +071500 PFM-INIT-F4-3. NC2014.2 +071600 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +071700 MOVE 1.5 TO PERFORM4. NC2014.2 +071800 PFM-TEST-F4-3. NC2014.2 +071900* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +072000 PERFORM PFM-I THRU PFM-J VARYING PERFORM3 NC2014.2 +072100 FROM PERFORM9 BY PERFORM10 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +072200 AFTER PERFORM2 FROM 2 BY PERFORM11 UNTIL PERFORM2 NC2014.2 +072300 GREATER THAN 20. NC2014.2 +072400 IF PERFORM14 (3, 2) EQUAL TO 15.0 AND PERFORM14 (3, 8) NC2014.2 +072500 EQUAL TO 20.0 AND PERFORM14 (3, 14) EQUAL TO 25.0 NC2014.2 +072600 AND PERFORM14 (3, 20) EQUAL TO 30.0 AND PERFORM14 (2, 2) NC2014.2 +072700 EQUAL TO 35.0 MOVE "A" TO XRAY. NC2014.2 +072800 IF PERFORM14 (2, 8) EQUAL TO 40.0 AND NC2014.2 +072900 PERFORM14 (2, 14) EQUAL TO 45.0 AND PERFORM14 (2, 20) NC2014.2 +073000 EQUAL TO 50.0 AND PERFORM2 EQUAL TO 2 AND PERFORM3 NC2014.2 +073100 EQUAL TO 1 AND XRAY EQUAL TO "A" PERFORM PASS NC2014.2 +073200 GO TO PFM-WRITE-F4-3. NC2014.2 +073300 GO TO PFM-FAIL-F4-3. NC2014.2 +073400 PFM-DELETE-F4-3. NC2014.2 +073500 PERFORM DE-LETE. NC2014.2 +073600 GO TO PFM-WRITE-F4-3. NC2014.2 +073700 PFM-FAIL-F4-3. NC2014.2 +073800 MOVE PERFORM14 (3, 2) TO COMPUTED-N. NC2014.2 +073900 MOVE 15.0 TO CORRECT-N. NC2014.2 +074000 PERFORM FAIL. NC2014.2 +074100 PERFORM PRINT-DETAIL. NC2014.2 +074200 MOVE SPACE TO P-OR-F. NC2014.2 +074300 MOVE PERFORM14 (3, 8) TO COMPUTED-N. NC2014.2 +074400 MOVE 20.0 TO CORRECT-N. NC2014.2 +074500 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +074600 PERFORM PRINT-DETAIL. NC2014.2 +074700 MOVE PERFORM14 (3, 14) TO COMPUTED-N. NC2014.2 +074800 MOVE 25.0 TO CORRECT-N. NC2014.2 +074900 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075000 PERFORM PRINT-DETAIL. NC2014.2 +075100 MOVE PERFORM14 (3, 20) TO COMPUTED-N. NC2014.2 +075200 MOVE 30.0 TO CORRECT-N. NC2014.2 +075300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075400 PERFORM PRINT-DETAIL. NC2014.2 +075500 MOVE PERFORM14 (2, 2) TO COMPUTED-N. NC2014.2 +075600 MOVE 35.0 TO CORRECT-N. NC2014.2 +075700 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075800 PERFORM PRINT-DETAIL. NC2014.2 +075900 MOVE PERFORM14 (2, 8) TO COMPUTED-N. NC2014.2 +076000 MOVE 40.0 TO CORRECT-N. NC2014.2 +076100 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +076200 PERFORM PRINT-DETAIL. NC2014.2 +076300 MOVE PERFORM14 (2, 14) TO COMPUTED-N. NC2014.2 +076400 MOVE 45.0 TO CORRECT-N. NC2014.2 +076500 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +076600 PERFORM PRINT-DETAIL. NC2014.2 +076700 MOVE PERFORM14 (2, 20) TO COMPUTED-N. NC2014.2 +076800 MOVE 50.0 TO CORRECT-N. NC2014.2 +076900 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077000 PERFORM PRINT-DETAIL. NC2014.2 +077100 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +077200 MOVE 2 TO CORRECT-N. NC2014.2 +077300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077400 PERFORM PRINT-DETAIL. NC2014.2 +077500 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +077600 MOVE 1 TO CORRECT-N. NC2014.2 +077700 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077800 PERFORM PRINT-DETAIL. NC2014.2 +077900 MOVE XRAY TO COMPUTED-A. NC2014.2 +078000 MOVE "A" TO CORRECT-A. NC2014.2 +078100 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +078200 PFM-WRITE-F4-3. NC2014.2 +078300 PERFORM PRINT-DETAIL. NC2014.2 +078400* NC2014.2 +078500 PFM-INIT-F4-4. NC2014.2 +078600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +078700 MOVE 2 TO PERFORM9. NC2014.2 +078800 MOVE 2 TO PERFORM10. NC2014.2 +078900 PFM-TEST-F4-4. NC2014.2 +079000* NOTE IN THIS TEST THREE SUBSCRIPTS ARE VARIED. NC2014.2 +079100 PERFORM PFM-L VARYING PERFORM3 FROM PERFORM9 BY 2 NC2014.2 +079200 UNTIL PERFORM3 GREATER THAN 4 AFTER PERFORM2 FROM 10 NC2014.2 +079300 BY -5 UNTIL PERFORM2 EQUAL TO 0 AFTER PERFORM11 NC2014.2 +079400 FROM 3 BY PERFORM10 UNTIL PERFORM11 GREATER THAN 5. NC2014.2 +079500 IF PERFORM16 (2, 10, 3) EQUAL TO 5.0 AND PERFORM16 (2, 10, 5)NC2014.2 +079600 EQUAL TO 5.7 AND PERFORM16 (2, 5, 3) EQUAL TO 6.4 AND NC2014.2 +079700 PERFORM16 (2, 5, 5) EQUAL TO 7.1 AND PERFORM16 (4, 10, 3) NC2014.2 +079800 EQUAL TO 7.8 AND PERFORM16 (4, 10, 5) EQUAL TO 8.5 NC2014.2 +079900 MOVE "B" TO XRAY. IF NC2014.2 +080000 PERFORM16 (4, 5, 3) EQUAL TO 9.2 AND PERFORM16 (4, 5, 5) NC2014.2 +080100 EQUAL TO 9.9 AND PERFORM11 EQUAL TO 3 AND PERFORM2 EQUAL NC2014.2 +080200 TO 10 AND PERFORM3 EQUAL TO 6 AND XRAY EQUAL TO "B" NC2014.2 +080300 PERFORM PASS GO TO PFM-WRITE-F4-4. NC2014.2 +080400 GO TO PFM-FAIL-F4-4. NC2014.2 +080500 PFM-DELETE-F4-4. NC2014.2 +080600 PERFORM DE-LETE. NC2014.2 +080700 GO TO PFM-WRITE-F4-4. NC2014.2 +080800 PFM-FAIL-F4-4. NC2014.2 +080900 MOVE PERFORM16 (2, 10, 3) TO COMPUTED-N. NC2014.2 +081000 MOVE 5.0 TO CORRECT-N. NC2014.2 +081100 PERFORM FAIL. NC2014.2 +081200 PERFORM PRINT-DETAIL. NC2014.2 +081300 MOVE SPACE TO P-OR-F. NC2014.2 +081400 MOVE PERFORM16 (2, 10, 3) TO COMPUTED-N. NC2014.2 +081500 MOVE 5.0 TO CORRECT-N. NC2014.2 +081600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +081700 PERFORM PRINT-DETAIL. NC2014.2 +081800 MOVE PERFORM16 (2, 10, 5) TO COMPUTED-N. NC2014.2 +081900 MOVE 5.7 TO CORRECT-N. NC2014.2 +082000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082100 PERFORM PRINT-DETAIL. NC2014.2 +082200 MOVE PERFORM16 (2, 5, 3) TO COMPUTED-N. NC2014.2 +082300 MOVE 6.4 TO CORRECT-N. NC2014.2 +082400 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082500 PERFORM PRINT-DETAIL. NC2014.2 +082600 MOVE PERFORM16 (2, 5, 5) TO COMPUTED-N. NC2014.2 +082700 MOVE 7.1 TO CORRECT-N. NC2014.2 +082800 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082900 PERFORM PRINT-DETAIL. NC2014.2 +083000 MOVE PERFORM16 (4, 10, 3) TO COMPUTED-N. NC2014.2 +083100 MOVE 7.8 TO CORRECT-N. NC2014.2 +083200 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +083300 PERFORM PRINT-DETAIL. NC2014.2 +083400 MOVE PERFORM16 (4, 10, 5) TO COMPUTED-N. NC2014.2 +083500 MOVE 8.5 TO CORRECT-N. NC2014.2 +083600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +083700 PERFORM PRINT-DETAIL. NC2014.2 +083800 MOVE PERFORM16 (4, 5, 3) TO COMPUTED-N. NC2014.2 +083900 MOVE 9.2 TO CORRECT-N. NC2014.2 +084000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084100 PERFORM PRINT-DETAIL. NC2014.2 +084200 MOVE PERFORM16 (4, 5, 5) TO COMPUTED-N. NC2014.2 +084300 MOVE 9.9 TO CORRECT-N. NC2014.2 +084400 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084500 PERFORM PRINT-DETAIL. NC2014.2 +084600 MOVE PERFORM11 TO COMPUTED-N. NC2014.2 +084700 MOVE 3 TO CORRECT-N. NC2014.2 +084800 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084900 PERFORM PRINT-DETAIL. NC2014.2 +085000 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +085100 MOVE 10 TO CORRECT-N. NC2014.2 +085200 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +085300 PERFORM PRINT-DETAIL. NC2014.2 +085400 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +085500 MOVE 6 TO CORRECT-N. NC2014.2 +085600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +085700 PERFORM PRINT-DETAIL. NC2014.2 +085800 MOVE XRAY TO COMPUTED-A. NC2014.2 +085900 MOVE "B" TO CORRECT-A. NC2014.2 +086000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +086100 PFM-WRITE-F4-4. NC2014.2 +086200 PERFORM PRINT-DETAIL. NC2014.2 +086300 GO TO PFM-CONTINUE. NC2014.2 +086400 PFM-A. NC2014.2 +086500 MULTIPLY PERFORM3 BY 6 GIVING PERFORM2. NC2014.2 +086600 PFM-AA. NC2014.2 +086700 ADD 1 TO PERFORM3. NC2014.2 +086800 PFM-B. NC2014.2 +086900 PERFORM FAIL. NC2014.2 +087000 MOVE "PFM-B ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +087100* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +087200* THE PREVIOUS ONE. NC2014.2 +087300 GO TO PFM-WRITE-F3-1. NC2014.2 +087400 PFM-C. NC2014.2 +087500 ADD 1 TO PERFORM2. NC2014.2 +087600 PFM-D. NC2014.2 +087700 PERFORM FAIL. NC2014.2 +087800 MOVE "PFM-D ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +087900* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +088000* THE PREVIOUS ONE. NC2014.2 +088100 GO TO PFM-WRITE-F3-2. NC2014.2 +088200 PFM-E. NC2014.2 +088300 ADD PERFORM4 3.5 GIVING PERFORM6. NC2014.2 +088400 PFM-F. NC2014.2 +088500 PERFORM FAIL. NC2014.2 +088600 MOVE "PFM-F ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +088700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +088800* THE PREVIOUS ONE. NC2014.2 +088900 GO TO PFM-WRITE-F4-1. NC2014.2 +089000 PFM-G. NC2014.2 +089100 ADD PERFORM4 8 GIVING PERFORM8 (PERFORM3). NC2014.2 +089200 ADD .3 TO PERFORM4. NC2014.2 +089300 PFM-H. NC2014.2 +089400 PERFORM FAIL. NC2014.2 +089500 MOVE "PFM-H ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +089600* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +089700* THE PREVIOUS ONE. NC2014.2 +089800 GO TO PFM-WRITE-F4-2. NC2014.2 +089900 PFM-I. NC2014.2 +090000 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +090100 (PERFORM3, PERFORM2). NC2014.2 +090200 PFM-J. NC2014.2 +090300 ADD .5 TO PERFORM4. NC2014.2 +090400 PFM-K. NC2014.2 +090500 PERFORM FAIL. NC2014.2 +090600 MOVE "PFM-K ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +090700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +090800* THE PREVIOUS ONE. NC2014.2 +090900 GO TO PFM-WRITE-F4-3. NC2014.2 +091000 PFM-L. NC2014.2 +091100 SUBTRACT 5.0 FROM PERFORM5 GIVING PERFORM16 NC2014.2 +091200 (PERFORM3, PERFORM2, PERFORM11). NC2014.2 +091300 ADD .7 TO PERFORM5. NC2014.2 +091400 PFM-M. NC2014.2 +091500 PERFORM FAIL. NC2014.2 +091600 MOVE "PFM-M ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +091700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +091800* THE PREVIOUS ONE. NC2014.2 +091900 GO TO PFM-WRITE-F4-4. NC2014.2 +092000 PFM-CONTINUE. NC2014.2 +092100 EXIT. NC2014.2 +092200* NC2014.2 +092300 PFM-INIT-F3-3. NC2014.2 +092400 MOVE "PFM-TEST-F3-3 " TO PAR-NAME. NC2014.2 +092500 MOVE "VI-122 6.20.4 GR10(C)" TO ANSI-REFERENCE. NC2014.2 +092600 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +092700 GO TO PFM-TEST-F3-3. NC2014.2 +092800 PFM-A-3-3. NC2014.2 +092900 EXIT. NC2014.2 +093000 PFM-B-3-3. NC2014.2 +093100 ADD 1 TO WRK-DS-02V00. NC2014.2 +093200 PFM-TEST-F3-3. NC2014.2 +093300 PERFORM PFM-A-3-3 THROUGH PFM-B-3-3 UNTIL TEST-2NUC-COND-99. NC2014.2 +093400 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +093500 PERFORM PASS GO TO PFM-WRITE-F3-3. NC2014.2 +093600 GO TO PFM-FAIL-F3-3. NC2014.2 +093700 PFM-DELETE-F3-3. NC2014.2 +093800 PERFORM DE-LETE. NC2014.2 +093900 GO TO PFM-WRITE-F3-3. NC2014.2 +094000 PFM-FAIL-F3-3. NC2014.2 +094100 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +094200 MOVE 99 TO CORRECT-N. NC2014.2 +094300 PERFORM FAIL. NC2014.2 +094400 PFM-WRITE-F3-3. NC2014.2 +094500 PERFORM PRINT-DETAIL. NC2014.2 +094600* NC2014.2 +094700 PFM-INIT-F4-5. NC2014.2 +094800 MOVE "PFM-TEST-F4-5" TO PAR-NAME. NC2014.2 +094900 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +095000 MOVE ZERO TO WRK-DS-06V06. NC2014.2 +095100 PERFORM PFM-A-4-5 THROUGH PFM-C-4-5 VARYING WRK-DS-02V00 NC2014.2 +095200 FROM 1 BY 1 UNTIL TEST-2NUC-COND-99. NC2014.2 +095300 GO TO PFM-TEST-F4-5. NC2014.2 +095400 PFM-A-4-5. NC2014.2 +095500 ADD 0.000001 TO WRK-DS-06V06. NC2014.2 +095600 PFM-B-4-5. NC2014.2 +095700 ADD 1 TO WRK-DS-06V06. NC2014.2 +095800 PFM-C-4-5. NC2014.2 +095900 SUBTRACT 1 FROM WRK-DS-06V06. NC2014.2 +096000 PFM-TEST-F4-5. NC2014.2 +096100 ADD WRK-DS-02V00 TO WRK-DS-06V06. NC2014.2 +096200 IF WRK-DS-06V06 EQUAL TO 99.000098 NC2014.2 +096300 PERFORM PASS GO TO PFM-WRITE-F4-5. NC2014.2 +096400 GO TO PFM-FAIL-F4-5. NC2014.2 +096500 PFM-DELETE-F4-5. NC2014.2 +096600 PERFORM DE-LETE. NC2014.2 +096700 GO TO PFM-WRITE-F4-5. NC2014.2 +096800 PFM-FAIL-F4-5. NC2014.2 +096900 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2014.2 +097000 MOVE 99.000098 TO CORRECT-N. NC2014.2 +097100 PERFORM FAIL. NC2014.2 +097200 PFM-WRITE-F4-5. NC2014.2 +097300 PERFORM PRINT-DETAIL. NC2014.2 +097400* NC2014.2 +097500 PFM-INIT-F4-6. NC2014.2 +097600 MOVE "PFM-TEST-F4-6" TO PAR-NAME. NC2014.2 +097700 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +097800 MOVE ZERO TO WRK-DS-06V06. NC2014.2 +097900 PERFORM PFM-A-4-6 VARYING WRK-DS-02V00 FROM A02TWOS-DS-02V00NC2014.2 +098000 BY A02TWOS-DS-02V00 UNTIL (WRK-DS-02V00 + 12) = 100.NC2014.2 +098100 PFM-A-4-6. NC2014.2 +098200 ADD 0.000001 TO WRK-DS-06V06. NC2014.2 +098300 PFM-TEST-F4-6. NC2014.2 +098400 ADD WRK-DS-02V00 TO WRK-DS-06V06. NC2014.2 +098500 IF WRK-DS-06V06 EQUAL TO 88.000004 NC2014.2 +098600 PERFORM PASS GO TO PFM-WRITE-F4-6. NC2014.2 +098700 GO TO PFM-FAIL-F4-6. NC2014.2 +098800 PFM-DELETE-F4-6. NC2014.2 +098900 PERFORM DE-LETE. NC2014.2 +099000 GO TO PFM-WRITE-F4-6. NC2014.2 +099100 PFM-FAIL-F4-6. NC2014.2 +099200 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2014.2 +099300 MOVE 88.000004 TO CORRECT-N. NC2014.2 +099400 PERFORM FAIL. NC2014.2 +099500 PFM-WRITE-F4-6. NC2014.2 +099600 PERFORM PRINT-DETAIL. NC2014.2 +099700* NC2014.2 +099800 PFM-INIT-F4-7. NC2014.2 +099900 MOVE "PFM-TEST-F4-7" TO PAR-NAME. NC2014.2 +100000 GO TO PFM-TEST-F4-7. NC2014.2 +100100 PFM-A-10. NC2014.2 +100200 EXIT. NC2014.2 +100300 PFM-TEST-F4-7. NC2014.2 +100400 PERFORM PFM-A-10 NC2014.2 +100500 VARYING PERFORM4 NC2014.2 +100600 FROM -5.5 NC2014.2 +100700 BY 0.1 NC2014.2 +100800 UNTIL PERFORM4 > 90. NC2014.2 +100900 IF PERFORM4 EQUAL TO 90.1 NC2014.2 +101000 PERFORM PASS GO TO PFM-WRITE-F4-7. NC2014.2 +101100 GO TO PFM-FAIL-F4-7. NC2014.2 +101200* NOTE PFM-A-10 SHOULD BE "EXECUTED" UNTIL PERFORM4 IS 90.1NC2014.2 +101300* EVEN THOUGH PFM-A-10 IS NOTHING BUT AN EXIT. NC2014.2 +101400 PFM-DELETE-F4-7. NC2014.2 +101500 PERFORM DE-LETE. NC2014.2 +101600 GO TO PFM-WRITE-F4-7. NC2014.2 +101700 PFM-FAIL-F4-7. NC2014.2 +101800 PERFORM FAIL. NC2014.2 +101900 MOVE PERFORM4 TO COMPUTED-N. NC2014.2 +102000 MOVE 90.1 TO CORRECT-N. NC2014.2 +102100 PFM-WRITE-F4-7. NC2014.2 +102200 PERFORM PRINT-DETAIL. NC2014.2 +102300* NC2014.2 +102400 PFM-INIT-F4-8. NC2014.2 +102500 MOVE "PFM-TEST-F4-8" TO PAR-NAME. NC2014.2 +102600 MOVE ZERO TO PFM-11-COUNTER. NC2014.2 +102700 MOVE ZERO TO SWITCH-PFM-1. NC2014.2 +102800* NOTE THIS AUDIT ROUTINE TESTS NESTED PERFORMS NC2014.2 +102900* IF THE PROGRAM CANNOT SET RETURNS AT THE PROPER PLACE NC2014.2 +103000* OR EXECUTE THEM IN PROPER SEQUENCE A FAIL WILL NC2014.2 +103100* RESULT. NC2014.2 +103200 PFM-TEST-F4-8. NC2014.2 +103300 GO TO PFM-PART-A. NC2014.2 +103400 PFM-DELETE-F4-8. NC2014.2 +103500 PERFORM DE-LETE. NC2014.2 +103600 GO TO PFM-WRITE-F4-8. NC2014.2 +103700 PFM-PART-A SECTION. NC2014.2 +103800 PARA-PART-A. NC2014.2 +103900 IF SWITCH-PFM-1 = 1 NC2014.2 +104000 GO TO PFM-SEC-A3. NC2014.2 +104100 PFM-SEC-A2. NC2014.2 +104200 PERFORM PFM-SEC-B1 THRU PFM-SEC-B6. NC2014.2 +104300 GO TO PFM-SEC-A4. NC2014.2 +104400 PFM-SEC-A3. NC2014.2 +104500 ADD 2 TO PFM-11-COUNTER. NC2014.2 +104600 MOVE 1 TO SWITCH-PFM-2. NC2014.2 +104700 PERFORM PFM-SEC-B1 THRU PFM-SEC-B5. NC2014.2 +104800 PFM-SEC-A4. NC2014.2 +104900 EXIT. NC2014.2 +105000 PFM-PART-B SECTION. NC2014.2 +105100 PFM-SEC-B1. NC2014.2 +105200 MULTIPLY PFM-11-COUNTER BY 10 GIVING PFM-11-COUNTER. NC2014.2 +105300 IF SWITCH-PFM-2 EQUAL TO 1 NC2014.2 +105400 GO TO PFM-SEC-B5. NC2014.2 +105500 PFM-SEC-B2. NC2014.2 +105600 MOVE 1 TO SWITCH-PFM-1. NC2014.2 +105700 PFM-SEC-B3. NC2014.2 +105800 PERFORM PFM-PART-A. NC2014.2 +105900 PFM-SEC-B4. NC2014.2 +106000 EXIT. NC2014.2 +106100 PFM-SEC-B5. NC2014.2 +106200 EXIT. NC2014.2 +106300 PFM-SEC-B6. NC2014.2 +106400 EXIT. NC2014.2 +106500 PFM-SEC-B7. NC2014.2 +106600 EXIT. NC2014.2 +106700 PFM-SEC-STOP. NC2014.2 +106800 IF PFM-11-COUNTER EQUAL TO 200 NC2014.2 +106900 PERFORM PASS NC2014.2 +107000 GO TO PFM-WRITE-F4-8. NC2014.2 +107100 PERFORM FAIL. NC2014.2 +107200 MOVE "200" TO CORRECT-A. NC2014.2 +107300 MOVE PFM-11-COUNTER TO COMPUTED-A. NC2014.2 +107400 PFM-WRITE-F4-8. NC2014.2 +107500 PERFORM PRINT-DETAIL. NC2014.2 +107600* NC2014.2 +107700 PFM-INIT-F4-9. NC2014.2 +107800 MOVE "PFM-TEST-F4-9" TO PAR-NAME. NC2014.2 +107900 ADD 44 TO PFM-12-ANS1. NC2014.2 +108000 ADD 46 TO PFM-12-ANS2. NC2014.2 +108100* NOTE THIS PROGRAM TESTS THE ABILITY OF THE COMPILER TO NC2014.2 +108200* PERFORM A STATEMENT WITH A VARYING CLAUSE INCLUDED. NC2014.2 +108300 GO TO PFM-TEST-F4-9. NC2014.2 +108400 PFM-F4-9-A. NC2014.2 +108500 ADD 1 TO PFM-12-ANS2. NC2014.2 +108600 SUBTRACT 2 FROM PFM-12-ANS1. NC2014.2 +108700 IF PFM-12-ANS2 LESS THAN PFM-12-ANS1 NC2014.2 +108800 GO TO PFM-F4-9-B ELSE NC2014.2 +108900 DIVIDE PFM-12-COUNTER BY 2 GIVING PFM-12-COUNTER. NC2014.2 +109000 IF PFM-12-COUNTER LESS THAN 36 SUBTRACT 4 FROM NC2014.2 +109100 PFM-12-COUNTER. NC2014.2 +109200 PFM-F4-9-B. NC2014.2 +109300 EXIT. NC2014.2 +109400 PFM-TEST-F4-9. NC2014.2 +109500 PERFORM PFM-F4-9-A VARYING PFM-12-COUNTER FROM 100 BY 4 NC2014.2 +109600 UNTIL PFM-12-COUNTER NOT GREATER THAN 15 NC2014.2 +109700 AND PFM-12-ANS1 LESS THAN PFM-12-ANS2 NC2014.2 +109800 OR PFM-12-ANS2 GREATER THAN 50. NC2014.2 +109900 IF PFM-12-COUNTER EQUAL TO 13 NC2014.2 +110000 PERFORM PASS NC2014.2 +110100 GO TO PFM-WRITE-F4-9. NC2014.2 +110200 GO TO PFM-FAIL-F4-9. NC2014.2 +110300 PFM-DELETE-F4-9. NC2014.2 +110400 PERFORM DE-LETE. NC2014.2 +110500 GO TO PFM-WRITE-F4-9. NC2014.2 +110600 PFM-FAIL-F4-9. NC2014.2 +110700 PERFORM FAIL. NC2014.2 +110800 MOVE PFM-12-COUNTER TO COMPUTED-A. NC2014.2 +110900 MOVE "13" TO CORRECT-A. NC2014.2 +111000 PFM-WRITE-F4-9. NC2014.2 +111100 PERFORM PRINT-DETAIL. NC2014.2 +111200* NC2014.2 +111300 PFM-INIT-F4-10. NC2014.2 +111400 MOVE "PFM-TEST-F4-10" TO PAR-NAME. NC2014.2 +111500 MOVE 0 TO PERFORM18. NC2014.2 +111600 MOVE 1 TO START-POINT. NC2014.2 +111700 MOVE 3 TO INC-VALUE. NC2014.2 +111800 GO TO PFM-TEST-F4-10. NC2014.2 +111900 PFM-F4-10-A. NC2014.2 +112000 ADD 1 TO PERFORM18. NC2014.2 +112100 ADD 3 TO PERFORM17. NC2014.2 +112200* NOTE MANIPULATING PERFORM17 IS SUPPOSED TO AFFECT THE NC2014.2 +112300* NUMBER OF TIMES THIS PARAGRAPH IS PERFORMED --- IN NC2014.2 +112400* PARTICULAR PFM-F4-10-A WOULD HAVE BEEN EXECUTED 15 NC2014.2 +112500* TIMES WITHOUT THE ABOVE ADDITION TO PERFORM17, BUT NC2014.2 +112600* IN FACT IT SHOULD NOW BE EXECUTED ONLY 8 TIMES. NC2014.2 +112700 PFM-TEST-F4-10. NC2014.2 +112800 PERFORM PFM-F4-10-A NC2014.2 +112900 VARYING PERFORM17 NC2014.2 +113000 FROM START-POINT NC2014.2 +113100 BY INC-VALUE NC2014.2 +113200 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +113300 IF PERFORM18 EQUAL TO 8 PERFORM PASS NC2014.2 +113400 GO TO PFM-WRITE-F4-10. NC2014.2 +113500 GO TO PFM-FAIL-F4-10. NC2014.2 +113600 PFM-DELETE-F4-10. NC2014.2 +113700 PERFORM DE-LETE. NC2014.2 +113800 GO TO PFM-WRITE-F4-10. NC2014.2 +113900 PFM-FAIL-F4-10. NC2014.2 +114000 PERFORM FAIL. NC2014.2 +114100 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +114200 MOVE 8 TO CORRECT-N. NC2014.2 +114300 PFM-WRITE-F4-10. NC2014.2 +114400 PERFORM PRINT-DETAIL. NC2014.2 +114500* NC2014.2 +114600 PFM-INIT-F4-11. NC2014.2 +114700 MOVE "PFM-TEST-F4-11" TO PAR-NAME. NC2014.2 +114800 MOVE 0 TO PERFORM18. NC2014.2 +114900 MOVE 1 TO START-POINT. NC2014.2 +115000 MOVE 3 TO INC-VALUE. NC2014.2 +115100 GO TO PFM-TEST-F4-11. NC2014.2 +115200 PFM-F4-11-A. NC2014.2 +115300 ADD 1 TO PERFORM18. NC2014.2 +115400 MOVE 46 TO START-POINT. NC2014.2 +115500* NOTE THE ABOVE MOVE HAS NO EFFECT ON THE NUMBER OF TIMES NC2014.2 +115600* PFM-F4-11-A IS EXECUTED (15). NC2014.2 +115700 PFM-TEST-F4-11. NC2014.2 +115800 PERFORM PFM-F4-11-A NC2014.2 +115900 VARYING PERFORM17 NC2014.2 +116000 FROM START-POINT NC2014.2 +116100 BY INC-VALUE NC2014.2 +116200 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +116300 IF PERFORM18 EQUAL TO 15 PERFORM PASS NC2014.2 +116400 GO TO PFM-WRITE-F4-11. NC2014.2 +116500 GO TO PFM-FAIL-F4-11. NC2014.2 +116600 PFM-DELETE-F4-11. NC2014.2 +116700 PERFORM DE-LETE. NC2014.2 +116800 GO TO PFM-WRITE-F4-11. NC2014.2 +116900 PFM-FAIL-F4-11. NC2014.2 +117000 PERFORM FAIL. NC2014.2 +117100 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +117200 MOVE 15 TO CORRECT-N. NC2014.2 +117300 PFM-WRITE-F4-11. NC2014.2 +117400 PERFORM PRINT-DETAIL. NC2014.2 +117500* NC2014.2 +117600 PFM-INIT-F4-12. NC2014.2 +117700 MOVE "PFM-TEST-F4-12" TO PAR-NAME. NC2014.2 +117800 MOVE 0 TO PERFORM18. NC2014.2 +117900 MOVE 1 TO START-POINT. NC2014.2 +118000 MOVE 3 TO INC-VALUE. NC2014.2 +118100 GO TO PFM-TEST-F4-12. NC2014.2 +118200 PFM-F4-12-A. NC2014.2 +118300 ADD 1 TO PERFORM18. NC2014.2 +118400 ADD 1 TO INC-VALUE. NC2014.2 +118500* NOTE THE ABOVE ADD TO INC-VALUE SHOULD ACCELERATE THE NC2014.2 +118600* SPEED AT WHICH PERFORM17 APPROACHES 46 --- THEREFORENC2014.2 +118700* PFM-F4-12-A IS EXECUTED ONLY 7 TIMES INSTEAD OF 15. NC2014.2 +118800 PFM-TEST-F4-12. NC2014.2 +118900 PERFORM PFM-F4-12-A NC2014.2 +119000 VARYING PERFORM17 NC2014.2 +119100 FROM START-POINT NC2014.2 +119200 BY INC-VALUE NC2014.2 +119300 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +119400 IF PERFORM18 EQUAL TO 7 PERFORM PASS NC2014.2 +119500 GO TO PFM-WRITE-F4-12. NC2014.2 +119600 GO TO PFM-FAIL-F4-12. NC2014.2 +119700 PFM-DELETE-F4-12. NC2014.2 +119800 PERFORM DE-LETE. NC2014.2 +119900 GO TO PFM-WRITE-F4-12. NC2014.2 +120000 PFM-FAIL-F4-12. NC2014.2 +120100 PERFORM FAIL. NC2014.2 +120200 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +120300 MOVE 7 TO CORRECT-N. NC2014.2 +120400 PFM-WRITE-F4-12. NC2014.2 +120500 PERFORM PRINT-DETAIL. NC2014.2 +120600 PFM-INIT-F3-4. NC2014.2 +120700* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +120800 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +120900 MOVE 1 TO PERFORM2. NC2014.2 +121000* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +121100* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +121200 PFM-TEST-F3-4-0. NC2014.2 +121300 PERFORM PFM-A THRU PFM-AA TEST BEFORE NC2014.2 +121400 UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +121500 PFM-TEST-F3-4-1. NC2014.2 +121600 IF PERFORM2 EQUAL TO 48 PERFORM PASS GO TO PFM-WRITE-F3-4. NC2014.2 +121700 GO TO PFM-FAIL-F3-4. NC2014.2 +121800 PFM-DELETE-F3-4. NC2014.2 +121900 PERFORM DE-LETE. NC2014.2 +122000 GO TO PFM-WRITE-F3-4. NC2014.2 +122100 PFM-FAIL-F3-4. NC2014.2 +122200 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +122300 MOVE 48 TO CORRECT-N. NC2014.2 +122400 PERFORM FAIL. NC2014.2 +122500 PFM-WRITE-F3-4. NC2014.2 +122600 MOVE "PFM-TEST-F3-4" TO PAR-NAME. NC2014.2 +122700 PERFORM PRINT-DETAIL. NC2014.2 +122800 PFM-INIT-F3-5. NC2014.2 +122900* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +123000 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +123100 MOVE 50 TO PERFORM2. NC2014.2 +123200* NOTE IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC2014.2 +123300* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-C. NC2014.2 +123400 PFM-TEST-F3-5-0. NC2014.2 +123500 PERFORM PFM-F3-5-C TEST BEFORE NC2014.2 +123600 UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +123700 PFM-TEST-F3-5-1. NC2014.2 +123800 IF PERFORM2 EQUAL TO 50 PERFORM PASS GO TO PFM-WRITE-F3-5. NC2014.2 +123900 GO TO PFM-FAIL-F3-5. NC2014.2 +124000 PFM-DELETE-F3-5. NC2014.2 +124100 PERFORM DE-LETE. NC2014.2 +124200 GO TO PFM-WRITE-F3-5. NC2014.2 +124300 PFM-F3-5-C. NC2014.2 +124400 ADD 1 TO PERFORM2. NC2014.2 +124500 PFM-FAIL-F3-5. NC2014.2 +124600 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +124700 MOVE 50 TO CORRECT-N. NC2014.2 +124800 PERFORM FAIL. NC2014.2 +124900 PFM-WRITE-F3-5. NC2014.2 +125000 MOVE "PFM-TEST-F3-5" TO PAR-NAME. NC2014.2 +125100 PERFORM PRINT-DETAIL. NC2014.2 +125200 PFM-INIT-F3-6. NC2014.2 +125300* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +125400 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +125500 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +125600 PFM-TEST-F3-6-0. NC2014.2 +125700 PERFORM PFM-A-F3-6 THROUGH PFM-B-F3-6 NC2014.2 +125800 WITH TEST BEFORE NC2014.2 +125900 UNTIL TEST-2NUC-COND-99. NC2014.2 +126000 PFM-TEST-F3-6. NC2014.2 +126100 GO TO PFM-TESTT-F3-6. NC2014.2 +126200 PFM-A-F3-6. NC2014.2 +126300 EXIT. NC2014.2 +126400 PFM-B-F3-6. NC2014.2 +126500 ADD 1 TO WRK-DS-02V00. NC2014.2 +126600 PFM-TESTT-F3-6. NC2014.2 +126700 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +126800 PERFORM PASS GO TO PFM-WRITE-F3-6. NC2014.2 +126900 GO TO PFM-FAIL-F3-6. NC2014.2 +127000 PFM-DELETE-F3-6. NC2014.2 +127100 PERFORM DE-LETE. NC2014.2 +127200 GO TO PFM-WRITE-F3-6. NC2014.2 +127300 PFM-FAIL-F3-6. NC2014.2 +127400 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +127500 MOVE 99 TO CORRECT-N. NC2014.2 +127600 PERFORM FAIL. NC2014.2 +127700 PFM-WRITE-F3-6. NC2014.2 +127800 MOVE "PFM-TEST-F3-6 " TO PAR-NAME. NC2014.2 +127900 PERFORM PRINT-DETAIL. NC2014.2 +128000 PFM-INIT-F3-7. NC2014.2 +128100* ===--> "TEST AFTER" PHRASE <--=== NC2014.2 +128200 MOVE "VI-112 6.20.4 GR10(C)" TO ANSI-REFERENCE. NC2014.2 +128300 MOVE 1 TO PERFORM2. NC2014.2 +128400 MOVE 5 TO PERFORM3. NC2014.2 +128500* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +128600* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +128700 PFM-TEST-F3-7-0. NC2014.2 +128800 PERFORM PFM-A THRU PFM-AA TEST AFTER NC2014.2 +128900 UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +129000 PFM-TEST-F3-7-1. NC2014.2 +129100 IF PERFORM2 EQUAL TO 48 PERFORM PASS GO TO PFM-WRITE-F3-7. NC2014.2 +129200 GO TO PFM-FAIL-F3-7. NC2014.2 +129300 PFM-DELETE-F3-7. NC2014.2 +129400 PERFORM DE-LETE. NC2014.2 +129500 GO TO PFM-WRITE-F3-7. NC2014.2 +129600 PFM-FAIL-F3-7. NC2014.2 +129700 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +129800 MOVE 48 TO CORRECT-N. NC2014.2 +129900 PERFORM FAIL. NC2014.2 +130000 PFM-WRITE-F3-7. NC2014.2 +130100 MOVE "PFM-TEST-F3-7" TO PAR-NAME. NC2014.2 +130200 PERFORM PRINT-DETAIL. NC2014.2 +130300 PFM-INIT-F3-8. NC2014.2 +130400* ===--> "TEST AFTER" PHRASE <--=== NC2014.2 +130500 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +130600 MOVE 50 TO PERFORM2. NC2014.2 +130700* NOTE IN THIS TEST CONDITION IS SATISFIED AFTER PERFORM IS NC2014.2 +130800* ENTERED AND CONTROL SHOULD BE PASSED TO PFM-C ONCE. NC2014.2 +130900 PFM-TEST-F3-8-0. NC2014.2 +131000 PERFORM PFM-F3-8-C TEST AFTER NC2014.2 +131100 UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +131200 PFM-TEST-F3-8-1. NC2014.2 +131300 IF PERFORM2 EQUAL TO 51 PERFORM PASS GO TO PFM-WRITE-F3-8. NC2014.2 +131400 GO TO PFM-FAIL-F3-8. NC2014.2 +131500 PFM-DELETE-F3-8. NC2014.2 +131600 PERFORM DE-LETE. NC2014.2 +131700 GO TO PFM-WRITE-F3-8. NC2014.2 +131800 PFM-F3-8-C. NC2014.2 +131900 ADD 1 TO PERFORM2. NC2014.2 +132000 PFM-FAIL-F3-8. NC2014.2 +132100 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +132200 MOVE 51 TO CORRECT-N. NC2014.2 +132300 PERFORM FAIL. NC2014.2 +132400 PFM-WRITE-F3-8. NC2014.2 +132500 MOVE "PFM-TEST-F3-8" TO PAR-NAME. NC2014.2 +132600 PERFORM PRINT-DETAIL. NC2014.2 +132700 PFM-INIT-F3-9. NC2014.2 +132800* ===--> "TEST AFTER " PHRASE <--=== NC2014.2 +132900 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +133000 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +133100 PFM-TEST-F3-9-0. NC2014.2 +133200 PERFORM PFM-A-F3-9 THROUGH PFM-B-F3-9 NC2014.2 +133300 WITH TEST AFTER NC2014.2 +133400 UNTIL TEST-2NUC-COND-99. NC2014.2 +133500 PFM-TEST-F3-9. NC2014.2 +133600 GO TO PFM-TESTT-F3-9. NC2014.2 +133700 PFM-A-F3-9. NC2014.2 +133800 EXIT. NC2014.2 +133900 PFM-B-F3-9. NC2014.2 +134000 ADD 1 TO WRK-DS-02V00. NC2014.2 +134100 PFM-TESTT-F3-9. NC2014.2 +134200 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +134300 PERFORM PASS GO TO PFM-WRITE-F3-9. NC2014.2 +134400 GO TO PFM-FAIL-F3-9. NC2014.2 +134500 PFM-DELETE-F3-9. NC2014.2 +134600 PERFORM DE-LETE. NC2014.2 +134700 GO TO PFM-WRITE-F3-9. NC2014.2 +134800 PFM-FAIL-F3-9. NC2014.2 +134900 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +135000 MOVE 99 TO CORRECT-N. NC2014.2 +135100 PERFORM FAIL. NC2014.2 +135200 PFM-WRITE-F3-9. NC2014.2 +135300 MOVE "PFM-TEST-F3-9" TO PAR-NAME. NC2014.2 +135400 PERFORM PRINT-DETAIL. NC2014.2 +135500* NC2014.2 +135600 PFM-INIT-F4-13. NC2014.2 +135700* ===--> "WITH TEST BEFORE" PHRASE <--=== NC2014.2 +135800 MOVE "VI-114 6.20.4 GR10(d)1" TO ANSI-REFERENCE. NC2014.2 +135900 MOVE 20 TO PERFORM2. NC2014.2 +136000 MOVE 9 TO PERFORM3. NC2014.2 +136100 MOVE 1.5 TO PERFORM4. NC2014.2 +136200 MOVE 3 TO PERFORM9. NC2014.2 +136300 MOVE -1 TO PERFORM10. NC2014.2 +136400 MOVE 6 TO PERFORM11. NC2014.2 +136500 MOVE ZEROS TO PERFORM12. NC2014.2 +136600 MOVE SPACE TO XRAY. NC2014.2 +136700* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +136800 PFM-TEST-F4-13-0. NC2014.2 +136900 PERFORM PFM-I-F4-13 THRU PFM-J-F4-13 WITH TEST BEFORE NC2014.2 +137000 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +137100 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +137200 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +137300 UNTIL PERFORM2 GREATER THAN 20. NC2014.2 +137400 GO TO PFM-TEST-F4-13-1. NC2014.2 +137500 PFM-I-F4-13. NC2014.2 +137600 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +137700 (PERFORM3, PERFORM2). NC2014.2 +137800 PFM-J-F4-13. NC2014.2 +137900 ADD .5 TO PERFORM4. NC2014.2 +138000 PFM-TEST-F4-13-1. NC2014.2 +138100 IF PERFORM14 (3, 2) EQUAL TO 15.0 AND PERFORM14 (3, 8) NC2014.2 +138200 EQUAL TO 20.0 AND PERFORM14 (3, 14) EQUAL TO 25.0 NC2014.2 +138300 AND PERFORM14 (3, 20) EQUAL TO 30.0 AND PERFORM14 (2, 2) NC2014.2 +138400 EQUAL TO 35.0 MOVE "A" TO XRAY. NC2014.2 +138500 IF PERFORM14 (2, 8) EQUAL TO 40.0 AND NC2014.2 +138600 PERFORM14 (2, 14) EQUAL TO 45.0 AND PERFORM14 (2, 20) NC2014.2 +138700 EQUAL TO 50.0 AND PERFORM2 EQUAL TO 2 AND PERFORM3 NC2014.2 +138800 EQUAL TO 1 AND XRAY EQUAL TO "A" PERFORM PASS NC2014.2 +138900 GO TO PFM-WRITE-F4-13. NC2014.2 +139000 GO TO PFM-FAIL-F4-13. NC2014.2 +139100 PFM-DELETE-F4-13. NC2014.2 +139200 PERFORM DE-LETE. NC2014.2 +139300 GO TO PFM-WRITE-F4-13. NC2014.2 +139400 PFM-FAIL-F4-13. NC2014.2 +139500 MOVE PERFORM14 (3, 2) TO COMPUTED-N. NC2014.2 +139600 MOVE 15.0 TO CORRECT-N. NC2014.2 +139700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +139800 PERFORM FAIL. NC2014.2 +139900 PERFORM PRINT-DETAIL. NC2014.2 +140000 MOVE SPACE TO P-OR-F. NC2014.2 +140100 MOVE PERFORM14 (3, 8) TO COMPUTED-N. NC2014.2 +140200 MOVE 20.0 TO CORRECT-N. NC2014.2 +140300 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +140400 PERFORM PRINT-DETAIL. NC2014.2 +140500 MOVE PERFORM14 (3, 14) TO COMPUTED-N. NC2014.2 +140600 MOVE 25.0 TO CORRECT-N. NC2014.2 +140700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +140800 PERFORM PRINT-DETAIL. NC2014.2 +140900 MOVE PERFORM14 (3, 20) TO COMPUTED-N. NC2014.2 +141000 MOVE 30.0 TO CORRECT-N. NC2014.2 +141100 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +141200 PERFORM PRINT-DETAIL. NC2014.2 +141300 MOVE PERFORM14 (2, 2) TO COMPUTED-N. NC2014.2 +141400 MOVE 35.0 TO CORRECT-N. NC2014.2 +141500 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +141600 PERFORM PRINT-DETAIL. NC2014.2 +141700 MOVE PERFORM14 (2, 8) TO COMPUTED-N. NC2014.2 +141800 MOVE 40.0 TO CORRECT-N. NC2014.2 +141900 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142000 PERFORM PRINT-DETAIL. NC2014.2 +142100 MOVE PERFORM14 (2, 14) TO COMPUTED-N. NC2014.2 +142200 MOVE 45.0 TO CORRECT-N. NC2014.2 +142300 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142400 PERFORM PRINT-DETAIL. NC2014.2 +142500 MOVE PERFORM14 (2, 20) TO COMPUTED-N. NC2014.2 +142600 MOVE 50.0 TO CORRECT-N. NC2014.2 +142700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142800 PERFORM PRINT-DETAIL. NC2014.2 +142900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +143000 MOVE 2 TO CORRECT-N. NC2014.2 +143100 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +143200 PERFORM PRINT-DETAIL. NC2014.2 +143300 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +143400 MOVE 1 TO CORRECT-N. NC2014.2 +143500 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +143600 PERFORM PRINT-DETAIL. NC2014.2 +143700 MOVE XRAY TO COMPUTED-A. NC2014.2 +143800 MOVE "A" TO CORRECT-A. NC2014.2 +143900 PFM-WRITE-F4-13. NC2014.2 +144000 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +144100 PERFORM PRINT-DETAIL. NC2014.2 +144200* NC2014.2 +144300 PFM-INIT-F4-14. NC2014.2 +144400* ===--> "WITH TEST AFTER" PHRASE <--=== NC2014.2 +144500 MOVE "VI-117/8 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +144600 MOVE "PFM-TEST-F4-14" TO PAR-NAME. NC2014.2 +144700 MOVE ZEROS TO PERFORM12. NC2014.2 +144800 MOVE SPACE TO XRAY. NC2014.2 +144900 MOVE 6 TO PERFORM11. NC2014.2 +145000 MOVE -1 TO PERFORM10. NC2014.2 +145100 MOVE 2 TO PERFORM9. NC2014.2 +145200 MOVE 1 TO PERFORM4. NC2014.2 +145300 MOVE 2 TO PERFORM3. NC2014.2 +145400 MOVE 20 TO PERFORM2. NC2014.2 +145500 MOVE 1 TO REC-CT. NC2014.2 +145600* NOTE: IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +145700 PFM-TEST-F4-14-0. NC2014.2 +145800 PERFORM PFM-I-F4-14 THRU PFM-J-F4-14 WITH TEST AFTER NC2014.2 +145900 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +146000 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +146100 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +146200 UNTIL PERFORM2 GREATER THAN 19. NC2014.2 +146300 GO TO PFM-TEST-F4-14-1. NC2014.2 +146400 PFM-I-F4-14. NC2014.2 +146500 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +146600 (PERFORM3, PERFORM2). NC2014.2 +146700 PFM-J-F4-14. NC2014.2 +146800 ADD .5 TO PERFORM4. NC2014.2 +146900 MOVE 1 TO PERFORM3. NC2014.2 +147000 MOVE 99 TO PERFORM2. NC2014.2 +147100 PFM-DELETE-F4-14. NC2014.2 +147200 PERFORM DE-LETE. NC2014.2 +147300 PERFORM PRINT-DETAIL. NC2014.2 +147400 GO TO PFM-INIT-F4-15. NC2014.2 +147500 PFM-TEST-F4-14-1. NC2014.2 +147600 MOVE "PFM-TEST-F4-14-1" TO PAR-NAME. NC2014.2 +147700 IF PERFORM14 (2, 2) NOT EQUAL TO 10.0 NC2014.2 +147800 MOVE PERFORM14 (2, 2) TO COMPUTED-N NC2014.2 +147900 MOVE 10.0 TO CORRECT-N NC2014.2 +148000 PERFORM FAIL NC2014.2 +148100 PERFORM PRINT-DETAIL NC2014.2 +148200 ELSE NC2014.2 +148300 PERFORM PASS NC2014.2 +148400 PERFORM PRINT-DETAIL. NC2014.2 +148500 MOVE SPACE TO P-OR-F. NC2014.2 +148600 ADD 1 TO REC-CT. NC2014.2 +148700 PFM-TEST-F4-14-2. NC2014.2 +148800 MOVE "PFM-TEST-F4-14-2" TO PAR-NAME. NC2014.2 +148900 IF PERFORM4 NOT = 1.5 NC2014.2 +149000 MOVE PERFORM4 TO COMPUTED-N NC2014.2 +149100 MOVE 1.5 TO CORRECT-N NC2014.2 +149200 PERFORM FAIL NC2014.2 +149300 PERFORM PRINT-DETAIL NC2014.2 +149400 ELSE NC2014.2 +149500 PERFORM PASS NC2014.2 +149600 PERFORM PRINT-DETAIL. NC2014.2 +149700* NC2014.2 +149800 PFM-INIT-F4-15. NC2014.2 +149900* ===--> " TEST AFTER " PHRASE <--=== NC2014.2 +150000 MOVE "VI-117/8 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +150100 MOVE "PFM-TEST-F4-15" TO PAR-NAME. NC2014.2 +150200 MOVE ZEROS TO PERFORM12. NC2014.2 +150300 MOVE 1 TO REC-CT. NC2014.2 +150400 MOVE 20 TO PERFORM2. NC2014.2 +150500 MOVE 5 TO PERFORM3. NC2014.2 +150600 MOVE 1 TO PERFORM4. NC2014.2 +150700 MOVE 3 TO PERFORM9. NC2014.2 +150800 MOVE -1 TO PERFORM10. NC2014.2 +150900 MOVE 6 TO PERFORM11. NC2014.2 +151000* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +151100 PFM-TEST-F4-15-0. NC2014.2 +151200 PERFORM PFM-I-F4-15 THRU PFM-J-F4-15 TEST AFTER NC2014.2 +151300 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +151400 UNTIL PERFORM3 EQUAL TO 2 NC2014.2 +151500 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +151600 UNTIL PERFORM2 GREATER THAN 19. NC2014.2 +151700 GO TO PFM-TEST-F4-15-1. NC2014.2 +151800 PFM-I-F4-15. NC2014.2 +151900 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +152000 (PERFORM3, PERFORM2). NC2014.2 +152100 PFM-J-F4-15. NC2014.2 +152200 ADD .5 TO PERFORM4. NC2014.2 +152300 MOVE 20 TO PERFORM2. NC2014.2 +152400 PFM-DELETE-F4-15. NC2014.2 +152500 PERFORM DE-LETE. NC2014.2 +152600 PERFORM PRINT-DETAIL. NC2014.2 +152700 GO TO PFM-INIT-F4-16. NC2014.2 +152800 PFM-TEST-F4-15-1. NC2014.2 +152900 IF PERFORM14 (2, 2) NOT = 15.0 NC2014.2 +153000 MOVE PERFORM14 (2, 2) TO COMPUTED-N NC2014.2 +153100 MOVE 15.0 TO CORRECT-N NC2014.2 +153200 PERFORM FAIL NC2014.2 +153300 PERFORM PRINT-DETAIL NC2014.2 +153400 ELSE NC2014.2 +153500 PERFORM PASS NC2014.2 +153600 PERFORM PRINT-DETAIL. NC2014.2 +153700 ADD 1 TO REC-CT. NC2014.2 +153800 PFM-TEST-F4-15-2. NC2014.2 +153900 IF PERFORM14 (3, 2) NOT = 10.0 NC2014.2 +154000 MOVE PERFORM14 (3, 2) TO COMPUTED-N NC2014.2 +154100 MOVE 10.0 TO CORRECT-N NC2014.2 +154200 PERFORM FAIL NC2014.2 +154300 PERFORM PRINT-DETAIL NC2014.2 +154400 ELSE NC2014.2 +154500 PERFORM PASS NC2014.2 +154600 PERFORM PRINT-DETAIL. NC2014.2 +154700* NC2014.2 +154800 PFM-INIT-F4-16. NC2014.2 +154900* ===--> 6 AFTER PHRASES <--=== NC2014.2 +155000 MOVE "VI-110 6.20.3 SR12" TO ANSI-REFERENCE. NC2014.2 +155100 MOVE "PFM-TEST-F4-16" TO PAR-NAME. NC2014.2 +155200 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +155300 MOVE 0 TO PFM-7-TOT. NC2014.2 +155400 MOVE 1 TO REC-CT. NC2014.2 +155500 MOVE 1 TO S1 S2 S3 S4 S5 S6 S7. NC2014.2 +155600* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +155700 PFM-TEST-F4-16-0. NC2014.2 +155800 PERFORM PFM-I-F4-16 THRU PFM-J-F4-16 NC2014.2 +155900 VARYING S1 FROM 1 BY 1 NC2014.2 +156000 UNTIL S1 = 3 NC2014.2 +156100 AFTER S2 FROM 1 BY 1 NC2014.2 +156200 UNTIL S2 = 3 NC2014.2 +156300 AFTER S3 FROM 1 BY 1 NC2014.2 +156400 UNTIL S3 = 3 NC2014.2 +156500 AFTER S4 FROM 1 BY 1 NC2014.2 +156600 UNTIL S4 = 3 NC2014.2 +156700 AFTER S5 FROM 1 BY 1 NC2014.2 +156800 UNTIL S5 = 3 NC2014.2 +156900 AFTER S6 FROM 1 BY 1 NC2014.2 +157000 UNTIL S6 = 3 NC2014.2 +157100 AFTER S7 FROM 1 BY 1 NC2014.2 +157200 UNTIL S7 = 3. NC2014.2 +157300 GO TO PFM-TEST-F4-16-1. NC2014.2 +157400 PFM-I-F4-16. NC2014.2 +157500 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +157600 PFM-J-F4-16. NC2014.2 +157700 ADD 1 TO PFM-7-TOT. NC2014.2 +157800 PFM-DELETE-F4-16. NC2014.2 +157900 PERFORM DE-LETE. NC2014.2 +158000 PERFORM PRINT-DETAIL. NC2014.2 +158100 GO TO PFM-INIT-F4-17. NC2014.2 +158200 PFM-TEST-F4-16-1. NC2014.2 +158300 IF PFM77-1 (1 1 1 1 1 1 1) NOT = "*" NC2014.2 +158400 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +158500 MOVE "*" TO CORRECT-A NC2014.2 +158600 PERFORM FAIL NC2014.2 +158700 PERFORM PRINT-DETAIL NC2014.2 +158800 ELSE NC2014.2 +158900 PERFORM PASS NC2014.2 +159000 PERFORM PRINT-DETAIL. NC2014.2 +159100 ADD 1 TO REC-CT. NC2014.2 +159200 PFM-TEST-F4-16-2. NC2014.2 +159300 IF PFM77-1 (1 1 1 1 1 1 2) NOT = "*" NC2014.2 +159400 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +159500 MOVE "*" TO CORRECT-A NC2014.2 +159600 PERFORM FAIL NC2014.2 +159700 PERFORM PRINT-DETAIL NC2014.2 +159800 ELSE NC2014.2 +159900 PERFORM PASS NC2014.2 +160000 PERFORM PRINT-DETAIL. NC2014.2 +160100 ADD 1 TO REC-CT. NC2014.2 +160200 PFM-TEST-F4-16-3. NC2014.2 +160300 IF PFM77-1 (1 1 1 1 1 2 1) NOT = "*" NC2014.2 +160400 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +160500 MOVE "*" TO CORRECT-A NC2014.2 +160600 PERFORM FAIL NC2014.2 +160700 PERFORM PRINT-DETAIL NC2014.2 +160800 ELSE NC2014.2 +160900 PERFORM PASS NC2014.2 +161000 PERFORM PRINT-DETAIL. NC2014.2 +161100 ADD 1 TO REC-CT. NC2014.2 +161200 PFM-TEST-F4-16-4. NC2014.2 +161300 IF PFM77-1 (1 1 1 1 1 2 2) NOT = "*" NC2014.2 +161400 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +161500 MOVE "*" TO CORRECT-A NC2014.2 +161600 PERFORM FAIL NC2014.2 +161700 PERFORM PRINT-DETAIL NC2014.2 +161800 ELSE NC2014.2 +161900 PERFORM PASS NC2014.2 +162000 PERFORM PRINT-DETAIL. NC2014.2 +162100 ADD 1 TO REC-CT. NC2014.2 +162200 PFM-TEST-F4-16-5. NC2014.2 +162300 IF PFM77-1 (1 1 1 1 2 1 1) NOT = "*" NC2014.2 +162400 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +162500 MOVE "*" TO CORRECT-A NC2014.2 +162600 PERFORM FAIL NC2014.2 +162700 PERFORM PRINT-DETAIL NC2014.2 +162800 ELSE NC2014.2 +162900 PERFORM PASS NC2014.2 +163000 PERFORM PRINT-DETAIL. NC2014.2 +163100 ADD 1 TO REC-CT. NC2014.2 +163200 PFM-TEST-F4-16-6. NC2014.2 +163300 IF PFM77-1 (1 1 1 1 2 1 2) NOT = "*" NC2014.2 +163400 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +163500 MOVE "*" TO CORRECT-A NC2014.2 +163600 PERFORM FAIL NC2014.2 +163700 PERFORM PRINT-DETAIL NC2014.2 +163800 ELSE NC2014.2 +163900 PERFORM PASS NC2014.2 +164000 PERFORM PRINT-DETAIL. NC2014.2 +164100 ADD 1 TO REC-CT. NC2014.2 +164200 PFM-TEST-F4-16-7. NC2014.2 +164300 IF PFM77-1 (1 1 1 2 1 1 1) NOT = "*" NC2014.2 +164400 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +164500 MOVE "*" TO CORRECT-A NC2014.2 +164600 PERFORM FAIL NC2014.2 +164700 PERFORM PRINT-DETAIL NC2014.2 +164800 ELSE NC2014.2 +164900 PERFORM PASS NC2014.2 +165000 PERFORM PRINT-DETAIL. NC2014.2 +165100 ADD 1 TO REC-CT. NC2014.2 +165200 PFM-TEST-F4-16-9. NC2014.2 +165300 IF PFM77-1 (1 1 1 2 1 1 2) NOT = "*" NC2014.2 +165400 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +165500 MOVE "*" TO CORRECT-A NC2014.2 +165600 PERFORM FAIL NC2014.2 +165700 PERFORM PRINT-DETAIL NC2014.2 +165800 ELSE NC2014.2 +165900 PERFORM PASS NC2014.2 +166000 PERFORM PRINT-DETAIL. NC2014.2 +166100 ADD 1 TO REC-CT. NC2014.2 +166200 PFM-TEST-F4-16-10. NC2014.2 +166300 IF PFM-7-TOT NOT = 128 NC2014.2 +166400 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +166500 MOVE 128 TO CORRECT-18V0 NC2014.2 +166600 PERFORM FAIL NC2014.2 +166700 PERFORM PRINT-DETAIL NC2014.2 +166800 ELSE NC2014.2 +166900 PERFORM PASS NC2014.2 +167000 PERFORM PRINT-DETAIL. NC2014.2 +167100* NC2014.2 +167200 PFM-INIT-F4-17. NC2014.2 +167300* ===--> 6 AFTER PHRASES <--=== NC2014.2 +167400* ===--> "WITH TEST BEFORE" PHRASE <--=== NC2014.2 +167500 MOVE "PFM-TEST-F4-17" TO PAR-NAME. NC2014.2 +167600 MOVE "VI-114 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +167700 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +167800 MOVE 101 TO COUNT-DU-6V0. NC2014.2 +167900 MOVE 0 TO PFM-7-TOT. NC2014.2 +168000 MOVE 1 TO REC-CT. NC2014.2 +168100* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +168200 PFM-TEST-F4-17-0. NC2014.2 +168300 PERFORM PFM-I-F4-17 THRU PFM-J-F4-17 WITH TEST BEFORE NC2014.2 +168400 VARYING S1 FROM 1 BY 1 NC2014.2 +168500 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +168600 AFTER S2 FROM 1 BY 1 NC2014.2 +168700 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +168800 AFTER S3 FROM 1 BY 1 NC2014.2 +168900 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169000 AFTER S4 FROM 1 BY 1 NC2014.2 +169100 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169200 AFTER S5 FROM 1 BY 1 NC2014.2 +169300 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169400 AFTER S6 FROM 1 BY 1 NC2014.2 +169500 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169600 AFTER S7 FROM 1 BY 1 NC2014.2 +169700 UNTIL COUNT-DU-6V0 > 100. NC2014.2 +169800 GO TO PFM-TEST-F4-17-1. NC2014.2 +169900 PFM-I-F4-17. NC2014.2 +170000 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +170100 PFM-J-F4-17. NC2014.2 +170200 ADD 1 TO PFM-7-TOT. NC2014.2 +170300 PFM-DELETE-F4-17. NC2014.2 +170400 PERFORM DE-LETE. NC2014.2 +170500 PERFORM PRINT-DETAIL. NC2014.2 +170600 GO TO PFM-INIT-F4-18. NC2014.2 +170700 PFM-TEST-F4-17-1. NC2014.2 +170800 IF PFM77-1 (1 1 1 1 1 1 1) NOT = SPACE NC2014.2 +170900 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +171000 MOVE SPACE TO CORRECT-A NC2014.2 +171100 PERFORM FAIL NC2014.2 +171200 PERFORM PRINT-DETAIL NC2014.2 +171300 ELSE NC2014.2 +171400 PERFORM PASS NC2014.2 +171500 PERFORM PRINT-DETAIL. NC2014.2 +171600 ADD 1 TO REC-CT. NC2014.2 +171700 PFM-TEST-F4-17-2. NC2014.2 +171800 IF PFM77-1 (1 1 1 1 1 1 2) NOT = SPACE NC2014.2 +171900 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +172000 MOVE SPACE TO CORRECT-A NC2014.2 +172100 PERFORM FAIL NC2014.2 +172200 PERFORM PRINT-DETAIL NC2014.2 +172300 ELSE NC2014.2 +172400 PERFORM PASS NC2014.2 +172500 PERFORM PRINT-DETAIL. NC2014.2 +172600 ADD 1 TO REC-CT. NC2014.2 +172700 PFM-TEST-F4-17-3. NC2014.2 +172800 IF PFM77-1 (1 1 1 1 1 2 1) NOT = SPACE NC2014.2 +172900 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +173000 MOVE SPACE TO CORRECT-A NC2014.2 +173100 PERFORM FAIL NC2014.2 +173200 PERFORM PRINT-DETAIL NC2014.2 +173300 ELSE NC2014.2 +173400 PERFORM PASS NC2014.2 +173500 PERFORM PRINT-DETAIL. NC2014.2 +173600 ADD 1 TO REC-CT. NC2014.2 +173700 PFM-TEST-F4-17-4. NC2014.2 +173800 IF PFM77-1 (1 1 1 1 1 2 2) NOT = SPACE NC2014.2 +173900 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +174000 MOVE SPACE TO CORRECT-A NC2014.2 +174100 PERFORM FAIL NC2014.2 +174200 PERFORM PRINT-DETAIL NC2014.2 +174300 ELSE NC2014.2 +174400 PERFORM PASS NC2014.2 +174500 PERFORM PRINT-DETAIL. NC2014.2 +174600 ADD 1 TO REC-CT. NC2014.2 +174700 PFM-TEST-F4-17-5. NC2014.2 +174800 IF PFM77-1 (1 1 1 1 2 1 1) NOT = SPACE NC2014.2 +174900 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +175000 MOVE SPACE TO CORRECT-A NC2014.2 +175100 PERFORM FAIL NC2014.2 +175200 PERFORM PRINT-DETAIL NC2014.2 +175300 ELSE NC2014.2 +175400 PERFORM PASS NC2014.2 +175500 PERFORM PRINT-DETAIL. NC2014.2 +175600 ADD 1 TO REC-CT. NC2014.2 +175700 PFM-TEST-F4-17-6. NC2014.2 +175800 IF PFM77-1 (1 1 1 1 2 1 2) NOT = SPACE NC2014.2 +175900 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +176000 MOVE SPACE TO CORRECT-A NC2014.2 +176100 PERFORM FAIL NC2014.2 +176200 PERFORM PRINT-DETAIL NC2014.2 +176300 ELSE NC2014.2 +176400 PERFORM PASS NC2014.2 +176500 PERFORM PRINT-DETAIL. NC2014.2 +176600 ADD 1 TO REC-CT. NC2014.2 +176700 PFM-TEST-F4-17-7. NC2014.2 +176800 IF PFM77-1 (1 1 1 2 1 1 1) NOT = SPACE NC2014.2 +176900 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +177000 MOVE SPACE TO CORRECT-A NC2014.2 +177100 PERFORM FAIL NC2014.2 +177200 PERFORM PRINT-DETAIL NC2014.2 +177300 ELSE NC2014.2 +177400 PERFORM PASS NC2014.2 +177500 PERFORM PRINT-DETAIL. NC2014.2 +177600 ADD 1 TO REC-CT. NC2014.2 +177700 PFM-TEST-F4-17-8. NC2014.2 +177800 IF PFM77-1 (1 1 1 2 1 1 2) NOT = SPACE NC2014.2 +177900 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +178000 MOVE SPACE TO CORRECT-A NC2014.2 +178100 PERFORM FAIL NC2014.2 +178200 PERFORM PRINT-DETAIL NC2014.2 +178300 ELSE NC2014.2 +178400 PERFORM PASS NC2014.2 +178500 PERFORM PRINT-DETAIL. NC2014.2 +178600 ADD 1 TO REC-CT. NC2014.2 +178700 PFM-TEST-F4-17-9. NC2014.2 +178800 IF PFM-7-TOT NOT = ZERO NC2014.2 +178900 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +179000 MOVE ZERO TO CORRECT-18V0 NC2014.2 +179100 PERFORM FAIL NC2014.2 +179200 PERFORM PRINT-DETAIL NC2014.2 +179300 ELSE NC2014.2 +179400 PERFORM PASS NC2014.2 +179500 PERFORM PRINT-DETAIL. NC2014.2 +179600* NC2014.2 +179700 PFM-INIT-F4-18. NC2014.2 +179800* ===--> 6 AFTER PHRASES <--=== NC2014.2 +179900* ===--> TEST AFTER" PHRASE <--=== NC2014.2 +180000 MOVE "PFM-TEST-F4-18" TO PAR-NAME. NC2014.2 +180100 MOVE "VI-119 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +180200 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +180300 MOVE 0 TO COUNT-DU-6V0. NC2014.2 +180400 MOVE 0 TO PFM-7-TOT. NC2014.2 +180500 MOVE 1 TO REC-CT. NC2014.2 +180600* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +180700 PFM-TEST-F4-18-0. NC2014.2 +180800 PERFORM PFM-I-F4-18 THRU PFM-J-F4-18 TEST AFTER NC2014.2 +180900 VARYING S1 FROM 1 BY 1 NC2014.2 +181000 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181100 AFTER S2 FROM 1 BY 1 NC2014.2 +181200 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181300 AFTER S3 FROM 1 BY 1 NC2014.2 +181400 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181500 AFTER S4 FROM 1 BY 1 NC2014.2 +181600 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181700 AFTER S5 FROM 1 BY 1 NC2014.2 +181800 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181900 AFTER S6 FROM 1 BY 1 NC2014.2 +182000 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +182100 AFTER S7 FROM 1 BY 1 NC2014.2 +182200 UNTIL COUNT-DU-6V0 > 100. NC2014.2 +182300 GO TO PFM-TEST-F4-18-1. NC2014.2 +182400 PFM-I-F4-18. NC2014.2 +182500 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +182600 MOVE 101 TO COUNT-DU-6V0. NC2014.2 +182700 PFM-J-F4-18. NC2014.2 +182800 ADD 1 TO PFM-7-TOT. NC2014.2 +182900 PFM-DELETE-F4-18. NC2014.2 +183000 PERFORM DE-LETE. NC2014.2 +183100 PERFORM PRINT-DETAIL. NC2014.2 +183200 GO TO PFM-INIT-F4-20. NC2014.2 +183300 PFM-TEST-F4-18-1. NC2014.2 +183400 IF PFM77-1 (1 1 1 1 1 1 1) NOT = "*" NC2014.2 +183500 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +183600 MOVE "*" TO CORRECT-A NC2014.2 +183700 PERFORM FAIL NC2014.2 +183800 PERFORM PRINT-DETAIL NC2014.2 +183900 ELSE NC2014.2 +184000 PERFORM PASS NC2014.2 +184100 PERFORM PRINT-DETAIL. NC2014.2 +184200 ADD 1 TO REC-CT. NC2014.2 +184300 PFM-TEST-F4-18-2. NC2014.2 +184400 IF PFM77-1 (1 1 1 1 1 1 2) NOT = SPACE NC2014.2 +184500 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +184600 MOVE SPACE TO CORRECT-A NC2014.2 +184700 PERFORM FAIL NC2014.2 +184800 PERFORM PRINT-DETAIL NC2014.2 +184900 ELSE NC2014.2 +185000 PERFORM PASS NC2014.2 +185100 PERFORM PRINT-DETAIL. NC2014.2 +185200 ADD 1 TO REC-CT. NC2014.2 +185300 PFM-TEST-F4-18-3. NC2014.2 +185400 IF PFM77-1 (1 1 1 1 1 2 1) NOT = SPACE NC2014.2 +185500 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +185600 MOVE SPACE TO CORRECT-A NC2014.2 +185700 PERFORM FAIL NC2014.2 +185800 PERFORM PRINT-DETAIL NC2014.2 +185900 ELSE NC2014.2 +186000 PERFORM PASS NC2014.2 +186100 PERFORM PRINT-DETAIL. NC2014.2 +186200 ADD 1 TO REC-CT. NC2014.2 +186300 PFM-TEST-F4-18-4. NC2014.2 +186400 IF PFM77-1 (1 1 1 1 1 2 2) NOT = SPACE NC2014.2 +186500 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +186600 MOVE SPACE TO CORRECT-A NC2014.2 +186700 PERFORM FAIL NC2014.2 +186800 PERFORM PRINT-DETAIL NC2014.2 +186900 ELSE NC2014.2 +187000 PERFORM PASS NC2014.2 +187100 PERFORM PRINT-DETAIL. NC2014.2 +187200 ADD 1 TO REC-CT. NC2014.2 +187300 PFM-TEST-F4-18-5. NC2014.2 +187400 IF PFM77-1 (1 1 1 1 2 1 1) NOT = SPACE NC2014.2 +187500 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +187600 MOVE SPACE TO CORRECT-A NC2014.2 +187700 PERFORM FAIL NC2014.2 +187800 PERFORM PRINT-DETAIL NC2014.2 +187900 ELSE NC2014.2 +188000 PERFORM PASS NC2014.2 +188100 PERFORM PRINT-DETAIL. NC2014.2 +188200 ADD 1 TO REC-CT. NC2014.2 +188300 PFM-TEST-F4-18-6. NC2014.2 +188400 IF PFM77-1 (1 1 1 1 2 1 2) NOT = SPACE NC2014.2 +188500 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +188600 MOVE SPACE TO CORRECT-A NC2014.2 +188700 PERFORM FAIL NC2014.2 +188800 PERFORM PRINT-DETAIL NC2014.2 +188900 ELSE NC2014.2 +189000 PERFORM PASS NC2014.2 +189100 PERFORM PRINT-DETAIL. NC2014.2 +189200 ADD 1 TO REC-CT. NC2014.2 +189300 PFM-TEST-F4-18-7. NC2014.2 +189400 IF PFM77-1 (1 1 1 2 1 1 1) NOT = SPACE NC2014.2 +189500 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +189600 MOVE SPACE TO CORRECT-A NC2014.2 +189700 MOVE "PFM-TEST-F4-18-8" TO PAR-NAME NC2014.2 +189800 PERFORM FAIL NC2014.2 +189900 PERFORM PRINT-DETAIL NC2014.2 +190000 ELSE NC2014.2 +190100 PERFORM PASS NC2014.2 +190200 PERFORM PRINT-DETAIL. NC2014.2 +190300 ADD 1 TO REC-CT. NC2014.2 +190400 PFM-TEST-F4-18-8. NC2014.2 +190500 IF PFM77-1 (1 1 1 2 1 1 2) NOT = SPACE NC2014.2 +190600 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +190700 MOVE SPACE TO CORRECT-A NC2014.2 +190800 PERFORM FAIL NC2014.2 +190900 PERFORM PRINT-DETAIL NC2014.2 +191000 ELSE NC2014.2 +191100 PERFORM PASS NC2014.2 +191200 PERFORM PRINT-DETAIL. NC2014.2 +191300 ADD 1 TO REC-CT. NC2014.2 +191400 PFM-TEST-F4-18-9. NC2014.2 +191500 IF PFM-7-TOT NOT = 1 NC2014.2 +191600 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +191700 MOVE 1 TO CORRECT-18V0 NC2014.2 +191800 PERFORM FAIL NC2014.2 +191900 PERFORM PRINT-DETAIL NC2014.2 +192000 ELSE NC2014.2 +192100 PERFORM PASS NC2014.2 +192200 PERFORM PRINT-DETAIL. NC2014.2 +192300* NC2014.2 +192400* NC2014.2 +192500 PFM-INIT-F4-20. NC2014.2 +192600 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE NC2014.2 +192700 MOVE "PFM-TEST-F4-20" TO PAR-NAME. NC2014.2 +192800 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +192900 MOVE "VARYING BY FRAC." TO FEATURE. NC2014.2 +193000 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +193100 MOVE ZERO TO COUNT-DU-6V0. NC2014.2 +193200 MOVE ZERO TO REC-CT. NC2014.2 +193300 PFM-TEST-F4-20-0. NC2014.2 +193400 PERFORM PFM-LOOP-F4-20 THROUGH PFM-LOOP-F4-20-EXIT NC2014.2 +193500 VARYING WRK-DU-2V1-1 NC2014.2 +193600 FROM WRK-DU-0V1-1 BY .1 NC2014.2 +193700 UNTIL WRK-DU-2V1-1 + WRK-DU-2V1-3 > 12.1. NC2014.2 +193800 GO TO PFM-TEST-F4-20-1. NC2014.2 +193900 PFM-DELETE-F4-20. NC2014.2 +194000 PERFORM DE-LETE. NC2014.2 +194100 PERFORM PRINT-DETAIL. NC2014.2 +194200 GO TO PFM-INIT-F4-21. NC2014.2 +194300 PFM-LOOP-F4-20. NC2014.2 +194400 ADD 1 TO COUNT-DU-6V0. NC2014.2 +194500 PFM-LOOP-F4-20-EXIT. NC2014.2 +194600 EXIT. NC2014.2 +194700 PFM-TEST-F4-20-1. NC2014.2 +194800 IF COUNT-DU-6V0 = 10 NC2014.2 +194900 PERFORM PASS NC2014.2 +195000 PERFORM PRINT-DETAIL NC2014.2 +195100 ELSE NC2014.2 +195200 PERFORM FAIL NC2014.2 +195300 MOVE COUNT-DU-6V0 TO COMPUTED-N NC2014.2 +195400 MOVE 10 TO CORRECT-N NC2014.2 +195500 PERFORM PRINT-DETAIL. NC2014.2 +195600* NC2014.2 +195700 PFM-INIT-F4-21. NC2014.2 +195800 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE NC2014.2 +195900 MOVE "PFM-TEST-F4-21" TO PAR-NAME. NC2014.2 +196000 MOVE "CHANGE BY INCR." TO FEATURE. NC2014.2 +196100 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +196200 MOVE ZERO TO COUNT-DU-6V0. NC2014.2 +196300 PFM-TEST-F4-21-0. NC2014.2 +196400 PERFORM LOOP-FOR-F4-21 THRU LOOP-F4-21-EXIT NC2014.2 +196500 VARYING WRK-DU-2V1-1 FROM WRK-DU-0V1-1 BY WRK-DU-2V1-2 NC2014.2 +196600 UNTIL WRK-DU-2V1-1 + 11.1 > 12.1. NC2014.2 +196700 GO TO PFM-TEST-F4-21-1. NC2014.2 +196800 PFM-DELETE-F4-21. NC2014.2 +196900 PERFORM DE-LETE. NC2014.2 +197000 PERFORM PRINT-DETAIL. NC2014.2 +197100 GO TO PFM-INIT-F4-22. NC2014.2 +197200 LOOP-FOR-F4-21. NC2014.2 +197300 ADD 1 TO COUNT-DU-6V0. NC2014.2 +197400 ADD .1 TO WRK-DU-2V1-2. NC2014.2 +197500 LOOP-F4-21-EXIT. NC2014.2 +197600 EXIT. NC2014.2 +197700 PFM-TEST-F4-21-1. NC2014.2 +197800 IF COUNT-DU-6V0 = 4 NC2014.2 +197900 PERFORM PASS NC2014.2 +198000 PERFORM PRINT-DETAIL NC2014.2 +198100 ELSE NC2014.2 +198200 PERFORM FAIL NC2014.2 +198300 MOVE COUNT-DU-6V0 TO COMPUTED-N NC2014.2 +198400 MOVE 4 TO CORRECT-N NC2014.2 +198500 PERFORM PRINT-DETAIL. NC2014.2 +198600* NC2014.2 +198700 PFM-INIT-F4-22. NC2014.2 +198800* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2014.2 +198900 MOVE "VI-110 6.20.4 GR5" TO ANSI-REFERENCE. NC2014.2 +199000 MOVE "PFM-TEST-F4-22" TO PAR-NAME. NC2014.2 +199100 MOVE "CHANGE BY INCR." TO FEATURE. NC2014.2 +199200 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +199300 MOVE 44 TO PFM-12-ANS1. NC2014.2 +199400 MOVE 46 TO PFM-12-ANS2. NC2014.2 +199500* NOTE THIS PROGRAM TESTS THE ABILITY OF THE COMPILER TO NC2014.2 +199600* PERFORM A STATEMENT WITH A VARYING CLAUSE INCLUDED. NC2014.2 +199700 PFM-TEST-F4-22-0. NC2014.2 +199800 PERFORM VARYING PFM-12-COUNTER FROM 100 BY 4 NC2014.2 +199900 UNTIL PFM-12-COUNTER NOT GREATER THAN 15 NC2014.2 +200000 AND PFM-12-ANS1 LESS THAN PFM-12-ANS2 NC2014.2 +200100 OR PFM-12-ANS2 GREATER THAN 50 NC2014.2 +200200 ADD 1 TO PFM-12-ANS2 NC2014.2 +200300 SUBTRACT 2 FROM PFM-12-ANS1 NC2014.2 +200400 IF PFM-12-ANS2 GREATER THAN OR EQUAL TO NC2014.2 +200500 PFM-12-ANS1 NC2014.2 +200600 DIVIDE PFM-12-COUNTER BY 2 NC2014.2 +200700 GIVING PFM-12-COUNTER NC2014.2 +200800 IF PFM-12-COUNTER LESS THAN 36 NC2014.2 +200900 SUBTRACT 4 FROM PFM-12-COUNTER NC2014.2 +201000 END-IF NC2014.2 +201100 END-IF NC2014.2 +201200 END-PERFORM. NC2014.2 +201300 GO TO PFM-TEST-F4-22-1. NC2014.2 +201400 PFM-DELETE-F4-22. NC2014.2 +201500 PERFORM DE-LETE. NC2014.2 +201600 GO TO PFM-WRITE-F4-22. NC2014.2 +201700 PFM-TEST-F4-22-1. NC2014.2 +201800 IF PFM-12-COUNTER EQUAL TO 13 NC2014.2 +201900 PERFORM PASS NC2014.2 +202000 GO TO PFM-WRITE-F4-22. NC2014.2 +202100 PERFORM FAIL. NC2014.2 +202200 MOVE PFM-12-COUNTER TO COMPUTED-A. NC2014.2 +202300 MOVE "13" TO CORRECT-A. NC2014.2 +202400 PFM-WRITE-F4-22. NC2014.2 +202500 MOVE "PFM-TEST-F4-22" TO PAR-NAME. NC2014.2 +202600 PERFORM PRINT-DETAIL. NC2014.2 +202700* NC2014.2 +202800* NC2014.2 +202900 PFM-INIT-F4-23. NC2014.2 +203000* ===--> ORDER OF INITIALISATION <--=== NC2014.2 +203100* ===--> OF VARYING IDENTIFIERS. <--=== NC2014.2 +203200 MOVE "VI-114 6.20.4 GR10(d)1" TO ANSI-REFERENCE. NC2014.2 +203300 MOVE "PFM-TEST-F4-23" TO PAR-NAME. NC2014.2 +203400 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +203500 MOVE 0 TO PFM-F4-23-TOT. NC2014.2 +203600 PFM-TEST-F4-23-0. NC2014.2 +203700 PERFORM PFM-F4-23-PROC NC2014.2 +203800 VARYING PFM-A1 FROM 1 BY 1 NC2014.2 +203900 UNTIL PFM-A1 > 3 NC2014.2 +204000 AFTER PFM-B1 FROM PFM-A1 BY 1 NC2014.2 +204100 UNTIL PFM-B1 > 3. NC2014.2 +204200 GO TO PFM-TEST-F4-23-1. NC2014.2 +204300 PFM-DELETE-F4-23. NC2014.2 +204400 PERFORM DE-LETE. NC2014.2 +204500 PERFORM PRINT-DETAIL. NC2014.2 +204600 GO TO PFM-INIT-F4-24. NC2014.2 +204700 PFM-F4-23-PROC. NC2014.2 +204800 ADD 1 TO PFM-F4-23-TOT. NC2014.2 +204900 PFM-TEST-F4-23-1. NC2014.2 +205000 IF PFM-F4-23-TOT = 6 NC2014.2 +205100 PERFORM PASS NC2014.2 +205200 PERFORM PRINT-DETAIL NC2014.2 +205300 ELSE NC2014.2 +205400 MOVE 6 TO CORRECT-18V0 NC2014.2 +205500 MOVE PFM-F4-23-TOT TO COMPUTED-18V0 NC2014.2 +205600 PERFORM FAIL NC2014.2 +205700 PERFORM PRINT-DETAIL. NC2014.2 +205800 MOVE 2 TO PERFORM9. NC2014.2 +205900 MOVE 2 TO PERFORM10. NC2014.2 +206000* NC2014.2 +206100 PFM-INIT-F4-24. NC2014.2 +206200* ===--> MANIPULATING SUBSCRIPTS <--=== NC2014.2 +206300 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE. NC2014.2 +206400 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +206500 INITIALIZE FILLER-A. NC2014.2 +206600 MOVE 1 TO S1 S2 S3. NC2014.2 +206700 MOVE 10 TO PFM-F4-24-B (1) MOVE 20 TO PFM-F4-24-B (2). NC2014.2 +206800 MOVE 30 TO PFM-F4-24-B (3) MOVE 40 TO PFM-F4-24-B (4). NC2014.2 +206900 MOVE 50 TO PFM-F4-24-B (5) MOVE 60 TO PFM-F4-24-B (6). NC2014.2 +207000 MOVE 70 TO PFM-F4-24-B (7) MOVE 80 TO PFM-F4-24-B (8). NC2014.2 +207100 MOVE 90 TO PFM-F4-24-B (9) MOVE 100 TO PFM-F4-24-B (10). NC2014.2 +207200 MOVE 10 TO PFM-F4-24-C (1) MOVE 20 TO PFM-F4-24-C (2). NC2014.2 +207300 MOVE 30 TO PFM-F4-24-C (3) MOVE 40 TO PFM-F4-24-C (4). NC2014.2 +207400 MOVE 50 TO PFM-F4-24-C (5) MOVE 60 TO PFM-F4-24-C (6). NC2014.2 +207500 MOVE 70 TO PFM-F4-24-C (7) MOVE 80 TO PFM-F4-24-C (8). NC2014.2 +207600 MOVE 90 TO PFM-F4-24-C (9) MOVE 100 TO PFM-F4-24-C (10). NC2014.2 +207700 MOVE 0 TO PERFORM18. NC2014.2 +207800 PFM-TEST-F4-24-0. NC2014.2 +207900 PERFORM PFM-A-F4-24 NC2014.2 +208000 VARYING PFM-F4-24-A (S1) NC2014.2 +208100 FROM 10 NC2014.2 +208200 BY PFM-F4-24-C (S2) NC2014.2 +208300 UNTIL PFM-F4-24-A (S1) > 70. NC2014.2 +208400 PFM-TEST-F4-24-1. NC2014.2 +208500 IF PFM-F4-24-A (S1) EQUAL TO 80 NC2014.2 +208600 PERFORM PASS GO TO PFM-WRITE-F4-24-1. NC2014.2 +208700 PERFORM FAIL. NC2014.2 +208800 MOVE PFM-F4-24-A (S1) TO COMPUTED-N. NC2014.2 +208900 MOVE 80 TO CORRECT-N. NC2014.2 +209000 GO TO PFM-WRITE-F4-24-1. NC2014.2 +209100 PFM-DELETE-F4-24-1. NC2014.2 +209200 PERFORM DE-LETE. NC2014.2 +209300 GO TO PFM-WRITE-F4-24-1. NC2014.2 +209400 PFM-A-F4-24. NC2014.2 +209500 ADD 1 TO PERFORM18. NC2014.2 +209600 MULTIPLY 2 BY S2. NC2014.2 +209700 ADD 1 TO S1 S3. NC2014.2 +209800 PFM-WRITE-F4-24-1. NC2014.2 +209900 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +210000 PERFORM PRINT-DETAIL. NC2014.2 +210100 PFM-TEST-F4-24-2. NC2014.2 +210200 IF S1 EQUAL TO 4 NC2014.2 +210300 PERFORM PASS GO TO PFM-WRITE-F4-24-2. NC2014.2 +210400 PERFORM FAIL. NC2014.2 +210500 MOVE S1 TO COMPUTED-N. NC2014.2 +210600 MOVE 4 TO CORRECT-N. NC2014.2 +210700 GO TO PFM-WRITE-F4-24-2. NC2014.2 +210800 PFM-DELETE-F4-24-2. NC2014.2 +210900 PERFORM DE-LETE. NC2014.2 +211000 GO TO PFM-WRITE-F4-24-2. NC2014.2 +211100 PFM-A-F4-24-2. NC2014.2 +211200 ADD 1 TO PERFORM18. NC2014.2 +211300 MULTIPLY 2 BY S2. NC2014.2 +211400 ADD 1 TO S1 S3. NC2014.2 +211500 PFM-WRITE-F4-24-2. NC2014.2 +211600 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +211700 PERFORM PRINT-DETAIL. NC2014.2 +211800 CCVS-EXIT SECTION. NC2014.2 +211900 CCVS-999999. NC2014.2 +212000 GO TO CLOSE-FILES. NC2014.2 +*END-OF,NC201A +*HEADER,COBOL,NC202A +000100 IDENTIFICATION DIVISION. NC2024.2 +000200 PROGRAM-ID. NC2024.2 +000300 NC202A. NC2024.2 +000400 NC2024.2 +000500**************************************************************** NC2024.2 +000600* * NC2024.2 +000700* VALIDATION FOR:- * NC2024.2 +000800* * NC2024.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +001000* * NC2024.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2024.2 +001200* * NC2024.2 +001300**************************************************************** NC2024.2 +001400* * NC2024.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2024.2 +001600* * NC2024.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2024.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2024.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2024.2 +002000* * NC2024.2 +002100**************************************************************** NC2024.2 +002200* NC2024.2 +002300* PROGRAM NC202A TESTS FORMAT3 OF THE ADD STATEMENT. NC2024.2 +002400* NC2024.2 +002500 ENVIRONMENT DIVISION. NC2024.2 +002600 CONFIGURATION SECTION. NC2024.2 +002700 SOURCE-COMPUTER. NC2024.2 +002800 XXXXX082. NC2024.2 +002900 OBJECT-COMPUTER. NC2024.2 +003000 XXXXX083. NC2024.2 +003100 INPUT-OUTPUT SECTION. NC2024.2 +003200 FILE-CONTROL. NC2024.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2024.2 +003400 XXXXX055. NC2024.2 +003500 DATA DIVISION. NC2024.2 +003600 FILE SECTION. NC2024.2 +003700 FD PRINT-FILE. NC2024.2 +003800 01 PRINT-REC PICTURE X(120). NC2024.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2024.2 +004000 WORKING-STORAGE SECTION. NC2024.2 +004100 01 TABLE1. NC2024.2 +004200 02 RECORD1 PICTURE 99. NC2024.2 +004300 02 RECORD2 PICTURE 99 NC2024.2 +004400 OCCURS 2 TIMES NC2024.2 +004500 INDEXED BY INDEX1. NC2024.2 +004600 02 RECORD3 PICTURE 99. NC2024.2 +004700 01 TABLE2. NC2024.2 +004800 02 RECORD1 PICTURE 99. NC2024.2 +004900 02 RECORD2 PICTURE 99 NC2024.2 +005000 OCCURS 2 TIMES NC2024.2 +005100 INDEXED BY INDEX2. NC2024.2 +005200 02 RECORD3 PICTURE 99. NC2024.2 +005300 77 WRK-AN-00001 PICTURE X. NC2024.2 +005400 77 WRK-XN-00001 PICTURE X. NC2024.2 +005500 77 WRK-DS-01V00 PICTURE S9. NC2024.2 +005600 77 WRK-DS-02V00 PICTURE S99. NC2024.2 +005700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2024.2 +005800 77 WRK-DS-05V00 PICTURE S9(5). NC2024.2 +005900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2024.2 +006000 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2024.2 +006100 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2024.2 +006200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2024.2 +006300 VALUE 111111111.111111111. NC2024.2 +006400 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2024.2 +006500 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2024.2 +006600 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2024.2 +006700 77 WRK-DS-03V00 PICTURE S999. NC2024.2 +006800 77 WRK-DS-06V00 PICTURE S9(6). NC2024.2 +006900 77 WRK-DS-0201P PICTURE S99P. NC2024.2 +007000 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2024.2 +007100 77 ADD-1 PICTURE S9(8)V99 VALUE 1. NC2024.2 +007200 77 ADD-2 PICTURE S9(6)V9(4) VALUE 1. NC2024.2 +007300 77 ADD-3 PICTURE S9(5) VALUE -1. NC2024.2 +007400 77 ADD-4 PICTURE 9 VALUE 9. NC2024.2 +007500 77 ADD-5 PICTURE 9 VALUE 9. NC2024.2 +007600 77 ADD-6 PICTURE 9(5) VALUE 99999. NC2024.2 +007700 77 ADD-7 PICTURE 9 VALUE 1. NC2024.2 +007800 77 ADD-8 PICTURE 9. NC2024.2 +007900 77 ADD-9 PICTURE S9(8)V99 VALUE 5.9. NC2024.2 +008000 77 ADD-10 PICTURE 9(5) VALUE 52800. NC2024.2 +008100 77 ADD-11 PICTURE 99999. NC2024.2 +008200 77 ADD-12 PICTURE PP9 VALUE .001. NC2024.2 +008300 77 ADD-13 PICTURE 9PP VALUE 100. NC2024.2 +008400 77 ADD-14 PICTURE 999V999. NC2024.2 +008500 77 W-1 PICTURE IS 9. NC2024.2 +008600 77 W-2 PICTURE IS 99. NC2024.2 +008700 77 W-3 PICTURE IS 999. NC2024.2 +008800 77 W-4 PICTURE 9 VALUE 0. NC2024.2 +008900 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2024.2 +009000 77 W-9 PICTURE 999. NC2024.2 +009100 77 D-5 PICTURE S999 VALUE -1. NC2024.2 +009200 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2024.2 +009300 77 ONE PICTURE 9 VALUE 1. NC2024.2 +009400 77 TWO PICTURE S9 VALUE 2. NC2024.2 +009500 77 THREE PICTURE S9 VALUE 3. NC2024.2 +009600 77 FOUR PICTURE S9 VALUE 4. NC2024.2 +009700 77 FIVE PICTURE S9 VALUE 5. NC2024.2 +009800 77 SIX PICTURE S9 VALUE 6. NC2024.2 +009900 77 SEVEN PICTURE S9 VALUE 7. NC2024.2 +010000 77 EIGHT PICTURE 9 VALUE 8. NC2024.2 +010100 77 NINE PICTURE S9 VALUE 9. NC2024.2 +010200 77 TEN PICTURE S99 VALUE 10. NC2024.2 +010300 77 FIFTEEN PICTURE S99 VALUE 15. NC2024.2 +010400 77 TWENTY PICTURE S99 VALUE 20. NC2024.2 +010500 77 TWENTY-5 PICTURE S99 VALUE 25. NC2024.2 +010600 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2024.2 +010700 01 GRP-FOR-ADD-CORR-1. NC2024.2 +010800 02 GRP-SUBTRACT-CORR-1. NC2024.2 +010900 03 FILLER PICTURE S99 VALUE 91. NC2024.2 +011000 03 ADD-CORR-2 PICTURE S99 VALUE 22. NC2024.2 +011100 03 ADD-CORR-1 PICTURE S99 VALUE 11. NC2024.2 +011200 03 ADD-CORR-A PICTURE S99 VALUE 93. NC2024.2 +011300 03 ADD-CORR-4 PICTURE S99 VALUE 44. NC2024.2 +011400 03 ADD-CORR-3 PICTURE S99 VALUE 33. NC2024.2 +011500 03 ADD-CORR-6 PICTURE S99 VALUE 66. NC2024.2 +011600 03 ADD-CORR-5 PICTURE S99 VALUE 55. NC2024.2 +011700 03 ADD-CORR-8 PICTURE S99 VALUE 88. NC2024.2 +011800 03 ADD-CORR-7 PICTURE S99 VALUE 77. NC2024.2 +011900 03 ADD-CORR-9 PICTURE S99 VALUE 99. NC2024.2 +012000 01 GRP-FOR-ADD-CORR-R. NC2024.2 +012100 02 GRP-SUBTRACT-CORR-1. NC2024.2 +012200 05 ADD-CORR-1 PICTURE 99. NC2024.2 +012300 05 ADD-CORR-2 PICTURE 99. NC2024.2 +012400 05 ADD-CORR-3 PICTURE 99. NC2024.2 +012500 05 ADD-CORR-4 PICTURE 99. NC2024.2 +012600 05 ADD-CORR-5 PICTURE 9P. NC2024.2 +012700 05 ADD-CORR-6 PICTURE 999. NC2024.2 +012800 05 ADD-CORR-7 PICTURE 99. NC2024.2 +012900 05 ADD-CORR-8 PICTURE 99. NC2024.2 +013000 05 ADD-CORR-9 PICTURE 99. NC2024.2 +013100 05 FILLER PICTURE 99. NC2024.2 +013200 01 GRP-FOR-ADD-CORR-2. NC2024.2 +013300 02 GRP-ADD-SUB-CORR. NC2024.2 +013400 03 GRP-SUBTRACT-CORR-1. NC2024.2 +013500 04 ADD-CORR-1 PICTURE S99 VALUE 11. NC2024.2 +013600 04 ADD-CORR-2 PICTURE S99 VALUE 22. NC2024.2 +013700 04 ADD-CORR-5 PICTURE S99 VALUE 55. NC2024.2 +013800 04 ADD-CORR-4 PICTURE S99 VALUE 44. NC2024.2 +013900 04 ADD-CORR-3 PICTURE S99 VALUE 33. NC2024.2 +014000 04 ADD-CORR-6 PICTURE S99 VALUE 66. NC2024.2 +014100 04 ADD-CORR-7 PICTURE S99 VALUE 77. NC2024.2 +014200 04 ADD-CORR-8 PICTURE S99 VALUE 88. NC2024.2 +014300 04 ADD-CORR-9 PICTURE S99 VALUE 99. NC2024.2 +014400 04 ADD-CORR-B PICTURE S99 VALUE 92. NC2024.2 +014500 04 ADD-CORR-0 PICTURE S99 VALUE 00. NC2024.2 +014600 01 GRP-FOR-ADD-CORR-A. NC2024.2 +014700 02 GRP-SUBTRACT-CORR-3. NC2024.2 +014800 03 GRP-SUBTRACT-CORR-1. NC2024.2 +014900 05 ADD-CORR-4 PICTURE S999 VALUE 044. NC2024.2 +015000 05 ADD-CORR-3 PICTURE S999 VALUE 033. NC2024.2 +015100 05 ADD-CORR-2 PICTURE S999 VALUE 022. NC2024.2 +015200 05 ADD-CORR-1 PICTURE S999 VALUE 111. NC2024.2 +015300 01 ADD-15. NC2024.2 +015400 02 FIELD1 PICTURE 99999 VALUE 1. NC2024.2 +015500 02 FIELD2 PICTURE 999V99 VALUE 32.1. NC2024.2 +015600 02 FIELD3 PICTURE 999V9 VALUE 123.4. NC2024.2 +015700 01 ADD-16. NC2024.2 +015800 02 FIELD1 PICTURE 99999 VALUE 99999. NC2024.2 +015900 02 FIELD2 PICTURE 999V99 VALUE 745.67. NC2024.2 +016000 02 FIELD3 PICTURE 999V9 VALUE 432.1. NC2024.2 +016100 01 SUBTRACT-DATA. NC2024.2 +016200 02 SUBTR-1 PICTURE 9 VALUE 1. NC2024.2 +016300 02 SUBTR-2 PICTURE S99 VALUE 99. NC2024.2 +016400 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC2024.2 +016500 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC2024.2 +016600 02 SUBTR-5 PICTURE S9PP VALUE 100. NC2024.2 +016700 02 SUBTR-6 PICTURE 9 VALUE 1. NC2024.2 +016800 02 SUBTR-7 PICTURE S99 VALUE 99. NC2024.2 +016900 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC2024.2 +017000 02 SUBTR-9 PICTURE SV999. NC2024.2 +017100 02 SUBTR-10 PICTURE S999 VALUE 100. NC2024.2 +017200 02 SUBTR-11 PICTURE S999V999. NC2024.2 +017300 02 SUBTR-12. NC2024.2 +017400 03 SUBTR-13 PICTURE 9 VALUE 1. NC2024.2 +017500 03 SUBTR-14 PICTURE S9V999 VALUE -1.725. NC2024.2 +017600 03 SUBTR-15 PICTURE S99V99 VALUE 76.76. NC2024.2 +017700 02 SUBTR-16. NC2024.2 +017800 03 SUBTR-13 PICTURE 9 VALUE 2. NC2024.2 +017900 03 SUBTR-14 PICTURE S9V99 VALUE .23. NC2024.2 +018000 03 SUBTR-15 PICTURE S9V99 VALUE 1. NC2024.2 +018100 01 CORR-DATA-1. NC2024.2 +018200 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018300 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018400 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018500 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018600 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018700 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018800 01 CORR-DATA-2. NC2024.2 +018900 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019000 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019100 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019200 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019300 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019400 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019500 01 CORR-DATA-3. NC2024.2 +019600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019700 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019900 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020000 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020100 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020200 01 CORR-DATA-4. NC2024.2 +020300 03 XYZ-11 PICTURE IS 99. NC2024.2 +020400 03 XYZ-12 PICTURE IS 99. NC2024.2 +020500 03 XYZ-13 PICTURE IS 99. NC2024.2 +020600 03 XYZ-14 PICTURE IS 99. NC2024.2 +020700 03 XYZ-15 PICTURE IS 99. NC2024.2 +020800 03 XYZ-16 PICTURE IS 99. NC2024.2 +020900 01 CORR-DATA-5. NC2024.2 +021000 03 XYZ-1 PICTURE 99. NC2024.2 +021100 03 XYZ-2 PICTURE 99. NC2024.2 +021200 03 XYZ-13 PICTURE IS 99. NC2024.2 +021300 03 XYZ-14 PICTURE IS 99. NC2024.2 +021400 03 FILLER PICTURE IS 99. NC2024.2 +021500 03 XYZ-11 PICTURE IS 99. NC2024.2 +021600 03 XYZ-12 PICTURE IS 99. NC2024.2 +021700 01 CORR-DATA-6. NC2024.2 +021800 03 XYZ-11 PICTURE IS 99. NC2024.2 +021900 03 XYZ-12 PICTURE IS 99. NC2024.2 +022000 03 FILLER PICTURE IS 99. NC2024.2 +022100 03 XYZ-1 PICTURE IS 99. NC2024.2 +022200 03 XYZ-2 PICTURE IS 9(2). NC2024.2 +022300 03 FILLER PICTURE IS 99. NC2024.2 +022400 01 CORR-DATA-7. NC2024.2 +022500 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2024.2 +022600 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2024.2 +022700 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2024.2 +022800 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2024.2 +022900 01 42-DATANAMES. NC2024.2 +023000 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2024.2 +023100 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC2024.2 +023200 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC2024.2 +023300 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC2024.2 +023400 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC2024.2 +023500 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC2024.2 +023600 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC2024.2 +023700 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC2024.2 +023800 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC2024.2 +023900 02 DNAME10 PICTURE 9(10) VALUE 1. NC2024.2 +024000 02 DNAME11 PICTURE 9(11) VALUE 1. NC2024.2 +024100 02 DNAME12 PICTURE 9(12) VALUE 1. NC2024.2 +024200 02 DNAME13 PICTURE 9(13) VALUE 1. NC2024.2 +024300 02 DNAME14 PICTURE 9(14) VALUE 1. NC2024.2 +024400 02 DNAME15 PICTURE 9(15) VALUE 1. NC2024.2 +024500 02 DNAME16 PICTURE 9(16) VALUE 1. NC2024.2 +024600 02 DNAME17 PICTURE 9(17) VALUE 1. NC2024.2 +024700 02 DNAME18 PICTURE 9(18) VALUE 1. NC2024.2 +024800 02 DNAME19 PICTURE 9 VALUE 1. NC2024.2 +024900 02 DNAME20 PICTURE 99 VALUE 1. NC2024.2 +025000 02 DNAME21 PICTURE 999 VALUE 1. NC2024.2 +025100 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2024.2 +025200 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2024.2 +025300 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2024.2 +025400 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2024.2 +025500 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2024.2 +025600 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2024.2 +025700 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2024.2 +025800 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2024.2 +025900 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026000 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026100 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026200 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026300 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026400 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026500 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026600 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026700 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026800 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026900 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027000 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027100 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027200 01 TEST-RESULTS. NC2024.2 +027300 02 FILLER PIC X VALUE SPACE. NC2024.2 +027400 02 FEATURE PIC X(20) VALUE SPACE. NC2024.2 +027500 02 FILLER PIC X VALUE SPACE. NC2024.2 +027600 02 P-OR-F PIC X(5) VALUE SPACE. NC2024.2 +027700 02 FILLER PIC X VALUE SPACE. NC2024.2 +027800 02 PAR-NAME. NC2024.2 +027900 03 FILLER PIC X(19) VALUE SPACE. NC2024.2 +028000 03 PARDOT-X PIC X VALUE SPACE. NC2024.2 +028100 03 DOTVALUE PIC 99 VALUE ZERO. NC2024.2 +028200 02 FILLER PIC X(8) VALUE SPACE. NC2024.2 +028300 02 RE-MARK PIC X(61). NC2024.2 +028400 01 TEST-COMPUTED. NC2024.2 +028500 02 FILLER PIC X(30) VALUE SPACE. NC2024.2 +028600 02 FILLER PIC X(17) VALUE NC2024.2 +028700 " COMPUTED=". NC2024.2 +028800 02 COMPUTED-X. NC2024.2 +028900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2024.2 +029000 03 COMPUTED-N REDEFINES COMPUTED-A NC2024.2 +029100 PIC -9(9).9(9). NC2024.2 +029200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2024.2 +029300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2024.2 +029400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2024.2 +029500 03 CM-18V0 REDEFINES COMPUTED-A. NC2024.2 +029600 04 COMPUTED-18V0 PIC -9(18). NC2024.2 +029700 04 FILLER PIC X. NC2024.2 +029800 03 FILLER PIC X(50) VALUE SPACE. NC2024.2 +029900 01 TEST-CORRECT. NC2024.2 +030000 02 FILLER PIC X(30) VALUE SPACE. NC2024.2 +030100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2024.2 +030200 02 CORRECT-X. NC2024.2 +030300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2024.2 +030400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2024.2 +030500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2024.2 +030600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2024.2 +030700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2024.2 +030800 03 CR-18V0 REDEFINES CORRECT-A. NC2024.2 +030900 04 CORRECT-18V0 PIC -9(18). NC2024.2 +031000 04 FILLER PIC X. NC2024.2 +031100 03 FILLER PIC X(2) VALUE SPACE. NC2024.2 +031200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2024.2 +031300 01 CCVS-C-1. NC2024.2 +031400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2024.2 +031500- "SS PARAGRAPH-NAME NC2024.2 +031600- " REMARKS". NC2024.2 +031700 02 FILLER PIC X(20) VALUE SPACE. NC2024.2 +031800 01 CCVS-C-2. NC2024.2 +031900 02 FILLER PIC X VALUE SPACE. NC2024.2 +032000 02 FILLER PIC X(6) VALUE "TESTED". NC2024.2 +032100 02 FILLER PIC X(15) VALUE SPACE. NC2024.2 +032200 02 FILLER PIC X(4) VALUE "FAIL". NC2024.2 +032300 02 FILLER PIC X(94) VALUE SPACE. NC2024.2 +032400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2024.2 +032500 01 REC-CT PIC 99 VALUE ZERO. NC2024.2 +032600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2024.2 +033000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2024.2 +033100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2024.2 +033200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2024.2 +033300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2024.2 +033400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2024.2 +033500 01 CCVS-H-1. NC2024.2 +033600 02 FILLER PIC X(39) VALUE SPACES. NC2024.2 +033700 02 FILLER PIC X(42) VALUE NC2024.2 +033800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2024.2 +033900 02 FILLER PIC X(39) VALUE SPACES. NC2024.2 +034000 01 CCVS-H-2A. NC2024.2 +034100 02 FILLER PIC X(40) VALUE SPACE. NC2024.2 +034200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2024.2 +034300 02 FILLER PIC XXXX VALUE NC2024.2 +034400 "4.2 ". NC2024.2 +034500 02 FILLER PIC X(28) VALUE NC2024.2 +034600 " COPY - NOT FOR DISTRIBUTION". NC2024.2 +034700 02 FILLER PIC X(41) VALUE SPACE. NC2024.2 +034800 NC2024.2 +034900 01 CCVS-H-2B. NC2024.2 +035000 02 FILLER PIC X(15) VALUE NC2024.2 +035100 "TEST RESULT OF ". NC2024.2 +035200 02 TEST-ID PIC X(9). NC2024.2 +035300 02 FILLER PIC X(4) VALUE NC2024.2 +035400 " IN ". NC2024.2 +035500 02 FILLER PIC X(12) VALUE NC2024.2 +035600 " HIGH ". NC2024.2 +035700 02 FILLER PIC X(22) VALUE NC2024.2 +035800 " LEVEL VALIDATION FOR ". NC2024.2 +035900 02 FILLER PIC X(58) VALUE NC2024.2 +036000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +036100 01 CCVS-H-3. NC2024.2 +036200 02 FILLER PIC X(34) VALUE NC2024.2 +036300 " FOR OFFICIAL USE ONLY ". NC2024.2 +036400 02 FILLER PIC X(58) VALUE NC2024.2 +036500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2024.2 +036600 02 FILLER PIC X(28) VALUE NC2024.2 +036700 " COPYRIGHT 1985 ". NC2024.2 +036800 01 CCVS-E-1. NC2024.2 +036900 02 FILLER PIC X(52) VALUE SPACE. NC2024.2 +037000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2024.2 +037100 02 ID-AGAIN PIC X(9). NC2024.2 +037200 02 FILLER PIC X(45) VALUE SPACES. NC2024.2 +037300 01 CCVS-E-2. NC2024.2 +037400 02 FILLER PIC X(31) VALUE SPACE. NC2024.2 +037500 02 FILLER PIC X(21) VALUE SPACE. NC2024.2 +037600 02 CCVS-E-2-2. NC2024.2 +037700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2024.2 +037800 03 FILLER PIC X VALUE SPACE. NC2024.2 +037900 03 ENDER-DESC PIC X(44) VALUE NC2024.2 +038000 "ERRORS ENCOUNTERED". NC2024.2 +038100 01 CCVS-E-3. NC2024.2 +038200 02 FILLER PIC X(22) VALUE NC2024.2 +038300 " FOR OFFICIAL USE ONLY". NC2024.2 +038400 02 FILLER PIC X(12) VALUE SPACE. NC2024.2 +038500 02 FILLER PIC X(58) VALUE NC2024.2 +038600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +038700 02 FILLER PIC X(13) VALUE SPACE. NC2024.2 +038800 02 FILLER PIC X(15) VALUE NC2024.2 +038900 " COPYRIGHT 1985". NC2024.2 +039000 01 CCVS-E-4. NC2024.2 +039100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2024.2 +039200 02 FILLER PIC X(4) VALUE " OF ". NC2024.2 +039300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2024.2 +039400 02 FILLER PIC X(40) VALUE NC2024.2 +039500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2024.2 +039600 01 XXINFO. NC2024.2 +039700 02 FILLER PIC X(19) VALUE NC2024.2 +039800 "*** INFORMATION ***". NC2024.2 +039900 02 INFO-TEXT. NC2024.2 +040000 04 FILLER PIC X(8) VALUE SPACE. NC2024.2 +040100 04 XXCOMPUTED PIC X(20). NC2024.2 +040200 04 FILLER PIC X(5) VALUE SPACE. NC2024.2 +040300 04 XXCORRECT PIC X(20). NC2024.2 +040400 02 INF-ANSI-REFERENCE PIC X(48). NC2024.2 +040500 01 HYPHEN-LINE. NC2024.2 +040600 02 FILLER PIC IS X VALUE IS SPACE. NC2024.2 +040700 02 FILLER PIC IS X(65) VALUE IS "************************NC2024.2 +040800- "*****************************************". NC2024.2 +040900 02 FILLER PIC IS X(54) VALUE IS "************************NC2024.2 +041000- "******************************". NC2024.2 +041100 01 CCVS-PGM-ID PIC X(9) VALUE NC2024.2 +041200 "NC202A". NC2024.2 +041300 PROCEDURE DIVISION. NC2024.2 +041400 CCVS1 SECTION. NC2024.2 +041500 OPEN-FILES. NC2024.2 +041600 OPEN OUTPUT PRINT-FILE. NC2024.2 +041700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2024.2 +041800 MOVE SPACE TO TEST-RESULTS. NC2024.2 +041900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2024.2 +042000 GO TO CCVS1-EXIT. NC2024.2 +042100 CLOSE-FILES. NC2024.2 +042200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2024.2 +042300 TERMINATE-CCVS. NC2024.2 +042400S EXIT PROGRAM. NC2024.2 +042500STERMINATE-CALL. NC2024.2 +042600 STOP RUN. NC2024.2 +042700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2024.2 +042800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2024.2 +042900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2024.2 +043000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2024.2 +043100 MOVE "****TEST DELETED****" TO RE-MARK. NC2024.2 +043200 PRINT-DETAIL. NC2024.2 +043300 IF REC-CT NOT EQUAL TO ZERO NC2024.2 +043400 MOVE "." TO PARDOT-X NC2024.2 +043500 MOVE REC-CT TO DOTVALUE. NC2024.2 +043600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2024.2 +043700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2024.2 +043800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2024.2 +043900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2024.2 +044000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2024.2 +044100 MOVE SPACE TO CORRECT-X. NC2024.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2024.2 +044300 MOVE SPACE TO RE-MARK. NC2024.2 +044400 HEAD-ROUTINE. NC2024.2 +044500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +044600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +044700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2024.2 +044800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2024.2 +044900 COLUMN-NAMES-ROUTINE. NC2024.2 +045000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +045100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +045200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +045300 END-ROUTINE. NC2024.2 +045400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2024.2 +045500 END-RTN-EXIT. NC2024.2 +045600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +045700 END-ROUTINE-1. NC2024.2 +045800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2024.2 +045900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2024.2 +046000 ADD PASS-COUNTER TO ERROR-HOLD. NC2024.2 +046100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2024.2 +046200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2024.2 +046300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2024.2 +046400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2024.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2024.2 +046600 END-ROUTINE-12. NC2024.2 +046700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2024.2 +046800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2024.2 +046900 MOVE "NO " TO ERROR-TOTAL NC2024.2 +047000 ELSE NC2024.2 +047100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2024.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2024.2 +047300 PERFORM WRITE-LINE. NC2024.2 +047400 END-ROUTINE-13. NC2024.2 +047500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2024.2 +047600 MOVE "NO " TO ERROR-TOTAL ELSE NC2024.2 +047700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2024.2 +047800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2024.2 +047900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048000 IF INSPECT-COUNTER EQUAL TO ZERO NC2024.2 +048100 MOVE "NO " TO ERROR-TOTAL NC2024.2 +048200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2024.2 +048300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2024.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048600 WRITE-LINE. NC2024.2 +048700 ADD 1 TO RECORD-COUNT. NC2024.2 +048800Y IF RECORD-COUNT GREATER 50 NC2024.2 +048900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2024.2 +049000Y MOVE SPACE TO DUMMY-RECORD NC2024.2 +049100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2024.2 +049200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2024.2 +049300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2024.2 +049400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2024.2 +049500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2024.2 +049600Y MOVE ZERO TO RECORD-COUNT. NC2024.2 +049700 PERFORM WRT-LN. NC2024.2 +049800 WRT-LN. NC2024.2 +049900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2024.2 +050000 MOVE SPACE TO DUMMY-RECORD. NC2024.2 +050100 BLANK-LINE-PRINT. NC2024.2 +050200 PERFORM WRT-LN. NC2024.2 +050300 FAIL-ROUTINE. NC2024.2 +050400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2024.2 +050500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2024.2 +050600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2024.2 +050700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2024.2 +050800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2024.2 +051000 GO TO FAIL-ROUTINE-EX. NC2024.2 +051100 FAIL-ROUTINE-WRITE. NC2024.2 +051200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2024.2 +051300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2024.2 +051400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2024.2 +051500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2024.2 +051600 FAIL-ROUTINE-EX. EXIT. NC2024.2 +051700 BAIL-OUT. NC2024.2 +051800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2024.2 +051900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2024.2 +052000 BAIL-OUT-WRITE. NC2024.2 +052100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2024.2 +052200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2024.2 +052300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2024.2 +052500 BAIL-OUT-EX. EXIT. NC2024.2 +052600 CCVS1-EXIT. NC2024.2 +052700 EXIT. NC2024.2 +052800 SECT-NC202A-001 SECTION. NC2024.2 +052900 ADD-INIT-F3-1. NC2024.2 +053000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +053100 MOVE "ADD CORRESPONDING " TO FEATURE. NC2024.2 +053200 MOVE "ADD-TEST-F3-1" TO PAR-NAME. NC2024.2 +053300 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +053400 MOVE 11 TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053500 MOVE 22 TO ADD-CORR-2 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053600 MOVE 33 TO ADD-CORR-3 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053700 MOVE 44 TO ADD-CORR-4 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053800 MOVE 55 TO ADD-CORR-5 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053900 MOVE 66 TO ADD-CORR-6 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054000 MOVE 77 TO ADD-CORR-7 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054100 MOVE 88 TO ADD-CORR-8 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054200 MOVE 99 TO ADD-CORR-9 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054300 ADD-TEST-F3-1. NC2024.2 +054400 ADD CORRESPONDING GRP-FOR-ADD-CORR-1 TO GRP-FOR-ADD-CORR-R. NC2024.2 +054500 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344506677889900" NC2024.2 +054600 PERFORM PASS NC2024.2 +054700 GO TO ADD-WRITE-F3-1. NC2024.2 +054800 GO TO ADD-FAIL-F3-1. NC2024.2 +054900 ADD-DELETE-F3-1. NC2024.2 +055000 PERFORM DE-LETE. NC2024.2 +055100 GO TO ADD-WRITE-F3-1. NC2024.2 +055200 ADD-FAIL-F3-1. NC2024.2 +055300 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +055400 MOVE "11223344506677889900" TO CORRECT-A. NC2024.2 +055500 PERFORM FAIL. NC2024.2 +055600 ADD-WRITE-F3-1. NC2024.2 +055700 PERFORM PRINT-DETAIL. NC2024.2 +055800* NC2024.2 +055900 ADD-INIT-F3-2. NC2024.2 +056000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +056100 MOVE "ADD-TEST-F3-2" TO PAR-NAME. NC2024.2 +056200 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +056300 MOVE 11 TO ADD-CORR-1 OF GRP-ADD-SUB-CORR. NC2024.2 +056400 MOVE 22 TO ADD-CORR-2 OF GRP-ADD-SUB-CORR. NC2024.2 +056500 MOVE 33 TO ADD-CORR-3 OF GRP-ADD-SUB-CORR. NC2024.2 +056600 MOVE 44 TO ADD-CORR-4 OF GRP-ADD-SUB-CORR. NC2024.2 +056700 MOVE 55 TO ADD-CORR-5 OF GRP-ADD-SUB-CORR. NC2024.2 +056800 MOVE 66 TO ADD-CORR-6 OF GRP-ADD-SUB-CORR. NC2024.2 +056900 MOVE 77 TO ADD-CORR-7 OF GRP-ADD-SUB-CORR. NC2024.2 +057000 MOVE 88 TO ADD-CORR-8 OF GRP-ADD-SUB-CORR. NC2024.2 +057100 MOVE 99 TO ADD-CORR-9 OF GRP-ADD-SUB-CORR. NC2024.2 +057200 ADD-TEST-F3-2. NC2024.2 +057300 ADD CORRESPONDING GRP-ADD-SUB-CORR TO NC2024.2 +057400 GRP-FOR-ADD-CORR-R ROUNDED. NC2024.2 +057500 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344606677889900" NC2024.2 +057600 PERFORM PASS NC2024.2 +057700 GO TO ADD-WRITE-F3-2. NC2024.2 +057800 GO TO ADD-FAIL-F3-2. NC2024.2 +057900 ADD-DELETE-F3-2. NC2024.2 +058000 PERFORM DE-LETE. NC2024.2 +058100 GO TO ADD-WRITE-F3-2. NC2024.2 +058200 ADD-FAIL-F3-2. NC2024.2 +058300 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +058400 MOVE "11223344606677889900" TO CORRECT-A. NC2024.2 +058500 PERFORM FAIL. NC2024.2 +058600 ADD-WRITE-F3-2. NC2024.2 +058700 PERFORM PRINT-DETAIL. NC2024.2 +058800* NC2024.2 +058900 ADD-INIT-F3-3. NC2024.2 +059000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +059100 MOVE ZERO TO GRP-FOR-ADD-CORR-R, WRK-XN-00001. NC2024.2 +059200 MOVE 111 TO ADD-CORR-1 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059300 MOVE 22 TO ADD-CORR-2 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059400 MOVE 33 TO ADD-CORR-3 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059500 MOVE 44 TO ADD-CORR-4 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059600 ADD-INIT-F3-3-1. NC2024.2 +059700 MOVE "ADD-TEST-F3-3-1" TO PAR-NAME. NC2024.2 +059800 ADD-TEST-F3-3-1. NC2024.2 +059900 ADD CORRESPONDING GRP-SUBTRACT-CORR-3 TO GRP-FOR-ADD-CORR-R NC2024.2 +060000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC2024.2 +060100 IF GRP-FOR-ADD-CORR-R EQUAL TO "00223344000000000000" NC2024.2 +060200 PERFORM PASS NC2024.2 +060300 GO TO ADD-WRITE-F3-3-1. NC2024.2 +060400 GO TO ADD-FAIL-F3-3-1. NC2024.2 +060500 ADD-DELETE-F3-3-1. NC2024.2 +060600 PERFORM DE-LETE. NC2024.2 +060700 GO TO ADD-WRITE-F3-3-1. NC2024.2 +060800 ADD-FAIL-F3-3-1. NC2024.2 +060900 MOVE "00223344000000000000" TO CORRECT-A. NC2024.2 +061000 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +061100 PERFORM FAIL. NC2024.2 +061200 ADD-WRITE-F3-3-1. NC2024.2 +061300 PERFORM PRINT-DETAIL. NC2024.2 +061400* NC2024.2 +061500 ADD-INIT-F3-3-2. NC2024.2 +061600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +061700 MOVE "ADD-TEST-F3-3-2" TO PAR-NAME. NC2024.2 +061800 ADD-TEST-F3-3-2. NC2024.2 +061900 IF WRK-XN-00001 EQUAL TO "1" NC2024.2 +062000 PERFORM PASS NC2024.2 +062100 GO TO ADD-WRITE-F3-3-2. NC2024.2 +062200 GO TO ADD-FAIL-F3-3-2. NC2024.2 +062300 ADD-DELETE-F3-3-2. NC2024.2 +062400 PERFORM DE-LETE. NC2024.2 +062500 GO TO ADD-WRITE-F3-3-2. NC2024.2 +062600 ADD-FAIL-F3-3-2. NC2024.2 +062700 MOVE 1 TO CORRECT-A. NC2024.2 +062800 MOVE WRK-XN-00001 TO COMPUTED-A. NC2024.2 +062900 PERFORM FAIL. NC2024.2 +063000 ADD-WRITE-F3-3-2. NC2024.2 +063100 PERFORM PRINT-DETAIL. NC2024.2 +063200* NC2024.2 +063300 ADD-INIT-F3-4. NC2024.2 +063400 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +063500 MOVE "ADD-TEST-F3-4" TO PAR-NAME. NC2024.2 +063600 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +063700 MOVE ZERO TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-A. NC2024.2 +063800 ADD-TEST-F3-4. NC2024.2 +063900 ADD CORRESPONDING GRP-SUBTRACT-CORR-1 OF GRP-SUBTRACT-CORR-3 NC2024.2 +064000 TO GRP-SUBTRACT-CORR-1 OF GRP-FOR-ADD-CORR-R. NC2024.2 +064100 IF GRP-FOR-ADD-CORR-R EQUAL TO "00223344000000000000" NC2024.2 +064200 PERFORM PASS NC2024.2 +064300 GO TO ADD-WRITE-F3-4. NC2024.2 +064400 GO TO ADD-FAIL-F3-4. NC2024.2 +064500 ADD-DELETE-F3-4. NC2024.2 +064600 PERFORM DE-LETE. NC2024.2 +064700 GO TO ADD-WRITE-F3-4. NC2024.2 +064800 ADD-FAIL-F3-4. NC2024.2 +064900 MOVE "00223344000000000000" TO CORRECT-A. NC2024.2 +065000 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +065100 PERFORM FAIL. NC2024.2 +065200 ADD-WRITE-F3-4. NC2024.2 +065300 PERFORM PRINT-DETAIL. NC2024.2 +065400* NC2024.2 +065500 ADD-INIT-F3-5-1. NC2024.2 +065600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +065700 MOVE "ADD-TEST-F3-5-1" TO PAR-NAME. NC2024.2 +065800 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +065900 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +066000 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +066100 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +066200 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +066300 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +066400 ADD-TEST-F3-5-1. NC2024.2 +066500 ADD CORRESPONDING ADD-15 TO ADD-16 ON SIZE ERROR NC2024.2 +066600 PERFORM PASS NC2024.2 +066700 GO TO ADD-WRITE-F3-5-1. NC2024.2 +066800 GO TO ADD-FAIL-F3-5-1. NC2024.2 +066900 ADD-DELETE-F3-5-1. NC2024.2 +067000 PERFORM DE-LETE. NC2024.2 +067100 GO TO ADD-WRITE-F3-5-1. NC2024.2 +067200 ADD-FAIL-F3-5-1. NC2024.2 +067300 PERFORM FAIL. NC2024.2 +067400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC2024.2 +067500 ADD-WRITE-F3-5-1. NC2024.2 +067600 PERFORM PRINT-DETAIL. NC2024.2 +067700* NC2024.2 +067800 ADD-INIT-F3-5-2. NC2024.2 +067900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +068000 MOVE "ADD-TEST-F3-5-2" TO PAR-NAME. NC2024.2 +068100 ADD-TEST-F3-5-2. NC2024.2 +068200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +068300 PERFORM PASS NC2024.2 +068400 GO TO ADD-WRITE-F3-5-2. NC2024.2 +068500 GO TO ADD-FAIL-F3-5-2. NC2024.2 +068600 ADD-DELETE-F3-5-2. NC2024.2 +068700 PERFORM DE-LETE. NC2024.2 +068800 GO TO ADD-WRITE-F3-5-2. NC2024.2 +068900 ADD-FAIL-F3-5-2. NC2024.2 +069000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N. NC2024.2 +069100 MOVE 99999 TO CORRECT-N. NC2024.2 +069200 PERFORM FAIL. NC2024.2 +069300 ADD-WRITE-F3-5-2. NC2024.2 +069400 PERFORM PRINT-DETAIL. NC2024.2 +069500* NC2024.2 +069600 ADD-INIT-F3-5-3. NC2024.2 +069700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +069800 MOVE "ADD-TEST-F3-5-3" TO PAR-NAME. NC2024.2 +069900 ADD-TEST-F3-5-3. NC2024.2 +070000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +070100 PERFORM PASS NC2024.2 +070200 GO TO ADD-WRITE-F3-5-3. NC2024.2 +070300 GO TO ADD-FAIL-F3-5-3. NC2024.2 +070400 ADD-DELETE-F3-5-3. NC2024.2 +070500 PERFORM DE-LETE. NC2024.2 +070600 GO TO ADD-WRITE-F3-5-3. NC2024.2 +070700 ADD-FAIL-F3-5-3. NC2024.2 +070800 PERFORM FAIL. NC2024.2 +070900 MOVE FIELD2 OF ADD-16 TO COMPUTED-N. NC2024.2 +071000 MOVE "+777.77" TO CORRECT-A. NC2024.2 +071100 ADD-WRITE-F3-5-3. NC2024.2 +071200 PERFORM PRINT-DETAIL. NC2024.2 +071300* NC2024.2 +071400 ADD-INIT-F3-5-4. NC2024.2 +071500 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +071600 MOVE "ADD-TEST-F3-5-4" TO PAR-NAME. NC2024.2 +071700 ADD-TEST-F3-5-4. NC2024.2 +071800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +071900 PERFORM PASS NC2024.2 +072000 GO TO ADD-WRITE-F3-5-4. NC2024.2 +072100 GO TO ADD-FAIL-F3-5-4. NC2024.2 +072200 ADD-DELETE-F3-5-4. NC2024.2 +072300 PERFORM DE-LETE. NC2024.2 +072400 GO TO ADD-WRITE-F3-5-4. NC2024.2 +072500 ADD-FAIL-F3-5-4. NC2024.2 +072600 PERFORM FAIL. NC2024.2 +072700 MOVE FIELD3 OF ADD-16 TO COMPUTED-N. NC2024.2 +072800 MOVE 555.5 TO CORRECT-N. NC2024.2 +072900 ADD-WRITE-F3-5-4. NC2024.2 +073000 PERFORM PRINT-DETAIL. NC2024.2 +073100* NC2024.2 +073200 ADD-INIT-F3-6. NC2024.2 +073300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +073400 MOVE "ADD-TEST-F3-6" TO PAR-NAME. NC2024.2 +073500 MOVE "ADD CORRESPONDING " TO FEATURE. NC2024.2 +073600 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +073700 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +073800 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +073900 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +074000 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +074100 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +074200 MOVE ZEROES TO CORR-DATA-2. NC2024.2 +074300 ADD-TEST-F3-6. NC2024.2 +074400 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2024.2 +074500 IF XYZ-4 OF CORR-DATA-2 EQUAL TO ZERO NC2024.2 +074600 PERFORM PASS NC2024.2 +074700 GO TO ADD-WRITE-F3-6. NC2024.2 +074800 GO TO ADD-FAIL-F3-6. NC2024.2 +074900 ADD-DELETE-F3-6. NC2024.2 +075000 PERFORM DE-LETE. NC2024.2 +075100 GO TO ADD-WRITE-F3-6. NC2024.2 +075200 ADD-FAIL-F3-6. NC2024.2 +075300 PERFORM FAIL. NC2024.2 +075400 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +075500 MOVE 00 TO CORRECT-A. NC2024.2 +075600 ADD-WRITE-F3-6. NC2024.2 +075700 PERFORM PRINT-DETAIL. NC2024.2 +075800* NC2024.2 +075900 ADD-INIT-F3-7. NC2024.2 +076000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +076100 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +076200 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +076300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +076400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +076500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +076600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +076700 MOVE 060820000200 TO CORR-DATA-2. NC2024.2 +076800 ADD-INIT-F3-7-1. NC2024.2 +076900 MOVE "ADD-TEST-F3-7-1" TO PAR-NAME. NC2024.2 +077000 ADD-TEST-F3-7-1. NC2024.2 +077100 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2024.2 +077200 IF XYZ-1 OF CORR-DATA-2 EQUAL TO 09 NC2024.2 +077300 PERFORM PASS NC2024.2 +077400 GO TO ADD-WRITE-F3-7-1. NC2024.2 +077500 GO TO ADD-FAIL-F3-7-1. NC2024.2 +077600 ADD-DELETE-F3-7-1. NC2024.2 +077700 PERFORM DE-LETE. NC2024.2 +077800 GO TO ADD-WRITE-F3-7-1. NC2024.2 +077900 ADD-FAIL-F3-7-1. NC2024.2 +078000 PERFORM FAIL. NC2024.2 +078100 MOVE XYZ-1 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +078200 MOVE "09" TO CORRECT-A. NC2024.2 +078300 ADD-WRITE-F3-7-1. NC2024.2 +078400 PERFORM PRINT-DETAIL. NC2024.2 +078500* NC2024.2 +078600 ADD-INIT-F3-7-2. NC2024.2 +078700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +078800 MOVE "ADD-TEST-F3-7-2" TO PAR-NAME. NC2024.2 +078900 ADD-TEST-F3-7-2. NC2024.2 +079000 IF XYZ-2 OF CORR-DATA-2 EQUAL TO 12 NC2024.2 +079100 PERFORM PASS NC2024.2 +079200 GO TO ADD-WRITE-F3-7-2. NC2024.2 +079300 GO TO ADD-FAIL-F3-7-2. NC2024.2 +079400 ADD-DELETE-F3-7-2. NC2024.2 +079500 PERFORM DE-LETE. NC2024.2 +079600 GO TO ADD-WRITE-F3-7-2. NC2024.2 +079700 ADD-FAIL-F3-7-2. NC2024.2 +079800 PERFORM FAIL. NC2024.2 +079900 MOVE XYZ-2 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +080000 MOVE "12" TO CORRECT-A. NC2024.2 +080100 ADD-WRITE-F3-7-2. NC2024.2 +080200 PERFORM PRINT-DETAIL. NC2024.2 +080300* NC2024.2 +080400 ADD-INIT-F3-7-3. NC2024.2 +080500 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +080600 MOVE "ADD-TEST-F3-7-3" TO PAR-NAME. NC2024.2 +080700 ADD-TEST-F3-7-3. NC2024.2 +080800 IF XYZ-3 OF CORR-DATA-2 EQUAL TO 30 NC2024.2 +080900 PERFORM PASS NC2024.2 +081000 GO TO ADD-WRITE-F3-7-3. NC2024.2 +081100 GO TO ADD-FAIL-F3-7-3. NC2024.2 +081200 ADD-DELETE-F3-7-3. NC2024.2 +081300 PERFORM DE-LETE. NC2024.2 +081400 GO TO ADD-WRITE-F3-7-3. NC2024.2 +081500 ADD-FAIL-F3-7-3. NC2024.2 +081600 PERFORM FAIL. NC2024.2 +081700 MOVE XYZ-3 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +081800 MOVE "30" TO CORRECT-A. NC2024.2 +081900 ADD-WRITE-F3-7-3. NC2024.2 +082000 PERFORM PRINT-DETAIL. NC2024.2 +082100* NC2024.2 +082200 ADD-INIT-F3-7-4. NC2024.2 +082300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +082400 MOVE "ADD-TEST-F3-7-4" TO PAR-NAME. NC2024.2 +082500 ADD-TEST-F3-7-4. NC2024.2 +082600 IF XYZ-4 OF CORR-DATA-2 EQUAL TO 00 NC2024.2 +082700 PERFORM PASS NC2024.2 +082800 GO TO ADD-WRITE-F3-7-4. NC2024.2 +082900 GO TO ADD-FAIL-F3-7-4. NC2024.2 +083000 ADD-DELETE-F3-7-4. NC2024.2 +083100 PERFORM DE-LETE. NC2024.2 +083200 GO TO ADD-WRITE-F3-7-4. NC2024.2 +083300 ADD-FAIL-F3-7-4. NC2024.2 +083400 PERFORM FAIL. NC2024.2 +083500 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +083600 MOVE "00" TO CORRECT-A. NC2024.2 +083700 ADD-WRITE-F3-7-4. NC2024.2 +083800 PERFORM PRINT-DETAIL. NC2024.2 +083900* NC2024.2 +084000 ADD-INIT-F3-7-5. NC2024.2 +084100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +084200 MOVE "ADD-TEST-F3-7-5" TO PAR-NAME. NC2024.2 +084300 ADD-TEST-F3-7-5. NC2024.2 +084400 IF XYZ-5 IN CORR-DATA-2 EQUAL TO 03 NC2024.2 +084500 PERFORM PASS NC2024.2 +084600 GO TO ADD-WRITE-F3-7-5. NC2024.2 +084700 GO TO ADD-FAIL-F3-7-5. NC2024.2 +084800 DELETE-F3-7-5. NC2024.2 +084900 PERFORM DE-LETE. NC2024.2 +085000 GO TO ADD-WRITE-F3-7-5. NC2024.2 +085100 ADD-FAIL-F3-7-5. NC2024.2 +085200 MOVE XYZ-5 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +085300 MOVE "03" TO CORRECT-A. NC2024.2 +085400 PERFORM FAIL. NC2024.2 +085500 ADD-WRITE-F3-7-5. NC2024.2 +085600 PERFORM PRINT-DETAIL. NC2024.2 +085700* NC2024.2 +085800 ADD-INIT-F3-8. NC2024.2 +085900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +086000 MOVE ZERO TO WRK-AN-00001. NC2024.2 +086100 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +086200 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +086300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +086400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +086500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +086600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +086700 MOVE 999999999999 TO CORR-DATA-2. NC2024.2 +086800 ADD-INIT-F3-8-1. NC2024.2 +086900 MOVE "ADD-TEST-F3-8-1" TO PAR-NAME. NC2024.2 +087000 ADD-TEST-F3-8-1. NC2024.2 +087100 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2 ON SIZE ERROR NC2024.2 +087200 MOVE 4 TO WRK-AN-00001. NC2024.2 +087300 IF WRK-AN-00001 EQUAL TO "4" NC2024.2 +087400 PERFORM PASS NC2024.2 +087500 GO TO ADD-WRITE-F3-8-1. NC2024.2 +087600 GO TO ADD-FAIL-F3-8-1. NC2024.2 +087700 ADD-DELETE-F3-8-1. NC2024.2 +087800 PERFORM DE-LETE. NC2024.2 +087900 GO TO ADD-WRITE-F3-8-1. NC2024.2 +088000 ADD-FAIL-F3-8-1. NC2024.2 +088100 PERFORM FAIL. NC2024.2 +088200 MOVE WRK-AN-00001 TO COMPUTED-A. NC2024.2 +088300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +088400 ADD-WRITE-F3-8-1. NC2024.2 +088500 PERFORM PRINT-DETAIL. NC2024.2 +088600* NC2024.2 +088700 ADD-INIT-F3-8-2. NC2024.2 +088800 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +088900 MOVE "ADD-TEST-F3-8-2" TO PAR-NAME. NC2024.2 +089000 ADD-TEST-F3-8-2. NC2024.2 +089100 IF CORR-DATA-2 EQUAL TO "999999999999" NC2024.2 +089200 PERFORM PASS NC2024.2 +089300 GO TO ADD-WRITE-F3-8-2. NC2024.2 +089400 GO TO ADD-FAIL-F3-8-2. NC2024.2 +089500 ADD-DELETE-F3-8-2. NC2024.2 +089600 PERFORM DE-LETE. NC2024.2 +089700 GO TO ADD-WRITE-F3-8-2. NC2024.2 +089800 ADD-FAIL-F3-8-2. NC2024.2 +089900 PERFORM FAIL. NC2024.2 +090000 MOVE CORR-DATA-2 TO COMPUTED-A. NC2024.2 +090100 MOVE "999999999999" TO CORRECT-A. NC2024.2 +090200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC2024.2 +090300 ADD-WRITE-F3-8-2. NC2024.2 +090400 PERFORM PRINT-DETAIL. NC2024.2 +090500* NC2024.2 +090600 ADD-INIT-F3-9-1. NC2024.2 +090700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +090800 MOVE "ADD-TEST-F3-9-1" TO PAR-NAME. NC2024.2 +090900 MOVE ZEROES TO CORR-DATA-5. NC2024.2 +091000 MOVE 222222222222 TO CORR-DATA-1. NC2024.2 +091100 ADD-TEST-F3-9-1. NC2024.2 +091200 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-5. NC2024.2 +091300 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 22 NC2024.2 +091400 PERFORM PASS NC2024.2 +091500 GO TO ADD-WRITE-F3-9-1. NC2024.2 +091600 GO TO ADD-FAIL-F3-9-1. NC2024.2 +091700 ADD-DELETE-F3-9-1. NC2024.2 +091800 PERFORM DE-LETE. NC2024.2 +091900 GO TO ADD-WRITE-F3-9-1. NC2024.2 +092000 ADD-FAIL-F3-9-1. NC2024.2 +092100 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +092200 MOVE "22" TO CORRECT-A. NC2024.2 +092300 PERFORM FAIL. NC2024.2 +092400 ADD-WRITE-F3-9-1. NC2024.2 +092500 PERFORM PRINT-DETAIL. NC2024.2 +092600* NC2024.2 +092700 ADD-INIT-F3-9-2. NC2024.2 +092800 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +092900 MOVE "ADD-TEST-F3-9-2" TO PAR-NAME. NC2024.2 +093000 ADD-TEST-F3-9-2. NC2024.2 +093100 IF XYZ-13 OF CORR-DATA-5 EQUAL TO 00 NC2024.2 +093200 PERFORM PASS NC2024.2 +093300 GO TO ADD-WRITE-F3-9-2. NC2024.2 +093400 GO TO ADD-FAIL-F3-9-2. NC2024.2 +093500 ADD-DELETE-F3-9-2. NC2024.2 +093600 PERFORM DE-LETE. NC2024.2 +093700 GO TO ADD-WRITE-F3-9-2. NC2024.2 +093800 ADD-FAIL-F3-9-2. NC2024.2 +093900 MOVE XYZ-13 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +094000 MOVE "00" TO CORRECT-A. NC2024.2 +094100 PERFORM FAIL. NC2024.2 +094200 ADD-WRITE-F3-9-2. NC2024.2 +094300 PERFORM PRINT-DETAIL. NC2024.2 +094400* NC2024.2 +094500 ADD-INIT-F3-9-3. NC2024.2 +094600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +094700 MOVE "ADD-TEST-F3-9-3" TO PAR-NAME. NC2024.2 +094800 ADD-TEST-F3-9-3. NC2024.2 +094900 IF XYZ-11 OF CORR-DATA-5 EQUAL TO 00 NC2024.2 +095000 PERFORM PASS NC2024.2 +095100 GO TO ADD-WRITE-F3-9-3. NC2024.2 +095200 GO TO ADD-FAIL-F3-9-3. NC2024.2 +095300 ADD-DELETE-F3-9-3. NC2024.2 +095400 PERFORM DE-LETE. NC2024.2 +095500 GO TO ADD-WRITE-F3-9-3. NC2024.2 +095600 ADD-FAIL-F3-9-3. NC2024.2 +095700 MOVE XYZ-11 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +095800 MOVE "00" TO CORRECT-A. NC2024.2 +095900 PERFORM FAIL. NC2024.2 +096000 ADD-WRITE-F3-9-3. NC2024.2 +096100 PERFORM PRINT-DETAIL. NC2024.2 +096200* NC2024.2 +096300 ADD-INIT-F3-10. NC2024.2 +096400 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +096500 MOVE ZERO TO CORR-DATA-5. NC2024.2 +096600 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +096700 MOVE 98 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +096800 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +096900 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +097000 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +097100 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +097200 ADD-INIT-F3-10-1. NC2024.2 +097300 MOVE "ADD-TEST-F3-10-1" TO PAR-NAME. NC2024.2 +097400 ADD-TEST-F3-10-1. NC2024.2 +097500 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5. NC2024.2 +097600 IF XYZ-1 IN CORR-DATA-5 EQUAL TO 20 NC2024.2 +097700 PERFORM PASS NC2024.2 +097800 GO TO ADD-WRITE-F3-10-1. NC2024.2 +097900 GO TO ADD-FAIL-F3-10-1. NC2024.2 +098000 ADD-DELETE-F3-10-1. NC2024.2 +098100 PERFORM DE-LETE. NC2024.2 +098200 GO TO ADD-WRITE-F3-10-1. NC2024.2 +098300 ADD-FAIL-F3-10-1. NC2024.2 +098400 PERFORM FAIL. NC2024.2 +098500 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +098600 MOVE "+20.0000" TO CORRECT-A. NC2024.2 +098700 ADD-WRITE-F3-10-1. NC2024.2 +098800 PERFORM PRINT-DETAIL. NC2024.2 +098900* NC2024.2 +099000 ADD-INIT-F3-10-2. NC2024.2 +099100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +099200 MOVE "ADD-TEST-F3-10-2" TO PAR-NAME. NC2024.2 +099300 ADD-TEST-F3-10-2. NC2024.2 +099400 IF XYZ-2 IN CORR-DATA-5 EQUAL TO 98 NC2024.2 +099500 PERFORM PASS NC2024.2 +099600 GO TO ADD-WRITE-F3-10-2. NC2024.2 +099700 GO TO ADD-FAIL-F3-10-2. NC2024.2 +099800 ADD-DELETE-F3-10-2. NC2024.2 +099900 PERFORM DE-LETE. NC2024.2 +100000 GO TO ADD-WRITE-F3-10-2. NC2024.2 +100100 ADD-FAIL-F3-10-2. NC2024.2 +100200 PERFORM FAIL. NC2024.2 +100300 MOVE XYZ-2 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +100400 MOVE "98.0000" TO CORRECT-A. NC2024.2 +100500 ADD-WRITE-F3-10-2. NC2024.2 +100600 PERFORM PRINT-DETAIL. NC2024.2 +100700* NC2024.2 +100800 ADD-INIT-F3-10-3. NC2024.2 +100900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +101000 MOVE "ADD-TEST-F3-10-3" TO PAR-NAME. NC2024.2 +101100 ADD-TEST-F3-10-3. NC2024.2 +101200 IF XYZ-11 OF CORR-DATA-5 EQUAL TO 01 NC2024.2 +101300 PERFORM PASS NC2024.2 +101400 GO TO ADD-WRITE-F3-10-3. NC2024.2 +101500 GO TO ADD-FAIL-F3-10-3. NC2024.2 +101600 ADD-DELETE-F3-10-3. NC2024.2 +101700 PERFORM DE-LETE. NC2024.2 +101800 GO TO ADD-WRITE-F3-10-3. NC2024.2 +101900 ADD-FAIL-F3-10-3. NC2024.2 +102000 PERFORM FAIL. NC2024.2 +102100 MOVE XYZ-11 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +102200 MOVE "+01.0000" TO CORRECT-A. NC2024.2 +102300 ADD-WRITE-F3-10-3. NC2024.2 +102400 PERFORM PRINT-DETAIL. NC2024.2 +102500* NC2024.2 +102600 ADD-INIT-F3-11. NC2024.2 +102700 MOVE ZERO TO CORR-DATA-5. NC2024.2 +102800 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +102900 MOVE 98 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +103000 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +103100 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +103200 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +103300 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +103400 ADD-INIT-F3-11-1. NC2024.2 +103500 MOVE "ADD-TEST-F3-11-1" TO PAR-NAME. NC2024.2 +103600 ADD-TEST-F3-11-1. NC2024.2 +103700 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5 ROUNDED. NC2024.2 +103800 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 20 NC2024.2 +103900 PERFORM PASS NC2024.2 +104000 GO TO ADD-WRITE-F3-11-1. NC2024.2 +104100 GO TO ADD-FAIL-F3-11-1. NC2024.2 +104200 ADD-DELETE-F3-11-1. NC2024.2 +104300 PERFORM DE-LETE. NC2024.2 +104400 GO TO ADD-WRITE-F3-11-1. NC2024.2 +104500 ADD-FAIL-F3-11-1. NC2024.2 +104600 PERFORM FAIL. NC2024.2 +104700 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +104800 MOVE 20.0000 TO CORRECT-N. NC2024.2 +104900 ADD-WRITE-F3-11-1. NC2024.2 +105000 PERFORM PRINT-DETAIL. NC2024.2 +105100* NC2024.2 +105200 ADD-INIT-F3-11-2. NC2024.2 +105300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +105400 MOVE "ADD-TEST-F3-11-2" TO PAR-NAME. NC2024.2 +105500 ADD-TEST-F3-11-2. NC2024.2 +105600 IF XYZ-2 OF CORR-DATA-5 EQUAL TO 99 NC2024.2 +105700 PERFORM PASS NC2024.2 +105800 GO TO ADD-WRITE-F3-11-2. NC2024.2 +105900 GO TO ADD-FAIL-F3-11-2. NC2024.2 +106000 ADD-DELETE-F3-11-2. NC2024.2 +106100 PERFORM DE-LETE. NC2024.2 +106200 GO TO ADD-WRITE-F3-11-2. NC2024.2 +106300 ADD-FAIL-F3-11-2. NC2024.2 +106400 MOVE XYZ-2 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +106500 MOVE "+99.0000" TO CORRECT-A. NC2024.2 +106600 PERFORM FAIL. NC2024.2 +106700 ADD-WRITE-F3-11-2. NC2024.2 +106800 PERFORM PRINT-DETAIL. NC2024.2 +106900* NC2024.2 +107000 ADD-INIT-F3-12. NC2024.2 +107100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +107200 MOVE "ADD-TEST-F3-12" TO PAR-NAME. NC2024.2 +107300 MOVE ZERO TO CORR-DATA-5. NC2024.2 +107400 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +107500 MOVE 99 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +107600 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +107700 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +107800 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +107900 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +108000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +108100 ADD-TEST-F3-12. NC2024.2 +108200 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5 ROUNDED NC2024.2 +108300 ON SIZE ERROR MOVE "W" TO WRK-AN-00001. NC2024.2 +108400 IF WRK-AN-00001 EQUAL TO "W" NC2024.2 +108500 PERFORM PASS NC2024.2 +108600 GO TO ADD-WRITE-F3-12. NC2024.2 +108700 GO TO ADD-FAIL-F3-12. NC2024.2 +108800 ADD-DELETE-F3-12. NC2024.2 +108900 PERFORM DE-LETE. NC2024.2 +109000 GO TO ADD-WRITE-F3-12. NC2024.2 +109100 ADD-FAIL-F3-12. NC2024.2 +109200 PERFORM FAIL. NC2024.2 +109300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +109400 ADD-WRITE-F3-12. NC2024.2 +109500 PERFORM PRINT-DETAIL. NC2024.2 +109600* NC2024.2 +109700 ADD-INIT-F3-13. NC2024.2 +109800 MOVE "ADD-TEST-F3-13" TO PAR-NAME. NC2024.2 +109900 MOVE "VI-74 6.6.4" TO ANSI-REFERENCE. NC2024.2 +110000 MOVE "ADD CORRESPONDING" TO FEATURE. NC2024.2 +110100 BUILD-TABLE1. NC2024.2 +110200 MOVE 06 TO RECORD1 OF TABLE1. NC2024.2 +110300 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2024.2 +110400 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2024.2 +110500 MOVE 07 TO RECORD3 OF TABLE1. NC2024.2 +110600 BUILD-TABLE2. NC2024.2 +110700 MOVE 08 TO RECORD1 OF TABLE2. NC2024.2 +110800 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2024.2 +110900 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2024.2 +111000 MOVE 09 TO RECORD3 OF TABLE2. NC2024.2 +111100 ADD-TEST-F3-13. NC2024.2 +111200 ADD CORRESPONDING TABLE1 TO TABLE2. NC2024.2 +111300 IF RECORD1 OF TABLE2 = 14 AND NC2024.2 +111400 RECORD2 OF TABLE2 (1) = 03 AND NC2024.2 +111500 RECORD2 OF TABLE2 (2) = 04 AND NC2024.2 +111600 RECORD3 OF TABLE2 = 16 NC2024.2 +111700 PERFORM PASS NC2024.2 +111800 GO TO ADD-WRITE-F3-13. NC2024.2 +111900 GO TO ADD-FAIL-F3-13. NC2024.2 +112000 ADD-DELETE-F3-13. NC2024.2 +112100 PERFORM DE-LETE. NC2024.2 +112200 GO TO ADD-WRITE-F3-13. NC2024.2 +112300 ADD-FAIL-F3-13. NC2024.2 +112400 PERFORM FAIL. NC2024.2 +112500 MOVE TABLE2 TO COMPUTED-A. NC2024.2 +112600 MOVE "14030416" TO CORRECT-A. NC2024.2 +112700 ADD-WRITE-F3-13. NC2024.2 +112800 PERFORM PRINT-DETAIL. NC2024.2 +112900* NC2024.2 +113000 ADD-INIT-F3-14. NC2024.2 +113100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +113200* ===--> NO SIZE ERROR <--=== NC2024.2 +113300 MOVE 1 TO REC-CT. NC2024.2 +113400 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +113500 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +113600 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +113700 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +113800 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +113900 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +114000 MOVE "ADD-TEST-F3-14-0" TO PAR-NAME. NC2024.2 +114100 ADD-TEST-F3-14-1. NC2024.2 +114200 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +114300 ON SIZE ERROR NC2024.2 +114400 GO TO ADD-FAIL-F3-14-1. NC2024.2 +114500 PERFORM PASS. NC2024.2 +114600 GO TO ADD-WRITE-F3-14-1. NC2024.2 +114700 ADD-DELETE-F3-14-1. NC2024.2 +114800 PERFORM DE-LETE. NC2024.2 +114900 GO TO ADD-WRITE-F3-14-1. NC2024.2 +115000 ADD-FAIL-F3-14-1. NC2024.2 +115100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +115200 TO RE-MARK NC2024.2 +115300 PERFORM FAIL. NC2024.2 +115400 ADD-WRITE-F3-14-1. NC2024.2 +115500 PERFORM PRINT-DETAIL. NC2024.2 +115600* NC2024.2 +115700 ADD-INIT-F3-14-2. NC2024.2 +115800 MOVE "ADD-TEST-F3-14-2" TO PAR-NAME. NC2024.2 +115900 ADD 1 TO REC-CT. NC2024.2 +116000 ADD-TEST-F3-14-2. NC2024.2 +116100 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +116200 PERFORM PASS NC2024.2 +116300 GO TO ADD-WRITE-F3-14-2. NC2024.2 +116400 GO TO ADD-FAIL-F3-14-2. NC2024.2 +116500 ADD-DELETE-F3-14-2. NC2024.2 +116600 PERFORM DE-LETE NC2024.2 +116700 GO TO ADD-WRITE-F3-14-2. NC2024.2 +116800 ADD-FAIL-F3-14-2. NC2024.2 +116900 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +117000 MOVE 88889 TO CORRECT-N NC2024.2 +117100 PERFORM FAIL. NC2024.2 +117200 ADD-WRITE-F3-14-2. NC2024.2 +117300 PERFORM PRINT-DETAIL. NC2024.2 +117400* NC2024.2 +117500 ADD-INIT-F3-14-3. NC2024.2 +117600 MOVE "ADD-TEST-F3-14-3" TO PAR-NAME. NC2024.2 +117700 ADD 1 TO REC-CT. NC2024.2 +117800 ADD-TEST-F3-14-3. NC2024.2 +117900 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +118000 PERFORM PASS NC2024.2 +118100 GO TO ADD-WRITE-F3-14-3. NC2024.2 +118200 GO TO ADD-FAIL-F3-14-3. NC2024.2 +118300 ADD-DELETE-F3-14-3. NC2024.2 +118400 PERFORM DE-LETE. NC2024.2 +118500 GO TO ADD-WRITE-F3-14-3. NC2024.2 +118600 ADD-FAIL-F3-14-3. NC2024.2 +118700 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +118800 MOVE "+777.77" TO CORRECT-A NC2024.2 +118900 PERFORM FAIL. NC2024.2 +119000 ADD-WRITE-F3-14-3. NC2024.2 +119100 PERFORM PRINT-DETAIL. NC2024.2 +119200* NC2024.2 +119300 ADD-INIT-F3-14-4. NC2024.2 +119400 MOVE "ADD-TEST-F3-14-4" TO PAR-NAME. NC2024.2 +119500 ADD 1 TO REC-CT. NC2024.2 +119600 ADD-TEST-F3-14-4. NC2024.2 +119700 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +119800 PERFORM PASS NC2024.2 +119900 GO TO ADD-WRITE-F3-14-4. NC2024.2 +120000 GO TO ADD-FAIL-F3-14-4. NC2024.2 +120100 ADD-DELETE-F3-14-4. NC2024.2 +120200 PERFORM DE-LETE. NC2024.2 +120300 GO TO ADD-WRITE-F3-14-4. NC2024.2 +120400 ADD-FAIL-F3-14-4. NC2024.2 +120500 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +120600 MOVE 555.5 TO CORRECT-N NC2024.2 +120700 PERFORM FAIL. NC2024.2 +120800 ADD-WRITE-F3-14-4. NC2024.2 +120900 PERFORM PRINT-DETAIL. NC2024.2 +121000* NC2024.2 +121100 ADD-INIT-F3-15. NC2024.2 +121200* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +121300* ===--> SIZE ERROR <--=== NC2024.2 +121400 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +121500 MOVE 0 TO REC-CT. NC2024.2 +121600 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +121700 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +121800 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +121900 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +122000 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +122100 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +122200* NC2024.2 +122300 ADD-INIT-F3-15-1. NC2024.2 +122400 MOVE "ADD-TEST-F3-15-1" TO PAR-NAME. NC2024.2 +122500 ADD 1 TO REC-CT. NC2024.2 +122600 ADD-TEST-F3-15-1. NC2024.2 +122700 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +122800 NOT ON SIZE ERROR NC2024.2 +122900 GO TO ADD-FAIL-F3-15-1. NC2024.2 +123000 PERFORM PASS. NC2024.2 +123100 GO TO ADD-WRITE-F3-15-1. NC2024.2 +123200 ADD-DELETE-F3-15-1. NC2024.2 +123300 PERFORM DE-LETE. NC2024.2 +123400 GO TO ADD-WRITE-F3-15-1. NC2024.2 +123500 ADD-FAIL-F3-15-1. NC2024.2 +123600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +123700 TO RE-MARK NC2024.2 +123800 PERFORM FAIL. NC2024.2 +123900 ADD-WRITE-F3-15-1. NC2024.2 +124000 PERFORM PRINT-DETAIL. NC2024.2 +124100* NC2024.2 +124200 ADD-INIT-F3-15-2. NC2024.2 +124300 MOVE "ADD-TEST-F3-15-2" TO PAR-NAME. NC2024.2 +124400 ADD 1 TO REC-CT. NC2024.2 +124500 ADD-TEST-F3-15-2. NC2024.2 +124600 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +124700 PERFORM PASS NC2024.2 +124800 GO TO ADD-WRITE-F3-15-2. NC2024.2 +124900 GO TO ADD-FAIL-F3-15-2. NC2024.2 +125000 ADD-DELETE-F3-15-2. NC2024.2 +125100 PERFORM DE-LETE. NC2024.2 +125200 GO TO ADD-WRITE-F3-15-2. NC2024.2 +125300 ADD-FAIL-F3-15-2. NC2024.2 +125400 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +125500 MOVE 99999 TO CORRECT-N NC2024.2 +125600 PERFORM FAIL. NC2024.2 +125700 ADD-WRITE-F3-15-2. NC2024.2 +125800 PERFORM PRINT-DETAIL. NC2024.2 +125900* NC2024.2 +126000 ADD-INIT-F3-15-3. NC2024.2 +126100 MOVE "ADD-TEST-F3-15-3" TO PAR-NAME. NC2024.2 +126200 ADD 1 TO REC-CT. NC2024.2 +126300 ADD-TEST-F3-15-3. NC2024.2 +126400 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +126500 PERFORM PASS NC2024.2 +126600 GO TO ADD-WRITE-F3-15-3. NC2024.2 +126700 GO TO ADD-FAIL-F3-15-3. NC2024.2 +126800 ADD-DELETE-F3-15-3. NC2024.2 +126900 PERFORM DE-LETE. NC2024.2 +127000 GO TO ADD-WRITE-F3-15-3. NC2024.2 +127100 ADD-FAIL-F3-15-3. NC2024.2 +127200 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +127300 MOVE "+777.77" TO CORRECT-A NC2024.2 +127400 PERFORM FAIL. NC2024.2 +127500 ADD-WRITE-F3-15-3. NC2024.2 +127600 PERFORM PRINT-DETAIL. NC2024.2 +127700* NC2024.2 +127800 ADD-INIT-F3-15-4. NC2024.2 +127900 MOVE "ADD-TEST-F3-15-4" TO PAR-NAME. NC2024.2 +128000 ADD 1 TO REC-CT. NC2024.2 +128100 ADD-TEST-F3-15-4. NC2024.2 +128200 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +128300 PERFORM PASS NC2024.2 +128400 GO TO ADD-WRITE-F3-15-4. NC2024.2 +128500 GO TO ADD-FAIL-F3-15-4. NC2024.2 +128600 ADD-DELETE-F3-15-4. NC2024.2 +128700 PERFORM DE-LETE. NC2024.2 +128800 GO TO ADD-WRITE-F3-15-4. NC2024.2 +128900 ADD-FAIL-F3-15-4. NC2024.2 +129000 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +129100 MOVE 555.5 TO CORRECT-N NC2024.2 +129200 PERFORM FAIL. NC2024.2 +129300 ADD-WRITE-F3-15-4. NC2024.2 +129400 PERFORM PRINT-DETAIL. NC2024.2 +129500* NC2024.2 +129600 ADD-INIT-F3-16. NC2024.2 +129700* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +129800* ===--> NO SIZE ERROR <--=== NC2024.2 +129900 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +130000 MOVE 1 TO REC-CT. NC2024.2 +130100 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +130200 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +130300 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +130400 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +130500 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +130600 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +130700 ADD-INIT-F3-16-1. NC2024.2 +130800 MOVE "ADD-TEST-F3-16-1" TO PAR-NAME. NC2024.2 +130900 ADD-TEST-F3-16-1. NC2024.2 +131000 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +131100 NOT ON SIZE ERROR NC2024.2 +131200 PERFORM PASS NC2024.2 +131300 GO TO ADD-WRITE-F3-16-1. NC2024.2 +131400 GO TO ADD-FAIL-F3-16-1. NC2024.2 +131500 ADD-DELETE-F3-16-1. NC2024.2 +131600 PERFORM DE-LETE. NC2024.2 +131700 GO TO ADD-WRITE-F3-16-1. NC2024.2 +131800 ADD-FAIL-F3-16-1. NC2024.2 +131900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +132000 PERFORM FAIL. NC2024.2 +132100 ADD-WRITE-F3-16-1. NC2024.2 +132200 PERFORM PRINT-DETAIL. NC2024.2 +132300* NC2024.2 +132400 ADD-INIT-F3-16-2. NC2024.2 +132500 MOVE "ADD-TEST-F3-16-2" TO PAR-NAME. NC2024.2 +132600 ADD 1 TO REC-CT. NC2024.2 +132700 ADD-TEST-F3-16-2. NC2024.2 +132800 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +132900 PERFORM PASS NC2024.2 +133000 GO TO ADD-WRITE-F3-16-2. NC2024.2 +133100 GO TO ADD-FAIL-F3-16-2. NC2024.2 +133200 ADD-DELETE-F3-16-2. NC2024.2 +133300 PERFORM DE-LETE. NC2024.2 +133400 GO TO ADD-WRITE-F3-16-2. NC2024.2 +133500 ADD-FAIL-F3-16-2. NC2024.2 +133600 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +133700 MOVE 88889 TO CORRECT-N NC2024.2 +133800 PERFORM FAIL. NC2024.2 +133900 ADD-WRITE-F3-16-2. NC2024.2 +134000 PERFORM PRINT-DETAIL. NC2024.2 +134100* NC2024.2 +134200 ADD-INIT-F3-16-3. NC2024.2 +134300 MOVE "ADD-TEST-F3-16-3" TO PAR-NAME. NC2024.2 +134400 ADD 1 TO REC-CT. NC2024.2 +134500 ADD-TEST-F3-16-3. NC2024.2 +134600 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +134700 PERFORM PASS NC2024.2 +134800 GO TO ADD-WRITE-F3-16-3. NC2024.2 +134900 GO TO ADD-FAIL-F3-16-3. NC2024.2 +135000 ADD-DELETE-F3-16-3. NC2024.2 +135100 PERFORM DE-LETE. NC2024.2 +135200 GO TO ADD-WRITE-F3-16-3. NC2024.2 +135300 ADD-FAIL-F3-16-3. NC2024.2 +135400 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +135500 MOVE "+777.77" TO CORRECT-A NC2024.2 +135600 PERFORM FAIL. NC2024.2 +135700 ADD-WRITE-F3-16-3. NC2024.2 +135800 PERFORM PRINT-DETAIL. NC2024.2 +135900* NC2024.2 +136000 ADD-INIT-F3-16-4. NC2024.2 +136100 MOVE "ADD-TEST-F3-16-4" TO PAR-NAME. NC2024.2 +136200 ADD 1 TO REC-CT. NC2024.2 +136300 ADD-TEST-F3-16-4. NC2024.2 +136400 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +136500 PERFORM PASS NC2024.2 +136600 GO TO ADD-WRITE-F3-16-4. NC2024.2 +136700 GO TO ADD-FAIL-F3-16-4. NC2024.2 +136800 ADD-DELETE-F3-16-4. NC2024.2 +136900 PERFORM DE-LETE. NC2024.2 +137000 GO TO ADD-WRITE-F3-16-4. NC2024.2 +137100 ADD-FAIL-F3-16-4. NC2024.2 +137200 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +137300 MOVE 555.5 TO CORRECT-N NC2024.2 +137400 PERFORM FAIL. NC2024.2 +137500 ADD-WRITE-F3-16-4. NC2024.2 +137600 PERFORM PRINT-DETAIL. NC2024.2 +137700* NC2024.2 +137800 ADD-INIT-F3-17. NC2024.2 +137900* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +138000* ===--> SIZE ERROR <--=== NC2024.2 +138100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +138200 MOVE 1 TO REC-CT. NC2024.2 +138300 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +138400 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +138500 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +138600 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +138700 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +138800 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +138900 ADD-INIT-F3-17-1. NC2024.2 +139000 MOVE "ADD-TEST-F3-17-1" TO PAR-NAME. NC2024.2 +139100 ADD-TEST-F3-17-1. NC2024.2 +139200 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +139300 ON SIZE ERROR NC2024.2 +139400 PERFORM PASS NC2024.2 +139500 GO TO ADD-WRITE-F3-17-1 NC2024.2 +139600 NOT ON SIZE ERROR NC2024.2 +139700 GO TO ADD-FAIL-F3-17-1. NC2024.2 +139800 ADD-DELETE-F3-17. NC2024.2 +139900 PERFORM DE-LETE. NC2024.2 +140000 GO TO ADD-WRITE-F3-17-1. NC2024.2 +140100 ADD-FAIL-F3-17-1. NC2024.2 +140200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +140300 TO RE-MARK NC2024.2 +140400 PERFORM FAIL. NC2024.2 +140500 ADD-WRITE-F3-17-1. NC2024.2 +140600 PERFORM PRINT-DETAIL. NC2024.2 +140700* NC2024.2 +140800 ADD-INIT-F3-17-2. NC2024.2 +140900 MOVE "ADD-TEST-F3-17-2" TO PAR-NAME. NC2024.2 +141000 ADD 1 TO REC-CT. NC2024.2 +141100 ADD-TEST-F3-17-2. NC2024.2 +141200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +141300 PERFORM PASS NC2024.2 +141400 GO TO ADD-WRITE-F3-17-2. NC2024.2 +141500 GO TO ADD-FAIL-F3-17-2. NC2024.2 +141600 ADD-DELETE-F3-17-2. NC2024.2 +141700 PERFORM DE-LETE. NC2024.2 +141800 GO TO ADD-WRITE-F3-17-2. NC2024.2 +141900 ADD-FAIL-F3-17-2. NC2024.2 +142000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +142100 MOVE 99999 TO CORRECT-N NC2024.2 +142200 PERFORM FAIL. NC2024.2 +142300 ADD-WRITE-F3-17-2. NC2024.2 +142400 PERFORM PRINT-DETAIL. NC2024.2 +142500* NC2024.2 +142600 ADD-INIT-F3-17-3. NC2024.2 +142700 MOVE "ADD-TEST-F3-17-3" TO PAR-NAME. NC2024.2 +142800 ADD 1 TO REC-CT. NC2024.2 +142900 ADD-TEST-F3-17-3. NC2024.2 +143000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +143100 PERFORM PASS NC2024.2 +143200 GO TO ADD-WRITE-F3-17-3. NC2024.2 +143300 GO TO ADD-FAIL-F3-17-3. NC2024.2 +143400 ADD-DELETE-F3-17-3. NC2024.2 +143500 PERFORM DE-LETE. NC2024.2 +143600 GO TO ADD-WRITE-F3-17-3. NC2024.2 +143700 ADD-FAIL-F3-17-3. NC2024.2 +143800 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +143900 MOVE "+777.77" TO CORRECT-A NC2024.2 +144000 PERFORM FAIL. NC2024.2 +144100 ADD-WRITE-F3-17-3. NC2024.2 +144200 PERFORM PRINT-DETAIL. NC2024.2 +144300* NC2024.2 +144400 ADD-INIT-F3-17-4. NC2024.2 +144500 MOVE "ADD-TEST-F3-17-4" TO PAR-NAME. NC2024.2 +144600 ADD 1 TO REC-CT. NC2024.2 +144700 ADD-TEST-F3-17-4. NC2024.2 +144800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +144900 PERFORM PASS NC2024.2 +145000 GO TO ADD-WRITE-F3-17-4. NC2024.2 +145100 GO TO ADD-FAIL-F3-17-4. NC2024.2 +145200 ADD-DELETE-F3-17-4. NC2024.2 +145300 PERFORM DE-LETE. NC2024.2 +145400 GO TO ADD-WRITE-F3-17-4. NC2024.2 +145500 ADD-FAIL-F3-17-4. NC2024.2 +145600 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +145700 MOVE 555.5 TO CORRECT-N NC2024.2 +145800 PERFORM FAIL. NC2024.2 +145900 ADD-WRITE-F3-17-4. NC2024.2 +146000 PERFORM PRINT-DETAIL. NC2024.2 +146100* NC2024.2 +146200 ADD-INIT-F3-18. NC2024.2 +146300* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +146400* ===--> NO SIZE ERROR <--=== NC2024.2 +146500 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +146600 MOVE 1 TO REC-CT. NC2024.2 +146700 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +146800 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +146900 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +147000 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +147100 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +147200 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +147300 ADD-INIT-F3-18-1. NC2024.2 +147400 MOVE "ADD-TEST-F3-18-1" TO PAR-NAME. NC2024.2 +147500 ADD-TEST-F3-18-1. NC2024.2 +147600 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +147700 ON SIZE ERROR NC2024.2 +147800 GO TO ADD-FAIL-F3-18-1 NC2024.2 +147900 NOT ON SIZE ERROR NC2024.2 +148000 PERFORM PASS NC2024.2 +148100 GO TO ADD-WRITE-F3-18-1. NC2024.2 +148200 ADD-DELETE-F3-18-1. NC2024.2 +148300 PERFORM DE-LETE. NC2024.2 +148400 GO TO ADD-WRITE-F3-18-1. NC2024.2 +148500 ADD-FAIL-F3-18-1. NC2024.2 +148600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +148700 TO RE-MARK NC2024.2 +148800 PERFORM FAIL. NC2024.2 +148900 ADD-WRITE-F3-18-1. NC2024.2 +149000 PERFORM PRINT-DETAIL. NC2024.2 +149100* NC2024.2 +149200 ADD-INIT-F3-18-2. NC2024.2 +149300 MOVE "ADD-TEST-F3-18-2" TO PAR-NAME. NC2024.2 +149400 ADD 1 TO REC-CT. NC2024.2 +149500 ADD-TEST-F3-18-2. NC2024.2 +149600 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +149700 PERFORM PASS NC2024.2 +149800 GO TO ADD-WRITE-F3-18-2. NC2024.2 +149900 GO TO ADD-FAIL-F3-18-2. NC2024.2 +150000 ADD-DELETE-F3-18-2. NC2024.2 +150100 PERFORM DE-LETE NC2024.2 +150200 GO TO ADD-WRITE-F3-18-2. NC2024.2 +150300 ADD-FAIL-F3-18-2. NC2024.2 +150400 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +150500 MOVE 88889 TO CORRECT-N NC2024.2 +150600 PERFORM FAIL. NC2024.2 +150700 ADD-WRITE-F3-18-2. NC2024.2 +150800 PERFORM PRINT-DETAIL. NC2024.2 +150900* NC2024.2 +151000 ADD-INIT-F3-18-3. NC2024.2 +151100 MOVE "ADD-TEST-F3-18-3" TO PAR-NAME. NC2024.2 +151200 ADD 1 TO REC-CT. NC2024.2 +151300 ADD-TEST-F3-18-3. NC2024.2 +151400 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +151500 PERFORM PASS NC2024.2 +151600 GO TO ADD-WRITE-F3-18-3. NC2024.2 +151700 GO TO ADD-FAIL-F3-18-3. NC2024.2 +151800 ADD-DELETE-F3-18-3. NC2024.2 +151900 PERFORM DE-LETE. NC2024.2 +152000 GO TO ADD-WRITE-F3-18-3. NC2024.2 +152100 ADD-FAIL-F3-18-3. NC2024.2 +152200 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +152300 MOVE "+777.77" TO CORRECT-A NC2024.2 +152400 PERFORM FAIL. NC2024.2 +152500 ADD-WRITE-F3-18-3. NC2024.2 +152600 PERFORM PRINT-DETAIL. NC2024.2 +152700* NC2024.2 +152800 ADD-INIT-F3-18-4. NC2024.2 +152900 MOVE "ADD-TEST-F3-18-4" TO PAR-NAME. NC2024.2 +153000 ADD 1 TO REC-CT. NC2024.2 +153100 ADD-TEST-F3-18-4. NC2024.2 +153200 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +153300 PERFORM PASS NC2024.2 +153400 GO TO ADD-WRITE-F3-18-4. NC2024.2 +153500 GO TO ADD-FAIL-F3-18-4. NC2024.2 +153600 ADD-DELETE-F3-18-4. NC2024.2 +153700 PERFORM DE-LETE. NC2024.2 +153800 GO TO ADD-WRITE-F3-18-4. NC2024.2 +153900 ADD-FAIL-F3-18-4. NC2024.2 +154000 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +154100 MOVE 555.5 TO CORRECT-N NC2024.2 +154200 PERFORM FAIL. NC2024.2 +154300 ADD-WRITE-F3-18-4. NC2024.2 +154400 PERFORM PRINT-DETAIL. NC2024.2 +154500* NC2024.2 +154600 ADD-INIT-F3-19. NC2024.2 +154700* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +154800* ===--> SIZE ERROR <--=== NC2024.2 +154900 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +155000 MOVE SPACE TO WRK-XN-00001. NC2024.2 +155100 MOVE SPACE TO WRK-AN-00001. NC2024.2 +155200 MOVE 0 TO REC-CT. NC2024.2 +155300 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +155400 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +155500 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +155600 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +155700 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +155800 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +155900 MOVE "ADD-TEST-F3-19-0" TO PAR-NAME. NC2024.2 +156000 ADD-TEST-F3-19-0. NC2024.2 +156100 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +156200 ON SIZE ERROR NC2024.2 +156300 MOVE "A" TO WRK-AN-00001 NC2024.2 +156400 END-ADD NC2024.2 +156500 MOVE "B" TO WRK-XN-00001. NC2024.2 +156600* NC2024.2 +156700 ADD-INIT-F3-19-1. NC2024.2 +156800 MOVE "ADD-TEST-F3-19-1" TO PAR-NAME. NC2024.2 +156900 ADD 1 TO REC-CT. NC2024.2 +157000 ADD-TEST-F3-19-1. NC2024.2 +157100 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +157200 PERFORM PASS NC2024.2 +157300 GO TO ADD-WRITE-F3-19-1. NC2024.2 +157400 GO TO ADD-FAIL-F3-19-1. NC2024.2 +157500 ADD-DELETE-F3-19-1. NC2024.2 +157600 PERFORM DE-LETE. NC2024.2 +157700 GO TO ADD-WRITE-F3-19-1. NC2024.2 +157800 ADD-FAIL-F3-19-1. NC2024.2 +157900 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +158000 MOVE 99999 TO CORRECT-N NC2024.2 +158100 PERFORM FAIL. NC2024.2 +158200 ADD-WRITE-F3-19-1. NC2024.2 +158300 PERFORM PRINT-DETAIL. NC2024.2 +158400* NC2024.2 +158500 ADD-INIT-F3-19-2. NC2024.2 +158600 MOVE "ADD-TEST-F3-19-2" TO PAR-NAME. NC2024.2 +158700 ADD 1 TO REC-CT. NC2024.2 +158800 ADD-TEST-F3-19-2. NC2024.2 +158900 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +159000 PERFORM PASS NC2024.2 +159100 GO TO ADD-WRITE-F3-19-2. NC2024.2 +159200 GO TO ADD-FAIL-F3-19-2. NC2024.2 +159300 ADD-DELETE-F3-19-2. NC2024.2 +159400 PERFORM DE-LETE. NC2024.2 +159500 GO TO ADD-WRITE-F3-19-2. NC2024.2 +159600 ADD-FAIL-F3-19-2. NC2024.2 +159700 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +159800 MOVE "+777.77" TO CORRECT-A NC2024.2 +159900 PERFORM FAIL. NC2024.2 +160000 ADD-WRITE-F3-19-2. NC2024.2 +160100 PERFORM PRINT-DETAIL. NC2024.2 +160200* NC2024.2 +160300 ADD-INIT-F3-19-3. NC2024.2 +160400 MOVE "ADD-TEST-F3-19-3" TO PAR-NAME. NC2024.2 +160500 ADD 1 TO REC-CT. NC2024.2 +160600 ADD-TEST-F3-19-3. NC2024.2 +160700 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +160800 PERFORM PASS NC2024.2 +160900 GO TO ADD-WRITE-F3-19-3. NC2024.2 +161000 GO TO ADD-FAIL-F3-19-3. NC2024.2 +161100 ADD-DELETE-F3-19-3. NC2024.2 +161200 PERFORM DE-LETE. NC2024.2 +161300 GO TO ADD-WRITE-F3-19-3. NC2024.2 +161400 ADD-FAIL-F3-19-3. NC2024.2 +161500 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +161600 MOVE 555.5 TO CORRECT-N NC2024.2 +161700 PERFORM FAIL. NC2024.2 +161800 ADD-WRITE-F3-19-3. NC2024.2 +161900 PERFORM PRINT-DETAIL. NC2024.2 +162000* NC2024.2 +162100 ADD-INIT-F3-19-4. NC2024.2 +162200 MOVE "ADD-TEST-F3-19-4" TO PAR-NAME. NC2024.2 +162300 ADD 1 TO REC-CT. NC2024.2 +162400 ADD-TEST-F3-19-4. NC2024.2 +162500 IF WRK-AN-00001 = SPACE NC2024.2 +162600 GO TO ADD-FAIL-F3-19-4. NC2024.2 +162700 PERFORM PASS NC2024.2 +162800 GO TO ADD-WRITE-F3-19-4. NC2024.2 +162900 ADD-DELETE-F3-19-4. NC2024.2 +163000 PERFORM DE-LETE. NC2024.2 +163100 GO TO ADD-WRITE-F3-19-4. NC2024.2 +163200 ADD-FAIL-F3-19-4. NC2024.2 +163300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +163400 TO RE-MARK NC2024.2 +163500 MOVE "A" TO COMPUTED-X NC2024.2 +163600 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +163700 PERFORM FAIL. NC2024.2 +163800 ADD-WRITE-F3-19-4. NC2024.2 +163900 PERFORM PRINT-DETAIL. NC2024.2 +164000* NC2024.2 +164100 ADD-INIT-F3-19-5. NC2024.2 +164200 MOVE "ADD-TEST-F3-19-5" TO PAR-NAME. NC2024.2 +164300 ADD 1 TO REC-CT. NC2024.2 +164400 ADD-TEST-F3-19-5. NC2024.2 +164500 IF WRK-XN-00001 = SPACE NC2024.2 +164600 GO TO ADD-FAIL-F3-19-5. NC2024.2 +164700 PERFORM PASS NC2024.2 +164800 GO TO ADD-WRITE-F3-19-5. NC2024.2 +164900 ADD-DELETE-F3-19-5. NC2024.2 +165000 PERFORM DE-LETE. NC2024.2 +165100 GO TO ADD-WRITE-F3-19-5. NC2024.2 +165200 ADD-FAIL-F3-19-5. NC2024.2 +165300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +165400 MOVE "B" TO COMPUTED-X NC2024.2 +165500 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +165600 PERFORM FAIL. NC2024.2 +165700 ADD-WRITE-F3-19-5. NC2024.2 +165800 PERFORM PRINT-DETAIL. NC2024.2 +165900* NC2024.2 +166000 ADD-INIT-F3-20. NC2024.2 +166100* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +166200* ===--> NO SIZE ERROR <--=== NC2024.2 +166300 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +166400 MOVE "ADD-TEST-F3-20-0" TO PAR-NAME. NC2024.2 +166500 MOVE SPACE TO WRK-XN-00001. NC2024.2 +166600 MOVE SPACE TO WRK-AN-00001. NC2024.2 +166700 MOVE 0 TO REC-CT. NC2024.2 +166800 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +166900 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +167000 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +167100 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +167200 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +167300 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +167400 ADD-TEST-F3-20-0. NC2024.2 +167500 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +167600 ON SIZE ERROR NC2024.2 +167700 MOVE "A" TO WRK-AN-00001 NC2024.2 +167800 END-ADD NC2024.2 +167900 MOVE "B" TO WRK-XN-00001. NC2024.2 +168000* NC2024.2 +168100 ADD-INIT-F3-20-1. NC2024.2 +168200 MOVE "ADD-TEST-F3-20-1" TO PAR-NAME. NC2024.2 +168300 ADD 1 TO REC-CT. NC2024.2 +168400 ADD-TEST-F3-20-1. NC2024.2 +168500 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +168600 PERFORM PASS NC2024.2 +168700 GO TO ADD-WRITE-F3-20-1. NC2024.2 +168800 GO TO ADD-FAIL-F3-20-1. NC2024.2 +168900 ADD-DELETE-F3-20-1. NC2024.2 +169000 PERFORM DE-LETE. NC2024.2 +169100 GO TO ADD-WRITE-F3-20-1. NC2024.2 +169200 ADD-FAIL-F3-20-1. NC2024.2 +169300 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +169400 MOVE 88889 TO CORRECT-N NC2024.2 +169500 PERFORM FAIL. NC2024.2 +169600 ADD-WRITE-F3-20-1. NC2024.2 +169700 PERFORM PRINT-DETAIL. NC2024.2 +169800* NC2024.2 +169900 ADD-INIT-F3-20-2. NC2024.2 +170000 MOVE "ADD-TEST-F3-20-2" TO PAR-NAME. NC2024.2 +170100 ADD 1 TO REC-CT. NC2024.2 +170200 ADD-TEST-F3-20-2. NC2024.2 +170300 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +170400 PERFORM PASS NC2024.2 +170500 GO TO ADD-WRITE-F3-20-2. NC2024.2 +170600 GO TO ADD-FAIL-F3-20-2. NC2024.2 +170700 ADD-DELETE-F3-20-2. NC2024.2 +170800 PERFORM DE-LETE. NC2024.2 +170900 GO TO ADD-WRITE-F3-20-2. NC2024.2 +171000 ADD-FAIL-F3-20-2. NC2024.2 +171100 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +171200 MOVE "+777.77" TO CORRECT-A NC2024.2 +171300 PERFORM FAIL. NC2024.2 +171400 ADD-WRITE-F3-20-2. NC2024.2 +171500 PERFORM PRINT-DETAIL. NC2024.2 +171600* NC2024.2 +171700 ADD-INIT-F3-20-3. NC2024.2 +171800 MOVE "ADD-TEST-F3-20-3" TO PAR-NAME. NC2024.2 +171900 ADD 1 TO REC-CT. NC2024.2 +172000 ADD-TEST-F3-20-3. NC2024.2 +172100 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +172200 PERFORM PASS NC2024.2 +172300 GO TO ADD-WRITE-F3-20-3. NC2024.2 +172400 GO TO ADD-FAIL-F3-20-3. NC2024.2 +172500 ADD-DELETE-F3-20-3. NC2024.2 +172600 PERFORM DE-LETE. NC2024.2 +172700 GO TO ADD-WRITE-F3-20-3. NC2024.2 +172800 ADD-FAIL-F3-20-3. NC2024.2 +172900 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +173000 MOVE 555.5 TO CORRECT-N NC2024.2 +173100 PERFORM FAIL. NC2024.2 +173200 ADD-WRITE-F3-20-3. NC2024.2 +173300 PERFORM PRINT-DETAIL. NC2024.2 +173400* NC2024.2 +173500 ADD-INIT-F3-20-4. NC2024.2 +173600 MOVE "ADD-TEST-F3-20-4" TO PAR-NAME. NC2024.2 +173700 ADD 1 TO REC-CT. NC2024.2 +173800 ADD-TEST-F3-20-4. NC2024.2 +173900 IF WRK-AN-00001 = SPACE NC2024.2 +174000 PERFORM PASS NC2024.2 +174100 GO TO ADD-WRITE-F3-20-4. NC2024.2 +174200 GO TO ADD-FAIL-F3-20-4. NC2024.2 +174300 ADD-DELETE-F3-20-4. NC2024.2 +174400 PERFORM DE-LETE. NC2024.2 +174500 GO TO ADD-WRITE-F3-20-4. NC2024.2 +174600 ADD-FAIL-F3-20-4. NC2024.2 +174700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +174800 TO RE-MARK. NC2024.2 +174900 MOVE SPACE TO CORRECT-X. NC2024.2 +175000 MOVE WRK-AN-00001 TO COMPUTED-X. NC2024.2 +175100 PERFORM FAIL. NC2024.2 +175200 ADD-WRITE-F3-20-4. NC2024.2 +175300 PERFORM PRINT-DETAIL. NC2024.2 +175400* NC2024.2 +175500 ADD-INIT-F3-20-5. NC2024.2 +175600 MOVE "ADD-TEST-F3-20-5" TO PAR-NAME. NC2024.2 +175700 ADD 1 TO REC-CT. NC2024.2 +175800 ADD-TEST-F3-20-5. NC2024.2 +175900 IF WRK-XN-00001 = SPACE NC2024.2 +176000 GO TO ADD-FAIL-F3-20-5. NC2024.2 +176100 PERFORM PASS NC2024.2 +176200 GO TO ADD-WRITE-F3-20-5. NC2024.2 +176300 ADD-DELETE-F3-20-5. NC2024.2 +176400 PERFORM DE-LETE. NC2024.2 +176500 GO TO ADD-WRITE-F3-20-5. NC2024.2 +176600 ADD-FAIL-F3-20-5. NC2024.2 +176700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +176800 MOVE "B" TO COMPUTED-X NC2024.2 +176900 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +177000 PERFORM FAIL. NC2024.2 +177100 ADD-WRITE-F3-20-5. NC2024.2 +177200 PERFORM PRINT-DETAIL. NC2024.2 +177300* NC2024.2 +177400 ADD-INIT-F3-21. NC2024.2 +177500* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +177600* ===--> SIZE ERROR <--=== NC2024.2 +177700 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +177800 MOVE "ADD-TEST-F3-21-0" TO PAR-NAME. NC2024.2 +177900 MOVE SPACE TO WRK-XN-00001. NC2024.2 +178000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +178100 MOVE 1 TO REC-CT. NC2024.2 +178200 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +178300 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +178400 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +178500 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +178600 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +178700 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +178800 ADD-TEST-F3-21-0. NC2024.2 +178900 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +179000 NOT ON SIZE ERROR NC2024.2 +179100 MOVE "A" TO WRK-AN-00001 NC2024.2 +179200 END-ADD NC2024.2 +179300 MOVE "B" TO WRK-XN-00001. NC2024.2 +179400* NC2024.2 +179500 ADD-INIT-F3-21-1. NC2024.2 +179600 MOVE "ADD-TEST-F3-21-1" TO PAR-NAME. NC2024.2 +179700 ADD 1 TO REC-CT. NC2024.2 +179800 ADD-TEST-F3-21-1. NC2024.2 +179900 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +180000 PERFORM PASS NC2024.2 +180100 GO TO ADD-WRITE-F3-21-1. NC2024.2 +180200 GO TO ADD-FAIL-F3-21-1. NC2024.2 +180300 ADD-DELETE-F3-21-1. NC2024.2 +180400 PERFORM DE-LETE. NC2024.2 +180500 GO TO ADD-WRITE-F3-21-1. NC2024.2 +180600 ADD-FAIL-F3-21-1. NC2024.2 +180700 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +180800 MOVE 99999 TO CORRECT-N NC2024.2 +180900 PERFORM FAIL. NC2024.2 +181000 ADD-WRITE-F3-21-1. NC2024.2 +181100 PERFORM PRINT-DETAIL. NC2024.2 +181200* NC2024.2 +181300 ADD-INIT-F3-21-2. NC2024.2 +181400 MOVE "ADD-TEST-F3-21-2" TO PAR-NAME. NC2024.2 +181500 ADD 1 TO REC-CT. NC2024.2 +181600 ADD-TEST-F3-21-2. NC2024.2 +181700 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +181800 PERFORM PASS NC2024.2 +181900 GO TO ADD-WRITE-F3-21-2. NC2024.2 +182000 GO TO ADD-FAIL-F3-21-2. NC2024.2 +182100 ADD-DELETE-F3-21-2. NC2024.2 +182200 PERFORM DE-LETE. NC2024.2 +182300 GO TO ADD-WRITE-F3-21-2. NC2024.2 +182400 ADD-FAIL-F3-21-2. NC2024.2 +182500 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +182600 MOVE "+777.77" TO CORRECT-A NC2024.2 +182700 PERFORM FAIL. NC2024.2 +182800 ADD-WRITE-F3-21-2. NC2024.2 +182900 PERFORM PRINT-DETAIL. NC2024.2 +183000* NC2024.2 +183100 ADD-INIT-F3-21-3. NC2024.2 +183200 MOVE "ADD-TEST-F3-21-3" TO PAR-NAME. NC2024.2 +183300 ADD 1 TO REC-CT. NC2024.2 +183400 ADD-TEST-F3-21-3. NC2024.2 +183500 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +183600 PERFORM PASS NC2024.2 +183700 GO TO ADD-WRITE-F3-21-3. NC2024.2 +183800 GO TO ADD-FAIL-F3-21-3. NC2024.2 +183900 ADD-DELETE-F3-21-3. NC2024.2 +184000 PERFORM DE-LETE. NC2024.2 +184100 GO TO ADD-WRITE-F3-21-3. NC2024.2 +184200 ADD-FAIL-F3-21-3. NC2024.2 +184300 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +184400 MOVE 555.5 TO CORRECT-N NC2024.2 +184500 PERFORM FAIL. NC2024.2 +184600 ADD-WRITE-F3-21-3. NC2024.2 +184700 PERFORM PRINT-DETAIL. NC2024.2 +184800* NC2024.2 +184900 ADD-INIT-F3-21-4. NC2024.2 +185000 MOVE "ADD-TEST-F3-21-4" TO PAR-NAME. NC2024.2 +185100 ADD 1 TO REC-CT. NC2024.2 +185200 ADD-TEST-F3-21-4. NC2024.2 +185300 IF WRK-AN-00001 = "A" NC2024.2 +185400 GO TO ADD-FAIL-F3-21-4. NC2024.2 +185500 PERFORM PASS NC2024.2 +185600 GO TO ADD-WRITE-F3-21-4. NC2024.2 +185700 ADD-DELETE-F3-21-4. NC2024.2 +185800 PERFORM DE-LETE. NC2024.2 +185900 GO TO ADD-WRITE-F3-21-4. NC2024.2 +186000 ADD-FAIL-F3-21-4. NC2024.2 +186100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +186200 TO RE-MARK NC2024.2 +186300 MOVE SPACE TO COMPUTED-X NC2024.2 +186400 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +186500 PERFORM FAIL. NC2024.2 +186600 ADD-WRITE-F3-21-4. NC2024.2 +186700 PERFORM PRINT-DETAIL. NC2024.2 +186800* NC2024.2 +186900 ADD-INIT-F3-21-5. NC2024.2 +187000 MOVE "ADD-TEST-F3-21-5" TO PAR-NAME. NC2024.2 +187100 ADD 1 TO REC-CT. NC2024.2 +187200 ADD-TEST-F3-21-5. NC2024.2 +187300 IF WRK-XN-00001 = SPACE NC2024.2 +187400 GO TO ADD-FAIL-F3-21-5. NC2024.2 +187500 PERFORM PASS NC2024.2 +187600 GO TO ADD-WRITE-F3-21-5. NC2024.2 +187700 ADD-DELETE-F3-21-5. NC2024.2 +187800 PERFORM DE-LETE. NC2024.2 +187900 GO TO ADD-WRITE-F3-21-5. NC2024.2 +188000 ADD-FAIL-F3-21-5. NC2024.2 +188100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +188200 MOVE "B" TO COMPUTED-X NC2024.2 +188300 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +188400 PERFORM FAIL. NC2024.2 +188500 ADD-WRITE-F3-21-5. NC2024.2 +188600 PERFORM PRINT-DETAIL. NC2024.2 +188700* NC2024.2 +188800 ADD-INIT-F3-22. NC2024.2 +188900* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +189000* ===--> NO SIZE ERROR <--=== NC2024.2 +189100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +189200 MOVE "ADD-TEST-F3-22-0" TO PAR-NAME. NC2024.2 +189300 MOVE SPACE TO WRK-XN-00001. NC2024.2 +189400 MOVE SPACE TO WRK-AN-00001. NC2024.2 +189500 MOVE 0 TO REC-CT. NC2024.2 +189600 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +189700 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +189800 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +189900 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +190000 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +190100 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +190200 ADD-TEST-F3-22-0. NC2024.2 +190300 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +190400 NOT ON SIZE ERROR NC2024.2 +190500 MOVE "A" TO WRK-AN-00001 NC2024.2 +190600 PERFORM PASS NC2024.2 +190700 PERFORM PRINT-DETAIL NC2024.2 +190800 END-ADD NC2024.2 +190900 MOVE "B" TO WRK-XN-00001. NC2024.2 +191000* NC2024.2 +191100 ADD-INIT-F3-22-1. NC2024.2 +191200 MOVE "ADD-TEST-F3-22-1" TO PAR-NAME. NC2024.2 +191300 ADD 1 TO REC-CT. NC2024.2 +191400 ADD-TEST-F3-22-1. NC2024.2 +191500 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +191600 PERFORM PASS NC2024.2 +191700 GO TO ADD-WRITE-F3-22-1. NC2024.2 +191800 GO TO ADD-FAIL-F3-22-1. NC2024.2 +191900 ADD-DELETE-F3-22-1. NC2024.2 +192000 PERFORM DE-LETE. NC2024.2 +192100 GO TO ADD-WRITE-F3-22-1. NC2024.2 +192200 ADD-FAIL-F3-22-1. NC2024.2 +192300 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +192400 MOVE 88889 TO CORRECT-N NC2024.2 +192500 PERFORM FAIL. NC2024.2 +192600 ADD-WRITE-F3-22-1. NC2024.2 +192700 PERFORM PRINT-DETAIL. NC2024.2 +192800* NC2024.2 +192900 ADD-INIT-F3-22-2. NC2024.2 +193000 MOVE "ADD-TEST-F3-22-2" TO PAR-NAME. NC2024.2 +193100 ADD 1 TO REC-CT. NC2024.2 +193200 ADD-TEST-F3-22-2. NC2024.2 +193300 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +193400 PERFORM PASS NC2024.2 +193500 GO TO ADD-WRITE-F3-22-2. NC2024.2 +193600 GO TO ADD-FAIL-F3-22-2. NC2024.2 +193700 ADD-DELETE-F3-22-2. NC2024.2 +193800 PERFORM DE-LETE. NC2024.2 +193900 GO TO ADD-WRITE-F3-22-2. NC2024.2 +194000 ADD-FAIL-F3-22-2. NC2024.2 +194100 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +194200 MOVE "+777.77" TO CORRECT-A NC2024.2 +194300 PERFORM FAIL. NC2024.2 +194400 ADD-WRITE-F3-22-2. NC2024.2 +194500 PERFORM PRINT-DETAIL. NC2024.2 +194600* NC2024.2 +194700 ADD-INIT-F3-22-3. NC2024.2 +194800 MOVE "ADD-TEST-F3-22-3" TO PAR-NAME. NC2024.2 +194900 ADD 1 TO REC-CT. NC2024.2 +195000 ADD-TEST-F3-22-3. NC2024.2 +195100 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +195200 PERFORM PASS NC2024.2 +195300 GO TO ADD-WRITE-F3-22-3. NC2024.2 +195400 GO TO ADD-FAIL-F3-22-3. NC2024.2 +195500 ADD-DELETE-F3-22-3. NC2024.2 +195600 PERFORM DE-LETE. NC2024.2 +195700 GO TO ADD-WRITE-F3-22-3. NC2024.2 +195800 ADD-FAIL-F3-22-3. NC2024.2 +195900 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +196000 MOVE 555.5 TO CORRECT-N NC2024.2 +196100 PERFORM FAIL. NC2024.2 +196200 ADD-WRITE-F3-22-3. NC2024.2 +196300 PERFORM PRINT-DETAIL. NC2024.2 +196400* NC2024.2 +196500 ADD-INIT-F3-22-4. NC2024.2 +196600 MOVE "ADD-TEST-F3-22-4" TO PAR-NAME. NC2024.2 +196700 ADD 1 TO REC-CT. NC2024.2 +196800 ADD-TEST-F3-22-4. NC2024.2 +196900 IF WRK-XN-00001 = SPACE NC2024.2 +197000 GO TO ADD-FAIL-F3-22-4. NC2024.2 +197100 PERFORM PASS NC2024.2 +197200 GO TO ADD-WRITE-F3-22-4. NC2024.2 +197300 ADD-DELETE-F3-22-4. NC2024.2 +197400 PERFORM DE-LETE. NC2024.2 +197500 GO TO ADD-WRITE-F3-22-4. NC2024.2 +197600 ADD-FAIL-F3-22-4. NC2024.2 +197700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +197800 MOVE "B" TO COMPUTED-X NC2024.2 +197900 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +198000 PERFORM FAIL. NC2024.2 +198100 ADD-WRITE-F3-22-4. NC2024.2 +198200 PERFORM PRINT-DETAIL. NC2024.2 +198300* NC2024.2 +198400 ADD-INIT-F3-23. NC2024.2 +198500* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +198600* ===--> SIZE ERROR <--=== NC2024.2 +198700 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +198800 MOVE "ADD-TEST-F3-23-0" TO PAR-NAME. NC2024.2 +198900 MOVE SPACE TO WRK-XN-00001. NC2024.2 +199000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +199100 MOVE 0 TO REC-CT. NC2024.2 +199200 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +199300 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +199400 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +199500 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +199600 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +199700 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +199800 ADD-TEST-F3-23-0. NC2024.2 +199900 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +200000 ON SIZE ERROR NC2024.2 +200100 MOVE "A" TO WRK-AN-00001 NC2024.2 +200200 NOT ON SIZE ERROR NC2024.2 +200300 MOVE "B" TO WRK-AN-00001 NC2024.2 +200400 END-ADD NC2024.2 +200500 MOVE "B" TO WRK-XN-00001. NC2024.2 +200600 GO TO ADD-TEST-F3-23-1. NC2024.2 +200700* NC2024.2 +200800 ADD-INIT-F3-23-1. NC2024.2 +200900 MOVE "ADD-TEST-F3-23-1" TO PAR-NAME. NC2024.2 +201000 ADD 1 TO REC-CT. NC2024.2 +201100 ADD-TEST-F3-23-1. NC2024.2 +201200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +201300 PERFORM PASS NC2024.2 +201400 GO TO ADD-WRITE-F3-23-1. NC2024.2 +201500 GO TO ADD-FAIL-F3-23-1. NC2024.2 +201600 ADD-DELETE-F3-23-1. NC2024.2 +201700 PERFORM DE-LETE NC2024.2 +201800 GO TO ADD-WRITE-F3-23-1. NC2024.2 +201900 ADD-FAIL-F3-23-1. NC2024.2 +202000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +202100 MOVE 99999 TO CORRECT-N NC2024.2 +202200 PERFORM FAIL. NC2024.2 +202300 ADD-WRITE-F3-23-1. NC2024.2 +202400 PERFORM PRINT-DETAIL. NC2024.2 +202500* NC2024.2 +202600 ADD-INIT-F3-23-2. NC2024.2 +202700 MOVE "ADD-TEST-F3-23-2" TO PAR-NAME. NC2024.2 +202800 ADD 1 TO REC-CT. NC2024.2 +202900 ADD-TEST-F3-23-2. NC2024.2 +203000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +203100 PERFORM PASS NC2024.2 +203200 GO TO ADD-WRITE-F3-23-2. NC2024.2 +203300 GO TO ADD-FAIL-F3-23-2. NC2024.2 +203400 ADD-DELETE-F3-23-2. NC2024.2 +203500 PERFORM DE-LETE. NC2024.2 +203600 GO TO ADD-WRITE-F3-23-2. NC2024.2 +203700 ADD-FAIL-F3-23-2. NC2024.2 +203800 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +203900 MOVE "+777.77" TO CORRECT-A NC2024.2 +204000 PERFORM FAIL. NC2024.2 +204100 ADD-WRITE-F3-23-2. NC2024.2 +204200 PERFORM PRINT-DETAIL. NC2024.2 +204300* NC2024.2 +204400 ADD-INIT-F3-23-3. NC2024.2 +204500 MOVE "ADD-TEST-F3-23-3" TO PAR-NAME. NC2024.2 +204600 ADD 1 TO REC-CT. NC2024.2 +204700 ADD-TEST-F3-23-3. NC2024.2 +204800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +204900 PERFORM PASS NC2024.2 +205000 GO TO ADD-WRITE-F3-23-3. NC2024.2 +205100 GO TO ADD-FAIL-F3-23-3. NC2024.2 +205200 ADD-DELETE-F3-23-3. NC2024.2 +205300 PERFORM DE-LETE. NC2024.2 +205400 GO TO ADD-WRITE-F3-23-3. NC2024.2 +205500 ADD-FAIL-F3-23-3. NC2024.2 +205600 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +205700 MOVE 555.5 TO CORRECT-N NC2024.2 +205800 PERFORM FAIL. NC2024.2 +205900 ADD-WRITE-F3-23-3. NC2024.2 +206000 PERFORM PRINT-DETAIL. NC2024.2 +206100* NC2024.2 +206200 ADD-INIT-F3-23-4. NC2024.2 +206300 MOVE "ADD-TEST-F3-23-4" TO PAR-NAME. NC2024.2 +206400 ADD 1 TO REC-CT. NC2024.2 +206500 ADD-TEST-F3-23-4. NC2024.2 +206600 IF WRK-AN-00001 = "B" NC2024.2 +206700 GO TO ADD-FAIL-F3-23-4. NC2024.2 +206800 PERFORM PASS NC2024.2 +206900 GO TO ADD-WRITE-F3-23-4. NC2024.2 +207000 ADD-DELETE-F3-23-4. NC2024.2 +207100 PERFORM DE-LETE. NC2024.2 +207200 GO TO ADD-WRITE-F3-23-4. NC2024.2 +207300 ADD-FAIL-F3-23-4. NC2024.2 +207400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +207500 TO RE-MARK NC2024.2 +207600 MOVE "B" TO COMPUTED-X NC2024.2 +207700 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +207800 PERFORM FAIL. NC2024.2 +207900 ADD-WRITE-F3-23-4. NC2024.2 +208000 PERFORM PRINT-DETAIL. NC2024.2 +208100* NC2024.2 +208200 ADD-INIT-F3-23-5. NC2024.2 +208300 MOVE "ADD-TEST-F3-23-5" TO PAR-NAME. NC2024.2 +208400 ADD 1 TO REC-CT. NC2024.2 +208500 ADD-TEST-F3-23-5. NC2024.2 +208600 IF WRK-XN-00001 = SPACE NC2024.2 +208700 GO TO ADD-FAIL-F3-23-5. NC2024.2 +208800 PERFORM PASS NC2024.2 +208900 GO TO ADD-WRITE-F3-23-5. NC2024.2 +209000 ADD-DELETE-F3-23-5. NC2024.2 +209100 PERFORM DE-LETE. NC2024.2 +209200 GO TO ADD-WRITE-F3-23-5. NC2024.2 +209300 ADD-FAIL-F3-23-5. NC2024.2 +209400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +209500 MOVE "B" TO COMPUTED-X NC2024.2 +209600 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +209700 PERFORM FAIL. NC2024.2 +209800 ADD-WRITE-F3-23-5. NC2024.2 +209900 PERFORM PRINT-DETAIL. NC2024.2 +210000* NC2024.2 +210100 ADD-INIT-F3-24. NC2024.2 +210200* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +210300* ===--> NO SIZE ERROR <--=== NC2024.2 +210400 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +210500 MOVE "ADD-TEST-F3-24-0" TO PAR-NAME. NC2024.2 +210600 MOVE SPACE TO WRK-XN-00001. NC2024.2 +210700 MOVE SPACE TO WRK-AN-00001. NC2024.2 +210800 MOVE 0 TO REC-CT. NC2024.2 +210900 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +211000 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +211100 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +211200 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +211300 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +211400 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +211500 ADD-TEST-F3-24-0. NC2024.2 +211600 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +211700 ON SIZE ERROR NC2024.2 +211800 MOVE "A" TO WRK-AN-00001 NC2024.2 +211900 NOT ON SIZE ERROR NC2024.2 +212000 MOVE "B" TO WRK-AN-00001 NC2024.2 +212100 END-ADD NC2024.2 +212200 MOVE "B" TO WRK-XN-00001. NC2024.2 +212300* NC2024.2 +212400 ADD-INIT-F3-24-1. NC2024.2 +212500 MOVE "ADD-TEST-F3-24-1" TO PAR-NAME. NC2024.2 +212600 ADD 1 TO REC-CT. NC2024.2 +212700 ADD-TEST-F3-24-1. NC2024.2 +212800 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +212900 PERFORM PASS NC2024.2 +213000 GO TO ADD-WRITE-F3-24-1. NC2024.2 +213100 GO TO ADD-FAIL-F3-24-1. NC2024.2 +213200 ADD-DELETE-F3-24-1. NC2024.2 +213300 PERFORM DE-LETE. NC2024.2 +213400 GO TO ADD-WRITE-F3-24-1. NC2024.2 +213500 ADD-FAIL-F3-24-1. NC2024.2 +213600 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +213700 MOVE 88889 TO CORRECT-N NC2024.2 +213800 PERFORM FAIL. NC2024.2 +213900 ADD-WRITE-F3-24-1. NC2024.2 +214000 PERFORM PRINT-DETAIL. NC2024.2 +214100* NC2024.2 +214200 ADD-INIT-F3-24-2. NC2024.2 +214300 MOVE "ADD-TEST-F3-24-2" TO PAR-NAME. NC2024.2 +214400 ADD 1 TO REC-CT. NC2024.2 +214500 ADD-TEST-F3-24-2. NC2024.2 +214600 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +214700 PERFORM PASS NC2024.2 +214800 GO TO ADD-WRITE-F3-24-2. NC2024.2 +214900 GO TO ADD-FAIL-F3-24-2. NC2024.2 +215000 ADD-DELETE-F3-24-2. NC2024.2 +215100 PERFORM DE-LETE. NC2024.2 +215200 GO TO ADD-WRITE-F3-24-2. NC2024.2 +215300 ADD-FAIL-F3-24-2. NC2024.2 +215400 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +215500 MOVE "+777.77" TO CORRECT-A NC2024.2 +215600 PERFORM FAIL. NC2024.2 +215700 ADD-WRITE-F3-24-2. NC2024.2 +215800 PERFORM PRINT-DETAIL. NC2024.2 +215900* NC2024.2 +216000 ADD-INIT-F3-24-3. NC2024.2 +216100 MOVE "ADD-TEST-F3-24-3" TO PAR-NAME. NC2024.2 +216200 ADD 1 TO REC-CT. NC2024.2 +216300 ADD-TEST-F3-24-3. NC2024.2 +216400 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +216500 PERFORM PASS NC2024.2 +216600 GO TO ADD-WRITE-F3-24-3. NC2024.2 +216700 GO TO ADD-FAIL-F3-24-3. NC2024.2 +216800 ADD-DELETE-F3-24-3. NC2024.2 +216900 PERFORM DE-LETE. NC2024.2 +217000 GO TO ADD-WRITE-F3-24-3. NC2024.2 +217100 ADD-FAIL-F3-24-3. NC2024.2 +217200 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +217300 MOVE 555.5 TO CORRECT-N NC2024.2 +217400 PERFORM FAIL. NC2024.2 +217500 ADD-WRITE-F3-24-3. NC2024.2 +217600 PERFORM PRINT-DETAIL. NC2024.2 +217700* NC2024.2 +217800 ADD-INIT-F3-24-4. NC2024.2 +217900 MOVE "ADD-TEST-F3-24-4" TO PAR-NAME. NC2024.2 +218000 ADD 1 TO REC-CT. NC2024.2 +218100 ADD-TEST-F3-24-4. NC2024.2 +218200 IF WRK-AN-00001 = "B" NC2024.2 +218300 PERFORM PASS NC2024.2 +218400 GO TO ADD-WRITE-F3-24-4. NC2024.2 +218500 GO TO ADD-FAIL-F3-24-4. NC2024.2 +218600 ADD-DELETE-F3-24-4. NC2024.2 +218700 PERFORM DE-LETE. NC2024.2 +218800 GO TO ADD-WRITE-F3-24-4. NC2024.2 +218900 ADD-FAIL-F3-24-4. NC2024.2 +219000 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +219100 TO RE-MARK NC2024.2 +219200 MOVE "B" TO COMPUTED-X NC2024.2 +219300 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +219400 PERFORM FAIL. NC2024.2 +219500 ADD-WRITE-F3-24-4. NC2024.2 +219600 PERFORM PRINT-DETAIL. NC2024.2 +219700* NC2024.2 +219800 ADD-INIT-F3-24-5. NC2024.2 +219900 MOVE "ADD-TEST-F3-24-5" TO PAR-NAME. NC2024.2 +220000 ADD 1 TO REC-CT. NC2024.2 +220100 ADD-TEST-F3-24-5. NC2024.2 +220200 IF WRK-XN-00001 = SPACE NC2024.2 +220300 GO TO ADD-FAIL-F3-24-5. NC2024.2 +220400 PERFORM PASS NC2024.2 +220500 GO TO ADD-WRITE-F3-24-5. NC2024.2 +220600 ADD-DELETE-F3-24-5. NC2024.2 +220700 PERFORM DE-LETE. NC2024.2 +220800 GO TO ADD-WRITE-F3-24-5. NC2024.2 +220900 ADD-FAIL-F3-24-5. NC2024.2 +221000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +221100 MOVE "B" TO COMPUTED-X NC2024.2 +221200 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +221300 PERFORM FAIL. NC2024.2 +221400 ADD-WRITE-F3-24-5. NC2024.2 +221500 PERFORM PRINT-DETAIL. NC2024.2 +221600* NC2024.2 +221700 CCVS-EXIT SECTION. NC2024.2 +221800 CCVS-999999. NC2024.2 +221900 GO TO CLOSE-FILES. NC2024.2 +*END-OF,NC202A +*HEADER,COBOL,NC203A +000100 IDENTIFICATION DIVISION. NC2034.2 +000200 PROGRAM-ID. NC2034.2 +000300 NC203A. NC2034.2 +000400* NC2034.2 +000500**************************************************************** NC2034.2 +000600* * NC2034.2 +000700* VALIDATION FOR:- * NC2034.2 +000800* * NC2034.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +001000* * NC2034.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2034.2 +001200* * NC2034.2 +001300**************************************************************** NC2034.2 +001400* * NC2034.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2034.2 +001600* * NC2034.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2034.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2034.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2034.2 +002000* * NC2034.2 +002100**************************************************************** NC2034.2 +002200* THIS PROGRAM TESTS FORMAT 4 OF THE DIVIDE STATEMENT. * NC2034.2 +002300* NC2034.2 +002400**************************************************************** NC2034.2 +002500* THIS COMMENT ENTRY SHOULD APPEAR AS THE LAST LINE BEFORE NC2034.2 +002600* THE ENVIRONMENT DIVISION. NC2034.2 +002700 ENVIRONMENT DIVISION. NC2034.2 +002800 CONFIGURATION SECTION. NC2034.2 +002900 SOURCE-COMPUTER. NC2034.2 +003000 XXXXX082. NC2034.2 +003100 OBJECT-COMPUTER. NC2034.2 +003200 XXXXX083. NC2034.2 +003300 INPUT-OUTPUT SECTION. NC2034.2 +003400 FILE-CONTROL. NC2034.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2034.2 +003600 XXXXX055. NC2034.2 +003700 DATA DIVISION. NC2034.2 +003800 FILE SECTION. NC2034.2 +003900 FD PRINT-FILE. NC2034.2 +004000 01 PRINT-REC PICTURE X(120). NC2034.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2034.2 +004200 WORKING-STORAGE SECTION. NC2034.2 +004300 01 WS-REMAINDERS. NC2034.2 +004400 03 WS-REM PIC 99 OCCURS 20. NC2034.2 +004500 01 WRK-XN-00001-1 PIC X. NC2034.2 +004600 01 WRK-XN-00001-2 PIC X. NC2034.2 +004700 01 WS-46. NC2034.2 +004800 03 WS-1-20 PIC X(20). NC2034.2 +004900 03 WS-21-40 PIC X(20). NC2034.2 +005000 03 WS-41-46 PIC X(6). NC2034.2 +005100 77 11A PICTURE 9999 VALUE 9. NC2034.2 +005200 77 11B PICTURE 99; VALUE 8. NC2034.2 +005300 77 1111C PICTURE 99 VALUE 9. NC2034.2 +005400 77 WRK-DS-02V00 PICTURE S99. NC2034.2 +005500 88 TEST-2NUC-COND-99 VALUE 99. NC2034.2 +005600 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2034.2 +005700 77 WRK-DS-18V00 PICTURE S9(18). NC2034.2 +005800 77 A18ONES-DS-18V00 PICTURE S9(18) NC2034.2 +005900 VALUE 111111111111111111. NC2034.2 +006000 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2034.2 +006100 VALUE 222222222222222222. NC2034.2 +006200 77 WRK-DS-05V00 PICTURE S9(5). NC2034.2 +006300 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2034.2 +006400 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2034.2 +006500 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2034.2 +006600 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2034.2 +006700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2034.2 +006800 77 WRK-DS-0201P PICTURE S99P. NC2034.2 +006900 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2034.2 +007000 77 WRK-DS-09V00 PICTURE S9(9). NC2034.2 +007100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2034.2 +007200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2034.2 +007300 PICTURE S9(18). NC2034.2 +007400 77 XRAY PICTURE IS X. NC2034.2 +007500 77 W-1 PICTURE IS 9. NC2034.2 +007600 77 W-2 PICTURE IS 99. NC2034.2 +007700 77 W-3 PICTURE IS 999. NC2034.2 +007800 77 W-5 PICTURE 99 VALUE ZERO. NC2034.2 +007900 77 W-9 PICTURE 999. NC2034.2 +008000 77 W-11 PICTURE S99V9. NC2034.2 +008100 77 D-1 PICTURE S9V99 VALUE 1.06. NC2034.2 +008200 77 D-7 PICTURE S99V99 VALUE 1.09. NC2034.2 +008300 77 ONE PICTURE IS 9 VALUE IS 1. NC2034.2 +008400 77 TWO PICTURE IS S9 VALUE IS 2. NC2034.2 +008500 77 THREE PICTURE IS S9 VALUE IS 3. NC2034.2 +008600 77 FOUR PICTURE IS S9 VALUE IS 4. NC2034.2 +008700 77 FIVE PICTURE IS S9 VALUE IS 5. NC2034.2 +008800 77 SIX PICTURE IS S9 VALUE IS 6. NC2034.2 +008900 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2034.2 +009000 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2034.2 +009100 77 NINE PICTURE IS S9 VALUE IS 9. NC2034.2 +009200 77 TEN PICTURE IS S99 VALUE IS 10. NC2034.2 +009300 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2034.2 +009400 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2034.2 +009500 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2034.2 +009600 77 25COUNT PICTURE 999 VALUE ZERO. NC2034.2 +009700 77 25ANS PICTURE 99 VALUE ZERO. NC2034.2 +009800 77 25REM PICTURE 99 VALUE ZERO. NC2034.2 +009900 77 DIV-30-Y1 PICTURE 999 USAGE COMP SYNC RIGHT VALUE 31. NC2034.2 +010000 77 DIV-30-Y2 PICTURE 999 USAGE COMP VALUE 54. NC2034.2 +010100 77 DIV-30-Y3 PICTURE 999 VALUE 151. NC2034.2 +010200 77 DIV-30-Y4 PICTURE 9(4) SYNC RIGHT VALUE 1010. NC2034.2 +010300 77 DIV-Z1-30 PICTURE 999 USAGE COMP VALUE ZERO. NC2034.2 +010400 77 DIV-Z2-30 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2034.2 +010500 77 DIV-Z3-30 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2034.2 +010600 77 DIV-Z4-30 PICTURE 999 VALUE ZERO. NC2034.2 +010700 77 DIV-30-A1 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2034.2 +010800 77 DIV-30-A2 PICTURE 999 VALUE ZERO. NC2034.2 +010900 77 DIV-30-A3 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2034.2 +011000 77 DIV-30-A4 PICTURE 999 USAGE COMP VALUE ZERO. NC2034.2 +011100 01 DIV-ENTRIES. NC2034.2 +011200 02 DIV11 PICTURE 999 VALUE 105. NC2034.2 +011300 02 DIV12 PICTURE 9999 VALUE 1000. NC2034.2 +011400 02 DIV13 PICTURE 999. NC2034.2 +011500 02 DIV14 PICTURE 99. NC2034.2 +011600 02 DIV15 PICTURE 9V9 VALUE 1.1. NC2034.2 +011700 02 DIV16 PICTURE 99V99 VALUE 89.10. NC2034.2 +011800 02 DIV17 PICTURE 99V99. NC2034.2 +011900 02 DIV18 PICTURE 9999. NC2034.2 +012000 02 DIV19 PICTURE 99 VALUE 14. NC2034.2 +012100 02 DIV20 PICTURE 9999 VALUE 2147. NC2034.2 +012200 02 DIV21 PICTURE 999. NC2034.2 +012300 02 DIV22 PICTURE 99. NC2034.2 +012400 01 WRK-DU-1V17-1 PIC 9V9(17). NC2034.2 +012500 01 WRK-DU-1V5-1 PIC 9V9(5). NC2034.2 +012600 01 WRK-DU-2V1-1 PIC 99V9. NC2034.2 +012700 01 WRK-DU-05V00-0001 PIC 9(5). NC2034.2 +012800 01 WRK-DS-05V00-0002 PIC S9(5). NC2034.2 +012900 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2034.2 +013000 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2034.2 +013100 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2034.2 +013200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC2034.2 +013300 01 NE-0008 PIC $9(4).99-. NC2034.2 +013400 01 NE-0009 PIC ***99. NC2034.2 +013500 01 NE-04V01-0006 PIC ****.9. NC2034.2 +013600 01 GRP-0010. NC2034.2 +013700 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2034.2 +013800 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2034.2 +013900 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2034.2 +014000 05 WRK-DS-03V04-O003F-0014 PIC S9(3)V9999 NC2034.2 +014100 OCCURS 3 TIMES. NC2034.2 +014200 01 DS-02V00-0001 PIC S99 VALUE 16. NC2034.2 +014300 01 DS-03V00-0002 PIC S999 VALUE 174. NC2034.2 +014400 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2034.2 +014500 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2034.2 +014600 01 MINUS-NAMES. NC2034.2 +014700 02 WHOLE-FIELD PICTURE S9(18). NC2034.2 +014800 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2034.2 +014900 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2034.2 +015000 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2034.2 +015100 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2034.2 +015200 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2034.2 +015300 01 TEST-RESULTS. NC2034.2 +015400 02 FILLER PIC X VALUE SPACE. NC2034.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. NC2034.2 +015600 02 FILLER PIC X VALUE SPACE. NC2034.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. NC2034.2 +015800 02 FILLER PIC X VALUE SPACE. NC2034.2 +015900 02 PAR-NAME. NC2034.2 +016000 03 FILLER PIC X(19) VALUE SPACE. NC2034.2 +016100 03 PARDOT-X PIC X VALUE SPACE. NC2034.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. NC2034.2 +016300 02 FILLER PIC X(8) VALUE SPACE. NC2034.2 +016400 02 RE-MARK PIC X(61). NC2034.2 +016500 01 TEST-COMPUTED. NC2034.2 +016600 02 FILLER PIC X(30) VALUE SPACE. NC2034.2 +016700 02 FILLER PIC X(17) VALUE NC2034.2 +016800 " COMPUTED=". NC2034.2 +016900 02 COMPUTED-X. NC2034.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2034.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A NC2034.2 +017200 PIC -9(9).9(9). NC2034.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2034.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2034.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2034.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. NC2034.2 +017700 04 COMPUTED-18V0 PIC -9(18). NC2034.2 +017800 04 FILLER PIC X. NC2034.2 +017900 03 FILLER PIC X(50) VALUE SPACE. NC2034.2 +018000 01 TEST-CORRECT. NC2034.2 +018100 02 FILLER PIC X(30) VALUE SPACE. NC2034.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2034.2 +018300 02 CORRECT-X. NC2034.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2034.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2034.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2034.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2034.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2034.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. NC2034.2 +019000 04 CORRECT-18V0 PIC -9(18). NC2034.2 +019100 04 FILLER PIC X. NC2034.2 +019200 03 FILLER PIC X(2) VALUE SPACE. NC2034.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2034.2 +019400 01 CCVS-C-1. NC2034.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2034.2 +019600- "SS PARAGRAPH-NAME NC2034.2 +019700- " REMARKS". NC2034.2 +019800 02 FILLER PIC X(20) VALUE SPACE. NC2034.2 +019900 01 CCVS-C-2. NC2034.2 +020000 02 FILLER PIC X VALUE SPACE. NC2034.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". NC2034.2 +020200 02 FILLER PIC X(15) VALUE SPACE. NC2034.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". NC2034.2 +020400 02 FILLER PIC X(94) VALUE SPACE. NC2034.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2034.2 +020600 01 REC-CT PIC 99 VALUE ZERO. NC2034.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2034.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2034.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2034.2 +021600 01 CCVS-H-1. NC2034.2 +021700 02 FILLER PIC X(39) VALUE SPACES. NC2034.2 +021800 02 FILLER PIC X(42) VALUE NC2034.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2034.2 +022000 02 FILLER PIC X(39) VALUE SPACES. NC2034.2 +022100 01 CCVS-H-2A. NC2034.2 +022200 02 FILLER PIC X(40) VALUE SPACE. NC2034.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2034.2 +022400 02 FILLER PIC XXXX VALUE NC2034.2 +022500 "4.2 ". NC2034.2 +022600 02 FILLER PIC X(28) VALUE NC2034.2 +022700 " COPY - NOT FOR DISTRIBUTION". NC2034.2 +022800 02 FILLER PIC X(41) VALUE SPACE. NC2034.2 +022900 NC2034.2 +023000 01 CCVS-H-2B. NC2034.2 +023100 02 FILLER PIC X(15) VALUE NC2034.2 +023200 "TEST RESULT OF ". NC2034.2 +023300 02 TEST-ID PIC X(9). NC2034.2 +023400 02 FILLER PIC X(4) VALUE NC2034.2 +023500 " IN ". NC2034.2 +023600 02 FILLER PIC X(12) VALUE NC2034.2 +023700 " HIGH ". NC2034.2 +023800 02 FILLER PIC X(22) VALUE NC2034.2 +023900 " LEVEL VALIDATION FOR ". NC2034.2 +024000 02 FILLER PIC X(58) VALUE NC2034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +024200 01 CCVS-H-3. NC2034.2 +024300 02 FILLER PIC X(34) VALUE NC2034.2 +024400 " FOR OFFICIAL USE ONLY ". NC2034.2 +024500 02 FILLER PIC X(58) VALUE NC2034.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2034.2 +024700 02 FILLER PIC X(28) VALUE NC2034.2 +024800 " COPYRIGHT 1985 ". NC2034.2 +024900 01 CCVS-E-1. NC2034.2 +025000 02 FILLER PIC X(52) VALUE SPACE. NC2034.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2034.2 +025200 02 ID-AGAIN PIC X(9). NC2034.2 +025300 02 FILLER PIC X(45) VALUE SPACES. NC2034.2 +025400 01 CCVS-E-2. NC2034.2 +025500 02 FILLER PIC X(31) VALUE SPACE. NC2034.2 +025600 02 FILLER PIC X(21) VALUE SPACE. NC2034.2 +025700 02 CCVS-E-2-2. NC2034.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2034.2 +025900 03 FILLER PIC X VALUE SPACE. NC2034.2 +026000 03 ENDER-DESC PIC X(44) VALUE NC2034.2 +026100 "ERRORS ENCOUNTERED". NC2034.2 +026200 01 CCVS-E-3. NC2034.2 +026300 02 FILLER PIC X(22) VALUE NC2034.2 +026400 " FOR OFFICIAL USE ONLY". NC2034.2 +026500 02 FILLER PIC X(12) VALUE SPACE. NC2034.2 +026600 02 FILLER PIC X(58) VALUE NC2034.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +026800 02 FILLER PIC X(13) VALUE SPACE. NC2034.2 +026900 02 FILLER PIC X(15) VALUE NC2034.2 +027000 " COPYRIGHT 1985". NC2034.2 +027100 01 CCVS-E-4. NC2034.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2034.2 +027300 02 FILLER PIC X(4) VALUE " OF ". NC2034.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2034.2 +027500 02 FILLER PIC X(40) VALUE NC2034.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2034.2 +027700 01 XXINFO. NC2034.2 +027800 02 FILLER PIC X(19) VALUE NC2034.2 +027900 "*** INFORMATION ***". NC2034.2 +028000 02 INFO-TEXT. NC2034.2 +028100 04 FILLER PIC X(8) VALUE SPACE. NC2034.2 +028200 04 XXCOMPUTED PIC X(20). NC2034.2 +028300 04 FILLER PIC X(5) VALUE SPACE. NC2034.2 +028400 04 XXCORRECT PIC X(20). NC2034.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). NC2034.2 +028600 01 HYPHEN-LINE. NC2034.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. NC2034.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************NC2034.2 +028900- "*****************************************". NC2034.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************NC2034.2 +029100- "******************************". NC2034.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE NC2034.2 +029300 "NC203A". NC2034.2 +029400 PROCEDURE DIVISION. NC2034.2 +029500 CCVS1 SECTION. NC2034.2 +029600 OPEN-FILES. NC2034.2 +029700 OPEN OUTPUT PRINT-FILE. NC2034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2034.2 +029900 MOVE SPACE TO TEST-RESULTS. NC2034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2034.2 +030100 GO TO CCVS1-EXIT. NC2034.2 +030200 CLOSE-FILES. NC2034.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2034.2 +030400 TERMINATE-CCVS. NC2034.2 +030500S EXIT PROGRAM. NC2034.2 +030600STERMINATE-CALL. NC2034.2 +030700 STOP RUN. NC2034.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2034.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2034.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2034.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2034.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. NC2034.2 +031300 PRINT-DETAIL. NC2034.2 +031400 IF REC-CT NOT EQUAL TO ZERO NC2034.2 +031500 MOVE "." TO PARDOT-X NC2034.2 +031600 MOVE REC-CT TO DOTVALUE. NC2034.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2034.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2034.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2034.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2034.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2034.2 +032200 MOVE SPACE TO CORRECT-X. NC2034.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2034.2 +032400 MOVE SPACE TO RE-MARK. NC2034.2 +032500 HEAD-ROUTINE. NC2034.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2034.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2034.2 +033000 COLUMN-NAMES-ROUTINE. NC2034.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +033400 END-ROUTINE. NC2034.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2034.2 +033600 END-RTN-EXIT. NC2034.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +033800 END-ROUTINE-1. NC2034.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2034.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2034.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. NC2034.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2034.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2034.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2034.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2034.2 +034700 END-ROUTINE-12. NC2034.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2034.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2034.2 +035000 MOVE "NO " TO ERROR-TOTAL NC2034.2 +035100 ELSE NC2034.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2034.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2034.2 +035400 PERFORM WRITE-LINE. NC2034.2 +035500 END-ROUTINE-13. NC2034.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2034.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE NC2034.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2034.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2034.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO NC2034.2 +036200 MOVE "NO " TO ERROR-TOTAL NC2034.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2034.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2034.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036700 WRITE-LINE. NC2034.2 +036800 ADD 1 TO RECORD-COUNT. NC2034.2 +036900Y IF RECORD-COUNT GREATER 50 NC2034.2 +037000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2034.2 +037100Y MOVE SPACE TO DUMMY-RECORD NC2034.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2034.2 +037300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2034.2 +037400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2034.2 +037500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2034.2 +037600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2034.2 +037700Y MOVE ZERO TO RECORD-COUNT. NC2034.2 +037800 PERFORM WRT-LN. NC2034.2 +037900 WRT-LN. NC2034.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2034.2 +038100 MOVE SPACE TO DUMMY-RECORD. NC2034.2 +038200 BLANK-LINE-PRINT. NC2034.2 +038300 PERFORM WRT-LN. NC2034.2 +038400 FAIL-ROUTINE. NC2034.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2034.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2034.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2034.2 +038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2034.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +039000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2034.2 +039100 GO TO FAIL-ROUTINE-EX. NC2034.2 +039200 FAIL-ROUTINE-WRITE. NC2034.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2034.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2034.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2034.2 +039600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2034.2 +039700 FAIL-ROUTINE-EX. EXIT. NC2034.2 +039800 BAIL-OUT. NC2034.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2034.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2034.2 +040100 BAIL-OUT-WRITE. NC2034.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2034.2 +040300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2034.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2034.2 +040600 BAIL-OUT-EX. EXIT. NC2034.2 +040700 CCVS1-EXIT. NC2034.2 +040800 EXIT. NC2034.2 +040900 SECT-NC203A-001 SECTION. NC2034.2 +041000 DIV-INIT-F4-1. NC2034.2 +041100 MOVE "DIV-TEST-F4-1" TO PAR-NAME. NC2034.2 +041200 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +041300 MOVE "DIVIDE" TO FEATURE. NC2034.2 +041400 MOVE 111111.0 TO WRK-DS-06V06. NC2034.2 +041500 DIV-TEST-F4-1. NC2034.2 +041600 DIVIDE 22 INTO WRK-DS-06V06 GIVING WRK-DS-05V00 NC2034.2 +041700 REMAINDER WRK-DS-02V00. NC2034.2 +041800 ADD WRK-DS-02V00 TO WRK-DS-05V00. NC2034.2 +041900 IF WRK-DS-05V00 EQUAL TO 5061 NC2034.2 +042000 PERFORM PASS NC2034.2 +042100 GO TO DIV-WRITE-F4-1. NC2034.2 +042200 GO TO DIV-FAIL-F4-1. NC2034.2 +042300 DIV-DELETE-F4-1. NC2034.2 +042400 PERFORM DE-LETE. NC2034.2 +042500 GO TO DIV-WRITE-F4-1. NC2034.2 +042600 DIV-FAIL-F4-1. NC2034.2 +042700 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2034.2 +042800 MOVE 5061 TO CORRECT-N. NC2034.2 +042900 PERFORM FAIL. NC2034.2 +043000 DIV-WRITE-F4-1. NC2034.2 +043100 PERFORM PRINT-DETAIL. NC2034.2 +043200* NC2034.2 +043300 DIV-INIT-F4-2. NC2034.2 +043400 MOVE "DIV-TEST-F4-2" TO PAR-NAME. NC2034.2 +043500 MOVE 105 TO DIV11. NC2034.2 +043600 MOVE 1000 TO DIV12. NC2034.2 +043700 DIV-TEST-F4-2. NC2034.2 +043800 DIVIDE DIV11 INTO DIV12 GIVING DIV13 REMAINDER DIV14. NC2034.2 +043900 IF DIV14 IS EQUAL TO 55 NC2034.2 +044000 PERFORM PASS NC2034.2 +044100 GO TO DIV-WRITE-F4-2. NC2034.2 +044200 GO TO DIV-FAIL-F4-2. NC2034.2 +044300 DIV-DELETE-F4-2. NC2034.2 +044400 PERFORM DE-LETE. NC2034.2 +044500 GO TO DIV-WRITE-F4-2. NC2034.2 +044600 DIV-FAIL-F4-2. NC2034.2 +044700 PERFORM FAIL. NC2034.2 +044800 MOVE DIV14 TO COMPUTED-N. NC2034.2 +044900 MOVE "+55" TO CORRECT-A. NC2034.2 +045000 DIV-WRITE-F4-2. NC2034.2 +045100 PERFORM PRINT-DETAIL. NC2034.2 +045200* NC2034.2 +045300 DIV-INIT-F4-3. NC2034.2 +045400 MOVE "DIV-TEST-F4-3" TO PAR-NAME. NC2034.2 +045500 MOVE 14 TO DIV19. NC2034.2 +045600 MOVE 2147 TO DIV20. NC2034.2 +045700 DIV-TEST-F4-3. NC2034.2 +045800 DIVIDE DIV19 INTO DIV20 GIVING DIV21 ROUNDED REMAINDER NC2034.2 +045900 DIV22. NC2034.2 +046000 IF DIV22 IS EQUAL TO 05 NC2034.2 +046100 PERFORM PASS NC2034.2 +046200 GO TO DIV-WRITE-F4-3. NC2034.2 +046300 GO TO DIV-FAIL-F4-3. NC2034.2 +046400 DIV-DELETE-F4-3. NC2034.2 +046500 PERFORM DE-LETE. NC2034.2 +046600 GO TO DIV-WRITE-F4-3. NC2034.2 +046700 DIV-FAIL-F4-3. NC2034.2 +046800 PERFORM FAIL. NC2034.2 +046900 MOVE DIV22 TO COMPUTED-N. NC2034.2 +047000 MOVE "+05" TO CORRECT-A. NC2034.2 +047100 DIV-WRITE-F4-3. NC2034.2 +047200 PERFORM PRINT-DETAIL. NC2034.2 +047300* NC2034.2 +047400 DIV-INIT-F4-4. NC2034.2 +047500 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +047600 MOVE ZERO TO 25COUNT. NC2034.2 +047700 MOVE ZERO TO 25ANS. NC2034.2 +047800 MOVE ZERO TO 25REM. NC2034.2 +047900 MOVE 1 TO REC-CT. NC2034.2 +048000 DIV-INIT-F4-4-0. NC2034.2 +048100 MOVE "DIV-TEST-F4-4-0" TO PAR-NAME. NC2034.2 +048200 DIV-TEST-F4-4-0. NC2034.2 +048300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +048400 ON SIZE ERROR NC2034.2 +048500 PERFORM PASS NC2034.2 +048600 GO TO DIV-WRITE-F4-4-0. NC2034.2 +048700 GO TO DIV-FAIL-F4-4-0. NC2034.2 +048800 DIV-FAIL-F4-4-0. NC2034.2 +048900 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK. NC2034.2 +049000 PERFORM FAIL. NC2034.2 +049100 DIV-WRITE-F4-4-0. NC2034.2 +049200 PERFORM PRINT-DETAIL. NC2034.2 +049300* NC2034.2 +049400 DIV-INIT-F4-4-1. NC2034.2 +049500 MOVE "DIV-TEST-F4-4-1" TO PAR-NAME. NC2034.2 +049600 ADD 1 TO REC-CT. NC2034.2 +049700 DIV-TEST-F4-4-1. NC2034.2 +049800 IF 25ANS NOT = ZERO NC2034.2 +049900 GO TO DIV-FAIL-F4-4-1. NC2034.2 +050000 PERFORM PASS NC2034.2 +050100 GO TO DIV-WRITE-F4-4-1. NC2034.2 +050200 DIV-DELETE-F4-4-1. NC2034.2 +050300 PERFORM DE-LETE. NC2034.2 +050400 GO TO DIV-WRITE-F4-4-1. NC2034.2 +050500 DIV-FAIL-F4-4-1. NC2034.2 +050600 MOVE 25ANS TO COMPUTED-N NC2034.2 +050700 MOVE ZERO TO CORRECT-N NC2034.2 +050800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +050900 PERFORM FAIL. NC2034.2 +051000 DIV-WRITE-F4-4-1. NC2034.2 +051100 PERFORM PRINT-DETAIL. NC2034.2 +051200* NC2034.2 +051300 DIV-INIT-F4-4-2. NC2034.2 +051400 MOVE "DIV-TEST-F4-4-2" TO PAR-NAME. NC2034.2 +051500 ADD 1 TO REC-CT. NC2034.2 +051600 DIV-TEST-F4-4-2. NC2034.2 +051700 IF 25REM NOT = ZERO NC2034.2 +051800 GO TO DIV-FAIL-F4-4-2. NC2034.2 +051900 PERFORM PASS NC2034.2 +052000 GO TO DIV-WRITE-F4-4-2. NC2034.2 +052100 DIV-DELETE-F4-4-2. NC2034.2 +052200 PERFORM DE-LETE. NC2034.2 +052300 GO TO DIV-WRITE-F4-4-2. NC2034.2 +052400 DIV-FAIL-F4-4-2. NC2034.2 +052500 MOVE 25REM TO COMPUTED-N NC2034.2 +052600 MOVE ZERO TO CORRECT-N NC2034.2 +052700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +052800 PERFORM FAIL. NC2034.2 +052900 DIV-WRITE-F4-4-2. NC2034.2 +053000 PERFORM PRINT-DETAIL. NC2034.2 +053100* NC2034.2 +053200 DIV-INIT-F4-5. NC2034.2 +053300 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +053400 MOVE ZERO TO 25ANS. NC2034.2 +053500 MOVE ZERO TO 25REM. NC2034.2 +053600 MOVE 3 TO 25COUNT. NC2034.2 +053700 MOVE 1 TO REC-CT. NC2034.2 +053800 DIV-INIT-F4-5-0. NC2034.2 +053900 MOVE "DIV-TEST-F4-5-0" TO PAR-NAME. NC2034.2 +054000 DIV-TEST-F4-5-0. NC2034.2 +054100 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +054200 ON SIZE ERROR NC2034.2 +054300 GO TO DIV-FAIL-F4-5-0. NC2034.2 +054400 PERFORM PASS. NC2034.2 +054500 GO TO DIV-WRITE-F4-5-0. NC2034.2 +054600 DIV-DELETE-F4-5-0. NC2034.2 +054700 PERFORM DE-LETE. NC2034.2 +054800 GO TO DIV-WRITE-F4-5-0. NC2034.2 +054900 DIV-FAIL-F4-5-0. NC2034.2 +055000 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +055100 TO RE-MARK NC2034.2 +055200 PERFORM FAIL. NC2034.2 +055300 DIV-WRITE-F4-5-0. NC2034.2 +055400 PERFORM PRINT-DETAIL. NC2034.2 +055500* NC2034.2 +055600 DIV-INIT-F4-5-1. NC2034.2 +055700 MOVE "DIV-TEST-F4-5-1" TO PAR-NAME. NC2034.2 +055800 ADD 1 TO REC-CT. NC2034.2 +055900 DIV-TEST-F4-5-1. NC2034.2 +056000 IF 25ANS NOT = 33 NC2034.2 +056100 GO TO DIV-FAIL-F4-5-1. NC2034.2 +056200 PERFORM PASS NC2034.2 +056300 GO TO DIV-WRITE-F4-5-1. NC2034.2 +056400 DIV-DELETE-F4-5-1. NC2034.2 +056500 PERFORM DE-LETE. NC2034.2 +056600 GO TO DIV-WRITE-F4-5-1. NC2034.2 +056700 DIV-FAIL-F4-5-1. NC2034.2 +056800 MOVE 33 TO CORRECT-N NC2034.2 +056900 MOVE 25ANS TO COMPUTED-N NC2034.2 +057000 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +057100 PERFORM FAIL. NC2034.2 +057200 DIV-WRITE-F4-5-1. NC2034.2 +057300 PERFORM PRINT-DETAIL. NC2034.2 +057400* NC2034.2 +057500 DIV-INIT-F4-5-2. NC2034.2 +057600 MOVE "DIV-TEST-F4-5-2" TO PAR-NAME. NC2034.2 +057700 ADD 1 TO REC-CT. NC2034.2 +057800 DIV-TEST-F4-5-2. NC2034.2 +057900 IF 25REM NOT = 1 NC2034.2 +058000 GO TO DIV-FAIL-F4-5-2. NC2034.2 +058100 PERFORM PASS NC2034.2 +058200 GO TO DIV-WRITE-F4-5-2. NC2034.2 +058300 DIV-DELETE-F4-5-2. NC2034.2 +058400 PERFORM DE-LETE. NC2034.2 +058500 GO TO DIV-WRITE-F4-5-2. NC2034.2 +058600 DIV-FAIL-F4-5-2. NC2034.2 +058700 MOVE 25REM TO COMPUTED-N NC2034.2 +058800 MOVE 1 TO CORRECT-N NC2034.2 +058900 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +059000 PERFORM FAIL. NC2034.2 +059100 DIV-WRITE-F4-5-2. NC2034.2 +059200 PERFORM PRINT-DETAIL. NC2034.2 +059300* NC2034.2 +059400 DIV-INIT-F4-6. NC2034.2 +059500 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +059600 MOVE 40 TO 25COUNT. NC2034.2 +059700 MOVE ZERO TO 25ANS. NC2034.2 +059800 MOVE ZERO TO 25REM. NC2034.2 +059900 MOVE 1 TO REC-CT. NC2034.2 +060000 DIV-INIT-F4-6-0. NC2034.2 +060100 MOVE "DIV-TEST-F4-6-0" TO PAR-NAME. NC2034.2 +060200 DIV-TEST-F4-6-0. NC2034.2 +060300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +060400 ON SIZE ERROR NC2034.2 +060500 GO TO DIV-FAIL-F4-6-0. NC2034.2 +060600 PERFORM PASS. NC2034.2 +060700 GO TO DIV-WRITE-F4-6-0. NC2034.2 +060800 DIV-DELETE-F4-6-0. NC2034.2 +060900 PERFORM DE-LETE. NC2034.2 +061000 GO TO DIV-WRITE-F4-6-0. NC2034.2 +061100 DIV-FAIL-F4-6-0. NC2034.2 +061200 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +061300 TO RE-MARK NC2034.2 +061400 PERFORM FAIL. NC2034.2 +061500 DIV-WRITE-F4-6-0. NC2034.2 +061600 PERFORM PRINT-DETAIL. NC2034.2 +061700* NC2034.2 +061800 DIV-INIT-F4-6-1. NC2034.2 +061900 MOVE "DIV-TEST-F4-6-1" TO PAR-NAME. NC2034.2 +062000 ADD 1 TO REC-CT. NC2034.2 +062100 DIV-TEST-F4-6-1. NC2034.2 +062200 IF 25ANS NOT = 2 NC2034.2 +062300 GO TO DIV-FAIL-F4-6-1. NC2034.2 +062400 PERFORM PASS NC2034.2 +062500 GO TO DIV-WRITE-F4-6-1. NC2034.2 +062600 DIV-DELETE-F4-6-1. NC2034.2 +062700 PERFORM DE-LETE. NC2034.2 +062800 GO TO DIV-WRITE-F4-6-1. NC2034.2 +062900 DIV-FAIL-F4-6-1. NC2034.2 +063000 MOVE 2 TO CORRECT-N NC2034.2 +063100 MOVE 25ANS TO COMPUTED-N NC2034.2 +063200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +063300 PERFORM FAIL. NC2034.2 +063400 DIV-WRITE-F4-6-1. NC2034.2 +063500 PERFORM PRINT-DETAIL. NC2034.2 +063600* NC2034.2 +063700 DIV-INIT-F4-6-2. NC2034.2 +063800 MOVE "DIV-TEST-F4-6-2" TO PAR-NAME. NC2034.2 +063900 DIV-TEST-F4-6-2. NC2034.2 +064000 ADD 1 TO REC-CT. NC2034.2 +064100 IF 25REM NOT = 20 NC2034.2 +064200 GO TO DIV-FAIL-F4-6-2. NC2034.2 +064300 PERFORM PASS NC2034.2 +064400 GO TO DIV-WRITE-F4-6-2. NC2034.2 +064500 DIV-DELETE-F4-6-2. NC2034.2 +064600 PERFORM DE-LETE. NC2034.2 +064700 GO TO DIV-WRITE-F4-6-2. NC2034.2 +064800 DIV-FAIL-F4-6-2. NC2034.2 +064900 MOVE 25REM TO COMPUTED-N NC2034.2 +065000 MOVE 20 TO CORRECT-N NC2034.2 +065100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +065200 PERFORM FAIL. NC2034.2 +065300 DIV-WRITE-F4-6-2. NC2034.2 +065400 PERFORM PRINT-DETAIL. NC2034.2 +065500* NC2034.2 +065600 DIV-INIT-F4-7. NC2034.2 +065700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +065800 MOVE "DIV-TEST-F4-7-0" TO PAR-NAME. NC2034.2 +065900 MOVE 16 TO DS-02V00-0001. NC2034.2 +066000 MOVE 174 TO DS-03V00-0002. NC2034.2 +066100 MOVE ZERO TO WRK-DS-04V01-0005. NC2034.2 +066200 MOVE ZERO TO NE-0009. NC2034.2 +066300 MOVE 1 TO REC-CT. NC2034.2 +066400 DIV-TEST-F4-7-0. NC2034.2 +066500 DIVIDE DS-02V00-0001 INTO DS-03V00-0002 NC2034.2 +066600 GIVING WRK-DS-04V01-0005 REMAINDER NE-0009. NC2034.2 +066700* NC2034.2 +066800* REMAINDER RECEIVING FIELD DESCRIBED AS NUMERIC EDITED. NC2034.2 +066900* I1 = 16 NC2034.2 +067000* I2 = 174 NC2034.2 +067100* NC2034.2 +067200 DIV-INIT-F4-7-1. NC2034.2 +067300 MOVE "DIV-TEST-F4-7-1" TO PAR-NAME. NC2034.2 +067400 DIV-TEST-F4-7-1. NC2034.2 +067500 IF NE-0009 EQUAL TO "***01" NC2034.2 +067600 PERFORM PASS NC2034.2 +067700 GO TO DIV-WRITE-F4-7-1. NC2034.2 +067800 GO TO DIV-FAIL-F4-7-1. NC2034.2 +067900 DIV-FAIL-F4-7-1. NC2034.2 +068000 PERFORM FAIL. NC2034.2 +068100 MOVE "***01" TO CORRECT-A. NC2034.2 +068200 MOVE NE-0009 TO COMPUTED-A. NC2034.2 +068300 DIV-DELETE-F4-7-1. NC2034.2 +068400 PERFORM DE-LETE. NC2034.2 +068500 GO TO DIV-WRITE-F4-7-1. NC2034.2 +068600 DIV-WRITE-F4-7-1. NC2034.2 +068700 PERFORM PRINT-DETAIL. NC2034.2 +068800* NC2034.2 +068900 DIV-INIT-F4-7-2. NC2034.2 +069000 MOVE "DIV-TEST-F4-7-2" TO PAR-NAME. NC2034.2 +069100 ADD 1 TO REC-CT. NC2034.2 +069200 DIV-TEST-F4-7-2. NC2034.2 +069300 IF WRK-DS-04V01-0005 NOT = 10.8 NC2034.2 +069400 GO TO DIV-FAIL-F4-7-2. NC2034.2 +069500 PERFORM PASS NC2034.2 +069600 GO TO DIV-WRITE-F4-7-2. NC2034.2 +069700 DIV-DELETE-F4-7-2. NC2034.2 +069800 PERFORM DE-LETE. NC2034.2 +069900 GO TO DIV-WRITE-F4-7-2. NC2034.2 +070000 DIV-FAIL-F4-7-2. NC2034.2 +070100 MOVE WRK-DS-04V01-0005 TO COMPUTED-N NC2034.2 +070200 MOVE 10.8 TO CORRECT-N NC2034.2 +070300 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +070400 PERFORM FAIL. NC2034.2 +070500 DIV-WRITE-F4-7-2. NC2034.2 +070600 PERFORM PRINT-DETAIL. NC2034.2 +070700* NC2034.2 +070800 DIV-INIT-F4-8. NC2034.2 +070900 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +071000 MOVE 16 TO DS-02V00-0001. NC2034.2 +071100 MOVE 174 TO DS-03V00-0002. NC2034.2 +071200 MOVE ZERO TO WRK-DS-04V01-0005. NC2034.2 +071300 MOVE ZERO TO NE-04V01-0006. NC2034.2 +071400 MOVE 1 TO REC-CT. NC2034.2 +071500 MOVE "DIV-TEST-F4-8-0" TO PAR-NAME. NC2034.2 +071600 MOVE "DIVIDE" TO FEATURE. NC2034.2 +071700* NC2034.2 +071800 DIV-TEST-F4-8-0. NC2034.2 +071900 DIVIDE DS-02V00-0001 INTO DS-03V00-0002 NC2034.2 +072000 GIVING NE-04V01-0006 REMAINDER WRK-DS-05V00-0002. NC2034.2 +072100* NC2034.2 +072200* GIVING RECEIVING FIELD DESCRIBED AS NUMERIC EDITED. NC2034.2 +072300* INTERMEDIATE STORAGE SHOULD BE USED TO CALCULATE THE NC2034.2 +072400* REMAINDER NC2034.2 +072500* I1 = 16 NC2034.2 +072600* I2 = 174 NC2034.2 +072700* NC2034.2 +072800 DIV-INIT-F4-8-1. NC2034.2 +072900 MOVE "DIV-TEST-F4-8-1" TO PAR-NAME. NC2034.2 +073000 DIV-TEST-F4-8-1. NC2034.2 +073100 IF WRK-DS-05V00-0002 EQUAL TO 00001 NC2034.2 +073200 PERFORM PASS NC2034.2 +073300 GO TO DIV-WRITE-F4-8-1. NC2034.2 +073400 GO TO DIV-FAIL-F4-8-1. NC2034.2 +073500 DIV-DELETE-F4-8-1. NC2034.2 +073600 PERFORM DE-LETE. NC2034.2 +073700 GO TO DIV-WRITE-F4-8-1. NC2034.2 +073800 DIV-FAIL-F4-8-1. NC2034.2 +073900 PERFORM FAIL. NC2034.2 +074000 MOVE 00001 TO CORRECT-A. NC2034.2 +074100 MOVE WRK-DS-05V00-0002 TO COMPUTED-A. NC2034.2 +074200 DIV-WRITE-F4-8-1. NC2034.2 +074300 PERFORM PRINT-DETAIL. NC2034.2 +074400* NC2034.2 +074500 DIV-INIT-F4-8-2. NC2034.2 +074600 MOVE "DIV-TEST-F4-8-2" TO PAR-NAME. NC2034.2 +074700 ADD 1 TO REC-CT. NC2034.2 +074800 DIV-TEST-F4-8-2. NC2034.2 +074900 IF NE-04V01-0006 NOT = "**10.8" NC2034.2 +075000 GO TO DIV-FAIL-F4-8-2. NC2034.2 +075100 PERFORM PASS NC2034.2 +075200 GO TO DIV-WRITE-F4-8-2. NC2034.2 +075300 DIV-DELETE-F4-8-2. NC2034.2 +075400 PERFORM DE-LETE. NC2034.2 +075500 GO TO DIV-WRITE-F4-8-2. NC2034.2 +075600 DIV-FAIL-F4-8-2. NC2034.2 +075700 MOVE NE-04V01-0006 TO COMPUTED-A NC2034.2 +075800 MOVE "**10.8" TO CORRECT-A NC2034.2 +075900 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +076000 PERFORM FAIL. NC2034.2 +076100 DIV-WRITE-F4-8-2. NC2034.2 +076200 PERFORM PRINT-DETAIL. NC2034.2 +076300* NC2034.2 +076400 DIV-INIT-F4-9. NC2034.2 +076500 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +076600 MOVE ZERO TO 25COUNT. NC2034.2 +076700 MOVE ZERO TO 25ANS. NC2034.2 +076800 MOVE ZERO TO 25REM. NC2034.2 +076900 MOVE 1 TO REC-CT. NC2034.2 +077000 DIV-INIT-F4-9-0. NC2034.2 +077100 MOVE "DIV-TEST-F4-9-0" TO PAR-NAME. NC2034.2 +077200 DIV-TEST-F4-9-0. NC2034.2 +077300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +077400 NOT ON SIZE ERROR NC2034.2 +077500 GO TO DIV-FAIL-F4-9-0. NC2034.2 +077600 PERFORM PASS. NC2034.2 +077700 GO TO DIV-WRITE-F4-9-0. NC2034.2 +077800 DIV-DELETE-F4-9-0. NC2034.2 +077900 PERFORM DE-LETE. NC2034.2 +078000 GO TO DIV-WRITE-F4-9-0. NC2034.2 +078100 DIV-FAIL-F4-9-0. NC2034.2 +078200 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +078300 TO RE-MARK NC2034.2 +078400 PERFORM FAIL. NC2034.2 +078500 DIV-WRITE-F4-9-0. NC2034.2 +078600 PERFORM PRINT-DETAIL. NC2034.2 +078700* NC2034.2 +078800 DIV-INIT-F4-9-1. NC2034.2 +078900 MOVE "DIV-TEST-F4-9-1" TO PAR-NAME. NC2034.2 +079000 ADD 1 TO REC-CT. NC2034.2 +079100 DIV-TEST-F4-9-1. NC2034.2 +079200 IF 25ANS NOT = ZERO NC2034.2 +079300 GO TO DIV-FAIL-F4-9-1. NC2034.2 +079400 PERFORM PASS NC2034.2 +079500 GO TO DIV-WRITE-F4-9-1. NC2034.2 +079600 DIV-DELETE-F4-9-1. NC2034.2 +079700 PERFORM DE-LETE. NC2034.2 +079800 GO TO DIV-WRITE-F4-9-1. NC2034.2 +079900 DIV-FAIL-F4-9-1. NC2034.2 +080000 MOVE 25ANS TO COMPUTED-N NC2034.2 +080100 MOVE ZERO TO CORRECT-N NC2034.2 +080200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +080300 PERFORM FAIL. NC2034.2 +080400 DIV-WRITE-F4-9-1. NC2034.2 +080500 PERFORM PRINT-DETAIL. NC2034.2 +080600* NC2034.2 +080700 DIV-INIT-F4-9-2. NC2034.2 +080800 MOVE "DIV-TEST-F4-9-2" TO PAR-NAME. NC2034.2 +080900 ADD 1 TO REC-CT. NC2034.2 +081000 DIV-TEST-F4-9-2. NC2034.2 +081100 IF 25REM NOT = ZERO NC2034.2 +081200 GO TO DIV-FAIL-F4-9-2. NC2034.2 +081300 PERFORM PASS NC2034.2 +081400 GO TO DIV-WRITE-F4-9-2. NC2034.2 +081500 DIV-DELETE-F4-9-2. NC2034.2 +081600 PERFORM DE-LETE. NC2034.2 +081700 GO TO DIV-WRITE-F4-9-2. NC2034.2 +081800 DIV-FAIL-F4-9-2. NC2034.2 +081900 MOVE 25REM TO COMPUTED-N NC2034.2 +082000 MOVE ZERO TO CORRECT-N NC2034.2 +082100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +082200 PERFORM FAIL. NC2034.2 +082300 DIV-WRITE-F4-9-2. NC2034.2 +082400 PERFORM PRINT-DETAIL. NC2034.2 +082500* NC2034.2 +082600 DIV-INIT-F4-10. NC2034.2 +082700 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +082800 MOVE ZERO TO 25ANS. NC2034.2 +082900 MOVE ZERO TO 25REM. NC2034.2 +083000 MOVE 3 TO 25COUNT. NC2034.2 +083100 MOVE 1 TO REC-CT. NC2034.2 +083200 DIV-INIT-F4-10-0. NC2034.2 +083300 MOVE "DIV-TEST-F4-10-0" TO PAR-NAME. NC2034.2 +083400 DIV-TEST-F4-10-0. NC2034.2 +083500 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +083600 NOT ON SIZE ERROR NC2034.2 +083700 PERFORM PASS NC2034.2 +083800 GO TO DIV-WRITE-F4-10-0. NC2034.2 +083900 GO TO DIV-FAIL-F4-10-0. NC2034.2 +084000 DIV-DELETE-F4-10-0. NC2034.2 +084100 PERFORM DE-LETE. NC2034.2 +084200 GO TO DIV-WRITE-F4-10-0. NC2034.2 +084300 DIV-FAIL-F4-10-0. NC2034.2 +084400 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC2034.2 +084500 PERFORM FAIL. NC2034.2 +084600 DIV-WRITE-F4-10-0. NC2034.2 +084700 PERFORM PRINT-DETAIL. NC2034.2 +084800* NC2034.2 +084900 DIV-INIT-F4-10-1. NC2034.2 +085000 MOVE "DIV-TEST-F4-10-1" TO PAR-NAME. NC2034.2 +085100 ADD 1 TO REC-CT. NC2034.2 +085200 DIV-TEST-F4-10-1. NC2034.2 +085300 IF 25ANS NOT = 33 NC2034.2 +085400 GO TO DIV-FAIL-F4-10-1. NC2034.2 +085500 PERFORM PASS NC2034.2 +085600 GO TO DIV-WRITE-F4-10-1. NC2034.2 +085700 DIV-DELETE-F4-10-1. NC2034.2 +085800 PERFORM DE-LETE. NC2034.2 +085900 GO TO DIV-WRITE-F4-10-1. NC2034.2 +086000 DIV-FAIL-F4-10-1. NC2034.2 +086100 MOVE 33 TO CORRECT-N NC2034.2 +086200 MOVE 25ANS TO COMPUTED-N NC2034.2 +086300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +086400 PERFORM FAIL. NC2034.2 +086500 DIV-WRITE-F4-10-1. NC2034.2 +086600 PERFORM PRINT-DETAIL. NC2034.2 +086700* NC2034.2 +086800 DIV-INIT-F4-10-2. NC2034.2 +086900 MOVE "DIV-TEST-F4-10-2" TO PAR-NAME. NC2034.2 +087000 ADD 1 TO REC-CT. NC2034.2 +087100 DIV-TEST-F4-10-2. NC2034.2 +087200 IF 25REM NOT = 1 NC2034.2 +087300 GO TO DIV-FAIL-F4-10-2. NC2034.2 +087400 PERFORM PASS NC2034.2 +087500 GO TO DIV-WRITE-F4-10-2. NC2034.2 +087600 DIV-DELETE-F4-10-2. NC2034.2 +087700 PERFORM DE-LETE. NC2034.2 +087800 GO TO DIV-WRITE-F4-10-2. NC2034.2 +087900 DIV-FAIL-F4-10-2. NC2034.2 +088000 MOVE 25REM TO COMPUTED-N NC2034.2 +088100 MOVE 1 TO CORRECT-N NC2034.2 +088200 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +088300 PERFORM FAIL. NC2034.2 +088400 DIV-WRITE-F4-10-2. NC2034.2 +088500 PERFORM PRINT-DETAIL. NC2034.2 +088600* NC2034.2 +088700 DIV-INIT-F4-11. NC2034.2 +088800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +088900 MOVE ZERO TO 25COUNT. NC2034.2 +089000 MOVE ZERO TO 25ANS. NC2034.2 +089100 MOVE ZERO TO 25REM. NC2034.2 +089200 MOVE 1 TO REC-CT. NC2034.2 +089300 DIV-INIT-F4-11-0. NC2034.2 +089400 MOVE "DIV-TEST-F4-11-0" TO PAR-NAME. NC2034.2 +089500 DIV-TEST-F4-11-0. NC2034.2 +089600 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +089700 ON SIZE ERROR NC2034.2 +089800 PERFORM PASS NC2034.2 +089900 GO TO DIV-WRITE-F4-11-0 NC2034.2 +090000 NOT ON SIZE ERROR NC2034.2 +090100 GO TO DIV-FAIL-F4-11-0. NC2034.2 +090200 DIV-DELETE-F4-11-0. NC2034.2 +090300 PERFORM DE-LETE. NC2034.2 +090400 GO TO DIV-WRITE-F4-11-0. NC2034.2 +090500 DIV-FAIL-F4-11-0. NC2034.2 +090600 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +090700 TO RE-MARK NC2034.2 +090800 PERFORM FAIL. NC2034.2 +090900 DIV-WRITE-F4-11-0. NC2034.2 +091000 PERFORM PRINT-DETAIL. NC2034.2 +091100* NC2034.2 +091200 DIV-INIT-F4-11-1. NC2034.2 +091300 MOVE "DIV-TEST-F4-11-1" TO PAR-NAME. NC2034.2 +091400 ADD 1 TO REC-CT. NC2034.2 +091500 DIV-TEST-F4-11-1. NC2034.2 +091600 IF 25ANS NOT = ZERO NC2034.2 +091700 GO TO DIV-FAIL-F4-11-1. NC2034.2 +091800 PERFORM PASS NC2034.2 +091900 GO TO DIV-WRITE-F4-11-1. NC2034.2 +092000 DIV-DELETE-F4-11-1. NC2034.2 +092100 PERFORM DE-LETE. NC2034.2 +092200 GO TO DIV-WRITE-F4-11-1. NC2034.2 +092300 DIV-FAIL-F4-11-1. NC2034.2 +092400 MOVE 25ANS TO COMPUTED-N NC2034.2 +092500 MOVE ZERO TO CORRECT-N NC2034.2 +092600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +092700 PERFORM FAIL. NC2034.2 +092800 DIV-WRITE-F4-11-1. NC2034.2 +092900 PERFORM PRINT-DETAIL. NC2034.2 +093000* NC2034.2 +093100 DIV-INIT-F4-11-2. NC2034.2 +093200 MOVE "DIV-TEST-F4-11-2" TO PAR-NAME. NC2034.2 +093300 ADD 1 TO REC-CT. NC2034.2 +093400 DIV-TEST-F4-11-2. NC2034.2 +093500 IF 25REM NOT = ZERO NC2034.2 +093600 GO TO DIV-FAIL-F4-11-2. NC2034.2 +093700 PERFORM PASS NC2034.2 +093800 GO TO DIV-WRITE-F4-11-2. NC2034.2 +093900 DIV-DELETE-F4-11-2. NC2034.2 +094000 PERFORM DE-LETE. NC2034.2 +094100 GO TO DIV-WRITE-F4-11-2. NC2034.2 +094200 DIV-FAIL-F4-11-2. NC2034.2 +094300 MOVE 25REM TO COMPUTED-N NC2034.2 +094400 MOVE ZERO TO CORRECT-N NC2034.2 +094500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +094600 PERFORM FAIL. NC2034.2 +094700 DIV-WRITE-F4-11-2. NC2034.2 +094800 PERFORM PRINT-DETAIL. NC2034.2 +094900* NC2034.2 +095000 DIV-INIT-F4-12. NC2034.2 +095100 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +095200 MOVE ZERO TO 25ANS. NC2034.2 +095300 MOVE ZERO TO 25REM. NC2034.2 +095400 MOVE 3 TO 25COUNT. NC2034.2 +095500 MOVE 1 TO REC-CT. NC2034.2 +095600 DIV-INIT-F4-12-0. NC2034.2 +095700 MOVE "DIV-TEST-F4-12-0" TO PAR-NAME. NC2034.2 +095800 DIV-TEST-F4-12-0. NC2034.2 +095900 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +096000 ON SIZE ERROR NC2034.2 +096100 GO TO DIV-FAIL-F4-12-0 NC2034.2 +096200 NOT ON SIZE ERROR NC2034.2 +096300 PERFORM PASS NC2034.2 +096400 GO TO DIV-WRITE-F4-12-0. NC2034.2 +096500 DIV-DELETE-F4-12-0. NC2034.2 +096600 PERFORM DE-LETE. NC2034.2 +096700 GO TO DIV-WRITE-F4-12-0. NC2034.2 +096800 DIV-FAIL-F4-12-0. NC2034.2 +096900 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +097000 TO RE-MARK NC2034.2 +097100 PERFORM FAIL. NC2034.2 +097200 DIV-WRITE-F4-12-0. NC2034.2 +097300 PERFORM PRINT-DETAIL. NC2034.2 +097400* NC2034.2 +097500 DIV-INIT-F4-12-1. NC2034.2 +097600 MOVE "DIV-TEST-F4-12-1" TO PAR-NAME. NC2034.2 +097700 ADD 1 TO REC-CT. NC2034.2 +097800 DIV-TEST-F4-12-1. NC2034.2 +097900 IF 25ANS NOT = 33 NC2034.2 +098000 GO TO DIV-FAIL-F4-12-1. NC2034.2 +098100 PERFORM PASS NC2034.2 +098200 GO TO DIV-WRITE-F4-12-1. NC2034.2 +098300 DIV-DELETE-F4-12-1. NC2034.2 +098400 PERFORM DE-LETE. NC2034.2 +098500 GO TO DIV-WRITE-F4-12-1. NC2034.2 +098600 DIV-FAIL-F4-12-1. NC2034.2 +098700 MOVE 33 TO CORRECT-N NC2034.2 +098800 MOVE 25ANS TO COMPUTED-N NC2034.2 +098900 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +099000 PERFORM FAIL. NC2034.2 +099100 DIV-WRITE-F4-12-1. NC2034.2 +099200 PERFORM PRINT-DETAIL. NC2034.2 +099300* NC2034.2 +099400 DIV-INIT-F4-12-2. NC2034.2 +099500 MOVE "DIV-TEST-F4-12-2" TO PAR-NAME. NC2034.2 +099600 ADD 1 TO REC-CT. NC2034.2 +099700 DIV-TEST-F4-12-2. NC2034.2 +099800 IF 25REM NOT = 1 NC2034.2 +099900 GO TO DIV-FAIL-F4-12-2. NC2034.2 +100000 PERFORM PASS NC2034.2 +100100 GO TO DIV-WRITE-F4-12-2. NC2034.2 +100200 DIV-DELETE-F4-12-2. NC2034.2 +100300 PERFORM DE-LETE. NC2034.2 +100400 GO TO DIV-WRITE-F4-12-2. NC2034.2 +100500 DIV-FAIL-F4-12-2. NC2034.2 +100600 MOVE 25REM TO COMPUTED-N NC2034.2 +100700 MOVE 1 TO CORRECT-N NC2034.2 +100800 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +100900 PERFORM FAIL. NC2034.2 +101000 DIV-WRITE-F4-12-2. NC2034.2 +101100 PERFORM PRINT-DETAIL. NC2034.2 +101200* NC2034.2 +101300 DIV-INIT-F4-13. NC2034.2 +101400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +101500 MOVE ZERO TO 25COUNT. NC2034.2 +101600 MOVE ZERO TO 25ANS. NC2034.2 +101700 MOVE ZERO TO 25REM. NC2034.2 +101800 MOVE 1 TO REC-CT. NC2034.2 +101900 MOVE "DIV-TEST-F4-13-0" TO PAR-NAME. NC2034.2 +102000 DIV-TEST-F4-13-0. NC2034.2 +102100 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +102200 ON SIZE ERROR NC2034.2 +102300 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +102400 END-DIVIDE NC2034.2 +102500 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +102600* NC2034.2 +102700 DIV-INIT-F4-13-1. NC2034.2 +102800 MOVE "DIV-TEST-F4-13-1" TO PAR-NAME. NC2034.2 +102900 DIV-TEST-F4-13-1. NC2034.2 +103000 IF 25ANS NOT = ZERO NC2034.2 +103100 GO TO DIV-FAIL-F4-13-1. NC2034.2 +103200 PERFORM PASS NC2034.2 +103300 GO TO DIV-WRITE-F4-13-1. NC2034.2 +103400 DIV-DELETE-F4-13-1. NC2034.2 +103500 PERFORM DE-LETE. NC2034.2 +103600 GO TO DIV-WRITE-F4-13-1. NC2034.2 +103700 DIV-FAIL-F4-13-1. NC2034.2 +103800 MOVE 25ANS TO COMPUTED-N NC2034.2 +103900 MOVE ZERO TO CORRECT-N NC2034.2 +104000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +104100 PERFORM FAIL. NC2034.2 +104200 DIV-WRITE-F4-13-1. NC2034.2 +104300 PERFORM PRINT-DETAIL. NC2034.2 +104400* NC2034.2 +104500 DIV-INIT-F4-13-2. NC2034.2 +104600 MOVE "DIV-TEST-F4-13-2" TO PAR-NAME. NC2034.2 +104700 ADD 1 TO REC-CT. NC2034.2 +104800 DIV-TEST-F4-13-2. NC2034.2 +104900 IF 25REM NOT = ZERO NC2034.2 +105000 GO TO DIV-FAIL-F4-13-2. NC2034.2 +105100 PERFORM PASS NC2034.2 +105200 GO TO DIV-WRITE-F4-13-2. NC2034.2 +105300 DIV-DELETE-F4-13-2. NC2034.2 +105400 PERFORM DE-LETE. NC2034.2 +105500 GO TO DIV-WRITE-F4-13-2. NC2034.2 +105600 DIV-FAIL-F4-13-2. NC2034.2 +105700 MOVE 25REM TO COMPUTED-N NC2034.2 +105800 MOVE ZERO TO CORRECT-N NC2034.2 +105900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +106000 PERFORM FAIL. NC2034.2 +106100 DIV-WRITE-F4-13-2. NC2034.2 +106200 PERFORM PRINT-DETAIL. NC2034.2 +106300* NC2034.2 +106400 DIV-INIT-F4-13-3. NC2034.2 +106500 MOVE "DIV-TEST-F4-13-3" TO PAR-NAME. NC2034.2 +106600 ADD 1 TO REC-CT. NC2034.2 +106700 DIV-TEST-F4-13-3. NC2034.2 +106800 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +106900 GO TO DIV-FAIL-F4-13-3. NC2034.2 +107000 PERFORM PASS NC2034.2 +107100 GO TO DIV-WRITE-F4-13-3. NC2034.2 +107200 DIV-DELETE-F4-13-3. NC2034.2 +107300 PERFORM DE-LETE. NC2034.2 +107400 GO TO DIV-WRITE-F4-13-3. NC2034.2 +107500 DIV-FAIL-F4-13-3. NC2034.2 +107600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2034.2 +107700 TO RE-MARK NC2034.2 +107800 MOVE "A" TO CORRECT-A NC2034.2 +107900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +108000 PERFORM FAIL. NC2034.2 +108100 DIV-WRITE-F4-13-3. NC2034.2 +108200 PERFORM PRINT-DETAIL. NC2034.2 +108300* NC2034.2 +108400 DIV-INIT-F4-13-4. NC2034.2 +108500 MOVE "DIV-TEST-F4-13-4" TO PAR-NAME. NC2034.2 +108600 ADD 1 TO REC-CT. NC2034.2 +108700 DIV-TEST-F4-13-4. NC2034.2 +108800 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +108900 GO TO DIV-FAIL-F4-13-4. NC2034.2 +109000 PERFORM PASS NC2034.2 +109100 GO TO DIV-WRITE-F4-13-4. NC2034.2 +109200 DIV-DELETE-F4-13-4. NC2034.2 +109300 PERFORM DE-LETE. NC2034.2 +109400 GO TO DIV-WRITE-F4-13-4. NC2034.2 +109500 DIV-FAIL-F4-13-4. NC2034.2 +109600 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +109700 MOVE "B" TO CORRECT-A NC2034.2 +109800 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +109900 PERFORM FAIL. NC2034.2 +110000 DIV-WRITE-F4-13-4. NC2034.2 +110100 PERFORM PRINT-DETAIL. NC2034.2 +110200* NC2034.2 +110300 DIV-INIT-F4-14. NC2034.2 +110400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +110500 MOVE "DIV-TEST-F4-14-0" TO PAR-NAME. NC2034.2 +110600 MOVE ZERO TO 25ANS. NC2034.2 +110700 MOVE ZERO TO 25REM. NC2034.2 +110800 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +110900 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +111000 MOVE 3 TO 25COUNT. NC2034.2 +111100 MOVE 1 TO REC-CT. NC2034.2 +111200 DIV-TEST-F4-14-0. NC2034.2 +111300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +111400 ON SIZE ERROR NC2034.2 +111500 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +111600 END-DIVIDE NC2034.2 +111700 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +111800* NC2034.2 +111900 DIV-INIT-F4-14-1. NC2034.2 +112000 MOVE "DIV-TEST-F4-14-1" TO PAR-NAME. NC2034.2 +112100 DIV-TEST-F4-14-1. NC2034.2 +112200 IF 25ANS NOT = 33 NC2034.2 +112300 GO TO DIV-FAIL-F4-14-1. NC2034.2 +112400 PERFORM PASS NC2034.2 +112500 GO TO DIV-WRITE-F4-14-1. NC2034.2 +112600 DIV-DELETE-F4-14-1. NC2034.2 +112700 PERFORM DE-LETE. NC2034.2 +112800 GO TO DIV-WRITE-F4-14-1. NC2034.2 +112900 DIV-FAIL-F4-14-1. NC2034.2 +113000 MOVE 33 TO CORRECT-N NC2034.2 +113100 MOVE 25ANS TO COMPUTED-N NC2034.2 +113200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +113300 PERFORM FAIL. NC2034.2 +113400 DIV-WRITE-F4-14-1. NC2034.2 +113500 PERFORM PRINT-DETAIL. NC2034.2 +113600* NC2034.2 +113700 DIV-INIT-F4-14-2. NC2034.2 +113800 MOVE "DIV-TEST-F4-14-2" TO PAR-NAME. NC2034.2 +113900 ADD 1 TO REC-CT. NC2034.2 +114000 DIV-TEST-F4-14-2. NC2034.2 +114100 IF 25REM NOT = 1 NC2034.2 +114200 GO TO DIV-FAIL-F4-14-2. NC2034.2 +114300 PERFORM PASS NC2034.2 +114400 GO TO DIV-WRITE-F4-14-2. NC2034.2 +114500 DIV-DELETE-F4-14-2. NC2034.2 +114600 PERFORM DE-LETE. NC2034.2 +114700 GO TO DIV-WRITE-F4-14-2. NC2034.2 +114800 DIV-FAIL-F4-14-2. NC2034.2 +114900 MOVE 25REM TO COMPUTED-N NC2034.2 +115000 MOVE 1 TO CORRECT-N NC2034.2 +115100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +115200 PERFORM FAIL. NC2034.2 +115300 DIV-WRITE-F4-14-2. NC2034.2 +115400 PERFORM PRINT-DETAIL. NC2034.2 +115500* NC2034.2 +115600 DIV-INIT-F4-14-3. NC2034.2 +115700 MOVE "DIV-TEST-F4-14-3" TO PAR-NAME. NC2034.2 +115800 ADD 1 TO REC-CT. NC2034.2 +115900 DIV-TEST-F4-14-3. NC2034.2 +116000 IF WRK-XN-00001-1 NOT = SPACE NC2034.2 +116100 GO TO DIV-FAIL-F4-14-3. NC2034.2 +116200 PERFORM PASS NC2034.2 +116300 GO TO DIV-WRITE-F4-14-3. NC2034.2 +116400 DIV-DELETE-F4-14-3. NC2034.2 +116500 PERFORM DE-LETE. NC2034.2 +116600 GO TO DIV-WRITE-F4-14-3. NC2034.2 +116700 DIV-FAIL-F4-14-3. NC2034.2 +116800 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +116900 TO RE-MARK. NC2034.2 +117000 MOVE SPACE TO CORRECT-A NC2034.2 +117100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +117200 PERFORM FAIL. NC2034.2 +117300 DIV-WRITE-F4-14-3. NC2034.2 +117400 PERFORM PRINT-DETAIL. NC2034.2 +117500* NC2034.2 +117600 DIV-INIT-F4-14-4. NC2034.2 +117700 MOVE "DIV-TEST-F4-14-4" TO PAR-NAME. NC2034.2 +117800 ADD 1 TO REC-CT. NC2034.2 +117900 DIV-TEST-F4-14-4. NC2034.2 +118000 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +118100 GO TO DIV-FAIL-F4-14-4. NC2034.2 +118200 PERFORM PASS NC2034.2 +118300 GO TO DIV-WRITE-F4-14-4. NC2034.2 +118400 DIV-DELETE-F4-14-4. NC2034.2 +118500 PERFORM DE-LETE. NC2034.2 +118600 GO TO DIV-WRITE-F4-14-4. NC2034.2 +118700 DIV-FAIL-F4-14-4. NC2034.2 +118800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +118900 MOVE "B" TO CORRECT-A NC2034.2 +119000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +119100 PERFORM FAIL. NC2034.2 +119200 DIV-WRITE-F4-14-4. NC2034.2 +119300 PERFORM PRINT-DETAIL. NC2034.2 +119400* NC2034.2 +119500 DIV-INIT-F4-15. NC2034.2 +119600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2034.2 +119700 MOVE ZERO TO 25COUNT. NC2034.2 +119800 MOVE ZERO TO 25ANS. NC2034.2 +119900 MOVE ZERO TO 25REM. NC2034.2 +120000 MOVE 1 TO REC-CT. NC2034.2 +120100 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +120200 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +120300 MOVE "DIV-TEST-F4-15-0" TO PAR-NAME. NC2034.2 +120400 DIV-TEST-F4-15-0. NC2034.2 +120500 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +120600 NOT ON SIZE ERROR NC2034.2 +120700 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +120800 END-DIVIDE NC2034.2 +120900 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +121000* NC2034.2 +121100 DIV-INIT-F4-15-1. NC2034.2 +121200 MOVE "DIV-TEST-F4-15-1" TO PAR-NAME. NC2034.2 +121300 ADD 1 TO REC-CT. NC2034.2 +121400 DIV-TEST-F4-15-1. NC2034.2 +121500 IF 25ANS NOT = ZERO NC2034.2 +121600 GO TO DIV-FAIL-F4-15-1. NC2034.2 +121700 PERFORM PASS NC2034.2 +121800 GO TO DIV-WRITE-F4-15-1. NC2034.2 +121900 DIV-DELETE-F4-15-1. NC2034.2 +122000 PERFORM DE-LETE. NC2034.2 +122100 GO TO DIV-WRITE-F4-15-1. NC2034.2 +122200 DIV-FAIL-F4-15-1. NC2034.2 +122300 MOVE 25ANS TO COMPUTED-N NC2034.2 +122400 MOVE ZERO TO CORRECT-N NC2034.2 +122500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +122600 PERFORM FAIL. NC2034.2 +122700 DIV-WRITE-F4-15-1. NC2034.2 +122800 PERFORM PRINT-DETAIL. NC2034.2 +122900* NC2034.2 +123000 DIV-INIT-F4-15-2. NC2034.2 +123100 MOVE "DIV-TEST-F4-15-2" TO PAR-NAME. NC2034.2 +123200 ADD 1 TO REC-CT. NC2034.2 +123300 DIV-TEST-F4-15-2. NC2034.2 +123400 IF 25REM NOT = ZERO NC2034.2 +123500 GO TO DIV-FAIL-F4-15-2. NC2034.2 +123600 PERFORM PASS NC2034.2 +123700 GO TO DIV-WRITE-F4-15-2. NC2034.2 +123800 DIV-DELETE-F4-15-2. NC2034.2 +123900 PERFORM DE-LETE. NC2034.2 +124000 GO TO DIV-WRITE-F4-15-2. NC2034.2 +124100 DIV-FAIL-F4-15-2. NC2034.2 +124200 MOVE 25REM TO COMPUTED-N NC2034.2 +124300 MOVE ZERO TO CORRECT-N NC2034.2 +124400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +124500 PERFORM FAIL. NC2034.2 +124600 DIV-WRITE-F4-15-2. NC2034.2 +124700 PERFORM PRINT-DETAIL. NC2034.2 +124800* NC2034.2 +124900 DIV-INIT-F4-15-3. NC2034.2 +125000 MOVE "DIV-TEST-F4-15-3" TO PAR-NAME. NC2034.2 +125100 ADD 1 TO REC-CT. NC2034.2 +125200 DIV-TEST-F4-15-3. NC2034.2 +125300 IF WRK-XN-00001-1 = "A" NC2034.2 +125400 GO TO DIV-FAIL-F4-15-3. NC2034.2 +125500 PERFORM PASS NC2034.2 +125600 GO TO DIV-WRITE-F4-15-3. NC2034.2 +125700 DIV-DELETE-F4-15-3. NC2034.2 +125800 PERFORM DE-LETE. NC2034.2 +125900 GO TO DIV-WRITE-F4-15-3. NC2034.2 +126000 DIV-FAIL-F4-15-3. NC2034.2 +126100 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +126200 TO RE-MARK NC2034.2 +126300 MOVE SPACE TO CORRECT-A NC2034.2 +126400 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +126500 PERFORM FAIL. NC2034.2 +126600 DIV-WRITE-F4-15-3. NC2034.2 +126700 PERFORM PRINT-DETAIL. NC2034.2 +126800* NC2034.2 +126900 DIV-INIT-F4-15-4. NC2034.2 +127000 MOVE "DIV-TEST-F4-15-4" TO PAR-NAME. NC2034.2 +127100 ADD 1 TO REC-CT. NC2034.2 +127200 DIV-TEST-F4-15-4. NC2034.2 +127300 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +127400 GO TO DIV-FAIL-F4-15-4. NC2034.2 +127500 PERFORM PASS NC2034.2 +127600 GO TO DIV-WRITE-F4-15-4. NC2034.2 +127700 DIV-DELETE-F4-15-4. NC2034.2 +127800 PERFORM DE-LETE. NC2034.2 +127900 GO TO DIV-WRITE-F4-15-4. NC2034.2 +128000 DIV-FAIL-F4-15-4. NC2034.2 +128100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +128200 MOVE "B" TO CORRECT-A NC2034.2 +128300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +128400 PERFORM FAIL. NC2034.2 +128500 DIV-WRITE-F4-15-4. NC2034.2 +128600 PERFORM PRINT-DETAIL. NC2034.2 +128700* NC2034.2 +128800 DIV-INIT-F4-16. NC2034.2 +128900 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +129000 MOVE ZERO TO 25ANS. NC2034.2 +129100 MOVE ZERO TO 25REM. NC2034.2 +129200 MOVE 3 TO 25COUNT. NC2034.2 +129300 MOVE 1 TO REC-CT. NC2034.2 +129400 MOVE "DIV-TEST-F4-16-0" TO PAR-NAME. NC2034.2 +129500 DIV-TEST-F4-16-0. NC2034.2 +129600 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +129700 NOT ON SIZE ERROR NC2034.2 +129800 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +129900 END-DIVIDE NC2034.2 +130000 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +130100* NC2034.2 +130200 DIV-INIT-F4-16-1. NC2034.2 +130300 MOVE "DIV-TEST-F4-16-1" TO PAR-NAME. NC2034.2 +130400 DIV-TEST-F4-16-1. NC2034.2 +130500 IF 25ANS NOT = 33 NC2034.2 +130600 GO TO DIV-FAIL-F4-16-1. NC2034.2 +130700 PERFORM PASS NC2034.2 +130800 GO TO DIV-WRITE-F4-16-1. NC2034.2 +130900 DIV-DELETE-F4-16-1. NC2034.2 +131000 PERFORM DE-LETE. NC2034.2 +131100 GO TO DIV-WRITE-F4-16-1. NC2034.2 +131200 DIV-FAIL-F4-16-1. NC2034.2 +131300 MOVE 33 TO CORRECT-N NC2034.2 +131400 MOVE 25ANS TO COMPUTED-N NC2034.2 +131500 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +131600 PERFORM FAIL. NC2034.2 +131700 DIV-WRITE-F4-16-1. NC2034.2 +131800 PERFORM PRINT-DETAIL. NC2034.2 +131900* NC2034.2 +132000 DIV-INIT-F4-16-2. NC2034.2 +132100 MOVE "DIV-TEST-F4-16-2" TO PAR-NAME. NC2034.2 +132200 ADD 1 TO REC-CT. NC2034.2 +132300 DIV-TEST-F4-16-2. NC2034.2 +132400 IF 25REM NOT = 1 NC2034.2 +132500 GO TO DIV-FAIL-F4-16-2. NC2034.2 +132600 PERFORM PASS NC2034.2 +132700 GO TO DIV-WRITE-F4-16-2. NC2034.2 +132800 DIV-DELETE-F4-16-2. NC2034.2 +132900 PERFORM DE-LETE. NC2034.2 +133000 GO TO DIV-WRITE-F4-16-2. NC2034.2 +133100 DIV-FAIL-F4-16-2. NC2034.2 +133200 MOVE 25REM TO COMPUTED-N NC2034.2 +133300 MOVE 1 TO CORRECT-N NC2034.2 +133400 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +133500 PERFORM FAIL. NC2034.2 +133600 DIV-WRITE-F4-16-2. NC2034.2 +133700 PERFORM PRINT-DETAIL. NC2034.2 +133800* NC2034.2 +133900 DIV-INIT-F4-16-3. NC2034.2 +134000 MOVE "DIV-TEST-F4-16-3" TO PAR-NAME. NC2034.2 +134100 ADD 1 TO REC-CT. NC2034.2 +134200 DIV-TEST-F4-16-3. NC2034.2 +134300 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +134400 GO TO DIV-FAIL-F4-16-3. NC2034.2 +134500 PERFORM PASS NC2034.2 +134600 GO TO DIV-WRITE-F4-16-3. NC2034.2 +134700 DIV-DELETE-F4-16-3. NC2034.2 +134800 PERFORM DE-LETE. NC2034.2 +134900 GO TO DIV-WRITE-F4-16-3. NC2034.2 +135000 DIV-FAIL-F4-16-3. NC2034.2 +135100 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2034.2 +135200 TO RE-MARK NC2034.2 +135300 MOVE "A" TO CORRECT-A NC2034.2 +135400 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +135500 PERFORM FAIL. NC2034.2 +135600 DIV-WRITE-F4-16-3. NC2034.2 +135700 PERFORM PRINT-DETAIL. NC2034.2 +135800* NC2034.2 +135900 DIV-INIT-F4-16-4. NC2034.2 +136000 MOVE "DIV-TEST-F4-16-4" TO PAR-NAME. NC2034.2 +136100 ADD 1 TO REC-CT. NC2034.2 +136200 DIV-TEST-F4-16-4. NC2034.2 +136300 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +136400 GO TO DIV-FAIL-F4-16-4. NC2034.2 +136500 PERFORM PASS NC2034.2 +136600 GO TO DIV-WRITE-F4-16-4. NC2034.2 +136700 DIV-DELETE-F4-16-4. NC2034.2 +136800 PERFORM DE-LETE. NC2034.2 +136900 GO TO DIV-WRITE-F4-16-4. NC2034.2 +137000 DIV-FAIL-F4-16-4. NC2034.2 +137100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +137200 MOVE "B" TO CORRECT-A NC2034.2 +137300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +137400 PERFORM FAIL. NC2034.2 +137500 DIV-WRITE-F4-16-4. NC2034.2 +137600 PERFORM PRINT-DETAIL. NC2034.2 +137700* NC2034.2 +137800 DIV-INIT-F4-17. NC2034.2 +137900 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +138000 MOVE ZERO TO 25COUNT. NC2034.2 +138100 MOVE ZERO TO 25ANS. NC2034.2 +138200 MOVE ZERO TO 25REM. NC2034.2 +138300 MOVE 1 TO REC-CT. NC2034.2 +138400 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +138500 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +138600 MOVE "DIV-TEST-F4-17-0" TO PAR-NAME. NC2034.2 +138700 DIV-TEST-F4-17-0. NC2034.2 +138800 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +138900 ON SIZE ERROR NC2034.2 +139000 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +139100 NOT ON SIZE ERROR NC2034.2 +139200 MOVE "B" TO WRK-XN-00001-1 NC2034.2 +139300 END-DIVIDE NC2034.2 +139400 MOVE "C" TO WRK-XN-00001-2. NC2034.2 +139500* NC2034.2 +139600 DIV-INIT-F4-17-1. NC2034.2 +139700 MOVE "DIV-TEST-F4-17-1" TO PAR-NAME. NC2034.2 +139800 ADD 1 TO REC-CT. NC2034.2 +139900 DIV-TEST-F4-17-1. NC2034.2 +140000 IF 25ANS NOT = ZERO NC2034.2 +140100 GO TO DIV-FAIL-F4-17-1. NC2034.2 +140200 PERFORM PASS NC2034.2 +140300 GO TO DIV-WRITE-F4-17-1. NC2034.2 +140400 DIV-DELETE-F4-17-1. NC2034.2 +140500 PERFORM DE-LETE. NC2034.2 +140600 GO TO DIV-WRITE-F4-17-1. NC2034.2 +140700 DIV-FAIL-F4-17-1. NC2034.2 +140800 MOVE 25ANS TO COMPUTED-N NC2034.2 +140900 MOVE ZERO TO CORRECT-N NC2034.2 +141000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +141100 PERFORM FAIL. NC2034.2 +141200 DIV-WRITE-F4-17-1. NC2034.2 +141300 PERFORM PRINT-DETAIL. NC2034.2 +141400* NC2034.2 +141500 DIV-INIT-F4-17-2. NC2034.2 +141600 MOVE "DIV-TEST-F4-17-2" TO PAR-NAME. NC2034.2 +141700 ADD 1 TO REC-CT. NC2034.2 +141800 DIV-TEST-F4-17-2. NC2034.2 +141900 IF 25REM NOT = ZERO NC2034.2 +142000 GO TO DIV-FAIL-F4-17-2. NC2034.2 +142100 PERFORM PASS NC2034.2 +142200 GO TO DIV-WRITE-F4-17-2. NC2034.2 +142300 DIV-DELETE-F4-17-2. NC2034.2 +142400 PERFORM DE-LETE. NC2034.2 +142500 GO TO DIV-WRITE-F4-17-2. NC2034.2 +142600 DIV-FAIL-F4-17-2. NC2034.2 +142700 MOVE 25REM TO COMPUTED-N NC2034.2 +142800 MOVE ZERO TO CORRECT-N NC2034.2 +142900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +143000 PERFORM FAIL. NC2034.2 +143100 DIV-WRITE-F4-17-2. NC2034.2 +143200 PERFORM PRINT-DETAIL. NC2034.2 +143300* NC2034.2 +143400 DIV-INIT-F4-17-3. NC2034.2 +143500 MOVE "DIV-TEST-F4-17-3" TO PAR-NAME. NC2034.2 +143600 ADD 1 TO REC-CT. NC2034.2 +143700 DIV-TEST-F4-17-3. NC2034.2 +143800 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +143900 GO TO DIV-FAIL-F4-17-3. NC2034.2 +144000 PERFORM PASS NC2034.2 +144100 GO TO DIV-WRITE-F4-17-3. NC2034.2 +144200 DIV-DELETE-F4-17-3. NC2034.2 +144300 PERFORM DE-LETE. NC2034.2 +144400 GO TO DIV-WRITE-F4-17-3. NC2034.2 +144500 DIV-FAIL-F4-17-3. NC2034.2 +144600 MOVE "ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC2034.2 +144700 TO RE-MARK NC2034.2 +144800 MOVE "A" TO CORRECT-A NC2034.2 +144900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +145000 PERFORM FAIL. NC2034.2 +145100 DIV-WRITE-F4-17-3. NC2034.2 +145200 PERFORM PRINT-DETAIL. NC2034.2 +145300* NC2034.2 +145400 DIV-INIT-F4-17-4. NC2034.2 +145500 MOVE "DIV-TEST-F4-17-4" TO PAR-NAME. NC2034.2 +145600 ADD 1 TO REC-CT. NC2034.2 +145700 DIV-TEST-F4-17-4. NC2034.2 +145800 IF WRK-XN-00001-2 NOT = "C" NC2034.2 +145900 GO TO DIV-FAIL-F4-17-4. NC2034.2 +146000 PERFORM PASS NC2034.2 +146100 GO TO DIV-WRITE-F4-17-4. NC2034.2 +146200 DIV-DELETE-F4-17-4. NC2034.2 +146300 PERFORM DE-LETE. NC2034.2 +146400 GO TO DIV-WRITE-F4-17-4. NC2034.2 +146500 DIV-FAIL-F4-17-4. NC2034.2 +146600 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +146700 MOVE "C" TO CORRECT-A NC2034.2 +146800 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +146900 PERFORM FAIL. NC2034.2 +147000 DIV-WRITE-F4-17-4. NC2034.2 +147100 PERFORM PRINT-DETAIL. NC2034.2 +147200* NC2034.2 +147300 DIV-INIT-F4-18. NC2034.2 +147400 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +147500 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +147600 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +147700 MOVE ZERO TO 25ANS. NC2034.2 +147800 MOVE ZERO TO 25REM. NC2034.2 +147900 MOVE 3 TO 25COUNT. NC2034.2 +148000 MOVE 1 TO REC-CT. NC2034.2 +148100 MOVE "DIV-TEST-F4-18-0" TO PAR-NAME. NC2034.2 +148200 DIV-TEST-F4-18-0. NC2034.2 +148300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +148400 ON SIZE ERROR NC2034.2 +148500 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +148600 NOT ON SIZE ERROR NC2034.2 +148700 MOVE "B" TO WRK-XN-00001-1 NC2034.2 +148800 END-DIVIDE NC2034.2 +148900 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +149000* NC2034.2 +149100 DIV-INIT-F4-18-1. NC2034.2 +149200 MOVE "DIV-TEST-F4-18-1" TO PAR-NAME. NC2034.2 +149300 DIV-TEST-F4-18-1. NC2034.2 +149400 IF 25ANS NOT = 33 NC2034.2 +149500 GO TO DIV-FAIL-F4-18-1. NC2034.2 +149600 PERFORM PASS NC2034.2 +149700 GO TO DIV-WRITE-F4-18-1. NC2034.2 +149800 DIV-DELETE-F4-18-1. NC2034.2 +149900 PERFORM DE-LETE. NC2034.2 +150000 GO TO DIV-WRITE-F4-18-1. NC2034.2 +150100 DIV-FAIL-F4-18-1. NC2034.2 +150200 MOVE 33 TO CORRECT-N NC2034.2 +150300 MOVE 25ANS TO COMPUTED-N NC2034.2 +150400 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +150500 PERFORM FAIL. NC2034.2 +150600 DIV-WRITE-F4-18-1. NC2034.2 +150700 PERFORM PRINT-DETAIL. NC2034.2 +150800* NC2034.2 +150900 DIV-INIT-F4-18-2. NC2034.2 +151000 MOVE "DIV-TEST-F4-18-2" TO PAR-NAME. NC2034.2 +151100 ADD 1 TO REC-CT. NC2034.2 +151200 DIV-TEST-F4-18-2. NC2034.2 +151300 IF 25REM NOT = 1 NC2034.2 +151400 GO TO DIV-FAIL-F4-18-2. NC2034.2 +151500 PERFORM PASS NC2034.2 +151600 GO TO DIV-WRITE-F4-18-2. NC2034.2 +151700 DIV-DELETE-F4-18-2. NC2034.2 +151800 PERFORM DE-LETE. NC2034.2 +151900 GO TO DIV-WRITE-F4-18-2. NC2034.2 +152000 DIV-FAIL-F4-18-2. NC2034.2 +152100 MOVE 25REM TO COMPUTED-N NC2034.2 +152200 MOVE 1 TO CORRECT-N NC2034.2 +152300 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +152400 PERFORM FAIL. NC2034.2 +152500 DIV-WRITE-F4-18-2. NC2034.2 +152600 PERFORM PRINT-DETAIL. NC2034.2 +152700* NC2034.2 +152800 DIV-INIT-F4-18-3. NC2034.2 +152900 MOVE "DIV-TEST-F4-18-3" TO PAR-NAME. NC2034.2 +153000 ADD 1 TO REC-CT. NC2034.2 +153100 DIV-TEST-F4-18-3. NC2034.2 +153200 IF WRK-XN-00001-1 NOT = "B" NC2034.2 +153300 GO TO DIV-FAIL-F4-18-3. NC2034.2 +153400 PERFORM PASS NC2034.2 +153500 GO TO DIV-WRITE-F4-18-3. NC2034.2 +153600 DIV-DELETE-F4-18-3. NC2034.2 +153700 PERFORM DE-LETE. NC2034.2 +153800 GO TO DIV-WRITE-F4-18-3. NC2034.2 +153900 DIV-FAIL-F4-18-3. NC2034.2 +154000 MOVE "ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC2034.2 +154100 TO RE-MARK NC2034.2 +154200 MOVE "B" TO CORRECT-A NC2034.2 +154300 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +154400 PERFORM FAIL. NC2034.2 +154500 DIV-WRITE-F4-18-3. NC2034.2 +154600 PERFORM PRINT-DETAIL. NC2034.2 +154700* NC2034.2 +154800 DIV-INIT-F4-18-4. NC2034.2 +154900 MOVE "DIV-TEST-F4-18-4" TO PAR-NAME. NC2034.2 +155000 ADD 1 TO REC-CT. NC2034.2 +155100 DIV-TEST-F4-18-4. NC2034.2 +155200 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +155300 GO TO DIV-FAIL-F4-18-4. NC2034.2 +155400 PERFORM PASS NC2034.2 +155500 GO TO DIV-WRITE-F4-18-4. NC2034.2 +155600 DIV-DELETE-F4-18-4. NC2034.2 +155700 PERFORM DE-LETE. NC2034.2 +155800 GO TO DIV-WRITE-F4-18-4. NC2034.2 +155900 DIV-FAIL-F4-18-4. NC2034.2 +156000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +156100 MOVE "B" TO CORRECT-A NC2034.2 +156200 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +156300 PERFORM FAIL. NC2034.2 +156400 DIV-WRITE-F4-18-4. NC2034.2 +156500 PERFORM PRINT-DETAIL. NC2034.2 +156600* NC2034.2 +156700 DIV-INIT-F4-19. NC2034.2 +156800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +156900 MOVE ZERO TO 25ANS. NC2034.2 +157000 MOVE ZERO TO 25REM. NC2034.2 +157100 MOVE ZERO TO WS-REMAINDERS. NC2034.2 +157200 MOVE 6 TO 25COUNT. NC2034.2 +157300 MOVE 1 TO REC-CT. NC2034.2 +157400 MOVE "DIV-TEST-F4-19-0" TO PAR-NAME. NC2034.2 +157500 DIV-TEST-F4-19-0. NC2034.2 +157600 DIVIDE 25COUNT INTO 100 GIVING 25ANS NC2034.2 +157700 REMAINDER WS-REM (25ANS) NC2034.2 +157800 ON SIZE ERROR NC2034.2 +157900 GO TO DIV-FAIL-F4-19-0. NC2034.2 +158000 PERFORM PASS. NC2034.2 +158100 GO TO DIV-WRITE-F4-19-0. NC2034.2 +158200 DIV-DELETE-F4-19-0. NC2034.2 +158300 PERFORM DE-LETE. NC2034.2 +158400 GO TO DIV-WRITE-F4-19-0. NC2034.2 +158500 DIV-FAIL-F4-19-0. NC2034.2 +158600 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +158700 TO RE-MARK NC2034.2 +158800 PERFORM FAIL. NC2034.2 +158900 DIV-WRITE-F4-19-0. NC2034.2 +159000 PERFORM PRINT-DETAIL. NC2034.2 +159100* NC2034.2 +159200 DIV-INIT-F4-19-1. NC2034.2 +159300 MOVE "DIV-TEST-F4-19-1" TO PAR-NAME. NC2034.2 +159400 ADD 1 TO REC-CT. NC2034.2 +159500 DIV-TEST-F4-19-1. NC2034.2 +159600 IF 25ANS NOT = 16 NC2034.2 +159700 GO TO DIV-FAIL-F4-19-1. NC2034.2 +159800 PERFORM PASS NC2034.2 +159900 GO TO DIV-WRITE-F4-19-1. NC2034.2 +160000 DIV-DELETE-F4-19-1. NC2034.2 +160100 PERFORM DE-LETE. NC2034.2 +160200 GO TO DIV-WRITE-F4-19-1. NC2034.2 +160300 DIV-FAIL-F4-19-1. NC2034.2 +160400 MOVE 16 TO CORRECT-N NC2034.2 +160500 MOVE 25ANS TO COMPUTED-N NC2034.2 +160600 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +160700 PERFORM FAIL. NC2034.2 +160800 DIV-WRITE-F4-19-1. NC2034.2 +160900 PERFORM PRINT-DETAIL. NC2034.2 +161000* NC2034.2 +161100 DIV-INIT-F4-19-2. NC2034.2 +161200 MOVE "DIV-TEST-F4-19-2" TO PAR-NAME. NC2034.2 +161300 ADD 1 TO REC-CT. NC2034.2 +161400 DIV-TEST-F4-19-2. NC2034.2 +161500 IF WS-REM (25ANS) NOT = 4 NC2034.2 +161600 GO TO DIV-FAIL-F4-19-2. NC2034.2 +161700 PERFORM PASS NC2034.2 +161800 GO TO DIV-WRITE-F4-19-2. NC2034.2 +161900 DIV-DELETE-F4-19-2. NC2034.2 +162000 PERFORM DE-LETE. NC2034.2 +162100 GO TO DIV-WRITE-F4-19-2. NC2034.2 +162200 DIV-FAIL-F4-19-2. NC2034.2 +162300 MOVE WS-REM (25ANS) TO COMPUTED-N NC2034.2 +162400 MOVE 4 TO CORRECT-N NC2034.2 +162500 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +162600 PERFORM FAIL NC2034.2 +162700 PERFORM PRINT-DETAIL NC2034.2 +162800 ADD 1 TO REC-CT NC2034.2 +162900 MOVE 25ANS TO COMPUTED-N NC2034.2 +163000 MOVE 16 TO CORRECT-N NC2034.2 +163100 MOVE "INVALID SUBSCRIPT FOR REMAINDER" TO RE-MARK NC2034.2 +163200 PERFORM FAIL. NC2034.2 +163300 DIV-WRITE-F4-19-2. NC2034.2 +163400 PERFORM PRINT-DETAIL. NC2034.2 +163500* NC2034.2 +163600 DIV-INIT-F4-20. NC2034.2 +163700 MOVE "DIV-TEST-F4-20" TO PAR-NAME. NC2034.2 +163800 MOVE 10.0 TO WRK-DU-2V1-1. NC2034.2 +163900 MOVE 3.14159265358979323 TO WRK-DU-1V17-1. NC2034.2 +164000 MOVE ZERO TO REC-CT. NC2034.2 +164100 DIV-TEST-F4-20. NC2034.2 +164200 DIVIDE WRK-DU-2V1-1 INTO WRK-DU-1V17-1 GIVING WRK-DU-1V5-1 NC2034.2 +164300 ROUNDED REMAINDER WRK-NE-1 NC2034.2 +164400 ON SIZE ERROR GO TO DIV-FAIL-F4-20. NC2034.2 +164500 GO TO DIV-TEST-F4-20-1. NC2034.2 +164600 DIV-DELETE-F4-20. NC2034.2 +164700 PERFORM DE-LETE. NC2034.2 +164800 PERFORM PRINT-DETAIL. NC2034.2 +164900 GO TO CCVS-EXIT. NC2034.2 +165000 DIV-FAIL-F4-20. NC2034.2 +165100 PERFORM FAIL. NC2034.2 +165200 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC2034.2 +165300 PERFORM PRINT-DETAIL. NC2034.2 +165400* NC2034.2 +165500 DIV-TEST-F4-20-1. NC2034.2 +165600 MOVE "DIV-TEST-F4-20-1" TO PAR-NAME. NC2034.2 +165700 MOVE 1 TO REC-CT. NC2034.2 +165800 IF WRK-DU-1V5-1 = 0.31416 NC2034.2 +165900 PERFORM PASS NC2034.2 +166000 GO TO DIV-WRITE-F4-20-1 NC2034.2 +166100 ELSE NC2034.2 +166200 GO TO DIV-FAIL-F4-20-1. NC2034.2 +166300 DIV-DELETE-F4-20-1. NC2034.2 +166400 PERFORM DE-LETE. NC2034.2 +166500 GO TO DIV-WRITE-F4-20-1. NC2034.2 +166600 DIV-FAIL-F4-20-1. NC2034.2 +166700 PERFORM FAIL NC2034.2 +166800 MOVE WRK-DU-1V5-1 TO COMPUTED-N NC2034.2 +166900 MOVE 0.31416 TO CORRECT-N. NC2034.2 +167000 DIV-WRITE-F4-20-1. NC2034.2 +167100 PERFORM PRINT-DETAIL. NC2034.2 +167200* NC2034.2 +167300 DIV-TEST-F4-20-2. NC2034.2 +167400 ADD 1 TO REC-CT. NC2034.2 +167500 MOVE "DIV-TEST-F4-20-2" TO PAR-NAME. NC2034.2 +167600 IF WRK-NE-1 = ".0000/92653,58979,32" NC2034.2 +167700 PERFORM PASS NC2034.2 +167800 GO TO DIV-WRITE-F4-20-2 NC2034.2 +167900 ELSE NC2034.2 +168000 GO TO DIV-FAIL-F4-20-2. NC2034.2 +168100 DIV-DELETE-F4-20-2. NC2034.2 +168200 PERFORM DE-LETE. NC2034.2 +168300 GO TO DIV-WRITE-F4-20-2. NC2034.2 +168400 DIV-FAIL-F4-20-2. NC2034.2 +168500 PERFORM FAIL NC2034.2 +168600 MOVE WRK-NE-1 TO COMPUTED-A NC2034.2 +168700 MOVE ".0000/92653,58979,32" TO CORRECT-A. NC2034.2 +168800 DIV-WRITE-F4-20-2. NC2034.2 +168900 PERFORM PRINT-DETAIL. NC2034.2 +169000* NC2034.2 +169100 CCVS-EXIT SECTION. NC2034.2 +169200 CCVS-999999. NC2034.2 +169300 GO TO CLOSE-FILES. NC2034.2 +*END-OF,NC203A +*HEADER,COBOL,NC204M +000100 IDENTIFICATION DIVISION. NC2044.2 +000200 PROGRAM-ID. NC2044.2 +000300 NC204M. NC2044.2 +000400**************************************************************** NC2044.2 +000500* * NC2044.2 +000600* VALIDATION FOR:- * NC2044.2 +000700* * NC2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +000900* * NC2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2044.2 +001100* * NC2044.2 +001200**************************************************************** NC2044.2 +001300* * NC2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2044.2 +001500* * NC2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2044.2 +001900* * NC2044.2 +002000**************************************************************** NC2044.2 +002100* * NC2044.2 +002200* PROGRAM NC204M TESTS FORMAT 1 OF THE ACCEPT STATEMENT AND * NC2044.2 +002300* THE GENERAL FORMAT OF THE DISPLAY STATEMENT. * NC2044.2 +002400* * NC2044.2 +002500* X CARDS USED ARE:- * NC2044.2 +002600* * NC2044.2 +002700* X-55 - SYSTEM PRINTER NAME. * NC2044.2 +002800* X-56 - DISPLAY MNEMONIC NAME. * NC2044.2 +002900* X-57 - ACCEPT MNEMONIC NAME. * NC2044.2 +003000* X-82 - SOURCE COMPUTER NAME. * NC2044.2 +003100* X-83 - OBJECT COMPUTER NAME. * NC2044.2 +003200* * NC2044.2 +003300**************************************************************** NC2044.2 +003400 ENVIRONMENT DIVISION. NC2044.2 +003500 CONFIGURATION SECTION. NC2044.2 +003600 SOURCE-COMPUTER. NC2044.2 +003700 XXXXX082. NC2044.2 +003800 OBJECT-COMPUTER. NC2044.2 +003900 XXXXX083. NC2044.2 +004000 SPECIAL-NAMES. NC2044.2 +004100 XXXXX057 NC2044.2 +004200 IS ACCEPT-INPUT-DEVICE NC2044.2 +004300 XXXXX056 NC2044.2 +004400 IS DISPLAY-OUTPUT-DEVICE. NC2044.2 +004500 INPUT-OUTPUT SECTION. NC2044.2 +004600 FILE-CONTROL. NC2044.2 +004700 SELECT PRINT-FILE ASSIGN TO NC2044.2 +004800 XXXXX055. NC2044.2 +004900 DATA DIVISION. NC2044.2 +005000 FILE SECTION. NC2044.2 +005100 FD PRINT-FILE. NC2044.2 +005200 01 PRINT-REC PICTURE X(120). NC2044.2 +005300 01 DUMMY-RECORD PICTURE X(120). NC2044.2 +005400 WORKING-STORAGE SECTION. NC2044.2 +005500 77 SUB PICTURE 9 USAGE COMPUTATIONAL VALUE 5. NC2044.2 +005600 01 ACCEPT-DATA. NC2044.2 +005700 02 ACCEPT-D1. NC2044.2 +005800 03 ACCEPT-D1-A PICTURE X(20). NC2044.2 +005900 03 ACCEPT-D1-B PICTURE X(7). NC2044.2 +006000 02 ACCEPT-D2 PICTURE X(27) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY ZNC2044.2 +006100- "". NC2044.2 +006200 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. NC2044.2 +006300 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. NC2044.2 +006400 02 ACCEPT-D5 PICTURE X(11) . NC2044.2 +006500 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/l, =". NC2044.2 +006600 02 ACCEPT-D7 PICTURE X. NC2044.2 +006700 02 ACCEPT-D8 PICTURE X VALUE "9". NC2044.2 +006800 02 ACCEPT-D9 PICTURE X. NC2044.2 +006900 02 ACCEPT-D10 PICTURE X VALUE "0". NC2044.2 +007000 02 ACCEPT-D11 PICTURE A(20). NC2044.2 +007100 02 ACCEPT-D12 PICTURE A(20) NC2044.2 +007200 VALUE " ABC XYZ ". NC2044.2 +007300 02 ACCEPT-D13 PICTURE X(200). NC2044.2 +007400 02 ACCEPT-D15 PICTURE XX. NC2044.2 +007500 02 ACCEPT-D16 PICTURE XX VALUE " 9". NC2044.2 +007600 02 ACCEPT-D17. NC2044.2 +007700 03 QUAL-ACCEPT PICTURE X. NC2044.2 +007800 02 ACCEPT-D18 PICTURE X VALUE QUOTE. NC2044.2 +007900 02 ACCEPT-D19. NC2044.2 +008000 03 QUAL-ACCEPT PICTURE X. NC2044.2 +008100 02 ACCEPT-D20 PICTURE X VALUE "Q". NC2044.2 +008200 02 ACCEPT-VALUE21 PICTURE X(12) VALUE "............". NC2044.2 +008300 02 ACCEPT-D21 REDEFINES ACCEPT-VALUE21. NC2044.2 +008400 03 TAB-ACCEPT OCCURS 3 TIMES. NC2044.2 +008500 04 TAB-A PICTURE XXXX. NC2044.2 +008600 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". NC2044.2 +008700 02 ACCEPT-D23. NC2044.2 +008800 03 TAB-A PICTURE XXXX OCCURS 5 TIMES. NC2044.2 +008900 02 ACCEPT-D24 PICTURE X(20) VALUE "----------------ABCD". NC2044.2 +009000 02 ACCEPT-TEST-14-DATA PIC X(15). NC2044.2 +009100 02 FILLER REDEFINES ACCEPT-TEST-14-DATA. NC2044.2 +009200 03 ACC-14-CHARS-1-10 PIC X(10). NC2044.2 +009300 02 FILLER REDEFINES ACCEPT-TEST-14-DATA. NC2044.2 +009400 03 ACC-14-CHARS-11-15 PIC X(5). NC2044.2 +009500 NC2044.2 +009600 01 GRP-CONSTANTS. NC2044.2 +009700 04 GRP-ALPHABETIC. NC2044.2 +009800 05 ALPHABET-AN-00026 PICTURE A(26) NC2044.2 +009900 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2044.2 +010000 04 GRP-NUMERIC. NC2044.2 +010100 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789.NC2044.2 +010200 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2044.2 +010300 PICTURE 9(6)V9999. NC2044.2 +010400 04 GRP-ALPHANUMERIC. NC2044.2 +010500 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2044.2 +010600 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-<>=l,;.()/* 0123456789". NC2044.2 +010700 05 FILLER PICTURE X VALUE QUOTE. NC2044.2 +010800 01 ACCEPT-RESULTS. NC2044.2 +010900 02 FILLER PICTURE X(80) VALUE NC2044.2 +011000 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC2044.2 +011100- "789 ". NC2044.2 +011200 01 80X-CHARACTER-FIELD. NC2044.2 +011300 02 FILLER PICTURE X(80). NC2044.2 +011400 01 DISPLAY-DATA. NC2044.2 +011500 02 DISPLAY-A. NC2044.2 +011600 03 DISPLAY-A1 PICTURE A VALUE "A". NC2044.2 +011700 03 DISPLAY-A2. NC2044.2 +011800 04 DISPLAY-A2A PICTURE A VALUE "L". NC2044.2 +011900 04 DISPLAY-A3. NC2044.2 +012000 05 DISPLAY-A3A PICTURE A VALUE "P". NC2044.2 +012100 05 DISPLAY-A4. NC2044.2 +012200 06 DISPLAY-A4A PICTURE A VALUE "H". NC2044.2 +012300 06 DISPLAY-A5. NC2044.2 +012400 07 DISPLAY-A5A PICTURE A VALUE "A". NC2044.2 +012500 07 DISPLAY-A6. NC2044.2 +012600 08 DISPLAY-A6A PICTURE A VALUE "B". NC2044.2 +012700 08 DISPLAY-A7. NC2044.2 +012800 09 DISPLAY-A7A PICTURE A VALUE "E". NC2044.2 +012900 09 DISPLAY-A8. NC2044.2 +013000 10 DISPLAY-A8A PICTURE AAA VALUE "TIC". NC2044.2 +013100 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. NC2044.2 +013200 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". NC2044.2 +013300 02 DISPLAY-B PICTURE X(13). NC2044.2 +013400 02 DISPLAY-C REDEFINES DISPLAY-B. NC2044.2 +013500 03 DISPLAY-D PICTURE X(8). NC2044.2 +013600 03 DISPLAY-E PICTURE X(5). NC2044.2 +013700 02 DISPLAY-F. NC2044.2 +013800 03 DISPLAY-G PICTURE X(100) VALUE IS "D001*002*003*004*005*00NC2044.2 +013900- "6*007*008*009*010*011*012*013*014*015*016*017*018*019*020D02NC2044.2 +014000- "1*022*023*024*025". NC2044.2 +014100 03 DISPLAY-H PICTURE IS X(100) VALUE IS "*026*027*028*029*030NC2044.2 +014200- "*031*032*033*034*035*036*037*038*039*040D041*042*043*044*045NC2044.2 +014300- "*046*047*048*049*050". NC2044.2 +014400 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". NC2044.2 +014500 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". NC2044.2 +014600 02 CORRECT-FOLLOWS PICTURE X(20) NC2044.2 +014700 VALUE "CORRECT DATA FOLLOWS". NC2044.2 +014800 02 END-CORRECT PICTURE X(16) VALUE "END CORRECT DATA". NC2044.2 +014900 02 DISPLAY-WRITER. NC2044.2 +015000 03 DIS-PLAYER PICTURE X(119). NC2044.2 +015100 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. NC2044.2 +015200 02 ZERO-SPACE-QUOTE. NC2044.2 +015300 03 FILLER PICTURE X VALUE "0". NC2044.2 +015400 03 FILLER PICTURE X VALUE SPACE. NC2044.2 +015500 03 FILLER PICTURE X VALUE QUOTE. NC2044.2 +015600 02 QUAL-TAB-VALUE PICTURE X(21) NC2044.2 +015700 VALUE "ABCDEFGHIJKLMNOPQRSTU". NC2044.2 +015800 02 NO-QUAL-TAB-RECORD REDEFINES QUAL-TAB-VALUE. NC2044.2 +015900 03 X1 PICTURE X. NC2044.2 +016000 03 X2 PICTURE X. NC2044.2 +016100 03 X3 PICTURE X. NC2044.2 +016200 03 X4 PICTURE X. NC2044.2 +016300 03 X5 PICTURE X. NC2044.2 +016400 03 X6 PICTURE X. NC2044.2 +016500 03 X7 PICTURE X. NC2044.2 +016600 03 X8 PICTURE X. NC2044.2 +016700 03 X9 PICTURE X. NC2044.2 +016800 03 X10 PICTURE X. NC2044.2 +016900 03 X11 PICTURE X. NC2044.2 +017000 03 X12 PICTURE X. NC2044.2 +017100 03 X13 PICTURE X. NC2044.2 +017200 03 X14 PICTURE X. NC2044.2 +017300 03 X15 PICTURE X. NC2044.2 +017400 03 X16 PICTURE X. NC2044.2 +017500 03 X17 PICTURE X. NC2044.2 +017600 03 X18 PICTURE X. NC2044.2 +017700 03 X19 PICTURE X. NC2044.2 +017800 03 X20 PICTURE X. NC2044.2 +017900 03 X21 PICTURE X. NC2044.2 +018000 02 QUAL-TAB-RECORD REDEFINES QUAL-TAB-VALUE. NC2044.2 +018100 03 XTAB PICTURE X OCCURS 9 TIMES. NC2044.2 +018200 03 GRP-1. NC2044.2 +018300 04 ELEM-1 PICTURE X. NC2044.2 +018400 04 ELEM-2 PICTURE X. NC2044.2 +018500 04 ELEM-3 PICTURE X. NC2044.2 +018600 04 SUB-TAB PICTURE X OCCURS 3 TIMES. NC2044.2 +018700 03 GRP-2. NC2044.2 +018800 04 ELEM-1 PICTURE X. NC2044.2 +018900 04 ELEM-2 PICTURE X. NC2044.2 +019000 04 ELEM-3 PICTURE X. NC2044.2 +019100 04 SUB-TAB PICTURE X OCCURS 3 TIMES. NC2044.2 +019200 02 DISPLAY-MIXTURE. NC2044.2 +019300 03 FILLER PICTURE X(6) VALUE "QUOTE ". NC2044.2 +019400 03 FILLER PICTURE X VALUE QUOTE. NC2044.2 +019500 03 FILLER PICTURE X(36) VALUE NC2044.2 +019600 " ASTERISK * NUMERIC LITERALS 21 1325". NC2044.2 +019700 03 I-DATA PICTURE X(17) NC2044.2 +019800 VALUE " IDENTIFIER DATA ". NC2044.2 +019900 03 TA-VALUE PICTURE X(20) NC2044.2 +020000 VALUE "A B C D E 1 2 3 4 5 ". NC2044.2 +020100 03 TA-BLE REDEFINES TA-VALUE. NC2044.2 +020200 04 ROW OCCURS 2 TIMES. NC2044.2 +020300 05 PIECE PICTURE XX OCCURS 5 TIMES. NC2044.2 +020400 03 TRUE-PAIR. NC2044.2 +020500 04 A1 PICTURE X(20) NC2044.2 +020600 VALUE "(TOTAL 21 OPERANDS) ".NC2044.2 +020700 04 A2 PICTURE X(11) NC2044.2 +020800 VALUE "END OF DATA". NC2044.2 +020900 02 FALSE-PAIR. NC2044.2 +021000 04 A1 PICTURE X(20) NC2044.2 +021100 VALUE "(SOME BAD OPERANDS) ".NC2044.2 +021200 04 A2 PICTURE X(11) NC2044.2 +021300 VALUE "ERROR DATA". NC2044.2 +021400 01 CHARACTER-BREAKDOWN-S. NC2044.2 +021500 02 FIRST-20S PICTURE X(20). NC2044.2 +021600 02 SECOND-20S PICTURE X(20). NC2044.2 +021700 02 THIRD-20S PICTURE X(20). NC2044.2 +021800 02 FOURTH-20S PICTURE X(20). NC2044.2 +021900 02 FIFTH-20S PICTURE X(20). NC2044.2 +022000 02 SIXTH-20S PICTURE X(20). NC2044.2 +022100 02 SEVENTH-20S PICTURE X(20). NC2044.2 +022200 02 EIGHTH-20S PICTURE X(20). NC2044.2 +022300 02 NINTH-20S PICTURE X(20). NC2044.2 +022400 02 TENTH-20S PICTURE X(20). NC2044.2 +022500 01 CHARACTER-BREAKDOWN-R. NC2044.2 +022600 02 FIRST-20R PICTURE X(20). NC2044.2 +022700 02 SECOND-20R PICTURE X(20). NC2044.2 +022800 02 THIRD-20R PICTURE X(20). NC2044.2 +022900 02 FOURTH-20R PICTURE X(20). NC2044.2 +023000 02 FIFTH-20R PICTURE X(20). NC2044.2 +023100 02 SIXTH-20R PICTURE X(20). NC2044.2 +023200 02 SEVENTH-20R PICTURE X(20). NC2044.2 +023300 02 EIGHTH-20R PICTURE X(20). NC2044.2 +023400 02 NINTH-20R PICTURE X(20). NC2044.2 +023500 02 TENTH-20R PICTURE X(20). NC2044.2 +023600 01 TEST-RESULTS. NC2044.2 +023700 02 FILLER PIC X VALUE SPACE. NC2044.2 +023800 02 FEATURE PIC X(20) VALUE SPACE. NC2044.2 +023900 02 FILLER PIC X VALUE SPACE. NC2044.2 +024000 02 P-OR-F PIC X(5) VALUE SPACE. NC2044.2 +024100 02 FILLER PIC X VALUE SPACE. NC2044.2 +024200 02 PAR-NAME. NC2044.2 +024300 03 FILLER PIC X(19) VALUE SPACE. NC2044.2 +024400 03 PARDOT-X PIC X VALUE SPACE. NC2044.2 +024500 03 DOTVALUE PIC 99 VALUE ZERO. NC2044.2 +024600 02 FILLER PIC X(8) VALUE SPACE. NC2044.2 +024700 02 RE-MARK PIC X(61). NC2044.2 +024800 01 TEST-COMPUTED. NC2044.2 +024900 02 FILLER PIC X(30) VALUE SPACE. NC2044.2 +025000 02 FILLER PIC X(17) VALUE NC2044.2 +025100 " COMPUTED=". NC2044.2 +025200 02 COMPUTED-X. NC2044.2 +025300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2044.2 +025400 03 COMPUTED-N REDEFINES COMPUTED-A NC2044.2 +025500 PIC -9(9).9(9). NC2044.2 +025600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2044.2 +025700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2044.2 +025800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2044.2 +025900 03 CM-18V0 REDEFINES COMPUTED-A. NC2044.2 +026000 04 COMPUTED-18V0 PIC -9(18). NC2044.2 +026100 04 FILLER PIC X. NC2044.2 +026200 03 FILLER PIC X(50) VALUE SPACE. NC2044.2 +026300 01 TEST-CORRECT. NC2044.2 +026400 02 FILLER PIC X(30) VALUE SPACE. NC2044.2 +026500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2044.2 +026600 02 CORRECT-X. NC2044.2 +026700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2044.2 +026800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2044.2 +026900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2044.2 +027000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2044.2 +027100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2044.2 +027200 03 CR-18V0 REDEFINES CORRECT-A. NC2044.2 +027300 04 CORRECT-18V0 PIC -9(18). NC2044.2 +027400 04 FILLER PIC X. NC2044.2 +027500 03 FILLER PIC X(2) VALUE SPACE. NC2044.2 +027600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2044.2 +027700 01 CCVS-C-1. NC2044.2 +027800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2044.2 +027900- "SS PARAGRAPH-NAME NC2044.2 +028000- " REMARKS". NC2044.2 +028100 02 FILLER PIC X(20) VALUE SPACE. NC2044.2 +028200 01 CCVS-C-2. NC2044.2 +028300 02 FILLER PIC X VALUE SPACE. NC2044.2 +028400 02 FILLER PIC X(6) VALUE "TESTED". NC2044.2 +028500 02 FILLER PIC X(15) VALUE SPACE. NC2044.2 +028600 02 FILLER PIC X(4) VALUE "FAIL". NC2044.2 +028700 02 FILLER PIC X(94) VALUE SPACE. NC2044.2 +028800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2044.2 +028900 01 REC-CT PIC 99 VALUE ZERO. NC2044.2 +029000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2044.2 +029500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2044.2 +029600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2044.2 +029700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2044.2 +029800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2044.2 +029900 01 CCVS-H-1. NC2044.2 +030000 02 FILLER PIC X(39) VALUE SPACES. NC2044.2 +030100 02 FILLER PIC X(42) VALUE NC2044.2 +030200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2044.2 +030300 02 FILLER PIC X(39) VALUE SPACES. NC2044.2 +030400 01 CCVS-H-2A. NC2044.2 +030500 02 FILLER PIC X(40) VALUE SPACE. NC2044.2 +030600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2044.2 +030700 02 FILLER PIC XXXX VALUE NC2044.2 +030800 "4.2 ". NC2044.2 +030900 02 FILLER PIC X(28) VALUE NC2044.2 +031000 " COPY - NOT FOR DISTRIBUTION". NC2044.2 +031100 02 FILLER PIC X(41) VALUE SPACE. NC2044.2 +031200 NC2044.2 +031300 01 CCVS-H-2B. NC2044.2 +031400 02 FILLER PIC X(15) VALUE NC2044.2 +031500 "TEST RESULT OF ". NC2044.2 +031600 02 TEST-ID PIC X(9). NC2044.2 +031700 02 FILLER PIC X(4) VALUE NC2044.2 +031800 " IN ". NC2044.2 +031900 02 FILLER PIC X(12) VALUE NC2044.2 +032000 " HIGH ". NC2044.2 +032100 02 FILLER PIC X(22) VALUE NC2044.2 +032200 " LEVEL VALIDATION FOR ". NC2044.2 +032300 02 FILLER PIC X(58) VALUE NC2044.2 +032400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +032500 01 CCVS-H-3. NC2044.2 +032600 02 FILLER PIC X(34) VALUE NC2044.2 +032700 " FOR OFFICIAL USE ONLY ". NC2044.2 +032800 02 FILLER PIC X(58) VALUE NC2044.2 +032900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2044.2 +033000 02 FILLER PIC X(28) VALUE NC2044.2 +033100 " COPYRIGHT 1985 ". NC2044.2 +033200 01 CCVS-E-1. NC2044.2 +033300 02 FILLER PIC X(52) VALUE SPACE. NC2044.2 +033400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2044.2 +033500 02 ID-AGAIN PIC X(9). NC2044.2 +033600 02 FILLER PIC X(45) VALUE SPACES. NC2044.2 +033700 01 CCVS-E-2. NC2044.2 +033800 02 FILLER PIC X(31) VALUE SPACE. NC2044.2 +033900 02 FILLER PIC X(21) VALUE SPACE. NC2044.2 +034000 02 CCVS-E-2-2. NC2044.2 +034100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2044.2 +034200 03 FILLER PIC X VALUE SPACE. NC2044.2 +034300 03 ENDER-DESC PIC X(44) VALUE NC2044.2 +034400 "ERRORS ENCOUNTERED". NC2044.2 +034500 01 CCVS-E-3. NC2044.2 +034600 02 FILLER PIC X(22) VALUE NC2044.2 +034700 " FOR OFFICIAL USE ONLY". NC2044.2 +034800 02 FILLER PIC X(12) VALUE SPACE. NC2044.2 +034900 02 FILLER PIC X(58) VALUE NC2044.2 +035000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +035100 02 FILLER PIC X(13) VALUE SPACE. NC2044.2 +035200 02 FILLER PIC X(15) VALUE NC2044.2 +035300 " COPYRIGHT 1985". NC2044.2 +035400 01 CCVS-E-4. NC2044.2 +035500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2044.2 +035600 02 FILLER PIC X(4) VALUE " OF ". NC2044.2 +035700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2044.2 +035800 02 FILLER PIC X(40) VALUE NC2044.2 +035900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2044.2 +036000 01 XXINFO. NC2044.2 +036100 02 FILLER PIC X(19) VALUE NC2044.2 +036200 "*** INFORMATION ***". NC2044.2 +036300 02 INFO-TEXT. NC2044.2 +036400 04 FILLER PIC X(8) VALUE SPACE. NC2044.2 +036500 04 XXCOMPUTED PIC X(20). NC2044.2 +036600 04 FILLER PIC X(5) VALUE SPACE. NC2044.2 +036700 04 XXCORRECT PIC X(20). NC2044.2 +036800 02 INF-ANSI-REFERENCE PIC X(48). NC2044.2 +036900 01 HYPHEN-LINE. NC2044.2 +037000 02 FILLER PIC IS X VALUE IS SPACE. NC2044.2 +037100 02 FILLER PIC IS X(65) VALUE IS "************************NC2044.2 +037200- "*****************************************". NC2044.2 +037300 02 FILLER PIC IS X(54) VALUE IS "************************NC2044.2 +037400- "******************************". NC2044.2 +037500 01 CCVS-PGM-ID PIC X(9) VALUE NC2044.2 +037600 "NC204M". NC2044.2 +037700 PROCEDURE DIVISION. NC2044.2 +037800 CCVS1 SECTION. NC2044.2 +037900 OPEN-FILES. NC2044.2 +038000 OPEN OUTPUT PRINT-FILE. NC2044.2 +038100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2044.2 +038200 MOVE SPACE TO TEST-RESULTS. NC2044.2 +038300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2044.2 +038400 GO TO CCVS1-EXIT. NC2044.2 +038500 CLOSE-FILES. NC2044.2 +038600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2044.2 +038700 TERMINATE-CCVS. NC2044.2 +038800S EXIT PROGRAM. NC2044.2 +038900STERMINATE-CALL. NC2044.2 +039000 STOP RUN. NC2044.2 +039100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2044.2 +039200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2044.2 +039300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2044.2 +039400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2044.2 +039500 MOVE "****TEST DELETED****" TO RE-MARK. NC2044.2 +039600 PRINT-DETAIL. NC2044.2 +039700 IF REC-CT NOT EQUAL TO ZERO NC2044.2 +039800 MOVE "." TO PARDOT-X NC2044.2 +039900 MOVE REC-CT TO DOTVALUE. NC2044.2 +040000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2044.2 +040100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2044.2 +040200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2044.2 +040300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2044.2 +040400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2044.2 +040500 MOVE SPACE TO CORRECT-X. NC2044.2 +040600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2044.2 +040700 MOVE SPACE TO RE-MARK. NC2044.2 +040800 HEAD-ROUTINE. NC2044.2 +040900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2044.2 +041200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2044.2 +041300 COLUMN-NAMES-ROUTINE. NC2044.2 +041400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +041500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +041700 END-ROUTINE. NC2044.2 +041800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2044.2 +041900 END-RTN-EXIT. NC2044.2 +042000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +042100 END-ROUTINE-1. NC2044.2 +042200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2044.2 +042300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2044.2 +042400 ADD PASS-COUNTER TO ERROR-HOLD. NC2044.2 +042500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2044.2 +042600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2044.2 +042700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2044.2 +042800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2044.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2044.2 +043000 END-ROUTINE-12. NC2044.2 +043100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2044.2 +043200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2044.2 +043300 MOVE "NO " TO ERROR-TOTAL NC2044.2 +043400 ELSE NC2044.2 +043500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2044.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2044.2 +043700 PERFORM WRITE-LINE. NC2044.2 +043800 END-ROUTINE-13. NC2044.2 +043900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2044.2 +044000 MOVE "NO " TO ERROR-TOTAL ELSE NC2044.2 +044100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2044.2 +044200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2044.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +044400 IF INSPECT-COUNTER EQUAL TO ZERO NC2044.2 +044500 MOVE "NO " TO ERROR-TOTAL NC2044.2 +044600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2044.2 +044700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2044.2 +044800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +044900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +045000 WRITE-LINE. NC2044.2 +045100 ADD 1 TO RECORD-COUNT. NC2044.2 +045200Y IF RECORD-COUNT GREATER 50 NC2044.2 +045300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2044.2 +045400Y MOVE SPACE TO DUMMY-RECORD NC2044.2 +045500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2044.2 +045600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2044.2 +045700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2044.2 +045800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2044.2 +045900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2044.2 +046000Y MOVE ZERO TO RECORD-COUNT. NC2044.2 +046100 PERFORM WRT-LN. NC2044.2 +046200 WRT-LN. NC2044.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2044.2 +046400 MOVE SPACE TO DUMMY-RECORD. NC2044.2 +046500 BLANK-LINE-PRINT. NC2044.2 +046600 PERFORM WRT-LN. NC2044.2 +046700 FAIL-ROUTINE. NC2044.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2044.2 +046900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2044.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2044.2 +047100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2044.2 +047200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +047300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2044.2 +047400 GO TO FAIL-ROUTINE-EX. NC2044.2 +047500 FAIL-ROUTINE-WRITE. NC2044.2 +047600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2044.2 +047700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2044.2 +047800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2044.2 +047900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2044.2 +048000 FAIL-ROUTINE-EX. EXIT. NC2044.2 +048100 BAIL-OUT. NC2044.2 +048200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2044.2 +048300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2044.2 +048400 BAIL-OUT-WRITE. NC2044.2 +048500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2044.2 +048600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2044.2 +048700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +048800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2044.2 +048900 BAIL-OUT-EX. EXIT. NC2044.2 +049000 CCVS1-EXIT. NC2044.2 +049100 EXIT. NC2044.2 +049200 SECT-NC204M-001 SECTION. NC2044.2 +049300 DIS-INIT-GF. NC2044.2 +049400 MOVE "VI-78 6.10" TO ANSI-REFERENCE. NC2044.2 +049500 MOVE SPACE TO FEATURE. NC2044.2 +049600 PERFORM BLANK-LINE-PRINT. NC2044.2 +049700 MOVE "SEE NOTE IN DIS-INIT-GF." TO RE-MARK. NC2044.2 +049800 PERFORM PRINT-DETAIL. NC2044.2 +049900 PERFORM BLANK-LINE-PRINT. NC2044.2 +050000 MOVE "DISPLAY UPON" TO FEATURE. NC2044.2 +050100* NOTE FOR THE SAKE OF CONVENIENCE IN READING THE OUTPUT, NC2044.2 +050200* THE DISPLAY TESTS ARE CONSTRUCTED ON THE ASSUMPTION NC2044.2 +050300* THAT THE DISPLAYED OUTPUT WILL BE PRINTED ALONG NC2044.2 +050400* WITH THE OUTPUT FROM THE WRITE STATEMENTS. NOTE , NC2044.2 +050500* HOWEVER, IT IS NOT CONSIDERED NONSTANDARD IF THE NC2044.2 +050600* DISPLAYED OUTPUT APPEARS ELSEWHERE IN THE LISTING. NC2044.2 +050700* NC2044.2 +050800 DIS-INIT-GF-1. NC2044.2 +050900 MOVE "DIS-TEST-GF-1 " TO PAR-NAME. NC2044.2 +051000 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +051100 DIS-TEST-GF-1. NC2044.2 +051200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +051300 DISPLAY DISPLAY-A UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +051400 MOVE DISPLAY-A TO DIS-PLAYER. NC2044.2 +051500 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +051600 GO TO DIS-WRITE-GF-1. NC2044.2 +051700 DIS-DELETE-GF-1. NC2044.2 +051800 PERFORM DE-LETE. NC2044.2 +051900 DIS-WRITE-GF-1. NC2044.2 +052000 MOVE "DIS-TEST-GF-1 " TO PAR-NAME. NC2044.2 +052100 PERFORM PRINT-DETAIL. NC2044.2 +052200* NC2044.2 +052300 DIS-INIT-GF-2. NC2044.2 +052400 MOVE "DIS-TEST-GF-2 " TO PAR-NAME. NC2044.2 +052500 DIS-TEST-GF-2. NC2044.2 +052600 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +052700 DISPLAY "ALPHABETIC LITERAL" UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +052800 MOVE "ALPHABETIC LITERAL" TO DIS-PLAYER. NC2044.2 +052900 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +053000 GO TO DIS-WRITE-GF-2. NC2044.2 +053100 DIS-DELETE-GF-2. NC2044.2 +053200 PERFORM DE-LETE. NC2044.2 +053300 DIS-WRITE-GF-2. NC2044.2 +053400 MOVE "DIS-TEST-GF-2 " TO PAR-NAME. NC2044.2 +053500 PERFORM PRINT-DETAIL. NC2044.2 +053600* NC2044.2 +053700 DIS-INIT-GF-3. NC2044.2 +053800 MOVE "DIS-TEST-GF-3 " TO PAR-NAME. NC2044.2 +053900 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +054000 DIS-TEST-GF-3. NC2044.2 +054100 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +054200 DISPLAY DISPLAY-N UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +054300 MOVE DISPLAY-N TO DIS-PLAYER. NC2044.2 +054400 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +054500 GO TO DIS-WRITE-GF-3. NC2044.2 +054600 DIS-DELETE-GF-3. NC2044.2 +054700 PERFORM DE-LETE. NC2044.2 +054800 DIS-WRITE-GF-3. NC2044.2 +054900 MOVE "DIS-TEST-GF-3 " TO PAR-NAME. NC2044.2 +055000 PERFORM PRINT-DETAIL. NC2044.2 +055100* NC2044.2 +055200 DIS-INIT-GF-4. NC2044.2 +055300 MOVE "DIS-TEST-GF-4 " TO PAR-NAME. NC2044.2 +055400 DIS-TEST-GF-4. NC2044.2 +055500 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +055600 DISPLAY 9876543210 UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +055700 MOVE "9876543210" TO DIS-PLAYER. NC2044.2 +055800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +055900 GO TO DIS-WRITE-GF-4. NC2044.2 +056000 DIS-DELETE-GF-4. NC2044.2 +056100 PERFORM DE-LETE. NC2044.2 +056200 DIS-WRITE-GF-4. NC2044.2 +056300 MOVE "DIS-TEST-GF-4 " TO PAR-NAME. NC2044.2 +056400 PERFORM PRINT-DETAIL. NC2044.2 +056500* NC2044.2 +056600 DIS-INIT-GF-5. NC2044.2 +056700 MOVE "DIS-TEST-GF-5 " TO PAR-NAME. NC2044.2 +056800 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +056900 DIS-TEST-GF-5. NC2044.2 +057000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +057100 DISPLAY DISPLAY-X UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +057200 MOVE DISPLAY-X TO DIS-PLAYER. NC2044.2 +057300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +057400 GO TO DIS-WRITE-GF-5. NC2044.2 +057500 DIS-DELETE-GF-5. NC2044.2 +057600 PERFORM DE-LETE. NC2044.2 +057700 DIS-WRITE-GF-5. NC2044.2 +057800 MOVE "DIS-TEST-GF-5 " TO PAR-NAME. NC2044.2 +057900 PERFORM PRINT-DETAIL. NC2044.2 +058000* NC2044.2 +058100 DIS-INIT-GF-6. NC2044.2 +058200 MOVE "DIS-TEST-GF-6 " TO PAR-NAME. NC2044.2 +058300 DIS-TEST-GF-6. NC2044.2 +058400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +058500 DISPLAY "A1B2C3D4E5 ALPHANUMERIC LITERAL" UPON NC2044.2 +058600 DISPLAY-OUTPUT-DEVICE. NC2044.2 +058700 MOVE "A1B2C3D4E5 ALPHANUMERIC LITERAL" TO DIS-PLAYER. NC2044.2 +058800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +058900 GO TO DIS-WRITE-GF-6. NC2044.2 +059000 DIS-DELETE-GF-6. NC2044.2 +059100 PERFORM DE-LETE. NC2044.2 +059200 DIS-WRITE-GF-6. NC2044.2 +059300 MOVE "DIS-TEST-GF-6 " TO PAR-NAME. NC2044.2 +059400 PERFORM PRINT-DETAIL. NC2044.2 +059500* NC2044.2 +059600 DIS-INIT-GF-7. NC2044.2 +059700 MOVE "DIS-TEST-GF-7 " TO PAR-NAME. NC2044.2 +059800 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +059900 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +060000 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +060100 DIS-TEST-GF-7. NC2044.2 +060200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +060300 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES" UPON NC2044.2 +060400 DISPLAY-OUTPUT-DEVICE. NC2044.2 +060500 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC2044.2 +060600 TO DIS-PLAYER. NC2044.2 +060700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +060800 GO TO DIS-WRITE-GF-7. NC2044.2 +060900 DIS-DELETE-GF-7. NC2044.2 +061000 PERFORM DE-LETE. NC2044.2 +061100 DIS-WRITE-GF-7. NC2044.2 +061200 MOVE "DIS-TEST-GF-7 " TO PAR-NAME. NC2044.2 +061300 PERFORM PRINT-DETAIL. NC2044.2 +061400* NC2044.2 +061500 DIS-INIT-GF-8. NC2044.2 +061600 MOVE "DIS-TEST-GF-8 " TO PAR-NAME. NC2044.2 +061700 DIS-TEST-GF-8. NC2044.2 +061800 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +061900 DISPLAY ZERO SPACE QUOTE UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +062000* DISPLAY FIGURATIVE CONSTANT ONE ZERO EXPECTED. NC2044.2 +062100 MOVE ZERO-SPACE-QUOTE TO DIS-PLAYER. NC2044.2 +062200 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +062300 GO TO DIS-WRITE-GF-8. NC2044.2 +062400 DIS-DELETE-GF-8. NC2044.2 +062500 PERFORM DE-LETE. NC2044.2 +062600 DIS-WRITE-GF-8. NC2044.2 +062700 MOVE "DIS-TEST-GF-8 " TO PAR-NAME. NC2044.2 +062800 PERFORM PRINT-DETAIL. NC2044.2 +062900* NC2044.2 +063000 DIS-INIT-GF-9. NC2044.2 +063100 MOVE "DIS-TEST-GF-9 " TO PAR-NAME. NC2044.2 +063200 MOVE "REDEFINE-INFO" TO DISPLAY-B. NC2044.2 +063300 DIS-TEST-GF-9. NC2044.2 +063400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +063500 DISPLAY DISPLAY-C UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +063600* DISPLAY REDEFINES FIELD. NC2044.2 +063700 MOVE "REDEFINE-INFO" TO DIS-PLAYER. NC2044.2 +063800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +063900 GO TO DIS-WRITE-GF-9. NC2044.2 +064000 DIS-DELETE-GF-9. NC2044.2 +064100 PERFORM DE-LETE. NC2044.2 +064200 DIS-WRITE-GF-9. NC2044.2 +064300 MOVE "DIS-TEST-GF-9 " TO PAR-NAME. NC2044.2 +064400 PERFORM PRINT-DETAIL. NC2044.2 +064500* NC2044.2 +064600 DIS-INIT-GF-10. NC2044.2 +064700 MOVE "DIS-TEST-GF-10" TO PAR-NAME. NC2044.2 +064800 MOVE "D001*002*003*004*005*006*007*008*009*010*011*012*013*01NC2044.2 +064900- "4*015*016*017*018*019*020*021*022*023*024*025" TO DISPLAY-G.NC2044.2 +065000 MOVE "*026*027*028*029*030*031*032*033*034*035*036*037*038*03NC2044.2 +065100- "9*040*041*042*043*044*045*046*047*048*049*050" TO DISPLAY-H.NC2044.2 +065200 DIS-TEST-GF-10. NC2044.2 +065300 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +065400 DISPLAY DISPLAY-F UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +065500 MOVE DISPLAY-G TO DIS-PLAYER. NC2044.2 +065600 MOVE 1 TO DISPLAY-SWITCH. NC2044.2 +065700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +065800* NOTE THE "CORRECT" RESULT IS WRITTEN AS TWO NC2044.2 +065900* 100-CHARACTER LINES, BUT THE WAY THAT THE NC2044.2 +066000* "COMPUTED" RESULT IS SPLIT UP IS NOT NC2044.2 +066100* DEFINED BY THE STANDARD --- REGARDLESS OF NC2044.2 +066200* THIS, ALL 200 CHARACTERS MUST BE DISPLAYED. NC2044.2 +066300 GO TO DIS-WRITE-GF-10. NC2044.2 +066400 DIS-DELETE-GF-10. NC2044.2 +066500 PERFORM DE-LETE. NC2044.2 +066600 DIS-WRITE-GF-10. NC2044.2 +066700 MOVE "DIS-TEST-GF-10" TO PAR-NAME. NC2044.2 +066800 PERFORM PRINT-DETAIL. NC2044.2 +066900* NC2044.2 +067000 DIS-INIT-GF-11. NC2044.2 +067100 MOVE "DIS-TEST-GF-11" TO PAR-NAME. NC2044.2 +067200 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC2044.2 +067300 MOVE 0123456789 TO DIGITS-DV-10V00. NC2044.2 +067400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-<>=l,:.()/* 0123456789" NC2044.2 +067500 TO GRP-ALPHANUMERIC. NC2044.2 +067600 DIS-TEST-GF-11. NC2044.2 +067700 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +067800 DISPLAY GRP-ALPHABETIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +067900 DISPLAY GRP-NUMERIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +068000 DISPLAY GRP-ALPHANUMERIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +068100 MOVE GRP-ALPHABETIC TO DIS-PLAYER NC2044.2 +068200 MOVE 2 TO DISPLAY-SWITCH. NC2044.2 +068300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +068400 GO TO DIS-WRITE-GF-11. NC2044.2 +068500 DIS-DELETE-GF-11. NC2044.2 +068600 PERFORM DE-LETE. NC2044.2 +068700 DIS-WRITE-GF-11. NC2044.2 +068800 MOVE "DIS-TEST-GF-11" TO PAR-NAME. NC2044.2 +068900 PERFORM PRINT-DETAIL. NC2044.2 +069000* NC2044.2 +069100 DIS-INIT-GF-12. NC2044.2 +069200 MOVE "DIS-TEST-GF-12" TO PAR-NAME. NC2044.2 +069300 DIS-TEST-GF-12. NC2044.2 +069400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +069500 DISPLAY X21 X20 X19 X18 X17 X16 X15 X14 X13 X12 X11 X10 X9 NC2044.2 +069600 X8 X7 X6 X5 X4 X3 X2 X1 UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +069700 MOVE "UTSRQPONMLKJIHGFEDCBA" TO DIS-PLAYER. NC2044.2 +069800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +069900 GO TO DIS-WRITE-GF-12. NC2044.2 +070000 DIS-DELETE-GF-12. NC2044.2 +070100 PERFORM DE-LETE. NC2044.2 +070200 DIS-WRITE-GF-12. NC2044.2 +070300 MOVE "DIS-TEST-GF-12" TO PAR-NAME. NC2044.2 +070400 PERFORM PRINT-DETAIL. NC2044.2 +070500* NC2044.2 +070600 DIS-INIT-GF-13. NC2044.2 +070700 MOVE "DIS-TEST-GF-13" TO PAR-NAME. NC2044.2 +070800 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO QUAL-TAB-VALUE. NC2044.2 +070900 DIS-TEST-GF-13. NC2044.2 +071000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +071100 DISPLAY XTAB (1), XTAB (2), XTAB (3), XTAB (4), NC2044.2 +071200 XTAB (5), XTAB (6), XTAB (7), XTAB (8), NC2044.2 +071300 XTAB (9), NC2044.2 +071400 ELEM-1 OF GRP-1, NC2044.2 +071500 ELEM-2 OF GRP-1, NC2044.2 +071600 ELEM-3 OF GRP-1, NC2044.2 +071700 SUB-TAB OF GRP-1 (1), NC2044.2 +071800 SUB-TAB OF GRP-1 (2), NC2044.2 +071900 SUB-TAB OF GRP-1 (3), NC2044.2 +072000 ELEM-1 IN GRP-2, NC2044.2 +072100 ELEM-2 IN GRP-2, NC2044.2 +072200 ELEM-3 IN GRP-2, NC2044.2 +072300 SUB-TAB OF GRP-2 (1), NC2044.2 +072400 SUB-TAB OF GRP-2 (2), NC2044.2 +072500 SUB-TAB OF GRP-2 (3) UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +072600* NOTE DISPLAY 21 VARIABLES, SUBSCRIPTED, QUALIFIED, BOTH. NC2044.2 +072700 MOVE QUAL-TAB-VALUE TO DIS-PLAYER. NC2044.2 +072800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +072900 GO TO DIS-WRITE-GF-13. NC2044.2 +073000 DIS-DELETE-GF-13. NC2044.2 +073100 PERFORM DE-LETE. NC2044.2 +073200 DIS-WRITE-GF-13. NC2044.2 +073300 MOVE "DIS-TEST-GF-13" TO PAR-NAME. NC2044.2 +073400 PERFORM PRINT-DETAIL. NC2044.2 +073500* NC2044.2 +073600 DIS-INIT-GF-14. NC2044.2 +073700 MOVE "DIS-TEST-GF-14" TO PAR-NAME. NC2044.2 +073800 MOVE "SEE NOTE IN DIS-TEST-GF-14" TO RE-MARK. NC2044.2 +073900 DIS-TEST-GF-14. NC2044.2 +074000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +074100 DISPLAY "QUOTE " NC2044.2 +074200 QUOTES NC2044.2 +074300 " ASTERISK " NC2044.2 +074400 "*" NC2044.2 +074500 " NUMERIC LITERALS " NC2044.2 +074600 21 NC2044.2 +074700 SPACES NC2044.2 +074800 1325 NC2044.2 +074900 I-DATA NC2044.2 +075000 PIECE (1, 1) NC2044.2 +075100 PIECE (1, 2) NC2044.2 +075200 PIECE (1, 3) NC2044.2 +075300 PIECE (1, 4) NC2044.2 +075400 PIECE (1, 5) NC2044.2 +075500 PIECE (2, 1) NC2044.2 +075600 PIECE (2, 2) NC2044.2 +075700 PIECE (2, 3) NC2044.2 +075800 PIECE (2, 4) NC2044.2 +075900 PIECE (2, 5) NC2044.2 +076000 A1 OF TRUE-PAIR NC2044.2 +076100 A2 IN TRUE-PAIR UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +076200* NOTE 21 OPERANDS, 111 CHARACTERS. NC2044.2 +076300 MOVE DISPLAY-MIXTURE TO DIS-PLAYER. NC2044.2 +076400 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +076500 GO TO DIS-WRITE-GF-14. NC2044.2 +076600 DIS-DELETE-GF-14. NC2044.2 +076700 PERFORM DE-LETE. NC2044.2 +076800 DIS-WRITE-GF-14. NC2044.2 +076900 MOVE "DIS-TEST-GF-14" TO PAR-NAME. NC2044.2 +077000 PERFORM PRINT-DETAIL. NC2044.2 +077100* NC2044.2 +077200 DISP-INIT-GF-15. NC2044.2 +077300* ==--> SINGLE IDENTIFIER WITH "WITH NO ADVANCING" PHRASE <--==NC2044.2 +077400 MOVE "VI-79 6.10.4 GR8" TO ANSI-REFERENCE. NC2044.2 +077500 MOVE "DIS-TEST-GF-15 " TO PAR-NAME. NC2044.2 +077600 MOVE "PLEASE PERFORM A VISUAL CHECK ON THE POSITIONING" NC2044.2 +077700 TO RE-MARK. NC2044.2 +077800 PERFORM PRINT-DETAIL. NC2044.2 +077900 MOVE "OF THE HARDWARE DEVICE AFTER THIS TEST." NC2044.2 +078000 TO RE-MARK. NC2044.2 +078100 PERFORM PRINT-DETAIL. NC2044.2 +078200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +078300 DIS-TEST-GF-15. NC2044.2 +078400 DISPLAY 9876543210 UPON DISPLAY-OUTPUT-DEVICE NC2044.2 +078500 WITH NO ADVANCING. NC2044.2 +078600 MOVE "9876543210" TO DIS-PLAYER. NC2044.2 +078700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +078800 GO TO DIS-WRITE-GF-15. NC2044.2 +078900 DIS-DELETE-GF-15. NC2044.2 +079000 PERFORM DE-LETE. NC2044.2 +079100 DIS-WRITE-GF-15. NC2044.2 +079200 PERFORM PRINT-DETAIL. NC2044.2 +079300* NC2044.2 +079400 DISP-INIT-GF-16. NC2044.2 +079500* ==--> MULTPL IDENTIFIERS WITH "WITH NO ADVANCING" PHRASE <--=NC2044.2 +079600 MOVE "VI-79 6.10.4 GR8" TO ANSI-REFERENCE. NC2044.2 +079700 MOVE "DIS-TEST-GF-16 " TO PAR-NAME. NC2044.2 +079800 MOVE "PLEASE PERFORM A VISUAL CHECK ON THE POSITIONING" NC2044.2 +079900 TO RE-MARK. NC2044.2 +080000 PERFORM PRINT-DETAIL. NC2044.2 +080100 MOVE "OF THE HARDWARE DEVICE AFTER THIS TEST." NC2044.2 +080200 TO RE-MARK. NC2044.2 +080300 PERFORM PRINT-DETAIL. NC2044.2 +080400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +080500 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +080600 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +080700 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +080800 DIS-TEST-GF-16. NC2044.2 +080900 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES" NC2044.2 +081000 UPON DISPLAY-OUTPUT-DEVICE WITH NO ADVANCING. NC2044.2 +081100 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC2044.2 +081200 TO DIS-PLAYER. NC2044.2 +081300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +081400 GO TO DIS-WRITE-GF-16. NC2044.2 +081500 DIS-DELETE-GF-16. NC2044.2 +081600 PERFORM DE-LETE. NC2044.2 +081700 DIS-WRITE-GF-16. NC2044.2 +081800 MOVE "DIS-TEST-GF-16 " TO PAR-NAME. NC2044.2 +081900 PERFORM PRINT-DETAIL. NC2044.2 +082000* NC2044.2 +082100 AC-CEPT SECTION. NC2044.2 +082200 ACC-INIT-F1. NC2044.2 +082300 MOVE "ACCEPT " TO FEATURE. NC2044.2 +082400 MOVE "VI-71 6.5.2" TO ANSI-REFERENCE. NC2044.2 +082500 ACC-INIT-F1-1. NC2044.2 +082600 MOVE "ACC-TEST-F1-1 " TO PAR-NAME. NC2044.2 +082700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXY Z" TO ACCEPT-D2. NC2044.2 +082800 ACC-TEST-F1-1. NC2044.2 +082900 ACCEPT ACCEPT-D1 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +083000 IF ACCEPT-D1 EQUAL TO ACCEPT-D2 NC2044.2 +083100 PERFORM PASS GO TO ACC-WRITE-F1-1. NC2044.2 +083200 GO TO ACC-FAIL-F1-1. NC2044.2 +083300 ACC-DELETE-F1-1. NC2044.2 +083400 PERFORM DE-LETE. NC2044.2 +083500 GO TO ACC-WRITE-F1-1. NC2044.2 +083600 ACC-FAIL-F1-1. NC2044.2 +083700 MOVE ACCEPT-D1-A TO COMPUTED-A. NC2044.2 +083800 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC2044.2 +083900 PERFORM PRINT-DETAIL. NC2044.2 +084000 MOVE ACCEPT-D1-B TO COMPUTED-A. NC2044.2 +084100 MOVE "UVWXY Z" TO CORRECT-A. NC2044.2 +084200 PERFORM FAIL. NC2044.2 +084300 MOVE "LAST 7 OF 27-CHAR FIELD" TO RE-MARK. NC2044.2 +084400 ACC-WRITE-F1-1. NC2044.2 +084500 PERFORM PRINT-DETAIL. NC2044.2 +084600* NC2044.2 +084700 ACC-INIT-F1-2. NC2044.2 +084800 MOVE "ACC-TEST-F1-2 " TO PAR-NAME. NC2044.2 +084900 MOVE 0123456789 TO ACCEPT-D4. NC2044.2 +085000 ACC-TEST-F1-2. NC2044.2 +085100 ACCEPT ACCEPT-D3 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +085200 IF ACCEPT-D3 EQUAL TO ACCEPT-D4 NC2044.2 +085300 PERFORM PASS GO TO ACC-WRITE-F1-2. NC2044.2 +085400 GO TO ACC-FAIL-F1-2. NC2044.2 +085500 ACC-DELETE-F1-2. NC2044.2 +085600 PERFORM DE-LETE. NC2044.2 +085700 GO TO ACC-WRITE-F1-2. NC2044.2 +085800 ACC-FAIL-F1-2. NC2044.2 +085900 MOVE ACCEPT-D3 TO COMPUTED-18V0. NC2044.2 +086000 MOVE ACCEPT-D4 TO CORRECT-18V0. NC2044.2 +086100 PERFORM FAIL. NC2044.2 +086200 ACC-WRITE-F1-2. NC2044.2 +086300 PERFORM PRINT-DETAIL. NC2044.2 +086400* NC2044.2 +086500 ACC-INIT-F1-3. NC2044.2 +086600 MOVE "ACC-TEST-F1-3 " TO PAR-NAME. NC2044.2 +086700 MOVE "().+-*/$, =" TO ACCEPT-D6. NC2044.2 +086800 ACC-TEST-F1-3. NC2044.2 +086900 ACCEPT ACCEPT-D5 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +087000 IF ACCEPT-D5 EQUAL TO ACCEPT-D6 NC2044.2 +087100 PERFORM PASS GO TO ACC-WRITE-F1-3. NC2044.2 +087200* NOTE ACCEPT SPECIAL CHARACTERS. NC2044.2 +087300 GO TO ACC-FAIL-F1-3. NC2044.2 +087400 ACC-DELETE-F1-3. NC2044.2 +087500 PERFORM DE-LETE. NC2044.2 +087600 GO TO ACC-WRITE-F1-3. NC2044.2 +087700 ACC-FAIL-F1-3. NC2044.2 +087800 MOVE ACCEPT-D5 TO COMPUTED-A. NC2044.2 +087900 MOVE ACCEPT-D6 TO CORRECT-A. NC2044.2 +088000 PERFORM FAIL. NC2044.2 +088100 ACC-WRITE-F1-3. NC2044.2 +088200 PERFORM PRINT-DETAIL. NC2044.2 +088300* NC2044.2 +088400 ACC-INIT-F1-4. NC2044.2 +088500 MOVE "ACC-TEST-F1-4 " TO PAR-NAME. NC2044.2 +088600 MOVE "9" TO ACCEPT-D8. NC2044.2 +088700 ACC-TEST-F1-4. NC2044.2 +088800 ACCEPT ACCEPT-D7 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +088900 IF ACCEPT-D7 EQUAL TO ACCEPT-D8 NC2044.2 +089000 PERFORM PASS GO TO ACC-WRITE-F1-4. NC2044.2 +089100 GO TO ACC-FAIL-F1-4. NC2044.2 +089200 ACC-DELETE-F1-4. NC2044.2 +089300 PERFORM DE-LETE. NC2044.2 +089400 GO TO ACC-WRITE-F1-4. NC2044.2 +089500 ACC-FAIL-F1-4. NC2044.2 +089600 MOVE ACCEPT-D7 TO COMPUTED-A. NC2044.2 +089700 MOVE ACCEPT-D8 TO CORRECT-A. NC2044.2 +089800 MOVE "9 EXPECTED" TO RE-MARK. NC2044.2 +089900 PERFORM FAIL. NC2044.2 +090000 ACC-WRITE-F1-4. NC2044.2 +090100 PERFORM PRINT-DETAIL. NC2044.2 +090200* NC2044.2 +090300 ACC-INIT-F1-5. NC2044.2 +090400 MOVE "ACC-TEST-F1-5 " TO PAR-NAME. NC2044.2 +090500 MOVE "0" TO ACCEPT-D10. NC2044.2 +090600 ACC-TEST-F1-5. NC2044.2 +090700 ACCEPT ACCEPT-D9 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +090800 IF ACCEPT-D9 EQUAL TO ACCEPT-D10 NC2044.2 +090900 PERFORM PASS GO TO ACC-WRITE-F1-5. NC2044.2 +091000 GO TO ACC-FAIL-F1-5. NC2044.2 +091100 ACC-DELETE-F1-5. NC2044.2 +091200 PERFORM DE-LETE. NC2044.2 +091300 GO TO ACC-WRITE-F1-5. NC2044.2 +091400 ACC-FAIL-F1-5. NC2044.2 +091500 MOVE ACCEPT-D9 TO COMPUTED-A. NC2044.2 +091600 MOVE ACCEPT-D10 TO CORRECT-A. NC2044.2 +091700 MOVE "0 EXPECTED" TO RE-MARK. NC2044.2 +091800 PERFORM FAIL. NC2044.2 +091900 ACC-WRITE-F1-5. NC2044.2 +092000 PERFORM PRINT-DETAIL. NC2044.2 +092100* NC2044.2 +092200 ACC-INIT-F1-6. NC2044.2 +092300 MOVE "ACC-TEST-F1-6 " TO PAR-NAME. NC2044.2 +092400 MOVE " ABC XYZ " TO ACCEPT-D12. NC2044.2 +092500 ACC-TEST-F1-6. NC2044.2 +092600 ACCEPT ACCEPT-D11 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +092700 IF ACCEPT-D11 EQUAL TO ACCEPT-D12 NC2044.2 +092800 PERFORM PASS GO TO ACC-WRITE-F1-6. NC2044.2 +092900 GO TO ACC-FAIL-F1-6. NC2044.2 +093000 ACC-DELETE-F1-6. NC2044.2 +093100 PERFORM DE-LETE. NC2044.2 +093200 GO TO ACC-WRITE-F1-6. NC2044.2 +093300 ACC-FAIL-F1-6. NC2044.2 +093400 MOVE ACCEPT-D11 TO COMPUTED-A. NC2044.2 +093500 MOVE ACCEPT-D12 TO CORRECT-A. NC2044.2 +093600 PERFORM FAIL. NC2044.2 +093700 ACC-WRITE-F1-6. NC2044.2 +093800 PERFORM PRINT-DETAIL. NC2044.2 +093900* NC2044.2 +094000 ACC-INIT-F1-7. NC2044.2 +094100 MOVE "ACC-TEST-F1-7 " TO PAR-NAME. NC2044.2 +094200 MOVE " 9" TO ACCEPT-D16. NC2044.2 +094300 ACC-TEST-F1-7. NC2044.2 +094400 ACCEPT ACCEPT-D15 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +094500 IF ACCEPT-D15 EQUAL TO ACCEPT-D16 NC2044.2 +094600 PERFORM PASS GO TO ACC-WRITE-F1-7. NC2044.2 +094700 GO TO ACC-FAIL-F1-7. NC2044.2 +094800 ACC-DELETE-F1-7. NC2044.2 +094900 PERFORM DE-LETE. NC2044.2 +095000 GO TO ACC-WRITE-F1-7. NC2044.2 +095100 ACC-FAIL-F1-7. NC2044.2 +095200 PERFORM FAIL. NC2044.2 +095300 MOVE ACCEPT-D15 TO COMPUTED-A. NC2044.2 +095400 MOVE " 9 (SPACE 9)" TO CORRECT-A. NC2044.2 +095500 ACC-WRITE-F1-7. NC2044.2 +095600 PERFORM PRINT-DETAIL. NC2044.2 +095700* NC2044.2 +095800 ACC-INIT-F1-8. NC2044.2 +095900 MOVE "ACC-TEST-F1-8 " TO PAR-NAME. NC2044.2 +096000 MOVE QUOTE TO ACCEPT-D18. NC2044.2 +096100 ACC-TEST-F1-8. NC2044.2 +096200 ACCEPT ACCEPT-D17 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +096300 IF ACCEPT-D17 EQUAL TO ACCEPT-D18 NC2044.2 +096400 PERFORM PASS GO TO ACC-WRITE-F1-8. NC2044.2 +096500 GO TO ACC-FAIL-F1-8. NC2044.2 +096600 ACC-DELETE-F1-8. NC2044.2 +096700 PERFORM DE-LETE. NC2044.2 +096800 GO TO ACC-WRITE-F1-8. NC2044.2 +096900 ACC-FAIL-F1-8. NC2044.2 +097000 PERFORM FAIL. NC2044.2 +097100 MOVE ACCEPT-D17 TO COMPUTED-A. NC2044.2 +097200 MOVE ACCEPT-D18 TO CORRECT-A. NC2044.2 +097300 ACC-WRITE-F1-8. NC2044.2 +097400 PERFORM PRINT-DETAIL. NC2044.2 +097500* NC2044.2 +097600 ACC-INIT-F1-9. NC2044.2 +097700 MOVE "ACC-TEST-F1-9 " TO PAR-NAME. NC2044.2 +097800 MOVE "Q" TO ACCEPT-D20. NC2044.2 +097900 ACC-TEST-F1-9. NC2044.2 +098000 ACCEPT QUAL-ACCEPT OF ACCEPT-D19 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +098100 IF ACCEPT-D19 EQUAL TO ACCEPT-D20 NC2044.2 +098200 PERFORM PASS GO TO ACC-WRITE-F1-9. NC2044.2 +098300 GO TO ACC-FAIL-F1-9. NC2044.2 +098400 ACC-DELETE-F1-9. NC2044.2 +098500 PERFORM DE-LETE. NC2044.2 +098600 GO TO ACC-WRITE-F1-9. NC2044.2 +098700 ACC-FAIL-F1-9. NC2044.2 +098800 PERFORM FAIL. NC2044.2 +098900 MOVE ACCEPT-D19 TO COMPUTED-A. NC2044.2 +099000 MOVE ACCEPT-D20 TO CORRECT-A. NC2044.2 +099100 ACC-WRITE-F1-9. NC2044.2 +099200 PERFORM PRINT-DETAIL. NC2044.2 +099300* NC2044.2 +099400 ACC-INIT-F1-10. NC2044.2 +099500 MOVE "ACC-TEST-F1-10" TO PAR-NAME. NC2044.2 +099600 MOVE "....ABCD...." TO ACCEPT-D22. NC2044.2 +099700 ACC-TEST-F1-10. NC2044.2 +099800 ACCEPT TAB-ACCEPT (2) FROM ACCEPT-INPUT-DEVICE. NC2044.2 +099900 IF ACCEPT-D21 EQUAL TO ACCEPT-D22 NC2044.2 +100000 PERFORM PASS GO TO ACC-WRITE-F1-10. NC2044.2 +100100 GO TO ACC-FAIL-F1-10. NC2044.2 +100200 ACC-DELETE-F1-10. NC2044.2 +100300 PERFORM DE-LETE. NC2044.2 +100400 GO TO ACC-WRITE-F1-10. NC2044.2 +100500 ACC-FAIL-F1-10. NC2044.2 +100600 PERFORM FAIL. NC2044.2 +100700 MOVE ACCEPT-D21 TO COMPUTED-A. NC2044.2 +100800 MOVE ACCEPT-D22 TO CORRECT-A. NC2044.2 +100900 ACC-WRITE-F1-10. NC2044.2 +101000 PERFORM PRINT-DETAIL. NC2044.2 +101100* NC2044.2 +101200 ACC-INIT-F1-11. NC2044.2 +101300 MOVE "ACC-TEST-F1-11" TO PAR-NAME. NC2044.2 +101400 MOVE "--------------------" TO ACCEPT-D23. NC2044.2 +101500 MOVE "----------------ABCD" TO ACCEPT-D24. NC2044.2 +101600 ACC-TEST-F1-11. NC2044.2 +101700 ACCEPT TAB-A IN ACCEPT-D23 (SUB) FROM ACCEPT-INPUT-DEVICE. NC2044.2 +101800 IF ACCEPT-D23 EQUAL TO ACCEPT-D24 NC2044.2 +101900 PERFORM PASS GO TO ACC-WRITE-F1-11. NC2044.2 +102000 GO TO ACC-FAIL-F1-11. NC2044.2 +102100 ACC-DELETE-F1-11. NC2044.2 +102200 PERFORM DE-LETE. NC2044.2 +102300 GO TO ACC-WRITE-F1-11. NC2044.2 +102400 ACC-FAIL-F1-11. NC2044.2 +102500 PERFORM FAIL. NC2044.2 +102600 MOVE ACCEPT-D23 TO COMPUTED-A. NC2044.2 +102700 MOVE ACCEPT-D24 TO CORRECT-A. NC2044.2 +102800 ACC-WRITE-F1-11. NC2044.2 +102900 PERFORM PRINT-DETAIL. NC2044.2 +103000* NC2044.2 +103100 ACC-INIT-F1-12. NC2044.2 +103200 MOVE "ACC-TEST-F1-12" TO PAR-NAME. NC2044.2 +103300 MOVE NC2044.2 +103400 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC2044.2 +103500- "789 " TO ACCEPT-RESULTS. NC2044.2 +103600 ACC-TEST-F1-12. NC2044.2 +103700 ACCEPT 80X-CHARACTER-FIELD FROM ACCEPT-INPUT-DEVICE. NC2044.2 +103800 IF 80X-CHARACTER-FIELD EQUAL TO ACCEPT-RESULTS NC2044.2 +103900 PERFORM PASS GO TO ACC-WRITE-F1-12. NC2044.2 +104000 GO TO ACC-FAIL-F1-12. NC2044.2 +104100 ACC-DELETE-F1-12. NC2044.2 +104200 PERFORM DE-LETE. NC2044.2 +104300 GO TO ACC-WRITE-F1-12. NC2044.2 +104400 ACC-FAIL-F1-12. NC2044.2 +104500 MOVE 80X-CHARACTER-FIELD TO CHARACTER-BREAKDOWN-R. NC2044.2 +104600 MOVE ACCEPT-RESULTS TO CHARACTER-BREAKDOWN-S. NC2044.2 +104700 MOVE FIRST-20R TO COMPUTED-A. NC2044.2 +104800 MOVE FIRST-20S TO CORRECT-A. NC2044.2 +104900 PERFORM PRINT-DETAIL. NC2044.2 +105000 MOVE SECOND-20R TO COMPUTED-A. NC2044.2 +105100 MOVE SECOND-20S TO CORRECT-A. NC2044.2 +105200 PERFORM PRINT-DETAIL. NC2044.2 +105300 MOVE THIRD-20R TO COMPUTED-A. NC2044.2 +105400 MOVE THIRD-20S TO CORRECT-A. NC2044.2 +105500 PERFORM PRINT-DETAIL. NC2044.2 +105600 MOVE FOURTH-20R TO COMPUTED-A. NC2044.2 +105700 MOVE FOURTH-20S TO CORRECT-A. NC2044.2 +105800 PERFORM FAIL. NC2044.2 +105900 MOVE "LAST 20 OF 80 CHAR FIELD" TO RE-MARK. NC2044.2 +106000 ACC-WRITE-F1-12. NC2044.2 +106100 MOVE "ACC-TEST-F1-12" TO PAR-NAME. NC2044.2 +106200 PERFORM PRINT-DETAIL. NC2044.2 +106300* NC2044.2 +106400 ACC-INIT-F1-13. NC2044.2 +106500 MOVE "ACC-TEST-F1-13" TO PAR-NAME. NC2044.2 +106600 MOVE "D001*002*003*004*005*006*007*008*009*010*011*012*013*01NC2044.2 +106700- "4*015*016*017*018*019*020D021*022*023*024*025" TO DISPLAY-G.NC2044.2 +106800 MOVE "*026*027*028*029*030*031*032*033*034*035*036*037*038*03NC2044.2 +106900- "9*040D041*042*043*044*045*046*047*048*049*050" TO DISPLAY-H.NC2044.2 +107000 ACC-TEST-F1-13. NC2044.2 +107100 ACCEPT ACCEPT-D13 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +107200 IF ACCEPT-D13 EQUAL TO DISPLAY-F NC2044.2 +107300 PERFORM PASS GO TO ACC-WRITE-F1-13. NC2044.2 +107400 GO TO ACC-FAIL-F1-13. NC2044.2 +107500 ACC-DELETE-F1-13. NC2044.2 +107600 PERFORM DE-LETE. NC2044.2 +107700 GO TO ACC-WRITE-F1-13. NC2044.2 +107800 ACC-FAIL-F1-13. NC2044.2 +107900 MOVE ACCEPT-D13 TO CHARACTER-BREAKDOWN-R. NC2044.2 +108000 MOVE DISPLAY-F TO CHARACTER-BREAKDOWN-S. NC2044.2 +108100 MOVE FIRST-20R TO COMPUTED-A. NC2044.2 +108200 MOVE FIRST-20S TO CORRECT-A. NC2044.2 +108300 PERFORM PRINT-DETAIL. NC2044.2 +108400 MOVE SECOND-20R TO COMPUTED-A. NC2044.2 +108500 MOVE SECOND-20S TO CORRECT-A. NC2044.2 +108600 PERFORM PRINT-DETAIL. NC2044.2 +108700 MOVE THIRD-20R TO COMPUTED-A. NC2044.2 +108800 MOVE THIRD-20S TO CORRECT-A. NC2044.2 +108900 PERFORM PRINT-DETAIL. NC2044.2 +109000 MOVE FOURTH-20R TO COMPUTED-A. NC2044.2 +109100 MOVE FOURTH-20S TO CORRECT-A. NC2044.2 +109200 PERFORM PRINT-DETAIL. NC2044.2 +109300 MOVE FIFTH-20R TO COMPUTED-A. NC2044.2 +109400 MOVE FIFTH-20S TO CORRECT-A. NC2044.2 +109500 PERFORM PRINT-DETAIL. NC2044.2 +109600 MOVE SIXTH-20R TO COMPUTED-A. NC2044.2 +109700 MOVE SIXTH-20S TO CORRECT-A. NC2044.2 +109800 PERFORM PRINT-DETAIL. NC2044.2 +109900 MOVE SEVENTH-20R TO COMPUTED-A. NC2044.2 +110000 MOVE SEVENTH-20S TO CORRECT-A. NC2044.2 +110100 PERFORM PRINT-DETAIL. NC2044.2 +110200 MOVE EIGHTH-20R TO COMPUTED-A. NC2044.2 +110300 MOVE EIGHTH-20S TO CORRECT-A. NC2044.2 +110400 PERFORM PRINT-DETAIL. NC2044.2 +110500 MOVE NINTH-20R TO COMPUTED-A. NC2044.2 +110600 MOVE NINTH-20S TO CORRECT-A. NC2044.2 +110700 PERFORM PRINT-DETAIL. NC2044.2 +110800 MOVE TENTH-20R TO COMPUTED-A. NC2044.2 +110900 MOVE TENTH-20S TO CORRECT-A. NC2044.2 +111000 PERFORM FAIL. NC2044.2 +111100 MOVE "LAST 20 OF 200CHAR FIELD" TO RE-MARK. NC2044.2 +111200 ACC-WRITE-F1-13. NC2044.2 +111300 MOVE "ACC-TEST-F1-13" TO PAR-NAME. NC2044.2 +111400 PERFORM PRINT-DETAIL. NC2044.2 +111500* NC2044.2 +111600 ACC-INIT-F1-14. NC2044.2 +111700 MOVE "VI-71 6.5.4 GR4(A)" TO ANSI-REFERENCE. NC2044.2 +111800 MOVE SPACES TO ACCEPT-TEST-14-DATA. NC2044.2 +111900 MOVE "ACC-TEST-F1-14-1" TO PAR-NAME. NC2044.2 +112000 MOVE "PLEASE PERFORM A VISUAL CHECK TO ENSURE THAT" NC2044.2 +112100 TO RE-MARK. NC2044.2 +112200 PERFORM PRINT-DETAIL. NC2044.2 +112300 MOVE "A REQUEST FOR FURTHER INPUT IS MADE BY THE" NC2044.2 +112400 TO RE-MARK. NC2044.2 +112500 PERFORM PRINT-DETAIL. NC2044.2 +112600 MOVE "HARDWARE DEVICE" TO RE-MARK NC2044.2 +112700 PERFORM PRINT-DETAIL. NC2044.2 +112800 ACC-INIT-F1-14-1. NC2044.2 +112900 MOVE "ACC-TEST-F1-14-1" TO PAR-NAME. NC2044.2 +113000 ACC-TEST-F1-14-1. NC2044.2 +113100 ACCEPT ACCEPT-TEST-14-DATA FROM ACCEPT-INPUT-DEVICE. NC2044.2 +113200 IF ACC-14-CHARS-1-10 = "ABCDEFGHIJ" NC2044.2 +113300 PERFORM PASS NC2044.2 +113400 GO TO ACC-WRITE-F1-14-1. NC2044.2 +113500 GO TO ACC-FAIL-F1-14-1. NC2044.2 +113600 ACC-DELETE-F1-14-1. NC2044.2 +113700 PERFORM DE-LETE. NC2044.2 +113800 GO TO ACC-WRITE-F1-14-1. NC2044.2 +113900 ACC-FAIL-F1-14-1. NC2044.2 +114000 MOVE "ABCDEFGHIJ" TO CORRECT-A NC2044.2 +114100 MOVE ACC-14-CHARS-1-10 TO COMPUTED-A NC2044.2 +114200 PERFORM FAIL. NC2044.2 +114300 ACC-WRITE-F1-14-1. NC2044.2 +114400 PERFORM PRINT-DETAIL. NC2044.2 +114500* NC2044.2 +114600 ACC-INIT-F1-14-2. NC2044.2 +114700 MOVE "ACC-TEST-F1-14-2" TO PAR-NAME. NC2044.2 +114800 ACC-TEST-F1-14-2. NC2044.2 +114900 ACCEPT ACCEPT-TEST-14-DATA FROM ACCEPT-INPUT-DEVICE. NC2044.2 +115000 IF ACC-14-CHARS-11-15 = "KLMNO" NC2044.2 +115100 PERFORM PASS NC2044.2 +115200 GO TO ACC-WRITE-F1-14-2. NC2044.2 +115300 GO TO ACC-FAIL-F1-14-2. NC2044.2 +115400 ACC-DELETE-F1-14-2. NC2044.2 +115500 PERFORM DE-LETE. NC2044.2 +115600 GO TO ACC-WRITE-F1-14-2. NC2044.2 +115700 ACC-FAIL-F1-14-2. NC2044.2 +115800 MOVE "KLMNO" TO CORRECT-A NC2044.2 +115900 MOVE ACC-14-CHARS-11-15 TO COMPUTED-A NC2044.2 +116000 PERFORM FAIL. NC2044.2 +116100 ACC-WRITE-F1-14-2. NC2044.2 +116200 PERFORM PRINT-DETAIL. NC2044.2 +116300 ACCEPT-EXIT. NC2044.2 +116400 GO TO CCVS-EXIT. NC2044.2 +116500 DISPLAY-SUPPORT-1. NC2044.2 +116600 PERFORM BLANK-LINE-PRINT. NC2044.2 +116700 MOVE SPACE TO P-OR-F. NC2044.2 +116800 MOVE SEE-BELOW TO COMPUTED-A. NC2044.2 +116900 MOVE SEE-BELOW TO CORRECT-A. NC2044.2 +117000 PERFORM PRINT-DETAIL. NC2044.2 +117100 MOVE SPACE TO FEATURE. NC2044.2 +117200 DISPLAY TEST-RESULTS UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +117300 DISPLAY-SUPPORT-2. NC2044.2 +117400 MOVE SPACE TO TEST-RESULTS. NC2044.2 +117500 DISPLAY TEST-RESULTS UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +117600 MOVE SPACE TO TEST-RESULTS. NC2044.2 +117700 PERFORM PRINT-DETAIL. NC2044.2 +117800 MOVE CORRECT-FOLLOWS TO RE-MARK. NC2044.2 +117900 PERFORM PRINT-DETAIL. NC2044.2 +118000 PERFORM BLANK-LINE-PRINT. NC2044.2 +118100 MOVE DISPLAY-WRITER TO TEST-RESULTS. NC2044.2 +118200 PERFORM PRINT-DETAIL. NC2044.2 +118300 IF DISPLAY-SWITCH EQUAL TO 1 NC2044.2 +118400 MOVE ZERO TO DISPLAY-SWITCH NC2044.2 +118500 MOVE DISPLAY-H TO DIS-PLAYER NC2044.2 +118600 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +118700 PERFORM PRINT-DETAIL. NC2044.2 +118800 IF DISPLAY-SWITCH EQUAL TO 2 NC2044.2 +118900 MOVE ZERO TO DISPLAY-SWITCH NC2044.2 +119000 MOVE GRP-NUMERIC TO DIS-PLAYER NC2044.2 +119100 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +119200 PERFORM PRINT-DETAIL NC2044.2 +119300 MOVE GRP-ALPHANUMERIC TO DIS-PLAYER NC2044.2 +119400 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +119500 PERFORM PRINT-DETAIL. NC2044.2 +119600 MOVE SPACE TO TEST-RESULTS. NC2044.2 +119700 PERFORM BLANK-LINE-PRINT. NC2044.2 +119800 IF DISPLAY-SWITCH EQUAL TO 1 NC2044.2 +119900 MOVE "SEE NOTE IN DIS-TEST-GF-10" TO RE-MARK NC2044.2 +120000 PERFORM PRINT-DETAIL. NC2044.2 +120100 MOVE "DISPLAY UPON" TO FEATURE. NC2044.2 +120200 MOVE SEE-ABOVE TO COMPUTED-A. NC2044.2 +120300 MOVE SEE-ABOVE TO CORRECT-A. NC2044.2 +120400 MOVE END-CORRECT TO RE-MARK. NC2044.2 +120500 CCVS-EXIT SECTION. NC2044.2 +120600 CCVS-999999. NC2044.2 +120700 GO TO CLOSE-FILES. NC2044.2 +*END-OF,NC204M +*HEADER,DATA*,NC204M +ABCDEFGHIJKLMNOPQRSTUVWXY Z +0123456789 +().+-*/$, = +9 +0 + ABC XYZ + 9 +" +Q +ABCD +ABCD +A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456789 +D001*002*003*004*005*006*007*008*009*010*011*012*013*014*015*016*017*018*019*020 +D021*022*023*024*025*026*027*028*029*030*031*032*033*034*035*036*037*038*039*040 +D041*042*043*044*045*046*047*048*049*050 +ABCDEFGHIJ +KLMNOPQRST +*END-OF,NC204M +*HEADER,COBOL,NC205A +000100 IDENTIFICATION DIVISION. NC2054.2 +000200 PROGRAM-ID. NC2054.2 +000300 NC205A. NC2054.2 +000400* * NC2054.2 +000500**************************************************************** NC2054.2 +000600* * NC2054.2 +000700* VALIDATION FOR:- * NC2054.2 +000800* * NC2054.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +001000* * NC2054.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2054.2 +001200* * NC2054.2 +001300**************************************************************** NC2054.2 +001400* * NC2054.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2054.2 +001600* * NC2054.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2054.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2054.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2054.2 +002000* * NC2054.2 +002100**************************************************************** NC2054.2 +002200* * NC2054.2 +002300* PROGRAM NC205A TESTS THE CONTINUATION OF COBOL WORDS, * NC2054.2 +002400* NUMERIC AND NON-NUMERIC LITERALS AND PICTURE STRINGS USING* NC2054.2 +002500* A HYPHEN IN THE INDICATOR AREA OF CONTINUATION LINES. * NC2054.2 +002600* * NC2054.2 +002700**************************************************************** NC2054.2 +002800 ENVIRONMENT DIVISION. NC2054.2 +002900 CONFIGURATION SECTION. NC2054.2 +003000 SOURCE-COMPUTER. NC2054.2 +003100 XXXXX082. NC2054.2 +003200 OBJECT-COMPUTER. NC2054.2 +003300 XXXXX083. NC2054.2 +003400 INPUT-OUTPUT SECTION. NC2054.2 +003500 FILE-CONTROL. NC2054.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2054.2 +003700 XXXXX055. NC2054.2 +003800 DATA DIVISION. NC2054.2 +003900 FILE SECTION. NC2054.2 +004000 FD PRINT-FILE. NC2054.2 +004100 01 PRINT-REC PICTURE X(120). NC2054.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2054.2 +004300 WORKING-STORAGE SECTION. NC2054.2 +004400 77 WS-TEST-12-DATA NC2054.2 +004500 PIC S9( NC2054.2 +004600- 6)V9(6). NC2054.2 +004700 77 PROCEDURE NC2054.2 +004800- DIVISION PICTURE X. NC2054.2 +004900 77 CONT- NC2054.2 +005000- A PIC NC2054.2 +005100- TURE X(10) VAL NC2054.2 +005200- UE "GOVERNMNC2054.2 +005300- "ENT". NC2054.2 +005400 77 CONT-B PICTURE S9(5)V9(5) VALUE ZERO. NC2054.2 +005500 77 CONT-C PICTURE 9(8). NC2054.2 +005600 77 CONT-D PICTURE 9(5). NC2054.2 +005700 77 CONT-E PICTURE 9999. NC2054.2 +005800 77 CONT-F PICTURE 9(5). NC2054.2 +005900 77 CONT-88 PICTURE S99. NC2054.2 +006000 88 GREATERZERO VALUE -10. NC2054.2 +006100 88 NEGATIVEZERO VALUE +10. NC2054.2 +006200 77 NC2054.2 +006300 NC2054.2 +006400 SPACING-77 NC2054.2 +006500 PICTURE NC2054.2 +006600 NC2054.2 +006700 X(10) VALUENC2054.2 +006800 NC2054.2 +006900 "ABCDE12345". NC2054.2 +007000 77 SPACING-SEND PICTURE 9(10) VALUE 1234567890. NC2054.2 +007100 77 SPACING-RECEIVE PICTURE NC2054.2 +007200 NC2054.2 +007300 NC2054.2 +007400 NC2054.2 +007500 NC2054.2 +007600 NC2054.2 +007700 NC2054.2 +007800 NC2054.2 +007900 NC2054.2 +008000 NC2054.2 +008100 NC2054.2 +008200 NC2054.2 +008300 NC2054.2 +008400 NC2054.2 +008500 NC2054.2 +008600 NC2054.2 +008700 NC2054.2 +008800 NC2054.2 +008900 NC2054.2 +009000 NC2054.2 +009100 NC2054.2 +009200 NC2054.2 +009300 NC2054.2 +009400 NC2054.2 +009500 NC2054.2 +009600 NC2054.2 +009700 NC2054.2 +009800 NC2054.2 +009900 NC2054.2 +010000 NC2054.2 +010100 NC2054.2 +010200 NC2054.2 +010300 NC2054.2 +010400 NC2054.2 +010500 NC2054.2 +010600 NC2054.2 +010700 NC2054.2 +010800 NC2054.2 +010900 NC2054.2 +011000 NC2054.2 +011100 NC2054.2 +011200 NC2054.2 +011300 NC2054.2 +011400 NC2054.2 +011500 NC2054.2 +011600 NC2054.2 +011700 NC2054.2 +011800 NC2054.2 +011900 NC2054.2 +012000 NC2054.2 +012100 NC2054.2 +012200 NC2054.2 +012300 NC2054.2 +012400 NC2054.2 +012500 NC2054.2 +012600 NC2054.2 +012700 NC2054.2 +012800 NC2054.2 +012900 NC2054.2 +013000 NC2054.2 +013100 NC2054.2 +013200 9999999999. NC2054.2 +013300 01 SPACING-01. 02 SPACING-02. 03 SPACING-03 PICTURE XX. 02 NC2054.2 +013400 SPACING-2. 03 SPACING-3. 04 SPACING-4 PICTURE X(8). NC2054.2 +013500 01 CONT-G NC2054.2 +013600- RP. NC2054.2 +013700 02 LEVEL-02. NC2054.2 +013800 03 LEVEL-03.NC2054.2 +013900 04 NC2054.2 +014000 LEVEL- NC2054.2 +014100- 04 PICTURE XXXXXXXXXX. NC2054.2 +014200 01 TEST-RESULTS. NC2054.2 +014300 02 FILLER PIC X VALUE SPACE. NC2054.2 +014400 02 FEATURE PIC X(20) VALUE SPACE. NC2054.2 +014500 02 FILLER PIC X VALUE SPACE. NC2054.2 +014600 02 P-OR-F PIC X(5) VALUE SPACE. NC2054.2 +014700 02 FILLER PIC X VALUE SPACE. NC2054.2 +014800 02 PAR-NAME. NC2054.2 +014900 03 FILLER PIC X(19) VALUE SPACE. NC2054.2 +015000 03 PARDOT-X PIC X VALUE SPACE. NC2054.2 +015100 03 DOTVALUE PIC 99 VALUE ZERO. NC2054.2 +015200 02 FILLER PIC X(8) VALUE SPACE. NC2054.2 +015300 02 RE-MARK PIC X(61). NC2054.2 +015400 01 TEST-COMPUTED. NC2054.2 +015500 02 FILLER PIC X(30) VALUE SPACE. NC2054.2 +015600 02 FILLER PIC X(17) VALUE NC2054.2 +015700 " COMPUTED=". NC2054.2 +015800 02 COMPUTED-X. NC2054.2 +015900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2054.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A NC2054.2 +016100 PIC -9(9).9(9). NC2054.2 +016200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2054.2 +016300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2054.2 +016400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2054.2 +016500 03 CM-18V0 REDEFINES COMPUTED-A. NC2054.2 +016600 04 COMPUTED-18V0 PIC -9(18). NC2054.2 +016700 04 FILLER PIC X. NC2054.2 +016800 03 FILLER PIC X(50) VALUE SPACE. NC2054.2 +016900 01 TEST-CORRECT. NC2054.2 +017000 02 FILLER PIC X(30) VALUE SPACE. NC2054.2 +017100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2054.2 +017200 02 CORRECT-X. NC2054.2 +017300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2054.2 +017400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2054.2 +017500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2054.2 +017600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2054.2 +017700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2054.2 +017800 03 CR-18V0 REDEFINES CORRECT-A. NC2054.2 +017900 04 CORRECT-18V0 PIC -9(18). NC2054.2 +018000 04 FILLER PIC X. NC2054.2 +018100 03 FILLER PIC X(2) VALUE SPACE. NC2054.2 +018200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2054.2 +018300 01 CCVS-C-1. NC2054.2 +018400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2054.2 +018500- "SS PARAGRAPH-NAME NC2054.2 +018600- " REMARKS". NC2054.2 +018700 02 FILLER PIC X(20) VALUE SPACE. NC2054.2 +018800 01 CCVS-C-2. NC2054.2 +018900 02 FILLER PIC X VALUE SPACE. NC2054.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". NC2054.2 +019100 02 FILLER PIC X(15) VALUE SPACE. NC2054.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". NC2054.2 +019300 02 FILLER PIC X(94) VALUE SPACE. NC2054.2 +019400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2054.2 +019500 01 REC-CT PIC 99 VALUE ZERO. NC2054.2 +019600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2054.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2054.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2054.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2054.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2054.2 +020400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2054.2 +020500 01 CCVS-H-1. NC2054.2 +020600 02 FILLER PIC X(39) VALUE SPACES. NC2054.2 +020700 02 FILLER PIC X(42) VALUE NC2054.2 +020800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2054.2 +020900 02 FILLER PIC X(39) VALUE SPACES. NC2054.2 +021000 01 CCVS-H-2A. NC2054.2 +021100 02 FILLER PIC X(40) VALUE SPACE. NC2054.2 +021200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2054.2 +021300 02 FILLER PIC XXXX VALUE NC2054.2 +021400 "4.2 ". NC2054.2 +021500 02 FILLER PIC X(28) VALUE NC2054.2 +021600 " COPY - NOT FOR DISTRIBUTION". NC2054.2 +021700 02 FILLER PIC X(41) VALUE SPACE. NC2054.2 +021800 NC2054.2 +021900 01 CCVS-H-2B. NC2054.2 +022000 02 FILLER PIC X(15) VALUE NC2054.2 +022100 "TEST RESULT OF ". NC2054.2 +022200 02 TEST-ID PIC X(9). NC2054.2 +022300 02 FILLER PIC X(4) VALUE NC2054.2 +022400 " IN ". NC2054.2 +022500 02 FILLER PIC X(12) VALUE NC2054.2 +022600 " HIGH ". NC2054.2 +022700 02 FILLER PIC X(22) VALUE NC2054.2 +022800 " LEVEL VALIDATION FOR ". NC2054.2 +022900 02 FILLER PIC X(58) VALUE NC2054.2 +023000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +023100 01 CCVS-H-3. NC2054.2 +023200 02 FILLER PIC X(34) VALUE NC2054.2 +023300 " FOR OFFICIAL USE ONLY ". NC2054.2 +023400 02 FILLER PIC X(58) VALUE NC2054.2 +023500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2054.2 +023600 02 FILLER PIC X(28) VALUE NC2054.2 +023700 " COPYRIGHT 1985 ". NC2054.2 +023800 01 CCVS-E-1. NC2054.2 +023900 02 FILLER PIC X(52) VALUE SPACE. NC2054.2 +024000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2054.2 +024100 02 ID-AGAIN PIC X(9). NC2054.2 +024200 02 FILLER PIC X(45) VALUE SPACES. NC2054.2 +024300 01 CCVS-E-2. NC2054.2 +024400 02 FILLER PIC X(31) VALUE SPACE. NC2054.2 +024500 02 FILLER PIC X(21) VALUE SPACE. NC2054.2 +024600 02 CCVS-E-2-2. NC2054.2 +024700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2054.2 +024800 03 FILLER PIC X VALUE SPACE. NC2054.2 +024900 03 ENDER-DESC PIC X(44) VALUE NC2054.2 +025000 "ERRORS ENCOUNTERED". NC2054.2 +025100 01 CCVS-E-3. NC2054.2 +025200 02 FILLER PIC X(22) VALUE NC2054.2 +025300 " FOR OFFICIAL USE ONLY". NC2054.2 +025400 02 FILLER PIC X(12) VALUE SPACE. NC2054.2 +025500 02 FILLER PIC X(58) VALUE NC2054.2 +025600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +025700 02 FILLER PIC X(13) VALUE SPACE. NC2054.2 +025800 02 FILLER PIC X(15) VALUE NC2054.2 +025900 " COPYRIGHT 1985". NC2054.2 +026000 01 CCVS-E-4. NC2054.2 +026100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2054.2 +026200 02 FILLER PIC X(4) VALUE " OF ". NC2054.2 +026300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2054.2 +026400 02 FILLER PIC X(40) VALUE NC2054.2 +026500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2054.2 +026600 01 XXINFO. NC2054.2 +026700 02 FILLER PIC X(19) VALUE NC2054.2 +026800 "*** INFORMATION ***". NC2054.2 +026900 02 INFO-TEXT. NC2054.2 +027000 04 FILLER PIC X(8) VALUE SPACE. NC2054.2 +027100 04 XXCOMPUTED PIC X(20). NC2054.2 +027200 04 FILLER PIC X(5) VALUE SPACE. NC2054.2 +027300 04 XXCORRECT PIC X(20). NC2054.2 +027400 02 INF-ANSI-REFERENCE PIC X(48). NC2054.2 +027500 01 HYPHEN-LINE. NC2054.2 +027600 02 FILLER PIC IS X VALUE IS SPACE. NC2054.2 +027700 02 FILLER PIC IS X(65) VALUE IS "************************NC2054.2 +027800- "*****************************************". NC2054.2 +027900 02 FILLER PIC IS X(54) VALUE IS "************************NC2054.2 +028000- "******************************". NC2054.2 +028100 01 CCVS-PGM-ID PIC X(9) VALUE NC2054.2 +028200 "NC205A". NC2054.2 +028300 PROCEDURE DIVISION. NC2054.2 +028400 CCVS1 SECTION. NC2054.2 +028500 OPEN-FILES. NC2054.2 +028600 OPEN OUTPUT PRINT-FILE. NC2054.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2054.2 +028800 MOVE SPACE TO TEST-RESULTS. NC2054.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2054.2 +029000 GO TO CCVS1-EXIT. NC2054.2 +029100 CLOSE-FILES. NC2054.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2054.2 +029300 TERMINATE-CCVS. NC2054.2 +029400S EXIT PROGRAM. NC2054.2 +029500STERMINATE-CALL. NC2054.2 +029600 STOP RUN. NC2054.2 +029700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2054.2 +029800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2054.2 +029900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2054.2 +030000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2054.2 +030100 MOVE "****TEST DELETED****" TO RE-MARK. NC2054.2 +030200 PRINT-DETAIL. NC2054.2 +030300 IF REC-CT NOT EQUAL TO ZERO NC2054.2 +030400 MOVE "." TO PARDOT-X NC2054.2 +030500 MOVE REC-CT TO DOTVALUE. NC2054.2 +030600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2054.2 +030700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2054.2 +030800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2054.2 +030900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2054.2 +031000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2054.2 +031100 MOVE SPACE TO CORRECT-X. NC2054.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2054.2 +031300 MOVE SPACE TO RE-MARK. NC2054.2 +031400 HEAD-ROUTINE. NC2054.2 +031500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +031600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +031700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2054.2 +031800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2054.2 +031900 COLUMN-NAMES-ROUTINE. NC2054.2 +032000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +032100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +032300 END-ROUTINE. NC2054.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2054.2 +032500 END-RTN-EXIT. NC2054.2 +032600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +032700 END-ROUTINE-1. NC2054.2 +032800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2054.2 +032900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2054.2 +033000 ADD PASS-COUNTER TO ERROR-HOLD. NC2054.2 +033100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2054.2 +033200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2054.2 +033300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2054.2 +033400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2054.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2054.2 +033600 END-ROUTINE-12. NC2054.2 +033700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2054.2 +033800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2054.2 +033900 MOVE "NO " TO ERROR-TOTAL NC2054.2 +034000 ELSE NC2054.2 +034100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2054.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2054.2 +034300 PERFORM WRITE-LINE. NC2054.2 +034400 END-ROUTINE-13. NC2054.2 +034500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2054.2 +034600 MOVE "NO " TO ERROR-TOTAL ELSE NC2054.2 +034700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2054.2 +034800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2054.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035000 IF INSPECT-COUNTER EQUAL TO ZERO NC2054.2 +035100 MOVE "NO " TO ERROR-TOTAL NC2054.2 +035200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2054.2 +035300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2054.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035600 WRITE-LINE. NC2054.2 +035700 ADD 1 TO RECORD-COUNT. NC2054.2 +035800Y IF RECORD-COUNT GREATER 50 NC2054.2 +035900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2054.2 +036000Y MOVE SPACE TO DUMMY-RECORD NC2054.2 +036100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2054.2 +036200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2054.2 +036300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2054.2 +036400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2054.2 +036500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2054.2 +036600Y MOVE ZERO TO RECORD-COUNT. NC2054.2 +036700 PERFORM WRT-LN. NC2054.2 +036800 WRT-LN. NC2054.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2054.2 +037000 MOVE SPACE TO DUMMY-RECORD. NC2054.2 +037100 BLANK-LINE-PRINT. NC2054.2 +037200 PERFORM WRT-LN. NC2054.2 +037300 FAIL-ROUTINE. NC2054.2 +037400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2054.2 +037500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2054.2 +037600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2054.2 +037700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2054.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2054.2 +038000 GO TO FAIL-ROUTINE-EX. NC2054.2 +038100 FAIL-ROUTINE-WRITE. NC2054.2 +038200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2054.2 +038300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2054.2 +038400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2054.2 +038500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2054.2 +038600 FAIL-ROUTINE-EX. EXIT. NC2054.2 +038700 BAIL-OUT. NC2054.2 +038800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2054.2 +038900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2054.2 +039000 BAIL-OUT-WRITE. NC2054.2 +039100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2054.2 +039200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2054.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +039400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2054.2 +039500 BAIL-OUT-EX. EXIT. NC2054.2 +039600 CCVS1-EXIT. NC2054.2 +039700 EXIT. NC2054.2 +039800 SECT-NC205A-001 SECTION. NC2054.2 +039900 CON-INIT-GF. NC2054.2 +040000 MOVE "CONTINUATION ---" TO FEATURE. NC2054.2 +040100 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC2054.2 +040200 PERFORM PRINT-DETAIL. NC2054.2 +040300 CON-INIT-GF-1. NC2054.2 +040400 MOVE "CON-TEST-GF-1" TO PAR-NAME NC2054.2 +040500 MOVE " NUMERIC INTEGER" TO FEATURE. NC2054.2 +040600 CON-TEST-GF-1. NC2054.2 +040700 MOVE 4 NC2054.2 +040800- 5 NC2054.2 +040900- 6 NC2054.2 +041000- 7 NC2054.2 +041100- 8 TO CONT-B. NC2054.2 +041200 IF CONT-B EQUAL TO 45678 NC2054.2 +041300 PERFORM PASS NC2054.2 +041400 GO TO CON-WRITE-GF-1. NC2054.2 +041500 GO TO CON-FAIL-GF-1. NC2054.2 +041600 CON-DELETE-GF-1. NC2054.2 +041700 PERFORM DE-LETE. NC2054.2 +041800 GO TO CON-WRITE-GF-1. NC2054.2 +041900 CON-FAIL-GF-1. NC2054.2 +042000 PERFORM FAIL. NC2054.2 +042100 MOVE CONT-B TO COMPUTED-N. NC2054.2 +042200 MOVE 45678 TO CORRECT-N. NC2054.2 +042300 CON-WRITE-GF-1. NC2054.2 +042400 PERFORM PRINT-DETAIL. NC2054.2 +042500* NC2054.2 +042600 CON-INIT-GF-2. NC2054.2 +042700 MOVE "CON-TEST-GF-2" TO PAR-NAME. NC2054.2 +042800 MOVE " NUM NON-INTEGER" TO FEATURE. NC2054.2 +042900 CON-TEST-GF-2. NC2054.2 +043000 MOVE - NC2054.2 +043100- 9 NC2054.2 +043200- 9 NC2054.2 +043300- 9 NC2054.2 +043400- . NC2054.2 +043500- 7 NC2054.2 +043600- 7 NC2054.2 +043700- 7 TO CONT-B. NC2054.2 +043800 IF CONT-B EQUAL TO -999.777 NC2054.2 +043900 PERFORM PASS NC2054.2 +044000 GO TO CON-WRITE-GF-2. NC2054.2 +044100 GO TO CON-FAIL-GF-2. NC2054.2 +044200 CON-DELETE-GF-2. NC2054.2 +044300 PERFORM DE-LETE. NC2054.2 +044400 GO TO CON-WRITE-GF-2. NC2054.2 +044500 CON-FAIL-GF-2. NC2054.2 +044600 PERFORM FAIL. NC2054.2 +044700 MOVE CONT-B TO COMPUTED-N. NC2054.2 +044800 MOVE -999.777 TO CORRECT-N. NC2054.2 +044900 CON-WRITE-GF-2. NC2054.2 +045000 PERFORM PRINT-DETAIL. NC2054.2 +045100* NC2054.2 +045200* N.B. CONTIN-TEST-3 HAS BEEN REMOVED, AND SUBSEQUENT NC2054.2 +045300* TESTS HAVE BEEN RE-NUMBERED. NC2054.2 +045400 CON-INIT-GF-3. NC2054.2 +045500 MOVE " COMP CONDITIONAL" TO FEATURE. NC2054.2 +045600 MOVE "CON-TEST-GF-3" TO PAR-NAME. NC2054.2 +045700 CON-TEST-GF-3. NC2054.2 +045800 MOVE -10 TO CONT-B. NC2054.2 +045900 MOVE 10 TO CONT-C. NC2054.2 +046000 MOVE 1 TO CONT-D. NC2054.2 +046100 MOVE 0 TO CONT-E. NC2054.2 +046200 MOVE 10 TO CONT-F. NC2054.2 +046300 MOVE -10 TO CONT-88. NC2054.2 +046400 IF CONT-E EQUA NC2054.2 +046500- L TO ZERO NC2054.2 +046600- S AN NC2054.2 +046700- D GREATER NC2054.2 +046800- ZERO AND CONT-B NC2054.2 +046900 EQUAL TO CONT-C OR ((((((0 NC2054.2 +047000 NC2054.2 +047100 NC2054.2 +047200 NC2054.2 +047300 NC2054.2 +047400 NC2054.2 +047500 NC2054.2 +047600 NC2054.2 +047700 NC2054.2 +047800 NC2054.2 +047900 NC2054.2 +048000 NC2054.2 +048100 NC2054.2 +048200 NC2054.2 +048300 NC2054.2 +048400 NC2054.2 +048500 NC2054.2 +048600 NC2054.2 +048700 NC2054.2 +048800 NC2054.2 +048900 NC2054.2 +049000 NC2054.2 +049100 NC2054.2 +049200 NC2054.2 +049300 NC2054.2 +049400 NC2054.2 +049500 NC2054.2 +049600 NC2054.2 +049700 NC2054.2 +049800 NC2054.2 +049900 NC2054.2 +050000 NC2054.2 +050100 NC2054.2 +050200 NC2054.2 +050300 NC2054.2 +050400 NC2054.2 +050500 NC2054.2 +050600 NC2054.2 +050700 NC2054.2 +050800 NC2054.2 +050900 NC2054.2 +051000 NC2054.2 +051100 NC2054.2 +051200 NC2054.2 +051300 NC2054.2 +051400 NC2054.2 +051500 NC2054.2 +051600 NC2054.2 +051700 NC2054.2 +051800 NC2054.2 +051900 NC2054.2 +052000 NC2054.2 +052100 NC2054.2 +052200 NC2054.2 +052300 NC2054.2 +052400 NC2054.2 +052500 NC2054.2 +052600 NC2054.2 +052700 NC2054.2 +052800 NC2054.2 +052900 NC2054.2 +053000 NC2054.2 +053100 NC2054.2 +053200 NC2054.2 +053300 NC2054.2 +053400 NC2054.2 +053500 NC2054.2 +053600 NC2054.2 +053700 NC2054.2 +053800 NC2054.2 +053900 NC2054.2 +054000 NC2054.2 +054100 NC2054.2 +054200 NC2054.2 +054300 NC2054.2 +054400 NC2054.2 +054500 NC2054.2 +054600 NC2054.2 +054700 NC2054.2 +054800 NC2054.2 +054900 NC2054.2 +055000 - CONT-D EQUAL TO CONT-D O NC2054.2 +055100- R -11 + CONT-F))))))NC2054.2 +055200 AND N NC2054.2 +055300- OT NEGATIVE NC2054.2 +055400- ZERO NC2054.2 +055500 PERFORM PASS NC2054.2 +055600 EL NC2054.2 +055700- SE NC2054.2 +055800 GO TO CON-FAIL-GF-3. NC2054.2 +055900 GO TO CON-WRITE-GF-3. NC2054.2 +056000 CON-DELETE-GF-3. NC2054.2 +056100 PERFORM DE-LETE. NC2054.2 +056200 GO TO CON-WRITE-GF-3. NC2054.2 +056300 NC2054.2 +056400 NC2054.2 +056500 NC2054.2 +056600 NC2054.2 +056700 CON-FAIL-GF-3. NC2054.2 +056800 PERFORM FAIL. NC2054.2 +056900 CON-WRITE-GF-3. NC2054.2 +057000 PERFORM PRINT-DETAIL. NC2054.2 +057100* NC2054.2 +057200 CON-INIT-GF-4. NC2054.2 +057300 MOVE " RESERVED WORDS" TO FEATURE NC2054.2 +057400 MOVE "CON-TEST-GF-4" TO PAR-NAME. NC2054.2 +057500 MOVE 54321 TO CONT-D. NC2054.2 +057600 MOVE 12 TO CONT-E. NC2054.2 +057700 MOVE 1199997 TO CONT-C. NC2054.2 +057800 CON-TEST-GF-4. NC2054.2 +057900 DIV NC2054.2 +058000- ID NC2054.2 +058100- E CONT-E IN NC2054.2 +058200- TO CONT-C GIV NC2054.2 +058300- IN NC2054.2 +058400- G CONT-D ROUN NC2054.2 +058500- DE NC2054.2 +058600- D O NC2054.2 +058700- N SIZE ERRNC2054.2 +058800- OR PERFOR NC2054.2 +058900- M PASS G NC2054.2 +059000- O T NC2054.2 +059100- O CON-WRITE-GF-4. NC2054.2 +059200 GO TO CON-FAIL-GF-4. NC2054.2 +059300 CON-DELETE-GF-4. NC2054.2 +059400 PERFORM DE-LETE. NC2054.2 +059500 GO TO CON-WRITE-GF-4. NC2054.2 +059600 CON-FAIL-GF-4. NC2054.2 +059700 PERFORM FAIL. NC2054.2 +059800 MOVE CONT-D TO COMPUTED-N. NC2054.2 +059900 MOVE 54321 TO CORRECT-N. NC2054.2 +060000 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC2054.2 +060100 CON-WRITE-GF-4. NC2054.2 +060200 PERFORM PRINT-DETAIL. NC2054.2 +060300* NC2054.2 +060400 CON-INIT-GF-5. NC2054.2 +060500 MOVE " DATA-NAMES" TO FEATURE. NC2054.2 +060600 MOVE "CON-TEST-GF-5" TO PAR-NAME. NC2054.2 +060700 MOVE 10000 TO CONT-D. NC2054.2 +060800 MOVE 1000 TO CONT-F. NC2054.2 +060900 MOVE ZERO TO CONT-C. NC2054.2 +061000 CON-TEST-GF-5. NC2054.2 +061100 IF CONT NC2054.2 +061200- -D EQUAL TO 10000 ADD CONT NC2054.2 +061300- -D CONT NC2054.2 +061400- -F GIVING CONT-NC2054.2 +061500- C. NC2054.2 +061600 IF CONT-C EQUAL TO 11000 NC2054.2 +061700 PERFORM PASS GO TO CON-WRITE-GF-5. NC2054.2 +061800 GO TO CON-FAIL-GF-5. NC2054.2 +061900 CON-DELETE-GF-5. NC2054.2 +062000 PERFORM DE-LETE. NC2054.2 +062100 GO TO CON-WRITE-GF-5. NC2054.2 +062200 CON-FAIL-GF-5. NC2054.2 +062300 PERFORM FAIL. NC2054.2 +062400 MOVE CONT-C TO COMPUTED-A. NC2054.2 +062500 MOVE 11000 TO CORRECT-A. NC2054.2 +062600 CON-WRITE-GF-5. NC2054.2 +062700 PERFORM PRINT-DETAIL. NC2054.2 +062800* NC2054.2 +062900 CON-TEST-GF-6. NC2054.2 +063000 MOVE "CON-TEST-GF-6" TO PAR-NAME. NC2054.2 +063100 MOVE " PARAGRAPH-NAMES" TO FEATURE. NC2054.2 +063200 PERFORM PA NC2054.2 +063300- SS. NC2054.2 +063400 IF P-OR-F NOT EQUAL TO "PASS" GO TO CON-FAIL-GF-6. NC2054.2 +063500 GO TO CON NC2054.2 +063600- -WRITE-GF-6. NC2054.2 +063700 CON-TEST-GF-6-1. NC2054.2 +063800 GO TO CON-FAIL-GF-6. NC2054.2 +063900 CON-DELETE-GF-6. NC2054.2 +064000 PERFORM DE-LETE. NC2054.2 +064100 GO TO CON-WRITE-GF-6. NC2054.2 +064200 CON-FAIL-GF-6. NC2054.2 +064300 PERFORM FAIL. NC2054.2 +064400 MOVE "CNTD PARA-NAME NOT FOUND" TO RE-MARK. NC2054.2 +064500 CON-WRITE-GF-6. NC2054.2 +064600 PERFORM PRINT-DETAIL. NC2054.2 +064700* NC2054.2 +064800* N.B. THE REFERENCE TO THE OLD TEST CALLED NC2054.2 +064900* CONTIN-TEST-8 HAS BEEN REMOVED. NC2054.2 +065000* NOTE TEST MOVED TO SQ215. NC2054.2 +065100* NC2054.2 +065200 CON-INIT-GF-7. NC2054.2 +065300 MOVE " RECORD, ITEM DESCR" TO FEATURE. NC2054.2 +065400 MOVE "CON-TEST-GF-7" TO PAR-NAME. NC2054.2 +065500* N.B. CONT-A IS NOT EXPLICITLY INITIALISED HERE NC2054.2 +065600* BECAUSE THE -VALUE IS- CLAUSE OF THE NC2054.2 +065700* DEFINITION IS UNDER TEST IN THE NEXT PARAGRAPH. NC2054.2 +065800 CON-TEST-GF-7. NC2054.2 +065900 MOVE CONT-A TO CONT-GRP. NC2054.2 +066000 IF LEVEL-04 EQUAL TO "GOVERNMENT" NC2054.2 +066100 PERFORM PASS NC2054.2 +066200 GO TO CON-WRITE-GF-7. NC2054.2 +066300 GO TO CON-FAIL-GF-7. NC2054.2 +066400 CON-DELETE-GF-7. NC2054.2 +066500 PERFORM DE-LETE. NC2054.2 +066600 GO TO CON-WRITE-GF-7. NC2054.2 +066700 CON-FAIL-GF-7. NC2054.2 +066800 PERFORM FAIL. NC2054.2 +066900 MOVE LEVEL-04 TO COMPUTED-A. NC2054.2 +067000 MOVE "GOVERNMENT" TO CORRECT-A. NC2054.2 +067100 CON-WRITE-GF-7. NC2054.2 +067200 PERFORM PRINT-DETAIL. NC2054.2 +067300 CON-INIT-GF-8. NC2054.2 +067400 MOVE "SPACES BETWEEN WORDS" TO FEATURE. NC2054.2 +067500 MOVE "CON-TEST-GF-10" TO PAR-NAME. NC2054.2 +067600 MOVE "ABCDE12345" TO SPACING-77. NC2054.2 +067700 CON-TEST-GF-8. NC2054.2 +067800 MOVE SPACING-77 TO SPACING-01. NC2054.2 +067900 IF SPACING-4 EQUAL TO "CDE12345" NC2054.2 +068000 PERFORM PASS GO TO CON-WRITE-GF-8. NC2054.2 +068100 GO TO CON-FAIL-GF-8. NC2054.2 +068200 CON-DELETE-GF-8. NC2054.2 +068300 PERFORM DE-LETE. NC2054.2 +068400 GO TO CON-WRITE-GF-8. NC2054.2 +068500 CON-FAIL-GF-8. NC2054.2 +068600 PERFORM FAIL. NC2054.2 +068700 MOVE SPACING-4 TO COMPUTED-A. NC2054.2 +068800 MOVE "CDE12345" TO CORRECT-A. NC2054.2 +068900 CON-WRITE-GF-8. NC2054.2 +069000 PERFORM PRINT-DETAIL. NC2054.2 +069100* NC2054.2 +069200 CON-INIT-GF-9. NC2054.2 +069300 MOVE "CON-WRITE-GF-9" TO PAR-NAME. NC2054.2 +069400 MOVE 1234567890 TO SPACING-SEND. NC2054.2 +069500 MOVE SPACING-SEND TO SPACING-RECEIVE. NC2054.2 +069600 CON-TEST-GF-9. NC2054.2 +069700 IF SPACING-RECEIVE EQUAL TO 1234567890 NC2054.2 +069800 PERFORM NC2054.2 +069900 NC2054.2 +070000 NC2054.2 +070100 NC2054.2 +070200 NC2054.2 +070300 NC2054.2 +070400 NC2054.2 +070500 NC2054.2 +070600 NC2054.2 +070700 NC2054.2 +070800 NC2054.2 +070900 NC2054.2 +071000 NC2054.2 +071100 NC2054.2 +071200 NC2054.2 +071300 NC2054.2 +071400 NC2054.2 +071500 NC2054.2 +071600 NC2054.2 +071700 NC2054.2 +071800 NC2054.2 +071900 NC2054.2 +072000 NC2054.2 +072100 NC2054.2 +072200 NC2054.2 +072300 NC2054.2 +072400 NC2054.2 +072500 NC2054.2 +072600 NC2054.2 +072700 NC2054.2 +072800 NC2054.2 +072900 NC2054.2 +073000 NC2054.2 +073100 NC2054.2 +073200 NC2054.2 +073300 NC2054.2 +073400 NC2054.2 +073500 NC2054.2 +073600 NC2054.2 +073700 NC2054.2 +073800 NC2054.2 +073900 NC2054.2 +074000 NC2054.2 +074100 NC2054.2 +074200 NC2054.2 +074300 NC2054.2 +074400 NC2054.2 +074500 NC2054.2 +074600 NC2054.2 +074700 NC2054.2 +074800 NC2054.2 +074900 NC2054.2 +075000 NC2054.2 +075100 NC2054.2 +075200 NC2054.2 +075300 NC2054.2 +075400 NC2054.2 +075500 NC2054.2 +075600 NC2054.2 +075700 NC2054.2 +075800 NC2054.2 +075900 NC2054.2 +076000 NC2054.2 +076100 NC2054.2 +076200 NC2054.2 +076300 NC2054.2 +076400 NC2054.2 +076500 NC2054.2 +076600 NC2054.2 +076700 NC2054.2 +076800 NC2054.2 +076900 PA NC2054.2 +077000- SS GO TO CON-WRITE-GF-9. NC2054.2 +077100 GO TO CON-FAIL-GF-9. NC2054.2 +077200 CON-DELETE-GF-9. NC2054.2 +077300 PERFORM DE-LETE. NC2054.2 +077400 GO TO CON-WRITE-GF-9. NC2054.2 +077500 CON-FAIL-GF-9. NC2054.2 +077600 PERFORM FAIL. NC2054.2 +077700 MOVE SPACING-RECEIVE TO COMPUTED-18V0. NC2054.2 +077800 MOVE 1234567890 TO CORRECT-18V0. NC2054.2 +077900 CON-WRITE-GF-9. NC2054.2 +078000 PERFORM PRINT-DETAIL. NC2054.2 +078100* NC2054.2 +078200 CON-INIT-GF-10. NC2054.2 +078300* ===--> PICTURE CHARACTER STRING CONTINUED <--=== NC2054.2 +078400 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC2054.2 +078500 MOVE "PICTURE STRING CONTINUED" TO FEATURE NC2054.2 +078600 MOVE "CON-TEST-GF-10" TO PAR-NAME. NC2054.2 +078700 CON-TEST-GF-10-1. NC2054.2 +078800 MOVE 654321.987654 TO WS-TEST-12-DATA. NC2054.2 +078900 IF WS-TEST-12-DATA = 654321.987654 NC2054.2 +079000 PERFORM PASS NC2054.2 +079100 GO TO CON-WRITE-GF-10. NC2054.2 +079200 GO TO CON-FAIL-GF-10. NC2054.2 +079300 CON-DELETE-GF-10. NC2054.2 +079400 PERFORM DE-LETE. NC2054.2 +079500 GO TO CON-WRITE-GF-10. NC2054.2 +079600 CON-FAIL-GF-10. NC2054.2 +079700 PERFORM FAIL. NC2054.2 +079800 MOVE WS-TEST-12-DATA TO COMPUTED-N. NC2054.2 +079900 MOVE 654321.987654 TO CORRECT-N. NC2054.2 +080000 CON-WRITE-GF-10. NC2054.2 +080100 PERFORM PRINT-DETAIL. NC2054.2 +080200 CCVS-EXIT SECTION. NC2054.2 +080300 CCVS-999999. NC2054.2 +080400 GO TO CLOSE-FILES. NC2054.2 +*END-OF,NC205A +*HEADER,COBOL,NC206A +000100 IDENTIFICATION DIVISION. NC2064.2 +000200 PROGRAM-ID. NC2064.2 +000300**************************************************************** NC2064.2 +000400* * NC2064.2 +000500* VALIDATION FOR:- * NC2064.2 +000600* * NC2064.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +000800* * NC2064.2 +000900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2064.2 +001000* * NC2064.2 +001100**************************************************************** NC2064.2 +001200* * NC2064.2 +001300* X-CARDS USED BY THIS PROGRAM ARE :- * NC2064.2 +001400* * NC2064.2 +001500* X-55 - SYSTEM PRINTER NAME. * NC2064.2 +001600* X-82 - SOURCE COMPUTER NAME. * NC2064.2 +001700* X-83 - OBJECT COMPUTER NAME. * NC2064.2 +001800* * NC2064.2 +001900**************************************************************** NC2064.2 +002000 NC206A. NC2064.2 +002100* * NC2064.2 +002200* PROGRAM NC206A TESTS THE ACCESSING OF ELEMENTARY ITEMS * NC2064.2 +002300* USING FORMAT 1 QUALIFICATION WITH UP TO 5 LEVELS OF * NC2064.2 +002400* QUALIFIERS. SINGLE DIMENSION TABLES ARE ALSO ACCESSES * NC2064.2 +002500* USING SUBSCRIPTS QUALIFIED TO ONE LEVEL. * NC2064.2 +002600* * NC2064.2 +002700**************************************************************** NC2064.2 +002800 ENVIRONMENT DIVISION. NC2064.2 +002900 CONFIGURATION SECTION. NC2064.2 +003000 SOURCE-COMPUTER. NC2064.2 +003100 XXXXX082. NC2064.2 +003200 OBJECT-COMPUTER. NC2064.2 +003300 XXXXX083. NC2064.2 +003400 INPUT-OUTPUT SECTION. NC2064.2 +003500 FILE-CONTROL. NC2064.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2064.2 +003700 XXXXX055. NC2064.2 +003800 DATA DIVISION. NC2064.2 +003900 FILE SECTION. NC2064.2 +004000 FD PRINT-FILE. NC2064.2 +004100 01 PRINT-REC PICTURE X(120). NC2064.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2064.2 +004300 WORKING-STORAGE SECTION. NC2064.2 +004400 77 MAX-NAME-1 PICTURE S9(18) VALUE +1. NC2064.2 +004500 01 TABLE-LEVEL-5A. NC2064.2 +004600 02 TABLE-LEVEL-4A. NC2064.2 +004700 03 TABLE-LEVEL-3A. NC2064.2 +004800 04 TABLE-LEVEL-2A. NC2064.2 +004900 05 TABLE-LEVEL-1A. NC2064.2 +005000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2A1A0A".NC2064.2 +005100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2A1A0B".NC2064.2 +005200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2A1A0C".NC2064.2 +005300 06 TBL-LEVEL-0D PIC X(12) VALUE "5A4A3A2A1A0D".NC2064.2 +005400 05 TABLE-LEVEL-1B. NC2064.2 +005500 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2A1B0A".NC2064.2 +005600 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2A1B0B".NC2064.2 +005700 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2A1B0C".NC2064.2 +005800 04 TABLE-LEVEL-2B. NC2064.2 +005900 05 TABLE-LEVEL-1A. NC2064.2 +006000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2B1A0A".NC2064.2 +006100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2B1A0B".NC2064.2 +006200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2B1A0C".NC2064.2 +006300 05 TABLE-LEVEL-1B. NC2064.2 +006400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2B1B0A".NC2064.2 +006500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2B1B0B".NC2064.2 +006600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2B1B0C".NC2064.2 +006700 03 TABLE-LEVEL-3B. NC2064.2 +006800 04 TABLE-LEVEL-2A. NC2064.2 +006900 05 TABLE-LEVEL-1A. NC2064.2 +007000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2A1A0A".NC2064.2 +007100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2A1A0B".NC2064.2 +007200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2A1A0C".NC2064.2 +007300 05 TABLE-LEVEL-1B. NC2064.2 +007400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2A1B0A".NC2064.2 +007500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2A1B0B".NC2064.2 +007600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2A1B0C".NC2064.2 +007700 04 TABLE-LEVEL-2B. NC2064.2 +007800 05 TABLE-LEVEL-1A. NC2064.2 +007900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2B1A0A".NC2064.2 +008000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2B1A0B".NC2064.2 +008100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2B1A0C".NC2064.2 +008200 05 TABLE-LEVEL-1B. NC2064.2 +008300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2B1B0A".NC2064.2 +008400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2B1B0B".NC2064.2 +008500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2B1B0C".NC2064.2 +008600 02 TABLE-LEVEL-4B. NC2064.2 +008700 03 TABLE-LEVEL-3A. NC2064.2 +008800 04 TABLE-LEVEL-2A. NC2064.2 +008900 05 TABLE-LEVEL-1A. NC2064.2 +009000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2A1A0A".NC2064.2 +009100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2A1A0B".NC2064.2 +009200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2A1A0C".NC2064.2 +009300 05 TABLE-LEVEL-1B. NC2064.2 +009400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2A1B0A".NC2064.2 +009500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2A1B0B".NC2064.2 +009600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2A1B0C".NC2064.2 +009700 04 TABLE-LEVEL-2B. NC2064.2 +009800 05 TABLE-LEVEL-1A. NC2064.2 +009900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2B1A0A".NC2064.2 +010000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2B1A0B".NC2064.2 +010100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2B1A0C".NC2064.2 +010200 05 TABLE-LEVEL-1B. NC2064.2 +010300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2B1B0A".NC2064.2 +010400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2B1B0B".NC2064.2 +010500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2B1B0C".NC2064.2 +010600 03 TABLE-LEVEL-3B. NC2064.2 +010700 04 TABLE-LEVEL-2A. NC2064.2 +010800 05 TABLE-LEVEL-1A. NC2064.2 +010900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2A1A0A".NC2064.2 +011000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2A1A0B".NC2064.2 +011100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2A1A0C".NC2064.2 +011200 05 TABLE-LEVEL-1B. NC2064.2 +011300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2A1B0A".NC2064.2 +011400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2A1B0B".NC2064.2 +011500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2A1B0C".NC2064.2 +011600 04 TABLE-LEVEL-2B. NC2064.2 +011700 05 TABLE-LEVEL-1A. NC2064.2 +011800 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2B1A0A".NC2064.2 +011900 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2B1A0B".NC2064.2 +012000 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2B1A0C".NC2064.2 +012100 05 TABLE-LEVEL-1B. NC2064.2 +012200 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2B1B0A".NC2064.2 +012300 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2B1B0B".NC2064.2 +012400 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2B1B0C".NC2064.2 +012500 01 TABLE-LEVEL-5B. NC2064.2 +012600 02 TABLE-LEVEL-4A. NC2064.2 +012700 03 TABLE-LEVEL-3A. NC2064.2 +012800 04 TABLE-LEVEL-2A. NC2064.2 +012900 05 TABLE-LEVEL-1A. NC2064.2 +013000 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +013100 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +013200 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +013300 05 TABLE-LEVEL-1B. NC2064.2 +013400 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +013500 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +013600 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +013700 04 TABLE-LEVEL-2B. NC2064.2 +013800 05 TABLE-LEVEL-1A. NC2064.2 +013900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +014000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +014100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +014200 05 TABLE-LEVEL-1B. NC2064.2 +014300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +014400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +014500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +014600 03 TABLE-LEVEL-3B. NC2064.2 +014700 04 TABLE-LEVEL-2A. NC2064.2 +014800 05 TABLE-LEVEL-1A. NC2064.2 +014900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +015100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +015200 05 TABLE-LEVEL-1B. NC2064.2 +015300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +015500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +015600 04 TABLE-LEVEL-2B. NC2064.2 +015700 05 TABLE-LEVEL-1A. NC2064.2 +015800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +016000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +016100 05 TABLE-LEVEL-1B. NC2064.2 +016200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +016300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +016400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +016500 02 TABLE-LEVEL-4B. NC2064.2 +016600 03 TABLE-LEVEL-3A. NC2064.2 +016700 04 TABLE-LEVEL-2A. NC2064.2 +016800 05 TABLE-LEVEL-1A. NC2064.2 +016900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +017100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +017200 05 TABLE-LEVEL-1B. NC2064.2 +017300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +017500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +017600 04 TABLE-LEVEL-2B. NC2064.2 +017700 05 TABLE-LEVEL-1A. NC2064.2 +017800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +018000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +018100 05 TABLE-LEVEL-1B. NC2064.2 +018200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +018300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +018400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +018500 03 TABLE-LEVEL-3B. NC2064.2 +018600 04 TABLE-LEVEL-2A. NC2064.2 +018700 05 TABLE-LEVEL-1A. NC2064.2 +018800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +018900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +019100 05 TABLE-LEVEL-1B. NC2064.2 +019200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +019300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +019500 04 TABLE-LEVEL-2B. NC2064.2 +019600 05 TABLE-LEVEL-1A. NC2064.2 +019700 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +019800 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019900 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +020000 05 TABLE-LEVEL-1B. NC2064.2 +020100 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +020200 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +020300 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +020400 01 QUAL-SUB-TABLE. NC2064.2 +020500 02 AX. NC2064.2 +020600 03 AX-1 OCCURS 5 TIMES. NC2064.2 +020700 04 AX-2 PIC X. NC2064.2 +020800 04 AX-3 PIC X. NC2064.2 +020900 02 BX. NC2064.2 +021000 03 AX-1 OCCURS 2 TIMES. NC2064.2 +021100 04 AX-2 PIC 9. NC2064.2 +021200 04 AX-3 PIC 9. NC2064.2 +021300 02 CX. NC2064.2 +021400 03 CX-SUB PIC 9 VALUE 2. NC2064.2 +021500 02 DX. NC2064.2 +021600 03 CX-SUB USAGE IS INDEX. NC2064.2 +021700 01 TEST-RESULTS. NC2064.2 +021800 02 FILLER PIC X VALUE SPACE. NC2064.2 +021900 02 FEATURE PIC X(20) VALUE SPACE. NC2064.2 +022000 02 FILLER PIC X VALUE SPACE. NC2064.2 +022100 02 P-OR-F PIC X(5) VALUE SPACE. NC2064.2 +022200 02 FILLER PIC X VALUE SPACE. NC2064.2 +022300 02 PAR-NAME. NC2064.2 +022400 03 FILLER PIC X(19) VALUE SPACE. NC2064.2 +022500 03 PARDOT-X PIC X VALUE SPACE. NC2064.2 +022600 03 DOTVALUE PIC 99 VALUE ZERO. NC2064.2 +022700 02 FILLER PIC X(8) VALUE SPACE. NC2064.2 +022800 02 RE-MARK PIC X(61). NC2064.2 +022900 01 TEST-COMPUTED. NC2064.2 +023000 02 FILLER PIC X(30) VALUE SPACE. NC2064.2 +023100 02 FILLER PIC X(17) VALUE NC2064.2 +023200 " COMPUTED=". NC2064.2 +023300 02 COMPUTED-X. NC2064.2 +023400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2064.2 +023500 03 COMPUTED-N REDEFINES COMPUTED-A NC2064.2 +023600 PIC -9(9).9(9). NC2064.2 +023700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2064.2 +023800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2064.2 +023900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2064.2 +024000 03 CM-18V0 REDEFINES COMPUTED-A. NC2064.2 +024100 04 COMPUTED-18V0 PIC -9(18). NC2064.2 +024200 04 FILLER PIC X. NC2064.2 +024300 03 FILLER PIC X(50) VALUE SPACE. NC2064.2 +024400 01 TEST-CORRECT. NC2064.2 +024500 02 FILLER PIC X(30) VALUE SPACE. NC2064.2 +024600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2064.2 +024700 02 CORRECT-X. NC2064.2 +024800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2064.2 +024900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2064.2 +025000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2064.2 +025100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2064.2 +025200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2064.2 +025300 03 CR-18V0 REDEFINES CORRECT-A. NC2064.2 +025400 04 CORRECT-18V0 PIC -9(18). NC2064.2 +025500 04 FILLER PIC X. NC2064.2 +025600 03 FILLER PIC X(2) VALUE SPACE. NC2064.2 +025700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2064.2 +025800 01 CCVS-C-1. NC2064.2 +025900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2064.2 +026000- "SS PARAGRAPH-NAME NC2064.2 +026100- " REMARKS". NC2064.2 +026200 02 FILLER PIC X(20) VALUE SPACE. NC2064.2 +026300 01 CCVS-C-2. NC2064.2 +026400 02 FILLER PIC X VALUE SPACE. NC2064.2 +026500 02 FILLER PIC X(6) VALUE "TESTED". NC2064.2 +026600 02 FILLER PIC X(15) VALUE SPACE. NC2064.2 +026700 02 FILLER PIC X(4) VALUE "FAIL". NC2064.2 +026800 02 FILLER PIC X(94) VALUE SPACE. NC2064.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2064.2 +027000 01 REC-CT PIC 99 VALUE ZERO. NC2064.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2064.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2064.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2064.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2064.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2064.2 +028000 01 CCVS-H-1. NC2064.2 +028100 02 FILLER PIC X(39) VALUE SPACES. NC2064.2 +028200 02 FILLER PIC X(42) VALUE NC2064.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. NC2064.2 +028500 01 CCVS-H-2A. NC2064.2 +028600 02 FILLER PIC X(40) VALUE SPACE. NC2064.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2064.2 +028800 02 FILLER PIC XXXX VALUE NC2064.2 +028900 "4.2 ". NC2064.2 +029000 02 FILLER PIC X(28) VALUE NC2064.2 +029100 " COPY - NOT FOR DISTRIBUTION". NC2064.2 +029200 02 FILLER PIC X(41) VALUE SPACE. NC2064.2 +029300 NC2064.2 +029400 01 CCVS-H-2B. NC2064.2 +029500 02 FILLER PIC X(15) VALUE NC2064.2 +029600 "TEST RESULT OF ". NC2064.2 +029700 02 TEST-ID PIC X(9). NC2064.2 +029800 02 FILLER PIC X(4) VALUE NC2064.2 +029900 " IN ". NC2064.2 +030000 02 FILLER PIC X(12) VALUE NC2064.2 +030100 " HIGH ". NC2064.2 +030200 02 FILLER PIC X(22) VALUE NC2064.2 +030300 " LEVEL VALIDATION FOR ". NC2064.2 +030400 02 FILLER PIC X(58) VALUE NC2064.2 +030500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +030600 01 CCVS-H-3. NC2064.2 +030700 02 FILLER PIC X(34) VALUE NC2064.2 +030800 " FOR OFFICIAL USE ONLY ". NC2064.2 +030900 02 FILLER PIC X(58) VALUE NC2064.2 +031000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2064.2 +031100 02 FILLER PIC X(28) VALUE NC2064.2 +031200 " COPYRIGHT 1985 ". NC2064.2 +031300 01 CCVS-E-1. NC2064.2 +031400 02 FILLER PIC X(52) VALUE SPACE. NC2064.2 +031500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2064.2 +031600 02 ID-AGAIN PIC X(9). NC2064.2 +031700 02 FILLER PIC X(45) VALUE SPACES. NC2064.2 +031800 01 CCVS-E-2. NC2064.2 +031900 02 FILLER PIC X(31) VALUE SPACE. NC2064.2 +032000 02 FILLER PIC X(21) VALUE SPACE. NC2064.2 +032100 02 CCVS-E-2-2. NC2064.2 +032200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2064.2 +032300 03 FILLER PIC X VALUE SPACE. NC2064.2 +032400 03 ENDER-DESC PIC X(44) VALUE NC2064.2 +032500 "ERRORS ENCOUNTERED". NC2064.2 +032600 01 CCVS-E-3. NC2064.2 +032700 02 FILLER PIC X(22) VALUE NC2064.2 +032800 " FOR OFFICIAL USE ONLY". NC2064.2 +032900 02 FILLER PIC X(12) VALUE SPACE. NC2064.2 +033000 02 FILLER PIC X(58) VALUE NC2064.2 +033100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +033200 02 FILLER PIC X(13) VALUE SPACE. NC2064.2 +033300 02 FILLER PIC X(15) VALUE NC2064.2 +033400 " COPYRIGHT 1985". NC2064.2 +033500 01 CCVS-E-4. NC2064.2 +033600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2064.2 +033700 02 FILLER PIC X(4) VALUE " OF ". NC2064.2 +033800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2064.2 +033900 02 FILLER PIC X(40) VALUE NC2064.2 +034000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2064.2 +034100 01 XXINFO. NC2064.2 +034200 02 FILLER PIC X(19) VALUE NC2064.2 +034300 "*** INFORMATION ***". NC2064.2 +034400 02 INFO-TEXT. NC2064.2 +034500 04 FILLER PIC X(8) VALUE SPACE. NC2064.2 +034600 04 XXCOMPUTED PIC X(20). NC2064.2 +034700 04 FILLER PIC X(5) VALUE SPACE. NC2064.2 +034800 04 XXCORRECT PIC X(20). NC2064.2 +034900 02 INF-ANSI-REFERENCE PIC X(48). NC2064.2 +035000 01 HYPHEN-LINE. NC2064.2 +035100 02 FILLER PIC IS X VALUE IS SPACE. NC2064.2 +035200 02 FILLER PIC IS X(65) VALUE IS "************************NC2064.2 +035300- "*****************************************". NC2064.2 +035400 02 FILLER PIC IS X(54) VALUE IS "************************NC2064.2 +035500- "******************************". NC2064.2 +035600 01 CCVS-PGM-ID PIC X(9) VALUE NC2064.2 +035700 "NC206A". NC2064.2 +035800 PROCEDURE DIVISION. NC2064.2 +035900 CCVS1 SECTION. NC2064.2 +036000 OPEN-FILES. NC2064.2 +036100 OPEN OUTPUT PRINT-FILE. NC2064.2 +036200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2064.2 +036300 MOVE SPACE TO TEST-RESULTS. NC2064.2 +036400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2064.2 +036500 GO TO CCVS1-EXIT. NC2064.2 +036600 CLOSE-FILES. NC2064.2 +036700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2064.2 +036800 TERMINATE-CCVS. NC2064.2 +036900S EXIT PROGRAM. NC2064.2 +037000STERMINATE-CALL. NC2064.2 +037100 STOP RUN. NC2064.2 +037200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2064.2 +037300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2064.2 +037400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2064.2 +037500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2064.2 +037600 MOVE "****TEST DELETED****" TO RE-MARK. NC2064.2 +037700 PRINT-DETAIL. NC2064.2 +037800 IF REC-CT NOT EQUAL TO ZERO NC2064.2 +037900 MOVE "." TO PARDOT-X NC2064.2 +038000 MOVE REC-CT TO DOTVALUE. NC2064.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2064.2 +038200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2064.2 +038300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2064.2 +038400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2064.2 +038500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2064.2 +038600 MOVE SPACE TO CORRECT-X. NC2064.2 +038700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2064.2 +038800 MOVE SPACE TO RE-MARK. NC2064.2 +038900 HEAD-ROUTINE. NC2064.2 +039000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2064.2 +039300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2064.2 +039400 COLUMN-NAMES-ROUTINE. NC2064.2 +039500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +039600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +039800 END-ROUTINE. NC2064.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2064.2 +040000 END-RTN-EXIT. NC2064.2 +040100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +040200 END-ROUTINE-1. NC2064.2 +040300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2064.2 +040400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2064.2 +040500 ADD PASS-COUNTER TO ERROR-HOLD. NC2064.2 +040600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2064.2 +040700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2064.2 +040800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2064.2 +040900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2064.2 +041000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2064.2 +041100 END-ROUTINE-12. NC2064.2 +041200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2064.2 +041300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2064.2 +041400 MOVE "NO " TO ERROR-TOTAL NC2064.2 +041500 ELSE NC2064.2 +041600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2064.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2064.2 +041800 PERFORM WRITE-LINE. NC2064.2 +041900 END-ROUTINE-13. NC2064.2 +042000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2064.2 +042100 MOVE "NO " TO ERROR-TOTAL ELSE NC2064.2 +042200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2064.2 +042300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2064.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +042500 IF INSPECT-COUNTER EQUAL TO ZERO NC2064.2 +042600 MOVE "NO " TO ERROR-TOTAL NC2064.2 +042700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2064.2 +042800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2064.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +043000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +043100 WRITE-LINE. NC2064.2 +043200 ADD 1 TO RECORD-COUNT. NC2064.2 +043300Y IF RECORD-COUNT GREATER 50 NC2064.2 +043400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2064.2 +043500Y MOVE SPACE TO DUMMY-RECORD NC2064.2 +043600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2064.2 +043700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2064.2 +043800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2064.2 +043900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2064.2 +044000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2064.2 +044100Y MOVE ZERO TO RECORD-COUNT. NC2064.2 +044200 PERFORM WRT-LN. NC2064.2 +044300 WRT-LN. NC2064.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2064.2 +044500 MOVE SPACE TO DUMMY-RECORD. NC2064.2 +044600 BLANK-LINE-PRINT. NC2064.2 +044700 PERFORM WRT-LN. NC2064.2 +044800 FAIL-ROUTINE. NC2064.2 +044900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2064.2 +045000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2064.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2064.2 +045200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2064.2 +045300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +045400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2064.2 +045500 GO TO FAIL-ROUTINE-EX. NC2064.2 +045600 FAIL-ROUTINE-WRITE. NC2064.2 +045700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2064.2 +045800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2064.2 +045900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2064.2 +046000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2064.2 +046100 FAIL-ROUTINE-EX. EXIT. NC2064.2 +046200 BAIL-OUT. NC2064.2 +046300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2064.2 +046400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2064.2 +046500 BAIL-OUT-WRITE. NC2064.2 +046600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2064.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2064.2 +046800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +046900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2064.2 +047000 BAIL-OUT-EX. EXIT. NC2064.2 +047100 CCVS1-EXIT. NC2064.2 +047200 EXIT. NC2064.2 +047300 SECT-NC206A-001 SECTION. NC2064.2 +047400 NC-06-001. NC2064.2 +047500* 5 LEVELS OF QUALIFICATION ARE USED IN ORDER TO MAKE THE NC2064.2 +047600* IDENTIFIERS UNIQUE. SEE THE 01 WORKING-STORAGE ENTRIES NC2064.2 +047700* CALLED TABLE-LEVEL-5A AND TABLE-LEVEL-5B. NC2064.2 +047800 QAL-INIT-F1-1. NC2064.2 +047900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +048000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +048100 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2064.2 +048200 QAL-TEST-F1-1. NC2064.2 +048300 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +048400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +048500 TO "5A4A3A2A1A0A" NC2064.2 +048600 PERFORM PASS NC2064.2 +048700 GO TO QAL-WRITE-F1-1. NC2064.2 +048800 GO TO QAL-FAIL-F1-1. NC2064.2 +048900 QAL-DELETE-F1-1. NC2064.2 +049000 PERFORM DE-LETE. NC2064.2 +049100 GO TO QAL-WRITE-F1-1. NC2064.2 +049200 QAL-FAIL-F1-1. NC2064.2 +049300 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +049400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +049500 COMPUTED-A. NC2064.2 +049600 MOVE "5A4A3A2A1A0A" TO CORRECT-A. NC2064.2 +049700 PERFORM FAIL. NC2064.2 +049800 QAL-WRITE-F1-1. NC2064.2 +049900 PERFORM PRINT-DETAIL. NC2064.2 +050000* NC2064.2 +050100 QAL-INIT-F1-2. NC2064.2 +050200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +050300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +050400 MOVE "QAL-TEST-F1-2 " TO PAR-NAME. NC2064.2 +050500 QAL-TEST-F1-2. NC2064.2 +050600 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +050700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +050800 TO "5A4A3A2A1B0A" NC2064.2 +050900 PERFORM PASS NC2064.2 +051000 GO TO QAL-WRITE-F1-2. NC2064.2 +051100 GO TO QAL-FAIL-F1-2. NC2064.2 +051200 QAL-DELETE-F1-2. NC2064.2 +051300 PERFORM DE-LETE. NC2064.2 +051400 GO TO QAL-WRITE-F1-2. NC2064.2 +051500 QAL-FAIL-F1-2. NC2064.2 +051600 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +051700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +051800 COMPUTED-A. NC2064.2 +051900 MOVE "5A4A3A2A1B0A" TO CORRECT-A. NC2064.2 +052000 PERFORM FAIL. NC2064.2 +052100 QAL-WRITE-F1-2. NC2064.2 +052200 PERFORM PRINT-DETAIL. NC2064.2 +052300* NC2064.2 +052400 QAL-INIT-F1-3. NC2064.2 +052500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +052600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +052700 MOVE "QAL-TEST-F1-3" TO PAR-NAME. NC2064.2 +052800 QAL-TEST-F1-3. NC2064.2 +052900 IF TBL-LEVEL-0A IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +053000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +053100 TO "5A4A3A2B1A0A" NC2064.2 +053200 PERFORM PASS NC2064.2 +053300 GO TO QAL-WRITE-F1-3. NC2064.2 +053400 GO TO QAL-FAIL-F1-3. NC2064.2 +053500 QAL-DELETE-F1-3. NC2064.2 +053600 PERFORM DE-LETE. NC2064.2 +053700 GO TO QAL-WRITE-F1-3. NC2064.2 +053800 QAL-FAIL-F1-3. NC2064.2 +053900 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +054000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +054100 COMPUTED-A. NC2064.2 +054200 MOVE "5A4A3A2B1A0A" TO CORRECT-A. NC2064.2 +054300 PERFORM FAIL. NC2064.2 +054400 QAL-WRITE-F1-3. NC2064.2 +054500 PERFORM PRINT-DETAIL. NC2064.2 +054600* NC2064.2 +054700 QAL-INIT-F1-4. NC2064.2 +054800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +054900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +055000 MOVE "QAL-TEST-F1-4 " TO PAR-NAME. NC2064.2 +055100 QAL-TEST-F1-4. NC2064.2 +055200 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +055300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +055400 TO "5A4A3A2B1B0A" NC2064.2 +055500 PERFORM PASS NC2064.2 +055600 GO TO QAL-WRITE-F1-4. NC2064.2 +055700 GO TO QAL-FAIL-F1-4. NC2064.2 +055800 QAL-DELETE-F1-4. NC2064.2 +055900 PERFORM DE-LETE. NC2064.2 +056000 GO TO QAL-WRITE-F1-4. NC2064.2 +056100 QAL-FAIL-F1-4. NC2064.2 +056200 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +056300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +056400 COMPUTED-A. NC2064.2 +056500 MOVE "5A4A3A2B1B0A" TO CORRECT-A. NC2064.2 +056600 PERFORM FAIL. NC2064.2 +056700 QAL-WRITE-F1-4. NC2064.2 +056800 PERFORM PRINT-DETAIL. NC2064.2 +056900* NC2064.2 +057000 QAL-INIT-F1-5. NC2064.2 +057100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +057200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +057300 MOVE "QAL-TEST-F1-5 " TO PAR-NAME. NC2064.2 +057400 QAL-TEST-F1-5. NC2064.2 +057500 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +057600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +057700 TO "5A4A3B2A1A0A" NC2064.2 +057800 PERFORM PASS NC2064.2 +057900 GO TO QAL-WRITE-F1-5. NC2064.2 +058000 GO TO QAL-FAIL-F1-5. NC2064.2 +058100 QAL-DELETE-F1-5. NC2064.2 +058200 PERFORM DE-LETE. NC2064.2 +058300 GO TO QAL-WRITE-F1-5. NC2064.2 +058400 QAL-FAIL-F1-5. NC2064.2 +058500 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +058600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +058700 COMPUTED-A. NC2064.2 +058800 MOVE "5A4A3B2A1A0A" TO CORRECT-A. NC2064.2 +058900 PERFORM FAIL. NC2064.2 +059000 QAL-WRITE-F1-5. NC2064.2 +059100 PERFORM PRINT-DETAIL. NC2064.2 +059200* NC2064.2 +059300 QAL-INIT-F1-6. NC2064.2 +059400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +059500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +059600 MOVE "QAL-TEST-F1-6 " TO PAR-NAME. NC2064.2 +059700 QAL-TEST-F1-6. NC2064.2 +059800 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +059900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +060000 TO "5A4A3B2A1B0A" NC2064.2 +060100 PERFORM PASS NC2064.2 +060200 GO TO QAL-WRITE-F1-6. NC2064.2 +060300 GO TO QAL-FAIL-F1-6. NC2064.2 +060400 QAL-DELETE-F1-6. NC2064.2 +060500 PERFORM DE-LETE. NC2064.2 +060600 GO TO QAL-WRITE-F1-6. NC2064.2 +060700 QAL-FAIL-F1-6. NC2064.2 +060800 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +060900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +061000 COMPUTED-A. NC2064.2 +061100 MOVE "5A4A3B2A1B0A" TO CORRECT-A. NC2064.2 +061200 PERFORM FAIL. NC2064.2 +061300 QAL-WRITE-F1-6. NC2064.2 +061400 PERFORM PRINT-DETAIL. NC2064.2 +061500* NC2064.2 +061600 QAL-INIT-F1-7. NC2064.2 +061700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +061800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +061900 MOVE "QAL-TEST-F1-7 " TO PAR-NAME. NC2064.2 +062000 QAL-TEST-F1-7. NC2064.2 +062100 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +062200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +062300 TO "5A4A3B2B1A0A" NC2064.2 +062400 PERFORM PASS NC2064.2 +062500 GO TO QAL-WRITE-F1-7. NC2064.2 +062600 GO TO QAL-FAIL-F1-7. NC2064.2 +062700 QAL-DELETE-F1-7. NC2064.2 +062800 PERFORM DE-LETE. NC2064.2 +062900 GO TO QAL-WRITE-F1-7. NC2064.2 +063000 QAL-FAIL-F1-7. NC2064.2 +063100 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +063200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +063300 COMPUTED-A. NC2064.2 +063400 MOVE "5A4A3B2B1A0A" TO CORRECT-A. NC2064.2 +063500 PERFORM FAIL. NC2064.2 +063600 QAL-WRITE-F1-7. NC2064.2 +063700 PERFORM PRINT-DETAIL. NC2064.2 +063800* NC2064.2 +063900 QAL-INIT-F1-8. NC2064.2 +064000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +064100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +064200 MOVE "QAL-TEST-F1-8 " TO PAR-NAME. NC2064.2 +064300 QAL-TEST-F1-8. NC2064.2 +064400 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +064500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +064600 TO "5A4A3B2B1B0A" NC2064.2 +064700 PERFORM PASS NC2064.2 +064800 GO TO QAL-WRITE-F1-8. NC2064.2 +064900 GO TO QAL-FAIL-F1-8. NC2064.2 +065000 QAL-DELETE-F1-8. NC2064.2 +065100 PERFORM DE-LETE. NC2064.2 +065200 GO TO QAL-WRITE-F1-8. NC2064.2 +065300 QAL-FAIL-F1-8. NC2064.2 +065400 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +065500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +065600 COMPUTED-A. NC2064.2 +065700 MOVE "5A4A3B2B1B0A" TO CORRECT-A. NC2064.2 +065800 PERFORM FAIL. NC2064.2 +065900 QAL-WRITE-F1-8. NC2064.2 +066000 PERFORM PRINT-DETAIL. NC2064.2 +066100* NC2064.2 +066200 QAL-INIT-F1-9. NC2064.2 +066300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +066400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +066500 MOVE "QAL-TEST-F1-9 " TO PAR-NAME. NC2064.2 +066600 QAL-TEST-F1-9. NC2064.2 +066700 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +066800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +066900 TO "5A4B3A2A1A0A" NC2064.2 +067000 PERFORM PASS NC2064.2 +067100 GO TO QAL-WRITE-F1-9. NC2064.2 +067200 GO TO QAL-FAIL-F1-9. NC2064.2 +067300 QAL-DELETE-F1-9. NC2064.2 +067400 PERFORM DE-LETE. NC2064.2 +067500 GO TO QAL-WRITE-F1-9. NC2064.2 +067600 QAL-FAIL-F1-9. NC2064.2 +067700 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +067800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +067900 COMPUTED-A. NC2064.2 +068000 MOVE "5A4B3A2A1A0A" TO CORRECT-A. NC2064.2 +068100 PERFORM FAIL. NC2064.2 +068200 QAL-WRITE-F1-9. NC2064.2 +068300 PERFORM PRINT-DETAIL. NC2064.2 +068400* NC2064.2 +068500 QAL-INIT-F1-10. NC2064.2 +068600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +068700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +068800 MOVE "QAL-TEST-F1-10 " TO PAR-NAME. NC2064.2 +068900 QAL-TEST-F1-10. NC2064.2 +069000 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +069100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +069200 TO "5A4B3A2A1B0A" NC2064.2 +069300 PERFORM PASS NC2064.2 +069400 GO TO QAL-WRITE-F1-10. NC2064.2 +069500 GO TO QAL-FAIL-F1-10. NC2064.2 +069600 QAL-DELETE-F1-10. NC2064.2 +069700 PERFORM DE-LETE. NC2064.2 +069800 GO TO QAL-WRITE-F1-10. NC2064.2 +069900 QAL-FAIL-F1-10. NC2064.2 +070000 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +070100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +070200 COMPUTED-A. NC2064.2 +070300 MOVE "5A4B3A2A1B0A" TO CORRECT-A. NC2064.2 +070400 PERFORM FAIL. NC2064.2 +070500 QAL-WRITE-F1-10. NC2064.2 +070600 PERFORM PRINT-DETAIL. NC2064.2 +070700* NC2064.2 +070800 QAL-INIT-F1-11. NC2064.2 +070900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +071000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +071100 MOVE "QAL-TEST-F1-11 " TO PAR-NAME. NC2064.2 +071200 QAL-TEST-F1-11. NC2064.2 +071300 IF TBL-LEVEL-0A IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +071400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +071500 TO "5A4B3A2B1A0A" NC2064.2 +071600 PERFORM PASS NC2064.2 +071700 GO TO QAL-WRITE-F1-11. NC2064.2 +071800 GO TO QAL-FAIL-F1-11. NC2064.2 +071900 QAL-DELETE-F1-11. NC2064.2 +072000 PERFORM DE-LETE. NC2064.2 +072100 GO TO QAL-WRITE-F1-11. NC2064.2 +072200 QAL-FAIL-F1-11. NC2064.2 +072300 MOVE "5A4B3A2B1A0A" TO CORRECT-A. NC2064.2 +072400 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +072500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +072600 COMPUTED-A. NC2064.2 +072700 PERFORM FAIL. NC2064.2 +072800 QAL-WRITE-F1-11. NC2064.2 +072900 PERFORM PRINT-DETAIL. NC2064.2 +073000* NC2064.2 +073100 QAL-INIT-F1-12. NC2064.2 +073200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +073300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +073400 MOVE "QAL-TEST-F1-12 " TO PAR-NAME. NC2064.2 +073500 QAL-TEST-F1-12. NC2064.2 +073600 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +073700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +073800 TO "5A4B3A2B1B0A" NC2064.2 +073900 PERFORM PASS NC2064.2 +074000 GO TO QAL-WRITE-F1-12. NC2064.2 +074100 GO TO QAL-FAIL-F1-12. NC2064.2 +074200 QAL-DELETE-F1-12. NC2064.2 +074300 PERFORM DE-LETE. NC2064.2 +074400 GO TO QAL-WRITE-F1-12. NC2064.2 +074500 QAL-FAIL-F1-12. NC2064.2 +074600 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +074700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +074800 COMPUTED-A. NC2064.2 +074900 MOVE "5A4B3A2B1B0A" TO CORRECT-A. NC2064.2 +075000 PERFORM FAIL. NC2064.2 +075100 QAL-WRITE-F1-12. NC2064.2 +075200 PERFORM PRINT-DETAIL. NC2064.2 +075300* NC2064.2 +075400 QAL-INIT-F1-13. NC2064.2 +075500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +075600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +075700 MOVE "QAL-TEST-F1-13 " TO PAR-NAME. NC2064.2 +075800 QAL-TEST-F1-13. NC2064.2 +075900 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +076000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +076100 TO "5A4B3B2A1A0A" NC2064.2 +076200 PERFORM PASS NC2064.2 +076300 GO TO QAL-WRITE-F1-13. NC2064.2 +076400 GO TO QAL-FAIL-F1-13. NC2064.2 +076500 QAL-DELETE-F1-13. NC2064.2 +076600 PERFORM DE-LETE. NC2064.2 +076700 GO TO QAL-WRITE-F1-13. NC2064.2 +076800 QAL-FAIL-F1-13. NC2064.2 +076900 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +077000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +077100 TO COMPUTED-A. NC2064.2 +077200 MOVE "5A4B3B2A1A0A" TO CORRECT-A. NC2064.2 +077300 PERFORM FAIL. NC2064.2 +077400 QAL-WRITE-F1-13. NC2064.2 +077500 PERFORM PRINT-DETAIL. NC2064.2 +077600* NC2064.2 +077700 QAL-INIT-F1-14. NC2064.2 +077800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +077900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +078000 MOVE "QAL-TEST-F1-14 " TO PAR-NAME. NC2064.2 +078100 QAL-TEST-F1-14. NC2064.2 +078200 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +078300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +078400 TO "5A4B3B2A1B0A" NC2064.2 +078500 PERFORM PASS NC2064.2 +078600 GO TO QAL-WRITE-F1-14. NC2064.2 +078700 GO TO QAL-FAIL-F1-14. NC2064.2 +078800 QAL-DELETE-F1-14. NC2064.2 +078900 PERFORM DE-LETE. NC2064.2 +079000 GO TO QAL-WRITE-F1-14. NC2064.2 +079100 QAL-FAIL-F1-14. NC2064.2 +079200 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +079300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +079400 COMPUTED-A. NC2064.2 +079500 MOVE "5A4B3B2A1B0A" TO CORRECT-A. NC2064.2 +079600 PERFORM FAIL. NC2064.2 +079700 QAL-WRITE-F1-14. NC2064.2 +079800 PERFORM PRINT-DETAIL. NC2064.2 +079900* NC2064.2 +080000 QAL-INIT-F1-15. NC2064.2 +080100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +080200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +080300 MOVE "QAL-TEST-F1-15 " TO PAR-NAME. NC2064.2 +080400 QAL-TEST-F1-15. NC2064.2 +080500 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +080600 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +080700 TO "5A4B3B2B1A0A" NC2064.2 +080800 PERFORM PASS NC2064.2 +080900 GO TO QAL-WRITE-F1-15. NC2064.2 +081000 GO TO QAL-FAIL-F1-15. NC2064.2 +081100 QAL-DELETE-F1-15. NC2064.2 +081200 PERFORM DE-LETE. NC2064.2 +081300 GO TO QAL-WRITE-F1-15. NC2064.2 +081400 QAL-FAIL-F1-15. NC2064.2 +081500 MOVE "5A4B3B2B1A0A" TO CORRECT-A. NC2064.2 +081600 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +081700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +081800 COMPUTED-A. NC2064.2 +081900 PERFORM FAIL. NC2064.2 +082000 QAL-WRITE-F1-15. NC2064.2 +082100 PERFORM PRINT-DETAIL. NC2064.2 +082200* NC2064.2 +082300 QAL-INIT-F1-16. NC2064.2 +082400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +082500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +082600 MOVE "QAL-TEST-F1-16 " TO PAR-NAME. NC2064.2 +082700 QAL-TEST-F1-16. NC2064.2 +082800 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +082900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +083000 TO "5A4B3B2B1B0A" NC2064.2 +083100 PERFORM PASS NC2064.2 +083200 GO TO QAL-WRITE-F1-16. NC2064.2 +083300 GO TO QAL-FAIL-F1-16. NC2064.2 +083400 QAL-DELETE-F1-16. NC2064.2 +083500 PERFORM DE-LETE. NC2064.2 +083600 GO TO QAL-WRITE-F1-16. NC2064.2 +083700 QAL-FAIL-F1-16. NC2064.2 +083800 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +083900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +084000 COMPUTED-A. NC2064.2 +084100 MOVE "5A4B3B2B1B0A" TO CORRECT-A. NC2064.2 +084200 PERFORM FAIL. NC2064.2 +084300 QAL-WRITE-F1-16. NC2064.2 +084400 PERFORM PRINT-DETAIL. NC2064.2 +084500* NC2064.2 +084600 QAL-INIT-F1-17. NC2064.2 +084700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +084800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +084900 MOVE "QAL-TEST-F1-17" TO PAR-NAME. NC2064.2 +085000 QAL-TEST-F1-17. NC2064.2 +085100 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +085200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +085300 TO "5A4A3A2A1A0B" NC2064.2 +085400 PERFORM PASS NC2064.2 +085500 GO TO QAL-WRITE-F1-17. NC2064.2 +085600 GO TO QAL-FAIL-F1-17. NC2064.2 +085700 QAL-DELETE-F1-17. NC2064.2 +085800 PERFORM DE-LETE. NC2064.2 +085900 GO TO QAL-WRITE-F1-17. NC2064.2 +086000 QAL-FAIL-F1-17. NC2064.2 +086100 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +086200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +086300 COMPUTED-A. NC2064.2 +086400 MOVE "5A4A3A2A1A0B" TO CORRECT-A. NC2064.2 +086500 PERFORM FAIL. NC2064.2 +086600 QAL-WRITE-F1-17. NC2064.2 +086700 PERFORM PRINT-DETAIL. NC2064.2 +086800* NC2064.2 +086900 QAL-INIT-F1-18. NC2064.2 +087000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +087100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +087200 MOVE "QAL-TEST-F1-18" TO PAR-NAME. NC2064.2 +087300 QAL-TEST-F1-18. NC2064.2 +087400 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +087500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +087600 TO "5A4A3A2A1B0B" NC2064.2 +087700 PERFORM PASS NC2064.2 +087800 GO TO QAL-WRITE-F1-18. NC2064.2 +087900 GO TO QAL-FAIL-F1-18. NC2064.2 +088000 QAL-DELETE-F1-18. NC2064.2 +088100 PERFORM DE-LETE. NC2064.2 +088200 GO TO QAL-WRITE-F1-18. NC2064.2 +088300 QAL-FAIL-F1-18. NC2064.2 +088400 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +088500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +088600 COMPUTED-A. NC2064.2 +088700 MOVE "5A4A3A2A1B0B" TO CORRECT-A. NC2064.2 +088800 PERFORM FAIL. NC2064.2 +088900 QAL-WRITE-F1-18. NC2064.2 +089000 PERFORM PRINT-DETAIL. NC2064.2 +089100* NC2064.2 +089200 QAL-INIT-F1-19. NC2064.2 +089300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +089400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +089500 MOVE "QAL-TEST-F1-19" TO PAR-NAME. NC2064.2 +089600 QAL-TEST-F1-19. NC2064.2 +089700 IF TBL-LEVEL-0B IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +089800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +089900 TO "5A4A3A2B1A0B" NC2064.2 +090000 PERFORM PASS NC2064.2 +090100 GO TO QAL-WRITE-F1-19. NC2064.2 +090200 GO TO QAL-FAIL-F1-19. NC2064.2 +090300 QAL-DELETE-F1-19. NC2064.2 +090400 PERFORM DE-LETE. NC2064.2 +090500 GO TO QAL-WRITE-F1-19. NC2064.2 +090600 QAL-FAIL-F1-19. NC2064.2 +090700 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +090800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +090900 COMPUTED-A. NC2064.2 +091000 MOVE "5A4A3A2B1A0B" TO CORRECT-A. NC2064.2 +091100 PERFORM FAIL. NC2064.2 +091200 QAL-WRITE-F1-19. NC2064.2 +091300 PERFORM PRINT-DETAIL. NC2064.2 +091400* NC2064.2 +091500 QAL-INIT-F1-20. NC2064.2 +091600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +091700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +091800 MOVE "QAL-TEST-F1-20" TO PAR-NAME. NC2064.2 +091900 QAL-TEST-F1-20. NC2064.2 +092000 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +092100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +092200 TO "5A4A3A2B1B0B" NC2064.2 +092300 PERFORM PASS NC2064.2 +092400 GO TO QAL-WRITE-F1-20. NC2064.2 +092500 GO TO QAL-FAIL-F1-20. NC2064.2 +092600 QAL-DELETE-F1-20. NC2064.2 +092700 PERFORM DE-LETE. NC2064.2 +092800 GO TO QAL-WRITE-F1-20. NC2064.2 +092900 QAL-FAIL-F1-20. NC2064.2 +093000 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +093100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +093200 COMPUTED-A. NC2064.2 +093300 MOVE "5A4A3A2B1B0B" TO CORRECT-A. NC2064.2 +093400 PERFORM FAIL. NC2064.2 +093500 QAL-WRITE-F1-20. NC2064.2 +093600 PERFORM PRINT-DETAIL. NC2064.2 +093700* NC2064.2 +093800 QAL-INIT-F1-21. NC2064.2 +093900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +094000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +094100 MOVE "QAL-TEST-F1-21" TO PAR-NAME. NC2064.2 +094200 QAL-TEST-F1-21. NC2064.2 +094300 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +094400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +094500 TO "5A4A3B2A1A0B" NC2064.2 +094600 PERFORM PASS NC2064.2 +094700 GO TO QAL-WRITE-F1-21. NC2064.2 +094800 GO TO QAL-FAIL-F1-21. NC2064.2 +094900 QAL-DELETE-F1-21. NC2064.2 +095000 PERFORM DE-LETE. NC2064.2 +095100 GO TO QAL-WRITE-F1-21. NC2064.2 +095200 QAL-FAIL-F1-21. NC2064.2 +095300 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +095400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +095500 COMPUTED-A. NC2064.2 +095600 MOVE "5A4A3B2A1A0B" TO CORRECT-A. NC2064.2 +095700 PERFORM FAIL. NC2064.2 +095800 QAL-WRITE-F1-21. NC2064.2 +095900 PERFORM PRINT-DETAIL. NC2064.2 +096000* NC2064.2 +096100 QAL-INIT-F1-22. NC2064.2 +096200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +096300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +096400 MOVE "QAL-TEST-F1-22" TO PAR-NAME. NC2064.2 +096500 QAL-TEST-F1-22. NC2064.2 +096600 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +096700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +096800 TO "5A4A3B2A1B0B" NC2064.2 +096900 PERFORM PASS NC2064.2 +097000 GO TO QAL-WRITE-F1-22. NC2064.2 +097100 GO TO QAL-FAIL-F1-22. NC2064.2 +097200 QAL-DELETE-F1-22. NC2064.2 +097300 PERFORM DE-LETE. NC2064.2 +097400 GO TO QAL-WRITE-F1-22. NC2064.2 +097500 QAL-FAIL-F1-22. NC2064.2 +097600 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +097700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +097800 COMPUTED-A. NC2064.2 +097900 MOVE "5A4A3B2A1B0B" TO CORRECT-A. NC2064.2 +098000 PERFORM FAIL. NC2064.2 +098100 QAL-WRITE-F1-22. NC2064.2 +098200 PERFORM PRINT-DETAIL. NC2064.2 +098300* NC2064.2 +098400 QAL-INIT-F1-23. NC2064.2 +098500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +098600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +098700 MOVE "QAL-TEST-F1-23" TO PAR-NAME. NC2064.2 +098800 QAL-TEST-F1-23. NC2064.2 +098900 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +099000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +099100 TO "5A4A3B2B1A0B" NC2064.2 +099200 PERFORM PASS NC2064.2 +099300 GO TO QAL-WRITE-F1-23. NC2064.2 +099400 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +099500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +099600 COMPUTED-A. NC2064.2 +099700 MOVE "5A4A3B2B1A0B" TO CORRECT-A. NC2064.2 +099800 PERFORM FAIL. NC2064.2 +099900 GO TO QAL-WRITE-F1-23. NC2064.2 +100000 QAL-DELETE-F1-23. NC2064.2 +100100 PERFORM DE-LETE. NC2064.2 +100200 QAL-WRITE-F1-23. NC2064.2 +100300 PERFORM PRINT-DETAIL. NC2064.2 +100400* NC2064.2 +100500 QAL-INIT-F1-24. NC2064.2 +100600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +100700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +100800 MOVE "QAL-TEST-F1-24" TO PAR-NAME. NC2064.2 +100900 QAL-TEST-F1-24. NC2064.2 +101000 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +101100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +101200 TO "5A4A3B2B1B0B" NC2064.2 +101300 PERFORM PASS NC2064.2 +101400 GO TO QAL-WRITE-F1-24. NC2064.2 +101500 GO TO QAL-FAIL-F1-24. NC2064.2 +101600 QAL-DELETE-F1-24. NC2064.2 +101700 PERFORM DE-LETE. NC2064.2 +101800 GO TO QAL-WRITE-F1-24. NC2064.2 +101900 QAL-FAIL-F1-24. NC2064.2 +102000 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +102100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +102200 COMPUTED-A. NC2064.2 +102300 MOVE "5A4A3B2B1B0B" TO CORRECT-A. NC2064.2 +102400 PERFORM FAIL. NC2064.2 +102500 QAL-WRITE-F1-24. NC2064.2 +102600 PERFORM PRINT-DETAIL. NC2064.2 +102700* NC2064.2 +102800 QAL-INIT-F1-25. NC2064.2 +102900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +103000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +103100 MOVE "QAL-TEST-F1-25" TO PAR-NAME. NC2064.2 +103200 QAL-TEST-F1-25. NC2064.2 +103300 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +103400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +103500 TO "5A4B3A2A1A0B" NC2064.2 +103600 PERFORM PASS NC2064.2 +103700 GO TO QAL-WRITE-F1-25. NC2064.2 +103800 GO TO QAL-FAIL-F1-25. NC2064.2 +103900 QAL-DELETE-F1-25. NC2064.2 +104000 PERFORM DE-LETE. NC2064.2 +104100 GO TO QAL-WRITE-F1-25. NC2064.2 +104200 QAL-FAIL-F1-25. NC2064.2 +104300 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +104400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +104500 COMPUTED-A. NC2064.2 +104600 MOVE "5A4B3A2A1A0B" TO CORRECT-A. NC2064.2 +104700 PERFORM FAIL. NC2064.2 +104800 QAL-WRITE-F1-25. NC2064.2 +104900 PERFORM PRINT-DETAIL. NC2064.2 +105000* NC2064.2 +105100 QAL-INIT-F1-26. NC2064.2 +105200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +105300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +105400 MOVE "QAL-TEST-F1-26" TO PAR-NAME. NC2064.2 +105500 QAL-TEST-F1-26. NC2064.2 +105600 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +105700 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +105800 TO "5A4B3A2A1B0B" NC2064.2 +105900 PERFORM PASS NC2064.2 +106000 GO TO QAL-WRITE-F1-26. NC2064.2 +106100 GO TO QAL-FAIL-F1-26. NC2064.2 +106200 QAL-DELETE-F1-26. NC2064.2 +106300 PERFORM DE-LETE. NC2064.2 +106400 GO TO QAL-WRITE-F1-26. NC2064.2 +106500 QAL-FAIL-F1-26. NC2064.2 +106600 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +106700 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +106800 COMPUTED-A. NC2064.2 +106900 MOVE "5A4B3A2A1B0B" TO CORRECT-A. NC2064.2 +107000 PERFORM FAIL. NC2064.2 +107100 QAL-WRITE-F1-26. NC2064.2 +107200 PERFORM PRINT-DETAIL. NC2064.2 +107300* NC2064.2 +107400 QAL-INIT-F1-27. NC2064.2 +107500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +107600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +107700 MOVE "QAL-TEST-F1-27" TO PAR-NAME. NC2064.2 +107800 QAL-TEST-F1-27. NC2064.2 +107900 IF TBL-LEVEL-0B IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +108000 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +108100 TO "5A4B3A2B1A0B" NC2064.2 +108200 PERFORM PASS NC2064.2 +108300 GO TO QAL-WRITE-F1-27. NC2064.2 +108400 GO TO QAL-FAIL-F1-27. NC2064.2 +108500 QAL-DELETE-F1-27. NC2064.2 +108600 PERFORM DE-LETE. NC2064.2 +108700 GO TO QAL-WRITE-F1-27. NC2064.2 +108800 QAL-FAIL-F1-27. NC2064.2 +108900 MOVE "5A4B3A2B1A0B" TO CORRECT-A. NC2064.2 +109000 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +109100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +109200 COMPUTED-A. NC2064.2 +109300 PERFORM FAIL. NC2064.2 +109400 QAL-WRITE-F1-27. NC2064.2 +109500 PERFORM PRINT-DETAIL. NC2064.2 +109600* NC2064.2 +109700 QAL-INIT-F1-28. NC2064.2 +109800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +109900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +110000 MOVE "QAL-TEST-F1-28" TO PAR-NAME. NC2064.2 +110100 QAL-TEST-F1-28. NC2064.2 +110200 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +110300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +110400 TO "5A4B3A2B1B0B" NC2064.2 +110500 PERFORM PASS NC2064.2 +110600 GO TO QAL-WRITE-F1-28. NC2064.2 +110700 GO TO QAL-FAIL-F1-28. NC2064.2 +110800 QAL-DELETE-F1-28. NC2064.2 +110900 PERFORM DE-LETE. NC2064.2 +111000 GO TO QAL-WRITE-F1-28. NC2064.2 +111100 QAL-FAIL-F1-28. NC2064.2 +111200 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +111300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +111400 COMPUTED-A. NC2064.2 +111500 MOVE "5A4B3A2B1B0B" TO CORRECT-A. NC2064.2 +111600 PERFORM FAIL. NC2064.2 +111700 QAL-WRITE-F1-28. NC2064.2 +111800 PERFORM PRINT-DETAIL. NC2064.2 +111900* NC2064.2 +112000 QAL-INIT-F1-29. NC2064.2 +112100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +112200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +112300 MOVE "QAL-TEST-F1-29" TO PAR-NAME. NC2064.2 +112400 QAL-TEST-F1-29. NC2064.2 +112500 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +112600 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +112700 TO "5A4B3B2A1A0B" NC2064.2 +112800 PERFORM PASS NC2064.2 +112900 GO TO QAL-WRITE-F1-29. NC2064.2 +113000 GO TO QAL-FAIL-F1-29. NC2064.2 +113100 QAL-DELETE-F1-29. NC2064.2 +113200 PERFORM DE-LETE. NC2064.2 +113300 GO TO QAL-WRITE-F1-29. NC2064.2 +113400 QAL-FAIL-F1-29. NC2064.2 +113500 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +113600 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +113700 TO COMPUTED-A. NC2064.2 +113800 MOVE "5A4B3B2A1A0B" TO CORRECT-A. NC2064.2 +113900 PERFORM FAIL. NC2064.2 +114000 QAL-WRITE-F1-29. NC2064.2 +114100 PERFORM PRINT-DETAIL. NC2064.2 +114200* NC2064.2 +114300 QAL-INIT-F1-30. NC2064.2 +114400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +114500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +114600 MOVE "QAL-TEST-F1-30" TO PAR-NAME. NC2064.2 +114700 QAL-TEST-F1-30. NC2064.2 +114800 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +114900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +115000 TO "5A4B3B2A1B0B" NC2064.2 +115100 PERFORM PASS NC2064.2 +115200 GO TO QAL-WRITE-F1-30. NC2064.2 +115300 GO TO QAL-FAIL-F1-30. NC2064.2 +115400 QAL-DELETE-F1-30. NC2064.2 +115500 PERFORM DE-LETE. NC2064.2 +115600 GO TO QAL-WRITE-F1-30. NC2064.2 +115700 QAL-FAIL-F1-30. NC2064.2 +115800 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +115900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +116000 COMPUTED-A. NC2064.2 +116100 MOVE "5A4B3B2A1B0B" TO CORRECT-A. NC2064.2 +116200 PERFORM FAIL. NC2064.2 +116300 QAL-WRITE-F1-30. NC2064.2 +116400 PERFORM PRINT-DETAIL. NC2064.2 +116500* NC2064.2 +116600 QAL-INIT-F1-31. NC2064.2 +116700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +116800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +116900 MOVE "QAL-TEST-F1-31" TO PAR-NAME. NC2064.2 +117000 QAL-TEST-F1-31. NC2064.2 +117100 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +117200 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +117300 TO "5A4B3B2B1A0B" NC2064.2 +117400 PERFORM PASS NC2064.2 +117500 GO TO QAL-WRITE-F1-31. NC2064.2 +117600 GO TO QAL-FAIL-F1-31. NC2064.2 +117700 QAL-DELETE-F1-31. NC2064.2 +117800 PERFORM DE-LETE. NC2064.2 +117900 GO TO QAL-WRITE-F1-31. NC2064.2 +118000 QAL-FAIL-F1-31. NC2064.2 +118100 MOVE "5A4B3B2B1A0B" TO CORRECT-A. NC2064.2 +118200 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +118300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +118400 COMPUTED-A. NC2064.2 +118500 PERFORM FAIL. NC2064.2 +118600 QAL-WRITE-F1-31. NC2064.2 +118700 PERFORM PRINT-DETAIL. NC2064.2 +118800* NC2064.2 +118900 QAL-INIT-F1-32. NC2064.2 +119000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +119100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +119200 MOVE "QAL-TEST-F1-32" TO PAR-NAME. NC2064.2 +119300 QAL-TEST-F1-32. NC2064.2 +119400 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +119500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +119600 TO "5A4B3B2B1B0B" NC2064.2 +119700 PERFORM PASS NC2064.2 +119800 GO TO QAL-WRITE-F1-32. NC2064.2 +119900 GO TO QAL-FAIL-F1-32. NC2064.2 +120000 QAL-DELETE-F1-32. NC2064.2 +120100 PERFORM DE-LETE. NC2064.2 +120200 GO TO QAL-WRITE-F1-32. NC2064.2 +120300 QAL-FAIL-F1-32. NC2064.2 +120400 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +120500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +120600 COMPUTED-A. NC2064.2 +120700 MOVE "5A4B3B2B1B0B" TO CORRECT-A. NC2064.2 +120800 PERFORM FAIL. NC2064.2 +120900 QAL-WRITE-F1-32. NC2064.2 +121000 PERFORM PRINT-DETAIL. NC2064.2 +121100* NC2064.2 +121200 QAL-INIT-F1-33. NC2064.2 +121300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +121400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +121500 MOVE "QAL-TEST-F1-33" TO PAR-NAME. NC2064.2 +121600 QAL-TEST-F1-33. NC2064.2 +121700 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +121800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +121900 TO "5A4A3A2A1A0C" NC2064.2 +122000 PERFORM PASS NC2064.2 +122100 GO TO QAL-WRITE-F1-33. NC2064.2 +122200 GO TO QAL-FAIL-F1-33. NC2064.2 +122300 QAL-DELETE-F1-33. NC2064.2 +122400 PERFORM DE-LETE. NC2064.2 +122500 GO TO QAL-WRITE-F1-33. NC2064.2 +122600 QAL-FAIL-F1-33. NC2064.2 +122700 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +122800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +122900 COMPUTED-A. NC2064.2 +123000 MOVE "5A4A3A2A1A0C" TO CORRECT-A. NC2064.2 +123100 PERFORM FAIL. NC2064.2 +123200 QAL-WRITE-F1-33. NC2064.2 +123300 PERFORM PRINT-DETAIL. NC2064.2 +123400* NC2064.2 +123500 QAL-INIT-F1-34. NC2064.2 +123600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +123700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +123800 MOVE "QAL-TEST-F1-34" TO PAR-NAME. NC2064.2 +123900 QAL-TEST-F1-34. NC2064.2 +124000 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +124100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +124200 TO "5A4A3A2A1B0C" NC2064.2 +124300 PERFORM PASS NC2064.2 +124400 GO TO QAL-WRITE-F1-34. NC2064.2 +124500 GO TO QAL-FAIL-F1-34. NC2064.2 +124600 QAL-DELETE-F1-34. NC2064.2 +124700 PERFORM DE-LETE. NC2064.2 +124800 GO TO QAL-WRITE-F1-34. NC2064.2 +124900 QAL-FAIL-F1-34. NC2064.2 +125000 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +125100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +125200 COMPUTED-A. NC2064.2 +125300 MOVE "5A4A3A2A1B0C" TO CORRECT-A. NC2064.2 +125400 PERFORM FAIL. NC2064.2 +125500 QAL-WRITE-F1-34. NC2064.2 +125600 PERFORM PRINT-DETAIL. NC2064.2 +125700* NC2064.2 +125800 QAL-INIT-F1-35. NC2064.2 +125900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +126000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +126100 MOVE "QAL-TEST-F1-35" TO PAR-NAME. NC2064.2 +126200 QAL-TEST-F1-35. NC2064.2 +126300 IF TBL-LEVEL-0C IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +126400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +126500 TO "5A4A3A2B1A0C" NC2064.2 +126600 PERFORM PASS NC2064.2 +126700 GO TO QAL-WRITE-F1-35. NC2064.2 +126800 GO TO QAL-FAIL-F1-35. NC2064.2 +126900 QAL-DELETE-F1-35. NC2064.2 +127000 PERFORM DE-LETE. NC2064.2 +127100 GO TO QAL-WRITE-F1-35. NC2064.2 +127200 QAL-FAIL-F1-35. NC2064.2 +127300 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +127400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +127500 COMPUTED-A. NC2064.2 +127600 MOVE "5A4A3A2B1A0C" TO CORRECT-A. NC2064.2 +127700 PERFORM FAIL. NC2064.2 +127800 QAL-WRITE-F1-35. NC2064.2 +127900 PERFORM PRINT-DETAIL. NC2064.2 +128000* NC2064.2 +128100 QAL-INIT-F1-36. NC2064.2 +128200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +128300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +128400 MOVE "QAL-TEST-F1-36" TO PAR-NAME. NC2064.2 +128500 QAL-TEST-F1-36. NC2064.2 +128600 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +128700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +128800 TO "5A4A3A2B1B0C" NC2064.2 +128900 PERFORM PASS NC2064.2 +129000 GO TO QAL-WRITE-F1-36. NC2064.2 +129100 GO TO QAL-FAIL-F1-36. NC2064.2 +129200 QAL-DELETE-F1-36. NC2064.2 +129300 PERFORM DE-LETE. NC2064.2 +129400 GO TO QAL-WRITE-F1-36. NC2064.2 +129500 QAL-FAIL-F1-36. NC2064.2 +129600 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +129700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +129800 COMPUTED-A. NC2064.2 +129900 MOVE "5A4A3A2B1B0C" TO CORRECT-A. NC2064.2 +130000 PERFORM FAIL. NC2064.2 +130100 QAL-WRITE-F1-36. NC2064.2 +130200 PERFORM PRINT-DETAIL. NC2064.2 +130300* NC2064.2 +130400 QAL-INIT-F1-37. NC2064.2 +130500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +130600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +130700 MOVE "QAL-TEST-F1-37" TO PAR-NAME. NC2064.2 +130800 QAL-TEST-F1-37. NC2064.2 +130900 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +131000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +131100 TO "5A4A3B2A1A0C" NC2064.2 +131200 PERFORM PASS NC2064.2 +131300 GO TO QAL-WRITE-F1-37. NC2064.2 +131400 GO TO QAL-FAIL-F1-37. NC2064.2 +131500 QAL-DELETE-F1-37. NC2064.2 +131600 PERFORM DE-LETE. NC2064.2 +131700 GO TO QAL-WRITE-F1-37. NC2064.2 +131800 QAL-FAIL-F1-37. NC2064.2 +131900 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +132000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +132100 COMPUTED-A. NC2064.2 +132200 MOVE "5A4A3B2A1A0C" TO CORRECT-A. NC2064.2 +132300 PERFORM FAIL. NC2064.2 +132400 QAL-WRITE-F1-37. NC2064.2 +132500 PERFORM PRINT-DETAIL. NC2064.2 +132600* NC2064.2 +132700 QAL-INIT-F1-38. NC2064.2 +132800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +132900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +133000 MOVE "QAL-TEST-F1-38" TO PAR-NAME. NC2064.2 +133100 QAL-TEST-F1-38. NC2064.2 +133200 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +133300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +133400 TO "5A4A3B2A1B0C" NC2064.2 +133500 PERFORM PASS NC2064.2 +133600 GO TO QAL-WRITE-F1-38. NC2064.2 +133700 GO TO QAL-FAIL-F1-38. NC2064.2 +133800 QAL-DELETE-F1-38. NC2064.2 +133900 PERFORM DE-LETE. NC2064.2 +134000 GO TO QAL-WRITE-F1-38. NC2064.2 +134100 QAL-FAIL-F1-38. NC2064.2 +134200 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +134300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +134400 COMPUTED-A. NC2064.2 +134500 MOVE "5A4A3B2A1B0C" TO CORRECT-A. NC2064.2 +134600 PERFORM FAIL. NC2064.2 +134700 QAL-WRITE-F1-38. NC2064.2 +134800 PERFORM PRINT-DETAIL. NC2064.2 +134900* NC2064.2 +135000 QAL-INIT-F1-39. NC2064.2 +135100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +135200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +135300 MOVE "QAL-TEST-F1-39" TO PAR-NAME. NC2064.2 +135400 QAL-TEST-F1-39. NC2064.2 +135500 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +135600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +135700 TO "5A4A3B2B1A0C" NC2064.2 +135800 PERFORM PASS NC2064.2 +135900 GO TO QAL-WRITE-F1-39. NC2064.2 +136000 GO TO QAL-FAIL-F1-39. NC2064.2 +136100 QAL-DELETE-F1-39. NC2064.2 +136200 PERFORM DE-LETE. NC2064.2 +136300 GO TO QAL-WRITE-F1-39. NC2064.2 +136400 QAL-FAIL-F1-39. NC2064.2 +136500 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +136600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +136700 COMPUTED-A. NC2064.2 +136800 MOVE "5A4A3B2B1A0C" TO CORRECT-A. NC2064.2 +136900 PERFORM FAIL. NC2064.2 +137000 QAL-WRITE-F1-39. NC2064.2 +137100 PERFORM PRINT-DETAIL. NC2064.2 +137200* NC2064.2 +137300 QAL-INIT-F1-40. NC2064.2 +137400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +137500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +137600 MOVE "QAL-TEST-F1-40" TO PAR-NAME. NC2064.2 +137700 QAL-TEST-F1-40. NC2064.2 +137800 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +137900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +138000 TO "5A4A3B2B1B0C" NC2064.2 +138100 PERFORM PASS NC2064.2 +138200 GO TO QAL-WRITE-F1-40. NC2064.2 +138300 GO TO QAL-FAIL-F1-40. NC2064.2 +138400 QAL-DELETE-F1-40. NC2064.2 +138500 PERFORM DE-LETE. NC2064.2 +138600 GO TO QAL-WRITE-F1-40. NC2064.2 +138700 QAL-FAIL-F1-40. NC2064.2 +138800 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +138900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +139000 COMPUTED-A. NC2064.2 +139100 MOVE "5A4A3B2B1B0C" TO CORRECT-A. NC2064.2 +139200 PERFORM FAIL. NC2064.2 +139300 QAL-WRITE-F1-40. NC2064.2 +139400 PERFORM PRINT-DETAIL. NC2064.2 +139500* NC2064.2 +139600 QAL-INIT-F1-41. NC2064.2 +139700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +139800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +139900 MOVE "QAL-TEST-F1-41" TO PAR-NAME. NC2064.2 +140000 QAL-TEST-F1-41. NC2064.2 +140100 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +140200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +140300 TO "5A4B3A2A1A0C" NC2064.2 +140400 PERFORM PASS NC2064.2 +140500 GO TO QAL-WRITE-F1-41. NC2064.2 +140600 GO TO QAL-FAIL-F1-41. NC2064.2 +140700 QAL-DELETE-F1-41. NC2064.2 +140800 PERFORM DE-LETE. NC2064.2 +140900 GO TO QAL-WRITE-F1-41. NC2064.2 +141000 QAL-FAIL-F1-41. NC2064.2 +141100 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +141200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +141300 COMPUTED-A. NC2064.2 +141400 MOVE "5A4B3A2A1A0C" TO CORRECT-A. NC2064.2 +141500 PERFORM FAIL. NC2064.2 +141600 QAL-WRITE-F1-41. NC2064.2 +141700 PERFORM PRINT-DETAIL. NC2064.2 +141800* NC2064.2 +141900 QAL-INIT-F1-42. NC2064.2 +142000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +142100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +142200 MOVE "QAL-TEST-F1-42" TO PAR-NAME. NC2064.2 +142300 QAL-TEST-F1-42. NC2064.2 +142400 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +142500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +142600 TO "5A4B3A2A1B0C" NC2064.2 +142700 PERFORM PASS NC2064.2 +142800 GO TO QAL-WRITE-F1-42. NC2064.2 +142900 GO TO QAL-FAIL-F1-42. NC2064.2 +143000 QAL-DELETE-F1-42. NC2064.2 +143100 PERFORM DE-LETE. NC2064.2 +143200 GO TO QAL-WRITE-F1-42. NC2064.2 +143300 QAL-FAIL-F1-42. NC2064.2 +143400 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +143500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +143600 COMPUTED-A. NC2064.2 +143700 MOVE "5A4B3A2A1B0C" TO CORRECT-A. NC2064.2 +143800 PERFORM FAIL. NC2064.2 +143900 QAL-WRITE-F1-42. NC2064.2 +144000 PERFORM PRINT-DETAIL. NC2064.2 +144100* NC2064.2 +144200 QAL-INIT-F1-43. NC2064.2 +144300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +144400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +144500 MOVE "QAL-TEST-F1-43" TO PAR-NAME. NC2064.2 +144600 QAL-TEST-F1-43. NC2064.2 +144700 IF TBL-LEVEL-0C IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +144800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +144900 TO "5A4B3A2B1A0C" NC2064.2 +145000 PERFORM PASS NC2064.2 +145100 GO TO QAL-WRITE-F1-43. NC2064.2 +145200 GO TO QAL-FAIL-F1-43. NC2064.2 +145300 QAL-DELETE-F1-43. NC2064.2 +145400 PERFORM DE-LETE. NC2064.2 +145500 GO TO QAL-WRITE-F1-43. NC2064.2 +145600 QAL-FAIL-F1-43. NC2064.2 +145700 MOVE "5A4B3A2B1A0C" TO CORRECT-A. NC2064.2 +145800 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +145900 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +146000 COMPUTED-A. NC2064.2 +146100 PERFORM FAIL. NC2064.2 +146200 QAL-WRITE-F1-43. NC2064.2 +146300 PERFORM PRINT-DETAIL. NC2064.2 +146400* NC2064.2 +146500 QAL-INIT-F1-44. NC2064.2 +146600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +146700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +146800 MOVE "QAL-TEST-F1-44" TO PAR-NAME. NC2064.2 +146900 QAL-TEST-F1-44. NC2064.2 +147000 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +147100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +147200 TO "5A4B3A2B1B0C" NC2064.2 +147300 PERFORM PASS NC2064.2 +147400 GO TO QAL-WRITE-F1-44. NC2064.2 +147500 GO TO QAL-FAIL-F1-44. NC2064.2 +147600 QAL-DELETE-F1-44. NC2064.2 +147700 PERFORM DE-LETE. NC2064.2 +147800 GO TO QAL-WRITE-F1-44. NC2064.2 +147900 QAL-FAIL-F1-44. NC2064.2 +148000 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +148100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +148200 COMPUTED-A. NC2064.2 +148300 MOVE "5A4B3A2B1B0C" TO CORRECT-A. NC2064.2 +148400 PERFORM FAIL. NC2064.2 +148500 QAL-WRITE-F1-44. NC2064.2 +148600 PERFORM PRINT-DETAIL. NC2064.2 +148700* NC2064.2 +148800 QAL-INIT-F1-45. NC2064.2 +148900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +149000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +149100 MOVE "QAL-TEST-F1-45" TO PAR-NAME. NC2064.2 +149200 QAL-TEST-F1-45. NC2064.2 +149300 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +149400 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +149500 TO "5A4B3B2A1A0C" NC2064.2 +149600 PERFORM PASS NC2064.2 +149700 GO TO QAL-WRITE-F1-45. NC2064.2 +149800 GO TO QAL-FAIL-F1-45. NC2064.2 +149900 QAL-DELETE-F1-45. NC2064.2 +150000 PERFORM DE-LETE. NC2064.2 +150100 GO TO QAL-WRITE-F1-45. NC2064.2 +150200 QAL-FAIL-F1-45. NC2064.2 +150300 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +150400 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +150500 TO COMPUTED-A. NC2064.2 +150600 MOVE "5A4B3B2A1A0C" TO CORRECT-A. NC2064.2 +150700 PERFORM FAIL. NC2064.2 +150800 QAL-WRITE-F1-45. NC2064.2 +150900 PERFORM PRINT-DETAIL. NC2064.2 +151000* NC2064.2 +151100 QAL-INIT-F1-46. NC2064.2 +151200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +151300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +151400 MOVE "QAL-TEST-F1-46" TO PAR-NAME. NC2064.2 +151500 QAL-TEST-F1-46. NC2064.2 +151600 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +151700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +151800 TO "5A4B3B2A1B0C" NC2064.2 +151900 PERFORM PASS NC2064.2 +152000 GO TO QAL-WRITE-F1-46. NC2064.2 +152100 GO TO QAL-FAIL-F1-46. NC2064.2 +152200 QAL-DELETE-F1-46. NC2064.2 +152300 PERFORM DE-LETE. NC2064.2 +152400 GO TO QAL-WRITE-F1-46. NC2064.2 +152500 QAL-FAIL-F1-46. NC2064.2 +152600 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +152700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +152800 COMPUTED-A. NC2064.2 +152900 MOVE "5A4B3B2A1B0C" TO CORRECT-A. NC2064.2 +153000 PERFORM FAIL. NC2064.2 +153100 QAL-WRITE-F1-46. NC2064.2 +153200 PERFORM PRINT-DETAIL. NC2064.2 +153300* NC2064.2 +153400 QAL-INIT-F1-47. NC2064.2 +153500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +153600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +153700 MOVE "QAL-TEST-F1-47" TO PAR-NAME. NC2064.2 +153800 QAL-TEST-F1-47. NC2064.2 +153900 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +154000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +154100 TO "5A4B3B2B1A0C" NC2064.2 +154200 PERFORM PASS NC2064.2 +154300 GO TO QAL-WRITE-F1-47. NC2064.2 +154400 GO TO QAL-FAIL-F1-47. NC2064.2 +154500 QAL-DELETE-F1-47. NC2064.2 +154600 PERFORM DE-LETE. NC2064.2 +154700 GO TO QAL-WRITE-F1-47. NC2064.2 +154800 QAL-FAIL-F1-47. NC2064.2 +154900 MOVE "5A4B3B2B1A0C" TO CORRECT-A. NC2064.2 +155000 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +155100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +155200 COMPUTED-A. NC2064.2 +155300 PERFORM FAIL. NC2064.2 +155400 QAL-WRITE-F1-47. NC2064.2 +155500 PERFORM PRINT-DETAIL. NC2064.2 +155600* NC2064.2 +155700 QAL-INIT-F1-48. NC2064.2 +155800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +155900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +156000 MOVE "QAL-TEST-F1-48" TO PAR-NAME. NC2064.2 +156100 QAL-TEST-F1-48. NC2064.2 +156200 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +156300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +156400 TO "5A4B3B2B1B0C" NC2064.2 +156500 PERFORM PASS NC2064.2 +156600 GO TO QAL-WRITE-F1-48. NC2064.2 +156700 GO TO QAL-FAIL-F1-48. NC2064.2 +156800 QAL-DELETE-F1-48. NC2064.2 +156900 PERFORM DE-LETE. NC2064.2 +157000 GO TO QAL-WRITE-F1-48. NC2064.2 +157100 QAL-FAIL-F1-48. NC2064.2 +157200 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +157300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +157400 COMPUTED-A. NC2064.2 +157500 MOVE "5A4B3B2B1B0C" TO CORRECT-A. NC2064.2 +157600 PERFORM FAIL. NC2064.2 +157700 QAL-WRITE-F1-48. NC2064.2 +157800 PERFORM PRINT-DETAIL. NC2064.2 +157900* NC2064.2 +158000 QAL-INIT-F1-49. NC2064.2 +158100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +158200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +158300 MOVE "QAL-TEST-F1-49" TO PAR-NAME. NC2064.2 +158400 QAL-TEST-F1-49. NC2064.2 +158500 IF TBL-LEVEL-0D EQUAL TO "5A4A3A2A1A0D" NC2064.2 +158600 PERFORM PASS NC2064.2 +158700 GO TO QAL-WRITE-F1-49. NC2064.2 +158800 GO TO QAL-FAIL-F1-49. NC2064.2 +158900 QAL-DELETE-F1-49. NC2064.2 +159000 PERFORM DE-LETE. NC2064.2 +159100 GO TO QAL-WRITE-F1-49. NC2064.2 +159200 QAL-FAIL-F1-49. NC2064.2 +159300 MOVE "5A4A3A2A1A0D" TO CORRECT-A. NC2064.2 +159400 MOVE TBL-LEVEL-0D IN TABLE-LEVEL-5A TO COMPUTED-A. NC2064.2 +159500* NOTE TBL-LEVEL-0D IS UNIQUE AND NEED NOT BE QUALIFIED NC2064.2 +159600* HOWEVER, REFERENCE IS MADE TO IT BOTH QUALIFIED AND NC2064.2 +159700* UNQUALIFIED TO INSURE THE ABILITY TO DO SO. NC2064.2 +159800 PERFORM FAIL. NC2064.2 +159900 QAL-WRITE-F1-49. NC2064.2 +160000 PERFORM PRINT-DETAIL. NC2064.2 +160100* NC2064.2 +160200 PERFORM END-ROUTINE. NC2064.2 +160300* NC2064.2 +160400 SUB-INIT-F1-0. NC2064.2 +160500 PERFORM END-ROUTINE. NC2064.2 +160600 MOVE "AA1122DD33" TO AX. NC2064.2 +160700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +160800 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +160900* NC2064.2 +161000 SUB-INIT-F1-1. NC2064.2 +161100 MOVE "SUB-TEST-F1-1" TO PAR-NAME. NC2064.2 +161200 SUB-TEST-F1-1. NC2064.2 +161300 IF AX-2 IN AX (CX-SUB OF CX) EQUAL TO "1" NC2064.2 +161400 PERFORM PASS NC2064.2 +161500 GO TO SUB-WRITE-F1-1. NC2064.2 +161600 GO TO SUB-FAIL-F1-1. NC2064.2 +161700 SUB-DELETE-F1-1. NC2064.2 +161800 PERFORM DE-LETE. NC2064.2 +161900 GO TO SUB-WRITE-F1-1. NC2064.2 +162000 SUB-FAIL-F1-1. NC2064.2 +162100 MOVE AX-2 IN AX (CX-SUB OF CX) TO COMPUTED-A. NC2064.2 +162200 MOVE 1 TO CORRECT-A. NC2064.2 +162300 PERFORM FAIL. NC2064.2 +162400 SUB-WRITE-F1-1. NC2064.2 +162500 PERFORM PRINT-DETAIL. NC2064.2 +162600* NC2064.2 +162700 SUB-INIT-F1-2. NC2064.2 +162800 MOVE "SUB-TEST-F1-2" TO PAR-NAME. NC2064.2 +162900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +163000 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +163100 MOVE 4 TO CX. NC2064.2 +163200 MOVE "DD" TO CORRECT-A. NC2064.2 +163300 SUB-TEST-F1-2. NC2064.2 +163400 MOVE AX-1 OF AX (CX-SUB OF CX) TO COMPUTED-A. NC2064.2 +163500 IF COMPUTED-A EQUAL TO CORRECT-A NC2064.2 +163600 PERFORM PASS NC2064.2 +163700 MOVE SPACE TO COMPUTED-A CORRECT-A NC2064.2 +163800 GO TO SUB-WRITE-F1-2. NC2064.2 +163900 GO TO SUB-FAIL-F1-2. NC2064.2 +164000 SUB-DELETE-F1-2. NC2064.2 +164100 PERFORM DE-LETE. NC2064.2 +164200 GO TO SUB-WRITE-F1-2. NC2064.2 +164300 SUB-FAIL-F1-2. NC2064.2 +164400 PERFORM FAIL. NC2064.2 +164500 SUB-WRITE-F1-2. NC2064.2 +164600 PERFORM PRINT-DETAIL. NC2064.2 +164700* NC2064.2 +164800 SUB-INIT-F1-3. NC2064.2 +164900 MOVE "SUB-TEST-F1-3" TO PAR-NAME. NC2064.2 +165000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +165100 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +165200 MOVE 5 TO CX. NC2064.2 +165300 MOVE 5 TO AX-3 OF BX (1) AX-2 OF BX (1). NC2064.2 +165400 MOVE AX-1 IN BX (1) TO AX-1 OF AX (CX-SUB OF CX). NC2064.2 +165500 SUB-TEST-F1-3. NC2064.2 +165600 IF AX-1 OF BX (1) EQUAL TO AX-1 IN AX (CX-SUB IN CX) NC2064.2 +165700 PERFORM PASS NC2064.2 +165800 GO TO SUB-WRITE-F1-3. NC2064.2 +165900 GO TO SUB-FAIL-F1-3. NC2064.2 +166000 SUB-DELETE-F1-3. NC2064.2 +166100 PERFORM DE-LETE. NC2064.2 +166200 GO TO SUB-WRITE-F1-3. NC2064.2 +166300 SUB-FAIL-F1-3. NC2064.2 +166400 MOVE AX-1 OF BX (1) TO COMPUTED-A. NC2064.2 +166500 MOVE AX-1 IN AX (CX-SUB IN CX) TO CORRECT-A. NC2064.2 +166600 PERFORM FAIL. NC2064.2 +166700 MOVE "UNEQUAL COMPARISON" TO RE-MARK. NC2064.2 +166800 SUB-WRITE-F1-3. NC2064.2 +166900 PERFORM PRINT-DETAIL. NC2064.2 +167000* NC2064.2 +167100 SUB-INIT-F1-4. NC2064.2 +167200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +167300 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +167400 MOVE "SUB-TEST-F1-4" TO PAR-NAME. NC2064.2 +167500 MOVE 1 TO CX. NC2064.2 +167600 MOVE 11 TO AX-1 OF BX (CX-SUB IN CX). NC2064.2 +167700 ADD AX-3 IN BX (CX-SUB OF CX) TO AX-2 IN BX (CX-SUB IN CX). NC2064.2 +167800 SUB-TEST-F1-4. NC2064.2 +167900 IF AX-2 IN BX (CX-SUB IN CX) EQUAL TO AX-2 IN AX (3) NC2064.2 +168000 PERFORM PASS NC2064.2 +168100 GO TO SUB-WRITE-F1-4. NC2064.2 +168200 GO TO SUB-FAIL-F1-4. NC2064.2 +168300 SUB-DELETE-F1-4. NC2064.2 +168400 PERFORM DE-LETE. NC2064.2 +168500 GO TO SUB-WRITE-F1-4. NC2064.2 +168600 SUB-FAIL-F1-4. NC2064.2 +168700 MOVE AX-2 IN BX (CX-SUB IN CX) TO COMPUTED-A. NC2064.2 +168800 MOVE AX-2 IN AX (3) TO CORRECT-A. NC2064.2 +168900 MOVE "UNEQUAL COMPARISON" TO RE-MARK. NC2064.2 +169000 PERFORM FAIL. NC2064.2 +169100 SUB-WRITE-F1-4. NC2064.2 +169200 PERFORM PRINT-DETAIL. NC2064.2 +169300 CCVS-EXIT SECTION. NC2064.2 +169400 CCVS-999999. NC2064.2 +169500 GO TO CLOSE-FILES. NC2064.2 +*END-OF,NC206A +*HEADER,COBOL,NC207A +000100 IDENTIFICATION DIVISION. NC2074.2 +000200 PROGRAM-ID. NC2074.2 +000300 NC207A. NC2074.2 +000400**************************************************************** NC2074.2 +000500* * NC2074.2 +000600* VALIDATION FOR:- * NC2074.2 +000700* * NC2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +000900* * NC2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2074.2 +001100* * NC2074.2 +001200**************************************************************** NC2074.2 +001300* * NC2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2074.2 +001500* * NC2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2074.2 +001900* * NC2074.2 +002000**************************************************************** NC2074.2 +002100* * NC2074.2 +002200* PROGRAM NC207A TESTS THE USE OF FORMAT 1 QUALIFICATION * NC2074.2 +002300* USING FORMATS 1, 2 AND 3 OF THE "ADD" STATEMENT, FORMATS * NC2074.2 +002400* 2 AND 3 OF THE "SUBTRACT" STATEMENT, FORMAT 2 OF THE * NC2074.2 +002500* "MULTIPLY" STATEMENT AND FORMAT 3 OF THE "DIVIDE"* NC2074.2 +002600* STATEMENT. * NC2074.2 +002700* THE MAJORITY OF TESTST USE UP TO FIVE LEVELS OF * NC2074.2 +002800* QUALIFICATION BUT THE MINIMUM REQUIREMENT OF 49 LEVELS IN * NC2074.2 +002900* THE NUCLEUS IS ALSO TESTED. * NC2074.2 +003000* * NC2074.2 +003100**************************************************************** NC2074.2 +003200 ENVIRONMENT DIVISION. NC2074.2 +003300 CONFIGURATION SECTION. NC2074.2 +003400 SOURCE-COMPUTER. NC2074.2 +003500 XXXXX082. NC2074.2 +003600 OBJECT-COMPUTER. NC2074.2 +003700 XXXXX083. NC2074.2 +003800 INPUT-OUTPUT SECTION. NC2074.2 +003900 FILE-CONTROL. NC2074.2 +004000 SELECT PRINT-FILE ASSIGN TO NC2074.2 +004100 XXXXX055. NC2074.2 +004200 DATA DIVISION. NC2074.2 +004300 FILE SECTION. NC2074.2 +004400 FD PRINT-FILE. NC2074.2 +004500 01 PRINT-REC PICTURE X(120). NC2074.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC2074.2 +004700 WORKING-STORAGE SECTION. NC2074.2 +004800 77 ACCUMULATOR1 PIC 9(18) VALUE ZERO. NC2074.2 +004900 77 ACCUMULATOR2 PIC 9(18) VALUE ZERO. NC2074.2 +005000 01 TABLE-LEVEL-5A. NC2074.2 +005100 02 TABLE-LEVEL-4A. NC2074.2 +005200 03 TABLE-LEVEL-3A. NC2074.2 +005300 04 TABLE-LEVEL-2A. NC2074.2 +005400 05 TABLE-LEVEL-1A. NC2074.2 +005500 06 TBL-ITEM-1 PIC 9 VALUE 1. NC2074.2 +005600 05 TABLE-LEVEL-1B. NC2074.2 +005700 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +005800 04 TABLE-LEVEL-2B. NC2074.2 +005900 05 TABLE-LEVEL-1A. NC2074.2 +006000 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +006100 05 TABLE-LEVEL-1B. NC2074.2 +006200 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +006300 03 TABLE-LEVEL-3B. NC2074.2 +006400 04 TABLE-LEVEL-2A. NC2074.2 +006500 05 TABLE-LEVEL-1A. NC2074.2 +006600 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +006700 05 TABLE-LEVEL-1B. NC2074.2 +006800 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +006900 04 TABLE-LEVEL-2B. NC2074.2 +007000 05 TABLE-LEVEL-1A. NC2074.2 +007100 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +007200 05 TABLE-LEVEL-1B. NC2074.2 +007300 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +007400 02 TABLE-LEVEL-4B. NC2074.2 +007500 03 TABLE-LEVEL-3A. NC2074.2 +007600 04 TABLE-LEVEL-2A. NC2074.2 +007700 05 TABLE-LEVEL-1A. NC2074.2 +007800 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +007900 05 TABLE-LEVEL-1B. NC2074.2 +008000 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +008100 04 TABLE-LEVEL-2B. NC2074.2 +008200 05 TABLE-LEVEL-1A. NC2074.2 +008300 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +008400 05 TABLE-LEVEL-1B. NC2074.2 +008500 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +008600 03 TABLE-LEVEL-3B. NC2074.2 +008700 04 TABLE-LEVEL-2A. NC2074.2 +008800 05 TABLE-LEVEL-1A. NC2074.2 +008900 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +009000 05 TABLE-LEVEL-1B. NC2074.2 +009100 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +009200 04 TABLE-LEVEL-2B. NC2074.2 +009300 05 TABLE-LEVEL-1A. NC2074.2 +009400 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +009500 05 TABLE-LEVEL-1B. NC2074.2 +009600 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +009700 01 TABLE-LEVEL-5B. NC2074.2 +009800 02 TABLE-LEVEL-4A. NC2074.2 +009900 03 TABLE-LEVEL-3A. NC2074.2 +010000 04 TABLE-LEVEL-2A. NC2074.2 +010100 05 TABLE-LEVEL-1A. NC2074.2 +010200 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +010300 05 TABLE-LEVEL-1B. NC2074.2 +010400 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +010500 04 TABLE-LEVEL-2B. NC2074.2 +010600 05 TABLE-LEVEL-1A. NC2074.2 +010700 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +010800 05 TABLE-LEVEL-1B. NC2074.2 +010900 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +011000 03 TABLE-LEVEL-3B. NC2074.2 +011100 04 TABLE-LEVEL-2A. NC2074.2 +011200 05 TABLE-LEVEL-1A. NC2074.2 +011300 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +011400 05 TABLE-LEVEL-1B. NC2074.2 +011500 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +011600 04 TABLE-LEVEL-2B. NC2074.2 +011700 05 TABLE-LEVEL-1A. NC2074.2 +011800 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +011900 05 TABLE-LEVEL-1B. NC2074.2 +012000 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +012100 02 TABLE-LEVEL-4B. NC2074.2 +012200 03 TABLE-LEVEL-3A. NC2074.2 +012300 04 TABLE-LEVEL-2A. NC2074.2 +012400 05 TABLE-LEVEL-1A. NC2074.2 +012500 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +012600 05 TABLE-LEVEL-1B. NC2074.2 +012700 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +012800 04 TABLE-LEVEL-2B. NC2074.2 +012900 05 TABLE-LEVEL-1A. NC2074.2 +013000 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +013100 05 TABLE-LEVEL-1B. NC2074.2 +013200 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +013300 03 TABLE-LEVEL-3B. NC2074.2 +013400 04 TABLE-LEVEL-2A. NC2074.2 +013500 05 TABLE-LEVEL-1A. NC2074.2 +013600 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +013700 05 TABLE-LEVEL-1B. NC2074.2 +013800 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +013900 04 TABLE-LEVEL-2B. NC2074.2 +014000 05 TABLE-LEVEL-1A. NC2074.2 +014100 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +014200 05 TABLE-LEVEL-1B. NC2074.2 +014300 06 TBL-ITEM-1 PIC 99 VALUE 1. NC2074.2 +014400 NC2074.2 +014500 01 TABLE-LEVEL-5C. NC2074.2 +014600 02 TABLE-LEVEL-4A. NC2074.2 +014700 03 TABLE-LEVEL-3A. NC2074.2 +014800 04 TABLE-LEVEL-2A. NC2074.2 +014900 05 TABLE-LEVEL-1A. NC2074.2 +015000 06 TBL-ITEM-1 PIC 9 VALUE 1. NC2074.2 +015100 05 TABLE-LEVEL-1B. NC2074.2 +015200 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +015300 04 TABLE-LEVEL-2B. NC2074.2 +015400 05 TABLE-LEVEL-1A. NC2074.2 +015500 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +015600 05 TABLE-LEVEL-1B. NC2074.2 +015700 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +015800 03 TABLE-LEVEL-3B. NC2074.2 +015900 04 TABLE-LEVEL-2A. NC2074.2 +016000 05 TABLE-LEVEL-1A. NC2074.2 +016100 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +016200 05 TABLE-LEVEL-1B. NC2074.2 +016300 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +016400 04 TABLE-LEVEL-2B. NC2074.2 +016500 05 TABLE-LEVEL-1A. NC2074.2 +016600 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +016700 05 TABLE-LEVEL-1B. NC2074.2 +016800 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +016900 02 TABLE-LEVEL-4B. NC2074.2 +017000 03 TABLE-LEVEL-3A. NC2074.2 +017100 04 TABLE-LEVEL-2A. NC2074.2 +017200 05 TABLE-LEVEL-1A. NC2074.2 +017300 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +017400 05 TABLE-LEVEL-1B. NC2074.2 +017500 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +017600 04 TABLE-LEVEL-2B. NC2074.2 +017700 05 TABLE-LEVEL-1A. NC2074.2 +017800 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +017900 05 TABLE-LEVEL-1B. NC2074.2 +018000 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +018100 03 TABLE-LEVEL-3B. NC2074.2 +018200 04 TABLE-LEVEL-2A. NC2074.2 +018300 05 TABLE-LEVEL-1A. NC2074.2 +018400 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +018500 05 TABLE-LEVEL-1B. NC2074.2 +018600 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +018700 04 TABLE-LEVEL-2B. NC2074.2 +018800 05 TABLE-LEVEL-1A. NC2074.2 +018900 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +019000 05 TABLE-LEVEL-1B. NC2074.2 +019100 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +019200 01 TABLE-5B-INIT. NC2074.2 +019300 02 FILLER PIC 9(16) VALUE 16. NC2074.2 +019400 02 FILLER PIC 9(15) VALUE 15. NC2074.2 +019500 02 FILLER PIC 9(14) VALUE 14. NC2074.2 +019600 02 FILLER PIC 9(13) VALUE 13. NC2074.2 +019700 02 FILLER PIC 9(12) VALUE 12. NC2074.2 +019800 02 FILLER PIC 9(11) VALUE 11. NC2074.2 +019900 02 FILLER PIC 9(10) VALUE 10. NC2074.2 +020000 02 FILLER PIC 9(9) VALUE 9. NC2074.2 +020100 02 FILLER PIC 9(8) VALUE 8. NC2074.2 +020200 02 FILLER PIC 9(7) VALUE 7. NC2074.2 +020300 02 FILLER PIC 9(6) VALUE 6. NC2074.2 +020400 02 FILLER PIC 9(5) VALUE 5. NC2074.2 +020500 02 FILLER PIC 9(4) VALUE 4. NC2074.2 +020600 02 FILLER PIC 9(3) VALUE 3. NC2074.2 +020700 02 FILLER PIC 9(2) VALUE 2. NC2074.2 +020800 02 FILLER PIC 9(2) VALUE 1. NC2074.2 +020900 01 FIRST-GROUP. NC2074.2 +021000 02 GROUP-02. NC2074.2 +021100 03 GROUP-03. NC2074.2 +021200 04 GROUP-04. NC2074.2 +021300 05 GROUP-05. NC2074.2 +021400 06 GROUP-06. NC2074.2 +021500 07 GROUP-07. NC2074.2 +021600 08 GROUP-08. NC2074.2 +021700 09 GROUP-09. NC2074.2 +021800 10 GROUP-10. NC2074.2 +021900 11 GROUP-11. NC2074.2 +022000 12 GROUP-12. NC2074.2 +022100 13 GROUP-13. NC2074.2 +022200 14 GROUP-14. NC2074.2 +022300 15 GROUP-15. NC2074.2 +022400 16 GROUP-16. NC2074.2 +022500 17 GROUP-17. NC2074.2 +022600 18 GROUP-18. NC2074.2 +022700 19 GROUP-19. NC2074.2 +022800 20 GROUP-20. NC2074.2 +022900 21 GROUP-21. NC2074.2 +023000 22 GROUP-22. NC2074.2 +023100 23 GROUP-23. NC2074.2 +023200 24 GROUP-24. NC2074.2 +023300 25 GROUP-25. NC2074.2 +023400 26 GROUP-26. NC2074.2 +023500 27 GROUP-27. NC2074.2 +023600 28 GROUP-28. NC2074.2 +023700 29 GROUP-29. NC2074.2 +023800 30 GROUP-30. NC2074.2 +023900 31 GROUP-31. NC2074.2 +024000 32 GROUP-32. NC2074.2 +024100 33 GROUP-33. NC2074.2 +024200 34 GROUP-34. NC2074.2 +024300 35 GROUP-35. NC2074.2 +024400 36 GROUP-36. NC2074.2 +024500 37 GROUP-37. NC2074.2 +024600 38 GROUP-38. NC2074.2 +024700 39 GROUP-39. NC2074.2 +024800 40 GROUP-40. NC2074.2 +024900 41 GROUP-41. NC2074.2 +025000 42 GROUP-42. NC2074.2 +025100 43 GROUP-43. NC2074.2 +025200 44 GROUP-44. NC2074.2 +025300 45 GROUP-45. NC2074.2 +025400 46 GROUP-46. NC2074.2 +025500 47 GROUP-47. NC2074.2 +025600 48 GROUP-48. NC2074.2 +025700 49 GROUP-49-1 PIC 9(4) VALUE 1. NC2074.2 +025800 49 GROUP-49-2 PIC S9(3) COMP VALUE 2. NC2074.2 +025900 49 GROUP-49-3 PIC S9(15) COMP VALUE 3. NC2074.2 +026000 49 GROUP-49-4 PIC S9(8) COMP VALUE 4. NC2074.2 +026100 49 GROUP-49-5 PIC 9(8) VALUE 5. NC2074.2 +026200 01 SECOND-GROUP. NC2074.2 +026300 02 GROUP-02. NC2074.2 +026400 03 GROUP-03. NC2074.2 +026500 04 GROUP-04. NC2074.2 +026600 05 GROUP-05. NC2074.2 +026700 06 GROUP-06. NC2074.2 +026800 07 GROUP-07. NC2074.2 +026900 08 GROUP-08. NC2074.2 +027000 09 GROUP-09. NC2074.2 +027100 10 GROUP-10. NC2074.2 +027200 11 GROUP-11. NC2074.2 +027300 12 GROUP-12. NC2074.2 +027400 13 GROUP-13. NC2074.2 +027500 14 GROUP-14. NC2074.2 +027600 15 GROUP-15. NC2074.2 +027700 16 GROUP-16. NC2074.2 +027800 17 GROUP-17. NC2074.2 +027900 18 GROUP-18. NC2074.2 +028000 19 GROUP-19. NC2074.2 +028100 20 GROUP-20. NC2074.2 +028200 21 GROUP-21. NC2074.2 +028300 22 GROUP-22. NC2074.2 +028400 23 GROUP-23. NC2074.2 +028500 24 GROUP-24. NC2074.2 +028600 25 GROUP-25. NC2074.2 +028700 26 GROUP-26. NC2074.2 +028800 27 GROUP-27. NC2074.2 +028900 28 GROUP-28. NC2074.2 +029000 29 GROUP-29. NC2074.2 +029100 30 GROUP-30. NC2074.2 +029200 31 GROUP-31. NC2074.2 +029300 32 GROUP-32. NC2074.2 +029400 33 GROUP-33. NC2074.2 +029500 34 GROUP-34. NC2074.2 +029600 35 GROUP-35. NC2074.2 +029700 36 GROUP-36. NC2074.2 +029800 37 GROUP-37. NC2074.2 +029900 38 GROUP-38. NC2074.2 +030000 39 GROUP-39. NC2074.2 +030100 40 GROUP-40. NC2074.2 +030200 41 GROUP-41. NC2074.2 +030300 42 GROUP-42. NC2074.2 +030400 43 GROUP-43. NC2074.2 +030500 44 GROUP-44. NC2074.2 +030600 45 GROUP-45. NC2074.2 +030700 46 GROUP-46. NC2074.2 +030800 47 GROUP-47. NC2074.2 +030900 48 GROUP-48. NC2074.2 +031000 49 GROUP-49-1 PIC 9(4) VALUE 100. NC2074.2 +031100 49 GROUP-49-2 PIC S9(3) COMP VALUE 200. NC2074.2 +031200 49 GROUP-49-3 PIC S9(15) COMP VALUE 300. NC2074.2 +031300 49 GROUP-49-4 PIC S9(8) COMP VALUE 400. NC2074.2 +031400 49 GROUP-49-5 PIC 9(8) VALUE 500. NC2074.2 +031500 88 LEVEL-49-OK VALUE 500. NC2074.2 +031600 01 TEST-RESULTS. NC2074.2 +031700 02 FILLER PIC X VALUE SPACE. NC2074.2 +031800 02 FEATURE PIC X(20) VALUE SPACE. NC2074.2 +031900 02 FILLER PIC X VALUE SPACE. NC2074.2 +032000 02 P-OR-F PIC X(5) VALUE SPACE. NC2074.2 +032100 02 FILLER PIC X VALUE SPACE. NC2074.2 +032200 02 PAR-NAME. NC2074.2 +032300 03 FILLER PIC X(19) VALUE SPACE. NC2074.2 +032400 03 PARDOT-X PIC X VALUE SPACE. NC2074.2 +032500 03 DOTVALUE PIC 99 VALUE ZERO. NC2074.2 +032600 02 FILLER PIC X(8) VALUE SPACE. NC2074.2 +032700 02 RE-MARK PIC X(61). NC2074.2 +032800 01 TEST-COMPUTED. NC2074.2 +032900 02 FILLER PIC X(30) VALUE SPACE. NC2074.2 +033000 02 FILLER PIC X(17) VALUE NC2074.2 +033100 " COMPUTED=". NC2074.2 +033200 02 COMPUTED-X. NC2074.2 +033300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2074.2 +033400 03 COMPUTED-N REDEFINES COMPUTED-A NC2074.2 +033500 PIC -9(9).9(9). NC2074.2 +033600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2074.2 +033700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2074.2 +033800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2074.2 +033900 03 CM-18V0 REDEFINES COMPUTED-A. NC2074.2 +034000 04 COMPUTED-18V0 PIC -9(18). NC2074.2 +034100 04 FILLER PIC X. NC2074.2 +034200 03 FILLER PIC X(50) VALUE SPACE. NC2074.2 +034300 01 TEST-CORRECT. NC2074.2 +034400 02 FILLER PIC X(30) VALUE SPACE. NC2074.2 +034500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2074.2 +034600 02 CORRECT-X. NC2074.2 +034700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2074.2 +034800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2074.2 +034900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2074.2 +035000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2074.2 +035100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2074.2 +035200 03 CR-18V0 REDEFINES CORRECT-A. NC2074.2 +035300 04 CORRECT-18V0 PIC -9(18). NC2074.2 +035400 04 FILLER PIC X. NC2074.2 +035500 03 FILLER PIC X(2) VALUE SPACE. NC2074.2 +035600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2074.2 +035700 01 CCVS-C-1. NC2074.2 +035800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2074.2 +035900- "SS PARAGRAPH-NAME NC2074.2 +036000- " REMARKS". NC2074.2 +036100 02 FILLER PIC X(20) VALUE SPACE. NC2074.2 +036200 01 CCVS-C-2. NC2074.2 +036300 02 FILLER PIC X VALUE SPACE. NC2074.2 +036400 02 FILLER PIC X(6) VALUE "TESTED". NC2074.2 +036500 02 FILLER PIC X(15) VALUE SPACE. NC2074.2 +036600 02 FILLER PIC X(4) VALUE "FAIL". NC2074.2 +036700 02 FILLER PIC X(94) VALUE SPACE. NC2074.2 +036800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2074.2 +036900 01 REC-CT PIC 99 VALUE ZERO. NC2074.2 +037000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2074.2 +037500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2074.2 +037600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2074.2 +037700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2074.2 +037800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2074.2 +037900 01 CCVS-H-1. NC2074.2 +038000 02 FILLER PIC X(39) VALUE SPACES. NC2074.2 +038100 02 FILLER PIC X(42) VALUE NC2074.2 +038200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2074.2 +038300 02 FILLER PIC X(39) VALUE SPACES. NC2074.2 +038400 01 CCVS-H-2A. NC2074.2 +038500 02 FILLER PIC X(40) VALUE SPACE. NC2074.2 +038600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2074.2 +038700 02 FILLER PIC XXXX VALUE NC2074.2 +038800 "4.2 ". NC2074.2 +038900 02 FILLER PIC X(28) VALUE NC2074.2 +039000 " COPY - NOT FOR DISTRIBUTION". NC2074.2 +039100 02 FILLER PIC X(41) VALUE SPACE. NC2074.2 +039200 NC2074.2 +039300 01 CCVS-H-2B. NC2074.2 +039400 02 FILLER PIC X(15) VALUE NC2074.2 +039500 "TEST RESULT OF ". NC2074.2 +039600 02 TEST-ID PIC X(9). NC2074.2 +039700 02 FILLER PIC X(4) VALUE NC2074.2 +039800 " IN ". NC2074.2 +039900 02 FILLER PIC X(12) VALUE NC2074.2 +040000 " HIGH ". NC2074.2 +040100 02 FILLER PIC X(22) VALUE NC2074.2 +040200 " LEVEL VALIDATION FOR ". NC2074.2 +040300 02 FILLER PIC X(58) VALUE NC2074.2 +040400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +040500 01 CCVS-H-3. NC2074.2 +040600 02 FILLER PIC X(34) VALUE NC2074.2 +040700 " FOR OFFICIAL USE ONLY ". NC2074.2 +040800 02 FILLER PIC X(58) VALUE NC2074.2 +040900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2074.2 +041000 02 FILLER PIC X(28) VALUE NC2074.2 +041100 " COPYRIGHT 1985 ". NC2074.2 +041200 01 CCVS-E-1. NC2074.2 +041300 02 FILLER PIC X(52) VALUE SPACE. NC2074.2 +041400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2074.2 +041500 02 ID-AGAIN PIC X(9). NC2074.2 +041600 02 FILLER PIC X(45) VALUE SPACES. NC2074.2 +041700 01 CCVS-E-2. NC2074.2 +041800 02 FILLER PIC X(31) VALUE SPACE. NC2074.2 +041900 02 FILLER PIC X(21) VALUE SPACE. NC2074.2 +042000 02 CCVS-E-2-2. NC2074.2 +042100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2074.2 +042200 03 FILLER PIC X VALUE SPACE. NC2074.2 +042300 03 ENDER-DESC PIC X(44) VALUE NC2074.2 +042400 "ERRORS ENCOUNTERED". NC2074.2 +042500 01 CCVS-E-3. NC2074.2 +042600 02 FILLER PIC X(22) VALUE NC2074.2 +042700 " FOR OFFICIAL USE ONLY". NC2074.2 +042800 02 FILLER PIC X(12) VALUE SPACE. NC2074.2 +042900 02 FILLER PIC X(58) VALUE NC2074.2 +043000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +043100 02 FILLER PIC X(13) VALUE SPACE. NC2074.2 +043200 02 FILLER PIC X(15) VALUE NC2074.2 +043300 " COPYRIGHT 1985". NC2074.2 +043400 01 CCVS-E-4. NC2074.2 +043500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2074.2 +043600 02 FILLER PIC X(4) VALUE " OF ". NC2074.2 +043700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2074.2 +043800 02 FILLER PIC X(40) VALUE NC2074.2 +043900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2074.2 +044000 01 XXINFO. NC2074.2 +044100 02 FILLER PIC X(19) VALUE NC2074.2 +044200 "*** INFORMATION ***". NC2074.2 +044300 02 INFO-TEXT. NC2074.2 +044400 04 FILLER PIC X(8) VALUE SPACE. NC2074.2 +044500 04 XXCOMPUTED PIC X(20). NC2074.2 +044600 04 FILLER PIC X(5) VALUE SPACE. NC2074.2 +044700 04 XXCORRECT PIC X(20). NC2074.2 +044800 02 INF-ANSI-REFERENCE PIC X(48). NC2074.2 +044900 01 HYPHEN-LINE. NC2074.2 +045000 02 FILLER PIC IS X VALUE IS SPACE. NC2074.2 +045100 02 FILLER PIC IS X(65) VALUE IS "************************NC2074.2 +045200- "*****************************************". NC2074.2 +045300 02 FILLER PIC IS X(54) VALUE IS "************************NC2074.2 +045400- "******************************". NC2074.2 +045500 01 CCVS-PGM-ID PIC X(9) VALUE NC2074.2 +045600 "NC207". NC2074.2 +045700 PROCEDURE DIVISION. NC2074.2 +045800 CCVS1 SECTION. NC2074.2 +045900 OPEN-FILES. NC2074.2 +046000 OPEN OUTPUT PRINT-FILE. NC2074.2 +046100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2074.2 +046200 MOVE SPACE TO TEST-RESULTS. NC2074.2 +046300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2074.2 +046400 GO TO CCVS1-EXIT. NC2074.2 +046500 CLOSE-FILES. NC2074.2 +046600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2074.2 +046700 TERMINATE-CCVS. NC2074.2 +046800S EXIT PROGRAM. NC2074.2 +046900STERMINATE-CALL. NC2074.2 +047000 STOP RUN. NC2074.2 +047100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2074.2 +047200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2074.2 +047300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2074.2 +047400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2074.2 +047500 MOVE "****TEST DELETED****" TO RE-MARK. NC2074.2 +047600 PRINT-DETAIL. NC2074.2 +047700 IF REC-CT NOT EQUAL TO ZERO NC2074.2 +047800 MOVE "." TO PARDOT-X NC2074.2 +047900 MOVE REC-CT TO DOTVALUE. NC2074.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2074.2 +048100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2074.2 +048200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2074.2 +048300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2074.2 +048400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2074.2 +048500 MOVE SPACE TO CORRECT-X. NC2074.2 +048600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2074.2 +048700 MOVE SPACE TO RE-MARK. NC2074.2 +048800 HEAD-ROUTINE. NC2074.2 +048900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2074.2 +049200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2074.2 +049300 COLUMN-NAMES-ROUTINE. NC2074.2 +049400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +049500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +049700 END-ROUTINE. NC2074.2 +049800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2074.2 +049900 END-RTN-EXIT. NC2074.2 +050000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +050100 END-ROUTINE-1. NC2074.2 +050200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2074.2 +050300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2074.2 +050400 ADD PASS-COUNTER TO ERROR-HOLD. NC2074.2 +050500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2074.2 +050600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2074.2 +050700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2074.2 +050800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2074.2 +050900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2074.2 +051000 END-ROUTINE-12. NC2074.2 +051100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2074.2 +051200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2074.2 +051300 MOVE "NO " TO ERROR-TOTAL NC2074.2 +051400 ELSE NC2074.2 +051500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2074.2 +051600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2074.2 +051700 PERFORM WRITE-LINE. NC2074.2 +051800 END-ROUTINE-13. NC2074.2 +051900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2074.2 +052000 MOVE "NO " TO ERROR-TOTAL ELSE NC2074.2 +052100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2074.2 +052200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2074.2 +052300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +052400 IF INSPECT-COUNTER EQUAL TO ZERO NC2074.2 +052500 MOVE "NO " TO ERROR-TOTAL NC2074.2 +052600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2074.2 +052700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2074.2 +052800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +052900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +053000 WRITE-LINE. NC2074.2 +053100 ADD 1 TO RECORD-COUNT. NC2074.2 +053200Y IF RECORD-COUNT GREATER 50 NC2074.2 +053300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2074.2 +053400Y MOVE SPACE TO DUMMY-RECORD NC2074.2 +053500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2074.2 +053600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2074.2 +053700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2074.2 +053800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2074.2 +053900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2074.2 +054000Y MOVE ZERO TO RECORD-COUNT. NC2074.2 +054100 PERFORM WRT-LN. NC2074.2 +054200 WRT-LN. NC2074.2 +054300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2074.2 +054400 MOVE SPACE TO DUMMY-RECORD. NC2074.2 +054500 BLANK-LINE-PRINT. NC2074.2 +054600 PERFORM WRT-LN. NC2074.2 +054700 FAIL-ROUTINE. NC2074.2 +054800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2074.2 +054900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2074.2 +055000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2074.2 +055100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2074.2 +055200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +055300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2074.2 +055400 GO TO FAIL-ROUTINE-EX. NC2074.2 +055500 FAIL-ROUTINE-WRITE. NC2074.2 +055600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2074.2 +055700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2074.2 +055800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2074.2 +055900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2074.2 +056000 FAIL-ROUTINE-EX. EXIT. NC2074.2 +056100 BAIL-OUT. NC2074.2 +056200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2074.2 +056300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2074.2 +056400 BAIL-OUT-WRITE. NC2074.2 +056500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2074.2 +056600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2074.2 +056700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +056800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2074.2 +056900 BAIL-OUT-EX. EXIT. NC2074.2 +057000 CCVS1-EXIT. NC2074.2 +057100 EXIT. NC2074.2 +057200 SECT-NC207A-001 SECTION. NC2074.2 +057300 ADD-INIT-F1-1. NC2074.2 +057400 MOVE "ADD-TEST-F1-1 " TO PAR-NAME. NC2074.2 +057500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +057600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +057700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +057800 ADD-TEST-F1-1. NC2074.2 +057900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +058000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +058100 TO ACCUMULATOR1. NC2074.2 +058200 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +058300 PERFORM PASS NC2074.2 +058400 GO TO ADD-WRITE-F1-1. NC2074.2 +058500 GO TO ADD-FAIL-F1-1. NC2074.2 +058600 ADD-DELETE-F1-1. NC2074.2 +058700 PERFORM DE-LETE. NC2074.2 +058800 GO TO ADD-WRITE-F1-1. NC2074.2 +058900 ADD-FAIL-F1-1. NC2074.2 +059000 MOVE 1 TO CORRECT-N. NC2074.2 +059100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +059200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +059300 TO COMPUTED-N. NC2074.2 +059400 PERFORM FAIL. NC2074.2 +059500 ADD-WRITE-F1-1. NC2074.2 +059600 PERFORM PRINT-DETAIL. NC2074.2 +059700* NC2074.2 +059800 ADD-INIT-F1-2. NC2074.2 +059900 MOVE "ADD-TEST-F1-2 " TO PAR-NAME. NC2074.2 +060000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +060100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +060200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +060300 ADD-TEST-F1-2. NC2074.2 +060400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +060500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +060600 ACCUMULATOR1. NC2074.2 +060700 IF ACCUMULATOR1 EQUAL TO 2 NC2074.2 +060800 PERFORM PASS NC2074.2 +060900 GO TO ADD-WRITE-F1-2. NC2074.2 +061000 GO TO ADD-FAIL-F1-2. NC2074.2 +061100 ADD-DELETE-F1-2. NC2074.2 +061200 PERFORM DE-LETE. NC2074.2 +061300 GO TO ADD-WRITE-F1-2. NC2074.2 +061400 ADD-FAIL-F1-2. NC2074.2 +061500 MOVE 2 TO CORRECT-N. NC2074.2 +061600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +061700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +061800 COMPUTED-N. NC2074.2 +061900 PERFORM FAIL. NC2074.2 +062000 ADD-WRITE-F1-2. NC2074.2 +062100 PERFORM PRINT-DETAIL. NC2074.2 +062200* NC2074.2 +062300 ADD-INIT-F1-3. NC2074.2 +062400 MOVE "ADD-TEST-F1-3 " TO PAR-NAME. NC2074.2 +062500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +062600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +062700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +062800 ADD-TEST-F1-3. NC2074.2 +062900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +063000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +063100 ACCUMULATOR1. NC2074.2 +063200 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +063300 PERFORM PASS NC2074.2 +063400 GO TO ADD-WRITE-F1-3. NC2074.2 +063500 GO TO ADD-FAIL-F1-3. NC2074.2 +063600 ADD-DELETE-F1-3. NC2074.2 +063700 PERFORM DE-LETE. NC2074.2 +063800 GO TO ADD-WRITE-F1-3. NC2074.2 +063900 ADD-FAIL-F1-3. NC2074.2 +064000 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +064100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +064200 COMPUTED-N. NC2074.2 +064300 MOVE 3 TO CORRECT-N. NC2074.2 +064400 PERFORM FAIL. NC2074.2 +064500 ADD-WRITE-F1-3. NC2074.2 +064600 PERFORM PRINT-DETAIL. NC2074.2 +064700* NC2074.2 +064800 ADD-INIT-F1-4. NC2074.2 +064900 MOVE "ADD-TEST-F1-4 " TO PAR-NAME. NC2074.2 +065000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +065100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +065200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +065300 ADD-TEST-F1-4. NC2074.2 +065400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +065500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +065600 ACCUMULATOR1. NC2074.2 +065700 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +065800 PERFORM PASS NC2074.2 +065900 GO TO ADD-WRITE-F1-4. NC2074.2 +066000 GO TO ADD-FAIL-F1-4. NC2074.2 +066100 ADD-DELETE-F1-4. NC2074.2 +066200 PERFORM DE-LETE. NC2074.2 +066300 GO TO ADD-WRITE-F1-4. NC2074.2 +066400 ADD-FAIL-F1-4. NC2074.2 +066500 MOVE 4 TO CORRECT-N. NC2074.2 +066600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +066700 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +066800 COMPUTED-N. NC2074.2 +066900 PERFORM FAIL. NC2074.2 +067000 ADD-WRITE-F1-4. NC2074.2 +067100 PERFORM PRINT-DETAIL. NC2074.2 +067200* NC2074.2 +067300 ADD-INIT-F1-5. NC2074.2 +067400 MOVE "ADD-TEST-F1-5 " TO PAR-NAME. NC2074.2 +067500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +067600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +067700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +067800 ADD-TEST-F1-5. NC2074.2 +067900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +068000 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +068100 ACCUMULATOR1. NC2074.2 +068200 IF ACCUMULATOR1 EQUAL TO 5 NC2074.2 +068300 PERFORM PASS NC2074.2 +068400 GO TO ADD-WRITE-F1-5. NC2074.2 +068500 GO TO ADD-FAIL-F1-5. NC2074.2 +068600 ADD-DELETE-F1-5. NC2074.2 +068700 PERFORM DE-LETE. NC2074.2 +068800 GO TO ADD-WRITE-F1-5. NC2074.2 +068900 ADD-FAIL-F1-5. NC2074.2 +069000 MOVE 5 TO CORRECT-N. NC2074.2 +069100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +069200 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +069300 COMPUTED-N. NC2074.2 +069400 PERFORM FAIL. NC2074.2 +069500 ADD-WRITE-F1-5. NC2074.2 +069600 PERFORM PRINT-DETAIL. NC2074.2 +069700* NC2074.2 +069800 ADD-INIT-F1-6. NC2074.2 +069900 MOVE "ADD-TEST-F1-6 " TO PAR-NAME. NC2074.2 +070000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +070100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +070200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +070300 ADD-TEST-F1-6. NC2074.2 +070400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +070500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +070600 ACCUMULATOR1. NC2074.2 +070700 IF ACCUMULATOR1 EQUAL TO 6 NC2074.2 +070800 PERFORM PASS NC2074.2 +070900 GO TO ADD-WRITE-F1-6. NC2074.2 +071000 GO TO ADD-FAIL-F1-6. NC2074.2 +071100 ADD-DELETE-F1-6. NC2074.2 +071200 PERFORM DE-LETE. NC2074.2 +071300 GO TO ADD-WRITE-F1-6. NC2074.2 +071400 ADD-FAIL-F1-6. NC2074.2 +071500 MOVE 6 TO CORRECT-N. NC2074.2 +071600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +071700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +071800 COMPUTED-N. NC2074.2 +071900 PERFORM FAIL. NC2074.2 +072000 ADD-WRITE-F1-6. NC2074.2 +072100 PERFORM PRINT-DETAIL. NC2074.2 +072200* NC2074.2 +072300 ADD-INIT-F1-7. NC2074.2 +072400 MOVE "ADD-TEST-F1-7" TO PAR-NAME. NC2074.2 +072500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +072600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +072700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +072800 ADD-TEST-F1-7. NC2074.2 +072900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +073000 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +073100 ACCUMULATOR1. NC2074.2 +073200 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +073300 PERFORM PASS NC2074.2 +073400 GO TO ADD-WRITE-F1-7. NC2074.2 +073500 GO TO ADD-FAIL-F1-7. NC2074.2 +073600 ADD-DELETE-F1-7. NC2074.2 +073700 PERFORM DE-LETE. NC2074.2 +073800 GO TO ADD-WRITE-F1-7. NC2074.2 +073900 ADD-FAIL-F1-7. NC2074.2 +074000 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +074100 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +074200 COMPUTED-N. NC2074.2 +074300 MOVE 7 TO CORRECT-N. NC2074.2 +074400 PERFORM FAIL. NC2074.2 +074500 ADD-WRITE-F1-7. NC2074.2 +074600 PERFORM PRINT-DETAIL. NC2074.2 +074700* NC2074.2 +074800 ADD-INIT-F1-8. NC2074.2 +074900 MOVE "ADD-TEST-F1-8 " TO PAR-NAME. NC2074.2 +075000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +075100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +075200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +075300 ADD-TEST-F1-8. NC2074.2 +075400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +075500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +075600 ACCUMULATOR1. NC2074.2 +075700 IF ACCUMULATOR1 EQUAL TO 8 NC2074.2 +075800 PERFORM PASS NC2074.2 +075900 GO TO ADD-WRITE-F1-8. NC2074.2 +076000 GO TO ADD-FAIL-F1-8. NC2074.2 +076100 ADD-DELETE-F1-8. NC2074.2 +076200 PERFORM DE-LETE. NC2074.2 +076300 GO TO ADD-WRITE-F1-8. NC2074.2 +076400 ADD-FAIL-F1-8. NC2074.2 +076500 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +076600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +076700 COMPUTED-N. NC2074.2 +076800 MOVE 8 TO CORRECT-N. NC2074.2 +076900 PERFORM FAIL. NC2074.2 +077000 ADD-WRITE-F1-8. NC2074.2 +077100 PERFORM PRINT-DETAIL. NC2074.2 +077200* NC2074.2 +077300 ADD-INIT-F2-9. NC2074.2 +077400 MOVE "ADD-TEST-F2-9 " TO PAR-NAME. NC2074.2 +077500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +077600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +077700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +077800 ADD-TEST-F2-9. NC2074.2 +077900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +078000 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +078100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +078200 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +078300 GIVING ACCUMULATOR2. NC2074.2 +078400 IF ACCUMULATOR2 EQUAL TO 18 NC2074.2 +078500 PERFORM PASS NC2074.2 +078600 GO TO ADD-WRITE-F2-9. NC2074.2 +078700 GO TO ADD-FAIL-F2-9. NC2074.2 +078800 ADD-DELETE-F2-9. NC2074.2 +078900 PERFORM DE-LETE. NC2074.2 +079000 GO TO ADD-WRITE-F2-9. NC2074.2 +079100 ADD-FAIL-F2-9. NC2074.2 +079200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +079300 MOVE 18 TO CORRECT-N. NC2074.2 +079400 PERFORM FAIL. NC2074.2 +079500 ADD-WRITE-F2-9. NC2074.2 +079600 PERFORM PRINT-DETAIL. NC2074.2 +079700* NC2074.2 +079800 ADD-INIT-F2-10. NC2074.2 +079900 MOVE "ADD-TEST-F2-10 " TO PAR-NAME. NC2074.2 +080000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +080100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +080200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +080300 ADD-TEST-F2-10. NC2074.2 +080400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +080500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +080600 TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +080700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +080800 GIVING ACCUMULATOR2. NC2074.2 +080900 IF ACCUMULATOR2 EQUAL TO 20 NC2074.2 +081000 PERFORM PASS NC2074.2 +081100 GO TO ADD-WRITE-F2-10. NC2074.2 +081200 GO TO ADD-FAIL-F2-10. NC2074.2 +081300 ADD-DELETE-F2-10. NC2074.2 +081400 PERFORM DE-LETE. NC2074.2 +081500 GO TO ADD-WRITE-F2-10. NC2074.2 +081600 ADD-FAIL-F2-10. NC2074.2 +081700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +081800 MOVE 20 TO CORRECT-N. NC2074.2 +081900 PERFORM FAIL. NC2074.2 +082000 ADD-WRITE-F2-10. NC2074.2 +082100 PERFORM PRINT-DETAIL. NC2074.2 +082200* NC2074.2 +082300 ADD-INIT-F2-11. NC2074.2 +082400 MOVE "ADD-TEST-F2-11 " TO PAR-NAME. NC2074.2 +082500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +082600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +082700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +082800 ADD-TEST-F2-11. NC2074.2 +082900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +083000 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +083100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +083200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +083300 GIVING ACCUMULATOR2. NC2074.2 +083400 IF ACCUMULATOR2 EQUAL TO 22 NC2074.2 +083500 PERFORM PASS NC2074.2 +083600 GO TO ADD-WRITE-F2-11. NC2074.2 +083700 GO TO ADD-FAIL-F2-11. NC2074.2 +083800 ADD-DELETE-F2-11. NC2074.2 +083900 PERFORM DE-LETE. NC2074.2 +084000 GO TO ADD-WRITE-F2-11. NC2074.2 +084100 ADD-FAIL-F2-11. NC2074.2 +084200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +084300 MOVE 22 TO CORRECT-N. NC2074.2 +084400 PERFORM FAIL. NC2074.2 +084500 ADD-WRITE-F2-11. NC2074.2 +084600 PERFORM PRINT-DETAIL. NC2074.2 +084700* NC2074.2 +084800 ADD-INIT-F2-12. NC2074.2 +084900 MOVE "ADD-TEST-F2-12 " TO PAR-NAME. NC2074.2 +085000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +085100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +085200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +085300 ADD-TEST-F2-12. NC2074.2 +085400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +085500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +085600 TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +085700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +085800 GIVING ACCUMULATOR2. NC2074.2 +085900 IF ACCUMULATOR2 EQUAL TO 24 NC2074.2 +086000 PERFORM PASS NC2074.2 +086100 GO TO ADD-WRITE-F2-12. NC2074.2 +086200 GO TO ADD-FAIL-F2-12. NC2074.2 +086300 ADD-DELETE-F2-12. NC2074.2 +086400 PERFORM DE-LETE. NC2074.2 +086500 GO TO ADD-WRITE-F2-12. NC2074.2 +086600 ADD-FAIL-F2-12. NC2074.2 +086700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +086800 MOVE 24 TO CORRECT-N. NC2074.2 +086900 PERFORM FAIL. NC2074.2 +087000 ADD-WRITE-F2-12. NC2074.2 +087100 PERFORM PRINT-DETAIL. NC2074.2 +087200* NC2074.2 +087300 ADD-INIT-F2-13. NC2074.2 +087400 MOVE "ADD-TEST-F2-13 " TO PAR-NAME. NC2074.2 +087500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +087600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +087700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +087800 ADD-TEST-F2-13. NC2074.2 +087900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A IN NC2074.2 +088000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +088100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A IN NC2074.2 +088200 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +088300 GIVING ACCUMULATOR2. NC2074.2 +088400 IF ACCUMULATOR2 EQUAL TO 26 NC2074.2 +088500 PERFORM PASS NC2074.2 +088600 GO TO ADD-WRITE-F2-13. NC2074.2 +088700 GO TO ADD-FAIL-F2-13. NC2074.2 +088800 ADD-DELETE-F2-13. NC2074.2 +088900 PERFORM DE-LETE. NC2074.2 +089000 GO TO ADD-WRITE-F2-13. NC2074.2 +089100 ADD-FAIL-F2-13. NC2074.2 +089200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +089300 MOVE 26 TO CORRECT-N. NC2074.2 +089400 PERFORM FAIL. NC2074.2 +089500 ADD-WRITE-F2-13. NC2074.2 +089600 PERFORM PRINT-DETAIL. NC2074.2 +089700* NC2074.2 +089800 ADD-INIT-F2-14. NC2074.2 +089900 MOVE "ADD-TEST-F2-14 " TO PAR-NAME. NC2074.2 +090000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +090100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +090200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +090300 ADD-TEST-F2-14. NC2074.2 +090400 ADD TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2074.2 +090500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +090600 TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2074.2 +090700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +090800 GIVING ACCUMULATOR2. NC2074.2 +090900 IF ACCUMULATOR2 EQUAL TO 28 NC2074.2 +091000 PERFORM PASS NC2074.2 +091100 GO TO ADD-WRITE-F2-14. NC2074.2 +091200 GO TO ADD-FAIL-F2-14. NC2074.2 +091300 ADD-DELETE-F2-14. NC2074.2 +091400 PERFORM DE-LETE. NC2074.2 +091500 GO TO ADD-WRITE-F2-14. NC2074.2 +091600 ADD-FAIL-F2-14. NC2074.2 +091700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +091800 MOVE 28 TO CORRECT-N. NC2074.2 +091900 PERFORM FAIL. NC2074.2 +092000 ADD-WRITE-F2-14. NC2074.2 +092100 PERFORM PRINT-DETAIL. NC2074.2 +092200* NC2074.2 +092300 ADD-INIT-F2-15. NC2074.2 +092400 MOVE "ADD-TEST-F2-15 " TO PAR-NAME. NC2074.2 +092500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +092600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +092700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +092800 ADD-TEST-F2-15. NC2074.2 +092900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2074.2 +093000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +093100 TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2074.2 +093200 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +093300 GIVING ACCUMULATOR2. NC2074.2 +093400 IF ACCUMULATOR2 EQUAL TO 30 NC2074.2 +093500 PERFORM PASS NC2074.2 +093600 GO TO ADD-WRITE-F2-15. NC2074.2 +093700 GO TO ADD-FAIL-F2-15. NC2074.2 +093800 ADD-DELETE-F2-15. NC2074.2 +093900 PERFORM DE-LETE. NC2074.2 +094000 GO TO ADD-WRITE-F2-15. NC2074.2 +094100 ADD-FAIL-F2-15. NC2074.2 +094200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +094300 MOVE 30 TO CORRECT-N. NC2074.2 +094400 PERFORM FAIL. NC2074.2 +094500 ADD-WRITE-F2-15. NC2074.2 +094600 PERFORM PRINT-DETAIL. NC2074.2 +094700* NC2074.2 +094800 ADD-INIT-F2-16. NC2074.2 +094900 MOVE "ADD-TEST-F2-16 " TO PAR-NAME. NC2074.2 +095000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +095100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +095200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +095300 ADD-TEST-F2-16. NC2074.2 +095400 ADD TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +095500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +095600 TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +095700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +095800 GIVING ACCUMULATOR2. NC2074.2 +095900 IF ACCUMULATOR2 EQUAL TO 32 NC2074.2 +096000 PERFORM PASS NC2074.2 +096100 GO TO ADD-WRITE-F2-16. NC2074.2 +096200 GO TO ADD-FAIL-F2-16. NC2074.2 +096300 ADD-DELETE-F2-16. NC2074.2 +096400 PERFORM DE-LETE. NC2074.2 +096500 GO TO ADD-WRITE-F2-16. NC2074.2 +096600 ADD-FAIL-F2-16. NC2074.2 +096700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +096800 MOVE 32 TO CORRECT-N. NC2074.2 +096900 PERFORM FAIL. NC2074.2 +097000 ADD-WRITE-F2-16. NC2074.2 +097100 PERFORM PRINT-DETAIL. NC2074.2 +097200* NC2074.2 +097300 ADD-INIT-F3-17. NC2074.2 +097400 MOVE "ADD-TEST-F3-17" TO PAR-NAME. NC2074.2 +097500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +097600 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +097700 ADD CORRESPONDING TABLE-LEVEL-5A TO TABLE-LEVEL-5B. NC2074.2 +097800 ADD-TEST-F3-17. NC2074.2 +097900 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +098000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +098100 EQUAL TO 17 NC2074.2 +098200 PERFORM PASS NC2074.2 +098300 GO TO ADD-WRITE-F3-17. NC2074.2 +098400 GO TO ADD-FAIL-F3-17. NC2074.2 +098500 ADD-DELETE-F3-17. NC2074.2 +098600 PERFORM DE-LETE. NC2074.2 +098700 GO TO ADD-WRITE-F3-17. NC2074.2 +098800 ADD-FAIL-F3-17. NC2074.2 +098900 MOVE 17 TO CORRECT-N. NC2074.2 +099000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +099100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +099200 TO COMPUTED-N. NC2074.2 +099300 PERFORM FAIL. NC2074.2 +099400 ADD-WRITE-F3-17. NC2074.2 +099500 PERFORM PRINT-DETAIL. NC2074.2 +099600* NC2074.2 +099700 ADD-INIT-F3-18. NC2074.2 +099800 MOVE "ADD-TEST-F3-18" TO PAR-NAME. NC2074.2 +099900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +100000 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +100100 ADD-TEST-F3-18. NC2074.2 +100200 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +100300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +100400 EQUAL TO 17 NC2074.2 +100500 PERFORM PASS NC2074.2 +100600 GO TO ADD-WRITE-F3-18. NC2074.2 +100700 ADD-DELETE-F3-18. NC2074.2 +100800 PERFORM DE-LETE. NC2074.2 +100900 GO TO ADD-WRITE-F3-18. NC2074.2 +101000 ADD-FAIL-F3-18. NC2074.2 +101100 MOVE 17 TO CORRECT-N. NC2074.2 +101200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +101300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +101400 TO COMPUTED-N. NC2074.2 +101500 PERFORM FAIL. NC2074.2 +101600 ADD-WRITE-F3-18. NC2074.2 +101700 PERFORM PRINT-DETAIL. NC2074.2 +101800* NC2074.2 +101900 ADD-INIT-F3-19. NC2074.2 +102000 MOVE "ADD-TEST-F3-19" TO PAR-NAME. NC2074.2 +102100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +102200 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +102300 ADD-TEST-F3-19. NC2074.2 +102400 IF TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +102500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +102600 EQUAL TO 17 NC2074.2 +102700 PERFORM PASS NC2074.2 +102800 GO TO ADD-WRITE-F3-19. NC2074.2 +102900 GO TO ADD-FAIL-F3-19. NC2074.2 +103000 ADD-DELETE-F3-19. NC2074.2 +103100 PERFORM DE-LETE. NC2074.2 +103200 GO TO ADD-WRITE-F3-19. NC2074.2 +103300 ADD-FAIL-F3-19. NC2074.2 +103400 MOVE 17 TO CORRECT-N. NC2074.2 +103500 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +103600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +103700 TO COMPUTED-N. NC2074.2 +103800 PERFORM FAIL. NC2074.2 +103900 ADD-WRITE-F3-19. NC2074.2 +104000 PERFORM PRINT-DETAIL. NC2074.2 +104100* NC2074.2 +104200 ADD-INIT-F3-20. NC2074.2 +104300 MOVE "ADD-TEST-F3-20" TO PAR-NAME. NC2074.2 +104400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +104500 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +104600 ADD-TEST-F3-20. NC2074.2 +104700 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +104800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +104900 EQUAL TO 17 NC2074.2 +105000 PERFORM PASS NC2074.2 +105100 GO TO ADD-WRITE-F3-20. NC2074.2 +105200 GO TO ADD-FAIL-F3-20. NC2074.2 +105300 ADD-DELETE-F3-20. NC2074.2 +105400 PERFORM DE-LETE. NC2074.2 +105500 GO TO ADD-WRITE-F3-20. NC2074.2 +105600 ADD-FAIL-F3-20. NC2074.2 +105700 MOVE 17 TO CORRECT-N. NC2074.2 +105800 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +105900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +106000 TO COMPUTED-N. NC2074.2 +106100 PERFORM FAIL. NC2074.2 +106200 ADD-WRITE-F3-20. NC2074.2 +106300 PERFORM PRINT-DETAIL. NC2074.2 +106400* NC2074.2 +106500 ADD-INIT-F3-21. NC2074.2 +106600 MOVE "ADD-TEST-F3-21" TO PAR-NAME. NC2074.2 +106700 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +106800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +106900 ADD-TEST-F3-21. NC2074.2 +107000 IF TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +107100 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +107200 EQUAL TO 17 NC2074.2 +107300 PERFORM PASS NC2074.2 +107400 GO TO ADD-WRITE-F3-21. NC2074.2 +107500 GO TO ADD-FAIL-F3-21. NC2074.2 +107600 ADD-DELETE-F3-21. NC2074.2 +107700 PERFORM DE-LETE. NC2074.2 +107800 GO TO ADD-WRITE-F3-21. NC2074.2 +107900 ADD-FAIL-F3-21. NC2074.2 +108000 MOVE 17 TO CORRECT-N. NC2074.2 +108100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +108200 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +108300 TO COMPUTED-N. NC2074.2 +108400 PERFORM FAIL. NC2074.2 +108500 ADD-WRITE-F3-21. NC2074.2 +108600 PERFORM PRINT-DETAIL. NC2074.2 +108700* NC2074.2 +108800 ADD-INIT-F3-22. NC2074.2 +108900 MOVE "ADD-TEST-F3-22" TO PAR-NAME. NC2074.2 +109000 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +109100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +109200 ADD-TEST-F3-22. NC2074.2 +109300 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +109400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +109500 EQUAL TO 17 NC2074.2 +109600 PERFORM PASS NC2074.2 +109700 GO TO ADD-WRITE-F3-22. NC2074.2 +109800 GO TO ADD-FAIL-F3-22. NC2074.2 +109900 ADD-DELETE-F3-22. NC2074.2 +110000 PERFORM DE-LETE. NC2074.2 +110100 GO TO ADD-WRITE-F3-22. NC2074.2 +110200 ADD-FAIL-F3-22. NC2074.2 +110300 MOVE 17 TO CORRECT-N. NC2074.2 +110400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +110500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B TO NC2074.2 +110600 COMPUTED-N. NC2074.2 +110700 PERFORM FAIL. NC2074.2 +110800 ADD-WRITE-F3-22. NC2074.2 +110900 PERFORM PRINT-DETAIL. NC2074.2 +111000* NC2074.2 +111100 ADD-INIT-F3-23. NC2074.2 +111200 MOVE "ADD-TEST-F3-23" TO PAR-NAME. NC2074.2 +111300 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +111400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +111500 ADD-TEST-F3-23. NC2074.2 +111600 IF TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +111700 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +111800 EQUAL TO 17 NC2074.2 +111900 PERFORM PASS NC2074.2 +112000 GO TO ADD-WRITE-F3-23. NC2074.2 +112100 GO TO ADD-FAIL-F3-23. NC2074.2 +112200 ADD-DELETE-F3-23. NC2074.2 +112300 PERFORM DE-LETE. NC2074.2 +112400 GO TO ADD-WRITE-F3-23. NC2074.2 +112500 ADD-FAIL-F3-23. NC2074.2 +112600 MOVE 17 TO CORRECT-N. NC2074.2 +112700 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +112800 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B TO NC2074.2 +112900 COMPUTED-N. NC2074.2 +113000 PERFORM FAIL. NC2074.2 +113100 ADD-WRITE-F3-23. NC2074.2 +113200 PERFORM PRINT-DETAIL. NC2074.2 +113300* NC2074.2 +113400 ADD-INIT-F3-24. NC2074.2 +113500 MOVE "ADD-TEST-F3-24" TO PAR-NAME. NC2074.2 +113600 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +113700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +113800 ADD-TEST-F3-24. NC2074.2 +113900 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +114000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +114100 EQUAL TO 17 NC2074.2 +114200 PERFORM PASS NC2074.2 +114300 GO TO ADD-WRITE-F3-24. NC2074.2 +114400 GO TO ADD-FAIL-F3-24. NC2074.2 +114500 ADD-DELETE-F3-24. NC2074.2 +114600 PERFORM DE-LETE. NC2074.2 +114700 GO TO ADD-WRITE-F3-24. NC2074.2 +114800 ADD-FAIL-F3-24. NC2074.2 +114900 MOVE 17 TO CORRECT-N. NC2074.2 +115000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +115100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B TO NC2074.2 +115200 COMPUTED-N. NC2074.2 +115300 PERFORM FAIL. NC2074.2 +115400 ADD-WRITE-F3-24. NC2074.2 +115500 PERFORM PRINT-DETAIL. NC2074.2 +115600 PERFORM END-ROUTINE. NC2074.2 +115700* NC2074.2 +115800 ADD-INIT-F1-25. NC2074.2 +115900* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +116000 MOVE "ADD-TEST-F1-25 " TO PAR-NAME. NC2074.2 +116100 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +116200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +116300 ADD-TEST-F1-25. NC2074.2 +116400 ADD GROUP-49-1 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +116500 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +116600 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +116700 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +116800 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +116900 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +117000 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +117100 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +117200 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +117300 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +117400 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +117500 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +117600 IN SECOND-GROUP NC2074.2 +117700 TO ACCUMULATOR2. NC2074.2 +117800 IF ACCUMULATOR2 EQUAL TO 100 NC2074.2 +117900 PERFORM PASS NC2074.2 +118000 GO TO ADD-WRITE-F1-25. NC2074.2 +118100 GO TO ADD-FAIL-F1-25. NC2074.2 +118200 ADD-DELETE-F1-25. NC2074.2 +118300 PERFORM DE-LETE. NC2074.2 +118400 GO TO ADD-WRITE-F1-25. NC2074.2 +118500 ADD-FAIL-F1-25. NC2074.2 +118600 MOVE 100 TO CORRECT-N. NC2074.2 +118700 MOVE GROUP-49-1 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +118800 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +118900 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +119000 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +119100 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +119200 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +119300 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +119400 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +119500 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +119600 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +119700 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +119800 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +119900 IN SECOND-GROUP NC2074.2 +120000 TO COMPUTED-N. NC2074.2 +120100 PERFORM FAIL. NC2074.2 +120200 ADD-WRITE-F1-25. NC2074.2 +120300 PERFORM PRINT-DETAIL. NC2074.2 +120400* NC2074.2 +120500 SUB-INIT-F2-1. NC2074.2 +120600 MOVE "SUB-TEST-F2-1 " TO PAR-NAME. NC2074.2 +120700 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +120800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +120900 MOVE TABLE-5B-INIT TO TABLE-LEVEL-5B. NC2074.2 +121000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +121100 SUB-TEST-F2-1. NC2074.2 +121200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +121300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +121400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +121500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +121600 GIVING ACCUMULATOR1. NC2074.2 +121700 IF ACCUMULATOR1 EQUAL TO 15 NC2074.2 +121800 PERFORM PASS NC2074.2 +121900 GO TO SUB-WRITE-F2-1. NC2074.2 +122000 GO TO SUB-FAIL-F2-1. NC2074.2 +122100 SUB-DELETE-F2-1. NC2074.2 +122200 PERFORM DE-LETE. NC2074.2 +122300 GO TO SUB-WRITE-F2-1. NC2074.2 +122400 SUB-FAIL-F2-1. NC2074.2 +122500 MOVE 15 TO CORRECT-N. NC2074.2 +122600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +122700 PERFORM FAIL. NC2074.2 +122800 SUB-WRITE-F2-1. NC2074.2 +122900 PERFORM PRINT-DETAIL. NC2074.2 +123000* NC2074.2 +123100 SUB-INIT-F2-2. NC2074.2 +123200 MOVE "SUB-TEST-F2-2 " TO PAR-NAME. NC2074.2 +123300 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +123400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +123500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +123600 SUB-TEST-F2-2. NC2074.2 +123700 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +123800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +123900 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +124000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +124100 GIVING ACCUMULATOR1. NC2074.2 +124200 IF ACCUMULATOR1 EQUAL TO 13 NC2074.2 +124300 PERFORM PASS NC2074.2 +124400 GO TO SUB-WRITE-F2-2. NC2074.2 +124500 GO TO SUB-FAIL-F2-2. NC2074.2 +124600 SUB-DELETE-F2-2. NC2074.2 +124700 PERFORM DE-LETE. NC2074.2 +124800 GO TO SUB-WRITE-F2-2. NC2074.2 +124900 SUB-FAIL-F2-2. NC2074.2 +125000 MOVE 13 TO CORRECT-N. NC2074.2 +125100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +125200 PERFORM FAIL. NC2074.2 +125300 SUB-WRITE-F2-2. NC2074.2 +125400 PERFORM PRINT-DETAIL. NC2074.2 +125500* NC2074.2 +125600 SUB-INIT-F2-3. NC2074.2 +125700 MOVE "SUB-TEST-F2-3 " TO PAR-NAME. NC2074.2 +125800 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +125900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +126000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +126100 SUB-TEST-F2-3. NC2074.2 +126200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +126300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +126400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +126500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +126600 GIVING ACCUMULATOR1. NC2074.2 +126700 IF ACCUMULATOR1 EQUAL TO 11 NC2074.2 +126800 PERFORM PASS NC2074.2 +126900 GO TO SUB-WRITE-F2-3. NC2074.2 +127000 GO TO SUB-FAIL-F2-3. NC2074.2 +127100 SUB-DELETE-F2-3. NC2074.2 +127200 PERFORM DE-LETE. NC2074.2 +127300 GO TO SUB-WRITE-F2-3. NC2074.2 +127400 SUB-FAIL-F2-3. NC2074.2 +127500 MOVE 11 TO CORRECT-N. NC2074.2 +127600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +127700 PERFORM FAIL. NC2074.2 +127800 SUB-WRITE-F2-3. NC2074.2 +127900 PERFORM PRINT-DETAIL. NC2074.2 +128000* NC2074.2 +128100 SUB-INIT-F2-4. NC2074.2 +128200 MOVE "SUB-TEST-F2-4 " TO PAR-NAME. NC2074.2 +128300 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +128400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +128500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +128600 SUB-TEST-F2-4. NC2074.2 +128700 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +128800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +128900 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +129000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +129100 GIVING ACCUMULATOR1. NC2074.2 +129200 IF ACCUMULATOR1 EQUAL TO 9 NC2074.2 +129300 PERFORM PASS NC2074.2 +129400 GO TO SUB-WRITE-F2-4. NC2074.2 +129500 GO TO SUB-FAIL-F2-4. NC2074.2 +129600 SUB-DELETE-F2-4. NC2074.2 +129700 PERFORM DE-LETE. NC2074.2 +129800 GO TO SUB-WRITE-F2-4. NC2074.2 +129900 SUB-FAIL-F2-4. NC2074.2 +130000 MOVE 9 TO CORRECT-N. NC2074.2 +130100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +130200 PERFORM FAIL. NC2074.2 +130300 SUB-WRITE-F2-4. NC2074.2 +130400 PERFORM PRINT-DETAIL. NC2074.2 +130500* NC2074.2 +130600 SUB-INIT-F2-5. NC2074.2 +130700 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +130800 MOVE "SUB-TEST-F2-5 " TO PAR-NAME. NC2074.2 +130900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +131000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +131100 SUB-TEST-F2-5. NC2074.2 +131200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +131300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +131400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +131500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +131600 GIVING ACCUMULATOR1. NC2074.2 +131700 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +131800 PERFORM PASS NC2074.2 +131900 GO TO SUB-WRITE-F2-5. NC2074.2 +132000 GO TO SUB-FAIL-F2-5. NC2074.2 +132100 SUB-DELETE-F2-5. NC2074.2 +132200 PERFORM DE-LETE. NC2074.2 +132300 GO TO SUB-WRITE-F2-5. NC2074.2 +132400 SUB-FAIL-F2-5. NC2074.2 +132500 MOVE 7 TO CORRECT-N. NC2074.2 +132600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +132700 PERFORM FAIL. NC2074.2 +132800 SUB-WRITE-F2-5. NC2074.2 +132900 PERFORM PRINT-DETAIL. NC2074.2 +133000* NC2074.2 +133100 SUB-INIT-F2-6. NC2074.2 +133200 MOVE "SUB-TEST-F2-6 " TO PAR-NAME. NC2074.2 +133300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +133400 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +133500 SUB-TEST-F2-6. NC2074.2 +133600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +133700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +133800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +133900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +134000 GIVING ACCUMULATOR1. NC2074.2 +134100 IF ACCUMULATOR1 EQUAL TO 5 NC2074.2 +134200 PERFORM PASS NC2074.2 +134300 GO TO SUB-WRITE-F2-6. NC2074.2 +134400 GO TO SUB-FAIL-F2-6. NC2074.2 +134500 SUB-DELETE-F2-6. NC2074.2 +134600 PERFORM DE-LETE. NC2074.2 +134700 GO TO SUB-WRITE-F2-6. NC2074.2 +134800 SUB-FAIL-F2-6. NC2074.2 +134900 MOVE 5 TO CORRECT-N. NC2074.2 +135000 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +135100 PERFORM FAIL. NC2074.2 +135200 SUB-WRITE-F2-6. NC2074.2 +135300 PERFORM PRINT-DETAIL. NC2074.2 +135400* NC2074.2 +135500 SUB-INIT-F2-7. NC2074.2 +135600 MOVE "SUB-TEST-F2-7 " TO PAR-NAME. NC2074.2 +135700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +135800 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +135900 SUB-TEST-F2-7. NC2074.2 +136000 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +136100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +136200 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +136300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +136400 GIVING ACCUMULATOR1. NC2074.2 +136500 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +136600 PERFORM PASS NC2074.2 +136700 GO TO SUB-WRITE-F2-7. NC2074.2 +136800 GO TO SUB-FAIL-F2-7. NC2074.2 +136900 SUB-DELETE-F2-7. NC2074.2 +137000 PERFORM DE-LETE. NC2074.2 +137100 GO TO SUB-WRITE-F2-7. NC2074.2 +137200 SUB-FAIL-F2-7. NC2074.2 +137300 MOVE 3 TO CORRECT-N. NC2074.2 +137400 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +137500 PERFORM FAIL. NC2074.2 +137600 SUB-WRITE-F2-7. NC2074.2 +137700 PERFORM PRINT-DETAIL. NC2074.2 +137800* NC2074.2 +137900 SUB-INIT-F2-8. NC2074.2 +138000 MOVE "SUB-TEST-F2-8 " TO PAR-NAME. NC2074.2 +138100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +138200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +138300 SUB-TEST-F2-8. NC2074.2 +138400 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +138500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +138600 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +138700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +138800 GIVING ACCUMULATOR1. NC2074.2 +138900 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +139000 PERFORM PASS NC2074.2 +139100 GO TO SUB-WRITE-F2-8. NC2074.2 +139200 GO TO SUB-FAIL-F2-8. NC2074.2 +139300 SUB-DELETE-F2-8. NC2074.2 +139400 PERFORM DE-LETE. NC2074.2 +139500 GO TO SUB-WRITE-F2-8. NC2074.2 +139600 SUB-FAIL-F2-8. NC2074.2 +139700 MOVE 1 TO CORRECT-N. NC2074.2 +139800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +139900 PERFORM FAIL. NC2074.2 +140000 SUB-WRITE-F2-8. NC2074.2 +140100 PERFORM PRINT-DETAIL. NC2074.2 +140200* NC2074.2 +140300 SUB-INIT-F2-9. NC2074.2 +140400 MOVE "SUB-TEST-F2-9 " TO PAR-NAME. NC2074.2 +140500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +140600 MOVE 5 TO ACCUMULATOR2. NC2074.2 +140700 SUB-TEST-F2-9. NC2074.2 +140800 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +140900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +141000 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +141100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +141200 GIVING ACCUMULATOR2. NC2074.2 +141300 IF ACCUMULATOR2 EQUAL TO ZERO NC2074.2 +141400 PERFORM PASS NC2074.2 +141500 GO TO SUB-WRITE-F2-9. NC2074.2 +141600 GO TO SUB-FAIL-F2-9. NC2074.2 +141700 SUB-DELETE-F2-9. NC2074.2 +141800 PERFORM DE-LETE. NC2074.2 +141900 GO TO SUB-WRITE-F2-9. NC2074.2 +142000 SUB-FAIL-F2-9. NC2074.2 +142100 MOVE ZERO TO CORRECT-N. NC2074.2 +142200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +142300 PERFORM FAIL. NC2074.2 +142400 SUB-WRITE-F2-9. NC2074.2 +142500 PERFORM PRINT-DETAIL. NC2074.2 +142600* NC2074.2 +142700 SUB-INIT-F2-10. NC2074.2 +142800 MOVE "SUB-TEST-F2-10 " TO PAR-NAME. NC2074.2 +142900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +143000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +143100 SUB-TEST-F2-10. NC2074.2 +143200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +143300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +143400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +143500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +143600 GIVING ACCUMULATOR2. NC2074.2 +143700 IF ACCUMULATOR2 EQUAL TO 3 NC2074.2 +143800 PERFORM PASS NC2074.2 +143900 GO TO SUB-WRITE-F2-10. NC2074.2 +144000 GO TO SUB-FAIL-F2-10. NC2074.2 +144100 SUB-DELETE-F2-10. NC2074.2 +144200 PERFORM DE-LETE. NC2074.2 +144300 GO TO SUB-WRITE-F2-10. NC2074.2 +144400 SUB-FAIL-F2-10. NC2074.2 +144500 MOVE 3 TO CORRECT-N. NC2074.2 +144600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +144700 PERFORM FAIL. NC2074.2 +144800 SUB-WRITE-F2-10. NC2074.2 +144900 PERFORM PRINT-DETAIL. NC2074.2 +145000* NC2074.2 +145100 SUB-INIT-F2-11. NC2074.2 +145200 MOVE "SUB-TEST-F2-11 " TO PAR-NAME. NC2074.2 +145300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +145400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +145500 SUB-TEST-F2-11. NC2074.2 +145600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +145700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +145800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +145900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +146000 GIVING ACCUMULATOR2. NC2074.2 +146100 IF ACCUMULATOR2 EQUAL TO 5 NC2074.2 +146200 PERFORM PASS NC2074.2 +146300 GO TO SUB-WRITE-F2-11. NC2074.2 +146400 GO TO SUB-FAIL-F2-11. NC2074.2 +146500 SUB-DELETE-F2-11. NC2074.2 +146600 PERFORM DE-LETE. NC2074.2 +146700 GO TO SUB-WRITE-F2-11. NC2074.2 +146800 SUB-FAIL-F2-11. NC2074.2 +146900 MOVE 5 TO CORRECT-N. NC2074.2 +147000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +147100 PERFORM FAIL. NC2074.2 +147200 SUB-WRITE-F2-11. NC2074.2 +147300 PERFORM PRINT-DETAIL. NC2074.2 +147400* NC2074.2 +147500 SUB-INIT-F2-12. NC2074.2 +147600 MOVE "SUB-TEST-F2-12 " TO PAR-NAME. NC2074.2 +147700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +147800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +147900 SUB-TEST-F2-12. NC2074.2 +148000 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +148100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +148200 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +148300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +148400 GIVING ACCUMULATOR2. NC2074.2 +148500 IF ACCUMULATOR2 EQUAL TO 7 NC2074.2 +148600 PERFORM PASS NC2074.2 +148700 GO TO SUB-WRITE-F2-12. NC2074.2 +148800 GO TO SUB-FAIL-F2-12. NC2074.2 +148900 SUB-DELETE-F2-12. NC2074.2 +149000 PERFORM DE-LETE. NC2074.2 +149100 GO TO SUB-WRITE-F2-12. NC2074.2 +149200 SUB-FAIL-F2-12. NC2074.2 +149300 MOVE 7 TO CORRECT-N. NC2074.2 +149400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +149500 PERFORM FAIL. NC2074.2 +149600 SUB-WRITE-F2-12. NC2074.2 +149700 PERFORM PRINT-DETAIL. NC2074.2 +149800* NC2074.2 +149900 SUB-INIT-F2-13. NC2074.2 +150000 MOVE "SUB-TEST-F2-13 " TO PAR-NAME. NC2074.2 +150100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +150200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +150300 SUB-TEST-F2-13. NC2074.2 +150400 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +150500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +150600 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +150700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +150800 GIVING ACCUMULATOR2. NC2074.2 +150900 IF ACCUMULATOR2 EQUAL TO 9 NC2074.2 +151000 PERFORM PASS NC2074.2 +151100 GO TO SUB-WRITE-F2-13. NC2074.2 +151200 GO TO SUB-FAIL-F2-13. NC2074.2 +151300 SUB-DELETE-F2-13. NC2074.2 +151400 PERFORM DE-LETE. NC2074.2 +151500 GO TO SUB-WRITE-F2-13. NC2074.2 +151600 SUB-FAIL-F2-13. NC2074.2 +151700 MOVE 9 TO CORRECT-N. NC2074.2 +151800 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +151900 PERFORM FAIL. NC2074.2 +152000 SUB-WRITE-F2-13. NC2074.2 +152100 PERFORM PRINT-DETAIL. NC2074.2 +152200* NC2074.2 +152300 SUB-INIT-F2-14. NC2074.2 +152400 MOVE "SUB-TEST-F2-14 " TO PAR-NAME. NC2074.2 +152500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +152600 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +152700 SUB-TEST-F2-14. NC2074.2 +152800 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +152900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +153000 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +153100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +153200 GIVING ACCUMULATOR2. NC2074.2 +153300 IF ACCUMULATOR2 EQUAL TO 11 NC2074.2 +153400 PERFORM PASS NC2074.2 +153500 GO TO SUB-WRITE-F2-14. NC2074.2 +153600 GO TO SUB-FAIL-F2-14. NC2074.2 +153700 SUB-DELETE-F2-14. NC2074.2 +153800 PERFORM DE-LETE. NC2074.2 +153900 GO TO SUB-WRITE-F2-14. NC2074.2 +154000 SUB-FAIL-F2-14. NC2074.2 +154100 MOVE 11 TO CORRECT-N. NC2074.2 +154200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +154300 PERFORM FAIL. NC2074.2 +154400 SUB-WRITE-F2-14. NC2074.2 +154500 PERFORM PRINT-DETAIL. NC2074.2 +154600* NC2074.2 +154700 SUB-INIT-F2-15. NC2074.2 +154800 MOVE "SUB-TEST-F2-15 " TO PAR-NAME. NC2074.2 +154900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +155000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +155100 SUB-TEST-F2-15. NC2074.2 +155200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +155300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +155400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +155500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +155600 GIVING ACCUMULATOR2. NC2074.2 +155700 IF ACCUMULATOR2 EQUAL TO 13 NC2074.2 +155800 PERFORM PASS NC2074.2 +155900 GO TO SUB-WRITE-F2-15. NC2074.2 +156000 GO TO SUB-FAIL-F2-15. NC2074.2 +156100 SUB-DELETE-F2-15. NC2074.2 +156200 PERFORM DE-LETE. NC2074.2 +156300 GO TO SUB-WRITE-F2-15. NC2074.2 +156400 SUB-FAIL-F2-15. NC2074.2 +156500 MOVE 13 TO CORRECT-N. NC2074.2 +156600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +156700 PERFORM FAIL. NC2074.2 +156800 SUB-WRITE-F2-15. NC2074.2 +156900 PERFORM PRINT-DETAIL. NC2074.2 +157000* NC2074.2 +157100 SUB-INIT-F2-16. NC2074.2 +157200 MOVE "SUB-TEST-F2-16 " TO PAR-NAME. NC2074.2 +157300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +157400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +157500 SUB-TEST-F2-16. NC2074.2 +157600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +157700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +157800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +157900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +158000 GIVING ACCUMULATOR2. NC2074.2 +158100 IF ACCUMULATOR2 EQUAL TO 15 NC2074.2 +158200 PERFORM PASS NC2074.2 +158300 GO TO SUB-WRITE-F2-16. NC2074.2 +158400 GO TO SUB-FAIL-F2-16. NC2074.2 +158500 SUB-DELETE-F2-16. NC2074.2 +158600 PERFORM DE-LETE. NC2074.2 +158700 GO TO SUB-WRITE-F2-16. NC2074.2 +158800 SUB-FAIL-F2-16. NC2074.2 +158900 MOVE 15 TO CORRECT-N. NC2074.2 +159000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +159100 PERFORM FAIL. NC2074.2 +159200 SUB-WRITE-F2-16. NC2074.2 +159300 PERFORM PRINT-DETAIL. NC2074.2 +159400* NC2074.2 +159500 SUB-INIT-F3-17. NC2074.2 +159600 MOVE "SUB-TEST-F3-17" TO PAR-NAME. NC2074.2 +159700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +159800 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +159900 SUBTRACT CORRESPONDING TABLE-LEVEL-5A FROM TABLE-LEVEL-5C. NC2074.2 +160000 SUB-TEST-F3-17. NC2074.2 +160100 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +160200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +160300 EQUAL TO ZERO NC2074.2 +160400 PERFORM PASS NC2074.2 +160500 GO TO SUB-WRITE-F3-17. NC2074.2 +160600 GO TO SUB-FAIL-F3-17. NC2074.2 +160700 SUB-DELETE-F3-17. NC2074.2 +160800 PERFORM DE-LETE. NC2074.2 +160900 GO TO SUB-WRITE-F3-17. NC2074.2 +161000 SUB-FAIL-F3-17. NC2074.2 +161100 MOVE 00 TO CORRECT-N. NC2074.2 +161200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +161300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +161400 TO COMPUTED-N. NC2074.2 +161500 PERFORM FAIL. NC2074.2 +161600 SUB-WRITE-F3-17. NC2074.2 +161700 PERFORM PRINT-DETAIL. NC2074.2 +161800* NC2074.2 +161900 SUB-INIT-F3-18. NC2074.2 +162000 MOVE "SUB-TEST-F3-18" TO PAR-NAME. NC2074.2 +162100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +162200 SUB-TEST-F3-18. NC2074.2 +162300 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +162400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +162500 EQUAL TO ZERO NC2074.2 +162600 PERFORM PASS NC2074.2 +162700 GO TO SUB-WRITE-F3-18. NC2074.2 +162800 GO TO SUB-FAIL-F3-18. NC2074.2 +162900 SUB-DELETE-F3-18. NC2074.2 +163000 PERFORM DE-LETE. NC2074.2 +163100 GO TO SUB-WRITE-F3-18. NC2074.2 +163200 SUB-FAIL-F3-18. NC2074.2 +163300 MOVE 00 TO CORRECT-N. NC2074.2 +163400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +163500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +163600 TO COMPUTED-N. NC2074.2 +163700 PERFORM FAIL. NC2074.2 +163800 SUB-WRITE-F3-18. NC2074.2 +163900 PERFORM PRINT-DETAIL. NC2074.2 +164000* NC2074.2 +164100 SUB-INIT-F3-19. NC2074.2 +164200 MOVE "SUB-TEST-F3-19" TO PAR-NAME. NC2074.2 +164300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +164400 SUB-TEST-F3-19. NC2074.2 +164500 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +164600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +164700 EQUAL TO ZERO NC2074.2 +164800 PERFORM PASS NC2074.2 +164900 GO TO SUB-WRITE-F3-19. NC2074.2 +165000 GO TO SUB-FAIL-F3-19. NC2074.2 +165100 SUB-DELETE-F3-19. NC2074.2 +165200 PERFORM DE-LETE. NC2074.2 +165300 GO TO SUB-WRITE-F3-19. NC2074.2 +165400 SUB-FAIL-F3-19. NC2074.2 +165500 MOVE 00 TO CORRECT-N. NC2074.2 +165600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +165700 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +165800 TO COMPUTED-N. NC2074.2 +165900 PERFORM FAIL. NC2074.2 +166000 SUB-WRITE-F3-19. NC2074.2 +166100 PERFORM PRINT-DETAIL. NC2074.2 +166200* NC2074.2 +166300 SUB-INIT-F3-20. NC2074.2 +166400 MOVE "SUB-TEST-F3-20" TO PAR-NAME. NC2074.2 +166500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +166600 SUB-TEST-F3-20. NC2074.2 +166700 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +166800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +166900 EQUAL TO ZERO NC2074.2 +167000 PERFORM PASS NC2074.2 +167100 GO TO SUB-WRITE-F3-20. NC2074.2 +167200 GO TO SUB-FAIL-F3-20. NC2074.2 +167300 SUB-DELETE-F3-20. NC2074.2 +167400 PERFORM DE-LETE. NC2074.2 +167500 GO TO SUB-WRITE-F3-20. NC2074.2 +167600 SUB-FAIL-F3-20. NC2074.2 +167700 MOVE 00 TO CORRECT-N. NC2074.2 +167800 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +167900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +168000 TO COMPUTED-N. NC2074.2 +168100 PERFORM FAIL. NC2074.2 +168200 SUB-WRITE-F3-20. NC2074.2 +168300 PERFORM PRINT-DETAIL. NC2074.2 +168400* NC2074.2 +168500 SUB-INIT-F3-21. NC2074.2 +168600 MOVE "SUB-TEST-F3-21" TO PAR-NAME. NC2074.2 +168700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +168800 SUB-TEST-F3-21. NC2074.2 +168900 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +169000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +169100 EQUAL TO ZERO NC2074.2 +169200 PERFORM PASS NC2074.2 +169300 GO TO SUB-WRITE-F3-21. NC2074.2 +169400 GO TO SUB-FAIL-F3-21. NC2074.2 +169500 SUB-DELETE-F3-21. NC2074.2 +169600 PERFORM DE-LETE. NC2074.2 +169700 GO TO SUB-WRITE-F3-21. NC2074.2 +169800 SUB-FAIL-F3-21. NC2074.2 +169900 MOVE 00 TO CORRECT-N. NC2074.2 +170000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +170100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +170200 TO COMPUTED-N. NC2074.2 +170300 PERFORM FAIL. NC2074.2 +170400 SUB-WRITE-F3-21. NC2074.2 +170500 PERFORM PRINT-DETAIL. NC2074.2 +170600* NC2074.2 +170700 SUB-INIT-F3-22. NC2074.2 +170800 MOVE "SUB-TEST-F3-22" TO PAR-NAME. NC2074.2 +170900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +171000 SUB-TEST-F3-22. NC2074.2 +171100 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +171200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +171300 EQUAL TO ZERO NC2074.2 +171400 PERFORM PASS NC2074.2 +171500 GO TO SUB-WRITE-F3-22. NC2074.2 +171600 GO TO SUB-FAIL-F3-22. NC2074.2 +171700 SUB-DELETE-F3-22. NC2074.2 +171800 PERFORM DE-LETE. NC2074.2 +171900 GO TO SUB-WRITE-F3-22. NC2074.2 +172000 SUB-FAIL-F3-22. NC2074.2 +172100 MOVE 00 TO CORRECT-N. NC2074.2 +172200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +172300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +172400 TO COMPUTED-N. NC2074.2 +172500 PERFORM FAIL. NC2074.2 +172600 SUB-WRITE-F3-22. NC2074.2 +172700 PERFORM PRINT-DETAIL. NC2074.2 +172800* NC2074.2 +172900 SUB-INIT-F3-23. NC2074.2 +173000 MOVE "SUB-TEST-F3-23" TO PAR-NAME. NC2074.2 +173100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +173200 SUB-TEST-F3-23. NC2074.2 +173300 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +173400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +173500 EQUAL TO ZERO NC2074.2 +173600 PERFORM PASS NC2074.2 +173700 GO TO SUB-WRITE-F3-23. NC2074.2 +173800 GO TO SUB-FAIL-F3-23. NC2074.2 +173900 SUB-DELETE-F3-23. NC2074.2 +174000 PERFORM DE-LETE. NC2074.2 +174100 GO TO SUB-WRITE-F3-23. NC2074.2 +174200 SUB-FAIL-F3-23. NC2074.2 +174300 MOVE 00 TO CORRECT-N. NC2074.2 +174400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +174500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +174600 TO COMPUTED-N. NC2074.2 +174700 PERFORM FAIL. NC2074.2 +174800 SUB-WRITE-F3-23. NC2074.2 +174900 PERFORM PRINT-DETAIL. NC2074.2 +175000* NC2074.2 +175100 SUB-INIT-F3-24. NC2074.2 +175200 MOVE "SUB-TEST-F3-24" TO PAR-NAME. NC2074.2 +175300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +175400 SUB-TEST-F3-24. NC2074.2 +175500 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +175600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +175700 EQUAL TO ZERO NC2074.2 +175800 PERFORM PASS NC2074.2 +175900 GO TO SUB-WRITE-F3-24. NC2074.2 +176000 GO TO SUB-FAIL-F3-24. NC2074.2 +176100 SUB-DELETE-F3-24. NC2074.2 +176200 PERFORM DE-LETE. NC2074.2 +176300 GO TO SUB-WRITE-F3-24. NC2074.2 +176400 SUB-FAIL-F3-24. NC2074.2 +176500 MOVE 00 TO CORRECT-N. NC2074.2 +176600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +176700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +176800 TO COMPUTED-N. NC2074.2 +176900 PERFORM FAIL. NC2074.2 +177000 SUB-WRITE-F3-24. NC2074.2 +177100 PERFORM PRINT-DETAIL. NC2074.2 +177200* NC2074.2 +177300 SUB-INIT-F2-25. NC2074.2 +177400* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +177500 MOVE "SUB-TEST-F2-25 " TO PAR-NAME. NC2074.2 +177600 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +177700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +177800 SUB-TEST-F2-25. NC2074.2 +177900 SUBTRACT GROUP-49-2 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +178000 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +178100 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +178200 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +178300 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +178400 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +178500 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +178600 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +178700 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +178800 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +178900 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +179000 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +179100 IN SECOND-GROUP NC2074.2 +179200 FROM 200 NC2074.2 +179300 GIVING ACCUMULATOR1. NC2074.2 +179400 IF ACCUMULATOR1 EQUAL TO ZERO NC2074.2 +179500 PERFORM PASS NC2074.2 +179600 GO TO SUB-WRITE-F2-25. NC2074.2 +179700 GO TO SUB-FAIL-F2-25. NC2074.2 +179800 SUB-DELETE-F2-25. NC2074.2 +179900 PERFORM DE-LETE. NC2074.2 +180000 GO TO SUB-WRITE-F2-25. NC2074.2 +180100 SUB-FAIL-F2-25. NC2074.2 +180200 MOVE 200 TO CORRECT-N. NC2074.2 +180300 MOVE GROUP-49-2 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +180400 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +180500 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +180600 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +180700 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +180800 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +180900 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +181000 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +181100 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +181200 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +181300 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +181400 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +181500 IN SECOND-GROUP NC2074.2 +181600 TO COMPUTED-N. NC2074.2 +181700 PERFORM FAIL. NC2074.2 +181800 SUB-WRITE-F2-25. NC2074.2 +181900 PERFORM PRINT-DETAIL. NC2074.2 +182000 PERFORM END-ROUTINE. NC2074.2 +182100* NC2074.2 +182200 MPY-INIT-F2-1. NC2074.2 +182300 MOVE "MPY-TEST-F2-1 " TO PAR-NAME. NC2074.2 +182400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +182500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +182600 MPY-TEST-F2-1. NC2074.2 +182700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +182800 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +182900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +183000 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +183100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +183200 GIVING ACCUMULATOR1. NC2074.2 +183300 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +183400 PERFORM PASS NC2074.2 +183500 GO TO MPY-WRITE-F2-1. NC2074.2 +183600 GO TO MPY-FAIL-F2-1. NC2074.2 +183700 MPY-DELETE-F2-1. NC2074.2 +183800 PERFORM DE-LETE. NC2074.2 +183900 GO TO MPY-WRITE-F2-1. NC2074.2 +184000 MPY-FAIL-F2-1. NC2074.2 +184100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +184200 MOVE 1 TO CORRECT-N. NC2074.2 +184300 PERFORM FAIL. NC2074.2 +184400 MPY-WRITE-F2-1. NC2074.2 +184500 PERFORM PRINT-DETAIL. NC2074.2 +184600* NC2074.2 +184700 MPY-INIT-F2-2. NC2074.2 +184800 MOVE "MPY-TEST-F2-2 " TO PAR-NAME. NC2074.2 +184900 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +185000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +185100 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +185200 MPY-TEST-F2-2. NC2074.2 +185300 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +185400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +185500 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +185600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +185700 GIVING ACCUMULATOR1. NC2074.2 +185800 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +185900 PERFORM PASS NC2074.2 +186000 GO TO MPY-WRITE-F2-2. NC2074.2 +186100 GO TO MPY-FAIL-F2-2. NC2074.2 +186200 MPY-DELETE-F2-2. NC2074.2 +186300 PERFORM DE-LETE. NC2074.2 +186400 GO TO MPY-WRITE-F2-2. NC2074.2 +186500 MPY-FAIL-F2-2. NC2074.2 +186600 MOVE 4 TO CORRECT-N. NC2074.2 +186700 PERFORM FAIL NC2074.2 +186800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +186900 MPY-WRITE-F2-2. NC2074.2 +187000 PERFORM PRINT-DETAIL. NC2074.2 +187100* NC2074.2 +187200 MPY-INIT-F2-3. NC2074.2 +187300 MOVE "MPY-TEST-F2-3 " TO PAR-NAME. NC2074.2 +187400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +187500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +187600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +187700 MPY-TEST-F2-3. NC2074.2 +187800 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +187900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +188000 GIVING ACCUMULATOR1. NC2074.2 +188100 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +188200 PERFORM PASS NC2074.2 +188300 GO TO MPY-WRITE-F2-3. NC2074.2 +188400 GO TO MPY-FAIL-F2-3. NC2074.2 +188500 MPY-DELETE-F2-3. NC2074.2 +188600 PERFORM DE-LETE. NC2074.2 +188700 GO TO MPY-WRITE-F2-3. NC2074.2 +188800 MPY-FAIL-F2-3. NC2074.2 +188900 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +189000 MOVE 3 TO CORRECT-N. NC2074.2 +189100 PERFORM FAIL. NC2074.2 +189200 MPY-WRITE-F2-3. NC2074.2 +189300 PERFORM PRINT-DETAIL. NC2074.2 +189400* NC2074.2 +189500 MPY-INIT-F2-4. NC2074.2 +189600 MOVE "MPY-TEST-F2-4 " TO PAR-NAME. NC2074.2 +189700 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +189800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +189900 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +190000 MPY-TEST-F2-4. NC2074.2 +190100 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +190200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +190300 GIVING ACCUMULATOR1. NC2074.2 +190400 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +190500 PERFORM PASS NC2074.2 +190600 GO TO MPY-WRITE-F2-4. NC2074.2 +190700 GO TO MPY-FAIL-F2-4. NC2074.2 +190800 MPY-DELETE-F2-4. NC2074.2 +190900 PERFORM DE-LETE. NC2074.2 +191000 GO TO MPY-WRITE-F2-4. NC2074.2 +191100 MPY-FAIL-F2-4. NC2074.2 +191200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +191300 MOVE 4 TO CORRECT-N. NC2074.2 +191400 PERFORM FAIL. NC2074.2 +191500 MPY-WRITE-F2-4. NC2074.2 +191600 PERFORM PRINT-DETAIL. NC2074.2 +191700* NC2074.2 +191800 MPY-INIT-F2-5. NC2074.2 +191900 MOVE "MPY-TEST-F2-5 " TO PAR-NAME. NC2074.2 +192000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +192100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +192200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +192300 MPY-TEST-F2-5. NC2074.2 +192400 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +192500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +192600 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +192700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +192800 GIVING ACCUMULATOR1. NC2074.2 +192900 IF ACCUMULATOR1 EQUAL TO 25 NC2074.2 +193000 PERFORM PASS NC2074.2 +193100 GO TO MPY-WRITE-F2-5. NC2074.2 +193200 GO TO MPY-FAIL-F2-5. NC2074.2 +193300 MPY-DELETE-F2-5. NC2074.2 +193400 PERFORM DE-LETE. NC2074.2 +193500 GO TO MPY-WRITE-F2-5. NC2074.2 +193600 MPY-FAIL-F2-5. NC2074.2 +193700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +193800 MOVE 25 TO CORRECT-N. NC2074.2 +193900 PERFORM FAIL. NC2074.2 +194000 MPY-WRITE-F2-5. NC2074.2 +194100 PERFORM PRINT-DETAIL. NC2074.2 +194200* NC2074.2 +194300 MPY-INIT-F2-6. NC2074.2 +194400 MOVE "MPY-TEST-F2-6 " TO PAR-NAME. NC2074.2 +194500 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +194600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +194700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +194800 MPY-TEST-F2-6. NC2074.2 +194900 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +195000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +195100 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +195200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +195300 GIVING ACCUMULATOR1. NC2074.2 +195400 IF ACCUMULATOR1 EQUAL TO 36 NC2074.2 +195500 PERFORM PASS NC2074.2 +195600 GO TO MPY-WRITE-F2-6. NC2074.2 +195700 GO TO MPY-FAIL-F2-6. NC2074.2 +195800 MPY-DELETE-F2-6. NC2074.2 +195900 PERFORM DE-LETE. NC2074.2 +196000 GO TO MPY-WRITE-F2-6. NC2074.2 +196100 MPY-FAIL-F2-6. NC2074.2 +196200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +196300 MOVE 36 TO CORRECT-N. NC2074.2 +196400 PERFORM FAIL. NC2074.2 +196500 MPY-WRITE-F2-6. NC2074.2 +196600 PERFORM PRINT-DETAIL. NC2074.2 +196700* NC2074.2 +196800 MPY-INIT-F2-7. NC2074.2 +196900 MOVE "MPY-TEST-F2-7 " TO PAR-NAME. NC2074.2 +197000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +197100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +197200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +197300 MPY-TEST-F2-7. NC2074.2 +197400 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +197500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +197600 GIVING ACCUMULATOR1. NC2074.2 +197700 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +197800 PERFORM PASS NC2074.2 +197900 GO TO MPY-WRITE-F2-7. NC2074.2 +198000 GO TO MPY-FAIL-F2-7. NC2074.2 +198100 MPY-DELETE-F2-7. NC2074.2 +198200 PERFORM DE-LETE. NC2074.2 +198300 GO TO MPY-WRITE-F2-7. NC2074.2 +198400 MPY-FAIL-F2-7. NC2074.2 +198500 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +198600 MOVE 7 TO CORRECT-N. NC2074.2 +198700 PERFORM FAIL. NC2074.2 +198800 MPY-WRITE-F2-7. NC2074.2 +198900 PERFORM PRINT-DETAIL. NC2074.2 +199000* NC2074.2 +199100 MPY-INIT-F2-8. NC2074.2 +199200 MOVE "MPY-TEST-F2-8 " TO PAR-NAME. NC2074.2 +199300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +199400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +199500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +199600 MPY-TEST-F2-8. NC2074.2 +199700 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +199800 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +199900 GIVING ACCUMULATOR1. NC2074.2 +200000 IF ACCUMULATOR1 EQUAL TO 8 NC2074.2 +200100 PERFORM PASS NC2074.2 +200200 GO TO MPY-WRITE-F2-8. NC2074.2 +200300 GO TO MPY-FAIL-F2-8. NC2074.2 +200400 MPY-DELETE-F2-8. NC2074.2 +200500 PERFORM DE-LETE. NC2074.2 +200600 GO TO MPY-WRITE-F2-8. NC2074.2 +200700 MPY-FAIL-F2-8. NC2074.2 +200800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +200900 MOVE 8 TO CORRECT-N. NC2074.2 +201000 PERFORM FAIL. NC2074.2 +201100 MPY-WRITE-F2-8. NC2074.2 +201200 PERFORM PRINT-DETAIL. NC2074.2 +201300* NC2074.2 +201400 MPY-INIT-F2-9. NC2074.2 +201500 MOVE "MPY-TEST-F2-9 " TO PAR-NAME. NC2074.2 +201600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +201700 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +201800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +201900 MPY-TEST-F2-9. NC2074.2 +202000 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +202100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +202200 GIVING ACCUMULATOR2. NC2074.2 +202300 IF ACCUMULATOR2 EQUAL TO 9 NC2074.2 +202400 PERFORM PASS NC2074.2 +202500 GO TO MPY-WRITE-F2-9. NC2074.2 +202600 GO TO MPY-FAIL-F2-9. NC2074.2 +202700 MPY-DELETE-F2-9. NC2074.2 +202800 PERFORM DE-LETE. NC2074.2 +202900 GO TO MPY-WRITE-F2-9. NC2074.2 +203000 MPY-FAIL-F2-9. NC2074.2 +203100 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +203200 MOVE 9 TO CORRECT-N. NC2074.2 +203300 PERFORM FAIL. NC2074.2 +203400 MPY-WRITE-F2-9. NC2074.2 +203500 PERFORM PRINT-DETAIL. NC2074.2 +203600* NC2074.2 +203700 MPY-INIT-F2-10. NC2074.2 +203800 MOVE "MPY-TEST-F2-10 " TO PAR-NAME. NC2074.2 +203900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +204000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +204100 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +204200 MPY-TEST-F2-10. NC2074.2 +204300 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +204400 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +204500 GIVING ACCUMULATOR2. NC2074.2 +204600 IF ACCUMULATOR2 EQUAL TO 10 NC2074.2 +204700 PERFORM PASS NC2074.2 +204800 GO TO MPY-WRITE-F2-10. NC2074.2 +204900 GO TO MPY-FAIL-F2-10. NC2074.2 +205000 MPY-DELETE-F2-10. NC2074.2 +205100 PERFORM DE-LETE. NC2074.2 +205200 GO TO MPY-WRITE-F2-10. NC2074.2 +205300 MPY-FAIL-F2-10. NC2074.2 +205400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +205500 MOVE 10 TO CORRECT-N. NC2074.2 +205600 PERFORM FAIL. NC2074.2 +205700 MPY-WRITE-F2-10. NC2074.2 +205800 PERFORM PRINT-DETAIL. NC2074.2 +205900* NC2074.2 +206000 MPY-INIT-F2-11. NC2074.2 +206100 MOVE "MPY-TEST-F2-11 " TO PAR-NAME. NC2074.2 +206200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +206300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +206400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +206500 MPY-TEST-F2-11. NC2074.2 +206600 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +206700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +206800 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +206900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +207000 GIVING ACCUMULATOR2. NC2074.2 +207100 IF ACCUMULATOR2 EQUAL TO 121 NC2074.2 +207200 PERFORM PASS NC2074.2 +207300 GO TO MPY-WRITE-F2-11. NC2074.2 +207400 GO TO MPY-FAIL-F2-11. NC2074.2 +207500 MPY-DELETE-F2-11. NC2074.2 +207600 PERFORM DE-LETE. NC2074.2 +207700 GO TO MPY-WRITE-F2-11. NC2074.2 +207800 MPY-FAIL-F2-11. NC2074.2 +207900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +208000 MOVE 121 TO CORRECT-N. NC2074.2 +208100 PERFORM FAIL. NC2074.2 +208200 MPY-WRITE-F2-11. NC2074.2 +208300 PERFORM PRINT-DETAIL. NC2074.2 +208400* NC2074.2 +208500 MPY-INIT-F2-12. NC2074.2 +208600 MOVE "MPY-TEST-F2-12 " TO PAR-NAME. NC2074.2 +208700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +208800 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +208900 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +209000 MPY-TEST-F2-12. NC2074.2 +209100 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +209200 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +209300 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +209400 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +209500 GIVING ACCUMULATOR2. NC2074.2 +209600 IF ACCUMULATOR2 EQUAL TO 144 NC2074.2 +209700 PERFORM PASS NC2074.2 +209800 GO TO MPY-WRITE-F2-12. NC2074.2 +209900 GO TO MPY-FAIL-F2-12. NC2074.2 +210000 MPY-DELETE-F2-12. NC2074.2 +210100 PERFORM DE-LETE. NC2074.2 +210200 GO TO MPY-WRITE-F2-12. NC2074.2 +210300 MPY-FAIL-F2-12. NC2074.2 +210400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +210500 MOVE 144 TO CORRECT-N. NC2074.2 +210600 PERFORM FAIL. NC2074.2 +210700 MPY-WRITE-F2-12. NC2074.2 +210800 PERFORM PRINT-DETAIL. NC2074.2 +210900* NC2074.2 +211000 MPY-INIT-F2-13. NC2074.2 +211100 MOVE "MPY-TEST-F2-13 " TO PAR-NAME. NC2074.2 +211200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +211300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +211400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +211500 MPY-TEST-F2-13. NC2074.2 +211600 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +211700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +211800 GIVING ACCUMULATOR2. NC2074.2 +211900 IF ACCUMULATOR2 EQUAL TO 13 NC2074.2 +212000 PERFORM PASS NC2074.2 +212100 GO TO MPY-WRITE-F2-13. NC2074.2 +212200 GO TO MPY-FAIL-F2-13. NC2074.2 +212300 MPY-DELETE-F2-13. NC2074.2 +212400 PERFORM DE-LETE. NC2074.2 +212500 GO TO MPY-WRITE-F2-13. NC2074.2 +212600 MPY-FAIL-F2-13. NC2074.2 +212700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +212800 MOVE 13 TO CORRECT-N. NC2074.2 +212900 PERFORM FAIL. NC2074.2 +213000 MPY-WRITE-F2-13. NC2074.2 +213100 PERFORM PRINT-DETAIL. NC2074.2 +213200* NC2074.2 +213300 MPY-INIT-F2-14. NC2074.2 +213400 MOVE "MPY-TEST-F2-14 " TO PAR-NAME. NC2074.2 +213500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +213600 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +213700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +213800 MPY-TEST-F2-14. NC2074.2 +213900 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +214000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +214100 GIVING ACCUMULATOR2. NC2074.2 +214200 IF ACCUMULATOR2 EQUAL TO 14 NC2074.2 +214300 PERFORM PASS NC2074.2 +214400 GO TO MPY-WRITE-F2-14. NC2074.2 +214500 GO TO MPY-FAIL-F2-14. NC2074.2 +214600 MPY-DELETE-F2-14. NC2074.2 +214700 PERFORM DE-LETE. NC2074.2 +214800 GO TO MPY-WRITE-F2-14. NC2074.2 +214900 MPY-FAIL-F2-14. NC2074.2 +215000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +215100 MOVE 14 TO CORRECT-N. NC2074.2 +215200 PERFORM FAIL. NC2074.2 +215300 MPY-WRITE-F2-14. NC2074.2 +215400 PERFORM PRINT-DETAIL. NC2074.2 +215500* NC2074.2 +215600 MPY-INIT-F2-15. NC2074.2 +215700 MOVE "MPY-TEST-F2-15 " TO PAR-NAME. NC2074.2 +215800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +215900 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +216000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +216100 MPY-TEST-F2-15. NC2074.2 +216200 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +216300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +216400 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +216500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +216600 GIVING ACCUMULATOR2. NC2074.2 +216700 IF ACCUMULATOR2 EQUAL TO 225 NC2074.2 +216800 PERFORM PASS NC2074.2 +216900 GO TO MPY-WRITE-F2-15. NC2074.2 +217000 GO TO MPY-FAIL-F2-15. NC2074.2 +217100 MPY-DELETE-F2-15. NC2074.2 +217200 PERFORM DE-LETE. NC2074.2 +217300 GO TO MPY-WRITE-F2-15. NC2074.2 +217400 MPY-FAIL-F2-15. NC2074.2 +217500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +217600 MOVE 225 TO CORRECT-N. NC2074.2 +217700 PERFORM FAIL. NC2074.2 +217800 MPY-WRITE-F2-15. NC2074.2 +217900 PERFORM PRINT-DETAIL. NC2074.2 +218000* NC2074.2 +218100 MPY-INIT-F2-16. NC2074.2 +218200 MOVE "MPY-TEST-F2-16 " TO PAR-NAME. NC2074.2 +218300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +218400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +218500 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +218600 MPY-TEST-F2-16. NC2074.2 +218700 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +218800 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +218900 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +219000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +219100 GIVING ACCUMULATOR2. NC2074.2 +219200 IF ACCUMULATOR2 EQUAL TO 256 NC2074.2 +219300 PERFORM PASS NC2074.2 +219400 GO TO MPY-WRITE-F2-16. NC2074.2 +219500 GO TO MPY-FAIL-F2-16. NC2074.2 +219600 MPY-DELETE-F2-16. NC2074.2 +219700 PERFORM DE-LETE. NC2074.2 +219800 GO TO MPY-WRITE-F2-16. NC2074.2 +219900 MPY-FAIL-F2-16. NC2074.2 +220000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +220100 MOVE 256 TO CORRECT-N. NC2074.2 +220200 PERFORM FAIL. NC2074.2 +220300 MPY-WRITE-F2-16. NC2074.2 +220400 PERFORM PRINT-DETAIL. NC2074.2 +220500* NC2074.2 +220600 MPY-INIT-F2-17. NC2074.2 +220700* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +220800 MOVE "MPY-TEST-F2-17 " TO PAR-NAME. NC2074.2 +220900 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +221000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +221100 MPY-TEST-F2-17. NC2074.2 +221200 MULTIPLY GROUP-49-3 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +221300 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +221400 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +221500 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +221600 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +221700 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +221800 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +221900 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +222000 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +222100 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +222200 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +222300 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +222400 IN FIRST-GROUP NC2074.2 +222500 BY 3 NC2074.2 +222600 GIVING ACCUMULATOR1. NC2074.2 +222700 IF ACCUMULATOR1 EQUAL TO 9 NC2074.2 +222800 PERFORM PASS NC2074.2 +222900 GO TO MPY-WRITE-F2-17. NC2074.2 +223000 GO TO MPY-FAIL-F2-17. NC2074.2 +223100 MPY-DELETE-F2-17. NC2074.2 +223200 PERFORM DE-LETE. NC2074.2 +223300 GO TO MPY-WRITE-F2-17. NC2074.2 +223400 MPY-FAIL-F2-17. NC2074.2 +223500 MOVE 9 TO CORRECT-N. NC2074.2 +223600 MOVE GROUP-49-3 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +223700 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +223800 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +223900 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +224000 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +224100 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +224200 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +224300 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +224400 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +224500 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +224600 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +224700 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +224800 IN FIRST-GROUP NC2074.2 +224900 TO COMPUTED-N. NC2074.2 +225000 MOVE "3 TIMES 3 SHOULD BE 9" TO RE-MARK. NC2074.2 +225100 PERFORM FAIL. NC2074.2 +225200 MPY-WRITE-F2-17. NC2074.2 +225300 PERFORM PRINT-DETAIL. NC2074.2 +225400 PERFORM END-ROUTINE. NC2074.2 +225500* NC2074.2 +225600 DIV-INIT-F3-1. NC2074.2 +225700 MOVE "DIV-TEST-F3-1 " TO PAR-NAME NC2074.2 +225800 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +225900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +226000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +226100 DIV-TEST-F3-1. NC2074.2 +226200 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +226300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +226400 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +226500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +226600 GIVING ACCUMULATOR1. NC2074.2 +226700 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +226800 PERFORM PASS NC2074.2 +226900 GO TO DIV-WRITE-F3-1. NC2074.2 +227000 GO TO DIV-FAIL-F3-1. NC2074.2 +227100 DIV-DELETE-F3-1. NC2074.2 +227200 PERFORM DE-LETE. NC2074.2 +227300 GO TO DIV-WRITE-F3-1. NC2074.2 +227400 DIV-FAIL-F3-1. NC2074.2 +227500 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +227600 MOVE 1 TO CORRECT-N. NC2074.2 +227700 PERFORM FAIL. NC2074.2 +227800 DIV-WRITE-F3-1. NC2074.2 +227900 PERFORM PRINT-DETAIL. NC2074.2 +228000* NC2074.2 +228100 DIV-INIT-F3-2. NC2074.2 +228200 MOVE "DIV-TEST-F3-2 " TO PAR-NAME NC2074.2 +228300 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +228400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +228500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +228600 DIV-TEST-F3-2. NC2074.2 +228700 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +228800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +228900 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +229000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +229100 GIVING ACCUMULATOR1. NC2074.2 +229200 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +229300 PERFORM PASS NC2074.2 +229400 GO TO DIV-WRITE-F3-2. NC2074.2 +229500 GO TO DIV-FAIL-F3-2. NC2074.2 +229600 DIV-DELETE-F3-2. NC2074.2 +229700 PERFORM DE-LETE. NC2074.2 +229800 GO TO DIV-WRITE-F3-2. NC2074.2 +229900 DIV-FAIL-F3-2. NC2074.2 +230000 MOVE 1 TO CORRECT-N. NC2074.2 +230100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +230200 PERFORM FAIL. NC2074.2 +230300 DIV-WRITE-F3-2. NC2074.2 +230400 PERFORM PRINT-DETAIL. NC2074.2 +230500* NC2074.2 +230600 DIV-INIT-F3-3. NC2074.2 +230700 MOVE "DIV-TEST-F3-3 " TO PAR-NAME NC2074.2 +230800 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +230900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +231000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +231100 DIV-TEST-F3-3. NC2074.2 +231200 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +231300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 3 NC2074.2 +231400 GIVING ACCUMULATOR1. NC2074.2 +231500 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +231600 PERFORM PASS NC2074.2 +231700 GO TO DIV-WRITE-F3-3. NC2074.2 +231800 GO TO DIV-FAIL-F3-3. NC2074.2 +231900 DIV-DELETE-F3-3. NC2074.2 +232000 PERFORM DE-LETE. NC2074.2 +232100 GO TO DIV-WRITE-F3-3. NC2074.2 +232200 DIV-FAIL-F3-3. NC2074.2 +232300 MOVE 1 TO CORRECT-N. NC2074.2 +232400 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +232500 PERFORM FAIL. NC2074.2 +232600 DIV-WRITE-F3-3. NC2074.2 +232700 PERFORM PRINT-DETAIL. NC2074.2 +232800* NC2074.2 +232900 DIV-INIT-F3-4. NC2074.2 +233000 MOVE "DIV-TEST-F3-4 " TO PAR-NAME NC2074.2 +233100 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +233200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +233300 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +233400 DIV-TEST-F3-4. NC2074.2 +233500 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +233600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 3 NC2074.2 +233700 GIVING ACCUMULATOR1. NC2074.2 +233800 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +233900 PERFORM PASS NC2074.2 +234000 GO TO DIV-WRITE-F3-4. NC2074.2 +234100 GO TO DIV-FAIL-F3-4. NC2074.2 +234200 DIV-DELETE-F3-4. NC2074.2 +234300 PERFORM DE-LETE. NC2074.2 +234400 GO TO DIV-WRITE-F3-4. NC2074.2 +234500 DIV-FAIL-F3-4. NC2074.2 +234600 MOVE 1 TO CORRECT-N. NC2074.2 +234700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +234800 PERFORM FAIL. NC2074.2 +234900 DIV-WRITE-F3-4. NC2074.2 +235000 PERFORM PRINT-DETAIL. NC2074.2 +235100* NC2074.2 +235200 DIV-INIT-F3-5. NC2074.2 +235300 MOVE "DIV-TEST-F3-5 " TO PAR-NAME NC2074.2 +235400 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +235500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +235600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +235700 DIV-TEST-F3-5. NC2074.2 +235800 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +235900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +236000 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +236100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +236200 GIVING ACCUMULATOR1. NC2074.2 +236300 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +236400 PERFORM PASS NC2074.2 +236500 GO TO DIV-WRITE-F3-5. NC2074.2 +236600 GO TO DIV-FAIL-F3-5. NC2074.2 +236700 DIV-DELETE-F3-5. NC2074.2 +236800 PERFORM DE-LETE. NC2074.2 +236900 GO TO DIV-WRITE-F3-5. NC2074.2 +237000 DIV-FAIL-F3-5. NC2074.2 +237100 MOVE 1 TO CORRECT-N. NC2074.2 +237200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +237300 PERFORM FAIL. NC2074.2 +237400 DIV-WRITE-F3-5. NC2074.2 +237500 PERFORM PRINT-DETAIL. NC2074.2 +237600* NC2074.2 +237700 DIV-INIT-F3-6. NC2074.2 +237800 MOVE "DIV-TEST-F3-6 " TO PAR-NAME NC2074.2 +237900 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +238000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +238100 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +238200 DIV-TEST-F3-6. NC2074.2 +238300 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +238400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +238500 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +238600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +238700 GIVING ACCUMULATOR1. NC2074.2 +238800 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +238900 PERFORM PASS NC2074.2 +239000 GO TO DIV-WRITE-F3-6. NC2074.2 +239100 GO TO DIV-FAIL-F3-6. NC2074.2 +239200 DIV-DELETE-F3-6. NC2074.2 +239300 PERFORM DE-LETE. NC2074.2 +239400 GO TO DIV-WRITE-F3-6. NC2074.2 +239500 DIV-FAIL-F3-6. NC2074.2 +239600 MOVE 1 TO CORRECT-N. NC2074.2 +239700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +239800 PERFORM FAIL. NC2074.2 +239900 DIV-WRITE-F3-6. NC2074.2 +240000 PERFORM PRINT-DETAIL. NC2074.2 +240100* NC2074.2 +240200 DIV-INIT-F3-7. NC2074.2 +240300 MOVE "DIV-TEST-F3-7 " TO PAR-NAME NC2074.2 +240400 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +240500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +240600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +240700 DIV-TEST-F3-7. NC2074.2 +240800 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +240900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 7 NC2074.2 +241000 GIVING ACCUMULATOR1. NC2074.2 +241100 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +241200 PERFORM PASS NC2074.2 +241300 GO TO DIV-WRITE-F3-7. NC2074.2 +241400 GO TO DIV-FAIL-F3-7. NC2074.2 +241500 DIV-DELETE-F3-7. NC2074.2 +241600 PERFORM DE-LETE. NC2074.2 +241700 GO TO DIV-WRITE-F3-7. NC2074.2 +241800 DIV-FAIL-F3-7. NC2074.2 +241900 MOVE 1 TO CORRECT-N. NC2074.2 +242000 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +242100 PERFORM FAIL. NC2074.2 +242200 DIV-WRITE-F3-7. NC2074.2 +242300 PERFORM PRINT-DETAIL. NC2074.2 +242400* NC2074.2 +242500 DIV-INIT-F3-8. NC2074.2 +242600 MOVE "DIV-TEST-F3-8 " TO PAR-NAME NC2074.2 +242700 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +242800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +242900 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +243000 DIV-TEST-F3-8. NC2074.2 +243100 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +243200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 8 NC2074.2 +243300 GIVING ACCUMULATOR1. NC2074.2 +243400 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +243500 PERFORM PASS NC2074.2 +243600 GO TO DIV-WRITE-F3-8. NC2074.2 +243700 GO TO DIV-FAIL-F3-8. NC2074.2 +243800 DIV-DELETE-F3-8. NC2074.2 +243900 PERFORM DE-LETE. NC2074.2 +244000 GO TO DIV-WRITE-F3-8. NC2074.2 +244100 DIV-FAIL-F3-8. NC2074.2 +244200 MOVE 1 TO CORRECT-N. NC2074.2 +244300 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +244400 PERFORM FAIL. NC2074.2 +244500 DIV-WRITE-F3-8. NC2074.2 +244600 PERFORM PRINT-DETAIL. NC2074.2 +244700* NC2074.2 +244800 DIV-INIT-F3-9. NC2074.2 +244900 MOVE "DIV-TEST-F3-9 " TO PAR-NAME NC2074.2 +245000 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +245100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +245200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +245300 DIV-TEST-F3-9. NC2074.2 +245400 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +245500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 9 NC2074.2 +245600 GIVING ACCUMULATOR2. NC2074.2 +245700 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +245800 PERFORM PASS NC2074.2 +245900 GO TO DIV-WRITE-F3-9. NC2074.2 +246000 GO TO DIV-FAIL-F3-9. NC2074.2 +246100 DIV-DELETE-F3-9. NC2074.2 +246200 PERFORM DE-LETE. NC2074.2 +246300 GO TO DIV-WRITE-F3-9. NC2074.2 +246400 DIV-FAIL-F3-9. NC2074.2 +246500 MOVE 1 TO CORRECT-N. NC2074.2 +246600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +246700 PERFORM FAIL. NC2074.2 +246800 DIV-WRITE-F3-9. NC2074.2 +246900 PERFORM PRINT-DETAIL. NC2074.2 +247000* NC2074.2 +247100 DIV-INIT-F3-10. NC2074.2 +247200 MOVE "DIV-TEST-F3-10 " TO PAR-NAME NC2074.2 +247300 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +247400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +247500 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +247600 DIV-TEST-F3-10. NC2074.2 +247700 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +247800 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 10 NC2074.2 +247900 GIVING ACCUMULATOR2. NC2074.2 +248000 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +248100 PERFORM PASS NC2074.2 +248200 GO TO DIV-WRITE-F3-10. NC2074.2 +248300 GO TO DIV-FAIL-F3-10. NC2074.2 +248400 DIV-DELETE-F3-10. NC2074.2 +248500 PERFORM DE-LETE. NC2074.2 +248600 GO TO DIV-WRITE-F3-10. NC2074.2 +248700 DIV-FAIL-F3-10. NC2074.2 +248800 MOVE 1 TO CORRECT-N. NC2074.2 +248900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +249000 PERFORM FAIL. NC2074.2 +249100 DIV-WRITE-F3-10. NC2074.2 +249200 PERFORM PRINT-DETAIL. NC2074.2 +249300* NC2074.2 +249400 DIV-INIT-F3-11. NC2074.2 +249500 MOVE "DIV-TEST-F3-11 " TO PAR-NAME NC2074.2 +249600 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +249700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +249800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +249900 DIV-TEST-F3-11. NC2074.2 +250000 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +250100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +250200 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +250300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +250400 GIVING ACCUMULATOR2. NC2074.2 +250500 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +250600 PERFORM PASS NC2074.2 +250700 GO TO DIV-WRITE-F3-11. NC2074.2 +250800 GO TO DIV-FAIL-F3-11. NC2074.2 +250900 DIV-DELETE-F3-11. NC2074.2 +251000 PERFORM DE-LETE. NC2074.2 +251100 GO TO DIV-WRITE-F3-11. NC2074.2 +251200 DIV-FAIL-F3-11. NC2074.2 +251300 MOVE 1 TO CORRECT-N. NC2074.2 +251400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +251500 PERFORM FAIL. NC2074.2 +251600 DIV-WRITE-F3-11. NC2074.2 +251700 PERFORM PRINT-DETAIL. NC2074.2 +251800* NC2074.2 +251900 DIV-INIT-F3-12. NC2074.2 +252000 MOVE "DIV-TEST-F3-12 " TO PAR-NAME NC2074.2 +252100 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +252200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +252300 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +252400 DIV-TEST-F3-12. NC2074.2 +252500 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +252600 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +252700 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +252800 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +252900 GIVING ACCUMULATOR2. NC2074.2 +253000 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +253100 PERFORM PASS NC2074.2 +253200 GO TO DIV-WRITE-F3-12. NC2074.2 +253300 GO TO DIV-FAIL-F3-12. NC2074.2 +253400 DIV-DELETE-F3-12. NC2074.2 +253500 PERFORM DE-LETE. NC2074.2 +253600 GO TO DIV-WRITE-F3-12. NC2074.2 +253700 DIV-FAIL-F3-12. NC2074.2 +253800 MOVE 1 TO CORRECT-N. NC2074.2 +253900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +254000 PERFORM FAIL. NC2074.2 +254100 DIV-WRITE-F3-12. NC2074.2 +254200 PERFORM PRINT-DETAIL. NC2074.2 +254300* NC2074.2 +254400 DIV-INIT-F3-13. NC2074.2 +254500 MOVE "DIV-TEST-F3-13 " TO PAR-NAME NC2074.2 +254600 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +254700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +254800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +254900 DIV-TEST-F3-13. NC2074.2 +255000 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +255100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 13 NC2074.2 +255200 GIVING ACCUMULATOR2. NC2074.2 +255300 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +255400 PERFORM PASS NC2074.2 +255500 GO TO DIV-WRITE-F3-13. NC2074.2 +255600 GO TO DIV-FAIL-F3-13. NC2074.2 +255700 DIV-DELETE-F3-13. NC2074.2 +255800 PERFORM DE-LETE. NC2074.2 +255900 GO TO DIV-WRITE-F3-13. NC2074.2 +256000 DIV-FAIL-F3-13. NC2074.2 +256100 MOVE 1 TO CORRECT-N. NC2074.2 +256200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +256300 PERFORM FAIL. NC2074.2 +256400 DIV-WRITE-F3-13. NC2074.2 +256500 PERFORM PRINT-DETAIL. NC2074.2 +256600* NC2074.2 +256700 DIV-INIT-F3-14. NC2074.2 +256800 MOVE "DIV-TEST-F3-14 " TO PAR-NAME NC2074.2 +256900 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +257000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +257100 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +257200 DIV-TEST-F3-14. NC2074.2 +257300 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +257400 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 14 NC2074.2 +257500 GIVING ACCUMULATOR2. NC2074.2 +257600 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +257700 PERFORM PASS NC2074.2 +257800 GO TO DIV-WRITE-F3-14. NC2074.2 +257900 GO TO DIV-FAIL-F3-14. NC2074.2 +258000 DIV-DELETE-F3-14. NC2074.2 +258100 PERFORM DE-LETE. NC2074.2 +258200 GO TO DIV-WRITE-F3-14. NC2074.2 +258300 DIV-FAIL-F3-14. NC2074.2 +258400 MOVE 1 TO CORRECT-N. NC2074.2 +258500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +258600 PERFORM FAIL. NC2074.2 +258700 DIV-WRITE-F3-14. NC2074.2 +258800 PERFORM PRINT-DETAIL. NC2074.2 +258900* NC2074.2 +259000 DIV-INIT-F3-15. NC2074.2 +259100 MOVE "DIV-TEST-F3-15 " TO PAR-NAME NC2074.2 +259200 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +259300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +259400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +259500 DIV-TEST-F3-15. NC2074.2 +259600 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +259700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +259800 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +259900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +260000 GIVING ACCUMULATOR2. NC2074.2 +260100 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +260200 PERFORM PASS NC2074.2 +260300 GO TO DIV-WRITE-F3-15. NC2074.2 +260400 GO TO DIV-FAIL-F3-15. NC2074.2 +260500 DIV-DELETE-F3-15. NC2074.2 +260600 PERFORM DE-LETE. NC2074.2 +260700 GO TO DIV-WRITE-F3-15. NC2074.2 +260800 DIV-FAIL-F3-15. NC2074.2 +260900 MOVE 1 TO CORRECT-N. NC2074.2 +261000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +261100 PERFORM FAIL. NC2074.2 +261200 DIV-WRITE-F3-15. NC2074.2 +261300 PERFORM PRINT-DETAIL. NC2074.2 +261400* NC2074.2 +261500 DIV-INIT-F3-16. NC2074.2 +261600 MOVE "DIV-TEST-F3-16 " TO PAR-NAME NC2074.2 +261700 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +261800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +261900 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +262000 DIV-TEST-F3-16. NC2074.2 +262100 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +262200 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +262300 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +262400 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +262500 GIVING ACCUMULATOR2. NC2074.2 +262600 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +262700 PERFORM PASS NC2074.2 +262800 GO TO DIV-WRITE-F3-16. NC2074.2 +262900 GO TO DIV-FAIL-F3-16. NC2074.2 +263000 DIV-DELETE-F3-16. NC2074.2 +263100 PERFORM DE-LETE. NC2074.2 +263200 GO TO DIV-WRITE-F3-16. NC2074.2 +263300 DIV-FAIL-F3-16. NC2074.2 +263400 MOVE 1 TO CORRECT-N. NC2074.2 +263500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +263600 PERFORM FAIL. NC2074.2 +263700 DIV-WRITE-F3-16. NC2074.2 +263800 PERFORM PRINT-DETAIL. NC2074.2 +263900* NC2074.2 +264000 DIV-INIT-F3-17. NC2074.2 +264100* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +264200 MOVE "DIV-TEST-F3-17 " TO PAR-NAME. NC2074.2 +264300 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +264400 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +264500 DIV-TEST-F3-17. NC2074.2 +264600 DIVIDE GROUP-49-4 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +264700 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +264800 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +264900 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +265000 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +265100 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +265200 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +265300 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +265400 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +265500 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +265600 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +265700 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +265800 IN SECOND-GROUP NC2074.2 +265900 BY 40 NC2074.2 +266000 GIVING ACCUMULATOR1. NC2074.2 +266100 IF ACCUMULATOR1 EQUAL TO 10 NC2074.2 +266200 PERFORM PASS NC2074.2 +266300 GO TO DIV-WRITE-F3-17. NC2074.2 +266400 GO TO DIV-FAIL-F3-17. NC2074.2 +266500 DIV-DELETE-F3-17. NC2074.2 +266600 PERFORM DE-LETE. NC2074.2 +266700 GO TO DIV-WRITE-F3-17. NC2074.2 +266800 DIV-FAIL-F3-17. NC2074.2 +266900 MOVE 10 TO CORRECT-N. NC2074.2 +267000 MOVE GROUP-49-4 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +267100 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +267200 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +267300 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +267400 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +267500 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +267600 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +267700 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +267800 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +267900 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +268000 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +268100 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +268200 IN SECOND-GROUP NC2074.2 +268300 TO COMPUTED-N. NC2074.2 +268400 PERFORM FAIL. NC2074.2 +268500 DIV-WRITE-F3-17. NC2074.2 +268600 PERFORM PRINT-DETAIL. NC2074.2 +268700 PERFORM END-ROUTINE. NC2074.2 +268800* NC2074.2 +268900 CND-INIT-GF-1. NC2074.2 +269000* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +269100 MOVE "CND-TEST-GF-1 " TO PAR-NAME. NC2074.2 +269200 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +269300 MOVE "CONDITION NAME " TO FEATURE. NC2074.2 +269400 CND-TEST-GF-1. NC2074.2 +269500 IF LEVEL-49-OK NC2074.2 +269600 PERFORM PASS NC2074.2 +269700 GO TO CND-WRITE-GF-1. NC2074.2 +269800 GO TO CND-FAIL-GF-1. NC2074.2 +269900 CND-DELETE-GF-1. NC2074.2 +270000 PERFORM DE-LETE. NC2074.2 +270100 GO TO CND-WRITE-GF-1. NC2074.2 +270200 CND-FAIL-GF-1. NC2074.2 +270300 MOVE 500 TO CORRECT-N. NC2074.2 +270400 MOVE GROUP-49-5 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +270500 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +270600 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +270700 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +270800 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +270900 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +271000 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +271100 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +271200 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +271300 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +271400 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +271500 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +271600 IN SECOND-GROUP NC2074.2 +271700 TO COMPUTED-N. NC2074.2 +271800 PERFORM FAIL. NC2074.2 +271900 CND-WRITE-GF-1. NC2074.2 +272000 PERFORM PRINT-DETAIL. NC2074.2 +272100 CCVS-EXIT SECTION. NC2074.2 +272200 CCVS-999999. NC2074.2 +272300 GO TO CLOSE-FILES. NC2074.2 +*END-OF,NC207A +*HEADER,COBOL,NC208A +000100 IDENTIFICATION DIVISION. NC2084.2 +000200 PROGRAM-ID. NC2084.2 +000300 NC208A. NC2084.2 +000400**************************************************************** NC2084.2 +000500* * NC2084.2 +000600* VALIDATION FOR:- * NC2084.2 +000700* * NC2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +000900* * NC2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2084.2 +001100* * NC2084.2 +001200**************************************************************** NC2084.2 +001300* * NC2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2084.2 +001500* * NC2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2084.2 +001900* * NC2084.2 +002000**************************************************************** NC2084.2 +002100 NC2084.2 +002200* * NC2084.2 +002300* PROGRAM NC208A TESTS FORMATS 1 AND 2 OF QUALIFICATION* NC2084.2 +002400* USING FORMATS 1 AND 2 OF THE "MOVE" STATEMENT, FORMAT 1 OF* NC2084.2 +002500* THE "ADD" STATEMENT AND THE FORMAT 2 "MULTIPLY" STATEMENT.* NC2084.2 +002600* * NC2084.2 +002700**************************************************************** NC2084.2 +002800 ENVIRONMENT DIVISION. NC2084.2 +002900 CONFIGURATION SECTION. NC2084.2 +003000 SOURCE-COMPUTER. NC2084.2 +003100 XXXXX082. NC2084.2 +003200 OBJECT-COMPUTER. NC2084.2 +003300 XXXXX083. NC2084.2 +003400 INPUT-OUTPUT SECTION. NC2084.2 +003500 FILE-CONTROL. NC2084.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2084.2 +003700 XXXXX055. NC2084.2 +003800 DATA DIVISION. NC2084.2 +003900 FILE SECTION. NC2084.2 +004000 FD PRINT-FILE. NC2084.2 +004100 01 PRINT-REC PICTURE X(120). NC2084.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2084.2 +004300 WORKING-STORAGE SECTION. NC2084.2 +004400 77 QT1 PICTURE XXXX VALUE SPACE. NC2084.2 +004500 77 QT2 PICTURE XXXX VALUE SPACE. NC2084.2 +004600 77 QT3 PICTURE XXXX VALUE SPACE. NC2084.2 +004700 77 QT4 PICTURE XXXX VALUE SPACE. NC2084.2 +004800 77 QT5 PICTURE XXXX VALUE SPACE. NC2084.2 +004900 77 WRK-XN-00001 PICTURE X. NC2084.2 +005000 77 WRK-DS-01V00 PICTURE S9. NC2084.2 +005100 77 WRK-DS-02V00 PICTURE S99. NC2084.2 +005200 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2084.2 +005300 77 WRK-DS-05V00 PICTURE S9(5). NC2084.2 +005400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2084.2 +005500 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2084.2 +005600 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2084.2 +005700 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2084.2 +005800 VALUE 111111111.111111111. NC2084.2 +005900 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2084.2 +006000 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2084.2 +006100 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2084.2 +006200 77 WRK-DS-03V00 PICTURE S999. NC2084.2 +006300 77 WRK-DS-06V00 PICTURE S9(6). NC2084.2 +006400 77 WRK-DS-0201P PICTURE S99P. NC2084.2 +006500 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2084.2 +006600 77 XRAY PICTURE IS X. NC2084.2 +006700 77 W-1 PICTURE IS 9. NC2084.2 +006800 77 W-2 PICTURE IS 99. NC2084.2 +006900 77 W-3 PICTURE IS 999. NC2084.2 +007000 77 W-4 PICTURE 9 VALUE 0. NC2084.2 +007100 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2084.2 +007200 77 W-9 PICTURE 999. NC2084.2 +007300 77 D-5 PICTURE S999 VALUE -1. NC2084.2 +007400 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2084.2 +007500 77 ONE PICTURE 9 VALUE 1. NC2084.2 +007600 77 TWO PICTURE S9 VALUE 2. NC2084.2 +007700 77 THREE PICTURE S9 VALUE 3. NC2084.2 +007800 77 FOUR PICTURE S9 VALUE 4. NC2084.2 +007900 77 FIVE PICTURE S9 VALUE 5. NC2084.2 +008000 77 SIX PICTURE S9 VALUE 6. NC2084.2 +008100 77 SEVEN PICTURE S9 VALUE 7. NC2084.2 +008200 77 EIGHT PICTURE 9 VALUE 8. NC2084.2 +008300 77 NINE PICTURE S9 VALUE 9. NC2084.2 +008400 77 TEN PICTURE S99 VALUE 10. NC2084.2 +008500 77 FIFTEEN PICTURE S99 VALUE 15. NC2084.2 +008600 77 TWENTY PICTURE S99 VALUE 20. NC2084.2 +008700 77 TWENTY-5 PICTURE S99 VALUE 25. NC2084.2 +008800 01 MOVE54. NC2084.2 +008900 02 MOVE55 PICTURE X VALUE "W". NC2084.2 +009000 02 MOVE56 PICTURE X VALUE "X". NC2084.2 +009100 02 MOVE57. NC2084.2 +009200 03 MOVE58 PICTURE X VALUE "Y". NC2084.2 +009300 03 MOVE59 PICTURE X VALUE "Z". NC2084.2 +009400 01 MOVE60. NC2084.2 +009500 02 MOVE56 PICTURE X. NC2084.2 +009600 02 MOVE57. NC2084.2 +009700 03 MOVE58 PICTURE X. NC2084.2 +009800 03 MOVE64. NC2084.2 +009900 04 MOVE65 PICTURE X VALUE "A". NC2084.2 +010000 01 SEND-BREAKDOWN. NC2084.2 +010100 02 SEND-20 PIC X(20). NC2084.2 +010200 02 SEND-40 PIC X(20). NC2084.2 +010300 02 SEND-60 PIC X(20). NC2084.2 +010400 01 RECEIVE-BREAKDOWN. NC2084.2 +010500 02 RECEIVE-20 PIC X(20). NC2084.2 +010600 02 RECEIVE-40 PIC X(20). NC2084.2 +010700 02 RECEIVE-60 PIC X(20). NC2084.2 +010800 01 GRP-FOR-QUAL-FROM. NC2084.2 +010900 02 QUAL-TEST-SUB-GRP-1. NC2084.2 +011000 03 QUAL-TEST-1 PICTURE X(26) VALUE NC2084.2 +011100 "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2084.2 +011200 03 QUAL-TEST-1-FROM REDEFINES QUAL-TEST-1 PICTURE X(26). NC2084.2 +011300 03 QUAL-TEST-2 PICTURE S9(10) VALUE +9999999999.NC2084.2 +011400 03 QUAL-TEST-2-FROM REDEFINES QUAL-TEST-2 PICTURE S9(10). NC2084.2 +011500 03 QUAL-TEST-3 PICTURE S999 VALUE 2. NC2084.2 +011600 03 QUAL-TEST-3-FROM REDEFINES QUAL-TEST-3 PICTURE S999. NC2084.2 +011700 02 QUAL-TEST-SUB-GRP-2. NC2084.2 +011800 03 QUAL-TEST-4 PICTURE X OCCURS 5 TIMES. NC2084.2 +011900 03 QUAL-TEST-4-FROM PICTURE X OCCURS 4 TIMES. NC2084.2 +012000 01 GRP-FOR-QUAL-TO. NC2084.2 +012100 02 DUMMY-LEVELZ. NC2084.2 +012200 03 QUAL-TEST-1 PICTURE X(26). NC2084.2 +012300 03 QUAL-TEST-1-TO REDEFINES QUAL-TEST-1 PICTURE X(26). NC2084.2 +012400 03 QUAL-TEST-2 PICTURE S9(10). NC2084.2 +012500 03 QUAL-TEST-2-TO REDEFINES QUAL-TEST-2 PICTURE S9(10). NC2084.2 +012600 03 QUAL-TEST-3 PICTURE S999. NC2084.2 +012700 03 QUAL-TEST-3-TO REDEFINES QUAL-TEST-3 PICTURE S999. NC2084.2 +012800 02 QUAL-TEST1. NC2084.2 +012900 03 QUAL-TEST-4 PICTURE X OCCURS 5 TIMES. NC2084.2 +013000 02 QUAL-TEST2. NC2084.2 +013100 03 QUAL-TEST-4-TO PICTURE X OCCURS 4 TIMES. NC2084.2 +013200 01 GRP-MOVE-CORR-1. NC2084.2 +013300 09 MOVE-CORR-5 PICTURE 999 VALUE 555. NC2084.2 +013400 09 MOVE-CORR-3 PICTURE 999 VALUE 333. NC2084.2 +013500 09 MOVE-CORR-2 PICTURE 999 VALUE 222. NC2084.2 +013600 09 MOVE-CORR-1 PICTURE 999 VALUE 111. NC2084.2 +013700 09 FILLER PICTURE XXX VALUE ZEROS. NC2084.2 +013800 09 MOVE-CORR-4 PICTURE XXX VALUE "XYZ". NC2084.2 +013900 09 MOVE-CORR-6 PICTURE XXX VALUE ALL "6". NC2084.2 +014000 09 MOVE-CORR-7 PICTURE 999 VALUE 777. NC2084.2 +014100 01 GRP-MOVE-CORR-R. NC2084.2 +014200 05 FILLER PICTURE XXX. NC2084.2 +014300 05 MOVE-CORR-1 PICTURE XXX. NC2084.2 +014400 05 MOVE-CORR-2 PICTURE 999. NC2084.2 +014500 05 MOVE-CORR-3 PICTURE ZZZ. NC2084.2 +014600 05 MOVE-CORR-4. NC2084.2 +014700 06 FILLER PICTURE 999. NC2084.2 +014800 06 FILLER PICTURE XXX. NC2084.2 +014900 01 GRP-TO-MOVE-CORR. NC2084.2 +015000 03 GRP-TO-MOVE-CORR-1. NC2084.2 +015100 05 MOVE-CORR-G1. NC2084.2 +015200 06 MOVE-CORR-G2. NC2084.2 +015300 09 MOVE-CORR-E1 PICTURE 999 VALUE 111. NC2084.2 +015400 09 MOVE-CORR-E2 PICTURE 999 VALUE 222. NC2084.2 +015500 09 FILLER PICTURE 999 VALUE 333. NC2084.2 +015600 06 MOVE-CORR-G3. NC2084.2 +015700 07 MOVE-CORR-E3 PICTURE XXX VALUE "123". NC2084.2 +015800 07 MOVE-CORR-G4. NC2084.2 +015900 08 MOVE-CORR-G5. NC2084.2 +016000 09 MOVE-CORR-E4 PICTURE XXX VALUE "ABC".NC2084.2 +016100 09 MOVE-CORR-E5 PICTURE 99 VALUE 45. NC2084.2 +016200 01 GRP-TO-MOVE-CORR-TO. NC2084.2 +016300 02 MOVE-CORR-G1. NC2084.2 +016400 04 MOVE-CORR-G2. NC2084.2 +016500 05 MOVE-CORR-E1 PICTURE XXX. NC2084.2 +016600 05 MOVE-CORR-E2 PICTURE 999 OCCURS 2. NC2084.2 +016700 05 FILLER PICTURE 999. NC2084.2 +016800 04 MOVE-CORR-G3. NC2084.2 +016900 06 MOVE-CORR-E3 PICTURE 999. NC2084.2 +017000 06 MOVE-CORR-G4. NC2084.2 +017100 07 MOVE-CORR-G5 PICTURE X(5). NC2084.2 +017200 01 GRP-FOR-MULT-REC-A. NC2084.2 +017300 03 WRK-DS-01V00-IN-GRP PICTURE S9 VALUE ZERO. NC2084.2 +017400 03 WRK-DS-05V00-IN-GRP PICTURE S9(5) VALUE ZERO. NC2084.2 +017500 03 WRK-DS-06V06-IN-GRP PICTURE S9(6)V9(6) VALUE ZERO. NC2084.2 +017600 01 GRP-FOR-MULT-REC-B. NC2084.2 +017700 03 WRK-DS-03V10-IN-GRP PICTURE S9(3)V9(10) VALUE ZERO. NC2084.2 +017800 03 WRK-DS-0201P-IN-GRP PICTURE S99P VALUE ZERO. NC2084.2 +017900 03 WRK-DS-03V00-IN-GRP PICTURE S999 VALUE ZERO. NC2084.2 +018000 01 GRP-FOR-MULT-REC-C. NC2084.2 +018100 03 WRK-DS-02V00-IN-GRP PICTURE S99 VALUE ZERO. NC2084.2 +018200 03 WRK-DS-18V00-IN-GRP PICTURE S9(18) VALUE ZERO. NC2084.2 +018300 03 WRK-DS-09V09-IN-GRP PICTURE S9(9)V9(9) VALUE ZERO. NC2084.2 +018400 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2084.2 +018500 01 CORR-DATA-1. NC2084.2 +018600 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018700 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018800 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018900 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019000 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019100 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019200 01 CORR-DATA-2. NC2084.2 +019300 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019500 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019700 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019900 01 CORR-DATA-3. NC2084.2 +020000 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020100 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020200 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020300 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020500 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020600 01 CORR-DATA-4. NC2084.2 +020700 03 XYZ-11 PICTURE IS 99. NC2084.2 +020800 03 XYZ-12 PICTURE IS 99. NC2084.2 +020900 03 XYZ-13 PICTURE IS 99. NC2084.2 +021000 03 XYZ-14 PICTURE IS 99. NC2084.2 +021100 03 XYZ-15 PICTURE IS 99. NC2084.2 +021200 03 XYZ-16 PICTURE IS 99. NC2084.2 +021300 01 CORR-DATA-5. NC2084.2 +021400 03 XYZ-1 PICTURE 99. NC2084.2 +021500 03 XYZ-2 PICTURE 99. NC2084.2 +021600 03 XYZ-13 PICTURE IS 99. NC2084.2 +021700 03 XYZ-14 PICTURE IS 99. NC2084.2 +021800 03 FILLER PICTURE IS 99. NC2084.2 +021900 03 XYZ-11 PICTURE IS 99. NC2084.2 +022000 03 XYZ-12 PICTURE IS 99. NC2084.2 +022100 01 CORR-DATA-6. NC2084.2 +022200 03 XYZ-11 PICTURE IS 99. NC2084.2 +022300 03 XYZ-12 PICTURE IS 99. NC2084.2 +022400 03 FILLER PICTURE IS 99. NC2084.2 +022500 03 XYZ-1 PICTURE IS 99. NC2084.2 +022600 03 XYZ-2 PICTURE IS 9(2). NC2084.2 +022700 03 FILLER PICTURE IS 99. NC2084.2 +022800 01 CORR-DATA-7. NC2084.2 +022900 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2084.2 +023000 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2084.2 +023100 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2084.2 +023200 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2084.2 +023300 01 AN-DATANAMES. NC2084.2 +023400 02 ANDATA1 PICTURE X VALUE SPACE. NC2084.2 +023500 02 ANDATA2 PICTURE XX VALUE SPACE. NC2084.2 +023600 02 ANDATA3 PICTURE XXX VALUE SPACE. NC2084.2 +023700 02 ANDATA4 PICTURE X(4) VALUE SPACE. NC2084.2 +023800 02 ANDATA5 PICTURE X(5) VALUE SPACE. NC2084.2 +023900 02 ANDATA6 PICTURE X(6) VALUE SPACE. NC2084.2 +024000 02 ANDATA7 PICTURE X(7) VALUE SPACE. NC2084.2 +024100 02 ANDATA8 PICTURE X(8) VALUE SPACE. NC2084.2 +024200 02 ANDATA9 PICTURE X(9) VALUE SPACE. NC2084.2 +024300 02 ANDATA10 PICTURE X(10) VALUE SPACE. NC2084.2 +024400 02 ANDATA11 PICTURE X(11) VALUE SPACE. NC2084.2 +024500 02 ANDATA12 PICTURE X(12) VALUE SPACE. NC2084.2 +024600 02 ANDATA13 PICTURE X(13) VALUE SPACE. NC2084.2 +024700 02 ANDATA14 PICTURE X(14) VALUE SPACE. NC2084.2 +024800 02 ANDATA15 PICTURE X(15) VALUE SPACE. NC2084.2 +024900 02 ANDATA16 PICTURE X(16) VALUE SPACE. NC2084.2 +025000 02 ANDATA17 PICTURE X(17) VALUE SPACE. NC2084.2 +025100 02 ANDATA18 PICTURE X(18) VALUE SPACE. NC2084.2 +025200 02 ANDATA19 PICTURE X(19) VALUE SPACE. NC2084.2 +025300 02 ANDATA20 PICTURE X(20) VALUE SPACE. NC2084.2 +025400 02 ANDATA21 PICTURE X(120) VALUE SPACE. NC2084.2 +025500 01 42-DATANAMES. NC2084.2 +025600 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2084.2 +025700 02 DNAME2 PICTURE 99 VALUE 01 COMPUTATIONAL. NC2084.2 +025800 02 DNAME3 PICTURE 999 VALUE 001 COMPUTATIONAL. NC2084.2 +025900 02 DNAME4 PICTURE 9(4) VALUE 0001 COMPUTATIONAL. NC2084.2 +026000 02 DNAME5 PICTURE 9(5) VALUE 00001 COMPUTATIONAL. NC2084.2 +026100 02 DNAME6 PICTURE 9(6) VALUE 000001 COMPUTATIONAL. NC2084.2 +026200 02 DNAME7 PICTURE 9(7) VALUE 0000001 COMPUTATIONAL. NC2084.2 +026300 02 DNAME8 PICTURE 9(8) VALUE 00000001 COMPUTATIONAL. NC2084.2 +026400 02 DNAME9 PICTURE 9(9) VALUE 000000001. NC2084.2 +026500 02 DNAME10 PICTURE 9(10) VALUE 0000000001. NC2084.2 +026600 02 DNAME11 PICTURE 9(11) VALUE 00000000001. NC2084.2 +026700 02 DNAME12 PICTURE 9(12) VALUE 000000000001. NC2084.2 +026800 02 DNAME13 PICTURE 9(13) VALUE 0000000000001. NC2084.2 +026900 02 DNAME14 PICTURE 9(14) VALUE 00000000000001. NC2084.2 +027000 02 DNAME15 PICTURE 9(15) VALUE 000000000000001. NC2084.2 +027100 02 DNAME16 PICTURE 9(16) VALUE 0000000000000001. NC2084.2 +027200 02 DNAME17 PICTURE 9(17) VALUE 00000000000000001. NC2084.2 +027300 02 DNAME18 PICTURE 9(18) VALUE 000000000000000001. NC2084.2 +027400 02 DNAME19 PICTURE 9 VALUE 1. NC2084.2 +027500 02 DNAME20 PICTURE 99 VALUE 11. NC2084.2 +027600 02 DNAME21 PICTURE 999 VALUE 111. NC2084.2 +027700 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2084.2 +027800 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2084.2 +027900 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2084.2 +028000 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2084.2 +028100 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2084.2 +028200 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2084.2 +028300 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2084.2 +028400 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2084.2 +028500 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028600 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028700 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028800 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028900 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029000 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029100 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029200 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029300 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029400 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029500 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029600 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029700 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029800 01 TEST-RESULTS. NC2084.2 +029900 02 FILLER PIC X VALUE SPACE. NC2084.2 +030000 02 FEATURE PIC X(20) VALUE SPACE. NC2084.2 +030100 02 FILLER PIC X VALUE SPACE. NC2084.2 +030200 02 P-OR-F PIC X(5) VALUE SPACE. NC2084.2 +030300 02 FILLER PIC X VALUE SPACE. NC2084.2 +030400 02 PAR-NAME. NC2084.2 +030500 03 FILLER PIC X(19) VALUE SPACE. NC2084.2 +030600 03 PARDOT-X PIC X VALUE SPACE. NC2084.2 +030700 03 DOTVALUE PIC 99 VALUE ZERO. NC2084.2 +030800 02 FILLER PIC X(8) VALUE SPACE. NC2084.2 +030900 02 RE-MARK PIC X(61). NC2084.2 +031000 01 TEST-COMPUTED. NC2084.2 +031100 02 FILLER PIC X(30) VALUE SPACE. NC2084.2 +031200 02 FILLER PIC X(17) VALUE NC2084.2 +031300 " COMPUTED=". NC2084.2 +031400 02 COMPUTED-X. NC2084.2 +031500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2084.2 +031600 03 COMPUTED-N REDEFINES COMPUTED-A NC2084.2 +031700 PIC -9(9).9(9). NC2084.2 +031800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2084.2 +031900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2084.2 +032000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2084.2 +032100 03 CM-18V0 REDEFINES COMPUTED-A. NC2084.2 +032200 04 COMPUTED-18V0 PIC -9(18). NC2084.2 +032300 04 FILLER PIC X. NC2084.2 +032400 03 FILLER PIC X(50) VALUE SPACE. NC2084.2 +032500 01 TEST-CORRECT. NC2084.2 +032600 02 FILLER PIC X(30) VALUE SPACE. NC2084.2 +032700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2084.2 +032800 02 CORRECT-X. NC2084.2 +032900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2084.2 +033000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2084.2 +033100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2084.2 +033200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2084.2 +033300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2084.2 +033400 03 CR-18V0 REDEFINES CORRECT-A. NC2084.2 +033500 04 CORRECT-18V0 PIC -9(18). NC2084.2 +033600 04 FILLER PIC X. NC2084.2 +033700 03 FILLER PIC X(2) VALUE SPACE. NC2084.2 +033800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2084.2 +033900 01 CCVS-C-1. NC2084.2 +034000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2084.2 +034100- "SS PARAGRAPH-NAME NC2084.2 +034200- " REMARKS". NC2084.2 +034300 02 FILLER PIC X(20) VALUE SPACE. NC2084.2 +034400 01 CCVS-C-2. NC2084.2 +034500 02 FILLER PIC X VALUE SPACE. NC2084.2 +034600 02 FILLER PIC X(6) VALUE "TESTED". NC2084.2 +034700 02 FILLER PIC X(15) VALUE SPACE. NC2084.2 +034800 02 FILLER PIC X(4) VALUE "FAIL". NC2084.2 +034900 02 FILLER PIC X(94) VALUE SPACE. NC2084.2 +035000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2084.2 +035100 01 REC-CT PIC 99 VALUE ZERO. NC2084.2 +035200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2084.2 +035700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2084.2 +035800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2084.2 +035900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2084.2 +036000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2084.2 +036100 01 CCVS-H-1. NC2084.2 +036200 02 FILLER PIC X(39) VALUE SPACES. NC2084.2 +036300 02 FILLER PIC X(42) VALUE NC2084.2 +036400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2084.2 +036500 02 FILLER PIC X(39) VALUE SPACES. NC2084.2 +036600 01 CCVS-H-2A. NC2084.2 +036700 02 FILLER PIC X(40) VALUE SPACE. NC2084.2 +036800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2084.2 +036900 02 FILLER PIC XXXX VALUE NC2084.2 +037000 "4.2 ". NC2084.2 +037100 02 FILLER PIC X(28) VALUE NC2084.2 +037200 " COPY - NOT FOR DISTRIBUTION". NC2084.2 +037300 02 FILLER PIC X(41) VALUE SPACE. NC2084.2 +037400 NC2084.2 +037500 01 CCVS-H-2B. NC2084.2 +037600 02 FILLER PIC X(15) VALUE NC2084.2 +037700 "TEST RESULT OF ". NC2084.2 +037800 02 TEST-ID PIC X(9). NC2084.2 +037900 02 FILLER PIC X(4) VALUE NC2084.2 +038000 " IN ". NC2084.2 +038100 02 FILLER PIC X(12) VALUE NC2084.2 +038200 " HIGH ". NC2084.2 +038300 02 FILLER PIC X(22) VALUE NC2084.2 +038400 " LEVEL VALIDATION FOR ". NC2084.2 +038500 02 FILLER PIC X(58) VALUE NC2084.2 +038600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +038700 01 CCVS-H-3. NC2084.2 +038800 02 FILLER PIC X(34) VALUE NC2084.2 +038900 " FOR OFFICIAL USE ONLY ". NC2084.2 +039000 02 FILLER PIC X(58) VALUE NC2084.2 +039100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2084.2 +039200 02 FILLER PIC X(28) VALUE NC2084.2 +039300 " COPYRIGHT 1985 ". NC2084.2 +039400 01 CCVS-E-1. NC2084.2 +039500 02 FILLER PIC X(52) VALUE SPACE. NC2084.2 +039600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2084.2 +039700 02 ID-AGAIN PIC X(9). NC2084.2 +039800 02 FILLER PIC X(45) VALUE SPACES. NC2084.2 +039900 01 CCVS-E-2. NC2084.2 +040000 02 FILLER PIC X(31) VALUE SPACE. NC2084.2 +040100 02 FILLER PIC X(21) VALUE SPACE. NC2084.2 +040200 02 CCVS-E-2-2. NC2084.2 +040300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2084.2 +040400 03 FILLER PIC X VALUE SPACE. NC2084.2 +040500 03 ENDER-DESC PIC X(44) VALUE NC2084.2 +040600 "ERRORS ENCOUNTERED". NC2084.2 +040700 01 CCVS-E-3. NC2084.2 +040800 02 FILLER PIC X(22) VALUE NC2084.2 +040900 " FOR OFFICIAL USE ONLY". NC2084.2 +041000 02 FILLER PIC X(12) VALUE SPACE. NC2084.2 +041100 02 FILLER PIC X(58) VALUE NC2084.2 +041200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +041300 02 FILLER PIC X(13) VALUE SPACE. NC2084.2 +041400 02 FILLER PIC X(15) VALUE NC2084.2 +041500 " COPYRIGHT 1985". NC2084.2 +041600 01 CCVS-E-4. NC2084.2 +041700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2084.2 +041800 02 FILLER PIC X(4) VALUE " OF ". NC2084.2 +041900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2084.2 +042000 02 FILLER PIC X(40) VALUE NC2084.2 +042100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2084.2 +042200 01 XXINFO. NC2084.2 +042300 02 FILLER PIC X(19) VALUE NC2084.2 +042400 "*** INFORMATION ***". NC2084.2 +042500 02 INFO-TEXT. NC2084.2 +042600 04 FILLER PIC X(8) VALUE SPACE. NC2084.2 +042700 04 XXCOMPUTED PIC X(20). NC2084.2 +042800 04 FILLER PIC X(5) VALUE SPACE. NC2084.2 +042900 04 XXCORRECT PIC X(20). NC2084.2 +043000 02 INF-ANSI-REFERENCE PIC X(48). NC2084.2 +043100 01 HYPHEN-LINE. NC2084.2 +043200 02 FILLER PIC IS X VALUE IS SPACE. NC2084.2 +043300 02 FILLER PIC IS X(65) VALUE IS "************************NC2084.2 +043400- "*****************************************". NC2084.2 +043500 02 FILLER PIC IS X(54) VALUE IS "************************NC2084.2 +043600- "******************************". NC2084.2 +043700 01 CCVS-PGM-ID PIC X(9) VALUE NC2084.2 +043800 "NC208A". NC2084.2 +043900 PROCEDURE DIVISION. NC2084.2 +044000 CCVS1 SECTION. NC2084.2 +044100 OPEN-FILES. NC2084.2 +044200 OPEN OUTPUT PRINT-FILE. NC2084.2 +044300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2084.2 +044400 MOVE SPACE TO TEST-RESULTS. NC2084.2 +044500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2084.2 +044600 GO TO CCVS1-EXIT. NC2084.2 +044700 CLOSE-FILES. NC2084.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2084.2 +044900 TERMINATE-CCVS. NC2084.2 +045000S EXIT PROGRAM. NC2084.2 +045100STERMINATE-CALL. NC2084.2 +045200 STOP RUN. NC2084.2 +045300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2084.2 +045400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2084.2 +045500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2084.2 +045600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2084.2 +045700 MOVE "****TEST DELETED****" TO RE-MARK. NC2084.2 +045800 PRINT-DETAIL. NC2084.2 +045900 IF REC-CT NOT EQUAL TO ZERO NC2084.2 +046000 MOVE "." TO PARDOT-X NC2084.2 +046100 MOVE REC-CT TO DOTVALUE. NC2084.2 +046200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2084.2 +046300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2084.2 +046400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2084.2 +046500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2084.2 +046600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2084.2 +046700 MOVE SPACE TO CORRECT-X. NC2084.2 +046800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2084.2 +046900 MOVE SPACE TO RE-MARK. NC2084.2 +047000 HEAD-ROUTINE. NC2084.2 +047100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2084.2 +047400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2084.2 +047500 COLUMN-NAMES-ROUTINE. NC2084.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +047900 END-ROUTINE. NC2084.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2084.2 +048100 END-RTN-EXIT. NC2084.2 +048200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +048300 END-ROUTINE-1. NC2084.2 +048400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2084.2 +048500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2084.2 +048600 ADD PASS-COUNTER TO ERROR-HOLD. NC2084.2 +048700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2084.2 +048800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2084.2 +048900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2084.2 +049000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2084.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2084.2 +049200 END-ROUTINE-12. NC2084.2 +049300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2084.2 +049400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2084.2 +049500 MOVE "NO " TO ERROR-TOTAL NC2084.2 +049600 ELSE NC2084.2 +049700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2084.2 +049800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2084.2 +049900 PERFORM WRITE-LINE. NC2084.2 +050000 END-ROUTINE-13. NC2084.2 +050100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2084.2 +050200 MOVE "NO " TO ERROR-TOTAL ELSE NC2084.2 +050300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2084.2 +050400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2084.2 +050500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +050600 IF INSPECT-COUNTER EQUAL TO ZERO NC2084.2 +050700 MOVE "NO " TO ERROR-TOTAL NC2084.2 +050800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2084.2 +050900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2084.2 +051000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +051100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +051200 WRITE-LINE. NC2084.2 +051300 ADD 1 TO RECORD-COUNT. NC2084.2 +051400Y IF RECORD-COUNT GREATER 50 NC2084.2 +051500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2084.2 +051600Y MOVE SPACE TO DUMMY-RECORD NC2084.2 +051700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2084.2 +051800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2084.2 +051900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2084.2 +052000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2084.2 +052100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2084.2 +052200Y MOVE ZERO TO RECORD-COUNT. NC2084.2 +052300 PERFORM WRT-LN. NC2084.2 +052400 WRT-LN. NC2084.2 +052500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2084.2 +052600 MOVE SPACE TO DUMMY-RECORD. NC2084.2 +052700 BLANK-LINE-PRINT. NC2084.2 +052800 PERFORM WRT-LN. NC2084.2 +052900 FAIL-ROUTINE. NC2084.2 +053000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2084.2 +053100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2084.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2084.2 +053300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2084.2 +053400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2084.2 +053600 GO TO FAIL-ROUTINE-EX. NC2084.2 +053700 FAIL-ROUTINE-WRITE. NC2084.2 +053800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2084.2 +053900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2084.2 +054000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2084.2 +054100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2084.2 +054200 FAIL-ROUTINE-EX. EXIT. NC2084.2 +054300 BAIL-OUT. NC2084.2 +054400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2084.2 +054500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2084.2 +054600 BAIL-OUT-WRITE. NC2084.2 +054700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2084.2 +054800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2084.2 +054900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +055000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2084.2 +055100 BAIL-OUT-EX. EXIT. NC2084.2 +055200 CCVS1-EXIT. NC2084.2 +055300 EXIT. NC2084.2 +055400 QUAL-SECTION-1 SECTION. NC2084.2 +055500 PAR-INIT-F2-1. NC2084.2 +055600 MOVE "PAR-TEST-F2-1 " TO PAR-NAME. NC2084.2 +055700 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +055800 PAR-TEST-F2-1. NC2084.2 +055900 PERFORM PAR-1A OF QUAL-SECTION-1. NC2084.2 +056000 IF QT1 EQUAL TO "PASS" NC2084.2 +056100 PERFORM PASS NC2084.2 +056200 GO TO PAR-WRITE-F2-1. NC2084.2 +056300 GO TO PAR-FAIL-F2-1. NC2084.2 +056400 PAR-DELETE-F2-1. NC2084.2 +056500 PERFORM DE-LETE. NC2084.2 +056600 GO TO PAR-WRITE-F2-1. NC2084.2 +056700 PAR-FAIL-F2-1. NC2084.2 +056800 PERFORM FAIL. NC2084.2 +056900* NOTE NC2084.2 +057000* PERFORM PARAGRAPH IN SAME SECTION. NC2084.2 +057100 PAR-WRITE-F2-1. NC2084.2 +057200 PERFORM PRINT-DETAIL. NC2084.2 +057300 GO TO PAR-1-EXIT. NC2084.2 +057400* NC2084.2 +057500 PAR-1A. NC2084.2 +057600 MOVE "PASS" TO QT1. NC2084.2 +057700 PAR-1-EXIT. NC2084.2 +057800 EXIT. NC2084.2 +057900* NC2084.2 +058000 PAR-INIT-F2-2. NC2084.2 +058100 MOVE "PAR-TEST-F2-2" TO PAR-NAME. NC2084.2 +058200 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +058300 PAR-TEST-F2-2. NC2084.2 +058400 PERFORM PAR-2A OF QUAL-SECTION-2. NC2084.2 +058500 IF QT2 EQUAL TO "PASS" NC2084.2 +058600 PERFORM PASS NC2084.2 +058700 GO TO PAR-WRITE-F2-2. NC2084.2 +058800 GO TO PAR-FAIL-F2-2. NC2084.2 +058900 PAR-DELETE-F2-2. NC2084.2 +059000 PERFORM DE-LETE. NC2084.2 +059100 GO TO PAR-WRITE-F2-2. NC2084.2 +059200 PAR-FAIL-F2-2. NC2084.2 +059300 PERFORM FAIL. NC2084.2 +059400* NOTE NC2084.2 +059500* PERFORM PARAGRAPH IN A DIFFERENT SECTION. NC2084.2 +059600 PAR-WRITE-F2-2. NC2084.2 +059700 PERFORM PRINT-DETAIL. NC2084.2 +059800 GO TO PAR-2-EXIT. NC2084.2 +059900 PAR-2A. NC2084.2 +060000 MOVE "FAIL" TO QT2. NC2084.2 +060100 PAR-2-EXIT. NC2084.2 +060200 EXIT. NC2084.2 +060300* NC2084.2 +060400 PAR-INIT-F2-3. NC2084.2 +060500 MOVE "PAR-TEST-F2-3" TO PAR-NAME. NC2084.2 +060600 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +060700 PAR-TEST-F2-3. NC2084.2 +060800 GO TO PAR-3B IN QUAL-SECTION-1. NC2084.2 +060900* NOTE NC2084.2 +061000* GO TO IN SAME SECTION. NC2084.2 +061100 PAR-3A. NC2084.2 +061200 MOVE "FAIL" TO QT3. NC2084.2 +061300 GO TO PAR-3C. NC2084.2 +061400 PAR-3B. NC2084.2 +061500 MOVE "PASS" TO QT3. NC2084.2 +061600 PAR-3C. NC2084.2 +061700 IF QT3 EQUAL TO "PASS" NC2084.2 +061800 PERFORM PASS NC2084.2 +061900 GO TO PAR-WRITE-F2-3. NC2084.2 +062000 GO TO PAR-FAIL-F2-3. NC2084.2 +062100 PAR-DELETE-F2-3. NC2084.2 +062200 PERFORM DE-LETE. NC2084.2 +062300 GO TO PAR-WRITE-F2-3. NC2084.2 +062400 PAR-FAIL-F2-3. NC2084.2 +062500 PERFORM FAIL. NC2084.2 +062600 PAR-WRITE-F2-3. NC2084.2 +062700 PERFORM PRINT-DETAIL. NC2084.2 +062800 PAR-3-EXIT. NC2084.2 +062900 EXIT. NC2084.2 +063000* NC2084.2 +063100 PAR-INIT-F2-4. NC2084.2 +063200 MOVE "PAR-TEST-F2-4" TO PAR-NAME. NC2084.2 +063300 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +063400 PAR-TEST-F2-4. NC2084.2 +063500 GO TO PAR-4B IN QUAL-SECTION-2. NC2084.2 +063600* NOTE NC2084.2 +063700* GO TO IN DIFFERENT SECTION. NC2084.2 +063800 PAR-4A. NC2084.2 +063900 MOVE "FAIL" TO QT4. NC2084.2 +064000 GO TO PAR-4C. NC2084.2 +064100 PAR-4B. NC2084.2 +064200 MOVE "FAIL" TO QT4. NC2084.2 +064300 PAR-4C. NC2084.2 +064400 IF QT4 EQUAL TO "PASS" NC2084.2 +064500 PERFORM PASS NC2084.2 +064600 GO TO PAR-WRITE-F2-4. NC2084.2 +064700 GO TO PAR-FAIL-F2-4. NC2084.2 +064800 PAR-DELETE-F2-4. NC2084.2 +064900 PERFORM DE-LETE. NC2084.2 +065000 GO TO PAR-WRITE-F2-4. NC2084.2 +065100 PAR-FAIL-F2-4. NC2084.2 +065200 PERFORM FAIL. NC2084.2 +065300 PAR-WRITE-F2-4. NC2084.2 +065400 PERFORM PRINT-DETAIL. NC2084.2 +065500 PAR-4-EXIT. NC2084.2 +065600 PERFORM END-ROUTINE. NC2084.2 +065700 GO TO QUAL-EXIT. NC2084.2 +065800 QUAL-SECTION-2 SECTION. NC2084.2 +065900 PAR-1A. NC2084.2 +066000 MOVE "FAIL" TO QT1. NC2084.2 +066100 PAR-2A. NC2084.2 +066200 MOVE "PASS" TO QT2. NC2084.2 +066300 PAR-3B. NC2084.2 +066400 MOVE "FAIL" TO QT3. NC2084.2 +066500 GO TO PAR-3C OF QUAL-SECTION-1. NC2084.2 +066600 PAR-3C. NC2084.2 +066700 PERFORM FAIL. NC2084.2 +066800* NOTE THIS PARAGRAPH SHOULD NEVER BE ENTERED. NC2084.2 +066900 GO TO PAR-INIT-F2-4 IN QUAL-SECTION-1. NC2084.2 +067000 PAR-4. NC2084.2 +067100 GO TO QUAL-EXIT. NC2084.2 +067200* NOTE NC2084.2 +067300* IF NC2084.2 +067400* GO TO DIFFERENT SECTION FAILS END QUALIFICATION TEST. NC2084.2 +067500 PAR-4B. NC2084.2 +067600 MOVE "PASS" TO QT4. NC2084.2 +067700 GO TO PAR-4C IN QUAL-SECTION-1. NC2084.2 +067800 QUAL-EXIT. NC2084.2 +067900 EXIT. NC2084.2 +068000 DATA-NAME-QUAL SECTION. NC2084.2 +068100 QAL-INIT-F1-1. NC2084.2 +068200 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2084.2 +068300 MOVE SPACE TO TEST-RESULTS. NC2084.2 +068400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +068500 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +068600 QAL-TEST-F1-1. NC2084.2 +068700 MOVE "123456789" TO QUAL-TEST-SUB-GRP-2. NC2084.2 +068800 MOVE ZERO TO GRP-FOR-QUAL-TO. NC2084.2 +068900 MOVE 2 TO WRK-DS-01V00. NC2084.2 +069000 MOVE QUAL-TEST-1 OF GRP-FOR-QUAL-FROM NC2084.2 +069100 TO QUAL-TEST-1 OF GRP-FOR-QUAL-TO. NC2084.2 +069200 IF QUAL-TEST-1 OF GRP-FOR-QUAL-TO EQUAL TO NC2084.2 +069300 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" NC2084.2 +069400 PERFORM PASS NC2084.2 +069500 GO TO QAL-WRITE-F1-1. NC2084.2 +069600 GO TO QAL-FAIL-F1-1. NC2084.2 +069700 QAL-DELETE-F1-1. NC2084.2 +069800 PERFORM DE-LETE. NC2084.2 +069900 GO TO QAL-WRITE-F1-1. NC2084.2 +070000 QAL-FAIL-F1-1. NC2084.2 +070100 MOVE "ABCDEFGGHIJKLMNOPQRSTUVWXYZ" TO SEND-BREAKDOWN NC2084.2 +070200 MOVE QUAL-TEST-1 OF GRP-FOR-QUAL-TO TO RECEIVE-BREAKDOWN NC2084.2 +070300 PERFORM FAIL NC2084.2 +070400 MOVE SEND-20 TO CORRECT-A NC2084.2 +070500 MOVE RECEIVE-20 TO COMPUTED-A NC2084.2 +070600 MOVE "1ST 20 POSITIONS OF ANSWERS" TO RE-MARK NC2084.2 +070700 MOVE TEST-RESULTS TO PRINT-REC. NC2084.2 +070800 WRITE PRINT-REC NC2084.2 +070900 MOVE SPACES TO P-OR-F NC2084.2 +071000 MOVE SEND-40 TO CORRECT-A NC2084.2 +071100 MOVE RECEIVE-40 TO COMPUTED-A NC2084.2 +071200 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2084.2 +071300 MOVE "2ND 20 POSITIONS OF ANSWERS" TO RE-MARK. NC2084.2 +071400 QAL-WRITE-F1-1. NC2084.2 +071500 PERFORM PRINT-DETAIL. NC2084.2 +071600* NC2084.2 +071700 QAL-INIT-F1-2. NC2084.2 +071800 MOVE "QAL-TEST-F1-2 " TO PAR-NAME. NC2084.2 +071900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +072000 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +072100 MOVE ZERO TO QUAL-TEST-2-TO. NC2084.2 +072200 QAL-TEST-F1-2. NC2084.2 +072300 ADD QUAL-TEST-2 OF GRP-FOR-QUAL-FROM NC2084.2 +072400 TO QUAL-TEST-2 OF GRP-FOR-QUAL-TO. NC2084.2 +072500 IF QUAL-TEST-2 OF GRP-FOR-QUAL-TO EQUAL TO 9999999999 NC2084.2 +072600 PERFORM PASS NC2084.2 +072700 GO TO QAL-WRITE-F1-2. NC2084.2 +072800 GO TO QAL-FAIL-F1-2. NC2084.2 +072900 QAL-DELETE-F1-2. NC2084.2 +073000 PERFORM DE-LETE. NC2084.2 +073100 GO TO QAL-WRITE-F1-2. NC2084.2 +073200 QAL-FAIL-F1-2. NC2084.2 +073300 MOVE 9999999999 TO CORRECT-18V0. NC2084.2 +073400 MOVE QUAL-TEST-2 OF GRP-FOR-QUAL-TO TO COMPUTED-18V0. NC2084.2 +073500 PERFORM FAIL. NC2084.2 +073600 QAL-WRITE-F1-2. NC2084.2 +073700 PERFORM PRINT-DETAIL. NC2084.2 +073800* NC2084.2 +073900 QAL-INIT-F1-3. NC2084.2 +074000 MOVE "QAL-TEST-F1-3 " TO PAR-NAME. NC2084.2 +074100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +074200 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +074300 QAL-TEST-F1-3. NC2084.2 +074400 MULTIPLY QUAL-TEST-3 OF GRP-FOR-QUAL-FROM BY WRK-DS-01V00 NC2084.2 +074500 GIVING QUAL-TEST-3 OF GRP-FOR-QUAL-TO. NC2084.2 +074600 IF QUAL-TEST-3 OF GRP-FOR-QUAL-TO EQUAL TO 004 NC2084.2 +074700 PERFORM PASS NC2084.2 +074800 GO TO QAL-WRITE-F1-3. NC2084.2 +074900 GO TO QAL-FAIL-F1-3. NC2084.2 +075000 QAL-DELETE-F1-3. NC2084.2 +075100 PERFORM DE-LETE. NC2084.2 +075200 GO TO QAL-WRITE-F1-3. NC2084.2 +075300 QAL-FAIL-F1-3. NC2084.2 +075400 MOVE 004 TO CORRECT-N. NC2084.2 +075500 MOVE QUAL-TEST-3 OF GRP-FOR-QUAL-TO TO COMPUTED-N. NC2084.2 +075600 PERFORM FAIL. NC2084.2 +075700 QAL-WRITE-F1-3. NC2084.2 +075800 PERFORM PRINT-DETAIL. NC2084.2 +075900* NC2084.2 +076000 QAL-INIT-F1-4. NC2084.2 +076100 MOVE "QAL-TEST-F1-4 " TO PAR-NAME. NC2084.2 +076200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +076300 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +076400 QAL-TEST-F1-4. NC2084.2 +076500 MOVE QUAL-TEST-4 OF GRP-FOR-QUAL-FROM (WRK-DS-01V00) NC2084.2 +076600 TO QUAL-TEST-4 OF GRP-FOR-QUAL-TO (WRK-DS-01V00). NC2084.2 +076700 IF QUAL-TEST1 OF GRP-FOR-QUAL-TO EQUAL TO "02000" NC2084.2 +076800 PERFORM PASS NC2084.2 +076900 GO TO QAL-WRITE-F1-4. NC2084.2 +077000 GO TO QAL-FAIL-F1-4. NC2084.2 +077100 QAL-DELETE-F1-4. NC2084.2 +077200 PERFORM DE-LETE. NC2084.2 +077300 GO TO QAL-WRITE-F1-4. NC2084.2 +077400 QAL-FAIL-F1-4. NC2084.2 +077500 MOVE "02000" TO CORRECT-A. NC2084.2 +077600 MOVE QUAL-TEST1 OF GRP-FOR-QUAL-TO TO COMPUTED-A. NC2084.2 +077700 PERFORM FAIL. NC2084.2 +077800 QAL-WRITE-F1-4. NC2084.2 +077900 PERFORM PRINT-DETAIL. NC2084.2 +078000* NC2084.2 +078100 QAL-INIT-F1-5. NC2084.2 +078200 MOVE "QAL-TEST-F1-5 " TO PAR-NAME. NC2084.2 +078300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +078400 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +078500 QAL-TEST-F1-5. NC2084.2 +078600 MOVE QUAL-TEST-1-FROM IN GRP-FOR-QUAL-FROM TO NC2084.2 +078700 QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO. NC2084.2 +078800 IF QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO EQUAL TO NC2084.2 +078900 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" NC2084.2 +079000 PERFORM PASS NC2084.2 +079100 GO TO QAL-WRITE-F1-5. NC2084.2 +079200 GO TO QAL-FAIL-F1-5. NC2084.2 +079300 QAL-DELETE-F1-5. NC2084.2 +079400 PERFORM DE-LETE. NC2084.2 +079500 GO TO QAL-WRITE-F1-5. NC2084.2 +079600 QAL-FAIL-F1-5. NC2084.2 +079700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO SEND-BREAKDOWN. NC2084.2 +079800 MOVE QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO TO RECEIVE-BREAKDOWN. NC2084.2 +079900 PERFORM FAIL. NC2084.2 +080000 MOVE SEND-20 TO CORRECT-A. NC2084.2 +080100 MOVE RECEIVE-20 TO COMPUTED-A. NC2084.2 +080200 PERFORM QAL-WRITE-F1-5. NC2084.2 +080300 MOVE SPACES TO P-OR-F. NC2084.2 +080400 MOVE SEND-40 TO CORRECT-A. NC2084.2 +080500 MOVE RECEIVE-40 TO COMPUTED-A. NC2084.2 +080600 MOVE "2ND 20 POSITIONS OF ANSWERS" TO RE-MARK. NC2084.2 +080700 MOVE TEST-RESULTS TO PRINT-REC. NC2084.2 +080800 WRITE PRINT-REC. NC2084.2 +080900 QAL-WRITE-F1-5. NC2084.2 +081000 PERFORM PRINT-DETAIL. NC2084.2 +081100* NC2084.2 +081200 QAL-INIT-F1-6. NC2084.2 +081300 MOVE "QAL-TEST-F1-6 " TO PAR-NAME. NC2084.2 +081400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +081500 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +081600 QAL-TEST-F1-6. NC2084.2 +081700 MOVE 0000000000 TO QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO. NC2084.2 +081800 ADD QUAL-TEST-2-FROM IN GRP-FOR-QUAL-FROM TO NC2084.2 +081900 QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO. NC2084.2 +082000 IF QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO EQUAL TO 9999999999 NC2084.2 +082100 PERFORM PASS NC2084.2 +082200 GO TO QAL-WRITE-F1-6. NC2084.2 +082300 GO TO QAL-FAIL-F1-6. NC2084.2 +082400 QAL-DELETE-F1-6. NC2084.2 +082500 PERFORM DE-LETE. NC2084.2 +082600 GO TO QAL-WRITE-F1-6. NC2084.2 +082700 QAL-FAIL-F1-6. NC2084.2 +082800 MOVE 9999999999 TO CORRECT-18V0. NC2084.2 +082900 MOVE QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO TO COMPUTED-18V0. NC2084.2 +083000 PERFORM FAIL. NC2084.2 +083100 QAL-WRITE-F1-6. NC2084.2 +083200 PERFORM PRINT-DETAIL. NC2084.2 +083300* NC2084.2 +083400 QAL-INIT-F1-7. NC2084.2 +083500 MOVE "QAL-TEST-F1-7 " TO PAR-NAME. NC2084.2 +083600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +083700 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +083800 QAL-TEST-F1-7. NC2084.2 +083900 MULTIPLY QUAL-TEST-3-FROM IN GRP-FOR-QUAL-FROM BY NC2084.2 +084000 WRK-DS-01V00 GIVING QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO. NC2084.2 +084100 IF QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO EQUAL TO 004 NC2084.2 +084200 PERFORM PASS NC2084.2 +084300 GO TO QAL-WRITE-F1-7. NC2084.2 +084400 GO TO QAL-FAIL-F1-7. NC2084.2 +084500 QAL-DELETE-F1-7. NC2084.2 +084600 PERFORM DE-LETE. NC2084.2 +084700 GO TO QAL-WRITE-F1-7. NC2084.2 +084800 QAL-FAIL-F1-7. NC2084.2 +084900 MOVE 004 TO CORRECT-N. NC2084.2 +085000 MOVE QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO TO COMPUTED-N. NC2084.2 +085100 PERFORM FAIL. NC2084.2 +085200 QAL-WRITE-F1-7. NC2084.2 +085300 PERFORM PRINT-DETAIL. NC2084.2 +085400* NC2084.2 +085500 QAL-INIT-F1-8. NC2084.2 +085600 MOVE "QAL-TEST-F1-8 " TO PAR-NAME. NC2084.2 +085700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +085800 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +085900 QAL-TEST-F1-8. NC2084.2 +086000 MOVE QUAL-TEST-4-FROM IN GRP-FOR-QUAL-FROM (WRK-DS-01V00) NC2084.2 +086100 TO QUAL-TEST-4-TO IN GRP-FOR-QUAL-TO (WRK-DS-01V00). NC2084.2 +086200 IF QUAL-TEST2 IN GRP-FOR-QUAL-TO EQUAL TO "0700" NC2084.2 +086300 PERFORM PASS NC2084.2 +086400 GO TO QAL-WRITE-F1-8. NC2084.2 +086500 GO TO QAL-FAIL-F1-8. NC2084.2 +086600 QAL-DELETE-F1-8. NC2084.2 +086700 PERFORM DE-LETE. NC2084.2 +086800 GO TO QAL-WRITE-F1-8. NC2084.2 +086900 QAL-FAIL-F1-8. NC2084.2 +087000 MOVE "0700" TO CORRECT-A. NC2084.2 +087100 MOVE QUAL-TEST2 TO COMPUTED-A. NC2084.2 +087200 PERFORM FAIL. NC2084.2 +087300 QAL-WRITE-F1-8. NC2084.2 +087400 PERFORM PRINT-DETAIL. NC2084.2 +087500 PERFORM END-ROUTINE. NC2084.2 +087600* NC2084.2 +087700 MOVE-CORR-ROUTINE SECTION. NC2084.2 +087800 MOV-INIT-F1-1. NC2084.2 +087900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +088000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +088100 MOVE THREE TO XYZ-1 OF CORR-DATA-1. NC2084.2 +088200 MOVE FOUR TO XYZ-2 OF CORR-DATA-1. NC2084.2 +088300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2084.2 +088400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2084.2 +088500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2084.2 +088600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2084.2 +088700 MOV-INIT-F1-1-1. NC2084.2 +088800 MOVE "MOV-TEST-F1-1-1" TO PAR-NAME. NC2084.2 +088900 MOV-TEST-F1-1-1. NC2084.2 +089000 MOVE CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2084.2 +089100 IF XYZ-2 OF CORR-DATA-2 EQUAL TO 4 NC2084.2 +089200 PERFORM PASS ELSE NC2084.2 +089300 GO TO MOV-FAIL-F1-1-1. NC2084.2 +089400 GO TO MOV-WRITE-F1-1-1. NC2084.2 +089500 MOV-DELETE-F1-1-1. NC2084.2 +089600 PERFORM DE-LETE. NC2084.2 +089700 GO TO MOV-WRITE-F1-1-1. NC2084.2 +089800 MOV-FAIL-F1-1-1. NC2084.2 +089900 PERFORM FAIL. NC2084.2 +090000 MOVE XYZ-2 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +090100 MOVE 04 TO CORRECT-A. NC2084.2 +090200 MOV-WRITE-F1-1-1. NC2084.2 +090300 PERFORM PRINT-DETAIL. NC2084.2 +090400* NC2084.2 +090500 MOV-INIT-F1-1-2. NC2084.2 +090600 MOVE "MOV-TEST-F1-1-2" TO PAR-NAME. NC2084.2 +090700 MOV-TEST-F1-1-2. NC2084.2 +090800 IF XYZ-1 OF CORR-DATA-2 EQUAL TO THREE NC2084.2 +090900 PERFORM PASS ELSE NC2084.2 +091000 GO TO MOV-FAIL-F1-1-2. NC2084.2 +091100 GO TO MOV-WRITE-F1-1-2. NC2084.2 +091200 MOV-DELETE-F1-1-2. NC2084.2 +091300 PERFORM DE-LETE. NC2084.2 +091400 GO TO MOV-WRITE-F1-1-2. NC2084.2 +091500 MOV-FAIL-F1-1-2. NC2084.2 +091600 PERFORM FAIL. NC2084.2 +091700 MOVE XYZ-1 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +091800 MOVE THREE TO CORRECT-A. NC2084.2 +091900 MOV-WRITE-F1-1-2. NC2084.2 +092000 PERFORM PRINT-DETAIL. NC2084.2 +092100* NC2084.2 +092200 MOV-INIT-F1-1-3. NC2084.2 +092300 MOVE "MOV-TEST-F1-1-3" TO PAR-NAME. NC2084.2 +092400 MOV-TEST-F1-1-3. NC2084.2 +092500 IF XYZ-3 OF CORR-DATA-2 EQUAL TO TEN NC2084.2 +092600 PERFORM PASS ELSE NC2084.2 +092700 GO TO MOV-FAIL-F1-1-3. NC2084.2 +092800 GO TO MOV-WRITE-F1-1-3. NC2084.2 +092900 MOV-DELETE-F1-1-3. NC2084.2 +093000 PERFORM DE-LETE. NC2084.2 +093100 GO TO MOV-WRITE-F1-1-3. NC2084.2 +093200 MOV-FAIL-F1-1-3. NC2084.2 +093300 MOVE XYZ-3 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +093400 MOVE "10" TO CORRECT-A. NC2084.2 +093500 PERFORM FAIL. NC2084.2 +093600 MOV-WRITE-F1-1-3. NC2084.2 +093700 PERFORM PRINT-DETAIL. NC2084.2 +093800* NC2084.2 +093900 MOV-INIT-F1-1-4. NC2084.2 +094000 MOVE "MOV-TEST-F1-1-4" TO PAR-NAME. NC2084.2 +094100 MOV-TEST-F1-1-4. NC2084.2 +094200 IF XYZ-4 OF CORR-DATA-2 EQUAL TO XYZ-4 OF NC2084.2 +094300 CORR-DATA-1 NC2084.2 +094400 PERFORM PASS ELSE NC2084.2 +094500 GO TO MOV-FAIL-F1-1-4. NC2084.2 +094600 GO TO MOV-WRITE-F1-1-4. NC2084.2 +094700 MOV-DELETE-F1-1-4. NC2084.2 +094800 PERFORM DE-LETE. NC2084.2 +094900 GO TO MOV-WRITE-F1-1-4. NC2084.2 +095000 MOV-FAIL-F1-1-4. NC2084.2 +095100 PERFORM FAIL. NC2084.2 +095200 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +095300 MOVE XYZ-4 OF CORR-DATA-1 TO CORRECT-A. NC2084.2 +095400 MOV-WRITE-F1-1-4. NC2084.2 +095500 PERFORM PRINT-DETAIL. NC2084.2 +095600* NC2084.2 +095700 MOV-INIT-F1-1-5. NC2084.2 +095800 MOVE "MOV-TEST-F1-1-5" TO PAR-NAME. NC2084.2 +095900 MOV-TEST-F1-1-5. NC2084.2 +096000 IF XYZ-5 OF CORR-DATA-2 EQUAL TO 01 NC2084.2 +096100 PERFORM PASS ELSE NC2084.2 +096200 GO TO MOV-FAIL-F1-1-5. NC2084.2 +096300 GO TO MOV-WRITE-F1-1-5. NC2084.2 +096400 MOV-DELETE-F1-1-5. NC2084.2 +096500 PERFORM DE-LETE. NC2084.2 +096600 GO TO MOV-WRITE-F1-1-5. NC2084.2 +096700 MOV-FAIL-F1-1-5. NC2084.2 +096800 MOVE XYZ-5 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +096900 MOVE "01" TO CORRECT-A. NC2084.2 +097000 PERFORM FAIL. NC2084.2 +097100 MOV-WRITE-F1-1-5. NC2084.2 +097200 PERFORM PRINT-DETAIL. NC2084.2 +097300* NC2084.2 +097400 MOV-INIT-F1-2. NC2084.2 +097500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +097600 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +097700 MOVE THREE TO XYZ-1 OF CORR-DATA-1. NC2084.2 +097800 MOVE FOUR TO XYZ-2 OF CORR-DATA-1. NC2084.2 +097900 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2084.2 +098000 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2084.2 +098100 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2084.2 +098200 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2084.2 +098300 MOVE CORRESPONDING CORR-DATA-1 TO CORR-DATA-3. NC2084.2 +098400 MOV-INIT-F1-2-1. NC2084.2 +098500 MOVE "MOV-TEST-F1-2-1" TO PAR-NAME. NC2084.2 +098600 MOV-TEST-F1-2-1. NC2084.2 +098700 IF XYZ-1 OF CORR-DATA-3 EQUAL TO 03 NC2084.2 +098800 PERFORM PASS ELSE NC2084.2 +098900 GO TO MOV-FAIL-F1-2-1. NC2084.2 +099000 GO TO MOV-WRITE-F1-2-1. NC2084.2 +099100 MOV-DELETE-F1-2-1. NC2084.2 +099200 PERFORM DE-LETE. NC2084.2 +099300 GO TO MOV-WRITE-F1-2-1. NC2084.2 +099400 MOV-FAIL-F1-2-1. NC2084.2 +099500 PERFORM FAIL. NC2084.2 +099600 MOVE XYZ-1 OF CORR-DATA-3 TO COMPUTED-A. NC2084.2 +099700 MOVE "03" TO CORRECT-A. NC2084.2 +099800 MOV-WRITE-F1-2-1. NC2084.2 +099900 PERFORM PRINT-DETAIL. NC2084.2 +100000* NC2084.2 +100100 MOV-INIT-F1-2-2. NC2084.2 +100200 MOVE "MOV-TEST-F1-2-2" TO PAR-NAME. NC2084.2 +100300 MOV-TEST-F1-2-2. NC2084.2 +100400 IF XYZ-3 OF CORR-DATA-3 EQUAL TO 10 NC2084.2 +100500 PERFORM PASS ELSE NC2084.2 +100600 GO TO MOV-FAIL-F1-2-2. NC2084.2 +100700 GO TO MOV-WRITE-F1-2-2. NC2084.2 +100800 MOV-DELETE-F1-2-2. NC2084.2 +100900 PERFORM DE-LETE. NC2084.2 +101000 GO TO MOV-WRITE-F1-2-2. NC2084.2 +101100 MOV-FAIL-F1-2-2. NC2084.2 +101200 PERFORM FAIL. NC2084.2 +101300 MOVE XYZ-3 OF CORR-DATA-3 TO COMPUTED-A. NC2084.2 +101400 MOVE "10" TO CORRECT-A. NC2084.2 +101500 MOV-WRITE-F1-2-2. NC2084.2 +101600 PERFORM PRINT-DETAIL. NC2084.2 +101700* NC2084.2 +101800 MOV-INIT-F1-3. NC2084.2 +101900 MOVE "MOV-TEST-F1-3" TO PAR-NAME. NC2084.2 +102000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +102100 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +102200 MOVE ZERO TO CORR-DATA-5. NC2084.2 +102300 MOVE 123456789012 TO CORR-DATA-3. NC2084.2 +102400 MOVE CORRESPONDING CORR-DATA-3 TO CORR-DATA-5. NC2084.2 +102500 MOV-TEST-F1-3. NC2084.2 +102600 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 12 NEXT NC2084.2 +102700 SENTENCE ELSE NC2084.2 +102800 GO TO MOV-FAIL-F1-3. NC2084.2 +102900 IF XYZ-2 OF CORR-DATA-5 EQUAL TO 90 NEXT NC2084.2 +103000 SENTENCE ELSE NC2084.2 +103100 GO TO MOV-FAIL-F1-3. NC2084.2 +103200 IF XYZ-13 OF CORR-DATA-5 EQUAL TO 0 NC2084.2 +103300 PERFORM PASS ELSE NC2084.2 +103400 GO TO MOV-FAIL-F1-3. NC2084.2 +103500 GO TO MOV-WRITE-F1-3. NC2084.2 +103600 MOV-DELETE-F1-3. NC2084.2 +103700 PERFORM DE-LETE. NC2084.2 +103800 GO TO MOV-WRITE-F1-3. NC2084.2 +103900 MOV-FAIL-F1-3. NC2084.2 +104000 MOVE CORR-DATA-5 TO COMPUTED-A. NC2084.2 +104100 MOVE "9012000000000000" TO CORRECT-A. NC2084.2 +104200 PERFORM FAIL. NC2084.2 +104300 MOV-WRITE-F1-3. NC2084.2 +104400 PERFORM PRINT-DETAIL. NC2084.2 +104500* NC2084.2 +104600 MOV-INIT-F1-4. NC2084.2 +104700 MOVE "MOV-TEST-F1-4 " TO PAR-NAME. NC2084.2 +104800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +104900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +105000 MOVE SPACE TO GRP-MOVE-CORR-R. NC2084.2 +105100 MOVE CORRESPONDING GRP-MOVE-CORR-1 TO GRP-MOVE-CORR-R. NC2084.2 +105200 MOV-TEST-F1-4. NC2084.2 +105300 IF GRP-MOVE-CORR-R EQUAL TO " 111222333XYZ " NC2084.2 +105400 PERFORM PASS GO TO MOV-WRITE-F1-4. NC2084.2 +105500 GO TO MOVE-FAIL-F1-4. NC2084.2 +105600 MOV-DELETE-F1-4. NC2084.2 +105700 PERFORM DE-LETE. NC2084.2 +105800 GO TO MOV-WRITE-F1-4. NC2084.2 +105900 MOVE-FAIL-F1-4. NC2084.2 +106000 MOVE GRP-MOVE-CORR-R TO COMPUTED-A. NC2084.2 +106100 MOVE " 111222333XYZ " TO CORRECT-A. NC2084.2 +106200 PERFORM FAIL. NC2084.2 +106300 MOV-WRITE-F1-4. NC2084.2 +106400 PERFORM PRINT-DETAIL. NC2084.2 +106500* NC2084.2 +106600 MOV-INIT-F1-5. NC2084.2 +106700 MOVE "MOV-TEST-F1-5" TO PAR-NAME. NC2084.2 +106800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +106900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +107000 MOVE SPACE TO GRP-TO-MOVE-CORR-TO. NC2084.2 +107100 MOVE CORRESPONDING GRP-TO-MOVE-CORR-1 TO NC2084.2 +107200 GRP-TO-MOVE-CORR-TO. NC2084.2 +107300 MOV-TEST-F1-5. NC2084.2 +107400 IF GRP-TO-MOVE-CORR-TO EQUAL TO "111 123ABC45" NC2084.2 +107500 PERFORM PASS GO TO MOV-WRITE-F1-5. NC2084.2 +107600 GO TO MOVE-FAIL-F1-5. NC2084.2 +107700 MOV-DELETE-F1-5. NC2084.2 +107800 PERFORM DE-LETE. NC2084.2 +107900 GO TO MOV-WRITE-F1-5. NC2084.2 +108000 MOVE-FAIL-F1-5. NC2084.2 +108100 MOVE GRP-TO-MOVE-CORR-TO TO COMPUTED-A. NC2084.2 +108200 MOVE "111 123ABC45" TO CORRECT-A. NC2084.2 +108300 PERFORM FAIL. NC2084.2 +108400 MOV-WRITE-F1-5. NC2084.2 +108500 PERFORM PRINT-DETAIL. NC2084.2 +108600* NC2084.2 +108700 MOV-INIT-F1-6. NC2084.2 +108800 MOVE "MOV-TEST-F1-6" TO PAR-NAME. NC2084.2 +108900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +109000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +109100 MOVE CORRESPONDING MOVE54 TO MOVE60. NC2084.2 +109200 MOV-TEST-F1-6. NC2084.2 +109300 IF MOVE60 EQUAL TO "XYA" NC2084.2 +109400 PERFORM PASS NC2084.2 +109500 GO TO MOV-WRITE-F1-6. NC2084.2 +109600 GO TO MOV-FAIL-F1-6. NC2084.2 +109700 MOV-DELETE-F1-6. NC2084.2 +109800 PERFORM DE-LETE. NC2084.2 +109900 GO TO MOV-WRITE-F1-6. NC2084.2 +110000 MOV-FAIL-F1-6. NC2084.2 +110100 MOVE MOVE60 TO COMPUTED-A NC2084.2 +110200 MOVE "XYA" TO CORRECT-A NC2084.2 +110300 PERFORM FAIL. NC2084.2 +110400 MOV-WRITE-F1-6. NC2084.2 +110500 PERFORM PRINT-DETAIL. NC2084.2 +110600* NC2084.2 +110700 MOV-INIT-F1-7. NC2084.2 +110800 MOVE "MOV-TEST-F1-7" TO PAR-NAME. NC2084.2 +110900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +111000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +111100 MOVE "*" TO MOVE56 OF MOVE60 MOVE58 OF MOVE60 MOVE65. NC2084.2 +111200 MOV-TEST-F1-7. NC2084.2 +111300 IF MOVE60 EQUAL TO "***" NC2084.2 +111400 PERFORM PASS NC2084.2 +111500 GO TO MOV-WRITE-F1-7. NC2084.2 +111600 GO TO MOV-FAIL-F1-7. NC2084.2 +111700 MOV-DELETE-F1-7. NC2084.2 +111800 PERFORM DE-LETE. NC2084.2 +111900 GO TO MOV-WRITE-F1-7. NC2084.2 +112000 MOV-FAIL-F1-7. NC2084.2 +112100 MOVE MOVE60 TO COMPUTED-A NC2084.2 +112200 MOVE "***" TO CORRECT-A NC2084.2 +112300 PERFORM FAIL. NC2084.2 +112400 MOV-WRITE-F1-7. NC2084.2 +112500 PERFORM PRINT-DETAIL. NC2084.2 +112600 PERFORM END-ROUTINE. NC2084.2 +112700 NUMERIC-OPERAND-LIMITS-TESTS SECTION. NC2084.2 +112800 CCVS-EXIT SECTION. NC2084.2 +112900 CCVS-999999. NC2084.2 +113000 GO TO CLOSE-FILES. NC2084.2 +*END-OF,NC208A +*HEADER,COBOL,NC209A +000100 IDENTIFICATION DIVISION. NC2094.2 +000200 PROGRAM-ID. NC2094.2 +000300 NC209A. NC2094.2 +000400* * NC2094.2 +000500**************************************************************** NC2094.2 +000600* * NC2094.2 +000700* VALIDATION FOR:- * NC2094.2 +000800* * NC2094.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +001000* * NC2094.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2094.2 +001200* * NC2094.2 +001300**************************************************************** NC2094.2 +001400* * NC2094.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2094.2 +001600* * NC2094.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2094.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2094.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2094.2 +002000* * NC2094.2 +002100**************************************************************** NC2094.2 +002200* PROGRAM NC209A TESTS FORMAT 2 OF THE "MOVE" STATEMENT, * NC2094.2 +002300* USING QUALIFIED AND SUBSCRIPTED IDENTIFIERS. * NC2094.2 +002400* * NC2094.2 +002500**************************************************************** NC2094.2 +002600 ENVIRONMENT DIVISION. NC2094.2 +002700 CONFIGURATION SECTION. NC2094.2 +002800 SOURCE-COMPUTER. NC2094.2 +002900 XXXXX082. NC2094.2 +003000 OBJECT-COMPUTER. NC2094.2 +003100 XXXXX083. NC2094.2 +003200 INPUT-OUTPUT SECTION. NC2094.2 +003300 FILE-CONTROL. NC2094.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2094.2 +003500 XXXXX055. NC2094.2 +003600 DATA DIVISION. NC2094.2 +003700 FILE SECTION. NC2094.2 +003800 FD PRINT-FILE. NC2094.2 +003900 01 PRINT-REC PICTURE X(120). NC2094.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2094.2 +004100 WORKING-STORAGE SECTION. NC2094.2 +004200 01 A-LEVEL. NC2094.2 +004300 02 B-LEVEL. NC2094.2 +004400 03 C-LEVEL. NC2094.2 +004500 04 D-LEVEL. NC2094.2 +004600 05 TOM PICTURE XXX VALUE "TOM". NC2094.2 +004700 05 DICK PICTURE XXXX VALUE "DICK". NC2094.2 +004800 04 DD-LEVEL. NC2094.2 +004900 05 HARRY PICTURE X(5) VALUE "HARRY". NC2094.2 +005000 04 DDD-LEVEL. NC2094.2 +005100 05 JOE PICTURE XXX VALUE "JOE". NC2094.2 +005200 02 AL PICTURE XX VALUE "AL". NC2094.2 +005300 02 BB-LEVEL. NC2094.2 +005400 04 BOB PICTURE XXX VALUE "BOB". NC2094.2 +005500 01 A-GROUP. NC2094.2 +005600 02 B-GROUP. NC2094.2 +005700 10 C-LEVEL. NC2094.2 +005800 12 D-LEVEL. NC2094.2 +005900 13 TOM PICTURE XXX VALUE "ZZZ". NC2094.2 +006000 13 DICK PICTURE XXXX VALUE "ZZZZ". NC2094.2 +006100 12 DD-LEVEL-FALSE. NC2094.2 +006200 13 HARRY PICTURE X(5) VALUE "ZZZZZ". NC2094.2 +006300 12 DDD-LEVEL. NC2094.2 +006400 13 JOE PICTURE XXX VALUE "ZZZ". NC2094.2 +006500 01 A-BUNCH. NC2094.2 +006600 49 TOM PICTURE XXX VALUE "YYY". NC2094.2 +006700 49 DICK PICTURE XXXX VALUE "YYYY". NC2094.2 +006800 49 HARRY PICTURE X(5) VALUE "YYYYY". NC2094.2 +006900 49 JOE PICTURE XXX VALUE "YYY". NC2094.2 +007000 49 AL PICTURE XX VALUE "YY". NC2094.2 +007100 49 BOB PICTURE XXX VALUE "YYY". NC2094.2 +007200 01 A-SET. NC2094.2 +007300 02 B-SET. NC2094.2 +007400 04 D-LEVEL. NC2094.2 +007500 05 TOM PICTURE XXX VALUE "WWW". NC2094.2 +007600 05 DICK PICTURE XXXX VALUE "WWWW". NC2094.2 +007700 04 HARRY PICTURE X(5) VALUE "WWWWW". NC2094.2 +007800 04 BOB PICTURE XXX VALUE "WWW". NC2094.2 +007900 01 C-STACK. NC2094.2 +008000 04 D-LEVEL. NC2094.2 +008100 05 TOM PICTURE XXX VALUE "VVV". NC2094.2 +008200 04 DD-LEVEL. NC2094.2 +008300 05 DICK PICTURE XXXX VALUE "VVVV". NC2094.2 +008400 05 HARRY PICTURE X(5) VALUE "VVVVV". NC2094.2 +008500 01 A-GLOB. NC2094.2 +008600 02 B-LEVEL. NC2094.2 +008700 03 C-LEVEL. NC2094.2 +008800 04 D-LEVEL. NC2094.2 +008900 05 TOM PICTURE XXX VALUE "UUU". NC2094.2 +009000 05 DICK PICTURE XXXX VALUE "UUUU". NC2094.2 +009100 04 DD-LEVEL. NC2094.2 +009200 05 HARRY-A PICTURE XX VALUE "UU". NC2094.2 +009300 05 HARRY-B PICTURE XXX VALUE "UUU". NC2094.2 +009400 04 DDD-LEVEL. NC2094.2 +009500 05 JOE PICTURE XXX VALUE "UUU". NC2094.2 +009600 02 AL PICTURE XX VALUE "UU". NC2094.2 +009700 02 BB-LEVEL-FALSE. NC2094.2 +009800 04 BOB PICTURE XXX VALUE "UUU". NC2094.2 +009900 66 AL-BOB RENAMES AL OF A-GLOB THRU BOB OF A-GLOB. NC2094.2 +010000 66 HARRY RENAMES HARRY-A THRU HARRY-B. NC2094.2 +010100 01 A-COLLECTION. NC2094.2 +010200 02 B-COLLECTION. NC2094.2 +010300 03 C-COLLECTION. NC2094.2 +010400 04 D-LEVEL. NC2094.2 +010500 05 TOM OCCURS 3 TIMES PICTURE X. NC2094.2 +010600 05 DICK. NC2094.2 +010700 06 RICHARD OCCURS 2 PICTURE XX. NC2094.2 +010800 04 DD-LEVEL-FALSE PICTURE 9(5). NC2094.2 +010900 04 DD-LEVEL REDEFINES DD-LEVEL-FALSE. NC2094.2 +011000 05 HARRY PICTURE X(5). NC2094.2 +011100 04 DDD-LEVEL. NC2094.2 +011200 05 JOE PICTURE XXX. NC2094.2 +011300 05 JOSEPH REDEFINES JOE PICTURE 999. NC2094.2 +011400 01 WORK-AREA. NC2094.2 +011500 02 WORK-TOM PICTURE XXX. NC2094.2 +011600 02 FILLER PICTURE XXXX. NC2094.2 +011700 01 A-COVEY. NC2094.2 +011800 02 FILLER PICTURE X(45). NC2094.2 +011900 02 B-COVEY. NC2094.2 +012000 03 TOMMY PICTURE XXX VALUE "SSS". NC2094.2 +012100 03 DICKY PICTURE XXXX VALUE "SSSS". NC2094.2 +012200 03 JOEY PICTURE XXX VALUE "SSS". NC2094.2 +012300 03 HAROLD PICTURE X(5) VALUE "SSSSS". NC2094.2 +012400 01 A-FLOCK REDEFINES A-COVEY. NC2094.2 +012500 02 B-FLOCK OCCURS 4 TIMES. NC2094.2 +012600 03 C-FLOCK. NC2094.2 +012700 04 D-LEVEL. NC2094.2 +012800 05 TOM PICTURE XXX. NC2094.2 +012900 05 DICK PICTURE XXXX. NC2094.2 +013000 04 DDD-LEVEL. NC2094.2 +013100 05 JOE PICTURE XXX. NC2094.2 +013200 04 DD-LEVEL. NC2094.2 +013300 05 HARRY PICTURE X(5). NC2094.2 +013400 01 A-CROWD. NC2094.2 +013500 02 BB-CROWD. NC2094.2 +013600 03 BOBBY PICTURE XXX VALUE "RRR". NC2094.2 +013700 03 FILLER PICTURE X(15). NC2094.2 +013800 02 BB-MOB REDEFINES BB-CROWD OCCURS 6 TIMES. NC2094.2 +013900 03 BOB PICTURE XXX. NC2094.2 +014000 01 TEST-RESULTS. NC2094.2 +014100 02 FILLER PIC X VALUE SPACE. NC2094.2 +014200 02 FEATURE PIC X(20) VALUE SPACE. NC2094.2 +014300 02 FILLER PIC X VALUE SPACE. NC2094.2 +014400 02 P-OR-F PIC X(5) VALUE SPACE. NC2094.2 +014500 02 FILLER PIC X VALUE SPACE. NC2094.2 +014600 02 PAR-NAME. NC2094.2 +014700 03 FILLER PIC X(19) VALUE SPACE. NC2094.2 +014800 03 PARDOT-X PIC X VALUE SPACE. NC2094.2 +014900 03 DOTVALUE PIC 99 VALUE ZERO. NC2094.2 +015000 02 FILLER PIC X(8) VALUE SPACE. NC2094.2 +015100 02 RE-MARK PIC X(61). NC2094.2 +015200 01 TEST-COMPUTED. NC2094.2 +015300 02 FILLER PIC X(30) VALUE SPACE. NC2094.2 +015400 02 FILLER PIC X(17) VALUE NC2094.2 +015500 " COMPUTED=". NC2094.2 +015600 02 COMPUTED-X. NC2094.2 +015700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2094.2 +015800 03 COMPUTED-N REDEFINES COMPUTED-A NC2094.2 +015900 PIC -9(9).9(9). NC2094.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2094.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2094.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2094.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. NC2094.2 +016400 04 COMPUTED-18V0 PIC -9(18). NC2094.2 +016500 04 FILLER PIC X. NC2094.2 +016600 03 FILLER PIC X(50) VALUE SPACE. NC2094.2 +016700 01 TEST-CORRECT. NC2094.2 +016800 02 FILLER PIC X(30) VALUE SPACE. NC2094.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2094.2 +017000 02 CORRECT-X. NC2094.2 +017100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2094.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2094.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2094.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2094.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2094.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. NC2094.2 +017700 04 CORRECT-18V0 PIC -9(18). NC2094.2 +017800 04 FILLER PIC X. NC2094.2 +017900 03 FILLER PIC X(2) VALUE SPACE. NC2094.2 +018000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2094.2 +018100 01 CCVS-C-1. NC2094.2 +018200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2094.2 +018300- "SS PARAGRAPH-NAME NC2094.2 +018400- " REMARKS". NC2094.2 +018500 02 FILLER PIC X(20) VALUE SPACE. NC2094.2 +018600 01 CCVS-C-2. NC2094.2 +018700 02 FILLER PIC X VALUE SPACE. NC2094.2 +018800 02 FILLER PIC X(6) VALUE "TESTED". NC2094.2 +018900 02 FILLER PIC X(15) VALUE SPACE. NC2094.2 +019000 02 FILLER PIC X(4) VALUE "FAIL". NC2094.2 +019100 02 FILLER PIC X(94) VALUE SPACE. NC2094.2 +019200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2094.2 +019300 01 REC-CT PIC 99 VALUE ZERO. NC2094.2 +019400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2094.2 +019900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2094.2 +020000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2094.2 +020100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2094.2 +020200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2094.2 +020300 01 CCVS-H-1. NC2094.2 +020400 02 FILLER PIC X(39) VALUE SPACES. NC2094.2 +020500 02 FILLER PIC X(42) VALUE NC2094.2 +020600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2094.2 +020700 02 FILLER PIC X(39) VALUE SPACES. NC2094.2 +020800 01 CCVS-H-2A. NC2094.2 +020900 02 FILLER PIC X(40) VALUE SPACE. NC2094.2 +021000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2094.2 +021100 02 FILLER PIC XXXX VALUE NC2094.2 +021200 "4.2 ". NC2094.2 +021300 02 FILLER PIC X(28) VALUE NC2094.2 +021400 " COPY - NOT FOR DISTRIBUTION". NC2094.2 +021500 02 FILLER PIC X(41) VALUE SPACE. NC2094.2 +021600 NC2094.2 +021700 01 CCVS-H-2B. NC2094.2 +021800 02 FILLER PIC X(15) VALUE NC2094.2 +021900 "TEST RESULT OF ". NC2094.2 +022000 02 TEST-ID PIC X(9). NC2094.2 +022100 02 FILLER PIC X(4) VALUE NC2094.2 +022200 " IN ". NC2094.2 +022300 02 FILLER PIC X(12) VALUE NC2094.2 +022400 " HIGH ". NC2094.2 +022500 02 FILLER PIC X(22) VALUE NC2094.2 +022600 " LEVEL VALIDATION FOR ". NC2094.2 +022700 02 FILLER PIC X(58) VALUE NC2094.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +022900 01 CCVS-H-3. NC2094.2 +023000 02 FILLER PIC X(34) VALUE NC2094.2 +023100 " FOR OFFICIAL USE ONLY ". NC2094.2 +023200 02 FILLER PIC X(58) VALUE NC2094.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2094.2 +023400 02 FILLER PIC X(28) VALUE NC2094.2 +023500 " COPYRIGHT 1985 ". NC2094.2 +023600 01 CCVS-E-1. NC2094.2 +023700 02 FILLER PIC X(52) VALUE SPACE. NC2094.2 +023800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2094.2 +023900 02 ID-AGAIN PIC X(9). NC2094.2 +024000 02 FILLER PIC X(45) VALUE SPACES. NC2094.2 +024100 01 CCVS-E-2. NC2094.2 +024200 02 FILLER PIC X(31) VALUE SPACE. NC2094.2 +024300 02 FILLER PIC X(21) VALUE SPACE. NC2094.2 +024400 02 CCVS-E-2-2. NC2094.2 +024500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2094.2 +024600 03 FILLER PIC X VALUE SPACE. NC2094.2 +024700 03 ENDER-DESC PIC X(44) VALUE NC2094.2 +024800 "ERRORS ENCOUNTERED". NC2094.2 +024900 01 CCVS-E-3. NC2094.2 +025000 02 FILLER PIC X(22) VALUE NC2094.2 +025100 " FOR OFFICIAL USE ONLY". NC2094.2 +025200 02 FILLER PIC X(12) VALUE SPACE. NC2094.2 +025300 02 FILLER PIC X(58) VALUE NC2094.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +025500 02 FILLER PIC X(13) VALUE SPACE. NC2094.2 +025600 02 FILLER PIC X(15) VALUE NC2094.2 +025700 " COPYRIGHT 1985". NC2094.2 +025800 01 CCVS-E-4. NC2094.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2094.2 +026000 02 FILLER PIC X(4) VALUE " OF ". NC2094.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2094.2 +026200 02 FILLER PIC X(40) VALUE NC2094.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2094.2 +026400 01 XXINFO. NC2094.2 +026500 02 FILLER PIC X(19) VALUE NC2094.2 +026600 "*** INFORMATION ***". NC2094.2 +026700 02 INFO-TEXT. NC2094.2 +026800 04 FILLER PIC X(8) VALUE SPACE. NC2094.2 +026900 04 XXCOMPUTED PIC X(20). NC2094.2 +027000 04 FILLER PIC X(5) VALUE SPACE. NC2094.2 +027100 04 XXCORRECT PIC X(20). NC2094.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). NC2094.2 +027300 01 HYPHEN-LINE. NC2094.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. NC2094.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************NC2094.2 +027600- "*****************************************". NC2094.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************NC2094.2 +027800- "******************************". NC2094.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE NC2094.2 +028000 "NC209A". NC2094.2 +028100 PROCEDURE DIVISION. NC2094.2 +028200 CCVS1 SECTION. NC2094.2 +028300 OPEN-FILES. NC2094.2 +028400 OPEN OUTPUT PRINT-FILE. NC2094.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2094.2 +028600 MOVE SPACE TO TEST-RESULTS. NC2094.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2094.2 +028800 GO TO CCVS1-EXIT. NC2094.2 +028900 CLOSE-FILES. NC2094.2 +029000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2094.2 +029100 TERMINATE-CCVS. NC2094.2 +029200S EXIT PROGRAM. NC2094.2 +029300STERMINATE-CALL. NC2094.2 +029400 STOP RUN. NC2094.2 +029500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2094.2 +029600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2094.2 +029700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2094.2 +029800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2094.2 +029900 MOVE "****TEST DELETED****" TO RE-MARK. NC2094.2 +030000 PRINT-DETAIL. NC2094.2 +030100 IF REC-CT NOT EQUAL TO ZERO NC2094.2 +030200 MOVE "." TO PARDOT-X NC2094.2 +030300 MOVE REC-CT TO DOTVALUE. NC2094.2 +030400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2094.2 +030500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2094.2 +030600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2094.2 +030700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2094.2 +030800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2094.2 +030900 MOVE SPACE TO CORRECT-X. NC2094.2 +031000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2094.2 +031100 MOVE SPACE TO RE-MARK. NC2094.2 +031200 HEAD-ROUTINE. NC2094.2 +031300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +031400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +031500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2094.2 +031600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2094.2 +031700 COLUMN-NAMES-ROUTINE. NC2094.2 +031800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +031900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +032100 END-ROUTINE. NC2094.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2094.2 +032300 END-RTN-EXIT. NC2094.2 +032400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +032500 END-ROUTINE-1. NC2094.2 +032600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2094.2 +032700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2094.2 +032800 ADD PASS-COUNTER TO ERROR-HOLD. NC2094.2 +032900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2094.2 +033000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2094.2 +033100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2094.2 +033200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2094.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2094.2 +033400 END-ROUTINE-12. NC2094.2 +033500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2094.2 +033600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2094.2 +033700 MOVE "NO " TO ERROR-TOTAL NC2094.2 +033800 ELSE NC2094.2 +033900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2094.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2094.2 +034100 PERFORM WRITE-LINE. NC2094.2 +034200 END-ROUTINE-13. NC2094.2 +034300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2094.2 +034400 MOVE "NO " TO ERROR-TOTAL ELSE NC2094.2 +034500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2094.2 +034600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2094.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +034800 IF INSPECT-COUNTER EQUAL TO ZERO NC2094.2 +034900 MOVE "NO " TO ERROR-TOTAL NC2094.2 +035000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2094.2 +035100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2094.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +035300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +035400 WRITE-LINE. NC2094.2 +035500 ADD 1 TO RECORD-COUNT. NC2094.2 +035600Y IF RECORD-COUNT GREATER 50 NC2094.2 +035700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2094.2 +035800Y MOVE SPACE TO DUMMY-RECORD NC2094.2 +035900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2094.2 +036000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2094.2 +036100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2094.2 +036200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2094.2 +036300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2094.2 +036400Y MOVE ZERO TO RECORD-COUNT. NC2094.2 +036500 PERFORM WRT-LN. NC2094.2 +036600 WRT-LN. NC2094.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2094.2 +036800 MOVE SPACE TO DUMMY-RECORD. NC2094.2 +036900 BLANK-LINE-PRINT. NC2094.2 +037000 PERFORM WRT-LN. NC2094.2 +037100 FAIL-ROUTINE. NC2094.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2094.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2094.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2094.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2094.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2094.2 +037800 GO TO FAIL-ROUTINE-EX. NC2094.2 +037900 FAIL-ROUTINE-WRITE. NC2094.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2094.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2094.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2094.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2094.2 +038400 FAIL-ROUTINE-EX. EXIT. NC2094.2 +038500 BAIL-OUT. NC2094.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2094.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2094.2 +038800 BAIL-OUT-WRITE. NC2094.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2094.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2094.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2094.2 +039300 BAIL-OUT-EX. EXIT. NC2094.2 +039400 CCVS1-EXIT. NC2094.2 +039500 EXIT. NC2094.2 +039600 SECT-NC209A-001 SECTION. NC2094.2 +039700 NC-209A-001. NC2094.2 +039800 MOV-INIT-F2-1. NC2094.2 +039900 MOVE "MOV-TEST-F2-1" TO PAR-NAME. NC2094.2 +040000 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +040100 MOVE "MOVE CORRESPONDING -" TO FEATURE. NC2094.2 +040200 PERFORM PRINT-DETAIL. NC2094.2 +040300 MOVE " DIFFERENT LEVELS " TO FEATURE. NC2094.2 +040400 MOVE CORRESPONDING B-LEVEL OF A-LEVEL TO B-GROUP. NC2094.2 +040500 MOVE 1 TO REC-CT. NC2094.2 +040600* TOM DICK AND JOE SHOULD BE MOVED. NC2094.2 +040700* NC2094.2 +040800 MOV-TEST-F2-1-1. NC2094.2 +040900 IF TOM OF A-GROUP EQUAL TO "TOM" NC2094.2 +041000 PERFORM PASS NC2094.2 +041100 GO TO MOV-WRITE-F2-1-1. NC2094.2 +041200 GO TO MOV-FAIL-F2-1-1. NC2094.2 +041300 MOV-DELETE-F2-1-1. NC2094.2 +041400 PERFORM DE-LETE. NC2094.2 +041500 GO TO MOV-WRITE-F2-1-1. NC2094.2 +041600 MOV-FAIL-F2-1-1. NC2094.2 +041700 PERFORM FAIL. NC2094.2 +041800 MOVE TOM OF A-GROUP TO COMPUTED-A. NC2094.2 +041900 MOVE "TOM" TO CORRECT-A. NC2094.2 +042000 MOV-WRITE-F2-1-1. NC2094.2 +042100 PERFORM PRINT-DETAIL. NC2094.2 +042200* NC2094.2 +042300 MOV-TEST-F2-1-2. NC2094.2 +042400 ADD 1 TO REC-CT. NC2094.2 +042500 IF DICK OF A-GROUP EQUAL TO "DICK" NC2094.2 +042600 PERFORM PASS NC2094.2 +042700 GO TO MOV-WRITE-F2-1-2. NC2094.2 +042800 GO TO MOV-FAIL-F2-1-2. NC2094.2 +042900 MOV-DELETE-F2-1-2. NC2094.2 +043000 PERFORM DE-LETE. NC2094.2 +043100 GO TO MOV-WRITE-F2-1-2. NC2094.2 +043200 MOV-FAIL-F2-1-2. NC2094.2 +043300 PERFORM FAIL. NC2094.2 +043400 MOVE DICK OF A-GROUP TO COMPUTED-A. NC2094.2 +043500 MOVE "DICK" TO CORRECT-A. NC2094.2 +043600 MOV-WRITE-F2-1-2. NC2094.2 +043700 PERFORM PRINT-DETAIL. NC2094.2 +043800* NC2094.2 +043900 MOV-TEST-F2-1-3. NC2094.2 +044000 ADD 1 TO REC-CT. NC2094.2 +044100 IF HARRY OF A-GROUP EQUAL TO "ZZZZZ" NC2094.2 +044200 PERFORM PASS NC2094.2 +044300 GO TO MOV-WRITE-F2-1-3. NC2094.2 +044400 GO TO MOV-FAIL-F2-1-3. NC2094.2 +044500 MOV-DELETE-F2-1-3. NC2094.2 +044600 PERFORM DE-LETE. NC2094.2 +044700 GO TO MOV-WRITE-F2-1-3. NC2094.2 +044800 MOV-FAIL-F2-1-3. NC2094.2 +044900 PERFORM FAIL. NC2094.2 +045000 MOVE HARRY OF A-GROUP TO COMPUTED-A. NC2094.2 +045100 MOVE "ZZZZZ" TO CORRECT-A. NC2094.2 +045200 MOV-WRITE-F2-1-3. NC2094.2 +045300 PERFORM PRINT-DETAIL. NC2094.2 +045400* NC2094.2 +045500 MOV-TEST-F2-1-4. NC2094.2 +045600 ADD 1 TO REC-CT. NC2094.2 +045700 IF JOE OF A-GROUP EQUAL TO "JOE" NC2094.2 +045800 PERFORM PASS NC2094.2 +045900 GO TO MOV-WRITE-F2-1-4. NC2094.2 +046000 GO TO MOV-FAIL-F2-1-4. NC2094.2 +046100 MOV-DELETE-F2-1-4. NC2094.2 +046200 PERFORM DE-LETE. NC2094.2 +046300 GO TO MOV-WRITE-F2-1-4. NC2094.2 +046400 MOV-FAIL-F2-1-4. NC2094.2 +046500 PERFORM FAIL. NC2094.2 +046600 MOVE JOE OF A-GROUP TO COMPUTED-A. NC2094.2 +046700 MOVE "JOE" TO CORRECT-A. NC2094.2 +046800 MOV-WRITE-F2-1-4. NC2094.2 +046900 PERFORM PRINT-DETAIL. NC2094.2 +047000* NC2094.2 +047100 MOV-INIT-F2-2. NC2094.2 +047200 MOVE "MOV-TEST-F2-2" TO PAR-NAME. NC2094.2 +047300 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +047400 MOVE CORRESPONDING A-LEVEL TO A-BUNCH. NC2094.2 +047500 MOVE 1 TO REC-CT. NC2094.2 +047600* NOTE AL SHOULD BE MOVED. NC2094.2 +047700 MOV-TEST-F2-2-1. NC2094.2 +047800 IF TOM OF A-BUNCH EQUAL TO "YYY" NC2094.2 +047900 PERFORM PASS NC2094.2 +048000 GO TO MOV-WRITE-F2-2-1. NC2094.2 +048100 GO TO MOV-FAIL-F2-2-1. NC2094.2 +048200 MOV-DELETE-F2-2-1. NC2094.2 +048300 PERFORM DE-LETE. NC2094.2 +048400 GO TO MOV-WRITE-F2-2-1. NC2094.2 +048500 MOV-FAIL-F2-2-1. NC2094.2 +048600 PERFORM FAIL. NC2094.2 +048700 MOVE TOM OF A-BUNCH TO COMPUTED-A. NC2094.2 +048800 MOVE "YYY" TO CORRECT-A. NC2094.2 +048900 MOV-WRITE-F2-2-1. NC2094.2 +049000 PERFORM PRINT-DETAIL. NC2094.2 +049100* NC2094.2 +049200 MOV-TEST-F2-2-2. NC2094.2 +049300 ADD 1 TO REC-CT. NC2094.2 +049400 IF DICK OF A-BUNCH EQUAL TO "YYYY" NC2094.2 +049500 PERFORM PASS NC2094.2 +049600 GO TO MOV-WRITE-F2-2-2. NC2094.2 +049700 GO TO MOV-FAIL-F2-2-2. NC2094.2 +049800 MOV-DELETE-F2-2-2. NC2094.2 +049900 PERFORM DE-LETE. NC2094.2 +050000 GO TO MOV-WRITE-F2-2-2. NC2094.2 +050100 MOV-FAIL-F2-2-2. NC2094.2 +050200 PERFORM FAIL. NC2094.2 +050300 MOVE DICK OF A-BUNCH TO COMPUTED-A. NC2094.2 +050400 MOVE "YYYY" TO CORRECT-A. NC2094.2 +050500 MOV-WRITE-F2-2-2. NC2094.2 +050600 PERFORM PRINT-DETAIL. NC2094.2 +050700* NC2094.2 +050800 MOV-TEST-F2-2-3. NC2094.2 +050900 ADD 1 TO REC-CT. NC2094.2 +051000 IF HARRY OF A-BUNCH EQUAL TO "YYYYY" NC2094.2 +051100 PERFORM PASS NC2094.2 +051200 GO TO MOV-WRITE-F2-2-3. NC2094.2 +051300 GO TO MOV-FAIL-F2-2-3. NC2094.2 +051400 MOV-DELETE-F2-2-3. NC2094.2 +051500 PERFORM DE-LETE. NC2094.2 +051600 GO TO MOV-WRITE-F2-2-3. NC2094.2 +051700 MOV-FAIL-F2-2-3. NC2094.2 +051800 PERFORM FAIL. NC2094.2 +051900 MOVE HARRY OF A-BUNCH TO COMPUTED-A. NC2094.2 +052000 MOVE "YYYYY" TO CORRECT-A. NC2094.2 +052100 MOV-WRITE-F2-2-3. NC2094.2 +052200 PERFORM PRINT-DETAIL. NC2094.2 +052300* NC2094.2 +052400 MOV-TEST-F2-2-4. NC2094.2 +052500 ADD 1 TO REC-CT. NC2094.2 +052600 IF JOE OF A-BUNCH EQUAL TO "YYY" NC2094.2 +052700 PERFORM PASS NC2094.2 +052800 GO TO MOV-WRITE-F2-2-4. NC2094.2 +052900 GO TO MOV-FAIL-F2-2-4. NC2094.2 +053000 MOV-DELETE-F2-2-4. NC2094.2 +053100 PERFORM DE-LETE. NC2094.2 +053200 GO TO MOV-WRITE-F2-2-4. NC2094.2 +053300 MOV-FAIL-F2-2-4. NC2094.2 +053400 PERFORM FAIL. NC2094.2 +053500 MOVE JOE OF A-BUNCH TO COMPUTED-A. NC2094.2 +053600 MOVE "YYY" TO CORRECT-A. NC2094.2 +053700 MOV-WRITE-F2-2-4. NC2094.2 +053800 PERFORM PRINT-DETAIL. NC2094.2 +053900* NC2094.2 +054000 MOV-TEST-F2-2-5. NC2094.2 +054100 ADD 1 TO REC-CT. NC2094.2 +054200 IF AL OF A-BUNCH EQUAL TO "AL" NC2094.2 +054300 PERFORM PASS NC2094.2 +054400 GO TO MOV-WRITE-F2-2-5. NC2094.2 +054500 GO TO MOV-FAIL-F2-2-5. NC2094.2 +054600 MOV-DELETE-F2-2-5. NC2094.2 +054700 PERFORM DE-LETE. NC2094.2 +054800 GO TO MOV-WRITE-F2-2-5. NC2094.2 +054900 MOV-FAIL-F2-2-5. NC2094.2 +055000 PERFORM FAIL. NC2094.2 +055100 MOVE AL OF A-BUNCH TO COMPUTED-A. NC2094.2 +055200 MOVE "AL" TO CORRECT-A. NC2094.2 +055300 MOV-WRITE-F2-2-5. NC2094.2 +055400 PERFORM PRINT-DETAIL. NC2094.2 +055500* NC2094.2 +055600 MOV-TEST-F2-2-6. NC2094.2 +055700 ADD 1 TO REC-CT. NC2094.2 +055800 IF BOB OF A-BUNCH EQUAL TO "YYY" NC2094.2 +055900 PERFORM PASS NC2094.2 +056000 GO TO MOV-WRITE-F2-2-6. NC2094.2 +056100 GO TO MOV-FAIL-F2-2-6. NC2094.2 +056200 MOV-DELETE-F2-2-6. NC2094.2 +056300 PERFORM DE-LETE. NC2094.2 +056400 GO TO MOV-WRITE-F2-2-6. NC2094.2 +056500 MOV-FAIL-F2-2-6. NC2094.2 +056600 PERFORM FAIL. NC2094.2 +056700 MOVE BOB OF A-BUNCH TO COMPUTED-A. NC2094.2 +056800 MOVE "YYY" TO CORRECT-A. NC2094.2 +056900 MOV-WRITE-F2-2-6. NC2094.2 +057000 PERFORM PRINT-DETAIL. NC2094.2 +057100* NC2094.2 +057200 MOV-INIT-F2-3. NC2094.2 +057300 MOVE "MOV-TEST-F2-3" TO PAR-NAME. NC2094.2 +057400 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +057500 MOVE CORR B-LEVEL OF A-LEVEL TO B-SET. NC2094.2 +057600 MOVE 1 TO REC-CT. NC2094.2 +057700* NOTE CORR IS A LEGAL ABBREVIATION. NC2094.2 +057800* NOTE NO MOVES SHOULD TAKE PLACE. NC2094.2 +057900* NC2094.2 +058000 MOV-TEST-F2-3-1. NC2094.2 +058100 ADD 1 TO REC-CT. NC2094.2 +058200 IF TOM OF A-SET EQUAL TO "WWW" NC2094.2 +058300 PERFORM PASS NC2094.2 +058400 GO TO MOV-WRITE-F2-3-1. NC2094.2 +058500 GO TO MOV-FAIL-F2-3-1. NC2094.2 +058600 MOV-DELETE-F2-3-1. NC2094.2 +058700 PERFORM DE-LETE. NC2094.2 +058800 GO TO MOV-WRITE-F2-3-1. NC2094.2 +058900 MOV-FAIL-F2-3-1. NC2094.2 +059000 PERFORM FAIL. NC2094.2 +059100 MOVE TOM OF A-SET TO COMPUTED-A. NC2094.2 +059200 MOVE "WWW" TO CORRECT-A. NC2094.2 +059300 MOV-WRITE-F2-3-1. NC2094.2 +059400 PERFORM PRINT-DETAIL. NC2094.2 +059500* NC2094.2 +059600 MOV-TEST-F2-3-2. NC2094.2 +059700 ADD 1 TO REC-CT. NC2094.2 +059800 IF DICK OF A-SET EQUAL TO "WWWW" NC2094.2 +059900 PERFORM PASS NC2094.2 +060000 GO TO MOV-WRITE-F2-3-2. NC2094.2 +060100 GO TO MOV-FAIL-F2-3-2. NC2094.2 +060200 MOV-DELETE-F2-3-2. NC2094.2 +060300 PERFORM DE-LETE. NC2094.2 +060400 GO TO MOV-WRITE-F2-3-2. NC2094.2 +060500 MOV-FAIL-F2-3-2. NC2094.2 +060600 PERFORM FAIL. NC2094.2 +060700 MOVE DICK OF A-SET TO COMPUTED-A. NC2094.2 +060800 MOVE "WWWW" TO CORRECT-A. NC2094.2 +060900 MOV-WRITE-F2-3-2. NC2094.2 +061000 PERFORM PRINT-DETAIL. NC2094.2 +061100* NC2094.2 +061200 MOV-TEST-F2-3-3. NC2094.2 +061300 ADD 1 TO REC-CT. NC2094.2 +061400 IF HARRY OF A-SET EQUAL TO "WWWWW" NC2094.2 +061500 PERFORM PASS NC2094.2 +061600 GO TO MOV-WRITE-F2-3-3. NC2094.2 +061700 GO TO MOV-FAIL-F2-3-3. NC2094.2 +061800 MOV-DELETE-F2-3-3. NC2094.2 +061900 PERFORM DE-LETE. NC2094.2 +062000 GO TO MOV-WRITE-F2-3-3. NC2094.2 +062100 MOV-FAIL-F2-3-3. NC2094.2 +062200 PERFORM FAIL. NC2094.2 +062300 MOVE HARRY OF A-SET TO COMPUTED-A. NC2094.2 +062400 MOVE "WWWWW" TO CORRECT-A. NC2094.2 +062500 MOV-WRITE-F2-3-3. NC2094.2 +062600 PERFORM PRINT-DETAIL. NC2094.2 +062700* NC2094.2 +062800 MOV-TEST-F2-3-4. NC2094.2 +062900 ADD 1 TO REC-CT. NC2094.2 +063000 IF BOB OF A-SET EQUAL TO "WWW" NC2094.2 +063100 PERFORM PASS NC2094.2 +063200 GO TO MOV-WRITE-F2-3-4. NC2094.2 +063300 GO TO MOV-FAIL-F2-3-4. NC2094.2 +063400 MOV-DELETE-F2-3-4. NC2094.2 +063500 PERFORM DE-LETE. NC2094.2 +063600 GO TO MOV-WRITE-F2-3-4. NC2094.2 +063700 MOV-FAIL-F2-3-4. NC2094.2 +063800 PERFORM FAIL. NC2094.2 +063900 MOVE BOB OF A-SET TO COMPUTED-A. NC2094.2 +064000 MOVE "WWW" TO CORRECT-A. NC2094.2 +064100 MOV-WRITE-F2-3-4. NC2094.2 +064200 PERFORM PRINT-DETAIL. NC2094.2 +064300* NC2094.2 +064400 MOV-INIT-F2-4. NC2094.2 +064500 MOVE "MOV-TEST-F2-4" TO PAR-NAME. NC2094.2 +064600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +064700 MOVE CORRESPONDING C-LEVEL OF A-LEVEL TO C-STACK. NC2094.2 +064800 MOVE 1 TO REC-CT. NC2094.2 +064900* NOTE TOM AND HARRY SHOULD BE MOVED. NC2094.2 +065000 MOV-TEST-F2-4-1. NC2094.2 +065100 IF TOM OF C-STACK EQUAL TO "TOM" NC2094.2 +065200 PERFORM PASS NC2094.2 +065300 GO TO MOV-WRITE-F2-4-1. NC2094.2 +065400 GO TO MOV-FAIL-F2-4-1. NC2094.2 +065500 MOV-DELETE-F2-4-1. NC2094.2 +065600 PERFORM DE-LETE. NC2094.2 +065700 GO TO MOV-WRITE-F2-4-1. NC2094.2 +065800 MOV-FAIL-F2-4-1. NC2094.2 +065900 PERFORM FAIL. NC2094.2 +066000 MOVE TOM OF C-STACK TO COMPUTED-A. NC2094.2 +066100 MOVE "TOM" TO CORRECT-A. NC2094.2 +066200 MOV-WRITE-F2-4-1. NC2094.2 +066300 PERFORM PRINT-DETAIL. NC2094.2 +066400* NC2094.2 +066500 MOV-TEST-F2-4-2. NC2094.2 +066600 ADD 1 TO REC-CT. NC2094.2 +066700 IF DICK OF C-STACK EQUAL TO "VVVV" NC2094.2 +066800 PERFORM PASS NC2094.2 +066900 GO TO MOV-WRITE-F2-4-2. NC2094.2 +067000 GO TO MOV-FAIL-F2-4-2. NC2094.2 +067100 MOV-DELETE-F2-4-2. NC2094.2 +067200 PERFORM DE-LETE. NC2094.2 +067300 GO TO MOV-WRITE-F2-4-2. NC2094.2 +067400 MOV-FAIL-F2-4-2. NC2094.2 +067500 PERFORM FAIL. NC2094.2 +067600 MOVE DICK OF C-STACK TO COMPUTED-A. NC2094.2 +067700 MOVE "VVVV" TO CORRECT-A. NC2094.2 +067800 MOV-WRITE-F2-4-2. NC2094.2 +067900 PERFORM PRINT-DETAIL. NC2094.2 +068000* NC2094.2 +068100 MOV-TEST-F2-4-3. NC2094.2 +068200 ADD 1 TO REC-CT. NC2094.2 +068300 IF HARRY OF C-STACK EQUAL TO "HARRY" NC2094.2 +068400 PERFORM PASS NC2094.2 +068500 GO TO MOV-WRITE-F2-4-3. NC2094.2 +068600 GO TO MOV-FAIL-F2-4-3. NC2094.2 +068700 MOV-DELETE-F2-4-3. NC2094.2 +068800 PERFORM DE-LETE. NC2094.2 +068900 GO TO MOV-WRITE-F2-4-3. NC2094.2 +069000 MOV-FAIL-F2-4-3. NC2094.2 +069100 PERFORM FAIL. NC2094.2 +069200 MOVE HARRY OF C-STACK TO COMPUTED-A. NC2094.2 +069300 MOVE "HARRY" TO CORRECT-A. NC2094.2 +069400 MOV-WRITE-F2-4-3. NC2094.2 +069500 PERFORM PRINT-DETAIL. NC2094.2 +069600* NC2094.2 +069700 MOV-INIT-F2-5. NC2094.2 +069800 MOVE "MOV-TEST-F2-5" TO PAR-NAME. NC2094.2 +069900 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +070000 MOVE " WITH RENAMES " TO FEATURE. NC2094.2 +070100 MOVE CORRESPONDING A-LEVEL TO A-GLOB. NC2094.2 +070200 MOVE 1 TO REC-CT. NC2094.2 +070300* NOTE TOM, DICK, JOE, AND AL SHOULD BE MOVED. NC2094.2 +070400* NC2094.2 +070500 MOV-TEST-F2-5-1. NC2094.2 +070600 IF TOM OF A-GLOB EQUAL TO "TOM" NC2094.2 +070700 PERFORM PASS NC2094.2 +070800 GO TO MOV-WRITE-F2-5-1. NC2094.2 +070900 GO TO MOV-FAIL-F2-5-1. NC2094.2 +071000 MOV-DELETE-F2-5-1. NC2094.2 +071100 PERFORM DE-LETE. NC2094.2 +071200 GO TO MOV-WRITE-F2-5-1. NC2094.2 +071300 MOV-FAIL-F2-5-1. NC2094.2 +071400 PERFORM FAIL. NC2094.2 +071500 MOVE TOM OF A-GLOB TO COMPUTED-A. NC2094.2 +071600 MOVE "TOM" TO CORRECT-A. NC2094.2 +071700 MOV-WRITE-F2-5-1. NC2094.2 +071800 PERFORM PRINT-DETAIL. NC2094.2 +071900* NC2094.2 +072000 MOV-TEST-F2-5-2. NC2094.2 +072100 ADD 1 TO REC-CT. NC2094.2 +072200 IF DICK OF A-GLOB EQUAL TO "DICK" NC2094.2 +072300 PERFORM PASS NC2094.2 +072400 GO TO MOV-WRITE-F2-5-2. NC2094.2 +072500 GO TO MOV-FAIL-F2-5-2. NC2094.2 +072600 MOV-DELETE-F2-5-2. NC2094.2 +072700 PERFORM DE-LETE. NC2094.2 +072800 GO TO MOV-WRITE-F2-5-2. NC2094.2 +072900 MOV-FAIL-F2-5-2. NC2094.2 +073000 PERFORM FAIL. NC2094.2 +073100 MOVE DICK OF A-GLOB TO COMPUTED-A. NC2094.2 +073200 MOVE "DICK" TO CORRECT-A. NC2094.2 +073300 MOV-WRITE-F2-5-2. NC2094.2 +073400 PERFORM PRINT-DETAIL. NC2094.2 +073500* NC2094.2 +073600 MOV-TEST-F2-5-3. NC2094.2 +073700 ADD 1 TO REC-CT. NC2094.2 +073800 IF HARRY OF A-GLOB EQUAL TO "UUUUU" NC2094.2 +073900 PERFORM PASS NC2094.2 +074000 GO TO MOV-WRITE-F2-5-3. NC2094.2 +074100 GO TO MOV-FAIL-F2-5-3. NC2094.2 +074200 MOV-DELETE-F2-5-3. NC2094.2 +074300 PERFORM DE-LETE. NC2094.2 +074400 GO TO MOV-WRITE-F2-5-3. NC2094.2 +074500 MOV-FAIL-F2-5-3. NC2094.2 +074600 PERFORM FAIL. NC2094.2 +074700 MOVE HARRY OF A-GLOB TO COMPUTED-A. NC2094.2 +074800 MOVE "UUUUU" TO CORRECT-A. NC2094.2 +074900 MOV-WRITE-F2-5-3. NC2094.2 +075000 PERFORM PRINT-DETAIL. NC2094.2 +075100* NC2094.2 +075200 MOV-TEST-F2-5-4. NC2094.2 +075300 ADD 1 TO REC-CT. NC2094.2 +075400 IF JOE OF A-GLOB EQUAL TO "JOE" NC2094.2 +075500 PERFORM PASS NC2094.2 +075600 GO TO MOV-WRITE-F2-5-4. NC2094.2 +075700 GO TO MOV-FAIL-F2-5-4. NC2094.2 +075800 MOV-DELETE-F2-5-4. NC2094.2 +075900 PERFORM DE-LETE. NC2094.2 +076000 GO TO MOV-WRITE-F2-5-4. NC2094.2 +076100 MOV-FAIL-F2-5-4. NC2094.2 +076200 PERFORM FAIL. NC2094.2 +076300 MOVE JOE OF A-GLOB TO COMPUTED-A. NC2094.2 +076400 MOVE "JOE" TO CORRECT-A. NC2094.2 +076500 MOV-WRITE-F2-5-4. NC2094.2 +076600 PERFORM PRINT-DETAIL. NC2094.2 +076700* NC2094.2 +076800 MOV-TEST-F2-5-5. NC2094.2 +076900 ADD 1 TO REC-CT. NC2094.2 +077000 IF AL OF A-GLOB EQUAL TO "AL" NC2094.2 +077100 PERFORM PASS NC2094.2 +077200 GO TO MOV-WRITE-F2-5-5. NC2094.2 +077300 GO TO MOV-FAIL-F2-5-5. NC2094.2 +077400 MOV-DELETE-F2-5-5. NC2094.2 +077500 PERFORM DE-LETE. NC2094.2 +077600 GO TO MOV-WRITE-F2-5-5. NC2094.2 +077700 MOV-FAIL-F2-5-5. NC2094.2 +077800 PERFORM FAIL. NC2094.2 +077900 MOVE AL OF A-GLOB TO COMPUTED-A. NC2094.2 +078000 MOVE "AL" TO CORRECT-A. NC2094.2 +078100 MOV-WRITE-F2-5-5. NC2094.2 +078200 PERFORM PRINT-DETAIL. NC2094.2 +078300* NC2094.2 +078400 MOV-TEST-F2-5-6. NC2094.2 +078500 ADD 1 TO REC-CT. NC2094.2 +078600 IF BOB OF A-GLOB EQUAL TO "UUU" NC2094.2 +078700 PERFORM PASS NC2094.2 +078800 GO TO MOV-WRITE-F2-5-6. NC2094.2 +078900 GO TO MOV-FAIL-F2-5-6. NC2094.2 +079000 MOV-DELETE-F2-5-6. NC2094.2 +079100 PERFORM DE-LETE. NC2094.2 +079200 GO TO MOV-WRITE-F2-5-6. NC2094.2 +079300 MOV-FAIL-F2-5-6. NC2094.2 +079400 PERFORM FAIL. NC2094.2 +079500 MOVE BOB OF A-GLOB TO COMPUTED-A. NC2094.2 +079600 MOVE "UUU" TO CORRECT-A. NC2094.2 +079700 MOV-WRITE-F2-5-6. NC2094.2 +079800 PERFORM PRINT-DETAIL. NC2094.2 +079900* NC2094.2 +080000 MOV-INIT-F2-6. NC2094.2 +080100 MOVE "MOV-TEST-F2-6" TO PAR-NAME. NC2094.2 +080200 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +080300 MOVE " WITH REDEF, OCCURS" TO FEATURE. NC2094.2 +080400 MOVE D-LEVEL IN C-COLLECTION TO WORK-AREA. NC2094.2 +080500 MOVE "TTTTTTTTTTTTTTT" TO C-COLLECTION NC2094.2 +080600 MOVE 1 TO REC-CT. NC2094.2 +080700 MOVE CORRESPONDING C-LEVEL IN A-LEVEL TO C-COLLECTION. NC2094.2 +080800* NOTE DICK AND JOE SHOULD BE MOVED. NC2094.2 +080900* NC2094.2 +081000 MOV-TEST-F2-6-1. NC2094.2 +081100 MOVE D-LEVEL IN C-COLLECTION TO WORK-AREA. NC2094.2 +081200 IF WORK-TOM EQUAL TO "TTT" NC2094.2 +081300 PERFORM PASS NC2094.2 +081400 GO TO MOV-WRITE-F2-6-1. NC2094.2 +081500 GO TO MOV-FAIL-F2-6-1. NC2094.2 +081600 MOV-DELETE-F2-6-1. NC2094.2 +081700 PERFORM DE-LETE. NC2094.2 +081800 GO TO MOV-WRITE-F2-6-1. NC2094.2 +081900 MOV-FAIL-F2-6-1. NC2094.2 +082000 PERFORM FAIL. NC2094.2 +082100 MOVE D-LEVEL OF A-COLLECTION TO COMPUTED-A. NC2094.2 +082200 MOVE "TTT" TO CORRECT-A. NC2094.2 +082300 MOV-WRITE-F2-6-1. NC2094.2 +082400 PERFORM PRINT-DETAIL. NC2094.2 +082500* NC2094.2 +082600 MOV-TEST-F2-6-2. NC2094.2 +082700 ADD 1 TO REC-CT. NC2094.2 +082800 IF DICK OF A-COLLECTION EQUAL TO "DICK" NC2094.2 +082900 PERFORM PASS NC2094.2 +083000 GO TO MOV-WRITE-F2-6-2. NC2094.2 +083100 GO TO MOV-FAIL-F2-6-2. NC2094.2 +083200 MOV-DELETE-F2-6-2. NC2094.2 +083300 PERFORM DE-LETE. NC2094.2 +083400 GO TO MOV-WRITE-F2-6-2. NC2094.2 +083500 MOV-FAIL-F2-6-2. NC2094.2 +083600 PERFORM FAIL. NC2094.2 +083700 MOVE DICK OF A-COLLECTION TO COMPUTED-A. NC2094.2 +083800 MOVE "DICK" TO CORRECT-A. NC2094.2 +083900 MOV-WRITE-F2-6-2. NC2094.2 +084000 PERFORM PRINT-DETAIL. NC2094.2 +084100* NC2094.2 +084200 MOV-TEST-F2-6-3. NC2094.2 +084300 ADD 1 TO REC-CT. NC2094.2 +084400 IF HARRY OF A-COLLECTION EQUAL TO "TTTTT" NC2094.2 +084500 PERFORM PASS NC2094.2 +084600 GO TO MOV-WRITE-F2-6-3. NC2094.2 +084700 GO TO MOV-FAIL-F2-6-3. NC2094.2 +084800 MOV-DELETE-F2-6-3. NC2094.2 +084900 PERFORM DE-LETE. NC2094.2 +085000 GO TO MOV-WRITE-F2-6-3. NC2094.2 +085100 MOV-FAIL-F2-6-3. NC2094.2 +085200 PERFORM FAIL. NC2094.2 +085300 MOVE HARRY OF A-COLLECTION TO COMPUTED-A. NC2094.2 +085400 MOVE "TTTTT" TO CORRECT-A. NC2094.2 +085500 MOV-WRITE-F2-6-3. NC2094.2 +085600 PERFORM PRINT-DETAIL. NC2094.2 +085700* NC2094.2 +085800 MOV-TEST-F2-6-4. NC2094.2 +085900 ADD 1 TO REC-CT. NC2094.2 +086000 IF JOE OF A-COLLECTION EQUAL TO "JOE" NC2094.2 +086100 PERFORM PASS NC2094.2 +086200 GO TO MOV-WRITE-F2-6-4. NC2094.2 +086300 GO TO MOV-FAIL-F2-6-4. NC2094.2 +086400 MOV-DELETE-F2-6-4. NC2094.2 +086500 PERFORM DE-LETE. NC2094.2 +086600 GO TO MOV-WRITE-F2-6-4. NC2094.2 +086700 MOV-FAIL-F2-6-4. NC2094.2 +086800 PERFORM FAIL. NC2094.2 +086900 MOVE JOE OF A-COLLECTION TO COMPUTED-A. NC2094.2 +087000 MOVE "JOE" TO CORRECT-A. NC2094.2 +087100 MOV-WRITE-F2-6-4. NC2094.2 +087200 PERFORM PRINT-DETAIL. NC2094.2 +087300* NC2094.2 +087400 MOV-INIT-F2-7. NC2094.2 +087500 MOVE "MOV-TEST-F2-7" TO PAR-NAME. NC2094.2 +087600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +087700 MOVE CORRESPONDING C-LEVEL IN A-LEVEL TO C-FLOCK (4). NC2094.2 +087800 MOVE 1 TO REC-CT. NC2094.2 +087900* NOTE TOM, DICK, HARRY, AND JOE SHOULD BE MOVED. NC2094.2 +088000 MOV-TEST-F2-7-1. NC2094.2 +088100 IF TOMMY OF A-COVEY EQUAL TO "TOM" NC2094.2 +088200 PERFORM PASS NC2094.2 +088300 GO TO MOV-WRITE-F2-7-1. NC2094.2 +088400 GO TO MOV-FAIL-F2-7-1. NC2094.2 +088500 MOV-DELETE-F2-7-1. NC2094.2 +088600 PERFORM DE-LETE. NC2094.2 +088700 GO TO MOV-WRITE-F2-7-1. NC2094.2 +088800 MOV-FAIL-F2-7-1. NC2094.2 +088900 PERFORM FAIL. NC2094.2 +089000 MOVE TOMMY OF A-COVEY TO COMPUTED-A. NC2094.2 +089100 MOVE "TOM" TO CORRECT-A. NC2094.2 +089200 MOV-WRITE-F2-7-1. NC2094.2 +089300 PERFORM PRINT-DETAIL. NC2094.2 +089400* NC2094.2 +089500 MOV-TEST-F2-7-2. NC2094.2 +089600 ADD 1 TO REC-CT. NC2094.2 +089700 IF DICKY OF A-COVEY EQUAL TO "DICK" NC2094.2 +089800 PERFORM PASS NC2094.2 +089900 GO TO MOV-WRITE-F2-7-2. NC2094.2 +090000 GO TO MOV-FAIL-F2-7-2. NC2094.2 +090100 MOV-DELETE-F2-7-2. NC2094.2 +090200 PERFORM DE-LETE. NC2094.2 +090300 GO TO MOV-WRITE-F2-7-2. NC2094.2 +090400 MOV-FAIL-F2-7-2. NC2094.2 +090500 PERFORM FAIL. NC2094.2 +090600 MOVE DICKY OF A-COVEY TO COMPUTED-A. NC2094.2 +090700 MOVE "DICK" TO CORRECT-A. NC2094.2 +090800 MOV-WRITE-F2-7-2. NC2094.2 +090900 PERFORM PRINT-DETAIL. NC2094.2 +091000* NC2094.2 +091100 MOV-TEST-F2-7-3. NC2094.2 +091200 ADD 1 TO REC-CT. NC2094.2 +091300 IF JOEY OF A-COVEY EQUAL TO "JOE" NC2094.2 +091400 PERFORM PASS NC2094.2 +091500 GO TO MOV-WRITE-F2-7-3. NC2094.2 +091600 GO TO MOV-FAIL-F2-7-3. NC2094.2 +091700 MOV-DELETE-F2-7-3. NC2094.2 +091800 PERFORM DE-LETE. NC2094.2 +091900 GO TO MOV-WRITE-F2-7-3. NC2094.2 +092000 MOV-FAIL-F2-7-3. NC2094.2 +092100 PERFORM FAIL. NC2094.2 +092200 MOVE JOEY OF A-COVEY TO COMPUTED-A. NC2094.2 +092300 MOVE "JOE" TO CORRECT-A. NC2094.2 +092400 MOV-WRITE-F2-7-3. NC2094.2 +092500 PERFORM PRINT-DETAIL. NC2094.2 +092600* NC2094.2 +092700 MOV-TEST-F2-7-4. NC2094.2 +092800 ADD 1 TO REC-CT. NC2094.2 +092900 IF HAROLD OF A-COVEY EQUAL TO "HARRY" NC2094.2 +093000 PERFORM PASS NC2094.2 +093100 GO TO MOV-WRITE-F2-7-4. NC2094.2 +093200 GO TO MOV-FAIL-F2-7-4. NC2094.2 +093300 MOV-DELETE-F2-7-4. NC2094.2 +093400 PERFORM DE-LETE. NC2094.2 +093500 GO TO MOV-WRITE-F2-7-4. NC2094.2 +093600 MOV-FAIL-F2-7-4. NC2094.2 +093700 PERFORM FAIL. NC2094.2 +093800 MOVE HAROLD OF A-COVEY TO COMPUTED-A. NC2094.2 +093900 MOVE "HARRY" TO CORRECT-A. NC2094.2 +094000 MOV-WRITE-F2-7-4. NC2094.2 +094100 PERFORM PRINT-DETAIL. NC2094.2 +094200* NC2094.2 +094300 MOV-INIT-F2-8. NC2094.2 +094400 MOVE "MOV-TEST-F2-8" TO PAR-NAME. NC2094.2 +094500 MOVE CORRESPONDING BB-LEVEL TO BB-MOB (1). NC2094.2 +094600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +094700 MOVE 0 TO REC-CT. NC2094.2 +094800* NOTE BOB SHOULD BE MOVED. NC2094.2 +094900 MOV-TEST-F2-8. NC2094.2 +095000 IF BOBBY OF A-CROWD EQUAL TO "BOB" NC2094.2 +095100 PERFORM PASS NC2094.2 +095200 GO TO MOV-WRITE-F2-8. NC2094.2 +095300 GO TO MOV-FAIL-F2-8. NC2094.2 +095400 MOV-DELETE-F2-8. NC2094.2 +095500 PERFORM DE-LETE. NC2094.2 +095600 GO TO MOV-WRITE-F2-8. NC2094.2 +095700 MOV-FAIL-F2-8. NC2094.2 +095800 PERFORM FAIL. NC2094.2 +095900 MOVE BOBBY OF A-CROWD TO COMPUTED-A. NC2094.2 +096000 MOVE "BOB" TO CORRECT-A. NC2094.2 +096100 MOV-WRITE-F2-8. NC2094.2 +096200 PERFORM PRINT-DETAIL. NC2094.2 +096300* NC2094.2 +096400 CCVS-EXIT SECTION. NC2094.2 +096500 CCVS-999999. NC2094.2 +096600 GO TO CLOSE-FILES. NC2094.2 +*END-OF,NC209A +*HEADER,COBOL,NC210A +000100 IDENTIFICATION DIVISION. NC2104.2 +000200 PROGRAM-ID. NC2104.2 +000300 NC210A. NC2104.2 +000400**************************************************************** NC2104.2 +000500* * NC2104.2 +000600* VALIDATION FOR:- * NC2104.2 +000700* * NC2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +000900* * NC2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2104.2 +001100* * NC2104.2 +001200**************************************************************** NC2104.2 +001300* * NC2104.2 +001400* PROGRAM NC210A TESTS NESTED "IF" STATEMENTS, USING 63 * NC2104.2 +001500* STATEMENTS AND 6 LEVELS OF NESTING IN ONE SENTENCE AND * NC2104.2 +001600* 22 LEVELS OF NESTING IN A SECOND TEST. * NC2104.2 +001700* * NC2104.2 +001800* X-CARDS USED ARE :- * NC2104.2 +001900* * NC2104.2 +002000* X-55 - SYSTEM PRINTER NAME. * NC2104.2 +002100* X-82 - SOURCE COMPUTER NAME. * NC2104.2 +002200* X-83 - OBJECT COMPUTER NAME. * NC2104.2 +002300* * NC2104.2 +002400**************************************************************** NC2104.2 +002500 ENVIRONMENT DIVISION. NC2104.2 +002600 CONFIGURATION SECTION. NC2104.2 +002700 SOURCE-COMPUTER. NC2104.2 +002800 XXXXX082. NC2104.2 +002900 OBJECT-COMPUTER. NC2104.2 +003000 XXXXX083. NC2104.2 +003100 INPUT-OUTPUT SECTION. NC2104.2 +003200 FILE-CONTROL. NC2104.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2104.2 +003400 XXXXX055. NC2104.2 +003500 DATA DIVISION. NC2104.2 +003600 FILE SECTION. NC2104.2 +003700 FD PRINT-FILE. NC2104.2 +003800 01 PRINT-REC PICTURE X(120). NC2104.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2104.2 +004000 WORKING-STORAGE SECTION. NC2104.2 +004100 77 ACCUM-DATANAME PIC 99 VALUE ZERO. NC2104.2 +004200 77 DATANAME-A PIC 9 VALUE 0. NC2104.2 +004300 77 DATANAME-B PIC 9 VALUE 0. NC2104.2 +004400 77 DATANAME-C PIC 9 VALUE 0. NC2104.2 +004500 77 DATANAME-D PIC 9 VALUE 0. NC2104.2 +004600 77 DATANAME-E PIC 9 VALUE 0. NC2104.2 +004700 77 DATANAME-F PIC 9 VALUE 0. NC2104.2 +004800 77 SUB-SCRIPT PIC 99 VALUE 01. NC2104.2 +004900 01 DATA-NAMES. NC2104.2 +005000 02 ONE-A PIC 9 VALUE 0. NC2104.2 +005100 02 ONE-B PIC 9 VALUE 0. NC2104.2 +005200 02 ONE-C PIC 9 VALUE 0. NC2104.2 +005300 02 ONE-D PIC 9 VALUE 0. NC2104.2 +005400 02 ONE-E PIC 9 VALUE 0. NC2104.2 +005500 02 ONE-F PIC 9 VALUE 0. NC2104.2 +005600 01 ONE-X REDEFINES DATA-NAMES PIC 9(6). NC2104.2 +005700 01 BUILT-TABLE. NC2104.2 +005800 02 A-POS PIC XX. NC2104.2 +005900 02 B-POS PIC XX. NC2104.2 +006000 02 C-POS PIC XX. NC2104.2 +006100 02 D-POS PIC XXX. NC2104.2 +006200 02 E-POS PIC XXX. NC2104.2 +006300 02 F-POS PIC XXX. NC2104.2 +006400 01 PARAGRAPH-NAME. NC2104.2 +006500 02 FILLER PIC X(11) VALUE "IF-TEST-GF-". NC2104.2 +006600 02 PAR-NUMBER PIC 99 VALUE 00. NC2104.2 +006700 01 COMPARISON-TABLE. NC2104.2 +006800 02 FILLER PIC X(15) VALUE "A1B1C1D01E01F01". NC2104.2 +006900 02 FILLER PIC X(15) VALUE "A1B1C1D01E01F02". NC2104.2 +007000 02 FILLER PIC X(15) VALUE "A1B1C1D01E02F03". NC2104.2 +007100 02 FILLER PIC X(15) VALUE "A1B1C1D01E02F04". NC2104.2 +007200 02 FILLER PIC X(15) VALUE "A1B1C1D02E03F05". NC2104.2 +007300 02 FILLER PIC X(15) VALUE "A1B1C1D02E03F06". NC2104.2 +007400 02 FILLER PIC X(15) VALUE "A1B1C1D02E04F07". NC2104.2 +007500 02 FILLER PIC X(15) VALUE "A1B1C1D02E04F08". NC2104.2 +007600 02 FILLER PIC X(15) VALUE "A1B1C2D03E05F09". NC2104.2 +007700 02 FILLER PIC X(15) VALUE "A1B1C2D03E05F10". NC2104.2 +007800 02 FILLER PIC X(15) VALUE "A1B1C2D03E06F11". NC2104.2 +007900 02 FILLER PIC X(15) VALUE "A1B1C2D03E06F12". NC2104.2 +008000 02 FILLER PIC X(15) VALUE "A1B1C2D04E07F13". NC2104.2 +008100 02 FILLER PIC X(15) VALUE "A1B1C2D04E07F14". NC2104.2 +008200 02 FILLER PIC X(15) VALUE "A1B1C2D04E08F15". NC2104.2 +008300 02 FILLER PIC X(15) VALUE "A1B1C2D04E08F16". NC2104.2 +008400 02 FILLER PIC X(15) VALUE "A1B2C3D05E09F17". NC2104.2 +008500 02 FILLER PIC X(15) VALUE "A1B2C3D05E09F18". NC2104.2 +008600 02 FILLER PIC X(15) VALUE "A1B2C3D05E10F19". NC2104.2 +008700 02 FILLER PIC X(15) VALUE "A1B2C3D05E10F20". NC2104.2 +008800 02 FILLER PIC X(15) VALUE "A1B2C3D06E11F21". NC2104.2 +008900 02 FILLER PIC X(15) VALUE "A1B2C3D06E11F22". NC2104.2 +009000 02 FILLER PIC X(15) VALUE "A1B2C3D06E12F23". NC2104.2 +009100 02 FILLER PIC X(15) VALUE "A1B2C3D06E12F24". NC2104.2 +009200 02 FILLER PIC X(15) VALUE "A1B2C4D07E13F25". NC2104.2 +009300 02 FILLER PIC X(15) VALUE "A1B2C4D07E13F26". NC2104.2 +009400 02 FILLER PIC X(15) VALUE "A1B2C4D07E14F27". NC2104.2 +009500 02 FILLER PIC X(15) VALUE "A1B2C4D07E14F28". NC2104.2 +009600 02 FILLER PIC X(15) VALUE "A1B2C4D08E15F29". NC2104.2 +009700 02 FILLER PIC X(15) VALUE "A1B2C4D08E15F30". NC2104.2 +009800 02 FILLER PIC X(15) VALUE "A1B2C4D08E16F31". NC2104.2 +009900 02 FILLER PIC X(15) VALUE "A1B2C4D08E16F32". NC2104.2 +010000 02 FILLER PIC X(15) VALUE "A2B3C5D09E17F33". NC2104.2 +010100 02 FILLER PIC X(15) VALUE "A2B3C5D09E17F34". NC2104.2 +010200 02 FILLER PIC X(15) VALUE "A2B3C5D09E18F35". NC2104.2 +010300 02 FILLER PIC X(15) VALUE "A2B3C5D09E18F36". NC2104.2 +010400 02 FILLER PIC X(15) VALUE "A2B3C5D10E19F37". NC2104.2 +010500 02 FILLER PIC X(15) VALUE "A2B3C5D10E19F38". NC2104.2 +010600 02 FILLER PIC X(15) VALUE "A2B3C5D10E20F39". NC2104.2 +010700 02 FILLER PIC X(15) VALUE "A2B3C5D10E20F40". NC2104.2 +010800 02 FILLER PIC X(15) VALUE "A2B3C6D11E21F41". NC2104.2 +010900 02 FILLER PIC X(15) VALUE "A2B3C6D11E21F42". NC2104.2 +011000 02 FILLER PIC X(15) VALUE "A2B3C6D11E22F43". NC2104.2 +011100 02 FILLER PIC X(15) VALUE "A2B3C6D11E22F44". NC2104.2 +011200 02 FILLER PIC X(15) VALUE "A2B3C6D12E23F45". NC2104.2 +011300 02 FILLER PIC X(15) VALUE "A2B3C6D12E23F46". NC2104.2 +011400 02 FILLER PIC X(15) VALUE "A2B3C6D12E24F47". NC2104.2 +011500 02 FILLER PIC X(15) VALUE "A2B3C6D12E24F48". NC2104.2 +011600 02 FILLER PIC X(15) VALUE "A2B4C7D13E25F49". NC2104.2 +011700 02 FILLER PIC X(15) VALUE "A2B4C7D13E25F50". NC2104.2 +011800 02 FILLER PIC X(15) VALUE "A2B4C7D13E26F51". NC2104.2 +011900 02 FILLER PIC X(15) VALUE "A2B4C7D13E26F52". NC2104.2 +012000 02 FILLER PIC X(15) VALUE "A2B4C7D14E27F53". NC2104.2 +012100 02 FILLER PIC X(15) VALUE "A2B4C7D14E27F54". NC2104.2 +012200 02 FILLER PIC X(15) VALUE "A2B4C7D14E28F55". NC2104.2 +012300 02 FILLER PIC X(15) VALUE "A2B4C7D14E28F56". NC2104.2 +012400 02 FILLER PIC X(15) VALUE "A2B4C8D15E29F57". NC2104.2 +012500 02 FILLER PIC X(15) VALUE "A2B4C8D15E29F58". NC2104.2 +012600 02 FILLER PIC X(15) VALUE "A2B4C8D15E30F59". NC2104.2 +012700 02 FILLER PIC X(15) VALUE "A2B4C8D15E30F60". NC2104.2 +012800 02 FILLER PIC X(15) VALUE "A2B4C8D16E31F61". NC2104.2 +012900 02 FILLER PIC X(15) VALUE "A2B4C8D16E31F62". NC2104.2 +013000 02 FILLER PIC X(15) VALUE "A2B4C8D16E32F63". NC2104.2 +013100 02 FILLER PIC X(15) VALUE "A2B4C8D16E32F64". NC2104.2 +013200 01 COMP-TBL REDEFINES COMPARISON-TABLE. NC2104.2 +013300 02 CORRECT-ENTRY OCCURS 64 TIMES PIC X(15). NC2104.2 +013400 01 T-F PIC X(5) VALUE "FALSE". NC2104.2 +013500 01 CHECK-PARA. NC2104.2 +013600 02 FILLER PIC X(21) VALUE "VALUE OF DATANAME AT ". NC2104.2 +013700 02 CHECK-VALU PIC 99. NC2104.2 +013800 02 FILLER PIC X(4) VALUE SPACES. NC2104.2 +013900 01 TEST-RESULTS. NC2104.2 +014000 02 FILLER PIC X VALUE SPACE. NC2104.2 +014100 02 FEATURE PIC X(20) VALUE SPACE. NC2104.2 +014200 02 FILLER PIC X VALUE SPACE. NC2104.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. NC2104.2 +014400 02 FILLER PIC X VALUE SPACE. NC2104.2 +014500 02 PAR-NAME. NC2104.2 +014600 03 FILLER PIC X(19) VALUE SPACE. NC2104.2 +014700 03 PARDOT-X PIC X VALUE SPACE. NC2104.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. NC2104.2 +014900 02 FILLER PIC X(8) VALUE SPACE. NC2104.2 +015000 02 RE-MARK PIC X(61). NC2104.2 +015100 01 TEST-COMPUTED. NC2104.2 +015200 02 FILLER PIC X(30) VALUE SPACE. NC2104.2 +015300 02 FILLER PIC X(17) VALUE NC2104.2 +015400 " COMPUTED=". NC2104.2 +015500 02 COMPUTED-X. NC2104.2 +015600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2104.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A NC2104.2 +015800 PIC -9(9).9(9). NC2104.2 +015900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2104.2 +016000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2104.2 +016100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2104.2 +016200 03 CM-18V0 REDEFINES COMPUTED-A. NC2104.2 +016300 04 COMPUTED-18V0 PIC -9(18). NC2104.2 +016400 04 FILLER PIC X. NC2104.2 +016500 03 FILLER PIC X(50) VALUE SPACE. NC2104.2 +016600 01 TEST-CORRECT. NC2104.2 +016700 02 FILLER PIC X(30) VALUE SPACE. NC2104.2 +016800 02 FILLER PIC X(17) VALUE " CORRECT =". NC2104.2 +016900 02 CORRECT-X. NC2104.2 +017000 03 CORRECT-A PIC X(20) VALUE SPACE. NC2104.2 +017100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2104.2 +017200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2104.2 +017300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2104.2 +017400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2104.2 +017500 03 CR-18V0 REDEFINES CORRECT-A. NC2104.2 +017600 04 CORRECT-18V0 PIC -9(18). NC2104.2 +017700 04 FILLER PIC X. NC2104.2 +017800 03 FILLER PIC X(2) VALUE SPACE. NC2104.2 +017900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2104.2 +018000 01 CCVS-C-1. NC2104.2 +018100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2104.2 +018200- "SS PARAGRAPH-NAME NC2104.2 +018300- " REMARKS". NC2104.2 +018400 02 FILLER PIC X(20) VALUE SPACE. NC2104.2 +018500 01 CCVS-C-2. NC2104.2 +018600 02 FILLER PIC X VALUE SPACE. NC2104.2 +018700 02 FILLER PIC X(6) VALUE "TESTED". NC2104.2 +018800 02 FILLER PIC X(15) VALUE SPACE. NC2104.2 +018900 02 FILLER PIC X(4) VALUE "FAIL". NC2104.2 +019000 02 FILLER PIC X(94) VALUE SPACE. NC2104.2 +019100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2104.2 +019200 01 REC-CT PIC 99 VALUE ZERO. NC2104.2 +019300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2104.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2104.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2104.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2104.2 +020100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2104.2 +020200 01 CCVS-H-1. NC2104.2 +020300 02 FILLER PIC X(39) VALUE SPACES. NC2104.2 +020400 02 FILLER PIC X(42) VALUE NC2104.2 +020500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2104.2 +020600 02 FILLER PIC X(39) VALUE SPACES. NC2104.2 +020700 01 CCVS-H-2A. NC2104.2 +020800 02 FILLER PIC X(40) VALUE SPACE. NC2104.2 +020900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2104.2 +021000 02 FILLER PIC XXXX VALUE NC2104.2 +021100 "4.2 ". NC2104.2 +021200 02 FILLER PIC X(28) VALUE NC2104.2 +021300 " COPY - NOT FOR DISTRIBUTION". NC2104.2 +021400 02 FILLER PIC X(41) VALUE SPACE. NC2104.2 +021500 NC2104.2 +021600 01 CCVS-H-2B. NC2104.2 +021700 02 FILLER PIC X(15) VALUE NC2104.2 +021800 "TEST RESULT OF ". NC2104.2 +021900 02 TEST-ID PIC X(9). NC2104.2 +022000 02 FILLER PIC X(4) VALUE NC2104.2 +022100 " IN ". NC2104.2 +022200 02 FILLER PIC X(12) VALUE NC2104.2 +022300 " HIGH ". NC2104.2 +022400 02 FILLER PIC X(22) VALUE NC2104.2 +022500 " LEVEL VALIDATION FOR ". NC2104.2 +022600 02 FILLER PIC X(58) VALUE NC2104.2 +022700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +022800 01 CCVS-H-3. NC2104.2 +022900 02 FILLER PIC X(34) VALUE NC2104.2 +023000 " FOR OFFICIAL USE ONLY ". NC2104.2 +023100 02 FILLER PIC X(58) VALUE NC2104.2 +023200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2104.2 +023300 02 FILLER PIC X(28) VALUE NC2104.2 +023400 " COPYRIGHT 1985 ". NC2104.2 +023500 01 CCVS-E-1. NC2104.2 +023600 02 FILLER PIC X(52) VALUE SPACE. NC2104.2 +023700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2104.2 +023800 02 ID-AGAIN PIC X(9). NC2104.2 +023900 02 FILLER PIC X(45) VALUE SPACES. NC2104.2 +024000 01 CCVS-E-2. NC2104.2 +024100 02 FILLER PIC X(31) VALUE SPACE. NC2104.2 +024200 02 FILLER PIC X(21) VALUE SPACE. NC2104.2 +024300 02 CCVS-E-2-2. NC2104.2 +024400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2104.2 +024500 03 FILLER PIC X VALUE SPACE. NC2104.2 +024600 03 ENDER-DESC PIC X(44) VALUE NC2104.2 +024700 "ERRORS ENCOUNTERED". NC2104.2 +024800 01 CCVS-E-3. NC2104.2 +024900 02 FILLER PIC X(22) VALUE NC2104.2 +025000 " FOR OFFICIAL USE ONLY". NC2104.2 +025100 02 FILLER PIC X(12) VALUE SPACE. NC2104.2 +025200 02 FILLER PIC X(58) VALUE NC2104.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +025400 02 FILLER PIC X(13) VALUE SPACE. NC2104.2 +025500 02 FILLER PIC X(15) VALUE NC2104.2 +025600 " COPYRIGHT 1985". NC2104.2 +025700 01 CCVS-E-4. NC2104.2 +025800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2104.2 +025900 02 FILLER PIC X(4) VALUE " OF ". NC2104.2 +026000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2104.2 +026100 02 FILLER PIC X(40) VALUE NC2104.2 +026200 " TESTS WERE EXECUTED SUCCESSFULLY". NC2104.2 +026300 01 XXINFO. NC2104.2 +026400 02 FILLER PIC X(19) VALUE NC2104.2 +026500 "*** INFORMATION ***". NC2104.2 +026600 02 INFO-TEXT. NC2104.2 +026700 04 FILLER PIC X(8) VALUE SPACE. NC2104.2 +026800 04 XXCOMPUTED PIC X(20). NC2104.2 +026900 04 FILLER PIC X(5) VALUE SPACE. NC2104.2 +027000 04 XXCORRECT PIC X(20). NC2104.2 +027100 02 INF-ANSI-REFERENCE PIC X(48). NC2104.2 +027200 01 HYPHEN-LINE. NC2104.2 +027300 02 FILLER PIC IS X VALUE IS SPACE. NC2104.2 +027400 02 FILLER PIC IS X(65) VALUE IS "************************NC2104.2 +027500- "*****************************************". NC2104.2 +027600 02 FILLER PIC IS X(54) VALUE IS "************************NC2104.2 +027700- "******************************". NC2104.2 +027800 01 CCVS-PGM-ID PIC X(9) VALUE NC2104.2 +027900 "NC210A". NC2104.2 +028000 PROCEDURE DIVISION. NC2104.2 +028100 CCVS1 SECTION. NC2104.2 +028200 OPEN-FILES. NC2104.2 +028300 OPEN OUTPUT PRINT-FILE. NC2104.2 +028400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2104.2 +028500 MOVE SPACE TO TEST-RESULTS. NC2104.2 +028600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2104.2 +028700 GO TO CCVS1-EXIT. NC2104.2 +028800 CLOSE-FILES. NC2104.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2104.2 +029000 TERMINATE-CCVS. NC2104.2 +029100 STOP RUN. NC2104.2 +029200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2104.2 +029300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2104.2 +029400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2104.2 +029500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2104.2 +029600 MOVE "****TEST DELETED****" TO RE-MARK. NC2104.2 +029700 PRINT-DETAIL. NC2104.2 +029800 IF REC-CT NOT EQUAL TO ZERO NC2104.2 +029900 MOVE "." TO PARDOT-X NC2104.2 +030000 MOVE REC-CT TO DOTVALUE. NC2104.2 +030100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2104.2 +030200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2104.2 +030300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2104.2 +030400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2104.2 +030500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2104.2 +030600 MOVE SPACE TO CORRECT-X. NC2104.2 +030700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2104.2 +030800 MOVE SPACE TO RE-MARK. NC2104.2 +030900 HEAD-ROUTINE. NC2104.2 +031000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2104.2 +031300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2104.2 +031400 COLUMN-NAMES-ROUTINE. NC2104.2 +031500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +031600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +031800 END-ROUTINE. NC2104.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2104.2 +032000 END-RTN-EXIT. NC2104.2 +032100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +032200 END-ROUTINE-1. NC2104.2 +032300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2104.2 +032400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2104.2 +032500 ADD PASS-COUNTER TO ERROR-HOLD. NC2104.2 +032600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2104.2 +032700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2104.2 +032800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2104.2 +032900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2104.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2104.2 +033100 END-ROUTINE-12. NC2104.2 +033200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2104.2 +033300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2104.2 +033400 MOVE "NO " TO ERROR-TOTAL NC2104.2 +033500 ELSE NC2104.2 +033600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2104.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2104.2 +033800 PERFORM WRITE-LINE. NC2104.2 +033900 END-ROUTINE-13. NC2104.2 +034000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2104.2 +034100 MOVE "NO " TO ERROR-TOTAL ELSE NC2104.2 +034200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2104.2 +034300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2104.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +034500 IF INSPECT-COUNTER EQUAL TO ZERO NC2104.2 +034600 MOVE "NO " TO ERROR-TOTAL NC2104.2 +034700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2104.2 +034800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2104.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +035000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +035100 WRITE-LINE. NC2104.2 +035200 ADD 1 TO RECORD-COUNT. NC2104.2 +035300Y IF RECORD-COUNT GREATER 50 NC2104.2 +035400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2104.2 +035500Y MOVE SPACE TO DUMMY-RECORD NC2104.2 +035600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2104.2 +035700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2104.2 +035800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2104.2 +035900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2104.2 +036000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2104.2 +036100Y MOVE ZERO TO RECORD-COUNT. NC2104.2 +036200 PERFORM WRT-LN. NC2104.2 +036300 WRT-LN. NC2104.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2104.2 +036500 MOVE SPACE TO DUMMY-RECORD. NC2104.2 +036600 BLANK-LINE-PRINT. NC2104.2 +036700 PERFORM WRT-LN. NC2104.2 +036800 FAIL-ROUTINE. NC2104.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2104.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2104.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2104.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2104.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2104.2 +037500 GO TO FAIL-ROUTINE-EX. NC2104.2 +037600 FAIL-ROUTINE-WRITE. NC2104.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2104.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2104.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2104.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2104.2 +038100 FAIL-ROUTINE-EX. EXIT. NC2104.2 +038200 BAIL-OUT. NC2104.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2104.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2104.2 +038500 BAIL-OUT-WRITE. NC2104.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2104.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2104.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2104.2 +039000 BAIL-OUT-EX. EXIT. NC2104.2 +039100 CCVS1-EXIT. NC2104.2 +039200 EXIT. NC2104.2 +039300 SECT-NC210A-001 SECTION. NC2104.2 +039400 IF-INIT-GF-X. NC2104.2 +039500 MOVE "VI-89 6.15.4 GR1(C)" TO ANSI-REFERENCE. NC2104.2 +039600 IF-TEST-GF-X. NC2104.2 +039700 IF DATANAME-A EQUAL TO ONE-A NC2104.2 +039800 MOVE "A1" TO A-POS NC2104.2 +039900 IF DATANAME-B EQUAL TO ONE-B NC2104.2 +040000 MOVE "B1" TO B-POS NC2104.2 +040100 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +040200 MOVE "C1" TO C-POS NC2104.2 +040300 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +040400 MOVE "D01" TO D-POS NC2104.2 +040500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +040600 MOVE "E01" TO E-POS NC2104.2 +040700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +040800 MOVE "F01" TO F-POS NC2104.2 +040900 ELSE NC2104.2 +041000 MOVE "F02" TO F-POS NC2104.2 +041100 ELSE NC2104.2 +041200 MOVE "E02" TO E-POS NC2104.2 +041300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +041400 MOVE "F03" TO F-POS NC2104.2 +041500 ELSE NC2104.2 +041600 MOVE "F04" TO F-POS NC2104.2 +041700 ELSE NC2104.2 +041800 MOVE "D02" TO D-POS NC2104.2 +041900 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +042000 MOVE "E03" TO E-POS NC2104.2 +042100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +042200 MOVE "F05" TO F-POS NC2104.2 +042300 ELSE NC2104.2 +042400 MOVE "F06" TO F-POS NC2104.2 +042500 ELSE NC2104.2 +042600 MOVE "E04" TO E-POS NC2104.2 +042700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +042800 MOVE "F07" TO F-POS NC2104.2 +042900 ELSE NC2104.2 +043000 MOVE "F08" TO F-POS NC2104.2 +043100 ELSE NC2104.2 +043200 MOVE "C2" TO C-POS NC2104.2 +043300 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +043400 MOVE "D03" TO D-POS NC2104.2 +043500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +043600 MOVE "E05" TO E-POS NC2104.2 +043700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +043800 MOVE "F09" TO F-POS NC2104.2 +043900 ELSE NC2104.2 +044000 MOVE "F10" TO F-POS NC2104.2 +044100 ELSE NC2104.2 +044200 MOVE "E06" TO E-POS NC2104.2 +044300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +044400 MOVE "F11" TO F-POS NC2104.2 +044500 ELSE NC2104.2 +044600 MOVE "F12" TO F-POS NC2104.2 +044700 ELSE NC2104.2 +044800 MOVE "D04" TO D-POS NC2104.2 +044900 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +045000 MOVE "E07" TO E-POS NC2104.2 +045100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +045200 MOVE "F13" TO F-POS NC2104.2 +045300 ELSE NC2104.2 +045400 MOVE "F14" TO F-POS NC2104.2 +045500 ELSE NC2104.2 +045600 MOVE "E08" TO E-POS NC2104.2 +045700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +045800 MOVE "F15" TO F-POS NC2104.2 +045900 ELSE NC2104.2 +046000 MOVE "F16" TO F-POS NC2104.2 +046100 ELSE NC2104.2 +046200 MOVE "B2" TO B-POS NC2104.2 +046300 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +046400 MOVE "C3" TO C-POS NC2104.2 +046500 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +046600 MOVE "D05" TO D-POS NC2104.2 +046700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +046800 MOVE "E09" TO E-POS NC2104.2 +046900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +047000 MOVE "F17" TO F-POS NC2104.2 +047100 ELSE NC2104.2 +047200 MOVE "F18" TO F-POS NC2104.2 +047300 ELSE NC2104.2 +047400 MOVE "E10" TO E-POS NC2104.2 +047500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +047600 MOVE "F19" TO F-POS NC2104.2 +047700 ELSE NC2104.2 +047800 MOVE "F20" TO F-POS NC2104.2 +047900 ELSE NC2104.2 +048000 MOVE "D06" TO D-POS NC2104.2 +048100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +048200 MOVE "E11" TO E-POS NC2104.2 +048300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +048400 MOVE "F21" TO F-POS NC2104.2 +048500 ELSE NC2104.2 +048600 MOVE "F22" TO F-POS NC2104.2 +048700 ELSE NC2104.2 +048800 MOVE "E12" TO E-POS NC2104.2 +048900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +049000 MOVE "F23" TO F-POS NC2104.2 +049100 ELSE NC2104.2 +049200 MOVE "F24" TO F-POS NC2104.2 +049300 ELSE NC2104.2 +049400 MOVE "C4" TO C-POS NC2104.2 +049500 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +049600 MOVE "D07" TO D-POS NC2104.2 +049700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +049800 MOVE "E13" TO E-POS NC2104.2 +049900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +050000 MOVE "F25" TO F-POS NC2104.2 +050100 ELSE NC2104.2 +050200 MOVE "F26" TO F-POS NC2104.2 +050300 ELSE NC2104.2 +050400 MOVE "E14" TO E-POS NC2104.2 +050500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +050600 MOVE "F27" TO F-POS NC2104.2 +050700 ELSE NC2104.2 +050800 MOVE "F28" TO F-POS NC2104.2 +050900 ELSE NC2104.2 +051000 MOVE "D08" TO D-POS NC2104.2 +051100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +051200 MOVE "E15" TO E-POS NC2104.2 +051300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +051400 MOVE "F29" TO F-POS NC2104.2 +051500 ELSE NC2104.2 +051600 MOVE "F30" TO F-POS NC2104.2 +051700 ELSE NC2104.2 +051800 MOVE "E16" TO E-POS NC2104.2 +051900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +052000 MOVE "F31" TO F-POS NC2104.2 +052100 ELSE NC2104.2 +052200 MOVE "F32" TO F-POS NC2104.2 +052300 ELSE NC2104.2 +052400 MOVE "A2" TO A-POS NC2104.2 +052500 IF DATANAME-B EQUAL TO ONE-B NC2104.2 +052600 MOVE "B3" TO B-POS NC2104.2 +052700 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +052800 MOVE "C5" TO C-POS NC2104.2 +052900 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +053000 MOVE "D09" TO D-POS NC2104.2 +053100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +053200 MOVE "E17" TO E-POS NC2104.2 +053300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +053400 MOVE "F33" TO F-POS NC2104.2 +053500 ELSE NC2104.2 +053600 MOVE "F34" TO F-POS NC2104.2 +053700 ELSE NC2104.2 +053800 MOVE "E18" TO E-POS NC2104.2 +053900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +054000 MOVE "F35" TO F-POS NC2104.2 +054100 ELSE NC2104.2 +054200 MOVE "F36" TO F-POS NC2104.2 +054300 ELSE NC2104.2 +054400 MOVE "D10" TO D-POS NC2104.2 +054500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +054600 MOVE "E19" TO E-POS NC2104.2 +054700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +054800 MOVE "F37" TO F-POS NC2104.2 +054900 ELSE NC2104.2 +055000 MOVE "F38" TO F-POS NC2104.2 +055100 ELSE NC2104.2 +055200 MOVE "E20" TO E-POS NC2104.2 +055300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +055400 MOVE "F39" TO F-POS NC2104.2 +055500 ELSE NC2104.2 +055600 MOVE "F40" TO F-POS NC2104.2 +055700 ELSE NC2104.2 +055800 MOVE "C6" TO C-POS NC2104.2 +055900 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +056000 MOVE "D11" TO D-POS NC2104.2 +056100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +056200 MOVE "E21" TO E-POS NC2104.2 +056300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +056400 MOVE "F41" TO F-POS NC2104.2 +056500 ELSE NC2104.2 +056600 MOVE "F42" TO F-POS NC2104.2 +056700 ELSE NC2104.2 +056800 MOVE "E22" TO E-POS NC2104.2 +056900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +057000 MOVE "F43" TO F-POS NC2104.2 +057100 ELSE NC2104.2 +057200 MOVE "F44" TO F-POS NC2104.2 +057300 ELSE NC2104.2 +057400 MOVE "D12" TO D-POS NC2104.2 +057500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +057600 MOVE "E23" TO E-POS NC2104.2 +057700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +057800 MOVE "F45" TO F-POS NC2104.2 +057900 ELSE NC2104.2 +058000 MOVE "F46" TO F-POS NC2104.2 +058100 ELSE NC2104.2 +058200 MOVE "E24" TO E-POS NC2104.2 +058300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +058400 MOVE "F47" TO F-POS NC2104.2 +058500 ELSE NC2104.2 +058600 MOVE "F48" TO F-POS NC2104.2 +058700 ELSE NC2104.2 +058800 MOVE "B4" TO B-POS NC2104.2 +058900 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +059000 MOVE "C7" TO C-POS NC2104.2 +059100 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +059200 MOVE "D13" TO D-POS NC2104.2 +059300 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +059400 MOVE "E25" TO E-POS NC2104.2 +059500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +059600 MOVE "F49" TO F-POS NC2104.2 +059700 ELSE NC2104.2 +059800 MOVE "F50" TO F-POS NC2104.2 +059900 ELSE NC2104.2 +060000 MOVE "E26" TO E-POS NC2104.2 +060100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +060200 MOVE "F51" TO F-POS NC2104.2 +060300 ELSE NC2104.2 +060400 MOVE "F52" TO F-POS NC2104.2 +060500 ELSE NC2104.2 +060600 MOVE "D14" TO D-POS NC2104.2 +060700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +060800 MOVE "E27" TO E-POS NC2104.2 +060900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +061000 MOVE "F53" TO F-POS NC2104.2 +061100 ELSE NC2104.2 +061200 MOVE "F54" TO F-POS NC2104.2 +061300 ELSE NC2104.2 +061400 MOVE "E28" TO E-POS NC2104.2 +061500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +061600 MOVE "F55" TO F-POS NC2104.2 +061700 ELSE NC2104.2 +061800 MOVE "F56" TO F-POS NC2104.2 +061900 ELSE NC2104.2 +062000 MOVE "C8" TO C-POS NC2104.2 +062100 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +062200 MOVE "D15" TO D-POS NC2104.2 +062300 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +062400 MOVE "E29" TO E-POS NC2104.2 +062500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +062600 MOVE "F57" TO F-POS NC2104.2 +062700 ELSE NC2104.2 +062800 MOVE "F58" TO F-POS NC2104.2 +062900 ELSE NC2104.2 +063000 MOVE "E30" TO E-POS NC2104.2 +063100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +063200 MOVE "F59" TO F-POS NC2104.2 +063300 ELSE NC2104.2 +063400 MOVE "F60" TO F-POS NC2104.2 +063500 ELSE NC2104.2 +063600 MOVE "D16" TO D-POS NC2104.2 +063700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +063800 MOVE "E31" TO E-POS NC2104.2 +063900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +064000 MOVE "F61" TO F-POS NC2104.2 +064100 ELSE NC2104.2 +064200 MOVE "F62" TO F-POS NC2104.2 +064300 ELSE NC2104.2 +064400 MOVE "E32" TO E-POS NC2104.2 +064500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +064600 MOVE "F63" TO F-POS NC2104.2 +064700 ELSE NC2104.2 +064800 MOVE "F64" TO F-POS. NC2104.2 +064900 IF BUILT-TABLE EQUAL TO CORRECT-ENTRY (SUB-SCRIPT) NC2104.2 +065000 PERFORM PASS NC2104.2 +065100 GO TO IF-WRITE-GF-X. NC2104.2 +065200 GO TO IF-FAIL-GF-X. NC2104.2 +065300 IF-DELETE-GF-X. NC2104.2 +065400 MOVE 63 TO PAR-NUMBER. NC2104.2 +065500 PERFORM DE-LETE. NC2104.2 +065600 ADD 63 TO DELETE-COUNTER. NC2104.2 +065700 GO TO IF-WRITE-GF-X. NC2104.2 +065800 IF-FAIL-GF-X. NC2104.2 +065900 MOVE BUILT-TABLE TO COMPUTED-A. NC2104.2 +066000 MOVE CORRECT-ENTRY (SUB-SCRIPT) TO CORRECT-A. NC2104.2 +066100 PERFORM FAIL. NC2104.2 +066200 IF-WRITE-GF-X. NC2104.2 +066300 ADD 1 TO PAR-NUMBER. NC2104.2 +066400 MOVE PARAGRAPH-NAME TO PAR-NAME. NC2104.2 +066500 PERFORM PRINT-DETAIL. NC2104.2 +066600 IF PAR-NUMBER EQUAL TO 64 GO TO IF-INIT-GF-Y. NC2104.2 +066700 ADD 1 TO SUB-SCRIPT. NC2104.2 +066800 MOVE SPACES TO BUILT-TABLE. NC2104.2 +066900 ADD 1 TO ONE-X. NC2104.2 +067000 IF ONE-F EQUAL TO 2 ADD 8 TO ONE-X. NC2104.2 +067100 IF ONE-E EQUAL TO 2 ADD 80 TO ONE-X. NC2104.2 +067200 IF ONE-D EQUAL TO 2 ADD 800 TO ONE-X. NC2104.2 +067300 IF ONE-C EQUAL TO 2 ADD 8000 TO ONE-X. NC2104.2 +067400 IF ONE-B EQUAL TO 2 ADD 80000 TO ONE-X. NC2104.2 +067500 GO TO IF-INIT-GF-X. NC2104.2 +067600* NC2104.2 +067700 IF-INIT-GF-Y. NC2104.2 +067800 MOVE "VI-89 6.15.4 GR1(C)" TO ANSI-REFERENCE. NC2104.2 +067900 ADD 1 TO PAR-NUMBER. NC2104.2 +068000 MOVE 22 TO ACCUM-DATANAME. NC2104.2 +068100 IF-TEST-GF-Y. NC2104.2 +068200 MOVE "FALSE" TO T-F. NC2104.2 +068300 IF ACCUM-DATANAME NOT EQUAL TO 1 NC2104.2 +068400 IF ACCUM-DATANAME NOT EQUAL TO 2 NC2104.2 +068500 IF ACCUM-DATANAME NOT EQUAL TO 3 NC2104.2 +068600 IF ACCUM-DATANAME NOT EQUAL TO 4 NC2104.2 +068700 IF ACCUM-DATANAME NOT EQUAL TO 5 NC2104.2 +068800 IF ACCUM-DATANAME NOT EQUAL TO 6 NC2104.2 +068900 IF ACCUM-DATANAME NOT EQUAL TO 7 NC2104.2 +069000 IF ACCUM-DATANAME NOT EQUAL TO 8 NC2104.2 +069100 IF ACCUM-DATANAME NOT EQUAL TO 9 NC2104.2 +069200 IF ACCUM-DATANAME NOT EQUAL TO 10 NC2104.2 +069300 IF ACCUM-DATANAME NOT EQUAL TO 11 NC2104.2 +069400 IF ACCUM-DATANAME NOT EQUAL TO 12 NC2104.2 +069500 IF ACCUM-DATANAME NOT EQUAL TO 13 NC2104.2 +069600 IF ACCUM-DATANAME NOT EQUAL TO 14 NC2104.2 +069700 IF ACCUM-DATANAME NOT EQUAL TO 15 NC2104.2 +069800 IF ACCUM-DATANAME NOT EQUAL TO 16 NC2104.2 +069900 IF ACCUM-DATANAME NOT EQUAL TO 17 NC2104.2 +070000 IF ACCUM-DATANAME NOT EQUAL TO 18 NC2104.2 +070100 IF ACCUM-DATANAME NOT EQUAL TO 19 NC2104.2 +070200 IF ACCUM-DATANAME NOT EQUAL TO 20 NC2104.2 +070300 IF ACCUM-DATANAME NOT EQUAL TO 21 NC2104.2 +070400 MOVE "TRUE" TO T-F. NC2104.2 +070500 IF ACCUM-DATANAME EQUAL TO 22 AND T-F EQUAL TO "TRUE" NC2104.2 +070600 PERFORM PASS NC2104.2 +070700 PERFORM IF-WRITE-GF-Y NC2104.2 +070800 SUBTRACT 1 FROM ACCUM-DATANAME NC2104.2 +070900 GO TO IF-TEST-GF-Y. NC2104.2 +071000 IF ACCUM-DATANAME LESS THAN 22 AND T-F EQUAL TO "FALSE" NC2104.2 +071100 PERFORM PASS NC2104.2 +071200 GO TO IF-WRITE-GF-Y NC2104.2 +071300 ELSE GO TO IF-FAIL-GF-Y. NC2104.2 +071400 IF-DELETE-GF-Y. NC2104.2 +071500 ADD 21 TO PAR-NUMBER. NC2104.2 +071600 PERFORM DE-LETE. NC2104.2 +071700 ADD 21 TO DELETE-COUNTER. NC2104.2 +071800 MOVE 1 TO ACCUM-DATANAME. NC2104.2 +071900 GO TO IF-WRITE-GF-Y. NC2104.2 +072000 IF-FAIL-GF-Y. NC2104.2 +072100 MOVE "*****" TO COMPUTED-A CORRECT-A. NC2104.2 +072200 MOVE ACCUM-DATANAME TO CHECK-VALU. NC2104.2 +072300 MOVE CHECK-PARA TO RE-MARK. NC2104.2 +072400 PERFORM FAIL. NC2104.2 +072500 IF-WRITE-GF-Y. NC2104.2 +072600 MOVE PARAGRAPH-NAME TO PAR-NAME. NC2104.2 +072700 ADD 1 TO PAR-NUMBER. NC2104.2 +072800 PERFORM PRINT-DETAIL. NC2104.2 +072900 IF ACCUM-DATANAME EQUAL TO 1 GO TO TEST-EXIT. NC2104.2 +073000 SUBTRACT 1 FROM ACCUM-DATANAME. NC2104.2 +073100 IF-RETURN-GF-Y. NC2104.2 +073200 GO TO IF-TEST-GF-Y. NC2104.2 +073300 TEST-EXIT. NC2104.2 +073400 EXIT. NC2104.2 +073500 CCVS-EXIT SECTION. NC2104.2 +073600 CCVS-999999. NC2104.2 +073700 GO TO CLOSE-FILES. NC2104.2 +*END-OF,NC210A +*HEADER,COBOL,NC211A +000100 IDENTIFICATION DIVISION. NC2114.2 +000200 PROGRAM-ID. NC2114.2 +000300 NC211A. NC2114.2 +000400**************************************************************** NC2114.2 +000500* * NC2114.2 +000600* VALIDATION FOR:- * NC2114.2 +000700* * NC2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +000900* * NC2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2114.2 +001100* * NC2114.2 +001200**************************************************************** NC2114.2 +001300* * NC2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2114.2 +001500* * NC2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2114.2 +001900* * NC2114.2 +002000**************************************************************** NC2114.2 +002100* NC2114.2 +002200* * NC2114.2 +002300* PROGRAM NC211A TESTS THE GENERAL FORMAT OF THE "IF" * NC2114.2 +002400* STATEMENT USING COMPOUND CONDITIONAL STATEMENTS WITH * NC2114.2 +002500* ABREVIATED CONDITIONS, CONDITION NAMES AND QUALIFIED * NC2114.2 +002600* DATA-NAMES. * NC2114.2 +002700* * NC2114.2 +002800**************************************************************** NC2114.2 +002900 ENVIRONMENT DIVISION. NC2114.2 +003000 CONFIGURATION SECTION. NC2114.2 +003100 SOURCE-COMPUTER. NC2114.2 +003200 XXXXX082. NC2114.2 +003300 OBJECT-COMPUTER. NC2114.2 +003400 XXXXX083. NC2114.2 +003500ASPECIAL-NAMES. NC2114.2 +003600A XXXXX051 NC2114.2 +003700A IS WRK-SWITCH-1 NC2114.2 +003800A ON STATUS IS ON-WRK-SWITCH-1 NC2114.2 +003900A OFF STATUS IS OFF-WRK-SWITCH-1 NC2114.2 +004000A XXXXX052 NC2114.2 +004100A IS WRK-SWITCH-2 NC2114.2 +004200A OFF STATUS IS OFF-WRK-SWITCH-2. NC2114.2 +004300 INPUT-OUTPUT SECTION. NC2114.2 +004400 FILE-CONTROL. NC2114.2 +004500 SELECT PRINT-FILE ASSIGN TO NC2114.2 +004600 XXXXX055. NC2114.2 +004700 DATA DIVISION. NC2114.2 +004800 FILE SECTION. NC2114.2 +004900 FD PRINT-FILE. NC2114.2 +005000 01 PRINT-REC PICTURE X(120). NC2114.2 +005100 01 DUMMY-RECORD PICTURE X(120). NC2114.2 +005200 WORKING-STORAGE SECTION. NC2114.2 +005300 77 WRK-DS-02V00 PICTURE S99. NC2114.2 +005400 88 TEST-2NUC-COND-99 VALUE 99. NC2114.2 +005500 77 WRK-DS-06V06 PICTURE 9(6)V9(6). NC2114.2 +005600 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2114.2 +005700 PICTURE S9(12). NC2114.2 +005800 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2114.2 +005900 77 WRK-DS-01V00 PICTURE S9. NC2114.2 +006000 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2114.2 +006100 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2114.2 +006200 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2114.2 +006300 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2114.2 +006400 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2114.2 +006500 77 WRK-XN-00001 PICTURE X. NC2114.2 +006600 77 WRK-XN-00005 PICTURE X(5). NC2114.2 +006700 77 MINUS-TWO PICTURE S9 VALUE -2. NC2114.2 +006800 77 MINUS-ONE PICTURE S9 VALUE -1. NC2114.2 +006900 77 MINUS-UNO PICTURE S9 VALUE -1. NC2114.2 +007000 77 NAUGHT PICTURE S9 VALUE 0. NC2114.2 +007100 77 NOTHING PICTURE S9 VALUE ZERO. NC2114.2 +007200 77 ONE PICTURE S9 VALUE 1. NC2114.2 +007300 77 UNO PICTURE S9 VALUE +1. NC2114.2 +007400 77 TWO PICTURE 9 VALUE 2. NC2114.2 +007500 77 DOS PICTURE S9 VALUE +2. NC2114.2 +007600 77 THREE PICTURE 9 VALUE 3. NC2114.2 +007700 77 TRES PICTURE S9 VALUE +3. NC2114.2 +007800 77 FOUR PICTURE S9 VALUE 4. NC2114.2 +007900 77 QUATROS PICTURE S9 VALUE +4. NC2114.2 +008000 77 FIVE PICTURE S9 VALUE 5. NC2114.2 +008100 77 SIX PICTURE S9 VALUE 6. NC2114.2 +008200 77 SEVEN PICTURE 9 VALUE 7. NC2114.2 +008300 77 EIGHT PICTURE S9 VALUE 8. NC2114.2 +008400 77 NINE PICTURE 9 VALUE 9. NC2114.2 +008500 77 TEN PICTURE 99 VALUE 10. NC2114.2 +008600 77 ONE-THIRD PIC SV9(18) VALUE +.333333333333333333. NC2114.2 +008700 77 THREE-SEVENTHS PIC SV9(10) VALUE +.4285714286. NC2114.2 +008800 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2114.2 +008900 77 XRAY PICTURE IS X. NC2114.2 +009000 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2114.2 +009100 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2114.2 +009200 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2114.2 +009300 77 IF-D4 PICTURE X(15) VALUE " ". NC2114.2 +009400 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2114.2 +009500 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2114.2 +009600 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2114.2 +009700 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2114.2 +009800 77 IF-D9 PICTURE X(3) VALUE "123". NC2114.2 +009900 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2114.2 +010000 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2114.2 +010100 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2114.2 +010200 77 IF-D15 PICTURE S999PP VALUE 12300. NC2114.2 +010300 77 IF-D16 PICTURE PP99 VALUE .0012. NC2114.2 +010400 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2114.2 +010500 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2114.2 +010600 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2114.2 +010700 77 IF-D23 PICTURE $9,9B9.90+. NC2114.2 +010800 77 IF-D24 PICTURE X(10) VALUE "l1,2 3.40+". NC2114.2 +010900 77 IF-D25 PICTURE ABABX0A. NC2114.2 +011000 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2114.2 +011100 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2114.2 +011200 USAGE IS COMPUTATIONAL. NC2114.2 +011300 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2114.2 +011400 77 IF-D31 PICTURE S9(6) VALUE -123. NC2114.2 +011500 77 IF-D32 PICTURE S9(4)V99. NC2114.2 +011600 88 A; VALUE 1. NC2114.2 +011700 88 B VALUES ARE 2 THRU 4. NC2114.2 +011800 88 C VALUE IS ZERO. NC2114.2 +011900 88 D VALUE IS +12.34. NC2114.2 +012000 88 E VALUE IS .01, .11, .21 .81. NC2114.2 +012100 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2114.2 +012200 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2114.2 +012300 77 IF-D33 PICTURE X(4). NC2114.2 +012400 88 B VALUE QUOTE. NC2114.2 +012500 88 C VALUE SPACE. NC2114.2 +012600 88 D VALUE ALL "BAC". NC2114.2 +012700 77 IF-D34 PICTURE A(4). NC2114.2 +012800 88 B VALUE "A A ". NC2114.2 +012900 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2114.2 +013000 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2114.2 +013100 77 CCON-1 PICTURE 99 VALUE 11. NC2114.2 +013200 77 CCON-2 PICTURE 99 VALUE 12. NC2114.2 +013300 77 CCON-3 PICTURE 99 VALUE 13. NC2114.2 +013400 77 CCON-4 PICTURE 99 VALUE 14. NC2114.2 +013500 77 CLASS-1 PICTURE X(5). NC2114.2 +013600 77 CLASS-2 PICTURE X(5). NC2114.2 +013700 77 CLASS-3 PICTURE X(5). NC2114.2 +013800 77 SIGN-1 PICTURE S9(5). NC2114.2 +013900 77 SIGN-2 PICTURE S9(5). NC2114.2 +014000 77 SIGN-3 PICTURE S9(5). NC2114.2 +014100 77 AZE PICTURE X(5) VALUE "AAAAA". NC2114.2 +014200 77 BEEZE PICTURE X(5) VALUE "BBBBB". NC2114.2 +014300 77 CEEZE PICTURE X(5) VALUE "CCCCC". NC2114.2 +014400 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2114.2 +014500 01 IF-TABLE. NC2114.2 +014600 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2114.2 +014700 01 QUOTE-DATA. NC2114.2 +014800 02 QU-1 PICTURE X(3) VALUE "123". NC2114.2 +014900 02 QU-2 PICTURE X VALUE QUOTE. NC2114.2 +015000 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2114.2 +015100 01 IF-D10. NC2114.2 +015200 02 D1 PICTURE X(2) VALUE "01". NC2114.2 +015300 02 D2 PICTURE X(2) VALUE "23". NC2114.2 +015400 02 D3. NC2114.2 +015500 03 D4 PICTURE X(4) VALUE "4567". NC2114.2 +015600 03 D5 PICTURE X(4) VALUE "8912". NC2114.2 +015700 01 IF-D12. NC2114.2 +015800 02 D1 PICTURE X(3) VALUE "ABC". NC2114.2 +015900 02 D2. NC2114.2 +016000 03 D3. NC2114.2 +016100 04 D4 PICTURE XX VALUE "DE". NC2114.2 +016200 04 D5 PICTURE X VALUE "F". NC2114.2 +016300 01 IF-D20. NC2114.2 +016400 02 FILLER PICTURE 9(5) VALUE ZERO. NC2114.2 +016500 02 D1 PICTURE 9(2) VALUE 12. NC2114.2 +016600 02 D2 PICTURE 9 VALUE 3. NC2114.2 +016700 02 D3 PICTURE 9(2) VALUE 45. NC2114.2 +016800 01 IF-D21. NC2114.2 +016900 02 D1 PICTURE 9(5) VALUE ZEROS. NC2114.2 +017000 02 D2 PICTURE 9(5) VALUE 12345. NC2114.2 +017100 01 IF-D22. NC2114.2 +017200 02 D1 PICTURE A(2) VALUE "AB". NC2114.2 +017300 02 D2 PICTURE A(4) VALUE "CDEF". NC2114.2 +017400 01 IF-D35. NC2114.2 +017500 02 AA PICTURE X(2). NC2114.2 +017600 88 A1 VALUE "AA". NC2114.2 +017700 88 A2 VALUE "AB". NC2114.2 +017800 02 BB PICTURE IS X(2). NC2114.2 +017900 88 B1 VALUE "CC". NC2114.2 +018000 88 B2 VALUE "CD". NC2114.2 +018100 02 BB-2 REDEFINES BB. NC2114.2 +018200 03 AAA PICTURE X. NC2114.2 +018300 88 AA1 VALUE "A". NC2114.2 +018400 88 AA2 VALUE "C". NC2114.2 +018500 03 BBB PICTURE X. NC2114.2 +018600 88 BB1 VALUE "B". NC2114.2 +018700 88 BB2 VALUE "D". NC2114.2 +018800 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2114.2 +018900- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2114.2 +019000- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2114.2 +019100 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2114.2 +019200 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2114.2 +019300 88 IF-D40A VALUE ZERO THRU 10000. NC2114.2 +019400 88 IF-D40B VALUE 10001 THRU 99999. NC2114.2 +019500 88 IF-D40C VALUE 99999. NC2114.2 +019600 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2114.2 +019700 01 PERFORM2 PICTURE S999 VALUE 20. NC2114.2 +019800 01 PERFORM3 PICTURE 9 VALUE 5. NC2114.2 +019900 01 PERFORM4 PICTURE S99V9. NC2114.2 +020000 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2114.2 +020100 01 PERFORM6 PICTURE 99V9. NC2114.2 +020200 01 PERFORM7. NC2114.2 +020300 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2114.2 +020400 01 PERFORM9 PICTURE 9 VALUE 3. NC2114.2 +020500 01 PERFORM10 PICTURE S9 VALUE -1. NC2114.2 +020600 01 PERFORM11 PICTURE 99 VALUE 6. NC2114.2 +020700 01 PERFORM12. NC2114.2 +020800 02 PERFORM13 OCCURS 4 TIMES. NC2114.2 +020900 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2114.2 +021000 03 PERFORM15 OCCURS 10 TIMES. NC2114.2 +021100 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2114.2 +021200 01 PERFORM-KEY PICTURE 9. NC2114.2 +021300 01 RECEIVING-TABLE. NC2114.2 +021400 03 TBL-ELEMEN-A. NC2114.2 +021500 05 TBL-ELEMEN-B PICTURE X(18). NC2114.2 +021600 05 TBL-ELEMEN-C PICTURE X(18). NC2114.2 +021700 03 TBL-ELEMEN-D. NC2114.2 +021800 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2114.2 +021900 01 LITERAL-SPLITTER. NC2114.2 +022000 02 PART1 PICTURE X(20). NC2114.2 +022100 02 PART2 PICTURE X(20). NC2114.2 +022200 02 PART3 PICTURE X(20). NC2114.2 +022300 02 PART4 PICTURE X(20). NC2114.2 +022400 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2114.2 +022500 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2114.2 +022600 01 GRP-FOR-88-LEVELS. NC2114.2 +022700 03 WRK-DS-02V00-COND PICTURE 99. NC2114.2 +022800 88 COND-1 VALUE IS 01 THRU 05. NC2114.2 +022900 88 COND-2 VALUES ARE 06 THRU 10 NC2114.2 +023000 16 THRU 20 00. NC2114.2 +023100 88 COND-3 VALUES 11 THRU 15. NC2114.2 +023200 01 GRP-MOVE-CONSTANTS. NC2114.2 +023300 03 GRP-GROUP-MOVE-FROM. NC2114.2 +023400 04 GRP-ALPHABETIC. NC2114.2 +023500 05 ALPHABET-AN-00026 PICTURE A(26) NC2114.2 +023600 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2114.2 +023700 04 GRP-NUMERIC. NC2114.2 +023800 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2114.2 +023900 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2114.2 +024000 PICTURE 9(6)V9999. NC2114.2 +024100 04 GRP-ALPHANUMERIC. NC2114.2 +024200 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2114.2 +024300 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=l,;.()/* 0123456789". NC2114.2 +024400 05 FILLER PICTURE X VALUE QUOTE. NC2114.2 +024500 01 GRP-FOR-2N058. NC2114.2 +024600 02 SUB-GRP-FOR-2N058-A. NC2114.2 +024700 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2114.2 +024800 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2114.2 +024900 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2114.2 +025000 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2114.2 +025100 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2114.2 +025200 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2114.2 +025300 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2114.2 +025400 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2114.2 +025500 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2114.2 +025600 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2114.2 +025700 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2114.2 +025800 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2114.2 +025900 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2114.2 +026000 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2114.2 +026100 02 SUB-GRP-FOR-2N058-B. NC2114.2 +026200 03 SUB-SUB-BA. NC2114.2 +026300 04 ELEM-FOR-2N058-A PICTURE 999. NC2114.2 +026400 04 ELEM-FOR-2N058-B PICTURE XXX. NC2114.2 +026500 04 ELEM-FOR-2N058-C PICTURE XXX. NC2114.2 +026600 04 ELEM-FOR-2N058-D PICTURE X(6). NC2114.2 +026700 03 SUB-SUB-BB. NC2114.2 +026800 04 ELEM-FOR-2N058-E PICTURE XXX. NC2114.2 +026900 04 ELEM-FOR-2N058-F PICTURE XXX. NC2114.2 +027000 04 ELEM-FOR-2N058-G PICTURE XXX. NC2114.2 +027100 04 ELEM-FOR-2N058-H PICTURE 999. NC2114.2 +027200 03 SUB-SUB-BC. NC2114.2 +027300 04 ELEM-FOR-2N058-I PICTURE XXX. NC2114.2 +027400 04 ELEM-FOR-2N058-J PICTURE XXX. NC2114.2 +027500 04 ELEM-FOR-2N058-K PICTURE XXX. NC2114.2 +027600 04 ELEM-FOR-2N058-L PICTURE XXX. NC2114.2 +027700 04 ELEM-FOR-2N058-M PICTURE XXX. NC2114.2 +027800 04 ELEM-FOR-2N058-N PICTURE XXX. NC2114.2 +027900 01 CHARACTER-BREAKDOWN-S. NC2114.2 +028000 02 FIRST-20S PICTURE X(20). NC2114.2 +028100 02 SECOND-20S PICTURE X(20). NC2114.2 +028200 02 THIRD-20S PICTURE X(20). NC2114.2 +028300 02 FOURTH-20S PICTURE X(20). NC2114.2 +028400 02 FIFTH-20S PICTURE X(20). NC2114.2 +028500 02 SIXTH-20S PICTURE X(20). NC2114.2 +028600 02 SEVENTH-20S PICTURE X(20). NC2114.2 +028700 02 EIGHTH-20S PICTURE X(20). NC2114.2 +028800 02 NINTH-20S PICTURE X(20). NC2114.2 +028900 02 TENTH-20S PICTURE X(20). NC2114.2 +029000 01 CHARACTER-BREAKDOWN-R. NC2114.2 +029100 02 FIRST-20R PICTURE X(20). NC2114.2 +029200 02 SECOND-20R PICTURE X(20). NC2114.2 +029300 02 THIRD-20R PICTURE X(20). NC2114.2 +029400 02 FOURTH-20R PICTURE X(20). NC2114.2 +029500 02 FIFTH-20R PICTURE X(20). NC2114.2 +029600 02 SIXTH-20R PICTURE X(20). NC2114.2 +029700 02 SEVENTH-20R PICTURE X(20). NC2114.2 +029800 02 EIGHTH-20R PICTURE X(20). NC2114.2 +029900 02 NINTH-20R PICTURE X(20). NC2114.2 +030000 02 TENTH-20R PICTURE X(20). NC2114.2 +030100 01 TABLE-80. NC2114.2 +030200 02 ELMT OCCURS 3 TIMES PIC 9. NC2114.2 +030300 88 A80 VALUES ARE ZERO THRU 7. NC2114.2 +030400 88 B80 VALUE 8. NC2114.2 +030500 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2114.2 +030600 NC2114.2 +030700 01 TABLE-86. NC2114.2 +030800 88 A86 VALUE "ABC". NC2114.2 +030900 88 B86 VALUE "ABCABC". NC2114.2 +031000 88 C86 VALUE " ABC". NC2114.2 +031100 02 DATANAME-86 PIC XXX VALUE "ABC". NC2114.2 +031200 02 DNAME-86. NC2114.2 +031300 03 FILLER PIC X VALUE "A". NC2114.2 +031400 03 FILLER PIC X VALUE "B". NC2114.2 +031500 03 FILLER PIC X VALUE "C". NC2114.2 +031600B01 DNAME-SWITCH PICTURE 9 VALUE 1. NC2114.2 +031700B 88 ON-WRK-SWITCH-1 VALUE 1. NC2114.2 +031800B 88 OFF-WRK-SWITCH-1 VALUE 0. NC2114.2 +031900B01 DNAME-SWITCH2 PICTURE 9 VALUE 0. NC2114.2 +032000B 88 ON-WRK-SWITCH-2 VALUE 1. NC2114.2 +032100B 88 OFF-WRK-SWITCH-2 VALUE 0. NC2114.2 +032200 01 FIGCON-DATA. NC2114.2 +032300 02 SPACE-X PICTURE X(10) VALUE " ". NC2114.2 +032400 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2114.2 +032500 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2114.2 +032600 02 ABC PICTURE XXX VALUE "ABC". NC2114.2 +032700 02 ONE23 PICTURE 9999 VALUE 123. NC2114.2 +032800 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2114.2 +032900 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2114.2 +033000 01 XX-TALLY PIC S9(5) USAGE COMP. NC2114.2 +033100 01 TEST-RESULTS. NC2114.2 +033200 02 FILLER PIC X VALUE SPACE. NC2114.2 +033300 02 FEATURE PIC X(20) VALUE SPACE. NC2114.2 +033400 02 FILLER PIC X VALUE SPACE. NC2114.2 +033500 02 P-OR-F PIC X(5) VALUE SPACE. NC2114.2 +033600 02 FILLER PIC X VALUE SPACE. NC2114.2 +033700 02 PAR-NAME. NC2114.2 +033800 03 FILLER PIC X(19) VALUE SPACE. NC2114.2 +033900 03 PARDOT-X PIC X VALUE SPACE. NC2114.2 +034000 03 DOTVALUE PIC 99 VALUE ZERO. NC2114.2 +034100 02 FILLER PIC X(8) VALUE SPACE. NC2114.2 +034200 02 RE-MARK PIC X(61). NC2114.2 +034300 01 TEST-COMPUTED. NC2114.2 +034400 02 FILLER PIC X(30) VALUE SPACE. NC2114.2 +034500 02 FILLER PIC X(17) VALUE NC2114.2 +034600 " COMPUTED=". NC2114.2 +034700 02 COMPUTED-X. NC2114.2 +034800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2114.2 +034900 03 COMPUTED-N REDEFINES COMPUTED-A NC2114.2 +035000 PIC -9(9).9(9). NC2114.2 +035100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2114.2 +035200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2114.2 +035300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2114.2 +035400 03 CM-18V0 REDEFINES COMPUTED-A. NC2114.2 +035500 04 COMPUTED-18V0 PIC -9(18). NC2114.2 +035600 04 FILLER PIC X. NC2114.2 +035700 03 FILLER PIC X(50) VALUE SPACE. NC2114.2 +035800 01 TEST-CORRECT. NC2114.2 +035900 02 FILLER PIC X(30) VALUE SPACE. NC2114.2 +036000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2114.2 +036100 02 CORRECT-X. NC2114.2 +036200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2114.2 +036300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2114.2 +036400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2114.2 +036500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2114.2 +036600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2114.2 +036700 03 CR-18V0 REDEFINES CORRECT-A. NC2114.2 +036800 04 CORRECT-18V0 PIC -9(18). NC2114.2 +036900 04 FILLER PIC X. NC2114.2 +037000 03 FILLER PIC X(2) VALUE SPACE. NC2114.2 +037100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2114.2 +037200 01 CCVS-C-1. NC2114.2 +037300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2114.2 +037400- "SS PARAGRAPH-NAME NC2114.2 +037500- " REMARKS". NC2114.2 +037600 02 FILLER PIC X(20) VALUE SPACE. NC2114.2 +037700 01 CCVS-C-2. NC2114.2 +037800 02 FILLER PIC X VALUE SPACE. NC2114.2 +037900 02 FILLER PIC X(6) VALUE "TESTED". NC2114.2 +038000 02 FILLER PIC X(15) VALUE SPACE. NC2114.2 +038100 02 FILLER PIC X(4) VALUE "FAIL". NC2114.2 +038200 02 FILLER PIC X(94) VALUE SPACE. NC2114.2 +038300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2114.2 +038400 01 REC-CT PIC 99 VALUE ZERO. NC2114.2 +038500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2114.2 +039000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2114.2 +039100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2114.2 +039200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2114.2 +039300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2114.2 +039400 01 CCVS-H-1. NC2114.2 +039500 02 FILLER PIC X(39) VALUE SPACES. NC2114.2 +039600 02 FILLER PIC X(42) VALUE NC2114.2 +039700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2114.2 +039800 02 FILLER PIC X(39) VALUE SPACES. NC2114.2 +039900 01 CCVS-H-2A. NC2114.2 +040000 02 FILLER PIC X(40) VALUE SPACE. NC2114.2 +040100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2114.2 +040200 02 FILLER PIC XXXX VALUE NC2114.2 +040300 "4.2 ". NC2114.2 +040400 02 FILLER PIC X(28) VALUE NC2114.2 +040500 " COPY - NOT FOR DISTRIBUTION". NC2114.2 +040600 02 FILLER PIC X(41) VALUE SPACE. NC2114.2 +040700 NC2114.2 +040800 01 CCVS-H-2B. NC2114.2 +040900 02 FILLER PIC X(15) VALUE NC2114.2 +041000 "TEST RESULT OF ". NC2114.2 +041100 02 TEST-ID PIC X(9). NC2114.2 +041200 02 FILLER PIC X(4) VALUE NC2114.2 +041300 " IN ". NC2114.2 +041400 02 FILLER PIC X(12) VALUE NC2114.2 +041500 " HIGH ". NC2114.2 +041600 02 FILLER PIC X(22) VALUE NC2114.2 +041700 " LEVEL VALIDATION FOR ". NC2114.2 +041800 02 FILLER PIC X(58) VALUE NC2114.2 +041900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +042000 01 CCVS-H-3. NC2114.2 +042100 02 FILLER PIC X(34) VALUE NC2114.2 +042200 " FOR OFFICIAL USE ONLY ". NC2114.2 +042300 02 FILLER PIC X(58) VALUE NC2114.2 +042400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2114.2 +042500 02 FILLER PIC X(28) VALUE NC2114.2 +042600 " COPYRIGHT 1985 ". NC2114.2 +042700 01 CCVS-E-1. NC2114.2 +042800 02 FILLER PIC X(52) VALUE SPACE. NC2114.2 +042900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2114.2 +043000 02 ID-AGAIN PIC X(9). NC2114.2 +043100 02 FILLER PIC X(45) VALUE SPACES. NC2114.2 +043200 01 CCVS-E-2. NC2114.2 +043300 02 FILLER PIC X(31) VALUE SPACE. NC2114.2 +043400 02 FILLER PIC X(21) VALUE SPACE. NC2114.2 +043500 02 CCVS-E-2-2. NC2114.2 +043600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2114.2 +043700 03 FILLER PIC X VALUE SPACE. NC2114.2 +043800 03 ENDER-DESC PIC X(44) VALUE NC2114.2 +043900 "ERRORS ENCOUNTERED". NC2114.2 +044000 01 CCVS-E-3. NC2114.2 +044100 02 FILLER PIC X(22) VALUE NC2114.2 +044200 " FOR OFFICIAL USE ONLY". NC2114.2 +044300 02 FILLER PIC X(12) VALUE SPACE. NC2114.2 +044400 02 FILLER PIC X(58) VALUE NC2114.2 +044500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +044600 02 FILLER PIC X(13) VALUE SPACE. NC2114.2 +044700 02 FILLER PIC X(15) VALUE NC2114.2 +044800 " COPYRIGHT 1985". NC2114.2 +044900 01 CCVS-E-4. NC2114.2 +045000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2114.2 +045100 02 FILLER PIC X(4) VALUE " OF ". NC2114.2 +045200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2114.2 +045300 02 FILLER PIC X(40) VALUE NC2114.2 +045400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2114.2 +045500 01 XXINFO. NC2114.2 +045600 02 FILLER PIC X(19) VALUE NC2114.2 +045700 "*** INFORMATION ***". NC2114.2 +045800 02 INFO-TEXT. NC2114.2 +045900 04 FILLER PIC X(8) VALUE SPACE. NC2114.2 +046000 04 XXCOMPUTED PIC X(20). NC2114.2 +046100 04 FILLER PIC X(5) VALUE SPACE. NC2114.2 +046200 04 XXCORRECT PIC X(20). NC2114.2 +046300 02 INF-ANSI-REFERENCE PIC X(48). NC2114.2 +046400 01 HYPHEN-LINE. NC2114.2 +046500 02 FILLER PIC IS X VALUE IS SPACE. NC2114.2 +046600 02 FILLER PIC IS X(65) VALUE IS "************************NC2114.2 +046700- "*****************************************". NC2114.2 +046800 02 FILLER PIC IS X(54) VALUE IS "************************NC2114.2 +046900- "******************************". NC2114.2 +047000 01 CCVS-PGM-ID PIC X(9) VALUE NC2114.2 +047100 "NC211A". NC2114.2 +047200 PROCEDURE DIVISION. NC2114.2 +047300 CCVS1 SECTION. NC2114.2 +047400 OPEN-FILES. NC2114.2 +047500 OPEN OUTPUT PRINT-FILE. NC2114.2 +047600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2114.2 +047700 MOVE SPACE TO TEST-RESULTS. NC2114.2 +047800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2114.2 +047900 GO TO CCVS1-EXIT. NC2114.2 +048000 CLOSE-FILES. NC2114.2 +048100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2114.2 +048200 TERMINATE-CCVS. NC2114.2 +048300S EXIT PROGRAM. NC2114.2 +048400STERMINATE-CALL. NC2114.2 +048500 STOP RUN. NC2114.2 +048600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2114.2 +048700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2114.2 +048800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2114.2 +048900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2114.2 +049000 MOVE "****TEST DELETED****" TO RE-MARK. NC2114.2 +049100 PRINT-DETAIL. NC2114.2 +049200 IF REC-CT NOT EQUAL TO ZERO NC2114.2 +049300 MOVE "." TO PARDOT-X NC2114.2 +049400 MOVE REC-CT TO DOTVALUE. NC2114.2 +049500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2114.2 +049600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2114.2 +049700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2114.2 +049800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2114.2 +049900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2114.2 +050000 MOVE SPACE TO CORRECT-X. NC2114.2 +050100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2114.2 +050200 MOVE SPACE TO RE-MARK. NC2114.2 +050300 HEAD-ROUTINE. NC2114.2 +050400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +050500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +050600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2114.2 +050700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2114.2 +050800 COLUMN-NAMES-ROUTINE. NC2114.2 +050900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +051000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +051100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +051200 END-ROUTINE. NC2114.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2114.2 +051400 END-RTN-EXIT. NC2114.2 +051500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +051600 END-ROUTINE-1. NC2114.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2114.2 +051800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2114.2 +051900 ADD PASS-COUNTER TO ERROR-HOLD. NC2114.2 +052000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2114.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2114.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2114.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2114.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2114.2 +052500 END-ROUTINE-12. NC2114.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2114.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2114.2 +052800 MOVE "NO " TO ERROR-TOTAL NC2114.2 +052900 ELSE NC2114.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2114.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2114.2 +053200 PERFORM WRITE-LINE. NC2114.2 +053300 END-ROUTINE-13. NC2114.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2114.2 +053500 MOVE "NO " TO ERROR-TOTAL ELSE NC2114.2 +053600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2114.2 +053700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2114.2 +053800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +053900 IF INSPECT-COUNTER EQUAL TO ZERO NC2114.2 +054000 MOVE "NO " TO ERROR-TOTAL NC2114.2 +054100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2114.2 +054200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2114.2 +054300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +054400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +054500 WRITE-LINE. NC2114.2 +054600 ADD 1 TO RECORD-COUNT. NC2114.2 +054700Y IF RECORD-COUNT GREATER 50 NC2114.2 +054800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2114.2 +054900Y MOVE SPACE TO DUMMY-RECORD NC2114.2 +055000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2114.2 +055100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2114.2 +055200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2114.2 +055300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2114.2 +055400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2114.2 +055500Y MOVE ZERO TO RECORD-COUNT. NC2114.2 +055600 PERFORM WRT-LN. NC2114.2 +055700 WRT-LN. NC2114.2 +055800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2114.2 +055900 MOVE SPACE TO DUMMY-RECORD. NC2114.2 +056000 BLANK-LINE-PRINT. NC2114.2 +056100 PERFORM WRT-LN. NC2114.2 +056200 FAIL-ROUTINE. NC2114.2 +056300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2114.2 +056400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2114.2 +056500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2114.2 +056600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2114.2 +056700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +056800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2114.2 +056900 GO TO FAIL-ROUTINE-EX. NC2114.2 +057000 FAIL-ROUTINE-WRITE. NC2114.2 +057100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2114.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2114.2 +057300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2114.2 +057400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2114.2 +057500 FAIL-ROUTINE-EX. EXIT. NC2114.2 +057600 BAIL-OUT. NC2114.2 +057700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2114.2 +057800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2114.2 +057900 BAIL-OUT-WRITE. NC2114.2 +058000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2114.2 +058100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2114.2 +058200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +058300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2114.2 +058400 BAIL-OUT-EX. EXIT. NC2114.2 +058500 CCVS1-EXIT. NC2114.2 +058600 EXIT. NC2114.2 +058700 SECT-NC211A-001 SECTION. NC2114.2 +058800 NC-211A-001. NC2114.2 +058900 CC--INIT-GF-1. NC2114.2 +059000 MOVE "CC--TEST-GF-1 " TO PAR-NAME. NC2114.2 +059100 MOVE "COMPOUND CONDITIONS" TO FEATURE. NC2114.2 +059200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +059300 PERFORM PRINT-DETAIL. NC2114.2 +059400 MOVE " NOT ABBREVIATED " TO FEATURE. NC2114.2 +059500 MOVE 11 TO CCON-1. NC2114.2 +059600 MOVE 12 TO CCON-2. NC2114.2 +059700 MOVE 13 TO CCON-3. NC2114.2 +059800 CC--TEST-GF-1. NC2114.2 +059900 IF CCON-1 IS LESS THAN CCON-2 AND CCON-3 IS GREATER THAN 10 NC2114.2 +060000 PERFORM PASS NC2114.2 +060100 GO TO CC--WRITE-GF-1. NC2114.2 +060200 GO TO CC--FAIL-GF-1. NC2114.2 +060300 CC--DELETE-GF-1. NC2114.2 +060400 PERFORM DE-LETE. NC2114.2 +060500 GO TO CC--WRITE-GF-1. NC2114.2 +060600 CC--FAIL-GF-1. NC2114.2 +060700 PERFORM FAIL. NC2114.2 +060800 CC--WRITE-GF-1. NC2114.2 +060900 PERFORM PRINT-DETAIL. NC2114.2 +061000* NC2114.2 +061100 CC--INIT-GF-2. NC2114.2 +061200 MOVE "CC--TEST-GF-2 " TO PAR-NAME. NC2114.2 +061300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +061400 MOVE 11 TO CCON-1. NC2114.2 +061500 MOVE 12 TO CCON-2. NC2114.2 +061600 MOVE 13 TO CCON-3. NC2114.2 +061700 CC--TEST-GF-2. NC2114.2 +061800 IF CCON-2 GREATER THAN CCON-1 AND 20 LESS THAN CCON-3 NC2114.2 +061900 GO TO CC--FAIL-GF-2. NC2114.2 +062000 PERFORM PASS. NC2114.2 +062100 GO TO CC--WRITE-GF-2. NC2114.2 +062200 CC--DELETE-GF-2. NC2114.2 +062300 PERFORM DE-LETE. NC2114.2 +062400 GO TO CC--WRITE-GF-2. NC2114.2 +062500 CC--FAIL-GF-2. NC2114.2 +062600 PERFORM FAIL. NC2114.2 +062700 CC--WRITE-GF-2. NC2114.2 +062800 PERFORM PRINT-DETAIL. NC2114.2 +062900* NC2114.2 +063000 CC--INIT-GF-3. NC2114.2 +063100 MOVE "CC--TEST-GF-3 " TO PAR-NAME. NC2114.2 +063200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +063300 MOVE 11 TO CCON-1. NC2114.2 +063400 MOVE 12 TO CCON-2. NC2114.2 +063500 MOVE 13 TO CCON-3. NC2114.2 +063600 CC--TEST-GF-3. NC2114.2 +063700 IF CCON-1 GREATER THAN CCON-2 AND 20 GREATER THAN CCON-3 NC2114.2 +063800 GO TO CC--FAIL-GF-3. NC2114.2 +063900 PERFORM PASS. NC2114.2 +064000 GO TO CC--WRITE-GF-3. NC2114.2 +064100 CC--DELETE-GF-3. NC2114.2 +064200 PERFORM DE-LETE. NC2114.2 +064300 GO TO CC--WRITE-GF-3. NC2114.2 +064400 CC--FAIL-GF-3. NC2114.2 +064500 PERFORM FAIL. NC2114.2 +064600 CC--WRITE-GF-3. NC2114.2 +064700 PERFORM PRINT-DETAIL. NC2114.2 +064800* NC2114.2 +064900 CC--INIT-GF-4. NC2114.2 +065000 MOVE "CC--TEST-GF-4 " TO PAR-NAME. NC2114.2 +065100 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +065200 MOVE 11 TO CCON-1. NC2114.2 +065300 MOVE 13 TO CCON-3. NC2114.2 +065400 CC--TEST-GF-4. NC2114.2 +065500 IF CCON-1 GREATER THAN 10 OR 20 LESS THAN CCON-3 NC2114.2 +065600 PERFORM PASS NC2114.2 +065700 GO TO CC--WRITE-GF-4. NC2114.2 +065800 GO TO CC--FAIL-GF-4. NC2114.2 +065900 CC--DELETE-GF-4. NC2114.2 +066000 PERFORM DE-LETE. NC2114.2 +066100 GO TO CC--WRITE-GF-4. NC2114.2 +066200 CC--FAIL-GF-4. NC2114.2 +066300 PERFORM FAIL. NC2114.2 +066400 CC--WRITE-GF-4. NC2114.2 +066500 PERFORM PRINT-DETAIL. NC2114.2 +066600* NC2114.2 +066700 CC--INIT-GF-5. NC2114.2 +066800 MOVE "CC--TEST-GF-5 " TO PAR-NAME. NC2114.2 +066900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +067000 MOVE 11 TO CCON-1. NC2114.2 +067100 MOVE 12 TO CCON-2. NC2114.2 +067200 MOVE 13 TO CCON-3. NC2114.2 +067300 CC--TEST-GF-5. NC2114.2 +067400 IF CCON-3 LESS THAN CCON-2 OR 20 GREATER THAN CCON-1 NC2114.2 +067500 PERFORM PASS NC2114.2 +067600 GO TO CC--WRITE-GF-5. NC2114.2 +067700 GO TO CC--FAIL-GF-5. NC2114.2 +067800 CC--DELETE-GF-5. NC2114.2 +067900 PERFORM DE-LETE. NC2114.2 +068000 GO TO CC--WRITE-GF-5. NC2114.2 +068100 CC--FAIL-GF-5. NC2114.2 +068200 PERFORM FAIL. NC2114.2 +068300 CC--WRITE-GF-5. NC2114.2 +068400 PERFORM PRINT-DETAIL. NC2114.2 +068500* NC2114.2 +068600 CC--INIT-GF-6. NC2114.2 +068700 MOVE "CC--TEST-GF-6 " TO PAR-NAME. NC2114.2 +068800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +068900 MOVE 11 TO CCON-1. NC2114.2 +069000 MOVE 12 TO CCON-2. NC2114.2 +069100 MOVE 13 TO CCON-3. NC2114.2 +069200 CC--TEST-GF-6. NC2114.2 +069300 IF CCON-1 EQUAL TO 11 AND CCON-3 GREATER THAN 12 OR CCON-2 NC2114.2 +069400 LESS THAN 20 AND CCON-1 GREATER THAN 12 NC2114.2 +069500 PERFORM PASS NC2114.2 +069600 GO TO CC--WRITE-GF-6. NC2114.2 +069700 GO TO CC--FAIL-GF-6. NC2114.2 +069800 CC--DELETE-GF-6. NC2114.2 +069900 PERFORM DE-LETE. NC2114.2 +070000 GO TO CC--WRITE-GF-6. NC2114.2 +070100 CC--FAIL-GF-6. NC2114.2 +070200 PERFORM FAIL. NC2114.2 +070300 CC--WRITE-GF-6. NC2114.2 +070400 PERFORM PRINT-DETAIL. NC2114.2 +070500* NC2114.2 +070600 CC--INIT-GF-7. NC2114.2 +070700 MOVE "CC--TEST-GF-7 " TO PAR-NAME. NC2114.2 +070800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +070900 MOVE 11 TO CCON-1. NC2114.2 +071000 MOVE 12 TO CCON-2. NC2114.2 +071100 MOVE 13 TO CCON-3. NC2114.2 +071200 CC--TEST-GF-7. NC2114.2 +071300 IF CCON-1 LESS THAN 9 AND CCON-3 GREATER THAN 12 OR CCON-2 NC2114.2 +071400 GREATER THAN 10 AND CCON-1 GREATER THAN 8 NC2114.2 +071500 PERFORM PASS NC2114.2 +071600 GO TO CC--WRITE-GF-7. NC2114.2 +071700 GO TO CC--FAIL-GF-7. NC2114.2 +071800 CC--DELETE-GF-7. NC2114.2 +071900 PERFORM DE-LETE. NC2114.2 +072000 GO TO CC--WRITE-GF-7. NC2114.2 +072100 CC--FAIL-GF-7. NC2114.2 +072200 PERFORM FAIL. NC2114.2 +072300 CC--WRITE-GF-7. NC2114.2 +072400 PERFORM PRINT-DETAIL. NC2114.2 +072500* NC2114.2 +072600 CC--INIT-GF-8. NC2114.2 +072700 MOVE "CC--TEST-GF-8 " TO PAR-NAME. NC2114.2 +072800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +072900 MOVE 11 TO CCON-1. NC2114.2 +073000 MOVE 12 TO CCON-2. NC2114.2 +073100 CC--TEST-GF-8. NC2114.2 +073200 IF CCON-1 NOT EQUAL TO 11 OR CCON-2 NOT LESS THAN 10 NC2114.2 +073300 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +073400 GO TO CC--WRITE-GF-8. NC2114.2 +073500 CC--DELETE-GF-8. NC2114.2 +073600 PERFORM DE-LETE. NC2114.2 +073700 GO TO CC--WRITE-GF-8. NC2114.2 +073800 CC--FAIL-GF-8. NC2114.2 +073900 PERFORM FAIL. NC2114.2 +074000 CC--WRITE-GF-8. NC2114.2 +074100 PERFORM PRINT-DETAIL. NC2114.2 +074200* NC2114.2 +074300 CC--INIT-GF-9. NC2114.2 +074400 MOVE "CC--TEST-GF-9 " TO PAR-NAME. NC2114.2 +074500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +074600 MOVE 11 TO CCON-1. NC2114.2 +074700 MOVE 12 TO CCON-2. NC2114.2 +074800 MOVE 13 TO CCON-3. NC2114.2 +074900 CC--TEST-GF-9. NC2114.2 +075000 IF CCON-2 NOT EQUAL TO CCON-3 AND CCON-1 NOT GREATER THAN 12 NC2114.2 +075100 PERFORM PASS NC2114.2 +075200 GO TO CC--WRITE-GF-9. NC2114.2 +075300 GO TO CC--FAIL-GF-9. NC2114.2 +075400 CC--DELETE-GF-9. NC2114.2 +075500 PERFORM DE-LETE. NC2114.2 +075600 GO TO CC--WRITE-GF-9. NC2114.2 +075700 CC--FAIL-GF-9. NC2114.2 +075800 PERFORM FAIL. NC2114.2 +075900 CC--WRITE-GF-9. NC2114.2 +076000 PERFORM PRINT-DETAIL. NC2114.2 +076100* NC2114.2 +076200 CC--INIT-GF-10. NC2114.2 +076300 MOVE "CC--TEST-GF-10" TO PAR-NAME. NC2114.2 +076400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +076500 MOVE 12 TO CCON-2. NC2114.2 +076600 MOVE 13 TO CCON-3. NC2114.2 +076700 CC--TEST-GF-10. NC2114.2 +076800 IF CCON-3 NOT EQUAL TO 13 OR CCON-2 NOT LESS THAN 13 NC2114.2 +076900 GO TO CC--FAIL-GF-10. NC2114.2 +077000 PERFORM PASS. NC2114.2 +077100 GO TO CC--WRITE-GF-10. NC2114.2 +077200 CC--DELETE-GF-10. NC2114.2 +077300 PERFORM DE-LETE. NC2114.2 +077400 GO TO CC--WRITE-GF-10. NC2114.2 +077500 CC--FAIL-GF-10. NC2114.2 +077600 PERFORM FAIL. NC2114.2 +077700 CC--WRITE-GF-10. NC2114.2 +077800 PERFORM PRINT-DETAIL. NC2114.2 +077900* NC2114.2 +078000 CC--INIT-GF-11. NC2114.2 +078100 MOVE "CC--TEST-GF-11" TO PAR-NAME. NC2114.2 +078200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +078300 MOVE " ABBREVIATED " TO FEATURE. NC2114.2 +078400 MOVE 13 TO CCON-3. NC2114.2 +078500 CC--TEST-GF-11. NC2114.2 +078600 IF CCON-3 NOT EQUAL TO 12 AND GREATER THAN 10 NC2114.2 +078700 PERFORM PASS NC2114.2 +078800 GO TO CC--WRITE-GF-11. NC2114.2 +078900 GO TO CC--FAIL-GF-11. NC2114.2 +079000 CC--DELETE-GF-11. NC2114.2 +079100 PERFORM DE-LETE. NC2114.2 +079200 GO TO CC--WRITE-GF-11. NC2114.2 +079300 CC--FAIL-GF-11. NC2114.2 +079400 PERFORM FAIL. NC2114.2 +079500 CC--WRITE-GF-11. NC2114.2 +079600 PERFORM PRINT-DETAIL. NC2114.2 +079700* NC2114.2 +079800 CC--INIT-GF-12. NC2114.2 +079900 MOVE "CC--TEST-GF-12" TO PAR-NAME. NC2114.2 +080000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +080100 MOVE 12 TO CCON-2. NC2114.2 +080200 CC--TEST-GF-12. NC2114.2 +080300 IF CCON-2 LESS THAN 10 OR EQUAL TO 12 PERFORM PASS NC2114.2 +080400 GO TO CC--WRITE-GF-12. NC2114.2 +080500 GO TO CC--FAIL-GF-12. NC2114.2 +080600 CC--DELETE-GF-12. NC2114.2 +080700 PERFORM DE-LETE. NC2114.2 +080800 GO TO CC--WRITE-GF-12. NC2114.2 +080900 CC--FAIL-GF-12. NC2114.2 +081000 PERFORM FAIL. NC2114.2 +081100 CC--WRITE-GF-12. NC2114.2 +081200 PERFORM PRINT-DETAIL. NC2114.2 +081300* NC2114.2 +081400 CC--INIT-GF-13. NC2114.2 +081500 MOVE "CC--TEST-GF-13" TO PAR-NAME. NC2114.2 +081600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +081700 MOVE 11 TO CCON-1. NC2114.2 +081800 MOVE 12 TO CCON-2. NC2114.2 +081900 CC--TEST-GF-13. NC2114.2 +082000 IF CCON-1 EQUAL TO CCON-2 OR 10 OR 11 PERFORM PASS NC2114.2 +082100 GO TO CC--WRITE-GF-13. NC2114.2 +082200 GO TO CC--FAIL-GF-13. NC2114.2 +082300 CC--DELETE-GF-13. NC2114.2 +082400 PERFORM DE-LETE. NC2114.2 +082500 GO TO CC--WRITE-GF-13. NC2114.2 +082600 CC--FAIL-GF-13. NC2114.2 +082700 PERFORM FAIL. NC2114.2 +082800 CC--WRITE-GF-13. NC2114.2 +082900 PERFORM PRINT-DETAIL. NC2114.2 +083000* NC2114.2 +083100 CC--INIT-GF-14. NC2114.2 +083200 MOVE "CC--TEST-GF-14" TO PAR-NAME. NC2114.2 +083300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +083400 MOVE 11 TO CCON-1. NC2114.2 +083500 MOVE 12 TO CCON-2. NC2114.2 +083600 MOVE 13 TO CCON-3. NC2114.2 +083700 CC--TEST-GF-14. NC2114.2 +083800 IF CCON-2 GREATER THAN CCON-3 OR EQUAL TO CCON-1 OR 8 OR NC2114.2 +083900 CCON-3 - 1; PERFORM PASS NC2114.2 +084000 GO TO CC--WRITE-GF-14. NC2114.2 +084100 GO TO CC--FAIL-GF-14. NC2114.2 +084200 CC--DELETE-GF-14. NC2114.2 +084300 PERFORM DE-LETE. NC2114.2 +084400 GO TO CC--WRITE-GF-14. NC2114.2 +084500 CC--FAIL-GF-14. NC2114.2 +084600 PERFORM FAIL. NC2114.2 +084700 CC--WRITE-GF-14. NC2114.2 +084800 PERFORM PRINT-DETAIL. NC2114.2 +084900* NC2114.2 +085000 CC--INIT-GF-15. NC2114.2 +085100 MOVE "CC--TEST-GF-15" TO PAR-NAME. NC2114.2 +085200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +085300 MOVE "ABCDEF" TO IF-D11. NC2114.2 +085400 MOVE "ABC" TO D1 OF IF-D12. NC2114.2 +085500 MOVE "DE" TO D4 OF IF-D12. NC2114.2 +085600 MOVE "F" TO D5 OF IF-D12. NC2114.2 +085700 MOVE "AB" TO D1 OF IF-D22. NC2114.2 +085800 MOVE "CDEF" TO D2 OF IF-D22. NC2114.2 +085900 CC--TEST-GF-15. NC2114.2 +086000 IF IF-D11 EQUAL TO IF-D12 OR IF-D22 AND "ABCDEF" NC2114.2 +086100 PERFORM PASS NC2114.2 +086200 GO TO CC--WRITE-GF-15. NC2114.2 +086300 GO TO CC--FAIL-GF-15. NC2114.2 +086400 CC--DELETE-GF-15. NC2114.2 +086500 PERFORM DE-LETE. NC2114.2 +086600 GO TO CC--WRITE-GF-15. NC2114.2 +086700 CC--FAIL-GF-15. NC2114.2 +086800 PERFORM FAIL. NC2114.2 +086900 CC--WRITE-GF-15. NC2114.2 +087000 PERFORM PRINT-DETAIL. NC2114.2 +087100* NC2114.2 +087200 CC--INIT-GF-16. NC2114.2 +087300 MOVE "CC--TEST-GF-16" TO PAR-NAME. NC2114.2 +087400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +087500 MOVE "ABCDEF" TO IF-D11. NC2114.2 +087600 MOVE "ABC" TO D1 OF IF-D12. NC2114.2 +087700 MOVE "DE" TO D4 OF IF-D12. NC2114.2 +087800 MOVE "F" TO D5 OF IF-D12. NC2114.2 +087900 MOVE "AB" TO D1 OF IF-D22. NC2114.2 +088000 MOVE "CDEF" TO D2 OF IF-D22. NC2114.2 +088100 CC--TEST-GF-16. NC2114.2 +088200 IF IF-D11 NOT EQUAL TO IF-D12 AND IF-D22 OR "ABCDEF" NC2114.2 +088300 PERFORM FAIL NC2114.2 +088400 GO TO CC--WRITE-GF-16. NC2114.2 +088500 GO TO CC--PASS-GF-16. NC2114.2 +088600 CC--DELETE-GF-16. NC2114.2 +088700 PERFORM DE-LETE. NC2114.2 +088800 GO TO CC--WRITE-GF-16. NC2114.2 +088900 CC--PASS-GF-16. NC2114.2 +089000 PERFORM PASS. NC2114.2 +089100 CC--WRITE-GF-16. NC2114.2 +089200 PERFORM PRINT-DETAIL. NC2114.2 +089300* NC2114.2 +089400 CC--INIT-GF-17. NC2114.2 +089500 MOVE "CC--TEST-GF-17" TO PAR-NAME. NC2114.2 +089600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +089700 MOVE +123.45 TO IF-D7. NC2114.2 +089800 MOVE 12300 TO IF-D13. NC2114.2 +089900 MOVE 2137.45 TO IF-D27. NC2114.2 +090000 MOVE 2137.45 TO IF-D28. NC2114.2 +090100 CC--TEST-GF-17. NC2114.2 +090200 IF IF-D27 GREATER THAN IF-D13 OR (IF-D27 IS EQUAL TO IF-D28 NC2114.2 +090300 AND IF-D27 NOT LESS THAN IF-D7) PERFORM PASS NC2114.2 +090400 GO TO CC--WRITE-GF-17. NC2114.2 +090500 GO TO CC--FAIL-GF-17. NC2114.2 +090600 CC--DELETE-GF-17. NC2114.2 +090700 PERFORM DE-LETE. NC2114.2 +090800 GO TO CC--WRITE-GF-17. NC2114.2 +090900 CC--FAIL-GF-17. NC2114.2 +091000 PERFORM FAIL. NC2114.2 +091100 CC--WRITE-GF-17. NC2114.2 +091200 PERFORM PRINT-DETAIL. NC2114.2 +091300* NC2114.2 +091400 CC--INIT-GF-18. NC2114.2 +091500 MOVE "CC--TEST-GF-18" TO PAR-NAME. NC2114.2 +091600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +091700 MOVE 11 TO CCON-1. NC2114.2 +091800 MOVE 12 TO CCON-2. NC2114.2 +091900 MOVE 13 TO CCON-3. NC2114.2 +092000 CC--TEST-GF-18. NC2114.2 +092100 IF CCON-2 GREATER THAN CCON-1 AND NOT GREATER THAN CCON-3 OR NC2114.2 +092200 CCON-1 PERFORM PASS NC2114.2 +092300 GO TO CC--WRITE-GF-18. NC2114.2 +092400 GO TO CC--FAIL-GF-18. NC2114.2 +092500* NOTE THE STANDARD SAYS THAT THE ABOVE IS EQUIVALENT TO --- NC2114.2 +092600* IF CCON-2 GREATER THAN CCON-1 AND CCON-2 NOT GREATER THANNC2114.2 +092700* CCON-3 OR CCON-2 NOT GREATER THAN CCON-1 PERFORM PASS NC2114.2 +092800* ELSE PERFORM FAIL. NC2114.2 +092900 CC--DELETE-GF-18. NC2114.2 +093000 PERFORM DE-LETE. NC2114.2 +093100 GO TO CC--WRITE-GF-18. NC2114.2 +093200 CC--FAIL-GF-18. NC2114.2 +093300 PERFORM FAIL. NC2114.2 +093400 CC--WRITE-GF-18. NC2114.2 +093500 PERFORM PRINT-DETAIL. NC2114.2 +093600* NC2114.2 +093700 CC--INIT-GF-19. NC2114.2 +093800 MOVE "CC--TEST-GF-19" TO PAR-NAME. NC2114.2 +093900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +094000 MOVE " ABBREV. W/PARENS " TO FEATURE. NC2114.2 +094100 MOVE 11 TO CCON-1. NC2114.2 +094200 MOVE 12 TO CCON-2. NC2114.2 +094300 MOVE 13 TO CCON-3. NC2114.2 +094400 CC--TEST-GF-19. NC2114.2 +094500 IF CCON-1 NOT LESS THAN 9 AND (CCON-3 GREATER THAN 12 OR NC2114.2 +094600 CCON-2 GREATER THAN 10) AND CCON-1 GREATER THAN 8 NC2114.2 +094700 PERFORM PASS NC2114.2 +094800 GO TO CC--WRITE-GF-19. NC2114.2 +094900 GO TO CC--FAIL-GF-19. NC2114.2 +095000 CC--DELETE-GF-19. NC2114.2 +095100 PERFORM DE-LETE. NC2114.2 +095200 GO TO CC--WRITE-GF-19. NC2114.2 +095300 CC--FAIL-GF-19. NC2114.2 +095400 PERFORM FAIL. NC2114.2 +095500 CC--WRITE-GF-19. NC2114.2 +095600 PERFORM PRINT-DETAIL. NC2114.2 +095700* NC2114.2 +095800 CC--INIT-GF-20. NC2114.2 +095900 MOVE "CC--TEST-GF-20" TO PAR-NAME. NC2114.2 +096000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +096100 MOVE " ABBREV. W/PARENS " TO FEATURE. NC2114.2 +096200 MOVE 0 TO IF-D1. NC2114.2 +096300 MOVE ZERO TO IF-D2. NC2114.2 +096400 MOVE " " TO IF-D4. NC2114.2 +096500 MOVE .0012 TO IF-D16. NC2114.2 +096600 MOVE .0012 TO IF-D17. NC2114.2 +096700 MOVE 12 TO D1 OF IF-D20. NC2114.2 +096800 MOVE 3 TO D2 OF IF-D20. NC2114.2 +096900 MOVE 45 TO D3 OF IF-D20. NC2114.2 +097000 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +097100 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +097200 CC--TEST-GF-20. NC2114.2 +097300 IF IF-D4 EQUAL TO ZEROS OR (IF-D1 NOT LESS THAN NC2114.2 +097400 IF-D2 AND (IF-D16 GREATER THAN IF-D17 OR IF-D20 EQUAL TO NC2114.2 +097500 IF-D21)) PERFORM PASS NC2114.2 +097600 GO TO CC--WRITE-GF-20. NC2114.2 +097700 GO TO CC--FAIL-GF-20. NC2114.2 +097800 CC--DELETE-GF-20. NC2114.2 +097900 PERFORM DE-LETE. NC2114.2 +098000 GO TO CC--WRITE-GF-20. NC2114.2 +098100 CC--FAIL-GF-20. NC2114.2 +098200 PERFORM FAIL. NC2114.2 +098300 CC--WRITE-GF-20. NC2114.2 +098400 PERFORM PRINT-DETAIL. NC2114.2 +098500* NC2114.2 +098600 CC--INIT-GF-21. NC2114.2 +098700 MOVE "CC--TEST-GF-21" TO PAR-NAME. NC2114.2 +098800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +098900 MOVE " NESTED IF " TO FEATURE. NC2114.2 +099000 MOVE .0012 TO IF-D16. NC2114.2 +099100 MOVE .0012 TO IF-D17. NC2114.2 +099200 MOVE 12 TO D1 OF IF-D20. NC2114.2 +099300 MOVE 3 TO D2 OF IF-D20. NC2114.2 +099400 MOVE 45 TO D3 OF IF-D20. NC2114.2 +099500 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +099600 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +099700 CC--TEST-GF-21. NC2114.2 +099800 IF IF-D20 NOT LESS THAN IF-D21 NC2114.2 +099900 IF IF-D16 EQUAL TO IF-D17 NC2114.2 +100000 PERFORM PASS NC2114.2 +100100 GO TO CC--WRITE-GF-21 NC2114.2 +100200 ELSE NC2114.2 +100300 PERFORM CC--FAIL-GF-21 NC2114.2 +100400 ELSE NC2114.2 +100500 NEXT SENTENCE. NC2114.2 +100600 GO TO CC--FAIL-GF-21. NC2114.2 +100700 CC--DELETE-GF-21. NC2114.2 +100800 PERFORM DE-LETE. NC2114.2 +100900 GO TO CC--WRITE-GF-21. NC2114.2 +101000 CC--FAIL-GF-21. NC2114.2 +101100 PERFORM FAIL. NC2114.2 +101200 CC--WRITE-GF-21. NC2114.2 +101300 PERFORM PRINT-DETAIL. NC2114.2 +101400* NC2114.2 +101500 CC--INIT-GF-22. NC2114.2 +101600 MOVE "CC--TEST-GF-22" TO PAR-NAME. NC2114.2 +101700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +101800 MOVE " NESTED IF " TO FEATURE. NC2114.2 +101900 MOVE 12 TO D1 OF IF-D20. NC2114.2 +102000 MOVE 3 TO D2 OF IF-D20. NC2114.2 +102100 MOVE 45 TO D3 OF IF-D20. NC2114.2 +102200 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +102300 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +102400 CC--TEST-GF-22. NC2114.2 +102500 IF IF-D20 NOT EQUAL TO IF-D21 NC2114.2 +102600 NEXT SENTENCE NC2114.2 +102700 ELSE NC2114.2 +102800 IF IF-D20 NOT GREATER THAN IF-D21 NC2114.2 +102900 PERFORM PASS NC2114.2 +103000 GO TO CC--WRITE-GF-22 NC2114.2 +103100 ELSE NC2114.2 +103200 GO TO CC--FAIL-GF-22. NC2114.2 +103300* NC2114.2 +103400 GO TO CC--FAIL-GF-22. NC2114.2 +103500 CC--DELETE-GF-22. NC2114.2 +103600 PERFORM DE-LETE. NC2114.2 +103700 GO TO CC--WRITE-GF-22. NC2114.2 +103800 CC--FAIL-GF-22. NC2114.2 +103900 PERFORM FAIL. NC2114.2 +104000 CC--WRITE-GF-22. NC2114.2 +104100 PERFORM PRINT-DETAIL. NC2114.2 +104200* NC2114.2 +104300 CC--INIT-GF-23. NC2114.2 +104400 MOVE "CC--TEST-GF-23" TO PAR-NAME. NC2114.2 +104500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +104600 MOVE " NESTED IF " TO FEATURE. NC2114.2 +104700 MOVE "X" TO WRK-XN-00001. NC2114.2 +104800 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +104900 MOVE 1 TO XX-TALLY. NC2114.2 +105000 MOVE SPACE TO IF-TABLE. NC2114.2 +105100 PERFORM CC--TEST-GF-23. NC2114.2 +105200 CC--TEST-GF-23. NC2114.2 +105300 IF WRK-XN-00001 IS EQUAL TO "X" NC2114.2 +105400 MOVE "Z" TO WRK-XN-00001 NC2114.2 +105500 IF WRK-DS-01V00 IS EQUAL TO ZERO NC2114.2 +105600 MOVE 1 TO WRK-DS-01V00 NC2114.2 +105700 ELSE NC2114.2 +105800 MOVE 2 TO WRK-DS-01V00 NC2114.2 +105900 ELSE NC2114.2 +106000 MOVE "W" TO WRK-XN-00001 NC2114.2 +106100 IF WRK-DS-01V00 IS GREATER THAN ZERO NC2114.2 +106200 MOVE "1" TO IF-ELEM (7). NC2114.2 +106300 MOVE WRK-XN-00001 TO IF-ELEM (XX-TALLY). NC2114.2 +106400 ADD 1 TO XX-TALLY. NC2114.2 +106500 MOVE WRK-DS-01V00 TO IF-ELEM (XX-TALLY). NC2114.2 +106600 ADD 1 TO XX-TALLY. NC2114.2 +106700 MOVE SPACE TO IF-ELEM (XX-TALLY) NC2114.2 +106800 ADD 1 TO XX-TALLY. NC2114.2 +106900 CC--TEST-GF-23-1. NC2114.2 +107000 IF IF-TABLE EQUAL TO "Z1 W1 1 " NC2114.2 +107100 PERFORM PASS GO TO CC--WRITE-GF-23. NC2114.2 +107200 GO TO CC--FAIL-GF-23. NC2114.2 +107300 CC--DELETE-GF-23. NC2114.2 +107400 PERFORM DE-LETE. NC2114.2 +107500 GO TO CC--WRITE-GF-23. NC2114.2 +107600 CC--FAIL-GF-23. NC2114.2 +107700 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +107800 MOVE "Z1 W1 1" TO CORRECT-A. NC2114.2 +107900 PERFORM FAIL. NC2114.2 +108000 CC--WRITE-GF-23. NC2114.2 +108100 PERFORM PRINT-DETAIL. NC2114.2 +108200* NC2114.2 +108300 CC--INIT-GF-24. NC2114.2 +108400 MOVE "CC--TEST-GF-24" TO PAR-NAME. NC2114.2 +108500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +108600 MOVE " NOT ABBREVIATED " TO FEATURE. NC2114.2 +108700 MOVE SPACE TO WRK-XN-00001. NC2114.2 +108800 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +108900 CC--TEST-GF-24. NC2114.2 +109000 IF WRK-XN-00001 EQUAL TO SPACE NC2114.2 +109100 OR NC2114.2 +109200 WRK-DS-01V00 EQUAL TO ZERO NC2114.2 +109300 PERFORM PASS NC2114.2 +109400 ELSE NC2114.2 +109500 GO TO CC--FAIL-GF-24. NC2114.2 +109600* NOTE BOTH CONDITIONS ARE TRUE. NC2114.2 +109700 GO TO CC--WRITE-GF-24. NC2114.2 +109800 CC--DELETE-GF-24. NC2114.2 +109900 PERFORM DE-LETE. NC2114.2 +110000 GO TO CC--WRITE-GF-24. NC2114.2 +110100 CC--FAIL-GF-24. NC2114.2 +110200 PERFORM FAIL. NC2114.2 +110300 CC--WRITE-GF-24. NC2114.2 +110400 PERFORM PRINT-DETAIL. NC2114.2 +110500* NC2114.2 +110600 CC--INIT-GF-25. NC2114.2 +110700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +110800 MOVE "CC--TEST-GF-25" TO PAR-NAME. NC2114.2 +110900 MOVE "0" TO WRK-XN-00001. NC2114.2 +111000 MOVE 0 TO WRK-DS-01V00. NC2114.2 +111100 CC--TEST-GF-25. NC2114.2 +111200 IF WRK-XN-00001 EQUAL TO "0" NC2114.2 +111300 AND NC2114.2 +111400 WRK-DS-01V00 EQUAL TO 0 NC2114.2 +111500 PERFORM PASS NC2114.2 +111600 ELSE NC2114.2 +111700 GO TO CC--FAIL-GF-25. NC2114.2 +111800* NOTE BOTH CONDITIONS ARE TRUE. NC2114.2 +111900 GO TO CC--WRITE-GF-25. NC2114.2 +112000 CC--DELETE-GF-25. NC2114.2 +112100 PERFORM DE-LETE. NC2114.2 +112200 GO TO CC--WRITE-GF-25. NC2114.2 +112300 CC--FAIL-GF-25. NC2114.2 +112400 PERFORM FAIL. NC2114.2 +112500 CC--WRITE-GF-25. NC2114.2 +112600 PERFORM PRINT-DETAIL. NC2114.2 +112700* NC2114.2 +112800 CC--INIT-GF-26. NC2114.2 +112900 MOVE "CC--TEST-GF-26" TO PAR-NAME. NC2114.2 +113000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +113100 MOVE " NOT ABBR, W/PARENS" TO FEATURE. NC2114.2 +113200 MOVE SPACE TO IF-TABLE. NC2114.2 +113300 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +113400 MOVE ZERO TO WRK-XN-00001. NC2114.2 +113500 PERFORM CC--TEST-GF-26. NC2114.2 +113600 MOVE "X" TO IF-ELEM (5). NC2114.2 +113700 CC--TEST-GF-26. NC2114.2 +113800 IF (WRK-DS-01V00 IS EQUAL TO 0 NC2114.2 +113900 OR NC2114.2 +114000 WRK-XN-00001 EQUAL TO "0") NC2114.2 +114100 AND NC2114.2 +114200 SPACE IS EQUAL TO IF-TABLE NC2114.2 +114300 MOVE "1" TO IF-ELEM (1) NC2114.2 +114400 ELSE NC2114.2 +114500 MOVE "1" TO IF-ELEM (3). NC2114.2 +114600* NOTE ALL CONDITIONS ARE TRUE THE FIRST TIME, THEN THE NC2114.2 +114700* FIRST TWO ARE TRUE THE SECOND TIME. NC2114.2 +114800 CC--TEST-GF-26-1. NC2114.2 +114900 IF IF-TABLE EQUAL TO "1 1 X" NC2114.2 +115000 PERFORM PASS GO TO CC--WRITE-GF-26. NC2114.2 +115100 GO TO CC--FAIL-GF-26. NC2114.2 +115200 CC--DELETE-GF-26. NC2114.2 +115300 PERFORM DE-LETE. NC2114.2 +115400 GO TO CC--WRITE-GF-26. NC2114.2 +115500 CC--FAIL-GF-26. NC2114.2 +115600 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +115700 MOVE "1 1 X" TO CORRECT-A. NC2114.2 +115800 PERFORM FAIL. NC2114.2 +115900 CC--WRITE-GF-26. NC2114.2 +116000 PERFORM PRINT-DETAIL. NC2114.2 +116100* NC2114.2 +116200 CC--INIT-GF-27. NC2114.2 +116300 MOVE "CC--TEST-GF-27" TO PAR-NAME. NC2114.2 +116400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +116500 MOVE " NOT ABBR, W/PARENS" TO FEATURE. NC2114.2 +116600 MOVE SPACE TO IF-TABLE. NC2114.2 +116700 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +116800 MOVE ZERO TO WRK-XN-00001. NC2114.2 +116900 PERFORM CC--TEST-GF-27. NC2114.2 +117000 MOVE "X" TO IF-ELEM (5). NC2114.2 +117100 CC--TEST-GF-27. NC2114.2 +117200 IF NOT (WRK-DS-01V00 IS EQUAL TO 0 NC2114.2 +117300 AND NC2114.2 +117400 WRK-XN-00001 IS EQUAL TO "0") NC2114.2 +117500 OR NC2114.2 +117600 SPACE IS EQUAL TO IF-TABLE NC2114.2 +117700 MOVE "1" TO IF-ELEM (1) NC2114.2 +117800 ELSE NC2114.2 +117900 MOVE "1" TO IF-ELEM (3). NC2114.2 +118000* NOTE THE FIRST PART IS ALWAYS FALSE, AND THE PORTION NC2114.2 +118100* AFTER THE "OR" IS FIRST TRUE, THEN FALSE. NC2114.2 +118200 CC--TEST-GF-27-1. NC2114.2 +118300 IF IF-TABLE EQUAL TO "1 1 X" NC2114.2 +118400 PERFORM PASS GO TO CC--WRITE-GF-27. NC2114.2 +118500 GO TO CC--FAIL-GF-27. NC2114.2 +118600 CC--DELETE-GF-27. NC2114.2 +118700 PERFORM DE-LETE. NC2114.2 +118800 GO TO CC--WRITE-GF-27. NC2114.2 +118900 CC--FAIL-GF-27. NC2114.2 +119000 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +119100 MOVE "1 1 X" TO CORRECT-A. NC2114.2 +119200 PERFORM FAIL. NC2114.2 +119300 CC--WRITE-GF-27. NC2114.2 +119400 PERFORM PRINT-DETAIL. NC2114.2 +119500* NC2114.2 +119600 CC--INIT-GF-28. NC2114.2 +119700 MOVE "CC--TEST-GF-28" TO PAR-NAME. NC2114.2 +119800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +119900 MOVE " ABBREVIATED " TO FEATURE. NC2114.2 +120000 MOVE ZERO TO IF-TABLE NC2114.2 +120100 MOVE ZERO TO WRK-XN-00001. NC2114.2 +120200 MOVE 1 TO XX-TALLY. NC2114.2 +120300 PERFORM CC--TEST-GF-28. NC2114.2 +120400 MOVE "X" TO IF-ELEM (5). NC2114.2 +120500 CC--TEST-GF-28. NC2114.2 +120600 IF WRK-XN-00001 = "0" OR = "1" OR = IF-TABLE NC2114.2 +120700 AND = IF-ELEM (5) NC2114.2 +120800 MOVE "1" TO IF-ELEM (XX-TALLY) NC2114.2 +120900 ADD 1 TO XX-TALLY NC2114.2 +121000 ELSE NC2114.2 +121100 MOVE "2" TO IF-ELEM (XX-TALLY) NC2114.2 +121200 ADD 1 TO XX-TALLY. NC2114.2 +121300 CC--TEST-GF-28-1. NC2114.2 +121400 IF IF-TABLE EQUAL TO "1100X0000000" NC2114.2 +121500 PERFORM PASS GO TO CC--WRITE-GF-28. NC2114.2 +121600 GO TO CC--FAIL-GF-28. NC2114.2 +121700 CC--DELETE-GF-28. NC2114.2 +121800 PERFORM DE-LETE. NC2114.2 +121900 GO TO CC--WRITE-GF-28. NC2114.2 +122000 CC--FAIL-GF-28. NC2114.2 +122100 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +122200 MOVE "1100X0000000" TO CORRECT-A. NC2114.2 +122300 PERFORM FAIL. NC2114.2 +122400 CC--WRITE-GF-28. NC2114.2 +122500 PERFORM PRINT-DETAIL. NC2114.2 +122600* NC2114.2 +122700 CC--INIT-GF-29. NC2114.2 +122800 MOVE "CC--TEST-GF-29" TO PAR-NAME. NC2114.2 +122900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +123000 MOVE ZERO TO IF-TABLE. NC2114.2 +123100 MOVE ZERO TO WRK-XN-00001. NC2114.2 +123200 MOVE 1 TO XX-TALLY. NC2114.2 +123300 PERFORM CC--TEST-GF-29. NC2114.2 +123400 MOVE "X" TO WRK-XN-00001. NC2114.2 +123500 CC--TEST-GF-29. NC2114.2 +123600 IF WRK-XN-00001 = "0" OR "1" OR "2" OR IF-TABLE OR "3" NC2114.2 +123700 MOVE "1" TO IF-ELEM (XX-TALLY) NC2114.2 +123800 ADD 1 TO XX-TALLY NC2114.2 +123900 ELSE NC2114.2 +124000 MOVE "2" TO IF-ELEM (XX-TALLY) NC2114.2 +124100 ADD 1 TO XX-TALLY. NC2114.2 +124200 CC--TEST-GF-29-1. NC2114.2 +124300 IF IF-TABLE EQUAL TO "120000000000" NC2114.2 +124400 PERFORM PASS GO TO CC--WRITE-GF-29. NC2114.2 +124500 GO TO CC--FAIL-GF-29. NC2114.2 +124600 CC--DELETE-GF-29. NC2114.2 +124700 PERFORM DE-LETE. NC2114.2 +124800 GO TO CC--WRITE-GF-29. NC2114.2 +124900 CC--FAIL-GF-29. NC2114.2 +125000 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +125100 MOVE "120000000000" TO CORRECT-A. NC2114.2 +125200 PERFORM FAIL. NC2114.2 +125300 CC--WRITE-GF-29. NC2114.2 +125400 PERFORM PRINT-DETAIL. NC2114.2 +125500* NC2114.2 +125600 CC--INIT-GF-30. NC2114.2 +125700 MOVE "CC--TEST-GF-30" TO PAR-NAME. NC2114.2 +125800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +125900 MOVE " LOGICAL *NOT*" TO FEATURE. NC2114.2 +126000 MOVE "AAAAA" TO AZE. NC2114.2 +126100 MOVE -2 TO MINUS-TWO. NC2114.2 +126200 MOVE 2 TO TWO. NC2114.2 +126300 CC--TEST-GF-30. NC2114.2 +126400 IF NOT AZE < "AAAAA" NC2114.2 +126500 AND NC2114.2 +126600 MINUS-TWO < TWO NC2114.2 +126700 PERFORM PASS NC2114.2 +126800 ELSE NC2114.2 +126900 GO TO CC--FAIL-GF-30. NC2114.2 +127000* NOTE CC--TEST-GF-30 TESTS LOGICAL "NOT" PLUS "AND" --- NC2114.2 +127100* FIRST LINE TRUE, NC2114.2 +127200* SECOND LINE TRUE. NC2114.2 +127300 GO TO CC--WRITE-GF-30. NC2114.2 +127400 CC--DELETE-GF-30. NC2114.2 +127500 PERFORM DE-LETE. NC2114.2 +127600 GO TO CC--WRITE-GF-30. NC2114.2 +127700 CC--FAIL-GF-30. NC2114.2 +127800 PERFORM FAIL. NC2114.2 +127900 CC--WRITE-GF-30. NC2114.2 +128000 PERFORM PRINT-DETAIL. NC2114.2 +128100* NC2114.2 +128200 CC--INIT-GF-31. NC2114.2 +128300 MOVE "CC--TEST-GF-31" TO PAR-NAME. NC2114.2 +128400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +128500 MOVE 10 TO TEN. NC2114.2 +128600 MOVE 3 TO THREE. NC2114.2 +128700 CC--TEST-GF-31. NC2114.2 +128800 IF NOT TEN = 10.00000000 NC2114.2 +128900 OR NC2114.2 +129000 THREE = TEN NC2114.2 +129100 GO TO CC--FAIL-GF-31 NC2114.2 +129200 ELSE NC2114.2 +129300 PERFORM PASS. NC2114.2 +129400* NOTE CC--TEST-GF-31 TESTS LOGICAL "NOT" PLUS "OR" --- NC2114.2 +129500* FIRST LINE FALSE, NC2114.2 +129600* SECOND LINE FALSE. NC2114.2 +129700 GO TO CC--WRITE-GF-31. NC2114.2 +129800 CC--DELETE-GF-31. NC2114.2 +129900 PERFORM DE-LETE. NC2114.2 +130000 GO TO CC--WRITE-GF-31. NC2114.2 +130100 CC--FAIL-GF-31. NC2114.2 +130200 PERFORM FAIL. NC2114.2 +130300 CC--WRITE-GF-31. NC2114.2 +130400 PERFORM PRINT-DETAIL. NC2114.2 +130500* NC2114.2 +130600 CC--INIT-GF-32. NC2114.2 +130700 MOVE "CC--TEST-GF-32" TO PAR-NAME. NC2114.2 +130800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +130900 MOVE 0 TO NAUGHT. NC2114.2 +131000 MOVE 3 TO THREE. NC2114.2 +131100 MOVE 6 TO SIX. NC2114.2 +131200 CC--TEST-GF-32. NC2114.2 +131300 IF NOT (NAUGHT > THREE NC2114.2 +131400 OR NC2114.2 +131500 NAUGHT < ZERO) NC2114.2 +131600 AND NC2114.2 +131700 6.00000000000000001 NOT EQUAL TO SIX NC2114.2 +131800 PERFORM PASS NC2114.2 +131900 ELSE NC2114.2 +132000 GO TO CC--FAIL-GF-32. NC2114.2 +132100* NOTE CC--TEST-GF-32 TESTS LOGICAL "NOT" OF PARENTHESIZED NC2114.2 +132200* CONDITION PLUS "AND" --- NC2114.2 +132300* FIRST LINE (WITHIN PARENTHESES) FALSE NC2114.2 +132400* SECOND LINE (WITHIN PARENTHESES) FALSE NC2114.2 +132500* FIRST PLUS SECOND LINE (WITHIN PARENS) FALSE NC2114.2 +132600* FIRST PLUS SECOND LINE TRUE NC2114.2 +132700* THIRD LINE TRUE. NC2114.2 +132800 GO TO CC--WRITE-GF-32. NC2114.2 +132900 CC--DELETE-GF-32. NC2114.2 +133000 PERFORM DE-LETE. NC2114.2 +133100 GO TO CC--WRITE-GF-32. NC2114.2 +133200 CC--FAIL-GF-32. NC2114.2 +133300 PERFORM FAIL. NC2114.2 +133400 CC--WRITE-GF-32. NC2114.2 +133500 PERFORM PRINT-DETAIL. NC2114.2 +133600* NC2114.2 +133700 CC--INIT-GF-33. NC2114.2 +133800 MOVE "CC--TEST-GF-33" TO PAR-NAME. NC2114.2 +133900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +134000 MOVE +.333333333333333333 TO ONE-THIRD. NC2114.2 +134100 MOVE "AAAAA" TO AZE. NC2114.2 +134200 MOVE "CCCCC" TO CEEZE. NC2114.2 +134300 CC--TEST-GF-33. NC2114.2 +134400 IF ( .3703703333 ) EQUAL TO ONE-THIRD NC2114.2 +134500 AND NOT AZE EQUAL TO CEEZE NC2114.2 +134600 GO TO CC--FAIL-GF-33 NC2114.2 +134700 ELSE NC2114.2 +134800 PERFORM PASS. NC2114.2 +134900* NOTE CC--TEST-GF-33 TESTS LOGICAL "NOT" FOLLOWING AN "AND"NC2114.2 +135000* FIRST LINE FALSE, NC2114.2 +135100* SECOND LINE TRUE. NC2114.2 +135200 GO TO CC--WRITE-GF-33. NC2114.2 +135300 CC--DELETE-GF-33. NC2114.2 +135400 PERFORM DE-LETE. NC2114.2 +135500 GO TO CC--WRITE-GF-33. NC2114.2 +135600 CC--FAIL-GF-33. NC2114.2 +135700 PERFORM FAIL. NC2114.2 +135800 CC--WRITE-GF-33. NC2114.2 +135900 PERFORM PRINT-DETAIL. NC2114.2 +136000* NC2114.2 +136100 CC--INIT-GF-34. NC2114.2 +136200 MOVE "CC--TEST-GF-34" TO PAR-NAME. NC2114.2 +136300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +136400 MOVE 11 TO CCON-1. NC2114.2 +136500 MOVE 12 TO CCON-2. NC2114.2 +136600 MOVE 13 TO CCON-3. NC2114.2 +136700 MOVE 14 TO CCON-4. NC2114.2 +136800 CC--TEST-GF-34. NC2114.2 +136900 IF NOT (CCON-4 NOT GREATER THAN CCON-2 AND CCON-3 NC2114.2 +137000 AND NOT CCON-1) NC2114.2 +137100 PERFORM PASS NC2114.2 +137200 ELSE NC2114.2 +137300 GO TO CC--FAIL-GF-34. NC2114.2 +137400* NC2114.2 +137500* NOTE THE ABOVE STATEMENT TESTS THE USE OF A COMPLEX NC2114.2 +137600* CONDITION WITH COMBINATIONS OF LOGICAL OPERATORS NC2114.2 +137700* ABREVIATED RELATIONAL OPERATORS AND OMITTED NC2114.2 +137800* CONDITION SUBJECTS. NC2114.2 +137900* THE EXPANDED EQUIVALENT OF THIS STATEMENT IS - NC2114.2 +138000* "NOT (((CCON-4 NOT > CCON-2) AND (CCON-4 NOT > NC2114.2 +138100* CCON-3)) AND (NOT (CCON-4 NOT > CCON-1)))" NC2114.2 +138200 GO TO CC--WRITE-GF-34. NC2114.2 +138300 CC--DELETE-GF-34. NC2114.2 +138400 PERFORM DE-LETE. NC2114.2 +138500 GO TO CC--WRITE-GF-34. NC2114.2 +138600 CC--FAIL-GF-34. NC2114.2 +138700 PERFORM FAIL. NC2114.2 +138800 CC--WRITE-GF-34. NC2114.2 +138900 PERFORM PRINT-DETAIL. NC2114.2 +139000* NC2114.2 +139100 CC--INIT-GF-35. NC2114.2 +139200 MOVE "CC--TEST-GF-35" TO PAR-NAME. NC2114.2 +139300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +139400 MOVE -1 TO MINUS-ONE. NC2114.2 +139500 MOVE +.4285714286 TO THREE-SEVENTHS. NC2114.2 +139600 MOVE 1 TO ONE. NC2114.2 +139700 MOVE 2 TO TWO. NC2114.2 +139800 MOVE +2 TO DOS. NC2114.2 +139900 MOVE 5 TO FIVE. NC2114.2 +140000 CC--TEST-GF-35. NC2114.2 +140100 IF TWO > DOS NC2114.2 +140200 OR NC2114.2 +140300 NOT ( THREE-SEVENTHS ) EQUAL TO FIVE NC2114.2 +140400 AND NC2114.2 +140500 MINUS-ONE = ONE NC2114.2 +140600 GO TO CC--FAIL-GF-35 NC2114.2 +140700 ELSE NC2114.2 +140800 PERFORM PASS. NC2114.2 +140900* NOTE CC--TEST-GF-35 TESTS LOGICAL "NOT" WHICH FOLLOWS AN NC2114.2 +141000* "OR" AND PRECEDES AN "AND" --- NC2114.2 +141100* FIRST LINE FALSE NC2114.2 +141200* SECOND LINE TRUE NC2114.2 +141300* THIRD LINE FALSE. NC2114.2 +141400 GO TO CC--WRITE-GF-35. NC2114.2 +141500 CC--DELETE-GF-35. NC2114.2 +141600 PERFORM DE-LETE. NC2114.2 +141700 GO TO CC--WRITE-GF-35. NC2114.2 +141800 CC--FAIL-GF-35. NC2114.2 +141900 PERFORM FAIL. NC2114.2 +142000 CC--WRITE-GF-35. NC2114.2 +142100 PERFORM PRINT-DETAIL. NC2114.2 +142200* NC2114.2 +142300 CC--INIT-GF-36. NC2114.2 +142400 MOVE "CC--TEST-GF-36" TO PAR-NAME. NC2114.2 +142500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +142600 MOVE "AAAAA" TO AZE. NC2114.2 +142700 MOVE "BBBBB" TO BEEZE. NC2114.2 +142800 MOVE 5 TO FIVE. NC2114.2 +142900 CC--TEST-GF-36. NC2114.2 +143000 IF AZE = BEEZE NC2114.2 +143100 OR NOT (5 > FIVE AND NC2114.2 +143200 NOT 5 > FIVE) NC2114.2 +143300 PERFORM PASS NC2114.2 +143400 ELSE NC2114.2 +143500 GO TO CC--FAIL-GF-36. NC2114.2 +143600* NOTE CC--TEST-GF-36 TESTS LOGICAL "NOT" WHICH FOLLOWS AN NC2114.2 +143700* "OR" AND PRECEDES A PARENTHESIZED CONDITION --- NC2114.2 +143800* FIRST LINE FALSE, NC2114.2 +143900* SECOND LINE (WITHIN PARENS) FALSE NC2114.2 +144000* THIRD LINE (WITHIN PARENS) TRUE NC2114.2 +144100* SECOND PLUS THIRD LINE (WITHIN PARENS) FALSE NC2114.2 +144200* SECOND PLUS THIRD LINE TRUE. NC2114.2 +144300 GO TO CC--WRITE-GF-36. NC2114.2 +144400 CC--DELETE-GF-36. NC2114.2 +144500 PERFORM DE-LETE. NC2114.2 +144600 GO TO CC--WRITE-GF-36. NC2114.2 +144700 CC--FAIL-GF-36. NC2114.2 +144800 PERFORM FAIL. NC2114.2 +144900 CC--WRITE-GF-36. NC2114.2 +145000 PERFORM PRINT-DETAIL. NC2114.2 +145100* NC2114.2 +145200 CC--INIT-GF-37. NC2114.2 +145300 MOVE "CC--TEST-GF-37" TO PAR-NAME. NC2114.2 +145400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +145500 MOVE 0 TO NAUGHT. NC2114.2 +145600 MOVE 1 TO ONE. NC2114.2 +145700 MOVE +1 TO UNO. NC2114.2 +145800 MOVE 2 TO TWO. NC2114.2 +145900 MOVE +2 TO DOS. NC2114.2 +146000 CC--TEST-GF-37. NC2114.2 +146100 IF ((NAUGHT EQUAL TO ONE) NC2114.2 +146200 OR (NOT ((UNO = ONE) OR NC2114.2 +146300 (TWO = DOS)))) NC2114.2 +146400 GO TO CC--FAIL-GF-37 NC2114.2 +146500 ELSE NC2114.2 +146600 PERFORM PASS. NC2114.2 +146700* NOTE CC--TEST-GF-37 TESTS LOGICAL "NOT" THAT IS CONTAINEDNC2114.2 +146800* PARENTHESES AND WHICH PRECEDES A PARENTHESIZED NC2114.2 +146900* CONDITION --- NC2114.2 +147000* FIRST LINE (IN INNER PARENS) FALSE NC2114.2 +147100* SECOND LINE (IN INNER PARENS) TRUE NC2114.2 +147200* THIRD LINE (IN INNER PARENS) FALSE NC2114.2 +147300* SECOND PLUS THIRD LINE (IN MIDDLE PARENS) TRUE NC2114.2 +147400* SECOND PLUS THIRD LINE (IN OUTER PARENS) FALSE NC2114.2 +147500* PARENS AROUND ENTIRE CONDITION ARE REDUNDANT. NC2114.2 +147600 GO TO CC--WRITE-GF-37. NC2114.2 +147700 CC--DELETE-GF-37. NC2114.2 +147800 PERFORM DE-LETE. NC2114.2 +147900 GO TO CC--WRITE-GF-37. NC2114.2 +148000 CC--FAIL-GF-37. NC2114.2 +148100 PERFORM FAIL. NC2114.2 +148200 CC--WRITE-GF-37. NC2114.2 +148300 PERFORM PRINT-DETAIL. NC2114.2 +148400* NC2114.2 +148500 CC--INIT-GF-38. NC2114.2 +148600 MOVE "CC--TEST-GF-38" TO PAR-NAME. NC2114.2 +148700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +148800 MOVE "AAAAA" TO AZE. NC2114.2 +148900 MOVE 1 TO ONE. NC2114.2 +149000 MOVE 2 TO TWO. NC2114.2 +149100 MOVE 3 TO THREE. NC2114.2 +149200 CC--TEST-GF-38. NC2114.2 +149300 IF NOT AZE LESS THAN ONE AND NC2114.2 +149400 NOT ONE < AZE NC2114.2 +149500 OR TWO AND NC2114.2 +149600 NOT THREE LESS THAN TWO NC2114.2 +149700 PERFORM PASS NC2114.2 +149800 ELSE NC2114.2 +149900 GO TO CC--FAIL-GF-38. NC2114.2 +150000* NOTE CC--TEST-GF-38 TESTS LOGICAL "NOT" FOLLOWING "AND" ANC2114.2 +150100* IN COMBINATION WITH AN ABBREVIATION --- NC2114.2 +150200* EITHER FIRST LINE OR SECOND LINE MUST BE FALSE, NC2114.2 +150300* THEREFORE, NC2114.2 +150400* FIRST PLUS SECOND LINES FALSE NC2114.2 +150500* ABBREVIATED THIRD LINE TRUE NC2114.2 +150600* FOURTH LINE TRUE NC2114.2 +150700* THIRD PLUS FOURTH LINES TRUE. NC2114.2 +150800 GO TO CC--WRITE-GF-38. NC2114.2 +150900 CC--DELETE-GF-38. NC2114.2 +151000 PERFORM DE-LETE. NC2114.2 +151100 GO TO CC--WRITE-GF-38. NC2114.2 +151200 CC--FAIL-GF-38. NC2114.2 +151300 PERFORM FAIL. NC2114.2 +151400 CC--WRITE-GF-38. NC2114.2 +151500 PERFORM PRINT-DETAIL. NC2114.2 +151600* NC2114.2 +151700 CC--INIT-GF-39. NC2114.2 +151800 MOVE "CC--TEST-GF-39" TO PAR-NAME. NC2114.2 +151900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +152000 MOVE " SIGN CONDITIONS" TO FEATURE. NC2114.2 +152100 MOVE 0 TO SIGN-1. NC2114.2 +152200 MOVE 0 TO SIGN-2. NC2114.2 +152300 MOVE 9 TO SIGN-3. NC2114.2 +152400 CC--TEST-GF-39. NC2114.2 +152500 IF NOT (SIGN-1 POSITIVE OR NC2114.2 +152600 SIGN-2 NEGATIVE) NC2114.2 +152700 AND SIGN-3 NOT ZERO NC2114.2 +152800 PERFORM PASS NC2114.2 +152900 ELSE NC2114.2 +153000 GO TO CC--FAIL-GF-39. NC2114.2 +153100* NOTE CC--TEST-GF-39 TESTS SIGN CONDITIONS WITH SEVERAL TYNC2114.2 +153200* OF LOGICAL CONNECTORS INCLUDING PARENTHESES --- NC2114.2 +153300* FIRST LINE FALSE NC2114.2 +153400* SECOND LINE FALSE NC2114.2 +153500* FIRST PLUS SECOND LINES (WITHIN PARENS) FALSE NC2114.2 +153600* FIRST PLUS SECOND LINES TRUE NC2114.2 +153700* THIRD LINE TRUE. NC2114.2 +153800 GO TO CC--WRITE-GF-39. NC2114.2 +153900 CC--DELETE-GF-39. NC2114.2 +154000 PERFORM DE-LETE. NC2114.2 +154100 GO TO CC--WRITE-GF-39. NC2114.2 +154200 CC--FAIL-GF-39. NC2114.2 +154300 PERFORM FAIL. NC2114.2 +154400 CC--WRITE-GF-39. NC2114.2 +154500 PERFORM PRINT-DETAIL. NC2114.2 +154600* NC2114.2 +154700 CC--INIT-GF-40. NC2114.2 +154800 MOVE "CC--TEST-GF-40" TO PAR-NAME. NC2114.2 +154900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +155000 MOVE " SIGN CONDITIONS" TO FEATURE. NC2114.2 +155100 MOVE -5 TO SIGN-1. NC2114.2 +155200 MOVE -1 TO SIGN-2. NC2114.2 +155300 MOVE 0 TO SIGN-3. NC2114.2 +155400 CC--TEST-GF-40. NC2114.2 +155500 IF SIGN-1 IS POSITIVE NC2114.2 +155600 OR NOT SIGN-2 IS NEGATIVE NC2114.2 +155700 AND SIGN-3 IS ZERO NC2114.2 +155800 GO TO CC--FAIL-GF-40 NC2114.2 +155900 ELSE NC2114.2 +156000 PERFORM PASS. NC2114.2 +156100* NOTE CC--TEST-GF-40 TESTS SIGN CONDITIONS WITH SEVERAL TYNC2114.2 +156200* OF LOGICAL CONNECTORS BUT NO PARENTHESES --- NC2114.2 +156300* FIRST LINE FALSE NC2114.2 +156400* SECOND LINE FALSE NC2114.2 +156500* THIRD LINE TRUE. NC2114.2 +156600 GO TO CC--WRITE-GF-40. NC2114.2 +156700 CC--DELETE-GF-40. NC2114.2 +156800 PERFORM DE-LETE. NC2114.2 +156900 GO TO CC--WRITE-GF-40. NC2114.2 +157000 CC--FAIL-GF-40. NC2114.2 +157100 PERFORM FAIL. NC2114.2 +157200 CC--WRITE-GF-40. NC2114.2 +157300 PERFORM PRINT-DETAIL. NC2114.2 +157400* NC2114.2 +157500 CC--INIT-GF-41. NC2114.2 +157600 MOVE "CC--TEST-GF-41" TO PAR-NAME. NC2114.2 +157700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +157800 MOVE " CLASS CONDITIONS" TO FEATURE. NC2114.2 +157900 MOVE SPACE TO CLASS-1. NC2114.2 +158000 MOVE ZERO TO CLASS-2. NC2114.2 +158100 MOVE ZERO TO CLASS-3. NC2114.2 +158200 CC--TEST-GF-41. NC2114.2 +158300 IF NOT (CLASS-1 NUMERIC OR NC2114.2 +158400 CLASS-2 ALPHABETIC) NC2114.2 +158500 AND CLASS-3 NOT NUMERIC NC2114.2 +158600 GO TO CC--FAIL-GF-41 NC2114.2 +158700 ELSE NC2114.2 +158800 PERFORM PASS. NC2114.2 +158900* NOTE CC--TEST-GF-41 TESTS CLASS CONDITIONS WITH SEVERAL NC2114.2 +159000* TYPES OF LOGICAL CONNECTORS INCLUDING PARENTHESES --NC2114.2 +159100* FIRST LINE FALSE NC2114.2 +159200* SECOND LINE FALSE NC2114.2 +159300* FIRST PLUS SECOND LINES (WITHIN PARENS) FALSE NC2114.2 +159400* FIRST PLUS SECOND LINES TRUE NC2114.2 +159500* THIRD LINE FALSE. NC2114.2 +159600 GO TO CC--WRITE-GF-41. NC2114.2 +159700 CC--DELETE-GF-41. NC2114.2 +159800 PERFORM DE-LETE. NC2114.2 +159900 GO TO CC--WRITE-GF-41. NC2114.2 +160000 CC--FAIL-GF-41. NC2114.2 +160100 PERFORM FAIL. NC2114.2 +160200 CC--WRITE-GF-41. NC2114.2 +160300 PERFORM PRINT-DETAIL. NC2114.2 +160400* NC2114.2 +160500 CC--INIT-GF-42. NC2114.2 +160600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +160700 MOVE " CLASS CONDITIONS" TO FEATURE. NC2114.2 +160800 MOVE "CC--TEST-GF-42" TO PAR-NAME. NC2114.2 +160900 MOVE 12345 TO CLASS-1. NC2114.2 +161000 MOVE 12345 TO CLASS-2. NC2114.2 +161100 MOVE 12345 TO CLASS-3. NC2114.2 +161200 CC--TEST-GF-42. NC2114.2 +161300 IF CLASS-1 NUMERIC NC2114.2 +161400 OR NOT CLASS-2 ALPHABETIC NC2114.2 +161500 AND CLASS-3 NUMERIC NC2114.2 +161600 PERFORM PASS NC2114.2 +161700 ELSE NC2114.2 +161800 GO TO CC--FAIL-GF-42. NC2114.2 +161900* NOTE CC--TEST-GF-42 TESTS CLASS CONDITIONS WITH SEVERAL NC2114.2 +162000* TYPES OF LOGICAL CONNECTORS BUT NO PARENTHESES --- NC2114.2 +162100* FIRST LINE TRUE NC2114.2 +162200* SECOND LINE TRUE NC2114.2 +162300* THIRD LINE TRUE. NC2114.2 +162400 GO TO CC--WRITE-GF-42. NC2114.2 +162500 CC--DELETE-GF-42. NC2114.2 +162600 PERFORM DE-LETE. NC2114.2 +162700 GO TO CC--WRITE-GF-42. NC2114.2 +162800 CC--FAIL-GF-42. NC2114.2 +162900 PERFORM FAIL. NC2114.2 +163000 CC--WRITE-GF-42. NC2114.2 +163100 PERFORM PRINT-DETAIL. NC2114.2 +163200* NC2114.2 +163300 CC--INIT-GF-43. NC2114.2 +163400 MOVE "CC--TEST-GF-43" TO PAR-NAME. NC2114.2 +163500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +163600 MOVE " SWITCH CONDITIONS" TO FEATURE. NC2114.2 +163700 CC--TEST-GF-43. NC2114.2 +163800 IF NOT (ON-WRK-SWITCH-1 OR NC2114.2 +163900 OFF-WRK-SWITCH-2) NC2114.2 +164000 AND NOT OFF-WRK-SWITCH-1 NC2114.2 +164100 GO TO CC--FAIL-GF-43 NC2114.2 +164200 ELSE NC2114.2 +164300 PERFORM PASS. NC2114.2 +164400* NOTE *** *** *** IF SWITCHES ARE NOT IMPLEMENTED NC2114.2 +164500* THE CONDITION-NAMES WILL AUTOMATICALLY BE ASSIGNED TO AN NC2114.2 +164600* 01 IN WORKING-STORAGE THEREBY SATISFYING THE TEST. NC2114.2 +164700* NOTE CC--TEST-GF-43 TESTS SWITCH-STATUS CONDITIONS WITH NC2114.2 +164800* SEVERAL TYPES OF LOGICAL CONNECTORS INCLUDING NC2114.2 +164900* PARENTHESES --- NC2114.2 +165000* FIRST LINE TRUE NC2114.2 +165100* SECOND LINE TRUE NC2114.2 +165200* FIRST PLUS SECOND LINES (WITHIN PARENS) TRUE NC2114.2 +165300* FIRST PLUS SECOND LINES FALSE NC2114.2 +165400* THIRD LINE TRUE. NC2114.2 +165500 GO TO CC--WRITE-GF-43. NC2114.2 +165600 CC--DELETE-GF-43. NC2114.2 +165700 PERFORM DE-LETE. NC2114.2 +165800 GO TO CC--WRITE-GF-43. NC2114.2 +165900 CC--FAIL-GF-43. NC2114.2 +166000 PERFORM FAIL. NC2114.2 +166100 CC--WRITE-GF-43. NC2114.2 +166200 PERFORM PRINT-DETAIL. NC2114.2 +166300* NC2114.2 +166400 CC--INIT-GF-44. NC2114.2 +166500 MOVE "CC--TEST-GF-44" TO PAR-NAME. NC2114.2 +166600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +166700 MOVE " SWITCH CONDITIONS" TO FEATURE. NC2114.2 +166800 CC--TEST-GF-44. NC2114.2 +166900 IF ON-WRK-SWITCH-1 NC2114.2 +167000 OR NOT OFF-WRK-SWITCH-2 NC2114.2 +167100 AND OFF-WRK-SWITCH-1 NC2114.2 +167200 PERFORM PASS NC2114.2 +167300 ELSE NC2114.2 +167400 GO TO CC--FAIL-GF-44. NC2114.2 +167500* NOTE CC--TEST-GF-44 TESTS SWITCH-STATUS CONDITIONS WITH NC2114.2 +167600* SEVERAL TYPES OF LOGICAL CONNECTORS BUT WITHOUT NC2114.2 +167700* PARENTHESES --- NC2114.2 +167800* FIRST LINE TRUE NC2114.2 +167900* SECOND LINE FALSE NC2114.2 +168000* THIRD LINE FALSE. NC2114.2 +168100 GO TO CC--WRITE-GF-44. NC2114.2 +168200 CC--DELETE-GF-44. NC2114.2 +168300 PERFORM DE-LETE. NC2114.2 +168400 GO TO CC--WRITE-GF-44. NC2114.2 +168500 CC--FAIL-GF-44. NC2114.2 +168600 PERFORM FAIL. NC2114.2 +168700 CC--WRITE-GF-44. NC2114.2 +168800 PERFORM PRINT-DETAIL. NC2114.2 +168900* NC2114.2 +169000 CC--INIT-GF-45. NC2114.2 +169100 MOVE "CC--TEST-GF-45" TO PAR-NAME. NC2114.2 +169200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +169300 MOVE " CONDITION-NAMES" TO FEATURE. NC2114.2 +169400 MOVE "AA" TO AA. NC2114.2 +169500 MOVE "CD" TO BB. NC2114.2 +169600 MOVE "C" TO AAA. NC2114.2 +169700 CC--TEST-GF-45. NC2114.2 +169800 IF NOT (A1 OR NC2114.2 +169900 B1) NC2114.2 +170000 AND NOT AA1 NC2114.2 +170100 GO TO CC--FAIL-GF-45 NC2114.2 +170200 ELSE NC2114.2 +170300 PERFORM PASS. NC2114.2 +170400* NOTE CC--TEST-GF-45 TESTS CONDITION-NAME CONDITIONS WITH NC2114.2 +170500* SEVERAL TYPES OF LOGICAL CONNECTORS INCLUDING NC2114.2 +170600* PARENTHESES --- NC2114.2 +170700* FIRST LINE TRUE NC2114.2 +170800* SECOND LINE FALSE NC2114.2 +170900* FIRST PLUS SECOND LINE (WITHIN PARENS) TRUE NC2114.2 +171000* FIRST PLUS SECOND LINE FALSE NC2114.2 +171100* THIRD LINE TRUE. NC2114.2 +171200 GO TO CC--WRITE-GF-45. NC2114.2 +171300 CC--DELETE-GF-45. NC2114.2 +171400 PERFORM DE-LETE. NC2114.2 +171500 GO TO CC--WRITE-GF-45. NC2114.2 +171600 CC--FAIL-GF-45. NC2114.2 +171700 PERFORM FAIL. NC2114.2 +171800 CC--WRITE-GF-45. NC2114.2 +171900 PERFORM PRINT-DETAIL. NC2114.2 +172000* NC2114.2 +172100 CC--INIT-GF-46. NC2114.2 +172200 MOVE "CC--TEST-GF-46" TO PAR-NAME. NC2114.2 +172300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +172400 MOVE " CONDITION-NAMES" TO FEATURE. NC2114.2 +172500 MOVE "AB" TO AA. NC2114.2 +172600 MOVE "CD" TO BB. NC2114.2 +172700 MOVE "A" TO AAA. NC2114.2 +172800 CC--TEST-GF-46. NC2114.2 +172900 IF A1 NC2114.2 +173000 OR NOT B1 NC2114.2 +173100 AND AA1 NC2114.2 +173200 PERFORM PASS NC2114.2 +173300 ELSE NC2114.2 +173400 GO TO CC--FAIL-GF-46. NC2114.2 +173500* NOTE CC--TEST-GF-46 TESTS CONDITION-NAME CONDITIONS WITH NC2114.2 +173600* SEVERAL TYPES OF LOGICAL CONNECTORS BUT NO NC2114.2 +173700* PARENTHESES --- NC2114.2 +173800* FIRST LINE FALSE NC2114.2 +173900* SECOND LINE TRUE NC2114.2 +174000* THIRD LINE TRUE. NC2114.2 +174100 GO TO CC--WRITE-GF-46. NC2114.2 +174200 CC--DELETE-GF-46. NC2114.2 +174300 PERFORM DE-LETE. NC2114.2 +174400 GO TO CC--WRITE-GF-46. NC2114.2 +174500 CC--FAIL-GF-46. NC2114.2 +174600 PERFORM FAIL. NC2114.2 +174700 CC--WRITE-GF-46. NC2114.2 +174800 PERFORM PRINT-DETAIL. NC2114.2 +174900* PAUL WOZ UPTO HERE. NC2114.2 +175000 CC--INIT-GF-47. NC2114.2 +175100 MOVE " MIXED CONDITIONS" TO FEATURE. NC2114.2 +175200 MOVE -1 TO IF-D32. NC2114.2 +175300 MOVE "ABCD4" TO CLASS-1. NC2114.2 +175400 MOVE -1 TO SIGN-1. NC2114.2 +175500 CC--TEST-GF-47. NC2114.2 +175600* NOTE IF SWITCHES ARE NOT IMPLEMENTED SWITCH-1 WILL NC2114.2 +175700* BE AUTOMATICALLY TURNED ON TO FULFILL THE REQUIREMENTS NC2114.2 +175800* OF THIS TEST. NC2114.2 +175900 IF NOT TWO > THREE NC2114.2 +176000 AND NOT (ON-WRK-SWITCH-1 AND NC2114.2 +176100 F OR NC2114.2 +176200 CLASS-1 ALPHABETIC) NC2114.2 +176300 OR TWO = THREE NC2114.2 +176400 AND SIGN-1 ZERO NC2114.2 +176500 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +176600* NOTE CC--TEST-GF-47 TESTS A COMPOUND CONDITION WHICH NC2114.2 +176700* CONTAINS ALL OF THE TYPES OF SIMPLE CONDITIONS AND NC2114.2 +176800* SEVERAL TYPES OF LOGICAL CONNECTORS --- NC2114.2 +176900* FIRST LINE TRUE NC2114.2 +177000* SECOND LINE TRUE NC2114.2 +177100* THIRD LINE FALSE NC2114.2 +177200* FOURTH LINE FALSE NC2114.2 +177300* SECOND THRU FOURTH LINES (WITHIN PARENS) FALSE NC2114.2 +177400* SECOND THRU FOURTH LINES TRUE NC2114.2 +177500* FIRST THRU FOURTH LINES TRUE NC2114.2 +177600* FIFTH LINE FALSE NC2114.2 +177700* SIXTH LINE FALSE NC2114.2 +177800* FIFTH THRU SIXTH LINES FALSE. NC2114.2 +177900 GO TO CC--WRITE-GF-47. NC2114.2 +178000 CC--DELETE-GF-47. NC2114.2 +178100 PERFORM DE-LETE. NC2114.2 +178200 CC--WRITE-GF-47. NC2114.2 +178300 MOVE "CC--TEST-GF-47" TO PAR-NAME. NC2114.2 +178400 PERFORM PRINT-DETAIL. NC2114.2 +178500 CC--TEST-GF-48. NC2114.2 +178600 MOVE +9 TO SIGN-1. NC2114.2 +178700 MOVE -5 TO SIGN-2. NC2114.2 +178800 MOVE "+1234" TO CLASS-1. NC2114.2 +178900 MOVE 1235 TO IF-D32. NC2114.2 +179000* NOTE IF SWITCHES ARE NOT IMPLEMENTED SWITCH-1 WILL BE NC2114.2 +179100* AUTOMATICALLY TURNED ON TO FULFILL THE REQUIREMENTS NC2114.2 +179200* OF THIS TEST. NC2114.2 +179300 IF FOUR GREATER THAN 2.5 NC2114.2 +179400 AND EQUAL TO QUATROS NC2114.2 +179500 AND (FOUR = TEN OR NC2114.2 +179600 NOT < TEN OR NC2114.2 +179700 SIGN-1 POSITIVE AND NC2114.2 +179800 (SIGN-2 NOT NEGATIVE OR NC2114.2 +179900 CLASS-1 NOT NUMERIC)) NC2114.2 +180000 AND NOT OFF-WRK-SWITCH-1 NC2114.2 +180100 OR E NC2114.2 +180200 AND F NC2114.2 +180300 OR NOT G NC2114.2 +180400 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +180500* NOTE CC--TEST-GF-48 TESTS A COMPOUND CONDITION WHICH NC2114.2 +180600* CONTAINS ALL OF THE TYPES OF SIMPLE CONDITIONS AND NC2114.2 +180700* SEVERAL TYPES OF LOGICAL CONNECTORS --- NC2114.2 +180800* * FIRST LINE TRUE NC2114.2 +180900* * SECOND ABBREVIATED LINE TRUE NC2114.2 +181000* THIRD LINE FALSE NC2114.2 +181100* FOURTH LINE FALSE NC2114.2 +181200* FIFTH LINE TRUE NC2114.2 +181300* SIXTH LINE FALSE NC2114.2 +181400* SEVENTH LINE TRUE NC2114.2 +181500* SIXTH PLUS SEVENTH LINES TRUE NC2114.2 +181600* * THIRD THRU SEVENTH LINES TRUE NC2114.2 +181700* * EIGHTH LINE TRUE NC2114.2 +181800* ** FIRST THRU EIGHTH LINES TRUE NC2114.2 +181900* NINTH LINE FALSE NC2114.2 +182000* TENTH LINE TRUE NC2114.2 +182100* ** NINTH PLUS TENTH LINES FALSE NC2114.2 +182200* ** ELEVENTH LINE FALSE. NC2114.2 +182300 GO TO CC--WRITE-GF-48. NC2114.2 +182400 CC--DELETE-GF-48. NC2114.2 +182500 PERFORM DE-LETE. NC2114.2 +182600 CC--WRITE-GF-48. NC2114.2 +182700 MOVE "CC--TEST-GF-48" TO PAR-NAME. NC2114.2 +182800 PERFORM PRINT-DETAIL. NC2114.2 +182900 FIG-INIT-A. NC2114.2 +183000 PERFORM END-ROUTINE. NC2114.2 +183100 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC2114.2 +183200 FIG-TEST-1. NC2114.2 +183300 MOVE SUB-GRP-FOR-2N058-A TO SUB-GRP-FOR-2N058-B. NC2114.2 +183400 IF SUB-SUB-BA EQUAL TO "000000 ABCABC" NC2114.2 +183500 PERFORM PASS GO TO FIG-WRITE-1. NC2114.2 +183600 GO TO FIG-FAIL-1. NC2114.2 +183700 FIG-DELETE-1. NC2114.2 +183800 PERFORM DE-LETE. NC2114.2 +183900 GO TO FIG-WRITE-1. NC2114.2 +184000 FIG-FAIL-1. NC2114.2 +184100 MOVE SUB-SUB-BA TO COMPUTED-A. NC2114.2 +184200 MOVE "000000 ABCABC" TO CORRECT-A. NC2114.2 +184300 PERFORM FAIL. NC2114.2 +184400 FIG-WRITE-1. NC2114.2 +184500 MOVE "FIG-TEST-1" TO PAR-NAME. NC2114.2 +184600 PERFORM PRINT-DETAIL. NC2114.2 +184700 FIG-TEST-2. NC2114.2 +184800 IF SUB-SUB-BB EQUAL TO "ZZZ 000000" NC2114.2 +184900 PERFORM PASS GO TO FIG-WRITE-2. NC2114.2 +185000* NOTE THIS TEST DEPENDS UPON THE RESULT OF FIG-TEST-1. NC2114.2 +185100 GO TO FIG-FAIL-2. NC2114.2 +185200 FIG-DELETE-2. NC2114.2 +185300 PERFORM DE-LETE. NC2114.2 +185400 GO TO FIG-WRITE-2. NC2114.2 +185500 FIG-FAIL-2. NC2114.2 +185600 MOVE SUB-SUB-BB TO COMPUTED-A. NC2114.2 +185700 MOVE "ZZZ 000000" TO CORRECT-A. NC2114.2 +185800 PERFORM FAIL. NC2114.2 +185900 FIG-WRITE-2. NC2114.2 +186000 MOVE "FIG-TEST-2" TO PAR-NAME. NC2114.2 +186100 PERFORM PRINT-DETAIL. NC2114.2 +186200 FIG-TEST-3. NC2114.2 +186300 IF ELEM-FOR-2N058-I OF SUB-SUB-BC NOT EQUAL TO QUOTE NC2114.2 +186400 GO TO FIG-FAIL-3. NC2114.2 +186500 IF ELEM-FOR-2N058-J OF SUB-SUB-BC NOT EQUAL TO QUOTE NC2114.2 +186600 GO TO FIG-FAIL-3. NC2114.2 +186700 IF ELEM-FOR-2N058-K OF SUB-SUB-BC NOT EQUAL TO HIGH-VALUE NC2114.2 +186800 GO TO FIG-FAIL-3. NC2114.2 +186900 IF ELEM-FOR-2N058-L OF SUB-SUB-BC NOT EQUAL TO LOW-VALUE NC2114.2 +187000 GO TO FIG-FAIL-3. NC2114.2 +187100 IF ELEM-FOR-2N058-M OF SUB-SUB-BC NOT EQUAL TO HIGH-VALUE NC2114.2 +187200 GO TO FIG-FAIL-3. NC2114.2 +187300 IF ELEM-FOR-2N058-N OF SUB-SUB-BC NOT EQUAL TO LOW-VALUE NC2114.2 +187400 GO TO FIG-FAIL-3. NC2114.2 +187500 PERFORM PASS. NC2114.2 +187600 GO TO FIG-WRITE-3. NC2114.2 +187700 FIG-DELETE-3. NC2114.2 +187800 PERFORM DE-LETE. NC2114.2 +187900 GO TO FIG-WRITE-3. NC2114.2 +188000 FIG-FAIL-3. NC2114.2 +188100 MOVE SPACE TO FEATURE. NC2114.2 +188200 MOVE "6 QUOTES, 3 HIGH-VALUES," TO RE-MARK. NC2114.2 +188300 PERFORM PRINT-DETAIL. NC2114.2 +188400 MOVE "3 LOW-VALUES, 3 HIGH-VALUES" TO RE-MARK. NC2114.2 +188500 PERFORM PRINT-DETAIL. NC2114.2 +188600 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC2114.2 +188700 MOVE SUB-SUB-BC TO COMPUTED-A. NC2114.2 +188800 MOVE "SEE REMARKS" TO CORRECT-A. NC2114.2 +188900 MOVE "3 LOW-VALUES" TO RE-MARK. NC2114.2 +189000 PERFORM FAIL. NC2114.2 +189100 FIG-WRITE-3. NC2114.2 +189200 MOVE "FIG-TEST-3" TO PAR-NAME. NC2114.2 +189300 PERFORM PRINT-DETAIL. NC2114.2 +189400 CCVS-EXIT SECTION. NC2114.2 +189500 CCVS-999999. NC2114.2 +189600 GO TO CLOSE-FILES. NC2114.2 +*END-OF,NC211A +*HEADER,COBOL,NC214M +000100 IDENTIFICATION DIVISION. NC2144.2 +000200 PROGRAM-ID. NC2144.2 +000300 NC214M. NC2144.2 +000400**************************************************************** NC2144.2 +000500* * NC2144.2 +000600* VALIDATION FOR:- * NC2144.2 +000700* * NC2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +000900* * NC2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2144.2 +001100* * NC2144.2 +001200**************************************************************** NC2144.2 +001300* * NC2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2144.2 +001500* * NC2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2144.2 +001900* * NC2144.2 +002000**************************************************************** NC2144.2 +002100* * NC2144.2 +002200* PROGRAM NC214M TESTS FORMAT 2 OF THE "ACCEPT" STATEMENT. * NC2144.2 +002300* * NC2144.2 +002400**************************************************************** NC2144.2 +002500 ENVIRONMENT DIVISION. NC2144.2 +002600 CONFIGURATION SECTION. NC2144.2 +002700 SOURCE-COMPUTER. NC2144.2 +002800 XXXXX082. NC2144.2 +002900 OBJECT-COMPUTER. NC2144.2 +003000 XXXXX083 NC2144.2 +003100 PROGRAM COLLATING SEQUENCE IS N-A-T-I-V-E. NC2144.2 +003200 SPECIAL-NAMES. NC2144.2 +003300* NC2144.2 +003400* NC2144.2 +003500* THE FOLLOWING IS THE ALPHABET FOR THE PROGRAM COLLATING NC2144.2 +003600* SEQUENCE CLAUSE. NC2144.2 +003700* NC2144.2 +003800 ALPHABET NC2144.2 +003900 N-A-T-I-V-E IS NATIVE NC2144.2 +004000* NC2144.2 +004100* NC2144.2 +004200* NC2144.2 +004300* NC2144.2 +004400 ALPHABET NC2144.2 +004500 THE-ONE-CHARACTER-ALPHABET IS "Q" ALSO LOW-VALUE NC2144.2 +004600 ALSO HIGH-VALUE NC2144.2 +004700 ALSO QUOTE NC2144.2 +004800 ALSO SPACES. NC2144.2 +004900* NC2144.2 +005000* NC2144.2 +005100* COLLATING-AND-ALPHABET-TEST-9 ***** TEST OF SYNTAX NC2144.2 +005200* ON THE PROGRAM COLLATING SEQUENCE CLAUSE AND ALPHABET-NAME NC2144.2 +005300* CLAUSES. NC2144.2 +005400* NC2144.2 +005500* NC2144.2 +005600 INPUT-OUTPUT SECTION. NC2144.2 +005700 FILE-CONTROL. NC2144.2 +005800 SELECT PRINT-FILE ASSIGN TO NC2144.2 +005900 XXXXX055. NC2144.2 +006000 DATA DIVISION. NC2144.2 +006100 FILE SECTION. NC2144.2 +006200 FD PRINT-FILE. NC2144.2 +006300 01 PRINT-REC PICTURE X(120). NC2144.2 +006400 01 DUMMY-RECORD PICTURE X(120). NC2144.2 +006500 WORKING-STORAGE SECTION. NC2144.2 +006600 01 WRK-DU-6V0-1 PIC 9(6) VALUE ZERO. NC2144.2 +006700 01 WRK-DU-5V0-1 PIC 9(5) VALUE ZERO. NC2144.2 +006800 01 WRK-DU-8V0-1 PIC 9(8) VALUE ZERO. NC2144.2 +006900 01 WRK-XN-120-1 PIC X(120) VALUE NC2144.2 +007000 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007100- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007200- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007400- "". NC2144.2 +007500 01 WRK-DU-2V1-1 PIC 99V9 VALUE ZERO. NC2144.2 +007600 01 WRK-DU-0V1-1 PIC V9 VALUE .1. NC2144.2 +007700 01 WRK-DU-2V1-2 PIC 99V9 VALUE 0.1. NC2144.2 +007800 01 WRK-DU-2V1-3 PIC 99V9 VALUE 11.1. NC2144.2 +007900 01 WRK-DU-1V0-1 PIC 9 VALUE 9. NC2144.2 +008000 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2144.2 +008100 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2144.2 +008200 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2144.2 +008300 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2144.2 +008400 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2144.2 +008500 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2144.2 +008600 01 COUNT-DU-6V0 PIC 9(6). NC2144.2 +008700 01 TEST-RESULTS. NC2144.2 +008800 02 FILLER PIC X VALUE SPACE. NC2144.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. NC2144.2 +009000 02 FILLER PIC X VALUE SPACE. NC2144.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. NC2144.2 +009200 02 FILLER PIC X VALUE SPACE. NC2144.2 +009300 02 PAR-NAME. NC2144.2 +009400 03 FILLER PIC X(19) VALUE SPACE. NC2144.2 +009500 03 PARDOT-X PIC X VALUE SPACE. NC2144.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. NC2144.2 +009700 02 FILLER PIC X(8) VALUE SPACE. NC2144.2 +009800 02 RE-MARK PIC X(61). NC2144.2 +009900 01 TEST-COMPUTED. NC2144.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2144.2 +010100 02 FILLER PIC X(17) VALUE NC2144.2 +010200 " COMPUTED=". NC2144.2 +010300 02 COMPUTED-X. NC2144.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2144.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A NC2144.2 +010600 PIC -9(9).9(9). NC2144.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2144.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2144.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2144.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. NC2144.2 +011100 04 COMPUTED-18V0 PIC -9(18). NC2144.2 +011200 04 FILLER PIC X. NC2144.2 +011300 03 FILLER PIC X(50) VALUE SPACE. NC2144.2 +011400 01 TEST-CORRECT. NC2144.2 +011500 02 FILLER PIC X(30) VALUE SPACE. NC2144.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2144.2 +011700 02 CORRECT-X. NC2144.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2144.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2144.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2144.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2144.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2144.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. NC2144.2 +012400 04 CORRECT-18V0 PIC -9(18). NC2144.2 +012500 04 FILLER PIC X. NC2144.2 +012600 03 FILLER PIC X(2) VALUE SPACE. NC2144.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2144.2 +012800 01 CCVS-C-1. NC2144.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2144.2 +013000- "SS PARAGRAPH-NAME NC2144.2 +013100- " REMARKS". NC2144.2 +013200 02 FILLER PIC X(20) VALUE SPACE. NC2144.2 +013300 01 CCVS-C-2. NC2144.2 +013400 02 FILLER PIC X VALUE SPACE. NC2144.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". NC2144.2 +013600 02 FILLER PIC X(15) VALUE SPACE. NC2144.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". NC2144.2 +013800 02 FILLER PIC X(94) VALUE SPACE. NC2144.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2144.2 +014000 01 REC-CT PIC 99 VALUE ZERO. NC2144.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2144.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2144.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2144.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2144.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2144.2 +015000 01 CCVS-H-1. NC2144.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2144.2 +015200 02 FILLER PIC X(42) VALUE NC2144.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2144.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2144.2 +015500 01 CCVS-H-2A. NC2144.2 +015600 02 FILLER PIC X(40) VALUE SPACE. NC2144.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2144.2 +015800 02 FILLER PIC XXXX VALUE NC2144.2 +015900 "4.2 ". NC2144.2 +016000 02 FILLER PIC X(28) VALUE NC2144.2 +016100 " COPY - NOT FOR DISTRIBUTION". NC2144.2 +016200 02 FILLER PIC X(41) VALUE SPACE. NC2144.2 +016300 NC2144.2 +016400 01 CCVS-H-2B. NC2144.2 +016500 02 FILLER PIC X(15) VALUE NC2144.2 +016600 "TEST RESULT OF ". NC2144.2 +016700 02 TEST-ID PIC X(9). NC2144.2 +016800 02 FILLER PIC X(4) VALUE NC2144.2 +016900 " IN ". NC2144.2 +017000 02 FILLER PIC X(12) VALUE NC2144.2 +017100 " HIGH ". NC2144.2 +017200 02 FILLER PIC X(22) VALUE NC2144.2 +017300 " LEVEL VALIDATION FOR ". NC2144.2 +017400 02 FILLER PIC X(58) VALUE NC2144.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +017600 01 CCVS-H-3. NC2144.2 +017700 02 FILLER PIC X(34) VALUE NC2144.2 +017800 " FOR OFFICIAL USE ONLY ". NC2144.2 +017900 02 FILLER PIC X(58) VALUE NC2144.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2144.2 +018100 02 FILLER PIC X(28) VALUE NC2144.2 +018200 " COPYRIGHT 1985 ". NC2144.2 +018300 01 CCVS-E-1. NC2144.2 +018400 02 FILLER PIC X(52) VALUE SPACE. NC2144.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2144.2 +018600 02 ID-AGAIN PIC X(9). NC2144.2 +018700 02 FILLER PIC X(45) VALUE SPACES. NC2144.2 +018800 01 CCVS-E-2. NC2144.2 +018900 02 FILLER PIC X(31) VALUE SPACE. NC2144.2 +019000 02 FILLER PIC X(21) VALUE SPACE. NC2144.2 +019100 02 CCVS-E-2-2. NC2144.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2144.2 +019300 03 FILLER PIC X VALUE SPACE. NC2144.2 +019400 03 ENDER-DESC PIC X(44) VALUE NC2144.2 +019500 "ERRORS ENCOUNTERED". NC2144.2 +019600 01 CCVS-E-3. NC2144.2 +019700 02 FILLER PIC X(22) VALUE NC2144.2 +019800 " FOR OFFICIAL USE ONLY". NC2144.2 +019900 02 FILLER PIC X(12) VALUE SPACE. NC2144.2 +020000 02 FILLER PIC X(58) VALUE NC2144.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +020200 02 FILLER PIC X(13) VALUE SPACE. NC2144.2 +020300 02 FILLER PIC X(15) VALUE NC2144.2 +020400 " COPYRIGHT 1985". NC2144.2 +020500 01 CCVS-E-4. NC2144.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2144.2 +020700 02 FILLER PIC X(4) VALUE " OF ". NC2144.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2144.2 +020900 02 FILLER PIC X(40) VALUE NC2144.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2144.2 +021100 01 XXINFO. NC2144.2 +021200 02 FILLER PIC X(19) VALUE NC2144.2 +021300 "*** INFORMATION ***". NC2144.2 +021400 02 INFO-TEXT. NC2144.2 +021500 04 FILLER PIC X(8) VALUE SPACE. NC2144.2 +021600 04 XXCOMPUTED PIC X(20). NC2144.2 +021700 04 FILLER PIC X(5) VALUE SPACE. NC2144.2 +021800 04 XXCORRECT PIC X(20). NC2144.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). NC2144.2 +022000 01 HYPHEN-LINE. NC2144.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. NC2144.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************NC2144.2 +022300- "*****************************************". NC2144.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************NC2144.2 +022500- "******************************". NC2144.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE NC2144.2 +022700 "NC214M". NC2144.2 +022800 PROCEDURE DIVISION. NC2144.2 +022900 CCVS1 SECTION. NC2144.2 +023000 OPEN-FILES. NC2144.2 +023100 OPEN OUTPUT PRINT-FILE. NC2144.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2144.2 +023300 MOVE SPACE TO TEST-RESULTS. NC2144.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2144.2 +023500 GO TO CCVS1-EXIT. NC2144.2 +023600 CLOSE-FILES. NC2144.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2144.2 +023800 TERMINATE-CCVS. NC2144.2 +023900S EXIT PROGRAM. NC2144.2 +024000STERMINATE-CALL. NC2144.2 +024100 STOP RUN. NC2144.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2144.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2144.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2144.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2144.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. NC2144.2 +024700 PRINT-DETAIL. NC2144.2 +024800 IF REC-CT NOT EQUAL TO ZERO NC2144.2 +024900 MOVE "." TO PARDOT-X NC2144.2 +025000 MOVE REC-CT TO DOTVALUE. NC2144.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2144.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2144.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2144.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2144.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2144.2 +025600 MOVE SPACE TO CORRECT-X. NC2144.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2144.2 +025800 MOVE SPACE TO RE-MARK. NC2144.2 +025900 HEAD-ROUTINE. NC2144.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2144.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2144.2 +026400 COLUMN-NAMES-ROUTINE. NC2144.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +026800 END-ROUTINE. NC2144.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2144.2 +027000 END-RTN-EXIT. NC2144.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +027200 END-ROUTINE-1. NC2144.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2144.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2144.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. NC2144.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2144.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2144.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2144.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2144.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2144.2 +028100 END-ROUTINE-12. NC2144.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2144.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2144.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2144.2 +028500 ELSE NC2144.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2144.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2144.2 +028800 PERFORM WRITE-LINE. NC2144.2 +028900 END-ROUTINE-13. NC2144.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2144.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE NC2144.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2144.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2144.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO NC2144.2 +029600 MOVE "NO " TO ERROR-TOTAL NC2144.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2144.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2144.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +030100 WRITE-LINE. NC2144.2 +030200 ADD 1 TO RECORD-COUNT. NC2144.2 +030300Y IF RECORD-COUNT GREATER 50 NC2144.2 +030400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2144.2 +030500Y MOVE SPACE TO DUMMY-RECORD NC2144.2 +030600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2144.2 +030700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2144.2 +030800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2144.2 +030900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2144.2 +031000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2144.2 +031100Y MOVE ZERO TO RECORD-COUNT. NC2144.2 +031200 PERFORM WRT-LN. NC2144.2 +031300 WRT-LN. NC2144.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2144.2 +031500 MOVE SPACE TO DUMMY-RECORD. NC2144.2 +031600 BLANK-LINE-PRINT. NC2144.2 +031700 PERFORM WRT-LN. NC2144.2 +031800 FAIL-ROUTINE. NC2144.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2144.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2144.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2144.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2144.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2144.2 +032500 GO TO FAIL-ROUTINE-EX. NC2144.2 +032600 FAIL-ROUTINE-WRITE. NC2144.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2144.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2144.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2144.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2144.2 +033100 FAIL-ROUTINE-EX. EXIT. NC2144.2 +033200 BAIL-OUT. NC2144.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2144.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2144.2 +033500 BAIL-OUT-WRITE. NC2144.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2144.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2144.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2144.2 +034000 BAIL-OUT-EX. EXIT. NC2144.2 +034100 CCVS1-EXIT. NC2144.2 +034200 EXIT. NC2144.2 +034300 SECT-NC214M-001 SECTION. NC2144.2 +034400 ACC-INIT-F2-1. NC2144.2 +034500* ===---> TEST THE ACCEPT FROM DATE STATEMENT <---=== NC2144.2 +034600 MOVE "ACC-TEST-F2-1" TO PAR-NAME. NC2144.2 +034700 MOVE "VI-72 6.5.4 GR7" TO ANSI-REFERENCE. NC2144.2 +034800 MOVE "ACCEPT DATE" TO FEATURE. NC2144.2 +034900 ACC-TEST-F2-1. NC2144.2 +035000 ACCEPT WRK-DU-6V0-1 FROM DATE. NC2144.2 +035100 MOVE WRK-DU-6V0-1 TO COMPUTED-N. NC2144.2 +035200 MOVE "DATE YYMMDD FORMAT" TO CORRECT-A. NC2144.2 +035300 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +035400 GO TO ACC-WRITE-F2-1. NC2144.2 +035500 ACC-DELETE-F2-1. NC2144.2 +035600 PERFORM DE-LETE. NC2144.2 +035700 ACC-WRITE-F2-1. NC2144.2 +035800 PERFORM PRINT-DETAIL. NC2144.2 +035900* NC2144.2 +036000 ACC-INIT-F2-2. NC2144.2 +036100* ===---> TEST THE ACCEPT FROM DAY STATEMENT <---=== NC2144.2 +036200 MOVE "ACC-TEST-F2-2" TO PAR-NAME. NC2144.2 +036300 MOVE "VI-72 6.5.4 GR8" TO ANSI-REFERENCE. NC2144.2 +036400 MOVE "ACCEPT DAY" TO FEATURE. NC2144.2 +036500 ACC-TEST-F2-2. NC2144.2 +036600 ACCEPT WRK-DU-5V0-1 FROM DAY. NC2144.2 +036700 MOVE WRK-DU-5V0-1 TO COMPUTED-N. NC2144.2 +036800 MOVE "DAY YYDDD FORMAT" TO CORRECT-A. NC2144.2 +036900 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +037000 GO TO ACC-WRITE-F2-2. NC2144.2 +037100 ACC-DELETE-F2-2. NC2144.2 +037200 PERFORM DE-LETE. NC2144.2 +037300 ACC-WRITE-F2-2. NC2144.2 +037400 PERFORM PRINT-DETAIL. NC2144.2 +037500* NC2144.2 +037600 ACC-INIT-F2-3. NC2144.2 +037700* ===---> TEST THE ACCEPT FROM TIME STATEMENT <---=== NC2144.2 +037800 MOVE "ACC-TEST-F2-3" TO PAR-NAME. NC2144.2 +037900 MOVE "VI-72 6.5.4 GR9" TO ANSI-REFERENCE. NC2144.2 +038000 MOVE "ACCEPT TIME" TO FEATURE. NC2144.2 +038100 ACC-TEST-F2-3. NC2144.2 +038200 ACCEPT WRK-DU-8V0-1 FROM TIME. NC2144.2 +038300 MOVE WRK-DU-8V0-1 TO COMPUTED-N. NC2144.2 +038400 MOVE "HHMMSSFF FORMAT" TO CORRECT-A. NC2144.2 +038500 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +038600 GO TO ACC-WRITE-F2-3. NC2144.2 +038700 ACC-DELETE-F2-3. NC2144.2 +038800 PERFORM DE-LETE. NC2144.2 +038900 ACC-WRITE-F2-3. NC2144.2 +039000 PERFORM PRINT-DETAIL. NC2144.2 +039100* NC2144.2 +039200 ACC-INIT-F2-4. NC2144.2 +039300* ===---> TEST THE ACCEPT FROM DAY-OF-WEEK STATEMENT <---=== NC2144.2 +039400 MOVE "ACC-TEST-F2-4" TO PAR-NAME. NC2144.2 +039500 MOVE "VI-72 6.5.4 GR10" TO ANSI-REFERENCE. NC2144.2 +039600 MOVE "ACCEPT DAY-OF-WEEK" TO FEATURE. NC2144.2 +039700 ACC-TEST-F2-4. NC2144.2 +039800 ACCEPT WRK-DU-1V0-1 FROM DAY-OF-WEEK. NC2144.2 +039900 MOVE WRK-DU-1V0-1 TO COMPUTED-N. NC2144.2 +040000 MOVE "SINGLE DIGIT INTEGER REPRESENTING DAY" TO CORRECT-A. NC2144.2 +040100 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +040200 GO TO ACC-WRITE-F2-4. NC2144.2 +040300 ACC-DELETE-F2-4. NC2144.2 +040400 PERFORM DE-LETE. NC2144.2 +040500 ACC-WRITE-F2-4. NC2144.2 +040600 PERFORM PRINT-DETAIL. NC2144.2 +040700 CCVS-EXIT SECTION. NC2144.2 +040800 CCVS-999999. NC2144.2 +040900 GO TO CLOSE-FILES. NC2144.2 +*END-OF,NC214M +*HEADER,COBOL,NC215A +000100 IDENTIFICATION DIVISION. NC2154.2 +000200 PROGRAM-ID. NC2154.2 +000300 NC215A. NC2154.2 +000400**************************************************************** NC2154.2 +000500* * NC2154.2 +000600* VALIDATION FOR:- * NC2154.2 +000700* * NC2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2154.2 +000900* * NC2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2154.2 +001100* * NC2154.2 +001200**************************************************************** NC2154.2 +001300* * NC2154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2154.2 +001500* * NC2154.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2154.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2154.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2154.2 +001900* * NC2154.2 +002000**************************************************************** NC2154.2 +002100* NC2154.2 +002200* * NC2154.2 +002300* PROGRAM NC215A TESTS THE LITERAL PHRASE OF THE "ALPHABET" * NC2154.2 +002400* CLAUSE OF THE "SPECIAL-NAMES" PARAGRAPH AND THE * NC2154.2 +002500* "PROGRAM COLLATING SEQUENCE" OF THE "OBJECT COMPUTER * NC2154.2 +002600* PARAGRAPH. * NC2154.2 +002700* * NC2154.2 +002800**************************************************************** NC2154.2 +002900 ENVIRONMENT DIVISION. NC2154.2 +003000 CONFIGURATION SECTION. NC2154.2 +003100 SOURCE-COMPUTER. NC2154.2 +003200 XXXXX082. NC2154.2 +003300 OBJECT-COMPUTER. NC2154.2 +003400 XXXXX083 NC2154.2 +003500 PROGRAM COLLATING SEQUENCE IS THE-WILD-ONE. NC2154.2 +003600 SPECIAL-NAMES. NC2154.2 +003700 ALPHABET NC2154.2 +003800 THE-WILD-ONE IS "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO NC2154.2 +003900 "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9", NC2154.2 +004000* NC2154.2 +004100* NC2154.2 +004200*ALPHABET-TEST-10 ***** THE WHOLE ALPHABET IS ONE LITERAL NC2154.2 +004300* WITH ALL 51 CHARACTERS IN THE COBOL CHARACTER SET. TEST-10 NC2154.2 +004400* IS ONLY A SYNTAX CHECK ON NC2154.2 +004500* ALPHABET-NAME IS LITERAL. NC2154.2 +004600* NC2154.2 +004700* NC2154.2 +004800 ALPHABET NC2154.2 +004900 THE-BIG-OL-LITERAL-ALPHABET IS "A+0B-1C*2D/3E=4Fl5G,6H;7I.8J"NC2154.2 +005000- ""9K(L)M>N B-AN-1 PERFORM PASS NC2154.2 +036100 ELSE NC2154.2 +036200 GO TO SEQ-FAIL-GF-2. NC2154.2 +036300 GO TO SEQ-WRITE-GF-2. NC2154.2 +036400 SEQ-DELETE-GF-2. NC2154.2 +036500 PERFORM DE-LETE. NC2154.2 +036600 GO TO SEQ-WRITE-GF-2. NC2154.2 +036700 SEQ-FAIL-GF-2. NC2154.2 +036800 MOVE "H I J B NOT SEQUENCED" TO COMPUTED-A. NC2154.2 +036900 PERFORM FAIL. NC2154.2 +037000 SEQ-WRITE-GF-2. NC2154.2 +037100 PERFORM PRINT-DETAIL. NC2154.2 +037200* NC2154.2 +037300 SEQ-INIT-GF-3. NC2154.2 +037400 MOVE "SEQ-TEST-GF-3" TO PAR-NAME. NC2154.2 +037500 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +037600 MOVE "I J K L M N EQUAL" TO FEATURE. NC2154.2 +037700 MOVE "I" TO I-AN-1. NC2154.2 +037800 MOVE "J" TO J-AN-1. NC2154.2 +037900 MOVE "K" TO K-AN-1. NC2154.2 +038000 MOVE "L" TO L-AN-1. NC2154.2 +038100 MOVE "M" TO M-AN-1. NC2154.2 +038200 MOVE "N" TO N-AN-1. NC2154.2 +038300 SEQ-TEST-GF-3. NC2154.2 +038400 IF I-AN-1 = J-AN-1 AND K-AN-1 AND L-AN-1 AND M-AN-1 NC2154.2 +038500 AND N-AN-1 PERFORM PASS NC2154.2 +038600 ELSE NC2154.2 +038700 GO TO SEQ-FAIL-GF-3. NC2154.2 +038800 GO TO SEQ-WRITE-GF-3. NC2154.2 +038900 SEQ-DELETE-GF-3. NC2154.2 +039000 PERFORM DE-LETE. NC2154.2 +039100 GO TO SEQ-WRITE-GF-3. NC2154.2 +039200 SEQ-FAIL-GF-3. NC2154.2 +039300 MOVE "I J K L M N NOT =" TO COMPUTED-A. NC2154.2 +039400 PERFORM FAIL. NC2154.2 +039500 SEQ-WRITE-GF-3. NC2154.2 +039600 PERFORM PRINT-DETAIL. NC2154.2 +039700* NC2154.2 +039800 SEQ-INIT-GF-4. NC2154.2 +039900 MOVE "SEQ-TEST-GF-4" TO PAR-NAME. NC2154.2 +040000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +040100 MOVE "O > THAN N" TO FEATURE. NC2154.2 +040200 MOVE "O" TO O-AN-1. NC2154.2 +040300 MOVE "N" TO N-AN-1. NC2154.2 +040400 SEQ-TEST-GF-4. NC2154.2 +040500 IF O-AN-1 > N-AN-1 PERFORM PASS NC2154.2 +040600 ELSE NC2154.2 +040700 GO TO SEQ-FAIL-GF-4. NC2154.2 +040800 GO TO SEQ-WRITE-GF-4. NC2154.2 +040900 SEQ-DELETE-GF-4. NC2154.2 +041000 PERFORM DE-LETE. NC2154.2 +041100 GO TO SEQ-WRITE-GF-4. NC2154.2 +041200 SEQ-FAIL-GF-4. NC2154.2 +041300 MOVE "O NOT > THAN N" TO COMPUTED-A. NC2154.2 +041400 PERFORM FAIL. NC2154.2 +041500 SEQ-WRITE-GF-4. NC2154.2 +041600 PERFORM PRINT-DETAIL. NC2154.2 +041700* NC2154.2 +041800 SEQ-INIT-GF-5. NC2154.2 +041900 MOVE "SEQ-TEST-GF-5" TO PAR-NAME. NC2154.2 +042000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +042100 MOVE "A < THAN ZERO" TO FEATURE. NC2154.2 +042200 MOVE "A" TO A-AN-1. NC2154.2 +042300 MOVE ZERO TO ZERO-DU-9V0-1. NC2154.2 +042400 SEQ-TEST-GF-5. NC2154.2 +042500 IF A-AN-1 < ZERO-DU-9V0-1 PERFORM PASS NC2154.2 +042600 ELSE NC2154.2 +042700 GO TO SEQ-FAIL-GF-5. NC2154.2 +042800 GO TO SEQ-WRITE-GF-5. NC2154.2 +042900 SEQ-DELETE-GF-5. NC2154.2 +043000 PERFORM DE-LETE. NC2154.2 +043100 GO TO SEQ-WRITE-GF-5. NC2154.2 +043200 SEQ-FAIL-GF-5. NC2154.2 +043300 MOVE "A FOUND > THAN ZERO" TO COMPUTED-A. NC2154.2 +043400 PERFORM FAIL. NC2154.2 +043500 SEQ-WRITE-GF-5. NC2154.2 +043600 PERFORM PRINT-DETAIL. NC2154.2 +043700* NC2154.2 +043800 SEQ-INIT-GF-6. NC2154.2 +043900 MOVE "SEQ-TEST-GF-6" TO PAR-NAME. NC2154.2 +044000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +044100 MOVE "NINE < THAN SPACE" TO FEATURE. NC2154.2 +044200 MOVE 9 TO NINE-DU-9V0-1. NC2154.2 +044300 SEQ-TEST-GF-6. NC2154.2 +044400 IF NINE-DU-9V0-1 < SPACE PERFORM PASS NC2154.2 +044500 ELSE NC2154.2 +044600 GO TO SEQ-FAIL-GF-6. NC2154.2 +044700 GO TO SEQ-WRITE-GF-6. NC2154.2 +044800 SEQ-DELETE-GF-6. NC2154.2 +044900 PERFORM DE-LETE. NC2154.2 +045000 GO TO SEQ-WRITE-GF-6. NC2154.2 +045100 SEQ-FAIL-GF-6. NC2154.2 +045200 MOVE "9 FOUND > THAN SPACE" TO COMPUTED-A. NC2154.2 +045300 PERFORM FAIL. NC2154.2 +045400 SEQ-WRITE-GF-6. NC2154.2 +045500 PERFORM PRINT-DETAIL. NC2154.2 +045600* NC2154.2 +045700 SEQ-INIT-GF-7. NC2154.2 +045800 MOVE "SEQ-TEST-GF-7" TO PAR-NAME. NC2154.2 +045900 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +046000 MOVE "NINE < THAN QUOTE" TO FEATURE. NC2154.2 +046100 MOVE 9 TO NINE-DU-9V0-1. NC2154.2 +046200 SEQ-TEST-GF-7. NC2154.2 +046300 IF NINE-DU-9V0-1 < QUOTE PERFORM PASS NC2154.2 +046400 ELSE NC2154.2 +046500 GO TO SEQ-FAIL-GF-7. NC2154.2 +046600 GO TO SEQ-WRITE-GF-7. NC2154.2 +046700 SEQ-DELETE-GF-7. NC2154.2 +046800 PERFORM DE-LETE. NC2154.2 +046900 GO TO SEQ-WRITE-GF-7. NC2154.2 +047000 SEQ-FAIL-GF-7. NC2154.2 +047100 MOVE "NINE FOUND > QUOTE" TO COMPUTED-A. NC2154.2 +047200 PERFORM FAIL. NC2154.2 +047300 SEQ-WRITE-GF-7. NC2154.2 +047400 PERFORM PRINT-DETAIL. NC2154.2 +047500* NC2154.2 +047600 ALPHABET-TEST-10. NC2154.2 +047700 PERFORM END-ROUTINE. NC2154.2 +047800 MOVE " ALPHABET-NAME ***** CHECK THE ALPHABET-NAMENC2154.2 +047900- " IN THE SPECIAL-NAMES PARAGRAPH" TO TEST-RESULTS. NC2154.2 +048000 PERFORM PRINT-DETAIL. NC2154.2 +048100 CCVS-EXIT SECTION. NC2154.2 +048200 CCVS-999999. NC2154.2 +048300 GO TO CLOSE-FILES. NC2154.2 +*END-OF,NC215A +*HEADER,COBOL,NC216A +000100 IDENTIFICATION DIVISION. NC2164.2 +000200 PROGRAM-ID. NC2164.2 +000300 NC216A. NC2164.2 +000400**************************************************************** NC2164.2 +000500* * NC2164.2 +000600* VALIDATION FOR:- * NC2164.2 +000700* * NC2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +000900* * NC2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2164.2 +001100* * NC2164.2 +001200**************************************************************** NC2164.2 +001300* * NC2164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2164.2 +001500* * NC2164.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2164.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2164.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2164.2 +001900* * NC2164.2 +002000**************************************************************** NC2164.2 +002100* * NC2164.2 +002200* PROGRAM NC216A TESTS ALL FOUR FORMATS OF THE "INSPECT" * NC2164.2 +002300* STATEMENT USING VARIOUS COMBINATIONS OF THE OPTIONAL * NC2164.2 +002400* PHRASES: CHARACTERS, ALL, LEADING, FIRST, BEFORE, AFTER. * NC2164.2 +002500* * NC2164.2 +002600**************************************************************** NC2164.2 +002700 ENVIRONMENT DIVISION. NC2164.2 +002800 CONFIGURATION SECTION. NC2164.2 +002900 SOURCE-COMPUTER. NC2164.2 +003000 XXXXX082. NC2164.2 +003100 OBJECT-COMPUTER. NC2164.2 +003200 XXXXX083. NC2164.2 +003300 INPUT-OUTPUT SECTION. NC2164.2 +003400 FILE-CONTROL. NC2164.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2164.2 +003600 XXXXX055. NC2164.2 +003700 DATA DIVISION. NC2164.2 +003800 FILE SECTION. NC2164.2 +003900 FD PRINT-FILE. NC2164.2 +004000 01 PRINT-REC PICTURE X(120). NC2164.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2164.2 +004200 WORKING-STORAGE SECTION. NC2164.2 +004300 01 WRK-DU-999-1 PIC 999. NC2164.2 +004400 01 WRK-DU-999-2 PIC 999. NC2164.2 +004500 01 WRK-DU-999-3 PIC 999. NC2164.2 +004600 01 WRK-DU-999-4 PIC 999. NC2164.2 +004700 01 JUST-XN-20-1 PIC X(20) JUSTIFIED. NC2164.2 +004800 01 SPACE-XN-1-1 PIC X VALUE SPACE. NC2164.2 +004900 01 COMMA-XN-1-1 PIC X VALUE ",". NC2164.2 +005000 01 HYPEN-XN-1-1 PIC X VALUE "-". NC2164.2 +005100 01 A-XN-1-1 PIC X VALUE "A". NC2164.2 +005200 01 D-XN-1-1 PIC X VALUE "D". NC2164.2 +005300 01 G-XN-1-1 PIC X VALUE "G". NC2164.2 +005400 01 H-XN-1-1 PIC X VALUE "H". NC2164.2 +005500 01 L-XN-1-1 PIC X VALUE "L". NC2164.2 +005600 01 O-XN-1-1 PIC X VALUE "O". NC2164.2 +005700 01 P-XN-1-1 PIC X VALUE "P". NC2164.2 +005800 01 S-XN-1-1 PIC X VALUE "S". NC2164.2 +005900 01 Z-XN-1-1 PIC X VALUE "Z". NC2164.2 +006000 01 AH-XN-2 PIC X(2) VALUE "AH". NC2164.2 +006100 01 HSPACE-XN-2 PIC X(2) VALUE "H ". NC2164.2 +006200 01 OH-XN-2 PIC X(2) VALUE "OH". NC2164.2 +006300 01 ALL-XN-3 PIC X(3) VALUE "ALL". NC2164.2 +006400 01 YES-XN-3 PIC X(3) VALUE "YES". NC2164.2 +006500 01 X-SPACE-X-XN-3 PICTURE X(3) VALUE "X X". NC2164.2 +006600 01 AABA-XN-4 PICTURE X(4) VALUE "AABA". NC2164.2 +006700 01 WRK-XN-83-1 PIC X(83). NC2164.2 +006800 01 WRK-XN-83-2 PIC X(83). NC2164.2 +006900 01 WRK-DS-5V0-1 PIC S9(5) VALUE -12345. NC2164.2 +007000 01 WRK-NE-1 PIC -999,999.99/9 VALUE "-123,456.78/9". NC2164.2 +007100 01 KIDS-CAN-NOT-BE PIC X(15) VALUE "KIDS CAN NOT BE". NC2164.2 +007200 01 BLANK-PERIOD PIC X(2) VALUE " ." . NC2164.2 +007300 01 WC-XN-83 PIC X(83) VALUE NC2164.2 +007400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +007500- "IDS CAN NOT BE ALL BAD.". NC2164.2 +007600 01 ANS-XN-83-1 PIC X(83) VALUE NC2164.2 +007700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +007800- "IDS CAN NOT BE ALL BAD.". NC2164.2 +007900 01 ANS-XN-83-2 PIC X(83) VALUE NC2164.2 +008000 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008100- "IDS CAN NOT BE ALL BAD.". NC2164.2 +008200 01 ANS-XN-83-3 PIC X(83) VALUE NC2164.2 +008300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008400- "IDS CAN NOT BE ALL-BAD.". NC2164.2 +008500 01 ANS-XN-83-4 PIC X(83) VALUE NC2164.2 +008600 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008700- "IDS CAN NOT BE ALL BAD.". NC2164.2 +008800 01 ANS-XN-83-5 PIC X(83) VALUE NC2164.2 +008900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +009000- "IDS CAN NOT BE ALL BAD.". NC2164.2 +009100 01 ANS-XN-83-6 PIC X(83) VALUE NC2164.2 +009200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +009300- "IDS CAN NOT BE ALZZZZZZ". NC2164.2 +009400 01 ANS-XN-83-7 PIC X(83) VALUE NC2164.2 +009500 "OH-YES-AH-YES-W.P.-ZRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC2164.2 +009600- "IDS-CAN-NOT-BE-ALZZZZZZ". NC2164.2 +009700 01 ANS-XN-83-8 PIC X(83) VALUE NC2164.2 +009800 "AH-YES-AH-YES-W.C.-FRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC2164.2 +009900- "IDS-CAN-NOT-BE-ALL-BAD.". NC2164.2 +010000 01 ANS-XN-83-9 PIC X(83) VALUE NC2164.2 +010100 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2164.2 +010200- "IDS CAN NOT BE ALL BAD.". NC2164.2 +010300 01 ANS-XN-83-10 PIC X(83) VALUE NC2164.2 +010400 "OH YES AH YES W.C. FRITOES HE NC2164.2 +010500- " BE ALL BAD.". NC2164.2 +010600 01 ANS-XN-83-11 PIC X(83) VALUE NC2164.2 +010700 "OH YES AH NC2164.2 +010800- " D.". NC2164.2 +010900 NC2164.2 +011000 NC2164.2 +011100 01 WS-RIGHT-1-83. NC2164.2 +011200 03 WS-RIGHT-1-20 PIC X(20). NC2164.2 +011300 03 WS-RIGHT-21-40 PIC X(20). NC2164.2 +011400 03 WS-RIGHT-41-60 PIC X(20). NC2164.2 +011500 03 WS-RIGHT-61-80 PIC X(20). NC2164.2 +011600 03 WS-RIGHT-81-83 PIC X(3). NC2164.2 +011700 01 WS-WRONG-1-83. NC2164.2 +011800 03 WS-WRONG-1-20 PIC X(20). NC2164.2 +011900 03 WS-WRONG-21-40 PIC X(20). NC2164.2 +012000 03 WS-WRONG-41-60 PIC X(20). NC2164.2 +012100 03 WS-WRONG-61-80 PIC X(20). NC2164.2 +012200 03 WS-WRONG-81-83 PIC X(3). NC2164.2 +012300 NC2164.2 +012400 01 INSPECT-FIELDS. NC2164.2 +012500 03 GRP-A. NC2164.2 +012600 05 PIC X(7) VALUE "XXXXXXX". NC2164.2 +012700 05 PIC X(7) VALUE "YYYYYYY". NC2164.2 +012800 05 PIC X(7) VALUE "AAABAAA". NC2164.2 +012900 05 PIC X(7) VALUE "SSSSSSS". NC2164.2 +013000 05 PIC X(7) VALUE "TTTTTTT". NC2164.2 +013100 03 GRP-B REDEFINES GRP-A. NC2164.2 +013200 05 DATA-FIELD PIC X(7) OCCURS 5. NC2164.2 +013300 01 LOCATE-CHARS. NC2164.2 +013400 03 GRP-C. NC2164.2 +013500 05 PIC X VALUE "G". NC2164.2 +013600 05 PIC X VALUE "H". NC2164.2 +013700 05 PIC X VALUE "B". NC2164.2 +013800 05 PIC X VALUE "D". NC2164.2 +013900 05 PIC X VALUE "C". NC2164.2 +014000 03 GRP-D REDEFINES GRP-C. NC2164.2 +014100 05 END-CHAR PIC X OCCURS 5. NC2164.2 +014200 01 SUB PIC 9 COMP. NC2164.2 +014300 01 WS-BB PIC XX VALUE "BB". NC2164.2 +014400 01 WS-Y PIC X VALUE "Y". NC2164.2 +014500 01 WS-3 PIC X VALUE "3". NC2164.2 +014600 01 WS-E PIC X VALUE "E". NC2164.2 +014700 01 XN-DF PIC XX VALUE "DF". NC2164.2 +014800 01 XN-67 PIC XX VALUE "67". NC2164.2 +014900 01 XN-B PIC X VALUE "B". NC2164.2 +015000 01 TEST-31-DATA. NC2164.2 +015100 03 FILLER PIC X(48) VALUE NC2164.2 +015200 "AABBCCDDEBBBBGHDDIJJXXAABBCCDDEEEFFGGHHIIJJKKLLM". NC2164.2 +015300 01 TEST-32-DATA. NC2164.2 +015400 03 FILLER PIC X(48) VALUE NC2164.2 +015500 "AABSSSSSEBBTTTT1URSTSTSTVVDYYDEEEFFGSSSSTZSTZSTM". NC2164.2 +015600 01 TEST-34-DATA. NC2164.2 +015700 03 FILLER PIC X(20) VALUE NC2164.2 +015800 "AAFSSA ET U V W H S". NC2164.2 +015900 01 TEST-34-ANSWER. NC2164.2 +016000 03 FILLER PIC X(20) VALUE NC2164.2 +016100 "AAFXXA ET Y Y Y H S". NC2164.2 +016200 01 TEST-35-DATA. NC2164.2 +016300 03 FILLER PIC X(20) VALUE NC2164.2 +016400 "AX SSA YEG U V W H S". NC2164.2 +016500 01 TEST-35-ANSWER. NC2164.2 +016600 03 FILLER PIC X(20) VALUE NC2164.2 +016700 "AX AAA YEG H S". NC2164.2 +016800 01 TEST-38-DATA. NC2164.2 +016900 03 FILLER PIC X(20) VALUE NC2164.2 +017000 "AXESSA YEGTUASSW H S". NC2164.2 +017100 01 TEST-39-DATA. NC2164.2 +017200 03 FILLER PIC X(20) VALUE NC2164.2 +017300 "ABESSA YE TUTCGW H S". NC2164.2 +017400 01 TEST-40-DATA. NC2164.2 +017500 03 FILLER PIC X(13) VALUE NC2164.2 +017600 "GADQAUZTABAGA". NC2164.2 +017700 01 TEST-RESULTS. NC2164.2 +017800 02 FILLER PIC X VALUE SPACE. NC2164.2 +017900 02 FEATURE PIC X(20) VALUE SPACE. NC2164.2 +018000 02 FILLER PIC X VALUE SPACE. NC2164.2 +018100 02 P-OR-F PIC X(5) VALUE SPACE. NC2164.2 +018200 02 FILLER PIC X VALUE SPACE. NC2164.2 +018300 02 PAR-NAME. NC2164.2 +018400 03 FILLER PIC X(19) VALUE SPACE. NC2164.2 +018500 03 PARDOT-X PIC X VALUE SPACE. NC2164.2 +018600 03 DOTVALUE PIC 99 VALUE ZERO. NC2164.2 +018700 02 FILLER PIC X(8) VALUE SPACE. NC2164.2 +018800 02 RE-MARK PIC X(61). NC2164.2 +018900 01 TEST-COMPUTED. NC2164.2 +019000 02 FILLER PIC X(30) VALUE SPACE. NC2164.2 +019100 02 FILLER PIC X(17) VALUE NC2164.2 +019200 " COMPUTED=". NC2164.2 +019300 02 COMPUTED-X. NC2164.2 +019400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2164.2 +019500 03 COMPUTED-N REDEFINES COMPUTED-A NC2164.2 +019600 PIC -9(9).9(9). NC2164.2 +019700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2164.2 +019800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2164.2 +019900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2164.2 +020000 03 CM-18V0 REDEFINES COMPUTED-A. NC2164.2 +020100 04 COMPUTED-18V0 PIC -9(18). NC2164.2 +020200 04 FILLER PIC X. NC2164.2 +020300 03 FILLER PIC X(50) VALUE SPACE. NC2164.2 +020400 01 TEST-CORRECT. NC2164.2 +020500 02 FILLER PIC X(30) VALUE SPACE. NC2164.2 +020600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2164.2 +020700 02 CORRECT-X. NC2164.2 +020800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2164.2 +020900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2164.2 +021000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2164.2 +021100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2164.2 +021200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2164.2 +021300 03 CR-18V0 REDEFINES CORRECT-A. NC2164.2 +021400 04 CORRECT-18V0 PIC -9(18). NC2164.2 +021500 04 FILLER PIC X. NC2164.2 +021600 03 FILLER PIC X(2) VALUE SPACE. NC2164.2 +021700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2164.2 +021800 01 CCVS-C-1. NC2164.2 +021900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2164.2 +022000- "SS PARAGRAPH-NAME NC2164.2 +022100- " REMARKS". NC2164.2 +022200 02 FILLER PIC X(20) VALUE SPACE. NC2164.2 +022300 01 CCVS-C-2. NC2164.2 +022400 02 FILLER PIC X VALUE SPACE. NC2164.2 +022500 02 FILLER PIC X(6) VALUE "TESTED". NC2164.2 +022600 02 FILLER PIC X(15) VALUE SPACE. NC2164.2 +022700 02 FILLER PIC X(4) VALUE "FAIL". NC2164.2 +022800 02 FILLER PIC X(94) VALUE SPACE. NC2164.2 +022900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2164.2 +023000 01 REC-CT PIC 99 VALUE ZERO. NC2164.2 +023100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2164.2 +023600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2164.2 +023700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2164.2 +023800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2164.2 +023900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2164.2 +024000 01 CCVS-H-1. NC2164.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC2164.2 +024200 02 FILLER PIC X(42) VALUE NC2164.2 +024300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2164.2 +024400 02 FILLER PIC X(39) VALUE SPACES. NC2164.2 +024500 01 CCVS-H-2A. NC2164.2 +024600 02 FILLER PIC X(40) VALUE SPACE. NC2164.2 +024700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2164.2 +024800 02 FILLER PIC XXXX VALUE NC2164.2 +024900 "4.2 ". NC2164.2 +025000 02 FILLER PIC X(28) VALUE NC2164.2 +025100 " COPY - NOT FOR DISTRIBUTION". NC2164.2 +025200 02 FILLER PIC X(41) VALUE SPACE. NC2164.2 +025300 NC2164.2 +025400 01 CCVS-H-2B. NC2164.2 +025500 02 FILLER PIC X(15) VALUE NC2164.2 +025600 "TEST RESULT OF ". NC2164.2 +025700 02 TEST-ID PIC X(9). NC2164.2 +025800 02 FILLER PIC X(4) VALUE NC2164.2 +025900 " IN ". NC2164.2 +026000 02 FILLER PIC X(12) VALUE NC2164.2 +026100 " HIGH ". NC2164.2 +026200 02 FILLER PIC X(22) VALUE NC2164.2 +026300 " LEVEL VALIDATION FOR ". NC2164.2 +026400 02 FILLER PIC X(58) VALUE NC2164.2 +026500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +026600 01 CCVS-H-3. NC2164.2 +026700 02 FILLER PIC X(34) VALUE NC2164.2 +026800 " FOR OFFICIAL USE ONLY ". NC2164.2 +026900 02 FILLER PIC X(58) VALUE NC2164.2 +027000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2164.2 +027100 02 FILLER PIC X(28) VALUE NC2164.2 +027200 " COPYRIGHT 1985 ". NC2164.2 +027300 01 CCVS-E-1. NC2164.2 +027400 02 FILLER PIC X(52) VALUE SPACE. NC2164.2 +027500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2164.2 +027600 02 ID-AGAIN PIC X(9). NC2164.2 +027700 02 FILLER PIC X(45) VALUE SPACES. NC2164.2 +027800 01 CCVS-E-2. NC2164.2 +027900 02 FILLER PIC X(31) VALUE SPACE. NC2164.2 +028000 02 FILLER PIC X(21) VALUE SPACE. NC2164.2 +028100 02 CCVS-E-2-2. NC2164.2 +028200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2164.2 +028300 03 FILLER PIC X VALUE SPACE. NC2164.2 +028400 03 ENDER-DESC PIC X(44) VALUE NC2164.2 +028500 "ERRORS ENCOUNTERED". NC2164.2 +028600 01 CCVS-E-3. NC2164.2 +028700 02 FILLER PIC X(22) VALUE NC2164.2 +028800 " FOR OFFICIAL USE ONLY". NC2164.2 +028900 02 FILLER PIC X(12) VALUE SPACE. NC2164.2 +029000 02 FILLER PIC X(58) VALUE NC2164.2 +029100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +029200 02 FILLER PIC X(13) VALUE SPACE. NC2164.2 +029300 02 FILLER PIC X(15) VALUE NC2164.2 +029400 " COPYRIGHT 1985". NC2164.2 +029500 01 CCVS-E-4. NC2164.2 +029600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2164.2 +029700 02 FILLER PIC X(4) VALUE " OF ". NC2164.2 +029800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2164.2 +029900 02 FILLER PIC X(40) VALUE NC2164.2 +030000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2164.2 +030100 01 XXINFO. NC2164.2 +030200 02 FILLER PIC X(19) VALUE NC2164.2 +030300 "*** INFORMATION ***". NC2164.2 +030400 02 INFO-TEXT. NC2164.2 +030500 04 FILLER PIC X(8) VALUE SPACE. NC2164.2 +030600 04 XXCOMPUTED PIC X(20). NC2164.2 +030700 04 FILLER PIC X(5) VALUE SPACE. NC2164.2 +030800 04 XXCORRECT PIC X(20). NC2164.2 +030900 02 INF-ANSI-REFERENCE PIC X(48). NC2164.2 +031000 01 HYPHEN-LINE. NC2164.2 +031100 02 FILLER PIC IS X VALUE IS SPACE. NC2164.2 +031200 02 FILLER PIC IS X(65) VALUE IS "************************NC2164.2 +031300- "*****************************************". NC2164.2 +031400 02 FILLER PIC IS X(54) VALUE IS "************************NC2164.2 +031500- "******************************". NC2164.2 +031600 01 CCVS-PGM-ID PIC X(9) VALUE NC2164.2 +031700 "NC216A". NC2164.2 +031800 PROCEDURE DIVISION. NC2164.2 +031900 CCVS1 SECTION. NC2164.2 +032000 OPEN-FILES. NC2164.2 +032100 OPEN OUTPUT PRINT-FILE. NC2164.2 +032200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2164.2 +032300 MOVE SPACE TO TEST-RESULTS. NC2164.2 +032400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2164.2 +032500 GO TO CCVS1-EXIT. NC2164.2 +032600 CLOSE-FILES. NC2164.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2164.2 +032800 TERMINATE-CCVS. NC2164.2 +032900S EXIT PROGRAM. NC2164.2 +033000STERMINATE-CALL. NC2164.2 +033100 STOP RUN. NC2164.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2164.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2164.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2164.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2164.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. NC2164.2 +033700 PRINT-DETAIL. NC2164.2 +033800 IF REC-CT NOT EQUAL TO ZERO NC2164.2 +033900 MOVE "." TO PARDOT-X NC2164.2 +034000 MOVE REC-CT TO DOTVALUE. NC2164.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2164.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2164.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2164.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2164.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2164.2 +034600 MOVE SPACE TO CORRECT-X. NC2164.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2164.2 +034800 MOVE SPACE TO RE-MARK. NC2164.2 +034900 HEAD-ROUTINE. NC2164.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2164.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2164.2 +035400 COLUMN-NAMES-ROUTINE. NC2164.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +035800 END-ROUTINE. NC2164.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2164.2 +036000 END-RTN-EXIT. NC2164.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +036200 END-ROUTINE-1. NC2164.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2164.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2164.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. NC2164.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2164.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2164.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2164.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2164.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2164.2 +037100 END-ROUTINE-12. NC2164.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2164.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2164.2 +037400 MOVE "NO " TO ERROR-TOTAL NC2164.2 +037500 ELSE NC2164.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2164.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2164.2 +037800 PERFORM WRITE-LINE. NC2164.2 +037900 END-ROUTINE-13. NC2164.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2164.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE NC2164.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2164.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2164.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO NC2164.2 +038600 MOVE "NO " TO ERROR-TOTAL NC2164.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2164.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2164.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +039100 WRITE-LINE. NC2164.2 +039200 ADD 1 TO RECORD-COUNT. NC2164.2 +039300Y IF RECORD-COUNT GREATER 50 NC2164.2 +039400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2164.2 +039500Y MOVE SPACE TO DUMMY-RECORD NC2164.2 +039600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2164.2 +039700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2164.2 +039800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2164.2 +039900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2164.2 +040000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2164.2 +040100Y MOVE ZERO TO RECORD-COUNT. NC2164.2 +040200 PERFORM WRT-LN. NC2164.2 +040300 WRT-LN. NC2164.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2164.2 +040500 MOVE SPACE TO DUMMY-RECORD. NC2164.2 +040600 BLANK-LINE-PRINT. NC2164.2 +040700 PERFORM WRT-LN. NC2164.2 +040800 FAIL-ROUTINE. NC2164.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2164.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2164.2 +041100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2164.2 +041200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2164.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +041400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2164.2 +041500 GO TO FAIL-ROUTINE-EX. NC2164.2 +041600 FAIL-ROUTINE-WRITE. NC2164.2 +041700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2164.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2164.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2164.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2164.2 +042100 FAIL-ROUTINE-EX. EXIT. NC2164.2 +042200 BAIL-OUT. NC2164.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2164.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2164.2 +042500 BAIL-OUT-WRITE. NC2164.2 +042600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2164.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2164.2 +042800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +042900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2164.2 +043000 BAIL-OUT-EX. EXIT. NC2164.2 +043100 CCVS1-EXIT. NC2164.2 +043200 EXIT. NC2164.2 +043300 SECT-NC216A-001 SECTION. NC2164.2 +043400* NC2164.2 +043500 INS-INIT-F1-1. NC2164.2 +043600 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2164.2 +043700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +043800 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC2164.2 +043900 MOVE NC2164.2 +044000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +044100- "IDS CAN NOT BE ALL BAD." NC2164.2 +044200 TO WC-XN-83. NC2164.2 +044300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +044400 INS-TEST-F1-1. NC2164.2 +044500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS. NC2164.2 +044600 IF WRK-DU-999-1 EQUAL TO 83 NC2164.2 +044700 PERFORM PASS NC2164.2 +044800 GO TO INS-WRITE-F1-1. NC2164.2 +044900 GO TO INS-FAIL-F1-1. NC2164.2 +045000 INS-DELETE-F1-1. NC2164.2 +045100 PERFORM DE-LETE. NC2164.2 +045200 GO TO INS-WRITE-F1-1. NC2164.2 +045300 INS-FAIL-F1-1. NC2164.2 +045400 PERFORM FAIL. NC2164.2 +045500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +045600 MOVE 83 TO CORRECT-N. NC2164.2 +045700 INS-WRITE-F1-1. NC2164.2 +045800 PERFORM PRINT-DETAIL. NC2164.2 +045900* NC2164.2 +046000 INS-INIT-F1-2. NC2164.2 +046100 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2164.2 +046200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +046300 MOVE "TALLY ALL LITERAL" TO FEATURE. NC2164.2 +046400 MOVE NC2164.2 +046500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +046600- "IDS CAN NOT BE ALL BAD." NC2164.2 +046700 TO WC-XN-83. NC2164.2 +046800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +046900 INS-TEST-F1-2. NC2164.2 +047000 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL "A". NC2164.2 +047100 IF WRK-DU-999-1 EQUAL TO 8 NC2164.2 +047200 PERFORM PASS NC2164.2 +047300 GO TO INS-WRITE-F1-2. NC2164.2 +047400 GO TO INS-FAIL-F1-2. NC2164.2 +047500 INS-DELETE-F1-2. NC2164.2 +047600 PERFORM DE-LETE. NC2164.2 +047700 GO TO INS-WRITE-F1-2. NC2164.2 +047800 INS-FAIL-F1-2. NC2164.2 +047900 PERFORM FAIL. NC2164.2 +048000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +048100 MOVE 8 TO CORRECT-N. NC2164.2 +048200 INS-WRITE-F1-2. NC2164.2 +048300 PERFORM PRINT-DETAIL. NC2164.2 +048400* NC2164.2 +048500 INS-INIT-F1-3. NC2164.2 +048600 MOVE "INS-TEST-F1-3" TO PAR-NAME. NC2164.2 +048700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +048800 MOVE "TALLY FOR ALL SPACES" TO FEATURE. NC2164.2 +048900 MOVE NC2164.2 +049000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +049100- "IDS CAN NOT BE ALL BAD." NC2164.2 +049200 TO WC-XN-83. NC2164.2 +049300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +049400 INS-TEST-F1-3. NC2164.2 +049500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACES. NC2164.2 +049600 IF WRK-DU-999-1 EQUAL TO 17 NC2164.2 +049700 PERFORM PASS NC2164.2 +049800 GO TO INS-WRITE-F1-3. NC2164.2 +049900 GO TO INS-FAIL-F1-3. NC2164.2 +050000 INS-DELETE-F1-3. NC2164.2 +050100 PERFORM DE-LETE. NC2164.2 +050200 GO TO INS-WRITE-F1-3. NC2164.2 +050300 INS-FAIL-F1-3. NC2164.2 +050400 PERFORM FAIL. NC2164.2 +050500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +050600 MOVE 17 TO CORRECT-N. NC2164.2 +050700 INS-WRITE-F1-3. NC2164.2 +050800 PERFORM PRINT-DETAIL. NC2164.2 +050900* NC2164.2 +051000 INS-INIT-F1-4. NC2164.2 +051100 MOVE "INS-TEST-F1-4" TO PAR-NAME. NC2164.2 +051200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +051300 MOVE "TALLY LEADING LIT" TO FEATURE. NC2164.2 +051400 MOVE NC2164.2 +051500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +051600- "IDS CAN NOT BE ALL BAD." NC2164.2 +051700 TO WC-XN-83. NC2164.2 +051800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +051900 INS-TEST-F1-4. NC2164.2 +052000 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "AH". NC2164.2 +052100 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +052200 PERFORM PASS NC2164.2 +052300 GO TO INS-WRITE-F1-4. NC2164.2 +052400 GO TO INS-FAIL-F1-4. NC2164.2 +052500 INS-DELETE-F1-4. NC2164.2 +052600 PERFORM DE-LETE. NC2164.2 +052700 GO TO INS-WRITE-F1-4. NC2164.2 +052800 INS-FAIL-F1-4. NC2164.2 +052900 PERFORM FAIL. NC2164.2 +053000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +053100 MOVE 1 TO CORRECT-N. NC2164.2 +053200 INS-WRITE-F1-4. NC2164.2 +053300 PERFORM PRINT-DETAIL. NC2164.2 +053400* NC2164.2 +053500 INS-INIT-F1-5. NC2164.2 +053600 MOVE "INS-TEST-F1-5" TO PAR-NAME. NC2164.2 +053700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +053800 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +053900 MOVE NC2164.2 +054000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +054100- "IDS CAN NOT BE ALL BAD." NC2164.2 +054200 TO WC-XN-83. NC2164.2 +054300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +054400 INS-TEST-F1-5. NC2164.2 +054500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +054600 AFTER " W". NC2164.2 +054700 IF WRK-DU-999-1 EQUAL TO 68 NC2164.2 +054800 PERFORM PASS NC2164.2 +054900 GO TO INS-WRITE-F1-5. NC2164.2 +055000 GO TO INS-FAIL-F1-5. NC2164.2 +055100 INS-DELETE-F1-5. NC2164.2 +055200 PERFORM DE-LETE. NC2164.2 +055300 GO TO INS-WRITE-F1-5. NC2164.2 +055400 INS-FAIL-F1-5. NC2164.2 +055500 PERFORM FAIL. NC2164.2 +055600 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +055700 MOVE 68 TO CORRECT-N. NC2164.2 +055800 INS-WRITE-F1-5. NC2164.2 +055900 PERFORM PRINT-DETAIL. NC2164.2 +056000* NC2164.2 +056100 INS-INIT-F1-6. NC2164.2 +056200 MOVE "INS-TEST-F1-6" TO PAR-NAME. NC2164.2 +056300 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +056400 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC2164.2 +056500 MOVE NC2164.2 +056600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +056700- "IDS CAN NOT BE ALL BAD." NC2164.2 +056800 TO WC-XN-83. NC2164.2 +056900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +057000 INS-TEST-F1-6. NC2164.2 +057100 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL " " NC2164.2 +057200 BEFORE INITIAL "W.C.". NC2164.2 +057300 IF WRK-DU-999-1 EQUAL TO 4 NC2164.2 +057400 PERFORM PASS NC2164.2 +057500 GO TO INS-WRITE-F1-6. NC2164.2 +057600 GO TO INS-FAIL-F1-6. NC2164.2 +057700 INS-DELETE-F1-6. NC2164.2 +057800 PERFORM DE-LETE. NC2164.2 +057900 GO TO INS-WRITE-F1-6. NC2164.2 +058000 INS-FAIL-F1-6. NC2164.2 +058100 PERFORM FAIL. NC2164.2 +058200 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +058300 MOVE 4 TO CORRECT-N. NC2164.2 +058400 INS-WRITE-F1-6. NC2164.2 +058500 PERFORM PRINT-DETAIL. NC2164.2 +058600* NC2164.2 +058700 INS-INIT-F1-7. NC2164.2 +058800 MOVE "INS-TEST-F1-7" TO PAR-NAME. NC2164.2 +058900 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +059000 MOVE "LEAD LIT INITIAL FIG" TO FEATURE. NC2164.2 +059100 MOVE NC2164.2 +059200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +059300- "IDS CAN NOT BE ALL BAD." NC2164.2 +059400 TO WC-XN-83. NC2164.2 +059500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +059600 INS-TEST-F1-7. NC2164.2 +059700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "Y" NC2164.2 +059800 AFTER INITIAL SPACES. NC2164.2 +059900 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +060000 PERFORM PASS NC2164.2 +060100 GO TO INS-WRITE-F1-7. NC2164.2 +060200 GO TO INS-FAIL-F1-7. NC2164.2 +060300 INS-DELETE-F1-7. NC2164.2 +060400 PERFORM DE-LETE. NC2164.2 +060500 GO TO INS-WRITE-F1-7. NC2164.2 +060600 INS-FAIL-F1-7. NC2164.2 +060700 PERFORM FAIL. NC2164.2 +060800 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +060900 MOVE 1 TO CORRECT-N. NC2164.2 +061000 INS-WRITE-F1-7. NC2164.2 +061100 PERFORM PRINT-DETAIL. NC2164.2 +061200* NC2164.2 +061300 INS-INIT-F2-8. NC2164.2 +061400 MOVE "INS-TEST-F2-8" TO PAR-NAME. NC2164.2 +061500 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +061600 MOVE "REP CHARS BY SPACES" TO FEATURE. NC2164.2 +061700 MOVE NC2164.2 +061800 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +061900- "IDS CAN NOT BE ALL BAD." NC2164.2 +062000 TO WC-XN-83. NC2164.2 +062100 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +062200 MOVE NC2164.2 +062300 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +062400- "IDS CAN NOT BE ALL BAD." NC2164.2 +062500 TO ANS-XN-83-5. NC2164.2 +062600 INS-TEST-F2-8. NC2164.2 +062700 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACES. NC2164.2 +062800 IF WRK-XN-83-1 EQUAL TO SPACES NC2164.2 +062900 PERFORM PASS NC2164.2 +063000 GO TO INS-WRITE-F2-8. NC2164.2 +063100 GO TO INS-FAIL-F2-8. NC2164.2 +063200 INS-DELETE-F2-8. NC2164.2 +063300 PERFORM DE-LETE. NC2164.2 +063400 GO TO INS-WRITE-F2-8. NC2164.2 +063500 INS-FAIL-F2-8. NC2164.2 +063600 PERFORM FAIL. NC2164.2 +063700 MOVE "83 SPACES" TO RE-MARK. NC2164.2 +063800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +063900 MOVE SPACES TO WS-RIGHT-1-83. NC2164.2 +064000 PERFORM FAIL. NC2164.2 +064100 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +064200 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83. NC2164.2 +064300 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2164.2 +064400 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2164.2 +064500 PERFORM PRINT-DETAIL. NC2164.2 +064600 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2164.2 +064700 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2164.2 +064800 PERFORM PRINT-DETAIL. NC2164.2 +064900 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2164.2 +065000 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2164.2 +065100 PERFORM PRINT-DETAIL. NC2164.2 +065200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +065300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +065400 PERFORM PRINT-DETAIL. NC2164.2 +065500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +065600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +065700 INS-WRITE-F2-8. NC2164.2 +065800 PERFORM PRINT-DETAIL. NC2164.2 +065900* NC2164.2 +066000 INS-INIT-F2-9. NC2164.2 +066100 MOVE "INS-TEST-F2-9" TO PAR-NAME. NC2164.2 +066200 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +066300 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC2164.2 +066400 MOVE NC2164.2 +066500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +066600- "IDS CAN NOT BE ALL BAD." NC2164.2 +066700 TO WC-XN-83. NC2164.2 +066800 MOVE NC2164.2 +066900 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2164.2 +067000- "IDS CAN NOT BE ALL BAD." NC2164.2 +067100 TO ANS-XN-83-9. NC2164.2 +067200 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +067300 MOVE 1 TO REC-CT. NC2164.2 +067400 INS-TEST-F2-9. NC2164.2 +067500 INSPECT WRK-XN-83-1 NC2164.2 +067600 REPLACING LEADING "AH" BY "OH" BEFORE INITIAL " AH YES" NC2164.2 +067700 FIRST "I" BY "O" AFTER INITIAL "." NC2164.2 +067800 ALL ". " BY ", " AFTER INITIAL "HE". NC2164.2 +067900 MOVE WRK-XN-83-1 TO WRK-XN-83-2. NC2164.2 +068000 INSPECT WRK-XN-83-1 NC2164.2 +068100 REPLACING ALL "OT" BY "IT" BEFORE "HE" NC2164.2 +068200 LEADING ", " BY ". " AFTER "RE" NC2164.2 +068300 FIRST "KIDS CAN NOT BE" BY KIDS-CAN-NOT-BE NC2164.2 +068400 ALL BLANK-PERIOD BY " ." AFTER "BAD". NC2164.2 +068500 GO TO INS-TEST-F2-9-1. NC2164.2 +068600 INS-DELETE-F2-9. NC2164.2 +068700 PERFORM DE-LETE. NC2164.2 +068800 PERFORM PRINT-DETAIL. NC2164.2 +068900 GO TO INS-TEST-F2-10. NC2164.2 +069000* NC2164.2 +069100 INS-TEST-F2-9-1. NC2164.2 +069200 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +069300 PERFORM PASS NC2164.2 +069400 GO TO INS-WRITE-F2-9-1 NC2164.2 +069500 ELSE NC2164.2 +069600 GO TO INS-FAIL-F2-9-1. NC2164.2 +069700 INS-DELETE-F2-9-1. NC2164.2 +069800 PERFORM DE-LETE. NC2164.2 +069900 GO TO INS-WRITE-F2-9-1. NC2164.2 +070000 INS-FAIL-F2-9-1. NC2164.2 +070100 PERFORM FAIL NC2164.2 +070200 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +070300 MOVE ANS-XN-83-1 TO CORRECT-A. NC2164.2 +070400 INS-WRITE-F2-9-1. NC2164.2 +070500 PERFORM PRINT-DETAIL. NC2164.2 +070600* NC2164.2 +070700 INS-TEST-F2-9-2. NC2164.2 +070800 ADD 1 TO REC-CT. NC2164.2 +070900 IF WRK-XN-83-2 EQUAL TO ANS-XN-83-9 NC2164.2 +071000 PERFORM PASS NC2164.2 +071100 GO TO INS-WRITE-F2-9-2 NC2164.2 +071200 ELSE NC2164.2 +071300 GO TO INS-FAIL-F2-9-2. NC2164.2 +071400 INS-FAIL-F2-9-2. NC2164.2 +071500 PERFORM FAIL NC2164.2 +071600 MOVE WRK-XN-83-2 TO WS-WRONG-1-83 NC2164.2 +071700 MOVE ANS-XN-83-9 TO WS-RIGHT-1-83 NC2164.2 +071800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +071900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +072000 PERFORM PRINT-DETAIL NC2164.2 +072100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +072200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +072300 PERFORM PRINT-DETAIL NC2164.2 +072400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +072500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +072600 PERFORM PRINT-DETAIL NC2164.2 +072700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +072800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +072900 PERFORM PRINT-DETAIL NC2164.2 +073000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +073100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +073200 INS-WRITE-F2-9-2. NC2164.2 +073300 PERFORM PRINT-DETAIL. NC2164.2 +073400* NC2164.2 +073500 INS-INIT-F2-10. NC2164.2 +073600 MOVE "INS-TEST-F2-10" TO PAR-NAME. NC2164.2 +073700 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +073800 MOVE "LEAD AFTER INIT ID" TO FEATURE. NC2164.2 +073900 MOVE ZERO TO REC-CT. NC2164.2 +074000 MOVE NC2164.2 +074100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +074200- "IDS CAN NOT BE ALL BAD." NC2164.2 +074300 TO WC-XN-83. NC2164.2 +074400 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +074500 INS-TEST-F2-10. NC2164.2 +074600 INSPECT WRK-XN-83-1 REPLACING LEADING SPACE-XN-1-1 NC2164.2 +074700 BY COMMA-XN-1-1 AFTER INITIAL YES-XN-3. NC2164.2 +074800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-2 NC2164.2 +074900 PERFORM PASS NC2164.2 +075000 GO TO INS-WRITE-F2-10. NC2164.2 +075100 GO TO INS-FAIL-F2-10. NC2164.2 +075200 INS-DELETE-F2-10. NC2164.2 +075300 PERFORM DE-LETE. NC2164.2 +075400 GO TO INS-WRITE-F2-10. NC2164.2 +075500 INS-FAIL-F2-10. NC2164.2 +075600 PERFORM FAIL. NC2164.2 +075700 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +075800 MOVE ANS-XN-83-2 TO WS-RIGHT-1-83 NC2164.2 +075900 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +076000 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +076100 PERFORM PRINT-DETAIL NC2164.2 +076200 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +076300 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +076400 PERFORM PRINT-DETAIL NC2164.2 +076500 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +076600 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +076700 PERFORM PRINT-DETAIL NC2164.2 +076800 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +076900 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +077000 PERFORM PRINT-DETAIL NC2164.2 +077100 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +077200 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +077300 INS-WRITE-F2-10. NC2164.2 +077400 PERFORM PRINT-DETAIL. NC2164.2 +077500* NC2164.2 +077600 INS-INIT-F2-11. NC2164.2 +077700 MOVE "INS-TEST-F2-11" TO PAR-NAME. NC2164.2 +077800 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +077900 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC2164.2 +078000 MOVE NC2164.2 +078100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +078200- "IDS CAN NOT BE ALL BAD." NC2164.2 +078300 TO WC-XN-83. NC2164.2 +078400 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +078500 MOVE "O" TO O-XN-1-1. NC2164.2 +078600 INS-TEST-F2-11. NC2164.2 +078700 INSPECT WRK-XN-83-1 REPLACING FIRST "A" BY O-XN-1-1 NC2164.2 +078800 BEFORE INITIAL "H YES". NC2164.2 +078900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +079000 PERFORM PASS NC2164.2 +079100 GO TO INS-WRITE-F2-11. NC2164.2 +079200 GO TO INS-FAIL-F2-11. NC2164.2 +079300 INS-DELETE-F2-11. NC2164.2 +079400 PERFORM DE-LETE. NC2164.2 +079500 GO TO INS-WRITE-F2-11. NC2164.2 +079600 INS-FAIL-F2-11. NC2164.2 +079700 PERFORM FAIL. NC2164.2 +079800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +079900 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +080000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +080100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +080200 PERFORM PRINT-DETAIL NC2164.2 +080300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +080400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +080500 PERFORM PRINT-DETAIL NC2164.2 +080600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +080700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +080800 PERFORM PRINT-DETAIL NC2164.2 +080900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +081000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +081100 PERFORM PRINT-DETAIL NC2164.2 +081200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +081300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +081400 INS-WRITE-F2-11. NC2164.2 +081500 PERFORM PRINT-DETAIL. NC2164.2 +081600* NC2164.2 +081700 INS-INIT-F2-12. NC2164.2 +081800 MOVE "INS-TEST-F2-12" TO PAR-NAME. NC2164.2 +081900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +082000 MOVE "ALL ID BY LIT AFTER" TO FEATURE. NC2164.2 +082100 MOVE NC2164.2 +082200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +082300- "IDS CAN NOT BE ALL BAD." NC2164.2 +082400 TO WC-XN-83. NC2164.2 +082500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +082600 INS-TEST-F2-12. NC2164.2 +082700 INSPECT WRK-XN-83-1 REPLACING ALL SPACE-XN-1-1 BY "-" NC2164.2 +082800 AFTER ALL-XN-3. NC2164.2 +082900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-3 NC2164.2 +083000 PERFORM PASS NC2164.2 +083100 GO TO INS-WRITE-F2-12. NC2164.2 +083200 GO TO INS-FAIL-F2-12. NC2164.2 +083300 INS-DELETE-F2-12. NC2164.2 +083400 PERFORM DE-LETE. NC2164.2 +083500 GO TO INS-WRITE-F2-12. NC2164.2 +083600 INS-FAIL-F2-12. NC2164.2 +083700 PERFORM FAIL. NC2164.2 +083800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +083900 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2164.2 +084000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +084100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +084200 PERFORM PRINT-DETAIL NC2164.2 +084300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +084400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +084500 PERFORM PRINT-DETAIL NC2164.2 +084600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +084700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +084800 PERFORM PRINT-DETAIL NC2164.2 +084900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +085000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +085100 PERFORM PRINT-DETAIL NC2164.2 +085200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +085300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +085400 INS-WRITE-F2-12. NC2164.2 +085500 PERFORM PRINT-DETAIL. NC2164.2 +085600* NC2164.2 +085700 INS-INIT-F3-13. NC2164.2 +085800 MOVE "INS-TEST-F3-13" TO PAR-NAME. NC2164.2 +085900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +086000 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC2164.2 +086100 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +086200 MOVE NC2164.2 +086300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +086400- "IDS CAN NOT BE ALL BAD." NC2164.2 +086500 TO WC-XN-83. NC2164.2 +086600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +086700 MOVE 1 TO REC-CT. NC2164.2 +086800 INS-TEST-F3-13-0. NC2164.2 +086900 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +087000 REPLACING CHARACTERS BY SPACES. NC2164.2 +087100 GO TO INS-TEST-F3-13-1. NC2164.2 +087200 INS-DELETE-F3-13. NC2164.2 +087300 PERFORM DE-LETE. NC2164.2 +087400 PERFORM PRINT-DETAIL. NC2164.2 +087500 GO TO INS-INIT-F3-14. NC2164.2 +087600* NC2164.2 +087700 INS-TEST-F3-13-1. NC2164.2 +087800 IF WRK-DU-999-1 EQUAL TO 83 NC2164.2 +087900 PERFORM PASS NC2164.2 +088000 GO TO INS-WRITE-F3-13-1 NC2164.2 +088100 ELSE NC2164.2 +088200 GO TO INS-FAIL-F3-13-1. NC2164.2 +088300 INS-DELETE-F3-13-1. NC2164.2 +088400 PERFORM DE-LETE. NC2164.2 +088500 GO TO INS-WRITE-F3-13-1. NC2164.2 +088600 INS-FAIL-F3-13-1. NC2164.2 +088700 PERFORM FAIL NC2164.2 +088800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +088900 MOVE 83 TO CORRECT-N. NC2164.2 +089000 INS-WRITE-F3-13-1. NC2164.2 +089100 PERFORM PRINT-DETAIL. NC2164.2 +089200* NC2164.2 +089300 TEST-13-2. NC2164.2 +089400 ADD 1 TO REC-CT. NC2164.2 +089500 IF WRK-XN-83-1 EQUAL TO SPACES NC2164.2 +089600 PERFORM PASS NC2164.2 +089700 GO TO INS-WRITE-F3-13-2 NC2164.2 +089800 ELSE NC2164.2 +089900 GO TO INS-FAIL-F3-13-2. NC2164.2 +090000 INS-DELETE-F3-13-2. NC2164.2 +090100 PERFORM DE-LETE. NC2164.2 +090200 GO TO INS-WRITE-F3-13-2. NC2164.2 +090300 INS-FAIL-F3-13-2. NC2164.2 +090400 PERFORM FAIL NC2164.2 +090500 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +090600 MOVE "83 SPACES" TO CORRECT-A. NC2164.2 +090700 INS-WRITE-F3-13-2. NC2164.2 +090800 PERFORM PRINT-DETAIL. NC2164.2 +090900* NC2164.2 +091000 INS-INIT-F3-14. NC2164.2 +091100 MOVE "INS-TEST-F3-14" TO PAR-NAME. NC2164.2 +091200 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +091300 MOVE "LIT BY BEFORE INIT" TO FEATURE. NC2164.2 +091400 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +091500 MOVE NC2164.2 +091600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +091700- "IDS CAN NOT BE ALL BAD." NC2164.2 +091800 TO WC-XN-83. NC2164.2 +091900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +092000 MOVE 1 TO REC-CT. NC2164.2 +092100 INS-TEST-F3-14-0. NC2164.2 +092200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +092300 AFTER L-XN-1-1 REPLACING ALL "A" BY "E" BEFORE INITIAL NC2164.2 +092400 HSPACE-XN-2. NC2164.2 +092500 GO TO INS-TEST-F3-14-1. NC2164.2 +092600 INS-DELETE-F3-14. NC2164.2 +092700 PERFORM DE-LETE. NC2164.2 +092800 PERFORM PRINT-DETAIL. NC2164.2 +092900 GO TO INS-INIT-F3-15. NC2164.2 +093000* NC2164.2 +093100 INS-TEST-F3-14-1. NC2164.2 +093200 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +093300 PERFORM PASS NC2164.2 +093400 GO TO INS-WRITE-F3-14-1 NC2164.2 +093500 ELSE NC2164.2 +093600 PERFORM FAIL NC2164.2 +093700 GO TO INS-FAIL-F3-14-1. NC2164.2 +093800 INS-DELETE-F3-14-1. NC2164.2 +093900 PERFORM DE-LETE. NC2164.2 +094000 GO TO INS-WRITE-F3-14-1. NC2164.2 +094100 INS-FAIL-F3-14-1. NC2164.2 +094200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +094300 MOVE 6 TO CORRECT-N. NC2164.2 +094400 INS-WRITE-F3-14-1. NC2164.2 +094500 PERFORM PRINT-DETAIL. NC2164.2 +094600* NC2164.2 +094700 INS-TEST-F3-14-2. NC2164.2 +094800 ADD 1 TO REC-CT. NC2164.2 +094900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-4 NC2164.2 +095000 PERFORM PASS NC2164.2 +095100 GO TO INS-WRITE-F3-14-2 NC2164.2 +095200 ELSE NC2164.2 +095300 PERFORM FAIL NC2164.2 +095400 GO TO INS-FAIL-F3-14-2. NC2164.2 +095500 INS-DELETE-F3-14-2. NC2164.2 +095600 PERFORM DE-LETE. NC2164.2 +095700 GO TO INS-WRITE-F3-14-2. NC2164.2 +095800 INS-FAIL-F3-14-2. NC2164.2 +095900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +096000 MOVE ANS-XN-83-4 TO WS-RIGHT-1-83 NC2164.2 +096100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +096200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +096300 PERFORM PRINT-DETAIL NC2164.2 +096400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +096500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +096600 PERFORM PRINT-DETAIL NC2164.2 +096700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +096800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +096900 PERFORM PRINT-DETAIL NC2164.2 +097000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +097100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +097200 PERFORM PRINT-DETAIL NC2164.2 +097300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +097400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +097500 INS-WRITE-F3-14-2. NC2164.2 +097600 PERFORM PRINT-DETAIL. NC2164.2 +097700* NC2164.2 +097800 INS-INIT-F3-15. NC2164.2 +097900 MOVE "INS-TEST-F3-15" TO PAR-NAME. NC2164.2 +098000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +098100 MOVE "REPL FIRST AFTER" TO FEATURE. NC2164.2 +098200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +098300 MOVE NC2164.2 +098400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +098500- "IDS CAN NOT BE ALL BAD." NC2164.2 +098600 TO WC-XN-83. NC2164.2 +098700 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +098800 MOVE NC2164.2 +098900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +099000- "IDS CAN NOT BE ALL BAD." NC2164.2 +099100 TO ANS-XN-83-5. NC2164.2 +099200 MOVE 1 TO REC-CT. NC2164.2 +099300 INS-TEST-F3-15-0. NC2164.2 +099400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" BEFORE NC2164.2 +099500 L-XN-1-1 REPLACING FIRST AH-XN-2 BY "OH" AFTER NC2164.2 +099600 INITIAL HSPACE-XN-2. NC2164.2 +099700 GO TO INS-TEST-F3-15-1. NC2164.2 +099800 INS-DELETE-F3-15. NC2164.2 +099900 PERFORM DE-LETE. NC2164.2 +100000 PERFORM PRINT-DETAIL. NC2164.2 +100100 GO TO INS-INIT-F3-16. NC2164.2 +100200* NC2164.2 +100300 INS-TEST-F3-15-1. NC2164.2 +100400 IF WRK-DU-999-1 EQUAL TO 7 NC2164.2 +100500 PERFORM PASS NC2164.2 +100600 GO TO INS-WRITE-F3-15-1 NC2164.2 +100700 ELSE NC2164.2 +100800 PERFORM FAIL NC2164.2 +100900 GO TO INS-FAIL-F3-15-1. NC2164.2 +101000 INS-DELETE-F3-15-1. NC2164.2 +101100 PERFORM DE-LETE. NC2164.2 +101200 GO TO INS-WRITE-F3-15-1. NC2164.2 +101300 INS-FAIL-F3-15-1. NC2164.2 +101400 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +101500 MOVE 7 TO CORRECT-N. NC2164.2 +101600 INS-WRITE-F3-15-1. NC2164.2 +101700 PERFORM PRINT-DETAIL. NC2164.2 +101800* NC2164.2 +101900 INS-TEST-F3-15-2. NC2164.2 +102000 ADD 1 TO REC-CT. NC2164.2 +102100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +102200 PERFORM PASS NC2164.2 +102300 GO TO INS-WRITE-F3-15-2 NC2164.2 +102400 ELSE NC2164.2 +102500 PERFORM FAIL NC2164.2 +102600 GO TO INS-FAIL-F3-15-2. NC2164.2 +102700 INS-DELETE-F3-15-2. NC2164.2 +102800 PERFORM DE-LETE. NC2164.2 +102900 GO TO INS-WRITE-F3-15-2. NC2164.2 +103000 INS-FAIL-F3-15-2. NC2164.2 +103100 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +103200 MOVE ANS-XN-83-5 TO CORRECT-A. NC2164.2 +103300 INS-WRITE-F3-15-2. NC2164.2 +103400 PERFORM PRINT-DETAIL. NC2164.2 +103500* NC2164.2 +103600 INS-INIT-F3-16. NC2164.2 +103700 MOVE "INS-TEST-F3-16" TO PAR-NAME. NC2164.2 +103800 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +103900 MOVE "FOR LEADING" TO FEATURE. NC2164.2 +104000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +104100 MOVE NC2164.2 +104200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +104300- "IDS CAN NOT BE ALL BAD." NC2164.2 +104400 TO WC-XN-83. NC2164.2 +104500 MOVE NC2164.2 +104600 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +104700- "IDS CAN NOT BE ALL BAD." NC2164.2 +104800 TO ANS-XN-83-5. NC2164.2 +104900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +105000 MOVE 1 TO REC-CT. NC2164.2 +105100 INS-TEST-F3-16-0. NC2164.2 +105200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR LEADING NC2164.2 +105300 AH-XN-2 REPLACING LEADING AH-XN-2 BY "OH". NC2164.2 +105400 GO TO INS-TEST-F3-16-1. NC2164.2 +105500 INS-DELETE-F3-16. NC2164.2 +105600 PERFORM DE-LETE. NC2164.2 +105700 PERFORM PRINT-DETAIL. NC2164.2 +105800 GO TO INS-INIT-F3-17. NC2164.2 +105900* NC2164.2 +106000 INS-TEST-F3-16-1. NC2164.2 +106100 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +106200 PERFORM PASS NC2164.2 +106300 GO TO INS-WRITE-F3-16-1 NC2164.2 +106400 ELSE NC2164.2 +106500 PERFORM FAIL NC2164.2 +106600 GO TO INS-FAIL-F3-16-1. NC2164.2 +106700 INS-DELETE-F3-16-1. NC2164.2 +106800 PERFORM DE-LETE. NC2164.2 +106900 GO TO INS-WRITE-F3-16-1. NC2164.2 +107000 INS-FAIL-F3-16-1. NC2164.2 +107100 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +107200 MOVE 1 TO CORRECT-N. NC2164.2 +107300 INS-WRITE-F3-16-1. NC2164.2 +107400 PERFORM PRINT-DETAIL. NC2164.2 +107500* NC2164.2 +107600 INS-TEST-F3-16-2. NC2164.2 +107700 ADD 1 TO REC-CT. NC2164.2 +107800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +107900 PERFORM PASS NC2164.2 +108000 GO TO INS-WRITE-F3-16-2 NC2164.2 +108100 ELSE NC2164.2 +108200 PERFORM FAIL NC2164.2 +108300 GO TO INS-FAIL-F3-16-2. NC2164.2 +108400 INS-DELETE-F3-16-2. NC2164.2 +108500 PERFORM DE-LETE. NC2164.2 +108600 GO TO INS-WRITE-F3-16-2. NC2164.2 +108700 INS-FAIL-F3-16-2. NC2164.2 +108800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +108900 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +109000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +109100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +109200 PERFORM PRINT-DETAIL NC2164.2 +109300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +109400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +109500 PERFORM PRINT-DETAIL NC2164.2 +109600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +109700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +109800 PERFORM PRINT-DETAIL NC2164.2 +109900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +110000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +110100 PERFORM PRINT-DETAIL NC2164.2 +110200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +110300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +110400 INS-WRITE-F3-16-2. NC2164.2 +110500 PERFORM PRINT-DETAIL. NC2164.2 +110600* NC2164.2 +110700 INS-INIT-F3-17. NC2164.2 +110800 MOVE "INS-TEST-F3-17" TO PAR-NAME. NC2164.2 +110900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +111000 MOVE "LIT BY AFTER INIT" TO FEATURE. NC2164.2 +111100 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +111200 MOVE NC2164.2 +111300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +111400- "IDS CAN NOT BE ALL BAD." NC2164.2 +111500 TO WC-XN-83. NC2164.2 +111600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +111700 MOVE NC2164.2 +111800 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +111900- "IDS CAN NOT BE ALL BAD." NC2164.2 +112000 TO ANS-XN-83-5. NC2164.2 +112100 MOVE 1 TO REC-CT. NC2164.2 +112200 INS-TEST-F3-17-0. NC2164.2 +112300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +112400 REPLACING FIRST "AH" BY "OH" AFTER INITIAL "YES". NC2164.2 +112500 GO TO INS-TEST-F3-17-1. NC2164.2 +112600 INS-DELETE-F3-17. NC2164.2 +112700 PERFORM DE-LETE. NC2164.2 +112800 PERFORM PRINT-DETAIL. NC2164.2 +112900 GO TO INS-INIT-F3-18. NC2164.2 +113000* NC2164.2 +113100 INS-TEST-F3-17-1. NC2164.2 +113200 IF WRK-DU-999-1 EQUAL TO 8 NC2164.2 +113300 PERFORM PASS NC2164.2 +113400 GO TO INS-WRITE-F3-17-1 NC2164.2 +113500 ELSE NC2164.2 +113600 PERFORM FAIL NC2164.2 +113700 GO TO INS-FAIL-F3-17-1. NC2164.2 +113800 INS-DELETE-F3-17-1. NC2164.2 +113900 PERFORM DE-LETE. NC2164.2 +114000 GO TO INS-WRITE-F3-17-1. NC2164.2 +114100 INS-FAIL-F3-17-1. NC2164.2 +114200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +114300 MOVE 8 TO CORRECT-N. NC2164.2 +114400 INS-WRITE-F3-17-1. NC2164.2 +114500 PERFORM PRINT-DETAIL. NC2164.2 +114600* NC2164.2 +114700 INS-TEST-F3-17-2. NC2164.2 +114800 ADD 1 TO REC-CT. NC2164.2 +114900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +115000 PERFORM PASS NC2164.2 +115100 GO TO INS-WRITE-F3-17-2 NC2164.2 +115200 ELSE NC2164.2 +115300 PERFORM FAIL NC2164.2 +115400 GO TO INS-FAIL-F3-17-2. NC2164.2 +115500 INS-DELETE-F3-17-2. NC2164.2 +115600 PERFORM DE-LETE. NC2164.2 +115700 GO TO INS-WRITE-F3-17-2. NC2164.2 +115800 INS-FAIL-F3-17-2. NC2164.2 +115900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +116000 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2164.2 +116100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +116200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +116300 PERFORM PRINT-DETAIL NC2164.2 +116400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +116500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +116600 PERFORM PRINT-DETAIL NC2164.2 +116700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +116800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +116900 PERFORM PRINT-DETAIL NC2164.2 +117000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +117100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +117200 PERFORM PRINT-DETAIL NC2164.2 +117300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +117400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +117500 INS-WRITE-F3-17-2. NC2164.2 +117600 PERFORM PRINT-DETAIL. NC2164.2 +117700* NC2164.2 +117800 INS-INIT-F3-18. NC2164.2 +117900 MOVE "INS-TEST-F3-18" TO PAR-NAME. NC2164.2 +118000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +118100 MOVE "CHAR AFTER ALL BEF" TO FEATURE. NC2164.2 +118200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +118300 MOVE NC2164.2 +118400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +118500- "IDS CAN NOT BE ALL BAD." NC2164.2 +118600 TO WC-XN-83. NC2164.2 +118700 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +118800 MOVE 1 TO REC-CT. NC2164.2 +118900 INS-TEST-F3-18-0. NC2164.2 +119000 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +119100 AFTER AH-XN-2 REPLACING ALL "AH" BY "OH" BEFORE YES-XN-3.NC2164.2 +119200 GO TO INS-TEST-F3-18-1. NC2164.2 +119300 INS-DELETE-F3-18. NC2164.2 +119400 PERFORM DE-LETE. NC2164.2 +119500 PERFORM PRINT-DETAIL. NC2164.2 +119600 GO TO INS-INIT-F3-19. NC2164.2 +119700* NC2164.2 +119800 INS-TEST-F3-18-1. NC2164.2 +119900 IF WRK-DU-999-1 EQUAL TO 81 NC2164.2 +120000 PERFORM PASS NC2164.2 +120100 GO TO INS-WRITE-F3-18-1 NC2164.2 +120200 ELSE NC2164.2 +120300 PERFORM FAIL NC2164.2 +120400 GO TO INS-FAIL-F3-18-1. NC2164.2 +120500 INS-DELETE-F3-18-1. NC2164.2 +120600 PERFORM DE-LETE. NC2164.2 +120700 GO TO INS-WRITE-F3-18-1. NC2164.2 +120800 INS-FAIL-F3-18-1. NC2164.2 +120900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +121000 MOVE 81 TO CORRECT-N. NC2164.2 +121100 INS-WRITE-F3-18-1. NC2164.2 +121200 PERFORM PRINT-DETAIL. NC2164.2 +121300* NC2164.2 +121400 INS-TEST-F3-18-2. NC2164.2 +121500 ADD 1 TO REC-CT. NC2164.2 +121600 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +121700 PERFORM PASS NC2164.2 +121800 GO TO INS-WRITE-F3-18-2 NC2164.2 +121900 ELSE NC2164.2 +122000 PERFORM FAIL NC2164.2 +122100 GO TO INS-FAIL-F3-18-2. NC2164.2 +122200 INS-DELETE-F3-18-2. NC2164.2 +122300 PERFORM DE-LETE. NC2164.2 +122400 GO TO INS-WRITE-F3-18-2. NC2164.2 +122500 INS-FAIL-F3-18-2. NC2164.2 +122600 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +122700 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +122800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +122900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +123000 PERFORM PRINT-DETAIL NC2164.2 +123100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +123200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +123300 PERFORM PRINT-DETAIL NC2164.2 +123400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +123500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +123600 PERFORM PRINT-DETAIL NC2164.2 +123700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +123800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +123900 PERFORM PRINT-DETAIL NC2164.2 +124000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +124100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +124200 INS-WRITE-F3-18-2. NC2164.2 +124300 PERFORM PRINT-DETAIL. NC2164.2 +124400* NC2164.2 +124500 INS-INIT-F3-19. NC2164.2 +124600 MOVE "INS-TEST-F3-19" TO PAR-NAME. NC2164.2 +124700 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +124800 MOVE "TALLY SERIES" TO FEATURE. NC2164.2 +124900 MOVE ZERO TO WRK-DU-999-1 WRK-DU-999-2 WRK-DU-999-3 NC2164.2 +125000 WRK-DU-999-4. NC2164.2 +125100 MOVE NC2164.2 +125200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +125300- "IDS CAN NOT BE ALL BAD." NC2164.2 +125400 TO WC-XN-83. NC2164.2 +125500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +125600 MOVE 1 TO REC-CT. NC2164.2 +125700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +125800 WRK-DU-999-2 FOR LEADING "AH" NC2164.2 +125900 WRK-DU-999-3 FOR CHARACTERS BEFORE "." NC2164.2 +126000 WRK-DU-999-4 FOR CHARACTERS AFTER "AL" NC2164.2 +126100 REPLACING NC2164.2 +126200 FIRST "L " BY "ZZ" AFTER INITIAL "AL" NC2164.2 +126300 FIRST "BAD" BY "ZZZ" AFTER "L " NC2164.2 +126400 LEADING "BAD" BY "ZZZ" BEFORE INITIAL "Q" NC2164.2 +126500 FIRST "BAD" BY "ZZZ" BEFORE INITIAL "Z" NC2164.2 +126600 FIRST "BAD" BY "ZZZ" AFTER "ALL " NC2164.2 +126700 ALL "." BY "Z" AFTER "AL". NC2164.2 +126800 GO TO INS-TEST-F3-19-1. NC2164.2 +126900 INS-DELETE-F3-19. NC2164.2 +127000 PERFORM DE-LETE. NC2164.2 +127100 PERFORM PRINT-DETAIL. NC2164.2 +127200 GO TO INS-INIT-F3-20. NC2164.2 +127300* NC2164.2 +127400 INS-TEST-F3-19-1. NC2164.2 +127500 IF WRK-DU-999-1 = 8 NC2164.2 +127600 PERFORM PASS NC2164.2 +127700 GO TO INS-WRITE-F3-19-1 NC2164.2 +127800 ELSE NC2164.2 +127900 GO TO INS-FAIL-F3-19-1. NC2164.2 +128000 INS-DELETE-F3-19-1. NC2164.2 +128100 PERFORM DE-LETE. NC2164.2 +128200 GO TO INS-WRITE-F3-19-1. NC2164.2 +128300 INS-FAIL-F3-19-1. NC2164.2 +128400 PERFORM FAIL NC2164.2 +128500 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +128600 MOVE 8 TO CORRECT-N. NC2164.2 +128700 INS-WRITE-F3-19-1. NC2164.2 +128800 PERFORM PRINT-DETAIL. NC2164.2 +128900* NC2164.2 +129000 INS-TEST-F3-19-2. NC2164.2 +129100 ADD 1 TO REC-CT. NC2164.2 +129200 IF WRK-DU-999-2 = 0 NC2164.2 +129300 PERFORM PASS NC2164.2 +129400 GO TO INS-WRITE-F3-19-2 NC2164.2 +129500 ELSE NC2164.2 +129600 GO TO INS-FAIL-F3-19-2. NC2164.2 +129700 INS-DELETE-F3-19-2. NC2164.2 +129800 PERFORM DE-LETE. NC2164.2 +129900 GO TO INS-WRITE-F3-19-2. NC2164.2 +130000 INS-FAIL-F3-19-2. NC2164.2 +130100 PERFORM FAIL NC2164.2 +130200 MOVE WRK-DU-999-2 TO COMPUTED-N NC2164.2 +130300 MOVE 0 TO CORRECT-N. NC2164.2 +130400 INS-WRITE-F3-19-2. NC2164.2 +130500 PERFORM PRINT-DETAIL. NC2164.2 +130600* NC2164.2 +130700 INS-TEST-F3-19-3. NC2164.2 +130800 ADD 1 TO REC-CT. NC2164.2 +130900 IF WRK-DU-999-3 = 13 NC2164.2 +131000 PERFORM PASS NC2164.2 +131100 GO TO INS-WRITE-F3-19-3 NC2164.2 +131200 ELSE NC2164.2 +131300 PERFORM FAIL NC2164.2 +131400 GO TO INS-FAIL-F3-19-3. NC2164.2 +131500 INS-DELETE-F3-19-3. NC2164.2 +131600 PERFORM DE-LETE. NC2164.2 +131700 GO TO INS-WRITE-F3-19-3. NC2164.2 +131800 INS-FAIL-F3-19-3. NC2164.2 +131900 MOVE WRK-DU-999-3 TO COMPUTED-N NC2164.2 +132000 MOVE 13 TO CORRECT-N. NC2164.2 +132100 INS-WRITE-F3-19-3. NC2164.2 +132200 PERFORM PRINT-DETAIL. NC2164.2 +132300* NC2164.2 +132400 INS-TEST-F3-19-4. NC2164.2 +132500 ADD 1 TO REC-CT. NC2164.2 +132600 IF WRK-DU-999-4 = 5 NC2164.2 +132700 PERFORM PASS NC2164.2 +132800 GO TO INS-WRITE-F3-19-4 NC2164.2 +132900 ELSE NC2164.2 +133000 GO TO INS-FAIL-F3-19-4. NC2164.2 +133100 INS-DELETE-F3-19-4. NC2164.2 +133200 PERFORM DE-LETE. NC2164.2 +133300 GO TO INS-WRITE-F3-19-4. NC2164.2 +133400 INS-FAIL-F3-19-4. NC2164.2 +133500 PERFORM FAIL NC2164.2 +133600 MOVE WRK-DU-999-4 TO COMPUTED-N NC2164.2 +133700 MOVE 5 TO CORRECT-N. NC2164.2 +133800 INS-WRITE-F3-19-4. NC2164.2 +133900 PERFORM PRINT-DETAIL. NC2164.2 +134000* NC2164.2 +134100 INS-TEST-F3-19-5. NC2164.2 +134200 ADD 1 TO REC-CT. NC2164.2 +134300 IF WRK-XN-83-1 = ANS-XN-83-6 NC2164.2 +134400 PERFORM PASS NC2164.2 +134500 GO TO INS-WRITE-F3-19-5 NC2164.2 +134600 ELSE NC2164.2 +134700 GO TO INS-FAIL-F3-19-5. NC2164.2 +134800 INS-DELETE-F3-19-5. NC2164.2 +134900 PERFORM DE-LETE. NC2164.2 +135000 GO TO INS-WRITE-F3-19-5. NC2164.2 +135100 INS-FAIL-F3-19-5. NC2164.2 +135200 PERFORM FAIL NC2164.2 +135300 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +135400 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2164.2 +135500 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +135600 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +135700 PERFORM PRINT-DETAIL NC2164.2 +135800 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +135900 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +136000 PERFORM PRINT-DETAIL NC2164.2 +136100 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +136200 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +136300 PERFORM PRINT-DETAIL NC2164.2 +136400 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +136500 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +136600 PERFORM PRINT-DETAIL NC2164.2 +136700 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +136800 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +136900 INS-WRITE-F3-19-5. NC2164.2 +137000 PERFORM PRINT-DETAIL. NC2164.2 +137100* NC2164.2 +137200 INS-INIT-F3-20. NC2164.2 +137300 MOVE "INS-TEST-F3-20" TO PAR-NAME. NC2164.2 +137400 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +137500 MOVE "REPLACE SERIES" TO FEATURE. NC2164.2 +137600 MOVE ZERO TO REC-CT WRK-DU-999-1. NC2164.2 +137700 MOVE NC2164.2 +137800 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +137900- "IDS CAN NOT BE ALL BAD." NC2164.2 +138000 TO WC-XN-83. NC2164.2 +138100 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +138200 MOVE 1 TO REC-CT. NC2164.2 +138300 INS-TEST-F3-20-0. NC2164.2 +138400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +138500 BEFORE "." NC2164.2 +138600 REPLACING NC2164.2 +138700 ALL "L BAD." BY "ZZZZZZ" AFTER L-XN-1-1 NC2164.2 +138800 ALL " " BY HYPEN-XN-1-1 NC2164.2 +138900 FIRST "C" BY P-XN-1-1 NC2164.2 +139000 LEADING AH-XN-2 BY OH-XN-2 NC2164.2 +139100 ALL "F" BY "Z" BEFORE G-XN-1-1. NC2164.2 +139200 GO TO INS-TEST-F3-20-1. NC2164.2 +139300 INS-DELETE-F3-20. NC2164.2 +139400 PERFORM DE-LETE. NC2164.2 +139500 PERFORM PRINT-DETAIL. NC2164.2 +139600 GO TO CCVS-999999. NC2164.2 +139700* NC2164.2 +139800 INS-TEST-F3-20-1. NC2164.2 +139900 IF WRK-DU-999-1 EQUAL TO 15 NC2164.2 +140000 PERFORM PASS NC2164.2 +140100 GO TO INS-WRITE-F3-20-1 NC2164.2 +140200 ELSE NC2164.2 +140300 GO TO INS-FAIL-F3-20-1. NC2164.2 +140400 INS-DELETE-F3-20-1. NC2164.2 +140500 PERFORM DE-LETE. NC2164.2 +140600 GO TO INS-WRITE-F3-20-1. NC2164.2 +140700 INS-FAIL-F3-20-1. NC2164.2 +140800 PERFORM FAIL NC2164.2 +140900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +141000 MOVE 15 TO CORRECT-N. NC2164.2 +141100 INS-WRITE-F3-20-1. NC2164.2 +141200 PERFORM PRINT-DETAIL. NC2164.2 +141300* NC2164.2 +141400 INS-TEST-F3-20-2. NC2164.2 +141500 ADD 1 TO REC-CT. NC2164.2 +141600 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-7 NC2164.2 +141700 PERFORM PASS NC2164.2 +141800 GO TO INS-WRITE-F3-20-2 NC2164.2 +141900 ELSE NC2164.2 +142000 GO TO INS-FAIL-F3-20-2. NC2164.2 +142100 INS-DELETE-F3-20-2. NC2164.2 +142200 PERFORM DE-LETE. NC2164.2 +142300 GO TO INS-WRITE-F3-20-2. NC2164.2 +142400 INS-FAIL-F3-20-2. NC2164.2 +142500 PERFORM FAIL NC2164.2 +142600 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +142700 MOVE ANS-XN-83-7 TO WS-RIGHT-1-83 NC2164.2 +142800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +142900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +143000 PERFORM PRINT-DETAIL NC2164.2 +143100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +143200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +143300 PERFORM PRINT-DETAIL NC2164.2 +143400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +143500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +143600 PERFORM PRINT-DETAIL NC2164.2 +143700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +143800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +143900 PERFORM PRINT-DETAIL NC2164.2 +144000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +144100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +144200 INS-WRITE-F3-20-2. NC2164.2 +144300 PERFORM PRINT-DETAIL. NC2164.2 +144400* NC2164.2 +144500 INS-INIT-F2-21. NC2164.2 +144600 MOVE ZERO TO REC-CT. NC2164.2 +144700 MOVE SPACES TO PAR-NAME. NC2164.2 +144800 MOVE "INS-TEST-F2-21" TO PAR-NAME. NC2164.2 +144900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +145000 MOVE "REPLACE BEFORE" TO FEATURE. NC2164.2 +145100 MOVE NC2164.2 +145200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +145300- "IDS CAN NOT BE ALL BAD." NC2164.2 +145400 TO WC-XN-83. NC2164.2 +145500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +145600 INS-TEST-F2-21. NC2164.2 +145700 INSPECT WRK-XN-83-1 NC2164.2 +145800 REPLACING ALL SPACE-XN-1-1 BY "-" BEFORE INITIAL "Z". NC2164.2 +145900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-8 NC2164.2 +146000 PERFORM PASS NC2164.2 +146100 GO TO INS-WRITE-F2-21-1 NC2164.2 +146200 ELSE NC2164.2 +146300 GO TO INS-FAIL-F2-21-1. NC2164.2 +146400 INS-DELETE-F2-21-1. NC2164.2 +146500 PERFORM DE-LETE. NC2164.2 +146600 GO TO INS-WRITE-F2-21-1. NC2164.2 +146700 INS-FAIL-F2-21-1. NC2164.2 +146800 PERFORM FAIL NC2164.2 +146900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +147000 MOVE ANS-XN-83-8 TO WS-RIGHT-1-83 NC2164.2 +147100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +147200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +147300 PERFORM PRINT-DETAIL NC2164.2 +147400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +147500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +147600 PERFORM PRINT-DETAIL NC2164.2 +147700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +147800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +147900 PERFORM PRINT-DETAIL NC2164.2 +148000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +148100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +148200 PERFORM PRINT-DETAIL NC2164.2 +148300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +148400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +148500 INS-WRITE-F2-21-1. NC2164.2 +148600 PERFORM PRINT-DETAIL. NC2164.2 +148700* NC2164.2 +148800 INS-INIT-F2-22. NC2164.2 +148900 MOVE "INS-TEST-F2-22" TO PAR-NAME. NC2164.2 +149000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +149100 MOVE "REPLACE AFTER" TO FEATURE. NC2164.2 +149200 MOVE NC2164.2 +149300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +149400- "IDS CAN NOT BE ALL BAD." NC2164.2 +149500 TO WC-XN-83. NC2164.2 +149600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +149700 INS-TEST-F2-22. NC2164.2 +149800 INSPECT WRK-XN-83-1 NC2164.2 +149900 REPLACING ALL SPACE-XN-1-1 BY "-" AFTER INITIAL "Z". NC2164.2 +150000 IF WRK-XN-83-1 EQUAL TO WC-XN-83 NC2164.2 +150100 PERFORM PASS NC2164.2 +150200 GO TO INS-WRITE-F2-22 NC2164.2 +150300 ELSE NC2164.2 +150400 GO TO INS-FAIL-F2-22. NC2164.2 +150500 INS-DELETE-F2-22. NC2164.2 +150600 PERFORM DE-LETE. NC2164.2 +150700 GO TO INS-WRITE-F2-22. NC2164.2 +150800 INS-FAIL-F2-22. NC2164.2 +150900 PERFORM FAIL NC2164.2 +151000 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +151100 MOVE WC-XN-83 TO WS-RIGHT-1-83 NC2164.2 +151200 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +151300 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +151400 PERFORM PRINT-DETAIL NC2164.2 +151500 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +151600 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +151700 PERFORM PRINT-DETAIL NC2164.2 +151800 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +151900 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +152000 PERFORM PRINT-DETAIL NC2164.2 +152100 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +152200 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +152300 PERFORM PRINT-DETAIL NC2164.2 +152400 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +152500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +152600 INS-WRITE-F2-22. NC2164.2 +152700 PERFORM PRINT-DETAIL. NC2164.2 +152800* NC2164.2 +152900 INS-INIT-F1-23. NC2164.2 +153000 MOVE "INS-TEST-F1-23" TO PAR-NAME. NC2164.2 +153100 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +153200 MOVE "TALLY SIGNED NUM." TO FEATURE. NC2164.2 +153300 MOVE -12345 TO WRK-DS-5V0-1. NC2164.2 +153400 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +153500 MOVE ZERO TO WRK-DU-999-2. NC2164.2 +153600 MOVE 1 TO REC-CT. NC2164.2 +153700 INS-TEST-F1-23-0. NC2164.2 +153800 INSPECT WRK-DS-5V0-1 NC2164.2 +153900 TALLYING WRK-DU-999-1 FOR ALL "-" NC2164.2 +154000 WRK-DU-999-2 FOR ALL "5". NC2164.2 +154100 GO TO INS-TEST-F1-23-1. NC2164.2 +154200 INS-DELETE-F1-23. NC2164.2 +154300 PERFORM DE-LETE. NC2164.2 +154400 PERFORM PRINT-DETAIL. NC2164.2 +154500 GO TO INS-INIT-F1-24. NC2164.2 +154600* NC2164.2 +154700 INS-TEST-F1-23-1. NC2164.2 +154800 IF WRK-DU-999-1 EQUAL 0 NC2164.2 +154900 PERFORM PASS NC2164.2 +155000 GO TO INS-WRITE-F1-23-1 NC2164.2 +155100 ELSE NC2164.2 +155200 PERFORM FAIL NC2164.2 +155300 GO TO INS-FAIL-F1-23-1. NC2164.2 +155400 INS-DELETE-F1-23-1. NC2164.2 +155500 PERFORM DE-LETE. NC2164.2 +155600 GO TO INS-WRITE-F1-23-1. NC2164.2 +155700 INS-FAIL-F1-23-1. NC2164.2 +155800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +155900 MOVE ZERO TO CORRECT-N. NC2164.2 +156000 INS-WRITE-F1-23-1. NC2164.2 +156100 PERFORM PRINT-DETAIL. NC2164.2 +156200* NC2164.2 +156300 INS-TEST-F1-23-2. NC2164.2 +156400 ADD 1 TO REC-CT. NC2164.2 +156500 IF WRK-DU-999-2 EQUAL TO 1 NC2164.2 +156600 PERFORM PASS NC2164.2 +156700 GO TO INS-WRITE-F1-23-2 NC2164.2 +156800 ELSE NC2164.2 +156900 PERFORM FAIL NC2164.2 +157000 GO TO INS-FAIL-F1-23-2. NC2164.2 +157100 INS-DELETE-F1-23-2. NC2164.2 +157200 PERFORM DE-LETE. NC2164.2 +157300 GO TO INS-WRITE-F1-23-2. NC2164.2 +157400 INS-FAIL-F1-23-2. NC2164.2 +157500 MOVE WRK-DU-999-2 TO COMPUTED-N NC2164.2 +157600 MOVE 1 TO CORRECT-N. NC2164.2 +157700 INS-WRITE-F1-23-2. NC2164.2 +157800 PERFORM PRINT-DETAIL. NC2164.2 +157900* NC2164.2 +158000 INS-INIT-F1-24. NC2164.2 +158100 MOVE "INS-TEST-F1-24" TO PAR-NAME. NC2164.2 +158200 MOVE "NUMERIC EDITED FIELD" TO FEATURE. NC2164.2 +158300 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +158400 MOVE 123456.789 TO WRK-NE-1. NC2164.2 +158500 MOVE ZERO TO REC-CT. NC2164.2 +158600 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +158700 INS-TEST-F1-24. NC2164.2 +158800 INSPECT WRK-NE-1 TALLYING WRK-DU-999-1 FOR ALL ",". NC2164.2 +158900 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +159000 PERFORM PASS NC2164.2 +159100 GO TO INS-WRITE-F1-24 NC2164.2 +159200 ELSE NC2164.2 +159300 GO TO INS-FAIL-F1-24. NC2164.2 +159400 INS-DELETE-F1-24. NC2164.2 +159500 PERFORM DE-LETE. NC2164.2 +159600 GO TO INS-WRITE-F1-24. NC2164.2 +159700 INS-FAIL-F1-24. NC2164.2 +159800 PERFORM FAIL NC2164.2 +159900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +160000 MOVE 1 TO CORRECT-N. NC2164.2 +160100 INS-WRITE-F1-24. NC2164.2 +160200 PERFORM PRINT-DETAIL. NC2164.2 +160300* NC2164.2 +160400 INS-INIT-F1-25. NC2164.2 +160500 MOVE "INS-TEST-F1-25" TO PAR-NAME. NC2164.2 +160600 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +160700 MOVE "NUMERIC EDITED FIELD" TO FEATURE. NC2164.2 +160800 MOVE 123456.789 TO WRK-NE-1. NC2164.2 +160900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +161000 INS-TEST-F1-25. NC2164.2 +161100 INSPECT WRK-NE-1 TALLYING WRK-DU-999-1 FOR ALL "-". NC2164.2 +161200 IF WRK-DU-999-1 EQUAL TO ZERO NC2164.2 +161300 PERFORM PASS NC2164.2 +161400 GO TO INS-WRITE-F1-25 NC2164.2 +161500 ELSE NC2164.2 +161600 GO TO INS-FAIL-F1-25. NC2164.2 +161700 INS-DELETE-F1-25. NC2164.2 +161800 PERFORM DE-LETE. NC2164.2 +161900 GO TO INS-WRITE-F1-25. NC2164.2 +162000 INS-FAIL-F1-25. NC2164.2 +162100 PERFORM FAIL NC2164.2 +162200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +162300 MOVE ZERO TO CORRECT-N. NC2164.2 +162400 INS-WRITE-F1-25. NC2164.2 +162500 PERFORM PRINT-DETAIL. NC2164.2 +162600* NC2164.2 +162700 INS-INIT-F1-26. NC2164.2 +162800 MOVE "INS-TEST-F1-26" TO PAR-NAME. NC2164.2 +162900 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +163000 MOVE "2 CHARACTER MASK" TO FEATURE. NC2164.2 +163100 MOVE "X X" TO X-SPACE-X-XN-3. NC2164.2 +163200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +163300 INS-TEST-F1-26. NC2164.2 +163400 INSPECT X-SPACE-X-XN-3 TALLYING WRK-DU-999-1 FOR ALL "X ". NC2164.2 +163500 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +163600 PERFORM PASS NC2164.2 +163700 GO TO INS-WRITE-F1-26 NC2164.2 +163800 ELSE NC2164.2 +163900 GO TO INS-FAIL-F1-26. NC2164.2 +164000 INS-DELETE-F1-26. NC2164.2 +164100 PERFORM DE-LETE. NC2164.2 +164200 GO TO INS-WRITE-F1-26. NC2164.2 +164300 INS-FAIL-F1-26. NC2164.2 +164400 PERFORM FAIL NC2164.2 +164500 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +164600 MOVE 1 TO CORRECT-N. NC2164.2 +164700 INS-WRITE-F1-26. NC2164.2 +164800 PERFORM PRINT-DETAIL. NC2164.2 +164900* NC2164.2 +165000 INS-INIT-F1-27. NC2164.2 +165100 MOVE "INS-TEST-F1-27" TO PAR-NAME. NC2164.2 +165200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +165300 MOVE "ORDER OF COMPARE" TO FEATURE. NC2164.2 +165400 MOVE "AABA" TO AABA-XN-4. NC2164.2 +165500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +165600 MOVE ZERO TO WRK-DU-999-2. NC2164.2 +165700 INS-TEST-F1-27. NC2164.2 +165800 INSPECT AABA-XN-4 TALLYING WRK-DU-999-1 FOR ALL "AA" NC2164.2 +165900 WRK-DU-999-2 FOR ALL "A". NC2164.2 +166000 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +166100 AND NC2164.2 +166200 WRK-DU-999-2 EQUAL TO 1 NC2164.2 +166300 PERFORM PASS NC2164.2 +166400 GO TO INS-WRITE-F1-27 NC2164.2 +166500 ELSE NC2164.2 +166600 GO TO INS-FAIL-F1-27. NC2164.2 +166700 INS-DELETE-F1-27. NC2164.2 +166800 PERFORM DE-LETE. NC2164.2 +166900 GO TO INS-WRITE-F1-27. NC2164.2 +167000 INS-FAIL-F1-27. NC2164.2 +167100 PERFORM FAIL NC2164.2 +167200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +167300 MOVE WRK-DU-999-2 TO CORRECT-N NC2164.2 +167400 MOVE "BOTH SHOULD BE 1" TO RE-MARK. NC2164.2 +167500 INS-WRITE-F1-27. NC2164.2 +167600 PERFORM PRINT-DETAIL. NC2164.2 +167700* NC2164.2 +167800 INS-INIT-F1-28. NC2164.2 +167900* ===--> BEFORE AND AFTER PHRASES <--=== NC2164.2 +168000 MOVE "INS-TEST-F1-28" TO PAR-NAME. NC2164.2 +168100 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +168200 MOVE "TALLY FOR ALL SPACES" TO FEATURE. NC2164.2 +168300 MOVE NC2164.2 +168400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +168500- "IDS CAN NOT BE ALL BAD." NC2164.2 +168600 TO WC-XN-83. NC2164.2 +168700 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +168800 INS-TEST-F1-28. NC2164.2 +168900 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACES NC2164.2 +169000 AFTER "C." NC2164.2 +169100 BEFORE "DO". NC2164.2 +169200 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +169300 PERFORM PASS NC2164.2 +169400 GO TO INS-WRITE-F1-28. NC2164.2 +169500 GO TO INS-FAIL-F1-28. NC2164.2 +169600 INS-DELETE-F1-28. NC2164.2 +169700 PERFORM DE-LETE. NC2164.2 +169800 GO TO INS-WRITE-F1-28. NC2164.2 +169900 INS-FAIL-F1-28. NC2164.2 +170000 PERFORM FAIL. NC2164.2 +170100 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +170200 MOVE 6 TO CORRECT-N. NC2164.2 +170300 INS-WRITE-F1-28. NC2164.2 +170400 PERFORM PRINT-DETAIL. NC2164.2 +170500* NC2164.2 +170600 INS-INIT-F1-29. NC2164.2 +170700* ===--> BEFORE AND AFTER PHRASES <--=== NC2164.2 +170800 MOVE "INS-TEST-F1-29" TO PAR-NAME. NC2164.2 +170900 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +171000 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +171100 MOVE NC2164.2 +171200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +171300- "IDS CAN NOT BE ALL BAD." NC2164.2 +171400 TO WC-XN-83. NC2164.2 +171500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +171600 INS-TEST-F1-29. NC2164.2 +171700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +171800 BEFORE "KI" NC2164.2 +171900 AFTER " W". NC2164.2 +172000 IF WRK-DU-999-1 EQUAL TO 44 NC2164.2 +172100 PERFORM PASS NC2164.2 +172200 GO TO INS-WRITE-F1-29. NC2164.2 +172300 GO TO INS-FAIL-F1-29. NC2164.2 +172400 INS-DELETE-F1-29. NC2164.2 +172500 PERFORM DE-LETE. NC2164.2 +172600 GO TO INS-WRITE-F1-29. NC2164.2 +172700 INS-FAIL-F1-29. NC2164.2 +172800 PERFORM FAIL. NC2164.2 +172900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +173000 MOVE 44 TO CORRECT-N. NC2164.2 +173100 INS-WRITE-F1-29. NC2164.2 +173200 PERFORM PRINT-DETAIL. NC2164.2 +173300* NC2164.2 +173400 INS-INIT-F1-30. NC2164.2 +173500* ===--> EVALUATION OF SUBSCRIPTED IDENTIFIERS <--=== NC2164.2 +173600 MOVE "INS-TEST-F1-30" TO PAR-NAME. NC2164.2 +173700 MOVE "VI-95 6.17.4 GR4 & VI-97 6.17.4 GR8" NC2164.2 +173800 TO ANSI-REFERENCE. NC2164.2 +173900 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +174000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +174100 MOVE "XXXXXXXYYYYYYYAAABAAASSSSSSSTTTTTTT" NC2164.2 +174200 TO INSPECT-FIELDS. NC2164.2 +174300 MOVE "GHBDC" TO LOCATE-CHARS. NC2164.2 +174400 MOVE 3 TO SUB. NC2164.2 +174500 INS-TEST-F1-30-0. NC2164.2 +174600 INSPECT DATA-FIELD (SUB) NC2164.2 +174700 TALLYING WRK-DU-999-1 NC2164.2 +174800 FOR ALL "A" BEFORE END-CHAR (SUB) NC2164.2 +174900 ALL END-CHAR (SUB). NC2164.2 +175000 INS-TEST-F1-30-1. NC2164.2 +175100 IF WRK-DU-999-1 EQUAL TO 4 NC2164.2 +175200 PERFORM PASS NC2164.2 +175300 GO TO INS-WRITE-F1-30-1. NC2164.2 +175400 GO TO INS-FAIL-F1-30-1. NC2164.2 +175500 INS-DELETE-F1-30-1. NC2164.2 +175600 PERFORM DE-LETE. NC2164.2 +175700 GO TO INS-WRITE-F1-30-1. NC2164.2 +175800 INS-FAIL-F1-30-1. NC2164.2 +175900 PERFORM FAIL. NC2164.2 +176000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +176100 MOVE 4 TO CORRECT-N. NC2164.2 +176200 INS-WRITE-F1-30-1. NC2164.2 +176300 PERFORM PRINT-DETAIL. NC2164.2 +176400* NC2164.2 +176500 INS-INIT-F1-31. NC2164.2 +176600 MOVE "INS-TEST-F1-31" TO PAR-NAME. NC2164.2 +176700 MOVE "VI-93" TO ANSI-REFERENCE. NC2164.2 +176800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +176900 MOVE "AABBCCDDEBBBBGHDDIJJXXAABBCCDDEEEFFGGHHIIJJKKLLM" NC2164.2 +177000 TO TEST-31-DATA. NC2164.2 +177100 MOVE "BB" TO WS-BB. NC2164.2 +177200 INS-TEST-F1-31-0. NC2164.2 +177300 INSPECT TEST-31-DATA TALLYING WRK-DU-999-1 NC2164.2 +177400 FOR ALL "A" BEFORE "X" NC2164.2 +177500 ALL WS-BB BEFORE "X" NC2164.2 +177600 ALL "D" BEFORE "X". NC2164.2 +177700 INS-TEST-F1-31-1. NC2164.2 +177800 IF WRK-DU-999-1 EQUAL TO 9 NC2164.2 +177900 PERFORM PASS NC2164.2 +178000 GO TO INS-WRITE-F1-31-1. NC2164.2 +178100 GO TO INS-FAIL-F1-31-1. NC2164.2 +178200 INS-DELETE-F1-31-1. NC2164.2 +178300 PERFORM DE-LETE. NC2164.2 +178400 GO TO INS-WRITE-F1-31-1. NC2164.2 +178500 INS-FAIL-F1-31-1. NC2164.2 +178600 PERFORM FAIL. NC2164.2 +178700 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +178800 MOVE 10 TO CORRECT-N. NC2164.2 +178900 INS-WRITE-F1-31-1. NC2164.2 +179000 PERFORM PRINT-DETAIL. NC2164.2 +179100* NC2164.2 +179200 INS-INIT-F1-32. NC2164.2 +179300 MOVE "INS-TEST-F1-32" TO PAR-NAME. NC2164.2 +179400 MOVE "VI-93" TO ANSI-REFERENCE. NC2164.2 +179500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +179600 MOVE "AABSSSSSEBBTTTT1URSTSTSTVVDYYDEEEFFGSSSSTZSTZSTM" NC2164.2 +179700 TO TEST-32-DATA. NC2164.2 +179800 MOVE "Y" TO WS-Y. NC2164.2 +179900 INS-TEST-F1-32-0. NC2164.2 +180000 INSPECT TEST-32-DATA TALLYING WRK-DU-999-1 NC2164.2 +180100 FOR LEADING "S" AFTER WS-Y NC2164.2 +180200 "S" AFTER "U" NC2164.2 +180300 "T" AFTER WS-Y NC2164.2 +180400 "T" AFTER "U". NC2164.2 +180500 INS-TEST-F1-32-1. NC2164.2 +180600 IF WRK-DU-999-1 EQUAL TO 0 NC2164.2 +180700 PERFORM PASS NC2164.2 +180800 GO TO INS-WRITE-F1-32-1. NC2164.2 +180900 GO TO INS-FAIL-F1-32-1. NC2164.2 +181000 INS-DELETE-F1-32-1. NC2164.2 +181100 PERFORM DE-LETE. NC2164.2 +181200 GO TO INS-WRITE-F1-32-1. NC2164.2 +181300 INS-FAIL-F1-32-1. NC2164.2 +181400 PERFORM FAIL. NC2164.2 +181500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +181600 MOVE 0 TO CORRECT-N. NC2164.2 +181700 INS-WRITE-F1-32-1. NC2164.2 +181800 PERFORM PRINT-DETAIL. NC2164.2 +181900* NC2164.2 +182000 INS-INIT-F2-33. NC2164.2 +182100* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +182200 MOVE "INS-TEST-F2-33" TO PAR-NAME. NC2164.2 +182300 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +182400 MOVE "REP CHARS BY SPACES" TO FEATURE. NC2164.2 +182500 MOVE NC2164.2 +182600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +182700- "IDS CAN NOT BE ALL BAD." NC2164.2 +182800 TO WC-XN-83. NC2164.2 +182900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +183000 MOVE NC2164.2 +183100 "AH YES AH YES W.C NC2164.2 +183200- " BE ALL BAD." NC2164.2 +183300 TO ANS-XN-83-10. NC2164.2 +183400 INS-TEST-F2-33-0. NC2164.2 +183500 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACES NC2164.2 +183600 BEFORE "B" AFTER "C". NC2164.2 +183700 INS-TEST-F2-33-1. NC2164.2 +183800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-10 NC2164.2 +183900 PERFORM PASS NC2164.2 +184000 GO TO INS-WRITE-F2-33-1. NC2164.2 +184100 GO TO INS-FAIL-F2-33-1. NC2164.2 +184200 INS-DELETE-F2-33-1. NC2164.2 +184300 PERFORM DE-LETE. NC2164.2 +184400 GO TO INS-WRITE-F2-33-1. NC2164.2 +184500 INS-FAIL-F2-33-1. NC2164.2 +184600 PERFORM FAIL. NC2164.2 +184700 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +184800 MOVE ANS-XN-83-10 TO WS-RIGHT-1-83. NC2164.2 +184900 MOVE "THERE SHOUD BE 55 SPACES BETWEEN ""B"" AND ""C""." NC2164.2 +185000 TO RE-MARK. NC2164.2 +185100 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2164.2 +185200 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2164.2 +185300 PERFORM PRINT-DETAIL. NC2164.2 +185400 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2164.2 +185500 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2164.2 +185600 PERFORM PRINT-DETAIL. NC2164.2 +185700 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2164.2 +185800 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2164.2 +185900 PERFORM PRINT-DETAIL. NC2164.2 +186000 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2164.2 +186100 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2164.2 +186200 PERFORM PRINT-DETAIL. NC2164.2 +186300 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2164.2 +186400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +186500 INS-WRITE-F2-33-1. NC2164.2 +186600 PERFORM PRINT-DETAIL. NC2164.2 +186700* NC2164.2 +186800 INS-INIT-F2-34. NC2164.2 +186900* ===--> MULTIPLE "CHARACTERS" PHRASES WITH <--=== NC2164.2 +187000* ===--> "BEFORE" AND "AFTER" <--=== NC2164.2 +187100 MOVE "INS-TEST-F2-34" TO PAR-NAME. NC2164.2 +187200 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +187300 MOVE "AAFSSQ ET U V W H S" TO TEST-34-DATA. NC2164.2 +187400 MOVE "AAFXXQ ETYYYYYYYH S" TO TEST-34-ANSWER. NC2164.2 +187500 INS-TEST-F2-34-0. NC2164.2 +187600 INSPECT TEST-34-DATA NC2164.2 +187700 REPLACING NC2164.2 +187800 CHARACTERS BY "X" AFTER "F" BEFORE "Q" NC2164.2 +187900 CHARACTERS BY "Y" AFTER "T" BEFORE "H". NC2164.2 +188000 INS-TEST-F2-34-1. NC2164.2 +188100 IF TEST-34-DATA = TEST-34-ANSWER NC2164.2 +188200 PERFORM PASS NC2164.2 +188300 GO TO INS-WRITE-F2-34-1. NC2164.2 +188400 GO TO INS-FAIL-F2-34-1. NC2164.2 +188500 INS-DELETE-F2-34-1. NC2164.2 +188600 PERFORM DE-LETE. NC2164.2 +188700 GO TO INS-WRITE-F2-34-1. NC2164.2 +188800 INS-FAIL-F2-34-1. NC2164.2 +188900 PERFORM FAIL. NC2164.2 +189000 MOVE TEST-34-DATA TO COMPUTED-A. NC2164.2 +189100 MOVE TEST-34-ANSWER TO CORRECT-A. NC2164.2 +189200 INS-WRITE-F2-34-1. NC2164.2 +189300 PERFORM PRINT-DETAIL. NC2164.2 +189400* NC2164.2 +189500 INS-INIT-F3-35. NC2164.2 +189600* ===--> MULTIPLE "CHARACTERS" PHRASES WITH <--=== NC2164.2 +189700* ===--> "BEFORE" AND "AFTER" <--=== NC2164.2 +189800 MOVE "INS-TEST-F3-35-1" TO PAR-NAME. NC2164.2 +189900 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +190000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +190100 MOVE "AX SSA YEG U V W H S" TO TEST-35-DATA. NC2164.2 +190200 MOVE "AXAAAAAYEG H S" TO TEST-35-ANSWER. NC2164.2 +190300 INS-TEST-F3-35-0. NC2164.2 +190400 INSPECT TEST-35-DATA TALLYING WRK-DU-999-1 NC2164.2 +190500 FOR CHARACTERS NC2164.2 +190600 REPLACING NC2164.2 +190700 CHARACTERS BY "A" AFTER "X" BEFORE "Y" NC2164.2 +190800 CHARACTERS BY SPACE AFTER "G" BEFORE "H". NC2164.2 +190900 INS-TEST-F3-35-1. NC2164.2 +191000 IF TEST-35-DATA = TEST-35-ANSWER NC2164.2 +191100 PERFORM PASS NC2164.2 +191200 GO TO INS-WRITE-F3-35-1. NC2164.2 +191300 GO TO INS-FAIL-F3-35-1. NC2164.2 +191400 INS-DELETE-F3-35-1. NC2164.2 +191500 PERFORM DE-LETE. NC2164.2 +191600 GO TO INS-WRITE-F3-35-1. NC2164.2 +191700 INS-FAIL-F3-35-1. NC2164.2 +191800 PERFORM FAIL. NC2164.2 +191900 MOVE TEST-35-DATA TO COMPUTED-A. NC2164.2 +192000 MOVE TEST-35-ANSWER TO CORRECT-A. NC2164.2 +192100 INS-WRITE-F3-35-1. NC2164.2 +192200 PERFORM PRINT-DETAIL. NC2164.2 +192300* NC2164.2 +192400 INS-INIT-F3-36. NC2164.2 +192500* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +192600 MOVE "INS-TEST-F3-36" TO PAR-NAME. NC2164.2 +192700 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC2164.2 +192800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +192900 MOVE NC2164.2 +193000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +193100- "IDS CAN NOT BE ALL BAZ." NC2164.2 +193200 TO WC-XN-83. NC2164.2 +193300 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +193400 MOVE NC2164.2 +193500 "AH NC2164.2 +193600- " Z." NC2164.2 +193700 TO ANS-XN-83-11. NC2164.2 +193800 MOVE 1 TO REC-CT. NC2164.2 +193900 INS-TEST-F3-36-0. NC2164.2 +194000 INSPECT WRK-XN-83-1 NC2164.2 +194100 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +194200 BEFORE "LL" AFTER "ES" NC2164.2 +194300 REPLACING CHARACTERS BY SPACES NC2164.2 +194400 AFTER "H" BEFORE "Z". NC2164.2 +194500 GO TO INS-TEST-F3-36-1. NC2164.2 +194600 INS-DELETE-F3-36. NC2164.2 +194700 PERFORM DE-LETE. NC2164.2 +194800 PERFORM PRINT-DETAIL. NC2164.2 +194900 GO TO INS-INIT-F3-37. NC2164.2 +195000 INS-TEST-F3-36-1. NC2164.2 +195100 IF WRK-DU-999-1 EQUAL TO 70 NC2164.2 +195200 PERFORM PASS NC2164.2 +195300 GO TO INS-WRITE-F3-36-1 NC2164.2 +195400 ELSE NC2164.2 +195500 GO TO INS-FAIL-F3-36-1. NC2164.2 +195600 INS-DELETE-F3-36-1. NC2164.2 +195700 PERFORM DE-LETE. NC2164.2 +195800 GO TO INS-WRITE-F3-36-1. NC2164.2 +195900 INS-FAIL-F3-36-1. NC2164.2 +196000 PERFORM FAIL NC2164.2 +196100 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +196200 MOVE 70 TO CORRECT-N. NC2164.2 +196300 INS-WRITE-F3-36-1. NC2164.2 +196400 PERFORM PRINT-DETAIL. NC2164.2 +196500* NC2164.2 +196600 INS-TEST-F3-36-2. NC2164.2 +196700 ADD 1 TO REC-CT. NC2164.2 +196800 IF WRK-XN-83-1 = ANS-XN-83-11 NC2164.2 +196900 PERFORM PASS NC2164.2 +197000 GO TO INS-WRITE-F3-36-2 NC2164.2 +197100 ELSE NC2164.2 +197200 GO TO INS-FAIL-F3-36-2. NC2164.2 +197300 INS-DELETE-F3-36-2. NC2164.2 +197400 PERFORM DE-LETE. NC2164.2 +197500 GO TO INS-WRITE-F3-36-2. NC2164.2 +197600 INS-FAIL-F3-36-2. NC2164.2 +197700 PERFORM FAIL NC2164.2 +197800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +197900 MOVE ANS-XN-83-11 TO WS-RIGHT-1-83 NC2164.2 +198000 MOVE "THERE SHOULD BE 81 SPACES BETWEEN ""H"" AND ""Z""." NC2164.2 +198100 TO RE-MARK NC2164.2 +198200 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +198300 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +198400 PERFORM PRINT-DETAIL NC2164.2 +198500 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +198600 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +198700 PERFORM PRINT-DETAIL NC2164.2 +198800 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +198900 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +199000 PERFORM PRINT-DETAIL NC2164.2 +199100 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +199200 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +199300 PERFORM PRINT-DETAIL NC2164.2 +199400 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +199500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +199600 INS-WRITE-F3-36-2. NC2164.2 +199700 PERFORM PRINT-DETAIL. NC2164.2 +199800* NC2164.2 +199900 INS-INIT-F3-37. NC2164.2 +200000* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +200100 MOVE "INS-TEST-F3-37" TO PAR-NAME. NC2164.2 +200200 MOVE "REPL FIRST AFTER" TO FEATURE. NC2164.2 +200300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +200400 MOVE NC2164.2 +200500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +200600- "IDS CAN NOT BE ALL BAD." NC2164.2 +200700 TO WC-XN-83. NC2164.2 +200800 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +200900 MOVE NC2164.2 +201000 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +201100- "IDS CAN NOT BE ALL BAD." NC2164.2 +201200 TO ANS-XN-83-5. NC2164.2 +201300 MOVE 1 TO REC-CT. NC2164.2 +201400 INS-TEST-F3-37-0. NC2164.2 +201500 INSPECT WRK-XN-83-1 NC2164.2 +201600 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +201700 BEFORE L-XN-1-1 NC2164.2 +201800 AFTER "YE" NC2164.2 +201900 REPLACING FIRST AH-XN-2 BY "OH" NC2164.2 +202000 AFTER INITIAL HSPACE-XN-2 NC2164.2 +202100 BEFORE "F". NC2164.2 +202200 GO TO INS-TEST-F3-37-1. NC2164.2 +202300 INS-DELETE-F3-37. NC2164.2 +202400 PERFORM DE-LETE. NC2164.2 +202500 PERFORM PRINT-DETAIL. NC2164.2 +202600 GO TO INS-INIT-F3-38. NC2164.2 +202700 INS-TEST-F3-37-1. NC2164.2 +202800 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +202900 PERFORM PASS NC2164.2 +203000 GO TO INS-WRITE-F3-37-1 NC2164.2 +203100 ELSE NC2164.2 +203200 GO TO INS-FAIL-F3-37-1. NC2164.2 +203300 INS-DELETE-F3-37-1. NC2164.2 +203400 PERFORM DE-LETE. NC2164.2 +203500 GO TO INS-WRITE-F3-37-1. NC2164.2 +203600 INS-FAIL-F3-37-1. NC2164.2 +203700 PERFORM FAIL NC2164.2 +203800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +203900 MOVE 6 TO CORRECT-N. NC2164.2 +204000 INS-WRITE-F3-37-1. NC2164.2 +204100 PERFORM PRINT-DETAIL. NC2164.2 +204200* NC2164.2 +204300 INS-TEST-F3-37-2. NC2164.2 +204400 ADD 1 TO REC-CT. NC2164.2 +204500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +204600 PERFORM PASS NC2164.2 +204700 GO TO INS-WRITE-F3-37-2 NC2164.2 +204800 ELSE NC2164.2 +204900 GO TO INS-FAIL-F3-37-2. NC2164.2 +205000 INS-DELETE-F3-37-2. NC2164.2 +205100 PERFORM DE-LETE. NC2164.2 +205200 GO TO INS-WRITE-F3-37-2. NC2164.2 +205300 INS-FAIL-F3-37-2. NC2164.2 +205400 PERFORM FAIL NC2164.2 +205500 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +205600 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2164.2 +205700 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +205800 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +205900 PERFORM PRINT-DETAIL NC2164.2 +206000 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +206100 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +206200 PERFORM PRINT-DETAIL NC2164.2 +206300 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +206400 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +206500 PERFORM PRINT-DETAIL NC2164.2 +206600 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +206700 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +206800 PERFORM PRINT-DETAIL NC2164.2 +206900 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +207000 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +207100 INS-WRITE-F3-37-2. NC2164.2 +207200 PERFORM PRINT-DETAIL. NC2164.2 +207300* NC2164.2 +207400 INS-INIT-F3-38. NC2164.2 +207500* ===--> MULTIPLE OPERANDS FOR "ALL" <--=== NC2164.2 +207600 MOVE "INS-TEST-F3-38" TO PAR-NAME. NC2164.2 +207700 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +207800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +207900 MOVE "E" TO WS-E. NC2164.2 +208000 MOVE "AXESSA YEGTUASSW H S" TO TEST-38-DATA. NC2164.2 +208100 MOVE ZERO TO REC-CT. NC2164.2 +208200 INS-TEST-F3-38-0. NC2164.2 +208300 INSPECT TEST-38-DATA TALLYING WRK-DU-999-1 NC2164.2 +208400 FOR NC2164.2 +208500 ALL "A" AFTER WS-E NC2164.2 +208600 "A" AFTER "T" NC2164.2 +208700 "S" AFTER WS-E NC2164.2 +208800 "S" AFTER "T". NC2164.2 +208900 INS-TEST-F3-38-1. NC2164.2 +209000 IF WRK-DU-999-1 = 7 NC2164.2 +209100 PERFORM PASS NC2164.2 +209200 GO TO INS-WRITE-F3-38. NC2164.2 +209300 GO TO INS-FAIL-F3-38. NC2164.2 +209400 INS-DELETE-F3-38. NC2164.2 +209500 PERFORM DE-LETE. NC2164.2 +209600 GO TO INS-WRITE-F3-38. NC2164.2 +209700 INS-FAIL-F3-38. NC2164.2 +209800 PERFORM FAIL. NC2164.2 +209900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +210000 MOVE 7 TO CORRECT-N. NC2164.2 +210100 INS-WRITE-F3-38. NC2164.2 +210200 PERFORM PRINT-DETAIL. NC2164.2 +210300* NC2164.2 +210400 INS-INIT-F3-39. NC2164.2 +210500* ===--> MULTIPLE OPERANDS FOR "LEADING" <--=== NC2164.2 +210600 MOVE "INS-TEST-F3-39" TO PAR-NAME. NC2164.2 +210700 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +210800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +210900 MOVE "ABESSA YE TUTCGW H S" TO TEST-39-DATA. NC2164.2 +211000 INS-TEST-F3-39-0. NC2164.2 +211100 INSPECT TEST-39-DATA NC2164.2 +211200 TALLYING WRK-DU-999-1 NC2164.2 +211300 FOR LEADING "B" NC2164.2 +211400 LEADING WS-E NC2164.2 +211500 BEFORE "C" NC2164.2 +211600 REPLACING NC2164.2 +211700 CHARACTERS BY "A" AFTER "X" BEFORE "Y" NC2164.2 +211800 CHARACTERS BY SPACE AFTER "G" BEFORE "H". NC2164.2 +211900 INS-TEST-F3-39-1. NC2164.2 +212000 IF WRK-DU-999-1 = 0 NC2164.2 +212100 PERFORM PASS NC2164.2 +212200 GO TO INS-WRITE-F3-39-1. NC2164.2 +212300 GO TO INS-FAIL-F3-39-1. NC2164.2 +212400 INS-DELETE-F3-39-1. NC2164.2 +212500 PERFORM DE-LETE. NC2164.2 +212600 GO TO INS-WRITE-F3-39-1. NC2164.2 +212700 INS-FAIL-F3-39-1. NC2164.2 +212800 PERFORM FAIL. NC2164.2 +212900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +213000 MOVE 0 TO CORRECT-N. NC2164.2 +213100 INS-WRITE-F3-39-1. NC2164.2 +213200 PERFORM PRINT-DETAIL. NC2164.2 +213300* NC2164.2 +213400 INS-INIT-F4-40. NC2164.2 +213500* ===--> INSPECT CONVERTING <--=== NC2164.2 +213600 MOVE "INS-TEST-F4-40" TO PAR-NAME. NC2164.2 +213700 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +213800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +213900 MOVE "GADQAUZTABAGA" TO TEST-40-DATA. NC2164.2 +214000 INS-TEST-F4-40-0. NC2164.2 +214100 INSPECT TEST-40-DATA NC2164.2 +214200 CONVERTING "AU" TO "23" BEFORE "B" AFTER "Q". NC2164.2 +214300 GO TO INS-TEST-F4-40-1. NC2164.2 +214400 INS-DELETE-F4-40. NC2164.2 +214500 PERFORM DE-LETE. NC2164.2 +214600 PERFORM PRINT-DETAIL. NC2164.2 +214700 GO TO INS-INIT-F4-41. NC2164.2 +214800 INS-TEST-F4-40-1. NC2164.2 +214900 IF TEST-40-DATA = "GADQ23ZT2BAGA" NC2164.2 +215000 PERFORM PASS NC2164.2 +215100 GO TO INS-WRITE-F4-40-1 NC2164.2 +215200 ELSE NC2164.2 +215300 GO TO INS-FAIL-F4-40-1. NC2164.2 +215400 INS-DELETE-F4-40-1. NC2164.2 +215500 PERFORM DE-LETE. NC2164.2 +215600 GO TO INS-WRITE-F4-40-1. NC2164.2 +215700 INS-FAIL-F4-40-1. NC2164.2 +215800 MOVE "GADQ23ZT2BAGA" TO CORRECT-A NC2164.2 +215900 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +216000 PERFORM FAIL. NC2164.2 +216100 INS-WRITE-F4-40-1. NC2164.2 +216200 PERFORM PRINT-DETAIL. NC2164.2 +216300 INS-INIT-F4-41. NC2164.2 +216400* ===--> INSPECT CONVERTING <--=== NC2164.2 +216500 MOVE "INS-TEST-F4-41" TO PAR-NAME. NC2164.2 +216600 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +216700 MOVE "GADQ23ZT2BAGA" TO TEST-40-DATA. NC2164.2 +216800 MOVE "DF" TO XN-DF. NC2164.2 +216900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +217000 INS-TEST-F4-41-0. NC2164.2 +217100 INSPECT TEST-40-DATA NC2164.2 +217200 CONVERTING XN-DF TO "45". NC2164.2 +217300 GO TO INS-TEST-F4-41-1. NC2164.2 +217400 INS-DELETE-F4-41. NC2164.2 +217500 PERFORM DE-LETE. NC2164.2 +217600 PERFORM PRINT-DETAIL. NC2164.2 +217700 GO TO INS-INIT-F4-42. NC2164.2 +217800 INS-TEST-F4-41-1. NC2164.2 +217900 IF TEST-40-DATA = "GA4Q23ZT2BAGA" NC2164.2 +218000 PERFORM PASS NC2164.2 +218100 GO TO INS-WRITE-F4-41-1 NC2164.2 +218200 ELSE NC2164.2 +218300 GO TO INS-FAIL-F4-41-1. NC2164.2 +218400 INS-DELETE-F4-41-1. NC2164.2 +218500 PERFORM DE-LETE. NC2164.2 +218600 GO TO INS-WRITE-F4-41-1. NC2164.2 +218700 INS-FAIL-F4-41-1. NC2164.2 +218800 MOVE "GA4Q23ZT2BAGA" TO CORRECT-A NC2164.2 +218900 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +219000 PERFORM FAIL. NC2164.2 +219100 INS-WRITE-F4-41-1. NC2164.2 +219200 PERFORM PRINT-DETAIL. NC2164.2 +219300* NC2164.2 +219400 INS-INIT-F4-42. NC2164.2 +219500* ===--> INSPECT CONVERTING <--=== NC2164.2 +219600 MOVE "INS-TEST-F4-42" TO PAR-NAME. NC2164.2 +219700 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +219800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +219900 MOVE "GA4Q23ZT2BAGA" TO TEST-40-DATA. NC2164.2 +220000 MOVE "67" TO XN-67. NC2164.2 +220100 INS-TEST-F4-42-0. NC2164.2 +220200 INSPECT TEST-40-DATA NC2164.2 +220300 CONVERTING "GA" TO XN-67 BEFORE XN-B. NC2164.2 +220400 GO TO INS-TEST-F4-42-1. NC2164.2 +220500 INS-DELETE-F4-42. NC2164.2 +220600 PERFORM DE-LETE. NC2164.2 +220700 PERFORM PRINT-DETAIL. NC2164.2 +220800 GO TO CCVS-EXIT. NC2164.2 +220900 INS-TEST-F4-42-1. NC2164.2 +221000 IF TEST-40-DATA = "674Q23ZT2BAGA" NC2164.2 +221100 PERFORM PASS NC2164.2 +221200 GO TO INS-WRITE-F4-42-1 NC2164.2 +221300 ELSE NC2164.2 +221400 GO TO INS-FAIL-F4-42-1. NC2164.2 +221500 INS-DELETE-F4-42-1. NC2164.2 +221600 PERFORM DE-LETE. NC2164.2 +221700 GO TO INS-WRITE-F4-42-1. NC2164.2 +221800 INS-FAIL-F4-42-1. NC2164.2 +221900 MOVE "674Q23ZT2BAGA" TO CORRECT-A NC2164.2 +222000 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +222100 PERFORM FAIL. NC2164.2 +222200 INS-WRITE-F4-42-1. NC2164.2 +222300 PERFORM PRINT-DETAIL. NC2164.2 +222400* NC2164.2 +222500 CCVS-EXIT SECTION. NC2164.2 +222600 CCVS-999999. NC2164.2 +222700 GO TO CLOSE-FILES. NC2164.2 +*END-OF,NC216A +*HEADER,COBOL,NC217A +000100 IDENTIFICATION DIVISION. NC2174.2 +000200 PROGRAM-ID. NC2174.2 +000300 NC217A. NC2174.2 +000400**************************************************************** NC2174.2 +000500* * NC2174.2 +000600* VALIDATION FOR:- * NC2174.2 +000700* * NC2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +000900* * NC2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2174.2 +001100* * NC2174.2 +001200**************************************************************** NC2174.2 +001300* * NC2174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2174.2 +001500* * NC2174.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2174.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2174.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2174.2 +001900* * NC2174.2 +002000**************************************************************** NC2174.2 +002100* * NC2174.2 +002200* PROGRAM NC217A TESTS THE USE OF THE "STRING" STATEMENT, * NC2174.2 +002300* INCLUDING THE OPTIONAL PHRASES "POINTER", "OVERFLOW", * NC2174.2 +002400* "NOT OVERFLOW" AND "END-STRING". * NC2174.2 +002500* * NC2174.2 +002600* * NC2174.2 +002700**************************************************************** NC2174.2 +002800 ENVIRONMENT DIVISION. NC2174.2 +002900 CONFIGURATION SECTION. NC2174.2 +003000 SOURCE-COMPUTER. NC2174.2 +003100 XXXXX082. NC2174.2 +003200 OBJECT-COMPUTER. NC2174.2 +003300 XXXXX083. NC2174.2 +003400 INPUT-OUTPUT SECTION. NC2174.2 +003500 FILE-CONTROL. NC2174.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2174.2 +003700 XXXXX055. NC2174.2 +003800 DATA DIVISION. NC2174.2 +003900 FILE SECTION. NC2174.2 +004000 FD PRINT-FILE. NC2174.2 +004100 01 PRINT-REC PICTURE X(120). NC2174.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2174.2 +004300 WORKING-STORAGE SECTION. NC2174.2 +004400 01 WRK-XN-00001-1 PIC X. NC2174.2 +004500 01 WRK-XN-00001-2 PIC X. NC2174.2 +004600 01 WRK-XN-00001-3 PIC X. NC2174.2 +004700 01 ID8-DU-2V0 PIC 99. NC2174.2 +004800 01 ISUB-DU-2V0 PIC 99. NC2174.2 +004900 01 MY-BOSS-DU-2V0 PIC 99 VALUE ZERO. NC2174.2 +005000 01 ID1-DS-LS-4 PIC S9(4) VALUE +1001 SIGN IS LEADING SEPARATE. NC2174.2 +005100 01 ID1-DS-TS-4 PIC S9(4) VALUE +1001 SIGN IS TRAILING SEPARATE. NC2174.2 +005200 01 ID1-XN-25 PIC X(25) VALUE NC2174.2 +005300 "A2345B2345C2345D2345E2345". NC2174.2 +005400 01 ID1-XN-X-25 REDEFINES ID1-XN-25. NC2174.2 +005500 10 ID1-1 PIC X OCCURS 5 TIMES. NC2174.2 +005600 10 ID1-2 PIC X OCCURS 5 TIMES. NC2174.2 +005700 10 ID1-3 PIC X OCCURS 5 TIMES. NC2174.2 +005800 10 ID1-4 PIC X OCCURS 5 TIMES. NC2174.2 +005900 10 ID1-5 PIC X OCCURS 5 TIMES. NC2174.2 +006000 01 ZEROX-XN-1 PIC X VALUE ZERO. NC2174.2 +006100 01 A-XN-1 PIC X VALUE "A". NC2174.2 +006200 01 B-XN-1 PIC X VALUE "B". NC2174.2 +006300 01 AB-XN-2 PIC XX VALUE "AB". NC2174.2 +006400 01 ID7-XN-5 PIC X(5). NC2174.2 +006500 01 ASTER-XN-5 PIC X(5) VALUE "*****". NC2174.2 +006600 01 ANS-XN-5-1. NC2174.2 +006700 10 FILLER PIC X VALUE LOW-VALUE. NC2174.2 +006800 10 FILLER PIC X(4) VALUE "ABCD". NC2174.2 +006900 01 ANS-XN-5-2. NC2174.2 +007000 10 FILLER PIC X VALUE HIGH-VALUE. NC2174.2 +007100 10 FILLER PIC X(4) VALUE "****". NC2174.2 +007200 01 DELIM-TABLE-XN-5 PIC X(5) VALUE "CDEFF". NC2174.2 +007300 01 DELIM-XN-X-1 REDEFINES DELIM-TABLE-XN-5. NC2174.2 +007400 10 ID3-XN-1 PIC X OCCURS 5 TIMES. NC2174.2 +007500 01 ABCDEFG-XN-7 PIC X(7) VALUE "ABCDEFG". NC2174.2 +007600 01 ID7-XN-15 PIC X(15) VALUE SPACES. NC2174.2 +007700 01 WISH-LIST-XN-37 PIC X(37) VALUE SPACES. NC2174.2 +007800 01 ANS-XN-37 PIC X(37) VALUE NC2174.2 +007900 "GEE I WISH I WAS A FORTRAN PROGRAMMER". NC2174.2 +008000 01 TEST-21-GROUP. NC2174.2 +008100 03 TEST-21-A PIC XX. NC2174.2 +008200 03 TEST-21-B PIC XX. NC2174.2 +008300 03 TEST-21-C PIC X. NC2174.2 +008400 NC2174.2 +008500 01 TEST-RESULTS. NC2174.2 +008600 02 FILLER PIC X VALUE SPACE. NC2174.2 +008700 02 FEATURE PIC X(20) VALUE SPACE. NC2174.2 +008800 02 FILLER PIC X VALUE SPACE. NC2174.2 +008900 02 P-OR-F PIC X(5) VALUE SPACE. NC2174.2 +009000 02 FILLER PIC X VALUE SPACE. NC2174.2 +009100 02 PAR-NAME. NC2174.2 +009200 03 FILLER PIC X(19) VALUE SPACE. NC2174.2 +009300 03 PARDOT-X PIC X VALUE SPACE. NC2174.2 +009400 03 DOTVALUE PIC 99 VALUE ZERO. NC2174.2 +009500 02 FILLER PIC X(8) VALUE SPACE. NC2174.2 +009600 02 RE-MARK PIC X(61). NC2174.2 +009700 01 TEST-COMPUTED. NC2174.2 +009800 02 FILLER PIC X(30) VALUE SPACE. NC2174.2 +009900 02 FILLER PIC X(17) VALUE NC2174.2 +010000 " COMPUTED=". NC2174.2 +010100 02 COMPUTED-X. NC2174.2 +010200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2174.2 +010300 03 COMPUTED-N REDEFINES COMPUTED-A NC2174.2 +010400 PIC -9(9).9(9). NC2174.2 +010500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2174.2 +010600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2174.2 +010700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2174.2 +010800 03 CM-18V0 REDEFINES COMPUTED-A. NC2174.2 +010900 04 COMPUTED-18V0 PIC -9(18). NC2174.2 +011000 04 FILLER PIC X. NC2174.2 +011100 03 FILLER PIC X(50) VALUE SPACE. NC2174.2 +011200 01 TEST-CORRECT. NC2174.2 +011300 02 FILLER PIC X(30) VALUE SPACE. NC2174.2 +011400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2174.2 +011500 02 CORRECT-X. NC2174.2 +011600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2174.2 +011700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2174.2 +011800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2174.2 +011900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2174.2 +012000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2174.2 +012100 03 CR-18V0 REDEFINES CORRECT-A. NC2174.2 +012200 04 CORRECT-18V0 PIC -9(18). NC2174.2 +012300 04 FILLER PIC X. NC2174.2 +012400 03 FILLER PIC X(2) VALUE SPACE. NC2174.2 +012500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2174.2 +012600 01 CCVS-C-1. NC2174.2 +012700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2174.2 +012800- "SS PARAGRAPH-NAME NC2174.2 +012900- " REMARKS". NC2174.2 +013000 02 FILLER PIC X(20) VALUE SPACE. NC2174.2 +013100 01 CCVS-C-2. NC2174.2 +013200 02 FILLER PIC X VALUE SPACE. NC2174.2 +013300 02 FILLER PIC X(6) VALUE "TESTED". NC2174.2 +013400 02 FILLER PIC X(15) VALUE SPACE. NC2174.2 +013500 02 FILLER PIC X(4) VALUE "FAIL". NC2174.2 +013600 02 FILLER PIC X(94) VALUE SPACE. NC2174.2 +013700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2174.2 +013800 01 REC-CT PIC 99 VALUE ZERO. NC2174.2 +013900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2174.2 +014400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2174.2 +014500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2174.2 +014600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2174.2 +014700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2174.2 +014800 01 CCVS-H-1. NC2174.2 +014900 02 FILLER PIC X(39) VALUE SPACES. NC2174.2 +015000 02 FILLER PIC X(42) VALUE NC2174.2 +015100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2174.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC2174.2 +015300 01 CCVS-H-2A. NC2174.2 +015400 02 FILLER PIC X(40) VALUE SPACE. NC2174.2 +015500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2174.2 +015600 02 FILLER PIC XXXX VALUE NC2174.2 +015700 "4.2 ". NC2174.2 +015800 02 FILLER PIC X(28) VALUE NC2174.2 +015900 " COPY - NOT FOR DISTRIBUTION". NC2174.2 +016000 02 FILLER PIC X(41) VALUE SPACE. NC2174.2 +016100 NC2174.2 +016200 01 CCVS-H-2B. NC2174.2 +016300 02 FILLER PIC X(15) VALUE NC2174.2 +016400 "TEST RESULT OF ". NC2174.2 +016500 02 TEST-ID PIC X(9). NC2174.2 +016600 02 FILLER PIC X(4) VALUE NC2174.2 +016700 " IN ". NC2174.2 +016800 02 FILLER PIC X(12) VALUE NC2174.2 +016900 " HIGH ". NC2174.2 +017000 02 FILLER PIC X(22) VALUE NC2174.2 +017100 " LEVEL VALIDATION FOR ". NC2174.2 +017200 02 FILLER PIC X(58) VALUE NC2174.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +017400 01 CCVS-H-3. NC2174.2 +017500 02 FILLER PIC X(34) VALUE NC2174.2 +017600 " FOR OFFICIAL USE ONLY ". NC2174.2 +017700 02 FILLER PIC X(58) VALUE NC2174.2 +017800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2174.2 +017900 02 FILLER PIC X(28) VALUE NC2174.2 +018000 " COPYRIGHT 1985 ". NC2174.2 +018100 01 CCVS-E-1. NC2174.2 +018200 02 FILLER PIC X(52) VALUE SPACE. NC2174.2 +018300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2174.2 +018400 02 ID-AGAIN PIC X(9). NC2174.2 +018500 02 FILLER PIC X(45) VALUE SPACES. NC2174.2 +018600 01 CCVS-E-2. NC2174.2 +018700 02 FILLER PIC X(31) VALUE SPACE. NC2174.2 +018800 02 FILLER PIC X(21) VALUE SPACE. NC2174.2 +018900 02 CCVS-E-2-2. NC2174.2 +019000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2174.2 +019100 03 FILLER PIC X VALUE SPACE. NC2174.2 +019200 03 ENDER-DESC PIC X(44) VALUE NC2174.2 +019300 "ERRORS ENCOUNTERED". NC2174.2 +019400 01 CCVS-E-3. NC2174.2 +019500 02 FILLER PIC X(22) VALUE NC2174.2 +019600 " FOR OFFICIAL USE ONLY". NC2174.2 +019700 02 FILLER PIC X(12) VALUE SPACE. NC2174.2 +019800 02 FILLER PIC X(58) VALUE NC2174.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +020000 02 FILLER PIC X(13) VALUE SPACE. NC2174.2 +020100 02 FILLER PIC X(15) VALUE NC2174.2 +020200 " COPYRIGHT 1985". NC2174.2 +020300 01 CCVS-E-4. NC2174.2 +020400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2174.2 +020500 02 FILLER PIC X(4) VALUE " OF ". NC2174.2 +020600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2174.2 +020700 02 FILLER PIC X(40) VALUE NC2174.2 +020800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2174.2 +020900 01 XXINFO. NC2174.2 +021000 02 FILLER PIC X(19) VALUE NC2174.2 +021100 "*** INFORMATION ***". NC2174.2 +021200 02 INFO-TEXT. NC2174.2 +021300 04 FILLER PIC X(8) VALUE SPACE. NC2174.2 +021400 04 XXCOMPUTED PIC X(20). NC2174.2 +021500 04 FILLER PIC X(5) VALUE SPACE. NC2174.2 +021600 04 XXCORRECT PIC X(20). NC2174.2 +021700 02 INF-ANSI-REFERENCE PIC X(48). NC2174.2 +021800 01 HYPHEN-LINE. NC2174.2 +021900 02 FILLER PIC IS X VALUE IS SPACE. NC2174.2 +022000 02 FILLER PIC IS X(65) VALUE IS "************************NC2174.2 +022100- "*****************************************". NC2174.2 +022200 02 FILLER PIC IS X(54) VALUE IS "************************NC2174.2 +022300- "******************************". NC2174.2 +022400 01 CCVS-PGM-ID PIC X(9) VALUE NC2174.2 +022500 "NC217A". NC2174.2 +022600 PROCEDURE DIVISION. NC2174.2 +022700 CCVS1 SECTION. NC2174.2 +022800 OPEN-FILES. NC2174.2 +022900 OPEN OUTPUT PRINT-FILE. NC2174.2 +023000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2174.2 +023100 MOVE SPACE TO TEST-RESULTS. NC2174.2 +023200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2174.2 +023300 GO TO CCVS1-EXIT. NC2174.2 +023400 CLOSE-FILES. NC2174.2 +023500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2174.2 +023600 TERMINATE-CCVS. NC2174.2 +023700S EXIT PROGRAM. NC2174.2 +023800STERMINATE-CALL. NC2174.2 +023900 STOP RUN. NC2174.2 +024000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2174.2 +024100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2174.2 +024200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2174.2 +024300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2174.2 +024400 MOVE "****TEST DELETED****" TO RE-MARK. NC2174.2 +024500 PRINT-DETAIL. NC2174.2 +024600 IF REC-CT NOT EQUAL TO ZERO NC2174.2 +024700 MOVE "." TO PARDOT-X NC2174.2 +024800 MOVE REC-CT TO DOTVALUE. NC2174.2 +024900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2174.2 +025000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2174.2 +025100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2174.2 +025200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2174.2 +025300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2174.2 +025400 MOVE SPACE TO CORRECT-X. NC2174.2 +025500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2174.2 +025600 MOVE SPACE TO RE-MARK. NC2174.2 +025700 HEAD-ROUTINE. NC2174.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2174.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2174.2 +026200 COLUMN-NAMES-ROUTINE. NC2174.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +026600 END-ROUTINE. NC2174.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2174.2 +026800 END-RTN-EXIT. NC2174.2 +026900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +027000 END-ROUTINE-1. NC2174.2 +027100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2174.2 +027200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2174.2 +027300 ADD PASS-COUNTER TO ERROR-HOLD. NC2174.2 +027400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2174.2 +027500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2174.2 +027600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2174.2 +027700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2174.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2174.2 +027900 END-ROUTINE-12. NC2174.2 +028000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2174.2 +028100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2174.2 +028200 MOVE "NO " TO ERROR-TOTAL NC2174.2 +028300 ELSE NC2174.2 +028400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2174.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2174.2 +028600 PERFORM WRITE-LINE. NC2174.2 +028700 END-ROUTINE-13. NC2174.2 +028800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2174.2 +028900 MOVE "NO " TO ERROR-TOTAL ELSE NC2174.2 +029000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2174.2 +029100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2174.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029300 IF INSPECT-COUNTER EQUAL TO ZERO NC2174.2 +029400 MOVE "NO " TO ERROR-TOTAL NC2174.2 +029500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2174.2 +029600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2174.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029900 WRITE-LINE. NC2174.2 +030000 ADD 1 TO RECORD-COUNT. NC2174.2 +030100Y IF RECORD-COUNT GREATER 50 NC2174.2 +030200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2174.2 +030300Y MOVE SPACE TO DUMMY-RECORD NC2174.2 +030400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2174.2 +030500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2174.2 +030600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2174.2 +030700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2174.2 +030800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2174.2 +030900Y MOVE ZERO TO RECORD-COUNT. NC2174.2 +031000 PERFORM WRT-LN. NC2174.2 +031100 WRT-LN. NC2174.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2174.2 +031300 MOVE SPACE TO DUMMY-RECORD. NC2174.2 +031400 BLANK-LINE-PRINT. NC2174.2 +031500 PERFORM WRT-LN. NC2174.2 +031600 FAIL-ROUTINE. NC2174.2 +031700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2174.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2174.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2174.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2174.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2174.2 +032300 GO TO FAIL-ROUTINE-EX. NC2174.2 +032400 FAIL-ROUTINE-WRITE. NC2174.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2174.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2174.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2174.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2174.2 +032900 FAIL-ROUTINE-EX. EXIT. NC2174.2 +033000 BAIL-OUT. NC2174.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2174.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2174.2 +033300 BAIL-OUT-WRITE. NC2174.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2174.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2174.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2174.2 +033800 BAIL-OUT-EX. EXIT. NC2174.2 +033900 CCVS1-EXIT. NC2174.2 +034000 EXIT. NC2174.2 +034100 SECT-NC217A-001 SECTION. NC2174.2 +034200 STR-INIT-GF-1. NC2174.2 +034300 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +034400 MOVE "STR-TEST-GF-1" TO PAR-NAME. NC2174.2 +034500 MOVE "LIT DEL BY SIZE" TO FEATURE. NC2174.2 +034600 MOVE "*****" TO ID7-XN-5. NC2174.2 +034700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +034800 MOVE 1 TO REC-CT. NC2174.2 +034900 STR-TEST-GF-1. NC2174.2 +035000 STRING "ABCDEF" DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +035100 WITH POINTER ID8-DU-2V0. NC2174.2 +035200 GO TO STR-TEST-GF-1-1. NC2174.2 +035300 STR-DELETE-GF-1. NC2174.2 +035400 PERFORM DE-LETE. NC2174.2 +035500 PERFORM PRINT-DETAIL. NC2174.2 +035600 GO TO STR-INIT-GF-2. NC2174.2 +035700 STR-TEST-GF-1-1. NC2174.2 +035800 IF ID7-XN-5 = "ABCDE" NC2174.2 +035900 PERFORM PASS NC2174.2 +036000 GO TO STR-WRITE-GF-1-1 NC2174.2 +036100 ELSE NC2174.2 +036200 GO TO STR-FAIL-GF-1-1. NC2174.2 +036300 STR-DELETE-GF-1-1. NC2174.2 +036400 PERFORM DE-LETE. NC2174.2 +036500 GO TO STR-WRITE-GF-1-1. NC2174.2 +036600 STR-FAIL-GF-1-1. NC2174.2 +036700 PERFORM FAIL NC2174.2 +036800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +036900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +037000 STR-WRITE-GF-1-1. NC2174.2 +037100 PERFORM PRINT-DETAIL. NC2174.2 +037200* NC2174.2 +037300 STR-TEST-GF-1-2. NC2174.2 +037400 ADD 1 TO REC-CT. NC2174.2 +037500 IF ID8-DU-2V0 = 6 NC2174.2 +037600 PERFORM PASS NC2174.2 +037700 GO TO STR-WRITE-GF-1-2 NC2174.2 +037800 ELSE NC2174.2 +037900 GO TO STR-FAIL-GF-1-2. NC2174.2 +038000 STR-DELETE-GF-1-2. NC2174.2 +038100 PERFORM DE-LETE. NC2174.2 +038200 GO TO STR-WRITE-GF-1-2. NC2174.2 +038300 STR-FAIL-GF-1-2. NC2174.2 +038400 PERFORM FAIL NC2174.2 +038500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +038600 MOVE 6 TO CORRECT-N. NC2174.2 +038700 STR-WRITE-GF-1-2. NC2174.2 +038800 PERFORM PRINT-DETAIL. NC2174.2 +038900* NC2174.2 +039000 STR-INIT-GF-2. NC2174.2 +039100 MOVE "STR-TEST-GF-2" TO PAR-NAME. NC2174.2 +039200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +039300 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +039400 MOVE "*****" TO ID7-XN-5. NC2174.2 +039500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +039600 MOVE 1 TO REC-CT. NC2174.2 +039700 STR-TEST-GF-2-0. NC2174.2 +039800 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +039900 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +040000 ON OVERFLOW PERFORM PASS NC2174.2 +040100 GO TO STR-WRITE-GF-2-1. NC2174.2 +040200 GO TO STR-FAIL-GF-2-1. NC2174.2 +040300 STR-DELETE-GF-2. NC2174.2 +040400 PERFORM DE-LETE. NC2174.2 +040500 PERFORM PRINT-DETAIL. NC2174.2 +040600 GO TO STR-INIT-GF-3. NC2174.2 +040700 STR-TEST-GF-2-1. NC2174.2 +040800* THIS IS THE BLOCK TO WHICH CONTROL WILL BE SENT BY NC2174.2 +040900* PARAGRAPH "STR-TEST-GF-2-0". NC2174.2 +041000 STR-DELETE-GF-2-1. NC2174.2 +041100* GO TO STR-DELETE-GF-2. NC2174.2 +041200 STR-FAIL-GF-2-1. NC2174.2 +041300 PERFORM FAIL. NC2174.2 +041400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +041500 STR-WRITE-GF-2-1. NC2174.2 +041600 PERFORM PRINT-DETAIL. NC2174.2 +041700* NC2174.2 +041800 STR-TEST-GF-2-2. NC2174.2 +041900 ADD 1 TO REC-CT. NC2174.2 +042000 IF ID7-XN-5 = "ABCDE" NC2174.2 +042100 PERFORM PASS NC2174.2 +042200 GO TO STR-WRITE-GF-2-2 NC2174.2 +042300 ELSE NC2174.2 +042400 GO TO STR-FAIL-GF-2-2. NC2174.2 +042500 STR-DELETE-GF-2-2. NC2174.2 +042600 PERFORM DE-LETE. NC2174.2 +042700 GO TO STR-WRITE-GF-2-2. NC2174.2 +042800 STR-FAIL-GF-2-2. NC2174.2 +042900 PERFORM FAIL NC2174.2 +043000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +043100 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +043200 STR-WRITE-GF-2-2. NC2174.2 +043300 PERFORM PRINT-DETAIL. NC2174.2 +043400* NC2174.2 +043500 STR-TEST-GF-2-3. NC2174.2 +043600 ADD 1 TO REC-CT. NC2174.2 +043700 IF ID8-DU-2V0 = 6 NC2174.2 +043800 PERFORM PASS NC2174.2 +043900 GO TO STR-WRITE-GF-2-3 NC2174.2 +044000 ELSE NC2174.2 +044100 GO TO STR-FAIL-GF-2-3. NC2174.2 +044200 STR-DELETE-GF-2-3. NC2174.2 +044300 PERFORM DE-LETE. NC2174.2 +044400 GO TO STR-WRITE-GF-2-3. NC2174.2 +044500 STR-FAIL-GF-2-3. NC2174.2 +044600 PERFORM FAIL NC2174.2 +044700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +044800 MOVE 6 TO CORRECT-N. NC2174.2 +044900 STR-WRITE-GF-2-3. NC2174.2 +045000 PERFORM PRINT-DETAIL. NC2174.2 +045100* NC2174.2 +045200 STR-INIT-GF-3. NC2174.2 +045300 MOVE "STR-TEST-GF-3" TO PAR-NAME. NC2174.2 +045400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +045500 MOVE "ID DEL BY QUAL ID" TO FEATURE. NC2174.2 +045600 MOVE "*****" TO ID7-XN-5. NC2174.2 +045700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +045800 MOVE 5 TO ISUB-DU-2V0. NC2174.2 +045900 MOVE 1 TO REC-CT. NC2174.2 +046000* NC2174.2 +046100 STR-TEST-GF-3. NC2174.2 +046200 STRING ABCDEFG-XN-7 DELIMITED BY ID3-XN-1 (ISUB-DU-2V0) NC2174.2 +046300 INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +046400 GO TO STR-TEST-GF-3-1. NC2174.2 +046500 STR-DELETE-GF-3. NC2174.2 +046600 PERFORM DE-LETE. NC2174.2 +046700 PERFORM PRINT-DETAIL. NC2174.2 +046800 GO TO STRING-INIT-4. NC2174.2 +046900* NC2174.2 +047000 STR-TEST-GF-3-1. NC2174.2 +047100 IF ID7-XN-5 = "ABCDE" NC2174.2 +047200 PERFORM PASS NC2174.2 +047300 GO TO STR-WRITE-GF-3-1 NC2174.2 +047400 ELSE NC2174.2 +047500 GO TO STR-FAIL-GF-3-1. NC2174.2 +047600 STR-DELETE-GF-3-1. NC2174.2 +047700 PERFORM DE-LETE. NC2174.2 +047800 GO TO STR-WRITE-GF-3-1. NC2174.2 +047900 STR-FAIL-GF-3-1. NC2174.2 +048000 PERFORM FAIL NC2174.2 +048100 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +048200 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +048300 STR-WRITE-GF-3-1. NC2174.2 +048400 PERFORM PRINT-DETAIL. NC2174.2 +048500* NC2174.2 +048600 STR-TEST-GF-3-2. NC2174.2 +048700 ADD 1 TO REC-CT. NC2174.2 +048800 IF ID8-DU-2V0 = 6 NC2174.2 +048900 PERFORM PASS NC2174.2 +049000 GO TO STR-WRITE-GF-3-2 NC2174.2 +049100 ELSE NC2174.2 +049200 GO TO STR-FAIL-GF-3-2. NC2174.2 +049300 STR-DELETE-GF-3-2. NC2174.2 +049400 PERFORM DE-LETE. NC2174.2 +049500 GO TO STR-WRITE-GF-3-2. NC2174.2 +049600 STR-FAIL-GF-3-2. NC2174.2 +049700 PERFORM FAIL NC2174.2 +049800 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +049900 MOVE 6 TO CORRECT-N. NC2174.2 +050000 STR-WRITE-GF-3-2. NC2174.2 +050100 PERFORM PRINT-DETAIL. NC2174.2 +050200* NC2174.2 +050300 STRING-INIT-4. NC2174.2 +050400 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2174.2 +050500 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +050600 MOVE "SUBSCRIPTED IDS" TO FEATURE. NC2174.2 +050700 MOVE "*****" TO ID7-XN-5. NC2174.2 +050800 MOVE 1 TO ID8-DU-2V0. NC2174.2 +050900 MOVE ZERO TO REC-CT. NC2174.2 +051000 MOVE "**** " TO P-OR-F. NC2174.2 +051100* NC2174.2 +051200 STRING-TEST-4. NC2174.2 +051300* STRING ID1-1 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051400* ID1-2 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051500* ID1-3 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051600* ID1-4 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051700* ID1-5 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051800* DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +051900* POINTER ID8-DU-2V0. NC2174.2 +052000* GO TO STRING-TEST-4-1. NC2174.2 +052100 STRING-DELETE-4. NC2174.2 +052200 PERFORM DE-LETE. NC2174.2 +052300 MOVE "*DELETED - ANSC INTERPRETATION*" TO RE-MARK. NC2174.2 +052400 PERFORM PRINT-DETAIL. NC2174.2 +052500 GO TO STR-INIT-GF-5. NC2174.2 +052600 STRING-TEST-4-1. NC2174.2 +052700 IF ID7-XN-5 = "ABCDE" NC2174.2 +052800 PERFORM PASS NC2174.2 +052900 PERFORM PRINT-DETAIL NC2174.2 +053000 ELSE NC2174.2 +053100 PERFORM FAIL NC2174.2 +053200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +053300 MOVE "ABCDE" TO CORRECT-A NC2174.2 +053400 PERFORM PRINT-DETAIL. NC2174.2 +053500 ADD 1 TO REC-CT. NC2174.2 +053600 STRING-TEST-4-2. NC2174.2 +053700 IF ID8-DU-2V0 = 6 NC2174.2 +053800 PERFORM PASS NC2174.2 +053900 PERFORM PRINT-DETAIL NC2174.2 +054000 ELSE NC2174.2 +054100 PERFORM FAIL NC2174.2 +054200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +054300 MOVE 6 TO CORRECT-N NC2174.2 +054400 PERFORM PRINT-DETAIL. NC2174.2 +054500* NC2174.2 +054600 STR-INIT-GF-5. NC2174.2 +054700 MOVE "STR-TEST-GF-5" TO PAR-NAME. NC2174.2 +054800 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +054900 MOVE "IMMEDIATE OVERFLOW" TO FEATURE. NC2174.2 +055000 MOVE "*****" TO ID7-XN-5. NC2174.2 +055100 MOVE "*****" TO ASTER-XN-5. NC2174.2 +055200* NOTE THAT THE POINTER IS SET TO A VALUE GREATER THAN NC2174.2 +055300* THE LENGTH OF THE RECEIVING ITEM ID7-XN-5.......... NC2174.2 +055400 MOVE 7 TO ID8-DU-2V0. NC2174.2 +055500 MOVE 1 TO REC-CT. NC2174.2 +055600* NC2174.2 +055700 STR-TEST-GF-5-1. NC2174.2 +055800 STRING "ABCDE" DELIMITED BY ABCDEFG-XN-7 INTO ID7-XN-5 NC2174.2 +055900 POINTER ID8-DU-2V0 NC2174.2 +056000 ON OVERFLOW PERFORM PASS NC2174.2 +056100 GO TO STR-WRITE-GF-5-1. NC2174.2 +056200 GO TO STR-FAIL-GF-5-1. NC2174.2 +056300 STR-DELETE-GF-5-1. NC2174.2 +056400 PERFORM DE-LETE. NC2174.2 +056500 PERFORM PRINT-DETAIL. NC2174.2 +056600 GO TO STR-INIT-GF-6. NC2174.2 +056700 STR-FAIL-GF-5-1. NC2174.2 +056800 PERFORM FAIL. NC2174.2 +056900 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +057000 STR-WRITE-GF-5-1. NC2174.2 +057100 PERFORM PRINT-DETAIL. NC2174.2 +057200* NC2174.2 +057300 STR-TEST-GF-5-2. NC2174.2 +057400 ADD 1 TO REC-CT. NC2174.2 +057500 IF ID7-XN-5 = ASTER-XN-5 NC2174.2 +057600 PERFORM PASS NC2174.2 +057700 GO TO STR-WRITE-GF-5-2 NC2174.2 +057800 ELSE NC2174.2 +057900 GO TO STR-FAIL-GF-5-2. NC2174.2 +058000 STR-DELETE-GF-5-2. NC2174.2 +058100 PERFORM DE-LETE. NC2174.2 +058200 GO TO STR-WRITE-GF-5-2. NC2174.2 +058300 STR-FAIL-GF-5-2. NC2174.2 +058400 PERFORM FAIL NC2174.2 +058500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +058600 MOVE "*****" TO CORRECT-A. NC2174.2 +058700 STR-WRITE-GF-5-2. NC2174.2 +058800 PERFORM PRINT-DETAIL. NC2174.2 +058900* NC2174.2 +059000 STR-TEST-GF-5-3. NC2174.2 +059100 ADD 1 TO REC-CT. NC2174.2 +059200 IF ID8-DU-2V0 = 7 NC2174.2 +059300 PERFORM PASS NC2174.2 +059400 GO TO STR-WRITE-GF-5-3 NC2174.2 +059500 ELSE NC2174.2 +059600 GO TO STR-FAIL-GF-5-3. NC2174.2 +059700 STR-DELETE-GF-5-3. NC2174.2 +059800 PERFORM DE-LETE. NC2174.2 +059900 GO TO STR-WRITE-GF-5-3. NC2174.2 +060000 STR-FAIL-GF-5-3. NC2174.2 +060100 PERFORM FAIL NC2174.2 +060200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +060300 MOVE 7 TO CORRECT-N. NC2174.2 +060400 STR-WRITE-GF-5-3. NC2174.2 +060500 PERFORM PRINT-DETAIL. NC2174.2 +060600* NC2174.2 +060700 STR-INIT-GF-6. NC2174.2 +060800 MOVE "STR-TEST-GF-6" TO PAR-NAME. NC2174.2 +060900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +061000 MOVE "SPACE LIT OVERFLOWS" TO FEATURE. NC2174.2 +061100 MOVE "*****" TO ID7-XN-5. NC2174.2 +061200 MOVE 1 TO ID8-DU-2V0. NC2174.2 +061300 MOVE 1 TO REC-CT. NC2174.2 +061400* NC2174.2 +061500 STR-TEST-GF-6-1. NC2174.2 +061600 STRING SPACE "ABCDE" DELIMITED BY " ABCDE" NC2174.2 +061700 INTO ID7-XN-5 OVERFLOW PERFORM PASS NC2174.2 +061800 GO TO STR-WRITE-GF-6-1. NC2174.2 +061900 GO TO STR-FAIL-GF-6-1. NC2174.2 +062000 STR-DELETE-GF-6-1. NC2174.2 +062100 PERFORM DE-LETE. NC2174.2 +062200 PERFORM PRINT-DETAIL. NC2174.2 +062300 GO TO STR-INIT-GF-7. NC2174.2 +062400 STR-FAIL-GF-6-1. NC2174.2 +062500 PERFORM FAIL. NC2174.2 +062600 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +062700 STR-WRITE-GF-6-1. NC2174.2 +062800 PERFORM PRINT-DETAIL. NC2174.2 +062900* NC2174.2 +063000 STR-TEST-GF-6-2. NC2174.2 +063100 ADD 1 TO REC-CT. NC2174.2 +063200 IF ID7-XN-5 = " ABCD" NC2174.2 +063300 PERFORM PASS NC2174.2 +063400 GO TO STR-WRITE-GF-6-2 NC2174.2 +063500 ELSE NC2174.2 +063600 GO TO STR-FAIL-GF-6-2. NC2174.2 +063700 STR-DELETE-GF-6-2. NC2174.2 +063800 PERFORM DE-LETE. NC2174.2 +063900 GO TO STR-WRITE-GF-6-2. NC2174.2 +064000 STR-FAIL-GF-6-2. NC2174.2 +064100 PERFORM FAIL NC2174.2 +064200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +064300 MOVE " ABCD" TO CORRECT-A. NC2174.2 +064400 STR-WRITE-GF-6-2. NC2174.2 +064500 PERFORM PRINT-DETAIL. NC2174.2 +064600* NC2174.2 +064700 STR-INIT-GF-7. NC2174.2 +064800 MOVE "STR-TEST-GF-7" TO PAR-NAME. NC2174.2 +064900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +065000 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +065100 MOVE "*****" TO ID7-XN-5. NC2174.2 +065200 MOVE 1 TO ID8-DU-2V0. NC2174.2 +065300 MOVE 1 TO REC-CT. NC2174.2 +065400* NC2174.2 +065500 STR-TEST-GF-7-1. NC2174.2 +065600 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +065700 POINTER ID8-DU-2V0 OVERFLOW GO TO STR-FAIL-GF-7-1. NC2174.2 +065800 PERFORM PASS. NC2174.2 +065900 GO TO STR-WRITE-GF-7-1. NC2174.2 +066000 STR-DELETE-GF-7-1. NC2174.2 +066100 PERFORM DE-LETE. NC2174.2 +066200 PERFORM PRINT-DETAIL. NC2174.2 +066300 GO TO STR-INIT-GF-8. NC2174.2 +066400 STR-FAIL-GF-7-1. NC2174.2 +066500 PERFORM FAIL. NC2174.2 +066600 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +066700 STR-WRITE-GF-7-1. NC2174.2 +066800 PERFORM PRINT-DETAIL. NC2174.2 +066900* NC2174.2 +067000 STR-TEST-GF-7-2. NC2174.2 +067100 ADD 1 TO REC-CT. NC2174.2 +067200 IF ID7-XN-5 = "ABCDE" NC2174.2 +067300 PERFORM PASS NC2174.2 +067400 GO TO STR-WRITE-GF-7-2 NC2174.2 +067500 ELSE NC2174.2 +067600 GO TO STR-FAIL-GF-7-2. NC2174.2 +067700 STR-DELETE-GF-7-2. NC2174.2 +067800 PERFORM DE-LETE. NC2174.2 +067900 GO TO STR-WRITE-GF-7-2. NC2174.2 +068000 STR-FAIL-GF-7-2. NC2174.2 +068100 PERFORM FAIL NC2174.2 +068200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +068300 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +068400 STR-WRITE-GF-7-2. NC2174.2 +068500 PERFORM PRINT-DETAIL. NC2174.2 +068600* NC2174.2 +068700 STR-TEST-GF-7-3. NC2174.2 +068800 ADD 1 TO REC-CT. NC2174.2 +068900 IF ID8-DU-2V0 = 6 NC2174.2 +069000 PERFORM PASS NC2174.2 +069100 GO TO STR-WRITE-GF-7-3 NC2174.2 +069200 ELSE NC2174.2 +069300 GO TO STR-FAIL-GF-7-3. NC2174.2 +069400 STR-DELETE-GF-7-3. NC2174.2 +069500 PERFORM DE-LETE. NC2174.2 +069600 GO TO STR-WRITE-GF-7-3. NC2174.2 +069700 STR-FAIL-GF-7-3. NC2174.2 +069800 PERFORM FAIL NC2174.2 +069900 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +070000 MOVE 6 TO CORRECT-N. NC2174.2 +070100 STR-WRITE-GF-7-3. NC2174.2 +070200 PERFORM PRINT-DETAIL. NC2174.2 +070300* NC2174.2 +070400 STR-INIT-GF-8. NC2174.2 +070500 MOVE "STR-TEST-GF-8" TO PAR-NAME. NC2174.2 +070600 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +070700 MOVE "LOW-VALUE OVERFLOW" TO FEATURE. NC2174.2 +070800 MOVE "*****" TO ID7-XN-5. NC2174.2 +070900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +071000 MOVE 1 TO REC-CT. NC2174.2 +071100* NC2174.2 +071200 STR-TEST-GF-8-1. NC2174.2 +071300 STRING LOW-VALUE "ABCDE" DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +071400 WITH POINTER ID8-DU-2V0 NC2174.2 +071500 ON OVERFLOW PERFORM PASS NC2174.2 +071600 GO TO STR-WRITE-GF-8-1. NC2174.2 +071700 GO TO STR-FAIL-GF-8-1. NC2174.2 +071800 STR-DELETE-GF-8-1. NC2174.2 +071900 PERFORM DE-LETE. NC2174.2 +072000 PERFORM PRINT-DETAIL. NC2174.2 +072100 GO TO STR-INIT-GF-9. NC2174.2 +072200 STR-FAIL-GF-8-1. NC2174.2 +072300 PERFORM FAIL. NC2174.2 +072400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +072500 STR-WRITE-GF-8-1. NC2174.2 +072600 PERFORM PRINT-DETAIL. NC2174.2 +072700* NC2174.2 +072800 STR-TEST-GF-8-2. NC2174.2 +072900 ADD 1 TO REC-CT. NC2174.2 +073000 IF ID7-XN-5 = ANS-XN-5-1 NC2174.2 +073100 PERFORM PASS NC2174.2 +073200 GO TO STR-WRITE-GF-8-2 NC2174.2 +073300 ELSE NC2174.2 +073400 GO TO STR-FAIL-GF-8-2. NC2174.2 +073500 STR-DELETE-GF-8-2. NC2174.2 +073600 PERFORM DE-LETE. NC2174.2 +073700 GO TO STR-WRITE-GF-8-2. NC2174.2 +073800 STR-FAIL-GF-8-2. NC2174.2 +073900 PERFORM FAIL NC2174.2 +074000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +074100 MOVE ANS-XN-5-1 TO CORRECT-A. NC2174.2 +074200 STR-WRITE-GF-8-2. NC2174.2 +074300 PERFORM PRINT-DETAIL. NC2174.2 +074400* NC2174.2 +074500 STR-TEST-GF-8-3. NC2174.2 +074600 ADD 1 TO REC-CT. NC2174.2 +074700 IF ID8-DU-2V0 = 6 NC2174.2 +074800 PERFORM PASS NC2174.2 +074900 GO TO STR-WRITE-GF-8-3 NC2174.2 +075000 ELSE NC2174.2 +075100 GO TO STR-FAIL-GF-8-3. NC2174.2 +075200 STR-DELETE-GF-8-3. NC2174.2 +075300 PERFORM DE-LETE. NC2174.2 +075400 GO TO STR-WRITE-GF-8-3. NC2174.2 +075500 STR-FAIL-GF-8-3. NC2174.2 +075600 PERFORM FAIL NC2174.2 +075700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +075800 MOVE 6 TO CORRECT-N. NC2174.2 +075900 STR-WRITE-GF-8-3. NC2174.2 +076000 PERFORM PRINT-DETAIL. NC2174.2 +076100* NC2174.2 +076200 STR-INIT-GF-9. NC2174.2 +076300 MOVE "STR-TEST-GF-9" TO PAR-NAME. NC2174.2 +076400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +076500 MOVE "HIGH-VALUE DEL SIZE" TO FEATURE. NC2174.2 +076600 MOVE "*****" TO ID7-XN-5. NC2174.2 +076700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +076800 MOVE 1 TO REC-CT. NC2174.2 +076900* NC2174.2 +077000 STR-TEST-GF-9-1. NC2174.2 +077100 STRING HIGH-VALUE DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +077200 POINTER ID8-DU-2V0 NC2174.2 +077300 OVERFLOW GO TO STR-FAIL-GF-9-1. NC2174.2 +077400 PERFORM PASS. NC2174.2 +077500 GO TO STR-WRITE-GF-9-1. NC2174.2 +077600 STR-DELETE-GF-9-1. NC2174.2 +077700 PERFORM DE-LETE. NC2174.2 +077800 PERFORM PRINT-DETAIL. NC2174.2 +077900 GO TO STR-INIT-GF-10. NC2174.2 +078000 STR-FAIL-GF-9-1. NC2174.2 +078100 PERFORM FAIL. NC2174.2 +078200 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +078300 STR-WRITE-GF-9-1. NC2174.2 +078400 PERFORM PRINT-DETAIL. NC2174.2 +078500* NC2174.2 +078600 STR-TEST-GF-9-2. NC2174.2 +078700 ADD 1 TO REC-CT. NC2174.2 +078800 IF ID7-XN-5 = ANS-XN-5-2 NC2174.2 +078900 PERFORM PASS NC2174.2 +079000 GO TO STR-WRITE-GF-9-2 NC2174.2 +079100 ELSE NC2174.2 +079200 GO TO STR-FAIL-GF-9-2. NC2174.2 +079300 STR-DELETE-GF-9-2. NC2174.2 +079400 PERFORM DE-LETE. NC2174.2 +079500 GO TO STR-WRITE-GF-9-2. NC2174.2 +079600 STR-FAIL-GF-9-2. NC2174.2 +079700 PERFORM FAIL NC2174.2 +079800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +079900 MOVE ANS-XN-5-2 TO CORRECT-A. NC2174.2 +080000 STR-WRITE-GF-9-2. NC2174.2 +080100 PERFORM PRINT-DETAIL. NC2174.2 +080200* NC2174.2 +080300 STR-TEST-GF-9-3. NC2174.2 +080400 ADD 1 TO REC-CT. NC2174.2 +080500 IF ID8-DU-2V0 = 2 NC2174.2 +080600 PERFORM PASS NC2174.2 +080700 GO TO STR-WRITE-GF-9-3 NC2174.2 +080800 ELSE NC2174.2 +080900 GO TO STR-FAIL-GF-9-3. NC2174.2 +081000 STR-DELETE-GF-9-3. NC2174.2 +081100 PERFORM DE-LETE. NC2174.2 +081200 GO TO STR-WRITE-GF-9-3. NC2174.2 +081300 STR-FAIL-GF-9-3. NC2174.2 +081400 PERFORM FAIL NC2174.2 +081500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +081600 MOVE 2 TO CORRECT-N. NC2174.2 +081700 STR-WRITE-GF-9-3. NC2174.2 +081800 PERFORM PRINT-DETAIL. NC2174.2 +081900* NC2174.2 +082000 STR-INIT-GF-10. NC2174.2 +082100 MOVE "STR-TEST-GF-10" TO PAR-NAME. NC2174.2 +082200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +082300 MOVE "LIT DEL ZERO" TO FEATURE. NC2174.2 +082400 MOVE "*****" TO ID7-XN-5. NC2174.2 +082500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +082600 MOVE 1 TO REC-CT. NC2174.2 +082700* NC2174.2 +082800 STR-TEST-GF-10-0. NC2174.2 +082900 STRING "A0" "B0D" "C0LKJSD" "D0321" "E0987LKJALKJKLLKJSD" NC2174.2 +083000 DELIMITED BY ZERO INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +083100 GO TO STR-TEST-GF-10-1. NC2174.2 +083200 STR-DELETE-GF-10. NC2174.2 +083300 PERFORM DE-LETE. NC2174.2 +083400 PERFORM PRINT-DETAIL. NC2174.2 +083500 GO TO STR-INIT-GF-11. NC2174.2 +083600* NC2174.2 +083700 STR-TEST-GF-10-1. NC2174.2 +083800 IF ID7-XN-5 = "ABCDE" NC2174.2 +083900 PERFORM PASS NC2174.2 +084000 GO TO STR-WRITE-GF-10-1 NC2174.2 +084100 ELSE NC2174.2 +084200 GO TO STR-FAIL-GF-10-1. NC2174.2 +084300 STR-DELETE-GF-10-1. NC2174.2 +084400 PERFORM DE-LETE. NC2174.2 +084500 GO TO STR-WRITE-GF-10-1. NC2174.2 +084600 STR-FAIL-GF-10-1. NC2174.2 +084700 PERFORM FAIL NC2174.2 +084800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +084900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +085000 STR-WRITE-GF-10-1. NC2174.2 +085100 PERFORM PRINT-DETAIL. NC2174.2 +085200* NC2174.2 +085300 STR-TEST-GF-10-2. NC2174.2 +085400 ADD 1 TO REC-CT. NC2174.2 +085500 IF ID8-DU-2V0 = 6 NC2174.2 +085600 PERFORM PASS NC2174.2 +085700 GO TO STR-WRITE-GF-10-2 NC2174.2 +085800 ELSE NC2174.2 +085900 GO TO STR-FAIL-GF-10-2. NC2174.2 +086000 STR-DELETE-GF-10-2. NC2174.2 +086100 PERFORM DE-LETE. NC2174.2 +086200 GO TO STR-WRITE-GF-10-2. NC2174.2 +086300 STR-FAIL-GF-10-2. NC2174.2 +086400 PERFORM FAIL NC2174.2 +086500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +086600 MOVE 6 TO CORRECT-N. NC2174.2 +086700 STR-WRITE-GF-10-2. NC2174.2 +086800 PERFORM PRINT-DETAIL. NC2174.2 +086900* NC2174.2 +087000 STR-INIT-GF-11. NC2174.2 +087100 MOVE "STR-TEST-GF-11" TO PAR-NAME. NC2174.2 +087200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +087300 MOVE "LIT DEL BY QUOTE" TO FEATURE. NC2174.2 +087400 MOVE "*****" TO ID7-XN-5. NC2174.2 +087500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +087600 MOVE 1 TO REC-CT. NC2174.2 +087700* NC2174.2 +087800 STR-TEST-GF-11. NC2174.2 +087900 STRING "A""" "B""KJHSF" "C""321654987LLKJHAF" "D""=,l." NC2174.2 +088000 "E""********" DELIMITED BY QUOTE INTO ID7-XN-5 NC2174.2 +088100 POINTER ID8-DU-2V0. NC2174.2 +088200 GO TO STR-TEST-GF-11-1. NC2174.2 +088300 STR-DELETE-GF-11-0. NC2174.2 +088400 PERFORM DE-LETE. NC2174.2 +088500 PERFORM PRINT-DETAIL. NC2174.2 +088600 GO TO STR-INIT-GF-12. NC2174.2 +088700* NC2174.2 +088800 STR-TEST-GF-11-1. NC2174.2 +088900 IF ID7-XN-5 = "ABCDE" NC2174.2 +089000 PERFORM PASS NC2174.2 +089100 GO TO STR-WRITE-GF-11-1 NC2174.2 +089200 ELSE NC2174.2 +089300 GO TO STR-FAIL-GF-11-1. NC2174.2 +089400 STR-DELETE-GF-11-1. NC2174.2 +089500 PERFORM DE-LETE. NC2174.2 +089600 GO TO STR-WRITE-GF-11-1. NC2174.2 +089700 STR-FAIL-GF-11-1. NC2174.2 +089800 PERFORM FAIL NC2174.2 +089900 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +090000 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +090100 STR-WRITE-GF-11-1. NC2174.2 +090200 PERFORM PRINT-DETAIL. NC2174.2 +090300 ADD 1 TO REC-CT. NC2174.2 +090400* NC2174.2 +090500 STR-TEST-GF-11-2. NC2174.2 +090600 IF ID8-DU-2V0 = 6 NC2174.2 +090700 PERFORM PASS NC2174.2 +090800 GO TO STR-WRITE-GF-11-2 NC2174.2 +090900 ELSE NC2174.2 +091000 GO TO STR-FAIL-GF-11-2. NC2174.2 +091100 STR-DELETE-GF-11-2. NC2174.2 +091200 PERFORM DE-LETE. NC2174.2 +091300 GO TO STR-WRITE-GF-11-2. NC2174.2 +091400 STR-FAIL-GF-11-2. NC2174.2 +091500 PERFORM FAIL NC2174.2 +091600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +091700 MOVE 6 TO CORRECT-N. NC2174.2 +091800 STR-WRITE-GF-11-2. NC2174.2 +091900 PERFORM PRINT-DETAIL. NC2174.2 +092000* NC2174.2 +092100 STR-INIT-GF-12. NC2174.2 +092200 MOVE "STR-TEST-GF-12" TO PAR-NAME. NC2174.2 +092300 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +092400 MOVE "ZERO ID DEL SIZE" TO FEATURE. NC2174.2 +092500 MOVE 0 TO REC-CT. NC2174.2 +092600 MOVE ALL "*" TO ID7-XN-15. NC2174.2 +092700* NC2174.2 +092800 STR-TEST-GF-12-1. NC2174.2 +092900 STRING ZERO ABCDEFG-XN-7 DELIMITED BY SIZE ZERO ABCDEFG-XN-7NC2174.2 +093000 DELIMITED BY SIZE INTO ID7-XN-15. NC2174.2 +093100 IF ID7-XN-15 = "0ABCDEFG0ABCDEF" NC2174.2 +093200 PERFORM PASS NC2174.2 +093300 GO TO STR-WRITE-GF-12-1 NC2174.2 +093400 ELSE NC2174.2 +093500 GO TO STR-FAIL-GF-12-1. NC2174.2 +093600 STR-DELETE-GF-12-1. NC2174.2 +093700 PERFORM DE-LETE. NC2174.2 +093800 GO TO STR-WRITE-GF-12-1. NC2174.2 +093900 STR-FAIL-GF-12-1. NC2174.2 +094000 PERFORM FAIL NC2174.2 +094100 MOVE ID7-XN-15 TO COMPUTED-A NC2174.2 +094200 MOVE "0ABCDEFG0ABCDEF" TO CORRECT-A. NC2174.2 +094300 STR-WRITE-GF-12-1. NC2174.2 +094400 PERFORM PRINT-DETAIL. NC2174.2 +094500* NC2174.2 +094600 STR-INIT-GF-13. NC2174.2 +094700 MOVE "STR-TEST-GF-13" TO PAR-NAME. NC2174.2 +094800 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +094900 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +095000 MOVE "*****" TO ID7-XN-5. NC2174.2 +095100* NC2174.2 +095200 STR-TEST-GF-13. NC2174.2 +095300 STRING "A" "B" "C" DELIMITED BY SIZE "D" "E" "F" DELIMITED NC2174.2 +095400 BY SIZE INTO ID7-XN-5. NC2174.2 +095500 IF ID7-XN-5 = "ABCDE" NC2174.2 +095600 PERFORM PASS NC2174.2 +095700 GO TO STR-WRITE-GF-13 NC2174.2 +095800 ELSE NC2174.2 +095900 GO TO STR-FAIL-GF-13. NC2174.2 +096000 STR-DELETE-GF-13. NC2174.2 +096100 PERFORM DE-LETE. NC2174.2 +096200 GO TO STR-WRITE-GF-13. NC2174.2 +096300 STR-FAIL-GF-13. NC2174.2 +096400 PERFORM FAIL NC2174.2 +096500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +096600 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +096700 STR-WRITE-GF-13. NC2174.2 +096800 PERFORM PRINT-DETAIL. NC2174.2 +096900* NC2174.2 +097000 STR-INIT-GF-14. NC2174.2 +097100 MOVE "STR-TEST-GF-14" TO PAR-NAME. NC2174.2 +097200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +097300 MOVE "IDENTIFIER SERIES" TO FEATURE. NC2174.2 +097400 MOVE "*****" TO ID7-XN-5. NC2174.2 +097500* NC2174.2 +097600 STR-TEST-GF-14. NC2174.2 +097700 STRING AB-XN-2 AB-XN-2 AB-XN-2 DELIMITED BY B-XN-1 NC2174.2 +097800 AB-XN-2 AB-XN-2 DELIMITED BY B-XN-1 INTO ID7-XN-5. NC2174.2 +097900 IF ID7-XN-5 = "AAAAA" NC2174.2 +098000 PERFORM PASS NC2174.2 +098100 GO TO STR-WRITE-GF-14 NC2174.2 +098200 ELSE NC2174.2 +098300 GO TO STR-FAIL-GF-14. NC2174.2 +098400 STR-DELETE-GF-14. NC2174.2 +098500 PERFORM DE-LETE. NC2174.2 +098600 GO TO STR-WRITE-GF-14. NC2174.2 +098700 STR-FAIL-GF-14. NC2174.2 +098800 PERFORM FAIL NC2174.2 +098900 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +099000 MOVE "AAAAA" TO CORRECT-A. NC2174.2 +099100 STR-WRITE-GF-14. NC2174.2 +099200 PERFORM PRINT-DETAIL. NC2174.2 +099300* NC2174.2 +099400 STR-INIT-GF-15. NC2174.2 +099500 MOVE "STR-TEST-GF-15" TO PAR-NAME. NC2174.2 +099600 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +099700 MOVE "SIGN LEADING" TO FEATURE. NC2174.2 +099800 MOVE "*****" TO ID7-XN-5. NC2174.2 +099900 MOVE +1001 TO ID1-DS-LS-4. NC2174.2 +100000 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +100100 MOVE 1 TO ID8-DU-2V0. NC2174.2 +100200 MOVE 1 TO REC-CT. NC2174.2 +100300* NC2174.2 +100400 STR-TEST-GF-15-0. NC2174.2 +100500 STRING ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 SPACE DELIMITED NC2174.2 +100600 BY SIZE ID1-DS-LS-4 DELIMITED "0" INTO NC2174.2 +100700 ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +100800 GO TO STR-TEST-GF-15-1. NC2174.2 +100900 STR-DELETE-GF-15. NC2174.2 +101000 PERFORM DE-LETE. NC2174.2 +101100 PERFORM PRINT-DETAIL. NC2174.2 +101200 GO TO STR-INIT-GF-16. NC2174.2 +101300* NC2174.2 +101400 STR-TEST-GF-15-1. NC2174.2 +101500 IF ID7-XN-5 = "+1 +1" NC2174.2 +101600 PERFORM PASS NC2174.2 +101700 GO TO STR-WRITE-GF-15-1 NC2174.2 +101800 ELSE NC2174.2 +101900 GO TO STR-FAIL-GF-15-1. NC2174.2 +102000 STR-DELETE-GF-15-1. NC2174.2 +102100 PERFORM DE-LETE. NC2174.2 +102200 GO TO STR-WRITE-GF-15-1. NC2174.2 +102300 STR-FAIL-GF-15-1. NC2174.2 +102400 PERFORM FAIL NC2174.2 +102500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +102600 MOVE "+1 +1" TO CORRECT-A. NC2174.2 +102700 STR-WRITE-GF-15-1. NC2174.2 +102800 PERFORM PRINT-DETAIL. NC2174.2 +102900* NC2174.2 +103000 STR-TEST-GF-15-2. NC2174.2 +103100 ADD 1 TO REC-CT. NC2174.2 +103200 IF ID8-DU-2V0 = 6 NC2174.2 +103300 PERFORM PASS NC2174.2 +103400 GO TO STR-WRITE-GF-15-2 NC2174.2 +103500 ELSE NC2174.2 +103600 GO TO STR-FAIL-GF-15-2. NC2174.2 +103700 STR-DELETE-GF-15-2. NC2174.2 +103800 PERFORM DE-LETE. NC2174.2 +103900 GO TO STR-WRITE-GF-15-2. NC2174.2 +104000 STR-FAIL-GF-15-2. NC2174.2 +104100 PERFORM FAIL NC2174.2 +104200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +104300 MOVE 6 TO CORRECT-N. NC2174.2 +104400 STR-WRITE-GF-15-2. NC2174.2 +104500 PERFORM PRINT-DETAIL. NC2174.2 +104600* NC2174.2 +104700 STR-INIT-GF-16. NC2174.2 +104800 MOVE "STR-TEST-GF-16" TO PAR-NAME. NC2174.2 +104900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +105000 MOVE "SIGN LEADING" TO FEATURE. NC2174.2 +105100 MOVE "*****" TO ID7-XN-5. NC2174.2 +105200 MOVE +1001 TO ID1-DS-LS-4. NC2174.2 +105300 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +105400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +105500 MOVE 1 TO REC-CT. NC2174.2 +105600* NC2174.2 +105700 STR-TEST-GF-16-0. NC2174.2 +105800 STRING ID1-DS-LS-4 DELIMITED "0" " " DELIMITED BY SIZE NC2174.2 +105900 ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 INTO ID7-XN-5 NC2174.2 +106000 POINTER ID8-DU-2V0. NC2174.2 +106100 GO TO STR-TEST-GF-16-1. NC2174.2 +106200 STR-DELETE-GF-16. NC2174.2 +106300 PERFORM DE-LETE. NC2174.2 +106400 PERFORM PRINT-DETAIL. NC2174.2 +106500 GO TO STR-INIT-GF-17. NC2174.2 +106600* NC2174.2 +106700 STR-TEST-GF-16-1. NC2174.2 +106800 IF ID7-XN-5 = "+1 +1" NC2174.2 +106900 PERFORM PASS NC2174.2 +107000 GO TO STR-WRITE-GF-16-1 NC2174.2 +107100 ELSE NC2174.2 +107200 GO TO STR-FAIL-GF-16-1. NC2174.2 +107300 STR-DELETE-GF-16-1. NC2174.2 +107400 PERFORM DE-LETE. NC2174.2 +107500 GO TO STR-WRITE-GF-16-1. NC2174.2 +107600 STR-FAIL-GF-16-1. NC2174.2 +107700 PERFORM FAIL NC2174.2 +107800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +107900 MOVE "+1 +1" TO CORRECT-A. NC2174.2 +108000 STR-WRITE-GF-16-1. NC2174.2 +108100 PERFORM PRINT-DETAIL. NC2174.2 +108200* NC2174.2 +108300 STR-TEST-GF-16-2. NC2174.2 +108400 ADD 1 TO REC-CT. NC2174.2 +108500 IF ID8-DU-2V0 = 6 NC2174.2 +108600 PERFORM PASS NC2174.2 +108700 GO TO STR-WRITE-GF-16-2 NC2174.2 +108800 ELSE NC2174.2 +108900 GO TO STR-FAIL-GF-16-2. NC2174.2 +109000 STR-DELETE-GF-16-2. NC2174.2 +109100 PERFORM DE-LETE. NC2174.2 +109200 GO TO STR-WRITE-GF-16-2. NC2174.2 +109300 STR-FAIL-GF-16-2. NC2174.2 +109400 PERFORM FAIL NC2174.2 +109500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +109600 MOVE 6 TO CORRECT-N. NC2174.2 +109700 STR-WRITE-GF-16-2. NC2174.2 +109800 PERFORM PRINT-DETAIL. NC2174.2 +109900* NC2174.2 +110000 STR-INIT-GF-17. NC2174.2 +110100 MOVE "STR-TEST-GF-17" TO PAR-NAME. NC2174.2 +110200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +110300 MOVE "SIGN TRAILING" TO FEATURE. NC2174.2 +110400 MOVE "*****" TO ID7-XN-5. NC2174.2 +110500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +110600 MOVE +1001 TO ID1-DS-TS-4. NC2174.2 +110700 MOVE 1 TO REC-CT. NC2174.2 +110800* NC2174.2 +110900 STR-TEST-GF-17-0. NC2174.2 +111000 STRING ID1-DS-TS-4 DELIMITED BY SIZE SPACE DELIMITED SIZE NC2174.2 +111100 ID1-DS-TS-4 DELIMITED BY SIZE NC2174.2 +111200 INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +111300 GO TO STR-TEST-GF-17-1. NC2174.2 +111400 STR-DELETE-GF-17. NC2174.2 +111500 PERFORM DE-LETE. NC2174.2 +111600 PERFORM PRINT-DETAIL. NC2174.2 +111700 GO TO STR-INIT-GF-18. NC2174.2 +111800* NC2174.2 +111900 STR-TEST-GF-17-1. NC2174.2 +112000 IF ID7-XN-5 = "1001+" NC2174.2 +112100 PERFORM PASS NC2174.2 +112200 GO TO STR-WRITE-GF-17-1 NC2174.2 +112300 ELSE NC2174.2 +112400 GO TO STR-FAIL-GF-17-1. NC2174.2 +112500 STR-DELETE-GF-17-1. NC2174.2 +112600 PERFORM DE-LETE. NC2174.2 +112700 GO TO STR-WRITE-GF-17-1. NC2174.2 +112800 STR-FAIL-GF-17-1. NC2174.2 +112900 PERFORM FAIL NC2174.2 +113000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +113100 MOVE "1001+" TO CORRECT-A. NC2174.2 +113200 STR-WRITE-GF-17-1. NC2174.2 +113300 PERFORM PRINT-DETAIL. NC2174.2 +113400* NC2174.2 +113500 STR-TEST-GF-17-2. NC2174.2 +113600 ADD 1 TO REC-CT. NC2174.2 +113700 IF ID8-DU-2V0 = 6 NC2174.2 +113800 PERFORM PASS NC2174.2 +113900 GO TO STR-WRITE-GF-17-2 NC2174.2 +114000 ELSE NC2174.2 +114100 GO TO STR-FAIL-GF-17-2. NC2174.2 +114200 STR-DELETE-GF-17-2. NC2174.2 +114300 PERFORM DE-LETE. NC2174.2 +114400 GO TO STR-WRITE-GF-17-2. NC2174.2 +114500 STR-FAIL-GF-17-2. NC2174.2 +114600 PERFORM FAIL NC2174.2 +114700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +114800 MOVE 6 TO CORRECT-N. NC2174.2 +114900 STR-WRITE-GF-17-2. NC2174.2 +115000 PERFORM PRINT-DETAIL. NC2174.2 +115100* NC2174.2 +115200 STR-INIT-GF-18. NC2174.2 +115300 MOVE "STR-TEST-GF-18" TO PAR-NAME. NC2174.2 +115400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +115500 MOVE "NEG LEADING SEPARATE" TO FEATURE. NC2174.2 +115600 MOVE -1001 TO ID1-DS-LS-4. NC2174.2 +115700 MOVE "*****" TO ID7-XN-5. NC2174.2 +115800 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +115900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +116000 MOVE 1 TO REC-CT. NC2174.2 +116100* NC2174.2 +116200 STR-TEST-GF-18-0. NC2174.2 +116300 STRING ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 SPACE DELIMITED NC2174.2 +116400 BY SIZE ID1-DS-LS-4 DELIMITED BY "0" INTO NC2174.2 +116500 ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +116600 GO TO STR-TEST-GF-18-1. NC2174.2 +116700 STR-DELETE-GF-18. NC2174.2 +116800 PERFORM DE-LETE. NC2174.2 +116900 PERFORM PRINT-DETAIL. NC2174.2 +117000 GO TO STR-INIT-GF-19. NC2174.2 +117100* NC2174.2 +117200 STR-TEST-GF-18-1. NC2174.2 +117300 IF ID7-XN-5 = "-1 -1" NC2174.2 +117400 PERFORM PASS NC2174.2 +117500 GO TO STR-WRITE-GF-18-1 NC2174.2 +117600 ELSE NC2174.2 +117700 GO TO STR-FAIL-GF-18-1. NC2174.2 +117800 STR-DELETE-GF-18-1. NC2174.2 +117900 PERFORM DE-LETE. NC2174.2 +118000 GO TO STR-WRITE-GF-18-1. NC2174.2 +118100 STR-FAIL-GF-18-1. NC2174.2 +118200 PERFORM FAIL NC2174.2 +118300 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +118400 MOVE "-1 -1" TO CORRECT-A. NC2174.2 +118500 STR-WRITE-GF-18-1. NC2174.2 +118600 PERFORM PRINT-DETAIL. NC2174.2 +118700* NC2174.2 +118800 STR-TEST-GF-18-2. NC2174.2 +118900 ADD 1 TO REC-CT. NC2174.2 +119000 IF ID8-DU-2V0 = 6 NC2174.2 +119100 PERFORM PASS NC2174.2 +119200 GO TO STR-WRITE-GF-18-2 NC2174.2 +119300 ELSE NC2174.2 +119400 GO TO STR-FAIL-GF-18-2. NC2174.2 +119500 STR-DELETE-GF-18-2. NC2174.2 +119600 PERFORM DE-LETE. NC2174.2 +119700 GO TO STR-WRITE-GF-18-2. NC2174.2 +119800 STR-FAIL-GF-18-2. NC2174.2 +119900 PERFORM FAIL NC2174.2 +120000 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +120100 MOVE 6 TO CORRECT-N. NC2174.2 +120200 STR-WRITE-GF-18-2. NC2174.2 +120300 PERFORM PRINT-DETAIL. NC2174.2 +120400* NC2174.2 +120500 STR-INIT-GF-19. NC2174.2 +120600 MOVE "STR-TEST-GF-19" TO PAR-NAME. NC2174.2 +120700 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +120800 MOVE "NEGATIVE SIGN TRAIL" TO FEATURE. NC2174.2 +120900 MOVE "*****" TO ID7-XN-5. NC2174.2 +121000 MOVE 1 TO ID8-DU-2V0. NC2174.2 +121100 MOVE -1001 TO ID1-DS-TS-4. NC2174.2 +121200 MOVE 1 TO REC-CT. NC2174.2 +121300* NC2174.2 +121400 STR-TEST-GF-19-0. NC2174.2 +121500 STRING ID1-DS-TS-4 DELIMITED BY SIZE SPACE DELIMITED SIZE NC2174.2 +121600 ID1-DS-TS-4 DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +121700 POINTER ID8-DU-2V0. NC2174.2 +121800 GO TO STR-TEST-GF-19-1. NC2174.2 +121900 STR-DELETE-GF-19. NC2174.2 +122000 PERFORM DE-LETE. NC2174.2 +122100 PERFORM PRINT-DETAIL. NC2174.2 +122200 GO TO STR-INIT-GF-20. NC2174.2 +122300* NC2174.2 +122400 STR-TEST-GF-19-1. NC2174.2 +122500 IF ID7-XN-5 = "1001-" NC2174.2 +122600 PERFORM PASS NC2174.2 +122700 GO TO STR-WRITE-GF-19-1 NC2174.2 +122800 ELSE NC2174.2 +122900 GO TO STR-FAIL-GF-19-1. NC2174.2 +123000 STR-DELETE-GF-19-1. NC2174.2 +123100 PERFORM DE-LETE. NC2174.2 +123200 GO TO STR-WRITE-GF-19-1. NC2174.2 +123300 STR-FAIL-GF-19-1. NC2174.2 +123400 PERFORM FAIL NC2174.2 +123500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +123600 MOVE "1001-" TO CORRECT-A. NC2174.2 +123700 STR-WRITE-GF-19-1. NC2174.2 +123800 PERFORM PRINT-DETAIL. NC2174.2 +123900* NC2174.2 +124000 STR-TEST-GF-19-2. NC2174.2 +124100 ADD 1 TO REC-CT. NC2174.2 +124200 IF ID8-DU-2V0 = 6 NC2174.2 +124300 PERFORM PASS NC2174.2 +124400 GO TO STR-WRITE-GF-19-2 NC2174.2 +124500 ELSE NC2174.2 +124600 GO TO STR-FAIL-GF-19-2. NC2174.2 +124700 STR-DELETE-GF-19-2. NC2174.2 +124800 PERFORM DE-LETE. NC2174.2 +124900 GO TO STR-WRITE-GF-19-2. NC2174.2 +125000 STR-FAIL-GF-19-2. NC2174.2 +125100 PERFORM FAIL NC2174.2 +125200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +125300 MOVE 6 TO CORRECT-N. NC2174.2 +125400 STR-WRITE-GF-19-2. NC2174.2 +125500 PERFORM PRINT-DETAIL. NC2174.2 +125600* NC2174.2 +125700 STR-INIT-GF-20. NC2174.2 +125800 MOVE "STR-TEST-GF-20" TO PAR-NAME. NC2174.2 +125900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +126000 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +126100 MOVE ALL "*" TO WISH-LIST-XN-37. NC2174.2 +126200 MOVE "GEE I WISH I WAS A FORTRAN PROGRAMMER" TO ANS-XN-37. NC2174.2 +126300 MOVE 1 TO MY-BOSS-DU-2V0. NC2174.2 +126400 MOVE 1 TO REC-CT. NC2174.2 +126500* NC2174.2 +126600 STR-TEST-GF-20-1. NC2174.2 +126700 STRING "GEE" SPACE "I WISH I" SPACES "WAS A FORTRAN" " " NC2174.2 +126800 "PROGRAMMER" NC2174.2 +126900 DELIMITED BY SIZE INTO WISH-LIST-XN-37 NC2174.2 +127000 WITH POINTER MY-BOSS-DU-2V0 NC2174.2 +127100 ON OVERFLOW GO TO STR-FAIL-GF-20-1. NC2174.2 +127200 PERFORM PASS. NC2174.2 +127300 GO TO STR-WRITE-GF-20-1. NC2174.2 +127400 STR-DELETE-GF-20. NC2174.2 +127500 PERFORM DE-LETE. NC2174.2 +127600 PERFORM PRINT-DETAIL. NC2174.2 +127700 GO TO STR-INIT-GF-21. NC2174.2 +127800 STR-FAIL-GF-20-1. NC2174.2 +127900 PERFORM FAIL. NC2174.2 +128000 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +128100 STR-WRITE-GF-20-1. NC2174.2 +128200 PERFORM PRINT-DETAIL. NC2174.2 +128300* NC2174.2 +128400 STR-TEST-GF-20-2. NC2174.2 +128500 MOVE "STR-TEST-GF-20" TO PAR-NAME. NC2174.2 +128600 MOVE 1 TO REC-CT. NC2174.2 +128700 IF WISH-LIST-XN-37 = ANS-XN-37 NC2174.2 +128800 PERFORM PASS NC2174.2 +128900 GO TO STR-WRITE-GF-20-2 NC2174.2 +129000 ELSE NC2174.2 +129100 GO TO STR-FAIL-GF-20-2. NC2174.2 +129200 STR-DELETE-GF-20-2. NC2174.2 +129300 PERFORM DE-LETE. NC2174.2 +129400 GO TO STR-WRITE-GF-20-2. NC2174.2 +129500 STR-FAIL-GF-20-2. NC2174.2 +129600 PERFORM FAIL NC2174.2 +129700 MOVE WISH-LIST-XN-37 TO COMPUTED-A NC2174.2 +129800 MOVE ANS-XN-37 TO CORRECT-A. NC2174.2 +129900 STR-WRITE-GF-20-2. NC2174.2 +130000 PERFORM PRINT-DETAIL. NC2174.2 +130100* NC2174.2 +130200 STR-TEST-GF-20-3. NC2174.2 +130300 ADD 1 TO REC-CT. NC2174.2 +130400 IF MY-BOSS-DU-2V0 = 38 NC2174.2 +130500 PERFORM PASS NC2174.2 +130600 GO TO STR-WRITE-GF-20-3 NC2174.2 +130700 ELSE NC2174.2 +130800 GO TO STR-FAIL-GF-20-3. NC2174.2 +130900 STR-DELETE-GF-20-3. NC2174.2 +131000 PERFORM DE-LETE. NC2174.2 +131100 GO TO STR-WRITE-GF-20-3. NC2174.2 +131200 STR-FAIL-GF-20-3. NC2174.2 +131300 PERFORM FAIL NC2174.2 +131400 MOVE MY-BOSS-DU-2V0 TO COMPUTED-N NC2174.2 +131500 MOVE 38 TO CORRECT-N. NC2174.2 +131600 STR-WRITE-GF-20-3. NC2174.2 +131700 PERFORM PRINT-DETAIL. NC2174.2 +131800* NC2174.2 +131900* NC2174.2 +132000 STR-INIT-GF-21. NC2174.2 +132100* ===--> INTO GROUP FIELD <--=== NC2174.2 +132200 MOVE "VI-130 6.24.3 GR4" TO ANSI-REFERENCE. NC2174.2 +132300 MOVE "STR-TEST-GF-21" TO PAR-NAME. NC2174.2 +132400 MOVE "LIT DEL BY SIZE" TO FEATURE. NC2174.2 +132500 MOVE "*****" TO ID7-XN-5. NC2174.2 +132600 MOVE 1 TO ID8-DU-2V0. NC2174.2 +132700 MOVE 1 TO REC-CT. NC2174.2 +132800* NC2174.2 +132900 STR-TEST-GF-21-0. NC2174.2 +133000 STRING "ABCDEF" DELIMITED BY SIZE INTO TEST-21-GROUP NC2174.2 +133100 WITH POINTER ID8-DU-2V0. NC2174.2 +133200 GO TO STR-TEST-GF-21-1. NC2174.2 +133300 STR-DELETE-GF-21. NC2174.2 +133400 PERFORM DE-LETE. NC2174.2 +133500 PERFORM PRINT-DETAIL. NC2174.2 +133600 GO TO STR-INIT-GF-22. NC2174.2 +133700* NC2174.2 +133800 STR-TEST-GF-21-1. NC2174.2 +133900 IF TEST-21-GROUP = "ABCDE" NC2174.2 +134000 PERFORM PASS NC2174.2 +134100 GO TO STR-WRITE-GF-21-1 NC2174.2 +134200 ELSE NC2174.2 +134300 GO TO STR-FAIL-GF-21-1. NC2174.2 +134400 STR-DELETE-GF-21-1. NC2174.2 +134500 PERFORM DE-LETE. NC2174.2 +134600 GO TO STR-WRITE-GF-21-1. NC2174.2 +134700 STR-FAIL-GF-21-1. NC2174.2 +134800 PERFORM FAIL NC2174.2 +134900 MOVE TEST-21-GROUP TO COMPUTED-A NC2174.2 +135000 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +135100 STR-WRITE-GF-21-1. NC2174.2 +135200 PERFORM PRINT-DETAIL. NC2174.2 +135300* NC2174.2 +135400 STR-TEST-GF-21-2. NC2174.2 +135500 ADD 1 TO REC-CT. NC2174.2 +135600 IF ID8-DU-2V0 = 6 NC2174.2 +135700 PERFORM PASS NC2174.2 +135800 GO TO STR-WRITE-GF-21-2 NC2174.2 +135900 ELSE NC2174.2 +136000 GO TO STR-FAIL-GF-21-2. NC2174.2 +136100 STR-DELETE-GF-21-2. NC2174.2 +136200 PERFORM DE-LETE. NC2174.2 +136300 GO TO STR-WRITE-GF-21-2. NC2174.2 +136400 STR-FAIL-GF-21-2. NC2174.2 +136500 PERFORM FAIL NC2174.2 +136600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +136700 MOVE 6 TO CORRECT-N. NC2174.2 +136800 STR-WRITE-GF-21-2. NC2174.2 +136900 PERFORM PRINT-DETAIL. NC2174.2 +137000* NC2174.2 +137100 STR-INIT-GF-22. NC2174.2 +137200* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +137300 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +137400 MOVE "STR-TEST-GF-22" TO PAR-NAME. NC2174.2 +137500 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +137600 MOVE "*****" TO ID7-XN-5. NC2174.2 +137700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +137800 MOVE 1 TO REC-CT. NC2174.2 +137900* NC2174.2 +138000 STR-TEST-GF-22-1. NC2174.2 +138100 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +138200 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +138300 NOT ON OVERFLOW GO TO STR-FAIL-GF-22-1. NC2174.2 +138400 PERFORM PASS. NC2174.2 +138500 GO TO STR-WRITE-GF-22-1. NC2174.2 +138600 STR-DELETE-GF-22. NC2174.2 +138700 PERFORM DE-LETE. NC2174.2 +138800 PERFORM PRINT-DETAIL. NC2174.2 +138900 GO TO STR-INIT-GF-23. NC2174.2 +139000 STR-FAIL-GF-22-1. NC2174.2 +139100 PERFORM FAIL. NC2174.2 +139200 MOVE "NOT ON OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +139300 STR-WRITE-GF-22-1. NC2174.2 +139400 PERFORM PRINT-DETAIL. NC2174.2 +139500* NC2174.2 +139600 STR-TEST-GF-22-2. NC2174.2 +139700 ADD 1 TO REC-CT. NC2174.2 +139800 IF ID7-XN-5 = "ABCDE" NC2174.2 +139900 PERFORM PASS NC2174.2 +140000 GO TO STR-WRITE-GF-22-2 NC2174.2 +140100 ELSE NC2174.2 +140200 GO TO STR-FAIL-GF-22-2. NC2174.2 +140300 STR-DELETE-GF-22-2. NC2174.2 +140400 PERFORM DE-LETE. NC2174.2 +140500 GO TO STR-WRITE-GF-22-2. NC2174.2 +140600 STR-FAIL-GF-22-2. NC2174.2 +140700 PERFORM FAIL. NC2174.2 +140800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +140900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +141000 STR-WRITE-GF-22-2. NC2174.2 +141100 PERFORM PRINT-DETAIL. NC2174.2 +141200* NC2174.2 +141300 STR-TEST-GF-22-3. NC2174.2 +141400 ADD 1 TO REC-CT. NC2174.2 +141500 IF ID8-DU-2V0 = 6 NC2174.2 +141600 PERFORM PASS NC2174.2 +141700 GO TO STR-WRITE-GF-22-3 NC2174.2 +141800 ELSE NC2174.2 +141900 GO TO STR-FAIL-GF-22-3. NC2174.2 +142000 STR-DELETE-GF-22-3. NC2174.2 +142100 PERFORM DE-LETE. NC2174.2 +142200 GO TO STR-WRITE-GF-22-3. NC2174.2 +142300 STR-FAIL-GF-22-3. NC2174.2 +142400 PERFORM FAIL NC2174.2 +142500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +142600 MOVE 6 TO CORRECT-N. NC2174.2 +142700 STR-WRITE-GF-22-3. NC2174.2 +142800 PERFORM PRINT-DETAIL. NC2174.2 +142900* NC2174.2 +143000 STR-INIT-GF-23. NC2174.2 +143100* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +143200 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +143300 MOVE "STR-TEST-GF-23" TO PAR-NAME. NC2174.2 +143400 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +143500 MOVE "*****" TO ID7-XN-5. NC2174.2 +143600 MOVE 1 TO ID8-DU-2V0. NC2174.2 +143700 MOVE 1 TO REC-CT. NC2174.2 +143800* NC2174.2 +143900 STR-TEST-GF-23-1. NC2174.2 +144000 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +144100 POINTER ID8-DU-2V0 NC2174.2 +144200 NOT ON OVERFLOW PERFORM PASS NC2174.2 +144300 GO TO STR-WRITE-GF-23-1. NC2174.2 +144400 GO TO STR-FAIL-GF-23-1. NC2174.2 +144500 STR-DELETE-GF-23. NC2174.2 +144600 PERFORM DE-LETE. NC2174.2 +144700 PERFORM PRINT-DETAIL. NC2174.2 +144800 GO TO STR-INIT-GF-24. NC2174.2 +144900 STR-FAIL-GF-23-1. NC2174.2 +145000 PERFORM FAIL. NC2174.2 +145100 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2174.2 +145200 STR-WRITE-GF-23-1. NC2174.2 +145300 PERFORM PRINT-DETAIL. NC2174.2 +145400* NC2174.2 +145500 STR-TEST-GF-23-2. NC2174.2 +145600 ADD 1 TO REC-CT. NC2174.2 +145700 IF ID7-XN-5 = "ABCDE" NC2174.2 +145800 PERFORM PASS NC2174.2 +145900 GO TO STR-WRITE-GF-23-2 NC2174.2 +146000 ELSE NC2174.2 +146100 GO TO STR-FAIL-GF-23-2. NC2174.2 +146200 STR-DELETE-GF-23-2. NC2174.2 +146300 PERFORM DE-LETE. NC2174.2 +146400 GO TO STR-WRITE-GF-23-2. NC2174.2 +146500 STR-FAIL-GF-23-2. NC2174.2 +146600 PERFORM FAIL NC2174.2 +146700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +146800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +146900 STR-WRITE-GF-23-2. NC2174.2 +147000 PERFORM PRINT-DETAIL. NC2174.2 +147100* NC2174.2 +147200 STR-TEST-GF-23-3. NC2174.2 +147300 ADD 1 TO REC-CT. NC2174.2 +147400 IF ID8-DU-2V0 = 6 NC2174.2 +147500 PERFORM PASS NC2174.2 +147600 GO TO STR-WRITE-GF-23-3 NC2174.2 +147700 ELSE NC2174.2 +147800 GO TO STR-FAIL-GF-23-3. NC2174.2 +147900 STR-DELETE-GF-23-3. NC2174.2 +148000 PERFORM DE-LETE. NC2174.2 +148100 GO TO STR-WRITE-GF-23-3. NC2174.2 +148200 STR-FAIL-GF-23-3. NC2174.2 +148300 PERFORM FAIL NC2174.2 +148400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +148500 MOVE 6 TO CORRECT-N. NC2174.2 +148600 STR-WRITE-GF-23-3. NC2174.2 +148700 PERFORM PRINT-DETAIL. NC2174.2 +148800* NC2174.2 +148900 STR-INIT-GF-24. NC2174.2 +149000* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2174.2 +149100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +149200 MOVE "STR-TEST-GF-24" TO PAR-NAME. NC2174.2 +149300 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +149400 MOVE "*****" TO ID7-XN-5. NC2174.2 +149500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +149600 MOVE 1 TO REC-CT. NC2174.2 +149700* NC2174.2 +149800 STR-TEST-GF-24-1. NC2174.2 +149900 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +150000 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +150100 ON OVERFLOW PERFORM PASS NC2174.2 +150200 GO TO STR-WRITE-GF-24-1 NC2174.2 +150300 NOT ON OVERFLOW GO TO STR-FAIL-GF-24-1. NC2174.2 +150400 STR-DELETE-GF-24. NC2174.2 +150500 PERFORM DE-LETE. NC2174.2 +150600 PERFORM PRINT-DETAIL. NC2174.2 +150700 GO TO STR-INIT-GF-25. NC2174.2 +150800 STR-FAIL-GF-24-1. NC2174.2 +150900 PERFORM FAIL. NC2174.2 +151000 MOVE "NOT ON OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +151100 STR-WRITE-GF-24-1. NC2174.2 +151200 PERFORM PRINT-DETAIL. NC2174.2 +151300* NC2174.2 +151400 STR-TEST-GF-24-2. NC2174.2 +151500 ADD 1 TO REC-CT. NC2174.2 +151600 IF ID7-XN-5 = "ABCDE" NC2174.2 +151700 PERFORM PASS NC2174.2 +151800 GO TO STR-WRITE-GF-24-2 NC2174.2 +151900 ELSE NC2174.2 +152000 GO TO STR-FAIL-GF-24-2. NC2174.2 +152100 STR-DELETE-GF-24-2. NC2174.2 +152200 PERFORM DE-LETE. NC2174.2 +152300 GO TO STR-WRITE-GF-24-2. NC2174.2 +152400 STR-FAIL-GF-24-2. NC2174.2 +152500 PERFORM FAIL NC2174.2 +152600 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +152700 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +152800 STR-WRITE-GF-24-2. NC2174.2 +152900 PERFORM PRINT-DETAIL. NC2174.2 +153000* NC2174.2 +153100 STR-TEST-GF-24-3. NC2174.2 +153200 ADD 1 TO REC-CT. NC2174.2 +153300 IF ID8-DU-2V0 = 6 NC2174.2 +153400 PERFORM PASS NC2174.2 +153500 GO TO STR-WRITE-GF-24-3 NC2174.2 +153600 ELSE NC2174.2 +153700 GO TO STR-FAIL-GF-24-3. NC2174.2 +153800 STR-DELETE-GF-24-3. NC2174.2 +153900 PERFORM DE-LETE. NC2174.2 +154000 GO TO STR-WRITE-GF-24-3. NC2174.2 +154100 STR-FAIL-GF-24-3. NC2174.2 +154200 PERFORM FAIL NC2174.2 +154300 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +154400 MOVE 6 TO CORRECT-N. NC2174.2 +154500 STR-WRITE-GF-24-3. NC2174.2 +154600 PERFORM PRINT-DETAIL. NC2174.2 +154700* NC2174.2 +154800 STR-INIT-GF-25. NC2174.2 +154900* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +155000 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +155100 MOVE "STR-TEST-GF-25" TO PAR-NAME. NC2174.2 +155200 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +155300 MOVE "*****" TO ID7-XN-5. NC2174.2 +155400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +155500 MOVE ZERO TO REC-CT. NC2174.2 +155600* NC2174.2 +155700 STR-TEST-GF-25-1. NC2174.2 +155800 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +155900 POINTER ID8-DU-2V0 NC2174.2 +156000 ON OVERFLOW GO TO STR-FAIL-GF-25-1 NC2174.2 +156100 NOT ON OVERFLOW PERFORM PASS NC2174.2 +156200 GO TO STR-WRITE-GF-25-1. NC2174.2 +156300 STR-DELETE-GF-25-1. NC2174.2 +156400 PERFORM DE-LETE. NC2174.2 +156500 PERFORM PRINT-DETAIL. NC2174.2 +156600 GO TO STR-INIT-GF-26. NC2174.2 +156700 STR-FAIL-GF-25-1. NC2174.2 +156800 PERFORM FAIL. NC2174.2 +156900 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2174.2 +157000 STR-WRITE-GF-25-1. NC2174.2 +157100 PERFORM PRINT-DETAIL. NC2174.2 +157200* NC2174.2 +157300 STR-TEST-GF-25-2. NC2174.2 +157400 MOVE "STR-TEST-GF-25-1" TO PAR-NAME. NC2174.2 +157500 MOVE 1 TO REC-CT. NC2174.2 +157600 IF ID7-XN-5 = "ABCDE" NC2174.2 +157700 PERFORM PASS NC2174.2 +157800 GO TO STR-WRITE-GF-25-2 NC2174.2 +157900 ELSE NC2174.2 +158000 GO TO STR-FAIL-GF-25-2. NC2174.2 +158100 STR-DELETE-GF-25-2. NC2174.2 +158200 PERFORM DE-LETE. NC2174.2 +158300 GO TO STR-WRITE-GF-25-2. NC2174.2 +158400 STR-FAIL-GF-25-2. NC2174.2 +158500 PERFORM FAIL NC2174.2 +158600 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +158700 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +158800 STR-WRITE-GF-25-2. NC2174.2 +158900 PERFORM PRINT-DETAIL. NC2174.2 +159000* NC2174.2 +159100 STR-TEST-GF-25-3. NC2174.2 +159200 ADD 1 TO REC-CT. NC2174.2 +159300 IF ID8-DU-2V0 = 6 NC2174.2 +159400 PERFORM PASS NC2174.2 +159500 GO TO STR-WRITE-GF-25-3 NC2174.2 +159600 ELSE NC2174.2 +159700 GO TO STR-FAIL-GF-25-3. NC2174.2 +159800 STR-DELETE-GF-25-3. NC2174.2 +159900 PERFORM DE-LETE. NC2174.2 +160000 GO TO STR-WRITE-GF-25-3. NC2174.2 +160100 STR-FAIL-GF-25-3. NC2174.2 +160200 PERFORM FAIL NC2174.2 +160300 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +160400 MOVE 6 TO CORRECT-N. NC2174.2 +160500 STR-WRITE-GF-25-3. NC2174.2 +160600 PERFORM PRINT-DETAIL. NC2174.2 +160700* NC2174.2 +160800 STR-INIT-GF-26. NC2174.2 +160900* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2174.2 +161000 MOVE "VI-132 6.24.4 GR11" TO ANSI-REFERENCE. NC2174.2 +161100 MOVE "STR-TEST-GF-26" TO PAR-NAME. NC2174.2 +161200 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +161300 MOVE "*****" TO ID7-XN-5. NC2174.2 +161400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +161500 MOVE 1 TO REC-CT. NC2174.2 +161600 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +161700 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +161800 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +161900* NC2174.2 +162000 STR-TEST-GF-26-0. NC2174.2 +162100 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +162200 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +162300 ON OVERFLOW NC2174.2 +162400 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +162500 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +162600 NOT ON OVERFLOW NC2174.2 +162700 MOVE "C" TO WRK-XN-00001-1 NC2174.2 +162800 MOVE "D" TO WRK-XN-00001-2 NC2174.2 +162900 END-STRING NC2174.2 +163000 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +163100 GO TO STR-TEST-GF-26-1. NC2174.2 +163200 STR-DELETE-GF-26. NC2174.2 +163300 PERFORM DE-LETE. NC2174.2 +163400 PERFORM PRINT-DETAIL. NC2174.2 +163500 GO TO STR-INIT-GF-27. NC2174.2 +163600* NC2174.2 +163700 STR-TEST-GF-26-1. NC2174.2 +163800 IF ID7-XN-5 = "ABCDE" NC2174.2 +163900 PERFORM PASS NC2174.2 +164000 GO TO STR-WRITE-GF-26-1 NC2174.2 +164100 ELSE NC2174.2 +164200 GO TO STR-FAIL-GF-26-1. NC2174.2 +164300 STR-DELETE-GF-26-1. NC2174.2 +164400 PERFORM DE-LETE. NC2174.2 +164500 GO TO STR-WRITE-GF-26-1. NC2174.2 +164600 STR-FAIL-GF-26-1. NC2174.2 +164700 PERFORM FAIL NC2174.2 +164800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +164900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +165000 STR-WRITE-GF-26-1. NC2174.2 +165100 PERFORM PRINT-DETAIL. NC2174.2 +165200* NC2174.2 +165300 STR-TEST-GF-26-2. NC2174.2 +165400 ADD 1 TO REC-CT. NC2174.2 +165500 MOVE "STR-TEST-GF-26-2" TO PAR-NAME. NC2174.2 +165600 IF ID8-DU-2V0 = 6 NC2174.2 +165700 PERFORM PASS NC2174.2 +165800 GO TO STR-WRITE-GF-26-2 NC2174.2 +165900 ELSE NC2174.2 +166000 GO TO STR-FAIL-GF-26-2. NC2174.2 +166100 STR-DELETE-GF-26-2. NC2174.2 +166200 PERFORM DE-LETE. NC2174.2 +166300 GO TO STR-WRITE-GF-26-2. NC2174.2 +166400 STR-FAIL-GF-26-2. NC2174.2 +166500 PERFORM FAIL NC2174.2 +166600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +166700 MOVE 6 TO CORRECT-N. NC2174.2 +166800 STR-WRITE-GF-26-2. NC2174.2 +166900 PERFORM PRINT-DETAIL. NC2174.2 +167000* NC2174.2 +167100 STR-TEST-GF-26-3. NC2174.2 +167200 ADD 1 TO REC-CT. NC2174.2 +167300 IF WRK-XN-00001-1 = "A" NC2174.2 +167400 PERFORM PASS NC2174.2 +167500 GO TO STR-WRITE-GF-26-3 NC2174.2 +167600 ELSE NC2174.2 +167700 GO TO STR-FAIL-GF-26-3. NC2174.2 +167800 STR-DELETE-GF-26-3. NC2174.2 +167900 PERFORM DE-LETE. NC2174.2 +168000 GO TO STR-WRITE-GF-26-3. NC2174.2 +168100 STR-FAIL-GF-26-3. NC2174.2 +168200 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +168300 MOVE "A" TO CORRECT-X NC2174.2 +168400 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +168500 PERFORM FAIL. NC2174.2 +168600 STR-WRITE-GF-26-3. NC2174.2 +168700 PERFORM PRINT-DETAIL. NC2174.2 +168800* NC2174.2 +168900 STR-TEST-GF-26-4. NC2174.2 +169000 ADD 1 TO REC-CT. NC2174.2 +169100 IF WRK-XN-00001-2 = "B" NC2174.2 +169200 PERFORM PASS NC2174.2 +169300 GO TO STR-WRITE-GF-26-4 NC2174.2 +169400 ELSE NC2174.2 +169500 GO TO STR-FAIL-GF-26-4. NC2174.2 +169600 STR-DELETE-GF-26-4. NC2174.2 +169700 PERFORM DE-LETE. NC2174.2 +169800 GO TO STR-WRITE-GF-26-4. NC2174.2 +169900 STR-FAIL-GF-26-4. NC2174.2 +170000 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +170100 MOVE "B" TO CORRECT-X NC2174.2 +170200 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +170300 PERFORM FAIL. NC2174.2 +170400 STR-WRITE-GF-26-4. NC2174.2 +170500 PERFORM PRINT-DETAIL. NC2174.2 +170600* NC2174.2 +170700 STR-TEST-GF-26-5. NC2174.2 +170800 ADD 1 TO REC-CT. NC2174.2 +170900 IF WRK-XN-00001-3 = "Z" NC2174.2 +171000 PERFORM PASS NC2174.2 +171100 GO TO STR-WRITE-GF-26-5 NC2174.2 +171200 ELSE NC2174.2 +171300 GO TO STR-FAIL-GF-26-5. NC2174.2 +171400 STR-DELETE-GF-26-5. NC2174.2 +171500 PERFORM DE-LETE. NC2174.2 +171600 GO TO STR-WRITE-GF-26-5. NC2174.2 +171700 STR-FAIL-GF-26-5. NC2174.2 +171800 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +171900 MOVE "Z" TO CORRECT-X NC2174.2 +172000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +172100 PERFORM FAIL. NC2174.2 +172200 STR-WRITE-GF-26-5. NC2174.2 +172300 PERFORM PRINT-DETAIL. NC2174.2 +172400* NC2174.2 +172500 STR-INIT-GF-27. NC2174.2 +172600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +172700 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +172800 MOVE "STR-TEST-GF-27" TO PAR-NAME. NC2174.2 +172900 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +173000 MOVE "*****" TO ID7-XN-5. NC2174.2 +173100 MOVE 1 TO ID8-DU-2V0. NC2174.2 +173200 MOVE ZERO TO REC-CT. NC2174.2 +173300 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +173400 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +173500 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +173600* NC2174.2 +173700 STR-TEST-GF-27-0. NC2174.2 +173800 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +173900 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +174000 ON OVERFLOW NC2174.2 +174100 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +174200 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +174300 END-STRING NC2174.2 +174400 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +174500 GO TO STR-TEST-GF-27-1. NC2174.2 +174600 STR-DELETE-GF-27. NC2174.2 +174700 PERFORM DE-LETE. NC2174.2 +174800 PERFORM PRINT-DETAIL. NC2174.2 +174900 GO TO STR-INIT-GF-28. NC2174.2 +175000* NC2174.2 +175100 STR-TEST-GF-27-1. NC2174.2 +175200 MOVE 1 TO REC-CT. NC2174.2 +175300 IF ID7-XN-5 = "ABCDE" NC2174.2 +175400 PERFORM PASS NC2174.2 +175500 GO TO STR-WRITE-GF-27-1 NC2174.2 +175600 ELSE NC2174.2 +175700 GO TO STR-FAIL-GF-27-1. NC2174.2 +175800 STR-DELETE-GF-27-1. NC2174.2 +175900 PERFORM DE-LETE. NC2174.2 +176000 GO TO STR-WRITE-GF-27-1. NC2174.2 +176100 STR-FAIL-GF-27-1. NC2174.2 +176200 PERFORM FAIL NC2174.2 +176300 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +176400 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +176500 STR-WRITE-GF-27-1. NC2174.2 +176600 PERFORM PRINT-DETAIL. NC2174.2 +176700* NC2174.2 +176800 STR-TEST-GF-27-2. NC2174.2 +176900 ADD 1 TO REC-CT. NC2174.2 +177000 IF ID8-DU-2V0 = 6 NC2174.2 +177100 PERFORM PASS NC2174.2 +177200 GO TO STR-WRITE-GF-27-2 NC2174.2 +177300 ELSE NC2174.2 +177400 GO TO STR-FAIL-GF-27-2. NC2174.2 +177500 STR-DELETE-GF-27-2. NC2174.2 +177600 PERFORM DE-LETE. NC2174.2 +177700 GO TO STR-WRITE-GF-27-2. NC2174.2 +177800 STR-FAIL-GF-27-2. NC2174.2 +177900 PERFORM FAIL NC2174.2 +178000 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +178100 MOVE 6 TO CORRECT-N. NC2174.2 +178200 STR-WRITE-GF-27-2. NC2174.2 +178300 PERFORM PRINT-DETAIL. NC2174.2 +178400* NC2174.2 +178500 STR-TEST-GF-27-3. NC2174.2 +178600 ADD 1 TO REC-CT. NC2174.2 +178700 IF WRK-XN-00001-1 = "A" NC2174.2 +178800 PERFORM PASS NC2174.2 +178900 GO TO STR-WRITE-GF-27-3 NC2174.2 +179000 ELSE NC2174.2 +179100 GO TO STR-FAIL-GF-27-3. NC2174.2 +179200 STR-DELETE-GF-27-3. NC2174.2 +179300 PERFORM DE-LETE. NC2174.2 +179400 GO TO STR-WRITE-GF-27-3. NC2174.2 +179500 STR-FAIL-GF-27-3. NC2174.2 +179600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +179700 MOVE "A" TO CORRECT-X NC2174.2 +179800 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +179900 PERFORM FAIL. NC2174.2 +180000 STR-WRITE-GF-27-3. NC2174.2 +180100 PERFORM PRINT-DETAIL. NC2174.2 +180200* NC2174.2 +180300 STR-TEST-GF-27-4. NC2174.2 +180400 ADD 1 TO REC-CT. NC2174.2 +180500 IF WRK-XN-00001-2 = "B" NC2174.2 +180600 PERFORM PASS NC2174.2 +180700 GO TO STR-WRITE-GF-27-4 NC2174.2 +180800 ELSE NC2174.2 +180900 GO TO STR-FAIL-GF-27-4. NC2174.2 +181000 STR-DELETE-GF-27-4. NC2174.2 +181100 PERFORM DE-LETE. NC2174.2 +181200 GO TO STR-WRITE-GF-27-4. NC2174.2 +181300 STR-FAIL-GF-27-4. NC2174.2 +181400 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +181500 MOVE "B" TO CORRECT-X NC2174.2 +181600 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +181700 PERFORM FAIL. NC2174.2 +181800 STR-WRITE-GF-27-4. NC2174.2 +181900 PERFORM PRINT-DETAIL. NC2174.2 +182000* NC2174.2 +182100 STR-TEST-GF-27-5. NC2174.2 +182200 ADD 1 TO REC-CT. NC2174.2 +182300 IF WRK-XN-00001-3 = "Z" NC2174.2 +182400 PERFORM PASS NC2174.2 +182500 GO TO STR-WRITE-GF-27-5 NC2174.2 +182600 ELSE NC2174.2 +182700 GO TO STR-FAIL-GF-27-5. NC2174.2 +182800 STR-DELETE-GF-27-5. NC2174.2 +182900 PERFORM DE-LETE. NC2174.2 +183000 GO TO STR-WRITE-GF-27-5. NC2174.2 +183100 STR-FAIL-GF-27-5. NC2174.2 +183200 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +183300 MOVE "Z" TO CORRECT-X NC2174.2 +183400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +183500 PERFORM FAIL. NC2174.2 +183600 STR-WRITE-GF-27-5. NC2174.2 +183700 PERFORM PRINT-DETAIL. NC2174.2 +183800* NC2174.2 +183900 STR-INIT-GF-28. NC2174.2 +184000* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +184100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +184200 MOVE "STR-TEST-GF-28" TO PAR-NAME. NC2174.2 +184300 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +184400 MOVE "*****" TO ID7-XN-5. NC2174.2 +184500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +184600 MOVE ZERO TO REC-CT. NC2174.2 +184700 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +184800 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +184900 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +185000* NC2174.2 +185100 STR-TEST-GF-28-0. NC2174.2 +185200 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +185300 POINTER ID8-DU-2V0 NC2174.2 +185400 ON OVERFLOW NC2174.2 +185500 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +185600 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +185700 END-STRING NC2174.2 +185800 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +185900 GO TO STR-TEST-GF-28-1. NC2174.2 +186000 STR-DELETE-GF-28. NC2174.2 +186100 PERFORM DE-LETE. NC2174.2 +186200 PERFORM PRINT-DETAIL. NC2174.2 +186300 GO TO STR-INIT-GF-29. NC2174.2 +186400* NC2174.2 +186500 STR-TEST-GF-28-1. NC2174.2 +186600 MOVE 1 TO REC-CT. NC2174.2 +186700 IF ID7-XN-5 = "ABCDE" NC2174.2 +186800 PERFORM PASS NC2174.2 +186900 GO TO STR-WRITE-GF-28-1 NC2174.2 +187000 ELSE NC2174.2 +187100 GO TO STR-FAIL-GF-28-1. NC2174.2 +187200 STR-DELETE-GF-28-1. NC2174.2 +187300 PERFORM DE-LETE. NC2174.2 +187400 GO TO STR-WRITE-GF-28-1. NC2174.2 +187500 STR-FAIL-GF-28-1. NC2174.2 +187600 PERFORM FAIL NC2174.2 +187700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +187800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +187900 STR-WRITE-GF-28-1. NC2174.2 +188000 PERFORM PRINT-DETAIL. NC2174.2 +188100* NC2174.2 +188200 STR-TEST-GF-28-2. NC2174.2 +188300 ADD 1 TO REC-CT. NC2174.2 +188400 IF ID8-DU-2V0 = 6 NC2174.2 +188500 PERFORM PASS NC2174.2 +188600 GO TO STR-WRITE-GF-28-2 NC2174.2 +188700 ELSE NC2174.2 +188800 GO TO STR-FAIL-GF-28-2. NC2174.2 +188900 STR-DELETE-GF-28-2. NC2174.2 +189000 PERFORM DE-LETE. NC2174.2 +189100 GO TO STR-WRITE-GF-28-2. NC2174.2 +189200 STR-FAIL-GF-28-2. NC2174.2 +189300 PERFORM FAIL NC2174.2 +189400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +189500 MOVE 6 TO CORRECT-N. NC2174.2 +189600 STR-WRITE-GF-28-2. NC2174.2 +189700 PERFORM PRINT-DETAIL. NC2174.2 +189800* NC2174.2 +189900 STR-TEST-GF-28-3. NC2174.2 +190000 ADD 1 TO REC-CT. NC2174.2 +190100 IF WRK-XN-00001-1 = SPACE NC2174.2 +190200 PERFORM PASS NC2174.2 +190300 GO TO STR-WRITE-GF-28-3 NC2174.2 +190400 ELSE NC2174.2 +190500 GO TO STR-FAIL-GF-28-3. NC2174.2 +190600 STR-DELETE-GF-28-3. NC2174.2 +190700 PERFORM DE-LETE. NC2174.2 +190800 GO TO STR-WRITE-GF-28-3. NC2174.2 +190900 STR-FAIL-GF-28-3. NC2174.2 +191000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +191100 MOVE SPACE TO CORRECT-X NC2174.2 +191200 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2174.2 +191300 PERFORM FAIL. NC2174.2 +191400 STR-WRITE-GF-28-3. NC2174.2 +191500 PERFORM PRINT-DETAIL. NC2174.2 +191600* NC2174.2 +191700 STR-TEST-GF-28-4. NC2174.2 +191800 ADD 1 TO REC-CT. NC2174.2 +191900 IF WRK-XN-00001-2 = SPACE NC2174.2 +192000 PERFORM PASS NC2174.2 +192100 GO TO STR-WRITE-GF-28-4 NC2174.2 +192200 ELSE NC2174.2 +192300 GO TO STR-FAIL-GF-28-4. NC2174.2 +192400 STR-DELETE-GF-28-4. NC2174.2 +192500 PERFORM DE-LETE. NC2174.2 +192600 GO TO STR-WRITE-GF-28-4. NC2174.2 +192700 STR-FAIL-GF-28-4. NC2174.2 +192800 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +192900 MOVE SPACE TO CORRECT-X NC2174.2 +193000 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2174.2 +193100 PERFORM FAIL. NC2174.2 +193200 STR-WRITE-GF-28-4. NC2174.2 +193300 PERFORM PRINT-DETAIL. NC2174.2 +193400* NC2174.2 +193500 STR-TEST-GF-28-5. NC2174.2 +193600 ADD 1 TO REC-CT. NC2174.2 +193700 IF WRK-XN-00001-3 = "Z" NC2174.2 +193800 PERFORM PASS NC2174.2 +193900 GO TO STR-WRITE-GF-28-5 NC2174.2 +194000 ELSE NC2174.2 +194100 GO TO STR-FAIL-GF-28-5. NC2174.2 +194200 STR-DELETE-GF-28-5. NC2174.2 +194300 PERFORM DE-LETE. NC2174.2 +194400 GO TO STR-WRITE-GF-28-5. NC2174.2 +194500 STR-FAIL-GF-28-5. NC2174.2 +194600 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +194700 MOVE "Z" TO CORRECT-X NC2174.2 +194800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +194900 PERFORM FAIL. NC2174.2 +195000 STR-WRITE-GF-28-5. NC2174.2 +195100 PERFORM PRINT-DETAIL. NC2174.2 +195200* NC2174.2 +195300 STR-INIT-GF-29. NC2174.2 +195400* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +195500 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +195600 MOVE "STR-TEST-GF-29" TO PAR-NAME. NC2174.2 +195700 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +195800 MOVE "*****" TO ID7-XN-5. NC2174.2 +195900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +196000 MOVE ZERO TO REC-CT. NC2174.2 +196100 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +196200 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +196300 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +196400* NC2174.2 +196500 STR-TEST-GF-29. NC2174.2 +196600 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +196700 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +196800 NOT ON OVERFLOW NC2174.2 +196900 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +197000 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +197100 END-STRING NC2174.2 +197200 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +197300 GO TO STR-TEST-GF-29-1. NC2174.2 +197400 STR-DELETE-GF-29. NC2174.2 +197500 PERFORM DE-LETE. NC2174.2 +197600 PERFORM PRINT-DETAIL. NC2174.2 +197700 GO TO STR-INIT-GF-30. NC2174.2 +197800* NC2174.2 +197900 STR-TEST-GF-29-1. NC2174.2 +198000 MOVE 1 TO REC-CT. NC2174.2 +198100 IF ID7-XN-5 = "ABCDE" NC2174.2 +198200 PERFORM PASS NC2174.2 +198300 GO TO STR-WRITE-GF-29-1 NC2174.2 +198400 ELSE NC2174.2 +198500 GO TO STR-FAIL-GF-29-1. NC2174.2 +198600 STR-DELETE-GF-29-1. NC2174.2 +198700 PERFORM DE-LETE. NC2174.2 +198800 GO TO STR-WRITE-GF-29-1. NC2174.2 +198900 STR-FAIL-GF-29-1. NC2174.2 +199000 PERFORM FAIL NC2174.2 +199100 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +199200 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +199300 STR-WRITE-GF-29-1. NC2174.2 +199400 PERFORM PRINT-DETAIL. NC2174.2 +199500* NC2174.2 +199600 STR-TEST-GF-29-2. NC2174.2 +199700 ADD 1 TO REC-CT. NC2174.2 +199800 IF ID8-DU-2V0 = 6 NC2174.2 +199900 PERFORM PASS NC2174.2 +200000 GO TO STR-WRITE-GF-29-2 NC2174.2 +200100 ELSE NC2174.2 +200200 GO TO STR-FAIL-GF-29-2. NC2174.2 +200300 STR-DELETE-GF-29-2. NC2174.2 +200400 PERFORM DE-LETE. NC2174.2 +200500 GO TO STR-WRITE-GF-29-2. NC2174.2 +200600 STR-FAIL-GF-29-2. NC2174.2 +200700 PERFORM FAIL NC2174.2 +200800 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +200900 MOVE 6 TO CORRECT-N. NC2174.2 +201000 STR-WRITE-GF-29-2. NC2174.2 +201100 PERFORM PRINT-DETAIL. NC2174.2 +201200* NC2174.2 +201300 STR-TEST-GF-29-3. NC2174.2 +201400 ADD 1 TO REC-CT. NC2174.2 +201500 IF WRK-XN-00001-1 = SPACE NC2174.2 +201600 PERFORM PASS NC2174.2 +201700 GO TO STR-WRITE-GF-29-3 NC2174.2 +201800 ELSE NC2174.2 +201900 GO TO STR-FAIL-GF-29-3. NC2174.2 +202000 STR-DELETE-GF-29-3. NC2174.2 +202100 PERFORM DE-LETE. NC2174.2 +202200 GO TO STR-WRITE-GF-29-3. NC2174.2 +202300 STR-FAIL-GF-29-3. NC2174.2 +202400 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +202500 MOVE SPACE TO CORRECT-X NC2174.2 +202600 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" NC2174.2 +202700 TO RE-MARK NC2174.2 +202800 PERFORM FAIL. NC2174.2 +202900 STR-WRITE-GF-29-3. NC2174.2 +203000 PERFORM PRINT-DETAIL. NC2174.2 +203100* NC2174.2 +203200 STR-TEST-GF-29-4. NC2174.2 +203300 ADD 1 TO REC-CT. NC2174.2 +203400 IF WRK-XN-00001-2 = SPACE NC2174.2 +203500 PERFORM PASS NC2174.2 +203600 GO TO STR-WRITE-GF-29-4 NC2174.2 +203700 ELSE NC2174.2 +203800 GO TO STR-FAIL-GF-29-4. NC2174.2 +203900 STR-DELETE-GF-29-4. NC2174.2 +204000 PERFORM DE-LETE. NC2174.2 +204100 GO TO STR-WRITE-GF-29-4. NC2174.2 +204200 STR-FAIL-GF-29-4. NC2174.2 +204300 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +204400 MOVE SPACE TO CORRECT-X NC2174.2 +204500 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" NC2174.2 +204600 TO RE-MARK NC2174.2 +204700 PERFORM FAIL. NC2174.2 +204800 STR-WRITE-GF-29-4. NC2174.2 +204900 PERFORM PRINT-DETAIL. NC2174.2 +205000* NC2174.2 +205100 STR-TEST-GF-29-5. NC2174.2 +205200 ADD 1 TO REC-CT. NC2174.2 +205300 IF WRK-XN-00001-3 = "Z" NC2174.2 +205400 PERFORM PASS NC2174.2 +205500 GO TO STR-WRITE-GF-29-5 NC2174.2 +205600 ELSE NC2174.2 +205700 GO TO STR-FAIL-GF-29-5. NC2174.2 +205800 STR-DELETE-GF-29-5. NC2174.2 +205900 PERFORM DE-LETE. NC2174.2 +206000 GO TO STR-WRITE-GF-29-5. NC2174.2 +206100 STR-FAIL-GF-29-5. NC2174.2 +206200 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +206300 MOVE "Z" TO CORRECT-X NC2174.2 +206400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +206500 PERFORM FAIL. NC2174.2 +206600 STR-WRITE-GF-29-5. NC2174.2 +206700 PERFORM PRINT-DETAIL. NC2174.2 +206800* NC2174.2 +206900 STR-INIT-GF-30. NC2174.2 +207000* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +207100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +207200 MOVE "STR-TEST-GF-30" TO PAR-NAME. NC2174.2 +207300 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +207400 MOVE "*****" TO ID7-XN-5. NC2174.2 +207500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +207600 MOVE ZERO TO REC-CT. NC2174.2 +207700 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +207800 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +207900 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +208000* NC2174.2 +208100 STR-TEST-GF-30. NC2174.2 +208200 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +208300 POINTER ID8-DU-2V0 NC2174.2 +208400 NOT ON OVERFLOW NC2174.2 +208500 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +208600 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +208700 END-STRING NC2174.2 +208800 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +208900 GO TO STR-TEST-GF-30-1. NC2174.2 +209000 STR-DELETE-GF-30. NC2174.2 +209100 PERFORM DE-LETE. NC2174.2 +209200 PERFORM PRINT-DETAIL. NC2174.2 +209300 GO TO CCVS-EXIT. NC2174.2 +209400* NC2174.2 +209500 STR-TEST-GF-30-1. NC2174.2 +209600 MOVE 1 TO REC-CT. NC2174.2 +209700 IF ID7-XN-5 = "ABCDE" NC2174.2 +209800 PERFORM PASS NC2174.2 +209900 GO TO STR-WRITE-GF-30-1 NC2174.2 +210000 ELSE NC2174.2 +210100 GO TO STR-FAIL-GF-30-1. NC2174.2 +210200 STR-DELETE-GF-30-1. NC2174.2 +210300 PERFORM DE-LETE. NC2174.2 +210400 GO TO STR-WRITE-GF-30-1. NC2174.2 +210500 STR-FAIL-GF-30-1. NC2174.2 +210600 PERFORM FAIL NC2174.2 +210700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +210800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +210900 STR-WRITE-GF-30-1. NC2174.2 +211000 PERFORM PRINT-DETAIL. NC2174.2 +211100* NC2174.2 +211200 STR-TEST-GF-30-2. NC2174.2 +211300 ADD 1 TO REC-CT. NC2174.2 +211400 IF ID8-DU-2V0 = 6 NC2174.2 +211500 PERFORM PASS NC2174.2 +211600 GO TO STR-WRITE-GF-30-2 NC2174.2 +211700 ELSE NC2174.2 +211800 GO TO STR-FAIL-GF-30-2. NC2174.2 +211900 STR-DELETE-GF-30-2. NC2174.2 +212000 PERFORM DE-LETE. NC2174.2 +212100 GO TO STR-WRITE-GF-30-2. NC2174.2 +212200 STR-FAIL-GF-30-2. NC2174.2 +212300 PERFORM FAIL NC2174.2 +212400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +212500 MOVE 6 TO CORRECT-N. NC2174.2 +212600 STR-WRITE-GF-30-2. NC2174.2 +212700 PERFORM PRINT-DETAIL. NC2174.2 +212800* NC2174.2 +212900 STR-TEST-GF-30-3. NC2174.2 +213000 ADD 1 TO REC-CT. NC2174.2 +213100 IF WRK-XN-00001-1 = "A" NC2174.2 +213200 PERFORM PASS NC2174.2 +213300 GO TO STR-WRITE-GF-30-3 NC2174.2 +213400 ELSE NC2174.2 +213500 GO TO STR-FAIL-GF-30-3. NC2174.2 +213600 STR-DELETE-GF-30-3. NC2174.2 +213700 PERFORM DE-LETE. NC2174.2 +213800 GO TO STR-WRITE-GF-30-3. NC2174.2 +213900 STR-FAIL-GF-30-3. NC2174.2 +214000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +214100 MOVE "A" TO CORRECT-X NC2174.2 +214200 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" NC2174.2 +214300 TO RE-MARK NC2174.2 +214400 PERFORM FAIL. NC2174.2 +214500 STR-WRITE-GF-30-3. NC2174.2 +214600 PERFORM PRINT-DETAIL. NC2174.2 +214700* NC2174.2 +214800 STR-TEST-GF-30-4. NC2174.2 +214900 ADD 1 TO REC-CT. NC2174.2 +215000 IF WRK-XN-00001-2 = "B" NC2174.2 +215100 PERFORM PASS NC2174.2 +215200 GO TO STR-WRITE-GF-30-4 NC2174.2 +215300 ELSE NC2174.2 +215400 GO TO STR-FAIL-GF-30-4. NC2174.2 +215500 STR-DELETE-GF-30-4. NC2174.2 +215600 PERFORM DE-LETE. NC2174.2 +215700 GO TO STR-WRITE-GF-30-4. NC2174.2 +215800 STR-FAIL-GF-30-4. NC2174.2 +215900 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +216000 MOVE "B" TO CORRECT-X NC2174.2 +216100 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" NC2174.2 +216200 TO RE-MARK NC2174.2 +216300 PERFORM FAIL. NC2174.2 +216400 STR-WRITE-GF-30-4. NC2174.2 +216500 PERFORM PRINT-DETAIL. NC2174.2 +216600* NC2174.2 +216700 STR-TEST-GF-30-5. NC2174.2 +216800 ADD 1 TO REC-CT. NC2174.2 +216900 IF WRK-XN-00001-3 = "Z" NC2174.2 +217000 PERFORM PASS NC2174.2 +217100 GO TO STR-WRITE-GF-30-5 NC2174.2 +217200 ELSE NC2174.2 +217300 GO TO STR-FAIL-GF-30-5. NC2174.2 +217400 STR-DELETE-GF-30-5. NC2174.2 +217500 PERFORM DE-LETE. NC2174.2 +217600 GO TO STR-WRITE-GF-30-5. NC2174.2 +217700 STR-FAIL-GF-30-5. NC2174.2 +217800 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +217900 MOVE "Z" TO CORRECT-X NC2174.2 +218000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +218100 PERFORM FAIL. NC2174.2 +218200 STR-WRITE-GF-30-5. NC2174.2 +218300 PERFORM PRINT-DETAIL. NC2174.2 +218400* NC2174.2 +218500 CCVS-EXIT SECTION. NC2174.2 +218600 CCVS-999999. NC2174.2 +218700 GO TO CLOSE-FILES. NC2174.2 +*END-OF,NC217A +*HEADER,COBOL,NC218A +000100 IDENTIFICATION DIVISION. NC2184.2 +000200 PROGRAM-ID. NC2184.2 +000300 NC218A. NC2184.2 +000400**************************************************************** NC2184.2 +000500* * NC2184.2 +000600* VALIDATION FOR:- * NC2184.2 +000700* * NC2184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +000900* * NC2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2184.2 +001100* * NC2184.2 +001200**************************************************************** NC2184.2 +001300* * NC2184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2184.2 +001500* * NC2184.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2184.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2184.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2184.2 +001900* * NC2184.2 +002000**************************************************************** NC2184.2 +002100* * NC2184.2 +002200* PROGRAM NC218A TESTS TYHE USE OF THE "UNSTRING" STATEMENT * NC2184.2 +002300* INCLUDING THE OPTIONAL PHRASES "POINTER", "TALLYING", * NC2184.2 +002400* "OVERFLOW", "NOT OVERFLOW" AND "END-STRING". * NC2184.2 +002500* * NC2184.2 +002600**************************************************************** NC2184.2 +002700 ENVIRONMENT DIVISION. NC2184.2 +002800 CONFIGURATION SECTION. NC2184.2 +002900 SOURCE-COMPUTER. NC2184.2 +003000 XXXXX082. NC2184.2 +003100 OBJECT-COMPUTER. NC2184.2 +003200 XXXXX083. NC2184.2 +003300 INPUT-OUTPUT SECTION. NC2184.2 +003400 FILE-CONTROL. NC2184.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2184.2 +003600 XXXXX055. NC2184.2 +003700 DATA DIVISION. NC2184.2 +003800 FILE SECTION. NC2184.2 +003900 FD PRINT-FILE. NC2184.2 +004000 01 PRINT-REC PICTURE X(120). NC2184.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2184.2 +004200 WORKING-STORAGE SECTION. NC2184.2 +004300 01 WRK-XN-00001-1 PIC X. NC2184.2 +004400 01 WRK-XN-00001-2 PIC X. NC2184.2 +004500 01 WRK-XN-00001-3 PIC X. NC2184.2 +004600 01 ZERO-XN-1 PIC X VALUE "0". NC2184.2 +004700 01 GRP1-XN-6 PIC X(6) VALUE "ABCDEF". NC2184.2 +004800 01 ID1-XN-7 PIC X(7) VALUE "1200000". NC2184.2 +004900 01 GRP1-XN-7 PIC X(7) VALUE "ABCDEFG". NC2184.2 +005000 01 GRP1-XN-10 PIC X(10) VALUE "ABCDEFGHIJ". NC2184.2 +005100 01 ID1-XN-12 PIC X(12) VALUE "ABCDEFGHIJKL". NC2184.2 +005200 01 GRP1-XN-36 PIC X(36) VALUE NC2184.2 +005300 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789". NC2184.2 +005400 01 GRP1-XN-X-36 REDEFINES GRP1-XN-36. NC2184.2 +005500 10 ID1 PIC X(6) OCCURS 6 TIMES. NC2184.2 +005600 01 GRP2-XN-2 PIC XX VALUE "CE". NC2184.2 +005700 01 GRP2-XN-X-2 REDEFINES GRP2-XN-2. NC2184.2 +005800 10 ID2A PIC X OCCURS 2 TIMES. NC2184.2 +005900 01 GRP2-XN-7 PIC X(7) VALUE "BCDEFGH". NC2184.2 +006000 01 GRP2-XN-X-7 REDEFINES GRP2-XN-7. NC2184.2 +006100 10 ID2 PIC X OCCURS 7 TIMES. NC2184.2 +006200 01 ID4-X PIC X VALUE SPACE. NC2184.2 +006300 01 ID4-XJ PIC X JUSTIFIED RIGHT VALUE SPACE. NC2184.2 +006400 01 ID4-XXX PIC XXX VALUE SPACES. NC2184.2 +006500 01 ID4-XXXJ PIC XXX JUST RIGHT VALUE SPACES. NC2184.2 +006600 01 ID4-DU-1V0 PIC 9 VALUE ZERO. NC2184.2 +006700 01 ID4-DS-1V0 PIC S9 VALUE ZERO. NC2184.2 +006800 01 ID4-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +006900 01 ID4-DS-2V0 PIC S99 VALUE ZERO. NC2184.2 +007000 01 ID4-DS-TS-1V0 PIC S9 TRAILING VALUE ZERO. NC2184.2 +007100 01 ID4-DS-LS-1V0 PIC S9 LEADING VALUE ZERO. NC2184.2 +007200 01 GRP4-XN-6. NC2184.2 +007300 10 ID4A-XXXXX PIC X(5). NC2184.2 +007400 10 ID4B-X PIC X. NC2184.2 +007500 01 ID4C-XXXX PIC X(4) VALUE SPACES. NC2184.2 +007600 01 ID4D-X PIC X VALUE SPACE. NC2184.2 +007700 01 GRP4-XN-10. NC2184.2 +007800 10 ID4A-X PIC X. NC2184.2 +007900 10 ID4B-XX PIC XX. NC2184.2 +008000 10 ID4C-XXX PIC XXX. NC2184.2 +008100 10 ID4D-XXXX PIC XXXX. NC2184.2 +008200 01 ASTER-XN-4 PIC X(4) VALUE "****". NC2184.2 +008300 01 ID5-XN-4 PIC X(4) VALUE SPACES. NC2184.2 +008400 01 ID5-XN-4-2 PIC X(4) VALUE SPACES. NC2184.2 +008500 01 ID5-XN-6 PIC X(6) VALUE SPACES. NC2184.2 +008600 01 ID6-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +008700 01 ID6-DU-2V0-2 PIC 99 VALUE ZERO. NC2184.2 +008800 01 ID10-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +008900 01 ID11-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +009000 01 TEST-RESULTS. NC2184.2 +009100 02 FILLER PIC X VALUE SPACE. NC2184.2 +009200 02 FEATURE PIC X(20) VALUE SPACE. NC2184.2 +009300 02 FILLER PIC X VALUE SPACE. NC2184.2 +009400 02 P-OR-F PIC X(5) VALUE SPACE. NC2184.2 +009500 02 FILLER PIC X VALUE SPACE. NC2184.2 +009600 02 PAR-NAME. NC2184.2 +009700 03 FILLER PIC X(19) VALUE SPACE. NC2184.2 +009800 03 PARDOT-X PIC X VALUE SPACE. NC2184.2 +009900 03 DOTVALUE PIC 99 VALUE ZERO. NC2184.2 +010000 02 FILLER PIC X(8) VALUE SPACE. NC2184.2 +010100 02 RE-MARK PIC X(61). NC2184.2 +010200 01 TEST-COMPUTED. NC2184.2 +010300 02 FILLER PIC X(30) VALUE SPACE. NC2184.2 +010400 02 FILLER PIC X(17) VALUE NC2184.2 +010500 " COMPUTED=". NC2184.2 +010600 02 COMPUTED-X. NC2184.2 +010700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2184.2 +010800 03 COMPUTED-N REDEFINES COMPUTED-A NC2184.2 +010900 PIC -9(9).9(9). NC2184.2 +011000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2184.2 +011100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2184.2 +011200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2184.2 +011300 03 CM-18V0 REDEFINES COMPUTED-A. NC2184.2 +011400 04 COMPUTED-18V0 PIC -9(18). NC2184.2 +011500 04 FILLER PIC X. NC2184.2 +011600 03 FILLER PIC X(50) VALUE SPACE. NC2184.2 +011700 01 TEST-CORRECT. NC2184.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2184.2 +011900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2184.2 +012000 02 CORRECT-X. NC2184.2 +012100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2184.2 +012200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2184.2 +012300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2184.2 +012400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2184.2 +012500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2184.2 +012600 03 CR-18V0 REDEFINES CORRECT-A. NC2184.2 +012700 04 CORRECT-18V0 PIC -9(18). NC2184.2 +012800 04 FILLER PIC X. NC2184.2 +012900 03 FILLER PIC X(2) VALUE SPACE. NC2184.2 +013000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2184.2 +013100 01 CCVS-C-1. NC2184.2 +013200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2184.2 +013300- "SS PARAGRAPH-NAME NC2184.2 +013400- " REMARKS". NC2184.2 +013500 02 FILLER PIC X(20) VALUE SPACE. NC2184.2 +013600 01 CCVS-C-2. NC2184.2 +013700 02 FILLER PIC X VALUE SPACE. NC2184.2 +013800 02 FILLER PIC X(6) VALUE "TESTED". NC2184.2 +013900 02 FILLER PIC X(15) VALUE SPACE. NC2184.2 +014000 02 FILLER PIC X(4) VALUE "FAIL". NC2184.2 +014100 02 FILLER PIC X(94) VALUE SPACE. NC2184.2 +014200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2184.2 +014300 01 REC-CT PIC 99 VALUE ZERO. NC2184.2 +014400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2184.2 +014900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2184.2 +015000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2184.2 +015100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2184.2 +015200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2184.2 +015300 01 CCVS-H-1. NC2184.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2184.2 +015500 02 FILLER PIC X(42) VALUE NC2184.2 +015600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2184.2 +015700 02 FILLER PIC X(39) VALUE SPACES. NC2184.2 +015800 01 CCVS-H-2A. NC2184.2 +015900 02 FILLER PIC X(40) VALUE SPACE. NC2184.2 +016000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2184.2 +016100 02 FILLER PIC XXXX VALUE NC2184.2 +016200 "4.2 ". NC2184.2 +016300 02 FILLER PIC X(28) VALUE NC2184.2 +016400 " COPY - NOT FOR DISTRIBUTION". NC2184.2 +016500 02 FILLER PIC X(41) VALUE SPACE. NC2184.2 +016600 NC2184.2 +016700 01 CCVS-H-2B. NC2184.2 +016800 02 FILLER PIC X(15) VALUE NC2184.2 +016900 "TEST RESULT OF ". NC2184.2 +017000 02 TEST-ID PIC X(9). NC2184.2 +017100 02 FILLER PIC X(4) VALUE NC2184.2 +017200 " IN ". NC2184.2 +017300 02 FILLER PIC X(12) VALUE NC2184.2 +017400 " HIGH ". NC2184.2 +017500 02 FILLER PIC X(22) VALUE NC2184.2 +017600 " LEVEL VALIDATION FOR ". NC2184.2 +017700 02 FILLER PIC X(58) VALUE NC2184.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +017900 01 CCVS-H-3. NC2184.2 +018000 02 FILLER PIC X(34) VALUE NC2184.2 +018100 " FOR OFFICIAL USE ONLY ". NC2184.2 +018200 02 FILLER PIC X(58) VALUE NC2184.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2184.2 +018400 02 FILLER PIC X(28) VALUE NC2184.2 +018500 " COPYRIGHT 1985 ". NC2184.2 +018600 01 CCVS-E-1. NC2184.2 +018700 02 FILLER PIC X(52) VALUE SPACE. NC2184.2 +018800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2184.2 +018900 02 ID-AGAIN PIC X(9). NC2184.2 +019000 02 FILLER PIC X(45) VALUE SPACES. NC2184.2 +019100 01 CCVS-E-2. NC2184.2 +019200 02 FILLER PIC X(31) VALUE SPACE. NC2184.2 +019300 02 FILLER PIC X(21) VALUE SPACE. NC2184.2 +019400 02 CCVS-E-2-2. NC2184.2 +019500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2184.2 +019600 03 FILLER PIC X VALUE SPACE. NC2184.2 +019700 03 ENDER-DESC PIC X(44) VALUE NC2184.2 +019800 "ERRORS ENCOUNTERED". NC2184.2 +019900 01 CCVS-E-3. NC2184.2 +020000 02 FILLER PIC X(22) VALUE NC2184.2 +020100 " FOR OFFICIAL USE ONLY". NC2184.2 +020200 02 FILLER PIC X(12) VALUE SPACE. NC2184.2 +020300 02 FILLER PIC X(58) VALUE NC2184.2 +020400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +020500 02 FILLER PIC X(13) VALUE SPACE. NC2184.2 +020600 02 FILLER PIC X(15) VALUE NC2184.2 +020700 " COPYRIGHT 1985". NC2184.2 +020800 01 CCVS-E-4. NC2184.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2184.2 +021000 02 FILLER PIC X(4) VALUE " OF ". NC2184.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2184.2 +021200 02 FILLER PIC X(40) VALUE NC2184.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2184.2 +021400 01 XXINFO. NC2184.2 +021500 02 FILLER PIC X(19) VALUE NC2184.2 +021600 "*** INFORMATION ***". NC2184.2 +021700 02 INFO-TEXT. NC2184.2 +021800 04 FILLER PIC X(8) VALUE SPACE. NC2184.2 +021900 04 XXCOMPUTED PIC X(20). NC2184.2 +022000 04 FILLER PIC X(5) VALUE SPACE. NC2184.2 +022100 04 XXCORRECT PIC X(20). NC2184.2 +022200 02 INF-ANSI-REFERENCE PIC X(48). NC2184.2 +022300 01 HYPHEN-LINE. NC2184.2 +022400 02 FILLER PIC IS X VALUE IS SPACE. NC2184.2 +022500 02 FILLER PIC IS X(65) VALUE IS "************************NC2184.2 +022600- "*****************************************". NC2184.2 +022700 02 FILLER PIC IS X(54) VALUE IS "************************NC2184.2 +022800- "******************************". NC2184.2 +022900 01 CCVS-PGM-ID PIC X(9) VALUE NC2184.2 +023000 "NC218A". NC2184.2 +023100 PROCEDURE DIVISION. NC2184.2 +023200 CCVS1 SECTION. NC2184.2 +023300 OPEN-FILES. NC2184.2 +023400 OPEN OUTPUT PRINT-FILE. NC2184.2 +023500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2184.2 +023600 MOVE SPACE TO TEST-RESULTS. NC2184.2 +023700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2184.2 +023800 GO TO CCVS1-EXIT. NC2184.2 +023900 CLOSE-FILES. NC2184.2 +024000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2184.2 +024100 TERMINATE-CCVS. NC2184.2 +024200S EXIT PROGRAM. NC2184.2 +024300STERMINATE-CALL. NC2184.2 +024400 STOP RUN. NC2184.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2184.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2184.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2184.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2184.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. NC2184.2 +025000 PRINT-DETAIL. NC2184.2 +025100 IF REC-CT NOT EQUAL TO ZERO NC2184.2 +025200 MOVE "." TO PARDOT-X NC2184.2 +025300 MOVE REC-CT TO DOTVALUE. NC2184.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2184.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2184.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2184.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2184.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2184.2 +025900 MOVE SPACE TO CORRECT-X. NC2184.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2184.2 +026100 MOVE SPACE TO RE-MARK. NC2184.2 +026200 HEAD-ROUTINE. NC2184.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2184.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2184.2 +026700 COLUMN-NAMES-ROUTINE. NC2184.2 +026800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +026900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +027100 END-ROUTINE. NC2184.2 +027200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2184.2 +027300 END-RTN-EXIT. NC2184.2 +027400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +027500 END-ROUTINE-1. NC2184.2 +027600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2184.2 +027700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2184.2 +027800 ADD PASS-COUNTER TO ERROR-HOLD. NC2184.2 +027900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2184.2 +028000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2184.2 +028100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2184.2 +028200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2184.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2184.2 +028400 END-ROUTINE-12. NC2184.2 +028500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2184.2 +028600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2184.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2184.2 +028800 ELSE NC2184.2 +028900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2184.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2184.2 +029100 PERFORM WRITE-LINE. NC2184.2 +029200 END-ROUTINE-13. NC2184.2 +029300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2184.2 +029400 MOVE "NO " TO ERROR-TOTAL ELSE NC2184.2 +029500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2184.2 +029600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2184.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +029800 IF INSPECT-COUNTER EQUAL TO ZERO NC2184.2 +029900 MOVE "NO " TO ERROR-TOTAL NC2184.2 +030000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2184.2 +030100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2184.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +030300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +030400 WRITE-LINE. NC2184.2 +030500 ADD 1 TO RECORD-COUNT. NC2184.2 +030600Y IF RECORD-COUNT GREATER 50 NC2184.2 +030700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2184.2 +030800Y MOVE SPACE TO DUMMY-RECORD NC2184.2 +030900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2184.2 +031000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2184.2 +031100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2184.2 +031200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2184.2 +031300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2184.2 +031400Y MOVE ZERO TO RECORD-COUNT. NC2184.2 +031500 PERFORM WRT-LN. NC2184.2 +031600 WRT-LN. NC2184.2 +031700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2184.2 +031800 MOVE SPACE TO DUMMY-RECORD. NC2184.2 +031900 BLANK-LINE-PRINT. NC2184.2 +032000 PERFORM WRT-LN. NC2184.2 +032100 FAIL-ROUTINE. NC2184.2 +032200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2184.2 +032300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2184.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2184.2 +032500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2184.2 +032600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +032700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2184.2 +032800 GO TO FAIL-ROUTINE-EX. NC2184.2 +032900 FAIL-ROUTINE-WRITE. NC2184.2 +033000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2184.2 +033100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2184.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2184.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2184.2 +033400 FAIL-ROUTINE-EX. EXIT. NC2184.2 +033500 BAIL-OUT. NC2184.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2184.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2184.2 +033800 BAIL-OUT-WRITE. NC2184.2 +033900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2184.2 +034000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2184.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2184.2 +034300 BAIL-OUT-EX. EXIT. NC2184.2 +034400 CCVS1-EXIT. NC2184.2 +034500 EXIT. NC2184.2 +034600 SECT-NC218A-001 SECTION. NC2184.2 +034700 NC2184.2 +034800 UST-INIT-GF-1. NC2184.2 +034900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +035000 MOVE "UST-TEST-GF-1" TO PAR-NAME. NC2184.2 +035100 MOVE "PIC X " TO FEATURE. NC2184.2 +035200 MOVE ZERO TO ID4-X. NC2184.2 +035300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +035400 MOVE "****" TO ID5-XN-4. NC2184.2 +035500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +035600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +035700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +035800 MOVE 1 TO REC-CT. NC2184.2 +035900 UST-TEST-GF-1. NC2184.2 +036000 UNSTRING ID1-XN-7 DELIMITED BY ZERO NC2184.2 +036100 INTO ID4-X DELIMITER IN ID5-XN-4 NC2184.2 +036200 COUNT IN ID6-DU-2V0 NC2184.2 +036300 WITH POINTER ID10-DU-2V0 NC2184.2 +036400 TALLYING ID11-DU-2V0 NC2184.2 +036500 ON OVERFLOW PERFORM PASS NC2184.2 +036600 GO TO UST-WRITE-GF-1. NC2184.2 +036700 GO TO UST-FAIL-GF-1. NC2184.2 +036800 UST-DELETE-GF-1. NC2184.2 +036900 PERFORM DE-LETE. NC2184.2 +037000 PERFORM PRINT-DETAIL. NC2184.2 +037100 GO TO UST-INIT-GF-2. NC2184.2 +037200 UST-FAIL-GF-1. NC2184.2 +037300 PERFORM FAIL. NC2184.2 +037400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2184.2 +037500 UST-WRITE-GF-1. NC2184.2 +037600 PERFORM PRINT-DETAIL. NC2184.2 +037700* NC2184.2 +037800 UST-TEST-GF-1-1. NC2184.2 +037900 ADD 1 TO REC-CT. NC2184.2 +038000 IF ID4-X = "1" NC2184.2 +038100 PERFORM PASS NC2184.2 +038200 GO TO UST-WRITE-GF-1-1 NC2184.2 +038300 ELSE NC2184.2 +038400 GO TO UST-FAIL-GF-1-1. NC2184.2 +038500 UST-DELETE-GF-1-1. NC2184.2 +038600 PERFORM DE-LETE. NC2184.2 +038700 GO TO UST-WRITE-GF-1-1. NC2184.2 +038800 UST-FAIL-GF-1-1. NC2184.2 +038900 PERFORM FAIL NC2184.2 +039000 MOVE ID4-X TO COMPUTED-A NC2184.2 +039100 MOVE "1" TO CORRECT-A. NC2184.2 +039200 UST-WRITE-GF-1-1. NC2184.2 +039300 PERFORM PRINT-DETAIL. NC2184.2 +039400* NC2184.2 +039500 UST-TEST-GF-1-2. NC2184.2 +039600 ADD 1 TO REC-CT. NC2184.2 +039700 IF ID5-XN-4 = "0 " NC2184.2 +039800 PERFORM PASS NC2184.2 +039900 GO TO UST-WRITE-GF-1-2 NC2184.2 +040000 ELSE NC2184.2 +040100 GO TO UST-FAIL-GF-1-2. NC2184.2 +040200 UST-DELETE-GF-1-2. NC2184.2 +040300 PERFORM DE-LETE. NC2184.2 +040400 GO TO UST-WRITE-GF-1-2. NC2184.2 +040500 UST-FAIL-GF-1-2. NC2184.2 +040600 PERFORM FAIL NC2184.2 +040700 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +040800 MOVE "0 " TO CORRECT-A. NC2184.2 +040900 UST-WRITE-GF-1-2. NC2184.2 +041000 PERFORM PRINT-DETAIL. NC2184.2 +041100* NC2184.2 +041200 UST-TEST-GF-1-3. NC2184.2 +041300 ADD 1 TO REC-CT. NC2184.2 +041400 IF ID6-DU-2V0 = 2 NC2184.2 +041500 PERFORM PASS NC2184.2 +041600 GO TO UST-WRITE-GF-1-3 NC2184.2 +041700 ELSE NC2184.2 +041800 GO TO UST-FAIL-GF-1-3. NC2184.2 +041900 UST-DELETE-GF-1-3. NC2184.2 +042000 PERFORM DE-LETE. NC2184.2 +042100 GO TO UST-WRITE-GF-1-3. NC2184.2 +042200 UST-FAIL-GF-1-3. NC2184.2 +042300 PERFORM FAIL NC2184.2 +042400 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +042500 MOVE 2 TO CORRECT-N. NC2184.2 +042600 UST-WRITE-GF-1-3. NC2184.2 +042700 PERFORM PRINT-DETAIL. NC2184.2 +042800* NC2184.2 +042900 UST-TEST-GF-1-4. NC2184.2 +043000 ADD 1 TO REC-CT. NC2184.2 +043100 IF ID10-DU-2V0 = 4 NC2184.2 +043200 PERFORM PASS NC2184.2 +043300 GO TO UST-WRITE-GF-1-4 NC2184.2 +043400 ELSE NC2184.2 +043500 GO TO UST-FAIL-GF-1-4. NC2184.2 +043600 UST-DELETE-GF-1-4. NC2184.2 +043700 PERFORM DE-LETE. NC2184.2 +043800 GO TO UST-WRITE-GF-1-4. NC2184.2 +043900 UST-FAIL-GF-1-4. NC2184.2 +044000 PERFORM FAIL NC2184.2 +044100 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +044200 MOVE 4 TO CORRECT-N. NC2184.2 +044300 UST-WRITE-GF-1-4. NC2184.2 +044400 PERFORM PRINT-DETAIL. NC2184.2 +044500* NC2184.2 +044600 UST-TEST-GF-1-5. NC2184.2 +044700 ADD 1 TO REC-CT. NC2184.2 +044800 IF ID11-DU-2V0 = 1 NC2184.2 +044900 PERFORM PASS NC2184.2 +045000 GO TO UST-WRITE-GF-1-5 NC2184.2 +045100 ELSE NC2184.2 +045200 GO TO UST-FAIL-GF-1-5. NC2184.2 +045300 UST-DELETE-GF-1-5. NC2184.2 +045400 PERFORM DE-LETE. NC2184.2 +045500 GO TO UST-WRITE-GF-1-5. NC2184.2 +045600 UST-FAIL-GF-1-5. NC2184.2 +045700 PERFORM FAIL NC2184.2 +045800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +045900 MOVE 1 TO CORRECT-N. NC2184.2 +046000 UST-WRITE-GF-1-5. NC2184.2 +046100 PERFORM PRINT-DETAIL. NC2184.2 +046200* NC2184.2 +046300 UST-INIT-GF-2. NC2184.2 +046400 MOVE "UST-TEST-GF-2" TO PAR-NAME. NC2184.2 +046500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +046600 MOVE "PIC X JUST" TO FEATURE. NC2184.2 +046700 MOVE "1200000" TO ID1-XN-7. NC2184.2 +046800 MOVE ZERO TO ID4-XJ. NC2184.2 +046900 MOVE "****" TO ID5-XN-4. NC2184.2 +047000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +047100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +047200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +047300 MOVE 1 TO REC-CT. NC2184.2 +047400* NC2184.2 +047500 UST-TEST-GF-2. NC2184.2 +047600 UNSTRING ID1-XN-7 DELIMITED ZERO INTO ID4-XJ NC2184.2 +047700 DELIMITER ID5-XN-4 NC2184.2 +047800 COUNT ID6-DU-2V0 NC2184.2 +047900 POINTER ID10-DU-2V0 NC2184.2 +048000 TALLYING ID11-DU-2V0 NC2184.2 +048100 OVERFLOW PERFORM PASS NC2184.2 +048200 GO TO UST-WRITE-GF-2. NC2184.2 +048300 GO TO UST-FAIL-GF-2. NC2184.2 +048400 UST-DELETE-GF-2. NC2184.2 +048500 PERFORM DE-LETE. NC2184.2 +048600 PERFORM PRINT-DETAIL. NC2184.2 +048700 GO TO UST-INIT-GF-3. NC2184.2 +048800 UST-FAIL-GF-2. NC2184.2 +048900 PERFORM FAIL. NC2184.2 +049000 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +049100 UST-WRITE-GF-2. NC2184.2 +049200 PERFORM PRINT-DETAIL. NC2184.2 +049300* NC2184.2 +049400 UST-TEST-GF-2-1. NC2184.2 +049500 ADD 1 TO REC-CT. NC2184.2 +049600 IF ID4-XJ = "2" NC2184.2 +049700 PERFORM PASS NC2184.2 +049800 GO TO UST-WRITE-GF-2-1 NC2184.2 +049900 ELSE NC2184.2 +050000 GO TO UST-FAIL-GF-2-1. NC2184.2 +050100 UST-DELETE-GF-2-1. NC2184.2 +050200 PERFORM DE-LETE. NC2184.2 +050300 GO TO UST-WRITE-GF-2-1. NC2184.2 +050400 UST-FAIL-GF-2-1. NC2184.2 +050500 PERFORM FAIL NC2184.2 +050600 MOVE ID4-XJ TO COMPUTED-A NC2184.2 +050700 MOVE "2" TO CORRECT-A. NC2184.2 +050800 UST-WRITE-GF-2-1. NC2184.2 +050900 PERFORM PRINT-DETAIL. NC2184.2 +051000* NC2184.2 +051100 UST-TEST-GF-2-2. NC2184.2 +051200 ADD 1 TO REC-CT. NC2184.2 +051300 IF ID5-XN-4 = "0 " NC2184.2 +051400 PERFORM PASS NC2184.2 +051500 GO TO UST-WRITE-GF-2-2 NC2184.2 +051600 ELSE NC2184.2 +051700 GO TO UST-FAIL-GF-2-2. NC2184.2 +051800 UST-DELETE-GF-2-2. NC2184.2 +051900 PERFORM DE-LETE. NC2184.2 +052000 GO TO UST-WRITE-GF-2-2. NC2184.2 +052100 UST-FAIL-GF-2-2. NC2184.2 +052200 PERFORM FAIL NC2184.2 +052300 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +052400 MOVE "0 " TO CORRECT-A. NC2184.2 +052500 UST-WRITE-GF-2-2. NC2184.2 +052600 PERFORM PRINT-DETAIL. NC2184.2 +052700* NC2184.2 +052800 UST-TEST-GF-2-3. NC2184.2 +052900 ADD 1 TO REC-CT. NC2184.2 +053000 IF ID6-DU-2V0 = 2 NC2184.2 +053100 PERFORM PASS NC2184.2 +053200 GO TO UST-WRITE-GF-2-3 NC2184.2 +053300 ELSE NC2184.2 +053400 GO TO UST-FAIL-GF-2-3. NC2184.2 +053500 UST-DELETE-GF-2-3. NC2184.2 +053600 PERFORM DE-LETE. NC2184.2 +053700 GO TO UST-WRITE-GF-2-3. NC2184.2 +053800 UST-FAIL-GF-2-3. NC2184.2 +053900 PERFORM FAIL NC2184.2 +054000 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +054100 MOVE 2 TO CORRECT-N. NC2184.2 +054200 UST-WRITE-GF-2-3. NC2184.2 +054300 PERFORM PRINT-DETAIL. NC2184.2 +054400* NC2184.2 +054500 UST-TEST-GF-2-4. NC2184.2 +054600 ADD 1 TO REC-CT. NC2184.2 +054700 IF ID10-DU-2V0 = 4 NC2184.2 +054800 PERFORM PASS NC2184.2 +054900 GO TO UST-WRITE-GF-2-4 NC2184.2 +055000 ELSE NC2184.2 +055100 GO TO UST-FAIL-GF-2-4. NC2184.2 +055200 UST-DELETE-GF-2-4. NC2184.2 +055300 PERFORM DE-LETE. NC2184.2 +055400 GO TO UST-WRITE-GF-2-4. NC2184.2 +055500 UST-FAIL-GF-2-4. NC2184.2 +055600 PERFORM FAIL NC2184.2 +055700 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +055800 MOVE 4 TO CORRECT-N. NC2184.2 +055900 UST-WRITE-GF-2-4. NC2184.2 +056000 PERFORM PRINT-DETAIL. NC2184.2 +056100* NC2184.2 +056200 UST-TEST-GF-2-5. NC2184.2 +056300 ADD 1 TO REC-CT. NC2184.2 +056400 IF ID11-DU-2V0 = 1 NC2184.2 +056500 PERFORM PASS NC2184.2 +056600 GO TO UST-WRITE-GF-2-5 NC2184.2 +056700 ELSE NC2184.2 +056800 GO TO UST-FAIL-GF-2-5. NC2184.2 +056900 UST-DELETE-GF-2-5. NC2184.2 +057000 PERFORM DE-LETE. NC2184.2 +057100 GO TO UST-WRITE-GF-2-5. NC2184.2 +057200 UST-FAIL-GF-2-5. NC2184.2 +057300 PERFORM FAIL NC2184.2 +057400 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +057500 MOVE 1 TO CORRECT-N. NC2184.2 +057600 UST-WRITE-GF-2-5. NC2184.2 +057700 PERFORM PRINT-DETAIL. NC2184.2 +057800* NC2184.2 +057900 UST-INIT-GF-3. NC2184.2 +058000 MOVE "UST-TEST-GF-3" TO PAR-NAME. NC2184.2 +058100 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +058200 MOVE "PIC XXX" TO FEATURE. NC2184.2 +058300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +058400 MOVE ZERO TO ID4-XXX. NC2184.2 +058500 MOVE "****" TO ID5-XN-4. NC2184.2 +058600 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +058700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +058800 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +058900 MOVE 1 TO REC-CT. NC2184.2 +059000* NC2184.2 +059100 UST-TEST-GF-3. NC2184.2 +059200 UNSTRING ID1-XN-7 DELIMITED "0" INTO ID4-XXX NC2184.2 +059300 DELIMITER ID5-XN-4 NC2184.2 +059400 COUNT ID6-DU-2V0 NC2184.2 +059500 POINTER ID10-DU-2V0 NC2184.2 +059600 TALLYING ID11-DU-2V0. NC2184.2 +059700 GO TO UST-TEST-GF-3-1. NC2184.2 +059800 UST-DELETE-GF-3. NC2184.2 +059900 PERFORM DE-LETE. NC2184.2 +060000 PERFORM PRINT-DETAIL. NC2184.2 +060100 GO TO UST-INIT-GF-4. NC2184.2 +060200* NC2184.2 +060300 UST-TEST-GF-3-1. NC2184.2 +060400 IF ID4-XXX = "12 " NC2184.2 +060500 PERFORM PASS NC2184.2 +060600 GO TO UST-WRITE-GF-3-1 NC2184.2 +060700 ELSE NC2184.2 +060800 GO TO UST-FAIL-GF-3-1. NC2184.2 +060900 UST-DELETE-GF-3-1. NC2184.2 +061000 PERFORM DE-LETE. NC2184.2 +061100 GO TO UST-WRITE-GF-3-1. NC2184.2 +061200 UST-FAIL-GF-3-1. NC2184.2 +061300 PERFORM FAIL NC2184.2 +061400 MOVE ID4-XXX TO COMPUTED-A NC2184.2 +061500 MOVE "12 " TO CORRECT-A. NC2184.2 +061600 UST-WRITE-GF-3-1. NC2184.2 +061700 PERFORM PRINT-DETAIL. NC2184.2 +061800* NC2184.2 +061900 UST-TEST-GF-3-2. NC2184.2 +062000 ADD 1 TO REC-CT. NC2184.2 +062100 IF ID5-XN-4 = "0 " NC2184.2 +062200 PERFORM PASS NC2184.2 +062300 GO TO UST-WRITE-GF-3-2 NC2184.2 +062400 ELSE NC2184.2 +062500 GO TO UST-FAIL-GF-3-2. NC2184.2 +062600 UST-DELETE-GF-3-2. NC2184.2 +062700 PERFORM DE-LETE. NC2184.2 +062800 GO TO UST-WRITE-GF-3-2. NC2184.2 +062900 UST-FAIL-GF-3-2. NC2184.2 +063000 PERFORM FAIL NC2184.2 +063100 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +063200 MOVE "0 " TO CORRECT-A. NC2184.2 +063300 UST-WRITE-GF-3-2. NC2184.2 +063400 PERFORM PRINT-DETAIL. NC2184.2 +063500* NC2184.2 +063600 UST-TEST-GF-3-3. NC2184.2 +063700 ADD 1 TO REC-CT. NC2184.2 +063800 IF ID6-DU-2V0 = 2 NC2184.2 +063900 PERFORM PASS NC2184.2 +064000 GO TO UST-WRITE-GF-3-3 NC2184.2 +064100 ELSE NC2184.2 +064200 GO TO UST-FAIL-GF-3-3. NC2184.2 +064300 UST-DELETE-GF-3-3. NC2184.2 +064400 PERFORM DE-LETE. NC2184.2 +064500 GO TO UST-WRITE-GF-3-3. NC2184.2 +064600 UST-FAIL-GF-3-3. NC2184.2 +064700 PERFORM FAIL NC2184.2 +064800 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +064900 MOVE 2 TO CORRECT-N. NC2184.2 +065000 UST-WRITE-GF-3-3. NC2184.2 +065100 PERFORM PRINT-DETAIL. NC2184.2 +065200* NC2184.2 +065300 UST-TEST-GF-3-4. NC2184.2 +065400 ADD 1 TO REC-CT. NC2184.2 +065500 IF ID10-DU-2V0 = 4 NC2184.2 +065600 PERFORM PASS NC2184.2 +065700 GO TO UST-WRITE-GF-3-4 NC2184.2 +065800 ELSE NC2184.2 +065900 GO TO UST-FAIL-GF-3-4. NC2184.2 +066000 UST-DELETE-GF-3-4. NC2184.2 +066100 PERFORM DE-LETE. NC2184.2 +066200 GO TO UST-WRITE-GF-3-4. NC2184.2 +066300 UST-FAIL-GF-3-4. NC2184.2 +066400 PERFORM FAIL NC2184.2 +066500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +066600 MOVE 4 TO CORRECT-N. NC2184.2 +066700 UST-WRITE-GF-3-4. NC2184.2 +066800 PERFORM PRINT-DETAIL. NC2184.2 +066900* NC2184.2 +067000 UST-TEST-GF-3-5. NC2184.2 +067100 ADD 1 TO REC-CT. NC2184.2 +067200 IF ID11-DU-2V0 = 1 NC2184.2 +067300 PERFORM PASS NC2184.2 +067400 GO TO UST-WRITE-GF-3-5 NC2184.2 +067500 ELSE NC2184.2 +067600 GO TO UST-FAIL-GF-3-5. NC2184.2 +067700 UST-DELETE-GF-3-5. NC2184.2 +067800 PERFORM DE-LETE. NC2184.2 +067900 GO TO UST-WRITE-GF-3-5. NC2184.2 +068000 UST-FAIL-GF-3-5. NC2184.2 +068100 PERFORM FAIL NC2184.2 +068200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +068300 MOVE 1 TO CORRECT-N. NC2184.2 +068400 UST-WRITE-GF-3-5. NC2184.2 +068500 PERFORM PRINT-DETAIL. NC2184.2 +068600* NC2184.2 +068700 UST-INIT-GF-4. NC2184.2 +068800 MOVE "UST-TEST-GF-4" TO PAR-NAME. NC2184.2 +068900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +069000 MOVE "PIC XXX JUST" TO FEATURE. NC2184.2 +069100 MOVE "1200000" TO ID1-XN-7. NC2184.2 +069200 MOVE "0" TO ZERO-XN-1. NC2184.2 +069300 MOVE ZERO TO ID4-XXXJ. NC2184.2 +069400 MOVE "****" TO ID5-XN-4. NC2184.2 +069500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +069600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +069700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +069800 MOVE 1 TO REC-CT. NC2184.2 +069900* NC2184.2 +070000 UST-TEST-GF-4. NC2184.2 +070100 UNSTRING ID1-XN-7 DELIMITED BY ZERO-XN-1 INTO ID4-XXXJ NC2184.2 +070200 DELIMITER ID5-XN-4 NC2184.2 +070300 COUNT IN ID6-DU-2V0 NC2184.2 +070400 POINTER ID10-DU-2V0 NC2184.2 +070500 TALLYING IN ID11-DU-2V0. NC2184.2 +070600 GO TO UST-TEST-GF-4-1. NC2184.2 +070700 UST-DELETE-GF-4. NC2184.2 +070800 PERFORM DE-LETE. NC2184.2 +070900 PERFORM PRINT-DETAIL. NC2184.2 +071000 GO TO UST-INIT-GF-5. NC2184.2 +071100* NC2184.2 +071200 UST-TEST-GF-4-1. NC2184.2 +071300 IF ID4-XXXJ = " 12" NC2184.2 +071400 PERFORM PASS NC2184.2 +071500 GO TO UST-WRITE-GF-4-1 NC2184.2 +071600 ELSE NC2184.2 +071700 GO TO UST-FAIL-GF-4-1. NC2184.2 +071800 UST-DELETE-GF-4-1. NC2184.2 +071900 PERFORM DE-LETE. NC2184.2 +072000 GO TO UST-WRITE-GF-4-1. NC2184.2 +072100 UST-FAIL-GF-4-1. NC2184.2 +072200 PERFORM FAIL NC2184.2 +072300 MOVE ID4-XXXJ TO COMPUTED-A NC2184.2 +072400 MOVE " 12" TO CORRECT-A. NC2184.2 +072500 UST-WRITE-GF-4-1. NC2184.2 +072600 PERFORM PRINT-DETAIL. NC2184.2 +072700* NC2184.2 +072800 UST-TEST-GF-4-2. NC2184.2 +072900 ADD 1 TO REC-CT. NC2184.2 +073000 IF ID5-XN-4 = "0 " NC2184.2 +073100 PERFORM PASS NC2184.2 +073200 GO TO UST-WRITE-GF-4-2 NC2184.2 +073300 ELSE NC2184.2 +073400 GO TO UST-FAIL-GF-4-2. NC2184.2 +073500 UST-DELETE-GF-4-2. NC2184.2 +073600 PERFORM DE-LETE. NC2184.2 +073700 GO TO UST-WRITE-GF-4-2. NC2184.2 +073800 UST-FAIL-GF-4-2. NC2184.2 +073900 PERFORM FAIL NC2184.2 +074000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +074100 MOVE "0 " TO CORRECT-A. NC2184.2 +074200 UST-WRITE-GF-4-2. NC2184.2 +074300 PERFORM PRINT-DETAIL. NC2184.2 +074400* NC2184.2 +074500 UST-TEST-GF-4-3. NC2184.2 +074600 ADD 1 TO REC-CT. NC2184.2 +074700 IF ID6-DU-2V0 = 2 NC2184.2 +074800 PERFORM PASS NC2184.2 +074900 GO TO UST-WRITE-GF-4-3 NC2184.2 +075000 ELSE NC2184.2 +075100 GO TO UST-FAIL-GF-4-3. NC2184.2 +075200 UST-DELETE-GF-4-3. NC2184.2 +075300 PERFORM DE-LETE. NC2184.2 +075400 GO TO UST-WRITE-GF-4-3. NC2184.2 +075500 UST-FAIL-GF-4-3. NC2184.2 +075600 PERFORM FAIL NC2184.2 +075700 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +075800 MOVE 2 TO CORRECT-N. NC2184.2 +075900 UST-WRITE-GF-4-3. NC2184.2 +076000 PERFORM PRINT-DETAIL. NC2184.2 +076100* NC2184.2 +076200 UST-TEST-GF-4-4. NC2184.2 +076300 ADD 1 TO REC-CT. NC2184.2 +076400 IF ID10-DU-2V0 = 4 NC2184.2 +076500 PERFORM PASS NC2184.2 +076600 GO TO UST-WRITE-GF-4-4 NC2184.2 +076700 ELSE NC2184.2 +076800 GO TO UST-FAIL-GF-4-4. NC2184.2 +076900 UST-DELETE-GF-4-4. NC2184.2 +077000 PERFORM DE-LETE. NC2184.2 +077100 GO TO UST-WRITE-GF-4-4. NC2184.2 +077200 UST-FAIL-GF-4-4. NC2184.2 +077300 PERFORM FAIL NC2184.2 +077400 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +077500 MOVE 4 TO CORRECT-N. NC2184.2 +077600 UST-WRITE-GF-4-4. NC2184.2 +077700 PERFORM PRINT-DETAIL. NC2184.2 +077800* NC2184.2 +077900 UST-TEST-GF-4-5. NC2184.2 +078000 ADD 1 TO REC-CT. NC2184.2 +078100 IF ID11-DU-2V0 = 1 NC2184.2 +078200 PERFORM PASS NC2184.2 +078300 GO TO UST-WRITE-GF-4-5 NC2184.2 +078400 ELSE NC2184.2 +078500 GO TO UST-FAIL-GF-4-5. NC2184.2 +078600 UST-DELETE-GF-4-5. NC2184.2 +078700 PERFORM DE-LETE. NC2184.2 +078800 GO TO UST-WRITE-GF-4-5. NC2184.2 +078900 UST-FAIL-GF-4-5. NC2184.2 +079000 PERFORM FAIL NC2184.2 +079100 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +079200 MOVE 1 TO CORRECT-N. NC2184.2 +079300 UST-WRITE-GF-4-5. NC2184.2 +079400 PERFORM PRINT-DETAIL. NC2184.2 +079500* NC2184.2 +079600 UST-INIT-GF-5. NC2184.2 +079700 MOVE "UST-TEST-GF-5" TO PAR-NAME. NC2184.2 +079800 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +079900 MOVE "PIC 9" TO FEATURE. NC2184.2 +080000 MOVE ZERO TO ID4-DU-1V0. NC2184.2 +080100 MOVE "****" TO ID5-XN-4. NC2184.2 +080200 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +080300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +080400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +080500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +080600 MOVE 1 TO REC-CT. NC2184.2 +080700* NC2184.2 +080800 UST-TEST-GF-5. NC2184.2 +080900 UNSTRING ID1-XN-7 DELIMITED "0" INTO ID4-DU-1V0 NC2184.2 +081000 DELIMITER IN ID5-XN-4 NC2184.2 +081100 COUNT ID6-DU-2V0 NC2184.2 +081200 WITH POINTER ID10-DU-2V0 NC2184.2 +081300 TALLYING ID11-DU-2V0. NC2184.2 +081400 GO TO UST-TEST-GF-5-1. NC2184.2 +081500 UST-DELETE-GF-5. NC2184.2 +081600 PERFORM DE-LETE. NC2184.2 +081700 PERFORM PRINT-DETAIL. NC2184.2 +081800 GO TO UST-INIT-GF-6. NC2184.2 +081900* NC2184.2 +082000 UST-TEST-GF-5-1. NC2184.2 +082100 IF ID4-DU-1V0 = 2 NC2184.2 +082200 PERFORM PASS NC2184.2 +082300 GO TO UST-WRITE-GF-5-1 NC2184.2 +082400 ELSE NC2184.2 +082500 GO TO UST-FAIL-GF-5-1. NC2184.2 +082600 UST-DELETE-GF-5-1. NC2184.2 +082700 PERFORM DE-LETE. NC2184.2 +082800 GO TO UST-WRITE-GF-5-1. NC2184.2 +082900 UST-FAIL-GF-5-1. NC2184.2 +083000 PERFORM FAIL NC2184.2 +083100 MOVE ID4-DU-1V0 TO COMPUTED-N NC2184.2 +083200 MOVE 2 TO CORRECT-N. NC2184.2 +083300 UST-WRITE-GF-5-1. NC2184.2 +083400 PERFORM PRINT-DETAIL. NC2184.2 +083500* NC2184.2 +083600 UST-TEST-GF-5-2. NC2184.2 +083700 ADD 1 TO REC-CT. NC2184.2 +083800 IF ID5-XN-4 = "0 " NC2184.2 +083900 PERFORM PASS NC2184.2 +084000 GO TO UST-WRITE-GF-5-2 NC2184.2 +084100 ELSE NC2184.2 +084200 GO TO UST-FAIL-GF-5-2. NC2184.2 +084300 UST-DELETE-GF-5-2. NC2184.2 +084400 PERFORM DE-LETE. NC2184.2 +084500 GO TO UST-WRITE-GF-5-2. NC2184.2 +084600 UST-FAIL-GF-5-2. NC2184.2 +084700 PERFORM FAIL NC2184.2 +084800 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +084900 MOVE "0 " TO CORRECT-A. NC2184.2 +085000 UST-WRITE-GF-5-2. NC2184.2 +085100 PERFORM PRINT-DETAIL. NC2184.2 +085200* NC2184.2 +085300 UST-TEST-GF-5-3. NC2184.2 +085400 ADD 1 TO REC-CT. NC2184.2 +085500 IF ID6-DU-2V0 = 2 NC2184.2 +085600 PERFORM PASS NC2184.2 +085700 GO TO UST-WRITE-GF-5-3 NC2184.2 +085800 ELSE NC2184.2 +085900 GO TO UST-FAIL-GF-5-3. NC2184.2 +086000 UST-DELETE-GF-5-3. NC2184.2 +086100 PERFORM DE-LETE. NC2184.2 +086200 GO TO UST-WRITE-GF-5-3. NC2184.2 +086300 UST-FAIL-GF-5-3. NC2184.2 +086400 PERFORM FAIL NC2184.2 +086500 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +086600 MOVE 2 TO CORRECT-N. NC2184.2 +086700 UST-WRITE-GF-5-3. NC2184.2 +086800 PERFORM PRINT-DETAIL. NC2184.2 +086900* NC2184.2 +087000 UST-TEST-GF-5-4. NC2184.2 +087100 ADD 1 TO REC-CT. NC2184.2 +087200 IF ID10-DU-2V0 = 4 NC2184.2 +087300 PERFORM PASS NC2184.2 +087400 GO TO UST-WRITE-GF-5-4 NC2184.2 +087500 ELSE NC2184.2 +087600 GO TO UST-FAIL-GF-5-4. NC2184.2 +087700 UST-DELETE-GF-5-4. NC2184.2 +087800 PERFORM DE-LETE. NC2184.2 +087900 GO TO UST-WRITE-GF-5-4. NC2184.2 +088000 UST-FAIL-GF-5-4. NC2184.2 +088100 PERFORM FAIL NC2184.2 +088200 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +088300 MOVE 4 TO CORRECT-N. NC2184.2 +088400 UST-WRITE-GF-5-4. NC2184.2 +088500 PERFORM PRINT-DETAIL. NC2184.2 +088600* NC2184.2 +088700 UST-TEST-GF-5-5. NC2184.2 +088800 ADD 1 TO REC-CT. NC2184.2 +088900 IF ID11-DU-2V0 = 1 NC2184.2 +089000 PERFORM PASS NC2184.2 +089100 GO TO UST-WRITE-GF-5-5 NC2184.2 +089200 ELSE NC2184.2 +089300 GO TO UST-FAIL-GF-5-5. NC2184.2 +089400 UST-DELETE-GF-5-5. NC2184.2 +089500 PERFORM DE-LETE. NC2184.2 +089600 GO TO UST-WRITE-GF-5-5. NC2184.2 +089700 UST-FAIL-GF-5-5. NC2184.2 +089800 PERFORM FAIL NC2184.2 +089900 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +090000 MOVE 1 TO CORRECT-N. NC2184.2 +090100 UST-WRITE-GF-5-5. NC2184.2 +090200 PERFORM PRINT-DETAIL. NC2184.2 +090300* NC2184.2 +090400 UST-INIT-GF-6. NC2184.2 +090500 MOVE "UST-TEST-GF-6" TO PAR-NAME. NC2184.2 +090600 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +090700 MOVE "PIC S9" TO FEATURE. NC2184.2 +090800 MOVE ZERO TO ID4-DS-1V0. NC2184.2 +090900 MOVE "****" TO ID5-XN-4. NC2184.2 +091000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +091100 MOVE "1200000" TO ID1-XN-7. NC2184.2 +091200 MOVE 1 TO ID10-DU-2V0. NC2184.2 +091300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +091400 MOVE 1 TO REC-CT. NC2184.2 +091500* NC2184.2 +091600 UST-TEST-GF-6. NC2184.2 +091700 UNSTRING ID1-XN-7 DELIMITED BY ALL ZERO INTO ID4-DS-1V0 NC2184.2 +091800 DELIMITER ID5-XN-4 NC2184.2 +091900 COUNT ID6-DU-2V0 NC2184.2 +092000 POINTER ID10-DU-2V0 NC2184.2 +092100 TALLYING ID11-DU-2V0. NC2184.2 +092200 GO TO UST-TEST-GF-6-1. NC2184.2 +092300 UST-DELETE-GF-6. NC2184.2 +092400 PERFORM DE-LETE. NC2184.2 +092500 PERFORM PRINT-DETAIL. NC2184.2 +092600 GO TO UST-INIT-GF-7. NC2184.2 +092700* NC2184.2 +092800 UST-TEST-GF-6-1. NC2184.2 +092900 IF ID4-DS-1V0 = +2 NC2184.2 +093000 PERFORM PASS NC2184.2 +093100 GO TO UST-WRITE-GF-6-1 NC2184.2 +093200 ELSE NC2184.2 +093300 GO TO UST-FAIL-GF-6-1. NC2184.2 +093400 UST-DELETE-GF-6-1. NC2184.2 +093500 PERFORM DE-LETE. NC2184.2 +093600 GO TO UST-WRITE-GF-6-1. NC2184.2 +093700 UST-FAIL-GF-6-1. NC2184.2 +093800 PERFORM FAIL NC2184.2 +093900 MOVE ID4-DS-1V0 TO COMPUTED-N NC2184.2 +094000 MOVE +2 TO CORRECT-N. NC2184.2 +094100 UST-WRITE-GF-6-1. NC2184.2 +094200 PERFORM PRINT-DETAIL. NC2184.2 +094300* NC2184.2 +094400 UST-TEST-GF-6-2. NC2184.2 +094500 ADD 1 TO REC-CT. NC2184.2 +094600 IF ID5-XN-4 = "0 " NC2184.2 +094700 PERFORM PASS NC2184.2 +094800 GO TO UST-WRITE-GF-6-2 NC2184.2 +094900 ELSE NC2184.2 +095000 GO TO UST-FAIL-GF-6-2. NC2184.2 +095100 UST-DELETE-GF-6-2. NC2184.2 +095200 PERFORM DE-LETE. NC2184.2 +095300 GO TO UST-WRITE-GF-6-2. NC2184.2 +095400 UST-FAIL-GF-6-2. NC2184.2 +095500 PERFORM FAIL NC2184.2 +095600 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +095700 MOVE "0 " TO CORRECT-A. NC2184.2 +095800 UST-WRITE-GF-6-2. NC2184.2 +095900 PERFORM PRINT-DETAIL. NC2184.2 +096000* NC2184.2 +096100 UST-TEST-GF-6-3. NC2184.2 +096200 ADD 1 TO REC-CT. NC2184.2 +096300 IF ID6-DU-2V0 = 2 NC2184.2 +096400 PERFORM PASS NC2184.2 +096500 GO TO UST-WRITE-GF-6-3 NC2184.2 +096600 ELSE NC2184.2 +096700 GO TO UST-FAIL-GF-6-3. NC2184.2 +096800 UST-DELETE-GF-6-3. NC2184.2 +096900 PERFORM DE-LETE. NC2184.2 +097000 GO TO UST-WRITE-GF-6-3. NC2184.2 +097100 UST-FAIL-GF-6-3. NC2184.2 +097200 PERFORM FAIL NC2184.2 +097300 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +097400 MOVE 2 TO CORRECT-N. NC2184.2 +097500 UST-WRITE-GF-6-3. NC2184.2 +097600 PERFORM PRINT-DETAIL. NC2184.2 +097700* NC2184.2 +097800 UST-TEST-GF-6-4. NC2184.2 +097900 ADD 1 TO REC-CT. NC2184.2 +098000 IF ID10-DU-2V0 = 8 NC2184.2 +098100 PERFORM PASS NC2184.2 +098200 GO TO UST-WRITE-GF-6-4 NC2184.2 +098300 ELSE NC2184.2 +098400 GO TO UST-FAIL-GF-6-4. NC2184.2 +098500 UST-DELETE-GF-6-4. NC2184.2 +098600 PERFORM DE-LETE. NC2184.2 +098700 GO TO UST-WRITE-GF-6-4. NC2184.2 +098800 UST-FAIL-GF-6-4. NC2184.2 +098900 PERFORM FAIL NC2184.2 +099000 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +099100 MOVE 8 TO CORRECT-N. NC2184.2 +099200 UST-WRITE-GF-6-4. NC2184.2 +099300 PERFORM PRINT-DETAIL. NC2184.2 +099400* NC2184.2 +099500 UST-TEST-GF-6-5. NC2184.2 +099600 ADD 1 TO REC-CT. NC2184.2 +099700 IF ID11-DU-2V0 = 1 NC2184.2 +099800 PERFORM PASS NC2184.2 +099900 GO TO UST-WRITE-GF-6-5 NC2184.2 +100000 ELSE NC2184.2 +100100 GO TO UST-FAIL-GF-6-5. NC2184.2 +100200 UST-DELETE-GF-6-5. NC2184.2 +100300 PERFORM DE-LETE. NC2184.2 +100400 GO TO UST-WRITE-GF-6-5. NC2184.2 +100500 UST-FAIL-GF-6-5. NC2184.2 +100600 PERFORM FAIL NC2184.2 +100700 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +100800 MOVE 1 TO CORRECT-N. NC2184.2 +100900 UST-WRITE-GF-6-5. NC2184.2 +101000 PERFORM PRINT-DETAIL. NC2184.2 +101100* NC2184.2 +101200 UST-INIT-GF-7. NC2184.2 +101300 MOVE "UST-TEST-GF-7" TO PAR-NAME. NC2184.2 +101400 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +101500 MOVE "PIC 99" TO FEATURE. NC2184.2 +101600 MOVE "1200000" TO ID1-XN-7. NC2184.2 +101700 MOVE ZERO TO ID4-DU-2V0. NC2184.2 +101800 MOVE "****" TO ID5-XN-4. NC2184.2 +101900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +102000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +102100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +102200 MOVE 1 TO REC-CT. NC2184.2 +102300* NC2184.2 +102400 UST-TEST-GF-7. NC2184.2 +102500 UNSTRING ID1-XN-7 DELIMITED ALL "0" INTO ID4-DU-2V0 NC2184.2 +102600 DELIMITER ID5-XN-4 NC2184.2 +102700 COUNT ID6-DU-2V0 NC2184.2 +102800 POINTER ID10-DU-2V0 NC2184.2 +102900 TALLYING ID11-DU-2V0. NC2184.2 +103000 GO TO UST-TEST-GF-7-1. NC2184.2 +103100 UST-DELETE-GF-7. NC2184.2 +103200 PERFORM DE-LETE. NC2184.2 +103300 PERFORM PRINT-DETAIL. NC2184.2 +103400 GO TO UST-INIT-GF-8. NC2184.2 +103500* NC2184.2 +103600 UST-TEST-GF-7-1. NC2184.2 +103700 IF ID4-DU-2V0 = 12 NC2184.2 +103800 PERFORM PASS NC2184.2 +103900 GO TO UST-WRITE-GF-7-1 NC2184.2 +104000 ELSE NC2184.2 +104100 GO TO UST-FAIL-GF-7-1. NC2184.2 +104200 UST-DELETE-GF-7-1. NC2184.2 +104300 PERFORM DE-LETE. NC2184.2 +104400 GO TO UST-WRITE-GF-7-1. NC2184.2 +104500 UST-FAIL-GF-7-1. NC2184.2 +104600 PERFORM FAIL NC2184.2 +104700 MOVE ID4-DU-2V0 TO COMPUTED-N NC2184.2 +104800 MOVE 12 TO CORRECT-N. NC2184.2 +104900 UST-WRITE-GF-7-1. NC2184.2 +105000 PERFORM PRINT-DETAIL. NC2184.2 +105100* NC2184.2 +105200 UST-TEST-GF-7-2. NC2184.2 +105300 ADD 1 TO REC-CT. NC2184.2 +105400 IF ID5-XN-4 = "0 " NC2184.2 +105500 PERFORM PASS NC2184.2 +105600 GO TO UST-WRITE-GF-7-2 NC2184.2 +105700 ELSE NC2184.2 +105800 GO TO UST-FAIL-GF-7-2. NC2184.2 +105900 UST-DELETE-GF-7-2. NC2184.2 +106000 PERFORM DE-LETE. NC2184.2 +106100 GO TO UST-WRITE-GF-7-2. NC2184.2 +106200 UST-FAIL-GF-7-2. NC2184.2 +106300 PERFORM FAIL NC2184.2 +106400 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +106500 MOVE "0 " TO CORRECT-A. NC2184.2 +106600 UST-WRITE-GF-7-2. NC2184.2 +106700 PERFORM PRINT-DETAIL. NC2184.2 +106800* NC2184.2 +106900 UST-TEST-GF-7-3. NC2184.2 +107000 ADD 1 TO REC-CT. NC2184.2 +107100 IF ID6-DU-2V0 = 2 NC2184.2 +107200 PERFORM PASS NC2184.2 +107300 GO TO UST-WRITE-GF-7-3 NC2184.2 +107400 ELSE NC2184.2 +107500 GO TO UST-FAIL-GF-7-3. NC2184.2 +107600 UST-DELETE-GF-7-3. NC2184.2 +107700 PERFORM DE-LETE. NC2184.2 +107800 GO TO UST-WRITE-GF-7-3. NC2184.2 +107900 UST-FAIL-GF-7-3. NC2184.2 +108000 PERFORM FAIL NC2184.2 +108100 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +108200 MOVE 2 TO CORRECT-N. NC2184.2 +108300 UST-WRITE-GF-7-3. NC2184.2 +108400 PERFORM PRINT-DETAIL. NC2184.2 +108500* NC2184.2 +108600 UST-TEST-GF-7-4. NC2184.2 +108700 ADD 1 TO REC-CT. NC2184.2 +108800 IF ID10-DU-2V0 = 8 NC2184.2 +108900 PERFORM PASS NC2184.2 +109000 GO TO UST-WRITE-GF-7-4 NC2184.2 +109100 ELSE NC2184.2 +109200 GO TO UST-FAIL-GF-7-4. NC2184.2 +109300 UST-DELETE-GF-7-4. NC2184.2 +109400 PERFORM DE-LETE. NC2184.2 +109500 GO TO UST-WRITE-GF-7-4. NC2184.2 +109600 UST-FAIL-GF-7-4. NC2184.2 +109700 PERFORM FAIL NC2184.2 +109800 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +109900 MOVE 8 TO CORRECT-N. NC2184.2 +110000 UST-WRITE-GF-7-4. NC2184.2 +110100 PERFORM PRINT-DETAIL. NC2184.2 +110200* NC2184.2 +110300 UST-TEST-GF-7-5. NC2184.2 +110400 ADD 1 TO REC-CT. NC2184.2 +110500 IF ID11-DU-2V0 = 1 NC2184.2 +110600 PERFORM PASS NC2184.2 +110700 GO TO UST-WRITE-GF-7-5 NC2184.2 +110800 ELSE NC2184.2 +110900 GO TO UST-FAIL-GF-7-5. NC2184.2 +111000 UST-DELETE-GF-7-5. NC2184.2 +111100 PERFORM DE-LETE. NC2184.2 +111200 GO TO UST-WRITE-GF-7-5. NC2184.2 +111300 UST-FAIL-GF-7-5. NC2184.2 +111400 PERFORM FAIL NC2184.2 +111500 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +111600 MOVE 1 TO CORRECT-N. NC2184.2 +111700 UST-WRITE-GF-7-5. NC2184.2 +111800 PERFORM PRINT-DETAIL. NC2184.2 +111900* NC2184.2 +112000 UST-INIT-GF-8. NC2184.2 +112100 MOVE "UST-TEST-GF-8" TO PAR-NAME. NC2184.2 +112200 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +112300 MOVE "PIC S99" TO FEATURE. NC2184.2 +112400 MOVE "1200000" TO ID1-XN-7. NC2184.2 +112500 MOVE ZERO TO ID4-DS-2V0. NC2184.2 +112600 MOVE "****" TO ID5-XN-4. NC2184.2 +112700 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +112800 MOVE 1 TO ID10-DU-2V0. NC2184.2 +112900 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +113000 MOVE 1 TO REC-CT. NC2184.2 +113100* NC2184.2 +113200 UST-TEST-GF-8. NC2184.2 +113300 UNSTRING ID1-XN-7 DELIMITED ZERO-XN-1 INTO ID4-DS-2V0 NC2184.2 +113400 DELIMITER ID5-XN-4 NC2184.2 +113500 COUNT ID6-DU-2V0 NC2184.2 +113600 POINTER ID10-DU-2V0 NC2184.2 +113700 TALLYING IN ID11-DU-2V0. NC2184.2 +113800 GO TO UST-TEST-GF-8-1. NC2184.2 +113900 UST-DELETE-GF-8. NC2184.2 +114000 PERFORM DE-LETE. NC2184.2 +114100 PERFORM PRINT-DETAIL. NC2184.2 +114200 GO TO UST-INIT-GF-9. NC2184.2 +114300* NC2184.2 +114400 UST-TEST-GF-8-1. NC2184.2 +114500 IF ID4-DS-2V0 = +12 NC2184.2 +114600 PERFORM PASS NC2184.2 +114700 GO TO UST-WRITE-GF-8-1 NC2184.2 +114800 ELSE NC2184.2 +114900 GO TO UST-FAIL-GF-8-1. NC2184.2 +115000 UST-DELETE-GF-8-1. NC2184.2 +115100 PERFORM DE-LETE. NC2184.2 +115200 GO TO UST-WRITE-GF-8-1. NC2184.2 +115300 UST-FAIL-GF-8-1. NC2184.2 +115400 PERFORM FAIL NC2184.2 +115500 MOVE ID4-DS-2V0 TO COMPUTED-N NC2184.2 +115600 MOVE +12 TO CORRECT-N. NC2184.2 +115700 UST-WRITE-GF-8-1. NC2184.2 +115800 PERFORM PRINT-DETAIL. NC2184.2 +115900* NC2184.2 +116000 UST-TEST-GF-8-2. NC2184.2 +116100 ADD 1 TO REC-CT. NC2184.2 +116200 IF ID5-XN-4 = "0 " NC2184.2 +116300 PERFORM PASS NC2184.2 +116400 GO TO UST-WRITE-GF-8-2 NC2184.2 +116500 ELSE NC2184.2 +116600 GO TO UST-FAIL-GF-8-2. NC2184.2 +116700 UST-DELETE-GF-8-2. NC2184.2 +116800 PERFORM DE-LETE. NC2184.2 +116900 GO TO UST-WRITE-GF-8-2. NC2184.2 +117000 UST-FAIL-GF-8-2. NC2184.2 +117100 PERFORM FAIL NC2184.2 +117200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +117300 MOVE "0 " TO CORRECT-A. NC2184.2 +117400 UST-WRITE-GF-8-2. NC2184.2 +117500 PERFORM PRINT-DETAIL. NC2184.2 +117600* NC2184.2 +117700 UST-TEST-GF-8-3. NC2184.2 +117800 ADD 1 TO REC-CT. NC2184.2 +117900 IF ID6-DU-2V0 = 2 NC2184.2 +118000 PERFORM PASS NC2184.2 +118100 GO TO UST-WRITE-GF-8-3 NC2184.2 +118200 ELSE NC2184.2 +118300 GO TO UST-FAIL-GF-8-3. NC2184.2 +118400 UST-DELETE-GF-8-3. NC2184.2 +118500 PERFORM DE-LETE. NC2184.2 +118600 GO TO UST-WRITE-GF-8-3. NC2184.2 +118700 UST-FAIL-GF-8-3. NC2184.2 +118800 PERFORM FAIL NC2184.2 +118900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +119000 MOVE 2 TO CORRECT-N. NC2184.2 +119100 UST-WRITE-GF-8-3. NC2184.2 +119200 PERFORM PRINT-DETAIL. NC2184.2 +119300* NC2184.2 +119400 UST-TEST-GF-8-4. NC2184.2 +119500 ADD 1 TO REC-CT. NC2184.2 +119600 IF ID10-DU-2V0 = 4 NC2184.2 +119700 PERFORM PASS NC2184.2 +119800 GO TO UST-WRITE-GF-8-4 NC2184.2 +119900 ELSE NC2184.2 +120000 GO TO UST-FAIL-GF-8-4. NC2184.2 +120100 UST-DELETE-GF-8-4. NC2184.2 +120200 PERFORM DE-LETE. NC2184.2 +120300 GO TO UST-WRITE-GF-8-4. NC2184.2 +120400 UST-FAIL-GF-8-4. NC2184.2 +120500 PERFORM FAIL NC2184.2 +120600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +120700 MOVE 4 TO CORRECT-N. NC2184.2 +120800 UST-WRITE-GF-8-4. NC2184.2 +120900 PERFORM PRINT-DETAIL. NC2184.2 +121000* NC2184.2 +121100 UST-TEST-GF-8-5. NC2184.2 +121200 ADD 1 TO REC-CT. NC2184.2 +121300 IF ID11-DU-2V0 = 1 NC2184.2 +121400 PERFORM PASS NC2184.2 +121500 GO TO UST-WRITE-GF-8-5 NC2184.2 +121600 ELSE NC2184.2 +121700 GO TO UST-FAIL-GF-8-5. NC2184.2 +121800 UST-DELETE-GF-8-5. NC2184.2 +121900 PERFORM DE-LETE. NC2184.2 +122000 GO TO UST-WRITE-GF-8-5. NC2184.2 +122100 UST-FAIL-GF-8-5. NC2184.2 +122200 PERFORM FAIL NC2184.2 +122300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +122400 MOVE 1 TO CORRECT-N. NC2184.2 +122500 UST-WRITE-GF-8-5. NC2184.2 +122600 PERFORM PRINT-DETAIL. NC2184.2 +122700* NC2184.2 +122800 UST-INIT-GF-9. NC2184.2 +122900 MOVE "UST-TEST-GF-9" TO PAR-NAME. NC2184.2 +123000 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +123100 MOVE "PIC S9 TRAIL SEP" TO FEATURE. NC2184.2 +123200 MOVE "1200000" TO ID1-XN-7. NC2184.2 +123300 MOVE ZERO TO ID4-DS-TS-1V0. NC2184.2 +123400 MOVE "****" TO ID5-XN-4. NC2184.2 +123500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +123600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +123700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +123800 MOVE 1 TO REC-CT. NC2184.2 +123900* NC2184.2 +124000 UST-TEST-GF-9. NC2184.2 +124100 UNSTRING ID1-XN-7 DELIMITED ALL ZERO-XN-1 INTO ID4-DS-TS-1V0 NC2184.2 +124200 DELIMITER ID5-XN-4 NC2184.2 +124300 COUNT ID6-DU-2V0 NC2184.2 +124400 POINTER ID10-DU-2V0 NC2184.2 +124500 TALLYING IN ID11-DU-2V0. NC2184.2 +124600 GO TO UST-TEST-GF-9-1. NC2184.2 +124700 UST-DELETE-GF-9. NC2184.2 +124800 PERFORM DE-LETE. NC2184.2 +124900 PERFORM PRINT-DETAIL. NC2184.2 +125000 GO TO UST-INIT-GF-10. NC2184.2 +125100* NC2184.2 +125200 UST-TEST-GF-9-1. NC2184.2 +125300 IF ID4-DS-TS-1V0 = +2 NC2184.2 +125400 PERFORM PASS NC2184.2 +125500 GO TO UST-WRITE-GF-9-1 NC2184.2 +125600 ELSE NC2184.2 +125700 GO TO UST-FAIL-GF-9-1. NC2184.2 +125800 UST-DELETE-GF-9-1. NC2184.2 +125900 PERFORM DE-LETE. NC2184.2 +126000 GO TO UST-WRITE-GF-9-1. NC2184.2 +126100 UST-FAIL-GF-9-1. NC2184.2 +126200 PERFORM FAIL NC2184.2 +126300 MOVE ID4-DS-TS-1V0 TO COMPUTED-N NC2184.2 +126400 MOVE +2 TO CORRECT-N. NC2184.2 +126500 UST-WRITE-GF-9-1. NC2184.2 +126600 PERFORM PRINT-DETAIL. NC2184.2 +126700* NC2184.2 +126800 UST-TEST-GF-9-2. NC2184.2 +126900 ADD 1 TO REC-CT. NC2184.2 +127000 IF ID5-XN-4 = "0 " NC2184.2 +127100 PERFORM PASS NC2184.2 +127200 GO TO UST-WRITE-GF-9-2 NC2184.2 +127300 ELSE NC2184.2 +127400 GO TO UST-FAIL-GF-9-2. NC2184.2 +127500 UST-DELETE-GF-9-2. NC2184.2 +127600 PERFORM DE-LETE. NC2184.2 +127700 GO TO UST-WRITE-GF-9-2. NC2184.2 +127800 UST-FAIL-GF-9-2. NC2184.2 +127900 PERFORM FAIL NC2184.2 +128000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +128100 MOVE "0 " TO CORRECT-A. NC2184.2 +128200 UST-WRITE-GF-9-2. NC2184.2 +128300 PERFORM PRINT-DETAIL. NC2184.2 +128400* NC2184.2 +128500 UST-TEST-GF-9-3. NC2184.2 +128600 IF ID6-DU-2V0 = 2 NC2184.2 +128700 PERFORM PASS NC2184.2 +128800 GO TO UST-WRITE-GF-9-3 NC2184.2 +128900 ELSE NC2184.2 +129000 GO TO UST-FAIL-GF-9-3. NC2184.2 +129100 UST-DELETE-GF-9-3. NC2184.2 +129200 PERFORM DE-LETE. NC2184.2 +129300 GO TO UST-WRITE-GF-9-3. NC2184.2 +129400 UST-FAIL-GF-9-3. NC2184.2 +129500 PERFORM FAIL NC2184.2 +129600 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +129700 MOVE 2 TO CORRECT-N. NC2184.2 +129800 UST-WRITE-GF-9-3. NC2184.2 +129900 PERFORM PRINT-DETAIL. NC2184.2 +130000* NC2184.2 +130100 UST-TEST-GF-9-4. NC2184.2 +130200 ADD 1 TO REC-CT. NC2184.2 +130300 IF ID10-DU-2V0 = 8 NC2184.2 +130400 PERFORM PASS NC2184.2 +130500 GO TO UST-WRITE-GF-9-4 NC2184.2 +130600 ELSE NC2184.2 +130700 GO TO UST-FAIL-GF-9-4. NC2184.2 +130800 UST-DELETE-GF-9-4. NC2184.2 +130900 PERFORM DE-LETE. NC2184.2 +131000 GO TO UST-WRITE-GF-9-4. NC2184.2 +131100 UST-FAIL-GF-9-4. NC2184.2 +131200 PERFORM FAIL NC2184.2 +131300 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +131400 MOVE 8 TO CORRECT-N. NC2184.2 +131500 UST-WRITE-GF-9-4. NC2184.2 +131600 PERFORM PRINT-DETAIL. NC2184.2 +131700* NC2184.2 +131800 UST-TEST-GF-9-5. NC2184.2 +131900 ADD 1 TO REC-CT. NC2184.2 +132000 IF ID11-DU-2V0 = 1 NC2184.2 +132100 PERFORM PASS NC2184.2 +132200 GO TO UST-WRITE-GF-9-5 NC2184.2 +132300 ELSE NC2184.2 +132400 GO TO UST-FAIL-GF-9-5. NC2184.2 +132500 UST-DELETE-GF-9-5. NC2184.2 +132600 PERFORM DE-LETE. NC2184.2 +132700 GO TO UST-WRITE-GF-9-5. NC2184.2 +132800 UST-FAIL-GF-9-5. NC2184.2 +132900 PERFORM FAIL NC2184.2 +133000 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +133100 MOVE 1 TO CORRECT-N. NC2184.2 +133200 UST-WRITE-GF-9-5. NC2184.2 +133300 PERFORM PRINT-DETAIL. NC2184.2 +133400* NC2184.2 +133500 UST-INIT-GF-10. NC2184.2 +133600 MOVE "UST-TEST-GF-10" TO PAR-NAME. NC2184.2 +133700 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +133800 MOVE "PIC S9 LEAD SEP" TO FEATURE. NC2184.2 +133900 MOVE "1200000" TO ID1-XN-7. NC2184.2 +134000 MOVE ZERO TO ID4-DS-LS-1V0. NC2184.2 +134100 MOVE "****" TO ID5-XN-4. NC2184.2 +134200 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +134300 MOVE 1 TO ID10-DU-2V0. NC2184.2 +134400 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +134500 MOVE 1 TO REC-CT. NC2184.2 +134600* NC2184.2 +134700 UST-TEST-GF-10. NC2184.2 +134800 UNSTRING ID1-XN-7 DELIMITED BY "0" INTO ID4-DS-LS-1V0 NC2184.2 +134900 DELIMITER ID5-XN-4 NC2184.2 +135000 COUNT ID6-DU-2V0 NC2184.2 +135100 POINTER ID10-DU-2V0 NC2184.2 +135200 TALLYING ID11-DU-2V0. NC2184.2 +135300 GO TO UST-TEST-GF-10-1. NC2184.2 +135400 UST-DELETE-GF-10. NC2184.2 +135500 PERFORM DE-LETE. NC2184.2 +135600 PERFORM PRINT-DETAIL. NC2184.2 +135700 GO TO UST-INIT-GF-11. NC2184.2 +135800* NC2184.2 +135900 UST-TEST-GF-10-1. NC2184.2 +136000 IF ID4-DS-LS-1V0 = +2 NC2184.2 +136100 PERFORM PASS NC2184.2 +136200 GO TO UST-WRITE-GF-10-1 NC2184.2 +136300 ELSE NC2184.2 +136400 GO TO UST-FAIL-GF-10-1. NC2184.2 +136500 UST-DELETE-GF-10-1. NC2184.2 +136600 PERFORM DE-LETE. NC2184.2 +136700 GO TO UST-WRITE-GF-10-1. NC2184.2 +136800 UST-FAIL-GF-10-1. NC2184.2 +136900 PERFORM FAIL NC2184.2 +137000 MOVE ID4-DS-LS-1V0 TO COMPUTED-N NC2184.2 +137100 MOVE +2 TO CORRECT-N. NC2184.2 +137200 UST-WRITE-GF-10-1. NC2184.2 +137300 PERFORM PRINT-DETAIL. NC2184.2 +137400* NC2184.2 +137500 UST-TEST-GF-10-2. NC2184.2 +137600 ADD 1 TO REC-CT. NC2184.2 +137700 IF ID5-XN-4 = "0 " NC2184.2 +137800 PERFORM PASS NC2184.2 +137900 GO TO UST-WRITE-GF-10-2 NC2184.2 +138000 ELSE NC2184.2 +138100 GO TO UST-FAIL-GF-10-2. NC2184.2 +138200 UST-DELETE-GF-10-2. NC2184.2 +138300 PERFORM DE-LETE. NC2184.2 +138400 GO TO UST-WRITE-GF-10-2. NC2184.2 +138500 UST-FAIL-GF-10-2. NC2184.2 +138600 PERFORM FAIL NC2184.2 +138700 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +138800 MOVE "0 " TO CORRECT-A. NC2184.2 +138900 UST-WRITE-GF-10-2. NC2184.2 +139000 PERFORM PRINT-DETAIL. NC2184.2 +139100* NC2184.2 +139200 UST-TEST-GF-10-3. NC2184.2 +139300 ADD 1 TO REC-CT. NC2184.2 +139400 IF ID6-DU-2V0 = 2 NC2184.2 +139500 PERFORM PASS NC2184.2 +139600 GO TO UST-WRITE-GF-10-3 NC2184.2 +139700 ELSE NC2184.2 +139800 GO TO UST-FAIL-GF-10-3. NC2184.2 +139900 UST-DELETE-GF-10-3. NC2184.2 +140000 PERFORM DE-LETE. NC2184.2 +140100 GO TO UST-WRITE-GF-10-3. NC2184.2 +140200 UST-FAIL-GF-10-3. NC2184.2 +140300 PERFORM FAIL NC2184.2 +140400 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +140500 MOVE 2 TO CORRECT-N. NC2184.2 +140600 UST-WRITE-GF-10-3. NC2184.2 +140700 PERFORM PRINT-DETAIL. NC2184.2 +140800* NC2184.2 +140900 UST-TEST-GF-10-4. NC2184.2 +141000 ADD 1 TO REC-CT. NC2184.2 +141100 IF ID10-DU-2V0 = 4 NC2184.2 +141200 PERFORM PASS NC2184.2 +141300 GO TO UST-WRITE-GF-10-4 NC2184.2 +141400 ELSE NC2184.2 +141500 GO TO UST-FAIL-GF-10-4. NC2184.2 +141600 UST-DELETE-GF-10-4. NC2184.2 +141700 PERFORM DE-LETE. NC2184.2 +141800 GO TO UST-WRITE-GF-10-4. NC2184.2 +141900 UST-FAIL-GF-10-4. NC2184.2 +142000 PERFORM FAIL NC2184.2 +142100 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +142200 MOVE 4 TO CORRECT-N. NC2184.2 +142300 UST-WRITE-GF-10-4. NC2184.2 +142400 PERFORM PRINT-DETAIL. NC2184.2 +142500* NC2184.2 +142600 UST-TEST-GF-10-5. NC2184.2 +142700 ADD 1 TO REC-CT. NC2184.2 +142800 IF ID11-DU-2V0 = 1 NC2184.2 +142900 PERFORM PASS NC2184.2 +143000 GO TO UST-WRITE-GF-10-5 NC2184.2 +143100 ELSE NC2184.2 +143200 GO TO UST-FAIL-GF-10-5. NC2184.2 +143300 UST-DELETE-GF-10-5. NC2184.2 +143400 PERFORM DE-LETE. NC2184.2 +143500 GO TO UST-WRITE-GF-10-5. NC2184.2 +143600 UST-FAIL-GF-10-5. NC2184.2 +143700 PERFORM FAIL NC2184.2 +143800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +143900 MOVE 1 TO CORRECT-N. NC2184.2 +144000 UST-WRITE-GF-10-5. NC2184.2 +144100 PERFORM PRINT-DETAIL. NC2184.2 +144200* NC2184.2 +144300 UST-INIT-GF-11. NC2184.2 +144400 MOVE "UST-TEST-GF-11" TO PAR-NAME. NC2184.2 +144500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +144600 MOVE "GROUP BOTTOM UP" TO FEATURE. NC2184.2 +144700 MOVE "ABCDEFGHIJ" TO GRP1-XN-10. NC2184.2 +144800 MOVE SPACES TO GRP4-XN-10. NC2184.2 +144900 MOVE "****" TO ID5-XN-4. NC2184.2 +145000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +145100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +145200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +145300 MOVE ZERO TO REC-CT. NC2184.2 +145400* NC2184.2 +145500 UST-TEST-GF-11. NC2184.2 +145600 UNSTRING GRP1-XN-10 INTO ID4D-XXXX ID4C-XXX ID4B-XX ID4A-X. NC2184.2 +145700 IF GRP4-XN-10 = "JHIEFGABCD" NC2184.2 +145800 PERFORM PASS NC2184.2 +145900 GO TO UST-WRITE-GF-11-1 NC2184.2 +146000 ELSE NC2184.2 +146100 GO TO UST-FAIL-GF-11-1. NC2184.2 +146200 UST-DELETE-GF-11-1. NC2184.2 +146300 PERFORM DE-LETE. NC2184.2 +146400 GO TO UST-WRITE-GF-11-1. NC2184.2 +146500 UST-FAIL-GF-11-1. NC2184.2 +146600 PERFORM FAIL NC2184.2 +146700 MOVE GRP4-XN-10 TO COMPUTED-A NC2184.2 +146800 MOVE "JHIEFGABCD" TO CORRECT-A. NC2184.2 +146900 UST-WRITE-GF-11-1. NC2184.2 +147000 PERFORM PRINT-DETAIL. NC2184.2 +147100* NC2184.2 +147200 UST-INIT-GF-12. NC2184.2 +147300 MOVE "UST-TEST-GF-12" TO PAR-NAME. NC2184.2 +147400 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +147500 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +147600 MOVE SPACES TO GRP4-XN-6. NC2184.2 +147700 MOVE "****" TO ID5-XN-4. NC2184.2 +147800 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +147900 MOVE 1 TO ID10-DU-2V0. NC2184.2 +148000 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +148100 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +148200 MOVE 1 TO REC-CT. NC2184.2 +148300* NC2184.2 +148400 UST-TEST-GF-12-1. NC2184.2 +148500 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +148600 ON OVERFLOW GO TO UST-FAIL-GF-12-1. NC2184.2 +148700 PERFORM PASS. NC2184.2 +148800 GO TO UST-WRITE-GF-12-1. NC2184.2 +148900 UST-DELETE-GF-12-1. NC2184.2 +149000 PERFORM DE-LETE. NC2184.2 +149100 PERFORM PRINT-DETAIL. NC2184.2 +149200 GO TO UST-INIT-GF-13. NC2184.2 +149300 UST-FAIL-GF-12-1. NC2184.2 +149400 PERFORM FAIL. NC2184.2 +149500 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +149600 UST-WRITE-GF-12-1. NC2184.2 +149700 PERFORM PRINT-DETAIL. NC2184.2 +149800* NC2184.2 +149900 UST-TEST-GF-12-2. NC2184.2 +150000 MOVE "UST-TEST-GF-12" TO PAR-NAME. NC2184.2 +150100 ADD 1 TO REC-CT. NC2184.2 +150200 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +150300 PERFORM PASS NC2184.2 +150400 GO TO UST-WRITE-GF-12-2 NC2184.2 +150500 ELSE NC2184.2 +150600 GO TO UST-FAIL-GF-12-2. NC2184.2 +150700 UST-DELETE-GF-12-2. NC2184.2 +150800 PERFORM DE-LETE. NC2184.2 +150900 GO TO UST-WRITE-GF-12-2. NC2184.2 +151000 UST-FAIL-GF-12-2. NC2184.2 +151100 PERFORM FAIL NC2184.2 +151200 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +151300 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +151400 UST-WRITE-GF-12-2. NC2184.2 +151500 PERFORM PRINT-DETAIL. NC2184.2 +151600* NC2184.2 +151700 UST-INIT-GF-13. NC2184.2 +151800 MOVE "UST-TEST-GF-13" TO PAR-NAME. NC2184.2 +151900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +152000 MOVE "OVERFLOW EXPECTED" TO FEATURE. NC2184.2 +152100 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +152200 MOVE SPACES TO GRP4-XN-6. NC2184.2 +152300 MOVE "****" TO ID5-XN-4. NC2184.2 +152400 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +152500 MOVE 1 TO ID10-DU-2V0. NC2184.2 +152600 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +152700 MOVE 1 TO REC-CT. NC2184.2 +152800 UST-TEST-GF-13-1. NC2184.2 +152900 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX OVERFLOW PERFORM PASS NC2184.2 +153000 GO TO UST-WRITE-GF-13-1. NC2184.2 +153100 GO TO UST-FAIL-GF-13-1. NC2184.2 +153200 UST-DELETE-GF-13-1. NC2184.2 +153300 PERFORM DE-LETE. NC2184.2 +153400 PERFORM PRINT-DETAIL. NC2184.2 +153500 GO TO UST-INIT-GF-14. NC2184.2 +153600 UST-FAIL-GF-13-1. NC2184.2 +153700 PERFORM FAIL. NC2184.2 +153800 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +153900 UST-WRITE-GF-13-1. NC2184.2 +154000 PERFORM PRINT-DETAIL. NC2184.2 +154100* NC2184.2 +154200 UST-TEST-GF-13-2. NC2184.2 +154300 ADD 1 TO REC-CT. NC2184.2 +154400 IF GRP4-XN-6 = "ABCDE " NC2184.2 +154500 PERFORM PASS NC2184.2 +154600 GO TO UST-WRITE-GF-13-2 NC2184.2 +154700 ELSE NC2184.2 +154800 GO TO UST-FAIL-GF-13-2. NC2184.2 +154900 UST-DELETE-GF-13-2. NC2184.2 +155000 PERFORM DE-LETE. NC2184.2 +155100 GO TO UST-WRITE-GF-13-2. NC2184.2 +155200 UST-FAIL-GF-13-2. NC2184.2 +155300 PERFORM FAIL NC2184.2 +155400 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +155500 MOVE "ABCDE " TO CORRECT-A. NC2184.2 +155600 UST-WRITE-GF-13-2. NC2184.2 +155700 PERFORM PRINT-DETAIL. NC2184.2 +155800* NC2184.2 +155900 UST-INIT-GF-14. NC2184.2 +156000 MOVE "UST-TEST-GF-14" TO PAR-NAME. NC2184.2 +156100 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +156200 MOVE "INSTANT OVERFLOW" TO FEATURE. NC2184.2 +156300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +156400 MOVE "****" TO ID5-XN-4. NC2184.2 +156500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +156600 MOVE 7 TO ID10-DU-2V0. NC2184.2 +156700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +156800 MOVE 1 TO REC-CT. NC2184.2 +156900* NC2184.2 +157000 UST-TEST-GF-14-1. NC2184.2 +157100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X POINTER ID10-DU-2V0NC2184.2 +157200 OVERFLOW PERFORM PASS NC2184.2 +157300 GO TO UST-WRITE-GF-14-1. NC2184.2 +157400 GO TO UST-FAIL-GF-14-1. NC2184.2 +157500 UST-DELETE-GF-14-1. NC2184.2 +157600 PERFORM DE-LETE. NC2184.2 +157700 PERFORM PRINT-DETAIL. NC2184.2 +157800 GO TO UST-INIT-GF-15. NC2184.2 +157900 UST-FAIL-GF-14-1. NC2184.2 +158000 PERFORM FAIL. NC2184.2 +158100 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +158200 UST-WRITE-GF-14-1. NC2184.2 +158300 PERFORM PRINT-DETAIL. NC2184.2 +158400* NC2184.2 +158500 UST-TEST-GF-14-2. NC2184.2 +158600 MOVE "UST-TEST-GF-14" TO PAR-NAME. NC2184.2 +158700 ADD 1 TO REC-CT. NC2184.2 +158800 IF GRP4-XN-6 = SPACES NC2184.2 +158900 PERFORM PASS NC2184.2 +159000 GO TO UST-WRITE-GF-14-2 NC2184.2 +159100 ELSE NC2184.2 +159200 GO TO UST-FAIL-GF-14-2. NC2184.2 +159300 UST-DELETE-GF-14-2. NC2184.2 +159400 PERFORM DE-LETE. NC2184.2 +159500 GO TO UST-WRITE-GF-14-2. NC2184.2 +159600 UST-FAIL-GF-14-2. NC2184.2 +159700 PERFORM FAIL NC2184.2 +159800 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +159900 MOVE "ALL SPACES" TO CORRECT-A. NC2184.2 +160000 UST-WRITE-GF-14-2. NC2184.2 +160100 PERFORM PRINT-DETAIL. NC2184.2 +160200* NC2184.2 +160300 UST-TEST-GF-14-3. NC2184.2 +160400 ADD 1 TO REC-CT. NC2184.2 +160500 IF ID10-DU-2V0 = 7 NC2184.2 +160600 PERFORM PASS NC2184.2 +160700 GO TO UST-WRITE-GF-14-3 NC2184.2 +160800 ELSE NC2184.2 +160900 GO TO UST-FAIL-GF-14-3. NC2184.2 +161000 UST-DELETE-GF-14-3. NC2184.2 +161100 PERFORM DE-LETE. NC2184.2 +161200 GO TO UST-WRITE-GF-14-3. NC2184.2 +161300 UST-FAIL-GF-14-3. NC2184.2 +161400 PERFORM FAIL NC2184.2 +161500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +161600 MOVE 7 TO CORRECT-N. NC2184.2 +161700 UST-WRITE-GF-14-3. NC2184.2 +161800 PERFORM PRINT-DETAIL. NC2184.2 +161900* NC2184.2 +162000 UST-INIT-GF-15. NC2184.2 +162100 MOVE "UST-TEST-GF-15" TO PAR-NAME. NC2184.2 +162200 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +162300 MOVE "POINTER NOT = 1" TO FEATURE. NC2184.2 +162400 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +162500 MOVE SPACES TO GRP4-XN-6. NC2184.2 +162600 MOVE "****" TO ID5-XN-4. NC2184.2 +162700 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +162800 MOVE 3 TO ID10-DU-2V0. NC2184.2 +162900 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +163000 MOVE 1 TO REC-CT. NC2184.2 +163100* NC2184.2 +163200 UST-TEST-GF-15-1. NC2184.2 +163300 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X POINTER ID10-DU-2V0NC2184.2 +163400 OVERFLOW GO TO UST-FAIL-GF-15-1. NC2184.2 +163500 PERFORM PASS NC2184.2 +163600 GO TO UST-WRITE-GF-15-1. NC2184.2 +163700 UST-DELETE-GF-15-1. NC2184.2 +163800 PERFORM DE-LETE. NC2184.2 +163900 PERFORM PRINT-DETAIL. NC2184.2 +164000 GO TO UST-INIT-GF-16. NC2184.2 +164100 UST-FAIL-GF-15-1. NC2184.2 +164200 PERFORM FAIL. NC2184.2 +164300 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +164400 UST-WRITE-GF-15-1. NC2184.2 +164500 PERFORM PRINT-DETAIL. NC2184.2 +164600* NC2184.2 +164700 UST-TEST-GF-15-2. NC2184.2 +164800 ADD 1 TO REC-CT. NC2184.2 +164900 IF GRP4-XN-6 = "CDEF " NC2184.2 +165000 PERFORM PASS NC2184.2 +165100 GO TO UST-WRITE-GF-15-2 NC2184.2 +165200 ELSE NC2184.2 +165300 GO TO UST-FAIL-GF-15-2. NC2184.2 +165400 UST-DELETE-GF-15-2. NC2184.2 +165500 PERFORM DE-LETE. NC2184.2 +165600 GO TO UST-WRITE-GF-15-2. NC2184.2 +165700 UST-FAIL-GF-15-2. NC2184.2 +165800 PERFORM FAIL NC2184.2 +165900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +166000 MOVE "CDEF " TO CORRECT-A. NC2184.2 +166100 UST-WRITE-GF-15-2. NC2184.2 +166200 PERFORM PRINT-DETAIL. NC2184.2 +166300* NC2184.2 +166400 UST-TEST-GF-15-3. NC2184.2 +166500 ADD 1 TO REC-CT. NC2184.2 +166600 IF ID10-DU-2V0 = 7 NC2184.2 +166700 PERFORM PASS NC2184.2 +166800 GO TO UST-WRITE-GF-15-3 NC2184.2 +166900 ELSE NC2184.2 +167000 GO TO UST-FAIL-GF-15-3. NC2184.2 +167100 UST-DELETE-GF-15-3. NC2184.2 +167200 PERFORM DE-LETE. NC2184.2 +167300 GO TO UST-WRITE-GF-15-3. NC2184.2 +167400 UST-FAIL-GF-15-3. NC2184.2 +167500 PERFORM FAIL NC2184.2 +167600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +167700 MOVE 7 TO CORRECT-N. NC2184.2 +167800 UST-WRITE-GF-15-3. NC2184.2 +167900 PERFORM PRINT-DETAIL. NC2184.2 +168000* NC2184.2 +168100 UST-INIT-GF-16. NC2184.2 +168200 MOVE "UST-TEST-GF-16" TO PAR-NAME. NC2184.2 +168300 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +168400 MOVE "TALLY 3 FIELDS TEST" TO FEATURE. NC2184.2 +168500 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +168600 MOVE SPACES TO GRP4-XN-6. NC2184.2 +168700 MOVE "****" TO ID4C-XXXX. NC2184.2 +168800 MOVE "****" TO ID5-XN-4. NC2184.2 +168900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +169000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +169100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +169200 MOVE 1 TO REC-CT. NC2184.2 +169300* NC2184.2 +169400 UST-TEST-GF-16-0. NC2184.2 +169500 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X ID4C-XXXX NC2184.2 +169600 TALLYING ID11-DU-2V0. NC2184.2 +169700 GO TO UST-TEST-GF-16-1. NC2184.2 +169800 UST-DELETE-GF-16. NC2184.2 +169900 PERFORM DE-LETE. NC2184.2 +170000 PERFORM PRINT-DETAIL. NC2184.2 +170100 GO TO UST-INIT-GF-17. NC2184.2 +170200* NC2184.2 +170300 UST-TEST-GF-16-1. NC2184.2 +170400 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +170500 PERFORM PASS NC2184.2 +170600 GO TO UST-WRITE-GF-16-1 NC2184.2 +170700 ELSE NC2184.2 +170800 GO TO UST-FAIL-GF-16-1. NC2184.2 +170900 UST-DELETE-GF-16-1. NC2184.2 +171000 PERFORM DE-LETE. NC2184.2 +171100 GO TO UST-WRITE-GF-16-1. NC2184.2 +171200 UST-FAIL-GF-16-1. NC2184.2 +171300 PERFORM FAIL NC2184.2 +171400 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +171500 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +171600 UST-WRITE-GF-16-1. NC2184.2 +171700 PERFORM PRINT-DETAIL. NC2184.2 +171800* NC2184.2 +171900 UST-TEST-GF-16-2. NC2184.2 +172000 ADD 1 TO REC-CT. NC2184.2 +172100 IF ID4C-XXXX = "****" NC2184.2 +172200 PERFORM PASS NC2184.2 +172300 GO TO UST-WRITE-GF-16-2 NC2184.2 +172400 ELSE NC2184.2 +172500 GO TO UST-FAIL-GF-16-2. NC2184.2 +172600 UST-DELETE-GF-16-2. NC2184.2 +172700 PERFORM DE-LETE. NC2184.2 +172800 GO TO UST-WRITE-GF-16-2. NC2184.2 +172900 UST-FAIL-GF-16-2. NC2184.2 +173000 PERFORM FAIL NC2184.2 +173100 MOVE ID4C-XXXX TO COMPUTED-A NC2184.2 +173200 MOVE "****" TO CORRECT-A. NC2184.2 +173300 UST-WRITE-GF-16-2. NC2184.2 +173400 PERFORM PRINT-DETAIL. NC2184.2 +173500* NC2184.2 +173600 UST-TEST-GF-16-3. NC2184.2 +173700 ADD 1 TO REC-CT. NC2184.2 +173800 IF ID11-DU-2V0 = 2 NC2184.2 +173900 PERFORM PASS NC2184.2 +174000 GO TO UST-WRITE-GF-16-3 NC2184.2 +174100 ELSE NC2184.2 +174200 GO TO UST-FAIL-GF-16-3. NC2184.2 +174300 UST-DELETE-GF-16-3. NC2184.2 +174400 PERFORM DE-LETE. NC2184.2 +174500 GO TO UST-WRITE-GF-16-3. NC2184.2 +174600 UST-FAIL-GF-16-3. NC2184.2 +174700 PERFORM FAIL NC2184.2 +174800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +174900 MOVE 2 TO CORRECT-N. NC2184.2 +175000 UST-WRITE-GF-16-3. NC2184.2 +175100 PERFORM PRINT-DETAIL. NC2184.2 +175200* NC2184.2 +175300 UST-INIT-GF-17. NC2184.2 +175400 MOVE "UST-TEST-GF-17" TO PAR-NAME. NC2184.2 +175500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +175600 MOVE "QUAL DEL BY POINT" TO FEATURE. NC2184.2 +175700 MOVE "ABCDEFG" TO GRP1-XN-7. NC2184.2 +175800 MOVE "BCDEFGH" TO GRP2-XN-7. NC2184.2 +175900 MOVE SPACES TO GRP4-XN-6. NC2184.2 +176000 MOVE ALL "*" TO ID5-XN-6. NC2184.2 +176100 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +176200 MOVE 2 TO ID10-DU-2V0. NC2184.2 +176300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +176400 MOVE 1 TO REC-CT. NC2184.2 +176500* NC2184.2 +176600 UST-TEST-GF-17. NC2184.2 +176700 UNSTRING GRP1-XN-7 DELIMITED BY ID2 (ID10-DU-2V0) NC2184.2 +176800 INTO GRP4-XN-6 NC2184.2 +176900 DELIMITER IN ID5-XN-6 NC2184.2 +177000 COUNT ID6-DU-2V0 NC2184.2 +177100 POINTER ID10-DU-2V0. NC2184.2 +177200 GO TO UST-TEST-GF-17-1. NC2184.2 +177300 UST-DELETE-GF-17. NC2184.2 +177400 PERFORM DE-LETE. NC2184.2 +177500 PERFORM PRINT-DETAIL. NC2184.2 +177600 GO TO UST-INIT-GF-18. NC2184.2 +177700* NC2184.2 +177800 UST-TEST-GF-17-1. NC2184.2 +177900 IF GRP4-XN-6 = "B " NC2184.2 +178000 PERFORM PASS NC2184.2 +178100 GO TO UST-WRITE-GF-17-1 NC2184.2 +178200 ELSE NC2184.2 +178300 GO TO UST-FAIL-GF-17-1. NC2184.2 +178400 UST-DELETE-GF-17-1. NC2184.2 +178500 PERFORM DE-LETE. NC2184.2 +178600 GO TO UST-WRITE-GF-17-1. NC2184.2 +178700 UST-FAIL-GF-17-1. NC2184.2 +178800 PERFORM FAIL NC2184.2 +178900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +179000 MOVE "B " TO CORRECT-A. NC2184.2 +179100 UST-WRITE-GF-17-1. NC2184.2 +179200 PERFORM PRINT-DETAIL. NC2184.2 +179300* NC2184.2 +179400 UST-TEST-GF-17-2. NC2184.2 +179500 ADD 1 TO REC-CT. NC2184.2 +179600 IF ID5-XN-6 = "C " NC2184.2 +179700 PERFORM PASS NC2184.2 +179800 GO TO UST-WRITE-GF-17-2 NC2184.2 +179900 ELSE NC2184.2 +180000 GO TO UST-FAIL-GF-17-2. NC2184.2 +180100 UST-DELETE-GF-17-2. NC2184.2 +180200 PERFORM DE-LETE. NC2184.2 +180300 GO TO UST-WRITE-GF-17-2. NC2184.2 +180400 UST-FAIL-GF-17-2. NC2184.2 +180500 PERFORM FAIL NC2184.2 +180600 MOVE ID5-XN-6 TO COMPUTED-A NC2184.2 +180700 MOVE "C " TO CORRECT-A. NC2184.2 +180800 UST-WRITE-GF-17-2. NC2184.2 +180900 PERFORM PRINT-DETAIL. NC2184.2 +181000* NC2184.2 +181100 UST-TEST-GF-17-3. NC2184.2 +181200 ADD 1 TO REC-CT. NC2184.2 +181300 IF ID6-DU-2V0 = 1 NC2184.2 +181400 PERFORM PASS NC2184.2 +181500 GO TO UST-WRITE-GF-17-3 NC2184.2 +181600 ELSE NC2184.2 +181700 GO TO UST-FAIL-GF-17-3. NC2184.2 +181800 UST-DELETE-GF-17-3. NC2184.2 +181900 PERFORM DE-LETE. NC2184.2 +182000 GO TO UST-WRITE-GF-17-3. NC2184.2 +182100 UST-FAIL-GF-17-3. NC2184.2 +182200 PERFORM FAIL NC2184.2 +182300 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +182400 MOVE 1 TO CORRECT-N. NC2184.2 +182500 UST-WRITE-GF-17-3. NC2184.2 +182600 PERFORM PRINT-DETAIL. NC2184.2 +182700* NC2184.2 +182800 UST-TEST-GF-17-4. NC2184.2 +182900 ADD 1 TO REC-CT. NC2184.2 +183000 IF ID10-DU-2V0 = 4 NC2184.2 +183100 PERFORM PASS NC2184.2 +183200 GO TO UST-WRITE-GF-17-4 NC2184.2 +183300 ELSE NC2184.2 +183400 GO TO UST-FAIL-GF-17-4. NC2184.2 +183500 UST-DELETE-GF-17-4. NC2184.2 +183600 PERFORM DE-LETE. NC2184.2 +183700 GO TO UST-WRITE-GF-17-4. NC2184.2 +183800 UST-FAIL-GF-17-4. NC2184.2 +183900 PERFORM FAIL NC2184.2 +184000 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +184100 MOVE 4 TO CORRECT-N. NC2184.2 +184200 UST-WRITE-GF-17-4. NC2184.2 +184300 PERFORM PRINT-DETAIL. NC2184.2 +184400* NC2184.2 +184500 UST-INIT-GF-18. NC2184.2 +184600 ADD 1 TO REC-CT. NC2184.2 +184700 MOVE "UST-TEST-GF-18" TO PAR-NAME. NC2184.2 +184800 MOVE "VI-136" TO ANSI-REFERENCE. NC2184.2 +184900 MOVE "QUAL DEL BY TALLY" TO FEATURE. NC2184.2 +185000 MOVE "ABCDEFG" TO GRP1-XN-7. NC2184.2 +185100 MOVE "CE" TO GRP2-XN-2. NC2184.2 +185200 MOVE SPACES TO GRP4-XN-6. NC2184.2 +185300 MOVE "****" TO ID5-XN-4. NC2184.2 +185400 MOVE "****" TO ID5-XN-4-2. NC2184.2 +185500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +185600 MOVE ZERO TO ID6-DU-2V0-2. NC2184.2 +185700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +185800 MOVE 1 TO ID11-DU-2V0. NC2184.2 +185900 MOVE 1 TO REC-CT. NC2184.2 +186000* NC2184.2 +186100 UST-TEST-GF-18. NC2184.2 +186200 UNSTRING GRP1-XN-7 DELIMITED ID2A (ID10-DU-2V0) NC2184.2 +186300 INTO ID4A-XXXXX NC2184.2 +186400 DELIMITER IN ID5-XN-4 NC2184.2 +186500 COUNT ID6-DU-2V0 NC2184.2 +186600 ID4B-X DELIMITER IN ID5-XN-4-2 NC2184.2 +186700 COUNT ID6-DU-2V0-2 NC2184.2 +186800 TALLYING ID11-DU-2V0. NC2184.2 +186900 GO TO UST-TEST-GF-18-1. NC2184.2 +187000 UST-DELETE-GF-18. NC2184.2 +187100 PERFORM DE-LETE. NC2184.2 +187200 PERFORM PRINT-DETAIL. NC2184.2 +187300 GO TO UST-INIT-GF-19. NC2184.2 +187400* NC2184.2 +187500 UST-TEST-GF-18-1. NC2184.2 +187600 IF GRP4-XN-6 = "AB D" NC2184.2 +187700 PERFORM PASS NC2184.2 +187800 GO TO UST-WRITE-GF-18-1 NC2184.2 +187900 ELSE NC2184.2 +188000 GO TO UST-FAIL-GF-18-1. NC2184.2 +188100 UST-DELETE-GF-18-1. NC2184.2 +188200 PERFORM DE-LETE. NC2184.2 +188300 GO TO UST-WRITE-GF-18-1. NC2184.2 +188400 UST-FAIL-GF-18-1. NC2184.2 +188500 PERFORM FAIL NC2184.2 +188600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +188700 MOVE "AB D" TO CORRECT-A. NC2184.2 +188800 UST-WRITE-GF-18-1. NC2184.2 +188900 PERFORM PRINT-DETAIL. NC2184.2 +189000* NC2184.2 +189100 UST-TEST-GF-18-2. NC2184.2 +189200 ADD 1 TO REC-CT. NC2184.2 +189300 IF ID5-XN-4 = "C " NC2184.2 +189400 PERFORM PASS NC2184.2 +189500 GO TO UST-WRITE-GF-18-2 NC2184.2 +189600 ELSE NC2184.2 +189700 GO TO UST-FAIL-GF-18-2. NC2184.2 +189800 UST-DELETE-GF-18-2. NC2184.2 +189900 PERFORM DE-LETE. NC2184.2 +190000 GO TO UST-WRITE-GF-18-2. NC2184.2 +190100 UST-FAIL-GF-18-2. NC2184.2 +190200 PERFORM FAIL NC2184.2 +190300 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +190400 MOVE "C " TO CORRECT-A. NC2184.2 +190500 UST-WRITE-GF-18-2. NC2184.2 +190600 PERFORM PRINT-DETAIL. NC2184.2 +190700* NC2184.2 +190800 UST-TEST-GF-18-3. NC2184.2 +190900 ADD 1 TO REC-CT. NC2184.2 +191000 IF ID6-DU-2V0 = 2 NC2184.2 +191100 PERFORM PASS NC2184.2 +191200 GO TO UST-WRITE-GF-18-3 NC2184.2 +191300 ELSE NC2184.2 +191400 GO TO UST-FAIL-GF-18-3. NC2184.2 +191500 UST-DELETE-GF-18-3. NC2184.2 +191600 PERFORM DE-LETE. NC2184.2 +191700 GO TO UST-WRITE-GF-18-3. NC2184.2 +191800 UST-FAIL-GF-18-3. NC2184.2 +191900 PERFORM FAIL NC2184.2 +192000 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +192100 MOVE 2 TO CORRECT-N. NC2184.2 +192200 UST-WRITE-GF-18-3. NC2184.2 +192300 PERFORM PRINT-DETAIL. NC2184.2 +192400* NC2184.2 +192500 UST-TEST-GF-18-4. NC2184.2 +192600 ADD 1 TO REC-CT. NC2184.2 +192700 IF ID6-DU-2V0-2 EQUAL TO 4 NC2184.2 +192800 PERFORM PASS NC2184.2 +192900 GO TO UST-WRITE-GF-18-4 NC2184.2 +193000 ELSE NC2184.2 +193100 GO TO UST-FAIL-GF-18-4. NC2184.2 +193200 UST-DELETE-GF-18-4. NC2184.2 +193300 PERFORM DE-LETE. NC2184.2 +193400 GO TO UST-WRITE-GF-18-4. NC2184.2 +193500 UST-FAIL-GF-18-4. NC2184.2 +193600 PERFORM FAIL NC2184.2 +193700 MOVE ID6-DU-2V0-2 TO COMPUTED-N NC2184.2 +193800 MOVE 4 TO CORRECT-N. NC2184.2 +193900 UST-WRITE-GF-18-4. NC2184.2 +194000 PERFORM PRINT-DETAIL. NC2184.2 +194100* NC2184.2 +194200 UST-TEST-GF-18-5. NC2184.2 +194300 ADD 1 TO REC-CT. NC2184.2 +194400 IF ID11-DU-2V0 = 3 NC2184.2 +194500 PERFORM PASS NC2184.2 +194600 GO TO UST-WRITE-GF-18-5 NC2184.2 +194700 ELSE NC2184.2 +194800 GO TO UST-FAIL-GF-18-5. NC2184.2 +194900 UST-DELETE-GF-18-5. NC2184.2 +195000 PERFORM DE-LETE. NC2184.2 +195100 GO TO UST-WRITE-GF-18-5. NC2184.2 +195200 UST-FAIL-GF-18-5. NC2184.2 +195300 PERFORM FAIL NC2184.2 +195400 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +195500 MOVE 3 TO CORRECT-N. NC2184.2 +195600 UST-WRITE-GF-18-5. NC2184.2 +195700 PERFORM PRINT-DETAIL. NC2184.2 +195800* NC2184.2 +195900 UST-TEST-GF-18-6. NC2184.2 +196000 ADD 1 TO REC-CT. NC2184.2 +196100 IF ID5-XN-4-2 = SPACES AND ID6-DU-2V0-2 = 4 NC2184.2 +196200 PERFORM PASS NC2184.2 +196300 GO TO UST-WRITE-GF-18-6 NC2184.2 +196400 ELSE NC2184.2 +196500 GO TO UST-FAIL-GF-18-6. NC2184.2 +196600 UST-DELETE-GF-18-6. NC2184.2 +196700 PERFORM DE-LETE. NC2184.2 +196800 GO TO UST-WRITE-GF-18-6. NC2184.2 +196900 UST-FAIL-GF-18-6. NC2184.2 +197000 PERFORM FAIL NC2184.2 +197100 MOVE ID5-XN-4-2 TO COMPUTED-A NC2184.2 +197200 MOVE 4 TO CORRECT-A. NC2184.2 +197300 UST-WRITE-GF-18-6. NC2184.2 +197400 PERFORM PRINT-DETAIL. NC2184.2 +197500* NC2184.2 +197600 UST-INIT-GF-19. NC2184.2 +197700 MOVE "UST-TEST-GF-19" TO PAR-NAME. NC2184.2 +197800 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +197900 MOVE "QUALIFIED ID1" TO FEATURE. NC2184.2 +198000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" TO GRP1-XN-X-36. NC2184.2 +198100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +198200 MOVE "****" TO ID5-XN-4. NC2184.2 +198300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +198400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +198500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +198600 MOVE 1 TO REC-CT. NC2184.2 +198700* NC2184.2 +198800 UST-TEST-GF-19-0. NC2184.2 +198900 UNSTRING ID1 OF GRP1-XN-X-36 (ID10-DU-2V0) INTO GRP4-XN-6 NC2184.2 +199000 POINTER ID10-DU-2V0. NC2184.2 +199100 GO TO UST-TEST-GF-19-1. NC2184.2 +199200 UST-DELETE-GF-19. NC2184.2 +199300 PERFORM DE-LETE. NC2184.2 +199400 PERFORM PRINT-DETAIL. NC2184.2 +199500 GO TO UST-INIT-GF-20. NC2184.2 +199600* NC2184.2 +199700 UST-TEST-GF-19-1. NC2184.2 +199800 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +199900 PERFORM PASS NC2184.2 +200000 GO TO UST-WRITE-GF-19-1 NC2184.2 +200100 ELSE NC2184.2 +200200 GO TO UST-FAIL-GF-19-1. NC2184.2 +200300 UST-DELETE-GF-19-1. NC2184.2 +200400 PERFORM DE-LETE. NC2184.2 +200500 GO TO UST-WRITE-GF-19-1. NC2184.2 +200600 UST-FAIL-GF-19-1. NC2184.2 +200700 PERFORM FAIL NC2184.2 +200800 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +200900 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +201000 UST-WRITE-GF-19-1. NC2184.2 +201100 PERFORM PRINT-DETAIL. NC2184.2 +201200* NC2184.2 +201300 UST-TEST-GF-19-2. NC2184.2 +201400 ADD 1 TO REC-CT. NC2184.2 +201500 IF ID10-DU-2V0 = 7 NC2184.2 +201600 PERFORM PASS NC2184.2 +201700 GO TO UST-WRITE-GF-19-2 NC2184.2 +201800 ELSE NC2184.2 +201900 GO TO UST-FAIL-GF-19-2. NC2184.2 +202000 UST-DELETE-GF-19-2. NC2184.2 +202100 PERFORM DE-LETE. NC2184.2 +202200 GO TO UST-WRITE-GF-19-2. NC2184.2 +202300 UST-FAIL-GF-19-2. NC2184.2 +202400 PERFORM FAIL NC2184.2 +202500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +202600 MOVE 7 TO CORRECT-N. NC2184.2 +202700 UST-WRITE-GF-19-2. NC2184.2 +202800 PERFORM PRINT-DETAIL. NC2184.2 +202900* NC2184.2 +203000 UST-TEST-GF-19-3. NC2184.2 +203100 ADD 1 TO REC-CT. NC2184.2 +203200 IF ID11-DU-2V0 = ZERO NC2184.2 +203300 PERFORM PASS NC2184.2 +203400 GO TO UST-WRITE-GF-19-3 NC2184.2 +203500 ELSE NC2184.2 +203600 GO TO UST-FAIL-GF-19-3. NC2184.2 +203700 UST-DELETE-GF-19-3. NC2184.2 +203800 PERFORM DE-LETE. NC2184.2 +203900 GO TO UST-WRITE-GF-19-3. NC2184.2 +204000 UST-FAIL-GF-19-3. NC2184.2 +204100 PERFORM FAIL NC2184.2 +204200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +204300 MOVE ZERO TO CORRECT-N. NC2184.2 +204400 UST-WRITE-GF-19-3. NC2184.2 +204500 PERFORM PRINT-DETAIL. NC2184.2 +204600* NC2184.2 +204700 UST-INIT-GF-20. NC2184.2 +204800 MOVE "UST-TEST-GF-20" TO PAR-NAME. NC2184.2 +204900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +205000 MOVE "MULT RECEIVE AREAS" TO FEATURE. NC2184.2 +205100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +205200 MOVE "****" TO ID4C-XXXX. NC2184.2 +205300 MOVE "*" TO ID4D-X. NC2184.2 +205400 MOVE "****" TO ID5-XN-4. NC2184.2 +205500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +205600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +205700 MOVE 1 TO ID11-DU-2V0. NC2184.2 +205800 MOVE 1 TO REC-CT. NC2184.2 +205900* NC2184.2 +206000 UST-TEST-GF-20. NC2184.2 +206100 UNSTRING ID1 OF GRP1-XN-X-36 (ID11-DU-2V0) NC2184.2 +206200 INTO ID4A-XXXXX ID4B-X ID4C-XXXX ID4D-X NC2184.2 +206300 TALLYING ID11-DU-2V0. NC2184.2 +206400 GO TO UST-TEST-GF-20-1. NC2184.2 +206500 UST-DELETE-GF-20. NC2184.2 +206600 PERFORM DE-LETE. NC2184.2 +206700 PERFORM PRINT-DETAIL. NC2184.2 +206800 GO TO UST-INIT-GF-21. NC2184.2 +206900* NC2184.2 +207000 UST-TEST-GF-20-1. NC2184.2 +207100 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +207200 PERFORM PASS NC2184.2 +207300 GO TO UST-WRITE-GF-20-1 NC2184.2 +207400 ELSE NC2184.2 +207500 GO TO UST-FAIL-GF-20-1. NC2184.2 +207600 UST-DELETE-GF-20-1. NC2184.2 +207700 PERFORM DE-LETE. NC2184.2 +207800 GO TO UST-WRITE-GF-20-1. NC2184.2 +207900 UST-FAIL-GF-20-1. NC2184.2 +208000 PERFORM FAIL NC2184.2 +208100 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +208200 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +208300 UST-WRITE-GF-20-1. NC2184.2 +208400 PERFORM PRINT-DETAIL. NC2184.2 +208500* NC2184.2 +208600 UST-TEST-GF-20-2. NC2184.2 +208700 ADD 1 TO REC-CT. NC2184.2 +208800 IF ID4C-XXXX = "****" NC2184.2 +208900 PERFORM PASS NC2184.2 +209000 GO TO UST-WRITE-GF-20-2 NC2184.2 +209100 ELSE NC2184.2 +209200 GO TO UST-FAIL-GF-20-2. NC2184.2 +209300 UST-DELETE-GF-20-2. NC2184.2 +209400 PERFORM DE-LETE. NC2184.2 +209500 GO TO UST-WRITE-GF-20-2. NC2184.2 +209600 UST-FAIL-GF-20-2. NC2184.2 +209700 PERFORM FAIL NC2184.2 +209800 MOVE ID4C-XXXX TO COMPUTED-A NC2184.2 +209900 MOVE "****" TO CORRECT-A. NC2184.2 +210000 UST-WRITE-GF-20-2. NC2184.2 +210100 PERFORM PRINT-DETAIL. NC2184.2 +210200* NC2184.2 +210300 UST-TEST-GF-20-3. NC2184.2 +210400 ADD 1 TO REC-CT. NC2184.2 +210500 IF ID4D-X = "*" NC2184.2 +210600 PERFORM PASS NC2184.2 +210700 GO TO UST-WRITE-GF-20-3 NC2184.2 +210800 ELSE NC2184.2 +210900 GO TO UST-FAIL-GF-20-3. NC2184.2 +211000 UST-DELETE-GF-20-3. NC2184.2 +211100 PERFORM DE-LETE. NC2184.2 +211200 GO TO UST-WRITE-GF-20-3. NC2184.2 +211300 UST-FAIL-GF-20-3. NC2184.2 +211400 PERFORM FAIL NC2184.2 +211500 MOVE ID4D-X TO COMPUTED-A NC2184.2 +211600 MOVE "*" TO CORRECT-A. NC2184.2 +211700 UST-WRITE-GF-20-3. NC2184.2 +211800 PERFORM PRINT-DETAIL. NC2184.2 +211900* NC2184.2 +212000 UST-TEST-GF-20-4. NC2184.2 +212100 ADD 1 TO REC-CT. NC2184.2 +212200 IF ID11-DU-2V0 = 3 NC2184.2 +212300 PERFORM PASS NC2184.2 +212400 GO TO UST-WRITE-GF-20-4 NC2184.2 +212500 ELSE NC2184.2 +212600 GO TO UST-FAIL-GF-20-4. NC2184.2 +212700 UST-DELETE-GF-20-4. NC2184.2 +212800 PERFORM DE-LETE. NC2184.2 +212900 GO TO UST-WRITE-GF-20-4. NC2184.2 +213000 UST-FAIL-GF-20-4. NC2184.2 +213100 PERFORM FAIL NC2184.2 +213200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +213300 MOVE 3 TO CORRECT-N. NC2184.2 +213400 UST-WRITE-GF-20-4. NC2184.2 +213500 PERFORM PRINT-DETAIL. NC2184.2 +213600* NC2184.2 +213700 UST-INIT-GF-21. NC2184.2 +213800 MOVE "UST-TEST-GF-21" TO PAR-NAME. NC2184.2 +213900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +214000 MOVE "TRUNCATION CHECKS" TO FEATURE. NC2184.2 +214100 MOVE "ABCDEFGHIJKL" TO ID1-XN-12. NC2184.2 +214200 MOVE ALL "*" TO GRP4-XN-10. NC2184.2 +214300 MOVE 1 TO ID11-DU-2V0. NC2184.2 +214400 MOVE 1 TO REC-CT. NC2184.2 +214500* NC2184.2 +214600 UST-TEST-GF-21. NC2184.2 +214700 UNSTRING ID1-XN-12 NC2184.2 +214800 DELIMITED BY "E" OR "H" OR "K" OR "L" NC2184.2 +214900 INTO ID4C-XXX ID4B-XX ID4A-X NC2184.2 +215000 TALLYING IN ID11-DU-2V0. NC2184.2 +215100 GO TO UST-TEST-GF-21-1. NC2184.2 +215200 UNSTRING-DELETE. NC2184.2 +215300 PERFORM DE-LETE. NC2184.2 +215400 PERFORM PRINT-DETAIL. NC2184.2 +215500 GO TO UST-INIT-GF-22. NC2184.2 +215600* NC2184.2 +215700 UST-TEST-GF-21-1. NC2184.2 +215800 IF ID4C-XXX = "ABC" NC2184.2 +215900 PERFORM PASS NC2184.2 +216000 GO TO UST-WRITE-GF-21-1 NC2184.2 +216100 ELSE NC2184.2 +216200 GO TO UST-FAIL-GF-21-1. NC2184.2 +216300 UST-DELETE-GF-21-1. NC2184.2 +216400 PERFORM DE-LETE. NC2184.2 +216500 GO TO UST-WRITE-GF-21-1. NC2184.2 +216600 UST-FAIL-GF-21-1. NC2184.2 +216700 PERFORM FAIL NC2184.2 +216800 MOVE ID4C-XXX TO COMPUTED-A NC2184.2 +216900 MOVE "ABC" TO CORRECT-A. NC2184.2 +217000 UST-WRITE-GF-21-1. NC2184.2 +217100 PERFORM PRINT-DETAIL. NC2184.2 +217200* NC2184.2 +217300 UST-TEST-GF-21-2. NC2184.2 +217400 ADD 1 TO REC-CT. NC2184.2 +217500 IF ID4B-XX = "FG" NC2184.2 +217600 PERFORM PASS NC2184.2 +217700 GO TO UST-WRITE-GF-21-2 NC2184.2 +217800 ELSE NC2184.2 +217900 GO TO UST-FAIL-GF-21-2. NC2184.2 +218000 UST-DELETE-GF-21-2. NC2184.2 +218100 PERFORM DE-LETE. NC2184.2 +218200 GO TO UST-WRITE-GF-21-2. NC2184.2 +218300 UST-FAIL-GF-21-2. NC2184.2 +218400 PERFORM FAIL NC2184.2 +218500 MOVE ID4B-XX TO COMPUTED-A NC2184.2 +218600 MOVE "FG" TO CORRECT-A. NC2184.2 +218700 UST-WRITE-GF-21-2. NC2184.2 +218800 PERFORM PRINT-DETAIL. NC2184.2 +218900* NC2184.2 +219000 UST-TEST-GF-21-3. NC2184.2 +219100 ADD 1 TO REC-CT. NC2184.2 +219200 IF ID4A-X = "I" NC2184.2 +219300 PERFORM PASS NC2184.2 +219400 GO TO UST-WRITE-GF-21-3 NC2184.2 +219500 ELSE NC2184.2 +219600 GO TO UST-FAIL-GF-21-3. NC2184.2 +219700 UST-DELETE-GF-21-3. NC2184.2 +219800 PERFORM DE-LETE. NC2184.2 +219900 GO TO UST-WRITE-GF-21-3. NC2184.2 +220000 UST-FAIL-GF-21-3. NC2184.2 +220100 PERFORM FAIL NC2184.2 +220200 MOVE ID4A-X TO COMPUTED-A NC2184.2 +220300 MOVE "I" TO CORRECT-A. NC2184.2 +220400 UST-WRITE-GF-21-3. NC2184.2 +220500 PERFORM PRINT-DETAIL. NC2184.2 +220600* NC2184.2 +220700 UST-TEST-GF-21-4. NC2184.2 +220800 ADD 1 TO REC-CT. NC2184.2 +220900 IF ID11-DU-2V0 = 4 NC2184.2 +221000 PERFORM PASS NC2184.2 +221100 GO TO UST-WRITE-GF-21-4 NC2184.2 +221200 ELSE NC2184.2 +221300 GO TO UST-FAIL-GF-21-4. NC2184.2 +221400 UST-DELETE-GF-21-4. NC2184.2 +221500 PERFORM DE-LETE. NC2184.2 +221600 GO TO UST-WRITE-GF-21-4. NC2184.2 +221700 UST-FAIL-GF-21-4. NC2184.2 +221800 PERFORM FAIL NC2184.2 +221900 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +222000 MOVE 4 TO CORRECT-N. NC2184.2 +222100 UST-WRITE-GF-21-4. NC2184.2 +222200 PERFORM PRINT-DETAIL. NC2184.2 +222300* NC2184.2 +222400 UST-INIT-GF-22. NC2184.2 +222500* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +222600 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +222700 MOVE "UST-TEST-GF-22" TO PAR-NAME. NC2184.2 +222800 MOVE "PIC X " TO FEATURE. NC2184.2 +222900 MOVE ZERO TO ID4-X. NC2184.2 +223000 MOVE "****" TO ID5-XN-4. NC2184.2 +223100 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +223200 MOVE 1 TO ID10-DU-2V0. NC2184.2 +223300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +223400 MOVE 1 TO REC-CT. NC2184.2 +223500* NC2184.2 +223600 UST-TEST-GF-22-1. NC2184.2 +223700 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X DELIMITER IN NC2184.2 +223800 ID5-XN-4 COUNT IN ID6-DU-2V0 WITH POINTER ID10-DU-2V0NC2184.2 +223900 TALLYING ID11-DU-2V0 NC2184.2 +224000 NOT ON OVERFLOW GO TO UST-FAIL-GF-22-1. NC2184.2 +224100 PERFORM PASS. NC2184.2 +224200 GO TO UST-WRITE-GF-22-1. NC2184.2 +224300 UST-DELETE-GF-22-1. NC2184.2 +224400 PERFORM DE-LETE. NC2184.2 +224500 PERFORM PRINT-DETAIL. NC2184.2 +224600 GO TO UST-INIT-GF-23. NC2184.2 +224700 UST-FAIL-GF-22-1. NC2184.2 +224800 PERFORM FAIL. NC2184.2 +224900 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK.NC2184.2 +225000 UST-WRITE-GF-22-1. NC2184.2 +225100 PERFORM PRINT-DETAIL. NC2184.2 +225200* NC2184.2 +225300 UST-TEST-GF-22-2. NC2184.2 +225400 ADD 1 TO REC-CT. NC2184.2 +225500 IF ID4-X = "1" NC2184.2 +225600 PERFORM PASS NC2184.2 +225700 GO TO UST-WRITE-GF-22-2 NC2184.2 +225800 ELSE NC2184.2 +225900 GO TO UST-FAIL-GF-22-2. NC2184.2 +226000 UST-DELETE-GF-22-2. NC2184.2 +226100 PERFORM DE-LETE. NC2184.2 +226200 GO TO UST-WRITE-GF-22-2. NC2184.2 +226300 UST-FAIL-GF-22-2. NC2184.2 +226400 PERFORM FAIL NC2184.2 +226500 MOVE ID4-X TO COMPUTED-A NC2184.2 +226600 MOVE "1" TO CORRECT-A. NC2184.2 +226700 UST-WRITE-GF-22-2. NC2184.2 +226800 PERFORM PRINT-DETAIL. NC2184.2 +226900* NC2184.2 +227000 UST-TEST-GF-22-3. NC2184.2 +227100 ADD 1 TO REC-CT. NC2184.2 +227200 IF ID5-XN-4 = "0 " NC2184.2 +227300 PERFORM PASS NC2184.2 +227400 GO TO UST-WRITE-GF-22-3 NC2184.2 +227500 ELSE NC2184.2 +227600 GO TO UST-FAIL-GF-22-3. NC2184.2 +227700 UST-DELETE-GF-22-3. NC2184.2 +227800 PERFORM DE-LETE. NC2184.2 +227900 GO TO UST-WRITE-GF-22-3. NC2184.2 +228000 UST-FAIL-GF-22-3. NC2184.2 +228100 PERFORM FAIL NC2184.2 +228200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +228300 MOVE "0 " TO CORRECT-A. NC2184.2 +228400 UST-WRITE-GF-22-3. NC2184.2 +228500 PERFORM PRINT-DETAIL. NC2184.2 +228600* NC2184.2 +228700 UST-TEST-GF-22-4. NC2184.2 +228800 ADD 1 TO REC-CT. NC2184.2 +228900 IF ID6-DU-2V0 = 2 NC2184.2 +229000 PERFORM PASS NC2184.2 +229100 GO TO UST-WRITE-GF-22-4 NC2184.2 +229200 ELSE NC2184.2 +229300 GO TO UST-FAIL-GF-22-4. NC2184.2 +229400 UST-DELETE-GF-22-4. NC2184.2 +229500 PERFORM DE-LETE. NC2184.2 +229600 GO TO UST-WRITE-GF-22-4. NC2184.2 +229700 UST-FAIL-GF-22-4. NC2184.2 +229800 PERFORM FAIL NC2184.2 +229900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +230000 MOVE 2 TO CORRECT-N. NC2184.2 +230100 UST-WRITE-GF-22-4. NC2184.2 +230200 PERFORM PRINT-DETAIL. NC2184.2 +230300* NC2184.2 +230400 UST-TEST-GF-22-5. NC2184.2 +230500 ADD 1 TO REC-CT. NC2184.2 +230600 IF ID10-DU-2V0 = 4 NC2184.2 +230700 PERFORM PASS NC2184.2 +230800 GO TO UST-WRITE-GF-22-5 NC2184.2 +230900 ELSE NC2184.2 +231000 GO TO UST-FAIL-GF-22-5. NC2184.2 +231100 UST-DELETE-GF-22-5. NC2184.2 +231200 PERFORM DE-LETE. NC2184.2 +231300 GO TO UST-WRITE-GF-22-5. NC2184.2 +231400 UST-FAIL-GF-22-5. NC2184.2 +231500 PERFORM FAIL NC2184.2 +231600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +231700 MOVE 4 TO CORRECT-N. NC2184.2 +231800 UST-WRITE-GF-22-5. NC2184.2 +231900 PERFORM PRINT-DETAIL. NC2184.2 +232000* NC2184.2 +232100 UST-TEST-GF-22-6. NC2184.2 +232200 ADD 1 TO REC-CT. NC2184.2 +232300 IF ID11-DU-2V0 = 1 NC2184.2 +232400 PERFORM PASS NC2184.2 +232500 GO TO UST-WRITE-GF-22-6 NC2184.2 +232600 ELSE NC2184.2 +232700 GO TO UST-FAIL-GF-22-6. NC2184.2 +232800 UST-DELETE-GF-22-6. NC2184.2 +232900 PERFORM DE-LETE. NC2184.2 +233000 GO TO UST-WRITE-GF-22-6. NC2184.2 +233100 UST-FAIL-GF-22-6. NC2184.2 +233200 PERFORM FAIL NC2184.2 +233300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +233400 MOVE 1 TO CORRECT-N. NC2184.2 +233500 UST-WRITE-GF-22-6. NC2184.2 +233600 PERFORM PRINT-DETAIL. NC2184.2 +233700* NC2184.2 +233800 UST-INIT-GF-23. NC2184.2 +233900* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +234000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +234100 MOVE "UST-TEST-GF-23" TO PAR-NAME. NC2184.2 +234200 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +234300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +234400 MOVE "****" TO ID5-XN-4. NC2184.2 +234500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +234600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +234700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +234800 MOVE 1 TO REC-CT. NC2184.2 +234900* NC2184.2 +235000 UST-TEST-GF-23-1. NC2184.2 +235100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +235200 NOT ON OVERFLOW PERFORM PASS NC2184.2 +235300 GO TO UST-WRITE-GF-23-1. NC2184.2 +235400 GO TO UST-FAIL-GF-23-1. NC2184.2 +235500 UST-DELETE-GF-23-1. NC2184.2 +235600 PERFORM DE-LETE. NC2184.2 +235700 PERFORM PRINT-DETAIL. NC2184.2 +235800 GO TO UST-INIT-GF-24. NC2184.2 +235900 UST-FAIL-GF-23-1. NC2184.2 +236000 PERFORM FAIL. NC2184.2 +236100 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +236200 UST-WRITE-GF-23-1. NC2184.2 +236300 PERFORM PRINT-DETAIL. NC2184.2 +236400* NC2184.2 +236500 UST-TEST-GF-23-2. NC2184.2 +236600 ADD 1 TO REC-CT. NC2184.2 +236700 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +236800 PERFORM PASS NC2184.2 +236900 GO TO UST-WRITE-GF-23-2 NC2184.2 +237000 ELSE NC2184.2 +237100 GO TO UST-FAIL-GF-23-2. NC2184.2 +237200 UST-DELETE-GF-23-2. NC2184.2 +237300 PERFORM DE-LETE. NC2184.2 +237400 GO TO UST-WRITE-GF-23-2. NC2184.2 +237500 UST-FAIL-GF-23-2. NC2184.2 +237600 PERFORM FAIL NC2184.2 +237700 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +237800 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +237900 UST-WRITE-GF-23-2. NC2184.2 +238000 PERFORM PRINT-DETAIL. NC2184.2 +238100* NC2184.2 +238200 UST-INIT-GF-24. NC2184.2 +238300* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2184.2 +238400 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +238500 MOVE "UST-TEST-GF-24" TO PAR-NAME. NC2184.2 +238600 MOVE "PIC X " TO FEATURE. NC2184.2 +238700 MOVE ZERO TO ID4-X. NC2184.2 +238800 MOVE "****" TO ID5-XN-4. NC2184.2 +238900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +239000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +239100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +239200 MOVE 1 TO REC-CT. NC2184.2 +239300* NC2184.2 +239400 UST-TEST-GF-24-1. NC2184.2 +239500 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +239600 DELIMITER IN ID5-XN-4 NC2184.2 +239700 COUNT IN ID6-DU-2V0 NC2184.2 +239800 WITH POINTER ID10-DU-2V0 NC2184.2 +239900 TALLYING ID11-DU-2V0 NC2184.2 +240000 ON OVERFLOW PERFORM PASS NC2184.2 +240100 GO TO UST-WRITE-GF-24-1 NC2184.2 +240200 NOT ON OVERFLOW GO TO UST-FAIL-GF-24-1. NC2184.2 +240300 UST-DELETE-GF-24-1. NC2184.2 +240400 PERFORM DE-LETE. NC2184.2 +240500 PERFORM PRINT-DETAIL. NC2184.2 +240600 GO TO UST-INIT-GF-25. NC2184.2 +240700 UST-FAIL-GF-24-1. NC2184.2 +240800 PERFORM FAIL. NC2184.2 +240900 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +241000 UST-WRITE-GF-24-1. NC2184.2 +241100 PERFORM PRINT-DETAIL. NC2184.2 +241200* NC2184.2 +241300 UST-TEST-GF-24-2. NC2184.2 +241400 ADD 1 TO REC-CT. NC2184.2 +241500 IF ID4-X = "1" NC2184.2 +241600 PERFORM PASS NC2184.2 +241700 GO TO UST-WRITE-GF-24-2 NC2184.2 +241800 ELSE NC2184.2 +241900 GO TO UST-FAIL-GF-24-2. NC2184.2 +242000 UST-DELETE-GF-24-2. NC2184.2 +242100 PERFORM DE-LETE. NC2184.2 +242200 GO TO UST-WRITE-GF-24-2. NC2184.2 +242300 UST-FAIL-GF-24-2. NC2184.2 +242400 PERFORM FAIL NC2184.2 +242500 MOVE ID4-X TO COMPUTED-A NC2184.2 +242600 MOVE "1" TO CORRECT-A. NC2184.2 +242700 UST-WRITE-GF-24-2. NC2184.2 +242800 PERFORM PRINT-DETAIL. NC2184.2 +242900* NC2184.2 +243000 UST-TEST-GF-24-3. NC2184.2 +243100 ADD 1 TO REC-CT. NC2184.2 +243200 IF ID5-XN-4 = "0 " NC2184.2 +243300 PERFORM PASS NC2184.2 +243400 GO TO UST-WRITE-GF-24-3 NC2184.2 +243500 ELSE NC2184.2 +243600 GO TO UST-FAIL-GF-24-3. NC2184.2 +243700 UST-DELETE-GF-24-3. NC2184.2 +243800 PERFORM DE-LETE. NC2184.2 +243900 GO TO UST-WRITE-GF-24-3. NC2184.2 +244000 UST-FAIL-GF-24-3. NC2184.2 +244100 PERFORM FAIL NC2184.2 +244200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +244300 MOVE "0 " TO CORRECT-A. NC2184.2 +244400 UST-WRITE-GF-24-3. NC2184.2 +244500 PERFORM PRINT-DETAIL. NC2184.2 +244600* NC2184.2 +244700 UST-TEST-GF-24-4. NC2184.2 +244800 ADD 1 TO REC-CT. NC2184.2 +244900 IF ID6-DU-2V0 = 2 NC2184.2 +245000 PERFORM PASS NC2184.2 +245100 GO TO UST-WRITE-GF-24-4 NC2184.2 +245200 ELSE NC2184.2 +245300 GO TO UST-FAIL-GF-24-4. NC2184.2 +245400 UST-DELETE-GF-24-4. NC2184.2 +245500 PERFORM DE-LETE. NC2184.2 +245600 GO TO UST-WRITE-GF-24-4. NC2184.2 +245700 UST-FAIL-GF-24-4. NC2184.2 +245800 PERFORM FAIL NC2184.2 +245900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +246000 MOVE 2 TO CORRECT-N. NC2184.2 +246100 UST-WRITE-GF-24-4. NC2184.2 +246200 PERFORM PRINT-DETAIL. NC2184.2 +246300* NC2184.2 +246400 UST-TEST-GF-24-5. NC2184.2 +246500 ADD 1 TO REC-CT. NC2184.2 +246600 IF ID10-DU-2V0 = 4 NC2184.2 +246700 PERFORM PASS NC2184.2 +246800 GO TO UST-WRITE-GF-24-5 NC2184.2 +246900 ELSE NC2184.2 +247000 GO TO UST-FAIL-GF-24-5. NC2184.2 +247100 UST-DELETE-GF-24-5. NC2184.2 +247200 PERFORM DE-LETE. NC2184.2 +247300 GO TO UST-WRITE-GF-24-5. NC2184.2 +247400 UST-FAIL-GF-24-5. NC2184.2 +247500 PERFORM FAIL NC2184.2 +247600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +247700 MOVE 4 TO CORRECT-N. NC2184.2 +247800 UST-WRITE-GF-24-5. NC2184.2 +247900 PERFORM PRINT-DETAIL. NC2184.2 +248000* NC2184.2 +248100 UST-TEST-GF-24-6. NC2184.2 +248200 ADD 1 TO REC-CT. NC2184.2 +248300 IF ID11-DU-2V0 = 1 NC2184.2 +248400 PERFORM PASS NC2184.2 +248500 GO TO UST-WRITE-GF-24-6 NC2184.2 +248600 ELSE NC2184.2 +248700 GO TO UST-FAIL-GF-24-6. NC2184.2 +248800 UST-DELETE-GF-24-6. NC2184.2 +248900 PERFORM DE-LETE. NC2184.2 +249000 GO TO UST-WRITE-GF-24-6. NC2184.2 +249100 UST-FAIL-GF-24-6. NC2184.2 +249200 PERFORM FAIL NC2184.2 +249300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +249400 MOVE 1 TO CORRECT-N. NC2184.2 +249500 UST-WRITE-GF-24-6. NC2184.2 +249600 PERFORM PRINT-DETAIL. NC2184.2 +249700* NC2184.2 +249800 UST-INIT-GF-25. NC2184.2 +249900* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2184.2 +250000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +250100 MOVE "UST-TEST-GF-25" TO PAR-NAME. NC2184.2 +250200 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +250300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +250400 MOVE "****" TO ID5-XN-4. NC2184.2 +250500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +250600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +250700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +250800 MOVE 1 TO REC-CT. NC2184.2 +250900* NC2184.2 +251000 UST-TEST-GF-25-1. NC2184.2 +251100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +251200 ON OVERFLOW GO TO UST-FAIL-GF-25-1 NC2184.2 +251300 NOT ON OVERFLOW PERFORM PASS NC2184.2 +251400 GO TO UST-WRITE-GF-25-1. NC2184.2 +251500 UST-DELETE-GF-25-1. NC2184.2 +251600 PERFORM DE-LETE. NC2184.2 +251700 PERFORM PRINT-DETAIL. NC2184.2 +251800 GO TO UST-INIT-GF-26. NC2184.2 +251900 UST-FAIL-GF-25-1. NC2184.2 +252000 PERFORM FAIL. NC2184.2 +252100 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2184.2 +252200 UST-WRITE-GF-25-1. NC2184.2 +252300 PERFORM PRINT-DETAIL. NC2184.2 +252400* NC2184.2 +252500 UST-TEST-GF-25-2. NC2184.2 +252600 ADD 1 TO REC-CT. NC2184.2 +252700 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +252800 PERFORM PASS NC2184.2 +252900 GO TO UST-WRITE-GF-25-2 NC2184.2 +253000 ELSE NC2184.2 +253100 GO TO UST-FAIL-GF-25-2. NC2184.2 +253200 UST-DELETE-GF-25-2. NC2184.2 +253300 PERFORM DE-LETE. NC2184.2 +253400 GO TO UST-WRITE-GF-25-2. NC2184.2 +253500 UST-FAIL-GF-25-2. NC2184.2 +253600 PERFORM FAIL NC2184.2 +253700 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +253800 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +253900 UST-WRITE-GF-25-2. NC2184.2 +254000 PERFORM PRINT-DETAIL. NC2184.2 +254100* NC2184.2 +254200 UST-INIT-GF-26. NC2184.2 +254300* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +254400 MOVE "VI-138 6.26.4 GR19" TO ANSI-REFERENCE. NC2184.2 +254500 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +254600 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +254700 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +254800 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +254900 MOVE ZERO TO REC-CT. NC2184.2 +255000* NC2184.2 +255100 UST-TEST-GF-26-0. NC2184.2 +255200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +255300 ON OVERFLOW NC2184.2 +255400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +255500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +255600 NOT ON OVERFLOW NC2184.2 +255700 MOVE "C" TO WRK-XN-00001-1 NC2184.2 +255800 MOVE "D" TO WRK-XN-00001-2 NC2184.2 +255900 END-UNSTRING NC2184.2 +256000 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +256100 GO TO UST-TEST-GF-26-1. NC2184.2 +256200 UST-DELETE-GF-26. NC2184.2 +256300 PERFORM DE-LETE. NC2184.2 +256400 PERFORM PRINT-DETAIL. NC2184.2 +256500 GO TO UST-INIT-GF-27. NC2184.2 +256600* NC2184.2 +256700 UST-TEST-GF-26-1. NC2184.2 +256800 ADD 1 TO REC-CT. NC2184.2 +256900 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +257000 PERFORM PASS NC2184.2 +257100 GO TO UST-WRITE-GF-26-1 NC2184.2 +257200 ELSE NC2184.2 +257300 GO TO UST-FAIL-GF-26-1. NC2184.2 +257400 UST-DELETE-GF-26-1. NC2184.2 +257500 PERFORM DE-LETE. NC2184.2 +257600 GO TO UST-WRITE-GF-26-1. NC2184.2 +257700 UST-FAIL-GF-26-1. NC2184.2 +257800 PERFORM FAIL NC2184.2 +257900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +258000 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +258100 UST-WRITE-GF-26-1. NC2184.2 +258200 PERFORM PRINT-DETAIL. NC2184.2 +258300* NC2184.2 +258400 UST-TEST-GF-26-2. NC2184.2 +258500 ADD 1 TO REC-CT. NC2184.2 +258600 IF WRK-XN-00001-1 = "C" NC2184.2 +258700 PERFORM PASS NC2184.2 +258800 GO TO UST-WRITE-GF-26-2 NC2184.2 +258900 ELSE NC2184.2 +259000 GO TO UST-FAIL-GF-26-2. NC2184.2 +259100 UST-DELETE-GF-26-2. NC2184.2 +259200 PERFORM DE-LETE. NC2184.2 +259300 GO TO UST-WRITE-GF-26-2. NC2184.2 +259400 UST-FAIL-GF-26-2. NC2184.2 +259500 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +259600 MOVE "C" TO CORRECT-A. NC2184.2 +259700 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2184.2 +259800 PERFORM FAIL. NC2184.2 +259900 UST-WRITE-GF-26-2. NC2184.2 +260000 PERFORM PRINT-DETAIL. NC2184.2 +260100* NC2184.2 +260200 UST-TEST-GF-26-3. NC2184.2 +260300 ADD 1 TO REC-CT. NC2184.2 +260400 IF WRK-XN-00001-2 = "D" NC2184.2 +260500 PERFORM PASS NC2184.2 +260600 GO TO UST-WRITE-GF-26-3 NC2184.2 +260700 ELSE NC2184.2 +260800 GO TO UST-FAIL-GF-26-3. NC2184.2 +260900 UST-DELETE-GF-26-3. NC2184.2 +261000 PERFORM DE-LETE. NC2184.2 +261100 GO TO UST-WRITE-GF-26-3. NC2184.2 +261200 UST-FAIL-GF-26-3. NC2184.2 +261300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +261400 MOVE "D" TO CORRECT-A. NC2184.2 +261500 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2184.2 +261600 PERFORM FAIL. NC2184.2 +261700 UST-WRITE-GF-26-3. NC2184.2 +261800 PERFORM PRINT-DETAIL. NC2184.2 +261900* NC2184.2 +262000 UST-TEST-GF-26-4. NC2184.2 +262100 ADD 1 TO REC-CT. NC2184.2 +262200 IF WRK-XN-00001-3 = "Z" NC2184.2 +262300 PERFORM PASS NC2184.2 +262400 GO TO UST-WRITE-GF-26-4 NC2184.2 +262500 ELSE NC2184.2 +262600 GO TO UST-FAIL-GF-26-4. NC2184.2 +262700 UST-DELETE-GF-26-4. NC2184.2 +262800 PERFORM DE-LETE. NC2184.2 +262900 GO TO UST-WRITE-GF-26-4. NC2184.2 +263000 UST-FAIL-GF-26-4. NC2184.2 +263100 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +263200 MOVE "Z" TO CORRECT-A. NC2184.2 +263300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +263400 PERFORM FAIL. NC2184.2 +263500 UST-WRITE-GF-26-4. NC2184.2 +263600 PERFORM PRINT-DETAIL. NC2184.2 +263700* NC2184.2 +263800 UST-INIT-GF-27. NC2184.2 +263900* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +264000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +264100 MOVE "UST-TEST-GF-27" TO PAR-NAME. NC2184.2 +264200 MOVE "PIC X " TO FEATURE. NC2184.2 +264300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +264400 MOVE ZERO TO ID4-X. NC2184.2 +264500 MOVE "****" TO ID5-XN-4. NC2184.2 +264600 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +264700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +264800 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +264900 MOVE ZERO TO REC-CT. NC2184.2 +265000 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +265100 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +265200 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +265300* NC2184.2 +265400 UST-TEST-GF-27-0. NC2184.2 +265500 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +265600 DELIMITER IN ID5-XN-4 NC2184.2 +265700 COUNT IN ID6-DU-2V0 NC2184.2 +265800 WITH POINTER ID10-DU-2V0 NC2184.2 +265900 TALLYING ID11-DU-2V0 NC2184.2 +266000 ON OVERFLOW NC2184.2 +266100 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +266200 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +266300 END-UNSTRING NC2184.2 +266400 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +266500 GO TO UST-TEST-GF-27-1. NC2184.2 +266600 UST-DELETE-GF-27. NC2184.2 +266700 PERFORM DE-LETE. NC2184.2 +266800 PERFORM PRINT-DETAIL. NC2184.2 +266900 GO TO UST-INIT-GF-28. NC2184.2 +267000* NC2184.2 +267100 UST-TEST-GF-27-1. NC2184.2 +267200 ADD 1 TO REC-CT. NC2184.2 +267300 IF ID4-X = "1" NC2184.2 +267400 PERFORM PASS NC2184.2 +267500 GO TO UST-WRITE-GF-27-1 NC2184.2 +267600 ELSE NC2184.2 +267700 GO TO UST-FAIL-GF-27-1. NC2184.2 +267800 UST-DELETE-GF-27-1. NC2184.2 +267900 PERFORM DE-LETE. NC2184.2 +268000 GO TO UST-WRITE-GF-27-1. NC2184.2 +268100 UST-FAIL-GF-27-1. NC2184.2 +268200 PERFORM FAIL NC2184.2 +268300 MOVE ID4-X TO COMPUTED-A NC2184.2 +268400 MOVE "1" TO CORRECT-A. NC2184.2 +268500 UST-WRITE-GF-27-1. NC2184.2 +268600 PERFORM PRINT-DETAIL. NC2184.2 +268700* NC2184.2 +268800 UST-TEST-GF-27-2. NC2184.2 +268900 ADD 1 TO REC-CT. NC2184.2 +269000 IF ID5-XN-4 = "0 " NC2184.2 +269100 PERFORM PASS NC2184.2 +269200 GO TO UST-WRITE-GF-27-2 NC2184.2 +269300 ELSE NC2184.2 +269400 GO TO UST-FAIL-GF-27-2. NC2184.2 +269500 UST-DELETE-GF-27-2. NC2184.2 +269600 PERFORM DE-LETE. NC2184.2 +269700 GO TO UST-WRITE-GF-27-2. NC2184.2 +269800 UST-FAIL-GF-27-2. NC2184.2 +269900 PERFORM FAIL NC2184.2 +270000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +270100 MOVE "0 " TO CORRECT-A. NC2184.2 +270200 UST-WRITE-GF-27-2. NC2184.2 +270300 PERFORM PRINT-DETAIL. NC2184.2 +270400* NC2184.2 +270500 UST-TEST-GF-27-3. NC2184.2 +270600 ADD 1 TO REC-CT. NC2184.2 +270700 IF ID6-DU-2V0 = 2 NC2184.2 +270800 PERFORM PASS NC2184.2 +270900 GO TO UST-WRITE-GF-27-3 NC2184.2 +271000 ELSE NC2184.2 +271100 GO TO UST-FAIL-GF-27-3. NC2184.2 +271200 UST-DELETE-GF-27-3. NC2184.2 +271300 PERFORM DE-LETE. NC2184.2 +271400 GO TO UST-WRITE-GF-27-3. NC2184.2 +271500 UST-FAIL-GF-27-3. NC2184.2 +271600 PERFORM FAIL NC2184.2 +271700 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +271800 MOVE 2 TO CORRECT-N. NC2184.2 +271900 UST-WRITE-GF-27-3. NC2184.2 +272000 PERFORM PRINT-DETAIL. NC2184.2 +272100* NC2184.2 +272200 UST-TEST-GF-27-4. NC2184.2 +272300 ADD 1 TO REC-CT. NC2184.2 +272400 IF ID10-DU-2V0 = 4 NC2184.2 +272500 PERFORM PASS NC2184.2 +272600 GO TO UST-WRITE-GF-27-4 NC2184.2 +272700 ELSE NC2184.2 +272800 GO TO UST-FAIL-GF-27-4. NC2184.2 +272900 UST-DELETE-GF-27-4. NC2184.2 +273000 PERFORM DE-LETE. NC2184.2 +273100 GO TO UST-WRITE-GF-27-4. NC2184.2 +273200 UST-FAIL-GF-27-4. NC2184.2 +273300 PERFORM FAIL NC2184.2 +273400 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +273500 MOVE 4 TO CORRECT-N. NC2184.2 +273600 UST-WRITE-GF-27-4. NC2184.2 +273700 PERFORM PRINT-DETAIL. NC2184.2 +273800* NC2184.2 +273900 UST-TEST-GF-27-5. NC2184.2 +274000 ADD 1 TO REC-CT. NC2184.2 +274100 IF ID11-DU-2V0 = 1 NC2184.2 +274200 PERFORM PASS NC2184.2 +274300 GO TO UST-WRITE-GF-27-5 NC2184.2 +274400 ELSE NC2184.2 +274500 GO TO UST-FAIL-GF-27-5. NC2184.2 +274600 UST-DELETE-GF-27-5. NC2184.2 +274700 PERFORM DE-LETE. NC2184.2 +274800 GO TO UST-WRITE-GF-27-5. NC2184.2 +274900 UST-FAIL-GF-27-5. NC2184.2 +275000 PERFORM FAIL NC2184.2 +275100 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +275200 MOVE 1 TO CORRECT-N. NC2184.2 +275300 UST-WRITE-GF-27-5. NC2184.2 +275400* NC2184.2 +275500 UST-INIT-GF-28. NC2184.2 +275600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +275700 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +275800 MOVE "UST-TEST-GF-28" TO PAR-NAME. NC2184.2 +275900 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +276000 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +276100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +276200 MOVE "****" TO ID5-XN-4. NC2184.2 +276300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +276400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +276500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +276600 MOVE ZERO TO REC-CT. NC2184.2 +276700 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +276800 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +276900 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +277000* NC2184.2 +277100 UST-TEST-GF-28-0. NC2184.2 +277200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +277300 ON OVERFLOW NC2184.2 +277400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +277500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +277600 END-UNSTRING NC2184.2 +277700 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +277800 GO TO UST-TEST-GF-28-1. NC2184.2 +277900 UST-DELETE-GF-28. NC2184.2 +278000 PERFORM DE-LETE. NC2184.2 +278100 PERFORM PRINT-DETAIL. NC2184.2 +278200 GO TO UST-INIT-GF-29. NC2184.2 +278300* NC2184.2 +278400 UST-TEST-GF-28-1. NC2184.2 +278500 ADD 1 TO REC-CT. NC2184.2 +278600 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +278700 PERFORM PASS NC2184.2 +278800 GO TO UST-WRITE-GF-28-1 NC2184.2 +278900 ELSE NC2184.2 +279000 GO TO UST-FAIL-GF-28-1. NC2184.2 +279100 UST-DELETE-GF-28-1. NC2184.2 +279200 PERFORM DE-LETE. NC2184.2 +279300 GO TO UST-WRITE-GF-28-1. NC2184.2 +279400 UST-FAIL-GF-28-1. NC2184.2 +279500 PERFORM FAIL NC2184.2 +279600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +279700 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +279800 UST-WRITE-GF-28-1. NC2184.2 +279900 PERFORM PRINT-DETAIL. NC2184.2 +280000* NC2184.2 +280100* NC2184.2 +280200 UST-INIT-GF-29. NC2184.2 +280300* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +280400 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +280500 MOVE "UST-TEST-GF-29" TO PAR-NAME. NC2184.2 +280600 MOVE "PIC X " TO FEATURE. NC2184.2 +280700 MOVE "1200000" TO ID1-XN-7. NC2184.2 +280800 MOVE ZERO TO ID4-X. NC2184.2 +280900 MOVE "****" TO ID5-XN-4. NC2184.2 +281000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +281100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +281200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +281300 MOVE ZERO TO REC-CT. NC2184.2 +281400 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +281500 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +281600 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +281700* NC2184.2 +281800 UST-TEST-GF-29-0. NC2184.2 +281900 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +282000 DELIMITER IN ID5-XN-4 NC2184.2 +282100 COUNT IN ID6-DU-2V0 NC2184.2 +282200 WITH POINTER ID10-DU-2V0 NC2184.2 +282300 TALLYING ID11-DU-2V0 NC2184.2 +282400 NOT ON OVERFLOW NC2184.2 +282500 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +282600 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +282700 END-UNSTRING NC2184.2 +282800 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +282900 GO TO UST-TEST-GF-29-1. NC2184.2 +283000 UST-DELETE-GF-29. NC2184.2 +283100 PERFORM DE-LETE. NC2184.2 +283200 PERFORM PRINT-DETAIL. NC2184.2 +283300 GO TO UST-INIT-GF-30. NC2184.2 +283400* NC2184.2 +283500 UST-TEST-GF-29-1. NC2184.2 +283600 MOVE "UST-TEST-GF-29-1" TO PAR-NAME. NC2184.2 +283700 ADD 1 TO REC-CT. NC2184.2 +283800 IF ID4-X = "1" NC2184.2 +283900 PERFORM PASS NC2184.2 +284000 GO TO UST-WRITE-GF-29-1 NC2184.2 +284100 ELSE NC2184.2 +284200 GO TO UST-FAIL-GF-29-1. NC2184.2 +284300 UST-DELETE-GF-29-1. NC2184.2 +284400 PERFORM DE-LETE. NC2184.2 +284500 GO TO UST-WRITE-GF-29-1. NC2184.2 +284600 UST-FAIL-GF-29-1. NC2184.2 +284700 PERFORM FAIL NC2184.2 +284800 MOVE ID4-X TO COMPUTED-A NC2184.2 +284900 MOVE "1" TO CORRECT-A. NC2184.2 +285000 UST-WRITE-GF-29-1. NC2184.2 +285100 PERFORM PRINT-DETAIL. NC2184.2 +285200* NC2184.2 +285300 UST-TEST-GF-29-2. NC2184.2 +285400 ADD 1 TO REC-CT. NC2184.2 +285500 IF ID5-XN-4 = "0 " NC2184.2 +285600 PERFORM PASS NC2184.2 +285700 GO TO UST-WRITE-GF-29-2 NC2184.2 +285800 ELSE NC2184.2 +285900 GO TO UST-FAIL-GF-29-2. NC2184.2 +286000 UST-DELETE-GF-29-2. NC2184.2 +286100 PERFORM DE-LETE. NC2184.2 +286200 GO TO UST-WRITE-GF-29-2. NC2184.2 +286300 UST-FAIL-GF-29-2. NC2184.2 +286400 PERFORM FAIL NC2184.2 +286500 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +286600 MOVE "0 " TO CORRECT-A. NC2184.2 +286700 UST-WRITE-GF-29-2. NC2184.2 +286800 PERFORM PRINT-DETAIL. NC2184.2 +286900* NC2184.2 +287000 UST-TEST-GF-29-3. NC2184.2 +287100 ADD 1 TO REC-CT. NC2184.2 +287200 IF ID6-DU-2V0 = 2 NC2184.2 +287300 PERFORM PASS NC2184.2 +287400 GO TO UST-WRITE-GF-29-3 NC2184.2 +287500 ELSE NC2184.2 +287600 GO TO UST-FAIL-GF-29-3. NC2184.2 +287700 UST-DELETE-GF-29-3. NC2184.2 +287800 PERFORM DE-LETE. NC2184.2 +287900 GO TO UST-WRITE-GF-29-3. NC2184.2 +288000 UST-FAIL-GF-29-3. NC2184.2 +288100 PERFORM FAIL NC2184.2 +288200 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +288300 MOVE 2 TO CORRECT-N. NC2184.2 +288400 UST-WRITE-GF-29-3. NC2184.2 +288500 PERFORM PRINT-DETAIL. NC2184.2 +288600* NC2184.2 +288700 UST-TEST-GF-29-4. NC2184.2 +288800 ADD 1 TO REC-CT. NC2184.2 +288900 IF ID10-DU-2V0 = 4 NC2184.2 +289000 PERFORM PASS NC2184.2 +289100 GO TO UST-WRITE-GF-29-4 NC2184.2 +289200 ELSE NC2184.2 +289300 GO TO UST-FAIL-GF-29-4. NC2184.2 +289400 UST-DELETE-GF-29-4. NC2184.2 +289500 PERFORM DE-LETE. NC2184.2 +289600 GO TO UST-WRITE-GF-29-4. NC2184.2 +289700 UST-FAIL-GF-29-4. NC2184.2 +289800 PERFORM FAIL NC2184.2 +289900 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +290000 MOVE 4 TO CORRECT-N. NC2184.2 +290100 UST-WRITE-GF-29-4. NC2184.2 +290200 PERFORM PRINT-DETAIL. NC2184.2 +290300* NC2184.2 +290400 UST-TEST-GF-29-5. NC2184.2 +290500 ADD 1 TO REC-CT. NC2184.2 +290600 IF ID11-DU-2V0 = 1 NC2184.2 +290700 PERFORM PASS NC2184.2 +290800 GO TO UST-WRITE-GF-29-5 NC2184.2 +290900 ELSE NC2184.2 +291000 GO TO UST-FAIL-GF-29-5. NC2184.2 +291100 UST-DELETE-GF-29-5. NC2184.2 +291200 PERFORM DE-LETE. NC2184.2 +291300 GO TO UST-WRITE-GF-29-5. NC2184.2 +291400 UST-FAIL-GF-29-5. NC2184.2 +291500 PERFORM FAIL NC2184.2 +291600 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +291700 MOVE 1 TO CORRECT-N. NC2184.2 +291800 UST-WRITE-GF-29-5. NC2184.2 +291900 PERFORM PRINT-DETAIL. NC2184.2 +292000* NC2184.2 +292100 UST-TEST-GF-29-6. NC2184.2 +292200 ADD 1 TO REC-CT. NC2184.2 +292300 IF WRK-XN-00001-1 = SPACE NC2184.2 +292400 PERFORM PASS NC2184.2 +292500 GO TO UST-WRITE-GF-29-6 NC2184.2 +292600 ELSE NC2184.2 +292700 GO TO UST-FAIL-GF-29-6. NC2184.2 +292800 UST-DELETE-GF-29-6. NC2184.2 +292900 PERFORM DE-LETE. NC2184.2 +293000 GO TO UST-WRITE-GF-29-6. NC2184.2 +293100 UST-FAIL-GF-29-6. NC2184.2 +293200 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +293300 MOVE SPACE TO CORRECT-A. NC2184.2 +293400 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2184.2 +293500 PERFORM FAIL. NC2184.2 +293600 UST-WRITE-GF-29-6. NC2184.2 +293700 PERFORM PRINT-DETAIL. NC2184.2 +293800* NC2184.2 +293900 UST-TEST-GF-29-7. NC2184.2 +294000 ADD 1 TO REC-CT. NC2184.2 +294100 IF WRK-XN-00001-2 = SPACE NC2184.2 +294200 PERFORM PASS NC2184.2 +294300 GO TO UST-WRITE-GF-29-7 NC2184.2 +294400 ELSE NC2184.2 +294500 GO TO UST-FAIL-GF-29-7. NC2184.2 +294600 UST-DELETE-GF-29-7. NC2184.2 +294700 PERFORM DE-LETE. NC2184.2 +294800 GO TO UST-WRITE-GF-29-7. NC2184.2 +294900 UST-FAIL-GF-29-7. NC2184.2 +295000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +295100 MOVE SPACE TO CORRECT-A. NC2184.2 +295200 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2184.2 +295300 PERFORM FAIL. NC2184.2 +295400 UST-WRITE-GF-29-7. NC2184.2 +295500 PERFORM PRINT-DETAIL. NC2184.2 +295600* NC2184.2 +295700 UST-TEST-GF-29-8. NC2184.2 +295800 ADD 1 TO REC-CT. NC2184.2 +295900 IF WRK-XN-00001-3 = "Z" NC2184.2 +296000 PERFORM PASS NC2184.2 +296100 GO TO UST-WRITE-GF-29-8 NC2184.2 +296200 ELSE NC2184.2 +296300 GO TO UST-FAIL-GF-29-8. NC2184.2 +296400 UST-DELETE-GF-29-8. NC2184.2 +296500 PERFORM DE-LETE. NC2184.2 +296600 GO TO UST-WRITE-GF-29-8. NC2184.2 +296700 UST-FAIL-GF-29-8. NC2184.2 +296800 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +296900 MOVE "Z" TO CORRECT-A. NC2184.2 +297000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +297100 PERFORM FAIL. NC2184.2 +297200 UST-WRITE-GF-29-8. NC2184.2 +297300 PERFORM PRINT-DETAIL. NC2184.2 +297400* NC2184.2 +297500 UST-INIT-GF-30. NC2184.2 +297600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +297700 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +297800 MOVE "UST-TEST-GF-30" TO PAR-NAME. NC2184.2 +297900 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +298000 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +298100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +298200 MOVE "****" TO ID5-XN-4. NC2184.2 +298300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +298400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +298500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +298600 MOVE ZERO TO REC-CT. NC2184.2 +298700 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +298800 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +298900 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +299000* NC2184.2 +299100 UST-TEST-GF-30-0. NC2184.2 +299200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +299300 NOT ON OVERFLOW NC2184.2 +299400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +299500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +299600 END-UNSTRING NC2184.2 +299700 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +299800 GO TO UST-TEST-GF-30-1. NC2184.2 +299900 UST-DELETE-GF-30. NC2184.2 +300000 PERFORM DE-LETE. NC2184.2 +300100 PERFORM PRINT-DETAIL. NC2184.2 +300200 GO TO CCVS-EXIT. NC2184.2 +300300* NC2184.2 +300400 UST-TEST-GF-30-1. NC2184.2 +300500 MOVE 1 TO REC-CT. NC2184.2 +300600 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +300700 PERFORM PASS NC2184.2 +300800 GO TO UST-WRITE-GF-30-1 NC2184.2 +300900 ELSE NC2184.2 +301000 GO TO UST-FAIL-GF-30-1. NC2184.2 +301100 UST-DELETE-GF-30-1. NC2184.2 +301200 PERFORM DE-LETE. NC2184.2 +301300 GO TO UST-WRITE-GF-30-1. NC2184.2 +301400 UST-FAIL-GF-30-1. NC2184.2 +301500 PERFORM FAIL NC2184.2 +301600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +301700 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +301800 UST-WRITE-GF-30-1. NC2184.2 +301900 PERFORM PRINT-DETAIL. NC2184.2 +302000* NC2184.2 +302100 UST-TEST-GF-30-2. NC2184.2 +302200 ADD 1 TO REC-CT. NC2184.2 +302300 IF WRK-XN-00001-1 = "A" NC2184.2 +302400 PERFORM PASS NC2184.2 +302500 GO TO UST-WRITE-GF-30-2 NC2184.2 +302600 ELSE NC2184.2 +302700 GO TO UST-FAIL-GF-30-2. NC2184.2 +302800 UST-DELETE-GF-30-2. NC2184.2 +302900 PERFORM DE-LETE. NC2184.2 +303000 GO TO UST-WRITE-GF-30-2. NC2184.2 +303100 UST-FAIL-GF-30-2. NC2184.2 +303200 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +303300 MOVE "A" TO CORRECT-A. NC2184.2 +303400 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +303500 PERFORM FAIL. NC2184.2 +303600 UST-WRITE-GF-30-2. NC2184.2 +303700 PERFORM PRINT-DETAIL. NC2184.2 +303800* NC2184.2 +303900 UST-TEST-GF-30-3. NC2184.2 +304000 ADD 1 TO REC-CT. NC2184.2 +304100 IF WRK-XN-00001-2 = "B" NC2184.2 +304200 PERFORM PASS NC2184.2 +304300 GO TO UST-WRITE-GF-30-3 NC2184.2 +304400 ELSE NC2184.2 +304500 GO TO UST-FAIL-GF-30-3. NC2184.2 +304600 UST-DELETE-GF-30-3. NC2184.2 +304700 PERFORM DE-LETE. NC2184.2 +304800 GO TO UST-WRITE-GF-30-3. NC2184.2 +304900 UST-FAIL-GF-30-3. NC2184.2 +305000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +305100 MOVE "B" TO CORRECT-A. NC2184.2 +305200 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +305300 PERFORM FAIL. NC2184.2 +305400 UST-WRITE-GF-30-3. NC2184.2 +305500 PERFORM PRINT-DETAIL. NC2184.2 +305600* NC2184.2 +305700 UST-TEST-GF-30-4. NC2184.2 +305800 ADD 1 TO REC-CT. NC2184.2 +305900 IF WRK-XN-00001-3 = "Z" NC2184.2 +306000 PERFORM PASS NC2184.2 +306100 GO TO UST-WRITE-GF-30-4 NC2184.2 +306200 ELSE NC2184.2 +306300 GO TO UST-FAIL-GF-30-4. NC2184.2 +306400 UST-DELETE-GF-30-4. NC2184.2 +306500 PERFORM DE-LETE. NC2184.2 +306600 GO TO UST-WRITE-GF-30-4. NC2184.2 +306700 UST-FAIL-GF-30-4. NC2184.2 +306800 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +306900 MOVE "Z" TO CORRECT-A. NC2184.2 +307000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +307100 PERFORM FAIL. NC2184.2 +307200 UST-WRITE-GF-30-4. NC2184.2 +307300 PERFORM PRINT-DETAIL. NC2184.2 +307400* NC2184.2 +307500 CCVS-EXIT SECTION. NC2184.2 +307600 CCVS-999999. NC2184.2 +307700 GO TO CLOSE-FILES. NC2184.2 +*END-OF,NC218A +*HEADER,COBOL,NC219A +000100 IDENTIFICATION DIVISION. NC2194.2 +000200 PROGRAM-ID. NC2194.2 +000300 NC219A. NC2194.2 +000400* NC2194.2 +000500**************************************************************** NC2194.2 +000600* * NC2194.2 +000700* VALIDATION FOR:- * NC2194.2 +000800* * NC2194.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +001000* * NC2194.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2194.2 +001200* * NC2194.2 +001300**************************************************************** NC2194.2 +001400* * NC2194.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2194.2 +001600* * NC2194.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2194.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2194.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2194.2 +002000* * NC2194.2 +002100**************************************************************** NC2194.2 +002200* PROGRAM NC219A TESTS THE USE OF "HIGH-VALUE" & "LOW-VALUE" NC2194.2 +002300* IN THE LITERAL PHRASE OF THE "ALPHABET" CLAUSE OF THE NC2194.2 +002400* "SPECIAL-NAMES" PARAGRAPH AND THE "PROGRAM COLLATING NC2194.2 +002500* SEQUENCE" OF THE "OBJECT-COMPUTER PARAGRAPH. NC2194.2 +002600* NC2194.2 +002700**************************************************************** NC2194.2 +002800* NC2194.2 +002900* NC2194.2 +003000* ACCORDING TO THE RULES FOR PROGRAM COLLATING SEQUENCE NC2194.2 +003100* THE LOWEST CHARACTER SHOULD BE THE LETTER F FOLLOWED BY NC2194.2 +003200* THE LETTER U FOLLOWED IN ASCENDING ORDER BY THE LETTER N NC2194.2 +003300* WHICH IS SET ON AN EVEN PAR WITH THE COMPUTER VALUES FOR NC2194.2 +003400* HIGH-VALUE AND LOW-VALUE. THE NEXT HIGHEST CHARACTER IS THE NC2194.2 +003500* LETTER Y. THE REMAINDER OF THE CHARACTERS IN THE COBOL NC2194.2 +003600* CHARACTER SET THEN FOLLOW IN ASCENDING ORDER BUT EXCLUDE NC2194.2 +003700* THE CHARACTERS AND VALUES PREVIOUSLY METIONED (F,U,N,HIGH- NC2194.2 +003800* VALUE, LOW-VALUE, AND Y). LOW-VALUE FOR THE NEW PROGRAM NC2194.2 +003900* COLLATING SEQUENCE JUST EVALUATED SHOULD BE THE LETTER F. NC2194.2 +004000* HIGH-VALUE SHOULD NOW BE EVALUATED AS THE HIGHEST ORDER NC2194.2 +004100* CHARACTER FROM THE REMAINDER OF THE NATIVE COLLATING SEQUENCENC2194.2 +004200* NOT INCLUDING THE CHARACTERS F,U,N,**PREVIOUS** HIGH-VALUE NC2194.2 +004300* OR **PREVIOUS** LOW-VALUE, AND THE LETTER Y. NC2194.2 +004400* NC2194.2 +004500* THE ALPHABET-NAME COLLATING-SEQ-2 IS NOT USED IN NC2194.2 +004600* THE PROGRAM EXCEPT TO TEST WHETHER THE LETTER Q HAS BEEN NC2194.2 +004700* SET TO AN EQUAL PAR WITH THE NEW HIGH-VALUE AND NEW LOW-VALUENC2194.2 +004800* FOR PURPOSES OF THE PROGRAM COLLATING SEQUENCE. THIS WOULD NC2194.2 +004900* BE TRUE IF THE ALPHABET-NAME COLLATING-SEQ-2 WERE REFERENCED NC2194.2 +005000* IN A SORT, MERGE, OR CODE-SET CLAUSE. NC2194.2 +005100* NC2194.2 +005200* NC2194.2 +005300* NC2194.2 +005400 ENVIRONMENT DIVISION. NC2194.2 +005500 CONFIGURATION SECTION. NC2194.2 +005600 SOURCE-COMPUTER. NC2194.2 +005700 XXXXX082. NC2194.2 +005800 OBJECT-COMPUTER. NC2194.2 +005900 XXXXX083 NC2194.2 +006000 PROGRAM COLLATING SEQUENCE IS COLLATING-SEQ-1. NC2194.2 +006100 SPECIAL-NAMES. NC2194.2 +006200 ALPHABET NC2194.2 +006300 COLLATING-SEQ-1 IS "F" "U" "N" NC2194.2 +006400 ALSO HIGH-VALUE NC2194.2 +006500 ALSO LOW-VALUE NC2194.2 +006600 "Y" NC2194.2 +006700 ALPHABET NC2194.2 +006800 COLLATING-SEQ-2 IS "Q" NC2194.2 +006900 ALSO HIGH-VALUE NC2194.2 +007000 ALSO LOW-VALUE. NC2194.2 +007100 INPUT-OUTPUT SECTION. NC2194.2 +007200 FILE-CONTROL. NC2194.2 +007300 SELECT PRINT-FILE ASSIGN TO NC2194.2 +007400 XXXXX055. NC2194.2 +007500 DATA DIVISION. NC2194.2 +007600 FILE SECTION. NC2194.2 +007700 FD PRINT-FILE. NC2194.2 +007800 01 PRINT-REC PICTURE X(120). NC2194.2 +007900 01 DUMMY-RECORD PICTURE X(120). NC2194.2 +008000 WORKING-STORAGE SECTION. NC2194.2 +008100 01 F-AN-1 PICTURE A VALUE "F". NC2194.2 +008200 01 U-AN-1 PICTURE A VALUE "U". NC2194.2 +008300 01 N-AN-1 PICTURE A VALUE "N". NC2194.2 +008400 01 Y-AN-1 PICTURE A VALUE "Y". NC2194.2 +008500 01 Q-AN-1 PICTURE A VALUE "Q". NC2194.2 +008600 01 NEW-LOW PICTURE X VALUE LOW-VALUE. NC2194.2 +008700 01 TEST-RESULTS. NC2194.2 +008800 02 FILLER PIC X VALUE SPACE. NC2194.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. NC2194.2 +009000 02 FILLER PIC X VALUE SPACE. NC2194.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. NC2194.2 +009200 02 FILLER PIC X VALUE SPACE. NC2194.2 +009300 02 PAR-NAME. NC2194.2 +009400 03 FILLER PIC X(19) VALUE SPACE. NC2194.2 +009500 03 PARDOT-X PIC X VALUE SPACE. NC2194.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. NC2194.2 +009700 02 FILLER PIC X(8) VALUE SPACE. NC2194.2 +009800 02 RE-MARK PIC X(61). NC2194.2 +009900 01 TEST-COMPUTED. NC2194.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2194.2 +010100 02 FILLER PIC X(17) VALUE NC2194.2 +010200 " COMPUTED=". NC2194.2 +010300 02 COMPUTED-X. NC2194.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2194.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A NC2194.2 +010600 PIC -9(9).9(9). NC2194.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2194.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2194.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2194.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. NC2194.2 +011100 04 COMPUTED-18V0 PIC -9(18). NC2194.2 +011200 04 FILLER PIC X. NC2194.2 +011300 03 FILLER PIC X(50) VALUE SPACE. NC2194.2 +011400 01 TEST-CORRECT. NC2194.2 +011500 02 FILLER PIC X(30) VALUE SPACE. NC2194.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2194.2 +011700 02 CORRECT-X. NC2194.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2194.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2194.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2194.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2194.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2194.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. NC2194.2 +012400 04 CORRECT-18V0 PIC -9(18). NC2194.2 +012500 04 FILLER PIC X. NC2194.2 +012600 03 FILLER PIC X(2) VALUE SPACE. NC2194.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2194.2 +012800 01 CCVS-C-1. NC2194.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2194.2 +013000- "SS PARAGRAPH-NAME NC2194.2 +013100- " REMARKS". NC2194.2 +013200 02 FILLER PIC X(20) VALUE SPACE. NC2194.2 +013300 01 CCVS-C-2. NC2194.2 +013400 02 FILLER PIC X VALUE SPACE. NC2194.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". NC2194.2 +013600 02 FILLER PIC X(15) VALUE SPACE. NC2194.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". NC2194.2 +013800 02 FILLER PIC X(94) VALUE SPACE. NC2194.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2194.2 +014000 01 REC-CT PIC 99 VALUE ZERO. NC2194.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2194.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2194.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2194.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2194.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2194.2 +015000 01 CCVS-H-1. NC2194.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2194.2 +015200 02 FILLER PIC X(42) VALUE NC2194.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2194.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2194.2 +015500 01 CCVS-H-2A. NC2194.2 +015600 02 FILLER PIC X(40) VALUE SPACE. NC2194.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2194.2 +015800 02 FILLER PIC XXXX VALUE NC2194.2 +015900 "4.2 ". NC2194.2 +016000 02 FILLER PIC X(28) VALUE NC2194.2 +016100 " COPY - NOT FOR DISTRIBUTION". NC2194.2 +016200 02 FILLER PIC X(41) VALUE SPACE. NC2194.2 +016300 NC2194.2 +016400 01 CCVS-H-2B. NC2194.2 +016500 02 FILLER PIC X(15) VALUE NC2194.2 +016600 "TEST RESULT OF ". NC2194.2 +016700 02 TEST-ID PIC X(9). NC2194.2 +016800 02 FILLER PIC X(4) VALUE NC2194.2 +016900 " IN ". NC2194.2 +017000 02 FILLER PIC X(12) VALUE NC2194.2 +017100 " HIGH ". NC2194.2 +017200 02 FILLER PIC X(22) VALUE NC2194.2 +017300 " LEVEL VALIDATION FOR ". NC2194.2 +017400 02 FILLER PIC X(58) VALUE NC2194.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +017600 01 CCVS-H-3. NC2194.2 +017700 02 FILLER PIC X(34) VALUE NC2194.2 +017800 " FOR OFFICIAL USE ONLY ". NC2194.2 +017900 02 FILLER PIC X(58) VALUE NC2194.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2194.2 +018100 02 FILLER PIC X(28) VALUE NC2194.2 +018200 " COPYRIGHT 1985 ". NC2194.2 +018300 01 CCVS-E-1. NC2194.2 +018400 02 FILLER PIC X(52) VALUE SPACE. NC2194.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2194.2 +018600 02 ID-AGAIN PIC X(9). NC2194.2 +018700 02 FILLER PIC X(45) VALUE SPACES. NC2194.2 +018800 01 CCVS-E-2. NC2194.2 +018900 02 FILLER PIC X(31) VALUE SPACE. NC2194.2 +019000 02 FILLER PIC X(21) VALUE SPACE. NC2194.2 +019100 02 CCVS-E-2-2. NC2194.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2194.2 +019300 03 FILLER PIC X VALUE SPACE. NC2194.2 +019400 03 ENDER-DESC PIC X(44) VALUE NC2194.2 +019500 "ERRORS ENCOUNTERED". NC2194.2 +019600 01 CCVS-E-3. NC2194.2 +019700 02 FILLER PIC X(22) VALUE NC2194.2 +019800 " FOR OFFICIAL USE ONLY". NC2194.2 +019900 02 FILLER PIC X(12) VALUE SPACE. NC2194.2 +020000 02 FILLER PIC X(58) VALUE NC2194.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +020200 02 FILLER PIC X(13) VALUE SPACE. NC2194.2 +020300 02 FILLER PIC X(15) VALUE NC2194.2 +020400 " COPYRIGHT 1985". NC2194.2 +020500 01 CCVS-E-4. NC2194.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2194.2 +020700 02 FILLER PIC X(4) VALUE " OF ". NC2194.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2194.2 +020900 02 FILLER PIC X(40) VALUE NC2194.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2194.2 +021100 01 XXINFO. NC2194.2 +021200 02 FILLER PIC X(19) VALUE NC2194.2 +021300 "*** INFORMATION ***". NC2194.2 +021400 02 INFO-TEXT. NC2194.2 +021500 04 FILLER PIC X(8) VALUE SPACE. NC2194.2 +021600 04 XXCOMPUTED PIC X(20). NC2194.2 +021700 04 FILLER PIC X(5) VALUE SPACE. NC2194.2 +021800 04 XXCORRECT PIC X(20). NC2194.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). NC2194.2 +022000 01 HYPHEN-LINE. NC2194.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. NC2194.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************NC2194.2 +022300- "*****************************************". NC2194.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************NC2194.2 +022500- "******************************". NC2194.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE NC2194.2 +022700 "NC219A". NC2194.2 +022800 PROCEDURE DIVISION. NC2194.2 +022900 CCVS1 SECTION. NC2194.2 +023000 OPEN-FILES. NC2194.2 +023100 OPEN OUTPUT PRINT-FILE. NC2194.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2194.2 +023300 MOVE SPACE TO TEST-RESULTS. NC2194.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2194.2 +023500 GO TO CCVS1-EXIT. NC2194.2 +023600 CLOSE-FILES. NC2194.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2194.2 +023800 TERMINATE-CCVS. NC2194.2 +023900S EXIT PROGRAM. NC2194.2 +024000STERMINATE-CALL. NC2194.2 +024100 STOP RUN. NC2194.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2194.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2194.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2194.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2194.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. NC2194.2 +024700 PRINT-DETAIL. NC2194.2 +024800 IF REC-CT NOT EQUAL TO ZERO NC2194.2 +024900 MOVE "." TO PARDOT-X NC2194.2 +025000 MOVE REC-CT TO DOTVALUE. NC2194.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2194.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2194.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2194.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2194.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2194.2 +025600 MOVE SPACE TO CORRECT-X. NC2194.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2194.2 +025800 MOVE SPACE TO RE-MARK. NC2194.2 +025900 HEAD-ROUTINE. NC2194.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2194.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2194.2 +026400 COLUMN-NAMES-ROUTINE. NC2194.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +026800 END-ROUTINE. NC2194.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2194.2 +027000 END-RTN-EXIT. NC2194.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +027200 END-ROUTINE-1. NC2194.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2194.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2194.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. NC2194.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2194.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2194.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2194.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2194.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2194.2 +028100 END-ROUTINE-12. NC2194.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2194.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2194.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2194.2 +028500 ELSE NC2194.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2194.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2194.2 +028800 PERFORM WRITE-LINE. NC2194.2 +028900 END-ROUTINE-13. NC2194.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2194.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE NC2194.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2194.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2194.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO NC2194.2 +029600 MOVE "NO " TO ERROR-TOTAL NC2194.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2194.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2194.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +030100 WRITE-LINE. NC2194.2 +030200 ADD 1 TO RECORD-COUNT. NC2194.2 +030300Y IF RECORD-COUNT GREATER 50 NC2194.2 +030400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2194.2 +030500Y MOVE SPACE TO DUMMY-RECORD NC2194.2 +030600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2194.2 +030700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2194.2 +030800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2194.2 +030900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2194.2 +031000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2194.2 +031100Y MOVE ZERO TO RECORD-COUNT. NC2194.2 +031200 PERFORM WRT-LN. NC2194.2 +031300 WRT-LN. NC2194.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2194.2 +031500 MOVE SPACE TO DUMMY-RECORD. NC2194.2 +031600 BLANK-LINE-PRINT. NC2194.2 +031700 PERFORM WRT-LN. NC2194.2 +031800 FAIL-ROUTINE. NC2194.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2194.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2194.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2194.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2194.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2194.2 +032500 GO TO FAIL-ROUTINE-EX. NC2194.2 +032600 FAIL-ROUTINE-WRITE. NC2194.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2194.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2194.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2194.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2194.2 +033100 FAIL-ROUTINE-EX. EXIT. NC2194.2 +033200 BAIL-OUT. NC2194.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2194.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2194.2 +033500 BAIL-OUT-WRITE. NC2194.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2194.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2194.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2194.2 +034000 BAIL-OUT-EX. EXIT. NC2194.2 +034100 CCVS1-EXIT. NC2194.2 +034200 EXIT. NC2194.2 +034300 SECT-NC219A-001 SECTION. NC2194.2 +034400* NC2194.2 +034500* NC2194.2 +034600* THE LETTER F IS THE LOWEST CHARACTER IN THE PROGRAM NC2194.2 +034700* COLLATING SEQUENCE FOLLOWED IN ASCENDING ORDER BY THE NC2194.2 +034800* LETTER U. THIS IS SHOWN IN THE ALPHABET-NAME NC2194.2 +034900* COLLATING-SEQ-1. NC2194.2 +035000* NC2194.2 +035100* F SHOULD BE LESS THAN U. NC2194.2 +035200* NC2194.2 +035300* NC2194.2 +035400 SEQ-INIT-GF-1. NC2194.2 +035500 MOVE "SEQ-TEST-GF-1" TO PAR-NAME. NC2194.2 +035600 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +035700 MOVE "F < U" TO FEATURE. NC2194.2 +035800 SEQ-TEST-GF-1. NC2194.2 +035900 IF F-AN-1 IS LESS THAN U-AN-1 NC2194.2 +036000 PERFORM PASS NC2194.2 +036100 ELSE NC2194.2 +036200 GO TO SEQ-FAIL-GF-1. NC2194.2 +036300 GO TO SEQ-WRITE-GF-1. NC2194.2 +036400 SEQ-DELETE-GF-1. NC2194.2 +036500 PERFORM DE-LETE. NC2194.2 +036600 GO TO SEQ-WRITE-GF-1. NC2194.2 +036700 SEQ-FAIL-GF-1. NC2194.2 +036800 PERFORM FAIL NC2194.2 +036900 MOVE "F NOT < THAN U" TO COMPUTED-A. NC2194.2 +037000 SEQ-WRITE-GF-1. NC2194.2 +037100 PERFORM PRINT-DETAIL. NC2194.2 +037200* NC2194.2 +037300* NC2194.2 +037400* THE LETTER U IS THE SECOND LOWEST CHARACTER IN THE NC2194.2 +037500* PROGRAM COLLATING SEQUENCE FOLLOWED IN ASCENDING ORDER BY THENC2194.2 +037600* LETTER N. THIS IS SHOWN IN THE ALPHABET-NAME NC2194.2 +037700* COLLATING-SEQ-1. NC2194.2 +037800* NC2194.2 +037900* U SHOULD BE LESS THAN N. NC2194.2 +038000* NC2194.2 +038100* NC2194.2 +038200 SEQ-INIT-GF-2. NC2194.2 +038300 MOVE "SEQ-TEST-GF-2" TO PAR-NAME. NC2194.2 +038400 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +038500 MOVE "U < N" TO FEATURE. NC2194.2 +038600 SEQ-TEST-GF-2. NC2194.2 +038700* NC2194.2 +038800 IF U-AN-1 IS LESS THAN N-AN-1 NC2194.2 +038900 PERFORM PASS NC2194.2 +039000 ELSE NC2194.2 +039100 GO TO SEQ-FAIL-GF-2. NC2194.2 +039200 GO TO SEQ-WRITE-GF-2. NC2194.2 +039300 SEQ-DELETE-GF-2. NC2194.2 +039400 PERFORM DE-LETE. NC2194.2 +039500 GO TO SEQ-WRITE-GF-2. NC2194.2 +039600 SEQ-FAIL-GF-2. NC2194.2 +039700 PERFORM FAIL NC2194.2 +039800 MOVE "U NOT < THAN N" TO COMPUTED-A. NC2194.2 +039900 SEQ-WRITE-GF-2. NC2194.2 +040000 PERFORM PRINT-DETAIL. NC2194.2 +040100* NC2194.2 +040200* NC2194.2 +040300* THE LETTER N IS SET TO AN EVEN PAR WITH THE **OLD** NC2194.2 +040400* HIGH-VALUE BUT NOT EQUAL TO THE **NEW** HIGH-VALUE. NC2194.2 +040500* NC2194.2 +040600* N SHOULD NOT = HIGH-VALUE. NC2194.2 +040700* NC2194.2 +040800* NC2194.2 +040900 SEQ-INIT-GF-3. NC2194.2 +041000 MOVE "SEQ-TEST-GF-3" TO PAR-NAME. NC2194.2 +041100 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +041200 MOVE "N = HIGH-VALUE" TO FEATURE. NC2194.2 +041300 SEQ-TEST-GF-3. NC2194.2 +041400* NC2194.2 +041500 IF N-AN-1 IS EQUAL TO HIGH-VALUE NC2194.2 +041600 GO TO SEQ-FAIL-GF-3 NC2194.2 +041700 ELSE NC2194.2 +041800 PERFORM PASS. NC2194.2 +041900 GO TO SEQ-WRITE-GF-3. NC2194.2 +042000 SEQ-DELETE-GF-3. NC2194.2 +042100 PERFORM DE-LETE. NC2194.2 +042200 GO TO SEQ-WRITE-GF-3. NC2194.2 +042300 SEQ-FAIL-GF-3. NC2194.2 +042400 PERFORM FAIL NC2194.2 +042500 MOVE "N = HIGH-VALUE" TO COMPUTED-A. NC2194.2 +042600 SEQ-WRITE-GF-3. NC2194.2 +042700 PERFORM PRINT-DETAIL. NC2194.2 +042800* NC2194.2 +042900* NC2194.2 +043000* LOW-VALUE SHOULD BE SET TO THE LETTER F SINCE IT NC2194.2 +043100* IS THE LOWEST CHARACTER IN THE PROGRAM COLLATING SEQUENCE. NC2194.2 +043200* NC2194.2 +043300* F SHOULD BE EQUAL TO LOW-VALUE. NC2194.2 +043400* NC2194.2 +043500* NC2194.2 +043600 SEQ-INIT-GF-4. NC2194.2 +043700 MOVE "SEQ-TEST-GF-4" TO PAR-NAME. NC2194.2 +043800 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +043900 MOVE "F = LOW-VALUE" TO FEATURE. NC2194.2 +044000 SEQ-TEST-GF-4. NC2194.2 +044100* NC2194.2 +044200 IF F-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +044300 PERFORM PASS NC2194.2 +044400 ELSE NC2194.2 +044500 GO TO SEQ-FAIL-GF-4. NC2194.2 +044600 GO TO SEQ-WRITE-GF-4. NC2194.2 +044700 SEQ-DELETE-GF-4. NC2194.2 +044800 PERFORM DE-LETE. NC2194.2 +044900 GO TO SEQ-WRITE-GF-4. NC2194.2 +045000 SEQ-FAIL-GF-4. NC2194.2 +045100 PERFORM FAIL NC2194.2 +045200 MOVE "F NOT = LOW-VALUE" TO COMPUTED-A. NC2194.2 +045300 SEQ-WRITE-GF-4. NC2194.2 +045400 PERFORM PRINT-DETAIL. NC2194.2 +045500* NC2194.2 +045600* NC2194.2 +045700* THE **NEW** LOW-VALUE SHOULD BE SET TO THE LETTER F. NC2194.2 +045800* THE **NEW** HIGH-VALUE SHOULD BE SET TO THE HIGHEST ORDER NC2194.2 +045900* CHARACTER IN THE EVALUATED PROGRAM COLLATING SEQUENCE. NC2194.2 +046000* NC2194.2 +046100* HIGH-VALUE SHOULD BE GREATER THAN LOW-VALUE. NC2194.2 +046200* NC2194.2 +046300* NC2194.2 +046400 SEQ-INIT-GF-5. NC2194.2 +046500 MOVE "SEQ-TEST-GF-5" TO PAR-NAME. NC2194.2 +046600 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +046700 MOVE "H-VALUE > L-VALUE" TO FEATURE. NC2194.2 +046800 SEQ-TEST-GF-5. NC2194.2 +046900* NC2194.2 +047000 IF HIGH-VALUE IS GREATER THAN NEW-LOW NC2194.2 +047100 PERFORM PASS NC2194.2 +047200 ELSE NC2194.2 +047300 GO TO SEQ-FAIL-GF-5. NC2194.2 +047400 GO TO SEQ-WRITE-GF-5. NC2194.2 +047500 SEQ-DELETE-GF-5. NC2194.2 +047600 PERFORM DE-LETE. NC2194.2 +047700 GO TO SEQ-WRITE-GF-5. NC2194.2 +047800 SEQ-FAIL-GF-5. NC2194.2 +047900 PERFORM FAIL NC2194.2 +048000 MOVE "H-VALU NOT > L-VALU" TO COMPUTED-A. NC2194.2 +048100 SEQ-WRITE-GF-5. NC2194.2 +048200 PERFORM PRINT-DETAIL. NC2194.2 +048300* NC2194.2 +048400* NC2194.2 +048500* LOW-VALUE SHOULD BE LESS THAN HIGH-VALUE. NC2194.2 +048600* NC2194.2 +048700* NC2194.2 +048800 SEQ-INIT-GF-6. NC2194.2 +048900 MOVE "SEQ-TEST-GF-6" TO PAR-NAME. NC2194.2 +049000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +049100 MOVE "L-VALUE < H-VALUE" TO FEATURE. NC2194.2 +049200 SEQ-TEST-GF-6. NC2194.2 +049300* NC2194.2 +049400 IF NEW-LOW IS LESS THAN HIGH-VALUE NC2194.2 +049500 PERFORM PASS NC2194.2 +049600 ELSE NC2194.2 +049700 GO TO SEQ-FAIL-GF-6. NC2194.2 +049800 GO TO SEQ-WRITE-GF-6. NC2194.2 +049900 SEQ-DELETE-GF-6. NC2194.2 +050000 PERFORM DE-LETE. NC2194.2 +050100 GO TO SEQ-WRITE-GF-6. NC2194.2 +050200 SEQ-FAIL-GF-6. NC2194.2 +050300 PERFORM FAIL NC2194.2 +050400 MOVE "L-VALU NOT < H-VALU" TO COMPUTED-A. NC2194.2 +050500 SEQ-WRITE-GF-6. NC2194.2 +050600 PERFORM PRINT-DETAIL. NC2194.2 +050700* NC2194.2 +050800* NC2194.2 +050900* LOW-VALUE SHOULD NOT BE EQUAL TO HIGH-VALUE. NC2194.2 +051000* NC2194.2 +051100* NC2194.2 +051200 SEQ-INIT-GF-7. NC2194.2 +051300 MOVE "SEQ-TEST-GF-7" TO PAR-NAME. NC2194.2 +051400 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +051500 MOVE "H-VALUE = L-VALUE" TO FEATURE. NC2194.2 +051600 SEQ-TEST-GF-7. NC2194.2 +051700* NC2194.2 +051800 IF HIGH-VALUE IS EQUAL TO NEW-LOW NC2194.2 +051900 GO TO SEQ-FAIL-GF-7 NC2194.2 +052000 ELSE NC2194.2 +052100 PERFORM PASS. NC2194.2 +052200 GO TO SEQ-WRITE-GF-7. NC2194.2 +052300 SEQ-DELETE-GF-7. NC2194.2 +052400 PERFORM DE-LETE. NC2194.2 +052500 GO TO SEQ-WRITE-GF-7. NC2194.2 +052600 SEQ-FAIL-GF-7. NC2194.2 +052700 PERFORM FAIL NC2194.2 +052800 MOVE "H-VALUE = L-VALUE" TO COMPUTED-A. NC2194.2 +052900 SEQ-WRITE-GF-7. NC2194.2 +053000 PERFORM PRINT-DETAIL. NC2194.2 +053100* NC2194.2 +053200* NC2194.2 +053300* LOW-VALUE SHOULD BE SET TO THE LETTER F. NC2194.2 +053400* NC2194.2 +053500* THE LETTER Y SHOULD NOT BE EQUAL TO LOW-VALUE. NC2194.2 +053600* NC2194.2 +053700* NC2194.2 +053800 SEQ-INIT-GF-8. NC2194.2 +053900 MOVE "SEQ-TEST-GF-8" TO PAR-NAME. NC2194.2 +054000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +054100 MOVE "Y = LOW-VALUE" TO FEATURE. NC2194.2 +054200 SEQ-TEST-GF-8. NC2194.2 +054300* NC2194.2 +054400 IF Y-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +054500 GO TO SEQ-FAIL-GF-8 NC2194.2 +054600 ELSE NC2194.2 +054700 PERFORM PASS. NC2194.2 +054800 GO TO SEQ-WRITE-GF-8. NC2194.2 +054900 SEQ-DELETE-GF-8. NC2194.2 +055000 PERFORM DE-LETE. NC2194.2 +055100 GO TO SEQ-WRITE-GF-8. NC2194.2 +055200 SEQ-FAIL-GF-8. NC2194.2 +055300 PERFORM FAIL NC2194.2 +055400 MOVE "Y = LOW-VALUE" TO COMPUTED-A. NC2194.2 +055500 SEQ-WRITE-GF-8. NC2194.2 +055600 PERFORM PRINT-DETAIL. NC2194.2 +055700* NC2194.2 +055800* NC2194.2 +055900* THE LETTER Q IS MENTIONED IN THE ALPHABET-NAME NC2194.2 +056000* COLLATING-SEQ-2. THIS ALPHABET-NAME CLAUSE SHOULD HAVE NO NC2194.2 +056100* EFFECT ON THE PROGRAM COLLATING SEQUENCE. NC2194.2 +056200* NC2194.2 +056300* FOR OUR PROGRAM COLLATING SEQUENCE Q SHOULD NOT NC2194.2 +056400* BE THE LOW ORDER CHARACTER THEREFORE IT SHOULD NOT NC2194.2 +056500* BE EQUAL TO THE **NEW** LOW-VALUE. NC2194.2 +056600* NC2194.2 +056700* NC2194.2 +056800 SEQ-INIT-GF-9. NC2194.2 +056900 MOVE "SEQ-TEST-GF-9" TO PAR-NAME. NC2194.2 +057000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +057100 MOVE "Q = LOW-VALUE" TO FEATURE. NC2194.2 +057200 SEQ-TEST-GF-9. NC2194.2 +057300* NC2194.2 +057400 IF Q-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +057500 GO TO SEQ-FAIL-GF-9 NC2194.2 +057600 ELSE NC2194.2 +057700 PERFORM PASS. NC2194.2 +057800 GO TO SEQ-WRITE-GF-9. NC2194.2 +057900 SEQ-DELETE-GF-9. NC2194.2 +058000 PERFORM DE-LETE. NC2194.2 +058100 GO TO SEQ-WRITE-GF-9. NC2194.2 +058200 SEQ-FAIL-GF-9. NC2194.2 +058300 PERFORM FAIL NC2194.2 +058400 MOVE "Q = LOW-VALUE" TO COMPUTED-A. NC2194.2 +058500 SEQ-WRITE-GF-9. NC2194.2 +058600 PERFORM PRINT-DETAIL. NC2194.2 +058700* NC2194.2 +058800* NC2194.2 +058900 CCVS-EXIT SECTION. NC2194.2 +059000 CCVS-999999. NC2194.2 +059100 GO TO CLOSE-FILES. NC2194.2 +*END-OF,NC219A +*HEADER,COBOL,NC220M +000100 IDENTIFICATION DIVISION. NC2204.2 +000200 PROGRAM-ID. NC2204.2 +000300 NC220M. NC2204.2 +000400**************************************************************** NC2204.2 +000500* * NC2204.2 +000600* VALIDATION FOR:- * NC2204.2 +000700* * NC2204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +000900* * NC2204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2204.2 +001100* * NC2204.2 +001200**************************************************************** NC2204.2 +001300* * NC2204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2204.2 +001500* * NC2204.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2204.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2204.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2204.2 +001900* * NC2204.2 +002000**************************************************************** NC2204.2 +002100* * NC2204.2 +002200* PROGRAM NC220M TESTS THE USE OF INDEXED IDENTIFIERS AND * NC2204.2 +002300* QUALIFIED DATANAMES WITH FORMAT 1 OF THE "MULTIPLY" * NC2204.2 +002400* STATEMENT, FORMATS 3 & 4 OF THE "PERFORM" STATEMENT AND * NC2204.2 +002500* THE GENERAL FORMAT OF THE "DISPLAY" STATEMENT. * NC2204.2 +002600* * NC2204.2 +002700* * NC2204.2 +002800**************************************************************** NC2204.2 +002900 ENVIRONMENT DIVISION. NC2204.2 +003000 CONFIGURATION SECTION. NC2204.2 +003100 SOURCE-COMPUTER. NC2204.2 +003200 XXXXX082. NC2204.2 +003300 OBJECT-COMPUTER. NC2204.2 +003400 XXXXX083. NC2204.2 +003500 SPECIAL-NAMES. NC2204.2 +003600 XXXXX056 NC2204.2 +003700 IS DISPLAY-OUTPUT-DEVICE. NC2204.2 +003800 INPUT-OUTPUT SECTION. NC2204.2 +003900 FILE-CONTROL. NC2204.2 +004000 SELECT PRINT-FILE ASSIGN TO NC2204.2 +004100 XXXXX055. NC2204.2 +004200 DATA DIVISION. NC2204.2 +004300 FILE SECTION. NC2204.2 +004400 FD PRINT-FILE. NC2204.2 +004500 01 PRINT-REC PICTURE X(120). NC2204.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC2204.2 +004700 WORKING-STORAGE SECTION. NC2204.2 +004800 01 TABLE1. NC2204.2 +004900 02 TABLE1-REC PICTURE X(10) NC2204.2 +005000 OCCURS 2 TIMES NC2204.2 +005100 INDEXED BY INDEX1. NC2204.2 +005200 01 TABLE2. NC2204.2 +005300 02 NUMBER1 PICTURE 99 VALUE 03. NC2204.2 +005400 02 NUMBER2 PICTURE 99 NC2204.2 +005500 OCCURS 4 TIMES NC2204.2 +005600 INDEXED BY INDEX2. NC2204.2 +005700 02 NUMBER3 PICTURE 99 VALUE 06. NC2204.2 +005800 01 TABLE3. NC2204.2 +005900 02 NUMBER1 PICTURE 99 VALUE 10. NC2204.2 +006000 02 NUMBER2 PICTURE 99 NC2204.2 +006100 OCCURS 4 TIMES NC2204.2 +006200 INDEXED BY INDEX3. NC2204.2 +006300 02 NUMBER3 PICTURE 99 VALUE 13. NC2204.2 +006400 01 TABLE4. NC2204.2 +006500 02 TABLE4-NUM1 OCCURS 3 TIMES NC2204.2 +006600 INDEXED BY INDEX4-1. NC2204.2 +006700 03 TABLE4-NUM2 PICTURE 99 NC2204.2 +006800 OCCURS 3 TIMES NC2204.2 +006900 INDEXED BY INDEX4-2. NC2204.2 +007000 01 TABLE5. NC2204.2 +007100 02 TABLE5-NUM PICTURE 999 NC2204.2 +007200 OCCURS 6 TIMES NC2204.2 +007300 INDEXED BY INDEX5. NC2204.2 +007400 01 TABLE6. NC2204.2 +007500 02 TABLE6-NUM PICTURE 999 NC2204.2 +007600 OCCURS 6 TIMES NC2204.2 +007700 INDEXED BY INDEX6. NC2204.2 +007800 01 TABLE7. NC2204.2 +007900 02 TABLE7-NUM PICTURE 9 NC2204.2 +008000 OCCURS 2 TIMES NC2204.2 +008100 INDEXED BY INDEX7. NC2204.2 +008200 01 TABLE8. NC2204.2 +008300 02 TABLE8-NUM PICTURE 9 NC2204.2 +008400 OCCURS 3 TIMES NC2204.2 +008500 INDEXED BY INDEX8. NC2204.2 +008600 01 NUM-9 PICTURE 9. NC2204.2 +008700 01 NUM-999 PICTURE 999. NC2204.2 +008800 01 TEST-RESULTS. NC2204.2 +008900 02 FILLER PIC X VALUE SPACE. NC2204.2 +009000 02 FEATURE PIC X(20) VALUE SPACE. NC2204.2 +009100 02 FILLER PIC X VALUE SPACE. NC2204.2 +009200 02 P-OR-F PIC X(5) VALUE SPACE. NC2204.2 +009300 02 FILLER PIC X VALUE SPACE. NC2204.2 +009400 02 PAR-NAME. NC2204.2 +009500 03 FILLER PIC X(19) VALUE SPACE. NC2204.2 +009600 03 PARDOT-X PIC X VALUE SPACE. NC2204.2 +009700 03 DOTVALUE PIC 99 VALUE ZERO. NC2204.2 +009800 02 FILLER PIC X(8) VALUE SPACE. NC2204.2 +009900 02 RE-MARK PIC X(61). NC2204.2 +010000 01 TEST-COMPUTED. NC2204.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC2204.2 +010200 02 FILLER PIC X(17) VALUE NC2204.2 +010300 " COMPUTED=". NC2204.2 +010400 02 COMPUTED-X. NC2204.2 +010500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2204.2 +010600 03 COMPUTED-N REDEFINES COMPUTED-A NC2204.2 +010700 PIC -9(9).9(9). NC2204.2 +010800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2204.2 +010900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2204.2 +011000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2204.2 +011100 03 CM-18V0 REDEFINES COMPUTED-A. NC2204.2 +011200 04 COMPUTED-18V0 PIC -9(18). NC2204.2 +011300 04 FILLER PIC X. NC2204.2 +011400 03 FILLER PIC X(50) VALUE SPACE. NC2204.2 +011500 01 TEST-CORRECT. NC2204.2 +011600 02 FILLER PIC X(30) VALUE SPACE. NC2204.2 +011700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2204.2 +011800 02 CORRECT-X. NC2204.2 +011900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2204.2 +012000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2204.2 +012100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2204.2 +012200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2204.2 +012300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2204.2 +012400 03 CR-18V0 REDEFINES CORRECT-A. NC2204.2 +012500 04 CORRECT-18V0 PIC -9(18). NC2204.2 +012600 04 FILLER PIC X. NC2204.2 +012700 03 FILLER PIC X(2) VALUE SPACE. NC2204.2 +012800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2204.2 +012900 01 CCVS-C-1. NC2204.2 +013000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2204.2 +013100- "SS PARAGRAPH-NAME NC2204.2 +013200- " REMARKS". NC2204.2 +013300 02 FILLER PIC X(20) VALUE SPACE. NC2204.2 +013400 01 CCVS-C-2. NC2204.2 +013500 02 FILLER PIC X VALUE SPACE. NC2204.2 +013600 02 FILLER PIC X(6) VALUE "TESTED". NC2204.2 +013700 02 FILLER PIC X(15) VALUE SPACE. NC2204.2 +013800 02 FILLER PIC X(4) VALUE "FAIL". NC2204.2 +013900 02 FILLER PIC X(94) VALUE SPACE. NC2204.2 +014000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2204.2 +014100 01 REC-CT PIC 99 VALUE ZERO. NC2204.2 +014200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2204.2 +014700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2204.2 +014800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2204.2 +014900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2204.2 +015000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2204.2 +015100 01 CCVS-H-1. NC2204.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC2204.2 +015300 02 FILLER PIC X(42) VALUE NC2204.2 +015400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2204.2 +015500 02 FILLER PIC X(39) VALUE SPACES. NC2204.2 +015600 01 CCVS-H-2A. NC2204.2 +015700 02 FILLER PIC X(40) VALUE SPACE. NC2204.2 +015800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2204.2 +015900 02 FILLER PIC XXXX VALUE NC2204.2 +016000 "4.2 ". NC2204.2 +016100 02 FILLER PIC X(28) VALUE NC2204.2 +016200 " COPY - NOT FOR DISTRIBUTION". NC2204.2 +016300 02 FILLER PIC X(41) VALUE SPACE. NC2204.2 +016400 NC2204.2 +016500 01 CCVS-H-2B. NC2204.2 +016600 02 FILLER PIC X(15) VALUE NC2204.2 +016700 "TEST RESULT OF ". NC2204.2 +016800 02 TEST-ID PIC X(9). NC2204.2 +016900 02 FILLER PIC X(4) VALUE NC2204.2 +017000 " IN ". NC2204.2 +017100 02 FILLER PIC X(12) VALUE NC2204.2 +017200 " HIGH ". NC2204.2 +017300 02 FILLER PIC X(22) VALUE NC2204.2 +017400 " LEVEL VALIDATION FOR ". NC2204.2 +017500 02 FILLER PIC X(58) VALUE NC2204.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +017700 01 CCVS-H-3. NC2204.2 +017800 02 FILLER PIC X(34) VALUE NC2204.2 +017900 " FOR OFFICIAL USE ONLY ". NC2204.2 +018000 02 FILLER PIC X(58) VALUE NC2204.2 +018100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2204.2 +018200 02 FILLER PIC X(28) VALUE NC2204.2 +018300 " COPYRIGHT 1985 ". NC2204.2 +018400 01 CCVS-E-1. NC2204.2 +018500 02 FILLER PIC X(52) VALUE SPACE. NC2204.2 +018600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2204.2 +018700 02 ID-AGAIN PIC X(9). NC2204.2 +018800 02 FILLER PIC X(45) VALUE SPACES. NC2204.2 +018900 01 CCVS-E-2. NC2204.2 +019000 02 FILLER PIC X(31) VALUE SPACE. NC2204.2 +019100 02 FILLER PIC X(21) VALUE SPACE. NC2204.2 +019200 02 CCVS-E-2-2. NC2204.2 +019300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2204.2 +019400 03 FILLER PIC X VALUE SPACE. NC2204.2 +019500 03 ENDER-DESC PIC X(44) VALUE NC2204.2 +019600 "ERRORS ENCOUNTERED". NC2204.2 +019700 01 CCVS-E-3. NC2204.2 +019800 02 FILLER PIC X(22) VALUE NC2204.2 +019900 " FOR OFFICIAL USE ONLY". NC2204.2 +020000 02 FILLER PIC X(12) VALUE SPACE. NC2204.2 +020100 02 FILLER PIC X(58) VALUE NC2204.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +020300 02 FILLER PIC X(13) VALUE SPACE. NC2204.2 +020400 02 FILLER PIC X(15) VALUE NC2204.2 +020500 " COPYRIGHT 1985". NC2204.2 +020600 01 CCVS-E-4. NC2204.2 +020700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2204.2 +020800 02 FILLER PIC X(4) VALUE " OF ". NC2204.2 +020900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2204.2 +021000 02 FILLER PIC X(40) VALUE NC2204.2 +021100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2204.2 +021200 01 XXINFO. NC2204.2 +021300 02 FILLER PIC X(19) VALUE NC2204.2 +021400 "*** INFORMATION ***". NC2204.2 +021500 02 INFO-TEXT. NC2204.2 +021600 04 FILLER PIC X(8) VALUE SPACE. NC2204.2 +021700 04 XXCOMPUTED PIC X(20). NC2204.2 +021800 04 FILLER PIC X(5) VALUE SPACE. NC2204.2 +021900 04 XXCORRECT PIC X(20). NC2204.2 +022000 02 INF-ANSI-REFERENCE PIC X(48). NC2204.2 +022100 01 HYPHEN-LINE. NC2204.2 +022200 02 FILLER PIC IS X VALUE IS SPACE. NC2204.2 +022300 02 FILLER PIC IS X(65) VALUE IS "************************NC2204.2 +022400- "*****************************************". NC2204.2 +022500 02 FILLER PIC IS X(54) VALUE IS "************************NC2204.2 +022600- "******************************". NC2204.2 +022700 01 CCVS-PGM-ID PIC X(9) VALUE NC2204.2 +022800 "NC220M". NC2204.2 +022900 PROCEDURE DIVISION. NC2204.2 +023000 CCVS1 SECTION. NC2204.2 +023100 OPEN-FILES. NC2204.2 +023200 OPEN OUTPUT PRINT-FILE. NC2204.2 +023300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2204.2 +023400 MOVE SPACE TO TEST-RESULTS. NC2204.2 +023500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2204.2 +023600 GO TO CCVS1-EXIT. NC2204.2 +023700 CLOSE-FILES. NC2204.2 +023800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2204.2 +023900 TERMINATE-CCVS. NC2204.2 +024000S EXIT PROGRAM. NC2204.2 +024100STERMINATE-CALL. NC2204.2 +024200 STOP RUN. NC2204.2 +024300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2204.2 +024400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2204.2 +024500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2204.2 +024600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2204.2 +024700 MOVE "****TEST DELETED****" TO RE-MARK. NC2204.2 +024800 PRINT-DETAIL. NC2204.2 +024900 IF REC-CT NOT EQUAL TO ZERO NC2204.2 +025000 MOVE "." TO PARDOT-X NC2204.2 +025100 MOVE REC-CT TO DOTVALUE. NC2204.2 +025200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2204.2 +025300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2204.2 +025400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2204.2 +025500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2204.2 +025600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2204.2 +025700 MOVE SPACE TO CORRECT-X. NC2204.2 +025800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2204.2 +025900 MOVE SPACE TO RE-MARK. NC2204.2 +026000 HEAD-ROUTINE. NC2204.2 +026100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2204.2 +026400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2204.2 +026500 COLUMN-NAMES-ROUTINE. NC2204.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +026900 END-ROUTINE. NC2204.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2204.2 +027100 END-RTN-EXIT. NC2204.2 +027200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +027300 END-ROUTINE-1. NC2204.2 +027400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2204.2 +027500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2204.2 +027600 ADD PASS-COUNTER TO ERROR-HOLD. NC2204.2 +027700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2204.2 +027800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2204.2 +027900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2204.2 +028000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2204.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2204.2 +028200 END-ROUTINE-12. NC2204.2 +028300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2204.2 +028400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2204.2 +028500 MOVE "NO " TO ERROR-TOTAL NC2204.2 +028600 ELSE NC2204.2 +028700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2204.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2204.2 +028900 PERFORM WRITE-LINE. NC2204.2 +029000 END-ROUTINE-13. NC2204.2 +029100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2204.2 +029200 MOVE "NO " TO ERROR-TOTAL ELSE NC2204.2 +029300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2204.2 +029400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2204.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +029600 IF INSPECT-COUNTER EQUAL TO ZERO NC2204.2 +029700 MOVE "NO " TO ERROR-TOTAL NC2204.2 +029800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2204.2 +029900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2204.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +030100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +030200 WRITE-LINE. NC2204.2 +030300 ADD 1 TO RECORD-COUNT. NC2204.2 +030400Y IF RECORD-COUNT GREATER 50 NC2204.2 +030500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2204.2 +030600Y MOVE SPACE TO DUMMY-RECORD NC2204.2 +030700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2204.2 +030800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2204.2 +030900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2204.2 +031000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2204.2 +031100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2204.2 +031200Y MOVE ZERO TO RECORD-COUNT. NC2204.2 +031300 PERFORM WRT-LN. NC2204.2 +031400 WRT-LN. NC2204.2 +031500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2204.2 +031600 MOVE SPACE TO DUMMY-RECORD. NC2204.2 +031700 BLANK-LINE-PRINT. NC2204.2 +031800 PERFORM WRT-LN. NC2204.2 +031900 FAIL-ROUTINE. NC2204.2 +032000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2204.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2204.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2204.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2204.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +032500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2204.2 +032600 GO TO FAIL-ROUTINE-EX. NC2204.2 +032700 FAIL-ROUTINE-WRITE. NC2204.2 +032800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2204.2 +032900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2204.2 +033000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2204.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2204.2 +033200 FAIL-ROUTINE-EX. EXIT. NC2204.2 +033300 BAIL-OUT. NC2204.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2204.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2204.2 +033600 BAIL-OUT-WRITE. NC2204.2 +033700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2204.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2204.2 +033900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +034000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2204.2 +034100 BAIL-OUT-EX. EXIT. NC2204.2 +034200 CCVS1-EXIT. NC2204.2 +034300 EXIT. NC2204.2 +034400 SECT-NC220M-001 SECTION. NC2204.2 +034500 BUILD-TABLE1. NC2204.2 +034600 MOVE "LITERAL-02" TO TABLE1-REC (1). NC2204.2 +034700 MOVE "9876543210" TO TABLE1-REC (2). NC2204.2 +034800 BUILD-TABLE2. NC2204.2 +034900 MOVE 04 TO NUMBER2 OF TABLE2 (1). NC2204.2 +035000 MOVE 23 TO NUMBER2 OF TABLE2 (2). NC2204.2 +035100 MOVE 02 TO NUMBER2 OF TABLE2 (3). NC2204.2 +035200 MOVE 06 TO NUMBER2 OF TABLE2 (4). NC2204.2 +035300 BUILD-TABLE3. NC2204.2 +035400 MOVE 11 TO NUMBER2 OF TABLE3 (1). NC2204.2 +035500 MOVE 04 TO NUMBER2 OF TABLE3 (2). NC2204.2 +035600 MOVE 04 TO NUMBER2 OF TABLE3 (3). NC2204.2 +035700 MOVE 24 TO NUMBER2 OF TABLE3 (4). NC2204.2 +035800 BUILD-TABLE4. NC2204.2 +035900 MOVE 03 TO TABLE4-NUM2 (1, 1). NC2204.2 +036000 MOVE 04 TO TABLE4-NUM2 (1, 2). NC2204.2 +036100 MOVE 05 TO TABLE4-NUM2 (1, 3). NC2204.2 +036200 MOVE 12 TO TABLE4-NUM2 (2, 1). NC2204.2 +036300 MOVE 13 TO TABLE4-NUM2 (2, 2). NC2204.2 +036400 MOVE 14 TO TABLE4-NUM2 (2, 3). NC2204.2 +036500 MOVE 31 TO TABLE4-NUM2 (3, 1). NC2204.2 +036600 MOVE 32 TO TABLE4-NUM2 (3, 2). NC2204.2 +036700 MOVE 33 TO TABLE4-NUM2 (3, 3). NC2204.2 +036800 BUILD-TABLE5. NC2204.2 +036900 MOVE 011 TO TABLE5-NUM (1). NC2204.2 +037000 MOVE 005 TO TABLE5-NUM (2). NC2204.2 +037100 MOVE 597 TO TABLE5-NUM (3). NC2204.2 +037200 MOVE 036 TO TABLE5-NUM (4). NC2204.2 +037300 MOVE 082 TO TABLE5-NUM (5). NC2204.2 +037400 MOVE 125 TO TABLE5-NUM (6). NC2204.2 +037500 BUILD-TABLE7. NC2204.2 +037600 MOVE 1 TO TABLE7-NUM (1). NC2204.2 +037700 MOVE 9 TO TABLE7-NUM (2). NC2204.2 +037800 BUILD-TABLE8. NC2204.2 +037900 MOVE 4 TO TABLE8-NUM (1). NC2204.2 +038000 MOVE 7 TO TABLE8-NUM (2). NC2204.2 +038100 MOVE 2 TO TABLE8-NUM (3). NC2204.2 +038200* NC2204.2 +038300 DIS-INIT-GF-1. NC2204.2 +038400 MOVE "DIS-TEST-GF-1" TO PAR-NAME. NC2204.2 +038500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +038600 MOVE "DISPLAY UPON" TO FEATURE. NC2204.2 +038700 MOVE "RESULTS MUST BE" TO RE-MARK. NC2204.2 +038800 MOVE "LITERAL-02" TO CORRECT-A. NC2204.2 +038900 PERFORM BUILD-TABLE1. NC2204.2 +039000 SET INDEX1 TO 1. NC2204.2 +039100 DIS-TEST-GF-1. NC2204.2 +039200 DISPLAY " " UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +039300 DISPLAY TABLE1-REC (INDEX1) UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +039400 PERFORM INSPT. NC2204.2 +039500 GO TO DIS-WRITE-GF-1. NC2204.2 +039600 DIS-DELETE-GF-1. NC2204.2 +039700 PERFORM DE-LETE. NC2204.2 +039800 DIS-WRITE-GF-1. NC2204.2 +039900 PERFORM PRINT-DETAIL. NC2204.2 +040000* NC2204.2 +040100 DIS-INIT-GF-2. NC2204.2 +040200 MOVE "DIS-TEST-GF-2" TO PAR-NAME. NC2204.2 +040300 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +040400 MOVE "DISPLAY UPON" TO FEATURE. NC2204.2 +040500 MOVE "VISUALLY CHECKED" TO RE-MARK. NC2204.2 +040600 MOVE "9876543210" TO CORRECT-A. NC2204.2 +040700 PERFORM BUILD-TABLE1. NC2204.2 +040800 SET INDEX1 TO 1. NC2204.2 +040900 DIS-TEST-GF-2. NC2204.2 +041000 DISPLAY TABLE1-REC (INDEX1 + 1) NC2204.2 +041100 UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +041200 PERFORM INSPT. NC2204.2 +041300 GO TO DIS-WRITE-GF-2. NC2204.2 +041400 DIS-DELETE-GF-2. NC2204.2 +041500 PERFORM DE-LETE. NC2204.2 +041600 DIS-WRITE-GF-2. NC2204.2 +041700 PERFORM PRINT-DETAIL. NC2204.2 +041800* NC2204.2 +041900 MLT-INIT-F1-1. NC2204.2 +042000 MOVE "MLT-TEST-F1-1" TO PAR-NAME. NC2204.2 +042100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +042200 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +042300 PERFORM BUILD-TABLE2. NC2204.2 +042400 PERFORM BUILD-TABLE3. NC2204.2 +042500 SET INDEX2 TO 1. NC2204.2 +042600 SET INDEX3 TO 1. NC2204.2 +042700 MLT-TEST-F1-1. NC2204.2 +042800 MULTIPLY NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +042900 BY NUMBER2 OF TABLE3 (INDEX3). NC2204.2 +043000 IF NUMBER2 OF TABLE3 (INDEX3) = 44 NC2204.2 +043100 PERFORM PASS NC2204.2 +043200 ELSE GO TO MLT-FAIL-F1-1. NC2204.2 +043300 GO TO MLT-WRITE-F1-1. NC2204.2 +043400 MLT-DELETE-F1-1. NC2204.2 +043500 PERFORM DE-LETE. NC2204.2 +043600 GO TO MLT-WRITE-F1-1. NC2204.2 +043700 MLT-FAIL-F1-1. NC2204.2 +043800 PERFORM FAIL. NC2204.2 +043900 MOVE NUMBER2 OF TABLE3 (INDEX3) TO COMPUTED-18V0. NC2204.2 +044000 MOVE 44 TO CORRECT-18V0. NC2204.2 +044100 MLT-WRITE-F1-1. NC2204.2 +044200 PERFORM PRINT-DETAIL. NC2204.2 +044300* NC2204.2 +044400 MLT-INIT-F1-2. NC2204.2 +044500 MOVE "MLT-TEST-F1-2" TO PAR-NAME. NC2204.2 +044600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +044700 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +044800 PERFORM BUILD-TABLE2. NC2204.2 +044900 PERFORM BUILD-TABLE3. NC2204.2 +045000 PERFORM BUILD-TABLE4. NC2204.2 +045100 SET INDEX2 TO 1. NC2204.2 +045200 SET INDEX3 TO 1. NC2204.2 +045300 MLT-TEST-F1-2. NC2204.2 +045400 MULTIPLY NUMBER2 OF TABLE2 (INDEX2 + 1) NC2204.2 +045500 BY NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +045600 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 92 NC2204.2 +045700 PERFORM PASS NC2204.2 +045800 ELSE GO TO MLT-FAIL-F1-2. NC2204.2 +045900 GO TO MLT-WRITE-F1-2. NC2204.2 +046000 MLT-DELETE-F1-2. NC2204.2 +046100 PERFORM DE-LETE. NC2204.2 +046200 GO TO MLT-WRITE-F1-2. NC2204.2 +046300 MLT-FAIL-F1-2. NC2204.2 +046400 PERFORM FAIL. NC2204.2 +046500 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +046600 MOVE 92 TO CORRECT-18V0. NC2204.2 +046700 MLT-WRITE-F1-2. NC2204.2 +046800 PERFORM PRINT-DETAIL. NC2204.2 +046900* NC2204.2 +047000 MLT-INIT-F1-3. NC2204.2 +047100 MOVE "MLT-TEST-F1-3" TO PAR-NAME. NC2204.2 +047200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +047300 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +047400 PERFORM BUILD-TABLE4. NC2204.2 +047500 SET INDEX4-1 TO 2. NC2204.2 +047600 SET INDEX4-2 TO 1. NC2204.2 +047700 MLT-TEST-F1-3. NC2204.2 +047800 MULTIPLY TABLE4-NUM2 (1, 3) NC2204.2 +047900 BY TABLE4-NUM2 (INDEX4-1, INDEX4-2). NC2204.2 +048000 IF TABLE4-NUM2 (INDEX4-1, INDEX4-2) = 60 NC2204.2 +048100 PERFORM PASS NC2204.2 +048200 ELSE GO TO MLT-FAIL-F1-3. NC2204.2 +048300 GO TO MLT-WRITE-F1-3. NC2204.2 +048400 MLT-DELETE-F1-3. NC2204.2 +048500 PERFORM DE-LETE. NC2204.2 +048600 GO TO MLT-WRITE-F1-3. NC2204.2 +048700 MLT-FAIL-F1-3. NC2204.2 +048800 PERFORM FAIL. NC2204.2 +048900 MOVE TABLE4-NUM2 (INDEX4-1, INDEX4-2) TO COMPUTED-18V0. NC2204.2 +049000 MOVE 60 TO CORRECT-18V0. NC2204.2 +049100 MLT-WRITE-F1-3. NC2204.2 +049200 PERFORM PRINT-DETAIL. NC2204.2 +049300* NC2204.2 +049400 DIV-INIT-F5-1. NC2204.2 +049500 MOVE "DIV-TEST-F5-1" TO PAR-NAME. NC2204.2 +049600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +049700 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +049800 MOVE 1 TO REC-CT. NC2204.2 +049900 MOVE ZEROS TO TABLE6. NC2204.2 +050000 MOVE ZEROS TO NUM-999. NC2204.2 +050100 PERFORM BUILD-TABLE5. NC2204.2 +050200 SET INDEX5 TO 1. NC2204.2 +050300 SET INDEX6 TO 1. NC2204.2 +050400 DIV-TEST-F5-1. NC2204.2 +050500 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +050600 GIVING TABLE6-NUM (INDEX6) REMAINDER NUM-999. NC2204.2 +050700 GO TO DIV-TEST-F5-1-1. NC2204.2 +050800 DIV-DELETE-F5-1. NC2204.2 +050900 PERFORM DE-LETE. NC2204.2 +051000 PERFORM PRINT-DETAIL. NC2204.2 +051100 GO TO DIV-TEST-F5-2. NC2204.2 +051200* NC2204.2 +051300 DIV-TEST-F5-1-1. NC2204.2 +051400 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +051500 IF TABLE6-NUM (INDEX6) = 2 NC2204.2 +051600 PERFORM PASS NC2204.2 +051700 GO TO DIV-WRITE-F5-1-1 NC2204.2 +051800 ELSE NC2204.2 +051900 GO TO DIV-FAIL-F5-1-1. NC2204.2 +052000 DIV-DELETE-F5-1-1. NC2204.2 +052100 PERFORM DE-LETE. NC2204.2 +052200 GO TO DIV-WRITE-F5-1-1. NC2204.2 +052300 DIV-FAIL-F5-1-1. NC2204.2 +052400 PERFORM FAIL NC2204.2 +052500 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +052600 MOVE 2 TO CORRECT-18V0. NC2204.2 +052700 DIV-WRITE-F5-1-1. NC2204.2 +052800 PERFORM PRINT-DETAIL. NC2204.2 +052900* NC2204.2 +053000 DIV-TEST-F5-1-2. NC2204.2 +053100 ADD 1 TO REC-CT. NC2204.2 +053200 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +053300 IF NUM-999 = 1 NC2204.2 +053400 PERFORM PASS NC2204.2 +053500 GO TO DIV-WRITE-F5-1-2 NC2204.2 +053600 ELSE NC2204.2 +053700 GO TO DIV-FAIL-F5-1-2. NC2204.2 +053800 DIV-DELETE-F5-1-2. NC2204.2 +053900 PERFORM DE-LETE. NC2204.2 +054000 GO TO DIV-WRITE-F5-1-2. NC2204.2 +054100 DIV-FAIL-F5-1-2. NC2204.2 +054200 PERFORM FAIL NC2204.2 +054300 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +054400 MOVE 1 TO CORRECT-18V0. NC2204.2 +054500 DIV-WRITE-F5-1-2. NC2204.2 +054600 PERFORM PRINT-DETAIL. NC2204.2 +054700* NC2204.2 +054800 DIV-INIT-F5-2. NC2204.2 +054900 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +055000 MOVE "DIV-TEST-F5-2" TO PAR-NAME. NC2204.2 +055100 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +055200 MOVE 1 TO REC-CT. NC2204.2 +055300 MOVE ZEROS TO TABLE6. NC2204.2 +055400 MOVE ZEROS TO NUM-999. NC2204.2 +055500 SET INDEX5 TO 3. NC2204.2 +055600 SET INDEX6 TO 3. NC2204.2 +055700 DIV-TEST-F5-2. NC2204.2 +055800 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +055900 GIVING NUM-999 REMAINDER TABLE6-NUM (INDEX6). NC2204.2 +056000 GO TO DIV-TEST-F5-2-1. NC2204.2 +056100 DIV-DELETE-F5-2. NC2204.2 +056200 PERFORM DE-LETE. NC2204.2 +056300 PERFORM PRINT-DETAIL. NC2204.2 +056400 GO TO DIV-TEST-F5-3. NC2204.2 +056500* NC2204.2 +056600 DIV-TEST-F5-2-1. NC2204.2 +056700 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +056800 IF NUM-999 = 16 NC2204.2 +056900 PERFORM PASS NC2204.2 +057000 GO TO DIV-WRITE-F5-2-1 NC2204.2 +057100 ELSE NC2204.2 +057200 GO TO DIV-FAIL-F5-2-1. NC2204.2 +057300 DIV-DELETE-F5-2-1. NC2204.2 +057400 PERFORM DE-LETE. NC2204.2 +057500 GO TO DIV-WRITE-F5-2-1. NC2204.2 +057600 DIV-FAIL-F5-2-1. NC2204.2 +057700 PERFORM FAIL NC2204.2 +057800 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +057900 MOVE 16 TO CORRECT-18V0. NC2204.2 +058000 DIV-WRITE-F5-2-1. NC2204.2 +058100 PERFORM PRINT-DETAIL. NC2204.2 +058200* NC2204.2 +058300 DIV-TEST-F5-2-2. NC2204.2 +058400 ADD 1 TO REC-CT. NC2204.2 +058500 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +058600 IF TABLE6-NUM (INDEX6) = 21 NC2204.2 +058700 PERFORM PASS NC2204.2 +058800 GO TO DIV-WRITE-F5-2-2 NC2204.2 +058900 ELSE NC2204.2 +059000 GO TO DIV-FAIL-F5-2-2. NC2204.2 +059100 DIV-DELETE-F5-2-2. NC2204.2 +059200 PERFORM DE-LETE. NC2204.2 +059300 GO TO DIV-WRITE-F5-2-2. NC2204.2 +059400 DIV-FAIL-F5-2-2. NC2204.2 +059500 PERFORM FAIL NC2204.2 +059600 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +059700 MOVE 21 TO CORRECT-18V0. NC2204.2 +059800 DIV-WRITE-F5-2-2. NC2204.2 +059900 PERFORM PRINT-DETAIL. NC2204.2 +060000* NC2204.2 +060100 DIV-INIT-F5-3. NC2204.2 +060200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +060300 MOVE "DIV-TEST-F5-3" TO PAR-NAME. NC2204.2 +060400 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +060500 MOVE 1 TO REC-CT. NC2204.2 +060600 MOVE ZEROS TO TABLE6. NC2204.2 +060700 SET INDEX5 TO 5. NC2204.2 +060800 SET INDEX6 TO 5. NC2204.2 +060900 DIV-TEST-F5-3. NC2204.2 +061000 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +061100 GIVING TABLE6-NUM (INDEX6) NC2204.2 +061200 REMAINDER TABLE6-NUM (INDEX6 + 1). NC2204.2 +061300 GO TO DIV-TEST-F5-3-1. NC2204.2 +061400 DIV-DELETE-F5-3. NC2204.2 +061500 PERFORM DE-LETE. NC2204.2 +061600 PERFORM PRINT-DETAIL. NC2204.2 +061700 GO TO DIV-TEST-F4-4. NC2204.2 +061800* NC2204.2 +061900 DIV-TEST-F5-3-1. NC2204.2 +062000 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +062100 IF TABLE6-NUM (INDEX6) = 0 NC2204.2 +062200 PERFORM PASS NC2204.2 +062300 GO TO DIV-WRITE-F5-3-1 NC2204.2 +062400 ELSE NC2204.2 +062500 GO TO DIV-FAIL-F5-3-1. NC2204.2 +062600 DIV-DELETE-F5-3-1. NC2204.2 +062700 PERFORM DE-LETE. NC2204.2 +062800 GO TO DIV-WRITE-F5-3-1. NC2204.2 +062900 DIV-FAIL-F5-3-1. NC2204.2 +063000 PERFORM FAIL NC2204.2 +063100 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +063200 MOVE 0 TO CORRECT-18V0. NC2204.2 +063300 DIV-WRITE-F5-3-1. NC2204.2 +063400 PERFORM PRINT-DETAIL. NC2204.2 +063500* NC2204.2 +063600 DIV-TEST-F5-3-2. NC2204.2 +063700 ADD 1 TO REC-CT. NC2204.2 +063800 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +063900 IF TABLE6-NUM (INDEX6 + 1) = 82 NC2204.2 +064000 PERFORM PASS NC2204.2 +064100 GO TO DIV-WRITE-F5-3-2 NC2204.2 +064200 ELSE NC2204.2 +064300 GO TO DIV-FAIL-F5-3-2. NC2204.2 +064400 DIV-DELETE-F5-3-2. NC2204.2 +064500 PERFORM DE-LETE. NC2204.2 +064600 GO TO DIV-WRITE-F5-3-2. NC2204.2 +064700 DIV-FAIL-F5-3-2. NC2204.2 +064800 PERFORM FAIL NC2204.2 +064900 MOVE TABLE6-NUM (INDEX6 + 1) TO COMPUTED-18V0 NC2204.2 +065000 MOVE 82 TO CORRECT-18V0. NC2204.2 +065100 DIV-WRITE-F5-3-2. NC2204.2 +065200 PERFORM PRINT-DETAIL. NC2204.2 +065300* NC2204.2 +065400 DIV-INIT-F4-4. NC2204.2 +065500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +065600 MOVE "DIV-TEST-F4-4" TO PAR-NAME. NC2204.2 +065700 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +065800 MOVE 1 TO REC-CT. NC2204.2 +065900 MOVE ZEROS TO TABLE6. NC2204.2 +066000 MOVE ZEROS TO NUM-999. NC2204.2 +066100 SET INDEX5 TO 1. NC2204.2 +066200 SET INDEX6 TO 1. NC2204.2 +066300 DIV-TEST-F4-4. NC2204.2 +066400 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +066500 GIVING TABLE6-NUM (INDEX6) REMAINDER NUM-999. NC2204.2 +066600 GO TO DIV-TEST-F4-4-1. NC2204.2 +066700 DIV-DELETE-F4-4. NC2204.2 +066800 PERFORM DE-LETE. NC2204.2 +066900 PERFORM PRINT-DETAIL. NC2204.2 +067000 GO TO DIV-TEST-F4-5. NC2204.2 +067100* NC2204.2 +067200 DIV-TEST-F4-4-1. NC2204.2 +067300 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +067400 IF TABLE6-NUM (INDEX6) = 2 NC2204.2 +067500 PERFORM PASS NC2204.2 +067600 GO TO DIV-WRITE-F4-4-1 NC2204.2 +067700 ELSE NC2204.2 +067800 GO TO DIV-FAIL-F4-4-1. NC2204.2 +067900 DIV-DELETE-F4-4-1. NC2204.2 +068000 PERFORM DE-LETE. NC2204.2 +068100 GO TO DIV-WRITE-F4-4-1. NC2204.2 +068200 DIV-FAIL-F4-4-1. NC2204.2 +068300 PERFORM FAIL NC2204.2 +068400 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +068500 MOVE 2 TO CORRECT-18V0. NC2204.2 +068600 DIV-WRITE-F4-4-1. NC2204.2 +068700 PERFORM PRINT-DETAIL. NC2204.2 +068800 ADD 1 TO REC-CT. NC2204.2 +068900* NC2204.2 +069000 DIV-TEST-F4-4-2. NC2204.2 +069100 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +069200 IF NUM-999 = 1 NC2204.2 +069300 PERFORM PASS NC2204.2 +069400 GO TO DIV-WRITE-F4-4-2 NC2204.2 +069500 ELSE NC2204.2 +069600 GO TO DIV-FAIL-F4-4-2. NC2204.2 +069700 DIV-DELETE-F4-4-2. NC2204.2 +069800 PERFORM DE-LETE. NC2204.2 +069900 GO TO DIV-WRITE-F4-4-2. NC2204.2 +070000 DIV-FAIL-F4-4-2. NC2204.2 +070100 PERFORM FAIL NC2204.2 +070200 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +070300 MOVE 1 TO CORRECT-18V0. NC2204.2 +070400 DIV-WRITE-F4-4-2. NC2204.2 +070500 PERFORM PRINT-DETAIL. NC2204.2 +070600* NC2204.2 +070700 DIV-INIT-F4-5. NC2204.2 +070800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +070900 MOVE "DIV-TEST-F4-5" TO PAR-NAME. NC2204.2 +071000 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +071100 MOVE 1 TO REC-CT. NC2204.2 +071200 MOVE ZEROS TO TABLE6. NC2204.2 +071300 MOVE ZEROS TO NUM-999. NC2204.2 +071400 SET INDEX5 TO 3. NC2204.2 +071500 SET INDEX6 TO 3. NC2204.2 +071600 DIV-TEST-F4-5. NC2204.2 +071700 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +071800 GIVING NUM-999 REMAINDER TABLE6-NUM (INDEX6). NC2204.2 +071900 GO TO DIV-TEST-F4-5-1. NC2204.2 +072000 DIV-DELETE-F4-5. NC2204.2 +072100 PERFORM DE-LETE. NC2204.2 +072200 PERFORM PRINT-DETAIL. NC2204.2 +072300 GO TO DIV-TEST-F4-6. NC2204.2 +072400* NC2204.2 +072500 DIV-TEST-F4-5-1. NC2204.2 +072600 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +072700 IF NUM-999 = 16 NC2204.2 +072800 PERFORM PASS NC2204.2 +072900 GO TO DIV-WRITE-F4-5-1 NC2204.2 +073000 ELSE NC2204.2 +073100 GO TO DIV-FAIL-F4-5-1. NC2204.2 +073200 DIV-DELETE-F4-5-1. NC2204.2 +073300 PERFORM DE-LETE. NC2204.2 +073400 GO TO DIV-WRITE-F4-5-1. NC2204.2 +073500 DIV-FAIL-F4-5-1. NC2204.2 +073600 PERFORM FAIL NC2204.2 +073700 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +073800 MOVE 16 TO CORRECT-18V0. NC2204.2 +073900 DIV-WRITE-F4-5-1. NC2204.2 +074000 PERFORM PRINT-DETAIL. NC2204.2 +074100 ADD 1 TO REC-CT. NC2204.2 +074200* NC2204.2 +074300 DIV-TEST-F4-5-2. NC2204.2 +074400 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +074500 IF TABLE6-NUM (INDEX6) = 21 NC2204.2 +074600 PERFORM PASS NC2204.2 +074700 GO TO DIV-WRITE-F4-5-2 NC2204.2 +074800 ELSE NC2204.2 +074900 GO TO DIV-FAIL-F4-5-2. NC2204.2 +075000 DIV-DELETE-F4-5-2. NC2204.2 +075100 PERFORM DE-LETE. NC2204.2 +075200 GO TO DIV-WRITE-F4-5-2. NC2204.2 +075300 DIV-FAIL-F4-5-2. NC2204.2 +075400 PERFORM FAIL NC2204.2 +075500 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +075600 MOVE 21 TO CORRECT-18V0. NC2204.2 +075700 DIV-WRITE-F4-5-2. NC2204.2 +075800 PERFORM PRINT-DETAIL. NC2204.2 +075900* NC2204.2 +076000 DIV-INIT-F4-6. NC2204.2 +076100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +076200 MOVE "DIV-TEST-F4-6" TO PAR-NAME. NC2204.2 +076300 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +076400 MOVE 1 TO REC-CT. NC2204.2 +076500 MOVE ZEROS TO TABLE6. NC2204.2 +076600 MOVE ZEROS TO NUM-999. NC2204.2 +076700 SET INDEX5 TO 5. NC2204.2 +076800 SET INDEX6 TO 5. NC2204.2 +076900 DIV-TEST-F4-6. NC2204.2 +077000 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +077100 GIVING TABLE6-NUM (INDEX6) NC2204.2 +077200 REMAINDER TABLE6-NUM (INDEX6 + 1). NC2204.2 +077300 GO TO DIV-TEST-F4-6-1. NC2204.2 +077400 DIV-DELETE-F4-6. NC2204.2 +077500 PERFORM DE-LETE. NC2204.2 +077600 PERFORM PRINT-DETAIL. NC2204.2 +077700 GO TO DIV-TEST-F1-7. NC2204.2 +077800* NC2204.2 +077900 DIV-TEST-F4-6-1. NC2204.2 +078000 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +078100 IF TABLE6-NUM (INDEX6) = 0 NC2204.2 +078200 PERFORM PASS NC2204.2 +078300 GO TO DIV-WRITE-F4-6-1 NC2204.2 +078400 ELSE NC2204.2 +078500 GO TO DIV-FAIL-F4-6-1. NC2204.2 +078600 DIV-DELETE-F4-6-1. NC2204.2 +078700 PERFORM DE-LETE. NC2204.2 +078800 GO TO DIV-WRITE-F4-6-1. NC2204.2 +078900 DIV-FAIL-F4-6-1. NC2204.2 +079000 PERFORM FAIL NC2204.2 +079100 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +079200 MOVE 0 TO CORRECT-18V0. NC2204.2 +079300 DIV-WRITE-F4-6-1. NC2204.2 +079400 PERFORM PRINT-DETAIL. NC2204.2 +079500 ADD 1 TO REC-CT. NC2204.2 +079600* NC2204.2 +079700 DIV-TEST-F4-6-2. NC2204.2 +079800 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +079900 IF TABLE6-NUM (INDEX6 + 1) = 82 NC2204.2 +080000 PERFORM PASS NC2204.2 +080100 GO TO DIV-WRITE-F4-6-2 NC2204.2 +080200 ELSE NC2204.2 +080300 GO TO DIV-FAIL-F4-6-2. NC2204.2 +080400 DIV-DELETE-F4-6-2. NC2204.2 +080500 PERFORM DE-LETE. NC2204.2 +080600 GO TO DIV-WRITE-F4-6-2. NC2204.2 +080700 DIV-FAIL-F4-6-2. NC2204.2 +080800 PERFORM FAIL NC2204.2 +080900 MOVE TABLE6-NUM (INDEX6 + 1) TO COMPUTED-18V0 NC2204.2 +081000 MOVE 82 TO CORRECT-18V0. NC2204.2 +081100 DIV-WRITE-F4-6-2. NC2204.2 +081200 PERFORM PRINT-DETAIL. NC2204.2 +081300* NC2204.2 +081400 DIV-INIT-F1-7. NC2204.2 +081500 MOVE "DIV-TEST-F1-7" TO PAR-NAME. NC2204.2 +081600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +081700 MOVE ZEROS TO REC-CT. NC2204.2 +081800 PERFORM BUILD-TABLE2. NC2204.2 +081900 PERFORM BUILD-TABLE3. NC2204.2 +082000 MOVE "DIVIDE INTO" TO FEATURE. NC2204.2 +082100 SET INDEX2 TO 3. NC2204.2 +082200 SET INDEX3 TO 3. NC2204.2 +082300 DIV-TEST-F1-7. NC2204.2 +082400 DIVIDE NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +082500 INTO NUMBER2 OF TABLE3 (INDEX3). NC2204.2 +082600 IF NUMBER2 OF TABLE3 (INDEX3) = 2 NC2204.2 +082700 PERFORM PASS NC2204.2 +082800 ELSE GO TO DIV-FAIL-F1-7. NC2204.2 +082900 GO TO DIV-WRITE-F1-7. NC2204.2 +083000 DIV-DELETE-F1-7. NC2204.2 +083100 PERFORM DE-LETE. NC2204.2 +083200 GO TO DIV-WRITE-F1-7. NC2204.2 +083300 DIV-FAIL-F1-7. NC2204.2 +083400 PERFORM FAIL. NC2204.2 +083500 MOVE NUMBER2 OF TABLE3 (INDEX3) TO COMPUTED-18V0. NC2204.2 +083600 MOVE 2 TO CORRECT-18V0. NC2204.2 +083700 DIV-WRITE-F1-7. NC2204.2 +083800 PERFORM PRINT-DETAIL. NC2204.2 +083900* NC2204.2 +084000 DIV-INIT-F1-8. NC2204.2 +084100 MOVE "DIV-TEST-F1-8" TO PAR-NAME. NC2204.2 +084200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +084300 MOVE ZEROS TO REC-CT. NC2204.2 +084400 PERFORM BUILD-TABLE2. NC2204.2 +084500 PERFORM BUILD-TABLE3. NC2204.2 +084600 MOVE "DIVIDE INTO" TO FEATURE. NC2204.2 +084700 SET INDEX2 TO 3. NC2204.2 +084800 SET INDEX3 TO 3. NC2204.2 +084900 DIV-TEST-F1-8. NC2204.2 +085000 DIVIDE NUMBER2 OF TABLE2 (INDEX2 + 1) NC2204.2 +085100 INTO NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +085200 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 4 NC2204.2 +085300 PERFORM PASS NC2204.2 +085400 ELSE GO TO DIV-FAIL-F1-8. NC2204.2 +085500 GO TO DIV-WRITE-F1-8. NC2204.2 +085600 DIV-DELETE-F1-8. NC2204.2 +085700 PERFORM DE-LETE. NC2204.2 +085800 GO TO DIV-WRITE-F1-8. NC2204.2 +085900 DIV-FAIL-F1-8. NC2204.2 +086000 PERFORM FAIL. NC2204.2 +086100 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +086200 MOVE 4 TO CORRECT-18V0. NC2204.2 +086300 DIV-WRITE-F1-8. NC2204.2 +086400 PERFORM PRINT-DETAIL. NC2204.2 +086500* NC2204.2 +086600 DIV-INIT-F5-9. NC2204.2 +086700 MOVE "DIV-TEST-F5-9" TO PAR-NAME. NC2204.2 +086800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +086900 MOVE ZEROS TO REC-CT. NC2204.2 +087000 PERFORM BUILD-TABLE2. NC2204.2 +087100 PERFORM BUILD-TABLE3. NC2204.2 +087200 MOVE "DIVIDE BY GIVING" TO FEATURE. NC2204.2 +087300 SET INDEX2 TO 1. NC2204.2 +087400 SET INDEX3 TO 2. NC2204.2 +087500 DIV-TEST-F5-9. NC2204.2 +087600 DIVIDE NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +087700 BY NUMBER2 OF TABLE3 (INDEX3) NC2204.2 +087800 GIVING NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +087900 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 1 NC2204.2 +088000 PERFORM PASS NC2204.2 +088100 ELSE GO TO DIV-FAIL-F5-9. NC2204.2 +088200 GO TO DIV-WRITE-F5-9. NC2204.2 +088300 DIV-DELETE-F5-9. NC2204.2 +088400 PERFORM DE-LETE. NC2204.2 +088500 GO TO DIV-WRITE-F5-9. NC2204.2 +088600 DIV-FAIL-F5-9. NC2204.2 +088700 PERFORM FAIL. NC2204.2 +088800 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +088900 MOVE 1 TO CORRECT-18V0. NC2204.2 +089000 DIV-WRITE-F5-9. NC2204.2 +089100 PERFORM PRINT-DETAIL. NC2204.2 +089200* NC2204.2 +089300 DIV-INIT-F5-10. NC2204.2 +089400 MOVE "DIV-TEST-F5-10" TO PAR-NAME. NC2204.2 +089500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +089600 MOVE ZEROS TO REC-CT. NC2204.2 +089700 PERFORM BUILD-TABLE2. NC2204.2 +089800 PERFORM BUILD-TABLE3. NC2204.2 +089900 MOVE "DIVIDE BY GIVING" TO FEATURE. NC2204.2 +090000 SET INDEX2 TO 2. NC2204.2 +090100 SET INDEX3 TO 3. NC2204.2 +090200 DIV-TEST-F5-10. NC2204.2 +090300 DIVIDE NUMBER2 OF TABLE3 (INDEX3 + 1) NC2204.2 +090400 BY NUMBER2 OF TABLE2 (INDEX2 + 2) NC2204.2 +090500 GIVING NUMBER2 OF TABLE2 (INDEX2). NC2204.2 +090600 IF NUMBER2 OF TABLE2 (INDEX2) = 4 NC2204.2 +090700 PERFORM PASS NC2204.2 +090800 ELSE GO TO DIV-FAIL-F5-10. NC2204.2 +090900 GO TO DIV-WRITE-F5-10. NC2204.2 +091000 DIV-DELETE-F5-10. NC2204.2 +091100 PERFORM DE-LETE. NC2204.2 +091200 GO TO DIV-WRITE-F5-10. NC2204.2 +091300 DIV-FAIL-F5-10. NC2204.2 +091400 PERFORM FAIL. NC2204.2 +091500 MOVE NUMBER2 OF TABLE2 (INDEX2) TO COMPUTED-18V0. NC2204.2 +091600 MOVE 4 TO CORRECT-18V0. NC2204.2 +091700 DIV-WRITE-F5-10. NC2204.2 +091800 PERFORM PRINT-DETAIL. NC2204.2 +091900* NC2204.2 +092000 PFM-INIT-F3-1. NC2204.2 +092100 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC2204.2 +092200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +092300 MOVE ZEROS TO REC-CT. NC2204.2 +092400 MOVE "PERFORM UNTIL" TO FEATURE. NC2204.2 +092500 PERFORM BUILD-TABLE7. NC2204.2 +092600 PERFORM BUILD-TABLE8. NC2204.2 +092700 SET INDEX7 TO 1. NC2204.2 +092800 SET INDEX8 TO 1. NC2204.2 +092900 PFM-TEST-F3-1. NC2204.2 +093000 PERFORM PARAGRAPH-A UNTIL TABLE7-NUM (INDEX7) NC2204.2 +093100 IS EQUAL TO TABLE8-NUM (INDEX8). NC2204.2 +093200 IF TABLE7-NUM (INDEX7) = 4 NC2204.2 +093300 PERFORM PASS NC2204.2 +093400 ELSE GO TO PFM-FAIL-F3-1. NC2204.2 +093500 GO TO PFM-WRITE-F3-1. NC2204.2 +093600 PFM-DELETE-F3-1. NC2204.2 +093700 PERFORM DE-LETE. NC2204.2 +093800 GO TO PFM-WRITE-F3-1. NC2204.2 +093900 PFM-FAIL-F3-1. NC2204.2 +094000 PERFORM FAIL. NC2204.2 +094100 MOVE TABLE7-NUM (INDEX7) TO COMPUTED-18V0. NC2204.2 +094200 MOVE 4 TO CORRECT-18V0. NC2204.2 +094300 PFM-WRITE-F3-1. NC2204.2 +094400 PERFORM PRINT-DETAIL. NC2204.2 +094500* NC2204.2 +094600 PFM-INIT-F3-2. NC2204.2 +094700 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC2204.2 +094800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +094900 MOVE ZEROS TO REC-CT. NC2204.2 +095000 MOVE "PERFORM UNTIL" TO FEATURE. NC2204.2 +095100 PERFORM BUILD-TABLE7. NC2204.2 +095200 PERFORM BUILD-TABLE8. NC2204.2 +095300 SET INDEX7 TO 1. NC2204.2 +095400 SET INDEX8 TO 1. NC2204.2 +095500 PFM-TEST-F3-2. NC2204.2 +095600 PERFORM PARAGRAPH-A UNTIL TABLE7-NUM (INDEX7) NC2204.2 +095700 IS GREATER THAN TABLE8-NUM (INDEX8). NC2204.2 +095800 IF TABLE7-NUM (INDEX7) = 5 NC2204.2 +095900 PERFORM PASS NC2204.2 +096000 ELSE GO TO PFM-FAIL-F3-2. NC2204.2 +096100 GO TO PFM-WRITE-F3-2. NC2204.2 +096200 PFM-DELETE-F3-2. NC2204.2 +096300 PERFORM DE-LETE. NC2204.2 +096400 GO TO PFM-WRITE-F3-2. NC2204.2 +096500 PFM-FAIL-F3-2. NC2204.2 +096600 PERFORM FAIL. NC2204.2 +096700 MOVE TABLE7-NUM (INDEX7) TO COMPUTED-18V0. NC2204.2 +096800 MOVE 5 TO CORRECT-18V0. NC2204.2 +096900 PFM-WRITE-F3-2. NC2204.2 +097000 PERFORM PRINT-DETAIL. NC2204.2 +097100* NC2204.2 +097200 PFM-INIT-F4-3. NC2204.2 +097300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2204.2 +097400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +097500 MOVE ZEROS TO REC-CT. NC2204.2 +097600 MOVE "PERFORM VARYING" TO FEATURE. NC2204.2 +097700 MOVE ZEROS TO NUM-9. NC2204.2 +097800 PERFORM BUILD-TABLE7. NC2204.2 +097900 PERFORM BUILD-TABLE8. NC2204.2 +098000 SET INDEX7 TO 2. NC2204.2 +098100 SET INDEX8 TO 2. NC2204.2 +098200 PFM-TEST-F4-3. NC2204.2 +098300 PERFORM PARAGRAPH-B VARYING NUM-9 NC2204.2 +098400 FROM 1 BY 1 NC2204.2 +098500 UNTIL NUM-9 > TABLE8-NUM (INDEX8). NC2204.2 +098600 IF NUM-9 = 8 NC2204.2 +098700 PERFORM PASS NC2204.2 +098800 ELSE GO TO PFM-FAIL-F4-3. NC2204.2 +098900 GO TO PFM-WRITE-F4-3. NC2204.2 +099000 PFM-DELETE-F4-3. NC2204.2 +099100 PERFORM DE-LETE. NC2204.2 +099200 GO TO PFM-WRITE-F4-3. NC2204.2 +099300 PFM-FAIL-F4-3. NC2204.2 +099400 PERFORM FAIL. NC2204.2 +099500 MOVE NUM-9 TO COMPUTED-18V0. NC2204.2 +099600 MOVE 8 TO CORRECT-18V0. NC2204.2 +099700 PFM-WRITE-F4-3. NC2204.2 +099800 PERFORM PRINT-DETAIL. NC2204.2 +099900* NC2204.2 +100000 PFM-INIT-F4-4. NC2204.2 +100100 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2204.2 +100200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +100300 MOVE ZEROS TO REC-CT. NC2204.2 +100400 MOVE "PERFORM VARYING" TO FEATURE. NC2204.2 +100500 MOVE ZEROS TO NUM-9. NC2204.2 +100600 PERFORM BUILD-TABLE7. NC2204.2 +100700 PERFORM BUILD-TABLE8. NC2204.2 +100800 SET INDEX7 TO 2. NC2204.2 +100900 SET INDEX8 TO 3. NC2204.2 +101000 PFM-TEST-F4-4. NC2204.2 +101100 PERFORM PARAGRAPH-B VARYING NUM-9 NC2204.2 +101200 FROM 7 BY -1 NC2204.2 +101300 UNTIL NUM-9 < TABLE8-NUM (INDEX8). NC2204.2 +101400 IF NUM-9 = 1 NC2204.2 +101500 PERFORM PASS NC2204.2 +101600 ELSE GO TO PFM-FAIL-F4-4. NC2204.2 +101700 GO TO PFM-WRITE-F4-4. NC2204.2 +101800 PFM-DELETE-F4-4. NC2204.2 +101900 PERFORM DE-LETE. NC2204.2 +102000 GO TO PFM-WRITE-F4-4. NC2204.2 +102100 PFM-FAIL-F4-4. NC2204.2 +102200 PERFORM FAIL. NC2204.2 +102300 MOVE NUM-9 TO COMPUTED-18V0. NC2204.2 +102400 MOVE 1 TO CORRECT-18V0. NC2204.2 +102500 PFM-WRITE-F4-4. NC2204.2 +102600 PERFORM PRINT-DETAIL. NC2204.2 +102700 GO TO CCVS-999999. NC2204.2 +102800* NC2204.2 +102900 PARAGRAPH-A. NC2204.2 +103000 ADD 1 TO TABLE7-NUM (INDEX7). NC2204.2 +103100* NC2204.2 +103200 PARAGRAPH-B. NC2204.2 +103300 MOVE NUM-9 TO TABLE7-NUM (INDEX7). NC2204.2 +103400* NC2204.2 +103500 CCVS-EXIT SECTION. NC2204.2 +103600 CCVS-999999. NC2204.2 +103700 GO TO CLOSE-FILES. NC2204.2 +*END-OF,NC220M +*HEADER,COBOL,NC221A +000100 IDENTIFICATION DIVISION. NC2214.2 +000200 PROGRAM-ID. NC2214.2 +000300 NC221A. NC2214.2 +000400**************************************************************** NC2214.2 +000500* * NC2214.2 +000600* VALIDATION FOR:- * NC2214.2 +000700* * NC2214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +000900* * NC2214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2214.2 +001100* * NC2214.2 +001200**************************************************************** NC2214.2 +001300* * NC2214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2214.2 +001500* * NC2214.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2214.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2214.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2214.2 +001900* * NC2214.2 +002000**************************************************************** NC2214.2 +002100* * NC2214.2 +002200* PROGRAM NC221A TEST THE USE OF INDEXED IDENTIFIERS WITH * NC2214.2 +002300* FORMATS 1, 2 AND 3 OF THE "INSPECT" STATEMENT. * NC2214.2 +002400* * NC2214.2 +002500**************************************************************** NC2214.2 +002600 ENVIRONMENT DIVISION. NC2214.2 +002700 CONFIGURATION SECTION. NC2214.2 +002800 SOURCE-COMPUTER. NC2214.2 +002900 XXXXX082. NC2214.2 +003000 OBJECT-COMPUTER. NC2214.2 +003100 XXXXX083. NC2214.2 +003200 INPUT-OUTPUT SECTION. NC2214.2 +003300 FILE-CONTROL. NC2214.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2214.2 +003500 XXXXX055. NC2214.2 +003600 DATA DIVISION. NC2214.2 +003700 FILE SECTION. NC2214.2 +003800 FD PRINT-FILE. NC2214.2 +003900 01 PRINT-REC PICTURE X(120). NC2214.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2214.2 +004100 WORKING-STORAGE SECTION. NC2214.2 +004200 NC2214.2 +004300 01 WS-RIGHT-1-83. NC2214.2 +004400 03 WS-RIGHT-1-20 PIC X(20). NC2214.2 +004500 03 WS-RIGHT-21-40 PIC X(20). NC2214.2 +004600 03 WS-RIGHT-41-60 PIC X(20). NC2214.2 +004700 03 WS-RIGHT-61-80 PIC X(20). NC2214.2 +004800 03 WS-RIGHT-81-83 PIC X(3). NC2214.2 +004900 01 WS-WRONG-1-83. NC2214.2 +005000 03 WS-WRONG-1-20 PIC X(20). NC2214.2 +005100 03 WS-WRONG-21-40 PIC X(20). NC2214.2 +005200 03 WS-WRONG-41-60 PIC X(20). NC2214.2 +005300 03 WS-WRONG-61-80 PIC X(20). NC2214.2 +005400 03 WS-WRONG-81-83 PIC X(3). NC2214.2 +005500 NC2214.2 +005600 01 TABLE1. NC2214.2 +005700 02 TABLE1-REC PICTURE X(83) NC2214.2 +005800 OCCURS 4 TIMES NC2214.2 +005900 INDEXED BY INDEX1. NC2214.2 +006000 01 TABLE2. NC2214.2 +006100 02 WRK-DU-999 PICTURE 999 NC2214.2 +006200 OCCURS 4 TIMES NC2214.2 +006300 INDEXED BY INDEX2. NC2214.2 +006400 01 TABLE3. NC2214.2 +006500 02 TABLE3-SYMBOL PICTURE X NC2214.2 +006600 OCCURS 3 TIMES NC2214.2 +006700 INDEXED BY INDEX3. NC2214.2 +006800 01 TABLE4. NC2214.2 +006900 02 TABLE4-LETTER PICTURE XX NC2214.2 +007000 OCCURS 5 TIMES NC2214.2 +007100 INDEXED BY INDEX4. NC2214.2 +007200 01 WC-XN-83 PIC X(83) VALUE NC2214.2 +007300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +007400- "IDS CAN NOT BE ALL BAD.". NC2214.2 +007500 01 ANS-XN-83-1 PIC X(83) VALUE NC2214.2 +007600 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2214.2 +007700- "IDS CAN NOT BE ALL BAD.". NC2214.2 +007800 01 ANS-XN-83-2 PIC X(83) VALUE NC2214.2 +007900 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008000- "IDS CAN NOT BE ALL BAD.". NC2214.2 +008100 01 ANS-XN-83-3 PIC X(83) VALUE NC2214.2 +008200 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008300- "IDS CAN NOT BE ALL BAD.". NC2214.2 +008400 01 ANS-XN-83-4 PIC X(83) VALUE NC2214.2 +008500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008600- "IDS CAN NOT BE ALL-BAD.". NC2214.2 +008700 01 ANS-XN-83-5 PIC X(83) VALUE NC2214.2 +008800 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008900- "IDS CAN NOT BE ALL BAD.". NC2214.2 +009000 01 ANS-XN-83-6 PIC X(83) VALUE NC2214.2 +009100 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +009200- "IDS CAN NOT BE ALL BAD.". NC2214.2 +009300*01 TEST-RESULTS. NC2214.2 +009400* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009500* 02 FEATURE PIC X(20) VALUE SPACE. NC2214.2 +009600* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009700* 02 P-OR-F PIC X(5) VALUE SPACE. NC2214.2 +009800* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009900* 02 PAR-NAME. NC2214.2 +010000* 03 FILLER PIC X(19) VALUE SPACE. NC2214.2 +010100* 03 PARDOT-X PIC X VALUE SPACE. NC2214.2 +010200* 03 DOTVALUE PIC 99 VALUE ZERO. NC2214.2 +010300* 02 FILLER PIC X(8) VALUE SPACE. NC2214.2 +010400* 02 RE-MARK PIC X(61). NC2214.2 +010500 01 TEST-RESULTS. NC2214.2 +010600 02 FILLER PIC X VALUE SPACE. NC2214.2 +010700 02 FEATURE PIC X(20) VALUE SPACE. NC2214.2 +010800 02 FILLER PIC X VALUE SPACE. NC2214.2 +010900 02 P-OR-F PIC X(5) VALUE SPACE. NC2214.2 +011000 02 FILLER PIC X VALUE SPACE. NC2214.2 +011100 02 PAR-NAME. NC2214.2 +011200 03 FILLER PIC X(19) VALUE SPACE. NC2214.2 +011300 03 PARDOT-X PIC X VALUE SPACE. NC2214.2 +011400 03 DOTVALUE PIC 99 VALUE ZERO. NC2214.2 +011500 02 FILLER PIC X(8) VALUE SPACE. NC2214.2 +011600 02 RE-MARK PIC X(61). NC2214.2 +011700 01 TEST-COMPUTED. NC2214.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2214.2 +011900 02 FILLER PIC X(17) VALUE NC2214.2 +012000 " COMPUTED=". NC2214.2 +012100 02 COMPUTED-X. NC2214.2 +012200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2214.2 +012300 03 COMPUTED-N REDEFINES COMPUTED-A NC2214.2 +012400 PIC -9(9).9(9). NC2214.2 +012500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2214.2 +012600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2214.2 +012700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2214.2 +012800 03 CM-18V0 REDEFINES COMPUTED-A. NC2214.2 +012900 04 COMPUTED-18V0 PIC -9(18). NC2214.2 +013000 04 FILLER PIC X. NC2214.2 +013100 03 FILLER PIC X(50) VALUE SPACE. NC2214.2 +013200 01 TEST-CORRECT. NC2214.2 +013300 02 FILLER PIC X(30) VALUE SPACE. NC2214.2 +013400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2214.2 +013500 02 CORRECT-X. NC2214.2 +013600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2214.2 +013700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2214.2 +013800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2214.2 +013900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2214.2 +014000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2214.2 +014100 03 CR-18V0 REDEFINES CORRECT-A. NC2214.2 +014200 04 CORRECT-18V0 PIC -9(18). NC2214.2 +014300 04 FILLER PIC X. NC2214.2 +014400 03 FILLER PIC X(2) VALUE SPACE. NC2214.2 +014500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2214.2 +014600 01 CCVS-C-1. NC2214.2 +014700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2214.2 +014800- "SS PARAGRAPH-NAME NC2214.2 +014900- " REMARKS". NC2214.2 +015000 02 FILLER PIC X(20) VALUE SPACE. NC2214.2 +015100 01 CCVS-C-2. NC2214.2 +015200 02 FILLER PIC X VALUE SPACE. NC2214.2 +015300 02 FILLER PIC X(6) VALUE "TESTED". NC2214.2 +015400 02 FILLER PIC X(15) VALUE SPACE. NC2214.2 +015500 02 FILLER PIC X(4) VALUE "FAIL". NC2214.2 +015600 02 FILLER PIC X(94) VALUE SPACE. NC2214.2 +015700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2214.2 +015800 01 REC-CT PIC 99 VALUE ZERO. NC2214.2 +015900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2214.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2214.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2214.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2214.2 +016700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2214.2 +016800 01 CCVS-H-1. NC2214.2 +016900 02 FILLER PIC X(39) VALUE SPACES. NC2214.2 +017000 02 FILLER PIC X(42) VALUE NC2214.2 +017100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2214.2 +017200 02 FILLER PIC X(39) VALUE SPACES. NC2214.2 +017300 01 CCVS-H-2A. NC2214.2 +017400 02 FILLER PIC X(40) VALUE SPACE. NC2214.2 +017500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2214.2 +017600 02 FILLER PIC XXXX VALUE NC2214.2 +017700 "4.2 ". NC2214.2 +017800 02 FILLER PIC X(28) VALUE NC2214.2 +017900 " COPY - NOT FOR DISTRIBUTION". NC2214.2 +018000 02 FILLER PIC X(41) VALUE SPACE. NC2214.2 +018100 NC2214.2 +018200 01 CCVS-H-2B. NC2214.2 +018300 02 FILLER PIC X(15) VALUE NC2214.2 +018400 "TEST RESULT OF ". NC2214.2 +018500 02 TEST-ID PIC X(9). NC2214.2 +018600 02 FILLER PIC X(4) VALUE NC2214.2 +018700 " IN ". NC2214.2 +018800 02 FILLER PIC X(12) VALUE NC2214.2 +018900 " HIGH ". NC2214.2 +019000 02 FILLER PIC X(22) VALUE NC2214.2 +019100 " LEVEL VALIDATION FOR ". NC2214.2 +019200 02 FILLER PIC X(58) VALUE NC2214.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +019400 01 CCVS-H-3. NC2214.2 +019500 02 FILLER PIC X(34) VALUE NC2214.2 +019600 " FOR OFFICIAL USE ONLY ". NC2214.2 +019700 02 FILLER PIC X(58) VALUE NC2214.2 +019800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2214.2 +019900 02 FILLER PIC X(28) VALUE NC2214.2 +020000 " COPYRIGHT 1985 ". NC2214.2 +020100 01 CCVS-E-1. NC2214.2 +020200 02 FILLER PIC X(52) VALUE SPACE. NC2214.2 +020300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2214.2 +020400 02 ID-AGAIN PIC X(9). NC2214.2 +020500 02 FILLER PIC X(45) VALUE SPACES. NC2214.2 +020600 01 CCVS-E-2. NC2214.2 +020700 02 FILLER PIC X(31) VALUE SPACE. NC2214.2 +020800 02 FILLER PIC X(21) VALUE SPACE. NC2214.2 +020900 02 CCVS-E-2-2. NC2214.2 +021000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2214.2 +021100 03 FILLER PIC X VALUE SPACE. NC2214.2 +021200 03 ENDER-DESC PIC X(44) VALUE NC2214.2 +021300 "ERRORS ENCOUNTERED". NC2214.2 +021400 01 CCVS-E-3. NC2214.2 +021500 02 FILLER PIC X(22) VALUE NC2214.2 +021600 " FOR OFFICIAL USE ONLY". NC2214.2 +021700 02 FILLER PIC X(12) VALUE SPACE. NC2214.2 +021800 02 FILLER PIC X(58) VALUE NC2214.2 +021900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +022000 02 FILLER PIC X(13) VALUE SPACE. NC2214.2 +022100 02 FILLER PIC X(15) VALUE NC2214.2 +022200 " COPYRIGHT 1985". NC2214.2 +022300 01 CCVS-E-4. NC2214.2 +022400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2214.2 +022500 02 FILLER PIC X(4) VALUE " OF ". NC2214.2 +022600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2214.2 +022700 02 FILLER PIC X(40) VALUE NC2214.2 +022800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2214.2 +022900 01 XXINFO. NC2214.2 +023000 02 FILLER PIC X(19) VALUE NC2214.2 +023100 "*** INFORMATION ***". NC2214.2 +023200 02 INFO-TEXT. NC2214.2 +023300 04 FILLER PIC X(8) VALUE SPACE. NC2214.2 +023400 04 XXCOMPUTED PIC X(20). NC2214.2 +023500 04 FILLER PIC X(5) VALUE SPACE. NC2214.2 +023600 04 XXCORRECT PIC X(20). NC2214.2 +023700 02 INF-ANSI-REFERENCE PIC X(48). NC2214.2 +023800 01 HYPHEN-LINE. NC2214.2 +023900 02 FILLER PIC IS X VALUE IS SPACE. NC2214.2 +024000 02 FILLER PIC IS X(65) VALUE IS "************************NC2214.2 +024100- "*****************************************". NC2214.2 +024200 02 FILLER PIC IS X(54) VALUE IS "************************NC2214.2 +024300- "******************************". NC2214.2 +024400 01 CCVS-PGM-ID PIC X(9) VALUE NC2214.2 +024500 "NC221A". NC2214.2 +024600 PROCEDURE DIVISION. NC2214.2 +024700 CCVS1 SECTION. NC2214.2 +024800 OPEN-FILES. NC2214.2 +024900 OPEN OUTPUT PRINT-FILE. NC2214.2 +025000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2214.2 +025100 MOVE SPACE TO TEST-RESULTS. NC2214.2 +025200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2214.2 +025300 GO TO CCVS1-EXIT. NC2214.2 +025400 CLOSE-FILES. NC2214.2 +025500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2214.2 +025600 TERMINATE-CCVS. NC2214.2 +025700S EXIT PROGRAM. NC2214.2 +025800STERMINATE-CALL. NC2214.2 +025900 STOP RUN. NC2214.2 +026000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2214.2 +026100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2214.2 +026200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2214.2 +026300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2214.2 +026400 MOVE "****TEST DELETED****" TO RE-MARK. NC2214.2 +026500 PRINT-DETAIL. NC2214.2 +026600 IF REC-CT NOT EQUAL TO ZERO NC2214.2 +026700 MOVE "." TO PARDOT-X NC2214.2 +026800 MOVE REC-CT TO DOTVALUE. NC2214.2 +026900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2214.2 +027000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2214.2 +027100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2214.2 +027200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2214.2 +027300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2214.2 +027400 MOVE SPACE TO CORRECT-X. NC2214.2 +027500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2214.2 +027600 MOVE SPACE TO RE-MARK. NC2214.2 +027700 HEAD-ROUTINE. NC2214.2 +027800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +027900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +028000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2214.2 +028100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2214.2 +028200 COLUMN-NAMES-ROUTINE. NC2214.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +028600 END-ROUTINE. NC2214.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2214.2 +028800 END-RTN-EXIT. NC2214.2 +028900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +029000 END-ROUTINE-1. NC2214.2 +029100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2214.2 +029200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2214.2 +029300 ADD PASS-COUNTER TO ERROR-HOLD. NC2214.2 +029400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2214.2 +029500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2214.2 +029600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2214.2 +029700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2214.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2214.2 +029900 END-ROUTINE-12. NC2214.2 +030000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2214.2 +030100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2214.2 +030200 MOVE "NO " TO ERROR-TOTAL NC2214.2 +030300 ELSE NC2214.2 +030400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2214.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2214.2 +030600 PERFORM WRITE-LINE. NC2214.2 +030700 END-ROUTINE-13. NC2214.2 +030800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2214.2 +030900 MOVE "NO " TO ERROR-TOTAL ELSE NC2214.2 +031000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2214.2 +031100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2214.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031300 IF INSPECT-COUNTER EQUAL TO ZERO NC2214.2 +031400 MOVE "NO " TO ERROR-TOTAL NC2214.2 +031500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2214.2 +031600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2214.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031900 WRITE-LINE. NC2214.2 +032000 ADD 1 TO RECORD-COUNT. NC2214.2 +032100Y IF RECORD-COUNT GREATER 50 NC2214.2 +032200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2214.2 +032300Y MOVE SPACE TO DUMMY-RECORD NC2214.2 +032400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2214.2 +032500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2214.2 +032600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2214.2 +032700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2214.2 +032800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2214.2 +032900Y MOVE ZERO TO RECORD-COUNT. NC2214.2 +033000 PERFORM WRT-LN. NC2214.2 +033100 WRT-LN. NC2214.2 +033200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2214.2 +033300 MOVE SPACE TO DUMMY-RECORD. NC2214.2 +033400 BLANK-LINE-PRINT. NC2214.2 +033500 PERFORM WRT-LN. NC2214.2 +033600 FAIL-ROUTINE. NC2214.2 +033700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2214.2 +033800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2214.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2214.2 +034000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2214.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2214.2 +034300 GO TO FAIL-ROUTINE-EX. NC2214.2 +034400 FAIL-ROUTINE-WRITE. NC2214.2 +034500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2214.2 +034600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2214.2 +034700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2214.2 +034800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2214.2 +034900 FAIL-ROUTINE-EX. EXIT. NC2214.2 +035000 BAIL-OUT. NC2214.2 +035100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2214.2 +035200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2214.2 +035300 BAIL-OUT-WRITE. NC2214.2 +035400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2214.2 +035500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2214.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +035700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2214.2 +035800 BAIL-OUT-EX. EXIT. NC2214.2 +035900 CCVS1-EXIT. NC2214.2 +036000 EXIT. NC2214.2 +036100 INIT-TABLE1. NC2214.2 +036200 MOVE NC2214.2 +036300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +036400- "IDS CAN NOT BE ALL BAD." NC2214.2 +036500 TO WC-XN-83. NC2214.2 +036600 MOVE WC-XN-83 TO TABLE1-REC (1). NC2214.2 +036700 MOVE WC-XN-83 TO TABLE1-REC (2). NC2214.2 +036800 MOVE WC-XN-83 TO TABLE1-REC (3). NC2214.2 +036900 MOVE WC-XN-83 TO TABLE1-REC (4). NC2214.2 +037000 INIT-TABLE3. NC2214.2 +037100 MOVE " " TO TABLE3-SYMBOL (1). NC2214.2 +037200 MOVE "," TO TABLE3-SYMBOL (2). NC2214.2 +037300 MOVE "-" TO TABLE3-SYMBOL (3). NC2214.2 +037400 INIT-TABLE4. NC2214.2 +037500 MOVE "AH" TO TABLE4-LETTER (1). NC2214.2 +037600 MOVE "OH" TO TABLE4-LETTER (2). NC2214.2 +037700 MOVE "HE" TO TABLE4-LETTER (3). NC2214.2 +037800 MOVE "LL" TO TABLE4-LETTER (4). NC2214.2 +037900 MOVE "H " TO TABLE4-LETTER (5). NC2214.2 +038000* NC2214.2 +038100 INS-INIT-F1-1. NC2214.2 +038200 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2214.2 +038300 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +038400 MOVE "TALLY FOR LEADING" TO FEATURE. NC2214.2 +038500 MOVE ZEROS TO TABLE2. NC2214.2 +038600 SET INDEX1 TO 1. NC2214.2 +038700 SET INDEX2 TO 1. NC2214.2 +038800 INS-TEST-F1-1. NC2214.2 +038900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +039000 FOR LEADING "AH" NC2214.2 +039100 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC2214.2 +039200 PERFORM PASS NC2214.2 +039300 GO TO INS-WRITE-F1-1. NC2214.2 +039400 GO TO INS-FAIL-F1-1. NC2214.2 +039500 INS-DELETE-F1-1. NC2214.2 +039600 PERFORM DE-LETE. NC2214.2 +039700 GO TO INS-WRITE-F1-1. NC2214.2 +039800 INS-FAIL-F1-1. NC2214.2 +039900 PERFORM FAIL. NC2214.2 +040000 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC2214.2 +040100 MOVE 1 TO CORRECT-N. NC2214.2 +040200 INS-WRITE-F1-1. NC2214.2 +040300 PERFORM PRINT-DETAIL. NC2214.2 +040400* NC2214.2 +040500 INS-INIT-F1-2. NC2214.2 +040600 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2214.2 +040700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +040800 MOVE "TALLY FOR CHAR AFTER" TO FEATURE. NC2214.2 +040900 MOVE ZEROS TO TABLE2. NC2214.2 +041000 SET INDEX1 TO 2. NC2214.2 +041100 SET INDEX2 TO 2. NC2214.2 +041200 INS-TEST-F1-2. NC2214.2 +041300 INSPECT TABLE1-REC (INDEX1 + 1) NC2214.2 +041400 TALLYING WRK-DU-999 (INDEX2 + 1) NC2214.2 +041500 FOR CHARACTERS AFTER " W". NC2214.2 +041600 IF WRK-DU-999 (INDEX2 + 1) EQUAL TO 68 NC2214.2 +041700 PERFORM PASS NC2214.2 +041800 GO TO INS-WRITE-F1-2. NC2214.2 +041900 GO TO INS-FAIL-F1-2. NC2214.2 +042000 INS-DELETE-F1-2. NC2214.2 +042100 PERFORM DE-LETE. NC2214.2 +042200 GO TO INS-WRITE-F1-2. NC2214.2 +042300 INS-FAIL-F1-2. NC2214.2 +042400 PERFORM FAIL. NC2214.2 +042500 MOVE WRK-DU-999 (INDEX2 + 1) TO COMPUTED-N. NC2214.2 +042600 MOVE 68 TO CORRECT-N. NC2214.2 +042700 INS-WRITE-F1-2. NC2214.2 +042800 PERFORM PRINT-DETAIL. NC2214.2 +042900* NC2214.2 +043000 INS-INIT-F1-3. NC2214.2 +043100 MOVE "INS-TEST-F1-3" TO PAR-NAME. NC2214.2 +043200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +043300 MOVE "TALLY FOR ALL BEFORE" TO FEATURE. NC2214.2 +043400 MOVE ZEROS TO TABLE2. NC2214.2 +043500 SET INDEX1 TO 3. NC2214.2 +043600 SET INDEX2 TO 3. NC2214.2 +043700 INS-TEST-F1-3. NC2214.2 +043800 INSPECT TABLE1-REC (INDEX1 - 1) NC2214.2 +043900 TALLYING WRK-DU-999 (INDEX2 - 2) NC2214.2 +044000 FOR ALL " " BEFORE INITIAL "W.C.". NC2214.2 +044100 IF WRK-DU-999 (INDEX2 - 2) EQUAL TO 4 NC2214.2 +044200 PERFORM PASS NC2214.2 +044300 GO TO INS-WRITE-F1-3. NC2214.2 +044400 GO TO INS-FAIL-F1-3. NC2214.2 +044500 INS-DELETE-F1-3. NC2214.2 +044600 PERFORM DE-LETE. NC2214.2 +044700 GO TO INS-WRITE-F1-3. NC2214.2 +044800 INS-FAIL-F1-3. NC2214.2 +044900 PERFORM FAIL. NC2214.2 +045000 MOVE WRK-DU-999 (INDEX2 - 2) TO COMPUTED-N. NC2214.2 +045100 MOVE 4 TO CORRECT-N. NC2214.2 +045200 INS-WRITE-F1-3. NC2214.2 +045300 PERFORM PRINT-DETAIL. NC2214.2 +045400* NC2214.2 +045500 INS-INIT-F2-4. NC2214.2 +045600 MOVE "INS-TEST-F2-4" TO PAR-NAME. NC2214.2 +045700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +045800 MOVE "REPLACE BEFORE FIRST" TO FEATURE. NC2214.2 +045900 SET INDEX1 TO 4. NC2214.2 +046000 SET INDEX4 TO 1. NC2214.2 +046100 INS-TEST-F2-4. NC2214.2 +046200 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC2214.2 +046300 TABLE4-LETTER (INDEX4) BY TABLE4-LETTER (INDEX4 + 1) NC2214.2 +046400 BEFORE INITIAL " AH YES" FIRST "I" BY "O" NC2214.2 +046500 AFTER INITIAL "." ALL ". " BY ", " AFTER INITIAL NC2214.2 +046600 TABLE4-LETTER (INDEX4 + 2). NC2214.2 +046700 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC2214.2 +046800 PERFORM PASS NC2214.2 +046900 GO TO INS-WRITE-F2-4. NC2214.2 +047000 GO TO INS-FAIL-F2-4. NC2214.2 +047100 INS-DELETE-F2-4. NC2214.2 +047200 PERFORM DE-LETE. NC2214.2 +047300 GO TO INS-WRITE-F2-4. NC2214.2 +047400 INS-FAIL-F2-4. NC2214.2 +047500 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83. NC2214.2 +047600 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83. NC2214.2 +047700 PERFORM FAIL. NC2214.2 +047800 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +047900 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +048000 PERFORM PRINT-DETAIL. NC2214.2 +048100 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +048200 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +048300 PERFORM PRINT-DETAIL. NC2214.2 +048400 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +048500 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +048600 PERFORM PRINT-DETAIL. NC2214.2 +048700 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +048800 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +048900 PERFORM PRINT-DETAIL. NC2214.2 +049000 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +049100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +049200 PERFORM PRINT-DETAIL. NC2214.2 +049300 INS-WRITE-F2-4. NC2214.2 +049400 PERFORM PRINT-DETAIL. NC2214.2 +049500* NC2214.2 +049600 INS-INIT-F2-5. NC2214.2 +049700 MOVE "INS-TEST-F2-5" TO PAR-NAME. NC2214.2 +049800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +049900 MOVE "REPLACE LEAD AFTER" TO FEATURE NC2214.2 +050000 PERFORM INIT-TABLE1. NC2214.2 +050100 MOVE NC2214.2 +050200 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +050300- "IDS CAN NOT BE ALL BAD." NC2214.2 +050400 TO ANS-XN-83-2. NC2214.2 +050500 SET INDEX1 TO 1. NC2214.2 +050600 SET INDEX3 TO 1. NC2214.2 +050700 INS-TEST-F2-5. NC2214.2 +050800 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC2214.2 +050900 TABLE3-SYMBOL (INDEX3) BY TABLE3-SYMBOL (INDEX3 + 1) NC2214.2 +051000 AFTER INITIAL "YES". NC2214.2 +051100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-2 NC2214.2 +051200 PERFORM PASS NC2214.2 +051300 GO TO INS-WRITE-F2-5. NC2214.2 +051400 GO TO INS-FAIL-F2-5. NC2214.2 +051500 INS-DELETE-F2-5. NC2214.2 +051600 PERFORM DE-LETE. NC2214.2 +051700 GO TO INS-WRITE-F2-5. NC2214.2 +051800 INS-FAIL-F2-5. NC2214.2 +051900 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83. NC2214.2 +052000 MOVE ANS-XN-83-2 TO WS-RIGHT-1-83. NC2214.2 +052100 PERFORM FAIL. NC2214.2 +052200 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +052300 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +052400 PERFORM PRINT-DETAIL. NC2214.2 +052500 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +052600 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +052700 PERFORM PRINT-DETAIL. NC2214.2 +052800 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +052900 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +053000 PERFORM PRINT-DETAIL. NC2214.2 +053100 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +053200 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +053300 PERFORM PRINT-DETAIL. NC2214.2 +053400 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +053500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +053600 PERFORM PRINT-DETAIL. NC2214.2 +053700 INS-WRITE-F2-5. NC2214.2 +053800 PERFORM PRINT-DETAIL. NC2214.2 +053900* NC2214.2 +054000 INS-INIT-F2-6. NC2214.2 +054100 MOVE "INS-TEST-F2-6" TO PAR-NAME. NC2214.2 +054200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +054300 MOVE "REPLACE FIRST BEFORE" TO FEATURE. NC2214.2 +054400 PERFORM INIT-TABLE1. NC2214.2 +054500 SET INDEX1 TO 3. NC2214.2 +054600 MOVE NC2214.2 +054700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +054800- "IDS CAN NOT BE ALL BAD." NC2214.2 +054900 TO ANS-XN-83-3. NC2214.2 +055000 INS-TEST-F2-6. NC2214.2 +055100 INSPECT TABLE1-REC (INDEX1 - 1) REPLACING FIRST "A" BY "O" NC2214.2 +055200 BEFORE INITIAL "H YES". NC2214.2 +055300 IF TABLE1-REC (INDEX1 - 1) EQUAL TO ANS-XN-83-3 NC2214.2 +055400 PERFORM PASS NC2214.2 +055500 GO TO INS-WRITE-F2-6. NC2214.2 +055600 GO TO INS-FAIL-F2-6. NC2214.2 +055700 INS-DELETE-F2-6. NC2214.2 +055800 PERFORM DE-LETE. NC2214.2 +055900 GO TO INS-WRITE-F2-6. NC2214.2 +056000 INS-FAIL-F2-6. NC2214.2 +056100 MOVE TABLE1-REC (INDEX1 - 1) TO WS-WRONG-1-83. NC2214.2 +056200 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83. NC2214.2 +056300 PERFORM FAIL. NC2214.2 +056400 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +056500 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +056600 PERFORM PRINT-DETAIL. NC2214.2 +056700 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +056800 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +056900 PERFORM PRINT-DETAIL. NC2214.2 +057000 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +057100 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +057200 PERFORM PRINT-DETAIL. NC2214.2 +057300 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +057400 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +057500 PERFORM PRINT-DETAIL. NC2214.2 +057600 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +057700 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +057800 PERFORM PRINT-DETAIL. NC2214.2 +057900 INS-WRITE-F2-6. NC2214.2 +058000 PERFORM PRINT-DETAIL. NC2214.2 +058100* NC2214.2 +058200 INS-INIT-F2-7. NC2214.2 +058300 MOVE "INS-TEST-F2-7" TO PAR-NAME. NC2214.2 +058400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +058500 MOVE "REPLACE ALL AFTER" TO FEATURE. NC2214.2 +058600 PERFORM INIT-TABLE1. NC2214.2 +058700 PERFORM INIT-TABLE4. NC2214.2 +058800 MOVE NC2214.2 +058900 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +059000- "IDS CAN NOT BE ALL-BAD." NC2214.2 +059100 TO ANS-XN-83-4. NC2214.2 +059200 SET INDEX1 TO 1. NC2214.2 +059300 SET INDEX4 TO 4. NC2214.2 +059400 INS-TEST-F2-7. NC2214.2 +059500 INSPECT TABLE1-REC (INDEX1 + 1) REPLACING ALL SPACES BY "-" NC2214.2 +059600 AFTER TABLE4-LETTER (INDEX4). NC2214.2 +059700 IF TABLE1-REC (INDEX1 + 1) EQUAL TO ANS-XN-83-4 NC2214.2 +059800 PERFORM PASS NC2214.2 +059900 GO TO INS-WRITE-F2-7. NC2214.2 +060000 GO TO INS-FAIL-F2-7. NC2214.2 +060100 INS-DELETE-F2-7. NC2214.2 +060200 PERFORM DE-LETE. NC2214.2 +060300 GO TO INS-WRITE-F2-7. NC2214.2 +060400 INS-FAIL-F2-7. NC2214.2 +060500 MOVE TABLE1-REC (INDEX1 + 1) TO WS-WRONG-1-83. NC2214.2 +060600 MOVE ANS-XN-83-4 TO WS-RIGHT-1-83. NC2214.2 +060700 PERFORM FAIL. NC2214.2 +060800 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +060900 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +061000 PERFORM PRINT-DETAIL. NC2214.2 +061100 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +061200 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +061300 PERFORM PRINT-DETAIL. NC2214.2 +061400 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +061500 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +061600 PERFORM PRINT-DETAIL. NC2214.2 +061700 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +061800 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +061900 PERFORM PRINT-DETAIL. NC2214.2 +062000 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +062100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +062200 PERFORM PRINT-DETAIL. NC2214.2 +062300 INS-WRITE-F2-7. NC2214.2 +062400 PERFORM PRINT-DETAIL. NC2214.2 +062500* NC2214.2 +062600 INS-INIT-F3-8. NC2214.2 +062700 MOVE "INS-TEST-F3-8" TO PAR-NAME. NC2214.2 +062800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +062900 MOVE "TALLY REPLACE CHARS" TO FEATURE. NC2214.2 +063000 MOVE 1 TO REC-CT. NC2214.2 +063100 PERFORM INIT-TABLE1. NC2214.2 +063200 PERFORM INIT-TABLE4. NC2214.2 +063300 MOVE ZEROS TO TABLE2. NC2214.2 +063400 SET INDEX1 TO 4. NC2214.2 +063500 SET INDEX2 TO 1. NC2214.2 +063600 SET INDEX4 TO 5. NC2214.2 +063700 INS-TEST-F3-8-0. NC2214.2 +063800 INSPECT TABLE1-REC (INDEX1 - 2) NC2214.2 +063900 TALLYING WRK-DU-999 (INDEX2 + 2) FOR CHARACTERS NC2214.2 +064000 AFTER "L" REPLACING ALL "A" BY "E" NC2214.2 +064100 BEFORE INITIAL TABLE4-LETTER (INDEX4). NC2214.2 +064200 GO TO INS-TEST-F3-8-1. NC2214.2 +064300 INS-DELETE-F3-8. NC2214.2 +064400 PERFORM DE-LETE. NC2214.2 +064500 PERFORM PRINT-DETAIL. NC2214.2 +064600 GO TO INS-INIT-F3-9. NC2214.2 +064700 INS-TEST-F3-8-1. NC2214.2 +064800 IF WRK-DU-999 (INDEX2 + 2) EQUAL TO 6 NC2214.2 +064900 PERFORM PASS NC2214.2 +065000 GO TO INS-WRITE-F3-8-1 NC2214.2 +065100 ELSE GO TO INS-FAIL-F3-8-1. NC2214.2 +065200 INS-DELETE-F3-8-1. NC2214.2 +065300 PERFORM DE-LETE. NC2214.2 +065400 GO TO INS-WRITE-F3-8-1. NC2214.2 +065500 INS-FAIL-F3-8-1. NC2214.2 +065600 MOVE WRK-DU-999 (INDEX2 + 2) TO COMPUTED-N NC2214.2 +065700 MOVE 6 TO CORRECT-N . NC2214.2 +065800 PERFORM FAIL. NC2214.2 +065900 INS-WRITE-F3-8-1. NC2214.2 +066000 PERFORM PRINT-DETAIL. NC2214.2 +066100* NC2214.2 +066200 INS-TEST-F3-8-2. NC2214.2 +066300 ADD 1 TO REC-CT. NC2214.2 +066400 IF TABLE1-REC (INDEX1 - 2) EQUAL TO ANS-XN-83-5 NC2214.2 +066500 PERFORM PASS NC2214.2 +066600 GO TO INS-WRITE-F3-8-2 NC2214.2 +066700 ELSE NC2214.2 +066800 GO TO INS-FAIL-F3-8-2. NC2214.2 +066900 INS-DELETE-F3-8-2. NC2214.2 +067000 PERFORM DE-LETE. NC2214.2 +067100 GO TO INS-WRITE-F3-8-2. NC2214.2 +067200 INS-FAIL-F3-8-2. NC2214.2 +067300 MOVE TABLE1-REC (INDEX1 - 2) TO WS-WRONG-1-83 NC2214.2 +067400 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2214.2 +067500 PERFORM FAIL NC2214.2 +067600 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +067700 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +067800 PERFORM PRINT-DETAIL NC2214.2 +067900 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +068000 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +068100 PERFORM PRINT-DETAIL NC2214.2 +068200 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +068300 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +068400 PERFORM PRINT-DETAIL NC2214.2 +068500 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +068600 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +068700 PERFORM PRINT-DETAIL NC2214.2 +068800 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +068900 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +069000 INS-WRITE-F3-8-2. NC2214.2 +069100 PERFORM PRINT-DETAIL. NC2214.2 +069200* NC2214.2 +069300 INS-INIT-F3-9. NC2214.2 +069400 MOVE "INS-TEST-F3-9" TO PAR-NAME. NC2214.2 +069500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +069600 MOVE "TALLY BEFORE REPLACE" TO FEATURE. NC2214.2 +069700 MOVE 1 TO REC-CT. NC2214.2 +069800 PERFORM INIT-TABLE1. NC2214.2 +069900 MOVE ZEROS TO TABLE2. NC2214.2 +070000 PERFORM INIT-TABLE4. NC2214.2 +070100 SET INDEX1 TO 4. NC2214.2 +070200 SET INDEX2 TO 2. NC2214.2 +070300 SET INDEX4 TO 1. NC2214.2 +070400 INS-TEST-F3-9-0. NC2214.2 +070500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +070600 FOR ALL "A" BEFORE "L" REPLACING FIRST NC2214.2 +070700 TABLE4-LETTER (INDEX4) BY TABLE4-LETTER (INDEX4 + 1) NC2214.2 +070800 AFTER INITIAL "H". NC2214.2 +070900 GO TO INS-TEST-F3-9-1. NC2214.2 +071000 INS-DELETE-F3-9. NC2214.2 +071100 PERFORM DE-LETE. NC2214.2 +071200 PERFORM PRINT-DETAIL. NC2214.2 +071300 GO TO INS-INIT-F3-10. NC2214.2 +071400 INS-TEST-F3-9-1. NC2214.2 +071500 IF WRK-DU-999 (INDEX2) EQUAL TO 7 NC2214.2 +071600 PERFORM PASS NC2214.2 +071700 GO TO INS-WRITE-F3-9-1 NC2214.2 +071800 ELSE GO TO INS-FAIL-F3-9-1. NC2214.2 +071900 INS-DELETE-F3-9-1. NC2214.2 +072000 PERFORM DE-LETE. NC2214.2 +072100 GO TO INS-WRITE-F3-9-1. NC2214.2 +072200 INS-FAIL-F3-9-1. NC2214.2 +072300 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +072400 MOVE 7 TO CORRECT-N NC2214.2 +072500 PERFORM FAIL. NC2214.2 +072600 INS-WRITE-F3-9-1. NC2214.2 +072700 PERFORM PRINT-DETAIL. NC2214.2 +072800* NC2214.2 +072900 INS-TEST-F3-9-2. NC2214.2 +073000 ADD 1 TO REC-CT. NC2214.2 +073100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-6 NC2214.2 +073200 PERFORM PASS NC2214.2 +073300 GO TO INS-WRITE-F3-9-2 NC2214.2 +073400 ELSE NC2214.2 +073500 GO TO INS-FAIL-F3-9-2. NC2214.2 +073600 INS-DELETE-F3-9-2. NC2214.2 +073700 PERFORM DE-LETE. NC2214.2 +073800 GO TO INS-WRITE-F3-9-2. NC2214.2 +073900 INS-FAIL-F3-9-2. NC2214.2 +074000 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +074100 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2214.2 +074200 PERFORM FAIL NC2214.2 +074300 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +074400 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +074500 PERFORM PRINT-DETAIL NC2214.2 +074600 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +074700 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +074800 PERFORM PRINT-DETAIL NC2214.2 +074900 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +075000 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +075100 PERFORM PRINT-DETAIL NC2214.2 +075200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +075300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +075400 PERFORM PRINT-DETAIL NC2214.2 +075500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +075600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +075700 INS-WRITE-F3-9-2. NC2214.2 +075800 PERFORM PRINT-DETAIL. NC2214.2 +075900* NC2214.2 +076000 INS-INIT-F3-10. NC2214.2 +076100 MOVE "INS-TEST-F3-10" TO PAR-NAME. NC2214.2 +076200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +076300 MOVE "TALLY LEAD REPL LEAD" TO FEATURE. NC2214.2 +076400 MOVE 1 TO REC-CT. NC2214.2 +076500 PERFORM INIT-TABLE1. NC2214.2 +076600 MOVE ZEROS TO TABLE2. NC2214.2 +076700 PERFORM INIT-TABLE4. NC2214.2 +076800 SET INDEX1 TO 1. NC2214.2 +076900 SET INDEX2 TO 1. NC2214.2 +077000 SET INDEX4 TO 1. NC2214.2 +077100 INS-TEST-F3-10-0. NC2214.2 +077200 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +077300 FOR LEADING TABLE4-LETTER (INDEX4) REPLACING NC2214.2 +077400 LEADING TABLE4-LETTER (INDEX4) BY "OH". NC2214.2 +077500 GO TO INS-TEST-F3-10-1. NC2214.2 +077600 INS-DELETE-F3-10. NC2214.2 +077700 PERFORM DE-LETE. NC2214.2 +077800 PERFORM PRINT-DETAIL. NC2214.2 +077900 GO TO INS-INIT-F3-11. NC2214.2 +078000 INS-TEST-F3-10-1. NC2214.2 +078100 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC2214.2 +078200 PERFORM PASS NC2214.2 +078300 GO TO INS-WRITE-F3-10-1 NC2214.2 +078400 ELSE NC2214.2 +078500 GO TO INS-FAIL-F3-10-1. NC2214.2 +078600 INS-DELETE-F3-10-1. NC2214.2 +078700 PERFORM DE-LETE. NC2214.2 +078800 GO TO INS-WRITE-F3-10-1. NC2214.2 +078900 INS-FAIL-F3-10-1. NC2214.2 +079000 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +079100 MOVE 1 TO CORRECT-N NC2214.2 +079200 PERFORM FAIL. NC2214.2 +079300 INS-WRITE-F3-10-1. NC2214.2 +079400 PERFORM PRINT-DETAIL. NC2214.2 +079500* NC2214.2 +079600 INS-TEST-F3-10-2. NC2214.2 +079700 ADD 1 TO REC-CT. NC2214.2 +079800 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-3 NC2214.2 +079900 PERFORM PASS NC2214.2 +080000 GO TO INS-WRITE-F3-10-2 NC2214.2 +080100 ELSE NC2214.2 +080200 GO TO INS-FAIL-F3-10-2. NC2214.2 +080300 INS-DELETE-F3-10-2. NC2214.2 +080400 PERFORM DE-LETE. NC2214.2 +080500 GO TO INS-WRITE-F3-10-2. NC2214.2 +080600 INS-FAIL-F3-10-2. NC2214.2 +080700 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +080800 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2214.2 +080900 PERFORM FAIL NC2214.2 +081000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +081100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +081200 PERFORM PRINT-DETAIL NC2214.2 +081300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +081400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +081500 PERFORM PRINT-DETAIL NC2214.2 +081600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +081700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +081800 PERFORM PRINT-DETAIL NC2214.2 +081900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +082000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +082100 PERFORM PRINT-DETAIL NC2214.2 +082200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +082300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +082400 INS-WRITE-F3-10-2. NC2214.2 +082500 PERFORM PRINT-DETAIL. NC2214.2 +082600* NC2214.2 +082700 INS-INIT-F3-11. NC2214.2 +082800 MOVE "INS-TEST-F3-11" TO PAR-NAME. NC2214.2 +082900 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +083000 MOVE "TALLY REPL FIRST AFT" TO FEATURE. NC2214.2 +083100 MOVE 1 TO REC-CT. NC2214.2 +083200 PERFORM INIT-TABLE1. NC2214.2 +083300 MOVE ZEROS TO TABLE2. NC2214.2 +083400 SET INDEX1 TO 2. NC2214.2 +083500 SET INDEX2 TO 2. NC2214.2 +083600 INS-TEST-F3-11-0. NC2214.2 +083700 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +083800 FOR ALL "A" REPLACING FIRST "AH" BY "OH" AFTER NC2214.2 +083900 INITIAL "YES". NC2214.2 +084000 GO TO INS-TEST-F3-11-1. NC2214.2 +084100 INS-DELETE-F3-11. NC2214.2 +084200 PERFORM DE-LETE. NC2214.2 +084300 PERFORM PRINT-DETAIL. NC2214.2 +084400 GO TO INS-INIT-F3-12. NC2214.2 +084500 INS-TEST-F3-11-1. NC2214.2 +084600 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC2214.2 +084700 PERFORM PASS NC2214.2 +084800 GO TO INS-WRITE-F3-11-1 NC2214.2 +084900 ELSE NC2214.2 +085000 GO TO INS-FAIL-F3-11-1. NC2214.2 +085100 INS-DELETE-F3-11-1. NC2214.2 +085200 PERFORM DE-LETE. NC2214.2 +085300 GO TO INS-WRITE-F3-11-1. NC2214.2 +085400 INS-FAIL-F3-11-1. NC2214.2 +085500 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +085600 MOVE 8 TO CORRECT-N NC2214.2 +085700 PERFORM FAIL. NC2214.2 +085800 INS-WRITE-F3-11-1. NC2214.2 +085900 PERFORM PRINT-DETAIL. NC2214.2 +086000* NC2214.2 +086100 INS-TEST-F3-11-2. NC2214.2 +086200 ADD 1 TO REC-CT. NC2214.2 +086300 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-6 NC2214.2 +086400 PERFORM PASS NC2214.2 +086500 GO TO INS-WRITE-F3-11-2 NC2214.2 +086600 ELSE NC2214.2 +086700 GO TO INS-FAIL-F3-11-2. NC2214.2 +086800 INS-DELETE-F3-11-2. NC2214.2 +086900 PERFORM DE-LETE. NC2214.2 +087000 GO TO INS-WRITE-F3-11-2. NC2214.2 +087100 INS-FAIL-F3-11-2. NC2214.2 +087200 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +087300 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2214.2 +087400 PERFORM FAIL NC2214.2 +087500 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +087600 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +087700 PERFORM PRINT-DETAIL NC2214.2 +087800 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +087900 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +088000 PERFORM PRINT-DETAIL NC2214.2 +088100 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +088200 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +088300 PERFORM PRINT-DETAIL NC2214.2 +088400 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +088500 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +088600 PERFORM PRINT-DETAIL NC2214.2 +088700 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +088800 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +088900 INS-WRITE-F3-11-2. NC2214.2 +089000 PERFORM PRINT-DETAIL. NC2214.2 +089100* NC2214.2 +089200 INS-INIT-F3-12. NC2214.2 +089300 MOVE "INS-TEST-F3-12" TO PAR-NAME. NC2214.2 +089400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +089500 MOVE "TALLY CHARS REPL BEF" TO FEATURE. NC2214.2 +089600 MOVE 1 TO REC-CT. NC2214.2 +089700 PERFORM INIT-TABLE1. NC2214.2 +089800 MOVE ZEROS TO TABLE2. NC2214.2 +089900 PERFORM INIT-TABLE4. NC2214.2 +090000 SET INDEX1 TO 3. NC2214.2 +090100 SET INDEX2 TO 3. NC2214.2 +090200 SET INDEX4 TO 1. NC2214.2 +090300 INS-TEST-F3-12-0. NC2214.2 +090400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +090500 FOR CHARACTERS AFTER TABLE4-LETTER (INDEX4) NC2214.2 +090600 REPLACING ALL "AH" BY "OH" NC2214.2 +090700 BEFORE "YES". NC2214.2 +090800 GO TO INS-TEST-F3-12-1. NC2214.2 +090900 INS-DELETE-F3-12. NC2214.2 +091000 PERFORM DE-LETE. NC2214.2 +091100 PERFORM PRINT-DETAIL. NC2214.2 +091200 GO TO CCVS-999999. NC2214.2 +091300 INS-TEST-F3-12-1. NC2214.2 +091400 IF WRK-DU-999 (INDEX2) EQUAL TO 81 NC2214.2 +091500 PERFORM PASS NC2214.2 +091600 GO TO INS-WRITE-F3-12-1 NC2214.2 +091700 ELSE NC2214.2 +091800 GO TO INS-FAIL-F3-12-1. NC2214.2 +091900 INS-DELETE-F3-12-1. NC2214.2 +092000 PERFORM DE-LETE. NC2214.2 +092100 GO TO INS-WRITE-F3-12-1. NC2214.2 +092200 INS-FAIL-F3-12-1. NC2214.2 +092300 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +092400 MOVE 81 TO CORRECT-N NC2214.2 +092500 PERFORM FAIL. NC2214.2 +092600 INS-WRITE-F3-12-1. NC2214.2 +092700 PERFORM PRINT-DETAIL. NC2214.2 +092800* NC2214.2 +092900 INS-TEST-F3-12-2. NC2214.2 +093000 ADD 1 TO REC-CT. NC2214.2 +093100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-3 NC2214.2 +093200 PERFORM PASS NC2214.2 +093300 GO TO INS-WRITE-F3-12-2 NC2214.2 +093400 ELSE NC2214.2 +093500 GO TO INS-FAIL-F3-12-2. NC2214.2 +093600 INS-DELETE-F3-12-2. NC2214.2 +093700 PERFORM DE-LETE. NC2214.2 +093800 GO TO INS-WRITE-F3-12-2. NC2214.2 +093900 INS-FAIL-F3-12-2. NC2214.2 +094000 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +094100 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2214.2 +094200 PERFORM FAIL NC2214.2 +094300 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +094400 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +094500 PERFORM PRINT-DETAIL NC2214.2 +094600 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +094700 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +094800 PERFORM PRINT-DETAIL NC2214.2 +094900 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +095000 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +095100 PERFORM PRINT-DETAIL NC2214.2 +095200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +095300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +095400 PERFORM PRINT-DETAIL NC2214.2 +095500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +095600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +095700 INS-WRITE-F3-12-2. NC2214.2 +095800 PERFORM PRINT-DETAIL. NC2214.2 +095900 CCVS-EXIT SECTION. NC2214.2 +096000 CCVS-999999. NC2214.2 +096100 GO TO CLOSE-FILES. NC2214.2 +*END-OF,NC221A +*HEADER,COBOL,NC222A +000100 IDENTIFICATION DIVISION. NC2224.2 +000200 PROGRAM-ID. NC2224.2 +000300 NC222A. NC2224.2 +000400* * NC2224.2 +000500**************************************************************** NC2224.2 +000600* * NC2224.2 +000700* VALIDATION FOR:- * NC2224.2 +000800* * NC2224.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +001000* * NC2224.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2224.2 +001200* * NC2224.2 +001300**************************************************************** NC2224.2 +001400* * NC2224.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2224.2 +001600* * NC2224.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2224.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2224.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2224.2 +002000* * NC2224.2 +002100**************************************************************** NC2224.2 +002200* PROGRAM NC222A TESTS THE USE OF INDEXED IDENTIFIERS WITH * NC2224.2 +002300* FORMAT 2 OF THE "ADD", "SUBTRACT" AND "MOVE" STATEMENTS. * NC2224.2 +002400* DE-EDITING BY USE OF THE "MOVE" STATEMENT IS ALSO TESTED. * NC2224.2 +002500* * NC2224.2 +002600**************************************************************** NC2224.2 +002700 ENVIRONMENT DIVISION. NC2224.2 +002800 CONFIGURATION SECTION. NC2224.2 +002900 SOURCE-COMPUTER. NC2224.2 +003000 XXXXX082. NC2224.2 +003100 OBJECT-COMPUTER. NC2224.2 +003200 XXXXX083. NC2224.2 +003300 INPUT-OUTPUT SECTION. NC2224.2 +003400 FILE-CONTROL. NC2224.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2224.2 +003600 XXXXX055. NC2224.2 +003700 DATA DIVISION. NC2224.2 +003800 FILE SECTION. NC2224.2 +003900 FD PRINT-FILE. NC2224.2 +004000 01 PRINT-REC PICTURE X(120). NC2224.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2224.2 +004200 WORKING-STORAGE SECTION. NC2224.2 +004300 01 TABLE1. NC2224.2 +004400 02 RECORD1 PICTURE 99. NC2224.2 +004500 02 RECORD2 PICTURE 99 NC2224.2 +004600 OCCURS 2 TIMES NC2224.2 +004700 INDEXED BY INDEX1. NC2224.2 +004800 02 RECORD3 PICTURE 99. NC2224.2 +004900 01 TABLE2. NC2224.2 +005000 02 RECORD1 PICTURE 99. NC2224.2 +005100 02 RECORD2 PICTURE 99 NC2224.2 +005200 OCCURS 2 TIMES NC2224.2 +005300 INDEXED BY INDEX2. NC2224.2 +005400 02 RECORD3 PICTURE 99. NC2224.2 +005500 01 TABLE3. NC2224.2 +005600 02 RECORD1 PICTURE XX VALUE "AA". NC2224.2 +005700 02 RECORD2 PICTURE XX NC2224.2 +005800 OCCURS 2 TIMES NC2224.2 +005900 INDEXED BY INDEX3. NC2224.2 +006000 02 RECORD3 PICTURE XX VALUE "DD". NC2224.2 +006100 01 TABLE4. NC2224.2 +006200 02 RECORD1 PICTURE XX VALUE "EE". NC2224.2 +006300 02 RECORD2 PICTURE XX NC2224.2 +006400 OCCURS 2 TIMES NC2224.2 +006500 INDEXED BY INDEX4. NC2224.2 +006600 02 RECORD3 PICTURE XX VALUE "HH". NC2224.2 +006700 01 MOVE-TEST-3-A PIC $(4)9.99CR. NC2224.2 +006800 01 MOVE-TEST-3-B PIC S9(4)V99. NC2224.2 +006900 01 MOVE-TEST-4-A PIC --9B.99B99/99. NC2224.2 +007000 01 MOVE-TEST-4-B PIC S99V9(6). NC2224.2 +007100 01 TEST-RESULTS. NC2224.2 +007200 02 FILLER PIC X VALUE SPACE. NC2224.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC2224.2 +007400 02 FILLER PIC X VALUE SPACE. NC2224.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC2224.2 +007600 02 FILLER PIC X VALUE SPACE. NC2224.2 +007700 02 PAR-NAME. NC2224.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC2224.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC2224.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC2224.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC2224.2 +008200 02 RE-MARK PIC X(61). NC2224.2 +008300 01 TEST-COMPUTED. NC2224.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC2224.2 +008500 02 FILLER PIC X(17) VALUE NC2224.2 +008600 " COMPUTED=". NC2224.2 +008700 02 COMPUTED-X. NC2224.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2224.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC2224.2 +009000 PIC -9(9).9(9). NC2224.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2224.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2224.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2224.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC2224.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC2224.2 +009600 04 FILLER PIC X. NC2224.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC2224.2 +009800 01 TEST-CORRECT. NC2224.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC2224.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2224.2 +010100 02 CORRECT-X. NC2224.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2224.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2224.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2224.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2224.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2224.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC2224.2 +010800 04 CORRECT-18V0 PIC -9(18). NC2224.2 +010900 04 FILLER PIC X. NC2224.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC2224.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2224.2 +011200 01 CCVS-C-1. NC2224.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2224.2 +011400- "SS PARAGRAPH-NAME NC2224.2 +011500- " REMARKS". NC2224.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC2224.2 +011700 01 CCVS-C-2. NC2224.2 +011800 02 FILLER PIC X VALUE SPACE. NC2224.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC2224.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC2224.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC2224.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC2224.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2224.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC2224.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2224.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2224.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2224.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2224.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2224.2 +013400 01 CCVS-H-1. NC2224.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC2224.2 +013600 02 FILLER PIC X(42) VALUE NC2224.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2224.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2224.2 +013900 01 CCVS-H-2A. NC2224.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC2224.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2224.2 +014200 02 FILLER PIC XXXX VALUE NC2224.2 +014300 "4.2 ". NC2224.2 +014400 02 FILLER PIC X(28) VALUE NC2224.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC2224.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC2224.2 +014700 NC2224.2 +014800 01 CCVS-H-2B. NC2224.2 +014900 02 FILLER PIC X(15) VALUE NC2224.2 +015000 "TEST RESULT OF ". NC2224.2 +015100 02 TEST-ID PIC X(9). NC2224.2 +015200 02 FILLER PIC X(4) VALUE NC2224.2 +015300 " IN ". NC2224.2 +015400 02 FILLER PIC X(12) VALUE NC2224.2 +015500 " HIGH ". NC2224.2 +015600 02 FILLER PIC X(22) VALUE NC2224.2 +015700 " LEVEL VALIDATION FOR ". NC2224.2 +015800 02 FILLER PIC X(58) VALUE NC2224.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +016000 01 CCVS-H-3. NC2224.2 +016100 02 FILLER PIC X(34) VALUE NC2224.2 +016200 " FOR OFFICIAL USE ONLY ". NC2224.2 +016300 02 FILLER PIC X(58) VALUE NC2224.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2224.2 +016500 02 FILLER PIC X(28) VALUE NC2224.2 +016600 " COPYRIGHT 1985 ". NC2224.2 +016700 01 CCVS-E-1. NC2224.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC2224.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2224.2 +017000 02 ID-AGAIN PIC X(9). NC2224.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC2224.2 +017200 01 CCVS-E-2. NC2224.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC2224.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC2224.2 +017500 02 CCVS-E-2-2. NC2224.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2224.2 +017700 03 FILLER PIC X VALUE SPACE. NC2224.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC2224.2 +017900 "ERRORS ENCOUNTERED". NC2224.2 +018000 01 CCVS-E-3. NC2224.2 +018100 02 FILLER PIC X(22) VALUE NC2224.2 +018200 " FOR OFFICIAL USE ONLY". NC2224.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC2224.2 +018400 02 FILLER PIC X(58) VALUE NC2224.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC2224.2 +018700 02 FILLER PIC X(15) VALUE NC2224.2 +018800 " COPYRIGHT 1985". NC2224.2 +018900 01 CCVS-E-4. NC2224.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2224.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC2224.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2224.2 +019300 02 FILLER PIC X(40) VALUE NC2224.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2224.2 +019500 01 XXINFO. NC2224.2 +019600 02 FILLER PIC X(19) VALUE NC2224.2 +019700 "*** INFORMATION ***". NC2224.2 +019800 02 INFO-TEXT. NC2224.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC2224.2 +020000 04 XXCOMPUTED PIC X(20). NC2224.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC2224.2 +020200 04 XXCORRECT PIC X(20). NC2224.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC2224.2 +020400 01 HYPHEN-LINE. NC2224.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC2224.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC2224.2 +020700- "*****************************************". NC2224.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC2224.2 +020900- "******************************". NC2224.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC2224.2 +021100 "NC222A". NC2224.2 +021200 PROCEDURE DIVISION. NC2224.2 +021300 CCVS1 SECTION. NC2224.2 +021400 OPEN-FILES. NC2224.2 +021500 OPEN OUTPUT PRINT-FILE. NC2224.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2224.2 +021700 MOVE SPACE TO TEST-RESULTS. NC2224.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2224.2 +021900 GO TO CCVS1-EXIT. NC2224.2 +022000 CLOSE-FILES. NC2224.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2224.2 +022200 TERMINATE-CCVS. NC2224.2 +022300S EXIT PROGRAM. NC2224.2 +022400STERMINATE-CALL. NC2224.2 +022500 STOP RUN. NC2224.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2224.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2224.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2224.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2224.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC2224.2 +023100 PRINT-DETAIL. NC2224.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC2224.2 +023300 MOVE "." TO PARDOT-X NC2224.2 +023400 MOVE REC-CT TO DOTVALUE. NC2224.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2224.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2224.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2224.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2224.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2224.2 +024000 MOVE SPACE TO CORRECT-X. NC2224.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2224.2 +024200 MOVE SPACE TO RE-MARK. NC2224.2 +024300 HEAD-ROUTINE. NC2224.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2224.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2224.2 +024800 COLUMN-NAMES-ROUTINE. NC2224.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +025200 END-ROUTINE. NC2224.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2224.2 +025400 END-RTN-EXIT. NC2224.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +025600 END-ROUTINE-1. NC2224.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2224.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2224.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC2224.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2224.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2224.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2224.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2224.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2224.2 +026500 END-ROUTINE-12. NC2224.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2224.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2224.2 +026800 MOVE "NO " TO ERROR-TOTAL NC2224.2 +026900 ELSE NC2224.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2224.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2224.2 +027200 PERFORM WRITE-LINE. NC2224.2 +027300 END-ROUTINE-13. NC2224.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2224.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC2224.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2224.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2224.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC2224.2 +028000 MOVE "NO " TO ERROR-TOTAL NC2224.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2224.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2224.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +028500 WRITE-LINE. NC2224.2 +028600 ADD 1 TO RECORD-COUNT. NC2224.2 +028700Y IF RECORD-COUNT GREATER 50 NC2224.2 +028800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2224.2 +028900Y MOVE SPACE TO DUMMY-RECORD NC2224.2 +029000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2224.2 +029100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2224.2 +029200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2224.2 +029300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2224.2 +029400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2224.2 +029500Y MOVE ZERO TO RECORD-COUNT. NC2224.2 +029600 PERFORM WRT-LN. NC2224.2 +029700 WRT-LN. NC2224.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2224.2 +029900 MOVE SPACE TO DUMMY-RECORD. NC2224.2 +030000 BLANK-LINE-PRINT. NC2224.2 +030100 PERFORM WRT-LN. NC2224.2 +030200 FAIL-ROUTINE. NC2224.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2224.2 +030400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2224.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2224.2 +030600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2224.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2224.2 +030900 GO TO FAIL-ROUTINE-EX. NC2224.2 +031000 FAIL-ROUTINE-WRITE. NC2224.2 +031100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2224.2 +031200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2224.2 +031300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2224.2 +031400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2224.2 +031500 FAIL-ROUTINE-EX. EXIT. NC2224.2 +031600 BAIL-OUT. NC2224.2 +031700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2224.2 +031800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2224.2 +031900 BAIL-OUT-WRITE. NC2224.2 +032000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2224.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2224.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2224.2 +032400 BAIL-OUT-EX. EXIT. NC2224.2 +032500 CCVS1-EXIT. NC2224.2 +032600 EXIT. NC2224.2 +032700 INITIALISE-TABLE1. NC2224.2 +032800 MOVE 06 TO RECORD1 OF TABLE1. NC2224.2 +032900 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2224.2 +033000 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2224.2 +033100 MOVE 07 TO RECORD3 OF TABLE1. NC2224.2 +033200 INITIALISE-TABLE2. NC2224.2 +033300 MOVE 08 TO RECORD1 OF TABLE2. NC2224.2 +033400 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2224.2 +033500 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2224.2 +033600 MOVE 09 TO RECORD3 OF TABLE2. NC2224.2 +033700* NC2224.2 +033800 ADD-INIT-F2-1. NC2224.2 +033900 MOVE "ADD-TEST-F2-1" TO PAR-NAME. NC2224.2 +034000 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +034100 MOVE "ADD - QUALIFICATION" TO FEATURE. NC2224.2 +034200 PERFORM INITIALISE-TABLE1. NC2224.2 +034300 PERFORM INITIALISE-TABLE2. NC2224.2 +034400 SET INDEX1 TO 1. NC2224.2 +034500 SET INDEX2 TO 1. NC2224.2 +034600 ADD-TEST-F2-1. NC2224.2 +034700 ADD RECORD2 OF TABLE1 (INDEX1) TO RECORD2 OF TABLE2 (INDEX2).NC2224.2 +034800 IF RECORD2 OF TABLE2 (1) = 04 NC2224.2 +034900 AND RECORD2 OF TABLE2 (2) = 04 NC2224.2 +035000 AND RECORD1 OF TABLE2 = 08 NC2224.2 +035100 AND RECORD3 OF TABLE2 = 09 NC2224.2 +035200 PERFORM PASS NC2224.2 +035300 ELSE NC2224.2 +035400 GO TO ADD-FAIL-F2-1. NC2224.2 +035500 GO TO ADD-WRITE-F2-1. NC2224.2 +035600 ADD-DELETE-F2-1. NC2224.2 +035700 PERFORM DE-LETE. NC2224.2 +035800 GO TO ADD-WRITE-F2-1. NC2224.2 +035900 ADD-FAIL-F2-1. NC2224.2 +036000 PERFORM FAIL. NC2224.2 +036100 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +036200 MOVE "08040409" TO CORRECT-A. NC2224.2 +036300 ADD-WRITE-F2-1. NC2224.2 +036400 PERFORM PRINT-DETAIL. NC2224.2 +036500 NC2224.2 +036600 SUBTRACT-INIT-F2-1. NC2224.2 +036700 MOVE "SUBTRACT-TEST-F2-1" TO PAR-NAME. NC2224.2 +036800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +036900 MOVE "SUBTRACT - QUAL." TO FEATURE. NC2224.2 +037000 PERFORM INITIALISE-TABLE1. NC2224.2 +037100 PERFORM INITIALISE-TABLE2. NC2224.2 +037200 SET INDEX1 TO 1. NC2224.2 +037300 SET INDEX2 TO 1. NC2224.2 +037400 SUBTRACT-TEST-F2-1-0. NC2224.2 +037500 SUBTRACT RECORD2 OF TABLE1 (INDEX1) NC2224.2 +037600 FROM RECORD2 OF TABLE2 (INDEX2). NC2224.2 +037700 SUBTRACT-TEST-F2-1-1. NC2224.2 +037800 IF RECORD2 OF TABLE2 (1) = 02 NC2224.2 +037900 AND RECORD2 OF TABLE2 (2) = 04 NC2224.2 +038000 AND RECORD1 OF TABLE2 = 08 NC2224.2 +038100 AND RECORD3 OF TABLE2 = 09 NC2224.2 +038200 PERFORM PASS NC2224.2 +038300 ELSE NC2224.2 +038400 GO TO SUBTRACT-FAIL-F2-1. NC2224.2 +038500 GO TO SUBTRACT-WRITE-F2-1. NC2224.2 +038600 SUBTRACT-DELETE-F2-1. NC2224.2 +038700 PERFORM DE-LETE. NC2224.2 +038800 GO TO SUBTRACT-WRITE-F2-1. NC2224.2 +038900 SUBTRACT-FAIL-F2-1. NC2224.2 +039000 PERFORM FAIL. NC2224.2 +039100 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +039200 MOVE "08020409" TO CORRECT-A. NC2224.2 +039300 SUBTRACT-WRITE-F2-1. NC2224.2 +039400 PERFORM PRINT-DETAIL. NC2224.2 +039500* NC2224.2 +039600 MOV-INIT-F2-1. NC2224.2 +039700 MOVE "MOV-TEST-F2-1" TO PAR-NAME. NC2224.2 +039800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +039900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2224.2 +040000 PERFORM INITIALISE-TABLE1. NC2224.2 +040100 PERFORM INITIALISE-TABLE2. NC2224.2 +040200 MOV-TEST-F2-1. NC2224.2 +040300 MOVE CORRESPONDING TABLE1 TO TABLE2. NC2224.2 +040400 IF RECORD1 OF TABLE2 = 06 AND NC2224.2 +040500 RECORD2 OF TABLE2 (1) = 03 AND NC2224.2 +040600 RECORD2 OF TABLE2 (2) = 04 AND NC2224.2 +040700 RECORD3 OF TABLE2 = 07 NC2224.2 +040800 PERFORM PASS NC2224.2 +040900 ELSE GO TO MOV-FAIL-F2-1. NC2224.2 +041000 GO TO MOV-WRITE-F2-1. NC2224.2 +041100 MOV-DELETE-F2-1. NC2224.2 +041200 PERFORM DE-LETE. NC2224.2 +041300 GO TO MOV-WRITE-F2-1. NC2224.2 +041400 MOV-FAIL-F2-1. NC2224.2 +041500 PERFORM FAIL. NC2224.2 +041600 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +041700 MOVE "06030407" TO CORRECT-A. NC2224.2 +041800 MOV-WRITE-F2-1. NC2224.2 +041900 PERFORM PRINT-DETAIL. NC2224.2 +042000* NC2224.2 +042100 INITIALISE-TABLE3. NC2224.2 +042200 MOVE "BB" TO RECORD2 OF TABLE3 (1). NC2224.2 +042300 MOVE "CC" TO RECORD2 OF TABLE3 (2). NC2224.2 +042400 INITIALISE-TABLE4. NC2224.2 +042500 MOVE "FF" TO RECORD2 OF TABLE4 (1). NC2224.2 +042600 MOVE "GG" TO RECORD2 OF TABLE4 (2). NC2224.2 +042700* NC2224.2 +042800 MOV-INIT-F2-2. NC2224.2 +042900 MOVE "MOV-TEST-F2-2" TO PAR-NAME. NC2224.2 +043000 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +043100 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2224.2 +043200 MOV-TEST-F2-2. NC2224.2 +043300 MOVE CORRESPONDING TABLE3 TO TABLE4. NC2224.2 +043400 IF RECORD1 OF TABLE4 = "AA" AND NC2224.2 +043500 RECORD2 OF TABLE4 (1) = "FF" AND NC2224.2 +043600 RECORD2 OF TABLE4 (2) = "GG" AND NC2224.2 +043700 RECORD3 OF TABLE4 = "DD" NC2224.2 +043800 PERFORM PASS NC2224.2 +043900 ELSE GO TO MOV-FAIL-F2-2. NC2224.2 +044000 GO TO MOV-WRITE-F2-2. NC2224.2 +044100 MOV-DELETE-F2-2. NC2224.2 +044200 PERFORM DE-LETE. NC2224.2 +044300 GO TO MOV-WRITE-F2-2. NC2224.2 +044400 MOV-FAIL-F2-2. NC2224.2 +044500 PERFORM FAIL. NC2224.2 +044600 MOVE TABLE4 TO COMPUTED-A. NC2224.2 +044700 MOVE "AAFFGGDD" TO CORRECT-A. NC2224.2 +044800 MOV-WRITE-F2-2. NC2224.2 +044900 PERFORM PRINT-DETAIL. NC2224.2 +045000* NC2224.2 +045100 MOV-INIT-F2-3. NC2224.2 +045200* ===--> DE-EDITING <--=== NC2224.2 +045300 MOVE "VI-104 6.18.4 GR4(b)" TO ANSI-REFERENCE. NC2224.2 +045400 MOVE -123.45 TO MOVE-TEST-3-A. NC2224.2 +045500 MOVE 1 TO REC-CT. NC2224.2 +045600 MOV-TEST-F2-3-0. NC2224.2 +045700 MOVE MOVE-TEST-3-A TO MOVE-TEST-3-B. NC2224.2 +045800 GO TO MOV-TEST-F2-3-1. NC2224.2 +045900 MOV-DELETE-F2-3. NC2224.2 +046000 PERFORM DE-LETE. NC2224.2 +046100 PERFORM PRINT-DETAIL. NC2224.2 +046200 GO TO MOV-INIT-F2-4. NC2224.2 +046300 MOV-TEST-F2-3-1. NC2224.2 +046400 MOVE "MOV-TEST-F2-3-1" TO PAR-NAME. NC2224.2 +046500 IF MOVE-TEST-3-B = -123.45 NC2224.2 +046600 PERFORM PASS NC2224.2 +046700 GO TO MOV-WRITE-F2-3-1 NC2224.2 +046800 ELSE NC2224.2 +046900 GO TO MOV-FAIL-F2-3-1. NC2224.2 +047000 MOV-DELETE-F2-3-1. NC2224.2 +047100 PERFORM DE-LETE. NC2224.2 +047200 GO TO MOV-WRITE-F2-3-1. NC2224.2 +047300 MOV-FAIL-F2-3-1. NC2224.2 +047400 MOVE -123.45 TO CORRECT-N NC2224.2 +047500 MOVE MOVE-TEST-3-B TO COMPUTED-N NC2224.2 +047600 MOVE "DE-EDITING MOVE ERROR" TO RE-MARK NC2224.2 +047700 PERFORM FAIL. NC2224.2 +047800 MOV-WRITE-F2-3-1. NC2224.2 +047900 PERFORM PRINT-DETAIL. NC2224.2 +048000* NC2224.2 +048100 MOV-INIT-F2-3-2. NC2224.2 +048200 ADD 1 TO REC-CT. NC2224.2 +048300 MOVE "MOV-TEST-F2-3-2" TO PAR-NAME. NC2224.2 +048400 MOV-TEST-F2-3-2. NC2224.2 +048500 IF MOVE-TEST-3-A = " $123.45CR" NC2224.2 +048600 PERFORM PASS NC2224.2 +048700 GO TO MOV-WRITE-F2-3-2 NC2224.2 +048800 ELSE NC2224.2 +048900 GO TO MOV-FAIL-F2-3-2. NC2224.2 +049000 MOV-DELETE-F2-3-2. NC2224.2 +049100 PERFORM DE-LETE. NC2224.2 +049200 GO TO MOV-WRITE-F2-3-2. NC2224.2 +049300 MOV-FAIL-F2-3-2. NC2224.2 +049400 MOVE " $123.45" TO CORRECT-X NC2224.2 +049500 MOVE MOVE-TEST-3-A TO COMPUTED-X NC2224.2 +049600 MOVE "EDITED DATA MOVE ERROR" TO RE-MARK NC2224.2 +049700 PERFORM FAIL. NC2224.2 +049800 MOV-WRITE-F2-3-2. NC2224.2 +049900 PERFORM PRINT-DETAIL. NC2224.2 +050000* NC2224.2 +050100 MOV-INIT-F2-4. NC2224.2 +050200* ===--> DE-EDITING <--=== NC2224.2 +050300 MOVE "VI-104 6.18.4 GR4(b)" TO ANSI-REFERENCE. NC2224.2 +050400 MOVE -42.9876 TO MOVE-TEST-4-A. NC2224.2 +050500 MOVE 1 TO REC-CT. NC2224.2 +050600 MOV-TEST-F2-4-0. NC2224.2 +050700 MOVE MOVE-TEST-4-A TO MOVE-TEST-4-B. NC2224.2 +050800 GO TO MOV-TEST-F2-4-1. NC2224.2 +050900 MOV-DELETE-F2-4. NC2224.2 +051000 PERFORM DE-LETE. NC2224.2 +051100 PERFORM PRINT-DETAIL. NC2224.2 +051200 GO TO CCVS-999999. NC2224.2 +051300 MOV-TEST-F2-4-1. NC2224.2 +051400 MOVE "MOV-TEST-F2-4-1" TO PAR-NAME. NC2224.2 +051500 IF MOVE-TEST-4-B = -42.987600 NC2224.2 +051600 PERFORM PASS NC2224.2 +051700 GO TO MOV-WRITE-F2-4-1 NC2224.2 +051800 ELSE NC2224.2 +051900 GO TO MOV-FAIL-F2-4-1. NC2224.2 +052000 MOV-DELETE-F2-4-1. NC2224.2 +052100 PERFORM DE-LETE. NC2224.2 +052200 GO TO MOV-WRITE-F2-4-1. NC2224.2 +052300 MOV-FAIL-F2-4-1. NC2224.2 +052400 MOVE -42.987600 TO CORRECT-N NC2224.2 +052500 MOVE MOVE-TEST-4-B TO COMPUTED-N NC2224.2 +052600 MOVE "DE-EDITING MOVE ERROR" TO RE-MARK NC2224.2 +052700 PERFORM FAIL. NC2224.2 +052800 MOV-WRITE-F2-4-1. NC2224.2 +052900 PERFORM PRINT-DETAIL. NC2224.2 +053000* NC2224.2 +053100 MOV-TEST-F2-4-2. NC2224.2 +053200 ADD 1 TO REC-CT. NC2224.2 +053300 MOVE "MOV-TEST-F2-4-2" TO PAR-NAME. NC2224.2 +053400 IF MOVE-TEST-4-A = "-42 .98 76/00" NC2224.2 +053500 PERFORM PASS NC2224.2 +053600 GO TO MOV-WRITE-F2-4-2 NC2224.2 +053700 ELSE NC2224.2 +053800 GO TO MOV-FAIL-F2-4-2. NC2224.2 +053900 MOV-DELETE-F2-4-2. NC2224.2 +054000 PERFORM DE-LETE. NC2224.2 +054100 GO TO MOV-WRITE-F2-4-2. NC2224.2 +054200 MOV-FAIL-F2-4-2. NC2224.2 +054300 MOVE "-42 .98 76/00" TO CORRECT-X NC2224.2 +054400 MOVE MOVE-TEST-4-A TO COMPUTED-X NC2224.2 +054500 MOVE "EDITED DATA MOVE ERROR" TO RE-MARK NC2224.2 +054600 PERFORM FAIL. NC2224.2 +054700 MOV-WRITE-F2-4-2. NC2224.2 +054800 PERFORM PRINT-DETAIL. NC2224.2 +054900* NC2224.2 +055000 CCVS-EXIT SECTION. NC2224.2 +055100 CCVS-999999. NC2224.2 +055200 GO TO CLOSE-FILES. NC2224.2 +*END-OF,NC222A +*HEADER,COBOL,NC223A +000100 IDENTIFICATION DIVISION. NC2234.2 +000200 PROGRAM-ID. NC2234.2 +000300 NC223A. NC2234.2 +000400**************************************************************** NC2234.2 +000500* * NC2234.2 +000600* VALIDATION FOR:- * NC2234.2 +000700* * NC2234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +000900* * NC2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2234.2 +001100* * NC2234.2 +001200**************************************************************** NC2234.2 +001300* * NC2234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2234.2 +001500* * NC2234.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2234.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2234.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2234.2 +001900* * NC2234.2 +002000**************************************************************** NC2234.2 +002100* PROGRAM NC223A TESTS THE "INITIALISE" STATEMENT USING * NC2234.2 +002200* USING VARIOUS COMBINATIONS OD OPTIONAL PHRASES AND A * NC2234.2 +002300* VARIETY OF RECEIVING AREAS. * NC2234.2 +002400* * NC2234.2 +002500**************************************************************** NC2234.2 +002600 ENVIRONMENT DIVISION. NC2234.2 +002700 CONFIGURATION SECTION. NC2234.2 +002800 SOURCE-COMPUTER. NC2234.2 +002900 XXXXX082. NC2234.2 +003000 OBJECT-COMPUTER. NC2234.2 +003100 XXXXX083. NC2234.2 +003200 INPUT-OUTPUT SECTION. NC2234.2 +003300 FILE-CONTROL. NC2234.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2234.2 +003500 XXXXX055. NC2234.2 +003600 DATA DIVISION. NC2234.2 +003700 FILE SECTION. NC2234.2 +003800 FD PRINT-FILE. NC2234.2 +003900 01 PRINT-REC PICTURE X(120). NC2234.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2234.2 +004100 WORKING-STORAGE SECTION. NC2234.2 +004200 01 TEST-1-DATA. NC2234.2 +004300 03 TEST-1-1 PIC 9(6). NC2234.2 +004400 03 TEST-1-2 PIC $(3)9.99. NC2234.2 +004500 03 TEST-1-3 PIC X(10). NC2234.2 +004600 03 TEST-1-4 PIC XXBXX/XX. NC2234.2 +004700 03 TEST-1-5 PIC A(6). NC2234.2 +004800 03 TEST-1-6 PIC 9(6). NC2234.2 +004900 03 TEST-1-7 PIC $(3)9.99. NC2234.2 +005000 03 TEST-1-8 PIC X(10). NC2234.2 +005100 03 TEST-1-9 PIC XXBXX/XX. NC2234.2 +005200 03 TEST-1-10 PIC A(6). NC2234.2 +005300 01 NUM-1234 PIC 9(4) VALUE 1234. NC2234.2 +005400 01 TEST-8-DATA-1 PIC $(3)9.99. NC2234.2 +005500 01 TEST-8-DATA-2 PIC A(10). NC2234.2 +005600 01 TEST-RESULTS. NC2234.2 +005700 02 FILLER PIC X VALUE SPACE. NC2234.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC2234.2 +005900 02 FILLER PIC X VALUE SPACE. NC2234.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC2234.2 +006100 02 FILLER PIC X VALUE SPACE. NC2234.2 +006200 02 PAR-NAME. NC2234.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC2234.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC2234.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC2234.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC2234.2 +006700 02 RE-MARK PIC X(61). NC2234.2 +006800 01 TEST-COMPUTED. NC2234.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC2234.2 +007000 02 FILLER PIC X(17) VALUE NC2234.2 +007100 " COMPUTED=". NC2234.2 +007200 02 COMPUTED-X. NC2234.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2234.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC2234.2 +007500 PIC -9(9).9(9). NC2234.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2234.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2234.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2234.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC2234.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC2234.2 +008100 04 FILLER PIC X. NC2234.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC2234.2 +008300 01 TEST-CORRECT. NC2234.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC2234.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2234.2 +008600 02 CORRECT-X. NC2234.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2234.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2234.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2234.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2234.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2234.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC2234.2 +009300 04 CORRECT-18V0 PIC -9(18). NC2234.2 +009400 04 FILLER PIC X. NC2234.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC2234.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2234.2 +009700 01 CCVS-C-1. NC2234.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2234.2 +009900- "SS PARAGRAPH-NAME NC2234.2 +010000- " REMARKS". NC2234.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC2234.2 +010200 01 CCVS-C-2. NC2234.2 +010300 02 FILLER PIC X VALUE SPACE. NC2234.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC2234.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC2234.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC2234.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC2234.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2234.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC2234.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2234.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2234.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2234.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2234.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2234.2 +011900 01 CCVS-H-1. NC2234.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC2234.2 +012100 02 FILLER PIC X(42) VALUE NC2234.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2234.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC2234.2 +012400 01 CCVS-H-2A. NC2234.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC2234.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2234.2 +012700 02 FILLER PIC XXXX VALUE NC2234.2 +012800 "4.2 ". NC2234.2 +012900 02 FILLER PIC X(28) VALUE NC2234.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC2234.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC2234.2 +013200 NC2234.2 +013300 01 CCVS-H-2B. NC2234.2 +013400 02 FILLER PIC X(15) VALUE NC2234.2 +013500 "TEST RESULT OF ". NC2234.2 +013600 02 TEST-ID PIC X(9). NC2234.2 +013700 02 FILLER PIC X(4) VALUE NC2234.2 +013800 " IN ". NC2234.2 +013900 02 FILLER PIC X(12) VALUE NC2234.2 +014000 " HIGH ". NC2234.2 +014100 02 FILLER PIC X(22) VALUE NC2234.2 +014200 " LEVEL VALIDATION FOR ". NC2234.2 +014300 02 FILLER PIC X(58) VALUE NC2234.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +014500 01 CCVS-H-3. NC2234.2 +014600 02 FILLER PIC X(34) VALUE NC2234.2 +014700 " FOR OFFICIAL USE ONLY ". NC2234.2 +014800 02 FILLER PIC X(58) VALUE NC2234.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2234.2 +015000 02 FILLER PIC X(28) VALUE NC2234.2 +015100 " COPYRIGHT 1985 ". NC2234.2 +015200 01 CCVS-E-1. NC2234.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC2234.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2234.2 +015500 02 ID-AGAIN PIC X(9). NC2234.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC2234.2 +015700 01 CCVS-E-2. NC2234.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC2234.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC2234.2 +016000 02 CCVS-E-2-2. NC2234.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2234.2 +016200 03 FILLER PIC X VALUE SPACE. NC2234.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC2234.2 +016400 "ERRORS ENCOUNTERED". NC2234.2 +016500 01 CCVS-E-3. NC2234.2 +016600 02 FILLER PIC X(22) VALUE NC2234.2 +016700 " FOR OFFICIAL USE ONLY". NC2234.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC2234.2 +016900 02 FILLER PIC X(58) VALUE NC2234.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC2234.2 +017200 02 FILLER PIC X(15) VALUE NC2234.2 +017300 " COPYRIGHT 1985". NC2234.2 +017400 01 CCVS-E-4. NC2234.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2234.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC2234.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2234.2 +017800 02 FILLER PIC X(40) VALUE NC2234.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2234.2 +018000 01 XXINFO. NC2234.2 +018100 02 FILLER PIC X(19) VALUE NC2234.2 +018200 "*** INFORMATION ***". NC2234.2 +018300 02 INFO-TEXT. NC2234.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC2234.2 +018500 04 XXCOMPUTED PIC X(20). NC2234.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC2234.2 +018700 04 XXCORRECT PIC X(20). NC2234.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC2234.2 +018900 01 HYPHEN-LINE. NC2234.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC2234.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC2234.2 +019200- "*****************************************". NC2234.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC2234.2 +019400- "******************************". NC2234.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC2234.2 +019600 "NC223A". NC2234.2 +019700 PROCEDURE DIVISION. NC2234.2 +019800 CCVS1 SECTION. NC2234.2 +019900 OPEN-FILES. NC2234.2 +020000 OPEN OUTPUT PRINT-FILE. NC2234.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2234.2 +020200 MOVE SPACE TO TEST-RESULTS. NC2234.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2234.2 +020400 GO TO CCVS1-EXIT. NC2234.2 +020500 CLOSE-FILES. NC2234.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2234.2 +020700 TERMINATE-CCVS. NC2234.2 +020800S EXIT PROGRAM. NC2234.2 +020900STERMINATE-CALL. NC2234.2 +021000 STOP RUN. NC2234.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2234.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2234.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2234.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2234.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC2234.2 +021600 PRINT-DETAIL. NC2234.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC2234.2 +021800 MOVE "." TO PARDOT-X NC2234.2 +021900 MOVE REC-CT TO DOTVALUE. NC2234.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2234.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2234.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2234.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2234.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2234.2 +022500 MOVE SPACE TO CORRECT-X. NC2234.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2234.2 +022700 MOVE SPACE TO RE-MARK. NC2234.2 +022800 HEAD-ROUTINE. NC2234.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2234.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2234.2 +023300 COLUMN-NAMES-ROUTINE. NC2234.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +023700 END-ROUTINE. NC2234.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2234.2 +023900 END-RTN-EXIT. NC2234.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +024100 END-ROUTINE-1. NC2234.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2234.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2234.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC2234.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2234.2 +024600 NC2234.2 +024700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2234.2 +024800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2234.2 +024900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2234.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2234.2 +025100 END-ROUTINE-12. NC2234.2 +025200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2234.2 +025300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2234.2 +025400 MOVE "NO " TO ERROR-TOTAL NC2234.2 +025500 ELSE NC2234.2 +025600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2234.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2234.2 +025800 PERFORM WRITE-LINE. NC2234.2 +025900 END-ROUTINE-13. NC2234.2 +026000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2234.2 +026100 MOVE "NO " TO ERROR-TOTAL ELSE NC2234.2 +026200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2234.2 +026300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2234.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +026500 IF INSPECT-COUNTER EQUAL TO ZERO NC2234.2 +026600 MOVE "NO " TO ERROR-TOTAL NC2234.2 +026700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2234.2 +026800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2234.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +027000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +027100 WRITE-LINE. NC2234.2 +027200 ADD 1 TO RECORD-COUNT. NC2234.2 +027300Y IF RECORD-COUNT GREATER 50 NC2234.2 +027400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2234.2 +027500Y MOVE SPACE TO DUMMY-RECORD NC2234.2 +027600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2234.2 +027700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2234.2 +027800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2234.2 +027900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2234.2 +028000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2234.2 +028100Y MOVE ZERO TO RECORD-COUNT. NC2234.2 +028200 PERFORM WRT-LN. NC2234.2 +028300 WRT-LN. NC2234.2 +028400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2234.2 +028500 MOVE SPACE TO DUMMY-RECORD. NC2234.2 +028600 BLANK-LINE-PRINT. NC2234.2 +028700 PERFORM WRT-LN. NC2234.2 +028800 FAIL-ROUTINE. NC2234.2 +028900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2234.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2234.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2234.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2234.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2234.2 +029500 GO TO FAIL-ROUTINE-EX. NC2234.2 +029600 FAIL-ROUTINE-WRITE. NC2234.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2234.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2234.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2234.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2234.2 +030100 FAIL-ROUTINE-EX. EXIT. NC2234.2 +030200 BAIL-OUT. NC2234.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2234.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2234.2 +030500 BAIL-OUT-WRITE. NC2234.2 +030600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2234.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2234.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2234.2 +031000 BAIL-OUT-EX. EXIT. NC2234.2 +031100 CCVS1-EXIT. NC2234.2 +031200 EXIT. NC2234.2 +031300 SECT-NC223A-001 SECTION. NC2234.2 +031400* NC2234.2 +031500 INI-INIT-GF-1. NC2234.2 +031600 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +031700 MOVE "VI-92 6.16.2 GR5" TO ANSI-REFERENCE. NC2234.2 +031800 MOVE 1 TO REC-CT. NC2234.2 +031900 INI-TEST-GF-1-0. NC2234.2 +032000 INITIALIZE TEST-1-DATA. NC2234.2 +032100 GO TO INI-TEST-GF-1-1. NC2234.2 +032200 INI-DELETE-GF-1. NC2234.2 +032300 PERFORM DE-LETE. NC2234.2 +032400 PERFORM PRINT-DETAIL. NC2234.2 +032500 GO TO INI-INIT-GF-2. NC2234.2 +032600 INI-TEST-GF-1-1. NC2234.2 +032700 MOVE "INI-TEST-GF-1-1" TO PAR-NAME. NC2234.2 +032800 IF TEST-1-1 = ZERO NC2234.2 +032900 PERFORM PASS NC2234.2 +033000 GO TO INI-WRITE-GF-1-1 NC2234.2 +033100 ELSE NC2234.2 +033200 GO TO INI-FAIL-GF-1-1. NC2234.2 +033300 INI-DELETE-GF-1-1. NC2234.2 +033400 PERFORM DE-LETE. NC2234.2 +033500 GO TO INI-WRITE-GF-1-1. NC2234.2 +033600 INI-FAIL-GF-1-1. NC2234.2 +033700 MOVE ZERO TO CORRECT-N NC2234.2 +033800 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +033900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +034000 PERFORM FAIL. NC2234.2 +034100 INI-WRITE-GF-1-1. NC2234.2 +034200 PERFORM PRINT-DETAIL. NC2234.2 +034300* NC2234.2 +034400 INI-TEST-GF-1-2. NC2234.2 +034500 ADD 1 TO REC-CT. NC2234.2 +034600 MOVE "INI-TEST-GF-1-2" TO PAR-NAME. NC2234.2 +034700 IF TEST-1-2 = " $0.00" NC2234.2 +034800 PERFORM PASS NC2234.2 +034900 GO TO INI-WRITE-GF-1-2 NC2234.2 +035000 ELSE NC2234.2 +035100 GO TO INI-FAIL-GF-1-2. NC2234.2 +035200 INI-DELETE-GF-1-2. NC2234.2 +035300 PERFORM DE-LETE. NC2234.2 +035400 GO TO INI-WRITE-GF-1-2. NC2234.2 +035500 INI-FAIL-GF-1-2. NC2234.2 +035600 MOVE " $0.00" TO CORRECT-X NC2234.2 +035700 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +035800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +035900 PERFORM FAIL. NC2234.2 +036000 INI-WRITE-GF-1-2. NC2234.2 +036100 PERFORM PRINT-DETAIL. NC2234.2 +036200* NC2234.2 +036300 INI-TEST-GF-1-3. NC2234.2 +036400 ADD 1 TO REC-CT. NC2234.2 +036500 MOVE "INI-TEST-GF-1-3" TO PAR-NAME. NC2234.2 +036600 IF TEST-1-3 = SPACES NC2234.2 +036700 PERFORM PASS NC2234.2 +036800 GO TO INI-WRITE-GF-1-3 NC2234.2 +036900 ELSE NC2234.2 +037000 GO TO INI-FAIL-GF-1-3. NC2234.2 +037100 INI-DELETE-GF-1-3. NC2234.2 +037200 PERFORM DE-LETE. NC2234.2 +037300 GO TO INI-WRITE-GF-1-3. NC2234.2 +037400 INI-FAIL-GF-1-3. NC2234.2 +037500 MOVE SPACES TO CORRECT-X NC2234.2 +037600 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +037700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +037800 PERFORM FAIL. NC2234.2 +037900 INI-WRITE-GF-1-3. NC2234.2 +038000 PERFORM PRINT-DETAIL. NC2234.2 +038100* NC2234.2 +038200 INI-TEST-GF-1-4. NC2234.2 +038300 ADD 1 TO REC-CT. NC2234.2 +038400 MOVE "INI-TEST-GF-1-4" TO PAR-NAME. NC2234.2 +038500 IF TEST-1-4 = " / " NC2234.2 +038600 PERFORM PASS NC2234.2 +038700 GO TO INI-WRITE-GF-1-4 NC2234.2 +038800 ELSE NC2234.2 +038900 GO TO INI-FAIL-GF-1-4. NC2234.2 +039000 INI-DELETE-GF-1-4. NC2234.2 +039100 PERFORM DE-LETE. NC2234.2 +039200 GO TO INI-WRITE-GF-1-4. NC2234.2 +039300 INI-FAIL-GF-1-4. NC2234.2 +039400 MOVE " / " TO CORRECT-X NC2234.2 +039500 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +039600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +039700 PERFORM FAIL. NC2234.2 +039800 INI-WRITE-GF-1-4. NC2234.2 +039900 PERFORM PRINT-DETAIL. NC2234.2 +040000* NC2234.2 +040100 INI-TEST-GF-1-5. NC2234.2 +040200 ADD 1 TO REC-CT. NC2234.2 +040300 MOVE "INI-TEST-GF-1-5" TO PAR-NAME. NC2234.2 +040400 IF TEST-1-5 = SPACES NC2234.2 +040500 PERFORM PASS NC2234.2 +040600 GO TO INI-WRITE-GF-1-5 NC2234.2 +040700 ELSE NC2234.2 +040800 GO TO INI-FAIL-GF-1-5. NC2234.2 +040900 INI-DELETE-GF-1-5. NC2234.2 +041000 PERFORM DE-LETE. NC2234.2 +041100 GO TO INI-WRITE-GF-1-5. NC2234.2 +041200 INI-FAIL-GF-1-5. NC2234.2 +041300 MOVE SPACES TO CORRECT-X NC2234.2 +041400 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +041500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +041600 PERFORM FAIL. NC2234.2 +041700 INI-WRITE-GF-1-5. NC2234.2 +041800 PERFORM PRINT-DETAIL. NC2234.2 +041900* NC2234.2 +042000 INI-TEST-GF-1-6. NC2234.2 +042100 ADD 1 TO REC-CT. NC2234.2 +042200 MOVE "INI-TEST-GF-1-6" TO PAR-NAME. NC2234.2 +042300 IF TEST-1-6 = ZERO NC2234.2 +042400 PERFORM PASS NC2234.2 +042500 GO TO INI-WRITE-GF-1-6 NC2234.2 +042600 ELSE NC2234.2 +042700 GO TO INI-FAIL-GF-1-6. NC2234.2 +042800 INI-DELETE-GF-1-6. NC2234.2 +042900 PERFORM DE-LETE. NC2234.2 +043000 GO TO INI-WRITE-GF-1-6. NC2234.2 +043100 INI-FAIL-GF-1-6. NC2234.2 +043200 MOVE ZERO TO CORRECT-N NC2234.2 +043300 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +043400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +043500 PERFORM FAIL. NC2234.2 +043600 INI-WRITE-GF-1-6. NC2234.2 +043700 PERFORM PRINT-DETAIL. NC2234.2 +043800* NC2234.2 +043900 INI-TEST-GF-1-7. NC2234.2 +044000 ADD 1 TO REC-CT. NC2234.2 +044100 MOVE "INI-TEST-GF-1-7" TO PAR-NAME. NC2234.2 +044200 IF TEST-1-7 = " $0.00" NC2234.2 +044300 PERFORM PASS NC2234.2 +044400 GO TO INI-WRITE-GF-1-7 NC2234.2 +044500 ELSE NC2234.2 +044600 GO TO INI-FAIL-GF-1-7. NC2234.2 +044700 INI-DELETE-GF-1-7. NC2234.2 +044800 PERFORM DE-LETE. NC2234.2 +044900 GO TO INI-WRITE-GF-1-7. NC2234.2 +045000 INI-FAIL-GF-1-7. NC2234.2 +045100 MOVE " $0.00" TO CORRECT-X. NC2234.2 +045200 MOVE TEST-1-7 TO COMPUTED-X. NC2234.2 +045300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK. NC2234.2 +045400 PERFORM FAIL. NC2234.2 +045500 INI-WRITE-GF-1-7. NC2234.2 +045600 PERFORM PRINT-DETAIL. NC2234.2 +045700* NC2234.2 +045800 INI-TEST-GF-1-8. NC2234.2 +045900 ADD 1 TO REC-CT. NC2234.2 +046000 MOVE "INI-TEST-GF-1-8" TO PAR-NAME. NC2234.2 +046100 IF TEST-1-8 = SPACES NC2234.2 +046200 PERFORM PASS NC2234.2 +046300 GO TO INI-WRITE-GF-1-8 NC2234.2 +046400 ELSE NC2234.2 +046500 GO TO INI-FAIL-GF-1-8. NC2234.2 +046600 INI-DELETE-GF-1-8. NC2234.2 +046700 PERFORM DE-LETE. NC2234.2 +046800 GO TO INI-WRITE-GF-1-8. NC2234.2 +046900 INI-FAIL-GF-1-8. NC2234.2 +047000 MOVE SPACES TO CORRECT-X NC2234.2 +047100 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +047200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +047300 PERFORM FAIL. NC2234.2 +047400 INI-WRITE-GF-1-8. NC2234.2 +047500 PERFORM PRINT-DETAIL. NC2234.2 +047600* NC2234.2 +047700 INI-TEST-GF-1-9. NC2234.2 +047800 ADD 1 TO REC-CT. NC2234.2 +047900 MOVE "INI-TEST-GF-1-9" TO PAR-NAME. NC2234.2 +048000 IF TEST-1-9 = " / " NC2234.2 +048100 PERFORM PASS NC2234.2 +048200 GO TO INI-WRITE-GF-1-9 NC2234.2 +048300 ELSE NC2234.2 +048400 GO TO INI-FAIL-GF-1-9. NC2234.2 +048500 INI-DELETE-GF-1-9. NC2234.2 +048600 PERFORM DE-LETE. NC2234.2 +048700 GO TO INI-WRITE-GF-1-9. NC2234.2 +048800 INI-FAIL-GF-1-9. NC2234.2 +048900 MOVE " / " TO CORRECT-X NC2234.2 +049000 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +049100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +049200 PERFORM FAIL. NC2234.2 +049300 INI-WRITE-GF-1-9. NC2234.2 +049400 PERFORM PRINT-DETAIL. NC2234.2 +049500* NC2234.2 +049600 INI-TEST-GF-1-10. NC2234.2 +049700 ADD 1 TO REC-CT. NC2234.2 +049800 MOVE "INI-TEST-GF-1-10" TO PAR-NAME. NC2234.2 +049900 IF TEST-1-10 = SPACES NC2234.2 +050000 PERFORM PASS NC2234.2 +050100 GO TO INI-WRITE-GF-1-10 NC2234.2 +050200 ELSE NC2234.2 +050300 GO TO INI-FAIL-GF-1-10. NC2234.2 +050400 INI-DELETE-GF-1-10. NC2234.2 +050500 PERFORM DE-LETE. NC2234.2 +050600 GO TO INI-WRITE-GF-1-10. NC2234.2 +050700 INI-FAIL-GF-1-10. NC2234.2 +050800 MOVE SPACES TO CORRECT-X NC2234.2 +050900 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +051000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +051100 PERFORM FAIL. NC2234.2 +051200 INI-WRITE-GF-1-10. NC2234.2 +051300 PERFORM PRINT-DETAIL. NC2234.2 +051400* NC2234.2 +051500 INI-INIT-GF-2. NC2234.2 +051600 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +051700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +051800 MOVE 1 TO REC-CT. NC2234.2 +051900 INI-TEST-GF-2-0. NC2234.2 +052000 INITIALIZE TEST-1-DATA NC2234.2 +052100 REPLACING ALPHABETIC DATA BY "AAAAAA". NC2234.2 +052200 GO TO INI-TEST-GF-2-1. NC2234.2 +052300 INI-DELETE-GF-2. NC2234.2 +052400 PERFORM DE-LETE. NC2234.2 +052500 PERFORM PRINT-DETAIL. NC2234.2 +052600 GO TO INI-INIT-GF-3. NC2234.2 +052700* NC2234.2 +052800 INI-TEST-GF-2-1. NC2234.2 +052900 MOVE "INI-TEST-GF-2-1" TO PAR-NAME. NC2234.2 +053000 IF TEST-1-5 = "AAAAAA" NC2234.2 +053100 PERFORM PASS NC2234.2 +053200 GO TO INI-WRITE-GF-2-1 NC2234.2 +053300 ELSE NC2234.2 +053400 GO TO INI-FAIL-GF-2-1. NC2234.2 +053500 INI-DELETE-GF-2-1. NC2234.2 +053600 PERFORM DE-LETE. NC2234.2 +053700 GO TO INI-WRITE-GF-2-1. NC2234.2 +053800 INI-FAIL-GF-2-1. NC2234.2 +053900 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +054000 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +054100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +054200 PERFORM FAIL. NC2234.2 +054300 INI-WRITE-GF-2-1. NC2234.2 +054400 PERFORM PRINT-DETAIL. NC2234.2 +054500* NC2234.2 +054600 INI-TEST-GF-2-2. NC2234.2 +054700 ADD 1 TO REC-CT. NC2234.2 +054800 MOVE "INI-TEST-GF-2-2" TO PAR-NAME. NC2234.2 +054900 IF TEST-1-10 = "AAAAAA" NC2234.2 +055000 PERFORM PASS NC2234.2 +055100 GO TO INI-WRITE-GF-2-2 NC2234.2 +055200 ELSE NC2234.2 +055300 GO TO INI-FAIL-GF-2-2. NC2234.2 +055400 INI-DELETE-GF-2-2. NC2234.2 +055500 PERFORM DE-LETE. NC2234.2 +055600 GO TO INI-WRITE-GF-2-2. NC2234.2 +055700 INI-FAIL-GF-2-2. NC2234.2 +055800 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +055900 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +056000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +056100 PERFORM FAIL. NC2234.2 +056200 INI-WRITE-GF-2-2. NC2234.2 +056300 PERFORM PRINT-DETAIL. NC2234.2 +056400* NC2234.2 +056500 INI-TEST-GF-2-3. NC2234.2 +056600 ADD 1 TO REC-CT. NC2234.2 +056700 MOVE "INI-TEST-GF-2-3" TO PAR-NAME. NC2234.2 +056800 IF TEST-1-1 = ZERO NC2234.2 +056900 PERFORM PASS NC2234.2 +057000 GO TO INI-WRITE-GF-2-3 NC2234.2 +057100 ELSE NC2234.2 +057200 GO TO INI-FAIL-GF-2-3. NC2234.2 +057300 INI-DELETE-GF-2-3. NC2234.2 +057400 PERFORM DE-LETE. NC2234.2 +057500 GO TO INI-WRITE-GF-2-3. NC2234.2 +057600 INI-FAIL-GF-2-3. NC2234.2 +057700 MOVE ZERO TO CORRECT-N NC2234.2 +057800 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +057900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +058000 TO RE-MARK NC2234.2 +058100 PERFORM FAIL. NC2234.2 +058200 INI-WRITE-GF-2-3. NC2234.2 +058300 PERFORM PRINT-DETAIL. NC2234.2 +058400* NC2234.2 +058500 INI-TEST-GF-2-4. NC2234.2 +058600 ADD 1 TO REC-CT. NC2234.2 +058700 MOVE "INI-TEST-GF-2-4" TO PAR-NAME. NC2234.2 +058800 IF TEST-1-2 = " $0.00" NC2234.2 +058900 PERFORM PASS NC2234.2 +059000 GO TO INI-WRITE-GF-2-4 NC2234.2 +059100 ELSE NC2234.2 +059200 GO TO INI-FAIL-GF-2-4. NC2234.2 +059300 INI-DELETE-GF-2-4. NC2234.2 +059400 PERFORM DE-LETE. NC2234.2 +059500 GO TO INI-WRITE-GF-2-4. NC2234.2 +059600 INI-FAIL-GF-2-4. NC2234.2 +059700 MOVE " $0.00" TO CORRECT-X NC2234.2 +059800 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +059900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +060000 TO RE-MARK NC2234.2 +060100 PERFORM FAIL. NC2234.2 +060200 INI-WRITE-GF-2-4. NC2234.2 +060300 PERFORM PRINT-DETAIL. NC2234.2 +060400* NC2234.2 +060500 INI-TEST-GF-2-5. NC2234.2 +060600 ADD 1 TO REC-CT. NC2234.2 +060700 MOVE "INI-TEST-GF-2-5" TO PAR-NAME. NC2234.2 +060800 IF TEST-1-3 = SPACES NC2234.2 +060900 PERFORM PASS NC2234.2 +061000 GO TO INI-WRITE-GF-2-5 NC2234.2 +061100 ELSE NC2234.2 +061200 GO TO INI-FAIL-GF-2-5. NC2234.2 +061300 INI-DELETE-GF-2-5. NC2234.2 +061400 PERFORM DE-LETE. NC2234.2 +061500 GO TO INI-WRITE-GF-2-5. NC2234.2 +061600 INI-FAIL-GF-2-5. NC2234.2 +061700 MOVE SPACES TO CORRECT-X NC2234.2 +061800 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +061900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +062000 TO RE-MARK NC2234.2 +062100 PERFORM FAIL. NC2234.2 +062200 INI-WRITE-GF-2-5. NC2234.2 +062300 PERFORM PRINT-DETAIL. NC2234.2 +062400* NC2234.2 +062500 INI-TEST-GF-2-6. NC2234.2 +062600 ADD 1 TO REC-CT. NC2234.2 +062700 MOVE "INI-TEST-GF-2-6" TO PAR-NAME. NC2234.2 +062800 IF TEST-1-4 = " / " NC2234.2 +062900 PERFORM PASS NC2234.2 +063000 GO TO INI-WRITE-GF-2-6 NC2234.2 +063100 ELSE NC2234.2 +063200 GO TO INI-FAIL-GF-2-6. NC2234.2 +063300 INI-DELETE-GF-2-6. NC2234.2 +063400 PERFORM DE-LETE. NC2234.2 +063500 GO TO INI-WRITE-GF-2-6. NC2234.2 +063600 INI-FAIL-GF-2-6. NC2234.2 +063700 MOVE " / " TO CORRECT-X NC2234.2 +063800 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +063900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +064000 TO RE-MARK NC2234.2 +064100 PERFORM FAIL. NC2234.2 +064200 INI-WRITE-GF-2-6. NC2234.2 +064300 PERFORM PRINT-DETAIL. NC2234.2 +064400* NC2234.2 +064500 INI-TEST-GF-2-7. NC2234.2 +064600 ADD 1 TO REC-CT. NC2234.2 +064700 MOVE "INI-TEST-GF-2-7" TO PAR-NAME. NC2234.2 +064800 IF TEST-1-6 = ZERO NC2234.2 +064900 PERFORM PASS NC2234.2 +065000 GO TO INI-WRITE-GF-2-7 NC2234.2 +065100 ELSE NC2234.2 +065200 GO TO INI-FAIL-GF-2-7. NC2234.2 +065300 INI-DELETE-GF-2-7. NC2234.2 +065400 PERFORM DE-LETE. NC2234.2 +065500 GO TO INI-WRITE-GF-2-7. NC2234.2 +065600 INI-FAIL-GF-2-7. NC2234.2 +065700 MOVE ZERO TO CORRECT-N NC2234.2 +065800 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +065900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +066000 TO RE-MARK NC2234.2 +066100 PERFORM FAIL. NC2234.2 +066200 INI-WRITE-GF-2-7. NC2234.2 +066300 PERFORM PRINT-DETAIL. NC2234.2 +066400* NC2234.2 +066500 INI-TEST-GF-2-8. NC2234.2 +066600 ADD 1 TO REC-CT. NC2234.2 +066700 MOVE "INI-TEST-GF-2-8" TO PAR-NAME. NC2234.2 +066800 IF TEST-1-7 = " $0.00" NC2234.2 +066900 PERFORM PASS NC2234.2 +067000 GO TO INI-WRITE-GF-2-8 NC2234.2 +067100 ELSE NC2234.2 +067200 GO TO INI-FAIL-GF-2-8. NC2234.2 +067300 INI-DELETE-GF-2-8. NC2234.2 +067400 PERFORM DE-LETE. NC2234.2 +067500 GO TO INI-WRITE-GF-2-8. NC2234.2 +067600 INI-FAIL-GF-2-8. NC2234.2 +067700 MOVE " $0.00" TO CORRECT-X NC2234.2 +067800 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +067900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +068000 TO RE-MARK NC2234.2 +068100 PERFORM FAIL. NC2234.2 +068200 INI-WRITE-GF-2-8. NC2234.2 +068300 PERFORM PRINT-DETAIL. NC2234.2 +068400* NC2234.2 +068500 INI-TEST-GF-2-9. NC2234.2 +068600 ADD 1 TO REC-CT. NC2234.2 +068700 MOVE "INI-TEST-GF-2-9" TO PAR-NAME. NC2234.2 +068800 IF TEST-1-8 = SPACES NC2234.2 +068900 PERFORM PASS NC2234.2 +069000 GO TO INI-WRITE-GF-2-9 NC2234.2 +069100 ELSE NC2234.2 +069200 GO TO INI-FAIL-GF-2-9. NC2234.2 +069300 INI-DELETE-GF-2-9. NC2234.2 +069400 PERFORM DE-LETE. NC2234.2 +069500 GO TO INI-WRITE-GF-2-9. NC2234.2 +069600 INI-FAIL-GF-2-9. NC2234.2 +069700 MOVE SPACES TO CORRECT-X NC2234.2 +069800 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +069900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +070000 TO RE-MARK NC2234.2 +070100 PERFORM FAIL. NC2234.2 +070200 INI-WRITE-GF-2-9. NC2234.2 +070300 PERFORM PRINT-DETAIL. NC2234.2 +070400* NC2234.2 +070500 INI-TEST-GF-2-10. NC2234.2 +070600 ADD 1 TO REC-CT. NC2234.2 +070700 MOVE "INI-TEST-GF-2-10" TO PAR-NAME. NC2234.2 +070800 IF TEST-1-9 = " / " NC2234.2 +070900 PERFORM PASS NC2234.2 +071000 GO TO INI-WRITE-GF-2-10 NC2234.2 +071100 ELSE NC2234.2 +071200 GO TO INI-FAIL-GF-2-10. NC2234.2 +071300 INI-DELETE-GF-2-10. NC2234.2 +071400 PERFORM DE-LETE. NC2234.2 +071500 GO TO INI-WRITE-GF-2-10. NC2234.2 +071600 INI-FAIL-GF-2-10. NC2234.2 +071700 MOVE " / " TO CORRECT-X NC2234.2 +071800 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +071900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +072000 TO RE-MARK NC2234.2 +072100 PERFORM FAIL. NC2234.2 +072200 INI-WRITE-GF-2-10. NC2234.2 +072300 PERFORM PRINT-DETAIL. NC2234.2 +072400* NC2234.2 +072500 INI-INIT-GF-3. NC2234.2 +072600 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +072700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +072800 MOVE 1 TO REC-CT. NC2234.2 +072900 INI-TEST-GF-3-0. NC2234.2 +073000 INITIALIZE TEST-1-DATA NC2234.2 +073100 REPLACING ALPHANUMERIC BY "**********". NC2234.2 +073200 GO TO INI-TEST-GF-3-1. NC2234.2 +073300 INI-DELETE-GF-3. NC2234.2 +073400 PERFORM DE-LETE. NC2234.2 +073500 PERFORM PRINT-DETAIL. NC2234.2 +073600 GO TO INI-INIT-GF-4. NC2234.2 +073700 INI-TEST-GF-3-1. NC2234.2 +073800 MOVE "INI-TEST-GF-3-1" TO PAR-NAME. NC2234.2 +073900 IF TEST-1-3 = "**********" NC2234.2 +074000 PERFORM PASS NC2234.2 +074100 GO TO INI-WRITE-GF-3-1 NC2234.2 +074200 ELSE NC2234.2 +074300 GO TO INI-FAIL-GF-3-1. NC2234.2 +074400 INI-DELETE-GF-3-1. NC2234.2 +074500 PERFORM DE-LETE. NC2234.2 +074600 GO TO INI-WRITE-GF-3-1. NC2234.2 +074700 INI-FAIL-GF-3-1. NC2234.2 +074800 MOVE "**********" TO CORRECT-X NC2234.2 +074900 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +075000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +075100 PERFORM FAIL. NC2234.2 +075200 INI-WRITE-GF-3-1. NC2234.2 +075300 PERFORM PRINT-DETAIL. NC2234.2 +075400* NC2234.2 +075500 INI-TEST-GF-3-2. NC2234.2 +075600 ADD 1 TO REC-CT. NC2234.2 +075700 MOVE "INI-TEST-GF-3-2" TO PAR-NAME. NC2234.2 +075800 IF TEST-1-8 = "**********" NC2234.2 +075900 PERFORM PASS NC2234.2 +076000 GO TO INI-WRITE-GF-3-2 NC2234.2 +076100 ELSE NC2234.2 +076200 GO TO INI-FAIL-GF-3-2. NC2234.2 +076300 INI-DELETE-GF-3-2. NC2234.2 +076400 PERFORM DE-LETE. NC2234.2 +076500 GO TO INI-WRITE-GF-3-2. NC2234.2 +076600 INI-FAIL-GF-3-2. NC2234.2 +076700 MOVE "**********" TO CORRECT-X NC2234.2 +076800 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +076900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +077000 PERFORM FAIL. NC2234.2 +077100 INI-WRITE-GF-3-2. NC2234.2 +077200 PERFORM PRINT-DETAIL. NC2234.2 +077300* NC2234.2 +077400 INI-TEST-GF-3-3. NC2234.2 +077500 ADD 1 TO REC-CT. NC2234.2 +077600 MOVE "INI-TEST-GF-3-3" TO PAR-NAME. NC2234.2 +077700 IF TEST-1-1 = ZERO NC2234.2 +077800 PERFORM PASS NC2234.2 +077900 GO TO INI-WRITE-GF-3-3 NC2234.2 +078000 ELSE NC2234.2 +078100 GO TO INI-FAIL-GF-3-3. NC2234.2 +078200 INI-DELETE-GF-3-3. NC2234.2 +078300 PERFORM DE-LETE. NC2234.2 +078400 GO TO INI-WRITE-GF-3-3. NC2234.2 +078500 INI-FAIL-GF-3-3. NC2234.2 +078600 MOVE ZERO TO CORRECT-N NC2234.2 +078700 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +078800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +078900 TO RE-MARK NC2234.2 +079000 PERFORM FAIL. NC2234.2 +079100 INI-WRITE-GF-3-3. NC2234.2 +079200 PERFORM PRINT-DETAIL. NC2234.2 +079300* NC2234.2 +079400 INI-TEST-GF-3-4. NC2234.2 +079500 ADD 1 TO REC-CT. NC2234.2 +079600 MOVE "INI-TEST-GF-3-4" TO PAR-NAME. NC2234.2 +079700 IF TEST-1-2 = " $0.00" NC2234.2 +079800 PERFORM PASS NC2234.2 +079900 GO TO INI-WRITE-GF-3-4 NC2234.2 +080000 ELSE NC2234.2 +080100 GO TO INI-FAIL-GF-3-4. NC2234.2 +080200 INI-DELETE-GF-3-4. NC2234.2 +080300 PERFORM DE-LETE. NC2234.2 +080400 GO TO INI-WRITE-GF-3-4. NC2234.2 +080500 INI-FAIL-GF-3-4. NC2234.2 +080600 MOVE " $0.00" TO CORRECT-X NC2234.2 +080700 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +080800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +080900 TO RE-MARK NC2234.2 +081000 PERFORM FAIL. NC2234.2 +081100 INI-WRITE-GF-3-4. NC2234.2 +081200 PERFORM PRINT-DETAIL. NC2234.2 +081300* NC2234.2 +081400 INI-TEST-GF-3-5. NC2234.2 +081500 ADD 1 TO REC-CT. NC2234.2 +081600 MOVE "INI-TEST-GF-3-5" TO PAR-NAME. NC2234.2 +081700 IF TEST-1-4 = " / " NC2234.2 +081800 PERFORM PASS NC2234.2 +081900 GO TO INI-WRITE-GF-3-5 NC2234.2 +082000 ELSE NC2234.2 +082100 GO TO INI-FAIL-GF-3-5. NC2234.2 +082200 INI-DELETE-GF-3-5. NC2234.2 +082300 PERFORM DE-LETE. NC2234.2 +082400 GO TO INI-WRITE-GF-3-5. NC2234.2 +082500 INI-FAIL-GF-3-5. NC2234.2 +082600 MOVE " / " TO CORRECT-X NC2234.2 +082700 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +082800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +082900 TO RE-MARK NC2234.2 +083000 PERFORM FAIL. NC2234.2 +083100 INI-WRITE-GF-3-5. NC2234.2 +083200 PERFORM PRINT-DETAIL. NC2234.2 +083300* NC2234.2 +083400 INI-TEST-GF-3-6. NC2234.2 +083500 ADD 1 TO REC-CT. NC2234.2 +083600 MOVE "INI-TEST-GF-3-6" TO PAR-NAME. NC2234.2 +083700 IF TEST-1-5 = "AAAAAA" NC2234.2 +083800 PERFORM PASS NC2234.2 +083900 GO TO INI-WRITE-GF-3-6 NC2234.2 +084000 ELSE NC2234.2 +084100 GO TO INI-FAIL-GF-3-6. NC2234.2 +084200 INI-DELETE-GF-3-6. NC2234.2 +084300 PERFORM DE-LETE. NC2234.2 +084400 GO TO INI-WRITE-GF-3-6. NC2234.2 +084500 INI-FAIL-GF-3-6. NC2234.2 +084600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +084700 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +084800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +084900 TO RE-MARK NC2234.2 +085000 PERFORM FAIL. NC2234.2 +085100 INI-WRITE-GF-3-6. NC2234.2 +085200 PERFORM PRINT-DETAIL. NC2234.2 +085300* NC2234.2 +085400 INI-TEST-GF-3-7. NC2234.2 +085500 ADD 1 TO REC-CT. NC2234.2 +085600 MOVE "INI-TEST-GF-3-7" TO PAR-NAME. NC2234.2 +085700 IF TEST-1-6 = ZERO NC2234.2 +085800 PERFORM PASS NC2234.2 +085900 GO TO INI-WRITE-GF-3-7 NC2234.2 +086000 ELSE NC2234.2 +086100 GO TO INI-FAIL-GF-3-7. NC2234.2 +086200 INI-DELETE-GF-3-7. NC2234.2 +086300 PERFORM DE-LETE. NC2234.2 +086400 GO TO INI-WRITE-GF-3-7. NC2234.2 +086500 INI-FAIL-GF-3-7. NC2234.2 +086600 MOVE ZERO TO CORRECT-N NC2234.2 +086700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +086800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +086900 TO RE-MARK NC2234.2 +087000 PERFORM FAIL. NC2234.2 +087100 INI-WRITE-GF-3-7. NC2234.2 +087200 PERFORM PRINT-DETAIL. NC2234.2 +087300* NC2234.2 +087400 INI-TEST-GF-3-8. NC2234.2 +087500 ADD 1 TO REC-CT. NC2234.2 +087600 MOVE "INI-TEST-GF-3-8" TO PAR-NAME. NC2234.2 +087700 IF TEST-1-7 = " $0.00" NC2234.2 +087800 PERFORM PASS NC2234.2 +087900 GO TO INI-WRITE-GF-3-8 NC2234.2 +088000 ELSE NC2234.2 +088100 GO TO INI-FAIL-GF-3-8. NC2234.2 +088200 INI-DELETE-GF-3-8. NC2234.2 +088300 PERFORM DE-LETE. NC2234.2 +088400 GO TO INI-WRITE-GF-3-8. NC2234.2 +088500 INI-FAIL-GF-3-8. NC2234.2 +088600 MOVE " $0.00" TO CORRECT-X NC2234.2 +088700 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +088800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +088900 TO RE-MARK NC2234.2 +089000 PERFORM FAIL. NC2234.2 +089100 INI-WRITE-GF-3-8. NC2234.2 +089200 PERFORM PRINT-DETAIL. NC2234.2 +089300* NC2234.2 +089400 INI-TEST-GF-3-9. NC2234.2 +089500 ADD 1 TO REC-CT. NC2234.2 +089600 MOVE "INI-TEST-GF-3-9" TO PAR-NAME. NC2234.2 +089700 IF TEST-1-9 = " / " NC2234.2 +089800 PERFORM PASS NC2234.2 +089900 GO TO INI-WRITE-GF-3-9 NC2234.2 +090000 ELSE NC2234.2 +090100 GO TO INI-FAIL-GF-3-9. NC2234.2 +090200 INI-DELETE-GF-3-9. NC2234.2 +090300 PERFORM DE-LETE. NC2234.2 +090400 GO TO INI-WRITE-GF-3-9. NC2234.2 +090500 INI-FAIL-GF-3-9. NC2234.2 +090600 MOVE " / " TO CORRECT-X NC2234.2 +090700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +090800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +090900 TO RE-MARK NC2234.2 +091000 PERFORM FAIL. NC2234.2 +091100 INI-WRITE-GF-3-9. NC2234.2 +091200 PERFORM PRINT-DETAIL. NC2234.2 +091300* NC2234.2 +091400 INI-TEST-GF-3-10. NC2234.2 +091500 ADD 1 TO REC-CT. NC2234.2 +091600 MOVE "INI-TEST-GF-3-10" TO PAR-NAME. NC2234.2 +091700 IF TEST-1-10 = "AAAAAA" NC2234.2 +091800 PERFORM PASS NC2234.2 +091900 GO TO INI-WRITE-GF-3-10 NC2234.2 +092000 ELSE NC2234.2 +092100 GO TO INI-FAIL-GF-3-10. NC2234.2 +092200 INI-DELETE-GF-3-10. NC2234.2 +092300 PERFORM DE-LETE. NC2234.2 +092400 GO TO INI-WRITE-GF-3-10. NC2234.2 +092500 INI-FAIL-GF-3-10. NC2234.2 +092600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +092700 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +092800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +092900 TO RE-MARK NC2234.2 +093000 PERFORM FAIL. NC2234.2 +093100 INI-WRITE-GF-3-10. NC2234.2 +093200 PERFORM PRINT-DETAIL. NC2234.2 +093300* NC2234.2 +093400 INI-INIT-GF-4. NC2234.2 +093500 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +093600 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +093700 MOVE 1 TO REC-CT. NC2234.2 +093800 INI-TEST-GF-4-0. NC2234.2 +093900 INITIALIZE TEST-1-DATA NC2234.2 +094000 REPLACING ALPHANUMERIC-EDITED BY "DDDDDD". NC2234.2 +094100 GO TO INI-TEST-GF-4-1. NC2234.2 +094200 INI-DELETE-GF-4. NC2234.2 +094300 PERFORM DE-LETE. NC2234.2 +094400 PERFORM PRINT-DETAIL. NC2234.2 +094500 GO TO INI-INIT-GF-5. NC2234.2 +094600 INI-TEST-GF-4-1. NC2234.2 +094700 MOVE "INI-TEST-GF-4-1" TO PAR-NAME. NC2234.2 +094800 IF TEST-1-4 = "DD DD/DD" NC2234.2 +094900 PERFORM PASS NC2234.2 +095000 GO TO INI-WRITE-GF-4-1 NC2234.2 +095100 ELSE NC2234.2 +095200 GO TO INI-FAIL-GF-4-1. NC2234.2 +095300 INI-DELETE-GF-4-1. NC2234.2 +095400 PERFORM DE-LETE. NC2234.2 +095500 GO TO INI-WRITE-GF-4-1. NC2234.2 +095600 INI-FAIL-GF-4-1. NC2234.2 +095700 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +095800 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +095900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +096000 PERFORM FAIL. NC2234.2 +096100 INI-WRITE-GF-4-1. NC2234.2 +096200 PERFORM PRINT-DETAIL. NC2234.2 +096300* NC2234.2 +096400 INI-TEST-GF-4-2. NC2234.2 +096500 ADD 1 TO REC-CT. NC2234.2 +096600 MOVE "INI-TEST-GF-4-2" TO PAR-NAME. NC2234.2 +096700 IF TEST-1-9 = "DD DD/DD" NC2234.2 +096800 PERFORM PASS NC2234.2 +096900 GO TO INI-WRITE-GF-4-2 NC2234.2 +097000 ELSE NC2234.2 +097100 GO TO INI-FAIL-GF-4-2. NC2234.2 +097200 INI-DELETE-GF-4-2. NC2234.2 +097300 PERFORM DE-LETE. NC2234.2 +097400 GO TO INI-WRITE-GF-4-2. NC2234.2 +097500 INI-FAIL-GF-4-2. NC2234.2 +097600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +097700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +097800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +097900 PERFORM FAIL. NC2234.2 +098000 INI-WRITE-GF-4-2. NC2234.2 +098100 PERFORM PRINT-DETAIL. NC2234.2 +098200* NC2234.2 +098300 INI-TEST-GF-4-3. NC2234.2 +098400 ADD 1 TO REC-CT. NC2234.2 +098500 MOVE "INI-TEST-GF-4-3" TO PAR-NAME. NC2234.2 +098600 IF TEST-1-1 = ZERO NC2234.2 +098700 PERFORM PASS NC2234.2 +098800 GO TO INI-WRITE-GF-4-3 NC2234.2 +098900 ELSE NC2234.2 +099000 GO TO INI-FAIL-GF-4-3. NC2234.2 +099100 INI-DELETE-GF-4-3. NC2234.2 +099200 PERFORM DE-LETE. NC2234.2 +099300 GO TO INI-WRITE-GF-4-3. NC2234.2 +099400 INI-FAIL-GF-4-3. NC2234.2 +099500 MOVE ZERO TO CORRECT-N NC2234.2 +099600 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +099700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +099800 TO RE-MARK NC2234.2 +099900 PERFORM FAIL. NC2234.2 +100000 INI-WRITE-GF-4-3. NC2234.2 +100100 PERFORM PRINT-DETAIL. NC2234.2 +100200* NC2234.2 +100300 INI-TEST-GF-4-4. NC2234.2 +100400 ADD 1 TO REC-CT. NC2234.2 +100500 MOVE "INI-TEST-GF-4-4" TO PAR-NAME. NC2234.2 +100600 IF TEST-1-2 = " $0.00" NC2234.2 +100700 PERFORM PASS NC2234.2 +100800 GO TO INI-WRITE-GF-4-4 NC2234.2 +100900 ELSE NC2234.2 +101000 GO TO INI-FAIL-GF-4-4. NC2234.2 +101100 INI-DELETE-GF-4-4. NC2234.2 +101200 PERFORM DE-LETE. NC2234.2 +101300 GO TO INI-WRITE-GF-4-4. NC2234.2 +101400 INI-FAIL-GF-4-4. NC2234.2 +101500 MOVE " $0.00" TO CORRECT-X NC2234.2 +101600 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +101700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +101800 TO RE-MARK NC2234.2 +101900 PERFORM FAIL. NC2234.2 +102000 INI-WRITE-GF-4-4. NC2234.2 +102100 PERFORM PRINT-DETAIL. NC2234.2 +102200* NC2234.2 +102300 INI-TEST-GF-4-5. NC2234.2 +102400 ADD 1 TO REC-CT. NC2234.2 +102500 MOVE "INI-TEST-GF-4-5" TO PAR-NAME. NC2234.2 +102600 IF TEST-1-3 = "**********" NC2234.2 +102700 PERFORM PASS NC2234.2 +102800 GO TO INI-WRITE-GF-4-5 NC2234.2 +102900 ELSE NC2234.2 +103000 GO TO INI-FAIL-GF-4-5. NC2234.2 +103100 INI-DELETE-GF-4-5. NC2234.2 +103200 PERFORM DE-LETE. NC2234.2 +103300 GO TO INI-WRITE-GF-4-5. NC2234.2 +103400 INI-FAIL-GF-4-5. NC2234.2 +103500 MOVE "**********" TO CORRECT-X NC2234.2 +103600 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +103700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +103800 TO RE-MARK NC2234.2 +103900 PERFORM FAIL. NC2234.2 +104000 INI-WRITE-GF-4-5. NC2234.2 +104100 PERFORM PRINT-DETAIL. NC2234.2 +104200* NC2234.2 +104300 INI-TEST-GF-4-6. NC2234.2 +104400 ADD 1 TO REC-CT. NC2234.2 +104500 MOVE "INI-TEST-GF-4-6" TO PAR-NAME. NC2234.2 +104600 IF TEST-1-5 = "AAAAAA" NC2234.2 +104700 PERFORM PASS NC2234.2 +104800 GO TO INI-WRITE-GF-4-6 NC2234.2 +104900 ELSE NC2234.2 +105000 GO TO INI-FAIL-GF-4-6. NC2234.2 +105100 INI-DELETE-GF-4-6. NC2234.2 +105200 PERFORM DE-LETE. NC2234.2 +105300 GO TO INI-WRITE-GF-4-6. NC2234.2 +105400 INI-FAIL-GF-4-6. NC2234.2 +105500 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +105600 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +105700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +105800 TO RE-MARK NC2234.2 +105900 PERFORM FAIL. NC2234.2 +106000 INI-WRITE-GF-4-6. NC2234.2 +106100 PERFORM PRINT-DETAIL. NC2234.2 +106200* NC2234.2 +106300 INI-TEST-GF-4-7. NC2234.2 +106400 ADD 1 TO REC-CT. NC2234.2 +106500 MOVE "INI-TEST-GF-4-7" TO PAR-NAME. NC2234.2 +106600 IF TEST-1-6 = ZERO NC2234.2 +106700 PERFORM PASS NC2234.2 +106800 GO TO INI-WRITE-GF-4-7 NC2234.2 +106900 ELSE NC2234.2 +107000 GO TO INI-FAIL-GF-4-7. NC2234.2 +107100 INI-DELETE-GF-4-7. NC2234.2 +107200 PERFORM DE-LETE. NC2234.2 +107300 GO TO INI-WRITE-GF-4-7. NC2234.2 +107400 INI-FAIL-GF-4-7. NC2234.2 +107500 MOVE ZERO TO CORRECT-N NC2234.2 +107600 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +107700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +107800 TO RE-MARK NC2234.2 +107900 PERFORM FAIL. NC2234.2 +108000 INI-WRITE-GF-4-7. NC2234.2 +108100 PERFORM PRINT-DETAIL. NC2234.2 +108200* NC2234.2 +108300 INI-TEST-GF-4-8. NC2234.2 +108400 ADD 1 TO REC-CT. NC2234.2 +108500 MOVE "INI-TEST-GF-4-8" TO PAR-NAME. NC2234.2 +108600 IF TEST-1-7 = " $0.00" NC2234.2 +108700 PERFORM PASS NC2234.2 +108800 GO TO INI-WRITE-GF-4-8 NC2234.2 +108900 ELSE NC2234.2 +109000 GO TO INI-FAIL-GF-4-8. NC2234.2 +109100 INI-DELETE-GF-4-8. NC2234.2 +109200 PERFORM DE-LETE. NC2234.2 +109300 GO TO INI-WRITE-GF-4-8. NC2234.2 +109400 INI-FAIL-GF-4-8. NC2234.2 +109500 MOVE " $0.00" TO CORRECT-X NC2234.2 +109600 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +109700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +109800 TO RE-MARK NC2234.2 +109900 PERFORM FAIL. NC2234.2 +110000 INI-WRITE-GF-4-8. NC2234.2 +110100 PERFORM PRINT-DETAIL. NC2234.2 +110200* NC2234.2 +110300 INI-TEST-GF-4-9. NC2234.2 +110400 ADD 1 TO REC-CT. NC2234.2 +110500 MOVE "INI-TEST-GF-4-9" TO PAR-NAME. NC2234.2 +110600 IF TEST-1-8 = "**********" NC2234.2 +110700 PERFORM PASS NC2234.2 +110800 GO TO INI-WRITE-GF-4-9 NC2234.2 +110900 ELSE NC2234.2 +111000 GO TO INI-FAIL-GF-4-9. NC2234.2 +111100 INI-DELETE-GF-4-9. NC2234.2 +111200 PERFORM DE-LETE. NC2234.2 +111300 GO TO INI-WRITE-GF-4-9. NC2234.2 +111400 INI-FAIL-GF-4-9. NC2234.2 +111500 MOVE "**********" TO CORRECT-X NC2234.2 +111600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +111700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +111800 TO RE-MARK NC2234.2 +111900 PERFORM FAIL. NC2234.2 +112000 INI-WRITE-GF-4-9. NC2234.2 +112100 PERFORM PRINT-DETAIL. NC2234.2 +112200* NC2234.2 +112300 INI-TEST-GF-4-10. NC2234.2 +112400 ADD 1 TO REC-CT. NC2234.2 +112500 MOVE "INI-TEST-GF-4-10" TO PAR-NAME. NC2234.2 +112600 IF TEST-1-10 = "AAAAAA" NC2234.2 +112700 PERFORM PASS NC2234.2 +112800 GO TO INI-WRITE-GF-4-10 NC2234.2 +112900 ELSE NC2234.2 +113000 GO TO INI-FAIL-GF-4-10. NC2234.2 +113100 INI-DELETE-GF-4-10. NC2234.2 +113200 PERFORM DE-LETE. NC2234.2 +113300 GO TO INI-WRITE-GF-4-10. NC2234.2 +113400 INI-FAIL-GF-4-10. NC2234.2 +113500 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +113600 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +113700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +113800 TO RE-MARK NC2234.2 +113900 PERFORM FAIL. NC2234.2 +114000 INI-WRITE-GF-4-10. NC2234.2 +114100 PERFORM PRINT-DETAIL. NC2234.2 +114200* NC2234.2 +114300 INI-INIT-GF-5. NC2234.2 +114400 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +114500 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +114600 MOVE 1 TO REC-CT. NC2234.2 +114700 INI-TEST-GF-5-0. NC2234.2 +114800 INITIALIZE TEST-1-DATA NC2234.2 +114900 REPLACING NUMERIC DATA BY 1234. NC2234.2 +115000 GO TO INI-TEST-GF-5-1. NC2234.2 +115100 INI-DELETE-GF-5. NC2234.2 +115200 PERFORM DE-LETE. NC2234.2 +115300 PERFORM PRINT-DETAIL. NC2234.2 +115400 GO TO INI-INIT-GF-6. NC2234.2 +115500 INI-TEST-GF-5-1. NC2234.2 +115600 MOVE "INI-TEST-GF-5-1" TO PAR-NAME. NC2234.2 +115700 IF TEST-1-1 = 001234 NC2234.2 +115800 PERFORM PASS NC2234.2 +115900 GO TO INI-WRITE-GF-5-1 NC2234.2 +116000 ELSE NC2234.2 +116100 GO TO INI-FAIL-GF-5-1. NC2234.2 +116200 INI-DELETE-GF-5-1. NC2234.2 +116300 PERFORM DE-LETE. NC2234.2 +116400 GO TO INI-WRITE-GF-5-1. NC2234.2 +116500 INI-FAIL-GF-5-1. NC2234.2 +116600 MOVE 001234 TO CORRECT-N NC2234.2 +116700 MOVE TEST-1-1 TO COMPUTED-N NC2234.2 +116800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +116900 PERFORM FAIL. NC2234.2 +117000 INI-WRITE-GF-5-1. NC2234.2 +117100 PERFORM PRINT-DETAIL. NC2234.2 +117200* NC2234.2 +117300 INI-TEST-GF-5-2. NC2234.2 +117400 ADD 1 TO REC-CT. NC2234.2 +117500 MOVE "INI-TEST-GF-5-2" TO PAR-NAME. NC2234.2 +117600 IF TEST-1-6 = 001234 NC2234.2 +117700 PERFORM PASS NC2234.2 +117800 GO TO INI-WRITE-GF-5-2 NC2234.2 +117900 ELSE NC2234.2 +118000 GO TO INI-FAIL-GF-5-2. NC2234.2 +118100 INI-DELETE-GF-5-2. NC2234.2 +118200 PERFORM DE-LETE. NC2234.2 +118300 GO TO INI-WRITE-GF-5-2. NC2234.2 +118400 INI-FAIL-GF-5-2. NC2234.2 +118500 MOVE 001234 TO CORRECT-N NC2234.2 +118600 MOVE TEST-1-6 TO COMPUTED-N NC2234.2 +118700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +118800 PERFORM FAIL. NC2234.2 +118900 INI-WRITE-GF-5-2. NC2234.2 +119000 PERFORM PRINT-DETAIL. NC2234.2 +119100* NC2234.2 +119200 INI-TEST-GF-5-3. NC2234.2 +119300 ADD 1 TO REC-CT. NC2234.2 +119400 MOVE "INI-TEST-GF-5-3" TO PAR-NAME. NC2234.2 +119500 IF TEST-1-2 = " $0.00" NC2234.2 +119600 PERFORM PASS NC2234.2 +119700 GO TO INI-WRITE-GF-5-3 NC2234.2 +119800 ELSE NC2234.2 +119900 GO TO INI-FAIL-GF-5-3. NC2234.2 +120000 INI-DELETE-GF-5-3. NC2234.2 +120100 PERFORM DE-LETE. NC2234.2 +120200 GO TO INI-WRITE-GF-5-3. NC2234.2 +120300 INI-FAIL-GF-5-3. NC2234.2 +120400 MOVE " $0.00" TO CORRECT-X NC2234.2 +120500 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +120600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +120700 TO RE-MARK NC2234.2 +120800 PERFORM FAIL. NC2234.2 +120900 INI-WRITE-GF-5-3. NC2234.2 +121000 PERFORM PRINT-DETAIL. NC2234.2 +121100* NC2234.2 +121200 INI-TEST-GF-5-4. NC2234.2 +121300 ADD 1 TO REC-CT. NC2234.2 +121400 MOVE "INI-TEST-GF-5-4" TO PAR-NAME. NC2234.2 +121500 IF TEST-1-3 = "**********" NC2234.2 +121600 PERFORM PASS NC2234.2 +121700 GO TO INI-WRITE-GF-5-4 NC2234.2 +121800 ELSE NC2234.2 +121900 GO TO INI-FAIL-GF-5-4. NC2234.2 +122000 INI-DELETE-GF-5-4. NC2234.2 +122100 PERFORM DE-LETE. NC2234.2 +122200 GO TO INI-WRITE-GF-5-4. NC2234.2 +122300 INI-FAIL-GF-5-4. NC2234.2 +122400 MOVE "**********" TO CORRECT-X NC2234.2 +122500 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +122600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +122700 TO RE-MARK NC2234.2 +122800 PERFORM FAIL. NC2234.2 +122900 INI-WRITE-GF-5-4. NC2234.2 +123000 PERFORM PRINT-DETAIL. NC2234.2 +123100* NC2234.2 +123200 INI-TEST-GF-5-5. NC2234.2 +123300 ADD 1 TO REC-CT. NC2234.2 +123400 MOVE "INI-TEST-GF-5-5" TO PAR-NAME. NC2234.2 +123500 IF TEST-1-4 = "DD DD/DD" NC2234.2 +123600 PERFORM PASS NC2234.2 +123700 GO TO INI-WRITE-GF-5-5 NC2234.2 +123800 ELSE NC2234.2 +123900 GO TO INI-FAIL-GF-5-5. NC2234.2 +124000 INI-DELETE-GF-5-5. NC2234.2 +124100 PERFORM DE-LETE. NC2234.2 +124200 GO TO INI-WRITE-GF-5-5. NC2234.2 +124300 INI-FAIL-GF-5-5. NC2234.2 +124400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +124500 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +124600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +124700 TO RE-MARK NC2234.2 +124800 PERFORM FAIL. NC2234.2 +124900 INI-WRITE-GF-5-5. NC2234.2 +125000 PERFORM PRINT-DETAIL. NC2234.2 +125100* NC2234.2 +125200 INI-TEST-GF-5-6. NC2234.2 +125300 ADD 1 TO REC-CT. NC2234.2 +125400 MOVE "INI-TEST-GF-5-6" TO PAR-NAME. NC2234.2 +125500 IF TEST-1-5 = "AAAAAA" NC2234.2 +125600 PERFORM PASS NC2234.2 +125700 GO TO INI-WRITE-GF-5-6 NC2234.2 +125800 ELSE NC2234.2 +125900 GO TO INI-FAIL-GF-5-6. NC2234.2 +126000 INI-DELETE-GF-5-6. NC2234.2 +126100 PERFORM DE-LETE. NC2234.2 +126200 GO TO INI-WRITE-GF-5-6. NC2234.2 +126300 INI-FAIL-GF-5-6. NC2234.2 +126400 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +126500 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +126600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +126700 TO RE-MARK NC2234.2 +126800 PERFORM FAIL. NC2234.2 +126900 INI-WRITE-GF-5-6. NC2234.2 +127000 PERFORM PRINT-DETAIL. NC2234.2 +127100* NC2234.2 +127200 INI-TEST-GF-5-7. NC2234.2 +127300 ADD 1 TO REC-CT. NC2234.2 +127400 MOVE "INI-TEST-GF-5-7" TO PAR-NAME. NC2234.2 +127500 IF TEST-1-7 = " $0.00" NC2234.2 +127600 PERFORM PASS NC2234.2 +127700 GO TO INI-WRITE-GF-5-7 NC2234.2 +127800 ELSE NC2234.2 +127900 GO TO INI-FAIL-GF-5-7. NC2234.2 +128000 INI-DELETE-GF-5-7. NC2234.2 +128100 PERFORM DE-LETE. NC2234.2 +128200 GO TO INI-WRITE-GF-5-7. NC2234.2 +128300 INI-FAIL-GF-5-7. NC2234.2 +128400 MOVE " $0.00" TO CORRECT-X NC2234.2 +128500 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +128600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +128700 TO RE-MARK NC2234.2 +128800 PERFORM FAIL. NC2234.2 +128900 INI-WRITE-GF-5-7. NC2234.2 +129000 PERFORM PRINT-DETAIL. NC2234.2 +129100* NC2234.2 +129200 INI-TEST-GF-5-8. NC2234.2 +129300 ADD 1 TO REC-CT. NC2234.2 +129400 MOVE "INI-TEST-GF-5-8" TO PAR-NAME. NC2234.2 +129500 IF TEST-1-8 = "**********" NC2234.2 +129600 PERFORM PASS NC2234.2 +129700 GO TO INI-WRITE-GF-5-8 NC2234.2 +129800 ELSE NC2234.2 +129900 GO TO INI-FAIL-GF-5-8. NC2234.2 +130000 INI-DELETE-GF-5-8. NC2234.2 +130100 PERFORM DE-LETE. NC2234.2 +130200 GO TO INI-WRITE-GF-5-8. NC2234.2 +130300 INI-FAIL-GF-5-8. NC2234.2 +130400 MOVE "**********" TO CORRECT-X NC2234.2 +130500 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +130600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +130700 TO RE-MARK NC2234.2 +130800 PERFORM FAIL. NC2234.2 +130900 INI-WRITE-GF-5-8. NC2234.2 +131000 PERFORM PRINT-DETAIL. NC2234.2 +131100* NC2234.2 +131200 INI-TEST-GF-5-9. NC2234.2 +131300 ADD 1 TO REC-CT. NC2234.2 +131400 MOVE "INI-TEST-GF-5-9" TO PAR-NAME. NC2234.2 +131500 IF TEST-1-9 = "DD DD/DD" NC2234.2 +131600 PERFORM PASS NC2234.2 +131700 GO TO INI-WRITE-GF-5-9 NC2234.2 +131800 ELSE NC2234.2 +131900 GO TO INI-FAIL-GF-5-9. NC2234.2 +132000 INI-DELETE-GF-5-9. NC2234.2 +132100 PERFORM DE-LETE. NC2234.2 +132200 GO TO INI-WRITE-GF-5-9. NC2234.2 +132300 INI-FAIL-GF-5-9. NC2234.2 +132400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +132500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +132600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +132700 TO RE-MARK NC2234.2 +132800 PERFORM FAIL. NC2234.2 +132900 INI-WRITE-GF-5-9. NC2234.2 +133000 PERFORM PRINT-DETAIL. NC2234.2 +133100* NC2234.2 +133200 INI-TEST-GF-5-10. NC2234.2 +133300 ADD 1 TO REC-CT. NC2234.2 +133400 MOVE "INI-TEST-GF-5-10" TO PAR-NAME. NC2234.2 +133500 IF TEST-1-10 = "AAAAAA" NC2234.2 +133600 PERFORM PASS NC2234.2 +133700 GO TO INI-WRITE-GF-5-10 NC2234.2 +133800 ELSE NC2234.2 +133900 GO TO INI-FAIL-GF-5-10. NC2234.2 +134000 INI-DELETE-GF-5-10. NC2234.2 +134100 PERFORM DE-LETE. NC2234.2 +134200 GO TO INI-WRITE-GF-5-10. NC2234.2 +134300 INI-FAIL-GF-5-10. NC2234.2 +134400 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +134500 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +134600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +134700 TO RE-MARK NC2234.2 +134800 PERFORM FAIL. NC2234.2 +134900 INI-WRITE-GF-5-10. NC2234.2 +135000 PERFORM PRINT-DETAIL. NC2234.2 +135100* NC2234.2 +135200 INI-INIT-GF-6. NC2234.2 +135300 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +135400 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +135500 MOVE 1 TO REC-CT. NC2234.2 +135600 INI-TEST-GF-6-0. NC2234.2 +135700 INITIALIZE TEST-1-DATA NC2234.2 +135800 REPLACING NUMERIC-EDITED DATA BY NUM-1234. NC2234.2 +135900 GO TO INI-TEST-GF-6-1. NC2234.2 +136000 INI-DELETE-GF-6. NC2234.2 +136100 PERFORM DE-LETE. NC2234.2 +136200 PERFORM PRINT-DETAIL. NC2234.2 +136300 GO TO INI-INIT-GF-7. NC2234.2 +136400 INI-TEST-GF-6-1. NC2234.2 +136500 MOVE "INI-TEST-GF-6-1" TO PAR-NAME. NC2234.2 +136600 IF TEST-1-2 = "$234.00" NC2234.2 +136700 PERFORM PASS NC2234.2 +136800 GO TO INI-WRITE-GF-6-1 NC2234.2 +136900 ELSE NC2234.2 +137000 GO TO INI-FAIL-GF-6-1. NC2234.2 +137100 INI-DELETE-GF-6-1. NC2234.2 +137200 PERFORM DE-LETE. NC2234.2 +137300 GO TO INI-WRITE-GF-6-1. NC2234.2 +137400 INI-FAIL-GF-6-1. NC2234.2 +137500 MOVE "$234.00" TO CORRECT-X NC2234.2 +137600 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +137700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +137800 PERFORM FAIL. NC2234.2 +137900 INI-WRITE-GF-6-1. NC2234.2 +138000 PERFORM PRINT-DETAIL. NC2234.2 +138100* NC2234.2 +138200 INI-TEST-GF-6-2. NC2234.2 +138300 ADD 1 TO REC-CT. NC2234.2 +138400 MOVE "INI-TEST-GF-6-2" TO PAR-NAME. NC2234.2 +138500 IF TEST-1-7 = "$234.00" NC2234.2 +138600 PERFORM PASS NC2234.2 +138700 GO TO INI-WRITE-GF-6-2 NC2234.2 +138800 ELSE NC2234.2 +138900 GO TO INI-FAIL-GF-6-2. NC2234.2 +139000 INI-DELETE-GF-6-2. NC2234.2 +139100 PERFORM DE-LETE. NC2234.2 +139200 GO TO INI-WRITE-GF-6-2. NC2234.2 +139300 INI-FAIL-GF-6-2. NC2234.2 +139400 MOVE "$234.00" TO CORRECT-X NC2234.2 +139500 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +139600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +139700 PERFORM FAIL. NC2234.2 +139800 INI-WRITE-GF-6-2. NC2234.2 +139900 PERFORM PRINT-DETAIL. NC2234.2 +140000* NC2234.2 +140100 INI-TEST-GF-6-3. NC2234.2 +140200 ADD 1 TO REC-CT. NC2234.2 +140300 MOVE "INI-TEST-GF-6-3" TO PAR-NAME. NC2234.2 +140400 IF TEST-1-1 = 001234 NC2234.2 +140500 PERFORM PASS NC2234.2 +140600 GO TO INI-WRITE-GF-6-3 NC2234.2 +140700 ELSE NC2234.2 +140800 GO TO INI-FAIL-GF-6-3. NC2234.2 +140900 INI-DELETE-GF-6-3. NC2234.2 +141000 PERFORM DE-LETE. NC2234.2 +141100 GO TO INI-WRITE-GF-6-3. NC2234.2 +141200 INI-FAIL-GF-6-3. NC2234.2 +141300 MOVE 001234 TO CORRECT-N NC2234.2 +141400 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +141500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +141600 TO RE-MARK NC2234.2 +141700 PERFORM FAIL. NC2234.2 +141800 INI-WRITE-GF-6-3. NC2234.2 +141900 PERFORM PRINT-DETAIL. NC2234.2 +142000* NC2234.2 +142100 INI-TEST-GF-6-4. NC2234.2 +142200 ADD 1 TO REC-CT. NC2234.2 +142300 MOVE "INI-TEST-GF-6-4" TO PAR-NAME. NC2234.2 +142400 IF TEST-1-3 = "**********" NC2234.2 +142500 PERFORM PASS NC2234.2 +142600 GO TO INI-WRITE-GF-6-4 NC2234.2 +142700 ELSE NC2234.2 +142800 GO TO INI-FAIL-GF-6-4. NC2234.2 +142900 INI-DELETE-GF-6-4. NC2234.2 +143000 PERFORM DE-LETE. NC2234.2 +143100 GO TO INI-WRITE-GF-6-4. NC2234.2 +143200 INI-FAIL-GF-6-4. NC2234.2 +143300 MOVE "**********" TO CORRECT-X NC2234.2 +143400 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +143500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +143600 TO RE-MARK NC2234.2 +143700 PERFORM FAIL. NC2234.2 +143800 INI-WRITE-GF-6-4. NC2234.2 +143900 PERFORM PRINT-DETAIL. NC2234.2 +144000* NC2234.2 +144100 INI-TEST-GF-6-5. NC2234.2 +144200 ADD 1 TO REC-CT. NC2234.2 +144300 MOVE "INI-TEST-GF-6-5" TO PAR-NAME. NC2234.2 +144400 IF TEST-1-4 = "DD DD/DD" NC2234.2 +144500 PERFORM PASS NC2234.2 +144600 GO TO INI-WRITE-GF-6-5 NC2234.2 +144700 ELSE NC2234.2 +144800 GO TO INI-FAIL-GF-6-5. NC2234.2 +144900 INI-DELETE-GF-6-5. NC2234.2 +145000 PERFORM DE-LETE. NC2234.2 +145100 GO TO INI-WRITE-GF-6-5. NC2234.2 +145200 INI-FAIL-GF-6-5. NC2234.2 +145300 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +145400 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +145500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +145600 TO RE-MARK NC2234.2 +145700 PERFORM FAIL. NC2234.2 +145800 INI-WRITE-GF-6-5. NC2234.2 +145900 PERFORM PRINT-DETAIL. NC2234.2 +146000* NC2234.2 +146100 INI-TEST-GF-6-6. NC2234.2 +146200 ADD 1 TO REC-CT. NC2234.2 +146300 MOVE "INI-TEST-GF-6-6" TO PAR-NAME. NC2234.2 +146400 IF TEST-1-5 = "AAAAAA" NC2234.2 +146500 PERFORM PASS NC2234.2 +146600 GO TO INI-WRITE-GF-6-6 NC2234.2 +146700 ELSE NC2234.2 +146800 GO TO INI-FAIL-GF-6-6. NC2234.2 +146900 INI-DELETE-GF-6-6. NC2234.2 +147000 PERFORM DE-LETE. NC2234.2 +147100 GO TO INI-WRITE-GF-6-6. NC2234.2 +147200 INI-FAIL-GF-6-6. NC2234.2 +147300 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +147400 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +147500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +147600 TO RE-MARK NC2234.2 +147700 PERFORM FAIL. NC2234.2 +147800 INI-WRITE-GF-6-6. NC2234.2 +147900 PERFORM PRINT-DETAIL. NC2234.2 +148000* NC2234.2 +148100 INI-TEST-GF-6-7. NC2234.2 +148200 ADD 1 TO REC-CT. NC2234.2 +148300 MOVE "INI-TEST-GF-6-7" TO PAR-NAME. NC2234.2 +148400 IF TEST-1-6 = 1234 NC2234.2 +148500 PERFORM PASS NC2234.2 +148600 GO TO INI-WRITE-GF-6-7 NC2234.2 +148700 ELSE NC2234.2 +148800 GO TO INI-FAIL-GF-6-7. NC2234.2 +148900 INI-DELETE-GF-6-7. NC2234.2 +149000 PERFORM DE-LETE. NC2234.2 +149100 GO TO INI-WRITE-GF-6-7. NC2234.2 +149200 INI-FAIL-GF-6-7. NC2234.2 +149300 MOVE 1234 TO CORRECT-N NC2234.2 +149400 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +149500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +149600 TO RE-MARK NC2234.2 +149700 PERFORM FAIL. NC2234.2 +149800 INI-WRITE-GF-6-7. NC2234.2 +149900 PERFORM PRINT-DETAIL. NC2234.2 +150000* NC2234.2 +150100 INI-TEST-GF-6-8. NC2234.2 +150200 ADD 1 TO REC-CT. NC2234.2 +150300 MOVE "INI-TEST-GF-6-8" TO PAR-NAME. NC2234.2 +150400 IF TEST-1-8 = "**********" NC2234.2 +150500 PERFORM PASS NC2234.2 +150600 GO TO INI-WRITE-GF-6-8 NC2234.2 +150700 ELSE NC2234.2 +150800 GO TO INI-FAIL-GF-6-8. NC2234.2 +150900 INI-DELETE-GF-6-8. NC2234.2 +151000 PERFORM DE-LETE. NC2234.2 +151100 GO TO INI-WRITE-GF-6-8. NC2234.2 +151200 INI-FAIL-GF-6-8. NC2234.2 +151300 MOVE "**********" TO CORRECT-X NC2234.2 +151400 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +151500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +151600 TO RE-MARK NC2234.2 +151700 PERFORM FAIL. NC2234.2 +151800 INI-WRITE-GF-6-8. NC2234.2 +151900 PERFORM PRINT-DETAIL. NC2234.2 +152000* NC2234.2 +152100 INI-TEST-GF-6-9. NC2234.2 +152200 ADD 1 TO REC-CT. NC2234.2 +152300 MOVE "INI-TEST-GF-6-9" TO PAR-NAME. NC2234.2 +152400 IF TEST-1-9 = "DD DD/DD" NC2234.2 +152500 PERFORM PASS NC2234.2 +152600 GO TO INI-WRITE-GF-6-9 NC2234.2 +152700 ELSE NC2234.2 +152800 GO TO INI-FAIL-GF-6-9. NC2234.2 +152900 INI-DELETE-GF-6-9. NC2234.2 +153000 PERFORM DE-LETE. NC2234.2 +153100 GO TO INI-WRITE-GF-6-9. NC2234.2 +153200 INI-FAIL-GF-6-9. NC2234.2 +153300 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +153400 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +153500 TO RE-MARK NC2234.2 +153600 PERFORM FAIL. NC2234.2 +153700 INI-WRITE-GF-6-9. NC2234.2 +153800 PERFORM PRINT-DETAIL. NC2234.2 +153900* NC2234.2 +154000 INI-TEST-GF-6-10. NC2234.2 +154100 ADD 1 TO REC-CT. NC2234.2 +154200 MOVE "INI-TEST-GF-6-10" TO PAR-NAME. NC2234.2 +154300 IF TEST-1-10 = "AAAAAA" NC2234.2 +154400 PERFORM PASS NC2234.2 +154500 GO TO INI-WRITE-GF-6-10 NC2234.2 +154600 ELSE NC2234.2 +154700 GO TO INI-FAIL-GF-6-10. NC2234.2 +154800 INI-DELETE-GF-6-10. NC2234.2 +154900 PERFORM DE-LETE. NC2234.2 +155000 GO TO INI-WRITE-GF-6-10. NC2234.2 +155100 INI-FAIL-GF-6-10. NC2234.2 +155200 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +155300 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +155400 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +155500 TO RE-MARK NC2234.2 +155600 PERFORM FAIL. NC2234.2 +155700 INI-WRITE-GF-6-10. NC2234.2 +155800 PERFORM PRINT-DETAIL. NC2234.2 +155900* NC2234.2 +156000 INI-INIT-GF-7. NC2234.2 +156100* ===--> MULTIPLE "REPLACING" PHRASES" <--=== NC2234.2 +156200 MOVE "VI-91 6.16.2" TO ANSI-REFERENCE. NC2234.2 +156300 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +156400 MOVE 1 TO REC-CT. NC2234.2 +156500 MOVE ZEROS TO TEST-1-1. NC2234.2 +156600 MOVE ZEROS TO TEST-1-2. NC2234.2 +156700 MOVE SPACES TO TEST-1-3. NC2234.2 +156800 MOVE SPACES TO TEST-1-4. NC2234.2 +156900 MOVE SPACES TO TEST-1-5. NC2234.2 +157000 MOVE ZEROS TO TEST-1-6. NC2234.2 +157100 MOVE ZEROS TO TEST-1-7. NC2234.2 +157200 MOVE SPACES TO TEST-1-8. NC2234.2 +157300 MOVE SPACES TO TEST-1-9. NC2234.2 +157400 MOVE SPACES TO TEST-1-10. NC2234.2 +157500 INI-TEST-GF-7-0. NC2234.2 +157600 INITIALIZE TEST-1-DATA NC2234.2 +157700 REPLACING ALPHABETIC DATA BY "AAAAAA" NC2234.2 +157800 ALPHANUMERIC BY "**********" NC2234.2 +157900 ALPHANUMERIC-EDITED BY "DDDDDD" NC2234.2 +158000 NUMERIC DATA BY 1234 NC2234.2 +158100 NUMERIC-EDITED BY NUM-1234. NC2234.2 +158200 GO TO INI-TEST-GF-7-1. NC2234.2 +158300 INI-DELETE-GF-7. NC2234.2 +158400 PERFORM DE-LETE. NC2234.2 +158500 PERFORM PRINT-DETAIL. NC2234.2 +158600 GO TO INI-INIT-GF-8. NC2234.2 +158700 INI-TEST-GF-7-1. NC2234.2 +158800 MOVE "INI-TEST-GF-7-1" TO PAR-NAME. NC2234.2 +158900 IF TEST-1-2 = "$234.00" NC2234.2 +159000 PERFORM PASS NC2234.2 +159100 GO TO INI-WRITE-GF-7-1 NC2234.2 +159200 ELSE NC2234.2 +159300 GO TO INI-FAIL-GF-7-1. NC2234.2 +159400 INI-DELETE-GF-7-1. NC2234.2 +159500 PERFORM DE-LETE. NC2234.2 +159600 GO TO INI-WRITE-GF-7-1. NC2234.2 +159700 INI-FAIL-GF-7-1. NC2234.2 +159800 MOVE "$234.00" TO CORRECT-X NC2234.2 +159900 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +160000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +160100 PERFORM FAIL. NC2234.2 +160200 INI-WRITE-GF-7-1. NC2234.2 +160300 PERFORM PRINT-DETAIL. NC2234.2 +160400* NC2234.2 +160500 INI-TEST-GF-7-2. NC2234.2 +160600 ADD 1 TO REC-CT. NC2234.2 +160700 MOVE "INI-TEST-GF-7-2" TO PAR-NAME. NC2234.2 +160800 IF TEST-1-7 = "$234.00" NC2234.2 +160900 PERFORM PASS NC2234.2 +161000 GO TO INI-WRITE-GF-7-2 NC2234.2 +161100 ELSE NC2234.2 +161200 GO TO INI-FAIL-GF-7-2. NC2234.2 +161300 INI-DELETE-GF-7-2. NC2234.2 +161400 PERFORM DE-LETE. NC2234.2 +161500 GO TO INI-WRITE-GF-7-2. NC2234.2 +161600 INI-FAIL-GF-7-2. NC2234.2 +161700 MOVE "$234.00" TO CORRECT-X NC2234.2 +161800 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +161900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +162000 PERFORM FAIL. NC2234.2 +162100 INI-WRITE-GF-7-2. NC2234.2 +162200 PERFORM PRINT-DETAIL. NC2234.2 +162300* NC2234.2 +162400 INI-TEST-GF-7-3. NC2234.2 +162500 ADD 1 TO REC-CT. NC2234.2 +162600 MOVE "INI-TEST-GF-7-3" TO PAR-NAME. NC2234.2 +162700 IF TEST-1-1 = 001234 NC2234.2 +162800 PERFORM PASS NC2234.2 +162900 GO TO INI-WRITE-GF-7-3 NC2234.2 +163000 ELSE NC2234.2 +163100 GO TO INI-FAIL-GF-7-3. NC2234.2 +163200 INI-DELETE-GF-7-3. NC2234.2 +163300 PERFORM DE-LETE. NC2234.2 +163400 GO TO INI-WRITE-GF-7-3. NC2234.2 +163500 INI-FAIL-GF-7-3. NC2234.2 +163600 MOVE 001234 TO CORRECT-N NC2234.2 +163700 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +163800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +163900 TO RE-MARK NC2234.2 +164000 PERFORM FAIL. NC2234.2 +164100 INI-WRITE-GF-7-3. NC2234.2 +164200 PERFORM PRINT-DETAIL. NC2234.2 +164300* NC2234.2 +164400 INI-TEST-GF-7-4. NC2234.2 +164500 ADD 1 TO REC-CT. NC2234.2 +164600 MOVE "INI-TEST-GF-7-4" TO PAR-NAME. NC2234.2 +164700 IF TEST-1-3 = "**********" NC2234.2 +164800 PERFORM PASS NC2234.2 +164900 GO TO INI-WRITE-GF-7-4 NC2234.2 +165000 ELSE NC2234.2 +165100 GO TO INI-FAIL-GF-7-4. NC2234.2 +165200 INI-DELETE-GF-7-4. NC2234.2 +165300 PERFORM DE-LETE. NC2234.2 +165400 GO TO INI-WRITE-GF-7-4. NC2234.2 +165500 INI-FAIL-GF-7-4. NC2234.2 +165600 MOVE "**********" TO CORRECT-X NC2234.2 +165700 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +165800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +165900 TO RE-MARK NC2234.2 +166000 PERFORM FAIL. NC2234.2 +166100 INI-WRITE-GF-7-4. NC2234.2 +166200 PERFORM PRINT-DETAIL. NC2234.2 +166300* NC2234.2 +166400 INI-TEST-GF-7-5. NC2234.2 +166500 ADD 1 TO REC-CT. NC2234.2 +166600 MOVE "INI-TEST-GF-7-5" TO PAR-NAME. NC2234.2 +166700 IF TEST-1-4 = "DD DD/DD" NC2234.2 +166800 PERFORM PASS NC2234.2 +166900 GO TO INI-WRITE-GF-7-5 NC2234.2 +167000 ELSE NC2234.2 +167100 GO TO INI-FAIL-GF-7-5. NC2234.2 +167200 INI-DELETE-GF-7-5. NC2234.2 +167300 PERFORM DE-LETE. NC2234.2 +167400 GO TO INI-WRITE-GF-7-5. NC2234.2 +167500 INI-FAIL-GF-7-5. NC2234.2 +167600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +167700 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +167800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +167900 TO RE-MARK NC2234.2 +168000 PERFORM FAIL. NC2234.2 +168100 INI-WRITE-GF-7-5. NC2234.2 +168200 PERFORM PRINT-DETAIL. NC2234.2 +168300* NC2234.2 +168400 INI-TEST-GF-7-6. NC2234.2 +168500 ADD 1 TO REC-CT. NC2234.2 +168600 MOVE "INI-TEST-GF-7-6" TO PAR-NAME. NC2234.2 +168700 IF TEST-1-5 = "AAAAAA" NC2234.2 +168800 PERFORM PASS NC2234.2 +168900 GO TO INI-WRITE-GF-7-6 NC2234.2 +169000 ELSE NC2234.2 +169100 GO TO INI-FAIL-GF-7-6. NC2234.2 +169200 INI-DELETE-GF-7-6. NC2234.2 +169300 PERFORM DE-LETE. NC2234.2 +169400 GO TO INI-WRITE-GF-7-6. NC2234.2 +169500 INI-FAIL-GF-7-6. NC2234.2 +169600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +169700 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +169800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +169900 TO RE-MARK NC2234.2 +170000 PERFORM FAIL. NC2234.2 +170100 INI-WRITE-GF-7-6. NC2234.2 +170200 PERFORM PRINT-DETAIL. NC2234.2 +170300* NC2234.2 +170400 INI-TEST-GF-7-7. NC2234.2 +170500 ADD 1 TO REC-CT. NC2234.2 +170600 MOVE "INI-TEST-GF-7-7" TO PAR-NAME. NC2234.2 +170700 IF TEST-1-6 = 001234 NC2234.2 +170800 PERFORM PASS NC2234.2 +170900 GO TO INI-WRITE-GF-7-7 NC2234.2 +171000 ELSE NC2234.2 +171100 GO TO INI-FAIL-GF-7-7. NC2234.2 +171200 INI-DELETE-GF-7-7. NC2234.2 +171300 PERFORM DE-LETE. NC2234.2 +171400 GO TO INI-WRITE-GF-7-7. NC2234.2 +171500 INI-FAIL-GF-7-7. NC2234.2 +171600 MOVE ZERO TO CORRECT-N NC2234.2 +171700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +171800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +171900 TO RE-MARK NC2234.2 +172000 PERFORM FAIL. NC2234.2 +172100 INI-WRITE-GF-7-7. NC2234.2 +172200 PERFORM PRINT-DETAIL. NC2234.2 +172300* NC2234.2 +172400 INI-TEST-GF-7-8. NC2234.2 +172500 ADD 1 TO REC-CT. NC2234.2 +172600 MOVE "INI-TEST-GF-7-8" TO PAR-NAME. NC2234.2 +172700 IF TEST-1-8 = "**********" NC2234.2 +172800 PERFORM PASS NC2234.2 +172900 GO TO INI-WRITE-GF-7-8 NC2234.2 +173000 ELSE NC2234.2 +173100 GO TO INI-FAIL-GF-7-8. NC2234.2 +173200 INI-DELETE-GF-7-8. NC2234.2 +173300 PERFORM DE-LETE. NC2234.2 +173400 GO TO INI-WRITE-GF-7-8. NC2234.2 +173500 INI-FAIL-GF-7-8. NC2234.2 +173600 MOVE "**********" TO CORRECT-X NC2234.2 +173700 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +173800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +173900 TO RE-MARK NC2234.2 +174000 PERFORM FAIL. NC2234.2 +174100 INI-WRITE-GF-7-8. NC2234.2 +174200 PERFORM PRINT-DETAIL. NC2234.2 +174300* NC2234.2 +174400 INI-TEST-GF-7-9. NC2234.2 +174500 ADD 1 TO REC-CT. NC2234.2 +174600 MOVE "INI-TEST-GF-7-9" TO PAR-NAME. NC2234.2 +174700 IF TEST-1-9 = "DD DD/DD" NC2234.2 +174800 PERFORM PASS NC2234.2 +174900 GO TO INI-WRITE-GF-7-9 NC2234.2 +175000 ELSE NC2234.2 +175100 GO TO INI-FAIL-GF-7-9. NC2234.2 +175200 INI-DELETE-GF-7-9. NC2234.2 +175300 PERFORM DE-LETE. NC2234.2 +175400 GO TO INI-WRITE-GF-7-9. NC2234.2 +175500 INI-FAIL-GF-7-9. NC2234.2 +175600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +175700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +175800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +175900 TO RE-MARK NC2234.2 +176000 PERFORM FAIL. NC2234.2 +176100 INI-WRITE-GF-7-9. NC2234.2 +176200 PERFORM PRINT-DETAIL. NC2234.2 +176300* NC2234.2 +176400 INI-TEST-GF-7-10. NC2234.2 +176500 ADD 1 TO REC-CT. NC2234.2 +176600 MOVE "INI-TEST-GF-7-10" TO PAR-NAME. NC2234.2 +176700 IF TEST-1-10 = "AAAAAA" NC2234.2 +176800 PERFORM PASS NC2234.2 +176900 GO TO INI-WRITE-GF-7-10 NC2234.2 +177000 ELSE NC2234.2 +177100 GO TO INI-FAIL-GF-7-10. NC2234.2 +177200 INI-DELETE-GF-7-10. NC2234.2 +177300 PERFORM DE-LETE. NC2234.2 +177400 GO TO INI-WRITE-GF-7-10. NC2234.2 +177500 INI-FAIL-GF-7-10. NC2234.2 +177600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +177700 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +177800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +177900 TO RE-MARK NC2234.2 +178000 PERFORM FAIL. NC2234.2 +178100 INI-WRITE-GF-7-10. NC2234.2 +178200 PERFORM PRINT-DETAIL. NC2234.2 +178300* NC2234.2 +178400 INI-INIT-GF-8. NC2234.2 +178500* ===--> MULTIPLE RECEIVING AREAS <--=== NC2234.2 +178600 MOVE "VI-91 6.16.4 GR2" TO ANSI-REFERENCE. NC2234.2 +178700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +178800 MOVE 1 TO REC-CT. NC2234.2 +178900 MOVE LOW-VALUES TO TEST-1-DATA. NC2234.2 +179000 MOVE 999.99 TO TEST-8-DATA-1. NC2234.2 +179100 MOVE "ZZZZZZZZZZ" TO TEST-8-DATA-2. NC2234.2 +179200 INI-TEST-GF-8-0. NC2234.2 +179300 INITIALIZE TEST-8-DATA-1 NC2234.2 +179400 TEST-1-DATA NC2234.2 +179500 TEST-8-DATA-2. NC2234.2 +179600 GO TO INI-TEST-GF-8-1. NC2234.2 +179700 INI-DELETE-GF-8. NC2234.2 +179800 PERFORM DE-LETE. NC2234.2 +179900 PERFORM PRINT-DETAIL. NC2234.2 +180000 GO TO INI-INIT-GF-9. NC2234.2 +180100 INI-TEST-GF-8-1. NC2234.2 +180200 MOVE "INI-TEST-GF-8-1" TO PAR-NAME. NC2234.2 +180300 IF TEST-1-2 = " $0.00" NC2234.2 +180400 PERFORM PASS NC2234.2 +180500 GO TO INI-WRITE-GF-8-1 NC2234.2 +180600 ELSE NC2234.2 +180700 GO TO INI-FAIL-GF-8-1. NC2234.2 +180800 INI-DELETE-GF-8-1. NC2234.2 +180900 PERFORM DE-LETE. NC2234.2 +181000 GO TO INI-WRITE-GF-8-1. NC2234.2 +181100 INI-FAIL-GF-8-1. NC2234.2 +181200 MOVE " $0.00" TO CORRECT-X NC2234.2 +181300 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +181400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +181500 PERFORM FAIL. NC2234.2 +181600 INI-WRITE-GF-8-1. NC2234.2 +181700 PERFORM PRINT-DETAIL. NC2234.2 +181800* NC2234.2 +181900 INI-TEST-GF-8-2. NC2234.2 +182000 ADD 1 TO REC-CT. NC2234.2 +182100 MOVE "INI-TEST-GF-8-2" TO PAR-NAME. NC2234.2 +182200 IF TEST-1-7 = " $0.00" NC2234.2 +182300 PERFORM PASS NC2234.2 +182400 GO TO INI-WRITE-GF-8-2 NC2234.2 +182500 ELSE NC2234.2 +182600 GO TO INI-FAIL-GF-8-2. NC2234.2 +182700 INI-DELETE-GF-8-2. NC2234.2 +182800 PERFORM DE-LETE. NC2234.2 +182900 GO TO INI-WRITE-GF-8-2. NC2234.2 +183000 INI-FAIL-GF-8-2. NC2234.2 +183100 MOVE " $0.00" TO CORRECT-X NC2234.2 +183200 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +183300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +183400 PERFORM FAIL. NC2234.2 +183500 INI-WRITE-GF-8-2. NC2234.2 +183600 PERFORM PRINT-DETAIL. NC2234.2 +183700* NC2234.2 +183800 INI-TEST-GF-8-3. NC2234.2 +183900 ADD 1 TO REC-CT. NC2234.2 +184000 MOVE "INI-TEST-GF-8-3" TO PAR-NAME. NC2234.2 +184100 IF TEST-1-1 = ZERO NC2234.2 +184200 PERFORM PASS NC2234.2 +184300 GO TO INI-WRITE-GF-8-3 NC2234.2 +184400 ELSE NC2234.2 +184500 GO TO INI-FAIL-GF-8-3. NC2234.2 +184600 INI-DELETE-GF-8-3. NC2234.2 +184700 PERFORM DE-LETE. NC2234.2 +184800 GO TO INI-WRITE-GF-8-3. NC2234.2 +184900 INI-FAIL-GF-8-3. NC2234.2 +185000 MOVE ZERO TO CORRECT-N NC2234.2 +185100 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +185200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +185300 PERFORM FAIL. NC2234.2 +185400 INI-WRITE-GF-8-3. NC2234.2 +185500 PERFORM PRINT-DETAIL. NC2234.2 +185600* NC2234.2 +185700 INI-TEST-GF-8-4. NC2234.2 +185800 ADD 1 TO REC-CT. NC2234.2 +185900 MOVE "INI-TEST-GF-8-4" TO PAR-NAME. NC2234.2 +186000 IF TEST-1-3 = SPACES NC2234.2 +186100 PERFORM PASS NC2234.2 +186200 GO TO INI-WRITE-GF-8-4 NC2234.2 +186300 ELSE NC2234.2 +186400 GO TO INI-FAIL-GF-8-4. NC2234.2 +186500 INI-DELETE-GF-8-4. NC2234.2 +186600 PERFORM DE-LETE. NC2234.2 +186700 GO TO INI-WRITE-GF-8-4. NC2234.2 +186800 INI-FAIL-GF-8-4. NC2234.2 +186900 MOVE SPACES TO CORRECT-X NC2234.2 +187000 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +187100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +187200 PERFORM FAIL. NC2234.2 +187300 INI-WRITE-GF-8-4. NC2234.2 +187400 PERFORM PRINT-DETAIL. NC2234.2 +187500* NC2234.2 +187600 INI-TEST-GF-8-5. NC2234.2 +187700 ADD 1 TO REC-CT. NC2234.2 +187800 MOVE "INI-TEST-GF-8-5" TO PAR-NAME. NC2234.2 +187900 IF TEST-1-4 = " / " NC2234.2 +188000 PERFORM PASS NC2234.2 +188100 GO TO INI-WRITE-GF-8-5 NC2234.2 +188200 ELSE NC2234.2 +188300 GO TO INI-FAIL-GF-8-5. NC2234.2 +188400 INI-DELETE-GF-8-5. NC2234.2 +188500 PERFORM DE-LETE. NC2234.2 +188600 GO TO INI-WRITE-GF-8-5. NC2234.2 +188700 INI-FAIL-GF-8-5. NC2234.2 +188800 MOVE " / " TO CORRECT-X NC2234.2 +188900 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +189000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +189100 PERFORM FAIL. NC2234.2 +189200 INI-WRITE-GF-8-5. NC2234.2 +189300 PERFORM PRINT-DETAIL. NC2234.2 +189400* NC2234.2 +189500 INI-TEST-GF-8-6. NC2234.2 +189600 ADD 1 TO REC-CT. NC2234.2 +189700 MOVE "INI-TEST-GF-8-6" TO PAR-NAME. NC2234.2 +189800 IF TEST-1-5 = SPACES NC2234.2 +189900 PERFORM PASS NC2234.2 +190000 GO TO INI-WRITE-GF-8-6 NC2234.2 +190100 ELSE NC2234.2 +190200 GO TO INI-FAIL-GF-8-6. NC2234.2 +190300 INI-DELETE-GF-8-6. NC2234.2 +190400 PERFORM DE-LETE. NC2234.2 +190500 GO TO INI-WRITE-GF-8-6. NC2234.2 +190600 INI-FAIL-GF-8-6. NC2234.2 +190700 MOVE SPACES TO CORRECT-X NC2234.2 +190800 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +190900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +191000 PERFORM FAIL. NC2234.2 +191100 INI-WRITE-GF-8-6. NC2234.2 +191200 PERFORM PRINT-DETAIL. NC2234.2 +191300* NC2234.2 +191400 INI-TEST-GF-8-7. NC2234.2 +191500 ADD 1 TO REC-CT. NC2234.2 +191600 MOVE "INI-TEST-GF-8-7" TO PAR-NAME. NC2234.2 +191700 IF TEST-1-6 = ZERO NC2234.2 +191800 PERFORM PASS NC2234.2 +191900 GO TO INI-WRITE-GF-8-7 NC2234.2 +192000 ELSE NC2234.2 +192100 GO TO INI-FAIL-GF-8-7. NC2234.2 +192200 INI-DELETE-GF-8-7. NC2234.2 +192300 PERFORM DE-LETE. NC2234.2 +192400 GO TO INI-WRITE-GF-8-7. NC2234.2 +192500 INI-FAIL-GF-8-7. NC2234.2 +192600 MOVE ZERO TO CORRECT-N NC2234.2 +192700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +192800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +192900 PERFORM FAIL. NC2234.2 +193000 INI-WRITE-GF-8-7. NC2234.2 +193100 PERFORM PRINT-DETAIL. NC2234.2 +193200* NC2234.2 +193300 INI-TEST-GF-8-8. NC2234.2 +193400 ADD 1 TO REC-CT. NC2234.2 +193500 MOVE "INI-TEST-GF-8-8" TO PAR-NAME. NC2234.2 +193600 IF TEST-1-8 = SPACES NC2234.2 +193700 PERFORM PASS NC2234.2 +193800 GO TO INI-WRITE-GF-8-8 NC2234.2 +193900 ELSE NC2234.2 +194000 GO TO INI-FAIL-GF-8-8. NC2234.2 +194100 INI-DELETE-GF-8-8. NC2234.2 +194200 PERFORM DE-LETE. NC2234.2 +194300 GO TO INI-WRITE-GF-8-8. NC2234.2 +194400 INI-FAIL-GF-8-8. NC2234.2 +194500 MOVE SPACES TO CORRECT-X NC2234.2 +194600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +194700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +194800 PERFORM FAIL. NC2234.2 +194900 INI-WRITE-GF-8-8. NC2234.2 +195000 PERFORM PRINT-DETAIL. NC2234.2 +195100* NC2234.2 +195200 INI-TEST-GF-8-9. NC2234.2 +195300 ADD 1 TO REC-CT. NC2234.2 +195400 MOVE "INI-TEST-GF-8-9" TO PAR-NAME. NC2234.2 +195500 IF TEST-1-9 = " / " NC2234.2 +195600 PERFORM PASS NC2234.2 +195700 GO TO INI-WRITE-GF-8-9 NC2234.2 +195800 ELSE NC2234.2 +195900 GO TO INI-FAIL-GF-8-9. NC2234.2 +196000 INI-DELETE-GF-8-9. NC2234.2 +196100 PERFORM DE-LETE. NC2234.2 +196200 GO TO INI-WRITE-GF-8-9. NC2234.2 +196300 INI-FAIL-GF-8-9. NC2234.2 +196400 MOVE " / " TO CORRECT-X NC2234.2 +196500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +196600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +196700 PERFORM FAIL. NC2234.2 +196800 INI-WRITE-GF-8-9. NC2234.2 +196900 PERFORM PRINT-DETAIL. NC2234.2 +197000* NC2234.2 +197100 INI-TEST-GF-8-10. NC2234.2 +197200 ADD 1 TO REC-CT. NC2234.2 +197300 MOVE "INI-TEST-GF-8-10" TO PAR-NAME. NC2234.2 +197400 IF TEST-1-10 = SPACES NC2234.2 +197500 PERFORM PASS NC2234.2 +197600 GO TO INI-WRITE-GF-8-10 NC2234.2 +197700 ELSE NC2234.2 +197800 GO TO INI-FAIL-GF-8-10. NC2234.2 +197900 INI-DELETE-GF-8-10. NC2234.2 +198000 PERFORM DE-LETE. NC2234.2 +198100 GO TO INI-WRITE-GF-8-10. NC2234.2 +198200 INI-FAIL-GF-8-10. NC2234.2 +198300 MOVE SPACES TO CORRECT-X NC2234.2 +198400 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +198500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +198600 PERFORM FAIL. NC2234.2 +198700 INI-WRITE-GF-8-10. NC2234.2 +198800 PERFORM PRINT-DETAIL. NC2234.2 +198900* NC2234.2 +199000 INI-TEST-GF-8-11. NC2234.2 +199100 ADD 1 TO REC-CT. NC2234.2 +199200 MOVE "INI-TEST-GF-8-11" TO PAR-NAME. NC2234.2 +199300 IF TEST-8-DATA-1 = " $0.00" NC2234.2 +199400 PERFORM PASS NC2234.2 +199500 GO TO INI-WRITE-GF-8-11 NC2234.2 +199600 ELSE NC2234.2 +199700 GO TO INI-FAIL-GF-8-11. NC2234.2 +199800 INI-DELETE-GF-8-11. NC2234.2 +199900 PERFORM DE-LETE. NC2234.2 +200000 GO TO INI-WRITE-GF-8-11. NC2234.2 +200100 INI-FAIL-GF-8-11. NC2234.2 +200200 MOVE " $0.00" TO CORRECT-X NC2234.2 +200300 MOVE TEST-8-DATA-1 TO COMPUTED-X NC2234.2 +200400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +200500 PERFORM FAIL. NC2234.2 +200600 INI-WRITE-GF-8-11. NC2234.2 +200700 PERFORM PRINT-DETAIL. NC2234.2 +200800* NC2234.2 +200900 INI-TEST-GF-8-12. NC2234.2 +201000 ADD 1 TO REC-CT. NC2234.2 +201100 MOVE "INI-TEST-GF-8-12" TO PAR-NAME. NC2234.2 +201200 IF TEST-8-DATA-2 = SPACES NC2234.2 +201300 PERFORM PASS NC2234.2 +201400 GO TO INI-WRITE-GF-8-12 NC2234.2 +201500 ELSE NC2234.2 +201600 GO TO INI-FAIL-GF-8-12. NC2234.2 +201700 INI-DELETE-GF-8-12. NC2234.2 +201800 PERFORM DE-LETE. NC2234.2 +201900 GO TO INI-WRITE-GF-8-12. NC2234.2 +202000 INI-FAIL-GF-8-12. NC2234.2 +202100 MOVE SPACES TO CORRECT-X NC2234.2 +202200 MOVE TEST-8-DATA-2 TO COMPUTED-X NC2234.2 +202300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +202400 PERFORM FAIL. NC2234.2 +202500 INI-WRITE-GF-8-12. NC2234.2 +202600 PERFORM PRINT-DETAIL. NC2234.2 +202700* NC2234.2 +202800 INI-INIT-GF-9. NC2234.2 +202900* ===--> MULTIPLE RECEIVING AREAS AND <--=== NC2234.2 +203000* ===--> MULTIPLE "REPLACING" PHRASES" <--=== NC2234.2 +203100 MOVE "VI-91 6.16.2" TO ANSI-REFERENCE. NC2234.2 +203200 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +203300 MOVE 1 TO REC-CT. NC2234.2 +203400 MOVE ZEROS TO TEST-1-1. NC2234.2 +203500 MOVE ZEROS TO TEST-1-2. NC2234.2 +203600 MOVE SPACES TO TEST-1-3. NC2234.2 +203700 MOVE SPACES TO TEST-1-4. NC2234.2 +203800 MOVE SPACES TO TEST-1-5. NC2234.2 +203900 MOVE ZEROS TO TEST-1-6. NC2234.2 +204000 MOVE ZEROS TO TEST-1-7. NC2234.2 +204100 MOVE SPACES TO TEST-1-8. NC2234.2 +204200 MOVE SPACES TO TEST-1-9. NC2234.2 +204300 MOVE SPACES TO TEST-1-10. NC2234.2 +204400 MOVE 999.99 TO TEST-8-DATA-1. NC2234.2 +204500 MOVE "ZZZZZZZZZZ" TO TEST-8-DATA-2. NC2234.2 +204600 INI-TEST-GF-9-0. NC2234.2 +204700 INITIALIZE NC2234.2 +204800 TEST-8-DATA-1 NC2234.2 +204900 TEST-1-DATA NC2234.2 +205000 TEST-8-DATA-2 NC2234.2 +205100 REPLACING ALPHABETIC DATA BY "AAAAAA" NC2234.2 +205200 ALPHANUMERIC BY "**********" NC2234.2 +205300 ALPHANUMERIC-EDITED BY "DDDDDD" NC2234.2 +205400 NUMERIC DATA BY NUM-1234 NC2234.2 +205500 NUMERIC-EDITED BY 1234. NC2234.2 +205600 GO TO INI-TEST-GF-9-1. NC2234.2 +205700 INI-DELETE-GF-9. NC2234.2 +205800 PERFORM DE-LETE. NC2234.2 +205900 PERFORM PRINT-DETAIL. NC2234.2 +206000 GO TO CCVS-EXIT. NC2234.2 +206100 INI-TEST-GF-9-1. NC2234.2 +206200 MOVE "INI-TEST-GF-9-1" TO PAR-NAME. NC2234.2 +206300 IF TEST-1-2 = "$234.00" NC2234.2 +206400 PERFORM PASS NC2234.2 +206500 GO TO INI-WRITE-GF-9-1 NC2234.2 +206600 ELSE NC2234.2 +206700 GO TO INI-FAIL-GF-9-1. NC2234.2 +206800 INI-DELETE-GF-9-1. NC2234.2 +206900 PERFORM DE-LETE. NC2234.2 +207000 GO TO INI-WRITE-GF-9-1. NC2234.2 +207100 INI-FAIL-GF-9-1. NC2234.2 +207200 MOVE "$234.00" TO CORRECT-X NC2234.2 +207300 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +207400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +207500 PERFORM FAIL. NC2234.2 +207600 INI-WRITE-GF-9-1. NC2234.2 +207700 PERFORM PRINT-DETAIL. NC2234.2 +207800* NC2234.2 +207900 INI-TEST-GF-9-2. NC2234.2 +208000 ADD 1 TO REC-CT. NC2234.2 +208100 MOVE "INI-TEST-GF-9-2" TO PAR-NAME. NC2234.2 +208200 IF TEST-1-7 = "$234.00" NC2234.2 +208300 PERFORM PASS NC2234.2 +208400 GO TO INI-WRITE-GF-9-2 NC2234.2 +208500 ELSE NC2234.2 +208600 GO TO INI-FAIL-GF-9-2. NC2234.2 +208700 INI-DELETE-GF-9-2. NC2234.2 +208800 PERFORM DE-LETE. NC2234.2 +208900 GO TO INI-WRITE-GF-9-2. NC2234.2 +209000 INI-FAIL-GF-9-2. NC2234.2 +209100 MOVE "$234.00" TO CORRECT-X NC2234.2 +209200 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +209300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +209400 PERFORM FAIL. NC2234.2 +209500 INI-WRITE-GF-9-2. NC2234.2 +209600 PERFORM PRINT-DETAIL. NC2234.2 +209700* NC2234.2 +209800 INI-TEST-GF-9-3. NC2234.2 +209900 ADD 1 TO REC-CT. NC2234.2 +210000 MOVE "INI-TEST-GF-9-3" TO PAR-NAME. NC2234.2 +210100 IF TEST-1-1 = 001234 NC2234.2 +210200 PERFORM PASS NC2234.2 +210300 GO TO INI-WRITE-GF-9-3 NC2234.2 +210400 ELSE NC2234.2 +210500 GO TO INI-FAIL-GF-9-3. NC2234.2 +210600 INI-DELETE-GF-9-3. NC2234.2 +210700 PERFORM DE-LETE. NC2234.2 +210800 GO TO INI-WRITE-GF-9-3. NC2234.2 +210900 INI-FAIL-GF-9-3. NC2234.2 +211000 MOVE 001234 TO CORRECT-N NC2234.2 +211100 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +211200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +211300 PERFORM FAIL. NC2234.2 +211400 INI-WRITE-GF-9-3. NC2234.2 +211500 PERFORM PRINT-DETAIL. NC2234.2 +211600* NC2234.2 +211700 INI-TEST-GF-9-4. NC2234.2 +211800 ADD 1 TO REC-CT. NC2234.2 +211900 MOVE "INI-TEST-GF-9-4" TO PAR-NAME. NC2234.2 +212000 IF TEST-1-3 = "**********" NC2234.2 +212100 PERFORM PASS NC2234.2 +212200 GO TO INI-WRITE-GF-9-4 NC2234.2 +212300 ELSE NC2234.2 +212400 GO TO INI-FAIL-GF-9-4. NC2234.2 +212500 INI-DELETE-GF-9-4. NC2234.2 +212600 PERFORM DE-LETE. NC2234.2 +212700 GO TO INI-WRITE-GF-9-4. NC2234.2 +212800 INI-FAIL-GF-9-4. NC2234.2 +212900 MOVE "**********" TO CORRECT-X NC2234.2 +213000 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +213100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +213200 PERFORM FAIL. NC2234.2 +213300 INI-WRITE-GF-9-4. NC2234.2 +213400 PERFORM PRINT-DETAIL. NC2234.2 +213500* NC2234.2 +213600 INI-TEST-GF-9-5. NC2234.2 +213700 ADD 1 TO REC-CT. NC2234.2 +213800 MOVE "INI-TEST-GF-9-5" TO PAR-NAME. NC2234.2 +213900 IF TEST-1-4 = "DD DD/DD" NC2234.2 +214000 PERFORM PASS NC2234.2 +214100 GO TO INI-WRITE-GF-9-5 NC2234.2 +214200 ELSE NC2234.2 +214300 GO TO INI-FAIL-GF-9-5. NC2234.2 +214400 INI-DELETE-GF-9-5. NC2234.2 +214500 PERFORM DE-LETE. NC2234.2 +214600 GO TO INI-WRITE-GF-9-5. NC2234.2 +214700 INI-FAIL-GF-9-5. NC2234.2 +214800 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +214900 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +215000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +215100 PERFORM FAIL. NC2234.2 +215200 INI-WRITE-GF-9-5. NC2234.2 +215300 PERFORM PRINT-DETAIL. NC2234.2 +215400* NC2234.2 +215500 INI-TEST-GF-9-6. NC2234.2 +215600 ADD 1 TO REC-CT. NC2234.2 +215700 MOVE "INI-TEST-GF-9-6" TO PAR-NAME. NC2234.2 +215800 IF TEST-1-5 = "AAAAAA" NC2234.2 +215900 PERFORM PASS NC2234.2 +216000 GO TO INI-WRITE-GF-9-6 NC2234.2 +216100 ELSE NC2234.2 +216200 GO TO INI-FAIL-GF-9-6. NC2234.2 +216300 INI-DELETE-GF-9-6. NC2234.2 +216400 PERFORM DE-LETE. NC2234.2 +216500 GO TO INI-WRITE-GF-9-6. NC2234.2 +216600 INI-FAIL-GF-9-6. NC2234.2 +216700 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +216800 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +216900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +217000 PERFORM FAIL. NC2234.2 +217100 INI-WRITE-GF-9-6. NC2234.2 +217200 PERFORM PRINT-DETAIL. NC2234.2 +217300* NC2234.2 +217400 INI-TEST-GF-9-7. NC2234.2 +217500 ADD 1 TO REC-CT. NC2234.2 +217600 MOVE "INI-TEST-GF-9-7" TO PAR-NAME. NC2234.2 +217700 IF TEST-1-6 = 1234 NC2234.2 +217800 PERFORM PASS NC2234.2 +217900 GO TO INI-WRITE-GF-9-7 NC2234.2 +218000 ELSE NC2234.2 +218100 GO TO INI-FAIL-GF-9-7. NC2234.2 +218200 INI-DELETE-GF-9-7. NC2234.2 +218300 PERFORM DE-LETE. NC2234.2 +218400 GO TO INI-WRITE-GF-9-7. NC2234.2 +218500 INI-FAIL-GF-9-7. NC2234.2 +218600 MOVE 1234 TO CORRECT-N NC2234.2 +218700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +218800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +218900 PERFORM FAIL. NC2234.2 +219000 INI-WRITE-GF-9-7. NC2234.2 +219100 PERFORM PRINT-DETAIL. NC2234.2 +219200* NC2234.2 +219300 INI-TEST-GF-9-8. NC2234.2 +219400 ADD 1 TO REC-CT. NC2234.2 +219500 MOVE "INI-TEST-GF-9-8" TO PAR-NAME. NC2234.2 +219600 IF TEST-1-8 = "**********" NC2234.2 +219700 PERFORM PASS NC2234.2 +219800 GO TO INI-WRITE-GF-9-8 NC2234.2 +219900 ELSE NC2234.2 +220000 GO TO INI-FAIL-GF-9-8. NC2234.2 +220100 INI-DELETE-GF-9-8. NC2234.2 +220200 PERFORM DE-LETE. NC2234.2 +220300 GO TO INI-WRITE-GF-9-8. NC2234.2 +220400 INI-FAIL-GF-9-8. NC2234.2 +220500 MOVE "**********" TO CORRECT-X NC2234.2 +220600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +220700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +220800 PERFORM FAIL. NC2234.2 +220900 INI-WRITE-GF-9-8. NC2234.2 +221000 PERFORM PRINT-DETAIL. NC2234.2 +221100* NC2234.2 +221200 INI-TEST-GF-9-9. NC2234.2 +221300 ADD 1 TO REC-CT. NC2234.2 +221400 MOVE "INI-TEST-GF-9-9" TO PAR-NAME. NC2234.2 +221500 IF TEST-1-9 = "DD DD/DD" NC2234.2 +221600 PERFORM PASS NC2234.2 +221700 GO TO INI-WRITE-GF-9-9 NC2234.2 +221800 ELSE NC2234.2 +221900 GO TO INI-FAIL-GF-9-9. NC2234.2 +222000 INI-DELETE-GF-9-9. NC2234.2 +222100 PERFORM DE-LETE. NC2234.2 +222200 GO TO INI-WRITE-GF-9-9. NC2234.2 +222300 INI-FAIL-GF-9-9. NC2234.2 +222400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +222500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +222600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +222700 PERFORM FAIL. NC2234.2 +222800 INI-WRITE-GF-9-9. NC2234.2 +222900 PERFORM PRINT-DETAIL. NC2234.2 +223000* NC2234.2 +223100 INI-TEST-GF-9-10. NC2234.2 +223200 ADD 1 TO REC-CT. NC2234.2 +223300 MOVE "INI-TEST-GF-9-10" TO PAR-NAME. NC2234.2 +223400 IF TEST-1-10 = "AAAAAA" NC2234.2 +223500 PERFORM PASS NC2234.2 +223600 GO TO INI-WRITE-GF-9-10 NC2234.2 +223700 ELSE NC2234.2 +223800 GO TO INI-FAIL-GF-9-10. NC2234.2 +223900 INI-DELETE-GF-9-10. NC2234.2 +224000 PERFORM DE-LETE. NC2234.2 +224100 GO TO INI-WRITE-GF-9-10. NC2234.2 +224200 INI-FAIL-GF-9-10. NC2234.2 +224300 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +224400 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +224500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +224600 PERFORM FAIL. NC2234.2 +224700 INI-WRITE-GF-9-10. NC2234.2 +224800 PERFORM PRINT-DETAIL. NC2234.2 +224900* NC2234.2 +225000 INI-TEST-GF-9-11. NC2234.2 +225100 ADD 1 TO REC-CT. NC2234.2 +225200 MOVE "INI-TEST-GF-9-11" TO PAR-NAME. NC2234.2 +225300 IF TEST-8-DATA-1 = "$234.00" NC2234.2 +225400 PERFORM PASS NC2234.2 +225500 GO TO INI-WRITE-GF-9-11 NC2234.2 +225600 ELSE NC2234.2 +225700 GO TO INI-FAIL-GF-9-11. NC2234.2 +225800 INI-DELETE-GF-9-11. NC2234.2 +225900 PERFORM DE-LETE. NC2234.2 +226000 GO TO INI-WRITE-GF-9-11. NC2234.2 +226100 INI-FAIL-GF-9-11. NC2234.2 +226200 MOVE "$234.00" TO CORRECT-X NC2234.2 +226300 MOVE TEST-8-DATA-1 TO COMPUTED-X NC2234.2 +226400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +226500 PERFORM FAIL. NC2234.2 +226600 INI-WRITE-GF-9-11. NC2234.2 +226700 PERFORM PRINT-DETAIL. NC2234.2 +226800* NC2234.2 +226900 INI-TEST-GF-9-12. NC2234.2 +227000 ADD 1 TO REC-CT. NC2234.2 +227100 MOVE "INI-TEST-GF-9-12" TO PAR-NAME. NC2234.2 +227200 IF TEST-8-DATA-2 = "AAAAAA " NC2234.2 +227300 PERFORM PASS NC2234.2 +227400 GO TO INI-WRITE-GF-9-12 NC2234.2 +227500 ELSE NC2234.2 +227600 GO TO INI-FAIL-GF-9-12. NC2234.2 +227700 INI-DELETE-GF-9-12. NC2234.2 +227800 PERFORM DE-LETE. NC2234.2 +227900 GO TO INI-WRITE-GF-9-12. NC2234.2 +228000 INI-FAIL-GF-9-12. NC2234.2 +228100 MOVE "AAAAAA " TO CORRECT-X NC2234.2 +228200 MOVE TEST-8-DATA-2 TO COMPUTED-X NC2234.2 +228300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +228400 PERFORM FAIL. NC2234.2 +228500 INI-WRITE-GF-9-12. NC2234.2 +228600 PERFORM PRINT-DETAIL. NC2234.2 +228700* NC2234.2 +228800 CCVS-EXIT SECTION. NC2234.2 +228900 CCVS-999999. NC2234.2 +229000 GO TO CLOSE-FILES. NC2234.2 +*END-OF,NC223A +*HEADER,COBOL,NC224A +000100 IDENTIFICATION DIVISION. NC2244.2 +000200 PROGRAM-ID. NC2244.2 +000300 NC224A. NC2244.2 +000400**************************************************************** NC2244.2 +000500* * NC2244.2 +000600* VALIDATION FOR:- * NC2244.2 +000700* * NC2244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +000900* * NC2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2244.2 +001100* * NC2244.2 +001200**************************************************************** NC2244.2 +001300* * NC2244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2244.2 +001500* * NC2244.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2244.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2244.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2244.2 +001900* * NC2244.2 +002000**************************************************************** NC2244.2 +002100* PROGRAM NC224A TESTS THE USE OF REFERENCE MODIFICATION * NC2244.2 +002200* ON A VARIETY OF DATA ITEMS USING LITERALS, DATA NAMES * NC2244.2 +002300* AND ARITHMETIC EXPRESSIONS AS PARAMETERS. * NC2244.2 +002400* SUBSCRIPTED AND QUALIFIED DATA ITEMS ARE ALSO USED. * NC2244.2 +002500* * NC2244.2 +002600**************************************************************** NC2244.2 +002700 ENVIRONMENT DIVISION. NC2244.2 +002800 CONFIGURATION SECTION. NC2244.2 +002900 SOURCE-COMPUTER. NC2244.2 +003000 XXXXX082. NC2244.2 +003100 OBJECT-COMPUTER. NC2244.2 +003200 XXXXX083. NC2244.2 +003300 INPUT-OUTPUT SECTION. NC2244.2 +003400 FILE-CONTROL. NC2244.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2244.2 +003600 XXXXX055. NC2244.2 +003700 DATA DIVISION. NC2244.2 +003800 FILE SECTION. NC2244.2 +003900 FD PRINT-FILE. NC2244.2 +004000 01 PRINT-REC PICTURE X(120). NC2244.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2244.2 +004200 WORKING-STORAGE SECTION. NC2244.2 +004300 01 TEST-1-DATA PIC 9(6) VALUE 123456. NC2244.2 +004400 01 TEST-2-DATA PIC Z(5)9. NC2244.2 +004500 01 TEST-3-DATA-GRP. NC2244.2 +004600 03 TEST-3-DATA PIC X(6) VALUE "ABCDEF". NC2244.2 +004700 01 TEST-4-DATA PIC XXBXXBXX VALUE "AB CD EF". NC2244.2 +004800 NC2244.2 +004900 01 WS-2 PIC S9 VALUE +2. NC2244.2 +005000 01 WS-3 PIC S9 VALUE +3. NC2244.2 +005100 01 WS-5 PIC S9 VALUE +5. NC2244.2 +005200 01 WS-6 PIC S9 VALUE +6. NC2244.2 +005300 01 WS-7 PIC S9 VALUE +7. NC2244.2 +005400 01 WS-10 PIC S99 VALUE +10. NC2244.2 +005500 01 TEST-5-TABLE. NC2244.2 +005600 03 TABLE-GROUP OCCURS 4. NC2244.2 +005700 05 TABLE-1 PIC 9(8) NC2244.2 +005800 OCCURS 2. NC2244.2 +005900 03 TEST-3-DATA PIC X(6). NC2244.2 +006000* NC2244.2 +006100 01 TEST-RESULTS. NC2244.2 +006200 02 FILLER PIC X VALUE SPACE. NC2244.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. NC2244.2 +006400 02 FILLER PIC X VALUE SPACE. NC2244.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. NC2244.2 +006600 02 FILLER PIC X VALUE SPACE. NC2244.2 +006700 02 PAR-NAME. NC2244.2 +006800 03 FILLER PIC X(19) VALUE SPACE. NC2244.2 +006900 03 PARDOT-X PIC X VALUE SPACE. NC2244.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. NC2244.2 +007100 02 FILLER PIC X(8) VALUE SPACE. NC2244.2 +007200 02 RE-MARK PIC X(61). NC2244.2 +007300 01 TEST-COMPUTED. NC2244.2 +007400 02 FILLER PIC X(30) VALUE SPACE. NC2244.2 +007500 02 FILLER PIC X(17) VALUE NC2244.2 +007600 " COMPUTED=". NC2244.2 +007700 02 COMPUTED-X. NC2244.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2244.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A NC2244.2 +008000 PIC -9(9).9(9). NC2244.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2244.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2244.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2244.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. NC2244.2 +008500 04 COMPUTED-18V0 PIC -9(18). NC2244.2 +008600 04 FILLER PIC X. NC2244.2 +008700 03 FILLER PIC X(50) VALUE SPACE. NC2244.2 +008800 01 TEST-CORRECT. NC2244.2 +008900 02 FILLER PIC X(30) VALUE SPACE. NC2244.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2244.2 +009100 02 CORRECT-X. NC2244.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2244.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2244.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2244.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2244.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2244.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. NC2244.2 +009800 04 CORRECT-18V0 PIC -9(18). NC2244.2 +009900 04 FILLER PIC X. NC2244.2 +010000 03 FILLER PIC X(2) VALUE SPACE. NC2244.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2244.2 +010200 01 CCVS-C-1. NC2244.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2244.2 +010400- "SS PARAGRAPH-NAME NC2244.2 +010500- " REMARKS". NC2244.2 +010600 02 FILLER PIC X(20) VALUE SPACE. NC2244.2 +010700 01 CCVS-C-2. NC2244.2 +010800 02 FILLER PIC X VALUE SPACE. NC2244.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". NC2244.2 +011000 02 FILLER PIC X(15) VALUE SPACE. NC2244.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". NC2244.2 +011200 02 FILLER PIC X(94) VALUE SPACE. NC2244.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2244.2 +011400 01 REC-CT PIC 99 VALUE ZERO. NC2244.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2244.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2244.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2244.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2244.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2244.2 +012400 01 CCVS-H-1. NC2244.2 +012500 02 FILLER PIC X(39) VALUE SPACES. NC2244.2 +012600 02 FILLER PIC X(42) VALUE NC2244.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2244.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC2244.2 +012900 01 CCVS-H-2A. NC2244.2 +013000 02 FILLER PIC X(40) VALUE SPACE. NC2244.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2244.2 +013200 02 FILLER PIC XXXX VALUE NC2244.2 +013300 "4.2 ". NC2244.2 +013400 02 FILLER PIC X(28) VALUE NC2244.2 +013500 " COPY - NOT FOR DISTRIBUTION". NC2244.2 +013600 02 FILLER PIC X(41) VALUE SPACE. NC2244.2 +013700 NC2244.2 +013800 01 CCVS-H-2B. NC2244.2 +013900 02 FILLER PIC X(15) VALUE NC2244.2 +014000 "TEST RESULT OF ". NC2244.2 +014100 02 TEST-ID PIC X(9). NC2244.2 +014200 02 FILLER PIC X(4) VALUE NC2244.2 +014300 " IN ". NC2244.2 +014400 02 FILLER PIC X(12) VALUE NC2244.2 +014500 " HIGH ". NC2244.2 +014600 02 FILLER PIC X(22) VALUE NC2244.2 +014700 " LEVEL VALIDATION FOR ". NC2244.2 +014800 02 FILLER PIC X(58) VALUE NC2244.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +015000 01 CCVS-H-3. NC2244.2 +015100 02 FILLER PIC X(34) VALUE NC2244.2 +015200 " FOR OFFICIAL USE ONLY ". NC2244.2 +015300 02 FILLER PIC X(58) VALUE NC2244.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2244.2 +015500 02 FILLER PIC X(28) VALUE NC2244.2 +015600 " COPYRIGHT 1985 ". NC2244.2 +015700 01 CCVS-E-1. NC2244.2 +015800 02 FILLER PIC X(52) VALUE SPACE. NC2244.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2244.2 +016000 02 ID-AGAIN PIC X(9). NC2244.2 +016100 02 FILLER PIC X(45) VALUE SPACES. NC2244.2 +016200 01 CCVS-E-2. NC2244.2 +016300 02 FILLER PIC X(31) VALUE SPACE. NC2244.2 +016400 02 FILLER PIC X(21) VALUE SPACE. NC2244.2 +016500 02 CCVS-E-2-2. NC2244.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2244.2 +016700 03 FILLER PIC X VALUE SPACE. NC2244.2 +016800 03 ENDER-DESC PIC X(44) VALUE NC2244.2 +016900 "ERRORS ENCOUNTERED". NC2244.2 +017000 01 CCVS-E-3. NC2244.2 +017100 02 FILLER PIC X(22) VALUE NC2244.2 +017200 " FOR OFFICIAL USE ONLY". NC2244.2 +017300 02 FILLER PIC X(12) VALUE SPACE. NC2244.2 +017400 02 FILLER PIC X(58) VALUE NC2244.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +017600 02 FILLER PIC X(13) VALUE SPACE. NC2244.2 +017700 02 FILLER PIC X(15) VALUE NC2244.2 +017800 " COPYRIGHT 1985". NC2244.2 +017900 01 CCVS-E-4. NC2244.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2244.2 +018100 02 FILLER PIC X(4) VALUE " OF ". NC2244.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2244.2 +018300 02 FILLER PIC X(40) VALUE NC2244.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2244.2 +018500 01 XXINFO. NC2244.2 +018600 02 FILLER PIC X(19) VALUE NC2244.2 +018700 "*** INFORMATION ***". NC2244.2 +018800 02 INFO-TEXT. NC2244.2 +018900 04 FILLER PIC X(8) VALUE SPACE. NC2244.2 +019000 04 XXCOMPUTED PIC X(20). NC2244.2 +019100 04 FILLER PIC X(5) VALUE SPACE. NC2244.2 +019200 04 XXCORRECT PIC X(20). NC2244.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). NC2244.2 +019400 01 HYPHEN-LINE. NC2244.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. NC2244.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************NC2244.2 +019700- "*****************************************". NC2244.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************NC2244.2 +019900- "******************************". NC2244.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE NC2244.2 +020100 "NC224A". NC2244.2 +020200 PROCEDURE DIVISION. NC2244.2 +020300 CCVS1 SECTION. NC2244.2 +020400 OPEN-FILES. NC2244.2 +020500 OPEN OUTPUT PRINT-FILE. NC2244.2 +020600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2244.2 +020700 MOVE SPACE TO TEST-RESULTS. NC2244.2 +020800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2244.2 +020900 GO TO CCVS1-EXIT. NC2244.2 +021000 CLOSE-FILES. NC2244.2 +021100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2244.2 +021200 TERMINATE-CCVS. NC2244.2 +021300S EXIT PROGRAM. NC2244.2 +021400STERMINATE-CALL. NC2244.2 +021500 STOP RUN. NC2244.2 +021600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2244.2 +021700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2244.2 +021800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2244.2 +021900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2244.2 +022000 MOVE "****TEST DELETED****" TO RE-MARK. NC2244.2 +022100 PRINT-DETAIL. NC2244.2 +022200 IF REC-CT NOT EQUAL TO ZERO NC2244.2 +022300 MOVE "." TO PARDOT-X NC2244.2 +022400 MOVE REC-CT TO DOTVALUE. NC2244.2 +022500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2244.2 +022600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2244.2 +022700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2244.2 +022800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2244.2 +022900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2244.2 +023000 MOVE SPACE TO CORRECT-X. NC2244.2 +023100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2244.2 +023200 MOVE SPACE TO RE-MARK. NC2244.2 +023300 HEAD-ROUTINE. NC2244.2 +023400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +023500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +023600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2244.2 +023700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2244.2 +023800 COLUMN-NAMES-ROUTINE. NC2244.2 +023900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +024000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +024200 END-ROUTINE. NC2244.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2244.2 +024400 END-RTN-EXIT. NC2244.2 +024500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +024600 END-ROUTINE-1. NC2244.2 +024700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2244.2 +024800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2244.2 +024900 ADD PASS-COUNTER TO ERROR-HOLD. NC2244.2 +025000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2244.2 +025100 NC2244.2 +025200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2244.2 +025300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2244.2 +025400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2244.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2244.2 +025600 END-ROUTINE-12. NC2244.2 +025700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2244.2 +025800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2244.2 +025900 MOVE "NO " TO ERROR-TOTAL NC2244.2 +026000 ELSE NC2244.2 +026100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2244.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2244.2 +026300 PERFORM WRITE-LINE. NC2244.2 +026400 END-ROUTINE-13. NC2244.2 +026500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2244.2 +026600 MOVE "NO " TO ERROR-TOTAL ELSE NC2244.2 +026700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2244.2 +026800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2244.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027000 IF INSPECT-COUNTER EQUAL TO ZERO NC2244.2 +027100 MOVE "NO " TO ERROR-TOTAL NC2244.2 +027200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2244.2 +027300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2244.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027600 WRITE-LINE. NC2244.2 +027700 ADD 1 TO RECORD-COUNT. NC2244.2 +027800Y IF RECORD-COUNT GREATER 50 NC2244.2 +027900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2244.2 +028000Y MOVE SPACE TO DUMMY-RECORD NC2244.2 +028100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2244.2 +028200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2244.2 +028300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2244.2 +028400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2244.2 +028500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2244.2 +028600Y MOVE ZERO TO RECORD-COUNT. NC2244.2 +028700 PERFORM WRT-LN. NC2244.2 +028800 WRT-LN. NC2244.2 +028900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2244.2 +029000 MOVE SPACE TO DUMMY-RECORD. NC2244.2 +029100 BLANK-LINE-PRINT. NC2244.2 +029200 PERFORM WRT-LN. NC2244.2 +029300 FAIL-ROUTINE. NC2244.2 +029400 IF COMPUTED-X NOT EQUAL TO SPACE NC2244.2 +029500 GO TO FAIL-ROUTINE-WRITE. NC2244.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2244.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2244.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2244.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2244.2 +030100 GO TO FAIL-ROUTINE-EX. NC2244.2 +030200 FAIL-ROUTINE-WRITE. NC2244.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2244.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2244.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2244.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2244.2 +030700 FAIL-ROUTINE-EX. EXIT. NC2244.2 +030800 BAIL-OUT. NC2244.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2244.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2244.2 +031100 BAIL-OUT-WRITE. NC2244.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2244.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2244.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2244.2 +031600 BAIL-OUT-EX. EXIT. NC2244.2 +031700 CCVS1-EXIT. NC2244.2 +031800 EXIT. NC2244.2 +031900 SECT-NC224A-001 SECTION. NC2244.2 +032000* NC2244.2 +032100 REF-INIT-GF-1. NC2244.2 +032200 MOVE "REFERENCE MODIFICATION" TO FEATURE. NC2244.2 +032300 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +032400 MOVE 123456 TO TEST-1-DATA. NC2244.2 +032500 MOVE 1 TO REC-CT. NC2244.2 +032600 GO TO REF-TEST-GF-1-1. NC2244.2 +032700 REF-DELETE-GF-1. NC2244.2 +032800 PERFORM DE-LETE. NC2244.2 +032900 PERFORM PRINT-DETAIL. NC2244.2 +033000 GO TO REF-INIT-GF-2. NC2244.2 +033100 REF-TEST-GF-1-1. NC2244.2 +033200 MOVE "REF-TEST-GF-1-1" TO PAR-NAME. NC2244.2 +033300 IF TEST-1-DATA (3:) = 3456 NC2244.2 +033400 PERFORM PASS NC2244.2 +033500 GO TO REF-WRITE-GF-1-1 NC2244.2 +033600 ELSE NC2244.2 +033700 GO TO REF-FAIL-GF-1-1. NC2244.2 +033800 REF-DELETE-GF-1-1. NC2244.2 +033900 PERFORM DE-LETE. NC2244.2 +034000 GO TO REF-WRITE-GF-1-1. NC2244.2 +034100 REF-FAIL-GF-1-1. NC2244.2 +034200 MOVE 3456 TO CORRECT-N NC2244.2 +034300 MOVE TEST-1-DATA (3:) TO COMPUTED-X NC2244.2 +034400 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +034500 PERFORM FAIL. NC2244.2 +034600 REF-WRITE-GF-1-1. NC2244.2 +034700 PERFORM PRINT-DETAIL. NC2244.2 +034800* NC2244.2 +034900 REF-TEST-GF-1-2. NC2244.2 +035000 ADD 1 TO REC-CT. NC2244.2 +035100 MOVE "REF-TEST-GF-1-2" TO PAR-NAME. NC2244.2 +035200 IF TEST-1-DATA (2: WS-3) = 234 NC2244.2 +035300 PERFORM PASS NC2244.2 +035400 GO TO REF-WRITE-GF-1-2 NC2244.2 +035500 ELSE NC2244.2 +035600 GO TO REF-FAIL-GF-1-2. NC2244.2 +035700 REF-DELETE-GF-1-2. NC2244.2 +035800 PERFORM DE-LETE. NC2244.2 +035900 GO TO REF-WRITE-GF-1-2. NC2244.2 +036000 REF-FAIL-GF-1-2. NC2244.2 +036100 MOVE 234 TO CORRECT-N NC2244.2 +036200 MOVE TEST-1-DATA (2: WS-3) TO COMPUTED-X NC2244.2 +036300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +036400 PERFORM FAIL. NC2244.2 +036500 REF-WRITE-GF-1-2. NC2244.2 +036600 PERFORM PRINT-DETAIL. NC2244.2 +036700* NC2244.2 +036800 REF-TEST-GF-1-3. NC2244.2 +036900 ADD 1 TO REC-CT. NC2244.2 +037000 MOVE "REF-TEST-GF-1-3" TO PAR-NAME. NC2244.2 +037100 IF TEST-1-DATA (10 - 7: 6 + 2 - 5) = 345 NC2244.2 +037200 PERFORM PASS NC2244.2 +037300 GO TO REF-WRITE-GF-1-3 NC2244.2 +037400 ELSE NC2244.2 +037500 GO TO REF-FAIL-GF-1-3. NC2244.2 +037600 REF-DELETE-GF-1-3. NC2244.2 +037700 PERFORM DE-LETE. NC2244.2 +037800 GO TO REF-WRITE-GF-1-3. NC2244.2 +037900 REF-FAIL-GF-1-3. NC2244.2 +038000 MOVE 345 TO CORRECT-N NC2244.2 +038100 MOVE TEST-1-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +038200 TO COMPUTED-X NC2244.2 +038300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +038400 PERFORM FAIL. NC2244.2 +038500 REF-WRITE-GF-1-3. NC2244.2 +038600 PERFORM PRINT-DETAIL. NC2244.2 +038700* NC2244.2 +038800 REF-INIT-GF-2. NC2244.2 +038900 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +039000 MOVE 1234 TO TEST-2-DATA. NC2244.2 +039100 MOVE 1 TO REC-CT. NC2244.2 +039200 GO TO REF-TEST-GF-2-1. NC2244.2 +039300 REF-DELETE-GF-2. NC2244.2 +039400 PERFORM DE-LETE. NC2244.2 +039500 PERFORM PRINT-DETAIL. NC2244.2 +039600 GO TO REF-INIT-GF-3. NC2244.2 +039700 REF-TEST-GF-2-1. NC2244.2 +039800 MOVE "REF-TEST-GF-2-1" TO PAR-NAME. NC2244.2 +039900 IF TEST-2-DATA (WS-3:) = "1234" NC2244.2 +040000 PERFORM PASS NC2244.2 +040100 GO TO REF-WRITE-GF-2-1 NC2244.2 +040200 ELSE NC2244.2 +040300 GO TO REF-FAIL-GF-2-1. NC2244.2 +040400 REF-DELETE-GF-2-1. NC2244.2 +040500 PERFORM DE-LETE. NC2244.2 +040600 GO TO REF-WRITE-GF-2-1. NC2244.2 +040700 REF-FAIL-GF-2-1. NC2244.2 +040800 MOVE "1234" TO CORRECT-X NC2244.2 +040900 MOVE TEST-2-DATA (WS-3:) TO COMPUTED-X NC2244.2 +041000 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +041100 PERFORM FAIL. NC2244.2 +041200 REF-WRITE-GF-2-1. NC2244.2 +041300 PERFORM PRINT-DETAIL. NC2244.2 +041400* NC2244.2 +041500 REF-TEST-GF-2-2. NC2244.2 +041600 ADD 1 TO REC-CT. NC2244.2 +041700 MOVE "REF-TEST-GF-2-2" TO PAR-NAME. NC2244.2 +041800 IF TEST-2-DATA (WS-2: 3) = " 12" NC2244.2 +041900 PERFORM PASS NC2244.2 +042000 GO TO REF-WRITE-GF-2-2 NC2244.2 +042100 ELSE NC2244.2 +042200 GO TO REF-FAIL-GF-2-2. NC2244.2 +042300 REF-DELETE-GF-2-2. NC2244.2 +042400 PERFORM DE-LETE. NC2244.2 +042500 GO TO REF-WRITE-GF-2-2. NC2244.2 +042600 REF-FAIL-GF-2-2. NC2244.2 +042700 MOVE " 12" TO CORRECT-X NC2244.2 +042800 MOVE TEST-2-DATA (WS-2: 3) TO COMPUTED-X NC2244.2 +042900 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +043000 PERFORM FAIL. NC2244.2 +043100 REF-WRITE-GF-2-2. NC2244.2 +043200 PERFORM PRINT-DETAIL. NC2244.2 +043300* NC2244.2 +043400 REF-TEST-GF-2-3. NC2244.2 +043500 ADD 1 TO REC-CT. NC2244.2 +043600 MOVE "REF-TEST-GF-2-3" TO PAR-NAME. NC2244.2 +043700 IF TEST-2-DATA (10 - 7: 6 + 2 - 5) = "123" NC2244.2 +043800 PERFORM PASS NC2244.2 +043900 GO TO REF-WRITE-GF-2-3 NC2244.2 +044000 ELSE NC2244.2 +044100 GO TO REF-FAIL-GF-2-3. NC2244.2 +044200 REF-DELETE-GF-2-3. NC2244.2 +044300 PERFORM DE-LETE. NC2244.2 +044400 GO TO REF-WRITE-GF-2-3. NC2244.2 +044500 REF-FAIL-GF-2-3. NC2244.2 +044600 MOVE "123" TO CORRECT-X NC2244.2 +044700 MOVE TEST-2-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +044800 TO COMPUTED-X NC2244.2 +044900 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +045000 PERFORM FAIL. NC2244.2 +045100 REF-WRITE-GF-2-3. NC2244.2 +045200 PERFORM PRINT-DETAIL. NC2244.2 +045300* NC2244.2 +045400 REF-INIT-GF-3. NC2244.2 +045500 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +045600 MOVE "ABCDEF" TO TEST-3-DATA IN TEST-3-DATA-GRP. NC2244.2 +045700 MOVE 1 TO REC-CT. NC2244.2 +045800 GO TO REF-TEST-GF-3-1. NC2244.2 +045900 REF-DELETE-GF-3. NC2244.2 +046000 PERFORM DE-LETE. NC2244.2 +046100 PERFORM PRINT-DETAIL. NC2244.2 +046200 GO TO REF-INIT-GF-3. NC2244.2 +046300 REF-TEST-GF-3-1. NC2244.2 +046400 MOVE "REF-TEST-GF-3-1" TO PAR-NAME. NC2244.2 +046500 IF TEST-3-DATA IN TEST-3-DATA-GRP (3:) = "CDEF" NC2244.2 +046600 PERFORM PASS NC2244.2 +046700 GO TO REF-WRITE-GF-3-1 NC2244.2 +046800 ELSE NC2244.2 +046900 GO TO REF-FAIL-GF-3-1. NC2244.2 +047000 REF-DELETE-GF-3-1. NC2244.2 +047100 PERFORM DE-LETE. NC2244.2 +047200 GO TO REF-WRITE-GF-3-1. NC2244.2 +047300 REF-FAIL-GF-3-1. NC2244.2 +047400 MOVE "CDEF" TO CORRECT-X. NC2244.2 +047500 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (3:) TO COMPUTED-X. NC2244.2 +047600 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK. NC2244.2 +047700 PERFORM FAIL. NC2244.2 +047800 REF-WRITE-GF-3-1. NC2244.2 +047900 PERFORM PRINT-DETAIL. NC2244.2 +048000* NC2244.2 +048100 REF-TEST-GF-3-2. NC2244.2 +048200 ADD 1 TO REC-CT. NC2244.2 +048300 MOVE "REF-TEST-GF-3-2" TO PAR-NAME. NC2244.2 +048400 IF TEST-3-DATA IN TEST-3-DATA-GRP (2: WS-3) = "BCD" NC2244.2 +048500 PERFORM PASS NC2244.2 +048600 GO TO REF-WRITE-GF-3-2 NC2244.2 +048700 ELSE NC2244.2 +048800 GO TO REF-FAIL-GF-3-2. NC2244.2 +048900 REF-DELETE-GF-3-2. NC2244.2 +049000 PERFORM DE-LETE. NC2244.2 +049100 GO TO REF-WRITE-GF-3-2. NC2244.2 +049200 REF-FAIL-GF-3-2. NC2244.2 +049300 MOVE "BCD" TO CORRECT-X. NC2244.2 +049400 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (2: WS-3) NC2244.2 +049500 TO COMPUTED-X. NC2244.2 +049600 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK. NC2244.2 +049700 PERFORM FAIL. NC2244.2 +049800 REF-WRITE-GF-3-2. NC2244.2 +049900 PERFORM PRINT-DETAIL. NC2244.2 +050000* NC2244.2 +050100 REF-TEST-GF-3-3. NC2244.2 +050200 ADD 1 TO REC-CT. NC2244.2 +050300 MOVE "REF-TEST-GF-3-3" TO PAR-NAME. NC2244.2 +050400 IF TEST-3-DATA IN TEST-3-DATA-GRP (10 - 7: 6 + 2 - 5) NC2244.2 +050500 = "CDE" NC2244.2 +050600 PERFORM PASS NC2244.2 +050700 GO TO REF-WRITE-GF-3-3 NC2244.2 +050800 ELSE NC2244.2 +050900 GO TO REF-FAIL-GF-3-3. NC2244.2 +051000 REF-DELETE-GF-3-3. NC2244.2 +051100 PERFORM DE-LETE. NC2244.2 +051200 GO TO REF-WRITE-GF-3-3. NC2244.2 +051300 REF-FAIL-GF-3-3. NC2244.2 +051400 MOVE "CDE" TO CORRECT-X. NC2244.2 +051500 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (10 - 7: 6 + 2 - 5) NC2244.2 +051600 TO COMPUTED-X NC2244.2 +051700 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +051800 PERFORM FAIL. NC2244.2 +051900 REF-WRITE-GF-3-3. NC2244.2 +052000 PERFORM PRINT-DETAIL. NC2244.2 +052100* NC2244.2 +052200 REF-INIT-GF-4. NC2244.2 +052300 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +052400 MOVE "ABCDEF" TO TEST-4-DATA. NC2244.2 +052500 MOVE 1 TO REC-CT. NC2244.2 +052600 GO TO REF-TEST-GF-4-1. NC2244.2 +052700 REF-DELETE-GF-4. NC2244.2 +052800 PERFORM DE-LETE. NC2244.2 +052900 PERFORM PRINT-DETAIL. NC2244.2 +053000 GO TO REF-INIT-GF-5. NC2244.2 +053100 REF-TEST-GF-4-1. NC2244.2 +053200 MOVE "REF-TEST-GF-4-1" TO PAR-NAME. NC2244.2 +053300 IF TEST-4-DATA (3:) = " CD EF" NC2244.2 +053400 PERFORM PASS NC2244.2 +053500 GO TO REF-WRITE-GF-4-1 NC2244.2 +053600 ELSE NC2244.2 +053700 GO TO REF-FAIL-GF-4-1. NC2244.2 +053800 REF-DELETE-GF-4-1. NC2244.2 +053900 PERFORM DE-LETE. NC2244.2 +054000 GO TO REF-WRITE-GF-4-1. NC2244.2 +054100 REF-FAIL-GF-4-1. NC2244.2 +054200 MOVE " CD EF" TO CORRECT-X NC2244.2 +054300 MOVE TEST-4-DATA (3:) TO COMPUTED-X NC2244.2 +054400 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +054500 PERFORM FAIL. NC2244.2 +054600 REF-WRITE-GF-4-1. NC2244.2 +054700 PERFORM PRINT-DETAIL. NC2244.2 +054800* NC2244.2 +054900 REF-TEST-GF-4-2. NC2244.2 +055000 ADD 1 TO REC-CT. NC2244.2 +055100 MOVE "REF-TEST-GF-4-2" TO PAR-NAME. NC2244.2 +055200 IF TEST-4-DATA (WS-2: WS-3) = "B C" NC2244.2 +055300 PERFORM PASS NC2244.2 +055400 GO TO REF-WRITE-GF-4-2 NC2244.2 +055500 ELSE NC2244.2 +055600 GO TO REF-FAIL-GF-4-2. NC2244.2 +055700 REF-DELETE-GF-4-2. NC2244.2 +055800 PERFORM DE-LETE. NC2244.2 +055900 GO TO REF-WRITE-GF-4-2. NC2244.2 +056000 REF-FAIL-GF-4-2. NC2244.2 +056100 MOVE "B C" TO CORRECT-X NC2244.2 +056200 MOVE TEST-4-DATA (WS-2: WS-3) TO COMPUTED-X NC2244.2 +056300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +056400 PERFORM FAIL. NC2244.2 +056500 REF-WRITE-GF-4-2. NC2244.2 +056600 PERFORM PRINT-DETAIL. NC2244.2 +056700* NC2244.2 +056800 REF-TEST-GF-4-3. NC2244.2 +056900 ADD 1 TO REC-CT. NC2244.2 +057000 MOVE "REF-TEST-GF-4-3" TO PAR-NAME. NC2244.2 +057100 IF TEST-4-DATA (10 - 7: 6 + 2 - 5) = " CD" NC2244.2 +057200 PERFORM PASS NC2244.2 +057300 GO TO REF-WRITE-GF-4-3 NC2244.2 +057400 ELSE NC2244.2 +057500 GO TO REF-FAIL-GF-4-3. NC2244.2 +057600 REF-DELETE-GF-4-3. NC2244.2 +057700 PERFORM DE-LETE. NC2244.2 +057800 GO TO REF-WRITE-GF-4-3. NC2244.2 +057900 REF-FAIL-GF-4-3. NC2244.2 +058000 MOVE " CD" TO CORRECT-X NC2244.2 +058100 MOVE TEST-4-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +058200 TO COMPUTED-X NC2244.2 +058300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +058400 PERFORM FAIL. NC2244.2 +058500 REF-WRITE-GF-4-3. NC2244.2 +058600 PERFORM PRINT-DETAIL. NC2244.2 +058700* NC2244.2 +058800 REF-INIT-GF-5. NC2244.2 +058900* ===--> SUBSCRIPTED DATA-NAME <--=== NC2244.2 +059000 MOVE "IV-22 4.3.8.3.3 SR4" TO ANSI-REFERENCE. NC2244.2 +059100 MOVE 12345678 TO TABLE-1 (3 2). NC2244.2 +059200 MOVE 1 TO REC-CT. NC2244.2 +059300 GO TO REF-TEST-GF-5-1. NC2244.2 +059400 REF-DELETE-GF-5. NC2244.2 +059500 PERFORM DE-LETE. NC2244.2 +059600 PERFORM PRINT-DETAIL. NC2244.2 +059700 GO TO REF-INIT-GF-6. NC2244.2 +059800 REF-TEST-GF-5-1. NC2244.2 +059900 MOVE "REF-TEST-GF-5-1" TO PAR-NAME. NC2244.2 +060000 IF TABLE-1 (3 2) (2: 5) = 23456 NC2244.2 +060100 PERFORM PASS NC2244.2 +060200 GO TO REF-WRITE-GF-5-1 NC2244.2 +060300 ELSE NC2244.2 +060400 GO TO REF-FAIL-GF-5-1. NC2244.2 +060500 REF-DELETE-GF-5-1. NC2244.2 +060600 PERFORM DE-LETE. NC2244.2 +060700 GO TO REF-WRITE-GF-5-1. NC2244.2 +060800 REF-FAIL-GF-5-1. NC2244.2 +060900 MOVE 23456 TO CORRECT-N NC2244.2 +061000 MOVE TABLE-1 (3 2) (2: 5) TO COMPUTED-X NC2244.2 +061100 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +061200 PERFORM FAIL. NC2244.2 +061300 REF-WRITE-GF-5-1. NC2244.2 +061400 PERFORM PRINT-DETAIL. NC2244.2 +061500* NC2244.2 +061600 REF-INIT-GF-6. NC2244.2 +061700* ===--> QUALIFIED DATA-NAME <--=== NC2244.2 +061800 MOVE "IV-22 4.3.8.3.3 SR4" TO ANSI-REFERENCE. NC2244.2 +061900 MOVE "OPQRST" TO TEST-3-DATA OF TEST-5-TABLE. NC2244.2 +062000 MOVE 1 TO REC-CT. NC2244.2 +062100 GO TO REF-TEST-GF-6-1. NC2244.2 +062200 REF-DELETE-GF-6. NC2244.2 +062300 PERFORM DE-LETE. NC2244.2 +062400 PERFORM PRINT-DETAIL. NC2244.2 +062500 GO TO CCVS-EXIT. NC2244.2 +062600 REF-TEST-GF-6-1. NC2244.2 +062700 MOVE "REF-TEST-GF-6-1" TO PAR-NAME. NC2244.2 +062800 IF TEST-3-DATA OF TEST-5-TABLE (2: 4) = "PQRS" NC2244.2 +062900 PERFORM PASS NC2244.2 +063000 GO TO REF-WRITE-GF-6-1 NC2244.2 +063100 ELSE NC2244.2 +063200 GO TO REF-FAIL-GF-6-1. NC2244.2 +063300 REF-DELETE-GF-6-1. NC2244.2 +063400 PERFORM DE-LETE. NC2244.2 +063500 GO TO REF-WRITE-GF-6-1. NC2244.2 +063600 REF-FAIL-GF-6-1. NC2244.2 +063700 MOVE "PQRS" TO CORRECT-X. NC2244.2 +063800 MOVE TEST-3-DATA OF TEST-5-TABLE (2: 4) NC2244.2 +063900 TO COMPUTED-X NC2244.2 +064000 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +064100 PERFORM FAIL. NC2244.2 +064200 REF-WRITE-GF-6-1. NC2244.2 +064300 PERFORM PRINT-DETAIL. NC2244.2 +064400* NC2244.2 +064500 CCVS-EXIT SECTION. NC2244.2 +064600 CCVS-999999. NC2244.2 +064700 GO TO CLOSE-FILES. NC2244.2 +*END-OF,NC224A +*HEADER,COBOL,NC225A +000100 IDENTIFICATION DIVISION. NC2254.2 +000200 PROGRAM-ID. NC2254.2 +000300 NC225A. NC2254.2 +000400**************************************************************** NC2254.2 +000500* * NC2254.2 +000600* VALIDATION FOR:- * NC2254.2 +000700* * NC2254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +000900* * NC2254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2254.2 +001100* * NC2254.2 +001200**************************************************************** NC2254.2 +001300* * NC2254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2254.2 +001500* * NC2254.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2254.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2254.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2254.2 +001900* * NC2254.2 +002000**************************************************************** NC2254.2 +002100* * NC2254.2 +002200* PROGRAM NC225A TESTS THE USE OF THE "EVALUATE" STATEMENT. * NC2254.2 +002300* VARIOUS COMBINATIONS OF IDENTIFIERS, LITERALS, ARITHMETIC * NC2254.2 +002400* EXPRESSIONS AND CONDITIONAL EXPRESSIONS AS WELL AS THE * NC2254.2 +002500* OPTIONAL WORDS "TRUE" AND "FALSE" ARE USED AS SELECTION * NC2254.2 +002600* SUBJECTS AND SELECTION OBJECTS. * NC2254.2 +002700* MULTIPLE SELECTION SUBJECTS AND SETS OF SELECTION * NC2254.2 +002800* OBJECTS ARE ALSO TESTED. * NC2254.2 +002900* * NC2254.2 +003000**************************************************************** NC2254.2 +003100 ENVIRONMENT DIVISION. NC2254.2 +003200 CONFIGURATION SECTION. NC2254.2 +003300 SOURCE-COMPUTER. NC2254.2 +003400 XXXXX082. NC2254.2 +003500 OBJECT-COMPUTER. NC2254.2 +003600 XXXXX083. NC2254.2 +003700 INPUT-OUTPUT SECTION. NC2254.2 +003800 FILE-CONTROL. NC2254.2 +003900 SELECT PRINT-FILE ASSIGN TO NC2254.2 +004000 XXXXX055. NC2254.2 +004100 DATA DIVISION. NC2254.2 +004200 FILE SECTION. NC2254.2 +004300 FD PRINT-FILE. NC2254.2 +004400 01 PRINT-REC PICTURE X(120). NC2254.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC2254.2 +004600 WORKING-STORAGE SECTION. NC2254.2 +004700 01 WRK-XN-00001-1 PIC X. NC2254.2 +004800 01 WRK-XN-00001-2 PIC X. NC2254.2 +004900 01 WRK-XN-00001-3 PIC X. NC2254.2 +005000 01 WRK-XN-00001-4 PIC X. NC2254.2 +005100 01 WRK-DU-02V00 PIC 99. NC2254.2 +005200 01 WRK-DU-08V00 PIC 9(8). NC2254.2 +005300 01 WRK-DU-08V00-1 PIC 9(8). NC2254.2 +005400 01 WRK-DU-08V00-2 PIC 9(8). NC2254.2 +005500 88 IT-IS-81 VALUE 81. NC2254.2 +005600 01 WRK-DU-08V00-3 PIC 9(8). NC2254.2 +005700 01 WRK-DU-08V00-4 PIC 9(8). NC2254.2 +005800 01 TEST-3-DATA PIC X(6) VALUE "ABCDEF". NC2254.2 +005900 01 TEST-4-DATA PIC XXBXXBXX VALUE "AB CD EF". NC2254.2 +006000 NC2254.2 +006100 01 WS-2 PIC S9 VALUE +2. NC2254.2 +006200 01 WS-3 PIC S9 VALUE +3. NC2254.2 +006300 01 WS-5 PIC S9 VALUE +5. NC2254.2 +006400 01 WS-6 PIC S9 VALUE +6. NC2254.2 +006500 01 WS-7 PIC S9 VALUE +7. NC2254.2 +006600 01 WS-10 PIC S99 VALUE +10. NC2254.2 +006700 01 WS-81 PIC S99 VALUE +81. NC2254.2 +006800 01 TEST-5-TABLE. NC2254.2 +006900 03 TABLE-GROUP OCCURS 4. NC2254.2 +007000 05 TABLE-1 PIC 9(8) NC2254.2 +007100 OCCURS 2. NC2254.2 +007200 03 TEST-5-DATA PIC X(6). NC2254.2 +007300* NC2254.2 +007400 01 TEST-RESULTS. NC2254.2 +007500 02 FILLER PIC X VALUE SPACE. NC2254.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. NC2254.2 +007700 02 FILLER PIC X VALUE SPACE. NC2254.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. NC2254.2 +007900 02 FILLER PIC X VALUE SPACE. NC2254.2 +008000 02 PAR-NAME. NC2254.2 +008100 03 FILLER PIC X(19) VALUE SPACE. NC2254.2 +008200 03 PARDOT-X PIC X VALUE SPACE. NC2254.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. NC2254.2 +008400 02 FILLER PIC X(8) VALUE SPACE. NC2254.2 +008500 02 RE-MARK PIC X(61). NC2254.2 +008600 01 TEST-COMPUTED. NC2254.2 +008700 02 FILLER PIC X(30) VALUE SPACE. NC2254.2 +008800 02 FILLER PIC X(17) VALUE NC2254.2 +008900 " COMPUTED=". NC2254.2 +009000 02 COMPUTED-X. NC2254.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2254.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A NC2254.2 +009300 PIC -9(9).9(9). NC2254.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2254.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2254.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2254.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. NC2254.2 +009800 04 COMPUTED-18V0 PIC -9(18). NC2254.2 +009900 04 FILLER PIC X. NC2254.2 +010000 03 FILLER PIC X(50) VALUE SPACE. NC2254.2 +010100 01 TEST-CORRECT. NC2254.2 +010200 02 FILLER PIC X(30) VALUE SPACE. NC2254.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2254.2 +010400 02 CORRECT-X. NC2254.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2254.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2254.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2254.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2254.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2254.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. NC2254.2 +011100 04 CORRECT-18V0 PIC -9(18). NC2254.2 +011200 04 FILLER PIC X. NC2254.2 +011300 03 FILLER PIC X(2) VALUE SPACE. NC2254.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2254.2 +011500 01 CCVS-C-1. NC2254.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2254.2 +011700- "SS PARAGRAPH-NAME NC2254.2 +011800- " REMARKS". NC2254.2 +011900 02 FILLER PIC X(20) VALUE SPACE. NC2254.2 +012000 01 CCVS-C-2. NC2254.2 +012100 02 FILLER PIC X VALUE SPACE. NC2254.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". NC2254.2 +012300 02 FILLER PIC X(15) VALUE SPACE. NC2254.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". NC2254.2 +012500 02 FILLER PIC X(94) VALUE SPACE. NC2254.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2254.2 +012700 01 REC-CT PIC 99 VALUE ZERO. NC2254.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2254.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2254.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2254.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2254.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2254.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2254.2 +013700 01 CCVS-H-1. NC2254.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2254.2 +013900 02 FILLER PIC X(42) VALUE NC2254.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2254.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC2254.2 +014200 01 CCVS-H-2A. NC2254.2 +014300 02 FILLER PIC X(40) VALUE SPACE. NC2254.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2254.2 +014500 02 FILLER PIC XXXX VALUE NC2254.2 +014600 "4.2 ". NC2254.2 +014700 02 FILLER PIC X(28) VALUE NC2254.2 +014800 " COPY - NOT FOR DISTRIBUTION". NC2254.2 +014900 02 FILLER PIC X(41) VALUE SPACE. NC2254.2 +015000 NC2254.2 +015100 01 CCVS-H-2B. NC2254.2 +015200 02 FILLER PIC X(15) VALUE NC2254.2 +015300 "TEST RESULT OF ". NC2254.2 +015400 02 TEST-ID PIC X(9). NC2254.2 +015500 02 FILLER PIC X(4) VALUE NC2254.2 +015600 " IN ". NC2254.2 +015700 02 FILLER PIC X(12) VALUE NC2254.2 +015800 " HIGH ". NC2254.2 +015900 02 FILLER PIC X(22) VALUE NC2254.2 +016000 " LEVEL VALIDATION FOR ". NC2254.2 +016100 02 FILLER PIC X(58) VALUE NC2254.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +016300 01 CCVS-H-3. NC2254.2 +016400 02 FILLER PIC X(34) VALUE NC2254.2 +016500 " FOR OFFICIAL USE ONLY ". NC2254.2 +016600 02 FILLER PIC X(58) VALUE NC2254.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2254.2 +016800 02 FILLER PIC X(28) VALUE NC2254.2 +016900 " COPYRIGHT 1985 ". NC2254.2 +017000 01 CCVS-E-1. NC2254.2 +017100 02 FILLER PIC X(52) VALUE SPACE. NC2254.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2254.2 +017300 02 ID-AGAIN PIC X(9). NC2254.2 +017400 02 FILLER PIC X(45) VALUE SPACES. NC2254.2 +017500 01 CCVS-E-2. NC2254.2 +017600 02 FILLER PIC X(31) VALUE SPACE. NC2254.2 +017700 02 FILLER PIC X(21) VALUE SPACE. NC2254.2 +017800 02 CCVS-E-2-2. NC2254.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2254.2 +018000 03 FILLER PIC X VALUE SPACE. NC2254.2 +018100 03 ENDER-DESC PIC X(44) VALUE NC2254.2 +018200 "ERRORS ENCOUNTERED". NC2254.2 +018300 01 CCVS-E-3. NC2254.2 +018400 02 FILLER PIC X(22) VALUE NC2254.2 +018500 " FOR OFFICIAL USE ONLY". NC2254.2 +018600 02 FILLER PIC X(12) VALUE SPACE. NC2254.2 +018700 02 FILLER PIC X(58) VALUE NC2254.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +018900 02 FILLER PIC X(13) VALUE SPACE. NC2254.2 +019000 02 FILLER PIC X(15) VALUE NC2254.2 +019100 " COPYRIGHT 1985". NC2254.2 +019200 01 CCVS-E-4. NC2254.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2254.2 +019400 02 FILLER PIC X(4) VALUE " OF ". NC2254.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2254.2 +019600 02 FILLER PIC X(40) VALUE NC2254.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2254.2 +019800 01 XXINFO. NC2254.2 +019900 02 FILLER PIC X(19) VALUE NC2254.2 +020000 "*** INFORMATION ***". NC2254.2 +020100 02 INFO-TEXT. NC2254.2 +020200 04 FILLER PIC X(8) VALUE SPACE. NC2254.2 +020300 04 XXCOMPUTED PIC X(20). NC2254.2 +020400 04 FILLER PIC X(5) VALUE SPACE. NC2254.2 +020500 04 XXCORRECT PIC X(20). NC2254.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). NC2254.2 +020700 01 HYPHEN-LINE. NC2254.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. NC2254.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************NC2254.2 +021000- "*****************************************". NC2254.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************NC2254.2 +021200- "******************************". NC2254.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE NC2254.2 +021400 "NC225A". NC2254.2 +021500 PROCEDURE DIVISION. NC2254.2 +021600 CCVS1 SECTION. NC2254.2 +021700 OPEN-FILES. NC2254.2 +021800 OPEN OUTPUT PRINT-FILE. NC2254.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2254.2 +022000 MOVE SPACE TO TEST-RESULTS. NC2254.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2254.2 +022200 GO TO CCVS1-EXIT. NC2254.2 +022300 CLOSE-FILES. NC2254.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2254.2 +022500 TERMINATE-CCVS. NC2254.2 +022600S EXIT PROGRAM. NC2254.2 +022700STERMINATE-CALL. NC2254.2 +022800 STOP RUN. NC2254.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2254.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2254.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2254.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2254.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. NC2254.2 +023400 PRINT-DETAIL. NC2254.2 +023500 IF REC-CT NOT EQUAL TO ZERO NC2254.2 +023600 MOVE "." TO PARDOT-X NC2254.2 +023700 MOVE REC-CT TO DOTVALUE. NC2254.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2254.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2254.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2254.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2254.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2254.2 +024300 MOVE SPACE TO CORRECT-X. NC2254.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2254.2 +024500 MOVE SPACE TO RE-MARK. NC2254.2 +024600 HEAD-ROUTINE. NC2254.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2254.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2254.2 +025100 COLUMN-NAMES-ROUTINE. NC2254.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +025500 END-ROUTINE. NC2254.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2254.2 +025700 END-RTN-EXIT. NC2254.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +025900 END-ROUTINE-1. NC2254.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2254.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2254.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. NC2254.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2254.2 +026400 NC2254.2 +026500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2254.2 +026600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2254.2 +026700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2254.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2254.2 +026900 END-ROUTINE-12. NC2254.2 +027000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2254.2 +027100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2254.2 +027200 MOVE "NO " TO ERROR-TOTAL NC2254.2 +027300 ELSE NC2254.2 +027400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2254.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2254.2 +027600 PERFORM WRITE-LINE. NC2254.2 +027700 END-ROUTINE-13. NC2254.2 +027800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2254.2 +027900 MOVE "NO " TO ERROR-TOTAL ELSE NC2254.2 +028000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2254.2 +028100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2254.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028300 IF INSPECT-COUNTER EQUAL TO ZERO NC2254.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2254.2 +028500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2254.2 +028600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2254.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028900 WRITE-LINE. NC2254.2 +029000 ADD 1 TO RECORD-COUNT. NC2254.2 +029100Y IF RECORD-COUNT GREATER 50 NC2254.2 +029200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2254.2 +029300Y MOVE SPACE TO DUMMY-RECORD NC2254.2 +029400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2254.2 +029500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2254.2 +029600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2254.2 +029700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2254.2 +029800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2254.2 +029900Y MOVE ZERO TO RECORD-COUNT. NC2254.2 +030000 PERFORM WRT-LN. NC2254.2 +030100 WRT-LN. NC2254.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2254.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC2254.2 +030400 BLANK-LINE-PRINT. NC2254.2 +030500 PERFORM WRT-LN. NC2254.2 +030600 FAIL-ROUTINE. NC2254.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC2254.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC2254.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2254.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2254.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2254.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2254.2 +031400 GO TO FAIL-ROUTINE-EX. NC2254.2 +031500 FAIL-ROUTINE-WRITE. NC2254.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2254.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2254.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2254.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2254.2 +032000 FAIL-ROUTINE-EX. EXIT. NC2254.2 +032100 BAIL-OUT. NC2254.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2254.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2254.2 +032400 BAIL-OUT-WRITE. NC2254.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2254.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2254.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2254.2 +032900 BAIL-OUT-EX. EXIT. NC2254.2 +033000 CCVS1-EXIT. NC2254.2 +033100 EXIT. NC2254.2 +033200* NC2254.2 +033300 SECT-NC225A-001-1 SECTION. NC2254.2 +033400* NC2254.2 +033500 EVA-INIT-GF-1. NC2254.2 +033600 MOVE "EVALUATE STATEMENT" TO FEATURE. NC2254.2 +033700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +033800 MOVE 1 TO REC-CT. NC2254.2 +033900 MOVE "6" TO WRK-XN-00001-1. NC2254.2 +034000 GO TO EVA-TEST-GF-1-1. NC2254.2 +034100 EVA-DELETE-GF-1. NC2254.2 +034200 PERFORM DE-LETE. NC2254.2 +034300 PERFORM PRINT-DETAIL. NC2254.2 +034400 GO TO EVA-INIT-GF-2. NC2254.2 +034500 EVA-TEST-GF-1-1. NC2254.2 +034600 MOVE "EVA-TEST-GF-1-1" TO PAR-NAME. NC2254.2 +034700 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +034800 WHEN TRUE NC2254.2 +034900 PERFORM PASS NC2254.2 +035000 GO TO EVA-WRITE-GF-1-1. NC2254.2 +035100 GO TO EVA-FAIL-GF-1-1. NC2254.2 +035200 EVA-DELETE-GF-1-1. NC2254.2 +035300 PERFORM DE-LETE. NC2254.2 +035400 GO TO EVA-WRITE-GF-1-1. NC2254.2 +035500 EVA-FAIL-GF-1-1. NC2254.2 +035600 MOVE "EXPECTING NUMERIC CONDITION" TO RE-MARK. NC2254.2 +035700 PERFORM FAIL. NC2254.2 +035800 EVA-WRITE-GF-1-1. NC2254.2 +035900 PERFORM PRINT-DETAIL. NC2254.2 +036000* NC2254.2 +036100 EVA-TEST-GF-1-2. NC2254.2 +036200 ADD 1 TO REC-CT. NC2254.2 +036300 MOVE "EVA-TEST-GF-1-2" TO PAR-NAME. NC2254.2 +036400 EVALUATE WRK-XN-00001-1 NOT NUMERIC NC2254.2 +036500 WHEN TRUE NC2254.2 +036600 GO TO EVA-FAIL-GF-1-2. NC2254.2 +036700 PERFORM PASS. NC2254.2 +036800 GO TO EVA-WRITE-GF-1-2. NC2254.2 +036900 EVA-DELETE-GF-1-2. NC2254.2 +037000 PERFORM DE-LETE. NC2254.2 +037100 GO TO EVA-WRITE-GF-1-2. NC2254.2 +037200 EVA-FAIL-GF-1-2. NC2254.2 +037300 MOVE "EXPECTING NUMERIC CONDITION" TO RE-MARK NC2254.2 +037400 PERFORM FAIL. NC2254.2 +037500 EVA-WRITE-GF-1-2. NC2254.2 +037600 PERFORM PRINT-DETAIL. NC2254.2 +037700* NC2254.2 +037800 EVA-INIT-GF-2. NC2254.2 +037900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +038000 MOVE 1 TO REC-CT. NC2254.2 +038100 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +038200 GO TO EVA-TEST-GF-2-1. NC2254.2 +038300 EVA-DELETE-GF-2. NC2254.2 +038400 PERFORM DE-LETE. NC2254.2 +038500 PERFORM PRINT-DETAIL. NC2254.2 +038600 GO TO EVA-INIT-GF-3. NC2254.2 +038700 EVA-TEST-GF-2-1. NC2254.2 +038800 MOVE "EVA-TEST-GF-2-1" TO PAR-NAME. NC2254.2 +038900 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +039000 WHEN TRUE NC2254.2 +039100 GO TO EVA-FAIL-GF-2-1. NC2254.2 +039200 PERFORM PASS. NC2254.2 +039300 GO TO EVA-WRITE-GF-2-1. NC2254.2 +039400 EVA-DELETE-GF-2-1. NC2254.2 +039500 PERFORM DE-LETE. NC2254.2 +039600 GO TO EVA-WRITE-GF-2-1. NC2254.2 +039700 EVA-FAIL-GF-2-1. NC2254.2 +039800 MOVE "EXPECTING NON-NUMERIC CONDITION" TO RE-MARK NC2254.2 +039900 PERFORM FAIL. NC2254.2 +040000 EVA-WRITE-GF-2-1. NC2254.2 +040100 PERFORM PRINT-DETAIL. NC2254.2 +040200* NC2254.2 +040300 EVA-TEST-GF-2-2. NC2254.2 +040400 ADD 1 TO REC-CT. NC2254.2 +040500 MOVE "EVA-TEST-GF-2-2" TO PAR-NAME. NC2254.2 +040600 EVALUATE WRK-XN-00001-1 NOT NUMERIC NC2254.2 +040700 WHEN TRUE NC2254.2 +040800 PERFORM PASS NC2254.2 +040900 GO TO EVA-WRITE-GF-2-2. NC2254.2 +041000 GO TO EVA-FAIL-GF-2-2. NC2254.2 +041100 EVA-DELETE-GF-2-2. NC2254.2 +041200 PERFORM DE-LETE. NC2254.2 +041300 GO TO EVA-WRITE-GF-2-2. NC2254.2 +041400 EVA-FAIL-GF-2-2. NC2254.2 +041500 MOVE "EXPECTING NON-NUMERIC CONDITION" TO RE-MARK. NC2254.2 +041600 PERFORM FAIL. NC2254.2 +041700 EVA-WRITE-GF-2-2. NC2254.2 +041800 PERFORM PRINT-DETAIL. NC2254.2 +041900* NC2254.2 +042000 EVA-INIT-GF-3. NC2254.2 +042100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +042200 MOVE 1 TO REC-CT. NC2254.2 +042300 MOVE "6" TO WRK-XN-00001-1. NC2254.2 +042400 MOVE "6" TO WRK-XN-00001-2. NC2254.2 +042500 GO TO EVA-TEST-GF-3-1. NC2254.2 +042600 EVA-DELETE-GF-3. NC2254.2 +042700 PERFORM DE-LETE. NC2254.2 +042800 PERFORM PRINT-DETAIL. NC2254.2 +042900 GO TO EVA-INIT-GF-4. NC2254.2 +043000 EVA-TEST-GF-3-1. NC2254.2 +043100 MOVE "EVA-TEST-GF-3-1" TO PAR-NAME. NC2254.2 +043200 EVALUATE WRK-XN-00001-1 NC2254.2 +043300 WHEN WRK-XN-00001-2 NC2254.2 +043400 PERFORM PASS NC2254.2 +043500 GO TO EVA-WRITE-GF-3-1. NC2254.2 +043600 GO TO EVA-FAIL-GF-3-1. NC2254.2 +043700 EVA-DELETE-GF-3-1. NC2254.2 +043800 PERFORM DE-LETE. NC2254.2 +043900 GO TO EVA-WRITE-GF-3-1. NC2254.2 +044000 EVA-FAIL-GF-3-1. NC2254.2 +044100 MOVE "EXPECTING EQUAL IDENTIFIER" TO RE-MARK. NC2254.2 +044200 PERFORM FAIL. NC2254.2 +044300 EVA-WRITE-GF-3-1. NC2254.2 +044400 PERFORM PRINT-DETAIL. NC2254.2 +044500* NC2254.2 +044600 EVA-TEST-GF-3-2. NC2254.2 +044700 ADD 1 TO REC-CT. NC2254.2 +044800 MOVE "EVA-TEST-GF-3-2" TO PAR-NAME. NC2254.2 +044900 EVALUATE WRK-XN-00001-1 NC2254.2 +045000 WHEN NOT WRK-XN-00001-2 NC2254.2 +045100 GO TO EVA-FAIL-GF-3-2. NC2254.2 +045200 PERFORM PASS. NC2254.2 +045300 GO TO EVA-WRITE-GF-3-2. NC2254.2 +045400 EVA-DELETE-GF-3-2. NC2254.2 +045500 PERFORM DE-LETE. NC2254.2 +045600 GO TO EVA-WRITE-GF-3-2. NC2254.2 +045700 EVA-FAIL-GF-3-2. NC2254.2 +045800 MOVE "EXPECTING EQUAL IDENTIFIERS" TO RE-MARK NC2254.2 +045900 PERFORM FAIL. NC2254.2 +046000 EVA-WRITE-GF-3-2. NC2254.2 +046100 PERFORM PRINT-DETAIL. NC2254.2 +046200* NC2254.2 +046300 EVA-INIT-GF-4. NC2254.2 +046400 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +046500 MOVE 1 TO REC-CT. NC2254.2 +046600 MOVE "1" TO WRK-XN-00001-1. NC2254.2 +046700 MOVE "*" TO WRK-XN-00001-2. NC2254.2 +046800 GO TO EVA-TEST-GF-4-1. NC2254.2 +046900 EVA-DELETE-GF-4. NC2254.2 +047000 PERFORM DE-LETE. NC2254.2 +047100 PERFORM PRINT-DETAIL. NC2254.2 +047200 GO TO EVA-INIT-GF-5. NC2254.2 +047300 EVA-TEST-GF-4-1. NC2254.2 +047400 MOVE "EVA-TEST-GF-4-1" TO PAR-NAME. NC2254.2 +047500 EVALUATE WRK-XN-00001-1 NC2254.2 +047600 WHEN WRK-XN-00001-2 NC2254.2 +047700 GO TO EVA-FAIL-GF-4-1. NC2254.2 +047800 PERFORM PASS. NC2254.2 +047900 GO TO EVA-WRITE-GF-4-1. NC2254.2 +048000 EVA-DELETE-GF-4-1. NC2254.2 +048100 PERFORM DE-LETE. NC2254.2 +048200 GO TO EVA-WRITE-GF-4-1. NC2254.2 +048300 EVA-FAIL-GF-4-1. NC2254.2 +048400 MOVE "EXPECTING UNEQUAL IDENTIFIERS" TO RE-MARK NC2254.2 +048500 PERFORM FAIL. NC2254.2 +048600 EVA-WRITE-GF-4-1. NC2254.2 +048700 PERFORM PRINT-DETAIL. NC2254.2 +048800* NC2254.2 +048900 EVA-TEST-GF-4-2. NC2254.2 +049000 ADD 1 TO REC-CT. NC2254.2 +049100 EVALUATE WRK-XN-00001-1 NC2254.2 +049200 WHEN NOT WRK-XN-00001-2 NC2254.2 +049300 PERFORM PASS NC2254.2 +049400 GO TO EVA-WRITE-GF-4-2. NC2254.2 +049500 GO TO EVA-FAIL-GF-4-2. NC2254.2 +049600 EVA-DELETE-GF-4-2. NC2254.2 +049700 PERFORM DE-LETE. NC2254.2 +049800 GO TO EVA-WRITE-GF-4-2. NC2254.2 +049900 EVA-FAIL-GF-4-2. NC2254.2 +050000 MOVE "EXPECTING UNEQUAL IDENTIFIERS" TO RE-MARK. NC2254.2 +050100 PERFORM FAIL. NC2254.2 +050200 EVA-WRITE-GF-4-2. NC2254.2 +050300 MOVE "EVA-TEST-GF-4-2" TO PAR-NAME. NC2254.2 +050400 PERFORM PRINT-DETAIL. NC2254.2 +050500* NC2254.2 +050600 EVA-INIT-GF-5. NC2254.2 +050700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +050800 MOVE 1 TO REC-CT. NC2254.2 +050900 MOVE "A" TO WRK-XN-00001-1. NC2254.2 +051000 GO TO EVA-TEST-GF-5-1. NC2254.2 +051100 EVA-DELETE-GF-5. NC2254.2 +051200 PERFORM DE-LETE. NC2254.2 +051300 PERFORM PRINT-DETAIL. NC2254.2 +051400 GO TO EVA-INIT-GF-6. NC2254.2 +051500 EVA-TEST-GF-5-1. NC2254.2 +051600 MOVE "EVA-TEST-GF-5-1" TO PAR-NAME. NC2254.2 +051700 EVALUATE WRK-XN-00001-1 NC2254.2 +051800 WHEN "A" NC2254.2 +051900 PERFORM PASS NC2254.2 +052000 GO TO EVA-WRITE-GF-5-1. NC2254.2 +052100 GO TO EVA-FAIL-GF-5-1. NC2254.2 +052200 EVA-DELETE-GF-5-1. NC2254.2 +052300 PERFORM DE-LETE. NC2254.2 +052400 GO TO EVA-WRITE-GF-5-1. NC2254.2 +052500 EVA-FAIL-GF-5-1. NC2254.2 +052600 MOVE "EXPECTING EQUAL LITERAL" TO RE-MARK. NC2254.2 +052700 PERFORM FAIL. NC2254.2 +052800 EVA-WRITE-GF-5-1. NC2254.2 +052900 PERFORM PRINT-DETAIL. NC2254.2 +053000* NC2254.2 +053100 EVA-TEST-GF-5-2. NC2254.2 +053200 ADD 1 TO REC-CT. NC2254.2 +053300 MOVE "EVA-TEST-GF-5-2" TO PAR-NAME. NC2254.2 +053400 EVALUATE WRK-XN-00001-1 NC2254.2 +053500 WHEN NOT "A" NC2254.2 +053600 GO TO EVA-FAIL-GF-5-2. NC2254.2 +053700 PERFORM PASS. NC2254.2 +053800 GO TO EVA-WRITE-GF-5-2. NC2254.2 +053900 EVA-DELETE-GF-5-2. NC2254.2 +054000 PERFORM DE-LETE. NC2254.2 +054100 GO TO EVA-WRITE-GF-5-2. NC2254.2 +054200 EVA-FAIL-GF-5-2. NC2254.2 +054300 MOVE "EXPECTING EQUAL LITERAL" TO RE-MARK NC2254.2 +054400 PERFORM FAIL. NC2254.2 +054500 EVA-WRITE-GF-5-2. NC2254.2 +054600 PERFORM PRINT-DETAIL. NC2254.2 +054700* NC2254.2 +054800 EVA-INIT-GF-6. NC2254.2 +054900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +055000 MOVE 1 TO REC-CT. NC2254.2 +055100 MOVE "A" TO WRK-XN-00001-1. NC2254.2 +055200 GO TO EVA-TEST-GF-6-1. NC2254.2 +055300 EVA-DELETE-GF-6. NC2254.2 +055400 PERFORM DE-LETE. NC2254.2 +055500 PERFORM PRINT-DETAIL. NC2254.2 +055600 GO TO EVA-INIT-GF-7. NC2254.2 +055700 EVA-TEST-GF-6-1. NC2254.2 +055800 MOVE "EVA-TEST-GF-6-1" TO PAR-NAME. NC2254.2 +055900 EVALUATE WRK-XN-00001-1 NC2254.2 +056000 WHEN "Z" NC2254.2 +056100 GO TO EVA-FAIL-GF-6-1. NC2254.2 +056200 PERFORM PASS. NC2254.2 +056300 GO TO EVA-WRITE-GF-6-1. NC2254.2 +056400 EVA-DELETE-GF-6-1. NC2254.2 +056500 PERFORM DE-LETE. NC2254.2 +056600 GO TO EVA-WRITE-GF-6-1. NC2254.2 +056700 EVA-FAIL-GF-6-1. NC2254.2 +056800 MOVE "EXPECTING UNEQUAL LITERAL" TO RE-MARK NC2254.2 +056900 PERFORM FAIL. NC2254.2 +057000 EVA-WRITE-GF-6-1. NC2254.2 +057100 PERFORM PRINT-DETAIL. NC2254.2 +057200* NC2254.2 +057300 EVA-TEST-GF-6-2. NC2254.2 +057400 ADD 1 TO REC-CT. NC2254.2 +057500 MOVE "EVA-TEST-GF-6-2" TO PAR-NAME. NC2254.2 +057600 EVALUATE WRK-XN-00001-1 NC2254.2 +057700 WHEN NOT "Z" NC2254.2 +057800 PERFORM PASS NC2254.2 +057900 GO TO EVA-WRITE-GF-6-2. NC2254.2 +058000 GO TO EVA-FAIL-GF-6-2. NC2254.2 +058100 EVA-DELETE-GF-6-2. NC2254.2 +058200 PERFORM DE-LETE. NC2254.2 +058300 GO TO EVA-WRITE-GF-6-2. NC2254.2 +058400 EVA-FAIL-GF-6-2. NC2254.2 +058500 MOVE "EXPECTING UNEQUAL LITERAL" TO RE-MARK. NC2254.2 +058600 PERFORM FAIL. NC2254.2 +058700 EVA-WRITE-GF-6-2. NC2254.2 +058800 PERFORM PRINT-DETAIL. NC2254.2 +058900* NC2254.2 +059000 EVA-INIT-GF-7. NC2254.2 +059100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +059200 MOVE 1 TO REC-CT. NC2254.2 +059300 MOVE 89 TO WRK-DU-08V00. NC2254.2 +059400 GO TO EVA-TEST-GF-7-1. NC2254.2 +059500 EVA-DELETE-GF-7. NC2254.2 +059600 PERFORM DE-LETE. NC2254.2 +059700 PERFORM PRINT-DETAIL. NC2254.2 +059800 GO TO EVA-INIT-GF-8. NC2254.2 +059900 EVA-TEST-GF-7-1. NC2254.2 +060000 MOVE "EVA-TEST-GF-7-1" TO PAR-NAME. NC2254.2 +060100 EVALUATE WRK-DU-08V00 NC2254.2 +060200 WHEN (33 + (99 - 43)) NC2254.2 +060300 PERFORM PASS NC2254.2 +060400 GO TO EVA-WRITE-GF-7-1. NC2254.2 +060500 GO TO EVA-FAIL-GF-7-1. NC2254.2 +060600 EVA-DELETE-GF-7-1. NC2254.2 +060700 PERFORM DE-LETE. NC2254.2 +060800 GO TO EVA-WRITE-GF-7-1. NC2254.2 +060900 EVA-FAIL-GF-7-1. NC2254.2 +061000 MOVE "EXPECTING EQUAL ARITHMETIC EXPRESSION" TO RE-MARK. NC2254.2 +061100 PERFORM FAIL. NC2254.2 +061200 EVA-WRITE-GF-7-1. NC2254.2 +061300 PERFORM PRINT-DETAIL. NC2254.2 +061400* NC2254.2 +061500 EVA-TEST-GF-7-2. NC2254.2 +061600 ADD 1 TO REC-CT. NC2254.2 +061700 MOVE "EVA-TEST-GF-7-2" TO PAR-NAME. NC2254.2 +061800 EVALUATE WRK-DU-08V00 NC2254.2 +061900 WHEN NOT (33 + (99 - 43)) NC2254.2 +062000 GO TO EVA-FAIL-GF-7-2. NC2254.2 +062100 PERFORM PASS. NC2254.2 +062200 GO TO EVA-WRITE-GF-7-2. NC2254.2 +062300 EVA-DELETE-GF-7-2. NC2254.2 +062400 PERFORM DE-LETE. NC2254.2 +062500 GO TO EVA-WRITE-GF-7-2. NC2254.2 +062600 EVA-FAIL-GF-7-2. NC2254.2 +062700 MOVE "EXPECTING EQUAL ARITHMETIC EXPRESSION" NC2254.2 +062800 TO RE-MARK NC2254.2 +062900 PERFORM FAIL. NC2254.2 +063000 EVA-WRITE-GF-7-2. NC2254.2 +063100 PERFORM PRINT-DETAIL. NC2254.2 +063200* NC2254.2 +063300 EVA-INIT-GF-8. NC2254.2 +063400 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +063500 MOVE 1 TO REC-CT. NC2254.2 +063600 MOVE 89 TO WRK-DU-08V00. NC2254.2 +063700 GO TO EVA-TEST-GF-8-1. NC2254.2 +063800 EVA-DELETE-GF-8. NC2254.2 +063900 PERFORM DE-LETE. NC2254.2 +064000 PERFORM PRINT-DETAIL. NC2254.2 +064100 GO TO EVA-INIT-GF-9. NC2254.2 +064200 EVA-TEST-GF-8-1. NC2254.2 +064300 MOVE "EVA-TEST-GF-8-1" TO PAR-NAME. NC2254.2 +064400 EVALUATE WRK-DU-08V00 NC2254.2 +064500 WHEN (2 + 4 + 8 + 16 + 32 + 64) NC2254.2 +064600 GO TO EVA-FAIL-GF-8-1. NC2254.2 +064700 PERFORM PASS. NC2254.2 +064800 GO TO EVA-WRITE-GF-8-1. NC2254.2 +064900 EVA-DELETE-GF-8-1. NC2254.2 +065000 PERFORM DE-LETE. NC2254.2 +065100 GO TO EVA-WRITE-GF-8-1. NC2254.2 +065200 EVA-FAIL-GF-8-1. NC2254.2 +065300 MOVE "EXPECTING UNEQUAL ARITHMETIC EXPRESSION" NC2254.2 +065400 TO RE-MARK NC2254.2 +065500 PERFORM FAIL. NC2254.2 +065600 EVA-WRITE-GF-8-1. NC2254.2 +065700 PERFORM PRINT-DETAIL. NC2254.2 +065800* NC2254.2 +065900 EVA-TEST-GF-8-2. NC2254.2 +066000 ADD 1 TO REC-CT. NC2254.2 +066100 MOVE "EVA-TEST-GF-8-2" TO PAR-NAME. NC2254.2 +066200 EVALUATE WRK-DU-08V00 NC2254.2 +066300 WHEN NOT (2 + 4 + 8 + 16 + 32 + 64) NC2254.2 +066400 PERFORM PASS NC2254.2 +066500 GO TO EVA-WRITE-GF-8-2. NC2254.2 +066600 GO TO EVA-FAIL-GF-8-2. NC2254.2 +066700 EVA-DELETE-GF-8-2. NC2254.2 +066800 PERFORM DE-LETE. NC2254.2 +066900 GO TO EVA-WRITE-GF-8-2. NC2254.2 +067000 EVA-FAIL-GF-8-2. NC2254.2 +067100 MOVE "EXPECTING UNEQUAL ARITHMETIC EXPRESSION" TO RE-MARK. NC2254.2 +067200 PERFORM FAIL. NC2254.2 +067300 EVA-WRITE-GF-8-2. NC2254.2 +067400 PERFORM PRINT-DETAIL. NC2254.2 +067500* NC2254.2 +067600 EVA-INIT-GF-9. NC2254.2 +067700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +067800 MOVE 1 TO REC-CT. NC2254.2 +067900 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +068000 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +068100 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +068200 GO TO EVA-TEST-GF-9-1. NC2254.2 +068300 EVA-DELETE-GF-9. NC2254.2 +068400 PERFORM DE-LETE. NC2254.2 +068500 PERFORM PRINT-DETAIL. NC2254.2 +068600 GO TO EVA-INIT-GF-10. NC2254.2 +068700 EVA-TEST-GF-9-1. NC2254.2 +068800 MOVE "EVA-TEST-GF-9-1" TO PAR-NAME. NC2254.2 +068900 EVALUATE WRK-XN-00001-1 NC2254.2 +069000 WHEN WRK-XN-00001-2 THRU WRK-XN-00001-3 NC2254.2 +069100 PERFORM PASS NC2254.2 +069200 GO TO EVA-WRITE-GF-9-1. NC2254.2 +069300 GO TO EVA-FAIL-GF-9-1. NC2254.2 +069400 EVA-DELETE-GF-9-1. NC2254.2 +069500 PERFORM DE-LETE. NC2254.2 +069600 GO TO EVA-WRITE-GF-9-1. NC2254.2 +069700 EVA-FAIL-GF-9-1. NC2254.2 +069800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +069900 TO RE-MARK. NC2254.2 +070000 PERFORM FAIL. NC2254.2 +070100 EVA-WRITE-GF-9-1. NC2254.2 +070200 PERFORM PRINT-DETAIL. NC2254.2 +070300* NC2254.2 +070400 EVA-TEST-GF-9-2. NC2254.2 +070500 ADD 1 TO REC-CT. NC2254.2 +070600 MOVE "EVA-TEST-GF-9-2" TO PAR-NAME. NC2254.2 +070700 EVALUATE WRK-XN-00001-1 NC2254.2 +070800 WHEN NOT WRK-XN-00001-2 THRU WRK-XN-00001-3 NC2254.2 +070900 GO TO EVA-FAIL-GF-9-2. NC2254.2 +071000 PERFORM PASS. NC2254.2 +071100 GO TO EVA-WRITE-GF-9-2. NC2254.2 +071200 EVA-DELETE-GF-9-2. NC2254.2 +071300 PERFORM DE-LETE. NC2254.2 +071400 GO TO EVA-WRITE-GF-9-2. NC2254.2 +071500 EVA-FAIL-GF-9-2. NC2254.2 +071600 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +071700 TO RE-MARK NC2254.2 +071800 PERFORM FAIL. NC2254.2 +071900 EVA-WRITE-GF-9-2. NC2254.2 +072000 PERFORM PRINT-DETAIL. NC2254.2 +072100* NC2254.2 +072200 EVA-INIT-GF-10. NC2254.2 +072300 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +072400 MOVE 1 TO REC-CT. NC2254.2 +072500 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +072600 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +072700 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +072800 GO TO EVA-TEST-GF-10-1. NC2254.2 +072900 EVA-DELETE-GF-10. NC2254.2 +073000 PERFORM DE-LETE. NC2254.2 +073100 PERFORM PRINT-DETAIL. NC2254.2 +073200 GO TO EVA-INIT-GF-11. NC2254.2 +073300 EVA-TEST-GF-10-1. NC2254.2 +073400 MOVE "EVA-TEST-GF-10-1" TO PAR-NAME. NC2254.2 +073500 EVALUATE WRK-XN-00001-3 NC2254.2 +073600 WHEN WRK-XN-00001-2 THRU WRK-XN-00001-1 NC2254.2 +073700 GO TO EVA-FAIL-GF-10-1. NC2254.2 +073800 PERFORM PASS. NC2254.2 +073900 GO TO EVA-WRITE-GF-10-1. NC2254.2 +074000 EVA-DELETE-GF-10-1. NC2254.2 +074100 PERFORM DE-LETE. NC2254.2 +074200 GO TO EVA-WRITE-GF-10-1. NC2254.2 +074300 EVA-FAIL-GF-10-1. NC2254.2 +074400 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +074500 TO RE-MARK NC2254.2 +074600 PERFORM FAIL. NC2254.2 +074700 EVA-WRITE-GF-10-1. NC2254.2 +074800 PERFORM PRINT-DETAIL. NC2254.2 +074900* NC2254.2 +075000 EVA-TEST-GF-10-2. NC2254.2 +075100 ADD 1 TO REC-CT. NC2254.2 +075200 MOVE "EVA-TEST-GF-10-2" TO PAR-NAME. NC2254.2 +075300 EVALUATE WRK-XN-00001-3 NC2254.2 +075400 WHEN NOT WRK-XN-00001-2 THRU WRK-XN-00001-1 NC2254.2 +075500 PERFORM PASS NC2254.2 +075600 GO TO EVA-WRITE-GF-10-2. NC2254.2 +075700 GO TO EVA-FAIL-GF-10-2. NC2254.2 +075800 EVA-DELETE-GF-10-2. NC2254.2 +075900 PERFORM DE-LETE. NC2254.2 +076000 GO TO EVA-WRITE-GF-10-2. NC2254.2 +076100 EVA-FAIL-GF-10-2. NC2254.2 +076200 MOVE " SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +076300 TO RE-MARK. NC2254.2 +076400 PERFORM FAIL. NC2254.2 +076500 EVA-WRITE-GF-10-2. NC2254.2 +076600 PERFORM PRINT-DETAIL. NC2254.2 +076700* NC2254.2 +076800 EVA-INIT-GF-11. NC2254.2 +076900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +077000 MOVE 1 TO REC-CT. NC2254.2 +077100 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +077200 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +077300 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +077400 GO TO EVA-TEST-GF-11-1. NC2254.2 +077500 EVA-DELETE-GF-11. NC2254.2 +077600 PERFORM DE-LETE. NC2254.2 +077700 PERFORM PRINT-DETAIL. NC2254.2 +077800 GO TO EVA-INIT-GF-12. NC2254.2 +077900 EVA-TEST-GF-11-1. NC2254.2 +078000 MOVE "EVA-TEST-GF-11-1" TO PAR-NAME. NC2254.2 +078100 EVALUATE WRK-XN-00001-1 NC2254.2 +078200 WHEN "A" THROUGH "N" NC2254.2 +078300 PERFORM PASS NC2254.2 +078400 GO TO EVA-WRITE-GF-11-1. NC2254.2 +078500 GO TO EVA-FAIL-GF-11-1. NC2254.2 +078600 EVA-DELETE-GF-11-1. NC2254.2 +078700 PERFORM DE-LETE. NC2254.2 +078800 GO TO EVA-WRITE-GF-11-1. NC2254.2 +078900 EVA-FAIL-GF-11-1. NC2254.2 +079000 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +079100 TO RE-MARK. NC2254.2 +079200 PERFORM FAIL. NC2254.2 +079300 EVA-WRITE-GF-11-1. NC2254.2 +079400 PERFORM PRINT-DETAIL. NC2254.2 +079500* NC2254.2 +079600 EVA-TEST-GF-11-2. NC2254.2 +079700 ADD 1 TO REC-CT. NC2254.2 +079800 MOVE "EVA-TEST-GF-11-2" TO PAR-NAME. NC2254.2 +079900 EVALUATE WRK-XN-00001-1 NC2254.2 +080000 WHEN NOT "A" THROUGH "N" NC2254.2 +080100 GO TO EVA-FAIL-GF-11-2. NC2254.2 +080200 PERFORM PASS. NC2254.2 +080300 GO TO EVA-WRITE-GF-11-2. NC2254.2 +080400 EVA-DELETE-GF-11-2. NC2254.2 +080500 PERFORM DE-LETE. NC2254.2 +080600 GO TO EVA-WRITE-GF-11-2. NC2254.2 +080700 EVA-FAIL-GF-11-2. NC2254.2 +080800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +080900 TO RE-MARK NC2254.2 +081000 PERFORM FAIL. NC2254.2 +081100 EVA-WRITE-GF-11-2. NC2254.2 +081200 PERFORM PRINT-DETAIL. NC2254.2 +081300* NC2254.2 +081400 EVA-INIT-GF-12. NC2254.2 +081500 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +081600 MOVE 1 TO REC-CT. NC2254.2 +081700 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +081800 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +081900 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +082000 GO TO EVA-TEST-GF-12-1. NC2254.2 +082100 EVA-DELETE-GF-12. NC2254.2 +082200 PERFORM DE-LETE. NC2254.2 +082300 PERFORM PRINT-DETAIL. NC2254.2 +082400 GO TO EVA-INIT-GF-13. NC2254.2 +082500 EVA-TEST-GF-12-1. NC2254.2 +082600 MOVE "EVA-TEST-GF-12-1" TO PAR-NAME. NC2254.2 +082700 EVALUATE WRK-XN-00001-3 NC2254.2 +082800 WHEN "A" THROUGH "J" NC2254.2 +082900 GO TO EVA-FAIL-GF-12-1. NC2254.2 +083000 PERFORM PASS. NC2254.2 +083100 GO TO EVA-WRITE-GF-12-1. NC2254.2 +083200 EVA-DELETE-GF-12-1. NC2254.2 +083300 PERFORM DE-LETE. NC2254.2 +083400 GO TO EVA-WRITE-GF-12-1. NC2254.2 +083500 EVA-FAIL-GF-12-1. NC2254.2 +083600 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +083700 TO RE-MARK NC2254.2 +083800 PERFORM FAIL. NC2254.2 +083900 EVA-WRITE-GF-12-1. NC2254.2 +084000 PERFORM PRINT-DETAIL. NC2254.2 +084100* NC2254.2 +084200 EVA-TEST-GF-12-2. NC2254.2 +084300 ADD 1 TO REC-CT. NC2254.2 +084400 MOVE "EVA-TEST-GF-12-2" TO PAR-NAME. NC2254.2 +084500 EVALUATE WRK-XN-00001-3 NC2254.2 +084600 WHEN NOT "A" THROUGH "J" NC2254.2 +084700 PERFORM PASS NC2254.2 +084800 GO TO EVA-WRITE-GF-12-2. NC2254.2 +084900 GO TO EVA-FAIL-GF-12-2. NC2254.2 +085000 EVA-DELETE-GF-12-2. NC2254.2 +085100 PERFORM DE-LETE. NC2254.2 +085200 GO TO EVA-WRITE-GF-12-2. NC2254.2 +085300 EVA-FAIL-GF-12-2. NC2254.2 +085400 MOVE " SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +085500 TO RE-MARK. NC2254.2 +085600 PERFORM FAIL. NC2254.2 +085700 EVA-WRITE-GF-12-2. NC2254.2 +085800 PERFORM PRINT-DETAIL. NC2254.2 +085900* NC2254.2 +086000 EVA-INIT-GF-13. NC2254.2 +086100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +086200 MOVE 1 TO REC-CT. NC2254.2 +086300 MOVE 89 TO WRK-DU-08V00. NC2254.2 +086400 GO TO EVA-TEST-GF-13-1. NC2254.2 +086500 EVA-DELETE-GF-13. NC2254.2 +086600 PERFORM DE-LETE. NC2254.2 +086700 PERFORM PRINT-DETAIL. NC2254.2 +086800 GO TO EVA-INIT-GF-14. NC2254.2 +086900 EVA-TEST-GF-13-1. NC2254.2 +087000 MOVE "EVA-TEST-GF-13-1" TO PAR-NAME. NC2254.2 +087100 EVALUATE WRK-DU-08V00 NC2254.2 +087200 WHEN (11 + (99 - 43)) THRU (20 * 5) NC2254.2 +087300 PERFORM PASS NC2254.2 +087400 GO TO EVA-WRITE-GF-13-1. NC2254.2 +087500 GO TO EVA-FAIL-GF-13-1. NC2254.2 +087600 EVA-DELETE-GF-13-1. NC2254.2 +087700 PERFORM DE-LETE. NC2254.2 +087800 GO TO EVA-WRITE-GF-13-1. NC2254.2 +087900 EVA-FAIL-GF-13-1. NC2254.2 +088000 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +088100 TO RE-MARK. NC2254.2 +088200 PERFORM FAIL. NC2254.2 +088300 EVA-WRITE-GF-13-1. NC2254.2 +088400 PERFORM PRINT-DETAIL. NC2254.2 +088500* NC2254.2 +088600 EVA-TEST-GF-13-2. NC2254.2 +088700 ADD 1 TO REC-CT. NC2254.2 +088800 MOVE "EVA-TEST-GF-13-2" TO PAR-NAME. NC2254.2 +088900 EVALUATE WRK-DU-08V00 NC2254.2 +089000 WHEN NOT (11 + (99 - 43)) THRU (20 * 5) NC2254.2 +089100 GO TO EVA-FAIL-GF-13-2. NC2254.2 +089200 PERFORM PASS. NC2254.2 +089300 GO TO EVA-WRITE-GF-13-2. NC2254.2 +089400 EVA-DELETE-GF-13-2. NC2254.2 +089500 PERFORM DE-LETE. NC2254.2 +089600 GO TO EVA-WRITE-GF-13-2. NC2254.2 +089700 EVA-FAIL-GF-13-2. NC2254.2 +089800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +089900 TO RE-MARK NC2254.2 +090000 PERFORM FAIL. NC2254.2 +090100 EVA-WRITE-GF-13-2. NC2254.2 +090200 PERFORM PRINT-DETAIL. NC2254.2 +090300* NC2254.2 +090400 EVA-INIT-GF-14. NC2254.2 +090500 MOVE "VI-84 6.12.4 GR1(A)" TO ANSI-REFERENCE. NC2254.2 +090600 MOVE 1 TO REC-CT. NC2254.2 +090700 MOVE 89 TO WRK-DU-08V00. NC2254.2 +090800 GO TO EVA-TEST-GF-14-1. NC2254.2 +090900 EVA-DELETE-GF-14. NC2254.2 +091000 PERFORM DE-LETE. NC2254.2 +091100 PERFORM PRINT-DETAIL. NC2254.2 +091200 GO TO EVA-INIT-GF-15. NC2254.2 +091300 EVA-TEST-GF-14-1. NC2254.2 +091400 MOVE "EVA-TEST-GF-14-1" TO PAR-NAME. NC2254.2 +091500 EVALUATE WRK-DU-08V00 NC2254.2 +091600 WHEN (11 + (99 - 20)) THRU (20 * 5) NC2254.2 +091700 GO TO EVA-FAIL-GF-14-1. NC2254.2 +091800 PERFORM PASS. NC2254.2 +091900 GO TO EVA-WRITE-GF-14-1. NC2254.2 +092000 EVA-DELETE-GF-14-1. NC2254.2 +092100 PERFORM DE-LETE. NC2254.2 +092200 GO TO EVA-WRITE-GF-14-1. NC2254.2 +092300 EVA-FAIL-GF-14-1. NC2254.2 +092400 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +092500 TO RE-MARK NC2254.2 +092600 PERFORM FAIL. NC2254.2 +092700 EVA-WRITE-GF-14-1. NC2254.2 +092800 PERFORM PRINT-DETAIL. NC2254.2 +092900* NC2254.2 +093000 EVA-TEST-GF-14-2. NC2254.2 +093100 ADD 1 TO REC-CT. NC2254.2 +093200 MOVE "EVA-TEST-GF-14-2" TO PAR-NAME. NC2254.2 +093300 EVALUATE WRK-DU-08V00 NC2254.2 +093400 WHEN NOT (11 + (99 - 20)) THRU (20 * 5) NC2254.2 +093500 PERFORM PASS NC2254.2 +093600 GO TO EVA-WRITE-GF-14-2. NC2254.2 +093700 GO TO EVA-FAIL-GF-14-2. NC2254.2 +093800 EVA-DELETE-GF-14-2. NC2254.2 +093900 PERFORM DE-LETE. NC2254.2 +094000 GO TO EVA-WRITE-GF-14-2. NC2254.2 +094100 EVA-FAIL-GF-14-2. NC2254.2 +094200 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +094300 TO RE-MARK. NC2254.2 +094400 PERFORM FAIL. NC2254.2 +094500 EVA-WRITE-GF-14-2. NC2254.2 +094600 PERFORM PRINT-DETAIL. NC2254.2 +094700* NC2254.2 +094800 EVA-INIT-GF-15. NC2254.2 +094900 MOVE "VI-84 6.12.4 GR1(b)" TO ANSI-REFERENCE. NC2254.2 +095000 MOVE 1 TO REC-CT. NC2254.2 +095100 MOVE 26 TO WRK-DU-08V00. NC2254.2 +095200 GO TO EVA-TEST-GF-15-1. NC2254.2 +095300 EVA-DELETE-GF-15. NC2254.2 +095400 PERFORM DE-LETE. NC2254.2 +095500 PERFORM PRINT-DETAIL. NC2254.2 +095600 GO TO EVA-INIT-GF-16. NC2254.2 +095700 EVA-TEST-GF-15-1. NC2254.2 +095800 MOVE "EVA-TEST-GF-15-1" TO PAR-NAME. NC2254.2 +095900 EVALUATE 26 NC2254.2 +096000 WHEN WRK-DU-08V00 NC2254.2 +096100 PERFORM PASS NC2254.2 +096200 GO TO EVA-WRITE-GF-15-1. NC2254.2 +096300 GO TO EVA-FAIL-GF-15-1. NC2254.2 +096400 EVA-DELETE-GF-15-1. NC2254.2 +096500 PERFORM DE-LETE. NC2254.2 +096600 GO TO EVA-WRITE-GF-15-1. NC2254.2 +096700 EVA-FAIL-GF-15-1. NC2254.2 +096800 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +096900 TO RE-MARK. NC2254.2 +097000 PERFORM FAIL. NC2254.2 +097100 EVA-WRITE-GF-15-1. NC2254.2 +097200 PERFORM PRINT-DETAIL. NC2254.2 +097300* NC2254.2 +097400 EVA-TEST-GF-15-2. NC2254.2 +097500 ADD 1 TO REC-CT. NC2254.2 +097600 MOVE "EVA-TEST-GF-15-2" TO PAR-NAME. NC2254.2 +097700 EVALUATE 26 NC2254.2 +097800 WHEN NOT WRK-DU-08V00 NC2254.2 +097900 GO TO EVA-FAIL-GF-15-2. NC2254.2 +098000 PERFORM PASS. NC2254.2 +098100 GO TO EVA-WRITE-GF-15-2. NC2254.2 +098200 EVA-DELETE-GF-15-2. NC2254.2 +098300 PERFORM DE-LETE. NC2254.2 +098400 GO TO EVA-WRITE-GF-15-2. NC2254.2 +098500 EVA-FAIL-GF-15-2. NC2254.2 +098600 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +098700 TO RE-MARK NC2254.2 +098800 PERFORM FAIL. NC2254.2 +098900 EVA-WRITE-GF-15-2. NC2254.2 +099000 PERFORM PRINT-DETAIL. NC2254.2 +099100* NC2254.2 +099200 EVA-INIT-GF-16. NC2254.2 +099300 MOVE "VI-84 6.12.4 GR1(b)" TO ANSI-REFERENCE. NC2254.2 +099400 MOVE 1 TO REC-CT. NC2254.2 +099500 MOVE 78 TO WRK-DU-08V00. NC2254.2 +099600 GO TO EVA-TEST-GF-16-1. NC2254.2 +099700 EVA-DELETE-GF-16. NC2254.2 +099800 PERFORM DE-LETE. NC2254.2 +099900 PERFORM PRINT-DETAIL. NC2254.2 +100000 GO TO EVA-INIT-GF-17. NC2254.2 +100100 EVA-TEST-GF-16-1. NC2254.2 +100200 MOVE "EVA-TEST-GF-16-1" TO PAR-NAME. NC2254.2 +100300 EVALUATE 1234 NC2254.2 +100400 WHEN WRK-DU-08V00 NC2254.2 +100500 GO TO EVA-FAIL-GF-16-1. NC2254.2 +100600 PERFORM PASS. NC2254.2 +100700 GO TO EVA-WRITE-GF-16-1. NC2254.2 +100800 EVA-DELETE-GF-16-1. NC2254.2 +100900 PERFORM DE-LETE. NC2254.2 +101000 GO TO EVA-WRITE-GF-16-1. NC2254.2 +101100 EVA-FAIL-GF-16-1. NC2254.2 +101200 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +101300 TO RE-MARK NC2254.2 +101400 PERFORM FAIL. NC2254.2 +101500 EVA-WRITE-GF-16-1. NC2254.2 +101600 PERFORM PRINT-DETAIL. NC2254.2 +101700* NC2254.2 +101800 EVA-TEST-GF-16-2. NC2254.2 +101900 ADD 1 TO REC-CT. NC2254.2 +102000 MOVE "EVA-TEST-GF-16-2" TO PAR-NAME. NC2254.2 +102100 EVALUATE 1234 NC2254.2 +102200 WHEN NOT WRK-DU-08V00 NC2254.2 +102300 PERFORM PASS NC2254.2 +102400 GO TO EVA-WRITE-GF-16-2. NC2254.2 +102500 GO TO EVA-FAIL-GF-16-2. NC2254.2 +102600 EVA-DELETE-GF-16-2. NC2254.2 +102700 PERFORM DE-LETE. NC2254.2 +102800 GO TO EVA-WRITE-GF-16-2. NC2254.2 +102900 EVA-FAIL-GF-16-2. NC2254.2 +103000 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +103100 TO RE-MARK. NC2254.2 +103200 PERFORM FAIL. NC2254.2 +103300 EVA-WRITE-GF-16-2. NC2254.2 +103400 PERFORM PRINT-DETAIL. NC2254.2 +103500* NC2254.2 +103600 EVA-INIT-GF-17. NC2254.2 +103700 MOVE "VI-84 6.12.4 GR1(d)" TO ANSI-REFERENCE. NC2254.2 +103800 MOVE 1 TO REC-CT. NC2254.2 +103900 MOVE 8 TO WRK-XN-00001-1. NC2254.2 +104000 GO TO EVA-TEST-GF-17-1. NC2254.2 +104100 EVA-DELETE-GF-17. NC2254.2 +104200 PERFORM DE-LETE. NC2254.2 +104300 PERFORM PRINT-DETAIL. NC2254.2 +104400 GO TO EVA-INIT-GF-18. NC2254.2 +104500 EVA-TEST-GF-17-1. NC2254.2 +104600 MOVE "EVA-TEST-GF-17-1" TO PAR-NAME. NC2254.2 +104700 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +104800 WHEN TRUE NC2254.2 +104900 PERFORM PASS NC2254.2 +105000 GO TO EVA-WRITE-GF-17-1. NC2254.2 +105100 GO TO EVA-FAIL-GF-17-1. NC2254.2 +105200 EVA-DELETE-GF-17-1. NC2254.2 +105300 PERFORM DE-LETE. NC2254.2 +105400 GO TO EVA-WRITE-GF-17-1. NC2254.2 +105500 EVA-FAIL-GF-17-1. NC2254.2 +105600 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +105700 TO RE-MARK. NC2254.2 +105800 PERFORM FAIL. NC2254.2 +105900 EVA-WRITE-GF-17-1. NC2254.2 +106000 PERFORM PRINT-DETAIL. NC2254.2 +106100* NC2254.2 +106200 EVA-TEST-GF-17-2. NC2254.2 +106300 ADD 1 TO REC-CT. NC2254.2 +106400 MOVE "EVA-TEST-GF-17-2" TO PAR-NAME. NC2254.2 +106500 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +106600 WHEN FALSE NC2254.2 +106700 GO TO EVA-FAIL-GF-17-2. NC2254.2 +106800 PERFORM PASS. NC2254.2 +106900 GO TO EVA-WRITE-GF-17-2. NC2254.2 +107000 EVA-DELETE-GF-17-2. NC2254.2 +107100 PERFORM DE-LETE. NC2254.2 +107200 GO TO EVA-WRITE-GF-17-2. NC2254.2 +107300 EVA-FAIL-GF-17-2. NC2254.2 +107400 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +107500 TO RE-MARK NC2254.2 +107600 PERFORM FAIL. NC2254.2 +107700 EVA-WRITE-GF-17-2. NC2254.2 +107800 PERFORM PRINT-DETAIL. NC2254.2 +107900* NC2254.2 +108000 EVA-TEST-GF-17-3. NC2254.2 +108100 ADD 1 TO REC-CT. NC2254.2 +108200 MOVE "EVA-TEST-GF-17-3" TO PAR-NAME. NC2254.2 +108300 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +108400 WHEN ANY NC2254.2 +108500 PERFORM PASS NC2254.2 +108600 GO TO EVA-WRITE-GF-17-3. NC2254.2 +108700 GO TO EVA-FAIL-GF-17-3. NC2254.2 +108800 EVA-DELETE-GF-17-3. NC2254.2 +108900 PERFORM DE-LETE. NC2254.2 +109000 GO TO EVA-WRITE-GF-17-3. NC2254.2 +109100 EVA-FAIL-GF-17-3. NC2254.2 +109200 MOVE "WHEN 'ANY' SHOULD HAVE EXECUTED" TO RE-MARK NC2254.2 +109300 PERFORM FAIL. NC2254.2 +109400 EVA-WRITE-GF-17-3. NC2254.2 +109500 PERFORM PRINT-DETAIL. NC2254.2 +109600* NC2254.2 +109700 EVA-INIT-GF-18. NC2254.2 +109800 MOVE "VI-84 6.12.4 GR1(d)" TO ANSI-REFERENCE. NC2254.2 +109900 MOVE 1 TO REC-CT. NC2254.2 +110000 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +110100 GO TO EVA-TEST-GF-18-1. NC2254.2 +110200 EVA-DELETE-GF-18. NC2254.2 +110300 PERFORM DE-LETE. NC2254.2 +110400 PERFORM PRINT-DETAIL. NC2254.2 +110500 GO TO EVA-INIT-GF-19. NC2254.2 +110600 EVA-TEST-GF-18-1. NC2254.2 +110700 MOVE "EVA-TEST-GF-18-1" TO PAR-NAME. NC2254.2 +110800 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +110900 WHEN TRUE NC2254.2 +111000 GO TO EVA-FAIL-GF-18-1. NC2254.2 +111100 PERFORM PASS. NC2254.2 +111200 GO TO EVA-WRITE-GF-18-1. NC2254.2 +111300 EVA-DELETE-GF-18-1. NC2254.2 +111400 PERFORM DE-LETE. NC2254.2 +111500 GO TO EVA-WRITE-GF-18-1. NC2254.2 +111600 EVA-FAIL-GF-18-1. NC2254.2 +111700 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +111800 TO RE-MARK NC2254.2 +111900 PERFORM FAIL. NC2254.2 +112000 EVA-WRITE-GF-18-1. NC2254.2 +112100 PERFORM PRINT-DETAIL. NC2254.2 +112200* NC2254.2 +112300 EVA-TEST-GF-18-2. NC2254.2 +112400 ADD 1 TO REC-CT. NC2254.2 +112500 MOVE "EVA-TEST-GF-18-2" TO PAR-NAME. NC2254.2 +112600 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +112700 WHEN FALSE NC2254.2 +112800 PERFORM PASS NC2254.2 +112900 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113000 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113100 EVA-DELETE-GF-18-2. NC2254.2 +113200 PERFORM DE-LETE. NC2254.2 +113300 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113400 EVA-FAIL-GF-18-2. NC2254.2 +113500 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +113600 TO RE-MARK. NC2254.2 +113700 PERFORM FAIL. NC2254.2 +113800 EVA-WRITE-GF-18-2. NC2254.2 +113900 PERFORM PRINT-DETAIL. NC2254.2 +114000* NC2254.2 +114100 EVA-TEST-GF-18-3. NC2254.2 +114200 ADD 1 TO REC-CT. NC2254.2 +114300 MOVE "EVA-TEST-GF-18-3" TO PAR-NAME. NC2254.2 +114400 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +114500 WHEN ANY NC2254.2 +114600 PERFORM PASS NC2254.2 +114700 GO TO EVA-WRITE-GF-18-3. NC2254.2 +114800 GO TO EVA-FAIL-GF-18-3. NC2254.2 +114900 EVA-DELETE-GF-18-3. NC2254.2 +115000 PERFORM DE-LETE. NC2254.2 +115100 GO TO EVA-WRITE-GF-18-3. NC2254.2 +115200 EVA-FAIL-GF-18-3. NC2254.2 +115300 MOVE "WHEN 'ANY' SHOULD HAVE EXECUTED" TO RE-MARK NC2254.2 +115400 PERFORM FAIL. NC2254.2 +115500 EVA-WRITE-GF-18-3. NC2254.2 +115600 PERFORM PRINT-DETAIL. NC2254.2 +115700* NC2254.2 +115800 EVA-INIT-GF-19. NC2254.2 +115900 MOVE "VI-84 6.12.4 GR1(c)" TO ANSI-REFERENCE. NC2254.2 +116000 MOVE 1 TO REC-CT. NC2254.2 +116100 MOVE 9 TO WRK-DU-08V00. NC2254.2 +116200 GO TO EVA-TEST-GF-19-1. NC2254.2 +116300 EVA-DELETE-GF-19. NC2254.2 +116400 PERFORM DE-LETE. NC2254.2 +116500 PERFORM PRINT-DETAIL. NC2254.2 +116600 GO TO EVA-INIT-GF-20. NC2254.2 +116700 EVA-TEST-GF-19-1. NC2254.2 +116800 MOVE "EVA-TEST-GF-19-1" TO PAR-NAME. NC2254.2 +116900 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +117000 WHEN WS-81 NC2254.2 +117100 PERFORM PASS NC2254.2 +117200 GO TO EVA-WRITE-GF-19-1. NC2254.2 +117300 GO TO EVA-FAIL-GF-19-1. NC2254.2 +117400 EVA-DELETE-GF-19-1. NC2254.2 +117500 PERFORM DE-LETE. NC2254.2 +117600 GO TO EVA-WRITE-GF-19-1. NC2254.2 +117700 EVA-FAIL-GF-19-1. NC2254.2 +117800 MOVE "SELECTION SUBJECT SHOULD EQUAL IDENTIFIER" NC2254.2 +117900 TO RE-MARK. NC2254.2 +118000 PERFORM FAIL. NC2254.2 +118100 EVA-WRITE-GF-19-1. NC2254.2 +118200 PERFORM PRINT-DETAIL. NC2254.2 +118300* NC2254.2 +118400 EVA-TEST-GF-19-2. NC2254.2 +118500 ADD 1 TO REC-CT. NC2254.2 +118600 MOVE "EVA-TEST-GF-19-2" TO PAR-NAME. NC2254.2 +118700 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +118800 WHEN 81 NC2254.2 +118900 PERFORM PASS NC2254.2 +119000 GO TO EVA-WRITE-GF-19-2. NC2254.2 +119100 GO TO EVA-FAIL-GF-19-2. NC2254.2 +119200 EVA-DELETE-GF-19-2. NC2254.2 +119300 PERFORM DE-LETE. NC2254.2 +119400 GO TO EVA-WRITE-GF-19-2. NC2254.2 +119500 EVA-FAIL-GF-19-2. NC2254.2 +119600 MOVE "SELECTION SUBJECT SHOULD EQUAL LITERAL" NC2254.2 +119700 TO RE-MARK. NC2254.2 +119800 PERFORM FAIL. NC2254.2 +119900 EVA-WRITE-GF-19-2. NC2254.2 +120000 PERFORM PRINT-DETAIL. NC2254.2 +120100* NC2254.2 +120200 EVA-TEST-GF-19-3. NC2254.2 +120300 ADD 1 TO REC-CT. NC2254.2 +120400 MOVE "EVA-TEST-GF-19-3" TO PAR-NAME. NC2254.2 +120500 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +120600 WHEN (9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9) NC2254.2 +120700 PERFORM PASS NC2254.2 +120800 GO TO EVA-WRITE-GF-19-3. NC2254.2 +120900 GO TO EVA-FAIL-GF-19-3. NC2254.2 +121000 EVA-DELETE-GF-19-3. NC2254.2 +121100 PERFORM DE-LETE. NC2254.2 +121200 GO TO EVA-WRITE-GF-19-3. NC2254.2 +121300 EVA-FAIL-GF-19-3. NC2254.2 +121400 MOVE "SELECTION SUBJECT SHOULD EQUAL ARITHMETIC EXPRESSION"NC2254.2 +121500 TO RE-MARK. NC2254.2 +121600 PERFORM FAIL. NC2254.2 +121700 EVA-WRITE-GF-19-3. NC2254.2 +121800 PERFORM PRINT-DETAIL. NC2254.2 +121900* NC2254.2 +122000 EVA-INIT-GF-20. NC2254.2 +122100 MOVE "VI-84 6.12.4 GR1(c)" TO ANSI-REFERENCE. NC2254.2 +122200 MOVE 1 TO REC-CT. NC2254.2 +122300 MOVE 8 TO WRK-DU-08V00. NC2254.2 +122400 GO TO EVA-TEST-GF-20-1. NC2254.2 +122500 EVA-DELETE-GF-20. NC2254.2 +122600 PERFORM DE-LETE. NC2254.2 +122700 PERFORM PRINT-DETAIL. NC2254.2 +122800 GO TO EVA-INIT-GF-21. NC2254.2 +122900 EVA-TEST-GF-20-1. NC2254.2 +123000 MOVE "EVA-TEST-GF-20-1" TO PAR-NAME. NC2254.2 +123100 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +123200 WHEN WS-81 NC2254.2 +123300 GO TO EVA-FAIL-GF-20-1. NC2254.2 +123400 PERFORM PASS. NC2254.2 +123500 GO TO EVA-WRITE-GF-20-1. NC2254.2 +123600 EVA-DELETE-GF-20-1. NC2254.2 +123700 PERFORM DE-LETE. NC2254.2 +123800 GO TO EVA-WRITE-GF-20-1. NC2254.2 +123900 EVA-FAIL-GF-20-1. NC2254.2 +124000 MOVE "SELECTION SUBJECT SHOULD NOT EQUAL IDENTIFIER" NC2254.2 +124100 TO RE-MARK NC2254.2 +124200 PERFORM FAIL. NC2254.2 +124300 EVA-WRITE-GF-20-1. NC2254.2 +124400 PERFORM PRINT-DETAIL. NC2254.2 +124500* NC2254.2 +124600 EVA-TEST-GF-20-2. NC2254.2 +124700 ADD 1 TO REC-CT. NC2254.2 +124800 MOVE "EVA-TEST-GF-20-2" TO PAR-NAME. NC2254.2 +124900 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +125000 WHEN 81 NC2254.2 +125100 GO TO EVA-FAIL-GF-20-2. NC2254.2 +125200 PERFORM PASS. NC2254.2 +125300 GO TO EVA-WRITE-GF-20-2. NC2254.2 +125400 EVA-DELETE-GF-20-2. NC2254.2 +125500 PERFORM DE-LETE. NC2254.2 +125600 GO TO EVA-WRITE-GF-20-2. NC2254.2 +125700 EVA-FAIL-GF-20-2. NC2254.2 +125800 MOVE "SELECTION SUBJECT SHOULD NOT EQUAL LITERAL" NC2254.2 +125900 TO RE-MARK NC2254.2 +126000 PERFORM FAIL. NC2254.2 +126100 EVA-WRITE-GF-20-2. NC2254.2 +126200 PERFORM PRINT-DETAIL. NC2254.2 +126300 NC2254.2 +126400 EVA-TEST-GF-20-3. NC2254.2 +126500 ADD 1 TO REC-CT. NC2254.2 +126600 MOVE "EVA-TEST-GF-20-3" TO PAR-NAME. NC2254.2 +126700 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +126800 WHEN (9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9) NC2254.2 +126900 GO TO EVA-FAIL-GF-20-3. NC2254.2 +127000 PERFORM PASS. NC2254.2 +127100 GO TO EVA-WRITE-GF-20-3. NC2254.2 +127200 EVA-DELETE-GF-20-3. NC2254.2 +127300 PERFORM DE-LETE. NC2254.2 +127400 GO TO EVA-WRITE-GF-20-3. NC2254.2 +127500 EVA-FAIL-GF-20-3. NC2254.2 +127600 MOVE NC2254.2 +127700 "SELECTION SUBJECT SHOULD NOT = ARITHMETIC EXPRESSION" NC2254.2 +127800 TO RE-MARK NC2254.2 +127900 PERFORM FAIL. NC2254.2 +128000 EVA-WRITE-GF-20-3. NC2254.2 +128100 PERFORM PRINT-DETAIL. NC2254.2 +128200* NC2254.2 +128300 EVA-INIT-GF-21. NC2254.2 +128400 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +128500 MOVE 1 TO REC-CT. NC2254.2 +128600 MOVE SPACE TO WRK-XN-00001-1. NC2254.2 +128700 GO TO EVA-TEST-GF-21-1. NC2254.2 +128800 EVA-DELETE-GF-21. NC2254.2 +128900 PERFORM DE-LETE. NC2254.2 +129000 PERFORM PRINT-DETAIL. NC2254.2 +129100 GO TO EVA-INIT-GF-22. NC2254.2 +129200 EVA-TEST-GF-21-1. NC2254.2 +129300 MOVE "EVA-TEST-GF-21-1" TO PAR-NAME. NC2254.2 +129400 EVALUATE TRUE NC2254.2 +129500 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +129600 PERFORM PASS NC2254.2 +129700 GO TO EVA-WRITE-GF-21-1. NC2254.2 +129800 GO TO EVA-FAIL-GF-21-1. NC2254.2 +129900 EVA-DELETE-GF-21-1. NC2254.2 +130000 PERFORM DE-LETE. NC2254.2 +130100 GO TO EVA-WRITE-GF-21-1. NC2254.2 +130200 EVA-FAIL-GF-21-1. NC2254.2 +130300 MOVE "SELECTION OBJECT CONDITION SHOULD BE TRUE" NC2254.2 +130400 TO RE-MARK. NC2254.2 +130500 PERFORM FAIL. NC2254.2 +130600 EVA-WRITE-GF-21-1. NC2254.2 +130700 PERFORM PRINT-DETAIL. NC2254.2 +130800* NC2254.2 +130900 EVA-INIT-GF-22. NC2254.2 +131000 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +131100 MOVE 1 TO REC-CT. NC2254.2 +131200 MOVE "#" TO WRK-XN-00001-1. NC2254.2 +131300 GO TO EVA-TEST-GF-22-1. NC2254.2 +131400 EVA-DELETE-GF-22. NC2254.2 +131500 PERFORM DE-LETE. NC2254.2 +131600 PERFORM PRINT-DETAIL. NC2254.2 +131700 GO TO EVA-INIT-GF-23. NC2254.2 +131800 EVA-TEST-GF-22-1. NC2254.2 +131900 MOVE "EVA-TEST-GF-22-1" TO PAR-NAME. NC2254.2 +132000 EVALUATE TRUE NC2254.2 +132100 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +132200 GO TO EVA-FAIL-GF-22-1. NC2254.2 +132300 PERFORM PASS. NC2254.2 +132400 GO TO EVA-WRITE-GF-22-1. NC2254.2 +132500 EVA-DELETE-GF-22-1. NC2254.2 +132600 PERFORM DE-LETE. NC2254.2 +132700 GO TO EVA-WRITE-GF-22-1. NC2254.2 +132800 EVA-FAIL-GF-22-1. NC2254.2 +132900 MOVE "SELECTION OBJECT CONDITION SHOULD BE FALSE" NC2254.2 +133000 TO RE-MARK NC2254.2 +133100 PERFORM FAIL. NC2254.2 +133200 EVA-WRITE-GF-22-1. NC2254.2 +133300 PERFORM PRINT-DETAIL. NC2254.2 +133400* NC2254.2 +133500 EVA-INIT-GF-23. NC2254.2 +133600 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +133700 MOVE 1 TO REC-CT. NC2254.2 +133800 MOVE SPACE TO WRK-XN-00001-1. NC2254.2 +133900 GO TO EVA-TEST-GF-23-1. NC2254.2 +134000 EVA-DELETE-GF-23. NC2254.2 +134100 PERFORM DE-LETE. NC2254.2 +134200 PERFORM PRINT-DETAIL. NC2254.2 +134300 GO TO EVA-INIT-GF-24. NC2254.2 +134400 EVA-TEST-GF-23-1. NC2254.2 +134500 MOVE "EVA-TEST-GF-23-1" TO PAR-NAME. NC2254.2 +134600 EVALUATE FALSE NC2254.2 +134700 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +134800 GO TO EVA-FAIL-GF-23-1. NC2254.2 +134900 PERFORM PASS. NC2254.2 +135000 GO TO EVA-WRITE-GF-23-1. NC2254.2 +135100 EVA-DELETE-GF-23-1. NC2254.2 +135200 PERFORM DE-LETE. NC2254.2 +135300 GO TO EVA-WRITE-GF-23-1. NC2254.2 +135400 EVA-FAIL-GF-23-1. NC2254.2 +135500 MOVE "SELECTION OBJECT CONDITION SHOULD BE TRUE" NC2254.2 +135600 TO RE-MARK NC2254.2 +135700 PERFORM FAIL. NC2254.2 +135800 EVA-WRITE-GF-23-1. NC2254.2 +135900 PERFORM PRINT-DETAIL. NC2254.2 +136000* NC2254.2 +136100 EVA-INIT-GF-24. NC2254.2 +136200 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +136300 MOVE 1 TO REC-CT. NC2254.2 +136400 MOVE "#" TO WRK-XN-00001-1. NC2254.2 +136500 GO TO EVA-TEST-GF-24-1. NC2254.2 +136600 EVA-DELETE-GF-24. NC2254.2 +136700 PERFORM DE-LETE. NC2254.2 +136800 PERFORM PRINT-DETAIL. NC2254.2 +136900 GO TO EVA-INIT-GF-25. NC2254.2 +137000 EVA-TEST-GF-24-1. NC2254.2 +137100 MOVE "EVA-TEST-GF-24-1" TO PAR-NAME. NC2254.2 +137200 EVALUATE FALSE NC2254.2 +137300 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +137400 PERFORM PASS NC2254.2 +137500 GO TO EVA-WRITE-GF-24-1. NC2254.2 +137600 GO TO EVA-FAIL-GF-24-1. NC2254.2 +137700 EVA-DELETE-GF-24-1. NC2254.2 +137800 PERFORM DE-LETE. NC2254.2 +137900 GO TO EVA-WRITE-GF-24-1. NC2254.2 +138000 EVA-FAIL-GF-24-1. NC2254.2 +138100 MOVE "SELECTION OBJECT CONDITION SHOULD BE FALSE" NC2254.2 +138200 TO RE-MARK. NC2254.2 +138300 PERFORM FAIL. NC2254.2 +138400 EVA-WRITE-GF-24-1. NC2254.2 +138500 PERFORM PRINT-DETAIL. NC2254.2 +138600* NC2254.2 +138700 EVA-INIT-GF-25. NC2254.2 +138800 MOVE "VI-84 6.12.4 GR3(b)" TO ANSI-REFERENCE. NC2254.2 +138900 MOVE 1 TO REC-CT. NC2254.2 +139000 MOVE 26 TO WRK-DU-08V00. NC2254.2 +139100 GO TO EVA-TEST-GF-25-1. NC2254.2 +139200 EVA-DELETE-GF-25. NC2254.2 +139300 PERFORM DE-LETE. NC2254.2 +139400 PERFORM PRINT-DETAIL. NC2254.2 +139500 GO TO EVA-INIT-GF-16. NC2254.2 +139600 EVA-TEST-GF-25-1. NC2254.2 +139700 MOVE "EVA-TEST-GF-25-1" TO PAR-NAME. NC2254.2 +139800 EVALUATE 26 NC2254.2 +139900 WHEN WRK-DU-08V00 NC2254.2 +140000 PERFORM PASS NC2254.2 +140100 WHEN OTHER NC2254.2 +140200 GO TO EVA-FAIL-GF-25-1. NC2254.2 +140300 GO TO EVA-WRITE-GF-25-1. NC2254.2 +140400 EVA-DELETE-GF-25-1. NC2254.2 +140500 PERFORM DE-LETE. NC2254.2 +140600 GO TO EVA-WRITE-GF-25-1. NC2254.2 +140700 EVA-FAIL-GF-25-1. NC2254.2 +140800 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +140900 TO RE-MARK NC2254.2 +141000 PERFORM FAIL. NC2254.2 +141100 EVA-WRITE-GF-25-1. NC2254.2 +141200 PERFORM PRINT-DETAIL. NC2254.2 +141300* NC2254.2 +141400 EVA-INIT-GF-26. NC2254.2 +141500 MOVE "VI-84 6.12.4 GR3(b)" TO ANSI-REFERENCE. NC2254.2 +141600 MOVE 1 TO REC-CT. NC2254.2 +141700 MOVE 78 TO WRK-DU-08V00. NC2254.2 +141800 GO TO EVA-TEST-GF-26-1. NC2254.2 +141900 EVA-DELETE-GF-26. NC2254.2 +142000 PERFORM DE-LETE. NC2254.2 +142100 PERFORM PRINT-DETAIL. NC2254.2 +142200 GO TO EVA-INIT-GF-27. NC2254.2 +142300 EVA-TEST-GF-26-1. NC2254.2 +142400 MOVE "EVA-TEST-GF-26-1" TO PAR-NAME. NC2254.2 +142500 EVALUATE 1234 NC2254.2 +142600 WHEN WRK-DU-08V00 NC2254.2 +142700 GO TO EVA-FAIL-GF-26-1 NC2254.2 +142800 WHEN OTHER NC2254.2 +142900 PERFORM PASS. NC2254.2 +143000 GO TO EVA-WRITE-GF-26-1. NC2254.2 +143100 EVA-DELETE-GF-26-1. NC2254.2 +143200 PERFORM DE-LETE. NC2254.2 +143300 GO TO EVA-WRITE-GF-26-1. NC2254.2 +143400 EVA-FAIL-GF-26-1. NC2254.2 +143500 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +143600 TO RE-MARK NC2254.2 +143700 PERFORM FAIL. NC2254.2 +143800 EVA-WRITE-GF-26-1. NC2254.2 +143900 PERFORM PRINT-DETAIL. NC2254.2 +144000* NC2254.2 +144100 EVA-INIT-GF-27. NC2254.2 +144200 MOVE "VI-84 6.12.4 GR3(c)" TO ANSI-REFERENCE. NC2254.2 +144300 MOVE 1 TO REC-CT. NC2254.2 +144400 MOVE 26 TO WRK-DU-08V00. NC2254.2 +144500 GO TO EVA-TEST-GF-27-1. NC2254.2 +144600 EVA-DELETE-GF-27. NC2254.2 +144700 PERFORM DE-LETE. NC2254.2 +144800 PERFORM PRINT-DETAIL. NC2254.2 +144900 GO TO EVA-INIT-GF-28. NC2254.2 +145000 EVA-TEST-GF-27-1. NC2254.2 +145100 MOVE "EVA-TEST-GF-27-1" TO PAR-NAME. NC2254.2 +145200 EVALUATE 26 NC2254.2 +145300 WHEN NOT WRK-DU-08V00 NC2254.2 +145400 GO TO EVA-FAIL-GF-27-1 NC2254.2 +145500 END-EVALUATE. NC2254.2 +145600 PERFORM PASS. NC2254.2 +145700 GO TO EVA-WRITE-GF-27-1. NC2254.2 +145800 EVA-DELETE-GF-27-1. NC2254.2 +145900 PERFORM DE-LETE. NC2254.2 +146000 GO TO EVA-WRITE-GF-27-1. NC2254.2 +146100 EVA-FAIL-GF-27-1. NC2254.2 +146200 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +146300 TO RE-MARK NC2254.2 +146400 PERFORM FAIL. NC2254.2 +146500 EVA-WRITE-GF-27-1. NC2254.2 +146600 PERFORM PRINT-DETAIL. NC2254.2 +146700* NC2254.2 +146800 EVA-INIT-GF-28. NC2254.2 +146900 MOVE "VI-84 6.12.4 GR3(c)" TO ANSI-REFERENCE. NC2254.2 +147000 MOVE 1 TO REC-CT. NC2254.2 +147100 MOVE 78 TO WRK-DU-08V00. NC2254.2 +147200 GO TO EVA-TEST-GF-28-1. NC2254.2 +147300 EVA-DELETE-GF-28. NC2254.2 +147400 PERFORM DE-LETE. NC2254.2 +147500 PERFORM PRINT-DETAIL. NC2254.2 +147600 GO TO EVA-INIT-GF-29. NC2254.2 +147700 EVA-TEST-GF-28-1. NC2254.2 +147800 MOVE "EVA-TEST-GF-28-1" TO PAR-NAME. NC2254.2 +147900 EVALUATE 1234 NC2254.2 +148000 WHEN NOT WRK-DU-08V00 NC2254.2 +148100 PERFORM PASS NC2254.2 +148200 GO TO EVA-WRITE-GF-28-1 NC2254.2 +148300 end-evaluate. NC2254.2 +148400 GO TO EVA-FAIL-GF-28-1. NC2254.2 +148500 EVA-DELETE-GF-28-1. NC2254.2 +148600 PERFORM DE-LETE. NC2254.2 +148700 GO TO EVA-WRITE-GF-28-1. NC2254.2 +148800 EVA-FAIL-GF-28-1. NC2254.2 +148900 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +149000 TO RE-MARK. NC2254.2 +149100 PERFORM FAIL. NC2254.2 +149200 EVA-WRITE-GF-28-1. NC2254.2 +149300 PERFORM PRINT-DETAIL. NC2254.2 +149400* NC2254.2 +149500 EVA-INIT-GF-29. NC2254.2 +149600 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +149700 MOVE 1 TO REC-CT. NC2254.2 +149800 MOVE 8 TO WRK-XN-00001-1. NC2254.2 +149900 GO TO EVA-TEST-GF-29-1. NC2254.2 +150000 EVA-DELETE-GF-29. NC2254.2 +150100 PERFORM DE-LETE. NC2254.2 +150200 PERFORM PRINT-DETAIL. NC2254.2 +150300 GO TO EVA-INIT-GF-30. NC2254.2 +150400 EVA-TEST-GF-29-1. NC2254.2 +150500 MOVE "EVA-TEST-GF-29-1" TO PAR-NAME. NC2254.2 +150600 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +150700 WHEN TRUE NC2254.2 +150800 PERFORM PASS NC2254.2 +150900 WHEN OTHER NC2254.2 +151000 GO TO EVA-FAIL-GF-29-1 NC2254.2 +151100 END-EVALUATE NC2254.2 +151200 GO TO EVA-WRITE-GF-29-1. NC2254.2 +151300 EVA-DELETE-GF-29-1. NC2254.2 +151400 PERFORM DE-LETE. NC2254.2 +151500 GO TO EVA-WRITE-GF-29-1. NC2254.2 +151600 EVA-FAIL-GF-29-1. NC2254.2 +151700 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +151800 TO RE-MARK NC2254.2 +151900 PERFORM FAIL. NC2254.2 +152000 EVA-WRITE-GF-29-1. NC2254.2 +152100 PERFORM PRINT-DETAIL. NC2254.2 +152200* NC2254.2 +152300 EVA-INIT-GF-30. NC2254.2 +152400 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +152500 MOVE 1 TO REC-CT. NC2254.2 +152600 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +152700 GO TO EVA-TEST-GF-30-1. NC2254.2 +152800 EVA-DELETE-GF-30. NC2254.2 +152900 PERFORM DE-LETE. NC2254.2 +153000 PERFORM PRINT-DETAIL. NC2254.2 +153100 GO TO EVA-INIT-GF-31. NC2254.2 +153200 EVA-TEST-GF-30-1. NC2254.2 +153300 MOVE "EVA-TEST-GF-30-1" TO PAR-NAME. NC2254.2 +153400 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +153500 WHEN TRUE NC2254.2 +153600 GO TO EVA-FAIL-GF-30-1 NC2254.2 +153700 WHEN OTHER NC2254.2 +153800 PERFORM PASS NC2254.2 +153900 END-EVALUATE NC2254.2 +154000 GO TO EVA-WRITE-GF-30-1. NC2254.2 +154100 EVA-DELETE-GF-30-1. NC2254.2 +154200 PERFORM DE-LETE. NC2254.2 +154300 GO TO EVA-WRITE-GF-30-1. NC2254.2 +154400 EVA-FAIL-GF-30-1. NC2254.2 +154500 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +154600 TO RE-MARK NC2254.2 +154700 PERFORM FAIL. NC2254.2 +154800 EVA-WRITE-GF-30-1. NC2254.2 +154900 PERFORM PRINT-DETAIL. NC2254.2 +155000* NC2254.2 +155100 EVA-INIT-GF-31. NC2254.2 +155200 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +155300 MOVE "EVA-TEST-GF-31-1" TO PAR-NAME. NC2254.2 +155400 MOVE 1 TO REC-CT. NC2254.2 +155500 MOVE 81 TO WRK-DU-08V00. NC2254.2 +155600 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +155700 MOVE "*" TO WRK-XN-00001-2. NC2254.2 +155800 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +155900 MOVE 81 TO WRK-DU-08V00-2. NC2254.2 +156000 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +156100 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +156200 GO TO EVA-TEST-GF-31-0. NC2254.2 +156300 EVA-DELETE-GF-31. NC2254.2 +156400 PERFORM DE-LETE. NC2254.2 +156500 PERFORM PRINT-DETAIL. NC2254.2 +156600 GO TO EVA-INIT-GF-32. NC2254.2 +156700 EVA-TEST-GF-31-0. NC2254.2 +156800 EVALUATE WRK-DU-08V00 NC2254.2 +156900 ALSO 81 NC2254.2 +157000 ALSO (WRK-DU-08V00 * 9) NC2254.2 +157100 ALSO IT-IS-81 NC2254.2 +157200 ALSO TRUE NC2254.2 +157300 ALSO FALSE NC2254.2 +157400 WHEN NOT WRK-DU-08V00-1 NC2254.2 +157500 ALSO WRK-DU-08V00-2 NC2254.2 +157600 ALSO 729 NC2254.2 +157700 ALSO TRUE NC2254.2 +157800 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +157900 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +158000 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +158100 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +158200 WHEN 81 NC2254.2 +158300 ALSO WRK-DU-08V00 NC2254.2 +158400 ALSO (9 * 9 * 9) NC2254.2 +158500 ALSO FALSE NC2254.2 +158600 ALSO WRK-XN-00001-2 = "*" NC2254.2 +158700 ALSO WRK-DU-08V00 > 8 NC2254.2 +158800 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +158900 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +159000 WHEN ANY NC2254.2 +159100 ALSO ANY NC2254.2 +159200 ALSO ANY NC2254.2 +159300 ALSO ANY NC2254.2 +159400 ALSO ANY NC2254.2 +159500 ALSO WRK-DU-08V00 = 6 NC2254.2 +159600 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +159700 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +159800 WHEN OTHER NC2254.2 +159900 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +160000 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +160100 END-EVALUATE. NC2254.2 +160200 EVA-TEST-GF-31-1. NC2254.2 +160300 IF WRK-XN-00001-1 = "A" NC2254.2 +160400 PERFORM PASS NC2254.2 +160500 GO TO EVA-WRITE-GF-31-1 NC2254.2 +160600 ELSE NC2254.2 +160700 GO TO EVA-FAIL-GF-31-1. NC2254.2 +160800 EVA-DELETE-GF-31-1. NC2254.2 +160900 PERFORM DE-LETE. NC2254.2 +161000 GO TO EVA-WRITE-GF-31-1. NC2254.2 +161100 EVA-FAIL-GF-31-1. NC2254.2 +161200 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +161300 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +161400 MOVE "A" TO CORRECT-X NC2254.2 +161500 PERFORM FAIL. NC2254.2 +161600 EVA-WRITE-GF-31-1. NC2254.2 +161700 PERFORM PRINT-DETAIL. NC2254.2 +161800 EVA-TEST-GF-31-2. NC2254.2 +161900 IF WRK-XN-00001-2 = "B" NC2254.2 +162000 PERFORM PASS NC2254.2 +162100 GO TO EVA-WRITE-GF-31-2 NC2254.2 +162200 ELSE NC2254.2 +162300 GO TO EVA-FAIL-GF-31-2. NC2254.2 +162400 EVA-DELETE-GF-31-2. NC2254.2 +162500 PERFORM DE-LETE. NC2254.2 +162600 GO TO EVA-WRITE-GF-31-2. NC2254.2 +162700 EVA-FAIL-GF-31-2. NC2254.2 +162800 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +162900 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +163000 MOVE "B" TO CORRECT-X NC2254.2 +163100 PERFORM FAIL. NC2254.2 +163200 EVA-WRITE-GF-31-2. NC2254.2 +163300 PERFORM PRINT-DETAIL. NC2254.2 +163400* NC2254.2 +163500 EVA-INIT-GF-32. NC2254.2 +163600 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +163700 MOVE "EVA-TEST-GF-32-1" TO PAR-NAME. NC2254.2 +163800 MOVE 1 TO REC-CT. NC2254.2 +163900 MOVE 81 TO WRK-DU-08V00. NC2254.2 +164000 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +164100 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +164200 MOVE 7 TO WRK-DU-08V00-2. NC2254.2 +164300 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +164400 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +164500 GO TO EVA-TEST-GF-32-0. NC2254.2 +164600 EVA-DELETE-GF-32. NC2254.2 +164700 PERFORM DE-LETE. NC2254.2 +164800 PERFORM PRINT-DETAIL. NC2254.2 +164900 GO TO EVA-INIT-GF-33. NC2254.2 +165000 EVA-TEST-GF-32-0. NC2254.2 +165100 EVALUATE WRK-DU-08V00 NC2254.2 +165200 ALSO 81 NC2254.2 +165300 ALSO (WRK-DU-08V00 * 2) NC2254.2 +165400 ALSO IT-IS-81 NC2254.2 +165500 ALSO TRUE NC2254.2 +165600 ALSO FALSE NC2254.2 +165700 WHEN NOT WRK-DU-08V00-1 NC2254.2 +165800 ALSO WRK-DU-08V00-2 NC2254.2 +165900 ALSO 81 NC2254.2 +166000 ALSO TRUE NC2254.2 +166100 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +166200 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +166300 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +166400 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +166500 WHEN 81 NC2254.2 +166600 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +166700 ALSO (WRK-DU-08V00-2 * 8) THRU (WRK-DU-08V00-2 * 30) NC2254.2 +166800 ALSO FALSE NC2254.2 +166900 ALSO WRK-DU-08V00-2 = 7 NC2254.2 +167000 ALSO WRK-DU-08V00 > 88 NC2254.2 +167100 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +167200 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +167300 WHEN ANY NC2254.2 +167400 ALSO ANY NC2254.2 +167500 ALSO ANY NC2254.2 +167600 ALSO ANY NC2254.2 +167700 ALSO ANY NC2254.2 +167800 ALSO WRK-DU-08V00 = 6 NC2254.2 +167900 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +168000 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +168100 WHEN OTHER NC2254.2 +168200 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +168300 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +168400 END-EVALUATE. NC2254.2 +168500 EVA-TEST-GF-32-1. NC2254.2 +168600 IF WRK-XN-00001-1 = "C" NC2254.2 +168700 PERFORM PASS NC2254.2 +168800 GO TO EVA-WRITE-GF-32-1 NC2254.2 +168900 ELSE NC2254.2 +169000 GO TO EVA-FAIL-GF-32-1. NC2254.2 +169100 EVA-DELETE-GF-32-1. NC2254.2 +169200 PERFORM DE-LETE. NC2254.2 +169300 GO TO EVA-WRITE-GF-32-1. NC2254.2 +169400 EVA-FAIL-GF-32-1. NC2254.2 +169500 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +169600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +169700 MOVE "C" TO CORRECT-X NC2254.2 +169800 PERFORM FAIL. NC2254.2 +169900 EVA-WRITE-GF-32-1. NC2254.2 +170000 PERFORM PRINT-DETAIL. NC2254.2 +170100 EVA-TEST-GF-32-2. NC2254.2 +170200 ADD 1 TO REC-CT. NC2254.2 +170300 IF WRK-XN-00001-2 = "D" NC2254.2 +170400 PERFORM PASS NC2254.2 +170500 GO TO EVA-WRITE-GF-32-2 NC2254.2 +170600 ELSE NC2254.2 +170700 GO TO EVA-FAIL-GF-32-2. NC2254.2 +170800 EVA-DELETE-GF-32-2. NC2254.2 +170900 PERFORM DE-LETE. NC2254.2 +171000 GO TO EVA-WRITE-GF-32-2. NC2254.2 +171100 EVA-FAIL-GF-32-2. NC2254.2 +171200 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +171300 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +171400 MOVE "D" TO CORRECT-X NC2254.2 +171500 PERFORM FAIL. NC2254.2 +171600 EVA-WRITE-GF-32-2. NC2254.2 +171700 PERFORM PRINT-DETAIL. NC2254.2 +171800* NC2254.2 +171900 EVA-INIT-GF-33. NC2254.2 +172000 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +172100 MOVE "EVA-TEST-GF-33-1" TO PAR-NAME. NC2254.2 +172200 MOVE 1 TO REC-CT. NC2254.2 +172300 MOVE 6 TO WRK-DU-08V00. NC2254.2 +172400 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +172500 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +172600 MOVE 7 TO WRK-DU-08V00-2. NC2254.2 +172700 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +172800 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +172900 GO TO EVA-TEST-GF-33-0. NC2254.2 +173000 EVA-DELETE-GF-33. NC2254.2 +173100 PERFORM DE-LETE. NC2254.2 +173200 PERFORM PRINT-DETAIL. NC2254.2 +173300 GO TO EVA-INIT-GF-34. NC2254.2 +173400 EVA-TEST-GF-33-0. NC2254.2 +173500 EVALUATE WRK-DU-08V00 NC2254.2 +173600 ALSO 81 NC2254.2 +173700 ALSO (WRK-DU-08V00-2 * 9) NC2254.2 +173800 ALSO IT-IS-81 NC2254.2 +173900 ALSO TRUE NC2254.2 +174000 ALSO FALSE NC2254.2 +174100 WHEN NOT WRK-DU-08V00-1 NC2254.2 +174200 ALSO WRK-DU-08V00-2 NC2254.2 +174300 ALSO 81 NC2254.2 +174400 ALSO TRUE NC2254.2 +174500 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +174600 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +174700 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +174800 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +174900 WHEN 81 NC2254.2 +175000 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +175100 ALSO (WRK-DU-08V00-2 * 7) THRU (WRK-DU-08V00-2 * 8) NC2254.2 +175200 ALSO FALSE NC2254.2 +175300 ALSO WRK-DU-08V00-2 = 81 NC2254.2 +175400 ALSO WRK-DU-08V00 > 8 NC2254.2 +175500 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +175600 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +175700 WHEN ANY NC2254.2 +175800 ALSO ANY NC2254.2 +175900 ALSO ANY NC2254.2 +176000 ALSO ANY NC2254.2 +176100 ALSO ANY NC2254.2 +176200 ALSO WRK-DU-08V00-2 = 6 NC2254.2 +176300 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +176400 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +176500 WHEN OTHER NC2254.2 +176600 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +176700 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +176800 END-EVALUATE. NC2254.2 +176900 EVA-TEST-GF-33-1. NC2254.2 +177000 IF WRK-XN-00001-1 = "E" NC2254.2 +177100 PERFORM PASS NC2254.2 +177200 GO TO EVA-WRITE-GF-33-1 NC2254.2 +177300 ELSE NC2254.2 +177400 GO TO EVA-FAIL-GF-33-1. NC2254.2 +177500 EVA-DELETE-GF-33-1. NC2254.2 +177600 PERFORM DE-LETE. NC2254.2 +177700 GO TO EVA-WRITE-GF-33-1. NC2254.2 +177800 EVA-FAIL-GF-33-1. NC2254.2 +177900 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +178000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +178100 MOVE "E" TO CORRECT-X NC2254.2 +178200 PERFORM FAIL. NC2254.2 +178300 EVA-WRITE-GF-33-1. NC2254.2 +178400 PERFORM PRINT-DETAIL. NC2254.2 +178500 EVA-TEST-GF-33-2. NC2254.2 +178600 ADD 1 TO REC-CT. NC2254.2 +178700 IF WRK-XN-00001-2 = "F" NC2254.2 +178800 PERFORM PASS NC2254.2 +178900 GO TO EVA-WRITE-GF-33-2 NC2254.2 +179000 ELSE NC2254.2 +179100 GO TO EVA-FAIL-GF-33-2. NC2254.2 +179200 EVA-DELETE-GF-33-2. NC2254.2 +179300 PERFORM DE-LETE. NC2254.2 +179400 GO TO EVA-WRITE-GF-33-2. NC2254.2 +179500 EVA-FAIL-GF-33-2. NC2254.2 +179600 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +179700 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +179800 MOVE "F" TO CORRECT-X NC2254.2 +179900 PERFORM FAIL. NC2254.2 +180000 EVA-WRITE-GF-33-2. NC2254.2 +180100 PERFORM PRINT-DETAIL. NC2254.2 +180200* NC2254.2 +180300 EVA-INIT-GF-34. NC2254.2 +180400 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +180500 MOVE "EVA-TEST-GF-34-1" TO PAR-NAME. NC2254.2 +180600 MOVE 1 TO REC-CT. NC2254.2 +180700 MOVE 99 TO WRK-DU-08V00. NC2254.2 +180800 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +180900 MOVE 99 TO WRK-DU-08V00-1. NC2254.2 +181000 MOVE 99 TO WRK-DU-08V00-2. NC2254.2 +181100 MOVE 99 TO WRK-DU-08V00-3. NC2254.2 +181200 MOVE 99 TO WRK-DU-08V00-4. NC2254.2 +181300 GO TO EVA-TEST-GF-34-0. NC2254.2 +181400 EVA-DELETE-GF-34. NC2254.2 +181500 PERFORM DE-LETE. NC2254.2 +181600 PERFORM PRINT-DETAIL. NC2254.2 +181700 GO TO EVA-INIT-GF-35. NC2254.2 +181800 EVA-TEST-GF-34-0. NC2254.2 +181900 EVALUATE WRK-DU-08V00 NC2254.2 +182000 ALSO 81 NC2254.2 +182100 ALSO (WRK-DU-08V00-2 * 9) NC2254.2 +182200 ALSO IT-IS-81 NC2254.2 +182300 ALSO TRUE NC2254.2 +182400 ALSO FALSE NC2254.2 +182500 WHEN NOT WRK-DU-08V00-1 NC2254.2 +182600 ALSO WRK-DU-08V00-2 NC2254.2 +182700 ALSO 81 NC2254.2 +182800 ALSO TRUE NC2254.2 +182900 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +183000 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +183100 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +183200 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +183300 WHEN 81 NC2254.2 +183400 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +183500 ALSO (WRK-DU-08V00-2 * 7) THRU (WRK-DU-08V00-2 * 8) NC2254.2 +183600 ALSO FALSE NC2254.2 +183700 ALSO WRK-DU-08V00-2 = 81 NC2254.2 +183800 ALSO WRK-DU-08V00 > 8 NC2254.2 +183900 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +184000 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +184100 WHEN ANY NC2254.2 +184200 ALSO ANY NC2254.2 +184300 ALSO ANY NC2254.2 +184400 ALSO ANY NC2254.2 +184500 ALSO ANY NC2254.2 +184600 ALSO WRK-DU-08V00 = 99 NC2254.2 +184700 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +184800 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +184900 WHEN OTHER NC2254.2 +185000 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +185100 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +185200 END-EVALUATE. NC2254.2 +185300 EVA-TEST-GF-34-1. NC2254.2 +185400 IF WRK-XN-00001-1 = "G" NC2254.2 +185500 PERFORM PASS NC2254.2 +185600 GO TO EVA-WRITE-GF-34-1 NC2254.2 +185700 ELSE NC2254.2 +185800 GO TO EVA-FAIL-GF-34-1. NC2254.2 +185900 EVA-DELETE-GF-34-1. NC2254.2 +186000 PERFORM DE-LETE. NC2254.2 +186100 GO TO EVA-WRITE-GF-34-1. NC2254.2 +186200 EVA-FAIL-GF-34-1. NC2254.2 +186300 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +186400 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +186500 MOVE "G" TO CORRECT-X NC2254.2 +186600 PERFORM FAIL. NC2254.2 +186700 EVA-WRITE-GF-34-1. NC2254.2 +186800 PERFORM PRINT-DETAIL. NC2254.2 +186900 EVA-TEST-GF-34-2. NC2254.2 +187000 ADD 1 TO REC-CT. NC2254.2 +187100 IF WRK-XN-00001-2 = "H" NC2254.2 +187200 PERFORM PASS NC2254.2 +187300 GO TO EVA-WRITE-GF-34-2 NC2254.2 +187400 ELSE NC2254.2 +187500 GO TO EVA-FAIL-GF-34-2. NC2254.2 +187600 EVA-DELETE-GF-34-2. NC2254.2 +187700 PERFORM DE-LETE. NC2254.2 +187800 GO TO EVA-WRITE-GF-34-2. NC2254.2 +187900 EVA-FAIL-GF-34-2. NC2254.2 +188000 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +188100 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +188200 MOVE "H" TO CORRECT-X NC2254.2 +188300 PERFORM FAIL. NC2254.2 +188400 EVA-WRITE-GF-34-2. NC2254.2 +188500 PERFORM PRINT-DETAIL. NC2254.2 +188600* NC2254.2 +188700 EVA-INIT-GF-35. NC2254.2 +188800 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +188900 MOVE "EVA-TEST-GF-35-1" TO PAR-NAME. NC2254.2 +189000 MOVE 1 TO REC-CT. NC2254.2 +189100 MOVE 81 TO WRK-DU-08V00-1. NC2254.2 +189200 GO TO EVA-TEST-GF-35-1. NC2254.2 +189300 EVA-DELETE-GF-35. NC2254.2 +189400 PERFORM DE-LETE. NC2254.2 +189500 PERFORM PRINT-DETAIL. NC2254.2 +189600 GO TO CCVS-EXIT. NC2254.2 +189700 EVA-TEST-GF-35-1. NC2254.2 +189800 EVALUATE TRUE NC2254.2 +189900 WHEN WRK-DU-08V00 NUMERIC NC2254.2 +190000 WHEN WRK-DU-08V00 > 10 NC2254.2 +190100 WHEN WRK-DU-08V00 < 100 NC2254.2 +190200 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +190300 WHEN OTHER NC2254.2 +190400 MOVE "Z" TO WRK-XN-00001-1 NC2254.2 +190500 END-EVALUATE. NC2254.2 +190600 IF WRK-XN-00001-1 = "A" NC2254.2 +190700 PERFORM PASS NC2254.2 +190800 GO TO EVA-WRITE-GF-35-1 NC2254.2 +190900 ELSE NC2254.2 +191000 GO TO EVA-FAIL-GF-35-1. NC2254.2 +191100 EVA-DELETE-GF-35-1. NC2254.2 +191200 PERFORM DE-LETE. NC2254.2 +191300 GO TO EVA-WRITE-GF-35-1. NC2254.2 +191400 EVA-FAIL-GF-35-1. NC2254.2 +191500 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +191600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +191700 MOVE "A" TO CORRECT-X NC2254.2 +191800 PERFORM FAIL. NC2254.2 +191900 EVA-WRITE-GF-35-1. NC2254.2 +192000 PERFORM PRINT-DETAIL. NC2254.2 +192100* NC2254.2 +192200 CCVS-EXIT SECTION. NC2254.2 +192300 CCVS-999999. NC2254.2 +192400 GO TO CLOSE-FILES. NC2254.2 +*END-OF,NC225A +*HEADER,COBOL,NC231A +000100 IDENTIFICATION DIVISION. NC2314.2 +000200 PROGRAM-ID. NC2314.2 +000300 NC231A. NC2314.2 +000400**************************************************************** NC2314.2 +000500* * NC2314.2 +000600* VALIDATION FOR:- * NC2314.2 +000700* * NC2314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +000900* * NC2314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2314.2 +001100* * NC2314.2 +001200**************************************************************** NC2314.2 +001300* * NC2314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2314.2 +001500* * NC2314.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2314.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2314.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2314.2 +001900* * NC2314.2 +002000**************************************************************** NC2314.2 +002100* * NC2314.2 +002200* PROGRAM NC231A USES FORMAT 1 OF THE "SEARCH" STATEMENT TO * NC2314.2 +002300* ACCESS THREE AND SEVEN DIMENSIONAL TABLES. * NC2314.2 +002400* THE OPTIONAL "VARYING" PHRASE IS USED WITH AN IDENTIFIER. * NC2314.2 +002500* THE SCOPE TERMINATOR "END-SEARCH" IS ALSO TESTED. * NC2314.2 +002600* * NC2314.2 +002700**************************************************************** NC2314.2 +002800 ENVIRONMENT DIVISION. NC2314.2 +002900 CONFIGURATION SECTION. NC2314.2 +003000 SOURCE-COMPUTER. NC2314.2 +003100 XXXXX082. NC2314.2 +003200 OBJECT-COMPUTER. NC2314.2 +003300 XXXXX083. NC2314.2 +003400 INPUT-OUTPUT SECTION. NC2314.2 +003500 FILE-CONTROL. NC2314.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2314.2 +003700 XXXXX055. NC2314.2 +003800 DATA DIVISION. NC2314.2 +003900 FILE SECTION. NC2314.2 +004000 FD PRINT-FILE. NC2314.2 +004100 01 PRINT-REC PICTURE X(120). NC2314.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2314.2 +004300 WORKING-STORAGE SECTION. NC2314.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2314.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2314.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2314.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2314.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2314.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2314.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2314.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2314.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2314.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2314.2 +005400 77 L1-HOLD PIC XX. NC2314.2 +005500 77 L2-HOLD PIC XX. NC2314.2 +005600 77 L3-HOLD PIC XX. NC2314.2 +005700 77 L4-HOLD PIC XX. NC2314.2 +005800 77 L5-HOLD PIC XX. NC2314.2 +005900 77 L6-HOLD PIC XX. NC2314.2 +006000 77 L7-HOLD PIC XX. NC2314.2 +006100 77 N1 PIC 99. NC2314.2 +006200 77 N2 PIC 99. NC2314.2 +006300 77 N3 PIC 99. NC2314.2 +006400 77 N4 PIC 99. NC2314.2 +006500 77 N5 PIC 99. NC2314.2 +006600 77 N6 PIC 99. NC2314.2 +006700 77 N7 PIC 99. NC2314.2 +006800 01 GRP-NAME. NC2314.2 +006900 02 FILLER PICTURE XXX VALUE "GRP". NC2314.2 +007000 02 ADD-GRP PICTURE 99 VALUE 01. NC2314.2 +007100 NC2314.2 +007200 01 SEC-NAME. NC2314.2 +007300 02 FILLER PICTURE X(5) VALUE "SEC (". NC2314.2 +007400 02 SEC-GRP PICTURE 99 VALUE 00. NC2314.2 +007500 02 FILLER PICTURE X VALUE ",". NC2314.2 +007600 02 ADD-SEC PICTURE 99 VALUE 01. NC2314.2 +007700 02 FILLER PICTURE X VALUE ")". NC2314.2 +007800 NC2314.2 +007900 01 ELEM-NAME. NC2314.2 +008000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2314.2 +008100 02 ELEM-GRP PICTURE 99 VALUE 00. NC2314.2 +008200 02 FILLER PICTURE X VALUE ",". NC2314.2 +008300 02 ELEM-SEC PICTURE 99 VALUE 00. NC2314.2 +008400 02 FILLER PICTURE X VALUE ",". NC2314.2 +008500 02 ADD-ELEM PICTURE 99 VALUE 01. NC2314.2 +008600 02 FILLER PICTURE X VALUE ")". NC2314.2 +008700 NC2314.2 +008800 NC2314.2 +008900 01 3-DIMENSION-TBL. NC2314.2 +009000 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2314.2 +009100 03 ENTRY-1 PICTURE X(5). NC2314.2 +009200 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2314.2 +009300 04 ENTRY-2 PICTURE X(11). NC2314.2 +009400 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2314.2 +009500 05 ENTRY-3 PICTURE X(15). NC2314.2 +009600 NC2314.2 +009700 01 7-DIMENSION-TBL. NC2314.2 +009800 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY IX-1. NC2314.2 +009900 03 ENTRY-7-1 PIC XX. NC2314.2 +010000 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY IX-2. NC2314.2 +010100 04 ENTRY-7-2 PIC XX. NC2314.2 +010200 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY IX-3. NC2314.2 +010300 05 ENTRY-7-3 PIC XX. NC2314.2 +010400 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY IX-4. NC2314.2 +010500 06 ENTRY-7-4 PIC XX. NC2314.2 +010600 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY IX-5. NC2314.2 +010700 07 ENTRY-7-5 PIC XX. NC2314.2 +010800 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY IX-6. NC2314.2 +010900 08 ENTRY-7-6 PIC XX. NC2314.2 +011000 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY IX-7. NC2314.2 +011100 09 ENTRY-7-7 PIC XX. NC2314.2 +011200 NC2314.2 +011300 01 END-STMT. NC2314.2 +011400 02 FILLER PICTURE X(7) VALUE "AT END ". NC2314.2 +011500 02 END-IDX PICTURE X(5) VALUE SPACES. NC2314.2 +011600 02 FILLER PICTURE XXX VALUE " = ". NC2314.2 +011700 02 IDX-VALU PICTURE 99 VALUE 00. NC2314.2 +011800 02 FILLER PICTURE XXX VALUE SPACES. NC2314.2 +011900 NC2314.2 +012000 01 NOTE-1. NC2314.2 +012100 02 FILLER PICTURE X(74) VALUE NC2314.2 +012200 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2314.2 +012300- "PATH WAS TAKEN". NC2314.2 +012400 02 FILLER PICTURE X(46) VALUE SPACE. NC2314.2 +012500 NC2314.2 +012600 01 NOTE-2. NC2314.2 +012700 02 FILLER PICTURE X(112) VALUE NC2314.2 +012800 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2314.2 +012900- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2314.2 +013000 02 FILLER PICTURE X(8) VALUE SPACE. NC2314.2 +013100 NC2314.2 +013200 01 TEST-RESULTS. NC2314.2 +013300 02 FILLER PIC X VALUE SPACE. NC2314.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. NC2314.2 +013500 02 FILLER PIC X VALUE SPACE. NC2314.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. NC2314.2 +013700 02 FILLER PIC X VALUE SPACE. NC2314.2 +013800 02 PAR-NAME. NC2314.2 +013900 03 FILLER PIC X(19) VALUE SPACE. NC2314.2 +014000 03 PARDOT-X PIC X VALUE SPACE. NC2314.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. NC2314.2 +014200 02 FILLER PIC X(8) VALUE SPACE. NC2314.2 +014300 02 RE-MARK PIC X(61). NC2314.2 +014400 01 TEST-COMPUTED. NC2314.2 +014500 02 FILLER PIC X(30) VALUE SPACE. NC2314.2 +014600 02 FILLER PIC X(17) VALUE NC2314.2 +014700 " COMPUTED=". NC2314.2 +014800 02 COMPUTED-X. NC2314.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2314.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A NC2314.2 +015100 PIC -9(9).9(9). NC2314.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2314.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2314.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2314.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. NC2314.2 +015600 04 COMPUTED-18V0 PIC -9(18). NC2314.2 +015700 04 FILLER PIC X. NC2314.2 +015800 03 FILLER PIC X(50) VALUE SPACE. NC2314.2 +015900 01 TEST-CORRECT. NC2314.2 +016000 02 FILLER PIC X(30) VALUE SPACE. NC2314.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2314.2 +016200 02 CORRECT-X. NC2314.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2314.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2314.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2314.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2314.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2314.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. NC2314.2 +016900 04 CORRECT-18V0 PIC -9(18). NC2314.2 +017000 04 FILLER PIC X. NC2314.2 +017100 03 FILLER PIC X(2) VALUE SPACE. NC2314.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2314.2 +017300 01 CCVS-C-1. NC2314.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2314.2 +017500- "SS PARAGRAPH-NAME NC2314.2 +017600- " REMARKS". NC2314.2 +017700 02 FILLER PIC X(20) VALUE SPACE. NC2314.2 +017800 01 CCVS-C-2. NC2314.2 +017900 02 FILLER PIC X VALUE SPACE. NC2314.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". NC2314.2 +018100 02 FILLER PIC X(15) VALUE SPACE. NC2314.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". NC2314.2 +018300 02 FILLER PIC X(94) VALUE SPACE. NC2314.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2314.2 +018500 01 REC-CT PIC 99 VALUE ZERO. NC2314.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2314.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2314.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2314.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2314.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2314.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2314.2 +019500 01 CCVS-H-1. NC2314.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC2314.2 +019700 02 FILLER PIC X(42) VALUE NC2314.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2314.2 +019900 02 FILLER PIC X(39) VALUE SPACES. NC2314.2 +020000 01 CCVS-H-2A. NC2314.2 +020100 02 FILLER PIC X(40) VALUE SPACE. NC2314.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2314.2 +020300 02 FILLER PIC XXXX VALUE NC2314.2 +020400 "4.2 ". NC2314.2 +020500 02 FILLER PIC X(28) VALUE NC2314.2 +020600 " COPY - NOT FOR DISTRIBUTION". NC2314.2 +020700 02 FILLER PIC X(41) VALUE SPACE. NC2314.2 +020800 NC2314.2 +020900 01 CCVS-H-2B. NC2314.2 +021000 02 FILLER PIC X(15) VALUE NC2314.2 +021100 "TEST RESULT OF ". NC2314.2 +021200 02 TEST-ID PIC X(9). NC2314.2 +021300 02 FILLER PIC X(4) VALUE NC2314.2 +021400 " IN ". NC2314.2 +021500 02 FILLER PIC X(12) VALUE NC2314.2 +021600 " HIGH ". NC2314.2 +021700 02 FILLER PIC X(22) VALUE NC2314.2 +021800 " LEVEL VALIDATION FOR ". NC2314.2 +021900 02 FILLER PIC X(58) VALUE NC2314.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +022100 01 CCVS-H-3. NC2314.2 +022200 02 FILLER PIC X(34) VALUE NC2314.2 +022300 " FOR OFFICIAL USE ONLY ". NC2314.2 +022400 02 FILLER PIC X(58) VALUE NC2314.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2314.2 +022600 02 FILLER PIC X(28) VALUE NC2314.2 +022700 " COPYRIGHT 1985 ". NC2314.2 +022800 01 CCVS-E-1. NC2314.2 +022900 02 FILLER PIC X(52) VALUE SPACE. NC2314.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2314.2 +023100 02 ID-AGAIN PIC X(9). NC2314.2 +023200 02 FILLER PIC X(45) VALUE SPACES. NC2314.2 +023300 01 CCVS-E-2. NC2314.2 +023400 02 FILLER PIC X(31) VALUE SPACE. NC2314.2 +023500 02 FILLER PIC X(21) VALUE SPACE. NC2314.2 +023600 02 CCVS-E-2-2. NC2314.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2314.2 +023800 03 FILLER PIC X VALUE SPACE. NC2314.2 +023900 03 ENDER-DESC PIC X(44) VALUE NC2314.2 +024000 "ERRORS ENCOUNTERED". NC2314.2 +024100 01 CCVS-E-3. NC2314.2 +024200 02 FILLER PIC X(22) VALUE NC2314.2 +024300 " FOR OFFICIAL USE ONLY". NC2314.2 +024400 02 FILLER PIC X(12) VALUE SPACE. NC2314.2 +024500 02 FILLER PIC X(58) VALUE NC2314.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +024700 02 FILLER PIC X(13) VALUE SPACE. NC2314.2 +024800 02 FILLER PIC X(15) VALUE NC2314.2 +024900 " COPYRIGHT 1985". NC2314.2 +025000 01 CCVS-E-4. NC2314.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2314.2 +025200 02 FILLER PIC X(4) VALUE " OF ". NC2314.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2314.2 +025400 02 FILLER PIC X(40) VALUE NC2314.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2314.2 +025600 01 XXINFO. NC2314.2 +025700 02 FILLER PIC X(19) VALUE NC2314.2 +025800 "*** INFORMATION ***". NC2314.2 +025900 02 INFO-TEXT. NC2314.2 +026000 04 FILLER PIC X(8) VALUE SPACE. NC2314.2 +026100 04 XXCOMPUTED PIC X(20). NC2314.2 +026200 04 FILLER PIC X(5) VALUE SPACE. NC2314.2 +026300 04 XXCORRECT PIC X(20). NC2314.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). NC2314.2 +026500 01 HYPHEN-LINE. NC2314.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. NC2314.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************NC2314.2 +026800- "*****************************************". NC2314.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************NC2314.2 +027000- "******************************". NC2314.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE NC2314.2 +027200 "NC231A". NC2314.2 +027300 PROCEDURE DIVISION. NC2314.2 +027400 CCVS1 SECTION. NC2314.2 +027500 OPEN-FILES. NC2314.2 +027600 OPEN OUTPUT PRINT-FILE. NC2314.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2314.2 +027800 MOVE SPACE TO TEST-RESULTS. NC2314.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2314.2 +028000 GO TO CCVS1-EXIT. NC2314.2 +028100 CLOSE-FILES. NC2314.2 +028200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2314.2 +028300 TERMINATE-CCVS. NC2314.2 +028400S EXIT PROGRAM. NC2314.2 +028500STERMINATE-CALL. NC2314.2 +028600 STOP RUN. NC2314.2 +028700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2314.2 +028800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2314.2 +028900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2314.2 +029000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2314.2 +029100 MOVE "****TEST DELETED****" TO RE-MARK. NC2314.2 +029200 PRINT-DETAIL. NC2314.2 +029300 IF REC-CT NOT EQUAL TO ZERO NC2314.2 +029400 MOVE "." TO PARDOT-X NC2314.2 +029500 MOVE REC-CT TO DOTVALUE. NC2314.2 +029600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2314.2 +029700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2314.2 +029800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2314.2 +029900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2314.2 +030000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2314.2 +030100 MOVE SPACE TO CORRECT-X. NC2314.2 +030200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2314.2 +030300 MOVE SPACE TO RE-MARK. NC2314.2 +030400 HEAD-ROUTINE. NC2314.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2314.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2314.2 +030900 COLUMN-NAMES-ROUTINE. NC2314.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +031300 END-ROUTINE. NC2314.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2314.2 +031500 END-RTN-EXIT. NC2314.2 +031600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +031700 END-ROUTINE-1. NC2314.2 +031800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2314.2 +031900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2314.2 +032000 ADD PASS-COUNTER TO ERROR-HOLD. NC2314.2 +032100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2314.2 +032200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2314.2 +032300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2314.2 +032400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2314.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2314.2 +032600 END-ROUTINE-12. NC2314.2 +032700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2314.2 +032800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2314.2 +032900 MOVE "NO " TO ERROR-TOTAL NC2314.2 +033000 ELSE NC2314.2 +033100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2314.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2314.2 +033300 PERFORM WRITE-LINE. NC2314.2 +033400 END-ROUTINE-13. NC2314.2 +033500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2314.2 +033600 MOVE "NO " TO ERROR-TOTAL ELSE NC2314.2 +033700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2314.2 +033800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2314.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034000 IF INSPECT-COUNTER EQUAL TO ZERO NC2314.2 +034100 MOVE "NO " TO ERROR-TOTAL NC2314.2 +034200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2314.2 +034300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2314.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034600 WRITE-LINE. NC2314.2 +034700 ADD 1 TO RECORD-COUNT. NC2314.2 +034800Y IF RECORD-COUNT GREATER 50 NC2314.2 +034900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2314.2 +035000Y MOVE SPACE TO DUMMY-RECORD NC2314.2 +035100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2314.2 +035200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2314.2 +035300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2314.2 +035400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2314.2 +035500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2314.2 +035600Y MOVE ZERO TO RECORD-COUNT. NC2314.2 +035700 PERFORM WRT-LN. NC2314.2 +035800 WRT-LN. NC2314.2 +035900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2314.2 +036000 MOVE SPACE TO DUMMY-RECORD. NC2314.2 +036100 BLANK-LINE-PRINT. NC2314.2 +036200 PERFORM WRT-LN. NC2314.2 +036300 FAIL-ROUTINE. NC2314.2 +036400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2314.2 +036500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2314.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2314.2 +036700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2314.2 +036800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +036900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2314.2 +037000 GO TO FAIL-ROUTINE-EX. NC2314.2 +037100 FAIL-ROUTINE-WRITE. NC2314.2 +037200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2314.2 +037300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2314.2 +037400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2314.2 +037500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2314.2 +037600 FAIL-ROUTINE-EX. EXIT. NC2314.2 +037700 BAIL-OUT. NC2314.2 +037800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2314.2 +037900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2314.2 +038000 BAIL-OUT-WRITE. NC2314.2 +038100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2314.2 +038200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2314.2 +038300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +038400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2314.2 +038500 BAIL-OUT-EX. EXIT. NC2314.2 +038600 CCVS1-EXIT. NC2314.2 +038700 EXIT. NC2314.2 +038800 SECT-NC231A-001 SECTION. NC2314.2 +038900 TH-01-001. NC2314.2 +039000 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2314.2 +039100 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2314.2 +039200 UNTIL SUB-1 EQUAL TO 11 NC2314.2 +039300 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2314.2 +039400 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2314.2 +039500 GO TO CHECK-ENTRIES. NC2314.2 +039600 NC2314.2 +039700 PARA-1. NC2314.2 +039800 SET IDX-1 TO SUB-1. NC2314.2 +039900 SET IDX-2 TO SUB-2. NC2314.2 +040000 SET IDX-3 TO SUB-3. NC2314.2 +040100 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2314.2 +040200 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2314.2 +040300 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2314.2 +040400 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2314.2 +040500 SET ADD-ELEM TO IDX-3. NC2314.2 +040600 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2314.2 +040700 NC2314.2 +040800 CHECK-ENTRIES. NC2314.2 +040900 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2314.2 +041000 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2314.2 +041100 MOVE "GRP02" TO GRP-HOLD-AREA. NC2314.2 +041200 MOVE 02 TO SUB-2. NC2314.2 +041300 MOVE 01 TO CON-5. NC2314.2 +041400 SET IDX-1 TO 01. NC2314.2 +041500 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +041600 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +041700 GO TO LEVEL-1-TEST-2 NC2314.2 +041800 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +041900 NC2314.2 +042000 PERFORM PASS-TH. NC2314.2 +042100 GO TO LEVEL-1-TEST-2. NC2314.2 +042200 NC2314.2 +042300 GRP-FAIL-PARGRAPH. NC2314.2 +042400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +042500 IF ENTRY-1 (SUB-2) NOT EQUAL TO GRP-HOLD-AREA NC2314.2 +042600 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2314.2 +042700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK ELSE NC2314.2 +042800 MOVE "IDX-1" TO END-IDX NC2314.2 +042900 SET IDX-VALU TO IDX-1 NC2314.2 +043000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +043100 MOVE END-STMT TO COMPUTED-A. NC2314.2 +043200 NC2314.2 +043300 PERFORM FAIL-TH. NC2314.2 +043400 LEVEL-1-TEST-2. NC2314.2 +043500 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2314.2 +043600 MOVE "GRP01" TO GRP-HOLD-AREA. NC2314.2 +043700 MOVE 01 TO SUB-2. NC2314.2 +043800 MOVE 01 TO CON-5. NC2314.2 +043900 SET IDX-1 TO 01. NC2314.2 +044000 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +044100 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +044200 GO TO LEVEL-1-TEST-3 NC2314.2 +044300 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +044400 NC2314.2 +044500 PERFORM PASS-TH. NC2314.2 +044600 LEVEL-1-TEST-3. NC2314.2 +044700 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2314.2 +044800 MOVE "GRP10" TO GRP-HOLD-AREA. NC2314.2 +044900 MOVE 10 TO SUB-2. NC2314.2 +045000 MOVE 01 TO CON-5. NC2314.2 +045100 SET IDX-1 TO 01. NC2314.2 +045200 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +045300 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +045400 GO TO LEVEL-1-TEST-4 NC2314.2 +045500 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +045600 NC2314.2 +045700 PERFORM PASS-TH. NC2314.2 +045800 LEVEL-1-TEST-4. NC2314.2 +045900 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2314.2 +046000 MOVE "GRP05" TO GRP-HOLD-AREA. NC2314.2 +046100 MOVE 05 TO SUB-2. NC2314.2 +046200 MOVE 05 TO CON-5. NC2314.2 +046300 SET IDX-1 TO 05. NC2314.2 +046400 SEARCH GRP-ENTRY VARYING CON-5 WHEN ENTRY-1 (CON-5) NC2314.2 +046500 EQUAL TO GRP-HOLD-AREA GO TO PASS-TH-TEST-4. NC2314.2 +046600 PERFORM GRP-FAIL-PARGRAPH. NC2314.2 +046700 GO TO LEVEL-2-TEST-1. NC2314.2 +046800 PASS-TH-TEST-4. NC2314.2 +046900 NC2314.2 +047000 PERFORM PASS-TH. NC2314.2 +047100 NC2314.2 +047200 LEVEL-2-TEST-1. NC2314.2 +047300 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2314.2 +047400 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2314.2 +047500 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2314.2 +047600 MOVE 1 TO SUB-1 SUB-2. NC2314.2 +047700 SET IDX-1 IDX-2 TO 01. NC2314.2 +047800 MOVE 01 TO CON-6. NC2314.2 +047900 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +048000 PERFORM SEC-FAIL-PARGRAF NC2314.2 +048100 GO TO LEVEL-2-TEST-2 NC2314.2 +048200 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +048300 NEXT SENTENCE. NC2314.2 +048400 NC2314.2 +048500 PERFORM PASS-TH. NC2314.2 +048600 NC2314.2 +048700 LEVEL-2-TEST-2. NC2314.2 +048800 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2314.2 +048900 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2314.2 +049000 MOVE 05 TO SUB-1. NC2314.2 +049100 MOVE 10 TO SUB-2. NC2314.2 +049200 SET IDX-1 TO 5. NC2314.2 +049300 MOVE 01 TO CON-6. NC2314.2 +049400 SET IDX-2 TO 01. NC2314.2 +049500 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +049600 PERFORM SEC-FAIL-PARGRAF NC2314.2 +049700 GO TO LEVEL-2-TEST-3 NC2314.2 +049800 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +049900 NEXT SENTENCE. NC2314.2 +050000 NC2314.2 +050100 PERFORM PASS-TH. NC2314.2 +050200 NC2314.2 +050300 LEVEL-2-TEST-3. NC2314.2 +050400 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2314.2 +050500 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2314.2 +050600 SET IDX-1 TO 10. NC2314.2 +050700 MOVE 01 TO CON-6. NC2314.2 +050800 SET IDX-2 TO 01. NC2314.2 +050900 MOVE 10 TO SUB-1 SUB-2. NC2314.2 +051000 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +051100 PERFORM SEC-FAIL-PARGRAF NC2314.2 +051200 GO TO LEVEL-2-TEST-4 NC2314.2 +051300 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +051400 NEXT SENTENCE. NC2314.2 +051500 NC2314.2 +051600 PERFORM PASS-TH. NC2314.2 +051700 LEVEL-2-TEST-4. NC2314.2 +051800 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2314.2 +051900 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2314.2 +052000 MOVE 08 TO SUB-1. NC2314.2 +052100 MOVE 02 TO SUB-2. NC2314.2 +052200 SET IDX-1 TO 08. NC2314.2 +052300 MOVE 01 TO CON-6. NC2314.2 +052400 SET IDX-2 TO 01. NC2314.2 +052500 SEARCH GRP2-ENTRY VARYING CON-6 NC2314.2 +052600 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +052700 GO TO PASS-TH-2-4. NC2314.2 +052800 PERFORM SEC-FAIL-PARGRAF. NC2314.2 +052900 GO TO LEVEL-3-TEST-1. NC2314.2 +053000 PASS-TH-2-4. NC2314.2 +053100 NC2314.2 +053200 PERFORM PASS-TH. NC2314.2 +053300 GO TO LEVEL-3-TEST-1. NC2314.2 +053400 NC2314.2 +053500 SEC-FAIL-PARGRAF. NC2314.2 +053600 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +053700 IF ENTRY-2 (SUB-1, SUB-2) = SEC-HOLD-AREA NC2314.2 +053800 MOVE "IDX-2" TO END-IDX NC2314.2 +053900 SET IDX-VALU TO IDX-2 NC2314.2 +054000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +054100 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +054200 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2314.2 +054300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +054400 NC2314.2 +054500 PERFORM FAIL-TH. NC2314.2 +054600 NC2314.2 +054700 LEVEL-3-TEST-1. NC2314.2 +054800 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2314.2 +054900 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2314.2 +055000 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2314.2 +055100 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2314.2 +055200 SET IDX-1 IDX-2 IDX-3 TO 01. NC2314.2 +055300 MOVE 01 TO CON-7. NC2314.2 +055400 SEARCH GRP3-ENTRY VARYING CON-7 NC2314.2 +055500 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +055600 GO TO PASS-TH-3-1. NC2314.2 +055700 PERFORM ELEM-FAIL-PARA. NC2314.2 +055800 GO TO LEVEL-3-TEST-2. NC2314.2 +055900 PASS-TH-3-1. NC2314.2 +056000 NC2314.2 +056100 PERFORM PASS-TH. NC2314.2 +056200 NC2314.2 +056300 LEVEL-3-TEST-2. NC2314.2 +056400 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2314.2 +056500 MOVE 05 TO SUB-1. NC2314.2 +056600 MOVE 06 TO SUB-2. NC2314.2 +056700 MOVE 07 TO SUB-3. NC2314.2 +056800 SET IDX-1 TO 05. NC2314.2 +056900 SET IDX-2 TO 06. NC2314.2 +057000 MOVE 01 TO CON-7. NC2314.2 +057100 SET IDX-3 TO 01. NC2314.2 +057200 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2314.2 +057300 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +057400 PERFORM ELEM-FAIL-PARA NC2314.2 +057500 GO TO LEVEL-3-TEST-3 NC2314.2 +057600 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +057700 NEXT SENTENCE. NC2314.2 +057800 NC2314.2 +057900 PERFORM PASS-TH. NC2314.2 +058000 NC2314.2 +058100 LEVEL-3-TEST-3. NC2314.2 +058200 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2314.2 +058300 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2314.2 +058400 SET IDX-1 IDX-2 TO 10. NC2314.2 +058500 SET IDX-3 TO 01. NC2314.2 +058600 MOVE 01 TO CON-7. NC2314.2 +058700 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2314.2 +058800 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +058900 PERFORM ELEM-FAIL-PARA NC2314.2 +059000 GO TO LEVEL-3-TEST-4 NC2314.2 +059100 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +059200 NEXT SENTENCE. NC2314.2 +059300 NC2314.2 +059400 PERFORM PASS-TH. NC2314.2 +059500 LEVEL-3-TEST-4. NC2314.2 +059600 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2314.2 +059700 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2314.2 +059800 MOVE 07 TO SUB-1. NC2314.2 +059900 MOVE 06 TO SUB-2. NC2314.2 +060000 MOVE 05 TO SUB-3. NC2314.2 +060100 SET IDX-1 TO 07. NC2314.2 +060200 SET IDX-2 TO 06. NC2314.2 +060300 SET IDX-3 TO 03. NC2314.2 +060400 MOVE 03 TO CON-7. NC2314.2 +060500 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +060600 PERFORM ELEM-FAIL-PARA NC2314.2 +060700 GO TO MULT-SEARCH-TEST-1 NC2314.2 +060800 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +060900 NEXT SENTENCE. NC2314.2 +061000 NC2314.2 +061100 PERFORM PASS-TH. NC2314.2 +061200 GO TO MULT-SEARCH-TEST-1. NC2314.2 +061300 ELEM-FAIL-PARA. NC2314.2 +061400 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2314.2 +061500 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) = ELEM-HOLD-AREA NC2314.2 +061600 MOVE "IDX-3" TO END-IDX NC2314.2 +061700 SET IDX-VALU TO IDX-3 NC2314.2 +061800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +061900 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +062000 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2314.2 +062100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +062200 NC2314.2 +062300 PERFORM FAIL-TH. NC2314.2 +062400 NC2314.2 +062500 MULT-SEARCH-TEST-1. NC2314.2 +062600 MOVE "MULT-SEARCH-TEST-1 " TO PAR-NAME. NC2314.2 +062700 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2314.2 +062800 MOVE "GRP08" TO GRP-HOLD-AREA. NC2314.2 +062900 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2314.2 +063000 MOVE 01 TO CON-5 CON-6. NC2314.2 +063100 SET IDX-1 IDX-2 TO 01. NC2314.2 +063200 SEARCH GRP-ENTRY VARYING CON-5 AT END GO TO MULT-SEARCH-FAIL1NC2314.2 +063300 WHEN ENTRY-1 (CON-5) = "GRP08" NEXT SENTENCE. NC2314.2 +063400 SEARCH GRP2-ENTRY VARYING CON-6 AT END GO TO MULT-SEARCH-FAILNC2314.2 +063500 WHEN ENTRY-2 (CON-5, CON-6) = SEC-HOLD-AREA NC2314.2 +063600 NEXT SENTENCE. NC2314.2 +063700 NC2314.2 +063800 PERFORM PASS-TH. NC2314.2 +063900 GO TO MULT-SEARCH-TEST-2. NC2314.2 +064000 MULT-SEARCH-FAIL1. NC2314.2 +064100 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +064200 IF ENTRY-1 (08) = GRP-HOLD-AREA NC2314.2 +064300 MOVE "IDX-1" TO END-IDX NC2314.2 +064400 SET IDX-VALU TO IDX-1 NC2314.2 +064500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +064600 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +064700 MOVE ENTRY-1 (08) TO COMPUTED-A NC2314.2 +064800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +064900 NC2314.2 +065000 PERFORM FAIL-TH. NC2314.2 +065100 GO TO MULT-SEARCH-TEST-2. NC2314.2 +065200 MULT-SEARCH-FAIL. NC2314.2 +065300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +065400 IF ENTRY-2 (08, 07) = SEC-HOLD-AREA NC2314.2 +065500 MOVE "IDX-2" TO END-IDX NC2314.2 +065600 SET IDX-VALU TO IDX-2 NC2314.2 +065700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +065800 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +065900 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2314.2 +066000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +066100 NC2314.2 +066200 PERFORM FAIL-TH. NC2314.2 +066300 NC2314.2 +066400 MULT-SEARCH-TEST-2. NC2314.2 +066500 MOVE "MULT-SEARCH-TEST-2 " TO PAR-NAME. NC2314.2 +066600 MOVE "GRP04" TO GRP-HOLD-AREA. NC2314.2 +066700 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2314.2 +066800 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2314.2 +066900 MOVE 01 TO CON-5 CON-6 CON-7. NC2314.2 +067000 SET IDX-1 IDX-2 IDX-3 TO 01. NC2314.2 +067100 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +067200 GO TO MULT-SEARCH-2-FAIL WHEN ENTRY-1 (CON-5) = NC2314.2 +067300 GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +067400 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +067500 GO TO MULT-SEARCH-3-FAIL WHEN ENTRY-2 (CON-5, CON-6) = NC2314.2 +067600 SEC-HOLD-AREA NEXT SENTENCE. NC2314.2 +067700 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +067800 GO TO MULT-SEARCH-4-FAIL WHEN ENTRY-3 NC2314.2 +067900 (CON-5, CON-6, CON-7) = ELEM-HOLD-AREA NEXT SENTENCE.NC2314.2 +068000 NC2314.2 +068100 PERFORM PASS-TH. NC2314.2 +068200 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +068300 NC2314.2 +068400 MULT-SEARCH-2-FAIL. NC2314.2 +068500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +068600 IF ENTRY-1 (04) = GRP-HOLD-AREA NC2314.2 +068700 MOVE "IDX-1" TO END-IDX NC2314.2 +068800 SET IDX-VALU TO IDX-1 NC2314.2 +068900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +069000 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +069100 MOVE ENTRY-1 (04) TO COMPUTED-A NC2314.2 +069200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +069300 NC2314.2 +069400 PERFORM FAIL-TH. NC2314.2 +069500 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +069600 NC2314.2 +069700 MULT-SEARCH-3-FAIL. NC2314.2 +069800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +069900 IF ENTRY-2 (04, 04) = SEC-HOLD-AREA NC2314.2 +070000 MOVE "IDX-2" TO END-IDX NC2314.2 +070100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +070200 SET IDX-VALU TO IDX-2 NC2314.2 +070300 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +070400 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2314.2 +070500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +070600 NC2314.2 +070700 PERFORM FAIL-TH. NC2314.2 +070800 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +070900 NC2314.2 +071000 MULT-SEARCH-4-FAIL. NC2314.2 +071100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2314.2 +071200 IF ENTRY-3 (04, 04, 04) = ELEM-HOLD-AREA NC2314.2 +071300 MOVE "IDX-3" TO END-IDX NC2314.2 +071400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +071500 SET IDX-VALU TO IDX-3 NC2314.2 +071600 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +071700 MOVE ENTRY-3 (04, 04, 04) TO COMPUTED-A NC2314.2 +071800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +071900 NC2314.2 +072000 PERFORM FAIL-TH. NC2314.2 +072100 NC2314.2 +072200 MULT-SEARCH-7-INIT-3. NC2314.2 +072300 MOVE "MULT-SEARCH-7-TEST-3" TO PAR-NAME. NC2314.2 +072400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2314.2 +072500 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2314.2 +072600 MOVE "UV" TO L1-HOLD. NC2314.2 +072700 MOVE "WX" TO L2-HOLD. NC2314.2 +072800 MOVE "IJ" TO L3-HOLD. NC2314.2 +072900 MOVE "KL" TO L4-HOLD. NC2314.2 +073000 MOVE "AB" TO L5-HOLD. NC2314.2 +073100 MOVE "CD" TO L6-HOLD. NC2314.2 +073200 MOVE "GH" TO L7-HOLD. NC2314.2 +073300 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +073400 MOVE 1 TO N1 N2 N3 N4 N5 N6 N7. NC2314.2 +073500 GO TO MULT-SEARCH-7-TEST-3. NC2314.2 +073600 MULT-SEARCH-7-DELETE-3. NC2314.2 +073700 PERFORM DE-LETE. NC2314.2 +073800 PERFORM PRINT-DETAIL. NC2314.2 +073900 GO TO SPECIAL-TEST-1. NC2314.2 +074000 MULT-SEARCH-7-TEST-3. NC2314.2 +074100 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +074200 AT END GO TO MULT-SEARCH-7-FAIL-1 NC2314.2 +074300 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +074400 NEXT SENTENCE. NC2314.2 +074500 SEARCH GRP-7-2-ENTRY VARYING N2 NC2314.2 +074600 AT END GO TO MULT-SEARCH-7-FAIL-2 NC2314.2 +074700 WHEN ENTRY-7-2 (N1 N2) = L2-HOLD NC2314.2 +074800 NEXT SENTENCE. NC2314.2 +074900 SEARCH GRP-7-3-ENTRY VARYING N3 NC2314.2 +075000 AT END GO TO MULT-SEARCH-7-FAIL-3 NC2314.2 +075100 WHEN ENTRY-7-3 (N1 N2 N3) = L3-HOLD NC2314.2 +075200 NEXT SENTENCE. NC2314.2 +075300 SEARCH GRP-7-4-ENTRY VARYING N4 NC2314.2 +075400 AT END GO TO MULT-SEARCH-7-FAIL-4 NC2314.2 +075500 WHEN ENTRY-7-4 (N1 N2 N3 N4) = L4-HOLD NC2314.2 +075600 NEXT SENTENCE. NC2314.2 +075700 SEARCH GRP-7-5-ENTRY VARYING N5 NC2314.2 +075800 AT END GO TO MULT-SEARCH-7-FAIL-5 NC2314.2 +075900 WHEN ENTRY-7-5 (N1 N2 N3 N4 N5) = L5-HOLD NC2314.2 +076000 NEXT SENTENCE. NC2314.2 +076100 SEARCH GRP-7-6-ENTRY VARYING N6 NC2314.2 +076200 AT END GO TO MULT-SEARCH-7-FAIL-6 NC2314.2 +076300 WHEN ENTRY-7-6 (N1 N2 N3 N4 N5 N6) = L6-HOLD NC2314.2 +076400 NEXT SENTENCE. NC2314.2 +076500 SEARCH GRP-7-7-ENTRY VARYING N7 NC2314.2 +076600 AT END GO TO MULT-SEARCH-7-FAIL-7 NC2314.2 +076700 WHEN ENTRY-7-7 (N1 N2 N3 N4 N5 N6 N7) = L7-HOLD NC2314.2 +076800 NEXT SENTENCE. NC2314.2 +076900 NC2314.2 +077000 PERFORM PASS-TH. NC2314.2 +077100 GO TO SPECIAL-TEST-1. NC2314.2 +077200 NC2314.2 +077300 MULT-SEARCH-7-FAIL-1. NC2314.2 +077400 MOVE L1-HOLD TO CORRECT-A. NC2314.2 +077500 IF ENTRY-7-1 (2) = L1-HOLD NC2314.2 +077600 MOVE "IX-1" TO END-IDX NC2314.2 +077700 SET IDX-VALU TO IX-1 NC2314.2 +077800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +077900 MOVE END-STMT TO COMPUTED-A NC2314.2 +078000 ELSE NC2314.2 +078100 MOVE ENTRY-7-1 (2) TO COMPUTED-A NC2314.2 +078200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +078300 NC2314.2 +078400 PERFORM FAIL-TH. NC2314.2 +078500 GO TO SPECIAL-TEST-1. NC2314.2 +078600 NC2314.2 +078700 MULT-SEARCH-7-FAIL-2. NC2314.2 +078800 MOVE L2-HOLD TO CORRECT-A. NC2314.2 +078900 IF ENTRY-7-2 (2 1) = L1-HOLD NC2314.2 +079000 MOVE "IX-2" TO END-IDX NC2314.2 +079100 SET IDX-VALU TO IX-2 NC2314.2 +079200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +079300 MOVE END-STMT TO COMPUTED-A NC2314.2 +079400 ELSE NC2314.2 +079500 MOVE ENTRY-7-2 (2 1) TO COMPUTED-A NC2314.2 +079600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +079700 NC2314.2 +079800 PERFORM FAIL-TH. NC2314.2 +079900 GO TO SPECIAL-TEST-1. NC2314.2 +080000 NC2314.2 +080100 MULT-SEARCH-7-FAIL-3. NC2314.2 +080200 MOVE L3-HOLD TO CORRECT-A. NC2314.2 +080300 IF ENTRY-7-3 (2 1 2) = L3-HOLD NC2314.2 +080400 MOVE "IX-3" TO END-IDX NC2314.2 +080500 SET IDX-VALU TO IX-3 NC2314.2 +080600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +080700 MOVE END-STMT TO COMPUTED-A NC2314.2 +080800 ELSE NC2314.2 +080900 MOVE ENTRY-7-3 (2 1 2) TO COMPUTED-A NC2314.2 +081000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +081100 NC2314.2 +081200 PERFORM FAIL-TH. NC2314.2 +081300 GO TO SPECIAL-TEST-1. NC2314.2 +081400 NC2314.2 +081500 MULT-SEARCH-7-FAIL-4. NC2314.2 +081600 MOVE L4-HOLD TO CORRECT-A. NC2314.2 +081700 IF ENTRY-7-4 (2 1 2 1) = L4-HOLD NC2314.2 +081800 MOVE "IX-4" TO END-IDX NC2314.2 +081900 SET IDX-VALU TO IX-4 NC2314.2 +082000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +082100 MOVE END-STMT TO COMPUTED-A NC2314.2 +082200 ELSE NC2314.2 +082300 MOVE ENTRY-7-4 (2 1 2 1) TO COMPUTED-A NC2314.2 +082400 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +082500 NC2314.2 +082600 PERFORM FAIL-TH. NC2314.2 +082700 GO TO SPECIAL-TEST-1. NC2314.2 +082800 NC2314.2 +082900 MULT-SEARCH-7-FAIL-5. NC2314.2 +083000 MOVE L5-HOLD TO CORRECT-A. NC2314.2 +083100 IF ENTRY-7-5 (2 1 2 1 2) = L5-HOLD NC2314.2 +083200 MOVE "IX-5" TO END-IDX NC2314.2 +083300 SET IDX-VALU TO IX-5 NC2314.2 +083400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +083500 MOVE END-STMT TO COMPUTED-A NC2314.2 +083600 ELSE NC2314.2 +083700 MOVE ENTRY-7-5 (2 1 2 1 2) TO COMPUTED-A NC2314.2 +083800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +083900 NC2314.2 +084000 PERFORM FAIL-TH. NC2314.2 +084100 GO TO SPECIAL-TEST-1. NC2314.2 +084200 NC2314.2 +084300 MULT-SEARCH-7-FAIL-6. NC2314.2 +084400 MOVE L6-HOLD TO CORRECT-A. NC2314.2 +084500 IF ENTRY-7-6 (2 1 2 1 2 1) = L6-HOLD NC2314.2 +084600 MOVE "IX-6" TO END-IDX NC2314.2 +084700 SET IDX-VALU TO IX-6 NC2314.2 +084800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +084900 MOVE END-STMT TO COMPUTED-A NC2314.2 +085000 ELSE NC2314.2 +085100 MOVE ENTRY-7-6 (2 1 2 1 2 1) TO COMPUTED-A NC2314.2 +085200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +085300 NC2314.2 +085400 PERFORM FAIL-TH. NC2314.2 +085500 GO TO SPECIAL-TEST-1. NC2314.2 +085600 NC2314.2 +085700 MULT-SEARCH-7-FAIL-7. NC2314.2 +085800 MOVE L7-HOLD TO CORRECT-A. NC2314.2 +085900 IF ENTRY-7-7 (2 1 2 1 2 1 2) = L7-HOLD NC2314.2 +086000 MOVE "IX-7" TO END-IDX NC2314.2 +086100 SET IDX-VALU TO IX-7 NC2314.2 +086200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +086300 MOVE END-STMT TO COMPUTED-A NC2314.2 +086400 ELSE NC2314.2 +086500 MOVE ENTRY-7-7 (2 1 2 1 2 1 2) TO COMPUTED-A NC2314.2 +086600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +086700 NC2314.2 +086800 PERFORM FAIL-TH. NC2314.2 +086900 NC2314.2 +087000 SPECIAL-TEST-1. NC2314.2 +087100 MOVE "SPECIAL-TEST-1 " TO PAR-NAME. NC2314.2 +087200 MOVE "IDX SET HI TO ENTRY " TO FEATURE. NC2314.2 +087300 MOVE 04 TO CON-5. NC2314.2 +087400 SET IDX-1 TO 04. NC2314.2 +087500 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +087600 GO TO SPEC-PASS-PARAGRAPH-1 WHEN ENTRY-1 (CON-5) = "GRP03" NC2314.2 +087700 GO TO SPEC-FAIL-PARAGRAPH-1. NC2314.2 +087800 SPECIAL-2-LEVEL-SEARCH. NC2314.2 +087900 MOVE "SPECIAL-2-LEVEL-SEAR" TO PAR-NAME. NC2314.2 +088000 MOVE 04 TO CON-5. NC2314.2 +088100 MOVE 05 TO CON-6. NC2314.2 +088200 SET IDX-1 TO 04. NC2314.2 +088300 SET IDX-2 TO 05. NC2314.2 +088400 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2314.2 +088500 GO TO SPEC-FAIL-PARAGRAPH-2 NC2314.2 +088600 WHEN ENTRY-1 (CON-5) = "GRP04" NEXT SENTENCE. NC2314.2 +088700 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +088800 GO TO SPEC-PASS-PARAGRAPH-2 NC2314.2 +088900 WHEN ENTRY-2 (CON-5, CON-6) = "SEC (04,04)" NC2314.2 +089000 GO TO SPEC-FAIL-PARAGRAPH-3. NC2314.2 +089100 SPEC-PASS-PARAGRAPH-1. NC2314.2 +089200 NC2314.2 +089300 PERFORM PASS-TH. NC2314.2 +089400 GO TO SPECIAL-2-LEVEL-SEARCH. NC2314.2 +089500 NC2314.2 +089600 SPEC-FAIL-PARAGRAPH-1. NC2314.2 +089700 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK. NC2314.2 +089800 MOVE "GRP03" TO COMPUTED-A. NC2314.2 +089900 NC2314.2 +090000 MOVE SPACES TO CORRECT-A. NC2314.2 +090100 PERFORM FAIL-TH. NC2314.2 +090200 GO TO SPECIAL-2-LEVEL-SEARCH. NC2314.2 +090300 NC2314.2 +090400 SPEC-FAIL-PARAGRAPH-2. NC2314.2 +090500 MOVE "GRP04" TO CORRECT-A. NC2314.2 +090600 MOVE ENTRY-1 (04) TO COMPUTED-A. NC2314.2 +090700 NC2314.2 +090800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +090900 PERFORM FAIL-TH. NC2314.2 +091000 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +091100 NC2314.2 +091200 SPEC-FAIL-PARAGRAPH-3. NC2314.2 +091300 MOVE ENTRY-2 (04, 04) TO COMPUTED-A. NC2314.2 +091400 MOVE SPACE TO CORRECT-A. NC2314.2 +091500 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK. NC2314.2 +091600 NC2314.2 +091700 PERFORM FAIL-TH. NC2314.2 +091800 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +091900 NC2314.2 +092000 SPEC-PASS-PARAGRAPH-2. NC2314.2 +092100 NC2314.2 +092200 PERFORM PASS-TH. NC2314.2 +092300 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +092400 NC2314.2 +092500 SPECIAL-3-LEVEL-SEARCH. NC2314.2 +092600 MOVE "SPECIAL-3-LEVEL-SEAR" TO PAR-NAME. NC2314.2 +092700 SET IDX-1 TO 02. NC2314.2 +092800 MOVE 02 TO CON-5. NC2314.2 +092900 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +093000 GO TO SPEC-FAIL-PARAGRAPH-4 WHEN ENTRY-1 (CON-5) NC2314.2 +093100 EQUAL TO "GRP02" NEXT SENTENCE. NC2314.2 +093200 MOVE 01 TO CON-6. NC2314.2 +093300 SET IDX-2 TO 01. NC2314.2 +093400 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +093500 GO TO SPEC-FAIL-PARAGRAPH-5 NC2314.2 +093600 WHEN ENTRY-2 (CON-5, CON-6) = "SEC (02,03)" NEXT SENTENCE. NC2314.2 +093700 MOVE 05 TO CON-7. NC2314.2 +093800 SET IDX-3 TO 05. NC2314.2 +093900 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +094000 GO TO SPEC-PASS-PARAGRAPH-3 NC2314.2 +094100 WHEN ENTRY-3 (CON-5, CON-6, CON-7) = "ELEM (02,03,04)" NC2314.2 +094200 NC2314.2 +094300 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2314.2 +094400 MOVE SPACES TO CORRECT-A NC2314.2 +094500 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2314.2 +094600 PERFORM FAIL-TH NC2314.2 +094700 GO TO SEARCH-INIT-1. NC2314.2 +094800 SPEC-PASS-PARAGRAPH-3. NC2314.2 +094900 NC2314.2 +095000 PERFORM PASS-TH. NC2314.2 +095100 GO TO SEARCH-INIT-1. NC2314.2 +095200 NC2314.2 +095300 SPEC-FAIL-PARAGRAPH-4. NC2314.2 +095400 IF ENTRY-1 (02) = "GRP02" NC2314.2 +095500 MOVE "IDX-1" TO END-IDX NC2314.2 +095600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +095700 SET IDX-VALU TO IDX-1 NC2314.2 +095800 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +095900 MOVE ENTRY-1 (02) TO COMPUTED-A NC2314.2 +096000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +096100 NC2314.2 +096200 MOVE "GRP02" TO CORRECT-A. NC2314.2 +096300 PERFORM FAIL-TH. NC2314.2 +096400 GO TO SEARCH-INIT-1. NC2314.2 +096500 SPEC-FAIL-PARAGRAPH-5. NC2314.2 +096600 IF ENTRY-2 (02, 03) = "SEC (02,03)" NC2314.2 +096700 MOVE "IDX-2" TO END-IDX NC2314.2 +096800 SET IDX-VALU TO IDX-2 NC2314.2 +096900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +097000 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +097100 MOVE ENTRY-2 (02, 03) TO COMPUTED-A NC2314.2 +097200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +097300 NC2314.2 +097400 MOVE "SEC (02, 03)" TO CORRECT-A. NC2314.2 +097500 PERFORM FAIL-TH. NC2314.2 +097600 NC2314.2 +097700 NC2314.2 +097800 SEARCH-INIT-1. NC2314.2 +097900 MOVE "SEARCH-TEST-1" TO PAR-NAME. NC2314.2 +098000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC2314.2 +098100 MOVE "EXP.SCOPE TERMINATOR" TO FEATURE. NC2314.2 +098200 MOVE "CD" TO L1-HOLD. NC2314.2 +098300 MOVE "CD" TO ENTRY-7-1 (2). NC2314.2 +098400 MOVE SPACE TO L2-HOLD. NC2314.2 +098500 MOVE SPACE TO L3-HOLD. NC2314.2 +098600 MOVE SPACE TO L4-HOLD. NC2314.2 +098700 MOVE 1 TO REC-CT. NC2314.2 +098800 MOVE 1 TO N1. NC2314.2 +098900 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +099000 GO TO SEARCH-TEST-1-0. NC2314.2 +099100 SEARCH-DELETE-1. NC2314.2 +099200 PERFORM DE-LETE. NC2314.2 +099300 PERFORM PRINT-DETAIL. NC2314.2 +099400 GO TO SEARCH-INIT-2. NC2314.2 +099500 SEARCH-TEST-1-0. NC2314.2 +099600 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +099700 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +099800 MOVE "AA" TO L2-HOLD NC2314.2 +099900 MOVE "BB" TO L3-HOLD NC2314.2 +100000 END-SEARCH NC2314.2 +100100 MOVE "CC" TO L4-HOLD. NC2314.2 +100200 SEARCH-TEST-1-1. NC2314.2 +100300 MOVE "SEARCH-TEST-1-1" TO PAR-NAME. NC2314.2 +100400 IF L2-HOLD = "AA" NC2314.2 +100500 PERFORM PASS NC2314.2 +100600 PERFORM PRINT-DETAIL NC2314.2 +100700 ELSE NC2314.2 +100800 MOVE "'WHEN' PHRASE SHOULD BE TRUE" TO RE-MARK NC2314.2 +100900 MOVE "AA" TO CORRECT-X NC2314.2 +101000 MOVE L2-HOLD TO COMPUTED-X NC2314.2 +101100 PERFORM FAIL NC2314.2 +101200 PERFORM PRINT-DETAIL. NC2314.2 +101300 ADD 1 TO REC-CT. NC2314.2 +101400 SEARCH-TEST-1-2. NC2314.2 +101500 MOVE "SEARCH-TEST-1-2" TO PAR-NAME. NC2314.2 +101600 IF L3-HOLD = "BB" NC2314.2 +101700 PERFORM PASS NC2314.2 +101800 PERFORM PRINT-DETAIL NC2314.2 +101900 ELSE NC2314.2 +102000 MOVE "'WHEN' PHRASE SHOULD BE TRUE" TO RE-MARK NC2314.2 +102100 MOVE "BB" TO CORRECT-X NC2314.2 +102200 MOVE L3-HOLD TO COMPUTED-X NC2314.2 +102300 PERFORM FAIL NC2314.2 +102400 PERFORM PRINT-DETAIL. NC2314.2 +102500 ADD 1 TO REC-CT. NC2314.2 +102600 SEARCH-TEST-1-3. NC2314.2 +102700 MOVE "SEARCH-TEST-1-3" TO PAR-NAME. NC2314.2 +102800 IF L4-HOLD = "CC" NC2314.2 +102900 PERFORM PASS NC2314.2 +103000 PERFORM PRINT-DETAIL NC2314.2 +103100 ELSE NC2314.2 +103200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2314.2 +103300 MOVE "CC" TO CORRECT-X NC2314.2 +103400 MOVE L4-HOLD TO COMPUTED-X NC2314.2 +103500 PERFORM FAIL NC2314.2 +103600 PERFORM PRINT-DETAIL. NC2314.2 +103700 NC2314.2 +103800 NC2314.2 +103900 SEARCH-INIT-2. NC2314.2 +104000 MOVE "SEARCH-TEST-2" TO PAR-NAME. NC2314.2 +104100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC2314.2 +104200 MOVE "CD" TO L1-HOLD. NC2314.2 +104300 MOVE "ZZ" TO ENTRY-7-1 (2). NC2314.2 +104400 MOVE SPACE TO L2-HOLD. NC2314.2 +104500 MOVE SPACE TO L3-HOLD. NC2314.2 +104600 MOVE SPACE TO L4-HOLD. NC2314.2 +104700 MOVE 1 TO REC-CT. NC2314.2 +104800 MOVE 1 TO N1. NC2314.2 +104900 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +105000 GO TO SEARCH-TEST-2-0. NC2314.2 +105100 SEARCH-DELETE-2. NC2314.2 +105200 PERFORM DE-LETE. NC2314.2 +105300 PERFORM PRINT-DETAIL. NC2314.2 +105400 GO TO END-SEARCH-TEST. NC2314.2 +105500 SEARCH-TEST-2-0. NC2314.2 +105600 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +105700 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +105800 MOVE "AA" TO L2-HOLD NC2314.2 +105900 MOVE "BB" TO L3-HOLD NC2314.2 +106000 END-SEARCH NC2314.2 +106100 MOVE "CC" TO L4-HOLD. NC2314.2 +106200 SEARCH-TEST-2-1. NC2314.2 +106300 MOVE "SEARCH-TEST-2-1" TO PAR-NAME. NC2314.2 +106400 IF L2-HOLD = SPACE NC2314.2 +106500 PERFORM PASS NC2314.2 +106600 PERFORM PRINT-DETAIL NC2314.2 +106700 ELSE NC2314.2 +106800 MOVE "'WHEN' PHRASE SHOULD BE FALSE" TO RE-MARK NC2314.2 +106900 MOVE SPACE TO CORRECT-X NC2314.2 +107000 MOVE L2-HOLD TO COMPUTED-X NC2314.2 +107100 PERFORM FAIL NC2314.2 +107200 PERFORM PRINT-DETAIL. NC2314.2 +107300 ADD 1 TO REC-CT. NC2314.2 +107400 SEARCH-TEST-2-2. NC2314.2 +107500 MOVE "SEARCH-TEST-2-2" TO PAR-NAME. NC2314.2 +107600 IF L3-HOLD = SPACE NC2314.2 +107700 PERFORM PASS NC2314.2 +107800 PERFORM PRINT-DETAIL NC2314.2 +107900 ELSE NC2314.2 +108000 MOVE "'WHEN' PHRASE SHOULD BE FALSE" TO RE-MARK NC2314.2 +108100 MOVE SPACE TO CORRECT-X NC2314.2 +108200 MOVE L3-HOLD TO COMPUTED-X NC2314.2 +108300 PERFORM FAIL NC2314.2 +108400 PERFORM PRINT-DETAIL. NC2314.2 +108500 ADD 1 TO REC-CT. NC2314.2 +108600 SEARCH-TEST-2-3. NC2314.2 +108700 MOVE "SEARCH-TEST-2-3" TO PAR-NAME. NC2314.2 +108800 IF L4-HOLD = "CC" NC2314.2 +108900 PERFORM PASS NC2314.2 +109000 PERFORM PRINT-DETAIL NC2314.2 +109100 ELSE NC2314.2 +109200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2314.2 +109300 MOVE "CC" TO CORRECT-X NC2314.2 +109400 MOVE L4-HOLD TO COMPUTED-X NC2314.2 +109500 PERFORM FAIL NC2314.2 +109600 PERFORM PRINT-DETAIL. NC2314.2 +109700 NC2314.2 +109800 GO TO END-SEARCH-TEST. NC2314.2 +109900 NC2314.2 +110000 PASS-TH. NC2314.2 +110100 PERFORM PASS. NC2314.2 +110200 PERFORM PRINT-DETAIL. NC2314.2 +110300 FAIL-TH. NC2314.2 +110400 PERFORM FAIL. NC2314.2 +110500 PERFORM PRINT-DETAIL. NC2314.2 +110600 END-SEARCH-TEST. NC2314.2 +110700 EXIT. NC2314.2 +110800 CCVS-EXIT SECTION. NC2314.2 +110900 CCVS-999999. NC2314.2 +111000 GO TO CLOSE-FILES. NC2314.2 +*END-OF,NC231A +*HEADER,COBOL,NC232A +000100 IDENTIFICATION DIVISION. NC2324.2 +000200 PROGRAM-ID. NC2324.2 +000300 NC232A. NC2324.2 +000400**************************************************************** NC2324.2 +000500* * NC2324.2 +000600* VALIDATION FOR:- * NC2324.2 +000700* * NC2324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +000900* * NC2324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2324.2 +001100* * NC2324.2 +001200**************************************************************** NC2324.2 +001300* * NC2324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2324.2 +001500* * NC2324.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2324.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2324.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2324.2 +001900* * NC2324.2 +002000**************************************************************** NC2324.2 +002100 NC2324.2 +002200* NC2324.2 +002300* PROGRAM NC232A USES FORMAT 1 OF THE "SEARCH" STATEMENT TO * NC2324.2 +002400* ACCESS A THREE DIMENSIONAL TABLE. THE OPTIONAL "VARYING" * NC2324.2 +002500* PHRASE IS USED WITH AN INDEX-NAME. * NC2324.2 +002600* * NC2324.2 +002700**************************************************************** NC2324.2 +002800 ENVIRONMENT DIVISION. NC2324.2 +002900 CONFIGURATION SECTION. NC2324.2 +003000 SOURCE-COMPUTER. NC2324.2 +003100 XXXXX082. NC2324.2 +003200 OBJECT-COMPUTER. NC2324.2 +003300 XXXXX083. NC2324.2 +003400 INPUT-OUTPUT SECTION. NC2324.2 +003500 FILE-CONTROL. NC2324.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2324.2 +003700 XXXXX055. NC2324.2 +003800 DATA DIVISION. NC2324.2 +003900 FILE SECTION. NC2324.2 +004000 FD PRINT-FILE. NC2324.2 +004100 01 PRINT-REC PICTURE X(120). NC2324.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2324.2 +004300 WORKING-STORAGE SECTION. NC2324.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2324.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2324.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2324.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2324.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2324.2 +004900 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2324.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2324.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2324.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2324.2 +005300 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2324.2 +005400 01 GRP-NAME. NC2324.2 +005500 02 FILLER PICTURE XXX VALUE "GRP". NC2324.2 +005600 02 ADD-GRP PICTURE 99 VALUE 01. NC2324.2 +005700 NC2324.2 +005800 01 SEC-NAME. NC2324.2 +005900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2324.2 +006000 02 SEC-GRP PICTURE 99 VALUE 00. NC2324.2 +006100 02 FILLER PICTURE X VALUE ",". NC2324.2 +006200 02 ADD-SEC PICTURE 99 VALUE 01. NC2324.2 +006300 02 FILLER PICTURE X VALUE ")". NC2324.2 +006400 NC2324.2 +006500 01 ELEM-NAME. NC2324.2 +006600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2324.2 +006700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2324.2 +006800 02 FILLER PICTURE X VALUE ",". NC2324.2 +006900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2324.2 +007000 02 FILLER PICTURE X VALUE ",". NC2324.2 +007100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2324.2 +007200 02 FILLER PICTURE X VALUE ")". NC2324.2 +007300 NC2324.2 +007400 01 3-DIMENSION-TBL. NC2324.2 +007500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2324.2 +007600 03 ENTRY-1 PICTURE X(5). NC2324.2 +007700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2324.2 +007800 04 ENTRY-2 PICTURE X(11). NC2324.2 +007900 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2324.2 +008000 05 ENTRY-3 PICTURE X(15). NC2324.2 +008100 NC2324.2 +008200 01 END-STMT. NC2324.2 +008300 02 FILLER PICTURE X(7) VALUE "AT END ". NC2324.2 +008400 02 END-IDX PICTURE X(5) VALUE SPACES. NC2324.2 +008500 02 FILLER PICTURE XXX VALUE " = ". NC2324.2 +008600 02 IDX-VALU PICTURE 99 VALUE 00. NC2324.2 +008700 02 FILLER PICTURE XXX VALUE SPACES. NC2324.2 +008800 01 NOTE-1. NC2324.2 +008900 02 FILLER PICTURE X(74) VALUE NC2324.2 +009000 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2324.2 +009100- "PATH WAS TAKEN". NC2324.2 +009200 02 FILLER PICTURE X(46) VALUE SPACES. NC2324.2 +009300 01 NOTE-2. NC2324.2 +009400 02 FILLER PICTURE X(112) VALUE NC2324.2 +009500 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2324.2 +009600- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2324.2 +009700 02 FILLER PICTURE X(8) VALUE SPACES. NC2324.2 +009800 01 TEST-RESULTS. NC2324.2 +009900 02 FILLER PIC X VALUE SPACE. NC2324.2 +010000 02 FEATURE PIC X(20) VALUE SPACE. NC2324.2 +010100 02 FILLER PIC X VALUE SPACE. NC2324.2 +010200 02 P-OR-F PIC X(5) VALUE SPACE. NC2324.2 +010300 02 FILLER PIC X VALUE SPACE. NC2324.2 +010400 02 PAR-NAME. NC2324.2 +010500 03 FILLER PIC X(19) VALUE SPACE. NC2324.2 +010600 03 PARDOT-X PIC X VALUE SPACE. NC2324.2 +010700 03 DOTVALUE PIC 99 VALUE ZERO. NC2324.2 +010800 02 FILLER PIC X(8) VALUE SPACE. NC2324.2 +010900 02 RE-MARK PIC X(61). NC2324.2 +011000 01 TEST-COMPUTED. NC2324.2 +011100 02 FILLER PIC X(30) VALUE SPACE. NC2324.2 +011200 02 FILLER PIC X(17) VALUE NC2324.2 +011300 " COMPUTED=". NC2324.2 +011400 02 COMPUTED-X. NC2324.2 +011500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2324.2 +011600 03 COMPUTED-N REDEFINES COMPUTED-A NC2324.2 +011700 PIC -9(9).9(9). NC2324.2 +011800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2324.2 +011900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2324.2 +012000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2324.2 +012100 03 CM-18V0 REDEFINES COMPUTED-A. NC2324.2 +012200 04 COMPUTED-18V0 PIC -9(18). NC2324.2 +012300 04 FILLER PIC X. NC2324.2 +012400 03 FILLER PIC X(50) VALUE SPACE. NC2324.2 +012500 01 TEST-CORRECT. NC2324.2 +012600 02 FILLER PIC X(30) VALUE SPACE. NC2324.2 +012700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2324.2 +012800 02 CORRECT-X. NC2324.2 +012900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2324.2 +013000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2324.2 +013100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2324.2 +013200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2324.2 +013300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2324.2 +013400 03 CR-18V0 REDEFINES CORRECT-A. NC2324.2 +013500 04 CORRECT-18V0 PIC -9(18). NC2324.2 +013600 04 FILLER PIC X. NC2324.2 +013700 03 FILLER PIC X(2) VALUE SPACE. NC2324.2 +013800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2324.2 +013900 01 CCVS-C-1. NC2324.2 +014000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2324.2 +014100- "SS PARAGRAPH-NAME NC2324.2 +014200- " REMARKS". NC2324.2 +014300 02 FILLER PIC X(20) VALUE SPACE. NC2324.2 +014400 01 CCVS-C-2. NC2324.2 +014500 02 FILLER PIC X VALUE SPACE. NC2324.2 +014600 02 FILLER PIC X(6) VALUE "TESTED". NC2324.2 +014700 02 FILLER PIC X(15) VALUE SPACE. NC2324.2 +014800 02 FILLER PIC X(4) VALUE "FAIL". NC2324.2 +014900 02 FILLER PIC X(94) VALUE SPACE. NC2324.2 +015000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2324.2 +015100 01 REC-CT PIC 99 VALUE ZERO. NC2324.2 +015200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2324.2 +015700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2324.2 +015800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2324.2 +015900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2324.2 +016000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2324.2 +016100 01 CCVS-H-1. NC2324.2 +016200 02 FILLER PIC X(39) VALUE SPACES. NC2324.2 +016300 02 FILLER PIC X(42) VALUE NC2324.2 +016400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2324.2 +016500 02 FILLER PIC X(39) VALUE SPACES. NC2324.2 +016600 01 CCVS-H-2A. NC2324.2 +016700 02 FILLER PIC X(40) VALUE SPACE. NC2324.2 +016800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2324.2 +016900 02 FILLER PIC XXXX VALUE NC2324.2 +017000 "4.2 ". NC2324.2 +017100 02 FILLER PIC X(28) VALUE NC2324.2 +017200 " COPY - NOT FOR DISTRIBUTION". NC2324.2 +017300 02 FILLER PIC X(41) VALUE SPACE. NC2324.2 +017400 NC2324.2 +017500 01 CCVS-H-2B. NC2324.2 +017600 02 FILLER PIC X(15) VALUE NC2324.2 +017700 "TEST RESULT OF ". NC2324.2 +017800 02 TEST-ID PIC X(9). NC2324.2 +017900 02 FILLER PIC X(4) VALUE NC2324.2 +018000 " IN ". NC2324.2 +018100 02 FILLER PIC X(12) VALUE NC2324.2 +018200 " HIGH ". NC2324.2 +018300 02 FILLER PIC X(22) VALUE NC2324.2 +018400 " LEVEL VALIDATION FOR ". NC2324.2 +018500 02 FILLER PIC X(58) VALUE NC2324.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +018700 01 CCVS-H-3. NC2324.2 +018800 02 FILLER PIC X(34) VALUE NC2324.2 +018900 " FOR OFFICIAL USE ONLY ". NC2324.2 +019000 02 FILLER PIC X(58) VALUE NC2324.2 +019100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2324.2 +019200 02 FILLER PIC X(28) VALUE NC2324.2 +019300 " COPYRIGHT 1985 ". NC2324.2 +019400 01 CCVS-E-1. NC2324.2 +019500 02 FILLER PIC X(52) VALUE SPACE. NC2324.2 +019600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2324.2 +019700 02 ID-AGAIN PIC X(9). NC2324.2 +019800 02 FILLER PIC X(45) VALUE SPACES. NC2324.2 +019900 01 CCVS-E-2. NC2324.2 +020000 02 FILLER PIC X(31) VALUE SPACE. NC2324.2 +020100 02 FILLER PIC X(21) VALUE SPACE. NC2324.2 +020200 02 CCVS-E-2-2. NC2324.2 +020300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2324.2 +020400 03 FILLER PIC X VALUE SPACE. NC2324.2 +020500 03 ENDER-DESC PIC X(44) VALUE NC2324.2 +020600 "ERRORS ENCOUNTERED". NC2324.2 +020700 01 CCVS-E-3. NC2324.2 +020800 02 FILLER PIC X(22) VALUE NC2324.2 +020900 " FOR OFFICIAL USE ONLY". NC2324.2 +021000 02 FILLER PIC X(12) VALUE SPACE. NC2324.2 +021100 02 FILLER PIC X(58) VALUE NC2324.2 +021200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +021300 02 FILLER PIC X(13) VALUE SPACE. NC2324.2 +021400 02 FILLER PIC X(15) VALUE NC2324.2 +021500 " COPYRIGHT 1985". NC2324.2 +021600 01 CCVS-E-4. NC2324.2 +021700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2324.2 +021800 02 FILLER PIC X(4) VALUE " OF ". NC2324.2 +021900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2324.2 +022000 02 FILLER PIC X(40) VALUE NC2324.2 +022100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2324.2 +022200 01 XXINFO. NC2324.2 +022300 02 FILLER PIC X(19) VALUE NC2324.2 +022400 "*** INFORMATION ***". NC2324.2 +022500 02 INFO-TEXT. NC2324.2 +022600 04 FILLER PIC X(8) VALUE SPACE. NC2324.2 +022700 04 XXCOMPUTED PIC X(20). NC2324.2 +022800 04 FILLER PIC X(5) VALUE SPACE. NC2324.2 +022900 04 XXCORRECT PIC X(20). NC2324.2 +023000 02 INF-ANSI-REFERENCE PIC X(48). NC2324.2 +023100 01 HYPHEN-LINE. NC2324.2 +023200 02 FILLER PIC IS X VALUE IS SPACE. NC2324.2 +023300 02 FILLER PIC IS X(65) VALUE IS "************************NC2324.2 +023400- "*****************************************". NC2324.2 +023500 02 FILLER PIC IS X(54) VALUE IS "************************NC2324.2 +023600- "******************************". NC2324.2 +023700 01 CCVS-PGM-ID PIC X(9) VALUE NC2324.2 +023800 "NC232A". NC2324.2 +023900 PROCEDURE DIVISION. NC2324.2 +024000 CCVS1 SECTION. NC2324.2 +024100 OPEN-FILES. NC2324.2 +024200 OPEN OUTPUT PRINT-FILE. NC2324.2 +024300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2324.2 +024400 MOVE SPACE TO TEST-RESULTS. NC2324.2 +024500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2324.2 +024600 GO TO CCVS1-EXIT. NC2324.2 +024700 CLOSE-FILES. NC2324.2 +024800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2324.2 +024900 TERMINATE-CCVS. NC2324.2 +025000S EXIT PROGRAM. NC2324.2 +025100STERMINATE-CALL. NC2324.2 +025200 STOP RUN. NC2324.2 +025300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2324.2 +025400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2324.2 +025500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2324.2 +025600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2324.2 +025700 MOVE "****TEST DELETED****" TO RE-MARK. NC2324.2 +025800 PRINT-DETAIL. NC2324.2 +025900 IF REC-CT NOT EQUAL TO ZERO NC2324.2 +026000 MOVE "." TO PARDOT-X NC2324.2 +026100 MOVE REC-CT TO DOTVALUE. NC2324.2 +026200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2324.2 +026300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2324.2 +026400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2324.2 +026500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2324.2 +026600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2324.2 +026700 MOVE SPACE TO CORRECT-X. NC2324.2 +026800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2324.2 +026900 MOVE SPACE TO RE-MARK. NC2324.2 +027000 HEAD-ROUTINE. NC2324.2 +027100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2324.2 +027400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2324.2 +027500 COLUMN-NAMES-ROUTINE. NC2324.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +027900 END-ROUTINE. NC2324.2 +028000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2324.2 +028100 END-RTN-EXIT. NC2324.2 +028200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +028300 END-ROUTINE-1. NC2324.2 +028400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2324.2 +028500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2324.2 +028600 ADD PASS-COUNTER TO ERROR-HOLD. NC2324.2 +028700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2324.2 +028800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2324.2 +028900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2324.2 +029000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2324.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2324.2 +029200 END-ROUTINE-12. NC2324.2 +029300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2324.2 +029400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2324.2 +029500 MOVE "NO " TO ERROR-TOTAL NC2324.2 +029600 ELSE NC2324.2 +029700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2324.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2324.2 +029900 PERFORM WRITE-LINE. NC2324.2 +030000 END-ROUTINE-13. NC2324.2 +030100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2324.2 +030200 MOVE "NO " TO ERROR-TOTAL ELSE NC2324.2 +030300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2324.2 +030400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2324.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +030600 IF INSPECT-COUNTER EQUAL TO ZERO NC2324.2 +030700 MOVE "NO " TO ERROR-TOTAL NC2324.2 +030800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2324.2 +030900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2324.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +031100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +031200 WRITE-LINE. NC2324.2 +031300 ADD 1 TO RECORD-COUNT. NC2324.2 +031400Y IF RECORD-COUNT GREATER 50 NC2324.2 +031500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2324.2 +031600Y MOVE SPACE TO DUMMY-RECORD NC2324.2 +031700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2324.2 +031800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2324.2 +031900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2324.2 +032000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2324.2 +032100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2324.2 +032200Y MOVE ZERO TO RECORD-COUNT. NC2324.2 +032300 PERFORM WRT-LN. NC2324.2 +032400 WRT-LN. NC2324.2 +032500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2324.2 +032600 MOVE SPACE TO DUMMY-RECORD. NC2324.2 +032700 BLANK-LINE-PRINT. NC2324.2 +032800 PERFORM WRT-LN. NC2324.2 +032900 FAIL-ROUTINE. NC2324.2 +033000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2324.2 +033100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2324.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2324.2 +033300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2324.2 +033400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +033500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2324.2 +033600 GO TO FAIL-ROUTINE-EX. NC2324.2 +033700 FAIL-ROUTINE-WRITE. NC2324.2 +033800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2324.2 +033900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2324.2 +034000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2324.2 +034100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2324.2 +034200 FAIL-ROUTINE-EX. EXIT. NC2324.2 +034300 BAIL-OUT. NC2324.2 +034400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2324.2 +034500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2324.2 +034600 BAIL-OUT-WRITE. NC2324.2 +034700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2324.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2324.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2324.2 +035100 BAIL-OUT-EX. EXIT. NC2324.2 +035200 CCVS1-EXIT. NC2324.2 +035300 EXIT. NC2324.2 +035400 SECT-NC232A-001 SECTION. NC2324.2 +035500 TH-03-001. NC2324.2 +035600* NC2324.2 +035700 BUILD-LEVEL-1. NC2324.2 +035800 ADD 1 TO SUB-1. NC2324.2 +035900 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2324.2 +036000 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2324.2 +036100 ADD 1 TO ADD-GRP. NC2324.2 +036200 NC2324.2 +036300 BUILD-LEVEL-2. NC2324.2 +036400 ADD 1 TO SUB-2. NC2324.2 +036500 IF SUB-2 = 11 NC2324.2 +036600 MOVE ZERO TO SUB-2 NC2324.2 +036700 MOVE 01 TO ADD-SEC NC2324.2 +036800 GO TO BUILD-LEVEL-1. NC2324.2 +036900 MOVE SUB-1 TO SEC-GRP. NC2324.2 +037000 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2324.2 +037100 ADD 1 TO ADD-SEC. NC2324.2 +037200 NC2324.2 +037300 BUILD-LEVEL-3. NC2324.2 +037400 ADD 1 TO SUB-3. NC2324.2 +037500 IF SUB-3 = 11 NC2324.2 +037600 MOVE ZERO TO SUB-3 NC2324.2 +037700 MOVE 01 TO ADD-ELEM NC2324.2 +037800 GO TO BUILD-LEVEL-2. NC2324.2 +037900 MOVE SUB-1 TO ELEM-GRP. NC2324.2 +038000 MOVE SUB-2 TO ELEM-SEC. NC2324.2 +038100 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2324.2 +038200 ADD 1 TO ADD-ELEM. NC2324.2 +038300 GO TO BUILD-LEVEL-3. NC2324.2 +038400 NC2324.2 +038500 CHECK-ENTRIES. NC2324.2 +038600 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2324.2 +038700 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2324.2 +038800 MOVE "GRP02" TO GRP-HOLD-AREA. NC2324.2 +038900 MOVE 02 TO SUB-2. NC2324.2 +039000 SET IDX-1 TO 1. NC2324.2 +039100 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +039200 PERFORM GRP-FAIL-PARGRAPH NC2324.2 +039300 GO TO TH1-TEST-F1-2 NC2324.2 +039400 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +039500 PERFORM PASS NC2324.2 +039600 PERFORM PRINT-DETAIL. NC2324.2 +039700 GO TO TH1-TEST-F1-2. NC2324.2 +039800 NC2324.2 +039900 GRP-FAIL-PARGRAPH. NC2324.2 +040000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +040100 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2324.2 +040200 MOVE "IDX-1" TO END-IDX NC2324.2 +040300 SET IDX-VALU TO IDX-1 NC2324.2 +040400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +040500 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +040600 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2324.2 +040700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +040800 NC2324.2 +040900 PERFORM FAIL NC2324.2 +041000 PERFORM PRINT-DETAIL. NC2324.2 +041100* NC2324.2 +041200 TH1-INIT-F1-2. NC2324.2 +041300 MOVE "TH1-TEST-F1-2 " TO PAR-NAME. NC2324.2 +041400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +041500 MOVE "GRP01" TO GRP-HOLD-AREA. NC2324.2 +041600 MOVE 01 TO SUB-2. NC2324.2 +041700 SET IDX-1 TO 1. NC2324.2 +041800 TH1-TEST-F1-2. NC2324.2 +041900 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +042000 GO TO TH1-FAIL-F1-2 NC2324.2 +042100 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +042200 NC2324.2 +042300 PERFORM PASS NC2324.2 +042400 GO TO TH1-WRITE-F1-2. NC2324.2 +042500 TH1-DELETE-F1-2. NC2324.2 +042600 PERFORM DE-LETE. NC2324.2 +042700 GO TO TH1-WRITE-F1-2. NC2324.2 +042800 TH1-FAIL-F1-2. NC2324.2 +042900 PERFORM FAIL. NC2324.2 +043000 TH1-WRITE-F1-2. NC2324.2 +043100 PERFORM PRINT-DETAIL. NC2324.2 +043200* NC2324.2 +043300 TH1-INIT-F1-3. NC2324.2 +043400 MOVE "TH1-TEST-F1-3 " TO PAR-NAME. NC2324.2 +043500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +043600 MOVE "GRP10" TO GRP-HOLD-AREA. NC2324.2 +043700 MOVE 10 TO SUB-2. NC2324.2 +043800 SET IDX-1 TO 1. NC2324.2 +043900 TH1-TEST-F1-3. NC2324.2 +044000 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +044100 GO TO TH1-FAIL-F1-3 NC2324.2 +044200 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +044300 NC2324.2 +044400 PERFORM PASS NC2324.2 +044500 GO TO TH1-WRITE-F1-3. NC2324.2 +044600 TH1-DELETE-F1-3. NC2324.2 +044700 PERFORM DE-LETE. NC2324.2 +044800 GO TO TH1-WRITE-F1-3. NC2324.2 +044900 TH1-FAIL-F1-3. NC2324.2 +045000 PERFORM FAIL. NC2324.2 +045100 TH1-WRITE-F1-3. NC2324.2 +045200 PERFORM PRINT-DETAIL. NC2324.2 +045300* NC2324.2 +045400 TH1-INIT-F1-4. NC2324.2 +045500 MOVE "TH1-TEST-F1-4 " TO PAR-NAME. NC2324.2 +045600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +045700 MOVE "GRP05" TO GRP-HOLD-AREA. NC2324.2 +045800 MOVE 05 TO SUB-2. NC2324.2 +045900 SET IDX-1 TO 05. NC2324.2 +046000 TH1-TEST-F1-4. NC2324.2 +046100 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +046200 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2324.2 +046300 GO TO PASS-TH1-F1-4. NC2324.2 +046400 GO TO TH1-FAIL-F1-4. NC2324.2 +046500 PASS-TH1-F1-4. NC2324.2 +046600 NC2324.2 +046700 PERFORM PASS NC2324.2 +046800 GO TO TH1-WRITE-F1-4. NC2324.2 +046900 TH1-DELETE-F1-4. NC2324.2 +047000 PERFORM DE-LETE. NC2324.2 +047100 GO TO TH1-WRITE-F1-4. NC2324.2 +047200 TH1-FAIL-F1-4. NC2324.2 +047300 PERFORM GRP-FAIL-PARGRAPH. NC2324.2 +047400 TH1-WRITE-F1-4. NC2324.2 +047500 PERFORM PRINT-DETAIL. NC2324.2 +047600* NC2324.2 +047700 TH2-INIT-F1-1. NC2324.2 +047800 MOVE "TH2-TEST-F1-1 " TO PAR-NAME. NC2324.2 +047900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +048000 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +048100 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2324.2 +048200 MOVE 1 TO SUB-1 SUB-2. NC2324.2 +048300 SET IDX-1 IDX-2 TO 1. NC2324.2 +048400 TH2-TEST-F1-1. NC2324.2 +048500 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +048600 GO TO TH2-FAIL-F1-1 NC2324.2 +048700 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +048800 NEXT SENTENCE. NC2324.2 +048900 NC2324.2 +049000 PERFORM PASS. NC2324.2 +049100 GO TO TH2-WRITE-F1-1. NC2324.2 +049200 TH2-DELETE-F1-1. NC2324.2 +049300 PERFORM DE-LETE. NC2324.2 +049400 GO TO TH2-WRITE-F1-1. NC2324.2 +049500 TH2-FAIL-F1-1. NC2324.2 +049600 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +049700 TH2-WRITE-F1-1. NC2324.2 +049800 PERFORM PRINT-DETAIL. NC2324.2 +049900 NC2324.2 +050000 TH2-INIT-F1-2. NC2324.2 +050100 MOVE "TH2-TEST-F1-2 " TO PAR-NAME. NC2324.2 +050200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +050300 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +050400 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2324.2 +050500 MOVE 05 TO SUB-1. NC2324.2 +050600 MOVE 10 TO SUB-2. NC2324.2 +050700 SET IDX-1 TO 5. NC2324.2 +050800 SET IDX-2 TO 1. NC2324.2 +050900 TH2-TEST-F1-2. NC2324.2 +051000 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +051100 GO TO TH2-FAIL-F1-2 NC2324.2 +051200 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +051300 NEXT SENTENCE. NC2324.2 +051400 NC2324.2 +051500 PERFORM PASS NC2324.2 +051600 GO TO TH2-WRITE-F1-2. NC2324.2 +051700 TH2-DELETE-F1-2. NC2324.2 +051800 PERFORM DE-LETE. NC2324.2 +051900 GO TO TH2-WRITE-F1-2. NC2324.2 +052000 TH2-FAIL-F1-2. NC2324.2 +052100 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +052200 TH2-WRITE-F1-2. NC2324.2 +052300 PERFORM PRINT-DETAIL. NC2324.2 +052400* NC2324.2 +052500 TH2-INIT-F1-3. NC2324.2 +052600 MOVE "TH2-TEST-F1-3 " TO PAR-NAME. NC2324.2 +052700 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +052800 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +052900 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2324.2 +053000 SET IDX-1 TO 10. NC2324.2 +053100 SET IDX-2 TO 1. NC2324.2 +053200 MOVE 10 TO SUB-1 SUB-2. NC2324.2 +053300 TH2-TEST-F1-3. NC2324.2 +053400 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +053500 GO TO TH2-FAIL-F1-3 NC2324.2 +053600 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +053700 NEXT SENTENCE. NC2324.2 +053800 NC2324.2 +053900 PERFORM PASS NC2324.2 +054000 GO TO TH2-WRITE-F1-3. NC2324.2 +054100 TH2-DELETE-F1-3. NC2324.2 +054200 PERFORM DE-LETE. NC2324.2 +054300 GO TO TH2-WRITE-F1-3. NC2324.2 +054400 TH2-FAIL-F1-3. NC2324.2 +054500 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +054600 TH2-WRITE-F1-3. NC2324.2 +054700 PERFORM PRINT-DETAIL. NC2324.2 +054800* NC2324.2 +054900 TH2-INIT-F1-4. NC2324.2 +055000 MOVE "TH2-TEST-F1-4 " TO PAR-NAME. NC2324.2 +055100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +055200 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +055300 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2324.2 +055400 MOVE 08 TO SUB-1. NC2324.2 +055500 MOVE 02 TO SUB-2. NC2324.2 +055600 SET IDX-1 TO 08. NC2324.2 +055700 SET IDX-2 TO 01. NC2324.2 +055800 TH2-TEST-F1-4. NC2324.2 +055900 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +056000 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +056100 PERFORM PASS NC2324.2 +056200 GO TO TH2-WRITE-F1-4. NC2324.2 +056300 GO TO TH2-FAIL-F1-4. NC2324.2 +056400 TH2-DELETE-F1-4. NC2324.2 +056500 PERFORM DE-LETE. NC2324.2 +056600 GO TO TH2-WRITE-F1-4. NC2324.2 +056700 TH2-FAIL-F1-4. NC2324.2 +056800 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +056900 TH2-WRITE-F1-4. NC2324.2 +057000 PERFORM PRINT-DETAIL. NC2324.2 +057100 GO TO TH3-INIT-F1-1. NC2324.2 +057200* NC2324.2 +057300 SEC-FAIL-PARGRAF. NC2324.2 +057400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +057500 IF ENTRY-2 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2324.2 +057600 MOVE "IDX-2" TO END-IDX NC2324.2 +057700 SET IDX-VALU TO IDX-2 NC2324.2 +057800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +057900 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +058000 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2324.2 +058100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +058200 NC2324.2 +058300 PERFORM FAIL. NC2324.2 +058400 NC2324.2 +058500 TH3-INIT-F1-1. NC2324.2 +058600 MOVE "TH3-TEST-F1-1 " TO PAR-NAME. NC2324.2 +058700 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +058800 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +058900 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2324.2 +059000 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2324.2 +059100 SET IDX-1 IDX-2 IDX-3 TO 1. NC2324.2 +059200 TH3-TEST-F1-1. NC2324.2 +059300 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +059400 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +059500 GO TO PASS-TH3-1. NC2324.2 +059600 GO TO TH3-FAIL-F1-1. NC2324.2 +059700 PASS-TH3-1. NC2324.2 +059800 NC2324.2 +059900 PERFORM PASS. NC2324.2 +060000 GO TO TH3-WRITE-F1-1. NC2324.2 +060100 TH3-DELETE-F1-1. NC2324.2 +060200 PERFORM DE-LETE. NC2324.2 +060300 GO TO TH3-WRITE-F1-1. NC2324.2 +060400 TH3-FAIL-F1-1. NC2324.2 +060500 PERFORM ELEM-FAIL-PARA. NC2324.2 +060600 TH3-WRITE-F1-1. NC2324.2 +060700 PERFORM PRINT-DETAIL. NC2324.2 +060800* NC2324.2 +060900 TH3-INIT-F1-2. NC2324.2 +061000 MOVE "TH3-TEST-F1-2 " TO PAR-NAME. NC2324.2 +061100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +061200 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +061300 MOVE 05 TO SUB-1. NC2324.2 +061400 MOVE 06 TO SUB-2. NC2324.2 +061500 MOVE 07 TO SUB-3. NC2324.2 +061600 SET IDX-1 TO 05. NC2324.2 +061700 SET IDX-2 TO 06. NC2324.2 +061800 SET IDX-3 TO 1. NC2324.2 +061900 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2324.2 +062000 TH3-TEST-F1-2. NC2324.2 +062100 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +062200 GO TO TH3-FAIL-F1-2 NC2324.2 +062300 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +062400 NEXT SENTENCE. NC2324.2 +062500 NC2324.2 +062600 PERFORM PASS NC2324.2 +062700 GO TO TH3-WRITE-F1-2. NC2324.2 +062800 TH3-DELETE-F1-2. NC2324.2 +062900 PERFORM DE-LETE. NC2324.2 +063000 GO TO TH3-WRITE-F1-2. NC2324.2 +063100 TH3-FAIL-F1-2. NC2324.2 +063200 PERFORM ELEM-FAIL-PARA. NC2324.2 +063300 TH3-WRITE-F1-2. NC2324.2 +063400 PERFORM PRINT-DETAIL. NC2324.2 +063500* NC2324.2 +063600 TH3-INIT-F1-3. NC2324.2 +063700 MOVE "TH3-TEST-F1-3 " TO PAR-NAME. NC2324.2 +063800 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +063900 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +064000 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2324.2 +064100 SET IDX-1 IDX-2 TO 10. NC2324.2 +064200 SET IDX-3 TO 1. NC2324.2 +064300 TH3-TEST-F1-3. NC2324.2 +064400 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2324.2 +064500 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +064600 GO TO TH3-FAIL-F1-3 NC2324.2 +064700 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +064800 NEXT SENTENCE. NC2324.2 +064900 NC2324.2 +065000 PERFORM PASS NC2324.2 +065100 GO TO TH3-WRITE-F1-3. NC2324.2 +065200 TH3-DELETE-F1-3. NC2324.2 +065300 PERFORM DE-LETE. NC2324.2 +065400 GO TO TH3-WRITE-F1-3. NC2324.2 +065500 TH3-FAIL-F1-3. NC2324.2 +065600 PERFORM ELEM-FAIL-PARA. NC2324.2 +065700 TH3-WRITE-F1-3. NC2324.2 +065800 PERFORM PRINT-DETAIL. NC2324.2 +065900* NC2324.2 +066000 TH3-INIT-F1-4. NC2324.2 +066100 MOVE "TH3-TEST-F1-4 " TO PAR-NAME. NC2324.2 +066200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +066300 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +066400 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2324.2 +066500 MOVE 07 TO SUB-1. NC2324.2 +066600 MOVE 06 TO SUB-2. NC2324.2 +066700 MOVE 05 TO SUB-3. NC2324.2 +066800 SET IDX-1 TO 07. NC2324.2 +066900 SET IDX-2 TO 06. NC2324.2 +067000 SET IDX-3 TO 03. NC2324.2 +067100 TH3-TEST-F1-4. NC2324.2 +067200 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +067300 GO TO TH3-TEST-F1-4 NC2324.2 +067400 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +067500 NEXT SENTENCE. NC2324.2 +067600 NC2324.2 +067700 PERFORM PASS NC2324.2 +067800 GO TO TH3-WRITE-F1-4. NC2324.2 +067900 TH3-DELETE-F1-4. NC2324.2 +068000 PERFORM DE-LETE. NC2324.2 +068100 GO TO TH3-WRITE-F1-4. NC2324.2 +068200 TH3-FAIL-F1-4. NC2324.2 +068300 PERFORM ELEM-FAIL-PARA. NC2324.2 +068400 TH3-WRITE-F1-4. NC2324.2 +068500 PERFORM PRINT-DETAIL. NC2324.2 +068600 GO TO SCH-INIT-F1-1. NC2324.2 +068700* NC2324.2 +068800 ELEM-FAIL-PARA. NC2324.2 +068900 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2324.2 +069000 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2324.2 +069100 MOVE "IDX-3" TO END-IDX NC2324.2 +069200 SET IDX-VALU TO IDX-3 NC2324.2 +069300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +069400 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +069500 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2324.2 +069600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +069700 PERFORM FAIL. NC2324.2 +069800* NC2324.2 +069900 SCH-INIT-F1-1. NC2324.2 +070000 MOVE "SCH-TEST-F1-1 " TO PAR-NAME. NC2324.2 +070100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +070200 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2324.2 +070300 MOVE "GRP08" TO GRP-HOLD-AREA. NC2324.2 +070400 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2324.2 +070500 SET IDX-1 IDX-2 TO 1. NC2324.2 +070600 SCH-TEST-F1-1. NC2324.2 +070700 SEARCH GRP-ENTRY VARYING IDX-1 AT END GO TO SCH-FAIL-F1-1-A NC2324.2 +070800 WHEN ENTRY-1 (IDX-1) = "GRP08" NEXT SENTENCE. NC2324.2 +070900 SEARCH GRP2-ENTRY VARYING IDX-2 AT END GO TO SCH-FAIL-F1-1-B NC2324.2 +071000 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +071100 NEXT SENTENCE. NC2324.2 +071200 PERFORM PASS NC2324.2 +071300 GO TO SCH-WRITE-F1-1. NC2324.2 +071400 SCH-DELETE-F1-1. NC2324.2 +071500 PERFORM DE-LETE. NC2324.2 +071600 GO TO SCH-WRITE-F1-1. NC2324.2 +071700 SCH-FAIL-F1-1-A. NC2324.2 +071800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +071900 IF ENTRY-1 (08) EQUAL TO GRP-HOLD-AREA NC2324.2 +072000 MOVE "IDX-1" TO END-IDX NC2324.2 +072100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +072200 SET IDX-VALU TO IDX-1 NC2324.2 +072300 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +072400 MOVE ENTRY-1 (08) TO COMPUTED-A NC2324.2 +072500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +072600 NC2324.2 +072700 PERFORM FAIL NC2324.2 +072800 GO TO SCH-WRITE-F1-1. NC2324.2 +072900 SCH-FAIL-F1-1-B. NC2324.2 +073000 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +073100 IF ENTRY-2 (08, 07) EQUAL TO SEC-HOLD-AREA NC2324.2 +073200 MOVE "IDX-2" TO END-IDX NC2324.2 +073300 SET IDX-VALU TO IDX-2 NC2324.2 +073400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +073500 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +073600 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2324.2 +073700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +073800 NC2324.2 +073900 PERFORM FAIL. NC2324.2 +074000 SCH-WRITE-F1-1. NC2324.2 +074100 PERFORM PRINT-DETAIL. NC2324.2 +074200* NC2324.2 +074300 SCH-INIT-F1-2. NC2324.2 +074400 MOVE "SCH-TEST-F1-2 " TO PAR-NAME. NC2324.2 +074500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +074600 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2324.2 +074700 MOVE "GRP04" TO GRP-HOLD-AREA. NC2324.2 +074800 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2324.2 +074900 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2324.2 +075000 SET IDX-1 IDX-2 IDX-3 TO 1. NC2324.2 +075100 SCH-TEST-F1-2. NC2324.2 +075200 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +075300 AT END NC2324.2 +075400 GO TO SCH-FAIL-F1-2-A NC2324.2 +075500 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2324.2 +075600 NEXT SENTENCE. NC2324.2 +075700* NC2324.2 +075800 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +075900 AT END NC2324.2 +076000 GO TO SCH-FAIL-F1-2-B NC2324.2 +076100 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +076200 NEXT SENTENCE. NC2324.2 +076300* NC2324.2 +076400 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +076500 AT END NC2324.2 +076600 GO TO SCH-FAIL-F1-2-C NC2324.2 +076700 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +076800 NEXT SENTENCE. NC2324.2 +076900 NC2324.2 +077000 PERFORM PASS NC2324.2 +077100 GO TO SCH-WRITE-F1-2. NC2324.2 +077200 SCH-FAIL-F1-2-A. NC2324.2 +077300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +077400 IF ENTRY-1 (04) EQUAL TO GRP-HOLD-AREA NC2324.2 +077500 MOVE "IDX-1" TO END-IDX NC2324.2 +077600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +077700 SET IDX-VALU TO IDX-1 NC2324.2 +077800 MOVE END-STMT TO COMPUTED-A NC2324.2 +077900 ELSE NC2324.2 +078000 MOVE ENTRY-1 (04) TO COMPUTED-A NC2324.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +078200 PERFORM FAIL. NC2324.2 +078300 GO TO SCH-WRITE-F1-2. NC2324.2 +078400 SCH-FAIL-F1-2-B. NC2324.2 +078500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +078600 IF ENTRY-2 (04, 04) EQUAL TO SEC-HOLD-AREA NC2324.2 +078700 MOVE "IDX-2" TO END-IDX NC2324.2 +078800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +078900 SET IDX-VALU TO IDX-2 NC2324.2 +079000 MOVE END-STMT TO COMPUTED-A NC2324.2 +079100 ELSE NC2324.2 +079200 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2324.2 +079300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +079400 PERFORM FAIL NC2324.2 +079500 GO TO SCH-WRITE-F1-2. NC2324.2 +079600 SCH-FAIL-F1-2-C. NC2324.2 +079700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2324.2 +079800 IF ENTRY-3 (04, 04, 04) EQUAL TO ELEM-HOLD-AREA NC2324.2 +079900 MOVE "IDX-3" TO END-IDX NC2324.2 +080000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +080100 SET IDX-VALU TO IDX-3 NC2324.2 +080200 MOVE END-STMT TO COMPUTED-A NC2324.2 +080300 ELSE NC2324.2 +080400 MOVE ENTRY-3 (04, 04, 04) TO COMPUTED-A NC2324.2 +080500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +080600 PERFORM FAIL. NC2324.2 +080700 SCH-WRITE-F1-2. NC2324.2 +080800 PERFORM PRINT-DETAIL. NC2324.2 +080900* NC2324.2 +081000 SPC-INIT-F1-1. NC2324.2 +081100 MOVE "SPC-TEST-F1-1 " TO PAR-NAME. NC2324.2 +081200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +081300 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +081400 SET IDX-1 TO 4. NC2324.2 +081500 SPC-TEST-F1-1. NC2324.2 +081600 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +081700 AT END NC2324.2 +081800 PERFORM PASS NC2324.2 +081900 GO TO SPC-WRITE-F1-1 NC2324.2 +082000 WHEN ENTRY-1 (IDX-1) = "GRP03" NC2324.2 +082100 GO TO SPC-FAIL-F1-1. NC2324.2 +082200 SPC-DELETE-F1-1. NC2324.2 +082300 PERFORM DE-LETE. NC2324.2 +082400 GO TO SPC-WRITE-F1-1. NC2324.2 +082500 SPC-FAIL-F1-1. NC2324.2 +082600 MOVE SPACES TO CORRECT-A. NC2324.2 +082700 MOVE ENTRY-1 (03) TO COMPUTED-A. NC2324.2 +082800 MOVE SPACES TO RE-MARK. NC2324.2 +082900 PERFORM FAIL. NC2324.2 +083000 SPC-WRITE-F1-1. NC2324.2 +083100 PERFORM PRINT-DETAIL. NC2324.2 +083200* NC2324.2 +083300 SPC-INIT-F1-2. NC2324.2 +083400 MOVE "SPC-TEST-F1-2" TO PAR-NAME. NC2324.2 +083500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +083600 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +083700 SET IDX-1 TO 4. NC2324.2 +083800 SET IDX-2 TO 5. NC2324.2 +083900 SPC-TEST-F1-2. NC2324.2 +084000 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +084100 AT END GO TO SPC-FAIL-F1-2-A NC2324.2 +084200 WHEN ENTRY-1 (IDX-1) = "GRP04" NEXT SENTENCE. NC2324.2 +084300 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +084400 AT END PERFORM PASS NC2324.2 +084500 GO TO SPC-WRITE-F1-2 NC2324.2 +084600 WHEN ENTRY-2 (IDX-1, IDX-2) = "SEC (04,04)" NC2324.2 +084700 GO TO SPC-FAIL-F1-2-B. NC2324.2 +084800 SPC-DELETE-F1-2. NC2324.2 +084900 PERFORM DE-LETE. NC2324.2 +085000 GO TO SPC-WRITE-F1-2. NC2324.2 +085100 SPC-FAIL-F1-2-A. NC2324.2 +085200 MOVE "GRP04" TO CORRECT-A. NC2324.2 +085300 IF ENTRY-1 (04) EQUAL TO "GRP04" NC2324.2 +085400 MOVE "IDX-2" TO END-IDX NC2324.2 +085500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +085600 SET IDX-VALU TO IDX-2 NC2324.2 +085700 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +085800 MOVE ENTRY-1 (04) TO COMPUTED-A NC2324.2 +085900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +086000 PERFORM FAIL NC2324.2 +086100 GO TO SPC-WRITE-F1-2. NC2324.2 +086200 SPC-FAIL-F1-2-B. NC2324.2 +086300 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2324.2 +086400 MOVE SPACES TO CORRECT-A. NC2324.2 +086500 PERFORM FAIL. NC2324.2 +086600 SPC-WRITE-F1-2. NC2324.2 +086700 PERFORM PRINT-DETAIL. NC2324.2 +086800* NC2324.2 +086900 SPC-INIT-F1-3. NC2324.2 +087000 MOVE "SPC-TEST-F1-3" TO PAR-NAME. NC2324.2 +087100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +087200 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +087300 SET IDX-1 TO 02. NC2324.2 +087400 SPC-TEST-F1-3. NC2324.2 +087500 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +087600 AT END NC2324.2 +087700 GO TO SPC-FAIL-F1-3-A NC2324.2 +087800 WHEN ENTRY-1 (IDX-1) EQUAL TO "GRP02" NC2324.2 +087900 NEXT SENTENCE. NC2324.2 +088000 SET IDX-2 TO 01. NC2324.2 +088100 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +088200 AT END NC2324.2 +088300 GO TO SPC-FAIL-F1-3-B NC2324.2 +088400 WHEN ENTRY-2 (IDX-1, IDX-2) = "SEC (02,03)" NC2324.2 +088500 NEXT SENTENCE. NC2324.2 +088600 SET IDX-3 TO 05. NC2324.2 +088700 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +088800 AT END PERFORM PASS NC2324.2 +088900 GO TO SPC-WRITE-F1-3 NC2324.2 +089000 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = "ELEM (02,03,04)" NC2324.2 +089100 GO TO SPC-FAIL-F1-3-C. NC2324.2 +089200 SPC-FAIL-F1-3-A. NC2324.2 +089300 MOVE "GRP02" TO CORRECT-A. NC2324.2 +089400 IF ENTRY-1 (02) EQUAL TO "GRP02" NC2324.2 +089500 MOVE "IDX-1" TO END-IDX NC2324.2 +089600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +089700 SET IDX-VALU TO IDX-1 NC2324.2 +089800 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +089900 MOVE ENTRY-1 (02) TO COMPUTED-A NC2324.2 +090000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +090100 PERFORM FAIL NC2324.2 +090200 GO TO SPC-WRITE-F1-3. NC2324.2 +090300 SPC-FAIL-F1-3-B. NC2324.2 +090400 MOVE "SEC (02,03)" TO CORRECT-A. NC2324.2 +090500 IF ENTRY-2 (02, 03) EQUAL TO "SEC (02,03)" NC2324.2 +090600 MOVE "IDX-2" TO END-IDX NC2324.2 +090700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +090800 SET IDX-VALU TO IDX-2 NC2324.2 +090900 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +091000 MOVE ENTRY-2 (02, 03) TO COMPUTED-A NC2324.2 +091100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +091200 PERFORM FAIL NC2324.2 +091300 GO TO SPC-WRITE-F1-3. NC2324.2 +091400 SPC-FAIL-F1-3-C. NC2324.2 +091500 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2324.2 +091600 MOVE SPACES TO CORRECT-A NC2324.2 +091700 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2324.2 +091800 PERFORM FAIL. NC2324.2 +091900 SPC-WRITE-F1-3. NC2324.2 +092000 PERFORM PRINT-DETAIL. NC2324.2 +092100 CCVS-EXIT SECTION. NC2324.2 +092200 CCVS-999999. NC2324.2 +092300 GO TO CLOSE-FILES. NC2324.2 +*END-OF,NC232A +*HEADER,COBOL,NC233A +000100 IDENTIFICATION DIVISION. NC2334.2 +000200 PROGRAM-ID. NC2334.2 +000300 NC233A. NC2334.2 +000400**************************************************************** NC2334.2 +000500* * NC2334.2 +000600* VALIDATION FOR:- * NC2334.2 +000700* * NC2334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +000900* * NC2334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2334.2 +001100* * NC2334.2 +001200**************************************************************** NC2334.2 +001300* * NC2334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2334.2 +001500* * NC2334.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2334.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2334.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2334.2 +001900* * NC2334.2 +002000**************************************************************** NC2334.2 +002100 NC2334.2 +002200* * NC2334.2 +002300* PROGRAM NC233A USES FORMAT 2 OF THE "SEARCH" STATEMENT * NC2334.2 +002400* TO ACCESS THRE AND SEVEN-DIMENSIONAL TABLES. * NC2334.2 +002500* THE SCOPE TERMINATOR "END-SEARCH" IS ALSO TESTED. * NC2334.2 +002600* * NC2334.2 +002700**************************************************************** NC2334.2 +002800 ENVIRONMENT DIVISION. NC2334.2 +002900 CONFIGURATION SECTION. NC2334.2 +003000 SOURCE-COMPUTER. NC2334.2 +003100 XXXXX082. NC2334.2 +003200 OBJECT-COMPUTER. NC2334.2 +003300 XXXXX083. NC2334.2 +003400 INPUT-OUTPUT SECTION. NC2334.2 +003500 FILE-CONTROL. NC2334.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2334.2 +003700 XXXXX055. NC2334.2 +003800 DATA DIVISION. NC2334.2 +003900 FILE SECTION. NC2334.2 +004000 FD PRINT-FILE. NC2334.2 +004100 01 PRINT-REC PICTURE X(120). NC2334.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2334.2 +004300 WORKING-STORAGE SECTION. NC2334.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2334.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2334.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2334.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2334.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2334.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2334.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2334.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2334.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2334.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2334.2 +005400 77 L1-HOLD PIC XX. NC2334.2 +005500 77 L2-HOLD PIC XX. NC2334.2 +005600 77 L3-HOLD PIC XX. NC2334.2 +005700 77 L4-HOLD PIC XX. NC2334.2 +005800 77 L5-HOLD PIC XX. NC2334.2 +005900 77 L6-HOLD PIC XX. NC2334.2 +006000 77 L7-HOLD PIC XX. NC2334.2 +006100 77 N1 PIC 99. NC2334.2 +006200 77 N2 PIC 99. NC2334.2 +006300 77 N3 PIC 99. NC2334.2 +006400 77 N4 PIC 99. NC2334.2 +006500 77 N5 PIC 99. NC2334.2 +006600 77 N6 PIC 99. NC2334.2 +006700 77 N7 PIC 99. NC2334.2 +006800 01 GRP-NAME. NC2334.2 +006900 02 FILLER PICTURE XXX VALUE "GRP". NC2334.2 +007000 02 ADD-GRP PICTURE 99 VALUE 01. NC2334.2 +007100 NC2334.2 +007200 01 SEC-NAME. NC2334.2 +007300 02 FILLER PICTURE X(5) VALUE "SEC (". NC2334.2 +007400 02 SEC-GRP PICTURE 99 VALUE 00. NC2334.2 +007500 02 FILLER PICTURE X VALUE ",". NC2334.2 +007600 02 ADD-SEC PICTURE 99 VALUE 01. NC2334.2 +007700 02 FILLER PICTURE X VALUE ")". NC2334.2 +007800 NC2334.2 +007900 01 ELEM-NAME. NC2334.2 +008000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2334.2 +008100 02 ELEM-GRP PICTURE 99 VALUE 00. NC2334.2 +008200 02 FILLER PICTURE X VALUE ",". NC2334.2 +008300 02 ELEM-SEC PICTURE 99 VALUE 00. NC2334.2 +008400 02 FILLER PICTURE X VALUE ",". NC2334.2 +008500 02 ADD-ELEM PICTURE 99 VALUE 01. NC2334.2 +008600 02 FILLER PICTURE X VALUE ")". NC2334.2 +008700 NC2334.2 +008800 01 3-DIMENSION-TBL. NC2334.2 +008900 02 GRP-ENTRY OCCURS 10 TIMES ASCENDING KEY IS GRP NC2334.2 +009000 INDEXED BY IDX-1. NC2334.2 +009100 03 ENTRY-1. NC2334.2 +009200 05 GRP PICTURE X(5). NC2334.2 +009300 03 GRP2-ENTRY OCCURS 10 TIMES ASCENDING KEY IS SEC NC2334.2 +009400 INDEXED BY IDX-2. NC2334.2 +009500 04 ENTRY-2. NC2334.2 +009600 05 FILLER PICTURE X(4). NC2334.2 +009700 05 SEC PICTURE X(7). NC2334.2 +009800 04 GRP3-ENTRY OCCURS 10 TIMES ASCENDING KEY IS ELEM NC2334.2 +009900 INDEXED BY IDX-3. NC2334.2 +010000 05 ENTRY-3. NC2334.2 +010100 07 FILLER PICTURE X(8). NC2334.2 +010200 07 ELEM PICTURE X(7). NC2334.2 +010300 NC2334.2 +010400 NC2334.2 +010500 01 7-DIMENSION-TBL. NC2334.2 +010600 02 GRP-7-1-ENTRY OCCURS 2 NC2334.2 +010700 ASCENDING KEY IS ENTRY-7-1G NC2334.2 +010800 INDEXED BY X1. NC2334.2 +010900 03 ENTRY-7-1G. NC2334.2 +011000 04 CHARS-7-1 PIC X. NC2334.2 +011100 04 ENTRY-7-1 PIC 9. NC2334.2 +011200 03 GRP-7-2-ENTRY OCCURS 2 NC2334.2 +011300 ASCENDING KEY IS ENTRY-7-2G NC2334.2 +011400 INDEXED BY X2. NC2334.2 +011500 04 ENTRY-7-2G. NC2334.2 +011600 05 CHARS-7-2 PIC X. NC2334.2 +011700 05 ENTRY-7-2 PIC 9. NC2334.2 +011800 04 GRP-7-3-ENTRY OCCURS 2 NC2334.2 +011900 ASCENDING KEY IS ENTRY-7-3G NC2334.2 +012000 INDEXED BY X3. NC2334.2 +012100 05 ENTRY-7-3G. NC2334.2 +012200 06 CHARS-7-3 PIC X. NC2334.2 +012300 06 ENTRY-7-3 PIC 9. NC2334.2 +012400 05 GRP-7-4-ENTRY OCCURS 2 NC2334.2 +012500 ASCENDING KEY IS ENTRY-7-4G NC2334.2 +012600 INDEXED BY X4. NC2334.2 +012700 06 ENTRY-7-4G. NC2334.2 +012800 07 CHARS-7-4 PIC X. NC2334.2 +012900 07 ENTRY-7-4 PIC 9. NC2334.2 +013000 06 GRP-7-5-ENTRY OCCURS 2 NC2334.2 +013100 ASCENDING KEY IS ENTRY-7-5G NC2334.2 +013200 INDEXED BY X5. NC2334.2 +013300 07 ENTRY-7-5G. NC2334.2 +013400 08 CHARS-7-5 PIC X. NC2334.2 +013500 08 ENTRY-7-5 PIC 9. NC2334.2 +013600 07 GRP-7-6-ENTRY OCCURS 2 NC2334.2 +013700 ASCENDING KEY IS ENTRY-7-6G NC2334.2 +013800 INDEXED BY X6. NC2334.2 +013900 08 ENTRY-7-6G. NC2334.2 +014000 09 CHARS-7-6 PIC X. NC2334.2 +014100 09 ENTRY-7-6 PIC 9. NC2334.2 +014200 08 GRP-7-7-ENTRY OCCURS 2 NC2334.2 +014300 ASCENDING KEY IS ENTRY-7-7G NC2334.2 +014400 INDEXED BY X7. NC2334.2 +014500 09 ENTRY-7-7G. NC2334.2 +014600 10 CHARS-7-7 PIC X. NC2334.2 +014700 10 ENTRY-7-7 PIC 9. NC2334.2 +014800 NC2334.2 +014900 01 NOTE-1. NC2334.2 +015000 02 FILLER PICTURE X(74) VALUE NC2334.2 +015100 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2334.2 +015200- "PATH WAS TAKEN". NC2334.2 +015300 02 FILLER PICTURE X(46) VALUE SPACES. NC2334.2 +015400 01 NOTE-2. NC2334.2 +015500 02 FILLER PICTURE X(112) VALUE NC2334.2 +015600 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2334.2 +015700- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2334.2 +015800 02 FILLER PICTURE X(8) VALUE SPACES. NC2334.2 +015900 NC2334.2 +016000 01 END-STMT. NC2334.2 +016100 02 FILLER PICTURE X(7) VALUE "AT END ". NC2334.2 +016200 02 END-IDX PICTURE X(5) VALUE SPACES. NC2334.2 +016300 02 FILLER PICTURE XXX VALUE " = ". NC2334.2 +016400 02 IDX-VALU PICTURE 99 VALUE 00. NC2334.2 +016500 02 FILLER PICTURE XXX VALUE SPACES. NC2334.2 +016600 01 TEST-RESULTS. NC2334.2 +016700 02 FILLER PIC X VALUE SPACE. NC2334.2 +016800 02 FEATURE PIC X(20) VALUE SPACE. NC2334.2 +016900 02 FILLER PIC X VALUE SPACE. NC2334.2 +017000 02 P-OR-F PIC X(5) VALUE SPACE. NC2334.2 +017100 02 FILLER PIC X VALUE SPACE. NC2334.2 +017200 02 PAR-NAME. NC2334.2 +017300 03 FILLER PIC X(19) VALUE SPACE. NC2334.2 +017400 03 PARDOT-X PIC X VALUE SPACE. NC2334.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. NC2334.2 +017600 02 FILLER PIC X(8) VALUE SPACE. NC2334.2 +017700 02 RE-MARK PIC X(61). NC2334.2 +017800 01 TEST-COMPUTED. NC2334.2 +017900 02 FILLER PIC X(30) VALUE SPACE. NC2334.2 +018000 02 FILLER PIC X(17) VALUE NC2334.2 +018100 " COMPUTED=". NC2334.2 +018200 02 COMPUTED-X. NC2334.2 +018300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2334.2 +018400 03 COMPUTED-N REDEFINES COMPUTED-A NC2334.2 +018500 PIC -9(9).9(9). NC2334.2 +018600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2334.2 +018700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2334.2 +018800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2334.2 +018900 03 CM-18V0 REDEFINES COMPUTED-A. NC2334.2 +019000 04 COMPUTED-18V0 PIC -9(18). NC2334.2 +019100 04 FILLER PIC X. NC2334.2 +019200 03 FILLER PIC X(50) VALUE SPACE. NC2334.2 +019300 01 TEST-CORRECT. NC2334.2 +019400 02 FILLER PIC X(30) VALUE SPACE. NC2334.2 +019500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2334.2 +019600 02 CORRECT-X. NC2334.2 +019700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2334.2 +019800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2334.2 +019900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2334.2 +020000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2334.2 +020100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2334.2 +020200 03 CR-18V0 REDEFINES CORRECT-A. NC2334.2 +020300 04 CORRECT-18V0 PIC -9(18). NC2334.2 +020400 04 FILLER PIC X. NC2334.2 +020500 03 FILLER PIC X(2) VALUE SPACE. NC2334.2 +020600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2334.2 +020700 01 CCVS-C-1. NC2334.2 +020800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2334.2 +020900- "SS PARAGRAPH-NAME NC2334.2 +021000- " REMARKS". NC2334.2 +021100 02 FILLER PIC X(20) VALUE SPACE. NC2334.2 +021200 01 CCVS-C-2. NC2334.2 +021300 02 FILLER PIC X VALUE SPACE. NC2334.2 +021400 02 FILLER PIC X(6) VALUE "TESTED". NC2334.2 +021500 02 FILLER PIC X(15) VALUE SPACE. NC2334.2 +021600 02 FILLER PIC X(4) VALUE "FAIL". NC2334.2 +021700 02 FILLER PIC X(94) VALUE SPACE. NC2334.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2334.2 +021900 01 REC-CT PIC 99 VALUE ZERO. NC2334.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2334.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2334.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2334.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2334.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2334.2 +022900 01 CCVS-H-1. NC2334.2 +023000 02 FILLER PIC X(39) VALUE SPACES. NC2334.2 +023100 02 FILLER PIC X(42) VALUE NC2334.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2334.2 +023300 02 FILLER PIC X(39) VALUE SPACES. NC2334.2 +023400 01 CCVS-H-2A. NC2334.2 +023500 02 FILLER PIC X(40) VALUE SPACE. NC2334.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2334.2 +023700 02 FILLER PIC XXXX VALUE NC2334.2 +023800 "4.2 ". NC2334.2 +023900 02 FILLER PIC X(28) VALUE NC2334.2 +024000 " COPY - NOT FOR DISTRIBUTION". NC2334.2 +024100 02 FILLER PIC X(41) VALUE SPACE. NC2334.2 +024200 NC2334.2 +024300 01 CCVS-H-2B. NC2334.2 +024400 02 FILLER PIC X(15) VALUE NC2334.2 +024500 "TEST RESULT OF ". NC2334.2 +024600 02 TEST-ID PIC X(9). NC2334.2 +024700 02 FILLER PIC X(4) VALUE NC2334.2 +024800 " IN ". NC2334.2 +024900 02 FILLER PIC X(12) VALUE NC2334.2 +025000 " HIGH ". NC2334.2 +025100 02 FILLER PIC X(22) VALUE NC2334.2 +025200 " LEVEL VALIDATION FOR ". NC2334.2 +025300 02 FILLER PIC X(58) VALUE NC2334.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +025500 01 CCVS-H-3. NC2334.2 +025600 02 FILLER PIC X(34) VALUE NC2334.2 +025700 " FOR OFFICIAL USE ONLY ". NC2334.2 +025800 02 FILLER PIC X(58) VALUE NC2334.2 +025900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2334.2 +026000 02 FILLER PIC X(28) VALUE NC2334.2 +026100 " COPYRIGHT 1985 ". NC2334.2 +026200 01 CCVS-E-1. NC2334.2 +026300 02 FILLER PIC X(52) VALUE SPACE. NC2334.2 +026400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2334.2 +026500 02 ID-AGAIN PIC X(9). NC2334.2 +026600 02 FILLER PIC X(45) VALUE SPACES. NC2334.2 +026700 01 CCVS-E-2. NC2334.2 +026800 02 FILLER PIC X(31) VALUE SPACE. NC2334.2 +026900 02 FILLER PIC X(21) VALUE SPACE. NC2334.2 +027000 02 CCVS-E-2-2. NC2334.2 +027100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2334.2 +027200 03 FILLER PIC X VALUE SPACE. NC2334.2 +027300 03 ENDER-DESC PIC X(44) VALUE NC2334.2 +027400 "ERRORS ENCOUNTERED". NC2334.2 +027500 01 CCVS-E-3. NC2334.2 +027600 02 FILLER PIC X(22) VALUE NC2334.2 +027700 " FOR OFFICIAL USE ONLY". NC2334.2 +027800 02 FILLER PIC X(12) VALUE SPACE. NC2334.2 +027900 02 FILLER PIC X(58) VALUE NC2334.2 +028000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +028100 02 FILLER PIC X(13) VALUE SPACE. NC2334.2 +028200 02 FILLER PIC X(15) VALUE NC2334.2 +028300 " COPYRIGHT 1985". NC2334.2 +028400 01 CCVS-E-4. NC2334.2 +028500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2334.2 +028600 02 FILLER PIC X(4) VALUE " OF ". NC2334.2 +028700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2334.2 +028800 02 FILLER PIC X(40) VALUE NC2334.2 +028900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2334.2 +029000 01 XXINFO. NC2334.2 +029100 02 FILLER PIC X(19) VALUE NC2334.2 +029200 "*** INFORMATION ***". NC2334.2 +029300 02 INFO-TEXT. NC2334.2 +029400 04 FILLER PIC X(8) VALUE SPACE. NC2334.2 +029500 04 XXCOMPUTED PIC X(20). NC2334.2 +029600 04 FILLER PIC X(5) VALUE SPACE. NC2334.2 +029700 04 XXCORRECT PIC X(20). NC2334.2 +029800 02 INF-ANSI-REFERENCE PIC X(48). NC2334.2 +029900 01 HYPHEN-LINE. NC2334.2 +030000 02 FILLER PIC IS X VALUE IS SPACE. NC2334.2 +030100 02 FILLER PIC IS X(65) VALUE IS "************************NC2334.2 +030200- "*****************************************". NC2334.2 +030300 02 FILLER PIC IS X(54) VALUE IS "************************NC2334.2 +030400- "******************************". NC2334.2 +030500 01 CCVS-PGM-ID PIC X(9) VALUE NC2334.2 +030600 "NC233A". NC2334.2 +030700 PROCEDURE DIVISION. NC2334.2 +030800 CCVS1 SECTION. NC2334.2 +030900 OPEN-FILES. NC2334.2 +031000 OPEN OUTPUT PRINT-FILE. NC2334.2 +031100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2334.2 +031200 MOVE SPACE TO TEST-RESULTS. NC2334.2 +031300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2334.2 +031400 GO TO CCVS1-EXIT. NC2334.2 +031500 CLOSE-FILES. NC2334.2 +031600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2334.2 +031700 TERMINATE-CCVS. NC2334.2 +031800S EXIT PROGRAM. NC2334.2 +031900STERMINATE-CALL. NC2334.2 +032000 STOP RUN. NC2334.2 +032100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2334.2 +032200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2334.2 +032300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2334.2 +032400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2334.2 +032500 MOVE "****TEST DELETED****" TO RE-MARK. NC2334.2 +032600 PRINT-DETAIL. NC2334.2 +032700 IF REC-CT NOT EQUAL TO ZERO NC2334.2 +032800 MOVE "." TO PARDOT-X NC2334.2 +032900 MOVE REC-CT TO DOTVALUE. NC2334.2 +033000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2334.2 +033100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2334.2 +033200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2334.2 +033300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2334.2 +033400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2334.2 +033500 MOVE SPACE TO CORRECT-X. NC2334.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2334.2 +033700 MOVE SPACE TO RE-MARK. NC2334.2 +033800 HEAD-ROUTINE. NC2334.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2334.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2334.2 +034300 COLUMN-NAMES-ROUTINE. NC2334.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +034700 END-ROUTINE. NC2334.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2334.2 +034900 END-RTN-EXIT. NC2334.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +035100 END-ROUTINE-1. NC2334.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2334.2 +035300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2334.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. NC2334.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2334.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2334.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2334.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2334.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2334.2 +036000 END-ROUTINE-12. NC2334.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2334.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2334.2 +036300 MOVE "NO " TO ERROR-TOTAL NC2334.2 +036400 ELSE NC2334.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2334.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2334.2 +036700 PERFORM WRITE-LINE. NC2334.2 +036800 END-ROUTINE-13. NC2334.2 +036900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2334.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE NC2334.2 +037100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2334.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2334.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO NC2334.2 +037500 MOVE "NO " TO ERROR-TOTAL NC2334.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2334.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2334.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +038000 WRITE-LINE. NC2334.2 +038100 ADD 1 TO RECORD-COUNT. NC2334.2 +038200Y IF RECORD-COUNT GREATER 50 NC2334.2 +038300Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2334.2 +038400Y MOVE SPACE TO DUMMY-RECORD NC2334.2 +038500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2334.2 +038600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2334.2 +038700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2334.2 +038800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2334.2 +038900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2334.2 +039000Y MOVE ZERO TO RECORD-COUNT. NC2334.2 +039100 PERFORM WRT-LN. NC2334.2 +039200 WRT-LN. NC2334.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2334.2 +039400 MOVE SPACE TO DUMMY-RECORD. NC2334.2 +039500 BLANK-LINE-PRINT. NC2334.2 +039600 PERFORM WRT-LN. NC2334.2 +039700 FAIL-ROUTINE. NC2334.2 +039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2334.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2334.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2334.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2334.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2334.2 +040400 GO TO FAIL-ROUTINE-EX. NC2334.2 +040500 FAIL-ROUTINE-WRITE. NC2334.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2334.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2334.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2334.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2334.2 +041000 FAIL-ROUTINE-EX. EXIT. NC2334.2 +041100 BAIL-OUT. NC2334.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2334.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2334.2 +041400 BAIL-OUT-WRITE. NC2334.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2334.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2334.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2334.2 +041900 BAIL-OUT-EX. EXIT. NC2334.2 +042000 CCVS1-EXIT. NC2334.2 +042100 EXIT. NC2334.2 +042200 SECT-NC233A-001 SECTION. NC2334.2 +042300 TH-05-001. NC2334.2 +042400 BUILD-LEVEL-1. NC2334.2 +042500 ADD 1 TO SUB-1. NC2334.2 +042600 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2334.2 +042700 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2334.2 +042800 ADD 1 TO ADD-GRP. NC2334.2 +042900 BUILD-LEVEL-2. NC2334.2 +043000 ADD 1 TO SUB-2. NC2334.2 +043100 IF SUB-2 = 11 NC2334.2 +043200 MOVE ZERO TO SUB-2 NC2334.2 +043300 MOVE 01 TO ADD-SEC NC2334.2 +043400 GO TO BUILD-LEVEL-1. NC2334.2 +043500 MOVE SUB-1 TO SEC-GRP. NC2334.2 +043600 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2334.2 +043700 ADD 1 TO ADD-SEC. NC2334.2 +043800 BUILD-LEVEL-3. NC2334.2 +043900 ADD 1 TO SUB-3. NC2334.2 +044000 IF SUB-3 = 11 NC2334.2 +044100 MOVE ZERO TO SUB-3 NC2334.2 +044200 MOVE 01 TO ADD-ELEM NC2334.2 +044300 GO TO BUILD-LEVEL-2. NC2334.2 +044400 MOVE SUB-1 TO ELEM-GRP. NC2334.2 +044500 MOVE SUB-2 TO ELEM-SEC. NC2334.2 +044600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2334.2 +044700 ADD 1 TO ADD-ELEM. NC2334.2 +044800 GO TO BUILD-LEVEL-3. NC2334.2 +044900 NC2334.2 +045000 CHECK-ENTRIES. NC2334.2 +045100 MOVE "SEARCH ALL-FIRST LEV" TO FEATURE. NC2334.2 +045200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2334.2 +045300 MOVE "GRP02" TO GRP-HOLD-AREA. NC2334.2 +045400 MOVE 02 TO SUB-2. NC2334.2 +045500 SET IDX-1 TO 1. NC2334.2 +045600 SEARCH ALL GRP-ENTRY AT END NC2334.2 +045700 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +045800 GO TO LEVEL-1-TEST-2 NC2334.2 +045900 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +046000 NC2334.2 +046100 PERFORM PASS-TH. NC2334.2 +046200 GO TO LEVEL-1-TEST-2. NC2334.2 +046300 NC2334.2 +046400 GRP-FAIL-PARGRAPH. NC2334.2 +046500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2334.2 +046600 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2334.2 +046700 MOVE "IDX-1" TO END-IDX NC2334.2 +046800 SET IDX-VALU TO IDX-1 NC2334.2 +046900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +047000 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +047100 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2334.2 +047200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +047300 NC2334.2 +047400 PERFORM FAIL-TH. NC2334.2 +047500 LEVEL-1-TEST-2. NC2334.2 +047600 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2334.2 +047700 MOVE "GRP01" TO GRP-HOLD-AREA. NC2334.2 +047800 MOVE 01 TO SUB-2. NC2334.2 +047900 SET IDX-1 TO 1. NC2334.2 +048000 SEARCH ALL GRP-ENTRY AT END NC2334.2 +048100 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +048200 GO TO LEVEL-1-TEST-3 NC2334.2 +048300 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +048400 NC2334.2 +048500 PERFORM PASS-TH. NC2334.2 +048600 LEVEL-1-TEST-3. NC2334.2 +048700 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2334.2 +048800 MOVE "GRP10" TO GRP-HOLD-AREA. NC2334.2 +048900 MOVE 10 TO SUB-2. NC2334.2 +049000 SET IDX-1 TO 1. NC2334.2 +049100 SEARCH ALL GRP-ENTRY AT END NC2334.2 +049200 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +049300 GO TO LEVEL-1-TEST-4 NC2334.2 +049400 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +049500 NC2334.2 +049600 PERFORM PASS-TH. NC2334.2 +049700 LEVEL-1-TEST-4. NC2334.2 +049800 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2334.2 +049900 MOVE "GRP05" TO GRP-HOLD-AREA. NC2334.2 +050000 MOVE 05 TO SUB-2. NC2334.2 +050100 SET IDX-1 TO 05. NC2334.2 +050200 SEARCH ALL GRP-ENTRY NC2334.2 +050300 WHEN GRP (IDX-1) = GRP-HOLD-AREA GO TO PASS-TH-TEST-4. NC2334.2 +050400 PERFORM GRP-FAIL-PARGRAPH. NC2334.2 +050500 GO TO LEVEL-2-TEST-1. NC2334.2 +050600 PASS-TH-TEST-4. NC2334.2 +050700 NC2334.2 +050800 PERFORM PASS-TH. NC2334.2 +050900 NC2334.2 +051000 LEVEL-2-TEST-1. NC2334.2 +051100 MOVE "SEARCH ALL-SEC LEVEL" TO FEATURE. NC2334.2 +051200 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2334.2 +051300 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2334.2 +051400 MOVE 1 TO SUB-1 SUB-2. NC2334.2 +051500 SET IDX-1 IDX-2 TO 1. NC2334.2 +051600 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +051700 PERFORM SEC-FAIL-PARGRAF NC2334.2 +051800 GO TO LEVEL-2-TEST-2 NC2334.2 +051900 WHEN SEC (IDX-1, IDX-2) = "(01,01)" NEXT SENTENCE. NC2334.2 +052000 NC2334.2 +052100 PERFORM PASS-TH. NC2334.2 +052200 NC2334.2 +052300 LEVEL-2-TEST-2. NC2334.2 +052400 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2334.2 +052500 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2334.2 +052600 MOVE 05 TO SUB-1. NC2334.2 +052700 MOVE 10 TO SUB-2. NC2334.2 +052800 SET IDX-1 TO 5. NC2334.2 +052900 SET IDX-2 TO 1. NC2334.2 +053000 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +053100 PERFORM SEC-FAIL-PARGRAF NC2334.2 +053200 GO TO LEVEL-2-TEST-3 NC2334.2 +053300 WHEN SEC (IDX-1, IDX-2) = "(05,10)" NEXT SENTENCE. NC2334.2 +053400 NC2334.2 +053500 PERFORM PASS-TH. NC2334.2 +053600 NC2334.2 +053700 LEVEL-2-TEST-3. NC2334.2 +053800 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2334.2 +053900 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2334.2 +054000 SET IDX-1 TO 10. NC2334.2 +054100 SET IDX-2 TO 1. NC2334.2 +054200 MOVE 10 TO SUB-1 SUB-2. NC2334.2 +054300 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +054400 PERFORM SEC-FAIL-PARGRAF NC2334.2 +054500 GO TO LEVEL-2-TEST-4 NC2334.2 +054600 WHEN SEC (IDX-1, IDX-2) = "(10,10)" NEXT SENTENCE. NC2334.2 +054700 NC2334.2 +054800 PERFORM PASS-TH. NC2334.2 +054900 LEVEL-2-TEST-4. NC2334.2 +055000 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2334.2 +055100 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2334.2 +055200 MOVE 08 TO SUB-1. NC2334.2 +055300 MOVE 02 TO SUB-2. NC2334.2 +055400 SET IDX-1 TO 08. NC2334.2 +055500 SET IDX-2 TO 01. NC2334.2 +055600 SEARCH ALL GRP2-ENTRY NC2334.2 +055700 WHEN SEC (IDX-1, IDX-2) = "(08,02)" GO TO PASS-TH-2-4. NC2334.2 +055800 PERFORM SEC-FAIL-PARGRAF. NC2334.2 +055900 GO TO LEVEL-3-TEST-1. NC2334.2 +056000 PASS-TH-2-4. NC2334.2 +056100 NC2334.2 +056200 PERFORM PASS-TH. NC2334.2 +056300 GO TO LEVEL-3-TEST-1. NC2334.2 +056400 NC2334.2 +056500 SEC-FAIL-PARGRAF. NC2334.2 +056600 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2334.2 +056700 IF ENTRY-2 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2334.2 +056800 MOVE "IDX-2" TO END-IDX NC2334.2 +056900 SET IDX-VALU TO IDX-2 NC2334.2 +057000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +057100 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +057200 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2334.2 +057300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +057400 NC2334.2 +057500 PERFORM FAIL-TH. NC2334.2 +057600 NC2334.2 +057700 LEVEL-3-TEST-1. NC2334.2 +057800 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2334.2 +057900 MOVE "SEARCH ALL THIRD LEV" TO FEATURE. NC2334.2 +058000 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2334.2 +058100 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2334.2 +058200 SET IDX-1 IDX-2 IDX-3 TO 1. NC2334.2 +058300 SEARCH ALL GRP3-ENTRY NC2334.2 +058400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",01,01)" NC2334.2 +058500 GO TO PASS-TH-3-1. NC2334.2 +058600 PERFORM ELEM-FAIL-PARA. NC2334.2 +058700 GO TO LEVEL-3-TEST-2. NC2334.2 +058800 PASS-TH-3-1. NC2334.2 +058900 NC2334.2 +059000 PERFORM PASS-TH. NC2334.2 +059100 NC2334.2 +059200 LEVEL-3-TEST-2. NC2334.2 +059300 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2334.2 +059400 MOVE 05 TO SUB-1. NC2334.2 +059500 MOVE 06 TO SUB-2. NC2334.2 +059600 MOVE 07 TO SUB-3. NC2334.2 +059700 SET IDX-1 TO 05. NC2334.2 +059800 SET IDX-2 TO 06. NC2334.2 +059900 SET IDX-3 TO 1. NC2334.2 +060000 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2334.2 +060100 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +060200 PERFORM ELEM-FAIL-PARA NC2334.2 +060300 GO TO LEVEL-3-TEST-3 NC2334.2 +060400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",06,07)" NC2334.2 +060500 NEXT SENTENCE. NC2334.2 +060600 NC2334.2 +060700 PERFORM PASS-TH. NC2334.2 +060800 NC2334.2 +060900 LEVEL-3-TEST-3. NC2334.2 +061000 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2334.2 +061100 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2334.2 +061200 SET IDX-1 IDX-2 TO 10. NC2334.2 +061300 SET IDX-3 TO 1. NC2334.2 +061400 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2334.2 +061500 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +061600 PERFORM ELEM-FAIL-PARA NC2334.2 +061700 GO TO LEVEL-3-TEST-4 NC2334.2 +061800 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",10,10)" NC2334.2 +061900 NEXT SENTENCE. NC2334.2 +062000 NC2334.2 +062100 PERFORM PASS-TH. NC2334.2 +062200 LEVEL-3-TEST-4. NC2334.2 +062300 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2334.2 +062400 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2334.2 +062500 MOVE 07 TO SUB-1. NC2334.2 +062600 MOVE 06 TO SUB-2. NC2334.2 +062700 MOVE 05 TO SUB-3. NC2334.2 +062800 SET IDX-1 TO 07. NC2334.2 +062900 SET IDX-2 TO 06. NC2334.2 +063000 SET IDX-3 TO 03. NC2334.2 +063100 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +063200 PERFORM ELEM-FAIL-PARA NC2334.2 +063300 GO TO MULT-SEARCH-TEST-1 NC2334.2 +063400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",06,05)" NC2334.2 +063500 NEXT SENTENCE. NC2334.2 +063600 NC2334.2 +063700 PERFORM PASS-TH. NC2334.2 +063800 GO TO MULT-SEARCH-TEST-1. NC2334.2 +063900 ELEM-FAIL-PARA. NC2334.2 +064000 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2334.2 +064100 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2334.2 +064200 MOVE "IDX-3" TO END-IDX NC2334.2 +064300 SET IDX-VALU TO IDX-3 NC2334.2 +064400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +064500 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +064600 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2334.2 +064700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +064800 NC2334.2 +064900 PERFORM FAIL-TH. NC2334.2 +065000 NC2334.2 +065100 MULT-SEARCH-TEST-1. NC2334.2 +065200 MOVE "MULT-SEARCH-TEST-1 " TO PAR-NAME. NC2334.2 +065300 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2334.2 +065400 MOVE "GRP08" TO GRP-HOLD-AREA. NC2334.2 +065500 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2334.2 +065600 SET IDX-1 IDX-2 TO 1. NC2334.2 +065700 SEARCH ALL GRP-ENTRY AT END GO TO MULT-SEARCH-FAIL1 NC2334.2 +065800 WHEN GRP (IDX-1) = "GRP08" NEXT SENTENCE. NC2334.2 +065900 SEARCH ALL GRP2-ENTRY AT END GO TO MULT-SEARCH-FAIL NC2334.2 +066000 WHEN SEC (IDX-1, IDX-2) = "(08,07)" NEXT SENTENCE. NC2334.2 +066100 NC2334.2 +066200 PERFORM PASS-TH. NC2334.2 +066300 GO TO MULT-SEARCH-7-INIT-3. NC2334.2 +066400 MULT-SEARCH-FAIL1. NC2334.2 +066500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2334.2 +066600 IF ENTRY-1 (08) EQUAL TO GRP-HOLD-AREA NC2334.2 +066700 MOVE "IDX-1" TO END-IDX NC2334.2 +066800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +066900 SET IDX-VALU TO IDX-1 NC2334.2 +067000 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +067100 MOVE ENTRY-1 (08) TO COMPUTED-A NC2334.2 +067200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +067300 NC2334.2 +067400 PERFORM FAIL-TH. NC2334.2 +067500 GO TO MULT-SEARCH-7-INIT-3. NC2334.2 +067600 MULT-SEARCH-FAIL. NC2334.2 +067700 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2334.2 +067800 IF ENTRY-2 (08, 07) EQUAL TO SEC-HOLD-AREA NC2334.2 +067900 MOVE "IDX-2" TO END-IDX NC2334.2 +068000 SET IDX-VALU TO IDX-2 NC2334.2 +068100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +068200 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +068300 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2334.2 +068400 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +068500 NC2334.2 +068600 PERFORM FAIL-TH. NC2334.2 +068700 NC2334.2 +068800 MULT-SEARCH-7-INIT-3. NC2334.2 +068900 MOVE "MULT-SEARCH-7-TEST-3" TO PAR-NAME. NC2334.2 +069000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2334.2 +069100 MOVE "A2" TO L1-HOLD. NC2334.2 +069200 MOVE "B1" TO L2-HOLD. NC2334.2 +069300 MOVE "C2" TO L3-HOLD. NC2334.2 +069400 MOVE "D1" TO L4-HOLD. NC2334.2 +069500 MOVE "E2" TO L5-HOLD. NC2334.2 +069600 MOVE "F1" TO L6-HOLD. NC2334.2 +069700 MOVE "G2" TO L7-HOLD. NC2334.2 +069800 SET X1 X2 X3 X4 X5 X6 X7 TO 1. NC2334.2 +069900 PERFORM MULT-SEARCH-7-INIT-3-A NC2334.2 +070000 VARYING N1 FROM 1 BY 1 UNTIL N1 > 2 NC2334.2 +070100 AFTER N2 FROM 1 BY 1 UNTIL N2 > 2 NC2334.2 +070200 AFTER N3 FROM 1 BY 1 UNTIL N3 > 2 NC2334.2 +070300 AFTER N4 FROM 1 BY 1 UNTIL N4 > 2 NC2334.2 +070400 AFTER N5 FROM 1 BY 1 UNTIL N5 > 2 NC2334.2 +070500 AFTER N6 FROM 1 BY 1 UNTIL N6 > 2 NC2334.2 +070600 AFTER N7 FROM 1 BY 1 UNTIL N7 > 2. NC2334.2 +070700 GO TO MULT-SEARCH-7-TEST-3. NC2334.2 +070800 MULT-SEARCH-7-INIT-3-A. NC2334.2 +070900 NC2334.2 +071000 MOVE N1 TO ENTRY-7-1 (N1). NC2334.2 +071100 MOVE "A" TO CHARS-7-1 (N1). NC2334.2 +071200 MOVE N2 TO ENTRY-7-2 (N1 N2). NC2334.2 +071300 MOVE "B" TO CHARS-7-2 (N1 N2). NC2334.2 +071400 MOVE N3 TO ENTRY-7-3 (N1 N2 N3). NC2334.2 +071500 MOVE "C" TO CHARS-7-3 (N1 N2 N3). NC2334.2 +071600 MOVE N4 TO ENTRY-7-4 (N1 N2 N3 N4). NC2334.2 +071700 MOVE "D" TO CHARS-7-4 (N1 N2 N3 N4). NC2334.2 +071800 MOVE N5 TO ENTRY-7-5 (N1 N2 N3 N4 N5). NC2334.2 +071900 MOVE "E" TO CHARS-7-5 (N1 N2 N3 N4 N5). NC2334.2 +072000 MOVE N6 TO ENTRY-7-6 (N1 N2 N3 N4 N5 N6). NC2334.2 +072100 MOVE "F" TO CHARS-7-6 (N1 N2 N3 N4 N5 N6). NC2334.2 +072200 MOVE N7 TO ENTRY-7-7 (N1 N2 N3 N4 N5 N6 N7). NC2334.2 +072300 MOVE "G" TO CHARS-7-7 (N1 N2 N3 N4 N5 N6 N7). NC2334.2 +072400 MULT-SEARCH-7-DELETE-3. NC2334.2 +072500 PERFORM DE-LETE. NC2334.2 +072600 PERFORM PRINT-DETAIL. NC2334.2 +072700 GO TO END-SEARCH-TEST. NC2334.2 +072800 MULT-SEARCH-7-TEST-3. NC2334.2 +072900 SEARCH ALL GRP-7-1-ENTRY NC2334.2 +073000 AT END GO TO MULT-SEARCH-7-FAIL-1 NC2334.2 +073100 WHEN ENTRY-7-1G (X1) = L1-HOLD NC2334.2 +073200 NEXT SENTENCE. NC2334.2 +073300 SET X1 TO 1. NC2334.2 +073400 SEARCH ALL GRP-7-2-ENTRY NC2334.2 +073500 AT END GO TO MULT-SEARCH-7-FAIL-2 NC2334.2 +073600 WHEN ENTRY-7-2G (X1 X2) = L2-HOLD NC2334.2 +073700 NEXT SENTENCE. NC2334.2 +073800 SET X1 TO 2. NC2334.2 +073900 SET X2 TO 1. NC2334.2 +074000 SEARCH ALL GRP-7-3-ENTRY NC2334.2 +074100 AT END GO TO MULT-SEARCH-7-FAIL-3 NC2334.2 +074200 WHEN ENTRY-7-3G (X1 X2 X3) = L3-HOLD NC2334.2 +074300 NEXT SENTENCE. NC2334.2 +074400 SET X1 TO 1. NC2334.2 +074500 SET X2, X3 TO 1. NC2334.2 +074600 SEARCH ALL GRP-7-4-ENTRY NC2334.2 +074700 AT END GO TO MULT-SEARCH-7-FAIL-4 NC2334.2 +074800 WHEN ENTRY-7-4G (X1 X2 X3 X4) = L4-HOLD NC2334.2 +074900 NEXT SENTENCE. NC2334.2 +075000 SET X1 TO 2. NC2334.2 +075100 SET X2, X3, X4 TO 1. NC2334.2 +075200 SEARCH ALL GRP-7-5-ENTRY NC2334.2 +075300 AT END GO TO MULT-SEARCH-7-FAIL-5 NC2334.2 +075400 WHEN ENTRY-7-5G (X1 X2 X3 X4 X5) = L5-HOLD NC2334.2 +075500 NEXT SENTENCE. NC2334.2 +075600 SET X1 TO 1. NC2334.2 +075700 SET X2, X3, X4, X5 TO 1. NC2334.2 +075800 SEARCH ALL GRP-7-6-ENTRY NC2334.2 +075900 AT END GO TO MULT-SEARCH-7-FAIL-6 NC2334.2 +076000 WHEN ENTRY-7-6G (X1 X2 X3 X4 X5 X6) = L6-HOLD NC2334.2 +076100 NEXT SENTENCE. NC2334.2 +076200 SET X1 TO 2. NC2334.2 +076300 SET X2, X3, X4, X6 TO 1. NC2334.2 +076400 SEARCH ALL GRP-7-7-ENTRY NC2334.2 +076500 AT END GO TO MULT-SEARCH-7-FAIL-7 NC2334.2 +076600 WHEN ENTRY-7-7G (X1 X2 X3 X4 X5 X6 X7) = L7-HOLD NC2334.2 +076700 NEXT SENTENCE. NC2334.2 +076800 NC2334.2 +076900 PERFORM PASS-TH. NC2334.2 +077000 GO TO END-SEARCH-TEST. NC2334.2 +077100 NC2334.2 +077200 MULT-SEARCH-7-FAIL-1. NC2334.2 +077300 MOVE L1-HOLD TO CORRECT-A. NC2334.2 +077400 IF ENTRY-7-1 (2) = L1-HOLD NC2334.2 +077500 MOVE "IX-1" TO END-IDX NC2334.2 +077600 SET IDX-VALU TO X1 NC2334.2 +077700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +077800 MOVE END-STMT TO COMPUTED-A NC2334.2 +077900 ELSE NC2334.2 +078000 MOVE ENTRY-7-1 (2) TO COMPUTED-A NC2334.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +078200 NC2334.2 +078300 PERFORM FAIL-TH. NC2334.2 +078400 GO TO END-SEARCH-TEST. NC2334.2 +078500 NC2334.2 +078600 MULT-SEARCH-7-FAIL-2. NC2334.2 +078700 MOVE L2-HOLD TO CORRECT-A. NC2334.2 +078800 IF ENTRY-7-2 (2 1) = L1-HOLD NC2334.2 +078900 MOVE "X2" TO END-IDX NC2334.2 +079000 SET IDX-VALU TO X2 NC2334.2 +079100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +079200 MOVE END-STMT TO COMPUTED-A NC2334.2 +079300 ELSE NC2334.2 +079400 MOVE ENTRY-7-2 (2 1) TO COMPUTED-A NC2334.2 +079500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +079600 NC2334.2 +079700 PERFORM FAIL-TH. NC2334.2 +079800 GO TO END-SEARCH-TEST. NC2334.2 +079900 NC2334.2 +080000 MULT-SEARCH-7-FAIL-3. NC2334.2 +080100 MOVE L3-HOLD TO CORRECT-A. NC2334.2 +080200 IF ENTRY-7-3 (2 1 2) = L3-HOLD NC2334.2 +080300 MOVE "X3" TO END-IDX NC2334.2 +080400 SET IDX-VALU TO X3 NC2334.2 +080500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +080600 MOVE END-STMT TO COMPUTED-A NC2334.2 +080700 ELSE NC2334.2 +080800 MOVE ENTRY-7-3 (2 1 2) TO COMPUTED-A NC2334.2 +080900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +081000 NC2334.2 +081100 PERFORM FAIL-TH. NC2334.2 +081200 GO TO END-SEARCH-TEST. NC2334.2 +081300 NC2334.2 +081400 MULT-SEARCH-7-FAIL-4. NC2334.2 +081500 MOVE L4-HOLD TO CORRECT-A. NC2334.2 +081600 IF ENTRY-7-4 (2 1 2 1) = L4-HOLD NC2334.2 +081700 MOVE "X4" TO END-IDX NC2334.2 +081800 SET IDX-VALU TO X4 NC2334.2 +081900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +082000 MOVE END-STMT TO COMPUTED-A NC2334.2 +082100 ELSE NC2334.2 +082200 MOVE ENTRY-7-4 (2 1 2 1) TO COMPUTED-A NC2334.2 +082300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +082400 NC2334.2 +082500 PERFORM FAIL-TH. NC2334.2 +082600 GO TO END-SEARCH-TEST. NC2334.2 +082700 NC2334.2 +082800 MULT-SEARCH-7-FAIL-5. NC2334.2 +082900 MOVE L5-HOLD TO CORRECT-A. NC2334.2 +083000 IF ENTRY-7-5 (2 1 2 1 2) = L5-HOLD NC2334.2 +083100 MOVE "X5" TO END-IDX NC2334.2 +083200 SET IDX-VALU TO X5 NC2334.2 +083300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +083400 MOVE END-STMT TO COMPUTED-A NC2334.2 +083500 ELSE NC2334.2 +083600 MOVE ENTRY-7-5 (2 1 2 1 2) TO COMPUTED-A NC2334.2 +083700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +083800 NC2334.2 +083900 PERFORM FAIL-TH. NC2334.2 +084000 GO TO END-SEARCH-TEST. NC2334.2 +084100 NC2334.2 +084200 MULT-SEARCH-7-FAIL-6. NC2334.2 +084300 MOVE L6-HOLD TO CORRECT-A. NC2334.2 +084400 IF ENTRY-7-6 (2 1 2 1 2 1) = L6-HOLD NC2334.2 +084500 MOVE "X6" TO END-IDX NC2334.2 +084600 SET IDX-VALU TO X6 NC2334.2 +084700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +084800 MOVE END-STMT TO COMPUTED-A NC2334.2 +084900 ELSE NC2334.2 +085000 MOVE ENTRY-7-6 (2 1 2 1 2 1) TO COMPUTED-A NC2334.2 +085100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +085200 NC2334.2 +085300 PERFORM FAIL-TH. NC2334.2 +085400 GO TO END-SEARCH-TEST. NC2334.2 +085500 NC2334.2 +085600 MULT-SEARCH-7-FAIL-7. NC2334.2 +085700 MOVE L7-HOLD TO CORRECT-A. NC2334.2 +085800 IF ENTRY-7-7 (2 1 2 1 2 1 2) = L6-HOLD NC2334.2 +085900 MOVE "X7" TO END-IDX NC2334.2 +086000 SET IDX-VALU TO X7 NC2334.2 +086100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +086200 MOVE END-STMT TO COMPUTED-A NC2334.2 +086300 ELSE NC2334.2 +086400 MOVE ENTRY-7-7 (2 1 2 1 2 1 2) TO COMPUTED-A NC2334.2 +086500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +086600 NC2334.2 +086700 PERFORM FAIL-TH. NC2334.2 +086800 NC2334.2 +086900 GO TO END-SEARCH-TEST. NC2334.2 +087000 NC2334.2 +087100 PASS-TH. NC2334.2 +087200 PERFORM PASS. NC2334.2 +087300 PERFORM PRINT-DETAIL. NC2334.2 +087400 FAIL-TH. NC2334.2 +087500 PERFORM FAIL. NC2334.2 +087600 PERFORM PRINT-DETAIL. NC2334.2 +087700 END-SEARCH-TEST. NC2334.2 +087800 EXIT. NC2334.2 +087900 CCVS-EXIT SECTION. NC2334.2 +088000 CCVS-999999. NC2334.2 +088100 GO TO CLOSE-FILES. NC2334.2 +*END-OF,NC233A +*HEADER,COBOL,NC234A +000100 IDENTIFICATION DIVISION. NC2344.2 +000200 PROGRAM-ID. NC2344.2 +000300 NC234A. NC2344.2 +000400 NC2344.2 +000500**************************************************************** NC2344.2 +000600* * NC2344.2 +000700* VALIDATION FOR:- * NC2344.2 +000800* * NC2344.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +001000* * NC2344.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2344.2 +001200* * NC2344.2 +001300**************************************************************** NC2344.2 +001400* * NC2344.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2344.2 +001600* * NC2344.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2344.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2344.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2344.2 +002000* * NC2344.2 +002100**************************************************************** NC2344.2 +002200* NC2344.2 +002300* PROGRAM NC234A TESTS THE ACCESSING OF A "REDEFINED" THREE * NC2344.2 +002400* -DIMENSIONAL TABLE USING FORMAT 1 OF THE "SEARCH" * NC2344.2 +002500* STATEMENT. THE "VARYING" AND "AT END" PHRASES ARE USED. * NC2344.2 +002600* * NC2344.2 +002700**************************************************************** NC2344.2 +002800 ENVIRONMENT DIVISION. NC2344.2 +002900 CONFIGURATION SECTION. NC2344.2 +003000 SOURCE-COMPUTER. NC2344.2 +003100 XXXXX082. NC2344.2 +003200 OBJECT-COMPUTER. NC2344.2 +003300 XXXXX083. NC2344.2 +003400 INPUT-OUTPUT SECTION. NC2344.2 +003500 FILE-CONTROL. NC2344.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2344.2 +003700 XXXXX055. NC2344.2 +003800 DATA DIVISION. NC2344.2 +003900 FILE SECTION. NC2344.2 +004000 FD PRINT-FILE. NC2344.2 +004100 01 PRINT-REC PICTURE X(120). NC2344.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2344.2 +004300 WORKING-STORAGE SECTION. NC2344.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2344.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2344.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2344.2 +004700 77 CON-5 PICTURE 99 VALUE 05. NC2344.2 +004800 77 CON-6 PICTURE 99 VALUE 06. NC2344.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2344.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2344.2 +005100 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2344.2 +005200 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2344.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2344.2 +005400 01 GRP-NAME. NC2344.2 +005500 02 FILLER PICTURE XXX VALUE "GRP". NC2344.2 +005600 02 ADD-GRP PICTURE 99 VALUE 01. NC2344.2 +005700 NC2344.2 +005800 01 SEC-NAME. NC2344.2 +005900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2344.2 +006000 02 SEC-GRP PICTURE 99 VALUE 00. NC2344.2 +006100 02 FILLER PICTURE X VALUE ",". NC2344.2 +006200 02 ADD-SEC PICTURE 99 VALUE 01. NC2344.2 +006300 02 FILLER PICTURE X VALUE ")". NC2344.2 +006400 NC2344.2 +006500 01 ELEM-NAME. NC2344.2 +006600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2344.2 +006700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2344.2 +006800 02 FILLER PICTURE X VALUE ",". NC2344.2 +006900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2344.2 +007000 02 FILLER PICTURE X VALUE ",". NC2344.2 +007100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2344.2 +007200 02 FILLER PICTURE X VALUE ")". NC2344.2 +007300 NC2344.2 +007400 01 3-DIMENSION-TBL. NC2344.2 +007500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2344.2 +007600 03 ENTRY-1 PICTURE X(5). NC2344.2 +007700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2344.2 +007800 04 ENTRY-2 PICTURE X(11). NC2344.2 +007900 04 3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2344.2 +008000 05 ENTRY-3 PICTURE X(15). NC2344.2 +008100 01 3-DEM-TBL REDEFINES 3-DIMENSION-TBL. NC2344.2 +008200 02 GRP-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-1-1. NC2344.2 +008300 03 ENTRY-1-1 PIC X(5). NC2344.2 +008400 03 GRP2-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-2-1. NC2344.2 +008500 04 ENTRY-2-1 PIC X(11). NC2344.2 +008600 04 GRP3-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-3-1. NC2344.2 +008700 05 ENTRY-3-1 PIC X(15). NC2344.2 +008800 NC2344.2 +008900 01 END-STMT. NC2344.2 +009000 02 FILLER PICTURE X(7) VALUE "AT END ". NC2344.2 +009100 02 END-IDX PICTURE X(7) VALUE SPACES. NC2344.2 +009200 02 FILLER PICTURE XXX VALUE " = ". NC2344.2 +009300 02 IDX-VALU PICTURE 99 VALUE 00. NC2344.2 +009400 02 FILLER PICTURE XXX VALUE SPACES. NC2344.2 +009500 01 NOTE-1. NC2344.2 +009600 02 FILLER PICTURE X(74) VALUE NC2344.2 +009700 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2344.2 +009800- "PATH WAS TAKEN". NC2344.2 +009900 02 FILLER PICTURE X(46) VALUE SPACES. NC2344.2 +010000 01 NOTE-2. NC2344.2 +010100 02 FILLER PICTURE X(112) VALUE NC2344.2 +010200 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2344.2 +010300- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2344.2 +010400 02 FILLER PICTURE X(8) VALUE SPACES. NC2344.2 +010500 01 TEST-RESULTS. NC2344.2 +010600 02 FILLER PIC X VALUE SPACE. NC2344.2 +010700 02 FEATURE PIC X(20) VALUE SPACE. NC2344.2 +010800 02 FILLER PIC X VALUE SPACE. NC2344.2 +010900 02 P-OR-F PIC X(5) VALUE SPACE. NC2344.2 +011000 02 FILLER PIC X VALUE SPACE. NC2344.2 +011100 02 PAR-NAME. NC2344.2 +011200 03 FILLER PIC X(19) VALUE SPACE. NC2344.2 +011300 03 PARDOT-X PIC X VALUE SPACE. NC2344.2 +011400 03 DOTVALUE PIC 99 VALUE ZERO. NC2344.2 +011500 02 FILLER PIC X(8) VALUE SPACE. NC2344.2 +011600 02 RE-MARK PIC X(61). NC2344.2 +011700 01 TEST-COMPUTED. NC2344.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2344.2 +011900 02 FILLER PIC X(17) VALUE NC2344.2 +012000 " COMPUTED=". NC2344.2 +012100 02 COMPUTED-X. NC2344.2 +012200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2344.2 +012300 03 COMPUTED-N REDEFINES COMPUTED-A NC2344.2 +012400 PIC -9(9).9(9). NC2344.2 +012500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2344.2 +012600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2344.2 +012700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2344.2 +012800 03 CM-18V0 REDEFINES COMPUTED-A. NC2344.2 +012900 04 COMPUTED-18V0 PIC -9(18). NC2344.2 +013000 04 FILLER PIC X. NC2344.2 +013100 03 FILLER PIC X(50) VALUE SPACE. NC2344.2 +013200 01 TEST-CORRECT. NC2344.2 +013300 02 FILLER PIC X(30) VALUE SPACE. NC2344.2 +013400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2344.2 +013500 02 CORRECT-X. NC2344.2 +013600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2344.2 +013700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2344.2 +013800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2344.2 +013900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2344.2 +014000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2344.2 +014100 03 CR-18V0 REDEFINES CORRECT-A. NC2344.2 +014200 04 CORRECT-18V0 PIC -9(18). NC2344.2 +014300 04 FILLER PIC X. NC2344.2 +014400 03 FILLER PIC X(2) VALUE SPACE. NC2344.2 +014500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2344.2 +014600 01 CCVS-C-1. NC2344.2 +014700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2344.2 +014800- "SS PARAGRAPH-NAME NC2344.2 +014900- " REMARKS". NC2344.2 +015000 02 FILLER PIC X(20) VALUE SPACE. NC2344.2 +015100 01 CCVS-C-2. NC2344.2 +015200 02 FILLER PIC X VALUE SPACE. NC2344.2 +015300 02 FILLER PIC X(6) VALUE "TESTED". NC2344.2 +015400 02 FILLER PIC X(15) VALUE SPACE. NC2344.2 +015500 02 FILLER PIC X(4) VALUE "FAIL". NC2344.2 +015600 02 FILLER PIC X(94) VALUE SPACE. NC2344.2 +015700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2344.2 +015800 01 REC-CT PIC 99 VALUE ZERO. NC2344.2 +015900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2344.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2344.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2344.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2344.2 +016700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2344.2 +016800 01 CCVS-H-1. NC2344.2 +016900 02 FILLER PIC X(39) VALUE SPACES. NC2344.2 +017000 02 FILLER PIC X(42) VALUE NC2344.2 +017100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2344.2 +017200 02 FILLER PIC X(39) VALUE SPACES. NC2344.2 +017300 01 CCVS-H-2A. NC2344.2 +017400 02 FILLER PIC X(40) VALUE SPACE. NC2344.2 +017500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2344.2 +017600 02 FILLER PIC XXXX VALUE NC2344.2 +017700 "4.2 ". NC2344.2 +017800 02 FILLER PIC X(28) VALUE NC2344.2 +017900 " COPY - NOT FOR DISTRIBUTION". NC2344.2 +018000 02 FILLER PIC X(41) VALUE SPACE. NC2344.2 +018100 NC2344.2 +018200 01 CCVS-H-2B. NC2344.2 +018300 02 FILLER PIC X(15) VALUE NC2344.2 +018400 "TEST RESULT OF ". NC2344.2 +018500 02 TEST-ID PIC X(9). NC2344.2 +018600 02 FILLER PIC X(4) VALUE NC2344.2 +018700 " IN ". NC2344.2 +018800 02 FILLER PIC X(12) VALUE NC2344.2 +018900 " HIGH ". NC2344.2 +019000 02 FILLER PIC X(22) VALUE NC2344.2 +019100 " LEVEL VALIDATION FOR ". NC2344.2 +019200 02 FILLER PIC X(58) VALUE NC2344.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +019400 01 CCVS-H-3. NC2344.2 +019500 02 FILLER PIC X(34) VALUE NC2344.2 +019600 " FOR OFFICIAL USE ONLY ". NC2344.2 +019700 02 FILLER PIC X(58) VALUE NC2344.2 +019800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2344.2 +019900 02 FILLER PIC X(28) VALUE NC2344.2 +020000 " COPYRIGHT 1985 ". NC2344.2 +020100 01 CCVS-E-1. NC2344.2 +020200 02 FILLER PIC X(52) VALUE SPACE. NC2344.2 +020300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2344.2 +020400 02 ID-AGAIN PIC X(9). NC2344.2 +020500 02 FILLER PIC X(45) VALUE SPACES. NC2344.2 +020600 01 CCVS-E-2. NC2344.2 +020700 02 FILLER PIC X(31) VALUE SPACE. NC2344.2 +020800 02 FILLER PIC X(21) VALUE SPACE. NC2344.2 +020900 02 CCVS-E-2-2. NC2344.2 +021000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2344.2 +021100 03 FILLER PIC X VALUE SPACE. NC2344.2 +021200 03 ENDER-DESC PIC X(44) VALUE NC2344.2 +021300 "ERRORS ENCOUNTERED". NC2344.2 +021400 01 CCVS-E-3. NC2344.2 +021500 02 FILLER PIC X(22) VALUE NC2344.2 +021600 " FOR OFFICIAL USE ONLY". NC2344.2 +021700 02 FILLER PIC X(12) VALUE SPACE. NC2344.2 +021800 02 FILLER PIC X(58) VALUE NC2344.2 +021900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +022000 02 FILLER PIC X(13) VALUE SPACE. NC2344.2 +022100 02 FILLER PIC X(15) VALUE NC2344.2 +022200 " COPYRIGHT 1985". NC2344.2 +022300 01 CCVS-E-4. NC2344.2 +022400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2344.2 +022500 02 FILLER PIC X(4) VALUE " OF ". NC2344.2 +022600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2344.2 +022700 02 FILLER PIC X(40) VALUE NC2344.2 +022800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2344.2 +022900 01 XXINFO. NC2344.2 +023000 02 FILLER PIC X(19) VALUE NC2344.2 +023100 "*** INFORMATION ***". NC2344.2 +023200 02 INFO-TEXT. NC2344.2 +023300 04 FILLER PIC X(8) VALUE SPACE. NC2344.2 +023400 04 XXCOMPUTED PIC X(20). NC2344.2 +023500 04 FILLER PIC X(5) VALUE SPACE. NC2344.2 +023600 04 XXCORRECT PIC X(20). NC2344.2 +023700 02 INF-ANSI-REFERENCE PIC X(48). NC2344.2 +023800 01 HYPHEN-LINE. NC2344.2 +023900 02 FILLER PIC IS X VALUE IS SPACE. NC2344.2 +024000 02 FILLER PIC IS X(65) VALUE IS "************************NC2344.2 +024100- "*****************************************". NC2344.2 +024200 02 FILLER PIC IS X(54) VALUE IS "************************NC2344.2 +024300- "******************************". NC2344.2 +024400 01 CCVS-PGM-ID PIC X(9) VALUE NC2344.2 +024500 "NC234A". NC2344.2 +024600 PROCEDURE DIVISION. NC2344.2 +024700 CCVS1 SECTION. NC2344.2 +024800 OPEN-FILES. NC2344.2 +024900 OPEN OUTPUT PRINT-FILE. NC2344.2 +025000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2344.2 +025100 MOVE SPACE TO TEST-RESULTS. NC2344.2 +025200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2344.2 +025300 GO TO CCVS1-EXIT. NC2344.2 +025400 CLOSE-FILES. NC2344.2 +025500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2344.2 +025600 TERMINATE-CCVS. NC2344.2 +025700S EXIT PROGRAM. NC2344.2 +025800STERMINATE-CALL. NC2344.2 +025900 STOP RUN. NC2344.2 +026000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2344.2 +026100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2344.2 +026200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2344.2 +026300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2344.2 +026400 MOVE "****TEST DELETED****" TO RE-MARK. NC2344.2 +026500 PRINT-DETAIL. NC2344.2 +026600 IF REC-CT NOT EQUAL TO ZERO NC2344.2 +026700 MOVE "." TO PARDOT-X NC2344.2 +026800 MOVE REC-CT TO DOTVALUE. NC2344.2 +026900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2344.2 +027000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2344.2 +027100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2344.2 +027200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2344.2 +027300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2344.2 +027400 MOVE SPACE TO CORRECT-X. NC2344.2 +027500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2344.2 +027600 MOVE SPACE TO RE-MARK. NC2344.2 +027700 HEAD-ROUTINE. NC2344.2 +027800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +027900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +028000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2344.2 +028100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2344.2 +028200 COLUMN-NAMES-ROUTINE. NC2344.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +028600 END-ROUTINE. NC2344.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2344.2 +028800 END-RTN-EXIT. NC2344.2 +028900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +029000 END-ROUTINE-1. NC2344.2 +029100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2344.2 +029200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2344.2 +029300 ADD PASS-COUNTER TO ERROR-HOLD. NC2344.2 +029400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2344.2 +029500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2344.2 +029600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2344.2 +029700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2344.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2344.2 +029900 END-ROUTINE-12. NC2344.2 +030000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2344.2 +030100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2344.2 +030200 MOVE "NO " TO ERROR-TOTAL NC2344.2 +030300 ELSE NC2344.2 +030400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2344.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2344.2 +030600 PERFORM WRITE-LINE. NC2344.2 +030700 END-ROUTINE-13. NC2344.2 +030800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2344.2 +030900 MOVE "NO " TO ERROR-TOTAL ELSE NC2344.2 +031000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2344.2 +031100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2344.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031300 IF INSPECT-COUNTER EQUAL TO ZERO NC2344.2 +031400 MOVE "NO " TO ERROR-TOTAL NC2344.2 +031500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2344.2 +031600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2344.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031900 WRITE-LINE. NC2344.2 +032000 ADD 1 TO RECORD-COUNT. NC2344.2 +032100Y IF RECORD-COUNT GREATER 50 NC2344.2 +032200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2344.2 +032300Y MOVE SPACE TO DUMMY-RECORD NC2344.2 +032400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2344.2 +032500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2344.2 +032600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2344.2 +032700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2344.2 +032800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2344.2 +032900Y MOVE ZERO TO RECORD-COUNT. NC2344.2 +033000 PERFORM WRT-LN. NC2344.2 +033100 WRT-LN. NC2344.2 +033200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2344.2 +033300 MOVE SPACE TO DUMMY-RECORD. NC2344.2 +033400 BLANK-LINE-PRINT. NC2344.2 +033500 PERFORM WRT-LN. NC2344.2 +033600 FAIL-ROUTINE. NC2344.2 +033700 IF COMPUTED-X NOT EQUAL TO SPACE NC2344.2 +033800 GO TO FAIL-ROUTINE-WRITE. NC2344.2 +033900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2344.2 +034000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2344.2 +034100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2344.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2344.2 +034400 GO TO FAIL-ROUTINE-EX. NC2344.2 +034500 FAIL-ROUTINE-WRITE. NC2344.2 +034600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2344.2 +034700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2344.2 +034800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2344.2 +034900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2344.2 +035000 FAIL-ROUTINE-EX. EXIT. NC2344.2 +035100 BAIL-OUT. NC2344.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2344.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2344.2 +035400 BAIL-OUT-WRITE. NC2344.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2344.2 +035600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2344.2 +035700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +035800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2344.2 +035900 BAIL-OUT-EX. EXIT. NC2344.2 +036000 CCVS1-EXIT. NC2344.2 +036100 EXIT. NC2344.2 +036200 SECT-NC234A-001 SECTION. NC2344.2 +036300 TH-07-001. NC2344.2 +036400 INITIALISE-TABLE. NC2344.2 +036500 PERFORM BUILD-TABLE VARYING SUB-1 FROM 1 BY 1 NC2344.2 +036600 UNTIL SUB-1 EQUAL TO 11 NC2344.2 +036700 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2344.2 +036800 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2344.2 +036900 GO TO CHECK-ENTRIES. NC2344.2 +037000 NC2344.2 +037100 BUILD-TABLE. NC2344.2 +037200 SET IDX-1 TO SUB-1. NC2344.2 +037300 SET IDX-2 TO SUB-2. NC2344.2 +037400 SET IDX-3 TO SUB-3. NC2344.2 +037500 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2344.2 +037600 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2344.2 +037700 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2344.2 +037800 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2344.2 +037900 SET ADD-ELEM TO IDX-3. NC2344.2 +038000 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2344.2 +038100* NC2344.2 +038200 CHECK-ENTRIES. NC2344.2 +038300 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +038400 MOVE "CHECK-ENTRIES" TO PAR-NAME. NC2344.2 +038500 MOVE "GRP02" TO GRP-HOLD-AREA. NC2344.2 +038600 MOVE 02 TO SUB-2. NC2344.2 +038700 SET IDX-1 TO 1. NC2344.2 +038800 SEARCH GRP-ENTRY VARYING IDX-1 NC2344.2 +038900 AT END NC2344.2 +039000 GO TO CHECK-FAIL NC2344.2 +039100 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2344.2 +039200 PERFORM PASS NC2344.2 +039300 GO TO CHECK-WRITE. NC2344.2 +039400 CHECK-DELETE. NC2344.2 +039500 PERFORM DE-LETE. NC2344.2 +039600 GO TO CHECK-WRITE. NC2344.2 +039700 CHECK-FAIL. NC2344.2 +039800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +039900 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2344.2 +040000 MOVE "IDX-1" TO END-IDX NC2344.2 +040100 SET IDX-VALU TO IDX-1 NC2344.2 +040200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +040300 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +040400 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2344.2 +040500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +040600 PERFORM FAIL. NC2344.2 +040700 CHECK-WRITE. NC2344.2 +040800 PERFORM PRINT-DETAIL. NC2344.2 +040900* NC2344.2 +041000 TH1-INIT-F1-2. NC2344.2 +041100 MOVE "TH1-TEST-F1-2" TO PAR-NAME. NC2344.2 +041200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +041300 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +041400 MOVE "GRP01" TO GRP-HOLD-AREA. NC2344.2 +041500 MOVE 01 TO SUB-2. NC2344.2 +041600 SET IDX-1-1 TO 1. NC2344.2 +041700 TH1-TEST-F1-2. NC2344.2 +041800 SEARCH GRP-ENTRY-1 VARYING IDX-1 NC2344.2 +041900 AT END GO TO TH1-FAIL-F1-2 NC2344.2 +042000 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +042100 PERFORM PASS NC2344.2 +042200 GO TO TH1-WRITE-F1-2. NC2344.2 +042300 TH1-DELETE-F1-2. NC2344.2 +042400 PERFORM DE-LETE. NC2344.2 +042500 GO TO TH1-WRITE-F1-2. NC2344.2 +042600 TH1-FAIL-F1-2. NC2344.2 +042700 PERFORM CHECK-FAIL. NC2344.2 +042800 TH1-WRITE-F1-2. NC2344.2 +042900 PERFORM PRINT-DETAIL. NC2344.2 +043000* NC2344.2 +043100 TH1-INIT-F1-3. NC2344.2 +043200 MOVE "TH1-TEST-F1-3" TO PAR-NAME. NC2344.2 +043300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +043400 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +043500 MOVE "GRP10" TO GRP-HOLD-AREA. NC2344.2 +043600 MOVE 10 TO SUB-2. NC2344.2 +043700 SET IDX-1-1 TO 1. NC2344.2 +043800 TH1-TEST-F1-3. NC2344.2 +043900 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +044000 AT END GO TO TH1-FAIL-F1-3 NC2344.2 +044100 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +044200 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +044300 PERFORM PASS NC2344.2 +044400 GO TO TH1-WRITE-F1-3. NC2344.2 +044500 TH1-DELETE-F1-3. NC2344.2 +044600 PERFORM DE-LETE. NC2344.2 +044700 GO TO TH1-WRITE-F1-3. NC2344.2 +044800 TH1-FAIL-F1-3. NC2344.2 +044900 PERFORM CHECK-FAIL. NC2344.2 +045000 TH1-WRITE-F1-3. NC2344.2 +045100 PERFORM PRINT-DETAIL. NC2344.2 +045200* NC2344.2 +045300 TH1-INIT-F1-4. NC2344.2 +045400 MOVE "TH1-TEST-F1-4" TO PAR-NAME. NC2344.2 +045500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +045600 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +045700 MOVE "GRP05" TO GRP-HOLD-AREA. NC2344.2 +045800 MOVE 05 TO SUB-2. NC2344.2 +045900 SET IDX-1-1 TO 05. NC2344.2 +046000 TH1-TEST-F1-4. NC2344.2 +046100 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +046200 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NC2344.2 +046300 PERFORM PASS NC2344.2 +046400 GO TO TH1-WRITE-F1-4. NC2344.2 +046500 GO TO TH1-FAIL-F1-4. NC2344.2 +046600 TH1-DELETE-F1-4. NC2344.2 +046700 PERFORM DE-LETE. NC2344.2 +046800 GO TO TH1-WRITE-F1-4. NC2344.2 +046900 TH1-FAIL-F1-4. NC2344.2 +047000 PERFORM CHECK-FAIL. NC2344.2 +047100 TH1-WRITE-F1-4. NC2344.2 +047200 PERFORM PRINT-DETAIL. NC2344.2 +047300* NC2344.2 +047400 TH2-INIT-F1-1. NC2344.2 +047500 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +047600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +047700 MOVE "TH2-TEST-F1-1" TO PAR-NAME. NC2344.2 +047800 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2344.2 +047900 MOVE 1 TO SUB-1 SUB-2. NC2344.2 +048000 SET IDX-1-1 IDX-2-1 TO 1. NC2344.2 +048100 TH2-TEST-F1-1. NC2344.2 +048200 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +048300 GO TO TH2-FAIL-F1-1 NC2344.2 +048400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +048500 NEXT SENTENCE. NC2344.2 +048600 PERFORM PASS NC2344.2 +048700 GO TO TH2-WRITE-F1-1. NC2344.2 +048800 TH2-DELETE-F1-1. NC2344.2 +048900 PERFORM DE-LETE. NC2344.2 +049000 GO TO TH2-WRITE-F1-1. NC2344.2 +049100 TH2-FAIL-F1-1. NC2344.2 +049200 PERFORM CHECK-FAIL2. NC2344.2 +049300 TH2-WRITE-F1-1. NC2344.2 +049400 PERFORM PRINT-DETAIL. NC2344.2 +049500 NC2344.2 +049600* NC2344.2 +049700 TH2-INIT-F1-2. NC2344.2 +049800 MOVE "TH2-TEST-F1-2" TO PAR-NAME. NC2344.2 +049900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +050000 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +050100 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2344.2 +050200 MOVE 05 TO SUB-1. NC2344.2 +050300 MOVE 10 TO SUB-2. NC2344.2 +050400 SET IDX-1-1 TO 5. NC2344.2 +050500 SET IDX-2-1 TO 1. NC2344.2 +050600 TH2-TEST-F1-2. NC2344.2 +050700 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +050800 GO TO TH2-FAIL-F1-2 NC2344.2 +050900 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +051000 NEXT SENTENCE. NC2344.2 +051100 PERFORM PASS NC2344.2 +051200 GO TO TH2-WRITE-F1-2. NC2344.2 +051300 TH2-DELETE-F1-2. NC2344.2 +051400 PERFORM DE-LETE. NC2344.2 +051500 GO TO TH2-WRITE-F1-2. NC2344.2 +051600 TH2-FAIL-F1-2. NC2344.2 +051700 PERFORM CHECK-FAIL2. NC2344.2 +051800 TH2-WRITE-F1-2. NC2344.2 +051900 PERFORM PRINT-DETAIL. NC2344.2 +052000* NC2344.2 +052100 TH2-INIT-F1-3. NC2344.2 +052200 MOVE "TH2-TEST-F1-3" TO PAR-NAME. NC2344.2 +052300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +052400 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +052500 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2344.2 +052600 SET IDX-1-1 TO 10. NC2344.2 +052700 SET IDX-2-1 TO 1. NC2344.2 +052800 MOVE 10 TO SUB-1 SUB-2. NC2344.2 +052900 TH2-TEST-F1-3. NC2344.2 +053000 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +053100 GO TO TH2-FAIL-F1-3 NC2344.2 +053200 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +053300 NEXT SENTENCE. NC2344.2 +053400 PERFORM PASS NC2344.2 +053500 GO TO TH2-WRITE-F1-3. NC2344.2 +053600 TH2-DELETE-F1-3. NC2344.2 +053700 PERFORM DE-LETE. NC2344.2 +053800 GO TO TH2-WRITE-F1-3. NC2344.2 +053900 TH2-FAIL-F1-3. NC2344.2 +054000 PERFORM CHECK-FAIL2. NC2344.2 +054100 TH2-WRITE-F1-3. NC2344.2 +054200 PERFORM PRINT-DETAIL. NC2344.2 +054300* NC2344.2 +054400 TH2-INIT-F1-4. NC2344.2 +054500 MOVE "TH2-TEST-F1-4" TO PAR-NAME. NC2344.2 +054600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +054700 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +054800 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2344.2 +054900 MOVE 08 TO SUB-1. NC2344.2 +055000 MOVE 02 TO SUB-2. NC2344.2 +055100 SET IDX-1-1 TO 08. NC2344.2 +055200 SET IDX-2-1 TO 01. NC2344.2 +055300 TH2-TEST-F1-4. NC2344.2 +055400 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +055500 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +055600 PERFORM PASS NC2344.2 +055700 GO TO TH2-WRITE-F1-4. NC2344.2 +055800 GO TO TH2-FAIL-F1-4. NC2344.2 +055900 TH2-DELETE-F1-4. NC2344.2 +056000 PERFORM DE-LETE. NC2344.2 +056100 GO TO TH2-WRITE-F1-4. NC2344.2 +056200 TH2-FAIL-F1-4. NC2344.2 +056300 PERFORM CHECK-FAIL2. NC2344.2 +056400 TH2-WRITE-F1-4. NC2344.2 +056500 PERFORM PRINT-DETAIL. NC2344.2 +056600 GO TO TH3-INIT-F1-1. NC2344.2 +056700 NC2344.2 +056800 CHECK-FAIL2. NC2344.2 +056900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +057000 IF ENTRY-2-1 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2344.2 +057100 MOVE "IDX-2" TO END-IDX NC2344.2 +057200 SET IDX-VALU TO IDX-2 NC2344.2 +057300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +057400 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +057500 MOVE ENTRY-2-1 (SUB-1, SUB-2) TO COMPUTED-A NC2344.2 +057600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +057700 PERFORM FAIL. NC2344.2 +057800* NC2344.2 +057900 TH3-INIT-F1-1. NC2344.2 +058000 MOVE "TH3-TEST-F1-1" TO PAR-NAME. NC2344.2 +058100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +058200 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +058300 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2344.2 +058400 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2344.2 +058500 SET IDX-1-1 IDX-2-1 IDX-3-1 TO 1. NC2344.2 +058600 TH3-TEST-F1-1. NC2344.2 +058700 SEARCH GRP3-ENTRY-1 VARYING IDX-3 NC2344.2 +058800 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +058900 = ELEM-HOLD-AREA NC2344.2 +059000 PERFORM PASS NC2344.2 +059100 GO TO TH3-WRITE-F1-1. NC2344.2 +059200 GO TO TH3-FAIL-F1-1. NC2344.2 +059300 TH3-DELETE-F1-1. NC2344.2 +059400 PERFORM DE-LETE. NC2344.2 +059500 GO TO TH3-WRITE-F1-1. NC2344.2 +059600 TH3-FAIL-F1-1. NC2344.2 +059700 PERFORM CHECK-FAIL3. NC2344.2 +059800 TH3-WRITE-F1-1. NC2344.2 +059900 PERFORM PRINT-DETAIL. NC2344.2 +060000* NC2344.2 +060100 TH3-INIT-F1-2. NC2344.2 +060200 MOVE "TH3-TEST-F1-2" TO PAR-NAME. NC2344.2 +060300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +060400 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +060500 MOVE 05 TO SUB-1. NC2344.2 +060600 MOVE 06 TO SUB-2. NC2344.2 +060700 MOVE 07 TO SUB-3. NC2344.2 +060800 SET IDX-1-1 TO 05. NC2344.2 +060900 SET IDX-2-1 TO 06. NC2344.2 +061000 SET IDX-3-1 TO 1. NC2344.2 +061100 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2344.2 +061200 TH3-TEST-F1-2. NC2344.2 +061300 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +061400 GO TO TH3-FAIL-F1-2 NC2344.2 +061500 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +061600 = ELEM-HOLD-AREA NC2344.2 +061700 NEXT SENTENCE. NC2344.2 +061800 PERFORM PASS NC2344.2 +061900 GO TO TH3-WRITE-F1-2. NC2344.2 +062000 TH3-DELETE-F1-2. NC2344.2 +062100 PERFORM DE-LETE. NC2344.2 +062200 GO TO TH3-WRITE-F1-2. NC2344.2 +062300 TH3-FAIL-F1-2. NC2344.2 +062400 PERFORM CHECK-FAIL3. NC2344.2 +062500 TH3-WRITE-F1-2. NC2344.2 +062600 PERFORM PRINT-DETAIL. NC2344.2 +062700* NC2344.2 +062800 TH3-INIT-F1-3. NC2344.2 +062900 MOVE "TH3-TEST-F1-3" TO PAR-NAME. NC2344.2 +063000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +063100 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +063200 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2344.2 +063300 SET IDX-1-1 IDX-2-1 TO 10. NC2344.2 +063400 SET IDX-3-1 TO 1. NC2344.2 +063500 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2344.2 +063600 TH3-TEST-F1-3. NC2344.2 +063700 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +063800 GO TO TH3-FAIL-F1-3 NC2344.2 +063900 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +064000 = ELEM-HOLD-AREA NC2344.2 +064100 NEXT SENTENCE. NC2344.2 +064200 PERFORM PASS NC2344.2 +064300 GO TO TH3-WRITE-F1-3. NC2344.2 +064400 TH3-DELETE-F1-3. NC2344.2 +064500 PERFORM DE-LETE. NC2344.2 +064600 GO TO TH3-WRITE-F1-3. NC2344.2 +064700 TH3-FAIL-F1-3. NC2344.2 +064800 PERFORM CHECK-FAIL3. NC2344.2 +064900 TH3-WRITE-F1-3. NC2344.2 +065000 PERFORM PRINT-DETAIL. NC2344.2 +065100* NC2344.2 +065200 TH3-INIT-F1-4. NC2344.2 +065300 MOVE "TH3-TEST-F1-4" TO PAR-NAME. NC2344.2 +065400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +065500 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +065600 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2344.2 +065700 MOVE 07 TO SUB-1. NC2344.2 +065800 MOVE 06 TO SUB-2. NC2344.2 +065900 MOVE 05 TO SUB-3. NC2344.2 +066000 SET IDX-1-1 TO 07. NC2344.2 +066100 SET IDX-2-1 TO 06. NC2344.2 +066200 SET IDX-3-1 TO 03. NC2344.2 +066300 TH3-TEST-F1-4. NC2344.2 +066400 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +066500 GO TO TH3-FAIL-F1-4 NC2344.2 +066600 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +066700 = ELEM-HOLD-AREA NC2344.2 +066800 NEXT SENTENCE. NC2344.2 +066900 PERFORM PASS NC2344.2 +067000 GO TO TH3-WRITE-F1-4. NC2344.2 +067100 TH3-DELETE-F1-4. NC2344.2 +067200 PERFORM DE-LETE. NC2344.2 +067300 GO TO TH3-WRITE-F1-4. NC2344.2 +067400 TH3-FAIL-F1-4. NC2344.2 +067500 PERFORM CHECK-FAIL3. NC2344.2 +067600 TH3-WRITE-F1-4. NC2344.2 +067700 PERFORM PRINT-DETAIL. NC2344.2 +067800 GO TO MLT-INIT-F1-1. NC2344.2 +067900* NC2344.2 +068000 CHECK-FAIL3. NC2344.2 +068100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2344.2 +068200 IF ENTRY-3-1 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2344.2 +068300 MOVE "IDX-3-1" TO END-IDX NC2344.2 +068400 SET IDX-VALU TO IDX-3-1 NC2344.2 +068500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +068600 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +068700 MOVE ENTRY-3-1 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2344.2 +068800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +068900 PERFORM FAIL. NC2344.2 +069000* NC2344.2 +069100 MLT-INIT-F1-1. NC2344.2 +069200 MOVE "MLT-TEST-F1-1 " TO PAR-NAME. NC2344.2 +069300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +069400 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2344.2 +069500 MOVE "GRP08" TO GRP-HOLD-AREA. NC2344.2 +069600 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2344.2 +069700 SET IDX-1-1 IDX-2-1 TO 1. NC2344.2 +069800 MLT-TEST-F1-1. NC2344.2 +069900 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +070000 AT END GO TO MLT-FAIL-F1-1-A NC2344.2 +070100 WHEN ENTRY-1-1 (IDX-1-1) = "GRP08" NEXT SENTENCE. NC2344.2 +070200 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +070300 AT END GO TO MLT-FAIL-F1-1-B NC2344.2 +070400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +070500 NEXT SENTENCE. NC2344.2 +070600 PERFORM PASS NC2344.2 +070700 GO TO MLT-WRITE-F1-1. NC2344.2 +070800 MLT-DELETE-F1-1. NC2344.2 +070900 PERFORM DE-LETE. NC2344.2 +071000 GO TO MLT-WRITE-F1-1. NC2344.2 +071100* NC2344.2 +071200 MLT-FAIL-F1-1-A. NC2344.2 +071300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +071400 IF ENTRY-1-1 (08) EQUAL TO GRP-HOLD-AREA NC2344.2 +071500 MOVE "IDX-1-1" TO END-IDX NC2344.2 +071600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +071700 SET IDX-VALU TO IDX-1-1 NC2344.2 +071800 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +071900 MOVE ENTRY-1-1 (08) TO COMPUTED-A NC2344.2 +072000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +072100 PERFORM FAIL NC2344.2 +072200 GO TO MLT-WRITE-F1-1. NC2344.2 +072300* NC2344.2 +072400 MLT-FAIL-F1-1-B. NC2344.2 +072500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +072600 IF ENTRY-2-1 (08, 07) EQUAL TO SEC-HOLD-AREA NC2344.2 +072700 MOVE "IDX-2-1" TO END-IDX NC2344.2 +072800 SET IDX-VALU TO IDX-2-1 NC2344.2 +072900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +073000 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +073100 MOVE ENTRY-2-1 (08, 07) TO COMPUTED-A NC2344.2 +073200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +073300 PERFORM FAIL. NC2344.2 +073400 MLT-WRITE-F1-1. NC2344.2 +073500 PERFORM PRINT-DETAIL. NC2344.2 +073600* NC2344.2 +073700 MLT-INIT-F1-2. NC2344.2 +073800 MOVE "MLT-TEST-F1-2 " TO PAR-NAME. NC2344.2 +073900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +074000 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2344.2 +074100 MOVE "GRP04" TO GRP-HOLD-AREA. NC2344.2 +074200 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2344.2 +074300 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2344.2 +074400 SET IDX-1-1 IDX-2-1 IDX-3-1 TO 1. NC2344.2 +074500 MLT-TEST-F1-2. NC2344.2 +074600 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 AT END NC2344.2 +074700 GO TO MLT-FAIL-F1-2-A WHEN ENTRY-1-1 (IDX-1-1) = NC2344.2 +074800 GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +074900 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +075000 GO TO MLT-FAIL-F1-2-B WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) =NC2344.2 +075100 SEC-HOLD-AREA NEXT SENTENCE. NC2344.2 +075200 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +075300 GO TO MLT-FAIL-F1-2-C WHEN ENTRY-3-1 NC2344.2 +075400 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +075500 = ELEM-HOLD-AREA NEXT SENTENCE. NC2344.2 +075600 PERFORM PASS NC2344.2 +075700 GO TO MLT-WRITE-F1-2. NC2344.2 +075800 MLT-DELETE-F1-2. NC2344.2 +075900 PERFORM DE-LETE NC2344.2 +076000 GO TO MLT-WRITE-F1-2. NC2344.2 +076100 MLT-FAIL-F1-2-A. NC2344.2 +076200 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +076300 IF ENTRY-1-1 (04) EQUAL TO GRP-HOLD-AREA NC2344.2 +076400 MOVE "IDX-1-1" TO END-IDX NC2344.2 +076500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +076600 SET IDX-VALU TO IDX-1-1 NC2344.2 +076700 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +076800 MOVE ENTRY-1-1 (04) TO COMPUTED-A NC2344.2 +076900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +077000 PERFORM FAIL. NC2344.2 +077100 GO TO MLT-WRITE-F1-2. NC2344.2 +077200 NC2344.2 +077300 MLT-FAIL-F1-2-B. NC2344.2 +077400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +077500 IF ENTRY-2-1 (04, 04) EQUAL TO SEC-HOLD-AREA NC2344.2 +077600 MOVE "IDX-2-1" TO END-IDX NC2344.2 +077700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +077800 SET IDX-VALU TO IDX-2-1 NC2344.2 +077900 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +078000 MOVE ENTRY-2-1 (04, 04) TO COMPUTED-A NC2344.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +078200 PERFORM FAIL NC2344.2 +078300 GO TO MLT-WRITE-F1-2. NC2344.2 +078400 NC2344.2 +078500 MLT-FAIL-F1-2-C. NC2344.2 +078600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2344.2 +078700 IF ENTRY-3-1 (04, 04, 04) EQUAL TO ELEM-HOLD-AREA NC2344.2 +078800 MOVE "IDX-3-1" TO END-IDX NC2344.2 +078900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +079000 SET IDX-VALU TO IDX-3-1 NC2344.2 +079100 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +079200 MOVE ENTRY-3-1 (04, 04, 04) TO COMPUTED-A NC2344.2 +079300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +079400 PERFORM FAIL. NC2344.2 +079500 MLT-WRITE-F1-2. NC2344.2 +079600 PERFORM PRINT-DETAIL. NC2344.2 +079700* NC2344.2 +079800 SPC-INIT-F1-1. NC2344.2 +079900 MOVE "SPC-TEST-F1-1" TO PAR-NAME. NC2344.2 +080000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +080100 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +080200 SET IDX-1-1 TO 4. NC2344.2 +080300 SPC-TEST-F1-1. NC2344.2 +080400 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +080500 AT END PERFORM PASS NC2344.2 +080600 GO TO SPC-WRITE-F1-1 NC2344.2 +080700 WHEN ENTRY-1-1 (IDX-1-1) = "GRP03" NC2344.2 +080800 GO TO SPC-FAIL-F1-1. NC2344.2 +080900 SPC-DELETE-F1-1. NC2344.2 +081000 PERFORM DE-LETE. NC2344.2 +081100 GO TO SPC-WRITE-F1-1. NC2344.2 +081200 SPC-FAIL-F1-1. NC2344.2 +081300 MOVE SPACES TO CORRECT-A. NC2344.2 +081400 MOVE ENTRY-1-1 (03) TO COMPUTED-A. NC2344.2 +081500 MOVE SPACES TO RE-MARK. NC2344.2 +081600 PERFORM FAIL. NC2344.2 +081700 SPC-WRITE-F1-1. NC2344.2 +081800 PERFORM PRINT-DETAIL. NC2344.2 +081900* NC2344.2 +082000 SP2-INIT-F1-1. NC2344.2 +082100 MOVE "SP2-TEST-F1-1" TO PAR-NAME. NC2344.2 +082200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +082300 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +082400 SET IDX-1-1 TO 4. NC2344.2 +082500 SET IDX-2-1 TO 5. NC2344.2 +082600 SP2-TEST-F1-1. NC2344.2 +082700 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 AT END NC2344.2 +082800 GO TO SP2-FAIL-F1-1-A NC2344.2 +082900 WHEN ENTRY-1-1 (IDX-1-1) = "GRP04" NEXT SENTENCE. NC2344.2 +083000 SET IDX-1-1 TO 4. NC2344.2 +083100 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +083200 AT END PERFORM PASS NC2344.2 +083300 GO TO SP2-WRITE-F1-1 NC2344.2 +083400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = "SEC (04,04)" NC2344.2 +083500 GO TO SP2-FAIL-F1-1-B. NC2344.2 +083600 SP2-DELETE-F1-1. NC2344.2 +083700 PERFORM DE-LETE. NC2344.2 +083800 GO TO SP2-WRITE-F1-1. NC2344.2 +083900 SP2-FAIL-F1-1-A. NC2344.2 +084000 MOVE "GRP04" TO CORRECT-A. NC2344.2 +084100 IF ENTRY-1-1 (04) EQUAL TO "GRP04" NC2344.2 +084200 MOVE "IDX-2-1" TO END-IDX NC2344.2 +084300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +084400 SET IDX-VALU TO IDX-2-1 NC2344.2 +084500 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +084600 MOVE ENTRY-1-1 (04) TO COMPUTED-A NC2344.2 +084700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +084800 PERFORM FAIL. NC2344.2 +084900 GO TO SP2-WRITE-F1-1. NC2344.2 +085000* NC2344.2 +085100 SP2-FAIL-F1-1-B. NC2344.2 +085200 MOVE ENTRY-2-1 (04, 04) TO COMPUTED-A. NC2344.2 +085300 MOVE SPACES TO CORRECT-A. NC2344.2 +085400 PERFORM FAIL. NC2344.2 +085500 SP2-WRITE-F1-1. NC2344.2 +085600 PERFORM PRINT-DETAIL. NC2344.2 +085700* NC2344.2 +085800 SP3-INIT-F1-1. NC2344.2 +085900 MOVE "SP3-TEST-F1-1" TO PAR-NAME. NC2344.2 +086000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +086100 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +086200 SET IDX-1-1 TO 02. NC2344.2 +086300 SP3-TEST-F1-1. NC2344.2 +086400 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +086500 AT END NC2344.2 +086600 GO TO SP3-FAIL-F1-1-A NC2344.2 +086700 WHEN ENTRY-1-1 (IDX-1-1) EQUAL TO "GRP02" NC2344.2 +086800 NEXT SENTENCE. NC2344.2 +086900 SET IDX-1-1 TO 02. NC2344.2 +087000 SET IDX-2-1 TO 01. NC2344.2 +087100 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +087200 AT END NC2344.2 +087300 GO TO SP3-FAIL-F1-1-B NC2344.2 +087400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = "SEC (02,03)" NC2344.2 +087500 NEXT SENTENCE. NC2344.2 +087600 SET IDX-1-1 TO 02. NC2344.2 +087700 SET IDX-2-1 TO 03. NC2344.2 +087800 SET IDX-3-1 TO 05. NC2344.2 +087900 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 NC2344.2 +088000 AT END PERFORM PASS NC2344.2 +088100 GO TO SP3-WRITE-F1-1 NC2344.2 +088200 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +088300 = "ELEM (02,03,04)" NC2344.2 +088400 GO TO SP3-FAIL-F1-1-C. NC2344.2 +088500 SP3-DELETE-F1-1. NC2344.2 +088600 PERFORM DE-LETE. NC2344.2 +088700 GO TO SP3-WRITE-F1-1. NC2344.2 +088800 SP3-FAIL-F1-1-A. NC2344.2 +088900 MOVE "GRP02" TO CORRECT-A. NC2344.2 +089000 IF ENTRY-1-1 (02) EQUAL TO "GRP02" NC2344.2 +089100 MOVE "IDX-1-1" TO END-IDX NC2344.2 +089200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +089300 SET IDX-VALU TO IDX-1-1 NC2344.2 +089400 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +089500 MOVE ENTRY-1-1 (02) TO COMPUTED-A NC2344.2 +089600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +089700 PERFORM FAIL. NC2344.2 +089800 GO TO SP3-WRITE-F1-1. NC2344.2 +089900* NC2344.2 +090000 SP3-FAIL-F1-1-B. NC2344.2 +090100 MOVE "SEC (02,03)" TO CORRECT-A. NC2344.2 +090200 IF ENTRY-2-1 (02, 03) EQUAL TO "SEC (02,03)" NC2344.2 +090300 MOVE "IDX-2-1" TO END-IDX NC2344.2 +090400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +090500 SET IDX-VALU TO IDX-2-1 NC2344.2 +090600 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +090700 MOVE ENTRY-2-1 (02, 03) TO COMPUTED-A NC2344.2 +090800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +090900 PERFORM FAIL. NC2344.2 +091000 GO TO SP3-WRITE-F1-1. NC2344.2 +091100* NC2344.2 +091200 SP3-FAIL-F1-1-C. NC2344.2 +091300 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2344.2 +091400 MOVE SPACES TO CORRECT-A NC2344.2 +091500 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2344.2 +091600 PERFORM FAIL. NC2344.2 +091700 SP3-WRITE-F1-1. NC2344.2 +091800 PERFORM PRINT-DETAIL. NC2344.2 +091900* NC2344.2 +092000 CCVS-EXIT SECTION. NC2344.2 +092100 CCVS-999999. NC2344.2 +092200 GO TO CLOSE-FILES. NC2344.2 +*END-OF,NC234A +*HEADER,COBOL,NC235A +000100 IDENTIFICATION DIVISION. NC2354.2 +000200 PROGRAM-ID. NC2354.2 +000300 NC235A. NC2354.2 +000400* NC2354.2 +000500**************************************************************** NC2354.2 +000600* * NC2354.2 +000700* VALIDATION FOR:- * NC2354.2 +000800* * NC2354.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +001000* * NC2354.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2354.2 +001200* * NC2354.2 +001300**************************************************************** NC2354.2 +001400* * NC2354.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2354.2 +001600* * NC2354.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2354.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2354.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2354.2 +002000* * NC2354.2 +002100**************************************************************** NC2354.2 +002200* PROGRAM NC235A TESTS THE USE OF FORMATS 1 AND 2 OF THE * NC2354.2 +002300* "SEARCH" STATEMENT ON A ONE DIMENSIONAL TABLE WITH A * NC2354.2 +002400* VARIABLE NUMBER OF OCCURRENCES. THE TABLE IS DEFINED * NC2354.2 +002500* USING FORMAT 2 OF THE "OCCURS" CLAUSE. * NC2354.2 +002600* * NC2354.2 +002700**************************************************************** NC2354.2 +002800 ENVIRONMENT DIVISION. NC2354.2 +002900 CONFIGURATION SECTION. NC2354.2 +003000 SOURCE-COMPUTER. NC2354.2 +003100 XXXXX082. NC2354.2 +003200 OBJECT-COMPUTER. NC2354.2 +003300 XXXXX083. NC2354.2 +003400 INPUT-OUTPUT SECTION. NC2354.2 +003500 FILE-CONTROL. NC2354.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2354.2 +003700 XXXXX055. NC2354.2 +003800 DATA DIVISION. NC2354.2 +003900 FILE SECTION. NC2354.2 +004000 FD PRINT-FILE. NC2354.2 +004100 01 PRINT-REC PICTURE X(120). NC2354.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2354.2 +004300 WORKING-STORAGE SECTION. NC2354.2 +004400 77 TBL-LENGTH PIC 99 VALUE 26. NC2354.2 +004500 77 SUB-1 PIC 99 VALUE ZERO. NC2354.2 +004600 01 TBL-TH309. NC2354.2 +004700 02 TH309-ENTRY OCCURS 1 TO 26 DEPENDING TBL-LENGTH NC2354.2 +004800 DESCENDING KEY IS DEC-KEY INDEXED BY IDX-1, IDX-2, IDX-3.NC2354.2 +004900 03 DEC-KEY PIC XX. NC2354.2 +005000 88 FIRSTZ VALUE "ZZ". NC2354.2 +005100 88 LASTA VALUE "AA". NC2354.2 +005200 88 MIDDLE-PP VALUE "PP". NC2354.2 +005300 01 NOTE-1. NC2354.2 +005400 02 FILLER PIC X(74) VALUE NC2354.2 +005500 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2354.2 +005600- "PATH WAS TAKEN". NC2354.2 +005700 02 FILLER PIC X(46) VALUE SPACE. NC2354.2 +005800 01 NOTE-2. NC2354.2 +005900 02 FILLER PIC X(112) VALUE NC2354.2 +006000 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2354.2 +006100- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2354.2 +006200 02 FILLER PIC X(8) VALUE SPACE. NC2354.2 +006300 01 TEST-RESULTS. NC2354.2 +006400 02 FILLER PIC X VALUE SPACE. NC2354.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. NC2354.2 +006600 02 FILLER PIC X VALUE SPACE. NC2354.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. NC2354.2 +006800 02 FILLER PIC X VALUE SPACE. NC2354.2 +006900 02 PAR-NAME. NC2354.2 +007000 03 FILLER PIC X(19) VALUE SPACE. NC2354.2 +007100 03 PARDOT-X PIC X VALUE SPACE. NC2354.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. NC2354.2 +007300 02 FILLER PIC X(8) VALUE SPACE. NC2354.2 +007400 02 RE-MARK PIC X(61). NC2354.2 +007500 01 TEST-COMPUTED. NC2354.2 +007600 02 FILLER PIC X(30) VALUE SPACE. NC2354.2 +007700 02 FILLER PIC X(17) VALUE NC2354.2 +007800 " COMPUTED=". NC2354.2 +007900 02 COMPUTED-X. NC2354.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2354.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A NC2354.2 +008200 PIC -9(9).9(9). NC2354.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2354.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2354.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2354.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. NC2354.2 +008700 04 COMPUTED-18V0 PIC -9(18). NC2354.2 +008800 04 FILLER PIC X. NC2354.2 +008900 03 FILLER PIC X(50) VALUE SPACE. NC2354.2 +009000 01 TEST-CORRECT. NC2354.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2354.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2354.2 +009300 02 CORRECT-X. NC2354.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2354.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2354.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2354.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2354.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2354.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. NC2354.2 +010000 04 CORRECT-18V0 PIC -9(18). NC2354.2 +010100 04 FILLER PIC X. NC2354.2 +010200 03 FILLER PIC X(2) VALUE SPACE. NC2354.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2354.2 +010400 01 CCVS-C-1. NC2354.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2354.2 +010600- "SS PARAGRAPH-NAME NC2354.2 +010700- " REMARKS". NC2354.2 +010800 02 FILLER PIC X(20) VALUE SPACE. NC2354.2 +010900 01 CCVS-C-2. NC2354.2 +011000 02 FILLER PIC X VALUE SPACE. NC2354.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". NC2354.2 +011200 02 FILLER PIC X(15) VALUE SPACE. NC2354.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". NC2354.2 +011400 02 FILLER PIC X(94) VALUE SPACE. NC2354.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2354.2 +011600 01 REC-CT PIC 99 VALUE ZERO. NC2354.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2354.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2354.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2354.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2354.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2354.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2354.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2354.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2354.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2354.2 +012600 01 CCVS-H-1. NC2354.2 +012700 02 FILLER PIC X(39) VALUE SPACES. NC2354.2 +012800 02 FILLER PIC X(42) VALUE NC2354.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2354.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC2354.2 +013100 01 CCVS-H-2A. NC2354.2 +013200 02 FILLER PIC X(40) VALUE SPACE. NC2354.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2354.2 +013400 02 FILLER PIC XXXX VALUE NC2354.2 +013500 "4.2 ". NC2354.2 +013600 02 FILLER PIC X(28) VALUE NC2354.2 +013700 " COPY - NOT FOR DISTRIBUTION". NC2354.2 +013800 02 FILLER PIC X(41) VALUE SPACE. NC2354.2 +013900 NC2354.2 +014000 01 CCVS-H-2B. NC2354.2 +014100 02 FILLER PIC X(15) VALUE NC2354.2 +014200 "TEST RESULT OF ". NC2354.2 +014300 02 TEST-ID PIC X(9). NC2354.2 +014400 02 FILLER PIC X(4) VALUE NC2354.2 +014500 " IN ". NC2354.2 +014600 02 FILLER PIC X(12) VALUE NC2354.2 +014700 " HIGH ". NC2354.2 +014800 02 FILLER PIC X(22) VALUE NC2354.2 +014900 " LEVEL VALIDATION FOR ". NC2354.2 +015000 02 FILLER PIC X(58) VALUE NC2354.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +015200 01 CCVS-H-3. NC2354.2 +015300 02 FILLER PIC X(34) VALUE NC2354.2 +015400 " FOR OFFICIAL USE ONLY ". NC2354.2 +015500 02 FILLER PIC X(58) VALUE NC2354.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2354.2 +015700 02 FILLER PIC X(28) VALUE NC2354.2 +015800 " COPYRIGHT 1985 ". NC2354.2 +015900 01 CCVS-E-1. NC2354.2 +016000 02 FILLER PIC X(52) VALUE SPACE. NC2354.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2354.2 +016200 02 ID-AGAIN PIC X(9). NC2354.2 +016300 02 FILLER PIC X(45) VALUE SPACES. NC2354.2 +016400 01 CCVS-E-2. NC2354.2 +016500 02 FILLER PIC X(31) VALUE SPACE. NC2354.2 +016600 02 FILLER PIC X(21) VALUE SPACE. NC2354.2 +016700 02 CCVS-E-2-2. NC2354.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2354.2 +016900 03 FILLER PIC X VALUE SPACE. NC2354.2 +017000 03 ENDER-DESC PIC X(44) VALUE NC2354.2 +017100 "ERRORS ENCOUNTERED". NC2354.2 +017200 01 CCVS-E-3. NC2354.2 +017300 02 FILLER PIC X(22) VALUE NC2354.2 +017400 " FOR OFFICIAL USE ONLY". NC2354.2 +017500 02 FILLER PIC X(12) VALUE SPACE. NC2354.2 +017600 02 FILLER PIC X(58) VALUE NC2354.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +017800 02 FILLER PIC X(13) VALUE SPACE. NC2354.2 +017900 02 FILLER PIC X(15) VALUE NC2354.2 +018000 " COPYRIGHT 1985". NC2354.2 +018100 01 CCVS-E-4. NC2354.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2354.2 +018300 02 FILLER PIC X(4) VALUE " OF ". NC2354.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2354.2 +018500 02 FILLER PIC X(40) VALUE NC2354.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2354.2 +018700 01 XXINFO. NC2354.2 +018800 02 FILLER PIC X(19) VALUE NC2354.2 +018900 "*** INFORMATION ***". NC2354.2 +019000 02 INFO-TEXT. NC2354.2 +019100 04 FILLER PIC X(8) VALUE SPACE. NC2354.2 +019200 04 XXCOMPUTED PIC X(20). NC2354.2 +019300 04 FILLER PIC X(5) VALUE SPACE. NC2354.2 +019400 04 XXCORRECT PIC X(20). NC2354.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). NC2354.2 +019600 01 HYPHEN-LINE. NC2354.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. NC2354.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************NC2354.2 +019900- "*****************************************". NC2354.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************NC2354.2 +020100- "******************************". NC2354.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE NC2354.2 +020300 "NC235A". NC2354.2 +020400 PROCEDURE DIVISION. NC2354.2 +020500 CCVS1 SECTION. NC2354.2 +020600 OPEN-FILES. NC2354.2 +020700 OPEN OUTPUT PRINT-FILE. NC2354.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2354.2 +020900 MOVE SPACE TO TEST-RESULTS. NC2354.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2354.2 +021100 GO TO CCVS1-EXIT. NC2354.2 +021200 CLOSE-FILES. NC2354.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2354.2 +021400 TERMINATE-CCVS. NC2354.2 +021500S EXIT PROGRAM. NC2354.2 +021600STERMINATE-CALL. NC2354.2 +021700 STOP RUN. NC2354.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2354.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2354.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2354.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2354.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. NC2354.2 +022300 PRINT-DETAIL. NC2354.2 +022400 IF REC-CT NOT EQUAL TO ZERO NC2354.2 +022500 MOVE "." TO PARDOT-X NC2354.2 +022600 MOVE REC-CT TO DOTVALUE. NC2354.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2354.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2354.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2354.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2354.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2354.2 +023200 MOVE SPACE TO CORRECT-X. NC2354.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2354.2 +023400 MOVE SPACE TO RE-MARK. NC2354.2 +023500 HEAD-ROUTINE. NC2354.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2354.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2354.2 +024000 COLUMN-NAMES-ROUTINE. NC2354.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +024400 END-ROUTINE. NC2354.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2354.2 +024600 END-RTN-EXIT. NC2354.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +024800 END-ROUTINE-1. NC2354.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2354.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2354.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. NC2354.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2354.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2354.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2354.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2354.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2354.2 +025700 END-ROUTINE-12. NC2354.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2354.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2354.2 +026000 MOVE "NO " TO ERROR-TOTAL NC2354.2 +026100 ELSE NC2354.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2354.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2354.2 +026400 PERFORM WRITE-LINE. NC2354.2 +026500 END-ROUTINE-13. NC2354.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2354.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE NC2354.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2354.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2354.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO NC2354.2 +027200 MOVE "NO " TO ERROR-TOTAL NC2354.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2354.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2354.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027700 WRITE-LINE. NC2354.2 +027800 ADD 1 TO RECORD-COUNT. NC2354.2 +027900Y IF RECORD-COUNT GREATER 50 NC2354.2 +028000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2354.2 +028100Y MOVE SPACE TO DUMMY-RECORD NC2354.2 +028200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2354.2 +028300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2354.2 +028400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2354.2 +028500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2354.2 +028600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2354.2 +028700Y MOVE ZERO TO RECORD-COUNT. NC2354.2 +028800 PERFORM WRT-LN. NC2354.2 +028900 WRT-LN. NC2354.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2354.2 +029100 MOVE SPACE TO DUMMY-RECORD. NC2354.2 +029200 BLANK-LINE-PRINT. NC2354.2 +029300 PERFORM WRT-LN. NC2354.2 +029400 FAIL-ROUTINE. NC2354.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2354.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2354.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2354.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2354.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2354.2 +030100 GO TO FAIL-ROUTINE-EX. NC2354.2 +030200 FAIL-ROUTINE-WRITE. NC2354.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2354.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2354.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2354.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2354.2 +030700 FAIL-ROUTINE-EX. EXIT. NC2354.2 +030800 BAIL-OUT. NC2354.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2354.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2354.2 +031100 BAIL-OUT-WRITE. NC2354.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2354.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2354.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2354.2 +031600 BAIL-OUT-EX. EXIT. NC2354.2 +031700 CCVS1-EXIT. NC2354.2 +031800 EXIT. NC2354.2 +031900 SECT-NC235A-001 SECTION. NC2354.2 +032000 TH-08-001. NC2354.2 +032100 INIT-TBL-TH309. NC2354.2 +032200 MOVE "ZZYYXXWWVVUUTTSSRRQQPPOONNMMLLKKJJIIHHGGFFEEDDCCBBAA" NC2354.2 +032300 TO TBL-TH309. NC2354.2 +032400 IF FIRSTZ (1) AND LASTA (26) NC2354.2 +032500 MOVE "26 ENTRY TABLE CONSTRUCTED " TO RE-MARK NC2354.2 +032600 GO TO INIT-WRITE. NC2354.2 +032700 MOVE "TBL ENTRIES BUILT INCORRECT" TO RE-MARK. NC2354.2 +032800 MOVE "*****" TO CORRECT-A COMPUTED-A. NC2354.2 +032900 INIT-WRITE. NC2354.2 +033000 MOVE "INIT-TBL-TH309" TO PAR-NAME. NC2354.2 +033100 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +033200 PERFORM PRINT-DETAIL. NC2354.2 +033300* NC2354.2 +033400 IDX-INIT-F2-1. NC2354.2 +033500 MOVE "IDX-TEST-F2-1 " TO PAR-NAME. NC2354.2 +033600 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +033700 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +033800 SET IDX-2 TO 26. NC2354.2 +033900 IDX-TEST-F2-1. NC2354.2 +034000 SEARCH ALL TH309-ENTRY AT END NC2354.2 +034100 GO TO IDX-FAIL-F2-1 NC2354.2 +034200 WHEN DEC-KEY (IDX-1) EQUAL TO "BB" NEXT SENTENCE. NC2354.2 +034300 PERFORM PASS. NC2354.2 +034400 GO TO IDX-WRITE-F2-1. NC2354.2 +034500 IDX-DELETE-F2-1. NC2354.2 +034600 PERFORM DE-LETE NC2354.2 +034700 GO TO IDX-WRITE-F2-1. NC2354.2 +034800 IDX-FAIL-F2-1. NC2354.2 +034900 MOVE 25 TO SUB-1 NC2354.2 +035000 MOVE "BB" TO CORRECT-A NC2354.2 +035100 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +035200 PERFORM FAIL. NC2354.2 +035300 IDX-WRITE-F2-1. NC2354.2 +035400 PERFORM PRINT-DETAIL. NC2354.2 +035500* NC2354.2 +035600 IDX-INIT-F2-2. NC2354.2 +035700 MOVE "IDX-TEST-F2-2 " TO PAR-NAME. NC2354.2 +035800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +035900 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +036000 SET IDX-3 TO 01. NC2354.2 +036100 IDX-TEST-F2-2. NC2354.2 +036200 SEARCH ALL TH309-ENTRY AT END NC2354.2 +036300 GO TO IDX-FAIL-F2-2 NC2354.2 +036400 WHEN DEC-KEY (IDX-1) EQUAL TO "XX" NC2354.2 +036500 PERFORM PASS NC2354.2 +036600 GO TO IDX-WRITE-F2-2. NC2354.2 +036700 IDX-DELETE-F2-2. NC2354.2 +036800 PERFORM DE-LETE. NC2354.2 +036900 GO TO IDX-WRITE-F2-2. NC2354.2 +037000 IDX-FAIL-F2-2. NC2354.2 +037100 MOVE 03 TO SUB-1 NC2354.2 +037200 MOVE "XX" TO CORRECT-A NC2354.2 +037300 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +037400 PERFORM FAIL. NC2354.2 +037500 IDX-WRITE-F2-2. NC2354.2 +037600 PERFORM PRINT-DETAIL. NC2354.2 +037700* NC2354.2 +037800 IDX-INIT-F2-3. NC2354.2 +037900 MOVE "IDX-TEST-F2-3 " TO PAR-NAME. NC2354.2 +038000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +038100 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +038200 MOVE 25 TO TBL-LENGTH. NC2354.2 +038300 IDX-TEST-F2-3. NC2354.2 +038400 SEARCH ALL TH309-ENTRY AT END NC2354.2 +038500 PERFORM PASS NC2354.2 +038600 GO TO IDX-WRITE-F2-3 NC2354.2 +038700 WHEN DEC-KEY (IDX-1) EQUAL TO "AA" NC2354.2 +038800 GO TO IDX-FAIL-F2-3. NC2354.2 +038900 IDX-DELETE-F2-3. NC2354.2 +039000 PERFORM DE-LETE. NC2354.2 +039100 GO TO IDX-WRITE-F2-3. NC2354.2 +039200 IDX-FAIL-F2-3. NC2354.2 +039300 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +039400 MOVE "AA" TO COMPUTED-A NC2354.2 +039500 PERFORM FAIL. NC2354.2 +039600 IDX-WRITE-F2-3. NC2354.2 +039700 PERFORM PRINT-DETAIL. NC2354.2 +039800* NC2354.2 +039900 IDX-INIT-F1-4. NC2354.2 +040000 MOVE "IDX-TEST-F1-4" TO PAR-NAME. NC2354.2 +040100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +040200 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +040300 MOVE 24 TO TBL-LENGTH. NC2354.2 +040400 SET IDX-3 TO 01. NC2354.2 +040500 IDX-TEST-F1-4. NC2354.2 +040600 SEARCH TH309-ENTRY VARYING IDX-3 AT END NC2354.2 +040700 PERFORM PASS NC2354.2 +040800 GO TO IDX-WRITE-F1-4 NC2354.2 +040900 WHEN DEC-KEY (IDX-3) EQUAL TO "BB" NC2354.2 +041000 GO TO IDX-FAIL-F1-4. NC2354.2 +041100 IDX-DELETE-F1-4. NC2354.2 +041200 PERFORM DE-LETE. NC2354.2 +041300 GO TO IDX-WRITE-F1-4. NC2354.2 +041400 IDX-FAIL-F1-4. NC2354.2 +041500 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +041600 MOVE "BB" TO COMPUTED-A NC2354.2 +041700 PERFORM FAIL. NC2354.2 +041800 IDX-WRITE-F1-4. NC2354.2 +041900 PERFORM PRINT-DETAIL. NC2354.2 +042000* NC2354.2 +042100 IDX-INIT-F1-5. NC2354.2 +042200 MOVE "IDX-TEST-F1-5 " TO PAR-NAME. NC2354.2 +042300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +042400 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +042500 SET IDX-2 TO 01. NC2354.2 +042600 IDX-TEST-F1-5. NC2354.2 +042700 SEARCH TH309-ENTRY VARYING IDX-2 AT END NC2354.2 +042800 GO TO IDX-FAIL-F1-5 NC2354.2 +042900 WHEN DEC-KEY (IDX-2) EQUAL TO "KK" NC2354.2 +043000 PERFORM PASS NC2354.2 +043100 GO TO IDX-WRITE-F1-5. NC2354.2 +043200 IDX-DELETE-F1-5. NC2354.2 +043300 PERFORM DE-LETE. NC2354.2 +043400 GO TO IDX-WRITE-F1-5. NC2354.2 +043500 IDX-FAIL-F1-5. NC2354.2 +043600 MOVE 16 TO SUB-1 NC2354.2 +043700 MOVE "KK" TO CORRECT-A NC2354.2 +043800 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +043900 PERFORM FAIL. NC2354.2 +044000 IDX-WRITE-F1-5. NC2354.2 +044100 PERFORM PRINT-DETAIL. NC2354.2 +044200* NC2354.2 +044300 IDX-INIT-F1-6. NC2354.2 +044400 MOVE "IDX-TEST-F1-6 " TO PAR-NAME. NC2354.2 +044500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +044600 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +044700 MOVE 22 TO TBL-LENGTH. NC2354.2 +044800 SET IDX-1 TO 09. NC2354.2 +044900 IDX-TEST-F1-6. NC2354.2 +045000 SEARCH TH309-ENTRY VARYING IDX-1 AT END NC2354.2 +045100 PERFORM PASS NC2354.2 +045200 GO TO IDX-WRITE-F1-6 NC2354.2 +045300 WHEN TH309-ENTRY (IDX-1) EQUAL TO "DD" NC2354.2 +045400 GO TO IDX-FAIL-F1-6. NC2354.2 +045500 IDX-DELETE-F1-6. NC2354.2 +045600 PERFORM DE-LETE. NC2354.2 +045700 GO TO IDX-WRITE-F1-6. NC2354.2 +045800 IDX-FAIL-F1-6. NC2354.2 +045900 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +046000 MOVE "DD" TO COMPUTED-A NC2354.2 +046100 PERFORM FAIL. NC2354.2 +046200 IDX-WRITE-F1-6. NC2354.2 +046300 PERFORM PRINT-DETAIL. NC2354.2 +046400* NC2354.2 +046500 IDX-INIT-F1-7. NC2354.2 +046600 MOVE "IDX-TEST-F1-7 " TO PAR-NAME. NC2354.2 +046700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +046800 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +046900 MOVE 22 TO TBL-LENGTH. NC2354.2 +047000 SET IDX-3 TO 23. NC2354.2 +047100 IDX-TEST-F1-7. NC2354.2 +047200 SEARCH TH309-ENTRY VARYING IDX-3 AT END NC2354.2 +047300 PERFORM PASS NC2354.2 +047400 GO TO IDX-WRITE-F1-7 NC2354.2 +047500 WHEN TH309-ENTRY (IDX-3) EQUAL TO "DD" NC2354.2 +047600 GO TO IDX-FAIL-F1-7. NC2354.2 +047700 IDX-DELETE-F1-7. NC2354.2 +047800 PERFORM DE-LETE. NC2354.2 +047900 GO TO IDX-WRITE-F1-7. NC2354.2 +048000 IDX-FAIL-F1-7. NC2354.2 +048100 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +048200 MOVE "DD" TO COMPUTED-A NC2354.2 +048300 PERFORM FAIL. NC2354.2 +048400 IDX-WRITE-F1-7. NC2354.2 +048500 PERFORM PRINT-DETAIL. NC2354.2 +048600* NC2354.2 +048700 IDX-INIT-F2-8. NC2354.2 +048800 MOVE "IDX-TEST-F2-8 " TO PAR-NAME. NC2354.2 +048900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +049000 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +049100 MOVE 20 TO TBL-LENGTH. NC2354.2 +049200 SET IDX-2 TO 21. NC2354.2 +049300 IDX-TEST-F2-8. NC2354.2 +049400 SEARCH ALL TH309-ENTRY AT END NC2354.2 +049500 GO TO IDX-FAIL-F2-8 NC2354.2 +049600 WHEN DEC-KEY (IDX-1) EQUAL TO "GG" NC2354.2 +049700 PERFORM PASS NC2354.2 +049800 GO TO IDX-WRITE-F2-8. NC2354.2 +049900 IDX-DELETE-F2-8. NC2354.2 +050000 PERFORM DE-LETE. NC2354.2 +050100 GO TO IDX-WRITE-F2-8. NC2354.2 +050200 IDX-FAIL-F2-8. NC2354.2 +050300 MOVE 20 TO SUB-1 NC2354.2 +050400 MOVE "GG" TO CORRECT-A NC2354.2 +050500 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +050600 PERFORM FAIL. NC2354.2 +050700 IDX-WRITE-F2-8. NC2354.2 +050800 PERFORM PRINT-DETAIL. NC2354.2 +050900* NC2354.2 +051000 IDX-INIT-F2-9. NC2354.2 +051100 MOVE "IDX-TEST-F2-9 " TO PAR-NAME. NC2354.2 +051200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +051300 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +051400 MOVE 20 TO TBL-LENGTH. NC2354.2 +051500 IDX-TEST-F2-9. NC2354.2 +051600 SEARCH ALL TH309-ENTRY AT END NC2354.2 +051700 PERFORM PASS NC2354.2 +051800 GO TO IDX-WRITE-F2-9 NC2354.2 +051900 WHEN LASTA (IDX-1) NC2354.2 +052000 GO TO IDX-FAIL-F2-9. NC2354.2 +052100 IDX-DELETE-F2-9. NC2354.2 +052200 PERFORM DE-LETE. NC2354.2 +052300 GO TO IDX-WRITE-F2-9. NC2354.2 +052400 IDX-FAIL-F2-9. NC2354.2 +052500 MOVE "CONDITION-NAME TEST" TO RE-MARK NC2354.2 +052600 PERFORM FAIL NC2354.2 +052700 MOVE "AA" TO COMPUTED-A. NC2354.2 +052800 IDX-WRITE-F2-9. NC2354.2 +052900 PERFORM PRINT-DETAIL. NC2354.2 +053000* NC2354.2 +053100 IDX-INIT-F2-10. NC2354.2 +053200 MOVE "IDX-TEST-F2-10 " TO PAR-NAME. NC2354.2 +053300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +053400 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +053500 SET IDX-1, IDX-2, IDX-3 TO 10. NC2354.2 +053600 IDX-TEST-F2-10. NC2354.2 +053700 SEARCH ALL TH309-ENTRY AT END NC2354.2 +053800 GO TO IDX-FAIL-F2-10 NC2354.2 +053900 WHEN DEC-KEY (IDX-1) EQUAL TO "RR" NC2354.2 +054000 PERFORM PASS NC2354.2 +054100 GO TO IDX-WRITE-F2-10. NC2354.2 +054200 IDX-DELETE-F2-10. NC2354.2 +054300 PERFORM DE-LETE. NC2354.2 +054400 GO TO IDX-WRITE-F2-10. NC2354.2 +054500 IDX-FAIL-F2-10. NC2354.2 +054600 MOVE 9 TO SUB-1 NC2354.2 +054700 MOVE "RR" TO CORRECT-A NC2354.2 +054800 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +054900 PERFORM FAIL. NC2354.2 +055000 IDX-WRITE-F2-10. NC2354.2 +055100 PERFORM PRINT-DETAIL. NC2354.2 +055200* NC2354.2 +055300 IDX-INIT-F2-11. NC2354.2 +055400 MOVE "IDX-TEST-F2-11 " TO PAR-NAME. NC2354.2 +055500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +055600 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +055700 MOVE 1 TO TBL-LENGTH. NC2354.2 +055800 IDX-TEST-F2-11. NC2354.2 +055900 SEARCH ALL TH309-ENTRY AT END NC2354.2 +056000 PERFORM PASS NC2354.2 +056100 GO TO IDX-WRITE-F2-11 NC2354.2 +056200 WHEN DEC-KEY (IDX-1) EQUAL TO "YY" NC2354.2 +056300 GO TO IDX-FAIL-F2-11. NC2354.2 +056400 IDX-DELETE-F2-11. NC2354.2 +056500 PERFORM DE-LETE. NC2354.2 +056600 GO TO IDX-WRITE-F2-11. NC2354.2 +056700 IDX-FAIL-F2-11. NC2354.2 +056800 MOVE 2 TO SUB-1 NC2354.2 +056900 MOVE "YY" TO COMPUTED-A NC2354.2 +057000 MOVE "ENTRY SHOULD NOT BE FOUND" TO RE-MARK NC2354.2 +057100 PERFORM FAIL. NC2354.2 +057200 IDX-WRITE-F2-11. NC2354.2 +057300 PERFORM PRINT-DETAIL. NC2354.2 +057400* NC2354.2 +057500 IDX-INIT-F2-12. NC2354.2 +057600 MOVE "IDX-TEST-F2-12 " TO PAR-NAME. NC2354.2 +057700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +057800 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +057900 MOVE 10 TO TBL-LENGTH. NC2354.2 +058000 IDX-TEST-F2-12. NC2354.2 +058100 SEARCH ALL TH309-ENTRY AT END NC2354.2 +058200 PERFORM PASS NC2354.2 +058300 GO TO IDX-WRITE-F2-12 NC2354.2 +058400 WHEN MIDDLE-PP (IDX-1) NC2354.2 +058500 GO TO IDX-FAIL-F2-12. NC2354.2 +058600 IDX-DELETE-F2-12. NC2354.2 +058700 PERFORM DE-LETE. NC2354.2 +058800 GO TO IDX-WRITE-F2-12. NC2354.2 +058900 IDX-FAIL-F2-12. NC2354.2 +059000 MOVE 10 TO SUB-1 NC2354.2 +059100 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +059200 MOVE "PP" TO COMPUTED-A NC2354.2 +059300 PERFORM FAIL. NC2354.2 +059400 IDX-WRITE-F2-12. NC2354.2 +059500 PERFORM PRINT-DETAIL. NC2354.2 +059600* NC2354.2 +059700 IDX-INIT-F2-13. NC2354.2 +059800 MOVE "IDX-TEST-F2-13 " TO PAR-NAME. NC2354.2 +059900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +060000 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +060100 MOVE 2 TO TBL-LENGTH. NC2354.2 +060200 IDX-TEST-F2-13. NC2354.2 +060300 SEARCH ALL TH309-ENTRY AT END NC2354.2 +060400 PERFORM PASS NC2354.2 +060500 GO TO IDX-WRITE-F2-13 NC2354.2 +060600 WHEN DEC-KEY (IDX-1) EQUAL TO "XX" NC2354.2 +060700 GO TO IDX-FAIL-F2-13. NC2354.2 +060800 IDX-DELETE-F2-13. NC2354.2 +060900 PERFORM DE-LETE. NC2354.2 +061000 GO TO IDX-WRITE-F2-13. NC2354.2 +061100 IDX-FAIL-F2-13. NC2354.2 +061200 MOVE "XX" TO COMPUTED-A NC2354.2 +061300 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +061400 PERFORM FAIL. NC2354.2 +061500 IDX-WRITE-F2-13. NC2354.2 +061600 PERFORM PRINT-DETAIL. NC2354.2 +061700 GO TO CCVS-EXIT. NC2354.2 +061800* NC2354.2 +061900 PUTOUT-COMPUTED-A. NC2354.2 +062000 IF TH309-ENTRY (SUB-1) EQUAL TO CORRECT-A NC2354.2 +062100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2354.2 +062200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK. NC2354.2 +062300 MOVE TH309-ENTRY (SUB-1) TO COMPUTED-A. NC2354.2 +062400 CCVS-EXIT SECTION. NC2354.2 +062500 CCVS-999999. NC2354.2 +062600 GO TO CLOSE-FILES. NC2354.2 +*END-OF,NC235A +*HEADER,COBOL,NC236A +000100 IDENTIFICATION DIVISION. NC2364.2 +000200 PROGRAM-ID. NC2364.2 +000300 NC236A. NC2364.2 +000400**************************************************************** NC2364.2 +000500* * NC2364.2 +000600* VALIDATION FOR:- * NC2364.2 +000700* * NC2364.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +000900* * NC2364.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2364.2 +001100* * NC2364.2 +001200**************************************************************** NC2364.2 +001300* * NC2364.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2364.2 +001500* * NC2364.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2364.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2364.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2364.2 +001900* * NC2364.2 +002000**************************************************************** NC2364.2 +002100 NC2364.2 +002200* * NC2364.2 +002300* PROGRAM NC236A TESTS FORMAT 1 OF THE "SEARCH" STATEMENT * NC2364.2 +002400* USING TWO-DIMAENSIONAL TABKES WHICH HAVE BEEN REDEFINED. * NC2364.2 +002500* THE OPTIONAL "VARYING" AND "AT END" PHRASES ARE USED. * NC2364.2 +002600* * NC2364.2 +002700**************************************************************** NC2364.2 +002800 ENVIRONMENT DIVISION. NC2364.2 +002900 CONFIGURATION SECTION. NC2364.2 +003000 SOURCE-COMPUTER. NC2364.2 +003100 XXXXX082. NC2364.2 +003200 OBJECT-COMPUTER. NC2364.2 +003300 XXXXX083. NC2364.2 +003400 INPUT-OUTPUT SECTION. NC2364.2 +003500 FILE-CONTROL. NC2364.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2364.2 +003700 XXXXX055. NC2364.2 +003800 DATA DIVISION. NC2364.2 +003900 FILE SECTION. NC2364.2 +004000 FD PRINT-FILE. NC2364.2 +004100 01 PRINT-REC PICTURE X(120). NC2364.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2364.2 +004300 WORKING-STORAGE SECTION. NC2364.2 +004400 01 NOTE-1. NC2364.2 +004500 02 FILLER PIC X(74) VALUE NC2364.2 +004600 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2364.2 +004700- "PATH WAS TAKEN". NC2364.2 +004800 02 FILLER PIC X(46) VALUE SPACES. NC2364.2 +004900 01 NOTE-2. NC2364.2 +005000 02 FILLER PIC X(112) VALUE NC2364.2 +005100 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2364.2 +005200- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2364.2 +005300 02 FILLER PIC X(8) VALUE SPACES. NC2364.2 +005400 01 TABLE-A PIC X(20) VALUE "01020304050607080910". NC2364.2 +005500 01 TABLE-1 REDEFINES TABLE-A. NC2364.2 +005600 02 TBL-A OCCURS 10 TIMES INDEXED BY A. NC2364.2 +005700 03 ELMT-A PIC 99. NC2364.2 +005800 01 W USAGE INDEX. NC2364.2 +005900 01 INDEX-VALUE PIC 9999. NC2364.2 +006000 01 TABLE-B PIC X(20) VALUE "01020304050607080910". NC2364.2 +006100 01 TABLE-2 REDEFINES TABLE-B. NC2364.2 +006200 02 TBL-B OCCURS 10 TIMES INDEXED BY B. NC2364.2 +006300 03 ELMT-B PIC 99. NC2364.2 +006400 01 TEST-RESULTS. NC2364.2 +006500 02 FILLER PIC X VALUE SPACE. NC2364.2 +006600 02 FEATURE PIC X(20) VALUE SPACE. NC2364.2 +006700 02 FILLER PIC X VALUE SPACE. NC2364.2 +006800 02 P-OR-F PIC X(5) VALUE SPACE. NC2364.2 +006900 02 FILLER PIC X VALUE SPACE. NC2364.2 +007000 02 PAR-NAME. NC2364.2 +007100 03 FILLER PIC X(19) VALUE SPACE. NC2364.2 +007200 03 PARDOT-X PIC X VALUE SPACE. NC2364.2 +007300 03 DOTVALUE PIC 99 VALUE ZERO. NC2364.2 +007400 02 FILLER PIC X(8) VALUE SPACE. NC2364.2 +007500 02 RE-MARK PIC X(61). NC2364.2 +007600 01 TEST-COMPUTED. NC2364.2 +007700 02 FILLER PIC X(30) VALUE SPACE. NC2364.2 +007800 02 FILLER PIC X(17) VALUE NC2364.2 +007900 " COMPUTED=". NC2364.2 +008000 02 COMPUTED-X. NC2364.2 +008100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2364.2 +008200 03 COMPUTED-N REDEFINES COMPUTED-A NC2364.2 +008300 PIC -9(9).9(9). NC2364.2 +008400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2364.2 +008500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2364.2 +008600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2364.2 +008700 03 CM-18V0 REDEFINES COMPUTED-A. NC2364.2 +008800 04 COMPUTED-18V0 PIC -9(18). NC2364.2 +008900 04 FILLER PIC X. NC2364.2 +009000 03 FILLER PIC X(50) VALUE SPACE. NC2364.2 +009100 01 TEST-CORRECT. NC2364.2 +009200 02 FILLER PIC X(30) VALUE SPACE. NC2364.2 +009300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2364.2 +009400 02 CORRECT-X. NC2364.2 +009500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2364.2 +009600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2364.2 +009700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2364.2 +009800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2364.2 +009900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2364.2 +010000 03 CR-18V0 REDEFINES CORRECT-A. NC2364.2 +010100 04 CORRECT-18V0 PIC -9(18). NC2364.2 +010200 04 FILLER PIC X. NC2364.2 +010300 03 FILLER PIC X(2) VALUE SPACE. NC2364.2 +010400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2364.2 +010500 01 CCVS-C-1. NC2364.2 +010600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2364.2 +010700- "SS PARAGRAPH-NAME NC2364.2 +010800- " REMARKS". NC2364.2 +010900 02 FILLER PIC X(20) VALUE SPACE. NC2364.2 +011000 01 CCVS-C-2. NC2364.2 +011100 02 FILLER PIC X VALUE SPACE. NC2364.2 +011200 02 FILLER PIC X(6) VALUE "TESTED". NC2364.2 +011300 02 FILLER PIC X(15) VALUE SPACE. NC2364.2 +011400 02 FILLER PIC X(4) VALUE "FAIL". NC2364.2 +011500 02 FILLER PIC X(94) VALUE SPACE. NC2364.2 +011600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2364.2 +011700 01 REC-CT PIC 99 VALUE ZERO. NC2364.2 +011800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2364.2 +011900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2364.2 +012300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2364.2 +012400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2364.2 +012500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2364.2 +012600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2364.2 +012700 01 CCVS-H-1. NC2364.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC2364.2 +012900 02 FILLER PIC X(42) VALUE NC2364.2 +013000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2364.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC2364.2 +013200 01 CCVS-H-2A. NC2364.2 +013300 02 FILLER PIC X(40) VALUE SPACE. NC2364.2 +013400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2364.2 +013500 02 FILLER PIC XXXX VALUE NC2364.2 +013600 "4.2 ". NC2364.2 +013700 02 FILLER PIC X(28) VALUE NC2364.2 +013800 " COPY - NOT FOR DISTRIBUTION". NC2364.2 +013900 02 FILLER PIC X(41) VALUE SPACE. NC2364.2 +014000 NC2364.2 +014100 01 CCVS-H-2B. NC2364.2 +014200 02 FILLER PIC X(15) VALUE NC2364.2 +014300 "TEST RESULT OF ". NC2364.2 +014400 02 TEST-ID PIC X(9). NC2364.2 +014500 02 FILLER PIC X(4) VALUE NC2364.2 +014600 " IN ". NC2364.2 +014700 02 FILLER PIC X(12) VALUE NC2364.2 +014800 " HIGH ". NC2364.2 +014900 02 FILLER PIC X(22) VALUE NC2364.2 +015000 " LEVEL VALIDATION FOR ". NC2364.2 +015100 02 FILLER PIC X(58) VALUE NC2364.2 +015200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +015300 01 CCVS-H-3. NC2364.2 +015400 02 FILLER PIC X(34) VALUE NC2364.2 +015500 " FOR OFFICIAL USE ONLY ". NC2364.2 +015600 02 FILLER PIC X(58) VALUE NC2364.2 +015700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2364.2 +015800 02 FILLER PIC X(28) VALUE NC2364.2 +015900 " COPYRIGHT 1985 ". NC2364.2 +016000 01 CCVS-E-1. NC2364.2 +016100 02 FILLER PIC X(52) VALUE SPACE. NC2364.2 +016200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2364.2 +016300 02 ID-AGAIN PIC X(9). NC2364.2 +016400 02 FILLER PIC X(45) VALUE SPACES. NC2364.2 +016500 01 CCVS-E-2. NC2364.2 +016600 02 FILLER PIC X(31) VALUE SPACE. NC2364.2 +016700 02 FILLER PIC X(21) VALUE SPACE. NC2364.2 +016800 02 CCVS-E-2-2. NC2364.2 +016900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2364.2 +017000 03 FILLER PIC X VALUE SPACE. NC2364.2 +017100 03 ENDER-DESC PIC X(44) VALUE NC2364.2 +017200 "ERRORS ENCOUNTERED". NC2364.2 +017300 01 CCVS-E-3. NC2364.2 +017400 02 FILLER PIC X(22) VALUE NC2364.2 +017500 " FOR OFFICIAL USE ONLY". NC2364.2 +017600 02 FILLER PIC X(12) VALUE SPACE. NC2364.2 +017700 02 FILLER PIC X(58) VALUE NC2364.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +017900 02 FILLER PIC X(13) VALUE SPACE. NC2364.2 +018000 02 FILLER PIC X(15) VALUE NC2364.2 +018100 " COPYRIGHT 1985". NC2364.2 +018200 01 CCVS-E-4. NC2364.2 +018300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2364.2 +018400 02 FILLER PIC X(4) VALUE " OF ". NC2364.2 +018500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2364.2 +018600 02 FILLER PIC X(40) VALUE NC2364.2 +018700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2364.2 +018800 01 XXINFO. NC2364.2 +018900 02 FILLER PIC X(19) VALUE NC2364.2 +019000 "*** INFORMATION ***". NC2364.2 +019100 02 INFO-TEXT. NC2364.2 +019200 04 FILLER PIC X(8) VALUE SPACE. NC2364.2 +019300 04 XXCOMPUTED PIC X(20). NC2364.2 +019400 04 FILLER PIC X(5) VALUE SPACE. NC2364.2 +019500 04 XXCORRECT PIC X(20). NC2364.2 +019600 02 INF-ANSI-REFERENCE PIC X(48). NC2364.2 +019700 01 HYPHEN-LINE. NC2364.2 +019800 02 FILLER PIC IS X VALUE IS SPACE. NC2364.2 +019900 02 FILLER PIC IS X(65) VALUE IS "************************NC2364.2 +020000- "*****************************************". NC2364.2 +020100 02 FILLER PIC IS X(54) VALUE IS "************************NC2364.2 +020200- "******************************". NC2364.2 +020300 01 CCVS-PGM-ID PIC X(9) VALUE NC2364.2 +020400 "NC236A". NC2364.2 +020500 PROCEDURE DIVISION. NC2364.2 +020600 CCVS1 SECTION. NC2364.2 +020700 OPEN-FILES. NC2364.2 +020800 OPEN OUTPUT PRINT-FILE. NC2364.2 +020900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2364.2 +021000 MOVE SPACE TO TEST-RESULTS. NC2364.2 +021100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2364.2 +021200 GO TO CCVS1-EXIT. NC2364.2 +021300 CLOSE-FILES. NC2364.2 +021400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2364.2 +021500 TERMINATE-CCVS. NC2364.2 +021600S EXIT PROGRAM. NC2364.2 +021700STERMINATE-CALL. NC2364.2 +021800 STOP RUN. NC2364.2 +021900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2364.2 +022000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2364.2 +022100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2364.2 +022200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2364.2 +022300 MOVE "****TEST DELETED****" TO RE-MARK. NC2364.2 +022400 PRINT-DETAIL. NC2364.2 +022500 IF REC-CT NOT EQUAL TO ZERO NC2364.2 +022600 MOVE "." TO PARDOT-X NC2364.2 +022700 MOVE REC-CT TO DOTVALUE. NC2364.2 +022800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2364.2 +022900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2364.2 +023000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2364.2 +023100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2364.2 +023200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2364.2 +023300 MOVE SPACE TO CORRECT-X. NC2364.2 +023400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2364.2 +023500 MOVE SPACE TO RE-MARK. NC2364.2 +023600 HEAD-ROUTINE. NC2364.2 +023700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +023800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +023900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2364.2 +024000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2364.2 +024100 COLUMN-NAMES-ROUTINE. NC2364.2 +024200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +024300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +024500 END-ROUTINE. NC2364.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2364.2 +024700 END-RTN-EXIT. NC2364.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +024900 END-ROUTINE-1. NC2364.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2364.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2364.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. NC2364.2 +025300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2364.2 +025400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2364.2 +025500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2364.2 +025600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2364.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2364.2 +025800 END-ROUTINE-12. NC2364.2 +025900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2364.2 +026000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2364.2 +026100 MOVE "NO " TO ERROR-TOTAL NC2364.2 +026200 ELSE NC2364.2 +026300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2364.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2364.2 +026500 PERFORM WRITE-LINE. NC2364.2 +026600 END-ROUTINE-13. NC2364.2 +026700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2364.2 +026800 MOVE "NO " TO ERROR-TOTAL ELSE NC2364.2 +026900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2364.2 +027000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2364.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027200 IF INSPECT-COUNTER EQUAL TO ZERO NC2364.2 +027300 MOVE "NO " TO ERROR-TOTAL NC2364.2 +027400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2364.2 +027500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2364.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027800 WRITE-LINE. NC2364.2 +027900 ADD 1 TO RECORD-COUNT. NC2364.2 +028000Y IF RECORD-COUNT GREATER 50 NC2364.2 +028100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2364.2 +028200Y MOVE SPACE TO DUMMY-RECORD NC2364.2 +028300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2364.2 +028400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2364.2 +028500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2364.2 +028600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2364.2 +028700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2364.2 +028800Y MOVE ZERO TO RECORD-COUNT. NC2364.2 +028900 PERFORM WRT-LN. NC2364.2 +029000 WRT-LN. NC2364.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2364.2 +029200 MOVE SPACE TO DUMMY-RECORD. NC2364.2 +029300 BLANK-LINE-PRINT. NC2364.2 +029400 PERFORM WRT-LN. NC2364.2 +029500 FAIL-ROUTINE. NC2364.2 +029600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2364.2 +029700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2364.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2364.2 +029900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2364.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2364.2 +030200 GO TO FAIL-ROUTINE-EX. NC2364.2 +030300 FAIL-ROUTINE-WRITE. NC2364.2 +030400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2364.2 +030500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2364.2 +030600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2364.2 +030700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2364.2 +030800 FAIL-ROUTINE-EX. EXIT. NC2364.2 +030900 BAIL-OUT. NC2364.2 +031000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2364.2 +031100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2364.2 +031200 BAIL-OUT-WRITE. NC2364.2 +031300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2364.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2364.2 +031500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +031600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2364.2 +031700 BAIL-OUT-EX. EXIT. NC2364.2 +031800 CCVS1-EXIT. NC2364.2 +031900 EXIT. NC2364.2 +032000 SECT-NC236A-001 SECTION. NC2364.2 +032100 TH-09-001. NC2364.2 +032200 SCH-INIT-F1-1. NC2364.2 +032300 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2364.2 +032400 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +032500 MOVE "SEARCH " TO FEATURE. NC2364.2 +032600 SET A TO 01. NC2364.2 +032700 SET W TO A. NC2364.2 +032800 SCH-TEST-F1-1. NC2364.2 +032900 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-1 NC2364.2 +033000 WHEN ELMT-A (A) EQUAL TO 05 NC2364.2 +033100 SET A TO W. NC2364.2 +033200 IF ELMT-A (A) EQUAL TO 05 NC2364.2 +033300 PERFORM PASS NC2364.2 +033400 GO TO SCH-WRITE-F1-1. NC2364.2 +033500 SCH-DELETE-F1-1. NC2364.2 +033600 PERFORM DE-LETE. NC2364.2 +033700 GO TO SCH-WRITE-F1-1. NC2364.2 +033800 SCH-FAIL-F1-1. NC2364.2 +033900 IF ELMT-A (05) EQUAL TO 05 NC2364.2 +034000 MOVE 05 TO CORRECT-18V0 NC2364.2 +034100 MOVE ELMT-A (05) TO COMPUTED-18V0 NC2364.2 +034200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +034300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +034400 MOVE ELMT-A (05) TO COMPUTED-18V0 NC2364.2 +034500 MOVE 05 TO CORRECT-18V0. NC2364.2 +034600 PERFORM FAIL. NC2364.2 +034700 SCH-WRITE-F1-1. NC2364.2 +034800 PERFORM PRINT-DETAIL. NC2364.2 +034900* NC2364.2 +035000 SCH-INIT-F1-2. NC2364.2 +035100 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2364.2 +035200 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +035300 MOVE "SEARCH " TO FEATURE. NC2364.2 +035400 SET A TO 09. NC2364.2 +035500 SET W TO A. NC2364.2 +035600 SCH-TEST-F1-2. NC2364.2 +035700 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-2 NC2364.2 +035800 WHEN ELMT-A (A) EQUAL TO 10 NC2364.2 +035900 SET A TO W. NC2364.2 +036000 IF ELMT-A (A) EQUAL TO 10 NC2364.2 +036100 PERFORM PASS NC2364.2 +036200 GO TO SCH-WRITE-F1-2. NC2364.2 +036300 SCH-DELETE-F1-2. NC2364.2 +036400 PERFORM DE-LETE. NC2364.2 +036500 GO TO SCH-WRITE-F1-2. NC2364.2 +036600 SCH-FAIL-F1-2. NC2364.2 +036700 IF ELMT-A (10) EQUAL TO 10 NC2364.2 +036800 MOVE 10 TO CORRECT-18V0 NC2364.2 +036900 MOVE ELMT-A (10) TO COMPUTED-18V0 NC2364.2 +037000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +037100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +037200 MOVE ELMT-A (10) TO COMPUTED-18V0 NC2364.2 +037300 MOVE 10 TO CORRECT-18V0. NC2364.2 +037400 PERFORM FAIL. NC2364.2 +037500 SCH-WRITE-F1-2. NC2364.2 +037600 PERFORM PRINT-DETAIL. NC2364.2 +037700* NC2364.2 +037800 SCH-INIT-F1-3. NC2364.2 +037900 MOVE "SCH-TEST-F1-3" TO PAR-NAME. NC2364.2 +038000 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +038100 MOVE "SEARCH " TO FEATURE. NC2364.2 +038200 SET A TO 02. NC2364.2 +038300 SET W TO A. NC2364.2 +038400 SCH-TEST-F1-3. NC2364.2 +038500 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-3 NC2364.2 +038600 WHEN ELMT-A (A) EQUAL TO 02 NC2364.2 +038700 SET A TO W. NC2364.2 +038800 IF ELMT-A (A) EQUAL TO 02 NC2364.2 +038900 PERFORM PASS NC2364.2 +039000 GO TO SCH-WRITE-F1-3. NC2364.2 +039100 SCH-DELETE-F1-3. NC2364.2 +039200 PERFORM DE-LETE. NC2364.2 +039300 GO TO SCH-WRITE-F1-3. NC2364.2 +039400 SCH-FAIL-F1-3. NC2364.2 +039500 IF ELMT-A (02) EQUAL TO 02 NC2364.2 +039600 MOVE 02 TO CORRECT-18V0 NC2364.2 +039700 MOVE ELMT-A (02) TO COMPUTED-18V0 NC2364.2 +039800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +039900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +040000 MOVE ELMT-A (02) TO COMPUTED-18V0 NC2364.2 +040100 MOVE 02 TO CORRECT-18V0. NC2364.2 +040200 PERFORM FAIL. NC2364.2 +040300 SCH-WRITE-F1-3. NC2364.2 +040400 PERFORM PRINT-DETAIL. NC2364.2 +040500* NC2364.2 +040600 SCH-INIT-F1-4. NC2364.2 +040700 MOVE "SCH-TEST-F1-4" TO PAR-NAME. NC2364.2 +040800 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +040900 MOVE "SEARCH " TO FEATURE. NC2364.2 +041000 SET A TO 07. NC2364.2 +041100 SET W TO A. NC2364.2 +041200 SCH-TEST-F1-4. NC2364.2 +041300 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-4 NC2364.2 +041400 WHEN ELMT-A (A) EQUAL TO 07 NC2364.2 +041500 SET A TO W. NC2364.2 +041600 IF ELMT-A (A) EQUAL TO 07 NC2364.2 +041700 PERFORM PASS NC2364.2 +041800 GO TO SCH-WRITE-F1-4. NC2364.2 +041900 SCH-DELETE-F1-4. NC2364.2 +042000 PERFORM DE-LETE. NC2364.2 +042100 GO TO SCH-WRITE-F1-4. NC2364.2 +042200 SCH-FAIL-F1-4. NC2364.2 +042300 IF ELMT-A (07) EQUAL TO 07 NC2364.2 +042400 MOVE 07 TO CORRECT-18V0 NC2364.2 +042500 MOVE ELMT-A (07) TO COMPUTED-18V0 NC2364.2 +042600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +042700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +042800 MOVE ELMT-A (07) TO COMPUTED-18V0 NC2364.2 +042900 MOVE 07 TO CORRECT-18V0. NC2364.2 +043000 PERFORM FAIL. NC2364.2 +043100 SCH-WRITE-F1-4. NC2364.2 +043200 PERFORM PRINT-DETAIL. NC2364.2 +043300* NC2364.2 +043400 SCH-INIT-F1-5. NC2364.2 +043500 MOVE "SCH-TEST-F1-5" TO PAR-NAME. NC2364.2 +043600 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +043700 MOVE "SEARCH " TO FEATURE. NC2364.2 +043800 SET A TO 03. NC2364.2 +043900 SET W TO A. NC2364.2 +044000 SCH-TEST-F1-5. NC2364.2 +044100 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-5 NC2364.2 +044200 WHEN ELMT-A (A) EQUAL TO 08 NC2364.2 +044300 SET A TO W. NC2364.2 +044400 IF ELMT-A (A) EQUAL TO 08 NC2364.2 +044500 PERFORM PASS NC2364.2 +044600 GO TO SCH-WRITE-F1-5. NC2364.2 +044700 SCH-DELETE-F1-5. NC2364.2 +044800 PERFORM DE-LETE. NC2364.2 +044900 GO TO SCH-WRITE-F1-5. NC2364.2 +045000 SCH-FAIL-F1-5. NC2364.2 +045100 IF ELMT-A (08) EQUAL TO 08 NC2364.2 +045200 MOVE 08 TO CORRECT-18V0 NC2364.2 +045300 MOVE ELMT-A (08) TO COMPUTED-18V0 NC2364.2 +045400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +045500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +045600 MOVE ELMT-A (08) TO COMPUTED-18V0 NC2364.2 +045700 MOVE 08 TO CORRECT-18V0. NC2364.2 +045800 PERFORM FAIL. NC2364.2 +045900 SCH-WRITE-F1-5. NC2364.2 +046000 PERFORM PRINT-DETAIL. NC2364.2 +046100* NC2364.2 +046200 SCH-INIT-F1-6. NC2364.2 +046300 MOVE "SCH-TEST-F1-6" TO PAR-NAME. NC2364.2 +046400 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +046500 MOVE "SEARCH " TO FEATURE. NC2364.2 +046600 SET A B TO 01. NC2364.2 +046700 SCH-TEST-F1-6. NC2364.2 +046800 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-6 NC2364.2 +046900 WHEN ELMT-B (B) EQUAL TO ELMT-A (8) NC2364.2 +047000 PERFORM PASS NC2364.2 +047100 GO TO SCH-WRITE-F1-6. NC2364.2 +047200 SCH-DELETE-F1-6. NC2364.2 +047300 PERFORM DE-LETE. NC2364.2 +047400 GO TO SCH-WRITE-F1-6. NC2364.2 +047500 SCH-FAIL-F1-6. NC2364.2 +047600 IF ELMT-B (8) EQUAL TO ELMT-A (8) NC2364.2 +047700 MOVE 08 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +047800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +047900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +048000 MOVE ELMT-B (8) TO COMPUTED-18V0 NC2364.2 +048100 MOVE ELMT-A (8) TO CORRECT-18V0. NC2364.2 +048200 PERFORM FAIL. NC2364.2 +048300 SCH-WRITE-F1-6. NC2364.2 +048400 PERFORM PRINT-DETAIL. NC2364.2 +048500* NC2364.2 +048600 SCH-INIT-F1-7. NC2364.2 +048700 MOVE "SCH-TEST-F1-7" TO PAR-NAME. NC2364.2 +048800 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +048900 MOVE "SEARCH " TO FEATURE. NC2364.2 +049000 SET A B TO 05. NC2364.2 +049100 SCH-TEST-F1-7. NC2364.2 +049200 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-7 NC2364.2 +049300 WHEN ELMT-B (B) EQUAL TO ELMT-A (10) NC2364.2 +049400 PERFORM PASS NC2364.2 +049500 GO TO SCH-WRITE-F1-7. NC2364.2 +049600 SCH-DELETE-F1-7. NC2364.2 +049700 PERFORM DE-LETE. NC2364.2 +049800 GO TO SCH-WRITE-F1-6. NC2364.2 +049900 SCH-FAIL-F1-7. NC2364.2 +050000 IF ELMT-B (10) EQUAL TO ELMT-A (10) NC2364.2 +050100 MOVE 10 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +050200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +050300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +050400 MOVE ELMT-B (10) TO COMPUTED-18V0 NC2364.2 +050500 MOVE ELMT-A (10) TO CORRECT-18V0. NC2364.2 +050600 PERFORM FAIL. NC2364.2 +050700 SCH-WRITE-F1-7. NC2364.2 +050800 PERFORM PRINT-DETAIL. NC2364.2 +050900* NC2364.2 +051000 SCH-INIT-F1-8. NC2364.2 +051100 MOVE "SCH-TEST-F1-8" TO PAR-NAME. NC2364.2 +051200 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +051300 MOVE "SEARCH " TO FEATURE. NC2364.2 +051400 SET A B TO 09. NC2364.2 +051500 SCH-TEST-F1-8. NC2364.2 +051600 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-8 NC2364.2 +051700 WHEN ELMT-B (09) EQUAL TO ELMT-A (A) NC2364.2 +051800 PERFORM PASS NC2364.2 +051900 GO TO SCH-WRITE-F1-8. NC2364.2 +052000 SCH-DELETE-F1-8. NC2364.2 +052100 PERFORM DE-LETE. NC2364.2 +052200 GO TO SCH-WRITE-F1-8. NC2364.2 +052300 SCH-FAIL-F1-8. NC2364.2 +052400 IF ELMT-B (09) EQUAL TO ELMT-A (09) NC2364.2 +052500 MOVE 09 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +052600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +052700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +052800 MOVE ELMT-B (09) TO COMPUTED-18V0 NC2364.2 +052900 MOVE ELMT-A (09) TO CORRECT-18V0. NC2364.2 +053000 PERFORM FAIL. NC2364.2 +053100 SCH-WRITE-F1-8. NC2364.2 +053200 PERFORM PRINT-DETAIL. NC2364.2 +053300* NC2364.2 +053400 SCH-INIT-F1-9. NC2364.2 +053500 MOVE "SCH-TEST-F1-9" TO PAR-NAME. NC2364.2 +053600 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +053700 MOVE "SEARCH " TO FEATURE. NC2364.2 +053800 SET A B TO 3. NC2364.2 +053900 SCH-TEST-F1-9. NC2364.2 +054000 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-9 NC2364.2 +054100 WHEN ELMT-B (B) EQUAL TO ELMT-A (A) NC2364.2 +054200 PERFORM PASS NC2364.2 +054300 GO TO SCH-WRITE-F1-9. NC2364.2 +054400 SCH-DELETE-F1-9. NC2364.2 +054500 PERFORM DE-LETE. NC2364.2 +054600 GO TO SCH-WRITE-F1-9. NC2364.2 +054700 SCH-FAIL-F1-9. NC2364.2 +054800 IF ELMT-B (3) EQUAL TO ELMT-A (3) NC2364.2 +054900 MOVE 03 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +055000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +055100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +055200 MOVE ELMT-B (3) TO COMPUTED-18V0 NC2364.2 +055300 MOVE ELMT-A (3) TO CORRECT-18V0. NC2364.2 +055400 PERFORM FAIL. NC2364.2 +055500 SCH-WRITE-F1-9. NC2364.2 +055600 PERFORM PRINT-DETAIL. NC2364.2 +055700* NC2364.2 +055800 SCH-INIT-F1-10. NC2364.2 +055900 MOVE "SCH-TEST-F1-10" TO PAR-NAME. NC2364.2 +056000 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +056100 MOVE "SEARCH " TO FEATURE. NC2364.2 +056200 SET A B TO 06. NC2364.2 +056300 SCH-TEST-F1-10. NC2364.2 +056400 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-10 NC2364.2 +056500 WHEN ELMT-B (9) EQUAL TO ELMT-A (9) NC2364.2 +056600 PERFORM PASS NC2364.2 +056700 GO TO SCH-WRITE-F1-10. NC2364.2 +056800 SCH-DELETE-F1-10. NC2364.2 +056900 PERFORM DE-LETE. NC2364.2 +057000 GO TO SCH-WRITE-F1-10. NC2364.2 +057100 SCH-FAIL-F1-10. NC2364.2 +057200 IF ELMT-B (9) EQUAL TO ELMT-A (9) NC2364.2 +057300 MOVE 09 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +057400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +057500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +057600 MOVE ELMT-B (9) TO COMPUTED-18V0 NC2364.2 +057700 MOVE ELMT-A (9) TO CORRECT-18V0. NC2364.2 +057800 PERFORM FAIL. NC2364.2 +057900 SCH-WRITE-F1-10. NC2364.2 +058000 PERFORM PRINT-DETAIL. NC2364.2 +058100* NC2364.2 +058200 CCVS-EXIT SECTION. NC2364.2 +058300 CCVS-999999. NC2364.2 +058400 GO TO CLOSE-FILES. NC2364.2 +*END-OF,NC236A +*HEADER,COBOL,NC237A +000100 IDENTIFICATION DIVISION. NC2374.2 +000200 PROGRAM-ID. NC2374.2 +000300 NC237A. NC2374.2 +000400**************************************************************** NC2374.2 +000500* * NC2374.2 +000600* VALIDATION FOR:- * NC2374.2 +000700* * NC2374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +000900* * NC2374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2374.2 +001100* * NC2374.2 +001200**************************************************************** NC2374.2 +001300* * NC2374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2374.2 +001500* * NC2374.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2374.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2374.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2374.2 +001900* * NC2374.2 +002000**************************************************************** NC2374.2 +002100 NC2374.2 +002200* NC2374.2 +002300* PROGRAM NC237A TESTS FORMAT 2 OF THE "SEARCH" STATEMENT * NC2374.2 +002400* WITH A THREE-DIMENSIONAL TABLE CONTAINING ASCENDING AND * NC2374.2 +002500* DESCENDING KEYS. * NC2374.2 +002600* * NC2374.2 +002700**************************************************************** NC2374.2 +002800 ENVIRONMENT DIVISION. NC2374.2 +002900 CONFIGURATION SECTION. NC2374.2 +003000 SOURCE-COMPUTER. NC2374.2 +003100 XXXXX082. NC2374.2 +003200 OBJECT-COMPUTER. NC2374.2 +003300 XXXXX083. NC2374.2 +003400 INPUT-OUTPUT SECTION. NC2374.2 +003500 FILE-CONTROL. NC2374.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2374.2 +003700 XXXXX055. NC2374.2 +003800 DATA DIVISION. NC2374.2 +003900 FILE SECTION. NC2374.2 +004000 FD PRINT-FILE. NC2374.2 +004100 01 PRINT-REC PICTURE X(120). NC2374.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2374.2 +004300 WORKING-STORAGE SECTION. NC2374.2 +004400 77 IDENT-1 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004500 77 IDENT-2 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004600 77 IDENT-3 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004700 77 IDENT-4 PICTURE 9 VALUE ZERO COMPUTATIONAL. NC2374.2 +004800 77 IDENT-5 PICTURE 9 VALUE ZERO COMPUTATIONAL. NC2374.2 +004900 77 IDENT-6 PICTURE 9(18) VALUE 3. NC2374.2 +005000 77 IDENT-7 PICTURE 9(18) VALUE 1. NC2374.2 +005100 77 IDENT-8 PICTURE 9 VALUE 6. NC2374.2 +005200 77 IDENT-9 PICTURE 9 VALUE 5. NC2374.2 +005300 01 TABLE-TH310. NC2374.2 +005400 02 ENTRY-310 OCCURS 9 TIMES ASCENDING GRP NC2374.2 +005500 INDEXED BY IDX-1. NC2374.2 +005600 03 ENTRY-1. NC2374.2 +005700 04 GRP PIC 99. NC2374.2 +005800 03 ENTRY-310-2 OCCURS 9 ASCENDING KEY GRP-1 NC2374.2 +005900 DESCENDING KEY IS SEC INDEXED BY IDX-2. NC2374.2 +006000 04 ENTRY-2. NC2374.2 +006100 05 GRP-1 PIC 99. NC2374.2 +006200 05 SEC PIC 99. NC2374.2 +006300 04 ENTRY-310-3 OCCURS 9 TIMES ASCENDING IS GRP-2 NC2374.2 +006400 DESCENDING KEY SEC-1 ASCENDING ELEM INDEXED IDX-3. NC2374.2 +006500 05 ENTRY-3. NC2374.2 +006600 06 GRP-2 PICTURE 99. NC2374.2 +006700 06 SEC-1 PICTURE 99. NC2374.2 +006800 06 ELEM PICTURE 99. NC2374.2 +006900 01 ENTRIES-X. NC2374.2 +007000 02 ONE-99 PICTURE 99 VALUE 01. NC2374.2 +007100 02 TWO-99 PICTURE 99 VALUE 09. NC2374.2 +007200 02 THREE-99 PICTURE 99 VALUE 01. NC2374.2 +007300 01 CT PICTURE 999 VALUE 111. NC2374.2 +007400 01 SU REDEFINES CT. NC2374.2 +007500 02 S1 PICTURE 9. NC2374.2 +007600 02 S2 PICTURE 9. NC2374.2 +007700 02 S3 PICTURE 9. NC2374.2 +007800 01 TEST-RESULTS. NC2374.2 +007900 02 FILLER PIC X VALUE SPACE. NC2374.2 +008000 02 FEATURE PIC X(20) VALUE SPACE. NC2374.2 +008100 02 FILLER PIC X VALUE SPACE. NC2374.2 +008200 02 P-OR-F PIC X(5) VALUE SPACE. NC2374.2 +008300 02 FILLER PIC X VALUE SPACE. NC2374.2 +008400 02 PAR-NAME. NC2374.2 +008500 03 FILLER PIC X(19) VALUE SPACE. NC2374.2 +008600 03 PARDOT-X PIC X VALUE SPACE. NC2374.2 +008700 03 DOTVALUE PIC 99 VALUE ZERO. NC2374.2 +008800 02 FILLER PIC X(8) VALUE SPACE. NC2374.2 +008900 02 RE-MARK PIC X(61). NC2374.2 +009000 01 TEST-COMPUTED. NC2374.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2374.2 +009200 02 FILLER PIC X(17) VALUE NC2374.2 +009300 " COMPUTED=". NC2374.2 +009400 02 COMPUTED-X. NC2374.2 +009500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2374.2 +009600 03 COMPUTED-N REDEFINES COMPUTED-A NC2374.2 +009700 PIC -9(9).9(9). NC2374.2 +009800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2374.2 +009900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2374.2 +010000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2374.2 +010100 03 CM-18V0 REDEFINES COMPUTED-A. NC2374.2 +010200 04 COMPUTED-18V0 PIC -9(18). NC2374.2 +010300 04 FILLER PIC X. NC2374.2 +010400 03 FILLER PIC X(50) VALUE SPACE. NC2374.2 +010500 01 TEST-CORRECT. NC2374.2 +010600 02 FILLER PIC X(30) VALUE SPACE. NC2374.2 +010700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2374.2 +010800 02 CORRECT-X. NC2374.2 +010900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2374.2 +011000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2374.2 +011100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2374.2 +011200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2374.2 +011300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2374.2 +011400 03 CR-18V0 REDEFINES CORRECT-A. NC2374.2 +011500 04 CORRECT-18V0 PIC -9(18). NC2374.2 +011600 04 FILLER PIC X. NC2374.2 +011700 03 FILLER PIC X(2) VALUE SPACE. NC2374.2 +011800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2374.2 +011900 01 CCVS-C-1. NC2374.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2374.2 +012100- "SS PARAGRAPH-NAME NC2374.2 +012200- " REMARKS". NC2374.2 +012300 02 FILLER PIC X(20) VALUE SPACE. NC2374.2 +012400 01 CCVS-C-2. NC2374.2 +012500 02 FILLER PIC X VALUE SPACE. NC2374.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". NC2374.2 +012700 02 FILLER PIC X(15) VALUE SPACE. NC2374.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". NC2374.2 +012900 02 FILLER PIC X(94) VALUE SPACE. NC2374.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2374.2 +013100 01 REC-CT PIC 99 VALUE ZERO. NC2374.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2374.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2374.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2374.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2374.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2374.2 +014100 01 CCVS-H-1. NC2374.2 +014200 02 FILLER PIC X(39) VALUE SPACES. NC2374.2 +014300 02 FILLER PIC X(42) VALUE NC2374.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2374.2 +014500 02 FILLER PIC X(39) VALUE SPACES. NC2374.2 +014600 01 CCVS-H-2A. NC2374.2 +014700 02 FILLER PIC X(40) VALUE SPACE. NC2374.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2374.2 +014900 02 FILLER PIC XXXX VALUE NC2374.2 +015000 "4.2 ". NC2374.2 +015100 02 FILLER PIC X(28) VALUE NC2374.2 +015200 " COPY - NOT FOR DISTRIBUTION". NC2374.2 +015300 02 FILLER PIC X(41) VALUE SPACE. NC2374.2 +015400 NC2374.2 +015500 01 CCVS-H-2B. NC2374.2 +015600 02 FILLER PIC X(15) VALUE NC2374.2 +015700 "TEST RESULT OF ". NC2374.2 +015800 02 TEST-ID PIC X(9). NC2374.2 +015900 02 FILLER PIC X(4) VALUE NC2374.2 +016000 " IN ". NC2374.2 +016100 02 FILLER PIC X(12) VALUE NC2374.2 +016200 " HIGH ". NC2374.2 +016300 02 FILLER PIC X(22) VALUE NC2374.2 +016400 " LEVEL VALIDATION FOR ". NC2374.2 +016500 02 FILLER PIC X(58) VALUE NC2374.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +016700 01 CCVS-H-3. NC2374.2 +016800 02 FILLER PIC X(34) VALUE NC2374.2 +016900 " FOR OFFICIAL USE ONLY ". NC2374.2 +017000 02 FILLER PIC X(58) VALUE NC2374.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2374.2 +017200 02 FILLER PIC X(28) VALUE NC2374.2 +017300 " COPYRIGHT 1985 ". NC2374.2 +017400 01 CCVS-E-1. NC2374.2 +017500 02 FILLER PIC X(52) VALUE SPACE. NC2374.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2374.2 +017700 02 ID-AGAIN PIC X(9). NC2374.2 +017800 02 FILLER PIC X(45) VALUE SPACES. NC2374.2 +017900 01 CCVS-E-2. NC2374.2 +018000 02 FILLER PIC X(31) VALUE SPACE. NC2374.2 +018100 02 FILLER PIC X(21) VALUE SPACE. NC2374.2 +018200 02 CCVS-E-2-2. NC2374.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2374.2 +018400 03 FILLER PIC X VALUE SPACE. NC2374.2 +018500 03 ENDER-DESC PIC X(44) VALUE NC2374.2 +018600 "ERRORS ENCOUNTERED". NC2374.2 +018700 01 CCVS-E-3. NC2374.2 +018800 02 FILLER PIC X(22) VALUE NC2374.2 +018900 " FOR OFFICIAL USE ONLY". NC2374.2 +019000 02 FILLER PIC X(12) VALUE SPACE. NC2374.2 +019100 02 FILLER PIC X(58) VALUE NC2374.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +019300 02 FILLER PIC X(13) VALUE SPACE. NC2374.2 +019400 02 FILLER PIC X(15) VALUE NC2374.2 +019500 " COPYRIGHT 1985". NC2374.2 +019600 01 CCVS-E-4. NC2374.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2374.2 +019800 02 FILLER PIC X(4) VALUE " OF ". NC2374.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2374.2 +020000 02 FILLER PIC X(40) VALUE NC2374.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2374.2 +020200 01 XXINFO. NC2374.2 +020300 02 FILLER PIC X(19) VALUE NC2374.2 +020400 "*** INFORMATION ***". NC2374.2 +020500 02 INFO-TEXT. NC2374.2 +020600 04 FILLER PIC X(8) VALUE SPACE. NC2374.2 +020700 04 XXCOMPUTED PIC X(20). NC2374.2 +020800 04 FILLER PIC X(5) VALUE SPACE. NC2374.2 +020900 04 XXCORRECT PIC X(20). NC2374.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). NC2374.2 +021100 01 HYPHEN-LINE. NC2374.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. NC2374.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************NC2374.2 +021400- "*****************************************". NC2374.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************NC2374.2 +021600- "******************************". NC2374.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE NC2374.2 +021800 "NC237A". NC2374.2 +021900 PROCEDURE DIVISION. NC2374.2 +022000 CCVS1 SECTION. NC2374.2 +022100 OPEN-FILES. NC2374.2 +022200 OPEN OUTPUT PRINT-FILE. NC2374.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2374.2 +022400 MOVE SPACE TO TEST-RESULTS. NC2374.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2374.2 +022600 GO TO CCVS1-EXIT. NC2374.2 +022700 CLOSE-FILES. NC2374.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2374.2 +022900 TERMINATE-CCVS. NC2374.2 +023000S EXIT PROGRAM. NC2374.2 +023100STERMINATE-CALL. NC2374.2 +023200 STOP RUN. NC2374.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2374.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2374.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2374.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2374.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. NC2374.2 +023800 PRINT-DETAIL. NC2374.2 +023900 IF REC-CT NOT EQUAL TO ZERO NC2374.2 +024000 MOVE "." TO PARDOT-X NC2374.2 +024100 MOVE REC-CT TO DOTVALUE. NC2374.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2374.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2374.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2374.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2374.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2374.2 +024700 MOVE SPACE TO CORRECT-X. NC2374.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2374.2 +024900 MOVE SPACE TO RE-MARK. NC2374.2 +025000 HEAD-ROUTINE. NC2374.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2374.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2374.2 +025500 COLUMN-NAMES-ROUTINE. NC2374.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +025900 END-ROUTINE. NC2374.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2374.2 +026100 END-RTN-EXIT. NC2374.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +026300 END-ROUTINE-1. NC2374.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2374.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2374.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. NC2374.2 +026700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2374.2 +026800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2374.2 +026900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2374.2 +027000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2374.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2374.2 +027200 END-ROUTINE-12. NC2374.2 +027300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2374.2 +027400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2374.2 +027500 MOVE "NO " TO ERROR-TOTAL NC2374.2 +027600 ELSE NC2374.2 +027700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2374.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2374.2 +027900 PERFORM WRITE-LINE. NC2374.2 +028000 END-ROUTINE-13. NC2374.2 +028100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2374.2 +028200 MOVE "NO " TO ERROR-TOTAL ELSE NC2374.2 +028300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2374.2 +028400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2374.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +028600 IF INSPECT-COUNTER EQUAL TO ZERO NC2374.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2374.2 +028800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2374.2 +028900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2374.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +029100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +029200 WRITE-LINE. NC2374.2 +029300 ADD 1 TO RECORD-COUNT. NC2374.2 +029400Y IF RECORD-COUNT GREATER 50 NC2374.2 +029500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2374.2 +029600Y MOVE SPACE TO DUMMY-RECORD NC2374.2 +029700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2374.2 +029800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2374.2 +029900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2374.2 +030000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2374.2 +030100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2374.2 +030200Y MOVE ZERO TO RECORD-COUNT. NC2374.2 +030300 PERFORM WRT-LN. NC2374.2 +030400 WRT-LN. NC2374.2 +030500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2374.2 +030600 MOVE SPACE TO DUMMY-RECORD. NC2374.2 +030700 BLANK-LINE-PRINT. NC2374.2 +030800 PERFORM WRT-LN. NC2374.2 +030900 FAIL-ROUTINE. NC2374.2 +031000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2374.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2374.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2374.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2374.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2374.2 +031600 GO TO FAIL-ROUTINE-EX. NC2374.2 +031700 FAIL-ROUTINE-WRITE. NC2374.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2374.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2374.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2374.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2374.2 +032200 FAIL-ROUTINE-EX. EXIT. NC2374.2 +032300 BAIL-OUT. NC2374.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2374.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2374.2 +032600 BAIL-OUT-WRITE. NC2374.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2374.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2374.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2374.2 +033100 BAIL-OUT-EX. EXIT. NC2374.2 +033200 CCVS1-EXIT. NC2374.2 +033300 EXIT. NC2374.2 +033400 SECT-NC237A-001 SECTION. NC2374.2 +033500 TH-10-001. NC2374.2 +033600* NC2374.2 +033700 BUILD-3DEM-TABLE. NC2374.2 +033800 MOVE "PERFORM VARYING" TO FEATURE. NC2374.2 +033900 SET IDX-1, IDX-2, IDX-3 TO 1. NC2374.2 +034000 PERFORM BUILD-TABLE THRU BUILD-EXIT VARYING ONE-99 FROM 1 NC2374.2 +034100 BY 1 UNTIL ONE-99 EQUAL TO 10 AFTER TWO-99 FROM 9 BY -1 NC2374.2 +034200 UNTIL TWO-99 EQUAL TO 0 AFTER THREE-99 FROM 1 BY 1 NC2374.2 +034300 UNTIL THREE-99 EQUAL TO 10. NC2374.2 +034400 GO TO IDX-INIT-GF-1. NC2374.2 +034500* NC2374.2 +034600 BUILD-TABLE. NC2374.2 +034700 MOVE ONE-99 TO GRP (IDX-1), GRP-1 (IDX-1, IDX-2), NC2374.2 +034800 GRP-2 (IDX-1, IDX-2, IDX-3). NC2374.2 +034900 MOVE TWO-99 TO SEC (IDX-1, IDX-2) SEC-1 (IDX-1, IDX-2, IDX-3)NC2374.2 +035000 MOVE THREE-99 TO ELEM (IDX-1, IDX-2, IDX-3). NC2374.2 +035100 IF CT = 999 NC2374.2 +035200 MOVE 0 TO CT NC2374.2 +035300 ELSE NC2374.2 +035400 ADD 1 TO CT. NC2374.2 +035500 IF S3 EQUAL TO 0 ADD 1 TO S3. NC2374.2 +035600 IF S2 EQUAL TO 0 ADD 1 TO S2. NC2374.2 +035700 IF S1 EQUAL TO 0 ADD 1 TO S1. NC2374.2 +035800 SET IDX-1 TO S1. NC2374.2 +035900 SET IDX-2 TO S2. NC2374.2 +036000 SET IDX-3 TO S3. NC2374.2 +036100 BUILD-EXIT. NC2374.2 +036200 EXIT. NC2374.2 +036300* NC2374.2 +036400 IDX-INIT-GF-1. NC2374.2 +036500 MOVE "IDX-TEST-GF-1" TO PAR-NAME. NC2374.2 +036600 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +036700 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +036800 IDX-TEST-GF-1. NC2374.2 +036900 IF ENTRY-3 (9, 9, 9) EQUAL TO 090109 NC2374.2 +037000 PERFORM PASS NC2374.2 +037100 MOVE "TABLE BUILT CORRECTLY" TO RE-MARK NC2374.2 +037200 GO TO IDX-WRITE-GF-1. NC2374.2 +037300 GO TO IDX-FAIL-GF-1. NC2374.2 +037400 IDX-DELETE-GF-1. NC2374.2 +037500 PERFORM DE-LETE. NC2374.2 +037600 GO TO IDX-WRITE-GF-1. NC2374.2 +037700 IDX-FAIL-GF-1. NC2374.2 +037800 MOVE "TABLE CREATED INCORRECTLY" TO RE-MARK. NC2374.2 +037900 PERFORM FAIL. NC2374.2 +038000 IDX-WRITE-GF-1. NC2374.2 +038100 PERFORM PRINT-DETAIL. NC2374.2 +038200* NC2374.2 +038300 IDX-INIT-GF-2. NC2374.2 +038400 MOVE "IDX-TEST-GF-2 " TO PAR-NAME. NC2374.2 +038500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +038600 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +038700 MOVE 7 TO IDENT-1. NC2374.2 +038800 SET IDX-1 IDX-2 IDX-3 TO IDENT-1. NC2374.2 +038900 SET IDX-1 IDX-3 DOWN BY IDENT-6. NC2374.2 +039000 IDX-TEST-GF-2. NC2374.2 +039100 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO 040304 NC2374.2 +039200 PERFORM PASS NC2374.2 +039300 GO TO IDX-WRITE-GF-2. NC2374.2 +039400 GO TO IDX-FAIL-GF-2. NC2374.2 +039500 IDX-DELETE-GF-2. NC2374.2 +039600 PERFORM DE-LETE. NC2374.2 +039700 GO TO IDX-WRITE-GF-2. NC2374.2 +039800 IDX-FAIL-GF-2. NC2374.2 +039900 MOVE "040304" TO CORRECT-A. NC2374.2 +040000 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +040100 PERFORM FAIL. NC2374.2 +040200 IDX-WRITE-GF-2. NC2374.2 +040300 PERFORM PRINT-DETAIL. NC2374.2 +040400* NC2374.2 +040500 IDX-INIT-GF-3. NC2374.2 +040600 MOVE "IDX-TEST-GF-3" TO PAR-NAME. NC2374.2 +040700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +040800 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +040900 MOVE 4 TO IDENT-1. NC2374.2 +041000 SET IDX-1 TO IDENT-7. NC2374.2 +041100 SET IDX-1 UP BY IDENT-1. NC2374.2 +041200 IDX-TEST-GF-3. NC2374.2 +041300 IF ENTRY-1 (IDX-1) EQUAL TO "05" NC2374.2 +041400 PERFORM PASS NC2374.2 +041500 GO TO IDX-WRITE-GF-3. NC2374.2 +041600 GO TO IDX-FAIL-GF-3. NC2374.2 +041700 IDX-DELETE-GF-3. NC2374.2 +041800 PERFORM DE-LETE. NC2374.2 +041900 GO TO IDX-WRITE-GF-3. NC2374.2 +042000 IDX-FAIL-GF-3. NC2374.2 +042100 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A. NC2374.2 +042200 MOVE "05" TO CORRECT-A. NC2374.2 +042300 PERFORM FAIL. NC2374.2 +042400 IDX-WRITE-GF-3. NC2374.2 +042500 PERFORM PRINT-DETAIL. NC2374.2 +042600* NC2374.2 +042700 IDX-INIT-GF-4. NC2374.2 +042800 MOVE "IDX-TEST-GF-4" TO PAR-NAME. NC2374.2 +042900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +043000 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +043100 MOVE 1 TO IDENT-1. NC2374.2 +043200 SET IDX-1 IDX-2 TO IDENT-1. NC2374.2 +043300 SET IDX-2 UP BY IDENT-9. NC2374.2 +043400 SET IDX-2 UP BY IDENT-6. NC2374.2 +043500 IDX-TEST-GF-4. NC2374.2 +043600 IF ENTRY-2 (IDX-1, IDX-2) EQUAL TO "0101" NC2374.2 +043700 PERFORM PASS NC2374.2 +043800 GO TO IDX-WRITE-GF-4. NC2374.2 +043900 GO TO IDX-FAIL-GF-4. NC2374.2 +044000 IDX-DELETE-GF-4. NC2374.2 +044100 PERFORM DE-LETE. NC2374.2 +044200 GO TO IDX-WRITE-GF-4. NC2374.2 +044300 IDX-FAIL-GF-4. NC2374.2 +044400 MOVE "0101" TO CORRECT-A. NC2374.2 +044500 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A. NC2374.2 +044600 PERFORM FAIL. NC2374.2 +044700 IDX-WRITE-GF-4. NC2374.2 +044800 PERFORM PRINT-DETAIL. NC2374.2 +044900* NC2374.2 +045000 IDX-INIT-GF-5. NC2374.2 +045100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +045200 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +045300 MOVE "IDX-TEST-GF-5" TO PAR-NAME. NC2374.2 +045400 MOVE 1 TO IDENT-1. NC2374.2 +045500 SET IDX-1 TO IDENT-6. NC2374.2 +045600 SET IDX-1 UP BY IDENT-1. NC2374.2 +045700 IDX-TEST-GF-5. NC2374.2 +045800 IF ENTRY-1 (IDX-1) EQUAL TO 04 NC2374.2 +045900 PERFORM PASS NC2374.2 +046000 GO TO IDX-WRITE-GF-5. NC2374.2 +046100 GO TO IDX-FAIL-GF-5. NC2374.2 +046200 IDX-DELETE-GF-5. NC2374.2 +046300 PERFORM DE-LETE. NC2374.2 +046400 GO TO IDX-WRITE-GF-5. NC2374.2 +046500 IDX-FAIL-GF-5. NC2374.2 +046600 MOVE "04" TO CORRECT-A. NC2374.2 +046700 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A. NC2374.2 +046800 PERFORM FAIL. NC2374.2 +046900 IDX-WRITE-GF-5. NC2374.2 +047000 PERFORM PRINT-DETAIL. NC2374.2 +047100* NC2374.2 +047200 IDX-INIT-GF-6. NC2374.2 +047300 MOVE "IDX-TEST-GF-6" TO PAR-NAME. NC2374.2 +047400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +047500 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +047600 SET IDX-3 TO 4. NC2374.2 +047700 SET IDX-1 IDX-2 TO IDX-3. NC2374.2 +047800 SET IDX-1 IDX-2 IDX-3 DOWN BY IDENT-7. NC2374.2 +047900 MOVE 4 TO IDENT-1. NC2374.2 +048000 SET IDX-1 IDX-2 IDX-3 UP BY IDENT-1. NC2374.2 +048100 IDX-TEST-GF-6. NC2374.2 +048200 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "070307" NC2374.2 +048300 PERFORM PASS NC2374.2 +048400 GO TO IDX-WRITE-GF-6. NC2374.2 +048500 GO TO IDX-FAIL-GF-6. NC2374.2 +048600 IDX-DELETE-GF-6. NC2374.2 +048700 PERFORM DE-LETE. NC2374.2 +048800 GO TO IDX-WRITE-GF-6. NC2374.2 +048900 IDX-FAIL-GF-6. NC2374.2 +049000 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +049100 MOVE "070307" TO CORRECT-A. NC2374.2 +049200 PERFORM FAIL. NC2374.2 +049300 IDX-WRITE-GF-6. NC2374.2 +049400 PERFORM PRINT-DETAIL. NC2374.2 +049500* NC2374.2 +049600 IDX-INIT-GF-7. NC2374.2 +049700 MOVE "IDX-TEST-GF-7" TO PAR-NAME. NC2374.2 +049800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +049900 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +050000 MOVE 3 TO IDENT-1 IDENT-2 IDENT-4. NC2374.2 +050100 SET IDX-1 TO IDENT-1. NC2374.2 +050200 SET IDX-2 TO IDENT-2. NC2374.2 +050300 SET IDX-3 TO IDENT-4. NC2374.2 +050400 SET IDX-1 IDX-2 IDX-3 UP BY IDENT-7. NC2374.2 +050500 IDX-TEST-GF-7. NC2374.2 +050600 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "040604" NC2374.2 +050700 PERFORM PASS NC2374.2 +050800 GO TO IDX-WRITE-GF-7. NC2374.2 +050900 GO TO IDX-FAIL-GF-7. NC2374.2 +051000 IDX-DELETE-GF-7. NC2374.2 +051100 PERFORM DE-LETE. NC2374.2 +051200 GO TO IDX-WRITE-GF-7. NC2374.2 +051300 IDX-FAIL-GF-7. NC2374.2 +051400 MOVE "040604" TO CORRECT-A. NC2374.2 +051500 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +051600 PERFORM FAIL. NC2374.2 +051700 IDX-WRITE-GF-7. NC2374.2 +051800 PERFORM PRINT-DETAIL. NC2374.2 +051900* NC2374.2 +052000 IDX-INIT-GF-8. NC2374.2 +052100 MOVE "IDX-TEST-GF-8" TO PAR-NAME. NC2374.2 +052200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +052300 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +052400 MOVE 9 TO IDENT-1. NC2374.2 +052500 SET IDX-1, IDX-2, IDX-3 TO IDENT-1. NC2374.2 +052600 SET IDX-1, IDX-2, IDX-3 DOWN BY 5. NC2374.2 +052700 IDX-TEST-GF-8. NC2374.2 +052800 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "040604" NC2374.2 +052900 PERFORM PASS NC2374.2 +053000 GO TO IDX-WRITE-GF-8. NC2374.2 +053100 GO TO IDX-FAIL-GF-8. NC2374.2 +053200 IDX-DELETE-GF-8. NC2374.2 +053300 PERFORM DE-LETE. NC2374.2 +053400 GO TO IDX-WRITE-GF-8. NC2374.2 +053500 IDX-FAIL-GF-8. NC2374.2 +053600 MOVE "040604" TO CORRECT-A. NC2374.2 +053700 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +053800 PERFORM FAIL. NC2374.2 +053900 IDX-WRITE-GF-8. NC2374.2 +054000 PERFORM PRINT-DETAIL. NC2374.2 +054100* NC2374.2 +054200 IDX-INIT-F2-9. NC2374.2 +054300 MOVE "IDX-TEST-F2-9" TO PAR-NAME. NC2374.2 +054400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +054500 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +054600 SET IDX-1 TO 05. NC2374.2 +054700 IDX-TEST-F2-9. NC2374.2 +054800 SEARCH ALL ENTRY-310-2 END NC2374.2 +054900 GO TO IDX-FAIL-F2-9 NC2374.2 +055000 WHEN GRP-1 (IDX-1, IDX-2) EQUAL TO "05" AND NC2374.2 +055100 SEC (IDX-1, IDX-2) EQUAL TO "07" NC2374.2 +055200 PERFORM PASS NC2374.2 +055300 GO TO IDX-WRITE-F2-9. NC2374.2 +055400 IDX-DELETE-F2-9. NC2374.2 +055500 PERFORM DE-LETE. NC2374.2 +055600 GO TO IDX-WRITE-F2-9. NC2374.2 +055700 IDX-FAIL-F2-9. NC2374.2 +055800 MOVE ENTRY-2 (05, 03) TO COMPUTED-A NC2374.2 +055900 MOVE "0507" TO CORRECT-A NC2374.2 +056000 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +056100 PERFORM FAIL. NC2374.2 +056200 IDX-WRITE-F2-9. NC2374.2 +056300 PERFORM PRINT-DETAIL. NC2374.2 +056400* NC2374.2 +056500 IDX-INIT-F2-10. NC2374.2 +056600 MOVE "IDX-TEST-F2-10" TO PAR-NAME. NC2374.2 +056700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +056800 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +056900 SET IDX-1 IDX-2 TO 9. NC2374.2 +057000 IDX-TEST-F2-10. NC2374.2 +057100 SEARCH ALL ENTRY-310-3 END NC2374.2 +057200 PERFORM PASS NC2374.2 +057300 GO TO IDX-WRITE-F2-10 NC2374.2 +057400 WHEN GRP-2 (IDX-1, IDX-2, IDX-3) EQUAL "09" NC2374.2 +057500 AND SEC-1 (IDX-1, IDX-2, IDX-3) EQUAL "01" NC2374.2 +057600 AND ELEM (IDX-1, IDX-2, IDX-3) EQUAL "10" NC2374.2 +057700 GO TO IDX-FAIL-F2-10. NC2374.2 +057800 IDX-DELETE-F2-10. NC2374.2 +057900 PERFORM DE-LETE. NC2374.2 +058000 GO TO IDX-WRITE-F2-10. NC2374.2 +058100 IDX-FAIL-F2-10. NC2374.2 +058200 MOVE "090110" TO COMPUTED-A NC2374.2 +058300 MOVE "ENTRY SHOULD NOT BE FOUND" TO RE-MARK NC2374.2 +058400 PERFORM FAIL. NC2374.2 +058500 IDX-WRITE-F2-10. NC2374.2 +058600 PERFORM PRINT-DETAIL. NC2374.2 +058700* NC2374.2 +058800 IDX-INIT-F2-11. NC2374.2 +058900 MOVE "IDX-TEST-F2-11" TO PAR-NAME. NC2374.2 +059000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +059100 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +059200 SET IDX-1 TO 09. NC2374.2 +059300 IDX-TEST-F2-11. NC2374.2 +059400 SEARCH ALL ENTRY-310 ENDNC2374.2 +059500 GO TO IDX-FAIL-F2-11 NC2374.2 +059600 WHEN GRP (IDX-1) EQUAL TO "07" NC2374.2 +059700 PERFORM PASS NC2374.2 +059800 GO TO IDX-WRITE-F2-11. NC2374.2 +059900 IDX-DELETE-F2-11. NC2374.2 +060000 PERFORM DE-LETE. NC2374.2 +060100 GO TO IDX-WRITE-F2-11. NC2374.2 +060200 IDX-FAIL-F2-11. NC2374.2 +060300 MOVE ENTRY-1 (07) TO COMPUTED-A NC2374.2 +060400 MOVE "07" TO CORRECT-A NC2374.2 +060500 PERFORM FAIL NC2374.2 +060600 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK. NC2374.2 +060700 IDX-WRITE-F2-11. NC2374.2 +060800 PERFORM PRINT-DETAIL. NC2374.2 +060900* NC2374.2 +061000 IDX-INIT-F2-12. NC2374.2 +061100 MOVE "IDX-TEST-F2-12" TO PAR-NAME. NC2374.2 +061200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +061300 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +061400 MOVE 04 TO IDENT-1. NC2374.2 +061500 SET IDX-1, IDX-2, IDX-3 TO IDENT-1. NC2374.2 +061600 SET IDX-1 UP BY 1. NC2374.2 +061700 IDX-TEST-F2-12. NC2374.2 +061800 SEARCH ALL ENTRY-310-3 AT END NC2374.2 +061900 GO TO IDX-FAIL-F2-12 NC2374.2 +062000 WHEN GRP-2 (IDX-1, IDX-2, IDX-3) EQUAL TO "05" AND NC2374.2 +062100 SEC-1 (IDX-1, IDX-2, IDX-3) EQUAL TO "06" AND NC2374.2 +062200 ELEM (IDX-1, IDX-2, IDX-3) EQUAL TO "03" NC2374.2 +062300 PERFORM PASS NC2374.2 +062400 GO TO IDX-WRITE-F2-12. NC2374.2 +062500 IDX-DELETE-F2-12. NC2374.2 +062600 PERFORM DE-LETE. NC2374.2 +062700 GO TO IDX-WRITE-F2-12. NC2374.2 +062800 IDX-FAIL-F2-12. NC2374.2 +062900 MOVE ENTRY-3 (05, 04, 03) TO COMPUTED-A NC2374.2 +063000 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +063100 MOVE "050603" TO CORRECT-A NC2374.2 +063200 PERFORM FAIL. NC2374.2 +063300 IDX-WRITE-F2-12. NC2374.2 +063400 PERFORM PRINT-DETAIL. NC2374.2 +063500* NC2374.2 +063600 IDX-INIT-F2-13. NC2374.2 +063700 MOVE "IDX-TEST-F2-13" TO PAR-NAME. NC2374.2 +063800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +063900 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +064000 SET IDX-1 TO 9. NC2374.2 +064100 IDX-TEST-F2-13. NC2374.2 +064200 SEARCH ALL ENTRY-310-2 AT END NC2374.2 +064300 GO TO IDX-FAIL-F2-13 NC2374.2 +064400 WHEN GRP-1 (IDX-1, IDX-2) EQUAL TO "09" AND SEC NC2374.2 +064500 (IDX-1, IDX-2) EQUAL TO "01" NC2374.2 +064600 PERFORM PASS NC2374.2 +064700 GO TO IDX-WRITE-F2-13. NC2374.2 +064800 IDX-DELETE-F2-13. NC2374.2 +064900 PERFORM DE-LETE. NC2374.2 +065000 GO TO IDX-WRITE-F2-13. NC2374.2 +065100 IDX-FAIL-F2-13. NC2374.2 +065200 MOVE ENTRY-2 (09, 09) TO COMPUTED-A NC2374.2 +065300 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +065400 MOVE "0901" TO CORRECT-A NC2374.2 +065500 PERFORM FAIL. NC2374.2 +065600 IDX-WRITE-F2-13. NC2374.2 +065700 PERFORM PRINT-DETAIL. NC2374.2 +065800* NC2374.2 +065900 CCVS-EXIT SECTION. NC2374.2 +066000 CCVS-999999. NC2374.2 +066100 GO TO CLOSE-FILES. NC2374.2 +*END-OF,NC237A +*HEADER,COBOL,NC238A +000100 IDENTIFICATION DIVISION. NC2384.2 +000200 PROGRAM-ID. NC2384.2 +000300 NC238A. NC2384.2 +000400**************************************************************** NC2384.2 +000500* * NC2384.2 +000600* VALIDATION FOR:- * NC2384.2 +000700* * NC2384.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +000900* * NC2384.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2384.2 +001100* * NC2384.2 +001200**************************************************************** NC2384.2 +001300* * NC2384.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2384.2 +001500* * NC2384.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2384.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2384.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2384.2 +001900* * NC2384.2 +002000**************************************************************** NC2384.2 +002100* NC2384.2 +002200* PROGRAM NC238A TESTS FORMATS 1 AND 2 OF THE "SEARCH" * NC2384.2 +002300* STATEMENT USING A TWO-DIMENDIONAL TABLE WITH ASCENDING * NC2384.2 +002400* AND DESCENDING KEYS AND MULTIPLE INDICES. SINGLE AND * NC2384.2 +002500* MULTIPLE CONDITIONS ARE USED IN THE "WHEN" PHRASE. * NC2384.2 +002600* * NC2384.2 +002700**************************************************************** NC2384.2 +002800 ENVIRONMENT DIVISION. NC2384.2 +002900 CONFIGURATION SECTION. NC2384.2 +003000 SOURCE-COMPUTER. NC2384.2 +003100 XXXXX082. NC2384.2 +003200 OBJECT-COMPUTER. NC2384.2 +003300 XXXXX083. NC2384.2 +003400 INPUT-OUTPUT SECTION. NC2384.2 +003500 FILE-CONTROL. NC2384.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2384.2 +003700 XXXXX055. NC2384.2 +003800 DATA DIVISION. NC2384.2 +003900 FILE SECTION. NC2384.2 +004000 FD PRINT-FILE. NC2384.2 +004100 01 PRINT-REC PICTURE X(120). NC2384.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2384.2 +004300 WORKING-STORAGE SECTION. NC2384.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2384.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2384.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2384.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2384.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2384.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2384.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2384.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2384.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2384.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2384.2 +005400 77 SUB-4 PICTURE 9 VALUE 9. NC2384.2 +005500 77 SUB-5 PICTURE 9 VALUE 1. NC2384.2 +005600 77 SUB-6 PICTURE 99 VALUE 01. NC2384.2 +005700 77 LEVEL-HOLD PICTURE X(4) VALUE SPACES. NC2384.2 +005800 01 ALPHA-TABLE. NC2384.2 +005900 02 FILLER PICTURE X(4) VALUE "PPPP". NC2384.2 +006000 02 FILLER PICTURE X(4) VALUE "OOOO". NC2384.2 +006100 02 FILLER PICTURE X(4) VALUE "NNNN". NC2384.2 +006200 02 FILLER PICTURE X(4) VALUE "MMMM". NC2384.2 +006300 02 FILLER PICTURE X(4) VALUE "LLLL". NC2384.2 +006400 02 FILLER PICTURE X(4) VALUE "KKKK". NC2384.2 +006500 02 FILLER PICTURE X(4) VALUE "JJJJ". NC2384.2 +006600 02 FILLER PICTURE X(4) VALUE "IIII". NC2384.2 +006700 02 FILLER PICTURE X(4) VALUE "HHHH". NC2384.2 +006800 02 FILLER PICTURE X(4) VALUE "GGGG". NC2384.2 +006900 02 FILLER PICTURE X(4) VALUE "FFFF". NC2384.2 +007000 02 FILLER PICTURE X(4) VALUE "EEEE". NC2384.2 +007100 02 FILLER PICTURE X(4) VALUE "DDDD". NC2384.2 +007200 02 FILLER PICTURE X(4) VALUE "CCCC". NC2384.2 +007300 02 FILLER PICTURE X(4) VALUE "BBBB". NC2384.2 +007400 02 FILLER PICTURE X(4) VALUE "AAAA". NC2384.2 +007500 01 ALPHA-BET-TABLE REDEFINES ALPHA-TABLE. NC2384.2 +007600 02 ALPHA-BET OCCURS 16 TIMES PICTURE X(4). NC2384.2 +007700 NC2384.2 +007800 01 SERIES-TABLE-2. NC2384.2 +007900 02 1ST-ENTRY OCCURS 4 TIMES ASCENDING KEY IS FIELD-1 FIELD-2NC2384.2 +008000 DESCENDING KEY IS FIELD-3 FIELD-4 INDEXED BY IDX-4 NC2384.2 +008100 IDX-5 IDX-6. NC2384.2 +008200 03 FIELD-1 PICTURE 9. NC2384.2 +008300 03 FIELD-2 PICTURE 9. NC2384.2 +008400 03 FIELD-3 PICTURE 9. NC2384.2 +008500 03 FIELD-4 PICTURE 9. NC2384.2 +008600 03 2ND-ENTRY OCCURS 4 TIMES DESCENDING IS FIELD-5 NC2384.2 +008700 FIELD-6 FIELD-7 FIELD-8 INDEXED IDX-7 IDX-8 IDX-9. NC2384.2 +008800 04 FIELD-5 PICTURE X. NC2384.2 +008900 04 FIELD-6 PICTURE X. NC2384.2 +009000 04 FIELD-7 PICTURE X. NC2384.2 +009100 04 FIELD-8 PICTURE X. NC2384.2 +009200 01 NOTE-1. NC2384.2 +009300 02 FILLER PICTURE X(74) VALUE NC2384.2 +009400 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2384.2 +009500- "PATH WAS TAKEN". NC2384.2 +009600 02 FILLER PICTURE X(46) VALUE SPACES. NC2384.2 +009700 01 NOTE-2. NC2384.2 +009800 02 FILLER PICTURE X(112) VALUE NC2384.2 +009900 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2384.2 +010000- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2384.2 +010100 02 FILLER PICTURE X(8) VALUE SPACES. NC2384.2 +010200 NC2384.2 +010300 01 END-STMT. NC2384.2 +010400 02 FILLER PICTURE X(7) VALUE "AT END ". NC2384.2 +010500 02 END-IDX PICTURE X(5) VALUE SPACES. NC2384.2 +010600 02 FILLER PICTURE XXX VALUE " = ". NC2384.2 +010700 02 IDX-VALU PICTURE 99 VALUE 00. NC2384.2 +010800 02 FILLER PICTURE XXX VALUE SPACES. NC2384.2 +010900 01 TEST-RESULTS. NC2384.2 +011000 02 FILLER PIC X VALUE SPACE. NC2384.2 +011100 02 FEATURE PIC X(20) VALUE SPACE. NC2384.2 +011200 02 FILLER PIC X VALUE SPACE. NC2384.2 +011300 02 P-OR-F PIC X(5) VALUE SPACE. NC2384.2 +011400 02 FILLER PIC X VALUE SPACE. NC2384.2 +011500 02 PAR-NAME. NC2384.2 +011600 03 FILLER PIC X(19) VALUE SPACE. NC2384.2 +011700 03 PARDOT-X PIC X VALUE SPACE. NC2384.2 +011800 03 DOTVALUE PIC 99 VALUE ZERO. NC2384.2 +011900 02 FILLER PIC X(8) VALUE SPACE. NC2384.2 +012000 02 RE-MARK PIC X(61). NC2384.2 +012100 01 TEST-COMPUTED. NC2384.2 +012200 02 FILLER PIC X(30) VALUE SPACE. NC2384.2 +012300 02 FILLER PIC X(17) VALUE NC2384.2 +012400 " COMPUTED=". NC2384.2 +012500 02 COMPUTED-X. NC2384.2 +012600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2384.2 +012700 03 COMPUTED-N REDEFINES COMPUTED-A NC2384.2 +012800 PIC -9(9).9(9). NC2384.2 +012900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2384.2 +013000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2384.2 +013100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2384.2 +013200 03 CM-18V0 REDEFINES COMPUTED-A. NC2384.2 +013300 04 COMPUTED-18V0 PIC -9(18). NC2384.2 +013400 04 FILLER PIC X. NC2384.2 +013500 03 FILLER PIC X(50) VALUE SPACE. NC2384.2 +013600 01 TEST-CORRECT. NC2384.2 +013700 02 FILLER PIC X(30) VALUE SPACE. NC2384.2 +013800 02 FILLER PIC X(17) VALUE " CORRECT =". NC2384.2 +013900 02 CORRECT-X. NC2384.2 +014000 03 CORRECT-A PIC X(20) VALUE SPACE. NC2384.2 +014100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2384.2 +014200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2384.2 +014300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2384.2 +014400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2384.2 +014500 03 CR-18V0 REDEFINES CORRECT-A. NC2384.2 +014600 04 CORRECT-18V0 PIC -9(18). NC2384.2 +014700 04 FILLER PIC X. NC2384.2 +014800 03 FILLER PIC X(2) VALUE SPACE. NC2384.2 +014900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2384.2 +015000 01 CCVS-C-1. NC2384.2 +015100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2384.2 +015200- "SS PARAGRAPH-NAME NC2384.2 +015300- " REMARKS". NC2384.2 +015400 02 FILLER PIC X(20) VALUE SPACE. NC2384.2 +015500 01 CCVS-C-2. NC2384.2 +015600 02 FILLER PIC X VALUE SPACE. NC2384.2 +015700 02 FILLER PIC X(6) VALUE "TESTED". NC2384.2 +015800 02 FILLER PIC X(15) VALUE SPACE. NC2384.2 +015900 02 FILLER PIC X(4) VALUE "FAIL". NC2384.2 +016000 02 FILLER PIC X(94) VALUE SPACE. NC2384.2 +016100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2384.2 +016200 01 REC-CT PIC 99 VALUE ZERO. NC2384.2 +016300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2384.2 +016800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2384.2 +016900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2384.2 +017000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2384.2 +017100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2384.2 +017200 01 CCVS-H-1. NC2384.2 +017300 02 FILLER PIC X(39) VALUE SPACES. NC2384.2 +017400 02 FILLER PIC X(42) VALUE NC2384.2 +017500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2384.2 +017600 02 FILLER PIC X(39) VALUE SPACES. NC2384.2 +017700 01 CCVS-H-2A. NC2384.2 +017800 02 FILLER PIC X(40) VALUE SPACE. NC2384.2 +017900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2384.2 +018000 02 FILLER PIC XXXX VALUE NC2384.2 +018100 "4.2 ". NC2384.2 +018200 02 FILLER PIC X(28) VALUE NC2384.2 +018300 " COPY - NOT FOR DISTRIBUTION". NC2384.2 +018400 02 FILLER PIC X(41) VALUE SPACE. NC2384.2 +018500 NC2384.2 +018600 01 CCVS-H-2B. NC2384.2 +018700 02 FILLER PIC X(15) VALUE NC2384.2 +018800 "TEST RESULT OF ". NC2384.2 +018900 02 TEST-ID PIC X(9). NC2384.2 +019000 02 FILLER PIC X(4) VALUE NC2384.2 +019100 " IN ". NC2384.2 +019200 02 FILLER PIC X(12) VALUE NC2384.2 +019300 " HIGH ". NC2384.2 +019400 02 FILLER PIC X(22) VALUE NC2384.2 +019500 " LEVEL VALIDATION FOR ". NC2384.2 +019600 02 FILLER PIC X(58) VALUE NC2384.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +019800 01 CCVS-H-3. NC2384.2 +019900 02 FILLER PIC X(34) VALUE NC2384.2 +020000 " FOR OFFICIAL USE ONLY ". NC2384.2 +020100 02 FILLER PIC X(58) VALUE NC2384.2 +020200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2384.2 +020300 02 FILLER PIC X(28) VALUE NC2384.2 +020400 " COPYRIGHT 1985 ". NC2384.2 +020500 01 CCVS-E-1. NC2384.2 +020600 02 FILLER PIC X(52) VALUE SPACE. NC2384.2 +020700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2384.2 +020800 02 ID-AGAIN PIC X(9). NC2384.2 +020900 02 FILLER PIC X(45) VALUE SPACES. NC2384.2 +021000 01 CCVS-E-2. NC2384.2 +021100 02 FILLER PIC X(31) VALUE SPACE. NC2384.2 +021200 02 FILLER PIC X(21) VALUE SPACE. NC2384.2 +021300 02 CCVS-E-2-2. NC2384.2 +021400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2384.2 +021500 03 FILLER PIC X VALUE SPACE. NC2384.2 +021600 03 ENDER-DESC PIC X(44) VALUE NC2384.2 +021700 "ERRORS ENCOUNTERED". NC2384.2 +021800 01 CCVS-E-3. NC2384.2 +021900 02 FILLER PIC X(22) VALUE NC2384.2 +022000 " FOR OFFICIAL USE ONLY". NC2384.2 +022100 02 FILLER PIC X(12) VALUE SPACE. NC2384.2 +022200 02 FILLER PIC X(58) VALUE NC2384.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +022400 02 FILLER PIC X(13) VALUE SPACE. NC2384.2 +022500 02 FILLER PIC X(15) VALUE NC2384.2 +022600 " COPYRIGHT 1985". NC2384.2 +022700 01 CCVS-E-4. NC2384.2 +022800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2384.2 +022900 02 FILLER PIC X(4) VALUE " OF ". NC2384.2 +023000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2384.2 +023100 02 FILLER PIC X(40) VALUE NC2384.2 +023200 " TESTS WERE EXECUTED SUCCESSFULLY". NC2384.2 +023300 01 XXINFO. NC2384.2 +023400 02 FILLER PIC X(19) VALUE NC2384.2 +023500 "*** INFORMATION ***". NC2384.2 +023600 02 INFO-TEXT. NC2384.2 +023700 04 FILLER PIC X(8) VALUE SPACE. NC2384.2 +023800 04 XXCOMPUTED PIC X(20). NC2384.2 +023900 04 FILLER PIC X(5) VALUE SPACE. NC2384.2 +024000 04 XXCORRECT PIC X(20). NC2384.2 +024100 02 INF-ANSI-REFERENCE PIC X(48). NC2384.2 +024200 01 HYPHEN-LINE. NC2384.2 +024300 02 FILLER PIC IS X VALUE IS SPACE. NC2384.2 +024400 02 FILLER PIC IS X(65) VALUE IS "************************NC2384.2 +024500- "*****************************************". NC2384.2 +024600 02 FILLER PIC IS X(54) VALUE IS "************************NC2384.2 +024700- "******************************". NC2384.2 +024800 01 CCVS-PGM-ID PIC X(9) VALUE NC2384.2 +024900 "NC238A". NC2384.2 +025000 PROCEDURE DIVISION. NC2384.2 +025100 CCVS1 SECTION. NC2384.2 +025200 OPEN-FILES. NC2384.2 +025300 OPEN OUTPUT PRINT-FILE. NC2384.2 +025400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2384.2 +025500 MOVE SPACE TO TEST-RESULTS. NC2384.2 +025600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2384.2 +025700 GO TO CCVS1-EXIT. NC2384.2 +025800 CLOSE-FILES. NC2384.2 +025900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2384.2 +026000 TERMINATE-CCVS. NC2384.2 +026100S EXIT PROGRAM. NC2384.2 +026200STERMINATE-CALL. NC2384.2 +026300 STOP RUN. NC2384.2 +026400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2384.2 +026500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2384.2 +026600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2384.2 +026700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2384.2 +026800 MOVE "****TEST DELETED****" TO RE-MARK. NC2384.2 +026900 PRINT-DETAIL. NC2384.2 +027000 IF REC-CT NOT EQUAL TO ZERO NC2384.2 +027100 MOVE "." TO PARDOT-X NC2384.2 +027200 MOVE REC-CT TO DOTVALUE. NC2384.2 +027300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2384.2 +027400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2384.2 +027500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2384.2 +027600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2384.2 +027700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2384.2 +027800 MOVE SPACE TO CORRECT-X. NC2384.2 +027900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2384.2 +028000 MOVE SPACE TO RE-MARK. NC2384.2 +028100 HEAD-ROUTINE. NC2384.2 +028200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2384.2 +028500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2384.2 +028600 COLUMN-NAMES-ROUTINE. NC2384.2 +028700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +028800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +029000 END-ROUTINE. NC2384.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2384.2 +029200 END-RTN-EXIT. NC2384.2 +029300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +029400 END-ROUTINE-1. NC2384.2 +029500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2384.2 +029600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2384.2 +029700 ADD PASS-COUNTER TO ERROR-HOLD. NC2384.2 +029800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2384.2 +029900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2384.2 +030000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2384.2 +030100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2384.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2384.2 +030300 END-ROUTINE-12. NC2384.2 +030400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2384.2 +030500 IF ERROR-COUNTER IS EQUAL TO ZERO NC2384.2 +030600 MOVE "NO " TO ERROR-TOTAL NC2384.2 +030700 ELSE NC2384.2 +030800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2384.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2384.2 +031000 PERFORM WRITE-LINE. NC2384.2 +031100 END-ROUTINE-13. NC2384.2 +031200 IF DELETE-COUNTER IS EQUAL TO ZERO NC2384.2 +031300 MOVE "NO " TO ERROR-TOTAL ELSE NC2384.2 +031400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2384.2 +031500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2384.2 +031600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +031700 IF INSPECT-COUNTER EQUAL TO ZERO NC2384.2 +031800 MOVE "NO " TO ERROR-TOTAL NC2384.2 +031900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2384.2 +032000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2384.2 +032100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +032200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +032300 WRITE-LINE. NC2384.2 +032400 ADD 1 TO RECORD-COUNT. NC2384.2 +032500Y IF RECORD-COUNT GREATER 50 NC2384.2 +032600Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2384.2 +032700Y MOVE SPACE TO DUMMY-RECORD NC2384.2 +032800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2384.2 +032900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2384.2 +033000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2384.2 +033100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2384.2 +033200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2384.2 +033300Y MOVE ZERO TO RECORD-COUNT. NC2384.2 +033400 PERFORM WRT-LN. NC2384.2 +033500 WRT-LN. NC2384.2 +033600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2384.2 +033700 MOVE SPACE TO DUMMY-RECORD. NC2384.2 +033800 BLANK-LINE-PRINT. NC2384.2 +033900 PERFORM WRT-LN. NC2384.2 +034000 FAIL-ROUTINE. NC2384.2 +034100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2384.2 +034200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2384.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2384.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2384.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +034600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2384.2 +034700 GO TO FAIL-ROUTINE-EX. NC2384.2 +034800 FAIL-ROUTINE-WRITE. NC2384.2 +034900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2384.2 +035000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2384.2 +035100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2384.2 +035200 MOVE SPACES TO COR-ANSI-REFERENCE. NC2384.2 +035300 FAIL-ROUTINE-EX. EXIT. NC2384.2 +035400 BAIL-OUT. NC2384.2 +035500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2384.2 +035600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2384.2 +035700 BAIL-OUT-WRITE. NC2384.2 +035800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2384.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2384.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2384.2 +036200 BAIL-OUT-EX. EXIT. NC2384.2 +036300 CCVS1-EXIT. NC2384.2 +036400 EXIT. NC2384.2 +036500 SECT-NC238A-001 SECTION. NC2384.2 +036600 TH-11-001. NC2384.2 +036700 SET IDX-4 IDX-7 TO 01. NC2384.2 +036800 BUILD-LOOP-1. NC2384.2 +036900 MOVE SUB-5 TO FIELD-1 (IDX-4) FIELD-2 (IDX-4). NC2384.2 +037000 MOVE SUB-4 TO FIELD-3 (IDX-4) FIELD-4 (IDX-4). NC2384.2 +037100 PERFORM BUILD-ENTRY-2 THRU ENTRY-2-EXIT. NC2384.2 +037200 IF 2ND-ENTRY (4, 4) EQUAL TO "AAAA" GO TO BUILD-EXIT. NC2384.2 +037300 ADD 1 TO SUB-5. NC2384.2 +037400 SUBTRACT 1 FROM SUB-4. NC2384.2 +037500 SET IDX-4 UP BY 1. NC2384.2 +037600 GO TO BUILD-LOOP-1. NC2384.2 +037700 BUILD-ENTRY-2. NC2384.2 +037800 MOVE ALPHA-BET (SUB-6) TO 2ND-ENTRY (IDX-4, IDX-7). NC2384.2 +037900 IF IDX-7 EQUAL TO 4 NC2384.2 +038000 SET IDX-7 TO 1 NC2384.2 +038100 ADD 1 TO SUB-6 NC2384.2 +038200 GO TO ENTRY-2-EXIT. NC2384.2 +038300 SET IDX-7 UP BY 1. NC2384.2 +038400 ADD 1 TO SUB-6. NC2384.2 +038500 GO TO BUILD-ENTRY-2. NC2384.2 +038600 ENTRY-2-EXIT. NC2384.2 +038700 EXIT. NC2384.2 +038800 BUILD-EXIT. NC2384.2 +038900 EXIT. NC2384.2 +039000* NC2384.2 +039100 SCH-INIT-F1-1. NC2384.2 +039200 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2384.2 +039300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +039400 MOVE "SEARCH" TO FEATURE. NC2384.2 +039500 MOVE "IMPLIED VARYING OPTION" TO RE-MARK. NC2384.2 +039600 SET IDX-4 TO 01. NC2384.2 +039700 SCH-TEST-F1-1. NC2384.2 +039800 SEARCH 1ST-ENTRY NC2384.2 +039900 WHEN 1ST-ENTRY (IDX-4) EQUAL TO "2288LLLLKKKKJJJJIIII" NC2384.2 +040000 MOVE 1ST-ENTRY (IDX-4) TO LEVEL-HOLD. NC2384.2 +040100 IF LEVEL-HOLD EQUAL TO "2288" NC2384.2 +040200 PERFORM PASS NC2384.2 +040300 GO TO SCH-WRITE-F1-1. NC2384.2 +040400 GO TO SCH-FAIL-F1-1. NC2384.2 +040500 SCH-DELETE-F1-1. NC2384.2 +040600 PERFORM DE-LETE. NC2384.2 +040700 GO TO SCH-WRITE-F1-1. NC2384.2 +040800 SCH-FAIL-F1-1. NC2384.2 +040900 MOVE "2288" TO CORRECT-A. NC2384.2 +041000 MOVE "ENTRY NOT FOUND" TO COMPUTED-A. NC2384.2 +041100 PERFORM FAIL. NC2384.2 +041200 SCH-WRITE-F1-1. NC2384.2 +041300 PERFORM PRINT-DETAIL. NC2384.2 +041400* NC2384.2 +041500 SCH-INIT-F1-2. NC2384.2 +041600 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2384.2 +041700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +041800 MOVE "FORMAT 1 VARYING OPTION" TO RE-MARK. NC2384.2 +041900 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +042000 SET IDX-5 TO 04. NC2384.2 +042100 SCH-TEST-F1-2. NC2384.2 +042200 SEARCH 1ST-ENTRY VARYING IDX-5 NC2384.2 +042300 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +042400 WHEN FIELD-1 (IDX-5) EQUAL TO 3 NC2384.2 +042500 MOVE FIELD-1 (IDX-5) TO LEVEL-HOLD NC2384.2 +042600 WHEN FIELD-4 (IDX-5) EQUAL TO 6 NC2384.2 +042700 MOVE FIELD-4 (IDX-5) TO LEVEL-HOLD. NC2384.2 +042800 MOVE "FORMAT 1 W/0 VARYING" TO RE-MARK. NC2384.2 +042900 IF LEVEL-HOLD EQUAL TO "6 " NC2384.2 +043000 PERFORM PASS NC2384.2 +043100 GO TO SCH-WRITE-F1-2. NC2384.2 +043200 GO TO SCH-FAIL-F1-2. NC2384.2 +043300 SCH-DELETE-F1-2. NC2384.2 +043400 PERFORM DE-LETE. NC2384.2 +043500 GO TO SCH-WRITE-F1-2. NC2384.2 +043600 SCH-FAIL-F1-2. NC2384.2 +043700 MOVE "6" TO CORRECT-A. NC2384.2 +043800 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +043900 PERFORM FAIL. NC2384.2 +044000 SCH-WRITE-F1-2. NC2384.2 +044100 PERFORM PRINT-DETAIL. NC2384.2 +044200* NC2384.2 +044300 SCH-INIT-F1-3. NC2384.2 +044400 MOVE "SCH-TEST-F1-3" TO PAR-NAME. NC2384.2 +044500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +044600 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +044700 SET IDX-5 TO 03. NC2384.2 +044800 SET IDX-8 TO 01. NC2384.2 +044900 SCH-TEST-F1-3. NC2384.2 +045000 SEARCH 2ND-ENTRY VARYING IDX-8 NC2384.2 +045100 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +045200 WHEN FIELD-7 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045300 MOVE FIELD-7 (IDX-5, IDX-8) TO LEVEL-HOLD NC2384.2 +045400 WHEN FIELD-5 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045500 MOVE FIELD-5 (IDX-5, IDX-8) TO LEVEL-HOLD NC2384.2 +045600 WHEN FIELD-8 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045700 MOVE FIELD-8 (IDX-5, IDX-8) TO LEVEL-HOLD. NC2384.2 +045800 IF LEVEL-HOLD EQUAL TO "E " NC2384.2 +045900 PERFORM PASS NC2384.2 +046000 GO TO SCH-WRITE-F1-3. NC2384.2 +046100 GO TO SCH-FAIL-F1-3. NC2384.2 +046200 SCH-DELETE-F1-3. NC2384.2 +046300 PERFORM DE-LETE. NC2384.2 +046400 GO TO SCH-WRITE-F1-3. NC2384.2 +046500 SCH-FAIL-F1-3. NC2384.2 +046600 MOVE "E" TO CORRECT-A. NC2384.2 +046700 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +046800 PERFORM FAIL. NC2384.2 +046900 SCH-WRITE-F1-3. NC2384.2 +047000 PERFORM PRINT-DETAIL. NC2384.2 +047100* NC2384.2 +047200 SCH-INIT-F1-4. NC2384.2 +047300 MOVE "SCH-TEST-F1-4" TO PAR-NAME. NC2384.2 +047400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +047500 MOVE "SEARCH VARYING" TO FEATURE. NC2384.2 +047600 MOVE "WHEN-COMPOUND CONDITION" TO RE-MARK. NC2384.2 +047700 SET IDX-4 IDX-9 TO 04. NC2384.2 +047800 SCH-TEST-F1-4. NC2384.2 +047900 SEARCH 2ND-ENTRY VARYING IDX-9 NC2384.2 +048000 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +048100 WHEN FIELD-6 (IDX-4, IDX-9) NOT EQUAL TO "A" NC2384.2 +048200 AND FIELD-7 (IDX-4, IDX-9) NOT EQUAL TO "A" NC2384.2 +048300 MOVE "A" TO LEVEL-HOLD. NC2384.2 +048400 IF LEVEL-HOLD EQUAL TO SPACES NC2384.2 +048500 PERFORM PASS NC2384.2 +048600 GO TO SCH-WRITE-F1-4. NC2384.2 +048700 GO TO SCH-FAIL-F1-4. NC2384.2 +048800 SCH-DELETE-F1-4. NC2384.2 +048900 PERFORM DE-LETE. NC2384.2 +049000 GO TO SCH-WRITE-F1-4. NC2384.2 +049100 SCH-FAIL-F1-4. NC2384.2 +049200 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +049300 MOVE "NO SUCH ENTRY" TO CORRECT-A. NC2384.2 +049400 PERFORM FAIL. NC2384.2 +049500 SCH-WRITE-F1-4. NC2384.2 +049600 PERFORM PRINT-DETAIL. NC2384.2 +049700* NC2384.2 +049800 SCH-INIT-F1-5. NC2384.2 +049900 MOVE "SCH-TEST-F1-5" TO PAR-NAME. NC2384.2 +050000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +050100 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +050200 SET IDX-6 TO 02. NC2384.2 +050300 SET IDX-7 TO 02. NC2384.2 +050400 SCH-TEST-F1-5. NC2384.2 +050500 SEARCH 2ND-ENTRY VARYING IDX-7 NC2384.2 +050600 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +050700 WHEN FIELD-5 (IDX-6, IDX-7) EQUAL TO "M" NC2384.2 +050800 MOVE FIELD-5 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +050900 WHEN FIELD-6 (IDX-6, IDX-7) EQUAL TO "N" NC2384.2 +051000 MOVE FIELD-6 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +051100 WHEN FIELD-7 (IDX-6, IDX-7) EQUAL TO "O" NC2384.2 +051200 MOVE FIELD-7 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +051300 WHEN FIELD-8 (IDX-6, IDX-7) EQUAL TO "I" NC2384.2 +051400 MOVE FIELD-8 (IDX-6, IDX-7) TO LEVEL-HOLD. NC2384.2 +051500 IF LEVEL-HOLD EQUAL TO "I " NC2384.2 +051600 PERFORM PASS NC2384.2 +051700 GO TO SCH-WRITE-F1-5. NC2384.2 +051800 GO TO SCH-FAIL-F1-5. NC2384.2 +051900 SCH-DELETE-F1-5. NC2384.2 +052000 PERFORM DE-LETE. NC2384.2 +052100 GO TO SCH-WRITE-F1-5. NC2384.2 +052200 SCH-FAIL-F1-5. NC2384.2 +052300 MOVE "I" TO CORRECT-A. NC2384.2 +052400 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +052500 PERFORM FAIL. NC2384.2 +052600 SCH-WRITE-F1-5. NC2384.2 +052700 PERFORM PRINT-DETAIL. NC2384.2 +052800* NC2384.2 +052900 SCH-INIT-F2-6. NC2384.2 +053000 MOVE "SCH-TEST-F2-6" TO PAR-NAME. NC2384.2 +053100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +053200 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +053300 MOVE "WHEN-COMPOUND CONDITION" TO RE-MARK. NC2384.2 +053400 SCH-TEST-F2-6. NC2384.2 +053500 SEARCH ALL 1ST-ENTRY NC2384.2 +053600 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +053700 WHEN FIELD-1 (IDX-4) EQUAL TO 2 AND NC2384.2 +053800 FIELD-2 (IDX-4) EQUAL TO 2 MOVE 2 TO LEVEL-HOLD. NC2384.2 +053900 IF LEVEL-HOLD EQUAL TO "2 " NC2384.2 +054000 PERFORM PASS NC2384.2 +054100 GO TO SCH-WRITE-F2-6. NC2384.2 +054200 GO TO SCH-FAIL-F2-6. NC2384.2 +054300 SCH-DELETE-F2-6. NC2384.2 +054400 PERFORM DE-LETE. NC2384.2 +054500 GO TO SCH-WRITE-F2-6. NC2384.2 +054600 SCH-FAIL-F2-6. NC2384.2 +054700 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +054800 MOVE "2" TO CORRECT-A. NC2384.2 +054900 PERFORM FAIL. NC2384.2 +055000 SCH-WRITE-F2-6. NC2384.2 +055100 PERFORM PRINT-DETAIL. NC2384.2 +055200* NC2384.2 +055300 SCH-INIT-F2-7. NC2384.2 +055400 MOVE "SCH-TEST-F2-7" TO PAR-NAME. NC2384.2 +055500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +055600 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +055700 SCH-TEST-F2-7. NC2384.2 +055800 SEARCH ALL 1ST-ENTRY NC2384.2 +055900 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +056000 WHEN FIELD-1 (IDX-4) EQUAL TO 4 AND NC2384.2 +056100 FIELD-2 (IDX-4) EQUAL TO 4 AND NC2384.2 +056200 FIELD-3 (IDX-4) EQUAL TO 6 AND NC2384.2 +056300 FIELD-4 (IDX-4) EQUAL TO 6 NC2384.2 +056400 MOVE 6 TO LEVEL-HOLD. NC2384.2 +056500 IF LEVEL-HOLD EQUAL TO "6 " NC2384.2 +056600 PERFORM PASS NC2384.2 +056700 GO TO SCH-WRITE-F2-7. NC2384.2 +056800 GO TO SCH-FAIL-F2-7. NC2384.2 +056900 SCH-DELETE-F2-7. NC2384.2 +057000 PERFORM DE-LETE. NC2384.2 +057100 GO TO SCH-WRITE-F2-7. NC2384.2 +057200 SCH-FAIL-F2-7. NC2384.2 +057300 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +057400 MOVE "6" TO CORRECT-A. NC2384.2 +057500 PERFORM FAIL. NC2384.2 +057600 SCH-WRITE-F2-7. NC2384.2 +057700 PERFORM PRINT-DETAIL. NC2384.2 +057800* NC2384.2 +057900 SCH-INIT-F2-8. NC2384.2 +058000 MOVE "SCH-TEST-F2-8" TO PAR-NAME. NC2384.2 +058100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +058200 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +058300 MOVE SPACES TO LEVEL-HOLD. NC2384.2 +058400 SET IDX-4 TO 01. NC2384.2 +058500 SCH-TEST-F2-8. NC2384.2 +058600 SEARCH ALL 2ND-ENTRY NC2384.2 +058700 WHEN FIELD-5 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +058800 FIELD-6 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +058900 FIELD-7 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +059000 FIELD-8 (IDX-4, IDX-7) EQUAL TO "P" NC2384.2 +059100 MOVE "OOOP" TO LEVEL-HOLD. NC2384.2 +059200 IF LEVEL-HOLD EQUAL TO "OOOP" NC2384.2 +059300 GO TO SCH-FAIL-F2-8. NC2384.2 +059400 PERFORM PASS. NC2384.2 +059500 GO TO SCH-WRITE-F2-8. NC2384.2 +059600 SCH-DELETE-F2-8. NC2384.2 +059700 PERFORM DE-LETE. NC2384.2 +059800 GO TO SCH-WRITE-F2-8. NC2384.2 +059900 SCH-FAIL-F2-8. NC2384.2 +060000 MOVE "NO SUCH ENTRY" TO CORRECT-A NC2384.2 +060100 MOVE LEVEL-HOLD TO COMPUTED-A NC2384.2 +060200 PERFORM FAIL. NC2384.2 +060300 SCH-WRITE-F2-8. NC2384.2 +060400 PERFORM PRINT-DETAIL. NC2384.2 +060500* NC2384.2 +060600 SCH-INIT-F2-9. NC2384.2 +060700 MOVE "SCH-TEST-F2-9" TO PAR-NAME. NC2384.2 +060800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +060900 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +061000 MOVE SPACES TO LEVEL-HOLD. NC2384.2 +061100 SET IDX-4 TO 04. NC2384.2 +061200 SCH-TEST-F2-9. NC2384.2 +061300 SEARCH ALL 2ND-ENTRY NC2384.2 +061400 WHEN FIELD-5 (IDX-4, IDX-7) EQUAL TO "B" AND NC2384.2 +061500 FIELD-6 (IDX-4, IDX-7) EQUAL TO "B" NC2384.2 +061600 MOVE "BB" TO LEVEL-HOLD. NC2384.2 +061700 IF LEVEL-HOLD EQUAL TO "BB " NC2384.2 +061800 PERFORM PASS NC2384.2 +061900 GO TO SCH-WRITE-F2-9. NC2384.2 +062000 GO TO SCH-FAIL-F2-9. NC2384.2 +062100 SCH-DELETE-F2-9. NC2384.2 +062200 PERFORM DE-LETE. NC2384.2 +062300 GO TO SCH-WRITE-F2-9. NC2384.2 +062400 SCH-FAIL-F2-9. NC2384.2 +062500 MOVE "BB " TO CORRECT-A. NC2384.2 +062600 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +062700 PERFORM FAIL. NC2384.2 +062800 SCH-WRITE-F2-9. NC2384.2 +062900 PERFORM PRINT-DETAIL. NC2384.2 +063000* NC2384.2 +063100 SCH-INIT-F2-10. NC2384.2 +063200* ===--> ARITHMETIC EXPRESSION OF ZERO <--=== NC2384.2 +063300 MOVE "SCH-TEST-F2-10" TO PAR-NAME. NC2384.2 +063400 MOVE "VI-51 6.2" TO ANSI-REFERENCE. NC2384.2 +063500 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +063600 MOVE "ARITHMETIC EXPRESSION OF ZERO" TO RE-MARK. NC2384.2 +063700 SCH-TEST-F2-10. NC2384.2 +063800 SEARCH ALL 1ST-ENTRY NC2384.2 +063900 AT END MOVE ZERO TO LEVEL-HOLD NC2384.2 +064000 WHEN FIELD-1 (IDX-4) EQUAL TO ZERO NC2384.2 +064100 MOVE 2 TO LEVEL-HOLD. NC2384.2 +064200 IF LEVEL-HOLD EQUAL TO ZERO NC2384.2 +064300 PERFORM PASS NC2384.2 +064400 GO TO SCH-WRITE-F2-10. NC2384.2 +064500 GO TO SCH-FAIL-F2-10. NC2384.2 +064600 SCH-DELETE-F2-10. NC2384.2 +064700 PERFORM DE-LETE. NC2384.2 +064800 GO TO SCH-WRITE-F2-10. NC2384.2 +064900 SCH-FAIL-F2-10. NC2384.2 +065000 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +065100 MOVE ZERO TO CORRECT-A. NC2384.2 +065200 PERFORM FAIL. NC2384.2 +065300 SCH-WRITE-F2-10. NC2384.2 +065400 PERFORM PRINT-DETAIL. NC2384.2 +065500* NC2384.2 +065600 CCVS-EXIT SECTION. NC2384.2 +065700 CCVS-999999. NC2384.2 +065800 GO TO CLOSE-FILES. NC2384.2 +*END-OF,NC238A +*HEADER,COBOL,NC239A +000100 IDENTIFICATION DIVISION. NC2394.2 +000200 PROGRAM-ID. NC2394.2 +000300 NC239A. NC2394.2 +000400**************************************************************** NC2394.2 +000500* * NC2394.2 +000600* VALIDATION FOR:- * NC2394.2 +000700* * NC2394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +000900* * NC2394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2394.2 +001100* * NC2394.2 +001200**************************************************************** NC2394.2 +001300* * NC2394.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2394.2 +001500* * NC2394.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2394.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2394.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2394.2 +001900* * NC2394.2 +002000**************************************************************** NC2394.2 +002100* * NC2394.2 +002200* PROGRAM NC239A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2394.2 +002300* THREE-DIMENSIONAL TABLE USING INDICES. * NC2394.2 +002400* VALUES ARE VERIFIED USING THE "IF" STATEMENT. * NC2394.2 +002500* ~ * NC2394.2 +002600**************************************************************** NC2394.2 +002700 ENVIRONMENT DIVISION. NC2394.2 +002800 CONFIGURATION SECTION. NC2394.2 +002900 SOURCE-COMPUTER. NC2394.2 +003000 XXXXX082. NC2394.2 +003100 OBJECT-COMPUTER. NC2394.2 +003200 XXXXX083. NC2394.2 +003300 INPUT-OUTPUT SECTION. NC2394.2 +003400 FILE-CONTROL. NC2394.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2394.2 +003600 XXXXX055. NC2394.2 +003700 DATA DIVISION. NC2394.2 +003800 FILE SECTION. NC2394.2 +003900 FD PRINT-FILE. NC2394.2 +004000 01 PRINT-REC PICTURE X(120). NC2394.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2394.2 +004200 WORKING-STORAGE SECTION. NC2394.2 +004300 77 SUB-1 PICTURE S99 VALUE ZERO. NC2394.2 +004400 77 SUB-2 PICTURE 99 VALUE ZERO. NC2394.2 +004500 77 SUB-3 PICTURE 99 VALUE ZERO. NC2394.2 +004600 77 CON-7 PICTURE 99 VALUE 07. NC2394.2 +004700 77 CON-10 PICTURE 99 VALUE 10. NC2394.2 +004800 77 CON-5 PICTURE 99 VALUE 05. NC2394.2 +004900 77 CON-6 PICTURE 99 VALUE 06. NC2394.2 +005000 01 GRP-NAME. NC2394.2 +005100 02 FILLER PICTURE XXX VALUE "GRP". NC2394.2 +005200 02 ADD-GRP PICTURE 99 VALUE 01. NC2394.2 +005300 NC2394.2 +005400 01 SEC-NAME. NC2394.2 +005500 02 FILLER PICTURE X(5) VALUE "SEC (". NC2394.2 +005600 02 SEC-GRP PICTURE 99 VALUE 00. NC2394.2 +005700 02 FILLER PICTURE X VALUE ",". NC2394.2 +005800 02 ADD-SEC PICTURE 99 VALUE 01. NC2394.2 +005900 02 FILLER PICTURE X VALUE ")". NC2394.2 +006000 NC2394.2 +006100 01 ELEM-NAME. NC2394.2 +006200 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2394.2 +006300 02 ELEM-GRP PICTURE 99 VALUE 00. NC2394.2 +006400 02 FILLER PICTURE X VALUE ",". NC2394.2 +006500 02 ELEM-SEC PICTURE 99 VALUE 00. NC2394.2 +006600 02 FILLER PICTURE X VALUE ",". NC2394.2 +006700 02 ADD-ELEM PICTURE 99 VALUE 01. NC2394.2 +006800 02 FILLER PICTURE X VALUE ")". NC2394.2 +006900 NC2394.2 +007000 01 3-DIMENSION-TBL. NC2394.2 +007100 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2394.2 +007200 03 ENTRY-1 PICTURE X(5). NC2394.2 +007300 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2394.2 +007400 04 ENTRY-2 PICTURE X(11). NC2394.2 +007500 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2394.2 +007600 05 ENTRY-3 PICTURE X(15). NC2394.2 +007700 NC2394.2 +007800 01 TEST-RESULTS. NC2394.2 +007900 02 FILLER PIC X VALUE SPACE. NC2394.2 +008000 02 FEATURE PIC X(20) VALUE SPACE. NC2394.2 +008100 02 FILLER PIC X VALUE SPACE. NC2394.2 +008200 02 P-OR-F PIC X(5) VALUE SPACE. NC2394.2 +008300 02 FILLER PIC X VALUE SPACE. NC2394.2 +008400 02 PAR-NAME. NC2394.2 +008500 03 FILLER PIC X(19) VALUE SPACE. NC2394.2 +008600 03 PARDOT-X PIC X VALUE SPACE. NC2394.2 +008700 03 DOTVALUE PIC 99 VALUE ZERO. NC2394.2 +008800 02 FILLER PIC X(8) VALUE SPACE. NC2394.2 +008900 02 RE-MARK PIC X(61). NC2394.2 +009000 01 TEST-COMPUTED. NC2394.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2394.2 +009200 02 FILLER PIC X(17) VALUE NC2394.2 +009300 " COMPUTED=". NC2394.2 +009400 02 COMPUTED-X. NC2394.2 +009500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2394.2 +009600 03 COMPUTED-N REDEFINES COMPUTED-A NC2394.2 +009700 PIC -9(9).9(9). NC2394.2 +009800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2394.2 +009900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2394.2 +010000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2394.2 +010100 03 CM-18V0 REDEFINES COMPUTED-A. NC2394.2 +010200 04 COMPUTED-18V0 PIC -9(18). NC2394.2 +010300 04 FILLER PIC X. NC2394.2 +010400 03 FILLER PIC X(50) VALUE SPACE. NC2394.2 +010500 01 TEST-CORRECT. NC2394.2 +010600 02 FILLER PIC X(30) VALUE SPACE. NC2394.2 +010700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2394.2 +010800 02 CORRECT-X. NC2394.2 +010900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2394.2 +011000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2394.2 +011100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2394.2 +011200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2394.2 +011300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2394.2 +011400 03 CR-18V0 REDEFINES CORRECT-A. NC2394.2 +011500 04 CORRECT-18V0 PIC -9(18). NC2394.2 +011600 04 FILLER PIC X. NC2394.2 +011700 03 FILLER PIC X(2) VALUE SPACE. NC2394.2 +011800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2394.2 +011900 01 CCVS-C-1. NC2394.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2394.2 +012100- "SS PARAGRAPH-NAME NC2394.2 +012200- " REMARKS". NC2394.2 +012300 02 FILLER PIC X(20) VALUE SPACE. NC2394.2 +012400 01 CCVS-C-2. NC2394.2 +012500 02 FILLER PIC X VALUE SPACE. NC2394.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". NC2394.2 +012700 02 FILLER PIC X(15) VALUE SPACE. NC2394.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". NC2394.2 +012900 02 FILLER PIC X(94) VALUE SPACE. NC2394.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2394.2 +013100 01 REC-CT PIC 99 VALUE ZERO. NC2394.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2394.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2394.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2394.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2394.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2394.2 +014100 01 CCVS-H-1. NC2394.2 +014200 02 FILLER PIC X(39) VALUE SPACES. NC2394.2 +014300 02 FILLER PIC X(42) VALUE NC2394.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2394.2 +014500 02 FILLER PIC X(39) VALUE SPACES. NC2394.2 +014600 01 CCVS-H-2A. NC2394.2 +014700 02 FILLER PIC X(40) VALUE SPACE. NC2394.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2394.2 +014900 02 FILLER PIC XXXX VALUE NC2394.2 +015000 "4.2 ". NC2394.2 +015100 02 FILLER PIC X(28) VALUE NC2394.2 +015200 " COPY - NOT FOR DISTRIBUTION". NC2394.2 +015300 02 FILLER PIC X(41) VALUE SPACE. NC2394.2 +015400 NC2394.2 +015500 01 CCVS-H-2B. NC2394.2 +015600 02 FILLER PIC X(15) VALUE NC2394.2 +015700 "TEST RESULT OF ". NC2394.2 +015800 02 TEST-ID PIC X(9). NC2394.2 +015900 02 FILLER PIC X(4) VALUE NC2394.2 +016000 " IN ". NC2394.2 +016100 02 FILLER PIC X(12) VALUE NC2394.2 +016200 " HIGH ". NC2394.2 +016300 02 FILLER PIC X(22) VALUE NC2394.2 +016400 " LEVEL VALIDATION FOR ". NC2394.2 +016500 02 FILLER PIC X(58) VALUE NC2394.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +016700 01 CCVS-H-3. NC2394.2 +016800 02 FILLER PIC X(34) VALUE NC2394.2 +016900 " FOR OFFICIAL USE ONLY ". NC2394.2 +017000 02 FILLER PIC X(58) VALUE NC2394.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2394.2 +017200 02 FILLER PIC X(28) VALUE NC2394.2 +017300 " COPYRIGHT 1985 ". NC2394.2 +017400 01 CCVS-E-1. NC2394.2 +017500 02 FILLER PIC X(52) VALUE SPACE. NC2394.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2394.2 +017700 02 ID-AGAIN PIC X(9). NC2394.2 +017800 02 FILLER PIC X(45) VALUE SPACES. NC2394.2 +017900 01 CCVS-E-2. NC2394.2 +018000 02 FILLER PIC X(31) VALUE SPACE. NC2394.2 +018100 02 FILLER PIC X(21) VALUE SPACE. NC2394.2 +018200 02 CCVS-E-2-2. NC2394.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2394.2 +018400 03 FILLER PIC X VALUE SPACE. NC2394.2 +018500 03 ENDER-DESC PIC X(44) VALUE NC2394.2 +018600 "ERRORS ENCOUNTERED". NC2394.2 +018700 01 CCVS-E-3. NC2394.2 +018800 02 FILLER PIC X(22) VALUE NC2394.2 +018900 " FOR OFFICIAL USE ONLY". NC2394.2 +019000 02 FILLER PIC X(12) VALUE SPACE. NC2394.2 +019100 02 FILLER PIC X(58) VALUE NC2394.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +019300 02 FILLER PIC X(13) VALUE SPACE. NC2394.2 +019400 02 FILLER PIC X(15) VALUE NC2394.2 +019500 " COPYRIGHT 1985". NC2394.2 +019600 01 CCVS-E-4. NC2394.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2394.2 +019800 02 FILLER PIC X(4) VALUE " OF ". NC2394.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2394.2 +020000 02 FILLER PIC X(40) VALUE NC2394.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2394.2 +020200 01 XXINFO. NC2394.2 +020300 02 FILLER PIC X(19) VALUE NC2394.2 +020400 "*** INFORMATION ***". NC2394.2 +020500 02 INFO-TEXT. NC2394.2 +020600 04 FILLER PIC X(8) VALUE SPACE. NC2394.2 +020700 04 XXCOMPUTED PIC X(20). NC2394.2 +020800 04 FILLER PIC X(5) VALUE SPACE. NC2394.2 +020900 04 XXCORRECT PIC X(20). NC2394.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). NC2394.2 +021100 01 HYPHEN-LINE. NC2394.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. NC2394.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************NC2394.2 +021400- "*****************************************". NC2394.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************NC2394.2 +021600- "******************************". NC2394.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE NC2394.2 +021800 "NC239A". NC2394.2 +021900 PROCEDURE DIVISION. NC2394.2 +022000 CCVS1 SECTION. NC2394.2 +022100 OPEN-FILES. NC2394.2 +022200 OPEN OUTPUT PRINT-FILE. NC2394.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2394.2 +022400 MOVE SPACE TO TEST-RESULTS. NC2394.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2394.2 +022600 GO TO CCVS1-EXIT. NC2394.2 +022700 CLOSE-FILES. NC2394.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2394.2 +022900 TERMINATE-CCVS. NC2394.2 +023000S EXIT PROGRAM. NC2394.2 +023100STERMINATE-CALL. NC2394.2 +023200 STOP RUN. NC2394.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2394.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2394.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2394.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2394.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. NC2394.2 +023800 PRINT-DETAIL. NC2394.2 +023900 IF REC-CT NOT EQUAL TO ZERO NC2394.2 +024000 MOVE "." TO PARDOT-X NC2394.2 +024100 MOVE REC-CT TO DOTVALUE. NC2394.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2394.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2394.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2394.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2394.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2394.2 +024700 MOVE SPACE TO CORRECT-X. NC2394.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2394.2 +024900 MOVE SPACE TO RE-MARK. NC2394.2 +025000 HEAD-ROUTINE. NC2394.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2394.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2394.2 +025500 COLUMN-NAMES-ROUTINE. NC2394.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +025900 END-ROUTINE. NC2394.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2394.2 +026100 END-RTN-EXIT. NC2394.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +026300 END-ROUTINE-1. NC2394.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2394.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2394.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. NC2394.2 +026700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2394.2 +026800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2394.2 +026900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2394.2 +027000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2394.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2394.2 +027200 END-ROUTINE-12. NC2394.2 +027300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2394.2 +027400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2394.2 +027500 MOVE "NO " TO ERROR-TOTAL NC2394.2 +027600 ELSE NC2394.2 +027700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2394.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2394.2 +027900 PERFORM WRITE-LINE. NC2394.2 +028000 END-ROUTINE-13. NC2394.2 +028100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2394.2 +028200 MOVE "NO " TO ERROR-TOTAL ELSE NC2394.2 +028300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2394.2 +028400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2394.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +028600 IF INSPECT-COUNTER EQUAL TO ZERO NC2394.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2394.2 +028800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2394.2 +028900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2394.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +029100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +029200 WRITE-LINE. NC2394.2 +029300 ADD 1 TO RECORD-COUNT. NC2394.2 +029400Y IF RECORD-COUNT GREATER 50 NC2394.2 +029500Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2394.2 +029600Y MOVE SPACE TO DUMMY-RECORD NC2394.2 +029700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2394.2 +029800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2394.2 +029900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2394.2 +030000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2394.2 +030100Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2394.2 +030200Y MOVE ZERO TO RECORD-COUNT. NC2394.2 +030300 PERFORM WRT-LN. NC2394.2 +030400 WRT-LN. NC2394.2 +030500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2394.2 +030600 MOVE SPACE TO DUMMY-RECORD. NC2394.2 +030700 BLANK-LINE-PRINT. NC2394.2 +030800 PERFORM WRT-LN. NC2394.2 +030900 FAIL-ROUTINE. NC2394.2 +031000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2394.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2394.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2394.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2394.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2394.2 +031600 GO TO FAIL-ROUTINE-EX. NC2394.2 +031700 FAIL-ROUTINE-WRITE. NC2394.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2394.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2394.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2394.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2394.2 +032200 FAIL-ROUTINE-EX. EXIT. NC2394.2 +032300 BAIL-OUT. NC2394.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2394.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2394.2 +032600 BAIL-OUT-WRITE. NC2394.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2394.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2394.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2394.2 +033100 BAIL-OUT-EX. EXIT. NC2394.2 +033200 CCVS1-EXIT. NC2394.2 +033300 EXIT. NC2394.2 +033400 SECT-NC239A-001 SECTION. NC2394.2 +033500 TH-12-001. NC2394.2 +033600 TABLE-INIT. NC2394.2 +033700 PERFORM TABLE-INIT-SUBROUTINE VARYING SUB-1 FROM 1 BY 1 NC2394.2 +033800 UNTIL SUB-1 EQUAL TO 11 NC2394.2 +033900 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2394.2 +034000 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11. NC2394.2 +034100 GO TO TABLE-TEST. NC2394.2 +034200 NC2394.2 +034300 TABLE-INIT-SUBROUTINE. NC2394.2 +034400 SET IDX-1 TO SUB-1. NC2394.2 +034500 SET IDX-2 TO SUB-2. NC2394.2 +034600 SET IDX-3 TO SUB-3. NC2394.2 +034700 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2394.2 +034800 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2394.2 +034900 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2394.2 +035000 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2394.2 +035100 SET ADD-ELEM TO IDX-3. NC2394.2 +035200 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2394.2 +035300 NC2394.2 +035400 TABLE-TEST. NC2394.2 +035500 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC2394.2 +035600 MOVE "TABLE-TEST" TO PAR-NAME. NC2394.2 +035700 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +035800 SET IDX-1 TO 5. NC2394.2 +035900 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP05" NC2394.2 +036000 GO TO TABLE-FAIL. NC2394.2 +036100 PERFORM PASS. NC2394.2 +036200 GO TO TABLE-WRITE. NC2394.2 +036300 TABLE-FAIL. NC2394.2 +036400 MOVE "GRP05" TO CORRECT-A NC2394.2 +036500 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC2394.2 +036600 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC2394.2 +036700 PERFORM FAIL. NC2394.2 +036800 TABLE-WRITE. NC2394.2 +036900 PERFORM PRINT-DETAIL. NC2394.2 +037000 NC2394.2 +037100 TH1-INIT-GF-1. NC2394.2 +037200 MOVE "TH1-TEST-GF-1" TO PAR-NAME. NC2394.2 +037300 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +037400 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC2394.2 +037500 SET IDX-1 TO 8. NC2394.2 +037600 TH1-TEST-GF-1. NC2394.2 +037700 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP08" NC2394.2 +037800 GO TO TH1-FAIL-GF-1. NC2394.2 +037900 PERFORM PASS. NC2394.2 +038000 GO TO TH1-WRITE-GF-1. NC2394.2 +038100 TH1-DELETE-GF-1. NC2394.2 +038200 PERFORM DE-LETE. NC2394.2 +038300 GO TO TH1-WRITE-GF-1. NC2394.2 +038400 TH1-FAIL-GF-1. NC2394.2 +038500 MOVE "GRP08" TO CORRECT-A NC2394.2 +038600 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC2394.2 +038700 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC2394.2 +038800 PERFORM FAIL. NC2394.2 +038900 TH1-WRITE-GF-1. NC2394.2 +039000 PERFORM PRINT-DETAIL. NC2394.2 +039100 NC2394.2 +039200 TH2-INIT-GF-1. NC2394.2 +039300 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +039400 MOVE "TH2-TEST-GF-1" TO PAR-NAME. NC2394.2 +039500 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +039600 SET IDX-1 TO 5. NC2394.2 +039700 SET IDX-2 TO 6. NC2394.2 +039800 TH2-TEST-GF-1. NC2394.2 +039900 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (05,06)" NC2394.2 +040000 GO TO TH2-FAIL-GF-1. NC2394.2 +040100 PERFORM PASS. NC2394.2 +040200 GO TO TH2-WRITE-GF-1. NC2394.2 +040300 TH2-DELETE-GF-1. NC2394.2 +040400 PERFORM DE-LETE. NC2394.2 +040500 GO TO TH2-WRITE-GF-1. NC2394.2 +040600 TH2-FAIL-GF-1. NC2394.2 +040700 MOVE "SEC (05,06)" TO CORRECT-A NC2394.2 +040800 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +040900 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +041000 PERFORM FAIL. NC2394.2 +041100 TH2-WRITE-GF-1. NC2394.2 +041200 PERFORM PRINT-DETAIL. NC2394.2 +041300 NC2394.2 +041400 TH2-INIT-GF-2. NC2394.2 +041500 MOVE "TH2-TEST-GF-2" TO PAR-NAME. NC2394.2 +041600 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +041700 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +041800 SET IDX-1, IDX-2 TO 8. NC2394.2 +041900 TH2-TEST-GF-2. NC2394.2 +042000 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (08,08)" NC2394.2 +042100 GO TO TH2-FAIL-GF-2. NC2394.2 +042200 PERFORM PASS. NC2394.2 +042300 GO TO TH2-WRITE-GF-2. NC2394.2 +042400 TH2-DELETE-GF-2. NC2394.2 +042500 PERFORM DE-LETE. NC2394.2 +042600 GO TO TH2-WRITE-GF-2. NC2394.2 +042700 TH2-FAIL-GF-2. NC2394.2 +042800 MOVE "SEC (08,08)" TO CORRECT-A NC2394.2 +042900 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +043000 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +043100 PERFORM FAIL. NC2394.2 +043200 TH2-WRITE-GF-2. NC2394.2 +043300 PERFORM PRINT-DETAIL. NC2394.2 +043400 NC2394.2 +043500 TH2-INIT-GF-3. NC2394.2 +043600 MOVE "TH2-TEST-GF-3" TO PAR-NAME. NC2394.2 +043700 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +043800 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +043900 SET IDX-1 TO 3. NC2394.2 +044000 SET IDX-2 TO 7. NC2394.2 +044100 TH2-TEST-GF-3. NC2394.2 +044200 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (03,07)" NC2394.2 +044300 GO TO TH2-FAIL-GF-3. NC2394.2 +044400 PERFORM PASS. NC2394.2 +044500 GO TO TH2-WRITE-GF-3. NC2394.2 +044600 TH2-DELETE-GF-3. NC2394.2 +044700 PERFORM DE-LETE. NC2394.2 +044800 GO TO TH2-WRITE-GF-3. NC2394.2 +044900 TH2-FAIL-GF-3. NC2394.2 +045000 MOVE "SEC (03,07)" TO CORRECT-A NC2394.2 +045100 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +045200 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +045300 PERFORM FAIL. NC2394.2 +045400 TH2-WRITE-GF-3. NC2394.2 +045500 PERFORM PRINT-DETAIL. NC2394.2 +045600 NC2394.2 +045700 TH3-INIT-GF-1. NC2394.2 +045800 MOVE "TH3-TEST-GF-1" TO PAR-NAME. NC2394.2 +045900 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +046000 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +046100 SET IDX-1 TO 2. NC2394.2 +046200 SET IDX-2 TO 6. NC2394.2 +046300 SET IDX-3 TO 10. NC2394.2 +046400 TH3-TEST-GF-1. NC2394.2 +046500 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +046600 "ELEM (02,06,10)" NC2394.2 +046700 GO TO TH3-FAIL-GF-1. NC2394.2 +046800 PERFORM PASS. NC2394.2 +046900 GO TO TH3-WRITE-GF-1. NC2394.2 +047000 TH3-DELETE-GF-1. NC2394.2 +047100 PERFORM DE-LETE. NC2394.2 +047200 GO TO TH3-WRITE-GF-1. NC2394.2 +047300 TH3-FAIL-GF-1. NC2394.2 +047400 MOVE "ELEM (02,06,10)" TO CORRECT-A NC2394.2 +047500 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +047600 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +047700 PERFORM FAIL. NC2394.2 +047800 TH3-WRITE-GF-1. NC2394.2 +047900 PERFORM PRINT-DETAIL. NC2394.2 +048000 NC2394.2 +048100 TH3-INIT-GF-2. NC2394.2 +048200 MOVE "TH3-TEST-GF-2" TO PAR-NAME. NC2394.2 +048300 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +048400 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +048500 SET IDX-1, IDX-2, IDX-3 TO 6. NC2394.2 +048600 TH3-TEST-GF-2. NC2394.2 +048700 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +048800 "ELEM (06,06,06)" NC2394.2 +048900 GO TO TH3-FAIL-GF-2. NC2394.2 +049000 PERFORM PASS. NC2394.2 +049100 GO TO TH3-WRITE-GF-2. NC2394.2 +049200 TH3-DELETE-GF-2. NC2394.2 +049300 PERFORM DE-LETE. NC2394.2 +049400 GO TO TH3-WRITE-GF-2. NC2394.2 +049500 TH3-FAIL-GF-2. NC2394.2 +049600 MOVE "ELEM (06,06,06)" TO CORRECT-A NC2394.2 +049700 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +049800 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +049900 PERFORM FAIL. NC2394.2 +050000 TH3-WRITE-GF-2. NC2394.2 +050100 PERFORM PRINT-DETAIL. NC2394.2 +050200 NC2394.2 +050300 TH3-INIT-GF-3. NC2394.2 +050400 MOVE "TH3-TEST-GF-3" TO PAR-NAME. NC2394.2 +050500 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +050600 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +050700 SET IDX-1 TO 9. NC2394.2 +050800 SET IDX-2 TO 8. NC2394.2 +050900 SET IDX-3 TO 7. NC2394.2 +051000 TH3-TEST-GF-3. NC2394.2 +051100 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +051200 "ELEM (09,08,07)" NC2394.2 +051300 GO TO TH3-FAIL-GF-3. NC2394.2 +051400 PERFORM PASS. NC2394.2 +051500 GO TO TH3-WRITE-GF-3. NC2394.2 +051600 TH3-DELETE-GF-3. NC2394.2 +051700 PERFORM DE-LETE. NC2394.2 +051800 GO TO TH3-WRITE-GF-3. NC2394.2 +051900 TH3-FAIL-GF-3. NC2394.2 +052000 MOVE "ELEM (09,08,07)" TO CORRECT-A NC2394.2 +052100 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +052200 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +052300 PERFORM FAIL. NC2394.2 +052400 TH3-WRITE-GF-3. NC2394.2 +052500 PERFORM PRINT-DETAIL. NC2394.2 +052600 CCVS-EXIT SECTION. NC2394.2 +052700 CCVS-999999. NC2394.2 +052800 GO TO CLOSE-FILES. NC2394.2 +*END-OF,NC239A +*HEADER,COBOL,NC240A +000100 IDENTIFICATION DIVISION. NC2404.2 +000200 PROGRAM-ID. NC2404.2 +000300 NC240A. NC2404.2 +000400 NC2404.2 +000500**************************************************************** NC2404.2 +000600* * NC2404.2 +000700* VALIDATION FOR:- * NC2404.2 +000800* * NC2404.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +001000* * NC2404.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2404.2 +001200* * NC2404.2 +001300**************************************************************** NC2404.2 +001400* * NC2404.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2404.2 +001600* * NC2404.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2404.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2404.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2404.2 +002000* * NC2404.2 +002100**************************************************************** NC2404.2 +002200* * NC2404.2 +002300* PROGRAM NC240A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2404.2 +002400* THREE-DIMENSIONAL TABLE USING SUBSCRIPTS. THE CONTENT OF * NC2404.2 +002500* TABLE ELEMENTS IS VERIFIED BY USE OF THE FORMAT 4 * NC2404.2 +002600* "PERFORM" STATEMENT. * NC2404.2 +002700* * NC2404.2 +002800**************************************************************** NC2404.2 +002900 NC2404.2 +003000 ENVIRONMENT DIVISION. NC2404.2 +003100 CONFIGURATION SECTION. NC2404.2 +003200 SOURCE-COMPUTER. NC2404.2 +003300 XXXXX082. NC2404.2 +003400 OBJECT-COMPUTER. NC2404.2 +003500 XXXXX083. NC2404.2 +003600 INPUT-OUTPUT SECTION. NC2404.2 +003700 FILE-CONTROL. NC2404.2 +003800 SELECT PRINT-FILE ASSIGN TO NC2404.2 +003900 XXXXX055. NC2404.2 +004000 DATA DIVISION. NC2404.2 +004100 FILE SECTION. NC2404.2 +004200 FD PRINT-FILE. NC2404.2 +004300 01 PRINT-REC PICTURE X(120). NC2404.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC2404.2 +004500 WORKING-STORAGE SECTION. NC2404.2 +004600 77 SUB-1 PICTURE S99 VALUE ZERO. NC2404.2 +004700 77 SUB-2 PICTURE 99 VALUE ZERO. NC2404.2 +004800 77 SUB-3 PICTURE 99 VALUE ZERO. NC2404.2 +004900 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2404.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2404.2 +005100 77 CON-7 PICTURE 99 VALUE 07. NC2404.2 +005200 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2404.2 +005300 77 CON-5 PICTURE 99 VALUE 05. NC2404.2 +005400 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2404.2 +005500 77 CON-6 PICTURE 99 VALUE 06. NC2404.2 +005600 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2404.2 +005700 01 GRP-NAME. NC2404.2 +005800 02 FILLER PICTURE XXX VALUE "GRP". NC2404.2 +005900 02 ADD-GRP PICTURE 99 VALUE 01. NC2404.2 +006000 NC2404.2 +006100 01 SEC-NAME. NC2404.2 +006200 02 FILLER PICTURE X(5) VALUE "SEC (". NC2404.2 +006300 02 SEC-GRP PICTURE 99 VALUE 00. NC2404.2 +006400 02 FILLER PICTURE X VALUE ",". NC2404.2 +006500 02 ADD-SEC PICTURE 99 VALUE 01. NC2404.2 +006600 02 FILLER PICTURE X VALUE ")". NC2404.2 +006700 NC2404.2 +006800 01 ELEM-NAME. NC2404.2 +006900 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2404.2 +007000 02 ELEM-GRP PICTURE 99 VALUE 00. NC2404.2 +007100 02 FILLER PICTURE X VALUE ",". NC2404.2 +007200 02 ELEM-SEC PICTURE 99 VALUE 00. NC2404.2 +007300 02 FILLER PICTURE X VALUE ",". NC2404.2 +007400 02 ADD-ELEM PICTURE 99 VALUE 01. NC2404.2 +007500 02 FILLER PICTURE X VALUE ")". NC2404.2 +007600 NC2404.2 +007700 01 3-DIMENSION-TBL. NC2404.2 +007800 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2404.2 +007900 03 ENTRY-1 PICTURE X(5). NC2404.2 +008000 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2404.2 +008100 04 ENTRY-2 PICTURE X(11). NC2404.2 +008200 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2404.2 +008300 05 ENTRY-3 PICTURE X(15). NC2404.2 +008400 01 TEST-RESULTS. NC2404.2 +008500 02 FILLER PIC X VALUE SPACE. NC2404.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. NC2404.2 +008700 02 FILLER PIC X VALUE SPACE. NC2404.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. NC2404.2 +008900 02 FILLER PIC X VALUE SPACE. NC2404.2 +009000 02 PAR-NAME. NC2404.2 +009100 03 FILLER PIC X(19) VALUE SPACE. NC2404.2 +009200 03 PARDOT-X PIC X VALUE SPACE. NC2404.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. NC2404.2 +009400 02 FILLER PIC X(8) VALUE SPACE. NC2404.2 +009500 02 RE-MARK PIC X(61). NC2404.2 +009600 01 TEST-COMPUTED. NC2404.2 +009700 02 FILLER PIC X(30) VALUE SPACE. NC2404.2 +009800 02 FILLER PIC X(17) VALUE NC2404.2 +009900 " COMPUTED=". NC2404.2 +010000 02 COMPUTED-X. NC2404.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2404.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A NC2404.2 +010300 PIC -9(9).9(9). NC2404.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2404.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2404.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2404.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. NC2404.2 +010800 04 COMPUTED-18V0 PIC -9(18). NC2404.2 +010900 04 FILLER PIC X. NC2404.2 +011000 03 FILLER PIC X(50) VALUE SPACE. NC2404.2 +011100 01 TEST-CORRECT. NC2404.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC2404.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2404.2 +011400 02 CORRECT-X. NC2404.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2404.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2404.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2404.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2404.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2404.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. NC2404.2 +012100 04 CORRECT-18V0 PIC -9(18). NC2404.2 +012200 04 FILLER PIC X. NC2404.2 +012300 03 FILLER PIC X(2) VALUE SPACE. NC2404.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2404.2 +012500 01 CCVS-C-1. NC2404.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2404.2 +012700- "SS PARAGRAPH-NAME NC2404.2 +012800- " REMARKS". NC2404.2 +012900 02 FILLER PIC X(20) VALUE SPACE. NC2404.2 +013000 01 CCVS-C-2. NC2404.2 +013100 02 FILLER PIC X VALUE SPACE. NC2404.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". NC2404.2 +013300 02 FILLER PIC X(15) VALUE SPACE. NC2404.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". NC2404.2 +013500 02 FILLER PIC X(94) VALUE SPACE. NC2404.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2404.2 +013700 01 REC-CT PIC 99 VALUE ZERO. NC2404.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2404.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2404.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2404.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2404.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2404.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2404.2 +014700 01 CCVS-H-1. NC2404.2 +014800 02 FILLER PIC X(39) VALUE SPACES. NC2404.2 +014900 02 FILLER PIC X(42) VALUE NC2404.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2404.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2404.2 +015200 01 CCVS-H-2A. NC2404.2 +015300 02 FILLER PIC X(40) VALUE SPACE. NC2404.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2404.2 +015500 02 FILLER PIC XXXX VALUE NC2404.2 +015600 "4.2 ". NC2404.2 +015700 02 FILLER PIC X(28) VALUE NC2404.2 +015800 " COPY - NOT FOR DISTRIBUTION". NC2404.2 +015900 02 FILLER PIC X(41) VALUE SPACE. NC2404.2 +016000 NC2404.2 +016100 01 CCVS-H-2B. NC2404.2 +016200 02 FILLER PIC X(15) VALUE NC2404.2 +016300 "TEST RESULT OF ". NC2404.2 +016400 02 TEST-ID PIC X(9). NC2404.2 +016500 02 FILLER PIC X(4) VALUE NC2404.2 +016600 " IN ". NC2404.2 +016700 02 FILLER PIC X(12) VALUE NC2404.2 +016800 " HIGH ". NC2404.2 +016900 02 FILLER PIC X(22) VALUE NC2404.2 +017000 " LEVEL VALIDATION FOR ". NC2404.2 +017100 02 FILLER PIC X(58) VALUE NC2404.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +017300 01 CCVS-H-3. NC2404.2 +017400 02 FILLER PIC X(34) VALUE NC2404.2 +017500 " FOR OFFICIAL USE ONLY ". NC2404.2 +017600 02 FILLER PIC X(58) VALUE NC2404.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2404.2 +017800 02 FILLER PIC X(28) VALUE NC2404.2 +017900 " COPYRIGHT 1985 ". NC2404.2 +018000 01 CCVS-E-1. NC2404.2 +018100 02 FILLER PIC X(52) VALUE SPACE. NC2404.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2404.2 +018300 02 ID-AGAIN PIC X(9). NC2404.2 +018400 02 FILLER PIC X(45) VALUE SPACES. NC2404.2 +018500 01 CCVS-E-2. NC2404.2 +018600 02 FILLER PIC X(31) VALUE SPACE. NC2404.2 +018700 02 FILLER PIC X(21) VALUE SPACE. NC2404.2 +018800 02 CCVS-E-2-2. NC2404.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2404.2 +019000 03 FILLER PIC X VALUE SPACE. NC2404.2 +019100 03 ENDER-DESC PIC X(44) VALUE NC2404.2 +019200 "ERRORS ENCOUNTERED". NC2404.2 +019300 01 CCVS-E-3. NC2404.2 +019400 02 FILLER PIC X(22) VALUE NC2404.2 +019500 " FOR OFFICIAL USE ONLY". NC2404.2 +019600 02 FILLER PIC X(12) VALUE SPACE. NC2404.2 +019700 02 FILLER PIC X(58) VALUE NC2404.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +019900 02 FILLER PIC X(13) VALUE SPACE. NC2404.2 +020000 02 FILLER PIC X(15) VALUE NC2404.2 +020100 " COPYRIGHT 1985". NC2404.2 +020200 01 CCVS-E-4. NC2404.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2404.2 +020400 02 FILLER PIC X(4) VALUE " OF ". NC2404.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2404.2 +020600 02 FILLER PIC X(40) VALUE NC2404.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2404.2 +020800 01 XXINFO. NC2404.2 +020900 02 FILLER PIC X(19) VALUE NC2404.2 +021000 "*** INFORMATION ***". NC2404.2 +021100 02 INFO-TEXT. NC2404.2 +021200 04 FILLER PIC X(8) VALUE SPACE. NC2404.2 +021300 04 XXCOMPUTED PIC X(20). NC2404.2 +021400 04 FILLER PIC X(5) VALUE SPACE. NC2404.2 +021500 04 XXCORRECT PIC X(20). NC2404.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). NC2404.2 +021700 01 HYPHEN-LINE. NC2404.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. NC2404.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************NC2404.2 +022000- "*****************************************". NC2404.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************NC2404.2 +022200- "******************************". NC2404.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE NC2404.2 +022400 "NC240A". NC2404.2 +022500 PROCEDURE DIVISION. NC2404.2 +022600 CCVS1 SECTION. NC2404.2 +022700 OPEN-FILES. NC2404.2 +022800 OPEN OUTPUT PRINT-FILE. NC2404.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2404.2 +023000 MOVE SPACE TO TEST-RESULTS. NC2404.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2404.2 +023200 GO TO CCVS1-EXIT. NC2404.2 +023300 CLOSE-FILES. NC2404.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2404.2 +023500 TERMINATE-CCVS. NC2404.2 +023600S EXIT PROGRAM. NC2404.2 +023700STERMINATE-CALL. NC2404.2 +023800 STOP RUN. NC2404.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2404.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2404.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2404.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2404.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. NC2404.2 +024400 PRINT-DETAIL. NC2404.2 +024500 IF REC-CT NOT EQUAL TO ZERO NC2404.2 +024600 MOVE "." TO PARDOT-X NC2404.2 +024700 MOVE REC-CT TO DOTVALUE. NC2404.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2404.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2404.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2404.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2404.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2404.2 +025300 MOVE SPACE TO CORRECT-X. NC2404.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2404.2 +025500 MOVE SPACE TO RE-MARK. NC2404.2 +025600 HEAD-ROUTINE. NC2404.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2404.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2404.2 +026100 COLUMN-NAMES-ROUTINE. NC2404.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +026500 END-ROUTINE. NC2404.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2404.2 +026700 END-RTN-EXIT. NC2404.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +026900 END-ROUTINE-1. NC2404.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2404.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2404.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. NC2404.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2404.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2404.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2404.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2404.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2404.2 +027800 END-ROUTINE-12. NC2404.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2404.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2404.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2404.2 +028200 ELSE NC2404.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2404.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2404.2 +028500 PERFORM WRITE-LINE. NC2404.2 +028600 END-ROUTINE-13. NC2404.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2404.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE NC2404.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2404.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2404.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO NC2404.2 +029300 MOVE "NO " TO ERROR-TOTAL NC2404.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2404.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2404.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029800 WRITE-LINE. NC2404.2 +029900 ADD 1 TO RECORD-COUNT. NC2404.2 +030000Y IF RECORD-COUNT GREATER 50 NC2404.2 +030100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2404.2 +030200Y MOVE SPACE TO DUMMY-RECORD NC2404.2 +030300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2404.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2404.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2404.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2404.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2404.2 +030800Y MOVE ZERO TO RECORD-COUNT. NC2404.2 +030900 PERFORM WRT-LN. NC2404.2 +031000 WRT-LN. NC2404.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2404.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC2404.2 +031300 BLANK-LINE-PRINT. NC2404.2 +031400 PERFORM WRT-LN. NC2404.2 +031500 FAIL-ROUTINE. NC2404.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2404.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2404.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2404.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2404.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2404.2 +032200 GO TO FAIL-ROUTINE-EX. NC2404.2 +032300 FAIL-ROUTINE-WRITE. NC2404.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2404.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2404.2 +032600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2404.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2404.2 +032800 FAIL-ROUTINE-EX. EXIT. NC2404.2 +032900 BAIL-OUT. NC2404.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2404.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2404.2 +033200 BAIL-OUT-WRITE. NC2404.2 +033300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2404.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2404.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2404.2 +033700 BAIL-OUT-EX. EXIT. NC2404.2 +033800 CCVS1-EXIT. NC2404.2 +033900 EXIT. NC2404.2 +034000 SECT-NC24A-0001 SECTION. NC2404.2 +034100 TH-13-001. NC2404.2 +034200 BUILD-LEVEL-1. NC2404.2 +034300 ADD 1 TO SUB-1. NC2404.2 +034400 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2404.2 +034500 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2404.2 +034600 ADD 1 TO ADD-GRP. NC2404.2 +034700 NC2404.2 +034800 BUILD-LEVEL-2. NC2404.2 +034900 ADD 1 TO SUB-2. NC2404.2 +035000 IF SUB-2 = 11 NC2404.2 +035100 MOVE ZERO TO SUB-2 NC2404.2 +035200 MOVE 01 TO ADD-SEC NC2404.2 +035300 GO TO BUILD-LEVEL-1. NC2404.2 +035400 MOVE SUB-1 TO SEC-GRP. NC2404.2 +035500 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2404.2 +035600 ADD 1 TO ADD-SEC. NC2404.2 +035700 NC2404.2 +035800 BUILD-LEVEL-3. NC2404.2 +035900 ADD 1 TO SUB-3. NC2404.2 +036000 IF SUB-3 = 11 NC2404.2 +036100 MOVE ZERO TO SUB-3 NC2404.2 +036200 MOVE 01 TO ADD-ELEM NC2404.2 +036300 GO TO BUILD-LEVEL-2. NC2404.2 +036400 MOVE SUB-1 TO ELEM-GRP. NC2404.2 +036500 MOVE SUB-2 TO ELEM-SEC. NC2404.2 +036600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2404.2 +036700 ADD 1 TO ADD-ELEM. NC2404.2 +036800 GO TO BUILD-LEVEL-3. NC2404.2 +036900 NC2404.2 +037000 CHECK-ENTRIES. NC2404.2 +037100 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2404.2 +037200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2404.2 +037300 MOVE SPACES TO TEST-CHECK. NC2404.2 +037400 MOVE "GRP05" TO GRP-HOLD-AREA. NC2404.2 +037500 PERFORM FIND-LEVEL-1-ENTRY VARYING CON-5 FROM 1 BY 1 NC2404.2 +037600 UNTIL CON-5 = 11. NC2404.2 +037700 IF TEST-CHECK = "PASS" GO TO TH1-INIT-GF-2. NC2404.2 +037800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +037900 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2404.2 +038000 NC2404.2 +038100 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +038200 PERFORM FAIL. NC2404.2 +038300 PERFORM PRINT-DETAIL. NC2404.2 +038400* NC2404.2 +038500 TH1-INIT-GF-2. NC2404.2 +038600 MOVE "GRP10" TO GRP-HOLD-AREA. NC2404.2 +038700 MOVE "TH1-TEST-GF-2 " TO PAR-NAME. NC2404.2 +038800 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +038900 MOVE SPACES TO TEST-CHECK. NC2404.2 +039000 TH1-TEST-GF-2. NC2404.2 +039100 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +039200 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +039300 IF TEST-CHECK = "PASS" NC2404.2 +039400 PERFORM PASS NC2404.2 +039500 GO TO TH1-WRITE-GF-2 NC2404.2 +039600 ELSE NC2404.2 +039700 GO TO TH1-FAIL-GF-2. NC2404.2 +039800 TH1-DELETE-GF-2. NC2404.2 +039900 PERFORM DE-LETE. NC2404.2 +040000 GO TO TH1-WRITE-GF-2. NC2404.2 +040100 TH1-FAIL-GF-2. NC2404.2 +040200 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +040300 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2404.2 +040400 NC2404.2 +040500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +040600 PERFORM FAIL. NC2404.2 +040700 TH1-WRITE-GF-2. NC2404.2 +040800 PERFORM PRINT-DETAIL. NC2404.2 +040900 NC2404.2 +041000 TH1-INIT-GF-3. NC2404.2 +041100 MOVE "GRP07" TO GRP-HOLD-AREA. NC2404.2 +041200 MOVE "TH1-TEST-GF-3 " TO PAR-NAME. NC2404.2 +041300 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +041400 MOVE SPACES TO TEST-CHECK. NC2404.2 +041500 TH1-TEST-GF-3. NC2404.2 +041600 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +041700 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +041800 IF TEST-CHECK = "PASS" NC2404.2 +041900 PERFORM PASS NC2404.2 +042000 GO TO TH1-WRITE-GF-3 NC2404.2 +042100 ELSE NC2404.2 +042200 GO TO TH1-FAIL-GF-3. NC2404.2 +042300 TH1-DELETE-GF-3. NC2404.2 +042400 PERFORM DE-LETE. NC2404.2 +042500 GO TO TH1-WRITE-GF-3. NC2404.2 +042600 TH1-FAIL-GF-3. NC2404.2 +042700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +042800 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2404.2 +042900 NC2404.2 +043000 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +043100 PERFORM FAIL. NC2404.2 +043200 TH1-WRITE-GF-3. NC2404.2 +043300 PERFORM PRINT-DETAIL. NC2404.2 +043400* NC2404.2 +043500 TH1-INIT-GF-4. NC2404.2 +043600 MOVE "TH1-TEST-GF-4 " TO PAR-NAME. NC2404.2 +043700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +043800 MOVE "GRP01" TO GRP-HOLD-AREA. NC2404.2 +043900 TH1-TEST-GF-4. NC2404.2 +044000 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +044100 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +044200 IF TEST-CHECK = "PASS" NC2404.2 +044300 PERFORM PASS NC2404.2 +044400 GO TO TH1-WRITE-GF-4 NC2404.2 +044500 ELSE NC2404.2 +044600 GO TO TH1-FAIL-GF-4. NC2404.2 +044700 TH1-DELETE-GF-4. NC2404.2 +044800 PERFORM DE-LETE. NC2404.2 +044900 GO TO TH1-WRITE-GF-4. NC2404.2 +045000 TH1-FAIL-GF-4. NC2404.2 +045100 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +045200 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2404.2 +045300 NC2404.2 +045400 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +045500 PERFORM FAIL. NC2404.2 +045600 TH1-WRITE-GF-4. NC2404.2 +045700 PERFORM PRINT-DETAIL. NC2404.2 +045800 GO TO TH2-INIT-GF-1. NC2404.2 +045900 NC2404.2 +046000 FIND-LEVEL-1-ENTRY. NC2404.2 +046100 IF ENTRY-1 (CON-5) = GRP-HOLD-AREA NC2404.2 +046200 MOVE "PASS" TO TEST-CHECK. NC2404.2 +046300 NC2404.2 +046400 TH2-INIT-GF-1. NC2404.2 +046500 MOVE "TH2-TEST-GF-1 " TO PAR-NAME. NC2404.2 +046600 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2404.2 +046700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +046800 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2404.2 +046900 MOVE SPACES TO TEST-CHECK. NC2404.2 +047000 TH2-TEST-GF-1. NC2404.2 +047100 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +047200 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +047300 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +047400 IF TEST-CHECK = "PASS" NC2404.2 +047500 PERFORM PASS NC2404.2 +047600 GO TO TH2-WRITE-GF-1 NC2404.2 +047700 ELSE NC2404.2 +047800 GO TO TH2-FAIL-GF-1. NC2404.2 +047900 TH2-DELETE-GF-1. NC2404.2 +048000 PERFORM DE-LETE. NC2404.2 +048100 GO TO TH2-WRITE-GF-1. NC2404.2 +048200 TH2-FAIL-GF-1. NC2404.2 +048300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +048400 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2404.2 +048500 NC2404.2 +048600 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +048700 PERFORM FAIL. NC2404.2 +048800 TH2-WRITE-GF-1. NC2404.2 +048900 PERFORM PRINT-DETAIL. NC2404.2 +049000 NC2404.2 +049100 TH2-INIT-GF-2. NC2404.2 +049200 MOVE "TH2-TEST-GF-2 " TO PAR-NAME. NC2404.2 +049300 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +049400 MOVE SPACES TO TEST-CHECK. NC2404.2 +049500 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2404.2 +049600 TH2-TEST-GF-2. NC2404.2 +049700 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +049800 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +049900 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +050000 IF TEST-CHECK = "PASS" NC2404.2 +050100 PERFORM PASS NC2404.2 +050200 GO TO TH2-WRITE-GF-2 NC2404.2 +050300 ELSE NC2404.2 +050400 GO TO TH2-FAIL-GF-2. NC2404.2 +050500 TH2-DELETE-GF-2. NC2404.2 +050600 PERFORM DE-LETE. NC2404.2 +050700 GO TO TH2-WRITE-GF-2. NC2404.2 +050800 TH2-FAIL-GF-2. NC2404.2 +050900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +051000 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2404.2 +051100 NC2404.2 +051200 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +051300 PERFORM FAIL. NC2404.2 +051400 TH2-WRITE-GF-2. NC2404.2 +051500 PERFORM PRINT-DETAIL. NC2404.2 +051600 NC2404.2 +051700 TH2-INIT-GF-3. NC2404.2 +051800 MOVE "TH2-TEST-GF-3 " TO PAR-NAME. NC2404.2 +051900 MOVE SPACES TO TEST-CHECK. NC2404.2 +052000 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +052100 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2404.2 +052200 TH2-TEST-GF-3. NC2404.2 +052300 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +052400 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +052500 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +052600 IF TEST-CHECK = "PASS" NC2404.2 +052700 PERFORM PASS NC2404.2 +052800 GO TO TH2-WRITE-GF-3 NC2404.2 +052900 ELSE NC2404.2 +053000 GO TO TH2-FAIL-GF-3. NC2404.2 +053100 TH2-DELETE-GF-3. NC2404.2 +053200 PERFORM DE-LETE. NC2404.2 +053300 GO TO TH2-WRITE-GF-3. NC2404.2 +053400 TH2-FAIL-GF-3. NC2404.2 +053500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +053600 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2404.2 +053700 NC2404.2 +053800 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +053900 PERFORM FAIL. NC2404.2 +054000 TH2-WRITE-GF-3. NC2404.2 +054100 PERFORM PRINT-DETAIL. NC2404.2 +054200* NC2404.2 +054300 TH2-INIT-GF-4. NC2404.2 +054400 MOVE "TH2-TEST-GF-4 " TO PAR-NAME. NC2404.2 +054500 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +054600 MOVE SPACES TO TEST-CHECK. NC2404.2 +054700 MOVE SPACES TO TEST-CHECK. NC2404.2 +054800 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2404.2 +054900 TH2-TEST-GF-4. NC2404.2 +055000 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +055100 VARYING CON-5 FROM 2 BY 2 UNTIL CON-5 = 12 NC2404.2 +055200 AFTER CON-6 FROM 2 BY 2 UNTIL CON-6 = 12. NC2404.2 +055300 IF TEST-CHECK = "PASS" NC2404.2 +055400 PERFORM PASS NC2404.2 +055500 GO TO TH2-WRITE-GF-4 NC2404.2 +055600 ELSE NC2404.2 +055700 GO TO TH2-FAIL-GF-4. NC2404.2 +055800 TH2-DELETE-GF-4. NC2404.2 +055900 PERFORM DE-LETE. NC2404.2 +056000 GO TO TH2-WRITE-GF-4. NC2404.2 +056100 TH2-FAIL-GF-4. NC2404.2 +056200 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +056300 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2404.2 +056400 NC2404.2 +056500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +056600 PERFORM FAIL. NC2404.2 +056700 TH2-WRITE-GF-4. NC2404.2 +056800 PERFORM PRINT-DETAIL. NC2404.2 +056900 GO TO TH3-INIT-GF-1. NC2404.2 +057000* NC2404.2 +057100 FIND-LEVEL-2-ENTRY. NC2404.2 +057200 IF ENTRY-2 (CON-5, CON-6) = SEC-HOLD-AREA NC2404.2 +057300 MOVE "PASS" TO TEST-CHECK. NC2404.2 +057400* NC2404.2 +057500 TH3-INIT-GF-1. NC2404.2 +057600 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2404.2 +057700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +057800 MOVE SPACES TO TEST-CHECK. NC2404.2 +057900 MOVE "TH3-TEST-GF-1 " TO PAR-NAME. NC2404.2 +058000 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2404.2 +058100 TH3-TEST-GF-1. NC2404.2 +058200 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +058300 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +058400 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10 NC2404.2 +058500 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 10. NC2404.2 +058600 IF TEST-CHECK = "PASS" NC2404.2 +058700 PERFORM PASS NC2404.2 +058800 GO TO TH3-WRITE-GF-1 NC2404.2 +058900 ELSE NC2404.2 +059000 GO TO TH3-FAIL-GF-1. NC2404.2 +059100 TH3-DELETE-GF-1. NC2404.2 +059200 PERFORM DE-LETE. NC2404.2 +059300 GO TO TH3-WRITE-GF-1. NC2404.2 +059400 TH3-FAIL-GF-1. NC2404.2 +059500 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +059600 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2404.2 +059700 NC2404.2 +059800 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +059900 PERFORM FAIL. NC2404.2 +060000 TH3-WRITE-GF-1. NC2404.2 +060100 PERFORM PRINT-DETAIL. NC2404.2 +060200 NC2404.2 +060300 TH3-INIT-GF-2. NC2404.2 +060400 MOVE "TH3-TEST-GF-2 " TO PAR-NAME. NC2404.2 +060500 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +060600 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2404.2 +060700 MOVE SPACES TO TEST-CHECK. NC2404.2 +060800 TH3-TEST-GF-2. NC2404.2 +060900 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +061000 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +061100 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 11 NC2404.2 +061200 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 11. NC2404.2 +061300 IF TEST-CHECK = "PASS" NC2404.2 +061400 PERFORM PASS NC2404.2 +061500 GO TO TH3-WRITE-GF-2 NC2404.2 +061600 ELSE NC2404.2 +061700 GO TO TH3-FAIL-GF-2. NC2404.2 +061800 TH3-DELETE-GF-2. NC2404.2 +061900 PERFORM DE-LETE. NC2404.2 +062000 GO TO TH3-WRITE-GF-2. NC2404.2 +062100 TH3-FAIL-GF-2. NC2404.2 +062200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +062300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2404.2 +062400 NC2404.2 +062500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +062600 PERFORM FAIL. NC2404.2 +062700 TH3-WRITE-GF-2. NC2404.2 +062800 PERFORM PRINT-DETAIL. NC2404.2 +062900 NC2404.2 +063000 TH3-INIT-GF-3. NC2404.2 +063100 MOVE "TH3-TEST-GF-3 " TO PAR-NAME. NC2404.2 +063200 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +063300 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2404.2 +063400 MOVE SPACES TO TEST-CHECK. NC2404.2 +063500 TH3-TEST-GF-3. NC2404.2 +063600 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +063700 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +063800 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10 NC2404.2 +063900 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 10. NC2404.2 +064000 IF TEST-CHECK = "PASS" NC2404.2 +064100 PERFORM PASS NC2404.2 +064200 GO TO TH3-WRITE-GF-3 NC2404.2 +064300 ELSE NC2404.2 +064400 GO TO TH3-FAIL-GF-3. NC2404.2 +064500 TH3-DELETE-GF-3. NC2404.2 +064600 PERFORM DE-LETE. NC2404.2 +064700 GO TO TH3-WRITE-GF-3. NC2404.2 +064800 TH3-FAIL-GF-3. NC2404.2 +064900 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +065000 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2404.2 +065100 NC2404.2 +065200 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +065300 PERFORM FAIL. NC2404.2 +065400 TH3-WRITE-GF-3. NC2404.2 +065500 PERFORM PRINT-DETAIL. NC2404.2 +065600* NC2404.2 +065700 TH3-INIT-GF-4. NC2404.2 +065800 MOVE "TH3-TEST-GF-4 " TO PAR-NAME. NC2404.2 +065900 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +066000 MOVE SPACES TO TEST-CHECK. NC2404.2 +066100 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2404.2 +066200 TH3-TEST-GF-4. NC2404.2 +066300 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +066400 VARYING CON-5 FROM 3 BY 3 UNTIL CON-5 = 12 NC2404.2 +066500 AFTER CON-6 FROM 2 BY 2 UNTIL CON-6 = 12 NC2404.2 +066600 AFTER CON-7 FROM 8 BY 8 UNTIL CON-7 = 16. NC2404.2 +066700 IF TEST-CHECK = "PASS" NC2404.2 +066800 PERFORM PASS NC2404.2 +066900 GO TO TH3-WRITE-GF-4 NC2404.2 +067000 ELSE NC2404.2 +067100 GO TO TH3-FAIL-GF-4. NC2404.2 +067200 TH3-DELETE-GF-4. NC2404.2 +067300 PERFORM DE-LETE. NC2404.2 +067400 GO TO TH3-WRITE-GF-4. NC2404.2 +067500 TH3-FAIL-GF-4. NC2404.2 +067600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +067700 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2404.2 +067800 NC2404.2 +067900 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +068000 PERFORM FAIL. NC2404.2 +068100 TH3-WRITE-GF-4. NC2404.2 +068200 PERFORM PRINT-DETAIL. NC2404.2 +068300 GO TO END-3LEVEL-TEST. NC2404.2 +068400 NC2404.2 +068500 FIND-LEVEL-3-ENTRY. NC2404.2 +068600 IF ENTRY-3 (CON-5, CON-6, CON-7) = ELEM-HOLD-AREA NC2404.2 +068700 MOVE "PASS" TO TEST-CHECK. NC2404.2 +068800 NC2404.2 +068900 END-3LEVEL-TEST. NC2404.2 +069000 EXIT. NC2404.2 +069100 CCVS-EXIT SECTION. NC2404.2 +069200 CCVS-999999. NC2404.2 +069300 GO TO CLOSE-FILES. NC2404.2 +*END-OF,NC240A +*HEADER,COBOL,NC241A +000100 IDENTIFICATION DIVISION. NC2414.2 +000200 PROGRAM-ID. NC2414.2 +000300 NC241A. NC2414.2 +000400**************************************************************** NC2414.2 +000500* * NC2414.2 +000600* VALIDATION FOR:- * NC2414.2 +000700* * NC2414.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +000900* * NC2414.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2414.2 +001100* * NC2414.2 +001200**************************************************************** NC2414.2 +001300* * NC2414.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2414.2 +001500* * NC2414.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2414.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2414.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2414.2 +001900* * NC2414.2 +002000**************************************************************** NC2414.2 +002100* NC2414.2 +002200* PROGRAM NC241A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2414.2 +002300* THREE-DIMENSIONAL TABLE USING INDICES. THE CONTENT OF * NC2414.2 +002400* TABLE ELEMENTS IS VERIFIED BY USE OF THE FORMAT 4 * NC2414.2 +002500* "PERFORM" STATEMENT. * NC2414.2 +002600* * NC2414.2 +002700**************************************************************** NC2414.2 +002800 NC2414.2 +002900 ENVIRONMENT DIVISION. NC2414.2 +003000 CONFIGURATION SECTION. NC2414.2 +003100 SOURCE-COMPUTER. NC2414.2 +003200 XXXXX082. NC2414.2 +003300 OBJECT-COMPUTER. NC2414.2 +003400 XXXXX083. NC2414.2 +003500 INPUT-OUTPUT SECTION. NC2414.2 +003600 FILE-CONTROL. NC2414.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2414.2 +003800 XXXXX055. NC2414.2 +003900 DATA DIVISION. NC2414.2 +004000 FILE SECTION. NC2414.2 +004100 FD PRINT-FILE. NC2414.2 +004200 01 PRINT-REC PICTURE X(120). NC2414.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2414.2 +004400 WORKING-STORAGE SECTION. NC2414.2 +004500 77 SUB-1 PICTURE S99 VALUE ZERO. NC2414.2 +004600 77 SUB-2 PICTURE 99 VALUE ZERO. NC2414.2 +004700 77 SUB-3 PICTURE 99 VALUE ZERO. NC2414.2 +004800 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2414.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2414.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2414.2 +005100 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2414.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2414.2 +005300 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2414.2 +005400 77 CON-6 PICTURE 99 VALUE 06. NC2414.2 +005500 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2414.2 +005600 01 GRP-NAME. NC2414.2 +005700 02 FILLER PICTURE XXX VALUE "GRP". NC2414.2 +005800 02 ADD-GRP PICTURE 99 VALUE 01. NC2414.2 +005900 NC2414.2 +006000 01 SEC-NAME. NC2414.2 +006100 02 FILLER PICTURE X(5) VALUE "SEC (". NC2414.2 +006200 02 SEC-GRP PICTURE 99 VALUE 00. NC2414.2 +006300 02 FILLER PICTURE X VALUE ",". NC2414.2 +006400 02 ADD-SEC PICTURE 99 VALUE 01. NC2414.2 +006500 02 FILLER PICTURE X VALUE ")". NC2414.2 +006600 NC2414.2 +006700 01 ELEM-NAME. NC2414.2 +006800 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2414.2 +006900 02 ELEM-GRP PICTURE 99 VALUE 00. NC2414.2 +007000 02 FILLER PICTURE X VALUE ",". NC2414.2 +007100 02 ELEM-SEC PICTURE 99 VALUE 00. NC2414.2 +007200 02 FILLER PICTURE X VALUE ",". NC2414.2 +007300 02 ADD-ELEM PICTURE 99 VALUE 01. NC2414.2 +007400 02 FILLER PICTURE X VALUE ")". NC2414.2 +007500 NC2414.2 +007600 01 3-DIMENSION-TBL. NC2414.2 +007700 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2414.2 +007800 03 ENTRY-1 PICTURE X(5). NC2414.2 +007900 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2414.2 +008000 04 ENTRY-2 PICTURE X(11). NC2414.2 +008100 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2414.2 +008200 05 ENTRY-3 PICTURE X(15). NC2414.2 +008300 NC2414.2 +008400 01 TEST-RESULTS. NC2414.2 +008500 02 FILLER PIC X VALUE SPACE. NC2414.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. NC2414.2 +008700 02 FILLER PIC X VALUE SPACE. NC2414.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. NC2414.2 +008900 02 FILLER PIC X VALUE SPACE. NC2414.2 +009000 02 PAR-NAME. NC2414.2 +009100 03 FILLER PIC X(19) VALUE SPACE. NC2414.2 +009200 03 PARDOT-X PIC X VALUE SPACE. NC2414.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. NC2414.2 +009400 02 FILLER PIC X(8) VALUE SPACE. NC2414.2 +009500 02 RE-MARK PIC X(61). NC2414.2 +009600 01 TEST-COMPUTED. NC2414.2 +009700 02 FILLER PIC X(30) VALUE SPACE. NC2414.2 +009800 02 FILLER PIC X(17) VALUE NC2414.2 +009900 " COMPUTED=". NC2414.2 +010000 02 COMPUTED-X. NC2414.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2414.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A NC2414.2 +010300 PIC -9(9).9(9). NC2414.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2414.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2414.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2414.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. NC2414.2 +010800 04 COMPUTED-18V0 PIC -9(18). NC2414.2 +010900 04 FILLER PIC X. NC2414.2 +011000 03 FILLER PIC X(50) VALUE SPACE. NC2414.2 +011100 01 TEST-CORRECT. NC2414.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC2414.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2414.2 +011400 02 CORRECT-X. NC2414.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2414.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2414.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2414.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2414.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2414.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. NC2414.2 +012100 04 CORRECT-18V0 PIC -9(18). NC2414.2 +012200 04 FILLER PIC X. NC2414.2 +012300 03 FILLER PIC X(2) VALUE SPACE. NC2414.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2414.2 +012500 01 CCVS-C-1. NC2414.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2414.2 +012700- "SS PARAGRAPH-NAME NC2414.2 +012800- " REMARKS". NC2414.2 +012900 02 FILLER PIC X(20) VALUE SPACE. NC2414.2 +013000 01 CCVS-C-2. NC2414.2 +013100 02 FILLER PIC X VALUE SPACE. NC2414.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". NC2414.2 +013300 02 FILLER PIC X(15) VALUE SPACE. NC2414.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". NC2414.2 +013500 02 FILLER PIC X(94) VALUE SPACE. NC2414.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2414.2 +013700 01 REC-CT PIC 99 VALUE ZERO. NC2414.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2414.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2414.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2414.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2414.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2414.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2414.2 +014700 01 CCVS-H-1. NC2414.2 +014800 02 FILLER PIC X(39) VALUE SPACES. NC2414.2 +014900 02 FILLER PIC X(42) VALUE NC2414.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2414.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2414.2 +015200 01 CCVS-H-2A. NC2414.2 +015300 02 FILLER PIC X(40) VALUE SPACE. NC2414.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2414.2 +015500 02 FILLER PIC XXXX VALUE NC2414.2 +015600 "4.2 ". NC2414.2 +015700 02 FILLER PIC X(28) VALUE NC2414.2 +015800 " COPY - NOT FOR DISTRIBUTION". NC2414.2 +015900 02 FILLER PIC X(41) VALUE SPACE. NC2414.2 +016000 NC2414.2 +016100 01 CCVS-H-2B. NC2414.2 +016200 02 FILLER PIC X(15) VALUE NC2414.2 +016300 "TEST RESULT OF ". NC2414.2 +016400 02 TEST-ID PIC X(9). NC2414.2 +016500 02 FILLER PIC X(4) VALUE NC2414.2 +016600 " IN ". NC2414.2 +016700 02 FILLER PIC X(12) VALUE NC2414.2 +016800 " HIGH ". NC2414.2 +016900 02 FILLER PIC X(22) VALUE NC2414.2 +017000 " LEVEL VALIDATION FOR ". NC2414.2 +017100 02 FILLER PIC X(58) VALUE NC2414.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +017300 01 CCVS-H-3. NC2414.2 +017400 02 FILLER PIC X(34) VALUE NC2414.2 +017500 " FOR OFFICIAL USE ONLY ". NC2414.2 +017600 02 FILLER PIC X(58) VALUE NC2414.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2414.2 +017800 02 FILLER PIC X(28) VALUE NC2414.2 +017900 " COPYRIGHT 1985 ". NC2414.2 +018000 01 CCVS-E-1. NC2414.2 +018100 02 FILLER PIC X(52) VALUE SPACE. NC2414.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2414.2 +018300 02 ID-AGAIN PIC X(9). NC2414.2 +018400 02 FILLER PIC X(45) VALUE SPACES. NC2414.2 +018500 01 CCVS-E-2. NC2414.2 +018600 02 FILLER PIC X(31) VALUE SPACE. NC2414.2 +018700 02 FILLER PIC X(21) VALUE SPACE. NC2414.2 +018800 02 CCVS-E-2-2. NC2414.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2414.2 +019000 03 FILLER PIC X VALUE SPACE. NC2414.2 +019100 03 ENDER-DESC PIC X(44) VALUE NC2414.2 +019200 "ERRORS ENCOUNTERED". NC2414.2 +019300 01 CCVS-E-3. NC2414.2 +019400 02 FILLER PIC X(22) VALUE NC2414.2 +019500 " FOR OFFICIAL USE ONLY". NC2414.2 +019600 02 FILLER PIC X(12) VALUE SPACE. NC2414.2 +019700 02 FILLER PIC X(58) VALUE NC2414.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +019900 02 FILLER PIC X(13) VALUE SPACE. NC2414.2 +020000 02 FILLER PIC X(15) VALUE NC2414.2 +020100 " COPYRIGHT 1985". NC2414.2 +020200 01 CCVS-E-4. NC2414.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2414.2 +020400 02 FILLER PIC X(4) VALUE " OF ". NC2414.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2414.2 +020600 02 FILLER PIC X(40) VALUE NC2414.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2414.2 +020800 01 XXINFO. NC2414.2 +020900 02 FILLER PIC X(19) VALUE NC2414.2 +021000 "*** INFORMATION ***". NC2414.2 +021100 02 INFO-TEXT. NC2414.2 +021200 04 FILLER PIC X(8) VALUE SPACE. NC2414.2 +021300 04 XXCOMPUTED PIC X(20). NC2414.2 +021400 04 FILLER PIC X(5) VALUE SPACE. NC2414.2 +021500 04 XXCORRECT PIC X(20). NC2414.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). NC2414.2 +021700 01 HYPHEN-LINE. NC2414.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. NC2414.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************NC2414.2 +022000- "*****************************************". NC2414.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************NC2414.2 +022200- "******************************". NC2414.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE NC2414.2 +022400 "NC241A". NC2414.2 +022500 PROCEDURE DIVISION. NC2414.2 +022600 CCVS1 SECTION. NC2414.2 +022700 OPEN-FILES. NC2414.2 +022800 OPEN OUTPUT PRINT-FILE. NC2414.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2414.2 +023000 MOVE SPACE TO TEST-RESULTS. NC2414.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2414.2 +023200 GO TO CCVS1-EXIT. NC2414.2 +023300 CLOSE-FILES. NC2414.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2414.2 +023500 TERMINATE-CCVS. NC2414.2 +023600S EXIT PROGRAM. NC2414.2 +023700STERMINATE-CALL. NC2414.2 +023800 STOP RUN. NC2414.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2414.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2414.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2414.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2414.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. NC2414.2 +024400 PRINT-DETAIL. NC2414.2 +024500 IF REC-CT NOT EQUAL TO ZERO NC2414.2 +024600 MOVE "." TO PARDOT-X NC2414.2 +024700 MOVE REC-CT TO DOTVALUE. NC2414.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2414.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2414.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2414.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2414.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2414.2 +025300 MOVE SPACE TO CORRECT-X. NC2414.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2414.2 +025500 MOVE SPACE TO RE-MARK. NC2414.2 +025600 HEAD-ROUTINE. NC2414.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2414.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2414.2 +026100 COLUMN-NAMES-ROUTINE. NC2414.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +026500 END-ROUTINE. NC2414.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2414.2 +026700 END-RTN-EXIT. NC2414.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +026900 END-ROUTINE-1. NC2414.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2414.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2414.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. NC2414.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2414.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2414.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2414.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2414.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2414.2 +027800 END-ROUTINE-12. NC2414.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2414.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2414.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2414.2 +028200 ELSE NC2414.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2414.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2414.2 +028500 PERFORM WRITE-LINE. NC2414.2 +028600 END-ROUTINE-13. NC2414.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2414.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE NC2414.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2414.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2414.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO NC2414.2 +029300 MOVE "NO " TO ERROR-TOTAL NC2414.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2414.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2414.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029800 WRITE-LINE. NC2414.2 +029900 ADD 1 TO RECORD-COUNT. NC2414.2 +030000Y IF RECORD-COUNT GREATER 50 NC2414.2 +030100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2414.2 +030200Y MOVE SPACE TO DUMMY-RECORD NC2414.2 +030300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2414.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2414.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2414.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2414.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2414.2 +030800Y MOVE ZERO TO RECORD-COUNT. NC2414.2 +030900 PERFORM WRT-LN. NC2414.2 +031000 WRT-LN. NC2414.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2414.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC2414.2 +031300 BLANK-LINE-PRINT. NC2414.2 +031400 PERFORM WRT-LN. NC2414.2 +031500 FAIL-ROUTINE. NC2414.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2414.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2414.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2414.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2414.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2414.2 +032200 GO TO FAIL-ROUTINE-EX. NC2414.2 +032300 FAIL-ROUTINE-WRITE. NC2414.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2414.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2414.2 +032600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2414.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2414.2 +032800 FAIL-ROUTINE-EX. EXIT. NC2414.2 +032900 BAIL-OUT. NC2414.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2414.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2414.2 +033200 BAIL-OUT-WRITE. NC2414.2 +033300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2414.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2414.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2414.2 +033700 BAIL-OUT-EX. EXIT. NC2414.2 +033800 CCVS1-EXIT. NC2414.2 +033900 EXIT. NC2414.2 +034000 SECT-NC241A-001 SECTION. NC2414.2 +034100 TH-15-001. NC2414.2 +034200 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2414.2 +034300 UNTIL SUB-1 EQUAL TO 11 NC2414.2 +034400 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2414.2 +034500 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2414.2 +034600 GO TO CHECK-ENTRIES. NC2414.2 +034700 NC2414.2 +034800 PARA-1. NC2414.2 +034900 SET IDX-1 TO SUB-1. NC2414.2 +035000 SET IDX-2 TO SUB-2. NC2414.2 +035100 SET IDX-3 TO SUB-3. NC2414.2 +035200 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2414.2 +035300 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2414.2 +035400 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2414.2 +035500 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2414.2 +035600 SET ADD-ELEM TO IDX-3. NC2414.2 +035700 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2414.2 +035800 NC2414.2 +035900 CHECK-ENTRIES. NC2414.2 +036000 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2414.2 +036100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2414.2 +036200 MOVE SPACES TO TEST-CHECK. NC2414.2 +036300 MOVE "GRP05" TO GRP-HOLD-AREA. NC2414.2 +036400 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2414.2 +036500 UNTIL IDX-1 = 11. NC2414.2 +036600 IF TEST-CHECK = "PASS" GO TO TH1-INIT-GF-2. NC2414.2 +036700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +036800 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2414.2 +036900 NC2414.2 +037000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +037100 PERFORM FAIL. NC2414.2 +037200 PERFORM PRINT-DETAIL. NC2414.2 +037300* NC2414.2 +037400 TH1-INIT-GF-2. NC2414.2 +037500 MOVE "GRP10" TO GRP-HOLD-AREA. NC2414.2 +037600 MOVE "TH1-TEST-GF-2 " TO PAR-NAME. NC2414.2 +037700 MOVE SPACES TO TEST-CHECK. NC2414.2 +037800 TH1-TEST-GF-2. NC2414.2 +037900 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +038000 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +038100 IF TEST-CHECK = "PASS" NC2414.2 +038200 PERFORM PASS NC2414.2 +038300 GO TO TH1-WRITE-GF-2 NC2414.2 +038400 ELSE NC2414.2 +038500 GO TO TH1-FAIL-GF-2. NC2414.2 +038600 TH1-DELETE-GF-2. NC2414.2 +038700 PERFORM DE-LETE. NC2414.2 +038800 GO TO TH1-WRITE-GF-2. NC2414.2 +038900 TH1-FAIL-GF-2. NC2414.2 +039000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +039100 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2414.2 +039200 NC2414.2 +039300 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +039400 PERFORM FAIL. NC2414.2 +039500 TH1-WRITE-GF-2. NC2414.2 +039600 PERFORM PRINT-DETAIL. NC2414.2 +039700* NC2414.2 +039800 TH1-INIT-GF-3. NC2414.2 +039900 MOVE "GRP07" TO GRP-HOLD-AREA. NC2414.2 +040000 MOVE "TH1-TEST-GF-3 " TO PAR-NAME. NC2414.2 +040100 MOVE SPACES TO TEST-CHECK. NC2414.2 +040200 TH1-TEST-GF-3. NC2414.2 +040300 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +040400 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +040500 IF TEST-CHECK = "PASS" NC2414.2 +040600 PERFORM PASS NC2414.2 +040700 GO TO TH1-WRITE-GF-3 NC2414.2 +040800 ELSE NC2414.2 +040900 GO TO TH1-FAIL-GF-3. NC2414.2 +041000 TH1-DELETE-GF-3. NC2414.2 +041100 PERFORM DE-LETE. NC2414.2 +041200 GO TO TH1-WRITE-GF-3. NC2414.2 +041300 TH1-FAIL-GF-3. NC2414.2 +041400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +041500 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2414.2 +041600 NC2414.2 +041700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +041800 PERFORM FAIL. NC2414.2 +041900 TH1-WRITE-GF-3. NC2414.2 +042000 PERFORM PRINT-DETAIL. NC2414.2 +042100* NC2414.2 +042200 TH1-INIT-GF-4. NC2414.2 +042300 MOVE "TH1-TEST-GF-4 " TO PAR-NAME. NC2414.2 +042400 MOVE "GRP01" TO GRP-HOLD-AREA. NC2414.2 +042500 TH1-TEST-GF-4. NC2414.2 +042600 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +042700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +042800 IF TEST-CHECK = "PASS" NC2414.2 +042900 PERFORM PASS NC2414.2 +043000 GO TO TH1-WRITE-GF-4 NC2414.2 +043100 ELSE NC2414.2 +043200 GO TO TH1-FAIL-GF-4. NC2414.2 +043300 TH1-DELETE-GF-4. NC2414.2 +043400 PERFORM DE-LETE. NC2414.2 +043500 GO TO TH1-WRITE-GF-4. NC2414.2 +043600 TH1-FAIL-GF-4. NC2414.2 +043700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +043800 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2414.2 +043900 NC2414.2 +044000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +044100 PERFORM FAIL. NC2414.2 +044200 TH1-WRITE-GF-4. NC2414.2 +044300 PERFORM PRINT-DETAIL. NC2414.2 +044400 GO TO TH2-INIT-GF-1. NC2414.2 +044500* NC2414.2 +044600 FIND-LEVEL-1-ENTRY. NC2414.2 +044700 IF ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2414.2 +044800 MOVE "PASS" TO TEST-CHECK. NC2414.2 +044900* NC2414.2 +045000 TH2-INIT-GF-1. NC2414.2 +045100 MOVE "TH2-TEST-GF-1 " TO PAR-NAME. NC2414.2 +045200 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2414.2 +045300 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2414.2 +045400 MOVE SPACES TO TEST-CHECK. NC2414.2 +045500 TH2-TEST-GF-1. NC2414.2 +045600 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +045700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +045800 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +045900 IF TEST-CHECK = "PASS" NC2414.2 +046000 PERFORM PASS NC2414.2 +046100 GO TO TH2-WRITE-GF-1 NC2414.2 +046200 ELSE NC2414.2 +046300 GO TO TH2-FAIL-GF-1. NC2414.2 +046400 TH2-DELETE-GF-1. NC2414.2 +046500 PERFORM DE-LETE. NC2414.2 +046600 GO TO TH2-WRITE-GF-1. NC2414.2 +046700 TH2-FAIL-GF-1. NC2414.2 +046800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +046900 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2414.2 +047000 NC2414.2 +047100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +047200 PERFORM FAIL. NC2414.2 +047300 TH2-WRITE-GF-1. NC2414.2 +047400 PERFORM PRINT-DETAIL. NC2414.2 +047500* NC2414.2 +047600 TH2-INIT-GF-2. NC2414.2 +047700 MOVE "TH2-TEST-GF-2 " TO PAR-NAME. NC2414.2 +047800 MOVE SPACES TO TEST-CHECK. NC2414.2 +047900 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2414.2 +048000 TH2-TEST-GF-2. NC2414.2 +048100 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +048200 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +048300 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +048400 IF TEST-CHECK = "PASS" NC2414.2 +048500 PERFORM PASS NC2414.2 +048600 GO TO TH2-WRITE-GF-2 NC2414.2 +048700 ELSE NC2414.2 +048800 GO TO TH2-FAIL-GF-2. NC2414.2 +048900 TH2-DELETE-GF-2. NC2414.2 +049000 PERFORM DE-LETE. NC2414.2 +049100 GO TO TH2-WRITE-GF-2. NC2414.2 +049200 TH2-FAIL-GF-2. NC2414.2 +049300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +049400 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2414.2 +049500 NC2414.2 +049600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +049700 PERFORM FAIL. NC2414.2 +049800 TH2-WRITE-GF-2. NC2414.2 +049900 PERFORM PRINT-DETAIL. NC2414.2 +050000* NC2414.2 +050100 TH2-INIT-GF-3. NC2414.2 +050200 MOVE "TH2-TEST-GF-3 " TO PAR-NAME. NC2414.2 +050300 MOVE SPACES TO TEST-CHECK. NC2414.2 +050400 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2414.2 +050500 TH2-TEST-GF-3. NC2414.2 +050600 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +050700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +050800 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +050900 IF TEST-CHECK = "PASS" NC2414.2 +051000 PERFORM PASS NC2414.2 +051100 GO TO TH2-WRITE-GF-3 NC2414.2 +051200 ELSE NC2414.2 +051300 GO TO TH2-FAIL-GF-3. NC2414.2 +051400 TH2-DELETE-GF-3. NC2414.2 +051500 PERFORM DE-LETE. NC2414.2 +051600 GO TO TH2-WRITE-GF-3. NC2414.2 +051700 TH2-FAIL-GF-3. NC2414.2 +051800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +051900 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2414.2 +052000 NC2414.2 +052100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +052200 PERFORM FAIL. NC2414.2 +052300 TH2-WRITE-GF-3. NC2414.2 +052400 PERFORM PRINT-DETAIL. NC2414.2 +052500* NC2414.2 +052600 TH2-INIT-GF-4. NC2414.2 +052700 MOVE "TH2-TEST-GF-4 " TO PAR-NAME. NC2414.2 +052800 MOVE SPACES TO TEST-CHECK. NC2414.2 +052900 MOVE SPACES TO TEST-CHECK. NC2414.2 +053000 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2414.2 +053100 TH2-TEST-GF-4. NC2414.2 +053200 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +053300 VARYING IDX-1 FROM 2 BY 2 UNTIL IDX-1 GREATER 10 NC2414.2 +053400 AFTER IDX-2 FROM 2 BY 2 UNTIL IDX-2 GREATER 10. NC2414.2 +053500 IF TEST-CHECK = "PASS" NC2414.2 +053600 PERFORM PASS NC2414.2 +053700 GO TO TH2-WRITE-GF-4 NC2414.2 +053800 ELSE NC2414.2 +053900 GO TO TH2-FAIL-GF-4. NC2414.2 +054000 TH2-DELETE-GF-4. NC2414.2 +054100 PERFORM DE-LETE. NC2414.2 +054200 GO TO TH2-WRITE-GF-4. NC2414.2 +054300 TH2-FAIL-GF-4. NC2414.2 +054400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +054500 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2414.2 +054600 NC2414.2 +054700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +054800 PERFORM FAIL. NC2414.2 +054900 TH2-WRITE-GF-4. NC2414.2 +055000 PERFORM PRINT-DETAIL. NC2414.2 +055100 GO TO TH3-INIT-GF-1. NC2414.2 +055200* NC2414.2 +055300 FIND-LEVEL-2-ENTRY. NC2414.2 +055400 IF ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2414.2 +055500 MOVE "PASS" TO TEST-CHECK. NC2414.2 +055600* NC2414.2 +055700 TH3-INIT-GF-1. NC2414.2 +055800 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2414.2 +055900 MOVE SPACES TO TEST-CHECK. NC2414.2 +056000 MOVE "TH3-TEST-GF-1 " TO PAR-NAME. NC2414.2 +056100 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2414.2 +056200 TH3-TEST-GF-1. NC2414.2 +056300 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +056400 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +056500 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10 NC2414.2 +056600 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 = 10. NC2414.2 +056700 IF TEST-CHECK = "PASS" NC2414.2 +056800 PERFORM PASS NC2414.2 +056900 GO TO TH3-WRITE-GF-1 NC2414.2 +057000 ELSE NC2414.2 +057100 GO TO TH3-FAIL-GF-1. NC2414.2 +057200 TH3-DELETE-GF-1. NC2414.2 +057300 PERFORM DE-LETE. NC2414.2 +057400 GO TO TH3-WRITE-GF-1. NC2414.2 +057500 TH3-FAIL-GF-1. NC2414.2 +057600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +057700 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2414.2 +057800 NC2414.2 +057900 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +058000 PERFORM FAIL. NC2414.2 +058100 TH3-WRITE-GF-1. NC2414.2 +058200 PERFORM PRINT-DETAIL. NC2414.2 +058300* NC2414.2 +058400 TH3-INIT-GF-2. NC2414.2 +058500 MOVE "TH3-TEST-GF-2 " TO PAR-NAME. NC2414.2 +058600 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2414.2 +058700 MOVE SPACES TO TEST-CHECK. NC2414.2 +058800 TH3-TEST-GF-2. NC2414.2 +058900 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +059000 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +059100 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 GREATER 10 NC2414.2 +059200 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 GREATER 10. NC2414.2 +059300 IF TEST-CHECK = "PASS" NC2414.2 +059400 PERFORM PASS NC2414.2 +059500 GO TO TH3-WRITE-GF-2 NC2414.2 +059600 ELSE NC2414.2 +059700 GO TO TH3-FAIL-GF-2. NC2414.2 +059800 TH3-DELETE-GF-2. NC2414.2 +059900 PERFORM DE-LETE. NC2414.2 +060000 GO TO TH3-WRITE-GF-2. NC2414.2 +060100 TH3-FAIL-GF-2. NC2414.2 +060200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +060300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2414.2 +060400 NC2414.2 +060500 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +060600 PERFORM FAIL. NC2414.2 +060700 TH3-WRITE-GF-2. NC2414.2 +060800 PERFORM PRINT-DETAIL. NC2414.2 +060900* NC2414.2 +061000 TH3-INIT-GF-3. NC2414.2 +061100 MOVE "TH3-TEST-GF-3 " TO PAR-NAME. NC2414.2 +061200 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2414.2 +061300 MOVE SPACES TO TEST-CHECK. NC2414.2 +061400 TH3-TEST-GF-3. NC2414.2 +061500 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +061600 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +061700 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10 NC2414.2 +061800 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 = 10. NC2414.2 +061900 IF TEST-CHECK = "PASS" NC2414.2 +062000 PERFORM PASS NC2414.2 +062100 GO TO TH3-WRITE-GF-3 NC2414.2 +062200 ELSE NC2414.2 +062300 GO TO TH3-FAIL-GF-3. NC2414.2 +062400 TH3-DELETE-GF-3. NC2414.2 +062500 PERFORM DE-LETE. NC2414.2 +062600 GO TO TH3-WRITE-GF-3. NC2414.2 +062700 TH3-FAIL-GF-3. NC2414.2 +062800 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +062900 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2414.2 +063000 NC2414.2 +063100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +063200 PERFORM FAIL. NC2414.2 +063300 TH3-WRITE-GF-3. NC2414.2 +063400 PERFORM PRINT-DETAIL. NC2414.2 +063500* NC2414.2 +063600 TH3-INIT-GF-4. NC2414.2 +063700 MOVE "TH3-TEST-GF-4 " TO PAR-NAME. NC2414.2 +063800 MOVE SPACES TO TEST-CHECK. NC2414.2 +063900 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2414.2 +064000 TH3-TEST-GF-4. NC2414.2 +064100 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +064200 VARYING IDX-1 FROM 3 BY 3 UNTIL IDX-1 GREATER 10 NC2414.2 +064300 AFTER IDX-2 FROM 2 BY 2 UNTIL IDX-2 GREATER 10 NC2414.2 +064400 AFTER IDX-3 FROM 8 BY 8 UNTIL IDX-3 GREATER 10. NC2414.2 +064500 IF TEST-CHECK = "PASS" NC2414.2 +064600 PERFORM PASS NC2414.2 +064700 GO TO TH3-WRITE-GF-4 NC2414.2 +064800 ELSE NC2414.2 +064900 GO TO TH3-FAIL-GF-4. NC2414.2 +065000 TH3-DELETE-GF-4. NC2414.2 +065100 PERFORM DE-LETE. NC2414.2 +065200 GO TO TH3-WRITE-GF-4. NC2414.2 +065300 TH3-FAIL-GF-4. NC2414.2 +065400 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +065500 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2414.2 +065600 NC2414.2 +065700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +065800 PERFORM FAIL. NC2414.2 +065900 TH3-WRITE-GF-4. NC2414.2 +066000 PERFORM PRINT-DETAIL. NC2414.2 +066100 GO TO END-3LEVEL-TEST. NC2414.2 +066200* NC2414.2 +066300 FIND-LEVEL-3-ENTRY. NC2414.2 +066400 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2414.2 +066500 MOVE "PASS" TO TEST-CHECK. NC2414.2 +066600* NC2414.2 +066700 END-3LEVEL-TEST. NC2414.2 +066800 EXIT. NC2414.2 +066900 CCVS-EXIT SECTION. NC2414.2 +067000 CCVS-999999. NC2414.2 +067100 GO TO CLOSE-FILES. NC2414.2 +*END-OF,NC241A +*HEADER,COBOL,NC242A +000100 IDENTIFICATION DIVISION. NC2424.2 +000200 PROGRAM-ID. NC2424.2 +000300 NC242A. NC2424.2 +000400 NC2424.2 +000500**************************************************************** NC2424.2 +000600* * NC2424.2 +000700* VALIDATION FOR:- * NC2424.2 +000800* * NC2424.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +001000* * NC2424.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2424.2 +001200* * NC2424.2 +001300**************************************************************** NC2424.2 +001400* * NC2424.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2424.2 +001600* * NC2424.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2424.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2424.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2424.2 +002000* * NC2424.2 +002100**************************************************************** NC2424.2 +002200* * NC2424.2 +002300* PROGRAM NC242A TESTS THE CONSTRUCTION AND ACCESS OF * NC2424.2 +002400* THREE AND SEVEN-DIMENSIONAL TABLES. * NC2424.2 +002500* THE CONSTRUCTION IS BY MEANS OF A FORMAT 4 "PERFORM" * NC2424.2 +002600* STATEMENT UTILIZING SUBSCRIPTS WHICH ARE CONVERTED TO * NC2424.2 +002700* INDICES BY "SET". ACCESS IS VIA "IF" STATEMENTS USING * NC2424.2 +002800* SUBSCRIPTS OF NUMERIC LITERALS AND CONSTANTS. * NC2424.2 +002900* * NC2424.2 +003000**************************************************************** NC2424.2 +003100 ENVIRONMENT DIVISION. NC2424.2 +003200 CONFIGURATION SECTION. NC2424.2 +003300 SOURCE-COMPUTER. NC2424.2 +003400 XXXXX082. NC2424.2 +003500 OBJECT-COMPUTER. NC2424.2 +003600 XXXXX083. NC2424.2 +003700 INPUT-OUTPUT SECTION. NC2424.2 +003800 FILE-CONTROL. NC2424.2 +003900 SELECT PRINT-FILE ASSIGN TO NC2424.2 +004000 XXXXX055. NC2424.2 +004100 DATA DIVISION. NC2424.2 +004200 FILE SECTION. NC2424.2 +004300 FD PRINT-FILE. NC2424.2 +004400 01 PRINT-REC PICTURE X(120). NC2424.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC2424.2 +004600 WORKING-STORAGE SECTION. NC2424.2 +004700 77 SUB-1 PICTURE S99 VALUE ZERO. NC2424.2 +004800 77 SUB-2 PICTURE 99 VALUE ZERO. NC2424.2 +004900 77 SUB-3 PICTURE 99 VALUE ZERO. NC2424.2 +005000 77 CON-7 PICTURE 99 VALUE 07. NC2424.2 +005100 77 CON-10 PICTURE 99 VALUE 10. NC2424.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2424.2 +005300 77 CON-6 PICTURE 99 VALUE 06. NC2424.2 +005400 77 N1 PICTURE 99 VALUE ZERO. NC2424.2 +005500 77 N2 PICTURE 99 VALUE ZERO. NC2424.2 +005600 77 N3 PICTURE 99 VALUE ZERO. NC2424.2 +005700 77 N4 PICTURE 99 VALUE ZERO. NC2424.2 +005800 77 N5 PICTURE 99 VALUE ZERO. NC2424.2 +005900 77 N6 PICTURE 99 VALUE ZERO. NC2424.2 +006000 77 N7 PICTURE 99 VALUE ZERO. NC2424.2 +006100 NC2424.2 +006200 NC2424.2 +006300 NC2424.2 +006400 01 GRP-NAME. NC2424.2 +006500 02 FILLER PICTURE XXX VALUE "GRP". NC2424.2 +006600 02 ADD-GRP PICTURE 99 VALUE 01. NC2424.2 +006700 NC2424.2 +006800 01 SEC-NAME. NC2424.2 +006900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2424.2 +007000 02 SEC-GRP PICTURE 99 VALUE 00. NC2424.2 +007100 02 FILLER PICTURE X VALUE ",". NC2424.2 +007200 02 ADD-SEC PICTURE 99 VALUE 01. NC2424.2 +007300 02 FILLER PICTURE X VALUE ")". NC2424.2 +007400 NC2424.2 +007500 01 ELEM-NAME. NC2424.2 +007600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2424.2 +007700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2424.2 +007800 02 FILLER PICTURE X VALUE ",". NC2424.2 +007900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2424.2 +008000 02 FILLER PICTURE X VALUE ",". NC2424.2 +008100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2424.2 +008200 02 FILLER PICTURE X VALUE ")". NC2424.2 +008300 NC2424.2 +008400 01 3-DIMENSION-TBL. NC2424.2 +008500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2424.2 +008600 03 ENTRY-1 PICTURE X(5). NC2424.2 +008700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2424.2 +008800 04 ENTRY-2 PICTURE X(11). NC2424.2 +008900 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2424.2 +009000 05 ENTRY-3 PICTURE X(15). NC2424.2 +009100 NC2424.2 +009200 01 7-DIMENSION-TBL. NC2424.2 +009300 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY IX-1. NC2424.2 +009400 03 ENTRY-7-1 PIC XX. NC2424.2 +009500 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY IX-2. NC2424.2 +009600 04 ENTRY-7-2 PIC XX. NC2424.2 +009700 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY IX-3. NC2424.2 +009800 05 ENTRY-7-3 PIC XX. NC2424.2 +009900 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY IX-4. NC2424.2 +010000 06 ENTRY-7-4 PIC XX. NC2424.2 +010100 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY IX-5. NC2424.2 +010200 07 ENTRY-7-5 PIC XX. NC2424.2 +010300 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY IX-6. NC2424.2 +010400 08 ENTRY-7-6 PIC XX. NC2424.2 +010500 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY IX-7. NC2424.2 +010600 09 ENTRY-7-7 PIC XX. NC2424.2 +010700 NC2424.2 +010800 77 L1-HOLD PIC XX. NC2424.2 +010900 77 L2-HOLD PIC XX. NC2424.2 +011000 77 L3-HOLD PIC XX. NC2424.2 +011100 77 L4-HOLD PIC XX. NC2424.2 +011200 77 L5-HOLD PIC XX. NC2424.2 +011300 77 L6-HOLD PIC XX. NC2424.2 +011400 77 L7-HOLD PIC XX. NC2424.2 +011500 01 TEST-RESULTS. NC2424.2 +011600 02 FILLER PIC X VALUE SPACE. NC2424.2 +011700 02 FEATURE PIC X(20) VALUE SPACE. NC2424.2 +011800 02 FILLER PIC X VALUE SPACE. NC2424.2 +011900 02 P-OR-F PIC X(5) VALUE SPACE. NC2424.2 +012000 02 FILLER PIC X VALUE SPACE. NC2424.2 +012100 02 PAR-NAME. NC2424.2 +012200 03 FILLER PIC X(19) VALUE SPACE. NC2424.2 +012300 03 PARDOT-X PIC X VALUE SPACE. NC2424.2 +012400 03 DOTVALUE PIC 99 VALUE ZERO. NC2424.2 +012500 02 FILLER PIC X(8) VALUE SPACE. NC2424.2 +012600 02 RE-MARK PIC X(61). NC2424.2 +012700 01 TEST-COMPUTED. NC2424.2 +012800 02 FILLER PIC X(30) VALUE SPACE. NC2424.2 +012900 02 FILLER PIC X(17) VALUE NC2424.2 +013000 " COMPUTED=". NC2424.2 +013100 02 COMPUTED-X. NC2424.2 +013200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2424.2 +013300 03 COMPUTED-N REDEFINES COMPUTED-A NC2424.2 +013400 PIC -9(9).9(9). NC2424.2 +013500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2424.2 +013600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2424.2 +013700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2424.2 +013800 03 CM-18V0 REDEFINES COMPUTED-A. NC2424.2 +013900 04 COMPUTED-18V0 PIC -9(18). NC2424.2 +014000 04 FILLER PIC X. NC2424.2 +014100 03 FILLER PIC X(50) VALUE SPACE. NC2424.2 +014200 01 TEST-CORRECT. NC2424.2 +014300 02 FILLER PIC X(30) VALUE SPACE. NC2424.2 +014400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2424.2 +014500 02 CORRECT-X. NC2424.2 +014600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2424.2 +014700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2424.2 +014800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2424.2 +014900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2424.2 +015000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2424.2 +015100 03 CR-18V0 REDEFINES CORRECT-A. NC2424.2 +015200 04 CORRECT-18V0 PIC -9(18). NC2424.2 +015300 04 FILLER PIC X. NC2424.2 +015400 03 FILLER PIC X(2) VALUE SPACE. NC2424.2 +015500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2424.2 +015600 01 CCVS-C-1. NC2424.2 +015700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2424.2 +015800- "SS PARAGRAPH-NAME NC2424.2 +015900- " REMARKS". NC2424.2 +016000 02 FILLER PIC X(20) VALUE SPACE. NC2424.2 +016100 01 CCVS-C-2. NC2424.2 +016200 02 FILLER PIC X VALUE SPACE. NC2424.2 +016300 02 FILLER PIC X(6) VALUE "TESTED". NC2424.2 +016400 02 FILLER PIC X(15) VALUE SPACE. NC2424.2 +016500 02 FILLER PIC X(4) VALUE "FAIL". NC2424.2 +016600 02 FILLER PIC X(94) VALUE SPACE. NC2424.2 +016700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2424.2 +016800 01 REC-CT PIC 99 VALUE ZERO. NC2424.2 +016900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2424.2 +017400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2424.2 +017500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2424.2 +017600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2424.2 +017700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2424.2 +017800 01 CCVS-H-1. NC2424.2 +017900 02 FILLER PIC X(39) VALUE SPACES. NC2424.2 +018000 02 FILLER PIC X(42) VALUE NC2424.2 +018100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2424.2 +018200 02 FILLER PIC X(39) VALUE SPACES. NC2424.2 +018300 01 CCVS-H-2A. NC2424.2 +018400 02 FILLER PIC X(40) VALUE SPACE. NC2424.2 +018500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2424.2 +018600 02 FILLER PIC XXXX VALUE NC2424.2 +018700 "4.2 ". NC2424.2 +018800 02 FILLER PIC X(28) VALUE NC2424.2 +018900 " COPY - NOT FOR DISTRIBUTION". NC2424.2 +019000 02 FILLER PIC X(41) VALUE SPACE. NC2424.2 +019100 NC2424.2 +019200 01 CCVS-H-2B. NC2424.2 +019300 02 FILLER PIC X(15) VALUE NC2424.2 +019400 "TEST RESULT OF ". NC2424.2 +019500 02 TEST-ID PIC X(9). NC2424.2 +019600 02 FILLER PIC X(4) VALUE NC2424.2 +019700 " IN ". NC2424.2 +019800 02 FILLER PIC X(12) VALUE NC2424.2 +019900 " HIGH ". NC2424.2 +020000 02 FILLER PIC X(22) VALUE NC2424.2 +020100 " LEVEL VALIDATION FOR ". NC2424.2 +020200 02 FILLER PIC X(58) VALUE NC2424.2 +020300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +020400 01 CCVS-H-3. NC2424.2 +020500 02 FILLER PIC X(34) VALUE NC2424.2 +020600 " FOR OFFICIAL USE ONLY ". NC2424.2 +020700 02 FILLER PIC X(58) VALUE NC2424.2 +020800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2424.2 +020900 02 FILLER PIC X(28) VALUE NC2424.2 +021000 " COPYRIGHT 1985 ". NC2424.2 +021100 01 CCVS-E-1. NC2424.2 +021200 02 FILLER PIC X(52) VALUE SPACE. NC2424.2 +021300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2424.2 +021400 02 ID-AGAIN PIC X(9). NC2424.2 +021500 02 FILLER PIC X(45) VALUE SPACES. NC2424.2 +021600 01 CCVS-E-2. NC2424.2 +021700 02 FILLER PIC X(31) VALUE SPACE. NC2424.2 +021800 02 FILLER PIC X(21) VALUE SPACE. NC2424.2 +021900 02 CCVS-E-2-2. NC2424.2 +022000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2424.2 +022100 03 FILLER PIC X VALUE SPACE. NC2424.2 +022200 03 ENDER-DESC PIC X(44) VALUE NC2424.2 +022300 "ERRORS ENCOUNTERED". NC2424.2 +022400 01 CCVS-E-3. NC2424.2 +022500 02 FILLER PIC X(22) VALUE NC2424.2 +022600 " FOR OFFICIAL USE ONLY". NC2424.2 +022700 02 FILLER PIC X(12) VALUE SPACE. NC2424.2 +022800 02 FILLER PIC X(58) VALUE NC2424.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +023000 02 FILLER PIC X(13) VALUE SPACE. NC2424.2 +023100 02 FILLER PIC X(15) VALUE NC2424.2 +023200 " COPYRIGHT 1985". NC2424.2 +023300 01 CCVS-E-4. NC2424.2 +023400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2424.2 +023500 02 FILLER PIC X(4) VALUE " OF ". NC2424.2 +023600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2424.2 +023700 02 FILLER PIC X(40) VALUE NC2424.2 +023800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2424.2 +023900 01 XXINFO. NC2424.2 +024000 02 FILLER PIC X(19) VALUE NC2424.2 +024100 "*** INFORMATION ***". NC2424.2 +024200 02 INFO-TEXT. NC2424.2 +024300 04 FILLER PIC X(8) VALUE SPACE. NC2424.2 +024400 04 XXCOMPUTED PIC X(20). NC2424.2 +024500 04 FILLER PIC X(5) VALUE SPACE. NC2424.2 +024600 04 XXCORRECT PIC X(20). NC2424.2 +024700 02 INF-ANSI-REFERENCE PIC X(48). NC2424.2 +024800 01 HYPHEN-LINE. NC2424.2 +024900 02 FILLER PIC IS X VALUE IS SPACE. NC2424.2 +025000 02 FILLER PIC IS X(65) VALUE IS "************************NC2424.2 +025100- "*****************************************". NC2424.2 +025200 02 FILLER PIC IS X(54) VALUE IS "************************NC2424.2 +025300- "******************************". NC2424.2 +025400 01 CCVS-PGM-ID PIC X(9) VALUE NC2424.2 +025500 "NC242A". NC2424.2 +025600 PROCEDURE DIVISION. NC2424.2 +025700 CCVS1 SECTION. NC2424.2 +025800 OPEN-FILES. NC2424.2 +025900 OPEN OUTPUT PRINT-FILE. NC2424.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2424.2 +026100 MOVE SPACE TO TEST-RESULTS. NC2424.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2424.2 +026300 GO TO CCVS1-EXIT. NC2424.2 +026400 CLOSE-FILES. NC2424.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2424.2 +026600 TERMINATE-CCVS. NC2424.2 +026700S EXIT PROGRAM. NC2424.2 +026800STERMINATE-CALL. NC2424.2 +026900 STOP RUN. NC2424.2 +027000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2424.2 +027100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2424.2 +027200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2424.2 +027300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2424.2 +027400 MOVE "****TEST DELETED****" TO RE-MARK. NC2424.2 +027500 PRINT-DETAIL. NC2424.2 +027600 IF REC-CT NOT EQUAL TO ZERO NC2424.2 +027700 MOVE "." TO PARDOT-X NC2424.2 +027800 MOVE REC-CT TO DOTVALUE. NC2424.2 +027900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2424.2 +028000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2424.2 +028100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2424.2 +028200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2424.2 +028300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2424.2 +028400 MOVE SPACE TO CORRECT-X. NC2424.2 +028500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2424.2 +028600 MOVE SPACE TO RE-MARK. NC2424.2 +028700 HEAD-ROUTINE. NC2424.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2424.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2424.2 +029200 COLUMN-NAMES-ROUTINE. NC2424.2 +029300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +029400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +029600 END-ROUTINE. NC2424.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2424.2 +029800 END-RTN-EXIT. NC2424.2 +029900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +030000 END-ROUTINE-1. NC2424.2 +030100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2424.2 +030200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2424.2 +030300 ADD PASS-COUNTER TO ERROR-HOLD. NC2424.2 +030400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2424.2 +030500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2424.2 +030600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2424.2 +030700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2424.2 +030800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2424.2 +030900 END-ROUTINE-12. NC2424.2 +031000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2424.2 +031100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2424.2 +031200 MOVE "NO " TO ERROR-TOTAL NC2424.2 +031300 ELSE NC2424.2 +031400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2424.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2424.2 +031600 PERFORM WRITE-LINE. NC2424.2 +031700 END-ROUTINE-13. NC2424.2 +031800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2424.2 +031900 MOVE "NO " TO ERROR-TOTAL ELSE NC2424.2 +032000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2424.2 +032100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2424.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032300 IF INSPECT-COUNTER EQUAL TO ZERO NC2424.2 +032400 MOVE "NO " TO ERROR-TOTAL NC2424.2 +032500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2424.2 +032600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2424.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032900 WRITE-LINE. NC2424.2 +033000 ADD 1 TO RECORD-COUNT. NC2424.2 +033100Y IF RECORD-COUNT GREATER 50 NC2424.2 +033200Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2424.2 +033300Y MOVE SPACE TO DUMMY-RECORD NC2424.2 +033400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2424.2 +033500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2424.2 +033600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2424.2 +033700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2424.2 +033800Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2424.2 +033900Y MOVE ZERO TO RECORD-COUNT. NC2424.2 +034000 PERFORM WRT-LN. NC2424.2 +034100 WRT-LN. NC2424.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2424.2 +034300 MOVE SPACE TO DUMMY-RECORD. NC2424.2 +034400 BLANK-LINE-PRINT. NC2424.2 +034500 PERFORM WRT-LN. NC2424.2 +034600 FAIL-ROUTINE. NC2424.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2424.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2424.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2424.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2424.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2424.2 +035300 GO TO FAIL-ROUTINE-EX. NC2424.2 +035400 FAIL-ROUTINE-WRITE. NC2424.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2424.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2424.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2424.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2424.2 +035900 FAIL-ROUTINE-EX. EXIT. NC2424.2 +036000 BAIL-OUT. NC2424.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2424.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2424.2 +036300 BAIL-OUT-WRITE. NC2424.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2424.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2424.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2424.2 +036800 BAIL-OUT-EX. EXIT. NC2424.2 +036900 CCVS1-EXIT. NC2424.2 +037000 EXIT. NC2424.2 +037100 SECT-NC242A-001 SECTION. NC2424.2 +037200 TH-16-001. NC2424.2 +037300 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2424.2 +037400 UNTIL SUB-1 EQUAL TO 11 NC2424.2 +037500 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2424.2 +037600 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2424.2 +037700 GO TO CHECK-ENTRIES. NC2424.2 +037800 NC2424.2 +037900 PARA-1. NC2424.2 +038000 SET IDX-1 TO SUB-1. NC2424.2 +038100 SET IDX-2 TO SUB-2. NC2424.2 +038200 SET IDX-3 TO SUB-3. NC2424.2 +038300 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2424.2 +038400 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2424.2 +038500 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2424.2 +038600 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2424.2 +038700 SET ADD-ELEM TO IDX-3. NC2424.2 +038800 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2424.2 +038900 NC2424.2 +039000 CHECK-ENTRIES. NC2424.2 +039100 MOVE "LEVEL 1 TBL SUBSCRPT" TO FEATURE. NC2424.2 +039200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2424.2 +039300 IF ENTRY-1 (5) IS NOT EQUAL TO "GRP05" NC2424.2 +039400 MOVE "GRP05" TO CORRECT-A NC2424.2 +039500 MOVE ENTRY-1 (5) TO COMPUTED-A NC2424.2 +039600 NC2424.2 +039700 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC2424.2 +039800 PERFORM FAIL NC2424.2 +039900 GO TO TEST-1-WRITE. NC2424.2 +040000 NC2424.2 +040100 PERFORM PASS. NC2424.2 +040200 TEST-1-WRITE. NC2424.2 +040300 PERFORM PRINT-DETAIL. NC2424.2 +040400 NC2424.2 +040500 TEST-1-2. NC2424.2 +040600 MOVE "TEST-1-2" TO PAR-NAME. NC2424.2 +040700 IF ENTRY-1 (CON-5) IS NOT EQUAL TO "GRP05" NC2424.2 +040800 MOVE "GRP05" TO CORRECT-A NC2424.2 +040900 MOVE ENTRY-1 (CON-5) TO COMPUTED-A NC2424.2 +041000 NC2424.2 +041100 MOVE "NUMERIC CONSTANT SUBSCRIPT " TO RE-MARK NC2424.2 +041200 PERFORM FAIL NC2424.2 +041300 GO TO TEST-1-2-WRITE. NC2424.2 +041400 NC2424.2 +041500 PERFORM PASS. NC2424.2 +041600 TEST-1-2-WRITE. NC2424.2 +041700 PERFORM PRINT-DETAIL. NC2424.2 +041800 NC2424.2 +041900 TEST-2. NC2424.2 +042000 MOVE "LEVEL 2 TBL SUBSCRPT" TO FEATURE. NC2424.2 +042100 MOVE "TEST-2 " TO PAR-NAME. NC2424.2 +042200 IF ENTRY-2 (5, 6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +042300 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +042400 MOVE ENTRY-2 (5, 6) TO COMPUTED-A NC2424.2 +042500 NC2424.2 +042600 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC2424.2 +042700 PERFORM FAIL NC2424.2 +042800 GO TO TEST-2-WRITE. NC2424.2 +042900 NC2424.2 +043000 PERFORM PASS. NC2424.2 +043100 TEST-2-WRITE. NC2424.2 +043200 PERFORM PRINT-DETAIL. NC2424.2 +043300 NC2424.2 +043400 TEST-2-2. NC2424.2 +043500 MOVE "TEST-2-2 " TO PAR-NAME. NC2424.2 +043600 IF ENTRY-2 (05, CON-6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +043700 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +043800 MOVE ENTRY-2 (05, CON-6) TO COMPUTED-A NC2424.2 +043900 NC2424.2 +044000 MOVE "NUM LITRL/CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +044100 PERFORM FAIL NC2424.2 +044200 GO TO TEST-2-2-WRITE. NC2424.2 +044300 NC2424.2 +044400 PERFORM PASS. NC2424.2 +044500 TEST-2-2-WRITE. NC2424.2 +044600 PERFORM PRINT-DETAIL. NC2424.2 +044700 NC2424.2 +044800 TEST-2-3. NC2424.2 +044900 MOVE "TEST-2-3 " TO PAR-NAME. NC2424.2 +045000 IF ENTRY-2 (CON-5, CON-6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +045100 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +045200 MOVE ENTRY-2 (CON-5, CON-6) TO COMPUTED-A NC2424.2 +045300 NC2424.2 +045400 MOVE "2 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +045500 PERFORM FAIL NC2424.2 +045600 GO TO TEST-2-3-WRITE. NC2424.2 +045700 NC2424.2 +045800 PERFORM PASS. NC2424.2 +045900 TEST-2-3-WRITE. NC2424.2 +046000 PERFORM PRINT-DETAIL. NC2424.2 +046100 NC2424.2 +046200 TEST-3. NC2424.2 +046300 MOVE "LEVEL 3 TBL SUBSCRPT" TO FEATURE. NC2424.2 +046400 MOVE "TEST-3 " TO PAR-NAME. NC2424.2 +046500 IF ENTRY-3 (10, 05, 06) IS NOT EQUAL TO "ELEM (10,05,06)" NC2424.2 +046600 MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +046700 MOVE ENTRY-3 (10, 05, 06) TO COMPUTED-A NC2424.2 +046800 NC2424.2 +046900 MOVE "3 NUMERIC LITERAL SUBSCRPTS" TO RE-MARK NC2424.2 +047000 PERFORM FAIL NC2424.2 +047100 GO TO TEST-3-WRITE. NC2424.2 +047200 NC2424.2 +047300 PERFORM PASS. NC2424.2 +047400 TEST-3-WRITE. NC2424.2 +047500 PERFORM PRINT-DETAIL. NC2424.2 +047600 NC2424.2 +047700 TEST-3-2. NC2424.2 +047800 MOVE "TEST-3-2 " TO PAR-NAME. NC2424.2 +047900 IF ENTRY-3 (10, CON-5, CON-6) IS NOT EQUAL TO NC2424.2 +048000 "ELEM (10,05,06)" NC2424.2 +048100 MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +048200 MOVE ENTRY-3 (10, CON-5, CON-6) TO COMPUTED-A NC2424.2 +048300 NC2424.2 +048400 MOVE "1 NUM LTRL/2 CONSTANT SUBS " TO RE-MARK NC2424.2 +048500 PERFORM FAIL NC2424.2 +048600 GO TO TEST-3-2-WRITE. NC2424.2 +048700 NC2424.2 +048800 PERFORM PASS. NC2424.2 +048900 TEST-3-2-WRITE. NC2424.2 +049000 PERFORM PRINT-DETAIL. NC2424.2 +049100 NC2424.2 +049200 TEST-3-3. NC2424.2 +049300 MOVE "TEST-3-3 " TO PAR-NAME. NC2424.2 +049400 IF ENTRY-3 (CON-10, CON-5, CON-6) IS NOT EQUAL TO NC2424.2 +049500 "ELEM (10,05,06)" MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +049600 MOVE ENTRY-3 (CON-10, CON-5, CON-6) TO COMPUTED-A NC2424.2 +049700 NC2424.2 +049800 MOVE "3 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +049900 PERFORM FAIL NC2424.2 +050000 GO TO END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050100 NC2424.2 +050200 PERFORM PASS. NC2424.2 +050300 GO TO END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050400 NC2424.2 +050500 END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050600 PERFORM PRINT-DETAIL. NC2424.2 +050700* NC2424.2 +050800 TH7-INIT. NC2424.2 +050900 MOVE "TH7-TEST" TO PAR-NAME. NC2424.2 +051000 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2424.2 +051100 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2424.2 +051200 MOVE "KL" TO L4-HOLD. NC2424.2 +051300 MOVE "AB" TO L5-HOLD. NC2424.2 +051400 MOVE "CD" TO L6-HOLD. NC2424.2 +051500 MOVE "GH" TO L7-HOLD. NC2424.2 +051600 MOVE 1 TO REC-CT. NC2424.2 +051700 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2424.2 +051800 MOVE 2 TO N1 N3 N5 N7. NC2424.2 +051900 GO TO TH7-TEST-1. NC2424.2 +052000 TH7-DELETE-1. NC2424.2 +052100 PERFORM DE-LETE. NC2424.2 +052200 PERFORM PRINT-DETAIL. NC2424.2 +052300 GO TO CCVS-999999. NC2424.2 +052400 TH7-TEST-1. NC2424.2 +052500 MOVE "TH7-TEST-1" TO PAR-NAME. NC2424.2 +052600 IF ENTRY-7-4 (N1 1 N3 1) = L4-HOLD NC2424.2 +052700 PERFORM PASS NC2424.2 +052800 PERFORM PRINT-DETAIL NC2424.2 +052900 ELSE NC2424.2 +053000 MOVE ENTRY-7-4 (N1 1 N3 1) TO COMPUTED-A NC2424.2 +053100 MOVE L4-HOLD TO CORRECT-A NC2424.2 +053200 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +053300 PERFORM FAIL NC2424.2 +053400 PERFORM PRINT-DETAIL. NC2424.2 +053500 ADD 1 TO REC-CT. NC2424.2 +053600 TH7-TEST-2. NC2424.2 +053700 MOVE "TH7-TEST-2" TO PAR-NAME. NC2424.2 +053800 IF ENTRY-7-5 (N1 1 N3 1 N5) = L5-HOLD NC2424.2 +053900 PERFORM PASS NC2424.2 +054000 PERFORM PRINT-DETAIL NC2424.2 +054100 ELSE NC2424.2 +054200 MOVE ENTRY-7-5 (N1 1 N3 1 N5) TO COMPUTED-A NC2424.2 +054300 MOVE L5-HOLD TO CORRECT-A NC2424.2 +054400 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +054500 PERFORM FAIL NC2424.2 +054600 PERFORM PRINT-DETAIL. NC2424.2 +054700 ADD 1 TO REC-CT. NC2424.2 +054800 TH7-TEST-3. NC2424.2 +054900 MOVE "TH7-TEST-3" TO PAR-NAME. NC2424.2 +055000 IF ENTRY-7-6 (N1 1 N3 1 N5 1) = L6-HOLD NC2424.2 +055100 PERFORM PASS NC2424.2 +055200 PERFORM PRINT-DETAIL NC2424.2 +055300 ELSE NC2424.2 +055400 MOVE ENTRY-7-6 (N1 1 N3 1 N5 1) TO COMPUTED-A NC2424.2 +055500 MOVE L6-HOLD TO CORRECT-A NC2424.2 +055600 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +055700 PERFORM FAIL NC2424.2 +055800 PERFORM PRINT-DETAIL. NC2424.2 +055900 ADD 1 TO REC-CT. NC2424.2 +056000 TH7-TEST-4. NC2424.2 +056100 MOVE "TH7-TEST-4" TO PAR-NAME. NC2424.2 +056200 IF ENTRY-7-7 (N1 1 N3 1 N5 1 N7) = L7-HOLD NC2424.2 +056300 PERFORM PASS NC2424.2 +056400 PERFORM PRINT-DETAIL NC2424.2 +056500 ELSE NC2424.2 +056600 MOVE ENTRY-7-7 (N1 1 N3 1 N5 1 N7) TO COMPUTED-A NC2424.2 +056700 MOVE L7-HOLD TO CORRECT-A NC2424.2 +056800 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +056900 PERFORM FAIL NC2424.2 +057000 PERFORM PRINT-DETAIL. NC2424.2 +057100 NC2424.2 +057200* NC2424.2 +057300 CCVS-EXIT SECTION. NC2424.2 +057400 CCVS-999999. NC2424.2 +057500 GO TO CLOSE-FILES. NC2424.2 +*END-OF,NC242A +*HEADER,COBOL,NC243A +000100 IDENTIFICATION DIVISION. NC2434.2 +000200 PROGRAM-ID. NC2434.2 +000300 NC243A. NC2434.2 +000400 NC2434.2 +000500**************************************************************** NC2434.2 +000600* * NC2434.2 +000700* VALIDATION FOR:- * NC2434.2 +000800* * NC2434.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +001000* * NC2434.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2434.2 +001200* * NC2434.2 +001300**************************************************************** NC2434.2 +001400* * NC2434.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2434.2 +001600* * NC2434.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2434.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2434.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2434.2 +002000* * NC2434.2 +002100**************************************************************** NC2434.2 +002200* * NC2434.2 +002300* PROGRAM NC243A TESTS THE CONSTRUCTION AND ACCES OF A * NC2434.2 +002400* SEVEN-DIMENSIONAL TABLE. THE CONSTRUCTION IS VIA * NC2434.2 +002500* SUBSCRIPTED LOOPS AND ACCESS IS BY FORMAT 4 "PERFORM" * NC2434.2 +002600* STATEMENTS USING INDICES. * NC2434.2 +002700* * NC2434.2 +002800**************************************************************** NC2434.2 +002900 ENVIRONMENT DIVISION. NC2434.2 +003000 CONFIGURATION SECTION. NC2434.2 +003100 SOURCE-COMPUTER. NC2434.2 +003200 XXXXX082. NC2434.2 +003300 OBJECT-COMPUTER. NC2434.2 +003400 XXXXX083. NC2434.2 +003500 INPUT-OUTPUT SECTION. NC2434.2 +003600 FILE-CONTROL. NC2434.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2434.2 +003800 XXXXX055. NC2434.2 +003900 DATA DIVISION. NC2434.2 +004000 FILE SECTION. NC2434.2 +004100 FD PRINT-FILE. NC2434.2 +004200 01 PRINT-REC PICTURE X(120). NC2434.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2434.2 +004400 WORKING-STORAGE SECTION. NC2434.2 +004500 77 SUB-1 PICTURE S99 VALUE ZERO. NC2434.2 +004600 77 SUB-2 PICTURE 99 VALUE ZERO. NC2434.2 +004700 77 SUB-3 PICTURE 99 VALUE ZERO. NC2434.2 +004800 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2434.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2434.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2434.2 +005100 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2434.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2434.2 +005300 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2434.2 +005400 77 CON-6 PICTURE 99 VALUE 06. NC2434.2 +005500 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2434.2 +005600 77 N1 PIC 9. NC2434.2 +005700 77 N2 PIC 9. NC2434.2 +005800 77 N3 PIC 9. NC2434.2 +005900 77 N4 PIC 9. NC2434.2 +006000 77 N5 PIC 9. NC2434.2 +006100 77 N6 PIC 9. NC2434.2 +006200 77 N7 PIC 9. NC2434.2 +006300 01 GRP-NAME. NC2434.2 +006400 02 FILLER PICTURE XXX VALUE "GRP". NC2434.2 +006500 02 ADD-GRP PICTURE 99 VALUE 01. NC2434.2 +006600 NC2434.2 +006700 01 SEC-NAME. NC2434.2 +006800 02 FILLER PICTURE X(5) VALUE "SEC (". NC2434.2 +006900 02 SEC-GRP PICTURE 99 VALUE 00. NC2434.2 +007000 02 FILLER PICTURE X VALUE ",". NC2434.2 +007100 02 ADD-SEC PICTURE 99 VALUE 01. NC2434.2 +007200 02 FILLER PICTURE X VALUE ")". NC2434.2 +007300 NC2434.2 +007400 01 ELEM-NAME. NC2434.2 +007500 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2434.2 +007600 02 ELEM-GRP PICTURE 99 VALUE 00. NC2434.2 +007700 02 FILLER PICTURE X VALUE ",". NC2434.2 +007800 02 ELEM-SEC PICTURE 99 VALUE 00. NC2434.2 +007900 02 FILLER PICTURE X VALUE ",". NC2434.2 +008000 02 ADD-ELEM PICTURE 99 VALUE 01. NC2434.2 +008100 02 FILLER PICTURE X VALUE ")". NC2434.2 +008200 NC2434.2 +008300 01 3-DIMENSION-TBL. NC2434.2 +008400 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2434.2 +008500 03 ENTRY-1 PICTURE X(5). NC2434.2 +008600 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2434.2 +008700 04 ENTRY-2 PICTURE X(11). NC2434.2 +008800 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2434.2 +008900 05 ENTRY-3 PICTURE X(15). NC2434.2 +009000 NC2434.2 +009100 01 7-DIMENSION-TBL. NC2434.2 +009200 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY X1. NC2434.2 +009300 03 ENTRY-7-1 PIC XX. NC2434.2 +009400 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY X2. NC2434.2 +009500 04 ENTRY-7-2 PIC XX. NC2434.2 +009600 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY X3. NC2434.2 +009700 05 ENTRY-7-3 PIC XX. NC2434.2 +009800 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY X4. NC2434.2 +009900 06 ENTRY-7-4 PIC XX. NC2434.2 +010000 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY X5. NC2434.2 +010100 07 ENTRY-7-5 PIC XX. NC2434.2 +010200 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY X6. NC2434.2 +010300 08 ENTRY-7-6 PIC XX. NC2434.2 +010400 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY X7. NC2434.2 +010500 09 ENTRY-7-7 PIC XX. NC2434.2 +010600 NC2434.2 +010700 01 WS-FLAG PIC X(5). NC2434.2 +010800 01 TEST-RESULTS. NC2434.2 +010900 02 FILLER PIC X VALUE SPACE. NC2434.2 +011000 02 FEATURE PIC X(20) VALUE SPACE. NC2434.2 +011100 02 FILLER PIC X VALUE SPACE. NC2434.2 +011200 02 P-OR-F PIC X(5) VALUE SPACE. NC2434.2 +011300 02 FILLER PIC X VALUE SPACE. NC2434.2 +011400 02 PAR-NAME. NC2434.2 +011500 03 FILLER PIC X(19) VALUE SPACE. NC2434.2 +011600 03 PARDOT-X PIC X VALUE SPACE. NC2434.2 +011700 03 DOTVALUE PIC 99 VALUE ZERO. NC2434.2 +011800 02 FILLER PIC X(8) VALUE SPACE. NC2434.2 +011900 02 RE-MARK PIC X(61). NC2434.2 +012000 01 TEST-COMPUTED. NC2434.2 +012100 02 FILLER PIC X(30) VALUE SPACE. NC2434.2 +012200 02 FILLER PIC X(17) VALUE NC2434.2 +012300 " COMPUTED=". NC2434.2 +012400 02 COMPUTED-X. NC2434.2 +012500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2434.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A NC2434.2 +012700 PIC -9(9).9(9). NC2434.2 +012800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2434.2 +012900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2434.2 +013000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2434.2 +013100 03 CM-18V0 REDEFINES COMPUTED-A. NC2434.2 +013200 04 COMPUTED-18V0 PIC -9(18). NC2434.2 +013300 04 FILLER PIC X. NC2434.2 +013400 03 FILLER PIC X(50) VALUE SPACE. NC2434.2 +013500 01 TEST-CORRECT. NC2434.2 +013600 02 FILLER PIC X(30) VALUE SPACE. NC2434.2 +013700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2434.2 +013800 02 CORRECT-X. NC2434.2 +013900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2434.2 +014000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2434.2 +014100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2434.2 +014200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2434.2 +014300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2434.2 +014400 03 CR-18V0 REDEFINES CORRECT-A. NC2434.2 +014500 04 CORRECT-18V0 PIC -9(18). NC2434.2 +014600 04 FILLER PIC X. NC2434.2 +014700 03 FILLER PIC X(2) VALUE SPACE. NC2434.2 +014800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2434.2 +014900 01 CCVS-C-1. NC2434.2 +015000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2434.2 +015100- "SS PARAGRAPH-NAME NC2434.2 +015200- " REMARKS". NC2434.2 +015300 02 FILLER PIC X(20) VALUE SPACE. NC2434.2 +015400 01 CCVS-C-2. NC2434.2 +015500 02 FILLER PIC X VALUE SPACE. NC2434.2 +015600 02 FILLER PIC X(6) VALUE "TESTED". NC2434.2 +015700 02 FILLER PIC X(15) VALUE SPACE. NC2434.2 +015800 02 FILLER PIC X(4) VALUE "FAIL". NC2434.2 +015900 02 FILLER PIC X(94) VALUE SPACE. NC2434.2 +016000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2434.2 +016100 01 REC-CT PIC 99 VALUE ZERO. NC2434.2 +016200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2434.2 +016700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2434.2 +016800 01 L4-HOLD PIC XX VALUE SPACE. NC2434.2 +016900 01 L5-HOLD PIC XX VALUE SPACE. NC2434.2 +017000 01 L6-HOLD PIC XX VALUE SPACE. NC2434.2 +017100 01 L7-HOLD PIC XX VALUE SPACE. NC2434.2 +017200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2434.2 +017300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2434.2 +017400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2434.2 +017500 01 CCVS-H-1. NC2434.2 +017600 02 FILLER PIC X(39) VALUE SPACES. NC2434.2 +017700 02 FILLER PIC X(42) VALUE NC2434.2 +017800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2434.2 +017900 02 FILLER PIC X(39) VALUE SPACES. NC2434.2 +018000 01 CCVS-H-2A. NC2434.2 +018100 02 FILLER PIC X(40) VALUE SPACE. NC2434.2 +018200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2434.2 +018300 02 FILLER PIC XXXX VALUE NC2434.2 +018400 "4.2 ". NC2434.2 +018500 02 FILLER PIC X(28) VALUE NC2434.2 +018600 " COPY - NOT FOR DISTRIBUTION". NC2434.2 +018700 02 FILLER PIC X(41) VALUE SPACE. NC2434.2 +018800 NC2434.2 +018900 01 CCVS-H-2B. NC2434.2 +019000 02 FILLER PIC X(15) VALUE NC2434.2 +019100 "TEST RESULT OF ". NC2434.2 +019200 02 TEST-ID PIC X(9). NC2434.2 +019300 02 FILLER PIC X(4) VALUE NC2434.2 +019400 " IN ". NC2434.2 +019500 02 FILLER PIC X(12) VALUE NC2434.2 +019600 " HIGH ". NC2434.2 +019700 02 FILLER PIC X(22) VALUE NC2434.2 +019800 " LEVEL VALIDATION FOR ". NC2434.2 +019900 02 FILLER PIC X(58) VALUE NC2434.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +020100 01 CCVS-H-3. NC2434.2 +020200 02 FILLER PIC X(34) VALUE NC2434.2 +020300 " FOR OFFICIAL USE ONLY ". NC2434.2 +020400 02 FILLER PIC X(58) VALUE NC2434.2 +020500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2434.2 +020600 02 FILLER PIC X(28) VALUE NC2434.2 +020700 " COPYRIGHT 1985 ". NC2434.2 +020800 01 CCVS-E-1. NC2434.2 +020900 02 FILLER PIC X(52) VALUE SPACE. NC2434.2 +021000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2434.2 +021100 02 ID-AGAIN PIC X(9). NC2434.2 +021200 02 FILLER PIC X(45) VALUE SPACES. NC2434.2 +021300 01 CCVS-E-2. NC2434.2 +021400 02 FILLER PIC X(31) VALUE SPACE. NC2434.2 +021500 02 FILLER PIC X(21) VALUE SPACE. NC2434.2 +021600 02 CCVS-E-2-2. NC2434.2 +021700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2434.2 +021800 03 FILLER PIC X VALUE SPACE. NC2434.2 +021900 03 ENDER-DESC PIC X(44) VALUE NC2434.2 +022000 "ERRORS ENCOUNTERED". NC2434.2 +022100 01 CCVS-E-3. NC2434.2 +022200 02 FILLER PIC X(22) VALUE NC2434.2 +022300 " FOR OFFICIAL USE ONLY". NC2434.2 +022400 02 FILLER PIC X(12) VALUE SPACE. NC2434.2 +022500 02 FILLER PIC X(58) VALUE NC2434.2 +022600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +022700 02 FILLER PIC X(13) VALUE SPACE. NC2434.2 +022800 02 FILLER PIC X(15) VALUE NC2434.2 +022900 " COPYRIGHT 1985". NC2434.2 +023000 01 CCVS-E-4. NC2434.2 +023100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2434.2 +023200 02 FILLER PIC X(4) VALUE " OF ". NC2434.2 +023300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2434.2 +023400 02 FILLER PIC X(40) VALUE NC2434.2 +023500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2434.2 +023600 01 XXINFO. NC2434.2 +023700 02 FILLER PIC X(19) VALUE NC2434.2 +023800 "*** INFORMATION ***". NC2434.2 +023900 02 INFO-TEXT. NC2434.2 +024000 04 FILLER PIC X(8) VALUE SPACE. NC2434.2 +024100 04 XXCOMPUTED PIC X(20). NC2434.2 +024200 04 FILLER PIC X(5) VALUE SPACE. NC2434.2 +024300 04 XXCORRECT PIC X(20). NC2434.2 +024400 02 INF-ANSI-REFERENCE PIC X(48). NC2434.2 +024500 01 HYPHEN-LINE. NC2434.2 +024600 02 FILLER PIC IS X VALUE IS SPACE. NC2434.2 +024700 02 FILLER PIC IS X(65) VALUE IS "************************NC2434.2 +024800- "*****************************************". NC2434.2 +024900 02 FILLER PIC IS X(54) VALUE IS "************************NC2434.2 +025000- "******************************". NC2434.2 +025100 01 CCVS-PGM-ID PIC X(9) VALUE NC2434.2 +025200 "NC243A". NC2434.2 +025300 PROCEDURE DIVISION. NC2434.2 +025400 CCVS1 SECTION. NC2434.2 +025500 OPEN-FILES. NC2434.2 +025600 OPEN OUTPUT PRINT-FILE. NC2434.2 +025700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2434.2 +025800 MOVE SPACE TO TEST-RESULTS. NC2434.2 +025900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2434.2 +026000 GO TO CCVS1-EXIT. NC2434.2 +026100 CLOSE-FILES. NC2434.2 +026200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2434.2 +026300 TERMINATE-CCVS. NC2434.2 +026400S EXIT PROGRAM. NC2434.2 +026500STERMINATE-CALL. NC2434.2 +026600 STOP RUN. NC2434.2 +026700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2434.2 +026800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2434.2 +026900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2434.2 +027000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2434.2 +027100 MOVE "****TEST DELETED****" TO RE-MARK. NC2434.2 +027200 PRINT-DETAIL. NC2434.2 +027300 IF REC-CT NOT EQUAL TO ZERO NC2434.2 +027400 MOVE "." TO PARDOT-X NC2434.2 +027500 MOVE REC-CT TO DOTVALUE. NC2434.2 +027600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2434.2 +027700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2434.2 +027800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2434.2 +027900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2434.2 +028000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2434.2 +028100 MOVE SPACE TO CORRECT-X. NC2434.2 +028200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2434.2 +028300 MOVE SPACE TO RE-MARK. NC2434.2 +028400 HEAD-ROUTINE. NC2434.2 +028500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +028600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +028700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2434.2 +028800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2434.2 +028900 COLUMN-NAMES-ROUTINE. NC2434.2 +029000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +029100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +029300 END-ROUTINE. NC2434.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2434.2 +029500 END-RTN-EXIT. NC2434.2 +029600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +029700 END-ROUTINE-1. NC2434.2 +029800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2434.2 +029900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2434.2 +030000 ADD PASS-COUNTER TO ERROR-HOLD. NC2434.2 +030100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2434.2 +030200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2434.2 +030300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2434.2 +030400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2434.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2434.2 +030600 END-ROUTINE-12. NC2434.2 +030700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2434.2 +030800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2434.2 +030900 MOVE "NO " TO ERROR-TOTAL NC2434.2 +031000 ELSE NC2434.2 +031100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2434.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2434.2 +031300 PERFORM WRITE-LINE. NC2434.2 +031400 END-ROUTINE-13. NC2434.2 +031500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2434.2 +031600 MOVE "NO " TO ERROR-TOTAL ELSE NC2434.2 +031700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2434.2 +031800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2434.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032000 IF INSPECT-COUNTER EQUAL TO ZERO NC2434.2 +032100 MOVE "NO " TO ERROR-TOTAL NC2434.2 +032200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2434.2 +032300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2434.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032600 WRITE-LINE. NC2434.2 +032700 ADD 1 TO RECORD-COUNT. NC2434.2 +032800Y IF RECORD-COUNT GREATER 50 NC2434.2 +032900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2434.2 +033000Y MOVE SPACE TO DUMMY-RECORD NC2434.2 +033100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2434.2 +033200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2434.2 +033300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2434.2 +033400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2434.2 +033500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2434.2 +033600Y MOVE ZERO TO RECORD-COUNT. NC2434.2 +033700 PERFORM WRT-LN. NC2434.2 +033800 WRT-LN. NC2434.2 +033900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2434.2 +034000 MOVE SPACE TO DUMMY-RECORD. NC2434.2 +034100 BLANK-LINE-PRINT. NC2434.2 +034200 PERFORM WRT-LN. NC2434.2 +034300 FAIL-ROUTINE. NC2434.2 +034400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2434.2 +034500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2434.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2434.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2434.2 +034800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +034900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2434.2 +035000 GO TO FAIL-ROUTINE-EX. NC2434.2 +035100 FAIL-ROUTINE-WRITE. NC2434.2 +035200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2434.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2434.2 +035400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2434.2 +035500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2434.2 +035600 FAIL-ROUTINE-EX. EXIT. NC2434.2 +035700 BAIL-OUT. NC2434.2 +035800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2434.2 +035900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2434.2 +036000 BAIL-OUT-WRITE. NC2434.2 +036100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2434.2 +036200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2434.2 +036300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +036400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2434.2 +036500 BAIL-OUT-EX. EXIT. NC2434.2 +036600 CCVS1-EXIT. NC2434.2 +036700 EXIT. NC2434.2 +036800 SECT-NC243A-001 SECTION. NC2434.2 +036900 TH-17-001. NC2434.2 +037000 NC2434.2 +037100 BUILD-LEVEL-1. NC2434.2 +037200 ADD 1 TO SUB-1. NC2434.2 +037300 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2434.2 +037400 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2434.2 +037500 ADD 1 TO ADD-GRP. NC2434.2 +037600 NC2434.2 +037700 BUILD-LEVEL-2. NC2434.2 +037800 ADD 1 TO SUB-2. NC2434.2 +037900 IF SUB-2 = 11 NC2434.2 +038000 MOVE ZERO TO SUB-2 NC2434.2 +038100 MOVE 01 TO ADD-SEC NC2434.2 +038200 GO TO BUILD-LEVEL-1. NC2434.2 +038300 MOVE SUB-1 TO SEC-GRP. NC2434.2 +038400 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2434.2 +038500 ADD 1 TO ADD-SEC. NC2434.2 +038600 NC2434.2 +038700 BUILD-LEVEL-3. NC2434.2 +038800 ADD 1 TO SUB-3. NC2434.2 +038900 IF SUB-3 = 11 NC2434.2 +039000 MOVE ZERO TO SUB-3 NC2434.2 +039100 MOVE 01 TO ADD-ELEM NC2434.2 +039200 GO TO BUILD-LEVEL-2. NC2434.2 +039300 MOVE SUB-1 TO ELEM-GRP. NC2434.2 +039400 MOVE SUB-2 TO ELEM-SEC. NC2434.2 +039500 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2434.2 +039600 ADD 1 TO ADD-ELEM. NC2434.2 +039700 GO TO BUILD-LEVEL-3. NC2434.2 +039800 NC2434.2 +039900 CHECK-ENTRIES. NC2434.2 +040000 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2434.2 +040100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2434.2 +040200 MOVE SPACES TO TEST-CHECK. NC2434.2 +040300 MOVE "GRP05" TO GRP-HOLD-AREA. NC2434.2 +040400 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +040500 UNTIL IDX-1 GREATER 10. NC2434.2 +040600 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-2. NC2434.2 +040700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +040800 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2434.2 +040900 NC2434.2 +041000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +041100 PERFORM FAIL-TH. NC2434.2 +041200 NC2434.2 +041300 LEVEL-1-TEST-2. NC2434.2 +041400 MOVE "GRP10" TO GRP-HOLD-AREA. NC2434.2 +041500 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2434.2 +041600 MOVE SPACES TO TEST-CHECK. NC2434.2 +041700 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +041800 UNTIL IDX-1 GREATER 10. NC2434.2 +041900 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-3. NC2434.2 +042000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +042100 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2434.2 +042200 NC2434.2 +042300 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +042400 PERFORM FAIL-TH. NC2434.2 +042500 NC2434.2 +042600 LEVEL-1-TEST-3. NC2434.2 +042700 MOVE "GRP07" TO GRP-HOLD-AREA. NC2434.2 +042800 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2434.2 +042900 MOVE SPACES TO TEST-CHECK. NC2434.2 +043000 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +043100 UNTIL IDX-1 GREATER 10. NC2434.2 +043200 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-4. NC2434.2 +043300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +043400 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2434.2 +043500 NC2434.2 +043600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +043700 PERFORM FAIL-TH. NC2434.2 +043800 LEVEL-1-TEST-4. NC2434.2 +043900 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2434.2 +044000 MOVE "GRP01" TO GRP-HOLD-AREA. NC2434.2 +044100 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +044200 UNTIL IDX-1 GREATER 10. NC2434.2 +044300 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-1. NC2434.2 +044400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +044500 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2434.2 +044600 NC2434.2 +044700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +044800 PERFORM FAIL-TH. NC2434.2 +044900 GO TO LEVEL-2-TEST-1. NC2434.2 +045000 NC2434.2 +045100 FIND-LEVEL-1-ENTRY. NC2434.2 +045200 IF ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2434.2 +045300 MOVE "PASS" TO TEST-CHECK NC2434.2 +045400 PERFORM PASS-TH. NC2434.2 +045500 NC2434.2 +045600 LEVEL-2-TEST-1. NC2434.2 +045700 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2434.2 +045800 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2434.2 +045900 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2434.2 +046000 MOVE SPACES TO TEST-CHECK. NC2434.2 +046100 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +046200 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +046300 IDX-2 = 10. NC2434.2 +046400 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-2. NC2434.2 +046500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +046600 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2434.2 +046700 NC2434.2 +046800 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +046900 PERFORM FAIL-TH. NC2434.2 +047000 NC2434.2 +047100 LEVEL-2-TEST-2. NC2434.2 +047200 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2434.2 +047300 MOVE SPACES TO TEST-CHECK. NC2434.2 +047400 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2434.2 +047500 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +047600 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 NC2434.2 +047700 UNTIL IDX-2 = 10. NC2434.2 +047800 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-3. NC2434.2 +047900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +048000 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2434.2 +048100 NC2434.2 +048200 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +048300 PERFORM FAIL-TH. NC2434.2 +048400 NC2434.2 +048500 LEVEL-2-TEST-3. NC2434.2 +048600 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2434.2 +048700 MOVE SPACES TO TEST-CHECK. NC2434.2 +048800 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2434.2 +048900 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +049000 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 NC2434.2 +049100 UNTIL IDX-2 = 10. NC2434.2 +049200 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-4. NC2434.2 +049300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +049400 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2434.2 +049500 NC2434.2 +049600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +049700 PERFORM FAIL-TH. NC2434.2 +049800 LEVEL-2-TEST-4. NC2434.2 +049900 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2434.2 +050000 MOVE SPACES TO TEST-CHECK. NC2434.2 +050100 MOVE SPACES TO TEST-CHECK. NC2434.2 +050200 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2434.2 +050300 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 2 BY 2 NC2434.2 +050400 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 2 BY 2 NC2434.2 +050500 UNTIL IDX-2 GREATER 10. NC2434.2 +050600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-1. NC2434.2 +050700 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +050800 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2434.2 +050900 NC2434.2 +051000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +051100 PERFORM FAIL-TH. NC2434.2 +051200 GO TO LEVEL-3-TEST-1. NC2434.2 +051300 FIND-LEVEL-2-ENTRY. NC2434.2 +051400 IF ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2434.2 +051500 MOVE "PASS" TO TEST-CHECK NC2434.2 +051600 PERFORM PASS-TH. NC2434.2 +051700 LEVEL-3-TEST-1. NC2434.2 +051800 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2434.2 +051900 MOVE SPACES TO TEST-CHECK. NC2434.2 +052000 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2434.2 +052100 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2434.2 +052200 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +052300 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +052400 IDX-2 = 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +052500 IDX-3 = 10. NC2434.2 +052600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-2. NC2434.2 +052700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +052800 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2434.2 +052900 NC2434.2 +053000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +053100 PERFORM FAIL-TH. NC2434.2 +053200 NC2434.2 +053300 LEVEL-3-TEST-2. NC2434.2 +053400 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2434.2 +053500 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2434.2 +053600 MOVE SPACES TO TEST-CHECK. NC2434.2 +053700 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +053800 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +053900 IDX-2 GREATER 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +054000 IDX-3 GREATER 10. NC2434.2 +054100 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-3. NC2434.2 +054200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +054300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2434.2 +054400 NC2434.2 +054500 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +054600 PERFORM FAIL-TH. NC2434.2 +054700 NC2434.2 +054800 LEVEL-3-TEST-3. NC2434.2 +054900 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2434.2 +055000 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2434.2 +055100 MOVE SPACES TO TEST-CHECK. NC2434.2 +055200 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +055300 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +055400 IDX-2 = 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +055500 IDX-3 = 10. NC2434.2 +055600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-4. NC2434.2 +055700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +055800 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2434.2 +055900 NC2434.2 +056000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +056100 PERFORM FAIL-TH. NC2434.2 +056200 LEVEL-3-TEST-4. NC2434.2 +056300 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2434.2 +056400 MOVE SPACES TO TEST-CHECK. NC2434.2 +056500 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2434.2 +056600 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 3 BY 3 NC2434.2 +056700 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 2 BY 2 UNTIL NC2434.2 +056800 IDX-2 GREATER 10 AFTER IDX-3 FROM 8 BY 8 UNTIL NC2434.2 +056900 IDX-3 GREATER 10. NC2434.2 +057000 IF TEST-CHECK = "PASS" GO TO END-3LEVEL-TEST. NC2434.2 +057100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +057200 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2434.2 +057300 NC2434.2 +057400 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +057500 PERFORM FAIL-TH. NC2434.2 +057600 GO TO END-3LEVEL-TEST. NC2434.2 +057700 NC2434.2 +057800 FIND-LEVEL-3-ENTRY. NC2434.2 +057900 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2434.2 +058000 MOVE "PASS" TO TEST-CHECK NC2434.2 +058100 PERFORM PASS-TH. NC2434.2 +058200 NC2434.2 +058300 PASS-TH. NC2434.2 +058400 PERFORM PASS. NC2434.2 +058500 PERFORM PRINT-DETAIL. NC2434.2 +058600 FAIL-TH. NC2434.2 +058700 PERFORM FAIL. NC2434.2 +058800 PERFORM PRINT-DETAIL. NC2434.2 +058900 END-3LEVEL-TEST. NC2434.2 +059000 EXIT. NC2434.2 +059100* NC2434.2 +059200 TH7-INIT-1. NC2434.2 +059300 MOVE "TH7-TEST" TO PAR-NAME. NC2434.2 +059400 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2434.2 +059500 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2434.2 +059600 MOVE "KL" TO L4-HOLD. NC2434.2 +059700 MOVE "AB" TO L5-HOLD. NC2434.2 +059800 MOVE "CD" TO L6-HOLD. NC2434.2 +059900 MOVE "GH" TO L7-HOLD. NC2434.2 +060000 MOVE SPACES TO WS-FLAG. NC2434.2 +060100 MOVE 1 TO REC-CT. NC2434.2 +060200 GO TO TH7-TEST-1-0. NC2434.2 +060300 TH7-DELETE-1. NC2434.2 +060400 PERFORM DE-LETE. NC2434.2 +060500 PERFORM PRINT-DETAIL. NC2434.2 +060600 GO TO CCVS-EXIT. NC2434.2 +060700 TH7-TEST-1-0. NC2434.2 +060800 PERFORM TH7-FIND-LEVEL-4-ENTRY NC2434.2 +060900 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +061000 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +061100 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +061200 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2. NC2434.2 +061300 GO TO TH7-TEST-1-1. NC2434.2 +061400 TH7-FIND-LEVEL-4-ENTRY. NC2434.2 +061500 IF ENTRY-7-4 (X1 X2 X3 X4) = L4-HOLD NC2434.2 +061600 MOVE "FOUND" TO WS-FLAG. NC2434.2 +061700 TH7-TEST-1-1. NC2434.2 +061800 IF WS-FLAG = "FOUND" NC2434.2 +061900 PERFORM PASS NC2434.2 +062000 PERFORM PRINT-DETAIL NC2434.2 +062100 ELSE NC2434.2 +062200 MOVE "TABLE NOT CORRECT AT 4TH LEVEL" TO RE-MARK NC2434.2 +062300 MOVE ENTRY-7-4 (X1 X2 X3 X4) TO COMPUTED-X NC2434.2 +062400 MOVE L4-HOLD TO CORRECT-X NC2434.2 +062500 PERFORM FAIL NC2434.2 +062600 PERFORM PRINT-DETAIL. NC2434.2 +062700 MOVE SPACES TO WS-FLAG. NC2434.2 +062800 ADD 1 TO REC-CT. NC2434.2 +062900 TH7-TEST-2-0. NC2434.2 +063000 PERFORM TH7-FIND-LEVEL-5-ENTRY NC2434.2 +063100 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +063200 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +063300 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +063400 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +063500 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2. NC2434.2 +063600 GO TO TH7-TEST-2-1. NC2434.2 +063700 TH7-FIND-LEVEL-5-ENTRY. NC2434.2 +063800 IF ENTRY-7-5 (X1 X2 X3 X4 X5) = L5-HOLD NC2434.2 +063900 MOVE "FOUND" TO WS-FLAG. NC2434.2 +064000 TH7-TEST-2-1. NC2434.2 +064100 IF WS-FLAG = "FOUND" NC2434.2 +064200 PERFORM PASS NC2434.2 +064300 PERFORM PRINT-DETAIL NC2434.2 +064400 ELSE NC2434.2 +064500 MOVE "TABLE NOT CORRECT AT 5TH LEVEL" TO RE-MARK NC2434.2 +064600 MOVE ENTRY-7-5 (X1 X2 X3 X4 X5) TO COMPUTED-X NC2434.2 +064700 MOVE L5-HOLD TO CORRECT-X NC2434.2 +064800 PERFORM FAIL NC2434.2 +064900 PERFORM PRINT-DETAIL. NC2434.2 +065000 MOVE SPACES TO WS-FLAG. NC2434.2 +065100 ADD 1 TO REC-CT. NC2434.2 +065200 TH7-TEST-3-0. NC2434.2 +065300 PERFORM TH7-FIND-LEVEL-6-ENTRY NC2434.2 +065400 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +065500 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +065600 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +065700 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +065800 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2 NC2434.2 +065900 AFTER X6 FROM 1 BY 1 UNTIL X6 > 2. NC2434.2 +066000 GO TO TH7-TEST-3-1. NC2434.2 +066100 TH7-FIND-LEVEL-6-ENTRY. NC2434.2 +066200 IF ENTRY-7-6 (X1 X2 X3 X4 X5 X6) = L6-HOLD NC2434.2 +066300 MOVE "FOUND" TO WS-FLAG. NC2434.2 +066400 TH7-TEST-3-1. NC2434.2 +066500 IF WS-FLAG = "FOUND" NC2434.2 +066600 PERFORM PASS NC2434.2 +066700 PERFORM PRINT-DETAIL NC2434.2 +066800 ELSE NC2434.2 +066900 MOVE "TABLE NOT CORRECT AT 6TH LEVEL" TO RE-MARK NC2434.2 +067000 MOVE ENTRY-7-6 (X1 X2 X3 X4 X5 X6) TO COMPUTED-X NC2434.2 +067100 MOVE L6-HOLD TO CORRECT-X NC2434.2 +067200 PERFORM FAIL NC2434.2 +067300 PERFORM PRINT-DETAIL. NC2434.2 +067400 MOVE SPACES TO WS-FLAG. NC2434.2 +067500 ADD 1 TO REC-CT. NC2434.2 +067600 TH7-TEST-4-0. NC2434.2 +067700 PERFORM TH7-FIND-LEVEL-7-ENTRY NC2434.2 +067800 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +067900 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +068000 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +068100 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +068200 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2 NC2434.2 +068300 AFTER X6 FROM 1 BY 1 UNTIL X6 > 2 NC2434.2 +068400 AFTER X7 FROM 1 BY 1 UNTIL X7 > 2. NC2434.2 +068500 GO TO TH7-TEST-4-1. NC2434.2 +068600 TH7-FIND-LEVEL-7-ENTRY. NC2434.2 +068700 IF ENTRY-7-7 (X1 X2 X3 X4 X5 X6 X7) = L7-HOLD NC2434.2 +068800 MOVE "FOUND" TO WS-FLAG. NC2434.2 +068900 TH7-TEST-4-1. NC2434.2 +069000 IF WS-FLAG = "FOUND" NC2434.2 +069100 PERFORM PASS NC2434.2 +069200 PERFORM PRINT-DETAIL NC2434.2 +069300 ELSE NC2434.2 +069400 MOVE "TABLE NOT CORRECT AT 6TH LEVEL" TO RE-MARK NC2434.2 +069500 MOVE ENTRY-7-7 (X1 X2 X3 X4 X5 X6 X7) TO COMPUTED-X NC2434.2 +069600 MOVE L7-HOLD TO CORRECT-X NC2434.2 +069700 PERFORM FAIL NC2434.2 +069800 PERFORM PRINT-DETAIL. NC2434.2 +069900* NC2434.2 +070000 CCVS-EXIT SECTION. NC2434.2 +070100 CCVS-999999. NC2434.2 +070200 GO TO CLOSE-FILES. NC2434.2 +*END-OF,NC243A +*HEADER,COBOL,NC244A +000100 IDENTIFICATION DIVISION. NC2444.2 +000200 PROGRAM-ID. NC2444.2 +000300 NC244A. NC2444.2 +000400**************************************************************** NC2444.2 +000500* * NC2444.2 +000600* VALIDATION FOR:- * NC2444.2 +000700* * NC2444.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +000900* * NC2444.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2444.2 +001100* * NC2444.2 +001200**************************************************************** NC2444.2 +001300* * NC2444.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2444.2 +001500* * NC2444.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2444.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2444.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2444.2 +001900* * NC2444.2 +002000**************************************************************** NC2444.2 +002100* * NC2444.2 +002200* PROGRAM NCC244A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2444.2 +002300* TWO-DIMENSIONAL TABLE WHICH HAS MULTIPLE INDICES. * NC2444.2 +002400* RELATIVE INDEXING AND FORMATS 1 AND 2 OF THE "SET" * NC2444.2 +002500* STATEMENT ARE USED. * NC2444.2 +002600* * NC2444.2 +002700**************************************************************** NC2444.2 +002800 ENVIRONMENT DIVISION. NC2444.2 +002900 CONFIGURATION SECTION. NC2444.2 +003000 SOURCE-COMPUTER. NC2444.2 +003100 XXXXX082. NC2444.2 +003200 OBJECT-COMPUTER. NC2444.2 +003300 XXXXX083. NC2444.2 +003400 INPUT-OUTPUT SECTION. NC2444.2 +003500 FILE-CONTROL. NC2444.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2444.2 +003700 XXXXX055. NC2444.2 +003800 DATA DIVISION. NC2444.2 +003900 FILE SECTION. NC2444.2 +004000 FD PRINT-FILE. NC2444.2 +004100 01 PRINT-REC PICTURE X(120). NC2444.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2444.2 +004300 WORKING-STORAGE SECTION. NC2444.2 +004400 77 SUB-COMP1 PICTURE S9 VALUE 3 COMPUTATIONAL. NC2444.2 +004500 77 SUB-COMP2 PICTURE S9(10) VALUE 1 COMPUTATIONAL. NC2444.2 +004600 77 SUB-COMP3 PICTURE S9(18) VALUE 49 COMPUTATIONAL. NC2444.2 +004700 77 SUB-COMP4 PICTURE 9 VALUE 3 COMPUTATIONAL. NC2444.2 +004800 77 SUB-COMP5 PICTURE 9(10) VALUE 1 COMPUTATIONAL. NC2444.2 +004900 77 SUB-COMP6 PICTURE 9(18) VALUE 9 COMPUTATIONAL. NC2444.2 +005000 77 SUB-7 PICTURE 99 VALUE 20. NC2444.2 +005100 77 SUB-8 PICTURE 99 VALUE 01. NC2444.2 +005200 77 SUB-9 PICTURE 99 VALUE 10. NC2444.2 +005300 77 IN-SERT PICTURE AA VALUE "AA". NC2444.2 +005400 77 ENTRY-HOLD PICTURE XX VALUE SPACES. NC2444.2 +005500 01 IDX-HOLD. NC2444.2 +005600 02 IDX-3HOLD PICTURE 9(6) VALUE 0. NC2444.2 +005700 02 FILLER PICTURE X(8) VALUE SPACES. NC2444.2 +005800 02 IDX-14HOLD PICTURE 9(6) VALUE 0. NC2444.2 +005900 01 TWO-DIMENSION-TABLE. NC2444.2 +006000 02 GRP-ENTRY OCCURS 50 INDEXED IDX-1 IDX-2 IDX-3 IDX-4 NC2444.2 +006100 IDX-5. NC2444.2 +006200 03 ENTRY-1 PICTURE 99. NC2444.2 +006300 03 ELEM-ENTRY OCCURS 10 TIMES INDEXED BY IDX-6 IDX-7 NC2444.2 +006400 IDX-8 IDX-9 IDX-10 IDX-11 IDX-12 IDX-13 IDX-14 NC2444.2 +006500 IDX-15. NC2444.2 +006600 04 ENTRY-2 PICTURE XX. NC2444.2 +006700 01 TEST-RESULTS. NC2444.2 +006800 02 FILLER PIC X VALUE SPACE. NC2444.2 +006900 02 FEATURE PIC X(20) VALUE SPACE. NC2444.2 +007000 02 FILLER PIC X VALUE SPACE. NC2444.2 +007100 02 P-OR-F PIC X(5) VALUE SPACE. NC2444.2 +007200 02 FILLER PIC X VALUE SPACE. NC2444.2 +007300 02 PAR-NAME. NC2444.2 +007400 03 FILLER PIC X(19) VALUE SPACE. NC2444.2 +007500 03 PARDOT-X PIC X VALUE SPACE. NC2444.2 +007600 03 DOTVALUE PIC 99 VALUE ZERO. NC2444.2 +007700 02 FILLER PIC X(8) VALUE SPACE. NC2444.2 +007800 02 RE-MARK PIC X(61). NC2444.2 +007900 01 TEST-COMPUTED. NC2444.2 +008000 02 FILLER PIC X(30) VALUE SPACE. NC2444.2 +008100 02 FILLER PIC X(17) VALUE NC2444.2 +008200 " COMPUTED=". NC2444.2 +008300 02 COMPUTED-X. NC2444.2 +008400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2444.2 +008500 03 COMPUTED-N REDEFINES COMPUTED-A NC2444.2 +008600 PIC -9(9).9(9). NC2444.2 +008700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2444.2 +008800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2444.2 +008900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2444.2 +009000 03 CM-18V0 REDEFINES COMPUTED-A. NC2444.2 +009100 04 COMPUTED-18V0 PIC -9(18). NC2444.2 +009200 04 FILLER PIC X. NC2444.2 +009300 03 FILLER PIC X(50) VALUE SPACE. NC2444.2 +009400 01 TEST-CORRECT. NC2444.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC2444.2 +009600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2444.2 +009700 02 CORRECT-X. NC2444.2 +009800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2444.2 +009900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2444.2 +010000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2444.2 +010100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2444.2 +010200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2444.2 +010300 03 CR-18V0 REDEFINES CORRECT-A. NC2444.2 +010400 04 CORRECT-18V0 PIC -9(18). NC2444.2 +010500 04 FILLER PIC X. NC2444.2 +010600 03 FILLER PIC X(2) VALUE SPACE. NC2444.2 +010700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2444.2 +010800 01 CCVS-C-1. NC2444.2 +010900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2444.2 +011000- "SS PARAGRAPH-NAME NC2444.2 +011100- " REMARKS". NC2444.2 +011200 02 FILLER PIC X(20) VALUE SPACE. NC2444.2 +011300 01 CCVS-C-2. NC2444.2 +011400 02 FILLER PIC X VALUE SPACE. NC2444.2 +011500 02 FILLER PIC X(6) VALUE "TESTED". NC2444.2 +011600 02 FILLER PIC X(15) VALUE SPACE. NC2444.2 +011700 02 FILLER PIC X(4) VALUE "FAIL". NC2444.2 +011800 02 FILLER PIC X(94) VALUE SPACE. NC2444.2 +011900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2444.2 +012000 01 REC-CT PIC 99 VALUE ZERO. NC2444.2 +012100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2444.2 +012600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2444.2 +012700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2444.2 +012800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2444.2 +012900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2444.2 +013000 01 CCVS-H-1. NC2444.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC2444.2 +013200 02 FILLER PIC X(42) VALUE NC2444.2 +013300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2444.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC2444.2 +013500 01 CCVS-H-2A. NC2444.2 +013600 02 FILLER PIC X(40) VALUE SPACE. NC2444.2 +013700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2444.2 +013800 02 FILLER PIC XXXX VALUE NC2444.2 +013900 "4.2 ". NC2444.2 +014000 02 FILLER PIC X(28) VALUE NC2444.2 +014100 " COPY - NOT FOR DISTRIBUTION". NC2444.2 +014200 02 FILLER PIC X(41) VALUE SPACE. NC2444.2 +014300 NC2444.2 +014400 01 CCVS-H-2B. NC2444.2 +014500 02 FILLER PIC X(15) VALUE NC2444.2 +014600 "TEST RESULT OF ". NC2444.2 +014700 02 TEST-ID PIC X(9). NC2444.2 +014800 02 FILLER PIC X(4) VALUE NC2444.2 +014900 " IN ". NC2444.2 +015000 02 FILLER PIC X(12) VALUE NC2444.2 +015100 " HIGH ". NC2444.2 +015200 02 FILLER PIC X(22) VALUE NC2444.2 +015300 " LEVEL VALIDATION FOR ". NC2444.2 +015400 02 FILLER PIC X(58) VALUE NC2444.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +015600 01 CCVS-H-3. NC2444.2 +015700 02 FILLER PIC X(34) VALUE NC2444.2 +015800 " FOR OFFICIAL USE ONLY ". NC2444.2 +015900 02 FILLER PIC X(58) VALUE NC2444.2 +016000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2444.2 +016100 02 FILLER PIC X(28) VALUE NC2444.2 +016200 " COPYRIGHT 1985 ". NC2444.2 +016300 01 CCVS-E-1. NC2444.2 +016400 02 FILLER PIC X(52) VALUE SPACE. NC2444.2 +016500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2444.2 +016600 02 ID-AGAIN PIC X(9). NC2444.2 +016700 02 FILLER PIC X(45) VALUE SPACES. NC2444.2 +016800 01 CCVS-E-2. NC2444.2 +016900 02 FILLER PIC X(31) VALUE SPACE. NC2444.2 +017000 02 FILLER PIC X(21) VALUE SPACE. NC2444.2 +017100 02 CCVS-E-2-2. NC2444.2 +017200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2444.2 +017300 03 FILLER PIC X VALUE SPACE. NC2444.2 +017400 03 ENDER-DESC PIC X(44) VALUE NC2444.2 +017500 "ERRORS ENCOUNTERED". NC2444.2 +017600 01 CCVS-E-3. NC2444.2 +017700 02 FILLER PIC X(22) VALUE NC2444.2 +017800 " FOR OFFICIAL USE ONLY". NC2444.2 +017900 02 FILLER PIC X(12) VALUE SPACE. NC2444.2 +018000 02 FILLER PIC X(58) VALUE NC2444.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +018200 02 FILLER PIC X(13) VALUE SPACE. NC2444.2 +018300 02 FILLER PIC X(15) VALUE NC2444.2 +018400 " COPYRIGHT 1985". NC2444.2 +018500 01 CCVS-E-4. NC2444.2 +018600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2444.2 +018700 02 FILLER PIC X(4) VALUE " OF ". NC2444.2 +018800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2444.2 +018900 02 FILLER PIC X(40) VALUE NC2444.2 +019000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2444.2 +019100 01 XXINFO. NC2444.2 +019200 02 FILLER PIC X(19) VALUE NC2444.2 +019300 "*** INFORMATION ***". NC2444.2 +019400 02 INFO-TEXT. NC2444.2 +019500 04 FILLER PIC X(8) VALUE SPACE. NC2444.2 +019600 04 XXCOMPUTED PIC X(20). NC2444.2 +019700 04 FILLER PIC X(5) VALUE SPACE. NC2444.2 +019800 04 XXCORRECT PIC X(20). NC2444.2 +019900 02 INF-ANSI-REFERENCE PIC X(48). NC2444.2 +020000 01 HYPHEN-LINE. NC2444.2 +020100 02 FILLER PIC IS X VALUE IS SPACE. NC2444.2 +020200 02 FILLER PIC IS X(65) VALUE IS "************************NC2444.2 +020300- "*****************************************". NC2444.2 +020400 02 FILLER PIC IS X(54) VALUE IS "************************NC2444.2 +020500- "******************************". NC2444.2 +020600 01 CCVS-PGM-ID PIC X(9) VALUE NC2444.2 +020700 "NC244A". NC2444.2 +020800 PROCEDURE DIVISION. NC2444.2 +020900 CCVS1 SECTION. NC2444.2 +021000 OPEN-FILES. NC2444.2 +021100 OPEN OUTPUT PRINT-FILE. NC2444.2 +021200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2444.2 +021300 MOVE SPACE TO TEST-RESULTS. NC2444.2 +021400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2444.2 +021500 GO TO CCVS1-EXIT. NC2444.2 +021600 CLOSE-FILES. NC2444.2 +021700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2444.2 +021800 TERMINATE-CCVS. NC2444.2 +021900S EXIT PROGRAM. NC2444.2 +022000STERMINATE-CALL. NC2444.2 +022100 STOP RUN. NC2444.2 +022200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2444.2 +022300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2444.2 +022400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2444.2 +022500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2444.2 +022600 MOVE "****TEST DELETED****" TO RE-MARK. NC2444.2 +022700 PRINT-DETAIL. NC2444.2 +022800 IF REC-CT NOT EQUAL TO ZERO NC2444.2 +022900 MOVE "." TO PARDOT-X NC2444.2 +023000 MOVE REC-CT TO DOTVALUE. NC2444.2 +023100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2444.2 +023200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2444.2 +023300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2444.2 +023400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2444.2 +023500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2444.2 +023600 MOVE SPACE TO CORRECT-X. NC2444.2 +023700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2444.2 +023800 MOVE SPACE TO RE-MARK. NC2444.2 +023900 HEAD-ROUTINE. NC2444.2 +024000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2444.2 +024300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2444.2 +024400 COLUMN-NAMES-ROUTINE. NC2444.2 +024500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +024600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +024800 END-ROUTINE. NC2444.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2444.2 +025000 END-RTN-EXIT. NC2444.2 +025100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +025200 END-ROUTINE-1. NC2444.2 +025300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2444.2 +025400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2444.2 +025500 ADD PASS-COUNTER TO ERROR-HOLD. NC2444.2 +025600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2444.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2444.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2444.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2444.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2444.2 +026100 END-ROUTINE-12. NC2444.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2444.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2444.2 +026400 MOVE "NO " TO ERROR-TOTAL NC2444.2 +026500 ELSE NC2444.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2444.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2444.2 +026800 PERFORM WRITE-LINE. NC2444.2 +026900 END-ROUTINE-13. NC2444.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2444.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE NC2444.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2444.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2444.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO NC2444.2 +027600 MOVE "NO " TO ERROR-TOTAL NC2444.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2444.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2444.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +028100 WRITE-LINE. NC2444.2 +028200 ADD 1 TO RECORD-COUNT. NC2444.2 +028300Y IF RECORD-COUNT GREATER 50 NC2444.2 +028400Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2444.2 +028500Y MOVE SPACE TO DUMMY-RECORD NC2444.2 +028600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2444.2 +028700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2444.2 +028800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2444.2 +028900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2444.2 +029000Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2444.2 +029100Y MOVE ZERO TO RECORD-COUNT. NC2444.2 +029200 PERFORM WRT-LN. NC2444.2 +029300 WRT-LN. NC2444.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2444.2 +029500 MOVE SPACE TO DUMMY-RECORD. NC2444.2 +029600 BLANK-LINE-PRINT. NC2444.2 +029700 PERFORM WRT-LN. NC2444.2 +029800 FAIL-ROUTINE. NC2444.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2444.2 +030000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2444.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2444.2 +030200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2444.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2444.2 +030500 GO TO FAIL-ROUTINE-EX. NC2444.2 +030600 FAIL-ROUTINE-WRITE. NC2444.2 +030700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2444.2 +030800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2444.2 +030900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2444.2 +031000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2444.2 +031100 FAIL-ROUTINE-EX. EXIT. NC2444.2 +031200 BAIL-OUT. NC2444.2 +031300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2444.2 +031400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2444.2 +031500 BAIL-OUT-WRITE. NC2444.2 +031600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2444.2 +031700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2444.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2444.2 +032000 BAIL-OUT-EX. EXIT. NC2444.2 +032100 CCVS1-EXIT. NC2444.2 +032200 EXIT. NC2444.2 +032300 SECT-NC244A-001 SECTION. NC2444.2 +032400 TH-18-001. NC2444.2 +032500 BUILD-2DEM-TABLE. NC2444.2 +032600 SET IDX-1 IDX-2 IDX-3 IDX-4 IDX-5 IDX-6 IDX-7 IDX-8 NC2444.2 +032700 IDX-9 IDX-10 TO 01. NC2444.2 +032800 SET IDX-11 IDX-12 IDX-13 IDX-14 IDX-15 TO 01. NC2444.2 +032900 BUILD-LEVEL-1. NC2444.2 +033000 SET ENTRY-1 (IDX-5) TO IDX-5. NC2444.2 +033100 IF IDX-5 EQUAL TO 6 MOVE "BB" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033200 IF IDX-5 EQUAL TO 11 MOVE "CC" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033300 IF IDX-5 EQUAL TO 16 MOVE "DD" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033400 IF IDX-5 EQUAL TO 21 MOVE "EE" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033500 IF IDX-5 EQUAL TO 26 MOVE "FF" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033600 IF IDX-5 EQUAL TO 31 MOVE "GG" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033700 IF IDX-5 EQUAL TO 36 MOVE "HH" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033800 IF IDX-5 EQUAL TO 41 MOVE "II" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033900 IF IDX-5 EQUAL TO 46 MOVE "JJ" TO IN-SERT. NC2444.2 +034000 BUILD-ENTRY. NC2444.2 +034100 MOVE IN-SERT TO ENTRY-2 (IDX-5, IDX-15). NC2444.2 +034200 IF IDX-15 EQUAL TO 10 AND IDX-5 EQUAL TO 50 NC2444.2 +034300 GO TO BUILD-EXIT. NC2444.2 +034400 IF IDX-15 EQUAL TO 10 NC2444.2 +034500 SET IDX-15 TO 01 NC2444.2 +034600 SET IDX-5 UP BY 1 NC2444.2 +034700 GO TO BUILD-LEVEL-1. NC2444.2 +034800 SET IDX-15 UP BY 01. NC2444.2 +034900 GO TO BUILD-ENTRY. NC2444.2 +035000 BUILD-EXIT. NC2444.2 +035100 EXIT. NC2444.2 +035200 TABLE-CHECKING SECTION. NC2444.2 +035300* NC2444.2 +035400 IDX-INIT-F1-1. NC2444.2 +035500 MOVE "IDX-TEST-F1-1" TO PAR-NAME. NC2444.2 +035600 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +035700 MOVE "RELATIVE INDEXING " TO FEATURE. NC2444.2 +035800 IDX-TEST-F1-1. NC2444.2 +035900 SET IDX-4 IDX-14 TO SUB-COMP2. NC2444.2 +036000 IF ENTRY-2 (IDX-4 + 49, IDX-14 + 9) EQUAL TO "JJ" NC2444.2 +036100 PERFORM PASS NC2444.2 +036200 GO TO IDX-WRITE-F1-1 NC2444.2 +036300 ELSE NC2444.2 +036400 GO TO IDX-FAIL-F1-1. NC2444.2 +036500 IDX-DELETE-F1-1. NC2444.2 +036600 PERFORM DE-LETE. NC2444.2 +036700 GO TO IDX-WRITE-F1-1. NC2444.2 +036800 IDX-FAIL-F1-1. NC2444.2 +036900 MOVE ENTRY-2 (IDX-4 + 49, IDX-14 + 9) TO COMPUTED-A. NC2444.2 +037000 MOVE "JJ" TO CORRECT-A. NC2444.2 +037100 PERFORM FAIL. NC2444.2 +037200 IDX-WRITE-F1-1. NC2444.2 +037300 PERFORM PRINT-DETAIL. NC2444.2 +037400* NC2444.2 +037500 IDX-INIT-F2-2. NC2444.2 +037600 MOVE "IDX-TEST-F2-2" TO PAR-NAME. NC2444.2 +037700 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +037800 MOVE "SET DN BY COMP ITEM " TO FEATURE. NC2444.2 +037900 IDX-TEST-F2-2. NC2444.2 +038000 SET IDX-3 TO SUB-COMP3. NC2444.2 +038100 SET IDX-3 DOWN BY SUB-7. NC2444.2 +038200 IF ENTRY-1 (IDX-3) EQUAL TO 29 NC2444.2 +038300 PERFORM PASS NC2444.2 +038400 GO TO IDX-WRITE-F2-2 NC2444.2 +038500 ELSE NC2444.2 +038600 GO TO IDX-FAIL-F2-2. NC2444.2 +038700 IDX-DELETE-F2-2. NC2444.2 +038800 PERFORM DE-LETE. NC2444.2 +038900 GO TO IDX-WRITE-F2-2. NC2444.2 +039000 IDX-FAIL-F2-2. NC2444.2 +039100 MOVE ENTRY-1 (IDX-3) TO COMPUTED-N. NC2444.2 +039200 MOVE 29 TO CORRECT-N. NC2444.2 +039300 PERFORM FAIL. NC2444.2 +039400 IDX-WRITE-F2-2. NC2444.2 +039500 PERFORM PRINT-DETAIL. NC2444.2 +039600* NC2444.2 +039700 IDX-INIT-F2-3. NC2444.2 +039800 MOVE "IDX-TEST-F2-3" TO PAR-NAME. NC2444.2 +039900 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +040000 MOVE "SET UP BY COMP ITEM " TO FEATURE. NC2444.2 +040100 IDX-TEST-F2-3. NC2444.2 +040200 SET IDX-2 TO SUB-COMP6. NC2444.2 +040300 SET IDX-2 UP BY SUB-COMP1. NC2444.2 +040400 IF ENTRY-1 (IDX-2) EQUAL TO 12 NC2444.2 +040500 PERFORM PASS NC2444.2 +040600 GO TO IDX-WRITE-F2-3 NC2444.2 +040700 ELSE NC2444.2 +040800 GO TO IDX-FAIL-F2-3. NC2444.2 +040900 IDX-DELETE-F2-3. NC2444.2 +041000 PERFORM DE-LETE. NC2444.2 +041100 GO TO IDX-WRITE-F2-3. NC2444.2 +041200 IDX-FAIL-F2-3. NC2444.2 +041300 MOVE ENTRY-1 (IDX-2) TO COMPUTED-N. NC2444.2 +041400 MOVE 12 TO CORRECT-N. NC2444.2 +041500 PERFORM FAIL. NC2444.2 +041600 IDX-WRITE-F2-3. NC2444.2 +041700 PERFORM PRINT-DETAIL. NC2444.2 +041800* NC2444.2 +041900 IDX-INIT-F2-4. NC2444.2 +042000 MOVE "IDX-TEST-F2-4" TO PAR-NAME. NC2444.2 +042100 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +042200 MOVE "MULT OPERND SET STMT" TO FEATURE. NC2444.2 +042300 GO TO IDX-TEST-F2-4. NC2444.2 +042400 TEST-4. NC2444.2 +042500 SET IDX-1 IDX-6 DOWN BY SUB-COMP5. NC2444.2 +042600 MOVE ENTRY-2 (IDX-1, IDX-6) TO ENTRY-HOLD. NC2444.2 +042700 TEST-4EXIT. NC2444.2 +042800 EXIT. NC2444.2 +042900 IDX-TEST-F2-4. NC2444.2 +043000 SET IDX-1 TO SUB-COMP3. NC2444.2 +043100 SET IDX-6 TO SUB-9. NC2444.2 +043200 PERFORM TEST-4 THRU TEST-4EXIT UNTIL NC2444.2 +043300 ENTRY-2 (IDX-1, IDX-6) EQUAL TO "II". NC2444.2 +043400 IF ENTRY-HOLD EQUAL TO "II" NC2444.2 +043500 PERFORM PASS NC2444.2 +043600 GO TO IDX-WRITE-F2-4 NC2444.2 +043700 ELSE NC2444.2 +043800 GO TO IDX-FAIL-F2-4. NC2444.2 +043900 IDX-DELETE-F2-4. NC2444.2 +044000 PERFORM DE-LETE. NC2444.2 +044100 GO TO IDX-WRITE-F2-4. NC2444.2 +044200 IDX-FAIL-F2-4. NC2444.2 +044300 MOVE ENTRY-HOLD TO COMPUTED-A. NC2444.2 +044400 MOVE "II" TO CORRECT-A. NC2444.2 +044500 IDX-WRITE-F2-4. NC2444.2 +044600 PERFORM PRINT-DETAIL. NC2444.2 +044700* NC2444.2 +044800 IDX-INIT-F2-5. NC2444.2 +044900 MOVE "IDX-TEST-F2-5" TO PAR-NAME. NC2444.2 +045000 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +045100 MOVE "PFM VARYNG COMP ITEM" TO FEATURE. NC2444.2 +045200 MOVE SPACES TO ENTRY-HOLD. NC2444.2 +045300 GO TO IDX-TEST-F2-5. NC2444.2 +045400 TEST-5. NC2444.2 +045500 SET IDX-3 TO SUB-COMP2. NC2444.2 +045600 SET IDX-14 TO SUB-COMP5. NC2444.2 +045700 MOVE ENTRY-2 (IDX-3, IDX-14) TO ENTRY-HOLD. NC2444.2 +045800 IDX-TEST-F2-5. NC2444.2 +045900 SET IDX-3, IDX-14 TO 01. NC2444.2 +046000 PERFORM TEST-5 NC2444.2 +046100 VARYING SUB-COMP5 FROM 1 BY SUB-8 NC2444.2 +046200 UNTIL ENTRY-2 (IDX-3, IDX-14) EQUAL TO "JJ" NC2444.2 +046300 OR IDX-14 EQUAL TO 10 NC2444.2 +046400 AFTER SUB-COMP2 FROM 1 BY 1 NC2444.2 +046500 UNTIL ENTRY-1 (IDX-3) EQUAL TO 46. NC2444.2 +046600 IF ENTRY-HOLD EQUAL TO "JJ" NC2444.2 +046700 PERFORM PASS NC2444.2 +046800 GO TO IDX-WRITE-F2-5 NC2444.2 +046900 ELSE NC2444.2 +047000 GO TO IDX-FAIL-F2-5. NC2444.2 +047100 IDX-DELETE-F2-5. NC2444.2 +047200 PERFORM DE-LETE. NC2444.2 +047300 MOVE "IDX-TEST-F2-5" TO PAR-NAME. NC2444.2 +047400 MOVE "PFM VARYING COMP ITEM" TO FEATURE. NC2444.2 +047500 PERFORM PRINT-DETAIL. NC2444.2 +047600* NOTE IF THIS TEST IS DELETED TEST-6 WILL ALSO BE DELETED. NC2444.2 +047700 PERFORM DE-LETE. NC2444.2 +047800 MOVE "IDX-TEST-F2-6" TO PAR-NAME. NC2444.2 +047900 PERFORM PRINT-DETAIL. NC2444.2 +048000 GO TO CLOSE-FILES. NC2444.2 +048100 IDX-FAIL-F2-5. NC2444.2 +048200 MOVE "JJ" TO CORRECT-A. NC2444.2 +048300 MOVE ENTRY-HOLD TO COMPUTED-A. NC2444.2 +048400 PERFORM FAIL. NC2444.2 +048500 IDX-WRITE-F2-5. NC2444.2 +048600 PERFORM PRINT-DETAIL. NC2444.2 +048700* NC2444.2 +048800 IDX-INIT-F2-6. NC2444.2 +048900 MOVE "IDX-TEST-F2-6" TO PAR-NAME. NC2444.2 +049000 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +049100 IDX-TEST-F2-6. NC2444.2 +049200 IF IDX-3 EQUAL TO 46 AND IDX-14 EQUAL TO 01 NC2444.2 +049300 PERFORM PASS NC2444.2 +049400 GO TO IDX-WRITE-F2-6 NC2444.2 +049500 ELSE NC2444.2 +049600 GO TO IDX-FAIL-F2-6. NC2444.2 +049700 IDX-DELETE-F2-6. NC2444.2 +049800 PERFORM DE-LETE. NC2444.2 +049900 GO TO IDX-WRITE-F2-6. NC2444.2 +050000 IDX-FAIL-F2-6. NC2444.2 +050100 SET IDX-3HOLD TO IDX-3. NC2444.2 +050200 SET IDX-14HOLD TO IDX-14. NC2444.2 +050300 MOVE IDX-HOLD TO COMPUTED-A. NC2444.2 +050400 PERFORM FAIL. NC2444.2 +050500 MOVE "000046 000001" TO CORRECT-A. NC2444.2 +050600 MOVE "COMPARE INDEXES OF TEST-5" TO RE-MARK. NC2444.2 +050700 IDX-WRITE-F2-6. NC2444.2 +050800 PERFORM PRINT-DETAIL. NC2444.2 +050900 CCVS-EXIT SECTION. NC2444.2 +051000 CCVS-999999. NC2444.2 +051100 GO TO CLOSE-FILES. NC2444.2 +*END-OF,NC244A +*HEADER,COBOL,NC245A +000100 IDENTIFICATION DIVISION. NC2454.2 +000200 PROGRAM-ID. NC2454.2 +000300 NC245A. NC2454.2 +000400**************************************************************** NC2454.2 +000500* * NC2454.2 +000600* VALIDATION FOR:- * NC2454.2 +000700* * NC2454.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +000900* * NC2454.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2454.2 +001100* * NC2454.2 +001200**************************************************************** NC2454.2 +001300* * NC2454.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2454.2 +001500* * NC2454.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2454.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2454.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2454.2 +001900* * NC2454.2 +002000**************************************************************** NC2454.2 +002100* * NC2454.2 +002200* PROGRAM NC245A TESTS THE USE OF THE COMMA, SEMI-COLON AND * NC2454.2 +002300* SPACE SEPARATORS WHEN SPECIFYING SUBSCRIPTS AND INDICES * NC2454.2 +002400* TO ACCESS TWO AND THREE-DIMENSIONAL TABLES * NC2454.2 +002500* RELATIVE INDEXING IS ALSO USED. * NC2454.2 +002600* * NC2454.2 +002700**************************************************************** NC2454.2 +002800 ENVIRONMENT DIVISION. NC2454.2 +002900 CONFIGURATION SECTION. NC2454.2 +003000 SOURCE-COMPUTER. NC2454.2 +003100 XXXXX082. NC2454.2 +003200 OBJECT-COMPUTER. NC2454.2 +003300 XXXXX083. NC2454.2 +003400 INPUT-OUTPUT SECTION. NC2454.2 +003500 FILE-CONTROL. NC2454.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2454.2 +003700 XXXXX055. NC2454.2 +003800 DATA DIVISION. NC2454.2 +003900 FILE SECTION. NC2454.2 +004000 FD PRINT-FILE. NC2454.2 +004100 01 PRINT-REC PICTURE X(120). NC2454.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2454.2 +004300 WORKING-STORAGE SECTION. NC2454.2 +004400 77 WRK1 PIC S999; COMPUTATIONAL, VALUE ZERO. NC2454.2 +004500 77 EXPECTED-VALUE, PIC S999999. NC2454.2 +004600 77 TEMP; PIC S999999. NC2454.2 +004700* TWO DIMENSIONAL TABLE; 15 X 10. NC2454.2 +004800 01 GRP-TAB2. NC2454.2 +004900 02 GRP-LEV2-0015F; OCCURS 15 TIMES; NC2454.2 +005000 INDEXED BY IN1, INDEX1, NC2454.2 +005100 USAGE IS COMPUTATIONAL. NC2454.2 +005200 03 ELEM2 PIC S999999; OCCURS 10 TIMES; NC2454.2 +005300 INDEXED BY IN2; INDEX2. NC2454.2 +005400* THREE DIMENSIONAL TABLE; 10 X 5 X 3. NC2454.2 +005500 01 GRP-TAB3. NC2454.2 +005600 02 GRP-LEV2-0003F; OCCURS 3 TIMES; NC2454.2 +005700 INDEXED BY INAME1, IN-NAME-1, NC2454.2 +005800 USAGE IS COMPUTATIONAL. NC2454.2 +005900 03 GRP-LEV3-0005F; OCCURS 5 TIMES; NC2454.2 +006000 INDEXED BY INAME2; IN-NAME-2. NC2454.2 +006100 04 ELEM3 PIC S999999; OCCURS 10 TIMES; NC2454.2 +006200 INDEXED BY INAME3; IN-NAME-3. NC2454.2 +006300* SUBSCRIPTS FOR REFERENCING TABLE ITEMS NC2454.2 +006400 01 SUBSCRIPT-TABLE; USAGE COMPUTATIONAL. NC2454.2 +006500 02 S21 PIC S999; VALUE IS 1. NC2454.2 +006600 02 S22 PIC S999; VALUE IS 1. NC2454.2 +006700 02 S31 PIC S999; VALUE IS 1. NC2454.2 +006800 02 S32 PIC S999; VALUE IS 1. NC2454.2 +006900 02 S33 PIC S999; VALUE IS 1. NC2454.2 +007000 01 TEST-RESULTS. NC2454.2 +007100 02 FILLER PIC X VALUE SPACE. NC2454.2 +007200 02 FEATURE PIC X(20) VALUE SPACE. NC2454.2 +007300 02 FILLER PIC X VALUE SPACE. NC2454.2 +007400 02 P-OR-F PIC X(5) VALUE SPACE. NC2454.2 +007500 02 FILLER PIC X VALUE SPACE. NC2454.2 +007600 02 PAR-NAME. NC2454.2 +007700 03 FILLER PIC X(19) VALUE SPACE. NC2454.2 +007800 03 PARDOT-X PIC X VALUE SPACE. NC2454.2 +007900 03 DOTVALUE PIC 99 VALUE ZERO. NC2454.2 +008000 02 FILLER PIC X(8) VALUE SPACE. NC2454.2 +008100 02 RE-MARK PIC X(61). NC2454.2 +008200 01 TEST-COMPUTED. NC2454.2 +008300 02 FILLER PIC X(30) VALUE SPACE. NC2454.2 +008400 02 FILLER PIC X(17) VALUE NC2454.2 +008500 " COMPUTED=". NC2454.2 +008600 02 COMPUTED-X. NC2454.2 +008700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2454.2 +008800 03 COMPUTED-N REDEFINES COMPUTED-A NC2454.2 +008900 PIC -9(9).9(9). NC2454.2 +009000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2454.2 +009100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2454.2 +009200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2454.2 +009300 03 CM-18V0 REDEFINES COMPUTED-A. NC2454.2 +009400 04 COMPUTED-18V0 PIC -9(18). NC2454.2 +009500 04 FILLER PIC X. NC2454.2 +009600 03 FILLER PIC X(50) VALUE SPACE. NC2454.2 +009700 01 TEST-CORRECT. NC2454.2 +009800 02 FILLER PIC X(30) VALUE SPACE. NC2454.2 +009900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2454.2 +010000 02 CORRECT-X. NC2454.2 +010100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2454.2 +010200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2454.2 +010300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2454.2 +010400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2454.2 +010500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2454.2 +010600 03 CR-18V0 REDEFINES CORRECT-A. NC2454.2 +010700 04 CORRECT-18V0 PIC -9(18). NC2454.2 +010800 04 FILLER PIC X. NC2454.2 +010900 03 FILLER PIC X(2) VALUE SPACE. NC2454.2 +011000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2454.2 +011100 01 CCVS-C-1. NC2454.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2454.2 +011300- "SS PARAGRAPH-NAME NC2454.2 +011400- " REMARKS". NC2454.2 +011500 02 FILLER PIC X(20) VALUE SPACE. NC2454.2 +011600 01 CCVS-C-2. NC2454.2 +011700 02 FILLER PIC X VALUE SPACE. NC2454.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". NC2454.2 +011900 02 FILLER PIC X(15) VALUE SPACE. NC2454.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". NC2454.2 +012100 02 FILLER PIC X(94) VALUE SPACE. NC2454.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2454.2 +012300 01 REC-CT PIC 99 VALUE ZERO. NC2454.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2454.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2454.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2454.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2454.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2454.2 +013300 01 CCVS-H-1. NC2454.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC2454.2 +013500 02 FILLER PIC X(42) VALUE NC2454.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2454.2 +013700 02 FILLER PIC X(39) VALUE SPACES. NC2454.2 +013800 01 CCVS-H-2A. NC2454.2 +013900 02 FILLER PIC X(40) VALUE SPACE. NC2454.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2454.2 +014100 02 FILLER PIC XXXX VALUE NC2454.2 +014200 "4.2 ". NC2454.2 +014300 02 FILLER PIC X(28) VALUE NC2454.2 +014400 " COPY - NOT FOR DISTRIBUTION". NC2454.2 +014500 02 FILLER PIC X(41) VALUE SPACE. NC2454.2 +014600 NC2454.2 +014700 01 CCVS-H-2B. NC2454.2 +014800 02 FILLER PIC X(15) VALUE NC2454.2 +014900 "TEST RESULT OF ". NC2454.2 +015000 02 TEST-ID PIC X(9). NC2454.2 +015100 02 FILLER PIC X(4) VALUE NC2454.2 +015200 " IN ". NC2454.2 +015300 02 FILLER PIC X(12) VALUE NC2454.2 +015400 " HIGH ". NC2454.2 +015500 02 FILLER PIC X(22) VALUE NC2454.2 +015600 " LEVEL VALIDATION FOR ". NC2454.2 +015700 02 FILLER PIC X(58) VALUE NC2454.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +015900 01 CCVS-H-3. NC2454.2 +016000 02 FILLER PIC X(34) VALUE NC2454.2 +016100 " FOR OFFICIAL USE ONLY ". NC2454.2 +016200 02 FILLER PIC X(58) VALUE NC2454.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2454.2 +016400 02 FILLER PIC X(28) VALUE NC2454.2 +016500 " COPYRIGHT 1985 ". NC2454.2 +016600 01 CCVS-E-1. NC2454.2 +016700 02 FILLER PIC X(52) VALUE SPACE. NC2454.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2454.2 +016900 02 ID-AGAIN PIC X(9). NC2454.2 +017000 02 FILLER PIC X(45) VALUE SPACES. NC2454.2 +017100 01 CCVS-E-2. NC2454.2 +017200 02 FILLER PIC X(31) VALUE SPACE. NC2454.2 +017300 02 FILLER PIC X(21) VALUE SPACE. NC2454.2 +017400 02 CCVS-E-2-2. NC2454.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2454.2 +017600 03 FILLER PIC X VALUE SPACE. NC2454.2 +017700 03 ENDER-DESC PIC X(44) VALUE NC2454.2 +017800 "ERRORS ENCOUNTERED". NC2454.2 +017900 01 CCVS-E-3. NC2454.2 +018000 02 FILLER PIC X(22) VALUE NC2454.2 +018100 " FOR OFFICIAL USE ONLY". NC2454.2 +018200 02 FILLER PIC X(12) VALUE SPACE. NC2454.2 +018300 02 FILLER PIC X(58) VALUE NC2454.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +018500 02 FILLER PIC X(13) VALUE SPACE. NC2454.2 +018600 02 FILLER PIC X(15) VALUE NC2454.2 +018700 " COPYRIGHT 1985". NC2454.2 +018800 01 CCVS-E-4. NC2454.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2454.2 +019000 02 FILLER PIC X(4) VALUE " OF ". NC2454.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2454.2 +019200 02 FILLER PIC X(40) VALUE NC2454.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2454.2 +019400 01 XXINFO. NC2454.2 +019500 02 FILLER PIC X(19) VALUE NC2454.2 +019600 "*** INFORMATION ***". NC2454.2 +019700 02 INFO-TEXT. NC2454.2 +019800 04 FILLER PIC X(8) VALUE SPACE. NC2454.2 +019900 04 XXCOMPUTED PIC X(20). NC2454.2 +020000 04 FILLER PIC X(5) VALUE SPACE. NC2454.2 +020100 04 XXCORRECT PIC X(20). NC2454.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). NC2454.2 +020300 01 HYPHEN-LINE. NC2454.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. NC2454.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************NC2454.2 +020600- "*****************************************". NC2454.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************NC2454.2 +020800- "******************************". NC2454.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE NC2454.2 +021000 "NC245A". NC2454.2 +021100 PROCEDURE DIVISION. NC2454.2 +021200 CCVS1 SECTION. NC2454.2 +021300 OPEN-FILES. NC2454.2 +021400 OPEN OUTPUT PRINT-FILE. NC2454.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2454.2 +021600 MOVE SPACE TO TEST-RESULTS. NC2454.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2454.2 +021800 GO TO CCVS1-EXIT. NC2454.2 +021900 CLOSE-FILES. NC2454.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2454.2 +022100 TERMINATE-CCVS. NC2454.2 +022200S EXIT PROGRAM. NC2454.2 +022300STERMINATE-CALL. NC2454.2 +022400 STOP RUN. NC2454.2 +022500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2454.2 +022600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2454.2 +022700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2454.2 +022800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2454.2 +022900 MOVE "****TEST DELETED****" TO RE-MARK. NC2454.2 +023000 PRINT-DETAIL. NC2454.2 +023100 IF REC-CT NOT EQUAL TO ZERO NC2454.2 +023200 MOVE "." TO PARDOT-X NC2454.2 +023300 MOVE REC-CT TO DOTVALUE. NC2454.2 +023400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2454.2 +023500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2454.2 +023600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2454.2 +023700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2454.2 +023800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2454.2 +023900 MOVE SPACE TO CORRECT-X. NC2454.2 +024000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2454.2 +024100 MOVE SPACE TO RE-MARK. NC2454.2 +024200 HEAD-ROUTINE. NC2454.2 +024300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +024400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +024500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2454.2 +024600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2454.2 +024700 COLUMN-NAMES-ROUTINE. NC2454.2 +024800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +024900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +025100 END-ROUTINE. NC2454.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2454.2 +025300 END-RTN-EXIT. NC2454.2 +025400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +025500 END-ROUTINE-1. NC2454.2 +025600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2454.2 +025700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2454.2 +025800 ADD PASS-COUNTER TO ERROR-HOLD. NC2454.2 +025900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2454.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2454.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2454.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2454.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2454.2 +026400 END-ROUTINE-12. NC2454.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2454.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2454.2 +026700 MOVE "NO " TO ERROR-TOTAL NC2454.2 +026800 ELSE NC2454.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2454.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2454.2 +027100 PERFORM WRITE-LINE. NC2454.2 +027200 END-ROUTINE-13. NC2454.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2454.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE NC2454.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2454.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2454.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO NC2454.2 +027900 MOVE "NO " TO ERROR-TOTAL NC2454.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2454.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2454.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +028400 WRITE-LINE. NC2454.2 +028500 ADD 1 TO RECORD-COUNT. NC2454.2 +028600Y IF RECORD-COUNT GREATER 50 NC2454.2 +028700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2454.2 +028800Y MOVE SPACE TO DUMMY-RECORD NC2454.2 +028900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2454.2 +029000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2454.2 +029100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2454.2 +029200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2454.2 +029300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2454.2 +029400Y MOVE ZERO TO RECORD-COUNT. NC2454.2 +029500 PERFORM WRT-LN. NC2454.2 +029600 WRT-LN. NC2454.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2454.2 +029800 MOVE SPACE TO DUMMY-RECORD. NC2454.2 +029900 BLANK-LINE-PRINT. NC2454.2 +030000 PERFORM WRT-LN. NC2454.2 +030100 FAIL-ROUTINE. NC2454.2 +030200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2454.2 +030300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2454.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2454.2 +030500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2454.2 +030600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +030700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2454.2 +030800 GO TO FAIL-ROUTINE-EX. NC2454.2 +030900 FAIL-ROUTINE-WRITE. NC2454.2 +031000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2454.2 +031100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2454.2 +031200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2454.2 +031300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2454.2 +031400 FAIL-ROUTINE-EX. EXIT. NC2454.2 +031500 BAIL-OUT. NC2454.2 +031600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2454.2 +031700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2454.2 +031800 BAIL-OUT-WRITE. NC2454.2 +031900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2454.2 +032000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2454.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2454.2 +032300 BAIL-OUT-EX. EXIT. NC2454.2 +032400 CCVS1-EXIT. NC2454.2 +032500 EXIT. NC2454.2 +032600* SECTION 2.1.6 ON PAGE IV-3 OF AMERICAN NATIONAL NC2454.2 +032700* STANDARD COBOL, X3.23 - 1985 STATES THAT COMMA AND NC2454.2 +032800* SEMICOLON ARE OPTIONAL WHERE SHOWN IN THE FORMATS AND NC2454.2 +032900* ARE INTERCHANGEABLE. EITHER ONE MAY BE USED ANYWHERE NC2454.2 +033000* ONE OF THEM IS SHOWN IN THE LANGUAGE FORMATS. NC2454.2 +033100* NC2454.2 +033200* THIS ROUTINE TESTS THE USE OF SEMICOLON IN PLACE OF NC2454.2 +033300* COMMA AS SEPARATORS FOR SUBSCRIPTS AND INDEXES IN NC2454.2 +033400* REFERENCING TABLE ITEMS. NC2454.2 +033500**************************************** NC2454.2 +033600*STATEMENT DELETION INSTRUCTIONS NC2454.2 +033700* IF THE COMPILER REJECTS ANY TABLE REFERENCE IN THESE NC2454.2 +033800* TESTS, DELETE THAT LINE OF CODE BY PLACING AN * IN COLUMN 7. NC2454.2 +033900* LEAVE THE PERFORM ... THRU STATEMENT. THE TEST DELETED NC2454.2 +034000* APPEARS AS A FAILURE ON THE OUTPUT REPORT. NC2454.2 +034100**************************************** NC2454.2 +034200 SECT-NC245A-001 SECTION. NC2454.2 +034300* THIS SECTION STORES THE VALUES 1 THRU 150 IN THE NC2454.2 +034400* TWO TABLES USED IN THE TESTS OF SEMICOLON AS SUBSCRIPT NC2454.2 +034500* AND INDEX SEPARATOR. NC2454.2 +034600 BUILD-TABLE. NC2454.2 +034700 ADD 1 TO WRK1. NC2454.2 +034800 MOVE WRK1 TO ELEM2 (S21, S22) NC2454.2 +034900 ELEM3 (S31, S32, S33). NC2454.2 +035000 IF WRK1 EQUAL TO 150 GO TO SECT-TH219-0002. NC2454.2 +035100 INCRE-SUBS. NC2454.2 +035200 ADD 1 TO S22, S33. NC2454.2 +035300 IF S22 LESS THAN 11 GO TO BUILD-TABLE. NC2454.2 +035400 MOVE 1 TO S22, S33. NC2454.2 +035500 ADD 1 TO S21, S32. NC2454.2 +035600 IF S32 LESS THAN 6 GO TO BUILD-TABLE. NC2454.2 +035700 MOVE 1 TO S32. NC2454.2 +035800 ADD 1 TO S31. NC2454.2 +035900 GO TO BUILD-TABLE. NC2454.2 +036000 SECT-TH219-0002 SECTION. NC2454.2 +036100* THIS SECTION CONTAINS THE TESTS ON THE USE OF SEMICOLON NC2454.2 +036200* AS A SEPARATOR IN REFERENCING TABLE ITEMS. NC2454.2 +036300 SEP-INIT-008. NC2454.2 +036400 MOVE "SEP-TEST-008" TO PAR-NAME. NC2454.2 +036500 MOVE "SEMICLN AS SEPARATOR" TO FEATURE. NC2454.2 +036600 MOVE 0 TO REC-CT. NC2454.2 +036700 MOVE 0 TO TEMP. NC2454.2 +036800 MOVE 6 TO EXPECTED-VALUE. NC2454.2 +036900 MOVE 1 TO S21. NC2454.2 +037000 MOVE 6 TO S22. NC2454.2 +037100* THIS TEST USES SPACES AND SEMICOLONS IN REFERENCING NC2454.2 +037200* TWO DIMENSIONAL TABLE ELEMENTS WITH SUBSCRIPTS. NC2454.2 +037300 SEP-TEST-008-01. NC2454.2 +037400 MOVE ELEM2 (S21; S22) TO TEMP. NC2454.2 +037500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +037600 SEP-TEST-008-02. NC2454.2 +037700 MOVE ELEM2(S21; S22) TO TEMP. NC2454.2 +037800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +037900 SEP-TEST-008-03. NC2454.2 +038000 ADD ELEM2 (S21 ; S22) TO TEMP. NC2454.2 +038100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038200 SEP-TEST-008-04. NC2454.2 +038300 MOVE ELEM2( S21; S22 ) TO TEMP. NC2454.2 +038400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038500 SEP-TEST-008-05. NC2454.2 +038600 MOVE ELEM2 ( S21; S22 ) TO TEMP. NC2454.2 +038700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038800 GO TO SEP-INIT-009. NC2454.2 +038900 SEP-DELETE-008. NC2454.2 +039000 PERFORM DE-LETE. NC2454.2 +039100 PERFORM TEST-WRITE. NC2454.2 +039200 SEP-INIT-009. NC2454.2 +039300 MOVE "SEP-TEST-009" TO PAR-NAME. NC2454.2 +039400 MOVE 0 TO REC-CT. NC2454.2 +039500 MOVE 0 TO TEMP. NC2454.2 +039600 MOVE 150 TO EXPECTED-VALUE. NC2454.2 +039700 MOVE 3 TO S31. NC2454.2 +039800 MOVE 5 TO S32. NC2454.2 +039900 MOVE 10 TO S33. NC2454.2 +040000* THIS TEST USES SEMICOLONS, COMMAS, AND SPACES IN NC2454.2 +040100* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS WITH SUBSCRIPTS.NC2454.2 +040200 SEP-TEST-009-01. NC2454.2 +040300 MOVE ELEM3 (S31; S32; S33) TO TEMP. NC2454.2 +040400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +040500 SEP-TEST-009-02. NC2454.2 +040600 MOVE ELEM3(S31; S32; S33) TO TEMP. NC2454.2 +040700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +040800 SEP-TEST-009-03. NC2454.2 +040900 ADD ELEM3 (S31, S32; S33) TO TEMP. NC2454.2 +041000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041100 SEP-TEST-009-04. NC2454.2 +041200 MOVE 300 TO TEMP. NC2454.2 +041300 SUBTRACT ELEM3 (S31; S32 S33) FROM TEMP. NC2454.2 +041400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041500 SEP-TEST-009-05. NC2454.2 +041600 MOVE ELEM3 (S31 ; S32 ; S33) TO TEMP. NC2454.2 +041700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041800 SEP-TEST-009-06. NC2454.2 +041900 MOVE ELEM3( S31 S32; S33) TO TEMP. NC2454.2 +042000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +042100 GO TO SEP-INIT-010. NC2454.2 +042200 SEP-DELETE-009. NC2454.2 +042300 PERFORM DE-LETE. NC2454.2 +042400 PERFORM TEST-WRITE. NC2454.2 +042500* NC2454.2 +042600 SEP-INIT-010. NC2454.2 +042700 MOVE "SEP-TEST-010" TO PAR-NAME. NC2454.2 +042800 MOVE 0 TO REC-CT. NC2454.2 +042900 MOVE 0 TO TEMP. NC2454.2 +043000 MOVE 150 TO EXPECTED-VALUE. NC2454.2 +043100* THIS TEST USES SEMICOLONS, SPACES AND COMMAS IN NC2454.2 +043200* REFERENCING TABLE ELEMENTS WITH LITERAL SUBSCRIPTS. NC2454.2 +043300 SEP-TEST-010-01. NC2454.2 +043400 MOVE ELEM2 (15; 10) TO TEMP. NC2454.2 +043500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +043600 SEP-TEST-010-02. NC2454.2 +043700 MOVE ELEM2 ( 15; 10 ) TO TEMP. NC2454.2 +043800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +043900 SEP-TEST-010-03. NC2454.2 +044000 ADD ELEM2(15; 10) TO TEMP. NC2454.2 +044100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044200 SEP-TEST-010-04. NC2454.2 +044300 MOVE ELEM2 (+15; 10) TO TEMP. NC2454.2 +044400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044500 SEP-TEST-010-05. NC2454.2 +044600 ADD ELEM3 (3; 5; 10) TO TEMP. NC2454.2 +044700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044800 SEP-TEST-010-06. NC2454.2 +044900 MOVE ELEM3( +3; +5, +10) TO TEMP. NC2454.2 +045000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +045100 SEP-TEST-010-07. NC2454.2 +045200 MOVE ELEM3 (+3, 5; 10) TO TEMP. NC2454.2 +045300 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +045400 GO TO SEP-INIT-011. NC2454.2 +045500 SEP-DELETE-010. NC2454.2 +045600 PERFORM DE-LETE. NC2454.2 +045700 PERFORM TEST-WRITE. NC2454.2 +045800* NC2454.2 +045900 SEP-INIT-011. NC2454.2 +046000 MOVE "SEP-TEST-011" TO PAR-NAME. NC2454.2 +046100 MOVE 0 TO TEMP; REC-CT. NC2454.2 +046200 MOVE 135 TO EXPECTED-VALUE. NC2454.2 +046300* THIS TEST USES SEMICOLON, COMMA AND SPACE IN NC2454.2 +046400* REFERENCING 2 AND 3-DIM. TABLES WITH INDEXING. NC2454.2 +046500 SEP-TEST-011-01. NC2454.2 +046600 SET IN1 TO 14. NC2454.2 +046700 SET IN2 TO 5. NC2454.2 +046800 MOVE ELEM2 (IN1; IN2) TO TEMP. NC2454.2 +046900 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047000 SEP-TEST-011-02. NC2454.2 +047100 SET INAME1 TO 3. NC2454.2 +047200 SET INAME2 TO 4. NC2454.2 +047300 SET INAME3 TO 5. NC2454.2 +047400 MOVE ELEM3 (INAME1; INAME2; INAME3) TO TEMP. NC2454.2 +047500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047600 SEP-TEST-011-03. NC2454.2 +047700 MOVE ELEM3 (INAME1, INAME2; INAME3) TO TEMP. NC2454.2 +047800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047900 SEP-TEST-011-04. NC2454.2 +048000 MOVE ELEM3 (INAME1; INAME2 INAME3) TO TEMP. NC2454.2 +048100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048200 SEP-TEST-011-05. NC2454.2 +048300 MOVE ELEM3 (3; INAME2; 5) TO TEMP. NC2454.2 +048400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048500 SEP-TEST-011-06. NC2454.2 +048600 MOVE ELEM3 (3, INAME2; 5) TO TEMP. NC2454.2 +048700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048800 GO TO SEP-INIT-012. NC2454.2 +048900 SEP-DELETE-011. NC2454.2 +049000 PERFORM DE-LETE. NC2454.2 +049100 PERFORM TEST-WRITE. NC2454.2 +049200* NC2454.2 +049300 SEP-INIT-012. NC2454.2 +049400 MOVE "SEP-TEST-012" TO PAR-NAME. NC2454.2 +049500 MOVE ZERO TO TEMP; REC-CT. NC2454.2 +049600 MOVE 123 TO EXPECTED-VALUE. NC2454.2 +049700* THIS TEST USES SEMICOLON, COMMA AND SPACE AS NC2454.2 +049800* SEPARATORS IN REFERENCING 3-DIMENSIONAL TABLE NC2454.2 +049900* ITEMS WITH RELATIVE INDEXING. NC2454.2 +050000 SEP-TEST-012-01. NC2454.2 +050100 SET INAME1; INAME2; INAME3 TO 3. NC2454.2 +050200 SET IN-NAME-1; IN-NAME-2; IN-NAME-3 TO 1. NC2454.2 +050300 MOVE ELEM3 (IN-NAME-1 + 2; INAME2; 3) TO TEMP. NC2454.2 +050400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +050500 SEP-TEST-012-02. NC2454.2 +050600 MOVE ELEM3 (IN-NAME-1 + 2; IN-NAME-2 + 2; NC2454.2 +050700 IN-NAME-3 + 2) TO TEMP. NC2454.2 +050800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +050900 SEP-TEST-012-03. NC2454.2 +051000 MOVE ELEM3 (INAME1; IN-NAME-2 + 2; IN-NAME-3 + 2) NC2454.2 +051100 TO TEMP. NC2454.2 +051200 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +051300 SEP-TEST-012-04. NC2454.2 +051400 MOVE ELEM3 (+3, INAME2; IN-NAME-3 + 2) TO TEMP. NC2454.2 +051500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +051600 GO TO CCVS-EXIT. NC2454.2 +051700 SEP-DELETE-012. NC2454.2 +051800 PERFORM DE-LETE. NC2454.2 +051900 PERFORM TEST-WRITE. NC2454.2 +052000* NC2454.2 +052100 SECT-TH219-0003 SECTION. NC2454.2 +052200* NC2454.2 +052300 TEST-CHECK. NC2454.2 +052400 ADD 1 TO REC-CT. NC2454.2 +052500 IF TEMP IS EQUAL TO EXPECTED-VALUE NC2454.2 +052600 PERFORM PASS NC2454.2 +052700 GO TO TEST-WRITE. NC2454.2 +052800 TEST-FAIL. NC2454.2 +052900 PERFORM FAIL. NC2454.2 +053000 MOVE TEMP TO COMPUTED-18V0. NC2454.2 +053100 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC2454.2 +053200 TEST-WRITE. NC2454.2 +053300 PERFORM PRINT-DETAIL. NC2454.2 +053400 MOVE 0 TO TEMP. NC2454.2 +053500 CCVS-EXIT SECTION. NC2454.2 +053600 CCVS-999999. NC2454.2 +053700 GO TO CLOSE-FILES. NC2454.2 +*END-OF,NC245A +*HEADER,COBOL,NC246A +000100 IDENTIFICATION DIVISION. NC2464.2 +000200 PROGRAM-ID. NC2464.2 +000300 NC246A. NC2464.2 +000400**************************************************************** NC2464.2 +000500* * NC2464.2 +000600* VALIDATION FOR:- * NC2464.2 +000700* * NC2464.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +000900* * NC2464.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2464.2 +001100* * NC2464.2 +001200**************************************************************** NC2464.2 +001300* * NC2464.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2464.2 +001500* * NC2464.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2464.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2464.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2464.2 +001900* * NC2464.2 +002000**************************************************************** NC2464.2 +002100* * NC2464.2 +002200* PROGRAM NC246A TESTS THE USE OF QUALIFIED DATA NAMES AND * NC2464.2 +002300* SUBSCRIPTS WHEN ACCESSING A SEVEN-DIMENSIONAL TABLE. * NC2464.2 +002400* QUALIFIED CONDITION-NAMES AND RELATIVE INDEXING ARE ALSO * NC2464.2 +002500* USED IN ACCESSING THREE-DIMENSIONAL TABLES. * NC2464.2 +002600* * NC2464.2 +002700**************************************************************** NC2464.2 +002800* * NC2464.2 +002900* DATA-NAMES MAY BE QUALIFIED AND THE NUMBER OF QUALIFIERS* NC2464.2 +003000* PERMITTED MUST BE AT LEAST FIVE. WHEN A SUBSCRIPT IS * NC2464.2 +003100* REPRESENTED BY A DATA-NAME, THE DATA-NAME MAY BE QUALIFIED* NC2464.2 +003200* BUT NOT SUBSCRIPTED. * NC2464.2 +003300* * NC2464.2 +003400**************************************************************** NC2464.2 +003500* * NC2464.2 +003600* STATEMENT DELETION INSTRUCTIONS * NC2464.2 +003700* * NC2464.2 +003800* IF THE COMPILER REJECTS ANY OF THE TABLE REFERENCES IN * NC2464.2 +003900* THIS ROUTINE, DELETE THAT LINE OF CODE BY PLACING AN * IN * NC2464.2 +004000* COLUMN 7. LEAVE THE PERFORM STATEMENT. THE TEST ELEMENT * NC2464.2 +004100* DELETED APPEARS AS A FAILURE ON THE OUTPUT REPORT AND THE * NC2464.2 +004200* COMPUTED RESULTS ARE SPACES. * NC2464.2 +004300* * NC2464.2 +004400**************************************************************** NC2464.2 +004500 ENVIRONMENT DIVISION. NC2464.2 +004600 CONFIGURATION SECTION. NC2464.2 +004700 SOURCE-COMPUTER. NC2464.2 +004800 XXXXX082. NC2464.2 +004900 OBJECT-COMPUTER. NC2464.2 +005000 XXXXX083. NC2464.2 +005100 INPUT-OUTPUT SECTION. NC2464.2 +005200 FILE-CONTROL. NC2464.2 +005300 SELECT PRINT-FILE ASSIGN TO NC2464.2 +005400 XXXXX055. NC2464.2 +005500 DATA DIVISION. NC2464.2 +005600 FILE SECTION. NC2464.2 +005700 FD PRINT-FILE. NC2464.2 +005800 01 PRINT-REC PICTURE X(120). NC2464.2 +005900 01 DUMMY-RECORD PICTURE X(120). NC2464.2 +006000 WORKING-STORAGE SECTION. NC2464.2 +006100 01 TABLE-A. NC2464.2 +006200 02 L2 OCCURS 2. NC2464.2 +006300 03 L3 OCCURS 2. NC2464.2 +006400 04 L4 OCCURS 2. NC2464.2 +006500 05 L5 OCCURS 2. NC2464.2 +006600 06 L6 OCCURS 2. NC2464.2 +006700 07 L7 OCCURS 2. NC2464.2 +006800 08 L8 OCCURS 2. NC2464.2 +006900 09 ELEM1 PIC 99. NC2464.2 +007000 09 ELEM2 PIC 99. NC2464.2 +007100 01 TABLE-B. NC2464.2 +007200 02 L2 OCCURS 2. NC2464.2 +007300 03 L3 OCCURS 2. NC2464.2 +007400 04 L4 OCCURS 2. NC2464.2 +007500 05 L5 OCCURS 2. NC2464.2 +007600 06 L6 OCCURS 2. NC2464.2 +007700 07 L7 OCCURS 2. NC2464.2 +007800 08 L8 OCCURS 2. NC2464.2 +007900 09 ELEM1 PIC 99. NC2464.2 +008000 09 ELEM2 PIC 99. NC2464.2 +008100 01 SUBSCRIPTS-GROUP-1. NC2464.2 +008200 02 SO2. NC2464.2 +008300 03 SO3. NC2464.2 +008400 04 SO4. NC2464.2 +008500 05 SO5. NC2464.2 +008600 06 SO6. NC2464.2 +008700 07 SO7. NC2464.2 +008800 08 SO8. NC2464.2 +008900 09 SO9. NC2464.2 +009000 10 S10. NC2464.2 +009100 11 S11. NC2464.2 +009200 12 S12. NC2464.2 +009300 13 S13. NC2464.2 +009400 14 S14. NC2464.2 +009500 15 S15. NC2464.2 +009600 16 S16. NC2464.2 +009700 17 S17. NC2464.2 +009800 18 S18. NC2464.2 +009900 19 S19. NC2464.2 +010000 20 S20. NC2464.2 +010100 21 S21. NC2464.2 +010200 22 S22. NC2464.2 +010300 23 S23. NC2464.2 +010400 24 S24. NC2464.2 +010500 25 S25. NC2464.2 +010600 26 S26. NC2464.2 +010700 27 S27. NC2464.2 +010800 28 S28. NC2464.2 +010900 29 S29. NC2464.2 +011000 30 S30. NC2464.2 +011100 31 S31. NC2464.2 +011200 32 S32. NC2464.2 +011300 33 S33. NC2464.2 +011400 34 S34. NC2464.2 +011500 35 S35. NC2464.2 +011600 36 S36. NC2464.2 +011700 37 S37. NC2464.2 +011800 38 S38. NC2464.2 +011900 39 S39. NC2464.2 +012000 40 S40. NC2464.2 +012100 41 S41. NC2464.2 +012200 42 S42. NC2464.2 +012300 43 S43. NC2464.2 +012400 44 S44. NC2464.2 +012500 45 S45. NC2464.2 +012600 46 S46. NC2464.2 +012700 47 S47. NC2464.2 +012800 48 S48. NC2464.2 +012900 49 SUB1 PIC 9 NC2464.2 +013000 VALUE 1. NC2464.2 +013100 49 SUB2 PIC 9 NC2464.2 +013200 VALUE 1. NC2464.2 +013300 49 SUB3 PIC 9 NC2464.2 +013400 VALUE 1. NC2464.2 +013500 49 SUB4 PIC 9 NC2464.2 +013600 VALUE 1. NC2464.2 +013700 49 SUB5 PIC 9 NC2464.2 +013800 VALUE 1. NC2464.2 +013900 49 SUB6 PIC 9 NC2464.2 +014000 VALUE 1. NC2464.2 +014100 49 SUB7 PIC 9 NC2464.2 +014200 VALUE 1. NC2464.2 +014300 01 SUBSCRIPTS-GROUP-2. NC2464.2 +014400 02 SO2. NC2464.2 +014500 03 SO3. NC2464.2 +014600 04 SO4. NC2464.2 +014700 05 SO5. NC2464.2 +014800 06 SO6. NC2464.2 +014900 07 SO7. NC2464.2 +015000 08 SO8. NC2464.2 +015100 09 SO9. NC2464.2 +015200 10 S10. NC2464.2 +015300 11 S11. NC2464.2 +015400 12 S12. NC2464.2 +015500 13 S13. NC2464.2 +015600 14 S14. NC2464.2 +015700 15 S15. NC2464.2 +015800 16 S16. NC2464.2 +015900 17 S17. NC2464.2 +016000 18 S18. NC2464.2 +016100 19 S19. NC2464.2 +016200 20 S20. NC2464.2 +016300 21 S21. NC2464.2 +016400 22 S22. NC2464.2 +016500 23 S23. NC2464.2 +016600 24 S24. NC2464.2 +016700 25 S25. NC2464.2 +016800 26 S26. NC2464.2 +016900 27 S27. NC2464.2 +017000 28 S28. NC2464.2 +017100 29 S29. NC2464.2 +017200 30 S30. NC2464.2 +017300 31 S31. NC2464.2 +017400 32 S32. NC2464.2 +017500 33 S33. NC2464.2 +017600 34 S34. NC2464.2 +017700 35 S35. NC2464.2 +017800 36 S36. NC2464.2 +017900 37 S37. NC2464.2 +018000 38 S38. NC2464.2 +018100 39 S39. NC2464.2 +018200 40 S40. NC2464.2 +018300 41 S41. NC2464.2 +018400 42 S42. NC2464.2 +018500 43 S43. NC2464.2 +018600 44 S44. NC2464.2 +018700 45 S45. NC2464.2 +018800 46 S46. NC2464.2 +018900 47 S47. NC2464.2 +019000 48 S48. NC2464.2 +019100 49 SUB1 PIC 9 NC2464.2 +019200 VALUE 2. NC2464.2 +019300 49 SUB2 PIC 9 NC2464.2 +019400 VALUE 2. NC2464.2 +019500 49 SUB3 PIC 9 NC2464.2 +019600 VALUE 2. NC2464.2 +019700 49 SUB4 PIC 9 NC2464.2 +019800 VALUE 2. NC2464.2 +019900 49 SUB5 PIC 9 NC2464.2 +020000 VALUE 2. NC2464.2 +020100 49 SUB6 PIC 9 NC2464.2 +020200 VALUE 2. NC2464.2 +020300 49 SUB7 PIC 9 NC2464.2 +020400 VALUE 2. NC2464.2 +020500 01 COMPARISON-VALUES. NC2464.2 +020600 02 EXPECTED-VALUE PICTURE X(6). NC2464.2 +020700 02 TEMP-VALUE PICTURE X(6). NC2464.2 +020800 01 GROUP-1-TABLE. NC2464.2 +020900 02 TABLE-LEVEL-2. NC2464.2 +021000 03 FILLER PIC X(13) VALUE "GROUP-1-TABLE". NC2464.2 +021100 03 TABLE-LEVEL-3. NC2464.2 +021200 04 FILLER PIC X VALUE SPACE. NC2464.2 +021300 04 TABLE-LEVEL-4. NC2464.2 +021400 05 FILLER PIC X VALUE "=". NC2464.2 +021500 05 TABLE-LEVEL-5. NC2464.2 +021600 06 FILLER PIC X VALUE SPACE. NC2464.2 +021700 06 TABLE-ITEM PICTURE X NC2464.2 +021800 OCCURS 15 TIMES NC2464.2 +021900 INDEXED BY IN1. NC2464.2 +022000 88 EQUALS-A VALUE "A". NC2464.2 +022100 88 EQUALS-C VALUE "C". NC2464.2 +022200 88 EQUALS-M VALUE "M". NC2464.2 +022300 05 GROUP-1-ENTRY REDEFINES TABLE-LEVEL-5. NC2464.2 +022400 06 FILLER PIC X(16). NC2464.2 +022500 01 GROUP-2-TABLE. NC2464.2 +022600 02 TABLE-LEVEL-2. NC2464.2 +022700 03 FILLER PIC X(13) VALUE "GROUP-2-TABLE". NC2464.2 +022800 03 TABLE-LEVEL-3. NC2464.2 +022900 04 FILLER PIC X VALUE SPACE. NC2464.2 +023000 04 TABLE-LEVEL-4. NC2464.2 +023100 05 FILLER PIC X VALUE "=". NC2464.2 +023200 05 TABLE-LEVEL-5. NC2464.2 +023300 06 FILLER PIC X VALUE SPACE. NC2464.2 +023400 06 TABLE-ITEM PICTURE X NC2464.2 +023500 OCCURS 12 TIMES NC2464.2 +023600 INDEXED BY IN2. NC2464.2 +023700 88 EQUALS-A VALUE "A". NC2464.2 +023800 88 EQUALS-C VALUE "C". NC2464.2 +023900 88 EQUALS-M VALUE "M". NC2464.2 +024000 05 GROUP-2-ENTRY REDEFINES TABLE-LEVEL-5. NC2464.2 +024100 06 FILLER PIC X(13). NC2464.2 +024200 01 GROUP-3-TABLE. NC2464.2 +024300 02 TABLE-LEVEL-2. NC2464.2 +024400 03 FILLER PIC X(15) VALUE "GROUP-3-TABLE =". NC2464.2 +024500 03 TABLE-LEVEL-3. NC2464.2 +024600 04 TABLE-LEVEL-4 NC2464.2 +024700 OCCURS 2 TIMES NC2464.2 +024800 INDEXED BY IN3. NC2464.2 +024900 05 TABLE-LEVEL-5 NC2464.2 +025000 OCCURS 2 TIMES NC2464.2 +025100 INDEXED BY IN4. NC2464.2 +025200 06 TABLE-ITEM PICTURE X NC2464.2 +025300 OCCURS 4 TIMES NC2464.2 +025400 INDEXED BY IN5. NC2464.2 +025500 88 EQUALS-A VALUE "A". NC2464.2 +025600 88 EQUALS-C VALUE "C". NC2464.2 +025700 88 EQUALS-M VALUE "M". NC2464.2 +025800 03 GROUP-3-ENTRY REDEFINES TABLE-LEVEL-3. NC2464.2 +025900 06 FILLER PIC X(16). NC2464.2 +026000 01 GROUP-4-TABLE. NC2464.2 +026100 02 UNQUAL-TABLE-2. NC2464.2 +026200 03 UNQUAL-TABLE-3. NC2464.2 +026300 04 UNQUAL-TABLE-4. NC2464.2 +026400 05 FILLER PIC X(15) VALUE "GROUP-4-TABLE =". NC2464.2 +026500 05 UNQUAL-TABLE-5. NC2464.2 +026600 06 UNQUAL-ITEM PIC X NC2464.2 +026700 OCCURS 15 TIMES. NC2464.2 +026800 01 GROUP-5-TABLE. NC2464.2 +026900 02 TABLE5-LEVEL-2. NC2464.2 +027000 03 FILLER PIC X(15) VALUE "GROUP-5-TABLE =". NC2464.2 +027100 03 TABLE5-LEVEL-3. NC2464.2 +027200 04 TABLE5-LEVEL-4 OCCURS 2 TIMES. NC2464.2 +027300 05 TABLE5-LEVEL-5 OCCURS 2 TIMES. NC2464.2 +027400 06 TABLE5-ITEM-UNQUAL PIC X NC2464.2 +027500 OCCURS 4 TIMES. NC2464.2 +027600 01 FIRST-SUB PIC 99 VALUE 1. NC2464.2 +027700 01 FOURTH-SUB PIC 99 VALUE 4. NC2464.2 +027800 01 UNQUAL-SUB PIC 99. NC2464.2 +027900 01 SUBSCRIPTS-PART1. NC2464.2 +028000 02 SUBSCRIPTS. NC2464.2 +028100 03 SUB1 PIC 9 VALUE 5. NC2464.2 +028200 03 SUB2 PIC 99 VALUE 12. NC2464.2 +028300 03 SUB3 PIC 999 USAGE COMP VALUE 1. NC2464.2 +028400 02 SOME-MORE-SUBSCRIPTS. NC2464.2 +028500 03 SUB1 PIC 9 USAGE COMP VALUE 3. NC2464.2 +028600 03 SUB2 PIC 99 USAGE COMP VALUE 7. NC2464.2 +028700 03 SUB3 PIC 999 VALUE 15. NC2464.2 +028800 01 SUBSCRIPTS-PART2. NC2464.2 +028900 02 SUB-PART2-LEVEL2. NC2464.2 +029000 03 SUB-PART2-LEVEL3. NC2464.2 +029100 04 SUB-PART2-LEVEL4. NC2464.2 +029200 05 SUBSCRIPTS. NC2464.2 +029300 06 SUB1 PIC 999 VALUE 5. NC2464.2 +029400 06 SUB2 PIC 99 VALUE 12. NC2464.2 +029500 06 SUB3 PIC 99 USAGE COMP VALUE 1. NC2464.2 +029600 03 SOME-MORE-SUBSCRIPTS. NC2464.2 +029700 04 SUB1 PIC 999 USAGE COMP VALUE 3. NC2464.2 +029800 04 SUB2 PIC 99 VALUE 7. NC2464.2 +029900 04 SUB3 PIC 99 USAGE COMP VALUE 15. NC2464.2 +030000 01 TEST-RESULTS. NC2464.2 +030100 02 FILLER PIC X VALUE SPACE. NC2464.2 +030200 02 FEATURE PIC X(20) VALUE SPACE. NC2464.2 +030300 02 FILLER PIC X VALUE SPACE. NC2464.2 +030400 02 P-OR-F PIC X(5) VALUE SPACE. NC2464.2 +030500 02 FILLER PIC X VALUE SPACE. NC2464.2 +030600 02 PAR-NAME. NC2464.2 +030700 03 FILLER PIC X(19) VALUE SPACE. NC2464.2 +030800 03 PARDOT-X PIC X VALUE SPACE. NC2464.2 +030900 03 DOTVALUE PIC 99 VALUE ZERO. NC2464.2 +031000 02 FILLER PIC X(8) VALUE SPACE. NC2464.2 +031100 02 RE-MARK PIC X(61). NC2464.2 +031200 01 TEST-COMPUTED. NC2464.2 +031300 02 FILLER PIC X(30) VALUE SPACE. NC2464.2 +031400 02 FILLER PIC X(17) VALUE NC2464.2 +031500 " COMPUTED=". NC2464.2 +031600 02 COMPUTED-X. NC2464.2 +031700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2464.2 +031800 03 COMPUTED-N REDEFINES COMPUTED-A NC2464.2 +031900 PIC -9(9).9(9). NC2464.2 +032000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2464.2 +032100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2464.2 +032200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2464.2 +032300 03 CM-18V0 REDEFINES COMPUTED-A. NC2464.2 +032400 04 COMPUTED-18V0 PIC -9(18). NC2464.2 +032500 04 FILLER PIC X. NC2464.2 +032600 03 FILLER PIC X(50) VALUE SPACE. NC2464.2 +032700 01 TEST-CORRECT. NC2464.2 +032800 02 FILLER PIC X(30) VALUE SPACE. NC2464.2 +032900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2464.2 +033000 02 CORRECT-X. NC2464.2 +033100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2464.2 +033200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2464.2 +033300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2464.2 +033400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2464.2 +033500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2464.2 +033600 03 CR-18V0 REDEFINES CORRECT-A. NC2464.2 +033700 04 CORRECT-18V0 PIC -9(18). NC2464.2 +033800 04 FILLER PIC X. NC2464.2 +033900 03 FILLER PIC X(2) VALUE SPACE. NC2464.2 +034000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2464.2 +034100 01 CCVS-C-1. NC2464.2 +034200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2464.2 +034300- "SS PARAGRAPH-NAME NC2464.2 +034400- " REMARKS". NC2464.2 +034500 02 FILLER PIC X(20) VALUE SPACE. NC2464.2 +034600 01 CCVS-C-2. NC2464.2 +034700 02 FILLER PIC X VALUE SPACE. NC2464.2 +034800 02 FILLER PIC X(6) VALUE "TESTED". NC2464.2 +034900 02 FILLER PIC X(15) VALUE SPACE. NC2464.2 +035000 02 FILLER PIC X(4) VALUE "FAIL". NC2464.2 +035100 02 FILLER PIC X(94) VALUE SPACE. NC2464.2 +035200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2464.2 +035300 01 REC-CT PIC 99 VALUE ZERO. NC2464.2 +035400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2464.2 +035900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2464.2 +036000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2464.2 +036100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2464.2 +036200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2464.2 +036300 01 CCVS-H-1. NC2464.2 +036400 02 FILLER PIC X(39) VALUE SPACES. NC2464.2 +036500 02 FILLER PIC X(42) VALUE NC2464.2 +036600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2464.2 +036700 02 FILLER PIC X(39) VALUE SPACES. NC2464.2 +036800 01 CCVS-H-2A. NC2464.2 +036900 02 FILLER PIC X(40) VALUE SPACE. NC2464.2 +037000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2464.2 +037100 02 FILLER PIC XXXX VALUE NC2464.2 +037200 "4.2 ". NC2464.2 +037300 02 FILLER PIC X(28) VALUE NC2464.2 +037400 " COPY - NOT FOR DISTRIBUTION". NC2464.2 +037500 02 FILLER PIC X(41) VALUE SPACE. NC2464.2 +037600 NC2464.2 +037700 01 CCVS-H-2B. NC2464.2 +037800 02 FILLER PIC X(15) VALUE NC2464.2 +037900 "TEST RESULT OF ". NC2464.2 +038000 02 TEST-ID PIC X(9). NC2464.2 +038100 02 FILLER PIC X(4) VALUE NC2464.2 +038200 " IN ". NC2464.2 +038300 02 FILLER PIC X(12) VALUE NC2464.2 +038400 " HIGH ". NC2464.2 +038500 02 FILLER PIC X(22) VALUE NC2464.2 +038600 " LEVEL VALIDATION FOR ". NC2464.2 +038700 02 FILLER PIC X(58) VALUE NC2464.2 +038800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +038900 01 CCVS-H-3. NC2464.2 +039000 02 FILLER PIC X(34) VALUE NC2464.2 +039100 " FOR OFFICIAL USE ONLY ". NC2464.2 +039200 02 FILLER PIC X(58) VALUE NC2464.2 +039300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2464.2 +039400 02 FILLER PIC X(28) VALUE NC2464.2 +039500 " COPYRIGHT 1985 ". NC2464.2 +039600 01 CCVS-E-1. NC2464.2 +039700 02 FILLER PIC X(52) VALUE SPACE. NC2464.2 +039800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2464.2 +039900 02 ID-AGAIN PIC X(9). NC2464.2 +040000 02 FILLER PIC X(45) VALUE SPACES. NC2464.2 +040100 01 CCVS-E-2. NC2464.2 +040200 02 FILLER PIC X(31) VALUE SPACE. NC2464.2 +040300 02 FILLER PIC X(21) VALUE SPACE. NC2464.2 +040400 02 CCVS-E-2-2. NC2464.2 +040500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2464.2 +040600 03 FILLER PIC X VALUE SPACE. NC2464.2 +040700 03 ENDER-DESC PIC X(44) VALUE NC2464.2 +040800 "ERRORS ENCOUNTERED". NC2464.2 +040900 01 CCVS-E-3. NC2464.2 +041000 02 FILLER PIC X(22) VALUE NC2464.2 +041100 " FOR OFFICIAL USE ONLY". NC2464.2 +041200 02 FILLER PIC X(12) VALUE SPACE. NC2464.2 +041300 02 FILLER PIC X(58) VALUE NC2464.2 +041400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +041500 02 FILLER PIC X(13) VALUE SPACE. NC2464.2 +041600 02 FILLER PIC X(15) VALUE NC2464.2 +041700 " COPYRIGHT 1985". NC2464.2 +041800 01 CCVS-E-4. NC2464.2 +041900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2464.2 +042000 02 FILLER PIC X(4) VALUE " OF ". NC2464.2 +042100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2464.2 +042200 02 FILLER PIC X(40) VALUE NC2464.2 +042300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2464.2 +042400 01 XXINFO. NC2464.2 +042500 02 FILLER PIC X(19) VALUE NC2464.2 +042600 "*** INFORMATION ***". NC2464.2 +042700 02 INFO-TEXT. NC2464.2 +042800 04 FILLER PIC X(8) VALUE SPACE. NC2464.2 +042900 04 XXCOMPUTED PIC X(20). NC2464.2 +043000 04 FILLER PIC X(5) VALUE SPACE. NC2464.2 +043100 04 XXCORRECT PIC X(20). NC2464.2 +043200 02 INF-ANSI-REFERENCE PIC X(48). NC2464.2 +043300 01 HYPHEN-LINE. NC2464.2 +043400 02 FILLER PIC IS X VALUE IS SPACE. NC2464.2 +043500 02 FILLER PIC IS X(65) VALUE IS "************************NC2464.2 +043600- "*****************************************". NC2464.2 +043700 02 FILLER PIC IS X(54) VALUE IS "************************NC2464.2 +043800- "******************************". NC2464.2 +043900 01 CCVS-PGM-ID PIC X(9) VALUE NC2464.2 +044000 "NC246A". NC2464.2 +044100 PROCEDURE DIVISION. NC2464.2 +044200 CCVS1 SECTION. NC2464.2 +044300 OPEN-FILES. NC2464.2 +044400 OPEN OUTPUT PRINT-FILE. NC2464.2 +044500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2464.2 +044600 MOVE SPACE TO TEST-RESULTS. NC2464.2 +044700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2464.2 +044800 GO TO CCVS1-EXIT. NC2464.2 +044900 CLOSE-FILES. NC2464.2 +045000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2464.2 +045100 TERMINATE-CCVS. NC2464.2 +045200S EXIT PROGRAM. NC2464.2 +045300STERMINATE-CALL. NC2464.2 +045400 STOP RUN. NC2464.2 +045500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2464.2 +045600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2464.2 +045700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2464.2 +045800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2464.2 +045900 MOVE "****TEST DELETED****" TO RE-MARK. NC2464.2 +046000 PRINT-DETAIL. NC2464.2 +046100 IF REC-CT NOT EQUAL TO ZERO NC2464.2 +046200 MOVE "." TO PARDOT-X NC2464.2 +046300 MOVE REC-CT TO DOTVALUE. NC2464.2 +046400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2464.2 +046500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2464.2 +046600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2464.2 +046700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2464.2 +046800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2464.2 +046900 MOVE SPACE TO CORRECT-X. NC2464.2 +047000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2464.2 +047100 MOVE SPACE TO RE-MARK. NC2464.2 +047200 HEAD-ROUTINE. NC2464.2 +047300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +047400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +047500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2464.2 +047600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2464.2 +047700 COLUMN-NAMES-ROUTINE. NC2464.2 +047800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +047900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +048100 END-ROUTINE. NC2464.2 +048200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2464.2 +048300 END-RTN-EXIT. NC2464.2 +048400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +048500 END-ROUTINE-1. NC2464.2 +048600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2464.2 +048700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2464.2 +048800 ADD PASS-COUNTER TO ERROR-HOLD. NC2464.2 +048900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2464.2 +049000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2464.2 +049100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2464.2 +049200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2464.2 +049300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2464.2 +049400 END-ROUTINE-12. NC2464.2 +049500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2464.2 +049600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2464.2 +049700 MOVE "NO " TO ERROR-TOTAL NC2464.2 +049800 ELSE NC2464.2 +049900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2464.2 +050000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2464.2 +050100 PERFORM WRITE-LINE. NC2464.2 +050200 END-ROUTINE-13. NC2464.2 +050300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2464.2 +050400 MOVE "NO " TO ERROR-TOTAL ELSE NC2464.2 +050500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2464.2 +050600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2464.2 +050700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +050800 IF INSPECT-COUNTER EQUAL TO ZERO NC2464.2 +050900 MOVE "NO " TO ERROR-TOTAL NC2464.2 +051000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2464.2 +051100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2464.2 +051200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +051300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +051400 WRITE-LINE. NC2464.2 +051500 ADD 1 TO RECORD-COUNT. NC2464.2 +051600Y IF RECORD-COUNT GREATER 50 NC2464.2 +051700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2464.2 +051800Y MOVE SPACE TO DUMMY-RECORD NC2464.2 +051900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2464.2 +052000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2464.2 +052100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2464.2 +052200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2464.2 +052300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2464.2 +052400Y MOVE ZERO TO RECORD-COUNT. NC2464.2 +052500 PERFORM WRT-LN. NC2464.2 +052600 WRT-LN. NC2464.2 +052700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2464.2 +052800 MOVE SPACE TO DUMMY-RECORD. NC2464.2 +052900 BLANK-LINE-PRINT. NC2464.2 +053000 PERFORM WRT-LN. NC2464.2 +053100 FAIL-ROUTINE. NC2464.2 +053200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2464.2 +053300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2464.2 +053400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2464.2 +053500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2464.2 +053600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +053700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2464.2 +053800 GO TO FAIL-ROUTINE-EX. NC2464.2 +053900 FAIL-ROUTINE-WRITE. NC2464.2 +054000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2464.2 +054100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2464.2 +054200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2464.2 +054300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2464.2 +054400 FAIL-ROUTINE-EX. EXIT. NC2464.2 +054500 BAIL-OUT. NC2464.2 +054600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2464.2 +054700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2464.2 +054800 BAIL-OUT-WRITE. NC2464.2 +054900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2464.2 +055000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2464.2 +055100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +055200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2464.2 +055300 BAIL-OUT-EX. EXIT. NC2464.2 +055400 CCVS1-EXIT. NC2464.2 +055500 EXIT. NC2464.2 +055600 SECT-NC246A-001 SECTION. NC2464.2 +055700* NC2464.2 +055800 TABLE-INIT. NC2464.2 +055900 MOVE "INIT-TABLE" TO PAR-NAME. NC2464.2 +056000 MOVE "STORE TABLE VALUES" TO FEATURE. NC2464.2 +056100* NC2464.2 +056200* THIS SECTION STORES THE LETTERS OF THE ALPHABET IN THE NC2464.2 +056300* THREE TABLES WHOSE ITEMS ARE REFERENCED IN THE QUALIFICATION NC2464.2 +056400* TESTS IN THIS ROUTINE. THE TABLE CONTENTS ARE AS FOLLOWS NC2464.2 +056500* GROUP-1-TABLE A,B,...,O. NC2464.2 +056600* GROUP-2-TABLE L,K,J,...,B,A. NC2464.2 +056700* GROUP-3-TABLE A,B,...,O,P. NC2464.2 +056800* GROUP-4-TABLE A,B,...,O. NC2464.2 +056900* GROUP-5-TABLE P,O,N,...,B,A. NC2464.2 +057000* THE TABLES ARE ALSO PRINTED ON THE OUTPUT REPORT. NC2464.2 +057100* NC2464.2 +057200 MOVE " ABCDEFGHIJKLMNO" TO GROUP-1-ENTRY. NC2464.2 +057300 MOVE " LKJIHGFEDCBA" TO GROUP-2-ENTRY. NC2464.2 +057400 MOVE "ABCDEFGHIJKLMNOP" TO GROUP-3-ENTRY. NC2464.2 +057500 MOVE "ABCDEFGHIJKLMNO" TO UNQUAL-TABLE-5. NC2464.2 +057600 MOVE "PONMLKJIHGFEDCBA" TO TABLE5-LEVEL-3. NC2464.2 +057700* NC2464.2 +057800 TABLE-PRINT. NC2464.2 +057900 MOVE GROUP-1-TABLE TO RE-MARK. NC2464.2 +058000 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +058100 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC2464.2 +058200 MOVE 1 TO REC-CT. NC2464.2 +058300 PERFORM PRINT-DETAIL. NC2464.2 +058400 MOVE GROUP-2-TABLE TO RE-MARK. NC2464.2 +058500 MOVE "LKJIHGFEDCBA" TO CORRECT-A. NC2464.2 +058600 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +058700 MOVE 2 TO REC-CT. NC2464.2 +058800 PERFORM PRINT-DETAIL. NC2464.2 +058900 MOVE GROUP-3-TABLE TO RE-MARK. NC2464.2 +059000 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-A. NC2464.2 +059100 MOVE 3 TO REC-CT. NC2464.2 +059200 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +059300 PERFORM PRINT-DETAIL. NC2464.2 +059400 MOVE GROUP-4-TABLE TO RE-MARK. NC2464.2 +059500 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC2464.2 +059600 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +059700 MOVE 4 TO REC-CT. NC2464.2 +059800 PERFORM PRINT-DETAIL. NC2464.2 +059900 MOVE GROUP-5-TABLE TO RE-MARK. NC2464.2 +060000 MOVE "PONMLKJIHGFEDCBA" TO CORRECT-A. NC2464.2 +060100 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +060200 MOVE 5 TO REC-CT. NC2464.2 +060300 PERFORM PRINT-DETAIL. NC2464.2 +060400* NC2464.2 +060500 QUAL-TEST-01. NC2464.2 +060600 MOVE ZERO TO REC-CT. NC2464.2 +060700 MOVE SPACE TO TEMP-VALUE. NC2464.2 +060800 MOVE "QUAL-TEST-01" TO PAR-NAME. NC2464.2 +060900 MOVE "QUALIFIED TABLE ITEM" TO FEATURE. NC2464.2 +061000 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +061100 MOVE "A" TO EXPECTED-VALUE. NC2464.2 +061200* NC2464.2 +061300* THIS TEST CONTAINS QUALIFIED DATA NAMES IN MOVE NC2464.2 +061400* STATEMENTS. THE DATA NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +061500* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +061600* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +061700* INDEXING ARE USED. NC2464.2 +061800* NC2464.2 +061900 QUAL-TEST-01-01. NC2464.2 +062000 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +062100 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +062200 OF GROUP-1-TABLE (1) TO TEMP-VALUE. NC2464.2 +062300 PERFORM SECT-TH220-0003. NC2464.2 +062400* NC2464.2 +062500 QUAL-TEST-01-02. NC2464.2 +062600 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +062700 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +062800 OF GROUP-1-TABLE (FIRST-SUB) TO TEMP-VALUE. NC2464.2 +062900 PERFORM SECT-TH220-0003. NC2464.2 +063000* NC2464.2 +063100 QUAL-TEST-01-03. NC2464.2 +063200 SET IN1 TO 1. NC2464.2 +063300 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +063400 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +063500 OF GROUP-1-TABLE (IN1) TO TEMP-VALUE. NC2464.2 +063600 PERFORM SECT-TH220-0003. NC2464.2 +063700* NC2464.2 +063800 QUAL-TEST-01-04. NC2464.2 +063900 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +064000 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +064100 OF GROUP-2-TABLE (12) TO TEMP-VALUE. NC2464.2 +064200 PERFORM SECT-TH220-0003. NC2464.2 +064300* NC2464.2 +064400 QUAL-TEST-01-05. NC2464.2 +064500 SET IN1 TO 1. NC2464.2 +064600 MOVE "D" TO EXPECTED-VALUE. NC2464.2 +064700 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +064800 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +064900 OF GROUP-1-TABLE (IN1 + 3) TO TEMP-VALUE. NC2464.2 +065000 PERFORM SECT-TH220-0003. NC2464.2 +065100* NC2464.2 +065200 QUAL-TEST-01-06. NC2464.2 +065300 SET IN1 TO 6. NC2464.2 +065400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +065500 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +065600 OF GROUP-1-TABLE (IN1 - 2) TO TEMP-VALUE. NC2464.2 +065700 PERFORM SECT-TH220-0003. NC2464.2 +065800* NC2464.2 +065900 QUAL-TEST-01-07. NC2464.2 +066000 MOVE 9 TO UNQUAL-SUB. NC2464.2 +066100 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +066200 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +066300 OF GROUP-2-TABLE (UNQUAL-SUB) TO TEMP-VALUE. NC2464.2 +066400 PERFORM SECT-TH220-0003. NC2464.2 +066500 GO TO QUAL-TEST-02. NC2464.2 +066600* NC2464.2 +066700 QUAL-DELETE-001. NC2464.2 +066800 PERFORM DE-LETE. NC2464.2 +066900 PERFORM PRINT-DETAIL. NC2464.2 +067000* NC2464.2 +067100 QUAL-TEST-02. NC2464.2 +067200 MOVE ZERO TO REC-CT. NC2464.2 +067300 MOVE "QUAL-TEST-02" TO PAR-NAME. NC2464.2 +067400 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +067500* NC2464.2 +067600* THIS TEST CONTAINS TWO QUALIFIED DATA NAMES IN IF NC2464.2 +067700* STATEMENTS. THE DATA NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +067800* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +067900* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +068000* INDEXING ARE USED. NC2464.2 +068100* NC2464.2 +068200 QUAL-TEST-02-01. NC2464.2 +068300 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +068400 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +068500 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +068600 IN GROUP-1-TABLE (1) IS EQUAL TO NC2464.2 +068700 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +068800 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +068900 IN GROUP-2-TABLE (12) NC2464.2 +069000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +069100 PERFORM SECT-TH220-0003. NC2464.2 +069200* NC2464.2 +069300 QUAL-TEST-02-02. NC2464.2 +069400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +069500 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +069600 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +069700 IN GROUP-1-TABLE (FIRST-SUB) IS NOT EQUAL TO NC2464.2 +069800 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +069900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +070000 IN GROUP-2-TABLE (FIRST-SUB) NC2464.2 +070100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +070200 PERFORM SECT-TH220-0003. NC2464.2 +070300* NC2464.2 +070400 QUAL-TEST-02-03. NC2464.2 +070500 SET IN1 TO 4. NC2464.2 +070600 SET IN2 TO 9. NC2464.2 +070700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +070800 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +070900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +071000 IN GROUP-1-TABLE (IN1) IS EQUAL TO NC2464.2 +071100 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +071200 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +071300 IN GROUP-2-TABLE (IN2) NC2464.2 +071400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +071500 PERFORM SECT-TH220-0003. NC2464.2 +071600* NC2464.2 +071700 QUAL-TEST-02-04. NC2464.2 +071800 SET IN1 IN2 TO 5. NC2464.2 +071900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +072000 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +072100 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +072200 IN GROUP-1-TABLE (IN1 - 1) EQUAL TO NC2464.2 +072300 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +072400 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +072500 IN GROUP-2-TABLE (IN2 + 4) NC2464.2 +072600 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +072700 PERFORM SECT-TH220-0003. NC2464.2 +072800* NC2464.2 +072900 QUAL-TEST-02-05. NC2464.2 +073000 SET IN1 TO 5. NC2464.2 +073100 MOVE 8 TO UNQUAL-SUB. NC2464.2 +073200 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +073300 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +073400 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +073500 IN GROUP-1-TABLE (IN1) EQUAL TO NC2464.2 +073600 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +073700 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +073800 IN GROUP-2-TABLE (UNQUAL-SUB) NC2464.2 +073900 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +074000 PERFORM SECT-TH220-0003. NC2464.2 +074100 GO TO QUAL-INIT-03. NC2464.2 +074200* NC2464.2 +074300 QUAL-DELETE-002. NC2464.2 +074400 PERFORM DE-LETE. NC2464.2 +074500 PERFORM PRINT-DETAIL. NC2464.2 +074600* NC2464.2 +074700 QUAL-INIT-03. NC2464.2 +074800 MOVE ZERO TO REC-CT. NC2464.2 +074900 MOVE "QUAL-TEST-03" TO PAR-NAME. NC2464.2 +075000 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +075100 MOVE SPACE TO TEMP-VALUE. NC2464.2 +075200 MOVE "D" TO EXPECTED-VALUE. NC2464.2 +075300* NC2464.2 +075400* THIS TEST CONTAINS QUALIFIED DATA NAMES IN MOVE NC2464.2 +075500* STATEMENTS. THE DATA NAMES REFER TO THREE DIMENSIONAL NC2464.2 +075600* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +075700* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +075800* INDEXING ARE USED. NC2464.2 +075900* NC2464.2 +076000* NC2464.2 +076100 QUAL-TEST-03-01. NC2464.2 +076200 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +076300 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +076400 OF GROUP-3-TABLE (1, 1, 4) TO TEMP-VALUE. NC2464.2 +076500 PERFORM SECT-TH220-0003. NC2464.2 +076600* NC2464.2 +076700 QUAL-TEST-03-02. NC2464.2 +076800 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +076900 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +077000 OF GROUP-3-TABLE (FIRST-SUB, FIRST-SUB, FOURTH-SUB) NC2464.2 +077100 TO TEMP-VALUE. NC2464.2 +077200 PERFORM SECT-TH220-0003. NC2464.2 +077300* NC2464.2 +077400 QUAL-TEST-03-03. NC2464.2 +077500 SET IN5 TO 4. NC2464.2 +077600 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +077700 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +077800 OF GROUP-3-TABLE (1, 1, IN5) TO TEMP-VALUE. NC2464.2 +077900 PERFORM SECT-TH220-0003. NC2464.2 +078000* NC2464.2 +078100 QUAL-TEST-03-04. NC2464.2 +078200 SET IN3, IN4 TO 1. NC2464.2 +078300 SET IN5 TO 4. NC2464.2 +078400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +078500 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +078600 OF GROUP-3-TABLE (IN3, IN4, IN5) TO TEMP-VALUE. NC2464.2 +078700 PERFORM SECT-TH220-0003. NC2464.2 +078800* NC2464.2 +078900 QUAL-TEST-03-05. NC2464.2 +079000 SET IN3, IN4 TO 2. NC2464.2 +079100 SET IN5 TO 1. NC2464.2 +079200 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +079300 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +079400 IN GROUP-3-TABLE (IN3 - 1, IN4 - 1, IN5 + 3) NC2464.2 +079500 TO TEMP-VALUE. NC2464.2 +079600 PERFORM SECT-TH220-0003. NC2464.2 +079700 GO TO QUAL-INIT-04. NC2464.2 +079800* NC2464.2 +079900 QUAL-DELETE-003. NC2464.2 +080000 PERFORM DE-LETE. NC2464.2 +080100 PERFORM PRINT-DETAIL. NC2464.2 +080200* NC2464.2 +080300 QUAL-INIT-04. NC2464.2 +080400 MOVE "QUAL-TEST-04" TO PAR-NAME. NC2464.2 +080500 MOVE ZERO TO REC-CT. NC2464.2 +080600 MOVE "QUALIFIED SUBSCRIPT" TO FEATURE. NC2464.2 +080700 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +080800 MOVE SPACE TO TEMP-VALUE. NC2464.2 +080900* NC2464.2 +081000* THIS TEST CONTAINS UNQUALIFIED DATA NAMES WITH NC2464.2 +081100* QUALIFIED SUBSCRIPTS IN MOVE STATEMENTS. THE DATA NAMES NC2464.2 +081200* REFER TO SINGLE DIMENSIONAL TABLE ITEMS. NC2464.2 +081300* NC2464.2 +081400 MOVE "E" TO EXPECTED-VALUE. NC2464.2 +081500* NC2464.2 +081600 QUAL-TEST-04-01. NC2464.2 +081700 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUBSCRIPTS-PART1) NC2464.2 +081800 TO TEMP-VALUE. NC2464.2 +081900 PERFORM SECT-TH220-0003. NC2464.2 +082000* NC2464.2 +082100 QUAL-TEST-04-02. NC2464.2 +082200 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUB-PART2-LEVEL4) NC2464.2 +082300 TO TEMP-VALUE. NC2464.2 +082400 PERFORM SECT-TH220-0003. NC2464.2 +082500* NC2464.2 +082600 QUAL-TEST-04-03. NC2464.2 +082700 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUB-PART2-LEVEL4 NC2464.2 +082800 OF SUB-PART2-LEVEL3 IN SUB-PART2-LEVEL2 NC2464.2 +082900 IN SUBSCRIPTS-PART2) NC2464.2 +083000 TO TEMP-VALUE. NC2464.2 +083100 PERFORM SECT-TH220-0003. NC2464.2 +083200* NC2464.2 +083300 QUAL-TEST-04-04. NC2464.2 +083400 MOVE "C" TO EXPECTED-VALUE. NC2464.2 +083500 MOVE UNQUAL-ITEM (SUB1 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +083600 SUBSCRIPTS-PART1) NC2464.2 +083700 TO TEMP-VALUE. NC2464.2 +083800 PERFORM SECT-TH220-0003. NC2464.2 +083900* NC2464.2 +084000 QUAL-TEST-04-05. NC2464.2 +084100 MOVE "G" TO EXPECTED-VALUE. NC2464.2 +084200 MOVE UNQUAL-ITEM (SUB2 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +084300 SUB-PART2-LEVEL2) NC2464.2 +084400 TO TEMP-VALUE. NC2464.2 +084500 PERFORM SECT-TH220-0003. NC2464.2 +084600 GO TO QUAL-INIT-05. NC2464.2 +084700* NC2464.2 +084800 QUAL-DELETE-004. NC2464.2 +084900 PERFORM DE-LETE. NC2464.2 +085000 PERFORM PRINT-DETAIL. NC2464.2 +085100* NC2464.2 +085200 QUAL-INIT-05. NC2464.2 +085300 MOVE "QUAL-TEST-05" TO PAR-NAME. NC2464.2 +085400 MOVE ZERO TO REC-CT. NC2464.2 +085500 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +085600* NC2464.2 +085700* THIS TEST CONTAINS UNQUALIFIED DATA NAMES WITH NC2464.2 +085800* QUALIFIED SUBSCRIPTS IN MOVE STATEMENTS. THE DATA NAMES NC2464.2 +085900* REFER TO THREE DIMENSIONAL TABLE ITEMS. NC2464.2 +086000* NC2464.2 +086100 MOVE SPACE TO TEMP-VALUE. NC2464.2 +086200 MOVE "N" TO EXPECTED-VALUE. NC2464.2 +086300* NC2464.2 +086400 QUAL-TEST-05-01. NC2464.2 +086500 MOVE TABLE5-ITEM-UNQUAL (FIRST-SUB FIRST-SUB NC2464.2 +086600 SUB1 OF SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +086700 IN SUBSCRIPTS-PART2) NC2464.2 +086800 TO TEMP-VALUE. NC2464.2 +086900 PERFORM SECT-TH220-0003. NC2464.2 +087000* NC2464.2 +087100 QUAL-TEST-05-02. NC2464.2 +087200 MOVE TABLE5-ITEM-UNQUAL (SUB3 OF SUBSCRIPTS OF NC2464.2 +087300 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS OF NC2464.2 +087400 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +087500 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2 NC2464.2 +087600 SUB1 OF SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +087700 IN SUBSCRIPTS-PART2) NC2464.2 +087800 TO TEMP-VALUE. NC2464.2 +087900 PERFORM SECT-TH220-0003. NC2464.2 +088000 GO TO QUAL-INIT-06. NC2464.2 +088100* NC2464.2 +088200 QUAL-DELETE-005. NC2464.2 +088300 PERFORM DE-LETE. NC2464.2 +088400 PERFORM PRINT-DETAIL. NC2464.2 +088500* NC2464.2 +088600 QUAL-INIT-06. NC2464.2 +088700 MOVE "QUAL-TEST-06" TO PAR-NAME. NC2464.2 +088800 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +088900 MOVE ZERO TO REC-CT. NC2464.2 +089000* NC2464.2 +089100* THIS TEST CONTAINS QUALIFIED DATA NAMES WITH NC2464.2 +089200* QUALIFIED SUBSCRIPTS IN IF STATEMENTS. THE DATA NAMES NC2464.2 +089300* REFER TO SINGLE DIMENSIONAL TABLE ITEMS. NC2464.2 +089400* NC2464.2 +089500 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +089600* NC2464.2 +089700 QUAL-TEST-06-01. NC2464.2 +089800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +089900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +090000 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +090100 OF GROUP-1-TABLE (SUB3 IN SOME-MORE-SUBSCRIPTS NC2464.2 +090200 IN SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +090300 IS EQUAL TO "O" NC2464.2 +090400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +090500 PERFORM SECT-TH220-0003. NC2464.2 +090600* NC2464.2 +090700 QUAL-TEST-06-02. NC2464.2 +090800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +090900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +091000 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +091100 OF GROUP-1-TABLE (SUB2 OF SUBSCRIPTS OF NC2464.2 +091200 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +091300 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +091400 IS EQUAL TO TABLE-ITEM OF TABLE-LEVEL-5 NC2464.2 +091500 IN TABLE-LEVEL-4 OF TABLE-LEVEL-3 IN NC2464.2 +091600 TABLE-LEVEL-2 OF GROUP-2-TABLE (SUB3 IN SUBSCRIPTS NC2464.2 +091700 OF SUBSCRIPTS-PART1) NC2464.2 +091800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +091900 PERFORM SECT-TH220-0003. NC2464.2 +092000 GO TO QUAL-INIT-07. NC2464.2 +092100* NC2464.2 +092200 QUAL-DELETE-006. NC2464.2 +092300 PERFORM DE-LETE. NC2464.2 +092400 PERFORM PRINT-DETAIL. NC2464.2 +092500* NC2464.2 +092600 QUAL-INIT-07. NC2464.2 +092700 MOVE "QUAL-TEST-07" TO PAR-NAME. NC2464.2 +092800 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +092900 MOVE ZERO TO REC-CT. NC2464.2 +093000* NC2464.2 +093100* THIS TEST CONTAINS QUALIFIED DATA NAMES WITH NC2464.2 +093200* QUALIFIED SUBSCRIPTS IN IF STATEMENTS. THE DATA NAMES NC2464.2 +093300* REFER TO THREE DIMENSIONAL TABLE ITEMS. NC2464.2 +093400* NC2464.2 +093500 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +093600* NC2464.2 +093700 QUAL-TEST-07-01. NC2464.2 +093800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +093900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +094000 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +094100 IN GROUP-3-TABLE (SUB3 IN SUBSCRIPTS IN NC2464.2 +094200 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS OF NC2464.2 +094300 SUBSCRIPTS-PART1 SUB1 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +094400 SUBSCRIPTS-PART1) IS EQUAL TO "C" NC2464.2 +094500 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +094600 PERFORM SECT-TH220-0003. NC2464.2 +094700* NC2464.2 +094800 QUAL-TEST-07-02. NC2464.2 +094900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +095000 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +095100 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +095200 OF GROUP-3-TABLE (SUB3 IN SUBSCRIPTS IN NC2464.2 +095300 SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 OF NC2464.2 +095400 SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB3 IN NC2464.2 +095500 SUBSCRIPTS IN SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +095600 IN SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB1 OF NC2464.2 +095700 SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +095800 IN SUBSCRIPTS-PART2) NC2464.2 +095900 IS EQUAL TO TABLE-ITEM OF TABLE-LEVEL-5 IN NC2464.2 +096000 TABLE-LEVEL-4 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +096100 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS IN NC2464.2 +096200 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS IN NC2464.2 +096300 SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +096400 OF SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB1 NC2464.2 +096500 OF SOME-MORE-SUBSCRIPTS OF SUBSCRIPTS-PART1) NC2464.2 +096600 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +096700 PERFORM SECT-TH220-0003. NC2464.2 +096800 GO TO QUAL-INIT-08. NC2464.2 +096900* NC2464.2 +097000 QUAL-DELETE-007. NC2464.2 +097100 PERFORM DE-LETE. NC2464.2 +097200 PERFORM PRINT-DETAIL. NC2464.2 +097300* NC2464.2 +097400 QUAL-INIT-08. NC2464.2 +097500 MOVE "QUAL-TEST-08" TO PAR-NAME. NC2464.2 +097600 MOVE "QUAL. CONDITION NAME" TO FEATURE. NC2464.2 +097700 MOVE ZERO TO REC-CT. NC2464.2 +097800 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +097900* NC2464.2 +098000* THIS TEST CONTAINS QUALIFIED CONDITION NAMES IN IF NC2464.2 +098100* STATEMENTS. THE CONDITION NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +098200* CONDITIONAL VARIABLES. THE SUBSCRIPTS IN THIS TEST ARE NC2464.2 +098300* CONSTANTS, UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT NC2464.2 +098400* AND RELATIVE INDEXING ARE USED. NC2464.2 +098500* NC2464.2 +098600 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +098700* NC2464.2 +098800 QUAL-TEST-08-01. NC2464.2 +098900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +099000 IF EQUALS-M OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +099100 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +099200 OF GROUP-1-TABLE (13) NC2464.2 +099300 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +099400 PERFORM SECT-TH220-0003. NC2464.2 +099500* NC2464.2 +099600 QUAL-TEST-08-02. NC2464.2 +099700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +099800 IF EQUALS-A OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +099900 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +100000 OF GROUP-1-TABLE (FIRST-SUB) NC2464.2 +100100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +100200 PERFORM SECT-TH220-0003. NC2464.2 +100300* NC2464.2 +100400 QUAL-TEST-08-03. NC2464.2 +100500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +100600 SET IN1 TO 3. NC2464.2 +100700 IF EQUALS-C OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +100800 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +100900 OF GROUP-1-TABLE (IN1) NC2464.2 +101000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +101100 PERFORM SECT-TH220-0003. NC2464.2 +101200* NC2464.2 +101300 QUAL-TEST-08-04. NC2464.2 +101400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +101500 SET IN1 TO 6. NC2464.2 +101600 IF EQUALS-A OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +101700 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +101800 OF GROUP-1-TABLE (IN1 - 5) NC2464.2 +101900 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +102000 PERFORM SECT-TH220-0003. NC2464.2 +102100* NC2464.2 +102200 QUAL-TEST-08-05. NC2464.2 +102300 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +102400 SET IN1 TO 1. NC2464.2 +102500 IF EQUALS-C OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +102600 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +102700 OF GROUP-1-TABLE (IN1 + 2) NC2464.2 +102800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +102900 PERFORM SECT-TH220-0003. NC2464.2 +103000 GO TO QUAL-INIT-09. NC2464.2 +103100* NC2464.2 +103200 QUAL-DELETE-008. NC2464.2 +103300 PERFORM DE-LETE. NC2464.2 +103400 PERFORM PRINT-DETAIL. NC2464.2 +103500* NC2464.2 +103600 QUAL-INIT-09. NC2464.2 +103700 MOVE "QUAL-TEST-09" TO PAR-NAME. NC2464.2 +103800 MOVE ZERO TO REC-CT. NC2464.2 +103900 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +104000* NC2464.2 +104100* THIS TEST CONTAINS QUALIFIED CONDITION NAMES IN IF NC2464.2 +104200* STATEMENTS. THE CONDITION NAMES REFER TO THREE DIMENSIONAL NC2464.2 +104300* CONDITIONAL VARIABLES. THE SUBSCRIPTS IN THIS TEST ARE NC2464.2 +104400* CONSTANTS, UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT NC2464.2 +104500* AND RELATIVE INDEXING ARE USED. NC2464.2 +104600* NC2464.2 +104700 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +104800* NC2464.2 +104900 QUAL-TEST-09-01. NC2464.2 +105000 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +105100 IF EQUALS-M OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +105200 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +105300 OF GROUP-3-TABLE (2, 2, 1) NC2464.2 +105400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +105500 PERFORM SECT-TH220-0003. NC2464.2 +105600* NC2464.2 +105700 QUAL-TEST-09-02. NC2464.2 +105800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +105900 IF EQUALS-A OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +106000 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +106100 OF GROUP-3-TABLE (FIRST-SUB, FIRST-SUB, FIRST-SUB) NC2464.2 +106200 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +106300 PERFORM SECT-TH220-0003. NC2464.2 +106400* NC2464.2 +106500 QUAL-TEST-09-03. NC2464.2 +106600 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +106700 SET IN5 TO 3. NC2464.2 +106800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +106900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +107000 OF GROUP-3-TABLE (1, 1, IN5) NC2464.2 +107100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +107200 PERFORM SECT-TH220-0003. NC2464.2 +107300* NC2464.2 +107400 QUAL-TEST-09-04. NC2464.2 +107500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +107600 SET IN3, IN4 TO 1. NC2464.2 +107700 SET IN5 TO 3. NC2464.2 +107800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +107900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +108000 OF GROUP-3-TABLE (IN3, IN4, IN5) NC2464.2 +108100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +108200 PERFORM SECT-TH220-0003. NC2464.2 +108300* NC2464.2 +108400 QUAL-TEST-09-05. NC2464.2 +108500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +108600 SET IN5 TO 1. NC2464.2 +108700 SET IN3, IN4 TO 2. NC2464.2 +108800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +108900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +109000 OF GROUP-3-TABLE (IN3 - 1, IN4 - 1, IN5 + 2) NC2464.2 +109100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +109200 PERFORM SECT-TH220-0003. NC2464.2 +109300 GO TO QUAL-INIT-10. NC2464.2 +109400* NC2464.2 +109500 QUAL-DELETE-009. NC2464.2 +109600 PERFORM DE-LETE. NC2464.2 +109700 PERFORM PRINT-DETAIL. NC2464.2 +109800* NC2464.2 +109900 QUAL-INIT-10. NC2464.2 +110000 MOVE "QUAL-TEST-10" TO PAR-NAME. NC2464.2 +110100 MOVE "QUALIFIED SUBSCRIPTS" TO RE-MARK. NC2464.2 +110200 MOVE ZERO TO REC-CT. NC2464.2 +110300* NC2464.2 +110400* THIS TEST CONTAINS QUALIFIED CONDITION NAMES WITH NC2464.2 +110500* QUALIFIED SUBSCRIPTS. NC2464.2 +110600* NC2464.2 +110700 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +110800* NC2464.2 +110900 QUAL-TEST-10-01. NC2464.2 +111000 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +111100 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +111200 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +111300 IN GROUP-1-TABLE (SUB1 OF SOME-MORE-SUBSCRIPTS NC2464.2 +111400 IN SUBSCRIPTS-PART1) NC2464.2 +111500 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +111600 PERFORM SECT-TH220-0003. NC2464.2 +111700* NC2464.2 +111800 QUAL-TEST-10-02. NC2464.2 +111900 IF NOT EQUALS-M OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +112000 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +112100 IN GROUP-2-TABLE (SUB2 OF SUBSCRIPTS NC2464.2 +112200 OF SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +112300 OF SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2) NC2464.2 +112400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +112500 PERFORM SECT-TH220-0003. NC2464.2 +112600* NC2464.2 +112700 QUAL-TEST-10-03. NC2464.2 +112800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +112900 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +113000 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +113100 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS OF NC2464.2 +113200 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +113300 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2, NC2464.2 +113400 SUB3 IN SUBSCRIPTS IN SUBSCRIPTS-PART1, NC2464.2 +113500 SUB1 IN SOME-MORE-SUBSCRIPTS IN SUB-PART2-LEVEL2 NC2464.2 +113600 IN SUBSCRIPTS-PART2) NC2464.2 +113700 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +113800 PERFORM SECT-TH220-0003. NC2464.2 +113900* NC2464.2 +114000 QUAL-TEST-10-04. NC2464.2 +114100 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +114200 IF NOT EQUALS-A OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +114300 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +114400 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS OF NC2464.2 +114500 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +114600 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2, NC2464.2 +114700 SUB3 IN SUBSCRIPTS OF SUB-PART2-LEVEL4 OF NC2464.2 +114800 SUB-PART2-LEVEL3 IN SUB-PART2-LEVEL2 IN NC2464.2 +114900 SUBSCRIPTS-PART2, SUB1 OF SOME-MORE-SUBSCRIPTS NC2464.2 +115000 OF SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +115100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +115200 PERFORM SECT-TH220-0003. NC2464.2 +115300 GO TO QUAL-INIT-11. NC2464.2 +115400* NC2464.2 +115500 QUAL-DELETE-010. NC2464.2 +115600 PERFORM DE-LETE. NC2464.2 +115700 PERFORM PRINT-DETAIL. NC2464.2 +115800* NC2464.2 +115900 QUAL-INIT-11. NC2464.2 +116000 MOVE "QUAL-TEST-11" TO PAR-NAME. NC2464.2 +116100 MOVE "QUALIFICATION" TO FEATURE. NC2464.2 +116200 MOVE "INTERMEDIATE LEVELS SKIPPED" TO RE-MARK. NC2464.2 +116300 MOVE SPACE TO TEMP-VALUE. NC2464.2 +116400 MOVE ZERO TO REC-CT. NC2464.2 +116500* NC2464.2 +116600* THIS TEST USES QUALIFIED DATA NAMES WITHOUT ALL OF THE NC2464.2 +116700* INTERMEDIATE LEVELS SPECIFIED. THERE ARE QUALIFIED TABLE NC2464.2 +116800* ITEMS AND QUALIFIED SUBSCRIPTS INCLUDED IN THE TEST NC2464.2 +116900* STATEMENTS. NC2464.2 +117000* NC2464.2 +117100 MOVE "G" TO EXPECTED-VALUE. NC2464.2 +117200* NC2464.2 +117300 QUAL-TEST-11-01. NC2464.2 +117400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF GROUP-1-TABLE (7) NC2464.2 +117500 TO TEMP-VALUE. NC2464.2 +117600 PERFORM SECT-TH220-0003. NC2464.2 +117700* NC2464.2 +117800 QUAL-TEST-11-02. NC2464.2 +117900 MOVE UNQUAL-ITEM (SUB2 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +118000 SUBSCRIPTS-PART2) TO TEMP-VALUE. NC2464.2 +118100 PERFORM SECT-TH220-0003. NC2464.2 +118200* NC2464.2 +118300 QUAL-TEST-11-03. NC2464.2 +118400 MOVE TABLE-ITEM OF GROUP-1-TABLE (SUB2 OF NC2464.2 +118500 SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2) TO TEMP-VALUE. NC2464.2 +118600 PERFORM SECT-TH220-0003. NC2464.2 +118700* NC2464.2 +118800 QUAL-TEST-11-04. NC2464.2 +118900 MOVE "A" TO EXPECTED-VALUE. NC2464.2 +119000 MOVE TABLE-ITEM OF GROUP-3-TABLE (FIRST-SUB, SUB3 OF NC2464.2 +119100 SUBSCRIPTS OF SUBSCRIPTS-PART1, SUB3 OF NC2464.2 +119200 SUB-PART2-LEVEL4) TO TEMP-VALUE. NC2464.2 +119300 PERFORM SECT-TH220-0003. NC2464.2 +119400* NC2464.2 +119500 QUAL-TEST-11-05. NC2464.2 +119600 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +119700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +119800 SET IN1 TO 3. NC2464.2 +119900 IF EQUALS-C OF TABLE-ITEM OF GROUP-1-TABLE (IN1) NC2464.2 +120000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +120100 PERFORM SECT-TH220-0003. NC2464.2 +120200* NC2464.2 +120300 QUAL-TEST-11-06. NC2464.2 +120400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +120500 IF EQUALS-C OF TABLE-ITEM OF GROUP-3-TABLE NC2464.2 +120600 (FIRST-SUB, SUB3 OF SUB-PART2-LEVEL3, SUB1 OF NC2464.2 +120700 SOME-MORE-SUBSCRIPTS OF SUBSCRIPTS-PART2) NC2464.2 +120800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +120900 PERFORM SECT-TH220-0003. NC2464.2 +121000 GO TO QUAL-INIT-12. NC2464.2 +121100 QUAL-DELETE-011. NC2464.2 +121200 PERFORM DE-LETE. NC2464.2 +121300 PERFORM PRINT-DETAIL. NC2464.2 +121400* NC2464.2 +121500 QUAL-INIT-12. NC2464.2 +121600 MOVE "IV-21 4.3.8.2.3 SR5 AND VI-2 1.3.2/4" NC2464.2 +121700 TO ANSI-REFERENCE. NC2464.2 +121800 MOVE "QUAL-TEST-12" TO PAR-NAME. NC2464.2 +121900 MOVE "SEVEN DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +122000 MOVE ZEROES TO TABLE-A NC2464.2 +122100 TABLE-B. NC2464.2 +122200 MOVE 27 TO ELEM1 OF L8 IN L7 IN L6 IN L5 IN L4 IN L3 NC2464.2 +122300 IN L2 OF TABLE-A (1, 2, 1, 2, 1, 1, 2). NC2464.2 +122400 GO TO QUAL-TEST-12. NC2464.2 +122500 QUAL-DELETE-12. NC2464.2 +122600 PERFORM DE-LETE. NC2464.2 +122700 PERFORM PRINT-DETAIL. NC2464.2 +122800 GO TO CCVS-EXIT. NC2464.2 +122900 QUAL-TEST-12. NC2464.2 +123000 IF ELEM1 OF L8 IN L7 OF L6 OF L5 IN L4 IN L3 OF L2 NC2464.2 +123100 IN TABLE-A NC2464.2 +123200 (SUB1 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +123300 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +123400 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +123500 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +123600 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +123700 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +123800 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +123900 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +124000 IN SUBSCRIPTS-GROUP-1, NC2464.2 +124100 SUB2 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +124200 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +124300 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +124400 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +124500 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +124600 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +124700 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +124800 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +124900 OF SUBSCRIPTS-GROUP-2, NC2464.2 +125000 SUB3 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +125100 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +125200 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +125300 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +125400 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +125500 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +125600 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +125700 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +125800 IN SUBSCRIPTS-GROUP-1, NC2464.2 +125900 SUB4 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +126000 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +126100 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +126200 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +126300 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +126400 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +126500 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +126600 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +126700 OF SUBSCRIPTS-GROUP-2, NC2464.2 +126800 SUB5 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +126900 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +127000 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +127100 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +127200 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +127300 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +127400 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +127500 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +127600 IN SUBSCRIPTS-GROUP-1, NC2464.2 +127700 SUB6 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +127800 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +127900 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +128000 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +128100 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +128200 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +128300 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +128400 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +128500 IN SUBSCRIPTS-GROUP-1, NC2464.2 +128600 SUB7 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +128700 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +128800 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +128900 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +129000 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +129100 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +129200 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +129300 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +129400 OF SUBSCRIPTS-GROUP-2) NC2464.2 +129500 = 27 NC2464.2 +129600 PERFORM PASS NC2464.2 +129700 PERFORM PRINT-DETAIL NC2464.2 +129800 ELSE NC2464.2 +129900 MOVE "QUALIFICATION FAILED" TO RE-MARK NC2464.2 +130000 PERFORM FAIL NC2464.2 +130100 PERFORM PRINT-DETAIL. NC2464.2 +130200* NC2464.2 +130300 GO TO CCVS-EXIT. NC2464.2 +130400* NC2464.2 +130500 SECT-TH220-0003 SECTION. NC2464.2 +130600 SYNTAX-CHECK. NC2464.2 +130700 ADD 1 TO REC-CT. NC2464.2 +130800 IF TEMP-VALUE IS EQUAL TO EXPECTED-VALUE NC2464.2 +130900 PERFORM PASS NC2464.2 +131000 GO TO SYNTAX-CHECK-WRITE. NC2464.2 +131100 SYNTAX-FAIL. NC2464.2 +131200 MOVE TEMP-VALUE TO COMPUTED-A. NC2464.2 +131300 MOVE EXPECTED-VALUE TO CORRECT-A. NC2464.2 +131400 PERFORM FAIL. NC2464.2 +131500 SYNTAX-CHECK-WRITE. NC2464.2 +131600 PERFORM PRINT-DETAIL. NC2464.2 +131700 MOVE SPACE TO TEMP-VALUE. NC2464.2 +131800 CCVS-EXIT SECTION. NC2464.2 +131900 CCVS-999999. NC2464.2 +132000 GO TO CLOSE-FILES. NC2464.2 +*END-OF,NC246A +*HEADER,COBOL,NC247A +000100 IDENTIFICATION DIVISION. NC2474.2 +000200 PROGRAM-ID. NC2474.2 +000300 NC247A. NC2474.2 +000400**************************************************************** NC2474.2 +000500* * NC2474.2 +000600* VALIDATION FOR:- * NC2474.2 +000700* * NC2474.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +000900* * NC2474.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2474.2 +001100* * NC2474.2 +001200**************************************************************** NC2474.2 +001300* * NC2474.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2474.2 +001500* * NC2474.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2474.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2474.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2474.2 +001900* * NC2474.2 +002000**************************************************************** NC2474.2 +002100* NC2474.2 +002200* NC2474.2 +002300* PROGRAM NC247A TESTS FORMAT2 OF THE "OCCURS" CLAUSE TO * NC2474.2 +002400* VERIFY THAT THE NUMBER OF TABLE OCCURRENCES CARIES * NC2474.2 +002500* ACCORDING TO THE CURRENT VALUE OF THE IDENTIDIER ON WHICH * NC2474.2 +002600* IT DEPENDS. * NC2474.2 +002700* * NC2474.2 +002800**************************************************************** NC2474.2 +002900 ENVIRONMENT DIVISION. NC2474.2 +003000 CONFIGURATION SECTION. NC2474.2 +003100 SOURCE-COMPUTER. NC2474.2 +003200 XXXXX082. NC2474.2 +003300 OBJECT-COMPUTER. NC2474.2 +003400 XXXXX083. NC2474.2 +003500 INPUT-OUTPUT SECTION. NC2474.2 +003600 FILE-CONTROL. NC2474.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2474.2 +003800 XXXXX055. NC2474.2 +003900 DATA DIVISION. NC2474.2 +004000 FILE SECTION. NC2474.2 +004100 FD PRINT-FILE. NC2474.2 +004200 01 PRINT-REC PICTURE X(120). NC2474.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2474.2 +004400 WORKING-STORAGE SECTION. NC2474.2 +004500 01 ODO-RECORD. NC2474.2 +004600 02 FILLER PIC X(120). NC2474.2 +004700 02 GRP-ODO. NC2474.2 +004800 03 DOI-DU-01V00 PIC 9. NC2474.2 +004900 03 ODO-XN-00009 PIC X(9). NC2474.2 +005000 03 ODO-GRP-00009. NC2474.2 +005100 04 ODO-XN-00001-O009D OCCURS 0 TO 9 TIMES DEPENDING ON NC2474.2 +005200 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D NC2474.2 +005300 INDEXED BY ODO-IX PIC X. NC2474.2 +005400 01 NEW-RECORD. NC2474.2 +005500 02 FILLER PIC X(120). NC2474.2 +005600 02 NEW-ODO. NC2474.2 +005700 03 NEW-DU-01V00 PIC 9. NC2474.2 +005800 03 NEW-XN-00009 PIC X(9). NC2474.2 +005900 03 NEW-GRP-00009. NC2474.2 +006000 04 NEW-XN-00001-O009D OCCURS 0 TO 9 TIMES DEPENDING ON NC2474.2 +006100 NEW-DU-01V00 ASCENDING KEY NEW-XN-00001-O009D NC2474.2 +006200 INDEXED BY NEW-IX PIC X. NC2474.2 +006300 01 STATIC-VALUE. NC2474.2 +006400 02 FILLER PIC 9 VALUE 9. NC2474.2 +006500 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". NC2474.2 +006600 01 WRK-GRP-00019. NC2474.2 +006700 02 WRK-DU-01V00 PIC 9. NC2474.2 +006800 02 WRK-XN-00009-1 PIC X(9). NC2474.2 +006900 02 WRK-XN-00009-2 PIC X(9). NC2474.2 +007000 01 WRK-DU-05V00 PIC 9(5). NC2474.2 +007100 01 WRK-XN-00020 PIC X(20). NC2474.2 +007200 01 WRK-XN-00010 PIC X(10). NC2474.2 +007300 01 WRK-XN-00001 PIC X. NC2474.2 +007400 01 TEST-RESULTS. NC2474.2 +007500 02 FILLER PIC X VALUE SPACE. NC2474.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. NC2474.2 +007700 02 FILLER PIC X VALUE SPACE. NC2474.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. NC2474.2 +007900 02 FILLER PIC X VALUE SPACE. NC2474.2 +008000 02 PAR-NAME. NC2474.2 +008100 03 FILLER PIC X(19) VALUE SPACE. NC2474.2 +008200 03 PARDOT-X PIC X VALUE SPACE. NC2474.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. NC2474.2 +008400 02 FILLER PIC X(8) VALUE SPACE. NC2474.2 +008500 02 RE-MARK PIC X(61). NC2474.2 +008600 01 TEST-COMPUTED. NC2474.2 +008700 02 FILLER PIC X(30) VALUE SPACE. NC2474.2 +008800 02 FILLER PIC X(17) VALUE NC2474.2 +008900 " COMPUTED=". NC2474.2 +009000 02 COMPUTED-X. NC2474.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2474.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A NC2474.2 +009300 PIC -9(9).9(9). NC2474.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2474.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2474.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2474.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. NC2474.2 +009800 04 COMPUTED-18V0 PIC -9(18). NC2474.2 +009900 04 FILLER PIC X. NC2474.2 +010000 03 FILLER PIC X(50) VALUE SPACE. NC2474.2 +010100 01 TEST-CORRECT. NC2474.2 +010200 02 FILLER PIC X(30) VALUE SPACE. NC2474.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2474.2 +010400 02 CORRECT-X. NC2474.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2474.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2474.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2474.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2474.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2474.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. NC2474.2 +011100 04 CORRECT-18V0 PIC -9(18). NC2474.2 +011200 04 FILLER PIC X. NC2474.2 +011300 03 FILLER PIC X(2) VALUE SPACE. NC2474.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2474.2 +011500 01 CCVS-C-1. NC2474.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2474.2 +011700- "SS PARAGRAPH-NAME NC2474.2 +011800- " REMARKS". NC2474.2 +011900 02 FILLER PIC X(20) VALUE SPACE. NC2474.2 +012000 01 CCVS-C-2. NC2474.2 +012100 02 FILLER PIC X VALUE SPACE. NC2474.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". NC2474.2 +012300 02 FILLER PIC X(15) VALUE SPACE. NC2474.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". NC2474.2 +012500 02 FILLER PIC X(94) VALUE SPACE. NC2474.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2474.2 +012700 01 REC-CT PIC 99 VALUE ZERO. NC2474.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2474.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2474.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2474.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2474.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2474.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2474.2 +013700 01 CCVS-H-1. NC2474.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2474.2 +013900 02 FILLER PIC X(42) VALUE NC2474.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2474.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC2474.2 +014200 01 CCVS-H-2A. NC2474.2 +014300 02 FILLER PIC X(40) VALUE SPACE. NC2474.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2474.2 +014500 02 FILLER PIC XXXX VALUE NC2474.2 +014600 "4.2 ". NC2474.2 +014700 02 FILLER PIC X(28) VALUE NC2474.2 +014800 " COPY - NOT FOR DISTRIBUTION". NC2474.2 +014900 02 FILLER PIC X(41) VALUE SPACE. NC2474.2 +015000 NC2474.2 +015100 01 CCVS-H-2B. NC2474.2 +015200 02 FILLER PIC X(15) VALUE NC2474.2 +015300 "TEST RESULT OF ". NC2474.2 +015400 02 TEST-ID PIC X(9). NC2474.2 +015500 02 FILLER PIC X(4) VALUE NC2474.2 +015600 " IN ". NC2474.2 +015700 02 FILLER PIC X(12) VALUE NC2474.2 +015800 " HIGH ". NC2474.2 +015900 02 FILLER PIC X(22) VALUE NC2474.2 +016000 " LEVEL VALIDATION FOR ". NC2474.2 +016100 02 FILLER PIC X(58) VALUE NC2474.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +016300 01 CCVS-H-3. NC2474.2 +016400 02 FILLER PIC X(34) VALUE NC2474.2 +016500 " FOR OFFICIAL USE ONLY ". NC2474.2 +016600 02 FILLER PIC X(58) VALUE NC2474.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2474.2 +016800 02 FILLER PIC X(28) VALUE NC2474.2 +016900 " COPYRIGHT 1985 ". NC2474.2 +017000 01 CCVS-E-1. NC2474.2 +017100 02 FILLER PIC X(52) VALUE SPACE. NC2474.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2474.2 +017300 02 ID-AGAIN PIC X(9). NC2474.2 +017400 02 FILLER PIC X(45) VALUE SPACES. NC2474.2 +017500 01 CCVS-E-2. NC2474.2 +017600 02 FILLER PIC X(31) VALUE SPACE. NC2474.2 +017700 02 FILLER PIC X(21) VALUE SPACE. NC2474.2 +017800 02 CCVS-E-2-2. NC2474.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2474.2 +018000 03 FILLER PIC X VALUE SPACE. NC2474.2 +018100 03 ENDER-DESC PIC X(44) VALUE NC2474.2 +018200 "ERRORS ENCOUNTERED". NC2474.2 +018300 01 CCVS-E-3. NC2474.2 +018400 02 FILLER PIC X(22) VALUE NC2474.2 +018500 " FOR OFFICIAL USE ONLY". NC2474.2 +018600 02 FILLER PIC X(12) VALUE SPACE. NC2474.2 +018700 02 FILLER PIC X(58) VALUE NC2474.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +018900 02 FILLER PIC X(13) VALUE SPACE. NC2474.2 +019000 02 FILLER PIC X(15) VALUE NC2474.2 +019100 " COPYRIGHT 1985". NC2474.2 +019200 01 CCVS-E-4. NC2474.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2474.2 +019400 02 FILLER PIC X(4) VALUE " OF ". NC2474.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2474.2 +019600 02 FILLER PIC X(40) VALUE NC2474.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2474.2 +019800 01 XXINFO. NC2474.2 +019900 02 FILLER PIC X(19) VALUE NC2474.2 +020000 "*** INFORMATION ***". NC2474.2 +020100 02 INFO-TEXT. NC2474.2 +020200 04 FILLER PIC X(8) VALUE SPACE. NC2474.2 +020300 04 XXCOMPUTED PIC X(20). NC2474.2 +020400 04 FILLER PIC X(5) VALUE SPACE. NC2474.2 +020500 04 XXCORRECT PIC X(20). NC2474.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). NC2474.2 +020700 01 HYPHEN-LINE. NC2474.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. NC2474.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************NC2474.2 +021000- "*****************************************". NC2474.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************NC2474.2 +021200- "******************************". NC2474.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE NC2474.2 +021400 "NC247A". NC2474.2 +021500 PROCEDURE DIVISION. NC2474.2 +021600 CCVS1 SECTION. NC2474.2 +021700 OPEN-FILES. NC2474.2 +021800 OPEN OUTPUT PRINT-FILE. NC2474.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2474.2 +022000 MOVE SPACE TO TEST-RESULTS. NC2474.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2474.2 +022200 GO TO CCVS1-EXIT. NC2474.2 +022300 CLOSE-FILES. NC2474.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2474.2 +022500 TERMINATE-CCVS. NC2474.2 +022600S EXIT PROGRAM. NC2474.2 +022700STERMINATE-CALL. NC2474.2 +022800 STOP RUN. NC2474.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2474.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2474.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2474.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2474.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. NC2474.2 +023400 PRINT-DETAIL. NC2474.2 +023500 IF REC-CT NOT EQUAL TO ZERO NC2474.2 +023600 MOVE "." TO PARDOT-X NC2474.2 +023700 MOVE REC-CT TO DOTVALUE. NC2474.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2474.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2474.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2474.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2474.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2474.2 +024300 MOVE SPACE TO CORRECT-X. NC2474.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2474.2 +024500 MOVE SPACE TO RE-MARK. NC2474.2 +024600 HEAD-ROUTINE. NC2474.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2474.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2474.2 +025100 COLUMN-NAMES-ROUTINE. NC2474.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +025500 END-ROUTINE. NC2474.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2474.2 +025700 END-RTN-EXIT. NC2474.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +025900 END-ROUTINE-1. NC2474.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2474.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2474.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. NC2474.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2474.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2474.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2474.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2474.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2474.2 +026800 END-ROUTINE-12. NC2474.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2474.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2474.2 +027100 MOVE "NO " TO ERROR-TOTAL NC2474.2 +027200 ELSE NC2474.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2474.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2474.2 +027500 PERFORM WRITE-LINE. NC2474.2 +027600 END-ROUTINE-13. NC2474.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2474.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE NC2474.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2474.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2474.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO NC2474.2 +028300 MOVE "NO " TO ERROR-TOTAL NC2474.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2474.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2474.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028800 WRITE-LINE. NC2474.2 +028900 ADD 1 TO RECORD-COUNT. NC2474.2 +029000Y IF RECORD-COUNT GREATER 50 NC2474.2 +029100Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2474.2 +029200Y MOVE SPACE TO DUMMY-RECORD NC2474.2 +029300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2474.2 +029400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2474.2 +029500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2474.2 +029600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2474.2 +029700Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2474.2 +029800Y MOVE ZERO TO RECORD-COUNT. NC2474.2 +029900 PERFORM WRT-LN. NC2474.2 +030000 WRT-LN. NC2474.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2474.2 +030200 MOVE SPACE TO DUMMY-RECORD. NC2474.2 +030300 BLANK-LINE-PRINT. NC2474.2 +030400 PERFORM WRT-LN. NC2474.2 +030500 FAIL-ROUTINE. NC2474.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2474.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2474.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2474.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2474.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2474.2 +031200 GO TO FAIL-ROUTINE-EX. NC2474.2 +031300 FAIL-ROUTINE-WRITE. NC2474.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2474.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2474.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2474.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2474.2 +031800 FAIL-ROUTINE-EX. EXIT. NC2474.2 +031900 BAIL-OUT. NC2474.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2474.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2474.2 +032200 BAIL-OUT-WRITE. NC2474.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2474.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2474.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2474.2 +032700 BAIL-OUT-EX. EXIT. NC2474.2 +032800 CCVS1-EXIT. NC2474.2 +032900 EXIT. NC2474.2 +033000 SECT-NC247A-001 SECTION. NC2474.2 +033100 INIT-WRK-AREA. NC2474.2 +033200 MOVE STATIC-VALUE TO WRK-GRP-00019. NC2474.2 +033300 MOVE 9 TO DOI-DU-01V00. NC2474.2 +033400 MOVE " ACTIVE: " TO ODO-XN-00009. NC2474.2 +033500 MOVE "1" TO ODO-XN-00001-O009D (1). NC2474.2 +033600 MOVE "2" TO ODO-XN-00001-O009D (2). NC2474.2 +033700 MOVE "3" TO ODO-XN-00001-O009D (3). NC2474.2 +033800 MOVE "4" TO ODO-XN-00001-O009D (4). NC2474.2 +033900 MOVE "5" TO ODO-XN-00001-O009D (5). NC2474.2 +034000 MOVE "6" TO ODO-XN-00001-O009D (6). NC2474.2 +034100 MOVE "7" TO ODO-XN-00001-O009D (7). NC2474.2 +034200 MOVE "8" TO ODO-XN-00001-O009D (8). NC2474.2 +034300 MOVE "9" TO ODO-XN-00001-O009D (9). NC2474.2 +034400* NC2474.2 +034500 IF-INIT-GF-1. NC2474.2 +034600 MOVE "IF-TEST-GF-1" TO PAR-NAME. NC2474.2 +034700 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +034800 MOVE "OCCURS DEPENDING ON" TO FEATURE. NC2474.2 +034900 MOVE STATIC-VALUE TO RE-MARK. NC2474.2 +035000 IF-TEST-GF-1. NC2474.2 +035100 IF STATIC-VALUE IS EQUAL TO GRP-ODO NC2474.2 +035200 PERFORM PASS NC2474.2 +035300 GO TO IF-WRITE-GF-1 NC2474.2 +035400 ELSE NC2474.2 +035500 GO TO IF-FAIL-GF-1. NC2474.2 +035600 IF-DELETE-GF-1. NC2474.2 +035700 PERFORM DE-LETE. NC2474.2 +035800 GO TO IF-WRITE-GF-1. NC2474.2 +035900 IF-FAIL-GF-1. NC2474.2 +036000 PERFORM FAIL NC2474.2 +036100 MOVE "CONDITION WAS EQUAL" TO CORRECT-A NC2474.2 +036200 MOVE "CONDITION NOT EQUAL" TO COMPUTED-A. NC2474.2 +036300 IF-WRITE-GF-1. NC2474.2 +036400 PERFORM PRINT-DETAIL. NC2474.2 +036500* NC2474.2 +036600 IF-INIT-GF-2. NC2474.2 +036700 MOVE WRK-GRP-00019 TO RE-MARK. NC2474.2 +036800 MOVE "IF-TEST-GF-2" TO PAR-NAME. NC2474.2 +036900 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +037000 PERFORM INIT-WRK-AREA. NC2474.2 +037100 MOVE 3 TO WRK-DU-01V00 DOI-DU-01V00 NC2474.2 +037200 MOVE "123 " TO WRK-XN-00009-2. NC2474.2 +037300 IF-TEST-GF-2. NC2474.2 +037400 IF GRP-ODO IS EQUAL TO WRK-GRP-00019 NC2474.2 +037500 PERFORM PASS NC2474.2 +037600 GO TO IF-WRITE-GF-2 NC2474.2 +037700 ELSE NC2474.2 +037800 GO TO IF-FAIL-GF-2. NC2474.2 +037900 IF-DELETE-GF-2. NC2474.2 +038000 PERFORM DE-LETE. NC2474.2 +038100 GO TO IF-WRITE-GF-2. NC2474.2 +038200 IF-FAIL-GF-2. NC2474.2 +038300 PERFORM FAIL NC2474.2 +038400 MOVE "CONDITION WAS EQUAL" TO CORRECT-A NC2474.2 +038500 MOVE "CONDITION NOT EQUAL" TO COMPUTED-A. NC2474.2 +038600 IF-WRITE-GF-2. NC2474.2 +038700 PERFORM PRINT-DETAIL. NC2474.2 +038800* NC2474.2 +038900 INS-INIT-F1-1. NC2474.2 +039000 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2474.2 +039100 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +039200 MOVE STATIC-VALUE TO RE-MARK. NC2474.2 +039300 PERFORM INIT-WRK-AREA. NC2474.2 +039400 MOVE 0 TO WRK-DU-05V00. NC2474.2 +039500 INS-TEST-F1-1. NC2474.2 +039600 INSPECT ODO-GRP-00009 TALLYING WRK-DU-05V00 FOR ALL "7". NC2474.2 +039700 IF WRK-DU-05V00 IS EQUAL TO 1 NC2474.2 +039800 PERFORM PASS NC2474.2 +039900 GO TO INS-WRITE-F1-1 NC2474.2 +040000 ELSE NC2474.2 +040100 GO TO INS-FAIL-F1-1. NC2474.2 +040200 INS-DELETE-F1-1. NC2474.2 +040300 PERFORM DE-LETE. NC2474.2 +040400 GO TO INS-WRITE-F1-1. NC2474.2 +040500 INS-FAIL-F1-1. NC2474.2 +040600 PERFORM FAIL NC2474.2 +040700 MOVE 1 TO CORRECT-18V0 NC2474.2 +040800 MOVE WRK-DU-05V00 TO COMPUTED-18V0. NC2474.2 +040900 INS-WRITE-F1-1. NC2474.2 +041000 PERFORM PRINT-DETAIL. NC2474.2 +041100* NC2474.2 +041200 INS-INIT-F1-2. NC2474.2 +041300 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2474.2 +041400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +041500 PERFORM INIT-WRK-AREA. NC2474.2 +041600 MOVE 3 TO DOI-DU-01V00 WRK-DU-01V00 WRK-DU-05V00. NC2474.2 +041700 MOVE "123 " TO WRK-XN-00009-2. NC2474.2 +041800 MOVE 0 TO WRK-DU-05V00. NC2474.2 +041900 MOVE WRK-GRP-00019 TO RE-MARK. NC2474.2 +042000 INS-TEST-F1-2. NC2474.2 +042100 INSPECT ODO-GRP-00009 TALLYING WRK-DU-05V00 FOR ALL "7". NC2474.2 +042200 IF WRK-DU-05V00 IS EQUAL TO 0 NC2474.2 +042300 PERFORM PASS NC2474.2 +042400 GO TO INS-WRITE-F1-2 NC2474.2 +042500 ELSE NC2474.2 +042600 GO TO INS-FAIL-F1-2. NC2474.2 +042700 INS-DELETE-F1-2. NC2474.2 +042800 PERFORM DE-LETE. NC2474.2 +042900 GO TO INS-WRITE-F1-2. NC2474.2 +043000 INS-FAIL-F1-2. NC2474.2 +043100 PERFORM FAIL NC2474.2 +043200 MOVE 0 TO CORRECT-18V0 NC2474.2 +043300 MOVE WRK-DU-05V00 TO COMPUTED-18V0. NC2474.2 +043400 INS-WRITE-F1-2. NC2474.2 +043500 PERFORM PRINT-DETAIL. NC2474.2 +043600* NC2474.2 +043700 MOV-INIT-F1-1. NC2474.2 +043800 MOVE "MOV-TEST-F1-1" TO PAR-NAME. NC2474.2 +043900 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +044000 MOVE "FULL ODO + BASE SEGMENT SOURCE" TO RE-MARK. NC2474.2 +044100 PERFORM INIT-WRK-AREA. NC2474.2 +044200 MOVE SPACES TO WRK-GRP-00019. NC2474.2 +044300 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +044400 MOV-TEST-F1-1. NC2474.2 +044500 IF WRK-GRP-00019 IS EQUAL TO STATIC-VALUE NC2474.2 +044600 PERFORM PASS NC2474.2 +044700 GO TO MOV-WRITE-F1-1 NC2474.2 +044800 ELSE NC2474.2 +044900 GO TO MOV-FAIL-F1-1. NC2474.2 +045000 MOV-DELETE-F1-1. NC2474.2 +045100 PERFORM DE-LETE. NC2474.2 +045200 GO TO MOV-WRITE-F1-1. NC2474.2 +045300 MOV-FAIL-F1-1. NC2474.2 +045400 PERFORM FAIL NC2474.2 +045500 MOVE STATIC-VALUE TO CORRECT-A NC2474.2 +045600 MOVE WRK-GRP-00019 TO COMPUTED-A. NC2474.2 +045700 MOV-WRITE-F1-1. NC2474.2 +045800 PERFORM PRINT-DETAIL. NC2474.2 +045900* NC2474.2 +046000 MOV-INIT-F1-2. NC2474.2 +046100 MOVE "MOV-TEST-F1-2" TO PAR-NAME. NC2474.2 +046200 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +046300 MOVE "PART ODO + BASE SEGMENT SOURCE" TO RE-MARK. NC2474.2 +046400 PERFORM INIT-WRK-AREA. NC2474.2 +046500 MOVE SPACES TO WRK-GRP-00019. NC2474.2 +046600 MOVE 3 TO DOI-DU-01V00. NC2474.2 +046700 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +046800 MOV-TEST-F1-2. NC2474.2 +046900 IF WRK-GRP-00019 IS EQUAL TO "3 ACTIVE: 123 " NC2474.2 +047000 PERFORM PASS NC2474.2 +047100 GO TO MOV-WRITE-F1-2 NC2474.2 +047200 ELSE NC2474.2 +047300 GO TO MOV-FAIL-F1-2. NC2474.2 +047400 MOV-DELETE-F1-2. NC2474.2 +047500 PERFORM DE-LETE. NC2474.2 +047600 GO TO MOV-WRITE-F1-2. NC2474.2 +047700 MOV-FAIL-F1-2. NC2474.2 +047800 PERFORM FAIL NC2474.2 +047900 MOVE "3 ACTIVE: 123" TO CORRECT-A NC2474.2 +048000 MOVE WRK-GRP-00019 TO COMPUTED-A. NC2474.2 +048100 MOV-WRITE-F1-2. NC2474.2 +048200 PERFORM PRINT-DETAIL. NC2474.2 +048300* NC2474.2 +048400 MOV-INIT-F1-3. NC2474.2 +048500 MOVE "MOV-TEST-F1-3" TO PAR-NAME. NC2474.2 +048600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +048700 MOVE "FULL ODO +BASE SEG RECEIVING" TO RE-MARK. NC2474.2 +048800 MOVE 9 TO DOI-DU-01V00. NC2474.2 +048900 MOVE "F" TO ODO-XN-00001-O009D (6). NC2474.2 +049000 MOVE "A" TO ODO-XN-00001-O009D (7). NC2474.2 +049100 MOVE "I" TO ODO-XN-00001-O009D (8). NC2474.2 +049200 MOVE "L" TO ODO-XN-00001-O009D (9). NC2474.2 +049300 MOVE "3 ACTIVE: TEST PASS" TO GRP-ODO. NC2474.2 +049400 MOVE 9 TO DOI-DU-01V00. NC2474.2 +049500 MOV-TEST-F1-3. NC2474.2 +049600 IF GRP-ODO IS EQUAL TO "9 ACTIVE: TEST PASS" NC2474.2 +049700 PERFORM PASS NC2474.2 +049800 GO TO MOV-WRITE-F1-3 NC2474.2 +049900 ELSE NC2474.2 +050000 GO TO MOV-FAIL-F1-3. NC2474.2 +050100 MOV-DELETE-F1-3. NC2474.2 +050200 PERFORM DE-LETE. NC2474.2 +050300 GO TO MOV-WRITE-F1-3. NC2474.2 +050400 MOV-FAIL-F1-3. NC2474.2 +050500 PERFORM FAIL NC2474.2 +050600 MOVE "9 ACTIVE: TEST PASS" TO CORRECT-A NC2474.2 +050700 MOVE GRP-ODO TO COMPUTED-A. NC2474.2 +050800 MOV-WRITE-F1-3. NC2474.2 +050900 PERFORM PRINT-DETAIL. NC2474.2 +051000* NC2474.2 +051100 MOV-INIT-F1-4. NC2474.2 +051200 MOVE "MOV-TEST-F1-4" TO PAR-NAME. NC2474.2 +051300 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +051400 MOVE "PART ODO + BASE SEG RECEIVING" TO RE-MARK. NC2474.2 +051500 MOVE 9 TO DOI-DU-01V00. NC2474.2 +051600 MOVE "F" TO ODO-XN-00001-O009D (6). NC2474.2 +051700 MOVE "A" TO ODO-XN-00001-O009D (7). NC2474.2 +051800 MOVE "I" TO ODO-XN-00001-O009D (8). NC2474.2 +051900 MOVE "L" TO ODO-XN-00001-O009D (9). NC2474.2 +052000 MOVE "9 ACTIVE: TEST PASS" TO GRP-ODO. NC2474.2 +052100 MOVE 9 TO DOI-DU-01V00. NC2474.2 +052200 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +052300 MOVE 5 TO WRK-DU-01V00. NC2474.2 +052400 MOV-TEST-F1-4. NC2474.2 +052500 IF GRP-ODO IS EQUAL TO "9 ACTIVE: TEST PASS" NC2474.2 +052600 PERFORM PASS NC2474.2 +052700 GO TO MOV-WRITE-F1-4 NC2474.2 +052800 ELSE NC2474.2 +052900 GO TO MOV-FAIL-F1-4. NC2474.2 +053000 MOV-DELETE-F1-4. NC2474.2 +053100 PERFORM DE-LETE. NC2474.2 +053200 GO TO MOV-WRITE-F1-4. NC2474.2 +053300 MOV-FAIL-F1-4. NC2474.2 +053400 PERFORM FAIL NC2474.2 +053500 MOVE WRK-GRP-00019 TO COMPUTED-A NC2474.2 +053600 MOVE "9 ACTIVE: TEST PASS" TO CORRECT-A. NC2474.2 +053700 MOV-WRITE-F1-4. NC2474.2 +053800 PERFORM PRINT-DETAIL. NC2474.2 +053900* NC2474.2 +054000 MOV-INIT-F1-5. NC2474.2 +054100 MOVE "MOV-TEST-F1-5" TO PAR-NAME. NC2474.2 +054200 MOVE "VI-26 5.8.3 SR5" TO ANSI-REFERENCE. NC2474.2 +054300* MOVE 9 TO DOI-DU-01V00. NC2474.2 +054400* MOVE "Z" TO ODO-XN-00001-O009D (1). NC2474.2 +054500* MOVE "E" TO ODO-XN-00001-O009D (2). NC2474.2 +054600* MOVE "R" TO ODO-XN-00001-O009D (3). NC2474.2 +054700* MOVE "O" TO ODO-XN-00001-O009D (4). NC2474.2 +054800* MOVE "*" TO WRK-XN-00001. NC2474.2 +054900* MOVE ZERO TO DOI-DU-01V00. NC2474.2 +055000* MOVE ODO-XN-00001-O009D (1) TO WRK-XN-00001. NC2474.2 +055100*MOV-TEST-F1-5. NC2474.2 +055200* IF WRK-XN-00001 = "*" NC2474.2 +055300* PERFORM PASS NC2474.2 +055400* GO TO MOV-WRITE-F1-5 NC2474.2 +055500* ELSE NC2474.2 +055600* GO TO MOV-FAIL-F1-5. NC2474.2 +055700 MOV-DELETE-F1-5. NC2474.2 +055800 PERFORM DE-LETE. NC2474.2 +055900 GO TO MOV-WRITE-F1-5. NC2474.2 +056000 MOV-FAIL-F1-5. NC2474.2 +056100 MOVE WRK-XN-00001 TO COMPUTED-A NC2474.2 +056200 MOVE "*" TO CORRECT-A NC2474.2 +056300 MOVE "OCCURS ZERO TIMES - MOVE SHOULD HAVE FAILED" NC2474.2 +056400 TO RE-MARK NC2474.2 +056500 PERFORM FAIL. NC2474.2 +056600 MOV-WRITE-F1-5. NC2474.2 +056700 PERFORM PRINT-DETAIL. NC2474.2 +056800* NC2474.2 +056900 MOV-INIT-F1-6. NC2474.2 +057000 MOVE "MOV-TEST-F1-6" TO PAR-NAME. NC2474.2 +057100 MOVE "VI-26 5.8.3 SR5" TO ANSI-REFERENCE. NC2474.2 +057200 MOVE 9 TO DOI-DU-01V00. NC2474.2 +057300 MOVE "P" TO ODO-XN-00001-O009D (1). NC2474.2 +057400 MOVE "Q" TO ODO-XN-00001-O009D (2). NC2474.2 +057500 MOVE "R" TO ODO-XN-00001-O009D (3). NC2474.2 +057600 MOVE "S" TO ODO-XN-00001-O009D (4). NC2474.2 +057700 MOVE "T" TO ODO-XN-00001-O009D (5). NC2474.2 +057800 MOVE "U" TO ODO-XN-00001-O009D (6). NC2474.2 +057900 MOVE "V" TO ODO-XN-00001-O009D (7). NC2474.2 +058000 MOVE "W" TO ODO-XN-00001-O009D (8). NC2474.2 +058100 MOVE "X" TO ODO-XN-00001-O009D (9). NC2474.2 +058200 MOVE 3 TO NEW-DU-01V00. NC2474.2 +058300 MOVE ODO-RECORD TO NEW-RECORD. NC2474.2 +058400 MOV-TEST-F1-6. NC2474.2 +058500 IF NEW-GRP-00009 = "PQRSTUVWX" NC2474.2 +058600 PERFORM PASS NC2474.2 +058700 GO TO MOV-WRITE-F1-6 NC2474.2 +058800 ELSE NC2474.2 +058900 GO TO MOV-FAIL-F1-6. NC2474.2 +059000 MOVE-DELETE-F1-6. NC2474.2 +059100 PERFORM DE-LETE. NC2474.2 +059200 GO TO MOV-WRITE-F1-6. NC2474.2 +059300 MOV-FAIL-F1-6. NC2474.2 +059400 MOVE NEW-GRP-00009 TO COMPUTED-A NC2474.2 +059500 MOVE "PQRSTUVWX" TO CORRECT-A NC2474.2 +059600 MOVE "ALL 9 FIELDS SHOULD BE MOVED IN GROUP MOVE" NC2474.2 +059700 TO RE-MARK NC2474.2 +059800 PERFORM FAIL. NC2474.2 +059900 MOV-WRITE-F1-6. NC2474.2 +060000 PERFORM PRINT-DETAIL. NC2474.2 +060100* NC2474.2 +060200 SCH-INIT-F1-1. NC2474.2 +060300 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2474.2 +060400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +060500 MOVE "SEARCH FULL ODO TABLE" TO RE-MARK. NC2474.2 +060600 PERFORM INIT-WRK-AREA. NC2474.2 +060700 SET ODO-IX TO 1. NC2474.2 +060800 SCH-TEST-F1-1. NC2474.2 +060900 SEARCH ODO-XN-00001-O009D NC2474.2 +061000 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +061100 PERFORM PASS NC2474.2 +061200 GO TO SCH-WRITE-F1-1. NC2474.2 +061300 GO TO SCH-FAIL-F1-1. NC2474.2 +061400 SCH-DELETE-F1-1. NC2474.2 +061500 PERFORM DE-LETE. NC2474.2 +061600 GO TO SCH-WRITE-F1-1. NC2474.2 +061700 SCH-FAIL-F1-1. NC2474.2 +061800 PERFORM FAIL. NC2474.2 +061900 MOVE "7 SHOULD BE FOUND" TO CORRECT-A NC2474.2 +062000 MOVE "7 WAS NOT FOUND" TO COMPUTED-A. NC2474.2 +062100 SCH-WRITE-F1-1. NC2474.2 +062200 PERFORM PRINT-DETAIL. NC2474.2 +062300* NC2474.2 +062400 SCH-INIT-F1-2. NC2474.2 +062500 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2474.2 +062600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +062700 MOVE "SEARCH PARTIAL ODO TABLE" TO RE-MARK. NC2474.2 +062800 PERFORM INIT-WRK-AREA. NC2474.2 +062900 MOVE 3 TO DOI-DU-01V00. NC2474.2 +063000 SET ODO-IX TO 1. NC2474.2 +063100 SCH-TEST-F1-2. NC2474.2 +063200 SEARCH ODO-XN-00001-O009D NC2474.2 +063300 AT END NC2474.2 +063400 PERFORM PASS NC2474.2 +063500 GO TO SCH-WRITE-F1-2 NC2474.2 +063600 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +063700 GO TO SCH-FAIL-F1-2. NC2474.2 +063800 SCH-DELETE-F1-2. NC2474.2 +063900 PERFORM DE-LETE. NC2474.2 +064000 GO TO SCH-WRITE-F1-2. NC2474.2 +064100 SCH-FAIL-F1-2. NC2474.2 +064200 PERFORM FAIL NC2474.2 +064300 MOVE "7 SHOULDN""T BE FOUND" TO CORRECT-A NC2474.2 +064400 MOVE "7 WAS FOUND" TO COMPUTED-A. NC2474.2 +064500 SCH-WRITE-F1-2. NC2474.2 +064600 PERFORM PRINT-DETAIL. NC2474.2 +064700* NC2474.2 +064800 SCH-INIT-F2-3. NC2474.2 +064900 MOVE "SCH-TEST-F2-3" TO PAR-NAME. NC2474.2 +065000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +065100 MOVE "SEARCH ALL FULL ODO TABLE" TO RE-MARK. NC2474.2 +065200 PERFORM INIT-WRK-AREA. NC2474.2 +065300 SCH-TEST-F2-3. NC2474.2 +065400 SEARCH ALL ODO-XN-00001-O009D NC2474.2 +065500 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +065600 PERFORM PASS NC2474.2 +065700 GO TO SCH-WRITE-F2-3. NC2474.2 +065800 GO TO SCH-FAIL-F2-3. NC2474.2 +065900 SCH-DELETE-F2-3. NC2474.2 +066000 PERFORM DE-LETE. NC2474.2 +066100 GO TO SCH-WRITE-F2-3. NC2474.2 +066200 SCH-FAIL-F2-3. NC2474.2 +066300 PERFORM FAIL NC2474.2 +066400 MOVE "7 SHOULD BE FOUND" TO CORRECT-A NC2474.2 +066500 MOVE "7 WAS NOT FOUND" TO COMPUTED-A. NC2474.2 +066600 SCH-WRITE-F2-3. NC2474.2 +066700 PERFORM PRINT-DETAIL. NC2474.2 +066800* NC2474.2 +066900 SCH-INIT-4. NC2474.2 +067000 MOVE "SCH-TEST-4" TO PAR-NAME. NC2474.2 +067100 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +067200 MOVE "SEARCH ALL PARTIAL ODO TABLE" TO RE-MARK. NC2474.2 +067300 PERFORM INIT-WRK-AREA. NC2474.2 +067400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +067500 SCH-TEST-4. NC2474.2 +067600 SEARCH ALL ODO-XN-00001-O009D NC2474.2 +067700 AT END NC2474.2 +067800 PERFORM PASS NC2474.2 +067900 GO TO SCH-WRITE-4 NC2474.2 +068000 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +068100 GO TO SCH-FAIL-4. NC2474.2 +068200 SCH-DELETE-4. NC2474.2 +068300 PERFORM DE-LETE. NC2474.2 +068400 GO TO SCH-WRITE-4. NC2474.2 +068500 SCH-FAIL-4. NC2474.2 +068600 PERFORM FAIL NC2474.2 +068700 MOVE "7 SHOULDN""T BE FOUND" TO CORRECT-A NC2474.2 +068800 MOVE "7 WAS FOUND" TO COMPUTED-A. NC2474.2 +068900 SCH-WRITE-4. NC2474.2 +069000 PERFORM PRINT-DETAIL. NC2474.2 +069100* NC2474.2 +069200 STR-INIT-GF-1. NC2474.2 +069300 MOVE "STR-TEST-GF-1" TO PAR-NAME. NC2474.2 +069400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +069500 MOVE "STRING FULL ODO AND LITERAL" TO RE-MARK. NC2474.2 +069600 PERFORM INIT-WRK-AREA. NC2474.2 +069700 MOVE SPACES TO WRK-XN-00020. NC2474.2 +069800 STR-TEST-GF-1. NC2474.2 +069900 STRING ODO-GRP-00009 "-TRAILER" DELIMITED BY SIZE NC2474.2 +070000 INTO WRK-XN-00020. NC2474.2 +070100 IF WRK-XN-00020 IS EQUAL TO "123456789-TRAILER " NC2474.2 +070200 PERFORM PASS NC2474.2 +070300 GO TO STR-WRITE-GF-1 NC2474.2 +070400 ELSE NC2474.2 +070500 GO TO STR-FAIL-GF-1. NC2474.2 +070600 STR-DELETE-GF-1. NC2474.2 +070700 PERFORM DE-LETE. NC2474.2 +070800 GO TO STR-WRITE-GF-1. NC2474.2 +070900 STR-FAIL-GF-1. NC2474.2 +071000 PERFORM FAIL NC2474.2 +071100 MOVE "123456789-TRAILER" TO CORRECT-A NC2474.2 +071200 MOVE WRK-XN-00020 TO COMPUTED-A. NC2474.2 +071300 STR-WRITE-GF-1. NC2474.2 +071400 PERFORM PRINT-DETAIL. NC2474.2 +071500* NC2474.2 +071600 STR-INIT-GF-2. NC2474.2 +071700 MOVE "STR-TEST-GF-2" TO PAR-NAME. NC2474.2 +071800 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +071900 MOVE "STRING PARTIAL ODO AND LITERAL" TO RE-MARK. NC2474.2 +072000 PERFORM INIT-WRK-AREA. NC2474.2 +072100 MOVE SPACES TO WRK-XN-00020. NC2474.2 +072200 MOVE 3 TO DOI-DU-01V00. NC2474.2 +072300 STR-TEST-GF-2. NC2474.2 +072400 STRING ODO-GRP-00009 "-TRAILER" DELIMITED BY SIZE NC2474.2 +072500 INTO WRK-XN-00020. NC2474.2 +072600 IF WRK-XN-00020 IS EQUAL TO "123-TRAILER " NC2474.2 +072700 PERFORM PASS NC2474.2 +072800 GO TO STR-WRITE-GF-2 NC2474.2 +072900 ELSE NC2474.2 +073000 GO TO STR-FAIL-GF-2. NC2474.2 +073100 STR-DELETE-GF-2. NC2474.2 +073200 PERFORM DE-LETE. NC2474.2 +073300 GO TO STR-WRITE-GF-2. NC2474.2 +073400 STR-FAIL-GF-2. NC2474.2 +073500 PERFORM FAIL NC2474.2 +073600 MOVE "123-TRAILER" TO CORRECT-A NC2474.2 +073700 MOVE WRK-XN-00020 TO COMPUTED-A. NC2474.2 +073800 STR-WRITE-GF-2. NC2474.2 +073900 PERFORM PRINT-DETAIL. NC2474.2 +074000* NC2474.2 +074100 STR-TEST-GF-3. NC2474.2 +074200 PERFORM INIT-WRK-AREA. NC2474.2 +074300 MOVE SPACES TO WRK-XN-00020. NC2474.2 +074400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +074500 STRING "LEADER-" ODO-GRP-00009 DELIMITED BY SIZE NC2474.2 +074600 INTO WRK-XN-00020. NC2474.2 +074700 IF WRK-XN-00020 IS EQUAL TO "LEADER-123 " NC2474.2 +074800 PERFORM PASS NC2474.2 +074900 GO TO STR-WRITE-GF-3 NC2474.2 +075000 ELSE NC2474.2 +075100 PERFORM FAIL NC2474.2 +075200 MOVE "LEADER-123" TO CORRECT-A NC2474.2 +075300 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +075400 PERFORM STR-WRITE-GF-3 NC2474.2 +075500 GO TO STR-DELETE-GF-4. NC2474.2 +075600 STR-DELETE-GF-3. NC2474.2 +075700 PERFORM DE-LETE. NC2474.2 +075800 STR-WRITE-GF-3. NC2474.2 +075900 MOVE "STR-TEST-GF-3" TO PAR-NAME. NC2474.2 +076000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +076100 MOVE "STRING LITERAL AND PARTIAL ODO" TO RE-MARK. NC2474.2 +076200 PERFORM PRINT-DETAIL. NC2474.2 +076300* NC2474.2 +076400 STR-INIT-GF-4. NC2474.2 +076500 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2474.2 +076600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +076700 MOVE "PARTIAL ODO/UNNEEDED OVERFLOW" TO RE-MARK. NC2474.2 +076800 PERFORM INIT-WRK-AREA NC2474.2 +076900 MOVE SPACES TO WRK-XN-00010. NC2474.2 +077000 MOVE 3 TO DOI-DU-01V00. NC2474.2 +077100 STR-TEST-GF-4. NC2474.2 +077200 STRING "LEADER-" ODO-GRP-00009 DELIMITED BY SIZE NC2474.2 +077300 INTO WRK-XN-00010 NC2474.2 +077400 ON OVERFLOW NC2474.2 +077500 GO TO STR-FAIL-GF-4. NC2474.2 +077600 PERFORM PASS. NC2474.2 +077700 GO TO STR-WRITE-GF-4. NC2474.2 +077800 STR-DELETE-GF-4. NC2474.2 +077900 PERFORM DE-LETE. NC2474.2 +078000 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2474.2 +078100 MOVE "DELETE AUTOMATIC IF" TO COMPUTED-A. NC2474.2 +078200 MOVE "STR-TEST-GF-3 FAILS" TO CORRECT-A. NC2474.2 +078300 GO TO STR-WRITE-GF-4. NC2474.2 +078400 STR-FAIL-GF-4. NC2474.2 +078500 PERFORM FAIL NC2474.2 +078600 MOVE "OVERFLOW EXIT TAKEN" TO COMPUTED-A NC2474.2 +078700 MOVE "NO EXIT NECESSARY" TO CORRECT-A. NC2474.2 +078800 STR-WRITE-GF-4. NC2474.2 +078900 PERFORM PRINT-DETAIL. NC2474.2 +079000* NC2474.2 +079100 UST-INIT-GF-1. NC2474.2 +079200 MOVE "UST-TEST-GF-1" TO PAR-NAME. NC2474.2 +079300 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +079400 MOVE "UNSTRING FULL ODO" TO RE-MARK. NC2474.2 +079500 PERFORM INIT-WRK-AREA. NC2474.2 +079600 MOVE SPACES TO WRK-XN-00010 WRK-XN-00020. NC2474.2 +079700 UST-TEST-GF-1. NC2474.2 +079800 UNSTRING GRP-ODO INTO WRK-XN-00010 WRK-XN-00020. NC2474.2 +079900 IF WRK-XN-00020 IS EQUAL TO "123456789 " NC2474.2 +080000 PERFORM PASS NC2474.2 +080100 GO TO UST-WRITE-GF-1 NC2474.2 +080200 ELSE NC2474.2 +080300 GO TO UST-FAIL-GF-1. NC2474.2 +080400 UST-DELETE-GF-1. NC2474.2 +080500 PERFORM DE-LETE. NC2474.2 +080600 GO TO UST-WRITE-GF-1. NC2474.2 +080700 UST-FAIL-GF-1. NC2474.2 +080800 PERFORM FAIL NC2474.2 +080900 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +081000 MOVE "123456789" TO CORRECT-A. NC2474.2 +081100 UST-WRITE-GF-1. NC2474.2 +081200 PERFORM PRINT-DETAIL. NC2474.2 +081300* NC2474.2 +081400 UST-INIT-GF-2. NC2474.2 +081500 MOVE "UST-TEST-GF-2" TO PAR-NAME. NC2474.2 +081600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +081700 MOVE "UNSTRING PARTIAL ODO" TO RE-MARK. NC2474.2 +081800 PERFORM INIT-WRK-AREA. NC2474.2 +081900 MOVE SPACES TO WRK-XN-00020 WRK-XN-00010. NC2474.2 +082000 MOVE 3 TO DOI-DU-01V00. NC2474.2 +082100 UST-TEST-GF-2. NC2474.2 +082200 UNSTRING GRP-ODO INTO WRK-XN-00010 WRK-XN-00020. NC2474.2 +082300 IF WRK-XN-00020 IS EQUAL TO "123 " NC2474.2 +082400 PERFORM PASS NC2474.2 +082500 GO TO UST-WRITE-GF-2 NC2474.2 +082600 ELSE NC2474.2 +082700 GO TO UST-FAIL-GF-2. NC2474.2 +082800 UST-DELETE-GF-2. NC2474.2 +082900 PERFORM DE-LETE. NC2474.2 +083000 GO TO UST-WRITE-GF-2. NC2474.2 +083100 UST-FAIL-GF-2. NC2474.2 +083200 PERFORM FAIL NC2474.2 +083300 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +083400 MOVE "123" TO CORRECT-A. NC2474.2 +083500 UST-WRITE-GF-2. NC2474.2 +083600 PERFORM PRINT-DETAIL. NC2474.2 +083700* NC2474.2 +083800 UST-INIT-GF-3. NC2474.2 +083900 MOVE "UST-TEST-GF-3" TO PAR-NAME. NC2474.2 +084000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +084100 MOVE "UNSTRING DELIMITED PARTIAL ODO" TO RE-MARK. NC2474.2 +084200 PERFORM INIT-WRK-AREA. NC2474.2 +084300 MOVE SPACES TO WRK-XN-00020. NC2474.2 +084400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +084500 UST-TEST-GF-3. NC2474.2 +084600 UNSTRING GRP-ODO DELIMITED BY "7" INTO WRK-XN-00020. NC2474.2 +084700 IF WRK-XN-00020 IS EQUAL TO "3 ACTIVE: 123 " NC2474.2 +084800 PERFORM PASS NC2474.2 +084900 GO TO UST-WRITE-GF-3 NC2474.2 +085000 ELSE NC2474.2 +085100 GO TO UST-FAIL-GF-3. NC2474.2 +085200 UST-DELETE-GF-3. NC2474.2 +085300 PERFORM DE-LETE. NC2474.2 +085400 GO TO UST-WRITE-GF-3. NC2474.2 +085500 UST-FAIL-GF-3. NC2474.2 +085600 PERFORM FAIL NC2474.2 +085700 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +085800 MOVE "3 ACTIVE: 123" TO CORRECT-A. NC2474.2 +085900 UST-WRITE-GF-3. NC2474.2 +086000 PERFORM PRINT-DETAIL. NC2474.2 +086100* NC2474.2 +086200 CCVS-EXIT SECTION. NC2474.2 +086300 CCVS-999999. NC2474.2 +086400 GO TO CLOSE-FILES. NC2474.2 +*END-OF,NC247A +*HEADER,COBOL,NC248A +000100 IDENTIFICATION DIVISION. NC2484.2 +000200 PROGRAM-ID. NC2484.2 +000300 NC248A. NC2484.2 +000400**************************************************************** NC2484.2 +000500* * NC2484.2 +000600* VALIDATION FOR:- * NC2484.2 +000700* * NC2484.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +000900* * NC2484.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2484.2 +001100* * NC2484.2 +001200**************************************************************** NC2484.2 +001300* * NC2484.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2484.2 +001500* * NC2484.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2484.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2484.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2484.2 +001900* * NC2484.2 +002000**************************************************************** NC2484.2 +002100* NC2484.2 +002200* PROGRAM NC248A TESTS FORMATS 1 AND 2 OF THE "SET" * NC2484.2 +002300* STATEMENT USING QUALIFICATION WITH INDEXED AND * NC2484.2 +002400* RELATIVE-INDEXED IDENTIFIERS. * NC2484.2 +002500* FORMAT 4 OF THE "SET" STATEMENT IS ALSO TESTED. * NC2484.2 +002600* * NC2484.2 +002700**************************************************************** NC2484.2 +002800 ENVIRONMENT DIVISION. NC2484.2 +002900 CONFIGURATION SECTION. NC2484.2 +003000 SOURCE-COMPUTER. NC2484.2 +003100 XXXXX082. NC2484.2 +003200 OBJECT-COMPUTER. NC2484.2 +003300 XXXXX083. NC2484.2 +003400 INPUT-OUTPUT SECTION. NC2484.2 +003500 FILE-CONTROL. NC2484.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2484.2 +003700 XXXXX055. NC2484.2 +003800 DATA DIVISION. NC2484.2 +003900 FILE SECTION. NC2484.2 +004000 FD PRINT-FILE. NC2484.2 +004100 01 PRINT-REC PICTURE X(120). NC2484.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2484.2 +004300 WORKING-STORAGE SECTION. NC2484.2 +004400 01 TEST-7-DATA. NC2484.2 +004500 03 TEST-7-1 PIC X. NC2484.2 +004600 88 TEST-7-1-TRUE VALUE "%". NC2484.2 +004700 01 TEST-8-DATA. NC2484.2 +004800 03 TEST-8-1 PIC X. NC2484.2 +004900 88 TEST-8-1-1-TRUE VALUE "J". NC2484.2 +005000 88 TEST-8-1-2-TRUE VALUE "A". NC2484.2 +005100 88 TEST-8-1-3-TRUE VALUE "N". NC2484.2 +005200 01 TEST-9-DATA. NC2484.2 +005300 03 TEST-9-1 PIC X. NC2484.2 +005400 88 TEST-9-1-1-TRUE VALUE "6". NC2484.2 +005500 88 TEST-9-1-2-TRUE VALUE "2". NC2484.2 +005600 03 TEST-9-2 PIC X. NC2484.2 +005700 88 TEST-9-2-1-TRUE VALUE "B". NC2484.2 +005800 88 TEST-9-2-2-TRUE VALUE "C". NC2484.2 +005900 03 TEST-9-3 PIC X. NC2484.2 +006000 88 TEST-9-3-1-TRUE VALUE "*". NC2484.2 +006100 88 TEST-9-3-2-TRUE VALUE "+". NC2484.2 +006200 NC2484.2 +006300 01 TABLE1. NC2484.2 +006400 02 TABLE1-REC PICTURE 99 NC2484.2 +006500 OCCURS 100 TIMES NC2484.2 +006600 INDEXED BY INDEX1. NC2484.2 +006700 01 TABLE2. NC2484.2 +006800 02 TABLE2-REC PICTURE 99 NC2484.2 +006900 OCCURS 12 TIMES NC2484.2 +007000 INDEXED BY INDEX2. NC2484.2 +007100 01 INDEX-ID PIC 999 VALUE ZEROS. NC2484.2 +007200 01 TEST-RESULTS. NC2484.2 +007300 02 FILLER PIC X VALUE SPACE. NC2484.2 +007400 02 FEATURE PIC X(20) VALUE SPACE. NC2484.2 +007500 02 FILLER PIC X VALUE SPACE. NC2484.2 +007600 02 P-OR-F PIC X(5) VALUE SPACE. NC2484.2 +007700 02 FILLER PIC X VALUE SPACE. NC2484.2 +007800 02 PAR-NAME. NC2484.2 +007900 03 FILLER PIC X(19) VALUE SPACE. NC2484.2 +008000 03 PARDOT-X PIC X VALUE SPACE. NC2484.2 +008100 03 DOTVALUE PIC 99 VALUE ZERO. NC2484.2 +008200 02 FILLER PIC X(8) VALUE SPACE. NC2484.2 +008300 02 RE-MARK PIC X(61). NC2484.2 +008400 01 TEST-COMPUTED. NC2484.2 +008500 02 FILLER PIC X(30) VALUE SPACE. NC2484.2 +008600 02 FILLER PIC X(17) VALUE NC2484.2 +008700 " COMPUTED=". NC2484.2 +008800 02 COMPUTED-X. NC2484.2 +008900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2484.2 +009000 03 COMPUTED-N REDEFINES COMPUTED-A NC2484.2 +009100 PIC -9(9).9(9). NC2484.2 +009200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2484.2 +009300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2484.2 +009400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2484.2 +009500 03 CM-18V0 REDEFINES COMPUTED-A. NC2484.2 +009600 04 COMPUTED-18V0 PIC -9(18). NC2484.2 +009700 04 FILLER PIC X. NC2484.2 +009800 03 FILLER PIC X(50) VALUE SPACE. NC2484.2 +009900 01 TEST-CORRECT. NC2484.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2484.2 +010100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2484.2 +010200 02 CORRECT-X. NC2484.2 +010300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2484.2 +010400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2484.2 +010500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2484.2 +010600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2484.2 +010700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2484.2 +010800 03 CR-18V0 REDEFINES CORRECT-A. NC2484.2 +010900 04 CORRECT-18V0 PIC -9(18). NC2484.2 +011000 04 FILLER PIC X. NC2484.2 +011100 03 FILLER PIC X(2) VALUE SPACE. NC2484.2 +011200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2484.2 +011300 01 CCVS-C-1. NC2484.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2484.2 +011500- "SS PARAGRAPH-NAME NC2484.2 +011600- " REMARKS". NC2484.2 +011700 02 FILLER PIC X(20) VALUE SPACE. NC2484.2 +011800 01 CCVS-C-2. NC2484.2 +011900 02 FILLER PIC X VALUE SPACE. NC2484.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". NC2484.2 +012100 02 FILLER PIC X(15) VALUE SPACE. NC2484.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". NC2484.2 +012300 02 FILLER PIC X(94) VALUE SPACE. NC2484.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2484.2 +012500 01 REC-CT PIC 99 VALUE ZERO. NC2484.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2484.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2484.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2484.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2484.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2484.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2484.2 +013500 01 CCVS-H-1. NC2484.2 +013600 02 FILLER PIC X(39) VALUE SPACES. NC2484.2 +013700 02 FILLER PIC X(42) VALUE NC2484.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2484.2 +013900 02 FILLER PIC X(39) VALUE SPACES. NC2484.2 +014000 01 CCVS-H-2A. NC2484.2 +014100 02 FILLER PIC X(40) VALUE SPACE. NC2484.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2484.2 +014300 02 FILLER PIC XXXX VALUE NC2484.2 +014400 "4.2 ". NC2484.2 +014500 02 FILLER PIC X(28) VALUE NC2484.2 +014600 " COPY - NOT FOR DISTRIBUTION". NC2484.2 +014700 02 FILLER PIC X(41) VALUE SPACE. NC2484.2 +014800 NC2484.2 +014900 01 CCVS-H-2B. NC2484.2 +015000 02 FILLER PIC X(15) VALUE NC2484.2 +015100 "TEST RESULT OF ". NC2484.2 +015200 02 TEST-ID PIC X(9). NC2484.2 +015300 02 FILLER PIC X(4) VALUE NC2484.2 +015400 " IN ". NC2484.2 +015500 02 FILLER PIC X(12) VALUE NC2484.2 +015600 " HIGH ". NC2484.2 +015700 02 FILLER PIC X(22) VALUE NC2484.2 +015800 " LEVEL VALIDATION FOR ". NC2484.2 +015900 02 FILLER PIC X(58) VALUE NC2484.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +016100 01 CCVS-H-3. NC2484.2 +016200 02 FILLER PIC X(34) VALUE NC2484.2 +016300 " FOR OFFICIAL USE ONLY ". NC2484.2 +016400 02 FILLER PIC X(58) VALUE NC2484.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2484.2 +016600 02 FILLER PIC X(28) VALUE NC2484.2 +016700 " COPYRIGHT 1985 ". NC2484.2 +016800 01 CCVS-E-1. NC2484.2 +016900 02 FILLER PIC X(52) VALUE SPACE. NC2484.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2484.2 +017100 02 ID-AGAIN PIC X(9). NC2484.2 +017200 02 FILLER PIC X(45) VALUE SPACES. NC2484.2 +017300 01 CCVS-E-2. NC2484.2 +017400 02 FILLER PIC X(31) VALUE SPACE. NC2484.2 +017500 02 FILLER PIC X(21) VALUE SPACE. NC2484.2 +017600 02 CCVS-E-2-2. NC2484.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2484.2 +017800 03 FILLER PIC X VALUE SPACE. NC2484.2 +017900 03 ENDER-DESC PIC X(44) VALUE NC2484.2 +018000 "ERRORS ENCOUNTERED". NC2484.2 +018100 01 CCVS-E-3. NC2484.2 +018200 02 FILLER PIC X(22) VALUE NC2484.2 +018300 " FOR OFFICIAL USE ONLY". NC2484.2 +018400 02 FILLER PIC X(12) VALUE SPACE. NC2484.2 +018500 02 FILLER PIC X(58) VALUE NC2484.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +018700 02 FILLER PIC X(13) VALUE SPACE. NC2484.2 +018800 02 FILLER PIC X(15) VALUE NC2484.2 +018900 " COPYRIGHT 1985". NC2484.2 +019000 01 CCVS-E-4. NC2484.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2484.2 +019200 02 FILLER PIC X(4) VALUE " OF ". NC2484.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2484.2 +019400 02 FILLER PIC X(40) VALUE NC2484.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2484.2 +019600 01 XXINFO. NC2484.2 +019700 02 FILLER PIC X(19) VALUE NC2484.2 +019800 "*** INFORMATION ***". NC2484.2 +019900 02 INFO-TEXT. NC2484.2 +020000 04 FILLER PIC X(8) VALUE SPACE. NC2484.2 +020100 04 XXCOMPUTED PIC X(20). NC2484.2 +020200 04 FILLER PIC X(5) VALUE SPACE. NC2484.2 +020300 04 XXCORRECT PIC X(20). NC2484.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). NC2484.2 +020500 01 HYPHEN-LINE. NC2484.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. NC2484.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************NC2484.2 +020800- "*****************************************". NC2484.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************NC2484.2 +021000- "******************************". NC2484.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE NC2484.2 +021200 "NC248A". NC2484.2 +021300 PROCEDURE DIVISION. NC2484.2 +021400 CCVS1 SECTION. NC2484.2 +021500 OPEN-FILES. NC2484.2 +021600 OPEN OUTPUT PRINT-FILE. NC2484.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2484.2 +021800 MOVE SPACE TO TEST-RESULTS. NC2484.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2484.2 +022000 GO TO CCVS1-EXIT. NC2484.2 +022100 CLOSE-FILES. NC2484.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2484.2 +022300 TERMINATE-CCVS. NC2484.2 +022400S EXIT PROGRAM. NC2484.2 +022500STERMINATE-CALL. NC2484.2 +022600 STOP RUN. NC2484.2 +022700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2484.2 +022800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2484.2 +022900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2484.2 +023000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2484.2 +023100 MOVE "****TEST DELETED****" TO RE-MARK. NC2484.2 +023200 PRINT-DETAIL. NC2484.2 +023300 IF REC-CT NOT EQUAL TO ZERO NC2484.2 +023400 MOVE "." TO PARDOT-X NC2484.2 +023500 MOVE REC-CT TO DOTVALUE. NC2484.2 +023600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2484.2 +023700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2484.2 +023800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2484.2 +023900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2484.2 +024000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2484.2 +024100 MOVE SPACE TO CORRECT-X. NC2484.2 +024200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2484.2 +024300 MOVE SPACE TO RE-MARK. NC2484.2 +024400 HEAD-ROUTINE. NC2484.2 +024500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +024600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +024700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2484.2 +024800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2484.2 +024900 COLUMN-NAMES-ROUTINE. NC2484.2 +025000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +025100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +025300 END-ROUTINE. NC2484.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2484.2 +025500 END-RTN-EXIT. NC2484.2 +025600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +025700 END-ROUTINE-1. NC2484.2 +025800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2484.2 +025900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2484.2 +026000 ADD PASS-COUNTER TO ERROR-HOLD. NC2484.2 +026100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2484.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2484.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2484.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2484.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2484.2 +026600 END-ROUTINE-12. NC2484.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2484.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2484.2 +026900 MOVE "NO " TO ERROR-TOTAL NC2484.2 +027000 ELSE NC2484.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2484.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2484.2 +027300 PERFORM WRITE-LINE. NC2484.2 +027400 END-ROUTINE-13. NC2484.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2484.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE NC2484.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2484.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2484.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO NC2484.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2484.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2484.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2484.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028600 WRITE-LINE. NC2484.2 +028700 ADD 1 TO RECORD-COUNT. NC2484.2 +028800Y IF RECORD-COUNT GREATER 50 NC2484.2 +028900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2484.2 +029000Y MOVE SPACE TO DUMMY-RECORD NC2484.2 +029100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2484.2 +029200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2484.2 +029300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2484.2 +029400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2484.2 +029500Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2484.2 +029600Y MOVE ZERO TO RECORD-COUNT. NC2484.2 +029700 PERFORM WRT-LN. NC2484.2 +029800 WRT-LN. NC2484.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2484.2 +030000 MOVE SPACE TO DUMMY-RECORD. NC2484.2 +030100 BLANK-LINE-PRINT. NC2484.2 +030200 PERFORM WRT-LN. NC2484.2 +030300 FAIL-ROUTINE. NC2484.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2484.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2484.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2484.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2484.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2484.2 +031000 GO TO FAIL-ROUTINE-EX. NC2484.2 +031100 FAIL-ROUTINE-WRITE. NC2484.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2484.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2484.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2484.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2484.2 +031600 FAIL-ROUTINE-EX. EXIT. NC2484.2 +031700 BAIL-OUT. NC2484.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2484.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2484.2 +032000 BAIL-OUT-WRITE. NC2484.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2484.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2484.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2484.2 +032500 BAIL-OUT-EX. EXIT. NC2484.2 +032600 CCVS1-EXIT. NC2484.2 +032700 EXIT. NC2484.2 +032800 BUILD-TABLE2. NC2484.2 +032900 MOVE 21 TO TABLE2-REC (1). NC2484.2 +033000 MOVE 02 TO TABLE2-REC (2). NC2484.2 +033100 MOVE 03 TO TABLE2-REC (3). NC2484.2 +033200 MOVE 11 TO TABLE2-REC (4). NC2484.2 +033300 MOVE 05 TO TABLE2-REC (5). NC2484.2 +033400 MOVE 10 TO TABLE2-REC (6). NC2484.2 +033500 MOVE 26 TO TABLE2-REC (7). NC2484.2 +033600 MOVE 02 TO TABLE2-REC (8). NC2484.2 +033700 MOVE 16 TO TABLE2-REC (9). NC2484.2 +033800 MOVE 62 TO TABLE2-REC (10). NC2484.2 +033900 MOVE 10 TO TABLE2-REC (11). NC2484.2 +034000 MOVE 04 TO TABLE2-REC (12). NC2484.2 +034100* NC2484.2 +034200 SET-INIT-F1-1. NC2484.2 +034300 MOVE "SET-TEST-F1-1" TO PAR-NAME. NC2484.2 +034400 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +034500 MOVE "SET ... TO" TO FEATURE. NC2484.2 +034600 SET-TEST-F1-1. NC2484.2 +034700 SET INDEX1 TO 1. NC2484.2 +034800 SET INDEX2 TO 4. NC2484.2 +034900 SET INDEX1 TO TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +035000 IF INDEX1 EQUAL TO 11 NC2484.2 +035100 PERFORM PASS NC2484.2 +035200 GO TO SET-WRITE-F1-1 NC2484.2 +035300 ELSE NC2484.2 +035400 GO TO SET-FAIL-F1-1. NC2484.2 +035500 SET-DELETE-F1-1. NC2484.2 +035600 PERFORM DE-LETE. NC2484.2 +035700 GO TO SET-WRITE-F1-1. NC2484.2 +035800 SET-FAIL-F1-1. NC2484.2 +035900 PERFORM FAIL. NC2484.2 +036000 SET INDEX-ID TO INDEX1. NC2484.2 +036100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +036200 MOVE 11 TO CORRECT-18V0. NC2484.2 +036300 SET-WRITE-F1-1. NC2484.2 +036400 PERFORM PRINT-DETAIL. NC2484.2 +036500* NC2484.2 +036600 SET-INIT-F2-2. NC2484.2 +036700 MOVE "SET-TEST-F2-2" TO PAR-NAME. NC2484.2 +036800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +036900 MOVE "SET ... UP BY" TO FEATURE. NC2484.2 +037000 PERFORM BUILD-TABLE2. NC2484.2 +037100 SET-TEST-F2-2. NC2484.2 +037200 SET INDEX1 TO 11. NC2484.2 +037300 SET INDEX2 TO 5. NC2484.2 +037400 SET INDEX1 UP BY TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +037500 IF INDEX1 EQUAL TO 16 NC2484.2 +037600 PERFORM PASS NC2484.2 +037700 GO TO SET-WRITE-F2-2 NC2484.2 +037800 ELSE NC2484.2 +037900 GO TO SET-FAIL-F2-2. NC2484.2 +038000 SET-DELETE-F2-2. NC2484.2 +038100 PERFORM DE-LETE. NC2484.2 +038200 GO TO SET-WRITE-F2-2. NC2484.2 +038300 SET-FAIL-F2-2. NC2484.2 +038400 PERFORM FAIL. NC2484.2 +038500 SET INDEX-ID TO INDEX1. NC2484.2 +038600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +038700 MOVE 16 TO CORRECT-18V0. NC2484.2 +038800 SET-WRITE-F2-2. NC2484.2 +038900 PERFORM PRINT-DETAIL. NC2484.2 +039000* NC2484.2 +039100 SET-INIT-F2-3. NC2484.2 +039200 MOVE "SET-TEST-F2-3" TO PAR-NAME. NC2484.2 +039300 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +039400 MOVE "SET ... DOWN BY" TO FEATURE. NC2484.2 +039500 PERFORM BUILD-TABLE2. NC2484.2 +039600 SET-TEST-F2-3. NC2484.2 +039700 SET INDEX1 TO 16. NC2484.2 +039800 SET INDEX2 TO 6. NC2484.2 +039900 SET INDEX1 DOWN BY TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +040000 IF INDEX1 EQUAL TO 06 NC2484.2 +040100 PERFORM PASS NC2484.2 +040200 GO TO SET-WRITE-F2-3 NC2484.2 +040300 ELSE NC2484.2 +040400 GO TO SET-FAIL-F2-3. NC2484.2 +040500 SET-DELETE-F2-3. NC2484.2 +040600 PERFORM DE-LETE. NC2484.2 +040700 GO TO SET-WRITE-F2-3. NC2484.2 +040800 SET-FAIL-F2-3. NC2484.2 +040900 PERFORM FAIL. NC2484.2 +041000 SET INDEX-ID TO INDEX1. NC2484.2 +041100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +041200 MOVE 06 TO CORRECT-18V0. NC2484.2 +041300 SET-WRITE-F2-3. NC2484.2 +041400 PERFORM PRINT-DETAIL. NC2484.2 +041500* NC2484.2 +041600 SET-INIT-F1-4. NC2484.2 +041700 MOVE "SET-TEST-F1-4" TO PAR-NAME. NC2484.2 +041800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +041900 MOVE "SET ... TO" TO FEATURE. NC2484.2 +042000 PERFORM BUILD-TABLE2. NC2484.2 +042100 SET-TEST-F1-4. NC2484.2 +042200 SET INDEX1 TO 1. NC2484.2 +042300 SET INDEX2 TO 11. NC2484.2 +042400 SET INDEX1 TO TABLE2-REC OF TABLE2 (INDEX2 + 1). NC2484.2 +042500 IF INDEX1 EQUAL TO 4 NC2484.2 +042600 PERFORM PASS NC2484.2 +042700 GO TO SET-WRITE-F1-4 NC2484.2 +042800 ELSE NC2484.2 +042900 GO TO SET-FAIL-F1-4. NC2484.2 +043000 SET-DELETE-F1-4. NC2484.2 +043100 PERFORM DE-LETE. NC2484.2 +043200 GO TO SET-WRITE-F1-4. NC2484.2 +043300 SET-FAIL-F1-4. NC2484.2 +043400 PERFORM FAIL. NC2484.2 +043500 SET INDEX-ID TO INDEX1. NC2484.2 +043600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +043700 MOVE 4 TO CORRECT-18V0. NC2484.2 +043800 SET-WRITE-F1-4. NC2484.2 +043900 PERFORM PRINT-DETAIL. NC2484.2 +044000* NC2484.2 +044100 SET-INIT-F2-5. NC2484.2 +044200 MOVE "SET-TEST-F2-5" TO PAR-NAME. NC2484.2 +044300 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +044400 MOVE "SET ... UP BY" TO FEATURE. NC2484.2 +044500 PERFORM BUILD-TABLE2. NC2484.2 +044600 SET-TEST-F2-5. NC2484.2 +044700 SET INDEX1 TO 1. NC2484.2 +044800 SET INDEX2 TO 3. NC2484.2 +044900 SET INDEX1 UP BY TABLE2-REC OF TABLE2 (INDEX2 - 2). NC2484.2 +045000 IF INDEX1 EQUAL TO 22 NC2484.2 +045100 PERFORM PASS NC2484.2 +045200 GO TO SET-WRITE-F2-5 NC2484.2 +045300 ELSE NC2484.2 +045400 GO TO SET-FAIL-F2-5. NC2484.2 +045500 SET-DELETE-F2-5. NC2484.2 +045600 PERFORM DE-LETE. NC2484.2 +045700 GO TO SET-WRITE-F2-5. NC2484.2 +045800 SET-FAIL-F2-5. NC2484.2 +045900 PERFORM FAIL. NC2484.2 +046000 SET INDEX-ID TO INDEX1. NC2484.2 +046100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +046200 MOVE 22 TO CORRECT-18V0. NC2484.2 +046300 SET-WRITE-F2-5. NC2484.2 +046400 PERFORM PRINT-DETAIL. NC2484.2 +046500* NC2484.2 +046600 SET-INIT-F2-6. NC2484.2 +046700 MOVE "SET-TEST-F2-6" TO PAR-NAME. NC2484.2 +046800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +046900 MOVE "SET ... DOWN BY" TO FEATURE. NC2484.2 +047000 PERFORM BUILD-TABLE2. NC2484.2 +047100 SET-TEST-F2-6. NC2484.2 +047200 SET INDEX1 TO 16. NC2484.2 +047300 SET INDEX2 TO 12. NC2484.2 +047400 SET INDEX1 DOWN BY TABLE2-REC OF TABLE2 (INDEX2 - 6). NC2484.2 +047500 IF INDEX1 EQUAL TO 06 NC2484.2 +047600 PERFORM PASS NC2484.2 +047700 GO TO SET-WRITE-F2-6 NC2484.2 +047800 ELSE NC2484.2 +047900 GO TO SET-FAIL-F2-6. NC2484.2 +048000 SET-DELETE-F2-6. NC2484.2 +048100 PERFORM DE-LETE. NC2484.2 +048200 GO TO SET-WRITE-F2-6. NC2484.2 +048300 SET-FAIL-F2-6. NC2484.2 +048400 PERFORM FAIL. NC2484.2 +048500 SET INDEX-ID TO INDEX1. NC2484.2 +048600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +048700 MOVE 06 TO CORRECT-18V0. NC2484.2 +048800 SET-WRITE-F2-6. NC2484.2 +048900 PERFORM PRINT-DETAIL. NC2484.2 +049000* NC2484.2 +049100 SET-INIT-F2-7. NC2484.2 +049200 MOVE "SET-TEST-F2-7" TO PAR-NAME. NC2484.2 +049300 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +049400 MOVE SPACE TO TEST-7-1. NC2484.2 +049500 SET-TEST-F2-7-0. NC2484.2 +049600 SET TEST-7-1-TRUE TO TRUE. NC2484.2 +049700 GO TO SET-TEST-F2-7-1. NC2484.2 +049800 SET-DELETE-F2-7. NC2484.2 +049900 PERFORM DE-LETE. NC2484.2 +050000 GO TO SET-WRITE-F2-7-1. NC2484.2 +050100* NC2484.2 +050200 SET-TEST-F2-7-1. NC2484.2 +050300 IF TEST-7-1 = "%" NC2484.2 +050400 PERFORM PASS NC2484.2 +050500 GO TO SET-WRITE-F2-7-1 NC2484.2 +050600 ELSE NC2484.2 +050700 GO TO SET-FAIL-F2-7-1. NC2484.2 +050800 SET-DELETE-F2-7-1. NC2484.2 +050900 PERFORM DE-LETE. NC2484.2 +051000 GO TO SET-WRITE-F2-7-1. NC2484.2 +051100 SET-FAIL-F2-7-1. NC2484.2 +051200 PERFORM FAIL. NC2484.2 +051300 MOVE "CONDITION VARIABLE NOT SET TO TRUE VALUE" NC2484.2 +051400 TO RE-MARK. NC2484.2 +051500 MOVE TEST-7-1 TO COMPUTED-X. NC2484.2 +051600 MOVE "%" TO CORRECT-X. NC2484.2 +051700 SET-WRITE-F2-7-1. NC2484.2 +051800 PERFORM PRINT-DETAIL. NC2484.2 +051900* NC2484.2 +052000 SET-INIT-F2-8. NC2484.2 +052100 MOVE "SET-TEST-F2-8" TO PAR-NAME. NC2484.2 +052200 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +052300 MOVE SPACE TO TEST-8-1. NC2484.2 +052400 SET-TEST-F2-8-0. NC2484.2 +052500 SET TEST-8-1-1-TRUE TO TRUE. NC2484.2 +052600 GO TO SET-TEST-F2-8-1. NC2484.2 +052700 SET-DELETE-F2-8. NC2484.2 +052800 PERFORM DE-LETE. NC2484.2 +052900 GO TO SET-WRITE-F2-8-1. NC2484.2 +053000* NC2484.2 +053100 SET-TEST-F2-8-1. NC2484.2 +053200 IF TEST-8-1 = "J" NC2484.2 +053300 PERFORM PASS NC2484.2 +053400 GO TO SET-WRITE-F2-8-1 NC2484.2 +053500 ELSE NC2484.2 +053600 GO TO SET-FAIL-F2-8-1. NC2484.2 +053700 SET-DELETE-F2-8-1. NC2484.2 +053800 PERFORM DE-LETE. NC2484.2 +053900 GO TO SET-WRITE-F2-8-1. NC2484.2 +054000 SET-FAIL-F2-8-1. NC2484.2 +054100 PERFORM FAIL. NC2484.2 +054200 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +054300 TO RE-MARK. NC2484.2 +054400 MOVE TEST-8-1 TO COMPUTED-X. NC2484.2 +054500 MOVE "J" TO CORRECT-X. NC2484.2 +054600 SET-WRITE-F2-8-1. NC2484.2 +054700 PERFORM PRINT-DETAIL. NC2484.2 +054800* NC2484.2 +054900 SET-INIT-F2-9. NC2484.2 +055000 MOVE "SET-TEST-F2-9" TO PAR-NAME. NC2484.2 +055100 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +055200 MOVE SPACE TO TEST-8-1. NC2484.2 +055300 MOVE 1 TO REC-CT. NC2484.2 +055400 SET-TEST-F2-9-0. NC2484.2 +055500 SET TEST-9-1-1-TRUE NC2484.2 +055600 TEST-9-2-1-TRUE NC2484.2 +055700 TEST-9-3-1-TRUE TO TRUE. NC2484.2 +055800 GO TO SET-TEST-F2-9-1. NC2484.2 +055900 SET-DELETE-F2-9. NC2484.2 +056000 PERFORM DE-LETE. NC2484.2 +056100 GO TO SET-WRITE-F2-9-3. NC2484.2 +056200* NC2484.2 +056300 SET-TEST-F2-9-1. NC2484.2 +056400 IF TEST-9-1 = "6" NC2484.2 +056500 PERFORM PASS NC2484.2 +056600 GO TO SET-WRITE-F2-9-1 NC2484.2 +056700 ELSE NC2484.2 +056800 GO TO SET-FAIL-F2-9-1. NC2484.2 +056900 SET-DELETE-F2-9-1. NC2484.2 +057000 PERFORM DE-LETE. NC2484.2 +057100 GO TO SET-WRITE-F2-9-1. NC2484.2 +057200 SET-FAIL-F2-9-1. NC2484.2 +057300 PERFORM FAIL. NC2484.2 +057400 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +057500 TO RE-MARK. NC2484.2 +057600 MOVE TEST-9-1 TO COMPUTED-X. NC2484.2 +057700 MOVE "6" TO CORRECT-X. NC2484.2 +057800 SET-WRITE-F2-9-1. NC2484.2 +057900 PERFORM PRINT-DETAIL. NC2484.2 +058000* NC2484.2 +058100 SET-TEST-F2-9-2. NC2484.2 +058200 ADD 1 TO REC-CT. NC2484.2 +058300 IF TEST-9-2 = "B" NC2484.2 +058400 PERFORM PASS NC2484.2 +058500 GO TO SET-WRITE-F2-9-2 NC2484.2 +058600 ELSE NC2484.2 +058700 GO TO SET-FAIL-F2-9-2. NC2484.2 +058800 SET-DELETE-F2-9-2. NC2484.2 +058900 PERFORM DE-LETE. NC2484.2 +059000 GO TO SET-WRITE-F2-9-2. NC2484.2 +059100 SET-FAIL-F2-9-2. NC2484.2 +059200 PERFORM FAIL. NC2484.2 +059300 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +059400 TO RE-MARK. NC2484.2 +059500 MOVE TEST-9-2 TO COMPUTED-X. NC2484.2 +059600 MOVE "6" TO CORRECT-X. NC2484.2 +059700 SET-WRITE-F2-9-2. NC2484.2 +059800 PERFORM PRINT-DETAIL. NC2484.2 +059900* NC2484.2 +060000 SET-TEST-F2-9-3. NC2484.2 +060100 ADD 1 TO REC-CT. NC2484.2 +060200 IF TEST-9-3 = "*" NC2484.2 +060300 PERFORM PASS NC2484.2 +060400 GO TO SET-WRITE-F2-9-3 NC2484.2 +060500 ELSE NC2484.2 +060600 GO TO SET-FAIL-F2-9-3. NC2484.2 +060700 SET-DELETE-F2-9-3. NC2484.2 +060800 PERFORM DE-LETE. NC2484.2 +060900 GO TO SET-WRITE-F2-9-3. NC2484.2 +061000 SET-FAIL-F2-9-3. NC2484.2 +061100 PERFORM FAIL. NC2484.2 +061200 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +061300 TO RE-MARK. NC2484.2 +061400 MOVE TEST-9-3 TO COMPUTED-X. NC2484.2 +061500 MOVE "*" TO CORRECT-X. NC2484.2 +061600 SET-WRITE-F2-9-3. NC2484.2 +061700 PERFORM PRINT-DETAIL. NC2484.2 +061800* NC2484.2 +061900 CCVS-EXIT SECTION. NC2484.2 +062000 CCVS-999999. NC2484.2 +062100 GO TO CLOSE-FILES. NC2484.2 +*END-OF,NC248A +*HEADER,COBOL,NC250A +000100 IDENTIFICATION DIVISION. NC2504.2 +000200 PROGRAM-ID. NC2504.2 +000300 NC250A. NC2504.2 +000400 NC2504.2 +000500**************************************************************** NC2504.2 +000600* * NC2504.2 +000700* VALIDATION FOR:- * NC2504.2 +000800* * NC2504.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +001000* * NC2504.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2504.2 +001200* * NC2504.2 +001300**************************************************************** NC2504.2 +001400* * NC2504.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2504.2 +001600* * NC2504.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2504.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2504.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2504.2 +002000* * NC2504.2 +002100**************************************************************** NC2504.2 +002200* NC2504.2 +002300* PROGRAM NC250A TESTS THE GENERAL FORMAT OF THE "IF" STATEMENTNC2504.2 +002400* A VARIETY OF QUALIFIED DATA-NAMES AND CONDITION-NAMES NC2504.2 +002500* ARE USED. NC2504.2 +002600* NC2504.2 +002700 NC2504.2 +002800 ENVIRONMENT DIVISION. NC2504.2 +002900 CONFIGURATION SECTION. NC2504.2 +003000 SOURCE-COMPUTER. NC2504.2 +003100 XXXXX082. NC2504.2 +003200 OBJECT-COMPUTER. NC2504.2 +003300 XXXXX083. NC2504.2 +003400 INPUT-OUTPUT SECTION. NC2504.2 +003500 FILE-CONTROL. NC2504.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2504.2 +003700 XXXXX055. NC2504.2 +003800 DATA DIVISION. NC2504.2 +003900 FILE SECTION. NC2504.2 +004000 FD PRINT-FILE. NC2504.2 +004100 01 PRINT-REC PICTURE X(120). NC2504.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2504.2 +004300 WORKING-STORAGE SECTION. NC2504.2 +004400 01 WRK-DU-1V0-1 PIC 9 VALUE 1. NC2504.2 +004500 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2504.2 +004600 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2504.2 +004700 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2504.2 +004800 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2504.2 +004900 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2504.2 +005000 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2504.2 +005100 77 SMALL-VALU PICTURE 99 VALUE 7. NC2504.2 +005200 77 SMALLER-VALU PICTURE 99 VALUE 6. NC2504.2 +005300 77 SMALLEST-VALU PICTURE 99 VALUE 5. NC2504.2 +005400 77 EVEN-SMALLER PICTURE 99 VALUE 1. NC2504.2 +005500 77 WRK-DS-02V00 PICTURE S99. NC2504.2 +005600 88 TEST-2NUC-COND-99 VALUE 99. NC2504.2 +005700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2504.2 +005800 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2504.2 +005900 PICTURE S9(12). NC2504.2 +006000 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2504.2 +006100 77 WRK-DS-01V00 PICTURE S9. NC2504.2 +006200 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2504.2 +006300 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2504.2 +006400 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2504.2 +006500 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2504.2 +006600 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2504.2 +006700 77 WRK-XN-00001 PICTURE X. NC2504.2 +006800 77 WRK-XN-00005 PICTURE X(5). NC2504.2 +006900 77 TWO PICTURE 9 VALUE 2. NC2504.2 +007000 77 THREE PICTURE 9 VALUE 3. NC2504.2 +007100 77 SEVEN PICTURE 9 VALUE 7. NC2504.2 +007200 77 EIGHT PICTURE 9 VALUE 8. NC2504.2 +007300 77 NINE PICTURE 9 VALUE 9. NC2504.2 +007400 77 TEN PICTURE 99 VALUE 10. NC2504.2 +007500 77 TWENTY PICTURE 99 VALUE 20. NC2504.2 +007600 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2504.2 +007700 77 XRAY PICTURE IS X. NC2504.2 +007800 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2504.2 +007900 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2504.2 +008000 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2504.2 +008100 77 IF-D4 PICTURE X(15) VALUE " ". NC2504.2 +008200 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2504.2 +008300 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2504.2 +008400 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2504.2 +008500 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2504.2 +008600 77 IF-D9 PICTURE X(3) VALUE "123". NC2504.2 +008700 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2504.2 +008800 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2504.2 +008900 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2504.2 +009000 77 IF-D15 PICTURE S999PP VALUE 12300. NC2504.2 +009100 77 IF-D16 PICTURE PP99 VALUE .0012. NC2504.2 +009200 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2504.2 +009300 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2504.2 +009400 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2504.2 +009500 77 IF-D23 PICTURE $9,9B9.90+. NC2504.2 +009600 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". NC2504.2 +009700 77 IF-D25 PICTURE ABABX0A. NC2504.2 +009800 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2504.2 +009900 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2504.2 +010000 USAGE IS COMPUTATIONAL. NC2504.2 +010100 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2504.2 +010200 77 IF-D31 PICTURE S9(6) VALUE -123. NC2504.2 +010300 77 IF-D32 PICTURE S9(4)V99. NC2504.2 +010400 88 A VALUE 1. NC2504.2 +010500 88 B VALUES ARE 2 THRU 4. NC2504.2 +010600 88 C VALUE IS ZERO. NC2504.2 +010700 88 D VALUE IS +12.34. NC2504.2 +010800 88 E VALUE IS .01, .11, .21 .81. NC2504.2 +010900 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2504.2 +011000 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2504.2 +011100 77 IF-D33 PICTURE X(4). NC2504.2 +011200 88 B VALUE QUOTE. NC2504.2 +011300 88 C VALUE SPACE. NC2504.2 +011400 88 D VALUE ALL "BAC". NC2504.2 +011500 77 IF-D34 PICTURE A(4). NC2504.2 +011600 88 B VALUE "A A ". NC2504.2 +011700 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2504.2 +011800 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2504.2 +011900 77 CCON-1 PICTURE 99 VALUE 11. NC2504.2 +012000 77 CCON-2 PICTURE 99 VALUE 12. NC2504.2 +012100 77 CCON-3 PICTURE 99 VALUE 13. NC2504.2 +012200 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. NC2504.2 +012300 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. NC2504.2 +012400 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. NC2504.2 +012500 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.NC2504.2 +012600 77 START-POINT PICTURE 9(6) COMPUTATIONAL. NC2504.2 +012700 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. NC2504.2 +012800 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. NC2504.2 +012900 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. NC2504.2 +013000 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. NC2504.2 +013100 77 PFM-12-COUNTER PICTURE 999 VALUE 100. NC2504.2 +013200 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. NC2504.2 +013300 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. NC2504.2 +013400 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2504.2 +013500 01 IF-TABLE. NC2504.2 +013600 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2504.2 +013700 01 QUOTE-DATA. NC2504.2 +013800 02 QU-1 PICTURE X(3) VALUE "123". NC2504.2 +013900 02 QU-2 PICTURE X VALUE QUOTE. NC2504.2 +014000 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2504.2 +014100 01 IF-D10. NC2504.2 +014200 02 D1 PICTURE X(2) VALUE "01". NC2504.2 +014300 02 D2 PICTURE X(2) VALUE "23". NC2504.2 +014400 02 D3. NC2504.2 +014500 03 D4 PICTURE X(4) VALUE "4567". NC2504.2 +014600 03 D5 PICTURE X(4) VALUE "8912". NC2504.2 +014700 01 IF-D12. NC2504.2 +014800 02 D1 PICTURE X(3) VALUE "ABC". NC2504.2 +014900 02 D2. NC2504.2 +015000 03 D3. NC2504.2 +015100 04 D4 PICTURE XX VALUE "DE". NC2504.2 +015200 04 D5 PICTURE X VALUE "F". NC2504.2 +015300 01 IF-D20. NC2504.2 +015400 02 FILLER PICTURE 9(5) VALUE ZERO. NC2504.2 +015500 02 D1 PICTURE 9(2) VALUE 12. NC2504.2 +015600 02 D2 PICTURE 9 VALUE 3. NC2504.2 +015700 02 D3 PICTURE 9(2) VALUE 45. NC2504.2 +015800 01 IF-D21. NC2504.2 +015900 02 D1 PICTURE 9(5) VALUE ZEROS. NC2504.2 +016000 02 D2 PICTURE 9(5) VALUE 12345. NC2504.2 +016100 01 IF-D22. NC2504.2 +016200 02 D1 PICTURE A(2) VALUE "AB". NC2504.2 +016300 02 D2 PICTURE A(4) VALUE "CDEF". NC2504.2 +016400 01 IF-D35. NC2504.2 +016500 02 AA PICTURE X(2). NC2504.2 +016600 88 A1 VALUE "AA". NC2504.2 +016700 88 A2 VALUE "AB". NC2504.2 +016800 02 BB PICTURE IS X(2). NC2504.2 +016900 88 B1 VALUE "CC". NC2504.2 +017000 88 B2 VALUE "CD". NC2504.2 +017100 02 BB-2 REDEFINES BB. NC2504.2 +017200 03 AAA PICTURE X. NC2504.2 +017300 88 AA1 VALUE "A". NC2504.2 +017400 88 AA2 VALUE "C". NC2504.2 +017500 03 BBB PICTURE X. NC2504.2 +017600 88 BB1 VALUE "B". NC2504.2 +017700 88 BB2 VALUE "D". NC2504.2 +017800 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2504.2 +017900- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2504.2 +018000- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2504.2 +018100 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2504.2 +018200 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2504.2 +018300 88 IF-D40A VALUE ZERO THRU 10000. NC2504.2 +018400 88 IF-D40B VALUE 10001 THRU 99999. NC2504.2 +018500 88 IF-D40C VALUE 99999. NC2504.2 +018600 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2504.2 +018700 01 PERFORM2 PICTURE S999 VALUE 20. NC2504.2 +018800 01 PERFORM3 PICTURE 9 VALUE 5. NC2504.2 +018900 01 PERFORM4 PICTURE S99V9. NC2504.2 +019000 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2504.2 +019100 01 PERFORM6 PICTURE 99V9. NC2504.2 +019200 01 PERFORM7. NC2504.2 +019300 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2504.2 +019400 01 PERFORM9 PICTURE 9 VALUE 3. NC2504.2 +019500 01 PERFORM10 PICTURE S9 VALUE -1. NC2504.2 +019600 01 PERFORM11 PICTURE 99 VALUE 6. NC2504.2 +019700 01 PERFORM12. NC2504.2 +019800 02 PERFORM13 OCCURS 4 TIMES. NC2504.2 +019900 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2504.2 +020000 03 PERFORM15 OCCURS 10 TIMES. NC2504.2 +020100 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2504.2 +020200 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. NC2504.2 +020300 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. NC2504.2 +020400 01 PERFORM-KEY PICTURE 9. NC2504.2 +020500 01 PERFORM-SEVEN-LEVEL-TABLE. NC2504.2 +020600 03 PFM71 OCCURS 2. NC2504.2 +020700 05 PFM72 OCCURS 2. NC2504.2 +020800 07 PFM73 OCCURS 2. NC2504.2 +020900 09 PFM74 OCCURS 2. NC2504.2 +021000 11 PFM75 OCCURS 2. NC2504.2 +021100 13 PFM76 OCCURS 2. NC2504.2 +021200 15 PFM77 OCCURS 2. NC2504.2 +021300 17 PFM77-1 PIC X. NC2504.2 +021400 01 S1 PIC S9(3) COMP. NC2504.2 +021500 01 S2 PIC S9(3) COMP. NC2504.2 +021600 01 S3 PIC S9(3) COMP. NC2504.2 +021700 01 S4 PIC S9(3) COMP. NC2504.2 +021800 01 S5 PIC S9(3) COMP. NC2504.2 +021900 01 S6 PIC S9(3) COMP. NC2504.2 +022000 01 S7 PIC S9(3) COMP. NC2504.2 +022100 01 PFM-7-TOT PIC S9(3) COMP. NC2504.2 +022200 01 PFM-F4-24-TOT PIC S9(3) COMP. NC2504.2 +022300 01 PFM-A PIC S9(3) COMP. NC2504.2 +022400 01 PFM-B PIC S9(3) COMP. NC2504.2 +022500 01 FILLER-A. NC2504.2 +022600 03 PFM-F4-25-A PIC S9(3) COMP OCCURS 10. NC2504.2 +022700 01 FILLER-B. NC2504.2 +022800 03 PFM-F4-25-B PIC S9(3) COMP OCCURS 10. NC2504.2 +022900 01 FILLER-C. NC2504.2 +023000 03 PFM-F4-25-C PIC S9(3) COMP OCCURS 10. NC2504.2 +023100 01 RECEIVING-TABLE. NC2504.2 +023200 03 TBL-ELEMEN-A. NC2504.2 +023300 05 TBL-ELEMEN-B PICTURE X(18). NC2504.2 +023400 05 TBL-ELEMEN-C PICTURE X(18). NC2504.2 +023500 03 TBL-ELEMEN-D. NC2504.2 +023600 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2504.2 +023700 01 LITERAL-SPLITTER. NC2504.2 +023800 02 PART1 PICTURE X(20). NC2504.2 +023900 02 PART2 PICTURE X(20). NC2504.2 +024000 02 PART3 PICTURE X(20). NC2504.2 +024100 02 PART4 PICTURE X(20). NC2504.2 +024200 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2504.2 +024300 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2504.2 +024400 01 GRP-FOR-88-LEVELS. NC2504.2 +024500 03 WRK-DS-02V00-COND PICTURE 99. NC2504.2 +024600 88 COND-1 VALUE IS 01 THRU 05. NC2504.2 +024700 88 COND-2 VALUES ARE 06 THRU 10 NC2504.2 +024800 16 THRU 20 00. NC2504.2 +024900 88 COND-3 VALUES 11 THRU 15. NC2504.2 +025000 01 GRP-MOVE-CONSTANTS. NC2504.2 +025100 03 GRP-GROUP-MOVE-FROM. NC2504.2 +025200 04 GRP-ALPHABETIC. NC2504.2 +025300 05 ALPHABET-AN-00026 PICTURE A(26) NC2504.2 +025400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2504.2 +025500 04 GRP-NUMERIC. NC2504.2 +025600 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2504.2 +025700 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2504.2 +025800 PICTURE 9(6)V9999. NC2504.2 +025900 04 GRP-ALPHANUMERIC. NC2504.2 +026000 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2504.2 +026100 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=$,;.()/* 0123456789". NC2504.2 +026200 05 FILLER PICTURE X VALUE QUOTE. NC2504.2 +026300 01 GRP-FOR-2N058. NC2504.2 +026400 02 SUB-GRP-FOR-2N058-A. NC2504.2 +026500 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2504.2 +026600 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2504.2 +026700 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2504.2 +026800 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2504.2 +026900 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2504.2 +027000 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2504.2 +027100 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2504.2 +027200 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2504.2 +027300 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2504.2 +027400 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2504.2 +027500 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2504.2 +027600 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2504.2 +027700 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2504.2 +027800 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2504.2 +027900 02 SUB-GRP-FOR-2N058-B. NC2504.2 +028000 03 SUB-SUB-BA. NC2504.2 +028100 04 ELEM-FOR-2N058-A PICTURE 999. NC2504.2 +028200 04 ELEM-FOR-2N058-B PICTURE XXX. NC2504.2 +028300 04 ELEM-FOR-2N058-C PICTURE XXX. NC2504.2 +028400 04 ELEM-FOR-2N058-D PICTURE X(6). NC2504.2 +028500 03 SUB-SUB-BB. NC2504.2 +028600 04 ELEM-FOR-2N058-E PICTURE XXX. NC2504.2 +028700 04 ELEM-FOR-2N058-F PICTURE XXX. NC2504.2 +028800 04 ELEM-FOR-2N058-G PICTURE XXX. NC2504.2 +028900 04 ELEM-FOR-2N058-H PICTURE 999. NC2504.2 +029000 03 SUB-SUB-BC. NC2504.2 +029100 04 ELEM-FOR-2N058-I PICTURE XXX. NC2504.2 +029200 04 ELEM-FOR-2N058-J PICTURE XXX. NC2504.2 +029300 04 ELEM-FOR-2N058-K PICTURE XXX. NC2504.2 +029400 04 ELEM-FOR-2N058-L PICTURE XXX. NC2504.2 +029500 04 ELEM-FOR-2N058-M PICTURE XXX. NC2504.2 +029600 04 ELEM-FOR-2N058-N PICTURE XXX. NC2504.2 +029700 01 CHARACTER-BREAKDOWN-S. NC2504.2 +029800 02 FIRST-20S PICTURE X(20). NC2504.2 +029900 02 SECOND-20S PICTURE X(20). NC2504.2 +030000 02 THIRD-20S PICTURE X(20). NC2504.2 +030100 02 FOURTH-20S PICTURE X(20). NC2504.2 +030200 02 FIFTH-20S PICTURE X(20). NC2504.2 +030300 02 SIXTH-20S PICTURE X(20). NC2504.2 +030400 02 SEVENTH-20S PICTURE X(20). NC2504.2 +030500 02 EIGHTH-20S PICTURE X(20). NC2504.2 +030600 02 NINTH-20S PICTURE X(20). NC2504.2 +030700 02 TENTH-20S PICTURE X(20). NC2504.2 +030800 01 CHARACTER-BREAKDOWN-R. NC2504.2 +030900 02 FIRST-20R PICTURE X(20). NC2504.2 +031000 02 SECOND-20R PICTURE X(20). NC2504.2 +031100 02 THIRD-20R PICTURE X(20). NC2504.2 +031200 02 FOURTH-20R PICTURE X(20). NC2504.2 +031300 02 FIFTH-20R PICTURE X(20). NC2504.2 +031400 02 SIXTH-20R PICTURE X(20). NC2504.2 +031500 02 SEVENTH-20R PICTURE X(20). NC2504.2 +031600 02 EIGHTH-20R PICTURE X(20). NC2504.2 +031700 02 NINTH-20R PICTURE X(20). NC2504.2 +031800 02 TENTH-20R PICTURE X(20). NC2504.2 +031900 01 TABLE-80. NC2504.2 +032000 02 ELMT OCCURS 3 TIMES PIC 9. NC2504.2 +032100 88 A80 VALUES ARE ZERO THRU 7. NC2504.2 +032200 88 B80 VALUE 8. NC2504.2 +032300 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2504.2 +032400 NC2504.2 +032500 01 TABLE-86. NC2504.2 +032600 88 A86 VALUE "ABC". NC2504.2 +032700 88 B86 VALUE "ABCABC". NC2504.2 +032800 88 C86 VALUE " ABC". NC2504.2 +032900 02 DATANAME-86 PIC XXX VALUE "ABC". NC2504.2 +033000 02 DNAME-86. NC2504.2 +033100 03 FILLER PIC X VALUE "A". NC2504.2 +033200 03 FILLER PIC X VALUE "B". NC2504.2 +033300 03 FILLER PIC X VALUE "C". NC2504.2 +033400 01 FIGCON-DATA. NC2504.2 +033500 02 SPACE-X PICTURE X(10) VALUE " ". NC2504.2 +033600 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2504.2 +033700 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2504.2 +033800 02 ABC PICTURE XXX VALUE "ABC". NC2504.2 +033900 02 ONE23 PICTURE 9999 VALUE 123. NC2504.2 +034000 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2504.2 +034100 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2504.2 +034200 01 TEST-RESULTS. NC2504.2 +034300 02 FILLER PIC X VALUE SPACE. NC2504.2 +034400 02 FEATURE PIC X(20) VALUE SPACE. NC2504.2 +034500 02 FILLER PIC X VALUE SPACE. NC2504.2 +034600 02 P-OR-F PIC X(5) VALUE SPACE. NC2504.2 +034700 02 FILLER PIC X VALUE SPACE. NC2504.2 +034800 02 PAR-NAME. NC2504.2 +034900 03 FILLER PIC X(19) VALUE SPACE. NC2504.2 +035000 03 PARDOT-X PIC X VALUE SPACE. NC2504.2 +035100 03 DOTVALUE PIC 99 VALUE ZERO. NC2504.2 +035200 02 FILLER PIC X(8) VALUE SPACE. NC2504.2 +035300 02 RE-MARK PIC X(61). NC2504.2 +035400 01 TEST-COMPUTED. NC2504.2 +035500 02 FILLER PIC X(30) VALUE SPACE. NC2504.2 +035600 02 FILLER PIC X(17) VALUE NC2504.2 +035700 " COMPUTED=". NC2504.2 +035800 02 COMPUTED-X. NC2504.2 +035900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2504.2 +036000 03 COMPUTED-N REDEFINES COMPUTED-A NC2504.2 +036100 PIC -9(9).9(9). NC2504.2 +036200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2504.2 +036300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2504.2 +036400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2504.2 +036500 03 CM-18V0 REDEFINES COMPUTED-A. NC2504.2 +036600 04 COMPUTED-18V0 PIC -9(18). NC2504.2 +036700 04 FILLER PIC X. NC2504.2 +036800 03 FILLER PIC X(50) VALUE SPACE. NC2504.2 +036900 01 TEST-CORRECT. NC2504.2 +037000 02 FILLER PIC X(30) VALUE SPACE. NC2504.2 +037100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2504.2 +037200 02 CORRECT-X. NC2504.2 +037300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2504.2 +037400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2504.2 +037500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2504.2 +037600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2504.2 +037700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2504.2 +037800 03 CR-18V0 REDEFINES CORRECT-A. NC2504.2 +037900 04 CORRECT-18V0 PIC -9(18). NC2504.2 +038000 04 FILLER PIC X. NC2504.2 +038100 03 FILLER PIC X(2) VALUE SPACE. NC2504.2 +038200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2504.2 +038300 01 CCVS-C-1. NC2504.2 +038400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2504.2 +038500- "SS PARAGRAPH-NAME NC2504.2 +038600- " REMARKS". NC2504.2 +038700 02 FILLER PIC X(20) VALUE SPACE. NC2504.2 +038800 01 CCVS-C-2. NC2504.2 +038900 02 FILLER PIC X VALUE SPACE. NC2504.2 +039000 02 FILLER PIC X(6) VALUE "TESTED". NC2504.2 +039100 02 FILLER PIC X(15) VALUE SPACE. NC2504.2 +039200 02 FILLER PIC X(4) VALUE "FAIL". NC2504.2 +039300 02 FILLER PIC X(94) VALUE SPACE. NC2504.2 +039400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2504.2 +039500 01 REC-CT PIC 99 VALUE ZERO. NC2504.2 +039600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2504.2 +040000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2504.2 +040100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2504.2 +040200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2504.2 +040300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2504.2 +040400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2504.2 +040500 01 CCVS-H-1. NC2504.2 +040600 02 FILLER PIC X(39) VALUE SPACES. NC2504.2 +040700 02 FILLER PIC X(42) VALUE NC2504.2 +040800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2504.2 +040900 02 FILLER PIC X(39) VALUE SPACES. NC2504.2 +041000 01 CCVS-H-2A. NC2504.2 +041100 02 FILLER PIC X(40) VALUE SPACE. NC2504.2 +041200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2504.2 +041300 02 FILLER PIC XXXX VALUE NC2504.2 +041400 "4.2 ". NC2504.2 +041500 02 FILLER PIC X(28) VALUE NC2504.2 +041600 " COPY - NOT FOR DISTRIBUTION". NC2504.2 +041700 02 FILLER PIC X(41) VALUE SPACE. NC2504.2 +041800 NC2504.2 +041900 01 CCVS-H-2B. NC2504.2 +042000 02 FILLER PIC X(15) VALUE NC2504.2 +042100 "TEST RESULT OF ". NC2504.2 +042200 02 TEST-ID PIC X(9). NC2504.2 +042300 02 FILLER PIC X(4) VALUE NC2504.2 +042400 " IN ". NC2504.2 +042500 02 FILLER PIC X(12) VALUE NC2504.2 +042600 " HIGH ". NC2504.2 +042700 02 FILLER PIC X(22) VALUE NC2504.2 +042800 " LEVEL VALIDATION FOR ". NC2504.2 +042900 02 FILLER PIC X(58) VALUE NC2504.2 +043000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +043100 01 CCVS-H-3. NC2504.2 +043200 02 FILLER PIC X(34) VALUE NC2504.2 +043300 " FOR OFFICIAL USE ONLY ". NC2504.2 +043400 02 FILLER PIC X(58) VALUE NC2504.2 +043500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2504.2 +043600 02 FILLER PIC X(28) VALUE NC2504.2 +043700 " COPYRIGHT 1985 ". NC2504.2 +043800 01 CCVS-E-1. NC2504.2 +043900 02 FILLER PIC X(52) VALUE SPACE. NC2504.2 +044000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2504.2 +044100 02 ID-AGAIN PIC X(9). NC2504.2 +044200 02 FILLER PIC X(45) VALUE SPACES. NC2504.2 +044300 01 CCVS-E-2. NC2504.2 +044400 02 FILLER PIC X(31) VALUE SPACE. NC2504.2 +044500 02 FILLER PIC X(21) VALUE SPACE. NC2504.2 +044600 02 CCVS-E-2-2. NC2504.2 +044700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2504.2 +044800 03 FILLER PIC X VALUE SPACE. NC2504.2 +044900 03 ENDER-DESC PIC X(44) VALUE NC2504.2 +045000 "ERRORS ENCOUNTERED". NC2504.2 +045100 01 CCVS-E-3. NC2504.2 +045200 02 FILLER PIC X(22) VALUE NC2504.2 +045300 " FOR OFFICIAL USE ONLY". NC2504.2 +045400 02 FILLER PIC X(12) VALUE SPACE. NC2504.2 +045500 02 FILLER PIC X(58) VALUE NC2504.2 +045600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +045700 02 FILLER PIC X(13) VALUE SPACE. NC2504.2 +045800 02 FILLER PIC X(15) VALUE NC2504.2 +045900 " COPYRIGHT 1985". NC2504.2 +046000 01 CCVS-E-4. NC2504.2 +046100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2504.2 +046200 02 FILLER PIC X(4) VALUE " OF ". NC2504.2 +046300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2504.2 +046400 02 FILLER PIC X(40) VALUE NC2504.2 +046500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2504.2 +046600 01 XXINFO. NC2504.2 +046700 02 FILLER PIC X(19) VALUE NC2504.2 +046800 "*** INFORMATION ***". NC2504.2 +046900 02 INFO-TEXT. NC2504.2 +047000 04 FILLER PIC X(8) VALUE SPACE. NC2504.2 +047100 04 XXCOMPUTED PIC X(20). NC2504.2 +047200 04 FILLER PIC X(5) VALUE SPACE. NC2504.2 +047300 04 XXCORRECT PIC X(20). NC2504.2 +047400 02 INF-ANSI-REFERENCE PIC X(48). NC2504.2 +047500 01 HYPHEN-LINE. NC2504.2 +047600 02 FILLER PIC IS X VALUE IS SPACE. NC2504.2 +047700 02 FILLER PIC IS X(65) VALUE IS "************************NC2504.2 +047800- "*****************************************". NC2504.2 +047900 02 FILLER PIC IS X(54) VALUE IS "************************NC2504.2 +048000- "******************************". NC2504.2 +048100 01 CCVS-PGM-ID PIC X(9) VALUE NC2504.2 +048200 "NC250A". NC2504.2 +048300 PROCEDURE DIVISION. NC2504.2 +048400 CCVS1 SECTION. NC2504.2 +048500 OPEN-FILES. NC2504.2 +048600 OPEN OUTPUT PRINT-FILE. NC2504.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2504.2 +048800 MOVE SPACE TO TEST-RESULTS. NC2504.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2504.2 +049000 GO TO CCVS1-EXIT. NC2504.2 +049100 CLOSE-FILES. NC2504.2 +049200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2504.2 +049300 TERMINATE-CCVS. NC2504.2 +049400 STOP RUN. NC2504.2 +049500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2504.2 +049600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2504.2 +049700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2504.2 +049800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2504.2 +049900 MOVE "****TEST DELETED****" TO RE-MARK. NC2504.2 +050000 PRINT-DETAIL. NC2504.2 +050100 IF REC-CT NOT EQUAL TO ZERO NC2504.2 +050200 MOVE "." TO PARDOT-X NC2504.2 +050300 MOVE REC-CT TO DOTVALUE. NC2504.2 +050400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2504.2 +050500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2504.2 +050600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2504.2 +050700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2504.2 +050800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2504.2 +050900 MOVE SPACE TO CORRECT-X. NC2504.2 +051000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2504.2 +051100 MOVE SPACE TO RE-MARK. NC2504.2 +051200 HEAD-ROUTINE. NC2504.2 +051300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +051400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +051500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2504.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2504.2 +051700 COLUMN-NAMES-ROUTINE. NC2504.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +052100 END-ROUTINE. NC2504.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2504.2 +052300 END-RTN-EXIT. NC2504.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +052500 END-ROUTINE-1. NC2504.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2504.2 +052700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2504.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. NC2504.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2504.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2504.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2504.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2504.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2504.2 +053400 END-ROUTINE-12. NC2504.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2504.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2504.2 +053700 MOVE "NO " TO ERROR-TOTAL NC2504.2 +053800 ELSE NC2504.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2504.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2504.2 +054100 PERFORM WRITE-LINE. NC2504.2 +054200 END-ROUTINE-13. NC2504.2 +054300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2504.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE NC2504.2 +054500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2504.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2504.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO NC2504.2 +054900 MOVE "NO " TO ERROR-TOTAL NC2504.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2504.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2504.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +055400 WRITE-LINE. NC2504.2 +055500 ADD 1 TO RECORD-COUNT. NC2504.2 +055600Y IF RECORD-COUNT GREATER 50 NC2504.2 +055700Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2504.2 +055800Y MOVE SPACE TO DUMMY-RECORD NC2504.2 +055900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2504.2 +056000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2504.2 +056100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2504.2 +056200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2504.2 +056300Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2504.2 +056400Y MOVE ZERO TO RECORD-COUNT. NC2504.2 +056500 PERFORM WRT-LN. NC2504.2 +056600 WRT-LN. NC2504.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2504.2 +056800 MOVE SPACE TO DUMMY-RECORD. NC2504.2 +056900 BLANK-LINE-PRINT. NC2504.2 +057000 PERFORM WRT-LN. NC2504.2 +057100 FAIL-ROUTINE. NC2504.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2504.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2504.2 +057400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2504.2 +057500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2504.2 +057600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +057700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2504.2 +057800 GO TO FAIL-ROUTINE-EX. NC2504.2 +057900 FAIL-ROUTINE-WRITE. NC2504.2 +058000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2504.2 +058100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2504.2 +058200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2504.2 +058300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2504.2 +058400 FAIL-ROUTINE-EX. EXIT. NC2504.2 +058500 BAIL-OUT. NC2504.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2504.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2504.2 +058800 BAIL-OUT-WRITE. NC2504.2 +058900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2504.2 +059000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2504.2 +059100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +059200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2504.2 +059300 BAIL-OUT-EX. EXIT. NC2504.2 +059400 CCVS1-EXIT. NC2504.2 +059500 EXIT. NC2504.2 +059600 SECT-NC201A-001 SECTION. NC2504.2 +059700* NC2504.2 +059800 IF--INIT-A. NC2504.2 +059900 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +060000 PERFORM END-ROUTINE. NC2504.2 +060100 MOVE SPACE TO TEST-RESULTS. NC2504.2 +060200 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC2504.2 +060300 PERFORM PRINT-DETAIL. NC2504.2 +060400 MOVE "COMPARE FIGURATIVE " TO RE-MARK. NC2504.2 +060500 PERFORM PRINT-DETAIL. NC2504.2 +060600 MOVE "CONSTANTS, SIGN OF DATA, " TO RE-MARK. NC2504.2 +060700 PERFORM PRINT-DETAIL. NC2504.2 +060800 MOVE "AND CONDITION-NAMES " TO RE-MARK. NC2504.2 +060900 PERFORM PRINT-DETAIL. NC2504.2 +061000 MOVE "IN VARYING COMBINATIONS. " TO RE-MARK. NC2504.2 +061100 PERFORM PRINT-DETAIL. NC2504.2 +061200 MOVE "COMPARE-- " TO FEATURE. NC2504.2 +061300 PERFORM PRINT-DETAIL. NC2504.2 +061400 MOVE " FIG. CONSTANTS " TO FEATURE. NC2504.2 +061500 IF--TEST-1. NC2504.2 +061600 IF ZEROES IS EQUAL TO IF-D3 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +061700* NOTE FIGURATIVE ZEROES VS ALPHANUMERIC FIELD. NC2504.2 +061800 GO TO IF--WRITE-1. NC2504.2 +061900 IF--DELETE-1. NC2504.2 +062000 PERFORM DE-LETE. NC2504.2 +062100 IF--WRITE-1. NC2504.2 +062200 MOVE "IF--TEST-1 " TO PAR-NAME. NC2504.2 +062300 PERFORM PRINT-DETAIL. NC2504.2 +062400 IF--TEST-2. NC2504.2 +062500 IF SPACES EQUAL TO IF-D4 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +062600* NOTE FIGURATIVE SPACES VS ALPHANUMERIC FIELD. NC2504.2 +062700 GO TO IF--WRITE-2. NC2504.2 +062800 IF--DELETE-2. NC2504.2 +062900 PERFORM DE-LETE. NC2504.2 +063000 IF--WRITE-2. NC2504.2 +063100 MOVE "IF--TEST-2 " TO PAR-NAME. NC2504.2 +063200 PERFORM PRINT-DETAIL. NC2504.2 +063300 IF--TEST-3. NC2504.2 +063400 IF QUOTES EQUAL TO IF-D5 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +063500* NOTE FIGURATIVE QUOTES VS ALPHANUMERIC FIELD. NC2504.2 +063600 GO TO IF--WRITE-3. NC2504.2 +063700 IF--DELETE-3. NC2504.2 +063800 PERFORM DE-LETE. NC2504.2 +063900 IF--WRITE-3. NC2504.2 +064000 MOVE "IF--TEST-3 " TO PAR-NAME. NC2504.2 +064100 PERFORM PRINT-DETAIL. NC2504.2 +064200 IF--TEST-4. NC2504.2 +064300 IF IF-D6 EQUAL TO ALL "BA" PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +064400* NOTE ALL ANY LITERAL VS ALPHANUMERIC FIELD. NC2504.2 +064500 GO TO IF--WRITE-4. NC2504.2 +064600 IF--DELETE-4. NC2504.2 +064700 PERFORM DE-LETE. NC2504.2 +064800 IF--WRITE-4. NC2504.2 +064900 MOVE "IF--TEST-4 " TO PAR-NAME. NC2504.2 +065000 PERFORM PRINT-DETAIL. NC2504.2 +065100 IF--TEST-5. NC2504.2 +065200 IF IF-D4 GREATER THAN SPACES PERFORM FAIL ELSE NC2504.2 +065300 PERFORM PASS. NC2504.2 +065400* NOTE FIG-SPACES VS ALPHANUMERIC FIELD. NC2504.2 +065500 GO TO IF--WRITE-5. NC2504.2 +065600 IF--DELETE-5. NC2504.2 +065700 PERFORM DE-LETE. NC2504.2 +065800 IF--WRITE-5. NC2504.2 +065900 MOVE "IF--TEST-5 " TO PAR-NAME. NC2504.2 +066000 PERFORM PRINT-DETAIL. NC2504.2 +066100 IF--TEST-6. NC2504.2 +066200 IF QUOTES GREATER THAN IF-D5 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +066300* NOTE FIG-QUOTES VS ALPHANUMERIC FIELD. NC2504.2 +066400 GO TO IF--WRITE-6. NC2504.2 +066500 IF--DELETE-6. NC2504.2 +066600 PERFORM DE-LETE. NC2504.2 +066700 IF--WRITE-6. NC2504.2 +066800 MOVE "IF--TEST-6 " TO PAR-NAME. NC2504.2 +066900 PERFORM PRINT-DETAIL. NC2504.2 +067000 IF--TEST-7. NC2504.2 +067100 IF ALL "BA" GREATER THAN IF-D6 PERFORM FAIL NC2504.2 +067200 ELSE PERFORM PASS. NC2504.2 +067300* NOTE ALL ANY LITERAL VS ALPHA FIELD. NC2504.2 +067400 GO TO IF--WRITE-7. NC2504.2 +067500 IF--DELETE-7. NC2504.2 +067600 PERFORM DE-LETE. NC2504.2 +067700 IF--WRITE-7. NC2504.2 +067800 MOVE "IF--TEST-7 " TO PAR-NAME. NC2504.2 +067900 PERFORM PRINT-DETAIL. NC2504.2 +068000 IF--INIT-B. NC2504.2 +068100 MOVE " UNEQUAL LENGTHS " TO FEATURE. NC2504.2 +068200 IF--TEST-8. NC2504.2 +068300 IF IF-D22 GREATER THAN IF-D19 PERFORM FAIL ELSE PERFORM PASS.NC2504.2 +068400* NOTE ALPHANUMERIC GROUP VS ALPHANUMERIC FIELD. NC2504.2 +068500* NOTE UNEQUAL LENGTHS. NC2504.2 +068600 GO TO IF--WRITE-8. NC2504.2 +068700 IF--DELETE-8. NC2504.2 +068800 PERFORM DE-LETE. NC2504.2 +068900 IF--WRITE-8. NC2504.2 +069000 MOVE "IF--TEST-8 " TO PAR-NAME. NC2504.2 +069100 PERFORM PRINT-DETAIL. NC2504.2 +069200 IF--INIT-C. NC2504.2 +069300 MOVE " POSITIVE " TO FEATURE. NC2504.2 +069400 IF--TEST-9. NC2504.2 +069500 IF IF-D1 IS NOT POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +069600* NOTE POSITIVE TEST ON ZERO VALUE. NC2504.2 +069700 GO TO IF--WRITE-9. NC2504.2 +069800 IF--DELETE-9. NC2504.2 +069900 PERFORM DE-LETE. NC2504.2 +070000 IF--WRITE-9. NC2504.2 +070100 MOVE "IF--TEST-9 " TO PAR-NAME. NC2504.2 +070200 PERFORM PRINT-DETAIL. NC2504.2 +070300 IF--TEST-10. NC2504.2 +070400 IF IF-D8 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +070500* NOTE POSITIVE TEST ON UNSIGNED VALUE. NC2504.2 +070600 GO TO IF--WRITE-10. NC2504.2 +070700 IF--DELETE-10. NC2504.2 +070800 PERFORM DE-LETE. NC2504.2 +070900 IF--WRITE-10. NC2504.2 +071000 MOVE "IF--TEST-10" TO PAR-NAME. NC2504.2 +071100 PERFORM PRINT-DETAIL. NC2504.2 +071200 IF--TEST-11. NC2504.2 +071300 IF IF-D16 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +071400* NOTE POSITIVE TEST ON SCALED VALUE. NC2504.2 +071500 GO TO IF--WRITE-11. NC2504.2 +071600 IF--DELETE-11. NC2504.2 +071700 PERFORM DE-LETE. NC2504.2 +071800 IF--WRITE-11. NC2504.2 +071900 MOVE "IF--TEST-11" TO PAR-NAME. NC2504.2 +072000 PERFORM PRINT-DETAIL. NC2504.2 +072100 IF--TEST-12. NC2504.2 +072200 IF IF-D27 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +072300* NOTE POSITIVE TEST ON COMPUTATIONAL FIELD. NC2504.2 +072400 GO TO IF--WRITE-12. NC2504.2 +072500 IF--DELETE-12. NC2504.2 +072600 PERFORM DE-LETE. NC2504.2 +072700 IF--WRITE-12. NC2504.2 +072800 MOVE "IF--TEST-12" TO PAR-NAME. NC2504.2 +072900 PERFORM PRINT-DETAIL. NC2504.2 +073000 IF--TEST-13. NC2504.2 +073100 IF IF-D28 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +073200* NOTE POSITIVE TEST ON NUMERIC DISPLAY IFELD. NC2504.2 +073300 GO TO IF--WRITE-13. NC2504.2 +073400 IF--DELETE-13. NC2504.2 +073500 PERFORM DE-LETE. NC2504.2 +073600 IF--WRITE-13. NC2504.2 +073700 MOVE "IF--TEST-13" TO PAR-NAME. NC2504.2 +073800 PERFORM PRINT-DETAIL. NC2504.2 +073900 IF--TEST-14. NC2504.2 +074000 IF IF-D31 IS POSITIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +074100* NOTE POSITIVE TEST ON NEGATIVE FIELD. NC2504.2 +074200 GO TO IF--WRITE-14. NC2504.2 +074300 IF--DELETE-14. NC2504.2 +074400 PERFORM DE-LETE. NC2504.2 +074500 IF--WRITE-14. NC2504.2 +074600 MOVE "IF--TEST-14" TO PAR-NAME. NC2504.2 +074700 PERFORM PRINT-DETAIL. NC2504.2 +074800 IF--TEST-15. NC2504.2 +074900 IF IF-D31 IS NOT POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +075000* NOTE NOT POSITIVE TEST ON NEGATIVE VALUE. NC2504.2 +075100 GO TO IF--WRITE-15. NC2504.2 +075200 IF--DELETE-15. NC2504.2 +075300 PERFORM DE-LETE. NC2504.2 +075400 IF--WRITE-15. NC2504.2 +075500 MOVE "IF--TEST-15" TO PAR-NAME. NC2504.2 +075600 PERFORM PRINT-DETAIL. NC2504.2 +075700 IF--TEST-16. NC2504.2 +075800 IF IF-D28 IS NOT POSITIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +075900* NOTE NOT POSITIVE TEST ON UNSIGNED FIELD. NC2504.2 +076000 GO TO IF--WRITE-16. NC2504.2 +076100 IF--DELETE-16. NC2504.2 +076200 PERFORM DE-LETE. NC2504.2 +076300 IF--WRITE-16. NC2504.2 +076400 MOVE "IF--TEST-16" TO PAR-NAME. NC2504.2 +076500 PERFORM PRINT-DETAIL. NC2504.2 +076600 IF--INIT-D. NC2504.2 +076700 MOVE " NEGATIVE " TO FEATURE. NC2504.2 +076800 IF--TEST-17. NC2504.2 +076900 IF IF-D31 IS NEGATIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +077000* NOTE NEGATIVE TEST ON NEGATIVE VALUE. NC2504.2 +077100 GO TO IF--WRITE-17. NC2504.2 +077200 IF--DELETE-17. NC2504.2 +077300 PERFORM DE-LETE. NC2504.2 +077400 IF--WRITE-17. NC2504.2 +077500 MOVE "IF--TEST-17" TO PAR-NAME. NC2504.2 +077600 PERFORM PRINT-DETAIL. NC2504.2 +077700 IF--TEST-18. NC2504.2 +077800 IF IF-D31 IS NOT NEGATIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +077900* NOTE NOT NEGATIVE TEST ON NEGATIVE VALUE. NC2504.2 +078000 GO TO IF--WRITE-18. NC2504.2 +078100 IF--DELETE-18. NC2504.2 +078200 PERFORM DE-LETE. NC2504.2 +078300 IF--WRITE-18. NC2504.2 +078400 MOVE "IF--TEST-18" TO PAR-NAME. NC2504.2 +078500 PERFORM PRINT-DETAIL. NC2504.2 +078600 IF--TEST-19. NC2504.2 +078700 IF IF-D16 NOT NEGATIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +078800* NOTE NOT NEGATIVE TEST ON UNSIGNED FIELD. NC2504.2 +078900 GO TO IF--WRITE-19. NC2504.2 +079000 IF--DELETE-19. NC2504.2 +079100 PERFORM DE-LETE. NC2504.2 +079200 IF--WRITE-19. NC2504.2 +079300 MOVE "IF--TEST-19" TO PAR-NAME. NC2504.2 +079400 PERFORM PRINT-DETAIL. NC2504.2 +079500 IF--INIT-E. NC2504.2 +079600 MOVE " ZERO " TO FEATURE. NC2504.2 +079700 IF--TEST-20. NC2504.2 +079800 IF IF-D1 IS ZERO PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +079900* NOTE ZERO TEST ON ZERO VALUE. NC2504.2 +080000 GO TO IF--WRITE-20. NC2504.2 +080100 IF--DELETE-20. NC2504.2 +080200 PERFORM DE-LETE. NC2504.2 +080300 IF--WRITE-20. NC2504.2 +080400 MOVE "IF--TEST-20" TO PAR-NAME. NC2504.2 +080500 PERFORM PRINT-DETAIL. NC2504.2 +080600 IF--TEST-21. NC2504.2 +080700 IF IF-D10 NOT EQUAL TO ZERO NC2504.2 +080800 PERFORM PASS ELSE NC2504.2 +080900 MOVE IF-D10 TO COMPUTED-A NC2504.2 +081000 MOVE ZERO TO CORRECT-N NC2504.2 +081100 PERFORM FAIL. NC2504.2 +081200* NOTE NOT EQUAL TO ZERO TEST ON NON-ZERO VALUE. NC2504.2 +081300 GO TO IF--WRITE-21. NC2504.2 +081400 IF--DELETE-21. NC2504.2 +081500 PERFORM DE-LETE. NC2504.2 +081600 IF--WRITE-21. NC2504.2 +081700 MOVE "IF--TEST-21" TO PAR-NAME. NC2504.2 +081800 PERFORM PRINT-DETAIL. NC2504.2 +081900 IF--INIT-F. NC2504.2 +082000 MOVE " CONDITION-NAMES " TO FEATURE. NC2504.2 +082100 IF--TEST-22. NC2504.2 +082200 MOVE 1 TO IF-D32. IF A OF IF-D32 PERFORM PASS NC2504.2 +082300 ELSE PERFORM FAIL. NC2504.2 +082400* NOTE TEST OF SIGNED NUMERIC FIELD FOR SINGLE VALUE. NC2504.2 +082500 GO TO IF--WRITE-22. NC2504.2 +082600 IF--DELETE-22. NC2504.2 +082700 PERFORM DE-LETE. NC2504.2 +082800 IF--WRITE-22. NC2504.2 +082900 MOVE "IF--TEST-22" TO PAR-NAME. NC2504.2 +083000 PERFORM PRINT-DETAIL. NC2504.2 +083100 IF--TEST-23. NC2504.2 +083200 MOVE 3 TO IF-D32. IF B OF IF-D32 PERFORM PASS NC2504.2 +083300 ELSE PERFORM FAIL. NC2504.2 +083400* NOTE TEST OF SIGNED NUMERIC FIELD FOR MULTIPLE VALUES. NC2504.2 +083500 GO TO IF--WRITE-23. NC2504.2 +083600 IF--DELETE-23. NC2504.2 +083700 PERFORM DE-LETE. NC2504.2 +083800 IF--WRITE-23. NC2504.2 +083900 MOVE "IF--TEST-23" TO PAR-NAME. NC2504.2 +084000 PERFORM PRINT-DETAIL. NC2504.2 +084100 IF--TEST-24. NC2504.2 +084200 MOVE ZERO TO IF-D32. IF C OF IF-D32 PERFORM PASS NC2504.2 +084300 ELSE PERFORM FAIL. NC2504.2 +084400* NOTE TEST OF SIGNED NUMERIC FIELD FOR FIG-ZERO. NC2504.2 +084500 GO TO IF--WRITE-24. NC2504.2 +084600 IF--DELETE-24. NC2504.2 +084700 PERFORM DE-LETE. NC2504.2 +084800 IF--WRITE-24. NC2504.2 +084900 MOVE "IF--TEST-24" TO PAR-NAME. NC2504.2 +085000 PERFORM PRINT-DETAIL. NC2504.2 +085100 IF--TEST-25. NC2504.2 +085200 MOVE +12.34 TO IF-D32. NC2504.2 +085300 IF D OF IF-D32 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +085400* NOTE SIGNED CONDITION-NAME. NC2504.2 +085500 GO TO IF--WRITE-25. NC2504.2 +085600 IF--DELETE-25. NC2504.2 +085700 PERFORM DE-LETE. NC2504.2 +085800 IF--WRITE-25. NC2504.2 +085900 MOVE "IF--TEST-25" TO PAR-NAME. NC2504.2 +086000 PERFORM PRINT-DETAIL. NC2504.2 +086100 IF--TEST-26. NC2504.2 +086200 MOVE QUOTE TO IF-D33. IF B OF IF-D33 AND NOT B OF IF-D32 NC2504.2 +086300 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +086400* NOTE TEST OF ALPHANUMERIC FIELD FOR FIG-QUOTES. NC2504.2 +086500 GO TO IF--WRITE-26. NC2504.2 +086600 IF--DELETE-26. NC2504.2 +086700 PERFORM DE-LETE. NC2504.2 +086800 IF--WRITE-26. NC2504.2 +086900 MOVE "IF--TEST-26" TO PAR-NAME. NC2504.2 +087000 PERFORM PRINT-DETAIL. NC2504.2 +087100 IF--TEST-27. NC2504.2 +087200 MOVE SPACE TO IF-D33. IF C OF IF-D33 PERFORM PASS NC2504.2 +087300 ELSE PERFORM FAIL. NC2504.2 +087400* NOTE TEST OF ALPHANUMERIC FIELD FOR FIG-SPACES. NC2504.2 +087500 GO TO IF--WRITE-27. NC2504.2 +087600 IF--DELETE-27. NC2504.2 +087700 PERFORM DE-LETE. NC2504.2 +087800 IF--WRITE-27. NC2504.2 +087900 MOVE "IF--TEST-27" TO PAR-NAME. NC2504.2 +088000 PERFORM PRINT-DETAIL. NC2504.2 +088100 IF--TEST-28. NC2504.2 +088200 MOVE "BACB" TO IF-D33. IF D OF IF-D33 PERFORM PASS NC2504.2 +088300 ELSE PERFORM FAIL. NC2504.2 +088400* NOTE TEST OF ALPHANUMERIC FIELD FOR ALL ANY LITERAL. NC2504.2 +088500 GO TO IF--WRITE-28. NC2504.2 +088600 IF--DELETE-28. NC2504.2 +088700 PERFORM DE-LETE. NC2504.2 +088800 IF--WRITE-28. NC2504.2 +088900 MOVE "IF--TEST-28" TO PAR-NAME. NC2504.2 +089000 PERFORM PRINT-DETAIL. NC2504.2 +089100 IF--TEST-29. NC2504.2 +089200 IF NOT B OF IF-D34 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +089300 GO TO IF--WRITE-29. NC2504.2 +089400 IF--DELETE-29. NC2504.2 +089500 PERFORM DE-LETE. NC2504.2 +089600 IF--WRITE-29. NC2504.2 +089700 MOVE "IF--TEST-29" TO PAR-NAME. NC2504.2 +089800 PERFORM PRINT-DETAIL. NC2504.2 +089900 IF--TEST-30. NC2504.2 +090000 MOVE "ABCD" TO IF-D35. NC2504.2 +090100 IF A2 AND B2 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +090200 GO TO IF--WRITE-30. NC2504.2 +090300 IF--DELETE-30. NC2504.2 +090400 PERFORM DE-LETE. NC2504.2 +090500 IF--WRITE-30. NC2504.2 +090600 MOVE "IF--TEST-30" TO PAR-NAME. NC2504.2 +090700 PERFORM PRINT-DETAIL. NC2504.2 +090800 IF--TEST-31. NC2504.2 +090900 MOVE .21 TO IF-D32. NC2504.2 +091000 IF E PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +091100* NOTE TESTS VALUE SERIES. NC2504.2 +091200 GO TO IF--WRITE-31. NC2504.2 +091300 IF--DELETE-31. NC2504.2 +091400 PERFORM DE-LETE. NC2504.2 +091500 IF--WRITE-31. NC2504.2 +091600 MOVE "IF--TEST-31" TO PAR-NAME. NC2504.2 +091700 PERFORM PRINT-DETAIL. NC2504.2 +091800 IF--TEST-32. NC2504.2 +091900 MOVE 1279.99 TO IF-D32. NC2504.2 +092000 IF F PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +092100* NOTE TESTS VALUE RANGE SERIES. NC2504.2 +092200 GO TO IF--WRITE-32. NC2504.2 +092300 IF--DELETE-32. NC2504.2 +092400 PERFORM DE-LETE. NC2504.2 +092500 IF--WRITE-32. NC2504.2 +092600 MOVE "IF--TEST-32" TO PAR-NAME. NC2504.2 +092700 PERFORM PRINT-DETAIL. NC2504.2 +092800 IF--TEST-33. NC2504.2 +092900 MOVE -4321.88 TO IF-D32. NC2504.2 +093000 IF G PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +093100* NOTE TESTS VALUE SERIES RANGE SERIES. NC2504.2 +093200 GO TO IF--WRITE-33. NC2504.2 +093300 IF--DELETE-33. NC2504.2 +093400 PERFORM DE-LETE. NC2504.2 +093500 IF--WRITE-33. NC2504.2 +093600 MOVE "IF--TEST-33" TO PAR-NAME. NC2504.2 +093700 PERFORM PRINT-DETAIL. NC2504.2 +093800 IF--INIT-G. NC2504.2 +093900 PERFORM END-ROUTINE. NC2504.2 +094000 MOVE SPACES TO FEATURE. NC2504.2 +094100 MOVE "THE FOLLOWING TESTS USE ARITHMETIC-EXPRESSIONS" NC2504.2 +094200 TO RE-MARK. NC2504.2 +094300 PERFORM PRINT-DETAIL. NC2504.2 +094400 MOVE "IN RELATION OR SIGN CONDITIONS." NC2504.2 +094500 TO RE-MARK. NC2504.2 +094600 PERFORM PRINT-DETAIL. NC2504.2 +094700 MOVE " EQUAL " TO FEATURE. NC2504.2 +094800 IF--TEST-34. NC2504.2 +094900 IF 1 + (TWO * 3) EQUAL TO (TWO * 3) + 1 NC2504.2 +095000 PERFORM PASS NC2504.2 +095100 ELSE NC2504.2 +095200 PERFORM FAIL. NC2504.2 +095300 GO TO IF--WRITE-34. NC2504.2 +095400 IF--DELETE-34. NC2504.2 +095500 PERFORM DE-LETE. NC2504.2 +095600 IF--WRITE-34. NC2504.2 +095700 MOVE "IF--TEST-34" TO PAR-NAME. NC2504.2 +095800 PERFORM PRINT-DETAIL. NC2504.2 +095900 IF--TEST-35. NC2504.2 +096000 IF 9 + TWO + 2 * 3 EQUAL TO 2 * 3 + TWO + 9 NC2504.2 +096100 PERFORM PASS NC2504.2 +096200 ELSE NC2504.2 +096300 PERFORM FAIL. NC2504.2 +096400 GO TO IF--WRITE-35. NC2504.2 +096500 IF--DELETE-35. NC2504.2 +096600 PERFORM DE-LETE. NC2504.2 +096700 IF--WRITE-35. NC2504.2 +096800 MOVE "IF--TEST-35" TO PAR-NAME. NC2504.2 +096900 PERFORM PRINT-DETAIL. NC2504.2 +097000 IF--TEST-36. NC2504.2 +097100 IF NINE ** 2 EQUAL TO 9 ** 2 NC2504.2 +097200 PERFORM PASS NC2504.2 +097300 ELSE NC2504.2 +097400 PERFORM FAIL. NC2504.2 +097500 GO TO IF--WRITE-36. NC2504.2 +097600 IF--DELETE-36. NC2504.2 +097700 PERFORM DE-LETE. NC2504.2 +097800 IF--WRITE-36. NC2504.2 +097900 MOVE "IF--TEST-36" TO PAR-NAME. NC2504.2 +098000 PERFORM PRINT-DETAIL. NC2504.2 +098100 IF--TEST-37. NC2504.2 +098200 IF 100 + (TWENTY + 3.4) + .05 EQUAL TO NC2504.2 +098300 .05 + (100 + TWENTY) + 3.4 NC2504.2 +098400 PERFORM PASS NC2504.2 +098500 ELSE NC2504.2 +098600 PERFORM FAIL. NC2504.2 +098700 GO TO IF--WRITE-37. NC2504.2 +098800 IF--DELETE-37. NC2504.2 +098900 PERFORM DE-LETE. NC2504.2 +099000 IF--WRITE-37. NC2504.2 +099100 MOVE "IF--TEST-37" TO PAR-NAME. NC2504.2 +099200 PERFORM PRINT-DETAIL. NC2504.2 +099300 IF--INIT-H. NC2504.2 +099400 MOVE " GREATER " TO FEATURE. NC2504.2 +099500 IF--TEST-38. NC2504.2 +099600 IF NINE * 8 IS GREATER THAN 9 * 7 + 8 PERFORM PASS NC2504.2 +099700 ELSE PERFORM FAIL. NC2504.2 +099800 GO TO IF--WRITE-38. NC2504.2 +099900 IF--DELETE-38. NC2504.2 +100000 PERFORM DE-LETE. NC2504.2 +100100 IF--WRITE-38. NC2504.2 +100200 MOVE "IF--TEST-38" TO PAR-NAME. NC2504.2 +100300 PERFORM PRINT-DETAIL. NC2504.2 +100400 IF--TEST-39. NC2504.2 +100500 IF 10 ** 2 + 25 GREATER THAN IF-D14 PERFORM PASS ELSE NC2504.2 +100600 PERFORM FAIL. NC2504.2 +100700 GO TO IF--WRITE-39. NC2504.2 +100800 IF--DELETE-39. NC2504.2 +100900 PERFORM DE-LETE. NC2504.2 +101000 IF--WRITE-39. NC2504.2 +101100 MOVE "IF--TEST-39" TO PAR-NAME. NC2504.2 +101200 PERFORM PRINT-DETAIL. NC2504.2 +101300 IF--TEST-40. NC2504.2 +101400 IF 1000 GREATER THAN TEN ** 3 - 1 PERFORM PASS ELSE PERFORM NC2504.2 +101500 FAIL. NC2504.2 +101600 GO TO IF--WRITE-40. NC2504.2 +101700 IF--DELETE-40. NC2504.2 +101800 PERFORM DE-LETE. NC2504.2 +101900 IF--WRITE-40. NC2504.2 +102000 MOVE "IF--TEST-40" TO PAR-NAME. NC2504.2 +102100 PERFORM PRINT-DETAIL. NC2504.2 +102200 IF--INIT-I. NC2504.2 +102300 MOVE " LESS " TO FEATURE. NC2504.2 +102400 IF--TEST-41. NC2504.2 +102500 IF 1000 LESS THAN 10 ** THREE + 1 PERFORM PASS ELSE NC2504.2 +102600 PERFORM FAIL. NC2504.2 +102700 GO TO IF--WRITE-41. NC2504.2 +102800 IF--DELETE-41. NC2504.2 +102900 PERFORM DE-LETE. NC2504.2 +103000 IF--WRITE-41. NC2504.2 +103100 MOVE "IF--TEST-41" TO PAR-NAME. NC2504.2 +103200 PERFORM PRINT-DETAIL. NC2504.2 +103300 IF--TEST-42. NC2504.2 +103400 IF 10 ** 2 + 20 LESS THAN IF-D14 PERFORM PASS ELSE NC2504.2 +103500 PERFORM FAIL. NC2504.2 +103600 GO TO IF--WRITE-42. NC2504.2 +103700 IF--DELETE-42. NC2504.2 +103800 PERFORM DE-LETE. NC2504.2 +103900 IF--WRITE-42. NC2504.2 +104000 MOVE "IF--TEST-42" TO PAR-NAME. NC2504.2 +104100 PERFORM PRINT-DETAIL. NC2504.2 +104200 IF--TEST-43. NC2504.2 +104300 IF 9 * 8 LESS THAN 9 * 7 + TEN PERFORM PASS ELSE PERFORM NC2504.2 +104400 FAIL. NC2504.2 +104500 GO TO IF--WRITE-43. NC2504.2 +104600 IF--DELETE-43. NC2504.2 +104700 PERFORM DE-LETE. NC2504.2 +104800 IF--WRITE-43. NC2504.2 +104900 MOVE "IF--TEST-43" TO PAR-NAME. NC2504.2 +105000 PERFORM PRINT-DETAIL. NC2504.2 +105100 IF--TEST-44-45. NC2504.2 +105200 MOVE SPACES TO TEST-RESULTS. NC2504.2 +105300 MOVE "NOT USED" TO RE-MARK. NC2504.2 +105400 MOVE "IF--TEST-44" TO PAR-NAME. NC2504.2 +105500 PERFORM PRINT-DETAIL. NC2504.2 +105600 MOVE "NOT USED" TO RE-MARK. NC2504.2 +105700 MOVE "IF--TEST-45" TO PAR-NAME. NC2504.2 +105800 PERFORM PRINT-DETAIL. NC2504.2 +105900 IF--INIT-J. NC2504.2 +106000 MOVE " NOT EQUAL " TO FEATURE. NC2504.2 +106100 PERFORM PRINT-DETAIL. NC2504.2 +106200 IF--TEST-46. NC2504.2 +106300 IF NINE * 9 - 7 * SEVEN NOT EQUAL - (SEVEN * 7) + 9 * NINE NC2504.2 +106400 PERFORM FAIL NC2504.2 +106500 ELSE NC2504.2 +106600 PERFORM PASS. NC2504.2 +106700 NC2504.2 +106800 GO TO IF--WRITE-46. NC2504.2 +106900 IF--DELETE-46. NC2504.2 +107000 PERFORM DE-LETE. NC2504.2 +107100 IF--WRITE-46. NC2504.2 +107200 MOVE "IF--TEST-46" TO PAR-NAME. NC2504.2 +107300 PERFORM PRINT-DETAIL. NC2504.2 +107400 IF--TEST-47. NC2504.2 +107500 IF IF-D14 - IF-D7 NOT EQUAL - IF-D7 + IF-D14 NC2504.2 +107600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +107700 GO TO IF--WRITE-47. NC2504.2 +107800 IF--DELETE-47. NC2504.2 +107900 PERFORM DE-LETE. NC2504.2 +108000 IF--WRITE-47. NC2504.2 +108100 MOVE "IF--TEST-47" TO PAR-NAME. NC2504.2 +108200 PERFORM PRINT-DETAIL. NC2504.2 +108300 IF--INIT-K. NC2504.2 +108400 MOVE " NOT GREATER " TO FEATURE. NC2504.2 +108500 IF--TEST-48. NC2504.2 +108600 IF NINE * 8 IS NOT GREATER THAN 9 * SEVEN + 8 THEN NC2504.2 +108700 PERFORM FAIL NC2504.2 +108800 ELSE NC2504.2 +108900 PERFORM PASS. NC2504.2 +109000 GO TO IF--WRITE-48. NC2504.2 +109100 IF--DELETE-48. NC2504.2 +109200 PERFORM DE-LETE. NC2504.2 +109300 IF--WRITE-48. NC2504.2 +109400 MOVE "IF--TEST-48" TO PAR-NAME. NC2504.2 +109500 PERFORM PRINT-DETAIL. NC2504.2 +109600 IF--TEST-49. NC2504.2 +109700 IF 10 ** 2 + 25 NOT GREATER THAN IF-D14 PERFORM FAIL ELSE NC2504.2 +109800 PERFORM PASS. NC2504.2 +109900 GO TO IF--WRITE-49. NC2504.2 +110000 IF--DELETE-49. NC2504.2 +110100 PERFORM DE-LETE. NC2504.2 +110200 IF--WRITE-49. NC2504.2 +110300 MOVE "IF--TEST-49" TO PAR-NAME. NC2504.2 +110400 PERFORM PRINT-DETAIL. NC2504.2 +110500 IF--TEST-50. NC2504.2 +110600 IF 1000 NOT GREATER THAN 10 ** THREE - 1 PERFORM FAIL ELSE NC2504.2 +110700 PERFORM PASS. NC2504.2 +110800 GO TO IF--WRITE-50. NC2504.2 +110900 IF--DELETE-50. NC2504.2 +111000 PERFORM DE-LETE. NC2504.2 +111100 IF--WRITE-50. NC2504.2 +111200 MOVE "IF--TEST-50" TO PAR-NAME. NC2504.2 +111300 PERFORM PRINT-DETAIL. NC2504.2 +111400 IF--INIT-L. NC2504.2 +111500 MOVE " NOT LESS " TO FEATURE. NC2504.2 +111600 IF--TEST-51. NC2504.2 +111700 IF 1000 NOT LESS THAN TEN ** 3 + 1 PERFORM FAIL ELSE NC2504.2 +111800 PERFORM PASS. NC2504.2 +111900 GO TO IF--WRITE-51. NC2504.2 +112000 IF--DELETE-51. NC2504.2 +112100 PERFORM DE-LETE. NC2504.2 +112200 IF--WRITE-51. NC2504.2 +112300 MOVE "IF--TEST-51" TO PAR-NAME. NC2504.2 +112400 PERFORM PRINT-DETAIL. NC2504.2 +112500 IF--TEST-52. NC2504.2 +112600 IF 10 ** 2 + 20 NOT LESS THAN IF-D14 PERFORM FAIL ELSE NC2504.2 +112700 PERFORM PASS. NC2504.2 +112800 GO TO IF--WRITE-52. NC2504.2 +112900 IF--DELETE-52. NC2504.2 +113000 PERFORM DE-LETE. NC2504.2 +113100 IF--WRITE-52. NC2504.2 +113200 MOVE "IF--TEST-52" TO PAR-NAME. NC2504.2 +113300 PERFORM PRINT-DETAIL. NC2504.2 +113400 IF--TEST-53. NC2504.2 +113500 IF NINE * 8 NOT LESS THAN 9 * 7 + TEN PERFORM FAIL ELSE NC2504.2 +113600 PERFORM PASS. NC2504.2 +113700 GO TO IF--WRITE-53. NC2504.2 +113800 IF--DELETE-53. NC2504.2 +113900 PERFORM DE-LETE. NC2504.2 +114000 IF--WRITE-53. NC2504.2 +114100 MOVE "IF--TEST-53" TO PAR-NAME. NC2504.2 +114200 PERFORM PRINT-DETAIL. NC2504.2 +114300 IF--INIT-M. NC2504.2 +114400 MOVE " POS, NEG, ZERO " TO FEATURE. NC2504.2 +114500 IF--TEST-54. NC2504.2 +114600 IF 9 ** TWO + (180 - 90) IS NOT POSITIVE PERFORM FAIL ELSE NC2504.2 +114700 PERFORM PASS. NC2504.2 +114800 GO TO IF--WRITE-54. NC2504.2 +114900 IF--DELETE-54. NC2504.2 +115000 PERFORM DE-LETE. NC2504.2 +115100 IF--WRITE-54. NC2504.2 +115200 MOVE "IF--TEST-54" TO PAR-NAME. NC2504.2 +115300 PERFORM PRINT-DETAIL. NC2504.2 +115400 IF--TEST-55. NC2504.2 +115500 IF NINE ** 2 + (90 - 180) IS POSITIVE PERFORM FAIL ELSE NC2504.2 +115600 PERFORM PASS. NC2504.2 +115700 GO TO IF--WRITE-55. NC2504.2 +115800 IF--DELETE-55. NC2504.2 +115900 PERFORM DE-LETE. NC2504.2 +116000 IF--WRITE-55. NC2504.2 +116100 MOVE "IF--TEST-55" TO PAR-NAME. NC2504.2 +116200 PERFORM PRINT-DETAIL. NC2504.2 +116300 IF--TEST-56. NC2504.2 +116400 IF 8 * EIGHT - 8 * 8 NOT ZERO NC2504.2 +116500 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +116600 GO TO IF--WRITE-56. NC2504.2 +116700 IF--DELETE-56. NC2504.2 +116800 PERFORM DE-LETE. NC2504.2 +116900 IF--WRITE-56. NC2504.2 +117000 MOVE "IF--TEST-56" TO PAR-NAME. NC2504.2 +117100 PERFORM PRINT-DETAIL. NC2504.2 +117200 IF--TEST-57-58. NC2504.2 +117300 MOVE SPACES TO TEST-RESULTS. NC2504.2 +117400 MOVE "NOT USED" TO RE-MARK. NC2504.2 +117500 MOVE "IF--TEST-57" TO PAR-NAME. NC2504.2 +117600 PERFORM PRINT-DETAIL. NC2504.2 +117700 MOVE "NOT USED" TO RE-MARK. NC2504.2 +117800 MOVE "IF--TEST-58" TO PAR-NAME. NC2504.2 +117900 PERFORM PRINT-DETAIL. NC2504.2 +118000 MOVE " POS, NEG, ZERO " TO FEATURE. NC2504.2 +118100 IF--TEST-59. NC2504.2 +118200 IF 10 ** THREE + 99 - (1500 - 400) IS NEGATIVE PERFORM PASS NC2504.2 +118300 ELSE PERFORM FAIL. NC2504.2 +118400 GO TO IF--WRITE-59. NC2504.2 +118500 IF--DELETE-59. NC2504.2 +118600 PERFORM DE-LETE. NC2504.2 +118700 IF--WRITE-59. NC2504.2 +118800 MOVE "IF--TEST-59" TO PAR-NAME. NC2504.2 +118900 PERFORM PRINT-DETAIL. NC2504.2 +119000 IF--TEST-60. NC2504.2 +119100 IF TEN ** 3 + 99 - (1500 - 400) IS NOT POSITIVE PERFORM PASS NC2504.2 +119200 ELSE PERFORM FAIL. NC2504.2 +119300 GO TO IF--WRITE-60. NC2504.2 +119400 IF--DELETE-60. NC2504.2 +119500 PERFORM DE-LETE. NC2504.2 +119600 IF--WRITE-60. NC2504.2 +119700 MOVE "IF--TEST-60" TO PAR-NAME. NC2504.2 +119800 PERFORM PRINT-DETAIL. NC2504.2 +119900 IF--TEST-61. NC2504.2 +120000 IF 8 * EIGHT - 8 * 8 IS ZERO NC2504.2 +120100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +120200 GO TO IF--WRITE-61. NC2504.2 +120300 IF--DELETE-61. NC2504.2 +120400 PERFORM DE-LETE. NC2504.2 +120500 IF--WRITE-61. NC2504.2 +120600 MOVE "IF--TEST-61" TO PAR-NAME. NC2504.2 +120700 PERFORM PRINT-DETAIL. NC2504.2 +120800 IF--TEST-62. NC2504.2 +120900 MOVE SPACES TO TEST-RESULTS. NC2504.2 +121000 MOVE "NOT USED" TO RE-MARK. NC2504.2 +121100 MOVE "IF--TEST-62" TO PAR-NAME. NC2504.2 +121200 PERFORM PRINT-DETAIL. NC2504.2 +121300 MOVE "POS, NEG, ZERO " TO FEATURE. NC2504.2 +121400 IF--TEST-63. NC2504.2 +121500 IF 10 ** THREE + 99 - (1500 - 400) IS NOT NEGATIVE NC2504.2 +121600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +121700 GO TO IF--WRITE-63. NC2504.2 +121800 IF--DELETE-63. NC2504.2 +121900 PERFORM DE-LETE. NC2504.2 +122000 IF--WRITE-63. NC2504.2 +122100 MOVE "IF--TEST-63" TO PAR-NAME. NC2504.2 +122200 PERFORM PRINT-DETAIL. NC2504.2 +122300 IF--INIT-N. NC2504.2 +122400 MOVE " SYMBOLS > < = " TO FEATURE. NC2504.2 +122500 IF--TEST-64. NC2504.2 +122600 IF TEN * 10 - 10 * 10 = - TEN * 10 + 10 * 10 NC2504.2 +122700 PERFORM PASS NC2504.2 +122800 ELSE NC2504.2 +122900 PERFORM FAIL. NC2504.2 +123000 GO TO IF--WRITE-64. NC2504.2 +123100 IF--DELETE-64. NC2504.2 +123200 PERFORM DE-LETE. NC2504.2 +123300 IF--WRITE-64. NC2504.2 +123400 MOVE "IF--TEST-64" TO PAR-NAME. NC2504.2 +123500 PERFORM PRINT-DETAIL. NC2504.2 +123600 IF--TEST-65. NC2504.2 +123700 IF NINE * 8 > 9 * 7 + 8 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +123800 GO TO IF--WRITE-65. NC2504.2 +123900 IF--DELETE-65. NC2504.2 +124000 PERFORM DE-LETE. NC2504.2 +124100 IF--WRITE-65. NC2504.2 +124200 MOVE "IF--TEST-65" TO PAR-NAME. NC2504.2 +124300 PERFORM PRINT-DETAIL. NC2504.2 +124400 IF--TEST-66. NC2504.2 +124500 IF 1000 < 10 ** THREE + 1 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +124600 GO TO IF--WRITE-66. NC2504.2 +124700 IF--DELETE-66. NC2504.2 +124800 PERFORM DE-LETE. NC2504.2 +124900 IF--WRITE-66. NC2504.2 +125000 MOVE "IF--TEST-66" TO PAR-NAME. NC2504.2 +125100 PERFORM PRINT-DETAIL. NC2504.2 +125200 IF--TEST-67. NC2504.2 +125300 IF 100 + TWENTY + 3.4 + .05 NOT = 100 + TWENTY + 3.4 + 0.6 NC2504.2 +125400 PERFORM PASS NC2504.2 +125500 ELSE NC2504.2 +125600 PERFORM FAIL. NC2504.2 +125700 GO TO IF--WRITE-67. NC2504.2 +125800 IF--DELETE-67. NC2504.2 +125900 PERFORM DE-LETE. NC2504.2 +126000 IF--WRITE-67. NC2504.2 +126100 MOVE "IF--TEST-67" TO PAR-NAME. NC2504.2 +126200 PERFORM PRINT-DETAIL. NC2504.2 +126300 IF--TEST-68. NC2504.2 +126400 IF NINE * 8 NOT > 9 * 7 + 8 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +126500 GO TO IF--WRITE-68. NC2504.2 +126600 IF--DELETE-68. NC2504.2 +126700 PERFORM DE-LETE. NC2504.2 +126800 IF--WRITE-68. NC2504.2 +126900 MOVE "IF--TEST-68" TO PAR-NAME. NC2504.2 +127000 PERFORM PRINT-DETAIL. NC2504.2 +127100 IF--TEST-69. NC2504.2 +127200 IF 1000 NOT < 10 ** THREE + 1 PERFORM FAIL ELSE PERFORM PASS.NC2504.2 +127300 GO TO IF--WRITE-69. NC2504.2 +127400 IF--DELETE-69. NC2504.2 +127500 PERFORM DE-LETE. NC2504.2 +127600 IF--WRITE-69. NC2504.2 +127700 MOVE "IF--TEST-69" TO PAR-NAME. NC2504.2 +127800 PERFORM PRINT-DETAIL. NC2504.2 +127900 IF--TEST-70. NC2504.2 +128000 MOVE SPACES TO TEST-RESULTS. NC2504.2 +128100 MOVE "NOT USED" TO RE-MARK. NC2504.2 +128200 MOVE "IF--TEST-70" TO PAR-NAME. NC2504.2 +128300 PERFORM PRINT-DETAIL. NC2504.2 +128400 IF--INIT-N1. NC2504.2 +128500 PERFORM END-ROUTINE. NC2504.2 +128600 MOVE SPACES TO FEATURE. NC2504.2 +128700 MOVE "THE FOLLOWING TESTS COMBINATIONS OF" NC2504.2 +128800 TO RE-MARK. NC2504.2 +128900 PERFORM PRINT-DETAIL. NC2504.2 +129000 MOVE "RELATIONAL AND SIZE ERROR CONDITIONS." NC2504.2 +129100 TO RE-MARK. NC2504.2 +129200 PERFORM PRINT-DETAIL. NC2504.2 +129300 IF--TEST-71. NC2504.2 +129400 MOVE "X" TO WRK-XN-00001. NC2504.2 +129500 MOVE ZERO TO WRK-DS-01V00. NC2504.2 +129600 IF WRK-XN-00001 IS EQUAL TO "X" NC2504.2 +129700 MOVE "Z" TO WRK-XN-00001 NC2504.2 +129800 ADD 1 TO WRK-DS-01V00 ON SIZE ERROR NC2504.2 +129900 MOVE "Y" TO WRK-XN-00001 NC2504.2 +130000 ELSE NC2504.2 +130100 ADD 2 TO WRK-DS-01V00 ON SIZE ERROR NC2504.2 +130200 MOVE "W" TO WRK-XN-00001. NC2504.2 +130300 IF WRK-XN-00001 EQUAL TO "Z" AND NC2504.2 +130400 WRK-DS-01V00 EQUAL TO 1 NC2504.2 +130500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +130600* NOTE COMBINATION OF RELATIONAL AND SIZE ERROR CONDITIONS.NC2504.2 +130700 GO TO IF--WRITE-71. NC2504.2 +130800 IF--DELETE-71. NC2504.2 +130900 PERFORM DE-LETE. NC2504.2 +131000 IF--WRITE-71. NC2504.2 +131100 MOVE " INCL SIZE ERROR" TO FEATURE. NC2504.2 +131200 MOVE "IF--TEST-71" TO PAR-NAME. NC2504.2 +131300 PERFORM PRINT-DETAIL. NC2504.2 +131400 IF--INIT-O. NC2504.2 +131500 MOVE " UNEQUAL LENGTHS" TO FEATURE. NC2504.2 +131600 IF--TEST-73. NC2504.2 +131700 MOVE "X" TO WRK-XN-00001. NC2504.2 +131800 MOVE "X " TO WRK-XN-00005. NC2504.2 +131900 IF WRK-XN-00001 IS EQUAL TO WRK-XN-00005 NC2504.2 +132000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +132100* NOTE EQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +132200 GO TO IF--WRITE-73. NC2504.2 +132300 IF--DELETE-73. NC2504.2 +132400 PERFORM DE-LETE. NC2504.2 +132500 IF--WRITE-73. NC2504.2 +132600 MOVE "IF--TEST-73" TO PAR-NAME. NC2504.2 +132700 PERFORM PRINT-DETAIL. NC2504.2 +132800 IF--TEST-74. NC2504.2 +132900 MOVE "X" TO WRK-XN-00001. NC2504.2 +133000 MOVE "Y " TO WRK-XN-00005. NC2504.2 +133100 IF WRK-XN-00001 IS NOT EQUAL TO WRK-XN-00005 NC2504.2 +133200 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +133300* NOTE UNEQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +133400 GO TO IF--WRITE-74. NC2504.2 +133500 IF--DELETE-74. NC2504.2 +133600 PERFORM DE-LETE. NC2504.2 +133700 IF--WRITE-74. NC2504.2 +133800 MOVE "IF--TEST-74" TO PAR-NAME. NC2504.2 +133900 PERFORM PRINT-DETAIL. NC2504.2 +134000 IF--TEST-75. NC2504.2 +134100 MOVE "X" TO WRK-XN-00001. NC2504.2 +134200 MOVE "X X" TO WRK-XN-00005. NC2504.2 +134300 IF WRK-XN-00001 IS NOT EQUAL TO WRK-XN-00005 NC2504.2 +134400 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +134500* NOTE UNEQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +134600 GO TO IF--WRITE-75. NC2504.2 +134700 IF--DELETE-75. NC2504.2 +134800 PERFORM DE-LETE. NC2504.2 +134900 IF--WRITE-75. NC2504.2 +135000 MOVE "IF--TEST-75" TO PAR-NAME. NC2504.2 +135100 PERFORM PRINT-DETAIL. NC2504.2 +135200 IF--INIT-P. NC2504.2 +135300 MOVE " UNEQUAL LENGTHS" TO FEATURE. NC2504.2 +135400 IF--TEST-77. NC2504.2 +135500 IF IF-D37 NOT EQUAL TO IF-D21 NC2504.2 +135600 PERFORM PASS GO TO IF--WRITE-77. NC2504.2 +135700* NOTE NUMERIC VS GROUP COMPARISON, UNEQUAL LENGTHS. NC2504.2 +135800 GO TO IF--FAIL-77. NC2504.2 +135900 IF--DELETE-77. NC2504.2 +136000 PERFORM DE-LETE. NC2504.2 +136100 GO TO IF--WRITE-11. NC2504.2 +136200 IF--FAIL-77. NC2504.2 +136300 PERFORM FAIL. NC2504.2 +136400 MOVE "IF-D37 SHOULD PAD ON RIGHT" TO RE-MARK. NC2504.2 +136500 IF--WRITE-77. NC2504.2 +136600 MOVE "IF--TEST-77" TO PAR-NAME. NC2504.2 +136700 PERFORM PRINT-DETAIL. NC2504.2 +136800 IF--TEST-78. NC2504.2 +136900 IF IF-D37 EQUAL TO IF-D38 NC2504.2 +137000 PERFORM PASS GO TO IF--WRITE-78. NC2504.2 +137100* NOTE NUMERIC VS ALPHANUMERIC COMPARISON, UNEQUAL LENGTHS.NC2504.2 +137200 GO TO IF--FAIL-78. NC2504.2 +137300 IF--DELETE-78. NC2504.2 +137400 PERFORM DE-LETE. NC2504.2 +137500 GO TO IF--WRITE-78. NC2504.2 +137600 IF--FAIL-78. NC2504.2 +137700 PERFORM FAIL. NC2504.2 +137800 MOVE "IF-D37 SHOULD PAD ON RIGHT" TO RE-MARK. NC2504.2 +137900 IF--WRITE-78. NC2504.2 +138000 MOVE "IF--TEST-78" TO PAR-NAME. NC2504.2 +138100 PERFORM PRINT-DETAIL. NC2504.2 +138200 IF--TEST-79. NC2504.2 +138300 MOVE ZERO TO IF-D10. NC2504.2 +138400 IF D3 OF IF-D10 EQUAL TO "00000000" NC2504.2 +138500 PERFORM PASS NC2504.2 +138600 GO TO IF-WRITE-79. NC2504.2 +138700 MOVE D3 IN IF-D10 TO COMPUTED-A. NC2504.2 +138800 MOVE "00000000" TO CORRECT-A. NC2504.2 +138900 PERFORM FAIL. NC2504.2 +139000 GO TO IF-WRITE-79. NC2504.2 +139100 IF-DELETE-79. NC2504.2 +139200 PERFORM DE-LETE. NC2504.2 +139300 IF-WRITE-79. NC2504.2 +139400 MOVE "QUALIFIED GROUP " TO FEATURE. NC2504.2 +139500 MOVE "IF--TEST-79 " TO PAR-NAME. NC2504.2 +139600 PERFORM PRINT-DETAIL. NC2504.2 +139700 IF--INIT-80. NC2504.2 +139800 PERFORM END-ROUTINE. NC2504.2 +139900 MOVE SPACES TO FEATURE. NC2504.2 +140000 MOVE "THESE SPECIAL CONDITION- " TO RE-MARK. NC2504.2 +140100 PERFORM PRINT-DETAIL. NC2504.2 +140200 MOVE "NAME TESTS VERIFY THE " TO RE-MARK. NC2504.2 +140300 PERFORM PRINT-DETAIL. NC2504.2 +140400 MOVE "ABILITY OF THE COMPILER TO " TO RE-MARK. NC2504.2 +140500 PERFORM PRINT-DETAIL. NC2504.2 +140600 MOVE "ACCEPT SUBSCRIPTED 88 LEVEL" TO RE-MARK. NC2504.2 +140700 PERFORM PRINT-DETAIL. NC2504.2 +140800* NOTE ******* ****** *********NC2504.2 +140900* ***** A NOTE AS THE FIRST STATEMENT IN THIS ****** NC2504.2 +141000* PARAGRAPH WILL BYPASS ALL THE SPECIAL ***** NC2504.2 +141100* CONDITION-NAME TESTS, BUT A NOTE STATEMENT NC2504.2 +141200* MIGHT NEED TO BE INSERTED IN EACH TEST NC2504.2 +141300* SO THE SYNTAX WOULD BE IGNORED BY THE COMPILER. NC2504.2 +141400 MOVE "OCCURS WITH 88 LEVEL" TO FEATURE. NC2504.2 +141500 MOVE 123 TO TABLE-80. NC2504.2 +141600 GO TO IF--TEST-80. NC2504.2 +141700 IF-DELETE-80. NC2504.2 +141800 PERFORM DE-LETE. NC2504.2 +141900 MOVE "IF--TEST-80" TO PAR-NAME. NC2504.2 +142000 MOVE "TEST-80 THRU 85 DELETED " TO RE-MARK. NC2504.2 +142100 PERFORM PRINT-DETAIL. NC2504.2 +142200 ADD 5 TO DELETE-COUNTER. NC2504.2 +142300 GO TO IF--TEST-86. NC2504.2 +142400 IF--TEST-80. NC2504.2 +142500 IF A80 (2) NC2504.2 +142600 PERFORM PASS ELSE NC2504.2 +142700 PERFORM FAIL. NC2504.2 +142800* NOTE ELMT(2) SHOULD CONTAIN A 2 WHICH IS CONTAINED IN NC2504.2 +142900* THE VALUE OF THE A80 88 LEVEL. NC2504.2 +143000 GO TO IF-WRITE-80. NC2504.2 +143100 IF--DELETE-80. NC2504.2 +143200 PERFORM DE-LETE. NC2504.2 +143300 IF-WRITE-80. NC2504.2 +143400 MOVE "IF--TEST-80" TO PAR-NAME. NC2504.2 +143500 PERFORM PRINT-DETAIL. NC2504.2 +143600 IF--TEST-81. NC2504.2 +143700 IF C80 (1) NC2504.2 +143800 PERFORM FAIL ELSE NC2504.2 +143900 PERFORM PASS. NC2504.2 +144000* NOTE ELMT(1) SHOULD CONTAIN A 1 WHICH IS NOT CONTAINED NC2504.2 +144100* IN THE VALUE OF THE C80 88 LEVEL. NC2504.2 +144200 GO TO IF-WRITE-81. NC2504.2 +144300 IF-DELETE-81. NC2504.2 +144400 PERFORM DE-LETE. NC2504.2 +144500 IF-WRITE-81. NC2504.2 +144600 MOVE "IF--TEST-81" TO PAR-NAME. NC2504.2 +144700 PERFORM PRINT-DETAIL. NC2504.2 +144800 IF--TEST-82. NC2504.2 +144900 IF B80 (3) NC2504.2 +145000 PERFORM FAIL ELSE NC2504.2 +145100 PERFORM PASS. NC2504.2 +145200* NOTE ELMT(3) SHOULD CONTAIN A 3 WHICH IS NOT CONTAINED NC2504.2 +145300* IN THE VALUE OF THE B80 88 LEVEL. NC2504.2 +145400 GO TO IF-WRITE-82. NC2504.2 +145500 IF-DELETE-82. NC2504.2 +145600 PERFORM DE-LETE. NC2504.2 +145700 IF-WRITE-82. NC2504.2 +145800 MOVE "IF--TEST-82" TO PAR-NAME. NC2504.2 +145900 PERFORM PRINT-DETAIL. NC2504.2 +146000 IF--TEST-83. NC2504.2 +146100 IF NOT A80 OF TABLE-80 (3) NC2504.2 +146200 PERFORM FAIL ELSE NC2504.2 +146300 PERFORM PASS. NC2504.2 +146400* NOTE ELMT(3) SHOULD CONTAIN A 3 BUT THE NOT CONDITION NC2504.2 +146500* SHOULD CAUSE THE TEST TO FAIL EVEN THOUGH THE A80 NC2504.2 +146600* VALUE INCLUDES THE VALUE 3. NC2504.2 +146700 GO TO IF-WRITE-83. NC2504.2 +146800 IF-DELETE-83. NC2504.2 +146900 PERFORM DE-LETE. NC2504.2 +147000 IF-WRITE-83. NC2504.2 +147100 MOVE "IF--TEST-83" TO PAR-NAME. NC2504.2 +147200 PERFORM PRINT-DETAIL. NC2504.2 +147300 IF--TEST-84. NC2504.2 +147400 IF NOT B80 (1) NC2504.2 +147500 PERFORM PASS ELSE NC2504.2 +147600 PERFORM FAIL. NC2504.2 +147700* NOTE ELMT(1) CONTAINS A 1 AND THE VALUE OF B80 IS 8 NC2504.2 +147800* SO, SAYING NOT 8 IS TRUE. NC2504.2 +147900 GO TO IF-WRITE-84. NC2504.2 +148000 IF-DELETE-84. NC2504.2 +148100 PERFORM DE-LETE. NC2504.2 +148200 IF-WRITE-84. NC2504.2 +148300 MOVE "IF--TEST-84" TO PAR-NAME. NC2504.2 +148400 PERFORM PRINT-DETAIL. NC2504.2 +148500 IF--TEST-85. NC2504.2 +148600 IF C80 OF TABLE-80 (2) NC2504.2 +148700 PERFORM FAIL ELSE NC2504.2 +148800 PERFORM PASS. NC2504.2 +148900* NOTE ELMT(2) IS 2 AND THE VALUES OF C80 DO NOT CONTAIN A 2. NC2504.2 +149000 GO TO IF-WRITE-85. NC2504.2 +149100 IF-DELETE-85. NC2504.2 +149200 PERFORM DE-LETE. NC2504.2 +149300 IF-WRITE-85. NC2504.2 +149400 MOVE "IF--TEST-85" TO PAR-NAME. NC2504.2 +149500 PERFORM PRINT-DETAIL. NC2504.2 +149600 IF--TEST-86. NC2504.2 +149700 IF A86 NC2504.2 +149800 PERFORM FAIL ELSE NC2504.2 +149900 PERFORM PASS. NC2504.2 +150000* NOTE A86 (ABC ) SHOULD NOT EQUAL TABLE-86 (ABCABC). NC2504.2 +150100 GO TO IF-WRITE-86. NC2504.2 +150200 IF-DELETE-86. NC2504.2 +150300 PERFORM DE-LETE. NC2504.2 +150400 IF-WRITE-86. NC2504.2 +150500 MOVE "IF--TEST-86" TO PAR-NAME. NC2504.2 +150600 PERFORM PRINT-DETAIL. NC2504.2 +150700 IF--TEST-87. NC2504.2 +150800 IF NOT B86 NC2504.2 +150900 PERFORM FAIL ELSE NC2504.2 +151000 PERFORM PASS. NC2504.2 +151100* NOTE B86 (ABCABC) SHOULD EQUAL TABLE-86 (ABCABC) THUS NC2504.2 +151200* FAILING THE TEST. NC2504.2 +151300 GO TO IF-WRITE-87. NC2504.2 +151400 IF-DELETE-87. NC2504.2 +151500 PERFORM DE-LETE. NC2504.2 +151600 IF-WRITE-87. NC2504.2 +151700 MOVE "IF--TEST-87" TO PAR-NAME. NC2504.2 +151800 PERFORM PRINT-DETAIL. NC2504.2 +151900 IF--TEST-88. NC2504.2 +152000 MOVE SPACES TO DATANAME-86. NC2504.2 +152100 IF C86 NC2504.2 +152200 PERFORM PASS ELSE NC2504.2 +152300 PERFORM FAIL. NC2504.2 +152400* NOTE TABLE-86 ( ABC) SHOULD EQUAL C86 ( ABC). NC2504.2 +152500 GO TO IF-WRITE-88. NC2504.2 +152600 IF-DELETE-88. NC2504.2 +152700 PERFORM DE-LETE. NC2504.2 +152800 IF-WRITE-88. NC2504.2 +152900 MOVE "IF--TEST-88" TO PAR-NAME. NC2504.2 +153000 PERFORM PRINT-DETAIL. NC2504.2 +153100 IF--INIT-R. NC2504.2 +153200 MOVE "FIGCON < = > D-NAME" TO FEATURE. NC2504.2 +153300 IF--TEST-89. NC2504.2 +153400 IF ZEROS NOT < LOW-VAL NC2504.2 +153500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +153600 GO TO IF--WRITE-89. NC2504.2 +153700 IF--DELETE-89. NC2504.2 +153800 PERFORM DE-LETE. NC2504.2 +153900 IF--WRITE-89. NC2504.2 +154000 MOVE "IF--TEST-89 " TO PAR-NAME. NC2504.2 +154100 PERFORM PRINT-DETAIL. NC2504.2 +154200 IF--TEST-90. NC2504.2 +154300 IF ZEROS < ONE23 NC2504.2 +154400 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +154500 GO TO IF--WRITE-90. NC2504.2 +154600 IF--DELETE-90. NC2504.2 +154700 PERFORM DE-LETE. NC2504.2 +154800 IF--WRITE-90. NC2504.2 +154900 MOVE "IF--TEST-90 " TO PAR-NAME. NC2504.2 +155000 PERFORM PRINT-DETAIL. NC2504.2 +155100 IF--TEST-91. NC2504.2 +155200 IF ZEROS = ZERO-C NC2504.2 +155300 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +155400 GO TO IF--WRITE-91. NC2504.2 +155500 IF--DELETE-91. NC2504.2 +155600 PERFORM DE-LETE. NC2504.2 +155700 IF--WRITE-91. NC2504.2 +155800 MOVE "IF--TEST-91 " TO PAR-NAME. NC2504.2 +155900 PERFORM PRINT-DETAIL. NC2504.2 +156000 IF--TEST-92. NC2504.2 +156100 IF ZEROS NOT = ZERO-D NC2504.2 +156200 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +156300 GO TO IF--WRITE-92. NC2504.2 +156400 IF--DELETE-92. NC2504.2 +156500 PERFORM DE-LETE. NC2504.2 +156600 IF--WRITE-92. NC2504.2 +156700 MOVE "IF--TEST-92 " TO PAR-NAME. NC2504.2 +156800 PERFORM PRINT-DETAIL. NC2504.2 +156900 IF--TEST-93. NC2504.2 +157000 IF SPACES = SPACE-X NC2504.2 +157100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +157200 GO TO IF--WRITE-93. NC2504.2 +157300 IF--DELETE-93. NC2504.2 +157400 PERFORM DE-LETE. NC2504.2 +157500 IF--WRITE-93. NC2504.2 +157600 MOVE "IF--TEST-93 " TO PAR-NAME. NC2504.2 +157700 PERFORM PRINT-DETAIL. NC2504.2 +157800 IF--TEST-94. NC2504.2 +157900 IF SPACES NOT = QUOTE-X NC2504.2 +158000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +158100 GO TO IF--WRITE-94. NC2504.2 +158200 IF--DELETE-94. NC2504.2 +158300 PERFORM DE-LETE. NC2504.2 +158400 IF--WRITE-94. NC2504.2 +158500 MOVE "IF--TEST-94 " TO PAR-NAME. NC2504.2 +158600 PERFORM PRINT-DETAIL. NC2504.2 +158700 IF--TEST-95. NC2504.2 +158800 IF SPACES > ABC OR < ABC NC2504.2 +158900 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +159000 GO TO IF--WRITE-95. NC2504.2 +159100 IF--DELETE-95. NC2504.2 +159200 PERFORM DE-LETE. NC2504.2 +159300 IF--WRITE-95. NC2504.2 +159400 MOVE "IF--TEST-95 " TO PAR-NAME. NC2504.2 +159500 PERFORM PRINT-DETAIL. NC2504.2 +159600 IF--TEST-96. NC2504.2 +159700 IF QUOTES NOT > QUOTE-X NC2504.2 +159800 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +159900 GO TO IF--WRITE-96. NC2504.2 +160000 IF--DELETE-96. NC2504.2 +160100 PERFORM DE-LETE. NC2504.2 +160200 IF--WRITE-96. NC2504.2 +160300 MOVE "IF--TEST-96 " TO PAR-NAME. NC2504.2 +160400 PERFORM PRINT-DETAIL. NC2504.2 +160500 IF--TEST-97. NC2504.2 +160600 IF QUOTES NOT = ZERO-D NC2504.2 +160700 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +160800 GO TO IF--WRITE-97. NC2504.2 +160900 IF--DELETE-97. NC2504.2 +161000 PERFORM DE-LETE. NC2504.2 +161100 IF--WRITE-97. NC2504.2 +161200 MOVE "IF--TEST-97 " TO PAR-NAME. NC2504.2 +161300 PERFORM PRINT-DETAIL. NC2504.2 +161400 IF--TEST-98. NC2504.2 +161500 IF HIGH-VALUES > LOW-VAL NC2504.2 +161600 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +161700 GO TO IF--WRITE-98. NC2504.2 +161800 IF--DELETE-98. NC2504.2 +161900 PERFORM DE-LETE. NC2504.2 +162000 IF--WRITE-98. NC2504.2 +162100 MOVE "IF--TEST-98 " TO PAR-NAME. NC2504.2 +162200 PERFORM PRINT-DETAIL. NC2504.2 +162300 IF--TEST-99. NC2504.2 +162400 IF HIGH-VALUES > ABC NC2504.2 +162500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +162600 GO TO IF--WRITE-99. NC2504.2 +162700 IF--DELETE-99. NC2504.2 +162800 PERFORM DE-LETE. NC2504.2 +162900 IF--WRITE-99. NC2504.2 +163000 MOVE "IF--TEST-99 " TO PAR-NAME. NC2504.2 +163100 PERFORM PRINT-DETAIL. NC2504.2 +163200 IF--TEST-100. NC2504.2 +163300 IF HIGH-VALUES NOT > ONE23 NC2504.2 +163400 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +163500 GO TO IF--WRITE-100. NC2504.2 +163600 IF--DELETE-100. NC2504.2 +163700 PERFORM DE-LETE. NC2504.2 +163800 IF--WRITE-100. NC2504.2 +163900 MOVE "IF--TEST-100" TO PAR-NAME. NC2504.2 +164000 PERFORM PRINT-DETAIL. NC2504.2 +164100 IF--TEST-101. NC2504.2 +164200 IF HIGH-VALUES = ZERO-D NC2504.2 +164300 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +164400 GO TO IF--WRITE-101. NC2504.2 +164500 IF--DELETE-101. NC2504.2 +164600 PERFORM DE-LETE. NC2504.2 +164700 IF--WRITE-101. NC2504.2 +164800 MOVE "IF--TEST-101" TO PAR-NAME. NC2504.2 +164900 PERFORM PRINT-DETAIL. NC2504.2 +165000 IF--TEST-102. NC2504.2 +165100 IF LOW-VALUES = LOW-VAL NC2504.2 +165200 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +165300 GO TO IF--WRITE-102. NC2504.2 +165400 IF--DELETE-102. NC2504.2 +165500 PERFORM DE-LETE. NC2504.2 +165600 IF--WRITE-102. NC2504.2 +165700 MOVE "IF--TEST-102" TO PAR-NAME. NC2504.2 +165800 PERFORM PRINT-DETAIL. NC2504.2 +165900 IF--TEST-103. NC2504.2 +166000 IF LOW-VALUES < ABC NC2504.2 +166100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +166200 GO TO IF--WRITE-103. NC2504.2 +166300 IF--DELETE-103. NC2504.2 +166400 PERFORM DE-LETE. NC2504.2 +166500 IF--WRITE-103. NC2504.2 +166600 MOVE "IF--TEST-103" TO PAR-NAME. NC2504.2 +166700 PERFORM PRINT-DETAIL. NC2504.2 +166800 IF--TEST-104. NC2504.2 +166900 IF ALL "00" < ONE23 NC2504.2 +167000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +167100 GO TO IF--WRITE-104. NC2504.2 +167200 IF--DELETE-104. NC2504.2 +167300 PERFORM DE-LETE. NC2504.2 +167400 IF--WRITE-104. NC2504.2 +167500 MOVE "IF--TEST-104" TO PAR-NAME. NC2504.2 +167600 PERFORM PRINT-DETAIL. NC2504.2 +167700 IF--TEST-105. NC2504.2 +167800 IF ALL ZEROES = ZERO-D NC2504.2 +167900 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +168000 GO TO IF--WRITE-105. NC2504.2 +168100 IF--DELETE-105. NC2504.2 +168200 PERFORM DE-LETE. NC2504.2 +168300 IF--WRITE-105. NC2504.2 +168400 MOVE "IF--TEST-105" TO PAR-NAME. NC2504.2 +168500 PERFORM PRINT-DETAIL. NC2504.2 +168600 IF--TEST-106. NC2504.2 +168700 IF ALL "00" NOT > ZERO-D NC2504.2 +168800 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +168900 GO TO IF--WRITE-106. NC2504.2 +169000 IF--DELETE-106. NC2504.2 +169100 PERFORM DE-LETE. NC2504.2 +169200 IF--WRITE-106. NC2504.2 +169300 MOVE "IF--TEST-106" TO PAR-NAME. NC2504.2 +169400 PERFORM PRINT-DETAIL. NC2504.2 +169500 IF--TEST-107. NC2504.2 +169600 IF ALL "A" = SPACE-X NC2504.2 +169700 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +169800 GO TO IF--WRITE-107. NC2504.2 +169900 IF--DELETE-107. NC2504.2 +170000 PERFORM DE-LETE. NC2504.2 +170100 IF--WRITE-107. NC2504.2 +170200 MOVE "IF--TEST-107" TO PAR-NAME. NC2504.2 +170300 PERFORM PRINT-DETAIL. NC2504.2 +170400 IF--TEST-108. NC2504.2 +170500 IF ALL "A" > ABC NC2504.2 +170600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +170700 GO TO IF--WRITE-108. NC2504.2 +170800 IF--DELETE-108. NC2504.2 +170900 PERFORM DE-LETE. NC2504.2 +171000 IF--WRITE-108. NC2504.2 +171100 MOVE "IF--TEST-108" TO PAR-NAME. NC2504.2 +171200 PERFORM PRINT-DETAIL. NC2504.2 +171300 IF--TEST-109. NC2504.2 +171400 IF IF-D4 ALPHABETIC NC2504.2 +171500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +171600 GO TO IF--WRITE-109. NC2504.2 +171700 IF--DELETE-109. NC2504.2 +171800 PERFORM DE-LETE. NC2504.2 +171900 IF--WRITE-109. NC2504.2 +172000 MOVE "CLASS --- ALPHABETIC" TO FEATURE. NC2504.2 +172100 MOVE "IF--TEST-109" TO PAR-NAME. NC2504.2 +172200 PERFORM PRINT-DETAIL. NC2504.2 +172300 IF--INIT-S. NC2504.2 +172400 MOVE "SIGN --- ZERO" TO FEATURE. NC2504.2 +172500 IF--TEST-110. NC2504.2 +172600 IF SMALLEST-VALU GREATER THAN SMALL-VALU NC2504.2 +172700 AND IS NOT LESS THAN EVEN-SMALLER OR SMALLER-VALU NC2504.2 +172800 MOVE "CONDITION FALSE" TO CORRECT-A NC2504.2 +172900 MOVE "CONDITION TRUE " TO COMPUTED-A NC2504.2 +173000 PERFORM FAIL NC2504.2 +173100 GO TO IF--WRITE-110. NC2504.2 +173200 PERFORM PASS. NC2504.2 +173300 GO TO IF--WRITE-110. NC2504.2 +173400 IF--DELETE-110. NC2504.2 +173500 PERFORM DE-LETE. NC2504.2 +173600 IF--WRITE-110. NC2504.2 +173700 MOVE "IF--TEST-110" TO PAR-NAME. NC2504.2 +173800 MOVE "ABBREV CONDITIONS" TO FEATURE. NC2504.2 +173900 PERFORM PRINT-DETAIL. NC2504.2 +174000 IF--TEST-111. NC2504.2 +174100 IF SMALLEST-VALU LESS THAN SMALL-VALU AND NC2504.2 +174200 (SMALLEST-VALU GREATER THAN EVEN-SMALLER OR SMALLER-VALU) NC2504.2 +174300 PERFORM PASS GO TO IF--WRITE-111. NC2504.2 +174400 MOVE "CONDITION TRUE" TO CORRECT-A. NC2504.2 +174500 MOVE "CONDITION FALSE" TO COMPUTED-A. NC2504.2 +174600 PERFORM FAIL. NC2504.2 +174700 GO TO IF--WRITE-111. NC2504.2 +174800 IF--DELETE-111. NC2504.2 +174900 PERFORM DE-LETE. NC2504.2 +175000 IF--WRITE-111. NC2504.2 +175100 MOVE "IF--TEST-111" TO PAR-NAME. NC2504.2 +175200 PERFORM PRINT-DETAIL. NC2504.2 +175300 IF--TEST-112. NC2504.2 +175400 IF IF-D40B NC2504.2 +175500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +175600 GO TO IF--WRITE-112. NC2504.2 +175700 IF--DELETE-112. NC2504.2 +175800 PERFORM DE-LETE. NC2504.2 +175900 IF--WRITE-112. NC2504.2 +176000 MOVE "CONDITION---NAME" TO FEATURE. NC2504.2 +176100 MOVE "IF--TEST-112" TO PAR-NAME. NC2504.2 +176200 PERFORM PRINT-DETAIL. NC2504.2 +176300 IF--INIT-T. NC2504.2 +176400 MOVE "ABBREV---CONDITION" TO FEATURE. NC2504.2 +176500 IF--TEST-113. NC2504.2 +176600 IF SMALLEST-VALU LESS THAN SMALL-VALU AND (SMALLEST-VALU NOT NC2504.2 +176700 GREATER THAN EVEN-SMALLER OR SMALLER-VALU) NC2504.2 +176800 PERFORM PASS NC2504.2 +176900 GO TO IF--WRITE-113. NC2504.2 +177000 MOVE "CONDITION TRUE" TO CORRECT-A. NC2504.2 +177100 MOVE "CONDITION FALSE" TO COMPUTED-A. NC2504.2 +177200 PERFORM FAIL. NC2504.2 +177300 GO TO IF--WRITE-113. NC2504.2 +177400 IF--DELETE-113. NC2504.2 +177500 PERFORM DE-LETE. NC2504.2 +177600 IF--WRITE-113. NC2504.2 +177700 MOVE "IF--TEST-113" TO PAR-NAME. NC2504.2 +177800 PERFORM PRINT-DETAIL. NC2504.2 +177900 IF--TEST-114. NC2504.2 +178000 IF SMALLEST-VALU LESS THAN SMALL-VALU NC2504.2 +178100 AND NOT EVEN-SMALLER OR SMALLER-VALU NC2504.2 +178200 PERFORM PASS NC2504.2 +178300 GO TO IF--WRITE-114 NC2504.2 +178400 ELSE NC2504.2 +178500 PERFORM FAIL NC2504.2 +178600 MOVE "CONDITION FALSE" TO CORRECT-A NC2504.2 +178700 MOVE "CONDITION TRUE" TO COMPUTED-A NC2504.2 +178800 GO TO IF--WRITE-114. NC2504.2 +178900 IF--DELETE-114. NC2504.2 +179000 PERFORM DE-LETE. NC2504.2 +179100 IF--WRITE-114. NC2504.2 +179200 MOVE "IF--TEST-114" TO PAR-NAME. NC2504.2 +179300 PERFORM PRINT-DETAIL. NC2504.2 +179400 IF--TEST-115. NC2504.2 +179500 IF COMP-SGN1 IS POSITIVE NC2504.2 +179600 PERFORM PASS NC2504.2 +179700 GO TO IF--WRITE-115. NC2504.2 +179800 MOVE "POSITIVE EXPECTED" TO CORRECT-A. NC2504.2 +179900 MOVE COMP-SGN1 TO COMPUTED-14V4. NC2504.2 +180000 PERFORM FAIL. NC2504.2 +180100 GO TO IF--WRITE-115. NC2504.2 +180200 IF--DELETE-115. NC2504.2 +180300 PERFORM DE-LETE. NC2504.2 +180400 IF--WRITE-115. NC2504.2 +180500 MOVE "POS/NEG SIGN TEST" TO FEATURE. NC2504.2 +180600 MOVE "IF--TEST-115" TO PAR-NAME. NC2504.2 +180700 PERFORM PRINT-DETAIL. NC2504.2 +180800 IF--TEST-116. NC2504.2 +180900 IF COMP-SGN2 NOT POSITIVE NC2504.2 +181000 MOVE COMP-SGN2 TO COMPUTED-14V4 NC2504.2 +181100 MOVE "POSITIVE EXPECTED" TO CORRECT-A NC2504.2 +181200 PERFORM FAIL NC2504.2 +181300 GO TO IF--WRITE-116. NC2504.2 +181400 PERFORM PASS. NC2504.2 +181500 GO TO IF--WRITE-116. NC2504.2 +181600 IF--DELETE-116. NC2504.2 +181700 PERFORM DE-LETE. NC2504.2 +181800 IF--WRITE-116. NC2504.2 +181900 MOVE "IF--TEST-116" TO PAR-NAME. NC2504.2 +182000 PERFORM PRINT-DETAIL. NC2504.2 +182100 IF--TEST-117. NC2504.2 +182200 IF COMP-SGN3 NOT NEGATIVE NC2504.2 +182300 MOVE COMP-SGN3 TO COMPUTED-14V4 NC2504.2 +182400 MOVE "NEGATIVE EXPECTED" TO CORRECT-A NC2504.2 +182500 PERFORM FAIL NC2504.2 +182600 GO TO IF--WRITE-117. NC2504.2 +182700 PERFORM PASS. NC2504.2 +182800 GO TO IF--WRITE-117. NC2504.2 +182900 IF--DELETE-117. NC2504.2 +183000 PERFORM DE-LETE. NC2504.2 +183100 IF--WRITE-117. NC2504.2 +183200 MOVE "IF--TEST-117" TO PAR-NAME. NC2504.2 +183300 PERFORM PRINT-DETAIL. NC2504.2 +183400 IF--TEST-118. NC2504.2 +183500 IF COMP-SGN4 NOT POSITIVE NC2504.2 +183600 PERFORM PASS NC2504.2 +183700 GO TO IF--WRITE-118. NC2504.2 +183800 MOVE COMP-SGN4 TO COMPUTED-14V4. NC2504.2 +183900 MOVE "NEGATIVE EXPECTED" TO CORRECT-A. NC2504.2 +184000 PERFORM FAIL. NC2504.2 +184100 GO TO IF--WRITE-118. NC2504.2 +184200 IF--DELETE-118. NC2504.2 +184300 PERFORM DE-LETE. NC2504.2 +184400 IF--WRITE-118. NC2504.2 +184500 MOVE "IF--TEST-118" TO PAR-NAME. NC2504.2 +184600 PERFORM PRINT-DETAIL. NC2504.2 +184700 IF--TEST-119. NC2504.2 +184800 MOVE SPACES TO TEST-RESULTS. NC2504.2 +184900 MOVE "NOT USED" TO RE-MARK. NC2504.2 +185000 MOVE "IF--TEST-119" TO PAR-NAME. NC2504.2 +185100 PERFORM PRINT-DETAIL. NC2504.2 +185200 IF--TEST-120. NC2504.2 +185300 MOVE -10 TO WRK-DS-06V06. NC2504.2 +185400 ADD +10 TO WRK-DS-06V06. NC2504.2 +185500 IF WRK-DS-06V06 NEGATIVE NC2504.2 +185600 PERFORM FAIL-120-121 NC2504.2 +185700 MOVE "NEGATIVE ZERO DETECTED" TO RE-MARK NC2504.2 +185800 GO TO IF--WRITE-120. NC2504.2 +185900 IF WRK-DS-06V06 POSITIVE NC2504.2 +186000 PERFORM FAIL-120-121 NC2504.2 +186100 MOVE "POSITIVE ZERO DETECTED" TO RE-MARK NC2504.2 +186200 GO TO IF--WRITE-120. NC2504.2 +186300 IF WRK-DS-06V06 ZERO NC2504.2 +186400 PERFORM PASS GO TO IF--WRITE-120. NC2504.2 +186500 PERFORM FAIL-120-121. NC2504.2 +186600 MOVE "NEITHER POS, NEG, NOR ZERO" TO RE-MARK. NC2504.2 +186700 GO TO IF--WRITE-120. NC2504.2 +186800 IF--DELETE-120. NC2504.2 +186900 PERFORM DE-LETE. NC2504.2 +187000 IF--WRITE-120. NC2504.2 +187100 MOVE "SIGN TEST ON ZERO" TO FEATURE. NC2504.2 +187200 MOVE "IF--TEST-120" TO PAR-NAME. NC2504.2 +187300 PERFORM PRINT-DETAIL. NC2504.2 +187400 GO TO IF--EXIT-120. NC2504.2 +187500 FAIL-120-121. NC2504.2 +187600 PERFORM FAIL. NC2504.2 +187700 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2504.2 +187800 MOVE ZERO TO CORRECT-N. NC2504.2 +187900 IF--EXIT-120. NC2504.2 +188000 EXIT. NC2504.2 +188100 IF--TEST-121. NC2504.2 +188200 MOVE 10 TO WRK-DS-06V06. NC2504.2 +188300 SUBTRACT 10 FROM WRK-DS-06V06. NC2504.2 +188400 IF WRK-DS-06V06 NEGATIVE NC2504.2 +188500 PERFORM FAIL-120-121 NC2504.2 +188600 MOVE "NEGATIVE ZERO DETECTED" TO RE-MARK NC2504.2 +188700 GO TO IF--WRITE-121. NC2504.2 +188800 IF WRK-DS-06V06 POSITIVE NC2504.2 +188900 PERFORM FAIL-120-121 NC2504.2 +189000 MOVE "POSITIVE ZERO DETECTED" TO RE-MARK NC2504.2 +189100 GO TO IF--WRITE-121. NC2504.2 +189200 NC2504.2 +189300 IF WRK-DS-06V06 ZERO NC2504.2 +189400 PERFORM PASS GO TO IF--WRITE-121. NC2504.2 +189500 PERFORM FAIL-120-121. NC2504.2 +189600 MOVE "NEITHER POS, NEG, NOR ZERO" TO RE-MARK. NC2504.2 +189700 GO TO IF--WRITE-120. NC2504.2 +189800 IF--DELETE-121. NC2504.2 +189900 PERFORM DE-LETE. NC2504.2 +190000 IF--WRITE-121. NC2504.2 +190100 MOVE "IF--TEST-121" TO PAR-NAME. NC2504.2 +190200 PERFORM PRINT-DETAIL. NC2504.2 +190300 IF-INIT-122. NC2504.2 +190400 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +190500 MOVE 1 TO WRK-DU-1V0-1. NC2504.2 +190600 MOVE 2 TO WRK-DU-1V0-2. NC2504.2 +190700 MOVE 3 TO WRK-DU-1V0-3. NC2504.2 +190800 MOVE 0 TO WRK-DU-1V0-4. NC2504.2 +190900 IF-TEST-122. NC2504.2 +191000 IF NOT (WRK-DU-1V0-1 NOT GREATER WRK-DU-1V0-2 AND NC2504.2 +191100 WRK-DU-1V0-3 AND NOT WRK-DU-1V0-4) GO TO BUMMER-122 NC2504.2 +191200 ELSE NEXT SENTENCE. NC2504.2 +191300 PERFORM PASS. NC2504.2 +191400 GO TO IF-WRITE-122. NC2504.2 +191500 IF-DELETE-122. NC2504.2 +191600 PERFORM DE-LETE. NC2504.2 +191700 GO TO IF-WRITE-122. NC2504.2 +191800 BUMMER-122. NC2504.2 +191900 PERFORM FAIL. NC2504.2 +192000 MOVE "RESULT TRUE" TO COMPUTED-A. NC2504.2 +192100 MOVE "SHOULD BE FALSE" TO CORRECT-A. NC2504.2 +192200 IF-WRITE-122. NC2504.2 +192300 MOVE "IF-TEST-122" TO PAR-NAME. NC2504.2 +192400 MOVE "ABR. COM. REL. CONDT" TO FEATURE. NC2504.2 +192500 PERFORM PRINT-DETAIL. NC2504.2 +192600 IF-INIT-123. NC2504.2 +192700 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +192800 MOVE 9 TO WRK-DU-1V0-1. NC2504.2 +192900 MOVE 8 TO WRK-DU-1V0-2. NC2504.2 +193000 MOVE 7 TO WRK-DU-1V0-3. NC2504.2 +193100 IF-LOGICAL-CONN-TEST-123. NC2504.2 +193200 IF WRK-DU-1V0-1 > WRK-DU-1V0-2 AND NOT < WRK-DU-2V0-1 OR NC2504.2 +193300 WRK-DU-2V0-2 OR NOT WRK-DU-2V0-3 AND WRK-DU-1V0-3 NC2504.2 +193400 PERFORM PASS NC2504.2 +193500 ELSE NC2504.2 +193600 PERFORM FAIL MOVE "FALSE RESULT FOUND" TO COMPUTED-A NC2504.2 +193700 MOVE "SHOULD BE TRUE" TO CORRECT-A. NC2504.2 +193800 GO TO IF-WRITE-123. NC2504.2 +193900 IF-DELETE-123. NC2504.2 +194000 PERFORM DE-LETE. NC2504.2 +194100 IF-WRITE-123. NC2504.2 +194200 MOVE "IF-TEST-123" TO PAR-NAME. NC2504.2 +194300 MOVE "LOGICAL CONNECTIVES" TO FEATURE. NC2504.2 +194400 PERFORM PRINT-DETAIL. NC2504.2 +194500 PERFORM END-ROUTINE. NC2504.2 +194600 MOVE " COLLATING-AND-ALPHABET-TEST-9 SYNTAX CHECK IN OBJENC2504.2 +194700- "CT-COMPUTER AND SPECIAL-NAMES" TO TEST-RESULTS. NC2504.2 +194800 PERFORM PRINT-DETAIL. NC2504.2 +194900 MOVE SPACE TO TEST-RESULTS. NC2504.2 +195000 IF-INIT-124. NC2504.2 +195100* ===--> ARITHMETIC EXPRESSION CONTAINING ZERO <--=== NC2504.2 +195200 MOVE "VI-58 6.3.1.5 AND VI-51 6.2" TO ANSI-REFERENCE. NC2504.2 +195300 MOVE 4 TO WRK-DU-1V0-1. NC2504.2 +195400 MOVE "IF-TEST-124" TO PAR-NAME. NC2504.2 +195500 IF-TEST-124. NC2504.2 +195600 IF ZERO - WRK-DU-1V0-1 IS NEGATIVE NC2504.2 +195700 PERFORM PASS NC2504.2 +195800 ELSE NC2504.2 +195900 PERFORM FAIL NC2504.2 +196000 MOVE "POSITIVE RESULT FOUND" TO COMPUTED-A NC2504.2 +196100 MOVE "SHOULD BE NEGATIVE" TO CORRECT-A. NC2504.2 +196200 GO TO IF-WRITE-124. NC2504.2 +196300 IF-DELETE-124. NC2504.2 +196400 PERFORM DE-LETE. NC2504.2 +196500 IF-WRITE-124. NC2504.2 +196600 MOVE "IF-TEST-124" TO PAR-NAME. NC2504.2 +196700 MOVE "LOGICAL CONNECTIVES" TO FEATURE. NC2504.2 +196800 PERFORM PRINT-DETAIL. NC2504.2 +196900 CCVS-EXIT SECTION. NC2504.2 +197000 CCVS-999999. NC2504.2 +197100 GO TO CLOSE-FILES. NC2504.2 +*END-OF,NC250A +*HEADER,COBOL,NC251A +000100 IDENTIFICATION DIVISION. NC2514.2 +000200 PROGRAM-ID. NC2514.2 +000300 NC251A. NC2514.2 +000400**************************************************************** NC2514.2 +000500* * NC2514.2 +000600* VALIDATION FOR:- * NC2514.2 +000700* * NC2514.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +000900* * NC2514.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2514.2 +001100* * NC2514.2 +001200**************************************************************** NC2514.2 +001300* * NC2514.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2514.2 +001500* * NC2514.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2514.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2514.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2514.2 +001900* * NC2514.2 +002000**************************************************************** NC2514.2 +002100* * NC2514.2 +002200* THIS PROGRAM TESTS FORMAT 5 OF THE DIVIDE STATEMENT. * NC2514.2 +002300* * NC2514.2 +002400**************************************************************** NC2514.2 +002500 ENVIRONMENT DIVISION. NC2514.2 +002600 CONFIGURATION SECTION. NC2514.2 +002700 SOURCE-COMPUTER. NC2514.2 +002800 XXXXX082. NC2514.2 +002900 OBJECT-COMPUTER. NC2514.2 +003000 XXXXX083. NC2514.2 +003100 INPUT-OUTPUT SECTION. NC2514.2 +003200 FILE-CONTROL. NC2514.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2514.2 +003400 XXXXX055. NC2514.2 +003500 DATA DIVISION. NC2514.2 +003600 FILE SECTION. NC2514.2 +003700 FD PRINT-FILE. NC2514.2 +003800 01 PRINT-REC PICTURE X(120). NC2514.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2514.2 +004000 WORKING-STORAGE SECTION. NC2514.2 +004100 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC2514.2 +004200 01 WRK-DU-1V5-1 PIC 9V9(5). NC2514.2 +004300 01 WRK-NE-1 PIC .9999/99999,99999,99. NC2514.2 +004400 01 WS-REMAINDERS. NC2514.2 +004500 03 WS-REM PIC 99 OCCURS 20. NC2514.2 +004600 01 WRK-XN-00001-1 PIC X. NC2514.2 +004700 01 WRK-XN-00001-2 PIC X. NC2514.2 +004800 01 WS-46. NC2514.2 +004900 03 WS-1-20 PIC X(20). NC2514.2 +005000 03 WS-21-40 PIC X(20). NC2514.2 +005100 03 WS-41-46 PIC X(6). NC2514.2 +005200 77 11A PICTURE 9999 VALUE 9. NC2514.2 +005300 77 11B PICTURE 99; VALUE 8. NC2514.2 +005400 77 1111C PICTURE 99 VALUE 9. NC2514.2 +005500 77 WRK-DS-02V00 PICTURE S99. NC2514.2 +005600 88 TEST-2NUC-COND-99 VALUE 99. NC2514.2 +005700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2514.2 +005800 77 WRK-DS-18V00 PICTURE S9(18). NC2514.2 +005900 77 WRK-DU-2V1-1 PICTURE S99V9. NC2514.2 +006000 77 A18ONES-DS-18V00 PICTURE S9(18) NC2514.2 +006100 VALUE 111111111111111111. NC2514.2 +006200 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2514.2 +006300 VALUE 222222222222222222. NC2514.2 +006400 77 WRK-DS-05V00 PICTURE S9(5). NC2514.2 +006500 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2514.2 +006600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2514.2 +006700 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2514.2 +006800 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2514.2 +006900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2514.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC2514.2 +007100 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2514.2 +007200 77 WRK-DS-09V00 PICTURE S9(9). NC2514.2 +007300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2514.2 +007400 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2514.2 +007500 PICTURE S9(18). NC2514.2 +007600 77 XRAY PICTURE IS X. NC2514.2 +007700 77 W-1 PICTURE IS 9. NC2514.2 +007800 77 W-2 PICTURE IS 99. NC2514.2 +007900 77 W-3 PICTURE IS 999. NC2514.2 +008000 77 W-5 PICTURE 99 VALUE ZERO. NC2514.2 +008100 77 W-9 PICTURE 999. NC2514.2 +008200 77 W-11 PICTURE S99V9. NC2514.2 +008300 77 D-1 PICTURE S9V99 VALUE 1.06. NC2514.2 +008400 77 D-7 PICTURE S99V99 VALUE 1.09. NC2514.2 +008500 77 ONE PICTURE IS 9 VALUE IS 1. NC2514.2 +008600 77 TWO PICTURE IS S9 VALUE IS 2. NC2514.2 +008700 77 THREE PICTURE IS S9 VALUE IS 3. NC2514.2 +008800 77 FOUR PICTURE IS S9 VALUE IS 4. NC2514.2 +008900 77 FIVE PICTURE IS S9 VALUE IS 5. NC2514.2 +009000 77 SIX PICTURE IS S9 VALUE IS 6. NC2514.2 +009100 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2514.2 +009200 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2514.2 +009300 77 NINE PICTURE IS S9 VALUE IS 9. NC2514.2 +009400 77 TEN PICTURE IS S99 VALUE IS 10. NC2514.2 +009500 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2514.2 +009600 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2514.2 +009700 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2514.2 +009800 77 25COUNT PICTURE 999 VALUE ZERO. NC2514.2 +009900 77 25ANS PICTURE 99 VALUE ZERO. NC2514.2 +010000 77 25REM PICTURE 99 VALUE ZERO. NC2514.2 +010100 77 DIV-30-Y1 PICTURE 999 USAGE COMP SYNC RIGHT VALUE 31. NC2514.2 +010200 77 DIV-30-Y2 PICTURE 999 USAGE COMP VALUE 54. NC2514.2 +010300 77 DIV-30-Y3 PICTURE 999 VALUE 151. NC2514.2 +010400 77 DIV-30-Y4 PICTURE 9(4) SYNC RIGHT VALUE 1010. NC2514.2 +010500 77 DIV-Z1-30 PICTURE 999 USAGE COMP VALUE ZERO. NC2514.2 +010600 77 DIV-Z2-30 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2514.2 +010700 77 DIV-Z3-30 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2514.2 +010800 77 DIV-Z4-30 PICTURE 999 VALUE ZERO. NC2514.2 +010900 77 DIV-30-A1 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2514.2 +011000 77 DIV-30-A2 PICTURE 999 VALUE ZERO. NC2514.2 +011100 77 DIV-30-A3 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2514.2 +011200 77 DIV-30-A4 PICTURE 999 USAGE COMP VALUE ZERO. NC2514.2 +011300 01 DIV-ENTRIES. NC2514.2 +011400 02 DIV11 PICTURE 999 VALUE 105. NC2514.2 +011500 02 DIV12 PICTURE 9999 VALUE 1000. NC2514.2 +011600 02 DIV13 PICTURE 999. NC2514.2 +011700 02 DIV14 PICTURE 99. NC2514.2 +011800 02 DIV15 PICTURE 9V9 VALUE 1.1. NC2514.2 +011900 02 DIV16 PICTURE 99V99 VALUE 89.10. NC2514.2 +012000 02 DIV17 PICTURE 99V99. NC2514.2 +012100 02 DIV18 PICTURE 9999. NC2514.2 +012200 02 DIV19 PICTURE 99 VALUE 14. NC2514.2 +012300 02 DIV20 PICTURE 9999 VALUE 2147. NC2514.2 +012400 02 DIV21 PICTURE 999. NC2514.2 +012500 02 DIV22 PICTURE 99. NC2514.2 +012600 01 WRK-DU-05V00-0001 PIC 9(5). NC2514.2 +012700 01 WRK-DS-05V00-0002 PIC S9(5). NC2514.2 +012800 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2514.2 +012900 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2514.2 +013000 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2514.2 +013100 01 NE-0008 PIC $9(4).99-. NC2514.2 +013200 01 NE-0009 PIC ***99. NC2514.2 +013300 01 NE-04V01-0006 PIC ****.9. NC2514.2 +013400 01 GRP-0010. NC2514.2 +013500 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2514.2 +013600 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2514.2 +013700 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2514.2 +013800 05 WRK-DS-03V04-O003F-0014 PIC S9(3)V9999 NC2514.2 +013900 OCCURS 3 TIMES. NC2514.2 +014000 01 DS-02V00-0001 PIC S99 VALUE 16. NC2514.2 +014100 01 DS-03V00-0002 PIC S999 VALUE 174. NC2514.2 +014200 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2514.2 +014300 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2514.2 +014400 01 MINUS-NAMES. NC2514.2 +014500 02 WHOLE-FIELD PICTURE S9(18). NC2514.2 +014600 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2514.2 +014700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2514.2 +014800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2514.2 +014900 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2514.2 +015000 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2514.2 +015100 01 TEST-RESULTS. NC2514.2 +015200 02 FILLER PIC X VALUE SPACE. NC2514.2 +015300 02 FEATURE PIC X(20) VALUE SPACE. NC2514.2 +015400 02 FILLER PIC X VALUE SPACE. NC2514.2 +015500 02 P-OR-F PIC X(5) VALUE SPACE. NC2514.2 +015600 02 FILLER PIC X VALUE SPACE. NC2514.2 +015700 02 PAR-NAME. NC2514.2 +015800 03 FILLER PIC X(19) VALUE SPACE. NC2514.2 +015900 03 PARDOT-X PIC X VALUE SPACE. NC2514.2 +016000 03 DOTVALUE PIC 99 VALUE ZERO. NC2514.2 +016100 02 FILLER PIC X(8) VALUE SPACE. NC2514.2 +016200 02 RE-MARK PIC X(61). NC2514.2 +016300 01 TEST-COMPUTED. NC2514.2 +016400 02 FILLER PIC X(30) VALUE SPACE. NC2514.2 +016500 02 FILLER PIC X(17) VALUE NC2514.2 +016600 " COMPUTED=". NC2514.2 +016700 02 COMPUTED-X. NC2514.2 +016800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2514.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A NC2514.2 +017000 PIC -9(9).9(9). NC2514.2 +017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2514.2 +017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2514.2 +017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2514.2 +017400 03 CM-18V0 REDEFINES COMPUTED-A. NC2514.2 +017500 04 COMPUTED-18V0 PIC -9(18). NC2514.2 +017600 04 FILLER PIC X. NC2514.2 +017700 03 FILLER PIC X(50) VALUE SPACE. NC2514.2 +017800 01 TEST-CORRECT. NC2514.2 +017900 02 FILLER PIC X(30) VALUE SPACE. NC2514.2 +018000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2514.2 +018100 02 CORRECT-X. NC2514.2 +018200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2514.2 +018300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2514.2 +018400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2514.2 +018500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2514.2 +018600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2514.2 +018700 03 CR-18V0 REDEFINES CORRECT-A. NC2514.2 +018800 04 CORRECT-18V0 PIC -9(18). NC2514.2 +018900 04 FILLER PIC X. NC2514.2 +019000 03 FILLER PIC X(2) VALUE SPACE. NC2514.2 +019100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2514.2 +019200 01 CCVS-C-1. NC2514.2 +019300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2514.2 +019400- "SS PARAGRAPH-NAME NC2514.2 +019500- " REMARKS". NC2514.2 +019600 02 FILLER PIC X(20) VALUE SPACE. NC2514.2 +019700 01 CCVS-C-2. NC2514.2 +019800 02 FILLER PIC X VALUE SPACE. NC2514.2 +019900 02 FILLER PIC X(6) VALUE "TESTED". NC2514.2 +020000 02 FILLER PIC X(15) VALUE SPACE. NC2514.2 +020100 02 FILLER PIC X(4) VALUE "FAIL". NC2514.2 +020200 02 FILLER PIC X(94) VALUE SPACE. NC2514.2 +020300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2514.2 +020400 01 REC-CT PIC 99 VALUE ZERO. NC2514.2 +020500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2514.2 +021000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2514.2 +021100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2514.2 +021200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2514.2 +021300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2514.2 +021400 01 CCVS-H-1. NC2514.2 +021500 02 FILLER PIC X(39) VALUE SPACES. NC2514.2 +021600 02 FILLER PIC X(42) VALUE NC2514.2 +021700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2514.2 +021800 02 FILLER PIC X(39) VALUE SPACES. NC2514.2 +021900 01 CCVS-H-2A. NC2514.2 +022000 02 FILLER PIC X(40) VALUE SPACE. NC2514.2 +022100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2514.2 +022200 02 FILLER PIC XXXX VALUE NC2514.2 +022300 "4.2 ". NC2514.2 +022400 02 FILLER PIC X(28) VALUE NC2514.2 +022500 " COPY - NOT FOR DISTRIBUTION". NC2514.2 +022600 02 FILLER PIC X(41) VALUE SPACE. NC2514.2 +022700 NC2514.2 +022800 01 CCVS-H-2B. NC2514.2 +022900 02 FILLER PIC X(15) VALUE NC2514.2 +023000 "TEST RESULT OF ". NC2514.2 +023100 02 TEST-ID PIC X(9). NC2514.2 +023200 02 FILLER PIC X(4) VALUE NC2514.2 +023300 " IN ". NC2514.2 +023400 02 FILLER PIC X(12) VALUE NC2514.2 +023500 " HIGH ". NC2514.2 +023600 02 FILLER PIC X(22) VALUE NC2514.2 +023700 " LEVEL VALIDATION FOR ". NC2514.2 +023800 02 FILLER PIC X(58) VALUE NC2514.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +024000 01 CCVS-H-3. NC2514.2 +024100 02 FILLER PIC X(34) VALUE NC2514.2 +024200 " FOR OFFICIAL USE ONLY ". NC2514.2 +024300 02 FILLER PIC X(58) VALUE NC2514.2 +024400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2514.2 +024500 02 FILLER PIC X(28) VALUE NC2514.2 +024600 " COPYRIGHT 1985 ". NC2514.2 +024700 01 CCVS-E-1. NC2514.2 +024800 02 FILLER PIC X(52) VALUE SPACE. NC2514.2 +024900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2514.2 +025000 02 ID-AGAIN PIC X(9). NC2514.2 +025100 02 FILLER PIC X(45) VALUE SPACES. NC2514.2 +025200 01 CCVS-E-2. NC2514.2 +025300 02 FILLER PIC X(31) VALUE SPACE. NC2514.2 +025400 02 FILLER PIC X(21) VALUE SPACE. NC2514.2 +025500 02 CCVS-E-2-2. NC2514.2 +025600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2514.2 +025700 03 FILLER PIC X VALUE SPACE. NC2514.2 +025800 03 ENDER-DESC PIC X(44) VALUE NC2514.2 +025900 "ERRORS ENCOUNTERED". NC2514.2 +026000 01 CCVS-E-3. NC2514.2 +026100 02 FILLER PIC X(22) VALUE NC2514.2 +026200 " FOR OFFICIAL USE ONLY". NC2514.2 +026300 02 FILLER PIC X(12) VALUE SPACE. NC2514.2 +026400 02 FILLER PIC X(58) VALUE NC2514.2 +026500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +026600 02 FILLER PIC X(13) VALUE SPACE. NC2514.2 +026700 02 FILLER PIC X(15) VALUE NC2514.2 +026800 " COPYRIGHT 1985". NC2514.2 +026900 01 CCVS-E-4. NC2514.2 +027000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2514.2 +027100 02 FILLER PIC X(4) VALUE " OF ". NC2514.2 +027200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2514.2 +027300 02 FILLER PIC X(40) VALUE NC2514.2 +027400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2514.2 +027500 01 XXINFO. NC2514.2 +027600 02 FILLER PIC X(19) VALUE NC2514.2 +027700 "*** INFORMATION ***". NC2514.2 +027800 02 INFO-TEXT. NC2514.2 +027900 04 FILLER PIC X(8) VALUE SPACE. NC2514.2 +028000 04 XXCOMPUTED PIC X(20). NC2514.2 +028100 04 FILLER PIC X(5) VALUE SPACE. NC2514.2 +028200 04 XXCORRECT PIC X(20). NC2514.2 +028300 02 INF-ANSI-REFERENCE PIC X(48). NC2514.2 +028400 01 HYPHEN-LINE. NC2514.2 +028500 02 FILLER PIC IS X VALUE IS SPACE. NC2514.2 +028600 02 FILLER PIC IS X(65) VALUE IS "************************NC2514.2 +028700- "*****************************************". NC2514.2 +028800 02 FILLER PIC IS X(54) VALUE IS "************************NC2514.2 +028900- "******************************". NC2514.2 +029000 01 CCVS-PGM-ID PIC X(9) VALUE NC2514.2 +029100 "NC251A". NC2514.2 +029200 PROCEDURE DIVISION. NC2514.2 +029300 CCVS1 SECTION. NC2514.2 +029400 OPEN-FILES. NC2514.2 +029500 OPEN OUTPUT PRINT-FILE. NC2514.2 +029600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2514.2 +029700 MOVE SPACE TO TEST-RESULTS. NC2514.2 +029800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2514.2 +029900 GO TO CCVS1-EXIT. NC2514.2 +030000 CLOSE-FILES. NC2514.2 +030100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2514.2 +030200 TERMINATE-CCVS. NC2514.2 +030300S EXIT PROGRAM. NC2514.2 +030400STERMINATE-CALL. NC2514.2 +030500 STOP RUN. NC2514.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2514.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2514.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2514.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2514.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. NC2514.2 +031100 PRINT-DETAIL. NC2514.2 +031200 IF REC-CT NOT EQUAL TO ZERO NC2514.2 +031300 MOVE "." TO PARDOT-X NC2514.2 +031400 MOVE REC-CT TO DOTVALUE. NC2514.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2514.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2514.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2514.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2514.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2514.2 +032000 MOVE SPACE TO CORRECT-X. NC2514.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2514.2 +032200 MOVE SPACE TO RE-MARK. NC2514.2 +032300 HEAD-ROUTINE. NC2514.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +032500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +032600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2514.2 +032700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2514.2 +032800 COLUMN-NAMES-ROUTINE. NC2514.2 +032900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +033000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +033200 END-ROUTINE. NC2514.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2514.2 +033400 END-RTN-EXIT. NC2514.2 +033500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +033600 END-ROUTINE-1. NC2514.2 +033700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2514.2 +033800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2514.2 +033900 ADD PASS-COUNTER TO ERROR-HOLD. NC2514.2 +034000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2514.2 +034100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2514.2 +034200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2514.2 +034300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2514.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2514.2 +034500 END-ROUTINE-12. NC2514.2 +034600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2514.2 +034700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2514.2 +034800 MOVE "NO " TO ERROR-TOTAL NC2514.2 +034900 ELSE NC2514.2 +035000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2514.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2514.2 +035200 PERFORM WRITE-LINE. NC2514.2 +035300 END-ROUTINE-13. NC2514.2 +035400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2514.2 +035500 MOVE "NO " TO ERROR-TOTAL ELSE NC2514.2 +035600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2514.2 +035700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2514.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +035900 IF INSPECT-COUNTER EQUAL TO ZERO NC2514.2 +036000 MOVE "NO " TO ERROR-TOTAL NC2514.2 +036100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2514.2 +036200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2514.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +036400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +036500 WRITE-LINE. NC2514.2 +036600 ADD 1 TO RECORD-COUNT. NC2514.2 +036700Y IF RECORD-COUNT GREATER 50 NC2514.2 +036800Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2514.2 +036900Y MOVE SPACE TO DUMMY-RECORD NC2514.2 +037000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2514.2 +037100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2514.2 +037200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2514.2 +037300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2514.2 +037400Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2514.2 +037500Y MOVE ZERO TO RECORD-COUNT. NC2514.2 +037600 PERFORM WRT-LN. NC2514.2 +037700 WRT-LN. NC2514.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2514.2 +037900 MOVE SPACE TO DUMMY-RECORD. NC2514.2 +038000 BLANK-LINE-PRINT. NC2514.2 +038100 PERFORM WRT-LN. NC2514.2 +038200 FAIL-ROUTINE. NC2514.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2514.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2514.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2514.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2514.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2514.2 +038900 GO TO FAIL-ROUTINE-EX. NC2514.2 +039000 FAIL-ROUTINE-WRITE. NC2514.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2514.2 +039200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2514.2 +039300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2514.2 +039400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2514.2 +039500 FAIL-ROUTINE-EX. EXIT. NC2514.2 +039600 BAIL-OUT. NC2514.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2514.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2514.2 +039900 BAIL-OUT-WRITE. NC2514.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2514.2 +040100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2514.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2514.2 +040400 BAIL-OUT-EX. EXIT. NC2514.2 +040500 CCVS1-EXIT. NC2514.2 +040600 EXIT. NC2514.2 +040700 SECT-NC251A-001 SECTION. NC2514.2 +040800 DIV-TEST-4. NC2514.2 +040900 DIVIDE DIV16 BY DIV15 GIVING DIV17 REMAINDER DIV18. NC2514.2 +041000 IF DIV18 IS EQUAL TO ZERO NC2514.2 +041100 PERFORM PASS NC2514.2 +041200 GO TO DIV-WRITE-4. NC2514.2 +041300 PERFORM FAIL. NC2514.2 +041400 MOVE DIV18 TO COMPUTED-N. NC2514.2 +041500 MOVE "0000" TO CORRECT-A. NC2514.2 +041600 GO TO DIV-WRITE-4. NC2514.2 +041700 DIV-DELETE-4. NC2514.2 +041800 PERFORM DE-LETE. NC2514.2 +041900 DIV-WRITE-4. NC2514.2 +042000 MOVE "DIV-TEST-4" TO PAR-NAME. NC2514.2 +042100 PERFORM PRINT-DETAIL. NC2514.2 +042200 DIV-TEST-5. NC2514.2 +042300 MOVE ZERO TO DIV21. NC2514.2 +042400 MOVE ZERO TO DIV22. NC2514.2 +042500 DIVIDE DIV20 BY DIV19 GIVING DIV21 ROUNDED REMAINDER NC2514.2 +042600 DIV22. NC2514.2 +042700 IF DIV22 IS EQUAL TO 05 NC2514.2 +042800 PERFORM PASS NC2514.2 +042900 GO TO DIV-WRITE-5. NC2514.2 +043000 PERFORM FAIL. NC2514.2 +043100 MOVE DIV22 TO COMPUTED-N. NC2514.2 +043200 MOVE "+05" TO CORRECT-A. NC2514.2 +043300 GO TO DIV-WRITE-5. NC2514.2 +043400 DIV-DELETE-5. NC2514.2 +043500 PERFORM DE-LETE. NC2514.2 +043600 DIV-WRITE-5. NC2514.2 +043700 MOVE "DIV-TEST-5" TO PAR-NAME. NC2514.2 +043800 PERFORM PRINT-DETAIL. NC2514.2 +043900* NC2514.2 +044000 DIV-INIT-F5-3. NC2514.2 +044100 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +044200 MOVE "DIV-TEST-F5-3-0" TO PAR-NAME. NC2514.2 +044300 MOVE 40 TO 25COUNT. NC2514.2 +044400 MOVE ZERO TO 25ANS. NC2514.2 +044500 MOVE ZERO TO 25REM. NC2514.2 +044600 MOVE 1 TO REC-CT. NC2514.2 +044700 DIV-TEST-F5-3-0. NC2514.2 +044800 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +044900 ON SIZE ERROR NC2514.2 +045000 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +045100 TO RE-MARK NC2514.2 +045200 PERFORM FAIL NC2514.2 +045300 PERFORM PRINT-DETAIL NC2514.2 +045400 GO TO DIV-TEST-F5-3-1. NC2514.2 +045500 PERFORM PASS. NC2514.2 +045600 PERFORM PRINT-DETAIL. NC2514.2 +045700 GO TO DIV-TEST-F5-3-1. NC2514.2 +045800 DIV-DELETE-F5-3. NC2514.2 +045900 PERFORM DE-LETE. NC2514.2 +046000 PERFORM PRINT-DETAIL. NC2514.2 +046100 GO TO DIV-INIT-F5-4. NC2514.2 +046200 DIV-TEST-F5-3-1. NC2514.2 +046300 MOVE "DIV-TEST-F5-3-1" TO PAR-NAME. NC2514.2 +046400 ADD 1 TO REC-CT. NC2514.2 +046500 IF 25ANS NOT = 2 NC2514.2 +046600 MOVE 2 TO CORRECT-N NC2514.2 +046700 MOVE 25ANS TO COMPUTED-N NC2514.2 +046800 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +046900 PERFORM FAIL NC2514.2 +047000 PERFORM PRINT-DETAIL NC2514.2 +047100 ELSE NC2514.2 +047200 PERFORM PASS NC2514.2 +047300 PERFORM PRINT-DETAIL. NC2514.2 +047400 DIV-TEST-F5-3-2. NC2514.2 +047500 MOVE "DIV-TEST-F5-3-2" TO PAR-NAME. NC2514.2 +047600 ADD 1 TO REC-CT. NC2514.2 +047700 IF 25REM NOT = 20 NC2514.2 +047800 MOVE 25REM TO COMPUTED-N NC2514.2 +047900 MOVE 20 TO CORRECT-N NC2514.2 +048000 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +048100 PERFORM FAIL NC2514.2 +048200 PERFORM PRINT-DETAIL NC2514.2 +048300 ELSE NC2514.2 +048400 PERFORM PASS NC2514.2 +048500 PERFORM PRINT-DETAIL. NC2514.2 +048600* NC2514.2 +048700 DIV-INIT-F5-4. NC2514.2 +048800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +048900 MOVE "DIV-TEST-F5-4-0" TO PAR-NAME. NC2514.2 +049000 MOVE ZERO TO 25COUNT. NC2514.2 +049100 MOVE ZERO TO 25ANS. NC2514.2 +049200 MOVE ZERO TO 25REM. NC2514.2 +049300 MOVE 1 TO REC-CT. NC2514.2 +049400 DIV-TEST-F5-4-0. NC2514.2 +049500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +049600 ON SIZE ERROR NC2514.2 +049700 PERFORM PASS NC2514.2 +049800 PERFORM PRINT-DETAIL NC2514.2 +049900 GO TO DIV-TEST-F5-4-1. NC2514.2 +050000 MOVE "ON SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK. NC2514.2 +050100 PERFORM FAIL. NC2514.2 +050200 PERFORM PRINT-DETAIL. NC2514.2 +050300 GO TO DIV-TEST-F5-4-1. NC2514.2 +050400 DIV-DELETE-F5-4. NC2514.2 +050500 PERFORM DE-LETE. NC2514.2 +050600 PERFORM PRINT-DETAIL. NC2514.2 +050700 GO TO DIV-INIT-F5-5. NC2514.2 +050800 DIV-TEST-F5-4-1. NC2514.2 +050900 MOVE "DIV-TEST-F5-4-1" TO PAR-NAME. NC2514.2 +051000 ADD 1 TO REC-CT. NC2514.2 +051100 IF 25ANS NOT = 0 NC2514.2 +051200 MOVE 0 TO CORRECT-N NC2514.2 +051300 MOVE 25ANS TO COMPUTED-N NC2514.2 +051400 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +051500 PERFORM FAIL NC2514.2 +051600 PERFORM PRINT-DETAIL NC2514.2 +051700 ELSE NC2514.2 +051800 PERFORM PASS NC2514.2 +051900 PERFORM PRINT-DETAIL. NC2514.2 +052000 DIV-TEST-F5-4-2. NC2514.2 +052100 MOVE "DIV-TEST-F5-4-2" TO PAR-NAME. NC2514.2 +052200 ADD 1 TO REC-CT. NC2514.2 +052300 IF 25REM NOT = ZERO NC2514.2 +052400 MOVE 25REM TO COMPUTED-N NC2514.2 +052500 MOVE ZERO TO CORRECT-N NC2514.2 +052600 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +052700 PERFORM FAIL NC2514.2 +052800 PERFORM PRINT-DETAIL NC2514.2 +052900 ELSE NC2514.2 +053000 PERFORM PASS NC2514.2 +053100 PERFORM PRINT-DETAIL. NC2514.2 +053200* NC2514.2 +053300 DIV-INIT-F5-5. NC2514.2 +053400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +053500 MOVE "DIV-TEST-F5-5-0" TO PAR-NAME. NC2514.2 +053600 MOVE 3 TO 25COUNT. NC2514.2 +053700 MOVE ZERO TO 25ANS. NC2514.2 +053800 MOVE ZERO TO 25REM. NC2514.2 +053900 MOVE 1 TO REC-CT. NC2514.2 +054000 DIV-TEST-F5-5-0. NC2514.2 +054100 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +054200 ON SIZE ERROR NC2514.2 +054300 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +054400 TO RE-MARK NC2514.2 +054500 PERFORM FAIL NC2514.2 +054600 PERFORM PRINT-DETAIL NC2514.2 +054700 GO TO DIV-TEST-F5-5-1. NC2514.2 +054800 PERFORM PASS. NC2514.2 +054900 PERFORM PRINT-DETAIL. NC2514.2 +055000 GO TO DIV-TEST-F5-5-1. NC2514.2 +055100 DIV-DELETE-F5-5. NC2514.2 +055200 PERFORM DE-LETE. NC2514.2 +055300 PERFORM PRINT-DETAIL. NC2514.2 +055400 GO TO DIV-TEST-12. NC2514.2 +055500 DIV-TEST-F5-5-1. NC2514.2 +055600 MOVE "DIV-TEST-F5-5-1" TO PAR-NAME. NC2514.2 +055700 ADD 1 TO REC-CT. NC2514.2 +055800 IF 25ANS NOT = 33 NC2514.2 +055900 MOVE 33 TO CORRECT-N NC2514.2 +056000 MOVE 25ANS TO COMPUTED-N NC2514.2 +056100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +056200 PERFORM FAIL NC2514.2 +056300 PERFORM PRINT-DETAIL NC2514.2 +056400 ELSE NC2514.2 +056500 PERFORM PASS NC2514.2 +056600 PERFORM PRINT-DETAIL. NC2514.2 +056700 DIV-TEST-F5-5-2. NC2514.2 +056800 MOVE "DIV-TEST-F5-5-2" TO PAR-NAME. NC2514.2 +056900 ADD 1 TO REC-CT. NC2514.2 +057000 IF 25REM NOT = 1 NC2514.2 +057100 MOVE 25REM TO COMPUTED-N NC2514.2 +057200 MOVE 1 TO CORRECT-N NC2514.2 +057300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +057400 PERFORM FAIL NC2514.2 +057500 PERFORM PRINT-DETAIL NC2514.2 +057600 ELSE NC2514.2 +057700 PERFORM PASS NC2514.2 +057800 PERFORM PRINT-DETAIL. NC2514.2 +057900* NC2514.2 +058000 DIV-TEST-12. NC2514.2 +058100 DIVIDE 230 BY DIV-30-Y2 GIVING DIV-Z2-30 REMAINDER NC2514.2 +058200 DIV-30-A2. NC2514.2 +058300 IF DIV-Z2-30 EQUAL TO 4 AND DIV-30-A2 EQUAL TO 14 NC2514.2 +058400 PERFORM PASS NC2514.2 +058500 GO TO DIV-WRITE-12. NC2514.2 +058600 PERFORM FAIL. NC2514.2 +058700 MOVE 4 TO CORRECT-N. NC2514.2 +058800 MOVE DIV-30-A3 TO COMPUTED-N. NC2514.2 +058900 GO TO DIV-WRITE-12. NC2514.2 +059000 DIV-DELETE-12. NC2514.2 +059100 PERFORM DE-LETE. NC2514.2 +059200 DIV-WRITE-12. NC2514.2 +059300 MOVE "DIV-TEST-12" TO PAR-NAME. NC2514.2 +059400 PERFORM PRINT-DETAIL. NC2514.2 +059500* NC2514.2 +059600 DIV-INIT-F5-7. NC2514.2 +059700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +059800 MOVE "DIV-TEST-F5-7-0" TO PAR-NAME. NC2514.2 +059900 MOVE 151 TO DIV-30-Y3. NC2514.2 +060000 MOVE ZERO TO DIV-Z3-30. NC2514.2 +060100 MOVE ZERO TO DIV-30-A3. NC2514.2 +060200 MOVE 1 TO REC-CT. NC2514.2 +060300 DIV-TEST-F5-7-0. NC2514.2 +060400 DIVIDE 681 BY DIV-30-Y3 GIVING DIV-Z3-30 REMAINDER NC2514.2 +060500 DIV-30-A3. NC2514.2 +060600 GO TO DIV-TEST-F5-7-1. NC2514.2 +060700 DIV-DELETE-F5-7. NC2514.2 +060800 PERFORM DE-LETE. NC2514.2 +060900 PERFORM PRINT-DETAIL. NC2514.2 +061000 GO TO DIV-INIT-F5-8. NC2514.2 +061100 DIV-TEST-F5-7-1. NC2514.2 +061200 MOVE "DIV-TEST-F5-7-1" TO PAR-NAME. NC2514.2 +061300 ADD 1 TO REC-CT. NC2514.2 +061400 IF DIV-Z3-30 NOT EQUAL TO 4 NC2514.2 +061500 MOVE 4 TO CORRECT-N NC2514.2 +061600 MOVE DIV-Z3-30 TO COMPUTED-N NC2514.2 +061700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +061800 PERFORM FAIL NC2514.2 +061900 PERFORM PRINT-DETAIL NC2514.2 +062000 ELSE NC2514.2 +062100 PERFORM PASS NC2514.2 +062200 PERFORM PRINT-DETAIL. NC2514.2 +062300 DIV-TEST-F5-7-2. NC2514.2 +062400 MOVE "DIV-TEST-F5-7-2" TO PAR-NAME. NC2514.2 +062500 ADD 1 TO REC-CT. NC2514.2 +062600 IF DIV-30-A3 NOT EQUAL TO 77 NC2514.2 +062700 MOVE DIV-30-A3 TO COMPUTED-N NC2514.2 +062800 MOVE 77 TO CORRECT-N NC2514.2 +062900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +063000 PERFORM FAIL NC2514.2 +063100 PERFORM PRINT-DETAIL NC2514.2 +063200 ELSE NC2514.2 +063300 PERFORM PASS NC2514.2 +063400 PERFORM PRINT-DETAIL. NC2514.2 +063500* NC2514.2 +063600 DIV-INIT-F5-8. NC2514.2 +063700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +063800 MOVE "DIV-TEST-F5-8-0" TO PAR-NAME. NC2514.2 +063900 MOVE 1010 TO DIV-30-Y4. NC2514.2 +064000 MOVE ZERO TO DIV-Z4-30. NC2514.2 +064100 MOVE ZERO TO DIV-30-A4. NC2514.2 +064200 MOVE 1 TO REC-CT. NC2514.2 +064300 DIV-TEST-F5-8-0. NC2514.2 +064400 DIVIDE 4150 BY DIV-30-Y4 GIVING DIV-Z4-30 REMAINDER NC2514.2 +064500 DIV-30-A4. NC2514.2 +064600 GO TO DIV-TEST-F5-8-1. NC2514.2 +064700 DIV-DELETE-F5-8. NC2514.2 +064800 PERFORM DE-LETE. NC2514.2 +064900 PERFORM PRINT-DETAIL. NC2514.2 +065000 GO TO DIV-INIT-F5-9. NC2514.2 +065100 DIV-TEST-F5-8-1. NC2514.2 +065200 MOVE "DIV-TEST-F5-8-1" TO PAR-NAME. NC2514.2 +065300 ADD 1 TO REC-CT. NC2514.2 +065400 IF DIV-Z4-30 NOT EQUAL TO 4 NC2514.2 +065500 MOVE 4 TO CORRECT-N NC2514.2 +065600 MOVE DIV-Z4-30 TO COMPUTED-N NC2514.2 +065700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +065800 PERFORM FAIL NC2514.2 +065900 PERFORM PRINT-DETAIL NC2514.2 +066000 ELSE NC2514.2 +066100 PERFORM PASS NC2514.2 +066200 PERFORM PRINT-DETAIL. NC2514.2 +066300 DIV-TEST-F5-8-2. NC2514.2 +066400 MOVE "DIV-TEST-F5-8-2" TO PAR-NAME. NC2514.2 +066500 ADD 1 TO REC-CT. NC2514.2 +066600 IF DIV-30-A4 NOT EQUAL TO 110 NC2514.2 +066700 MOVE DIV-30-A4 TO COMPUTED-N NC2514.2 +066800 MOVE 110 TO CORRECT-N NC2514.2 +066900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +067000 PERFORM FAIL NC2514.2 +067100 PERFORM PRINT-DETAIL NC2514.2 +067200 ELSE NC2514.2 +067300 PERFORM PASS NC2514.2 +067400 PERFORM PRINT-DETAIL. NC2514.2 +067500* NC2514.2 +067600* NC2514.2 +067700 DIV-INIT-F5-9. NC2514.2 +067800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +067900 MOVE "DIV-TEST-F5-9-0" TO PAR-NAME. NC2514.2 +068000 MOVE 31 TO DIV-30-Y1. NC2514.2 +068100 MOVE ZERO TO DIV-Z1-30. NC2514.2 +068200 MOVE ZERO TO DIV-30-A1. NC2514.2 +068300 MOVE 1 TO REC-CT. NC2514.2 +068400 DIV-TEST-F5-9-0. NC2514.2 +068500 DIVIDE 150 BY DIV-30-Y1 GIVING DIV-Z1-30 REMAINDER DIV-30-A1.NC2514.2 +068600 GO TO DIV-TEST-F5-9-1. NC2514.2 +068700 DIV-DELETE-F5-9. NC2514.2 +068800 PERFORM DE-LETE. NC2514.2 +068900 PERFORM PRINT-DETAIL. NC2514.2 +069000 GO TO DIV-INIT-F5-10. NC2514.2 +069100 DIV-TEST-F5-9-1. NC2514.2 +069200 MOVE "DIV-TEST-F5-9-1" TO PAR-NAME. NC2514.2 +069300 ADD 1 TO REC-CT. NC2514.2 +069400 IF DIV-Z1-30 NOT EQUAL TO 4 NC2514.2 +069500 MOVE 4 TO CORRECT-N NC2514.2 +069600 MOVE DIV-Z1-30 TO COMPUTED-N NC2514.2 +069700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +069800 PERFORM FAIL NC2514.2 +069900 PERFORM PRINT-DETAIL NC2514.2 +070000 ELSE NC2514.2 +070100 PERFORM PASS NC2514.2 +070200 PERFORM PRINT-DETAIL. NC2514.2 +070300 DIV-TEST-F5-9-2. NC2514.2 +070400 MOVE "DIV-TEST-F5-9-2" TO PAR-NAME. NC2514.2 +070500 ADD 1 TO REC-CT. NC2514.2 +070600 IF DIV-30-A1 NOT EQUAL TO 26 NC2514.2 +070700 MOVE DIV-30-A4 TO COMPUTED-N NC2514.2 +070800 MOVE 26 TO CORRECT-N NC2514.2 +070900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +071000 PERFORM FAIL NC2514.2 +071100 PERFORM PRINT-DETAIL NC2514.2 +071200 ELSE NC2514.2 +071300 PERFORM PASS NC2514.2 +071400 PERFORM PRINT-DETAIL. NC2514.2 +071500* NC2514.2 +071600 DIV-INIT-F5-10. NC2514.2 +071700 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +071800 MOVE "DIV-TEST-F5-10-0" TO PAR-NAME. NC2514.2 +071900 MOVE 40 TO 25COUNT. NC2514.2 +072000 MOVE ZERO TO 25ANS. NC2514.2 +072100 MOVE ZERO TO 25REM. NC2514.2 +072200 MOVE 1 TO REC-CT. NC2514.2 +072300 DIV-TEST-F5-10-0. NC2514.2 +072400 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +072500 NOT ON SIZE ERROR NC2514.2 +072600 PERFORM PASS NC2514.2 +072700 PERFORM PRINT-DETAIL NC2514.2 +072800 GO TO DIV-TEST-F5-10-1. NC2514.2 +072900 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC2514.2 +073000 PERFORM FAIL. NC2514.2 +073100 PERFORM PRINT-DETAIL. NC2514.2 +073200 GO TO DIV-TEST-F5-10-1. NC2514.2 +073300 DIV-DELETE-F5-10. NC2514.2 +073400 PERFORM DE-LETE. NC2514.2 +073500 PERFORM PRINT-DETAIL. NC2514.2 +073600 GO TO DIV-INIT-F5-11. NC2514.2 +073700 DIV-TEST-F5-10-1. NC2514.2 +073800 MOVE "DIV-TEST-F5-10-1" TO PAR-NAME. NC2514.2 +073900 ADD 1 TO REC-CT. NC2514.2 +074000 IF 25ANS NOT = 2 NC2514.2 +074100 MOVE 2 TO CORRECT-N NC2514.2 +074200 MOVE 25ANS TO COMPUTED-N NC2514.2 +074300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +074400 PERFORM FAIL NC2514.2 +074500 PERFORM PRINT-DETAIL NC2514.2 +074600 ELSE NC2514.2 +074700 PERFORM PASS NC2514.2 +074800 PERFORM PRINT-DETAIL. NC2514.2 +074900 DIV-TEST-F5-10-2. NC2514.2 +075000 MOVE "DIV-TEST-F5-10-2" TO PAR-NAME. NC2514.2 +075100 ADD 1 TO REC-CT. NC2514.2 +075200 IF 25REM NOT = 20 NC2514.2 +075300 MOVE 25REM TO COMPUTED-N NC2514.2 +075400 MOVE 20 TO CORRECT-N NC2514.2 +075500 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +075600 PERFORM FAIL NC2514.2 +075700 PERFORM PRINT-DETAIL NC2514.2 +075800 ELSE NC2514.2 +075900 PERFORM PASS NC2514.2 +076000 PERFORM PRINT-DETAIL. NC2514.2 +076100* NC2514.2 +076200 DIV-INIT-F5-11. NC2514.2 +076300 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +076400 MOVE "DIV-TEST-F5-11-0" TO PAR-NAME. NC2514.2 +076500 MOVE ZERO TO 25COUNT. NC2514.2 +076600 MOVE ZERO TO 25ANS. NC2514.2 +076700 MOVE ZERO TO 25REM. NC2514.2 +076800 MOVE 1 TO REC-CT. NC2514.2 +076900 DIV-TEST-F5-11-0. NC2514.2 +077000 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +077100 NOT ON SIZE ERROR NC2514.2 +077200 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +077300 TO RE-MARK NC2514.2 +077400 PERFORM FAIL NC2514.2 +077500 PERFORM PRINT-DETAIL NC2514.2 +077600 GO TO DIV-TEST-F5-11-1. NC2514.2 +077700 PERFORM PASS. NC2514.2 +077800 PERFORM PRINT-DETAIL. NC2514.2 +077900 GO TO DIV-TEST-F5-11-1. NC2514.2 +078000 DIV-DELETE-F5-11. NC2514.2 +078100 PERFORM DE-LETE. NC2514.2 +078200 PERFORM PRINT-DETAIL. NC2514.2 +078300 GO TO DIV-INIT-F5-12. NC2514.2 +078400 DIV-TEST-F5-11-1. NC2514.2 +078500 MOVE "DIV-TEST-F5-11-1" TO PAR-NAME. NC2514.2 +078600 ADD 1 TO REC-CT. NC2514.2 +078700 IF 25ANS NOT = 0 NC2514.2 +078800 MOVE 0 TO CORRECT-N NC2514.2 +078900 MOVE 25ANS TO COMPUTED-N NC2514.2 +079000 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +079100 PERFORM FAIL NC2514.2 +079200 PERFORM PRINT-DETAIL NC2514.2 +079300 ELSE NC2514.2 +079400 PERFORM PASS NC2514.2 +079500 PERFORM PRINT-DETAIL. NC2514.2 +079600 DIV-TEST-F5-11-2. NC2514.2 +079700 MOVE "DIV-TEST-F5-11-2" TO PAR-NAME. NC2514.2 +079800 ADD 1 TO REC-CT. NC2514.2 +079900 IF 25REM NOT = ZERO NC2514.2 +080000 MOVE 25REM TO COMPUTED-N NC2514.2 +080100 MOVE ZERO TO CORRECT-N NC2514.2 +080200 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +080300 PERFORM FAIL NC2514.2 +080400 PERFORM PRINT-DETAIL NC2514.2 +080500 ELSE NC2514.2 +080600 PERFORM PASS NC2514.2 +080700 PERFORM PRINT-DETAIL. NC2514.2 +080800* NC2514.2 +080900 DIV-INIT-F5-12. NC2514.2 +081000 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +081100 MOVE "DIV-TEST-F5-12-0" TO PAR-NAME. NC2514.2 +081200 MOVE 40 TO 25COUNT. NC2514.2 +081300 MOVE ZERO TO 25ANS. NC2514.2 +081400 MOVE ZERO TO 25REM. NC2514.2 +081500 MOVE 1 TO REC-CT. NC2514.2 +081600 DIV-TEST-F5-12-0. NC2514.2 +081700 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +081800 ON SIZE ERROR NC2514.2 +081900 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +082000 TO RE-MARK NC2514.2 +082100 PERFORM FAIL NC2514.2 +082200 PERFORM PRINT-DETAIL NC2514.2 +082300 GO TO DIV-TEST-F5-12-1 NC2514.2 +082400 NOT ON SIZE ERROR NC2514.2 +082500 PERFORM PASS NC2514.2 +082600 PERFORM PRINT-DETAIL NC2514.2 +082700 GO TO DIV-TEST-F5-12-1. NC2514.2 +082800 DIV-DELETE-F5-12. NC2514.2 +082900 PERFORM DE-LETE. NC2514.2 +083000 PERFORM PRINT-DETAIL. NC2514.2 +083100 GO TO DIV-INIT-F5-13. NC2514.2 +083200 DIV-TEST-F5-12-1. NC2514.2 +083300 MOVE "DIV-TEST-F5-12-1" TO PAR-NAME. NC2514.2 +083400 ADD 1 TO REC-CT. NC2514.2 +083500 IF 25ANS NOT = 2 NC2514.2 +083600 MOVE 2 TO CORRECT-N NC2514.2 +083700 MOVE 25ANS TO COMPUTED-N NC2514.2 +083800 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +083900 PERFORM FAIL NC2514.2 +084000 PERFORM PRINT-DETAIL NC2514.2 +084100 ELSE NC2514.2 +084200 PERFORM PASS NC2514.2 +084300 PERFORM PRINT-DETAIL. NC2514.2 +084400 DIV-TEST-F5-12-2. NC2514.2 +084500 MOVE "DIV-TEST-F5-12-2" TO PAR-NAME. NC2514.2 +084600 ADD 1 TO REC-CT. NC2514.2 +084700 IF 25REM NOT = 20 NC2514.2 +084800 MOVE 25REM TO COMPUTED-N NC2514.2 +084900 MOVE 20 TO CORRECT-N NC2514.2 +085000 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +085100 PERFORM FAIL NC2514.2 +085200 PERFORM PRINT-DETAIL NC2514.2 +085300 ELSE NC2514.2 +085400 PERFORM PASS NC2514.2 +085500 PERFORM PRINT-DETAIL. NC2514.2 +085600* NC2514.2 +085700 DIV-INIT-F5-13. NC2514.2 +085800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +085900 MOVE "DIV-TEST-F5-13-0" TO PAR-NAME. NC2514.2 +086000 MOVE ZERO TO 25COUNT. NC2514.2 +086100 MOVE ZERO TO 25ANS. NC2514.2 +086200 MOVE ZERO TO 25REM. NC2514.2 +086300 MOVE 1 TO REC-CT. NC2514.2 +086400 DIV-TEST-F5-13-0. NC2514.2 +086500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +086600 ON SIZE ERROR NC2514.2 +086700 PERFORM PASS NC2514.2 +086800 PERFORM PRINT-DETAIL NC2514.2 +086900 GO TO DIV-TEST-F5-13-1 NC2514.2 +087000 NOT ON SIZE ERROR NC2514.2 +087100 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +087200 TO RE-MARK NC2514.2 +087300 PERFORM FAIL NC2514.2 +087400 PERFORM PRINT-DETAIL NC2514.2 +087500 GO TO DIV-TEST-F5-13-1. NC2514.2 +087600 DIV-DELETE-F5-13. NC2514.2 +087700 PERFORM DE-LETE. NC2514.2 +087800 PERFORM PRINT-DETAIL. NC2514.2 +087900 GO TO DIV-INIT-F5-14. NC2514.2 +088000 DIV-TEST-F5-13-1. NC2514.2 +088100 MOVE "DIV-TEST-F5-13-1" TO PAR-NAME. NC2514.2 +088200 ADD 1 TO REC-CT. NC2514.2 +088300 IF 25ANS NOT = 0 NC2514.2 +088400 MOVE 0 TO CORRECT-N NC2514.2 +088500 MOVE 25ANS TO COMPUTED-N NC2514.2 +088600 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +088700 PERFORM FAIL NC2514.2 +088800 PERFORM PRINT-DETAIL NC2514.2 +088900 ELSE NC2514.2 +089000 PERFORM PASS NC2514.2 +089100 PERFORM PRINT-DETAIL. NC2514.2 +089200 DIV-TEST-F5-13-2. NC2514.2 +089300 MOVE "DIV-TEST-F5-13-2" TO PAR-NAME. NC2514.2 +089400 ADD 1 TO REC-CT. NC2514.2 +089500 IF 25REM NOT = ZERO NC2514.2 +089600 MOVE 25REM TO COMPUTED-N NC2514.2 +089700 MOVE ZERO TO CORRECT-N NC2514.2 +089800 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +089900 PERFORM FAIL NC2514.2 +090000 PERFORM PRINT-DETAIL NC2514.2 +090100 ELSE NC2514.2 +090200 PERFORM PASS NC2514.2 +090300 PERFORM PRINT-DETAIL. NC2514.2 +090400* NC2514.2 +090500 DIV-INIT-F5-14. NC2514.2 +090600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +090700 MOVE "DIV-TEST-F5-14-0" TO PAR-NAME. NC2514.2 +090800 MOVE 40 TO 25COUNT. NC2514.2 +090900 MOVE ZERO TO 25ANS. NC2514.2 +091000 MOVE ZERO TO 25REM. NC2514.2 +091100 MOVE 1 TO REC-CT. NC2514.2 +091200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +091300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +091400 DIV-TEST-F5-14-0. NC2514.2 +091500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +091600 ON SIZE ERROR NC2514.2 +091700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +091800 END-DIVIDE NC2514.2 +091900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +092000 GO TO DIV-TEST-F5-14-1. NC2514.2 +092100 DIV-DELETE-F5-14. NC2514.2 +092200 PERFORM DE-LETE. NC2514.2 +092300 PERFORM PRINT-DETAIL. NC2514.2 +092400 GO TO DIV-INIT-F5-15. NC2514.2 +092500 DIV-TEST-F5-14-1. NC2514.2 +092600 MOVE "DIV-TEST-F5-14-1" TO PAR-NAME. NC2514.2 +092700 ADD 1 TO REC-CT. NC2514.2 +092800 IF 25ANS NOT = 2 NC2514.2 +092900 MOVE 2 TO CORRECT-N NC2514.2 +093000 MOVE 25ANS TO COMPUTED-N NC2514.2 +093100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +093200 PERFORM FAIL NC2514.2 +093300 PERFORM PRINT-DETAIL NC2514.2 +093400 ELSE NC2514.2 +093500 PERFORM PASS NC2514.2 +093600 PERFORM PRINT-DETAIL. NC2514.2 +093700 DIV-TEST-F5-14-2. NC2514.2 +093800 MOVE "DIV-TEST-F5-14-2" TO PAR-NAME. NC2514.2 +093900 ADD 1 TO REC-CT. NC2514.2 +094000 IF 25REM NOT = 20 NC2514.2 +094100 MOVE 25REM TO COMPUTED-N NC2514.2 +094200 MOVE 20 TO CORRECT-N NC2514.2 +094300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +094400 PERFORM FAIL NC2514.2 +094500 PERFORM PRINT-DETAIL NC2514.2 +094600 ELSE NC2514.2 +094700 PERFORM PASS NC2514.2 +094800 PERFORM PRINT-DETAIL. NC2514.2 +094900 DIV-TEST-F5-14-3. NC2514.2 +095000 MOVE "DIV-TEST-F5-14-3" TO PAR-NAME. NC2514.2 +095100 ADD 1 TO REC-CT. NC2514.2 +095200 IF WRK-XN-00001-1 = SPACE NC2514.2 +095300 PERFORM PASS NC2514.2 +095400 PERFORM PRINT-DETAIL NC2514.2 +095500 ELSE NC2514.2 +095600 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +095700 TO RE-MARK NC2514.2 +095800 MOVE SPACE TO CORRECT-A NC2514.2 +095900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +096000 PERFORM FAIL NC2514.2 +096100 PERFORM PRINT-DETAIL. NC2514.2 +096200 DIV-TEST-F5-14-4. NC2514.2 +096300 MOVE "DIV-TEST-F5-14-4" TO PAR-NAME. NC2514.2 +096400 ADD 1 TO REC-CT. NC2514.2 +096500 IF WRK-XN-00001-2 = "B" NC2514.2 +096600 PERFORM PASS NC2514.2 +096700 PERFORM PRINT-DETAIL NC2514.2 +096800 ELSE NC2514.2 +096900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +097000 MOVE "B" TO CORRECT-A NC2514.2 +097100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +097200 PERFORM FAIL NC2514.2 +097300 PERFORM PRINT-DETAIL. NC2514.2 +097400* NC2514.2 +097500 DIV-INIT-F5-15. NC2514.2 +097600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +097700 MOVE "DIV-TEST-F5-15-0" TO PAR-NAME. NC2514.2 +097800 MOVE ZERO TO 25COUNT. NC2514.2 +097900 MOVE ZERO TO 25ANS. NC2514.2 +098000 MOVE ZERO TO 25REM. NC2514.2 +098100 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +098200 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +098300 MOVE 1 TO REC-CT. NC2514.2 +098400 DIV-TEST-F5-15-0. NC2514.2 +098500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +098600 ON SIZE ERROR NC2514.2 +098700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +098800 END-DIVIDE NC2514.2 +098900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +099000 GO TO DIV-TEST-F5-15-1. NC2514.2 +099100 DIV-DELETE-F5-15. NC2514.2 +099200 PERFORM DE-LETE. NC2514.2 +099300 PERFORM PRINT-DETAIL. NC2514.2 +099400 GO TO DIV-INIT-F5-16. NC2514.2 +099500 DIV-TEST-F5-15-1. NC2514.2 +099600 MOVE "DIV-TEST-F5-15-1" TO PAR-NAME. NC2514.2 +099700 ADD 1 TO REC-CT. NC2514.2 +099800 IF 25ANS NOT = 0 NC2514.2 +099900 MOVE 0 TO CORRECT-N NC2514.2 +100000 MOVE 25ANS TO COMPUTED-N NC2514.2 +100100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +100200 PERFORM FAIL NC2514.2 +100300 PERFORM PRINT-DETAIL NC2514.2 +100400 ELSE NC2514.2 +100500 PERFORM PASS NC2514.2 +100600 PERFORM PRINT-DETAIL. NC2514.2 +100700 DIV-TEST-F5-15-2. NC2514.2 +100800 MOVE "DIV-TEST-F5-15-2" TO PAR-NAME. NC2514.2 +100900 ADD 1 TO REC-CT. NC2514.2 +101000 IF 25REM NOT = ZERO NC2514.2 +101100 MOVE 25REM TO COMPUTED-N NC2514.2 +101200 MOVE ZERO TO CORRECT-N NC2514.2 +101300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +101400 PERFORM FAIL NC2514.2 +101500 PERFORM PRINT-DETAIL NC2514.2 +101600 ELSE NC2514.2 +101700 PERFORM PASS NC2514.2 +101800 PERFORM PRINT-DETAIL. NC2514.2 +101900 DIV-TEST-F5-15-3. NC2514.2 +102000 MOVE "DIV-TEST-F5-15-3" TO PAR-NAME. NC2514.2 +102100 ADD 1 TO REC-CT. NC2514.2 +102200 IF WRK-XN-00001-1 = "A" NC2514.2 +102300 PERFORM PASS NC2514.2 +102400 PERFORM PRINT-DETAIL NC2514.2 +102500 ELSE NC2514.2 +102600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +102700 TO RE-MARK NC2514.2 +102800 MOVE "A" TO CORRECT-A NC2514.2 +102900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +103000 PERFORM FAIL NC2514.2 +103100 PERFORM PRINT-DETAIL. NC2514.2 +103200 DIV-TEST-F5-15-4. NC2514.2 +103300 MOVE "DIV-TEST-F5-15-4" TO PAR-NAME. NC2514.2 +103400 ADD 1 TO REC-CT. NC2514.2 +103500 IF WRK-XN-00001-2 = "B" NC2514.2 +103600 PERFORM PASS NC2514.2 +103700 PERFORM PRINT-DETAIL NC2514.2 +103800 ELSE NC2514.2 +103900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +104000 MOVE SPACE TO CORRECT-A NC2514.2 +104100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +104200 PERFORM FAIL NC2514.2 +104300 PERFORM PRINT-DETAIL. NC2514.2 +104400* NC2514.2 +104500 DIV-INIT-F5-16. NC2514.2 +104600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +104700 MOVE "DIV-TEST-F5-16-0" TO PAR-NAME. NC2514.2 +104800 MOVE 40 TO 25COUNT. NC2514.2 +104900 MOVE ZERO TO 25ANS. NC2514.2 +105000 MOVE ZERO TO 25REM. NC2514.2 +105100 MOVE 1 TO REC-CT. NC2514.2 +105200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +105300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +105400 DIV-TEST-F5-16-0. NC2514.2 +105500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +105600 NOT ON SIZE ERROR NC2514.2 +105700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +105800 END-DIVIDE NC2514.2 +105900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +106000 GO TO DIV-TEST-F5-16-1. NC2514.2 +106100 DIV-DELETE-F5-16. NC2514.2 +106200 PERFORM DE-LETE. NC2514.2 +106300 PERFORM PRINT-DETAIL. NC2514.2 +106400 GO TO DIV-INIT-F5-17. NC2514.2 +106500 DIV-TEST-F5-16-1. NC2514.2 +106600 MOVE "DIV-TEST-F5-16-1" TO PAR-NAME. NC2514.2 +106700 ADD 1 TO REC-CT. NC2514.2 +106800 IF 25ANS NOT = 2 NC2514.2 +106900 MOVE 2 TO CORRECT-N NC2514.2 +107000 MOVE 25ANS TO COMPUTED-N NC2514.2 +107100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +107200 PERFORM FAIL NC2514.2 +107300 PERFORM PRINT-DETAIL NC2514.2 +107400 ELSE NC2514.2 +107500 PERFORM PASS NC2514.2 +107600 PERFORM PRINT-DETAIL. NC2514.2 +107700 DIV-TEST-F5-16-2. NC2514.2 +107800 MOVE "DIV-TEST-F5-16-2" TO PAR-NAME. NC2514.2 +107900 ADD 1 TO REC-CT. NC2514.2 +108000 IF 25REM NOT = 20 NC2514.2 +108100 MOVE 25REM TO COMPUTED-N NC2514.2 +108200 MOVE 20 TO CORRECT-N NC2514.2 +108300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +108400 PERFORM FAIL NC2514.2 +108500 PERFORM PRINT-DETAIL NC2514.2 +108600 ELSE NC2514.2 +108700 PERFORM PASS NC2514.2 +108800 PERFORM PRINT-DETAIL. NC2514.2 +108900 DIV-TEST-F5-16-3. NC2514.2 +109000 MOVE "DIV-TEST-F5-16-3" TO PAR-NAME. NC2514.2 +109100 ADD 1 TO REC-CT. NC2514.2 +109200 IF WRK-XN-00001-1 = "A" NC2514.2 +109300 PERFORM PASS NC2514.2 +109400 PERFORM PRINT-DETAIL NC2514.2 +109500 ELSE NC2514.2 +109600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +109700 TO RE-MARK NC2514.2 +109800 MOVE "A" TO CORRECT-A NC2514.2 +109900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +110000 PERFORM FAIL NC2514.2 +110100 PERFORM PRINT-DETAIL. NC2514.2 +110200 DIV-TEST-F5-16-4. NC2514.2 +110300 MOVE "DIV-TEST-F5-16-4" TO PAR-NAME. NC2514.2 +110400 ADD 1 TO REC-CT. NC2514.2 +110500 IF WRK-XN-00001-2 = "B" NC2514.2 +110600 PERFORM PASS NC2514.2 +110700 PERFORM PRINT-DETAIL NC2514.2 +110800 ELSE NC2514.2 +110900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +111000 MOVE "B" TO CORRECT-A NC2514.2 +111100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +111200 PERFORM FAIL NC2514.2 +111300 PERFORM PRINT-DETAIL. NC2514.2 +111400* NC2514.2 +111500 DIV-INIT-F5-17. NC2514.2 +111600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +111700 MOVE "DIV-TEST-F5-17-0" TO PAR-NAME. NC2514.2 +111800 MOVE ZERO TO 25COUNT. NC2514.2 +111900 MOVE ZERO TO 25ANS. NC2514.2 +112000 MOVE ZERO TO 25REM. NC2514.2 +112100 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +112200 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +112300 MOVE 1 TO REC-CT. NC2514.2 +112400 DIV-TEST-F5-17-0. NC2514.2 +112500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +112600 NOT ON SIZE ERROR NC2514.2 +112700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +112800 END-DIVIDE NC2514.2 +112900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +113000 GO TO DIV-TEST-F5-17-1. NC2514.2 +113100 DIV-DELETE-F5-17. NC2514.2 +113200 PERFORM DE-LETE. NC2514.2 +113300 PERFORM PRINT-DETAIL. NC2514.2 +113400 GO TO DIV-INIT-F5-18. NC2514.2 +113500 DIV-TEST-F5-17-1. NC2514.2 +113600 MOVE "DIV-TEST-F5-17-1" TO PAR-NAME. NC2514.2 +113700 ADD 1 TO REC-CT. NC2514.2 +113800 IF 25ANS NOT = 0 NC2514.2 +113900 MOVE 0 TO CORRECT-N NC2514.2 +114000 MOVE 25ANS TO COMPUTED-N NC2514.2 +114100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +114200 PERFORM FAIL NC2514.2 +114300 PERFORM PRINT-DETAIL NC2514.2 +114400 ELSE NC2514.2 +114500 PERFORM PASS NC2514.2 +114600 PERFORM PRINT-DETAIL. NC2514.2 +114700 DIV-TEST-F5-17-2. NC2514.2 +114800 MOVE "DIV-TEST-F5-17-2" TO PAR-NAME. NC2514.2 +114900 ADD 1 TO REC-CT. NC2514.2 +115000 IF 25REM NOT = ZERO NC2514.2 +115100 MOVE 25REM TO COMPUTED-N NC2514.2 +115200 MOVE ZERO TO CORRECT-N NC2514.2 +115300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +115400 PERFORM FAIL NC2514.2 +115500 PERFORM PRINT-DETAIL NC2514.2 +115600 ELSE NC2514.2 +115700 PERFORM PASS NC2514.2 +115800 PERFORM PRINT-DETAIL. NC2514.2 +115900 DIV-TEST-F5-17-3. NC2514.2 +116000 MOVE "DIV-TEST-F5-17-3" TO PAR-NAME. NC2514.2 +116100 ADD 1 TO REC-CT. NC2514.2 +116200 IF WRK-XN-00001-1 = SPACE NC2514.2 +116300 PERFORM PASS NC2514.2 +116400 PERFORM PRINT-DETAIL NC2514.2 +116500 ELSE NC2514.2 +116600 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +116700 TO RE-MARK NC2514.2 +116800 MOVE SPACE TO CORRECT-A NC2514.2 +116900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +117000 PERFORM FAIL NC2514.2 +117100 PERFORM PRINT-DETAIL. NC2514.2 +117200 DIV-TEST-F5-17-4. NC2514.2 +117300 MOVE "DIV-TEST-F5-17-4" TO PAR-NAME. NC2514.2 +117400 ADD 1 TO REC-CT. NC2514.2 +117500 IF WRK-XN-00001-2 = "B" NC2514.2 +117600 PERFORM PASS NC2514.2 +117700 PERFORM PRINT-DETAIL NC2514.2 +117800 ELSE NC2514.2 +117900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +118000 MOVE "B" TO CORRECT-A NC2514.2 +118100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +118200 PERFORM FAIL NC2514.2 +118300 PERFORM PRINT-DETAIL. NC2514.2 +118400* NC2514.2 +118500 DIV-INIT-F5-18. NC2514.2 +118600 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +118700 MOVE "DIV-TEST-F5-18-0" TO PAR-NAME. NC2514.2 +118800 MOVE 40 TO 25COUNT. NC2514.2 +118900 MOVE ZERO TO 25ANS. NC2514.2 +119000 MOVE ZERO TO 25REM. NC2514.2 +119100 MOVE 1 TO REC-CT. NC2514.2 +119200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +119300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +119400 DIV-TEST-F5-18-0. NC2514.2 +119500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +119600 ON SIZE ERROR NC2514.2 +119700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +119800 NOT ON SIZE ERROR NC2514.2 +119900 MOVE "B" TO WRK-XN-00001-1 NC2514.2 +120000 END-DIVIDE NC2514.2 +120100 MOVE "C" TO WRK-XN-00001-2. NC2514.2 +120200 GO TO DIV-TEST-F5-18-1. NC2514.2 +120300 DIV-DELETE-F5-18. NC2514.2 +120400 PERFORM DE-LETE. NC2514.2 +120500 PERFORM PRINT-DETAIL. NC2514.2 +120600 GO TO DIV-INIT-F5-19. NC2514.2 +120700 DIV-TEST-F5-18-1. NC2514.2 +120800 MOVE "DIV-TEST-F5-18-1" TO PAR-NAME. NC2514.2 +120900 ADD 1 TO REC-CT. NC2514.2 +121000 IF 25ANS NOT = 2 NC2514.2 +121100 MOVE 2 TO CORRECT-N NC2514.2 +121200 MOVE 25ANS TO COMPUTED-N NC2514.2 +121300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +121400 PERFORM FAIL NC2514.2 +121500 PERFORM PRINT-DETAIL NC2514.2 +121600 ELSE NC2514.2 +121700 PERFORM PASS NC2514.2 +121800 PERFORM PRINT-DETAIL. NC2514.2 +121900 DIV-TEST-F5-18-2. NC2514.2 +122000 MOVE "DIV-TEST-F5-18-2" TO PAR-NAME. NC2514.2 +122100 ADD 1 TO REC-CT. NC2514.2 +122200 IF 25REM NOT = 20 NC2514.2 +122300 MOVE 25REM TO COMPUTED-N NC2514.2 +122400 MOVE 20 TO CORRECT-N NC2514.2 +122500 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +122600 PERFORM FAIL NC2514.2 +122700 PERFORM PRINT-DETAIL NC2514.2 +122800 ELSE NC2514.2 +122900 PERFORM PASS NC2514.2 +123000 PERFORM PRINT-DETAIL. NC2514.2 +123100 DIV-TEST-F5-18-3. NC2514.2 +123200 MOVE "DIV-TEST-F5-18-3" TO PAR-NAME. NC2514.2 +123300 ADD 1 TO REC-CT. NC2514.2 +123400 IF WRK-XN-00001-1 = "B" NC2514.2 +123500 PERFORM PASS NC2514.2 +123600 PERFORM PRINT-DETAIL NC2514.2 +123700 ELSE NC2514.2 +123800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +123900 TO RE-MARK NC2514.2 +124000 MOVE "B" TO CORRECT-A NC2514.2 +124100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +124200 PERFORM FAIL NC2514.2 +124300 PERFORM PRINT-DETAIL. NC2514.2 +124400 DIV-TEST-F5-18-4. NC2514.2 +124500 MOVE "DIV-TEST-F5-18-4" TO PAR-NAME. NC2514.2 +124600 ADD 1 TO REC-CT. NC2514.2 +124700 IF WRK-XN-00001-2 = "C" NC2514.2 +124800 PERFORM PASS NC2514.2 +124900 PERFORM PRINT-DETAIL NC2514.2 +125000 ELSE NC2514.2 +125100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +125200 MOVE "C" TO CORRECT-A NC2514.2 +125300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +125400 PERFORM FAIL NC2514.2 +125500 PERFORM PRINT-DETAIL. NC2514.2 +125600* NC2514.2 +125700 DIV-INIT-F5-19. NC2514.2 +125800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +125900 MOVE "DIV-TEST-F5-19-0" TO PAR-NAME. NC2514.2 +126000 MOVE ZERO TO 25COUNT. NC2514.2 +126100 MOVE ZERO TO 25ANS. NC2514.2 +126200 MOVE ZERO TO 25REM. NC2514.2 +126300 MOVE 1 TO REC-CT. NC2514.2 +126400 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +126500 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +126600 DIV-TEST-F5-19-0. NC2514.2 +126700 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +126800 ON SIZE ERROR NC2514.2 +126900 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +127000 NOT ON SIZE ERROR NC2514.2 +127100 MOVE "B" TO WRK-XN-00001-1 NC2514.2 +127200 END-DIVIDE NC2514.2 +127300 MOVE "C" TO WRK-XN-00001-2. NC2514.2 +127400 GO TO DIV-TEST-F5-19-1. NC2514.2 +127500 DIV-DELETE-F5-19. NC2514.2 +127600 PERFORM DE-LETE. NC2514.2 +127700 PERFORM PRINT-DETAIL. NC2514.2 +127800 GO TO DIV-INIT-F5-20. NC2514.2 +127900 DIV-TEST-F5-19-1. NC2514.2 +128000 MOVE "DIV-TEST-F5-19-1" TO PAR-NAME. NC2514.2 +128100 ADD 1 TO REC-CT. NC2514.2 +128200 IF 25ANS NOT = 0 NC2514.2 +128300 MOVE 0 TO CORRECT-N NC2514.2 +128400 MOVE 25ANS TO COMPUTED-N NC2514.2 +128500 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +128600 PERFORM FAIL NC2514.2 +128700 PERFORM PRINT-DETAIL NC2514.2 +128800 ELSE NC2514.2 +128900 PERFORM PASS NC2514.2 +129000 PERFORM PRINT-DETAIL. NC2514.2 +129100 DIV-TEST-F5-19-2. NC2514.2 +129200 MOVE "DIV-TEST-F5-19-2" TO PAR-NAME. NC2514.2 +129300 ADD 1 TO REC-CT. NC2514.2 +129400 IF 25REM NOT = ZERO NC2514.2 +129500 MOVE 25REM TO COMPUTED-N NC2514.2 +129600 MOVE ZERO TO CORRECT-N NC2514.2 +129700 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +129800 PERFORM FAIL NC2514.2 +129900 PERFORM PRINT-DETAIL NC2514.2 +130000 ELSE NC2514.2 +130100 PERFORM PASS NC2514.2 +130200 PERFORM PRINT-DETAIL. NC2514.2 +130300 DIV-TEST-F5-19-3. NC2514.2 +130400 MOVE "DIV-TEST-F5-19-3" TO PAR-NAME. NC2514.2 +130500 ADD 1 TO REC-CT. NC2514.2 +130600 IF WRK-XN-00001-1 = "A" NC2514.2 +130700 PERFORM PASS NC2514.2 +130800 PERFORM PRINT-DETAIL NC2514.2 +130900 ELSE NC2514.2 +131000 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +131100 TO RE-MARK NC2514.2 +131200 MOVE "A" TO CORRECT-A NC2514.2 +131300 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +131400 PERFORM FAIL NC2514.2 +131500 PERFORM PRINT-DETAIL. NC2514.2 +131600 DIV-TEST-F5-19-4. NC2514.2 +131700 MOVE "DIV-TEST-F5-19-4" TO PAR-NAME. NC2514.2 +131800 ADD 1 TO REC-CT. NC2514.2 +131900 IF WRK-XN-00001-2 = "C" NC2514.2 +132000 PERFORM PASS NC2514.2 +132100 PERFORM PRINT-DETAIL NC2514.2 +132200 ELSE NC2514.2 +132300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +132400 MOVE "C" TO CORRECT-A NC2514.2 +132500 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +132600 PERFORM FAIL NC2514.2 +132700 PERFORM PRINT-DETAIL. NC2514.2 +132800* NC2514.2 +132900 DIV-INIT-F5-20. NC2514.2 +133000 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +133100 MOVE "DIV-TEST-F5-20-0" TO PAR-NAME. NC2514.2 +133200 MOVE ZERO TO 25ANS. NC2514.2 +133300 MOVE ZERO TO 25REM. NC2514.2 +133400 MOVE ZERO TO WS-REMAINDERS. NC2514.2 +133500 MOVE 6 TO 25COUNT. NC2514.2 +133600 MOVE 1 TO REC-CT. NC2514.2 +133700 DIV-TEST-F5-20-0. NC2514.2 +133800 DIVIDE 100 BY 25COUNT GIVING 25ANS NC2514.2 +133900 REMAINDER WS-REM (25ANS) NC2514.2 +134000 ON SIZE ERROR NC2514.2 +134100 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +134200 TO RE-MARK NC2514.2 +134300 PERFORM FAIL NC2514.2 +134400 PERFORM PRINT-DETAIL NC2514.2 +134500 GO TO DIV-TEST-F5-20-1. NC2514.2 +134600 PERFORM PASS. NC2514.2 +134700 PERFORM PRINT-DETAIL. NC2514.2 +134800 GO TO DIV-TEST-F5-20-1. NC2514.2 +134900 DIV-DELETE-F5-20. NC2514.2 +135000 PERFORM DE-LETE. NC2514.2 +135100 PERFORM PRINT-DETAIL. NC2514.2 +135200 GO TO CCVS-EXIT. NC2514.2 +135300 DIV-TEST-F5-20-1. NC2514.2 +135400 MOVE "DIV-TEST-F5-20-1" TO PAR-NAME. NC2514.2 +135500 ADD 1 TO REC-CT. NC2514.2 +135600 IF 25ANS NOT = 16 NC2514.2 +135700 MOVE 16 TO CORRECT-N NC2514.2 +135800 MOVE 25ANS TO COMPUTED-N NC2514.2 +135900 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +136000 PERFORM FAIL NC2514.2 +136100 PERFORM PRINT-DETAIL NC2514.2 +136200 ELSE NC2514.2 +136300 PERFORM PASS NC2514.2 +136400 PERFORM PRINT-DETAIL. NC2514.2 +136500 DIV-TEST-F5-20-2. NC2514.2 +136600 MOVE "DIV-TEST-F5-20-2" TO PAR-NAME. NC2514.2 +136700 ADD 1 TO REC-CT. NC2514.2 +136800 IF WS-REM (25ANS) NOT = 4 NC2514.2 +136900 MOVE WS-REM (25ANS) TO COMPUTED-N NC2514.2 +137000 MOVE 4 TO CORRECT-N NC2514.2 +137100 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +137200 PERFORM FAIL NC2514.2 +137300 PERFORM PRINT-DETAIL NC2514.2 +137400 ADD 1 TO REC-CT NC2514.2 +137500 MOVE 25ANS TO COMPUTED-N NC2514.2 +137600 MOVE 16 TO CORRECT-N NC2514.2 +137700 MOVE "INVALID SUBSCRIPT FOR REMAINDER" TO RE-MARK NC2514.2 +137800 PERFORM FAIL NC2514.2 +137900 PERFORM PRINT-DETAIL NC2514.2 +138000 ELSE NC2514.2 +138100 PERFORM PASS NC2514.2 +138200 PERFORM PRINT-DETAIL. NC2514.2 +138300* NC2514.2 +138400 DIV-INIT-F5-21. NC2514.2 +138500 MOVE "DIV-TEST-F5-21" TO PAR-NAME. NC2514.2 +138600 MOVE 10.0 TO WRK-DU-2V1-1. NC2514.2 +138700 MOVE ZERO TO REC-CT. NC2514.2 +138800 DIVIDE-REMAINDER-TEST-7. NC2514.2 +138900 DIVIDE WRK-DU-1V17-1 BY WRK-DU-2V1-1 GIVING WRK-DU-1V5-1 NC2514.2 +139000 REMAINDER WRK-NE-1 ON SIZE ERROR GO TO DIV-FAIL-F5-21. NC2514.2 +139100 GO TO DIV-TEST-F5-21-1. NC2514.2 +139200 DIV-DELETE-F5-21. NC2514.2 +139300 PERFORM DE-LETE. NC2514.2 +139400 PERFORM PRINT-DETAIL. NC2514.2 +139500 GO TO CCVS-EXIT. NC2514.2 +139600 DIV-FAIL-F5-21. NC2514.2 +139700 PERFORM FAIL. NC2514.2 +139800 MOVE "SIZE ERROR BAD" TO RE-MARK. NC2514.2 +139900 PERFORM PRINT-DETAIL. NC2514.2 +140000 DIV-TEST-F5-21-1. NC2514.2 +140100 MOVE "DIV-TEST-F5-21-1" TO ANSI-REFERENCE. NC2514.2 +140200 MOVE 1 TO REC-CT. NC2514.2 +140300 IF WRK-DU-1V5-1 = 0.31415 PERFORM PASS PERFORM PRINT-DETAIL NC2514.2 +140400 ELSE NC2514.2 +140500 PERFORM FAIL MOVE WRK-DU-1V5-1 TO COMPUTED-N MOVE 0.31415 NC2514.2 +140600 TO CORRECT-N PERFORM PRINT-DETAIL. NC2514.2 +140700 ADD 1 TO REC-CT. NC2514.2 +140800 DIV-TEST-F5-21-2. NC2514.2 +140900 MOVE "DIV-TEST-F5-21-2" TO ANSI-REFERENCE. NC2514.2 +141000 IF WRK-NE-1 = ".0000/92653,58979,32" PERFORM PASS NC2514.2 +141100 PERFORM PRINT-DETAIL ELSE NC2514.2 +141200 PERFORM FAIL MOVE WRK-NE-1 TO COMPUTED-A MOVE NC2514.2 +141300 ".0000/92653,58979,32" TO CORRECT-A PERFORM PRINT-DETAIL. NC2514.2 +141400* NC2514.2 +141500 CCVS-EXIT SECTION. NC2514.2 +141600 CCVS-999999. NC2514.2 +141700 GO TO CLOSE-FILES. NC2514.2 +*END-OF,NC251A +*HEADER,COBOL,NC252A +000100 IDENTIFICATION DIVISION. NC2524.2 +000200 PROGRAM-ID. NC2524.2 +000300 NC252A. NC2524.2 +000400**************************************************************** NC2524.2 +000500* * NC2524.2 +000600* VALIDATION FOR:- * NC2524.2 +000700* * NC2524.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +000900* * NC2524.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2524.2 +001100* * NC2524.2 +001200**************************************************************** NC2524.2 +001300* * NC2524.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2524.2 +001500* * NC2524.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2524.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2524.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2524.2 +001900* * NC2524.2 +002000**************************************************************** NC2524.2 +002100* * NC2524.2 +002200* THIS PROGRAM TESTS THE "REDEFINES" AND "RENAMES" CLAUSES. * NC2524.2 +002300* * NC2524.2 +002400**************************************************************** NC2524.2 +002500 ENVIRONMENT DIVISION. NC2524.2 +002600 CONFIGURATION SECTION. NC2524.2 +002700 SOURCE-COMPUTER. NC2524.2 +002800 XXXXX082. NC2524.2 +002900 OBJECT-COMPUTER. NC2524.2 +003000 XXXXX083. NC2524.2 +003100 INPUT-OUTPUT SECTION. NC2524.2 +003200 FILE-CONTROL. NC2524.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2524.2 +003400 XXXXX055. NC2524.2 +003500 DATA DIVISION. NC2524.2 +003600 FILE SECTION. NC2524.2 +003700 FD PRINT-FILE. NC2524.2 +003800 01 PRINT-REC PICTURE X(120). NC2524.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2524.2 +004000 WORKING-STORAGE SECTION. NC2524.2 +004100 01 WS-REMAINDERS. NC2524.2 +004200 03 WS-REM PIC 99 OCCURS 20. NC2524.2 +004300 01 WRK-XN-00001-1 PIC X. NC2524.2 +004400 01 WRK-XN-00001-2 PIC X. NC2524.2 +004500 01 WS-46. NC2524.2 +004600 03 WS-1-20 PIC X(20). NC2524.2 +004700 03 WS-21-40 PIC X(20). NC2524.2 +004800 03 WS-41-46 PIC X(6). NC2524.2 +004900 77 11A PICTURE 9999 VALUE 9. NC2524.2 +005000 77 11B PICTURE 99; VALUE 8. NC2524.2 +005100 77 1111C PICTURE 99 VALUE 9. NC2524.2 +005200 77 WRK-DS-02V00 PICTURE S99. NC2524.2 +005300 88 TEST-2NUC-COND-99 VALUE 99. NC2524.2 +005400 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2524.2 +005500 77 WRK-DS-18V00 PICTURE S9(18). NC2524.2 +005600 77 A18ONES-DS-18V00 PICTURE S9(18) NC2524.2 +005700 VALUE 111111111111111111. NC2524.2 +005800 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2524.2 +005900 VALUE 222222222222222222. NC2524.2 +006000 77 WRK-DS-05V00 PICTURE S9(5). NC2524.2 +006100 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2524.2 +006200 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2524.2 +006300 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2524.2 +006400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2524.2 +006500 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2524.2 +006600 77 WRK-DS-0201P PICTURE S99P. NC2524.2 +006700 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2524.2 +006800 77 WRK-DS-09V00 PICTURE S9(9). NC2524.2 +006900 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2524.2 +007000 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2524.2 +007100 PICTURE S9(18). NC2524.2 +007200 77 XRAY PICTURE IS X. NC2524.2 +007300 77 W-1 PICTURE IS 9. NC2524.2 +007400 77 W-2 PICTURE IS 99. NC2524.2 +007500 77 W-3 PICTURE IS 999. NC2524.2 +007600 77 W-5 PICTURE 99 VALUE ZERO. NC2524.2 +007700 77 W-9 PICTURE 999. NC2524.2 +007800 77 W-11 PICTURE S99V9. NC2524.2 +007900 77 D-1 PICTURE S9V99 VALUE 1.06. NC2524.2 +008000 77 D-7 PICTURE S99V99 VALUE 1.09. NC2524.2 +008100 77 ONE PICTURE IS 9 VALUE IS 1. NC2524.2 +008200 77 TWO PICTURE IS S9 VALUE IS 2. NC2524.2 +008300 77 THREE PICTURE IS S9 VALUE IS 3. NC2524.2 +008400 77 FOUR PICTURE IS S9 VALUE IS 4. NC2524.2 +008500 77 FIVE PICTURE IS S9 VALUE IS 5. NC2524.2 +008600 77 SIX PICTURE IS S9 VALUE IS 6. NC2524.2 +008700 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2524.2 +008800 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2524.2 +008900 77 NINE PICTURE IS S9 VALUE IS 9. NC2524.2 +009000 77 TEN PICTURE IS S99 VALUE IS 10. NC2524.2 +009100 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2524.2 +009200 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2524.2 +009300 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2524.2 +009400 1 COMPUTE-DATA. NC2524.2 +009500 02NC2524.2 +009600 COMPUTE-1 PICTURE 999V9999 VALUE ZERO. NC2524.2 +009700 2 COMPUTE-1A PICTURE 9(3)V9(4) VALUE 654.1873. NC2524.2 +009800 2 COMPUTE-2 PICTURE 9999V9 VALUE ZERO. NC2524.2 +009900 02 COMPUTE-3 PICTURE 999V99 VALUE ZERO. NC2524.2 +010000 2 COMPUTE-3A PICTURE 999V99 VALUE 86.14. NC2524.2 +010100 2 COMPUTE-3B PICTURE 999V99 VALUE 33.75. NC2524.2 +010200 2 COMPUTE-4 PICTURE 999 VALUE ZERO. NC2524.2 +010300 2 COMPUTE-4A PICTURE 999 VALUE 124. NC2524.2 +010400 2 COMPUTE-4B PICTURE 999 VALUE 217. NC2524.2 +010500 2 COMPUTE-5 PICTURE 9999V99 VALUE ZERO. NC2524.2 +010600 02 COMPUTE-5A PICTURE 999V9 VALUE 11.1. NC2524.2 +010700 2 COMPUTE-6 PICTURE 999V9 VALUE ZERO. NC2524.2 +010800 2 COMPUTE-6A PICTURE 999V9 VALUE 374.4. NC2524.2 +010900 2 COMPUTE-7 PICTURE 999 VALUE ZERO. NC2524.2 +011000 2 COMPUTE-8 PICTURE 999 VALUE ZERO. NC2524.2 +011100 02 COMPUTE-9 PICTURE 9999 VALUE ZERO. NC2524.2 +011200 2 COMPUTE-10 PICTURE 999V9999 VALUE ZERO. NC2524.2 +011300 2 COMPUTE-11 PICTURE 999V9 VALUE ZERO. NC2524.2 +011400 2 COMPUTE-11A PICTURE 999V9 VALUE 371.2. NC2524.2 +011500 2 COMPUTE-11B PICTURE 999V9 VALUE 468.9. NC2524.2 +011600 2 COMPUTE-12 PICTURE 99V99 VALUE ZERO. NC2524.2 +011700 2 COMPUTE-12A PICTURE 999V9 VALUE 336.4. NC2524.2 +011800 2 COMPUTE-12B PICTURE 999V9 VALUE 281.7. NC2524.2 +011900 01 RENAMES-DATA. NC2524.2 +012000 02 NAME1. NC2524.2 +012100 03 NAME1A PICTURE XX VALUE SPACE. NC2524.2 +012200 03 NAME1B PICTURE XXX VALUE SPACE. NC2524.2 +012300 02 NAME2 PICTURE X(10) VALUE SPACE. NC2524.2 +012400 02 NAME3. NC2524.2 +012500 09 NAME3A PICTURE XXX VALUE SPACE. NC2524.2 +012600 09 NAME3B PICTURE XX VALUE SPACE. NC2524.2 +012700 66 RENAME1 RENAMES NAME1 THRU NAME3. NC2524.2 +012800 66 RENAME2 RENAMES NAME1A THRU NAME1B. NC2524.2 +012900 66 RENAME3 RENAMES NAME2. NC2524.2 +013000 66 RENAME4 RENAMES NAME1. NC2524.2 +013100 01 GRP-FOR-RENAMES. NC2524.2 +013200 03 SUB-GRP-FOR-RENAMES-1. NC2524.2 +013300 05 ELEM-FOR-RENAMES-1 PICTURE X VALUE "X". NC2524.2 +013400 05 FILLER PICTURE XX VALUE SPACE. NC2524.2 +013500 03 SUB-GRP-FOR-RENAMES-2. NC2524.2 +013600 49 ELEM-FOR-RENAMES-2 PICTURE 999 VALUE 123. NC2524.2 +013700 49 FILLER PICTURE 9 VALUE ZERO. NC2524.2 +013800 49 ELEM-FOR-RENAMES-3 PICTURE XXXX VALUE ZERO. NC2524.2 +013900 66 RENAMES-TEST-1 RENAMES ELEM-FOR-RENAMES-2. NC2524.2 +014000 66 RENAMES-TEST-2 RENAMES SUB-GRP-FOR-RENAMES-1 NC2524.2 +014100 OF GRP-FOR-RENAMES. NC2524.2 +014200 66 RENAMES-TEST-3 RENAMES SUB-GRP-FOR-RENAMES-1 NC2524.2 +014300 THRU ELEM-FOR-RENAMES-2. NC2524.2 +014400 66 RENAMES-TEST-4 RENAMES ELEM-FOR-RENAMES-1 NC2524.2 +014500 THRU ELEM-FOR-RENAMES-2 IN GRP-FOR-RENAMES. NC2524.2 +014600 01 T-RENAMES-DATA. NC2524.2 +014700 02 TAG-1. NC2524.2 +014800 03 TAG-1A PICTURE XXXX. NC2524.2 +014900 03 TAG-1B PICTURE XXXXXX. NC2524.2 +015000 02 NAME-2 PICTURE XXXXXXX. NC2524.2 +015100 66 RENAME-5 RENAMES TAG-1A THRU TAG-1B. NC2524.2 +015200 66 RENAME-6 RENAMES TAG-1A THRU NAME-2 OF T-RENAMES-DATA. NC2524.2 +015300 01 U-RENAMES-DATA. NC2524.2 +015400 02 UNIT-1. NC2524.2 +015500 03 UNIT-1A PICTURE XXXXXXX VALUE "VERMONT". NC2524.2 +015600 03 UNIT-1B PICTURE XXXX VALUE "OHIO". NC2524.2 +015700 02 NAME-2 PICTURE XXXXX VALUE "MAINE". NC2524.2 +015800 66 RENAME-5 RENAMES UNIT-1A THROUGH UNIT-1B. NC2524.2 +015900 66 RENAME-6 RENAMES UNIT-1A THRU NAME-2 OF U-RENAMES-DATA. NC2524.2 +016000 01 V-RENAMES-DATA. NC2524.2 +016100 02 ITEM-1 PICTURE X(5). NC2524.2 +016200 02 TABLE-2. NC2524.2 +016300 03 TABLE-ITEM-2 PICTURE XXX OCCURS 5 TIMES. NC2524.2 +016400 66 RENAME-7 RENAMES ITEM-1 THRU TABLE-2. NC2524.2 +016500 01 W-RENAMES-DATA. NC2524.2 +016600 02 WIDGET-1 PICTURE 99V9. NC2524.2 +016700 02 WIDGET-2 PICTURE ***,***.**. NC2524.2 +016800 02 WIDGET-3 PICTURE XXXX. NC2524.2 +016900 02 WIDGET-4 PICTURE 9(4). NC2524.2 +017000 02 WIDGET-5 PICTURE 9(4). NC2524.2 +017100 66 RENAME-8 RENAMES WIDGET-1 THRU WIDGET-3. NC2524.2 +017200 66 RENAME-9 RENAMES WIDGET-3 THRU WIDGET-5. NC2524.2 +017300 66 RENAME-10 RENAMES WIDGET-4 THRU WIDGET-5. NC2524.2 +017400 66 RENAME-11 RENAMES WIDGET-2. NC2524.2 +017500 66 RENAME-12 RENAMES WIDGET-4. NC2524.2 +017600 01 REDEF10. NC2524.2 +017700 02 RDFDATA1 PICTURE X(10) VALUE "ABC98765DE".NC2524.2 +017800 02 RDFDATA2 PICTURE 9(4)V99 VALUE 9116.44. NC2524.2 +017900 02 RDFDATA3. NC2524.2 +018000 08 RDFDATA4 PICTURE X(6) VALUE "ALLDON". NC2524.2 +018100 08 RDFDATA5 PICTURE XX99 VALUE "XX66". NC2524.2 +018200 02 RDF3 REDEFINES RDFDATA3. NC2524.2 +018300 03 RDF3-4 PICTURE X(8). NC2524.2 +018400 03 RDF3-5 PIC 99. NC2524.2 +018500 03 RDF3-5-1 REDEFINES RDF3-5. NC2524.2 +018600 04 RDF3-5-14 PIC 9. NC2524.2 +018700 04 RDF3-5-15 PIC 9. NC2524.2 +018800 88 HARD VALUE 0. NC2524.2 +018900 88 SOFT VALUE 1. NC2524.2 +019000 02 RDFDATA6 PICTURE A(20) VALUE NC2524.2 +019100 "ZYXWVUTSRQPONMLKJIHG". NC2524.2 +019200 66 RDF3-5-16 RENAMES RDF3-5. NC2524.2 +019300 01 REDEF11 REDEFINES REDEF10. NC2524.2 +019400 02 RDFDATA7 PICTURE X(20). NC2524.2 +019500 02 RDF8. NC2524.2 +019600 03 RDFDATA8 OCCURS 36 TIMES PICTURE XX. NC2524.2 +019700 02 RDEF8 REDEFINES RDF8. NC2524.2 +019800 03 RDF8-1 PICTURE X(50). NC2524.2 +019900 03 RDF8-2 PIC X(9). NC2524.2 +020000 03 RDF8-3 REDEFINES RDF8-2. NC2524.2 +020100 04 RDF8-4 PIC X(5). NC2524.2 +020200 04 RDF8-5 PICTURE XX. NC2524.2 +020300 04 RDF8-6 PIC XX. NC2524.2 +020400 03 RDF8-8 PIC X(13). NC2524.2 +020500 66 RDF8-7 RENAMES RDF8-5 THRU RDF8-6. NC2524.2 +020600 01 REDEF12 REDEFINES REDEF10. NC2524.2 +020700 02 RDFDATA9 PICTURE A(3). NC2524.2 +020800 02 RDFDATA10 PIC 9(5). NC2524.2 +020900 02 RDFDATA11. NC2524.2 +021000 03 RDFDATA12. NC2524.2 +021100 04 RDFDATA13 PICTURE XX. NC2524.2 +021200 04 RDFDATA14 OCCURS 6 TIMES PICTURE 9. NC2524.2 +021300 03 RDFDATA15 PICTURE X(8). NC2524.2 +021400 02 RDFDATA16 PICTURE 99. NC2524.2 +021500 02 RDFDATA17 PICTURE X(80). NC2524.2 +021600 02 RDFDATA18 PICTURE X(14). NC2524.2 +021700 01 GRP-REDEF125 REDEFINES REDEF10. NC2524.2 +021800 02 AN0020-X-0001 PIC X(26). NC2524.2 +021900 02 AN0002-O036F-X-0002 PIC XX OCCURS 36 TIMES. NC2524.2 +022000 01 WRK-DU-05V00-0001 PIC 9(5). NC2524.2 +022100 01 WRK-DS-05V00-0002 PIC S9(5). NC2524.2 +022200 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2524.2 +022300 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2524.2 +022400 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2524.2 +022500 01 NE-0008 PIC $9(4).99-. NC2524.2 +022600 01 NE-0009 PIC ***99. NC2524.2 +022700 01 NE-04V01-0006 PIC ****.9. NC2524.2 +022800 01 GRP-0010. NC2524.2 +022900 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2524.2 +023000 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2524.2 +023100 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2524.2 +023200 05 WRK-DS-03V04-0003F-0014 PIC S9(3)V9999 NC2524.2 +023300 OCCURS 3 TIMES. NC2524.2 +023400 01 DS-02V00-0001 PIC S99 VALUE 16. NC2524.2 +023500 01 DS-03V00-0002 PIC S999 VALUE 174. NC2524.2 +023600 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2524.2 +023700 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2524.2 +023800 01 REDEF13. NC2524.2 +023900 02 FILLER PICTURE X(57) VALUE NC2524.2 +024000 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC2524.2 +024100 02 FILLER PICTURE X(57) VALUE NC2524.2 +024200 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC2524.2 +024300 02 FILLER PICTURE X(6) VALUE "AAAAAA". NC2524.2 +024400 01 MINUS-NAMES. NC2524.2 +024500 02 WHOLE-FIELD PICTURE S9(18). NC2524.2 +024600 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2524.2 +024700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2524.2 +024800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2524.2 +024900 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2524.2 +025000 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2524.2 +025100 01 TEST-RESULTS. NC2524.2 +025200 02 FILLER PIC X VALUE SPACE. NC2524.2 +025300 02 FEATURE PIC X(20) VALUE SPACE. NC2524.2 +025400 02 FILLER PIC X VALUE SPACE. NC2524.2 +025500 02 P-OR-F PIC X(5) VALUE SPACE. NC2524.2 +025600 02 FILLER PIC X VALUE SPACE. NC2524.2 +025700 02 PAR-NAME. NC2524.2 +025800 03 FILLER PIC X(19) VALUE SPACE. NC2524.2 +025900 03 PARDOT-X PIC X VALUE SPACE. NC2524.2 +026000 03 DOTVALUE PIC 99 VALUE ZERO. NC2524.2 +026100 02 FILLER PIC X(8) VALUE SPACE. NC2524.2 +026200 02 RE-MARK PIC X(61). NC2524.2 +026300 01 TEST-COMPUTED. NC2524.2 +026400 02 FILLER PIC X(30) VALUE SPACE. NC2524.2 +026500 02 FILLER PIC X(17) VALUE NC2524.2 +026600 " COMPUTED=". NC2524.2 +026700 02 COMPUTED-X. NC2524.2 +026800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2524.2 +026900 03 COMPUTED-N REDEFINES COMPUTED-A NC2524.2 +027000 PIC -9(9).9(9). NC2524.2 +027100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2524.2 +027200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2524.2 +027300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2524.2 +027400 03 CM-18V0 REDEFINES COMPUTED-A. NC2524.2 +027500 04 COMPUTED-18V0 PIC -9(18). NC2524.2 +027600 04 FILLER PIC X. NC2524.2 +027700 03 FILLER PIC X(50) VALUE SPACE. NC2524.2 +027800 01 TEST-CORRECT. NC2524.2 +027900 02 FILLER PIC X(30) VALUE SPACE. NC2524.2 +028000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2524.2 +028100 02 CORRECT-X. NC2524.2 +028200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2524.2 +028300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2524.2 +028400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2524.2 +028500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2524.2 +028600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2524.2 +028700 03 CR-18V0 REDEFINES CORRECT-A. NC2524.2 +028800 04 CORRECT-18V0 PIC -9(18). NC2524.2 +028900 04 FILLER PIC X. NC2524.2 +029000 03 FILLER PIC X(2) VALUE SPACE. NC2524.2 +029100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2524.2 +029200 01 CCVS-C-1. NC2524.2 +029300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2524.2 +029400- "SS PARAGRAPH-NAME NC2524.2 +029500- " REMARKS". NC2524.2 +029600 02 FILLER PIC X(20) VALUE SPACE. NC2524.2 +029700 01 CCVS-C-2. NC2524.2 +029800 02 FILLER PIC X VALUE SPACE. NC2524.2 +029900 02 FILLER PIC X(6) VALUE "TESTED". NC2524.2 +030000 02 FILLER PIC X(15) VALUE SPACE. NC2524.2 +030100 02 FILLER PIC X(4) VALUE "FAIL". NC2524.2 +030200 02 FILLER PIC X(94) VALUE SPACE. NC2524.2 +030300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2524.2 +030400 01 REC-CT PIC 99 VALUE ZERO. NC2524.2 +030500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2524.2 +031000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2524.2 +031100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2524.2 +031200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2524.2 +031300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2524.2 +031400 01 CCVS-H-1. NC2524.2 +031500 02 FILLER PIC X(39) VALUE SPACES. NC2524.2 +031600 02 FILLER PIC X(42) VALUE NC2524.2 +031700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2524.2 +031800 02 FILLER PIC X(39) VALUE SPACES. NC2524.2 +031900 01 CCVS-H-2A. NC2524.2 +032000 02 FILLER PIC X(40) VALUE SPACE. NC2524.2 +032100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2524.2 +032200 02 FILLER PIC XXXX VALUE NC2524.2 +032300 "4.2 ". NC2524.2 +032400 02 FILLER PIC X(28) VALUE NC2524.2 +032500 " COPY - NOT FOR DISTRIBUTION". NC2524.2 +032600 02 FILLER PIC X(41) VALUE SPACE. NC2524.2 +032700 NC2524.2 +032800 01 CCVS-H-2B. NC2524.2 +032900 02 FILLER PIC X(15) VALUE NC2524.2 +033000 "TEST RESULT OF ". NC2524.2 +033100 02 TEST-ID PIC X(9). NC2524.2 +033200 02 FILLER PIC X(4) VALUE NC2524.2 +033300 " IN ". NC2524.2 +033400 02 FILLER PIC X(12) VALUE NC2524.2 +033500 " HIGH ". NC2524.2 +033600 02 FILLER PIC X(22) VALUE NC2524.2 +033700 " LEVEL VALIDATION FOR ". NC2524.2 +033800 02 FILLER PIC X(58) VALUE NC2524.2 +033900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +034000 01 CCVS-H-3. NC2524.2 +034100 02 FILLER PIC X(34) VALUE NC2524.2 +034200 " FOR OFFICIAL USE ONLY ". NC2524.2 +034300 02 FILLER PIC X(58) VALUE NC2524.2 +034400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2524.2 +034500 02 FILLER PIC X(28) VALUE NC2524.2 +034600 " COPYRIGHT 1985 ". NC2524.2 +034700 01 CCVS-E-1. NC2524.2 +034800 02 FILLER PIC X(52) VALUE SPACE. NC2524.2 +034900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2524.2 +035000 02 ID-AGAIN PIC X(9). NC2524.2 +035100 02 FILLER PIC X(45) VALUE SPACES. NC2524.2 +035200 01 CCVS-E-2. NC2524.2 +035300 02 FILLER PIC X(31) VALUE SPACE. NC2524.2 +035400 02 FILLER PIC X(21) VALUE SPACE. NC2524.2 +035500 02 CCVS-E-2-2. NC2524.2 +035600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2524.2 +035700 03 FILLER PIC X VALUE SPACE. NC2524.2 +035800 03 ENDER-DESC PIC X(44) VALUE NC2524.2 +035900 "ERRORS ENCOUNTERED". NC2524.2 +036000 01 CCVS-E-3. NC2524.2 +036100 02 FILLER PIC X(22) VALUE NC2524.2 +036200 " FOR OFFICIAL USE ONLY". NC2524.2 +036300 02 FILLER PIC X(12) VALUE SPACE. NC2524.2 +036400 02 FILLER PIC X(58) VALUE NC2524.2 +036500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +036600 02 FILLER PIC X(13) VALUE SPACE. NC2524.2 +036700 02 FILLER PIC X(15) VALUE NC2524.2 +036800 " COPYRIGHT 1985". NC2524.2 +036900 01 CCVS-E-4. NC2524.2 +037000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2524.2 +037100 02 FILLER PIC X(4) VALUE " OF ". NC2524.2 +037200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2524.2 +037300 02 FILLER PIC X(40) VALUE NC2524.2 +037400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2524.2 +037500 01 XXINFO. NC2524.2 +037600 02 FILLER PIC X(19) VALUE NC2524.2 +037700 "*** INFORMATION ***". NC2524.2 +037800 02 INFO-TEXT. NC2524.2 +037900 04 FILLER PIC X(8) VALUE SPACE. NC2524.2 +038000 04 XXCOMPUTED PIC X(20). NC2524.2 +038100 04 FILLER PIC X(5) VALUE SPACE. NC2524.2 +038200 04 XXCORRECT PIC X(20). NC2524.2 +038300 02 INF-ANSI-REFERENCE PIC X(48). NC2524.2 +038400 01 HYPHEN-LINE. NC2524.2 +038500 02 FILLER PIC IS X VALUE IS SPACE. NC2524.2 +038600 02 FILLER PIC IS X(65) VALUE IS "************************NC2524.2 +038700- "*****************************************". NC2524.2 +038800 02 FILLER PIC IS X(54) VALUE IS "************************NC2524.2 +038900- "******************************". NC2524.2 +039000 01 CCVS-PGM-ID PIC X(9) VALUE NC2524.2 +039100 "NC252A". NC2524.2 +039200 PROCEDURE DIVISION. NC2524.2 +039300 CCVS1 SECTION. NC2524.2 +039400 OPEN-FILES. NC2524.2 +039500 OPEN OUTPUT PRINT-FILE. NC2524.2 +039600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2524.2 +039700 MOVE SPACE TO TEST-RESULTS. NC2524.2 +039800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2524.2 +039900 GO TO CCVS1-EXIT. NC2524.2 +040000 CLOSE-FILES. NC2524.2 +040100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2524.2 +040200 TERMINATE-CCVS. NC2524.2 +040300 STOP RUN. NC2524.2 +040400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2524.2 +040500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2524.2 +040600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2524.2 +040700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2524.2 +040800 MOVE "****TEST DELETED****" TO RE-MARK. NC2524.2 +040900 PRINT-DETAIL. NC2524.2 +041000 IF REC-CT NOT EQUAL TO ZERO NC2524.2 +041100 MOVE "." TO PARDOT-X NC2524.2 +041200 MOVE REC-CT TO DOTVALUE. NC2524.2 +041300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2524.2 +041400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2524.2 +041500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2524.2 +041600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2524.2 +041700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2524.2 +041800 MOVE SPACE TO CORRECT-X. NC2524.2 +041900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2524.2 +042000 MOVE SPACE TO RE-MARK. NC2524.2 +042100 HEAD-ROUTINE. NC2524.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2524.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2524.2 +042600 COLUMN-NAMES-ROUTINE. NC2524.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +043000 END-ROUTINE. NC2524.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2524.2 +043200 END-RTN-EXIT. NC2524.2 +043300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +043400 END-ROUTINE-1. NC2524.2 +043500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2524.2 +043600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2524.2 +043700 ADD PASS-COUNTER TO ERROR-HOLD. NC2524.2 +043800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2524.2 +043900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2524.2 +044000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2524.2 +044100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2524.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2524.2 +044300 END-ROUTINE-12. NC2524.2 +044400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2524.2 +044500 IF ERROR-COUNTER IS EQUAL TO ZERO NC2524.2 +044600 MOVE "NO " TO ERROR-TOTAL NC2524.2 +044700 ELSE NC2524.2 +044800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2524.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2524.2 +045000 PERFORM WRITE-LINE. NC2524.2 +045100 END-ROUTINE-13. NC2524.2 +045200 IF DELETE-COUNTER IS EQUAL TO ZERO NC2524.2 +045300 MOVE "NO " TO ERROR-TOTAL ELSE NC2524.2 +045400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2524.2 +045500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2524.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +045700 IF INSPECT-COUNTER EQUAL TO ZERO NC2524.2 +045800 MOVE "NO " TO ERROR-TOTAL NC2524.2 +045900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2524.2 +046000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2524.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +046200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +046300 WRITE-LINE. NC2524.2 +046400 ADD 1 TO RECORD-COUNT. NC2524.2 +046500Y IF RECORD-COUNT GREATER 50 NC2524.2 +046600Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2524.2 +046700Y MOVE SPACE TO DUMMY-RECORD NC2524.2 +046800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2524.2 +046900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2524.2 +047000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2524.2 +047100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2524.2 +047200Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2524.2 +047300Y MOVE ZERO TO RECORD-COUNT. NC2524.2 +047400 PERFORM WRT-LN. NC2524.2 +047500 WRT-LN. NC2524.2 +047600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2524.2 +047700 MOVE SPACE TO DUMMY-RECORD. NC2524.2 +047800 BLANK-LINE-PRINT. NC2524.2 +047900 PERFORM WRT-LN. NC2524.2 +048000 FAIL-ROUTINE. NC2524.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2524.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2524.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2524.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2524.2 +048500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +048600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2524.2 +048700 GO TO FAIL-ROUTINE-EX. NC2524.2 +048800 FAIL-ROUTINE-WRITE. NC2524.2 +048900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2524.2 +049000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2524.2 +049100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2524.2 +049200 MOVE SPACES TO COR-ANSI-REFERENCE. NC2524.2 +049300 FAIL-ROUTINE-EX. EXIT. NC2524.2 +049400 BAIL-OUT. NC2524.2 +049500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2524.2 +049600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2524.2 +049700 BAIL-OUT-WRITE. NC2524.2 +049800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2524.2 +049900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2524.2 +050000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +050100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2524.2 +050200 BAIL-OUT-EX. EXIT. NC2524.2 +050300 CCVS1-EXIT. NC2524.2 +050400 EXIT. NC2524.2 +050500 SECT-NC252A-001 SECTION. NC2524.2 +050600 RDF-INIT. NC2524.2 +050700 MOVE "REDEFINES " TO FEATURE. NC2524.2 +050800 RDF-TEST-1. NC2524.2 +050900 IF HARD NC2524.2 +051000 MOVE RDF3-5-15 TO COMPUTED-A NC2524.2 +051100 MOVE 6 TO CORRECT-A NC2524.2 +051200 PERFORM FAIL NC2524.2 +051300 GO TO RDF-WRITE-1. NC2524.2 +051400* NOTE 88 LEVEL CONDITION TEST ON REDEFINED FIELD. NC2524.2 +051500 PERFORM PASS. NC2524.2 +051600 GO TO RDF-WRITE-1. NC2524.2 +051700 RDF-DELETE-1. NC2524.2 +051800 PERFORM DE-LETE. NC2524.2 +051900 RDF-WRITE-1. NC2524.2 +052000 MOVE "RDF-TEST-1 " TO PAR-NAME. NC2524.2 +052100 PERFORM PRINT-DETAIL. NC2524.2 +052200 RDF-TEST-2. NC2524.2 +052300 IF RDF3-5-16 EQUAL TO 66 NC2524.2 +052400 PERFORM PASS NC2524.2 +052500 GO TO RDF-WRITE-2. NC2524.2 +052600* NOTE USING A RENAMES DATANAME THAT IS ALSO REDEFINED. NC2524.2 +052700 MOVE RDF3-5-16 TO COMPUTED-A. NC2524.2 +052800 MOVE 66 TO CORRECT-A. NC2524.2 +052900 PERFORM FAIL. NC2524.2 +053000 GO TO RDF-WRITE-2. NC2524.2 +053100 RDF-DELETE-2. NC2524.2 +053200 PERFORM DE-LETE. NC2524.2 +053300 RDF-WRITE-2. NC2524.2 +053400 MOVE "RDF-TEST-2 " TO PAR-NAME. NC2524.2 +053500 PERFORM PRINT-DETAIL. NC2524.2 +053600 RDF-TEST-003. NC2524.2 +053700 IF AN0002-O036F-X-0002 (8) EQUAL TO "LK" NC2524.2 +053800 PERFORM PASS NC2524.2 +053900 GO TO RDF-WRITE-003. NC2524.2 +054000* NC2524.2 +054100* NOTE REFERENCING SUBSCRIPTED DATA ITEM WHICH IS NC2524.2 +054200* SUBORDINATE TO A REDEFINES CLAUSE. NC2524.2 +054300* NC2524.2 +054400 MOVE AN0002-O036F-X-0002 (8) TO COMPUTED-A. NC2524.2 +054500 MOVE "LK" TO CORRECT-A. NC2524.2 +054600 PERFORM FAIL. NC2524.2 +054700 GO TO RDF-WRITE-003. NC2524.2 +054800 RDF-DELETE-003. NC2524.2 +054900 PERFORM DE-LETE. NC2524.2 +055000 RDF-WRITE-003. NC2524.2 +055100 MOVE "RDF-TEST-003" TO PAR-NAME. NC2524.2 +055200 PERFORM PRINT-DETAIL. NC2524.2 +055300 RDF-TEST-4. NC2524.2 +055400 IF RDFDATA7 EQUAL TO "ABC98765DE911644ALLD" NC2524.2 +055500 PERFORM PASS NC2524.2 +055600 GO TO RDF-WRITE-4. NC2524.2 +055700* NOTE THIS IS THE FIRST REFERENCE TO THESE REDEFINED NC2524.2 +055800* DATANAMES, SO, THE FIELDS CONTAIN THE WORKING-STORAGE NC2524.2 +055900* ASSIGNED VALUES. NC2524.2 +056000 MOVE RDFDATA7 TO COMPUTED-A. NC2524.2 +056100 MOVE "ABC98765DE911644ALLD" TO CORRECT-A. NC2524.2 +056200 PERFORM FAIL. NC2524.2 +056300 GO TO RDF-WRITE-4. NC2524.2 +056400 RDF-DELETE-4. NC2524.2 +056500 PERFORM DE-LETE. NC2524.2 +056600 RDF-WRITE-4. NC2524.2 +056700 MOVE "RDF-TEST-4 " TO PAR-NAME. NC2524.2 +056800 PERFORM PRINT-DETAIL. NC2524.2 +056900 RDF-TEST-5. NC2524.2 +057000 IF RDFDATA8 (13) EQUAL TO "HG" NC2524.2 +057100 PERFORM PASS NC2524.2 +057200 GO TO RDF-WRITE-5. NC2524.2 +057300 MOVE "HG" TO CORRECT-A. NC2524.2 +057400 MOVE RDFDATA8 (13) TO COMPUTED-A. NC2524.2 +057500 PERFORM FAIL. NC2524.2 +057600 GO TO RDF-WRITE-5. NC2524.2 +057700 RDF-DELETE-5. NC2524.2 +057800 PERFORM DE-LETE. NC2524.2 +057900 RDF-WRITE-5. NC2524.2 +058000 MOVE "RDF-TEST-5 " TO PAR-NAME. NC2524.2 +058100 PERFORM PRINT-DETAIL. NC2524.2 +058200 RDF-TEST-6. NC2524.2 +058300 IF RDFDATA2 EQUAL TO 9116.44 NC2524.2 +058400 PERFORM PASS NC2524.2 +058500 GO TO RDF-WRITE-6. NC2524.2 +058600 MOVE 9116.44 TO COMPUTED-N. NC2524.2 +058700 MOVE RDFDATA2 TO CORRECT-N. NC2524.2 +058800 PERFORM FAIL. NC2524.2 +058900 GO TO RDF-WRITE-6. NC2524.2 +059000 RDF-DELETE-6. NC2524.2 +059100 PERFORM DE-LETE. NC2524.2 +059200 RDF-WRITE-6. NC2524.2 +059300 MOVE "RDF-TEST-6 " TO PAR-NAME. NC2524.2 +059400 PERFORM PRINT-DETAIL. NC2524.2 +059500 RDF-TEST-7. NC2524.2 +059600 IF RDFDATA16 EQUAL TO 66 NC2524.2 +059700 PERFORM PASS NC2524.2 +059800 GO TO RDF-WRITE-7. NC2524.2 +059900 MOVE RDFDATA16 TO COMPUTED-A. NC2524.2 +060000 MOVE 66 TO CORRECT-A. NC2524.2 +060100 PERFORM FAIL. NC2524.2 +060200 GO TO RDF-WRITE-7. NC2524.2 +060300 RDF-DELETE-7. NC2524.2 +060400 PERFORM DE-LETE. NC2524.2 +060500 RDF-WRITE-7. NC2524.2 +060600 MOVE "RDF-TEST-7 " TO PAR-NAME. NC2524.2 +060700 PERFORM PRINT-DETAIL. NC2524.2 +060800 RDF-TEST-8. NC2524.2 +060900 MOVE SPACE TO REDEF12. NC2524.2 +061000 IF REDEF11 EQUAL TO SPACE NC2524.2 +061100 PERFORM PASS NC2524.2 +061200 GO TO RDF-WRITE-8. NC2524.2 +061300 MOVE "SPACE EXPECTED " TO CORRECT-A. NC2524.2 +061400 MOVE "NON BLANK CHARACTERS" TO COMPUTED-A. NC2524.2 +061500 MOVE "REDEF11 CONTAINS NON BLANKS" TO RE-MARK. NC2524.2 +061600 PERFORM FAIL. NC2524.2 +061700 GO TO RDF-WRITE-8. NC2524.2 +061800 RDF-DELETE-8. NC2524.2 +061900 PERFORM DE-LETE. NC2524.2 +062000 RDF-WRITE-8. NC2524.2 +062100 MOVE "RDF-TEST-8 " TO PAR-NAME. NC2524.2 +062200 PERFORM PRINT-DETAIL. NC2524.2 +062300 RDF-TEST-9. NC2524.2 +062400 MOVE ZERO TO REDEF12. NC2524.2 +062500 MOVE SPACE TO REDEF11. NC2524.2 +062600* NOTE CHECKS RDFDATA18 WHICH SHOULD NOT BE DISTURBED BY THE NC2524.2 +062700* MOVE SPACE STATEMENT TO A SHORTER REDEFINED AREA. NC2524.2 +062800 IF RDFDATA18 EQUAL TO ZERO NC2524.2 +062900 PERFORM PASS NC2524.2 +063000 GO TO RDF-WRITE-9. NC2524.2 +063100 MOVE "00000000000000" TO CORRECT-A. NC2524.2 +063200 MOVE RDFDATA18 TO COMPUTED-A. NC2524.2 +063300 PERFORM FAIL. NC2524.2 +063400 GO TO RDF-WRITE-9. NC2524.2 +063500 RDF-DELETE-9. NC2524.2 +063600 PERFORM DE-LETE. NC2524.2 +063700 RDF-WRITE-9. NC2524.2 +063800 MOVE "RDF-TEST-9 " TO PAR-NAME. NC2524.2 +063900 PERFORM PRINT-DETAIL. NC2524.2 +064000 RDF-TEST-10. NC2524.2 +064100 MOVE ZERO TO REDEF12. NC2524.2 +064200 MOVE "MOVING DATA TO A REDEFINED FIELD CAN BE RISKY " NC2524.2 +064300 TO REDEF10. NC2524.2 +064400 IF RDFDATA8 (14) EQUAL TO "00" NC2524.2 +064500 PERFORM PASS NC2524.2 +064600 GO TO RDF-WRITE-10. NC2524.2 +064700 MOVE 00 TO CORRECT-A. NC2524.2 +064800 MOVE RDFDATA8 (14) TO COMPUTED-A. NC2524.2 +064900 PERFORM FAIL. NC2524.2 +065000 GO TO RDF-WRITE-10. NC2524.2 +065100 RDF-DELETE-10. NC2524.2 +065200 PERFORM DE-LETE. NC2524.2 +065300 RDF-WRITE-10. NC2524.2 +065400 MOVE "RDF-TEST-10 " TO PAR-NAME. NC2524.2 +065500 PERFORM PRINT-DETAIL. NC2524.2 +065600 RDF-INIT-11. NC2524.2 +065700 MOVE REDEF13 TO REDEF12. NC2524.2 +065800 MOVE "RDF-TEST-11 " TO PAR-NAME. NC2524.2 +065900 RDF-TEST-11. NC2524.2 +066000 IF REDEF10 EQUAL TO NC2524.2 +066100 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" NC2524.2 +066200 PERFORM PASS NC2524.2 +066300 PERFORM PRINT-DETAIL NC2524.2 +066400 GO TO RDF-TEST-12. NC2524.2 +066500 MOVE 1 TO REC-CT. NC2524.2 +066600 MOVE REDEF10 TO WS-46. NC2524.2 +066700 MOVE "AAAAAAAAAAAAAAAAAAAA" TO CORRECT-A. NC2524.2 +066800 MOVE WS-1-20 TO COMPUTED-A. NC2524.2 +066900 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +067000 PERFORM FAIL. NC2524.2 +067100 PERFORM PRINT-DETAIL. NC2524.2 +067200 ADD 1 TO REC-CT. NC2524.2 +067300 MOVE "AAAAAAAAAAAAAAAAAAAA" TO CORRECT-A. NC2524.2 +067400 MOVE WS-21-40 TO COMPUTED-A. NC2524.2 +067500 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +067600 PERFORM FAIL. NC2524.2 +067700 PERFORM PRINT-DETAIL. NC2524.2 +067800 ADD 1 TO REC-CT. NC2524.2 +067900 MOVE "AAAAAA" TO CORRECT-A. NC2524.2 +068000 MOVE WS-41-46 TO COMPUTED-A. NC2524.2 +068100 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +068200 PERFORM FAIL. NC2524.2 +068300 PERFORM PRINT-DETAIL. NC2524.2 +068400 GO TO RDF-TEST-12. NC2524.2 +068500 RDF-DELETE-11. NC2524.2 +068600 PERFORM DE-LETE. NC2524.2 +068700 RDF-TEST-12. NC2524.2 +068800 MOVE 11 TO RDFDATA16. NC2524.2 +068900* NOTE 88 LEVEL TEST ON REDEFINED AREA. NC2524.2 +069000 IF SOFT NC2524.2 +069100 PERFORM PASS NC2524.2 +069200 ELSE NC2524.2 +069300 MOVE "CONDITION-NAME TEST" TO RE-MARK NC2524.2 +069400 PERFORM FAIL. NC2524.2 +069500 GO TO RDF-WRITE-12. NC2524.2 +069600 RDF-DELETE-12. NC2524.2 +069700 PERFORM DE-LETE. NC2524.2 +069800 RDF-WRITE-12. NC2524.2 +069900 MOVE "RDF-TEST-12" TO PAR-NAME. NC2524.2 +070000 PERFORM PRINT-DETAIL. NC2524.2 +070100 RDF-TEST-13. NC2524.2 +070200 MOVE REDEF13 TO REDEF12. NC2524.2 +070300 MOVE SPACE TO REDEF10. NC2524.2 +070400 IF RDF8-7 EQUAL TO SPACE NC2524.2 +070500 MOVE RDF8-7 TO COMPUTED-A NC2524.2 +070600 MOVE "AAAA" TO CORRECT-A NC2524.2 +070700 PERFORM FAIL NC2524.2 +070800 GO TO RDF-WRITE-13. NC2524.2 +070900 PERFORM PASS. NC2524.2 +071000 GO TO RDF-WRITE-13. NC2524.2 +071100 RDF-DELETE-13. NC2524.2 +071200 PERFORM DE-LETE. NC2524.2 +071300 RDF-WRITE-13. NC2524.2 +071400 MOVE "RDF-TEST-13 " TO PAR-NAME. NC2524.2 +071500 PERFORM PRINT-DETAIL. NC2524.2 +071600 RDF-TEST-14. NC2524.2 +071700 MOVE SPACE TO REDEF12. NC2524.2 +071800 MOVE REDEF13 TO REDEF10. NC2524.2 +071900 IF RDF8-3 EQUAL TO "AAAAAAAAA" NC2524.2 +072000 MOVE RDF8-3 TO COMPUTED-A NC2524.2 +072100 MOVE SPACE TO CORRECT-A NC2524.2 +072200 PERFORM FAIL NC2524.2 +072300 GO TO RDF-WRITE-14. NC2524.2 +072400 PERFORM PASS. NC2524.2 +072500 GO TO RDF-WRITE-14. NC2524.2 +072600 RDF-DELETE-14. NC2524.2 +072700 PERFORM DE-LETE. NC2524.2 +072800 RDF-WRITE-14. NC2524.2 +072900 MOVE "RDF-TEST-14 " TO PAR-NAME. NC2524.2 +073000 PERFORM PRINT-DETAIL. NC2524.2 +073100 RNM-INIT. NC2524.2 +073200 PERFORM END-ROUTINE. NC2524.2 +073300 MOVE "RENAMES" TO FEATURE. NC2524.2 +073400 RENAM-TEST-1. NC2524.2 +073500 MOVE "AB" TO NAME1A. NC2524.2 +073600 MOVE "CD" TO NAME1B. NC2524.2 +073700 IF RENAME4 EQUAL TO "ABCD " NC2524.2 +073800 PERFORM PASS NC2524.2 +073900 GO TO RNM-WRITE-1. NC2524.2 +074000 MOVE RENAME4 TO COMPUTED-A. NC2524.2 +074100 MOVE "ABCD" TO CORRECT-A. NC2524.2 +074200* NOTE CORRECT ANSWER IS ABCD-BLANK. NC2524.2 +074300 PERFORM FAIL. NC2524.2 +074400 GO TO RNM-WRITE-1. NC2524.2 +074500 RNM-DELETE-1. NC2524.2 +074600 PERFORM DE-LETE. NC2524.2 +074700 RNM-WRITE-1. NC2524.2 +074800 MOVE "RENAM-TEST-1" TO PAR-NAME. NC2524.2 +074900 PERFORM PRINT-DETAIL. NC2524.2 +075000 RENAM-TEST-2. NC2524.2 +075100 MOVE ALL "A" TO RENAMES-DATA. NC2524.2 +075200 IF RENAME3 EQUAL TO "AAAAAAAAAA" NC2524.2 +075300 PERFORM PASS NC2524.2 +075400 GO TO RNM-WRITE-2. NC2524.2 +075500 MOVE RENAME3 TO COMPUTED-A. NC2524.2 +075600 MOVE "AAAAAAAAAA" TO CORRECT-A. NC2524.2 +075700 PERFORM FAIL. NC2524.2 +075800 GO TO RNM-WRITE-2. NC2524.2 +075900 RNM-DELETE-2. NC2524.2 +076000 PERFORM DE-LETE. NC2524.2 +076100 RNM-WRITE-2. NC2524.2 +076200 MOVE "RENAM-TEST-2" TO PAR-NAME. NC2524.2 +076300 PERFORM PRINT-DETAIL. NC2524.2 +076400 RENAM-TEST-3. NC2524.2 +076500 MOVE ALL "A" TO RENAMES-DATA. NC2524.2 +076600 MOVE ALL "X" TO RENAME1. NC2524.2 +076700 IF NAME1 NOT EQUAL TO "XXXXX" GO TO RNM-FAIL-3. NC2524.2 +076800 IF NAME2 NOT EQUAL TO "XXXXXXXXXX" GO TO RNM-FAIL-3. NC2524.2 +076900 IF NAME3 NOT EQUAL TO "XXXXX" GO TO RNM-FAIL-3. NC2524.2 +077000 PERFORM PASS. NC2524.2 +077100 GO TO RNM-WRITE-3. NC2524.2 +077200 RNM-DELETE-3. NC2524.2 +077300 PERFORM DE-LETE. NC2524.2 +077400 GO TO RNM-WRITE-3. NC2524.2 +077500 RNM-FAIL-3. NC2524.2 +077600 MOVE RENAMES-DATA TO COMPUTED-A. NC2524.2 +077700 MOVE "XXXXXXXXXXXXXXXXXXXX" TO CORRECT-A. NC2524.2 +077800 PERFORM FAIL. NC2524.2 +077900 RNM-WRITE-3. NC2524.2 +078000 MOVE "RENAM-TEST-3" TO PAR-NAME. NC2524.2 +078100 PERFORM PRINT-DETAIL. NC2524.2 +078200 RENAM-TEST-4. NC2524.2 +078300 IF RENAMES-TEST-1 EQUAL TO 123 NC2524.2 +078400 PERFORM PASS NC2524.2 +078500 GO TO RENAM-WRITE-4. NC2524.2 +078600 MOVE RENAMES-TEST-1 TO COMPUTED-A. NC2524.2 +078700 MOVE 123 TO CORRECT-A. NC2524.2 +078800 PERFORM FAIL. NC2524.2 +078900 GO TO RENAM-WRITE-4. NC2524.2 +079000 RENAM-DELETE-4. NC2524.2 +079100 PERFORM DE-LETE. NC2524.2 +079200 RENAM-WRITE-4. NC2524.2 +079300 MOVE "RENAM-TEST-4" TO PAR-NAME. NC2524.2 +079400 PERFORM PRINT-DETAIL. NC2524.2 +079500 RENAM-TEST-5. NC2524.2 +079600 IF RENAMES-TEST-3 EQUAL TO "X 123" NC2524.2 +079700 PERFORM PASS NC2524.2 +079800 GO TO RENAM-WRITE-5. NC2524.2 +079900 MOVE RENAMES-TEST-3 TO COMPUTED-A. NC2524.2 +080000 MOVE "X 123" TO CORRECT-A. NC2524.2 +080100 PERFORM FAIL. NC2524.2 +080200 GO TO RENAM-WRITE-5. NC2524.2 +080300 RENAM-DELETE-5. NC2524.2 +080400 PERFORM DE-LETE. NC2524.2 +080500 RENAM-WRITE-5. NC2524.2 +080600 MOVE "RENAM-TEST-5" TO PAR-NAME. NC2524.2 +080700 PERFORM PRINT-DETAIL. NC2524.2 +080800 RENAM-TEST-6. NC2524.2 +080900 IF RENAMES-TEST-4 EQUAL TO "X 123" NC2524.2 +081000 PERFORM PASS NC2524.2 +081100 GO TO RENAM-WRITE-6. NC2524.2 +081200 MOVE RENAMES-TEST-4 TO COMPUTED-A. NC2524.2 +081300 MOVE "X 123" TO CORRECT-A. NC2524.2 +081400 PERFORM FAIL. NC2524.2 +081500 GO TO RENAM-WRITE-6. NC2524.2 +081600 RENAM-DELETE-6. NC2524.2 +081700 PERFORM DE-LETE. NC2524.2 +081800 RENAM-WRITE-6. NC2524.2 +081900 MOVE "RENAM-TEST-6" TO PAR-NAME. NC2524.2 +082000 PERFORM PRINT-DETAIL. NC2524.2 +082100 RENAM-TEST-7. NC2524.2 +082200 IF RENAMES-TEST-2 EQUAL TO "X " NC2524.2 +082300 PERFORM PASS NC2524.2 +082400 GO TO RENAM-WRITE-7. NC2524.2 +082500 MOVE RENAMES-TEST-2 TO COMPUTED-A. NC2524.2 +082600 MOVE "X " TO CORRECT-A. NC2524.2 +082700 PERFORM FAIL. NC2524.2 +082800 GO TO RENAM-WRITE-7. NC2524.2 +082900 RENAM-DELETE-7. NC2524.2 +083000 PERFORM DE-LETE. NC2524.2 +083100 RENAM-WRITE-7. NC2524.2 +083200 MOVE "RENAM-TEST-7" TO PAR-NAME. NC2524.2 +083300 PERFORM PRINT-DETAIL. NC2524.2 +083400 RENAM-INIT-C. NC2524.2 +083500 MOVE "QUALIFIED RENAMES" TO FEATURE. NC2524.2 +083600 RENAM-TEST-8. NC2524.2 +083700 MOVE "IOWA" TO TAG-1A. NC2524.2 +083800 MOVE "OREGON" TO TAG-1B. NC2524.2 +083900 MOVE "CALIFORNIA" TO RENAME-5 OF T-RENAMES-DATA. NC2524.2 +084000 IF TAG-1 EQUAL TO "CALIFORNIA" NC2524.2 +084100 PERFORM PASS GO TO RENAM-WRITE-8. NC2524.2 +084200 GO TO RENAM-FAIL-8. NC2524.2 +084300 RENAM-DELETE-8. NC2524.2 +084400 PERFORM DE-LETE. NC2524.2 +084500 GO TO RENAM-WRITE-8. NC2524.2 +084600 RENAM-FAIL-8. NC2524.2 +084700 PERFORM FAIL. NC2524.2 +084800 MOVE TAG-1 TO COMPUTED-A. NC2524.2 +084900 MOVE "CALIFORNIA" TO CORRECT-A. NC2524.2 +085000 RENAM-WRITE-8. NC2524.2 +085100 MOVE "RENAM-TEST-8 " TO PAR-NAME. NC2524.2 +085200 PERFORM PRINT-DETAIL. NC2524.2 +085300 RENAM-TEST-9. NC2524.2 +085400 IF UNIT-1 EQUAL TO "VERMONTOHIO" NC2524.2 +085500 PERFORM PASS GO TO RENAM-WRITE-9. NC2524.2 +085600* NOTE THIS TEST FURTHER CHECKS THE RESULTS OF NC2524.2 +085700* THE PREVIOUS TEST - THIS ITEM SHOULD BE UNCHANGED. NC2524.2 +085800 GO TO RENAM-FAIL-9. NC2524.2 +085900 RENAM-DELETE-9. NC2524.2 +086000 PERFORM DE-LETE. NC2524.2 +086100 GO TO RENAM-WRITE-9. NC2524.2 +086200 RENAM-FAIL-9. NC2524.2 +086300 PERFORM FAIL. NC2524.2 +086400 MOVE UNIT-1 TO COMPUTED-A. NC2524.2 +086500 MOVE "VERMONTOHIO" TO CORRECT-A. NC2524.2 +086600 RENAM-WRITE-9. NC2524.2 +086700 MOVE "RENAM-TEST-9 " TO PAR-NAME. NC2524.2 +086800 PERFORM PRINT-DETAIL. NC2524.2 +086900 RENAM-TEST-10. NC2524.2 +087000 MOVE "IOWAOREGONFLORIDA" TO T-RENAMES-DATA. NC2524.2 +087100 IF RENAME-6 IN T-RENAMES-DATA EQUAL TO NC2524.2 +087200 "IOWAOREGONFLORIDA" NC2524.2 +087300 PERFORM PASS GO TO RENAM-WRITE-10. NC2524.2 +087400 GO TO RENAM-FAIL-10. NC2524.2 +087500 RENAM-DELETE-10. NC2524.2 +087600 PERFORM DE-LETE. NC2524.2 +087700 GO TO RENAM-WRITE-10. NC2524.2 +087800 RENAM-FAIL-10. NC2524.2 +087900 PERFORM FAIL. NC2524.2 +088000 MOVE RENAME-6 IN T-RENAMES-DATA TO COMPUTED-A. NC2524.2 +088100 MOVE "IOWAOREGONFLORIDA" TO CORRECT-A. NC2524.2 +088200 RENAM-WRITE-10. NC2524.2 +088300 MOVE "RENAM-TEST-10" TO PAR-NAME. NC2524.2 +088400 PERFORM PRINT-DETAIL. NC2524.2 +088500 RENAM-TEST-11. NC2524.2 +088600 MOVE "BOSTO" TO ITEM-1. NC2524.2 +088700 MOVE "N M" TO TABLE-ITEM-2 (1). NC2524.2 +088800 MOVE "ASS" TO TABLE-ITEM-2 (2). NC2524.2 +088900 MOVE "ACH" TO TABLE-ITEM-2 (3). NC2524.2 +089000 MOVE "USE" TO TABLE-ITEM-2 (4). NC2524.2 +089100 MOVE "TTS" TO TABLE-ITEM-2 (5). NC2524.2 +089200 IF RENAME-7 EQUAL TO "BOSTON MASSACHUSETTS" NC2524.2 +089300 PERFORM PASS GO TO RENAM-WRITE-11. NC2524.2 +089400 GO TO RENAM-FAIL-11. NC2524.2 +089500 RENAM-DELETE-11. NC2524.2 +089600 PERFORM DE-LETE. NC2524.2 +089700 GO TO RENAM-WRITE-11. NC2524.2 +089800 RENAM-FAIL-11. NC2524.2 +089900 PERFORM FAIL. NC2524.2 +090000 MOVE RENAME-7 TO COMPUTED-A. NC2524.2 +090100 MOVE "BOSTON MASSACHUSETTS" TO CORRECT-A. NC2524.2 +090200 RENAM-WRITE-11. NC2524.2 +090300 MOVE "RENAMES A TABLE" TO FEATURE. NC2524.2 +090400 MOVE "RENAM-TEST-11" TO PAR-NAME. NC2524.2 +090500 PERFORM PRINT-DETAIL. NC2524.2 +090600 RENAM-INIT-D. NC2524.2 +090700 MOVE "RENAMED DATA ---" TO FEATURE. NC2524.2 +090800 PERFORM PRINT-DETAIL. NC2524.2 +090900 RENAM-TEST-12. NC2524.2 +091000 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +091100 MOVE 12.3 TO WIDGET-1. NC2524.2 +091200 MOVE 45678.9 TO WIDGET-2. NC2524.2 +091300 MOVE ZERO TO WIDGET-3. NC2524.2 +091400 IF RENAME-8 EQUAL TO "123*45,678.900000" NC2524.2 +091500 PERFORM PASS GO TO RENAM-WRITE-12. NC2524.2 +091600 GO TO RENAM-FAIL-12. NC2524.2 +091700 RENAM-DELETE-12. NC2524.2 +091800 PERFORM DE-LETE. NC2524.2 +091900 GO TO RENAM-WRITE-12. NC2524.2 +092000 RENAM-FAIL-12. NC2524.2 +092100 PERFORM FAIL. NC2524.2 +092200 MOVE RENAME-8 TO COMPUTED-A. NC2524.2 +092300 MOVE "123*45,678.900000" TO CORRECT-A. NC2524.2 +092400 RENAM-WRITE-12. NC2524.2 +092500 MOVE " GROUP COMPARISON" TO FEATURE NC2524.2 +092600 MOVE "RENAM-TEST-12" TO PAR-NAME. NC2524.2 +092700 PERFORM PRINT-DETAIL. NC2524.2 +092800 RENAM-TEST-13. NC2524.2 +092900 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +093000 MOVE "123456789" TO RENAME-10. NC2524.2 +093100 IF RENAME-9 EQUAL TO " 12345678" NC2524.2 +093200 PERFORM PASS GO TO RENAM-WRITE-13. NC2524.2 +093300 GO TO RENAM-FAIL-13. NC2524.2 +093400 RENAM-DELETE-13. NC2524.2 +093500 PERFORM DE-LETE. NC2524.2 +093600 GO TO RENAM-WRITE-13. NC2524.2 +093700 RENAM-FAIL-13. NC2524.2 +093800 PERFORM FAIL. NC2524.2 +093900 MOVE RENAME-9 TO COMPUTED-A NC2524.2 +094000 MOVE " 12345678" TO CORRECT-A. NC2524.2 +094100 RENAM-WRITE-13. NC2524.2 +094200 MOVE " GRP MOVE, COMPARE" TO FEATURE. NC2524.2 +094300 MOVE "RENAM-TEST-13" TO PAR-NAME. NC2524.2 +094400 PERFORM PRINT-DETAIL. NC2524.2 +094500 RENAM-TEST-14. NC2524.2 +094600 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +094700 MOVE 123456 TO RENAME-10 NC2524.2 +094800 IF WIDGET-4 EQUAL TO 1234 NC2524.2 +094900 PERFORM PASS GO TO RENAM-WRITE-14. NC2524.2 +095000 GO TO RENAM-FAIL-14. NC2524.2 +095100 RENAM-DELETE-14. NC2524.2 +095200 PERFORM DE-LETE. NC2524.2 +095300 GO TO RENAM-WRITE-14. NC2524.2 +095400 RENAM-FAIL-14. NC2524.2 +095500 PERFORM FAIL. NC2524.2 +095600 MOVE WIDGET-4 TO COMPUTED-N. NC2524.2 +095700 MOVE 1234 TO CORRECT-N. NC2524.2 +095800 RENAM-WRITE-14. NC2524.2 +095900 MOVE " GROUP MOVE" TO FEATURE. NC2524.2 +096000 MOVE "RENAM-TEST-14" TO PAR-NAME. NC2524.2 +096100 PERFORM PRINT-DETAIL. NC2524.2 +096200 RENAM-TEST-15. NC2524.2 +096300 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +096400 MOVE 234.5 TO RENAME-11. NC2524.2 +096500 IF WIDGET-2 EQUAL TO "****234.50" NC2524.2 +096600 PERFORM PASS GO TO RENAM-WRITE-15. NC2524.2 +096700 GO TO RENAM-FAIL-15. NC2524.2 +096800 RENAM-DELETE-15. NC2524.2 +096900 PERFORM DE-LETE. NC2524.2 +097000 GO TO RENAM-WRITE-15. NC2524.2 +097100 RENAM-FAIL-15. NC2524.2 +097200 PERFORM FAIL. NC2524.2 +097300 MOVE WIDGET-2 TO COMPUTED-A. NC2524.2 +097400 MOVE "****234.50" TO CORRECT-A. NC2524.2 +097500 RENAM-WRITE-15. NC2524.2 +097600 MOVE " EDITED MOVE" TO FEATURE. NC2524.2 +097700 MOVE "RENAM-TEST-15" TO PAR-NAME. NC2524.2 +097800 PERFORM PRINT-DETAIL. NC2524.2 +097900 RENAM-INIT-E. NC2524.2 +098000 MOVE " ADD, SIZE ERROR" TO FEATURE. NC2524.2 +098100* NOTE THE NEXT TWO TESTS ARE INTERRELATED. NC2524.2 +098200 RENAM-TEST-16. NC2524.2 +098300 MOVE 8000 TO WIDGET-4. NC2524.2 +098400 ADD 3500 TO RENAME-12 ON SIZE ERROR NC2524.2 +098500 PERFORM PASS GO TO RENAM-WRITE-16. NC2524.2 +098600 GO TO RENAM-FAIL-16. NC2524.2 +098700 RENAM-DELETE-16. NC2524.2 +098800 PERFORM DE-LETE. NC2524.2 +098900 GO TO RENAM-WRITE-16. NC2524.2 +099000 RENAM-FAIL-16. NC2524.2 +099100 PERFORM FAIL. NC2524.2 +099200 MOVE "SIZE ERROR DID NOT OCCUR" TO RE-MARK. NC2524.2 +099300 RENAM-WRITE-16. NC2524.2 +099400 MOVE "RENAM-TEST-16" TO PAR-NAME. NC2524.2 +099500 PERFORM PRINT-DETAIL. NC2524.2 +099600 RENAM-TEST-17. NC2524.2 +099700 IF RENAME-12 EQUAL TO 8000 NC2524.2 +099800 PERFORM PASS GO TO RENAM-WRITE-17. NC2524.2 +099900 GO TO RENAM-FAIL-17. NC2524.2 +100000 RENAM-DELETE-17. NC2524.2 +100100 PERFORM DE-LETE. NC2524.2 +100200 GO TO RENAM-WRITE-17. NC2524.2 +100300 RENAM-FAIL-17. NC2524.2 +100400 PERFORM FAIL. NC2524.2 +100500 MOVE RENAME-12 TO COMPUTED-N. NC2524.2 +100600 MOVE 8000 TO CORRECT-N. NC2524.2 +100700 RENAM-WRITE-17. NC2524.2 +100800 MOVE "RENAM-TEST-17" TO PAR-NAME. NC2524.2 +100900 PERFORM PRINT-DETAIL. NC2524.2 +101000 RENAM-TEST-18. NC2524.2 +101100 MOVE SPACE TO U-RENAMES-DATA. NC2524.2 +101200 MOVE "CHICAGO ILLINOIS" TO RENAME-5 OF U-RENAMES-DATA. NC2524.2 +101300 IF U-RENAMES-DATA EQUAL TO "CHICAGO ILL " NC2524.2 +101400 PERFORM PASS GO TO RENAM-WRITE-18. NC2524.2 +101500 PERFORM FAIL. NC2524.2 +101600 GO TO RENAM-FAIL-18. NC2524.2 +101700 RENAM-DELETE-18. NC2524.2 +101800 PERFORM DE-LETE. NC2524.2 +101900 GO TO RENAM-WRITE-18. NC2524.2 +102000 RENAM-FAIL-18. NC2524.2 +102100 PERFORM FAIL. NC2524.2 +102200 MOVE U-RENAMES-DATA TO COMPUTED-A. NC2524.2 +102300 MOVE "CHICAGO ILL " TO CORRECT-A. NC2524.2 +102400 RENAM-WRITE-18. NC2524.2 +102500 MOVE " THROUGH" TO FEATURE. NC2524.2 +102600 MOVE "RENAM-TEST-18" TO PAR-NAME. NC2524.2 +102700 PERFORM PRINT-DETAIL. NC2524.2 +102800* NC2524.2 +102900 COMPUTING SECTION. NC2524.2 +103000 COMPUTE-INIT. NC2524.2 +103100 MOVE SPACES TO TEST-RESULTS. NC2524.2 +103200 PERFORM END-ROUTINE. NC2524.2 +103300 MOVE "THE COMPUTED RESULT FOR THE FOLLOWING TESTS" NC2524.2 +103400 TO RE-MARK. NC2524.2 +103500 PERFORM PRINT-DETAIL. NC2524.2 +103600 MOVE "IS ALLOWED TO DEVIATE FROM THE INDICATED" NC2524.2 +103700 TO RE-MARK. NC2524.2 +103800 PERFORM PRINT-DETAIL. NC2524.2 +103900 MOVE "CORRECT RESULT BY" TO RE-MARK. NC2524.2 +104000 PERFORM PRINT-DETAIL. NC2524.2 +104100 MOVE "+ OR - (CORRECT RESULT * (.2 ** 5))." NC2524.2 +104200 TO RE-MARK. NC2524.2 +104300 PERFORM PRINT-DETAIL. NC2524.2 +104400 MOVE "COMPUTE " TO FEATURE. NC2524.2 +104500 COMP-TEST-1. NC2524.2 +104600 COMPUTE COMPUTE-1 = COMPUTE-1A. NC2524.2 +104700 IF ( COMPUTE-1 < 654.20038) AND NC2524.2 +104800 ( COMPUTE-1 > 654.17422) THEN NC2524.2 +104900 PERFORM PASS NC2524.2 +105000 GO TO COMP-WRITE-1. NC2524.2 +105100 PERFORM FAIL. NC2524.2 +105200 MOVE COMPUTE-1 TO COMPUTED-N. NC2524.2 +105300 MOVE "+654.1873" TO CORRECT-A. NC2524.2 +105400 GO TO COMP-WRITE-1. NC2524.2 +105500 COMP-DELETE-1. NC2524.2 +105600 PERFORM DE-LETE. NC2524.2 +105700 COMP-WRITE-1. NC2524.2 +105800 MOVE "COMP-TEST-1" TO PAR-NAME. NC2524.2 +105900 PERFORM PRINT-DETAIL. NC2524.2 +106000 COMP-TEST-2. NC2524.2 +106100 COMPUTE COMPUTE-2 = 2233.9 NC2524.2 +106200 IF ( COMPUTE-2 < 2233.94468) AND NC2524.2 +106300 ( COMPUTE-2 > 2233.85532) THEN NC2524.2 +106400 PERFORM PASS NC2524.2 +106500 GO TO COMP-WRITE-2. NC2524.2 +106600 PERFORM FAIL. NC2524.2 +106700 MOVE COMPUTE-2 TO COMPUTED-N. NC2524.2 +106800 MOVE "+2233.9" TO CORRECT-A. NC2524.2 +106900 GO TO COMP-WRITE-2. NC2524.2 +107000 COMP-DELETE-2. NC2524.2 +107100 PERFORM DE-LETE. NC2524.2 +107200 COMP-WRITE-2. NC2524.2 +107300 MOVE "COMP-TEST-2" TO PAR-NAME. NC2524.2 +107400 PERFORM PRINT-DETAIL. NC2524.2 +107500 COMP-TEST-3. NC2524.2 +107600 COMPUTE COMPUTE-3 = COMPUTE-3A - COMPUTE-3B. NC2524.2 +107700 IF ( COMPUTE-3 NOT < 52.39105) AND NC2524.2 +107800 ( COMPUTE-3 NOT > 52.38895) THEN NC2524.2 +107900 PERFORM FAIL NC2524.2 +108000 MOVE COMPUTE-3 TO COMPUTED-N NC2524.2 +108100 MOVE "+52.39" TO CORRECT-A NC2524.2 +108200 GO TO COMP-WRITE-3. NC2524.2 +108300 PERFORM PASS. NC2524.2 +108400 GO TO COMP-WRITE-3. NC2524.2 +108500 COMP-DELETE-3. NC2524.2 +108600 PERFORM DE-LETE. NC2524.2 +108700 COMP-WRITE-3. NC2524.2 +108800 MOVE "COMP-TEST-3" TO PAR-NAME. NC2524.2 +108900 PERFORM PRINT-DETAIL. NC2524.2 +109000 COMP-TEST-4. NC2524.2 +109100 COMPUTE COMPUTE-4 = COMPUTE-4A + COMPUTE-4B. NC2524.2 +109200 IF COMPUTE-4 NOT = 341 NC2524.2 +109300 PERFORM FAIL NC2524.2 +109400 MOVE COMPUTE-4 TO COMPUTED-N NC2524.2 +109500 MOVE "+341" TO CORRECT-A NC2524.2 +109600 GO TO COMP-WRITE-4. NC2524.2 +109700 PERFORM PASS. NC2524.2 +109800 GO TO COMP-WRITE-4. NC2524.2 +109900 COMP-DELETE-4. NC2524.2 +110000 PERFORM DE-LETE. NC2524.2 +110100 COMP-WRITE-4. NC2524.2 +110200 MOVE "COMP-TEST-4" TO PAR-NAME. NC2524.2 +110300 PERFORM PRINT-DETAIL. NC2524.2 +110400 COMP-TEST-5. NC2524.2 +110500 COMPUTE COMPUTE-5 = COMPUTE-5A * 36.1 NC2524.2 +110600 IF ( COMPUTE-5 > 400.71801) OR NC2524.2 +110700 ( COMPUTE-5 < 400.70199) THEN NC2524.2 +110800 PERFORM FAIL NC2524.2 +110900 MOVE COMPUTE-5 TO COMPUTED-N NC2524.2 +111000 MOVE "+400.71" TO CORRECT-A NC2524.2 +111100 GO TO COMP-WRITE-5. NC2524.2 +111200 PERFORM PASS. NC2524.2 +111300 GO TO COMP-WRITE-5. NC2524.2 +111400 COMP-DELETE-5. NC2524.2 +111500 PERFORM DE-LETE. NC2524.2 +111600 COMP-WRITE-5. NC2524.2 +111700 MOVE "COMP-TEST-5" TO PAR-NAME. NC2524.2 +111800 PERFORM PRINT-DETAIL. NC2524.2 +111900 COMP-TEST-6. NC2524.2 +112000 COMPUTE COMPUTE-6 = COMPUTE-6A / 6.0 NC2524.2 +112100 IF ( COMPUTE-6 > 62.40125) OR NC2524.2 +112200 ( COMPUTE-6 < 62.39875) THEN NC2524.2 +112300 PERFORM FAIL NC2524.2 +112400 MOVE COMPUTE-6 TO COMPUTED-N NC2524.2 +112500 MOVE "+062.40" TO CORRECT-A NC2524.2 +112600 GO TO COMP-WRITE-6. NC2524.2 +112700 PERFORM PASS. NC2524.2 +112800 GO TO COMP-WRITE-6. NC2524.2 +112900 COMP-DELETE-6. NC2524.2 +113000 PERFORM DE-LETE. NC2524.2 +113100 COMP-WRITE-6. NC2524.2 +113200 MOVE "COMP-TEST-6" TO PAR-NAME. NC2524.2 +113300 PERFORM PRINT-DETAIL. NC2524.2 +113400 COMP-TEST-7. NC2524.2 +113500 COMPUTE COMPUTE-7 = 2.0 ** 4. NC2524.2 +113600 IF COMPUTE-7 = 16 NC2524.2 +113700 PERFORM PASS NC2524.2 +113800 GO TO COMP-WRITE-7. NC2524.2 +113900 PERFORM FAIL. NC2524.2 +114000 MOVE COMPUTE-7 TO COMPUTED-N. NC2524.2 +114100 MOVE "+16" TO CORRECT-A. NC2524.2 +114200 GO TO COMP-WRITE-7. NC2524.2 +114300 COMP-DELETE-7. NC2524.2 +114400 PERFORM DE-LETE. NC2524.2 +114500 COMP-WRITE-7. NC2524.2 +114600 MOVE "COMP-TEST-7" TO PAR-NAME. NC2524.2 +114700 PERFORM PRINT-DETAIL. NC2524.2 +114800 COMP-TEST-8. NC2524.2 +114900 COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2. NC2524.2 +115000 IF COMPUTE-8 = 100 NC2524.2 +115100 PERFORM PASS NC2524.2 +115200 GO TO COMP-WRITE-8. NC2524.2 +115300 PERFORM FAIL. NC2524.2 +115400 MOVE COMPUTE-8 TO COMPUTED-N. NC2524.2 +115500 MOVE "+100" TO CORRECT-A. NC2524.2 +115600 GO TO COMP-WRITE-8. NC2524.2 +115700 COMP-DELETE-8. NC2524.2 +115800 PERFORM DE-LETE. NC2524.2 +115900 COMP-WRITE-8. NC2524.2 +116000 MOVE "COMP-TEST-8" TO PAR-NAME. NC2524.2 +116100 PERFORM PRINT-DETAIL. NC2524.2 +116200 COMP-TEST-9. NC2524.2 +116300 COMPUTE COMPUTE-9 ROUNDED = COMPUTE-6A * 7.0 NC2524.2 +116400 IF (COMPUTE-9 > 2621.05242) OR NC2524.2 +116500 (COMPUTE-9 < 2620.94758) THEN NC2524.2 +116600 PERFORM FAIL NC2524.2 +116700 MOVE COMPUTE-9 TO COMPUTED-N NC2524.2 +116800 MOVE "+2621" TO CORRECT-A NC2524.2 +116900 GO TO COMP-WRITE-9. NC2524.2 +117000 PERFORM PASS. NC2524.2 +117100 GO TO COMP-WRITE-9. NC2524.2 +117200 COMP-DELETE-9. NC2524.2 +117300 PERFORM DE-LETE. NC2524.2 +117400 COMP-WRITE-9. NC2524.2 +117500 MOVE "COMP-TEST-9" TO PAR-NAME. NC2524.2 +117600 PERFORM PRINT-DETAIL. NC2524.2 +117700 COMP-TEST-10. NC2524.2 +117800 COMPUTE COMPUTE-10 = COMPUTE-1A + COMPUTE-6A ON SIZE ERROR NC2524.2 +117900 MOVE "R" TO XRAY. NC2524.2 +118000 IF XRAY EQUAL TO "R" NC2524.2 +118100 PERFORM PASS NC2524.2 +118200 GO TO COMP-WRITE-10. NC2524.2 +118300 PERFORM FAIL. NC2524.2 +118400 MOVE "OSE NOT EXECUTED" TO RE-MARK. NC2524.2 +118500 GO TO COMP-WRITE-10. NC2524.2 +118600 COMP-DELETE-10. NC2524.2 +118700 PERFORM DE-LETE. NC2524.2 +118800 COMP-WRITE-10. NC2524.2 +118900 MOVE "COMP-TEST-10" TO PAR-NAME. NC2524.2 +119000 PERFORM PRINT-DETAIL. NC2524.2 +119100 COMP-TEST-11. NC2524.2 +119200 IF (COMPUTE-10 > 0.00002) OR NC2524.2 +119300 (COMPUTE-10 < -0.00002) NC2524.2 +119400 PERFORM FAIL NC2524.2 +119500 MOVE COMPUTE-10 TO COMPUTED-N NC2524.2 +119600 MOVE ZERO TO CORRECT-N NC2524.2 +119700 GO TO COMP-WRITE-11. NC2524.2 +119800 PERFORM PASS. NC2524.2 +119900 GO TO COMP-WRITE-11. NC2524.2 +120000 COMP-DELETE-11. NC2524.2 +120100 PERFORM DE-LETE. NC2524.2 +120200 COMP-WRITE-11. NC2524.2 +120300 MOVE "COMP-TEST-11" TO PAR-NAME. NC2524.2 +120400 PERFORM PRINT-DETAIL. NC2524.2 +120500 COMP-TEST-12. NC2524.2 +120600 COMPUTE COMPUTE-11 = COMPUTE-11A + COMPUTE-11B - 121.6 NC2524.2 +120700 IF ( COMPUTE-11 < 718.51437) AND NC2524.2 +120800 ( COMPUTE-11 > 718.48563) THEN NC2524.2 +120900 PERFORM PASS NC2524.2 +121000 GO TO COMP-WRITE-12. NC2524.2 +121100 PERFORM FAIL. NC2524.2 +121200 MOVE COMPUTE-11 TO COMPUTED-N. NC2524.2 +121300 MOVE "+718.5" TO CORRECT-A. NC2524.2 +121400 GO TO COMP-WRITE-12. NC2524.2 +121500 COMP-DELETE-12. NC2524.2 +121600 PERFORM DE-LETE. NC2524.2 +121700 COMP-WRITE-12. NC2524.2 +121800 MOVE "COMP-TEST-12" TO PAR-NAME. NC2524.2 +121900 PERFORM PRINT-DETAIL. NC2524.2 +122000 COMP-TEST-13. NC2524.2 +122100 COMPUTE COMPUTE-12 = COMPUTE-12A * 5.1 / 281.7. NC2524.2 +122200 IF (COMPUTE-12 < 6.09012) AND NC2524.2 +122300 (COMPUTE-12 > 6.08988) THEN NC2524.2 +122400 PERFORM PASS NC2524.2 +122500 GO TO COMP-WRITE-13. NC2524.2 +122600 PERFORM FAIL. NC2524.2 +122700 MOVE COMPUTE-12 TO COMPUTED-N. NC2524.2 +122800 MOVE "+6.09" TO CORRECT-A. NC2524.2 +122900 GO TO COMP-WRITE-13. NC2524.2 +123000 COMP-DELETE-13. NC2524.2 +123100 PERFORM DE-LETE. NC2524.2 +123200 COMP-WRITE-13. NC2524.2 +123300 MOVE "COMP-TEST-13" TO PAR-NAME. NC2524.2 +123400 PERFORM PRINT-DETAIL. NC2524.2 +123500 COMPUTE-ROUTINE SECTION. NC2524.2 +123600 COMPUTE-TEST. NC2524.2 +123700 MOVE "COMPUTE" TO FEATURE. NC2524.2 +123800 MOVE ZERO TO W-1. NC2524.2 +123900 MOVE ZERO TO W-2. NC2524.2 +124000 COMP-TEST-14. NC2524.2 +124100 COMPUTE W-1 = NINE. NC2524.2 +124200 IF W-1 = 9 NC2524.2 +124300 PERFORM PASS NC2524.2 +124400 GO TO COMP-WRITE-14. NC2524.2 +124500 PERFORM FAIL. NC2524.2 +124600 MOVE W-1 TO COMPUTED-A. NC2524.2 +124700 MOVE 9 TO W-1. NC2524.2 +124800 MOVE 9 TO CORRECT-A. NC2524.2 +124900 GO TO COMP-WRITE-14. NC2524.2 +125000 COMP-DELETE-14. NC2524.2 +125100 PERFORM DE-LETE. NC2524.2 +125200 COMP-WRITE-14. NC2524.2 +125300 MOVE "COMP-TEST-14" TO PAR-NAME. NC2524.2 +125400 PERFORM PRINT-DETAIL. NC2524.2 +125500 COMP-TEST-15. NC2524.2 +125600 COMPUTE W-2 = W-1 + 20. NC2524.2 +125700 IF W-2 = 29 NC2524.2 +125800 PERFORM PASS NC2524.2 +125900 GO TO COMP-WRITE-15. NC2524.2 +126000 PERFORM FAIL. NC2524.2 +126100 MOVE W-2 TO COMPUTED-N. NC2524.2 +126200 MOVE "+29" TO CORRECT-A. NC2524.2 +126300 MOVE 29 TO W-2. NC2524.2 +126400 GO TO COMP-WRITE-15. NC2524.2 +126500 COMP-DELETE-15. NC2524.2 +126600 PERFORM DE-LETE. NC2524.2 +126700 COMP-WRITE-15. NC2524.2 +126800 MOVE "COMP-TEST-15" TO PAR-NAME. NC2524.2 +126900 PERFORM PRINT-DETAIL. NC2524.2 +127000 COMP-TEST-16. NC2524.2 +127100 MOVE ZERO TO W-11. NC2524.2 +127200 COMPUTE W-11 = W-1 - W-2. NC2524.2 +127300 IF ( W-11 > -20.00040) AND NC2524.2 +127400 ( W-11 < -19.99960) THEN NC2524.2 +127500 PERFORM PASS NC2524.2 +127600 GO TO COMP-WRITE-16. NC2524.2 +127700 PERFORM FAIL. NC2524.2 +127800 MOVE W-11 TO COMPUTED-N. NC2524.2 +127900 MOVE "-20" TO CORRECT-A. NC2524.2 +128000 GO TO COMP-WRITE-16. NC2524.2 +128100 COMP-DELETE-16. NC2524.2 +128200 PERFORM DE-LETE. NC2524.2 +128300 COMP-WRITE-16. NC2524.2 +128400 MOVE "COMP-TEST-16" TO PAR-NAME. NC2524.2 +128500 PERFORM PRINT-DETAIL. NC2524.2 +128600 COMP-TEST-17. NC2524.2 +128700 MOVE ZERO TO W-3. NC2524.2 +128800 COMPUTE W-3 = TEN * 30. NC2524.2 +128900 IF W-3 = 300 NC2524.2 +129000 PERFORM PASS NC2524.2 +129100 GO TO COMP-WRITE-17. NC2524.2 +129200 PERFORM FAIL. NC2524.2 +129300 MOVE W-3 TO COMPUTED-N. NC2524.2 +129400 MOVE "+300" TO CORRECT-A. NC2524.2 +129500 GO TO COMP-WRITE-17. NC2524.2 +129600 COMP-DELETE-17. NC2524.2 +129700 PERFORM DE-LETE. NC2524.2 +129800 COMP-WRITE-17. NC2524.2 +129900 MOVE "COMP-TEST-17" TO PAR-NAME. NC2524.2 +130000 PERFORM PRINT-DETAIL. NC2524.2 +130100 COMP-TEST-18. NC2524.2 +130200 MOVE ZERO TO W-5. NC2524.2 +130300 COMPUTE W-5 = 42 / SEVEN. NC2524.2 +130400 IF W-5 = 6 NC2524.2 +130500 PERFORM PASS NC2524.2 +130600 GO TO COMP-WRITE-18. NC2524.2 +130700 PERFORM FAIL. NC2524.2 +130800 MOVE W-5 TO COMPUTED-N. NC2524.2 +130900 MOVE "+6" TO CORRECT-A. NC2524.2 +131000 GO TO COMP-WRITE-18. NC2524.2 +131100 COMP-DELETE-18. NC2524.2 +131200 PERFORM DE-LETE. NC2524.2 +131300 COMP-WRITE-18. NC2524.2 +131400 MOVE "COMP-TEST-18" TO PAR-NAME. NC2524.2 +131500 PERFORM PRINT-DETAIL. NC2524.2 +131600 COMP-TEST-19. NC2524.2 +131700 MOVE ZERO TO W-2. NC2524.2 +131800 COMPUTE W-2 = FOUR ** 3. NC2524.2 +131900 IF W-2 = 64 NC2524.2 +132000 PERFORM PASS NC2524.2 +132100 GO TO COMP-WRITE-19. NC2524.2 +132200 PERFORM FAIL. NC2524.2 +132300 MOVE W-2 TO COMPUTED-N. NC2524.2 +132400 MOVE "+64" TO CORRECT-A. NC2524.2 +132500 GO TO COMP-WRITE-19. NC2524.2 +132600 COMP-DELETE-19. NC2524.2 +132700 PERFORM DE-LETE. NC2524.2 +132800 COMP-WRITE-19. NC2524.2 +132900 MOVE "COMP-TEST-19" TO PAR-NAME. NC2524.2 +133000 PERFORM PRINT-DETAIL. NC2524.2 +133100 COMP-TEST-20. NC2524.2 +133200 MOVE 555 TO W-3. NC2524.2 +133300 COMPUTE W-3 = TWENTY-5 + 101 + 222. NC2524.2 +133400 IF W-3 = 348 NC2524.2 +133500 PERFORM PASS NC2524.2 +133600 GO TO COMP-WRITE-20. NC2524.2 +133700 PERFORM FAIL. NC2524.2 +133800 MOVE W-3 TO COMPUTED-N. NC2524.2 +133900 MOVE "+348" TO CORRECT-A. NC2524.2 +134000 GO TO COMP-WRITE-20. NC2524.2 +134100 COMP-DELETE-20. NC2524.2 +134200 PERFORM DE-LETE. NC2524.2 +134300 COMP-WRITE-20. NC2524.2 +134400 MOVE "COMP-TEST-20" TO PAR-NAME. NC2524.2 +134500 PERFORM PRINT-DETAIL. NC2524.2 +134600 COMP-TEST-21. NC2524.2 +134700 MOVE ZERO TO W-9. NC2524.2 +134800 COMPUTE W-9 = TWO * (3 + 4). NC2524.2 +134900 IF W-9 = 14 NC2524.2 +135000 PERFORM PASS NC2524.2 +135100 GO TO COMP-WRITE-21. NC2524.2 +135200 PERFORM FAIL. NC2524.2 +135300 MOVE W-9 TO COMPUTED-N. NC2524.2 +135400 MOVE "+14" TO CORRECT-A. NC2524.2 +135500 GO TO COMP-WRITE-21. NC2524.2 +135600 COMP-DELETE-21. NC2524.2 +135700 PERFORM DE-LETE. NC2524.2 +135800 COMP-WRITE-21. NC2524.2 +135900 MOVE "COMP-TEST-21" TO PAR-NAME. NC2524.2 +136000 PERFORM PRINT-DETAIL. NC2524.2 +136100 COMP-TEST-22. NC2524.2 +136200 MOVE ZERO TO W-9. NC2524.2 +136300 COMPUTE W-9 = (TWO + (3 * FOUR) / (2 * THREE)) ** 2 - 1. NC2524.2 +136400 IF W-9 = 15 PERFORM PASS NC2524.2 +136500 GO TO COMP-WRITE-22. NC2524.2 +136600 PERFORM FAIL. NC2524.2 +136700 MOVE W-9 TO COMPUTED-N. NC2524.2 +136800 MOVE "+15" TO CORRECT-A. NC2524.2 +136900 GO TO COMP-WRITE-22. NC2524.2 +137000 COMP-DELETE-22. NC2524.2 +137100 PERFORM DE-LETE. NC2524.2 +137200 COMP-WRITE-22. NC2524.2 +137300 MOVE "COMP-TEST-22" TO PAR-NAME. NC2524.2 +137400 PERFORM PRINT-DETAIL. NC2524.2 +137500 COMP-TEST-23. NC2524.2 +137600 MOVE ZERO TO XRAY. NC2524.2 +137700 MOVE 10 TO W-2. NC2524.2 +137800 COMPUTE W-2 = 96 + TWENTY ON SIZE ERROR NC2524.2 +137900 MOVE 8 TO XRAY. NC2524.2 +138000 IF XRAY IS EQUAL TO "8" NC2524.2 +138100 PERFORM PASS NC2524.2 +138200 GO TO COMP-WRITE-23. NC2524.2 +138300 PERFORM FAIL. NC2524.2 +138400 MOVE "8" TO CORRECT-A. NC2524.2 +138500 MOVE XRAY TO COMPUTED-A. NC2524.2 +138600 MOVE "OSE NOT EXECUTED" TO RE-MARK. NC2524.2 +138700 GO TO COMP-WRITE-23. NC2524.2 +138800 COMP-DELETE-23. NC2524.2 +138900 PERFORM DE-LETE. NC2524.2 +139000 COMP-WRITE-23. NC2524.2 +139100 MOVE "COMP-TEST-23" TO PAR-NAME. NC2524.2 +139200 PERFORM PRINT-DETAIL. NC2524.2 +139300 COMP-TEST-24. NC2524.2 +139400 IF W-2 = 10 NC2524.2 +139500 PERFORM PASS NC2524.2 +139600 GO TO COMP-WRITE-24. NC2524.2 +139700 PERFORM FAIL. NC2524.2 +139800 MOVE W-2 TO COMPUTED-A. NC2524.2 +139900 MOVE "10" TO CORRECT-A. NC2524.2 +140000 MOVE "NOT PROTECTED BY OES" TO RE-MARK. NC2524.2 +140100 GO TO COMP-WRITE-24. NC2524.2 +140200 COMP-DELETE-24. NC2524.2 +140300 PERFORM DE-LETE. NC2524.2 +140400 COMP-WRITE-24. NC2524.2 +140500 MOVE "COMP-TEST-24" TO PAR-NAME. NC2524.2 +140600 PERFORM PRINT-DETAIL. NC2524.2 +140700 COMP-TEST-25. NC2524.2 +140800 MOVE ZERO TO W-11. NC2524.2 +140900 COMPUTE W-11 ROUNDED = D-1 + D-7. NC2524.2 +141000 IF ( W-11 < 2.20004) AND NC2524.2 +141100 ( W-11 > 2.19996) THEN NC2524.2 +141200 PERFORM PASS NC2524.2 +141300 GO TO COMP-WRITE-25. NC2524.2 +141400 PERFORM FAIL. NC2524.2 +141500 MOVE W-11 TO COMPUTED-N. NC2524.2 +141600 MOVE "+2.2" TO CORRECT-A. NC2524.2 +141700 GO TO COMP-WRITE-25. NC2524.2 +141800 COMP-DELETE-25. NC2524.2 +141900 PERFORM DE-LETE. NC2524.2 +142000 COMP-WRITE-25. NC2524.2 +142100 MOVE "COMP-TEST-25" TO PAR-NAME. NC2524.2 +142200 PERFORM PRINT-DETAIL. NC2524.2 +142300 COMP-TEST-26. NC2524.2 +142400 MOVE ZERO TO W-11. NC2524.2 +142500 COMPUTE W-11 ROUNDED = 25 / 10. NC2524.2 +142600 IF ( W-11 < 2.50005) AND NC2524.2 +142700 ( W-11 > 2.49995) THEN NC2524.2 +142800 PERFORM PASS NC2524.2 +142900 GO TO COMP-WRITE-26. NC2524.2 +143000 PERFORM FAIL. NC2524.2 +143100 MOVE W-11 TO COMPUTED-N. NC2524.2 +143200 MOVE "+2.5" TO CORRECT-A. NC2524.2 +143300 GO TO COMP-WRITE-26. NC2524.2 +143400 COMP-DELETE-26. NC2524.2 +143500 PERFORM DE-LETE. NC2524.2 +143600 COMP-WRITE-26. NC2524.2 +143700 MOVE "COMP-TEST-26" TO PAR-NAME. NC2524.2 +143800 PERFORM PRINT-DETAIL. NC2524.2 +143900 CTST-END. NC2524.2 +144000 EXIT. NC2524.2 +144100 COMP-INIT-A. NC2524.2 +144200 MOVE "COMPUTE" TO FEATURE. NC2524.2 +144300 COMP-TEST-27. NC2524.2 +144400 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +144500 COMPUTE WRK-DS-02V00 = -9. NC2524.2 +144600 IF WRK-DS-02V00 = -9 NC2524.2 +144700 PERFORM PASS NC2524.2 +144800 GO TO COMP-WRITE-27. NC2524.2 +144900 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +145000 MOVE -9 TO CORRECT-N. NC2524.2 +145100 PERFORM FAIL. NC2524.2 +145200 GO TO COMP-WRITE-27. NC2524.2 +145300 COMP-DELETE-27. NC2524.2 +145400 PERFORM DE-LETE. NC2524.2 +145500 COMP-WRITE-27. NC2524.2 +145600 MOVE "COMP-TEST-27" TO PAR-NAME. NC2524.2 +145700 PERFORM PRINT-DETAIL. NC2524.2 +145800 COMP-TEST-28. NC2524.2 +145900 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +146000 COMPUTE WRK-DS-02V00 = A99-DS-02V00. NC2524.2 +146100 IF WRK-DS-02V00 = 99 NC2524.2 +146200 PERFORM PASS NC2524.2 +146300 GO TO COMP-WRITE-28. NC2524.2 +146400 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +146500 MOVE 99 TO CORRECT-N. NC2524.2 +146600 PERFORM FAIL. NC2524.2 +146700 GO TO COMP-WRITE-28. NC2524.2 +146800 COMP-DELETE-28. NC2524.2 +146900 PERFORM DE-LETE. NC2524.2 +147000 COMP-WRITE-28. NC2524.2 +147100 MOVE "COMP-TEST-28" TO PAR-NAME. NC2524.2 +147200 PERFORM PRINT-DETAIL. NC2524.2 +147300 COMP-TEST-29. NC2524.2 +147400 MOVE ZERO TO WRK-DS-18V00. NC2524.2 +147500 COMPUTE WRK-DS-18V00 = A18ONES-DS-18V00 + A18ONES-DS-18V00. NC2524.2 +147600 IF WRK-DS-18V00 = 222222222222222222 NC2524.2 +147700 PERFORM PASS NC2524.2 +147800 GO TO COMP-WRITE-29. NC2524.2 +147900 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC2524.2 +148000 MOVE 222222222222222222 TO CORRECT-18V0. NC2524.2 +148100 PERFORM FAIL. NC2524.2 +148200 GO TO COMP-WRITE-29. NC2524.2 +148300 COMP-DELETE-29. NC2524.2 +148400 PERFORM DE-LETE. NC2524.2 +148500 COMP-WRITE-29. NC2524.2 +148600 MOVE "COMP-TEST-29" TO PAR-NAME. NC2524.2 +148700 PERFORM PRINT-DETAIL. NC2524.2 +148800 COMP-TEST-30. NC2524.2 +148900 MOVE ZERO TO WRK-DS-18V00. NC2524.2 +149000 COMPUTE WRK-DS-18V00 = A18TWOS-DS-18V00 - A18ONES-DS-18V00. NC2524.2 +149100 IF WRK-DS-18V00 = 111111111111111111 NC2524.2 +149200 PERFORM PASS NC2524.2 +149300 GO TO COMP-WRITE-30. NC2524.2 +149400 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC2524.2 +149500 MOVE 111111111111111111 TO CORRECT-18V0. NC2524.2 +149600 PERFORM FAIL. NC2524.2 +149700 GO TO COMP-WRITE-30. NC2524.2 +149800 COMP-DELETE-30. NC2524.2 +149900 PERFORM DE-LETE. NC2524.2 +150000 COMP-WRITE-30. NC2524.2 +150100 MOVE "COMP-TEST-30" TO PAR-NAME. NC2524.2 +150200 PERFORM PRINT-DETAIL. NC2524.2 +150300 COMP-TEST-31. NC2524.2 +150400 MOVE ZERO TO TA--X. NC2524.2 +150500 COMPUTE TA--X = 3 * A02TWOS-DU-02V00. NC2524.2 +150600 IF TA--X = 66 NC2524.2 +150700 PERFORM PASS NC2524.2 +150800 GO TO COMP-WRITE-31. NC2524.2 +150900 MOVE TA--X TO COMPUTED-N NC2524.2 +151000 MOVE 66 TO CORRECT-N. NC2524.2 +151100 PERFORM FAIL. NC2524.2 +151200 GO TO COMP-WRITE-31. NC2524.2 +151300 COMP-DELETE-31. NC2524.2 +151400 PERFORM DE-LETE. NC2524.2 +151500 COMP-WRITE-31. NC2524.2 +151600 MOVE "COMP-TEST-31" TO PAR-NAME. NC2524.2 +151700 PERFORM PRINT-DETAIL. NC2524.2 +151800 COMP-TEST-32. NC2524.2 +151900 MOVE ZERO TO WRK-DS-05V00. NC2524.2 +152000 COMPUTE WRK-DS-05V00 = A02TWOS-DU-02V00 / A02TWOS-DS-03V02. NC2524.2 +152100 IF WRK-DS-05V00 = 1 NC2524.2 +152200 PERFORM PASS NC2524.2 +152300 GO TO COMP-WRITE-32. NC2524.2 +152400 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2524.2 +152500 MOVE 1 TO CORRECT-N. NC2524.2 +152600 PERFORM FAIL. NC2524.2 +152700 GO TO COMP-WRITE-32. NC2524.2 +152800 COMP-DELETE-32. NC2524.2 +152900 PERFORM DE-LETE. NC2524.2 +153000 COMP-WRITE-32. NC2524.2 +153100 MOVE "COMP-TEST-32" TO PAR-NAME. NC2524.2 +153200 PERFORM PRINT-DETAIL. NC2524.2 +153300 COMP-TEST-33. NC2524.2 +153400 MOVE ZERO TO WRK-DS-05V00. NC2524.2 +153500 COMPUTE WRK-DS-05V00 = 3 ** ATWO-DS-01V00. NC2524.2 +153600 IF WRK-DS-05V00 = 9 NC2524.2 +153700 PERFORM PASS NC2524.2 +153800 GO TO COMP-WRITE-33. NC2524.2 +153900 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2524.2 +154000 MOVE 9 TO CORRECT-N. NC2524.2 +154100 PERFORM FAIL. NC2524.2 +154200 GO TO COMP-WRITE-33. NC2524.2 +154300 COMP-DELETE-33. NC2524.2 +154400 PERFORM DE-LETE. NC2524.2 +154500 COMP-WRITE-33. NC2524.2 +154600 MOVE "COMP-TEST-33" TO PAR-NAME. NC2524.2 +154700 PERFORM PRINT-DETAIL. NC2524.2 +154800 COMP-TEST-34. NC2524.2 +154900 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +155000 COMPUTE WRK-DS-02V00 ROUNDED = A99-DS-02V00 NC2524.2 +155100 + AZERO-DS-05V05 - 2.5. NC2524.2 +155200 IF WRK-DS-02V00 = 97 NC2524.2 +155300 PERFORM PASS NC2524.2 +155400 GO TO COMP-WRITE-34. NC2524.2 +155500 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +155600 MOVE 97 TO CORRECT-N. NC2524.2 +155700 PERFORM FAIL. NC2524.2 +155800 GO TO COMP-WRITE-34. NC2524.2 +155900 COMP-DELETE-34. NC2524.2 +156000 PERFORM DE-LETE. NC2524.2 +156100 COMP-WRITE-34. NC2524.2 +156200 MOVE "COMP-TEST-34" TO PAR-NAME. NC2524.2 +156300 PERFORM PRINT-DETAIL. NC2524.2 +156400 COMP-TEST-35. NC2524.2 +156500 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +156600 COMPUTE WRK-DS-02V00 = A99-DS-02V00 + AZERO-DS-05V05 NC2524.2 +156700 ON SIZE ERROR NC2524.2 +156800 MOVE "SIZE ERR SHOULD NOT EXCUTE" TO RE-MARK NC2524.2 +156900 PERFORM FAIL NC2524.2 +157000 GO TO COMP-WRITE-35. NC2524.2 +157100 PERFORM PASS. NC2524.2 +157200 GO TO COMP-WRITE-35. NC2524.2 +157300 COMP-DELETE-35. NC2524.2 +157400 PERFORM DE-LETE. NC2524.2 +157500 COMP-WRITE-35. NC2524.2 +157600 MOVE "COMP-TEST-35" TO PAR-NAME. NC2524.2 +157700 PERFORM PRINT-DETAIL. NC2524.2 +157800 COMP-TEST-36. NC2524.2 +157900 IF TEST-2NUC-COND-99 NC2524.2 +158000 PERFORM PASS NC2524.2 +158100 GO TO COMP-WRITE-36. NC2524.2 +158200* NOTE THIS TEST DEPENDS UPON THE RESULT OF COMP-TEST-35. NC2524.2 +158300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +158400 MOVE 99 TO CORRECT-N. NC2524.2 +158500 PERFORM FAIL. NC2524.2 +158600 GO TO COMP-WRITE-36. NC2524.2 +158700 COMP-DELETE-36. NC2524.2 +158800 PERFORM DE-LETE. NC2524.2 +158900 COMP-WRITE-36. NC2524.2 +159000 MOVE "COMP-TEST-36" TO PAR-NAME. NC2524.2 +159100 PERFORM PRINT-DETAIL. NC2524.2 +159200 COMP-TEST-37. NC2524.2 +159300 MOVE ZERO TO WRK-DS-0201P. NC2524.2 +159400 COMPUTE WRK-DS-0201P ROUNDED = A05ONES-DS-05V00 / 5 NC2524.2 +159500 ON SIZE ERROR NC2524.2 +159600 PERFORM PASS NC2524.2 +159700 GO TO COMP-WRITE-37. NC2524.2 +159800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC2524.2 +159900 PERFORM FAIL. NC2524.2 +160000 GO TO COMP-WRITE-37. NC2524.2 +160100 COMP-DELETE-37. NC2524.2 +160200 PERFORM DE-LETE. NC2524.2 +160300 COMP-WRITE-37. NC2524.2 +160400 MOVE "COMP-TEST-37" TO PAR-NAME. NC2524.2 +160500 PERFORM PRINT-DETAIL. NC2524.2 +160600 COMP-TEST-38. NC2524.2 +160700 IF WRK-DS-0201P = ZERO NC2524.2 +160800 PERFORM PASS NC2524.2 +160900 GO TO COMP-WRITE-38. NC2524.2 +161000* NOTE THIS TEST DEPENDS UPON THE RESULT OF COMP-TEST-37. NC2524.2 +161100 MOVE WRK-DS-0201P TO COMPUTED-N. NC2524.2 +161200 MOVE ZERO TO CORRECT-N. NC2524.2 +161300 PERFORM FAIL. NC2524.2 +161400 GO TO COMP-WRITE-38. NC2524.2 +161500 COMP-DELETE-38. NC2524.2 +161600 PERFORM DE-LETE. NC2524.2 +161700 COMP-WRITE-38. NC2524.2 +161800 MOVE "COMP-TEST-38" TO PAR-NAME. NC2524.2 +161900 PERFORM PRINT-DETAIL. NC2524.2 +162000 COMP-TEST-39-42. NC2524.2 +162100 MOVE SPACES TO TEST-RESULTS. NC2524.2 +162200 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162300 MOVE "COMP-TEST-39" TO PAR-NAME. NC2524.2 +162400 PERFORM PRINT-DETAIL. NC2524.2 +162500 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162600 MOVE "COMP-TEST-40" TO PAR-NAME. NC2524.2 +162700 PERFORM PRINT-DETAIL. NC2524.2 +162800 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162900 MOVE "COMP-TEST-41" TO PAR-NAME. NC2524.2 +163000 PERFORM PRINT-DETAIL. NC2524.2 +163100 MOVE "NOT USED" TO RE-MARK. NC2524.2 +163200 MOVE "COMP-TEST-42" TO PAR-NAME. NC2524.2 +163300 PERFORM PRINT-DETAIL. NC2524.2 +163400 MOVE "COMPUTE" TO FEATURE. NC2524.2 +163500 COMP-TEST-43. NC2524.2 +163600 MOVE ZEROS TO WHOLE-FIELD. NC2524.2 +163700 COMPUTE WHOLE-FIELD = NC2524.2 +163800 (1 + (2 - (3 + (4 - (5 + (6 - (7 + (8 - (9 + (10 - NC2524.2 +163900 EVEN-NAME1)))))))))). NC2524.2 +164000 IF (WHOLE-FIELD < 10.0002) AND NC2524.2 +164100 (WHOLE-FIELD > 9.9998) PERFORM PASS NC2524.2 +164200 GO TO COMP-WRITE-43. NC2524.2 +164300 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC2524.2 +164400 MOVE 10 TO CORRECT-18V0. NC2524.2 +164500 PERFORM FAIL. NC2524.2 +164600 GO TO COMP-WRITE-43. NC2524.2 +164700 COMP-DELETE-43. NC2524.2 +164800 PERFORM DE-LETE. NC2524.2 +164900 COMP-WRITE-43. NC2524.2 +165000 MOVE "COMP-TEST-43" TO PAR-NAME. NC2524.2 +165100 PERFORM PRINT-DETAIL. NC2524.2 +165200 COMP-TEST-44. NC2524.2 +165300 MOVE ZEROS TO WHOLE-FIELD. NC2524.2 +165400 COMPUTE WHOLE-FIELD = NC2524.2 +165500 (ONE + (TWO - (THREE + (FOUR - (FIVE + (SIX - (SEVEN + NC2524.2 +165600 (EIGHT - (NINE + (TEN - EVEN-NAME1)))))))))). NC2524.2 +165700 IF WHOLE-FIELD = 10 PERFORM PASS NC2524.2 +165800 GO TO COMP-WRITE-44. NC2524.2 +165900 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC2524.2 +166000 MOVE 10 TO CORRECT-18V0. NC2524.2 +166100 PERFORM FAIL. NC2524.2 +166200 GO TO COMP-WRITE-44. NC2524.2 +166300 COMP-DELETE-44. NC2524.2 +166400 PERFORM DE-LETE. NC2524.2 +166500 COMP-WRITE-44. NC2524.2 +166600 MOVE "COMP-TEST-44" TO PAR-NAME. NC2524.2 +166700 PERFORM PRINT-DETAIL. NC2524.2 +166800 COMP-INT-045. NC2524.2 +166900 MOVE "COMPUTE SERIES" TO FEATURE. NC2524.2 +167000 MOVE "COMP-TEST-045" TO PAR-NAME. NC2524.2 +167100 COMP-TEST-045. NC2524.2 +167200 COMPUTE WRK-DS-05V00-0002 NC2524.2 +167300 WRK-DS-04V01-0005 ROUNDED NC2524.2 +167400 WRK-DS-03V04-0003F-0014 (2, 2, 2) = 174 / 16. NC2524.2 +167500* NC2524.2 +167600* IDENTIFIER SERIES - WITH AND WITHOUT ROUNDED - NC2524.2 +167700* SUBSCRIPTED DATA ITEM. NC2524.2 +167800* NC2524.2 +167900 MOVE "COMP-TEST-045-1" TO PAR-NAME. NC2524.2 +168000 IF WRK-DS-05V00-0002 NOT = 10 NC2524.2 +168100 MOVE +00010 TO CORRECT-N NC2524.2 +168200 MOVE WRK-DS-05V00-0002 TO COMPUTED-N NC2524.2 +168300 PERFORM COMP-WRITE-045 GO TO COMP-TEST-045-2. NC2524.2 +168400 PERFORM PASS. PERFORM COMP-WRITE-045. NC2524.2 +168500 COMP-TEST-045-2. NC2524.2 +168600 MOVE "COMP-TEST-045-2" TO PAR-NAME. NC2524.2 +168700 IF (WRK-DS-04V01-0005 > 10.9002180) OR NC2524.2 +168800 (WRK-DS-04V01-0005 < 10.8997820) PERFORM FAIL NC2524.2 +168900 MOVE +10.9 TO CORRECT-N NC2524.2 +169000 MOVE WRK-DS-04V01-0005 TO COMPUTED-N NC2524.2 +169100 PERFORM COMP-WRITE-045 GO TO COMP-TEST-045-3. NC2524.2 +169200 PERFORM PASS. PERFORM COMP-WRITE-045. NC2524.2 +169300 COMP-TEST-045-3. NC2524.2 +169400 MOVE "COMP-TEST-045-3" TO PAR-NAME. NC2524.2 +169500 IF (WRK-DS-03V04-0003F-0014 (2, 2, 2) > 10.87521750) OR NC2524.2 +169600 (WRK-DS-03V04-0003F-0014 (2, 2, 2) < 10.87479250) NC2524.2 +169700 PERFORM FAIL MOVE +010.8750 TO CORRECT-N NC2524.2 +169800 MOVE WRK-DS-03V04-0003F-0014 (2, 2, 2) TO COMPUTED-N NC2524.2 +169900 GO TO COMP-WRITE-045. NC2524.2 +170000 PERFORM PASS. NC2524.2 +170100 GO TO COMP-WRITE-045. NC2524.2 +170200 COMP-DELETE-045. NC2524.2 +170300 PERFORM DE-LETE. NC2524.2 +170400 COMP-WRITE-045. NC2524.2 +170500 PERFORM PRINT-DETAIL. NC2524.2 +170600 COMP-TEST-045-EXIT. NC2524.2 +170700 EXIT. NC2524.2 +170800 CCVS-EXIT SECTION. NC2524.2 +170900 CCVS-999999. NC2524.2 +171000 GO TO CLOSE-FILES. NC2524.2 +*END-OF,NC252A +*HEADER,COBOL,NC253A +000100 IDENTIFICATION DIVISION. NC2534.2 +000200 PROGRAM-ID. NC2534.2 +000300 NC253A. NC2534.2 +000400**************************************************************** NC2534.2 +000500* * NC2534.2 +000600* VALIDATION FOR:- * NC2534.2 +000700* * NC2534.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +000900* * NC2534.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2534.2 +001100* * NC2534.2 +001200**************************************************************** NC2534.2 +001300* * NC2534.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2534.2 +001500* * NC2534.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2534.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2534.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2534.2 +001900* * NC2534.2 +002000**************************************************************** NC2534.2 +002100 NC2534.2 +002200* NC2534.2 +002300* PROGRAM NC202A TESTS FORMAT3 OF THE SUBTRACT STATEMENT. NC2534.2 +002400* NC2534.2 +002500* NC2534.2 +002600 ENVIRONMENT DIVISION. NC2534.2 +002700 CONFIGURATION SECTION. NC2534.2 +002800 SOURCE-COMPUTER. NC2534.2 +002900 XXXXX082. NC2534.2 +003000 OBJECT-COMPUTER. NC2534.2 +003100 XXXXX083. NC2534.2 +003200 INPUT-OUTPUT SECTION. NC2534.2 +003300 FILE-CONTROL. NC2534.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2534.2 +003500 XXXXX055. NC2534.2 +003600 DATA DIVISION. NC2534.2 +003700 FILE SECTION. NC2534.2 +003800 FD PRINT-FILE. NC2534.2 +003900 01 PRINT-REC PICTURE X(120). NC2534.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2534.2 +004100 WORKING-STORAGE SECTION. NC2534.2 +004200 01 TABLE1. NC2534.2 +004300 02 RECORD1 PICTURE 99. NC2534.2 +004400 02 RECORD2 PICTURE 99 NC2534.2 +004500 OCCURS 2 TIMES NC2534.2 +004600 INDEXED BY INDEX1. NC2534.2 +004700 02 RECORD3 PICTURE 99. NC2534.2 +004800 01 TABLE2. NC2534.2 +004900 02 RECORD1 PICTURE 99. NC2534.2 +005000 02 RECORD2 PICTURE 99 NC2534.2 +005100 OCCURS 2 TIMES NC2534.2 +005200 INDEXED BY INDEX2. NC2534.2 +005300 02 RECORD3 PICTURE 99. NC2534.2 +005400 77 WRK-AN-00001 PICTURE A. NC2534.2 +005500 77 WRK-XN-00001 PICTURE X. NC2534.2 +005600 77 WRK-DS-01V00 PICTURE S9. NC2534.2 +005700 77 WRK-DS-02V00 PICTURE S99. NC2534.2 +005800 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2534.2 +005900 77 WRK-DS-05V00 PICTURE S9(5). NC2534.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2534.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2534.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2534.2 +006300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2534.2 +006400 VALUE 111111111.111111111. NC2534.2 +006500 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2534.2 +006600 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2534.2 +006700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2534.2 +006800 77 WRK-DS-03V00 PICTURE S999. NC2534.2 +006900 77 WRK-DS-06V00 PICTURE S9(6). NC2534.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC2534.2 +007100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2534.2 +007200 77 ADD-1 PICTURE S9(8)V99 VALUE 1. NC2534.2 +007300 77 ADD-2 PICTURE S9(6)V9(4) VALUE 1. NC2534.2 +007400 77 ADD-3 PICTURE S9(5) VALUE -1. NC2534.2 +007500 77 ADD-4 PICTURE 9 VALUE 9. NC2534.2 +007600 77 ADD-5 PICTURE 9 VALUE 9. NC2534.2 +007700 77 ADD-6 PICTURE 9(5) VALUE 99999. NC2534.2 +007800 77 ADD-7 PICTURE 9 VALUE 1. NC2534.2 +007900 77 ADD-8 PICTURE 9. NC2534.2 +008000 77 ADD-9 PICTURE S9(8)V99 VALUE 5.9. NC2534.2 +008100 77 ADD-10 PICTURE 9(5) VALUE 52800. NC2534.2 +008200 77 ADD-11 PICTURE 99999. NC2534.2 +008300 77 ADD-12 PICTURE PP9 VALUE .001. NC2534.2 +008400 77 ADD-13 PICTURE 9PP VALUE 100. NC2534.2 +008500 77 ADD-14 PICTURE 999V999. NC2534.2 +008600 77 W-1 PICTURE IS 9. NC2534.2 +008700 77 W-2 PICTURE IS 99. NC2534.2 +008800 77 W-3 PICTURE IS 999. NC2534.2 +008900 77 W-4 PICTURE 9 VALUE 0. NC2534.2 +009000 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2534.2 +009100 77 W-9 PICTURE 999. NC2534.2 +009200 77 D-5 PICTURE S999 VALUE -1. NC2534.2 +009300 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2534.2 +009400 77 ONE PICTURE 9 VALUE 1. NC2534.2 +009500 77 TWO PICTURE S9 VALUE 2. NC2534.2 +009600 77 THREE PICTURE S9 VALUE 3. NC2534.2 +009700 77 FOUR PICTURE S9 VALUE 4. NC2534.2 +009800 77 FIVE PICTURE S9 VALUE 5. NC2534.2 +009900 77 SIX PICTURE S9 VALUE 6. NC2534.2 +010000 77 SEVEN PICTURE S9 VALUE 7. NC2534.2 +010100 77 EIGHT PICTURE 9 VALUE 8. NC2534.2 +010200 77 NINE PICTURE S9 VALUE 9. NC2534.2 +010300 77 TEN PICTURE S99 VALUE 10. NC2534.2 +010400 77 FIFTEEN PICTURE S99 VALUE 15. NC2534.2 +010500 77 TWENTY PICTURE S99 VALUE 20. NC2534.2 +010600 77 TWENTY-5 PICTURE S99 VALUE 25. NC2534.2 +010700 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2534.2 +010800 01 GRP-FOR-ADD-CORR-1. NC2534.2 +010900 02 GRP-SUBTRACT-CORR-1. NC2534.2 +011000 03 FILLER PICTURE S99 VALUE 91. NC2534.2 +011100 03 ADD-CORR-2 PICTURE S99 VALUE 22. NC2534.2 +011200 03 ADD-CORR-1 PICTURE S99 VALUE 11. NC2534.2 +011300 03 ADD-CORR-A PICTURE S99 VALUE 93. NC2534.2 +011400 03 ADD-CORR-4 PICTURE S99 VALUE 44. NC2534.2 +011500 03 ADD-CORR-3 PICTURE S99 VALUE 33. NC2534.2 +011600 03 ADD-CORR-6 PICTURE S99 VALUE 66. NC2534.2 +011700 03 ADD-CORR-5 PICTURE S99 VALUE 55. NC2534.2 +011800 03 ADD-CORR-8 PICTURE S99 VALUE 88. NC2534.2 +011900 03 ADD-CORR-7 PICTURE S99 VALUE 77. NC2534.2 +012000 03 ADD-CORR-9 PICTURE S99 VALUE 99. NC2534.2 +012100 01 GRP-FOR-ADD-CORR-R. NC2534.2 +012200 02 GRP-SUBTRACT-CORR-1. NC2534.2 +012300 05 ADD-CORR-1 PICTURE 99. NC2534.2 +012400 05 ADD-CORR-2 PICTURE 99. NC2534.2 +012500 05 ADD-CORR-3 PICTURE 99. NC2534.2 +012600 05 ADD-CORR-4 PICTURE 99. NC2534.2 +012700 05 ADD-CORR-5 PICTURE 9P. NC2534.2 +012800 05 ADD-CORR-6 PICTURE 999. NC2534.2 +012900 05 ADD-CORR-7 PICTURE 99. NC2534.2 +013000 05 ADD-CORR-8 PICTURE 99. NC2534.2 +013100 05 ADD-CORR-9 PICTURE 99. NC2534.2 +013200 05 FILLER PICTURE 99. NC2534.2 +013300 01 GRP-FOR-ADD-CORR-2. NC2534.2 +013400 02 GRP-ADD-SUB-CORR. NC2534.2 +013500 03 GRP-SUBTRACT-CORR-1. NC2534.2 +013600 04 ADD-CORR-1 PICTURE S99 VALUE 11. NC2534.2 +013700 04 ADD-CORR-2 PICTURE S99 VALUE 22. NC2534.2 +013800 04 ADD-CORR-5 PICTURE S99 VALUE 55. NC2534.2 +013900 04 ADD-CORR-4 PICTURE S99 VALUE 44. NC2534.2 +014000 04 ADD-CORR-3 PICTURE S99 VALUE 33. NC2534.2 +014100 04 ADD-CORR-6 PICTURE S99 VALUE 66. NC2534.2 +014200 04 ADD-CORR-7 PICTURE S99 VALUE 77. NC2534.2 +014300 04 ADD-CORR-8 PICTURE S99 VALUE 88. NC2534.2 +014400 04 ADD-CORR-9 PICTURE S99 VALUE 99. NC2534.2 +014500 04 ADD-CORR-B PICTURE S99 VALUE 92. NC2534.2 +014600 04 ADD-CORR-0 PICTURE S99 VALUE 00. NC2534.2 +014700 01 GRP-FOR-ADD-CORR-A. NC2534.2 +014800 02 GRP-SUBTRACT-CORR-3. NC2534.2 +014900 03 GRP-SUBTRACT-CORR-1. NC2534.2 +015000 05 ADD-CORR-4 PICTURE S999 VALUE 044. NC2534.2 +015100 05 ADD-CORR-3 PICTURE S999 VALUE 033. NC2534.2 +015200 05 ADD-CORR-2 PICTURE S999 VALUE 022. NC2534.2 +015300 05 ADD-CORR-1 PICTURE S999 VALUE 111. NC2534.2 +015400 01 ADD-15. NC2534.2 +015500 02 FIELD1 PICTURE 99999 VALUE 1. NC2534.2 +015600 02 FIELD2 PICTURE 999V99 VALUE 32.1. NC2534.2 +015700 02 FIELD3 PICTURE 999V9 VALUE 123.4. NC2534.2 +015800 01 ADD-16. NC2534.2 +015900 02 FIELD1 PICTURE 99999 VALUE 99999. NC2534.2 +016000 02 FIELD2 PICTURE 999V99 VALUE 745.67. NC2534.2 +016100 02 FIELD3 PICTURE 999V9 VALUE 432.1. NC2534.2 +016200 01 SUBTRACT-DATA. NC2534.2 +016300 02 SUBTR-1 PICTURE 9 VALUE 1. NC2534.2 +016400 02 SUBTR-2 PICTURE S99 VALUE 99. NC2534.2 +016500 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC2534.2 +016600 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC2534.2 +016700 02 SUBTR-5 PICTURE S9PP VALUE 100. NC2534.2 +016800 02 SUBTR-6 PICTURE 9 VALUE 1. NC2534.2 +016900 02 SUBTR-7 PICTURE S99 VALUE 99. NC2534.2 +017000 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC2534.2 +017100 02 SUBTR-9 PICTURE SV999. NC2534.2 +017200 02 SUBTR-10 PICTURE S999 VALUE 100. NC2534.2 +017300 02 SUBTR-11 PICTURE S999V999. NC2534.2 +017400 02 SUBTR-12. NC2534.2 +017500 03 SUBTR-13 PICTURE 9 VALUE 1. NC2534.2 +017600 03 SUBTR-14 PICTURE S9V999 VALUE -1.725. NC2534.2 +017700 03 SUBTR-15 PICTURE S99V99 VALUE 76.76. NC2534.2 +017800 02 SUBTR-16. NC2534.2 +017900 03 SUBTR-13 PICTURE 9 VALUE 2. NC2534.2 +018000 03 SUBTR-14 PICTURE S9V99 VALUE .23. NC2534.2 +018100 03 SUBTR-15 PICTURE S9V99 VALUE 1. NC2534.2 +018200 01 CORR-DATA-1. NC2534.2 +018300 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018500 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018700 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018900 01 CORR-DATA-2. NC2534.2 +019000 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019100 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019200 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019300 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019400 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019500 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019600 01 CORR-DATA-3. NC2534.2 +019700 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019800 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019900 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020000 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020100 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020200 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020300 01 CORR-DATA-4. NC2534.2 +020400 03 XYZ-11 PICTURE IS 99. NC2534.2 +020500 03 XYZ-12 PICTURE IS 99. NC2534.2 +020600 03 XYZ-13 PICTURE IS 99. NC2534.2 +020700 03 XYZ-14 PICTURE IS 99. NC2534.2 +020800 03 XYZ-15 PICTURE IS 99. NC2534.2 +020900 03 XYZ-16 PICTURE IS 99. NC2534.2 +021000 01 CORR-DATA-5. NC2534.2 +021100 03 XYZ-1 PICTURE 99. NC2534.2 +021200 03 XYZ-2 PICTURE 99. NC2534.2 +021300 03 XYZ-13 PICTURE IS 99. NC2534.2 +021400 03 XYZ-14 PICTURE IS 99. NC2534.2 +021500 03 FILLER PICTURE IS 99. NC2534.2 +021600 03 XYZ-11 PICTURE IS 99. NC2534.2 +021700 03 XYZ-12 PICTURE IS 99. NC2534.2 +021800 01 CORR-DATA-6. NC2534.2 +021900 03 XYZ-11 PICTURE IS 99. NC2534.2 +022000 03 XYZ-12 PICTURE IS 99. NC2534.2 +022100 03 FILLER PICTURE IS 99. NC2534.2 +022200 03 XYZ-1 PICTURE IS 99. NC2534.2 +022300 03 XYZ-2 PICTURE IS 9(2). NC2534.2 +022400 03 FILLER PICTURE IS 99. NC2534.2 +022500 01 CORR-DATA-7. NC2534.2 +022600 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2534.2 +022700 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2534.2 +022800 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2534.2 +022900 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2534.2 +023000 01 42-DATANAMES. NC2534.2 +023100 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2534.2 +023200 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC2534.2 +023300 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC2534.2 +023400 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC2534.2 +023500 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC2534.2 +023600 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC2534.2 +023700 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC2534.2 +023800 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC2534.2 +023900 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC2534.2 +024000 02 DNAME10 PICTURE 9(10) VALUE 1. NC2534.2 +024100 02 DNAME11 PICTURE 9(11) VALUE 1. NC2534.2 +024200 02 DNAME12 PICTURE 9(12) VALUE 1. NC2534.2 +024300 02 DNAME13 PICTURE 9(13) VALUE 1. NC2534.2 +024400 02 DNAME14 PICTURE 9(14) VALUE 1. NC2534.2 +024500 02 DNAME15 PICTURE 9(15) VALUE 1. NC2534.2 +024600 02 DNAME16 PICTURE 9(16) VALUE 1. NC2534.2 +024700 02 DNAME17 PICTURE 9(17) VALUE 1. NC2534.2 +024800 02 DNAME18 PICTURE 9(18) VALUE 1. NC2534.2 +024900 02 DNAME19 PICTURE 9 VALUE 1. NC2534.2 +025000 02 DNAME20 PICTURE 99 VALUE 1. NC2534.2 +025100 02 DNAME21 PICTURE 999 VALUE 1. NC2534.2 +025200 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2534.2 +025300 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2534.2 +025400 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2534.2 +025500 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2534.2 +025600 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2534.2 +025700 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2534.2 +025800 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2534.2 +025900 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2534.2 +026000 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026100 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026200 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026300 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026400 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026500 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026600 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026700 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026800 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026900 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027000 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027100 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027200 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027300 01 TEST-RESULTS. NC2534.2 +027400 02 FILLER PIC X VALUE SPACE. NC2534.2 +027500 02 FEATURE PIC X(20) VALUE SPACE. NC2534.2 +027600 02 FILLER PIC X VALUE SPACE. NC2534.2 +027700 02 P-OR-F PIC X(5) VALUE SPACE. NC2534.2 +027800 02 FILLER PIC X VALUE SPACE. NC2534.2 +027900 02 PAR-NAME. NC2534.2 +028000 03 FILLER PIC X(19) VALUE SPACE. NC2534.2 +028100 03 PARDOT-X PIC X VALUE SPACE. NC2534.2 +028200 03 DOTVALUE PIC 99 VALUE ZERO. NC2534.2 +028300 02 FILLER PIC X(8) VALUE SPACE. NC2534.2 +028400 02 RE-MARK PIC X(61). NC2534.2 +028500 01 TEST-COMPUTED. NC2534.2 +028600 02 FILLER PIC X(30) VALUE SPACE. NC2534.2 +028700 02 FILLER PIC X(17) VALUE NC2534.2 +028800 " COMPUTED=". NC2534.2 +028900 02 COMPUTED-X. NC2534.2 +029000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2534.2 +029100 03 COMPUTED-N REDEFINES COMPUTED-A NC2534.2 +029200 PIC -9(9).9(9). NC2534.2 +029300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2534.2 +029400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2534.2 +029500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2534.2 +029600 03 CM-18V0 REDEFINES COMPUTED-A. NC2534.2 +029700 04 COMPUTED-18V0 PIC -9(18). NC2534.2 +029800 04 FILLER PIC X. NC2534.2 +029900 03 FILLER PIC X(50) VALUE SPACE. NC2534.2 +030000 01 TEST-CORRECT. NC2534.2 +030100 02 FILLER PIC X(30) VALUE SPACE. NC2534.2 +030200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2534.2 +030300 02 CORRECT-X. NC2534.2 +030400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2534.2 +030500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2534.2 +030600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2534.2 +030700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2534.2 +030800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2534.2 +030900 03 CR-18V0 REDEFINES CORRECT-A. NC2534.2 +031000 04 CORRECT-18V0 PIC -9(18). NC2534.2 +031100 04 FILLER PIC X. NC2534.2 +031200 03 FILLER PIC X(2) VALUE SPACE. NC2534.2 +031300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2534.2 +031400 01 CCVS-C-1. NC2534.2 +031500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2534.2 +031600- "SS PARAGRAPH-NAME NC2534.2 +031700- " REMARKS". NC2534.2 +031800 02 FILLER PIC X(20) VALUE SPACE. NC2534.2 +031900 01 CCVS-C-2. NC2534.2 +032000 02 FILLER PIC X VALUE SPACE. NC2534.2 +032100 02 FILLER PIC X(6) VALUE "TESTED". NC2534.2 +032200 02 FILLER PIC X(15) VALUE SPACE. NC2534.2 +032300 02 FILLER PIC X(4) VALUE "FAIL". NC2534.2 +032400 02 FILLER PIC X(94) VALUE SPACE. NC2534.2 +032500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2534.2 +032600 01 REC-CT PIC 99 VALUE ZERO. NC2534.2 +032700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2534.2 +032800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2534.2 +032900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2534.2 +033000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2534.2 +033100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2534.2 +033200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2534.2 +033300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2534.2 +033400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2534.2 +033500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2534.2 +033600 01 CCVS-H-1. NC2534.2 +033700 02 FILLER PIC X(39) VALUE SPACES. NC2534.2 +033800 02 FILLER PIC X(42) VALUE NC2534.2 +033900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2534.2 +034000 02 FILLER PIC X(39) VALUE SPACES. NC2534.2 +034100 01 CCVS-H-2A. NC2534.2 +034200 02 FILLER PIC X(40) VALUE SPACE. NC2534.2 +034300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2534.2 +034400 02 FILLER PIC XXXX VALUE NC2534.2 +034500 "4.2 ". NC2534.2 +034600 02 FILLER PIC X(28) VALUE NC2534.2 +034700 " COPY - NOT FOR DISTRIBUTION". NC2534.2 +034800 02 FILLER PIC X(41) VALUE SPACE. NC2534.2 +034900 NC2534.2 +035000 01 CCVS-H-2B. NC2534.2 +035100 02 FILLER PIC X(15) VALUE NC2534.2 +035200 "TEST RESULT OF ". NC2534.2 +035300 02 TEST-ID PIC X(9). NC2534.2 +035400 02 FILLER PIC X(4) VALUE NC2534.2 +035500 " IN ". NC2534.2 +035600 02 FILLER PIC X(12) VALUE NC2534.2 +035700 " HIGH ". NC2534.2 +035800 02 FILLER PIC X(22) VALUE NC2534.2 +035900 " LEVEL VALIDATION FOR ". NC2534.2 +036000 02 FILLER PIC X(58) VALUE NC2534.2 +036100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +036200 01 CCVS-H-3. NC2534.2 +036300 02 FILLER PIC X(34) VALUE NC2534.2 +036400 " FOR OFFICIAL USE ONLY ". NC2534.2 +036500 02 FILLER PIC X(58) VALUE NC2534.2 +036600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2534.2 +036700 02 FILLER PIC X(28) VALUE NC2534.2 +036800 " COPYRIGHT 1985 ". NC2534.2 +036900 01 CCVS-E-1. NC2534.2 +037000 02 FILLER PIC X(52) VALUE SPACE. NC2534.2 +037100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2534.2 +037200 02 ID-AGAIN PIC X(9). NC2534.2 +037300 02 FILLER PIC X(45) VALUE SPACES. NC2534.2 +037400 01 CCVS-E-2. NC2534.2 +037500 02 FILLER PIC X(31) VALUE SPACE. NC2534.2 +037600 02 FILLER PIC X(21) VALUE SPACE. NC2534.2 +037700 02 CCVS-E-2-2. NC2534.2 +037800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2534.2 +037900 03 FILLER PIC X VALUE SPACE. NC2534.2 +038000 03 ENDER-DESC PIC X(44) VALUE NC2534.2 +038100 "ERRORS ENCOUNTERED". NC2534.2 +038200 01 CCVS-E-3. NC2534.2 +038300 02 FILLER PIC X(22) VALUE NC2534.2 +038400 " FOR OFFICIAL USE ONLY". NC2534.2 +038500 02 FILLER PIC X(12) VALUE SPACE. NC2534.2 +038600 02 FILLER PIC X(58) VALUE NC2534.2 +038700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +038800 02 FILLER PIC X(13) VALUE SPACE. NC2534.2 +038900 02 FILLER PIC X(15) VALUE NC2534.2 +039000 " COPYRIGHT 1985". NC2534.2 +039100 01 CCVS-E-4. NC2534.2 +039200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2534.2 +039300 02 FILLER PIC X(4) VALUE " OF ". NC2534.2 +039400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2534.2 +039500 02 FILLER PIC X(40) VALUE NC2534.2 +039600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2534.2 +039700 01 XXINFO. NC2534.2 +039800 02 FILLER PIC X(19) VALUE NC2534.2 +039900 "*** INFORMATION ***". NC2534.2 +040000 02 INFO-TEXT. NC2534.2 +040100 04 FILLER PIC X(8) VALUE SPACE. NC2534.2 +040200 04 XXCOMPUTED PIC X(20). NC2534.2 +040300 04 FILLER PIC X(5) VALUE SPACE. NC2534.2 +040400 04 XXCORRECT PIC X(20). NC2534.2 +040500 02 INF-ANSI-REFERENCE PIC X(48). NC2534.2 +040600 01 HYPHEN-LINE. NC2534.2 +040700 02 FILLER PIC IS X VALUE IS SPACE. NC2534.2 +040800 02 FILLER PIC IS X(65) VALUE IS "************************NC2534.2 +040900- "*****************************************". NC2534.2 +041000 02 FILLER PIC IS X(54) VALUE IS "************************NC2534.2 +041100- "******************************". NC2534.2 +041200 01 CCVS-PGM-ID PIC X(9) VALUE NC2534.2 +041300 "NC253A". NC2534.2 +041400 PROCEDURE DIVISION. NC2534.2 +041500 CCVS1 SECTION. NC2534.2 +041600 OPEN-FILES. NC2534.2 +041700 OPEN OUTPUT PRINT-FILE. NC2534.2 +041800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2534.2 +041900 MOVE SPACE TO TEST-RESULTS. NC2534.2 +042000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2534.2 +042100 GO TO CCVS1-EXIT. NC2534.2 +042200 CLOSE-FILES. NC2534.2 +042300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2534.2 +042400 TERMINATE-CCVS. NC2534.2 +042500S EXIT PROGRAM. NC2534.2 +042600STERMINATE-CALL. NC2534.2 +042700 STOP RUN. NC2534.2 +042800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2534.2 +042900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2534.2 +043000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2534.2 +043100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2534.2 +043200 MOVE "****TEST DELETED****" TO RE-MARK. NC2534.2 +043300 PRINT-DETAIL. NC2534.2 +043400 IF REC-CT NOT EQUAL TO ZERO NC2534.2 +043500 MOVE "." TO PARDOT-X NC2534.2 +043600 MOVE REC-CT TO DOTVALUE. NC2534.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2534.2 +043800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2534.2 +043900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2534.2 +044000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2534.2 +044100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2534.2 +044200 MOVE SPACE TO CORRECT-X. NC2534.2 +044300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2534.2 +044400 MOVE SPACE TO RE-MARK. NC2534.2 +044500 HEAD-ROUTINE. NC2534.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2534.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2534.2 +045000 COLUMN-NAMES-ROUTINE. NC2534.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +045400 END-ROUTINE. NC2534.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2534.2 +045600 END-RTN-EXIT. NC2534.2 +045700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +045800 END-ROUTINE-1. NC2534.2 +045900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2534.2 +046000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2534.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. NC2534.2 +046200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2534.2 +046300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2534.2 +046400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2534.2 +046500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2534.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2534.2 +046700 END-ROUTINE-12. NC2534.2 +046800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2534.2 +046900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2534.2 +047000 MOVE "NO " TO ERROR-TOTAL NC2534.2 +047100 ELSE NC2534.2 +047200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2534.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2534.2 +047400 PERFORM WRITE-LINE. NC2534.2 +047500 END-ROUTINE-13. NC2534.2 +047600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2534.2 +047700 MOVE "NO " TO ERROR-TOTAL ELSE NC2534.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2534.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2534.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048100 IF INSPECT-COUNTER EQUAL TO ZERO NC2534.2 +048200 MOVE "NO " TO ERROR-TOTAL NC2534.2 +048300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2534.2 +048400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2534.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048700 WRITE-LINE. NC2534.2 +048800 ADD 1 TO RECORD-COUNT. NC2534.2 +048900Y IF RECORD-COUNT GREATER 50 NC2534.2 +049000Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2534.2 +049100Y MOVE SPACE TO DUMMY-RECORD NC2534.2 +049200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2534.2 +049300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2534.2 +049400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2534.2 +049500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2534.2 +049600Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2534.2 +049700Y MOVE ZERO TO RECORD-COUNT. NC2534.2 +049800 PERFORM WRT-LN. NC2534.2 +049900 WRT-LN. NC2534.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2534.2 +050100 MOVE SPACE TO DUMMY-RECORD. NC2534.2 +050200 BLANK-LINE-PRINT. NC2534.2 +050300 PERFORM WRT-LN. NC2534.2 +050400 FAIL-ROUTINE. NC2534.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2534.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2534.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2534.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2534.2 +050900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +051000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2534.2 +051100 GO TO FAIL-ROUTINE-EX. NC2534.2 +051200 FAIL-ROUTINE-WRITE. NC2534.2 +051300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2534.2 +051400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2534.2 +051500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2534.2 +051600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2534.2 +051700 FAIL-ROUTINE-EX. EXIT. NC2534.2 +051800 BAIL-OUT. NC2534.2 +051900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2534.2 +052000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2534.2 +052100 BAIL-OUT-WRITE. NC2534.2 +052200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2534.2 +052300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2534.2 +052400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +052500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2534.2 +052600 BAIL-OUT-EX. EXIT. NC2534.2 +052700 CCVS1-EXIT. NC2534.2 +052800 EXIT. NC2534.2 +052900* NC2534.2 +053000 SECT-NC253A-001 SECTION. NC2534.2 +053100 BUILD-TABLE1. NC2534.2 +053200 MOVE 06 TO RECORD1 OF TABLE1. NC2534.2 +053300 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2534.2 +053400 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2534.2 +053500 MOVE 07 TO RECORD3 OF TABLE1. NC2534.2 +053600 BUILD-TABLE2. NC2534.2 +053700 MOVE 08 TO RECORD1 OF TABLE2. NC2534.2 +053800 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2534.2 +053900 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2534.2 +054000 MOVE 09 TO RECORD3 OF TABLE2. NC2534.2 +054100* NC2534.2 +054200 SUB-INIT-F3-1. NC2534.2 +054300 PERFORM END-ROUTINE. NC2534.2 +054400 MOVE "SUB-TEST-F3-1" TO PAR-NAME. NC2534.2 +054500 MOVE "VI-134 6.25.4 GR3" TO ANSI-REFERENCE. NC2534.2 +054600 MOVE "SUBTRACT SERIES " TO FEATURE. NC2534.2 +054700 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2534.2 +054800 MOVE 11 TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-1. NC2534.2 +054900 MOVE 22 TO ADD-CORR-2 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055000 MOVE 33 TO ADD-CORR-3 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055100 MOVE 44 TO ADD-CORR-4 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055200 MOVE 55 TO ADD-CORR-5 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055300 MOVE 66 TO ADD-CORR-6 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055400 MOVE 77 TO ADD-CORR-7 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055500 MOVE 88 TO ADD-CORR-8 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055600 MOVE 99 TO ADD-CORR-9 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055700 SUB-TEST-F3-1. NC2534.2 +055800 SUBTRACT CORRESPONDING GRP-FOR-ADD-CORR-1 FROM NC2534.2 +055900 GRP-FOR-ADD-CORR-R. NC2534.2 +056000 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344506677889900" NC2534.2 +056100 PERFORM PASS NC2534.2 +056200 GO TO SUB-WRITE-F3-1. NC2534.2 +056300 GO TO SUB-FAIL-F3-1. NC2534.2 +056400 SUB-DELETE-F3-1. NC2534.2 +056500 PERFORM DE-LETE. NC2534.2 +056600 GO TO SUB-WRITE-F3-1. NC2534.2 +056700 SUB-FAIL-F3-1. NC2534.2 +056800 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2534.2 +056900 MOVE "11223344506677889900" TO CORRECT-A. NC2534.2 +057000 PERFORM FAIL. NC2534.2 +057100 SUB-WRITE-F3-1. NC2534.2 +057200 PERFORM PRINT-DETAIL. NC2534.2 +057300* NC2534.2 +057400 SUB-INIT-F3-2. NC2534.2 +057500 MOVE "SUB-TEST-F3-2" TO PAR-NAME. NC2534.2 +057600 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2534.2 +057700 SUB-TEST-F3-2. NC2534.2 +057800 SUBTRACT CORRESPONDING GRP-ADD-SUB-CORR FROM NC2534.2 +057900 GRP-FOR-ADD-CORR-R ROUNDED. NC2534.2 +058000 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344606677889900" NC2534.2 +058100 PERFORM PASS NC2534.2 +058200 GO TO SUB-WRITE-F3-2. NC2534.2 +058300 GO TO SUB-FAIL-F3-2. NC2534.2 +058400 SUB-DELETE-F3-2. NC2534.2 +058500 PERFORM DE-LETE. NC2534.2 +058600 GO TO SUB-WRITE-F3-2. NC2534.2 +058700 SUB-FAIL-F3-2. NC2534.2 +058800 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2534.2 +058900 MOVE "11223344606677889900" TO CORRECT-A. NC2534.2 +059000 PERFORM FAIL. NC2534.2 +059100 SUB-WRITE-F3-2. NC2534.2 +059200 PERFORM PRINT-DETAIL. NC2534.2 +059300* NC2534.2 +059400 SUB-INIT-F3-3. NC2534.2 +059500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +059600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +059700 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +059800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +059900 MOVE 0.23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +060000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +060100 SUB-INIT-F3-3-1. NC2534.2 +060200 MOVE "SUB-TEST-F3-3-1" TO PAR-NAME. NC2534.2 +060300 MOVE SPACE TO WRK-AN-00001. NC2534.2 +060400 SUB-TEST-F3-3-1. NC2534.2 +060500 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED ON NC2534.2 +060600 SIZE ERROR NC2534.2 +060700 MOVE "G" TO WRK-AN-00001. NC2534.2 +060800 IF WRK-AN-00001 EQUAL TO "G" NC2534.2 +060900 PERFORM PASS NC2534.2 +061000 GO TO SUB-WRITE-F3-3-1. NC2534.2 +061100 GO TO SUB-FAIL-F3-3-1. NC2534.2 +061200 SUB-DELETE-F3-3-1. NC2534.2 +061300 PERFORM DE-LETE. NC2534.2 +061400 GO TO SUB-WRITE-F3-3-1. NC2534.2 +061500 SUB-FAIL-F3-3-1. NC2534.2 +061600 PERFORM FAIL. NC2534.2 +061700 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2534.2 +061800 SUB-WRITE-F3-3-1. NC2534.2 +061900 PERFORM PRINT-DETAIL. NC2534.2 +062000* NC2534.2 +062100 SUB-INIT-F3-3-2. NC2534.2 +062200 MOVE "SUB-TEST-F3-3-2" TO PAR-NAME. NC2534.2 +062300 SUB-TEST-F3-3-2. NC2534.2 +062400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +062500 GO TO SUB-FAIL-F3-3-2. NC2534.2 +062600 PERFORM PASS. NC2534.2 +062700 GO TO SUB-WRITE-F3-3-2. NC2534.2 +062800 SUB-DELETE-F3-3-2. NC2534.2 +062900 PERFORM DE-LETE. NC2534.2 +063000 GO TO SUB-WRITE-F3-3-2. NC2534.2 +063100 SUB-FAIL-F3-3-2. NC2534.2 +063200 PERFORM FAIL. NC2534.2 +063300 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +063400 MOVE "+1" TO CORRECT-A. NC2534.2 +063500 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +063600 TO RE-MARK. NC2534.2 +063700 SUB-WRITE-F3-3-2. NC2534.2 +063800 PERFORM PRINT-DETAIL. NC2534.2 +063900* NC2534.2 +064000 SUB-INIT-F3-3-3. NC2534.2 +064100 MOVE "SUB-TEST-F3-3-3" TO PAR-NAME. NC2534.2 +064200 SUB-TEST-F3-3-3. NC2534.2 +064300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +064400 GO TO SUB-FAIL-F3-3-3. NC2534.2 +064500 PERFORM PASS. NC2534.2 +064600 GO TO SUB-WRITE-F3-3-3. NC2534.2 +064700 SUB-DELETE-F3-3-3. NC2534.2 +064800 PERFORM DE-LETE. NC2534.2 +064900 GO TO SUB-WRITE-F3-3-3. NC2534.2 +065000 SUB-FAIL-F3-3-3. NC2534.2 +065100 PERFORM FAIL. NC2534.2 +065200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +065300 MOVE "+1.96" TO CORRECT-A. NC2534.2 +065400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +065500 TO RE-MARK. NC2534.2 +065600 SUB-WRITE-F3-3-3. NC2534.2 +065700 PERFORM PRINT-DETAIL. NC2534.2 +065800* NC2534.2 +065900 SUB-INIT-3-3-4. NC2534.2 +066000 MOVE "SUB-TEST-3-3-4" TO PAR-NAME. NC2534.2 +066100 SUB-TEST-3-3-4. NC2534.2 +066200 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +066300 GO TO SUB-FAIL-3-3-4. NC2534.2 +066400 PERFORM PASS NC2534.2 +066500 GO TO SUB-WRITE-3-3-4. NC2534.2 +066600 SUB-DELETE-3-3-4. NC2534.2 +066700 PERFORM DE-LETE. NC2534.2 +066800 GO TO SUB-WRITE-3-3-4. NC2534.2 +066900 SUB-FAIL-3-3-4. NC2534.2 +067000 PERFORM FAIL. NC2534.2 +067100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +067200 MOVE "+1" TO CORRECT-A. NC2534.2 +067300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC2534.2 +067400 SUB-WRITE-3-3-4. NC2534.2 +067500 PERFORM PRINT-DETAIL. NC2534.2 +067600* NC2534.2 +067700 SUB-INIT-F3-4. NC2534.2 +067800 MOVE "SUB-TEST-F3-4" TO PAR-NAME. NC2534.2 +067900 MOVE "050506060000" TO CORR-DATA-2. NC2534.2 +068000 MOVE "999999999999" TO CORR-DATA-3. NC2534.2 +068100 SUB-TEST-F3-4. NC2534.2 +068200 SUBTRACT CORRESPONDING CORR-DATA-2 FROM CORR-DATA-3. NC2534.2 +068300 IF CORR-DATA-3 EQUAL TO "939399999494" NC2534.2 +068400 PERFORM PASS NC2534.2 +068500 GO TO SUB-WRITE-F3-4. NC2534.2 +068600 GO TO SUB-FAIL-F3-4. NC2534.2 +068700 SUB-DELETE-F3-4. NC2534.2 +068800 PERFORM DE-LETE. NC2534.2 +068900 GO TO SUB-WRITE-F3-4. NC2534.2 +069000 SUB-FAIL-F3-4. NC2534.2 +069100 MOVE 939399999494 TO CORRECT-A. NC2534.2 +069200 MOVE CORR-DATA-3 TO COMPUTED-A. NC2534.2 +069300 PERFORM FAIL. NC2534.2 +069400 SUB-WRITE-F3-4. NC2534.2 +069500 PERFORM PRINT-DETAIL. NC2534.2 +069600* NC2534.2 +069700 SUB-INIT-F3-5. NC2534.2 +069800 MOVE "SUB-TEST-F3-5" TO PAR-NAME. NC2534.2 +069900 MOVE 999955995511 TO CORR-DATA-1. NC2534.2 +070000 MOVE 123456107890 TO CORR-DATA-6. NC2534.2 +070100 SUB-TEST-F3-5. NC2534.2 +070200 SUBTRACT CORRESPONDING CORR-DATA-6 FROM CORR-DATA-1. NC2534.2 +070300 IF CORR-DATA-1 EQUAL TO "892155995511" NC2534.2 +070400 PERFORM PASS NC2534.2 +070500 GO TO SUB-WRITE-F3-5. NC2534.2 +070600 GO TO SUB-FAIL-F3-5. NC2534.2 +070700 SUB-DELETE-F3-5. NC2534.2 +070800 PERFORM DE-LETE. NC2534.2 +070900 GO TO SUB-WRITE-F3-5. NC2534.2 +071000 SUB-FAIL-F3-5. NC2534.2 +071100 MOVE 892155995511 TO CORRECT-A. NC2534.2 +071200 MOVE CORR-DATA-1 TO COMPUTED-A. NC2534.2 +071300 PERFORM FAIL. NC2534.2 +071400 SUB-WRITE-F3-5. NC2534.2 +071500 PERFORM PRINT-DETAIL. NC2534.2 +071600* NC2534.2 +071700 SUB-INIT-F3-6. NC2534.2 +071800 MOVE "555555000055" TO CORR-DATA-6. NC2534.2 +071900 MOVE "SUB-TEST-F3-6" TO PAR-NAME. NC2534.2 +072000 SUB-TEST-F3-6. NC2534.2 +072100 SUBTRACT CORRESPONDING CORR-DATA-6 FROM CORR-DATA-1 NC2534.2 +072200 IF CORR-DATA-1 EQUAL TO 892155995511 NC2534.2 +072300 PERFORM PASS NC2534.2 +072400 GO TO SUB-WRITE-F3-6. NC2534.2 +072500 GO TO SUB-FAIL-F3-6. NC2534.2 +072600 SUB-DELETE-F3-6. NC2534.2 +072700 PERFORM DE-LETE. NC2534.2 +072800 GO TO SUB-WRITE-F3-6. NC2534.2 +072900 SUB-FAIL-F3-6. NC2534.2 +073000 MOVE 892155995511 TO CORRECT-A. NC2534.2 +073100 MOVE CORR-DATA-1 TO COMPUTED-A. NC2534.2 +073200 PERFORM FAIL. NC2534.2 +073300 SUB-WRITE-F3-6. NC2534.2 +073400 PERFORM PRINT-DETAIL. NC2534.2 +073500* NC2534.2 +073600 SUB-INIT-F3-7. NC2534.2 +073700 MOVE "SUB-TEST-F3-7" TO PAR-NAME. NC2534.2 +073800 MOVE 99999999999999 TO CORR-DATA-5. NC2534.2 +073900 MOVE 111111111111 TO CORR-DATA-1. NC2534.2 +074000 SUB-TEST-F3-7. NC2534.2 +074100 SUBTRACT CORRESPONDING CORR-DATA-1 FROM CORR-DATA-5. NC2534.2 +074200 IF CORR-DATA-5 EQUAL TO "88889999999999" NC2534.2 +074300 PERFORM PASS NC2534.2 +074400 GO TO SUB-WRITE-F3-7. NC2534.2 +074500 GO TO SUB-FAIL-F3-7. NC2534.2 +074600 SUB-DELETE-F3-7. NC2534.2 +074700 PERFORM DE-LETE. NC2534.2 +074800 GO TO SUB-WRITE-F3-7. NC2534.2 +074900 SUB-FAIL-F3-7. NC2534.2 +075000 PERFORM FAIL. NC2534.2 +075100 MOVE CORR-DATA-5 TO COMPUTED-A. NC2534.2 +075200 MOVE "88889999999999" TO CORRECT-A. NC2534.2 +075300 SUB-WRITE-F3-7. NC2534.2 +075400 PERFORM PRINT-DETAIL. NC2534.2 +075500* NC2534.2 +075600 SUB-INIT-F3-8. NC2534.2 +075700 MOVE "SUB-TEST-F3-8" TO PAR-NAME. NC2534.2 +075800 MOVE "VI-134 6.25.4 GR3" TO ANSI-REFERENCE. NC2534.2 +075900 PERFORM BUILD-TABLE1. NC2534.2 +076000 PERFORM BUILD-TABLE2. NC2534.2 +076100 SUB-TEST-F3-8-0. NC2534.2 +076200 SUBTRACT CORRESPONDING TABLE1 FROM TABLE2. NC2534.2 +076300 SUB-TEST-F3-8-1. NC2534.2 +076400 IF RECORD1 OF TABLE2 = 02 NC2534.2 +076500 AND RECORD2 OF TABLE2 (1) = 03 NC2534.2 +076600 AND RECORD2 OF TABLE2 (2) = 04 NC2534.2 +076700 AND RECORD3 OF TABLE2 = 02 NC2534.2 +076800 PERFORM PASS NC2534.2 +076900 GO TO SUB-WRITE-F3-8. NC2534.2 +077000 GO TO SUB-FAIL-F3-8. NC2534.2 +077100 SUB-DELETE-F3-8. NC2534.2 +077200 PERFORM DE-LETE. NC2534.2 +077300 GO TO SUB-WRITE-F3-8. NC2534.2 +077400 SUB-FAIL-F3-8. NC2534.2 +077500 PERFORM FAIL. NC2534.2 +077600 MOVE TABLE2 TO COMPUTED-A. NC2534.2 +077700 MOVE "02030402" TO CORRECT-A. NC2534.2 +077800 SUB-WRITE-F3-8. NC2534.2 +077900 PERFORM PRINT-DETAIL. NC2534.2 +078000* NC2534.2 +078100 SUB-INIT-F3-9. NC2534.2 +078200* ===--> NO SIZE ERROR <--=== NC2534.2 +078300 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +078400 MOVE SPACE TO WRK-AN-00001. NC2534.2 +078500 MOVE 0 TO REC-CT. NC2534.2 +078600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +078700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +078800 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +078900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +079000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +079100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +079200 SUB-TEST-F3-9-0. NC2534.2 +079300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +079400 ON SIZE ERROR NC2534.2 +079500 MOVE "G" TO WRK-AN-00001. NC2534.2 +079600* NC2534.2 +079700 SUB-INIT-F3-9-1. NC2534.2 +079800 MOVE "SUB-TEST-F3-9-1" TO PAR-NAME. NC2534.2 +079900 ADD 1 TO REC-CT. NC2534.2 +080000 SUB-TEST-F3-9-1. NC2534.2 +080100 IF WRK-AN-00001 NOT = SPACE NC2534.2 +080200 GO TO SUB-FAIL-F3-9-1. NC2534.2 +080300 PERFORM PASS NC2534.2 +080400 GO TO SUB-WRITE-F3-9-1. NC2534.2 +080500 SUB-DELETE-F3-9-1. NC2534.2 +080600 PERFORM DE-LETE. NC2534.2 +080700 GO TO SUB-WRITE-F3-9-1. NC2534.2 +080800 SUB-FAIL-F3-9-1. NC2534.2 +080900 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +081000 TO RE-MARK NC2534.2 +081100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +081200 MOVE SPACE TO CORRECT-X NC2534.2 +081300 PERFORM FAIL. NC2534.2 +081400 SUB-WRITE-F3-9-1. NC2534.2 +081500 PERFORM PRINT-DETAIL. NC2534.2 +081600* NC2534.2 +081700 SUB-INIT-F3-9-2. NC2534.2 +081800 MOVE "SUB-TEST-F3-9-2" TO PAR-NAME. NC2534.2 +081900 ADD 1 TO REC-CT. NC2534.2 +082000 SUB-TEST-F3-9-2. NC2534.2 +082100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +082200 GO TO SUB-FAIL-F3-9-2. NC2534.2 +082300 PERFORM PASS NC2534.2 +082400 GO TO SUB-WRITE-F3-9-2. NC2534.2 +082500 SUB-DELETE-F3-9-2. NC2534.2 +082600 PERFORM DE-LETE. NC2534.2 +082700 GO TO SUB-WRITE-F3-9-2. NC2534.2 +082800 SUB-FAIL-F3-9-2. NC2534.2 +082900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +083000 MOVE "+1" TO CORRECT-A NC2534.2 +083100 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +083200 TO RE-MARK NC2534.2 +083300 PERFORM FAIL. NC2534.2 +083400 SUB-WRITE-F3-9-2. NC2534.2 +083500 PERFORM PRINT-DETAIL. NC2534.2 +083600* NC2534.2 +083700 SUB-INIT-F3-9-3. NC2534.2 +083800 MOVE "SUB-TEST-F3-9-3" TO PAR-NAME. NC2534.2 +083900 ADD 1 TO REC-CT. NC2534.2 +084000 SUB-TEST-F3-9-3. NC2534.2 +084100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +084200 GO TO SUB-FAIL-F3-9-3. NC2534.2 +084300 PERFORM PASS NC2534.2 +084400 GO TO SUB-WRITE-F3-9-3. NC2534.2 +084500 SUB-DELETE-F3-9-3. NC2534.2 +084600 PERFORM DE-LETE. NC2534.2 +084700 GO TO SUB-WRITE-F3-9-3. NC2534.2 +084800 SUB-FAIL-F3-9-3. NC2534.2 +084900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +085000 MOVE "+1.96" TO CORRECT-A NC2534.2 +085100 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +085200 TO RE-MARK NC2534.2 +085300 PERFORM FAIL. NC2534.2 +085400 SUB-WRITE-F3-9-3. NC2534.2 +085500 PERFORM PRINT-DETAIL. NC2534.2 +085600* NC2534.2 +085700 SUB-INIT-F3-9-4. NC2534.2 +085800 MOVE "SUB-TEST-F3-9-4" TO PAR-NAME. NC2534.2 +085900 ADD 1 TO REC-CT. NC2534.2 +086000 SUB-TEST-F3-9-4. NC2534.2 +086100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +086200 GO TO SUB-FAIL-F3-9-4. NC2534.2 +086300 PERFORM PASS NC2534.2 +086400 GO TO SUB-WRITE-F3-9-4. NC2534.2 +086500 SUB-DELETE-F3-9-4. NC2534.2 +086600 PERFORM DE-LETE. NC2534.2 +086700 GO TO SUB-WRITE-F3-9-4. NC2534.2 +086800 SUB-FAIL-F3-9-4. NC2534.2 +086900 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +087000 MOVE "-5.76" TO CORRECT-A NC2534.2 +087100 MOVE "SUBRACT CORRESPONDING FAILED" NC2534.2 +087200 TO RE-MARK NC2534.2 +087300 PERFORM FAIL. NC2534.2 +087400 SUB-WRITE-F3-9-4. NC2534.2 +087500 PERFORM PRINT-DETAIL. NC2534.2 +087600* NC2534.2 +087700 SUB-INIT-F3-10. NC2534.2 +087800* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +087900* ===--> SIZE ERROR <--=== NC2534.2 +088000 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +088100 MOVE SPACE TO WRK-AN-00001. NC2534.2 +088200 MOVE 0 TO REC-CT. NC2534.2 +088300 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +088400 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +088500 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +088600 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +088700 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +088800 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +088900 SUB-TEST-F3-10-0. NC2534.2 +089000 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +089100 NOT ON SIZE ERROR NC2534.2 +089200 MOVE "G" TO WRK-AN-00001. NC2534.2 +089300* NC2534.2 +089400 SUB-INIT-F3-10-1. NC2534.2 +089500 MOVE "SUB-TEST-F3-10-1" TO PAR-NAME. NC2534.2 +089600 ADD 1 TO REC-CT. NC2534.2 +089700 SUB-TEST-F3-10-1. NC2534.2 +089800 IF WRK-AN-00001 EQUAL TO "G" NC2534.2 +089900 GO TO SUB-FAIL-F3-10-1. NC2534.2 +090000 PERFORM PASS NC2534.2 +090100 GO TO SUB-WRITE-F3-10-1. NC2534.2 +090200 SUB-DELETE-F3-10-1. NC2534.2 +090300 PERFORM DE-LETE. NC2534.2 +090400 GO TO SUB-WRITE-F3-10-1. NC2534.2 +090500 SUB-FAIL-F3-10-1. NC2534.2 +090600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2534.2 +090700 TO RE-MARK NC2534.2 +090800 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +090900 MOVE SPACE TO CORRECT-X NC2534.2 +091000 PERFORM FAIL. NC2534.2 +091100 SUB-WRITE-F3-10-1. NC2534.2 +091200 PERFORM PRINT-DETAIL. NC2534.2 +091300* NC2534.2 +091400 SUB-INIT-F3-10-2. NC2534.2 +091500 MOVE "SUB-TEST-F3-10-2" TO PAR-NAME. NC2534.2 +091600 ADD 1 TO REC-CT. NC2534.2 +091700 SUB-TEST-F3-10-2. NC2534.2 +091800 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +091900 GO TO SUB-FAIL-F3-10-2. NC2534.2 +092000 PERFORM PASS NC2534.2 +092100 GO TO SUB-WRITE-F3-10-2. NC2534.2 +092200 SUB-DELETE-F3-10-2. NC2534.2 +092300 PERFORM DE-LETE. NC2534.2 +092400 GO TO SUB-WRITE-F3-10-2. NC2534.2 +092500 SUB-FAIL-F3-10-2. NC2534.2 +092600 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +092700 MOVE "+1" TO CORRECT-A NC2534.2 +092800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +092900 TO RE-MARK NC2534.2 +093000 PERFORM FAIL. NC2534.2 +093100 SUB-WRITE-F3-10-2. NC2534.2 +093200 PERFORM PRINT-DETAIL. NC2534.2 +093300* NC2534.2 +093400 SUB-INIT-F3-10-3. NC2534.2 +093500 MOVE "SUB-TEST-F3-10-3" TO PAR-NAME. NC2534.2 +093600 ADD 1 TO REC-CT. NC2534.2 +093700 SUB-TEST-F3-10-3. NC2534.2 +093800 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +093900 GO TO SUB-FAIL-F3-10-3. NC2534.2 +094000 PERFORM PASS NC2534.2 +094100 GO TO SUB-WRITE-F3-10-3. NC2534.2 +094200 SUB-DELETE-F3-10-3. NC2534.2 +094300 PERFORM DE-LETE. NC2534.2 +094400 GO TO SUB-WRITE-F3-10-3. NC2534.2 +094500 SUB-FAIL-F3-10-3. NC2534.2 +094600 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +094700 MOVE "+1.96" TO CORRECT-A NC2534.2 +094800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +094900 TO RE-MARK NC2534.2 +095000 PERFORM FAIL. NC2534.2 +095100 SUB-WRITE-F3-10-3. NC2534.2 +095200 PERFORM PRINT-DETAIL. NC2534.2 +095300* NC2534.2 +095400 SUB-INIT-F3-10-4. NC2534.2 +095500 MOVE "SUB-TEST-F3-10-4" TO PAR-NAME. NC2534.2 +095600 ADD 1 TO REC-CT. NC2534.2 +095700 SUB-TEST-F3-10-4. NC2534.2 +095800 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +095900 GO TO SUB-FAIL-F3-10-4. NC2534.2 +096000 PERFORM PASS NC2534.2 +096100 GO TO SUB-WRITE-F3-10-4. NC2534.2 +096200 SUB-DELETE-F3-10-4. NC2534.2 +096300 PERFORM DE-LETE. NC2534.2 +096400 GO TO SUB-WRITE-F3-10-4. NC2534.2 +096500 SUB-FAIL-F3-10-4. NC2534.2 +096600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +096700 MOVE "+1" TO CORRECT-A NC2534.2 +096800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +096900 PERFORM FAIL. NC2534.2 +097000 SUB-WRITE-F3-10-4. NC2534.2 +097100 PERFORM PRINT-DETAIL. NC2534.2 +097200* NC2534.2 +097300 SUB-INIT-F3-11. NC2534.2 +097400* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +097500* ===--> NO SIZE ERROR <--=== NC2534.2 +097600 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +097700 MOVE SPACE TO WRK-AN-00001. NC2534.2 +097800 MOVE 0 TO REC-CT. NC2534.2 +097900 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +098000 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +098100 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +098200 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +098300 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +098400 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +098500 SUB-TEST-F3-11-0. NC2534.2 +098600 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +098700 NOT ON SIZE ERROR NC2534.2 +098800 MOVE "G" TO WRK-AN-00001. NC2534.2 +098900* NC2534.2 +099000 SUB-INIT-F3-11-1. NC2534.2 +099100 MOVE "SUB-TEST-F3-11-1" TO PAR-NAME. NC2534.2 +099200 ADD 1 TO REC-CT. NC2534.2 +099300 SUB-TEST-F3-11-1. NC2534.2 +099400 IF WRK-AN-00001 EQUAL TO SPACE NC2534.2 +099500 GO TO SUB-FAIL-F3-11-1. NC2534.2 +099600 PERFORM PASS NC2534.2 +099700 GO TO SUB-WRITE-F3-11-1. NC2534.2 +099800 SUB-DELETE-F3-11-1. NC2534.2 +099900 PERFORM DE-LETE. NC2534.2 +100000 GO TO SUB-WRITE-F3-11-1. NC2534.2 +100100 SUB-FAIL-F3-11-1. NC2534.2 +100200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +100300 TO RE-MARK NC2534.2 +100400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +100500 MOVE "G" TO CORRECT-X NC2534.2 +100600 PERFORM FAIL. NC2534.2 +100700 SUB-WRITE-F3-11-1. NC2534.2 +100800 PERFORM PRINT-DETAIL. NC2534.2 +100900* NC2534.2 +101000 SUB-INIT-F3-11-2. NC2534.2 +101100 MOVE "SUB-TEST-F3-11-1" TO PAR-NAME. NC2534.2 +101200 ADD 1 TO REC-CT. NC2534.2 +101300 SUB-TEST-F3-11-2. NC2534.2 +101400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +101500 GO TO SUB-FAIL-F3-11-2. NC2534.2 +101600 PERFORM PASS NC2534.2 +101700 GO TO SUB-WRITE-F3-11-2. NC2534.2 +101800 SUB-DELETE-F3-11-2. NC2534.2 +101900 PERFORM DE-LETE. NC2534.2 +102000 GO TO SUB-WRITE-F3-11-2. NC2534.2 +102100 SUB-FAIL-F3-11-2. NC2534.2 +102200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +102300 MOVE "+1" TO CORRECT-A NC2534.2 +102400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +102500 TO RE-MARK NC2534.2 +102600 PERFORM FAIL. NC2534.2 +102700 SUB-WRITE-F3-11-2. NC2534.2 +102800 PERFORM PRINT-DETAIL. NC2534.2 +102900* NC2534.2 +103000 SUB-INIT-F3-11-3. NC2534.2 +103100 MOVE "SUB-TEST-F3-11-3" TO PAR-NAME. NC2534.2 +103200 ADD 1 TO REC-CT. NC2534.2 +103300 SUB-TEST-F3-11-3. NC2534.2 +103400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +103500 GO TO SUB-FAIL-F3-11-3. NC2534.2 +103600 PERFORM PASS NC2534.2 +103700 GO TO SUB-WRITE-F3-11-3. NC2534.2 +103800 SUB-DELETE-F3-11-3. NC2534.2 +103900 PERFORM DE-LETE. NC2534.2 +104000 GO TO SUB-WRITE-F3-11-3. NC2534.2 +104100 SUB-FAIL-F3-11-3. NC2534.2 +104200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +104300 MOVE "+1.96" TO CORRECT-A NC2534.2 +104400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +104500 TO RE-MARK NC2534.2 +104600 PERFORM FAIL. NC2534.2 +104700 SUB-WRITE-F3-11-3. NC2534.2 +104800 PERFORM PRINT-DETAIL. NC2534.2 +104900* NC2534.2 +105000 SUB-INIT-F3-11-4. NC2534.2 +105100 MOVE "SUB-TEST-F3-11-4" TO PAR-NAME. NC2534.2 +105200 ADD 1 TO REC-CT. NC2534.2 +105300 SUB-TEST-F3-11-4. NC2534.2 +105400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +105500 GO TO SUB-FAIL-F3-11-4. NC2534.2 +105600 PERFORM PASS NC2534.2 +105700 GO TO SUB-WRITE-F3-11-4. NC2534.2 +105800 SUB-DELETE-F3-11-4. NC2534.2 +105900 PERFORM DE-LETE. NC2534.2 +106000 GO TO SUB-WRITE-F3-11-4. NC2534.2 +106100 SUB-FAIL-F3-11-4. NC2534.2 +106200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +106300 MOVE "-5.76" TO CORRECT-A NC2534.2 +106400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +106500 TO RE-MARK NC2534.2 +106600 PERFORM FAIL. NC2534.2 +106700 SUB-WRITE-F3-11-4. NC2534.2 +106800 PERFORM PRINT-DETAIL. NC2534.2 +106900* NC2534.2 +107000 SUB-INIT-F3-12. NC2534.2 +107100* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +107200* ===--> SIZE ERROR <--=== NC2534.2 +107300 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +107400 MOVE SPACE TO WRK-AN-00001. NC2534.2 +107500 MOVE 0 TO REC-CT. NC2534.2 +107600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +107700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +107800 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +107900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +108000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +108100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +108200 SUB-TEST-F3-12-0. NC2534.2 +108300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +108400 ON SIZE ERROR NC2534.2 +108500 MOVE "A" TO WRK-AN-00001 NC2534.2 +108600 NOT ON SIZE ERROR NC2534.2 +108700 MOVE "B" TO WRK-AN-00001. NC2534.2 +108800* NC2534.2 +108900 SUB-INIT-F3-12-1. NC2534.2 +109000 MOVE "SUB-TEST-F3-12-1" TO PAR-NAME. NC2534.2 +109100 ADD 1 TO REC-CT. NC2534.2 +109200 SUB-TEST-F3-12-1. NC2534.2 +109300 IF WRK-AN-00001 NOT = "A" NC2534.2 +109400 GO TO SUB-FAIL-F3-12-1. NC2534.2 +109500 PERFORM PASS NC2534.2 +109600 GO TO SUB-WRITE-F3-12-1. NC2534.2 +109700 SUB-DELETE-F3-12-1. NC2534.2 +109800 PERFORM DE-LETE. NC2534.2 +109900 GO TO SUB-WRITE-F3-12-1. NC2534.2 +110000 SUB-FAIL-F3-12-1. NC2534.2 +110100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +110200 TO RE-MARK NC2534.2 +110300 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +110400 MOVE "A" TO CORRECT-X NC2534.2 +110500 PERFORM FAIL. NC2534.2 +110600 SUB-WRITE-F3-12-1. NC2534.2 +110700 PERFORM PRINT-DETAIL. NC2534.2 +110800* NC2534.2 +110900 SUB-INIT-F3-12-2. NC2534.2 +111000 MOVE "SUB-TEST-F3-12-2" TO PAR-NAME. NC2534.2 +111100 ADD 1 TO REC-CT. NC2534.2 +111200 SUB-TEST-F3-12-2. NC2534.2 +111300 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +111400 GO TO SUB-FAIL-F3-12-2. NC2534.2 +111500 PERFORM PASS NC2534.2 +111600 GO TO SUB-WRITE-F3-12-2. NC2534.2 +111700 SUB-DELETE-F3-12-2. NC2534.2 +111800 PERFORM DE-LETE. NC2534.2 +111900 GO TO SUB-WRITE-F3-12-2. NC2534.2 +112000 SUB-FAIL-F3-12-2. NC2534.2 +112100 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +112200 MOVE "+1" TO CORRECT-A NC2534.2 +112300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +112400 TO RE-MARK NC2534.2 +112500 PERFORM FAIL. NC2534.2 +112600 SUB-WRITE-F3-12-2. NC2534.2 +112700 PERFORM PRINT-DETAIL. NC2534.2 +112800* NC2534.2 +112900 SUB-INIT-F3-12-3. NC2534.2 +113000 MOVE "SUB-TEST-F3-12-3" TO PAR-NAME. NC2534.2 +113100 ADD 1 TO REC-CT. NC2534.2 +113200 SUB-TEST-F3-12-3. NC2534.2 +113300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +113400 GO TO SUB-FAIL-F3-12-3. NC2534.2 +113500 PERFORM PASS NC2534.2 +113600 GO TO SUB-WRITE-F3-12-3. NC2534.2 +113700 SUB-DELETE-F3-12-3. NC2534.2 +113800 PERFORM DE-LETE. NC2534.2 +113900 GO TO SUB-WRITE-F3-12-3. NC2534.2 +114000 SUB-FAIL-F3-12-3. NC2534.2 +114100 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +114200 MOVE "+1.96" TO CORRECT-A NC2534.2 +114300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +114400 TO RE-MARK NC2534.2 +114500 PERFORM FAIL. NC2534.2 +114600 SUB-WRITE-F3-12-3. NC2534.2 +114700 PERFORM PRINT-DETAIL. NC2534.2 +114800* NC2534.2 +114900 SUB-INIT-F3-12-4. NC2534.2 +115000 MOVE "SUB-TEST-F3-12-4" TO PAR-NAME. NC2534.2 +115100 ADD 1 TO REC-CT. NC2534.2 +115200 SUB-TEST-F3-12-4. NC2534.2 +115300 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +115400 GO TO SUB-FAIL-F3-12-4. NC2534.2 +115500 PERFORM PASS NC2534.2 +115600 GO TO SUB-WRITE-F3-12-4. NC2534.2 +115700 SUB-DELETE-F3-12-4. NC2534.2 +115800 PERFORM DE-LETE. NC2534.2 +115900 GO TO SUB-WRITE-F3-12-4. NC2534.2 +116000 SUB-FAIL-F3-12-4. NC2534.2 +116100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +116200 MOVE "+1" TO CORRECT-A NC2534.2 +116300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +116400 PERFORM FAIL. NC2534.2 +116500 SUB-WRITE-F3-12-4. NC2534.2 +116600 PERFORM PRINT-DETAIL. NC2534.2 +116700* NC2534.2 +116800 SUB-INIT-F3-13. NC2534.2 +116900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +117000* ===--> NO SIZE ERROR <--=== NC2534.2 +117100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +117200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +117300 MOVE 0 TO REC-CT. NC2534.2 +117400 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +117500 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +117600 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +117700 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +117800 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +117900 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +118000 SUB-TEST-F3-13-0. NC2534.2 +118100 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +118200 ON SIZE ERROR NC2534.2 +118300 MOVE "A" TO WRK-AN-00001 NC2534.2 +118400 NOT ON SIZE ERROR NC2534.2 +118500 MOVE "B" TO WRK-AN-00001. NC2534.2 +118600* NC2534.2 +118700 SUB-INIT-F3-13-1. NC2534.2 +118800 MOVE "SUB-TEST-F3-13-1" TO PAR-NAME. NC2534.2 +118900 ADD 1 TO REC-CT. NC2534.2 +119000 SUB-TEST-F3-13-1. NC2534.2 +119100 IF WRK-AN-00001 NOT = "B" NC2534.2 +119200 GO TO SUB-FAIL-F3-13-1. NC2534.2 +119300 PERFORM PASS NC2534.2 +119400 GO TO SUB-WRITE-F3-13-1. NC2534.2 +119500 SUB-DELETE-F3-13-1. NC2534.2 +119600 PERFORM DE-LETE. NC2534.2 +119700 GO TO SUB-WRITE-F3-13-1. NC2534.2 +119800 SUB-FAIL-F3-13-1. NC2534.2 +119900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +120000 TO RE-MARK NC2534.2 +120100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +120200 MOVE "B" TO CORRECT-X NC2534.2 +120300 PERFORM FAIL. NC2534.2 +120400 SUB-WRITE-F3-13-1. NC2534.2 +120500 PERFORM PRINT-DETAIL. NC2534.2 +120600* NC2534.2 +120700 SUB-INIT-F3-13-2. NC2534.2 +120800 MOVE "SUB-TEST-F3-13-2" TO PAR-NAME. NC2534.2 +120900 ADD 1 TO REC-CT. NC2534.2 +121000 SUB-TEST-F3-13-2. NC2534.2 +121100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +121200 GO TO SUB-FAIL-F3-13-2. NC2534.2 +121300 PERFORM PASS NC2534.2 +121400 GO TO SUB-WRITE-F3-13-2. NC2534.2 +121500 SUB-DELETE-F3-13-2. NC2534.2 +121600 PERFORM DE-LETE. NC2534.2 +121700 GO TO SUB-WRITE-F3-13-2. NC2534.2 +121800 SUB-FAIL-F3-13-2. NC2534.2 +121900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +122000 MOVE "+1" TO CORRECT-A NC2534.2 +122100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND"NC2534.2 +122200 TO RE-MARK NC2534.2 +122300 PERFORM FAIL. NC2534.2 +122400 SUB-WRITE-F3-13-2. NC2534.2 +122500 PERFORM PRINT-DETAIL. NC2534.2 +122600* NC2534.2 +122700 SUB-INIT-F3-13-3. NC2534.2 +122800 MOVE "SUB-TEST-F3-13-3" TO PAR-NAME. NC2534.2 +122900 ADD 1 TO REC-CT. NC2534.2 +123000 SUB-TEST-F3-13-3. NC2534.2 +123100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +123200 GO TO SUB-FAIL-F3-13-3. NC2534.2 +123300 PERFORM PASS NC2534.2 +123400 GO TO SUB-WRITE-F3-13-3. NC2534.2 +123500 SUB-DELETE-F3-13-3. NC2534.2 +123600 PERFORM DE-LETE. NC2534.2 +123700 GO TO SUB-WRITE-F3-13-3. NC2534.2 +123800 SUB-FAIL-F3-13-3. NC2534.2 +123900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +124000 MOVE "+1.96" TO CORRECT-A NC2534.2 +124100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +124200 TO RE-MARK NC2534.2 +124300 PERFORM FAIL. NC2534.2 +124400 SUB-WRITE-F3-13-3. NC2534.2 +124500 PERFORM PRINT-DETAIL. NC2534.2 +124600* NC2534.2 +124700 SUB-INIT-F3-13-4. NC2534.2 +124800 MOVE "SUB-TEST-F3-13-4" TO PAR-NAME. NC2534.2 +124900 ADD 1 TO REC-CT. NC2534.2 +125000 SUB-TEST-F3-13-4. NC2534.2 +125100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +125200 GO TO SUB-FAIL-F3-13-4. NC2534.2 +125300 PERFORM PASS NC2534.2 +125400 GO TO SUB-WRITE-F3-13-4. NC2534.2 +125500 SUB-FAIL-F3-13-4. NC2534.2 +125600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +125700 MOVE "-5.76" TO CORRECT-A NC2534.2 +125800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +125900 TO RE-MARK NC2534.2 +126000 PERFORM FAIL. NC2534.2 +126100 SUB-WRITE-F3-13-4. NC2534.2 +126200 PERFORM PRINT-DETAIL. NC2534.2 +126300* NC2534.2 +126400 SUB-INIT-F3-14. NC2534.2 +126500* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +126600* ===--> SIZE ERROR <--=== NC2534.2 +126700 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +126800 MOVE SPACE TO WRK-AN-00001. NC2534.2 +126900 MOVE SPACE TO WRK-XN-00001. NC2534.2 +127000 MOVE 0 TO REC-CT. NC2534.2 +127100 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +127200 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +127300 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +127400 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +127500 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +127600 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +127700 SUB-TEST-F3-14-0. NC2534.2 +127800 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +127900 ON SIZE ERROR NC2534.2 +128000 MOVE "A" TO WRK-AN-00001 NC2534.2 +128100 END-SUBTRACT NC2534.2 +128200 MOVE "Z" TO WRK-XN-00001. NC2534.2 +128300* NC2534.2 +128400 SUB-INIT-F3-14-1. NC2534.2 +128500 MOVE "SUB-TEST-F3-14-1" TO PAR-NAME. NC2534.2 +128600 ADD 1 TO REC-CT. NC2534.2 +128700 SUB-TEST-F3-14-1. NC2534.2 +128800 IF WRK-AN-00001 NOT = "A" NC2534.2 +128900 GO TO SUB-FAIL-F3-14-1. NC2534.2 +129000 PERFORM PASS NC2534.2 +129100 GO TO SUB-WRITE-F3-14-1. NC2534.2 +129200 SUB-DELETE-F3-14-1. NC2534.2 +129300 PERFORM DE-LETE. NC2534.2 +129400 GO TO SUB-WRITE-F3-14-1. NC2534.2 +129500 SUB-FAIL-F3-14-1. NC2534.2 +129600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +129700 TO RE-MARK NC2534.2 +129800 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +129900 MOVE "A" TO CORRECT-X NC2534.2 +130000 PERFORM FAIL. NC2534.2 +130100 SUB-WRITE-F3-14-1. NC2534.2 +130200 PERFORM PRINT-DETAIL. NC2534.2 +130300* NC2534.2 +130400 SUB-INIT-F3-14-2. NC2534.2 +130500 MOVE "SUB-TEST-F3-14-2" TO PAR-NAME. NC2534.2 +130600 ADD 1 TO REC-CT. NC2534.2 +130700 SUB-TEST-F3-14-2. NC2534.2 +130800 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +130900 GO TO SUB-FAIL-F3-14-2. NC2534.2 +131000 PERFORM PASS NC2534.2 +131100 GO TO SUB-WRITE-F3-14-2. NC2534.2 +131200 SUB-DELETE-F3-14-2. NC2534.2 +131300 PERFORM DE-LETE. NC2534.2 +131400 GO TO SUB-WRITE-F3-14-2. NC2534.2 +131500 SUB-FAIL-F3-14-2. NC2534.2 +131600 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +131700 MOVE "+1" TO CORRECT-A NC2534.2 +131800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +131900 TO RE-MARK NC2534.2 +132000 PERFORM FAIL. NC2534.2 +132100 SUB-WRITE-F3-14-2. NC2534.2 +132200 PERFORM PRINT-DETAIL. NC2534.2 +132300* NC2534.2 +132400 SUB-INIT-F3-14-3. NC2534.2 +132500 MOVE "SUB-TEST-F3-14-3" TO PAR-NAME. NC2534.2 +132600 ADD 1 TO REC-CT. NC2534.2 +132700 SUB-TEST-F3-14-3. NC2534.2 +132800 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +132900 GO TO SUB-FAIL-F3-14-3. NC2534.2 +133000 PERFORM PASS NC2534.2 +133100 GO TO SUB-WRITE-F3-14-3. NC2534.2 +133200 SUB-DELETE-F3-14-3. NC2534.2 +133300 PERFORM DE-LETE. NC2534.2 +133400 GO TO SUB-WRITE-F3-14-3. NC2534.2 +133500 SUB-FAIL-F3-14-3. NC2534.2 +133600 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +133700 MOVE "+1.96" TO CORRECT-A NC2534.2 +133800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +133900 TO RE-MARK NC2534.2 +134000 PERFORM FAIL. NC2534.2 +134100 SUB-WRITE-F3-14-3. NC2534.2 +134200 PERFORM PRINT-DETAIL. NC2534.2 +134300* NC2534.2 +134400 SUB-INIT-F3-14-4. NC2534.2 +134500 MOVE "SUB-TEST-F3-14-4" TO PAR-NAME. NC2534.2 +134600 ADD 1 TO REC-CT. NC2534.2 +134700 SUB-TEST-F3-14-4. NC2534.2 +134800 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +134900 GO TO SUB-FAIL-F3-14-4. NC2534.2 +135000 PERFORM PASS NC2534.2 +135100 GO TO SUB-WRITE-F3-14-4. NC2534.2 +135200 SUB-DELETE-F3-14-4. NC2534.2 +135300 PERFORM DE-LETE. NC2534.2 +135400 GO TO SUB-WRITE-F3-14-4. NC2534.2 +135500 SUB-FAIL-F3-14-4. NC2534.2 +135600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +135700 MOVE "+1" TO CORRECT-A NC2534.2 +135800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +135900 PERFORM FAIL. NC2534.2 +136000 SUB-WRITE-F3-14-4. NC2534.2 +136100 PERFORM PRINT-DETAIL. NC2534.2 +136200* NC2534.2 +136300 SUB-INIT-F3-14-5. NC2534.2 +136400 MOVE "SUB-TEST-F3-14-5" TO PAR-NAME. NC2534.2 +136500 ADD 1 TO REC-CT. NC2534.2 +136600 SUB-TEST-F3-14-5. NC2534.2 +136700 IF WRK-XN-00001 NOT = "Z" NC2534.2 +136800 GO TO SUB-FAIL-F3-14-5. NC2534.2 +136900 PERFORM PASS NC2534.2 +137000 GO TO SUB-WRITE-F3-14-5. NC2534.2 +137100 SUB-DELETE-F3-14-5. NC2534.2 +137200 PERFORM DE-LETE. NC2534.2 +137300 GO TO SUB-WRITE-F3-14-5. NC2534.2 +137400 SUB-FAIL-F3-14-5. NC2534.2 +137500 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +137600 MOVE "Z" TO COMPUTED-X NC2534.2 +137700 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +137800 PERFORM FAIL. NC2534.2 +137900 SUB-WRITE-F3-14-5. NC2534.2 +138000 PERFORM PRINT-DETAIL. NC2534.2 +138100* NC2534.2 +138200 SUB-INIT-F3-15. NC2534.2 +138300* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +138400* ===--> NO SIZE ERROR <--=== NC2534.2 +138500 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +138600 MOVE SPACE TO WRK-AN-00001. NC2534.2 +138700 MOVE SPACE TO WRK-XN-00001. NC2534.2 +138800 MOVE 0 TO REC-CT. NC2534.2 +138900 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +139000 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +139100 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +139200 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +139300 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +139400 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +139500 SUB-TEST-F3-15-0. NC2534.2 +139600 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +139700 ON SIZE ERROR NC2534.2 +139800 MOVE "A" TO WRK-AN-00001 NC2534.2 +139900 END-SUBTRACT NC2534.2 +140000 MOVE "Z" TO WRK-XN-00001. NC2534.2 +140100* NC2534.2 +140200 SUB-INIT-F3-15-1. NC2534.2 +140300 MOVE "SUB-TEST-F3-15-1" TO PAR-NAME. NC2534.2 +140400 ADD 1 TO REC-CT. NC2534.2 +140500 SUB-TEST-F3-15-1. NC2534.2 +140600 IF WRK-AN-00001 = "A" NC2534.2 +140700 GO TO SUB-FAIL-F3-15-1. NC2534.2 +140800 PERFORM PASS NC2534.2 +140900 GO TO SUB-WRITE-F3-15-1. NC2534.2 +141000 SUB-FAIL-F3-15-1. NC2534.2 +141100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2534.2 +141200 TO RE-MARK NC2534.2 +141300 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +141400 MOVE SPACE TO CORRECT-X NC2534.2 +141500 PERFORM FAIL. NC2534.2 +141600 SUB-WRITE-F3-15-1. NC2534.2 +141700 PERFORM PRINT-DETAIL. NC2534.2 +141800* NC2534.2 +141900 SUB-INIT-F3-15-2. NC2534.2 +142000 MOVE "SUB-TEST-F3-15-2" TO PAR-NAME. NC2534.2 +142100 ADD 1 TO REC-CT. NC2534.2 +142200 SUB-TEST-F3-15-2. NC2534.2 +142300 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +142400 GO TO SUB-FAIL-F3-15-2. NC2534.2 +142500 PERFORM PASS NC2534.2 +142600 GO TO SUB-WRITE-F3-15-2. NC2534.2 +142700 SUB-DELETE-F3-15-2. NC2534.2 +142800 PERFORM DE-LETE. NC2534.2 +142900 GO TO SUB-WRITE-F3-15-2. NC2534.2 +143000 SUB-FAIL-F3-15-2. NC2534.2 +143100 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +143200 MOVE "+1" TO CORRECT-A NC2534.2 +143300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +143400 TO RE-MARK NC2534.2 +143500 PERFORM FAIL. NC2534.2 +143600 SUB-WRITE-F3-15-2. NC2534.2 +143700 PERFORM PRINT-DETAIL. NC2534.2 +143800* NC2534.2 +143900 SUB-INIT-F3-15-3. NC2534.2 +144000 MOVE "SUB-TEST-F3-15-3" TO PAR-NAME. NC2534.2 +144100 ADD 1 TO REC-CT. NC2534.2 +144200 SUB-TEST-F3-15-3. NC2534.2 +144300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +144400 GO TO SUB-FAIL-F3-15-3. NC2534.2 +144500 PERFORM PASS NC2534.2 +144600 GO TO SUB-WRITE-F3-15-3. NC2534.2 +144700 SUB-DELETE-F3-15-3. NC2534.2 +144800 PERFORM DE-LETE. NC2534.2 +144900 GO TO SUB-WRITE-F3-15-3. NC2534.2 +145000 SUB-FAIL-F3-15-3. NC2534.2 +145100 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +145200 MOVE "+1.96" TO CORRECT-A NC2534.2 +145300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +145400 TO RE-MARK NC2534.2 +145500 PERFORM FAIL. NC2534.2 +145600 SUB-WRITE-F3-15-3. NC2534.2 +145700 PERFORM PRINT-DETAIL. NC2534.2 +145800* NC2534.2 +145900 SUB-INIT-F3-15-4. NC2534.2 +146000 MOVE "SUB-TEST-F3-15-4" TO PAR-NAME. NC2534.2 +146100 ADD 1 TO REC-CT. NC2534.2 +146200 SUB-TEST-F3-15-4. NC2534.2 +146300 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +146400 GO TO SUB-FAIL-F3-15-4. NC2534.2 +146500 PERFORM PASS NC2534.2 +146600 GO TO SUB-WRITE-F3-15-4. NC2534.2 +146700 SUB-DELETE-F3-15-4. NC2534.2 +146800 PERFORM DE-LETE. NC2534.2 +146900 GO TO SUB-WRITE-F3-15-4. NC2534.2 +147000 SUB-FAIL-F3-15-4. NC2534.2 +147100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +147200 MOVE "-5.76" TO CORRECT-A NC2534.2 +147300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +147400 TO RE-MARK NC2534.2 +147500 PERFORM FAIL. NC2534.2 +147600 SUB-WRITE-F3-15-4. NC2534.2 +147700 PERFORM PRINT-DETAIL. NC2534.2 +147800* NC2534.2 +147900 SUB-INIT-F3-15-5. NC2534.2 +148000 MOVE "SUB-TEST-F3-15-5" TO PAR-NAME. NC2534.2 +148100 ADD 1 TO REC-CT. NC2534.2 +148200 SUB-TEST-F3-15-5. NC2534.2 +148300 IF WRK-XN-00001 NOT = "Z" NC2534.2 +148400 GO TO SUB-FAIL-F3-15-5. NC2534.2 +148500 PERFORM PASS NC2534.2 +148600 GO TO SUB-WRITE-F3-15-5. NC2534.2 +148700 SUB-DELETE-F3-15-5. NC2534.2 +148800 PERFORM DE-LETE. NC2534.2 +148900 GO TO SUB-WRITE-F3-15-5. NC2534.2 +149000 SUB-FAIL-F3-15-5. NC2534.2 +149100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +149200 MOVE "Z" TO COMPUTED-X NC2534.2 +149300 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +149400 PERFORM FAIL. NC2534.2 +149500 SUB-WRITE-F3-15-5. NC2534.2 +149600 PERFORM PRINT-DETAIL. NC2534.2 +149700* NC2534.2 +149800 SUB-INIT-F3-16. NC2534.2 +149900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +150000* ===--> SIZE ERROR <--=== NC2534.2 +150100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +150200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +150300 MOVE SPACE TO WRK-XN-00001. NC2534.2 +150400 MOVE 0 TO REC-CT. NC2534.2 +150500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +150600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +150700 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +150800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +150900 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +151000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +151100 SUB-TEST-F3-16-0. NC2534.2 +151200 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +151300 ON SIZE ERROR NC2534.2 +151400 MOVE "A" TO WRK-AN-00001 NC2534.2 +151500 NOT ON SIZE ERROR NC2534.2 +151600 MOVE "B" TO WRK-AN-00001 NC2534.2 +151700 END-SUBTRACT NC2534.2 +151800 MOVE "Z" TO WRK-XN-00001. NC2534.2 +151900* NC2534.2 +152000 SUB-INIT-F3-16-1. NC2534.2 +152100 MOVE "SUB-TEST-F3-16-1" TO PAR-NAME. NC2534.2 +152200 ADD 1 TO REC-CT. NC2534.2 +152300 SUB-TEST-F3-16-1. NC2534.2 +152400 IF WRK-AN-00001 NOT = "A" NC2534.2 +152500 GO TO SUB-FAIL-F3-16-1. NC2534.2 +152600 PERFORM PASS NC2534.2 +152700 GO TO SUB-WRITE-F3-16-1. NC2534.2 +152800 SUB-DELETE-F3-16-1. NC2534.2 +152900 PERFORM DE-LETE. NC2534.2 +153000 GO TO SUB-WRITE-F3-16-1. NC2534.2 +153100 SUB-FAIL-F3-16-1. NC2534.2 +153200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +153300 TO RE-MARK NC2534.2 +153400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +153500 MOVE "A" TO CORRECT-X NC2534.2 +153600 PERFORM FAIL. NC2534.2 +153700 SUB-WRITE-F3-16-1. NC2534.2 +153800 PERFORM PRINT-DETAIL. NC2534.2 +153900* NC2534.2 +154000 SUB-INIT-F3-16-2. NC2534.2 +154100 MOVE "SUB-TEST-F3-16-2" TO PAR-NAME. NC2534.2 +154200 ADD 1 TO REC-CT. NC2534.2 +154300 SUB-TEST-F3-16-2. NC2534.2 +154400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +154500 GO TO SUB-FAIL-F3-16-2. NC2534.2 +154600 PERFORM PASS NC2534.2 +154700 GO TO SUB-WRITE-F3-16-2. NC2534.2 +154800 SUB-DELETE-F3-16-2. NC2534.2 +154900 PERFORM DE-LETE. NC2534.2 +155000 GO TO SUB-WRITE-F3-16-2. NC2534.2 +155100 SUB-FAIL-F3-16-2. NC2534.2 +155200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +155300 MOVE "+1" TO CORRECT-A NC2534.2 +155400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +155500 TO RE-MARK NC2534.2 +155600 PERFORM FAIL. NC2534.2 +155700 SUB-WRITE-F3-16-2. NC2534.2 +155800 PERFORM PRINT-DETAIL. NC2534.2 +155900* NC2534.2 +156000 SUB-INIT-F3-16-3. NC2534.2 +156100 MOVE "SUB-TEST-F3-16-3" TO PAR-NAME. NC2534.2 +156200 ADD 1 TO REC-CT. NC2534.2 +156300 SUB-TEST-F3-16-3. NC2534.2 +156400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +156500 GO TO SUB-FAIL-F3-16-3. NC2534.2 +156600 PERFORM PASS NC2534.2 +156700 GO TO SUB-WRITE-F3-16-3. NC2534.2 +156800 SUB-DELETE-F3-16-3. NC2534.2 +156900 PERFORM DE-LETE. NC2534.2 +157000 GO TO SUB-WRITE-F3-16-3. NC2534.2 +157100 SUB-FAIL-F3-16-3. NC2534.2 +157200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +157300 MOVE "+1.96" TO CORRECT-A NC2534.2 +157400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +157500 TO RE-MARK NC2534.2 +157600 PERFORM FAIL. NC2534.2 +157700 SUB-WRITE-F3-16-3. NC2534.2 +157800 PERFORM PRINT-DETAIL. NC2534.2 +157900* NC2534.2 +158000 SUB-INIT-F3-16-4. NC2534.2 +158100 MOVE "SUB-TEST-F3-16-4" TO PAR-NAME. NC2534.2 +158200 ADD 1 TO REC-CT. NC2534.2 +158300 SUB-TEST-F3-16-4. NC2534.2 +158400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +158500 GO TO SUB-FAIL-F3-16-4. NC2534.2 +158600 PERFORM PASS NC2534.2 +158700 GO TO SUB-WRITE-F3-16-4. NC2534.2 +158800 SUB-DELETE-F3-16-4. NC2534.2 +158900 PERFORM DE-LETE. NC2534.2 +159000 GO TO SUB-WRITE-F3-16-4. NC2534.2 +159100 SUB-FAIL-F3-16-4. NC2534.2 +159200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +159300 MOVE "+1" TO CORRECT-A NC2534.2 +159400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +159500 PERFORM FAIL. NC2534.2 +159600 SUB-WRITE-F3-16-4. NC2534.2 +159700 PERFORM PRINT-DETAIL. NC2534.2 +159800* NC2534.2 +159900 SUB-INIT-F3-16-5. NC2534.2 +160000 MOVE "SUB-TEST-F3-16-5" TO PAR-NAME. NC2534.2 +160100 ADD 1 TO REC-CT. NC2534.2 +160200 SUB-TEST-F3-16-5. NC2534.2 +160300 IF WRK-XN-00001 NOT = "Z" NC2534.2 +160400 GO TO SUB-FAIL-F3-16-5. NC2534.2 +160500 PERFORM PASS NC2534.2 +160600 GO TO SUB-WRITE-F3-16-5. NC2534.2 +160700 SUB-DELETE-F3-16-5. NC2534.2 +160800 PERFORM DE-LETE. NC2534.2 +160900 GO TO SUB-WRITE-F3-16-5. NC2534.2 +161000 SUB-FAIL-F3-16-5. NC2534.2 +161100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +161200 MOVE "Z" TO COMPUTED-X NC2534.2 +161300 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +161400 PERFORM FAIL. NC2534.2 +161500 SUB-WRITE-F3-16-5. NC2534.2 +161600 PERFORM PRINT-DETAIL. NC2534.2 +161700* NC2534.2 +161800 SUB-INIT-F3-17. NC2534.2 +161900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +162000* ===--> NO SIZE ERROR <--=== NC2534.2 +162100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +162200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +162300 MOVE SPACE TO WRK-XN-00001. NC2534.2 +162400 MOVE 0 TO REC-CT. NC2534.2 +162500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +162600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +162700 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +162800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +162900 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +163000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +163100 SUB-TEST-F3-17-0. NC2534.2 +163200 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +163300 ON SIZE ERROR NC2534.2 +163400 MOVE "A" TO WRK-AN-00001 NC2534.2 +163500 NOT ON SIZE ERROR NC2534.2 +163600 MOVE "B" TO WRK-AN-00001 NC2534.2 +163700 END-SUBTRACT NC2534.2 +163800 MOVE "Z" TO WRK-XN-00001. NC2534.2 +163900* NC2534.2 +164000 SUB-INIT-F3-17-1. NC2534.2 +164100 MOVE "SUB-TEST-F3-17-1" TO PAR-NAME. NC2534.2 +164200 ADD 1 TO REC-CT. NC2534.2 +164300 SUB-TEST-F3-17-1. NC2534.2 +164400 IF WRK-AN-00001 NOT = "B" NC2534.2 +164500 GO TO SUB-FAIL-F3-17-1. NC2534.2 +164600 PERFORM PASS NC2534.2 +164700 GO TO SUB-WRITE-F3-17-1. NC2534.2 +164800 SUB-DELETE-F3-17-1. NC2534.2 +164900 PERFORM DE-LETE. NC2534.2 +165000 GO TO SUB-WRITE-F3-17-1. NC2534.2 +165100 SUB-FAIL-F3-17-1. NC2534.2 +165200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +165300 TO RE-MARK NC2534.2 +165400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +165500 MOVE "B" TO CORRECT-X NC2534.2 +165600 PERFORM FAIL. NC2534.2 +165700 SUB-WRITE-F3-17-1. NC2534.2 +165800 PERFORM PRINT-DETAIL. NC2534.2 +165900* NC2534.2 +166000 SUB-INIT-F3-17-2. NC2534.2 +166100 MOVE "SUB-TEST-F3-17-2" TO PAR-NAME. NC2534.2 +166200 ADD 1 TO REC-CT. NC2534.2 +166300 SUB-TEST-F3-17-2. NC2534.2 +166400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +166500 GO TO SUB-FAIL-F3-17-2. NC2534.2 +166600 PERFORM PASS NC2534.2 +166700 GO TO SUB-WRITE-F3-17-2. NC2534.2 +166800 SUB-DELETE-F3-17-2. NC2534.2 +166900 PERFORM DE-LETE. NC2534.2 +167000 GO TO SUB-WRITE-F3-17-2. NC2534.2 +167100 SUB-FAIL-F3-17-2. NC2534.2 +167200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +167300 MOVE "+1" TO CORRECT-A NC2534.2 +167400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +167500 TO RE-MARK NC2534.2 +167600 PERFORM FAIL. NC2534.2 +167700 SUB-WRITE-F3-17-2. NC2534.2 +167800 PERFORM PRINT-DETAIL. NC2534.2 +167900* NC2534.2 +168000 SUB-INIT-F3-17-3. NC2534.2 +168100 MOVE "SUB-TEST-F3-17-3" TO PAR-NAME. NC2534.2 +168200 ADD 1 TO REC-CT. NC2534.2 +168300 SUB-TEST-F3-17-3. NC2534.2 +168400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +168500 GO TO SUB-FAIL-F3-17-3. NC2534.2 +168600 PERFORM PASS NC2534.2 +168700 GO TO SUB-WRITE-F3-17-3. NC2534.2 +168800 SUB-DELETE-F3-17-3. NC2534.2 +168900 PERFORM DE-LETE. NC2534.2 +169000 GO TO SUB-WRITE-F3-17-3. NC2534.2 +169100 SUB-FAIL-F3-17-3. NC2534.2 +169200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +169300 MOVE "+1.96" TO CORRECT-A NC2534.2 +169400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +169500 TO RE-MARK NC2534.2 +169600 PERFORM FAIL. NC2534.2 +169700 SUB-WRITE-F3-17-3. NC2534.2 +169800 PERFORM PRINT-DETAIL. NC2534.2 +169900* NC2534.2 +170000 SUB-INIT-F3-17-4. NC2534.2 +170100 MOVE "SUB-TEST-F3-17-4" TO PAR-NAME. NC2534.2 +170200 ADD 1 TO REC-CT. NC2534.2 +170300 SUB-TEST-F3-17-4. NC2534.2 +170400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +170500 GO TO SUB-FAIL-F3-17-4. NC2534.2 +170600 PERFORM PASS NC2534.2 +170700 GO TO SUB-WRITE-F3-17-4. NC2534.2 +170800 SUB-DELETE-F3-17-4. NC2534.2 +170900 PERFORM DE-LETE. NC2534.2 +171000 GO TO SUB-WRITE-F3-17-4. NC2534.2 +171100 SUB-FAIL-F3-17-4. NC2534.2 +171200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +171300 MOVE "-5.76" TO CORRECT-A NC2534.2 +171400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +171500 TO RE-MARK NC2534.2 +171600 PERFORM FAIL. NC2534.2 +171700 SUB-WRITE-F3-17-4. NC2534.2 +171800 PERFORM PRINT-DETAIL. NC2534.2 +171900* NC2534.2 +172000 SUB-INIT-F3-17-5. NC2534.2 +172100 MOVE "SUB-TEST-F3-17-5" TO PAR-NAME. NC2534.2 +172200 ADD 1 TO REC-CT. NC2534.2 +172300 SUB-TEST-F3-17-5. NC2534.2 +172400 IF WRK-XN-00001 NOT = "Z" NC2534.2 +172500 GO TO SUB-FAIL-F3-17-5. NC2534.2 +172600 PERFORM PASS NC2534.2 +172700 GO TO SUB-WRITE-F3-17-5. NC2534.2 +172800 SUB-DELETE-F3-17-5. NC2534.2 +172900 PERFORM DE-LETE. NC2534.2 +173000 GO TO SUB-WRITE-F3-17-5. NC2534.2 +173100 SUB-FAIL-F3-17-5. NC2534.2 +173200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +173300 MOVE "Z" TO COMPUTED-X NC2534.2 +173400 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +173500 PERFORM FAIL. NC2534.2 +173600 SUB-WRITE-F3-17-5. NC2534.2 +173700 PERFORM PRINT-DETAIL. NC2534.2 +173800* NC2534.2 +173900 SUB-INIT-F3-18. NC2534.2 +174000* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +174100* ===--> SIZE ERROR <--=== NC2534.2 +174200 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +174300 MOVE SPACE TO WRK-AN-00001. NC2534.2 +174400 MOVE SPACE TO WRK-XN-00001. NC2534.2 +174500 MOVE 0 TO REC-CT. NC2534.2 +174600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +174700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +174800 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +174900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +175000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +175100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +175200 SUB-TEST-F3-18-0. NC2534.2 +175300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +175400 ON SIZE ERROR NC2534.2 +175500 MOVE "A" TO WRK-AN-00001 NC2534.2 +175600 NOT ON SIZE ERROR NC2534.2 +175700 MOVE "B" TO WRK-AN-00001 NC2534.2 +175800 END-SUBTRACT NC2534.2 +175900 MOVE "Z" TO WRK-XN-00001. NC2534.2 +176000* NC2534.2 +176100 SUB-INIT-F3-18-1. NC2534.2 +176200 MOVE "SUB-TEST-F3-18-1" TO PAR-NAME. NC2534.2 +176300 ADD 1 TO REC-CT. NC2534.2 +176400 SUB-TEST-F3-18-1. NC2534.2 +176500 IF WRK-AN-00001 NOT = "A" NC2534.2 +176600 GO TO SUB-FAIL-F3-18-1. NC2534.2 +176700 PERFORM PASS NC2534.2 +176800 GO TO SUB-WRITE-F3-18-1. NC2534.2 +176900 SUB-DELETE-F3-18-1. NC2534.2 +177000 PERFORM DE-LETE. NC2534.2 +177100 GO TO SUB-WRITE-F3-18-1. NC2534.2 +177200 SUB-FAIL-F3-18-1. NC2534.2 +177300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +177400 TO RE-MARK NC2534.2 +177500 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +177600 MOVE "A" TO CORRECT-X NC2534.2 +177700 PERFORM FAIL. NC2534.2 +177800 SUB-WRITE-F3-18-1. NC2534.2 +177900 PERFORM PRINT-DETAIL. NC2534.2 +178000* NC2534.2 +178100 SUB-INIT-F3-18-2. NC2534.2 +178200 MOVE "SUB-TEST-F3-18-2" TO PAR-NAME. NC2534.2 +178300 ADD 1 TO REC-CT. NC2534.2 +178400 SUB-TEST-F3-18-2. NC2534.2 +178500 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +178600 GO TO SUB-FAIL-F3-18-2. NC2534.2 +178700 PERFORM PASS NC2534.2 +178800 GO TO SUB-WRITE-F3-18-2. NC2534.2 +178900 SUB-FAIL-F3-18-2. NC2534.2 +179000 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +179100 MOVE "+1" TO CORRECT-A NC2534.2 +179200 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +179300 TO RE-MARK NC2534.2 +179400 PERFORM FAIL. NC2534.2 +179500 SUB-WRITE-F3-18-2. NC2534.2 +179600 PERFORM PRINT-DETAIL. NC2534.2 +179700* NC2534.2 +179800 SUB-INIT-F3-18-3. NC2534.2 +179900 MOVE "SUB-TEST-F3-18-3" TO PAR-NAME. NC2534.2 +180000 ADD 1 TO REC-CT. NC2534.2 +180100 SUB-TEST-F3-18-3. NC2534.2 +180200 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +180300 GO TO SUB-FAIL-F3-18-3. NC2534.2 +180400 PERFORM PASS NC2534.2 +180500 GO TO SUB-WRITE-F3-18-3. NC2534.2 +180600 SUB-DELETE-F3-18-3. NC2534.2 +180700 PERFORM DE-LETE. NC2534.2 +180800 GO TO SUB-WRITE-F3-18-3. NC2534.2 +180900 SUB-FAIL-F3-18-3. NC2534.2 +181000 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +181100 MOVE "+1.96" TO CORRECT-A NC2534.2 +181200 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +181300 TO RE-MARK NC2534.2 +181400 PERFORM FAIL. NC2534.2 +181500 SUB-WRITE-F3-18-3. NC2534.2 +181600 PERFORM PRINT-DETAIL. NC2534.2 +181700* NC2534.2 +181800 SUB-INIT-F3-18-4. NC2534.2 +181900 MOVE "SUB-TEST-F3-18-4" TO PAR-NAME. NC2534.2 +182000 ADD 1 TO REC-CT. NC2534.2 +182100 SUB-TEST-F3-18-4. NC2534.2 +182200 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +182300 GO TO SUB-FAIL-F3-18-4. NC2534.2 +182400 PERFORM PASS NC2534.2 +182500 GO TO SUB-WRITE-F3-18-4. NC2534.2 +182600 SUB-DELETE-F3-18-4. NC2534.2 +182700 PERFORM DE-LETE. NC2534.2 +182800 GO TO SUB-WRITE-F3-18-4. NC2534.2 +182900 SUB-FAIL-F3-18-4. NC2534.2 +183000 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +183100 MOVE "+1" TO CORRECT-A NC2534.2 +183200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +183300 PERFORM FAIL. NC2534.2 +183400 SUB-WRITE-F3-18-4. NC2534.2 +183500 PERFORM PRINT-DETAIL. NC2534.2 +183600* NC2534.2 +183700 SUB-INIT-F3-18-5. NC2534.2 +183800 MOVE "SUB-TEST-F3-18-5" TO PAR-NAME. NC2534.2 +183900 ADD 1 TO REC-CT. NC2534.2 +184000 SUB-TEST-F3-18-5. NC2534.2 +184100 IF WRK-XN-00001 NOT = "Z" NC2534.2 +184200 GO TO SUB-FAIL-F3-18-5. NC2534.2 +184300 PERFORM PASS NC2534.2 +184400 GO TO SUB-WRITE-F3-18-5. NC2534.2 +184500 SUB-DELETE-F3-18-5. NC2534.2 +184600 PERFORM DE-LETE. NC2534.2 +184700 GO TO SUB-WRITE-F3-18-5. NC2534.2 +184800 SUB-FAIL-F3-18-5. NC2534.2 +184900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +185000 MOVE "Z" TO COMPUTED-X NC2534.2 +185100 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +185200 PERFORM FAIL. NC2534.2 +185300 SUB-WRITE-F3-18-5. NC2534.2 +185400 PERFORM PRINT-DETAIL. NC2534.2 +185500* NC2534.2 +185600 SUB-INIT-F3-19. NC2534.2 +185700* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +185800* ===--> NO SIZE ERROR <--=== NC2534.2 +185900 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +186000 MOVE SPACE TO WRK-AN-00001. NC2534.2 +186100 MOVE 0 TO REC-CT. NC2534.2 +186200 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +186300 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +186400 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +186500 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +186600 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +186700 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +186800 SUB-TEST-F3-19-0. NC2534.2 +186900 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +187000 ON SIZE ERROR NC2534.2 +187100 MOVE "A" TO WRK-AN-00001 NC2534.2 +187200 NOT ON SIZE ERROR NC2534.2 +187300 MOVE "B" TO WRK-AN-00001 NC2534.2 +187400 END-SUBTRACT NC2534.2 +187500 MOVE "Z" TO WRK-XN-00001. NC2534.2 +187600* NC2534.2 +187700 SUB-INIT-F3-19-1. NC2534.2 +187800 MOVE "SUB-TEST-F3-19-1" TO PAR-NAME. NC2534.2 +187900 ADD 1 TO REC-CT. NC2534.2 +188000 SUB-TEST-F3-19-1. NC2534.2 +188100 IF WRK-AN-00001 NOT = "B" NC2534.2 +188200 GO TO SUB-FAIL-F3-19-1. NC2534.2 +188300 PERFORM PASS NC2534.2 +188400 GO TO SUB-WRITE-F3-19-1. NC2534.2 +188500 SUB-DELETE-F3-19-1. NC2534.2 +188600 PERFORM DE-LETE. NC2534.2 +188700 GO TO SUB-WRITE-F3-19-1. NC2534.2 +188800 SUB-FAIL-F3-19-1. NC2534.2 +188900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +189000 TO RE-MARK NC2534.2 +189100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +189200 MOVE "B" TO CORRECT-X NC2534.2 +189300 PERFORM FAIL. NC2534.2 +189400 SUB-WRITE-F3-19-1. NC2534.2 +189500 PERFORM PRINT-DETAIL. NC2534.2 +189600* NC2534.2 +189700 SUB-INIT-F3-19-2. NC2534.2 +189800 MOVE "SUB-TEST-F3-19-2" TO PAR-NAME. NC2534.2 +189900 ADD 1 TO REC-CT. NC2534.2 +190000 SUB-TEST-F3-19-2. NC2534.2 +190100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +190200 GO TO SUB-FAIL-F3-19-2. NC2534.2 +190300 PERFORM PASS NC2534.2 +190400 GO TO SUB-WRITE-F3-19-2. NC2534.2 +190500 SUB-DELETE-F3-19-2. NC2534.2 +190600 PERFORM DE-LETE. NC2534.2 +190700 GO TO SUB-WRITE-F3-19-2. NC2534.2 +190800 SUB-FAIL-F3-19-2. NC2534.2 +190900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +191000 MOVE "+1" TO CORRECT-A NC2534.2 +191100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +191200 TO RE-MARK NC2534.2 +191300 PERFORM FAIL. NC2534.2 +191400 SUB-WRITE-F3-19-2. NC2534.2 +191500 PERFORM PRINT-DETAIL. NC2534.2 +191600* NC2534.2 +191700 SUB-INIT-F3-19-3. NC2534.2 +191800 MOVE "SUB-TEST-F3-19-3" TO PAR-NAME. NC2534.2 +191900 ADD 1 TO REC-CT. NC2534.2 +192000 SUB-TEST-F3-19-3. NC2534.2 +192100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +192200 GO TO SUB-FAIL-F3-19-3. NC2534.2 +192300 PERFORM PASS NC2534.2 +192400 GO TO SUB-WRITE-F3-19-3. NC2534.2 +192500 SUB-DELETE-F3-19-3. NC2534.2 +192600 PERFORM DE-LETE. NC2534.2 +192700 GO TO SUB-WRITE-F3-19-3. NC2534.2 +192800 SUB-FAIL-F3-19-3. NC2534.2 +192900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +193000 MOVE "+1.96" TO CORRECT-A NC2534.2 +193100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +193200 TO RE-MARK NC2534.2 +193300 PERFORM FAIL. NC2534.2 +193400 SUB-WRITE-F3-19-3. NC2534.2 +193500 PERFORM PRINT-DETAIL. NC2534.2 +193600* NC2534.2 +193700 SUB-INIT-F3-19-4. NC2534.2 +193800 MOVE "SUB-TEST-F3-19-4" TO PAR-NAME. NC2534.2 +193900 ADD 1 TO REC-CT. NC2534.2 +194000 SUB-TEST-F3-19-4. NC2534.2 +194100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +194200 GO TO SUB-FAIL-F3-19-4. NC2534.2 +194300 PERFORM PASS NC2534.2 +194400 GO TO SUB-WRITE-F3-19-4. NC2534.2 +194500 SUB-DELETE-F3-19-4. NC2534.2 +194600 PERFORM DE-LETE. NC2534.2 +194700 GO TO SUB-WRITE-F3-19-4. NC2534.2 +194800 SUB-FAIL-F3-19-4. NC2534.2 +194900 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +195000 MOVE "-5.76" TO CORRECT-A NC2534.2 +195100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +195200 TO RE-MARK NC2534.2 +195300 PERFORM FAIL. NC2534.2 +195400 SUB-WRITE-F3-19-4. NC2534.2 +195500 PERFORM PRINT-DETAIL. NC2534.2 +195600* NC2534.2 +195700 SUB-INIT-F3-19-5. NC2534.2 +195800 MOVE "SUB-TEST-F3-19-5" TO PAR-NAME. NC2534.2 +195900 ADD 1 TO REC-CT. NC2534.2 +196000 SUB-TEST-F3-19-5. NC2534.2 +196100 IF WRK-XN-00001 NOT = "Z" NC2534.2 +196200 GO TO SUB-FAIL-F3-19-5. NC2534.2 +196300 PERFORM PASS NC2534.2 +196400 GO TO SUB-WRITE-F3-19-5. NC2534.2 +196500 SUB-DELETE-F3-19-5. NC2534.2 +196600 PERFORM DE-LETE. NC2534.2 +196700 GO TO SUB-WRITE-F3-19-5. NC2534.2 +196800 SUB-FAIL-F3-19-5. NC2534.2 +196900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +197000 MOVE "Z" TO COMPUTED-X NC2534.2 +197100 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +197200 PERFORM FAIL. NC2534.2 +197300 SUB-WRITE-F3-19-5. NC2534.2 +197400 PERFORM PRINT-DETAIL. NC2534.2 +197500* NC2534.2 +197600 CCVS-EXIT SECTION. NC2534.2 +197700 CCVS-999999. NC2534.2 +197800 GO TO CLOSE-FILES. NC2534.2 +*END-OF,NC253A +*HEADER,COBOL,NC254A +000100 IDENTIFICATION DIVISION. NC2544.2 +000200 PROGRAM-ID. NC2544.2 +000300 NC254A. NC2544.2 +000400**************************************************************** NC2544.2 +000500* * NC2544.2 +000600* VALIDATION FOR:- * NC2544.2 +000700* * NC2544.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +000900* * NC2544.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +001100* * NC2544.2 +001200**************************************************************** NC2544.2 +001300* * NC2544.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2544.2 +001500* * NC2544.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2544.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2544.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2544.2 +001900* * NC2544.2 +002000**************************************************************** NC2544.2 +002100* NC2544.2 +002200* PROGRAM NC254A TESTS SWITCH SETTINGS USING LEVEL 2 FEATURES NC2544.2 +002300* LOGICAL OPERATORS AND, OR, NOT. NC2544.2 +002400* NC2544.2 +002500 ENVIRONMENT DIVISION. NC2544.2 +002600 CONFIGURATION SECTION. NC2544.2 +002700 SOURCE-COMPUTER. NC2544.2 +002800 XXXXX082. NC2544.2 +002900 OBJECT-COMPUTER. NC2544.2 +003000 XXXXX083. NC2544.2 +003100ASPECIAL-NAMES. NC2544.2 +003200A XXXXX051 NC2544.2 +003300A IS SW-1 NC2544.2 +003400A ON STATUS IS ON-SWITCH-1 NC2544.2 +003500A OFF STATUS IS OFF-SWITCH-1 NC2544.2 +003600A XXXXX052 NC2544.2 +003700A IS SW-2 NC2544.2 +003800A ON IS ON-SWITCH-2 NC2544.2 +003900A OFF IS OFF-SWITCH-2 NC2544.2 +004000 CLASS ORDINAL-A-ONLY IS NC2544.2 +004100 XXXXX090 NC2544.2 +004200 CLASS ORDINAL-A-THROUGH-D IS NC2544.2 +004300 XXXXX090 NC2544.2 +004400 THROUGH NC2544.2 +004500 XXXXX091 NC2544.2 +004600 CLASS ORDINAL-D-THRU-A NC2544.2 +004700 XXXXX091 NC2544.2 +004800 THRU NC2544.2 +004900 XXXXX090 NC2544.2 +005000 CLASS ACTUAL-A-ONLY "A" NC2544.2 +005100 CLASS ACTUAL-A-THRU-D IS "A" THRU "D" NC2544.2 +005200 CLASS ACTUAL-D-THROUGH-A IS "D" THROUGH "A" NC2544.2 +005300 CLASS ACTUAL-ABCD "ABCD". NC2544.2 +005400 INPUT-OUTPUT SECTION. NC2544.2 +005500 FILE-CONTROL. NC2544.2 +005600 SELECT PRINT-FILE ASSIGN TO NC2544.2 +005700 XXXXX055. NC2544.2 +005800 DATA DIVISION. NC2544.2 +005900 FILE SECTION. NC2544.2 +006000 FD PRINT-FILE. NC2544.2 +006100 01 PRINT-REC PICTURE X(120). NC2544.2 +006200 01 DUMMY-RECORD PICTURE X(120). NC2544.2 +006300 WORKING-STORAGE SECTION. NC2544.2 +006400 01 WS-A PIC X. NC2544.2 +006500 01 WS-B PIC X(5). NC2544.2 +006600 01 IF-D1 PICTURE IS S9(4)V9(2) NC2544.2 +006700 VALUE IS 0. NC2544.2 +006800 01 IF-D2 PICTURE IS S9(4)V9(2) NC2544.2 +006900 VALUE IS ZERO. NC2544.2 +007000 01 IF-D3 PICTURE IS X(10) NC2544.2 +007100 VALUE IS "0000000000". NC2544.2 +007200 01 IF-D4 PICTURE IS X(15) NC2544.2 +007300 VALUE IS " ". NC2544.2 +007400 01 IF-D6 PICTURE IS A(10) NC2544.2 +007500 VALUE IS "BABABABABA". NC2544.2 +007600 01 IF-D7 PICTURE IS S9(6)V9(4) NC2544.2 +007700 VALUE IS +123.45. NC2544.2 +007800 01 IF-D8 PICTURE IS 9(6)V9(4) NC2544.2 +007900 VALUE IS 12300. NC2544.2 +008000 01 IF-D9 PICTURE IS X(3) NC2544.2 +008100 VALUE IS "123". NC2544.2 +008200 01 IF-D11 PICTURE IS X(6) NC2544.2 +008300 VALUE IS "ABCDEF". NC2544.2 +008400 01 IF-D13 PICTURE IS 9(6)V9(4) NC2544.2 +008500 VALUE IS 12300. NC2544.2 +008600 01 IF-D14 PICTURE IS S9(4)V9(2) NC2544.2 +008700 VALUE IS +123.45. NC2544.2 +008800 01 IF-D15 PICTURE IS S999PP NC2544.2 +008900 VALUE IS 12300. NC2544.2 +009000 01 IF-D16 PICTURE IS PP99 NC2544.2 +009100 VALUE IS .0012. NC2544.2 +009200 01 IF-D17 PICTURE IS SV9(4) NC2544.2 +009300 VALUE IS .0012. NC2544.2 +009400 01 IF-D18 PICTURE IS X(10) NC2544.2 +009500 VALUE IS "BABABABABA". NC2544.2 +009600 01 IF-D19 PICTURE IS X(10) NC2544.2 +009700 VALUE IS "ABCDEF ". NC2544.2 +009800 01 IF-D23 PICTURE IS $9,9B9.90+. NC2544.2 +009900 01 IF-D24 PICTURE IS X(10) NC2544.2 +010000 VALUE IS "$1,2 3.40+". NC2544.2 +010100 01 IF-D25 PICTURE IS ABABX0A. NC2544.2 +010200 01 IF-D26 PIC X(7) NC2544.2 +010300 VALUE IS "A C D0E". NC2544.2 +010400 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC2544.2 +010500 USAGE IS COMPUTATIONAL. NC2544.2 +010600 01 IF-D28 PICTURE IS 999999V9999 NC2544.2 +010700 VALUE IS 2137.45. NC2544.2 +010800 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC2544.2 +010900 01 IF-D33 PICTURE S9 VALUE -0. NC2544.2 +011000 01 IF-D34 PICTURE S9 VALUE +0. NC2544.2 +011100 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC2544.2 +011200 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC2544.2 +011300 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC2544.2 +011400 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC2544.2 +011500 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC2544.2 +011600 XXXXX081. NC2544.2 +011700 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2544.2 +011800 01 A18ONES-DS-18V00 PICTURE S9(18) NC2544.2 +011900 VALUE 111111111111111111. NC2544.2 +012000 01 ONES-XN-00018 PICTURE X(18) NC2544.2 +012100 VALUE "111111111111111111". NC2544.2 +012200 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC2544.2 +012300 01 WRK-DU-02V00 PICTURE 99. NC2544.2 +012400 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC2544.2 +012500 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2544.2 +012600 VALUE 111111111.111111111. NC2544.2 +012700 01 ONES-XN-00002 PICTURE XX VALUE "11". NC2544.2 +012800 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2544.2 +012900 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC2544.2 +013000 01 A990-DS-0201P PICTURE S99P VALUE +990. NC2544.2 +013100 01 XDATA-XN-00018 PICTURE X(18) NC2544.2 +013200 VALUE "00ABCDEFGHI 4321 ". NC2544.2 +013300 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC2544.2 +013400 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC2544.2 +013500 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC2544.2 +013600 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC2544.2 +013700 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2544.2 +013800 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC2544.2 +013900 -123456789012345678. NC2544.2 +014000 01 WRK-XN-18-2 PIC X(18) VALUE NC2544.2 +014100 "123456789012345678". NC2544.2 +014200 NC2544.2 +014300 01 IF-D10. NC2544.2 +014400 02 FILLER PICTURE XX VALUE "01". NC2544.2 +014500 02 FILLER PICTURE XX VALUE "23". NC2544.2 +014600 02 IF-D10A. NC2544.2 +014700 03 FILLER PICTURE XXXX VALUE "4567". NC2544.2 +014800 03 FILLER PICTURE XXXX VALUE "8912". NC2544.2 +014900 01 IF-D12. NC2544.2 +015000 02 FILLER PICTURE XXX VALUE "ABC". NC2544.2 +015100 02 IF-D12A. NC2544.2 +015200 03 IF-D12B. NC2544.2 +015300 04 FILLER PICTURE XX VALUE "DE". NC2544.2 +015400 04 FILLER PICTURE X VALUE "F". NC2544.2 +015500 01 IF-D20. NC2544.2 +015600 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +015700 02 FILLER PICTURE 99 VALUE 12. NC2544.2 +015800 02 FILLER PICTURE 9 VALUE 3. NC2544.2 +015900 02 FILLER PICTURE 99 VALUE 45. NC2544.2 +016000 01 IF-D21. NC2544.2 +016100 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +016200 02 FILLER PICTURE 9(5) VALUE 12345. NC2544.2 +016300 01 IF-D22. NC2544.2 +016400 02 FILLER PICTURE AA VALUE "AB". NC2544.2 +016500 02 FILLER PICTURE AAAA VALUE "CDEF". NC2544.2 +016600 01 IF-D35. NC2544.2 +016700 02 IF-D35A VALUE "*ASTERISK". NC2544.2 +016800 03 FILLER PICTURE A(6). NC2544.2 +016900 03 FILLER PICTURE AAA. NC2544.2 +017000 02 IF-D35B VALUE "/SLASH". NC2544.2 +017100 03 FILLER PICTURE 9(6). NC2544.2 +017200 01 IF-D36 REDEFINES IF-D35. NC2544.2 +017300 02 IF-D36A PICTURE X(6). NC2544.2 +017400 02 IF-D36B PICTURE XXX. NC2544.2 +017500 02 IF-D36C PICTURE X(6). NC2544.2 +017600 01 IF-D39. NC2544.2 +017700 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC2544.2 +017800 02 FILLER PICTURE A(4) VALUE SPACE. NC2544.2 +017900 01 LEVEL-01. NC2544.2 +018000 02 LEVEL-02. NC2544.2 +018100 03 LEVEL-03. NC2544.2 +018200 04 LEVEL-04. NC2544.2 +018300 05 LEVEL-05. NC2544.2 +018400 06 LEVEL-06. NC2544.2 +018500 07 LEVEL-07. NC2544.2 +018600 08 LEVEL-08. NC2544.2 +018700 09 LEVEL-09. NC2544.2 +018800 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC2544.2 +018900 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC2544.2 +019000 SPACE. NC2544.2 +019100 01 LEVEL-SENDER PICTURE X VALUE "S". NC2544.2 +019200 01 VAL PICTURE IS 9 VALUE IS 0. NC2544.2 +019300 01 A-2 PICTURE IS A VALUE IS "A".NC2544.2 +019400 01 N-27 PICTURE IS 9999V9 NC2544.2 +019500 VALUE IS 9999.9. NC2544.2 +019600 01 N-30 PICTURE IS 9V9 NC2544.2 +019700 VALUE IS 2. NC2544.2 +019800 01 N-31 PICTURE IS 9(6). NC2544.2 +019900 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC2544.2 +020000 01 N-33 PICTURE IS 9(5) NC2544.2 +020100 VALUE IS 29. NC2544.2 +020200 01 A-37 PICTURE IS A VALUE IS "X".NC2544.2 +020300 01 X-38 REDEFINES A-37 PICTURE IS X. NC2544.2 +020400 01 X-43 PIC X(10) VALUE " l75.63". NC2544.2 +020500 01 N-84 PICTURE IS 9999999999. NC2544.2 +020600 01 NUMERIC-GRP-TEST. NC2544.2 +020700 02 NUMERIC-1 PICTURE 9 VALUE 0. NC2544.2 +020800 02 NUMERIC-2. NC2544.2 +020900 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC2544.2 +021000 03 NUMERIC-4. NC2544.2 +021100 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC2544.2 +021200 02 NUMERIC-6. NC2544.2 +021300 03 NUMERIC-7 PICTURE X VALUE "7". NC2544.2 +021400 03 NUMERIC-8 PICTURE 9 VALUE 8. NC2544.2 +021500 01 NUM-GRP. NC2544.2 +021600 02 NUM-SUB-GRP PIC 9. NC2544.2 +021700 01 GROUP-1000. NC2544.2 +021800 02 FILLER PIC X. NC2544.2 +021900 02 GROUP-X1000. NC2544.2 +022000 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC2544.2 +022100 03 XNAME PICTURE X(100) VALUE QUOTE. NC2544.2 +022200 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC2544.2 +022300 03 GROUP-1000-3 PICTURE X VALUE ".". NC2544.2 +022400 02 GROUP-X500-2. NC2544.2 +022500 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC2544.2 +022600 03 GROUP-X500-1. NC2544.2 +022700 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC2544.2 +022800 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC2544.2 +022900 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC2544.2 +023000 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC2544.2 +023100 01 HI-LO-VALUES. NC2544.2 +023200 02 LOW-VAL PIC X VALUE LOW-VALUE. NC2544.2 +023300 02 ZERO-01 PICTURE 9(18) VALUE 1. NC2544.2 +023400 02 ABC PICTURE XXX VALUE "ABC". NC2544.2 +023500 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC2544.2 +023600 02 ZERO-NULL PIC 9(9) VALUE 0. NC2544.2 +023700 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC2544.2 +023800 01 COMP-DATA. NC2544.2 +023900 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC2544.2 +024000 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC2544.2 +024100 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC2544.2 +024200 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC2544.2 +024300 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC2544.2 +024400 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC2544.2 +024500 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC2544.2 +024600 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC2544.2 +024700 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC2544.2 +024800 01 DISP-DATA. NC2544.2 +024900 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC2544.2 +025000 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC2544.2 +025100 02 DISP-DATA3 PICTURE 9 VALUE 9. NC2544.2 +025200 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC2544.2 +025300 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC2544.2 +025400 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC2544.2 +025500 01 DATA-5 PICTURE 9 VALUE 5. NC2544.2 +025600 01 DATA-99999 PICTURE S9(5) VALUE +99999. NC2544.2 +025700 01 DATA-Z PICTURE X VALUE "Z". NC2544.2 +025800 01 DATA-4 PICTURE 9 VALUE 4. NC2544.2 +025900 01 DATA-Y PICTURE X VALUE "Y". NC2544.2 +026000 01 DATA-VWXYZ PICTURE X(5) VALUE "VWXYZ". NC2544.2 +026100 01 DATA-ADCBA PICTURE X(5) VALUE "ADCBA". NC2544.2 +026200 01 TEST-RESULTS. NC2544.2 +026300 02 FILLER PIC X VALUE SPACE. NC2544.2 +026400 02 FEATURE PIC X(20) VALUE SPACE. NC2544.2 +026500 02 FILLER PIC X VALUE SPACE. NC2544.2 +026600 02 P-OR-F PIC X(5) VALUE SPACE. NC2544.2 +026700 02 FILLER PIC X VALUE SPACE. NC2544.2 +026800 02 PAR-NAME. NC2544.2 +026900 03 FILLER PIC X(19) VALUE SPACE. NC2544.2 +027000 03 PARDOT-X PIC X VALUE SPACE. NC2544.2 +027100 03 DOTVALUE PIC 99 VALUE ZERO. NC2544.2 +027200 02 FILLER PIC X(8) VALUE SPACE. NC2544.2 +027300 02 RE-MARK PIC X(61). NC2544.2 +027400 01 TEST-COMPUTED. NC2544.2 +027500 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +027600 02 FILLER PIC X(17) VALUE NC2544.2 +027700 " COMPUTED=". NC2544.2 +027800 02 COMPUTED-X. NC2544.2 +027900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2544.2 +028000 03 COMPUTED-N REDEFINES COMPUTED-A NC2544.2 +028100 PIC -9(9).9(9). NC2544.2 +028200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2544.2 +028300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2544.2 +028400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2544.2 +028500 03 CM-18V0 REDEFINES COMPUTED-A. NC2544.2 +028600 04 COMPUTED-18V0 PIC -9(18). NC2544.2 +028700 04 FILLER PIC X. NC2544.2 +028800 03 FILLER PIC X(50) VALUE SPACE. NC2544.2 +028900 01 TEST-CORRECT. NC2544.2 +029000 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +029100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2544.2 +029200 02 CORRECT-X. NC2544.2 +029300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2544.2 +029400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2544.2 +029500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2544.2 +029600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2544.2 +029700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2544.2 +029800 03 CR-18V0 REDEFINES CORRECT-A. NC2544.2 +029900 04 CORRECT-18V0 PIC -9(18). NC2544.2 +030000 04 FILLER PIC X. NC2544.2 +030100 03 FILLER PIC X(2) VALUE SPACE. NC2544.2 +030200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2544.2 +030300 01 CCVS-C-1. NC2544.2 +030400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2544.2 +030500- "SS PARAGRAPH-NAME NC2544.2 +030600- " REMARKS". NC2544.2 +030700 02 FILLER PIC X(20) VALUE SPACE. NC2544.2 +030800 01 CCVS-C-2. NC2544.2 +030900 02 FILLER PIC X VALUE SPACE. NC2544.2 +031000 02 FILLER PIC X(6) VALUE "TESTED". NC2544.2 +031100 02 FILLER PIC X(15) VALUE SPACE. NC2544.2 +031200 02 FILLER PIC X(4) VALUE "FAIL". NC2544.2 +031300 02 FILLER PIC X(94) VALUE SPACE. NC2544.2 +031400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2544.2 +031500 01 REC-CT PIC 99 VALUE ZERO. NC2544.2 +031600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2544.2 +032000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2544.2 +032100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2544.2 +032200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2544.2 +032300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2544.2 +032400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2544.2 +032500 01 CCVS-H-1. NC2544.2 +032600 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +032700 02 FILLER PIC X(42) VALUE NC2544.2 +032800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2544.2 +032900 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +033000 01 CCVS-H-2A. NC2544.2 +033100 02 FILLER PIC X(40) VALUE SPACE. NC2544.2 +033200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2544.2 +033300 02 FILLER PIC XXXX VALUE NC2544.2 +033400 "4.2 ". NC2544.2 +033500 02 FILLER PIC X(28) VALUE NC2544.2 +033600 " COPY - NOT FOR DISTRIBUTION". NC2544.2 +033700 02 FILLER PIC X(41) VALUE SPACE. NC2544.2 +033800 NC2544.2 +033900 01 CCVS-H-2B. NC2544.2 +034000 02 FILLER PIC X(15) VALUE NC2544.2 +034100 "TEST RESULT OF ". NC2544.2 +034200 02 TEST-ID PIC X(9). NC2544.2 +034300 02 FILLER PIC X(4) VALUE NC2544.2 +034400 " IN ". NC2544.2 +034500 02 FILLER PIC X(12) VALUE NC2544.2 +034600 " HIGH ". NC2544.2 +034700 02 FILLER PIC X(22) VALUE NC2544.2 +034800 " LEVEL VALIDATION FOR ". NC2544.2 +034900 02 FILLER PIC X(58) VALUE NC2544.2 +035000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +035100 01 CCVS-H-3. NC2544.2 +035200 02 FILLER PIC X(34) VALUE NC2544.2 +035300 " FOR OFFICIAL USE ONLY ". NC2544.2 +035400 02 FILLER PIC X(58) VALUE NC2544.2 +035500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +035600 02 FILLER PIC X(28) VALUE NC2544.2 +035700 " COPYRIGHT 1985 ". NC2544.2 +035800 01 CCVS-E-1. NC2544.2 +035900 02 FILLER PIC X(52) VALUE SPACE. NC2544.2 +036000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2544.2 +036100 02 ID-AGAIN PIC X(9). NC2544.2 +036200 02 FILLER PIC X(45) VALUE SPACES. NC2544.2 +036300 01 CCVS-E-2. NC2544.2 +036400 02 FILLER PIC X(31) VALUE SPACE. NC2544.2 +036500 02 FILLER PIC X(21) VALUE SPACE. NC2544.2 +036600 02 CCVS-E-2-2. NC2544.2 +036700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2544.2 +036800 03 FILLER PIC X VALUE SPACE. NC2544.2 +036900 03 ENDER-DESC PIC X(44) VALUE NC2544.2 +037000 "ERRORS ENCOUNTERED". NC2544.2 +037100 01 CCVS-E-3. NC2544.2 +037200 02 FILLER PIC X(22) VALUE NC2544.2 +037300 " FOR OFFICIAL USE ONLY". NC2544.2 +037400 02 FILLER PIC X(12) VALUE SPACE. NC2544.2 +037500 02 FILLER PIC X(58) VALUE NC2544.2 +037600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +037700 02 FILLER PIC X(13) VALUE SPACE. NC2544.2 +037800 02 FILLER PIC X(15) VALUE NC2544.2 +037900 " COPYRIGHT 1985". NC2544.2 +038000 01 CCVS-E-4. NC2544.2 +038100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2544.2 +038200 02 FILLER PIC X(4) VALUE " OF ". NC2544.2 +038300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2544.2 +038400 02 FILLER PIC X(40) VALUE NC2544.2 +038500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2544.2 +038600 01 XXINFO. NC2544.2 +038700 02 FILLER PIC X(19) VALUE NC2544.2 +038800 "*** INFORMATION ***". NC2544.2 +038900 02 INFO-TEXT. NC2544.2 +039000 04 FILLER PIC X(8) VALUE SPACE. NC2544.2 +039100 04 XXCOMPUTED PIC X(20). NC2544.2 +039200 04 FILLER PIC X(5) VALUE SPACE. NC2544.2 +039300 04 XXCORRECT PIC X(20). NC2544.2 +039400 02 INF-ANSI-REFERENCE PIC X(48). NC2544.2 +039500 01 HYPHEN-LINE. NC2544.2 +039600 02 FILLER PIC IS X VALUE IS SPACE. NC2544.2 +039700 02 FILLER PIC IS X(65) VALUE IS "************************NC2544.2 +039800- "*****************************************". NC2544.2 +039900 02 FILLER PIC IS X(54) VALUE IS "************************NC2544.2 +040000- "******************************". NC2544.2 +040100 01 CCVS-PGM-ID PIC X(9) VALUE NC2544.2 +040200 "NC254A". NC2544.2 +040300 PROCEDURE DIVISION. NC2544.2 +040400 CCVS1 SECTION. NC2544.2 +040500 OPEN-FILES. NC2544.2 +040600 OPEN OUTPUT PRINT-FILE. NC2544.2 +040700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2544.2 +040800 MOVE SPACE TO TEST-RESULTS. NC2544.2 +040900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2544.2 +041000 GO TO CCVS1-EXIT. NC2544.2 +041100 CLOSE-FILES. NC2544.2 +041200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2544.2 +041300 TERMINATE-CCVS. NC2544.2 +041400S EXIT PROGRAM. NC2544.2 +041500STERMINATE-CALL. NC2544.2 +041600 STOP RUN. NC2544.2 +041700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2544.2 +041800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2544.2 +041900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2544.2 +042000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2544.2 +042100 MOVE "****TEST DELETED****" TO RE-MARK. NC2544.2 +042200 PRINT-DETAIL. NC2544.2 +042300 IF REC-CT NOT EQUAL TO ZERO NC2544.2 +042400 MOVE "." TO PARDOT-X NC2544.2 +042500 MOVE REC-CT TO DOTVALUE. NC2544.2 +042600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2544.2 +042700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2544.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2544.2 +042900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2544.2 +043000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2544.2 +043100 MOVE SPACE TO CORRECT-X. NC2544.2 +043200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2544.2 +043300 MOVE SPACE TO RE-MARK. NC2544.2 +043400 HEAD-ROUTINE. NC2544.2 +043500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043900 COLUMN-NAMES-ROUTINE. NC2544.2 +044000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044300 END-ROUTINE. NC2544.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2544.2 +044500 END-RTN-EXIT. NC2544.2 +044600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044700 END-ROUTINE-1. NC2544.2 +044800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2544.2 +044900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2544.2 +045000 ADD PASS-COUNTER TO ERROR-HOLD. NC2544.2 +045100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2544.2 +045200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2544.2 +045300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2544.2 +045400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2544.2 +045500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2544.2 +045600 END-ROUTINE-12. NC2544.2 +045700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2544.2 +045800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2544.2 +045900 MOVE "NO " TO ERROR-TOTAL NC2544.2 +046000 ELSE NC2544.2 +046100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2544.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2544.2 +046300 PERFORM WRITE-LINE. NC2544.2 +046400 END-ROUTINE-13. NC2544.2 +046500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2544.2 +046600 MOVE "NO " TO ERROR-TOTAL ELSE NC2544.2 +046700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2544.2 +046800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2544.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047000 IF INSPECT-COUNTER EQUAL TO ZERO NC2544.2 +047100 MOVE "NO " TO ERROR-TOTAL NC2544.2 +047200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2544.2 +047300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2544.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047600 WRITE-LINE. NC2544.2 +047700 ADD 1 TO RECORD-COUNT. NC2544.2 +047800Y IF RECORD-COUNT GREATER 42 NC2544.2 +047900Y MOVE DUMMY-RECORD TO DUMMY-HOLD NC2544.2 +048000Y MOVE SPACE TO DUMMY-RECORD NC2544.2 +048100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2544.2 +048200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048900Y MOVE DUMMY-HOLD TO DUMMY-RECORD NC2544.2 +049000Y MOVE ZERO TO RECORD-COUNT. NC2544.2 +049100 PERFORM WRT-LN. NC2544.2 +049200 WRT-LN. NC2544.2 +049300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2544.2 +049400 MOVE SPACE TO DUMMY-RECORD. NC2544.2 +049500 BLANK-LINE-PRINT. NC2544.2 +049600 PERFORM WRT-LN. NC2544.2 +049700 FAIL-ROUTINE. NC2544.2 +049800 IF COMPUTED-X NOT EQUAL TO SPACE NC2544.2 +049900 GO TO FAIL-ROUTINE-WRITE. NC2544.2 +050000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2544.2 +050100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +050200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2544.2 +050300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +050400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +050500 GO TO FAIL-ROUTINE-EX. NC2544.2 +050600 FAIL-ROUTINE-WRITE. NC2544.2 +050700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2544.2 +050800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2544.2 +050900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2544.2 +051100 FAIL-ROUTINE-EX. EXIT. NC2544.2 +051200 BAIL-OUT. NC2544.2 +051300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2544.2 +051400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2544.2 +051500 BAIL-OUT-WRITE. NC2544.2 +051600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2544.2 +051700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +051800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +052000 BAIL-OUT-EX. EXIT. NC2544.2 +052100 CCVS1-EXIT. NC2544.2 +052200 EXIT. NC2544.2 +052300 SECT-NC254A-001 SECTION. NC2544.2 +052400* NC2544.2 +052500* NC2544.2 +052600 NEXT-INIT-GF-1. NC2544.2 +052700* ==--> NEXT SENTENCE <--== NC2544.2 +052800 MOVE "V1-89 6.15.4 GR2 " TO ANSI-REFERENCE. NC2544.2 +052900 MOVE "A" TO A-2. NC2544.2 +053000 NEXT-TEST-GF-1. NC2544.2 +053100 IF A-2 EQUAL TO "A" NC2544.2 +053200 NEXT SENTENCE NC2544.2 +053300 ELSE NC2544.2 +053400 NEXT SENTENCE. NC2544.2 +053500 PERFORM PASS. NC2544.2 +053600 GO TO NEXT-WRITE-GF-1. NC2544.2 +053700 NEXT-DELETE-GF-1. NC2544.2 +053800 PERFORM DE-LETE. NC2544.2 +053900 NEXT-WRITE-GF-1. NC2544.2 +054000 MOVE "NEXT-TEST-1" TO PAR-NAME. NC2544.2 +054100 PERFORM PRINT-DETAIL. NC2544.2 +054200* NC2544.2 +054300* NC2544.2 +054400 ANOTHER-REMARK. NC2544.2 +054500 MOVE SPACE TO TEST-RESULTS. NC2544.2 +054600 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC2544.2 +054700 PERFORM PRINT-DETAIL. NC2544.2 +054800 MOVE "TEST THE COMPARISONS IN " TO RE-MARK. NC2544.2 +054900 PERFORM PRINT-DETAIL. NC2544.2 +055000 MOVE "SWITCH-STATUS, RELATION " TO RE-MARK. NC2544.2 +055100 PERFORM PRINT-DETAIL. NC2544.2 +055200 MOVE "AND CLASS CONDITIONALS. " TO RE-MARK. NC2544.2 +055300 PERFORM PRINT-DETAIL. NC2544.2 +055400 SWH-INIT-GF-1. NC2544.2 +055500 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +055600 MOVE "SWITCH-STATUS" TO FEATURE. NC2544.2 +055700 SWH-TEST-GF-1. NC2544.2 +055800A IF ON-SWITCH-1 NC2544.2 +055900A PERFORM PASS NC2544.2 +056000A ELSE NC2544.2 +056100A PERFORM FAIL. NC2544.2 +056200A GO TO SWH-WRITE-GF-1. NC2544.2 +056300 SWH-DELETE-GF-1. NC2544.2 +056400B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +056500 PERFORM DE-LETE. NC2544.2 +056600 SWH-WRITE-GF-1. NC2544.2 +056700 MOVE "SWH-TEST-GF-1" TO PAR-NAME. NC2544.2 +056800 PERFORM PRINT-DETAIL. NC2544.2 +056900 SWH-INIT-GF-2. NC2544.2 +057000 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +057100 SWH-TEST-GF-2. NC2544.2 +057200A IF OFF-SWITCH-1 NC2544.2 +057300A PERFORM FAIL NC2544.2 +057400A ELSE NC2544.2 +057500A PERFORM PASS. NC2544.2 +057600A GO TO SWH-WRITE-GF-2. NC2544.2 +057700 SWH-DELETE-GF-2. NC2544.2 +057800B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +057900 PERFORM DE-LETE. NC2544.2 +058000 SWH-WRITE-GF-2. NC2544.2 +058100 MOVE "SWH-TEST-GF-2" TO PAR-NAME. NC2544.2 +058200 PERFORM PRINT-DETAIL. NC2544.2 +058300 SWH-INIT-GF-3. NC2544.2 +058400 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +058500 SWH-TEST-GF-3. NC2544.2 +058600A IF OFF-SWITCH-2 NC2544.2 +058700A PERFORM PASS NC2544.2 +058800A ELSE NC2544.2 +058900A PERFORM FAIL. NC2544.2 +059000A GO TO SWH-WRITE-GF-3. NC2544.2 +059100 SWH-DELETE-GF-3. NC2544.2 +059200B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +059300 PERFORM DE-LETE. NC2544.2 +059400 SWH-WRITE-GF-3. NC2544.2 +059500 MOVE "SWH-TEST-GF-3" TO PAR-NAME. NC2544.2 +059600 PERFORM PRINT-DETAIL. NC2544.2 +059700 SWH-INIT-GF-4. NC2544.2 +059800 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +059900 SWH-TEST-GF-4. NC2544.2 +060000A IF ON-SWITCH-2 NC2544.2 +060100A PERFORM FAIL NC2544.2 +060200A ELSE NC2544.2 +060300A PERFORM PASS. NC2544.2 +060400A GO TO SWH-WRITE-GF-4. NC2544.2 +060500 SWH-DELETE-GF-4. NC2544.2 +060600B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +060700 PERFORM DE-LETE. NC2544.2 +060800 SWH-WRITE-GF-4. NC2544.2 +060900 MOVE "SWH-TEST-GF-4" TO PAR-NAME. NC2544.2 +061000 PERFORM PRINT-DETAIL. NC2544.2 +061100 SWH-TEST-5. NC2544.2 +061200A IF NOT ON-SWITCH-1 NC2544.2 +061300A MOVE "SWITCH-1 OFF " TO COMPUTED-A NC2544.2 +061400A MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A NC2544.2 +061500A PERFORM FAIL NC2544.2 +061600A GO TO SWH-WRITE-5. NC2544.2 +061700A PERFORM PASS. NC2544.2 +061800A GO TO SWH-WRITE-5. NC2544.2 +061900 SWH-DELETE-5. NC2544.2 +062000B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +062100 PERFORM DE-LETE. NC2544.2 +062200 SWH-WRITE-5. NC2544.2 +062300 MOVE "SWH-TEST-5" TO PAR-NAME. NC2544.2 +062400 PERFORM PRINT-DETAIL. NC2544.2 +062500 SWH-TEST-6. NC2544.2 +062600A IF NOT OFF-SWITCH-1 NC2544.2 +062700A PERFORM PASS NC2544.2 +062800A GO TO SWH-WRITE-6. NC2544.2 +062900A MOVE "SWITCH-1 OFF " TO COMPUTED-A. NC2544.2 +063000A MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A. NC2544.2 +063100A PERFORM FAIL. NC2544.2 +063200A GO TO SWH-WRITE-6. NC2544.2 +063300 SWH-DELETE-6. NC2544.2 +063400B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +063500 PERFORM DE-LETE. NC2544.2 +063600 SWH-WRITE-6. NC2544.2 +063700 MOVE "SWH-TEST-6" TO PAR-NAME. NC2544.2 +063800 PERFORM PRINT-DETAIL. NC2544.2 +063900 SWH-TEST-7. NC2544.2 +064000A IF NOT ON-SWITCH-2 NC2544.2 +064100A PERFORM PASS NC2544.2 +064200A GO TO SWH-WRITE-7. NC2544.2 +064300A MOVE "SWITCH-2 ON " TO COMPUTED-A. NC2544.2 +064400A MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A. NC2544.2 +064500A PERFORM FAIL. NC2544.2 +064600A GO TO SWH-WRITE-7. NC2544.2 +064700 SWH-DELETE-7. NC2544.2 +064800B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +064900 PERFORM DE-LETE. NC2544.2 +065000 SWH-WRITE-7. NC2544.2 +065100 MOVE "SWH-TEST-7" TO PAR-NAME. NC2544.2 +065200 PERFORM PRINT-DETAIL. NC2544.2 +065300 SWH-TEST-8. NC2544.2 +065400A IF NOT OFF-SWITCH-2 NC2544.2 +065500A MOVE "SWITCH-2 ON " TO COMPUTED-A NC2544.2 +065600A MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A NC2544.2 +065700A PERFORM FAIL NC2544.2 +065800A GO TO SWH-WRITE-8. NC2544.2 +065900A PERFORM PASS. NC2544.2 +066000A GO TO SWH-WRITE-8. NC2544.2 +066100 SWH-DELETE-8. NC2544.2 +066200B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +066300 PERFORM DE-LETE. NC2544.2 +066400 SWH-WRITE-8. NC2544.2 +066500 MOVE "SWH-TEST-8" TO PAR-NAME. NC2544.2 +066600 PERFORM PRINT-DETAIL. NC2544.2 +066700* NC2544.2 +066800* NC2544.2 +066900 CCVS-EXIT SECTION. NC2544.2 +067000 CCVS-999999. NC2544.2 +067100 GO TO CLOSE-FILES. NC2544.2 +*END-OF,NC254A +*HEADER,COBOL,NC302M +000100 IDENTIFICATION DIVISION. NC3024.2 +000200 PROGRAM-ID. NC3024.2 +000300 NC302M. NC3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF OBSOLETE NC3024.2 +000500*MINIMUM SUBSET NUCLEUS FEATURES. NC3024.2 +000600 AUTHOR. DAVID G BAMBER. NC3024.2 +000700*Message expected for above statement: OBSOLETE NC3024.2 +000800 INSTALLATION. NCC. NC3024.2 +000900*Message expected for above statement: OBSOLETE NC3024.2 +001000 DATE-WRITTEN. 19TH AUG 1988. NC3024.2 +001100*Message expected for above statement: OBSOLETE NC3024.2 +001200 SECURITY. NO SECURITY. NC3024.2 +001300*Message expected for above statement: OBSOLETE NC3024.2 +001400 ENVIRONMENT DIVISION. NC3024.2 +001500 CONFIGURATION SECTION. NC3024.2 +001600 SOURCE-COMPUTER. NC3024.2 +001700 XXXXX082. NC3024.2 +001800 OBJECT-COMPUTER. NC3024.2 +001900 XXXXX083 NC3024.2 +002000 MEMORY SIZE NC3024.2 +002100 XXXXX068 NC3024.2 +002200 CHARACTERS. NC3024.2 +002300*Message expected for above statement: OBSOLETE NC3024.2 +002400 NC3024.2 +002500 NC3024.2 +002600 DATA DIVISION. NC3024.2 +002700 PROCEDURE DIVISION. NC3024.2 +002800 NC3024.2 +002900 NC302M-CONTROL. NC3024.2 +003000 PERFORM NC302M-ALTER THRU NC302M-STOP. NC3024.2 +003100 STOP RUN. NC3024.2 +003200 NC3024.2 +003300 NC302M-ALTER. NC3024.2 +003400 ALTER NC302M-PROC1 TO NC302M-PROC2. NC3024.2 +003500*Message expected for above statement: OBSOLETE NC3024.2 +003600 NC3024.2 +003700 NC302M-PROC1. NC3024.2 +003800 GO TO NC302M-PROC2. NC3024.2 +003900 NC3024.2 +004000 NC302M-PROC2. NC3024.2 +004100 DISPLAY "DUMMY PROCEDURE". NC3024.2 +004200 NC3024.2 +004300 NC3024.2 +004400 NC3024.2 +004500 NC3024.2 +004600 NC302M-STOP. NC3024.2 +004700 STOP "FNC302". NC3024.2 +004800*Message expected for above statement: OBSOLETE NC3024.2 +004900 NC3024.2 +005000 NC3024.2 +005100*TOTAL NUMBER OF FLAGS EXPECTED = 7. NC3024.2 +*END-OF,NC302M +*HEADER,COBOL,NC303M +000100 IDENTIFICATION DIVISION. NC3034.2 +000200 PROGRAM-ID. NC3034.2 +000300 NC303M. NC3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF NC3034.2 +000500*OBSOLETE HIGH SUBSET NUCLEUS FEATURES. NC3034.2 +000600 DATE-COMPILED. 22ND AUG 1988. NC3034.2 +000700*Message expected for above statement: OBSOLETE NC3034.2 +000800 ENVIRONMENT DIVISION. NC3034.2 +000900 CONFIGURATION SECTION. NC3034.2 +001000 SOURCE-COMPUTER. NC3034.2 +001100 XXXXX082. NC3034.2 +001200 OBJECT-COMPUTER. NC3034.2 +001300 XXXXX083. NC3034.2 +001400 NC3034.2 +001500 NC3034.2 +001600 PROCEDURE DIVISION. NC3034.2 +001700 NC3034.2 +001800 NC303M-CONTROL. NC3034.2 +001900 ALTER NC303M-GOTO TO PROCEED TO NC303M-GOTO-2, NC3034.2 +002000 NC303M-GOTO-2 TO PROCEED TO NC303M-CONTROL. NC3034.2 +002100*Message expected for above statement: OBSOLETE NC3034.2 +002200 STOP RUN. NC3034.2 +002300 NC3034.2 +002400 NC303M-GOTO. NC3034.2 +002500 GO TO. NC3034.2 +002600*Message expected for above statement: OBSOLETE NC3034.2 +002700 NC3034.2 +002800 NC303M-GOTO-2. NC3034.2 +002900 GO TO. NC3034.2 +003000*Message expected for above statement: OBSOLETE NC3034.2 +003100 NC3034.2 +003200*TOTAL NUMBER OF FLAGS EXPECTED = 4. NC3034.2 +*END-OF,NC303M +*HEADER,COBOL,NC401M +000100 IDENTIFICATION DIVISION. NC4014.2 +000200 PROGRAM-ID. NC4014.2 +000300 NC401M. NC4014.2 +000400 NC4014.2 +000500 NC4014.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET NUCLEUS NC4014.2 +000700*FEATURES. NC4014.2 +000800 DATE-COMPILED. 22ND AUG 1988. NC4014.2 +000900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +001000 ENVIRONMENT DIVISION. NC4014.2 +001100 CONFIGURATION SECTION. NC4014.2 +001200 SOURCE-COMPUTER. NC4014.2 +001300 XXXXX082. NC4014.2 +001400 OBJECT-COMPUTER. NC4014.2 +001500 XXXXX083. NC4014.2 +001600 SPECIAL-NAMES. NC4014.2 +001700 XXXXX056 NC4014.2 +001800 IS VDUNIT NC4014.2 +001900 ALPHABET NC4014.2 +002000 TEST-ALPHABET IS "A" THRU "F" NC4014.2 +002100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +002200 NC4014.2 +002300 NC4014.2 +002400 SYMBOLIC CHARACTERS A IS 32. NC4014.2 +002500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +002600 NC4014.2 +002700 NC4014.2 +002800 INPUT-OUTPUT SECTION. NC4014.2 +002900 FILE-CONTROL. NC4014.2 +003000 SELECT TFIL ASSIGN NC4014.2 +003100 XXXXX001. NC4014.2 +003200 SELECT TFIL-2 ASSIGN NC4014.2 +003300 XXXXX002. NC4014.2 +003400 DATA DIVISION. NC4014.2 +003500 FILE SECTION. NC4014.2 +003600 FD TFIL. NC4014.2 +003700 01 FREC. NC4014.2 +003800 03 GUBBINS PIC X(1 NC4014.2 +003900- 00). NC4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +004100 NC4014.2 +004200 FD TFIL-2. NC4014.2 +004300 01 FREC-2. NC4014.2 +004400 03 COLONTEST PIC X(100). NC4014.2 +004500 03 GUBBINS PIC X(100). NC4014.2 +004600 NC4014.2 +004700 NC4014.2 +004800 WORKING-STORAGE SECTION. NC4014.2 +004900 NC4014.2 +005000 01 TEST-CUSTOMER-RECORD. NC4014.2 +005100 03 TEST-AR-CUSTOMER-ID PIC X(4). NC4014.2 +005200 03 TEST-AR-CUSTOMER-NAME PIC X(20). NC4014.2 +005300 03 TEST-AR-NUMBER-INVOICES PIC S9(2). NC4014.2 +005400 03 TEST-AR-INVOICE-DATA OCCURS 1 TO 15 TIMES NC4014.2 +005500 DEPENDING ON NC4014.2 +005600 TEST-AR-NUMBER-INVOICES NC4014.2 +005700 INDEXED BY WS-INDEX. NC4014.2 +005800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +005900 NC4014.2 +006000 05 TEST-INVOICE-DATE. NC4014.2 +006100 07 TEST-INVOICE-YY PIC 99. NC4014.2 +006200 07 TEST-INVOICE-MM PIC 99. NC4014.2 +006300 07 TEST-INVOICE-DD PIC 99. NC4014.2 +006400 NC4014.2 +006500 01 TEST-DESCEND-RECORD. NC4014.2 +006600 03 TEST-DESCEND-CUST-ID PIC X(4). NC4014.2 +006700 03 TEST-DESCEND-CUST-NAME PIC X(20). NC4014.2 +006800 03 TEST-DESCEND-NO-INV PIC S9(2). NC4014.2 +006900 03 TEST-DESCEND-INVOICE OCCURS 15 TIMES NC4014.2 +007000 ASCENDING KEY IS NC4014.2 +007100 TEST-ASCEND-TIME NC4014.2 +007200 DESCENDING KEY IS NC4014.2 +007300 TEST-DESC-DATE. NC4014.2 +007400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +007500 NC4014.2 +007600 NC4014.2 +007700 05 TEST-DESC-DATE. NC4014.2 +007800 07 TEST-DESC-YY PIC 99. NC4014.2 +007900 07 TEST-DESC-MM PIC 99. NC4014.2 +008000 07 TEST-DESC-DD PIC 99. NC4014.2 +008100 05 TEST-ASCEND-TIME PIC 9(6). NC4014.2 +008200 NC4014.2 +008300 01 TEST-CODE-TABLE. NC4014.2 +008400 03 TEST-CODE PIC X(3) NC4014.2 +008500 OCCURS 40 TIMES NC4014.2 +008600 INDEXED BY CODE-INDEX. NC4014.2 +008700 NC4014.2 +008800 01 CUST-REC. NC4014.2 +008900 03 CUST-CODES PIC X. NC4014.2 +009000 88 CUST-PAID VALUE "A". NC4014.2 +009100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +009200 NC4014.2 +009300 NC4014.2 +009400 01 GROUP-1. NC4014.2 +009500 03 ITEM-1 PIC 99 VALUE 10. NC4014.2 +009600 03 ITEM-2 PIC 99 VALUE 12. NC4014.2 +009700 03 ITEM-3 PIC 99 VALUE 14. NC4014.2 +009800 NC4014.2 +009900 01 GROUP-2. NC4014.2 +010000 03 ITEM-1 PIC 99 VALUE 10. NC4014.2 +010100 03 ITEM-2 PIC 99 VALUE 12. NC4014.2 +010200 03 ITEM-3 PIC 99 VALUE 14. NC4014.2 +010300 NC4014.2 +010400 01 SALES-DATA. NC4014.2 +010500 03 STORE-INFO PIC X(30). NC4014.2 +010600 03 MON-SALES OCCURS 2 TIMES. NC4014.2 +010700 05 AM-SALES PIC 9(3). NC4014.2 +010800 05 TUE-SALES OCCURS 2 TIMES. NC4014.2 +010900 07 AM-SALES PIC 9(3). NC4014.2 +011000 07 WED-SALES OCCURS 2 TIMES. NC4014.2 +011100 09 AM-SALES PIC 9(3). NC4014.2 +011200 09 THU-SALES OCCURS 2 TIMES. NC4014.2 +011300 11 AM-SALES PIC 9(3). NC4014.2 +011400 11 FRI-SALES OCCURS 2 TIMES. NC4014.2 +011500 13 PM-SALES PIC 9(3). NC4014.2 +011600 NC4014.2 +011700 01 VARIABLES. NC4014.2 +011800 03 EDFIELD PIC Z,ZZZ.99. NC4014.2 +011900 NC4014.2 +012000 NC4014.2 +012100 03 STATE PIC X(4) VALUE ALL "A". NC4014.2 +012200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +012300 NC4014.2 +012400 NC4014.2 +012500 03 RKEY PIC 9(8) VALUE ZERO. NC4014.2 +012600 NC4014.2 +012700 NC4014.2 +012800 NC4014.2 +012900 03 GRANDTOTAL PIC 9(7)V99 VALUE ZERO. NC4014.2 +013000 03 BOX-A PIC 99 VALUE ZERO. NC4014.2 +013100 03 BOX-B PIC 99 VALUE ZERO. NC4014.2 +013200 03 BOX-C PIC 999 VALUE ZERO. NC4014.2 +013300 03 BOX-D PIC 999 VALUE ZERO. NC4014.2 +013400 NC4014.2 +013500 NC4014.2 +013600 03 MARYPOPPINS PIC X(34) VALUE "SUPERCALIFRAGILISTICEXPIALIDONC4014.2 +013700- "CIOUS". NC4014.2 +013800 03 MP-1 REDEFINES MARYPOPPINS. NC4014.2 +013900 04 MP-1-A PICTURE X(5). NC4014.2 +014000 04 MP-1-A-1 REDEFINES MP-1-A. NC4014.2 +014100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +014200 05 MP-1-A-1-A PICTURE X(3). NC4014.2 +014300 05 FILLER PICTURE X(2). NC4014.2 +014400 04 FILLER PICTURE X(29). NC4014.2 +014500 NC4014.2 +014600 03 VARA PIC X(4). NC4014.2 +014700 03 VARB PIC X(4). NC4014.2 +014800 03 VARC PIC X(4). NC4014.2 +014900 66 VARA NC4014.2 +015000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +015100 RENAMES VARB THRU VARC. NC4014.2 +015200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +015300 NC4014.2 +015400 NC4014.2 +015500 01 DDAY PIC 9(5). NC4014.2 +015600 NC4014.2 +015700 01 VARD PIC X(4). NC4014.2 +015800 NC4014.2 +015900 01 VARE PIC X(4). NC4014.2 +016000 NC4014.2 +016100 01 VARF PIC 9(7)V99. NC4014.2 +016200 NC4014.2 +016300 PROCEDURE DIVISION. NC4014.2 +016400 NC4014.2 +016500 NC4014.2 +016600 NC401M-CONTROL. NC4014.2 +016700 OPEN INPUT TFIL. NC4014.2 +016800 PERFORM NC401M-COLON THRU NC401M-END 1 TIMES. NC4014.2 +016900 ALTER NC401M-GOTO TO PROCEED TO NC401M-GOTO-2, NC4014.2 +017000 NC401M-GOTO-2 TO PROCEED TO NC401M-NESTIF. NC4014.2 +017100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +017200 CLOSE TFIL. NC4014.2 +017300 STOP RUN. NC4014.2 +017400 NC4014.2 +017500 NC4014.2 +017600 NC401M-COLON. NC4014.2 +017700 DISPLAY COLONTEST(1:20). NC4014.2 +017800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +017900 NC4014.2 +018000 NC4014.2 +018100 NC401M-QUALIF. NC4014.2 +018200 MOVE GUBBINS OF FREC TO GUBBINS OF FREC-2. NC4014.2 +018300*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +018400 NC4014.2 +018500 NC4014.2 +018600 NC401M-SUBSCR. NC4014.2 +018700 MOVE ZERO TO NC4014.2 +018800 PM-SALES (BOX-A, BOX-B, BOX-C, BOX-D, 1). NC4014.2 +018900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +019000 NC4014.2 +019100 NC401M-CHARBR1. NC4014.2 +019200 MUL NC4014.2 +019300- TIPLY BOX-A BY BOX-B GIVING BOX-C. NC4014.2 +019400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +019500 NC4014.2 +019600 NC4014.2 +019700 NC401M-CHARBR2. NC4014.2 +019800 MOVE 2 NC4014.2 +019900- 0 TO BOX-A. NC4014.2 +020000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +020100 NC4014.2 +020200 NC401M-ARITHEXP. NC4014.2 +020300 IF BOX-A + 1 IS NOT GREATER THAN BOX-B + 2 NC4014.2 +020400 DISPLAY "ARITHEXP-TEST". NC4014.2 +020500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +020600 NC4014.2 +020700 NC4014.2 +020800 NC401M-SIGCOND. NC4014.2 +020900 IF BOX-A IS NOT NEGATIVE NC4014.2 +021000 DISPLAY "SIGCOND-TEST". NC4014.2 +021100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +021200 NC4014.2 +021300 NC4014.2 +021400 NC401M-COMPCOND. NC4014.2 +021500 IF BOX-A IS GREATER THAN BOX-B AND NOT BOX-C IS GREATER NC4014.2 +021600 THAN BOX-A THEN MOVE 7 TO BOX-B. NC4014.2 +021700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +021800 NC4014.2 +021900 NC4014.2 +022000 NC401M-CORRESADD. NC4014.2 +022100 ADD CORRESPONDING GROUP-1 TO GROUP-2. NC4014.2 +022200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +022300 NC4014.2 +022400 NC4014.2 +022500 NC401M-CORRESMOVE. NC4014.2 +022600 MOVE CORRESPONDING GROUP-1 TO GROUP-2. NC4014.2 +022700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +022800 NC4014.2 +022900 NC4014.2 +023000 NC401M-CORRESSUB. NC4014.2 +023100 SUBTRACT CORRESPONDING GROUP-2 FROM GROUP-1. NC4014.2 +023200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +023300 NC4014.2 +023400 NC4014.2 +023500 NC401M-COMPUTE. NC4014.2 +023600 COMPUTE BOX-A = 10 + 6. NC4014.2 +023700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +023800 NC4014.2 +023900 NC4014.2 +024000 NC401M-GETDAY. NC4014.2 +024100 ACCEPT DDAY FROM DAY-OF-WEEK. NC4014.2 +024200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +024300 NC4014.2 +024400 NC4014.2 +024500 NC401M-DISPUPON. NC4014.2 +024600 DISPLAY "PFILE" UPON VDUNIT. NC4014.2 +024700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +024800 NC4014.2 +024900 NC4014.2 +025000 NC401-DIVREMAINDER. NC4014.2 +025100 DIVIDE BOX-A INTO BOX-B GIVING BOX-C REMAINDER BOX-D. NC4014.2 +025200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +025300 NC4014.2 +025400 NC4014.2 +025500 NC401M-EVAL. NC4014.2 +025600 EVALUATE BOX-A NC4014.2 +025700 WHEN 1 MOVE "A" TO VARC NC4014.2 +025800 WHEN 2 MOVE "B" TO VARC. NC4014.2 +025900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026000 NC4014.2 +026100 NC4014.2 +026200 NC401M-GOTO. NC4014.2 +026300 GO TO. NC4014.2 +026400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026500 NC4014.2 +026600 NC401M-GOTO-2. NC4014.2 +026700 GO TO. NC4014.2 +026800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026900 NC4014.2 +027000 NC4014.2 +027100 NC401M-NESTIF. NC4014.2 +027200 IF BOX-A IS GREATER THAN BOX-B THEN NC4014.2 +027300 MOVE "AAAA" TO VARD NC4014.2 +027400 ELSE NC4014.2 +027500 IF BOX-B IS GREATER THAN BOX-C THEN NC4014.2 +027600 MOVE "BBBB" TO VARD NC4014.2 +027700 ELSE NC4014.2 +027800 MOVE "CCCC" TO VARD. NC4014.2 +027900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +028000 NC4014.2 +028100 NC4014.2 +028200 NC401M-INIT. NC4014.2 +028300 INITIALIZE VARB. NC4014.2 +028400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +028500 NC4014.2 +028600 NC4014.2 +028700 NC401M-INSCT. NC4014.2 +028800 INSPECT MARYPOPPINS CONVERTING "A" TO "Z". NC4014.2 +028900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +029000 NC4014.2 +029100 NC4014.2 +029200 NC4014.2 +029300 NC401M-PWT. NC4014.2 +029400 PERFORM NC401M-NESTIF THRU NC401M-INIT WITH TEST AFTER NC4014.2 +029500 UNTIL BOX-B IS EQUAL TO BOX-A. NC4014.2 +029600*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +029700 NC4014.2 +029800 NC4014.2 +029900 NC401M-PWV. NC4014.2 +030000 PERFORM NC401M-NESTIF THRU NC401M-INIT NC4014.2 +030100 VARYING BOX-A FROM BOX-B BY BOX-C NC4014.2 +030200 UNTIL GRANDTOTAL IS EQUAL TO VARF. NC4014.2 +030300*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +030400 NC4014.2 +030500 NC4014.2 +030600 NC401M-SEARCH. NC4014.2 +030700 SEARCH TEST-CODE NC4014.2 +030800 WHEN BOX-A IS EQUAL TO BOX-B NC4014.2 +030900 NEXT SENTENCE. NC4014.2 +031000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +031100 NC4014.2 +031200 NC4014.2 +031300 NC401M-STT. NC4014.2 +031400 SET CUST-PAID TO TRUE. NC4014.2 +031500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +031600 NC4014.2 +031700 NC4014.2 +031800 NC401M-ST. NC4014.2 +031900 STRING VARD DELIMITED BY VARB INTO VARC. NC4014.2 +032000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +032100 NC4014.2 +032200 NC4014.2 +032300 NC401M-UST. NC4014.2 +032400 UNSTRING VARD INTO VARE. NC4014.2 +032500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +032600 NC4014.2 +032700 NC4014.2 +032800 NC401M-END. NC4014.2 +032900 NC4014.2 +033000*TOTAL NUMBER OF FLAGS EXPECTED = 40. NC4014.2 +033100*Message expected for following statement: NON-CONFORMING STANDARDNC4014.2 +033200 END PROGRAM NC401M. NC4014.2 +*END-OF,NC401M +*HEADER,COBOL,OBIC1A +000100 IDENTIFICATION DIVISION. OBIC14.2 +000200 PROGRAM-ID. OBIC14.2 +000300 OBIC1A. OBIC14.2 +000400**************************************************************** OBIC14.2 +000500* * OBIC14.2 +000600* VALIDATION FOR:- * OBIC14.2 +000700* * OBIC14.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC14.2 +000900* * OBIC14.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC14.2 +001100* * OBIC14.2 +001200**************************************************************** OBIC14.2 +001300* * OBIC14.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC14.2 +001500* * OBIC14.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC14.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC14.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC14.2 +001900* * OBIC14.2 +002000**************************************************************** OBIC14.2 +002100* OBIC14.2 +002200* THE MAIN PROGRAM IC218 CALLS THE SUBPROGRAM IC219 WHICH OBIC14.2 +002300* CONTAINS A SORT STATEMENT AND A STOP RUN STATEMENT. THE OBIC14.2 +002400* PURPOSE OF THESE PROGRAMS IS TO VERIFY THAT A SORT STATEMENT OBIC14.2 +002500* FUNCTIONS CORRECTLY IN A SUBPROGRAM. THE FIRST NON-DECLARA- OBIC14.2 +002600* TIVE PORTION OF THE SUBPROGRAM, THE SORT INPUT PROCEDURE AND OBIC14.2 +002700* THE SORT OUTPUT PROCEDURE ARE CONTAINED IN DIFFERENT SUBPRO- OBIC14.2 +002800* GRAM SEGMENTS. OBIC14.2 +002900* OBIC14.2 +003000* A CALL IS MADE TO THE SUBPROGRAM IC219. CONTROL SHOULD OBIC14.2 +003100* NOT BE RETURNED TO THIS PROGRAM SINCE IC219 CONTAINS A STOP OBIC14.2 +003200* RUN STATEMENT. THE SUBPROGRAM IC220 CONTAINS THE PRINTER FD OBIC14.2 +003300* AND PRINTS OUT THE REPORT SHOWING THE TEST RESULTS. OBIC14.2 +003400* OBIC14.2 +003500* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE OBIC14.2 +003600* COBOL, X3.23-1985 OBIC14.2 +003700* OBIC14.2 +003800******************************************************************OBIC14.2 +003900 ENVIRONMENT DIVISION. OBIC14.2 +004000 CONFIGURATION SECTION. OBIC14.2 +004100 SOURCE-COMPUTER. OBIC14.2 +004200 XXXXX082. OBIC14.2 +004300 OBJECT-COMPUTER. OBIC14.2 +004400 XXXXX083. OBIC14.2 +004500 DATA DIVISION. OBIC14.2 +004600 WORKING-STORAGE SECTION. OBIC14.2 +004700 01 SORT-LINK PICTURE 9. OBIC14.2 +004800 01 PRINT-LINE-VALUES. OBIC14.2 +004900 02 PASS-OR-FAIL PICTURE X(5). OBIC14.2 +005000 02 R-COUNT PICTURE 99. OBIC14.2 +005100 02 FEATURE-TESTED PICTURE X(20). OBIC14.2 +005200 02 COMPUTED-SORT-KEY PICTURE X(20). OBIC14.2 +005300 02 CORRECT-SORT-KEY PICTURE X(20). OBIC14.2 +005400 02 PARAGRAPH-NAME PICTURE X(12). OBIC14.2 +005500 01 PRINT-FLAG PICTURE 9. OBIC14.2 +005600 PROCEDURE DIVISION. OBIC14.2 +005700 SECT-IC218-0001 SECTION. OBIC14.2 +005800 CALL-IC219. OBIC14.2 +005900 MOVE 0 TO SORT-LINK. OBIC14.2 +006000 CALL "OBIC2A" USING SORT-LINK. OBIC14.2 +006100 CALL-FAIL. OBIC14.2 +006200* OBIC14.2 +006300* CONTROL SHOULD NOT RETURN TO THE MAIN PROGRAM FROM THE SUB- OBIC14.2 +006400* PROGRAM SINCE THE SUBPROGRAM CONTAINS A STOP RUN STATEMENT. OBIC14.2 +006500* OBIC14.2 +006600 MOVE 2 TO PRINT-FLAG. OBIC14.2 +006700 MOVE "CALL-MAIN-IC" TO PARAGRAPH-NAME. OBIC14.2 +006800 MOVE "CONTROL RETURNED" TO FEATURE-TESTED. OBIC14.2 +006900 MOVE "FAIL " TO PASS-OR-FAIL. OBIC14.2 +007000 MOVE 0 TO R-COUNT. OBIC14.2 +007100 MOVE SORT-LINK TO COMPUTED-SORT-KEY. OBIC14.2 +007200 MOVE SPACE TO CORRECT-SORT-KEY. OBIC14.2 +007300 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC14.2 +007400 MOVE 3 TO PRINT-FLAG. OBIC14.2 +007500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC14.2 +007600* OBIC14.2 +007700* NO STOP RUN STATEMENT APPEARS IN THIS PROGRAM. OBIC14.2 +007800* OBIC14.2 +007900 END-OF-PROGRAM. OBIC14.2 +008000 EXIT PROGRAM. OBIC14.2 +*END-OF,OBIC1A +*HEADER,COBOL,OBIC1A,SUBRTN,OBIC2A +000100 IDENTIFICATION DIVISION. OBIC24.2 +000200 PROGRAM-ID. OBIC24.2 +000300 OBIC2A. OBIC24.2 +000400**************************************************************** OBIC24.2 +000500* * OBIC24.2 +000600* VALIDATION FOR:- * OBIC24.2 +000700* * OBIC24.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC24.2 +000900* * OBIC24.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC24.2 +001100* * OBIC24.2 +001200**************************************************************** OBIC24.2 +001300* * OBIC24.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC24.2 +001500* * OBIC24.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC24.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC24.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC24.2 +001900* * OBIC24.2 +002000**************************************************************** OBIC24.2 +002100* OBIC24.2 +002200* THE SUBPROGRAM IC219 TESTS THE USE OF A SORT STATEMENT OBIC24.2 +002300* IN A SEGMENTED SUBPROGRAM. THE FIRST NON-DECLARATIVE SECTIONOBIC24.2 +002400* OF THE SUBPROGRAM CONSISTS OF A SORT STATEMENT AND A STOP RUNOBIC24.2 +002500* STATEMENT IN A FIXED PERMANENT SEGMENT. THE SORT INPUT OBIC24.2 +002600* PROCEDURE AND THE SORT OUTPUT PROCEDURE ARE CONTAINED IN TWO OBIC24.2 +002700* INDEPENDENT SEGMENTS. THE MAIN PROGRAM IC218 CALLS THIS OBIC24.2 +002800* SUBPROGRAM AND THE SUBPROGRAM IC220 IS CALLED FROM THE OBIC24.2 +002900* OUTPUT PROCEDURE SECTION TO PRINT THE OUTPUT REPORT. OBIC24.2 +003000* OBIC24.2 +003100******************************************************************OBIC24.2 +003200 ENVIRONMENT DIVISION. OBIC24.2 +003300 CONFIGURATION SECTION. OBIC24.2 +003400 SOURCE-COMPUTER. OBIC24.2 +003500 XXXXX082. OBIC24.2 +003600 OBJECT-COMPUTER. OBIC24.2 +003700 XXXXX083. OBIC24.2 +003800 INPUT-OUTPUT SECTION. OBIC24.2 +003900 FILE-CONTROL. OBIC24.2 +004000 SELECT ST-FS1 ASSIGN TO OBIC24.2 +004100 XXXXX027. OBIC24.2 +004200 DATA DIVISION. OBIC24.2 +004300 FILE SECTION. OBIC24.2 +004400 SD ST-FS1 OBIC24.2 +004500 DATA RECORD IS ST-FS1R1-F-G-126. OBIC24.2 +004600 01 ST-FS1R1-F-G-126. OBIC24.2 +004700 02 ST-FS1-1-120. OBIC24.2 +004800 03 FILLER PICTURE X(34). OBIC24.2 +004900 03 ST-FS1-REC-NO PICTURE 9(6). OBIC24.2 +005000 03 FILLER PICTURE X(80). OBIC24.2 +005100 02 ST-FS1-121-124 PICTURE X(4). OBIC24.2 +005200 02 ST-FS1-125-126 PICTURE 99. OBIC24.2 +005300 WORKING-STORAGE SECTION. OBIC24.2 +005400 01 TEMP1 PICTURE X(4). OBIC24.2 +005500 01 TEMP2 PICTURE 999. OBIC24.2 +005600 01 TEMP3 PICTURE 999. OBIC24.2 +005700 01 TEMP4 PICTURE 9(6). OBIC24.2 +005800 01 FAIL-COUNT PICTURE 999 VALUE ZERO. OBIC24.2 +005900 01 EOF-FLAG PICTURE 9 VALUE ZERO. OBIC24.2 +006000 01 PRINT-LINE-VALUES. OBIC24.2 +006100 02 PASS-OR-FAIL PICTURE X(5). OBIC24.2 +006200 02 R-COUNT PICTURE 99. OBIC24.2 +006300 02 FEATURE-TESTED PICTURE X(20). OBIC24.2 +006400 02 COMPUTED-SORT-KEY. OBIC24.2 +006500 03 COMPUTED-1-4 PICTURE X(4). OBIC24.2 +006600 03 COMPUTED-5-6 PICTURE 99. OBIC24.2 +006700 03 COMPUTED-7-12 PICTURE 9(6). OBIC24.2 +006800 03 FILLER PICTURE X(8) VALUE SPACE. OBIC24.2 +006900 02 CORRECT-SORT-KEY. OBIC24.2 +007000 03 CORRECT-1-4 PICTURE X(4). OBIC24.2 +007100 03 CORRECT-5-6 PICTURE 99. OBIC24.2 +007200 03 CORRECT-7-12 PICTURE 9(6). OBIC24.2 +007300 03 FILLER PICTURE X(8) VALUE SPACE. OBIC24.2 +007400 02 PARAGRAPH-NAME PICTURE X(12). OBIC24.2 +007500 01 PRINT-FLAG PICTURE 9. OBIC24.2 +007600 01 FILE-RECORD-INFORMATION-REC. OBIC24.2 +007700 03 FILE-RECORD-INFO-SKELETON. OBIC24.2 +007800 05 FILLER PICTURE X(48) VALUE OBIC24.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBIC24.2 +008000 05 FILLER PICTURE X(46) VALUE OBIC24.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBIC24.2 +008200 05 FILLER PICTURE X(26) VALUE OBIC24.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". OBIC24.2 +008400 05 FILLER PICTURE X(37) VALUE OBIC24.2 +008500 ",RECKEY= ". OBIC24.2 +008600 05 FILLER PICTURE X(38) VALUE OBIC24.2 +008700 ",ALTKEY1= ". OBIC24.2 +008800 05 FILLER PICTURE X(38) VALUE OBIC24.2 +008900 ",ALTKEY2= ". OBIC24.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.OBIC24.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBIC24.2 +009200 05 FILE-RECORD-INFO-P1-120. OBIC24.2 +009300 07 FILLER PIC X(5). OBIC24.2 +009400 07 XFILE-NAME PIC X(6). OBIC24.2 +009500 07 FILLER PIC X(8). OBIC24.2 +009600 07 XRECORD-NAME PIC X(6). OBIC24.2 +009700 07 FILLER PIC X(1). OBIC24.2 +009800 07 REELUNIT-NUMBER PIC 9(1). OBIC24.2 +009900 07 FILLER PIC X(7). OBIC24.2 +010000 07 XRECORD-NUMBER PIC 9(6). OBIC24.2 +010100 07 FILLER PIC X(6). OBIC24.2 +010200 07 UPDATE-NUMBER PIC 9(2). OBIC24.2 +010300 07 FILLER PIC X(5). OBIC24.2 +010400 07 ODO-NUMBER PIC 9(4). OBIC24.2 +010500 07 FILLER PIC X(5). OBIC24.2 +010600 07 XPROGRAM-NAME PIC X(5). OBIC24.2 +010700 07 FILLER PIC X(7). OBIC24.2 +010800 07 XRECORD-LENGTH PIC 9(6). OBIC24.2 +010900 07 FILLER PIC X(7). OBIC24.2 +011000 07 CHARS-OR-RECORDS PIC X(2). OBIC24.2 +011100 07 FILLER PIC X(1). OBIC24.2 +011200 07 XBLOCK-SIZE PIC 9(4). OBIC24.2 +011300 07 FILLER PIC X(6). OBIC24.2 +011400 07 RECORDS-IN-FILE PIC 9(6). OBIC24.2 +011500 07 FILLER PIC X(5). OBIC24.2 +011600 07 XFILE-ORGANIZATION PIC X(2). OBIC24.2 +011700 07 FILLER PIC X(6). OBIC24.2 +011800 07 XLABEL-TYPE PIC X(1). OBIC24.2 +011900 05 FILE-RECORD-INFO-P121-240. OBIC24.2 +012000 07 FILLER PIC X(8). OBIC24.2 +012100 07 XRECORD-KEY PIC X(29). OBIC24.2 +012200 07 FILLER PIC X(9). OBIC24.2 +012300 07 ALTERNATE-KEY1 PIC X(29). OBIC24.2 +012400 07 FILLER PIC X(9). OBIC24.2 +012500 07 ALTERNATE-KEY2 PIC X(29). OBIC24.2 +012600 07 FILLER PIC X(7). OBIC24.2 +012700 LINKAGE SECTION. OBIC24.2 +012800 01 SORT-LINK PICTURE 9. OBIC24.2 +012900 PROCEDURE DIVISION USING SORT-LINK. OBIC24.2 +013000 SECT-IC219-0001 SECTION 30. OBIC24.2 +013100* OBIC24.2 +013200* THIS SECTION CONTAINS A SORT STATEMENT AND A STOP RUN OBIC24.2 +013300* STATEMENT, THE ONLY STATEMENTS PERMITTED IN THE FIRST NON- OBIC24.2 +013400* DECLARATIVE PORTION OF THE PROCEDURE DIVISION IN SORT LEVEL 1OBIC24.2 +013500* OBIC24.2 +013600 SORT-PARAGRAPH. OBIC24.2 +013700 SORT ST-FS1 OBIC24.2 +013800 ASCENDING KEY ST-FS1-121-124 OBIC24.2 +013900 ASCENDING KEY ST-FS1-125-126 OBIC24.2 +014000 ASCENDING KEY ST-FS1-REC-NO OBIC24.2 +014100 INPUT PROCEDURE IS SECT-IC219-0002 OBIC24.2 +014200 OUTPUT PROCEDURE IS SECT-IC219-0003. OBIC24.2 +014300 STOP RUN. OBIC24.2 +014400 SECT-IC219-0002 SECTION 60. OBIC24.2 +014500* OBIC24.2 +014600* THE SORT INPUT PROCEDURE RELEASES 500 SORT RECORDS OF OBIC24.2 +014700* LENGTH 126 CHARACTERS. THREE ITEMS ARE USED AS THE SORT KEY,OBIC24.2 +014800* THEY ARE CHARACTERS 121-124 PICX(4), CHARACTERS 125-126 OBIC24.2 +014900* PIC 99, AND THE RECORD NUMBER FIELD CHARACTERS 35-40 PIC 9(6)OBIC24.2 +015000* THE RECORDS ARE WRITTEN WITH THE SORT KEY ITEMS CONTAINING OBIC24.2 +015100* THE FOLLOWING CHARACTERS OBIC24.2 +015200* OBIC24.2 +015300* FIRST 100 RECORDS ABCD 00 THRU 99 000001 THRU 000100 OBIC24.2 +015400* SECOND 100 RECORDS AAAA 00 THRU 99 000101 THRU 000200 OBIC24.2 +015500* THIRD 100 RECORDS ABCD 00 THRU 99 000201 THRU 00300 OBIC24.2 +015600* FOURTH 100 RECORDS UVWY 00 THRU 99 000301 THRU 000400 OBIC24.2 +015700* FIFTH 100 RECORDS UVWX 00 THRU 99 000401 THRU 000500 OBIC24.2 +015800* OBIC24.2 +015900 SORT-INPUT-PROCEDURE. OBIC24.2 +016000 MOVE 1 TO SORT-LINK. OBIC24.2 +016100 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). OBIC24.2 +016200 PERFORM RECORD-AREA-INIT. OBIC24.2 +016300 MOVE "ABCD" TO TEMP1. OBIC24.2 +016400 MOVE 0 TO TEMP2. OBIC24.2 +016500 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +016600 MOVE "AAAA" TO TEMP1. OBIC24.2 +016700 MOVE 0 TO TEMP2. OBIC24.2 +016800 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +016900 MOVE "ABCD" TO TEMP1. OBIC24.2 +017000 MOVE 0 TO TEMP2. OBIC24.2 +017100 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017200 MOVE "UVWY" TO TEMP1. OBIC24.2 +017300 MOVE 0 TO TEMP2. OBIC24.2 +017400 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017500 MOVE "UVWX" TO TEMP1. OBIC24.2 +017600 MOVE 0 TO TEMP2. OBIC24.2 +017700 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017800 GO TO SECT-IC219-0002-EXIT. OBIC24.2 +017900 RECORD-AREA-INIT. OBIC24.2 +018000 MOVE "ST-FS1" TO XFILE-NAME (1). OBIC24.2 +018100 MOVE "R1-F-G" TO XRECORD-NAME (1). OBIC24.2 +018200 MOVE "IC219" TO XPROGRAM-NAME (1). OBIC24.2 +018300 MOVE 126 TO XRECORD-LENGTH (1). OBIC24.2 +018400 MOVE "RC" TO CHARS-OR-RECORDS (1). OBIC24.2 +018500 MOVE 0001 TO XBLOCK-SIZE (1). OBIC24.2 +018600 MOVE 500 TO RECORDS-IN-FILE (1). OBIC24.2 +018700 MOVE "NA" TO XFILE-ORGANIZATION (1). OBIC24.2 +018800 MOVE "N" TO XLABEL-TYPE (1). OBIC24.2 +018900 MOVE 1 TO XRECORD-NUMBER (1). OBIC24.2 +019000 RELEASE-RECORD. OBIC24.2 +019100 MOVE FILE-RECORD-INFO-P1-120 (1) TO ST-FS1-1-120. OBIC24.2 +019200 MOVE TEMP1 TO ST-FS1-121-124. OBIC24.2 +019300 MOVE TEMP2 TO ST-FS1-125-126. OBIC24.2 +019400 RELEASE ST-FS1R1-F-G-126. OBIC24.2 +019500 ADD 1 TO XRECORD-NUMBER (1). OBIC24.2 +019600 ADD 1 TO TEMP2. OBIC24.2 +019700 SECT-IC219-0002-EXIT. OBIC24.2 +019800 EXIT. OBIC24.2 +019900 SECT-IC219-0003 SECTION 80. OBIC24.2 +020000* OBIC24.2 +020100* THE SORT OUTPUT PROCEDURE RETURNS 500 SORT RECORDS. THE OBIC24.2 +020200* DATA ITEMS COMPRISING THE SORT KEY ARE CHECKED TO ENSURE THE OBIC24.2 +020300* RECORDS ARE RETURNED IN THE EXPECTED SORT ORDER. THE SUBPRO-OBIC24.2 +020400* GRAM IC220 IS CALLED TO PRODUCE THE OUTPUT REPORT FOR THE OBIC24.2 +020500* TEST RESULTS. OBIC24.2 +020600* OBIC24.2 +020700* THE RECORDS SHOULD BE RETURNED WITH THE SORT KEY ITEMS OBIC24.2 +020800* CONTAINING THE FOLLOWING CHARACTERS OBIC24.2 +020900* OBIC24.2 +021000* FIRST 100 RECORDS AAAA 00 THRU 99 000101 THRU 000200 OBIC24.2 +021100* ABCD 00 000001 OBIC24.2 +021200* NEXT ABCD 00 000201 OBIC24.2 +021300* 200 ABCD 01 000002 OBIC24.2 +021400* RECORDS ABCD 01 000202 OBIC24.2 +021500* . . . . . . OBIC24.2 +021600* ABCD 99 000100 OBIC24.2 +021700* ABCD 99 000300 OBIC24.2 +021800* FOURTH 100 RECORDS UVWX 00 THRU 99 000401 THRU 000500 OBIC24.2 +021900* FIFTH 100 RECORDS UVWY 00 THRU 99 000301 THRU 000400 OBIC24.2 +022000* OBIC24.2 +022100 SORT-OUTPUT-INIT. OBIC24.2 +022200 MOVE 2 TO SORT-LINK. OBIC24.2 +022300 MOVE 1 TO PRINT-FLAG. OBIC24.2 +022400 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +022500 MOVE "SORT IN SUBPROGRAM" TO FEATURE-TESTED. OBIC24.2 +022600 MOVE "IC-SORT-TEST" TO PARAGRAPH-NAME. OBIC24.2 +022700 MOVE 0 TO R-COUNT. OBIC24.2 +022800 CHECK-OUTPUT-FROM-SORT. OBIC24.2 +022900 MOVE "AAAA" TO TEMP1. OBIC24.2 +023000 MOVE 0 TO TEMP3. OBIC24.2 +023100 MOVE 100 TO TEMP4. OBIC24.2 +023200 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +023300 MOVE "ABCD" TO TEMP1. OBIC24.2 +023400 MOVE 0 TO TEMP3. OBIC24.2 +023500 MOVE 0 TO TEMP4. OBIC24.2 +023600 PERFORM CHECK-ABCD-RECORDS 100 TIMES. OBIC24.2 +023700 MOVE "UVWX" TO TEMP1. OBIC24.2 +023800 MOVE 0 TO TEMP3. OBIC24.2 +023900 MOVE 400 TO TEMP4. OBIC24.2 +024000 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +024100 MOVE "UVWY" TO TEMP1. OBIC24.2 +024200 MOVE 0 TO TEMP3. OBIC24.2 +024300 MOVE 300 TO TEMP4. OBIC24.2 +024400 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +024500 CHECK-RESULTS. OBIC24.2 +024600 IF EOF-FLAG EQUAL TO 1 OBIC24.2 +024700 MOVE "PREMATURE EOF" TO COMPUTED-SORT-KEY OBIC24.2 +024800 MOVE "DATA RECORD EXPECTED" TO CORRECT-SORT-KEY OBIC24.2 +024900 GO TO FAIL-WRITE. OBIC24.2 +025000 RETURN ST-FS1 AT END GO TO CHECK-FAIL-COUNT. OBIC24.2 +025100 MOVE "NO EOF - 500 READ" TO COMPUTED-SORT-KEY. OBIC24.2 +025200 MOVE "EOF EXPECTED" TO CORRECT-SORT-KEY. OBIC24.2 +025300 GO TO FAIL-WRITE. OBIC24.2 +025400 CHECK-FAIL-COUNT. OBIC24.2 +025500 IF FAIL-COUNT EQUAL TO ZERO OBIC24.2 +025600 MOVE "PASS " TO PASS-OR-FAIL OBIC24.2 +025700 GO TO WRITE-RESULTS. OBIC24.2 +025800 MOVE "SORT ERRORS" TO COMPUTED-SORT-KEY. OBIC24.2 +025900 MOVE SPACE TO CORRECT-SORT-KEY. OBIC24.2 +026000 FAIL-WRITE. OBIC24.2 +026100 MOVE "FAIL " TO PASS-OR-FAIL. OBIC24.2 +026200 WRITE-RESULTS. OBIC24.2 +026300 MOVE 0 TO R-COUNT. OBIC24.2 +026400 MOVE 2 TO PRINT-FLAG. OBIC24.2 +026500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +026600 WRAPUP-OUTPUT-PROC. OBIC24.2 +026700 MOVE 3 TO PRINT-FLAG. OBIC24.2 +026800 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +026900 GO TO SECT-IC219-0003-EXIT. OBIC24.2 +027000 CHECK-RECORD. OBIC24.2 +027100 PERFORM RETURN-RECORD THROUGH RETURN-EXIT. OBIC24.2 +027200 ADD 1 TO TEMP4. OBIC24.2 +027300 PERFORM COMPARE-VALUES THROUGH COMPARE-EXIT. OBIC24.2 +027400 ADD 1 TO TEMP3. OBIC24.2 +027500 RETURN-RECORD. OBIC24.2 +027600 IF EOF-FLAG EQUAL TO 1 OBIC24.2 +027700 GO TO RETURN-EXIT. OBIC24.2 +027800 RETURN ST-FS1 AT END MOVE 1 TO EOF-FLAG. OBIC24.2 +027900 RETURN-EXIT. OBIC24.2 +028000 EXIT. OBIC24.2 +028100 CHECK-ABCD-RECORDS. OBIC24.2 +028200 PERFORM CHECK-RECORD. OBIC24.2 +028300 SUBTRACT 1 FROM TEMP3. OBIC24.2 +028400 ADD 199 TO TEMP4. OBIC24.2 +028500 PERFORM CHECK-RECORD. OBIC24.2 +028600 SUBTRACT 200 FROM TEMP4. OBIC24.2 +028700 COMPARE-VALUES. OBIC24.2 +028800 IF TEMP1 NOT EQUAL TO ST-FS1-121-124 OBIC24.2 +028900 GO TO SORT-FAIL. OBIC24.2 +029000 IF TEMP3 NOT EQUAL TO ST-FS1-125-126 OBIC24.2 +029100 GO TO SORT-FAIL. OBIC24.2 +029200 IF TEMP4 NOT EQUAL TO ST-FS1-REC-NO OBIC24.2 +029300 GO TO SORT-FAIL. OBIC24.2 +029400 GO TO COMPARE-EXIT. OBIC24.2 +029500 SORT-FAIL. OBIC24.2 +029600 MOVE "FAIL " TO PASS-OR-FAIL. OBIC24.2 +029700 ADD 1 TO R-COUNT. OBIC24.2 +029800 MOVE TEMP1 TO CORRECT-1-4. OBIC24.2 +029900 MOVE TEMP3 TO CORRECT-5-6. OBIC24.2 +030000 MOVE TEMP4 TO CORRECT-7-12. OBIC24.2 +030100 MOVE ST-FS1-121-124 TO COMPUTED-1-4. OBIC24.2 +030200 MOVE ST-FS1-125-126 TO COMPUTED-5-6. OBIC24.2 +030300 MOVE ST-FS1-REC-NO TO COMPUTED-7-12. OBIC24.2 +030400 MOVE 2 TO PRINT-FLAG. OBIC24.2 +030500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +030600 ADD 1 TO FAIL-COUNT. OBIC24.2 +030700 COMPARE-EXIT. OBIC24.2 +030800 EXIT. OBIC24.2 +030900 SECT-IC219-0003-EXIT. OBIC24.2 +031000 EXIT. OBIC24.2 +*END-OF,OBIC2A +*HEADER,COBOL,OBIC1A,SUBRTN,OBIC3A +000100 IDENTIFICATION DIVISION. OBIC34.2 +000200 PROGRAM-ID. OBIC34.2 +000300 OBIC3A. OBIC34.2 +000400**************************************************************** OBIC34.2 +000500* * OBIC34.2 +000600* VALIDATION FOR:- * OBIC34.2 +000700* * OBIC34.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +000900* * OBIC34.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC34.2 +001100* * OBIC34.2 +001200**************************************************************** OBIC34.2 +001300* * OBIC34.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC34.2 +001500* * OBIC34.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC34.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC34.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC34.2 +001900* * OBIC34.2 +002000**************************************************************** OBIC34.2 +002100* OBIC34.2 +002200* THE SUBPROGRAM IC220 PRINTS THE RESULTS FOR THE TESTING OBIC34.2 +002300* OF A SEGMENTED LEVEL 1 SORT PROGRAM AS A SUBPROGRAM. IT IS OBIC34.2 +002400* CALLED BY THE MAIN PROGRAM IC218 AND THE SUBPROGRAM IC219. OBIC34.2 +002500* THE LINKAGE VARIABLE PRINT-FLAG INDICATES WHETHER THE OBIC34.2 +002600* HEADING (FLAG=1), FOOTING (FLAG=3), OR A REPORT LINE (FLAG=2)OBIC34.2 +002700* SHOULD BE PRINTED. OBIC34.2 +002800* OBIC34.2 +002900******************************************************************OBIC34.2 +003000 ENVIRONMENT DIVISION. OBIC34.2 +003100 CONFIGURATION SECTION. OBIC34.2 +003200 SOURCE-COMPUTER. OBIC34.2 +003300 XXXXX082. OBIC34.2 +003400 OBJECT-COMPUTER. OBIC34.2 +003500 XXXXX083. OBIC34.2 +003600 INPUT-OUTPUT SECTION. OBIC34.2 +003700 FILE-CONTROL. OBIC34.2 +003800 SELECT PRINT-FILE ASSIGN TO OBIC34.2 +003900 XXXXX055. OBIC34.2 +004000 DATA DIVISION. OBIC34.2 +004100 FILE SECTION. OBIC34.2 +004200 FD PRINT-FILE. OBIC34.2 +004300 01 PRINT-REC PICTURE X(120). OBIC34.2 +004400 01 DUMMY-RECORD PICTURE X(120). OBIC34.2 +004500 WORKING-STORAGE SECTION. OBIC34.2 +004600 01 TEST-RESULTS. OBIC34.2 +004700 02 FILLER PIC X VALUE SPACE. OBIC34.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. OBIC34.2 +004900 02 FILLER PIC X VALUE SPACE. OBIC34.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. OBIC34.2 +005100 02 FILLER PIC X VALUE SPACE. OBIC34.2 +005200 02 PAR-NAME. OBIC34.2 +005300 03 FILLER PIC X(19) VALUE SPACE. OBIC34.2 +005400 03 PARDOT-X PIC X VALUE SPACE. OBIC34.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. OBIC34.2 +005600 02 FILLER PIC X(8) VALUE SPACE. OBIC34.2 +005700 02 RE-MARK PIC X(61). OBIC34.2 +005800 01 TEST-COMPUTED. OBIC34.2 +005900 02 FILLER PIC X(30) VALUE SPACE. OBIC34.2 +006000 02 FILLER PIC X(17) VALUE OBIC34.2 +006100 " COMPUTED=". OBIC34.2 +006200 02 COMPUTED-X. OBIC34.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. OBIC34.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A OBIC34.2 +006500 PIC -9(9).9(9). OBIC34.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBIC34.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBIC34.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBIC34.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. OBIC34.2 +007000 04 COMPUTED-18V0 PIC -9(18). OBIC34.2 +007100 04 FILLER PIC X. OBIC34.2 +007200 03 FILLER PIC X(50) VALUE SPACE. OBIC34.2 +007300 01 TEST-CORRECT. OBIC34.2 +007400 02 FILLER PIC X(30) VALUE SPACE. OBIC34.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". OBIC34.2 +007600 02 CORRECT-X. OBIC34.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. OBIC34.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBIC34.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBIC34.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBIC34.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBIC34.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. OBIC34.2 +008300 04 CORRECT-18V0 PIC -9(18). OBIC34.2 +008400 04 FILLER PIC X. OBIC34.2 +008500 03 FILLER PIC X(2) VALUE SPACE. OBIC34.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBIC34.2 +008700 01 CCVS-C-1. OBIC34.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBIC34.2 +008900- "SS PARAGRAPH-NAME OBIC34.2 +009000- " REMARKS". OBIC34.2 +009100 02 FILLER PIC X(20) VALUE SPACE. OBIC34.2 +009200 01 CCVS-C-2. OBIC34.2 +009300 02 FILLER PIC X VALUE SPACE. OBIC34.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". OBIC34.2 +009500 02 FILLER PIC X(15) VALUE SPACE. OBIC34.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". OBIC34.2 +009700 02 FILLER PIC X(94) VALUE SPACE. OBIC34.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBIC34.2 +009900 01 REC-CT PIC 99 VALUE ZERO. OBIC34.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBIC34.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. OBIC34.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBIC34.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBIC34.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBIC34.2 +010900 01 CCVS-H-1. OBIC34.2 +011000 02 FILLER PIC X(39) VALUE SPACES. OBIC34.2 +011100 02 FILLER PIC X(42) VALUE OBIC34.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBIC34.2 +011300 02 FILLER PIC X(39) VALUE SPACES. OBIC34.2 +011400 01 CCVS-H-2A. OBIC34.2 +011500 02 FILLER PIC X(40) VALUE SPACE. OBIC34.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". OBIC34.2 +011700 02 FILLER PIC XXXX VALUE OBIC34.2 +011800 "4.2 ". OBIC34.2 +011900 02 FILLER PIC X(28) VALUE OBIC34.2 +012000 " COPY - NOT FOR DISTRIBUTION". OBIC34.2 +012100 02 FILLER PIC X(41) VALUE SPACE. OBIC34.2 +012200 OBIC34.2 +012300 01 CCVS-H-2B. OBIC34.2 +012400 02 FILLER PIC X(15) VALUE OBIC34.2 +012500 "TEST RESULT OF ". OBIC34.2 +012600 02 TEST-ID PIC X(9). OBIC34.2 +012700 02 FILLER PIC X(4) VALUE OBIC34.2 +012800 " IN ". OBIC34.2 +012900 02 FILLER PIC X(12) VALUE OBIC34.2 +013000 " HIGH ". OBIC34.2 +013100 02 FILLER PIC X(22) VALUE OBIC34.2 +013200 " LEVEL VALIDATION FOR ". OBIC34.2 +013300 02 FILLER PIC X(58) VALUE OBIC34.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +013500 01 CCVS-H-3. OBIC34.2 +013600 02 FILLER PIC X(34) VALUE OBIC34.2 +013700 " FOR OFFICIAL USE ONLY ". OBIC34.2 +013800 02 FILLER PIC X(58) VALUE OBIC34.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC34.2 +014000 02 FILLER PIC X(28) VALUE OBIC34.2 +014100 " COPYRIGHT 1985 ". OBIC34.2 +014200 01 CCVS-E-1. OBIC34.2 +014300 02 FILLER PIC X(52) VALUE SPACE. OBIC34.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBIC34.2 +014500 02 ID-AGAIN PIC X(9). OBIC34.2 +014600 02 FILLER PIC X(45) VALUE SPACES. OBIC34.2 +014700 01 CCVS-E-2. OBIC34.2 +014800 02 FILLER PIC X(31) VALUE SPACE. OBIC34.2 +014900 02 FILLER PIC X(21) VALUE SPACE. OBIC34.2 +015000 02 CCVS-E-2-2. OBIC34.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBIC34.2 +015200 03 FILLER PIC X VALUE SPACE. OBIC34.2 +015300 03 ENDER-DESC PIC X(44) VALUE OBIC34.2 +015400 "ERRORS ENCOUNTERED". OBIC34.2 +015500 01 CCVS-E-3. OBIC34.2 +015600 02 FILLER PIC X(22) VALUE OBIC34.2 +015700 " FOR OFFICIAL USE ONLY". OBIC34.2 +015800 02 FILLER PIC X(12) VALUE SPACE. OBIC34.2 +015900 02 FILLER PIC X(58) VALUE OBIC34.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +016100 02 FILLER PIC X(13) VALUE SPACE. OBIC34.2 +016200 02 FILLER PIC X(15) VALUE OBIC34.2 +016300 " COPYRIGHT 1985". OBIC34.2 +016400 01 CCVS-E-4. OBIC34.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBIC34.2 +016600 02 FILLER PIC X(4) VALUE " OF ". OBIC34.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBIC34.2 +016800 02 FILLER PIC X(40) VALUE OBIC34.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". OBIC34.2 +017000 01 XXINFO. OBIC34.2 +017100 02 FILLER PIC X(19) VALUE OBIC34.2 +017200 "*** INFORMATION ***". OBIC34.2 +017300 02 INFO-TEXT. OBIC34.2 +017400 04 FILLER PIC X(8) VALUE SPACE. OBIC34.2 +017500 04 XXCOMPUTED PIC X(20). OBIC34.2 +017600 04 FILLER PIC X(5) VALUE SPACE. OBIC34.2 +017700 04 XXCORRECT PIC X(20). OBIC34.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). OBIC34.2 +017900 01 HYPHEN-LINE. OBIC34.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. OBIC34.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************OBIC34.2 +018200- "*****************************************". OBIC34.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************OBIC34.2 +018400- "******************************". OBIC34.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE OBIC34.2 +018600 "OBIC3A". OBIC34.2 +018700 LINKAGE SECTION. OBIC34.2 +018800 01 PRINT-LINE-VALUES. OBIC34.2 +018900 02 PASS-OR-FAIL PICTURE X(5). OBIC34.2 +019000 02 R-COUNT PICTURE 99. OBIC34.2 +019100 02 FEATURE-TESTED PICTURE X(20). OBIC34.2 +019200 02 COMPUTED-SORT-KEY PICTURE X(20). OBIC34.2 +019300 02 CORRECT-SORT-KEY PICTURE X(20). OBIC34.2 +019400 02 PARAGRAPH-NAME PICTURE X(12). OBIC34.2 +019500 01 PRINT-FLAG PICTURE 9. OBIC34.2 +019600 PROCEDURE DIVISION USING PRINT-LINE-VALUES PRINT-FLAG. OBIC34.2 +019700 SECT-IC220-0001 SECTION. OBIC34.2 +019800 BOILER-PLATE. OBIC34.2 +019900 GO TO CCVS1-EXIT. OBIC34.2 +020000 CLOSE-FILES. OBIC34.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBIC34.2 +020200 TERMINATE-CCVS. OBIC34.2 +020300S EXIT PROGRAM. OBIC34.2 +020400STERMINATE-CALL. OBIC34.2 +020500 STOP RUN. OBIC34.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBIC34.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBIC34.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBIC34.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBIC34.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. OBIC34.2 +021100 PRINT-DETAIL. OBIC34.2 +021200 IF REC-CT NOT EQUAL TO ZERO OBIC34.2 +021300 MOVE "." TO PARDOT-X OBIC34.2 +021400 MOVE REC-CT TO DOTVALUE. OBIC34.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBIC34.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBIC34.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBIC34.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBIC34.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBIC34.2 +022000 MOVE SPACE TO CORRECT-X. OBIC34.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBIC34.2 +022200 MOVE SPACE TO RE-MARK. OBIC34.2 +022300 HEAD-ROUTINE. OBIC34.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBIC34.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBIC34.2 +022800 COLUMN-NAMES-ROUTINE. OBIC34.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +023200 END-ROUTINE. OBIC34.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBIC34.2 +023400 END-RTN-EXIT. OBIC34.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +023600 END-ROUTINE-1. OBIC34.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBIC34.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBIC34.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. OBIC34.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBIC34.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. OBIC34.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. OBIC34.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. OBIC34.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBIC34.2 +024500 END-ROUTINE-12. OBIC34.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBIC34.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO OBIC34.2 +024800 MOVE "NO " TO ERROR-TOTAL OBIC34.2 +024900 ELSE OBIC34.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBIC34.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. OBIC34.2 +025200 PERFORM WRITE-LINE. OBIC34.2 +025300 END-ROUTINE-13. OBIC34.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO OBIC34.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE OBIC34.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBIC34.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBIC34.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO OBIC34.2 +026000 MOVE "NO " TO ERROR-TOTAL OBIC34.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBIC34.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBIC34.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +026500 WRITE-LINE. OBIC34.2 +026600 ADD 1 TO RECORD-COUNT. OBIC34.2 +026700Y IF RECORD-COUNT GREATER 50 OBIC34.2 +026800Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBIC34.2 +026900Y MOVE SPACE TO DUMMY-RECORD OBIC34.2 +027000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBIC34.2 +027100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBIC34.2 +027200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBIC34.2 +027300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBIC34.2 +027400Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBIC34.2 +027500Y MOVE ZERO TO RECORD-COUNT. OBIC34.2 +027600 PERFORM WRT-LN. OBIC34.2 +027700 WRT-LN. OBIC34.2 +027800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBIC34.2 +027900 MOVE SPACE TO DUMMY-RECORD. OBIC34.2 +028000 BLANK-LINE-PRINT. OBIC34.2 +028100 PERFORM WRT-LN. OBIC34.2 +028200 FAIL-ROUTINE. OBIC34.2 +028300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBIC34.2 +028400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.OBIC34.2 +028500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBIC34.2 +028600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBIC34.2 +028700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +028800 MOVE SPACES TO INF-ANSI-REFERENCE. OBIC34.2 +028900 GO TO FAIL-ROUTINE-EX. OBIC34.2 +029000 FAIL-ROUTINE-WRITE. OBIC34.2 +029100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBIC34.2 +029200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBIC34.2 +029300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +029400 MOVE SPACES TO COR-ANSI-REFERENCE. OBIC34.2 +029500 FAIL-ROUTINE-EX. EXIT. OBIC34.2 +029600 BAIL-OUT. OBIC34.2 +029700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBIC34.2 +029800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBIC34.2 +029900 BAIL-OUT-WRITE. OBIC34.2 +030000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBIC34.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBIC34.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. OBIC34.2 +030400 BAIL-OUT-EX. EXIT. OBIC34.2 +030500 CCVS1-EXIT. OBIC34.2 +030600 EXIT. OBIC34.2 +030700 SECT-IC220-0002 SECTION. OBIC34.2 +030800 BRANCH-STATEMENT. OBIC34.2 +030900 GO TO PRINT-HEADING PROCESS-LINE PRINT-FOOTING OBIC34.2 +031000 DEPENDING ON PRINT-FLAG. OBIC34.2 +031100 MOVE "ERROR IN PRINT-FLAG" TO DUMMY-RECORD. OBIC34.2 +031200 PERFORM WRITE-LINE. OBIC34.2 +031300 GO TO IC220-EXIT. OBIC34.2 +031400 PRINT-HEADING. OBIC34.2 +031500 MOVE 0 TO R-COUNT. OBIC34.2 +031600 OPEN-FILES. OBIC34.2 +031700 OPEN OUTPUT PRINT-FILE. OBIC34.2 +031800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBIC34.2 +031900 MOVE SPACE TO TEST-RESULTS. OBIC34.2 +032000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBIC34.2 +032100 GO TO IC220-EXIT. OBIC34.2 +032200 PRINT-FOOTING. OBIC34.2 +032300 PERFORM CLOSE-FILES. OBIC34.2 +032400 GO TO IC220-EXIT. OBIC34.2 +032500 PROCESS-LINE. OBIC34.2 +032600 IF PASS-OR-FAIL EQUAL TO "PASS " OBIC34.2 +032700 PERFORM PASS OBIC34.2 +032800 ELSE PERFORM FAIL OBIC34.2 +032900 MOVE COMPUTED-SORT-KEY TO COMPUTED-A OBIC34.2 +033000 MOVE CORRECT-SORT-KEY TO CORRECT-A. OBIC34.2 +033100 MOVE R-COUNT TO REC-CT. OBIC34.2 +033200 MOVE FEATURE-TESTED TO FEATURE. OBIC34.2 +033300 MOVE PARAGRAPH-NAME TO PAR-NAME. OBIC34.2 +033400 PERFORM PRINT-DETAIL. OBIC34.2 +033500 IC220-EXIT. OBIC34.2 +033600 EXIT PROGRAM. OBIC34.2 +*END-OF,OBIC3A +*HEADER,COBOL,OBNC1M +000100 IDENTIFICATION DIVISION. OBNC14.2 +000200 PROGRAM-ID. OBNC14.2 +000300 OBNC1M. OBNC14.2 +000400 OBNC14.2 +000500 AUTHOR. OBNC14.2 +000600 FEDERAL COMPILER TESTING CENTRE. OBNC14.2 +000700 INSTALLATION. OBNC14.2 +000800 GENERAL SERVICES ADMINISTRATION OBNC14.2 +000900 AUTOMATIC DATA AND TELECOMMUNICATION SERVICE OBNC14.2 +001000 SOFTWARE DEVELOPMENT OFFICE OBNC14.2 +001100 5203 LEESBURG PIKE. SUITE 1100 OBNC14.2 +001200 FALLS CHURCH VIRGINIA 22041 OBNC14.2 +001300 OBNC14.2 +001400 PHONE (703) 756-6153 OBNC14.2 +001500 DATE-WRITTEN. OBNC14.2 +001600 CCVS-74 VERSION 4.0 - 1980 JULY 1. OBNC14.2 +001700 CREATION DATE / VALIDATION DATE OBNC14.2 +001800 OBNC14.2 +001900 SECURITY. OBNC14.2 +002000 NONE OBNC14.2 +002100 OBNC14.2 +002200 OBNC14.2 +002300**************************************************************** OBNC14.2 +002400* * OBNC14.2 +002500* VALIDATION FOR:- * OBNC14.2 +002600* * OBNC14.2 +002700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +002800* * OBNC14.2 +002900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC14.2 +003000* * OBNC14.2 +003100**************************************************************** OBNC14.2 +003200* * OBNC14.2 +003300* X-CARDS USED BY THIS PROGRAM ARE :- * OBNC14.2 +003400* * OBNC14.2 +003500* X-55 - SYSTEM PRINTER NAME. * OBNC14.2 +003600* X-82 - SOURCE COMPUTER NAME. * OBNC14.2 +003700* X-83 - OBJECT COMPUTER NAME. * OBNC14.2 +003800* * OBNC14.2 +003900**************************************************************** OBNC14.2 +004000* OBNC14.2 +004100* PROGRAM OBNC1M CONTAINS CCVS74 TESTS OF LEVEL 1 LANGUAGE OBNC14.2 +004200* ELEMENTS DEFINED AS OBSOLETE IN THE 1985 STANDARDS. OBNC14.2 +004300* OBNC14.2 +004400* OBNC14.2 +004500**************************************************************** OBNC14.2 +004600 OBNC14.2 +004700 OBNC14.2 +004800 A COMMENT ENTRY PARAGRAPH IS TO BE TREATED AS OBNC14.2 +004900 DOCUMENTATION. ANY ATTEMPT TO COMPILE ANYTHING CONTAINED OBNC14.2 +005000 HERE IS ILLEGAL. THE LINES WHICH FOLLOW CONSTITUTE A TEST OBNC14.2 +005100 OF THIS REQUIREMENT. ALL LINES BEGIN IN AREA B --- OBNC14.2 +005200 OBNC14.2 +005300 ENVIRONMENT DIVISION. OBNC14.2 +005400 CONFIGURATION SECTION. OBNC14.2 +005500 SOURCE-COMPUTER. OBNC14.2 +005600 XXXXX082. OBNC14.2 +005700 OBJECT-COMPUTER. OBNC14.2 +005800 XXXXX083. OBNC14.2 +005900 INPUT-OUTPUT SECTION. OBNC14.2 +006000 FILE-CONTROL. OBNC14.2 +006100 SELECT PHONY-PRINT-FILE ASSIGN TO OBNC14.2 +006200 XXXXX055. OBNC14.2 +006300 DATA DIVISION. OBNC14.2 +006400 FILE SECTION. OBNC14.2 +006500 FD PHONY-PRINT-FILE OBNC14.2 +006600 LABEL RECORDS OMITTED OBNC14.2 +006700 DATA RECORD IS PHONY-PRINT-REC. OBNC14.2 +006800 01 PHONY-PRINT-REC PICTURE X(120). OBNC14.2 +006900 WORKING-STORAGE SECTION. OBNC14.2 +007000 01 COM-MENT. OBNC14.2 +007100 02 FILLER PICTURE X(56) VALUE OBNC14.2 +007200 " CONGRATULATIONS --- YOUR COMPILER HAS JUST SUCCESSFULLY". OBNC14.2 +007300 02 FILLER PICTURE X(51) VALUE OBNC14.2 +007400 " COMPILED AND EXECUTED THE COBOL REMARKS PARAGRAPH.". OBNC14.2 +007500 PROCEDURE DIVISION. OBNC14.2 +007600 PHONY-OPEN. OBNC14.2 +007700 OPEN OUTPUT PHONY-PRINT-FILE. OBNC14.2 +007800 PHONY-WRITE. OBNC14.2 +007900 MOVE COM-MENT TO PHONY-PRINT-REC. OBNC14.2 +008000 WRITE PHONY-PRINT-REC. OBNC14.2 +008100 PHONY-CLOSE. OBNC14.2 +008200 CLOSE PHONY-PRINT-FILE. OBNC14.2 +008300 STOP RUN. OBNC14.2 +008400 IDENTIFICATION DIVISION. OBNC14.2 +008500 OBNC14.2 +008600 OBNC14.2 +008700 ENVIRONMENT DIVISION. OBNC14.2 +008800 CONFIGURATION SECTION. OBNC14.2 +008900 SOURCE-COMPUTER. OBNC14.2 +009000 XXXXX082. OBNC14.2 +009100 OBJECT-COMPUTER. OBNC14.2 +009200 XXXXX083 OBNC14.2 +009300 MEMORY SIZE OBNC14.2 +009400 XXXXX067 OBNC14.2 +009500 WORDS. OBNC14.2 +009600 INPUT-OUTPUT SECTION. OBNC14.2 +009700 FILE-CONTROL. OBNC14.2 +009800 SELECT PRINT-FILE ASSIGN TO OBNC14.2 +009900 XXXXX055. OBNC14.2 +010000 DATA DIVISION. OBNC14.2 +010100 FILE SECTION. OBNC14.2 +010200 FD PRINT-FILE. OBNC14.2 +010300 01 PRINT-REC PICTURE X(132). OBNC14.2 +010400 01 DUMMY-RECORD PICTURE X(132). OBNC14.2 +010500 WORKING-STORAGE SECTION. OBNC14.2 +010600 01 CHARACTER-BREAKDOWN-R. OBNC14.2 +010700 02 FIRST-20R PICTURE X(20). OBNC14.2 +010800 02 SECOND-20R PICTURE X(20). OBNC14.2 +010900 02 THIRD-20R PICTURE X(20). OBNC14.2 +011000 02 FOURTH-20R PICTURE X(20). OBNC14.2 +011100 01 CHARACTER-BREAKDOWN-S. OBNC14.2 +011200 02 FIRST-20S PICTURE X(20). OBNC14.2 +011300 02 SECOND-20S PICTURE X(20). OBNC14.2 +011400 02 THIRD-20S PICTURE X(20). OBNC14.2 +011500 02 FOURTH-20S PICTURE X(20). OBNC14.2 +011600 01 X80-CHARACTER-FIELD. OBNC14.2 +011700 02 FILLER PICTURE X(80). OBNC14.2 +011800 01 ACCEPT-RESULTS. OBNC14.2 +011900 02 FILLER PICTURE X(80) VALUE OBNC14.2 +012000 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456OBNC14.2 +012100- "789 ". OBNC14.2 +012200 01 ALTERLOOP PIC 9 VALUE ZERO. OBNC14.2 +012300 01 DISPLAY-DATA. OBNC14.2 +012400 02 DISPLAY-A. OBNC14.2 +012500 03 DISPLAY-03 PICTURE A VALUE "A". OBNC14.2 +012600 03 DISPLAY-03A. OBNC14.2 +012700 04 DISPLAY-04 PICTURE A VALUE "L". OBNC14.2 +012800 04 DISPLAY-04A. OBNC14.2 +012900 05 DISPLAY-05 PICTURE A VALUE "P". OBNC14.2 +013000 05 DISPLAY-05A. OBNC14.2 +013100 06 DISPLAY-06 PICTURE A VALUE "H". OBNC14.2 +013200 06 DISPLAY-06A. OBNC14.2 +013300 07 DISPLAY-07 PICTURE A VALUE "A". OBNC14.2 +013400 07 DISPLAY-07A. OBNC14.2 +013500 08 DISPLAY-08 PICTURE A VALUE "B". OBNC14.2 +013600 08 DISPLAY-08A. OBNC14.2 +013700 09 DISPLAY-09 PICTURE A VALUE "E". OBNC14.2 +013800 09 DISPLAY-09A. OBNC14.2 +013900 10 DISPLAY-10 PICTURE AAA VALUE "TIC". OBNC14.2 +014000 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. OBNC14.2 +014100 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". OBNC14.2 +014200 02 DISPLAY-B PICTURE X(13). OBNC14.2 +014300 02 DISPLAY-C REDEFINES DISPLAY-B. OBNC14.2 +014400 03 DISPLAY-D PICTURE X(8). OBNC14.2 +014500 03 DISPLAY-E PICTURE X(5). OBNC14.2 +014600 02 DISPLAY-F. OBNC14.2 +014700 03 DISPLAY-G PICTURE X(100) VALUE "*001*002*003*00OBNC14.2 +014800- "4*005*006*007*008*009*010*011*012*013*014*015*016*017*018*01OBNC14.2 +014900- "9*020*021*022*023*024*025". OBNC14.2 +015000 03 DISPLAY-H PICTURE X(100) VALUE "*026*027*028*02OBNC14.2 +015100- "9*030*031*032*033*034*035*036*037*038*039*040*041*042*043*04OBNC14.2 +015200- "4*045*046*047*048*049*050". OBNC14.2 +015300 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". OBNC14.2 +015400 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". OBNC14.2 +015500 02 CORRECT-FOLLOWS PICTURE X(20) VALUE OBNC14.2 +015600 "CORRECT DATA FOLLOWS". OBNC14.2 +015700 02 END-CORRECT PICTURE X(16) VALUE OBNC14.2 +015800 "END CORRECT DATA". OBNC14.2 +015900 02 DISPLAY-WRITER. OBNC14.2 +016000 03 DIS-PLAYER. OBNC14.2 +016100 04 FILLER PICTURE X(6). OBNC14.2 +016200 04 QUOTE-SLOT PICTURE X. OBNC14.2 +016300 04 FILLER PICTURE X(112). OBNC14.2 +016400 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. OBNC14.2 +016500 02 ZERO-SPACE-QUOTE. OBNC14.2 +016600 03 FILLER PICTURE X VALUE ZERO. OBNC14.2 +016700 03 FILLER PICTURE X VALUE SPACE. OBNC14.2 +016800 03 FILLER PICTURE X VALUE QUOTE. OBNC14.2 +016900 01 LONG-LITERAL. OBNC14.2 +017000 02 LONG20 PICTURE IS X(20) OBNC14.2 +017100 VALUE IS "STANDARD COMPILERS M". OBNC14.2 +017200 02 LONG40 PICTURE IS X(20) OBNC14.2 +017300 VALUE IS "UST ALLOW NON-NUMERI". OBNC14.2 +017400 02 LONG60 PICTURE IS X(20) OBNC14.2 +017500 VALUE IS "C LITERALS OF AT LEA". OBNC14.2 +017600 02 LONG80 PICTURE IS X(20) OBNC14.2 +017700 VALUE IS "ST 120 CHARACTERS AN". OBNC14.2 +017800 02 LONG100 PICTURE IS X(20) OBNC14.2 +017900 VALUE IS "D NUMERIC LITERALS O". OBNC14.2 +018000 02 LONG120 PICTURE IS X(20) OBNC14.2 +018100 VALUE IS "F AT LEAST 18 DIGITS". OBNC14.2 +018200 01 ACCEPT-DATA. OBNC14.2 +018300 02 ACCEPT-D1. OBNC14.2 +018400 03 ACCEPT-D1-A PICTURE X(20). OBNC14.2 +018500 03 ACCEPT-D1-B PICTURE X(7). OBNC14.2 +018600 02 ACCEPT-D2 PICTURE X(27) OBNC14.2 +018700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY Z". OBNC14.2 +018800 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. OBNC14.2 +018900 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. OBNC14.2 +019000 02 ACCEPT-D5 PICTURE X(11). OBNC14.2 +019100 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/l, =". OBNC14.2 +019200 02 ACCEPT-D7 PICTURE X. OBNC14.2 +019300 02 ACCEPT-D8 PICTURE X VALUE "9". OBNC14.2 +019400 02 ACCEPT-D9 PICTURE X. OBNC14.2 +019500 02 ACCEPT-D10 PICTURE X VALUE "0". OBNC14.2 +019600 02 ACCEPT-D11 PICTURE A(20). OBNC14.2 +019700 02 ACCEPT-D12 PICTURE A(20) OBNC14.2 +019800 VALUE " ABC XYZ ". OBNC14.2 +019900 02 ACCEPT-D13 PICTURE 9(9). OBNC14.2 +020000 02 ACCEPT-D14 PICTURE 9(9) VALUE 012345678. OBNC14.2 +020100 02 ACCEPT-D15 PICTURE X. OBNC14.2 +020200 02 ACCEPT-D16 PICTURE X VALUE SPACE. OBNC14.2 +020300 02 ACCEPT-D17 PICTURE X. OBNC14.2 +020400 02 ACCEPT-D18 PICTURE X VALUE QUOTE. OBNC14.2 +020500 02 ACCEPT-D21. OBNC14.2 +020600 03 TAB-ACCEPT PICTURE XXXX OCCURS 3 TIMES. OBNC14.2 +020700 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". OBNC14.2 +020800 01 TAB-VALUE PICTURE X(21) OBNC14.2 +020900 VALUE "ABCDEFGHIJKLMNOPQRSTU". OBNC14.2 +021000 01 NO-TAB-RECORD REDEFINES TAB-VALUE. OBNC14.2 +021100 02 X1 PICTURE X. OBNC14.2 +021200 02 X2 PICTURE X. OBNC14.2 +021300 02 X3 PICTURE X. OBNC14.2 +021400 02 X4 PICTURE X. OBNC14.2 +021500 02 X5 PICTURE X. OBNC14.2 +021600 02 X6 PICTURE X. OBNC14.2 +021700 02 X7 PICTURE X. OBNC14.2 +021800 02 X8 PICTURE X. OBNC14.2 +021900 02 X9 PICTURE X. OBNC14.2 +022000 02 X10 PICTURE X. OBNC14.2 +022100 02 X11 PICTURE X. OBNC14.2 +022200 02 X12 PICTURE X. OBNC14.2 +022300 02 X13 PICTURE X. OBNC14.2 +022400 02 X14 PICTURE X. OBNC14.2 +022500 02 X15 PICTURE X. OBNC14.2 +022600 02 X16 PICTURE X. OBNC14.2 +022700 02 X17 PICTURE X. OBNC14.2 +022800 02 X18 PICTURE X. OBNC14.2 +022900 02 X19 PICTURE X. OBNC14.2 +023000 02 X20 PICTURE X. OBNC14.2 +023100 02 X21 PICTURE X. OBNC14.2 +023200 01 TAB-RECORD REDEFINES TAB-VALUE. OBNC14.2 +023300 02 XTAB PICTURE X OCCURS 21 TIMES. OBNC14.2 +023400 01 DISPLAY-MIXTURE. OBNC14.2 +023500 02 I-DATA PICTURE X(17) OBNC14.2 +023600 VALUE " IDENTIFIER DATA ". OBNC14.2 +023700 02 TA-VALUE PICTURE X(20) OBNC14.2 +023800 VALUE "A B C D E 0102030405". OBNC14.2 +023900 02 TA-BLE REDEFINES TA-VALUE. OBNC14.2 +024000 04 PIECE-A PICTURE XX OCCURS 5 TIMES. OBNC14.2 +024100 04 PIECE-N PICTURE 99 OCCURS 5 TIMES. OBNC14.2 +024200 02 TRUE-PAIR. OBNC14.2 +024300 03 A1 PICTURE X(21) OBNC14.2 +024400 VALUE " (TOTAL 21 OPERANDS) ". OBNC14.2 +024500 03 A2 PICTURE X(11) OBNC14.2 +024600 VALUE "END OF DATA". OBNC14.2 +024700 01 TEST-RESULTS. OBNC14.2 +024800 02 FILLER PIC X VALUE SPACE. OBNC14.2 +024900 02 FEATURE PIC X(20) VALUE SPACE. OBNC14.2 +025000 02 FILLER PIC X VALUE SPACE. OBNC14.2 +025100 02 P-OR-F PIC X(5) VALUE SPACE. OBNC14.2 +025200 02 FILLER PIC X VALUE SPACE. OBNC14.2 +025300 02 PAR-NAME. OBNC14.2 +025400 03 FILLER PIC X(19) VALUE SPACE. OBNC14.2 +025500 03 PARDOT-X PIC X VALUE SPACE. OBNC14.2 +025600 03 DOTVALUE PIC 99 VALUE ZERO. OBNC14.2 +025700 02 FILLER PIC X(8) VALUE SPACE. OBNC14.2 +025800 02 RE-MARK PIC X(61). OBNC14.2 +025900 01 TEST-COMPUTED. OBNC14.2 +026000 02 FILLER PIC X(30) VALUE SPACE. OBNC14.2 +026100 02 FILLER PIC X(17) VALUE OBNC14.2 +026200 " COMPUTED=". OBNC14.2 +026300 02 COMPUTED-X. OBNC14.2 +026400 03 COMPUTED-A PIC X(20) VALUE SPACE. OBNC14.2 +026500 03 COMPUTED-N REDEFINES COMPUTED-A OBNC14.2 +026600 PIC -9(9).9(9). OBNC14.2 +026700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBNC14.2 +026800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBNC14.2 +026900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBNC14.2 +027000 03 CM-18V0 REDEFINES COMPUTED-A. OBNC14.2 +027100 04 COMPUTED-18V0 PIC -9(18). OBNC14.2 +027200 04 FILLER PIC X. OBNC14.2 +027300 03 FILLER PIC X(50) VALUE SPACE. OBNC14.2 +027400 01 TEST-CORRECT. OBNC14.2 +027500 02 FILLER PIC X(30) VALUE SPACE. OBNC14.2 +027600 02 FILLER PIC X(17) VALUE " CORRECT =". OBNC14.2 +027700 02 CORRECT-X. OBNC14.2 +027800 03 CORRECT-A PIC X(20) VALUE SPACE. OBNC14.2 +027900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBNC14.2 +028000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBNC14.2 +028100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBNC14.2 +028200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBNC14.2 +028300 03 CR-18V0 REDEFINES CORRECT-A. OBNC14.2 +028400 04 CORRECT-18V0 PIC -9(18). OBNC14.2 +028500 04 FILLER PIC X. OBNC14.2 +028600 03 FILLER PIC X(2) VALUE SPACE. OBNC14.2 +028700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBNC14.2 +028800 01 CCVS-C-1. OBNC14.2 +028900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBNC14.2 +029000- "SS PARAGRAPH-NAME OBNC14.2 +029100- " REMARKS". OBNC14.2 +029200 02 FILLER PIC X(20) VALUE SPACE. OBNC14.2 +029300 01 CCVS-C-2. OBNC14.2 +029400 02 FILLER PIC X VALUE SPACE. OBNC14.2 +029500 02 FILLER PIC X(6) VALUE "TESTED". OBNC14.2 +029600 02 FILLER PIC X(15) VALUE SPACE. OBNC14.2 +029700 02 FILLER PIC X(4) VALUE "FAIL". OBNC14.2 +029800 02 FILLER PIC X(94) VALUE SPACE. OBNC14.2 +029900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBNC14.2 +030000 01 REC-CT PIC 99 VALUE ZERO. OBNC14.2 +030100 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030200 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030400 01 PASS-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030500 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBNC14.2 +030600 01 ERROR-HOLD PIC 999 VALUE ZERO. OBNC14.2 +030700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBNC14.2 +030800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBNC14.2 +030900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBNC14.2 +031000 01 CCVS-H-1. OBNC14.2 +031100 02 FILLER PIC X(39) VALUE SPACES. OBNC14.2 +031200 02 FILLER PIC X(42) VALUE OBNC14.2 +031300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBNC14.2 +031400 02 FILLER PIC X(39) VALUE SPACES. OBNC14.2 +031500 01 CCVS-H-2A. OBNC14.2 +031600 02 FILLER PIC X(40) VALUE SPACE. OBNC14.2 +031700 02 FILLER PIC X(7) VALUE "CCVS85 ". OBNC14.2 +031800 02 FILLER PIC XXXX VALUE OBNC14.2 +031900 "4.2 ". OBNC14.2 +032000 02 FILLER PIC X(28) VALUE OBNC14.2 +032100 " COPY - NOT FOR DISTRIBUTION". OBNC14.2 +032200 02 FILLER PIC X(41) VALUE SPACE. OBNC14.2 +032300 OBNC14.2 +032400 01 CCVS-H-2B. OBNC14.2 +032500 02 FILLER PIC X(15) VALUE OBNC14.2 +032600 "TEST RESULT OF ". OBNC14.2 +032700 02 TEST-ID PIC X(9). OBNC14.2 +032800 02 FILLER PIC X(4) VALUE OBNC14.2 +032900 " IN ". OBNC14.2 +033000 02 FILLER PIC X(12) VALUE OBNC14.2 +033100 " HIGH ". OBNC14.2 +033200 02 FILLER PIC X(22) VALUE OBNC14.2 +033300 " LEVEL VALIDATION FOR ". OBNC14.2 +033400 02 FILLER PIC X(58) VALUE OBNC14.2 +033500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +033600 01 CCVS-H-3. OBNC14.2 +033700 02 FILLER PIC X(34) VALUE OBNC14.2 +033800 " FOR OFFICIAL USE ONLY ". OBNC14.2 +033900 02 FILLER PIC X(58) VALUE OBNC14.2 +034000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC14.2 +034100 02 FILLER PIC X(28) VALUE OBNC14.2 +034200 " COPYRIGHT 1985 ". OBNC14.2 +034300 01 CCVS-E-1. OBNC14.2 +034400 02 FILLER PIC X(52) VALUE SPACE. OBNC14.2 +034500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBNC14.2 +034600 02 ID-AGAIN PIC X(9). OBNC14.2 +034700 02 FILLER PIC X(45) VALUE SPACES. OBNC14.2 +034800 01 CCVS-E-2. OBNC14.2 +034900 02 FILLER PIC X(31) VALUE SPACE. OBNC14.2 +035000 02 FILLER PIC X(21) VALUE SPACE. OBNC14.2 +035100 02 CCVS-E-2-2. OBNC14.2 +035200 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBNC14.2 +035300 03 FILLER PIC X VALUE SPACE. OBNC14.2 +035400 03 ENDER-DESC PIC X(44) VALUE OBNC14.2 +035500 "ERRORS ENCOUNTERED". OBNC14.2 +035600 01 CCVS-E-3. OBNC14.2 +035700 02 FILLER PIC X(22) VALUE OBNC14.2 +035800 " FOR OFFICIAL USE ONLY". OBNC14.2 +035900 02 FILLER PIC X(12) VALUE SPACE. OBNC14.2 +036000 02 FILLER PIC X(58) VALUE OBNC14.2 +036100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +036200 02 FILLER PIC X(13) VALUE SPACE. OBNC14.2 +036300 02 FILLER PIC X(15) VALUE OBNC14.2 +036400 " COPYRIGHT 1985". OBNC14.2 +036500 01 CCVS-E-4. OBNC14.2 +036600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBNC14.2 +036700 02 FILLER PIC X(4) VALUE " OF ". OBNC14.2 +036800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBNC14.2 +036900 02 FILLER PIC X(40) VALUE OBNC14.2 +037000 " TESTS WERE EXECUTED SUCCESSFULLY". OBNC14.2 +037100 01 XXINFO. OBNC14.2 +037200 02 FILLER PIC X(19) VALUE OBNC14.2 +037300 "*** INFORMATION ***". OBNC14.2 +037400 02 INFO-TEXT. OBNC14.2 +037500 04 FILLER PIC X(8) VALUE SPACE. OBNC14.2 +037600 04 XXCOMPUTED PIC X(20). OBNC14.2 +037700 04 FILLER PIC X(5) VALUE SPACE. OBNC14.2 +037800 04 XXCORRECT PIC X(20). OBNC14.2 +037900 02 INF-ANSI-REFERENCE PIC X(48). OBNC14.2 +038000 01 HYPHEN-LINE. OBNC14.2 +038100 02 FILLER PIC IS X VALUE IS SPACE. OBNC14.2 +038200 02 FILLER PIC IS X(65) VALUE IS "************************OBNC14.2 +038300- "*****************************************". OBNC14.2 +038400 02 FILLER PIC IS X(54) VALUE IS "************************OBNC14.2 +038500- "******************************". OBNC14.2 +038600 01 CCVS-PGM-ID PIC X(9) VALUE OBNC14.2 +038700 "OBNC1M". OBNC14.2 +038800 PROCEDURE DIVISION. OBNC14.2 +038900 CCVS1 SECTION. OBNC14.2 +039000 OPEN-FILES. OBNC14.2 +039100 OPEN OUTPUT PRINT-FILE. OBNC14.2 +039200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBNC14.2 +039300 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +039400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBNC14.2 +039500 GO TO CCVS1-EXIT. OBNC14.2 +039600 CLOSE-FILES. OBNC14.2 +039700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBNC14.2 +039800 TERMINATE-CCVS. OBNC14.2 +039900S EXIT PROGRAM. OBNC14.2 +040000STERMINATE-CALL. OBNC14.2 +040100 STOP RUN. OBNC14.2 +040200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBNC14.2 +040300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBNC14.2 +040400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBNC14.2 +040500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBNC14.2 +040600 MOVE "****TEST DELETED****" TO RE-MARK. OBNC14.2 +040700 PRINT-DETAIL. OBNC14.2 +040800 IF REC-CT NOT EQUAL TO ZERO OBNC14.2 +040900 MOVE "." TO PARDOT-X OBNC14.2 +041000 MOVE REC-CT TO DOTVALUE. OBNC14.2 +041100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBNC14.2 +041200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBNC14.2 +041300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBNC14.2 +041400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBNC14.2 +041500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBNC14.2 +041600 MOVE SPACE TO CORRECT-X. OBNC14.2 +041700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBNC14.2 +041800 MOVE SPACE TO RE-MARK. OBNC14.2 +041900 HEAD-ROUTINE. OBNC14.2 +042000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC14.2 +042300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC14.2 +042400 COLUMN-NAMES-ROUTINE. OBNC14.2 +042500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +042600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +042800 END-ROUTINE. OBNC14.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBNC14.2 +043000 END-RTN-EXIT. OBNC14.2 +043100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +043200 END-ROUTINE-1. OBNC14.2 +043300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBNC14.2 +043400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBNC14.2 +043500 ADD PASS-COUNTER TO ERROR-HOLD. OBNC14.2 +043600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBNC14.2 +043700 MOVE PASS-COUNTER TO CCVS-E-4-1. OBNC14.2 +043800 MOVE ERROR-HOLD TO CCVS-E-4-2. OBNC14.2 +043900 MOVE CCVS-E-4 TO CCVS-E-2-2. OBNC14.2 +044000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBNC14.2 +044100 END-ROUTINE-12. OBNC14.2 +044200 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBNC14.2 +044300 IF ERROR-COUNTER IS EQUAL TO ZERO OBNC14.2 +044400 MOVE "NO " TO ERROR-TOTAL OBNC14.2 +044500 ELSE OBNC14.2 +044600 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBNC14.2 +044700 MOVE CCVS-E-2 TO DUMMY-RECORD. OBNC14.2 +044800 PERFORM WRITE-LINE. OBNC14.2 +044900 END-ROUTINE-13. OBNC14.2 +045000 IF DELETE-COUNTER IS EQUAL TO ZERO OBNC14.2 +045100 MOVE "NO " TO ERROR-TOTAL ELSE OBNC14.2 +045200 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBNC14.2 +045300 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBNC14.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +045500 IF INSPECT-COUNTER EQUAL TO ZERO OBNC14.2 +045600 MOVE "NO " TO ERROR-TOTAL OBNC14.2 +045700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBNC14.2 +045800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBNC14.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +046000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +046100 WRITE-LINE. OBNC14.2 +046200 ADD 1 TO RECORD-COUNT. OBNC14.2 +046300Y IF RECORD-COUNT GREATER 42 OBNC14.2 +046400Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBNC14.2 +046500Y MOVE SPACE TO DUMMY-RECORD OBNC14.2 +046600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBNC14.2 +046700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC14.2 +046800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC14.2 +046900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES OBNC14.2 +047000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES OBNC14.2 +047100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047400Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBNC14.2 +047500Y MOVE ZERO TO RECORD-COUNT. OBNC14.2 +047600 PERFORM WRT-LN. OBNC14.2 +047700 WRT-LN. OBNC14.2 +047800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBNC14.2 +047900 MOVE SPACE TO DUMMY-RECORD. OBNC14.2 +048000 BLANK-LINE-PRINT. OBNC14.2 +048100 PERFORM WRT-LN. OBNC14.2 +048200 FAIL-ROUTINE. OBNC14.2 +048300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC14.2 +048400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC14.2 +048500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC14.2 +048600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBNC14.2 +048700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +048800 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC14.2 +048900 GO TO FAIL-ROUTINE-EX. OBNC14.2 +049000 FAIL-ROUTINE-WRITE. OBNC14.2 +049100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBNC14.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBNC14.2 +049300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +049400 MOVE SPACES TO COR-ANSI-REFERENCE. OBNC14.2 +049500 FAIL-ROUTINE-EX. EXIT. OBNC14.2 +049600 BAIL-OUT. OBNC14.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBNC14.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBNC14.2 +049900 BAIL-OUT-WRITE. OBNC14.2 +050000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBNC14.2 +050100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC14.2 +050200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +050300 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC14.2 +050400 BAIL-OUT-EX. EXIT. OBNC14.2 +050500 CCVS1-EXIT. OBNC14.2 +050600 EXIT. OBNC14.2 +050700 SECT-NC107A-001 SECTION. OBNC14.2 +050800 REMARKS-TEST. OBNC14.2 +050900 MOVE "IV-11 7.2.4" TO ANSI-REFERENCE. OBNC14.2 +051000 MOVE "COBOL REMARKS PARA" TO FEATURE. OBNC14.2 +051100 MOVE "REMARKS" TO PAR-NAME. OBNC14.2 +051200 MOVE "PHONY LINES SHOULDNT EXECUT" TO RE-MARK. OBNC14.2 +051300 PERFORM PRINT-DETAIL. OBNC14.2 +051400* THE FOLLOWING HAS BEEN MOVED FROM THE END TO ENSURE OBNC14.2 +051500* EXECUTION OBNC14.2 +051600 NOTE-TEST-6. OBNC14.2 +051700* PERFORM FAIL. OBNC14.2 +051800* NOTE ENTER GO TO NOTE-WRITE-6 OBNC14.2 +051900* USE GO TO NOTE-WRITE-6 OBNC14.2 +052000* DECLARATIVES GO TO NOTE-WRITE-6 OBNC14.2 +052100* DATA DIVISION GO TO NOTE-WRITE-6 OBNC14.2 +052200* COPY (SEE ALSO PROGRAM LB104) GO TO NOTE-WRITE-6 OBNC14.2 +052300* THE COMPILER SHOULD "IGNORE" THE ABOVE WORDS. OBNC14.2 +052400* PERFORM PASS. OBNC14.2 +052500 GO TO NOTE-WRITE-6. OBNC14.2 +052600 NOTE-DELETE-6. OBNC14.2 +052700 PERFORM DE-LETE. OBNC14.2 +052800 NOTE-WRITE-6. OBNC14.2 +052900 MOVE "NOTE RESERVED WORDS" TO FEATURE. OBNC14.2 +053000 MOVE "NOTE-TEST-6" TO PAR-NAME. OBNC14.2 +053100 PERFORM PRINT-DETAIL. OBNC14.2 +053200 NUM-INIT-1. OBNC14.2 +053300 MOVE "NUMERIC PARA-NAMES" TO FEATURE. OBNC14.2 +053400 MOVE "VI-75 6.7.2" TO ANSI-REFERENCE. OBNC14.2 +053500 PERFORM PRINT-DETAIL. OBNC14.2 +053600 NUM-TEST-1. OBNC14.2 +053700 ALTER 02 TO PROCEED TO 77. OBNC14.2 +053800 GO TO 02. OBNC14.2 +053900 NUM-DELETE-1. OBNC14.2 +054000 PERFORM DE-LETE. OBNC14.2 +054100 GO TO NUM-WRITE-1. OBNC14.2 +054200 02. OBNC14.2 +054300 GO TO 50. OBNC14.2 +054400 50. PERFORM FAIL. OBNC14.2 +054500 GO TO NUM-WRITE-1. OBNC14.2 +054600 77. OBNC14.2 +054700 PERFORM PASS. OBNC14.2 +054800 NUM-WRITE-1. OBNC14.2 +054900 MOVE "NUM-TEST-1" TO PAR-NAME. OBNC14.2 +055000 PERFORM PRINT-DETAIL. OBNC14.2 +055100 ALTER-INIT. OBNC14.2 +055200 MOVE "ALTER" TO FEATURE. OBNC14.2 +055300 MOVE "VI-75 6.7.2" TO ANSI-REFERENCE. OBNC14.2 +055400 ALTER-TEST-1. OBNC14.2 +055500 ALTER ALTER-A TO PROCEED TO ALTER-C. OBNC14.2 +055600 GO TO ALTER-A. OBNC14.2 +055700 ALTER-DELETE-1. OBNC14.2 +055800 PERFORM DE-LETE. OBNC14.2 +055900 GO TO ALTER-WRITE-1. OBNC14.2 +056000 ALTER-A. OBNC14.2 +056100 GO TO ALTER-B. OBNC14.2 +056200 ALTER-B. OBNC14.2 +056300 PERFORM FAIL. OBNC14.2 +056400 GO TO ALTER-WRITE-1. OBNC14.2 +056500 ALTER-C. OBNC14.2 +056600 PERFORM PASS. OBNC14.2 +056700 ALTER-WRITE-1. OBNC14.2 +056800 MOVE "ALTER-TEST-1" TO PAR-NAME. OBNC14.2 +056900 PERFORM PRINT-DETAIL. OBNC14.2 +057000 ALTER-TEST-2. OBNC14.2 +057100 ALTER ALTER-D TO ALTER-F. OBNC14.2 +057200* NOTE THE WORDS "PROCEED TO" ARE OPTIONAL. OBNC14.2 +057300 GO TO ALTER-D. OBNC14.2 +057400 ALTER-DELETE-2. OBNC14.2 +057500 PERFORM DE-LETE. OBNC14.2 +057600 GO TO ALTER-WRITE-2. OBNC14.2 +057700 ALTER-D. OBNC14.2 +057800 GO TO ALTER-E. OBNC14.2 +057900 ALTER-E. OBNC14.2 +058000 PERFORM FAIL. OBNC14.2 +058100 GO TO ALTER-WRITE-2. OBNC14.2 +058200 ALTER-F. OBNC14.2 +058300 PERFORM PASS. OBNC14.2 +058400 ALTER-WRITE-2. OBNC14.2 +058500 MOVE "ALTER-TEST-2" TO PAR-NAME. OBNC14.2 +058600 PERFORM PRINT-DETAIL. OBNC14.2 +058700 ALTER-TEST-3. OBNC14.2 +058800 ALTER ALTER-G TO PROCEED TO ALTER-I. OBNC14.2 +058900* NOTE COMPOUND ALTERS, MULTIPLE ALTERS OF THE SAME SEQUENCE. OBNC14.2 +059000 GO TO ALTER-G. OBNC14.2 +059100 ALTER-DELETE-3. OBNC14.2 +059200 PERFORM DE-LETE. OBNC14.2 +059300 GO TO ALTER-WRITE-3. OBNC14.2 +059400 ALTER-G. OBNC14.2 +059500 GO TO ALTER-H. OBNC14.2 +059600 ALTER-H. OBNC14.2 +059700 PERFORM FAIL. OBNC14.2 +059800 GO TO ALTER-WRITE-3. OBNC14.2 +059900 ALTER-I. OBNC14.2 +060000 ADD 1 TO ALTERLOOP. OBNC14.2 +060100 IF ALTERLOOP GREATER THAN 1 OBNC14.2 +060200 PERFORM FAIL OBNC14.2 +060300 GO TO ALTER-WRITE-3. OBNC14.2 +060400 ALTER ALTER-G TO PROCEED TO ALTER-J. OBNC14.2 +060500 GO TO ALTER-G. OBNC14.2 +060600 ALTER-J. OBNC14.2 +060700 PERFORM PASS. OBNC14.2 +060800 ALTER-WRITE-3. OBNC14.2 +060900 MOVE "ALTER-TEST-3" TO PAR-NAME. OBNC14.2 +061000 PERFORM PRINT-DETAIL. OBNC14.2 +061100* OBNC14.2 +061200 GO--TEST-1. OBNC14.2 +061300 ALTER GO--A TO PROCEED TO GO--C. OBNC14.2 +061400* NOTE THE GO STATEMENT IN GO--A IS NOT LEGAL UNLESS IT IS OBNC14.2 +061500* ALTERED AS SHOWN ABOVE BEFORE CONTROL PASSES TO IT. OBNC14.2 +061600 GO TO GO--A. OBNC14.2 +061700 GO--DELETE-1. OBNC14.2 +061800 PERFORM DE-LETE. OBNC14.2 +061900 GO TO GO--WRITE-1. OBNC14.2 +062000 GO--A. OBNC14.2 +062100 GO TO. OBNC14.2 +062200 GO--B. OBNC14.2 +062300 PERFORM FAIL. OBNC14.2 +062400 GO TO GO--WRITE-1. OBNC14.2 +062500 GO--C. OBNC14.2 +062600 PERFORM PASS. OBNC14.2 +062700 GO--WRITE-1. OBNC14.2 +062800 PERFORM END-ROUTINE. OBNC14.2 +062900 MOVE "UNFINISHED GO TO" TO FEATURE. OBNC14.2 +063000 MOVE "GO--TEST-1" TO PAR-NAME. OBNC14.2 +063100 PERFORM PRINT-DETAIL. OBNC14.2 +063200 COMMENT-ENTRIES-INIT. OBNC14.2 +063300 MOVE "VI-6 3.2.1.1" TO ANSI-REFERENCE. OBNC14.2 +063400 COMMENT-ENTRIES-TEST. OBNC14.2 +063500 MOVE "PLEASE VISUALLY VERIFY THE FOLLOWING PARAGRAPHS: " OBNC14.2 +063600 TO RE-MARK. OBNC14.2 +063700 PERFORM PRINT-DETAIL. OBNC14.2 +063800 MOVE " AUTHOR, INSTALLATION, DATE-WRITTEN, SECURITY" OBNC14.2 +063900 TO RE-MARK. OBNC14.2 +064000 PERFORM PRINT-DETAIL. OBNC14.2 +064100 SECT-NC180M-001 SECTION. OBNC14.2 +064200 STOP-INIT-GF-1. OBNC14.2 +064300 MOVE "STOP LITERAL" TO FEATURE. OBNC14.2 +064400 MOVE "VI-88 6.14.3 SR3, 6.14.4 GR2" TO ANSI-REFERENCE. OBNC14.2 +064500 STOP-TEST-GF-1. OBNC14.2 +064600 STOP "OPERATOR PLEASE EXECUTE RUN CONTINUATION". OBNC14.2 +064700 PERFORM PASS. OBNC14.2 +064800 GO TO STOP-WRITE-GF-1. OBNC14.2 +064900 STOP-DELETE-GF-1. OBNC14.2 +065000 PERFORM DE-LETE. OBNC14.2 +065100 STOP-WRITE-GF-1. OBNC14.2 +065200 MOVE "STOP-TEST-GF-1" TO PAR-NAME. OBNC14.2 +065300 PERFORM PRINT-DETAIL. OBNC14.2 +065400*STOP-NOTE. OBNC14.2 +065500* NOTE THE ABOVE TEST TESTS THE BASIC FUNCTIONING OF THE OBNC14.2 +065600* STOP VERB WITH LITERAL - A MESSAGE TO THE OPERATOR OBNC14.2 +065700* AND RESTART ABILITY. THE FOLLOWING TESTS ASCERTAIN OBNC14.2 +065800* THAT THE "LITERAL" MAY BE ANY LEGAL COBOL LITERAL. OBNC14.2 +065900* THE USER MUST VISUALLY CHECK THE MESSAGES TO THE OBNC14.2 +066000* OPERATOR AND SEE THAT THEY ARE IDENTICAL TO THE OBNC14.2 +066100* DATA SHOWN IN THE OUTPUT LISTING. OBNC14.2 +066200 STOP-INIT-GF-2. OBNC14.2 +066300 MOVE "SEE STOP-NOTE PARAGRAPH" TO RE-MARK. OBNC14.2 +066400 PERFORM PRINT-DETAIL. OBNC14.2 +066500 STOP-TEST-GF-2. OBNC14.2 +066600 STOP "A". OBNC14.2 +066700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +066800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +066900 GO TO STOP-WRITE-GF-2. OBNC14.2 +067000 STOP-DELETE-GF-2. OBNC14.2 +067100 PERFORM DE-LETE. OBNC14.2 +067200 STOP-WRITE-GF-2. OBNC14.2 +067300 MOVE "STOP-TEST-GF-2 " TO PAR-NAME. OBNC14.2 +067400 PERFORM PRINT-DETAIL. OBNC14.2 +067500 MOVE " A" TO PRINT-REC. OBNC14.2 +067600 WRITE PRINT-REC. OBNC14.2 +067700 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +067800 STOP-TEST-GF-3. OBNC14.2 +067900 STOP "*". OBNC14.2 +068000 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +068100 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +068200 GO TO STOP-WRITE-GF-3. OBNC14.2 +068300 STOP-DELETE-GF-3. OBNC14.2 +068400 PERFORM DE-LETE. OBNC14.2 +068500 STOP-WRITE-GF-3. OBNC14.2 +068600 MOVE "STOP-TEST-GF-3 " TO PAR-NAME. OBNC14.2 +068700 PERFORM PRINT-DETAIL. OBNC14.2 +068800 MOVE " *" TO PRINT-REC. OBNC14.2 +068900 WRITE PRINT-REC. OBNC14.2 +069000 STOP-TEST-GF-4. OBNC14.2 +069100 STOP QUOTE. OBNC14.2 +069200 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +069300 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +069400 GO TO STOP-WRITE-GF-4. OBNC14.2 +069500 STOP-DELETE-GF-4. OBNC14.2 +069600 PERFORM DE-LETE. OBNC14.2 +069700 STOP-WRITE-GF-4. OBNC14.2 +069800 MOVE "STOP-TEST-GF-4 " TO PAR-NAME. OBNC14.2 +069900 PERFORM PRINT-DETAIL. OBNC14.2 +070000 MOVE " (A SINGLE QUOTE)" TO PRINT-REC. OBNC14.2 +070100 WRITE PRINT-REC. OBNC14.2 +070200 STOP-TEST-GF-5. OBNC14.2 +070300 MOVE "IV-9 4.3.3.3.1" TO ANSI-REFERENCE. OBNC14.2 +070400 STOP " * 5 * 10 * 15 * 20 * 25 * 30 * 35 * 40 * 45 * 50 OBNC14.2 +070500- "* 55 * 60 * 65 * 70 * 75 * 80 * 85 * 90 * 95 *100 *105 *110 OBNC14.2 +070600- "*115 *120 *125 *130 *135 *140 *145 *150 *155 *160". OBNC14.2 +070700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +070800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +070900 GO TO STOP-WRITE-GF-5. OBNC14.2 +071000 STOP-DELETE-GF-5. OBNC14.2 +071100 PERFORM DE-LETE. OBNC14.2 +071200 STOP-WRITE-GF-5. OBNC14.2 +071300 MOVE "STOP-TEST-GF-5 " TO PAR-NAME. OBNC14.2 +071400 PERFORM PRINT-DETAIL. OBNC14.2 +071500 MOVE " * 5 * 10 * 15 * 20 * 25 * 30 * 35 * 40 * 45 * 50 OBNC14.2 +071600- "* 55 * 60 * 65 * 70 * 75 * 80 * 85 * 90 * 95 *100 *105 *110 OBNC14.2 +071700- "*115 *120 *125 *130 *135 *140 *145 *150 *155 *160" OBNC14.2 +071800 TO PRINT-REC. OBNC14.2 +071900 WRITE PRINT-REC. OBNC14.2 +072000 STOP-TEST-GF-6. OBNC14.2 +072100 MOVE "VI-129 6.23.4" TO ANSI-REFERENCE. OBNC14.2 +072200 STOP 7. OBNC14.2 +072300 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +072400 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +072500 GO TO STOP-WRITE-GF-6. OBNC14.2 +072600 STOP-DELETE-GF-6. OBNC14.2 +072700 PERFORM DE-LETE. OBNC14.2 +072800 STOP-WRITE-GF-6. OBNC14.2 +072900 MOVE "STOP-TEST-GF-6 " TO PAR-NAME. OBNC14.2 +073000 PERFORM PRINT-DETAIL. OBNC14.2 +073100 MOVE " 7" TO PRINT-REC. OBNC14.2 +073200 WRITE PRINT-REC. OBNC14.2 +073300 STOP-TEST-GF-7. OBNC14.2 +073400 STOP 123456789987654321. OBNC14.2 +073500 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +073600 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +073700 GO TO STOP-WRITE-GF-7. OBNC14.2 +073800 STOP-DELETE-GF-7. OBNC14.2 +073900 PERFORM DE-LETE. OBNC14.2 +074000 STOP-WRITE-GF-7. OBNC14.2 +074100 MOVE "STOP-TEST-GF-7 " TO PAR-NAME. OBNC14.2 +074200 PERFORM PRINT-DETAIL. OBNC14.2 +074300 MOVE " 123456789987654321" TO PRINT-REC. OBNC14.2 +074400 WRITE PRINT-REC. OBNC14.2 +074500 STOP-TEST-GF-8. OBNC14.2 +074600 STOP ZERO. OBNC14.2 +074700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +074800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +074900 GO TO STOP-WRITE-GF-8. OBNC14.2 +075000 STOP-DELETE-GF-8. OBNC14.2 +075100 PERFORM DE-LETE. OBNC14.2 +075200 STOP-WRITE-GF-8. OBNC14.2 +075300 MOVE "STOP-TEST-GF-8" TO PAR-NAME. OBNC14.2 +075400 PERFORM PRINT-DETAIL. OBNC14.2 +075500 MOVE " 0" TO PRINT-REC. OBNC14.2 +075600 WRITE PRINT-REC. OBNC14.2 +075700 STOP-TEST-GF-9. OBNC14.2 +075800 MOVE SPACE TO DUMMY-RECORD. OBNC14.2 +075900 PERFORM BLANK-LINE-PRINT 4 TIMES. OBNC14.2 +076000 MOVE " STOP-TEST-GF-9 PASSES UNLESS A SECOND REPORT FOR OBNC14.2 +076100- "OBNC1 IS GENERATED AFTER THIS ONE." TO TEST-RESULTS. OBNC14.2 +076200 PERFORM PRINT-DETAIL. OBNC14.2 +076300 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +076400 PERFORM END-ROUTINE THRU END-ROUTINE-13. OBNC14.2 +076500 CLOSE PRINT-FILE. OBNC14.2 +076600 STOP "OPERATOR KILL OBNC1". OBNC14.2 +076700 MOVE ZEROES TO ERROR-HOLD. OBNC14.2 +076800 OPEN OUTPUT PRINT-FILE. OBNC14.2 +076900 PERFORM HEAD-ROUTINE THROUGH COLUMN-NAMES-ROUTINE. OBNC14.2 +077000 PERFORM FAIL. OBNC14.2 +077100 MOVE "EXECUTION DID NOT HALT" TO RE-MARK. OBNC14.2 +077200 GO TO STOP-WRITE-GF-9. OBNC14.2 +077300 STOP-DELETE-GF-9. OBNC14.2 +077400 PERFORM DE-LETE. OBNC14.2 +077500 STOP-WRITE-GF-9. OBNC14.2 +077600 MOVE "STOP LITERAL" TO FEATURE. OBNC14.2 +077700 MOVE "STOP-GF-9-TEST" TO PAR-NAME. OBNC14.2 +077800 PERFORM PRINT-DETAIL. OBNC14.2 +077900 OBNC14.2 +078000 CCVS-EXIT SECTION. OBNC14.2 +078100 CCVS-999999. OBNC14.2 +078200 GO TO CLOSE-FILES. OBNC14.2 +*END-OF,OBNC1M +*HEADER,COBOL,OBNC2M +000100 IDENTIFICATION DIVISION. OBNC24.2 +000200 PROGRAM-ID. OBNC24.2 +000300 OBNC2M. OBNC24.2 +000400 OBNC24.2 +000500**************************************************************** OBNC24.2 +000600* * OBNC24.2 +000700* VALIDATION FOR:- * OBNC24.2 +000800* * OBNC24.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +001000* * OBNC24.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC24.2 +001200* * OBNC24.2 +001300**************************************************************** OBNC24.2 +001400* * OBNC24.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * OBNC24.2 +001600* * OBNC24.2 +001700* X-55 - SYSTEM PRINTER NAME. * OBNC24.2 +001800* X-82 - SOURCE COMPUTER NAME. * OBNC24.2 +001900* X-83 - OBJECT COMPUTER NAME. * OBNC24.2 +002000* * OBNC24.2 +002100**************************************************************** OBNC24.2 +002200* PROGRAM OBNC2M CONTAINS CCVS74 TESTS OF LANGUAGE ELEMENTS * OBNC24.2 +002300* DEFINED AS OBSOLETE IN THE 198X STANDARDS. * OBNC24.2 +002400**************************************************************** OBNC24.2 +002500 DATE-COMPILED. OBNC24.2 +002600* THIS COMMENT LINE SHOULD NOT BE REPLACED OBNC24.2 +002700* THIS COMMENT ENTRY SHOULD APPEAR AS THE LAST LINE BEFORE OBNC24.2 +002800* THE ENVIRONMENT DIVISION. OBNC24.2 +002900 ENVIRONMENT DIVISION. OBNC24.2 +003000 CONFIGURATION SECTION. OBNC24.2 +003100 SOURCE-COMPUTER. OBNC24.2 +003200 XXXXX082. OBNC24.2 +003300 OBJECT-COMPUTER. OBNC24.2 +003400 XXXXX083. OBNC24.2 +003500 INPUT-OUTPUT SECTION. OBNC24.2 +003600 FILE-CONTROL. OBNC24.2 +003700 SELECT PRINT-FILE ASSIGN TO OBNC24.2 +003800 XXXXX055. OBNC24.2 +003900 DATA DIVISION. OBNC24.2 +004000 FILE SECTION. OBNC24.2 +004100 FD PRINT-FILE. OBNC24.2 +004200 01 PRINT-REC PICTURE X(120). OBNC24.2 +004300 01 DUMMY-RECORD PICTURE X(120). OBNC24.2 +004400 WORKING-STORAGE SECTION. OBNC24.2 +004500 77 SMALL-VALU PICTURE 99 VALUE 7. OBNC24.2 +004600 77 SMALLER-VALU PICTURE 99 VALUE 6. OBNC24.2 +004700 77 SMALLEST-VALU PICTURE 99 VALUE 5. OBNC24.2 +004800 77 EVEN-SMALLER PICTURE 99 VALUE 1. OBNC24.2 +004900 77 WRK-DS-02V00 PICTURE S99. OBNC24.2 +005000 88 TEST-2NUC-COND-99 VALUE 99. OBNC24.2 +005100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). OBNC24.2 +005200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 OBNC24.2 +005300 PICTURE S9(12). OBNC24.2 +005400 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. OBNC24.2 +005500 77 WRK-DS-01V00 PICTURE S9. OBNC24.2 +005600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. OBNC24.2 +005700 77 A990-DS-0201P PICTURE S99P VALUE 990. OBNC24.2 +005800 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. OBNC24.2 +005900 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.OBNC24.2 +006000 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. OBNC24.2 +006100 77 WRK-XN-00001 PICTURE X. OBNC24.2 +006200 77 WRK-XN-00005 PICTURE X(5). OBNC24.2 +006300 77 TWO PICTURE 9 VALUE 2. OBNC24.2 +006400 77 THREE PICTURE 9 VALUE 3. OBNC24.2 +006500 77 SEVEN PICTURE 9 VALUE 7. OBNC24.2 +006600 77 NINE PICTURE 9 VALUE 9. OBNC24.2 +006700 77 TEN PICTURE 99 VALUE 10. OBNC24.2 +006800 77 ALTERCOUNT PICTURE 999 VALUE ZERO. OBNC24.2 +006900 77 QT5 PIC X(4) VALUE SPACE. OBNC24.2 +007000 77 XRAY PICTURE IS X. OBNC24.2 +007100 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. OBNC24.2 +007200 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. OBNC24.2 +007300 77 IF-D3 PICTURE X(10) VALUE "0000000000". OBNC24.2 +007400 77 IF-D4 PICTURE X(15) VALUE " ". OBNC24.2 +007500 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. OBNC24.2 +007600 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". OBNC24.2 +007700 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. OBNC24.2 +007800 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. OBNC24.2 +007900 77 IF-D9 PICTURE X(3) VALUE "123". OBNC24.2 +008000 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". OBNC24.2 +008100 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. OBNC24.2 +008200 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. OBNC24.2 +008300 77 IF-D15 PICTURE S999PP VALUE 12300. OBNC24.2 +008400 77 IF-D16 PICTURE PP99 VALUE .0012. OBNC24.2 +008500 77 IF-D17 PICTURE SV9(4) VALUE .0012. OBNC24.2 +008600 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". OBNC24.2 +008700 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". OBNC24.2 +008800 77 IF-D23 PICTURE $9,9B9.90+. OBNC24.2 +008900 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". OBNC24.2 +009000 77 IF-D25 PICTURE ABABX0A. OBNC24.2 +009100 77 IF-D26 PICTURE X(8) VALUE "A C D0E". OBNC24.2 +009200 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 OBNC24.2 +009300 USAGE IS COMPUTATIONAL. OBNC24.2 +009400 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. OBNC24.2 +009500 77 IF-D31 PICTURE S9(6) VALUE -123. OBNC24.2 +009600 77 IF-D32 PICTURE S9(4)V99. OBNC24.2 +009700 88 A VALUE 1. OBNC24.2 +009800 88 B VALUES ARE 2 THRU 4. OBNC24.2 +009900 88 C VALUE IS ZERO. OBNC24.2 +010000 88 D VALUE IS +12.34. OBNC24.2 +010100 88 E VALUE IS .01, .11, .21 .81. OBNC24.2 +010200 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. OBNC24.2 +010300 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. OBNC24.2 +010400 77 IF-D33 PICTURE X(4). OBNC24.2 +010500 88 B VALUE QUOTE. OBNC24.2 +010600 88 C VALUE SPACE. OBNC24.2 +010700 88 D VALUE ALL "BAC". OBNC24.2 +010800 77 IF-D34 PICTURE A(4). OBNC24.2 +010900 88 B VALUE "A A ". OBNC24.2 +011000 77 IF-D37 PICTURE 9(5) VALUE 12345. OBNC24.2 +011100 77 IF-D38 PICTURE X(9) VALUE "12345 ". OBNC24.2 +011200 77 CCON-1 PICTURE 99 VALUE 11. OBNC24.2 +011300 77 CCON-2 PICTURE 99 VALUE 12. OBNC24.2 +011400 77 CCON-3 PICTURE 99 VALUE 13. OBNC24.2 +011500 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. OBNC24.2 +011600 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. OBNC24.2 +011700 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. OBNC24.2 +011800 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.OBNC24.2 +011900 77 START-POINT PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +012000 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +012100 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. OBNC24.2 +012200 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. OBNC24.2 +012300 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. OBNC24.2 +012400 77 PFM-12-COUNTER PICTURE 999 VALUE 100. OBNC24.2 +012500 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. OBNC24.2 +012600 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. OBNC24.2 +012700 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. OBNC24.2 +012800 01 IF-TABLE. OBNC24.2 +012900 02 IF-ELEM PICTURE X OCCURS 12 TIMES. OBNC24.2 +013000 01 QUOTE-DATA. OBNC24.2 +013100 02 QU-1 PICTURE X(3) VALUE "123". OBNC24.2 +013200 02 QU-2 PICTURE X VALUE QUOTE. OBNC24.2 +013300 02 QU-3 PICTURE X(6) VALUE "ABC456". OBNC24.2 +013400 01 IF-D10. OBNC24.2 +013500 02 D1 PICTURE X(2) VALUE "01". OBNC24.2 +013600 02 D2 PICTURE X(2) VALUE "23". OBNC24.2 +013700 02 D3. OBNC24.2 +013800 03 D4 PICTURE X(4) VALUE "4567". OBNC24.2 +013900 03 D5 PICTURE X(4) VALUE "8912". OBNC24.2 +014000 01 IF-D12. OBNC24.2 +014100 02 D1 PICTURE X(3) VALUE "ABC". OBNC24.2 +014200 02 D2. OBNC24.2 +014300 03 D3. OBNC24.2 +014400 04 D4 PICTURE XX VALUE "DE". OBNC24.2 +014500 04 D5 PICTURE X VALUE "F". OBNC24.2 +014600 01 IF-D20. OBNC24.2 +014700 02 FILLER PICTURE 9(5) VALUE ZERO. OBNC24.2 +014800 02 D1 PICTURE 9(2) VALUE 12. OBNC24.2 +014900 02 D2 PICTURE 9 VALUE 3. OBNC24.2 +015000 02 D3 PICTURE 9(2) VALUE 45. OBNC24.2 +015100 01 IF-D21. OBNC24.2 +015200 02 D1 PICTURE 9(5) VALUE ZEROS. OBNC24.2 +015300 02 D2 PICTURE 9(5) VALUE 12345. OBNC24.2 +015400 01 IF-D22. OBNC24.2 +015500 02 D1 PICTURE A(2) VALUE "AB". OBNC24.2 +015600 02 D2 PICTURE A(4) VALUE "CDEF". OBNC24.2 +015700 01 IF-D35. OBNC24.2 +015800 02 AA PICTURE X(2). OBNC24.2 +015900 88 A1 VALUE "AA". OBNC24.2 +016000 88 A2 VALUE "AB". OBNC24.2 +016100 02 BB PICTURE IS X(2). OBNC24.2 +016200 88 B1 VALUE "CC". OBNC24.2 +016300 88 B2 VALUE "CD". OBNC24.2 +016400 02 BB-2 REDEFINES BB. OBNC24.2 +016500 03 AAA PICTURE X. OBNC24.2 +016600 88 AA1 VALUE "A". OBNC24.2 +016700 88 AA2 VALUE "C". OBNC24.2 +016800 03 BBB PICTURE X. OBNC24.2 +016900 88 BB1 VALUE "B". OBNC24.2 +017000 88 BB2 VALUE "D". OBNC24.2 +017100 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYOBNC24.2 +017200- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMOBNC24.2 +017300- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". OBNC24.2 +017400 01 IF-D40 PICTURE 9(5) VALUE 12345 OBNC24.2 +017500 COMPUTATIONAL SYNCHRONIZED RIGHT. OBNC24.2 +017600 88 IF-D40A VALUE ZERO THRU 10000. OBNC24.2 +017700 88 IF-D40B VALUE 10001 THRU 99999. OBNC24.2 +017800 88 IF-D40C VALUE 99999. OBNC24.2 +017900 01 PERFORM1 PICTURE XXX VALUE SPACES. OBNC24.2 +018000 01 PERFORM2 PICTURE S999 VALUE 20. OBNC24.2 +018100 01 PERFORM3 PICTURE 9 VALUE 5. OBNC24.2 +018200 01 PERFORM4 PICTURE S99V9. OBNC24.2 +018300 01 PERFORM5 PICTURE S99V9 VALUE 10.0. OBNC24.2 +018400 01 PERFORM6 PICTURE 99V9. OBNC24.2 +018500 01 PERFORM7. OBNC24.2 +018600 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. OBNC24.2 +018700 01 PERFORM9 PICTURE 9 VALUE 3. OBNC24.2 +018800 01 PERFORM10 PICTURE S9 VALUE -1. OBNC24.2 +018900 01 PERFORM11 PICTURE 99 VALUE 6. OBNC24.2 +019000 01 PERFORM12. OBNC24.2 +019100 02 PERFORM13 OCCURS 4 TIMES. OBNC24.2 +019200 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. OBNC24.2 +019300 03 PERFORM15 OCCURS 10 TIMES. OBNC24.2 +019400 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. OBNC24.2 +019500 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +019600 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +019700 01 PERFORM-KEY PICTURE 9. OBNC24.2 +019800 01 PERFORM-SEVEN-LEVEL-TABLE. OBNC24.2 +019900 03 PFM71 OCCURS 2. OBNC24.2 +020000 05 PFM72 OCCURS 2. OBNC24.2 +020100 07 PFM73 OCCURS 2. OBNC24.2 +020200 09 PFM74 OCCURS 2. OBNC24.2 +020300 11 PFM75 OCCURS 2. OBNC24.2 +020400 13 PFM76 OCCURS 2. OBNC24.2 +020500 15 PFM77 OCCURS 2. OBNC24.2 +020600 17 PFM77-1 PIC X. OBNC24.2 +020700 01 S1 PIC S9(3) COMP. OBNC24.2 +020800 01 S2 PIC S9(3) COMP. OBNC24.2 +020900 01 S3 PIC S9(3) COMP. OBNC24.2 +021000 01 S4 PIC S9(3) COMP. OBNC24.2 +021100 01 S5 PIC S9(3) COMP. OBNC24.2 +021200 01 S6 PIC S9(3) COMP. OBNC24.2 +021300 01 S7 PIC S9(3) COMP. OBNC24.2 +021400 01 PFM-7-TOT PIC S9(3) COMP. OBNC24.2 +021500 01 PFM-F4-24-TOT PIC S9(3) COMP. OBNC24.2 +021600 01 PFM-A PIC S9(3) COMP. OBNC24.2 +021700 01 PFM-B PIC S9(3) COMP. OBNC24.2 +021800 01 FILLER-A. OBNC24.2 +021900 03 PFM-F4-25-A PIC S9(3) COMP OCCURS 10. OBNC24.2 +022000 01 FILLER-B. OBNC24.2 +022100 03 PFM-F4-25-B PIC S9(3) COMP OCCURS 10. OBNC24.2 +022200 01 FILLER-C. OBNC24.2 +022300 03 PFM-F4-25-C PIC S9(3) COMP OCCURS 10. OBNC24.2 +022400 01 RECEIVING-TABLE. OBNC24.2 +022500 03 TBL-ELEMEN-A. OBNC24.2 +022600 05 TBL-ELEMEN-B PICTURE X(18). OBNC24.2 +022700 05 TBL-ELEMEN-C PICTURE X(18). OBNC24.2 +022800 03 TBL-ELEMEN-D. OBNC24.2 +022900 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. OBNC24.2 +023000 01 LITERAL-SPLITTER. OBNC24.2 +023100 02 PART1 PICTURE X(20). OBNC24.2 +023200 02 PART2 PICTURE X(20). OBNC24.2 +023300 02 PART3 PICTURE X(20). OBNC24.2 +023400 02 PART4 PICTURE X(20). OBNC24.2 +023500 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. OBNC24.2 +023600 02 80PARTS PICTURE X OCCURS 80 TIMES. OBNC24.2 +023700 01 GRP-FOR-88-LEVELS. OBNC24.2 +023800 03 WRK-DS-02V00-COND PICTURE 99. OBNC24.2 +023900 88 COND-1 VALUE IS 01 THRU 05. OBNC24.2 +024000 88 COND-2 VALUES ARE 06 THRU 10 OBNC24.2 +024100 16 THRU 20 00. OBNC24.2 +024200 88 COND-3 VALUES 11 THRU 15. OBNC24.2 +024300 01 GRP-MOVE-CONSTANTS. OBNC24.2 +024400 03 GRP-GROUP-MOVE-FROM. OBNC24.2 +024500 04 GRP-ALPHABETIC. OBNC24.2 +024600 05 ALPHABET-AN-00026 PICTURE A(26) OBNC24.2 +024700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". OBNC24.2 +024800 04 GRP-NUMERIC. OBNC24.2 +024900 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. OBNC24.2 +025000 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 OBNC24.2 +025100 PICTURE 9(6)V9999. OBNC24.2 +025200 04 GRP-ALPHANUMERIC. OBNC24.2 +025300 05 ALPHANUMERIC-XN-00049 PICTURE X(50) OBNC24.2 +025400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=l,;.()/* 0123456789". OBNC24.2 +025500 05 FILLER PICTURE X VALUE QUOTE. OBNC24.2 +025600 01 GRP-FOR-2N058. OBNC24.2 +025700 02 SUB-GRP-FOR-2N058-A. OBNC24.2 +025800 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. OBNC24.2 +025900 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. OBNC24.2 +026000 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. OBNC24.2 +026100 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". OBNC24.2 +026200 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". OBNC24.2 +026300 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. OBNC24.2 +026400 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. OBNC24.2 +026500 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. OBNC24.2 +026600 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. OBNC24.2 +026700 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. OBNC24.2 +026800 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. OBNC24.2 +026900 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. OBNC24.2 +027000 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. OBNC24.2 +027100 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. OBNC24.2 +027200 02 SUB-GRP-FOR-2N058-B. OBNC24.2 +027300 03 SUB-SUB-BA. OBNC24.2 +027400 04 ELEM-FOR-2N058-A PICTURE 999. OBNC24.2 +027500 04 ELEM-FOR-2N058-B PICTURE XXX. OBNC24.2 +027600 04 ELEM-FOR-2N058-C PICTURE XXX. OBNC24.2 +027700 04 ELEM-FOR-2N058-D PICTURE X(6). OBNC24.2 +027800 03 SUB-SUB-BB. OBNC24.2 +027900 04 ELEM-FOR-2N058-E PICTURE XXX. OBNC24.2 +028000 04 ELEM-FOR-2N058-F PICTURE XXX. OBNC24.2 +028100 04 ELEM-FOR-2N058-G PICTURE XXX. OBNC24.2 +028200 04 ELEM-FOR-2N058-H PICTURE 999. OBNC24.2 +028300 03 SUB-SUB-BC. OBNC24.2 +028400 04 ELEM-FOR-2N058-I PICTURE XXX. OBNC24.2 +028500 04 ELEM-FOR-2N058-J PICTURE XXX. OBNC24.2 +028600 04 ELEM-FOR-2N058-K PICTURE XXX. OBNC24.2 +028700 04 ELEM-FOR-2N058-L PICTURE XXX. OBNC24.2 +028800 04 ELEM-FOR-2N058-M PICTURE XXX. OBNC24.2 +028900 04 ELEM-FOR-2N058-N PICTURE XXX. OBNC24.2 +029000 01 CHARACTER-BREAKDOWN-S. OBNC24.2 +029100 02 FIRST-20S PICTURE X(20). OBNC24.2 +029200 02 SECOND-20S PICTURE X(20). OBNC24.2 +029300 02 THIRD-20S PICTURE X(20). OBNC24.2 +029400 02 FOURTH-20S PICTURE X(20). OBNC24.2 +029500 02 FIFTH-20S PICTURE X(20). OBNC24.2 +029600 02 SIXTH-20S PICTURE X(20). OBNC24.2 +029700 02 SEVENTH-20S PICTURE X(20). OBNC24.2 +029800 02 EIGHTH-20S PICTURE X(20). OBNC24.2 +029900 02 NINTH-20S PICTURE X(20). OBNC24.2 +030000 02 TENTH-20S PICTURE X(20). OBNC24.2 +030100 01 CHARACTER-BREAKDOWN-R. OBNC24.2 +030200 02 FIRST-20R PICTURE X(20). OBNC24.2 +030300 02 SECOND-20R PICTURE X(20). OBNC24.2 +030400 02 THIRD-20R PICTURE X(20). OBNC24.2 +030500 02 FOURTH-20R PICTURE X(20). OBNC24.2 +030600 02 FIFTH-20R PICTURE X(20). OBNC24.2 +030700 02 SIXTH-20R PICTURE X(20). OBNC24.2 +030800 02 SEVENTH-20R PICTURE X(20). OBNC24.2 +030900 02 EIGHTH-20R PICTURE X(20). OBNC24.2 +031000 02 NINTH-20R PICTURE X(20). OBNC24.2 +031100 02 TENTH-20R PICTURE X(20). OBNC24.2 +031200 01 TABLE-80. OBNC24.2 +031300 02 ELMT OCCURS 3 TIMES PIC 9. OBNC24.2 +031400 88 A80 VALUES ARE ZERO THRU 7. OBNC24.2 +031500 88 B80 VALUE 8. OBNC24.2 +031600 88 C80 VALUES ARE 7, 8 THROUGH 9. OBNC24.2 +031700 OBNC24.2 +031800 01 TABLE-86. OBNC24.2 +031900 88 A86 VALUE "ABC". OBNC24.2 +032000 88 B86 VALUE "ABCABC". OBNC24.2 +032100 88 C86 VALUE " ABC". OBNC24.2 +032200 02 DATANAME-86 PIC XXX VALUE "ABC". OBNC24.2 +032300 02 DNAME-86. OBNC24.2 +032400 03 FILLER PIC X VALUE "A". OBNC24.2 +032500 03 FILLER PIC X VALUE "B". OBNC24.2 +032600 03 FILLER PIC X VALUE "C". OBNC24.2 +032700 01 FIGCON-DATA. OBNC24.2 +032800 02 SPACE-X PICTURE X(10) VALUE " ". OBNC24.2 +032900 02 QUOTE-X PICTURE X(5) VALUE QUOTE. OBNC24.2 +033000 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. OBNC24.2 +033100 02 ABC PICTURE XXX VALUE "ABC". OBNC24.2 +033200 02 ONE23 PICTURE 9999 VALUE 123. OBNC24.2 +033300 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. OBNC24.2 +033400 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. OBNC24.2 +033500 01 TEST-RESULTS. OBNC24.2 +033600 02 FILLER PIC X VALUE SPACE. OBNC24.2 +033700 02 FEATURE PIC X(20) VALUE SPACE. OBNC24.2 +033800 02 FILLER PIC X VALUE SPACE. OBNC24.2 +033900 02 P-OR-F PIC X(5) VALUE SPACE. OBNC24.2 +034000 02 FILLER PIC X VALUE SPACE. OBNC24.2 +034100 02 PAR-NAME. OBNC24.2 +034200 03 FILLER PIC X(19) VALUE SPACE. OBNC24.2 +034300 03 PARDOT-X PIC X VALUE SPACE. OBNC24.2 +034400 03 DOTVALUE PIC 99 VALUE ZERO. OBNC24.2 +034500 02 FILLER PIC X(8) VALUE SPACE. OBNC24.2 +034600 02 RE-MARK PIC X(61). OBNC24.2 +034700 01 TEST-COMPUTED. OBNC24.2 +034800 02 FILLER PIC X(30) VALUE SPACE. OBNC24.2 +034900 02 FILLER PIC X(17) VALUE OBNC24.2 +035000 " COMPUTED=". OBNC24.2 +035100 02 COMPUTED-X. OBNC24.2 +035200 03 COMPUTED-A PIC X(20) VALUE SPACE. OBNC24.2 +035300 03 COMPUTED-N REDEFINES COMPUTED-A OBNC24.2 +035400 PIC -9(9).9(9). OBNC24.2 +035500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBNC24.2 +035600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBNC24.2 +035700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBNC24.2 +035800 03 CM-18V0 REDEFINES COMPUTED-A. OBNC24.2 +035900 04 COMPUTED-18V0 PIC -9(18). OBNC24.2 +036000 04 FILLER PIC X. OBNC24.2 +036100 03 FILLER PIC X(50) VALUE SPACE. OBNC24.2 +036200 01 TEST-CORRECT. OBNC24.2 +036300 02 FILLER PIC X(30) VALUE SPACE. OBNC24.2 +036400 02 FILLER PIC X(17) VALUE " CORRECT =". OBNC24.2 +036500 02 CORRECT-X. OBNC24.2 +036600 03 CORRECT-A PIC X(20) VALUE SPACE. OBNC24.2 +036700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBNC24.2 +036800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBNC24.2 +036900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBNC24.2 +037000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBNC24.2 +037100 03 CR-18V0 REDEFINES CORRECT-A. OBNC24.2 +037200 04 CORRECT-18V0 PIC -9(18). OBNC24.2 +037300 04 FILLER PIC X. OBNC24.2 +037400 03 FILLER PIC X(2) VALUE SPACE. OBNC24.2 +037500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBNC24.2 +037600 01 CCVS-C-1. OBNC24.2 +037700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBNC24.2 +037800- "SS PARAGRAPH-NAME OBNC24.2 +037900- " REMARKS". OBNC24.2 +038000 02 FILLER PIC X(20) VALUE SPACE. OBNC24.2 +038100 01 CCVS-C-2. OBNC24.2 +038200 02 FILLER PIC X VALUE SPACE. OBNC24.2 +038300 02 FILLER PIC X(6) VALUE "TESTED". OBNC24.2 +038400 02 FILLER PIC X(15) VALUE SPACE. OBNC24.2 +038500 02 FILLER PIC X(4) VALUE "FAIL". OBNC24.2 +038600 02 FILLER PIC X(94) VALUE SPACE. OBNC24.2 +038700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBNC24.2 +038800 01 REC-CT PIC 99 VALUE ZERO. OBNC24.2 +038900 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039000 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039200 01 PASS-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039300 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBNC24.2 +039400 01 ERROR-HOLD PIC 999 VALUE ZERO. OBNC24.2 +039500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBNC24.2 +039600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBNC24.2 +039700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBNC24.2 +039800 01 CCVS-H-1. OBNC24.2 +039900 02 FILLER PIC X(39) VALUE SPACES. OBNC24.2 +040000 02 FILLER PIC X(42) VALUE OBNC24.2 +040100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBNC24.2 +040200 02 FILLER PIC X(39) VALUE SPACES. OBNC24.2 +040300 01 CCVS-H-2A. OBNC24.2 +040400 02 FILLER PIC X(40) VALUE SPACE. OBNC24.2 +040500 02 FILLER PIC X(7) VALUE "CCVS85 ". OBNC24.2 +040600 02 FILLER PIC XXXX VALUE OBNC24.2 +040700 "4.2 ". OBNC24.2 +040800 02 FILLER PIC X(28) VALUE OBNC24.2 +040900 " COPY - NOT FOR DISTRIBUTION". OBNC24.2 +041000 02 FILLER PIC X(41) VALUE SPACE. OBNC24.2 +041100 OBNC24.2 +041200 01 CCVS-H-2B. OBNC24.2 +041300 02 FILLER PIC X(15) VALUE OBNC24.2 +041400 "TEST RESULT OF ". OBNC24.2 +041500 02 TEST-ID PIC X(9). OBNC24.2 +041600 02 FILLER PIC X(4) VALUE OBNC24.2 +041700 " IN ". OBNC24.2 +041800 02 FILLER PIC X(12) VALUE OBNC24.2 +041900 " HIGH ". OBNC24.2 +042000 02 FILLER PIC X(22) VALUE OBNC24.2 +042100 " LEVEL VALIDATION FOR ". OBNC24.2 +042200 02 FILLER PIC X(58) VALUE OBNC24.2 +042300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +042400 01 CCVS-H-3. OBNC24.2 +042500 02 FILLER PIC X(34) VALUE OBNC24.2 +042600 " FOR OFFICIAL USE ONLY ". OBNC24.2 +042700 02 FILLER PIC X(58) VALUE OBNC24.2 +042800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC24.2 +042900 02 FILLER PIC X(28) VALUE OBNC24.2 +043000 " COPYRIGHT 1985 ". OBNC24.2 +043100 01 CCVS-E-1. OBNC24.2 +043200 02 FILLER PIC X(52) VALUE SPACE. OBNC24.2 +043300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBNC24.2 +043400 02 ID-AGAIN PIC X(9). OBNC24.2 +043500 02 FILLER PIC X(45) VALUE SPACES. OBNC24.2 +043600 01 CCVS-E-2. OBNC24.2 +043700 02 FILLER PIC X(31) VALUE SPACE. OBNC24.2 +043800 02 FILLER PIC X(21) VALUE SPACE. OBNC24.2 +043900 02 CCVS-E-2-2. OBNC24.2 +044000 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBNC24.2 +044100 03 FILLER PIC X VALUE SPACE. OBNC24.2 +044200 03 ENDER-DESC PIC X(44) VALUE OBNC24.2 +044300 "ERRORS ENCOUNTERED". OBNC24.2 +044400 01 CCVS-E-3. OBNC24.2 +044500 02 FILLER PIC X(22) VALUE OBNC24.2 +044600 " FOR OFFICIAL USE ONLY". OBNC24.2 +044700 02 FILLER PIC X(12) VALUE SPACE. OBNC24.2 +044800 02 FILLER PIC X(58) VALUE OBNC24.2 +044900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +045000 02 FILLER PIC X(13) VALUE SPACE. OBNC24.2 +045100 02 FILLER PIC X(15) VALUE OBNC24.2 +045200 " COPYRIGHT 1985". OBNC24.2 +045300 01 CCVS-E-4. OBNC24.2 +045400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBNC24.2 +045500 02 FILLER PIC X(4) VALUE " OF ". OBNC24.2 +045600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBNC24.2 +045700 02 FILLER PIC X(40) VALUE OBNC24.2 +045800 " TESTS WERE EXECUTED SUCCESSFULLY". OBNC24.2 +045900 01 XXINFO. OBNC24.2 +046000 02 FILLER PIC X(19) VALUE OBNC24.2 +046100 "*** INFORMATION ***". OBNC24.2 +046200 02 INFO-TEXT. OBNC24.2 +046300 04 FILLER PIC X(8) VALUE SPACE. OBNC24.2 +046400 04 XXCOMPUTED PIC X(20). OBNC24.2 +046500 04 FILLER PIC X(5) VALUE SPACE. OBNC24.2 +046600 04 XXCORRECT PIC X(20). OBNC24.2 +046700 02 INF-ANSI-REFERENCE PIC X(48). OBNC24.2 +046800 01 HYPHEN-LINE. OBNC24.2 +046900 02 FILLER PIC IS X VALUE IS SPACE. OBNC24.2 +047000 02 FILLER PIC IS X(65) VALUE IS "************************OBNC24.2 +047100- "*****************************************". OBNC24.2 +047200 02 FILLER PIC IS X(54) VALUE IS "************************OBNC24.2 +047300- "******************************". OBNC24.2 +047400 01 CCVS-PGM-ID PIC X(9) VALUE OBNC24.2 +047500 "OBNC2M". OBNC24.2 +047600 PROCEDURE DIVISION. OBNC24.2 +047700 CCVS1 SECTION. OBNC24.2 +047800 OPEN-FILES. OBNC24.2 +047900 OPEN OUTPUT PRINT-FILE. OBNC24.2 +048000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBNC24.2 +048100 MOVE SPACE TO TEST-RESULTS. OBNC24.2 +048200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBNC24.2 +048300 GO TO CCVS1-EXIT. OBNC24.2 +048400 CLOSE-FILES. OBNC24.2 +048500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBNC24.2 +048600 TERMINATE-CCVS. OBNC24.2 +048700S EXIT PROGRAM. OBNC24.2 +048800STERMINATE-CALL. OBNC24.2 +048900 STOP RUN. OBNC24.2 +049000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBNC24.2 +049100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBNC24.2 +049200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBNC24.2 +049300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBNC24.2 +049400 MOVE "****TEST DELETED****" TO RE-MARK. OBNC24.2 +049500 PRINT-DETAIL. OBNC24.2 +049600 IF REC-CT NOT EQUAL TO ZERO OBNC24.2 +049700 MOVE "." TO PARDOT-X OBNC24.2 +049800 MOVE REC-CT TO DOTVALUE. OBNC24.2 +049900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBNC24.2 +050000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBNC24.2 +050100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBNC24.2 +050200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBNC24.2 +050300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBNC24.2 +050400 MOVE SPACE TO CORRECT-X. OBNC24.2 +050500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBNC24.2 +050600 MOVE SPACE TO RE-MARK. OBNC24.2 +050700 HEAD-ROUTINE. OBNC24.2 +050800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +050900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +051000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC24.2 +051100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC24.2 +051200 COLUMN-NAMES-ROUTINE. OBNC24.2 +051300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +051400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +051500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +051600 END-ROUTINE. OBNC24.2 +051700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBNC24.2 +051800 END-RTN-EXIT. OBNC24.2 +051900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +052000 END-ROUTINE-1. OBNC24.2 +052100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBNC24.2 +052200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBNC24.2 +052300 ADD PASS-COUNTER TO ERROR-HOLD. OBNC24.2 +052400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBNC24.2 +052500 MOVE PASS-COUNTER TO CCVS-E-4-1. OBNC24.2 +052600 MOVE ERROR-HOLD TO CCVS-E-4-2. OBNC24.2 +052700 MOVE CCVS-E-4 TO CCVS-E-2-2. OBNC24.2 +052800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBNC24.2 +052900 END-ROUTINE-12. OBNC24.2 +053000 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBNC24.2 +053100 IF ERROR-COUNTER IS EQUAL TO ZERO OBNC24.2 +053200 MOVE "NO " TO ERROR-TOTAL OBNC24.2 +053300 ELSE OBNC24.2 +053400 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBNC24.2 +053500 MOVE CCVS-E-2 TO DUMMY-RECORD. OBNC24.2 +053600 PERFORM WRITE-LINE. OBNC24.2 +053700 END-ROUTINE-13. OBNC24.2 +053800 IF DELETE-COUNTER IS EQUAL TO ZERO OBNC24.2 +053900 MOVE "NO " TO ERROR-TOTAL ELSE OBNC24.2 +054000 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBNC24.2 +054100 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBNC24.2 +054200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054300 IF INSPECT-COUNTER EQUAL TO ZERO OBNC24.2 +054400 MOVE "NO " TO ERROR-TOTAL OBNC24.2 +054500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBNC24.2 +054600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBNC24.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054900 WRITE-LINE. OBNC24.2 +055000 ADD 1 TO RECORD-COUNT. OBNC24.2 +055100Y IF RECORD-COUNT GREATER 50 OBNC24.2 +055200Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBNC24.2 +055300Y MOVE SPACE TO DUMMY-RECORD OBNC24.2 +055400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBNC24.2 +055500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBNC24.2 +055600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC24.2 +055700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBNC24.2 +055800Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBNC24.2 +055900Y MOVE ZERO TO RECORD-COUNT. OBNC24.2 +056000 PERFORM WRT-LN. OBNC24.2 +056100 WRT-LN. OBNC24.2 +056200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBNC24.2 +056300 MOVE SPACE TO DUMMY-RECORD. OBNC24.2 +056400 BLANK-LINE-PRINT. OBNC24.2 +056500 PERFORM WRT-LN. OBNC24.2 +056600 FAIL-ROUTINE. OBNC24.2 +056700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC24.2 +056800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.OBNC24.2 +056900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC24.2 +057000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBNC24.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +057200 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC24.2 +057300 GO TO FAIL-ROUTINE-EX. OBNC24.2 +057400 FAIL-ROUTINE-WRITE. OBNC24.2 +057500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBNC24.2 +057600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBNC24.2 +057700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +057800 MOVE SPACES TO COR-ANSI-REFERENCE. OBNC24.2 +057900 FAIL-ROUTINE-EX. EXIT. OBNC24.2 +058000 BAIL-OUT. OBNC24.2 +058100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBNC24.2 +058200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBNC24.2 +058300 BAIL-OUT-WRITE. OBNC24.2 +058400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBNC24.2 +058500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC24.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC24.2 +058800 BAIL-OUT-EX. EXIT. OBNC24.2 +058900 CCVS1-EXIT. OBNC24.2 +059000 EXIT. OBNC24.2 +059100 SECT-OBNC2M-001 SECTION. OBNC24.2 +059200* OBNC24.2 +059300 GO--TEST-1. OBNC24.2 +059400 ALTER GO--A TO PROCEED TO GO--C. OBNC24.2 +059500* NOTE THE GO STATEMENT IN GO--A IS NOT LEGAL UNLESS IT IS OBNC24.2 +059600* ALTERED AS SHOWN ABOVE BEFORE CONTROL PASSES TO IT. OBNC24.2 +059700 GO TO GO--A. OBNC24.2 +059800 GO--DELETE-1. OBNC24.2 +059900 PERFORM DE-LETE. OBNC24.2 +060000 GO TO GO--WRITE-1. OBNC24.2 +060100 GO--A. OBNC24.2 +060200 GO TO. OBNC24.2 +060300 GO--B. OBNC24.2 +060400 PERFORM FAIL. OBNC24.2 +060500 GO TO GO--WRITE-1. OBNC24.2 +060600 GO--C. OBNC24.2 +060700 PERFORM PASS. OBNC24.2 +060800 GO--WRITE-1. OBNC24.2 +060900 PERFORM END-ROUTINE. OBNC24.2 +061000 MOVE "UNFINISHED GO TO" TO FEATURE. OBNC24.2 +061100 MOVE "GO--TEST-1" TO PAR-NAME. OBNC24.2 +061200 PERFORM PRINT-DETAIL. OBNC24.2 +061300 ALTER-TEST-1. OBNC24.2 +061400 ALTER ALTER-A TO PROCEED TO ALTER-C OBNC24.2 +061500 ALTER-D TO PROCEED TO ALTER-F OBNC24.2 +061600 ALTER-F TO PROCEED TO ALTER-H. OBNC24.2 +061700 GO TO ALTER-A. OBNC24.2 +061800 ALTER-DELETE-1. OBNC24.2 +061900 PERFORM DE-LETE. OBNC24.2 +062000 GO TO ALTER-WRITE-1. OBNC24.2 +062100 ALTER-A. OBNC24.2 +062200 GO TO ALTER-B. OBNC24.2 +062300 ALTER-B. OBNC24.2 +062400 ADD 1 TO ALTERCOUNT. OBNC24.2 +062500 GO TO ALTER-FAIL-1. OBNC24.2 +062600 ALTER-C. OBNC24.2 +062700 PERFORM PASS. OBNC24.2 +062800 ALTER-D. OBNC24.2 +062900 GO TO ALTER-E. OBNC24.2 +063000 ALTER-E. OBNC24.2 +063100 ADD 10 TO ALTERCOUNT. OBNC24.2 +063200 GO TO ALTER-FAIL-1. OBNC24.2 +063300 ALTER-F. OBNC24.2 +063400 GO TO ALTER-G. OBNC24.2 +063500 ALTER-G. OBNC24.2 +063600 ADD 100 TO ALTERCOUNT. OBNC24.2 +063700 GO TO ALTER-FAIL-1. OBNC24.2 +063800 ALTER-H. OBNC24.2 +063900 GO TO ALTER-WRITE-1. OBNC24.2 +064000 ALTER-FAIL-1. OBNC24.2 +064100 MOVE ALTERCOUNT TO COMPUTED-N. OBNC24.2 +064200 MOVE ZERO TO CORRECT-N. OBNC24.2 +064300 PERFORM FAIL. OBNC24.2 +064400 ALTER-WRITE-1. OBNC24.2 +064500 PERFORM END-ROUTINE. OBNC24.2 +064600 MOVE "SERIES ALTER" TO FEATURE. OBNC24.2 +064700 MOVE "ALTER-TEST-1" TO PAR-NAME. OBNC24.2 +064800 PERFORM PRINT-DETAIL. OBNC24.2 +064900 ALTER-INIT-B. OBNC24.2 +065000 MOVE "SERIES ALTER" TO FEATURE. OBNC24.2 +065100 ALTER-TEST-2. OBNC24.2 +065200 MOVE ZERO TO SUBSCRIPT-6. OBNC24.2 +065300 MOVE SPACE TO RECEIVING-TABLE. OBNC24.2 +065400 ALTER-TESTT-2. OBNC24.2 +065500 GO TO ALTER-TESTTT-2. OBNC24.2 +065600 ALTER-A-2. OBNC24.2 +065700 GO TO ALTER-C-2. OBNC24.2 +065800 ALTER-B-2. OBNC24.2 +065900 MOVE "M" TO WRK-XN-00001. OBNC24.2 +066000 PERFORM ALTER-G-2. OBNC24.2 +066100 ALTER-C-2. OBNC24.2 +066200 MOVE "N" TO WRK-XN-00001. OBNC24.2 +066300 PERFORM ALTER-G-2. OBNC24.2 +066400 MOVE " " TO WRK-XN-00001. OBNC24.2 +066500 PERFORM ALTER-G-2. OBNC24.2 +066600 ALTER-D-2. OBNC24.2 +066700 GO TO ALTER-F-2. OBNC24.2 +066800 ALTER-E-2. OBNC24.2 +066900 MOVE "O" TO WRK-XN-00001. OBNC24.2 +067000 PERFORM ALTER-G-2. OBNC24.2 +067100 ALTER-F-2. OBNC24.2 +067200 MOVE "P" TO WRK-XN-00001. OBNC24.2 +067300 PERFORM ALTER-G-2. OBNC24.2 +067400 MOVE " " TO WRK-XN-00001. OBNC24.2 +067500 PERFORM ALTER-G-2. OBNC24.2 +067600 ALTER-G-2. OBNC24.2 +067700 ADD 1 TO SUBSCRIPT-6. OBNC24.2 +067800 MOVE WRK-XN-00001 TO TBL-ELEMEN-E (SUBSCRIPT-6). OBNC24.2 +067900 ALTER-TESTTT-2. OBNC24.2 +068000 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068100 ALTER ALTER-A-2 TO PROCEED TO ALTER-B-2 OBNC24.2 +068200 ALTER-TESTT-2 TO PROCEED TO ALTER-TESTT-2 OBNC24.2 +068300 ALTER-D-2 TO PROCEED TO ALTER-E-2. OBNC24.2 +068400 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068500 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068600 MOVE TBL-ELEMEN-D TO TBL-ELEMEN-B. OBNC24.2 +068700 IF TBL-ELEMEN-B EQUAL TO "N P MN OP MN OP " OBNC24.2 +068800 PERFORM PASS GO TO ALTER-WRITE-2. OBNC24.2 +068900 GO TO ALTER-FAIL-2. OBNC24.2 +069000 ALTER-DELETE-2. OBNC24.2 +069100 PERFORM DE-LETE. OBNC24.2 +069200 GO TO ALTER-WRITE-2. OBNC24.2 +069300 ALTER-FAIL-2. OBNC24.2 +069400 MOVE TBL-ELEMEN-B TO COMPUTED-A. OBNC24.2 +069500 MOVE "N P MN OP MN OP " TO CORRECT-A. OBNC24.2 +069600 PERFORM FAIL. OBNC24.2 +069700 ALTER-WRITE-2. OBNC24.2 +069800 MOVE "ALTER-TEST-2" TO PAR-NAME. OBNC24.2 +069900 PERFORM PRINT-DETAIL. OBNC24.2 +070000 ALTER-INIT-3. OBNC24.2 +070100* NOTE THE FOLLOWING TESTS UTILIZE THE ALTER STATEMENT WITH OBNC24.2 +070200* 11 OPERANDS A DELETE IN ALTER-TEST-3 WILL CAUSE THE OBNC24.2 +070300* REST OF THE ALTER TESTS TO BE BYPASSED. OBNC24.2 +070400 ALTER-TEST-3. OBNC24.2 +070500 ALTER TEST-3A TO PROCEED TO TEST-3C TEST-4A TO TEST-4C OBNC24.2 +070600 TEST-5A TO TEST-5B TEST-6A TO TEST-6C TEST-7A TO OBNC24.2 +070700 TEST-7B TEST-8B TO PROCEED TO TEST-8C TEST-9A TO OBNC24.2 +070800 TEST-9C TEST-10A TO TEST-10C TEST-11A TO TEST-11C OBNC24.2 +070900 TEST-12B TO PROCEED TO TEST-12C TEST-13A TO TEST-13B. OBNC24.2 +071000 GO TO TEST-3A. OBNC24.2 +071100 ALTER-DELETE-3. OBNC24.2 +071200 PERFORM DE-LETE. OBNC24.2 +071300 MOVE "ALTER-TEST-3 THRU 13" TO PAR-NAME. OBNC24.2 +071400 PERFORM PRINT-DETAIL. OBNC24.2 +071500 GO TO ALTER-EXIT. OBNC24.2 +071600 TEST-3A. OBNC24.2 +071700 GO TO TEST-3B. OBNC24.2 +071800 TEST-3B. OBNC24.2 +071900 MOVE "TEST-3C " TO CORRECT-A. OBNC24.2 +072000 MOVE "TEST-3B " TO COMPUTED-A. OBNC24.2 +072100 PERFORM FAIL. OBNC24.2 +072200 GO TO ALTER-WRITE-3. OBNC24.2 +072300 TEST-3C. OBNC24.2 +072400 PERFORM PASS. OBNC24.2 +072500 ALTER-WRITE-3. OBNC24.2 +072600 MOVE "ALTER-TEST-3 " TO PAR-NAME. OBNC24.2 +072700 PERFORM PRINT-DETAIL. OBNC24.2 +072800 ALTER-TEST-4. OBNC24.2 +072900 GO TO TEST-4A. OBNC24.2 +073000 TEST-4A. OBNC24.2 +073100 GO TO TEST-4B. OBNC24.2 +073200 TEST-4B. OBNC24.2 +073300 MOVE "TEST-4B " TO COMPUTED-A. OBNC24.2 +073400 MOVE "TEST-4C " TO CORRECT-A. OBNC24.2 +073500 PERFORM FAIL. OBNC24.2 +073600 GO TO ALTER-WRITE-4. OBNC24.2 +073700 TEST-4C. OBNC24.2 +073800 PERFORM PASS. OBNC24.2 +073900 ALTER-WRITE-4. OBNC24.2 +074000 MOVE "ALTER-TEST-4 " TO PAR-NAME. OBNC24.2 +074100 PERFORM PRINT-DETAIL. OBNC24.2 +074200 ALTER-TEST-5. OBNC24.2 +074300 GO TO TEST-5A. OBNC24.2 +074400 TEST-5B. OBNC24.2 +074500 PERFORM PASS OBNC24.2 +074600 GO TO ALTER-WRITE-5. OBNC24.2 +074700 TEST-5A. OBNC24.2 +074800 GO TO TEST-5C. OBNC24.2 +074900 TEST-5C. OBNC24.2 +075000 MOVE "TEST-5C " TO COMPUTED-A. OBNC24.2 +075100 MOVE "TEST-5B " TO CORRECT-A. OBNC24.2 +075200 PERFORM FAIL. OBNC24.2 +075300 ALTER-WRITE-5. OBNC24.2 +075400 MOVE "ALTER-TEST-5 " TO PAR-NAME. OBNC24.2 +075500 PERFORM PRINT-DETAIL. OBNC24.2 +075600 ALTER-TEST-6. OBNC24.2 +075700 GO TO TEST-6A. OBNC24.2 +075800 TEST-6B. OBNC24.2 +075900 MOVE "TEST-6B " TO COMPUTED-A. OBNC24.2 +076000 MOVE "TEST-6C " TO CORRECT-A. OBNC24.2 +076100 PERFORM FAIL. OBNC24.2 +076200 GO TO ALTER-WRITE-6. OBNC24.2 +076300 TEST-6A. OBNC24.2 +076400 GO TO TEST-6B. OBNC24.2 +076500 TEST-6C. OBNC24.2 +076600 PERFORM PASS. OBNC24.2 +076700 ALTER-WRITE-6. OBNC24.2 +076800 MOVE "ALTER-TEST-6 " TO PAR-NAME. OBNC24.2 +076900 PERFORM PRINT-DETAIL. OBNC24.2 +077000 ALTER-TEST-7. OBNC24.2 +077100 GO TO TEST-7A. OBNC24.2 +077200 TEST-7B. OBNC24.2 +077300 PERFORM PASS. OBNC24.2 +077400 GO TO ALTER-WRITE-7. OBNC24.2 +077500 TEST-7A. OBNC24.2 +077600 GO TO TEST-7C. OBNC24.2 +077700 TEST-7C. OBNC24.2 +077800 MOVE "TEST-7C " TO COMPUTED-A. OBNC24.2 +077900 MOVE "TEST-7B " TO CORRECT-A. OBNC24.2 +078000 PERFORM FAIL. OBNC24.2 +078100 ALTER-WRITE-7. OBNC24.2 +078200 MOVE "ALTER-TEST-7 " TO PAR-NAME. OBNC24.2 +078300 PERFORM PRINT-DETAIL. OBNC24.2 +078400 ALTER-TEST-8. OBNC24.2 +078500 GO TO TEST-8B. OBNC24.2 +078600 TEST-8B. OBNC24.2 +078700 GO TO TEST-8A. OBNC24.2 +078800 TEST-8C. OBNC24.2 +078900 PERFORM PASS. OBNC24.2 +079000 GO TO ALTER-WRITE-8. OBNC24.2 +079100 TEST-8A. OBNC24.2 +079200 MOVE "TEST-8A " TO COMPUTED-A. OBNC24.2 +079300 MOVE "TEST-8C " TO CORRECT-A. OBNC24.2 +079400 PERFORM FAIL. OBNC24.2 +079500 ALTER-WRITE-8. OBNC24.2 +079600 MOVE "ALTER-TEST-8 " TO PAR-NAME. OBNC24.2 +079700 PERFORM PRINT-DETAIL. OBNC24.2 +079800 ALTER-TEST-9. OBNC24.2 +079900 GO TO TEST-9A. OBNC24.2 +080000 TEST-9B. OBNC24.2 +080100 MOVE "TEST-9B " TO COMPUTED-A. OBNC24.2 +080200 MOVE "TEST-9C " TO CORRECT-A. OBNC24.2 +080300 PERFORM FAIL. OBNC24.2 +080400 GO TO ALTER-WRITE-9. OBNC24.2 +080500 TEST-9A. OBNC24.2 +080600 GO TO TEST-9B. OBNC24.2 +080700 TEST-9C. OBNC24.2 +080800 PERFORM PASS. OBNC24.2 +080900 ALTER-WRITE-9. OBNC24.2 +081000 MOVE "ALTER-TEST-9 " TO PAR-NAME. OBNC24.2 +081100 PERFORM PRINT-DETAIL. OBNC24.2 +081200 ALTER-TEST-10. OBNC24.2 +081300 GO TO TEST-10A. OBNC24.2 +081400 TEST-10B. OBNC24.2 +081500 MOVE "TEST-10B " TO COMPUTED-A. OBNC24.2 +081600 MOVE "TEST-10C " TO CORRECT-A. OBNC24.2 +081700 PERFORM FAIL. OBNC24.2 +081800 ALTER-WRITE-10. OBNC24.2 +081900 MOVE "ALTER-TEST-10 " TO PAR-NAME. OBNC24.2 +082000 PERFORM PRINT-DETAIL. OBNC24.2 +082100 ALTER-TEST-11. OBNC24.2 +082200 GO TO TEST-11A. OBNC24.2 +082300 TEST-10A. OBNC24.2 +082400 GO TO TEST-10B. OBNC24.2 +082500 TEST-10C. OBNC24.2 +082600 PERFORM PASS. OBNC24.2 +082700 GO TO ALTER-WRITE-10. OBNC24.2 +082800 TEST-11A. OBNC24.2 +082900 GO TO TEST-11B. OBNC24.2 +083000 TEST-11B. OBNC24.2 +083100 MOVE "TEST-11B " TO COMPUTED-A. OBNC24.2 +083200 MOVE "TEST-11C " TO CORRECT-A. OBNC24.2 +083300 PERFORM FAIL. OBNC24.2 +083400 GO TO ALTER-WRITE-11. OBNC24.2 +083500 TEST-11C. OBNC24.2 +083600 PERFORM PASS. OBNC24.2 +083700 ALTER-WRITE-11. OBNC24.2 +083800 MOVE "ALTER-TEST-11 " TO PAR-NAME. OBNC24.2 +083900 PERFORM PRINT-DETAIL. OBNC24.2 +084000 ALTER-TEST-12. OBNC24.2 +084100 GO TO TEST-12B. OBNC24.2 +084200 TEST-12A. OBNC24.2 +084300 MOVE "TEST-12A " TO COMPUTED-A. OBNC24.2 +084400 MOVE "TEST-12C " TO CORRECT-A. OBNC24.2 +084500 PERFORM FAIL. OBNC24.2 +084600 GO TO ALTER-WRITE-12. OBNC24.2 +084700 TEST-12B. OBNC24.2 +084800 GO TO TEST-12A. OBNC24.2 +084900 TEST-12C. OBNC24.2 +085000 PERFORM PASS. OBNC24.2 +085100 ALTER-WRITE-12. OBNC24.2 +085200 MOVE "ALTER-TEST-12 " TO PAR-NAME. OBNC24.2 +085300 PERFORM PRINT-DETAIL. OBNC24.2 +085400 ALTER-TEST-13. OBNC24.2 +085500 GO TO TEST-13A. OBNC24.2 +085600 TEST-13C. OBNC24.2 +085700 MOVE "TEST-13C " TO COMPUTED-A. OBNC24.2 +085800 MOVE "TEST-13B " TO CORRECT-A. OBNC24.2 +085900 PERFORM FAIL. OBNC24.2 +086000 GO TO ALTER-WRITE-13. OBNC24.2 +086100 TEST-13A. OBNC24.2 +086200 GO TO TEST-13C. OBNC24.2 +086300 TEST-13B. OBNC24.2 +086400 PERFORM PASS. OBNC24.2 +086500 ALTER-WRITE-13. OBNC24.2 +086600 MOVE "ALTER-TEST-13 " TO PAR-NAME. OBNC24.2 +086700 PERFORM PRINT-DETAIL. OBNC24.2 +086800 ALTER-EXIT. OBNC24.2 +086900 EXIT. OBNC24.2 +087000 DATE-TEST-1. OBNC24.2 +087100 MOVE "DATE-COMPILED" TO FEATURE, PAR-NAME. OBNC24.2 +087200 MOVE "SEE SOURCE LISTING" TO COMPUTED-A. OBNC24.2 +087300 MOVE "COMMENT SHOULD BE DELETED" TO RE-MARK. OBNC24.2 +087400 PERFORM PRINT-DETAIL. OBNC24.2 +087500 QUAL-SECTION-1 SECTION. OBNC24.2 +087600 PARA-TEST-5. OBNC24.2 +087700 ALTER PARA-5A IN QUAL-SECTION-1 TO PROCEED TO PARA-5C OF OBNC24.2 +087800 QUAL-SECTION-2. OBNC24.2 +087900 PARA-5A. OBNC24.2 +088000 GO TO PARA-5C OF QUAL-SECTION-1. OBNC24.2 +088100 PARA-5B. OBNC24.2 +088200 MOVE "FAIL" TO QT5. OBNC24.2 +088300 GO TO PARA-5D. OBNC24.2 +088400 PARA-5C. OBNC24.2 +088500 MOVE "FAIL" TO QT5. OBNC24.2 +088600 PARA-5D. OBNC24.2 +088700 IF QT5 EQUAL TO "PASS" OBNC24.2 +088800 PERFORM PASS ELSE OBNC24.2 +088900 PERFORM FAIL. OBNC24.2 +089000 MOVE "PARA-TEST-5" TO PAR-NAME. OBNC24.2 +089100 PERFORM PRINT-DETAIL. OBNC24.2 +089200 PARA-5-EXIT. OBNC24.2 +089300 EXIT. OBNC24.2 +089400 PARA-TEST-6. OBNC24.2 +089500 ALTER PARA-6B IN QUAL-SECTION-2 TO PROCEED TO PARA-6C OF OBNC24.2 +089600 QUAL-SECTION-1. OBNC24.2 +089700 PARA-6A. OBNC24.2 +089800 GO TO PARA-6B OF QUAL-SECTION-2. OBNC24.2 +089900 PARA-6B. OBNC24.2 +090000 PERFORM FAIL OBNC24.2 +090100 GO TO PARA-6-EXIT. OBNC24.2 +090200 PARA-6C. OBNC24.2 +090300 PERFORM PASS. OBNC24.2 +090400 GO TO PARA-6-EXIT. OBNC24.2 +090500 PARA-6D. OBNC24.2 +090600 PERFORM FAIL. OBNC24.2 +090700 PARA-6-EXIT. OBNC24.2 +090800 EXIT. OBNC24.2 +090900 PARA-6-LAST. OBNC24.2 +091000 GO TO CCVS-EXIT. OBNC24.2 +091100 PARA-TEST-FINISH. OBNC24.2 +091200 MOVE "PARA-TEST-6" TO PAR-NAME. OBNC24.2 +091300 PERFORM PRINT-DETAIL. OBNC24.2 +091400 QUAL-SECTION-2 SECTION. OBNC24.2 +091500 PARA-5C. OBNC24.2 +091600 MOVE "PASS" TO QT5. OBNC24.2 +091700 GO TO PARA-5D. OBNC24.2 +091800 PARA-6B. OBNC24.2 +091900 GO TO PARA-6D OF QUAL-SECTION-2. OBNC24.2 +092000 PARA-6C. OBNC24.2 +092100 PERFORM FAIL. OBNC24.2 +092200 GO TO PARA-6-EXIT. OBNC24.2 +092300 PARA-6D. OBNC24.2 +092400 GO TO PARA-6D IN QUAL-SECTION-1. OBNC24.2 +092500 QUAL-EXIT. OBNC24.2 +092600 EXIT. OBNC24.2 +092700 CCVS-EXIT SECTION. OBNC24.2 +092800 CCVS-999999. OBNC24.2 +092900 GO TO CLOSE-FILES. OBNC24.2 +*END-OF,OBNC2M TES09870 +*HEADER,COBOL,OBSQ1A +000100 IDENTIFICATION DIVISION. OBSQ14.2 +000200 PROGRAM-ID. OBSQ14.2 +000300 OBSQ1A. OBSQ14.2 +000400**************************************************************** OBSQ14.2 +000500* * OBSQ14.2 +000600* VALIDATION FOR:- * OBSQ14.2 +000700* " HIGH ". OBSQ14.2 +000800* * OBSQ14.2 +000900* CREATION DATE / VALIDATION DATE * OBSQ14.2 +001000* "4.2 ". OBSQ14.2 +001100* * OBSQ14.2 +001200* THE ROUTINE OBSQ1A CREATES A TAPE FILE WHICH HAS FIXED OBSQ14.2 +001300* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN OBSQ14.2 +001400* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSOBSQ14.2 +001500* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSOBSQ14.2 +001600* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED OBSQ14.2 +001700* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED OBSQ14.2 +001800* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. OBSQ14.2 +001900* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR OBSQ14.2 +002000* LEVEL ONE FEATURES. OBSQ14.2 +002100* OBSQ14.2 +002200* THIS ROUTINE TESTS THE OBSOLETE LANGUAGE FEATURE "VALUE OF". OBSQ14.2 +002300* IT IS IDENTICAL WITH THE OLD (74) TEST PROGRAM SQ102. OBSQ14.2 +002400* OBSQ14.2 +002500* USED X-CARDS: OBSQ14.2 +002600* XXXXX001 OBSQ14.2 +002700* XXXXX055 OBSQ14.2 +002800* P XXXXX062 OBSQ14.2 +002900* XXXXX082 OBSQ14.2 +003000* XXXXX083 OBSQ14.2 +003100* C XXXXX084 OBSQ14.2 +003200* OBSQ14.2 +003300* OBSQ14.2 +003400* OBSOLETE FEATURES WHICH ARE TESTED: OBSQ14.2 +003500* OBSQ14.2 +003600* VALUE OF OBSQ14.2 +003700* XXXXX074 OBSQ14.2 +003800* IS OBSQ14.2 +003900* XXXXX075 OBSQ14.2 +004000* XXXXX069 OBSQ14.2 +004100* OBSQ14.2 +004200* DATA RECORDS ARE ... DATA RECORD ... OBSQ14.2 +004300* LABEL RECORDS ARE ... LABEL RECORD ... OBSQ14.2 +004400 ENVIRONMENT DIVISION. OBSQ14.2 +004500 CONFIGURATION SECTION. OBSQ14.2 +004600 SOURCE-COMPUTER. OBSQ14.2 +004700 XXXXX082. OBSQ14.2 +004800 OBJECT-COMPUTER. OBSQ14.2 +004900 XXXXX083. OBSQ14.2 +005000 INPUT-OUTPUT SECTION. OBSQ14.2 +005100 FILE-CONTROL. OBSQ14.2 +005200P SELECT RAW-DATA ASSIGN TO OBSQ14.2 +005300P XXXXX062 OBSQ14.2 +005400P ORGANIZATION IS INDEXED OBSQ14.2 +005500P ACCESS MODE IS RANDOM OBSQ14.2 +005600P RECORD KEY IS RAW-DATA-KEY. OBSQ14.2 +005700 SELECT PRINT-FILE ASSIGN TO OBSQ14.2 +005800 XXXXX055. OBSQ14.2 +005900 SELECT SQ-FS1 ASSIGN TO OBSQ14.2 +006000 XXXXX001 OBSQ14.2 +006100 ORGANIZATION IS SEQUENTIAL OBSQ14.2 +006200 ACCESS MODE IS SEQUENTIAL. OBSQ14.2 +006300 DATA DIVISION. OBSQ14.2 +006400 FILE SECTION. OBSQ14.2 +006500P OBSQ14.2 +006600PFD RAW-DATA OBSQ14.2 +006700P DATA RECORD IS RAW-DATA-SATZ OBSQ14.2 +006800P RECORD CONTAINS 50 CHARACTERS OBSQ14.2 +006900P LABEL RECORDS ARE STANDARD. OBSQ14.2 +007000P OBSQ14.2 +007100P01 RAW-DATA-SATZ. OBSQ14.2 +007200P 05 RAW-DATA-KEY. OBSQ14.2 +007300P 10 C-2 PIC XX. OBSQ14.2 +007400P 10 C-POS3 PIC X. OBSQ14.2 +007500P 10 FILLER PIC XX. OBSQ14.2 +007600P 05 C-DATUM. OBSQ14.2 +007700P 10 C-D-JJ PIC XX. OBSQ14.2 +007800P 10 C-D-MM PIC XX. OBSQ14.2 +007900P 10 C-D-DD PIC XX. OBSQ14.2 +008000P 05 C-DATE REDEFINES C-DATUM PIC 9(6). OBSQ14.2 +008100P 05 C-ZEIT. OBSQ14.2 +008200P 10 C-T-HH PIC XX. OBSQ14.2 +008300P 10 C-T-MM PIC XX. OBSQ14.2 +008400P 10 C-T-SS PIC XX. OBSQ14.2 +008500P 10 C-T-HS PIC XX. OBSQ14.2 +008600P 05 C-TIME REDEFINES C-ZEIT PIC 9(8). OBSQ14.2 +008700P 05 C-NO-OF-TESTS PIC 99. OBSQ14.2 +008800P 05 C-OK PIC 999. OBSQ14.2 +008900P 05 C-ALL PIC 999. OBSQ14.2 +009000P 05 C-FAIL PIC 999. OBSQ14.2 +009100P 05 C-DELETED PIC 999. OBSQ14.2 +009200P 05 C-INSPECT PIC 999. OBSQ14.2 +009300P 05 C-NOTE PIC X(13). OBSQ14.2 +009400P 05 C-INDENT PIC X. OBSQ14.2 +009500 FD PRINT-FILE. OBSQ14.2 +009600 01 PRINT-REC PICTURE X(120). OBSQ14.2 +009700 01 DUMMY-RECORD PICTURE X(120). OBSQ14.2 +009800 FD SQ-FS1 OBSQ14.2 +009900C VALUE OF OBSQ14.2 +010000C XXXXX074 OBSQ14.2 +010100C IS OBSQ14.2 +010200C XXXXX075 OBSQ14.2 +010300G XXXXX069 OBSQ14.2 +010400 DATA RECORD SQ-FS1R1-F-G-120 OBSQ14.2 +010500 LABEL RECORD STANDARD. OBSQ14.2 +010600 01 SQ-FS1R1-F-G-120. OBSQ14.2 +010700 02 FILLER PIC X(120). OBSQ14.2 +010800 WORKING-STORAGE SECTION. OBSQ14.2 +010900 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. OBSQ14.2 +011000 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. OBSQ14.2 +011100 01 ERROR-FLAG PIC 9 VALUE ZERO. OBSQ14.2 +011200 01 EOF-FLAG PICTURE 9 VALUE ZERO. OBSQ14.2 +011300 01 FILE-RECORD-INFORMATION-REC. OBSQ14.2 +011400 03 FILE-RECORD-INFO-SKELETON. OBSQ14.2 +011500 05 FILLER PICTURE X(48) VALUE OBSQ14.2 +011600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ14.2 +011700 05 FILLER PICTURE X(46) VALUE OBSQ14.2 +011800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ14.2 +011900 05 FILLER PICTURE X(26) VALUE OBSQ14.2 +012000 ",LFIL=000000,ORG= ,LBLR= ". OBSQ14.2 +012100 05 FILLER PICTURE X(37) VALUE OBSQ14.2 +012200 ",RECKEY= ". OBSQ14.2 +012300 05 FILLER PICTURE X(38) VALUE OBSQ14.2 +012400 ",ALTKEY1= ". OBSQ14.2 +012500 05 FILLER PICTURE X(38) VALUE OBSQ14.2 +012600 ",ALTKEY2= ". OBSQ14.2 +012700 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ14.2 +012800 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ14.2 +012900 05 FILE-RECORD-INFO-P1-120. OBSQ14.2 +013000 07 FILLER PIC X(5). OBSQ14.2 +013100 07 XFILE-NAME PIC X(6). OBSQ14.2 +013200 07 FILLER PIC X(8). OBSQ14.2 +013300 07 XRECORD-NAME PIC X(6). OBSQ14.2 +013400 07 FILLER PIC X(1). OBSQ14.2 +013500 07 REELUNIT-NUMBER PIC 9(1). OBSQ14.2 +013600 07 FILLER PIC X(7). OBSQ14.2 +013700 07 XRECORD-NUMBER PIC 9(6). OBSQ14.2 +013800 07 FILLER PIC X(6). OBSQ14.2 +013900 07 UPDATE-NUMBER PIC 9(2). OBSQ14.2 +014000 07 FILLER PIC X(5). OBSQ14.2 +014100 07 ODO-NUMBER PIC 9(4). OBSQ14.2 +014200 07 FILLER PIC X(5). OBSQ14.2 +014300 07 XPROGRAM-NAME PIC X(5). OBSQ14.2 +014400 07 FILLER PIC X(7). OBSQ14.2 +014500 07 XRECORD-LENGTH PIC 9(6). OBSQ14.2 +014600 07 FILLER PIC X(7). OBSQ14.2 +014700 07 CHARS-OR-RECORDS PIC X(2). OBSQ14.2 +014800 07 FILLER PIC X(1). OBSQ14.2 +014900 07 XBLOCK-SIZE PIC 9(4). OBSQ14.2 +015000 07 FILLER PIC X(6). OBSQ14.2 +015100 07 RECORDS-IN-FILE PIC 9(6). OBSQ14.2 +015200 07 FILLER PIC X(5). OBSQ14.2 +015300 07 XFILE-ORGANIZATION PIC X(2). OBSQ14.2 +015400 07 FILLER PIC X(6). OBSQ14.2 +015500 07 XLABEL-TYPE PIC X(1). OBSQ14.2 +015600 05 FILE-RECORD-INFO-P121-240. OBSQ14.2 +015700 07 FILLER PIC X(8). OBSQ14.2 +015800 07 XRECORD-KEY PIC X(29). OBSQ14.2 +015900 07 FILLER PIC X(9). OBSQ14.2 +016000 07 ALTERNATE-KEY1 PIC X(29). OBSQ14.2 +016100 07 FILLER PIC X(9). OBSQ14.2 +016200 07 ALTERNATE-KEY2 PIC X(29). OBSQ14.2 +016300 07 FILLER PIC X(7). OBSQ14.2 +016400 01 TEST-RESULTS. OBSQ14.2 +016500 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +016600 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ14.2 +016700 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +016800 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ14.2 +016900 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +017000 02 PAR-NAME. OBSQ14.2 +017100 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ14.2 +017200 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ14.2 +017300 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ14.2 +017400 03 FILLER PIC X(5) VALUE SPACE. OBSQ14.2 +017500 02 FILLER PIC X(10) VALUE SPACE. OBSQ14.2 +017600 02 RE-MARK PIC X(61). OBSQ14.2 +017700 01 TEST-COMPUTED. OBSQ14.2 +017800 02 FILLER PIC X(30) VALUE SPACE. OBSQ14.2 +017900 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ14.2 +018000 02 COMPUTED-X. OBSQ14.2 +018100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ14.2 +018200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ14.2 +018300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ14.2 +018400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ14.2 +018500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ14.2 +018600 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ14.2 +018700 04 COMPUTED-18V0 PICTURE -9(18). OBSQ14.2 +018800 04 FILLER PICTURE X. OBSQ14.2 +018900 03 FILLER PIC X(50) VALUE SPACE. OBSQ14.2 +019000 01 TEST-CORRECT. OBSQ14.2 +019100 02 FILLER PIC X(30) VALUE SPACE. OBSQ14.2 +019200 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ14.2 +019300 02 CORRECT-X. OBSQ14.2 +019400 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ14.2 +019500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ14.2 +019600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ14.2 +019700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ14.2 +019800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ14.2 +019900 03 CR-18V0 REDEFINES CORRECT-A. OBSQ14.2 +020000 04 CORRECT-18V0 PICTURE -9(18). OBSQ14.2 +020100 04 FILLER PICTURE X. OBSQ14.2 +020200 03 FILLER PIC X(50) VALUE SPACE. OBSQ14.2 +020300 01 CCVS-C-1. OBSQ14.2 +020400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ14.2 +020500- "SS PARAGRAPH-NAME OBSQ14.2 +020600- " REMARKS". OBSQ14.2 +020700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ14.2 +020800 01 CCVS-C-2. OBSQ14.2 +020900 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +021000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ14.2 +021100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ14.2 +021200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ14.2 +021300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ14.2 +021400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ14.2 +021500 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ14.2 +021600 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ14.2 +021700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ14.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ14.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ14.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ14.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ14.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ14.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ14.2 +022400 01 CCVS-H-1. OBSQ14.2 +022500 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ14.2 +022600 02 FILLER PICTURE X(67) VALUE OBSQ14.2 +022700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ14.2 +022800- " SYSTEM". OBSQ14.2 +022900 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ14.2 +023000 01 CCVS-H-2. OBSQ14.2 +023100 02 FILLER PICTURE X(52) VALUE IS OBSQ14.2 +023200 "CCVS74 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ14.2 +023300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ14.2 +023400 02 TEST-ID PICTURE IS X(9). OBSQ14.2 +023500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ14.2 +023600 01 CCVS-H-3. OBSQ14.2 +023700 02 FILLER PICTURE X(34) VALUE OBSQ14.2 +023800 " FOR OFFICIAL USE ONLY ". OBSQ14.2 +023900 02 FILLER PICTURE X(58) VALUE OBSQ14.2 +024000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ14.2 +024100 02 FILLER PICTURE X(28) VALUE OBSQ14.2 +024200 " COPYRIGHT 1974 ". OBSQ14.2 +024300 01 CCVS-E-1. OBSQ14.2 +024400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ14.2 +024500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ14.2 +024600 02 ID-AGAIN PICTURE IS X(9). OBSQ14.2 +024700 02 FILLER PICTURE X(45) VALUE IS OBSQ14.2 +024800 " NTIS DISTRIBUTION COBOL 74". OBSQ14.2 +024900 01 CCVS-E-2. OBSQ14.2 +025000 02 FILLER PICTURE X(31) VALUE OBSQ14.2 +025100 SPACE. OBSQ14.2 +025200 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ14.2 +025300 02 CCVS-E-2-2. OBSQ14.2 +025400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ14.2 +025500 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +025600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ14.2 +025700 01 CCVS-E-3. OBSQ14.2 +025800 02 FILLER PICTURE X(22) VALUE OBSQ14.2 +025900 " FOR OFFICIAL USE ONLY". OBSQ14.2 +026000 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ14.2 +026100 02 FILLER PICTURE X(58) VALUE OBSQ14.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ14.2 +026300 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ14.2 +026400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". OBSQ14.2 +026500 01 CCVS-E-4. OBSQ14.2 +026600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ14.2 +026700 02 FILLER PIC XXXX VALUE " OF ". OBSQ14.2 +026800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ14.2 +026900 02 FILLER PIC X(40) VALUE OBSQ14.2 +027000 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ14.2 +027100 01 XXINFO. OBSQ14.2 +027200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ14.2 +027300 02 INFO-TEXT. OBSQ14.2 +027400 04 FILLER PIC X(20) VALUE SPACE. OBSQ14.2 +027500 04 XXCOMPUTED PIC X(20). OBSQ14.2 +027600 04 FILLER PIC X(5) VALUE SPACE. OBSQ14.2 +027700 04 XXCORRECT PIC X(20). OBSQ14.2 +027800 01 HYPHEN-LINE. OBSQ14.2 +027900 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +028000 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ14.2 +028100- "*****************************************". OBSQ14.2 +028200 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ14.2 +028300- "******************************". OBSQ14.2 +028400 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ14.2 +028500 "OBSQ1A". OBSQ14.2 +028600 PROCEDURE DIVISION. OBSQ14.2 +028700 CCVS1 SECTION. OBSQ14.2 +028800 OPEN-FILES. OBSQ14.2 +028900P OPEN I-O RAW-DATA. OBSQ14.2 +029000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ14.2 +029100P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ14.2 +029200P ADD 1 TO C-NO-OF-TESTS. OBSQ14.2 +029300P ACCEPT C-DATE FROM DATE. OBSQ14.2 +029400P ACCEPT C-TIME FROM TIME. OBSQ14.2 +029500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ14.2 +029600PEND-E-1. OBSQ14.2 +029700P CLOSE RAW-DATA. OBSQ14.2 +029800 OPEN OUTPUT PRINT-FILE. OBSQ14.2 +029900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ14.2 +030000 MOVE SPACE TO TEST-RESULTS. OBSQ14.2 +030100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ14.2 +030200 MOVE ZERO TO REC-SKL-SUB. OBSQ14.2 +030300 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ14.2 +030400 CCVS-INIT-FILE. OBSQ14.2 +030500 ADD 1 TO REC-SKL-SUB. OBSQ14.2 +030600 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ14.2 +030700 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ14.2 +030800 CCVS-INIT-EXIT. OBSQ14.2 +030900 GO TO CCVS1-EXIT. OBSQ14.2 +031000 CLOSE-FILES. OBSQ14.2 +031100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ14.2 +031200P OPEN I-O RAW-DATA. OBSQ14.2 +031300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ14.2 +031400P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ14.2 +031500P MOVE PASS-COUNTER TO C-OK. OBSQ14.2 +031600P MOVE ERROR-HOLD TO C-ALL. OBSQ14.2 +031700P MOVE ERROR-COUNTER TO C-FAIL. OBSQ14.2 +031800P MOVE DELETE-CNT TO C-DELETED. OBSQ14.2 +031900P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ14.2 +032000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ14.2 +032100PEND-E-2. OBSQ14.2 +032200P CLOSE RAW-DATA. OBSQ14.2 +032300 TERMINATE-CCVS. OBSQ14.2 +032400S EXIT PROGRAM. OBSQ14.2 +032500STERMINATE-CALL. OBSQ14.2 +032600 STOP RUN. OBSQ14.2 +032700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ14.2 +032800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ14.2 +032900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ14.2 +033000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ14.2 +033100 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ14.2 +033200 PRINT-DETAIL. OBSQ14.2 +033300 IF REC-CT NOT EQUAL TO ZERO OBSQ14.2 +033400 MOVE "." TO PARDOT-X OBSQ14.2 +033500 MOVE REC-CT TO DOTVALUE. OBSQ14.2 +033600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ14.2 +033700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ14.2 +033800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ14.2 +033900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ14.2 +034000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ14.2 +034100 MOVE SPACE TO CORRECT-X. OBSQ14.2 +034200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ14.2 +034300 MOVE SPACE TO RE-MARK. OBSQ14.2 +034400 HEAD-ROUTINE. OBSQ14.2 +034500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +034600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ14.2 +034700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ14.2 +034800 COLUMN-NAMES-ROUTINE. OBSQ14.2 +034900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +035000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +035200 END-ROUTINE. OBSQ14.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ14.2 +035400 END-RTN-EXIT. OBSQ14.2 +035500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +035600 END-ROUTINE-1. OBSQ14.2 +035700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ14.2 +035800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ14.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ14.2 +036000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ14.2 +036100 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ14.2 +036200 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ14.2 +036300 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ14.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ14.2 +036500 END-ROUTINE-12. OBSQ14.2 +036600 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ14.2 +036700 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ14.2 +036800 MOVE "NO " TO ERROR-TOTAL OBSQ14.2 +036900 ELSE OBSQ14.2 +037000 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ14.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ14.2 +037200 PERFORM WRITE-LINE. OBSQ14.2 +037300 END-ROUTINE-13. OBSQ14.2 +037400 IF DELETE-CNT IS EQUAL TO ZERO OBSQ14.2 +037500 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ14.2 +037600 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ14.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ14.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ14.2 +038000 MOVE "NO " TO ERROR-TOTAL OBSQ14.2 +038100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ14.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ14.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +038500 WRITE-LINE. OBSQ14.2 +038600 ADD 1 TO RECORD-COUNT. OBSQ14.2 +038700Y IF RECORD-COUNT GREATER 50 OBSQ14.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ14.2 +038900Y MOVE SPACE TO DUMMY-RECORD OBSQ14.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ14.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ14.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ14.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ14.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ14.2 +039500Y MOVE ZERO TO RECORD-COUNT. OBSQ14.2 +039600 PERFORM WRT-LN. OBSQ14.2 +039700 WRT-LN. OBSQ14.2 +039800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ14.2 +039900 MOVE SPACE TO DUMMY-RECORD. OBSQ14.2 +040000 BLANK-LINE-PRINT. OBSQ14.2 +040100 PERFORM WRT-LN. OBSQ14.2 +040200 FAIL-ROUTINE. OBSQ14.2 +040300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ14.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ14.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ14.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +040700 GO TO FAIL-ROUTINE-EX. OBSQ14.2 +040800 FAIL-ROUTINE-WRITE. OBSQ14.2 +040900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ14.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +041100 FAIL-ROUTINE-EX. EXIT. OBSQ14.2 +041200 BAIL-OUT. OBSQ14.2 +041300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ14.2 +041400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ14.2 +041500 BAIL-OUT-WRITE. OBSQ14.2 +041600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ14.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +041800 BAIL-OUT-EX. EXIT. OBSQ14.2 +041900 CCVS1-EXIT. OBSQ14.2 +042000 EXIT. OBSQ14.2 +042100 SECT-OBSQ1A-0001 SECTION. OBSQ14.2 +042200 SEQ-INIT-001. OBSQ14.2 +042300 MOVE "SQ-FS1" TO XFILE-NAME (1). OBSQ14.2 +042400 MOVE "R1-F-G" TO XRECORD-NAME (1). OBSQ14.2 +042500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). OBSQ14.2 +042600 MOVE 000120 TO XRECORD-LENGTH (1). OBSQ14.2 +042700 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ14.2 +042800 MOVE 0001 TO XBLOCK-SIZE (1). OBSQ14.2 +042900 MOVE 000750 TO RECORDS-IN-FILE (1). OBSQ14.2 +043000 MOVE "SQ" TO XFILE-ORGANIZATION (1). OBSQ14.2 +043100 MOVE "S" TO XLABEL-TYPE (1). OBSQ14.2 +043200 MOVE 000001 TO XRECORD-NUMBER (1). OBSQ14.2 +043300 OPEN OUTPUT SQ-FS1. OBSQ14.2 +043400 SEQ-TEST-001. OBSQ14.2 +043500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. OBSQ14.2 +043600 WRITE SQ-FS1R1-F-G-120. OBSQ14.2 +043700 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ14.2 +043800 GO TO SEQ-WRITE-001. OBSQ14.2 +043900 ADD 1 TO XRECORD-NUMBER (1). OBSQ14.2 +044000 GO TO SEQ-TEST-001. OBSQ14.2 +044100 SEQ-WRITE-001. OBSQ14.2 +044200 MOVE "CREATE FILE SQ-FS1" TO FEATURE. OBSQ14.2 +044300 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ14.2 +044400 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ14.2 +044500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ14.2 +044600 PERFORM PRINT-DETAIL. OBSQ14.2 +044700 CLOSE SQ-FS1. OBSQ14.2 +044800* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS OBSQ14.2 +044900* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. OBSQ14.2 +045000 SEQ-INIT-002. OBSQ14.2 +045100 MOVE ZERO TO WRK-CS-09V00. OBSQ14.2 +045200* THIS TEST READS AND CHECKS THE FILE CREATED IN OBSQ14.2 +045300* SEQ-TEST-001. OBSQ14.2 +045400 OPEN INPUT SQ-FS1. OBSQ14.2 +045500 SEQ-TEST-002. OBSQ14.2 +045600 READ SQ-FS1 OBSQ14.2 +045700 AT END GO TO SEQ-TEST-002-1. OBSQ14.2 +045800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ14.2 +045900 ADD 1 TO WRK-CS-09V00. OBSQ14.2 +046000 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +046100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ14.2 +046200 GO TO SEQ-FAIL-002. OBSQ14.2 +046300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) OBSQ14.2 +046400 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +046500 GO TO SEQ-TEST-002. OBSQ14.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" OBSQ14.2 +046700 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +046800 GO TO SEQ-TEST-002. OBSQ14.2 +046900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" OBSQ14.2 +047000 ADD 1 TO RECORDS-IN-ERROR. OBSQ14.2 +047100 GO TO SEQ-TEST-002. OBSQ14.2 +047200 SEQ-TEST-002-1. OBSQ14.2 +047300 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ14.2 +047400 GO TO SEQ-PASS-002. OBSQ14.2 +047500 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. OBSQ14.2 +047600 SEQ-FAIL-002. OBSQ14.2 +047700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. OBSQ14.2 +047800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ14.2 +047900 PERFORM FAIL. OBSQ14.2 +048000 GO TO SEQ-WRITE-002. OBSQ14.2 +048100 SEQ-PASS-002. OBSQ14.2 +048200 PERFORM PASS. OBSQ14.2 +048300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ14.2 +048400 MOVE WRK-CS-09V00 TO CORRECT-18V0. OBSQ14.2 +048500 SEQ-WRITE-002. OBSQ14.2 +048600 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ14.2 +048700 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. OBSQ14.2 +048800 PERFORM PRINT-DETAIL. OBSQ14.2 +048900 SEQ-CLOSE-002. OBSQ14.2 +049000 CLOSE SQ-FS1. OBSQ14.2 +049100 READ-INIT-01. OBSQ14.2 +049200 MOVE ZERO TO WRK-CS-09V00. OBSQ14.2 +049300 MOVE ZERO TO RECORDS-IN-ERROR. OBSQ14.2 +049400 OPEN INPUT SQ-FS1. OBSQ14.2 +049500* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED OBSQ14.2 +049600* IN THIS SERIES OF TESTS. OBSQ14.2 +049700 MOVE "LEV 1 READ STATEMENT" TO FEATURE. OBSQ14.2 +049800 MOVE "READ...RECORD AT END ..." TO RE-MARK. OBSQ14.2 +049900 MOVE "READ-TEST-01" TO PAR-NAME. OBSQ14.2 +050000 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +050100 READ-TEST-01. OBSQ14.2 +050200 READ SQ-FS1 RECORD AT END OBSQ14.2 +050300 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +050400 MOVE 1 TO EOF-FLAG OBSQ14.2 +050500 GO TO READ-FAIL-01. OBSQ14.2 +050600 PERFORM RECORD-CHECK. OBSQ14.2 +050700 IF WRK-CS-09V00 EQUAL TO 200 OBSQ14.2 +050800 GO TO READ-TEST-01-1. OBSQ14.2 +050900 GO TO READ-TEST-01. OBSQ14.2 +051000 RECORD-CHECK. OBSQ14.2 +051100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ14.2 +051200 ADD 1 TO WRK-CS-09V00. OBSQ14.2 +051300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) OBSQ14.2 +051400 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +051500 MOVE 1 TO ERROR-FLAG. OBSQ14.2 +051600 READ-TEST-01-1. OBSQ14.2 +051700 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +051800 GO TO READ-PASS-01. OBSQ14.2 +051900 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +052000 READ-FAIL-01. OBSQ14.2 +052100 PERFORM FAIL. OBSQ14.2 +052200 GO TO READ-WRITE-01. OBSQ14.2 +052300 READ-PASS-01. OBSQ14.2 +052400 PERFORM PASS. OBSQ14.2 +052500 READ-WRITE-01. OBSQ14.2 +052600 PERFORM PRINT-DETAIL. OBSQ14.2 +052700 READ-INIT-02. OBSQ14.2 +052800 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +052900 GO TO SEQ-EOF-003. OBSQ14.2 +053000 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +053100 MOVE "READ...AT END..." TO RE-MARK. OBSQ14.2 +053200 MOVE "READ-TEST-02" TO PAR-NAME. OBSQ14.2 +053300 READ-TEST-02. OBSQ14.2 +053400 READ SQ-FS1 AT END OBSQ14.2 +053500 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +053600 MOVE 1 TO EOF-FLAG OBSQ14.2 +053700 GO TO READ-FAIL-02. OBSQ14.2 +053800 PERFORM RECORD-CHECK. OBSQ14.2 +053900 IF WRK-CS-09V00 EQUAL TO 400 OBSQ14.2 +054000 GO TO READ-TEST-02-1. OBSQ14.2 +054100 GO TO READ-TEST-02. OBSQ14.2 +054200 READ-TEST-02-1. OBSQ14.2 +054300 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +054400 GO TO READ-PASS-02. OBSQ14.2 +054500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +054600 READ-FAIL-02. OBSQ14.2 +054700 PERFORM FAIL. OBSQ14.2 +054800 GO TO READ-WRITE-02. OBSQ14.2 +054900 READ-PASS-02. OBSQ14.2 +055000 PERFORM PASS. OBSQ14.2 +055100 READ-WRITE-02. OBSQ14.2 +055200 PERFORM PRINT-DETAIL. OBSQ14.2 +055300 READ-INIT-03. OBSQ14.2 +055400 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +055500 GO TO SEQ-EOF-003. OBSQ14.2 +055600 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +055700 MOVE "READ...RECORD END..." TO RE-MARK. OBSQ14.2 +055800 MOVE "READ-TEST-03" TO PAR-NAME. OBSQ14.2 +055900 READ-TEST-03. OBSQ14.2 +056000 READ SQ-FS1 RECORD END OBSQ14.2 +056100 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +056200 MOVE 1 TO EOF-FLAG OBSQ14.2 +056300 GO TO READ-FAIL-03. OBSQ14.2 +056400 PERFORM RECORD-CHECK. OBSQ14.2 +056500 IF WRK-CS-09V00 EQUAL TO 600 OBSQ14.2 +056600 GO TO READ-TEST-03-1. OBSQ14.2 +056700 GO TO READ-TEST-03. OBSQ14.2 +056800 READ-TEST-03-1. OBSQ14.2 +056900 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +057000 GO TO READ-PASS-03. OBSQ14.2 +057100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +057200 READ-FAIL-03. OBSQ14.2 +057300 PERFORM FAIL. OBSQ14.2 +057400 GO TO READ-WRITE-03. OBSQ14.2 +057500 READ-PASS-03. OBSQ14.2 +057600 PERFORM PASS. OBSQ14.2 +057700 READ-WRITE-03. OBSQ14.2 +057800 PERFORM PRINT-DETAIL. OBSQ14.2 +057900 READ-INIT-04. OBSQ14.2 +058000 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +058100 GO TO SEQ-EOF-003. OBSQ14.2 +058200 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +058300 MOVE "READ...END..." TO RE-MARK. OBSQ14.2 +058400 MOVE "READ-TEST-04" TO PAR-NAME. OBSQ14.2 +058500 READ-TEST-04. OBSQ14.2 +058600 READ SQ-FS1 END GO TO READ-TEST-04-1. OBSQ14.2 +058700 PERFORM RECORD-CHECK. OBSQ14.2 +058800 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +058900 GO TO READ-TEST-04-1. OBSQ14.2 +059000 GO TO READ-TEST-04. OBSQ14.2 +059100 READ-TEST-04-1. OBSQ14.2 +059200 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +059300 GO TO READ-PASS-04. OBSQ14.2 +059400 READ-FAIL-04. OBSQ14.2 +059500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +059600 PERFORM FAIL. OBSQ14.2 +059700 GO TO READ-WRITE-04. OBSQ14.2 +059800 READ-PASS-04. OBSQ14.2 +059900 PERFORM PASS. OBSQ14.2 +060000 READ-WRITE-04. OBSQ14.2 +060100 PERFORM PRINT-DETAIL. OBSQ14.2 +060200 SEQ-TEST-003. OBSQ14.2 +060300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO OBSQ14.2 +060400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A OBSQ14.2 +060500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 OBSQ14.2 +060600 GO TO SEQ-FAIL-003. OBSQ14.2 +060700 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +060800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ14.2 +060900 GO TO SEQ-FAIL-003. OBSQ14.2 +061000 SEQ-PASS-003. OBSQ14.2 +061100 PERFORM PASS. OBSQ14.2 +061200 GO TO SEQ-WRITE-003. OBSQ14.2 +061300 SEQ-EOF-003. OBSQ14.2 +061400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. OBSQ14.2 +061500 MOVE "RECORDS READ =" TO COMPUTED-A. OBSQ14.2 +061600 MOVE WRK-CS-09V00 TO CORRECT-18V0. OBSQ14.2 +061700 SEQ-FAIL-003. OBSQ14.2 +061800 PERFORM FAIL. OBSQ14.2 +061900 SEQ-WRITE-003. OBSQ14.2 +062000 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ14.2 +062100 MOVE "READ FILE SQ-FS1" TO FEATURE. OBSQ14.2 +062200 PERFORM PRINT-DETAIL. OBSQ14.2 +062300 SEQ-CLOSE-003. OBSQ14.2 +062400 CLOSE SQ-FS1. OBSQ14.2 +062500 TERMINATE-ROUTINE. OBSQ14.2 +062600 EXIT. OBSQ14.2 +062700 CCVS-EXIT SECTION. OBSQ14.2 +062800 CCVS-999999. OBSQ14.2 +062900 GO TO CLOSE-FILES. OBSQ14.2 +*END-OF,OBSQ1A +*HEADER,COBOL,OBSQ3A +000100 IDENTIFICATION DIVISION. OBSQ34.2 +000200 PROGRAM-ID. OBSQ34.2 +000300 OBSQ3A. OBSQ34.2 +000400**************************************************************** OBSQ34.2 +000500* * OBSQ34.2 +000600* VALIDATION FOR:- * OBSQ34.2 +000700* " HIGH ". OBSQ34.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ34.2 +000900* * OBSQ34.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ34.2 +001100* "4.2 ". OBSQ34.2 +001200* * OBSQ34.2 +001300* THIS ROUTINE TESTS THE USE OF MULTIPLE FILE CLAUSE OBSQ34.2 +001400* OF THE I-O-CONTROL PARAGRAPH. TWO TAPES ARE CREATED OBSQ34.2 +001500* CONTAINING 4 FILES EACH. TAPE ONE IS CREATED WITHOUT THE OBSQ34.2 +001600* USE OF THE NO REWIND OPTION WITH THE OPEN AND CLOSE OBSQ34.2 +001700* STATEMENTS. IT IS THEN PASSED ON TO OBSQ4A AND OBSQ5A WHERE ITOBSQ34.2 +001800* IS READ AND VALIDATED. TAPE TWO IS CREATED USING THE OBSQ34.2 +001900* POSITION PHRASE OF THE MULTIPLE FILE CLAUSE AND WITH THE USE OBSQ34.2 +002000* OF THE NO REWIND OPTION WITH THE OPEN AND CLOSE STATEMENT. OBSQ34.2 +002100* TAPE TWO IS THEN PASSED ON TO OBSQ5A WHERE IT IS READ AND OBSQ34.2 +002200* VALIDATED. OBSQ34.2 +002300 ENVIRONMENT DIVISION. OBSQ34.2 +002400 CONFIGURATION SECTION. OBSQ34.2 +002500 SOURCE-COMPUTER. OBSQ34.2 +002600 XXXXX082. OBSQ34.2 +002700 OBJECT-COMPUTER. OBSQ34.2 +002800 XXXXX083. OBSQ34.2 +002900 INPUT-OUTPUT SECTION. OBSQ34.2 +003000 FILE-CONTROL. OBSQ34.2 +003100P SELECT RAW-DATA ASSIGN TO OBSQ34.2 +003200P XXXXX062 OBSQ34.2 +003300P ORGANIZATION IS INDEXED OBSQ34.2 +003400P ACCESS MODE IS RANDOM OBSQ34.2 +003500P RECORD KEY IS RAW-DATA-KEY. OBSQ34.2 +003600 SELECT PRINT-FILE ASSIGN TO OBSQ34.2 +003700 XXXXX055. OBSQ34.2 +003800 SELECT SQ-FS1 ASSIGN TO OBSQ34.2 +003900 XXXXP004 OBSQ34.2 +004000 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +004100 SELECT SQ-FS2 ASSIGN TO OBSQ34.2 +004200 XXXXP008 OBSQ34.2 +004300 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +004400 SELECT SQ-FS3 ASSIGN OBSQ34.2 +004500 XXXXP009 OBSQ34.2 +004600 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +004700 SELECT SQ-FS4 ASSIGN OBSQ34.2 +004800 XXXXP010 OBSQ34.2 +004900 ACCESS MODE SEQUENTIAL. OBSQ34.2 +005000 SELECT SQ-FS5 ASSIGN OBSQ34.2 +005100 XXXXP005. OBSQ34.2 +005200 SELECT SQ-FS6 ASSIGN OBSQ34.2 +005300 XXXXP011 OBSQ34.2 +005400 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +005500 SELECT SQ-FS7 ASSIGN TO OBSQ34.2 +005600 XXXXP012 OBSQ34.2 +005700 ORGANIZATION IS SEQUENTIAL OBSQ34.2 +005800 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +005900 SELECT SQ-FS8 ASSIGN TO OBSQ34.2 +006000 XXXXP013 OBSQ34.2 +006100 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +006200 I-O-CONTROL. OBSQ34.2 +006300 MULTIPLE FILE TAPE CONTAINS SQ-FS1, OBSQ34.2 +006400 SQ-FS2, OBSQ34.2 +006500 SQ-FS3, OBSQ34.2 +006600 SQ-FS4; OBSQ34.2 +006700 MULTIPLE FILE TAPE SQ-FS8 POSITION 4, OBSQ34.2 +006800 SQ-FS7 POSITION 3, OBSQ34.2 +006900 SQ-FS6 POSITION 2, OBSQ34.2 +007000 SQ-FS5 POSITION 1. OBSQ34.2 +007100 DATA DIVISION. OBSQ34.2 +007200 FILE SECTION. OBSQ34.2 +007300P OBSQ34.2 +007400PFD RAW-DATA. OBSQ34.2 +007500P OBSQ34.2 +007600P01 RAW-DATA-SATZ. OBSQ34.2 +007700P 05 RAW-DATA-KEY PIC X(6). OBSQ34.2 +007800P 05 C-DATE PIC 9(6). OBSQ34.2 +007900P 05 C-TIME PIC 9(8). OBSQ34.2 +008000P 05 C-NO-OF-TESTS PIC 99. OBSQ34.2 +008100P 05 C-OK PIC 999. OBSQ34.2 +008200P 05 C-ALL PIC 999. OBSQ34.2 +008300P 05 C-FAIL PIC 999. OBSQ34.2 +008400P 05 C-DELETED PIC 999. OBSQ34.2 +008500P 05 C-INSPECT PIC 999. OBSQ34.2 +008600P 05 C-NOTE PIC X(13). OBSQ34.2 +008700P 05 C-INDENT PIC X. OBSQ34.2 +008800P 05 C-ABORT PIC X(8). OBSQ34.2 +008900 FD PRINT-FILE. OBSQ34.2 +009000 01 PRINT-REC PICTURE X(120). OBSQ34.2 +009100 01 DUMMY-RECORD PICTURE X(120). OBSQ34.2 +009200 FD SQ-FS1 OBSQ34.2 +009300 LABEL RECORD IS STANDARD OBSQ34.2 +009400 . OBSQ34.2 +009500 01 SQ-FS1R1-F-G-120 PIC X(120). OBSQ34.2 +009600 FD SQ-FS2 OBSQ34.2 +009700 LABEL RECORD STANDARD OBSQ34.2 +009800 BLOCK CONTAINS 5 RECORDS. OBSQ34.2 +009900 01 SQ-FS2R1-F-G-120 PIC X(120). OBSQ34.2 +010000 FD SQ-FS3 OBSQ34.2 +010100 LABEL RECORD STANDARD OBSQ34.2 +010200 BLOCK CONTAINS 1200 CHARACTERS OBSQ34.2 +010300 RECORD CONTAINS 120 CHARACTERS. OBSQ34.2 +010400 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ34.2 +010500 FD SQ-FS4 OBSQ34.2 +010600 LABEL RECORDS STANDARD OBSQ34.2 +010700 BLOCK 10 RECORDS OBSQ34.2 +010800 RECORD 120 CHARACTERS. OBSQ34.2 +010900 01 SQ-FS4R1-F-G-120 PIC X(120). OBSQ34.2 +011000 FD SQ-FS5 OBSQ34.2 +011100 LABEL RECORDS ARE STANDARD OBSQ34.2 +011200 BLOCK CONTAINS 5 RECORDS. OBSQ34.2 +011300 01 SQ-FS5R1-F-G-120 PIC X(120). OBSQ34.2 +011400 FD SQ-FS6 OBSQ34.2 +011500 LABEL RECORD IS STANDARD OBSQ34.2 +011600 BLOCK CONTAINS 10 RECORDS. OBSQ34.2 +011700 01 SQ-FS6R1-F-G-120 PIC X(120). OBSQ34.2 +011800 FD SQ-FS7 OBSQ34.2 +011900 LABEL RECORD STANDARD OBSQ34.2 +012000 BLOCK CONTAINS 2400 CHARACTERS. OBSQ34.2 +012100 01 SQ-FS7R1-F-G-120 PIC X(120). OBSQ34.2 +012200 FD SQ-FS8 OBSQ34.2 +012300 LABEL RECORDS ARE STANDARD OBSQ34.2 +012400 BLOCK 120 CHARACTERS OBSQ34.2 +012500 RECORD 120. OBSQ34.2 +012600 01 SQ-FS8R1-F-G-120 PIC X(120). OBSQ34.2 +012700 WORKING-STORAGE SECTION. OBSQ34.2 +012800 01 COUNT-OF-RECS PIC 9999. OBSQ34.2 +012900 01 FILE-RECORD-INFORMATION-REC. OBSQ34.2 +013000 03 FILE-RECORD-INFO-SKELETON. OBSQ34.2 +013100 05 FILLER PICTURE X(48) VALUE OBSQ34.2 +013200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ34.2 +013300 05 FILLER PICTURE X(46) VALUE OBSQ34.2 +013400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ34.2 +013500 05 FILLER PICTURE X(26) VALUE OBSQ34.2 +013600 ",LFIL=000000,ORG= ,LBLR= ". OBSQ34.2 +013700 05 FILLER PICTURE X(37) VALUE OBSQ34.2 +013800 ",RECKEY= ". OBSQ34.2 +013900 05 FILLER PICTURE X(38) VALUE OBSQ34.2 +014000 ",ALTKEY1= ". OBSQ34.2 +014100 05 FILLER PICTURE X(38) VALUE OBSQ34.2 +014200 ",ALTKEY2= ". OBSQ34.2 +014300 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ34.2 +014400 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ34.2 +014500 05 FILE-RECORD-INFO-P1-120. OBSQ34.2 +014600 07 FILLER PIC X(5). OBSQ34.2 +014700 07 XFILE-NAME PIC X(6). OBSQ34.2 +014800 07 FILLER PIC X(8). OBSQ34.2 +014900 07 XRECORD-NAME PIC X(6). OBSQ34.2 +015000 07 FILLER PIC X(1). OBSQ34.2 +015100 07 REELUNIT-NUMBER PIC 9(1). OBSQ34.2 +015200 07 FILLER PIC X(7). OBSQ34.2 +015300 07 XRECORD-NUMBER PIC 9(6). OBSQ34.2 +015400 07 FILLER PIC X(6). OBSQ34.2 +015500 07 UPDATE-NUMBER PIC 9(2). OBSQ34.2 +015600 07 FILLER PIC X(5). OBSQ34.2 +015700 07 ODO-NUMBER PIC 9(4). OBSQ34.2 +015800 07 FILLER PIC X(5). OBSQ34.2 +015900 07 XPROGRAM-NAME PIC X(5). OBSQ34.2 +016000 07 FILLER PIC X(7). OBSQ34.2 +016100 07 XRECORD-LENGTH PIC 9(6). OBSQ34.2 +016200 07 FILLER PIC X(7). OBSQ34.2 +016300 07 CHARS-OR-RECORDS PIC X(2). OBSQ34.2 +016400 07 FILLER PIC X(1). OBSQ34.2 +016500 07 XBLOCK-SIZE PIC 9(4). OBSQ34.2 +016600 07 FILLER PIC X(6). OBSQ34.2 +016700 07 RECORDS-IN-FILE PIC 9(6). OBSQ34.2 +016800 07 FILLER PIC X(5). OBSQ34.2 +016900 07 XFILE-ORGANIZATION PIC X(2). OBSQ34.2 +017000 07 FILLER PIC X(6). OBSQ34.2 +017100 07 XLABEL-TYPE PIC X(1). OBSQ34.2 +017200 05 FILE-RECORD-INFO-P121-240. OBSQ34.2 +017300 07 FILLER PIC X(8). OBSQ34.2 +017400 07 XRECORD-KEY PIC X(29). OBSQ34.2 +017500 07 FILLER PIC X(9). OBSQ34.2 +017600 07 ALTERNATE-KEY1 PIC X(29). OBSQ34.2 +017700 07 FILLER PIC X(9). OBSQ34.2 +017800 07 ALTERNATE-KEY2 PIC X(29). OBSQ34.2 +017900 07 FILLER PIC X(7). OBSQ34.2 +018000 01 TEST-RESULTS. OBSQ34.2 +018100 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018200 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ34.2 +018300 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018400 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ34.2 +018500 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018600 02 PAR-NAME. OBSQ34.2 +018700 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ34.2 +018800 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ34.2 +018900 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ34.2 +019000 03 FILLER PIC X(5) VALUE SPACE. OBSQ34.2 +019100 02 FILLER PIC X(10) VALUE SPACE. OBSQ34.2 +019200 02 RE-MARK PIC X(61). OBSQ34.2 +019300 01 TEST-COMPUTED. OBSQ34.2 +019400 02 FILLER PIC X(30) VALUE SPACE. OBSQ34.2 +019500 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ34.2 +019600 02 COMPUTED-X. OBSQ34.2 +019700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ34.2 +019800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ34.2 +019900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ34.2 +020000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ34.2 +020100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ34.2 +020200 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ34.2 +020300 04 COMPUTED-18V0 PICTURE -9(18). OBSQ34.2 +020400 04 FILLER PICTURE X. OBSQ34.2 +020500 03 FILLER PIC X(50) VALUE SPACE. OBSQ34.2 +020600 01 TEST-CORRECT. OBSQ34.2 +020700 02 FILLER PIC X(30) VALUE SPACE. OBSQ34.2 +020800 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ34.2 +020900 02 CORRECT-X. OBSQ34.2 +021000 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ34.2 +021100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ34.2 +021200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ34.2 +021300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ34.2 +021400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ34.2 +021500 03 CR-18V0 REDEFINES CORRECT-A. OBSQ34.2 +021600 04 CORRECT-18V0 PICTURE -9(18). OBSQ34.2 +021700 04 FILLER PICTURE X. OBSQ34.2 +021800 03 FILLER PIC X(50) VALUE SPACE. OBSQ34.2 +021900 01 CCVS-C-1. OBSQ34.2 +022000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ34.2 +022100- "SS PARAGRAPH-NAME OBSQ34.2 +022200- " REMARKS". OBSQ34.2 +022300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ34.2 +022400 01 CCVS-C-2. OBSQ34.2 +022500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +022600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ34.2 +022700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ34.2 +022800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ34.2 +022900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ34.2 +023000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ34.2 +023100 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ34.2 +023200 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ34.2 +023300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ34.2 +023400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ34.2 +023500 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ34.2 +023600 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ34.2 +023700 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ34.2 +023800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ34.2 +023900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ34.2 +024000 01 CCVS-H-1. OBSQ34.2 +024100 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ34.2 +024200 02 FILLER PICTURE X(67) VALUE OBSQ34.2 +024300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ34.2 +024400- " SYSTEM". OBSQ34.2 +024500 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ34.2 +024600 01 CCVS-H-2. OBSQ34.2 +024700 02 FILLER PICTURE X(52) VALUE IS OBSQ34.2 +024800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ34.2 +024900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ34.2 +025000 02 TEST-ID PICTURE IS X(9). OBSQ34.2 +025100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ34.2 +025200 01 CCVS-H-3. OBSQ34.2 +025300 02 FILLER PICTURE X(34) VALUE OBSQ34.2 +025400 " FOR OFFICIAL USE ONLY ". OBSQ34.2 +025500 02 FILLER PICTURE X(58) VALUE OBSQ34.2 +025600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ34.2 +025700 02 FILLER PICTURE X(28) VALUE OBSQ34.2 +025800 " COPYRIGHT 1985 ". OBSQ34.2 +025900 01 CCVS-E-1. OBSQ34.2 +026000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ34.2 +026100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ34.2 +026200 02 ID-AGAIN PICTURE IS X(9). OBSQ34.2 +026300 02 FILLER PICTURE X(45) VALUE IS OBSQ34.2 +026400 " NTIS DISTRIBUTION COBOL 85". OBSQ34.2 +026500 01 CCVS-E-2. OBSQ34.2 +026600 02 FILLER PICTURE X(31) VALUE OBSQ34.2 +026700 SPACE. OBSQ34.2 +026800 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ34.2 +026900 02 CCVS-E-2-2. OBSQ34.2 +027000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ34.2 +027100 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +027200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ34.2 +027300 01 CCVS-E-3. OBSQ34.2 +027400 02 FILLER PICTURE X(22) VALUE OBSQ34.2 +027500 " FOR OFFICIAL USE ONLY". OBSQ34.2 +027600 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ34.2 +027700 02 FILLER PICTURE X(58) VALUE OBSQ34.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ34.2 +027900 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ34.2 +028000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ34.2 +028100 01 CCVS-E-4. OBSQ34.2 +028200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ34.2 +028300 02 FILLER PIC XXXX VALUE " OF ". OBSQ34.2 +028400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ34.2 +028500 02 FILLER PIC X(40) VALUE OBSQ34.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ34.2 +028700 01 XXINFO. OBSQ34.2 +028800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ34.2 +028900 02 INFO-TEXT. OBSQ34.2 +029000 04 FILLER PIC X(20) VALUE SPACE. OBSQ34.2 +029100 04 XXCOMPUTED PIC X(20). OBSQ34.2 +029200 04 FILLER PIC X(5) VALUE SPACE. OBSQ34.2 +029300 04 XXCORRECT PIC X(20). OBSQ34.2 +029400 01 HYPHEN-LINE. OBSQ34.2 +029500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +029600 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ34.2 +029700- "*****************************************". OBSQ34.2 +029800 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ34.2 +029900- "******************************". OBSQ34.2 +030000 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ34.2 +030100 "OBSQ3A". OBSQ34.2 +030200 PROCEDURE DIVISION. OBSQ34.2 +030300 CCVS1 SECTION. OBSQ34.2 +030400 OPEN-FILES. OBSQ34.2 +030500P OPEN I-O RAW-DATA. OBSQ34.2 +030600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ34.2 +030700P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ34.2 +030800P MOVE "ABORTED " TO C-ABORT. OBSQ34.2 +030900P ADD 1 TO C-NO-OF-TESTS. OBSQ34.2 +031000P ACCEPT C-DATE FROM DATE. OBSQ34.2 +031100P ACCEPT C-TIME FROM TIME. OBSQ34.2 +031200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ34.2 +031300PEND-E-1. OBSQ34.2 +031400P CLOSE RAW-DATA. OBSQ34.2 +031500 OPEN OUTPUT PRINT-FILE. OBSQ34.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ34.2 +031700 MOVE SPACE TO TEST-RESULTS. OBSQ34.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ34.2 +031900 MOVE ZERO TO REC-SKL-SUB. OBSQ34.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ34.2 +032100 CCVS-INIT-FILE. OBSQ34.2 +032200 ADD 1 TO REC-SKL-SUB. OBSQ34.2 +032300 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ34.2 +032400 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ34.2 +032500 CCVS-INIT-EXIT. OBSQ34.2 +032600 GO TO CCVS1-EXIT. OBSQ34.2 +032700 CLOSE-FILES. OBSQ34.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ34.2 +032900P OPEN I-O RAW-DATA. OBSQ34.2 +033000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ34.2 +033100P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ34.2 +033200P MOVE "OK. " TO C-ABORT. OBSQ34.2 +033300P MOVE PASS-COUNTER TO C-OK. OBSQ34.2 +033400P MOVE ERROR-HOLD TO C-ALL. OBSQ34.2 +033500P MOVE ERROR-COUNTER TO C-FAIL. OBSQ34.2 +033600P MOVE DELETE-CNT TO C-DELETED. OBSQ34.2 +033700P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ34.2 +033800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ34.2 +033900PEND-E-2. OBSQ34.2 +034000P CLOSE RAW-DATA. OBSQ34.2 +034100 TERMINATE-CCVS. OBSQ34.2 +034200S EXIT PROGRAM. OBSQ34.2 +034300STERMINATE-CALL. OBSQ34.2 +034400 STOP RUN. OBSQ34.2 +034500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ34.2 +034600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ34.2 +034700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ34.2 +034800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ34.2 +034900 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ34.2 +035000 PRINT-DETAIL. OBSQ34.2 +035100 IF REC-CT NOT EQUAL TO ZERO OBSQ34.2 +035200 MOVE "." TO PARDOT-X OBSQ34.2 +035300 MOVE REC-CT TO DOTVALUE. OBSQ34.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ34.2 +035500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ34.2 +035600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ34.2 +035700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ34.2 +035800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ34.2 +035900 MOVE SPACE TO CORRECT-X. OBSQ34.2 +036000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ34.2 +036100 MOVE SPACE TO RE-MARK. OBSQ34.2 +036200 HEAD-ROUTINE. OBSQ34.2 +036300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +036400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ34.2 +036500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ34.2 +036600 COLUMN-NAMES-ROUTINE. OBSQ34.2 +036700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +036800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +036900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +037000 END-ROUTINE. OBSQ34.2 +037100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ34.2 +037200 END-RTN-EXIT. OBSQ34.2 +037300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +037400 END-ROUTINE-1. OBSQ34.2 +037500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ34.2 +037600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ34.2 +037700 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ34.2 +037800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ34.2 +037900 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ34.2 +038000 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ34.2 +038100 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ34.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ34.2 +038300 END-ROUTINE-12. OBSQ34.2 +038400 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ34.2 +038500 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ34.2 +038600 MOVE "NO " TO ERROR-TOTAL OBSQ34.2 +038700 ELSE OBSQ34.2 +038800 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ34.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ34.2 +039000 PERFORM WRITE-LINE. OBSQ34.2 +039100 END-ROUTINE-13. OBSQ34.2 +039200 IF DELETE-CNT IS EQUAL TO ZERO OBSQ34.2 +039300 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ34.2 +039400 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ34.2 +039500 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ34.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +039700 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ34.2 +039800 MOVE "NO " TO ERROR-TOTAL OBSQ34.2 +039900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ34.2 +040000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ34.2 +040100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +040200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +040300 WRITE-LINE. OBSQ34.2 +040400 ADD 1 TO RECORD-COUNT. OBSQ34.2 +040500Y IF RECORD-COUNT GREATER 50 OBSQ34.2 +040600Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ34.2 +040700Y MOVE SPACE TO DUMMY-RECORD OBSQ34.2 +040800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ34.2 +040900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ34.2 +041000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ34.2 +041100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ34.2 +041200Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ34.2 +041300Y MOVE ZERO TO RECORD-COUNT. OBSQ34.2 +041400 PERFORM WRT-LN. OBSQ34.2 +041500 WRT-LN. OBSQ34.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ34.2 +041700 MOVE SPACE TO DUMMY-RECORD. OBSQ34.2 +041800 BLANK-LINE-PRINT. OBSQ34.2 +041900 PERFORM WRT-LN. OBSQ34.2 +042000 FAIL-ROUTINE. OBSQ34.2 +042100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ34.2 +042200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ34.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ34.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +042500 GO TO FAIL-ROUTINE-EX. OBSQ34.2 +042600 FAIL-ROUTINE-WRITE. OBSQ34.2 +042700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ34.2 +042800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +042900 FAIL-ROUTINE-EX. EXIT. OBSQ34.2 +043000 BAIL-OUT. OBSQ34.2 +043100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ34.2 +043200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ34.2 +043300 BAIL-OUT-WRITE. OBSQ34.2 +043400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ34.2 +043500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +043600 BAIL-OUT-EX. EXIT. OBSQ34.2 +043700 CCVS1-EXIT. OBSQ34.2 +043800 EXIT. OBSQ34.2 +043900 SECT-OBSQ3A-0001 SECTION. OBSQ34.2 +044000 SEQ-INIT-001. OBSQ34.2 +044100* THIS TEST CREATES FILE SQ-FS1 AS THE FIRST FILE OBSQ34.2 +044200* ON MULTIPLE FILE TAPE ONE. THIS FILE IS CLOSED OBSQ34.2 +044300* WITH NO REWIND. OBSQ34.2 +044400 PERFORM BUILD-RECORD. OBSQ34.2 +044500 MOVE "SQ-FS1" TO XFILE-NAME (1). OBSQ34.2 +044600 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +044700 MOVE 1 TO XBLOCK-SIZE (1). OBSQ34.2 +044800 OPEN OUTPUT SQ-FS1. OBSQ34.2 +044900 SEQ-TEST-001. OBSQ34.2 +045000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. OBSQ34.2 +045100 WRITE SQ-FS1R1-F-G-120. OBSQ34.2 +045200 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +045300 GO TO SEQ-WRITE-001. OBSQ34.2 +045400 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +045500 GO TO SEQ-TEST-001. OBSQ34.2 +045600 SEQ-WRITE-001. OBSQ34.2 +045700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. OBSQ34.2 +045800 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ34.2 +045900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +046000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +046100 PERFORM PRINT-DETAIL. OBSQ34.2 +046200 SEQ-CLOSE-001. OBSQ34.2 +046300 CLOSE SQ-FS1 WITH NO REWIND. OBSQ34.2 +046400 SEQ-INIT-002. OBSQ34.2 +046500* THIS TEST CREATES FILE SQ-FS2 AS THE SECOND FILE OBSQ34.2 +046600* ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENED OBSQ34.2 +046700* AND CLOSED WITH NO REWIND. OBSQ34.2 +046800 PERFORM BUILD-RECORD. OBSQ34.2 +046900 MOVE "SQ-FS2" TO XFILE-NAME (1). OBSQ34.2 +047000 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +047100 MOVE 5 TO XBLOCK-SIZE (1). OBSQ34.2 +047200 OPEN OUTPUT SQ-FS2 WITH NO REWIND. OBSQ34.2 +047300 SEQ-TEST-002. OBSQ34.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. OBSQ34.2 +047500 WRITE SQ-FS2R1-F-G-120. OBSQ34.2 +047600 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +047700 GO TO SEQ-WRITE-002. OBSQ34.2 +047800 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +047900 GO TO SEQ-TEST-002. OBSQ34.2 +048000 SEQ-WRITE-002. OBSQ34.2 +048100 MOVE "CREATE FILE SQ-FS2" TO FEATURE. OBSQ34.2 +048200 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ34.2 +048300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +048400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +048500 PERFORM PRINT-DETAIL. OBSQ34.2 +048600 SEQ-CLOSE-002. OBSQ34.2 +048700 CLOSE SQ-FS2 WITH NO REWIND. OBSQ34.2 +048800 SEQ-INIT-003. OBSQ34.2 +048900* THIS TEST CREATES FILE SQ-FS3 AS THE THIRD FILE OBSQ34.2 +049000* ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENED OBSQ34.2 +049100* AND CLOSED WITH NO REWIND. OBSQ34.2 +049200 PERFORM BUILD-RECORD. OBSQ34.2 +049300 MOVE "SQ-FS3" TO XFILE-NAME (1). OBSQ34.2 +049400 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +049500 MOVE 1200 TO XBLOCK-SIZE (1). OBSQ34.2 +049600 OPEN OUTPUT SQ-FS3 NO REWIND. OBSQ34.2 +049700 SEQ-TEST-003. OBSQ34.2 +049800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. OBSQ34.2 +049900 WRITE SQ-FS3R1-F-G-120. OBSQ34.2 +050000 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +050100 GO TO SEQ-WRITE-003. OBSQ34.2 +050200 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +050300 GO TO SEQ-TEST-003. OBSQ34.2 +050400 SEQ-WRITE-003. OBSQ34.2 +050500 MOVE "CREATE FILE SQ-FS3" TO FEATURE. OBSQ34.2 +050600 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ34.2 +050700 MOVE "FILE CREATED, RECS=" TO COMPUTED-A. OBSQ34.2 +050800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +050900 PERFORM PRINT-DETAIL. OBSQ34.2 +051000 SEQ-CLOSE-003. OBSQ34.2 +051100 CLOSE SQ-FS3 WITH NO REWIND. OBSQ34.2 +051200 SEQ-INIT-004. OBSQ34.2 +051300* THIS TEST CREATES FILE SQ-FS4 AS THE FOURTH AND LASTOBSQ34.2 +051400* FILE ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENEDOBSQ34.2 +051500* WITH NO REWIND. OBSQ34.2 +051600 PERFORM BUILD-RECORD. OBSQ34.2 +051700 MOVE "SQ-FS4" TO XFILE-NAME (1). OBSQ34.2 +051800 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +051900 MOVE 10 TO XBLOCK-SIZE (1). OBSQ34.2 +052000 OPEN OUTPUT SQ-FS4 WITH NO REWIND. OBSQ34.2 +052100 SEQ-TEST-004. OBSQ34.2 +052200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. OBSQ34.2 +052300 WRITE SQ-FS4R1-F-G-120. OBSQ34.2 +052400 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +052500 GO TO SEQ-WRITE-004. OBSQ34.2 +052600 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +052700 GO TO SEQ-TEST-004. OBSQ34.2 +052800 SEQ-WRITE-004. OBSQ34.2 +052900 MOVE "CREATE FILE SQ-FS4" TO FEATURE. OBSQ34.2 +053000 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ34.2 +053100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +053200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +053300 PERFORM PRINT-DETAIL. OBSQ34.2 +053400 SEQ-CLOSE-004. OBSQ34.2 +053500 CLOSE SQ-FS4. OBSQ34.2 +053600 SEQ-INIT-005. OBSQ34.2 +053700* THIS TEST CREATES FILE SQ-FS5 AS THE FIRST FILE ON OBSQ34.2 +053800* MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +053900* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +054000 PERFORM BUILD-RECORD. OBSQ34.2 +054100 MOVE "SQ-FS5" TO XFILE-NAME (1). OBSQ34.2 +054200 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +054300 MOVE 5 TO XBLOCK-SIZE (1). OBSQ34.2 +054400 OPEN OUTPUT SQ-FS5. OBSQ34.2 +054500 SEQ-TEST-005. OBSQ34.2 +054600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5R1-F-G-120. OBSQ34.2 +054700 WRITE SQ-FS5R1-F-G-120. OBSQ34.2 +054800 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +054900 GO TO SEQ-WRITE-005. OBSQ34.2 +055000 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +055100 GO TO SEQ-TEST-005. OBSQ34.2 +055200 SEQ-WRITE-005. OBSQ34.2 +055300 MOVE "CREATE FILE SQ-FS5" TO FEATURE. OBSQ34.2 +055400 MOVE "SEQ-TEST-005" TO PAR-NAME. OBSQ34.2 +055500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +055600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +055700 PERFORM PRINT-DETAIL. OBSQ34.2 +055800 SEQ-CLOSE-005. OBSQ34.2 +055900 CLOSE SQ-FS5. OBSQ34.2 +056000 SEQ-INIT-006. OBSQ34.2 +056100* THIS TEST CREATES FILE SQ-FS6 AS THE SECOND FILE OBSQ34.2 +056200* ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +056300* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +056400 PERFORM BUILD-RECORD. OBSQ34.2 +056500 MOVE "SQ-FS6" TO XFILE-NAME (1). OBSQ34.2 +056600 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +056700 MOVE 10 TO XBLOCK-SIZE (1). OBSQ34.2 +056800 OPEN OUTPUT SQ-FS6. OBSQ34.2 +056900 SEQ-TEST-006. OBSQ34.2 +057000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS6R1-F-G-120. OBSQ34.2 +057100 WRITE SQ-FS6R1-F-G-120. OBSQ34.2 +057200 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +057300 GO TO SEQ-WRITE-006. OBSQ34.2 +057400 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +057500 GO TO SEQ-TEST-006. OBSQ34.2 +057600 SEQ-WRITE-006. OBSQ34.2 +057700 MOVE "CREATE FILE SQ-FS6" TO FEATURE. OBSQ34.2 +057800 MOVE "SEQ-TEST-006" TO PAR-NAME. OBSQ34.2 +057900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +058000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +058100 PERFORM PRINT-DETAIL. OBSQ34.2 +058200 SEQ-CLOSE-006. OBSQ34.2 +058300 CLOSE SQ-FS6. OBSQ34.2 +058400 SEQ-INIT-007. OBSQ34.2 +058500* THIS TEST CREATES FILE SQ-FS7 AS THE THIRD FILE OBSQ34.2 +058600* ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +058700* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +058800 PERFORM BUILD-RECORD. OBSQ34.2 +058900 MOVE "SQ-FS7" TO XFILE-NAME (1). OBSQ34.2 +059000 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +059100 MOVE 2400 TO XBLOCK-SIZE (1). OBSQ34.2 +059200 OPEN OUTPUT SQ-FS7. OBSQ34.2 +059300 SEQ-TEST-007. OBSQ34.2 +059400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS7R1-F-G-120. OBSQ34.2 +059500 WRITE SQ-FS7R1-F-G-120. OBSQ34.2 +059600 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +059700 GO TO SEQ-WRITE-007. OBSQ34.2 +059800 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +059900 GO TO SEQ-TEST-007. OBSQ34.2 +060000 SEQ-WRITE-007. OBSQ34.2 +060100 MOVE "CREATE FILE SQ-FS7" TO FEATURE. OBSQ34.2 +060200 MOVE "SEQ-TEST-007" TO PAR-NAME. OBSQ34.2 +060300 MOVE "FILE CREATED, RECS-=" TO COMPUTED-A. OBSQ34.2 +060400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +060500 PERFORM PRINT-DETAIL. OBSQ34.2 +060600 SEQ-CLOSE-007. OBSQ34.2 +060700 CLOSE SQ-FS7. OBSQ34.2 +060800 SEQ-INIT-008. OBSQ34.2 +060900* THIS TEST CREATES FILE SQ-FS8 AS THE FOURTH AND LASTOBSQ34.2 +061000* FILE ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASEOBSQ34.2 +061100* IS USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +061200 PERFORM BUILD-RECORD. OBSQ34.2 +061300 MOVE "SQ-FS8" TO XFILE-NAME (1). OBSQ34.2 +061400 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +061500 MOVE 120 TO XBLOCK-SIZE (1). OBSQ34.2 +061600 OPEN OUTPUT SQ-FS8. OBSQ34.2 +061700 SEQ-TEST-008. OBSQ34.2 +061800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS8R1-F-G-120. OBSQ34.2 +061900 WRITE SQ-FS8R1-F-G-120. OBSQ34.2 +062000 IF XRECORD-NUMBER (1) EQUAL 750 OBSQ34.2 +062100 GO TO SEQ-WRITE-008. OBSQ34.2 +062200 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +062300 GO TO SEQ-TEST-008. OBSQ34.2 +062400 SEQ-WRITE-008. OBSQ34.2 +062500 MOVE "CREATE FILE SQ-FS8" TO FEATURE. OBSQ34.2 +062600 MOVE "SEQ-TEST-008" TO PAR-NAME. OBSQ34.2 +062700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +062800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +062900 PERFORM PRINT-DETAIL. OBSQ34.2 +063000 SEQ-CLOSE-008. OBSQ34.2 +063100 CLOSE SQ-FS8. OBSQ34.2 +063200 OBSQ3A-END-ROUTINE. OBSQ34.2 +063300 MOVE "END OF OBSQ3A VALIDATION TESTS" TO PRINT-REC. OBSQ34.2 +063400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ34.2 +063500 TERMINATE-OBSQ3A. OBSQ34.2 +063600 GO TO CCVS-EXIT. OBSQ34.2 +063700 BUILD-RECORD. OBSQ34.2 +063800 MOVE "R1-F-G" TO XRECORD-NAME (1). OBSQ34.2 +063900 MOVE "OBSQ3A" TO XPROGRAM-NAME (1). OBSQ34.2 +064000 MOVE 120 TO XRECORD-LENGTH (1). OBSQ34.2 +064100 MOVE 750 TO RECORDS-IN-FILE (1). OBSQ34.2 +064200 MOVE "SQ" TO XFILE-ORGANIZATION (1). OBSQ34.2 +064300 MOVE "S" TO XLABEL-TYPE (1). OBSQ34.2 +064400 MOVE 1 TO XRECORD-NUMBER (1). OBSQ34.2 +064500 CCVS-EXIT SECTION. OBSQ34.2 +064600 CCVS-999999. OBSQ34.2 +064700 GO TO CLOSE-FILES. OBSQ34.2 +*END-OF,OBSQ3A +*HEADER,COBOL,OBSQ3A,SUBPRG,OBSQ4A +000100 IDENTIFICATION DIVISION. OBSQ44.2 +000200 PROGRAM-ID. OBSQ44.2 +000300 OBSQ4A. OBSQ44.2 +000400**************************************************************** OBSQ44.2 +000500* * OBSQ44.2 +000600* VALIDATION FOR:- * OBSQ44.2 +000700* " HIGH ". OBSQ44.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ44.2 +000900* * OBSQ44.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ44.2 +001100* "4.2 ". OBSQ44.2 +001200* * OBSQ44.2 +001300* THE ROUTINE OBSQ4A READS AND VALIDATES THE MULTIPLE OBSQ44.2 +001400* FILE TAPE CREATED IN OBSQ3A. THE FOUR FILES CONTAINED ON OBSQ44.2 +001500* THIS TAPE ARE SQ-FS1, SQ-FS2, SQ-FS3, AND SQ-FS4. BOTH OBSQ44.2 +001600* MULTIPLE FILE TAPES ONE AND TWO ARE THEN PASSED ON TO OBSQ5A.OBSQ44.2 +001700* OBSQ4A USES A MULTIPLE FILE CLAUSE WITH THE POSITION PHRASE OBSQ44.2 +001800* TO PROCESS TAPE ONE. THIS TAPE WAS CREATED USING OPEN AND OBSQ44.2 +001900* CLOSE STATEMENTS WITH NO REWIND. OBSQ44.2 +002000 ENVIRONMENT DIVISION. OBSQ44.2 +002100 CONFIGURATION SECTION. OBSQ44.2 +002200 SOURCE-COMPUTER. OBSQ44.2 +002300 XXXXX082. OBSQ44.2 +002400 OBJECT-COMPUTER. OBSQ44.2 +002500 XXXXX083. OBSQ44.2 +002600 INPUT-OUTPUT SECTION. OBSQ44.2 +002700 FILE-CONTROL. OBSQ44.2 +002800P SELECT RAW-DATA ASSIGN TO OBSQ44.2 +002900P XXXXX062 OBSQ44.2 +003000P ORGANIZATION IS INDEXED OBSQ44.2 +003100P ACCESS MODE IS RANDOM OBSQ44.2 +003200P RECORD KEY IS RAW-DATA-KEY. OBSQ44.2 +003300 SELECT PRINT-FILE ASSIGN TO OBSQ44.2 +003400 XXXXX055. OBSQ44.2 +003500 SELECT SQ-FS1 ASSIGN TO OBSQ44.2 +003600 XXXXP004. OBSQ44.2 +003700 SELECT SQ-FS2 ASSIGN TO OBSQ44.2 +003800 XXXXP008. OBSQ44.2 +003900 SELECT SQ-FS3 ASSIGN TO OBSQ44.2 +004000 XXXXP009. OBSQ44.2 +004100 SELECT SQ-FS4 ASSIGN TO OBSQ44.2 +004200 XXXXP010. OBSQ44.2 +004300 I-O-CONTROL. OBSQ44.2 +004400 MULTIPLE FILE CONTAINS SQ-FS1 POSITION 1, OBSQ44.2 +004500 SQ-FS4 POSITION 4, OBSQ44.2 +004600 SQ-FS3 POSITION 3, OBSQ44.2 +004700 SQ-FS2 POSITION 2. OBSQ44.2 +004800 DATA DIVISION. OBSQ44.2 +004900 FILE SECTION. OBSQ44.2 +005000P OBSQ44.2 +005100PFD RAW-DATA. OBSQ44.2 +005200P OBSQ44.2 +005300P01 RAW-DATA-SATZ. OBSQ44.2 +005400P 05 RAW-DATA-KEY PIC X(6). OBSQ44.2 +005500P 05 C-DATE PIC 9(6). OBSQ44.2 +005600P 05 C-TIME PIC 9(8). OBSQ44.2 +005700P 05 C-NO-OF-TESTS PIC 99. OBSQ44.2 +005800P 05 C-OK PIC 999. OBSQ44.2 +005900P 05 C-ALL PIC 999. OBSQ44.2 +006000P 05 C-FAIL PIC 999. OBSQ44.2 +006100P 05 C-DELETED PIC 999. OBSQ44.2 +006200P 05 C-INSPECT PIC 999. OBSQ44.2 +006300P 05 C-NOTE PIC X(13). OBSQ44.2 +006400P 05 C-INDENT PIC X. OBSQ44.2 +006500P 05 C-ABORT PIC X(8). OBSQ44.2 +006600 FD PRINT-FILE. OBSQ44.2 +006700 01 PRINT-REC PICTURE X(120). OBSQ44.2 +006800 01 DUMMY-RECORD PICTURE X(120). OBSQ44.2 +006900 FD SQ-FS1 OBSQ44.2 +007000 LABEL RECORD STANDARD OBSQ44.2 +007100 . OBSQ44.2 +007200 01 SQ-FS1R1-F-G-120 PIC X(120). OBSQ44.2 +007300 FD SQ-FS2 OBSQ44.2 +007400 LABEL RECORD STANDARD OBSQ44.2 +007500 BLOCK 5 RECORDS. OBSQ44.2 +007600 01 SQ-FS2R1-F-G-120 PIC X(120). OBSQ44.2 +007700 FD SQ-FS3 OBSQ44.2 +007800 LABEL RECORD STANDARD OBSQ44.2 +007900 RECORD CONTAINS 120 CHARACTERS OBSQ44.2 +008000 BLOCK CONTAINS 1200 CHARACTERS. OBSQ44.2 +008100 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ44.2 +008200 FD SQ-FS4 OBSQ44.2 +008300 LABEL RECORD IS STANDARD OBSQ44.2 +008400 RECORD 120 CHARACTERS OBSQ44.2 +008500 BLOCK CONTAINS 10 RECORDS. OBSQ44.2 +008600 01 SQ-FS4R1-F-G-120 PIC X(120). OBSQ44.2 +008700 WORKING-STORAGE SECTION. OBSQ44.2 +008800 77 RECORDS-COUNT PIC 999 VALUE 0. OBSQ44.2 +008900 77 RECORDS-IN-ERROR PIC 999 VALUE 0. OBSQ44.2 +009000 01 FILE-RECORD-INFORMATION-REC. OBSQ44.2 +009100 03 FILE-RECORD-INFO-SKELETON. OBSQ44.2 +009200 05 FILLER PICTURE X(48) VALUE OBSQ44.2 +009300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ44.2 +009400 05 FILLER PICTURE X(46) VALUE OBSQ44.2 +009500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ44.2 +009600 05 FILLER PICTURE X(26) VALUE OBSQ44.2 +009700 ",LFIL=000000,ORG= ,LBLR= ". OBSQ44.2 +009800 05 FILLER PICTURE X(37) VALUE OBSQ44.2 +009900 ",RECKEY= ". OBSQ44.2 +010000 05 FILLER PICTURE X(38) VALUE OBSQ44.2 +010100 ",ALTKEY1= ". OBSQ44.2 +010200 05 FILLER PICTURE X(38) VALUE OBSQ44.2 +010300 ",ALTKEY2= ". OBSQ44.2 +010400 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ44.2 +010500 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ44.2 +010600 05 FILE-RECORD-INFO-P1-120. OBSQ44.2 +010700 07 FILLER PIC X(5). OBSQ44.2 +010800 07 XFILE-NAME PIC X(6). OBSQ44.2 +010900 07 FILLER PIC X(8). OBSQ44.2 +011000 07 XRECORD-NAME PIC X(6). OBSQ44.2 +011100 07 FILLER PIC X(1). OBSQ44.2 +011200 07 REELUNIT-NUMBER PIC 9(1). OBSQ44.2 +011300 07 FILLER PIC X(7). OBSQ44.2 +011400 07 XRECORD-NUMBER PIC 9(6). OBSQ44.2 +011500 07 FILLER PIC X(6). OBSQ44.2 +011600 07 UPDATE-NUMBER PIC 9(2). OBSQ44.2 +011700 07 FILLER PIC X(5). OBSQ44.2 +011800 07 ODO-NUMBER PIC 9(4). OBSQ44.2 +011900 07 FILLER PIC X(5). OBSQ44.2 +012000 07 XPROGRAM-NAME PIC X(5). OBSQ44.2 +012100 07 FILLER PIC X(7). OBSQ44.2 +012200 07 XRECORD-LENGTH PIC 9(6). OBSQ44.2 +012300 07 FILLER PIC X(7). OBSQ44.2 +012400 07 CHARS-OR-RECORDS PIC X(2). OBSQ44.2 +012500 07 FILLER PIC X(1). OBSQ44.2 +012600 07 XBLOCK-SIZE PIC 9(4). OBSQ44.2 +012700 07 FILLER PIC X(6). OBSQ44.2 +012800 07 RECORDS-IN-FILE PIC 9(6). OBSQ44.2 +012900 07 FILLER PIC X(5). OBSQ44.2 +013000 07 XFILE-ORGANIZATION PIC X(2). OBSQ44.2 +013100 07 FILLER PIC X(6). OBSQ44.2 +013200 07 XLABEL-TYPE PIC X(1). OBSQ44.2 +013300 05 FILE-RECORD-INFO-P121-240. OBSQ44.2 +013400 07 FILLER PIC X(8). OBSQ44.2 +013500 07 XRECORD-KEY PIC X(29). OBSQ44.2 +013600 07 FILLER PIC X(9). OBSQ44.2 +013700 07 ALTERNATE-KEY1 PIC X(29). OBSQ44.2 +013800 07 FILLER PIC X(9). OBSQ44.2 +013900 07 ALTERNATE-KEY2 PIC X(29). OBSQ44.2 +014000 07 FILLER PIC X(7). OBSQ44.2 +014100 01 TEST-RESULTS. OBSQ44.2 +014200 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014300 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ44.2 +014400 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014500 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ44.2 +014600 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014700 02 PAR-NAME. OBSQ44.2 +014800 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ44.2 +014900 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ44.2 +015000 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ44.2 +015100 03 FILLER PIC X(5) VALUE SPACE. OBSQ44.2 +015200 02 FILLER PIC X(10) VALUE SPACE. OBSQ44.2 +015300 02 RE-MARK PIC X(61). OBSQ44.2 +015400 01 TEST-COMPUTED. OBSQ44.2 +015500 02 FILLER PIC X(30) VALUE SPACE. OBSQ44.2 +015600 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ44.2 +015700 02 COMPUTED-X. OBSQ44.2 +015800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ44.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ44.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ44.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ44.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ44.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ44.2 +016400 04 COMPUTED-18V0 PICTURE -9(18). OBSQ44.2 +016500 04 FILLER PICTURE X. OBSQ44.2 +016600 03 FILLER PIC X(50) VALUE SPACE. OBSQ44.2 +016700 01 TEST-CORRECT. OBSQ44.2 +016800 02 FILLER PIC X(30) VALUE SPACE. OBSQ44.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ44.2 +017000 02 CORRECT-X. OBSQ44.2 +017100 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ44.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ44.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ44.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ44.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ44.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. OBSQ44.2 +017700 04 CORRECT-18V0 PICTURE -9(18). OBSQ44.2 +017800 04 FILLER PICTURE X. OBSQ44.2 +017900 03 FILLER PIC X(50) VALUE SPACE. OBSQ44.2 +018000 01 CCVS-C-1. OBSQ44.2 +018100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ44.2 +018200- "SS PARAGRAPH-NAME OBSQ44.2 +018300- " REMARKS". OBSQ44.2 +018400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ44.2 +018500 01 CCVS-C-2. OBSQ44.2 +018600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +018700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ44.2 +018800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ44.2 +018900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ44.2 +019000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ44.2 +019100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ44.2 +019200 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ44.2 +019300 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ44.2 +019400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ44.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ44.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ44.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ44.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ44.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ44.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ44.2 +020100 01 CCVS-H-1. OBSQ44.2 +020200 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ44.2 +020300 02 FILLER PICTURE X(67) VALUE OBSQ44.2 +020400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ44.2 +020500- " SYSTEM". OBSQ44.2 +020600 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ44.2 +020700 01 CCVS-H-2. OBSQ44.2 +020800 02 FILLER PICTURE X(52) VALUE IS OBSQ44.2 +020900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ44.2 +021000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ44.2 +021100 02 TEST-ID PICTURE IS X(9). OBSQ44.2 +021200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ44.2 +021300 01 CCVS-H-3. OBSQ44.2 +021400 02 FILLER PICTURE X(34) VALUE OBSQ44.2 +021500 " FOR OFFICIAL USE ONLY ". OBSQ44.2 +021600 02 FILLER PICTURE X(58) VALUE OBSQ44.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ44.2 +021800 02 FILLER PICTURE X(28) VALUE OBSQ44.2 +021900 " COPYRIGHT 1985 ". OBSQ44.2 +022000 01 CCVS-E-1. OBSQ44.2 +022100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ44.2 +022200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ44.2 +022300 02 ID-AGAIN PICTURE IS X(9). OBSQ44.2 +022400 02 FILLER PICTURE X(45) VALUE IS OBSQ44.2 +022500 " NTIS DISTRIBUTION COBOL 85". OBSQ44.2 +022600 01 CCVS-E-2. OBSQ44.2 +022700 02 FILLER PICTURE X(31) VALUE OBSQ44.2 +022800 SPACE. OBSQ44.2 +022900 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ44.2 +023000 02 CCVS-E-2-2. OBSQ44.2 +023100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ44.2 +023200 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +023300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ44.2 +023400 01 CCVS-E-3. OBSQ44.2 +023500 02 FILLER PICTURE X(22) VALUE OBSQ44.2 +023600 " FOR OFFICIAL USE ONLY". OBSQ44.2 +023700 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ44.2 +023800 02 FILLER PICTURE X(58) VALUE OBSQ44.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ44.2 +024000 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ44.2 +024100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ44.2 +024200 01 CCVS-E-4. OBSQ44.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ44.2 +024400 02 FILLER PIC XXXX VALUE " OF ". OBSQ44.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ44.2 +024600 02 FILLER PIC X(40) VALUE OBSQ44.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ44.2 +024800 01 XXINFO. OBSQ44.2 +024900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ44.2 +025000 02 INFO-TEXT. OBSQ44.2 +025100 04 FILLER PIC X(20) VALUE SPACE. OBSQ44.2 +025200 04 XXCOMPUTED PIC X(20). OBSQ44.2 +025300 04 FILLER PIC X(5) VALUE SPACE. OBSQ44.2 +025400 04 XXCORRECT PIC X(20). OBSQ44.2 +025500 01 HYPHEN-LINE. OBSQ44.2 +025600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +025700 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ44.2 +025800- "*****************************************". OBSQ44.2 +025900 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ44.2 +026000- "******************************". OBSQ44.2 +026100 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ44.2 +026200 "OBSQ4A". OBSQ44.2 +026300 PROCEDURE DIVISION. OBSQ44.2 +026400 CCVS1 SECTION. OBSQ44.2 +026500 OPEN-FILES. OBSQ44.2 +026600P OPEN I-O RAW-DATA. OBSQ44.2 +026700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ44.2 +026800P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ44.2 +026900P MOVE "ABORTED " TO C-ABORT. OBSQ44.2 +027000P ADD 1 TO C-NO-OF-TESTS. OBSQ44.2 +027100P ACCEPT C-DATE FROM DATE. OBSQ44.2 +027200P ACCEPT C-TIME FROM TIME. OBSQ44.2 +027300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ44.2 +027400PEND-E-1. OBSQ44.2 +027500P CLOSE RAW-DATA. OBSQ44.2 +027600 OPEN OUTPUT PRINT-FILE. OBSQ44.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ44.2 +027800 MOVE SPACE TO TEST-RESULTS. OBSQ44.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ44.2 +028000 MOVE ZERO TO REC-SKL-SUB. OBSQ44.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ44.2 +028200 CCVS-INIT-FILE. OBSQ44.2 +028300 ADD 1 TO REC-SKL-SUB. OBSQ44.2 +028400 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ44.2 +028500 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ44.2 +028600 CCVS-INIT-EXIT. OBSQ44.2 +028700 GO TO CCVS1-EXIT. OBSQ44.2 +028800 CLOSE-FILES. OBSQ44.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ44.2 +029000P OPEN I-O RAW-DATA. OBSQ44.2 +029100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ44.2 +029200P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ44.2 +029300P MOVE "OK. " TO C-ABORT. OBSQ44.2 +029400P MOVE PASS-COUNTER TO C-OK. OBSQ44.2 +029500P MOVE ERROR-HOLD TO C-ALL. OBSQ44.2 +029600P MOVE ERROR-COUNTER TO C-FAIL. OBSQ44.2 +029700P MOVE DELETE-CNT TO C-DELETED. OBSQ44.2 +029800P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ44.2 +029900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ44.2 +030000PEND-E-2. OBSQ44.2 +030100P CLOSE RAW-DATA. OBSQ44.2 +030200 TERMINATE-CCVS. OBSQ44.2 +030300S EXIT PROGRAM. OBSQ44.2 +030400STERMINATE-CALL. OBSQ44.2 +030500 STOP RUN. OBSQ44.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ44.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ44.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ44.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ44.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ44.2 +031100 PRINT-DETAIL. OBSQ44.2 +031200 IF REC-CT NOT EQUAL TO ZERO OBSQ44.2 +031300 MOVE "." TO PARDOT-X OBSQ44.2 +031400 MOVE REC-CT TO DOTVALUE. OBSQ44.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ44.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ44.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ44.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ44.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ44.2 +032000 MOVE SPACE TO CORRECT-X. OBSQ44.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ44.2 +032200 MOVE SPACE TO RE-MARK. OBSQ44.2 +032300 HEAD-ROUTINE. OBSQ44.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +032500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ44.2 +032600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ44.2 +032700 COLUMN-NAMES-ROUTINE. OBSQ44.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +033000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +033100 END-ROUTINE. OBSQ44.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ44.2 +033300 END-RTN-EXIT. OBSQ44.2 +033400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +033500 END-ROUTINE-1. OBSQ44.2 +033600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ44.2 +033700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ44.2 +033800 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ44.2 +033900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ44.2 +034000 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ44.2 +034100 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ44.2 +034200 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ44.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ44.2 +034400 END-ROUTINE-12. OBSQ44.2 +034500 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ44.2 +034600 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ44.2 +034700 MOVE "NO " TO ERROR-TOTAL OBSQ44.2 +034800 ELSE OBSQ44.2 +034900 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ44.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ44.2 +035100 PERFORM WRITE-LINE. OBSQ44.2 +035200 END-ROUTINE-13. OBSQ44.2 +035300 IF DELETE-CNT IS EQUAL TO ZERO OBSQ44.2 +035400 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ44.2 +035500 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ44.2 +035600 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ44.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +035800 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ44.2 +035900 MOVE "NO " TO ERROR-TOTAL OBSQ44.2 +036000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ44.2 +036100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ44.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +036300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +036400 WRITE-LINE. OBSQ44.2 +036500 ADD 1 TO RECORD-COUNT. OBSQ44.2 +036600Y IF RECORD-COUNT GREATER 50 OBSQ44.2 +036700Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ44.2 +036800Y MOVE SPACE TO DUMMY-RECORD OBSQ44.2 +036900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ44.2 +037000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ44.2 +037100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ44.2 +037200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ44.2 +037300Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ44.2 +037400Y MOVE ZERO TO RECORD-COUNT. OBSQ44.2 +037500 PERFORM WRT-LN. OBSQ44.2 +037600 WRT-LN. OBSQ44.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ44.2 +037800 MOVE SPACE TO DUMMY-RECORD. OBSQ44.2 +037900 BLANK-LINE-PRINT. OBSQ44.2 +038000 PERFORM WRT-LN. OBSQ44.2 +038100 FAIL-ROUTINE. OBSQ44.2 +038200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ44.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ44.2 +038400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ44.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +038600 GO TO FAIL-ROUTINE-EX. OBSQ44.2 +038700 FAIL-ROUTINE-WRITE. OBSQ44.2 +038800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ44.2 +038900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +039000 FAIL-ROUTINE-EX. EXIT. OBSQ44.2 +039100 BAIL-OUT. OBSQ44.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ44.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ44.2 +039400 BAIL-OUT-WRITE. OBSQ44.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ44.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +039700 BAIL-OUT-EX. EXIT. OBSQ44.2 +039800 CCVS1-EXIT. OBSQ44.2 +039900 EXIT. OBSQ44.2 +040000 SECT-OBSQ4A-0001 SECTION. OBSQ44.2 +040100 SEQ-INIT-001. OBSQ44.2 +040200 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +040300 OPEN INPUT SQ-FS1. OBSQ44.2 +040400 SEQ-TEST-001. OBSQ44.2 +040500 READ SQ-FS1 AT END GO TO SEQ-TEST-001-01. OBSQ44.2 +040600 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +040700 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +040800 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +040900 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +041000 GO TO SEQ-FAIL-001. OBSQ44.2 +041100 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +041200 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041300 GO TO SEQ-TEST-001. OBSQ44.2 +041400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" OBSQ44.2 +041500 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041600 GO TO SEQ-TEST-001. OBSQ44.2 +041700 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +041800 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041900 GO TO SEQ-TEST-001. OBSQ44.2 +042000 IF XBLOCK-SIZE (1) NOT EQUAL TO 1 OBSQ44.2 +042100 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +042200 GO TO SEQ-TEST-001. OBSQ44.2 +042300 SEQ-TEST-001-01. OBSQ44.2 +042400 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +042500 GO TO SEQ-PASS-001. OBSQ44.2 +042600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. OBSQ44.2 +042700 SEQ-FAIL-001. OBSQ44.2 +042800 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +042900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +043000 PERFORM FAIL. OBSQ44.2 +043100 GO TO SEQ-WRITE-001. OBSQ44.2 +043200 SEQ-PASS-001. OBSQ44.2 +043300 PERFORM PASS. OBSQ44.2 +043400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +043500 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +043600 SEQ-WRITE-001. OBSQ44.2 +043700 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ44.2 +043800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. OBSQ44.2 +043900 PERFORM PRINT-DETAIL. OBSQ44.2 +044000 SEQ-CLOSE-001. OBSQ44.2 +044100 CLOSE SQ-FS1. OBSQ44.2 +044200 SEQ-INIT-002. OBSQ44.2 +044300* THIS TEST READS AND VALIDATES FILE SQ-FS3. OBSQ44.2 +044400 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +044500 OPEN INPUT SQ-FS3. OBSQ44.2 +044600 SEQ-TEST-002. OBSQ44.2 +044700 READ SQ-FS3 AT END GO TO SEQ-TEST-002-01. OBSQ44.2 +044800 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +044900 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +045000 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +045100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +045200 GO TO SEQ-FAIL-002. OBSQ44.2 +045300 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +045400 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +045500 GO TO SEQ-TEST-002. OBSQ44.2 +045600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" OBSQ44.2 +045700 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +045800 GO TO SEQ-TEST-002. OBSQ44.2 +045900 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ44.2 +046000 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +046100 GO TO SEQ-TEST-002. OBSQ44.2 +046200 IF XBLOCK-SIZE (1) NOT EQUAL TO 1200 OBSQ44.2 +046300 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +046400 GO TO SEQ-TEST-002. OBSQ44.2 +046500 SEQ-TEST-002-01. OBSQ44.2 +046600 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +046700 GO TO SEQ-PASS-002. OBSQ44.2 +046800 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. OBSQ44.2 +046900 SEQ-FAIL-002. OBSQ44.2 +047000 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +047100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +047200 PERFORM FAIL. OBSQ44.2 +047300 GO TO SEQ-WRITE-002. OBSQ44.2 +047400 SEQ-PASS-002. OBSQ44.2 +047500 PERFORM PASS. OBSQ44.2 +047600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +047700 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +047800 SEQ-WRITE-002. OBSQ44.2 +047900 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ44.2 +048000 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. OBSQ44.2 +048100 PERFORM PRINT-DETAIL. OBSQ44.2 +048200 SEQ-CLOSE-002. OBSQ44.2 +048300 CLOSE SQ-FS3. OBSQ44.2 +048400 SEQ-INIT-003. OBSQ44.2 +048500* THIS TEST READS AND VALIDATES FILE SQ-FS2. OBSQ44.2 +048600 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +048700 OPEN INPUT SQ-FS2. OBSQ44.2 +048800 SEQ-TEST-003. OBSQ44.2 +048900 READ SQ-FS2 AT END GO TO SEQ-TEST-003-01. OBSQ44.2 +049000 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +049100 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +049200 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +049300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +049400 GO TO SEQ-FAIL-003. OBSQ44.2 +049500 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +049600 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +049700 GO TO SEQ-TEST-003. OBSQ44.2 +049800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" OBSQ44.2 +049900 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +050000 GO TO SEQ-TEST-003. OBSQ44.2 +050100 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +050200 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +050300 GO TO SEQ-TEST-003. OBSQ44.2 +050400 IF XBLOCK-SIZE (1) NOT EQUAL TO 5 OBSQ44.2 +050500 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +050600 GO TO SEQ-TEST-003. OBSQ44.2 +050700 SEQ-TEST-003-01. OBSQ44.2 +050800 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +050900 GO TO SEQ-PASS-003. OBSQ44.2 +051000 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. OBSQ44.2 +051100 SEQ-FAIL-003. OBSQ44.2 +051200 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +051300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +051400 PERFORM FAIL. OBSQ44.2 +051500 GO TO SEQ-WRITE-003. OBSQ44.2 +051600 SEQ-PASS-003. OBSQ44.2 +051700 PERFORM PASS. OBSQ44.2 +051800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +051900 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +052000 SEQ-WRITE-003. OBSQ44.2 +052100 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ44.2 +052200 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. OBSQ44.2 +052300 PERFORM PRINT-DETAIL. OBSQ44.2 +052400 SEQ-CLOSE-003. OBSQ44.2 +052500 CLOSE SQ-FS2. OBSQ44.2 +052600 SEQ-INIT-004. OBSQ44.2 +052700* THIS TEST READS AND VALIDATES FILE SQ-FS4. OBSQ44.2 +052800 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +052900 OPEN INPUT SQ-FS4. OBSQ44.2 +053000 SEQ-TEST-004. OBSQ44.2 +053100 READ SQ-FS4 AT END GO TO SEQ-TEST-004-01. OBSQ44.2 +053200 MOVE SQ-FS4R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +053300 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +053400 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +053500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +053600 GO TO SEQ-FAIL-004. OBSQ44.2 +053700 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +053800 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +053900 GO TO SEQ-TEST-004. OBSQ44.2 +054000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS4" OBSQ44.2 +054100 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +054200 GO TO SEQ-TEST-004. OBSQ44.2 +054300 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +054400 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +054500 GO TO SEQ-TEST-004. OBSQ44.2 +054600 IF XBLOCK-SIZE (1) NOT EQUAL TO 10 OBSQ44.2 +054700 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +054800 GO TO SEQ-TEST-004. OBSQ44.2 +054900 SEQ-TEST-004-01. OBSQ44.2 +055000 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +055100 GO TO SEQ-PASS-004. OBSQ44.2 +055200 MOVE "ERRORS IN READING SQ-FS4" TO RE-MARK. OBSQ44.2 +055300 SEQ-FAIL-004. OBSQ44.2 +055400 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +055500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +055600 PERFORM FAIL. OBSQ44.2 +055700 GO TO SEQ-WRITE-004. OBSQ44.2 +055800 SEQ-PASS-004. OBSQ44.2 +055900 PERFORM PASS. OBSQ44.2 +056000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +056100 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +056200 SEQ-WRITE-004. OBSQ44.2 +056300 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ44.2 +056400 MOVE "VERIFY FILE SQ-FS4" TO FEATURE. OBSQ44.2 +056500 PERFORM PRINT-DETAIL. OBSQ44.2 +056600 SEQ-CLOSE-004. OBSQ44.2 +056700 CLOSE SQ-FS4. OBSQ44.2 +056800 OBSQ4A-END-ROUTINE. OBSQ44.2 +056900 MOVE "END OF OBSQ4A VALIDATION TESTS" TO PRINT-REC. OBSQ44.2 +057000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ44.2 +057100 GO TO CCVS-EXIT. OBSQ44.2 +057200 CCVS-EXIT SECTION. OBSQ44.2 +057300 CCVS-999999. OBSQ44.2 +057400 GO TO CLOSE-FILES. OBSQ44.2 +*END-OF,OBSQ4A +*HEADER,COBOL,OBSQ3A,SUBPRG,OBSQ5A +000100 IDENTIFICATION DIVISION. OBSQ54.2 +000200 PROGRAM-ID. OBSQ54.2 +000300 OBSQ5A. OBSQ54.2 +000400**************************************************************** OBSQ54.2 +000500* * OBSQ54.2 +000600* VALIDATION FOR:- * OBSQ54.2 +000700* " HIGH ". OBSQ54.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ54.2 +000900* * OBSQ54.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ54.2 +001100* "4.2 ". OBSQ54.2 +001200* * OBSQ54.2 +001300* THE ROUTINE OBSQ5A TESTS THE USE OF THE MULTIPLE FILE OBSQ54.2 +001400* CLAUSE BY READING AND VALIDATING THE TWO MULTIPLE FILE TAPES OBSQ54.2 +001500* CREATED IN OBSQ3A. TAPE ONE IS PROCESSED USING THE MULTIPLE OBSQ54.2 +001600* FILE CLAUSE WITH POSITION PHRASE. ONLY FILE SQ-FS3 IS OBSQ54.2 +001700* SPECIFIED AND PROCESSED FROM THIS TAPE. TAPE TWO IS OBSQ54.2 +001800* PROCESSED USING THE MULTIPLE FILE CLAUSE WITHOUT THE OBSQ54.2 +001900* POSITION PHRASE. ALL FOUR FILES ON THIS TAPE ARE PROCESSED. OBSQ54.2 +002000* THESE FILES WERE CREATED USING A MULTIPLE FILE CLAUSE WITH OBSQ54.2 +002100* POSITION PHRASE. OBSQ54.2 +002200 ENVIRONMENT DIVISION. OBSQ54.2 +002300 CONFIGURATION SECTION. OBSQ54.2 +002400 SOURCE-COMPUTER. OBSQ54.2 +002500 XXXXX082. OBSQ54.2 +002600 OBJECT-COMPUTER. OBSQ54.2 +002700 XXXXX083. OBSQ54.2 +002800 INPUT-OUTPUT SECTION. OBSQ54.2 +002900 FILE-CONTROL. OBSQ54.2 +003000P SELECT RAW-DATA ASSIGN TO OBSQ54.2 +003100P XXXXX062 OBSQ54.2 +003200P ORGANIZATION IS INDEXED OBSQ54.2 +003300P ACCESS MODE IS RANDOM OBSQ54.2 +003400P RECORD KEY IS RAW-DATA-KEY. OBSQ54.2 +003500 SELECT PRINT-FILE ASSIGN TO OBSQ54.2 +003600 XXXXX055. OBSQ54.2 +003700 SELECT SQ-FS3 ASSIGN TO OBSQ54.2 +003800 XXXXD009. OBSQ54.2 +003900 SELECT SQ-FS5 ASSIGN TO OBSQ54.2 +004000 XXXXD005. OBSQ54.2 +004100 SELECT SQ-FS6 ASSIGN TO OBSQ54.2 +004200 XXXXD011. OBSQ54.2 +004300 SELECT SQ-FS7 ASSIGN TO OBSQ54.2 +004400 XXXXD012. OBSQ54.2 +004500 SELECT SQ-FS8 ASSIGN TO OBSQ54.2 +004600 XXXXD013. OBSQ54.2 +004700 I-O-CONTROL. OBSQ54.2 +004800 MULTIPLE FILE TAPE CONTAINS SQ-FS3 POSITION 3; OBSQ54.2 +004900 MULTIPLE FILE TAPE SQ-FS5, OBSQ54.2 +005000 SQ-FS6, OBSQ54.2 +005100 SQ-FS7, OBSQ54.2 +005200 SQ-FS8. OBSQ54.2 +005300 DATA DIVISION. OBSQ54.2 +005400 FILE SECTION. OBSQ54.2 +005500P OBSQ54.2 +005600PFD RAW-DATA. OBSQ54.2 +005700P OBSQ54.2 +005800P01 RAW-DATA-SATZ. OBSQ54.2 +005900P 05 RAW-DATA-KEY PIC X(6). OBSQ54.2 +006000P 05 C-DATE PIC 9(6). OBSQ54.2 +006100P 05 C-TIME PIC 9(8). OBSQ54.2 +006200P 05 C-NO-OF-TESTS PIC 99. OBSQ54.2 +006300P 05 C-OK PIC 999. OBSQ54.2 +006400P 05 C-ALL PIC 999. OBSQ54.2 +006500P 05 C-FAIL PIC 999. OBSQ54.2 +006600P 05 C-DELETED PIC 999. OBSQ54.2 +006700P 05 C-INSPECT PIC 999. OBSQ54.2 +006800P 05 C-NOTE PIC X(13). OBSQ54.2 +006900P 05 C-INDENT PIC X. OBSQ54.2 +007000P 05 C-ABORT PIC X(8). OBSQ54.2 +007100 FD PRINT-FILE. OBSQ54.2 +007200 01 PRINT-REC PICTURE X(120). OBSQ54.2 +007300 01 DUMMY-RECORD PICTURE X(120). OBSQ54.2 +007400 FD SQ-FS3 OBSQ54.2 +007500 LABEL RECORD IS STANDARD OBSQ54.2 +007600 RECORD CONTAINS 120 CHARACTERS OBSQ54.2 +007700 BLOCK CONTAINS 1200 CHARACTERS. OBSQ54.2 +007800 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ54.2 +007900 FD SQ-FS5 OBSQ54.2 +008000 LABEL RECORD STANDARD OBSQ54.2 +008100 BLOCK CONTAINS 5 RECORDS. OBSQ54.2 +008200 01 SQ-FS5R1-F-G-120 PIC X(120). OBSQ54.2 +008300 FD SQ-FS6 OBSQ54.2 +008400 LABEL RECORD STANDARD OBSQ54.2 +008500 BLOCK CONTAINS 10 RECORDS. OBSQ54.2 +008600 01 SQ-FS6R1-F-G-120 PIC X(120). OBSQ54.2 +008700 FD SQ-FS7 OBSQ54.2 +008800 LABEL RECORD STANDARD OBSQ54.2 +008900 BLOCK CONTAINS 2400 CHARACTERS. OBSQ54.2 +009000 01 SQ-FS7R1-F-G-120 PIC X(120). OBSQ54.2 +009100 FD SQ-FS8 OBSQ54.2 +009200 LABEL RECORD STANDARD OBSQ54.2 +009300 RECORD 120 OBSQ54.2 +009400 BLOCK CONTAINS 120 CHARACTERS. OBSQ54.2 +009500 01 SQ-FS8R1-F-G-120 PIC X(120). OBSQ54.2 +009600 WORKING-STORAGE SECTION. OBSQ54.2 +009700 77 COUNT-OF-RECS PICTURE 999 VALUE 0. OBSQ54.2 +009800 77 RECORDS-IN-ERROR PIC 999 VALUE 0. OBSQ54.2 +009900 01 FILE-RECORD-INFORMATION-REC. OBSQ54.2 +010000 03 FILE-RECORD-INFO-SKELETON. OBSQ54.2 +010100 05 FILLER PICTURE X(48) VALUE OBSQ54.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ54.2 +010300 05 FILLER PICTURE X(46) VALUE OBSQ54.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ54.2 +010500 05 FILLER PICTURE X(26) VALUE OBSQ54.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". OBSQ54.2 +010700 05 FILLER PICTURE X(37) VALUE OBSQ54.2 +010800 ",RECKEY= ". OBSQ54.2 +010900 05 FILLER PICTURE X(38) VALUE OBSQ54.2 +011000 ",ALTKEY1= ". OBSQ54.2 +011100 05 FILLER PICTURE X(38) VALUE OBSQ54.2 +011200 ",ALTKEY2= ". OBSQ54.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ54.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ54.2 +011500 05 FILE-RECORD-INFO-P1-120. OBSQ54.2 +011600 07 FILLER PIC X(5). OBSQ54.2 +011700 07 XFILE-NAME PIC X(6). OBSQ54.2 +011800 07 FILLER PIC X(8). OBSQ54.2 +011900 07 XRECORD-NAME PIC X(6). OBSQ54.2 +012000 07 FILLER PIC X(1). OBSQ54.2 +012100 07 REELUNIT-NUMBER PIC 9(1). OBSQ54.2 +012200 07 FILLER PIC X(7). OBSQ54.2 +012300 07 XRECORD-NUMBER PIC 9(6). OBSQ54.2 +012400 07 FILLER PIC X(6). OBSQ54.2 +012500 07 UPDATE-NUMBER PIC 9(2). OBSQ54.2 +012600 07 FILLER PIC X(5). OBSQ54.2 +012700 07 ODO-NUMBER PIC 9(4). OBSQ54.2 +012800 07 FILLER PIC X(5). OBSQ54.2 +012900 07 XPROGRAM-NAME PIC X(5). OBSQ54.2 +013000 07 FILLER PIC X(7). OBSQ54.2 +013100 07 XRECORD-LENGTH PIC 9(6). OBSQ54.2 +013200 07 FILLER PIC X(7). OBSQ54.2 +013300 07 CHARS-OR-RECORDS PIC X(2). OBSQ54.2 +013400 07 FILLER PIC X(1). OBSQ54.2 +013500 07 XBLOCK-SIZE PIC 9(4). OBSQ54.2 +013600 07 FILLER PIC X(6). OBSQ54.2 +013700 07 RECORDS-IN-FILE PIC 9(6). OBSQ54.2 +013800 07 FILLER PIC X(5). OBSQ54.2 +013900 07 XFILE-ORGANIZATION PIC X(2). OBSQ54.2 +014000 07 FILLER PIC X(6). OBSQ54.2 +014100 07 XLABEL-TYPE PIC X(1). OBSQ54.2 +014200 05 FILE-RECORD-INFO-P121-240. OBSQ54.2 +014300 07 FILLER PIC X(8). OBSQ54.2 +014400 07 XRECORD-KEY PIC X(29). OBSQ54.2 +014500 07 FILLER PIC X(9). OBSQ54.2 +014600 07 ALTERNATE-KEY1 PIC X(29). OBSQ54.2 +014700 07 FILLER PIC X(9). OBSQ54.2 +014800 07 ALTERNATE-KEY2 PIC X(29). OBSQ54.2 +014900 07 FILLER PIC X(7). OBSQ54.2 +015000 01 TEST-RESULTS. OBSQ54.2 +015100 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ54.2 +015300 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ54.2 +015500 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015600 02 PAR-NAME. OBSQ54.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ54.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ54.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ54.2 +016000 03 FILLER PIC X(5) VALUE SPACE. OBSQ54.2 +016100 02 FILLER PIC X(10) VALUE SPACE. OBSQ54.2 +016200 02 RE-MARK PIC X(61). OBSQ54.2 +016300 01 TEST-COMPUTED. OBSQ54.2 +016400 02 FILLER PIC X(30) VALUE SPACE. OBSQ54.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ54.2 +016600 02 COMPUTED-X. OBSQ54.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ54.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ54.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ54.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ54.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ54.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ54.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). OBSQ54.2 +017400 04 FILLER PICTURE X. OBSQ54.2 +017500 03 FILLER PIC X(50) VALUE SPACE. OBSQ54.2 +017600 01 TEST-CORRECT. OBSQ54.2 +017700 02 FILLER PIC X(30) VALUE SPACE. OBSQ54.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ54.2 +017900 02 CORRECT-X. OBSQ54.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ54.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ54.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ54.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ54.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ54.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. OBSQ54.2 +018600 04 CORRECT-18V0 PICTURE -9(18). OBSQ54.2 +018700 04 FILLER PICTURE X. OBSQ54.2 +018800 03 FILLER PIC X(50) VALUE SPACE. OBSQ54.2 +018900 01 CCVS-C-1. OBSQ54.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ54.2 +019100- "SS PARAGRAPH-NAME OBSQ54.2 +019200- " REMARKS". OBSQ54.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ54.2 +019400 01 CCVS-C-2. OBSQ54.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ54.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ54.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ54.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ54.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ54.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ54.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ54.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ54.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ54.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ54.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ54.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ54.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ54.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ54.2 +021000 01 REC-COUNT PIC 9(5) VALUE ZERO. OBSQ54.2 +021100 01 CCVS-H-1. OBSQ54.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ54.2 +021300 02 FILLER PICTURE X(67) VALUE OBSQ54.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ54.2 +021500- " SYSTEM". OBSQ54.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ54.2 +021700 01 CCVS-H-2. OBSQ54.2 +021800 02 FILLER PICTURE X(52) VALUE IS OBSQ54.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ54.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ54.2 +022100 02 TEST-ID PICTURE IS X(9). OBSQ54.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ54.2 +022300 01 CCVS-H-3. OBSQ54.2 +022400 02 FILLER PICTURE X(34) VALUE OBSQ54.2 +022500 " FOR OFFICIAL USE ONLY ". OBSQ54.2 +022600 02 FILLER PICTURE X(58) VALUE OBSQ54.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ54.2 +022800 02 FILLER PICTURE X(28) VALUE OBSQ54.2 +022900 " COPYRIGHT 1985 ". OBSQ54.2 +023000 01 CCVS-E-1. OBSQ54.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ54.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ54.2 +023300 02 ID-AGAIN PICTURE IS X(9). OBSQ54.2 +023400 02 FILLER PICTURE X(45) VALUE IS OBSQ54.2 +023500 " NTIS DISTRIBUTION COBOL 85". OBSQ54.2 +023600 01 CCVS-E-2. OBSQ54.2 +023700 02 FILLER PICTURE X(31) VALUE OBSQ54.2 +023800 SPACE. OBSQ54.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ54.2 +024000 02 CCVS-E-2-2. OBSQ54.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ54.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ54.2 +024400 01 CCVS-E-3. OBSQ54.2 +024500 02 FILLER PICTURE X(22) VALUE OBSQ54.2 +024600 " FOR OFFICIAL USE ONLY". OBSQ54.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ54.2 +024800 02 FILLER PICTURE X(58) VALUE OBSQ54.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ54.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ54.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ54.2 +025200 01 CCVS-E-4. OBSQ54.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ54.2 +025400 02 FILLER PIC XXXX VALUE " OF ". OBSQ54.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ54.2 +025600 02 FILLER PIC X(40) VALUE OBSQ54.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ54.2 +025800 01 XXINFO. OBSQ54.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ54.2 +026000 02 INFO-TEXT. OBSQ54.2 +026100 04 FILLER PIC X(20) VALUE SPACE. OBSQ54.2 +026200 04 XXCOMPUTED PIC X(20). OBSQ54.2 +026300 04 FILLER PIC X(5) VALUE SPACE. OBSQ54.2 +026400 04 XXCORRECT PIC X(20). OBSQ54.2 +026500 01 HYPHEN-LINE. OBSQ54.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ54.2 +026800- "*****************************************". OBSQ54.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ54.2 +027000- "******************************". OBSQ54.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ54.2 +027200 "OBSQ5A". OBSQ54.2 +027300 PROCEDURE DIVISION. OBSQ54.2 +027400 CCVS1 SECTION. OBSQ54.2 +027500 OPEN-FILES. OBSQ54.2 +027600P OPEN I-O RAW-DATA. OBSQ54.2 +027700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ54.2 +027800P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ54.2 +027900P MOVE "ABORTED " TO C-ABORT. OBSQ54.2 +028000P ADD 1 TO C-NO-OF-TESTS. OBSQ54.2 +028100P ACCEPT C-DATE FROM DATE. OBSQ54.2 +028200P ACCEPT C-TIME FROM TIME. OBSQ54.2 +028300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ54.2 +028400PEND-E-1. OBSQ54.2 +028500P CLOSE RAW-DATA. OBSQ54.2 +028600 OPEN OUTPUT PRINT-FILE. OBSQ54.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ54.2 +028800 MOVE SPACE TO TEST-RESULTS. OBSQ54.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ54.2 +029000 MOVE ZERO TO REC-SKL-SUB. OBSQ54.2 +029100 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ54.2 +029200 CCVS-INIT-FILE. OBSQ54.2 +029300 ADD 1 TO REC-SKL-SUB. OBSQ54.2 +029400 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ54.2 +029500 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ54.2 +029600 CCVS-INIT-EXIT. OBSQ54.2 +029700 GO TO CCVS1-EXIT. OBSQ54.2 +029800 CLOSE-FILES. OBSQ54.2 +029900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ54.2 +030000P OPEN I-O RAW-DATA. OBSQ54.2 +030100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ54.2 +030200P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ54.2 +030300P MOVE "OK. " TO C-ABORT. OBSQ54.2 +030400P MOVE PASS-COUNTER TO C-OK. OBSQ54.2 +030500P MOVE ERROR-HOLD TO C-ALL. OBSQ54.2 +030600P MOVE ERROR-COUNTER TO C-FAIL. OBSQ54.2 +030700P MOVE DELETE-CNT TO C-DELETED. OBSQ54.2 +030800P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ54.2 +030900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ54.2 +031000PEND-E-2. OBSQ54.2 +031100P CLOSE RAW-DATA. OBSQ54.2 +031200 TERMINATE-CCVS. OBSQ54.2 +031300S EXIT PROGRAM. OBSQ54.2 +031400STERMINATE-CALL. OBSQ54.2 +031500 STOP RUN. OBSQ54.2 +031600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ54.2 +031700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ54.2 +031800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ54.2 +031900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ54.2 +032000 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ54.2 +032100 PRINT-DETAIL. OBSQ54.2 +032200 IF REC-CT NOT EQUAL TO ZERO OBSQ54.2 +032300 MOVE "." TO PARDOT-X OBSQ54.2 +032400 MOVE REC-CT TO DOTVALUE. OBSQ54.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ54.2 +032600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ54.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ54.2 +032800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ54.2 +032900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ54.2 +033000 MOVE SPACE TO CORRECT-X. OBSQ54.2 +033100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ54.2 +033200 MOVE SPACE TO RE-MARK. OBSQ54.2 +033300 HEAD-ROUTINE. OBSQ54.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +033500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ54.2 +033600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ54.2 +033700 COLUMN-NAMES-ROUTINE. OBSQ54.2 +033800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +033900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +034100 END-ROUTINE. OBSQ54.2 +034200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ54.2 +034300 END-RTN-EXIT. OBSQ54.2 +034400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +034500 END-ROUTINE-1. OBSQ54.2 +034600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ54.2 +034700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ54.2 +034800 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ54.2 +034900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ54.2 +035000 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ54.2 +035100 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ54.2 +035200 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ54.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ54.2 +035400 END-ROUTINE-12. OBSQ54.2 +035500 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ54.2 +035600 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ54.2 +035700 MOVE "NO " TO ERROR-TOTAL OBSQ54.2 +035800 ELSE OBSQ54.2 +035900 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ54.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ54.2 +036100 PERFORM WRITE-LINE. OBSQ54.2 +036200 END-ROUTINE-13. OBSQ54.2 +036300 IF DELETE-CNT IS EQUAL TO ZERO OBSQ54.2 +036400 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ54.2 +036500 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ54.2 +036600 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ54.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +036800 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ54.2 +036900 MOVE "NO " TO ERROR-TOTAL OBSQ54.2 +037000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ54.2 +037100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ54.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +037300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +037400 WRITE-LINE. OBSQ54.2 +037500 ADD 1 TO RECORD-COUNT. OBSQ54.2 +037600Y IF RECORD-COUNT GREATER 50 OBSQ54.2 +037700Y MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ54.2 +037800Y MOVE SPACE TO DUMMY-RECORD OBSQ54.2 +037900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ54.2 +038000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ54.2 +038100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ54.2 +038200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ54.2 +038300Y MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ54.2 +038400Y MOVE ZERO TO RECORD-COUNT. OBSQ54.2 +038500 PERFORM WRT-LN. OBSQ54.2 +038600 WRT-LN. OBSQ54.2 +038700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ54.2 +038800 MOVE SPACE TO DUMMY-RECORD. OBSQ54.2 +038900 BLANK-LINE-PRINT. OBSQ54.2 +039000 PERFORM WRT-LN. OBSQ54.2 +039100 FAIL-ROUTINE. OBSQ54.2 +039200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ54.2 +039300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ54.2 +039400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ54.2 +039500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +039600 GO TO FAIL-ROUTINE-EX. OBSQ54.2 +039700 FAIL-ROUTINE-WRITE. OBSQ54.2 +039800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ54.2 +039900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +040000 FAIL-ROUTINE-EX. EXIT. OBSQ54.2 +040100 BAIL-OUT. OBSQ54.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ54.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ54.2 +040400 BAIL-OUT-WRITE. OBSQ54.2 +040500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ54.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +040700 BAIL-OUT-EX. EXIT. OBSQ54.2 +040800 CCVS1-EXIT. OBSQ54.2 +040900 EXIT. OBSQ54.2 +041000 SECT-OBSQ5A-0001 SECTION. OBSQ54.2 +041100 SEQ-INIT-001. OBSQ54.2 +041200 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +041300 OPEN INPUT SQ-FS3. OBSQ54.2 +041400 SEQ-TEST-001. OBSQ54.2 +041500 READ SQ-FS3 AT END GO TO SEQ-TEST-001-01. OBSQ54.2 +041600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +041700 ADD 1 TO REC-COUNT. OBSQ54.2 +041800 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +041900 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +042000 GO TO SEQ-FAIL-001. OBSQ54.2 +042100 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +042200 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042300 GO TO SEQ-TEST-001. OBSQ54.2 +042400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" OBSQ54.2 +042500 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042600 GO TO SEQ-TEST-001. OBSQ54.2 +042700 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ54.2 +042800 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042900 GO TO SEQ-TEST-001. OBSQ54.2 +043000 IF XBLOCK-SIZE (1) NOT EQUAL TO 1200 OBSQ54.2 +043100 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +043200 GO TO SEQ-TEST-001. OBSQ54.2 +043300 SEQ-TEST-001-01. OBSQ54.2 +043400 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +043500 GO TO SEQ-PASS-001. OBSQ54.2 +043600 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. OBSQ54.2 +043700 SEQ-FAIL-001. OBSQ54.2 +043800 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +043900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +044000 PERFORM FAIL. OBSQ54.2 +044100 GO TO SEQ-WRITE-001. OBSQ54.2 +044200 SEQ-PASS-001. OBSQ54.2 +044300 PERFORM PASS. OBSQ54.2 +044400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +044500 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +044600 SEQ-WRITE-001. OBSQ54.2 +044700 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ54.2 +044800 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. OBSQ54.2 +044900 PERFORM PRINT-DETAIL. OBSQ54.2 +045000 SEQ-CLOSE-001. OBSQ54.2 +045100 CLOSE SQ-FS3. OBSQ54.2 +045200 SEQ-INIT-002. OBSQ54.2 +045300* THIS TEST READS AND VALIDATES FILE SQ-FS5. OBSQ54.2 +045400 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +045500 OPEN INPUT SQ-FS5. OBSQ54.2 +045600 SEQ-TEST-002. OBSQ54.2 +045700 READ SQ-FS5 AT END GO TO SEQ-TEST-002-01. OBSQ54.2 +045800 MOVE SQ-FS5R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +045900 ADD 1 TO REC-COUNT. OBSQ54.2 +046000 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +046100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +046200 GO TO SEQ-FAIL-002. OBSQ54.2 +046300 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +046400 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +046500 GO TO SEQ-TEST-002. OBSQ54.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" OBSQ54.2 +046700 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +046800 GO TO SEQ-TEST-002. OBSQ54.2 +046900 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ54.2 +047000 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +047100 GO TO SEQ-TEST-002. OBSQ54.2 +047200 IF XBLOCK-SIZE (1) NOT EQUAL TO 5 OBSQ54.2 +047300 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +047400 GO TO SEQ-TEST-002. OBSQ54.2 +047500 SEQ-TEST-002-01. OBSQ54.2 +047600 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +047700 GO TO SEQ-PASS-002. OBSQ54.2 +047800 MOVE "ERRORS IN READINGS SQ-FS5" TO RE-MARK. OBSQ54.2 +047900 SEQ-FAIL-002. OBSQ54.2 +048000 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +048100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +048200 PERFORM FAIL. OBSQ54.2 +048300 GO TO SEQ-WRITE-002. OBSQ54.2 +048400 SEQ-PASS-002. OBSQ54.2 +048500 PERFORM PASS. OBSQ54.2 +048600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +048700 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +048800 SEQ-WRITE-002. OBSQ54.2 +048900 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ54.2 +049000 MOVE "VERIFY FILE SQ-FS5" TO FEATURE OBSQ54.2 +049100 PERFORM PRINT-DETAIL. OBSQ54.2 +049200 SEQ-CLOSE-002. OBSQ54.2 +049300 CLOSE SQ-FS5 WITH NO REWIND. OBSQ54.2 +049400 SEQ-INIT-003. OBSQ54.2 +049500* THIS TEST READS AND VALIDATES FILE SQ-FS6. OBSQ54.2 +049600 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +049700 OPEN INPUT SQ-FS6 WITH NO REWIND. OBSQ54.2 +049800 SEQ-TEST-003. OBSQ54.2 +049900 READ SQ-FS6 AT END GO TO SEQ-TEST-003-01. OBSQ54.2 +050000 MOVE SQ-FS6R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +050100 ADD 1 TO REC-COUNT. OBSQ54.2 +050200 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +050300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +050400 GO TO SEQ-FAIL-003. OBSQ54.2 +050500 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +050600 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +050700 GO TO SEQ-TEST-003. OBSQ54.2 +050800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" OBSQ54.2 +050900 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +051000 GO TO SEQ-TEST-003. OBSQ54.2 +051100 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ54.2 +051200 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +051300 GO TO SEQ-TEST-003. OBSQ54.2 +051400 IF XBLOCK-SIZE (1) NOT EQUAL TO 10 OBSQ54.2 +051500 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +051600 GO TO SEQ-TEST-003. OBSQ54.2 +051700 SEQ-TEST-003-01. OBSQ54.2 +051800 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +051900 GO TO SEQ-PASS-003. OBSQ54.2 +052000 MOVE "ERRORS IN READING SQ-FS6" TO RE-MARK. OBSQ54.2 +052100 SEQ-FAIL-003. OBSQ54.2 +052200 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +052300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +052400 PERFORM FAIL. OBSQ54.2 +052500 GO TO SEQ-WRITE-003. OBSQ54.2 +052600 SEQ-PASS-003. OBSQ54.2 +052700 PERFORM PASS. OBSQ54.2 +052800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +052900 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +053000 SEQ-WRITE-003. OBSQ54.2 +053100 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ54.2 +053200 MOVE "VERIFY FILE SQ-FS6" TO FEATURE. OBSQ54.2 +053300 PERFORM PRINT-DETAIL. OBSQ54.2 +053400 SEQ-CLOSE-003. OBSQ54.2 +053500 CLOSE SQ-FS6 WITH NO REWIND. OBSQ54.2 +053600 SEQ-INIT-004. OBSQ54.2 +053700* THIS TEST READS AND VALIDATES FILE SQ-FS7. OBSQ54.2 +053800 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +053900 OPEN INPUT SQ-FS7 WITH NO REWIND. OBSQ54.2 +054000 SEQ-TEST-004. OBSQ54.2 +054100 READ SQ-FS7 AT END GO TO SEQ-TEST-004-01. OBSQ54.2 +054200 MOVE SQ-FS7R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +054300 ADD 1 TO REC-COUNT. OBSQ54.2 +054400 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +054500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +054600 GO TO SEQ-FAIL-004. OBSQ54.2 +054700 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +054800 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +054900 GO TO SEQ-TEST-004. OBSQ54.2 +055000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS7" OBSQ54.2 +055100 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +055200 GO TO SEQ-TEST-004. OBSQ54.2 +055300 IF CHARS-OR-RECORDS (1) NOT EQUAL "CH" OBSQ54.2 +055400 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +055500 GO TO SEQ-TEST-004. OBSQ54.2 +055600 IF XBLOCK-SIZE (1) NOT EQUAL TO 2400 OBSQ54.2 +055700 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +055800 GO TO SEQ-TEST-004. OBSQ54.2 +055900 SEQ-TEST-004-01. OBSQ54.2 +056000 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +056100 GO TO SEQ-PASS-004. OBSQ54.2 +056200 MOVE "ERRORS IN READING SQ-FS7" TO RE-MARK. OBSQ54.2 +056300 SEQ-FAIL-004. OBSQ54.2 +056400 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +056500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +056600 PERFORM FAIL. OBSQ54.2 +056700 GO TO SEQ-WRITE-004. OBSQ54.2 +056800 SEQ-PASS-004. OBSQ54.2 +056900 PERFORM PASS. OBSQ54.2 +057000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +057100 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +057200 SEQ-WRITE-004. OBSQ54.2 +057300 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ54.2 +057400 MOVE "VERIFY FILE SQ-FS7" TO FEATURE. OBSQ54.2 +057500 PERFORM PRINT-DETAIL. OBSQ54.2 +057600 SEQ-CLOSE-004. OBSQ54.2 +057700 CLOSE SQ-FS7 WITH NO REWIND. OBSQ54.2 +057800 SEQ-INIT-005. OBSQ54.2 +057900* THIS TEST READS AND VALIDATES FILE SQ-FS8. OBSQ54.2 +058000 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +058100 OPEN INPUT SQ-FS8 WITH NO REWIND. OBSQ54.2 +058200 SEQ-TEST-005. OBSQ54.2 +058300 READ SQ-FS8 AT END GO TO SEQ-TEST-005-01. OBSQ54.2 +058400 MOVE SQ-FS8R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +058500 ADD 1 TO REC-COUNT. OBSQ54.2 +058600 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +058700 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +058800 GO TO SEQ-FAIL-005. OBSQ54.2 +058900 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +059000 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059100 GO TO SEQ-TEST-005. OBSQ54.2 +059200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" OBSQ54.2 +059300 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059400 GO TO SEQ-TEST-005. OBSQ54.2 +059500 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ54.2 +059600 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059700 GO TO SEQ-TEST-005. OBSQ54.2 +059800 IF XBLOCK-SIZE (1) NOT EQUAL TO 120 OBSQ54.2 +059900 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +060000 GO TO SEQ-TEST-005. OBSQ54.2 +060100 SEQ-TEST-005-01. OBSQ54.2 +060200 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +060300 GO TO SEQ-PASS-005. OBSQ54.2 +060400 MOVE "ERRORS IN READING SQ-FS8" TO RE-MARK. OBSQ54.2 +060500 SEQ-FAIL-005. OBSQ54.2 +060600 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +060700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +060800 PERFORM FAIL. OBSQ54.2 +060900 GO TO SEQ-WRITE-005. OBSQ54.2 +061000 SEQ-PASS-005. OBSQ54.2 +061100 PERFORM PASS. OBSQ54.2 +061200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +061300 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +061400 SEQ-WRITE-005. OBSQ54.2 +061500 MOVE "SEQ-TEST-005" TO PAR-NAME. OBSQ54.2 +061600 MOVE "VERIFY FILE SQ-FS8" TO FEATURE. OBSQ54.2 +061700 PERFORM PRINT-DETAIL. OBSQ54.2 +061800 SEQ-CLOSE-005. OBSQ54.2 +061900 CLOSE SQ-FS8. OBSQ54.2 +062000 OBSQ5A-END-ROUTINE. OBSQ54.2 +062100 MOVE "END OF OBSQ5A VALIDATION TESTS" TO PRINT-REC. OBSQ54.2 +062200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ54.2 +062300 GO TO CCVS-EXIT. OBSQ54.2 +062400 CCVS-EXIT SECTION. OBSQ54.2 +062500 CCVS-999999. OBSQ54.2 +062600 GO TO CLOSE-FILES. OBSQ54.2 +*END-OF,OBSQ5A +*HEADER,COBOL,RL101A +000100 IDENTIFICATION DIVISION. RL1014.2 +000200 PROGRAM-ID. RL1014.2 +000300 RL101A. RL1014.2 +000400**************************************************************** RL1014.2 +000500* * RL1014.2 +000600* VALIDATION FOR:- * RL1014.2 +000700* * RL1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +000900* * RL1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1014.2 +001100* * RL1014.2 +001200**************************************************************** RL1014.2 +001300* * RL1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1014.2 +001500* * RL1014.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1014.2 +001700* RELATIVE I-O DATA FILE * RL1014.2 +001800* X-55 SYSTEM PRINTER * RL1014.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1014.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1014.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1014.2 +002200* X-82 SOURCE-COMPUTER * RL1014.2 +002300* X-83 OBJECT-COMPUTER. * RL1014.2 +002400* * RL1014.2 +002500**************************************************************** RL1014.2 +002600* RL111A * RL1014.2 +002700**************************************************************** RL1014.2 +002800* * RL1014.2 +002900* THIS PROGRAM WILL TEST THE NEW SYNTACTICAL CONSTRUCTS * RL1014.2 +003000* AND SEMENTIC ACTIONS ASSOCIATED WITH THE FOLLOWING * RL1014.2 +003100* CLAUSES: * RL1014.2 +003200* - ACCESS * RL1014.2 +003300* - READ * RL1014.2 +003400* - WRITE * RL1014.2 +003500* - REWRITE * RL1014.2 +003600* * RL1014.2 +003700* 1) THE PROGRAM WILL CREATE A RELATIVE I-O FILE * RL1014.2 +003800* 2) THEN IT WILL UPDATE SELECTIVE RECORDS OF THE FILE * RL1014.2 +003900* 3) THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR * RL1014.2 +004000* ACCURACY FOR EACH "OPEN", "CLOSE", "READ" AND * RL1014.2 +004100* "REWRITE" STATEMENT USED. * RL1014.2 +004200* 4) THE "READ", "WRITE" AND "REWRITE" STATEMENT WILL BE * RL1014.2 +004300* USED WITH THE APPROPRIATE "AT END", "NOT AT END", * RL1014.2 +004400* "INVALID KEY" AND "NOT INVALID KEY" PHRASES. * RL1014.2 +004500* * RL1014.2 +004600**************************************************************** RL1014.2 +004700 ENVIRONMENT DIVISION. RL1014.2 +004800 CONFIGURATION SECTION. RL1014.2 +004900 SOURCE-COMPUTER. RL1014.2 +005000 XXXXX082. RL1014.2 +005100 OBJECT-COMPUTER. RL1014.2 +005200 XXXXX083. RL1014.2 +005300 INPUT-OUTPUT SECTION. RL1014.2 +005400 FILE-CONTROL. RL1014.2 +005500 SELECT PRINT-FILE ASSIGN TO RL1014.2 +005600 XXXXX055. RL1014.2 +005700 SELECT RL-FS2 ASSIGN TO RL1014.2 +005800 XXXXP021 RL1014.2 +005900 ORGANIZATION IS RELATIVE RL1014.2 +006000 ACCESS IS SEQUENTIAL RL1014.2 +006100 STATUS RL-FS2-STATUS. RL1014.2 +006200 DATA DIVISION. RL1014.2 +006300 FILE SECTION. RL1014.2 +006400 FD PRINT-FILE. RL1014.2 +006500 01 PRINT-REC PICTURE X(120). RL1014.2 +006600 01 DUMMY-RECORD PICTURE X(120). RL1014.2 +006700 FD RL-FS2 RL1014.2 +006800 LABEL RECORDS STANDARD RL1014.2 +006900C VALUE OF RL1014.2 +007000C XXXXX074 RL1014.2 +007100C IS RL1014.2 +007200C XXXXX075 RL1014.2 +007300G XXXXX069 RL1014.2 +007400 BLOCK CONTAINS 1 RECORDS RL1014.2 +007500 RECORD CONTAINS 120 CHARACTERS. RL1014.2 +007600 01 RL-FS2R1-F-G-120. RL1014.2 +007700 02 FILLER PIC X(120). RL1014.2 +007800 WORKING-STORAGE SECTION. RL1014.2 +007900 01 RL-FS2-STATUS PIC XX. RL1014.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL1014.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL1014.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL1014.2 +008300 05 FILLER PICTURE X(48) VALUE RL1014.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1014.2 +008500 05 FILLER PICTURE X(46) VALUE RL1014.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1014.2 +008700 05 FILLER PICTURE X(26) VALUE RL1014.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL1014.2 +008900 05 FILLER PICTURE X(37) VALUE RL1014.2 +009000 ",RECKEY= ". RL1014.2 +009100 05 FILLER PICTURE X(38) VALUE RL1014.2 +009200 ",ALTKEY1= ". RL1014.2 +009300 05 FILLER PICTURE X(38) VALUE RL1014.2 +009400 ",ALTKEY2= ". RL1014.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL1014.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1014.2 +009700 05 FILE-RECORD-INFO-P1-120. RL1014.2 +009800 07 FILLER PIC X(5). RL1014.2 +009900 07 XFILE-NAME PIC X(6). RL1014.2 +010000 07 FILLER PIC X(8). RL1014.2 +010100 07 XRECORD-NAME PIC X(6). RL1014.2 +010200 07 FILLER PIC X(1). RL1014.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL1014.2 +010400 07 FILLER PIC X(7). RL1014.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL1014.2 +010600 07 FILLER PIC X(6). RL1014.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL1014.2 +010800 07 FILLER PIC X(5). RL1014.2 +010900 07 ODO-NUMBER PIC 9(4). RL1014.2 +011000 07 FILLER PIC X(5). RL1014.2 +011100 07 XPROGRAM-NAME PIC X(5). RL1014.2 +011200 07 FILLER PIC X(7). RL1014.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL1014.2 +011400 07 FILLER PIC X(7). RL1014.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL1014.2 +011600 07 FILLER PIC X(1). RL1014.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL1014.2 +011800 07 FILLER PIC X(6). RL1014.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL1014.2 +012000 07 FILLER PIC X(5). RL1014.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL1014.2 +012200 07 FILLER PIC X(6). RL1014.2 +012300 07 XLABEL-TYPE PIC X(1). RL1014.2 +012400 05 FILE-RECORD-INFO-P121-240. RL1014.2 +012500 07 FILLER PIC X(8). RL1014.2 +012600 07 XRECORD-KEY PIC X(29). RL1014.2 +012700 07 FILLER PIC X(9). RL1014.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL1014.2 +012900 07 FILLER PIC X(9). RL1014.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL1014.2 +013100 07 FILLER PIC X(7). RL1014.2 +013200 01 TEST-RESULTS. RL1014.2 +013300 02 FILLER PIC X VALUE SPACE. RL1014.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. RL1014.2 +013500 02 FILLER PIC X VALUE SPACE. RL1014.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. RL1014.2 +013700 02 FILLER PIC X VALUE SPACE. RL1014.2 +013800 02 PAR-NAME. RL1014.2 +013900 03 FILLER PIC X(19) VALUE SPACE. RL1014.2 +014000 03 PARDOT-X PIC X VALUE SPACE. RL1014.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. RL1014.2 +014200 02 FILLER PIC X(8) VALUE SPACE. RL1014.2 +014300 02 RE-MARK PIC X(61). RL1014.2 +014400 01 TEST-COMPUTED. RL1014.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL1014.2 +014600 02 FILLER PIC X(17) VALUE RL1014.2 +014700 " COMPUTED=". RL1014.2 +014800 02 COMPUTED-X. RL1014.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1014.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A RL1014.2 +015100 PIC -9(9).9(9). RL1014.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1014.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1014.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1014.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. RL1014.2 +015600 04 COMPUTED-18V0 PIC -9(18). RL1014.2 +015700 04 FILLER PIC X. RL1014.2 +015800 03 FILLER PIC X(50) VALUE SPACE. RL1014.2 +015900 01 TEST-CORRECT. RL1014.2 +016000 02 FILLER PIC X(30) VALUE SPACE. RL1014.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". RL1014.2 +016200 02 CORRECT-X. RL1014.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. RL1014.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1014.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1014.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1014.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1014.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. RL1014.2 +016900 04 CORRECT-18V0 PIC -9(18). RL1014.2 +017000 04 FILLER PIC X. RL1014.2 +017100 03 FILLER PIC X(2) VALUE SPACE. RL1014.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1014.2 +017300 01 CCVS-C-1. RL1014.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1014.2 +017500- "SS PARAGRAPH-NAME RL1014.2 +017600- " REMARKS". RL1014.2 +017700 02 FILLER PIC X(20) VALUE SPACE. RL1014.2 +017800 01 CCVS-C-2. RL1014.2 +017900 02 FILLER PIC X VALUE SPACE. RL1014.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". RL1014.2 +018100 02 FILLER PIC X(15) VALUE SPACE. RL1014.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". RL1014.2 +018300 02 FILLER PIC X(94) VALUE SPACE. RL1014.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1014.2 +018500 01 REC-CT PIC 99 VALUE ZERO. RL1014.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1014.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1014.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1014.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1014.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1014.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1014.2 +019500 01 CCVS-H-1. RL1014.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL1014.2 +019700 02 FILLER PIC X(42) VALUE RL1014.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1014.2 +019900 02 FILLER PIC X(39) VALUE SPACES. RL1014.2 +020000 01 CCVS-H-2A. RL1014.2 +020100 02 FILLER PIC X(40) VALUE SPACE. RL1014.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1014.2 +020300 02 FILLER PIC XXXX VALUE RL1014.2 +020400 "4.2 ". RL1014.2 +020500 02 FILLER PIC X(28) VALUE RL1014.2 +020600 " COPY - NOT FOR DISTRIBUTION". RL1014.2 +020700 02 FILLER PIC X(41) VALUE SPACE. RL1014.2 +020800 RL1014.2 +020900 01 CCVS-H-2B. RL1014.2 +021000 02 FILLER PIC X(15) VALUE RL1014.2 +021100 "TEST RESULT OF ". RL1014.2 +021200 02 TEST-ID PIC X(9). RL1014.2 +021300 02 FILLER PIC X(4) VALUE RL1014.2 +021400 " IN ". RL1014.2 +021500 02 FILLER PIC X(12) VALUE RL1014.2 +021600 " HIGH ". RL1014.2 +021700 02 FILLER PIC X(22) VALUE RL1014.2 +021800 " LEVEL VALIDATION FOR ". RL1014.2 +021900 02 FILLER PIC X(58) VALUE RL1014.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +022100 01 CCVS-H-3. RL1014.2 +022200 02 FILLER PIC X(34) VALUE RL1014.2 +022300 " FOR OFFICIAL USE ONLY ". RL1014.2 +022400 02 FILLER PIC X(58) VALUE RL1014.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1014.2 +022600 02 FILLER PIC X(28) VALUE RL1014.2 +022700 " COPYRIGHT 1985 ". RL1014.2 +022800 01 CCVS-E-1. RL1014.2 +022900 02 FILLER PIC X(52) VALUE SPACE. RL1014.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1014.2 +023100 02 ID-AGAIN PIC X(9). RL1014.2 +023200 02 FILLER PIC X(45) VALUE SPACES. RL1014.2 +023300 01 CCVS-E-2. RL1014.2 +023400 02 FILLER PIC X(31) VALUE SPACE. RL1014.2 +023500 02 FILLER PIC X(21) VALUE SPACE. RL1014.2 +023600 02 CCVS-E-2-2. RL1014.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1014.2 +023800 03 FILLER PIC X VALUE SPACE. RL1014.2 +023900 03 ENDER-DESC PIC X(44) VALUE RL1014.2 +024000 "ERRORS ENCOUNTERED". RL1014.2 +024100 01 CCVS-E-3. RL1014.2 +024200 02 FILLER PIC X(22) VALUE RL1014.2 +024300 " FOR OFFICIAL USE ONLY". RL1014.2 +024400 02 FILLER PIC X(12) VALUE SPACE. RL1014.2 +024500 02 FILLER PIC X(58) VALUE RL1014.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +024700 02 FILLER PIC X(13) VALUE SPACE. RL1014.2 +024800 02 FILLER PIC X(15) VALUE RL1014.2 +024900 " COPYRIGHT 1985". RL1014.2 +025000 01 CCVS-E-4. RL1014.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1014.2 +025200 02 FILLER PIC X(4) VALUE " OF ". RL1014.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1014.2 +025400 02 FILLER PIC X(40) VALUE RL1014.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". RL1014.2 +025600 01 XXINFO. RL1014.2 +025700 02 FILLER PIC X(19) VALUE RL1014.2 +025800 "*** INFORMATION ***". RL1014.2 +025900 02 INFO-TEXT. RL1014.2 +026000 04 FILLER PIC X(8) VALUE SPACE. RL1014.2 +026100 04 XXCOMPUTED PIC X(20). RL1014.2 +026200 04 FILLER PIC X(5) VALUE SPACE. RL1014.2 +026300 04 XXCORRECT PIC X(20). RL1014.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). RL1014.2 +026500 01 HYPHEN-LINE. RL1014.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. RL1014.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************RL1014.2 +026800- "*****************************************". RL1014.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************RL1014.2 +027000- "******************************". RL1014.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE RL1014.2 +027200 "RL101A". RL1014.2 +027300 PROCEDURE DIVISION. RL1014.2 +027400 CCVS1 SECTION. RL1014.2 +027500 OPEN-FILES. RL1014.2 +027600 OPEN OUTPUT PRINT-FILE. RL1014.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1014.2 +027800 MOVE SPACE TO TEST-RESULTS. RL1014.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1014.2 +028000 MOVE ZERO TO REC-SKL-SUB. RL1014.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1014.2 +028200 CCVS-INIT-FILE. RL1014.2 +028300 ADD 1 TO REC-SKL-SUB. RL1014.2 +028400 MOVE FILE-RECORD-INFO-SKELETON RL1014.2 +028500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1014.2 +028600 CCVS-INIT-EXIT. RL1014.2 +028700 GO TO CCVS1-EXIT. RL1014.2 +028800 CLOSE-FILES. RL1014.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1014.2 +029000 TERMINATE-CCVS. RL1014.2 +029100S EXIT PROGRAM. RL1014.2 +029200STERMINATE-CALL. RL1014.2 +029300 STOP RUN. RL1014.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1014.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1014.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1014.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1014.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. RL1014.2 +029900 PRINT-DETAIL. RL1014.2 +030000 IF REC-CT NOT EQUAL TO ZERO RL1014.2 +030100 MOVE "." TO PARDOT-X RL1014.2 +030200 MOVE REC-CT TO DOTVALUE. RL1014.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1014.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1014.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1014.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1014.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1014.2 +030800 MOVE SPACE TO CORRECT-X. RL1014.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1014.2 +031000 MOVE SPACE TO RE-MARK. RL1014.2 +031100 HEAD-ROUTINE. RL1014.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1014.2 +031500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1014.2 +031600 COLUMN-NAMES-ROUTINE. RL1014.2 +031700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +031800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +032000 END-ROUTINE. RL1014.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1014.2 +032200 END-RTN-EXIT. RL1014.2 +032300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +032400 END-ROUTINE-1. RL1014.2 +032500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1014.2 +032600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1014.2 +032700 ADD PASS-COUNTER TO ERROR-HOLD. RL1014.2 +032800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1014.2 +032900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1014.2 +033000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1014.2 +033100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1014.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1014.2 +033300 END-ROUTINE-12. RL1014.2 +033400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1014.2 +033500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1014.2 +033600 MOVE "NO " TO ERROR-TOTAL RL1014.2 +033700 ELSE RL1014.2 +033800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1014.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1014.2 +034000 PERFORM WRITE-LINE. RL1014.2 +034100 END-ROUTINE-13. RL1014.2 +034200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1014.2 +034300 MOVE "NO " TO ERROR-TOTAL ELSE RL1014.2 +034400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1014.2 +034500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1014.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +034700 IF INSPECT-COUNTER EQUAL TO ZERO RL1014.2 +034800 MOVE "NO " TO ERROR-TOTAL RL1014.2 +034900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1014.2 +035000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1014.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +035200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +035300 WRITE-LINE. RL1014.2 +035400 ADD 1 TO RECORD-COUNT. RL1014.2 +035500Y IF RECORD-COUNT GREATER 50 RL1014.2 +035600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1014.2 +035700Y MOVE SPACE TO DUMMY-RECORD RL1014.2 +035800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1014.2 +035900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1014.2 +036000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1014.2 +036100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1014.2 +036200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1014.2 +036300Y MOVE ZERO TO RECORD-COUNT. RL1014.2 +036400 PERFORM WRT-LN. RL1014.2 +036500 WRT-LN. RL1014.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1014.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL1014.2 +036800 BLANK-LINE-PRINT. RL1014.2 +036900 PERFORM WRT-LN. RL1014.2 +037000 FAIL-ROUTINE. RL1014.2 +037100 IF COMPUTED-X NOT EQUAL TO SPACE RL1014.2 +037200 GO TO FAIL-ROUTINE-WRITE. RL1014.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1014.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1014.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1014.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1014.2 +037800 GO TO FAIL-ROUTINE-EX. RL1014.2 +037900 FAIL-ROUTINE-WRITE. RL1014.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1014.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1014.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1014.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1014.2 +038400 FAIL-ROUTINE-EX. EXIT. RL1014.2 +038500 BAIL-OUT. RL1014.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1014.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1014.2 +038800 BAIL-OUT-WRITE. RL1014.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1014.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1014.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1014.2 +039300 BAIL-OUT-EX. EXIT. RL1014.2 +039400 CCVS1-EXIT. RL1014.2 +039500 EXIT. RL1014.2 +039600 SECT-RL101-001 SECTION. RL1014.2 +039700 REL-INIT-001. RL1014.2 +039800 MOVE "FILE CREATE RL-FS2" TO FEATURE. RL1014.2 +039900 OPEN OUTPUT RL-FS2. RL1014.2 +040000 MOVE "RL-FS2" TO XFILE-NAME (1). RL1014.2 +040100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL1014.2 +040200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1014.2 +040300 MOVE 000120 TO XRECORD-LENGTH (1). RL1014.2 +040400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL1014.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). RL1014.2 +040600 MOVE 000500 TO RECORDS-IN-FILE (1). RL1014.2 +040700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL1014.2 +040800 MOVE "S" TO XLABEL-TYPE (1). RL1014.2 +040900 MOVE 000001 TO XRECORD-NUMBER (1). RL1014.2 +041000 REL-TEST-001. RL1014.2 +041100 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS2R1-F-G-120. RL1014.2 +041200 WRITE RL-FS2R1-F-G-120 RL1014.2 +041300 INVALID KEY GO TO REL-FAIL-001. RL1014.2 +041400 IF XRECORD-NUMBER (1) EQUAL TO 500 RL1014.2 +041500 GO TO REL-WRITE-001. RL1014.2 +041600 ADD 000001 TO XRECORD-NUMBER (1). RL1014.2 +041700 GO TO REL-TEST-001. RL1014.2 +041800 REL-DELETE-001. RL1014.2 +041900 PERFORM DE-LETE. RL1014.2 +042000 GO TO REL-WRITE-001. RL1014.2 +042100 REL-FAIL-001. RL1014.2 +042200 PERFORM FAIL. RL1014.2 +042300 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL1014.2 +042400 REL-WRITE-001. RL1014.2 +042500 MOVE "REL-TEST-001" TO PAR-NAME RL1014.2 +042600 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL1014.2 +042700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1014.2 +042800 PERFORM PRINT-DETAIL. RL1014.2 +042900 CLOSE RL-FS2. RL1014.2 +043000 REL-INIT-002. RL1014.2 +043100 OPEN INPUT RL-FS2. RL1014.2 +043200 MOVE ZERO TO WRK-CS-09V00. RL1014.2 +043300 REL-TEST-002. RL1014.2 +043400 READ RL-FS2 RL1014.2 +043500 AT END GO TO REL-TEST-002-1. RL1014.2 +043600 MOVE RL-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1014.2 +043700 ADD 1 TO WRK-CS-09V00. RL1014.2 +043800 IF WRK-CS-09V00 GREATER 500 RL1014.2 +043900 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL1014.2 +044000 GO TO REL-TEST-002-1. RL1014.2 +044100 GO TO REL-TEST-002. RL1014.2 +044200 REL-DELETE-002. RL1014.2 +044300 REL-TEST-002-1. RL1014.2 +044400 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1014.2 +044500 PERFORM FAIL RL1014.2 +044600 ELSE RL1014.2 +044700 PERFORM PASS. RL1014.2 +044800 GO TO REL-WRITE-002. RL1014.2 +044900 REL-WRITE-002. RL1014.2 +045000 MOVE "REL-TEST-002" TO PAR-NAME. RL1014.2 +045100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL1014.2 +045200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1014.2 +045300 PERFORM PRINT-DETAIL. RL1014.2 +045400 CLOSE RL-FS2. RL1014.2 +045500 CCVS-EXIT SECTION. RL1014.2 +045600 CCVS-999999. RL1014.2 +045700 GO TO CLOSE-FILES. RL1014.2 +*END-OF,RL101A +*HEADER,COBOL,RL101A,SUBPRG,RL102A +000100 IDENTIFICATION DIVISION. RL1024.2 +000200 PROGRAM-ID. RL1024.2 +000300 RL102A. RL1024.2 +000400**************************************************************** RL1024.2 +000500* * RL1024.2 +000600* VALIDATION FOR:- * RL1024.2 +000700* * RL1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +000900* * RL1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1024.2 +001100* * RL1024.2 +001200**************************************************************** RL1024.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL1024.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS RANDOM). THE FILE RL1024.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL101. RL1024.2 +001600* RL1024.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL1024.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL1024.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL1024.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL1024.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1024.2 +002200* RL1024.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1024.2 +002400* PROGRAM ARE: RL1024.2 +002500* RL1024.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1024.2 +002700* RELATIVE I-O DATA FILE RL1024.2 +002800* X-55 SYSTEM PRINTER RL1024.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL1024.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL1024.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL1024.2 +003200* X-82 SOURCE-COMPUTER RL1024.2 +003300* X-83 OBJECT-COMPUTER. RL1024.2 +003400* RL1024.2 +003500**************************************************************** RL1024.2 +003600 ENVIRONMENT DIVISION. RL1024.2 +003700 CONFIGURATION SECTION. RL1024.2 +003800 SOURCE-COMPUTER. RL1024.2 +003900 XXXXX082. RL1024.2 +004000 OBJECT-COMPUTER. RL1024.2 +004100 XXXXX083. RL1024.2 +004200 INPUT-OUTPUT SECTION. RL1024.2 +004300 FILE-CONTROL. RL1024.2 +004400 SELECT PRINT-FILE ASSIGN TO RL1024.2 +004500 XXXXX055. RL1024.2 +004600 SELECT RL-FR1 ASSIGN TO RL1024.2 +004700 XXXXP021 RL1024.2 +004800 ORGANIZATION IS RELATIVE RL1024.2 +004900 ACCESS MODE IS RANDOM RL1024.2 +005000 RELATIVE KEY RL-FR1-KEY. RL1024.2 +005100 DATA DIVISION. RL1024.2 +005200 FILE SECTION. RL1024.2 +005300 FD PRINT-FILE. RL1024.2 +005400 01 PRINT-REC PICTURE X(120). RL1024.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL1024.2 +005600 FD RL-FR1 RL1024.2 +005700 LABEL RECORDS STANDARD RL1024.2 +005800C VALUE OF RL1024.2 +005900C XXXXX074 RL1024.2 +006000C IS RL1024.2 +006100C XXXXX075 RL1024.2 +006200G XXXXX069 RL1024.2 +006300 BLOCK CONTAINS 1 RECORDS RL1024.2 +006400 RECORD CONTAINS 120 CHARACTERS. RL1024.2 +006500 01 RL-FR1R1-F-G-120. RL1024.2 +006600 02 FILLER PICTURE X(120). RL1024.2 +006700 WORKING-STORAGE SECTION. RL1024.2 +006800 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +006900 01 RL-FR1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL1024.2 +007000 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL1024.2 +007100 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007200 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007300 01 I-O-ERROR-RL-FR1 PIC X(3) VALUE "NO ". RL1024.2 +007400 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007500 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007600 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007700 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL1024.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL1024.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL1024.2 +008000 05 FILLER PICTURE X(48) VALUE RL1024.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1024.2 +008200 05 FILLER PICTURE X(46) VALUE RL1024.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1024.2 +008400 05 FILLER PICTURE X(26) VALUE RL1024.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL1024.2 +008600 05 FILLER PICTURE X(37) VALUE RL1024.2 +008700 ",RECKEY= ". RL1024.2 +008800 05 FILLER PICTURE X(38) VALUE RL1024.2 +008900 ",ALTKEY1= ". RL1024.2 +009000 05 FILLER PICTURE X(38) VALUE RL1024.2 +009100 ",ALTKEY2= ". RL1024.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL1024.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1024.2 +009400 05 FILE-RECORD-INFO-P1-120. RL1024.2 +009500 07 FILLER PIC X(5). RL1024.2 +009600 07 XFILE-NAME PIC X(6). RL1024.2 +009700 07 FILLER PIC X(8). RL1024.2 +009800 07 XRECORD-NAME PIC X(6). RL1024.2 +009900 07 FILLER PIC X(1). RL1024.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL1024.2 +010100 07 FILLER PIC X(7). RL1024.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL1024.2 +010300 07 FILLER PIC X(6). RL1024.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL1024.2 +010500 07 FILLER PIC X(5). RL1024.2 +010600 07 ODO-NUMBER PIC 9(4). RL1024.2 +010700 07 FILLER PIC X(5). RL1024.2 +010800 07 XPROGRAM-NAME PIC X(5). RL1024.2 +010900 07 FILLER PIC X(7). RL1024.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL1024.2 +011100 07 FILLER PIC X(7). RL1024.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL1024.2 +011300 07 FILLER PIC X(1). RL1024.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL1024.2 +011500 07 FILLER PIC X(6). RL1024.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL1024.2 +011700 07 FILLER PIC X(5). RL1024.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL1024.2 +011900 07 FILLER PIC X(6). RL1024.2 +012000 07 XLABEL-TYPE PIC X(1). RL1024.2 +012100 05 FILE-RECORD-INFO-P121-240. RL1024.2 +012200 07 FILLER PIC X(8). RL1024.2 +012300 07 XRECORD-KEY PIC X(29). RL1024.2 +012400 07 FILLER PIC X(9). RL1024.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL1024.2 +012600 07 FILLER PIC X(9). RL1024.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL1024.2 +012800 07 FILLER PIC X(7). RL1024.2 +012900 01 TEST-RESULTS. RL1024.2 +013000 02 FILLER PIC X VALUE SPACE. RL1024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL1024.2 +013200 02 FILLER PIC X VALUE SPACE. RL1024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL1024.2 +013400 02 FILLER PIC X VALUE SPACE. RL1024.2 +013500 02 PAR-NAME. RL1024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL1024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL1024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL1024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL1024.2 +014000 02 RE-MARK PIC X(61). RL1024.2 +014100 01 TEST-COMPUTED. RL1024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL1024.2 +014300 02 FILLER PIC X(17) VALUE RL1024.2 +014400 " COMPUTED=". RL1024.2 +014500 02 COMPUTED-X. RL1024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL1024.2 +014800 PIC -9(9).9(9). RL1024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL1024.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL1024.2 +015400 04 FILLER PIC X. RL1024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL1024.2 +015600 01 TEST-CORRECT. RL1024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL1024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL1024.2 +015900 02 CORRECT-X. RL1024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL1024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL1024.2 +016600 04 CORRECT-18V0 PIC -9(18). RL1024.2 +016700 04 FILLER PIC X. RL1024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL1024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1024.2 +017000 01 CCVS-C-1. RL1024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1024.2 +017200- "SS PARAGRAPH-NAME RL1024.2 +017300- " REMARKS". RL1024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL1024.2 +017500 01 CCVS-C-2. RL1024.2 +017600 02 FILLER PIC X VALUE SPACE. RL1024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL1024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL1024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL1024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL1024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL1024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1024.2 +019200 01 CCVS-H-1. RL1024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL1024.2 +019400 02 FILLER PIC X(42) VALUE RL1024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL1024.2 +019700 01 CCVS-H-2A. RL1024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL1024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1024.2 +020000 02 FILLER PIC XXXX VALUE RL1024.2 +020100 "4.2 ". RL1024.2 +020200 02 FILLER PIC X(28) VALUE RL1024.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL1024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL1024.2 +020500 RL1024.2 +020600 01 CCVS-H-2B. RL1024.2 +020700 02 FILLER PIC X(15) VALUE RL1024.2 +020800 "TEST RESULT OF ". RL1024.2 +020900 02 TEST-ID PIC X(9). RL1024.2 +021000 02 FILLER PIC X(4) VALUE RL1024.2 +021100 " IN ". RL1024.2 +021200 02 FILLER PIC X(12) VALUE RL1024.2 +021300 " HIGH ". RL1024.2 +021400 02 FILLER PIC X(22) VALUE RL1024.2 +021500 " LEVEL VALIDATION FOR ". RL1024.2 +021600 02 FILLER PIC X(58) VALUE RL1024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +021800 01 CCVS-H-3. RL1024.2 +021900 02 FILLER PIC X(34) VALUE RL1024.2 +022000 " FOR OFFICIAL USE ONLY ". RL1024.2 +022100 02 FILLER PIC X(58) VALUE RL1024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1024.2 +022300 02 FILLER PIC X(28) VALUE RL1024.2 +022400 " COPYRIGHT 1985 ". RL1024.2 +022500 01 CCVS-E-1. RL1024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL1024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1024.2 +022800 02 ID-AGAIN PIC X(9). RL1024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL1024.2 +023000 01 CCVS-E-2. RL1024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL1024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL1024.2 +023300 02 CCVS-E-2-2. RL1024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1024.2 +023500 03 FILLER PIC X VALUE SPACE. RL1024.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL1024.2 +023700 "ERRORS ENCOUNTERED". RL1024.2 +023800 01 CCVS-E-3. RL1024.2 +023900 02 FILLER PIC X(22) VALUE RL1024.2 +024000 " FOR OFFICIAL USE ONLY". RL1024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL1024.2 +024200 02 FILLER PIC X(58) VALUE RL1024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL1024.2 +024500 02 FILLER PIC X(15) VALUE RL1024.2 +024600 " COPYRIGHT 1985". RL1024.2 +024700 01 CCVS-E-4. RL1024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL1024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1024.2 +025100 02 FILLER PIC X(40) VALUE RL1024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL1024.2 +025300 01 XXINFO. RL1024.2 +025400 02 FILLER PIC X(19) VALUE RL1024.2 +025500 "*** INFORMATION ***". RL1024.2 +025600 02 INFO-TEXT. RL1024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL1024.2 +025800 04 XXCOMPUTED PIC X(20). RL1024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL1024.2 +026000 04 XXCORRECT PIC X(20). RL1024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL1024.2 +026200 01 HYPHEN-LINE. RL1024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL1024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL1024.2 +026500- "*****************************************". RL1024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL1024.2 +026700- "******************************". RL1024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL1024.2 +026900 "RL102A". RL1024.2 +027000 PROCEDURE DIVISION. RL1024.2 +027100 CCVS1 SECTION. RL1024.2 +027200 OPEN-FILES. RL1024.2 +027300 OPEN OUTPUT PRINT-FILE. RL1024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1024.2 +027500 MOVE SPACE TO TEST-RESULTS. RL1024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1024.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL1024.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1024.2 +027900 CCVS-INIT-FILE. RL1024.2 +028000 ADD 1 TO REC-SKL-SUB. RL1024.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL1024.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1024.2 +028300 CCVS-INIT-EXIT. RL1024.2 +028400 GO TO CCVS1-EXIT. RL1024.2 +028500 CLOSE-FILES. RL1024.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1024.2 +028700 TERMINATE-CCVS. RL1024.2 +028800S EXIT PROGRAM. RL1024.2 +028900STERMINATE-CALL. RL1024.2 +029000 STOP RUN. RL1024.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1024.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1024.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1024.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1024.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL1024.2 +029600 PRINT-DETAIL. RL1024.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL1024.2 +029800 MOVE "." TO PARDOT-X RL1024.2 +029900 MOVE REC-CT TO DOTVALUE. RL1024.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1024.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1024.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1024.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1024.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1024.2 +030500 MOVE SPACE TO CORRECT-X. RL1024.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1024.2 +030700 MOVE SPACE TO RE-MARK. RL1024.2 +030800 HEAD-ROUTINE. RL1024.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1024.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1024.2 +031300 COLUMN-NAMES-ROUTINE. RL1024.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +031700 END-ROUTINE. RL1024.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1024.2 +031900 END-RTN-EXIT. RL1024.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +032100 END-ROUTINE-1. RL1024.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1024.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1024.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL1024.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1024.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1024.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1024.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1024.2 +033000 END-ROUTINE-12. RL1024.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1024.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1024.2 +033300 MOVE "NO " TO ERROR-TOTAL RL1024.2 +033400 ELSE RL1024.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1024.2 +033700 PERFORM WRITE-LINE. RL1024.2 +033800 END-ROUTINE-13. RL1024.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1024.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL1024.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1024.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1024.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL1024.2 +034500 MOVE "NO " TO ERROR-TOTAL RL1024.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1024.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1024.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +035000 WRITE-LINE. RL1024.2 +035100 ADD 1 TO RECORD-COUNT. RL1024.2 +035200Y IF RECORD-COUNT GREATER 50 RL1024.2 +035300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1024.2 +035400Y MOVE SPACE TO DUMMY-RECORD RL1024.2 +035500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1024.2 +035600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1024.2 +035700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1024.2 +035800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1024.2 +035900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1024.2 +036000Y MOVE ZERO TO RECORD-COUNT. RL1024.2 +036100 PERFORM WRT-LN. RL1024.2 +036200 WRT-LN. RL1024.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1024.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL1024.2 +036500 BLANK-LINE-PRINT. RL1024.2 +036600 PERFORM WRT-LN. RL1024.2 +036700 FAIL-ROUTINE. RL1024.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE RL1024.2 +036900 GO TO FAIL-ROUTINE-WRITE. RL1024.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1024.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1024.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1024.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1024.2 +037500 GO TO FAIL-ROUTINE-EX. RL1024.2 +037600 FAIL-ROUTINE-WRITE. RL1024.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1024.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1024.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1024.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1024.2 +038100 FAIL-ROUTINE-EX. EXIT. RL1024.2 +038200 BAIL-OUT. RL1024.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1024.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1024.2 +038500 BAIL-OUT-WRITE. RL1024.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1024.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1024.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1024.2 +039000 BAIL-OUT-EX. EXIT. RL1024.2 +039100 CCVS1-EXIT. RL1024.2 +039200 EXIT. RL1024.2 +039300 SECT-RL102-001 SECTION. RL1024.2 +039400 REL-INIT-003. RL1024.2 +039500 OPEN INPUT RL-FR1. RL1024.2 +039600 MOVE "REL-TEST-003" TO PAR-NAME. RL1024.2 +039700 MOVE ZERO TO RL-FR1-KEY. RL1024.2 +039800 MOVE ZERO TO WRK-CS-09V00-002 RL1024.2 +039900 MOVE ZERO TO WRK-CS-09V00-003 RL1024.2 +040000* RL1024.2 +040100 MOVE 01 TO REC-CT. RL1024.2 +040200 MOVE "READ RANDOM" TO FEATURE. RL1024.2 +040300 REL-TEST-003-R. RL1024.2 +040400 ADD 1 TO WRK-CS-09V00-003 RL1024.2 +040500 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +040600 IF RL-FR1-KEY GREATER +501 RL1024.2 +040700 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL1024.2 +040800 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1024.2 +040900 PERFORM FAIL RL1024.2 +041000 PERFORM PRINT-DETAIL RL1024.2 +041100 ADD 1 TO REC-CT RL1024.2 +041200 GO TO REL-WRITE-003. RL1024.2 +041300 READ RL-FR1 RL1024.2 +041400 INVALID KEY GO TO REL-WRITE-003. RL1024.2 +041500 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO RL-FR1-KEY RL1024.2 +041700 GO TO REL-TEST-003-R. RL1024.2 +041800 MOVE "YES" TO I-O-ERROR-RL-FR1. RL1024.2 +041900 ADD 1 TO WRK-CS-09V00-002 RL1024.2 +042000 GO TO REL-TEST-003-R. RL1024.2 +042100 REL-WRITE-003. RL1024.2 +042200 IF RL-FR1-KEY NOT EQUAL TO 501 RL1024.2 +042300 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL1024.2 +042400 MOVE RL-FR1-KEY TO COMPUTED-18V0 RL1024.2 +042500 PERFORM FAIL RL1024.2 +042600 ELSE RL1024.2 +042700 PERFORM PASS. RL1024.2 +042800 PERFORM PRINT-DETAIL. RL1024.2 +042900* RL1024.2 +043000*01 RL1024.2 +043100* RL1024.2 +043200 ADD 1 TO REC-CT. RL1024.2 +043300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1024.2 +043400 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL1024.2 +043500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL1024.2 +043600 PERFORM FAIL RL1024.2 +043700 ELSE RL1024.2 +043800 PERFORM PASS. RL1024.2 +043900 PERFORM PRINT-DETAIL. RL1024.2 +044000* RL1024.2 +044100*02 RL1024.2 +044200* RL1024.2 +044300 ADD 1 TO REC-CT. RL1024.2 +044400 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL1024.2 +044500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1024.2 +044600 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1024.2 +044700 MOVE 501 TO CORRECT-18V0 RL1024.2 +044800 PERFORM FAIL RL1024.2 +044900 ELSE RL1024.2 +045000 PERFORM PASS. RL1024.2 +045100 PERFORM PRINT-DETAIL. RL1024.2 +045200* RL1024.2 +045300*03 RL1024.2 +045400* RL1024.2 +045500 ADD 1 TO REC-CT. RL1024.2 +045600 IF I-O-ERROR-RL-FR1 EQUAL TO "YES" RL1024.2 +045700 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL1024.2 +045800 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL1024.2 +045900 PERFORM FAIL RL1024.2 +046000 ELSE RL1024.2 +046100 PERFORM PASS. RL1024.2 +046200 PERFORM PRINT-DETAIL. RL1024.2 +046300* RL1024.2 +046400*04 RL1024.2 +046500* RL1024.2 +046600 ADD 1 TO REC-CT. RL1024.2 +046700 CLOSE RL-FR1. RL1024.2 +046800 REL-INIT-004-R . RL1024.2 +046900 MOVE "REL-TEST-004" TO PAR-NAME. RL1024.2 +047000 OPEN I-O RL-FR1. RL1024.2 +047100 MOVE ZERO TO RL-FR1-KEY. RL1024.2 +047200 MOVE ZERO TO WRK-CS-09V00-002. RL1024.2 +047300 MOVE ZERO TO WRK-CS-09V00-003. RL1024.2 +047400 MOVE ZERO TO WRK-CS-09V00-004. RL1024.2 +047500 MOVE ZERO TO WRK-CS-09V00-005. RL1024.2 +047600* RL1024.2 +047700 MOVE 01 TO REC-CT. RL1024.2 +047800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +047900 MOVE "REWRITE" TO FEATURE. RL1024.2 +048000 REL-TEST-004-R. RL1024.2 +048100 ADD 5 TO WRK-CS-09V00-003. RL1024.2 +048200 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +048300 IF RL-FR1-KEY GREATER 505 RL1024.2 +048400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL1024.2 +048500 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1024.2 +048600 PERFORM FAIL RL1024.2 +048700 PERFORM PRINT-DETAIL RL1024.2 +048800 ADD 1 TO REC-CT RL1024.2 +048900 GO TO REL-TEST-004-3. RL1024.2 +049000 READ RL-FR1 RL1024.2 +049100 INVALID KEY GO TO REL-TEST-004-1. RL1024.2 +049200 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL1024.2 +049300 ADD 01 TO UPDATE-NUMBER (1). RL1024.2 +049400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1024.2 +049500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FR1R1-F-G-120. RL1024.2 +049600 REWRITE RL-FR1R1-F-G-120 RL1024.2 +049700 INVALID KEY GO TO REL-TEST-004-2. RL1024.2 +049800 GO TO REL-TEST-004-R. RL1024.2 +049900 REL-TEST-004-1. RL1024.2 +050000 IF RL-FR1-KEY LESS THAN 501 RL1024.2 +050100 ADD 1 TO WRK-CS-09V00-004 RL1024.2 +050200 GO TO REL-TEST-004-R. RL1024.2 +050300 PERFORM PASS. RL1024.2 +050400 PERFORM PRINT-DETAIL. RL1024.2 +050500* RL1024.2 +050600*01 RL1024.2 +050700* RL1024.2 +050800 ADD 1 TO REC-CT. RL1024.2 +050900 GO TO REL-TEST-004-3. RL1024.2 +051000 REL-TEST-004-2. RL1024.2 +051100 ADD 1 TO WRK-CS-09V00-005. RL1024.2 +051200 IF RL-FR1-KEY LESS 501 RL1024.2 +051300 GO TO REL-TEST-004-R. RL1024.2 +051400 REL-TEST-004-3. RL1024.2 +051500 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL1024.2 +051600 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL1024.2 +051700 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1024.2 +051800 PERFORM FAIL RL1024.2 +051900 ELSE RL1024.2 +052000 PERFORM PASS. RL1024.2 +052100 PERFORM PRINT-DETAIL. RL1024.2 +052200* RL1024.2 +052300*02 RL1024.2 +052400* RL1024.2 +052500 ADD 1 TO REC-CT. RL1024.2 +052600 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL1024.2 +052700 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL1024.2 +052800 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1024.2 +052900 PERFORM FAIL RL1024.2 +053000 ELSE RL1024.2 +053100 PERFORM PASS. RL1024.2 +053200 PERFORM PRINT-DETAIL. RL1024.2 +053300* RL1024.2 +053400*03 RL1024.2 +053500* RL1024.2 +053600 ADD 1 TO REC-CT. RL1024.2 +053700 CLOSE RL-FR1. RL1024.2 +053800 REL-INIT-005. RL1024.2 +053900 MOVE "REL-TEST-005" TO PAR-NAME. RL1024.2 +054000 OPEN INPUT RL-FR1. RL1024.2 +054100 MOVE 501 TO WRK-CS-09V00-003. RL1024.2 +054200 MOVE ZERO TO WRK-CS-09V00-004. RL1024.2 +054300 MOVE ZERO TO WRK-CS-09V00-005. RL1024.2 +054400 MOVE ZERO TO WRK-CS-09V00-002. RL1024.2 +054500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +054600 MOVE 01 TO REC-CT. RL1024.2 +054700* RL1024.2 +054800 MOVE "READ RANDOM" TO FEATURE. RL1024.2 +054900 REL-TEST-005-R. RL1024.2 +055000 SUBTRACT 1 FROM WRK-CS-09V00-003. RL1024.2 +055100 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +055200 IF WRK-CS-09V00-003 LESS THAN ZERO RL1024.2 +055300 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL1024.2 +055400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1024.2 +055500 MOVE ZERO TO CORRECT-18V0 RL1024.2 +055600 PERFORM FAIL RL1024.2 +055700 PERFORM PRINT-DETAIL RL1024.2 +055800 ADD 1 TO REC-CT RL1024.2 +055900 GO TO REL-TEST-005-3. RL1024.2 +056000 READ RL-FR1 RL1024.2 +056100 INVALID KEY GO TO REL-TEST-005-1. RL1024.2 +056200 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +056300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1024.2 +056400 ADD 1 TO WRK-CS-09V00-004. RL1024.2 +056500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1024.2 +056600 ADD 1 TO WRK-CS-09V00-005. RL1024.2 +056700 GO TO REL-TEST-005-R. RL1024.2 +056800 REL-TEST-005-1. RL1024.2 +056900 IF RL-FR1-KEY GREATER ZERO RL1024.2 +057000 ADD 1 TO WRK-CS-09V00-002 RL1024.2 +057100 GO TO REL-TEST-005-R. RL1024.2 +057200 PERFORM PASS. RL1024.2 +057300 PERFORM PRINT-DETAIL. RL1024.2 +057400 ADD 1 TO REC-CT. RL1024.2 +057500*01 RL1024.2 +057600 GO TO REL-TEST-005-3. RL1024.2 +057700 REL-TEST-005-3. RL1024.2 +057800 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL1024.2 +057900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1024.2 +058000 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1024.2 +058100 MOVE "SHOULD BE 400" TO RE-MARK RL1024.2 +058200 PERFORM FAIL RL1024.2 +058300 ELSE RL1024.2 +058400 PERFORM PASS. RL1024.2 +058500 PERFORM PRINT-DETAIL. RL1024.2 +058600* RL1024.2 +058700* RL1024.2 +058800*02 RL1024.2 +058900* RL1024.2 +059000 ADD 1 TO REC-CT. RL1024.2 +059100 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL1024.2 +059200 MOVE "UPDATED RECORDS" TO COMPUTED-A RL1024.2 +059300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1024.2 +059400 MOVE "SHOULD BE 100" TO RE-MARK RL1024.2 +059500 PERFORM FAIL RL1024.2 +059600 ELSE RL1024.2 +059700 PERFORM PASS. RL1024.2 +059800 PERFORM PRINT-DETAIL. RL1024.2 +059900* RL1024.2 +060000*03 RL1024.2 +060100* RL1024.2 +060200 ADD 1 TO REC-CT. RL1024.2 +060300 IF WRK-CS-09V00-002 GREATER 1 RL1024.2 +060400 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL1024.2 +060500 MOVE "INVALID KEY/READS" TO CORRECT-A RL1024.2 +060600 PERFORM FAIL RL1024.2 +060700 ELSE RL1024.2 +060800 PERFORM PASS. RL1024.2 +060900 PERFORM PRINT-DETAIL. RL1024.2 +061000* RL1024.2 +061100*04 RL1024.2 +061200* RL1024.2 +061300 ADD 1 TO REC-CT. RL1024.2 +061400 CLOSE RL-FR1. RL1024.2 +061500 CCVS-EXIT SECTION. RL1024.2 +061600 CCVS-999999. RL1024.2 +061700 GO TO CLOSE-FILES. RL1024.2 +*END-OF,RL102A +*HEADER,COBOL,RL101A,SUBPRG,RL103A +000100 IDENTIFICATION DIVISION. RL1034.2 +000200 PROGRAM-ID. RL1034.2 +000300 RL103A. RL1034.2 +000400**************************************************************** RL1034.2 +000500* * RL1034.2 +000600* VALIDATION FOR:- * RL1034.2 +000700* * RL1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +000900* * RL1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1034.2 +001100* * RL1034.2 +001200**************************************************************** RL1034.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL1034.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL1034.2 +001500* (ACCESS MODE IS SEQUENTIAL). THE FILE USED IS THAT RL1034.2 +001600* RESULTING FROM RL102. RL1034.2 +001700* RL1034.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL1034.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL1034.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL1034.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1034.2 +002200* RL1034.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1034.2 +002400* PROGRAM ARE: RL1034.2 +002500* RL1034.2 +002600* RL1034.2 +002700* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1034.2 +002800* RELATIVE I-O DATA FILE RL1034.2 +002900* X-55 SYSTEM PRINTER RL1034.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1034.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1034.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE RL1034.2 +003300* X-82 SOURCE-COMPUTER RL1034.2 +003400* X-83 OBJECT-COMPUTER. RL1034.2 +003500* RL1034.2 +003600**************************************************************** RL1034.2 +003700 ENVIRONMENT DIVISION. RL1034.2 +003800 CONFIGURATION SECTION. RL1034.2 +003900 SOURCE-COMPUTER. RL1034.2 +004000 XXXXX082. RL1034.2 +004100 OBJECT-COMPUTER. RL1034.2 +004200 XXXXX083. RL1034.2 +004300 INPUT-OUTPUT SECTION. RL1034.2 +004400 FILE-CONTROL. RL1034.2 +004500 SELECT PRINT-FILE ASSIGN TO RL1034.2 +004600 XXXXX055. RL1034.2 +004700 SELECT RL-FS1 ASSIGN TO RL1034.2 +004800 XXXXD021 RL1034.2 +004900 ORGANIZATION IS RELATIVE RL1034.2 +005000 ACCESS MODE IS SEQUENTIAL RL1034.2 +005100 RELATIVE KEY IS RL-FS1-KEY. RL1034.2 +005200 DATA DIVISION. RL1034.2 +005300 FILE SECTION. RL1034.2 +005400 FD PRINT-FILE. RL1034.2 +005500 01 PRINT-REC PICTURE X(120). RL1034.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL1034.2 +005700 FD RL-FS1 RL1034.2 +005800 LABEL RECORDS STANDARD RL1034.2 +005900C VALUE OF RL1034.2 +006000C XXXXX074 RL1034.2 +006100C IS RL1034.2 +006200C XXXXX075 RL1034.2 +006300G XXXXX069 RL1034.2 +006400 BLOCK CONTAINS 01 RECORDS RL1034.2 +006500 RECORD CONTAINS 120. RL1034.2 +006600 01 RL-FS1R1-F-G-120. RL1034.2 +006700 02 RL-WRK-120 PIC X(120). RL1034.2 +006800 WORKING-STORAGE SECTION. RL1034.2 +006900 01 RL-FS1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL1034.2 +007000 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007100 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007200 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007300 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007400 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007500 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007600 01 I-O-ERROR-RL-FS1 PIC X(3) VALUE "NO ". RL1034.2 +007700 01 FILE-RECORD-INFORMATION-REC. RL1034.2 +007800 03 FILE-RECORD-INFO-SKELETON. RL1034.2 +007900 05 FILLER PICTURE X(48) VALUE RL1034.2 +008000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1034.2 +008100 05 FILLER PICTURE X(46) VALUE RL1034.2 +008200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1034.2 +008300 05 FILLER PICTURE X(26) VALUE RL1034.2 +008400 ",LFIL=000000,ORG= ,LBLR= ". RL1034.2 +008500 05 FILLER PICTURE X(37) VALUE RL1034.2 +008600 ",RECKEY= ". RL1034.2 +008700 05 FILLER PICTURE X(38) VALUE RL1034.2 +008800 ",ALTKEY1= ". RL1034.2 +008900 05 FILLER PICTURE X(38) VALUE RL1034.2 +009000 ",ALTKEY2= ". RL1034.2 +009100 05 FILLER PICTURE X(7) VALUE SPACE.RL1034.2 +009200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1034.2 +009300 05 FILE-RECORD-INFO-P1-120. RL1034.2 +009400 07 FILLER PIC X(5). RL1034.2 +009500 07 XFILE-NAME PIC X(6). RL1034.2 +009600 07 FILLER PIC X(8). RL1034.2 +009700 07 XRECORD-NAME PIC X(6). RL1034.2 +009800 07 FILLER PIC X(1). RL1034.2 +009900 07 REELUNIT-NUMBER PIC 9(1). RL1034.2 +010000 07 FILLER PIC X(7). RL1034.2 +010100 07 XRECORD-NUMBER PIC 9(6). RL1034.2 +010200 07 FILLER PIC X(6). RL1034.2 +010300 07 UPDATE-NUMBER PIC 9(2). RL1034.2 +010400 07 FILLER PIC X(5). RL1034.2 +010500 07 ODO-NUMBER PIC 9(4). RL1034.2 +010600 07 FILLER PIC X(5). RL1034.2 +010700 07 XPROGRAM-NAME PIC X(5). RL1034.2 +010800 07 FILLER PIC X(7). RL1034.2 +010900 07 XRECORD-LENGTH PIC 9(6). RL1034.2 +011000 07 FILLER PIC X(7). RL1034.2 +011100 07 CHARS-OR-RECORDS PIC X(2). RL1034.2 +011200 07 FILLER PIC X(1). RL1034.2 +011300 07 XBLOCK-SIZE PIC 9(4). RL1034.2 +011400 07 FILLER PIC X(6). RL1034.2 +011500 07 RECORDS-IN-FILE PIC 9(6). RL1034.2 +011600 07 FILLER PIC X(5). RL1034.2 +011700 07 XFILE-ORGANIZATION PIC X(2). RL1034.2 +011800 07 FILLER PIC X(6). RL1034.2 +011900 07 XLABEL-TYPE PIC X(1). RL1034.2 +012000 05 FILE-RECORD-INFO-P121-240. RL1034.2 +012100 07 FILLER PIC X(8). RL1034.2 +012200 07 XRECORD-KEY PIC X(29). RL1034.2 +012300 07 FILLER PIC X(9). RL1034.2 +012400 07 ALTERNATE-KEY1 PIC X(29). RL1034.2 +012500 07 FILLER PIC X(9). RL1034.2 +012600 07 ALTERNATE-KEY2 PIC X(29). RL1034.2 +012700 07 FILLER PIC X(7). RL1034.2 +012800 01 TEST-RESULTS. RL1034.2 +012900 02 FILLER PIC X VALUE SPACE. RL1034.2 +013000 02 FEATURE PIC X(20) VALUE SPACE. RL1034.2 +013100 02 FILLER PIC X VALUE SPACE. RL1034.2 +013200 02 P-OR-F PIC X(5) VALUE SPACE. RL1034.2 +013300 02 FILLER PIC X VALUE SPACE. RL1034.2 +013400 02 PAR-NAME. RL1034.2 +013500 03 FILLER PIC X(19) VALUE SPACE. RL1034.2 +013600 03 PARDOT-X PIC X VALUE SPACE. RL1034.2 +013700 03 DOTVALUE PIC 99 VALUE ZERO. RL1034.2 +013800 02 FILLER PIC X(8) VALUE SPACE. RL1034.2 +013900 02 RE-MARK PIC X(61). RL1034.2 +014000 01 TEST-COMPUTED. RL1034.2 +014100 02 FILLER PIC X(30) VALUE SPACE. RL1034.2 +014200 02 FILLER PIC X(17) VALUE RL1034.2 +014300 " COMPUTED=". RL1034.2 +014400 02 COMPUTED-X. RL1034.2 +014500 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1034.2 +014600 03 COMPUTED-N REDEFINES COMPUTED-A RL1034.2 +014700 PIC -9(9).9(9). RL1034.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1034.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1034.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1034.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. RL1034.2 +015200 04 COMPUTED-18V0 PIC -9(18). RL1034.2 +015300 04 FILLER PIC X. RL1034.2 +015400 03 FILLER PIC X(50) VALUE SPACE. RL1034.2 +015500 01 TEST-CORRECT. RL1034.2 +015600 02 FILLER PIC X(30) VALUE SPACE. RL1034.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". RL1034.2 +015800 02 CORRECT-X. RL1034.2 +015900 03 CORRECT-A PIC X(20) VALUE SPACE. RL1034.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1034.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1034.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1034.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1034.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. RL1034.2 +016500 04 CORRECT-18V0 PIC -9(18). RL1034.2 +016600 04 FILLER PIC X. RL1034.2 +016700 03 FILLER PIC X(2) VALUE SPACE. RL1034.2 +016800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1034.2 +016900 01 CCVS-C-1. RL1034.2 +017000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1034.2 +017100- "SS PARAGRAPH-NAME RL1034.2 +017200- " REMARKS". RL1034.2 +017300 02 FILLER PIC X(20) VALUE SPACE. RL1034.2 +017400 01 CCVS-C-2. RL1034.2 +017500 02 FILLER PIC X VALUE SPACE. RL1034.2 +017600 02 FILLER PIC X(6) VALUE "TESTED". RL1034.2 +017700 02 FILLER PIC X(15) VALUE SPACE. RL1034.2 +017800 02 FILLER PIC X(4) VALUE "FAIL". RL1034.2 +017900 02 FILLER PIC X(94) VALUE SPACE. RL1034.2 +018000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1034.2 +018100 01 REC-CT PIC 99 VALUE ZERO. RL1034.2 +018200 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018300 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018500 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018600 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1034.2 +018700 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1034.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1034.2 +018900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1034.2 +019000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1034.2 +019100 01 CCVS-H-1. RL1034.2 +019200 02 FILLER PIC X(39) VALUE SPACES. RL1034.2 +019300 02 FILLER PIC X(42) VALUE RL1034.2 +019400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1034.2 +019500 02 FILLER PIC X(39) VALUE SPACES. RL1034.2 +019600 01 CCVS-H-2A. RL1034.2 +019700 02 FILLER PIC X(40) VALUE SPACE. RL1034.2 +019800 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1034.2 +019900 02 FILLER PIC XXXX VALUE RL1034.2 +020000 "4.2 ". RL1034.2 +020100 02 FILLER PIC X(28) VALUE RL1034.2 +020200 " COPY - NOT FOR DISTRIBUTION". RL1034.2 +020300 02 FILLER PIC X(41) VALUE SPACE. RL1034.2 +020400 RL1034.2 +020500 01 CCVS-H-2B. RL1034.2 +020600 02 FILLER PIC X(15) VALUE RL1034.2 +020700 "TEST RESULT OF ". RL1034.2 +020800 02 TEST-ID PIC X(9). RL1034.2 +020900 02 FILLER PIC X(4) VALUE RL1034.2 +021000 " IN ". RL1034.2 +021100 02 FILLER PIC X(12) VALUE RL1034.2 +021200 " HIGH ". RL1034.2 +021300 02 FILLER PIC X(22) VALUE RL1034.2 +021400 " LEVEL VALIDATION FOR ". RL1034.2 +021500 02 FILLER PIC X(58) VALUE RL1034.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +021700 01 CCVS-H-3. RL1034.2 +021800 02 FILLER PIC X(34) VALUE RL1034.2 +021900 " FOR OFFICIAL USE ONLY ". RL1034.2 +022000 02 FILLER PIC X(58) VALUE RL1034.2 +022100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1034.2 +022200 02 FILLER PIC X(28) VALUE RL1034.2 +022300 " COPYRIGHT 1985 ". RL1034.2 +022400 01 CCVS-E-1. RL1034.2 +022500 02 FILLER PIC X(52) VALUE SPACE. RL1034.2 +022600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1034.2 +022700 02 ID-AGAIN PIC X(9). RL1034.2 +022800 02 FILLER PIC X(45) VALUE SPACES. RL1034.2 +022900 01 CCVS-E-2. RL1034.2 +023000 02 FILLER PIC X(31) VALUE SPACE. RL1034.2 +023100 02 FILLER PIC X(21) VALUE SPACE. RL1034.2 +023200 02 CCVS-E-2-2. RL1034.2 +023300 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1034.2 +023400 03 FILLER PIC X VALUE SPACE. RL1034.2 +023500 03 ENDER-DESC PIC X(44) VALUE RL1034.2 +023600 "ERRORS ENCOUNTERED". RL1034.2 +023700 01 CCVS-E-3. RL1034.2 +023800 02 FILLER PIC X(22) VALUE RL1034.2 +023900 " FOR OFFICIAL USE ONLY". RL1034.2 +024000 02 FILLER PIC X(12) VALUE SPACE. RL1034.2 +024100 02 FILLER PIC X(58) VALUE RL1034.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +024300 02 FILLER PIC X(13) VALUE SPACE. RL1034.2 +024400 02 FILLER PIC X(15) VALUE RL1034.2 +024500 " COPYRIGHT 1985". RL1034.2 +024600 01 CCVS-E-4. RL1034.2 +024700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1034.2 +024800 02 FILLER PIC X(4) VALUE " OF ". RL1034.2 +024900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1034.2 +025000 02 FILLER PIC X(40) VALUE RL1034.2 +025100 " TESTS WERE EXECUTED SUCCESSFULLY". RL1034.2 +025200 01 XXINFO. RL1034.2 +025300 02 FILLER PIC X(19) VALUE RL1034.2 +025400 "*** INFORMATION ***". RL1034.2 +025500 02 INFO-TEXT. RL1034.2 +025600 04 FILLER PIC X(8) VALUE SPACE. RL1034.2 +025700 04 XXCOMPUTED PIC X(20). RL1034.2 +025800 04 FILLER PIC X(5) VALUE SPACE. RL1034.2 +025900 04 XXCORRECT PIC X(20). RL1034.2 +026000 02 INF-ANSI-REFERENCE PIC X(48). RL1034.2 +026100 01 HYPHEN-LINE. RL1034.2 +026200 02 FILLER PIC IS X VALUE IS SPACE. RL1034.2 +026300 02 FILLER PIC IS X(65) VALUE IS "************************RL1034.2 +026400- "*****************************************". RL1034.2 +026500 02 FILLER PIC IS X(54) VALUE IS "************************RL1034.2 +026600- "******************************". RL1034.2 +026700 01 CCVS-PGM-ID PIC X(9) VALUE RL1034.2 +026800 "RL103A". RL1034.2 +026900 PROCEDURE DIVISION. RL1034.2 +027000 CCVS1 SECTION. RL1034.2 +027100 OPEN-FILES. RL1034.2 +027200 OPEN OUTPUT PRINT-FILE. RL1034.2 +027300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1034.2 +027400 MOVE SPACE TO TEST-RESULTS. RL1034.2 +027500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1034.2 +027600 MOVE ZERO TO REC-SKL-SUB. RL1034.2 +027700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1034.2 +027800 CCVS-INIT-FILE. RL1034.2 +027900 ADD 1 TO REC-SKL-SUB. RL1034.2 +028000 MOVE FILE-RECORD-INFO-SKELETON RL1034.2 +028100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1034.2 +028200 CCVS-INIT-EXIT. RL1034.2 +028300 GO TO CCVS1-EXIT. RL1034.2 +028400 CLOSE-FILES. RL1034.2 +028500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1034.2 +028600 TERMINATE-CCVS. RL1034.2 +028700S EXIT PROGRAM. RL1034.2 +028800STERMINATE-CALL. RL1034.2 +028900 STOP RUN. RL1034.2 +029000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1034.2 +029100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1034.2 +029200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1034.2 +029300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1034.2 +029400 MOVE "****TEST DELETED****" TO RE-MARK. RL1034.2 +029500 PRINT-DETAIL. RL1034.2 +029600 IF REC-CT NOT EQUAL TO ZERO RL1034.2 +029700 MOVE "." TO PARDOT-X RL1034.2 +029800 MOVE REC-CT TO DOTVALUE. RL1034.2 +029900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1034.2 +030000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1034.2 +030100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1034.2 +030200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1034.2 +030300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1034.2 +030400 MOVE SPACE TO CORRECT-X. RL1034.2 +030500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1034.2 +030600 MOVE SPACE TO RE-MARK. RL1034.2 +030700 HEAD-ROUTINE. RL1034.2 +030800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +030900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +031000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1034.2 +031100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1034.2 +031200 COLUMN-NAMES-ROUTINE. RL1034.2 +031300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +031400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +031500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +031600 END-ROUTINE. RL1034.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1034.2 +031800 END-RTN-EXIT. RL1034.2 +031900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +032000 END-ROUTINE-1. RL1034.2 +032100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1034.2 +032200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1034.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. RL1034.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1034.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1034.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1034.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1034.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1034.2 +032900 END-ROUTINE-12. RL1034.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1034.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1034.2 +033200 MOVE "NO " TO ERROR-TOTAL RL1034.2 +033300 ELSE RL1034.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1034.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1034.2 +033600 PERFORM WRITE-LINE. RL1034.2 +033700 END-ROUTINE-13. RL1034.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1034.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE RL1034.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1034.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1034.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO RL1034.2 +034400 MOVE "NO " TO ERROR-TOTAL RL1034.2 +034500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1034.2 +034600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1034.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034900 WRITE-LINE. RL1034.2 +035000 ADD 1 TO RECORD-COUNT. RL1034.2 +035100Y IF RECORD-COUNT GREATER 50 RL1034.2 +035200Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1034.2 +035300Y MOVE SPACE TO DUMMY-RECORD RL1034.2 +035400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1034.2 +035500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1034.2 +035600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1034.2 +035700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1034.2 +035800Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1034.2 +035900Y MOVE ZERO TO RECORD-COUNT. RL1034.2 +036000 PERFORM WRT-LN. RL1034.2 +036100 WRT-LN. RL1034.2 +036200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1034.2 +036300 MOVE SPACE TO DUMMY-RECORD. RL1034.2 +036400 BLANK-LINE-PRINT. RL1034.2 +036500 PERFORM WRT-LN. RL1034.2 +036600 FAIL-ROUTINE. RL1034.2 +036700 IF COMPUTED-X NOT EQUAL TO SPACE RL1034.2 +036800 GO TO FAIL-ROUTINE-WRITE. RL1034.2 +036900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1034.2 +037000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1034.2 +037100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1034.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +037300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1034.2 +037400 GO TO FAIL-ROUTINE-EX. RL1034.2 +037500 FAIL-ROUTINE-WRITE. RL1034.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1034.2 +037700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1034.2 +037800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1034.2 +037900 MOVE SPACES TO COR-ANSI-REFERENCE. RL1034.2 +038000 FAIL-ROUTINE-EX. EXIT. RL1034.2 +038100 BAIL-OUT. RL1034.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1034.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1034.2 +038400 BAIL-OUT-WRITE. RL1034.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1034.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1034.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1034.2 +038900 BAIL-OUT-EX. EXIT. RL1034.2 +039000 CCVS1-EXIT. RL1034.2 +039100 EXIT. RL1034.2 +039200 SECT-RL103-001 SECTION. RL1034.2 +039300 REL-INIT-006. RL1034.2 +039400 MOVE 99 TO RL-FS1-KEY. RL1034.2 +039500* THIS FILE "RL-FS1" IS ACCESSED SEQUENTIALLY AND HAS RL1034.2 +039600* ASSOCIATED WITH IT A RELATIVE KEY WHICH AT ALL TIMES SHOULD RL1034.2 +039700* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL1034.2 +039800 OPEN INPUT RL-FS1. RL1034.2 +039900 MOVE "REL-TEST-006" TO PAR-NAME. RL1034.2 +040000 MOVE ZERO TO WRK-CS-09V00-006. RL1034.2 +040100 MOVE ZERO TO WRK-CS-09V00-007. RL1034.2 +040200 MOVE ZERO TO WRK-CS-09V00-008. RL1034.2 +040300 MOVE ZERO TO WRK-CS-09V00-009. RL1034.2 +040400 MOVE ZERO TO WRK-CS-09V00-010. RL1034.2 +040500 MOVE ZERO TO WRK-CS-09V00-011. RL1034.2 +040600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +040700 MOVE RL-FS1-KEY TO WRK-CS-09V00-011. RL1034.2 +040800 MOVE 01 TO REC-CT. RL1034.2 +040900 MOVE "READ SEQUENTIAL" TO FEATURE. RL1034.2 +041000 REL-TEST-006-R. RL1034.2 +041100 ADD 1 TO WRK-CS-09V00-006. RL1034.2 +041200 READ RL-FS1 RL1034.2 +041300 AT END GO TO REL-TEST-006-3. RL1034.2 +041400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +041500 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1034.2 +041600 ADD 1 TO WRK-CS-09V00-007 RL1034.2 +041700 GO TO REL-TEST-006-2. RL1034.2 +041800 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1034.2 +041900 ADD 1 TO WRK-CS-09V00-008 RL1034.2 +042000 GO TO REL-TEST-006-2. RL1034.2 +042100 ADD 1 TO WRK-CS-09V00-009. RL1034.2 +042200 REL-TEST-006-2. RL1034.2 +042300 IF RL-FS1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL1034.2 +042400 ADD 1 TO WRK-CS-09V00-010. RL1034.2 +042500 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +042600 GO TO REL-TEST-006-3. RL1034.2 +042700 GO TO REL-TEST-006-R. RL1034.2 +042800 REL-TEST-006-3. RL1034.2 +042900 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1034.2 +043000 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1034.2 +043100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +043200 MOVE 501 TO CORRECT-18V0 RL1034.2 +043300 PERFORM FAIL RL1034.2 +043400 ELSE RL1034.2 +043500 PERFORM PASS. RL1034.2 +043600 PERFORM PRINT-DETAIL. RL1034.2 +043700* .01 RL1034.2 +043800 ADD 1 TO REC-CT. RL1034.2 +043900 IF WRK-CS-09V00-007 EQUAL TO 400 RL1034.2 +044000 PERFORM PASS RL1034.2 +044100 ELSE RL1034.2 +044200 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1034.2 +044300 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL1034.2 +044400 MOVE "SHOULD BE 400" TO RE-MARK RL1034.2 +044500 PERFORM FAIL. RL1034.2 +044600 PERFORM PRINT-DETAIL. RL1034.2 +044700 ADD 1 TO REC-CT. RL1034.2 +044800* .02 RL1034.2 +044900 IF WRK-CS-09V00-008 EQUAL TO 100 RL1034.2 +045000 PERFORM PASS RL1034.2 +045100 ELSE RL1034.2 +045200 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1034.2 +045300 MOVE 100 TO CORRECT-18V0 RL1034.2 +045400 MOVE "UPDATED RECORDS" TO RE-MARK RL1034.2 +045500 PERFORM FAIL. RL1034.2 +045600 PERFORM PRINT-DETAIL. RL1034.2 +045700 ADD 1 TO REC-CT. RL1034.2 +045800* .03 RL1034.2 +045900 IF WRK-CS-09V00-009 EQUAL TO ZERO RL1034.2 +046000 PERFORM PASS RL1034.2 +046100 ELSE RL1034.2 +046200 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1034.2 +046300 MOVE ZERO TO CORRECT-18V0 RL1034.2 +046400 MOVE "BAD-UPDATES" TO RE-MARK RL1034.2 +046500 PERFORM FAIL. RL1034.2 +046600 PERFORM PRINT-DETAIL. RL1034.2 +046700 ADD 01 TO REC-CT. RL1034.2 +046800* .04 RL1034.2 +046900 IF WRK-CS-09V00-010 EQUAL TO ZERO RL1034.2 +047000 PERFORM PASS RL1034.2 +047100 ELSE RL1034.2 +047200 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1034.2 +047300 MOVE ZERO TO CORRECT-18V0 RL1034.2 +047400 MOVE "KEY VS RECORD" TO RE-MARK RL1034.2 +047500 PERFORM FAIL. RL1034.2 +047600 PERFORM PRINT-DETAIL. RL1034.2 +047700 ADD 01 TO REC-CT. RL1034.2 +047800* .05 RL1034.2 +047900 MOVE WRK-CS-09V00-011 TO RL-FS1-KEY. RL1034.2 +048000 MOVE RL-FS1-KEY TO COMPUTED-18V0. RL1034.2 +048100 MOVE "INFORMATION" TO CORRECT-A. RL1034.2 +048200 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL1034.2 +048300 PERFORM PRINT-DETAIL. RL1034.2 +048400 ADD 01 TO REC-CT. RL1034.2 +048500* .06 RL1034.2 +048600 CLOSE RL-FS1. RL1034.2 +048700 REL-INIT-007. RL1034.2 +048800 MOVE "REL-TEST-007" TO PAR-NAME RL1034.2 +048900 OPEN I-O RL-FS1. RL1034.2 +049000 MOVE ZERO TO WRK-CS-09V00-006 RL1034.2 +049100 MOVE ZERO TO WRK-CS-09V00-007 RL1034.2 +049200 MOVE ZERO TO WRK-CS-09V00-008 RL1034.2 +049300 MOVE ZERO TO WRK-CS-09V00-009 RL1034.2 +049400 MOVE ZERO TO WRK-CS-09V00-010 RL1034.2 +049500 MOVE ZERO TO WRK-CS-09V00-011 RL1034.2 +049600 MOVE 01 TO REC-CT. RL1034.2 +049700 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +049800 MOVE "DELETE" TO FEATURE. RL1034.2 +049900 REL-TEST-007-R. RL1034.2 +050000 ADD 1 TO WRK-CS-09V00-006 RL1034.2 +050100 ADD 1 TO WRK-CS-09V00-007. RL1034.2 +050200 READ RL-FS1 RL1034.2 +050300 AT END RL1034.2 +050400 MOVE "AT END PATH TAKEN " TO RE-MARK RL1034.2 +050500 GO TO REL-TEST-007-3. RL1034.2 +050600 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +050700 IF WRK-CS-09V00-007 EQUAL TO 4 RL1034.2 +050800 GO TO REL-TEST-007-2. RL1034.2 +050900 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +051000 MOVE "AT END NOT TAKEN" TO RE-MARK RL1034.2 +051100 GO TO REL-TEST-007-3. RL1034.2 +051200 GO TO REL-TEST-007-R. RL1034.2 +051300 REL-TEST-007-2. RL1034.2 +051400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1034.2 +051500 MOVE 99 TO UPDATE-NUMBER (1). RL1034.2 +051600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1034.2 +051700 DELETE RL-FS1. RL1034.2 +051800 MOVE ZERO TO WRK-CS-09V00-007. RL1034.2 +051900 ADD 1 TO WRK-CS-09V00-008 RL1034.2 +052000 GO TO REL-TEST-007-R. RL1034.2 +052100 REL-TEST-007-3. RL1034.2 +052200 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1034.2 +052300 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +052400 MOVE 501 TO CORRECT-18V0 RL1034.2 +052500 PERFORM FAIL RL1034.2 +052600 ELSE RL1034.2 +052700 PERFORM PASS. RL1034.2 +052800 PERFORM PRINT-DETAIL. RL1034.2 +052900 ADD 01 TO REC-CT. RL1034.2 +053000* .01 RL1034.2 +053100 IF WRK-CS-09V00-008 NOT EQUAL TO 125 RL1034.2 +053200 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1034.2 +053300 MOVE 125 TO CORRECT-18V0 RL1034.2 +053400 MOVE "DELETED RECORDS" TO RE-MARK RL1034.2 +053500 PERFORM FAIL RL1034.2 +053600 ELSE RL1034.2 +053700 PERFORM PASS. RL1034.2 +053800 PERFORM PRINT-DETAIL. RL1034.2 +053900 ADD 01 TO REC-CT. RL1034.2 +054000* .02 RL1034.2 +054100 CLOSE RL-FS1. RL1034.2 +054200 REL-INIT-008. RL1034.2 +054300 MOVE "REL-TEST-008" TO PAR-NAME. RL1034.2 +054400 MOVE ZERO TO WRK-CS-09V00-006 RL1034.2 +054500 MOVE ZERO TO WRK-CS-09V00-007 RL1034.2 +054600 MOVE ZERO TO WRK-CS-09V00-008 RL1034.2 +054700 MOVE ZERO TO WRK-CS-09V00-009 RL1034.2 +054800 MOVE ZERO TO WRK-CS-09V00-010 RL1034.2 +054900 MOVE ZERO TO WRK-CS-09V00-011 RL1034.2 +055000 MOVE 01 TO REC-CT. RL1034.2 +055100 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +055200 MOVE ZERO TO RL-FS1-KEY. RL1034.2 +055300 OPEN INPUT RL-FS1. RL1034.2 +055400 MOVE "READ UPDATED FILE" TO FEATURE. RL1034.2 +055500 REL-TEST-008-R. RL1034.2 +055600 ADD 1 TO WRK-CS-09V00-006. RL1034.2 +055700 ADD 1 TO WRK-CS-09V00-007. RL1034.2 +055800 ADD 1 TO WRK-CS-09V00-008. RL1034.2 +055900 READ RL-FS1 AT END GO TO REL-TEST-008-3. RL1034.2 +056000 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +056100 IF UPDATE-NUMBER (1) EQUAL TO 99 RL1034.2 +056200 ADD 1 TO WRK-CS-09V00-009. RL1034.2 +056300 IF WRK-CS-09V00-007 EQUAL TO 4 RL1034.2 +056400 MOVE 01 TO WRK-CS-09V00-007 RL1034.2 +056500 ADD 1 TO WRK-CS-09V00-008. RL1034.2 +056600 IF RL-FS1-KEY EQUAL TO XRECORD-NUMBER (1) RL1034.2 +056700 ADD 1 TO WRK-CS-09V00-010. RL1034.2 +056800 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL1034.2 +056900 ADD 1 TO WRK-CS-09V00-011. RL1034.2 +057000 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +057100 GO TO REL-TEST-008-3. RL1034.2 +057200 GO TO REL-TEST-008-R. RL1034.2 +057300 REL-TEST-008-3. RL1034.2 +057400 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL1034.2 +057500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1034.2 +057600 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +057700 MOVE 376 TO CORRECT-18V0 RL1034.2 +057800 PERFORM FAIL RL1034.2 +057900 ELSE RL1034.2 +058000 PERFORM PASS. RL1034.2 +058100 PERFORM PRINT-DETAIL. RL1034.2 +058200 ADD 01 TO REC-CT. RL1034.2 +058300* .01 RL1034.2 +058400 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL1034.2 +058500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1034.2 +058600 MOVE ZERO TO CORRECT-18V0 RL1034.2 +058700 MOVE "DELETED RECORDS" TO RE-MARK RL1034.2 +058800 PERFORM FAIL RL1034.2 +058900 ELSE RL1034.2 +059000 PERFORM PASS. RL1034.2 +059100 PERFORM PRINT-DETAIL. RL1034.2 +059200 ADD 01 TO REC-CT. RL1034.2 +059300* .02 RL1034.2 +059400 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL1034.2 +059500 MOVE "KEY MISMATCH" TO RE-MARK RL1034.2 +059600 MOVE 375 TO CORRECT-18V0 RL1034.2 +059700 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1034.2 +059800 PERFORM FAIL RL1034.2 +059900 ELSE RL1034.2 +060000 PERFORM PASS. RL1034.2 +060100 PERFORM PRINT-DETAIL. RL1034.2 +060200 ADD 01 TO REC-CT. RL1034.2 +060300* .03 RL1034.2 +060400 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL1034.2 +060500 MOVE 375 TO CORRECT-18V0 RL1034.2 +060600 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL1034.2 +060700 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL1034.2 +060800 PERFORM FAIL RL1034.2 +060900 ELSE RL1034.2 +061000 PERFORM PASS. RL1034.2 +061100 PERFORM PRINT-DETAIL. RL1034.2 +061200*04 RL1034.2 +061300 CLOSE RL-FS1. RL1034.2 +061400 CCVS-EXIT SECTION. RL1034.2 +061500 CCVS-999999. RL1034.2 +061600 GO TO CLOSE-FILES. RL1034.2 +*END-OF,RL103A +*HEADER,COBOL,RL104A +000100 IDENTIFICATION DIVISION. RL1044.2 +000200 PROGRAM-ID. RL1044.2 +000300 RL104A. RL1044.2 +000400**************************************************************** RL1044.2 +000500* * RL1044.2 +000600* VALIDATION FOR:- * RL1044.2 +000700* * RL1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +000900* * RL1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1044.2 +001100* * RL1044.2 +001200**************************************************************** RL1044.2 +001300* * RL1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1044.2 +001500* * RL1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1044.2 +001900* * RL1044.2 +002000**************************************************************** RL1044.2 +002100* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1044.2 +002200* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING RL1044.2 +002300* ELEMENTS: RL1044.2 +002400* RL1044.2 +002500* (1) FILE STATUS RL1044.2 +002600* (2) USE AFTER EXCEPTION PROCEDURE ON FILE-NAME RL1044.2 +002700* (3) READ RL1044.2 +002800* (4) WRITE RL1044.2 +002900* (5) REWRITE RL1044.2 +003000* (6) RELATIVE KEY RL1044.2 +003100* (7) ACCESS MODE RL1044.2 +003200* RL1044.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1044.2 +003400* (ACCESS MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RL1044.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1044.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1044.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1044.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1044.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1044.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1044.2 +004100* HAS BEEN SPECIFIED. RL1044.2 +004200* RL1044.2 +004300**************************************************************** RL1044.2 +004400 ENVIRONMENT DIVISION. RL1044.2 +004500 CONFIGURATION SECTION. RL1044.2 +004600 SOURCE-COMPUTER. RL1044.2 +004700 XXXXX082. RL1044.2 +004800 OBJECT-COMPUTER. RL1044.2 +004900 XXXXX083. RL1044.2 +005000 INPUT-OUTPUT SECTION. RL1044.2 +005100 FILE-CONTROL. RL1044.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1044.2 +005300 XXXXX055. RL1044.2 +005400 SELECT RL-FS2 ASSIGN RL1044.2 +005500 XXXXX022 RL1044.2 +005600 ORGANIZATION RELATIVE RL1044.2 +005700 ACCESS SEQUENTIAL RL1044.2 +005800 RELATIVE RL-FS2-KEY RL1044.2 +005900 FILE STATUS IS RL-FS2-STATUS. RL1044.2 +006000 DATA DIVISION. RL1044.2 +006100 FILE SECTION. RL1044.2 +006200 FD PRINT-FILE. RL1044.2 +006300 01 PRINT-REC PICTURE X(120). RL1044.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1044.2 +006500 FD RL-FS2 RL1044.2 +006600C VALUE OF RL1044.2 +006700C XXXXX074 RL1044.2 +006800C IS RL1044.2 +006900C XXXXX076 RL1044.2 +007000G XXXXX069 RL1044.2 +007100 LABEL RECORDS ARE STANDARD RL1044.2 +007200 BLOCK CONTAINS 1 RECORDS RL1044.2 +007300 DATA RECORD RL-FS2R1-F-G-240. RL1044.2 +007400 01 RL-FS2R1-F-G-240. RL1044.2 +007500 05 RL-FS2-WRK-120 PIC X(120). RL1044.2 +007600 05 RL-FS2-GRP-120. RL1044.2 +007700 10 RL-FS2-WRK-XN-0001-O120F RL1044.2 +007800 PICTURE X OCCURS 120 TIMES. RL1044.2 +007900 WORKING-STORAGE SECTION. RL1044.2 +008000 01 GRP-0001. RL1044.2 +008100 05 RL-FS2-KEY PIC 9(8) VALUE ZERO. RL1044.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008900 05 RL-FS2-STATUS PIC XX VALUE SPACE. RL1044.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1044.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1044.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1044.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1044.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1044.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1044.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1044.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1044.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1044.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1044.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1044.2 +010100 05 FILLER PICTURE X(48) VALUE RL1044.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1044.2 +010300 05 FILLER PICTURE X(46) VALUE RL1044.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1044.2 +010500 05 FILLER PICTURE X(26) VALUE RL1044.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1044.2 +010700 05 FILLER PICTURE X(37) VALUE RL1044.2 +010800 ",RECKEY= ". RL1044.2 +010900 05 FILLER PICTURE X(38) VALUE RL1044.2 +011000 ",ALTKEY1= ". RL1044.2 +011100 05 FILLER PICTURE X(38) VALUE RL1044.2 +011200 ",ALTKEY2= ". RL1044.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1044.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1044.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1044.2 +011600 07 FILLER PIC X(5). RL1044.2 +011700 07 XFILE-NAME PIC X(6). RL1044.2 +011800 07 FILLER PIC X(8). RL1044.2 +011900 07 XRECORD-NAME PIC X(6). RL1044.2 +012000 07 FILLER PIC X(1). RL1044.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1044.2 +012200 07 FILLER PIC X(7). RL1044.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1044.2 +012400 07 FILLER PIC X(6). RL1044.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1044.2 +012600 07 FILLER PIC X(5). RL1044.2 +012700 07 ODO-NUMBER PIC 9(4). RL1044.2 +012800 07 FILLER PIC X(5). RL1044.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1044.2 +013000 07 FILLER PIC X(7). RL1044.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1044.2 +013200 07 FILLER PIC X(7). RL1044.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1044.2 +013400 07 FILLER PIC X(1). RL1044.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1044.2 +013600 07 FILLER PIC X(6). RL1044.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1044.2 +013800 07 FILLER PIC X(5). RL1044.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1044.2 +014000 07 FILLER PIC X(6). RL1044.2 +014100 07 XLABEL-TYPE PIC X(1). RL1044.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1044.2 +014300 07 FILLER PIC X(8). RL1044.2 +014400 07 XRECORD-KEY PIC X(29). RL1044.2 +014500 07 FILLER PIC X(9). RL1044.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1044.2 +014700 07 FILLER PIC X(9). RL1044.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1044.2 +014900 07 FILLER PIC X(7). RL1044.2 +015000 01 TEST-RESULTS. RL1044.2 +015100 02 FILLER PIC X VALUE SPACE. RL1044.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1044.2 +015300 02 FILLER PIC X VALUE SPACE. RL1044.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1044.2 +015500 02 FILLER PIC X VALUE SPACE. RL1044.2 +015600 02 PAR-NAME. RL1044.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1044.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1044.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1044.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1044.2 +016100 02 RE-MARK PIC X(61). RL1044.2 +016200 01 TEST-COMPUTED. RL1044.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1044.2 +016400 02 FILLER PIC X(17) VALUE RL1044.2 +016500 " COMPUTED=". RL1044.2 +016600 02 COMPUTED-X. RL1044.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1044.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1044.2 +016900 PIC -9(9).9(9). RL1044.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1044.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1044.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1044.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1044.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1044.2 +017500 04 FILLER PIC X. RL1044.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1044.2 +017700 01 TEST-CORRECT. RL1044.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1044.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1044.2 +018000 02 CORRECT-X. RL1044.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1044.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1044.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1044.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1044.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1044.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1044.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1044.2 +018800 04 FILLER PIC X. RL1044.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1044.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1044.2 +019100 01 CCVS-C-1. RL1044.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1044.2 +019300- "SS PARAGRAPH-NAME RL1044.2 +019400- " REMARKS". RL1044.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1044.2 +019600 01 CCVS-C-2. RL1044.2 +019700 02 FILLER PIC X VALUE SPACE. RL1044.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1044.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1044.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1044.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1044.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1044.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1044.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1044.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1044.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1044.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1044.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1044.2 +021300 01 CCVS-H-1. RL1044.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1044.2 +021500 02 FILLER PIC X(42) VALUE RL1044.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1044.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1044.2 +021800 01 CCVS-H-2A. RL1044.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1044.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1044.2 +022100 02 FILLER PIC XXXX VALUE RL1044.2 +022200 "4.2 ". RL1044.2 +022300 02 FILLER PIC X(28) VALUE RL1044.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1044.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1044.2 +022600 RL1044.2 +022700 01 CCVS-H-2B. RL1044.2 +022800 02 FILLER PIC X(15) VALUE RL1044.2 +022900 "TEST RESULT OF ". RL1044.2 +023000 02 TEST-ID PIC X(9). RL1044.2 +023100 02 FILLER PIC X(4) VALUE RL1044.2 +023200 " IN ". RL1044.2 +023300 02 FILLER PIC X(12) VALUE RL1044.2 +023400 " HIGH ". RL1044.2 +023500 02 FILLER PIC X(22) VALUE RL1044.2 +023600 " LEVEL VALIDATION FOR ". RL1044.2 +023700 02 FILLER PIC X(58) VALUE RL1044.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +023900 01 CCVS-H-3. RL1044.2 +024000 02 FILLER PIC X(34) VALUE RL1044.2 +024100 " FOR OFFICIAL USE ONLY ". RL1044.2 +024200 02 FILLER PIC X(58) VALUE RL1044.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1044.2 +024400 02 FILLER PIC X(28) VALUE RL1044.2 +024500 " COPYRIGHT 1985 ". RL1044.2 +024600 01 CCVS-E-1. RL1044.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1044.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1044.2 +024900 02 ID-AGAIN PIC X(9). RL1044.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1044.2 +025100 01 CCVS-E-2. RL1044.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1044.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1044.2 +025400 02 CCVS-E-2-2. RL1044.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1044.2 +025600 03 FILLER PIC X VALUE SPACE. RL1044.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1044.2 +025800 "ERRORS ENCOUNTERED". RL1044.2 +025900 01 CCVS-E-3. RL1044.2 +026000 02 FILLER PIC X(22) VALUE RL1044.2 +026100 " FOR OFFICIAL USE ONLY". RL1044.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1044.2 +026300 02 FILLER PIC X(58) VALUE RL1044.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1044.2 +026600 02 FILLER PIC X(15) VALUE RL1044.2 +026700 " COPYRIGHT 1985". RL1044.2 +026800 01 CCVS-E-4. RL1044.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1044.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1044.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1044.2 +027200 02 FILLER PIC X(40) VALUE RL1044.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1044.2 +027400 01 XXINFO. RL1044.2 +027500 02 FILLER PIC X(19) VALUE RL1044.2 +027600 "*** INFORMATION ***". RL1044.2 +027700 02 INFO-TEXT. RL1044.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1044.2 +027900 04 XXCOMPUTED PIC X(20). RL1044.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1044.2 +028100 04 XXCORRECT PIC X(20). RL1044.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1044.2 +028300 01 HYPHEN-LINE. RL1044.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1044.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1044.2 +028600- "*****************************************". RL1044.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1044.2 +028800- "******************************". RL1044.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1044.2 +029000 "RL104A". RL1044.2 +029100 PROCEDURE DIVISION. RL1044.2 +029200 DECLARATIVES. RL1044.2 +029300 RL-FS2-01 SECTION. RL1044.2 +029400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS2. RL1044.2 +029500 RL-FS2-01-01. RL1044.2 +029600 ADD 1 TO WRK-CS-09V00-013. RL1044.2 +029700 GO TO RL-FS2-01-03 RL1044.2 +029800 RL-FS2-01-05 RL1044.2 +029900 DEPENDING ON WRK-CS-09V00-012. RL1044.2 +030000 GO TO RL-FS2-01-EXIT. RL1044.2 +030100 RL-FS2-01-03. RL1044.2 +030200*ENTRY FROM SEGMENT REL-TEST-009. RL1044.2 +030300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1044.2 +030400 ADD 1 TO WRK-CS-09V00-014. RL1044.2 +030500 RL-FS2-01-05. RL1044.2 +030600 ADD 1 TO WRK-CS-09V00-017. RL1044.2 +030700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1044.2 +030800 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1044.2 +030900 MOVE "10" TO WRK-XN-0002-003. RL1044.2 +031000 RL-FS2-01-EXIT. RL1044.2 +031100 EXIT. RL1044.2 +031200 END DECLARATIVES. RL1044.2 +031300 CCVS1 SECTION. RL1044.2 +031400 OPEN-FILES. RL1044.2 +031500 OPEN OUTPUT PRINT-FILE. RL1044.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1044.2 +031700 MOVE SPACE TO TEST-RESULTS. RL1044.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1044.2 +031900 MOVE ZERO TO REC-SKL-SUB. RL1044.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. RL1044.2 +032100 CCVS-INIT-FILE. RL1044.2 +032200 ADD 1 TO REC-SKL-SUB. RL1044.2 +032300 MOVE FILE-RECORD-INFO-SKELETON RL1044.2 +032400 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1044.2 +032500 CCVS-INIT-EXIT. RL1044.2 +032600 GO TO CCVS1-EXIT. RL1044.2 +032700 CLOSE-FILES. RL1044.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1044.2 +032900 TERMINATE-CCVS. RL1044.2 +033000S EXIT PROGRAM. RL1044.2 +033100STERMINATE-CALL. RL1044.2 +033200 STOP RUN. RL1044.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1044.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1044.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1044.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1044.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. RL1044.2 +033800 PRINT-DETAIL. RL1044.2 +033900 IF REC-CT NOT EQUAL TO ZERO RL1044.2 +034000 MOVE "." TO PARDOT-X RL1044.2 +034100 MOVE REC-CT TO DOTVALUE. RL1044.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1044.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1044.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1044.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1044.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1044.2 +034700 MOVE SPACE TO CORRECT-X. RL1044.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1044.2 +034900 MOVE SPACE TO RE-MARK. RL1044.2 +035000 HEAD-ROUTINE. RL1044.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1044.2 +035400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1044.2 +035500 COLUMN-NAMES-ROUTINE. RL1044.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +035900 END-ROUTINE. RL1044.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1044.2 +036100 END-RTN-EXIT. RL1044.2 +036200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +036300 END-ROUTINE-1. RL1044.2 +036400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1044.2 +036500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1044.2 +036600 ADD PASS-COUNTER TO ERROR-HOLD. RL1044.2 +036700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1044.2 +036800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1044.2 +036900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1044.2 +037000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1044.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1044.2 +037200 END-ROUTINE-12. RL1044.2 +037300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1044.2 +037400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1044.2 +037500 MOVE "NO " TO ERROR-TOTAL RL1044.2 +037600 ELSE RL1044.2 +037700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1044.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1044.2 +037900 PERFORM WRITE-LINE. RL1044.2 +038000 END-ROUTINE-13. RL1044.2 +038100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1044.2 +038200 MOVE "NO " TO ERROR-TOTAL ELSE RL1044.2 +038300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1044.2 +038400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1044.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +038600 IF INSPECT-COUNTER EQUAL TO ZERO RL1044.2 +038700 MOVE "NO " TO ERROR-TOTAL RL1044.2 +038800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1044.2 +038900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1044.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +039100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +039200 WRITE-LINE. RL1044.2 +039300 ADD 1 TO RECORD-COUNT. RL1044.2 +039400Y IF RECORD-COUNT GREATER 50 RL1044.2 +039500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1044.2 +039600Y MOVE SPACE TO DUMMY-RECORD RL1044.2 +039700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1044.2 +039800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1044.2 +039900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1044.2 +040000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1044.2 +040100Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1044.2 +040200Y MOVE ZERO TO RECORD-COUNT. RL1044.2 +040300 PERFORM WRT-LN. RL1044.2 +040400 WRT-LN. RL1044.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1044.2 +040600 MOVE SPACE TO DUMMY-RECORD. RL1044.2 +040700 BLANK-LINE-PRINT. RL1044.2 +040800 PERFORM WRT-LN. RL1044.2 +040900 FAIL-ROUTINE. RL1044.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE RL1044.2 +041100 GO TO FAIL-ROUTINE-WRITE. RL1044.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1044.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1044.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1044.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1044.2 +041700 GO TO FAIL-ROUTINE-EX. RL1044.2 +041800 FAIL-ROUTINE-WRITE. RL1044.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1044.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1044.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1044.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1044.2 +042300 FAIL-ROUTINE-EX. EXIT. RL1044.2 +042400 BAIL-OUT. RL1044.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1044.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1044.2 +042700 BAIL-OUT-WRITE. RL1044.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1044.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1044.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1044.2 +043200 BAIL-OUT-EX. EXIT. RL1044.2 +043300 CCVS1-EXIT. RL1044.2 +043400 EXIT. RL1044.2 +043500 SECT-RL-04-001 SECTION. RL1044.2 +043600 REL-INIT-009. RL1044.2 +043700 MOVE "REL-TEST-009" TO PAR-NAME. RL1044.2 +043800 MOVE "CREATE RL-FS2" TO FEATURE RL1044.2 +043900 MOVE "RL-FS2" TO XFILE-NAME (2). RL1044.2 +044000 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1044.2 +044100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1044.2 +044200 MOVE 000240 TO XRECORD-LENGTH (2). RL1044.2 +044300 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1044.2 +044400 MOVE 0001 TO XBLOCK-SIZE (2). RL1044.2 +044500 MOVE 000500 TO RECORDS-IN-FILE (2). RL1044.2 +044600 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1044.2 +044700 MOVE "S" TO XLABEL-TYPE (2). RL1044.2 +044800 MOVE 000001 TO XRECORD-NUMBER (2). RL1044.2 +044900*INITIALIZE RECORD WORK AREA NUMBER 2. RL1044.2 +045000 MOVE 1 TO WRK-CS-09V00-012. RL1044.2 +045100 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1044.2 +045200 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1044.2 +045300 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1044.2 +045400 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +045500 MOVE 90000002 TO RL-FS2-KEY. RL1044.2 +045600 MOVE 01 TO REC-CT. RL1044.2 +045700 OPEN OUTPUT RL-FS2. RL1044.2 +045800 MOVE RL-FS2-STATUS TO WRK-XN-0002-001. RL1044.2 +045900*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1044.2 +046000 REL-TEST-009-R. RL1044.2 +046100 MOVE "99" TO RL-FS2-STATUS. RL1044.2 +046200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120. RL1044.2 +046300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1044.2 +046400 RL-FS2-GRP-120. RL1044.2 +046500 WRITE RL-FS2R1-F-G-240. RL1044.2 +046600 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +046700 GO TO REL-TEST-009-2. RL1044.2 +046800 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1044.2 +046900 GO TO REL-TEST-009-2. RL1044.2 +047000 ADD 01 TO XRECORD-NUMBER (2). RL1044.2 +047100 GO TO REL-TEST-009-R. RL1044.2 +047200 REL-TEST-009-2. RL1044.2 +047300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1044.2 +047400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1044.2 +047500 MOVE ZERO TO CORRECT-18V0 RL1044.2 +047600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1044.2 +047700 PERFORM FAIL RL1044.2 +047800 ELSE RL1044.2 +047900 PERFORM PASS. RL1044.2 +048000 PERFORM PRINT-DETAIL. RL1044.2 +048100 ADD 01 TO REC-CT. RL1044.2 +048200* .01 RL1044.2 +048300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1044.2 +048400 MOVE "INCORRECT COUNT" TO RE-MARK RL1044.2 +048500 MOVE 500 TO CORRECT-18V0 RL1044.2 +048600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1044.2 +048700 PERFORM FAIL RL1044.2 +048800 ELSE RL1044.2 +048900 PERFORM PASS. RL1044.2 +049000 PERFORM PRINT-DETAIL. RL1044.2 +049100 ADD 01 TO REC-CT. RL1044.2 +049200* .02 RL1044.2 +049300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1044.2 +049400 MOVE "STATUS/OPEN" TO RE-MARK RL1044.2 +049500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1044.2 +049600 MOVE "00" TO CORRECT-A RL1044.2 +049700 PERFORM FAIL RL1044.2 +049800 ELSE RL1044.2 +049900 PERFORM PASS. RL1044.2 +050000 PERFORM PRINT-DETAIL. RL1044.2 +050100 ADD 01 TO REC-CT. RL1044.2 +050200* .03 RL1044.2 +050300 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +050400 MOVE "STATUS/WRITE" TO RE-MARK RL1044.2 +050500 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +050600 MOVE "00" TO CORRECT-A RL1044.2 +050700 PERFORM FAIL RL1044.2 +050800 ELSE RL1044.2 +050900 PERFORM PASS. RL1044.2 +051000 PERFORM PRINT-DETAIL. RL1044.2 +051100 ADD 01 TO REC-CT. RL1044.2 +051200* .04 RL1044.2 +051300 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +051400 CLOSE RL-FS2. RL1044.2 +051500 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +051600 MOVE "CLOSE/STATUS" TO RE-MARK RL1044.2 +051700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +051800 MOVE "00" TO CORRECT-A RL1044.2 +051900 PERFORM FAIL RL1044.2 +052000 ELSE RL1044.2 +052100 PERFORM PASS. RL1044.2 +052200 PERFORM PRINT-DETAIL. RL1044.2 +052300 ADD 01 TO REC-CT. RL1044.2 +052400* .05 RL1044.2 +052500 REL-INIT-010. RL1044.2 +052600 MOVE "REL-TEST-010" TO PAR-NAME. RL1044.2 +052700 MOVE 2 TO WRK-CS-09V00-012. RL1044.2 +052800 MOVE ZERO TO WRK-CS-09V00-013. RL1044.2 +052900 MOVE ZERO TO WRK-CS-09V00-014. RL1044.2 +053000 MOVE ZERO TO WRK-CS-09V00-015. RL1044.2 +053100 MOVE ZERO TO WRK-CS-09V00-016. RL1044.2 +053200 MOVE ZERO TO WRK-CS-09V00-017. RL1044.2 +053300 MOVE ZERO TO WRK-CS-09V00-018. RL1044.2 +053400 MOVE 01 TO REC-CT. RL1044.2 +053500 OPEN I-O RL-FS2. RL1044.2 +053600 MOVE SPACE TO WRK-XN-0002-002 RL1044.2 +053700 MOVE SPACE TO WRK-XN-0002-003 RL1044.2 +053800 MOVE SPACE TO WRK-XN-0002-004 RL1044.2 +053900 MOVE RL-FS2-STATUS TO WRK-XN-0002-001 RL1044.2 +054000 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +054100*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1044.2 +054200 MOVE "USE/FILE STATUE" TO FEATURE. RL1044.2 +054300 REL-TEST-010-R. RL1044.2 +054400 ADD 1 TO WRK-CS-09V00-014. RL1044.2 +054500 ADD 1 TO WRK-CS-09V00-015. RL1044.2 +054600 READ RL-FS2. RL1044.2 +054700 IF RL-FS2-STATUS EQUAL TO "10" RL1044.2 +054800 GO TO REL-TEST-010-3. RL1044.2 +054900 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1044.2 +055000 IF WRK-CS-09V00-015 EQUAL TO 5 RL1044.2 +055100 ADD 01 TO UPDATE-NUMBER (2) RL1044.2 +055200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120 RL1044.2 +055300 REWRITE RL-FS2R1-F-G-240 RL1044.2 +055400 MOVE ZERO TO WRK-CS-09V00-015 RL1044.2 +055500 GO TO REL-TEST-010-2. RL1044.2 +055600 IF WRK-CS-09V00-014 GREATER 500 RL1044.2 +055700 GO TO REL-TEST-010-3. RL1044.2 +055800 GO TO REL-TEST-010-R. RL1044.2 +055900 REL-TEST-010-2. RL1044.2 +056000 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +056100 ADD 1 TO WRK-CS-09V00-016. RL1044.2 +056200 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +056300 GO TO REL-TEST-010-R. RL1044.2 +056400 REL-TEST-010-3. RL1044.2 +056500 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1044.2 +056600 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1044.2 +056700 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1044.2 +056800 MOVE 1 TO CORRECT-18V0 RL1044.2 +056900 PERFORM FAIL RL1044.2 +057000 ELSE RL1044.2 +057100 PERFORM PASS. RL1044.2 +057200 PERFORM PRINT-DETAIL. RL1044.2 +057300 ADD 01 TO REC-CT. RL1044.2 +057400* .01 RL1044.2 +057500 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1044.2 +057600 MOVE "INCORRECT COUNT" TO RE-MARK RL1044.2 +057700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1044.2 +057800 MOVE 501 TO CORRECT-18V0 RL1044.2 +057900 PERFORM FAIL RL1044.2 +058000 ELSE RL1044.2 +058100 PERFORM PASS. RL1044.2 +058200 PERFORM PRINT-DETAIL. RL1044.2 +058300 ADD 01 TO REC-CT. RL1044.2 +058400* .02 RL1044.2 +058500 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1044.2 +058600 MOVE "OPEN/STATUS" TO RE-MARK RL1044.2 +058700 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1044.2 +058800 MOVE "00" TO CORRECT-A RL1044.2 +058900 PERFORM FAIL RL1044.2 +059000 ELSE RL1044.2 +059100 PERFORM PASS. RL1044.2 +059200 PERFORM PRINT-DETAIL. RL1044.2 +059300 ADD 01 TO REC-CT. RL1044.2 +059400* .03 RL1044.2 +059500 IF RL-FS2-STATUS NOT EQUAL TO "10" RL1044.2 +059600 MOVE "ATEND/STATUS" TO RE-MARK RL1044.2 +059700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +059800 MOVE "10" TO CORRECT-A RL1044.2 +059900 PERFORM FAIL RL1044.2 +060000 ELSE RL1044.2 +060100 PERFORM PASS. RL1044.2 +060200 PERFORM PRINT-DETAIL. RL1044.2 +060300 ADD 01 TO REC-CT. RL1044.2 +060400* .04 RL1044.2 +060500 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1044.2 +060600 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1044.2 +060700 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1044.2 +060800 MOVE "10" TO CORRECT-A RL1044.2 +060900 PERFORM FAIL RL1044.2 +061000 ELSE RL1044.2 +061100 PERFORM PASS. RL1044.2 +061200 PERFORM PRINT-DETAIL. RL1044.2 +061300 ADD 01 TO REC-CT. RL1044.2 +061400* .05 RL1044.2 +061500 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1044.2 +061600 MOVE "NO/EXCEPTION" TO RE-MARK RL1044.2 +061700 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1044.2 +061800 MOVE "10" TO CORRECT-A RL1044.2 +061900 PERFORM FAIL RL1044.2 +062000 ELSE RL1044.2 +062100 PERFORM PASS. RL1044.2 +062200 PERFORM PRINT-DETAIL RL1044.2 +062300 ADD 01 TO REC-CT. RL1044.2 +062400* .06 RL1044.2 +062500 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +062600 CLOSE RL-FS2 RL1044.2 +062700 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +062800 MOVE "CLOSE/STATUS" TO RE-MARK RL1044.2 +062900 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +063000 MOVE "00" TO CORRECT-A RL1044.2 +063100 PERFORM FAIL RL1044.2 +063200 ELSE RL1044.2 +063300 PERFORM PASS. RL1044.2 +063400 PERFORM PRINT-DETAIL. RL1044.2 +063500 ADD 01 TO REC-CT. RL1044.2 +063600* .07 RL1044.2 +063700 CCVS-EXIT SECTION. RL1044.2 +063800 CCVS-999999. RL1044.2 +063900 GO TO CLOSE-FILES. RL1044.2 +*END-OF,RL104A +*HEADER,COBOL,RL105A +000100 IDENTIFICATION DIVISION. RL1054.2 +000200 PROGRAM-ID. RL1054.2 +000300 RL105A. RL1054.2 +000400**************************************************************** RL1054.2 +000500* * RL1054.2 +000600* VALIDATION FOR:- * RL1054.2 +000700* * RL1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +000900* * RL1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1054.2 +001100* * RL1054.2 +001200**************************************************************** RL1054.2 +001300*GENERAL: THIS PROGRAM PROCESSED THREE RELATIVE FILES RL1054.2 +001400* IDENTIFIED AS RL-FR1, RL-FR2 AND RL-FR3. THE RL1054.2 +001500* FUNCTION OF THIS PROGRAM IS TO CREATE THREE RELATIVE RL1054.2 +001600* I-O FILES RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY RL1054.2 +001700* THAT THEY WERE CREATED CORRECTLY. THE FILES RL1054.2 +001800* PROCESSED CONTAIN FIXED LENGTH RECORDS. RL1054.2 +001900* RL1054.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1054.2 +002100* PROGRAM ARE: RL1054.2 +002200* RL1054.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002400* RELATIVE I-O DATA FILE-1 RL1054.2 +002500* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002600* RELATIVE I-O DATA FILE-2 RL1054.2 +002700* X-23 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002800* RELATIVE I-O DATA FILE-3 RL1054.2 +002900* X-55 SYSTEM PRINTER RL1054.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1054.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1054.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1054.2 +003300* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1054.2 +003400* X-77 OBJECT OF VALUE OF CLAUSE FOR FILE-3 RL1054.2 +003500* X-82 SOURCE-COMPUTER RL1054.2 +003600* X-83 OBJECT-COMPUTER. RL1054.2 +003700* RL1054.2 +003800**************************************************************** RL1054.2 +003900 ENVIRONMENT DIVISION. RL1054.2 +004000 CONFIGURATION SECTION. RL1054.2 +004100 SOURCE-COMPUTER. RL1054.2 +004200 XXXXX082. RL1054.2 +004300 OBJECT-COMPUTER. RL1054.2 +004400 XXXXX083. RL1054.2 +004500 INPUT-OUTPUT SECTION. RL1054.2 +004600 FILE-CONTROL. RL1054.2 +004700 SELECT PRINT-FILE ASSIGN TO RL1054.2 +004800 XXXXX055. RL1054.2 +004900 SELECT RL-FR1 ASSIGN TO RL1054.2 +005000 XXXXX021 RL1054.2 +005100 ORGANIZATION IS RELATIVE RL1054.2 +005200 ACCESS MODE IS RANDOM RL1054.2 +005300 RELATIVE KEY IS KEY-1. RL1054.2 +005400 SELECT RL-FR2 ASSIGN RL1054.2 +005500 XXXXX022 RL1054.2 +005600 ORGANIZATION IS RELATIVE RL1054.2 +005700 ACCESS MODE IS RANDOM RL1054.2 +005800 RELATIVE KEY IS KEY-2. RL1054.2 +005900 SELECT RL-FR3 ASSIGN TO RL1054.2 +006000 XXXXX023 RL1054.2 +006100 ORGANIZATION IS RELATIVE RL1054.2 +006200 ACCESS MODE IS RANDOM RL1054.2 +006300 RELATIVE KEY IS KEY-3. RL1054.2 +006400 DATA DIVISION. RL1054.2 +006500 FILE SECTION. RL1054.2 +006600 FD PRINT-FILE. RL1054.2 +006700 01 PRINT-REC PICTURE X(120). RL1054.2 +006800 01 DUMMY-RECORD PICTURE X(120). RL1054.2 +006900 FD RL-FR1 RL1054.2 +007000C VALUE OF RL1054.2 +007100C XXXXX074 RL1054.2 +007200C IS RL1054.2 +007300C XXXXX075 RL1054.2 +007400G XXXXX069 RL1054.2 +007500 LABEL RECORDS ARE STANDARD RL1054.2 +007600 DATA RECORD IS GRP-1SEQ-RECORD-1. RL1054.2 +007700 01 GRP-1SEQ-RECORD-1. RL1054.2 +007800 02 EXPRESSION PICTURE X(51). RL1054.2 +007900 02 FILLER PICTURE X(49). RL1054.2 +008000 FD RL-FR2 RL1054.2 +008100C VALUE OF RL1054.2 +008200C XXXXX074 RL1054.2 +008300C IS RL1054.2 +008400C XXXXX076 RL1054.2 +008500G XXXXX069 RL1054.2 +008600 LABEL RECORDS ARE STANDARD RL1054.2 +008700 DATA RECORD IS GRP-1SEQ-RECORD-2. RL1054.2 +008800 01 GRP-1SEQ-RECORD-2. RL1054.2 +008900 02 FILLER PICTURE X(100). RL1054.2 +009000 FD RL-FR3 RL1054.2 +009100C VALUE OF RL1054.2 +009200C XXXXX074 RL1054.2 +009300C IS RL1054.2 +009400C XXXXX077 RL1054.2 +009500G XXXXX069 RL1054.2 +009600 LABEL RECORDS ARE STANDARD RL1054.2 +009700 DATA RECORD IS GRP-1SEQ-RECORD-3. RL1054.2 +009800 01 GRP-1SEQ-RECORD-3. RL1054.2 +009900 02 FILLER PICTURE X(100). RL1054.2 +010000 WORKING-STORAGE SECTION. RL1054.2 +010100 77 SUB-1 PICTURE 99 VALUE ZERO. RL1054.2 +010200 77 KEY-1 RL1054.2 +010300 PICTURE 9(5). RL1054.2 +010400 77 KEY-2 RL1054.2 +010500 PICTURE 9(5). RL1054.2 +010600 77 KEY-3 RL1054.2 +010700 PICTURE 9(5). RL1054.2 +010800 01 RECORD-MESSAGE. RL1054.2 +010900 02 FILLER PICTURE X(8) VALUE "RECORD ". RL1054.2 +011000 02 2POS-NUM PICTURE 99. RL1054.2 +011100 02 FILLER PICTURE X(40) VALUE RL1054.2 +011200 " OF THIS FILE CONTAINS THIS INFORMATION". RL1054.2 +011300 02 FILLER PICTURE X(50) VALUE SPACE. RL1054.2 +011400 01 GRP-SEQ-TEST-RECORD PICTURE X(100) VALUE SPACE. RL1054.2 +011500 01 GRP-HOLD-RECORD PICTURE X(100) VALUE SPACE. RL1054.2 +011600 01 READ-WRITE-COUNTER. RL1054.2 +011700 02 ENTRY-RW OCCURS 20 TIMES PICTURE X. RL1054.2 +011800 01 FILE-RECORD-INFORMATION-REC. RL1054.2 +011900 03 FILE-RECORD-INFO-SKELETON. RL1054.2 +012000 05 FILLER PICTURE X(48) VALUE RL1054.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1054.2 +012200 05 FILLER PICTURE X(46) VALUE RL1054.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1054.2 +012400 05 FILLER PICTURE X(26) VALUE RL1054.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". RL1054.2 +012600 05 FILLER PICTURE X(37) VALUE RL1054.2 +012700 ",RECKEY= ". RL1054.2 +012800 05 FILLER PICTURE X(38) VALUE RL1054.2 +012900 ",ALTKEY1= ". RL1054.2 +013000 05 FILLER PICTURE X(38) VALUE RL1054.2 +013100 ",ALTKEY2= ". RL1054.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.RL1054.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1054.2 +013400 05 FILE-RECORD-INFO-P1-120. RL1054.2 +013500 07 FILLER PIC X(5). RL1054.2 +013600 07 XFILE-NAME PIC X(6). RL1054.2 +013700 07 FILLER PIC X(8). RL1054.2 +013800 07 XRECORD-NAME PIC X(6). RL1054.2 +013900 07 FILLER PIC X(1). RL1054.2 +014000 07 REELUNIT-NUMBER PIC 9(1). RL1054.2 +014100 07 FILLER PIC X(7). RL1054.2 +014200 07 XRECORD-NUMBER PIC 9(6). RL1054.2 +014300 07 FILLER PIC X(6). RL1054.2 +014400 07 UPDATE-NUMBER PIC 9(2). RL1054.2 +014500 07 FILLER PIC X(5). RL1054.2 +014600 07 ODO-NUMBER PIC 9(4). RL1054.2 +014700 07 FILLER PIC X(5). RL1054.2 +014800 07 XPROGRAM-NAME PIC X(5). RL1054.2 +014900 07 FILLER PIC X(7). RL1054.2 +015000 07 XRECORD-LENGTH PIC 9(6). RL1054.2 +015100 07 FILLER PIC X(7). RL1054.2 +015200 07 CHARS-OR-RECORDS PIC X(2). RL1054.2 +015300 07 FILLER PIC X(1). RL1054.2 +015400 07 XBLOCK-SIZE PIC 9(4). RL1054.2 +015500 07 FILLER PIC X(6). RL1054.2 +015600 07 RECORDS-IN-FILE PIC 9(6). RL1054.2 +015700 07 FILLER PIC X(5). RL1054.2 +015800 07 XFILE-ORGANIZATION PIC X(2). RL1054.2 +015900 07 FILLER PIC X(6). RL1054.2 +016000 07 XLABEL-TYPE PIC X(1). RL1054.2 +016100 05 FILE-RECORD-INFO-P121-240. RL1054.2 +016200 07 FILLER PIC X(8). RL1054.2 +016300 07 XRECORD-KEY PIC X(29). RL1054.2 +016400 07 FILLER PIC X(9). RL1054.2 +016500 07 ALTERNATE-KEY1 PIC X(29). RL1054.2 +016600 07 FILLER PIC X(9). RL1054.2 +016700 07 ALTERNATE-KEY2 PIC X(29). RL1054.2 +016800 07 FILLER PIC X(7). RL1054.2 +016900 01 TEST-RESULTS. RL1054.2 +017000 02 FILLER PIC X VALUE SPACE. RL1054.2 +017100 02 FEATURE PIC X(20) VALUE SPACE. RL1054.2 +017200 02 FILLER PIC X VALUE SPACE. RL1054.2 +017300 02 P-OR-F PIC X(5) VALUE SPACE. RL1054.2 +017400 02 FILLER PIC X VALUE SPACE. RL1054.2 +017500 02 PAR-NAME. RL1054.2 +017600 03 FILLER PIC X(19) VALUE SPACE. RL1054.2 +017700 03 PARDOT-X PIC X VALUE SPACE. RL1054.2 +017800 03 DOTVALUE PIC 99 VALUE ZERO. RL1054.2 +017900 02 FILLER PIC X(8) VALUE SPACE. RL1054.2 +018000 02 RE-MARK PIC X(61). RL1054.2 +018100 01 TEST-COMPUTED. RL1054.2 +018200 02 FILLER PIC X(30) VALUE SPACE. RL1054.2 +018300 02 FILLER PIC X(17) VALUE RL1054.2 +018400 " COMPUTED=". RL1054.2 +018500 02 COMPUTED-X. RL1054.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1054.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A RL1054.2 +018800 PIC -9(9).9(9). RL1054.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1054.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1054.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1054.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. RL1054.2 +019300 04 COMPUTED-18V0 PIC -9(18). RL1054.2 +019400 04 FILLER PIC X. RL1054.2 +019500 03 FILLER PIC X(50) VALUE SPACE. RL1054.2 +019600 01 TEST-CORRECT. RL1054.2 +019700 02 FILLER PIC X(30) VALUE SPACE. RL1054.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". RL1054.2 +019900 02 CORRECT-X. RL1054.2 +020000 03 CORRECT-A PIC X(20) VALUE SPACE. RL1054.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1054.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1054.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1054.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1054.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. RL1054.2 +020600 04 CORRECT-18V0 PIC -9(18). RL1054.2 +020700 04 FILLER PIC X. RL1054.2 +020800 03 FILLER PIC X(2) VALUE SPACE. RL1054.2 +020900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1054.2 +021000 01 CCVS-C-1. RL1054.2 +021100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1054.2 +021200- "SS PARAGRAPH-NAME RL1054.2 +021300- " REMARKS". RL1054.2 +021400 02 FILLER PIC X(20) VALUE SPACE. RL1054.2 +021500 01 CCVS-C-2. RL1054.2 +021600 02 FILLER PIC X VALUE SPACE. RL1054.2 +021700 02 FILLER PIC X(6) VALUE "TESTED". RL1054.2 +021800 02 FILLER PIC X(15) VALUE SPACE. RL1054.2 +021900 02 FILLER PIC X(4) VALUE "FAIL". RL1054.2 +022000 02 FILLER PIC X(94) VALUE SPACE. RL1054.2 +022100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1054.2 +022200 01 REC-CT PIC 99 VALUE ZERO. RL1054.2 +022300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1054.2 +022800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1054.2 +022900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1054.2 +023000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1054.2 +023100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1054.2 +023200 01 CCVS-H-1. RL1054.2 +023300 02 FILLER PIC X(39) VALUE SPACES. RL1054.2 +023400 02 FILLER PIC X(42) VALUE RL1054.2 +023500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1054.2 +023600 02 FILLER PIC X(39) VALUE SPACES. RL1054.2 +023700 01 CCVS-H-2A. RL1054.2 +023800 02 FILLER PIC X(40) VALUE SPACE. RL1054.2 +023900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1054.2 +024000 02 FILLER PIC XXXX VALUE RL1054.2 +024100 "4.2 ". RL1054.2 +024200 02 FILLER PIC X(28) VALUE RL1054.2 +024300 " COPY - NOT FOR DISTRIBUTION". RL1054.2 +024400 02 FILLER PIC X(41) VALUE SPACE. RL1054.2 +024500 RL1054.2 +024600 01 CCVS-H-2B. RL1054.2 +024700 02 FILLER PIC X(15) VALUE RL1054.2 +024800 "TEST RESULT OF ". RL1054.2 +024900 02 TEST-ID PIC X(9). RL1054.2 +025000 02 FILLER PIC X(4) VALUE RL1054.2 +025100 " IN ". RL1054.2 +025200 02 FILLER PIC X(12) VALUE RL1054.2 +025300 " HIGH ". RL1054.2 +025400 02 FILLER PIC X(22) VALUE RL1054.2 +025500 " LEVEL VALIDATION FOR ". RL1054.2 +025600 02 FILLER PIC X(58) VALUE RL1054.2 +025700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +025800 01 CCVS-H-3. RL1054.2 +025900 02 FILLER PIC X(34) VALUE RL1054.2 +026000 " FOR OFFICIAL USE ONLY ". RL1054.2 +026100 02 FILLER PIC X(58) VALUE RL1054.2 +026200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1054.2 +026300 02 FILLER PIC X(28) VALUE RL1054.2 +026400 " COPYRIGHT 1985 ". RL1054.2 +026500 01 CCVS-E-1. RL1054.2 +026600 02 FILLER PIC X(52) VALUE SPACE. RL1054.2 +026700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1054.2 +026800 02 ID-AGAIN PIC X(9). RL1054.2 +026900 02 FILLER PIC X(45) VALUE SPACES. RL1054.2 +027000 01 CCVS-E-2. RL1054.2 +027100 02 FILLER PIC X(31) VALUE SPACE. RL1054.2 +027200 02 FILLER PIC X(21) VALUE SPACE. RL1054.2 +027300 02 CCVS-E-2-2. RL1054.2 +027400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1054.2 +027500 03 FILLER PIC X VALUE SPACE. RL1054.2 +027600 03 ENDER-DESC PIC X(44) VALUE RL1054.2 +027700 "ERRORS ENCOUNTERED". RL1054.2 +027800 01 CCVS-E-3. RL1054.2 +027900 02 FILLER PIC X(22) VALUE RL1054.2 +028000 " FOR OFFICIAL USE ONLY". RL1054.2 +028100 02 FILLER PIC X(12) VALUE SPACE. RL1054.2 +028200 02 FILLER PIC X(58) VALUE RL1054.2 +028300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +028400 02 FILLER PIC X(13) VALUE SPACE. RL1054.2 +028500 02 FILLER PIC X(15) VALUE RL1054.2 +028600 " COPYRIGHT 1985". RL1054.2 +028700 01 CCVS-E-4. RL1054.2 +028800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1054.2 +028900 02 FILLER PIC X(4) VALUE " OF ". RL1054.2 +029000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1054.2 +029100 02 FILLER PIC X(40) VALUE RL1054.2 +029200 " TESTS WERE EXECUTED SUCCESSFULLY". RL1054.2 +029300 01 XXINFO. RL1054.2 +029400 02 FILLER PIC X(19) VALUE RL1054.2 +029500 "*** INFORMATION ***". RL1054.2 +029600 02 INFO-TEXT. RL1054.2 +029700 04 FILLER PIC X(8) VALUE SPACE. RL1054.2 +029800 04 XXCOMPUTED PIC X(20). RL1054.2 +029900 04 FILLER PIC X(5) VALUE SPACE. RL1054.2 +030000 04 XXCORRECT PIC X(20). RL1054.2 +030100 02 INF-ANSI-REFERENCE PIC X(48). RL1054.2 +030200 01 HYPHEN-LINE. RL1054.2 +030300 02 FILLER PIC IS X VALUE IS SPACE. RL1054.2 +030400 02 FILLER PIC IS X(65) VALUE IS "************************RL1054.2 +030500- "*****************************************". RL1054.2 +030600 02 FILLER PIC IS X(54) VALUE IS "************************RL1054.2 +030700- "******************************". RL1054.2 +030800 01 CCVS-PGM-ID PIC X(9) VALUE RL1054.2 +030900 "RL105A". RL1054.2 +031000 PROCEDURE DIVISION. RL1054.2 +031100 CCVS1 SECTION. RL1054.2 +031200 OPEN-FILES. RL1054.2 +031300 OPEN OUTPUT PRINT-FILE. RL1054.2 +031400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1054.2 +031500 MOVE SPACE TO TEST-RESULTS. RL1054.2 +031600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1054.2 +031700 MOVE ZERO TO REC-SKL-SUB. RL1054.2 +031800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1054.2 +031900 CCVS-INIT-FILE. RL1054.2 +032000 ADD 1 TO REC-SKL-SUB. RL1054.2 +032100 MOVE FILE-RECORD-INFO-SKELETON RL1054.2 +032200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1054.2 +032300 CCVS-INIT-EXIT. RL1054.2 +032400 GO TO CCVS1-EXIT. RL1054.2 +032500 CLOSE-FILES. RL1054.2 +032600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1054.2 +032700 TERMINATE-CCVS. RL1054.2 +032800S EXIT PROGRAM. RL1054.2 +032900STERMINATE-CALL. RL1054.2 +033000 STOP RUN. RL1054.2 +033100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1054.2 +033200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1054.2 +033300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1054.2 +033400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1054.2 +033500 MOVE "****TEST DELETED****" TO RE-MARK. RL1054.2 +033600 PRINT-DETAIL. RL1054.2 +033700 IF REC-CT NOT EQUAL TO ZERO RL1054.2 +033800 MOVE "." TO PARDOT-X RL1054.2 +033900 MOVE REC-CT TO DOTVALUE. RL1054.2 +034000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1054.2 +034100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1054.2 +034200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1054.2 +034300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1054.2 +034400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1054.2 +034500 MOVE SPACE TO CORRECT-X. RL1054.2 +034600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1054.2 +034700 MOVE SPACE TO RE-MARK. RL1054.2 +034800 HEAD-ROUTINE. RL1054.2 +034900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1054.2 +035200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1054.2 +035300 COLUMN-NAMES-ROUTINE. RL1054.2 +035400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +035500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +035700 END-ROUTINE. RL1054.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1054.2 +035900 END-RTN-EXIT. RL1054.2 +036000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +036100 END-ROUTINE-1. RL1054.2 +036200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1054.2 +036300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1054.2 +036400 ADD PASS-COUNTER TO ERROR-HOLD. RL1054.2 +036500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1054.2 +036600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1054.2 +036700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1054.2 +036800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1054.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1054.2 +037000 END-ROUTINE-12. RL1054.2 +037100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1054.2 +037200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1054.2 +037300 MOVE "NO " TO ERROR-TOTAL RL1054.2 +037400 ELSE RL1054.2 +037500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1054.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1054.2 +037700 PERFORM WRITE-LINE. RL1054.2 +037800 END-ROUTINE-13. RL1054.2 +037900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1054.2 +038000 MOVE "NO " TO ERROR-TOTAL ELSE RL1054.2 +038100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1054.2 +038200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1054.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +038400 IF INSPECT-COUNTER EQUAL TO ZERO RL1054.2 +038500 MOVE "NO " TO ERROR-TOTAL RL1054.2 +038600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1054.2 +038700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1054.2 +038800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +038900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +039000 WRITE-LINE. RL1054.2 +039100 ADD 1 TO RECORD-COUNT. RL1054.2 +039200Y IF RECORD-COUNT GREATER 50 RL1054.2 +039300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1054.2 +039400Y MOVE SPACE TO DUMMY-RECORD RL1054.2 +039500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1054.2 +039600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1054.2 +039700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1054.2 +039800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1054.2 +039900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1054.2 +040000Y MOVE ZERO TO RECORD-COUNT. RL1054.2 +040100 PERFORM WRT-LN. RL1054.2 +040200 WRT-LN. RL1054.2 +040300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1054.2 +040400 MOVE SPACE TO DUMMY-RECORD. RL1054.2 +040500 BLANK-LINE-PRINT. RL1054.2 +040600 PERFORM WRT-LN. RL1054.2 +040700 FAIL-ROUTINE. RL1054.2 +040800 IF COMPUTED-X NOT EQUAL TO SPACE RL1054.2 +040900 GO TO FAIL-ROUTINE-WRITE. RL1054.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1054.2 +041100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1054.2 +041200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1054.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +041400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1054.2 +041500 GO TO FAIL-ROUTINE-EX. RL1054.2 +041600 FAIL-ROUTINE-WRITE. RL1054.2 +041700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1054.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1054.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1054.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1054.2 +042100 FAIL-ROUTINE-EX. EXIT. RL1054.2 +042200 BAIL-OUT. RL1054.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1054.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1054.2 +042500 BAIL-OUT-WRITE. RL1054.2 +042600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1054.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1054.2 +042800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +042900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1054.2 +043000 BAIL-OUT-EX. EXIT. RL1054.2 +043100 CCVS1-EXIT. RL1054.2 +043200 EXIT. RL1054.2 +043300 SECT-RL105-001 SECTION. RL1054.2 +043400 SECT-RC-01-001-INIT. RL1054.2 +043500 MOVE 1 TO KEY-1 KEY-2 KEY-3 2POS-NUM. RL1054.2 +043600 MOVE "READ/WRITE INVAL KEY" TO FEATURE. RL1054.2 +043700 WRITE-REL-RECORDS SECTION. RL1054.2 +043800 REL-INIT-1. RL1054.2 +043900 MOVE ZERO TO 2POS-NUM. RL1054.2 +044000 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +044100 OPEN OUTPUT RL-FR1. RL1054.2 +044200 REL-TEST-1. RL1054.2 +044300 PERFORM REL-WRITE-FOR-TEST-1 THRU 1-EXIT 19 TIMES. RL1054.2 +044400 IF READ-WRITE-COUNTER EQUAL TO "WWWWWWWWWWWWWWWWWWW " RL1054.2 +044500 MOVE "19 RECORDS PASSED TO TEST-2" TO RE-MARK RL1054.2 +044600 GO TO REL-TEST-1-WRITE. RL1054.2 +044700 MOVE "WWWWWWWWWWWWWWWWWWW " TO CORRECT-A. RL1054.2 +044800 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +044900 PERFORM FAIL. RL1054.2 +045000 GO TO REL-TEST-1-WRITE. RL1054.2 +045100 REL-DELETE-TEST-1. RL1054.2 +045200 MOVE "***TESTS-DELETED ***" TO COMPUTED-A CORRECT-A. RL1054.2 +045300 MOVE "WRITE-REL-RECORDS SECTION " TO RE-MARK. RL1054.2 +045400 PERFORM REL-TEST-1-WRITE. RL1054.2 +045500 GO TO EXIT-SECTION-1. RL1054.2 +045600 REL-WRITE-FOR-TEST-1. RL1054.2 +045700 ADD 1 TO SUB-1. RL1054.2 +045800 MOVE "W" TO ENTRY-RW (SUB-1). RL1054.2 +045900 MOVE SUB-1 TO KEY-1. RL1054.2 +046000 ADD 1 TO 2POS-NUM. RL1054.2 +046100 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-1. RL1054.2 +046200 WRITE GRP-1SEQ-RECORD-1 INVALID KEY GO TO I-KEY-1. RL1054.2 +046300 GO TO 1-EXIT. RL1054.2 +046400 I-KEY-1. RL1054.2 +046500 MOVE "I" TO ENTRY-RW (SUB-1). RL1054.2 +046600 1-EXIT. RL1054.2 +046700 EXIT. RL1054.2 +046800 REL-TEST-1-WRITE. RL1054.2 +046900 MOVE "REL-TEST-1 " TO PAR-NAME. RL1054.2 +047000 PERFORM PRINT-DETAIL. RL1054.2 +047100 CLOSE RL-FR1. RL1054.2 +047200 REL-INIT-2. RL1054.2 +047300 MOVE 01 TO SUB-1 KEY-1. RL1054.2 +047400 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +047500 OPEN INPUT RL-FR1. RL1054.2 +047600 REL-TEST-2. RL1054.2 +047700 READ RL-FR1 RECORD INVALID RL1054.2 +047800 MOVE "E" TO ENTRY-RW (SUB-1) RL1054.2 +047900 GO TO COMPARE-FOR-TEST-2. RL1054.2 +048000 IF SUB-1 EQUAL TO 20 RL1054.2 +048100 GO TO COMPARE-FOR-TEST-2. RL1054.2 +048200 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +048300 ADD 1 TO SUB-1. RL1054.2 +048400 MOVE SUB-1 TO KEY-1. RL1054.2 +048500 GO TO REL-TEST-2. RL1054.2 +048600 COMPARE-FOR-TEST-2. RL1054.2 +048700 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRRRRE" RL1054.2 +048800 PERFORM PASS RL1054.2 +048900 GO TO REL-TEST-2-WRITE. RL1054.2 +049000 MOVE "RRRRRRRRRRRRRRRRRRRE" TO CORRECT-A. RL1054.2 +049100 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +049200 MOVE "INCORRECT RECORD COUNT " TO RE-MARK. RL1054.2 +049300 PERFORM FAIL. RL1054.2 +049400 REL-TEST-2-WRITE. RL1054.2 +049500 MOVE "REL-TEST-2 " TO PAR-NAME. RL1054.2 +049600 PERFORM PRINT-DETAIL. RL1054.2 +049700 EXIT-SECTION-1. RL1054.2 +049800 CLOSE RL-FR1. RL1054.2 +049900 BLOCKED-UNBLOCKED SECTION. RL1054.2 +050000 REL-INIT-3. RL1054.2 +050100 MOVE 0 TO SUB-1. RL1054.2 +050200 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +050300 OPEN OUTPUT RL-FR2. RL1054.2 +050400 MOVE 1 TO KEY-2 2POS-NUM. RL1054.2 +050500 REL-TEST-3. RL1054.2 +050600 PERFORM REL-WRITE-FOR-TEST-3 THRU 3-EXIT 8 TIMES. RL1054.2 +050700 PERFORM REL-WRITE-FOR-TEST-3 THRU 3-EXIT 8 TIMES. RL1054.2 +050800 CLOSE RL-FR2. RL1054.2 +050900 MOVE "REL-TEST-3 " TO PAR-NAME. RL1054.2 +051000 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWW " RL1054.2 +051100 MOVE "INVALID KEYS ON WRITE " TO RE-MARK ELSE RL1054.2 +051200 MOVE "16 RECORDS PASSED TO TEST-4" TO RE-MARK. RL1054.2 +051300 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1054.2 +051400 PERFORM PRINT-DETAIL. RL1054.2 +051500 GO TO REL-TEST-4. RL1054.2 +051600 REL-DELETE-TEST-3. RL1054.2 +051700 MOVE "***TESTS-DELETED ***" TO CORRECT-A COMPUTED-A. RL1054.2 +051800 MOVE "BLOCKED-UNBLOCKED SECTION " TO RE-MARK. RL1054.2 +051900 MOVE "REL-TEST-3 " TO PAR-NAME. RL1054.2 +052000 PERFORM PRINT-DETAIL. RL1054.2 +052100 GO TO REL-TEST-4. RL1054.2 +052200 REL-WRITE-FOR-TEST-3. RL1054.2 +052300 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-2. RL1054.2 +052400 WRITE GRP-1SEQ-RECORD-2 INVALID KEY GO TO I-KEY-3. RL1054.2 +052500 MOVE "W" TO ENTRY-RW (2POS-NUM). RL1054.2 +052600 ADD 1 TO 2POS-NUM. RL1054.2 +052700 MOVE 2POS-NUM TO KEY-2. RL1054.2 +052800 GO TO 3-EXIT. RL1054.2 +052900 I-KEY-3. RL1054.2 +053000 MOVE "I" TO ENTRY-RW (2POS-NUM). RL1054.2 +053100 ADD 1 TO 2POS-NUM. RL1054.2 +053200 MOVE 2POS-NUM TO KEY-2. RL1054.2 +053300 3-EXIT. RL1054.2 +053400 EXIT. RL1054.2 +053500 REL-TEST-4. RL1054.2 +053600 OPEN INPUT RL-FR2. RL1054.2 +053700 MOVE 01 TO 2POS-NUM. RL1054.2 +053800 MOVE 01 TO SUB-1 KEY-2. RL1054.2 +053900 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +054000 READ-FOR-TEST-4. RL1054.2 +054100 READ RL-FR2 INVALID RL1054.2 +054200 MOVE "INVALID KEY FILE-2 " TO COMPUTED-A RL1054.2 +054300 MOVE SPACE TO CORRECT-A RL1054.2 +054400 MOVE "INVALID KEY ON FIRST READ " TO RE-MARK RL1054.2 +054500 PERFORM FAIL RL1054.2 +054600 MOVE "I" TO ENTRY-RW (SUB-1) RL1054.2 +054700 GO TO REL-TEST-4-WRITE. RL1054.2 +054800 IF GRP-1SEQ-RECORD-2 NOT EQUAL TO RECORD-MESSAGE RL1054.2 +054900 MOVE "INCORRECT 1ST RECORD" TO COMPUTED-A RL1054.2 +055000 MOVE SPACE TO CORRECT-A RL1054.2 +055100 MOVE "RECORD NO. 1 INVALID" TO RE-MARK RL1054.2 +055200 PERFORM FAIL RL1054.2 +055300 MOVE "R" TO ENTRY-RW (SUB-1) RL1054.2 +055400 GO TO REL-TEST-4-WRITE. RL1054.2 +055500 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +055600 PERFORM PASS. RL1054.2 +055700 REL-TEST-4-WRITE. RL1054.2 +055800 MOVE "REL-TEST-4 " TO PAR-NAME. RL1054.2 +055900 PERFORM PRINT-DETAIL. RL1054.2 +056000 REL-TEST-5. RL1054.2 +056100 ADD 1 TO SUB-1. RL1054.2 +056200* NOTE THIS TEST DEPENDS ON TEST-4. RL1054.2 +056300 MOVE SUB-1 TO KEY-2. RL1054.2 +056400 READ RL-FR2 INVALID KEY RL1054.2 +056500 MOVE "E" TO ENTRY-RW (SUB-1) RL1054.2 +056600 GO TO COMPARE-FOR-TEST-5. RL1054.2 +056700 IF SUB-1 EQUAL TO 17 RL1054.2 +056800 GO TO COMPARE-FOR-TEST-5. RL1054.2 +056900 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +057000 GO TO REL-TEST-5. RL1054.2 +057100 COMPARE-FOR-TEST-5. RL1054.2 +057200 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRE " RL1054.2 +057300 PERFORM PASS RL1054.2 +057400 GO TO REL-TEST-5-WRITE. RL1054.2 +057500 MOVE "RRRRRRRRRRRRRRRRE " TO CORRECT-A. RL1054.2 +057600 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +057700 MOVE "INCORRECT RECORD COUNT " TO RE-MARK. RL1054.2 +057800 PERFORM FAIL. RL1054.2 +057900 REL-TEST-5-WRITE. RL1054.2 +058000 MOVE "REL-TEST-5 " TO PAR-NAME. RL1054.2 +058100 PERFORM PRINT-DETAIL. RL1054.2 +058200 CLOSE RL-FR2. RL1054.2 +058300 OPEN OUTPUT RL-FR3. RL1054.2 +058400 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +058500 MOVE 1 TO KEY-3 2POS-NUM. RL1054.2 +058600 REL-TEST-6. RL1054.2 +058700 PERFORM REL-WRITE-FOR-TEST-6 THRU 6-EXIT 7 TIMES. RL1054.2 +058800 PERFORM REL-WRITE-FOR-TEST-6 THRU 6-EXIT 9 TIMES. RL1054.2 +058900 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWW " RL1054.2 +059000 MOVE "INVALID KEYS ON WRITE " TO RE-MARK ELSE RL1054.2 +059100 MOVE "16 RECORDS PASSED TO TEST-7" TO RE-MARK. RL1054.2 +059200 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1054.2 +059300 MOVE "REL-TEST-6 " TO PAR-NAME. RL1054.2 +059400 PERFORM PRINT-DETAIL. RL1054.2 +059500 CLOSE RL-FR3. RL1054.2 +059600 GO TO REL-TEST-7. RL1054.2 +059700 REL-WRITE-FOR-TEST-6. RL1054.2 +059800 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-3. RL1054.2 +059900 WRITE GRP-1SEQ-RECORD-3 INVALID KEY GO TO I-KEY-6. RL1054.2 +060000 MOVE "W" TO ENTRY-RW (2POS-NUM). RL1054.2 +060100 ADD 1 TO 2POS-NUM. RL1054.2 +060200 MOVE 2POS-NUM TO KEY-3. RL1054.2 +060300 GO TO 6-EXIT. RL1054.2 +060400 I-KEY-6. RL1054.2 +060500 MOVE "I" TO ENTRY-RW (2POS-NUM). RL1054.2 +060600 ADD 1 TO 2POS-NUM. RL1054.2 +060700 MOVE 2POS-NUM TO KEY-3. RL1054.2 +060800 6-EXIT. RL1054.2 +060900 EXIT. RL1054.2 +061000 REL-TEST-7. RL1054.2 +061100 OPEN INPUT RL-FR3. RL1054.2 +061200 MOVE 08 TO SUB-1 KEY-3 2POS-NUM. RL1054.2 +061300 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +061400 READ-FOR-TEST-7. RL1054.2 +061500 READ RL-FR3 INVALID KEY RL1054.2 +061600 MOVE "INVALID KEY ON FILE3" TO COMPUTED-A RL1054.2 +061700 MOVE SPACE TO CORRECT-A RL1054.2 +061800 PERFORM FAIL RL1054.2 +061900 GO TO REL-TEST-7-WRITE. RL1054.2 +062000 IF GRP-1SEQ-RECORD-3 NOT EQUAL TO RECORD-MESSAGE RL1054.2 +062100 MOVE GRP-1SEQ-RECORD-3 TO COMPUTED-A RL1054.2 +062200 MOVE "8TH RECORD MESSAGE" TO CORRECT-A RL1054.2 +062300 MOVE "COMPUTED-A SHOWS 1ST 20 POS" TO RE-MARK RL1054.2 +062400 PERFORM FAIL RL1054.2 +062500 GO TO REL-TEST-7-WRITE. RL1054.2 +062600 PERFORM PASS. RL1054.2 +062700 REL-TEST-7-WRITE. RL1054.2 +062800 MOVE "REL-TEST-7 " TO PAR-NAME. RL1054.2 +062900 PERFORM PRINT-DETAIL. RL1054.2 +063000 CLOSE RL-FR3. RL1054.2 +063100 CCVS-EXIT SECTION. RL1054.2 +063200 CCVS-999999. RL1054.2 +063300 GO TO CLOSE-FILES. RL1054.2 +*END-OF,RL105A +*HEADER,COBOL,RL106A +000100 IDENTIFICATION DIVISION. RL1064.2 +000200 PROGRAM-ID. RL1064.2 +000300 RL106A. RL1064.2 +000400**************************************************************** RL1064.2 +000500* * RL1064.2 +000600* VALIDATION FOR:- * RL1064.2 +000700* * RL1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +000900* * RL1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1064.2 +001100* * RL1064.2 +001200**************************************************************** RL1064.2 +001300*GENERAL: THIS PROGRAM PROCESSES THREE RLEATIVE I-O FILES RL1064.2 +001400* IDENTIFIED AS RL-FR4,RL-FR5 AND RL-FR6. THE FUNCTIONRL1064.2 +001500* OF THIS PROGRAM IS TO CREATE THREE RELATIVE FILES RL1064.2 +001600* RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY THAT THEY RL1064.2 +001700* WERE CREATED CORRECTLY. THE FILES PROCESSED RL1064.2 +001800* CONTAIN VARIABLE LENGTH RECORDS. RL1064.2 +001900* RL1064.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1064.2 +002100* PROGRAM ARE: RL1064.2 +002200* RL1064.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002400* RELATIVE I-O DATA FILE-1 RL1064.2 +002500* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002600* RELATIVE I-O DATA FILE-2 RL1064.2 +002700* X-23 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002800* RELATIVE I-O DATA FILE-3 RL1064.2 +002900* X-55 SYSTEM PRINTER RL1064.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1064.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1064.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1064.2 +003300* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1064.2 +003400* X-77 OBJECT OF VALUE OF CLAUSE FOR FILE-3 RL1064.2 +003500* X-82 SOURCE-COMPUTER RL1064.2 +003600* X-83 OBJECT-COMPUTER. RL1064.2 +003700* RL1064.2 +003800**************************************************************** RL1064.2 +003900 ENVIRONMENT DIVISION. RL1064.2 +004000 CONFIGURATION SECTION. RL1064.2 +004100 SOURCE-COMPUTER. RL1064.2 +004200 XXXXX082. RL1064.2 +004300 OBJECT-COMPUTER. RL1064.2 +004400 XXXXX083. RL1064.2 +004500 INPUT-OUTPUT SECTION. RL1064.2 +004600 FILE-CONTROL. RL1064.2 +004700 SELECT PRINT-FILE ASSIGN TO RL1064.2 +004800 XXXXX055. RL1064.2 +004900 SELECT RL-FR4 ASSIGN TO RL1064.2 +005000 XXXXX021 RL1064.2 +005100 ORGANIZATION IS RELATIVE RL1064.2 +005200 ACCESS MODE IS RANDOM RL1064.2 +005300 RELATIVE KEY IS KEY-1. RL1064.2 +005400 SELECT RL-FR5 ASSIGN TO RL1064.2 +005500 XXXXX022 RL1064.2 +005600 ORGANIZATION IS RELATIVE RL1064.2 +005700 ACCESS MODE IS RANDOM RL1064.2 +005800 RELATIVE KEY IS KEY-2. RL1064.2 +005900 SELECT RL-FR6 ASSIGN TO RL1064.2 +006000 XXXXX023 RL1064.2 +006100 ORGANIZATION IS RELATIVE RL1064.2 +006200 ACCESS MODE IS RANDOM RL1064.2 +006300 RELATIVE KEY IS KEY-3. RL1064.2 +006400 I-O-CONTROL. RL1064.2 +006500 SAME RL-FR5 RL-FR6. RL1064.2 +006600 DATA DIVISION. RL1064.2 +006700 FILE SECTION. RL1064.2 +006800 FD PRINT-FILE. RL1064.2 +006900 01 PRINT-REC PICTURE X(120). RL1064.2 +007000 01 DUMMY-RECORD PICTURE X(120). RL1064.2 +007100 FD RL-FR4 RL1064.2 +007200C VALUE OF RL1064.2 +007300C XXXXX074 RL1064.2 +007400C IS RL1064.2 +007500C XXXXX075 RL1064.2 +007600G XXXXX069 RL1064.2 +007700 LABEL RECORDS ARE STANDARD RL1064.2 +007800 DATA RECORDS ARE GRP-1SEQ-RECORD-4A GRP-1SEQ-RECORD-4B. RL1064.2 +007900 01 GRP-1SEQ-RECORD-4A. RL1064.2 +008000 02 FILLER-4A PICTURE X(56). RL1064.2 +008100 01 GRP-1SEQ-RECORD-4B. RL1064.2 +008200 02 FILLER-4B PICTURE X(56). RL1064.2 +008300 02 LONG-REC-4B. RL1064.2 +008400 03 FILLER PICTURE X(15). RL1064.2 +008500 03 REC-NUMBER-4B PIC XX. RL1064.2 +008600 03 FILLER PICTURE X(27). RL1064.2 +008700 FD RL-FR5 RL1064.2 +008800 RECORD CONTAINS 56 TO 101 CHARACTERS RL1064.2 +008900C VALUE OF RL1064.2 +009000C XXXXX074 RL1064.2 +009100C IS RL1064.2 +009200C XXXXX076 RL1064.2 +009300G XXXXX069 RL1064.2 +009400 LABEL RECORDS ARE STANDARD RL1064.2 +009500 DATA RECORDS GRP-1SEQ-RECORD-5A GRP-1SEQ-RECORD-5B. RL1064.2 +009600 01 GRP-1SEQ-RECORD-5A. RL1064.2 +009700 02 FILLER-5A PICTURE X(56). RL1064.2 +009800 01 GRP-1SEQ-RECORD-5B. RL1064.2 +009900 02 FILLER-5B PICTURE X(56). RL1064.2 +010000 02 LONG-REC-5B. RL1064.2 +010100 03 FILLER PICTURE X(15). RL1064.2 +010200 03 REC-NUMBER-5B PIC XX. RL1064.2 +010300 03 FILLER PICTURE X(28). RL1064.2 +010400 FD RL-FR6 RL1064.2 +010500 BLOCK 3 RECORDS RL1064.2 +010600 RECORD CONTAINS 56 TO 102 CHARACTERS RL1064.2 +010700 LABEL RECORD STANDARD RL1064.2 +010800C VALUE OF RL1064.2 +010900C XXXXX074 RL1064.2 +011000C IS RL1064.2 +011100C XXXXX077 RL1064.2 +011200 DATA RECORD GRP-1SEQ-RECORD-6A GRP-1SEQ-RECORD-6B. RL1064.2 +011300 01 GRP-1SEQ-RECORD-6A. RL1064.2 +011400 02 FILLER-6A PICTURE X(56). RL1064.2 +011500 01 GRP-1SEQ-RECORD-6B. RL1064.2 +011600 02 FILLER-6B PICTURE X(56). RL1064.2 +011700 02 LONG-REC-6B. RL1064.2 +011800 03 FILLER PICTURE X(15). RL1064.2 +011900 03 REC-NUMBER-6B PIC XX. RL1064.2 +012000 03 FILLER PICTURE X(29). RL1064.2 +012100 WORKING-STORAGE SECTION. RL1064.2 +012200 77 SUB-1 PICTURE 99. RL1064.2 +012300 77 KEY-1 RL1064.2 +012400 PICTURE 9(5). RL1064.2 +012500 77 KEY-2 RL1064.2 +012600 PICTURE 9(5). RL1064.2 +012700 77 KEY-3 RL1064.2 +012800 PICTURE 9(5). RL1064.2 +012900 01 READ-WRITE-COUNTER. RL1064.2 +013000 02 ENTRY-RW OCCURS 20 TIMES PICTURE X. RL1064.2 +013100 01 RECORD-BUILD. RL1064.2 +013200 02 FILLER PICTURE X(27) VALUE RL1064.2 +013300 " TYPE OF RECORD WRITTEN IS ". RL1064.2 +013400 02 RECORD-LONG-OR-SHORT PICTURE X(5) VALUE "SHORT". RL1064.2 +013500 02 FILLER PICTURE X(24) VALUE SPACE. RL1064.2 +013600 02 RECORD-LONG-ONLY. RL1064.2 +013700 03 FILLER PICTURE X(15) VALUE RL1064.2 +013800 " RECORD NUMBER ". RL1064.2 +013900 03 POS-NUM2 PICTURE 99. RL1064.2 +014000 03 FILLER-LONG PICTURE X(29) VALUE RL1064.2 +014100 " AREA USED FOR LONG RECORD ". RL1064.2 +014200 01 FILE-RECORD-INFORMATION-REC. RL1064.2 +014300 03 FILE-RECORD-INFO-SKELETON. RL1064.2 +014400 05 FILLER PICTURE X(48) VALUE RL1064.2 +014500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1064.2 +014600 05 FILLER PICTURE X(46) VALUE RL1064.2 +014700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1064.2 +014800 05 FILLER PICTURE X(26) VALUE RL1064.2 +014900 ",LFIL=000000,ORG= ,LBLR= ". RL1064.2 +015000 05 FILLER PICTURE X(37) VALUE RL1064.2 +015100 ",RECKEY= ". RL1064.2 +015200 05 FILLER PICTURE X(38) VALUE RL1064.2 +015300 ",ALTKEY1= ". RL1064.2 +015400 05 FILLER PICTURE X(38) VALUE RL1064.2 +015500 ",ALTKEY2= ". RL1064.2 +015600 05 FILLER PICTURE X(7) VALUE SPACE.RL1064.2 +015700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1064.2 +015800 05 FILE-RECORD-INFO-P1-120. RL1064.2 +015900 07 FILLER PIC X(5). RL1064.2 +016000 07 XFILE-NAME PIC X(6). RL1064.2 +016100 07 FILLER PIC X(8). RL1064.2 +016200 07 XRECORD-NAME PIC X(6). RL1064.2 +016300 07 FILLER PIC X(1). RL1064.2 +016400 07 REELUNIT-NUMBER PIC 9(1). RL1064.2 +016500 07 FILLER PIC X(7). RL1064.2 +016600 07 XRECORD-NUMBER PIC 9(6). RL1064.2 +016700 07 FILLER PIC X(6). RL1064.2 +016800 07 UPDATE-NUMBER PIC 9(2). RL1064.2 +016900 07 FILLER PIC X(5). RL1064.2 +017000 07 ODO-NUMBER PIC 9(4). RL1064.2 +017100 07 FILLER PIC X(5). RL1064.2 +017200 07 XPROGRAM-NAME PIC X(5). RL1064.2 +017300 07 FILLER PIC X(7). RL1064.2 +017400 07 XRECORD-LENGTH PIC 9(6). RL1064.2 +017500 07 FILLER PIC X(7). RL1064.2 +017600 07 CHARS-OR-RECORDS PIC X(2). RL1064.2 +017700 07 FILLER PIC X(1). RL1064.2 +017800 07 XBLOCK-SIZE PIC 9(4). RL1064.2 +017900 07 FILLER PIC X(6). RL1064.2 +018000 07 RECORDS-IN-FILE PIC 9(6). RL1064.2 +018100 07 FILLER PIC X(5). RL1064.2 +018200 07 XFILE-ORGANIZATION PIC X(2). RL1064.2 +018300 07 FILLER PIC X(6). RL1064.2 +018400 07 XLABEL-TYPE PIC X(1). RL1064.2 +018500 05 FILE-RECORD-INFO-P121-240. RL1064.2 +018600 07 FILLER PIC X(8). RL1064.2 +018700 07 XRECORD-KEY PIC X(29). RL1064.2 +018800 07 FILLER PIC X(9). RL1064.2 +018900 07 ALTERNATE-KEY1 PIC X(29). RL1064.2 +019000 07 FILLER PIC X(9). RL1064.2 +019100 07 ALTERNATE-KEY2 PIC X(29). RL1064.2 +019200 07 FILLER PIC X(7). RL1064.2 +019300 01 TEST-RESULTS. RL1064.2 +019400 02 FILLER PIC X VALUE SPACE. RL1064.2 +019500 02 FEATURE PIC X(20) VALUE SPACE. RL1064.2 +019600 02 FILLER PIC X VALUE SPACE. RL1064.2 +019700 02 P-OR-F PIC X(5) VALUE SPACE. RL1064.2 +019800 02 FILLER PIC X VALUE SPACE. RL1064.2 +019900 02 PAR-NAME. RL1064.2 +020000 03 FILLER PIC X(19) VALUE SPACE. RL1064.2 +020100 03 PARDOT-X PIC X VALUE SPACE. RL1064.2 +020200 03 DOTVALUE PIC 99 VALUE ZERO. RL1064.2 +020300 02 FILLER PIC X(8) VALUE SPACE. RL1064.2 +020400 02 RE-MARK PIC X(61). RL1064.2 +020500 01 TEST-COMPUTED. RL1064.2 +020600 02 FILLER PIC X(30) VALUE SPACE. RL1064.2 +020700 02 FILLER PIC X(17) VALUE RL1064.2 +020800 " COMPUTED=". RL1064.2 +020900 02 COMPUTED-X. RL1064.2 +021000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1064.2 +021100 03 COMPUTED-N REDEFINES COMPUTED-A RL1064.2 +021200 PIC -9(9).9(9). RL1064.2 +021300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1064.2 +021400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1064.2 +021500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1064.2 +021600 03 CM-18V0 REDEFINES COMPUTED-A. RL1064.2 +021700 04 COMPUTED-18V0 PIC -9(18). RL1064.2 +021800 04 FILLER PIC X. RL1064.2 +021900 03 FILLER PIC X(50) VALUE SPACE. RL1064.2 +022000 01 TEST-CORRECT. RL1064.2 +022100 02 FILLER PIC X(30) VALUE SPACE. RL1064.2 +022200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1064.2 +022300 02 CORRECT-X. RL1064.2 +022400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1064.2 +022500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1064.2 +022600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1064.2 +022700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1064.2 +022800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1064.2 +022900 03 CR-18V0 REDEFINES CORRECT-A. RL1064.2 +023000 04 CORRECT-18V0 PIC -9(18). RL1064.2 +023100 04 FILLER PIC X. RL1064.2 +023200 03 FILLER PIC X(2) VALUE SPACE. RL1064.2 +023300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1064.2 +023400 01 CCVS-C-1. RL1064.2 +023500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1064.2 +023600- "SS PARAGRAPH-NAME RL1064.2 +023700- " REMARKS". RL1064.2 +023800 02 FILLER PIC X(20) VALUE SPACE. RL1064.2 +023900 01 CCVS-C-2. RL1064.2 +024000 02 FILLER PIC X VALUE SPACE. RL1064.2 +024100 02 FILLER PIC X(6) VALUE "TESTED". RL1064.2 +024200 02 FILLER PIC X(15) VALUE SPACE. RL1064.2 +024300 02 FILLER PIC X(4) VALUE "FAIL". RL1064.2 +024400 02 FILLER PIC X(94) VALUE SPACE. RL1064.2 +024500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1064.2 +024600 01 REC-CT PIC 99 VALUE ZERO. RL1064.2 +024700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1064.2 +024800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1064.2 +024900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1064.2 +025000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1064.2 +025100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1064.2 +025200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1064.2 +025300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1064.2 +025400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1064.2 +025500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1064.2 +025600 01 CCVS-H-1. RL1064.2 +025700 02 FILLER PIC X(39) VALUE SPACES. RL1064.2 +025800 02 FILLER PIC X(42) VALUE RL1064.2 +025900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1064.2 +026000 02 FILLER PIC X(39) VALUE SPACES. RL1064.2 +026100 01 CCVS-H-2A. RL1064.2 +026200 02 FILLER PIC X(40) VALUE SPACE. RL1064.2 +026300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1064.2 +026400 02 FILLER PIC XXXX VALUE RL1064.2 +026500 "4.2 ". RL1064.2 +026600 02 FILLER PIC X(28) VALUE RL1064.2 +026700 " COPY - NOT FOR DISTRIBUTION". RL1064.2 +026800 02 FILLER PIC X(41) VALUE SPACE. RL1064.2 +026900 RL1064.2 +027000 01 CCVS-H-2B. RL1064.2 +027100 02 FILLER PIC X(15) VALUE RL1064.2 +027200 "TEST RESULT OF ". RL1064.2 +027300 02 TEST-ID PIC X(9). RL1064.2 +027400 02 FILLER PIC X(4) VALUE RL1064.2 +027500 " IN ". RL1064.2 +027600 02 FILLER PIC X(12) VALUE RL1064.2 +027700 " HIGH ". RL1064.2 +027800 02 FILLER PIC X(22) VALUE RL1064.2 +027900 " LEVEL VALIDATION FOR ". RL1064.2 +028000 02 FILLER PIC X(58) VALUE RL1064.2 +028100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +028200 01 CCVS-H-3. RL1064.2 +028300 02 FILLER PIC X(34) VALUE RL1064.2 +028400 " FOR OFFICIAL USE ONLY ". RL1064.2 +028500 02 FILLER PIC X(58) VALUE RL1064.2 +028600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1064.2 +028700 02 FILLER PIC X(28) VALUE RL1064.2 +028800 " COPYRIGHT 1985 ". RL1064.2 +028900 01 CCVS-E-1. RL1064.2 +029000 02 FILLER PIC X(52) VALUE SPACE. RL1064.2 +029100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1064.2 +029200 02 ID-AGAIN PIC X(9). RL1064.2 +029300 02 FILLER PIC X(45) VALUE SPACES. RL1064.2 +029400 01 CCVS-E-2. RL1064.2 +029500 02 FILLER PIC X(31) VALUE SPACE. RL1064.2 +029600 02 FILLER PIC X(21) VALUE SPACE. RL1064.2 +029700 02 CCVS-E-2-2. RL1064.2 +029800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1064.2 +029900 03 FILLER PIC X VALUE SPACE. RL1064.2 +030000 03 ENDER-DESC PIC X(44) VALUE RL1064.2 +030100 "ERRORS ENCOUNTERED". RL1064.2 +030200 01 CCVS-E-3. RL1064.2 +030300 02 FILLER PIC X(22) VALUE RL1064.2 +030400 " FOR OFFICIAL USE ONLY". RL1064.2 +030500 02 FILLER PIC X(12) VALUE SPACE. RL1064.2 +030600 02 FILLER PIC X(58) VALUE RL1064.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +030800 02 FILLER PIC X(13) VALUE SPACE. RL1064.2 +030900 02 FILLER PIC X(15) VALUE RL1064.2 +031000 " COPYRIGHT 1985". RL1064.2 +031100 01 CCVS-E-4. RL1064.2 +031200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1064.2 +031300 02 FILLER PIC X(4) VALUE " OF ". RL1064.2 +031400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1064.2 +031500 02 FILLER PIC X(40) VALUE RL1064.2 +031600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1064.2 +031700 01 XXINFO. RL1064.2 +031800 02 FILLER PIC X(19) VALUE RL1064.2 +031900 "*** INFORMATION ***". RL1064.2 +032000 02 INFO-TEXT. RL1064.2 +032100 04 FILLER PIC X(8) VALUE SPACE. RL1064.2 +032200 04 XXCOMPUTED PIC X(20). RL1064.2 +032300 04 FILLER PIC X(5) VALUE SPACE. RL1064.2 +032400 04 XXCORRECT PIC X(20). RL1064.2 +032500 02 INF-ANSI-REFERENCE PIC X(48). RL1064.2 +032600 01 HYPHEN-LINE. RL1064.2 +032700 02 FILLER PIC IS X VALUE IS SPACE. RL1064.2 +032800 02 FILLER PIC IS X(65) VALUE IS "************************RL1064.2 +032900- "*****************************************". RL1064.2 +033000 02 FILLER PIC IS X(54) VALUE IS "************************RL1064.2 +033100- "******************************". RL1064.2 +033200 01 CCVS-PGM-ID PIC X(9) VALUE RL1064.2 +033300 "RL106A". RL1064.2 +033400 PROCEDURE DIVISION. RL1064.2 +033500 CCVS1 SECTION. RL1064.2 +033600 OPEN-FILES. RL1064.2 +033700 OPEN OUTPUT PRINT-FILE. RL1064.2 +033800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1064.2 +033900 MOVE SPACE TO TEST-RESULTS. RL1064.2 +034000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1064.2 +034100 MOVE ZERO TO REC-SKL-SUB. RL1064.2 +034200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1064.2 +034300 CCVS-INIT-FILE. RL1064.2 +034400 ADD 1 TO REC-SKL-SUB. RL1064.2 +034500 MOVE FILE-RECORD-INFO-SKELETON RL1064.2 +034600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1064.2 +034700 CCVS-INIT-EXIT. RL1064.2 +034800 GO TO CCVS1-EXIT. RL1064.2 +034900 CLOSE-FILES. RL1064.2 +035000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1064.2 +035100 TERMINATE-CCVS. RL1064.2 +035200S EXIT PROGRAM. RL1064.2 +035300STERMINATE-CALL. RL1064.2 +035400 STOP RUN. RL1064.2 +035500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1064.2 +035600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1064.2 +035700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1064.2 +035800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1064.2 +035900 MOVE "****TEST DELETED****" TO RE-MARK. RL1064.2 +036000 PRINT-DETAIL. RL1064.2 +036100 IF REC-CT NOT EQUAL TO ZERO RL1064.2 +036200 MOVE "." TO PARDOT-X RL1064.2 +036300 MOVE REC-CT TO DOTVALUE. RL1064.2 +036400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1064.2 +036500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1064.2 +036600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1064.2 +036700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1064.2 +036800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1064.2 +036900 MOVE SPACE TO CORRECT-X. RL1064.2 +037000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1064.2 +037100 MOVE SPACE TO RE-MARK. RL1064.2 +037200 HEAD-ROUTINE. RL1064.2 +037300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +037400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +037500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1064.2 +037600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1064.2 +037700 COLUMN-NAMES-ROUTINE. RL1064.2 +037800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +037900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +038000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +038100 END-ROUTINE. RL1064.2 +038200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1064.2 +038300 END-RTN-EXIT. RL1064.2 +038400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +038500 END-ROUTINE-1. RL1064.2 +038600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1064.2 +038700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1064.2 +038800 ADD PASS-COUNTER TO ERROR-HOLD. RL1064.2 +038900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1064.2 +039000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1064.2 +039100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1064.2 +039200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1064.2 +039300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1064.2 +039400 END-ROUTINE-12. RL1064.2 +039500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1064.2 +039600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1064.2 +039700 MOVE "NO " TO ERROR-TOTAL RL1064.2 +039800 ELSE RL1064.2 +039900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1064.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1064.2 +040100 PERFORM WRITE-LINE. RL1064.2 +040200 END-ROUTINE-13. RL1064.2 +040300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1064.2 +040400 MOVE "NO " TO ERROR-TOTAL ELSE RL1064.2 +040500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1064.2 +040600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1064.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +040800 IF INSPECT-COUNTER EQUAL TO ZERO RL1064.2 +040900 MOVE "NO " TO ERROR-TOTAL RL1064.2 +041000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1064.2 +041100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1064.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +041300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +041400 WRITE-LINE. RL1064.2 +041500 ADD 1 TO RECORD-COUNT. RL1064.2 +041600Y IF RECORD-COUNT GREATER 50 RL1064.2 +041700Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1064.2 +041800Y MOVE SPACE TO DUMMY-RECORD RL1064.2 +041900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1064.2 +042000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1064.2 +042100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1064.2 +042200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1064.2 +042300Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1064.2 +042400Y MOVE ZERO TO RECORD-COUNT. RL1064.2 +042500 PERFORM WRT-LN. RL1064.2 +042600 WRT-LN. RL1064.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1064.2 +042800 MOVE SPACE TO DUMMY-RECORD. RL1064.2 +042900 BLANK-LINE-PRINT. RL1064.2 +043000 PERFORM WRT-LN. RL1064.2 +043100 FAIL-ROUTINE. RL1064.2 +043200 IF COMPUTED-X NOT EQUAL TO SPACE RL1064.2 +043300 GO TO FAIL-ROUTINE-WRITE. RL1064.2 +043400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1064.2 +043500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1064.2 +043600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1064.2 +043700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +043800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1064.2 +043900 GO TO FAIL-ROUTINE-EX. RL1064.2 +044000 FAIL-ROUTINE-WRITE. RL1064.2 +044100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1064.2 +044200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1064.2 +044300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1064.2 +044400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1064.2 +044500 FAIL-ROUTINE-EX. EXIT. RL1064.2 +044600 BAIL-OUT. RL1064.2 +044700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1064.2 +044800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1064.2 +044900 BAIL-OUT-WRITE. RL1064.2 +045000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1064.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1064.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1064.2 +045400 BAIL-OUT-EX. EXIT. RL1064.2 +045500 CCVS1-EXIT. RL1064.2 +045600 EXIT. RL1064.2 +045700 SECT-RC106-001 SECTION. RL1064.2 +045800 SECT-RC-02-001-INIT. RL1064.2 +045900 MOVE 1 TO KEY-1 POS-NUM2. RL1064.2 +046000 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +046100 MOVE "R/W REL LENGTH RECS" TO FEATURE. RL1064.2 +046200 REL-TEST-8. RL1064.2 +046300 OPEN OUTPUT RL-FR4. RL1064.2 +046400 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +046500 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +046600 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +046700 ADD 1 TO POS-NUM2. RL1064.2 +046800 MOVE POS-NUM2 TO KEY-1. RL1064.2 +046900 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +047000 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +047100 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +047200 ADD 1 TO POS-NUM2. RL1064.2 +047300 MOVE POS-NUM2 TO KEY-1. RL1064.2 +047400 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +047500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +047600 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +047700 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +047800 ADD 1 TO POS-NUM2. RL1064.2 +047900 MOVE POS-NUM2 TO KEY-1. RL1064.2 +048000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +048100 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +048200 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +048300 ADD 1 TO POS-NUM2. RL1064.2 +048400 MOVE POS-NUM2 TO KEY-1. RL1064.2 +048500 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +048600 PERFORM WRITE-FOR-TEST-8 THRU 8-EXIT 11 TIMES. RL1064.2 +048700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +048800 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +048900 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +049000 ADD 1 TO POS-NUM2. RL1064.2 +049100 MOVE POS-NUM2 TO KEY-1. RL1064.2 +049200 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +049300 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +049400 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +049500 ADD 1 TO POS-NUM2. RL1064.2 +049600 MOVE POS-NUM2 TO KEY-1. RL1064.2 +049700 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +049800 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +049900 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +050000 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +050100 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1064.2 +050200 MOVE SPACE TO P-OR-F. RL1064.2 +050300 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWWWW " RL1064.2 +050400 MOVE READ-WRITE-COUNTER TO COMPUTED-A ELSE RL1064.2 +050500 MOVE "18 RECORDS PASSED TO TEST-9" TO RE-MARK. RL1064.2 +050600 GO TO REL-TEST-8-WRITE. RL1064.2 +050700 REL-DELETE-8. RL1064.2 +050800 PERFORM DE-LETE. RL1064.2 +050900*NOTE RL-FR4 IS NOT CREATED - SO SKIP TO REL-TEST-11. RL1064.2 +051000 MOVE "REL-TEST-8 " TO PAR-NAME. RL1064.2 +051100 PERFORM PRINT-DETAIL. RL1064.2 +051200 GO TO REL-TEST-11. RL1064.2 +051300 INVALID-TEST-8. RL1064.2 +051400 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +051500 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +051600 PERFORM FAIL. RL1064.2 +051700 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +051800 REL-TEST-8-WRITE. RL1064.2 +051900 MOVE "REL-TEST-8 " TO PAR-NAME. RL1064.2 +052000 PERFORM PRINT-DETAIL. RL1064.2 +052100 CLOSE RL-FR4. RL1064.2 +052200* RL1064.2 +052300 GO TO INIT-TEST-9. RL1064.2 +052400 WRITE-FOR-TEST-8. RL1064.2 +052500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +052600 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO I-KEY-8. RL1064.2 +052700 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +052800 ADD 1 TO POS-NUM2. RL1064.2 +052900 MOVE POS-NUM2 TO KEY-1. RL1064.2 +053000 GO TO 8-EXIT. RL1064.2 +053100 I-KEY-8. RL1064.2 +053200 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +053300 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +053400 ADD 1 TO POS-NUM2. RL1064.2 +053500 MOVE POS-NUM2 TO KEY-1. RL1064.2 +053600 PERFORM FAIL. RL1064.2 +053700 8-EXIT. RL1064.2 +053800 EXIT. RL1064.2 +053900 INIT-TEST-9. RL1064.2 +054000 OPEN INPUT RL-FR4. RL1064.2 +054100 MOVE 01 TO SUB-1 KEY-1. RL1064.2 +054200 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +054300 REL-TEST-9. RL1064.2 +054400 READ RL-FR4 INVALID KEY RL1064.2 +054500 MOVE "E" TO ENTRY-RW (SUB-1) RL1064.2 +054600 GO TO COMPARE-FOR-TEST-9. RL1064.2 +054700 IF SUB-1 EQUAL TO 19 RL1064.2 +054800 GO TO COMPARE-FOR-TEST-9. RL1064.2 +054900 MOVE "R" TO ENTRY-RW (SUB-1). RL1064.2 +055000 ADD 1 TO SUB-1. RL1064.2 +055100 MOVE SUB-1 TO KEY-1. RL1064.2 +055200 GO TO REL-TEST-9. RL1064.2 +055300 COMPARE-FOR-TEST-9. RL1064.2 +055400 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRRRE " RL1064.2 +055500 PERFORM PASS RL1064.2 +055600 GO TO REL-TEST-9-WRITE. RL1064.2 +055700 MOVE "RRRRRRRRRRRRRRRRRRE " TO CORRECT-A. RL1064.2 +055800 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +055900 PERFORM FAIL. RL1064.2 +056000 MOVE "INCORRECT NUMBER OF READS " TO RE-MARK. RL1064.2 +056100 REL-TEST-9-WRITE. RL1064.2 +056200 MOVE "REL-TEST-9 " TO PAR-NAME. RL1064.2 +056300 PERFORM PRINT-DETAIL. RL1064.2 +056400 CLOSE RL-FR4. RL1064.2 +056500 INIT-TEST-10. RL1064.2 +056600 OPEN INPUT RL-FR4. RL1064.2 +056700 MOVE 10 TO SUB-1 KEY-1. RL1064.2 +056800 REL-TEST-10. RL1064.2 +056900 READ RL-FR4 INVALID KEY RL1064.2 +057000 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +057100 MOVE SPACE TO CORRECT-A RL1064.2 +057200 MOVE "INVAILD KEY RL-FR4 " TO RE-MARK RL1064.2 +057300 PERFORM FAIL RL1064.2 +057400 GO TO REL-TEST-10-WRITE. RL1064.2 +057500* NOTE *** IF REC-NUMBER-4B CONTAINS THE RECORD NUMBER RL1064.2 +057600* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +057700* OF VARIABLE LENGTH RECORDS. RL1064.2 +057800* NOTE CHECK LENGTH OF RECORD 10. RL1064.2 +057900 COMPARE-FOR-TEST-10. RL1064.2 +058000 IF REC-NUMBER-4B EQUAL TO "10" RL1064.2 +058100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +058200 REL-TEST-10-WRITE. RL1064.2 +058300 CLOSE RL-FR4. RL1064.2 +058400 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +058500 MOVE "REL-TEST-10 " TO PAR-NAME. RL1064.2 +058600 PERFORM PRINT-DETAIL. RL1064.2 +058700 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +058800 MOVE 1 TO KEY-2 POS-NUM2. RL1064.2 +058900 REL-TEST-11. RL1064.2 +059000 OPEN OUTPUT RL-FR5. RL1064.2 +059100 PERFORM REL-TEST-11-SHORT-REC 2 TIMES. RL1064.2 +059200 PERFORM REL-TEST-11-LONG-REC 2 TIMES. RL1064.2 +059300 PERFORM REL-TEST-11-SHORT-REC 4 TIMES. RL1064.2 +059400 PERFORM REL-TEST-11-LONG-REC 2 TIMES. RL1064.2 +059500 MOVE SPACE TO COMPUTED-A CORRECT-A. RL1064.2 +059600 MOVE "10 RECORDS PASSED TEST-12" TO RE-MARK. RL1064.2 +059700 GO TO REL-TEST-11-WRITE. RL1064.2 +059800 REL-DELETE-11. RL1064.2 +059900 PERFORM DE-LETE. RL1064.2 +060000* NOTE RL-FR5 IS NOT CREATED SO SKIP TO REL-TEST-15. RL1064.2 +060100 MOVE "REL-TEST-11 " TO PAR-NAME. RL1064.2 +060200 PERFORM PRINT-DETAIL. RL1064.2 +060300 GO TO REL-TEST-15. RL1064.2 +060400 REL-TEST-11-LONG-REC. RL1064.2 +060500 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +060600 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-5B. RL1064.2 +060700 WRITE GRP-1SEQ-RECORD-5B INVALID KEY GO TO I-KEY-11. RL1064.2 +060800 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +060900 ADD 1 TO POS-NUM2. RL1064.2 +061000 MOVE POS-NUM2 TO KEY-2. RL1064.2 +061100 REL-TEST-11-SHORT-REC. RL1064.2 +061200 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +061300 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-5B. RL1064.2 +061400 WRITE GRP-1SEQ-RECORD-5A INVALID KEY GO TO I-KEY-11. RL1064.2 +061500 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +061600 ADD 1 TO POS-NUM2. RL1064.2 +061700 MOVE POS-NUM2 TO KEY-2. RL1064.2 +061800 I-KEY-11. RL1064.2 +061900 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +062000 PERFORM FAIL. RL1064.2 +062100 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +062200 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +062300 REL-TEST-11-WRITE. RL1064.2 +062400 CLOSE RL-FR5. RL1064.2 +062500 MOVE "REL-TEST-11 " TO PAR-NAME. RL1064.2 +062600 PERFORM PRINT-DETAIL. RL1064.2 +062700* RL1064.2 +062800 INIT-TEST-12. RL1064.2 +062900 OPEN INPUT RL-FR5. RL1064.2 +063000 MOVE 01 TO SUB-1 KEY-2. RL1064.2 +063100 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +063200 REL-TEST-12. RL1064.2 +063300 READ RL-FR5 INVALID KEY RL1064.2 +063400 MOVE "E" TO ENTRY-RW (SUB-1) RL1064.2 +063500 GO TO COMPARE-FOR-TEST-12. RL1064.2 +063600 MOVE "R" TO ENTRY-RW (SUB-1). RL1064.2 +063700 IF SUB-1 EQUAL TO 11 RL1064.2 +063800 GO TO COMPARE-FOR-TEST-12. RL1064.2 +063900 ADD 1 TO SUB-1. RL1064.2 +064000* NOTE BLANK OUT GARBAGE IN INPUT AREA. RL1064.2 +064100* MOVE SPACE TO GRP-1SEQ-RECORD-5B. RL1064.2 +064200 MOVE SUB-1 TO KEY-2. RL1064.2 +064300 GO TO REL-TEST-12. RL1064.2 +064400 COMPARE-FOR-TEST-12. RL1064.2 +064500 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRE" RL1064.2 +064600 PERFORM PASS RL1064.2 +064700 GO TO REL-TEST-12-WRITE. RL1064.2 +064800 MOVE "RRRRRRRRRRE" TO CORRECT-A. RL1064.2 +064900 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +065000 PERFORM FAIL. RL1064.2 +065100 REL-TEST-12-WRITE. RL1064.2 +065200 MOVE "REL-TEST-12 " TO PAR-NAME. RL1064.2 +065300 PERFORM PRINT-DETAIL. RL1064.2 +065400 CLOSE RL-FR5. RL1064.2 +065500 INIT-TEST-13. RL1064.2 +065600 OPEN INPUT RL-FR5. RL1064.2 +065700 MOVE 05 TO SUB-1 KEY-2. RL1064.2 +065800 READ-FOR-TEST-13. RL1064.2 +065900 READ RL-FR5 INVALID KEY RL1064.2 +066000 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +066100 MOVE SPACE TO CORRECT-A RL1064.2 +066200 MOVE "INVALID KEY RL-FR5 " TO RE-MARK RL1064.2 +066300 PERFORM FAIL RL1064.2 +066400 GO TO REL-TEST-13-WRITE. RL1064.2 +066500* NOTE *** IF REC-NUMBER-5B CONTAINS THE RECORD NUMBER RL1064.2 +066600* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +066700* OF VARIABLE LENGTH RECORDS. RL1064.2 +066800* NOTE CHECK LENGTH OF RECORD 5. RL1064.2 +066900 REL-TEST-13. RL1064.2 +067000 IF REC-NUMBER-5B EQUAL TO "05" RL1064.2 +067100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +067200 REL-TEST-13-WRITE. RL1064.2 +067300 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +067400 MOVE "REL-TEST-13 " TO PAR-NAME. RL1064.2 +067500 PERFORM PRINT-DETAIL. RL1064.2 +067600 MOVE 6 TO KEY-2. RL1064.2 +067700 REL-TEST-14. RL1064.2 +067800 READ RL-FR5 INVALID KEY RL1064.2 +067900 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +068000 MOVE SPACE TO CORRECT-A RL1064.2 +068100 MOVE "INVALID KEY ON RECORD 6 " TO RE-MARK RL1064.2 +068200 PERFORM FAIL RL1064.2 +068300 GO TO REL-TEST-14-WRITE. RL1064.2 +068400* NOTE CHECK LENGTH OF RECORD 6. RL1064.2 +068500 IF REC-NUMBER-5B EQUAL TO "06" RL1064.2 +068600 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +068700 REL-TEST-14-WRITE. RL1064.2 +068800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +068900 MOVE "REL-TEST-14 " TO PAR-NAME. RL1064.2 +069000 PERFORM PRINT-DETAIL. RL1064.2 +069100 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +069200 INIT-TEST-15. RL1064.2 +069300 CLOSE RL-FR5. RL1064.2 +069400 MOVE 1 TO KEY-1 KEY-2 KEY-3 POS-NUM2. RL1064.2 +069500 REL-TEST-15. RL1064.2 +069600 OPEN OUTPUT RL-FR6. RL1064.2 +069700 PERFORM REL-TEST-12-SHORT-REC 3 TIMES. RL1064.2 +069800 PERFORM REL-TEST-12-LONG-REC 2 TIMES. RL1064.2 +069900 PERFORM REL-TEST-12-SHORT-REC. RL1064.2 +070000 PERFORM REL-TEST-12-LONG-REC 2 TIMES. RL1064.2 +070100 PERFORM REL-TEST-12-SHORT-REC 3 TIMES. RL1064.2 +070200 PERFORM REL-TEST-12-LONG-REC. RL1064.2 +070300 MOVE SPACE TO COMPUTED-A CORRECT-A. RL1064.2 +070400 MOVE "12 RECORDS PASSED TEST-16" TO RE-MARK. RL1064.2 +070500 GO TO REL-TEST-15-WRITE. RL1064.2 +070600 REL-DELETE-15. RL1064.2 +070700 PERFORM DE-LETE. RL1064.2 +070800 MOVE "REL-TEST-15 " TO PAR-NAME. RL1064.2 +070900* NOTE THIS IS THE FINAL SERIES OF TESTS, IF THESE ARE RL1064.2 +071000* DELETED, THE PROGRAM IS AT AN END SO, RL1064.2 +071100* SKIP TO END-PARAGRAPH. RL1064.2 +071200 PERFORM PRINT-DETAIL. RL1064.2 +071300 GO TO CCVS-EXIT. RL1064.2 +071400 REL-TEST-12-LONG-REC. RL1064.2 +071500 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +071600 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-6B. RL1064.2 +071700 WRITE GRP-1SEQ-RECORD-6B INVALID KEY GO TO I-KEY-15. RL1064.2 +071800 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +071900 ADD 1 TO POS-NUM2. RL1064.2 +072000 MOVE POS-NUM2 TO KEY-3. RL1064.2 +072100 REL-TEST-12-SHORT-REC. RL1064.2 +072200 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +072300 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-6B. RL1064.2 +072400 WRITE GRP-1SEQ-RECORD-6A INVALID KEY GO TO I-KEY-15. RL1064.2 +072500 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +072600 ADD 1 TO POS-NUM2. RL1064.2 +072700 MOVE POS-NUM2 TO KEY-3. RL1064.2 +072800 I-KEY-15. RL1064.2 +072900 MOVE "INVALID KEY ON WRITE " TO RE-MARK RL1064.2 +073000 PERFORM FAIL. RL1064.2 +073100 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +073200 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +073300 REL-TEST-15-WRITE. RL1064.2 +073400 MOVE "REL-TEST-15 " TO PAR-NAME. RL1064.2 +073500 PERFORM PRINT-DETAIL. RL1064.2 +073600 CLOSE RL-FR6. RL1064.2 +073700* RL1064.2 +073800 INIT-TEST-16. RL1064.2 +073900 OPEN INPUT RL-FR6. RL1064.2 +074000 MOVE 01 TO SUB-1 KEY-3. RL1064.2 +074100 REL-TEST-16. RL1064.2 +074200 READ RL-FR6 INVALID KEY RL1064.2 +074300 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +074400 MOVE SPACE TO CORRECT-A RL1064.2 +074500 MOVE "INVALID KEY ON RANDOM-FILE3" TO RE-MARK RL1064.2 +074600 PERFORM FAIL RL1064.2 +074700 GO TO REL-TEST-16-WRITE. RL1064.2 +074800 IF SUB-1 EQUAL TO 7 RL1064.2 +074900 GO TO COMPARE-FOR-TEST-16. RL1064.2 +075000 ADD 1 TO SUB-1. RL1064.2 +075100 MOVE SUB-1 TO KEY-3. RL1064.2 +075200 GO TO REL-TEST-16. RL1064.2 +075300 COMPARE-FOR-TEST-16. RL1064.2 +075400 IF REC-NUMBER-6B EQUAL TO "07" RL1064.2 +075500 PERFORM PASS RL1064.2 +075600 GO TO REL-TEST-16-WRITE. RL1064.2 +075700 MOVE "RECORD 07 EXPECTED" TO CORRECT-A. RL1064.2 +075800 MOVE SPACE TO FILLER-LONG. RL1064.2 +075900 MOVE RECORD-LONG-ONLY TO COMPUTED-A. RL1064.2 +076000 MOVE "COMPUTED-A SHOWS REC READ" TO RE-MARK. RL1064.2 +076100 PERFORM FAIL. RL1064.2 +076200 REL-TEST-16-WRITE. RL1064.2 +076300 MOVE "REL-TEST-16 " TO PAR-NAME. RL1064.2 +076400 PERFORM PRINT-DETAIL. RL1064.2 +076500 INIT-TEST-17. RL1064.2 +076600 MOVE 01 TO SUB-1 KEY-3. RL1064.2 +076700 READ-FOR-TEST-17. RL1064.2 +076800 READ RL-FR6 INVALID KEY RL1064.2 +076900 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +077000 MOVE SPACE TO CORRECT-A RL1064.2 +077100 MOVE "INVALID KEY RL-FR6 " TO RE-MARK RL1064.2 +077200 PERFORM FAIL RL1064.2 +077300 GO TO REL-TEST-17-WRITE. RL1064.2 +077400 IF SUB-1 EQUAL TO 02 RL1064.2 +077500 GO TO REL-TEST-17. RL1064.2 +077600 ADD 1 TO SUB-1. RL1064.2 +077700 MOVE SUB-1 TO KEY-3. RL1064.2 +077800 GO TO READ-FOR-TEST-17. RL1064.2 +077900 REL-TEST-17. RL1064.2 +078000 IF REC-NUMBER-6B EQUAL TO "02" RL1064.2 +078100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +078200 GO TO REL-TEST-17-WRITE. RL1064.2 +078300* NOTE CHECK LENGTH OF RECORD 2. RL1064.2 +078400* NOTE *** IF REC-NUMBER-6B CONTAINS THE RECORD NUMBER RL1064.2 +078500* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +078600* OF VARIABLE LENGTH RECORDS. RL1064.2 +078700 REL-TEST-17-WRITE. RL1064.2 +078800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +078900 MOVE "REL-TEST-17 " TO PAR-NAME. RL1064.2 +079000 PERFORM PRINT-DETAIL. RL1064.2 +079100 INIT-TEST-18. RL1064.2 +079200 MOVE 12 TO SUB-1 KEY-3. RL1064.2 +079300 READ-FOR-TEST-18. RL1064.2 +079400 READ RL-FR6 INVALID KEY RL1064.2 +079500 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +079600 MOVE "RECORD 12 IS MISSING" TO CORRECT-A RL1064.2 +079700 MOVE "ATTEMPT TO READ LAST RECORD" TO RE-MARK RL1064.2 +079800 PERFORM FAIL RL1064.2 +079900 GO TO REL-TEST-18-WRITE. RL1064.2 +080000* NOTE *** RECORD 12 WAS A LONG RECORD AND RL1064.2 +080100* REC-NUMBER-6B SHOULD CONTAIN 12. RL1064.2 +080200 REL-TEST-18. RL1064.2 +080300 IF REC-NUMBER-6B EQUAL TO "12" RL1064.2 +080400 PERFORM PASS RL1064.2 +080500 GO TO REL-TEST-18-WRITE. RL1064.2 +080600 MOVE "WRONG LENGTH RECORD" TO COMPUTED-A. RL1064.2 +080700 PERFORM FAIL. RL1064.2 +080800 REL-TEST-18-WRITE. RL1064.2 +080900 MOVE "REL-TEST-18 " TO PAR-NAME. RL1064.2 +081000 PERFORM PRINT-DETAIL. RL1064.2 +081100 CLOSE RL-FR6. RL1064.2 +081200 CCVS-EXIT SECTION. RL1064.2 +081300 CCVS-999999. RL1064.2 +081400 GO TO CLOSE-FILES. RL1064.2 +*END-OF,RL106A +*HEADER,COBOL,RL107A +000100 IDENTIFICATION DIVISION. RL1074.2 +000200 PROGRAM-ID. RL1074.2 +000300 RL107A. RL1074.2 +000400**************************************************************** RL1074.2 +000500* * RL1074.2 +000600* VALIDATION FOR:- * RL1074.2 +000700* * RL1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +000900* * RL1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1074.2 +001100* * RL1074.2 +001200**************************************************************** RL1074.2 +001300* * RL1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1074.2 +001500* * RL1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1074.2 +001900* * RL1074.2 +002000**************************************************************** RL1074.2 +002100*GENERAL: THIS PROGRAM PROCESSES TWO RELATIVE I-O FILES. THE RL1074.2 +002200* THE FUNCTION OF THIS PROGRAM IS TO CREATE TWO RL1074.2 +002300* RELATIVES FILES RANDOMLY (ACCESS MODE RANDOM) AND RL1074.2 +002400* VERIFY THAT THEY WERE CREATED CORRECTLY. THE FILES RL1074.2 +002500* ARE IDENTIFIED AS "RL-FR7" AND "RL-FR8". THE FILES RL1074.2 +002600* ARE CREATED PARTIALLY (NOT ALL VALUES FOR RELATIVE RL1074.2 +002700* KEY ARE USED) IN THE OUTPUT MODE AND SUBSEQUENTLY RL1074.2 +002800* COMPLETED IN THE I-O MODE. THE END RESULT IS THAT RL1074.2 +002900* THERE ARE NO NULL RECORDS IN ANY OF THE FILES. RL1074.2 +003000* RL1074.2 +003100* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1074.2 +003200* PROGRAM ARE: RL1074.2 +003300* RL1074.2 +003400* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1074.2 +003500* RELATIVE I-O DATA FILE-1 RL1074.2 +003600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1074.2 +003700* RELATIVE I-O DATA FILE-2 RL1074.2 +003800* X-55 SYSTEM PRINTER RL1074.2 +003900* X-69 ADDITIONAL VALUE OF CLAUSES RL1074.2 +004000* X-74 VALUE OF IMPLEMENTOR-NAME RL1074.2 +004100* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1074.2 +004200* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1074.2 +004300* X-82 SOURCE-COMPUTER RL1074.2 +004400* X-83 OBJECT-COMPUTER. RL1074.2 +004500* RL1074.2 +004600**************************************************************** RL1074.2 +004700 ENVIRONMENT DIVISION. RL1074.2 +004800 CONFIGURATION SECTION. RL1074.2 +004900 SOURCE-COMPUTER. RL1074.2 +005000 XXXXX082. RL1074.2 +005100 OBJECT-COMPUTER. RL1074.2 +005200 XXXXX083. RL1074.2 +005300 INPUT-OUTPUT SECTION. RL1074.2 +005400 FILE-CONTROL. RL1074.2 +005500 SELECT PRINT-FILE ASSIGN TO RL1074.2 +005600 XXXXX055. RL1074.2 +005700 SELECT RL-FR7 ASSIGN TO RL1074.2 +005800 XXXXX021 RL1074.2 +005900 ORGANIZATION IS RELATIVE RL1074.2 +006000 ACCESS MODE IS RANDOM RL1074.2 +006100 RELATIVE KEY ACTUAL-KEY-1. RL1074.2 +006200 SELECT RL-FR8 ASSIGN TO RL1074.2 +006300 XXXXX022 RL1074.2 +006400 ORGANIZATION IS RELATIVE RL1074.2 +006500 ACCESS MODE IS RANDOM RL1074.2 +006600 RELATIVE KEY IS ACTUAL-KEY-2. RL1074.2 +006700 DATA DIVISION. RL1074.2 +006800 FILE SECTION. RL1074.2 +006900 FD PRINT-FILE. RL1074.2 +007000 01 PRINT-REC PICTURE X(120). RL1074.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1074.2 +007200 FD RL-FR7 RL1074.2 +007300 LABEL RECORDS ARE STANDARD RL1074.2 +007400C VALUE OF RL1074.2 +007500C XXXXX074 RL1074.2 +007600C IS RL1074.2 +007700C XXXXX075 RL1074.2 +007800G XXXXX069 RL1074.2 +007900 DATA RECORD IS RAC-REC-1. RL1074.2 +008000 01 RAC-REC-1. RL1074.2 +008100 03 FILLER PICTURE IS X(24). RL1074.2 +008200 03 RECORD-NO-1 PICTURE IS 9999. RL1074.2 +008300 03 FILLER PICTURE IS XXXX. RL1074.2 +008400 03 UPDATE-FIELD PICTURE IS X(7). RL1074.2 +008500 03 FILLER PICTURE IS X(81). RL1074.2 +008600 FD RL-FR8 RL1074.2 +008700 LABEL RECORDS ARE STANDARD RL1074.2 +008800C VALUE OF RL1074.2 +008900C XXXXX074 RL1074.2 +009000C IS RL1074.2 +009100C XXXXX076 RL1074.2 +009200G XXXXX069 RL1074.2 +009300 DATA RECORDS ARE RAC-REC-2 RAC-REC-3. RL1074.2 +009400 01 RAC-REC-2. RL1074.2 +009500 03 FILLER PICTURE IS X(24). RL1074.2 +009600 03 RECORD-NO-2 PICTURE IS 9999. RL1074.2 +009700 03 FILLER PICTURE IS X(92). RL1074.2 +009800 01 RAC-REC-3. RL1074.2 +009900 03 FILLER PICTURE IS X(24). RL1074.2 +010000 03 RECORD-NO-3 PICTURE IS 9999. RL1074.2 +010100 03 FILLER PICTURE IS X(92). RL1074.2 +010200 WORKING-STORAGE SECTION. RL1074.2 +010300 01 RECORD-SKELTON. RL1074.2 +010400 03 FILLER PICTURE IS X(24) VALUE " THIS IS RECORD NUMBER ".RL1074.2 +010500 03 RECORD-NUMXXX PICTURE IS 9999 VALUE IS ZERO. RL1074.2 +010600 03 FILLER PICTURE IS X(92) VALUE SPACE. RL1074.2 +010700 01 ACTUAL-KEY-1 RL1074.2 +010800 PICTURE 9(5). RL1074.2 +010900 01 ACTUAL-KEY-2 RL1074.2 +011000 PICTURE 9(5). RL1074.2 +011100 01 FILE-RECORD-INFORMATION-REC. RL1074.2 +011200 03 FILE-RECORD-INFO-SKELETON. RL1074.2 +011300 05 FILLER PICTURE X(48) VALUE RL1074.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1074.2 +011500 05 FILLER PICTURE X(46) VALUE RL1074.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1074.2 +011700 05 FILLER PICTURE X(26) VALUE RL1074.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". RL1074.2 +011900 05 FILLER PICTURE X(37) VALUE RL1074.2 +012000 ",RECKEY= ". RL1074.2 +012100 05 FILLER PICTURE X(38) VALUE RL1074.2 +012200 ",ALTKEY1= ". RL1074.2 +012300 05 FILLER PICTURE X(38) VALUE RL1074.2 +012400 ",ALTKEY2= ". RL1074.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.RL1074.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1074.2 +012700 05 FILE-RECORD-INFO-P1-120. RL1074.2 +012800 07 FILLER PIC X(5). RL1074.2 +012900 07 XFILE-NAME PIC X(6). RL1074.2 +013000 07 FILLER PIC X(8). RL1074.2 +013100 07 XRECORD-NAME PIC X(6). RL1074.2 +013200 07 FILLER PIC X(1). RL1074.2 +013300 07 REELUNIT-NUMBER PIC 9(1). RL1074.2 +013400 07 FILLER PIC X(7). RL1074.2 +013500 07 XRECORD-NUMBER PIC 9(6). RL1074.2 +013600 07 FILLER PIC X(6). RL1074.2 +013700 07 UPDATE-NUMBER PIC 9(2). RL1074.2 +013800 07 FILLER PIC X(5). RL1074.2 +013900 07 ODO-NUMBER PIC 9(4). RL1074.2 +014000 07 FILLER PIC X(5). RL1074.2 +014100 07 XPROGRAM-NAME PIC X(5). RL1074.2 +014200 07 FILLER PIC X(7). RL1074.2 +014300 07 XRECORD-LENGTH PIC 9(6). RL1074.2 +014400 07 FILLER PIC X(7). RL1074.2 +014500 07 CHARS-OR-RECORDS PIC X(2). RL1074.2 +014600 07 FILLER PIC X(1). RL1074.2 +014700 07 XBLOCK-SIZE PIC 9(4). RL1074.2 +014800 07 FILLER PIC X(6). RL1074.2 +014900 07 RECORDS-IN-FILE PIC 9(6). RL1074.2 +015000 07 FILLER PIC X(5). RL1074.2 +015100 07 XFILE-ORGANIZATION PIC X(2). RL1074.2 +015200 07 FILLER PIC X(6). RL1074.2 +015300 07 XLABEL-TYPE PIC X(1). RL1074.2 +015400 05 FILE-RECORD-INFO-P121-240. RL1074.2 +015500 07 FILLER PIC X(8). RL1074.2 +015600 07 XRECORD-KEY PIC X(29). RL1074.2 +015700 07 FILLER PIC X(9). RL1074.2 +015800 07 ALTERNATE-KEY1 PIC X(29). RL1074.2 +015900 07 FILLER PIC X(9). RL1074.2 +016000 07 ALTERNATE-KEY2 PIC X(29). RL1074.2 +016100 07 FILLER PIC X(7). RL1074.2 +016200 01 TEST-RESULTS. RL1074.2 +016300 02 FILLER PIC X VALUE SPACE. RL1074.2 +016400 02 FEATURE PIC X(20) VALUE SPACE. RL1074.2 +016500 02 FILLER PIC X VALUE SPACE. RL1074.2 +016600 02 P-OR-F PIC X(5) VALUE SPACE. RL1074.2 +016700 02 FILLER PIC X VALUE SPACE. RL1074.2 +016800 02 PAR-NAME. RL1074.2 +016900 03 FILLER PIC X(19) VALUE SPACE. RL1074.2 +017000 03 PARDOT-X PIC X VALUE SPACE. RL1074.2 +017100 03 DOTVALUE PIC 99 VALUE ZERO. RL1074.2 +017200 02 FILLER PIC X(8) VALUE SPACE. RL1074.2 +017300 02 RE-MARK PIC X(61). RL1074.2 +017400 01 TEST-COMPUTED. RL1074.2 +017500 02 FILLER PIC X(30) VALUE SPACE. RL1074.2 +017600 02 FILLER PIC X(17) VALUE RL1074.2 +017700 " COMPUTED=". RL1074.2 +017800 02 COMPUTED-X. RL1074.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1074.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A RL1074.2 +018100 PIC -9(9).9(9). RL1074.2 +018200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1074.2 +018300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1074.2 +018400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1074.2 +018500 03 CM-18V0 REDEFINES COMPUTED-A. RL1074.2 +018600 04 COMPUTED-18V0 PIC -9(18). RL1074.2 +018700 04 FILLER PIC X. RL1074.2 +018800 03 FILLER PIC X(50) VALUE SPACE. RL1074.2 +018900 01 TEST-CORRECT. RL1074.2 +019000 02 FILLER PIC X(30) VALUE SPACE. RL1074.2 +019100 02 FILLER PIC X(17) VALUE " CORRECT =". RL1074.2 +019200 02 CORRECT-X. RL1074.2 +019300 03 CORRECT-A PIC X(20) VALUE SPACE. RL1074.2 +019400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1074.2 +019500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1074.2 +019600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1074.2 +019700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1074.2 +019800 03 CR-18V0 REDEFINES CORRECT-A. RL1074.2 +019900 04 CORRECT-18V0 PIC -9(18). RL1074.2 +020000 04 FILLER PIC X. RL1074.2 +020100 03 FILLER PIC X(2) VALUE SPACE. RL1074.2 +020200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1074.2 +020300 01 CCVS-C-1. RL1074.2 +020400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1074.2 +020500- "SS PARAGRAPH-NAME RL1074.2 +020600- " REMARKS". RL1074.2 +020700 02 FILLER PIC X(20) VALUE SPACE. RL1074.2 +020800 01 CCVS-C-2. RL1074.2 +020900 02 FILLER PIC X VALUE SPACE. RL1074.2 +021000 02 FILLER PIC X(6) VALUE "TESTED". RL1074.2 +021100 02 FILLER PIC X(15) VALUE SPACE. RL1074.2 +021200 02 FILLER PIC X(4) VALUE "FAIL". RL1074.2 +021300 02 FILLER PIC X(94) VALUE SPACE. RL1074.2 +021400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1074.2 +021500 01 REC-CT PIC 99 VALUE ZERO. RL1074.2 +021600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1074.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1074.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1074.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1074.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1074.2 +022400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1074.2 +022500 01 CCVS-H-1. RL1074.2 +022600 02 FILLER PIC X(39) VALUE SPACES. RL1074.2 +022700 02 FILLER PIC X(42) VALUE RL1074.2 +022800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1074.2 +022900 02 FILLER PIC X(39) VALUE SPACES. RL1074.2 +023000 01 CCVS-H-2A. RL1074.2 +023100 02 FILLER PIC X(40) VALUE SPACE. RL1074.2 +023200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1074.2 +023300 02 FILLER PIC XXXX VALUE RL1074.2 +023400 "4.2 ". RL1074.2 +023500 02 FILLER PIC X(28) VALUE RL1074.2 +023600 " COPY - NOT FOR DISTRIBUTION". RL1074.2 +023700 02 FILLER PIC X(41) VALUE SPACE. RL1074.2 +023800 RL1074.2 +023900 01 CCVS-H-2B. RL1074.2 +024000 02 FILLER PIC X(15) VALUE RL1074.2 +024100 "TEST RESULT OF ". RL1074.2 +024200 02 TEST-ID PIC X(9). RL1074.2 +024300 02 FILLER PIC X(4) VALUE RL1074.2 +024400 " IN ". RL1074.2 +024500 02 FILLER PIC X(12) VALUE RL1074.2 +024600 " HIGH ". RL1074.2 +024700 02 FILLER PIC X(22) VALUE RL1074.2 +024800 " LEVEL VALIDATION FOR ". RL1074.2 +024900 02 FILLER PIC X(58) VALUE RL1074.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +025100 01 CCVS-H-3. RL1074.2 +025200 02 FILLER PIC X(34) VALUE RL1074.2 +025300 " FOR OFFICIAL USE ONLY ". RL1074.2 +025400 02 FILLER PIC X(58) VALUE RL1074.2 +025500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1074.2 +025600 02 FILLER PIC X(28) VALUE RL1074.2 +025700 " COPYRIGHT 1985 ". RL1074.2 +025800 01 CCVS-E-1. RL1074.2 +025900 02 FILLER PIC X(52) VALUE SPACE. RL1074.2 +026000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1074.2 +026100 02 ID-AGAIN PIC X(9). RL1074.2 +026200 02 FILLER PIC X(45) VALUE SPACES. RL1074.2 +026300 01 CCVS-E-2. RL1074.2 +026400 02 FILLER PIC X(31) VALUE SPACE. RL1074.2 +026500 02 FILLER PIC X(21) VALUE SPACE. RL1074.2 +026600 02 CCVS-E-2-2. RL1074.2 +026700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1074.2 +026800 03 FILLER PIC X VALUE SPACE. RL1074.2 +026900 03 ENDER-DESC PIC X(44) VALUE RL1074.2 +027000 "ERRORS ENCOUNTERED". RL1074.2 +027100 01 CCVS-E-3. RL1074.2 +027200 02 FILLER PIC X(22) VALUE RL1074.2 +027300 " FOR OFFICIAL USE ONLY". RL1074.2 +027400 02 FILLER PIC X(12) VALUE SPACE. RL1074.2 +027500 02 FILLER PIC X(58) VALUE RL1074.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +027700 02 FILLER PIC X(13) VALUE SPACE. RL1074.2 +027800 02 FILLER PIC X(15) VALUE RL1074.2 +027900 " COPYRIGHT 1985". RL1074.2 +028000 01 CCVS-E-4. RL1074.2 +028100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1074.2 +028200 02 FILLER PIC X(4) VALUE " OF ". RL1074.2 +028300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1074.2 +028400 02 FILLER PIC X(40) VALUE RL1074.2 +028500 " TESTS WERE EXECUTED SUCCESSFULLY". RL1074.2 +028600 01 XXINFO. RL1074.2 +028700 02 FILLER PIC X(19) VALUE RL1074.2 +028800 "*** INFORMATION ***". RL1074.2 +028900 02 INFO-TEXT. RL1074.2 +029000 04 FILLER PIC X(8) VALUE SPACE. RL1074.2 +029100 04 XXCOMPUTED PIC X(20). RL1074.2 +029200 04 FILLER PIC X(5) VALUE SPACE. RL1074.2 +029300 04 XXCORRECT PIC X(20). RL1074.2 +029400 02 INF-ANSI-REFERENCE PIC X(48). RL1074.2 +029500 01 HYPHEN-LINE. RL1074.2 +029600 02 FILLER PIC IS X VALUE IS SPACE. RL1074.2 +029700 02 FILLER PIC IS X(65) VALUE IS "************************RL1074.2 +029800- "*****************************************". RL1074.2 +029900 02 FILLER PIC IS X(54) VALUE IS "************************RL1074.2 +030000- "******************************". RL1074.2 +030100 01 CCVS-PGM-ID PIC X(9) VALUE RL1074.2 +030200 "RL107A". RL1074.2 +030300 PROCEDURE DIVISION. RL1074.2 +030400 CCVS1 SECTION. RL1074.2 +030500 OPEN-FILES. RL1074.2 +030600 OPEN OUTPUT PRINT-FILE. RL1074.2 +030700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1074.2 +030800 MOVE SPACE TO TEST-RESULTS. RL1074.2 +030900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1074.2 +031000 MOVE ZERO TO REC-SKL-SUB. RL1074.2 +031100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1074.2 +031200 CCVS-INIT-FILE. RL1074.2 +031300 ADD 1 TO REC-SKL-SUB. RL1074.2 +031400 MOVE FILE-RECORD-INFO-SKELETON RL1074.2 +031500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1074.2 +031600 CCVS-INIT-EXIT. RL1074.2 +031700 GO TO CCVS1-EXIT. RL1074.2 +031800 CLOSE-FILES. RL1074.2 +031900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1074.2 +032000 TERMINATE-CCVS. RL1074.2 +032100S EXIT PROGRAM. RL1074.2 +032200STERMINATE-CALL. RL1074.2 +032300 STOP RUN. RL1074.2 +032400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1074.2 +032500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1074.2 +032600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1074.2 +032700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1074.2 +032800 MOVE "****TEST DELETED****" TO RE-MARK. RL1074.2 +032900 PRINT-DETAIL. RL1074.2 +033000 IF REC-CT NOT EQUAL TO ZERO RL1074.2 +033100 MOVE "." TO PARDOT-X RL1074.2 +033200 MOVE REC-CT TO DOTVALUE. RL1074.2 +033300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1074.2 +033400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1074.2 +033500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1074.2 +033600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1074.2 +033700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1074.2 +033800 MOVE SPACE TO CORRECT-X. RL1074.2 +033900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1074.2 +034000 MOVE SPACE TO RE-MARK. RL1074.2 +034100 HEAD-ROUTINE. RL1074.2 +034200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1074.2 +034500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1074.2 +034600 COLUMN-NAMES-ROUTINE. RL1074.2 +034700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +034800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +035000 END-ROUTINE. RL1074.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1074.2 +035200 END-RTN-EXIT. RL1074.2 +035300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +035400 END-ROUTINE-1. RL1074.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1074.2 +035600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1074.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. RL1074.2 +035800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1074.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1074.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1074.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1074.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1074.2 +036300 END-ROUTINE-12. RL1074.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1074.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1074.2 +036600 MOVE "NO " TO ERROR-TOTAL RL1074.2 +036700 ELSE RL1074.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1074.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1074.2 +037000 PERFORM WRITE-LINE. RL1074.2 +037100 END-ROUTINE-13. RL1074.2 +037200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1074.2 +037300 MOVE "NO " TO ERROR-TOTAL ELSE RL1074.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1074.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1074.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO RL1074.2 +037800 MOVE "NO " TO ERROR-TOTAL RL1074.2 +037900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1074.2 +038000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1074.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +038200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +038300 WRITE-LINE. RL1074.2 +038400 ADD 1 TO RECORD-COUNT. RL1074.2 +038500Y IF RECORD-COUNT GREATER 50 RL1074.2 +038600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1074.2 +038700Y MOVE SPACE TO DUMMY-RECORD RL1074.2 +038800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1074.2 +038900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1074.2 +039000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1074.2 +039100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1074.2 +039200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1074.2 +039300Y MOVE ZERO TO RECORD-COUNT. RL1074.2 +039400 PERFORM WRT-LN. RL1074.2 +039500 WRT-LN. RL1074.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1074.2 +039700 MOVE SPACE TO DUMMY-RECORD. RL1074.2 +039800 BLANK-LINE-PRINT. RL1074.2 +039900 PERFORM WRT-LN. RL1074.2 +040000 FAIL-ROUTINE. RL1074.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE RL1074.2 +040200 GO TO FAIL-ROUTINE-WRITE. RL1074.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1074.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1074.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1074.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1074.2 +040800 GO TO FAIL-ROUTINE-EX. RL1074.2 +040900 FAIL-ROUTINE-WRITE. RL1074.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1074.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1074.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1074.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1074.2 +041400 FAIL-ROUTINE-EX. EXIT. RL1074.2 +041500 BAIL-OUT. RL1074.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1074.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1074.2 +041800 BAIL-OUT-WRITE. RL1074.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1074.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1074.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1074.2 +042300 BAIL-OUT-EX. EXIT. RL1074.2 +042400 CCVS1-EXIT. RL1074.2 +042500 EXIT. RL1074.2 +042600 SECT-RL107-001 SECTION. RL1074.2 +042700 TEST-1. RL1074.2 +042800 MOVE "OPEN OUTPUT RL-FR7" TO FEATURE. RL1074.2 +042900 MOVE "REL-TEST-001" TO PAR-NAME. RL1074.2 +043000 PERFORM PRINT-DETAIL. RL1074.2 +043100 OPEN OUTPUT RL-FR7. RL1074.2 +043200 TEST-2. RL1074.2 +043300 MOVE "OPEN OUTPUT RL-FR8" TO FEATURE. RL1074.2 +043400 MOVE "REL-TEST-002" TO PAR-NAME. RL1074.2 +043500 PERFORM PRINT-DETAIL. RL1074.2 +043600 OPEN OUTPUT RL-FR8. RL1074.2 +043700 TEST-3-INIT. RL1074.2 +043800 MOVE "WRITE RL-FR7" TO FEATURE. RL1074.2 +043900 MOVE "REL-TEST-003" TO PAR-NAME. RL1074.2 +044000 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +044100 MOVE ZERO TO RECORD-NUMXXX. RL1074.2 +044200 TEST-3. RL1074.2 +044300 ADD 1 TO RECORD-NUMXXX. RL1074.2 +044400 ADD 1 TO ACTUAL-KEY-1. RL1074.2 +044500 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-3-EXIT. RL1074.2 +044600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +044700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +044800 GO TO TEST-3. RL1074.2 +044900 TEST-3-EXIT. RL1074.2 +045000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +045100 PERFORM PRINT-DETAIL. RL1074.2 +045200 TEST-4-INIT. RL1074.2 +045300 MOVE "REL-TEST-004" TO PAR-NAME. RL1074.2 +045400 MOVE ZERO TO REC-CT. RL1074.2 +045500 MOVE 51 TO RECORD-NUMXXX. RL1074.2 +045600 MOVE 51 TO ACTUAL-KEY-1. RL1074.2 +045700 TEST-4. RL1074.2 +045800 SUBTRACT 1 FROM RECORD-NUMXXX. RL1074.2 +045900 SUBTRACT 1 FROM ACTUAL-KEY-1. RL1074.2 +046000 IF RECORD-NUMXXX IS LESS THAN 26 GO TO TEST-4-EXIT. RL1074.2 +046100 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +046200 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +046300 GO TO TEST-4. RL1074.2 +046400 TEST-4-EXIT. RL1074.2 +046500 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +046600 PERFORM PRINT-DETAIL. RL1074.2 +046700 TEST-5-INIT. RL1074.2 +046800 MOVE "REL-TEST-005" TO PAR-NAME. RL1074.2 +046900 MOVE ZERO TO REC-CT. RL1074.2 +047000 MOVE 48 TO ACTUAL-KEY-1. RL1074.2 +047100 MOVE 48 TO RECORD-NUMXXX. RL1074.2 +047200 TEST-5. RL1074.2 +047300 ADD 3 TO RECORD-NUMXXX. RL1074.2 +047400 ADD 3 TO ACTUAL-KEY-1. RL1074.2 +047500 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-5-EXIT. RL1074.2 +047600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +047700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +047800 GO TO TEST-5. RL1074.2 +047900 TEST-5-EXIT. RL1074.2 +048000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +048100 PERFORM PRINT-DETAIL. RL1074.2 +048200 TEST-6-INIT. RL1074.2 +048300 MOVE "REL-TEST-006" TO PAR-NAME. RL1074.2 +048400 MOVE ZERO TO REC-CT. RL1074.2 +048500 MOVE 49 TO ACTUAL-KEY-1. RL1074.2 +048600 MOVE 49 TO RECORD-NUMXXX. RL1074.2 +048700 TEST-6. RL1074.2 +048800 ADD 3 TO RECORD-NUMXXX. RL1074.2 +048900 ADD 3 TO ACTUAL-KEY-1. RL1074.2 +049000 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-6-EXIT. RL1074.2 +049100 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +049200 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +049300 GO TO TEST-6. RL1074.2 +049400 TEST-6-EXIT. RL1074.2 +049500 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +049600 PERFORM PRINT-DETAIL. RL1074.2 +049700 TEST-7-INIT. RL1074.2 +049800 MOVE "REL-TEST-007" TO PAR-NAME. RL1074.2 +049900 MOVE ZERO TO REC-CT. RL1074.2 +050000 MOVE 128 TO ACTUAL-KEY-1. RL1074.2 +050100 MOVE 128 TO RECORD-NUMXXX. RL1074.2 +050200 TEST-7. RL1074.2 +050300 SUBTRACT 3 FROM RECORD-NUMXXX. RL1074.2 +050400 SUBTRACT 3 FROM ACTUAL-KEY-1. RL1074.2 +050500 IF RECORD-NUMXXX IS LESS THAN 53 GO TO TEST-7-EXIT. RL1074.2 +050600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +050700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +050800 GO TO TEST-7. RL1074.2 +050900 TEST-7-EXIT. RL1074.2 +051000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +051100 PERFORM PRINT-DETAIL. RL1074.2 +051200 TEST-8-INIT. RL1074.2 +051300 MOVE "WRITE RL-FR8" TO FEATURE. RL1074.2 +051400 MOVE "REL-TEST-008" TO PAR-NAME. RL1074.2 +051500 MOVE ZERO TO REC-CT. RL1074.2 +051600 MOVE 0 TO ACTUAL-KEY-2. RL1074.2 +051700 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +051800 TEST-8. RL1074.2 +051900 ADD 1 TO RECORD-NUMXXX. RL1074.2 +052000 ADD 1 TO ACTUAL-KEY-2. RL1074.2 +052100 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-8-EXIT. RL1074.2 +052200 MOVE RECORD-SKELTON TO RAC-REC-2. RL1074.2 +052300 WRITE RAC-REC-2 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +052400 GO TO TEST-8. RL1074.2 +052500 TEST-8-EXIT. RL1074.2 +052600 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +052700 PERFORM PRINT-DETAIL. RL1074.2 +052800 TEST-9. RL1074.2 +052900 MOVE "CLOSE RL-FR7" TO FEATURE. RL1074.2 +053000 MOVE "REL-TEST-009" TO PAR-NAME. RL1074.2 +053100 MOVE ZERO TO REC-CT. RL1074.2 +053200 PERFORM PRINT-DETAIL. RL1074.2 +053300 CLOSE RL-FR7. RL1074.2 +053400 TEST-10. RL1074.2 +053500 MOVE "CLOSE RL-FR8" TO FEATURE. RL1074.2 +053600 MOVE "REL-TEST-010" TO PAR-NAME. RL1074.2 +053700 PERFORM PRINT-DETAIL. RL1074.2 +053800 CLOSE RL-FR8. RL1074.2 +053900 TEST-11. RL1074.2 +054000 MOVE "OPEN INPUT RL-FR8" TO FEATURE. RL1074.2 +054100 MOVE "REL-TEST-011" TO PAR-NAME. RL1074.2 +054200 PERFORM PRINT-DETAIL. RL1074.2 +054300 OPEN INPUT RL-FR8. RL1074.2 +054400 TEST-12. RL1074.2 +054500 MOVE "OPEN I-O RL-FR7" TO FEATURE. RL1074.2 +054600 MOVE "REL-TEST-012" TO PAR-NAME. RL1074.2 +054700 PERFORM PRINT-DETAIL. RL1074.2 +054800 OPEN I-O RL-FR7. RL1074.2 +054900 TEST-13-INIT. RL1074.2 +055000 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +055100 MOVE "REL-TEST-013" TO PAR-NAME. RL1074.2 +055200 MOVE 9 TO ACTUAL-KEY-1. RL1074.2 +055300 MOVE 9 TO RECORD-NUMXXX. RL1074.2 +055400 TEST-13. RL1074.2 +055500 ADD 1 TO ACTUAL-KEY-1. RL1074.2 +055600 ADD 1 TO RECORD-NUMXXX. RL1074.2 +055700 IF RECORD-NUMXXX IS GREATER THAN 20 GO TO TEST-13-EXIT. RL1074.2 +055800 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +055900 GO TO TEST-13. RL1074.2 +056000 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +056100 PERFORM ERROR-WRONG-RECORD. RL1074.2 +056200 GO TO TEST-13. RL1074.2 +056300 TEST-13-EXIT. RL1074.2 +056400 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +056500 PERFORM PRINT-DETAIL. RL1074.2 +056600 TEST-14-INIT. RL1074.2 +056700 MOVE "READ RL-FR8" TO FEATURE. RL1074.2 +056800 MOVE "REL-TEST-014" TO PAR-NAME. RL1074.2 +056900 MOVE ZERO TO REC-CT. RL1074.2 +057000 MOVE 0 TO ACTUAL-KEY-2. RL1074.2 +057100 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +057200 TEST-14. RL1074.2 +057300 ADD 3 TO ACTUAL-KEY-2. RL1074.2 +057400 ADD 3 TO RECORD-NUMXXX. RL1074.2 +057500 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-14-EXIT. RL1074.2 +057600 READ RL-FR8 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +057700 GO TO TEST-14. RL1074.2 +057800 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-2 RL1074.2 +057900 MOVE RECORD-NO-2 TO RECORD-NO-1 RL1074.2 +058000 PERFORM ERROR-WRONG-RECORD. RL1074.2 +058100 GO TO TEST-14. RL1074.2 +058200 TEST-14-EXIT. RL1074.2 +058300 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +058400 PERFORM PRINT-DETAIL. RL1074.2 +058500 TEST-15-INIT. RL1074.2 +058600 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +058700 MOVE "REL-TEST-015" TO PAR-NAME. RL1074.2 +058800 MOVE ZERO TO REC-CT. RL1074.2 +058900 MOVE 14 TO ACTUAL-KEY-1. RL1074.2 +059000 MOVE 14 TO RECORD-NUMXXX. RL1074.2 +059100 TEST-15. RL1074.2 +059200 ADD 14 TO ACTUAL-KEY-1. RL1074.2 +059300 ADD 14 TO RECORD-NUMXXX. RL1074.2 +059400 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-15-EXIT. RL1074.2 +059500 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +059600 GO TO TEST-14. RL1074.2 +059700 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +059800 PERFORM ERROR-WRONG-RECORD. RL1074.2 +059900 GO TO TEST-15. RL1074.2 +060000 TEST-15-EXIT. RL1074.2 +060100 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +060200 PERFORM PRINT-DETAIL. RL1074.2 +060300 TEST-16-INIT. RL1074.2 +060400 MOVE "REL-TEST-016" TO PAR-NAME. RL1074.2 +060500 MOVE ZERO TO REC-CT. RL1074.2 +060600 MOVE 11 TO ACTUAL-KEY-1. RL1074.2 +060700 MOVE 11 TO RECORD-NUMXXX. RL1074.2 +060800 TEST-16. RL1074.2 +060900 ADD 17 TO ACTUAL-KEY-1. RL1074.2 +061000 ADD 17 TO RECORD-NUMXXX. RL1074.2 +061100 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-16-EXIT. RL1074.2 +061200 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +061300 GO TO TEST-16. RL1074.2 +061400 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +061500 PERFORM ERROR-WRONG-RECORD. RL1074.2 +061600 GO TO TEST-16. RL1074.2 +061700 TEST-16-EXIT. RL1074.2 +061800 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +061900 PERFORM PRINT-DETAIL. RL1074.2 +062000 TEST-17-INIT. RL1074.2 +062100 MOVE "WRITE RL-FR7" TO FEATURE. RL1074.2 +062200 MOVE "REL-TEST-017" TO PAR-NAME. RL1074.2 +062300 MOVE ZERO TO REC-CT. RL1074.2 +062400 MOVE 125 TO ACTUAL-KEY-1. RL1074.2 +062500 MOVE 125 TO RECORD-NUMXXX. RL1074.2 +062600 TEST-17. RL1074.2 +062700 ADD 5 TO ACTUAL-KEY-1. RL1074.2 +062800 ADD 5 TO RECORD-NUMXXX. RL1074.2 +062900 IF RECORD-NUMXXX IS GREATER THAN 200 GO TO TEST-17-EXIT. RL1074.2 +063000 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +063100 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +063200 GO TO TEST-17. RL1074.2 +063300 TEST-17-EXIT. RL1074.2 +063400 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +063500 PERFORM PRINT-DETAIL. RL1074.2 +063600 TEST-18. RL1074.2 +063700 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +063800 MOVE "REL-TEST-018" TO PAR-NAME. RL1074.2 +063900 MOVE ZERO TO REC-CT. RL1074.2 +064000 MOVE 121 TO ACTUAL-KEY-1. RL1074.2 +064100 MOVE 121 TO RECORD-NUMXXX. RL1074.2 +064200 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +064300 GO TO TEST-19. RL1074.2 +064400 IF RECORD-NO-1 IS NOT EQUAL TO RECORD-NUMXXX RL1074.2 +064500 PERFORM ERROR-WRONG-RECORD RL1074.2 +064600 GO TO TEST-19. RL1074.2 +064700 PERFORM PASS. RL1074.2 +064800 PERFORM PRINT-DETAIL. RL1074.2 +064900 TEST-19. RL1074.2 +065000 MOVE "REL-TEST-019" TO PAR-NAME. RL1074.2 +065100 MOVE ZERO TO REC-CT. RL1074.2 +065200 MOVE 57 TO ACTUAL-KEY-1. RL1074.2 +065300 MOVE 57 TO RECORD-NUMXXX. RL1074.2 +065400 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +065500 GO TO TEST-20. RL1074.2 +065600 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +065700 PERFORM ERROR-WRONG-RECORD RL1074.2 +065800 GO TO TEST-20. RL1074.2 +065900 PERFORM PASS. RL1074.2 +066000 PERFORM PRINT-DETAIL. RL1074.2 +066100 TEST-20. RL1074.2 +066200 MOVE "READ RL-FR8" TO FEATURE. RL1074.2 +066300 MOVE "REL-TEST-020" TO PAR-NAME. RL1074.2 +066400 MOVE ZERO TO REC-CT. RL1074.2 +066500 MOVE 12 TO RECORD-NUMXXX. RL1074.2 +066600 MOVE 12 TO ACTUAL-KEY-2. RL1074.2 +066700 READ RL-FR8 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +066800 GO TO TEST-21. RL1074.2 +066900 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-2 RL1074.2 +067000 MOVE RECORD-NO-2 TO RECORD-NO-1 RL1074.2 +067100 PERFORM ERROR-WRONG-RECORD RL1074.2 +067200 GO TO TEST-21. RL1074.2 +067300 PERFORM PASS RL1074.2 +067400 PERFORM PRINT-DETAIL. RL1074.2 +067500 TEST-21. RL1074.2 +067600 MOVE "INVALID KEY RL-FR7" TO FEATURE. RL1074.2 +067700 MOVE "REL-TEST-021" TO PAR-NAME. RL1074.2 +067800 MOVE ZERO TO REC-CT. RL1074.2 +067900 MOVE 237 TO ACTUAL-KEY-1. RL1074.2 +068000 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +068100 PERFORM PRINT-DETAIL RL1074.2 +068200 GO TO TEST-22. RL1074.2 +068300 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +068400 TEST-22. RL1074.2 +068500 MOVE "REL-TEST-022" TO PAR-NAME. RL1074.2 +068600 MOVE 250 TO ACTUAL-KEY-1. RL1074.2 +068700 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +068800 PERFORM PRINT-DETAIL RL1074.2 +068900 GO TO TEST-23. RL1074.2 +069000 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +069100 TEST-23. RL1074.2 +069200 MOVE "INVALID KEY RL-FR8" TO FEATURE. RL1074.2 +069300 MOVE "REL-TEST-023" TO PAR-NAME. RL1074.2 +069400 MOVE 150 TO ACTUAL-KEY-2. RL1074.2 +069500 READ RL-FR8 INVALID KEY PERFORM PASS RL1074.2 +069600 PERFORM PRINT-DETAIL RL1074.2 +069700 GO TO TEST-24. RL1074.2 +069800 MOVE ACTUAL-KEY-2 TO ACTUAL-KEY-1. RL1074.2 +069900 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +070000 TEST-24. RL1074.2 +070100 MOVE "INVALID KEY RL-FR7" TO FEATURE. RL1074.2 +070200 MOVE "REL-TEST-024" TO PAR-NAME. RL1074.2 +070300 MOVE 230 TO ACTUAL-KEY-1. RL1074.2 +070400 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +070500 PERFORM PRINT-DETAIL RL1074.2 +070600 GO TO TEST-25-INIT. RL1074.2 +070700 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +070800 TEST-25-INIT. RL1074.2 +070900 MOVE "REWRITE RL-FR7" TO FEATURE. RL1074.2 +071000 MOVE "REL-TEST-025" TO PAR-NAME. RL1074.2 +071100 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +071200 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +071300 MOVE ZERO TO REC-CT. RL1074.2 +071400 TEST-25. RL1074.2 +071500 ADD 10 TO ACTUAL-KEY-1. RL1074.2 +071600 ADD 10 TO RECORD-NUMXXX. RL1074.2 +071700 IF RECORD-NUMXXX IS GREATER THAN 100 GO TO TEST-25-RESET. RL1074.2 +071800 READ RL-FR7 INVALID KEY RL1074.2 +071900 MOVE "INVALID KEY ON READ BEFORE REWRITE" TO RE-MARK RL1074.2 +072000 PERFORM ERROR-WRONG-RECORD RL1074.2 +072100 GO TO TEST-25. RL1074.2 +072200 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +072300 PERFORM ERROR-WRONG-RECORD RL1074.2 +072400 GO TO TEST-25. RL1074.2 +072500 MOVE "UPDATED" TO UPDATE-FIELD. RL1074.2 +072600 REWRITE RAC-REC-1 INVALID KEY RL1074.2 +072700 MOVE "INVALID KEY ON REWRITE" TO RE-MARK RL1074.2 +072800 PERFORM ERROR-INVALID-KEY. RL1074.2 +072900 GO TO TEST-25. RL1074.2 +073000 TEST-25-RESET. RL1074.2 +073100 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +073200 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +073300 TEST-25-READ. RL1074.2 +073400 ADD 10 TO ACTUAL-KEY-1. RL1074.2 +073500 ADD 10 TO RECORD-NUMXXX. RL1074.2 +073600 IF RECORD-NUMXXX IS GREATER THAN 100 GO TO TEST-25-EXIT. RL1074.2 +073700 READ RL-FR7 INVALID KEY RL1074.2 +073800 MOVE "INVALID KEY ON READ AFTER REWRITE" TO RE-MARK RL1074.2 +073900 PERFORM ERROR-INVALID-KEY RL1074.2 +074000 GO TO TEST-25-READ. RL1074.2 +074100 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +074200 PERFORM ERROR-WRONG-RECORD RL1074.2 +074300 GO TO TEST-25-READ. RL1074.2 +074400 IF UPDATE-FIELD IS EQUAL TO "UPDATED" GO TO TEST-25-READ. RL1074.2 +074500 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +074600 ADD 1 TO REC-CT. RL1074.2 +074700 MOVE UPDATE-FIELD TO COMPUTED-A. RL1074.2 +074800 MOVE "UPDATED" TO CORRECT-A. RL1074.2 +074900 MOVE "RECORD NOT UPDATED PROPERLY" TO RE-MARK. RL1074.2 +075000 PERFORM PRINT-DETAIL. RL1074.2 +075100 GO TO TEST-25-READ. RL1074.2 +075200 TEST-25-EXIT. RL1074.2 +075300 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +075400 PERFORM PRINT-DETAIL. RL1074.2 +075500 TEST-26. RL1074.2 +075600 MOVE "CLOSE RL-FR8" TO FEATURE. RL1074.2 +075700 MOVE "REL-TEST-026" TO PAR-NAME. RL1074.2 +075800 MOVE ZERO TO REC-CT. RL1074.2 +075900 PERFORM PRINT-DETAIL. RL1074.2 +076000 CLOSE RL-FR8. RL1074.2 +076100 TEST-27. RL1074.2 +076200 MOVE "CLOSE RL-FR7" TO FEATURE. RL1074.2 +076300 MOVE "REL-TEST-027" TO PAR-NAME. RL1074.2 +076400 PERFORM PRINT-DETAIL. RL1074.2 +076500 CLOSE RL-FR7. RL1074.2 +076600 GO TO SECT-RC-03-001-EXIT. RL1074.2 +076700 ERROR-INVALID-KEY. RL1074.2 +076800 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +076900 ADD 1 TO REC-CT. RL1074.2 +077000 MOVE RECORD-NUMXXX TO CORRECT-18V0. RL1074.2 +077100 MOVE "INVALID KEY" TO COMPUTED-A. RL1074.2 +077200 PERFORM PRINT-DETAIL. RL1074.2 +077300 ERROR-INVALID-KEY-EXPECTED. RL1074.2 +077400 PERFORM FAIL. RL1074.2 +077500 ADD 1 TO REC-CT. RL1074.2 +077600 MOVE ACTUAL-KEY-1 TO COMPUTED-18V0. RL1074.2 +077700 MOVE "INVALID KEY" TO CORRECT-A. RL1074.2 +077800 MOVE "INVALID KEY EXPECTED ON READ" TO RE-MARK. RL1074.2 +077900 PERFORM PRINT-DETAIL. RL1074.2 +078000 ERROR-WRONG-RECORD. RL1074.2 +078100 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +078200 ADD 1 TO REC-CT. RL1074.2 +078300 MOVE RECORD-NO-1 TO COMPUTED-18V0. RL1074.2 +078400 MOVE RECORD-NUMXXX TO CORRECT-18V0. RL1074.2 +078500 MOVE "WRONG RECORD FOUND" TO RE-MARK. RL1074.2 +078600 PERFORM PRINT-DETAIL. RL1074.2 +078700 SECT-RC-03-001-EXIT. RL1074.2 +078800 EXIT. RL1074.2 +078900 CCVS-EXIT SECTION. RL1074.2 +079000 CCVS-999999. RL1074.2 +079100 GO TO CLOSE-FILES. RL1074.2 +*END-OF,RL107A +*HEADER,COBOL,RL108A +000100 IDENTIFICATION DIVISION. RL1084.2 +000200 PROGRAM-ID. RL1084.2 +000300 RL108A. RL1084.2 +000400**************************************************************** RL1084.2 +000500* * RL1084.2 +000600* VALIDATION FOR:- * RL1084.2 +000700* * RL1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +000900* * RL1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1084.2 +001100* * RL1084.2 +001200**************************************************************** RL1084.2 +001300* * RL1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1084.2 +001500* * RL1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1084.2 +001700* X-61 - "LITERAL" IN "ASSIGN TO" CLAUSE FOR * RL1084.2 +001800* RELATIVE I-O DATA FILE. * RL1084.2 +001900* X-69 - ADDITIONAL "VALUE OF" CLAUSE. * RL1084.2 +002000* X-74 - VALUE OF IMPLEMENTOR-NAME. * RL1084.2 +002100* X-75 - OBJECT OF "VALUE" CLAUSE. * RL1084.2 +002200* X-82 - SOURCE COMPUTER NAME. * RL1084.2 +002300* X-83 - OBJECT COMPUTER NAME. * RL1084.2 +002400* * RL1084.2 +002500**************************************************************** RL1084.2 +002600*RL108A * RL1084.2 +002700*************************************************** RL1084.2 +002800*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL1084.2 +002900* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL1084.2 +003000* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL1084.2 +003100* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL1084.2 +003200* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL1084.2 +003300* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL1084.2 +003400* RL1084.2 +003500* THIS PROGRAM TESTS THE NEW SYNTACTICAL CONSTRUCTS AND RL1084.2 +003600* SEMANTIC ACTIONS OF THE FOLLOWING ELEMENTS: RL1084.2 +003700* - ASSIGN RL1084.2 +003800* - ORGANIZATION RL1084.2 +003900* - ACCESS RL1084.2 +004000* - READ RL1084.2 +004100* - WRITE RL1084.2 +004200**************************************************************** RL1084.2 +004300 ENVIRONMENT DIVISION. RL1084.2 +004400 CONFIGURATION SECTION. RL1084.2 +004500 SOURCE-COMPUTER. RL1084.2 +004600 XXXXX082. RL1084.2 +004700 OBJECT-COMPUTER. RL1084.2 +004800 XXXXX083. RL1084.2 +004900 INPUT-OUTPUT SECTION. RL1084.2 +005000 FILE-CONTROL. RL1084.2 +005100 SELECT PRINT-FILE ASSIGN TO RL1084.2 +005200 XXXXX055. RL1084.2 +005300 SELECT RL-FS1 ASSIGN TO RL1084.2 +005400 XXXXX061 RL1084.2 +005500 ORGANIZATION RELATIVE RL1084.2 +005600 ACCESS SEQUENTIAL. RL1084.2 +005700* RL1084.2 +005800 DATA DIVISION. RL1084.2 +005900 FILE SECTION. RL1084.2 +006000 FD PRINT-FILE. RL1084.2 +006100 01 PRINT-REC PICTURE X(120). RL1084.2 +006200 01 DUMMY-RECORD PICTURE X(120). RL1084.2 +006300 FD RL-FS1 RL1084.2 +006400 LABEL RECORDS STANDARD RL1084.2 +006500C VALUE OF RL1084.2 +006600C XXXXX074 RL1084.2 +006700C IS RL1084.2 +006800C XXXXX075 RL1084.2 +006900G XXXXX069 RL1084.2 +007000 BLOCK CONTAINS 1 RECORDS RL1084.2 +007100 RECORD CONTAINS 120 CHARACTERS. RL1084.2 +007200 01 RL-FS1R1-F-G-120. RL1084.2 +007300 02 FILLER PIC X(120). RL1084.2 +007400 WORKING-STORAGE SECTION. RL1084.2 +007500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL1084.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL1084.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL1084.2 +007800 05 FILLER PICTURE X(48) VALUE RL1084.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1084.2 +008000 05 FILLER PICTURE X(46) VALUE RL1084.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1084.2 +008200 05 FILLER PICTURE X(26) VALUE RL1084.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL1084.2 +008400 05 FILLER PICTURE X(37) VALUE RL1084.2 +008500 ",RECKEY= ". RL1084.2 +008600 05 FILLER PICTURE X(38) VALUE RL1084.2 +008700 ",ALTKEY1= ". RL1084.2 +008800 05 FILLER PICTURE X(38) VALUE RL1084.2 +008900 ",ALTKEY2= ". RL1084.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL1084.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1084.2 +009200 05 FILE-RECORD-INFO-P1-120. RL1084.2 +009300 07 FILLER PIC X(5). RL1084.2 +009400 07 XFILE-NAME PIC X(6). RL1084.2 +009500 07 FILLER PIC X(8). RL1084.2 +009600 07 XRECORD-NAME PIC X(6). RL1084.2 +009700 07 FILLER PIC X(1). RL1084.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL1084.2 +009900 07 FILLER PIC X(7). RL1084.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL1084.2 +010100 07 FILLER PIC X(6). RL1084.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL1084.2 +010300 07 FILLER PIC X(5). RL1084.2 +010400 07 ODO-NUMBER PIC 9(4). RL1084.2 +010500 07 FILLER PIC X(5). RL1084.2 +010600 07 XPROGRAM-NAME PIC X(5). RL1084.2 +010700 07 FILLER PIC X(7). RL1084.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL1084.2 +010900 07 FILLER PIC X(7). RL1084.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL1084.2 +011100 07 FILLER PIC X(1). RL1084.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL1084.2 +011300 07 FILLER PIC X(6). RL1084.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL1084.2 +011500 07 FILLER PIC X(5). RL1084.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL1084.2 +011700 07 FILLER PIC X(6). RL1084.2 +011800 07 XLABEL-TYPE PIC X(1). RL1084.2 +011900 05 FILE-RECORD-INFO-P121-240. RL1084.2 +012000 07 FILLER PIC X(8). RL1084.2 +012100 07 XRECORD-KEY PIC X(29). RL1084.2 +012200 07 FILLER PIC X(9). RL1084.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL1084.2 +012400 07 FILLER PIC X(9). RL1084.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL1084.2 +012600 07 FILLER PIC X(7). RL1084.2 +012700 01 TEST-RESULTS. RL1084.2 +012800 02 FILLER PIC X VALUE SPACE. RL1084.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL1084.2 +013000 02 FILLER PIC X VALUE SPACE. RL1084.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL1084.2 +013200 02 FILLER PIC X VALUE SPACE. RL1084.2 +013300 02 PAR-NAME. RL1084.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL1084.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL1084.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL1084.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL1084.2 +013800 02 RE-MARK PIC X(61). RL1084.2 +013900 01 TEST-COMPUTED. RL1084.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL1084.2 +014100 02 FILLER PIC X(17) VALUE RL1084.2 +014200 " COMPUTED=". RL1084.2 +014300 02 COMPUTED-X. RL1084.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1084.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL1084.2 +014600 PIC -9(9).9(9). RL1084.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1084.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1084.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1084.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL1084.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL1084.2 +015200 04 FILLER PIC X. RL1084.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL1084.2 +015400 01 TEST-CORRECT. RL1084.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL1084.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL1084.2 +015700 02 CORRECT-X. RL1084.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL1084.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1084.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1084.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1084.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1084.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL1084.2 +016400 04 CORRECT-18V0 PIC -9(18). RL1084.2 +016500 04 FILLER PIC X. RL1084.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL1084.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1084.2 +016800 01 CCVS-C-1. RL1084.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1084.2 +017000- "SS PARAGRAPH-NAME RL1084.2 +017100- " REMARKS". RL1084.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL1084.2 +017300 01 CCVS-C-2. RL1084.2 +017400 02 FILLER PIC X VALUE SPACE. RL1084.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL1084.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL1084.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL1084.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL1084.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1084.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL1084.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1084.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1084.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1084.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1084.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1084.2 +019000 01 CCVS-H-1. RL1084.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL1084.2 +019200 02 FILLER PIC X(42) VALUE RL1084.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1084.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL1084.2 +019500 01 CCVS-H-2A. RL1084.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL1084.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1084.2 +019800 02 FILLER PIC XXXX VALUE RL1084.2 +019900 "4.2 ". RL1084.2 +020000 02 FILLER PIC X(28) VALUE RL1084.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL1084.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL1084.2 +020300 RL1084.2 +020400 01 CCVS-H-2B. RL1084.2 +020500 02 FILLER PIC X(15) VALUE RL1084.2 +020600 "TEST RESULT OF ". RL1084.2 +020700 02 TEST-ID PIC X(9). RL1084.2 +020800 02 FILLER PIC X(4) VALUE RL1084.2 +020900 " IN ". RL1084.2 +021000 02 FILLER PIC X(12) VALUE RL1084.2 +021100 " HIGH ". RL1084.2 +021200 02 FILLER PIC X(22) VALUE RL1084.2 +021300 " LEVEL VALIDATION FOR ". RL1084.2 +021400 02 FILLER PIC X(58) VALUE RL1084.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +021600 01 CCVS-H-3. RL1084.2 +021700 02 FILLER PIC X(34) VALUE RL1084.2 +021800 " FOR OFFICIAL USE ONLY ". RL1084.2 +021900 02 FILLER PIC X(58) VALUE RL1084.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1084.2 +022100 02 FILLER PIC X(28) VALUE RL1084.2 +022200 " COPYRIGHT 1985 ". RL1084.2 +022300 01 CCVS-E-1. RL1084.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL1084.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1084.2 +022600 02 ID-AGAIN PIC X(9). RL1084.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL1084.2 +022800 01 CCVS-E-2. RL1084.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL1084.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL1084.2 +023100 02 CCVS-E-2-2. RL1084.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1084.2 +023300 03 FILLER PIC X VALUE SPACE. RL1084.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL1084.2 +023500 "ERRORS ENCOUNTERED". RL1084.2 +023600 01 CCVS-E-3. RL1084.2 +023700 02 FILLER PIC X(22) VALUE RL1084.2 +023800 " FOR OFFICIAL USE ONLY". RL1084.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL1084.2 +024000 02 FILLER PIC X(58) VALUE RL1084.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL1084.2 +024300 02 FILLER PIC X(15) VALUE RL1084.2 +024400 " COPYRIGHT 1985". RL1084.2 +024500 01 CCVS-E-4. RL1084.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1084.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL1084.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1084.2 +024900 02 FILLER PIC X(40) VALUE RL1084.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL1084.2 +025100 01 XXINFO. RL1084.2 +025200 02 FILLER PIC X(19) VALUE RL1084.2 +025300 "*** INFORMATION ***". RL1084.2 +025400 02 INFO-TEXT. RL1084.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL1084.2 +025600 04 XXCOMPUTED PIC X(20). RL1084.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL1084.2 +025800 04 XXCORRECT PIC X(20). RL1084.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL1084.2 +026000 01 HYPHEN-LINE. RL1084.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL1084.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL1084.2 +026300- "*****************************************". RL1084.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL1084.2 +026500- "******************************". RL1084.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL1084.2 +026700 "RL108A". RL1084.2 +026800 PROCEDURE DIVISION. RL1084.2 +026900 CCVS1 SECTION. RL1084.2 +027000 OPEN-FILES. RL1084.2 +027100 OPEN OUTPUT PRINT-FILE. RL1084.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1084.2 +027300 MOVE SPACE TO TEST-RESULTS. RL1084.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1084.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL1084.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL1084.2 +027700 CCVS-INIT-FILE. RL1084.2 +027800 ADD 1 TO REC-SKL-SUB. RL1084.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL1084.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1084.2 +028100 CCVS-INIT-EXIT. RL1084.2 +028200 GO TO CCVS1-EXIT. RL1084.2 +028300 CLOSE-FILES. RL1084.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1084.2 +028500 TERMINATE-CCVS. RL1084.2 +028600S EXIT PROGRAM. RL1084.2 +028700STERMINATE-CALL. RL1084.2 +028800 STOP RUN. RL1084.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1084.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1084.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1084.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1084.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL1084.2 +029400 PRINT-DETAIL. RL1084.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL1084.2 +029600 MOVE "." TO PARDOT-X RL1084.2 +029700 MOVE REC-CT TO DOTVALUE. RL1084.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1084.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1084.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1084.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1084.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1084.2 +030300 MOVE SPACE TO CORRECT-X. RL1084.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1084.2 +030500 MOVE SPACE TO RE-MARK. RL1084.2 +030600 HEAD-ROUTINE. RL1084.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1084.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1084.2 +031100 COLUMN-NAMES-ROUTINE. RL1084.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +031500 END-ROUTINE. RL1084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1084.2 +031700 END-RTN-EXIT. RL1084.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +031900 END-ROUTINE-1. RL1084.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1084.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1084.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL1084.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1084.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1084.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1084.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1084.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1084.2 +032800 END-ROUTINE-12. RL1084.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1084.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL1084.2 +033100 MOVE "NO " TO ERROR-TOTAL RL1084.2 +033200 ELSE RL1084.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1084.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1084.2 +033500 PERFORM WRITE-LINE. RL1084.2 +033600 END-ROUTINE-13. RL1084.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL1084.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL1084.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1084.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1084.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL1084.2 +034300 MOVE "NO " TO ERROR-TOTAL RL1084.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1084.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1084.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034800 WRITE-LINE. RL1084.2 +034900 ADD 1 TO RECORD-COUNT. RL1084.2 +035000Y IF RECORD-COUNT GREATER 50 RL1084.2 +035100Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1084.2 +035200Y MOVE SPACE TO DUMMY-RECORD RL1084.2 +035300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1084.2 +035400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1084.2 +035500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1084.2 +035600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1084.2 +035700Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1084.2 +035800Y MOVE ZERO TO RECORD-COUNT. RL1084.2 +035900 PERFORM WRT-LN. RL1084.2 +036000 WRT-LN. RL1084.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1084.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL1084.2 +036300 BLANK-LINE-PRINT. RL1084.2 +036400 PERFORM WRT-LN. RL1084.2 +036500 FAIL-ROUTINE. RL1084.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1084.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1084.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1084.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1084.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1084.2 +037200 GO TO FAIL-ROUTINE-EX. RL1084.2 +037300 FAIL-ROUTINE-WRITE. RL1084.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1084.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1084.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1084.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1084.2 +037800 FAIL-ROUTINE-EX. EXIT. RL1084.2 +037900 BAIL-OUT. RL1084.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1084.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1084.2 +038200 BAIL-OUT-WRITE. RL1084.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1084.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1084.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1084.2 +038700 BAIL-OUT-EX. EXIT. RL1084.2 +038800 CCVS1-EXIT. RL1084.2 +038900 EXIT. RL1084.2 +039000 SECT-RL108A-001 SECTION. RL1084.2 +039100 REL-INIT-001. RL1084.2 +039200 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL1084.2 +039300 OPEN OUTPUT RL-FS1. RL1084.2 +039400 MOVE "RL-FS1" TO XFILE-NAME (1). RL1084.2 +039500 MOVE "R1-F-G" TO XRECORD-NAME (1). RL1084.2 +039600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1084.2 +039700 MOVE 000120 TO XRECORD-LENGTH (1). RL1084.2 +039800 MOVE "RC" TO CHARS-OR-RECORDS (1). RL1084.2 +039900 MOVE 0001 TO XBLOCK-SIZE (1). RL1084.2 +040000 MOVE 000500 TO RECORDS-IN-FILE (1). RL1084.2 +040100 MOVE "RL" TO XFILE-ORGANIZATION (1). RL1084.2 +040200 MOVE "S" TO XLABEL-TYPE (1). RL1084.2 +040300 MOVE 000001 TO XRECORD-NUMBER (1). RL1084.2 +040400 REL-TEST-001. RL1084.2 +040500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1084.2 +040600 WRITE RL-FS1R1-F-G-120 RL1084.2 +040700 INVALID KEY GO TO REL-FAIL-001 RL1084.2 +040800 NOT INVALID KEY GO TO REL-TEST-001-A RL1084.2 +040900 END-WRITE. RL1084.2 +041000 REL-TEST-001-A. RL1084.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 500 RL1084.2 +041200 GO TO REL-WRITE-001. RL1084.2 +041300 ADD 000001 TO XRECORD-NUMBER (1). RL1084.2 +041400 GO TO REL-TEST-001. RL1084.2 +041500 REL-DELETE-001. RL1084.2 +041600 PERFORM DE-LETE. RL1084.2 +041700 GO TO REL-WRITE-001. RL1084.2 +041800 REL-FAIL-001. RL1084.2 +041900 PERFORM FAIL. RL1084.2 +042000 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL1084.2 +042100 REL-WRITE-001. RL1084.2 +042200 MOVE "VIII-37 4.9.4(A)" TO ANSI-REFERENCE. RL1084.2 +042300 MOVE "REL-TEST-001" TO PAR-NAME RL1084.2 +042400 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL1084.2 +042500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1084.2 +042600 PERFORM PRINT-DETAIL. RL1084.2 +042700 CLOSE RL-FS1. RL1084.2 +042800 REL-INIT-002. RL1084.2 +042900 OPEN INPUT RL-FS1. RL1084.2 +043000 MOVE ZERO TO WRK-CS-09V00. RL1084.2 +043100 REL-TEST-002. RL1084.2 +043200 READ RL-FS1 RL1084.2 +043300 AT END GO TO REL-TEST-002-1 RL1084.2 +043400 NOT AT END GO TO REL-TEST-002-A RL1084.2 +043500 END-READ. RL1084.2 +043600 REL-TEST-002-A. RL1084.2 +043700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1084.2 +043800 ADD 1 TO WRK-CS-09V00. RL1084.2 +043900 IF WRK-CS-09V00 GREATER 500 RL1084.2 +044000 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL1084.2 +044100 GO TO REL-TEST-002-1. RL1084.2 +044200 GO TO REL-TEST-002. RL1084.2 +044300 REL-DELETE-002. RL1084.2 +044400 PERFORM DE-LETE. RL1084.2 +044500 PERFORM PRINT-DETAIL. RL1084.2 +044600 GO TO CCVS-EXIT. RL1084.2 +044700 REL-TEST-002-1. RL1084.2 +044800 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1084.2 +044900 PERFORM FAIL RL1084.2 +045000 ELSE RL1084.2 +045100 PERFORM PASS. RL1084.2 +045200 GO TO REL-WRITE-002. RL1084.2 +045300 REL-WRITE-002. RL1084.2 +045400 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1084.2 +045500 MOVE "REL-TEST-002" TO PAR-NAME. RL1084.2 +045600 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL1084.2 +045700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1084.2 +045800 PERFORM PRINT-DETAIL. RL1084.2 +045900 CLOSE RL-FS1. RL1084.2 +046000 CCVS-EXIT SECTION. RL1084.2 +046100 CCVS-999999. RL1084.2 +046200 GO TO CLOSE-FILES. RL1084.2 +*END-OF,RL108A +*HEADER,COBOL,RL108A,SUBPRG,RL109A +000100 IDENTIFICATION DIVISION. RL1094.2 +000200 PROGRAM-ID. RL1094.2 +000300 RL109A. RL1094.2 +000400**************************************************************** RL1094.2 +000500* * RL1094.2 +000600* VALIDATION FOR:- * RL1094.2 +000700* * RL1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +000900* * RL1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1094.2 +001100* * RL1094.2 +001200**************************************************************** RL1094.2 +001300* * RL1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1094.2 +001500* * RL1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1094.2 +001900* * RL1094.2 +002000**************************************************************** RL1094.2 +002100*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL1094.2 +002200* I-O FILE RANDOMLY (ACCESS MODE IS RANDOM). THE FILE RL1094.2 +002300* USED AS INPUT IS THAT FILE CREATED BY RL108A. RL1094.2 +002400* RL1094.2 +002500* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL1094.2 +002600* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL1094.2 +002700* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL1094.2 +002800* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL1094.2 +002900* RECORD IN THE FILE IS AGAIN VERIFIED. RL1094.2 +003000* RL1094.2 +003100* THIS PROGRAM TESTS THE NEW SYNTACTICAL CONSTRUCTS AND RL1094.2 +003200* SEMENTIC ACTIONS OF THE FOLLOWING ELEMENTS: RL1094.2 +003300* - ORGANIZATION RL1094.2 +003400* - ACCESS RL1094.2 +003500* - READ RL1094.2 +003600* - REWRITE RL1094.2 +003700* RL1094.2 +003800* RL1094.2 +003900* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1094.2 +004000* PROGRAM ARE: RL1094.2 +004100* RL1094.2 +004200* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1094.2 +004300* RELATIVE I-O DATA FILE RL1094.2 +004400* X-55 SYSTEM PRINTER RL1094.2 +004500* X-69 ADDITIONAL VALUE OF CLAUSES RL1094.2 +004600* X-74 VALUE OF IMPLEMENTOR-NAME RL1094.2 +004700* X-75 OBJECT OF VALUE OF CLAUSE RL1094.2 +004800* X-82 SOURCE-COMPUTER RL1094.2 +004900* X-83 OBJECT-COMPUTER. RL1094.2 +005000* RL1094.2 +005100*************************************************** RL1094.2 +005200 ENVIRONMENT DIVISION. RL1094.2 +005300 CONFIGURATION SECTION. RL1094.2 +005400 SOURCE-COMPUTER. RL1094.2 +005500 XXXXX082. RL1094.2 +005600 OBJECT-COMPUTER. RL1094.2 +005700 XXXXX083. RL1094.2 +005800 INPUT-OUTPUT SECTION. RL1094.2 +005900 FILE-CONTROL. RL1094.2 +006000 SELECT PRINT-FILE ASSIGN TO RL1094.2 +006100 XXXXX055. RL1094.2 +006200 SELECT RL-FR1 ASSIGN TO RL1094.2 +006300 XXXXX061 RL1094.2 +006400 ORGANIZATION IS RELATIVE RL1094.2 +006500 ACCESS MODE IS RANDOM RL1094.2 +006600 RELATIVE RL-FR1-KEY. RL1094.2 +006700 DATA DIVISION. RL1094.2 +006800 FILE SECTION. RL1094.2 +006900 FD PRINT-FILE. RL1094.2 +007000 01 PRINT-REC PICTURE X(120). RL1094.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1094.2 +007200 FD RL-FR1 RL1094.2 +007300 LABEL RECORDS STANDARD RL1094.2 +007400C VALUE OF RL1094.2 +007500C XXXXX074 RL1094.2 +007600C IS RL1094.2 +007700C XXXXX075 RL1094.2 +007800G XXXXX069 RL1094.2 +007900 BLOCK CONTAINS 1 RECORDS RL1094.2 +008000 RECORD CONTAINS 120 CHARACTERS. RL1094.2 +008100 01 RL-FR1R1-F-G-120. RL1094.2 +008200 02 FILLER PICTURE X(120). RL1094.2 +008300 WORKING-STORAGE SECTION. RL1094.2 +008400 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008500 01 RL-FR1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL1094.2 +008600 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL1094.2 +008700 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008800 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008900 01 I-O-ERROR-RL-FR1 PIC X(3) VALUE "NO ". RL1094.2 +009000 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009100 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009200 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009300 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL1094.2 +009400 01 FILE-RECORD-INFORMATION-REC. RL1094.2 +009500 03 FILE-RECORD-INFO-SKELETON. RL1094.2 +009600 05 FILLER PICTURE X(48) VALUE RL1094.2 +009700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1094.2 +009800 05 FILLER PICTURE X(46) VALUE RL1094.2 +009900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1094.2 +010000 05 FILLER PICTURE X(26) VALUE RL1094.2 +010100 ",LFIL=000000,ORG= ,LBLR= ". RL1094.2 +010200 05 FILLER PICTURE X(37) VALUE RL1094.2 +010300 ",RECKEY= ". RL1094.2 +010400 05 FILLER PICTURE X(38) VALUE RL1094.2 +010500 ",ALTKEY1= ". RL1094.2 +010600 05 FILLER PICTURE X(38) VALUE RL1094.2 +010700 ",ALTKEY2= ". RL1094.2 +010800 05 FILLER PICTURE X(7) VALUE SPACE.RL1094.2 +010900 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1094.2 +011000 05 FILE-RECORD-INFO-P1-120. RL1094.2 +011100 07 FILLER PIC X(5). RL1094.2 +011200 07 XFILE-NAME PIC X(6). RL1094.2 +011300 07 FILLER PIC X(8). RL1094.2 +011400 07 XRECORD-NAME PIC X(6). RL1094.2 +011500 07 FILLER PIC X(1). RL1094.2 +011600 07 REELUNIT-NUMBER PIC 9(1). RL1094.2 +011700 07 FILLER PIC X(7). RL1094.2 +011800 07 XRECORD-NUMBER PIC 9(6). RL1094.2 +011900 07 FILLER PIC X(6). RL1094.2 +012000 07 UPDATE-NUMBER PIC 9(2). RL1094.2 +012100 07 FILLER PIC X(5). RL1094.2 +012200 07 ODO-NUMBER PIC 9(4). RL1094.2 +012300 07 FILLER PIC X(5). RL1094.2 +012400 07 XPROGRAM-NAME PIC X(5). RL1094.2 +012500 07 FILLER PIC X(7). RL1094.2 +012600 07 XRECORD-LENGTH PIC 9(6). RL1094.2 +012700 07 FILLER PIC X(7). RL1094.2 +012800 07 CHARS-OR-RECORDS PIC X(2). RL1094.2 +012900 07 FILLER PIC X(1). RL1094.2 +013000 07 XBLOCK-SIZE PIC 9(4). RL1094.2 +013100 07 FILLER PIC X(6). RL1094.2 +013200 07 RECORDS-IN-FILE PIC 9(6). RL1094.2 +013300 07 FILLER PIC X(5). RL1094.2 +013400 07 XFILE-ORGANIZATION PIC X(2). RL1094.2 +013500 07 FILLER PIC X(6). RL1094.2 +013600 07 XLABEL-TYPE PIC X(1). RL1094.2 +013700 05 FILE-RECORD-INFO-P121-240. RL1094.2 +013800 07 FILLER PIC X(8). RL1094.2 +013900 07 XRECORD-KEY PIC X(29). RL1094.2 +014000 07 FILLER PIC X(9). RL1094.2 +014100 07 ALTERNATE-KEY1 PIC X(29). RL1094.2 +014200 07 FILLER PIC X(9). RL1094.2 +014300 07 ALTERNATE-KEY2 PIC X(29). RL1094.2 +014400 07 FILLER PIC X(7). RL1094.2 +014500 01 TEST-RESULTS. RL1094.2 +014600 02 FILLER PIC X VALUE SPACE. RL1094.2 +014700 02 FEATURE PIC X(20) VALUE SPACE. RL1094.2 +014800 02 FILLER PIC X VALUE SPACE. RL1094.2 +014900 02 P-OR-F PIC X(5) VALUE SPACE. RL1094.2 +015000 02 FILLER PIC X VALUE SPACE. RL1094.2 +015100 02 PAR-NAME. RL1094.2 +015200 03 FILLER PIC X(19) VALUE SPACE. RL1094.2 +015300 03 PARDOT-X PIC X VALUE SPACE. RL1094.2 +015400 03 DOTVALUE PIC 99 VALUE ZERO. RL1094.2 +015500 02 FILLER PIC X(8) VALUE SPACE. RL1094.2 +015600 02 RE-MARK PIC X(61). RL1094.2 +015700 01 TEST-COMPUTED. RL1094.2 +015800 02 FILLER PIC X(30) VALUE SPACE. RL1094.2 +015900 02 FILLER PIC X(17) VALUE RL1094.2 +016000 " COMPUTED=". RL1094.2 +016100 02 COMPUTED-X. RL1094.2 +016200 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1094.2 +016300 03 COMPUTED-N REDEFINES COMPUTED-A RL1094.2 +016400 PIC -9(9).9(9). RL1094.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1094.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1094.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1094.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. RL1094.2 +016900 04 COMPUTED-18V0 PIC -9(18). RL1094.2 +017000 04 FILLER PIC X. RL1094.2 +017100 03 FILLER PIC X(50) VALUE SPACE. RL1094.2 +017200 01 TEST-CORRECT. RL1094.2 +017300 02 FILLER PIC X(30) VALUE SPACE. RL1094.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". RL1094.2 +017500 02 CORRECT-X. RL1094.2 +017600 03 CORRECT-A PIC X(20) VALUE SPACE. RL1094.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1094.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1094.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1094.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1094.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. RL1094.2 +018200 04 CORRECT-18V0 PIC -9(18). RL1094.2 +018300 04 FILLER PIC X. RL1094.2 +018400 03 FILLER PIC X(2) VALUE SPACE. RL1094.2 +018500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1094.2 +018600 01 CCVS-C-1. RL1094.2 +018700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1094.2 +018800- "SS PARAGRAPH-NAME RL1094.2 +018900- " REMARKS". RL1094.2 +019000 02 FILLER PIC X(20) VALUE SPACE. RL1094.2 +019100 01 CCVS-C-2. RL1094.2 +019200 02 FILLER PIC X VALUE SPACE. RL1094.2 +019300 02 FILLER PIC X(6) VALUE "TESTED". RL1094.2 +019400 02 FILLER PIC X(15) VALUE SPACE. RL1094.2 +019500 02 FILLER PIC X(4) VALUE "FAIL". RL1094.2 +019600 02 FILLER PIC X(94) VALUE SPACE. RL1094.2 +019700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1094.2 +019800 01 REC-CT PIC 99 VALUE ZERO. RL1094.2 +019900 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020000 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020200 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020300 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1094.2 +020400 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1094.2 +020500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1094.2 +020600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1094.2 +020700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1094.2 +020800 01 CCVS-H-1. RL1094.2 +020900 02 FILLER PIC X(39) VALUE SPACES. RL1094.2 +021000 02 FILLER PIC X(42) VALUE RL1094.2 +021100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1094.2 +021200 02 FILLER PIC X(39) VALUE SPACES. RL1094.2 +021300 01 CCVS-H-2A. RL1094.2 +021400 02 FILLER PIC X(40) VALUE SPACE. RL1094.2 +021500 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1094.2 +021600 02 FILLER PIC XXXX VALUE RL1094.2 +021700 "4.2 ". RL1094.2 +021800 02 FILLER PIC X(28) VALUE RL1094.2 +021900 " COPY - NOT FOR DISTRIBUTION". RL1094.2 +022000 02 FILLER PIC X(41) VALUE SPACE. RL1094.2 +022100 RL1094.2 +022200 01 CCVS-H-2B. RL1094.2 +022300 02 FILLER PIC X(15) VALUE RL1094.2 +022400 "TEST RESULT OF ". RL1094.2 +022500 02 TEST-ID PIC X(9). RL1094.2 +022600 02 FILLER PIC X(4) VALUE RL1094.2 +022700 " IN ". RL1094.2 +022800 02 FILLER PIC X(12) VALUE RL1094.2 +022900 " HIGH ". RL1094.2 +023000 02 FILLER PIC X(22) VALUE RL1094.2 +023100 " LEVEL VALIDATION FOR ". RL1094.2 +023200 02 FILLER PIC X(58) VALUE RL1094.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +023400 01 CCVS-H-3. RL1094.2 +023500 02 FILLER PIC X(34) VALUE RL1094.2 +023600 " FOR OFFICIAL USE ONLY ". RL1094.2 +023700 02 FILLER PIC X(58) VALUE RL1094.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1094.2 +023900 02 FILLER PIC X(28) VALUE RL1094.2 +024000 " COPYRIGHT 1985 ". RL1094.2 +024100 01 CCVS-E-1. RL1094.2 +024200 02 FILLER PIC X(52) VALUE SPACE. RL1094.2 +024300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1094.2 +024400 02 ID-AGAIN PIC X(9). RL1094.2 +024500 02 FILLER PIC X(45) VALUE SPACES. RL1094.2 +024600 01 CCVS-E-2. RL1094.2 +024700 02 FILLER PIC X(31) VALUE SPACE. RL1094.2 +024800 02 FILLER PIC X(21) VALUE SPACE. RL1094.2 +024900 02 CCVS-E-2-2. RL1094.2 +025000 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1094.2 +025100 03 FILLER PIC X VALUE SPACE. RL1094.2 +025200 03 ENDER-DESC PIC X(44) VALUE RL1094.2 +025300 "ERRORS ENCOUNTERED". RL1094.2 +025400 01 CCVS-E-3. RL1094.2 +025500 02 FILLER PIC X(22) VALUE RL1094.2 +025600 " FOR OFFICIAL USE ONLY". RL1094.2 +025700 02 FILLER PIC X(12) VALUE SPACE. RL1094.2 +025800 02 FILLER PIC X(58) VALUE RL1094.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +026000 02 FILLER PIC X(13) VALUE SPACE. RL1094.2 +026100 02 FILLER PIC X(15) VALUE RL1094.2 +026200 " COPYRIGHT 1985". RL1094.2 +026300 01 CCVS-E-4. RL1094.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1094.2 +026500 02 FILLER PIC X(4) VALUE " OF ". RL1094.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1094.2 +026700 02 FILLER PIC X(40) VALUE RL1094.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". RL1094.2 +026900 01 XXINFO. RL1094.2 +027000 02 FILLER PIC X(19) VALUE RL1094.2 +027100 "*** INFORMATION ***". RL1094.2 +027200 02 INFO-TEXT. RL1094.2 +027300 04 FILLER PIC X(8) VALUE SPACE. RL1094.2 +027400 04 XXCOMPUTED PIC X(20). RL1094.2 +027500 04 FILLER PIC X(5) VALUE SPACE. RL1094.2 +027600 04 XXCORRECT PIC X(20). RL1094.2 +027700 02 INF-ANSI-REFERENCE PIC X(48). RL1094.2 +027800 01 HYPHEN-LINE. RL1094.2 +027900 02 FILLER PIC IS X VALUE IS SPACE. RL1094.2 +028000 02 FILLER PIC IS X(65) VALUE IS "************************RL1094.2 +028100- "*****************************************". RL1094.2 +028200 02 FILLER PIC IS X(54) VALUE IS "************************RL1094.2 +028300- "******************************". RL1094.2 +028400 01 CCVS-PGM-ID PIC X(9) VALUE RL1094.2 +028500 "RL109A". RL1094.2 +028600 PROCEDURE DIVISION. RL1094.2 +028700 CCVS1 SECTION. RL1094.2 +028800 OPEN-FILES. RL1094.2 +028900 OPEN OUTPUT PRINT-FILE. RL1094.2 +029000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1094.2 +029100 MOVE SPACE TO TEST-RESULTS. RL1094.2 +029200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1094.2 +029300 MOVE ZERO TO REC-SKL-SUB. RL1094.2 +029400 PERFORM CCVS-INIT-FILE 9 TIMES. RL1094.2 +029500 CCVS-INIT-FILE. RL1094.2 +029600 ADD 1 TO REC-SKL-SUB. RL1094.2 +029700 MOVE FILE-RECORD-INFO-SKELETON RL1094.2 +029800 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1094.2 +029900 CCVS-INIT-EXIT. RL1094.2 +030000 GO TO CCVS1-EXIT. RL1094.2 +030100 CLOSE-FILES. RL1094.2 +030200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1094.2 +030300 TERMINATE-CCVS. RL1094.2 +030400S EXIT PROGRAM. RL1094.2 +030500STERMINATE-CALL. RL1094.2 +030600 STOP RUN. RL1094.2 +030700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1094.2 +030800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1094.2 +030900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1094.2 +031000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1094.2 +031100 MOVE "****TEST DELETED****" TO RE-MARK. RL1094.2 +031200 PRINT-DETAIL. RL1094.2 +031300 IF REC-CT NOT EQUAL TO ZERO RL1094.2 +031400 MOVE "." TO PARDOT-X RL1094.2 +031500 MOVE REC-CT TO DOTVALUE. RL1094.2 +031600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1094.2 +031700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1094.2 +031800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1094.2 +031900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1094.2 +032000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1094.2 +032100 MOVE SPACE TO CORRECT-X. RL1094.2 +032200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1094.2 +032300 MOVE SPACE TO RE-MARK. RL1094.2 +032400 HEAD-ROUTINE. RL1094.2 +032500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +032600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +032700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1094.2 +032800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1094.2 +032900 COLUMN-NAMES-ROUTINE. RL1094.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +033300 END-ROUTINE. RL1094.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1094.2 +033500 END-RTN-EXIT. RL1094.2 +033600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +033700 END-ROUTINE-1. RL1094.2 +033800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1094.2 +033900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1094.2 +034000 ADD PASS-COUNTER TO ERROR-HOLD. RL1094.2 +034100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1094.2 +034200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1094.2 +034300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1094.2 +034400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1094.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1094.2 +034600 END-ROUTINE-12. RL1094.2 +034700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1094.2 +034800 IF ERROR-COUNTER IS EQUAL TO ZERO RL1094.2 +034900 MOVE "NO " TO ERROR-TOTAL RL1094.2 +035000 ELSE RL1094.2 +035100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1094.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1094.2 +035300 PERFORM WRITE-LINE. RL1094.2 +035400 END-ROUTINE-13. RL1094.2 +035500 IF DELETE-COUNTER IS EQUAL TO ZERO RL1094.2 +035600 MOVE "NO " TO ERROR-TOTAL ELSE RL1094.2 +035700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1094.2 +035800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1094.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036000 IF INSPECT-COUNTER EQUAL TO ZERO RL1094.2 +036100 MOVE "NO " TO ERROR-TOTAL RL1094.2 +036200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1094.2 +036300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1094.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036600 WRITE-LINE. RL1094.2 +036700 ADD 1 TO RECORD-COUNT. RL1094.2 +036800Y IF RECORD-COUNT GREATER 50 RL1094.2 +036900Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1094.2 +037000Y MOVE SPACE TO DUMMY-RECORD RL1094.2 +037100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1094.2 +037200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1094.2 +037300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1094.2 +037400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1094.2 +037500Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1094.2 +037600Y MOVE ZERO TO RECORD-COUNT. RL1094.2 +037700 PERFORM WRT-LN. RL1094.2 +037800 WRT-LN. RL1094.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1094.2 +038000 MOVE SPACE TO DUMMY-RECORD. RL1094.2 +038100 BLANK-LINE-PRINT. RL1094.2 +038200 PERFORM WRT-LN. RL1094.2 +038300 FAIL-ROUTINE. RL1094.2 +038400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1094.2 +038500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1094.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1094.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1094.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1094.2 +039000 GO TO FAIL-ROUTINE-EX. RL1094.2 +039100 FAIL-ROUTINE-WRITE. RL1094.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1094.2 +039300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1094.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1094.2 +039500 MOVE SPACES TO COR-ANSI-REFERENCE. RL1094.2 +039600 FAIL-ROUTINE-EX. EXIT. RL1094.2 +039700 BAIL-OUT. RL1094.2 +039800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1094.2 +039900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1094.2 +040000 BAIL-OUT-WRITE. RL1094.2 +040100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1094.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1094.2 +040300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +040400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1094.2 +040500 BAIL-OUT-EX. EXIT. RL1094.2 +040600 CCVS1-EXIT. RL1094.2 +040700 EXIT. RL1094.2 +040800 SECT-RL109A-001 SECTION. RL1094.2 +040900 REL-INIT-003. RL1094.2 +041000 OPEN INPUT RL-FR1. RL1094.2 +041100 MOVE "REL-TEST-003" TO PAR-NAME. RL1094.2 +041200 MOVE ZERO TO RL-FR1-KEY. RL1094.2 +041300 MOVE ZERO TO WRK-CS-09V00-002 RL1094.2 +041400 MOVE ZERO TO WRK-CS-09V00-003 RL1094.2 +041500* RL1094.2 +041600 MOVE 01 TO REC-CT. RL1094.2 +041700 MOVE "READ RANDOM" TO FEATURE. RL1094.2 +041800 REL-TEST-003-R. RL1094.2 +041900 ADD 1 TO WRK-CS-09V00-003 RL1094.2 +042000 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +042100 IF RL-FR1-KEY GREATER +501 RL1094.2 +042200 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL1094.2 +042300 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1094.2 +042400 PERFORM FAIL RL1094.2 +042500 PERFORM PRINT-DETAIL RL1094.2 +042600 ADD 1 TO REC-CT RL1094.2 +042700 GO TO REL-WRITE-003. RL1094.2 +042800 READ RL-FR1 RL1094.2 +042900 INVALID GO TO REL-WRITE-003 RL1094.2 +043000 NOT INVALID GO TO REL-TEST-003-A RL1094.2 +043100 END-READ. RL1094.2 +043200 REL-TEST-003-A. RL1094.2 +043300 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +043400 IF XRECORD-NUMBER (1) EQUAL TO RL-FR1-KEY RL1094.2 +043500 GO TO REL-TEST-003-R. RL1094.2 +043600 MOVE "YES" TO I-O-ERROR-RL-FR1. RL1094.2 +043700 ADD 1 TO WRK-CS-09V00-002 RL1094.2 +043800 GO TO REL-TEST-003-R. RL1094.2 +043900 REL-WRITE-003. RL1094.2 +044000 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1094.2 +044100 IF RL-FR1-KEY NOT EQUAL TO 501 RL1094.2 +044200 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL1094.2 +044300 MOVE RL-FR1-KEY TO COMPUTED-18V0 RL1094.2 +044400 PERFORM FAIL RL1094.2 +044500 ELSE RL1094.2 +044600 PERFORM PASS. RL1094.2 +044700 PERFORM PRINT-DETAIL. RL1094.2 +044800* RL1094.2 +044900*01 RL1094.2 +045000* RL1094.2 +045100 ADD 1 TO REC-CT. RL1094.2 +045200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1094.2 +045300 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL1094.2 +045400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL1094.2 +045500 PERFORM FAIL RL1094.2 +045600 ELSE RL1094.2 +045700 PERFORM PASS. RL1094.2 +045800 PERFORM PRINT-DETAIL. RL1094.2 +045900* RL1094.2 +046000*02 RL1094.2 +046100* RL1094.2 +046200 ADD 1 TO REC-CT. RL1094.2 +046300 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL1094.2 +046400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1094.2 +046500 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1094.2 +046600 MOVE 501 TO CORRECT-18V0 RL1094.2 +046700 PERFORM FAIL RL1094.2 +046800 ELSE RL1094.2 +046900 PERFORM PASS. RL1094.2 +047000 PERFORM PRINT-DETAIL. RL1094.2 +047100* RL1094.2 +047200*03 RL1094.2 +047300* RL1094.2 +047400 ADD 1 TO REC-CT. RL1094.2 +047500 IF I-O-ERROR-RL-FR1 EQUAL TO "YES" RL1094.2 +047600 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL1094.2 +047700 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL1094.2 +047800 PERFORM FAIL RL1094.2 +047900 ELSE RL1094.2 +048000 PERFORM PASS. RL1094.2 +048100 PERFORM PRINT-DETAIL. RL1094.2 +048200* RL1094.2 +048300*04 RL1094.2 +048400* RL1094.2 +048500 ADD 1 TO REC-CT. RL1094.2 +048600 CLOSE RL-FR1. RL1094.2 +048700 REL-INIT-004-R . RL1094.2 +048800 MOVE "VIII-30 4.6.4" TO ANSI-REFERENCE. RL1094.2 +048900 MOVE "REL-TEST-004" TO PAR-NAME. RL1094.2 +049000 OPEN I-O RL-FR1. RL1094.2 +049100 MOVE ZERO TO RL-FR1-KEY. RL1094.2 +049200 MOVE ZERO TO WRK-CS-09V00-002. RL1094.2 +049300 MOVE ZERO TO WRK-CS-09V00-003. RL1094.2 +049400 MOVE ZERO TO WRK-CS-09V00-004. RL1094.2 +049500 MOVE ZERO TO WRK-CS-09V00-005. RL1094.2 +049600* RL1094.2 +049700 MOVE 01 TO REC-CT. RL1094.2 +049800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +049900 MOVE "REWRITE" TO FEATURE. RL1094.2 +050000 REL-TEST-004-R. RL1094.2 +050100 ADD 5 TO WRK-CS-09V00-003. RL1094.2 +050200 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +050300 IF RL-FR1-KEY GREATER 505 RL1094.2 +050400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL1094.2 +050500 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1094.2 +050600 PERFORM FAIL RL1094.2 +050700 PERFORM PRINT-DETAIL RL1094.2 +050800 ADD 1 TO REC-CT RL1094.2 +050900 GO TO REL-TEST-004-3. RL1094.2 +051000 READ RL-FR1 RL1094.2 +051100 INVALID KEY GO TO REL-TEST-004-1 RL1094.2 +051200 NOT INVALID KEY GO TO REL-TEST-004-A RL1094.2 +051300 END-READ. RL1094.2 +051400 REL-TEST-004-A. RL1094.2 +051500 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL1094.2 +051600 ADD 01 TO UPDATE-NUMBER (1). RL1094.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1094.2 +051800 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FR1R1-F-G-120. RL1094.2 +051900 REWRITE RL-FR1R1-F-G-120 RL1094.2 +052000 INVALID KEY GO TO REL-TEST-004-2 RL1094.2 +052100 NOT INVALID KEY GO TO REL-TEST-004-R RL1094.2 +052200 END-REWRITE. RL1094.2 +052300 REL-TEST-004-1. RL1094.2 +052400 IF RL-FR1-KEY LESS THAN 501 RL1094.2 +052500 ADD 1 TO WRK-CS-09V00-004 RL1094.2 +052600 GO TO REL-TEST-004-R. RL1094.2 +052700 PERFORM PASS. RL1094.2 +052800 PERFORM PRINT-DETAIL. RL1094.2 +052900* RL1094.2 +053000*01 RL1094.2 +053100* RL1094.2 +053200 ADD 1 TO REC-CT. RL1094.2 +053300 GO TO REL-TEST-004-3. RL1094.2 +053400 REL-TEST-004-2. RL1094.2 +053500 ADD 1 TO WRK-CS-09V00-005. RL1094.2 +053600 IF RL-FR1-KEY LESS 501 RL1094.2 +053700 GO TO REL-TEST-004-R. RL1094.2 +053800 REL-TEST-004-3. RL1094.2 +053900 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL1094.2 +054000 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL1094.2 +054100 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1094.2 +054200 PERFORM FAIL RL1094.2 +054300 ELSE RL1094.2 +054400 PERFORM PASS. RL1094.2 +054500 PERFORM PRINT-DETAIL. RL1094.2 +054600* RL1094.2 +054700*02 RL1094.2 +054800* RL1094.2 +054900 ADD 1 TO REC-CT. RL1094.2 +055000 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL1094.2 +055100 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL1094.2 +055200 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1094.2 +055300 PERFORM FAIL RL1094.2 +055400 ELSE RL1094.2 +055500 PERFORM PASS. RL1094.2 +055600 PERFORM PRINT-DETAIL. RL1094.2 +055700* RL1094.2 +055800*03 RL1094.2 +055900* RL1094.2 +056000 ADD 1 TO REC-CT. RL1094.2 +056100 CLOSE RL-FR1. RL1094.2 +056200 REL-INIT-005. RL1094.2 +056300 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1094.2 +056400 MOVE "REL-TEST-005" TO PAR-NAME. RL1094.2 +056500 OPEN INPUT RL-FR1. RL1094.2 +056600 MOVE 501 TO WRK-CS-09V00-003. RL1094.2 +056700 MOVE ZERO TO WRK-CS-09V00-004. RL1094.2 +056800 MOVE ZERO TO WRK-CS-09V00-005. RL1094.2 +056900 MOVE ZERO TO WRK-CS-09V00-002. RL1094.2 +057000 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +057100 MOVE 01 TO REC-CT. RL1094.2 +057200* RL1094.2 +057300 MOVE "READ RANDOM" TO FEATURE. RL1094.2 +057400 REL-TEST-005-R. RL1094.2 +057500 SUBTRACT 1 FROM WRK-CS-09V00-003. RL1094.2 +057600 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +057700 IF WRK-CS-09V00-003 LESS THAN ZERO RL1094.2 +057800 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL1094.2 +057900 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1094.2 +058000 MOVE ZERO TO CORRECT-18V0 RL1094.2 +058100 PERFORM FAIL RL1094.2 +058200 PERFORM PRINT-DETAIL RL1094.2 +058300 ADD 1 TO REC-CT RL1094.2 +058400 GO TO REL-TEST-005-3. RL1094.2 +058500 READ RL-FR1 RL1094.2 +058600 INVALID KEY GO TO REL-TEST-005-1 RL1094.2 +058700 NOT INVALID KEY GO TO REL-TEST-005-A RL1094.2 +058800 END-READ. RL1094.2 +058900 REL-TEST-005-A. RL1094.2 +059000 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +059100 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1094.2 +059200 ADD 1 TO WRK-CS-09V00-004. RL1094.2 +059300 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1094.2 +059400 ADD 1 TO WRK-CS-09V00-005. RL1094.2 +059500 GO TO REL-TEST-005-R. RL1094.2 +059600 REL-TEST-005-1. RL1094.2 +059700 IF RL-FR1-KEY GREATER ZERO RL1094.2 +059800 ADD 1 TO WRK-CS-09V00-002 RL1094.2 +059900 GO TO REL-TEST-005-R. RL1094.2 +060000 PERFORM PASS. RL1094.2 +060100 PERFORM PRINT-DETAIL. RL1094.2 +060200 ADD 1 TO REC-CT. RL1094.2 +060300*01 RL1094.2 +060400 GO TO REL-TEST-005-3. RL1094.2 +060500 REL-TEST-005-3. RL1094.2 +060600 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL1094.2 +060700 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1094.2 +060800 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1094.2 +060900 MOVE "SHOULD BE 400" TO RE-MARK RL1094.2 +061000 PERFORM FAIL RL1094.2 +061100 ELSE RL1094.2 +061200 PERFORM PASS. RL1094.2 +061300 PERFORM PRINT-DETAIL. RL1094.2 +061400* RL1094.2 +061500* RL1094.2 +061600*02 RL1094.2 +061700* RL1094.2 +061800 ADD 1 TO REC-CT. RL1094.2 +061900 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL1094.2 +062000 MOVE "UPDATED RECORDS" TO COMPUTED-A RL1094.2 +062100 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1094.2 +062200 MOVE "SHOULD BE 100" TO RE-MARK RL1094.2 +062300 PERFORM FAIL RL1094.2 +062400 ELSE RL1094.2 +062500 PERFORM PASS. RL1094.2 +062600 PERFORM PRINT-DETAIL. RL1094.2 +062700* RL1094.2 +062800*03 RL1094.2 +062900* RL1094.2 +063000 ADD 1 TO REC-CT. RL1094.2 +063100 IF WRK-CS-09V00-002 GREATER 1 RL1094.2 +063200 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL1094.2 +063300 MOVE "INVALID KEY/READS" TO CORRECT-A RL1094.2 +063400 PERFORM FAIL RL1094.2 +063500 ELSE RL1094.2 +063600 PERFORM PASS. RL1094.2 +063700 PERFORM PRINT-DETAIL. RL1094.2 +063800* RL1094.2 +063900*04 RL1094.2 +064000* RL1094.2 +064100 ADD 1 TO REC-CT. RL1094.2 +064200 CLOSE RL-FR1. RL1094.2 +064300 CCVS-EXIT SECTION. RL1094.2 +064400 CCVS-999999. RL1094.2 +064500 GO TO CLOSE-FILES. RL1094.2 +*END-OF,RL109A +*HEADER,COBOL,RL108A,SUBPRG,RL110A +000100 IDENTIFICATION DIVISION. RL1104.2 +000200 PROGRAM-ID. RL1104.2 +000300 RL110A. RL1104.2 +000400**************************************************************** RL1104.2 +000500* * RL1104.2 +000600* VALIDATION FOR:- * RL1104.2 +000700* * RL1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +000900* * RL1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1104.2 +001100* * RL1104.2 +001200**************************************************************** RL1104.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL1104.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL1104.2 +001500* (ACCESS MODE IS SEQUENTIAL). THE FILE USED IS THAT RL1104.2 +001600* RESULTING FROM RL109A. RL1104.2 +001700* RL1104.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL1104.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL1104.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL1104.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1104.2 +002200* RL1104.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1104.2 +002400* PROGRAM ARE: RL1104.2 +002500* RL1104.2 +002600* RL1104.2 +002700* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1104.2 +002800* RELATIVE I-O DATA FILE RL1104.2 +002900* X-55 SYSTEM PRINTER RL1104.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1104.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1104.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE RL1104.2 +003300* X-82 SOURCE-COMPUTER RL1104.2 +003400* X-83 OBJECT-COMPUTER. RL1104.2 +003500* RL1104.2 +003600*************************************************** RL1104.2 +003700 ENVIRONMENT DIVISION. RL1104.2 +003800 CONFIGURATION SECTION. RL1104.2 +003900 SOURCE-COMPUTER. RL1104.2 +004000 XXXXX082. RL1104.2 +004100 OBJECT-COMPUTER. RL1104.2 +004200 XXXXX083. RL1104.2 +004300 INPUT-OUTPUT SECTION. RL1104.2 +004400 FILE-CONTROL. RL1104.2 +004500 SELECT PRINT-FILE ASSIGN TO RL1104.2 +004600 XXXXX055. RL1104.2 +004700 SELECT RL-FS1 ASSIGN TO RL1104.2 +004800 XXXXX061 RL1104.2 +004900 ORGANIZATION IS RELATIVE RL1104.2 +005000 ACCESS MODE IS SEQUENTIAL RL1104.2 +005100 RELATIVE KEY IS RL-FS1-KEY. RL1104.2 +005200 DATA DIVISION. RL1104.2 +005300 FILE SECTION. RL1104.2 +005400 FD PRINT-FILE. RL1104.2 +005500 01 PRINT-REC PICTURE X(120). RL1104.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL1104.2 +005700 FD RL-FS1 RL1104.2 +005800 LABEL RECORDS STANDARD RL1104.2 +005900C VALUE OF RL1104.2 +006000C XXXXX074 RL1104.2 +006100C IS RL1104.2 +006200C XXXXX075 RL1104.2 +006300G XXXXX069 RL1104.2 +006400 BLOCK CONTAINS 01 RECORDS RL1104.2 +006500 RECORD CONTAINS 120. RL1104.2 +006600 01 RL-FS1R1-F-G-120. RL1104.2 +006700 02 RL-WRK-120 PIC X(120). RL1104.2 +006800 WORKING-STORAGE SECTION. RL1104.2 +006900 01 RL-FS1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL1104.2 +007000 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007100 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007200 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007300 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007400 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007500 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007600 01 I-O-ERROR-RL-FS1 PIC X(3) VALUE "NO ". RL1104.2 +007700 01 FILE-RECORD-INFORMATION-REC. RL1104.2 +007800 03 FILE-RECORD-INFO-SKELETON. RL1104.2 +007900 05 FILLER PICTURE X(48) VALUE RL1104.2 +008000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1104.2 +008100 05 FILLER PICTURE X(46) VALUE RL1104.2 +008200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1104.2 +008300 05 FILLER PICTURE X(26) VALUE RL1104.2 +008400 ",LFIL=000000,ORG= ,LBLR= ". RL1104.2 +008500 05 FILLER PICTURE X(37) VALUE RL1104.2 +008600 ",RECKEY= ". RL1104.2 +008700 05 FILLER PICTURE X(38) VALUE RL1104.2 +008800 ",ALTKEY1= ". RL1104.2 +008900 05 FILLER PICTURE X(38) VALUE RL1104.2 +009000 ",ALTKEY2= ". RL1104.2 +009100 05 FILLER PICTURE X(7) VALUE SPACE.RL1104.2 +009200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1104.2 +009300 05 FILE-RECORD-INFO-P1-120. RL1104.2 +009400 07 FILLER PIC X(5). RL1104.2 +009500 07 XFILE-NAME PIC X(6). RL1104.2 +009600 07 FILLER PIC X(8). RL1104.2 +009700 07 XRECORD-NAME PIC X(6). RL1104.2 +009800 07 FILLER PIC X(1). RL1104.2 +009900 07 REELUNIT-NUMBER PIC 9(1). RL1104.2 +010000 07 FILLER PIC X(7). RL1104.2 +010100 07 XRECORD-NUMBER PIC 9(6). RL1104.2 +010200 07 FILLER PIC X(6). RL1104.2 +010300 07 UPDATE-NUMBER PIC 9(2). RL1104.2 +010400 07 FILLER PIC X(5). RL1104.2 +010500 07 ODO-NUMBER PIC 9(4). RL1104.2 +010600 07 FILLER PIC X(5). RL1104.2 +010700 07 XPROGRAM-NAME PIC X(5). RL1104.2 +010800 07 FILLER PIC X(7). RL1104.2 +010900 07 XRECORD-LENGTH PIC 9(6). RL1104.2 +011000 07 FILLER PIC X(7). RL1104.2 +011100 07 CHARS-OR-RECORDS PIC X(2). RL1104.2 +011200 07 FILLER PIC X(1). RL1104.2 +011300 07 XBLOCK-SIZE PIC 9(4). RL1104.2 +011400 07 FILLER PIC X(6). RL1104.2 +011500 07 RECORDS-IN-FILE PIC 9(6). RL1104.2 +011600 07 FILLER PIC X(5). RL1104.2 +011700 07 XFILE-ORGANIZATION PIC X(2). RL1104.2 +011800 07 FILLER PIC X(6). RL1104.2 +011900 07 XLABEL-TYPE PIC X(1). RL1104.2 +012000 05 FILE-RECORD-INFO-P121-240. RL1104.2 +012100 07 FILLER PIC X(8). RL1104.2 +012200 07 XRECORD-KEY PIC X(29). RL1104.2 +012300 07 FILLER PIC X(9). RL1104.2 +012400 07 ALTERNATE-KEY1 PIC X(29). RL1104.2 +012500 07 FILLER PIC X(9). RL1104.2 +012600 07 ALTERNATE-KEY2 PIC X(29). RL1104.2 +012700 07 FILLER PIC X(7). RL1104.2 +012800 01 TEST-RESULTS. RL1104.2 +012900 02 FILLER PIC X VALUE SPACE. RL1104.2 +013000 02 FEATURE PIC X(20) VALUE SPACE. RL1104.2 +013100 02 FILLER PIC X VALUE SPACE. RL1104.2 +013200 02 P-OR-F PIC X(5) VALUE SPACE. RL1104.2 +013300 02 FILLER PIC X VALUE SPACE. RL1104.2 +013400 02 PAR-NAME. RL1104.2 +013500 03 FILLER PIC X(19) VALUE SPACE. RL1104.2 +013600 03 PARDOT-X PIC X VALUE SPACE. RL1104.2 +013700 03 DOTVALUE PIC 99 VALUE ZERO. RL1104.2 +013800 02 FILLER PIC X(8) VALUE SPACE. RL1104.2 +013900 02 RE-MARK PIC X(61). RL1104.2 +014000 01 TEST-COMPUTED. RL1104.2 +014100 02 FILLER PIC X(30) VALUE SPACE. RL1104.2 +014200 02 FILLER PIC X(17) VALUE RL1104.2 +014300 " COMPUTED=". RL1104.2 +014400 02 COMPUTED-X. RL1104.2 +014500 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1104.2 +014600 03 COMPUTED-N REDEFINES COMPUTED-A RL1104.2 +014700 PIC -9(9).9(9). RL1104.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1104.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1104.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1104.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. RL1104.2 +015200 04 COMPUTED-18V0 PIC -9(18). RL1104.2 +015300 04 FILLER PIC X. RL1104.2 +015400 03 FILLER PIC X(50) VALUE SPACE. RL1104.2 +015500 01 TEST-CORRECT. RL1104.2 +015600 02 FILLER PIC X(30) VALUE SPACE. RL1104.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". RL1104.2 +015800 02 CORRECT-X. RL1104.2 +015900 03 CORRECT-A PIC X(20) VALUE SPACE. RL1104.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1104.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1104.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1104.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1104.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. RL1104.2 +016500 04 CORRECT-18V0 PIC -9(18). RL1104.2 +016600 04 FILLER PIC X. RL1104.2 +016700 03 FILLER PIC X(2) VALUE SPACE. RL1104.2 +016800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1104.2 +016900 01 CCVS-C-1. RL1104.2 +017000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1104.2 +017100- "SS PARAGRAPH-NAME RL1104.2 +017200- " REMARKS". RL1104.2 +017300 02 FILLER PIC X(20) VALUE SPACE. RL1104.2 +017400 01 CCVS-C-2. RL1104.2 +017500 02 FILLER PIC X VALUE SPACE. RL1104.2 +017600 02 FILLER PIC X(6) VALUE "TESTED". RL1104.2 +017700 02 FILLER PIC X(15) VALUE SPACE. RL1104.2 +017800 02 FILLER PIC X(4) VALUE "FAIL". RL1104.2 +017900 02 FILLER PIC X(94) VALUE SPACE. RL1104.2 +018000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1104.2 +018100 01 REC-CT PIC 99 VALUE ZERO. RL1104.2 +018200 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018300 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018500 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018600 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1104.2 +018700 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1104.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1104.2 +018900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1104.2 +019000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1104.2 +019100 01 CCVS-H-1. RL1104.2 +019200 02 FILLER PIC X(39) VALUE SPACES. RL1104.2 +019300 02 FILLER PIC X(42) VALUE RL1104.2 +019400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1104.2 +019500 02 FILLER PIC X(39) VALUE SPACES. RL1104.2 +019600 01 CCVS-H-2A. RL1104.2 +019700 02 FILLER PIC X(40) VALUE SPACE. RL1104.2 +019800 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1104.2 +019900 02 FILLER PIC XXXX VALUE RL1104.2 +020000 "4.2 ". RL1104.2 +020100 02 FILLER PIC X(28) VALUE RL1104.2 +020200 " COPY - NOT FOR DISTRIBUTION". RL1104.2 +020300 02 FILLER PIC X(41) VALUE SPACE. RL1104.2 +020400 RL1104.2 +020500 01 CCVS-H-2B. RL1104.2 +020600 02 FILLER PIC X(15) VALUE RL1104.2 +020700 "TEST RESULT OF ". RL1104.2 +020800 02 TEST-ID PIC X(9). RL1104.2 +020900 02 FILLER PIC X(4) VALUE RL1104.2 +021000 " IN ". RL1104.2 +021100 02 FILLER PIC X(12) VALUE RL1104.2 +021200 " HIGH ". RL1104.2 +021300 02 FILLER PIC X(22) VALUE RL1104.2 +021400 " LEVEL VALIDATION FOR ". RL1104.2 +021500 02 FILLER PIC X(58) VALUE RL1104.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +021700 01 CCVS-H-3. RL1104.2 +021800 02 FILLER PIC X(34) VALUE RL1104.2 +021900 " FOR OFFICIAL USE ONLY ". RL1104.2 +022000 02 FILLER PIC X(58) VALUE RL1104.2 +022100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1104.2 +022200 02 FILLER PIC X(28) VALUE RL1104.2 +022300 " COPYRIGHT 1985 ". RL1104.2 +022400 01 CCVS-E-1. RL1104.2 +022500 02 FILLER PIC X(52) VALUE SPACE. RL1104.2 +022600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1104.2 +022700 02 ID-AGAIN PIC X(9). RL1104.2 +022800 02 FILLER PIC X(45) VALUE SPACES. RL1104.2 +022900 01 CCVS-E-2. RL1104.2 +023000 02 FILLER PIC X(31) VALUE SPACE. RL1104.2 +023100 02 FILLER PIC X(21) VALUE SPACE. RL1104.2 +023200 02 CCVS-E-2-2. RL1104.2 +023300 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1104.2 +023400 03 FILLER PIC X VALUE SPACE. RL1104.2 +023500 03 ENDER-DESC PIC X(44) VALUE RL1104.2 +023600 "ERRORS ENCOUNTERED". RL1104.2 +023700 01 CCVS-E-3. RL1104.2 +023800 02 FILLER PIC X(22) VALUE RL1104.2 +023900 " FOR OFFICIAL USE ONLY". RL1104.2 +024000 02 FILLER PIC X(12) VALUE SPACE. RL1104.2 +024100 02 FILLER PIC X(58) VALUE RL1104.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +024300 02 FILLER PIC X(13) VALUE SPACE. RL1104.2 +024400 02 FILLER PIC X(15) VALUE RL1104.2 +024500 " COPYRIGHT 1985". RL1104.2 +024600 01 CCVS-E-4. RL1104.2 +024700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1104.2 +024800 02 FILLER PIC X(4) VALUE " OF ". RL1104.2 +024900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1104.2 +025000 02 FILLER PIC X(40) VALUE RL1104.2 +025100 " TESTS WERE EXECUTED SUCCESSFULLY". RL1104.2 +025200 01 XXINFO. RL1104.2 +025300 02 FILLER PIC X(19) VALUE RL1104.2 +025400 "*** INFORMATION ***". RL1104.2 +025500 02 INFO-TEXT. RL1104.2 +025600 04 FILLER PIC X(8) VALUE SPACE. RL1104.2 +025700 04 XXCOMPUTED PIC X(20). RL1104.2 +025800 04 FILLER PIC X(5) VALUE SPACE. RL1104.2 +025900 04 XXCORRECT PIC X(20). RL1104.2 +026000 02 INF-ANSI-REFERENCE PIC X(48). RL1104.2 +026100 01 HYPHEN-LINE. RL1104.2 +026200 02 FILLER PIC IS X VALUE IS SPACE. RL1104.2 +026300 02 FILLER PIC IS X(65) VALUE IS "************************RL1104.2 +026400- "*****************************************". RL1104.2 +026500 02 FILLER PIC IS X(54) VALUE IS "************************RL1104.2 +026600- "******************************". RL1104.2 +026700 01 CCVS-PGM-ID PIC X(9) VALUE RL1104.2 +026800 "RL110A". RL1104.2 +026900 PROCEDURE DIVISION. RL1104.2 +027000 CCVS1 SECTION. RL1104.2 +027100 OPEN-FILES. RL1104.2 +027200 OPEN OUTPUT PRINT-FILE. RL1104.2 +027300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1104.2 +027400 MOVE SPACE TO TEST-RESULTS. RL1104.2 +027500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1104.2 +027600 MOVE ZERO TO REC-SKL-SUB. RL1104.2 +027700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1104.2 +027800 CCVS-INIT-FILE. RL1104.2 +027900 ADD 1 TO REC-SKL-SUB. RL1104.2 +028000 MOVE FILE-RECORD-INFO-SKELETON RL1104.2 +028100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1104.2 +028200 CCVS-INIT-EXIT. RL1104.2 +028300 GO TO CCVS1-EXIT. RL1104.2 +028400 CLOSE-FILES. RL1104.2 +028500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1104.2 +028600 TERMINATE-CCVS. RL1104.2 +028700S EXIT PROGRAM. RL1104.2 +028800STERMINATE-CALL. RL1104.2 +028900 STOP RUN. RL1104.2 +029000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1104.2 +029100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1104.2 +029200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1104.2 +029300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1104.2 +029400 MOVE "****TEST DELETED****" TO RE-MARK. RL1104.2 +029500 PRINT-DETAIL. RL1104.2 +029600 IF REC-CT NOT EQUAL TO ZERO RL1104.2 +029700 MOVE "." TO PARDOT-X RL1104.2 +029800 MOVE REC-CT TO DOTVALUE. RL1104.2 +029900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1104.2 +030000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1104.2 +030100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1104.2 +030200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1104.2 +030300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1104.2 +030400 MOVE SPACE TO CORRECT-X. RL1104.2 +030500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1104.2 +030600 MOVE SPACE TO RE-MARK. RL1104.2 +030700 HEAD-ROUTINE. RL1104.2 +030800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +030900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +031000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1104.2 +031100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1104.2 +031200 COLUMN-NAMES-ROUTINE. RL1104.2 +031300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +031400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +031500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +031600 END-ROUTINE. RL1104.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1104.2 +031800 END-RTN-EXIT. RL1104.2 +031900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +032000 END-ROUTINE-1. RL1104.2 +032100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1104.2 +032200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1104.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. RL1104.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1104.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1104.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1104.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1104.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1104.2 +032900 END-ROUTINE-12. RL1104.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1104.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1104.2 +033200 MOVE "NO " TO ERROR-TOTAL RL1104.2 +033300 ELSE RL1104.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1104.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1104.2 +033600 PERFORM WRITE-LINE. RL1104.2 +033700 END-ROUTINE-13. RL1104.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1104.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE RL1104.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1104.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1104.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO RL1104.2 +034400 MOVE "NO " TO ERROR-TOTAL RL1104.2 +034500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1104.2 +034600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1104.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034900 WRITE-LINE. RL1104.2 +035000 ADD 1 TO RECORD-COUNT. RL1104.2 +035100Y IF RECORD-COUNT GREATER 50 RL1104.2 +035200Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1104.2 +035300Y MOVE SPACE TO DUMMY-RECORD RL1104.2 +035400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1104.2 +035500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1104.2 +035600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1104.2 +035700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1104.2 +035800Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1104.2 +035900Y MOVE ZERO TO RECORD-COUNT. RL1104.2 +036000 PERFORM WRT-LN. RL1104.2 +036100 WRT-LN. RL1104.2 +036200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1104.2 +036300 MOVE SPACE TO DUMMY-RECORD. RL1104.2 +036400 BLANK-LINE-PRINT. RL1104.2 +036500 PERFORM WRT-LN. RL1104.2 +036600 FAIL-ROUTINE. RL1104.2 +036700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1104.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1104.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1104.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1104.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1104.2 +037300 GO TO FAIL-ROUTINE-EX. RL1104.2 +037400 FAIL-ROUTINE-WRITE. RL1104.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1104.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1104.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1104.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL1104.2 +037900 FAIL-ROUTINE-EX. EXIT. RL1104.2 +038000 BAIL-OUT. RL1104.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1104.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1104.2 +038300 BAIL-OUT-WRITE. RL1104.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1104.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1104.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1104.2 +038800 BAIL-OUT-EX. EXIT. RL1104.2 +038900 CCVS1-EXIT. RL1104.2 +039000 EXIT. RL1104.2 +039100 SECT-RL110A-001 SECTION. RL1104.2 +039200 REL-INIT-006. RL1104.2 +039300 MOVE 99 TO RL-FS1-KEY. RL1104.2 +039400* THIS FILE "RL-FS1" IS ACCESSED SEQUENTIALLY AND HAS RL1104.2 +039500* ASSOCIATED WITH IT A RELATIVE KEY WHICH AT ALL TIMES SHOULD RL1104.2 +039600* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL1104.2 +039700 OPEN INPUT RL-FS1. RL1104.2 +039800 MOVE "REL-TEST-006" TO PAR-NAME. RL1104.2 +039900 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +040000 MOVE ZERO TO WRK-CS-09V00-006. RL1104.2 +040100 MOVE ZERO TO WRK-CS-09V00-007. RL1104.2 +040200 MOVE ZERO TO WRK-CS-09V00-008. RL1104.2 +040300 MOVE ZERO TO WRK-CS-09V00-009. RL1104.2 +040400 MOVE ZERO TO WRK-CS-09V00-010. RL1104.2 +040500 MOVE ZERO TO WRK-CS-09V00-011. RL1104.2 +040600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +040700 MOVE RL-FS1-KEY TO WRK-CS-09V00-011. RL1104.2 +040800 MOVE 01 TO REC-CT. RL1104.2 +040900 MOVE "READ SEQUENTIAL" TO FEATURE. RL1104.2 +041000 REL-TEST-006-R. RL1104.2 +041100 ADD 1 TO WRK-CS-09V00-006. RL1104.2 +041200 READ RL-FS1 RL1104.2 +041300 END GO TO REL-TEST-006-3 RL1104.2 +041400 NOT AT END GO TO REL-TEST-006-A RL1104.2 +041500 END-READ. RL1104.2 +041600 REL-TEST-006-A. RL1104.2 +041700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +041800 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1104.2 +041900 ADD 1 TO WRK-CS-09V00-007 RL1104.2 +042000 GO TO REL-TEST-006-2. RL1104.2 +042100 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1104.2 +042200 ADD 1 TO WRK-CS-09V00-008 RL1104.2 +042300 GO TO REL-TEST-006-2. RL1104.2 +042400 ADD 1 TO WRK-CS-09V00-009. RL1104.2 +042500 REL-TEST-006-2. RL1104.2 +042600 IF RL-FS1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL1104.2 +042700 ADD 1 TO WRK-CS-09V00-010. RL1104.2 +042800 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +042900 GO TO REL-TEST-006-3. RL1104.2 +043000 GO TO REL-TEST-006-R. RL1104.2 +043100 REL-TEST-006-3. RL1104.2 +043200 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1104.2 +043300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1104.2 +043400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +043500 MOVE 501 TO CORRECT-18V0 RL1104.2 +043600 PERFORM FAIL RL1104.2 +043700 ELSE RL1104.2 +043800 PERFORM PASS. RL1104.2 +043900 PERFORM PRINT-DETAIL. RL1104.2 +044000* .01 RL1104.2 +044100 ADD 1 TO REC-CT. RL1104.2 +044200 IF WRK-CS-09V00-007 EQUAL TO 400 RL1104.2 +044300 PERFORM PASS RL1104.2 +044400 ELSE RL1104.2 +044500 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1104.2 +044600 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL1104.2 +044700 MOVE "SHOULD BE 400" TO RE-MARK RL1104.2 +044800 PERFORM FAIL. RL1104.2 +044900 PERFORM PRINT-DETAIL. RL1104.2 +045000 ADD 1 TO REC-CT. RL1104.2 +045100* .02 RL1104.2 +045200 IF WRK-CS-09V00-008 EQUAL TO 100 RL1104.2 +045300 PERFORM PASS RL1104.2 +045400 ELSE RL1104.2 +045500 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1104.2 +045600 MOVE 100 TO CORRECT-18V0 RL1104.2 +045700 MOVE "UPDATED RECORDS" TO RE-MARK RL1104.2 +045800 PERFORM FAIL. RL1104.2 +045900 PERFORM PRINT-DETAIL. RL1104.2 +046000 ADD 1 TO REC-CT. RL1104.2 +046100* .03 RL1104.2 +046200 IF WRK-CS-09V00-009 EQUAL TO ZERO RL1104.2 +046300 PERFORM PASS RL1104.2 +046400 ELSE RL1104.2 +046500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1104.2 +046600 MOVE ZERO TO CORRECT-18V0 RL1104.2 +046700 MOVE "BAD-UPDATES" TO RE-MARK RL1104.2 +046800 PERFORM FAIL. RL1104.2 +046900 PERFORM PRINT-DETAIL. RL1104.2 +047000 ADD 01 TO REC-CT. RL1104.2 +047100* .04 RL1104.2 +047200 IF WRK-CS-09V00-010 EQUAL TO ZERO RL1104.2 +047300 PERFORM PASS RL1104.2 +047400 ELSE RL1104.2 +047500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1104.2 +047600 MOVE ZERO TO CORRECT-18V0 RL1104.2 +047700 MOVE "KEY VS RECORD" TO RE-MARK RL1104.2 +047800 PERFORM FAIL. RL1104.2 +047900 PERFORM PRINT-DETAIL. RL1104.2 +048000 ADD 01 TO REC-CT. RL1104.2 +048100* .05 RL1104.2 +048200 MOVE WRK-CS-09V00-011 TO RL-FS1-KEY. RL1104.2 +048300 MOVE RL-FS1-KEY TO COMPUTED-18V0. RL1104.2 +048400 MOVE "INFORMATION" TO CORRECT-A. RL1104.2 +048500 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL1104.2 +048600 PERFORM PRINT-DETAIL. RL1104.2 +048700 ADD 01 TO REC-CT. RL1104.2 +048800* .06 RL1104.2 +048900 CLOSE RL-FS1. RL1104.2 +049000 REL-INIT-007. RL1104.2 +049100 MOVE "REL-TEST-007" TO PAR-NAME RL1104.2 +049200 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +049300 OPEN I-O RL-FS1. RL1104.2 +049400 MOVE ZERO TO WRK-CS-09V00-006 RL1104.2 +049500 MOVE ZERO TO WRK-CS-09V00-007 RL1104.2 +049600 MOVE ZERO TO WRK-CS-09V00-008 RL1104.2 +049700 MOVE ZERO TO WRK-CS-09V00-009 RL1104.2 +049800 MOVE ZERO TO WRK-CS-09V00-010 RL1104.2 +049900 MOVE ZERO TO WRK-CS-09V00-011 RL1104.2 +050000 MOVE 01 TO REC-CT. RL1104.2 +050100 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +050200 MOVE "DELETE" TO FEATURE. RL1104.2 +050300 REL-TEST-007-R. RL1104.2 +050400 ADD 1 TO WRK-CS-09V00-006 RL1104.2 +050500 ADD 1 TO WRK-CS-09V00-007. RL1104.2 +050600 READ RL-FS1 RL1104.2 +050700 AT END RL1104.2 +050800 MOVE "AT END PATH TAKEN " TO RE-MARK RL1104.2 +050900 GO TO REL-TEST-007-3 RL1104.2 +051000 NOT AT END RL1104.2 +051100 GO TO REL-TEST-007-A RL1104.2 +051200 END-READ. RL1104.2 +051300 REL-TEST-007-A. RL1104.2 +051400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +051500 IF WRK-CS-09V00-007 EQUAL TO 4 RL1104.2 +051600 GO TO REL-TEST-007-2. RL1104.2 +051700 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +051800 MOVE "AT END NOT TAKEN" TO RE-MARK RL1104.2 +051900 GO TO REL-TEST-007-3. RL1104.2 +052000 GO TO REL-TEST-007-R. RL1104.2 +052100 REL-TEST-007-2. RL1104.2 +052200 MOVE "VII-19 4.3.4" TO ANSI-REFERENCE. RL1104.2 +052300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1104.2 +052400 MOVE 99 TO UPDATE-NUMBER (1). RL1104.2 +052500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1104.2 +052600 DELETE RL-FS1 RL1104.2 +052700 END-DELETE. RL1104.2 +052800 REL-TEST-007-2-A. RL1104.2 +052900 MOVE ZERO TO WRK-CS-09V00-007. RL1104.2 +053000 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +053100 GO TO REL-TEST-007-R. RL1104.2 +053200 REL-TEST-007-3. RL1104.2 +053300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1104.2 +053400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +053500 MOVE 501 TO CORRECT-18V0 RL1104.2 +053600 PERFORM FAIL RL1104.2 +053700 ELSE RL1104.2 +053800 PERFORM PASS. RL1104.2 +053900 PERFORM PRINT-DETAIL. RL1104.2 +054000 ADD 01 TO REC-CT. RL1104.2 +054100 CLOSE RL-FS1. RL1104.2 +054200 REL-INIT-008. RL1104.2 +054300 MOVE "REL-TEST-008" TO PAR-NAME. RL1104.2 +054400 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +054500 MOVE ZERO TO WRK-CS-09V00-006 RL1104.2 +054600 MOVE ZERO TO WRK-CS-09V00-007 RL1104.2 +054700 MOVE ZERO TO WRK-CS-09V00-008 RL1104.2 +054800 MOVE ZERO TO WRK-CS-09V00-009 RL1104.2 +054900 MOVE ZERO TO WRK-CS-09V00-010 RL1104.2 +055000 MOVE ZERO TO WRK-CS-09V00-011 RL1104.2 +055100 MOVE 01 TO REC-CT. RL1104.2 +055200 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +055300 MOVE ZERO TO RL-FS1-KEY. RL1104.2 +055400 OPEN INPUT RL-FS1. RL1104.2 +055500 MOVE "READ UPDATED FILE" TO FEATURE. RL1104.2 +055600 REL-TEST-008-R. RL1104.2 +055700 ADD 1 TO WRK-CS-09V00-006. RL1104.2 +055800 ADD 1 TO WRK-CS-09V00-007. RL1104.2 +055900 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +056000 READ RL-FS1 RL1104.2 +056100 AT END GO TO REL-TEST-008-3 RL1104.2 +056200 NOT AT END GO TO REL-TEST-008-A RL1104.2 +056300 END-READ. RL1104.2 +056400 REL-TEST-008-A. RL1104.2 +056500 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +056600 IF UPDATE-NUMBER (1) EQUAL TO 99 RL1104.2 +056700 ADD 1 TO WRK-CS-09V00-009. RL1104.2 +056800 IF WRK-CS-09V00-007 EQUAL TO 4 RL1104.2 +056900 MOVE 01 TO WRK-CS-09V00-007 RL1104.2 +057000 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +057100 IF RL-FS1-KEY EQUAL TO XRECORD-NUMBER (1) RL1104.2 +057200 ADD 1 TO WRK-CS-09V00-010. RL1104.2 +057300 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL1104.2 +057400 ADD 1 TO WRK-CS-09V00-011. RL1104.2 +057500 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +057600 GO TO REL-TEST-008-3. RL1104.2 +057700 GO TO REL-TEST-008-R. RL1104.2 +057800 REL-TEST-008-3. RL1104.2 +057900 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL1104.2 +058000 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1104.2 +058100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +058200 MOVE 376 TO CORRECT-18V0 RL1104.2 +058300 PERFORM FAIL RL1104.2 +058400 ELSE RL1104.2 +058500 PERFORM PASS. RL1104.2 +058600 PERFORM PRINT-DETAIL. RL1104.2 +058700 ADD 01 TO REC-CT. RL1104.2 +058800* .01 RL1104.2 +058900 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL1104.2 +059000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1104.2 +059100 MOVE ZERO TO CORRECT-18V0 RL1104.2 +059200 MOVE "DELETED RECORDS" TO RE-MARK RL1104.2 +059300 PERFORM FAIL RL1104.2 +059400 ELSE RL1104.2 +059500 PERFORM PASS. RL1104.2 +059600 PERFORM PRINT-DETAIL. RL1104.2 +059700 ADD 01 TO REC-CT. RL1104.2 +059800* .02 RL1104.2 +059900 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL1104.2 +060000 MOVE "KEY MISMATCH" TO RE-MARK RL1104.2 +060100 MOVE 375 TO CORRECT-18V0 RL1104.2 +060200 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1104.2 +060300 PERFORM FAIL RL1104.2 +060400 ELSE RL1104.2 +060500 PERFORM PASS. RL1104.2 +060600 PERFORM PRINT-DETAIL. RL1104.2 +060700 ADD 01 TO REC-CT. RL1104.2 +060800* .03 RL1104.2 +060900 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL1104.2 +061000 MOVE 375 TO CORRECT-18V0 RL1104.2 +061100 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL1104.2 +061200 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL1104.2 +061300 PERFORM FAIL RL1104.2 +061400 ELSE RL1104.2 +061500 PERFORM PASS. RL1104.2 +061600 PERFORM PRINT-DETAIL. RL1104.2 +061700 ADD 01 TO REC-CT. RL1104.2 +061800*04 RL1104.2 +061900 CLOSE RL-FS1. RL1104.2 +062000 CCVS-EXIT SECTION. RL1104.2 +062100 CCVS-999999. RL1104.2 +062200 GO TO CLOSE-FILES. RL1104.2 +*END-OF,RL110A +*HEADER,COBOL,RL111A +000100 IDENTIFICATION DIVISION. RL1114.2 +000200 PROGRAM-ID. RL1114.2 +000300 RL111A. RL1114.2 +000400**************************************************************** RL1114.2 +000500* * RL1114.2 +000600* VALIDATION FOR:- * RL1114.2 +000700* * RL1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +000900* * RL1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1114.2 +001100* * RL1114.2 +001200**************************************************************** RL1114.2 +001300* * RL1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1114.2 +001500* * RL1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1114.2 +001900* * RL1114.2 +002000**************************************************************** RL1114.2 +002100* * RL1114.2 +002200* THIS PROGRAM WILL TEST THE SYNTACTICAL CONSTRUCTS AND * RL1114.2 +002300* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING CLAUSES: * RL1114.2 +002400* * RL1114.2 +002500* - ACCESS * RL1114.2 +002600* - READ * RL1114.2 +002700* - WRITE * RL1114.2 +002800* - REWRITE * RL1114.2 +002900* * RL1114.2 +003000* 1) THE PROGRAM WILL CREATE A RELATIVE I-O FILE * RL1114.2 +003100* 2) THEN IT WILL UPDATE SELECTIVE RECORDS OF THE FILE * RL1114.2 +003200* 3) THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR * RL1114.2 +003300* ACCURACY FOR EACH "OPEN", "CLOSE", "READ" AND * RL1114.2 +003400* "REWRITE" STATEMENT USED. * RL1114.2 +003500* 4) THE "READ", "WRITE" AND "REWRITE" STATEMENT WILL BE * RL1114.2 +003600* USED WITH THE APPROPRIATE "AT END", "NOT AT END" * RL1114.2 +003700* "INVALID KEY" AND "NOT INVALID KEY" PHRASES. * RL1114.2 +003800* * RL1114.2 +003900**************************************************************** RL1114.2 +004000 ENVIRONMENT DIVISION. RL1114.2 +004100 CONFIGURATION SECTION. RL1114.2 +004200 SOURCE-COMPUTER. RL1114.2 +004300 XXXXX082. RL1114.2 +004400 OBJECT-COMPUTER. RL1114.2 +004500 XXXXX083. RL1114.2 +004600 INPUT-OUTPUT SECTION. RL1114.2 +004700 FILE-CONTROL. RL1114.2 +004800 SELECT PRINT-FILE ASSIGN TO RL1114.2 +004900 XXXXX055. RL1114.2 +005000 SELECT RL-FS2 ASSIGN RL1114.2 +005100 XXXXX022 RL1114.2 +005200 ORGANIZATION RELATIVE RL1114.2 +005300 ACCESS IS SEQUENTIAL RL1114.2 +005400 RELATIVE KEY IS RL-FS2-KEY RL1114.2 +005500 STATUS RL-FS2-STATUS. RL1114.2 +005600 SELECT RL-FS3 ASSIGN RL1114.2 +005700 XXXXX022 RL1114.2 +005800 ORGANIZATION RELATIVE RL1114.2 +005900 ACCESS IS RANDOM RL1114.2 +006000 RELATIVE KEY IS RL-FS3-KEY RL1114.2 +006100 STATUS RL-FS3-STATUS. RL1114.2 +006200 DATA DIVISION. RL1114.2 +006300 FILE SECTION. RL1114.2 +006400 FD PRINT-FILE. RL1114.2 +006500 01 PRINT-REC PICTURE X(120). RL1114.2 +006600 01 DUMMY-RECORD PICTURE X(120). RL1114.2 +006700 FD RL-FS2 RL1114.2 +006800C VALUE OF RL1114.2 +006900C XXXXX074 RL1114.2 +007000C IS RL1114.2 +007100C XXXXX076 RL1114.2 +007200G XXXXX069 RL1114.2 +007300 LABEL RECORDS ARE STANDARD RL1114.2 +007400 BLOCK CONTAINS 1 RECORDS RL1114.2 +007500 DATA RECORD RL-FS2R1-F-G-240. RL1114.2 +007600 01 RL-FS2R1-F-G-240. RL1114.2 +007700 05 RL-FS2-WRK-120 PIC X(120). RL1114.2 +007800 05 RL-FS2-GRP-120. RL1114.2 +007900 10 RL-FS2-WRK-XN-0001-O120F RL1114.2 +008000 PICTURE X OCCURS 120 TIMES. RL1114.2 +008100 FD RL-FS3 RL1114.2 +008200C VALUE OF RL1114.2 +008300C XXXXX074 RL1114.2 +008400C IS RL1114.2 +008500C XXXXX076 RL1114.2 +008600G XXXXX069 RL1114.2 +008700 LABEL RECORDS ARE STANDARD RL1114.2 +008800 BLOCK CONTAINS 1 RECORDS RL1114.2 +008900 DATA RECORD RL-FS3R1-F-G-240. RL1114.2 +009000 01 RL-FS3R1-F-G-240. RL1114.2 +009100 05 RL-FS3-WRK-120 PIC X(120). RL1114.2 +009200 05 RL-FS3-GRP-120. RL1114.2 +009300 10 RL-FS3-WRK-XN-0001-O120F RL1114.2 +009400 PICTURE X OCCURS 120 TIMES. RL1114.2 +009500 WORKING-STORAGE SECTION. RL1114.2 +009600 01 GRP-0001. RL1114.2 +009700 05 RL-FS2-KEY PIC 9(8) VALUE ZERO. RL1114.2 +009800 05 RL-FS3-KEY PIC 9(8) VALUE ZERO. RL1114.2 +009900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010600 05 RL-FS2-STATUS PIC XX VALUE SPACE. RL1114.2 +010700 05 RL-FS3-STATUS PIC XX VALUE SPACE. RL1114.2 +010800 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1114.2 +010900 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1114.2 +011000 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1114.2 +011100 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1114.2 +011200 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1114.2 +011300 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1114.2 +011400 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1114.2 +011500 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1114.2 +011600 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1114.2 +011700 01 FILE-RECORD-INFORMATION-REC. RL1114.2 +011800 03 FILE-RECORD-INFO-SKELETON. RL1114.2 +011900 05 FILLER PICTURE X(48) VALUE RL1114.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1114.2 +012100 05 FILLER PICTURE X(46) VALUE RL1114.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1114.2 +012300 05 FILLER PICTURE X(26) VALUE RL1114.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". RL1114.2 +012500 05 FILLER PICTURE X(37) VALUE RL1114.2 +012600 ",RECKEY= ". RL1114.2 +012700 05 FILLER PICTURE X(38) VALUE RL1114.2 +012800 ",ALTKEY1= ". RL1114.2 +012900 05 FILLER PICTURE X(38) VALUE RL1114.2 +013000 ",ALTKEY2= ". RL1114.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.RL1114.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1114.2 +013300 05 FILE-RECORD-INFO-P1-120. RL1114.2 +013400 07 FILLER PIC X(5). RL1114.2 +013500 07 XFILE-NAME PIC X(6). RL1114.2 +013600 07 FILLER PIC X(8). RL1114.2 +013700 07 XRECORD-NAME PIC X(6). RL1114.2 +013800 07 FILLER PIC X(1). RL1114.2 +013900 07 REELUNIT-NUMBER PIC 9(1). RL1114.2 +014000 07 FILLER PIC X(7). RL1114.2 +014100 07 XRECORD-NUMBER PIC 9(6). RL1114.2 +014200 07 FILLER PIC X(6). RL1114.2 +014300 07 UPDATE-NUMBER PIC 9(2). RL1114.2 +014400 07 FILLER PIC X(5). RL1114.2 +014500 07 ODO-NUMBER PIC 9(4). RL1114.2 +014600 07 FILLER PIC X(5). RL1114.2 +014700 07 XPROGRAM-NAME PIC X(5). RL1114.2 +014800 07 FILLER PIC X(7). RL1114.2 +014900 07 XRECORD-LENGTH PIC 9(6). RL1114.2 +015000 07 FILLER PIC X(7). RL1114.2 +015100 07 CHARS-OR-RECORDS PIC X(2). RL1114.2 +015200 07 FILLER PIC X(1). RL1114.2 +015300 07 XBLOCK-SIZE PIC 9(4). RL1114.2 +015400 07 FILLER PIC X(6). RL1114.2 +015500 07 RECORDS-IN-FILE PIC 9(6). RL1114.2 +015600 07 FILLER PIC X(5). RL1114.2 +015700 07 XFILE-ORGANIZATION PIC X(2). RL1114.2 +015800 07 FILLER PIC X(6). RL1114.2 +015900 07 XLABEL-TYPE PIC X(1). RL1114.2 +016000 05 FILE-RECORD-INFO-P121-240. RL1114.2 +016100 07 FILLER PIC X(8). RL1114.2 +016200 07 XRECORD-KEY PIC X(29). RL1114.2 +016300 07 FILLER PIC X(9). RL1114.2 +016400 07 ALTERNATE-KEY1 PIC X(29). RL1114.2 +016500 07 FILLER PIC X(9). RL1114.2 +016600 07 ALTERNATE-KEY2 PIC X(29). RL1114.2 +016700 07 FILLER PIC X(7). RL1114.2 +016800 01 WRK-XN-00001-1 PIC X. RL1114.2 +016900 01 WRK-XN-00001-2 PIC X. RL1114.2 +017000 01 TEST-RESULTS. RL1114.2 +017100 02 FILLER PIC X VALUE SPACE. RL1114.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. RL1114.2 +017300 02 FILLER PIC X VALUE SPACE. RL1114.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. RL1114.2 +017500 02 FILLER PIC X VALUE SPACE. RL1114.2 +017600 02 PAR-NAME. RL1114.2 +017700 03 FILLER PIC X(19) VALUE SPACE. RL1114.2 +017800 03 PARDOT-X PIC X VALUE SPACE. RL1114.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. RL1114.2 +018000 02 FILLER PIC X(8) VALUE SPACE. RL1114.2 +018100 02 RE-MARK PIC X(61). RL1114.2 +018200 01 TEST-COMPUTED. RL1114.2 +018300 02 FILLER PIC X(30) VALUE SPACE. RL1114.2 +018400 02 FILLER PIC X(17) VALUE RL1114.2 +018500 " COMPUTED=". RL1114.2 +018600 02 COMPUTED-X. RL1114.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1114.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A RL1114.2 +018900 PIC -9(9).9(9). RL1114.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1114.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1114.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1114.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. RL1114.2 +019400 04 COMPUTED-18V0 PIC -9(18). RL1114.2 +019500 04 FILLER PIC X. RL1114.2 +019600 03 FILLER PIC X(50) VALUE SPACE. RL1114.2 +019700 01 TEST-CORRECT. RL1114.2 +019800 02 FILLER PIC X(30) VALUE SPACE. RL1114.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1114.2 +020000 02 CORRECT-X. RL1114.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1114.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1114.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1114.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1114.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1114.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. RL1114.2 +020700 04 CORRECT-18V0 PIC -9(18). RL1114.2 +020800 04 FILLER PIC X. RL1114.2 +020900 03 FILLER PIC X(2) VALUE SPACE. RL1114.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1114.2 +021100 01 CCVS-C-1. RL1114.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1114.2 +021300- "SS PARAGRAPH-NAME RL1114.2 +021400- " REMARKS". RL1114.2 +021500 02 FILLER PIC X(20) VALUE SPACE. RL1114.2 +021600 01 CCVS-C-2. RL1114.2 +021700 02 FILLER PIC X VALUE SPACE. RL1114.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". RL1114.2 +021900 02 FILLER PIC X(15) VALUE SPACE. RL1114.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". RL1114.2 +022100 02 FILLER PIC X(94) VALUE SPACE. RL1114.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1114.2 +022300 01 REC-CT PIC 99 VALUE ZERO. RL1114.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1114.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1114.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1114.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1114.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1114.2 +023300 01 CCVS-H-1. RL1114.2 +023400 02 FILLER PIC X(39) VALUE SPACES. RL1114.2 +023500 02 FILLER PIC X(42) VALUE RL1114.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1114.2 +023700 02 FILLER PIC X(39) VALUE SPACES. RL1114.2 +023800 01 CCVS-H-2A. RL1114.2 +023900 02 FILLER PIC X(40) VALUE SPACE. RL1114.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1114.2 +024100 02 FILLER PIC XXXX VALUE RL1114.2 +024200 "4.2 ". RL1114.2 +024300 02 FILLER PIC X(28) VALUE RL1114.2 +024400 " COPY - NOT FOR DISTRIBUTION". RL1114.2 +024500 02 FILLER PIC X(41) VALUE SPACE. RL1114.2 +024600 RL1114.2 +024700 01 CCVS-H-2B. RL1114.2 +024800 02 FILLER PIC X(15) VALUE RL1114.2 +024900 "TEST RESULT OF ". RL1114.2 +025000 02 TEST-ID PIC X(9). RL1114.2 +025100 02 FILLER PIC X(4) VALUE RL1114.2 +025200 " IN ". RL1114.2 +025300 02 FILLER PIC X(12) VALUE RL1114.2 +025400 " HIGH ". RL1114.2 +025500 02 FILLER PIC X(22) VALUE RL1114.2 +025600 " LEVEL VALIDATION FOR ". RL1114.2 +025700 02 FILLER PIC X(58) VALUE RL1114.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +025900 01 CCVS-H-3. RL1114.2 +026000 02 FILLER PIC X(34) VALUE RL1114.2 +026100 " FOR OFFICIAL USE ONLY ". RL1114.2 +026200 02 FILLER PIC X(58) VALUE RL1114.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1114.2 +026400 02 FILLER PIC X(28) VALUE RL1114.2 +026500 " COPYRIGHT 1985 ". RL1114.2 +026600 01 CCVS-E-1. RL1114.2 +026700 02 FILLER PIC X(52) VALUE SPACE. RL1114.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1114.2 +026900 02 ID-AGAIN PIC X(9). RL1114.2 +027000 02 FILLER PIC X(45) VALUE SPACES. RL1114.2 +027100 01 CCVS-E-2. RL1114.2 +027200 02 FILLER PIC X(31) VALUE SPACE. RL1114.2 +027300 02 FILLER PIC X(21) VALUE SPACE. RL1114.2 +027400 02 CCVS-E-2-2. RL1114.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1114.2 +027600 03 FILLER PIC X VALUE SPACE. RL1114.2 +027700 03 ENDER-DESC PIC X(44) VALUE RL1114.2 +027800 "ERRORS ENCOUNTERED". RL1114.2 +027900 01 CCVS-E-3. RL1114.2 +028000 02 FILLER PIC X(22) VALUE RL1114.2 +028100 " FOR OFFICIAL USE ONLY". RL1114.2 +028200 02 FILLER PIC X(12) VALUE SPACE. RL1114.2 +028300 02 FILLER PIC X(58) VALUE RL1114.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +028500 02 FILLER PIC X(13) VALUE SPACE. RL1114.2 +028600 02 FILLER PIC X(15) VALUE RL1114.2 +028700 " COPYRIGHT 1985". RL1114.2 +028800 01 CCVS-E-4. RL1114.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1114.2 +029000 02 FILLER PIC X(4) VALUE " OF ". RL1114.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1114.2 +029200 02 FILLER PIC X(40) VALUE RL1114.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1114.2 +029400 01 XXINFO. RL1114.2 +029500 02 FILLER PIC X(19) VALUE RL1114.2 +029600 "*** INFORMATION ***". RL1114.2 +029700 02 INFO-TEXT. RL1114.2 +029800 04 FILLER PIC X(8) VALUE SPACE. RL1114.2 +029900 04 XXCOMPUTED PIC X(20). RL1114.2 +030000 04 FILLER PIC X(5) VALUE SPACE. RL1114.2 +030100 04 XXCORRECT PIC X(20). RL1114.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). RL1114.2 +030300 01 HYPHEN-LINE. RL1114.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. RL1114.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************RL1114.2 +030600- "*****************************************". RL1114.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************RL1114.2 +030800- "******************************". RL1114.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE RL1114.2 +031000 "RL111A". RL1114.2 +031100 PROCEDURE DIVISION. RL1114.2 +031200 DECLARATIVES. RL1114.2 +031300 RL-FS2-01 SECTION. RL1114.2 +031400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS2. RL1114.2 +031500 RL-FS2-01-01. RL1114.2 +031600 ADD 1 TO WRK-CS-09V00-013. RL1114.2 +031700 GO TO RL-FS2-01-03 RL1114.2 +031800 RL-FS2-01-05 RL1114.2 +031900 DEPENDING ON WRK-CS-09V00-012. RL1114.2 +032000 GO TO RL-FS2-01-EXIT. RL1114.2 +032100 RL-FS2-01-03. RL1114.2 +032200*ENTRY FROM SEGMENT REL-TEST-009. RL1114.2 +032300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1114.2 +032400 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +032500 RL-FS2-01-05. RL1114.2 +032600 ADD 1 TO WRK-CS-09V00-017. RL1114.2 +032700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +032800 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1114.2 +032900 MOVE "10" TO WRK-XN-0002-003. RL1114.2 +033000 RL-FS2-01-EXIT. RL1114.2 +033100 EXIT. RL1114.2 +033200 RL-FS2-02 SECTION. RL1114.2 +033300 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS3. RL1114.2 +033400 RL-FS2-02-01. RL1114.2 +033500 IF PAR-NAME = "REL-TEST-060-1" RL1114.2 +033600 GO TO RL-FS2-02-STAT. RL1114.2 +033700 ADD 1 TO WRK-CS-09V00-013. RL1114.2 +033800* GO TO RL-FS2-02-03 RL1114.2 +033900* RL-FS2-02-05 RL1114.2 +034000* DEPENDING ON WRK-CS-09V00-012. RL1114.2 +034100 GO TO D-CLOSE-FILES. RL1114.2 +034200 RL-FS2-02-STAT. RL1114.2 +034300 IF RL-FS3-STATUS = "48" RL1114.2 +034400 PERFORM D-PASS RL1114.2 +034500 ELSE RL1114.2 +034600 MOVE "WRITE TO FILE OPENED INPUT NOT ALLOWED" RL1114.2 +034700 TO RE-MARK RL1114.2 +034800 PERFORM D-FAIL. RL1114.2 +034900 PERFORM D-PRINT-DETAIL. RL1114.2 +035000 D-CLOSE-FILES. RL1114.2 +035100 CLOSE RL-FS3. RL1114.2 +035200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. RL1114.2 +035300 CLOSE PRINT-FILE. RL1114.2 +035400 D-TERMINATE-CCVS. RL1114.2 +035500S EXIT PROGRAM. RL1114.2 +035600SD-TERMINATE-CALL. RL1114.2 +035700 STOP RUN. RL1114.2 +035800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1114.2 +035900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1114.2 +036000 D-PRINT-DETAIL. RL1114.2 +036100 IF REC-CT NOT EQUAL TO ZERO RL1114.2 +036200 MOVE "." TO PARDOT-X RL1114.2 +036300 MOVE REC-CT TO DOTVALUE. RL1114.2 +036400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. RL1114.2 +036500 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE RL1114.2 +036600 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX RL1114.2 +036700 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. RL1114.2 +036800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1114.2 +036900 MOVE SPACE TO CORRECT-X. RL1114.2 +037000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1114.2 +037100 MOVE SPACE TO RE-MARK. RL1114.2 +037200 D-END-ROUTINE. RL1114.2 +037300 MOVE HYPHEN-LINE TO DUMMY-RECORD. RL1114.2 +037400 PERFORM D-WRITE-LINE 5 TIMES. RL1114.2 +037500 D-END-RTN-EXIT. RL1114.2 +037600 MOVE CCVS-E-1 TO DUMMY-RECORD. RL1114.2 +037700 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +037800 D-END-ROUTINE-1. RL1114.2 +037900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1114.2 +038000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1114.2 +038100 ADD PASS-COUNTER TO ERROR-HOLD. RL1114.2 +038200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1114.2 +038300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1114.2 +038400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1114.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. RL1114.2 +038600 D-END-ROUTINE-12. RL1114.2 +038700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1114.2 +038800 IF ERROR-COUNTER IS EQUAL TO ZERO RL1114.2 +038900 MOVE "NO " TO ERROR-TOTAL RL1114.2 +039000 ELSE RL1114.2 +039100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1114.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1114.2 +039300 PERFORM D-WRITE-LINE. RL1114.2 +039400 D-END-ROUTINE-13. RL1114.2 +039500 IF DELETE-COUNTER IS EQUAL TO ZERO RL1114.2 +039600 MOVE "NO " TO ERROR-TOTAL ELSE RL1114.2 +039700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1114.2 +039800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1114.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040000 IF INSPECT-COUNTER EQUAL TO ZERO RL1114.2 +040100 MOVE "NO " TO ERROR-TOTAL RL1114.2 +040200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1114.2 +040300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1114.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040600 D-WRITE-LINE. RL1114.2 +040700 ADD 1 TO RECORD-COUNT. RL1114.2 +040800Y IF RECORD-COUNT GREATER 50 RL1114.2 +040900Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1114.2 +041000Y MOVE SPACE TO DUMMY-RECORD RL1114.2 +041100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1114.2 +041200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN RL1114.2 +041300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES RL1114.2 +041400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN RL1114.2 +041500Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1114.2 +041600Y MOVE ZERO TO RECORD-COUNT. RL1114.2 +041700 PERFORM D-WRT-LN. RL1114.2 +041800 D-WRT-LN. RL1114.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1114.2 +042000 MOVE SPACE TO DUMMY-RECORD. RL1114.2 +042100 D-FAIL-ROUTINE. RL1114.2 +042200 IF COMPUTED-X NOT EQUAL TO SPACE RL1114.2 +042300 GO TO D-FAIL-ROUTINE-WRITE. RL1114.2 +042400 IF CORRECT-X NOT EQUAL TO SPACE RL1114.2 +042500 GO TO D-FAIL-ROUTINE-WRITE. RL1114.2 +042600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +042700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1114.2 +042800 MOVE XXINFO TO DUMMY-RECORD. RL1114.2 +042900 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +043100 GO TO D-FAIL-ROUTINE-EX. RL1114.2 +043200 D-FAIL-ROUTINE-WRITE. RL1114.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE RL1114.2 +043400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1114.2 +043500 MOVE TEST-CORRECT TO PRINT-REC RL1114.2 +043600 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +043700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1114.2 +043800 D-FAIL-ROUTINE-EX. EXIT. RL1114.2 +043900 D-BAIL-OUT. RL1114.2 +044000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. RL1114.2 +044100 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. RL1114.2 +044200 D-BAIL-OUT-WRITE. RL1114.2 +044300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1114.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +044500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +044600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +044700 D-BAIL-OUT-EX. EXIT. RL1114.2 +044800 RL-FS2-02-03. RL1114.2 +044900*ENTRY FROM SEGMENT REL-TEST-009. RL1114.2 +045000* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1114.2 +045100 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +045200 RL-FS2-02-05. RL1114.2 +045300 ADD 1 TO WRK-CS-09V00-017. RL1114.2 +045400 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +045500 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1114.2 +045600 MOVE "10" TO WRK-XN-0002-003. RL1114.2 +045700 RL-FS2-02-EXIT. RL1114.2 +045800 EXIT. RL1114.2 +045900 END DECLARATIVES. RL1114.2 +046000 CCVS1 SECTION. RL1114.2 +046100 OPEN-FILES. RL1114.2 +046200 OPEN OUTPUT PRINT-FILE. RL1114.2 +046300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1114.2 +046400 MOVE SPACE TO TEST-RESULTS. RL1114.2 +046500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1114.2 +046600 MOVE ZERO TO REC-SKL-SUB. RL1114.2 +046700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1114.2 +046800 CCVS-INIT-FILE. RL1114.2 +046900 ADD 1 TO REC-SKL-SUB. RL1114.2 +047000 MOVE FILE-RECORD-INFO-SKELETON RL1114.2 +047100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1114.2 +047200 CCVS-INIT-EXIT. RL1114.2 +047300 GO TO CCVS1-EXIT. RL1114.2 +047400 CLOSE-FILES. RL1114.2 +047500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1114.2 +047600 TERMINATE-CCVS. RL1114.2 +047700S EXIT PROGRAM. RL1114.2 +047800STERMINATE-CALL. RL1114.2 +047900 STOP RUN. RL1114.2 +048000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1114.2 +048100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1114.2 +048200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1114.2 +048300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1114.2 +048400 MOVE "****TEST DELETED****" TO RE-MARK. RL1114.2 +048500 PRINT-DETAIL. RL1114.2 +048600 IF REC-CT NOT EQUAL TO ZERO RL1114.2 +048700 MOVE "." TO PARDOT-X RL1114.2 +048800 MOVE REC-CT TO DOTVALUE. RL1114.2 +048900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1114.2 +049000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1114.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1114.2 +049200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1114.2 +049300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1114.2 +049400 MOVE SPACE TO CORRECT-X. RL1114.2 +049500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1114.2 +049600 MOVE SPACE TO RE-MARK. RL1114.2 +049700 HEAD-ROUTINE. RL1114.2 +049800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +049900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +050000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1114.2 +050100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1114.2 +050200 COLUMN-NAMES-ROUTINE. RL1114.2 +050300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +050400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +050500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +050600 END-ROUTINE. RL1114.2 +050700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1114.2 +050800 END-RTN-EXIT. RL1114.2 +050900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +051000 END-ROUTINE-1. RL1114.2 +051100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1114.2 +051200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1114.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. RL1114.2 +051400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1114.2 +051500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1114.2 +051600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1114.2 +051700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1114.2 +051800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1114.2 +051900 END-ROUTINE-12. RL1114.2 +052000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1114.2 +052100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1114.2 +052200 MOVE "NO " TO ERROR-TOTAL RL1114.2 +052300 ELSE RL1114.2 +052400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1114.2 +052500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1114.2 +052600 PERFORM WRITE-LINE. RL1114.2 +052700 END-ROUTINE-13. RL1114.2 +052800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1114.2 +052900 MOVE "NO " TO ERROR-TOTAL ELSE RL1114.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1114.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1114.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053300 IF INSPECT-COUNTER EQUAL TO ZERO RL1114.2 +053400 MOVE "NO " TO ERROR-TOTAL RL1114.2 +053500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1114.2 +053600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1114.2 +053700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053900 WRITE-LINE. RL1114.2 +054000 ADD 1 TO RECORD-COUNT. RL1114.2 +054100Y IF RECORD-COUNT GREATER 50 RL1114.2 +054200Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1114.2 +054300Y MOVE SPACE TO DUMMY-RECORD RL1114.2 +054400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1114.2 +054500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1114.2 +054600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1114.2 +054700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1114.2 +054800Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1114.2 +054900Y MOVE ZERO TO RECORD-COUNT. RL1114.2 +055000 PERFORM WRT-LN. RL1114.2 +055100 WRT-LN. RL1114.2 +055200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1114.2 +055300 MOVE SPACE TO DUMMY-RECORD. RL1114.2 +055400 BLANK-LINE-PRINT. RL1114.2 +055500 PERFORM WRT-LN. RL1114.2 +055600 FAIL-ROUTINE. RL1114.2 +055700 IF COMPUTED-X NOT EQUAL TO SPACE RL1114.2 +055800 GO TO FAIL-ROUTINE-WRITE. RL1114.2 +055900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1114.2 +056000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +056100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1114.2 +056200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +056300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +056400 GO TO FAIL-ROUTINE-EX. RL1114.2 +056500 FAIL-ROUTINE-WRITE. RL1114.2 +056600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1114.2 +056700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1114.2 +056800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1114.2 +056900 MOVE SPACES TO COR-ANSI-REFERENCE. RL1114.2 +057000 FAIL-ROUTINE-EX. EXIT. RL1114.2 +057100 BAIL-OUT. RL1114.2 +057200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1114.2 +057300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1114.2 +057400 BAIL-OUT-WRITE. RL1114.2 +057500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1114.2 +057600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +057700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +057800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +057900 BAIL-OUT-EX. EXIT. RL1114.2 +058000 CCVS1-EXIT. RL1114.2 +058100 EXIT. RL1114.2 +058200 SECT-RL-04-001 SECTION. RL1114.2 +058300 REL-INIT-009. RL1114.2 +058400 MOVE "REL-TEST-009" TO PAR-NAME. RL1114.2 +058500 MOVE "CREATE RL-FS2" TO FEATURE RL1114.2 +058600 MOVE "RL-FS2" TO XFILE-NAME (2). RL1114.2 +058700 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1114.2 +058800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1114.2 +058900 MOVE 000240 TO XRECORD-LENGTH (2). RL1114.2 +059000 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1114.2 +059100 MOVE 0001 TO XBLOCK-SIZE (2). RL1114.2 +059200 MOVE 000500 TO RECORDS-IN-FILE (2). RL1114.2 +059300 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1114.2 +059400 MOVE "S" TO XLABEL-TYPE (2). RL1114.2 +059500 MOVE 000001 TO XRECORD-NUMBER (2). RL1114.2 +059600*INITIALIZE RECORD WORK AREA NUMBER 2. RL1114.2 +059700 MOVE 1 TO WRK-CS-09V00-012. RL1114.2 +059800 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1114.2 +059900 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1114.2 +060000 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1114.2 +060100 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +060200 MOVE 01 TO REC-CT. RL1114.2 +060300 OPEN OUTPUT RL-FS2. RL1114.2 +060400 MOVE RL-FS2-STATUS TO WRK-XN-0002-001. RL1114.2 +060500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1114.2 +060600 REL-TEST-009-R. RL1114.2 +060700 MOVE "99" TO RL-FS2-STATUS. RL1114.2 +060800 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120. RL1114.2 +060900 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1114.2 +061000 RL-FS2-GRP-120. RL1114.2 +061100 WRITE RL-FS2R1-F-G-240. RL1114.2 +061200 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +061300 GO TO REL-TEST-009-2. RL1114.2 +061400 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +061500 GO TO REL-TEST-009-2. RL1114.2 +061600 ADD 01 TO XRECORD-NUMBER (2). RL1114.2 +061700 GO TO REL-TEST-009-R. RL1114.2 +061800 REL-TEST-009-2. RL1114.2 +061900 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1114.2 +062000 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1114.2 +062100 MOVE ZERO TO CORRECT-18V0 RL1114.2 +062200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1114.2 +062300 PERFORM FAIL RL1114.2 +062400 ELSE RL1114.2 +062500 PERFORM PASS. RL1114.2 +062600 PERFORM PRINT-DETAIL. RL1114.2 +062700 ADD 01 TO REC-CT. RL1114.2 +062800* .01 RL1114.2 +062900 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1114.2 +063000 MOVE "INCORRECT COUNT" TO RE-MARK RL1114.2 +063100 MOVE 500 TO CORRECT-18V0 RL1114.2 +063200 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1114.2 +063300 PERFORM FAIL RL1114.2 +063400 ELSE RL1114.2 +063500 PERFORM PASS. RL1114.2 +063600 PERFORM PRINT-DETAIL. RL1114.2 +063700 ADD 01 TO REC-CT. RL1114.2 +063800* .02 RL1114.2 +063900 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1114.2 +064000 MOVE "STATUS/OPEN" TO RE-MARK RL1114.2 +064100 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1114.2 +064200 MOVE "00" TO CORRECT-A RL1114.2 +064300 PERFORM FAIL RL1114.2 +064400 ELSE RL1114.2 +064500 PERFORM PASS. RL1114.2 +064600 PERFORM PRINT-DETAIL. RL1114.2 +064700 ADD 01 TO REC-CT. RL1114.2 +064800* .03 RL1114.2 +064900 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +065000 MOVE "STATUS/WRITE" TO RE-MARK RL1114.2 +065100 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +065200 MOVE "00" TO CORRECT-A RL1114.2 +065300 PERFORM FAIL RL1114.2 +065400 ELSE RL1114.2 +065500 PERFORM PASS. RL1114.2 +065600 PERFORM PRINT-DETAIL. RL1114.2 +065700 ADD 01 TO REC-CT. RL1114.2 +065800* .04 RL1114.2 +065900 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +066000 CLOSE RL-FS2. RL1114.2 +066100 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +066200 MOVE "CLOSE/STATUS" TO RE-MARK RL1114.2 +066300 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +066400 MOVE "00" TO CORRECT-A RL1114.2 +066500 PERFORM FAIL RL1114.2 +066600 ELSE RL1114.2 +066700 PERFORM PASS. RL1114.2 +066800 PERFORM PRINT-DETAIL. RL1114.2 +066900 ADD 01 TO REC-CT. RL1114.2 +067000* .05 RL1114.2 +067100 REL-INIT-010. RL1114.2 +067200 MOVE "REL-TEST-010" TO PAR-NAME. RL1114.2 +067300 MOVE 2 TO WRK-CS-09V00-012. RL1114.2 +067400 MOVE ZERO TO WRK-CS-09V00-013. RL1114.2 +067500 MOVE ZERO TO WRK-CS-09V00-014. RL1114.2 +067600 MOVE ZERO TO WRK-CS-09V00-015. RL1114.2 +067700 MOVE ZERO TO WRK-CS-09V00-016. RL1114.2 +067800 MOVE ZERO TO WRK-CS-09V00-017. RL1114.2 +067900 MOVE ZERO TO WRK-CS-09V00-018. RL1114.2 +068000 MOVE 01 TO REC-CT. RL1114.2 +068100 OPEN I-O RL-FS2. RL1114.2 +068200 MOVE SPACE TO WRK-XN-0002-002 RL1114.2 +068300 MOVE SPACE TO WRK-XN-0002-003 RL1114.2 +068400 MOVE SPACE TO WRK-XN-0002-004 RL1114.2 +068500 MOVE RL-FS2-STATUS TO WRK-XN-0002-001 RL1114.2 +068600 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +068700*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1114.2 +068800 MOVE "USE/FILE STATUS" TO FEATURE. RL1114.2 +068900 REL-TEST-010-R. RL1114.2 +069000 MOVE "REL-TEST-010-R" TO PAR-NAME. RL1114.2 +069100 MOVE "VIII-26 4.5.2" TO ANSI-REFERENCE. RL1114.2 +069200 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +069300 ADD 1 TO WRK-CS-09V00-015. RL1114.2 +069400 READ RL-FS2. RL1114.2 +069500 IF RL-FS2-STATUS EQUAL TO "10" RL1114.2 +069600 GO TO REL-TEST-010-3. RL1114.2 +069700 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +069800 IF WRK-CS-09V00-015 EQUAL TO 5 RL1114.2 +069900 ADD 01 TO UPDATE-NUMBER (2) RL1114.2 +070000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120 RL1114.2 +070100 REWRITE RL-FS2R1-F-G-240 RL1114.2 +070200 MOVE ZERO TO WRK-CS-09V00-015 RL1114.2 +070300 GO TO REL-TEST-010-2. RL1114.2 +070400 IF WRK-CS-09V00-014 GREATER 500 RL1114.2 +070500 GO TO REL-TEST-010-3. RL1114.2 +070600 GO TO REL-TEST-010-R. RL1114.2 +070700 REL-TEST-010-2. RL1114.2 +070800 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +070900 ADD 1 TO WRK-CS-09V00-016. RL1114.2 +071000 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +071100 GO TO REL-TEST-010-R. RL1114.2 +071200 REL-TEST-010-3. RL1114.2 +071300 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1114.2 +071400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1114.2 +071500 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1114.2 +071600 MOVE 1 TO CORRECT-18V0 RL1114.2 +071700 PERFORM FAIL RL1114.2 +071800 ELSE RL1114.2 +071900 PERFORM PASS. RL1114.2 +072000 PERFORM PRINT-DETAIL. RL1114.2 +072100 ADD 01 TO REC-CT. RL1114.2 +072200* .01 RL1114.2 +072300 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1114.2 +072400 MOVE "INCORRECT COUNT" TO RE-MARK RL1114.2 +072500 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1114.2 +072600 MOVE 501 TO CORRECT-18V0 RL1114.2 +072700 PERFORM FAIL RL1114.2 +072800 ELSE RL1114.2 +072900 PERFORM PASS. RL1114.2 +073000 PERFORM PRINT-DETAIL. RL1114.2 +073100 ADD 01 TO REC-CT. RL1114.2 +073200* .02 RL1114.2 +073300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1114.2 +073400 MOVE "OPEN/STATUS" TO RE-MARK RL1114.2 +073500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1114.2 +073600 MOVE "00" TO CORRECT-A RL1114.2 +073700 PERFORM FAIL RL1114.2 +073800 ELSE RL1114.2 +073900 PERFORM PASS. RL1114.2 +074000 PERFORM PRINT-DETAIL. RL1114.2 +074100 ADD 01 TO REC-CT. RL1114.2 +074200* .03 RL1114.2 +074300 IF RL-FS2-STATUS NOT EQUAL TO "10" RL1114.2 +074400 MOVE "AT END/STATUS" TO RE-MARK RL1114.2 +074500 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +074600 MOVE "10" TO CORRECT-A RL1114.2 +074700 PERFORM FAIL RL1114.2 +074800 ELSE RL1114.2 +074900 PERFORM PASS. RL1114.2 +075000 PERFORM PRINT-DETAIL. RL1114.2 +075100 ADD 01 TO REC-CT. RL1114.2 +075200* .04 RL1114.2 +075300 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1114.2 +075400 MOVE "EXCEPTION/STATUS" TO RE-MARK RL1114.2 +075500 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1114.2 +075600 MOVE "10" TO CORRECT-A RL1114.2 +075700 PERFORM FAIL RL1114.2 +075800 ELSE RL1114.2 +075900 PERFORM PASS. RL1114.2 +076000 PERFORM PRINT-DETAIL. RL1114.2 +076100 ADD 01 TO REC-CT. RL1114.2 +076200* .05 RL1114.2 +076300 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1114.2 +076400 MOVE "NO/EXCEPTION" TO RE-MARK RL1114.2 +076500 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1114.2 +076600 MOVE "10" TO CORRECT-A RL1114.2 +076700 PERFORM FAIL RL1114.2 +076800 ELSE RL1114.2 +076900 PERFORM PASS. RL1114.2 +077000 PERFORM PRINT-DETAIL RL1114.2 +077100 ADD 01 TO REC-CT. RL1114.2 +077200* .06 RL1114.2 +077300 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +077400 CLOSE RL-FS2 RL1114.2 +077500 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +077600 MOVE "CLOSE/STATUS" TO RE-MARK RL1114.2 +077700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +077800 MOVE "00" TO CORRECT-A RL1114.2 +077900 PERFORM FAIL RL1114.2 +078000 ELSE RL1114.2 +078100 PERFORM PASS. RL1114.2 +078200 PERFORM PRINT-DETAIL. RL1114.2 +078300 ADD 01 TO REC-CT. RL1114.2 +078400* .07 RL1114.2 +078500* RL1114.2 +078600* RL1114.2 +078700 SECT-RL111-003-COBOL8X SECTION. RL1114.2 +078800*============================== RL1114.2 +078900* RL1114.2 +079000**************************************************************** RL1114.2 +079100* * RL1114.2 +079200* THIS SECTION CONTAINS THE ADDITIONAL CODING/TESTS FOR * RL1114.2 +079300* THE NEW COBOL '85 FEATURES. * RL1114.2 +079400* * RL1114.2 +079500**************************************************************** RL1114.2 +079600 REL-INIT-020. RL1114.2 +079700 MOVE "VIII-26 4.5.2" TO ANSI-REFERENCE. RL1114.2 +079800 MOVE "NEW COBOL85 TESTS" TO FEATURE. RL1114.2 +079900 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +080000 MOVE 0 TO REC-CT. RL1114.2 +080100 MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +080200 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +080300 OPEN I-O RL-FS2. RL1114.2 +080400 REL-TEST-020-1. RL1114.2 +080500 MOVE "REL-TEST-020-1" TO PAR-NAME. RL1114.2 +080600 IF RL-FS2-STATUS = "00" RL1114.2 +080700 PERFORM PASS RL1114.2 +080800 PERFORM PRINT-DETAIL RL1114.2 +080900 ELSE RL1114.2 +081000 MOVE "INVALID OPEN" TO RE-MARK RL1114.2 +081100 MOVE "00" TO CORRECT-X RL1114.2 +081200 MOVE RL-FS2-STATUS TO COMPUTED-X RL1114.2 +081300 PERFORM FAIL RL1114.2 +081400 PERFORM PRINT-DETAIL. RL1114.2 +081500 REL-TEST-020-2. RL1114.2 +081600 MOVE "REL-TEST-020-2" TO PAR-NAME. RL1114.2 +081700 READ RL-FS2 INTO FILE-RECORD-INFO-P1-120 (2) RL1114.2 +081800 END RL1114.2 +081900 MOVE "END ENCOUNTERED ON FIRST READ" TO RE-MARK RL1114.2 +082000 PERFORM FAIL RL1114.2 +082100 PERFORM PRINT-DETAIL RL1114.2 +082200 NOT AT END RL1114.2 +082300 PERFORM PASS RL1114.2 +082400 PERFORM PRINT-DETAIL RL1114.2 +082500 END-READ RL1114.2 +082600 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +082700 REL-TEST-020-3. RL1114.2 +082800 MOVE "REL-TEST-020-3" TO PAR-NAME. RL1114.2 +082900 IF XRECORD-NUMBER (2) = 1 RL1114.2 +083000 PERFORM PASS RL1114.2 +083100 PERFORM PRINT-DETAIL RL1114.2 +083200 ELSE RL1114.2 +083300 MOVE "FIRST RECORD NOT READ ON FIRST READ" RL1114.2 +083400 TO RE-MARK RL1114.2 +083500 MOVE 1 TO CORRECT-N RL1114.2 +083600 MOVE XRECORD-NUMBER (2) TO COMPUTED-N RL1114.2 +083700 PERFORM FAIL RL1114.2 +083800 PERFORM PRINT-DETAIL. RL1114.2 +083900 REL-TEST-020-4. RL1114.2 +084000 MOVE "REL-TEST-020-4" TO PAR-NAME. RL1114.2 +084100 IF WRK-XN-00001-1 = "X" RL1114.2 +084200 PERFORM PASS RL1114.2 +084300 PERFORM PRINT-DETAIL RL1114.2 +084400 ELSE RL1114.2 +084500 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +084600 MOVE "X" TO CORRECT-X RL1114.2 +084700 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +084800 PERFORM FAIL RL1114.2 +084900 PERFORM PRINT-DETAIL. RL1114.2 +085000* RL1114.2 +085100 REL-INIT-030. RL1114.2 +085200 MOVE "VIII-29 4.5.4" TO ANSI-REFERENCE. RL1114.2 +085300 MOVE 0 TO REC-CT. RL1114.2 +085400 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +085500 MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +085600 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +085700 REL-TEST-030-1. RL1114.2 +085800 MOVE "REL-TEST-030-1" TO PAR-NAME. RL1114.2 +085900 READ RL-FS2 RL1114.2 +086000 END RL1114.2 +086100 MOVE "END ENCOUNTERED ON SECOND READ" TO RE-MARK RL1114.2 +086200 PERFORM FAIL RL1114.2 +086300 PERFORM PRINT-DETAIL RL1114.2 +086400 NOT AT END RL1114.2 +086500 PERFORM PASS RL1114.2 +086600 PERFORM PRINT-DETAIL RL1114.2 +086700 END-READ RL1114.2 +086800 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +086900 REL-TEST-030-2. RL1114.2 +087000 MOVE "REL-TEST-030-2" TO PAR-NAME. RL1114.2 +087100 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +087200 IF XRECORD-NUMBER (2) = 2 RL1114.2 +087300 PERFORM PASS RL1114.2 +087400 PERFORM PRINT-DETAIL RL1114.2 +087500 ELSE RL1114.2 +087600 MOVE "SECOND RECORD NOT READ ON SECOND READ" RL1114.2 +087700 TO RE-MARK RL1114.2 +087800 MOVE 2 TO CORRECT-N RL1114.2 +087900 MOVE XRECORD-NUMBER (2) TO COMPUTED-N RL1114.2 +088000 PERFORM FAIL RL1114.2 +088100 PERFORM PRINT-DETAIL. RL1114.2 +088200 REL-TEST-030-3. RL1114.2 +088300 MOVE "REL-TEST-030-3" TO PAR-NAME. RL1114.2 +088400 IF WRK-XN-00001-1 = "X" RL1114.2 +088500 PERFORM PASS RL1114.2 +088600 PERFORM PRINT-DETAIL RL1114.2 +088700 ELSE RL1114.2 +088800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +088900 MOVE "X" TO CORRECT-X RL1114.2 +089000 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +089100 PERFORM FAIL RL1114.2 +089200 PERFORM PRINT-DETAIL. RL1114.2 +089300* RL1114.2 +089400 REL-INIT-040. RL1114.2 +089500 CLOSE RL-FS2. RL1114.2 +089600 OPEN I-O RL-FS3. RL1114.2 +089700 MOVE "VIII-29 4.5.4" TO ANSI-REFERENCE. RL1114.2 +089800 MOVE 0 TO REC-CT. RL1114.2 +089900 MOVE 2 TO RL-FS3-KEY. RL1114.2 +090000 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +090100 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +090200 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +090300 REL-TEST-040-1. RL1114.2 +090400 MOVE "REL-TEST-040-1" TO PAR-NAME. RL1114.2 +090500 WRITE RL-FS3R1-F-G-240 RL1114.2 +090600 INVALID RL1114.2 +090700 PERFORM PASS RL1114.2 +090800 PERFORM PRINT-DETAIL RL1114.2 +090900 NOT INVALID RL1114.2 +091000 MOVE "DUPLICATE KEY SHOULD NOT HAVE BEEN WRITTEN" RL1114.2 +091100 TO RE-MARK RL1114.2 +091200 PERFORM FAIL RL1114.2 +091300 PERFORM PRINT-DETAIL RL1114.2 +091400 END-WRITE RL1114.2 +091500 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +091600 REL-TEST-040-2. RL1114.2 +091700 MOVE "REL-TEST-040-2" TO PAR-NAME. RL1114.2 +091800 IF WRK-XN-00001-1 = "X" RL1114.2 +091900 PERFORM PASS RL1114.2 +092000 PERFORM PRINT-DETAIL RL1114.2 +092100 ELSE RL1114.2 +092200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +092300 MOVE "X" TO CORRECT-X RL1114.2 +092400 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +092500 PERFORM FAIL RL1114.2 +092600 PERFORM PRINT-DETAIL. RL1114.2 +092700* RL1114.2 +092800 REL-INIT-050. RL1114.2 +092900 MOVE "VIII-38 4.9.4 GR9(A)" TO ANSI-REFERENCE. RL1114.2 +093000 MOVE 0 TO REC-CT. RL1114.2 +093100 MOVE 600 TO RL-FS3-KEY. RL1114.2 +093200 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +093300 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +093400 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +093500 REL-TEST-050-1. RL1114.2 +093600 MOVE "REL-TEST-050-1" TO PAR-NAME. RL1114.2 +093700 WRITE RL-FS3R1-F-G-240 RL1114.2 +093800 INVALID RL1114.2 +093900 MOVE "NEW KEY, RECORD SHOULD HAVE BEEN WRITTEN OK" RL1114.2 +094000 TO RE-MARK RL1114.2 +094100 PERFORM FAIL RL1114.2 +094200 PERFORM PRINT-DETAIL RL1114.2 +094300 NOT INVALID RL1114.2 +094400 PERFORM PASS RL1114.2 +094500 PERFORM PRINT-DETAIL RL1114.2 +094600 END-WRITE RL1114.2 +094700 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +094800 REL-TEST-050-2. RL1114.2 +094900 MOVE "REL-TEST-050-2" TO PAR-NAME. RL1114.2 +095000 IF WRK-XN-00001-1 = "X" RL1114.2 +095100 PERFORM PASS RL1114.2 +095200 PERFORM PRINT-DETAIL RL1114.2 +095300 ELSE RL1114.2 +095400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +095500 MOVE "X" TO CORRECT-X RL1114.2 +095600 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +095700 PERFORM FAIL RL1114.2 +095800 PERFORM PRINT-DETAIL. RL1114.2 +095900* RL1114.2 +096000 REL-INIT-060. RL1114.2 +096100 MOVE "VIII-38 4.5.4 GR9(B)" TO ANSI-REFERENCE. RL1114.2 +096200 CLOSE RL-FS3. RL1114.2 +096300 OPEN INPUT RL-FS3. RL1114.2 +096400 MOVE 0 TO REC-CT. RL1114.2 +096500 MOVE 99999998 TO RL-FS3-KEY. RL1114.2 +096600 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +096700 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +096800 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +096900 REL-TEST-060-1. RL1114.2 +097000 MOVE "REL-TEST-060-1" TO PAR-NAME. RL1114.2 +097100 WRITE RL-FS3R1-F-G-240. RL1114.2 +097200 IF RL-FS3-STATUS NOT = "48" RL1114.2 +097300 MOVE "WRITE TO FILE OPENED INPUT NOT ALLOWED" RL1114.2 +097400 TO RE-MARK RL1114.2 +097500 ELSE RL1114.2 +097600 MOVE "SHOULD HAVE ACTIONED DECLARATIVES" TO RE-MARK. RL1114.2 +097700 PERFORM FAIL RL1114.2 +097800 PERFORM PRINT-DETAIL. RL1114.2 +097900* ENTRY TO THE DECLARATIVES CLOSES ALL FILES AND RL1114.2 +098000* TERMINATES THE PROGRAM. RL1114.2 +098100* EXECUTION SHOULD REACH THIS POINT ONLY AS RESULT OF AN ERROR RL1114.2 +098200 CLOSE RL-FS3. RL1114.2 +098300* RL1114.2 +098400 REL-INIT-070. RL1114.2 +098500* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +098600* OPEN I-O RL-FS3. RL1114.2 +098700* MOVE 0 TO REC-CT. RL1114.2 +098800* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +098900* MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +099000* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +099100*REL-TEST-070-1. RL1114.2 +099200* MOVE "REL-TEST-070-1" TO PAR-NAME. RL1114.2 +099300* READ RL-FS3 RL1114.2 +099400* INVALID RL1114.2 +099500* MOVE "INVALID KEY ON FIRST READ" TO RE-MARK RL1114.2 +099600* PERFORM FAIL RL1114.2 +099700* PERFORM PRINT-DETAIL RL1114.2 +099800* NOT INVALID KEY RL1114.2 +099900* PERFORM PASS RL1114.2 +100000* PERFORM PRINT-DETAIL RL1114.2 +100100* END-READ RL1114.2 +100200* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +100300*REL-TEST-070-2. RL1114.2 +100400* MOVE "REL-TEST-070-2" TO PAR-NAME. RL1114.2 +100500* IF WRK-XN-00001-1 = "X" RL1114.2 +100600* PERFORM PASS RL1114.2 +100700* PERFORM PRINT-DETAIL RL1114.2 +100800* ELSE RL1114.2 +100900* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +101000* MOVE "X" TO CORRECT-X RL1114.2 +101100* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +101200* PERFORM FAIL RL1114.2 +101300* PERFORM PRINT-DETAIL. RL1114.2 +101400*REL-TEST-070-3. RL1114.2 +101500* MOVE "REL-TEST-070-3" TO PAR-NAME. RL1114.2 +101600* RL1114.2 +101700* IF WRK-XN-00001-2 = "@" RL1114.2 +101800* PERFORM PASS RL1114.2 +101900* PERFORM PRINT-DETAIL RL1114.2 +102000* ELSE RL1114.2 +102100* MOVE "'USE AFTER' PROCEDURE NOT ACTIONED" RL1114.2 +102200* TO RE-MARK RL1114.2 +102300* MOVE "@" TO CORRECT-X RL1114.2 +102400* MOVE WRK-XN-00001-2 TO COMPUTED-X RL1114.2 +102500* PERFORM FAIL RL1114.2 +102600* PERFORM PRINT-DETAIL. RL1114.2 +102700* RL1114.2 +102800* RL1114.2 +102900*REL-INIT-080. RL1114.2 +103000* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +103100* CLOSE RL-FS3. RL1114.2 +103200* OPEN I-O RL-FS3. RL1114.2 +103300* MOVE 0 TO REC-CT. RL1114.2 +103400* MOVE 900000002 TO RL-FS3-KEY. RL1114.2 +103500* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +103600* MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +103700* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +103800*REL-TEST-080-1. RL1114.2 +103900* MOVE "REL-TEST-080-1" TO PAR-NAME. RL1114.2 +104000* READ RL-FS3 RL1114.2 +104100* INVALID RL1114.2 +104200* MOVE "INVALID KEY ON FIRST READ" TO RE-MARK RL1114.2 +104300* PERFORM FAIL RL1114.2 +104400* PERFORM PRINT-DETAIL RL1114.2 +104500* NOT INVALID KEY RL1114.2 +104600* PERFORM PASS RL1114.2 +104700* PERFORM PRINT-DETAIL RL1114.2 +104800* END-READ RL1114.2 +104900* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +105000*REL-TEST-080-2. RL1114.2 +105100* MOVE "REL-TEST-080-2" TO PAR-NAME. RL1114.2 +105200* IF WRK-XN-00001-1 = "X" RL1114.2 +105300* PERFORM PASS RL1114.2 +105400* PERFORM PRINT-DETAIL RL1114.2 +105500* ELSE RL1114.2 +105600* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +105700* MOVE "X" TO CORRECT-X RL1114.2 +105800* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +105900* PERFORM FAIL RL1114.2 +106000* PERFORM PRINT-DETAIL. RL1114.2 +106100* RL1114.2 +106200* RL1114.2 +106300*REL-INIT-090. RL1114.2 +106400* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +106500* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +106600* MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +106700* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +106800*REL-TEST-090-1. RL1114.2 +106900* MOVE "REL-TEST-090-1" TO PAR-NAME. RL1114.2 +107000* REWRITE RL-FS2R1-F-G-240 RL1114.2 +107100* INVALID KEY RL1114.2 +107200* MOVE "INVALID KEY ON REWRITE" TO RE-MARK RL1114.2 +107300* PERFORM FAIL RL1114.2 +107400* PERFORM PRINT-DETAIL RL1114.2 +107500* NOT INVALID KEY RL1114.2 +107600* PERFORM PASS RL1114.2 +107700* PERFORM PRINT-DETAIL RL1114.2 +107800* END-REWRITE RL1114.2 +107900* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +108000*REL-TEST-090-2. RL1114.2 +108100* MOVE "REL-TEST-090-2" TO PAR-NAME. RL1114.2 +108200* IF WRK-XN-00001-1 = "X" RL1114.2 +108300* PERFORM PASS RL1114.2 +108400* PERFORM PRINT-DETAIL RL1114.2 +108500* ELSE RL1114.2 +108600* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +108700* MOVE "X" TO CORRECT-X RL1114.2 +108800* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +108900* PERFORM FAIL RL1114.2 +109000* PERFORM PRINT-DETAIL. RL1114.2 +109100* RL1114.2 +109200 CCVS-EXIT SECTION. RL1114.2 +109300 CCVS-999999. RL1114.2 +109400 GO TO CLOSE-FILES. RL1114.2 +*END-OF,RL111A +*HEADER,COBOL,RL112A +000100 IDENTIFICATION DIVISION. RL1124.2 +000200 PROGRAM-ID. RL1124.2 +000300 RL112A. RL1124.2 +000400**************************************************************** RL1124.2 +000500* * RL1124.2 +000600* VALIDATION FOR:- * RL1124.2 +000700* * RL1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +000900* * RL1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1124.2 +001100* * RL1124.2 +001200**************************************************************** RL1124.2 +001300* * RL1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1124.2 +001500* * RL1124.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1124.2 +001700* RELATIVE I-O DATA FILE * RL1124.2 +001800* X-55 SYSTEM PRINTER * RL1124.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1124.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1124.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1124.2 +002200* X-82 SOURCE-COMPUTER * RL1124.2 +002300* X-83 OBJECT-COMPUTER. * RL1124.2 +002400* * RL1124.2 +002500**************************************************************** RL1124.2 +002600* RL112A * RL1124.2 +002700**************************************************************** RL1124.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1124.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1124.2 +003000* STATEMENT. RL1124.2 +003100* RL1124.2 +003200* RL1124.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1124.2 +003400* (ACCESS MODE RANDOM) AND THEN UPDATES SELECTIVE RL1124.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1124.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1124.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1124.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1124.2 +003900* AT END OR INVALID KEY PHRASES. THE OMISSION OF THESERL1124.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1124.2 +004100* HAS BEEN SPECIFIED. RL1124.2 +004200* RL1124.2 +004300*************************************************** RL1124.2 +004400 ENVIRONMENT DIVISION. RL1124.2 +004500 CONFIGURATION SECTION. RL1124.2 +004600 SOURCE-COMPUTER. RL1124.2 +004700 XXXXX082. RL1124.2 +004800 OBJECT-COMPUTER. RL1124.2 +004900 XXXXX083. RL1124.2 +005000 INPUT-OUTPUT SECTION. RL1124.2 +005100 FILE-CONTROL. RL1124.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1124.2 +005300 XXXXX055. RL1124.2 +005400 SELECT RL-FD2 ASSIGN RL1124.2 +005500 XXXXX022 RL1124.2 +005600 ORGANIZATION RELATIVE RL1124.2 +005700 ACCESS RANDOM RL1124.2 +005800 RELATIVE RL-FD2-KEY RL1124.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1124.2 +006000 DATA DIVISION. RL1124.2 +006100 FILE SECTION. RL1124.2 +006200 FD PRINT-FILE. RL1124.2 +006300 01 PRINT-REC PICTURE X(120). RL1124.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1124.2 +006500 FD RL-FD2 RL1124.2 +006600C VALUE OF RL1124.2 +006700C XXXXX074 RL1124.2 +006800C IS RL1124.2 +006900C XXXXX076 RL1124.2 +007000G XXXXX069 RL1124.2 +007100 LABEL RECORDS ARE STANDARD RL1124.2 +007200 BLOCK CONTAINS 1 RECORDS RL1124.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1124.2 +007400 01 RL-FD2R1-F-G-240. RL1124.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1124.2 +007600 05 RL-FD2-GRP-120. RL1124.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1124.2 +007800 PICTURE X OCCURS 120 TIMES. RL1124.2 +007900 WORKING-STORAGE SECTION. RL1124.2 +008000 01 GRP-0001. RL1124.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1124.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1124.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1124.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1124.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1124.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1124.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1124.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1124.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1124.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1124.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1124.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1124.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1124.2 +010100 05 FILLER PICTURE X(48) VALUE RL1124.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1124.2 +010300 05 FILLER PICTURE X(46) VALUE RL1124.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1124.2 +010500 05 FILLER PICTURE X(26) VALUE RL1124.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1124.2 +010700 05 FILLER PICTURE X(37) VALUE RL1124.2 +010800 ",RECKEY= ". RL1124.2 +010900 05 FILLER PICTURE X(38) VALUE RL1124.2 +011000 ",ALTKEY1= ". RL1124.2 +011100 05 FILLER PICTURE X(38) VALUE RL1124.2 +011200 ",ALTKEY2= ". RL1124.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1124.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1124.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1124.2 +011600 07 FILLER PIC X(5). RL1124.2 +011700 07 XFILE-NAME PIC X(6). RL1124.2 +011800 07 FILLER PIC X(8). RL1124.2 +011900 07 XRECORD-NAME PIC X(6). RL1124.2 +012000 07 FILLER PIC X(1). RL1124.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1124.2 +012200 07 FILLER PIC X(7). RL1124.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1124.2 +012400 07 FILLER PIC X(6). RL1124.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1124.2 +012600 07 FILLER PIC X(5). RL1124.2 +012700 07 ODO-NUMBER PIC 9(4). RL1124.2 +012800 07 FILLER PIC X(5). RL1124.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1124.2 +013000 07 FILLER PIC X(7). RL1124.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1124.2 +013200 07 FILLER PIC X(7). RL1124.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1124.2 +013400 07 FILLER PIC X(1). RL1124.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1124.2 +013600 07 FILLER PIC X(6). RL1124.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1124.2 +013800 07 FILLER PIC X(5). RL1124.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1124.2 +014000 07 FILLER PIC X(6). RL1124.2 +014100 07 XLABEL-TYPE PIC X(1). RL1124.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1124.2 +014300 07 FILLER PIC X(8). RL1124.2 +014400 07 XRECORD-KEY PIC X(29). RL1124.2 +014500 07 FILLER PIC X(9). RL1124.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1124.2 +014700 07 FILLER PIC X(9). RL1124.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1124.2 +014900 07 FILLER PIC X(7). RL1124.2 +015000 01 TEST-RESULTS. RL1124.2 +015100 02 FILLER PIC X VALUE SPACE. RL1124.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1124.2 +015300 02 FILLER PIC X VALUE SPACE. RL1124.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1124.2 +015500 02 FILLER PIC X VALUE SPACE. RL1124.2 +015600 02 PAR-NAME. RL1124.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1124.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1124.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1124.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1124.2 +016100 02 RE-MARK PIC X(61). RL1124.2 +016200 01 TEST-COMPUTED. RL1124.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1124.2 +016400 02 FILLER PIC X(17) VALUE RL1124.2 +016500 " COMPUTED=". RL1124.2 +016600 02 COMPUTED-X. RL1124.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1124.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1124.2 +016900 PIC -9(9).9(9). RL1124.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1124.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1124.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1124.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1124.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1124.2 +017500 04 FILLER PIC X. RL1124.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1124.2 +017700 01 TEST-CORRECT. RL1124.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1124.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1124.2 +018000 02 CORRECT-X. RL1124.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1124.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1124.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1124.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1124.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1124.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1124.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1124.2 +018800 04 FILLER PIC X. RL1124.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1124.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1124.2 +019100 01 CCVS-C-1. RL1124.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1124.2 +019300- "SS PARAGRAPH-NAME RL1124.2 +019400- " REMARKS". RL1124.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1124.2 +019600 01 CCVS-C-2. RL1124.2 +019700 02 FILLER PIC X VALUE SPACE. RL1124.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1124.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1124.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1124.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1124.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1124.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1124.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1124.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1124.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1124.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1124.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1124.2 +021300 01 CCVS-H-1. RL1124.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1124.2 +021500 02 FILLER PIC X(42) VALUE RL1124.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1124.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1124.2 +021800 01 CCVS-H-2A. RL1124.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1124.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1124.2 +022100 02 FILLER PIC XXXX VALUE RL1124.2 +022200 "4.2 ". RL1124.2 +022300 02 FILLER PIC X(28) VALUE RL1124.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1124.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1124.2 +022600 RL1124.2 +022700 01 CCVS-H-2B. RL1124.2 +022800 02 FILLER PIC X(15) VALUE RL1124.2 +022900 "TEST RESULT OF ". RL1124.2 +023000 02 TEST-ID PIC X(9). RL1124.2 +023100 02 FILLER PIC X(4) VALUE RL1124.2 +023200 " IN ". RL1124.2 +023300 02 FILLER PIC X(12) VALUE RL1124.2 +023400 " HIGH ". RL1124.2 +023500 02 FILLER PIC X(22) VALUE RL1124.2 +023600 " LEVEL VALIDATION FOR ". RL1124.2 +023700 02 FILLER PIC X(58) VALUE RL1124.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +023900 01 CCVS-H-3. RL1124.2 +024000 02 FILLER PIC X(34) VALUE RL1124.2 +024100 " FOR OFFICIAL USE ONLY ". RL1124.2 +024200 02 FILLER PIC X(58) VALUE RL1124.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1124.2 +024400 02 FILLER PIC X(28) VALUE RL1124.2 +024500 " COPYRIGHT 1985 ". RL1124.2 +024600 01 CCVS-E-1. RL1124.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1124.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1124.2 +024900 02 ID-AGAIN PIC X(9). RL1124.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1124.2 +025100 01 CCVS-E-2. RL1124.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1124.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1124.2 +025400 02 CCVS-E-2-2. RL1124.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1124.2 +025600 03 FILLER PIC X VALUE SPACE. RL1124.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1124.2 +025800 "ERRORS ENCOUNTERED". RL1124.2 +025900 01 CCVS-E-3. RL1124.2 +026000 02 FILLER PIC X(22) VALUE RL1124.2 +026100 " FOR OFFICIAL USE ONLY". RL1124.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1124.2 +026300 02 FILLER PIC X(58) VALUE RL1124.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1124.2 +026600 02 FILLER PIC X(15) VALUE RL1124.2 +026700 " COPYRIGHT 1985". RL1124.2 +026800 01 CCVS-E-4. RL1124.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1124.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1124.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1124.2 +027200 02 FILLER PIC X(40) VALUE RL1124.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1124.2 +027400 01 XXINFO. RL1124.2 +027500 02 FILLER PIC X(19) VALUE RL1124.2 +027600 "*** INFORMATION ***". RL1124.2 +027700 02 INFO-TEXT. RL1124.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1124.2 +027900 04 XXCOMPUTED PIC X(20). RL1124.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1124.2 +028100 04 XXCORRECT PIC X(20). RL1124.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1124.2 +028300 01 HYPHEN-LINE. RL1124.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1124.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1124.2 +028600- "*****************************************". RL1124.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1124.2 +028800- "******************************". RL1124.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1124.2 +029000 "RL112A". RL1124.2 +029100 PROCEDURE DIVISION. RL1124.2 +029200 DECLARATIVES. RL1124.2 +029300 RL-FD2-01 SECTION. RL1124.2 +029400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL1124.2 +029500 RL-FD2-01-01. RL1124.2 +029600 ADD 1 TO WRK-CS-09V00-013. RL1124.2 +029700 GO TO RL-FD2-01-03 RL1124.2 +029800 RL-FD2-01-05 RL1124.2 +029900 DEPENDING ON WRK-CS-09V00-012. RL1124.2 +030000 GO TO RL-FD2-01-EXIT. RL1124.2 +030100 RL-FD2-01-03. RL1124.2 +030200*ENTRY FROM SEGMENT REL-TEST-009. RL1124.2 +030300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1124.2 +030400 ADD 1 TO WRK-CS-09V00-014. RL1124.2 +030500 RL-FD2-01-05. RL1124.2 +030600 ADD 1 TO WRK-CS-09V00-017. RL1124.2 +030700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1124.2 +030800 MOVE RL-FD2-STATUS TO WRK-XN-0002-002 RL1124.2 +030900 MOVE "23" TO WRK-XN-0002-003. RL1124.2 +031000 RL-FD2-01-EXIT. RL1124.2 +031100 EXIT. RL1124.2 +031200 END DECLARATIVES. RL1124.2 +031300 CCVS1 SECTION. RL1124.2 +031400 OPEN-FILES. RL1124.2 +031500 OPEN OUTPUT PRINT-FILE. RL1124.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1124.2 +031700 MOVE SPACE TO TEST-RESULTS. RL1124.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1124.2 +031900 MOVE ZERO TO REC-SKL-SUB. RL1124.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. RL1124.2 +032100 CCVS-INIT-FILE. RL1124.2 +032200 ADD 1 TO REC-SKL-SUB. RL1124.2 +032300 MOVE FILE-RECORD-INFO-SKELETON RL1124.2 +032400 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1124.2 +032500 CCVS-INIT-EXIT. RL1124.2 +032600 GO TO CCVS1-EXIT. RL1124.2 +032700 CLOSE-FILES. RL1124.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1124.2 +032900 TERMINATE-CCVS. RL1124.2 +033000S EXIT PROGRAM. RL1124.2 +033100STERMINATE-CALL. RL1124.2 +033200 STOP RUN. RL1124.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1124.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1124.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1124.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1124.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. RL1124.2 +033800 PRINT-DETAIL. RL1124.2 +033900 IF REC-CT NOT EQUAL TO ZERO RL1124.2 +034000 MOVE "." TO PARDOT-X RL1124.2 +034100 MOVE REC-CT TO DOTVALUE. RL1124.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1124.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1124.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1124.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1124.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1124.2 +034700 MOVE SPACE TO CORRECT-X. RL1124.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1124.2 +034900 MOVE SPACE TO RE-MARK. RL1124.2 +035000 HEAD-ROUTINE. RL1124.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1124.2 +035400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1124.2 +035500 COLUMN-NAMES-ROUTINE. RL1124.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +035900 END-ROUTINE. RL1124.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1124.2 +036100 END-RTN-EXIT. RL1124.2 +036200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +036300 END-ROUTINE-1. RL1124.2 +036400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1124.2 +036500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1124.2 +036600 ADD PASS-COUNTER TO ERROR-HOLD. RL1124.2 +036700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1124.2 +036800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1124.2 +036900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1124.2 +037000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1124.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1124.2 +037200 END-ROUTINE-12. RL1124.2 +037300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1124.2 +037400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1124.2 +037500 MOVE "NO " TO ERROR-TOTAL RL1124.2 +037600 ELSE RL1124.2 +037700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1124.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1124.2 +037900 PERFORM WRITE-LINE. RL1124.2 +038000 END-ROUTINE-13. RL1124.2 +038100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1124.2 +038200 MOVE "NO " TO ERROR-TOTAL ELSE RL1124.2 +038300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1124.2 +038400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1124.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +038600 IF INSPECT-COUNTER EQUAL TO ZERO RL1124.2 +038700 MOVE "NO " TO ERROR-TOTAL RL1124.2 +038800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1124.2 +038900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1124.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +039100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +039200 WRITE-LINE. RL1124.2 +039300 ADD 1 TO RECORD-COUNT. RL1124.2 +039400Y IF RECORD-COUNT GREATER 50 RL1124.2 +039500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1124.2 +039600Y MOVE SPACE TO DUMMY-RECORD RL1124.2 +039700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1124.2 +039800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1124.2 +039900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1124.2 +040000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1124.2 +040100Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1124.2 +040200Y MOVE ZERO TO RECORD-COUNT. RL1124.2 +040300 PERFORM WRT-LN. RL1124.2 +040400 WRT-LN. RL1124.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1124.2 +040600 MOVE SPACE TO DUMMY-RECORD. RL1124.2 +040700 BLANK-LINE-PRINT. RL1124.2 +040800 PERFORM WRT-LN. RL1124.2 +040900 FAIL-ROUTINE. RL1124.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE RL1124.2 +041100 GO TO FAIL-ROUTINE-WRITE. RL1124.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1124.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1124.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1124.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1124.2 +041700 GO TO FAIL-ROUTINE-EX. RL1124.2 +041800 FAIL-ROUTINE-WRITE. RL1124.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1124.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1124.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1124.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1124.2 +042300 FAIL-ROUTINE-EX. EXIT. RL1124.2 +042400 BAIL-OUT. RL1124.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1124.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1124.2 +042700 BAIL-OUT-WRITE. RL1124.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1124.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1124.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1124.2 +043200 BAIL-OUT-EX. EXIT. RL1124.2 +043300 CCVS1-EXIT. RL1124.2 +043400 EXIT. RL1124.2 +043500 SECT-RL112A-001 SECTION. RL1124.2 +043600 REL-INIT-009. RL1124.2 +043700 MOVE "REL-TEST-009" TO PAR-NAME. RL1124.2 +043800 MOVE "CREATE RL-FD2" TO FEATURE RL1124.2 +043900 MOVE "RL-FD2" TO XFILE-NAME (2). RL1124.2 +044000 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1124.2 +044100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1124.2 +044200 MOVE 000240 TO XRECORD-LENGTH (2). RL1124.2 +044300 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1124.2 +044400 MOVE 0001 TO XBLOCK-SIZE (2). RL1124.2 +044500 MOVE 000500 TO RECORDS-IN-FILE (2). RL1124.2 +044600 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1124.2 +044700 MOVE "S" TO XLABEL-TYPE (2). RL1124.2 +044800 MOVE 000001 TO XRECORD-NUMBER (2). RL1124.2 +044900*INITIALIZE RECORD WORK AREA NUMBER 2. RL1124.2 +045000 MOVE 1 TO WRK-CS-09V00-012. RL1124.2 +045100 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1124.2 +045200 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1124.2 +045300 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1124.2 +045400 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +045500 MOVE 90000002 TO RL-FD2-KEY. RL1124.2 +045600 MOVE 01 TO REC-CT. RL1124.2 +045700 OPEN OUTPUT RL-FD2. RL1124.2 +045800 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1124.2 +045900*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1124.2 +046000 REL-TEST-009-R. RL1124.2 +046100 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1124.2 +046200 MOVE "99" TO RL-FD2-STATUS. RL1124.2 +046300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1124.2 +046400 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1124.2 +046500 RL-FD2-GRP-120. RL1124.2 +046600 WRITE RL-FD2R1-F-G-240. RL1124.2 +046700 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +046800 GO TO REL-TEST-009-2. RL1124.2 +046900 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1124.2 +047000 GO TO REL-TEST-009-2. RL1124.2 +047100 ADD 01 TO XRECORD-NUMBER (2). RL1124.2 +047200 GO TO REL-TEST-009-R. RL1124.2 +047300 REL-TEST-009-2. RL1124.2 +047400 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1124.2 +047500 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1124.2 +047600 MOVE ZERO TO CORRECT-18V0 RL1124.2 +047700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1124.2 +047800 PERFORM FAIL RL1124.2 +047900 ELSE RL1124.2 +048000 PERFORM PASS. RL1124.2 +048100 PERFORM PRINT-DETAIL. RL1124.2 +048200 ADD 01 TO REC-CT. RL1124.2 +048300* .01 RL1124.2 +048400 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1124.2 +048500 MOVE "INCORRECT COUNT" TO RE-MARK RL1124.2 +048600 MOVE 500 TO CORRECT-18V0 RL1124.2 +048700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1124.2 +048800 PERFORM FAIL RL1124.2 +048900 ELSE RL1124.2 +049000 PERFORM PASS. RL1124.2 +049100 PERFORM PRINT-DETAIL. RL1124.2 +049200 ADD 01 TO REC-CT. RL1124.2 +049300* .02 RL1124.2 +049400 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1124.2 +049500 MOVE "STATUS/OPEN" TO RE-MARK RL1124.2 +049600 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1124.2 +049700 MOVE "00" TO CORRECT-A RL1124.2 +049800 PERFORM FAIL RL1124.2 +049900 ELSE RL1124.2 +050000 PERFORM PASS. RL1124.2 +050100 PERFORM PRINT-DETAIL. RL1124.2 +050200 ADD 01 TO REC-CT. RL1124.2 +050300* .03 RL1124.2 +050400 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +050500 MOVE "STATUS/WRITE" TO RE-MARK RL1124.2 +050600 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +050700 MOVE "00" TO CORRECT-A RL1124.2 +050800 PERFORM FAIL RL1124.2 +050900 ELSE RL1124.2 +051000 PERFORM PASS. RL1124.2 +051100 PERFORM PRINT-DETAIL. RL1124.2 +051200 ADD 01 TO REC-CT. RL1124.2 +051300* .04 RL1124.2 +051400 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +051500 CLOSE RL-FD2. RL1124.2 +051600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +051700 MOVE "CLOSE/STATUS" TO RE-MARK RL1124.2 +051800 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +051900 MOVE "00" TO CORRECT-A RL1124.2 +052000 PERFORM FAIL RL1124.2 +052100 ELSE RL1124.2 +052200 PERFORM PASS. RL1124.2 +052300 PERFORM PRINT-DETAIL. RL1124.2 +052400 ADD 01 TO REC-CT. RL1124.2 +052500* .05 RL1124.2 +052600 REL-INIT-010. RL1124.2 +052700 MOVE "REL-TEST-010" TO PAR-NAME. RL1124.2 +052800 MOVE 2 TO WRK-CS-09V00-012. RL1124.2 +052900 MOVE ZERO TO RL-FD2-KEY. RL1124.2 +053000 MOVE ZERO TO WRK-CS-09V00-013. RL1124.2 +053100 MOVE ZERO TO WRK-CS-09V00-014. RL1124.2 +053200 MOVE ZERO TO WRK-CS-09V00-015. RL1124.2 +053300 MOVE ZERO TO WRK-CS-09V00-016. RL1124.2 +053400 MOVE ZERO TO WRK-CS-09V00-017. RL1124.2 +053500 MOVE ZERO TO WRK-CS-09V00-018. RL1124.2 +053600 MOVE 01 TO REC-CT. RL1124.2 +053700 OPEN I-O RL-FD2. RL1124.2 +053800 MOVE SPACE TO WRK-XN-0002-002 RL1124.2 +053900 MOVE SPACE TO WRK-XN-0002-003 RL1124.2 +054000 MOVE SPACE TO WRK-XN-0002-004 RL1124.2 +054100 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1124.2 +054200 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +054300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1124.2 +054400 MOVE "USE/FILE STATUS" TO FEATURE. RL1124.2 +054500 REL-TEST-010-R. RL1124.2 +054600 ADD 1 TO WRK-CS-09V00-014. RL1124.2 +054700 ADD 1 TO WRK-CS-09V00-015. RL1124.2 +054800 ADD 1 TO RL-FD2-KEY. RL1124.2 +054900 READ RL-FD2 RECORD. RL1124.2 +055000 IF RL-FD2-STATUS EQUAL TO "23" RL1124.2 +055100 GO TO REL-TEST-010-3. RL1124.2 +055200 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1124.2 +055300 IF WRK-CS-09V00-015 EQUAL TO 5 RL1124.2 +055400 ADD 01 TO UPDATE-NUMBER (2) RL1124.2 +055500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1124.2 +055600 REWRITE RL-FD2R1-F-G-240 RL1124.2 +055700 MOVE ZERO TO WRK-CS-09V00-015 RL1124.2 +055800 GO TO REL-TEST-010-2. RL1124.2 +055900 IF WRK-CS-09V00-014 GREATER 500 RL1124.2 +056000 GO TO REL-TEST-010-3. RL1124.2 +056100 GO TO REL-TEST-010-R. RL1124.2 +056200 REL-TEST-010-2. RL1124.2 +056300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +056400 ADD 1 TO WRK-CS-09V00-016. RL1124.2 +056500 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +056600 GO TO REL-TEST-010-R. RL1124.2 +056700 REL-TEST-010-3. RL1124.2 +056800 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1124.2 +056900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1124.2 +057000 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1124.2 +057100 MOVE 1 TO CORRECT-18V0 RL1124.2 +057200 PERFORM FAIL RL1124.2 +057300 ELSE RL1124.2 +057400 PERFORM PASS. RL1124.2 +057500 PERFORM PRINT-DETAIL. RL1124.2 +057600 ADD 01 TO REC-CT. RL1124.2 +057700* .01 RL1124.2 +057800 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1124.2 +057900 MOVE "INCORRECT COUNT" TO RE-MARK RL1124.2 +058000 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1124.2 +058100 MOVE 501 TO CORRECT-18V0 RL1124.2 +058200 PERFORM FAIL RL1124.2 +058300 ELSE RL1124.2 +058400 PERFORM PASS. RL1124.2 +058500 PERFORM PRINT-DETAIL. RL1124.2 +058600 ADD 01 TO REC-CT. RL1124.2 +058700* .02 RL1124.2 +058800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1124.2 +058900 MOVE "OPEN/STATUS" TO RE-MARK RL1124.2 +059000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1124.2 +059100 MOVE "00" TO CORRECT-A RL1124.2 +059200 PERFORM FAIL RL1124.2 +059300 ELSE RL1124.2 +059400 PERFORM PASS. RL1124.2 +059500 PERFORM PRINT-DETAIL. RL1124.2 +059600 ADD 01 TO REC-CT. RL1124.2 +059700* .03 RL1124.2 +059800 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1124.2 +059900 MOVE "ATEND/STATUS" TO RE-MARK RL1124.2 +060000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +060100 MOVE "23" TO CORRECT-A RL1124.2 +060200 PERFORM FAIL RL1124.2 +060300 ELSE RL1124.2 +060400 PERFORM PASS. RL1124.2 +060500 PERFORM PRINT-DETAIL. RL1124.2 +060600 ADD 01 TO REC-CT. RL1124.2 +060700* .04 RL1124.2 +060800 IF WRK-XN-0002-002 NOT EQUAL TO "23" RL1124.2 +060900 MOVE "EXCEPTION/STATUS" TO RE-MARK RL1124.2 +061000 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1124.2 +061100 MOVE "23" TO CORRECT-A RL1124.2 +061200 PERFORM FAIL RL1124.2 +061300 ELSE RL1124.2 +061400 PERFORM PASS. RL1124.2 +061500 PERFORM PRINT-DETAIL. RL1124.2 +061600 ADD 01 TO REC-CT. RL1124.2 +061700* .05 RL1124.2 +061800 IF WRK-XN-0002-003 NOT EQUAL TO "23" RL1124.2 +061900 MOVE "NO/EXCEPTION" TO RE-MARK RL1124.2 +062000 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1124.2 +062100 MOVE "23" TO CORRECT-A RL1124.2 +062200 PERFORM FAIL RL1124.2 +062300 ELSE RL1124.2 +062400 PERFORM PASS. RL1124.2 +062500 PERFORM PRINT-DETAIL RL1124.2 +062600 ADD 01 TO REC-CT. RL1124.2 +062700* .06 RL1124.2 +062800 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +062900 CLOSE RL-FD2 RL1124.2 +063000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +063100 MOVE "CLOSE/STATUS" TO RE-MARK RL1124.2 +063200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +063300 MOVE "00" TO CORRECT-A RL1124.2 +063400 PERFORM FAIL RL1124.2 +063500 ELSE RL1124.2 +063600 PERFORM PASS. RL1124.2 +063700 PERFORM PRINT-DETAIL. RL1124.2 +063800 ADD 01 TO REC-CT. RL1124.2 +063900* .07 RL1124.2 +064000 CCVS-EXIT SECTION. RL1124.2 +064100 CCVS-999999. RL1124.2 +064200 GO TO CLOSE-FILES. RL1124.2 +*END-OF,RL112A +*HEADER,COBOL,RL113A +000100 IDENTIFICATION DIVISION. RL1134.2 +000200 PROGRAM-ID. RL1134.2 +000300 RL113A. RL1134.2 +000400**************************************************************** RL1134.2 +000500* * RL1134.2 +000600* VALIDATION FOR:- * RL1134.2 +000700* * RL1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +000900* * RL1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1134.2 +001100* * RL1134.2 +001200**************************************************************** RL1134.2 +001300* * RL1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1134.2 +001500* * RL1134.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1134.2 +001700* RELATIVE I-O DATA FILE * RL1134.2 +001800* X-55 SYSTEM PRINTER * RL1134.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1134.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1134.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1134.2 +002200* X-82 SOURCE-COMPUTER * RL1134.2 +002300* X-83 OBJECT-COMPUTER. * RL1134.2 +002400* * RL1134.2 +002500**************************************************************** RL1134.2 +002600* RL113A * RL1134.2 +002700**************************************************************** RL1134.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1134.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1134.2 +003000* STATEMENT. RL1134.2 +003100* RL1134.2 +003200* RL1134.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1134.2 +003400* (ACCESS MODE RANDOM) AND THEN UPDATES SELECTIVE RL1134.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1134.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1134.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1134.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1134.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1134.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1134.2 +004100* HAS BEEN SPECIFIED. RL1134.2 +004200* RL1134.2 +004300*************************************************** RL1134.2 +004400 ENVIRONMENT DIVISION. RL1134.2 +004500 CONFIGURATION SECTION. RL1134.2 +004600 SOURCE-COMPUTER. RL1134.2 +004700 XXXXX082. RL1134.2 +004800 OBJECT-COMPUTER. RL1134.2 +004900 XXXXX083. RL1134.2 +005000 INPUT-OUTPUT SECTION. RL1134.2 +005100 FILE-CONTROL. RL1134.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1134.2 +005300 XXXXX055. RL1134.2 +005400 SELECT RL-FD2 ASSIGN RL1134.2 +005500 XXXXX022 RL1134.2 +005600 ORGANIZATION RELATIVE RL1134.2 +005700 ACCESS RANDOM RL1134.2 +005800 RELATIVE RL-FD2-KEY RL1134.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1134.2 +006000 DATA DIVISION. RL1134.2 +006100 FILE SECTION. RL1134.2 +006200 FD PRINT-FILE. RL1134.2 +006300 01 PRINT-REC PICTURE X(120). RL1134.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1134.2 +006500 FD RL-FD2 RL1134.2 +006600C VALUE OF RL1134.2 +006700C XXXXX074 RL1134.2 +006800C IS RL1134.2 +006900C XXXXX076 RL1134.2 +007000G XXXXX069 RL1134.2 +007100 LABEL RECORDS ARE STANDARD RL1134.2 +007200 BLOCK CONTAINS 1 RECORDS RL1134.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1134.2 +007400 01 RL-FD2R1-F-G-240. RL1134.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1134.2 +007600 05 RL-FD2-GRP-120. RL1134.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1134.2 +007800 PICTURE X OCCURS 120 TIMES. RL1134.2 +007900 WORKING-STORAGE SECTION. RL1134.2 +008000 01 GRP-0001. RL1134.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1134.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1134.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1134.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1134.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1134.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1134.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1134.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1134.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1134.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1134.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1134.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1134.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1134.2 +010100 05 FILLER PICTURE X(48) VALUE RL1134.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1134.2 +010300 05 FILLER PICTURE X(46) VALUE RL1134.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1134.2 +010500 05 FILLER PICTURE X(26) VALUE RL1134.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1134.2 +010700 05 FILLER PICTURE X(37) VALUE RL1134.2 +010800 ",RECKEY= ". RL1134.2 +010900 05 FILLER PICTURE X(38) VALUE RL1134.2 +011000 ",ALTKEY1= ". RL1134.2 +011100 05 FILLER PICTURE X(38) VALUE RL1134.2 +011200 ",ALTKEY2= ". RL1134.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1134.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1134.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1134.2 +011600 07 FILLER PIC X(5). RL1134.2 +011700 07 XFILE-NAME PIC X(6). RL1134.2 +011800 07 FILLER PIC X(8). RL1134.2 +011900 07 XRECORD-NAME PIC X(6). RL1134.2 +012000 07 FILLER PIC X(1). RL1134.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1134.2 +012200 07 FILLER PIC X(7). RL1134.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1134.2 +012400 07 FILLER PIC X(6). RL1134.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1134.2 +012600 07 FILLER PIC X(5). RL1134.2 +012700 07 ODO-NUMBER PIC 9(4). RL1134.2 +012800 07 FILLER PIC X(5). RL1134.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1134.2 +013000 07 FILLER PIC X(7). RL1134.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1134.2 +013200 07 FILLER PIC X(7). RL1134.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1134.2 +013400 07 FILLER PIC X(1). RL1134.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1134.2 +013600 07 FILLER PIC X(6). RL1134.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1134.2 +013800 07 FILLER PIC X(5). RL1134.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1134.2 +014000 07 FILLER PIC X(6). RL1134.2 +014100 07 XLABEL-TYPE PIC X(1). RL1134.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1134.2 +014300 07 FILLER PIC X(8). RL1134.2 +014400 07 XRECORD-KEY PIC X(29). RL1134.2 +014500 07 FILLER PIC X(9). RL1134.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1134.2 +014700 07 FILLER PIC X(9). RL1134.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1134.2 +014900 07 FILLER PIC X(7). RL1134.2 +015000 01 TEST-RESULTS. RL1134.2 +015100 02 FILLER PIC X VALUE SPACE. RL1134.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1134.2 +015300 02 FILLER PIC X VALUE SPACE. RL1134.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1134.2 +015500 02 FILLER PIC X VALUE SPACE. RL1134.2 +015600 02 PAR-NAME. RL1134.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1134.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1134.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1134.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1134.2 +016100 02 RE-MARK PIC X(61). RL1134.2 +016200 01 TEST-COMPUTED. RL1134.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1134.2 +016400 02 FILLER PIC X(17) VALUE RL1134.2 +016500 " COMPUTED=". RL1134.2 +016600 02 COMPUTED-X. RL1134.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1134.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1134.2 +016900 PIC -9(9).9(9). RL1134.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1134.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1134.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1134.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1134.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1134.2 +017500 04 FILLER PIC X. RL1134.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1134.2 +017700 01 TEST-CORRECT. RL1134.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1134.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1134.2 +018000 02 CORRECT-X. RL1134.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1134.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1134.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1134.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1134.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1134.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1134.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1134.2 +018800 04 FILLER PIC X. RL1134.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1134.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1134.2 +019100 01 CCVS-C-1. RL1134.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1134.2 +019300- "SS PARAGRAPH-NAME RL1134.2 +019400- " REMARKS". RL1134.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1134.2 +019600 01 CCVS-C-2. RL1134.2 +019700 02 FILLER PIC X VALUE SPACE. RL1134.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1134.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1134.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1134.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1134.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1134.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1134.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1134.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1134.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1134.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1134.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1134.2 +021300 01 CCVS-H-1. RL1134.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1134.2 +021500 02 FILLER PIC X(42) VALUE RL1134.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1134.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1134.2 +021800 01 CCVS-H-2A. RL1134.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1134.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1134.2 +022100 02 FILLER PIC XXXX VALUE RL1134.2 +022200 "4.2 ". RL1134.2 +022300 02 FILLER PIC X(28) VALUE RL1134.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1134.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1134.2 +022600 RL1134.2 +022700 01 CCVS-H-2B. RL1134.2 +022800 02 FILLER PIC X(15) VALUE RL1134.2 +022900 "TEST RESULT OF ". RL1134.2 +023000 02 TEST-ID PIC X(9). RL1134.2 +023100 02 FILLER PIC X(4) VALUE RL1134.2 +023200 " IN ". RL1134.2 +023300 02 FILLER PIC X(12) VALUE RL1134.2 +023400 " HIGH ". RL1134.2 +023500 02 FILLER PIC X(22) VALUE RL1134.2 +023600 " LEVEL VALIDATION FOR ". RL1134.2 +023700 02 FILLER PIC X(58) VALUE RL1134.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +023900 01 CCVS-H-3. RL1134.2 +024000 02 FILLER PIC X(34) VALUE RL1134.2 +024100 " FOR OFFICIAL USE ONLY ". RL1134.2 +024200 02 FILLER PIC X(58) VALUE RL1134.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1134.2 +024400 02 FILLER PIC X(28) VALUE RL1134.2 +024500 " COPYRIGHT 1985 ". RL1134.2 +024600 01 CCVS-E-1. RL1134.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1134.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1134.2 +024900 02 ID-AGAIN PIC X(9). RL1134.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1134.2 +025100 01 CCVS-E-2. RL1134.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1134.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1134.2 +025400 02 CCVS-E-2-2. RL1134.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1134.2 +025600 03 FILLER PIC X VALUE SPACE. RL1134.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1134.2 +025800 "ERRORS ENCOUNTERED". RL1134.2 +025900 01 CCVS-E-3. RL1134.2 +026000 02 FILLER PIC X(22) VALUE RL1134.2 +026100 " FOR OFFICIAL USE ONLY". RL1134.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1134.2 +026300 02 FILLER PIC X(58) VALUE RL1134.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1134.2 +026600 02 FILLER PIC X(15) VALUE RL1134.2 +026700 " COPYRIGHT 1985". RL1134.2 +026800 01 CCVS-E-4. RL1134.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1134.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1134.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1134.2 +027200 02 FILLER PIC X(40) VALUE RL1134.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1134.2 +027400 01 XXINFO. RL1134.2 +027500 02 FILLER PIC X(19) VALUE RL1134.2 +027600 "*** INFORMATION ***". RL1134.2 +027700 02 INFO-TEXT. RL1134.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1134.2 +027900 04 XXCOMPUTED PIC X(20). RL1134.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1134.2 +028100 04 XXCORRECT PIC X(20). RL1134.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1134.2 +028300 01 HYPHEN-LINE. RL1134.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1134.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1134.2 +028600- "*****************************************". RL1134.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1134.2 +028800- "******************************". RL1134.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1134.2 +029000 "RL113A". RL1134.2 +029100 PROCEDURE DIVISION. RL1134.2 +029200 DECLARATIVES. RL1134.2 +029300 RL-FD2-01 SECTION. RL1134.2 +029400 USE AFTER ERROR PROCEDURE INPUT. RL1134.2 +029500 RL-FD2-01-01. RL1134.2 +029600 MOVE "USE AFTER ERROR INPUT PROCEDURE SHOULD NOT BE OBEYED"RL1134.2 +029700 TO RE-MARK. RL1134.2 +029800 MOVE "RL-FD2-01-01" TO PAR-NAME. RL1134.2 +029900 MOVE "FAIL*" TO P-OR-F. RL1134.2 +030000 ADD 1 TO ERROR-COUNTER. RL1134.2 +030100* RL1134.2 +030200 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +030300 MOVE "." TO PARDOT-X RL1134.2 +030400 MOVE REC-CT TO DOTVALUE. RL1134.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. RL1134.2 +030600 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1134.2 +030700 IF P-OR-F EQUAL TO "FAIL*" RL1134.2 +030800 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1134.2 +030900 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1134.2 +031000 ELSE RL1134.2 +031100 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1134.2 +031200 MOVE SPACE TO P-OR-F. RL1134.2 +031300 MOVE SPACE TO COMPUTED-X. RL1134.2 +031400 MOVE SPACE TO CORRECT-X. RL1134.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +031600 MOVE SPACE TO RE-MARK. RL1134.2 +031700 GO TO RL-FD2-01-EXIT. RL1134.2 +031800 D1-FAIL-ROUTINE. RL1134.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1134.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1134.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1134.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1134.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1134.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1134.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1134.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +034300 D1-FAIL-ROUTINE-EX. RL1134.2 +034400 EXIT. RL1134.2 +034500 D1-BAIL-OUT. RL1134.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1134.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1134.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1134.2 +034900 GO TO D1-BAIL-OUT-EX. RL1134.2 +035000 D1-BAIL-OUT-WRITE. RL1134.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1134.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +036000 D1-BAIL-OUT-EX. RL1134.2 +036100 EXIT. RL1134.2 +036200 D1-WRITE-LINE. RL1134.2 +036300 ADD 1 TO RECORD-COUNT. RL1134.2 +036400Y IF RECORD-COUNT GREATER 50 RL1134.2 +036500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +036600Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +036700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +036800Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1134.2 +036900Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037000Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +037100Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1134.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037300Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037500Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +037600Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1134.2 +037700Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037800Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +037900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +038000Y MOVE ZERO TO RECORD-COUNT. RL1134.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +038300 D1-WRITE-LINE-EXIT. RL1134.2 +038400 EXIT. RL1134.2 +038500 RL-FD2-01-EXIT. RL1134.2 +038600 EXIT. RL1134.2 +038700* RL1134.2 +038800 RL-FD2-02 SECTION. RL1134.2 +038900 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL1134.2 +039000 RL-FD2-01-03. RL1134.2 +039100 MOVE "PASS " TO P-OR-F. RL1134.2 +039200 ADD 1 TO PASS-COUNTER. RL1134.2 +039300* RL1134.2 +039400 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +039500 MOVE "." TO PARDOT-X RL1134.2 +039600 MOVE REC-CT TO DOTVALUE. RL1134.2 +039700 MOVE TEST-RESULTS TO PRINT-REC. RL1134.2 +039800 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT. RL1134.2 +039900* RL1134.2 +040000 IF P-OR-F EQUAL TO "FAIL*" RL1134.2 +040100 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT RL1134.2 +040200 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1134.2 +040300 ELSE RL1134.2 +040400 PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1134.2 +040500 MOVE SPACE TO P-OR-F. RL1134.2 +040600 MOVE SPACE TO COMPUTED-X. RL1134.2 +040700 MOVE SPACE TO CORRECT-X. RL1134.2 +040800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +040900 MOVE SPACE TO RE-MARK. RL1134.2 +041000 GO TO RL-FD2-02-EXIT. RL1134.2 +041100 D2-FAIL-ROUTINE. RL1134.2 +041200 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +041300 GO TO D2-FAIL-ROUTINE-WRITE. RL1134.2 +041400 IF CORRECT-X NOT EQUAL TO SPACE RL1134.2 +041500 GO TO D2-FAIL-ROUTINE-WRITE. RL1134.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +041800 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042000 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +042400 GO TO D2-FAIL-ROUTINE-EX. RL1134.2 +042500 D2-FAIL-ROUTINE-WRITE. RL1134.2 +042600 MOVE TEST-COMPUTED TO PRINT-REC. RL1134.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042800 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +043000 MOVE TEST-CORRECT TO PRINT-REC. RL1134.2 +043100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +043200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +043300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +043400 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +043500 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +043600 D2-FAIL-ROUTINE-EX. RL1134.2 +043700 EXIT. RL1134.2 +043800 D2-BAIL-OUT. RL1134.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE RL1134.2 +044000 GO TO D2-BAIL-OUT-WRITE. RL1134.2 +044100 IF CORRECT-A EQUAL TO SPACE RL1134.2 +044200 GO TO D2-BAIL-OUT-EX. RL1134.2 +044300 D2-BAIL-OUT-WRITE. RL1134.2 +044400 MOVE CORRECT-A TO XXCORRECT. RL1134.2 +044500 MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +044600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +044700 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +044800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +044900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +045000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +045100 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +045300 D2-BAIL-OUT-EX. RL1134.2 +045400 EXIT. RL1134.2 +045500 RL-FD2-02-EXIT. RL1134.2 +045600 EXIT. RL1134.2 +045700 D2-WRITE-LINE. RL1134.2 +045800 ADD 1 TO RECORD-COUNT. RL1134.2 +045900Y IF RECORD-COUNT GREATER 50 RL1134.2 +046000Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +046100Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +046200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +046300Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1134.2 +046400Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +046500Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +046600Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1134.2 +046700Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +046800Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +046900Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +047000Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +047100Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1134.2 +047200Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +047300Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +047400Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +047500Y MOVE ZERO TO RECORD-COUNT. RL1134.2 +047600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +047700 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +047800 D2-WRITE-LINE-EXIT. RL1134.2 +047900 EXIT. RL1134.2 +048000 END DECLARATIVES. RL1134.2 +048100 CCVS1 SECTION. RL1134.2 +048200 OPEN-FILES. RL1134.2 +048300 OPEN OUTPUT PRINT-FILE. RL1134.2 +048400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1134.2 +048500 MOVE SPACE TO TEST-RESULTS. RL1134.2 +048600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1134.2 +048700 MOVE ZERO TO REC-SKL-SUB. RL1134.2 +048800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1134.2 +048900 CCVS-INIT-FILE. RL1134.2 +049000 ADD 1 TO REC-SKL-SUB. RL1134.2 +049100 MOVE FILE-RECORD-INFO-SKELETON RL1134.2 +049200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1134.2 +049300 CCVS-INIT-EXIT. RL1134.2 +049400 GO TO CCVS1-EXIT. RL1134.2 +049500 CLOSE-FILES. RL1134.2 +049600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1134.2 +049700 TERMINATE-CCVS. RL1134.2 +049800S EXIT PROGRAM. RL1134.2 +049900STERMINATE-CALL. RL1134.2 +050000 STOP RUN. RL1134.2 +050100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1134.2 +050200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1134.2 +050300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1134.2 +050400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1134.2 +050500 MOVE "****TEST DELETED****" TO RE-MARK. RL1134.2 +050600 PRINT-DETAIL. RL1134.2 +050700 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +050800 MOVE "." TO PARDOT-X RL1134.2 +050900 MOVE REC-CT TO DOTVALUE. RL1134.2 +051000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1134.2 +051100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1134.2 +051200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1134.2 +051300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1134.2 +051400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1134.2 +051500 MOVE SPACE TO CORRECT-X. RL1134.2 +051600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +051700 MOVE SPACE TO RE-MARK. RL1134.2 +051800 HEAD-ROUTINE. RL1134.2 +051900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1134.2 +052200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1134.2 +052300 COLUMN-NAMES-ROUTINE. RL1134.2 +052400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +052500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +052700 END-ROUTINE. RL1134.2 +052800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1134.2 +052900 END-RTN-EXIT. RL1134.2 +053000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +053100 END-ROUTINE-1. RL1134.2 +053200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1134.2 +053300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1134.2 +053400 ADD PASS-COUNTER TO ERROR-HOLD. RL1134.2 +053500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1134.2 +053600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1134.2 +053700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1134.2 +053800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1134.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1134.2 +054000 END-ROUTINE-12. RL1134.2 +054100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1134.2 +054200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1134.2 +054300 MOVE "NO " TO ERROR-TOTAL RL1134.2 +054400 ELSE RL1134.2 +054500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1134.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1134.2 +054700 PERFORM WRITE-LINE. RL1134.2 +054800 END-ROUTINE-13. RL1134.2 +054900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1134.2 +055000 MOVE "NO " TO ERROR-TOTAL ELSE RL1134.2 +055100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1134.2 +055200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1134.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +055400 IF INSPECT-COUNTER EQUAL TO ZERO RL1134.2 +055500 MOVE "NO " TO ERROR-TOTAL RL1134.2 +055600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1134.2 +055700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1134.2 +055800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +055900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +056000 WRITE-LINE. RL1134.2 +056100 ADD 1 TO RECORD-COUNT. RL1134.2 +056200Y IF RECORD-COUNT GREATER 50 RL1134.2 +056300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +056400Y MOVE SPACE TO DUMMY-RECORD RL1134.2 +056500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +056600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1134.2 +056700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1134.2 +056800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1134.2 +056900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +057000Y MOVE ZERO TO RECORD-COUNT. RL1134.2 +057100 PERFORM WRT-LN. RL1134.2 +057200 WRT-LN. RL1134.2 +057300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +057400 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +057500 BLANK-LINE-PRINT. RL1134.2 +057600 PERFORM WRT-LN. RL1134.2 +057700 FAIL-ROUTINE. RL1134.2 +057800 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +057900 GO TO FAIL-ROUTINE-WRITE. RL1134.2 +058000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1134.2 +058100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +058200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +058300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +058400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +058500 GO TO FAIL-ROUTINE-EX. RL1134.2 +058600 FAIL-ROUTINE-WRITE. RL1134.2 +058700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1134.2 +058800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +058900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1134.2 +059000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +059100 FAIL-ROUTINE-EX. EXIT. RL1134.2 +059200 BAIL-OUT. RL1134.2 +059300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1134.2 +059400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1134.2 +059500 BAIL-OUT-WRITE. RL1134.2 +059600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +059700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +059800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +059900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +060000 BAIL-OUT-EX. EXIT. RL1134.2 +060100 CCVS1-EXIT. RL1134.2 +060200 EXIT. RL1134.2 +060300 SECT-RL113A-001 SECTION. RL1134.2 +060400 REL-INIT-009. RL1134.2 +060500 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1134.2 +060600 MOVE "REL-TEST-009" TO PAR-NAME. RL1134.2 +060700 MOVE "CREATE RL-FD2" TO FEATURE RL1134.2 +060800 MOVE "RL-FD2" TO XFILE-NAME (2). RL1134.2 +060900 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1134.2 +061000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1134.2 +061100 MOVE 000240 TO XRECORD-LENGTH (2). RL1134.2 +061200 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1134.2 +061300 MOVE 0001 TO XBLOCK-SIZE (2). RL1134.2 +061400 MOVE 000500 TO RECORDS-IN-FILE (2). RL1134.2 +061500 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1134.2 +061600 MOVE "S" TO XLABEL-TYPE (2). RL1134.2 +061700 MOVE 000001 TO XRECORD-NUMBER (2). RL1134.2 +061800*INITIALIZE RECORD WORK AREA NUMBER 2. RL1134.2 +061900 MOVE 1 TO WRK-CS-09V00-012. RL1134.2 +062000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1134.2 +062100 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1134.2 +062200 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1134.2 +062300 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +062400 MOVE 90000002 TO RL-FD2-KEY. RL1134.2 +062500 MOVE 01 TO REC-CT. RL1134.2 +062600 OPEN OUTPUT RL-FD2. RL1134.2 +062700 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1134.2 +062800*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1134.2 +062900 REL-TEST-009-R. RL1134.2 +063000 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1134.2 +063100 MOVE "99" TO RL-FD2-STATUS. RL1134.2 +063200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1134.2 +063300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1134.2 +063400 RL-FD2-GRP-120. RL1134.2 +063500 WRITE RL-FD2R1-F-G-240. RL1134.2 +063600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +063700 GO TO REL-TEST-009-2. RL1134.2 +063800 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1134.2 +063900 GO TO REL-TEST-009-2. RL1134.2 +064000 ADD 01 TO XRECORD-NUMBER (2). RL1134.2 +064100 GO TO REL-TEST-009-R. RL1134.2 +064200 REL-TEST-009-2. RL1134.2 +064300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1134.2 +064400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1134.2 +064500 MOVE ZERO TO CORRECT-18V0 RL1134.2 +064600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1134.2 +064700 PERFORM FAIL RL1134.2 +064800 ELSE RL1134.2 +064900 PERFORM PASS. RL1134.2 +065000 PERFORM PRINT-DETAIL. RL1134.2 +065100 ADD 01 TO REC-CT. RL1134.2 +065200* .01 RL1134.2 +065300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1134.2 +065400 MOVE "INCORRECT COUNT" TO RE-MARK RL1134.2 +065500 MOVE 500 TO CORRECT-18V0 RL1134.2 +065600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1134.2 +065700 PERFORM FAIL RL1134.2 +065800 ELSE RL1134.2 +065900 PERFORM PASS. RL1134.2 +066000 PERFORM PRINT-DETAIL. RL1134.2 +066100 ADD 01 TO REC-CT. RL1134.2 +066200* .02 RL1134.2 +066300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1134.2 +066400 MOVE "STATUS/OPEN" TO RE-MARK RL1134.2 +066500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1134.2 +066600 MOVE "00" TO CORRECT-A RL1134.2 +066700 PERFORM FAIL RL1134.2 +066800 ELSE RL1134.2 +066900 PERFORM PASS. RL1134.2 +067000 PERFORM PRINT-DETAIL. RL1134.2 +067100 ADD 01 TO REC-CT. RL1134.2 +067200* .03 RL1134.2 +067300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +067400 MOVE "STATUS/WRITE" TO RE-MARK RL1134.2 +067500 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +067600 MOVE "00" TO CORRECT-A RL1134.2 +067700 PERFORM FAIL RL1134.2 +067800 ELSE RL1134.2 +067900 PERFORM PASS. RL1134.2 +068000 PERFORM PRINT-DETAIL. RL1134.2 +068100 ADD 01 TO REC-CT. RL1134.2 +068200* .04 RL1134.2 +068300 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +068400 CLOSE RL-FD2. RL1134.2 +068500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +068600 MOVE "CLOSE/STATUS" TO RE-MARK RL1134.2 +068700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +068800 MOVE "00" TO CORRECT-A RL1134.2 +068900 PERFORM FAIL RL1134.2 +069000 ELSE RL1134.2 +069100 PERFORM PASS. RL1134.2 +069200 PERFORM PRINT-DETAIL. RL1134.2 +069300 ADD 01 TO REC-CT. RL1134.2 +069400* .05 RL1134.2 +069500 REL-INIT-010. RL1134.2 +069600 MOVE "REL-TEST-010" TO PAR-NAME. RL1134.2 +069700 MOVE 2 TO WRK-CS-09V00-012. RL1134.2 +069800 MOVE ZERO TO RL-FD2-KEY. RL1134.2 +069900 MOVE ZERO TO WRK-CS-09V00-013. RL1134.2 +070000 MOVE ZERO TO WRK-CS-09V00-014. RL1134.2 +070100 MOVE ZERO TO WRK-CS-09V00-015. RL1134.2 +070200 MOVE ZERO TO WRK-CS-09V00-016. RL1134.2 +070300 MOVE ZERO TO WRK-CS-09V00-017. RL1134.2 +070400 MOVE ZERO TO WRK-CS-09V00-018. RL1134.2 +070500 MOVE 01 TO REC-CT. RL1134.2 +070600 OPEN I-O RL-FD2. RL1134.2 +070700 MOVE SPACE TO WRK-XN-0002-002 RL1134.2 +070800 MOVE SPACE TO WRK-XN-0002-003 RL1134.2 +070900 MOVE SPACE TO WRK-XN-0002-004 RL1134.2 +071000 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1134.2 +071100 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +071200*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1134.2 +071300 MOVE "USE/FILE STATUS" TO FEATURE. RL1134.2 +071400 REL-TEST-010-R. RL1134.2 +071500 ADD 1 TO RL-FD2-KEY. RL1134.2 +071600 ADD 1 TO WRK-CS-09V00-014. RL1134.2 +071700 ADD 1 TO WRK-CS-09V00-015. RL1134.2 +071800 READ RL-FD2 RECORD. RL1134.2 +071900 IF RL-FD2-STATUS EQUAL TO "23" RL1134.2 +072000 GO TO REL-TEST-010-3. RL1134.2 +072100 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1134.2 +072200 IF WRK-CS-09V00-015 EQUAL TO 5 RL1134.2 +072300 ADD 01 TO UPDATE-NUMBER (2) RL1134.2 +072400 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1134.2 +072500 REWRITE RL-FD2R1-F-G-240 RL1134.2 +072600 MOVE ZERO TO WRK-CS-09V00-015 RL1134.2 +072700 GO TO REL-TEST-010-2. RL1134.2 +072800 IF WRK-CS-09V00-014 GREATER 500 RL1134.2 +072900 MOVE 1 TO WRK-CS-09V00-013 RL1134.2 +073000 GO TO REL-TEST-010-3. RL1134.2 +073100 GO TO REL-TEST-010-R. RL1134.2 +073200 REL-TEST-010-2. RL1134.2 +073300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +073400 ADD 1 TO WRK-CS-09V00-016. RL1134.2 +073500 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +073600 GO TO REL-TEST-010-R. RL1134.2 +073700 REL-TEST-010-3. RL1134.2 +073800 IF WRK-CS-09V00-013 NOT EQUAL TO 0 RL1134.2 +073900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1134.2 +074000 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1134.2 +074100 MOVE 0 TO CORRECT-18V0 RL1134.2 +074200 PERFORM FAIL RL1134.2 +074300 ELSE RL1134.2 +074400 PERFORM PASS. RL1134.2 +074500 PERFORM PRINT-DETAIL. RL1134.2 +074600 ADD 01 TO REC-CT. RL1134.2 +074700* .01 RL1134.2 +074800 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1134.2 +074900 MOVE "INCORRECT COUNT" TO RE-MARK RL1134.2 +075000 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1134.2 +075100 MOVE 501 TO CORRECT-18V0 RL1134.2 +075200 PERFORM FAIL RL1134.2 +075300 ELSE RL1134.2 +075400 PERFORM PASS. RL1134.2 +075500 PERFORM PRINT-DETAIL. RL1134.2 +075600 ADD 01 TO REC-CT. RL1134.2 +075700* .02 RL1134.2 +075800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1134.2 +075900 MOVE "OPEN/STATUS" TO RE-MARK RL1134.2 +076000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1134.2 +076100 MOVE "00" TO CORRECT-A RL1134.2 +076200 PERFORM FAIL RL1134.2 +076300 ELSE RL1134.2 +076400 PERFORM PASS. RL1134.2 +076500 PERFORM PRINT-DETAIL. RL1134.2 +076600 ADD 01 TO REC-CT. RL1134.2 +076700* .03 RL1134.2 +076800 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1134.2 +076900 MOVE "AT END/STATUS" TO RE-MARK RL1134.2 +077000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +077100 MOVE "23" TO CORRECT-A RL1134.2 +077200 PERFORM FAIL RL1134.2 +077300 ELSE RL1134.2 +077400 PERFORM PASS. RL1134.2 +077500 PERFORM PRINT-DETAIL. RL1134.2 +077600 ADD 01 TO REC-CT. RL1134.2 +077700* .04 RL1134.2 +077800* IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1134.2 +077900* MOVE "EXCEPTION/STATUS" TO RE-MARK RL1134.2 +078000* MOVE WRK-XN-0002-002 TO COMPUTED-A RL1134.2 +078100* MOVE "10" TO CORRECT-A RL1134.2 +078200* PERFORM FAIL RL1134.2 +078300* ELSE RL1134.2 +078400* PERFORM PASS. RL1134.2 +078500* PERFORM PRINT-DETAIL. RL1134.2 +078600* ADD 01 TO REC-CT. RL1134.2 +078700* .05 RL1134.2 +078800* IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1134.2 +078900* MOVE "NO EXCEPTION" TO RE-MARK RL1134.2 +079000* MOVE WRK-XN-0002-003 TO COMPUTED-A RL1134.2 +079100* MOVE "10" TO CORRECT-A RL1134.2 +079200* PERFORM FAIL RL1134.2 +079300* ELSE RL1134.2 +079400* PERFORM PASS. RL1134.2 +079500* PERFORM PRINT-DETAIL RL1134.2 +079600* ADD 01 TO REC-CT. RL1134.2 +079700* .06 RL1134.2 +079800 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +079900 CLOSE RL-FD2 RL1134.2 +080000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +080100 MOVE "CLOSE/STATUS" TO RE-MARK RL1134.2 +080200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +080300 MOVE "00" TO CORRECT-A RL1134.2 +080400 PERFORM FAIL RL1134.2 +080500 ELSE RL1134.2 +080600 PERFORM PASS. RL1134.2 +080700 PERFORM PRINT-DETAIL. RL1134.2 +080800 ADD 01 TO REC-CT. RL1134.2 +080900* .07 RL1134.2 +081000 CCVS-EXIT SECTION. RL1134.2 +081100 CCVS-999999. RL1134.2 +081200 GO TO CLOSE-FILES. RL1134.2 +*END-OF,RL113A +*HEADER,COBOL,RL114A +000100 IDENTIFICATION DIVISION. RL1144.2 +000200 PROGRAM-ID. RL1144.2 +000300 RL114A. RL1144.2 +000400**************************************************************** RL1144.2 +000500* * RL1144.2 +000600* VALIDATION FOR:- * RL1144.2 +000700* * RL1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +000900* * RL1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1144.2 +001100* * RL1144.2 +001200**************************************************************** RL1144.2 +001300* * RL1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1144.2 +001500* * RL1144.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1144.2 +001700* RELATIVE I-O DATA FILE * RL1144.2 +001800* X-55 SYSTEM PRINTER * RL1144.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1144.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1144.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1144.2 +002200* X-82 SOURCE-COMPUTER * RL1144.2 +002300* X-83 OBJECT-COMPUTER. * RL1144.2 +002400* * RL1144.2 +002500**************************************************************** RL1144.2 +002600* RL114A * RL1144.2 +002700**************************************************************** RL1144.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1144.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1144.2 +003000* STATEMENT. RL1144.2 +003100* RL1144.2 +003200* RL1144.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE CONTAINING RL1144.2 +003400* 500 RECORDS (ACCESS MODE RANDOM). IT THEN CLOSES THERL1144.2 +003500* FILE AND RE-OPENS IT IS I-O AND READS ALL THE RECORDSRL1144.2 +003600* AND ATTEMPTS TO READ THE 501ST RECORD TO GIVE STATUS RL1144.2 +003700* CODE 23. SEE STANDARD REF VIII-4 1.3.4 (3) B, 1). RL1144.2 +003800* THE READ, WRITE AND REWRITE STATEMENTS ARE USED RL1144.2 +003900* WITHOUT THE APPROPRIATE AT END ON INVALID KEY PHRASESRL1144.2 +004000* WHICH IS PERMITTED IF AN APPLICABLE USE PROCEDURE RL1144.2 +004100* HAS BEEN SPECIFIED. RL1144.2 +004200* RL1144.2 +004300*************************************************** RL1144.2 +004400 ENVIRONMENT DIVISION. RL1144.2 +004500 CONFIGURATION SECTION. RL1144.2 +004600 SOURCE-COMPUTER. RL1144.2 +004700 XXXXX082. RL1144.2 +004800 OBJECT-COMPUTER. RL1144.2 +004900 XXXXX083. RL1144.2 +005000 INPUT-OUTPUT SECTION. RL1144.2 +005100 FILE-CONTROL. RL1144.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1144.2 +005300 XXXXX055. RL1144.2 +005400 SELECT RL-FD2 ASSIGN RL1144.2 +005500 XXXXX022 RL1144.2 +005600 ORGANIZATION RELATIVE RL1144.2 +005700 ACCESS RANDOM RL1144.2 +005800 RELATIVE RL-FD2-KEY RL1144.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1144.2 +006000 DATA DIVISION. RL1144.2 +006100 FILE SECTION. RL1144.2 +006200 FD PRINT-FILE. RL1144.2 +006300 01 PRINT-REC PICTURE X(120). RL1144.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1144.2 +006500 FD RL-FD2 RL1144.2 +006600C VALUE OF RL1144.2 +006700C XXXXX074 RL1144.2 +006800C IS RL1144.2 +006900C XXXXX076 RL1144.2 +007000G XXXXX069 RL1144.2 +007100 LABEL RECORDS ARE STANDARD RL1144.2 +007200 BLOCK CONTAINS 1 RECORDS RL1144.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1144.2 +007400 01 RL-FD2R1-F-G-240. RL1144.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1144.2 +007600 05 RL-FD2-GRP-120. RL1144.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1144.2 +007800 PICTURE X OCCURS 120 TIMES. RL1144.2 +007900 WORKING-STORAGE SECTION. RL1144.2 +008000 01 GRP-0001. RL1144.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1144.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1144.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1144.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1144.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1144.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1144.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1144.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1144.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1144.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1144.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1144.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1144.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1144.2 +010100 05 FILLER PICTURE X(48) VALUE RL1144.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1144.2 +010300 05 FILLER PICTURE X(46) VALUE RL1144.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1144.2 +010500 05 FILLER PICTURE X(26) VALUE RL1144.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1144.2 +010700 05 FILLER PICTURE X(37) VALUE RL1144.2 +010800 ",RECKEY= ". RL1144.2 +010900 05 FILLER PICTURE X(38) VALUE RL1144.2 +011000 ",ALTKEY1= ". RL1144.2 +011100 05 FILLER PICTURE X(38) VALUE RL1144.2 +011200 ",ALTKEY2= ". RL1144.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1144.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1144.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1144.2 +011600 07 FILLER PIC X(5). RL1144.2 +011700 07 XFILE-NAME PIC X(6). RL1144.2 +011800 07 FILLER PIC X(8). RL1144.2 +011900 07 XRECORD-NAME PIC X(6). RL1144.2 +012000 07 FILLER PIC X(1). RL1144.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1144.2 +012200 07 FILLER PIC X(7). RL1144.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1144.2 +012400 07 FILLER PIC X(6). RL1144.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1144.2 +012600 07 FILLER PIC X(5). RL1144.2 +012700 07 ODO-NUMBER PIC 9(4). RL1144.2 +012800 07 FILLER PIC X(5). RL1144.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1144.2 +013000 07 FILLER PIC X(7). RL1144.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1144.2 +013200 07 FILLER PIC X(7). RL1144.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1144.2 +013400 07 FILLER PIC X(1). RL1144.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1144.2 +013600 07 FILLER PIC X(6). RL1144.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1144.2 +013800 07 FILLER PIC X(5). RL1144.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1144.2 +014000 07 FILLER PIC X(6). RL1144.2 +014100 07 XLABEL-TYPE PIC X(1). RL1144.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1144.2 +014300 07 FILLER PIC X(8). RL1144.2 +014400 07 XRECORD-KEY PIC X(29). RL1144.2 +014500 07 FILLER PIC X(9). RL1144.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1144.2 +014700 07 FILLER PIC X(9). RL1144.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1144.2 +014900 07 FILLER PIC X(7). RL1144.2 +015000 01 TEST-RESULTS. RL1144.2 +015100 02 FILLER PIC X VALUE SPACE. RL1144.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1144.2 +015300 02 FILLER PIC X VALUE SPACE. RL1144.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1144.2 +015500 02 FILLER PIC X VALUE SPACE. RL1144.2 +015600 02 PAR-NAME. RL1144.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1144.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1144.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1144.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1144.2 +016100 02 RE-MARK PIC X(61). RL1144.2 +016200 01 TEST-COMPUTED. RL1144.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1144.2 +016400 02 FILLER PIC X(17) VALUE RL1144.2 +016500 " COMPUTED=". RL1144.2 +016600 02 COMPUTED-X. RL1144.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1144.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1144.2 +016900 PIC -9(9).9(9). RL1144.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1144.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1144.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1144.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1144.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1144.2 +017500 04 FILLER PIC X. RL1144.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1144.2 +017700 01 TEST-CORRECT. RL1144.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1144.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1144.2 +018000 02 CORRECT-X. RL1144.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1144.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1144.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1144.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1144.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1144.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1144.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1144.2 +018800 04 FILLER PIC X. RL1144.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1144.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1144.2 +019100 01 CCVS-C-1. RL1144.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1144.2 +019300- "SS PARAGRAPH-NAME RL1144.2 +019400- " REMARKS". RL1144.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1144.2 +019600 01 CCVS-C-2. RL1144.2 +019700 02 FILLER PIC X VALUE SPACE. RL1144.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1144.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1144.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1144.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1144.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1144.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1144.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1144.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1144.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1144.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1144.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1144.2 +021300 01 CCVS-H-1. RL1144.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1144.2 +021500 02 FILLER PIC X(42) VALUE RL1144.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1144.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1144.2 +021800 01 CCVS-H-2A. RL1144.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1144.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1144.2 +022100 02 FILLER PIC XXXX VALUE RL1144.2 +022200 "4.2 ". RL1144.2 +022300 02 FILLER PIC X(28) VALUE RL1144.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1144.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1144.2 +022600 RL1144.2 +022700 01 CCVS-H-2B. RL1144.2 +022800 02 FILLER PIC X(15) VALUE RL1144.2 +022900 "TEST RESULT OF ". RL1144.2 +023000 02 TEST-ID PIC X(9). RL1144.2 +023100 02 FILLER PIC X(4) VALUE RL1144.2 +023200 " IN ". RL1144.2 +023300 02 FILLER PIC X(12) VALUE RL1144.2 +023400 " HIGH ". RL1144.2 +023500 02 FILLER PIC X(22) VALUE RL1144.2 +023600 " LEVEL VALIDATION FOR ". RL1144.2 +023700 02 FILLER PIC X(58) VALUE RL1144.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +023900 01 CCVS-H-3. RL1144.2 +024000 02 FILLER PIC X(34) VALUE RL1144.2 +024100 " FOR OFFICIAL USE ONLY ". RL1144.2 +024200 02 FILLER PIC X(58) VALUE RL1144.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1144.2 +024400 02 FILLER PIC X(28) VALUE RL1144.2 +024500 " COPYRIGHT 1985 ". RL1144.2 +024600 01 CCVS-E-1. RL1144.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1144.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1144.2 +024900 02 ID-AGAIN PIC X(9). RL1144.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1144.2 +025100 01 CCVS-E-2. RL1144.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1144.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1144.2 +025400 02 CCVS-E-2-2. RL1144.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1144.2 +025600 03 FILLER PIC X VALUE SPACE. RL1144.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1144.2 +025800 "ERRORS ENCOUNTERED". RL1144.2 +025900 01 CCVS-E-3. RL1144.2 +026000 02 FILLER PIC X(22) VALUE RL1144.2 +026100 " FOR OFFICIAL USE ONLY". RL1144.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1144.2 +026300 02 FILLER PIC X(58) VALUE RL1144.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1144.2 +026600 02 FILLER PIC X(15) VALUE RL1144.2 +026700 " COPYRIGHT 1985". RL1144.2 +026800 01 CCVS-E-4. RL1144.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1144.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1144.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1144.2 +027200 02 FILLER PIC X(40) VALUE RL1144.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1144.2 +027400 01 XXINFO. RL1144.2 +027500 02 FILLER PIC X(19) VALUE RL1144.2 +027600 "*** INFORMATION ***". RL1144.2 +027700 02 INFO-TEXT. RL1144.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1144.2 +027900 04 XXCOMPUTED PIC X(20). RL1144.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1144.2 +028100 04 XXCORRECT PIC X(20). RL1144.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1144.2 +028300 01 HYPHEN-LINE. RL1144.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1144.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1144.2 +028600- "*****************************************". RL1144.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1144.2 +028800- "******************************". RL1144.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1144.2 +029000 "RL114A". RL1144.2 +029100 PROCEDURE DIVISION. RL1144.2 +029200 DECLARATIVES. RL1144.2 +029300 RL-FD2-01 SECTION. RL1144.2 +029400 USE AFTER ERROR PROCEDURE RL-FD2. RL1144.2 +029500 RL-FD2-01-01. RL1144.2 +029600 MOVE "PASS " TO P-OR-F. RL1144.2 +029700 ADD 1 TO PASS-COUNTER. RL1144.2 +029800* RL1144.2 +029900 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +030000 MOVE "." TO PARDOT-X RL1144.2 +030100 MOVE REC-CT TO DOTVALUE. RL1144.2 +030200 MOVE TEST-RESULTS TO PRINT-REC. RL1144.2 +030300 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1144.2 +030400 IF P-OR-F EQUAL TO "FAIL*" RL1144.2 +030500 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1144.2 +030600 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1144.2 +030700 ELSE RL1144.2 +030800 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1144.2 +030900 MOVE SPACE TO P-OR-F. RL1144.2 +031000 MOVE SPACE TO COMPUTED-X. RL1144.2 +031100 MOVE SPACE TO CORRECT-X. RL1144.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +031300 MOVE SPACE TO RE-MARK. RL1144.2 +031400 ADD 1 TO WRK-CS-09V00-013. RL1144.2 +031500 MOVE RL-FD2-STATUS TO WRK-XN-0002-002. RL1144.2 +031600 MOVE "23" TO WRK-XN-0002-003. RL1144.2 +031700 GO TO RL-FD2-01-EXIT. RL1144.2 +031800 D1-FAIL-ROUTINE. RL1144.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1144.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1144.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1144.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1144.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1144.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1144.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1144.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +034300 D1-FAIL-ROUTINE-EX. RL1144.2 +034400 EXIT. RL1144.2 +034500 D1-BAIL-OUT. RL1144.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1144.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1144.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1144.2 +034900 GO TO D1-BAIL-OUT-EX. RL1144.2 +035000 D1-BAIL-OUT-WRITE. RL1144.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1144.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +036000 D1-BAIL-OUT-EX. RL1144.2 +036100 EXIT. RL1144.2 +036200 D1-WRITE-LINE. RL1144.2 +036300 ADD 1 TO RECORD-COUNT. RL1144.2 +036400Y IF RECORD-COUNT GREATER 50 RL1144.2 +036500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +036600Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +036700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +036800Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1144.2 +036900Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037000Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +037100Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1144.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037300Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037500Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +037600Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1144.2 +037700Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037800Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +037900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +038000Y MOVE ZERO TO RECORD-COUNT. RL1144.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +038300 D1-WRITE-LINE-EXIT. RL1144.2 +038400 EXIT. RL1144.2 +038500 RL-FD2-01-EXIT. RL1144.2 +038600 EXIT. RL1144.2 +038700 RL-FD2-01-03 SECTION. RL1144.2 +038800 USE AFTER EXCEPTION PROCEDURE OUTPUT. RL1144.2 +038900 RL-FD2-01-03-01. RL1144.2 +039000 MOVE "RL-FD2-01-03" TO PAR-NAME. RL1144.2 +039100 MOVE "USE AFTER EXCEPTION PROCEDURE SHOULD NOT BE OBEYED" RL1144.2 +039200 TO RE-MARK. RL1144.2 +039300 MOVE "FAIL*" TO P-OR-F. RL1144.2 +039400 ADD 1 TO ERROR-COUNTER. RL1144.2 +039500* RL1144.2 +039600 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +039700 MOVE "." TO PARDOT-X RL1144.2 +039800 MOVE REC-CT TO DOTVALUE. RL1144.2 +039900 MOVE TEST-RESULTS TO PRINT-REC. RL1144.2 +040000 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT. RL1144.2 +040100 IF P-OR-F EQUAL TO "FAIL*" RL1144.2 +040200 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT RL1144.2 +040300 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1144.2 +040400 ELSE RL1144.2 +040500 PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1144.2 +040600 MOVE SPACE TO P-OR-F. RL1144.2 +040700 MOVE SPACE TO COMPUTED-X. RL1144.2 +040800 MOVE SPACE TO CORRECT-X. RL1144.2 +040900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +041000 MOVE SPACE TO RE-MARK. RL1144.2 +041100 GO TO RL-FD2-01-03-EXIT. RL1144.2 +041200 D2-FAIL-ROUTINE. RL1144.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +041400 GO TO D2-FAIL-ROUTINE-WRITE. RL1144.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE RL1144.2 +041600 GO TO D2-FAIL-ROUTINE-WRITE. RL1144.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +041900 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +042000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042100 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +042200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042300 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +042400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +042500 GO TO D2-FAIL-ROUTINE-EX. RL1144.2 +042600 D2-FAIL-ROUTINE-WRITE. RL1144.2 +042700 MOVE TEST-COMPUTED TO PRINT-REC. RL1144.2 +042800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +043100 MOVE TEST-CORRECT TO PRINT-REC. RL1144.2 +043200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +043300 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +043500 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043600 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +043700 D2-FAIL-ROUTINE-EX. RL1144.2 +043800 EXIT. RL1144.2 +043900 D2-BAIL-OUT. RL1144.2 +044000 IF COMPUTED-A NOT EQUAL TO SPACE RL1144.2 +044100 GO TO D2-BAIL-OUT-WRITE. RL1144.2 +044200 IF CORRECT-A EQUAL TO SPACE RL1144.2 +044300 GO TO D2-BAIL-OUT-EX. RL1144.2 +044400 D2-BAIL-OUT-WRITE. RL1144.2 +044500 MOVE CORRECT-A TO XXCORRECT. RL1144.2 +044600 MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +044700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +044800 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +044900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +045000 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +045100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +045200 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +045400 D2-BAIL-OUT-EX. RL1144.2 +045500 EXIT. RL1144.2 +045600 D2-WRITE-LINE. RL1144.2 +045700 ADD 1 TO RECORD-COUNT. RL1144.2 +045800Y IF RECORD-COUNT GREATER 50 RL1144.2 +045900Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +046000Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +046100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +046200Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1144.2 +046300Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046400Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +046500Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1144.2 +046600Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046700Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +046800Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046900Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +047000Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1144.2 +047100Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +047200Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +047300Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +047400Y MOVE ZERO TO RECORD-COUNT. RL1144.2 +047500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +047600 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +047700 D2-WRITE-LINE-EXIT. RL1144.2 +047800* EXIT. RL1144.2 +047900************ PRINT-DETAIL COPIED HERE ************** RL1144.2 +048000 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +048100 MOVE "." TO PARDOT-X RL1144.2 +048200 MOVE REC-CT TO DOTVALUE. RL1144.2 +048300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D2-WRITE-LINE. RL1144.2 +048400 IF P-OR-F EQUAL TO "FAIL*" PERFORM D2-WRITE-LINE RL1144.2 +048500 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1144.2 +048600 ELSE PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1144.2 +048700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1144.2 +048800 MOVE SPACE TO CORRECT-X. RL1144.2 +048900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +049000 MOVE SPACE TO RE-MARK. RL1144.2 +049100 RL-FD2-01-03-EXIT. RL1144.2 +049200 EXIT. RL1144.2 +049300 END DECLARATIVES. RL1144.2 +049400 CCVS1 SECTION. RL1144.2 +049500 OPEN-FILES. RL1144.2 +049600 OPEN OUTPUT PRINT-FILE. RL1144.2 +049700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1144.2 +049800 MOVE SPACE TO TEST-RESULTS. RL1144.2 +049900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1144.2 +050000 MOVE ZERO TO REC-SKL-SUB. RL1144.2 +050100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1144.2 +050200 CCVS-INIT-FILE. RL1144.2 +050300 ADD 1 TO REC-SKL-SUB. RL1144.2 +050400 MOVE FILE-RECORD-INFO-SKELETON RL1144.2 +050500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1144.2 +050600 CCVS-INIT-EXIT. RL1144.2 +050700 GO TO CCVS1-EXIT. RL1144.2 +050800 CLOSE-FILES. RL1144.2 +050900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1144.2 +051000 TERMINATE-CCVS. RL1144.2 +051100S EXIT PROGRAM. RL1144.2 +051200STERMINATE-CALL. RL1144.2 +051300 STOP RUN. RL1144.2 +051400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1144.2 +051500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1144.2 +051600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1144.2 +051700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1144.2 +051800 MOVE "****TEST DELETED****" TO RE-MARK. RL1144.2 +051900 PRINT-DETAIL. RL1144.2 +052000 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +052100 MOVE "." TO PARDOT-X RL1144.2 +052200 MOVE REC-CT TO DOTVALUE. RL1144.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1144.2 +052400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1144.2 +052500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1144.2 +052600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1144.2 +052700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1144.2 +052800 MOVE SPACE TO CORRECT-X. RL1144.2 +052900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +053000 MOVE SPACE TO RE-MARK. RL1144.2 +053100 HEAD-ROUTINE. RL1144.2 +053200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1144.2 +053500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1144.2 +053600 COLUMN-NAMES-ROUTINE. RL1144.2 +053700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +053800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +054000 END-ROUTINE. RL1144.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1144.2 +054200 END-RTN-EXIT. RL1144.2 +054300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +054400 END-ROUTINE-1. RL1144.2 +054500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1144.2 +054600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1144.2 +054700 ADD PASS-COUNTER TO ERROR-HOLD. RL1144.2 +054800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1144.2 +054900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1144.2 +055000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1144.2 +055100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1144.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1144.2 +055300 END-ROUTINE-12. RL1144.2 +055400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1144.2 +055500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1144.2 +055600 MOVE "NO " TO ERROR-TOTAL RL1144.2 +055700 ELSE RL1144.2 +055800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1144.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1144.2 +056000 PERFORM WRITE-LINE. RL1144.2 +056100 END-ROUTINE-13. RL1144.2 +056200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1144.2 +056300 MOVE "NO " TO ERROR-TOTAL ELSE RL1144.2 +056400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1144.2 +056500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1144.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +056700 IF INSPECT-COUNTER EQUAL TO ZERO RL1144.2 +056800 MOVE "NO " TO ERROR-TOTAL RL1144.2 +056900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1144.2 +057000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1144.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +057200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +057300 WRITE-LINE. RL1144.2 +057400 ADD 1 TO RECORD-COUNT. RL1144.2 +057500Y IF RECORD-COUNT GREATER 50 RL1144.2 +057600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +057700Y MOVE SPACE TO DUMMY-RECORD RL1144.2 +057800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +057900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1144.2 +058000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1144.2 +058100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1144.2 +058200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +058300Y MOVE ZERO TO RECORD-COUNT. RL1144.2 +058400 PERFORM WRT-LN. RL1144.2 +058500 WRT-LN. RL1144.2 +058600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +058700 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +058800 BLANK-LINE-PRINT. RL1144.2 +058900 PERFORM WRT-LN. RL1144.2 +059000 FAIL-ROUTINE. RL1144.2 +059100 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +059200 GO TO FAIL-ROUTINE-WRITE. RL1144.2 +059300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1144.2 +059400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +059500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +059600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +059800 GO TO FAIL-ROUTINE-EX. RL1144.2 +059900 FAIL-ROUTINE-WRITE. RL1144.2 +060000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1144.2 +060100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +060200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1144.2 +060300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +060400 FAIL-ROUTINE-EX. EXIT. RL1144.2 +060500 BAIL-OUT. RL1144.2 +060600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1144.2 +060700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1144.2 +060800 BAIL-OUT-WRITE. RL1144.2 +060900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +061000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +061200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +061300 BAIL-OUT-EX. EXIT. RL1144.2 +061400 CCVS1-EXIT. RL1144.2 +061500 EXIT. RL1144.2 +061600 SECT-RL114A-001 SECTION. RL1144.2 +061700 REL-INIT-009. RL1144.2 +061800 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1144.2 +061900 MOVE "REL-TEST-009" TO PAR-NAME. RL1144.2 +062000 MOVE "CREATE RL-FD2" TO FEATURE RL1144.2 +062100 MOVE "RL-FD2" TO XFILE-NAME (2). RL1144.2 +062200 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1144.2 +062300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1144.2 +062400 MOVE 000240 TO XRECORD-LENGTH (2). RL1144.2 +062500 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1144.2 +062600 MOVE 0001 TO XBLOCK-SIZE (2). RL1144.2 +062700 MOVE 000500 TO RECORDS-IN-FILE (2). RL1144.2 +062800 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1144.2 +062900 MOVE "S" TO XLABEL-TYPE (2). RL1144.2 +063000 MOVE 000001 TO XRECORD-NUMBER (2). RL1144.2 +063100*INITIALIZE RECORD WORK AREA NUMBER 2. RL1144.2 +063200 MOVE 1 TO WRK-CS-09V00-012. RL1144.2 +063300 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1144.2 +063400 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1144.2 +063500 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1144.2 +063600 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +063700 MOVE 90000002 TO RL-FD2-KEY. RL1144.2 +063800 MOVE 01 TO REC-CT. RL1144.2 +063900 OPEN OUTPUT RL-FD2. RL1144.2 +064000 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1144.2 +064100*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1144.2 +064200 REL-TEST-009-R. RL1144.2 +064300 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1144.2 +064400 MOVE "99" TO RL-FD2-STATUS. RL1144.2 +064500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1144.2 +064600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1144.2 +064700 RL-FD2-GRP-120. RL1144.2 +064800 WRITE RL-FD2R1-F-G-240. RL1144.2 +064900 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +065000 GO TO REL-TEST-009-2. RL1144.2 +065100 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1144.2 +065200 GO TO REL-TEST-009-2. RL1144.2 +065300 ADD 01 TO XRECORD-NUMBER (2). RL1144.2 +065400 GO TO REL-TEST-009-R. RL1144.2 +065500 REL-TEST-009-2. RL1144.2 +065600 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1144.2 +065700 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1144.2 +065800 MOVE ZERO TO CORRECT-18V0 RL1144.2 +065900 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1144.2 +066000 PERFORM FAIL RL1144.2 +066100 ELSE RL1144.2 +066200 PERFORM PASS. RL1144.2 +066300 PERFORM PRINT-DETAIL. RL1144.2 +066400 ADD 01 TO REC-CT. RL1144.2 +066500* .01 RL1144.2 +066600 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1144.2 +066700 MOVE "INCORRECT COUNT" TO RE-MARK RL1144.2 +066800 MOVE 500 TO CORRECT-18V0 RL1144.2 +066900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1144.2 +067000 PERFORM FAIL RL1144.2 +067100 ELSE RL1144.2 +067200 PERFORM PASS. RL1144.2 +067300 PERFORM PRINT-DETAIL. RL1144.2 +067400 ADD 01 TO REC-CT. RL1144.2 +067500* .02 RL1144.2 +067600 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1144.2 +067700 MOVE "STATUS/OPEN" TO RE-MARK RL1144.2 +067800 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1144.2 +067900 MOVE "00" TO CORRECT-A RL1144.2 +068000 PERFORM FAIL RL1144.2 +068100 ELSE RL1144.2 +068200 PERFORM PASS. RL1144.2 +068300 PERFORM PRINT-DETAIL. RL1144.2 +068400 ADD 01 TO REC-CT. RL1144.2 +068500* .03 RL1144.2 +068600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +068700 MOVE "STATUS/WRITE" TO RE-MARK RL1144.2 +068800 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +068900 MOVE "00" TO CORRECT-A RL1144.2 +069000 PERFORM FAIL RL1144.2 +069100 ELSE RL1144.2 +069200 PERFORM PASS. RL1144.2 +069300 PERFORM PRINT-DETAIL. RL1144.2 +069400 ADD 01 TO REC-CT. RL1144.2 +069500* .04 RL1144.2 +069600 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +069700 CLOSE RL-FD2. RL1144.2 +069800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +069900 MOVE "CLOSE/STATUS" TO RE-MARK RL1144.2 +070000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +070100 MOVE "00" TO CORRECT-A RL1144.2 +070200 PERFORM FAIL RL1144.2 +070300 ELSE RL1144.2 +070400 PERFORM PASS. RL1144.2 +070500 PERFORM PRINT-DETAIL. RL1144.2 +070600 ADD 01 TO REC-CT. RL1144.2 +070700* .05 RL1144.2 +070800 REL-INIT-010. RL1144.2 +070900 MOVE "REL-TEST-010" TO PAR-NAME. RL1144.2 +071000 MOVE 2 TO WRK-CS-09V00-012. RL1144.2 +071100 MOVE ZERO TO RL-FD2-KEY. RL1144.2 +071200 MOVE ZERO TO WRK-CS-09V00-013. RL1144.2 +071300 MOVE ZERO TO WRK-CS-09V00-014. RL1144.2 +071400 MOVE ZERO TO WRK-CS-09V00-015. RL1144.2 +071500 MOVE ZERO TO WRK-CS-09V00-016. RL1144.2 +071600 MOVE ZERO TO WRK-CS-09V00-017. RL1144.2 +071700 MOVE ZERO TO WRK-CS-09V00-018. RL1144.2 +071800 MOVE 01 TO REC-CT. RL1144.2 +071900 OPEN I-O RL-FD2. RL1144.2 +072000 MOVE SPACE TO WRK-XN-0002-002 RL1144.2 +072100 MOVE SPACE TO WRK-XN-0002-003 RL1144.2 +072200 MOVE SPACE TO WRK-XN-0002-004 RL1144.2 +072300 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1144.2 +072400 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +072500*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1144.2 +072600 MOVE "USE/FILE STATUS" TO FEATURE. RL1144.2 +072700 REL-TEST-010-R. RL1144.2 +072800 ADD 1 TO RL-FD2-KEY. RL1144.2 +072900 ADD 1 TO WRK-CS-09V00-014. RL1144.2 +073000 ADD 1 TO WRK-CS-09V00-015. RL1144.2 +073100 READ RL-FD2. RL1144.2 +073200 IF RL-FD2-STATUS EQUAL TO "23" RL1144.2 +073300 GO TO REL-TEST-010-3. RL1144.2 +073400 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1144.2 +073500 IF WRK-CS-09V00-015 EQUAL TO 5 RL1144.2 +073600 ADD 01 TO UPDATE-NUMBER (2) RL1144.2 +073700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1144.2 +073800 REWRITE RL-FD2R1-F-G-240 RL1144.2 +073900 MOVE ZERO TO WRK-CS-09V00-015 RL1144.2 +074000 GO TO REL-TEST-010-2. RL1144.2 +074100 IF WRK-CS-09V00-014 GREATER 500 RL1144.2 +074200 GO TO REL-TEST-010-3. RL1144.2 +074300 GO TO REL-TEST-010-R. RL1144.2 +074400 REL-TEST-010-2. RL1144.2 +074500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +074600 ADD 1 TO WRK-CS-09V00-016. RL1144.2 +074700 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +074800 GO TO REL-TEST-010-R. RL1144.2 +074900 REL-TEST-010-3. RL1144.2 +075000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1144.2 +075100 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1144.2 +075200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1144.2 +075300 MOVE 1 TO CORRECT-18V0 RL1144.2 +075400 PERFORM FAIL RL1144.2 +075500 ELSE RL1144.2 +075600 PERFORM PASS. RL1144.2 +075700 PERFORM PRINT-DETAIL. RL1144.2 +075800 ADD 01 TO REC-CT. RL1144.2 +075900* .01 RL1144.2 +076000 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1144.2 +076100 MOVE "INCORRECT COUNT" TO RE-MARK RL1144.2 +076200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1144.2 +076300 MOVE 501 TO CORRECT-18V0 RL1144.2 +076400 PERFORM FAIL RL1144.2 +076500 ELSE RL1144.2 +076600 PERFORM PASS. RL1144.2 +076700 PERFORM PRINT-DETAIL. RL1144.2 +076800 ADD 01 TO REC-CT. RL1144.2 +076900* .02 RL1144.2 +077000 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1144.2 +077100 MOVE "OPEN/STATUS" TO RE-MARK RL1144.2 +077200 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1144.2 +077300 MOVE "00" TO CORRECT-A RL1144.2 +077400 PERFORM FAIL RL1144.2 +077500 ELSE RL1144.2 +077600 PERFORM PASS. RL1144.2 +077700 PERFORM PRINT-DETAIL. RL1144.2 +077800 ADD 01 TO REC-CT. RL1144.2 +077900* .03 RL1144.2 +078000 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1144.2 +078100 MOVE "ATEND/STATUS" TO RE-MARK RL1144.2 +078200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +078300 MOVE "23" TO CORRECT-A RL1144.2 +078400 PERFORM FAIL RL1144.2 +078500 ELSE RL1144.2 +078600 PERFORM PASS. RL1144.2 +078700 PERFORM PRINT-DETAIL. RL1144.2 +078800 ADD 01 TO REC-CT. RL1144.2 +078900* .04 RL1144.2 +079000 IF WRK-XN-0002-002 NOT EQUAL TO "23" RL1144.2 +079100 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1144.2 +079200 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1144.2 +079300 MOVE "23" TO CORRECT-A RL1144.2 +079400 PERFORM FAIL RL1144.2 +079500 ELSE RL1144.2 +079600 PERFORM PASS. RL1144.2 +079700 PERFORM PRINT-DETAIL. RL1144.2 +079800 ADD 01 TO REC-CT. RL1144.2 +079900* .05 RL1144.2 +080000 IF WRK-XN-0002-003 NOT EQUAL TO "23" RL1144.2 +080100 MOVE "NO/EXCEPTION" TO RE-MARK RL1144.2 +080200 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1144.2 +080300 MOVE "23" TO CORRECT-A RL1144.2 +080400 PERFORM FAIL RL1144.2 +080500 ELSE RL1144.2 +080600 PERFORM PASS. RL1144.2 +080700 PERFORM PRINT-DETAIL RL1144.2 +080800 ADD 01 TO REC-CT. RL1144.2 +080900* .06 RL1144.2 +081000 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +081100 CLOSE RL-FD2 RL1144.2 +081200 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +081300 MOVE "CLOSE/STATUS" TO RE-MARK RL1144.2 +081400 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +081500 MOVE "00" TO CORRECT-A RL1144.2 +081600 PERFORM FAIL RL1144.2 +081700 ELSE RL1144.2 +081800 PERFORM PASS. RL1144.2 +081900 PERFORM PRINT-DETAIL. RL1144.2 +082000 ADD 01 TO REC-CT. RL1144.2 +082100* .07 RL1144.2 +082200 CCVS-EXIT SECTION. RL1144.2 +082300 CCVS-999999. RL1144.2 +082400 GO TO CLOSE-FILES. RL1144.2 +*END-OF,RL114A +*HEADER,COBOL,RL115A +000100 IDENTIFICATION DIVISION. RL1154.2 +000200 PROGRAM-ID. RL1154.2 +000300 RL115A. RL1154.2 +000400**************************************************************** RL1154.2 +000500* * RL1154.2 +000600* VALIDATION FOR:- * RL1154.2 +000700* * RL1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +000900* * RL1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1154.2 +001100* * RL1154.2 +001200**************************************************************** RL1154.2 +001300* * RL1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1154.2 +001500* * RL1154.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1154.2 +001700* RELATIVE I-O DATA FILE * RL1154.2 +001800* X-55 SYSTEM PRINTER * RL1154.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1154.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1154.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1154.2 +002200* X-82 SOURCE-COMPUTER * RL1154.2 +002300* X-83 OBJECT-COMPUTER. * RL1154.2 +002400* * RL1154.2 +002500**************************************************************** RL1154.2 +002600* RL115A * RL1154.2 +002700**************************************************************** RL1154.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1154.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1154.2 +003000* STATEMENT. RL1154.2 +003100* RL1154.2 +003200* RL1154.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1154.2 +003400* (ACCESS MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RL1154.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1154.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1154.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1154.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1154.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1154.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1154.2 +004100* HAS BEEN SPECIFIED. RL1154.2 +004200* RL1154.2 +004300*************************************************** RL1154.2 +004400 ENVIRONMENT DIVISION. RL1154.2 +004500 CONFIGURATION SECTION. RL1154.2 +004600 SOURCE-COMPUTER. RL1154.2 +004700 XXXXX082. RL1154.2 +004800 OBJECT-COMPUTER. RL1154.2 +004900 XXXXX083. RL1154.2 +005000 INPUT-OUTPUT SECTION. RL1154.2 +005100 FILE-CONTROL. RL1154.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1154.2 +005300 XXXXX055. RL1154.2 +005400 SELECT RL-FD2 ASSIGN RL1154.2 +005500 XXXXX022 RL1154.2 +005600 ORGANIZATION RELATIVE RL1154.2 +005700 ACCESS SEQUENTIAL RL1154.2 +005800 RELATIVE RL-FD2-KEY RL1154.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1154.2 +006000 DATA DIVISION. RL1154.2 +006100 FILE SECTION. RL1154.2 +006200 FD PRINT-FILE. RL1154.2 +006300 01 PRINT-REC PICTURE X(120). RL1154.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1154.2 +006500 FD RL-FD2 RL1154.2 +006600C VALUE OF RL1154.2 +006700C XXXXX074 RL1154.2 +006800C IS RL1154.2 +006900C XXXXX076 RL1154.2 +007000G XXXXX069 RL1154.2 +007100 LABEL RECORDS ARE STANDARD RL1154.2 +007200 BLOCK CONTAINS 1 RECORDS RL1154.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1154.2 +007400 01 RL-FD2R1-F-G-240. RL1154.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1154.2 +007600 05 RL-FD2-GRP-120. RL1154.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1154.2 +007800 PICTURE X OCCURS 120 TIMES. RL1154.2 +007900 WORKING-STORAGE SECTION. RL1154.2 +008000 01 GRP-0001. RL1154.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1154.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1154.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1154.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1154.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1154.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1154.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1154.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1154.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1154.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1154.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1154.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1154.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1154.2 +010100 05 FILLER PICTURE X(48) VALUE RL1154.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1154.2 +010300 05 FILLER PICTURE X(46) VALUE RL1154.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1154.2 +010500 05 FILLER PICTURE X(26) VALUE RL1154.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1154.2 +010700 05 FILLER PICTURE X(37) VALUE RL1154.2 +010800 ",RECKEY= ". RL1154.2 +010900 05 FILLER PICTURE X(38) VALUE RL1154.2 +011000 ",ALTKEY1= ". RL1154.2 +011100 05 FILLER PICTURE X(38) VALUE RL1154.2 +011200 ",ALTKEY2= ". RL1154.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1154.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1154.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1154.2 +011600 07 FILLER PIC X(5). RL1154.2 +011700 07 XFILE-NAME PIC X(6). RL1154.2 +011800 07 FILLER PIC X(8). RL1154.2 +011900 07 XRECORD-NAME PIC X(6). RL1154.2 +012000 07 FILLER PIC X(1). RL1154.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1154.2 +012200 07 FILLER PIC X(7). RL1154.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1154.2 +012400 07 FILLER PIC X(6). RL1154.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1154.2 +012600 07 FILLER PIC X(5). RL1154.2 +012700 07 ODO-NUMBER PIC 9(4). RL1154.2 +012800 07 FILLER PIC X(5). RL1154.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1154.2 +013000 07 FILLER PIC X(7). RL1154.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1154.2 +013200 07 FILLER PIC X(7). RL1154.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1154.2 +013400 07 FILLER PIC X(1). RL1154.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1154.2 +013600 07 FILLER PIC X(6). RL1154.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1154.2 +013800 07 FILLER PIC X(5). RL1154.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1154.2 +014000 07 FILLER PIC X(6). RL1154.2 +014100 07 XLABEL-TYPE PIC X(1). RL1154.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1154.2 +014300 07 FILLER PIC X(8). RL1154.2 +014400 07 XRECORD-KEY PIC X(29). RL1154.2 +014500 07 FILLER PIC X(9). RL1154.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1154.2 +014700 07 FILLER PIC X(9). RL1154.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1154.2 +014900 07 FILLER PIC X(7). RL1154.2 +015000 01 TEST-RESULTS. RL1154.2 +015100 02 FILLER PIC X VALUE SPACE. RL1154.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1154.2 +015300 02 FILLER PIC X VALUE SPACE. RL1154.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1154.2 +015500 02 FILLER PIC X VALUE SPACE. RL1154.2 +015600 02 PAR-NAME. RL1154.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1154.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1154.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1154.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1154.2 +016100 02 RE-MARK PIC X(61). RL1154.2 +016200 01 TEST-COMPUTED. RL1154.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1154.2 +016400 02 FILLER PIC X(17) VALUE RL1154.2 +016500 " COMPUTED=". RL1154.2 +016600 02 COMPUTED-X. RL1154.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1154.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1154.2 +016900 PIC -9(9).9(9). RL1154.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1154.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1154.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1154.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1154.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1154.2 +017500 04 FILLER PIC X. RL1154.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1154.2 +017700 01 TEST-CORRECT. RL1154.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1154.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1154.2 +018000 02 CORRECT-X. RL1154.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1154.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1154.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1154.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1154.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1154.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1154.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1154.2 +018800 04 FILLER PIC X. RL1154.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1154.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1154.2 +019100 01 CCVS-C-1. RL1154.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1154.2 +019300- "SS PARAGRAPH-NAME RL1154.2 +019400- " REMARKS". RL1154.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1154.2 +019600 01 CCVS-C-2. RL1154.2 +019700 02 FILLER PIC X VALUE SPACE. RL1154.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1154.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1154.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1154.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1154.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1154.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1154.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1154.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1154.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1154.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1154.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1154.2 +021300 01 CCVS-H-1. RL1154.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1154.2 +021500 02 FILLER PIC X(42) VALUE RL1154.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1154.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1154.2 +021800 01 CCVS-H-2A. RL1154.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1154.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1154.2 +022100 02 FILLER PIC XXXX VALUE RL1154.2 +022200 "4.2 ". RL1154.2 +022300 02 FILLER PIC X(28) VALUE RL1154.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1154.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1154.2 +022600 RL1154.2 +022700 01 CCVS-H-2B. RL1154.2 +022800 02 FILLER PIC X(15) VALUE RL1154.2 +022900 "TEST RESULT OF ". RL1154.2 +023000 02 TEST-ID PIC X(9). RL1154.2 +023100 02 FILLER PIC X(4) VALUE RL1154.2 +023200 " IN ". RL1154.2 +023300 02 FILLER PIC X(12) VALUE RL1154.2 +023400 " HIGH ". RL1154.2 +023500 02 FILLER PIC X(22) VALUE RL1154.2 +023600 " LEVEL VALIDATION FOR ". RL1154.2 +023700 02 FILLER PIC X(58) VALUE RL1154.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +023900 01 CCVS-H-3. RL1154.2 +024000 02 FILLER PIC X(34) VALUE RL1154.2 +024100 " FOR OFFICIAL USE ONLY ". RL1154.2 +024200 02 FILLER PIC X(58) VALUE RL1154.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1154.2 +024400 02 FILLER PIC X(28) VALUE RL1154.2 +024500 " COPYRIGHT 1985 ". RL1154.2 +024600 01 CCVS-E-1. RL1154.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1154.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1154.2 +024900 02 ID-AGAIN PIC X(9). RL1154.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1154.2 +025100 01 CCVS-E-2. RL1154.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1154.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1154.2 +025400 02 CCVS-E-2-2. RL1154.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1154.2 +025600 03 FILLER PIC X VALUE SPACE. RL1154.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1154.2 +025800 "ERRORS ENCOUNTERED". RL1154.2 +025900 01 CCVS-E-3. RL1154.2 +026000 02 FILLER PIC X(22) VALUE RL1154.2 +026100 " FOR OFFICIAL USE ONLY". RL1154.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1154.2 +026300 02 FILLER PIC X(58) VALUE RL1154.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1154.2 +026600 02 FILLER PIC X(15) VALUE RL1154.2 +026700 " COPYRIGHT 1985". RL1154.2 +026800 01 CCVS-E-4. RL1154.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1154.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1154.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1154.2 +027200 02 FILLER PIC X(40) VALUE RL1154.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1154.2 +027400 01 XXINFO. RL1154.2 +027500 02 FILLER PIC X(19) VALUE RL1154.2 +027600 "*** INFORMATION ***". RL1154.2 +027700 02 INFO-TEXT. RL1154.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1154.2 +027900 04 XXCOMPUTED PIC X(20). RL1154.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1154.2 +028100 04 XXCORRECT PIC X(20). RL1154.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1154.2 +028300 01 HYPHEN-LINE. RL1154.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1154.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1154.2 +028600- "*****************************************". RL1154.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1154.2 +028800- "******************************". RL1154.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1154.2 +029000 "RL115A". RL1154.2 +029100 PROCEDURE DIVISION. RL1154.2 +029200 DECLARATIVES. RL1154.2 +029300 RL-FD2-01 SECTION. RL1154.2 +029400 USE AFTER ERROR PROCEDURE I-O. RL1154.2 +029500 RL-FD2-01-01. RL1154.2 +029600 MOVE "PASS " TO P-OR-F. RL1154.2 +029700 ADD 1 TO PASS-COUNTER. RL1154.2 +029800* RL1154.2 +029900 IF REC-CT NOT EQUAL TO ZERO RL1154.2 +030000 MOVE "." TO PARDOT-X RL1154.2 +030100 MOVE REC-CT TO DOTVALUE. RL1154.2 +030200 MOVE TEST-RESULTS TO PRINT-REC. RL1154.2 +030300 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1154.2 +030400 IF P-OR-F EQUAL TO "FAIL*" RL1154.2 +030500 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1154.2 +030600 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1154.2 +030700 ELSE RL1154.2 +030800 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1154.2 +030900 MOVE SPACE TO P-OR-F. RL1154.2 +031000 MOVE SPACE TO COMPUTED-X. RL1154.2 +031100 MOVE SPACE TO CORRECT-X. RL1154.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1154.2 +031300 MOVE SPACE TO RE-MARK. RL1154.2 +031400 ADD 1 TO WRK-CS-09V00-013. RL1154.2 +031500 MOVE RL-FD2-STATUS TO WRK-XN-0002-002. RL1154.2 +031600 MOVE "10" TO WRK-XN-0002-003. RL1154.2 +031700 GO TO RL-FD2-01-EXIT. RL1154.2 +031800 D1-FAIL-ROUTINE. RL1154.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1154.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1154.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1154.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1154.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1154.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1154.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1154.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1154.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1154.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1154.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1154.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1154.2 +034300 D1-FAIL-ROUTINE-EX. RL1154.2 +034400 EXIT. RL1154.2 +034500 D1-BAIL-OUT. RL1154.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1154.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1154.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1154.2 +034900 GO TO D1-BAIL-OUT-EX. RL1154.2 +035000 D1-BAIL-OUT-WRITE. RL1154.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1154.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1154.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1154.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +036000 D1-BAIL-OUT-EX. RL1154.2 +036100 EXIT. RL1154.2 +036200 D1-WRITE-LINE. RL1154.2 +036300 ADD 1 TO RECORD-COUNT. RL1154.2 +036400Y IF RECORD-COUNT GREATER 50 RL1154.2 +036500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1154.2 +036600Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +036700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1154.2 +036800Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1154.2 +036900Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037000Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +037100Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1154.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037300Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037500Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +037600Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1154.2 +037700Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037800Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +037900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1154.2 +038000Y MOVE ZERO TO RECORD-COUNT. RL1154.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +038300 D1-WRITE-LINE-EXIT. RL1154.2 +038400 EXIT. RL1154.2 +038500 RL-FD2-01-EXIT. RL1154.2 +038600 EXIT. RL1154.2 +038700 END DECLARATIVES. RL1154.2 +038800 CCVS1 SECTION. RL1154.2 +038900 OPEN-FILES. RL1154.2 +039000 OPEN OUTPUT PRINT-FILE. RL1154.2 +039100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1154.2 +039200 MOVE SPACE TO TEST-RESULTS. RL1154.2 +039300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1154.2 +039400 MOVE ZERO TO REC-SKL-SUB. RL1154.2 +039500 PERFORM CCVS-INIT-FILE 9 TIMES. RL1154.2 +039600 CCVS-INIT-FILE. RL1154.2 +039700 ADD 1 TO REC-SKL-SUB. RL1154.2 +039800 MOVE FILE-RECORD-INFO-SKELETON RL1154.2 +039900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1154.2 +040000 CCVS-INIT-EXIT. RL1154.2 +040100 GO TO CCVS1-EXIT. RL1154.2 +040200 CLOSE-FILES. RL1154.2 +040300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1154.2 +040400 TERMINATE-CCVS. RL1154.2 +040500S EXIT PROGRAM. RL1154.2 +040600STERMINATE-CALL. RL1154.2 +040700 STOP RUN. RL1154.2 +040800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1154.2 +040900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1154.2 +041000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1154.2 +041100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1154.2 +041200 MOVE "****TEST DELETED****" TO RE-MARK. RL1154.2 +041300 PRINT-DETAIL. RL1154.2 +041400 IF REC-CT NOT EQUAL TO ZERO RL1154.2 +041500 MOVE "." TO PARDOT-X RL1154.2 +041600 MOVE REC-CT TO DOTVALUE. RL1154.2 +041700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1154.2 +041800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1154.2 +041900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1154.2 +042000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1154.2 +042100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1154.2 +042200 MOVE SPACE TO CORRECT-X. RL1154.2 +042300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1154.2 +042400 MOVE SPACE TO RE-MARK. RL1154.2 +042500 HEAD-ROUTINE. RL1154.2 +042600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +042700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +042800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1154.2 +042900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1154.2 +043000 COLUMN-NAMES-ROUTINE. RL1154.2 +043100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +043200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +043300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +043400 END-ROUTINE. RL1154.2 +043500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1154.2 +043600 END-RTN-EXIT. RL1154.2 +043700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +043800 END-ROUTINE-1. RL1154.2 +043900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1154.2 +044000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1154.2 +044100 ADD PASS-COUNTER TO ERROR-HOLD. RL1154.2 +044200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1154.2 +044300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1154.2 +044400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1154.2 +044500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1154.2 +044600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1154.2 +044700 END-ROUTINE-12. RL1154.2 +044800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1154.2 +044900 IF ERROR-COUNTER IS EQUAL TO ZERO RL1154.2 +045000 MOVE "NO " TO ERROR-TOTAL RL1154.2 +045100 ELSE RL1154.2 +045200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1154.2 +045300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1154.2 +045400 PERFORM WRITE-LINE. RL1154.2 +045500 END-ROUTINE-13. RL1154.2 +045600 IF DELETE-COUNTER IS EQUAL TO ZERO RL1154.2 +045700 MOVE "NO " TO ERROR-TOTAL ELSE RL1154.2 +045800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1154.2 +045900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1154.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046100 IF INSPECT-COUNTER EQUAL TO ZERO RL1154.2 +046200 MOVE "NO " TO ERROR-TOTAL RL1154.2 +046300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1154.2 +046400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1154.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046700 WRITE-LINE. RL1154.2 +046800 ADD 1 TO RECORD-COUNT. RL1154.2 +046900Y IF RECORD-COUNT GREATER 50 RL1154.2 +047000Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1154.2 +047100Y MOVE SPACE TO DUMMY-RECORD RL1154.2 +047200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1154.2 +047300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1154.2 +047400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1154.2 +047500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1154.2 +047600Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1154.2 +047700Y MOVE ZERO TO RECORD-COUNT. RL1154.2 +047800 PERFORM WRT-LN. RL1154.2 +047900 WRT-LN. RL1154.2 +048000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +048100 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +048200 BLANK-LINE-PRINT. RL1154.2 +048300 PERFORM WRT-LN. RL1154.2 +048400 FAIL-ROUTINE. RL1154.2 +048500 IF COMPUTED-X NOT EQUAL TO SPACE RL1154.2 +048600 GO TO FAIL-ROUTINE-WRITE. RL1154.2 +048700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1154.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +048900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1154.2 +049000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +049200 GO TO FAIL-ROUTINE-EX. RL1154.2 +049300 FAIL-ROUTINE-WRITE. RL1154.2 +049400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1154.2 +049500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1154.2 +049600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1154.2 +049700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1154.2 +049800 FAIL-ROUTINE-EX. EXIT. RL1154.2 +049900 BAIL-OUT. RL1154.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1154.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1154.2 +050200 BAIL-OUT-WRITE. RL1154.2 +050300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1154.2 +050400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +050700 BAIL-OUT-EX. EXIT. RL1154.2 +050800 CCVS1-EXIT. RL1154.2 +050900 EXIT. RL1154.2 +051000 SECT-RL115A-001 SECTION. RL1154.2 +051100 REL-INIT-009. RL1154.2 +051200 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1154.2 +051300 MOVE "REL-TEST-009" TO PAR-NAME. RL1154.2 +051400 MOVE "CREATE RL-FD2" TO FEATURE RL1154.2 +051500 MOVE "RL-FD2" TO XFILE-NAME (2). RL1154.2 +051600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1154.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1154.2 +051800 MOVE 000240 TO XRECORD-LENGTH (2). RL1154.2 +051900 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1154.2 +052000 MOVE 0001 TO XBLOCK-SIZE (2). RL1154.2 +052100 MOVE 000500 TO RECORDS-IN-FILE (2). RL1154.2 +052200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1154.2 +052300 MOVE "S" TO XLABEL-TYPE (2). RL1154.2 +052400 MOVE 000001 TO XRECORD-NUMBER (2). RL1154.2 +052500*INITIALIZE RECORD WORK AREA NUMBER 2. RL1154.2 +052600 MOVE 1 TO WRK-CS-09V00-012. RL1154.2 +052700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1154.2 +052800 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1154.2 +052900 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1154.2 +053000 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +053100 MOVE 90000002 TO RL-FD2-KEY. RL1154.2 +053200 MOVE 01 TO REC-CT. RL1154.2 +053300 OPEN OUTPUT RL-FD2. RL1154.2 +053400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1154.2 +053500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1154.2 +053600 REL-TEST-009-R. RL1154.2 +053700 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1154.2 +053800 MOVE "99" TO RL-FD2-STATUS. RL1154.2 +053900 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1154.2 +054000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1154.2 +054100 RL-FD2-GRP-120. RL1154.2 +054200 WRITE RL-FD2R1-F-G-240 INVALID KEY RL1154.2 +054300 GO TO REL-TEST-009-2. RL1154.2 +054400 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +054500 GO TO REL-TEST-009-2. RL1154.2 +054600 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1154.2 +054700 GO TO REL-TEST-009-2. RL1154.2 +054800 ADD 01 TO XRECORD-NUMBER (2). RL1154.2 +054900 GO TO REL-TEST-009-R. RL1154.2 +055000 REL-TEST-009-2. RL1154.2 +055100 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1154.2 +055200 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1154.2 +055300 MOVE ZERO TO CORRECT-18V0 RL1154.2 +055400 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1154.2 +055500 PERFORM FAIL RL1154.2 +055600 ELSE RL1154.2 +055700 PERFORM PASS. RL1154.2 +055800 PERFORM PRINT-DETAIL. RL1154.2 +055900 ADD 01 TO REC-CT. RL1154.2 +056000* .01 RL1154.2 +056100 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1154.2 +056200 MOVE "INCORRECT COUNT" TO RE-MARK RL1154.2 +056300 MOVE 500 TO CORRECT-18V0 RL1154.2 +056400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1154.2 +056500 PERFORM FAIL RL1154.2 +056600 ELSE RL1154.2 +056700 PERFORM PASS. RL1154.2 +056800 PERFORM PRINT-DETAIL. RL1154.2 +056900 ADD 01 TO REC-CT. RL1154.2 +057000* .02 RL1154.2 +057100 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1154.2 +057200 MOVE "STATUS/OPEN" TO RE-MARK RL1154.2 +057300 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1154.2 +057400 MOVE "00" TO CORRECT-A RL1154.2 +057500 PERFORM FAIL RL1154.2 +057600 ELSE RL1154.2 +057700 PERFORM PASS. RL1154.2 +057800 PERFORM PRINT-DETAIL. RL1154.2 +057900 ADD 01 TO REC-CT. RL1154.2 +058000* .03 RL1154.2 +058100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +058200 MOVE "STATUS/WRITE" TO RE-MARK RL1154.2 +058300 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +058400 MOVE "00" TO CORRECT-A RL1154.2 +058500 PERFORM FAIL RL1154.2 +058600 ELSE RL1154.2 +058700 PERFORM PASS. RL1154.2 +058800 PERFORM PRINT-DETAIL. RL1154.2 +058900 ADD 01 TO REC-CT. RL1154.2 +059000* .04 RL1154.2 +059100 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +059200 CLOSE RL-FD2. RL1154.2 +059300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +059400 MOVE "CLOSE/STATUS" TO RE-MARK RL1154.2 +059500 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +059600 MOVE "00" TO CORRECT-A RL1154.2 +059700 PERFORM FAIL RL1154.2 +059800 ELSE RL1154.2 +059900 PERFORM PASS. RL1154.2 +060000 PERFORM PRINT-DETAIL. RL1154.2 +060100 ADD 01 TO REC-CT. RL1154.2 +060200* .05 RL1154.2 +060300 REL-INIT-010. RL1154.2 +060400 MOVE "REL-TEST-010" TO PAR-NAME. RL1154.2 +060500 MOVE 2 TO WRK-CS-09V00-012. RL1154.2 +060600 MOVE ZERO TO RL-FD2-KEY. RL1154.2 +060700 MOVE ZERO TO WRK-CS-09V00-013. RL1154.2 +060800 MOVE ZERO TO WRK-CS-09V00-014. RL1154.2 +060900 MOVE ZERO TO WRK-CS-09V00-015. RL1154.2 +061000 MOVE ZERO TO WRK-CS-09V00-016. RL1154.2 +061100 MOVE ZERO TO WRK-CS-09V00-017. RL1154.2 +061200 MOVE ZERO TO WRK-CS-09V00-018. RL1154.2 +061300 MOVE 01 TO REC-CT. RL1154.2 +061400 OPEN I-O RL-FD2. RL1154.2 +061500 MOVE SPACE TO WRK-XN-0002-002 RL1154.2 +061600 MOVE SPACE TO WRK-XN-0002-003 RL1154.2 +061700 MOVE SPACE TO WRK-XN-0002-004 RL1154.2 +061800 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1154.2 +061900 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +062000*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1154.2 +062100 MOVE "USE/FILE STATUS" TO FEATURE. RL1154.2 +062200 REL-TEST-010-R. RL1154.2 +062300 ADD 1 TO RL-FD2-KEY. RL1154.2 +062400 ADD 1 TO WRK-CS-09V00-014. RL1154.2 +062500 ADD 1 TO WRK-CS-09V00-015. RL1154.2 +062600 READ RL-FD2. RL1154.2 +062700 IF RL-FD2-STATUS EQUAL TO "10" RL1154.2 +062800 GO TO REL-TEST-010-3. RL1154.2 +062900 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1154.2 +063000 IF WRK-CS-09V00-015 EQUAL TO 5 RL1154.2 +063100 ADD 01 TO UPDATE-NUMBER (2) RL1154.2 +063200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1154.2 +063300 REWRITE RL-FD2R1-F-G-240 RL1154.2 +063400 MOVE ZERO TO WRK-CS-09V00-015 RL1154.2 +063500 GO TO REL-TEST-010-2. RL1154.2 +063600 IF WRK-CS-09V00-014 GREATER 500 RL1154.2 +063700 GO TO REL-TEST-010-3. RL1154.2 +063800 GO TO REL-TEST-010-R. RL1154.2 +063900 REL-TEST-010-2. RL1154.2 +064000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +064100 ADD 1 TO WRK-CS-09V00-016. RL1154.2 +064200 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +064300 GO TO REL-TEST-010-R. RL1154.2 +064400 REL-TEST-010-3. RL1154.2 +064500 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1154.2 +064600 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1154.2 +064700 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1154.2 +064800 MOVE 1 TO CORRECT-18V0 RL1154.2 +064900 PERFORM FAIL RL1154.2 +065000 ELSE RL1154.2 +065100 PERFORM PASS. RL1154.2 +065200 PERFORM PRINT-DETAIL. RL1154.2 +065300 ADD 01 TO REC-CT. RL1154.2 +065400* .01 RL1154.2 +065500 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1154.2 +065600 MOVE "INCORRECT COUNT" TO RE-MARK RL1154.2 +065700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1154.2 +065800 MOVE 501 TO CORRECT-18V0 RL1154.2 +065900 PERFORM FAIL RL1154.2 +066000 ELSE RL1154.2 +066100 PERFORM PASS. RL1154.2 +066200 PERFORM PRINT-DETAIL. RL1154.2 +066300 ADD 01 TO REC-CT. RL1154.2 +066400* .02 RL1154.2 +066500 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1154.2 +066600 MOVE "OPEN/STATUS" TO RE-MARK RL1154.2 +066700 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1154.2 +066800 MOVE "00" TO CORRECT-A RL1154.2 +066900 PERFORM FAIL RL1154.2 +067000 ELSE RL1154.2 +067100 PERFORM PASS. RL1154.2 +067200 PERFORM PRINT-DETAIL. RL1154.2 +067300 ADD 01 TO REC-CT. RL1154.2 +067400* .03 RL1154.2 +067500 IF RL-FD2-STATUS NOT EQUAL TO "10" RL1154.2 +067600 MOVE "ATEND/STATUS" TO RE-MARK RL1154.2 +067700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +067800 MOVE "10" TO CORRECT-A RL1154.2 +067900 PERFORM FAIL RL1154.2 +068000 ELSE RL1154.2 +068100 PERFORM PASS. RL1154.2 +068200 PERFORM PRINT-DETAIL. RL1154.2 +068300 ADD 01 TO REC-CT. RL1154.2 +068400* .04 RL1154.2 +068500 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1154.2 +068600 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1154.2 +068700 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1154.2 +068800 MOVE "10" TO CORRECT-A RL1154.2 +068900 PERFORM FAIL RL1154.2 +069000 ELSE RL1154.2 +069100 PERFORM PASS. RL1154.2 +069200 PERFORM PRINT-DETAIL. RL1154.2 +069300 ADD 01 TO REC-CT. RL1154.2 +069400* .05 RL1154.2 +069500 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1154.2 +069600 MOVE "NO/EXCEPTION" TO RE-MARK RL1154.2 +069700 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1154.2 +069800 MOVE "10" TO CORRECT-A RL1154.2 +069900 PERFORM FAIL RL1154.2 +070000 ELSE RL1154.2 +070100 PERFORM PASS. RL1154.2 +070200 PERFORM PRINT-DETAIL RL1154.2 +070300 ADD 01 TO REC-CT. RL1154.2 +070400* .06 RL1154.2 +070500 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +070600 CLOSE RL-FD2 RL1154.2 +070700 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +070800 MOVE "CLOSE/STATUS" TO RE-MARK RL1154.2 +070900 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +071000 MOVE "00" TO CORRECT-A RL1154.2 +071100 PERFORM FAIL RL1154.2 +071200 ELSE RL1154.2 +071300 PERFORM PASS. RL1154.2 +071400 PERFORM PRINT-DETAIL. RL1154.2 +071500 ADD 01 TO REC-CT. RL1154.2 +071600* .07 RL1154.2 +071700 CCVS-EXIT SECTION. RL1154.2 +071800 CCVS-999999. RL1154.2 +071900 GO TO CLOSE-FILES. RL1154.2 +*END-OF,RL115A +*HEADER,COBOL,RL116A +000100 IDENTIFICATION DIVISION. RL1164.2 +000200 PROGRAM-ID. RL1164.2 +000300 RL116A. RL1164.2 +000400**************************************************************** RL1164.2 +000500* * RL1164.2 +000600* VALIDATION FOR:- * RL1164.2 +000700* * RL1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +000900* * RL1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1164.2 +001100* * RL1164.2 +001200**************************************************************** RL1164.2 +001300* * RL1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1164.2 +001500* * RL1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1164.2 +001900* * RL1164.2 +002000**************************************************************** RL1164.2 +002100* * RL1164.2 +002200* X-CARDS USED BY THIS PROGRAM ARE :- * RL1164.2 +002300* * RL1164.2 +002400* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1164.2 +002500* RELATIVE I-O DATA FILE * RL1164.2 +002600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1164.2 +002700* RELATIVE I-O DATA FILE * RL1164.2 +002800* X-55 SYSTEM PRINTER * RL1164.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1164.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1164.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE * RL1164.2 +003200* X-82 SOURCE-COMPUTER * RL1164.2 +003300* X-83 OBJECT-COMPUTER. * RL1164.2 +003400* * RL1164.2 +003500**************************************************************** RL1164.2 +003600* RL116A * RL1164.2 +003700**************************************************************** RL1164.2 +003800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1164.2 +003900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" RL1164.2 +004000* CLAUSE FOR THE VALUES "00" AND "10". RL1164.2 +004100* RL1164.2 +004200* RL1164.2 +004300* RL1164.2 +004400*************************************************** RL1164.2 +004500 ENVIRONMENT DIVISION. RL1164.2 +004600 CONFIGURATION SECTION. RL1164.2 +004700 SOURCE-COMPUTER. RL1164.2 +004800 XXXXX082. RL1164.2 +004900 OBJECT-COMPUTER. RL1164.2 +005000 XXXXX083. RL1164.2 +005100 INPUT-OUTPUT SECTION. RL1164.2 +005200 FILE-CONTROL. RL1164.2 +005300 SELECT PRINT-FILE ASSIGN TO RL1164.2 +005400 XXXXX055. RL1164.2 +005500 SELECT RL-FD2 ASSIGN RL1164.2 +005600 XXXXX022 RL1164.2 +005700 ORGANIZATION RELATIVE RL1164.2 +005800 ACCESS RANDOM RL1164.2 +005900 RELATIVE RL-FD2-KEY RL1164.2 +006000 FILE STATUS IS RL-FD2-STATUS. RL1164.2 +006100 SELECT RL-FD3 ASSIGN RL1164.2 +006200 XXXXX022 RL1164.2 +006300 ORGANIZATION RELATIVE RL1164.2 +006400 ACCESS SEQUENTIAL RL1164.2 +006500 RELATIVE RL-FD3-KEY RL1164.2 +006600 FILE STATUS IS RL-FD3-STATUS. RL1164.2 +006700 DATA DIVISION. RL1164.2 +006800 FILE SECTION. RL1164.2 +006900 FD PRINT-FILE. RL1164.2 +007000 01 PRINT-REC PICTURE X(120). RL1164.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1164.2 +007200 FD RL-FD2 RL1164.2 +007300C VALUE OF RL1164.2 +007400C XXXXX074 RL1164.2 +007500C IS RL1164.2 +007600C XXXXX076 RL1164.2 +007700G XXXXX069 RL1164.2 +007800 LABEL RECORDS ARE STANDARD RL1164.2 +007900 BLOCK CONTAINS 1 RECORDS RL1164.2 +008000 DATA RECORD RL-FD2R1-F-G-240. RL1164.2 +008100 01 RL-FD2R1-F-G-240. RL1164.2 +008200 05 RL-FD2-WRK-120 PIC X(120). RL1164.2 +008300 05 RL-FD2-GRP-120. RL1164.2 +008400 10 RL-FD2-WRK-XN-0001-O120F RL1164.2 +008500 PICTURE X OCCURS 120 TIMES. RL1164.2 +008600 FD RL-FD3 RL1164.2 +008700C VALUE OF RL1164.2 +008800C XXXXX074 RL1164.2 +008900C IS RL1164.2 +009000C XXXXX076 RL1164.2 +009100G XXXXX069 RL1164.2 +009200 LABEL RECORDS ARE STANDARD RL1164.2 +009300 BLOCK CONTAINS 1 RECORDS RL1164.2 +009400 DATA RECORD RL-FD3R1-F-G-240. RL1164.2 +009500 01 RL-FD3R1-F-G-240. RL1164.2 +009600 05 RL-FD3-WRK-120 PIC X(120). RL1164.2 +009700 05 RL-FD3-GRP-130. RL1164.2 +009800 10 RL-FD3-WRK-XN-0001-O120F RL1164.2 +009900 PICTURE X OCCURS 120 TIMES. RL1164.2 +010000 WORKING-STORAGE SECTION. RL1164.2 +010100 01 GRP-0001. RL1164.2 +010200 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1164.2 +010300 05 RL-FD3-KEY PIC 9(8) VALUE ZERO. RL1164.2 +010400 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010500 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010600 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010700 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010800 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010900 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +011000 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +011100 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1164.2 +011200 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1164.2 +011300 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1164.2 +011400 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1164.2 +011500 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1164.2 +011600 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1164.2 +011700 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1164.2 +011800 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1164.2 +011900 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1164.2 +012000 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1164.2 +012100 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1164.2 +012200 01 FILE-RECORD-INFORMATION-REC. RL1164.2 +012300 03 FILE-RECORD-INFO-SKELETON. RL1164.2 +012400 05 FILLER PICTURE X(48) VALUE RL1164.2 +012500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1164.2 +012600 05 FILLER PICTURE X(46) VALUE RL1164.2 +012700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1164.2 +012800 05 FILLER PICTURE X(26) VALUE RL1164.2 +012900 ",LFIL=000000,ORG= ,LBLR= ". RL1164.2 +013000 05 FILLER PICTURE X(37) VALUE RL1164.2 +013100 ",RECKEY= ". RL1164.2 +013200 05 FILLER PICTURE X(38) VALUE RL1164.2 +013300 ",ALTKEY1= ". RL1164.2 +013400 05 FILLER PICTURE X(38) VALUE RL1164.2 +013500 ",ALTKEY2= ". RL1164.2 +013600 05 FILLER PICTURE X(7) VALUE SPACE.RL1164.2 +013700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1164.2 +013800 05 FILE-RECORD-INFO-P1-120. RL1164.2 +013900 07 FILLER PIC X(5). RL1164.2 +014000 07 XFILE-NAME PIC X(6). RL1164.2 +014100 07 FILLER PIC X(8). RL1164.2 +014200 07 XRECORD-NAME PIC X(6). RL1164.2 +014300 07 FILLER PIC X(1). RL1164.2 +014400 07 REELUNIT-NUMBER PIC 9(1). RL1164.2 +014500 07 FILLER PIC X(7). RL1164.2 +014600 07 XRECORD-NUMBER PIC 9(6). RL1164.2 +014700 07 FILLER PIC X(6). RL1164.2 +014800 07 UPDATE-NUMBER PIC 9(2). RL1164.2 +014900 07 FILLER PIC X(5). RL1164.2 +015000 07 ODO-NUMBER PIC 9(4). RL1164.2 +015100 07 FILLER PIC X(5). RL1164.2 +015200 07 XPROGRAM-NAME PIC X(5). RL1164.2 +015300 07 FILLER PIC X(7). RL1164.2 +015400 07 XRECORD-LENGTH PIC 9(6). RL1164.2 +015500 07 FILLER PIC X(7). RL1164.2 +015600 07 CHARS-OR-RECORDS PIC X(2). RL1164.2 +015700 07 FILLER PIC X(1). RL1164.2 +015800 07 XBLOCK-SIZE PIC 9(4). RL1164.2 +015900 07 FILLER PIC X(6). RL1164.2 +016000 07 RECORDS-IN-FILE PIC 9(6). RL1164.2 +016100 07 FILLER PIC X(5). RL1164.2 +016200 07 XFILE-ORGANIZATION PIC X(2). RL1164.2 +016300 07 FILLER PIC X(6). RL1164.2 +016400 07 XLABEL-TYPE PIC X(1). RL1164.2 +016500 05 FILE-RECORD-INFO-P121-240. RL1164.2 +016600 07 FILLER PIC X(8). RL1164.2 +016700 07 XRECORD-KEY PIC X(29). RL1164.2 +016800 07 FILLER PIC X(9). RL1164.2 +016900 07 ALTERNATE-KEY1 PIC X(29). RL1164.2 +017000 07 FILLER PIC X(9). RL1164.2 +017100 07 ALTERNATE-KEY2 PIC X(29). RL1164.2 +017200 07 FILLER PIC X(7). RL1164.2 +017300 01 TEST-RESULTS. RL1164.2 +017400 02 FILLER PIC X VALUE SPACE. RL1164.2 +017500 02 FEATURE PIC X(20) VALUE SPACE. RL1164.2 +017600 02 FILLER PIC X VALUE SPACE. RL1164.2 +017700 02 P-OR-F PIC X(5) VALUE SPACE. RL1164.2 +017800 02 FILLER PIC X VALUE SPACE. RL1164.2 +017900 02 PAR-NAME. RL1164.2 +018000 03 FILLER PIC X(19) VALUE SPACE. RL1164.2 +018100 03 PARDOT-X PIC X VALUE SPACE. RL1164.2 +018200 03 DOTVALUE PIC 99 VALUE ZERO. RL1164.2 +018300 02 FILLER PIC X(8) VALUE SPACE. RL1164.2 +018400 02 RE-MARK PIC X(61). RL1164.2 +018500 01 TEST-COMPUTED. RL1164.2 +018600 02 FILLER PIC X(30) VALUE SPACE. RL1164.2 +018700 02 FILLER PIC X(17) VALUE RL1164.2 +018800 " COMPUTED=". RL1164.2 +018900 02 COMPUTED-X. RL1164.2 +019000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1164.2 +019100 03 COMPUTED-N REDEFINES COMPUTED-A RL1164.2 +019200 PIC -9(9).9(9). RL1164.2 +019300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1164.2 +019400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1164.2 +019500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1164.2 +019600 03 CM-18V0 REDEFINES COMPUTED-A. RL1164.2 +019700 04 COMPUTED-18V0 PIC -9(18). RL1164.2 +019800 04 FILLER PIC X. RL1164.2 +019900 03 FILLER PIC X(50) VALUE SPACE. RL1164.2 +020000 01 TEST-CORRECT. RL1164.2 +020100 02 FILLER PIC X(30) VALUE SPACE. RL1164.2 +020200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1164.2 +020300 02 CORRECT-X. RL1164.2 +020400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1164.2 +020500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1164.2 +020600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1164.2 +020700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1164.2 +020800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1164.2 +020900 03 CR-18V0 REDEFINES CORRECT-A. RL1164.2 +021000 04 CORRECT-18V0 PIC -9(18). RL1164.2 +021100 04 FILLER PIC X. RL1164.2 +021200 03 FILLER PIC X(2) VALUE SPACE. RL1164.2 +021300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1164.2 +021400 01 CCVS-C-1. RL1164.2 +021500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1164.2 +021600- "SS PARAGRAPH-NAME RL1164.2 +021700- " REMARKS". RL1164.2 +021800 02 FILLER PIC X(20) VALUE SPACE. RL1164.2 +021900 01 CCVS-C-2. RL1164.2 +022000 02 FILLER PIC X VALUE SPACE. RL1164.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". RL1164.2 +022200 02 FILLER PIC X(15) VALUE SPACE. RL1164.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". RL1164.2 +022400 02 FILLER PIC X(94) VALUE SPACE. RL1164.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1164.2 +022600 01 REC-CT PIC 99 VALUE ZERO. RL1164.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1164.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1164.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1164.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1164.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1164.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1164.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1164.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1164.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1164.2 +023600 01 CCVS-H-1. RL1164.2 +023700 02 FILLER PIC X(39) VALUE SPACES. RL1164.2 +023800 02 FILLER PIC X(42) VALUE RL1164.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1164.2 +024000 02 FILLER PIC X(39) VALUE SPACES. RL1164.2 +024100 01 CCVS-H-2A. RL1164.2 +024200 02 FILLER PIC X(40) VALUE SPACE. RL1164.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1164.2 +024400 02 FILLER PIC XXXX VALUE RL1164.2 +024500 "4.2 ". RL1164.2 +024600 02 FILLER PIC X(28) VALUE RL1164.2 +024700 " COPY - NOT FOR DISTRIBUTION". RL1164.2 +024800 02 FILLER PIC X(41) VALUE SPACE. RL1164.2 +024900 RL1164.2 +025000 01 CCVS-H-2B. RL1164.2 +025100 02 FILLER PIC X(15) VALUE RL1164.2 +025200 "TEST RESULT OF ". RL1164.2 +025300 02 TEST-ID PIC X(9). RL1164.2 +025400 02 FILLER PIC X(4) VALUE RL1164.2 +025500 " IN ". RL1164.2 +025600 02 FILLER PIC X(12) VALUE RL1164.2 +025700 " HIGH ". RL1164.2 +025800 02 FILLER PIC X(22) VALUE RL1164.2 +025900 " LEVEL VALIDATION FOR ". RL1164.2 +026000 02 FILLER PIC X(58) VALUE RL1164.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +026200 01 CCVS-H-3. RL1164.2 +026300 02 FILLER PIC X(34) VALUE RL1164.2 +026400 " FOR OFFICIAL USE ONLY ". RL1164.2 +026500 02 FILLER PIC X(58) VALUE RL1164.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1164.2 +026700 02 FILLER PIC X(28) VALUE RL1164.2 +026800 " COPYRIGHT 1985 ". RL1164.2 +026900 01 CCVS-E-1. RL1164.2 +027000 02 FILLER PIC X(52) VALUE SPACE. RL1164.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1164.2 +027200 02 ID-AGAIN PIC X(9). RL1164.2 +027300 02 FILLER PIC X(45) VALUE SPACES. RL1164.2 +027400 01 CCVS-E-2. RL1164.2 +027500 02 FILLER PIC X(31) VALUE SPACE. RL1164.2 +027600 02 FILLER PIC X(21) VALUE SPACE. RL1164.2 +027700 02 CCVS-E-2-2. RL1164.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1164.2 +027900 03 FILLER PIC X VALUE SPACE. RL1164.2 +028000 03 ENDER-DESC PIC X(44) VALUE RL1164.2 +028100 "ERRORS ENCOUNTERED". RL1164.2 +028200 01 CCVS-E-3. RL1164.2 +028300 02 FILLER PIC X(22) VALUE RL1164.2 +028400 " FOR OFFICIAL USE ONLY". RL1164.2 +028500 02 FILLER PIC X(12) VALUE SPACE. RL1164.2 +028600 02 FILLER PIC X(58) VALUE RL1164.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +028800 02 FILLER PIC X(13) VALUE SPACE. RL1164.2 +028900 02 FILLER PIC X(15) VALUE RL1164.2 +029000 " COPYRIGHT 1985". RL1164.2 +029100 01 CCVS-E-4. RL1164.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1164.2 +029300 02 FILLER PIC X(4) VALUE " OF ". RL1164.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1164.2 +029500 02 FILLER PIC X(40) VALUE RL1164.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1164.2 +029700 01 XXINFO. RL1164.2 +029800 02 FILLER PIC X(19) VALUE RL1164.2 +029900 "*** INFORMATION ***". RL1164.2 +030000 02 INFO-TEXT. RL1164.2 +030100 04 FILLER PIC X(8) VALUE SPACE. RL1164.2 +030200 04 XXCOMPUTED PIC X(20). RL1164.2 +030300 04 FILLER PIC X(5) VALUE SPACE. RL1164.2 +030400 04 XXCORRECT PIC X(20). RL1164.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). RL1164.2 +030600 01 HYPHEN-LINE. RL1164.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. RL1164.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************RL1164.2 +030900- "*****************************************". RL1164.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************RL1164.2 +031100- "******************************". RL1164.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE RL1164.2 +031300 "RL116A". RL1164.2 +031400 PROCEDURE DIVISION. RL1164.2 +031500 DECLARATIVES. RL1164.2 +031600 RL-FD2-01 SECTION. RL1164.2 +031700 USE AFTER ERROR PROCEDURE I-O. RL1164.2 +031800 RL-FD2-01-01. RL1164.2 +031900 MOVE "PASS " TO P-OR-F. RL1164.2 +032000 ADD 1 TO PASS-COUNTER. RL1164.2 +032100* RL1164.2 +032200 IF REC-CT NOT EQUAL TO ZERO RL1164.2 +032300 MOVE "." TO PARDOT-X RL1164.2 +032400 MOVE REC-CT TO DOTVALUE. RL1164.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. RL1164.2 +032600 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1164.2 +032700 IF P-OR-F EQUAL TO "FAIL*" RL1164.2 +032800 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1164.2 +032900 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1164.2 +033000 ELSE RL1164.2 +033100 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1164.2 +033200 MOVE SPACE TO P-OR-F. RL1164.2 +033300 MOVE SPACE TO COMPUTED-X. RL1164.2 +033400 MOVE SPACE TO CORRECT-X. RL1164.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1164.2 +033600 MOVE SPACE TO RE-MARK. RL1164.2 +033700 GO TO RL-FD2-01-EXIT. RL1164.2 +033800 D1-FAIL-ROUTINE. RL1164.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE RL1164.2 +034000 GO TO D1-FAIL-ROUTINE-WRITE. RL1164.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE RL1164.2 +034200 GO TO D1-FAIL-ROUTINE-WRITE. RL1164.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1164.2 +034500 MOVE XXINFO TO DUMMY-RECORD. RL1164.2 +034600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +034700 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +034800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +034900 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +035100 GO TO D1-FAIL-ROUTINE-EX. RL1164.2 +035200 D1-FAIL-ROUTINE-WRITE. RL1164.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC. RL1164.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +035500 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1164.2 +035700 MOVE TEST-CORRECT TO PRINT-REC. RL1164.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +035900 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +036100 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +036200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1164.2 +036300 D1-FAIL-ROUTINE-EX. RL1164.2 +036400 EXIT. RL1164.2 +036500 D1-BAIL-OUT. RL1164.2 +036600 IF COMPUTED-A NOT EQUAL TO SPACE RL1164.2 +036700 GO TO D1-BAIL-OUT-WRITE. RL1164.2 +036800 IF CORRECT-A EQUAL TO SPACE RL1164.2 +036900 GO TO D1-BAIL-OUT-EX. RL1164.2 +037000 D1-BAIL-OUT-WRITE. RL1164.2 +037100 MOVE CORRECT-A TO XXCORRECT. RL1164.2 +037200 MOVE COMPUTED-A TO XXCOMPUTED. RL1164.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +037400 MOVE XXINFO TO DUMMY-RECORD. RL1164.2 +037500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +037600 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +037800 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +038000 D1-BAIL-OUT-EX. RL1164.2 +038100 EXIT. RL1164.2 +038200 D1-WRITE-LINE. RL1164.2 +038300 ADD 1 TO RECORD-COUNT. RL1164.2 +038400Y IF RECORD-COUNT GREATER 50 RL1164.2 +038500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1164.2 +038600Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +038700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1164.2 +038800Y MOVE CCVS-C-1 TO DUMMY-RECORD RL1164.2 +038900Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039000Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +039100Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1164.2 +039200Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039300Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +039400Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039500Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +039600Y MOVE HYPHEN-LINE TO DUMMY-RECORD RL1164.2 +039700Y WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039800Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +039900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1164.2 +040000Y MOVE ZERO TO RECORD-COUNT. RL1164.2 +040100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +040200 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +040300 D1-WRITE-LINE-EXIT. RL1164.2 +040400 EXIT. RL1164.2 +040500 RL-FD2-01-EXIT. RL1164.2 +040600 EXIT. RL1164.2 +040700 END DECLARATIVES. RL1164.2 +040800 CCVS1 SECTION. RL1164.2 +040900 OPEN-FILES. RL1164.2 +041000 OPEN OUTPUT PRINT-FILE. RL1164.2 +041100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1164.2 +041200 MOVE SPACE TO TEST-RESULTS. RL1164.2 +041300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1164.2 +041400 MOVE ZERO TO REC-SKL-SUB. RL1164.2 +041500 PERFORM CCVS-INIT-FILE 9 TIMES. RL1164.2 +041600 CCVS-INIT-FILE. RL1164.2 +041700 ADD 1 TO REC-SKL-SUB. RL1164.2 +041800 MOVE FILE-RECORD-INFO-SKELETON RL1164.2 +041900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1164.2 +042000 CCVS-INIT-EXIT. RL1164.2 +042100 GO TO CCVS1-EXIT. RL1164.2 +042200 CLOSE-FILES. RL1164.2 +042300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1164.2 +042400 TERMINATE-CCVS. RL1164.2 +042500S EXIT PROGRAM. RL1164.2 +042600STERMINATE-CALL. RL1164.2 +042700 STOP RUN. RL1164.2 +042800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1164.2 +042900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1164.2 +043000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1164.2 +043100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1164.2 +043200 MOVE "****TEST DELETED****" TO RE-MARK. RL1164.2 +043300 PRINT-DETAIL. RL1164.2 +043400 IF REC-CT NOT EQUAL TO ZERO RL1164.2 +043500 MOVE "." TO PARDOT-X RL1164.2 +043600 MOVE REC-CT TO DOTVALUE. RL1164.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1164.2 +043800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1164.2 +043900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1164.2 +044000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1164.2 +044100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1164.2 +044200 MOVE SPACE TO CORRECT-X. RL1164.2 +044300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1164.2 +044400 MOVE SPACE TO RE-MARK. RL1164.2 +044500 HEAD-ROUTINE. RL1164.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1164.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1164.2 +045000 COLUMN-NAMES-ROUTINE. RL1164.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +045400 END-ROUTINE. RL1164.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1164.2 +045600 END-RTN-EXIT. RL1164.2 +045700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +045800 END-ROUTINE-1. RL1164.2 +045900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1164.2 +046000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1164.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. RL1164.2 +046200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1164.2 +046300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1164.2 +046400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1164.2 +046500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1164.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1164.2 +046700 END-ROUTINE-12. RL1164.2 +046800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1164.2 +046900 IF ERROR-COUNTER IS EQUAL TO ZERO RL1164.2 +047000 MOVE "NO " TO ERROR-TOTAL RL1164.2 +047100 ELSE RL1164.2 +047200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1164.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1164.2 +047400 PERFORM WRITE-LINE. RL1164.2 +047500 END-ROUTINE-13. RL1164.2 +047600 IF DELETE-COUNTER IS EQUAL TO ZERO RL1164.2 +047700 MOVE "NO " TO ERROR-TOTAL ELSE RL1164.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1164.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1164.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048100 IF INSPECT-COUNTER EQUAL TO ZERO RL1164.2 +048200 MOVE "NO " TO ERROR-TOTAL RL1164.2 +048300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1164.2 +048400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1164.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048700 WRITE-LINE. RL1164.2 +048800 ADD 1 TO RECORD-COUNT. RL1164.2 +048900Y IF RECORD-COUNT GREATER 50 RL1164.2 +049000Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1164.2 +049100Y MOVE SPACE TO DUMMY-RECORD RL1164.2 +049200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1164.2 +049300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1164.2 +049400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1164.2 +049500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1164.2 +049600Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1164.2 +049700Y MOVE ZERO TO RECORD-COUNT. RL1164.2 +049800 PERFORM WRT-LN. RL1164.2 +049900 WRT-LN. RL1164.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +050100 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +050200 BLANK-LINE-PRINT. RL1164.2 +050300 PERFORM WRT-LN. RL1164.2 +050400 FAIL-ROUTINE. RL1164.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE RL1164.2 +050600 GO TO FAIL-ROUTINE-WRITE. RL1164.2 +050700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1164.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +050900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1164.2 +051000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +051200 GO TO FAIL-ROUTINE-EX. RL1164.2 +051300 FAIL-ROUTINE-WRITE. RL1164.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1164.2 +051500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1164.2 +051600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1164.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1164.2 +051800 FAIL-ROUTINE-EX. EXIT. RL1164.2 +051900 BAIL-OUT. RL1164.2 +052000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1164.2 +052100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1164.2 +052200 BAIL-OUT-WRITE. RL1164.2 +052300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1164.2 +052400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +052500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +052600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +052700 BAIL-OUT-EX. EXIT. RL1164.2 +052800 CCVS1-EXIT. RL1164.2 +052900 EXIT. RL1164.2 +053000 SECT-RL116A-001 SECTION. RL1164.2 +053100 REL-INIT-009. RL1164.2 +053200 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1164.2 +053300 MOVE "REL-TEST-009" TO PAR-NAME. RL1164.2 +053400 MOVE "CREATE RL-FD2" TO FEATURE RL1164.2 +053500 MOVE "RL-FD2" TO XFILE-NAME (2). RL1164.2 +053600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1164.2 +053700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1164.2 +053800 MOVE 000240 TO XRECORD-LENGTH (2). RL1164.2 +053900 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1164.2 +054000 MOVE 0001 TO XBLOCK-SIZE (2). RL1164.2 +054100 MOVE 000500 TO RECORDS-IN-FILE (2). RL1164.2 +054200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1164.2 +054300 MOVE "S" TO XLABEL-TYPE (2). RL1164.2 +054400 MOVE 000001 TO XRECORD-NUMBER (2). RL1164.2 +054500*INITIALIZE RECORD WORK AREA NUMBER 2. RL1164.2 +054600 MOVE 1 TO WRK-CS-09V00-012. RL1164.2 +054700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1164.2 +054800 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1164.2 +054900 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1164.2 +055000 MOVE SPACE TO RL-FD2-STATUS. RL1164.2 +055100 MOVE 90000002 TO RL-FD2-KEY. RL1164.2 +055200 MOVE 01 TO REC-CT. RL1164.2 +055300 OPEN OUTPUT RL-FD2. RL1164.2 +055400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1164.2 +055500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1164.2 +055600 REL-INIT-1. RL1164.2 +055700 MOVE "REL-TEST-1" TO PAR-NAME. RL1164.2 +055800 MOVE "VII-3 1.3.4 1A" TO ANSI-REFERENCE. RL1164.2 +055900 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1164.2 +056000 MOVE "99" TO RL-FD2-STATUS. RL1164.2 +056100 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1164.2 +056200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1164.2 +056300 WRITE RL-FD2R1-F-G-240 RL1164.2 +056400 INVALID KEY CONTINUE. RL1164.2 +056500 REL-TEST-1. RL1164.2 +056600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1164.2 +056700 MOVE "INVALID WRITE" TO RE-MARK RL1164.2 +056800 MOVE RL-FD2-STATUS TO COMPUTED-X RL1164.2 +056900 MOVE "00" TO CORRECT-X RL1164.2 +057000 PERFORM FAIL RL1164.2 +057100 PERFORM PRINT-DETAIL RL1164.2 +057200 ELSE RL1164.2 +057300 PERFORM PASS RL1164.2 +057400 PERFORM PRINT-DETAIL. RL1164.2 +057500* RL1164.2 +057600 REL-INIT-2. RL1164.2 +057700 MOVE "REL-TEST-2" TO PAR-NAME. RL1164.2 +057800 MOVE "VII-3 1.3.4 2A" TO ANSI-REFERENCE. RL1164.2 +057900 IF RL-FD2-STATUS NOT = "00" RL1164.2 +058000 MOVE "TEST-2 NOT PERFORMED DUE TO FAILURE OF TEST-1"RL1164.2 +058100 TO RE-MARK RL1164.2 +058200 PERFORM FAIL RL1164.2 +058300 PERFORM PRINT-DETAIL RL1164.2 +058400 GO TO REL-TEST-2-EXIT. RL1164.2 +058500 CLOSE RL-FD2. RL1164.2 +058600 OPEN INPUT RL-FD3. RL1164.2 +058700 MOVE 1 TO RL-FD3-KEY. RL1164.2 +058800 REL-TEST-2-0. RL1164.2 +058900 READ RL-FD3 RL1164.2 +059000 AT END GO TO REL-TEST-2-1. RL1164.2 +059100 GO TO REL-TEST-2-0. RL1164.2 +059200 REL-TEST-2-1. RL1164.2 +059300 IF RL-FD3-STATUS NOT = "10" RL1164.2 +059400 MOVE RL-FD3-STATUS TO COMPUTED-X RL1164.2 +059500 MOVE "10" TO CORRECT-X RL1164.2 +059600 PERFORM FAIL RL1164.2 +059700 PERFORM PRINT-DETAIL RL1164.2 +059800 ELSE RL1164.2 +059900 PERFORM PASS RL1164.2 +060000 PERFORM PRINT-DETAIL. RL1164.2 +060100 CLOSE RL-FD3 RL1164.2 +060200 IF RL-FD3-STATUS NOT EQUAL TO "00" RL1164.2 +060300 MOVE "CLOSE/STATUS" TO RE-MARK RL1164.2 +060400 MOVE RL-FD3-STATUS TO COMPUTED-A RL1164.2 +060500 MOVE "00" TO CORRECT-A RL1164.2 +060600 PERFORM FAIL RL1164.2 +060700 ELSE RL1164.2 +060800 PERFORM PASS. RL1164.2 +060900 PERFORM PRINT-DETAIL. RL1164.2 +061000 REL-TEST-2-EXIT. RL1164.2 +061100* RL1164.2 +061200 CCVS-EXIT SECTION. RL1164.2 +061300 CCVS-999999. RL1164.2 +061400 GO TO CLOSE-FILES. RL1164.2 +*END-OF,RL116A +*HEADER,COBOL,RL117A +000100 IDENTIFICATION DIVISION. RL1174.2 +000200 PROGRAM-ID. RL1174.2 +000300 RL117A. RL1174.2 +000400**************************************************************** RL1174.2 +000500* * RL1174.2 +000600* VALIDATION FOR:- * RL1174.2 +000700* * RL1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +000900* * RL1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1174.2 +001100* * RL1174.2 +001200**************************************************************** RL1174.2 +001300* * RL1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1174.2 +001500* * RL1174.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1174.2 +001700* RELATIVE I-O DATA FILE * RL1174.2 +001800* X-55 SYSTEM PRINTER * RL1174.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1174.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1174.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1174.2 +002200* X-82 SOURCE-COMPUTER * RL1174.2 +002300* X-83 OBJECT-COMPUTER. * RL1174.2 +002400* * RL1174.2 +002500**************************************************************** RL1174.2 +002600* RL117A * RL1174.2 +002700**************************************************************** RL1174.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1174.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1174.2 +003000* CLAUSE FOR THE VALUES "10" AND "14". * RL1174.2 +003100* * RL1174.2 +003200* * RL1174.2 +003300* * RL1174.2 +003400**************************************************************** RL1174.2 +003500 ENVIRONMENT DIVISION. RL1174.2 +003600 CONFIGURATION SECTION. RL1174.2 +003700 SOURCE-COMPUTER. RL1174.2 +003800 XXXXX082. RL1174.2 +003900 OBJECT-COMPUTER. RL1174.2 +004000 XXXXX083. RL1174.2 +004100 INPUT-OUTPUT SECTION. RL1174.2 +004200 FILE-CONTROL. RL1174.2 +004300 SELECT PRINT-FILE ASSIGN TO RL1174.2 +004400 XXXXX055. RL1174.2 +004500 SELECT RL-FD2 ASSIGN RL1174.2 +004600 XXXXX022 RL1174.2 +004700 ORGANIZATION RELATIVE RL1174.2 +004800 ACCESS RANDOM RL1174.2 +004900 RELATIVE RL-FD2-KEY RL1174.2 +005000 FILE STATUS IS RL-FD2-STATUS. RL1174.2 +005100 SELECT RL-FD3 ASSIGN RL1174.2 +005200 XXXXX022 RL1174.2 +005300 ORGANIZATION RELATIVE RL1174.2 +005400 ACCESS SEQUENTIAL RL1174.2 +005500 RELATIVE RL-FD3-KEY RL1174.2 +005600 FILE STATUS IS RL-FD3-STATUS. RL1174.2 +005700 DATA DIVISION. RL1174.2 +005800 FILE SECTION. RL1174.2 +005900 FD PRINT-FILE. RL1174.2 +006000 01 PRINT-REC PICTURE X(120). RL1174.2 +006100 01 DUMMY-RECORD PICTURE X(120). RL1174.2 +006200 FD RL-FD2 RL1174.2 +006300C VALUE OF RL1174.2 +006400C XXXXX074 RL1174.2 +006500C IS RL1174.2 +006600C XXXXX076 RL1174.2 +006700G XXXXX069 RL1174.2 +006800 LABEL RECORDS ARE STANDARD RL1174.2 +006900 BLOCK CONTAINS 1 RECORDS RL1174.2 +007000 DATA RECORD RL-FD2R1-F-G-240. RL1174.2 +007100 01 RL-FD2R1-F-G-240. RL1174.2 +007200 05 RL-FD2-WRK-120 PIC X(120). RL1174.2 +007300 05 RL-FD2-GRP-120. RL1174.2 +007400 10 RL-FD2-WRK-XN-0001-O120F RL1174.2 +007500 PICTURE X OCCURS 120 TIMES. RL1174.2 +007600 FD RL-FD3 RL1174.2 +007700C VALUE OF RL1174.2 +007800C XXXXX074 RL1174.2 +007900C IS RL1174.2 +008000C XXXXX076 RL1174.2 +008100G XXXXX069 RL1174.2 +008200 LABEL RECORDS ARE STANDARD RL1174.2 +008300 BLOCK CONTAINS 1 RECORDS RL1174.2 +008400 DATA RECORD RL-FD3R1-F-G-240. RL1174.2 +008500 01 RL-FD3R1-F-G-240. RL1174.2 +008600 05 RL-FD3-WRK-120 PIC X(120). RL1174.2 +008700 05 RL-FD3-GRP-120. RL1174.2 +008800 10 RL-FD3-WRK-XN-0001-O120F RL1174.2 +008900 PICTURE X OCCURS 120 TIMES. RL1174.2 +009000 WORKING-STORAGE SECTION. RL1174.2 +009100 01 GRP-0001. RL1174.2 +009200 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1174.2 +009300 05 RL-FD3-KEY PIC 99 VALUE ZERO. RL1174.2 +009400 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009500 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009600 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009700 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009800 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009900 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +010000 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +010100 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1174.2 +010200 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1174.2 +010300 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1174.2 +010400 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1174.2 +010500 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1174.2 +010600 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1174.2 +010700 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1174.2 +010800 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1174.2 +010900 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1174.2 +011000 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1174.2 +011100 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1174.2 +011200 01 FILE-RECORD-INFORMATION-REC. RL1174.2 +011300 03 FILE-RECORD-INFO-SKELETON. RL1174.2 +011400 05 FILLER PICTURE X(48) VALUE RL1174.2 +011500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1174.2 +011600 05 FILLER PICTURE X(46) VALUE RL1174.2 +011700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1174.2 +011800 05 FILLER PICTURE X(26) VALUE RL1174.2 +011900 ",LFIL=000000,ORG= ,LBLR= ". RL1174.2 +012000 05 FILLER PICTURE X(37) VALUE RL1174.2 +012100 ",RECKEY= ". RL1174.2 +012200 05 FILLER PICTURE X(38) VALUE RL1174.2 +012300 ",ALTKEY1= ". RL1174.2 +012400 05 FILLER PICTURE X(38) VALUE RL1174.2 +012500 ",ALTKEY2= ". RL1174.2 +012600 05 FILLER PICTURE X(7) VALUE SPACE.RL1174.2 +012700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1174.2 +012800 05 FILE-RECORD-INFO-P1-120. RL1174.2 +012900 07 FILLER PIC X(5). RL1174.2 +013000 07 XFILE-NAME PIC X(6). RL1174.2 +013100 07 FILLER PIC X(8). RL1174.2 +013200 07 XRECORD-NAME PIC X(6). RL1174.2 +013300 07 FILLER PIC X(1). RL1174.2 +013400 07 REELUNIT-NUMBER PIC 9(1). RL1174.2 +013500 07 FILLER PIC X(7). RL1174.2 +013600 07 XRECORD-NUMBER PIC 9(6). RL1174.2 +013700 07 FILLER PIC X(6). RL1174.2 +013800 07 UPDATE-NUMBER PIC 9(2). RL1174.2 +013900 07 FILLER PIC X(5). RL1174.2 +014000 07 ODO-NUMBER PIC 9(4). RL1174.2 +014100 07 FILLER PIC X(5). RL1174.2 +014200 07 XPROGRAM-NAME PIC X(5). RL1174.2 +014300 07 FILLER PIC X(7). RL1174.2 +014400 07 XRECORD-LENGTH PIC 9(6). RL1174.2 +014500 07 FILLER PIC X(7). RL1174.2 +014600 07 CHARS-OR-RECORDS PIC X(2). RL1174.2 +014700 07 FILLER PIC X(1). RL1174.2 +014800 07 XBLOCK-SIZE PIC 9(4). RL1174.2 +014900 07 FILLER PIC X(6). RL1174.2 +015000 07 RECORDS-IN-FILE PIC 9(6). RL1174.2 +015100 07 FILLER PIC X(5). RL1174.2 +015200 07 XFILE-ORGANIZATION PIC X(2). RL1174.2 +015300 07 FILLER PIC X(6). RL1174.2 +015400 07 XLABEL-TYPE PIC X(1). RL1174.2 +015500 05 FILE-RECORD-INFO-P121-240. RL1174.2 +015600 07 FILLER PIC X(8). RL1174.2 +015700 07 XRECORD-KEY PIC X(29). RL1174.2 +015800 07 FILLER PIC X(9). RL1174.2 +015900 07 ALTERNATE-KEY1 PIC X(29). RL1174.2 +016000 07 FILLER PIC X(9). RL1174.2 +016100 07 ALTERNATE-KEY2 PIC X(29). RL1174.2 +016200 07 FILLER PIC X(7). RL1174.2 +016300 01 TEST-RESULTS. RL1174.2 +016400 02 FILLER PIC X VALUE SPACE. RL1174.2 +016500 02 FEATURE PIC X(20) VALUE SPACE. RL1174.2 +016600 02 FILLER PIC X VALUE SPACE. RL1174.2 +016700 02 P-OR-F PIC X(5) VALUE SPACE. RL1174.2 +016800 02 FILLER PIC X VALUE SPACE. RL1174.2 +016900 02 PAR-NAME. RL1174.2 +017000 03 FILLER PIC X(19) VALUE SPACE. RL1174.2 +017100 03 PARDOT-X PIC X VALUE SPACE. RL1174.2 +017200 03 DOTVALUE PIC 99 VALUE ZERO. RL1174.2 +017300 02 FILLER PIC X(8) VALUE SPACE. RL1174.2 +017400 02 RE-MARK PIC X(61). RL1174.2 +017500 01 TEST-COMPUTED. RL1174.2 +017600 02 FILLER PIC X(30) VALUE SPACE. RL1174.2 +017700 02 FILLER PIC X(17) VALUE RL1174.2 +017800 " COMPUTED=". RL1174.2 +017900 02 COMPUTED-X. RL1174.2 +018000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1174.2 +018100 03 COMPUTED-N REDEFINES COMPUTED-A RL1174.2 +018200 PIC -9(9).9(9). RL1174.2 +018300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1174.2 +018400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1174.2 +018500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1174.2 +018600 03 CM-18V0 REDEFINES COMPUTED-A. RL1174.2 +018700 04 COMPUTED-18V0 PIC -9(18). RL1174.2 +018800 04 FILLER PIC X. RL1174.2 +018900 03 FILLER PIC X(50) VALUE SPACE. RL1174.2 +019000 01 TEST-CORRECT. RL1174.2 +019100 02 FILLER PIC X(30) VALUE SPACE. RL1174.2 +019200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1174.2 +019300 02 CORRECT-X. RL1174.2 +019400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1174.2 +019500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1174.2 +019600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1174.2 +019700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1174.2 +019800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1174.2 +019900 03 CR-18V0 REDEFINES CORRECT-A. RL1174.2 +020000 04 CORRECT-18V0 PIC -9(18). RL1174.2 +020100 04 FILLER PIC X. RL1174.2 +020200 03 FILLER PIC X(2) VALUE SPACE. RL1174.2 +020300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1174.2 +020400 01 CCVS-C-1. RL1174.2 +020500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1174.2 +020600- "SS PARAGRAPH-NAME RL1174.2 +020700- " REMARKS". RL1174.2 +020800 02 FILLER PIC X(20) VALUE SPACE. RL1174.2 +020900 01 CCVS-C-2. RL1174.2 +021000 02 FILLER PIC X VALUE SPACE. RL1174.2 +021100 02 FILLER PIC X(6) VALUE "TESTED". RL1174.2 +021200 02 FILLER PIC X(15) VALUE SPACE. RL1174.2 +021300 02 FILLER PIC X(4) VALUE "FAIL". RL1174.2 +021400 02 FILLER PIC X(94) VALUE SPACE. RL1174.2 +021500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1174.2 +021600 01 REC-CT PIC 99 VALUE ZERO. RL1174.2 +021700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1174.2 +021800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1174.2 +021900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1174.2 +022000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1174.2 +022100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1174.2 +022200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1174.2 +022300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1174.2 +022400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1174.2 +022500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1174.2 +022600 01 CCVS-H-1. RL1174.2 +022700 02 FILLER PIC X(39) VALUE SPACES. RL1174.2 +022800 02 FILLER PIC X(42) VALUE RL1174.2 +022900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1174.2 +023000 02 FILLER PIC X(39) VALUE SPACES. RL1174.2 +023100 01 CCVS-H-2A. RL1174.2 +023200 02 FILLER PIC X(40) VALUE SPACE. RL1174.2 +023300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1174.2 +023400 02 FILLER PIC XXXX VALUE RL1174.2 +023500 "4.2 ". RL1174.2 +023600 02 FILLER PIC X(28) VALUE RL1174.2 +023700 " COPY - NOT FOR DISTRIBUTION". RL1174.2 +023800 02 FILLER PIC X(41) VALUE SPACE. RL1174.2 +023900 RL1174.2 +024000 01 CCVS-H-2B. RL1174.2 +024100 02 FILLER PIC X(15) VALUE RL1174.2 +024200 "TEST RESULT OF ". RL1174.2 +024300 02 TEST-ID PIC X(9). RL1174.2 +024400 02 FILLER PIC X(4) VALUE RL1174.2 +024500 " IN ". RL1174.2 +024600 02 FILLER PIC X(12) VALUE RL1174.2 +024700 " HIGH ". RL1174.2 +024800 02 FILLER PIC X(22) VALUE RL1174.2 +024900 " LEVEL VALIDATION FOR ". RL1174.2 +025000 02 FILLER PIC X(58) VALUE RL1174.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +025200 01 CCVS-H-3. RL1174.2 +025300 02 FILLER PIC X(34) VALUE RL1174.2 +025400 " FOR OFFICIAL USE ONLY ". RL1174.2 +025500 02 FILLER PIC X(58) VALUE RL1174.2 +025600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1174.2 +025700 02 FILLER PIC X(28) VALUE RL1174.2 +025800 " COPYRIGHT 1985 ". RL1174.2 +025900 01 CCVS-E-1. RL1174.2 +026000 02 FILLER PIC X(52) VALUE SPACE. RL1174.2 +026100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1174.2 +026200 02 ID-AGAIN PIC X(9). RL1174.2 +026300 02 FILLER PIC X(45) VALUE SPACES. RL1174.2 +026400 01 CCVS-E-2. RL1174.2 +026500 02 FILLER PIC X(31) VALUE SPACE. RL1174.2 +026600 02 FILLER PIC X(21) VALUE SPACE. RL1174.2 +026700 02 CCVS-E-2-2. RL1174.2 +026800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1174.2 +026900 03 FILLER PIC X VALUE SPACE. RL1174.2 +027000 03 ENDER-DESC PIC X(44) VALUE RL1174.2 +027100 "ERRORS ENCOUNTERED". RL1174.2 +027200 01 CCVS-E-3. RL1174.2 +027300 02 FILLER PIC X(22) VALUE RL1174.2 +027400 " FOR OFFICIAL USE ONLY". RL1174.2 +027500 02 FILLER PIC X(12) VALUE SPACE. RL1174.2 +027600 02 FILLER PIC X(58) VALUE RL1174.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +027800 02 FILLER PIC X(13) VALUE SPACE. RL1174.2 +027900 02 FILLER PIC X(15) VALUE RL1174.2 +028000 " COPYRIGHT 1985". RL1174.2 +028100 01 CCVS-E-4. RL1174.2 +028200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1174.2 +028300 02 FILLER PIC X(4) VALUE " OF ". RL1174.2 +028400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1174.2 +028500 02 FILLER PIC X(40) VALUE RL1174.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1174.2 +028700 01 XXINFO. RL1174.2 +028800 02 FILLER PIC X(19) VALUE RL1174.2 +028900 "*** INFORMATION ***". RL1174.2 +029000 02 INFO-TEXT. RL1174.2 +029100 04 FILLER PIC X(8) VALUE SPACE. RL1174.2 +029200 04 XXCOMPUTED PIC X(20). RL1174.2 +029300 04 FILLER PIC X(5) VALUE SPACE. RL1174.2 +029400 04 XXCORRECT PIC X(20). RL1174.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). RL1174.2 +029600 01 HYPHEN-LINE. RL1174.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. RL1174.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************RL1174.2 +029900- "*****************************************". RL1174.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************RL1174.2 +030100- "******************************". RL1174.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE RL1174.2 +030300 "RL117A". RL1174.2 +030400 PROCEDURE DIVISION. RL1174.2 +030500 CCVS1 SECTION. RL1174.2 +030600 OPEN-FILES. RL1174.2 +030700 OPEN OUTPUT PRINT-FILE. RL1174.2 +030800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1174.2 +030900 MOVE SPACE TO TEST-RESULTS. RL1174.2 +031000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1174.2 +031100 MOVE ZERO TO REC-SKL-SUB. RL1174.2 +031200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1174.2 +031300 CCVS-INIT-FILE. RL1174.2 +031400 ADD 1 TO REC-SKL-SUB. RL1174.2 +031500 MOVE FILE-RECORD-INFO-SKELETON RL1174.2 +031600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1174.2 +031700 CCVS-INIT-EXIT. RL1174.2 +031800 GO TO CCVS1-EXIT. RL1174.2 +031900 CLOSE-FILES. RL1174.2 +032000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1174.2 +032100 TERMINATE-CCVS. RL1174.2 +032200S EXIT PROGRAM. RL1174.2 +032300STERMINATE-CALL. RL1174.2 +032400 STOP RUN. RL1174.2 +032500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1174.2 +032600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1174.2 +032700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1174.2 +032800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1174.2 +032900 MOVE "****TEST DELETED****" TO RE-MARK. RL1174.2 +033000 PRINT-DETAIL. RL1174.2 +033100 IF REC-CT NOT EQUAL TO ZERO RL1174.2 +033200 MOVE "." TO PARDOT-X RL1174.2 +033300 MOVE REC-CT TO DOTVALUE. RL1174.2 +033400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1174.2 +033500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1174.2 +033600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1174.2 +033700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1174.2 +033800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1174.2 +033900 MOVE SPACE TO CORRECT-X. RL1174.2 +034000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1174.2 +034100 MOVE SPACE TO RE-MARK. RL1174.2 +034200 HEAD-ROUTINE. RL1174.2 +034300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +034400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +034500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1174.2 +034600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1174.2 +034700 COLUMN-NAMES-ROUTINE. RL1174.2 +034800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +034900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +035000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +035100 END-ROUTINE. RL1174.2 +035200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1174.2 +035300 END-RTN-EXIT. RL1174.2 +035400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +035500 END-ROUTINE-1. RL1174.2 +035600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1174.2 +035700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1174.2 +035800 ADD PASS-COUNTER TO ERROR-HOLD. RL1174.2 +035900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1174.2 +036000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1174.2 +036100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1174.2 +036200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1174.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1174.2 +036400 END-ROUTINE-12. RL1174.2 +036500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1174.2 +036600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1174.2 +036700 MOVE "NO " TO ERROR-TOTAL RL1174.2 +036800 ELSE RL1174.2 +036900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1174.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1174.2 +037100 PERFORM WRITE-LINE. RL1174.2 +037200 END-ROUTINE-13. RL1174.2 +037300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1174.2 +037400 MOVE "NO " TO ERROR-TOTAL ELSE RL1174.2 +037500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1174.2 +037600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1174.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO RL1174.2 +037900 MOVE "NO " TO ERROR-TOTAL RL1174.2 +038000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1174.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1174.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +038400 WRITE-LINE. RL1174.2 +038500 ADD 1 TO RECORD-COUNT. RL1174.2 +038600Y IF RECORD-COUNT GREATER 50 RL1174.2 +038700Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1174.2 +038800Y MOVE SPACE TO DUMMY-RECORD RL1174.2 +038900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1174.2 +039000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1174.2 +039100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1174.2 +039200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1174.2 +039300Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1174.2 +039400Y MOVE ZERO TO RECORD-COUNT. RL1174.2 +039500 PERFORM WRT-LN. RL1174.2 +039600 WRT-LN. RL1174.2 +039700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1174.2 +039800 MOVE SPACE TO DUMMY-RECORD. RL1174.2 +039900 BLANK-LINE-PRINT. RL1174.2 +040000 PERFORM WRT-LN. RL1174.2 +040100 FAIL-ROUTINE. RL1174.2 +040200 IF COMPUTED-X NOT EQUAL TO SPACE RL1174.2 +040300 GO TO FAIL-ROUTINE-WRITE. RL1174.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1174.2 +040500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1174.2 +040600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1174.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +040800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1174.2 +040900 GO TO FAIL-ROUTINE-EX. RL1174.2 +041000 FAIL-ROUTINE-WRITE. RL1174.2 +041100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1174.2 +041200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1174.2 +041300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1174.2 +041400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1174.2 +041500 FAIL-ROUTINE-EX. EXIT. RL1174.2 +041600 BAIL-OUT. RL1174.2 +041700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1174.2 +041800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1174.2 +041900 BAIL-OUT-WRITE. RL1174.2 +042000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1174.2 +042100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1174.2 +042200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +042300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1174.2 +042400 BAIL-OUT-EX. EXIT. RL1174.2 +042500 CCVS1-EXIT. RL1174.2 +042600 EXIT. RL1174.2 +042700 SECT-RL117A-001 SECTION. RL1174.2 +042800 REL-INIT-009. RL1174.2 +042900 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1174.2 +043000 MOVE "REL-TEST-009" TO PAR-NAME. RL1174.2 +043100 MOVE "CREATE RL-FD2" TO FEATURE RL1174.2 +043200 MOVE "RL-FD2" TO XFILE-NAME (2). RL1174.2 +043300 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1174.2 +043400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1174.2 +043500 MOVE 000240 TO XRECORD-LENGTH (2). RL1174.2 +043600 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1174.2 +043700 MOVE 0001 TO XBLOCK-SIZE (2). RL1174.2 +043800 MOVE 000500 TO RECORDS-IN-FILE (2). RL1174.2 +043900 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1174.2 +044000 MOVE "S" TO XLABEL-TYPE (2). RL1174.2 +044100 MOVE 000001 TO XRECORD-NUMBER (2). RL1174.2 +044200*INITIALIZE RECORD WORK AREA NUMBER 2. RL1174.2 +044300 MOVE 1 TO WRK-CS-09V00-012. RL1174.2 +044400 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1174.2 +044500 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1174.2 +044600 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1174.2 +044700 MOVE SPACE TO RL-FD2-STATUS. RL1174.2 +044800 MOVE 90000002 TO RL-FD2-KEY. RL1174.2 +044900 MOVE 01 TO REC-CT. RL1174.2 +045000 OPEN OUTPUT RL-FD2. RL1174.2 +045100 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1174.2 +045200*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1174.2 +045300 REL-TEST-009-R. RL1174.2 +045400 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1174.2 +045500 MOVE "99" TO RL-FD2-STATUS. RL1174.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1174.2 +045700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1174.2 +045800 RL-FD2-GRP-120. RL1174.2 +045900 WRITE RL-FD2R1-F-G-240 INVALID KEY RL1174.2 +046000 GO TO REL-TEST-009-2. RL1174.2 +046100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +046200 GO TO REL-TEST-009-2. RL1174.2 +046300 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1174.2 +046400 GO TO REL-TEST-009-2. RL1174.2 +046500 ADD 01 TO XRECORD-NUMBER (2). RL1174.2 +046600 GO TO REL-TEST-009-R. RL1174.2 +046700 REL-TEST-009-2. RL1174.2 +046800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1174.2 +046900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1174.2 +047000 MOVE ZERO TO CORRECT-18V0 RL1174.2 +047100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1174.2 +047200 PERFORM FAIL RL1174.2 +047300 ELSE RL1174.2 +047400 PERFORM PASS. RL1174.2 +047500 PERFORM PRINT-DETAIL. RL1174.2 +047600 ADD 01 TO REC-CT. RL1174.2 +047700* .01 RL1174.2 +047800 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1174.2 +047900 MOVE "INCORRECT COUNT" TO RE-MARK RL1174.2 +048000 MOVE 500 TO CORRECT-18V0 RL1174.2 +048100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1174.2 +048200 PERFORM FAIL RL1174.2 +048300 ELSE RL1174.2 +048400 PERFORM PASS. RL1174.2 +048500 PERFORM PRINT-DETAIL. RL1174.2 +048600 ADD 01 TO REC-CT. RL1174.2 +048700* .02 RL1174.2 +048800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1174.2 +048900 MOVE "STATUS/OPEN" TO RE-MARK RL1174.2 +049000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1174.2 +049100 MOVE "00" TO CORRECT-A RL1174.2 +049200 PERFORM FAIL RL1174.2 +049300 ELSE RL1174.2 +049400 PERFORM PASS. RL1174.2 +049500 PERFORM PRINT-DETAIL. RL1174.2 +049600 ADD 01 TO REC-CT. RL1174.2 +049700* .03 RL1174.2 +049800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +049900 MOVE "STATUS/WRITE" TO RE-MARK RL1174.2 +050000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1174.2 +050100 MOVE "00" TO CORRECT-A RL1174.2 +050200 PERFORM FAIL RL1174.2 +050300 ELSE RL1174.2 +050400 PERFORM PASS. RL1174.2 +050500 PERFORM PRINT-DETAIL. RL1174.2 +050600 ADD 01 TO REC-CT. RL1174.2 +050700* .04 RL1174.2 +050800 MOVE SPACE TO RL-FD2-STATUS. RL1174.2 +050900 CLOSE RL-FD2. RL1174.2 +051000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +051100 MOVE "CLOSE/STATUS" TO RE-MARK RL1174.2 +051200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1174.2 +051300 MOVE "00" TO CORRECT-A RL1174.2 +051400 PERFORM FAIL RL1174.2 +051500 ELSE RL1174.2 +051600 PERFORM PASS. RL1174.2 +051700 PERFORM PRINT-DETAIL. RL1174.2 +051800* RL1174.2 +051900 REL-INIT-1. RL1174.2 +052000 MOVE "REL-TEST-1" TO PAR-NAME. RL1174.2 +052100 MOVE "VII-3 1.3.4 2A" TO ANSI-REFERENCE. RL1174.2 +052200 MOVE 0 TO REC-CT. RL1174.2 +052300 OPEN I-O RL-FD3. RL1174.2 +052400* DELETE THE NEXT LINE TO DELETE THE TEST RL1174.2 +052500* GO TO REL-INIT-1-BETA. RL1174.2 +052600 REL-INIT-1-ALPHA. RL1174.2 +052700 GO TO REL-DELETE-1. RL1174.2 +052800 REL-INIT-1-BETA. RL1174.2 +052900 MOVE SPACE TO RL-FD3-STATUS. RL1174.2 +053000 PERFORM REL-INIT-1-A 501 TIMES. RL1174.2 +053100 GO TO REL-TEST-1. RL1174.2 +053200 REL-INIT-1-A. RL1174.2 +053300 READ RL-FD3 AT END GO TO REL-TEST-1. RL1174.2 +053400 REL-DELETE-1. RL1174.2 +053500 PERFORM DE-LETE. RL1174.2 +053600 PERFORM PRINT-DETAIL. RL1174.2 +053700 GO TO REL-INIT-2. RL1174.2 +053800 REL-TEST-1. RL1174.2 +053900 IF RL-FD3-STATUS NOT EQUAL TO "10" RL1174.2 +054000 MOVE "AT END STATUS" TO RE-MARK RL1174.2 +054100 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +054200 MOVE "10" TO CORRECT-A RL1174.2 +054300 PERFORM FAIL RL1174.2 +054400 PERFORM PRINT-DETAIL RL1174.2 +054500 ELSE RL1174.2 +054600 PERFORM PASS RL1174.2 +054700 PERFORM PRINT-DETAIL. RL1174.2 +054800* RL1174.2 +054900 REL-INIT-2. RL1174.2 +055000 MOVE "REL-TEST-2" TO PAR-NAME. RL1174.2 +055100 MOVE "VII-3 1.3.4 2D" TO ANSI-REFERENCE. RL1174.2 +055200 MOVE SPACE TO RL-FD3-STATUS. RL1174.2 +055300* DELETE THE NEXT LINE TO DELETE THE TEST RL1174.2 +055400* GO TO REL-INIT-2-BETA. RL1174.2 +055500 REL-INIT-2-ALPHA. RL1174.2 +055600 GO TO REL-DELETE-2. RL1174.2 +055700 REL-INIT-2-BETA. RL1174.2 +055800 READ RL-FD3 AT END GO TO REL-TEST-2. RL1174.2 +055900 GO TO REL-TEST-2. RL1174.2 +056000 REL-DELETE-2. RL1174.2 +056100 PERFORM DE-LETE. RL1174.2 +056200 PERFORM PRINT-DETAIL. RL1174.2 +056300 GO TO REL-INIT-3. RL1174.2 +056400 REL-TEST-2. RL1174.2 +056500 IF RL-FD3-STATUS NOT EQUAL TO "46" RL1174.2 +056600 MOVE "SEQUENTIAL READ FOLLOWING 'AT END' CONDITION"RL1174.2 +056700 TO RE-MARK RL1174.2 +056800 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +056900 MOVE "46" TO CORRECT-A RL1174.2 +057000 PERFORM FAIL RL1174.2 +057100 PERFORM PRINT-DETAIL RL1174.2 +057200 ELSE RL1174.2 +057300 PERFORM PASS RL1174.2 +057400 PERFORM PRINT-DETAIL. RL1174.2 +057500* RL1174.2 +057600 REL-INIT-3. RL1174.2 +057700 MOVE "REL-TEST-3" TO PAR-NAME. RL1174.2 +057800 MOVE "VII-3 1.3.4 2B" TO ANSI-REFERENCE. RL1174.2 +057900 CLOSE RL-FD3. RL1174.2 +058000 OPEN INPUT RL-FD3. RL1174.2 +058100 PERFORM REL-INIT-3-A 100 TIMES. RL1174.2 +058200 GO TO REL-TEST-3. RL1174.2 +058300 REL-INIT-3-A. RL1174.2 +058400 READ RL-FD3 RECORD AT END GO TO REL-TEST-3. RL1174.2 +058500 REL-DELETE-3. RL1174.2 +058600 PERFORM DE-LETE. RL1174.2 +058700 PERFORM PRINT-DETAIL. RL1174.2 +058800 GO TO RL-TEST-3-EXIT. RL1174.2 +058900 REL-TEST-3. RL1174.2 +059000 IF RL-FD3-STATUS NOT EQUAL TO "14" RL1174.2 +059100 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +059200 MOVE "14" TO CORRECT-A RL1174.2 +059300 PERFORM FAIL RL1174.2 +059400 PERFORM PRINT-DETAIL RL1174.2 +059500 ELSE RL1174.2 +059600 PERFORM PASS RL1174.2 +059700 PERFORM PRINT-DETAIL RL1174.2 +059800 CLOSE RL-FD3. RL1174.2 +059900 RL-TEST-3-EXIT. RL1174.2 +060000 EXIT. RL1174.2 +060100* RL1174.2 +060200 CCVS-EXIT SECTION. RL1174.2 +060300 CCVS-999999. RL1174.2 +060400 GO TO CLOSE-FILES. RL1174.2 +*END-OF,RL117A +*HEADER,COBOL,RL118A +000100 IDENTIFICATION DIVISION. RL1184.2 +000200 PROGRAM-ID. RL1184.2 +000300 RL118A. RL1184.2 +000400**************************************************************** RL1184.2 +000500* * RL1184.2 +000600* VALIDATION FOR:- * RL1184.2 +000700* * RL1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +000900* * RL1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1184.2 +001100* * RL1184.2 +001200**************************************************************** RL1184.2 +001300* * RL1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1184.2 +001500* * RL1184.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1184.2 +001700* RELATIVE I-O DATA FILE * RL1184.2 +001800* X-55 SYSTEM PRINTER * RL1184.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1184.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1184.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1184.2 +002200* X-82 SOURCE-COMPUTER * RL1184.2 +002300* X-83 OBJECT-COMPUTER. * RL1184.2 +002400* * RL1184.2 +002500**************************************************************** RL1184.2 +002600* RL118A * RL1184.2 +002700**************************************************************** RL1184.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1184.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1184.2 +003000* CLAUSE FOR THE VALUES "22", "23" AND "24". * RL1184.2 +003100**************************************************************** RL1184.2 +003200 ENVIRONMENT DIVISION. RL1184.2 +003300 CONFIGURATION SECTION. RL1184.2 +003400 SOURCE-COMPUTER. RL1184.2 +003500 XXXXX082. RL1184.2 +003600 OBJECT-COMPUTER. RL1184.2 +003700 XXXXX083. RL1184.2 +003800 INPUT-OUTPUT SECTION. RL1184.2 +003900 FILE-CONTROL. RL1184.2 +004000 SELECT PRINT-FILE ASSIGN TO RL1184.2 +004100 XXXXX055. RL1184.2 +004200 SELECT RL-FD2 ASSIGN RL1184.2 +004300 XXXXX022 RL1184.2 +004400 ORGANIZATION RELATIVE RL1184.2 +004500 ACCESS RANDOM RL1184.2 +004600 RELATIVE RL-FD2-KEY RL1184.2 +004700 FILE STATUS IS RL-FD2-STATUS. RL1184.2 +004800 SELECT RL-FD3 ASSIGN RL1184.2 +004900 XXXXX022 RL1184.2 +005000 ORGANIZATION RELATIVE RL1184.2 +005100 ACCESS RANDOM RL1184.2 +005200 RELATIVE RL-FD3-KEY RL1184.2 +005300 FILE STATUS IS RL-FD3-STATUS. RL1184.2 +005400 DATA DIVISION. RL1184.2 +005500 FILE SECTION. RL1184.2 +005600 FD PRINT-FILE. RL1184.2 +005700 01 PRINT-REC PICTURE X(120). RL1184.2 +005800 01 DUMMY-RECORD PICTURE X(120). RL1184.2 +005900 FD RL-FD2 RL1184.2 +006000C VALUE OF RL1184.2 +006100C XXXXX074 RL1184.2 +006200C IS RL1184.2 +006300C XXXXX076 RL1184.2 +006400G XXXXX069 RL1184.2 +006500 LABEL RECORDS ARE STANDARD RL1184.2 +006600 BLOCK CONTAINS 1 RECORDS RL1184.2 +006700 DATA RECORD RL-FD2R1-F-G-240. RL1184.2 +006800 01 RL-FD2R1-F-G-240. RL1184.2 +006900 05 RL-FD2-WRK-120 PIC X(120). RL1184.2 +007000 05 RL-FD2-GRP-120. RL1184.2 +007100 10 RL-FD2-WRK-XN-0001-O120F RL1184.2 +007200 PICTURE X OCCURS 120 TIMES. RL1184.2 +007300 FD RL-FD3 RL1184.2 +007400C VALUE OF RL1184.2 +007500C XXXXX074 RL1184.2 +007600C IS RL1184.2 +007700C XXXXX076 RL1184.2 +007800G XXXXX069 RL1184.2 +007900 LABEL RECORDS ARE STANDARD RL1184.2 +008000 BLOCK CONTAINS 1 RECORDS RL1184.2 +008100 DATA RECORD RL-FD3R1-F-G-240. RL1184.2 +008200 01 RL-FD3R1-F-G-240. RL1184.2 +008300 05 RL-FD3-WRK-120 PIC X(120). RL1184.2 +008400 05 RL-FD3-GRP-120. RL1184.2 +008500 10 RL-FD3-WRK-XN-0001-O120F RL1184.2 +008600 PICTURE X OCCURS 120 TIMES. RL1184.2 +008700 WORKING-STORAGE SECTION. RL1184.2 +008800 01 GRP-0001. RL1184.2 +008900 05 RL-FD2-KEY PIC 99 VALUE ZERO. RL1184.2 +009000 05 RL-FD3-KEY PIC 999 VALUE ZERO. RL1184.2 +009100 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009200 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009300 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009400 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009500 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009600 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009700 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009800 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1184.2 +009900 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1184.2 +010000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1184.2 +010100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1184.2 +010200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1184.2 +010300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1184.2 +010400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1184.2 +010500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1184.2 +010600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1184.2 +010700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1184.2 +010800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1184.2 +010900 01 FILE-RECORD-INFORMATION-REC. RL1184.2 +011000 03 FILE-RECORD-INFO-SKELETON. RL1184.2 +011100 05 FILLER PICTURE X(48) VALUE RL1184.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1184.2 +011300 05 FILLER PICTURE X(46) VALUE RL1184.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1184.2 +011500 05 FILLER PICTURE X(26) VALUE RL1184.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". RL1184.2 +011700 05 FILLER PICTURE X(37) VALUE RL1184.2 +011800 ",RECKEY= ". RL1184.2 +011900 05 FILLER PICTURE X(38) VALUE RL1184.2 +012000 ",ALTKEY1= ". RL1184.2 +012100 05 FILLER PICTURE X(38) VALUE RL1184.2 +012200 ",ALTKEY2= ". RL1184.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.RL1184.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1184.2 +012500 05 FILE-RECORD-INFO-P1-120. RL1184.2 +012600 07 FILLER PIC X(5). RL1184.2 +012700 07 XFILE-NAME PIC X(6). RL1184.2 +012800 07 FILLER PIC X(8). RL1184.2 +012900 07 XRECORD-NAME PIC X(6). RL1184.2 +013000 07 FILLER PIC X(1). RL1184.2 +013100 07 REELUNIT-NUMBER PIC 9(1). RL1184.2 +013200 07 FILLER PIC X(7). RL1184.2 +013300 07 XRECORD-NUMBER PIC 9(6). RL1184.2 +013400 07 FILLER PIC X(6). RL1184.2 +013500 07 UPDATE-NUMBER PIC 9(2). RL1184.2 +013600 07 FILLER PIC X(5). RL1184.2 +013700 07 ODO-NUMBER PIC 9(4). RL1184.2 +013800 07 FILLER PIC X(5). RL1184.2 +013900 07 XPROGRAM-NAME PIC X(5). RL1184.2 +014000 07 FILLER PIC X(7). RL1184.2 +014100 07 XRECORD-LENGTH PIC 9(6). RL1184.2 +014200 07 FILLER PIC X(7). RL1184.2 +014300 07 CHARS-OR-RECORDS PIC X(2). RL1184.2 +014400 07 FILLER PIC X(1). RL1184.2 +014500 07 XBLOCK-SIZE PIC 9(4). RL1184.2 +014600 07 FILLER PIC X(6). RL1184.2 +014700 07 RECORDS-IN-FILE PIC 9(6). RL1184.2 +014800 07 FILLER PIC X(5). RL1184.2 +014900 07 XFILE-ORGANIZATION PIC X(2). RL1184.2 +015000 07 FILLER PIC X(6). RL1184.2 +015100 07 XLABEL-TYPE PIC X(1). RL1184.2 +015200 05 FILE-RECORD-INFO-P121-240. RL1184.2 +015300 07 FILLER PIC X(8). RL1184.2 +015400 07 XRECORD-KEY PIC X(29). RL1184.2 +015500 07 FILLER PIC X(9). RL1184.2 +015600 07 ALTERNATE-KEY1 PIC X(29). RL1184.2 +015700 07 FILLER PIC X(9). RL1184.2 +015800 07 ALTERNATE-KEY2 PIC X(29). RL1184.2 +015900 07 FILLER PIC X(7). RL1184.2 +016000 01 TEST-RESULTS. RL1184.2 +016100 02 FILLER PIC X VALUE SPACE. RL1184.2 +016200 02 FEATURE PIC X(20) VALUE SPACE. RL1184.2 +016300 02 FILLER PIC X VALUE SPACE. RL1184.2 +016400 02 P-OR-F PIC X(5) VALUE SPACE. RL1184.2 +016500 02 FILLER PIC X VALUE SPACE. RL1184.2 +016600 02 PAR-NAME. RL1184.2 +016700 03 FILLER PIC X(19) VALUE SPACE. RL1184.2 +016800 03 PARDOT-X PIC X VALUE SPACE. RL1184.2 +016900 03 DOTVALUE PIC 99 VALUE ZERO. RL1184.2 +017000 02 FILLER PIC X(8) VALUE SPACE. RL1184.2 +017100 02 RE-MARK PIC X(61). RL1184.2 +017200 01 TEST-COMPUTED. RL1184.2 +017300 02 FILLER PIC X(30) VALUE SPACE. RL1184.2 +017400 02 FILLER PIC X(17) VALUE RL1184.2 +017500 " COMPUTED=". RL1184.2 +017600 02 COMPUTED-X. RL1184.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1184.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A RL1184.2 +017900 PIC -9(9).9(9). RL1184.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1184.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1184.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1184.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. RL1184.2 +018400 04 COMPUTED-18V0 PIC -9(18). RL1184.2 +018500 04 FILLER PIC X. RL1184.2 +018600 03 FILLER PIC X(50) VALUE SPACE. RL1184.2 +018700 01 TEST-CORRECT. RL1184.2 +018800 02 FILLER PIC X(30) VALUE SPACE. RL1184.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1184.2 +019000 02 CORRECT-X. RL1184.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1184.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1184.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1184.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1184.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1184.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. RL1184.2 +019700 04 CORRECT-18V0 PIC -9(18). RL1184.2 +019800 04 FILLER PIC X. RL1184.2 +019900 03 FILLER PIC X(2) VALUE SPACE. RL1184.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1184.2 +020100 01 CCVS-C-1. RL1184.2 +020200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1184.2 +020300- "SS PARAGRAPH-NAME RL1184.2 +020400- " REMARKS". RL1184.2 +020500 02 FILLER PIC X(20) VALUE SPACE. RL1184.2 +020600 01 CCVS-C-2. RL1184.2 +020700 02 FILLER PIC X VALUE SPACE. RL1184.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". RL1184.2 +020900 02 FILLER PIC X(15) VALUE SPACE. RL1184.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". RL1184.2 +021100 02 FILLER PIC X(94) VALUE SPACE. RL1184.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1184.2 +021300 01 REC-CT PIC 99 VALUE ZERO. RL1184.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1184.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1184.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1184.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1184.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1184.2 +022300 01 CCVS-H-1. RL1184.2 +022400 02 FILLER PIC X(39) VALUE SPACES. RL1184.2 +022500 02 FILLER PIC X(42) VALUE RL1184.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1184.2 +022700 02 FILLER PIC X(39) VALUE SPACES. RL1184.2 +022800 01 CCVS-H-2A. RL1184.2 +022900 02 FILLER PIC X(40) VALUE SPACE. RL1184.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1184.2 +023100 02 FILLER PIC XXXX VALUE RL1184.2 +023200 "4.2 ". RL1184.2 +023300 02 FILLER PIC X(28) VALUE RL1184.2 +023400 " COPY - NOT FOR DISTRIBUTION". RL1184.2 +023500 02 FILLER PIC X(41) VALUE SPACE. RL1184.2 +023600 RL1184.2 +023700 01 CCVS-H-2B. RL1184.2 +023800 02 FILLER PIC X(15) VALUE RL1184.2 +023900 "TEST RESULT OF ". RL1184.2 +024000 02 TEST-ID PIC X(9). RL1184.2 +024100 02 FILLER PIC X(4) VALUE RL1184.2 +024200 " IN ". RL1184.2 +024300 02 FILLER PIC X(12) VALUE RL1184.2 +024400 " HIGH ". RL1184.2 +024500 02 FILLER PIC X(22) VALUE RL1184.2 +024600 " LEVEL VALIDATION FOR ". RL1184.2 +024700 02 FILLER PIC X(58) VALUE RL1184.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +024900 01 CCVS-H-3. RL1184.2 +025000 02 FILLER PIC X(34) VALUE RL1184.2 +025100 " FOR OFFICIAL USE ONLY ". RL1184.2 +025200 02 FILLER PIC X(58) VALUE RL1184.2 +025300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1184.2 +025400 02 FILLER PIC X(28) VALUE RL1184.2 +025500 " COPYRIGHT 1985 ". RL1184.2 +025600 01 CCVS-E-1. RL1184.2 +025700 02 FILLER PIC X(52) VALUE SPACE. RL1184.2 +025800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1184.2 +025900 02 ID-AGAIN PIC X(9). RL1184.2 +026000 02 FILLER PIC X(45) VALUE SPACES. RL1184.2 +026100 01 CCVS-E-2. RL1184.2 +026200 02 FILLER PIC X(31) VALUE SPACE. RL1184.2 +026300 02 FILLER PIC X(21) VALUE SPACE. RL1184.2 +026400 02 CCVS-E-2-2. RL1184.2 +026500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1184.2 +026600 03 FILLER PIC X VALUE SPACE. RL1184.2 +026700 03 ENDER-DESC PIC X(44) VALUE RL1184.2 +026800 "ERRORS ENCOUNTERED". RL1184.2 +026900 01 CCVS-E-3. RL1184.2 +027000 02 FILLER PIC X(22) VALUE RL1184.2 +027100 " FOR OFFICIAL USE ONLY". RL1184.2 +027200 02 FILLER PIC X(12) VALUE SPACE. RL1184.2 +027300 02 FILLER PIC X(58) VALUE RL1184.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +027500 02 FILLER PIC X(13) VALUE SPACE. RL1184.2 +027600 02 FILLER PIC X(15) VALUE RL1184.2 +027700 " COPYRIGHT 1985". RL1184.2 +027800 01 CCVS-E-4. RL1184.2 +027900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1184.2 +028000 02 FILLER PIC X(4) VALUE " OF ". RL1184.2 +028100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1184.2 +028200 02 FILLER PIC X(40) VALUE RL1184.2 +028300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1184.2 +028400 01 XXINFO. RL1184.2 +028500 02 FILLER PIC X(19) VALUE RL1184.2 +028600 "*** INFORMATION ***". RL1184.2 +028700 02 INFO-TEXT. RL1184.2 +028800 04 FILLER PIC X(8) VALUE SPACE. RL1184.2 +028900 04 XXCOMPUTED PIC X(20). RL1184.2 +029000 04 FILLER PIC X(5) VALUE SPACE. RL1184.2 +029100 04 XXCORRECT PIC X(20). RL1184.2 +029200 02 INF-ANSI-REFERENCE PIC X(48). RL1184.2 +029300 01 HYPHEN-LINE. RL1184.2 +029400 02 FILLER PIC IS X VALUE IS SPACE. RL1184.2 +029500 02 FILLER PIC IS X(65) VALUE IS "************************RL1184.2 +029600- "*****************************************". RL1184.2 +029700 02 FILLER PIC IS X(54) VALUE IS "************************RL1184.2 +029800- "******************************". RL1184.2 +029900 01 CCVS-PGM-ID PIC X(9) VALUE RL1184.2 +030000 "RL118A". RL1184.2 +030100 PROCEDURE DIVISION. RL1184.2 +030200 CCVS1 SECTION. RL1184.2 +030300 OPEN-FILES. RL1184.2 +030400 OPEN OUTPUT PRINT-FILE. RL1184.2 +030500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1184.2 +030600 MOVE SPACE TO TEST-RESULTS. RL1184.2 +030700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1184.2 +030800 MOVE ZERO TO REC-SKL-SUB. RL1184.2 +030900 PERFORM CCVS-INIT-FILE 9 TIMES. RL1184.2 +031000 CCVS-INIT-FILE. RL1184.2 +031100 ADD 1 TO REC-SKL-SUB. RL1184.2 +031200 MOVE FILE-RECORD-INFO-SKELETON RL1184.2 +031300 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1184.2 +031400 CCVS-INIT-EXIT. RL1184.2 +031500 GO TO CCVS1-EXIT. RL1184.2 +031600 CLOSE-FILES. RL1184.2 +031700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1184.2 +031800 TERMINATE-CCVS. RL1184.2 +031900S EXIT PROGRAM. RL1184.2 +032000STERMINATE-CALL. RL1184.2 +032100 STOP RUN. RL1184.2 +032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1184.2 +032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1184.2 +032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1184.2 +032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1184.2 +032600 MOVE "****TEST DELETED****" TO RE-MARK. RL1184.2 +032700 PRINT-DETAIL. RL1184.2 +032800 IF REC-CT NOT EQUAL TO ZERO RL1184.2 +032900 MOVE "." TO PARDOT-X RL1184.2 +033000 MOVE REC-CT TO DOTVALUE. RL1184.2 +033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1184.2 +033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1184.2 +033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1184.2 +033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1184.2 +033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1184.2 +033600 MOVE SPACE TO CORRECT-X. RL1184.2 +033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1184.2 +033800 MOVE SPACE TO RE-MARK. RL1184.2 +033900 HEAD-ROUTINE. RL1184.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1184.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1184.2 +034400 COLUMN-NAMES-ROUTINE. RL1184.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +034800 END-ROUTINE. RL1184.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1184.2 +035000 END-RTN-EXIT. RL1184.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +035200 END-ROUTINE-1. RL1184.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1184.2 +035400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1184.2 +035500 ADD PASS-COUNTER TO ERROR-HOLD. RL1184.2 +035600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1184.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1184.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1184.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1184.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1184.2 +036100 END-ROUTINE-12. RL1184.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1184.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO RL1184.2 +036400 MOVE "NO " TO ERROR-TOTAL RL1184.2 +036500 ELSE RL1184.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1184.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1184.2 +036800 PERFORM WRITE-LINE. RL1184.2 +036900 END-ROUTINE-13. RL1184.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO RL1184.2 +037100 MOVE "NO " TO ERROR-TOTAL ELSE RL1184.2 +037200 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1184.2 +037300 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1184.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +037500 IF INSPECT-COUNTER EQUAL TO ZERO RL1184.2 +037600 MOVE "NO " TO ERROR-TOTAL RL1184.2 +037700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1184.2 +037800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1184.2 +037900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +038000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +038100 WRITE-LINE. RL1184.2 +038200 ADD 1 TO RECORD-COUNT. RL1184.2 +038300Y IF RECORD-COUNT GREATER 50 RL1184.2 +038400Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1184.2 +038500Y MOVE SPACE TO DUMMY-RECORD RL1184.2 +038600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1184.2 +038700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1184.2 +038800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1184.2 +038900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1184.2 +039000Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1184.2 +039100Y MOVE ZERO TO RECORD-COUNT. RL1184.2 +039200 PERFORM WRT-LN. RL1184.2 +039300 WRT-LN. RL1184.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1184.2 +039500 MOVE SPACE TO DUMMY-RECORD. RL1184.2 +039600 BLANK-LINE-PRINT. RL1184.2 +039700 PERFORM WRT-LN. RL1184.2 +039800 FAIL-ROUTINE. RL1184.2 +039900 IF COMPUTED-X NOT EQUAL TO SPACE RL1184.2 +040000 GO TO FAIL-ROUTINE-WRITE. RL1184.2 +040100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1184.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1184.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1184.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. RL1184.2 +040600 GO TO FAIL-ROUTINE-EX. RL1184.2 +040700 FAIL-ROUTINE-WRITE. RL1184.2 +040800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1184.2 +040900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1184.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1184.2 +041100 MOVE SPACES TO COR-ANSI-REFERENCE. RL1184.2 +041200 FAIL-ROUTINE-EX. EXIT. RL1184.2 +041300 BAIL-OUT. RL1184.2 +041400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1184.2 +041500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1184.2 +041600 BAIL-OUT-WRITE. RL1184.2 +041700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1184.2 +041800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1184.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1184.2 +042100 BAIL-OUT-EX. EXIT. RL1184.2 +042200 CCVS1-EXIT. RL1184.2 +042300 EXIT. RL1184.2 +042400 SECT-RL118A-001 SECTION. RL1184.2 +042500 REL-INIT-009. RL1184.2 +042600 MOVE "REL-TEST-009" TO PAR-NAME. RL1184.2 +042700 MOVE "CREATE RL-FD2" TO FEATURE RL1184.2 +042800 MOVE "RL-FD2" TO XFILE-NAME (2). RL1184.2 +042900 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1184.2 +043000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1184.2 +043100 MOVE 000240 TO XRECORD-LENGTH (2). RL1184.2 +043200 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1184.2 +043300 MOVE 0001 TO XBLOCK-SIZE (2). RL1184.2 +043400 MOVE 000500 TO RECORDS-IN-FILE (2). RL1184.2 +043500 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1184.2 +043600 MOVE "S" TO XLABEL-TYPE (2). RL1184.2 +043700 MOVE 000001 TO XRECORD-NUMBER (2). RL1184.2 +043800*INITIALIZE RECORD WORK AREA NUMBER 2. RL1184.2 +043900 MOVE 1 TO WRK-CS-09V00-012. RL1184.2 +044000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1184.2 +044100 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1184.2 +044200 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1184.2 +044300* RL1184.2 +044400 REL-INIT-1. RL1184.2 +044500 MOVE "REL-TEST-1" TO PAR-NAME. RL1184.2 +044600 MOVE "VII-3 1.3.4 3C" TO ANSI-REFERENCE. RL1184.2 +044700 MOVE 0 TO XRECORD-NUMBER (2). RL1184.2 +044800 OPEN OUTPUT RL-FD2. RL1184.2 +044900 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +045000 PERFORM REL-INIT-1-A 100 TIMES. RL1184.2 +045100 GO TO REL-DELETE-1. RL1184.2 +045200 REL-INIT-1-A. RL1184.2 +045300 ADD 1 TO XRECORD-NUMBER (2). RL1184.2 +045400 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1184.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1184.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1184.2 +045700 WRITE RL-FD2R1-F-G-240 RL1184.2 +045800 INVALID GO TO REL-DELETE-1. RL1184.2 +045900 REL-DELETE-1. RL1184.2 +046000 PERFORM DE-LETE. RL1184.2 +046100 PERFORM PRINT-DETAIL. RL1184.2 +046200 GO TO REL-INIT-2. RL1184.2 +046300 REL-TEST-1. RL1184.2 +046400 IF RL-FD2-STATUS NOT EQUAL TO "24" RL1184.2 +046500 MOVE "100TH RECORD SHOULD NOT BE WRITTEN" RL1184.2 +046600 TO RE-MARK RL1184.2 +046700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1184.2 +046800 MOVE "24" TO CORRECT-A RL1184.2 +046900 PERFORM FAIL RL1184.2 +047000 PERFORM PRINT-DETAIL RL1184.2 +047100 ELSE RL1184.2 +047200 PERFORM PASS RL1184.2 +047300 PERFORM PRINT-DETAIL. RL1184.2 +047400* RL1184.2 +047500 REL-INIT-2. RL1184.2 +047600 MOVE "REL-TEST-2" TO PAR-NAME. RL1184.2 +047700 MOVE "VII-3 1.3.4 3A" TO ANSI-REFERENCE. RL1184.2 +047800 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +047900 MOVE 27 TO RL-FD2-KEY. RL1184.2 +048000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1184.2 +048100 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1184.2 +048200 WRITE RL-FD2R1-F-G-240 RL1184.2 +048300 INVALID GO TO REL-TEST-2. RL1184.2 +048400 GO TO REL-TEST-2. RL1184.2 +048500 REL-DELETE-2. RL1184.2 +048600 PERFORM DE-LETE. RL1184.2 +048700 PERFORM PRINT-DETAIL. RL1184.2 +048800 GO TO REL-INIT-3. RL1184.2 +048900 REL-TEST-2. RL1184.2 +049000 IF RL-FD2-STATUS NOT EQUAL TO "22" RL1184.2 +049100 MOVE "DUPLICATE KEY SHOULD HAVE OCCURRED" RL1184.2 +049200 TO RE-MARK RL1184.2 +049300 MOVE RL-FD2-STATUS TO COMPUTED-A RL1184.2 +049400 MOVE "22" TO CORRECT-A RL1184.2 +049500 PERFORM FAIL RL1184.2 +049600 PERFORM PRINT-DETAIL RL1184.2 +049700 ELSE RL1184.2 +049800 PERFORM PASS RL1184.2 +049900 PERFORM PRINT-DETAIL. RL1184.2 +050000* RL1184.2 +050100* RL1184.2 +050200 REL-INIT-3. RL1184.2 +050300 MOVE "REL-TEST-3" TO PAR-NAME. RL1184.2 +050400 MOVE "VII-3 1.3.4 3B" TO ANSI-REFERENCE. RL1184.2 +050500 CLOSE RL-FD2. RL1184.2 +050600 OPEN I-O RL-FD3. RL1184.2 +050700 MOVE 999 TO RL-FD3-KEY. RL1184.2 +050800 READ RL-FD3 INVALID GO TO REL-TEST-3. RL1184.2 +050900 GO TO REL-TEST-3. RL1184.2 +051000 REL-DELETE-3. RL1184.2 +051100 PERFORM DE-LETE. RL1184.2 +051200 PERFORM PRINT-DETAIL. RL1184.2 +051300 GO TO REL-DELETE-4. RL1184.2 +051400 REL-TEST-3. RL1184.2 +051500 IF RL-FD3-STATUS NOT EQUAL TO "23" RL1184.2 +051600 MOVE "RECORD READ SHOULD NOT EXIST" TO RE-MARK RL1184.2 +051700 MOVE RL-FD3-STATUS TO COMPUTED-A RL1184.2 +051800 MOVE "23" TO CORRECT-A RL1184.2 +051900 PERFORM FAIL RL1184.2 +052000 PERFORM PRINT-DETAIL RL1184.2 +052100 ELSE RL1184.2 +052200 PERFORM PASS RL1184.2 +052300 PERFORM PRINT-DETAIL. RL1184.2 +052400* RL1184.2 +052500 REL-INIT-4. RL1184.2 +052600 MOVE "REL-TEST-4" TO PAR-NAME. RL1184.2 +052700 MOVE "VII-3 1.3.4 3C" TO ANSI-REFERENCE. RL1184.2 +052800 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +052900 MOVE 100 TO RL-FD3-KEY. RL1184.2 +053000 GO TO REL-DELETE-4. RL1184.2 +053100* WRITE RL-FD3R1-F-G-240 RL1184.2 +053200* INVALID GO TO REL-DELETE-4. RL1184.2 +053300* GO TO REL-TEST-4. RL1184.2 +053400 REL-DELETE-4. RL1184.2 +053500 PERFORM DE-LETE. RL1184.2 +053600 PERFORM PRINT-DETAIL. RL1184.2 +053700 GO TO REL-TEST-4-EXIT. RL1184.2 +053800 REL-TEST-4. RL1184.2 +053900 IF RL-FD3-STATUS NOT EQUAL TO "24" RL1184.2 +054000 MOVE "BOUNDARY VIOLATION SHOULD HAVE OCCURRED" RL1184.2 +054100 TO RE-MARK RL1184.2 +054200 MOVE RL-FD3-STATUS TO COMPUTED-A RL1184.2 +054300 MOVE "24" TO CORRECT-A RL1184.2 +054400 PERFORM FAIL RL1184.2 +054500 PERFORM PRINT-DETAIL RL1184.2 +054600 ELSE RL1184.2 +054700 PERFORM PASS RL1184.2 +054800 PERFORM PRINT-DETAIL. RL1184.2 +054900 REL-TEST-4-EXIT. RL1184.2 +055000 CLOSE RL-FD3. RL1184.2 +055100* RL1184.2 +055200 CCVS-EXIT SECTION. RL1184.2 +055300 CCVS-999999. RL1184.2 +055400 GO TO CLOSE-FILES. RL1184.2 +*END-OF,RL118A +*HEADER,COBOL,RL119A +000100 IDENTIFICATION DIVISION. RL1194.2 +000200 PROGRAM-ID. RL1194.2 +000300 RL119A. RL1194.2 +000400**************************************************************** RL1194.2 +000500* * RL1194.2 +000600* VALIDATION FOR:- * RL1194.2 +000700* * RL1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +000900* * RL1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1194.2 +001100* * RL1194.2 +001200**************************************************************** RL1194.2 +001300* * RL1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1194.2 +001500* * RL1194.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1194.2 +001700* RELATIVE I-O DATA FILE * RL1194.2 +001800* X-55 SYSTEM PRINTER * RL1194.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1194.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1194.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1194.2 +002200* X-82 SOURCE-COMPUTER * RL1194.2 +002300* X-83 OBJECT-COMPUTER. * RL1194.2 +002400* X-92 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1194.2 +002500* RELATIVE I-O DATA FILE * RL1194.2 +002600* * RL1194.2 +002700**************************************************************** RL1194.2 +002800* RL119A * RL1194.2 +002900**************************************************************** RL1194.2 +003000* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1194.2 +003100* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1194.2 +003200* CLAUSE FOR THE VALUES "35". * RL1194.2 +003300* * RL1194.2 +003400* THE CODE FOR THE VALUE "39" HAS BEEN ASTERISKED * RL1194.2 +003500* OUT AS NO SUITABLE METHOD OF TESTING THIS * RL1194.2 +003600* CONDITION IS AVAILABLE AT THE TIME OF WRITING. * RL1194.2 +003700**************************************************************** RL1194.2 +003800 ENVIRONMENT DIVISION. RL1194.2 +003900 CONFIGURATION SECTION. RL1194.2 +004000 SOURCE-COMPUTER. RL1194.2 +004100 XXXXX082. RL1194.2 +004200 OBJECT-COMPUTER. RL1194.2 +004300 XXXXX083. RL1194.2 +004400 INPUT-OUTPUT SECTION. RL1194.2 +004500 FILE-CONTROL. RL1194.2 +004600 SELECT PRINT-FILE ASSIGN TO RL1194.2 +004700 XXXXX055. RL1194.2 +004800 SELECT RL-FD3 ASSIGN RL1194.2 +004900 XXXXX092 RL1194.2 +005000 ORGANIZATION RELATIVE RL1194.2 +005100 ACCESS RANDOM RL1194.2 +005200 RELATIVE RL-FD3-KEY RL1194.2 +005300 FILE STATUS IS RL-FD3-STATUS. RL1194.2 +005400 DATA DIVISION. RL1194.2 +005500 FILE SECTION. RL1194.2 +005600 FD PRINT-FILE. RL1194.2 +005700 01 PRINT-REC PICTURE X(120). RL1194.2 +005800 01 DUMMY-RECORD PICTURE X(120). RL1194.2 +005900 FD RL-FD3 RL1194.2 +006000C VALUE OF RL1194.2 +006100C XXXXX074 RL1194.2 +006200C IS RL1194.2 +006300C XXXXX076 RL1194.2 +006400G XXXXX069 RL1194.2 +006500 LABEL RECORDS ARE STANDARD RL1194.2 +006600 BLOCK CONTAINS 1 RECORDS RL1194.2 +006700 DATA RECORD RL-FD3R1-F-G-240. RL1194.2 +006800 01 RL-FD3R1-F-G-240. RL1194.2 +006900 05 RL-FD3-WRK-120 PIC X(120). RL1194.2 +007000 05 RL-FD3-GRP-120. RL1194.2 +007100 10 RL-FD3-WRK-XN-0001-O120F RL1194.2 +007200 PICTURE X OCCURS 120 TIMES. RL1194.2 +007300 WORKING-STORAGE SECTION. RL1194.2 +007400 01 GRP-0001. RL1194.2 +007500 05 RL-FD3-KEY PIC 9(8) VALUE ZERO. RL1194.2 +007600 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007700 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007800 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007900 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008000 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008100 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008200 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008300 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1194.2 +008400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1194.2 +008500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1194.2 +008600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1194.2 +008700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1194.2 +008800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1194.2 +008900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1194.2 +009000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1194.2 +009100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1194.2 +009200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1194.2 +009300 01 FILE-RECORD-INFORMATION-REC. RL1194.2 +009400 03 FILE-RECORD-INFO-SKELETON. RL1194.2 +009500 05 FILLER PICTURE X(48) VALUE RL1194.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1194.2 +009700 05 FILLER PICTURE X(46) VALUE RL1194.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1194.2 +009900 05 FILLER PICTURE X(26) VALUE RL1194.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". RL1194.2 +010100 05 FILLER PICTURE X(37) VALUE RL1194.2 +010200 ",RECKEY= ". RL1194.2 +010300 05 FILLER PICTURE X(38) VALUE RL1194.2 +010400 ",ALTKEY1= ". RL1194.2 +010500 05 FILLER PICTURE X(38) VALUE RL1194.2 +010600 ",ALTKEY2= ". RL1194.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.RL1194.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1194.2 +010900 05 FILE-RECORD-INFO-P1-120. RL1194.2 +011000 07 FILLER PIC X(5). RL1194.2 +011100 07 XFILE-NAME PIC X(6). RL1194.2 +011200 07 FILLER PIC X(8). RL1194.2 +011300 07 XRECORD-NAME PIC X(6). RL1194.2 +011400 07 FILLER PIC X(1). RL1194.2 +011500 07 REELUNIT-NUMBER PIC 9(1). RL1194.2 +011600 07 FILLER PIC X(7). RL1194.2 +011700 07 XRECORD-NUMBER PIC 9(6). RL1194.2 +011800 07 FILLER PIC X(6). RL1194.2 +011900 07 UPDATE-NUMBER PIC 9(2). RL1194.2 +012000 07 FILLER PIC X(5). RL1194.2 +012100 07 ODO-NUMBER PIC 9(4). RL1194.2 +012200 07 FILLER PIC X(5). RL1194.2 +012300 07 XPROGRAM-NAME PIC X(5). RL1194.2 +012400 07 FILLER PIC X(7). RL1194.2 +012500 07 XRECORD-LENGTH PIC 9(6). RL1194.2 +012600 07 FILLER PIC X(7). RL1194.2 +012700 07 CHARS-OR-RECORDS PIC X(2). RL1194.2 +012800 07 FILLER PIC X(1). RL1194.2 +012900 07 XBLOCK-SIZE PIC 9(4). RL1194.2 +013000 07 FILLER PIC X(6). RL1194.2 +013100 07 RECORDS-IN-FILE PIC 9(6). RL1194.2 +013200 07 FILLER PIC X(5). RL1194.2 +013300 07 XFILE-ORGANIZATION PIC X(2). RL1194.2 +013400 07 FILLER PIC X(6). RL1194.2 +013500 07 XLABEL-TYPE PIC X(1). RL1194.2 +013600 05 FILE-RECORD-INFO-P121-240. RL1194.2 +013700 07 FILLER PIC X(8). RL1194.2 +013800 07 XRECORD-KEY PIC X(29). RL1194.2 +013900 07 FILLER PIC X(9). RL1194.2 +014000 07 ALTERNATE-KEY1 PIC X(29). RL1194.2 +014100 07 FILLER PIC X(9). RL1194.2 +014200 07 ALTERNATE-KEY2 PIC X(29). RL1194.2 +014300 07 FILLER PIC X(7). RL1194.2 +014400 01 TEST-RESULTS. RL1194.2 +014500 02 FILLER PIC X VALUE SPACE. RL1194.2 +014600 02 FEATURE PIC X(20) VALUE SPACE. RL1194.2 +014700 02 FILLER PIC X VALUE SPACE. RL1194.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. RL1194.2 +014900 02 FILLER PIC X VALUE SPACE. RL1194.2 +015000 02 PAR-NAME. RL1194.2 +015100 03 FILLER PIC X(19) VALUE SPACE. RL1194.2 +015200 03 PARDOT-X PIC X VALUE SPACE. RL1194.2 +015300 03 DOTVALUE PIC 99 VALUE ZERO. RL1194.2 +015400 02 FILLER PIC X(8) VALUE SPACE. RL1194.2 +015500 02 RE-MARK PIC X(61). RL1194.2 +015600 01 TEST-COMPUTED. RL1194.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL1194.2 +015800 02 FILLER PIC X(17) VALUE RL1194.2 +015900 " COMPUTED=". RL1194.2 +016000 02 COMPUTED-X. RL1194.2 +016100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1194.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A RL1194.2 +016300 PIC -9(9).9(9). RL1194.2 +016400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1194.2 +016500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1194.2 +016600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1194.2 +016700 03 CM-18V0 REDEFINES COMPUTED-A. RL1194.2 +016800 04 COMPUTED-18V0 PIC -9(18). RL1194.2 +016900 04 FILLER PIC X. RL1194.2 +017000 03 FILLER PIC X(50) VALUE SPACE. RL1194.2 +017100 01 TEST-CORRECT. RL1194.2 +017200 02 FILLER PIC X(30) VALUE SPACE. RL1194.2 +017300 02 FILLER PIC X(17) VALUE " CORRECT =". RL1194.2 +017400 02 CORRECT-X. RL1194.2 +017500 03 CORRECT-A PIC X(20) VALUE SPACE. RL1194.2 +017600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1194.2 +017700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1194.2 +017800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1194.2 +017900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1194.2 +018000 03 CR-18V0 REDEFINES CORRECT-A. RL1194.2 +018100 04 CORRECT-18V0 PIC -9(18). RL1194.2 +018200 04 FILLER PIC X. RL1194.2 +018300 03 FILLER PIC X(2) VALUE SPACE. RL1194.2 +018400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1194.2 +018500 01 CCVS-C-1. RL1194.2 +018600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1194.2 +018700- "SS PARAGRAPH-NAME RL1194.2 +018800- " REMARKS". RL1194.2 +018900 02 FILLER PIC X(20) VALUE SPACE. RL1194.2 +019000 01 CCVS-C-2. RL1194.2 +019100 02 FILLER PIC X VALUE SPACE. RL1194.2 +019200 02 FILLER PIC X(6) VALUE "TESTED". RL1194.2 +019300 02 FILLER PIC X(15) VALUE SPACE. RL1194.2 +019400 02 FILLER PIC X(4) VALUE "FAIL". RL1194.2 +019500 02 FILLER PIC X(94) VALUE SPACE. RL1194.2 +019600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1194.2 +019700 01 REC-CT PIC 99 VALUE ZERO. RL1194.2 +019800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1194.2 +019900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1194.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1194.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1194.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1194.2 +020600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1194.2 +020700 01 CCVS-H-1. RL1194.2 +020800 02 FILLER PIC X(39) VALUE SPACES. RL1194.2 +020900 02 FILLER PIC X(42) VALUE RL1194.2 +021000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1194.2 +021100 02 FILLER PIC X(39) VALUE SPACES. RL1194.2 +021200 01 CCVS-H-2A. RL1194.2 +021300 02 FILLER PIC X(40) VALUE SPACE. RL1194.2 +021400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1194.2 +021500 02 FILLER PIC XXXX VALUE RL1194.2 +021600 "4.2 ". RL1194.2 +021700 02 FILLER PIC X(28) VALUE RL1194.2 +021800 " COPY - NOT FOR DISTRIBUTION". RL1194.2 +021900 02 FILLER PIC X(41) VALUE SPACE. RL1194.2 +022000 RL1194.2 +022100 01 CCVS-H-2B. RL1194.2 +022200 02 FILLER PIC X(15) VALUE RL1194.2 +022300 "TEST RESULT OF ". RL1194.2 +022400 02 TEST-ID PIC X(9). RL1194.2 +022500 02 FILLER PIC X(4) VALUE RL1194.2 +022600 " IN ". RL1194.2 +022700 02 FILLER PIC X(12) VALUE RL1194.2 +022800 " HIGH ". RL1194.2 +022900 02 FILLER PIC X(22) VALUE RL1194.2 +023000 " LEVEL VALIDATION FOR ". RL1194.2 +023100 02 FILLER PIC X(58) VALUE RL1194.2 +023200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +023300 01 CCVS-H-3. RL1194.2 +023400 02 FILLER PIC X(34) VALUE RL1194.2 +023500 " FOR OFFICIAL USE ONLY ". RL1194.2 +023600 02 FILLER PIC X(58) VALUE RL1194.2 +023700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1194.2 +023800 02 FILLER PIC X(28) VALUE RL1194.2 +023900 " COPYRIGHT 1985 ". RL1194.2 +024000 01 CCVS-E-1. RL1194.2 +024100 02 FILLER PIC X(52) VALUE SPACE. RL1194.2 +024200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1194.2 +024300 02 ID-AGAIN PIC X(9). RL1194.2 +024400 02 FILLER PIC X(45) VALUE SPACES. RL1194.2 +024500 01 CCVS-E-2. RL1194.2 +024600 02 FILLER PIC X(31) VALUE SPACE. RL1194.2 +024700 02 FILLER PIC X(21) VALUE SPACE. RL1194.2 +024800 02 CCVS-E-2-2. RL1194.2 +024900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1194.2 +025000 03 FILLER PIC X VALUE SPACE. RL1194.2 +025100 03 ENDER-DESC PIC X(44) VALUE RL1194.2 +025200 "ERRORS ENCOUNTERED". RL1194.2 +025300 01 CCVS-E-3. RL1194.2 +025400 02 FILLER PIC X(22) VALUE RL1194.2 +025500 " FOR OFFICIAL USE ONLY". RL1194.2 +025600 02 FILLER PIC X(12) VALUE SPACE. RL1194.2 +025700 02 FILLER PIC X(58) VALUE RL1194.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +025900 02 FILLER PIC X(13) VALUE SPACE. RL1194.2 +026000 02 FILLER PIC X(15) VALUE RL1194.2 +026100 " COPYRIGHT 1985". RL1194.2 +026200 01 CCVS-E-4. RL1194.2 +026300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1194.2 +026400 02 FILLER PIC X(4) VALUE " OF ". RL1194.2 +026500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1194.2 +026600 02 FILLER PIC X(40) VALUE RL1194.2 +026700 " TESTS WERE EXECUTED SUCCESSFULLY". RL1194.2 +026800 01 XXINFO. RL1194.2 +026900 02 FILLER PIC X(19) VALUE RL1194.2 +027000 "*** INFORMATION ***". RL1194.2 +027100 02 INFO-TEXT. RL1194.2 +027200 04 FILLER PIC X(8) VALUE SPACE. RL1194.2 +027300 04 XXCOMPUTED PIC X(20). RL1194.2 +027400 04 FILLER PIC X(5) VALUE SPACE. RL1194.2 +027500 04 XXCORRECT PIC X(20). RL1194.2 +027600 02 INF-ANSI-REFERENCE PIC X(48). RL1194.2 +027700 01 HYPHEN-LINE. RL1194.2 +027800 02 FILLER PIC IS X VALUE IS SPACE. RL1194.2 +027900 02 FILLER PIC IS X(65) VALUE IS "************************RL1194.2 +028000- "*****************************************". RL1194.2 +028100 02 FILLER PIC IS X(54) VALUE IS "************************RL1194.2 +028200- "******************************". RL1194.2 +028300 01 CCVS-PGM-ID PIC X(9) VALUE RL1194.2 +028400 "RL119A". RL1194.2 +028500 PROCEDURE DIVISION. RL1194.2 +028600 DECLARATIVES. RL1194.2 +028700 RL-FD3-01 SECTION. RL1194.2 +028800 USE AFTER ERROR PROCEDURE RL-FD3. RL1194.2 +028900 RL-FD3-01-01. RL1194.2 +029000 IF RL-FD3-STATUS EQUAL TO "35" RL1194.2 +029100 PERFORM D-PASS RL1194.2 +029200 ELSE RL1194.2 +029300 MOVE RL-FD3-STATUS TO COMPUTED-A RL1194.2 +029400 MOVE "35" TO CORRECT-A RL1194.2 +029500 PERFORM D-FAIL. RL1194.2 +029600 PERFORM D-PRINT-DETAIL. RL1194.2 +029700 GO TO D-CLOSE-FILES. RL1194.2 +029800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1194.2 +029900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1194.2 +030000 D-CLOSE-FILES. RL1194.2 +030100 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. RL1194.2 +030200 CLOSE PRINT-FILE. RL1194.2 +030300 STOP RUN. RL1194.2 +030400 D-PRINT-DETAIL. RL1194.2 +030500 IF REC-CT NOT EQUAL TO ZERO RL1194.2 +030600 MOVE "." TO PARDOT-X RL1194.2 +030700 MOVE REC-CT TO DOTVALUE. RL1194.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. RL1194.2 +030900 PERFORM D-WRITE-LINE. RL1194.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE RL1194.2 +031100 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX RL1194.2 +031200 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. RL1194.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1194.2 +031400 MOVE SPACE TO CORRECT-X. RL1194.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1194.2 +031600 MOVE SPACE TO RE-MARK. RL1194.2 +031700 D-END-ROUTINE. RL1194.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. RL1194.2 +031900 PERFORM D-WRITE-LINE 5 TIMES. RL1194.2 +032000 D-END-RTN-EXIT. RL1194.2 +032100 MOVE CCVS-E-1 TO DUMMY-RECORD. RL1194.2 +032200 PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +032300 D-END-ROUTINE-1. RL1194.2 +032400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1194.2 +032500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1194.2 +032600 ADD PASS-COUNTER TO ERROR-HOLD. RL1194.2 +032700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO D-END-ROUTINE-12. RL1194.2 +032800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1194.2 +032900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1194.2 +033000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1194.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. RL1194.2 +033200 D-END-ROUTINE-12. RL1194.2 +033300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1194.2 +033400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1194.2 +033500 MOVE "NO " TO ERROR-TOTAL RL1194.2 +033600 ELSE RL1194.2 +033700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1194.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1194.2 +033900 PERFORM D-WRITE-LINE. RL1194.2 +034000 D-END-ROUTINE-13. RL1194.2 +034100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1194.2 +034200 MOVE "NO " TO ERROR-TOTAL ELSE RL1194.2 +034300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1194.2 +034400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1194.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +034600 IF INSPECT-COUNTER EQUAL TO ZERO RL1194.2 +034700 MOVE "NO " TO ERROR-TOTAL RL1194.2 +034800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1194.2 +034900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1194.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +035100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +035200 D-WRITE-LINE. RL1194.2 +035300 ADD 1 TO RECORD-COUNT. RL1194.2 +035400Y IF RECORD-COUNT GREATER 50 RL1194.2 +035500Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1194.2 +035600Y MOVE SPACE TO DUMMY-RECORD RL1194.2 +035700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1194.2 +035800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN RL1194.2 +035900Y MOVE CCVS-C-2 TO DUMMY-RECORD RL1194.2 +036000Y PERFORM D-WRT-LN 2 TIMES RL1194.2 +036100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN RL1194.2 +036200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1194.2 +036300Y MOVE ZERO TO RECORD-COUNT. RL1194.2 +036400 PERFORM D-WRT-LN. RL1194.2 +036500 D-WRT-LN. RL1194.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1194.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL1194.2 +036800 D-FAIL-ROUTINE. RL1194.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE RL1194.2 +037000 GO TO D-FAIL-ROUTINE-WRITE. RL1194.2 +037100 IF CORRECT-X NOT EQUAL TO SPACE RL1194.2 +037200 GO TO D-FAIL-ROUTINE-WRITE. RL1194.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1194.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +037700 GO TO D-FAIL-ROUTINE-EX. RL1194.2 +037800 D-FAIL-ROUTINE-WRITE. RL1194.2 +037900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE RL1194.2 +038000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1194.2 +038100 MOVE TEST-CORRECT TO PRINT-REC RL1194.2 +038200 PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1194.2 +038400 D-FAIL-ROUTINE-EX. EXIT. RL1194.2 +038500 D-BAIL-OUT. RL1194.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. RL1194.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. RL1194.2 +038800 D-BAIL-OUT-WRITE. RL1194.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1194.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +039300 D-BAIL-OUT-EX. EXIT. RL1194.2 +039400 END DECLARATIVES. RL1194.2 +039500 CCVS1 SECTION. RL1194.2 +039600 OPEN-FILES. RL1194.2 +039700 OPEN OUTPUT PRINT-FILE. RL1194.2 +039800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1194.2 +039900 MOVE SPACE TO TEST-RESULTS. RL1194.2 +040000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1194.2 +040100 MOVE ZERO TO REC-SKL-SUB. RL1194.2 +040200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1194.2 +040300 CCVS-INIT-FILE. RL1194.2 +040400 ADD 1 TO REC-SKL-SUB. RL1194.2 +040500 MOVE FILE-RECORD-INFO-SKELETON RL1194.2 +040600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1194.2 +040700 CCVS-INIT-EXIT. RL1194.2 +040800 GO TO CCVS1-EXIT. RL1194.2 +040900 CLOSE-FILES. RL1194.2 +041000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1194.2 +041100 TERMINATE-CCVS. RL1194.2 +041200S EXIT PROGRAM. RL1194.2 +041300STERMINATE-CALL. RL1194.2 +041400 STOP RUN. RL1194.2 +041500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1194.2 +041600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1194.2 +041700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1194.2 +041800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1194.2 +041900 MOVE "****TEST DELETED****" TO RE-MARK. RL1194.2 +042000 PRINT-DETAIL. RL1194.2 +042100 IF REC-CT NOT EQUAL TO ZERO RL1194.2 +042200 MOVE "." TO PARDOT-X RL1194.2 +042300 MOVE REC-CT TO DOTVALUE. RL1194.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1194.2 +042500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1194.2 +042600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1194.2 +042700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1194.2 +042800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1194.2 +042900 MOVE SPACE TO CORRECT-X. RL1194.2 +043000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1194.2 +043100 MOVE SPACE TO RE-MARK. RL1194.2 +043200 HEAD-ROUTINE. RL1194.2 +043300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +043400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +043500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1194.2 +043600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1194.2 +043700 COLUMN-NAMES-ROUTINE. RL1194.2 +043800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +043900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +044000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +044100 END-ROUTINE. RL1194.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1194.2 +044300 END-RTN-EXIT. RL1194.2 +044400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +044500 END-ROUTINE-1. RL1194.2 +044600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1194.2 +044700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1194.2 +044800 ADD PASS-COUNTER TO ERROR-HOLD. RL1194.2 +044900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1194.2 +045000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1194.2 +045100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1194.2 +045200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1194.2 +045300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1194.2 +045400 END-ROUTINE-12. RL1194.2 +045500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1194.2 +045600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1194.2 +045700 MOVE "NO " TO ERROR-TOTAL RL1194.2 +045800 ELSE RL1194.2 +045900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1194.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1194.2 +046100 PERFORM WRITE-LINE. RL1194.2 +046200 END-ROUTINE-13. RL1194.2 +046300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1194.2 +046400 MOVE "NO " TO ERROR-TOTAL ELSE RL1194.2 +046500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1194.2 +046600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1194.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +046800 IF INSPECT-COUNTER EQUAL TO ZERO RL1194.2 +046900 MOVE "NO " TO ERROR-TOTAL RL1194.2 +047000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1194.2 +047100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1194.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +047300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +047400 WRITE-LINE. RL1194.2 +047500 ADD 1 TO RECORD-COUNT. RL1194.2 +047600Y IF RECORD-COUNT GREATER 50 RL1194.2 +047700Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL1194.2 +047800Y MOVE SPACE TO DUMMY-RECORD RL1194.2 +047900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1194.2 +048000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1194.2 +048100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1194.2 +048200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1194.2 +048300Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL1194.2 +048400Y MOVE ZERO TO RECORD-COUNT. RL1194.2 +048500 PERFORM WRT-LN. RL1194.2 +048600 WRT-LN. RL1194.2 +048700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1194.2 +048800 MOVE SPACE TO DUMMY-RECORD. RL1194.2 +048900 BLANK-LINE-PRINT. RL1194.2 +049000 PERFORM WRT-LN. RL1194.2 +049100 FAIL-ROUTINE. RL1194.2 +049200 IF COMPUTED-X NOT EQUAL TO SPACE RL1194.2 +049300 GO TO FAIL-ROUTINE-WRITE. RL1194.2 +049400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1194.2 +049500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +049600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1194.2 +049700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +049800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +049900 GO TO FAIL-ROUTINE-EX. RL1194.2 +050000 FAIL-ROUTINE-WRITE. RL1194.2 +050100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1194.2 +050200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1194.2 +050300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1194.2 +050400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1194.2 +050500 FAIL-ROUTINE-EX. EXIT. RL1194.2 +050600 BAIL-OUT. RL1194.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1194.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1194.2 +050900 BAIL-OUT-WRITE. RL1194.2 +051000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1194.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +051200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +051300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +051400 BAIL-OUT-EX. EXIT. RL1194.2 +051500 CCVS1-EXIT. RL1194.2 +051600 EXIT. RL1194.2 +051700 SECT-RL119A-001 SECTION. RL1194.2 +051800* RL1194.2 +051900 REL-INIT-1. RL1194.2 +052000 MOVE "REL-TEST-1" TO PAR-NAME. RL1194.2 +052100 MOVE "VIII-4 1.3.4 4B" TO ANSI-REFERENCE. RL1194.2 +052200 MOVE SPACE TO RL-FD3-STATUS. RL1194.2 +052300 OPEN I-O RL-FD3. RL1194.2 +052400 GO TO REL-TEST-1. RL1194.2 +052500 REL-DELETE-1. RL1194.2 +052600 PERFORM DE-LETE. RL1194.2 +052700 PERFORM PRINT-DETAIL. RL1194.2 +052800 GO TO REL-TEST-1-EXIT. RL1194.2 +052900 REL-TEST-1. RL1194.2 +053000 IF RL-FD3-STATUS NOT EQUAL TO "35" RL1194.2 +053100 MOVE "NON-EXISTING FILE HAS BEEN OPENED" RL1194.2 +053200 TO RE-MARK RL1194.2 +053300 MOVE RL-FD3-STATUS TO COMPUTED-A RL1194.2 +053400 MOVE "35" TO CORRECT-A RL1194.2 +053500 PERFORM FAIL RL1194.2 +053600 PERFORM PRINT-DETAIL RL1194.2 +053700 ELSE RL1194.2 +053800 PERFORM PASS RL1194.2 +053900 PERFORM PRINT-DETAIL. RL1194.2 +054000 REL-TEST-1-EXIT. RL1194.2 +054100* EXIT. RL1194.2 +054200* RL1194.2 +054300 CCVS-EXIT SECTION. RL1194.2 +054400 CCVS-999999. RL1194.2 +054500 GO TO CLOSE-FILES. RL1194.2 +*END-OF,RL119A +*HEADER,COBOL,RL201A +000100 IDENTIFICATION DIVISION. RL2014.2 +000200 PROGRAM-ID. RL2014.2 +000300 RL201A. RL2014.2 +000400**************************************************************** RL2014.2 +000500* * RL2014.2 +000600* VALIDATION FOR:- * RL2014.2 +000700* * RL2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +000900* * RL2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2014.2 +001100* * RL2014.2 +001200**************************************************************** RL2014.2 +001300*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL2014.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL2014.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL2014.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL2014.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL2014.2 +001800* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL2014.2 +001900* RL2014.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2014.2 +002100* PROGRAM ARE: RL2014.2 +002200* RL2014.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2014.2 +002400* RELATIVE I-O DATA FILE RL2014.2 +002500* X-55 SYSTEM PRINTER RL2014.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2014.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2014.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2014.2 +002900* X-82 SOURCE-COMPUTER RL2014.2 +003000* X-83 OBJECT-COMPUTER. RL2014.2 +003100* RL2014.2 +003200**************************************************************** RL2014.2 +003300 ENVIRONMENT DIVISION. RL2014.2 +003400 CONFIGURATION SECTION. RL2014.2 +003500 SOURCE-COMPUTER. RL2014.2 +003600 XXXXX082. RL2014.2 +003700 OBJECT-COMPUTER. RL2014.2 +003800 XXXXX083. RL2014.2 +003900 INPUT-OUTPUT SECTION. RL2014.2 +004000 FILE-CONTROL. RL2014.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2014.2 +004200 XXXXX055. RL2014.2 +004300 SELECT RL-FS1 ASSIGN TO RL2014.2 +004400 XXXXP021 RL2014.2 +004500 ORGANIZATION IS RELATIVE. RL2014.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2014.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2014.2 +004800 DATA DIVISION. RL2014.2 +004900 FILE SECTION. RL2014.2 +005000 FD PRINT-FILE. RL2014.2 +005100 01 PRINT-REC PICTURE X(120). RL2014.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2014.2 +005300 FD RL-FS1 RL2014.2 +005400 LABEL RECORDS STANDARD RL2014.2 +005500C VALUE OF RL2014.2 +005600C XXXXX074 RL2014.2 +005700C IS RL2014.2 +005800C XXXXX075 RL2014.2 +005900G XXXXX069 RL2014.2 +006000 BLOCK CONTAINS 1 RECORDS RL2014.2 +006100 RECORD CONTAINS 120 CHARACTERS. RL2014.2 +006200 01 RL-FS1R1-F-G-120. RL2014.2 +006300 02 FILLER PIC X(120). RL2014.2 +006400 WORKING-STORAGE SECTION. RL2014.2 +006500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2014.2 +006600 01 FILE-RECORD-INFORMATION-REC. RL2014.2 +006700 03 FILE-RECORD-INFO-SKELETON. RL2014.2 +006800 05 FILLER PICTURE X(48) VALUE RL2014.2 +006900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2014.2 +007000 05 FILLER PICTURE X(46) VALUE RL2014.2 +007100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2014.2 +007200 05 FILLER PICTURE X(26) VALUE RL2014.2 +007300 ",LFIL=000000,ORG= ,LBLR= ". RL2014.2 +007400 05 FILLER PICTURE X(37) VALUE RL2014.2 +007500 ",RECKEY= ". RL2014.2 +007600 05 FILLER PICTURE X(38) VALUE RL2014.2 +007700 ",ALTKEY1= ". RL2014.2 +007800 05 FILLER PICTURE X(38) VALUE RL2014.2 +007900 ",ALTKEY2= ". RL2014.2 +008000 05 FILLER PICTURE X(7) VALUE SPACE.RL2014.2 +008100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2014.2 +008200 05 FILE-RECORD-INFO-P1-120. RL2014.2 +008300 07 FILLER PIC X(5). RL2014.2 +008400 07 XFILE-NAME PIC X(6). RL2014.2 +008500 07 FILLER PIC X(8). RL2014.2 +008600 07 XRECORD-NAME PIC X(6). RL2014.2 +008700 07 FILLER PIC X(1). RL2014.2 +008800 07 REELUNIT-NUMBER PIC 9(1). RL2014.2 +008900 07 FILLER PIC X(7). RL2014.2 +009000 07 XRECORD-NUMBER PIC 9(6). RL2014.2 +009100 07 FILLER PIC X(6). RL2014.2 +009200 07 UPDATE-NUMBER PIC 9(2). RL2014.2 +009300 07 FILLER PIC X(5). RL2014.2 +009400 07 ODO-NUMBER PIC 9(4). RL2014.2 +009500 07 FILLER PIC X(5). RL2014.2 +009600 07 XPROGRAM-NAME PIC X(5). RL2014.2 +009700 07 FILLER PIC X(7). RL2014.2 +009800 07 XRECORD-LENGTH PIC 9(6). RL2014.2 +009900 07 FILLER PIC X(7). RL2014.2 +010000 07 CHARS-OR-RECORDS PIC X(2). RL2014.2 +010100 07 FILLER PIC X(1). RL2014.2 +010200 07 XBLOCK-SIZE PIC 9(4). RL2014.2 +010300 07 FILLER PIC X(6). RL2014.2 +010400 07 RECORDS-IN-FILE PIC 9(6). RL2014.2 +010500 07 FILLER PIC X(5). RL2014.2 +010600 07 XFILE-ORGANIZATION PIC X(2). RL2014.2 +010700 07 FILLER PIC X(6). RL2014.2 +010800 07 XLABEL-TYPE PIC X(1). RL2014.2 +010900 05 FILE-RECORD-INFO-P121-240. RL2014.2 +011000 07 FILLER PIC X(8). RL2014.2 +011100 07 XRECORD-KEY PIC X(29). RL2014.2 +011200 07 FILLER PIC X(9). RL2014.2 +011300 07 ALTERNATE-KEY1 PIC X(29). RL2014.2 +011400 07 FILLER PIC X(9). RL2014.2 +011500 07 ALTERNATE-KEY2 PIC X(29). RL2014.2 +011600 07 FILLER PIC X(7). RL2014.2 +011700 01 TEST-RESULTS. RL2014.2 +011800 02 FILLER PIC X VALUE SPACE. RL2014.2 +011900 02 FEATURE PIC X(20) VALUE SPACE. RL2014.2 +012000 02 FILLER PIC X VALUE SPACE. RL2014.2 +012100 02 P-OR-F PIC X(5) VALUE SPACE. RL2014.2 +012200 02 FILLER PIC X VALUE SPACE. RL2014.2 +012300 02 PAR-NAME. RL2014.2 +012400 03 FILLER PIC X(19) VALUE SPACE. RL2014.2 +012500 03 PARDOT-X PIC X VALUE SPACE. RL2014.2 +012600 03 DOTVALUE PIC 99 VALUE ZERO. RL2014.2 +012700 02 FILLER PIC X(8) VALUE SPACE. RL2014.2 +012800 02 RE-MARK PIC X(61). RL2014.2 +012900 01 TEST-COMPUTED. RL2014.2 +013000 02 FILLER PIC X(30) VALUE SPACE. RL2014.2 +013100 02 FILLER PIC X(17) VALUE RL2014.2 +013200 " COMPUTED=". RL2014.2 +013300 02 COMPUTED-X. RL2014.2 +013400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2014.2 +013500 03 COMPUTED-N REDEFINES COMPUTED-A RL2014.2 +013600 PIC -9(9).9(9). RL2014.2 +013700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2014.2 +013800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2014.2 +013900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2014.2 +014000 03 CM-18V0 REDEFINES COMPUTED-A. RL2014.2 +014100 04 COMPUTED-18V0 PIC -9(18). RL2014.2 +014200 04 FILLER PIC X. RL2014.2 +014300 03 FILLER PIC X(50) VALUE SPACE. RL2014.2 +014400 01 TEST-CORRECT. RL2014.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2014.2 +014600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2014.2 +014700 02 CORRECT-X. RL2014.2 +014800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2014.2 +014900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2014.2 +015000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2014.2 +015100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2014.2 +015200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2014.2 +015300 03 CR-18V0 REDEFINES CORRECT-A. RL2014.2 +015400 04 CORRECT-18V0 PIC -9(18). RL2014.2 +015500 04 FILLER PIC X. RL2014.2 +015600 03 FILLER PIC X(2) VALUE SPACE. RL2014.2 +015700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2014.2 +015800 01 CCVS-C-1. RL2014.2 +015900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2014.2 +016000- "SS PARAGRAPH-NAME RL2014.2 +016100- " REMARKS". RL2014.2 +016200 02 FILLER PIC X(20) VALUE SPACE. RL2014.2 +016300 01 CCVS-C-2. RL2014.2 +016400 02 FILLER PIC X VALUE SPACE. RL2014.2 +016500 02 FILLER PIC X(6) VALUE "TESTED". RL2014.2 +016600 02 FILLER PIC X(15) VALUE SPACE. RL2014.2 +016700 02 FILLER PIC X(4) VALUE "FAIL". RL2014.2 +016800 02 FILLER PIC X(94) VALUE SPACE. RL2014.2 +016900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2014.2 +017000 01 REC-CT PIC 99 VALUE ZERO. RL2014.2 +017100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2014.2 +017600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2014.2 +017700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2014.2 +017800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2014.2 +017900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2014.2 +018000 01 CCVS-H-1. RL2014.2 +018100 02 FILLER PIC X(39) VALUE SPACES. RL2014.2 +018200 02 FILLER PIC X(42) VALUE RL2014.2 +018300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2014.2 +018400 02 FILLER PIC X(39) VALUE SPACES. RL2014.2 +018500 01 CCVS-H-2A. RL2014.2 +018600 02 FILLER PIC X(40) VALUE SPACE. RL2014.2 +018700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2014.2 +018800 02 FILLER PIC XXXX VALUE RL2014.2 +018900 "4.2 ". RL2014.2 +019000 02 FILLER PIC X(28) VALUE RL2014.2 +019100 " COPY - NOT FOR DISTRIBUTION". RL2014.2 +019200 02 FILLER PIC X(41) VALUE SPACE. RL2014.2 +019300 RL2014.2 +019400 01 CCVS-H-2B. RL2014.2 +019500 02 FILLER PIC X(15) VALUE RL2014.2 +019600 "TEST RESULT OF ". RL2014.2 +019700 02 TEST-ID PIC X(9). RL2014.2 +019800 02 FILLER PIC X(4) VALUE RL2014.2 +019900 " IN ". RL2014.2 +020000 02 FILLER PIC X(12) VALUE RL2014.2 +020100 " HIGH ". RL2014.2 +020200 02 FILLER PIC X(22) VALUE RL2014.2 +020300 " LEVEL VALIDATION FOR ". RL2014.2 +020400 02 FILLER PIC X(58) VALUE RL2014.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +020600 01 CCVS-H-3. RL2014.2 +020700 02 FILLER PIC X(34) VALUE RL2014.2 +020800 " FOR OFFICIAL USE ONLY ". RL2014.2 +020900 02 FILLER PIC X(58) VALUE RL2014.2 +021000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2014.2 +021100 02 FILLER PIC X(28) VALUE RL2014.2 +021200 " COPYRIGHT 1985 ". RL2014.2 +021300 01 CCVS-E-1. RL2014.2 +021400 02 FILLER PIC X(52) VALUE SPACE. RL2014.2 +021500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2014.2 +021600 02 ID-AGAIN PIC X(9). RL2014.2 +021700 02 FILLER PIC X(45) VALUE SPACES. RL2014.2 +021800 01 CCVS-E-2. RL2014.2 +021900 02 FILLER PIC X(31) VALUE SPACE. RL2014.2 +022000 02 FILLER PIC X(21) VALUE SPACE. RL2014.2 +022100 02 CCVS-E-2-2. RL2014.2 +022200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2014.2 +022300 03 FILLER PIC X VALUE SPACE. RL2014.2 +022400 03 ENDER-DESC PIC X(44) VALUE RL2014.2 +022500 "ERRORS ENCOUNTERED". RL2014.2 +022600 01 CCVS-E-3. RL2014.2 +022700 02 FILLER PIC X(22) VALUE RL2014.2 +022800 " FOR OFFICIAL USE ONLY". RL2014.2 +022900 02 FILLER PIC X(12) VALUE SPACE. RL2014.2 +023000 02 FILLER PIC X(58) VALUE RL2014.2 +023100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +023200 02 FILLER PIC X(13) VALUE SPACE. RL2014.2 +023300 02 FILLER PIC X(15) VALUE RL2014.2 +023400 " COPYRIGHT 1985". RL2014.2 +023500 01 CCVS-E-4. RL2014.2 +023600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2014.2 +023700 02 FILLER PIC X(4) VALUE " OF ". RL2014.2 +023800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2014.2 +023900 02 FILLER PIC X(40) VALUE RL2014.2 +024000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2014.2 +024100 01 XXINFO. RL2014.2 +024200 02 FILLER PIC X(19) VALUE RL2014.2 +024300 "*** INFORMATION ***". RL2014.2 +024400 02 INFO-TEXT. RL2014.2 +024500 04 FILLER PIC X(8) VALUE SPACE. RL2014.2 +024600 04 XXCOMPUTED PIC X(20). RL2014.2 +024700 04 FILLER PIC X(5) VALUE SPACE. RL2014.2 +024800 04 XXCORRECT PIC X(20). RL2014.2 +024900 02 INF-ANSI-REFERENCE PIC X(48). RL2014.2 +025000 01 HYPHEN-LINE. RL2014.2 +025100 02 FILLER PIC IS X VALUE IS SPACE. RL2014.2 +025200 02 FILLER PIC IS X(65) VALUE IS "************************RL2014.2 +025300- "*****************************************". RL2014.2 +025400 02 FILLER PIC IS X(54) VALUE IS "************************RL2014.2 +025500- "******************************". RL2014.2 +025600 01 CCVS-PGM-ID PIC X(9) VALUE RL2014.2 +025700 "RL201A". RL2014.2 +025800 PROCEDURE DIVISION. RL2014.2 +025900 CCVS1 SECTION. RL2014.2 +026000 OPEN-FILES. RL2014.2 +026100 OPEN OUTPUT PRINT-FILE. RL2014.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2014.2 +026300 MOVE SPACE TO TEST-RESULTS. RL2014.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2014.2 +026500 MOVE ZERO TO REC-SKL-SUB. RL2014.2 +026600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2014.2 +026700 CCVS-INIT-FILE. RL2014.2 +026800 ADD 1 TO REC-SKL-SUB. RL2014.2 +026900 MOVE FILE-RECORD-INFO-SKELETON RL2014.2 +027000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2014.2 +027100 CCVS-INIT-EXIT. RL2014.2 +027200 GO TO CCVS1-EXIT. RL2014.2 +027300 CLOSE-FILES. RL2014.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2014.2 +027500 TERMINATE-CCVS. RL2014.2 +027600S EXIT PROGRAM. RL2014.2 +027700STERMINATE-CALL. RL2014.2 +027800 STOP RUN. RL2014.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2014.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2014.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2014.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2014.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. RL2014.2 +028400 PRINT-DETAIL. RL2014.2 +028500 IF REC-CT NOT EQUAL TO ZERO RL2014.2 +028600 MOVE "." TO PARDOT-X RL2014.2 +028700 MOVE REC-CT TO DOTVALUE. RL2014.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2014.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2014.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2014.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2014.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2014.2 +029300 MOVE SPACE TO CORRECT-X. RL2014.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2014.2 +029500 MOVE SPACE TO RE-MARK. RL2014.2 +029600 HEAD-ROUTINE. RL2014.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2014.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2014.2 +030100 COLUMN-NAMES-ROUTINE. RL2014.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +030500 END-ROUTINE. RL2014.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2014.2 +030700 END-RTN-EXIT. RL2014.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +030900 END-ROUTINE-1. RL2014.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2014.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2014.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. RL2014.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2014.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2014.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2014.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2014.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2014.2 +031800 END-ROUTINE-12. RL2014.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2014.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2014.2 +032100 MOVE "NO " TO ERROR-TOTAL RL2014.2 +032200 ELSE RL2014.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2014.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2014.2 +032500 PERFORM WRITE-LINE. RL2014.2 +032600 END-ROUTINE-13. RL2014.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2014.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE RL2014.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2014.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2014.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO RL2014.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2014.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2014.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2014.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033800 WRITE-LINE. RL2014.2 +033900 ADD 1 TO RECORD-COUNT. RL2014.2 +034000Y IF RECORD-COUNT GREATER 50 RL2014.2 +034100Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2014.2 +034200Y MOVE SPACE TO DUMMY-RECORD RL2014.2 +034300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2014.2 +034400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2014.2 +034500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2014.2 +034600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2014.2 +034700Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2014.2 +034800Y MOVE ZERO TO RECORD-COUNT. RL2014.2 +034900 PERFORM WRT-LN. RL2014.2 +035000 WRT-LN. RL2014.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2014.2 +035200 MOVE SPACE TO DUMMY-RECORD. RL2014.2 +035300 BLANK-LINE-PRINT. RL2014.2 +035400 PERFORM WRT-LN. RL2014.2 +035500 FAIL-ROUTINE. RL2014.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE RL2014.2 +035700 GO TO FAIL-ROUTINE-WRITE. RL2014.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2014.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2014.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2014.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2014.2 +036300 GO TO FAIL-ROUTINE-EX. RL2014.2 +036400 FAIL-ROUTINE-WRITE. RL2014.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2014.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2014.2 +036700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2014.2 +036800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2014.2 +036900 FAIL-ROUTINE-EX. EXIT. RL2014.2 +037000 BAIL-OUT. RL2014.2 +037100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2014.2 +037200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2014.2 +037300 BAIL-OUT-WRITE. RL2014.2 +037400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2014.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2014.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2014.2 +037800 BAIL-OUT-EX. EXIT. RL2014.2 +037900 CCVS1-EXIT. RL2014.2 +038000 EXIT. RL2014.2 +038100 SECT-RL201-001 SECTION. RL2014.2 +038200 REL-INIT-001. RL2014.2 +038300 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2014.2 +038400 OPEN OUTPUT RL-FS1. RL2014.2 +038500 MOVE "RL-FS1" TO XFILE-NAME (1). RL2014.2 +038600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2014.2 +038700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2014.2 +038800 MOVE 000120 TO XRECORD-LENGTH (1). RL2014.2 +038900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2014.2 +039000 MOVE 0001 TO XBLOCK-SIZE (1). RL2014.2 +039100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2014.2 +039200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2014.2 +039300 MOVE "S" TO XLABEL-TYPE (1). RL2014.2 +039400 MOVE 000001 TO XRECORD-NUMBER (1). RL2014.2 +039500 REL-TEST-001. RL2014.2 +039600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2014.2 +039700 WRITE RL-FS1R1-F-G-120 RL2014.2 +039800 INVALID KEY GO TO REL-FAIL-001. RL2014.2 +039900 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2014.2 +040000 GO TO REL-WRITE-001. RL2014.2 +040100 ADD 000001 TO XRECORD-NUMBER (1). RL2014.2 +040200 GO TO REL-TEST-001. RL2014.2 +040300 REL-DELETE-001. RL2014.2 +040400 PERFORM DE-LETE. RL2014.2 +040500 GO TO REL-WRITE-001. RL2014.2 +040600 REL-FAIL-001. RL2014.2 +040700 PERFORM FAIL. RL2014.2 +040800 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2014.2 +040900 REL-WRITE-001. RL2014.2 +041000 MOVE "REL-TEST-001" TO PAR-NAME RL2014.2 +041100 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2014.2 +041200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2014.2 +041300 PERFORM PRINT-DETAIL. RL2014.2 +041400 CLOSE RL-FS1. RL2014.2 +041500 REL-INIT-002. RL2014.2 +041600 OPEN INPUT RL-FS1. RL2014.2 +041700 MOVE ZERO TO WRK-CS-09V00. RL2014.2 +041800 REL-TEST-002. RL2014.2 +041900 READ RL-FS1 RL2014.2 +042000 AT END GO TO REL-TEST-002-1. RL2014.2 +042100 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2014.2 +042200 ADD 1 TO WRK-CS-09V00. RL2014.2 +042300 IF WRK-CS-09V00 GREATER 500 RL2014.2 +042400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2014.2 +042500 GO TO REL-TEST-002-1. RL2014.2 +042600 GO TO REL-TEST-002. RL2014.2 +042700 REL-DELETE-002. RL2014.2 +042800 PERFORM DE-LETE. RL2014.2 +042900 PERFORM PRINT-DETAIL. RL2014.2 +043000 REL-TEST-002-1. RL2014.2 +043100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2014.2 +043200 PERFORM FAIL RL2014.2 +043300 ELSE RL2014.2 +043400 PERFORM PASS. RL2014.2 +043500 GO TO REL-WRITE-002. RL2014.2 +043600 REL-WRITE-002. RL2014.2 +043700 MOVE "REL-TEST-002" TO PAR-NAME. RL2014.2 +043800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2014.2 +043900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2014.2 +044000 PERFORM PRINT-DETAIL. RL2014.2 +044100 CLOSE RL-FS1. RL2014.2 +044200 CCVS-EXIT SECTION. RL2014.2 +044300 CCVS-999999. RL2014.2 +044400 GO TO CLOSE-FILES. RL2014.2 +*END-OF,RL201A +*HEADER,COBOL,RL201A,SUBPRG,RL202A +000100 IDENTIFICATION DIVISION. RL2024.2 +000200 PROGRAM-ID. RL2024.2 +000300 RL202A. RL2024.2 +000400**************************************************************** RL2024.2 +000500* * RL2024.2 +000600* VALIDATION FOR:- * RL2024.2 +000700* * RL2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +000900* * RL2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2024.2 +001100* * RL2024.2 +001200**************************************************************** RL2024.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL2024.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS DYNAMIC). THE FILE RL2024.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL201. RL2024.2 +001600* RL2024.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL2024.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL2024.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL2024.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL2024.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2024.2 +002200* RL2024.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2024.2 +002400* PROGRAM ARE: RL2024.2 +002500* RL2024.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2024.2 +002700* RELATIVE I-O DATA FILE RL2024.2 +002800* X-55 SYSTEM PRINTER RL2024.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2024.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2024.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2024.2 +003200* X-82 SOURCE-COMPUTER RL2024.2 +003300* X-83 OBJECT-COMPUTER. RL2024.2 +003400* RL2024.2 +003500*************************************************** RL2024.2 +003600 ENVIRONMENT DIVISION. RL2024.2 +003700 CONFIGURATION SECTION. RL2024.2 +003800 SOURCE-COMPUTER. RL2024.2 +003900 XXXXX082. RL2024.2 +004000 OBJECT-COMPUTER. RL2024.2 +004100 XXXXX083. RL2024.2 +004200 INPUT-OUTPUT SECTION. RL2024.2 +004300 FILE-CONTROL. RL2024.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2024.2 +004500 XXXXX055. RL2024.2 +004600 SELECT RL-FD1 ASSIGN TO RL2024.2 +004700 XXXXP021 RL2024.2 +004800 ORGANIZATION IS RELATIVE RL2024.2 +004900 ACCESS MODE IS DYNAMIC RL2024.2 +005000 RELATIVE KEY RL-FD1-KEY. RL2024.2 +005100 DATA DIVISION. RL2024.2 +005200 FILE SECTION. RL2024.2 +005300 FD PRINT-FILE. RL2024.2 +005400 01 PRINT-REC PICTURE X(120). RL2024.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2024.2 +005600 FD RL-FD1 RL2024.2 +005700 LABEL RECORDS STANDARD RL2024.2 +005800C VALUE OF RL2024.2 +005900C XXXXX074 RL2024.2 +006000C IS RL2024.2 +006100C XXXXX075 RL2024.2 +006200G XXXXX069 RL2024.2 +006300 BLOCK CONTAINS 1 RECORDS RL2024.2 +006400 RECORD CONTAINS 120 CHARACTERS. RL2024.2 +006500 01 RL-FD1R1-F-G-120. RL2024.2 +006600 02 FILLER PICTURE X(120). RL2024.2 +006700 WORKING-STORAGE SECTION. RL2024.2 +006800 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +006900 01 RL-FD1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL2024.2 +007000 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL2024.2 +007100 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007200 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007300 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2024.2 +007400 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007500 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007600 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007700 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL2024.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL2024.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL2024.2 +008000 05 FILLER PICTURE X(48) VALUE RL2024.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2024.2 +008200 05 FILLER PICTURE X(46) VALUE RL2024.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2024.2 +008400 05 FILLER PICTURE X(26) VALUE RL2024.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL2024.2 +008600 05 FILLER PICTURE X(37) VALUE RL2024.2 +008700 ",RECKEY= ". RL2024.2 +008800 05 FILLER PICTURE X(38) VALUE RL2024.2 +008900 ",ALTKEY1= ". RL2024.2 +009000 05 FILLER PICTURE X(38) VALUE RL2024.2 +009100 ",ALTKEY2= ". RL2024.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL2024.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2024.2 +009400 05 FILE-RECORD-INFO-P1-120. RL2024.2 +009500 07 FILLER PIC X(5). RL2024.2 +009600 07 XFILE-NAME PIC X(6). RL2024.2 +009700 07 FILLER PIC X(8). RL2024.2 +009800 07 XRECORD-NAME PIC X(6). RL2024.2 +009900 07 FILLER PIC X(1). RL2024.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL2024.2 +010100 07 FILLER PIC X(7). RL2024.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL2024.2 +010300 07 FILLER PIC X(6). RL2024.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL2024.2 +010500 07 FILLER PIC X(5). RL2024.2 +010600 07 ODO-NUMBER PIC 9(4). RL2024.2 +010700 07 FILLER PIC X(5). RL2024.2 +010800 07 XPROGRAM-NAME PIC X(5). RL2024.2 +010900 07 FILLER PIC X(7). RL2024.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL2024.2 +011100 07 FILLER PIC X(7). RL2024.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL2024.2 +011300 07 FILLER PIC X(1). RL2024.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL2024.2 +011500 07 FILLER PIC X(6). RL2024.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL2024.2 +011700 07 FILLER PIC X(5). RL2024.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL2024.2 +011900 07 FILLER PIC X(6). RL2024.2 +012000 07 XLABEL-TYPE PIC X(1). RL2024.2 +012100 05 FILE-RECORD-INFO-P121-240. RL2024.2 +012200 07 FILLER PIC X(8). RL2024.2 +012300 07 XRECORD-KEY PIC X(29). RL2024.2 +012400 07 FILLER PIC X(9). RL2024.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL2024.2 +012600 07 FILLER PIC X(9). RL2024.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL2024.2 +012800 07 FILLER PIC X(7). RL2024.2 +012900 01 TEST-RESULTS. RL2024.2 +013000 02 FILLER PIC X VALUE SPACE. RL2024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL2024.2 +013200 02 FILLER PIC X VALUE SPACE. RL2024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL2024.2 +013400 02 FILLER PIC X VALUE SPACE. RL2024.2 +013500 02 PAR-NAME. RL2024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL2024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL2024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL2024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL2024.2 +014000 02 RE-MARK PIC X(61). RL2024.2 +014100 01 TEST-COMPUTED. RL2024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL2024.2 +014300 02 FILLER PIC X(17) VALUE RL2024.2 +014400 " COMPUTED=". RL2024.2 +014500 02 COMPUTED-X. RL2024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL2024.2 +014800 PIC -9(9).9(9). RL2024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL2024.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL2024.2 +015400 04 FILLER PIC X. RL2024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL2024.2 +015600 01 TEST-CORRECT. RL2024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL2024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL2024.2 +015900 02 CORRECT-X. RL2024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL2024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL2024.2 +016600 04 CORRECT-18V0 PIC -9(18). RL2024.2 +016700 04 FILLER PIC X. RL2024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL2024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2024.2 +017000 01 CCVS-C-1. RL2024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2024.2 +017200- "SS PARAGRAPH-NAME RL2024.2 +017300- " REMARKS". RL2024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL2024.2 +017500 01 CCVS-C-2. RL2024.2 +017600 02 FILLER PIC X VALUE SPACE. RL2024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL2024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL2024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL2024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL2024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL2024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2024.2 +019200 01 CCVS-H-1. RL2024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL2024.2 +019400 02 FILLER PIC X(42) VALUE RL2024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2024.2 +019700 01 CCVS-H-2A. RL2024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL2024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2024.2 +020000 02 FILLER PIC XXXX VALUE RL2024.2 +020100 "4.2 ". RL2024.2 +020200 02 FILLER PIC X(28) VALUE RL2024.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL2024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL2024.2 +020500 RL2024.2 +020600 01 CCVS-H-2B. RL2024.2 +020700 02 FILLER PIC X(15) VALUE RL2024.2 +020800 "TEST RESULT OF ". RL2024.2 +020900 02 TEST-ID PIC X(9). RL2024.2 +021000 02 FILLER PIC X(4) VALUE RL2024.2 +021100 " IN ". RL2024.2 +021200 02 FILLER PIC X(12) VALUE RL2024.2 +021300 " HIGH ". RL2024.2 +021400 02 FILLER PIC X(22) VALUE RL2024.2 +021500 " LEVEL VALIDATION FOR ". RL2024.2 +021600 02 FILLER PIC X(58) VALUE RL2024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +021800 01 CCVS-H-3. RL2024.2 +021900 02 FILLER PIC X(34) VALUE RL2024.2 +022000 " FOR OFFICIAL USE ONLY ". RL2024.2 +022100 02 FILLER PIC X(58) VALUE RL2024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2024.2 +022300 02 FILLER PIC X(28) VALUE RL2024.2 +022400 " COPYRIGHT 1985 ". RL2024.2 +022500 01 CCVS-E-1. RL2024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL2024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2024.2 +022800 02 ID-AGAIN PIC X(9). RL2024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL2024.2 +023000 01 CCVS-E-2. RL2024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL2024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL2024.2 +023300 02 CCVS-E-2-2. RL2024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2024.2 +023500 03 FILLER PIC X VALUE SPACE. RL2024.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL2024.2 +023700 "ERRORS ENCOUNTERED". RL2024.2 +023800 01 CCVS-E-3. RL2024.2 +023900 02 FILLER PIC X(22) VALUE RL2024.2 +024000 " FOR OFFICIAL USE ONLY". RL2024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL2024.2 +024200 02 FILLER PIC X(58) VALUE RL2024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL2024.2 +024500 02 FILLER PIC X(15) VALUE RL2024.2 +024600 " COPYRIGHT 1985". RL2024.2 +024700 01 CCVS-E-4. RL2024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL2024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2024.2 +025100 02 FILLER PIC X(40) VALUE RL2024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL2024.2 +025300 01 XXINFO. RL2024.2 +025400 02 FILLER PIC X(19) VALUE RL2024.2 +025500 "*** INFORMATION ***". RL2024.2 +025600 02 INFO-TEXT. RL2024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL2024.2 +025800 04 XXCOMPUTED PIC X(20). RL2024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL2024.2 +026000 04 XXCORRECT PIC X(20). RL2024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL2024.2 +026200 01 HYPHEN-LINE. RL2024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL2024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL2024.2 +026500- "*****************************************". RL2024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL2024.2 +026700- "******************************". RL2024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL2024.2 +026900 "RL202A". RL2024.2 +027000 PROCEDURE DIVISION. RL2024.2 +027100 CCVS1 SECTION. RL2024.2 +027200 OPEN-FILES. RL2024.2 +027300 OPEN OUTPUT PRINT-FILE. RL2024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2024.2 +027500 MOVE SPACE TO TEST-RESULTS. RL2024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2024.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL2024.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL2024.2 +027900 CCVS-INIT-FILE. RL2024.2 +028000 ADD 1 TO REC-SKL-SUB. RL2024.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL2024.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2024.2 +028300 CCVS-INIT-EXIT. RL2024.2 +028400 GO TO CCVS1-EXIT. RL2024.2 +028500 CLOSE-FILES. RL2024.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2024.2 +028700 TERMINATE-CCVS. RL2024.2 +028800S EXIT PROGRAM. RL2024.2 +028900STERMINATE-CALL. RL2024.2 +029000 STOP RUN. RL2024.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2024.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2024.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2024.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2024.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL2024.2 +029600 PRINT-DETAIL. RL2024.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL2024.2 +029800 MOVE "." TO PARDOT-X RL2024.2 +029900 MOVE REC-CT TO DOTVALUE. RL2024.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2024.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2024.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2024.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2024.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2024.2 +030500 MOVE SPACE TO CORRECT-X. RL2024.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2024.2 +030700 MOVE SPACE TO RE-MARK. RL2024.2 +030800 HEAD-ROUTINE. RL2024.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2024.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2024.2 +031300 COLUMN-NAMES-ROUTINE. RL2024.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +031700 END-ROUTINE. RL2024.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2024.2 +031900 END-RTN-EXIT. RL2024.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +032100 END-ROUTINE-1. RL2024.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2024.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2024.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL2024.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2024.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2024.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2024.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2024.2 +033000 END-ROUTINE-12. RL2024.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2024.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL2024.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2024.2 +033400 ELSE RL2024.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2024.2 +033700 PERFORM WRITE-LINE. RL2024.2 +033800 END-ROUTINE-13. RL2024.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL2024.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL2024.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2024.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2024.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL2024.2 +034500 MOVE "NO " TO ERROR-TOTAL RL2024.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2024.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2024.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +035000 WRITE-LINE. RL2024.2 +035100 ADD 1 TO RECORD-COUNT. RL2024.2 +035200Y IF RECORD-COUNT GREATER 50 RL2024.2 +035300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2024.2 +035400Y MOVE SPACE TO DUMMY-RECORD RL2024.2 +035500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2024.2 +035600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2024.2 +035700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2024.2 +035800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2024.2 +035900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2024.2 +036000Y MOVE ZERO TO RECORD-COUNT. RL2024.2 +036100 PERFORM WRT-LN. RL2024.2 +036200 WRT-LN. RL2024.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2024.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL2024.2 +036500 BLANK-LINE-PRINT. RL2024.2 +036600 PERFORM WRT-LN. RL2024.2 +036700 FAIL-ROUTINE. RL2024.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE RL2024.2 +036900 GO TO FAIL-ROUTINE-WRITE. RL2024.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2024.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2024.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2024.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. RL2024.2 +037500 GO TO FAIL-ROUTINE-EX. RL2024.2 +037600 FAIL-ROUTINE-WRITE. RL2024.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2024.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2024.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2024.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. RL2024.2 +038100 FAIL-ROUTINE-EX. EXIT. RL2024.2 +038200 BAIL-OUT. RL2024.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2024.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2024.2 +038500 BAIL-OUT-WRITE. RL2024.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2024.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2024.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL2024.2 +039000 BAIL-OUT-EX. EXIT. RL2024.2 +039100 CCVS1-EXIT. RL2024.2 +039200 EXIT. RL2024.2 +039300 SECT-RL202-001 SECTION. RL2024.2 +039400 REL-INIT-003. RL2024.2 +039500 OPEN INPUT RL-FD1. RL2024.2 +039600 MOVE "REL-TEST-003" TO PAR-NAME. RL2024.2 +039700 MOVE ZERO TO RL-FD1-KEY. RL2024.2 +039800 MOVE ZERO TO WRK-CS-09V00-002 RL2024.2 +039900 MOVE ZERO TO WRK-CS-09V00-003 RL2024.2 +040000* RL2024.2 +040100 MOVE 01 TO REC-CT. RL2024.2 +040200 MOVE "READ RANDOM" TO FEATURE. RL2024.2 +040300 REL-TEST-003-R. RL2024.2 +040400 ADD 1 TO WRK-CS-09V00-003 RL2024.2 +040500 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +040600 IF RL-FD1-KEY GREATER +501 RL2024.2 +040700 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL2024.2 +040800 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2024.2 +040900 PERFORM FAIL RL2024.2 +041000 PERFORM PRINT-DETAIL RL2024.2 +041100 ADD 1 TO REC-CT RL2024.2 +041200 GO TO REL-WRITE-003. RL2024.2 +041300 READ RL-FD1 RL2024.2 +041400 INVALID KEY GO TO REL-WRITE-003. RL2024.2 +041500 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO RL-FD1-KEY RL2024.2 +041700 GO TO REL-TEST-003-R. RL2024.2 +041800 MOVE "YES" TO I-O-ERROR-RL-FD1. RL2024.2 +041900 ADD 1 TO WRK-CS-09V00-002 RL2024.2 +042000 GO TO REL-TEST-003-R. RL2024.2 +042100 REL-WRITE-003. RL2024.2 +042200 IF RL-FD1-KEY NOT EQUAL TO 501 RL2024.2 +042300 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL2024.2 +042400 MOVE RL-FD1-KEY TO COMPUTED-18V0 RL2024.2 +042500 PERFORM FAIL RL2024.2 +042600 ELSE RL2024.2 +042700 PERFORM PASS. RL2024.2 +042800 PERFORM PRINT-DETAIL. RL2024.2 +042900* RL2024.2 +043000*01 RL2024.2 +043100* RL2024.2 +043200 ADD 1 TO REC-CT. RL2024.2 +043300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2024.2 +043400 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL2024.2 +043500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL2024.2 +043600 PERFORM FAIL RL2024.2 +043700 ELSE RL2024.2 +043800 PERFORM PASS. RL2024.2 +043900 PERFORM PRINT-DETAIL. RL2024.2 +044000* RL2024.2 +044100*02 RL2024.2 +044200* RL2024.2 +044300 ADD 1 TO REC-CT. RL2024.2 +044400 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL2024.2 +044500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2024.2 +044600 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2024.2 +044700 MOVE 501 TO CORRECT-18V0 RL2024.2 +044800 PERFORM FAIL RL2024.2 +044900 ELSE RL2024.2 +045000 PERFORM PASS. RL2024.2 +045100 PERFORM PRINT-DETAIL. RL2024.2 +045200* RL2024.2 +045300*03 RL2024.2 +045400* RL2024.2 +045500 ADD 1 TO REC-CT. RL2024.2 +045600 IF I-O-ERROR-RL-FD1 EQUAL TO "YES" RL2024.2 +045700 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL2024.2 +045800 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL2024.2 +045900 PERFORM FAIL RL2024.2 +046000 ELSE RL2024.2 +046100 PERFORM PASS. RL2024.2 +046200 PERFORM PRINT-DETAIL. RL2024.2 +046300* RL2024.2 +046400*04 RL2024.2 +046500* RL2024.2 +046600 ADD 1 TO REC-CT. RL2024.2 +046700 CLOSE RL-FD1. RL2024.2 +046800 REL-INIT-004-R . RL2024.2 +046900 MOVE "REL-TEST-004" TO PAR-NAME. RL2024.2 +047000 OPEN I-O RL-FD1. RL2024.2 +047100 MOVE ZERO TO RL-FD1-KEY. RL2024.2 +047200 MOVE ZERO TO WRK-CS-09V00-002. RL2024.2 +047300 MOVE ZERO TO WRK-CS-09V00-003. RL2024.2 +047400 MOVE ZERO TO WRK-CS-09V00-004. RL2024.2 +047500 MOVE ZERO TO WRK-CS-09V00-005. RL2024.2 +047600* RL2024.2 +047700 MOVE 01 TO REC-CT. RL2024.2 +047800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +047900 MOVE "REWRITE" TO FEATURE. RL2024.2 +048000 REL-TEST-004-R. RL2024.2 +048100 ADD 5 TO WRK-CS-09V00-003. RL2024.2 +048200 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +048300 IF RL-FD1-KEY GREATER 505 RL2024.2 +048400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL2024.2 +048500 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2024.2 +048600 PERFORM FAIL RL2024.2 +048700 PERFORM PRINT-DETAIL RL2024.2 +048800 ADD 1 TO REC-CT RL2024.2 +048900 GO TO REL-TEST-004-3. RL2024.2 +049000 READ RL-FD1 RL2024.2 +049100 INVALID KEY GO TO REL-TEST-004-1. RL2024.2 +049200 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL2024.2 +049300 ADD 01 TO UPDATE-NUMBER (1). RL2024.2 +049400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2024.2 +049500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-120. RL2024.2 +049600 REWRITE RL-FD1R1-F-G-120 RL2024.2 +049700 INVALID KEY GO TO REL-TEST-004-2. RL2024.2 +049800 GO TO REL-TEST-004-R. RL2024.2 +049900 REL-TEST-004-1. RL2024.2 +050000 IF RL-FD1-KEY LESS THAN 501 RL2024.2 +050100 ADD 1 TO WRK-CS-09V00-004 RL2024.2 +050200 GO TO REL-TEST-004-R. RL2024.2 +050300 PERFORM PASS. RL2024.2 +050400 PERFORM PRINT-DETAIL. RL2024.2 +050500* RL2024.2 +050600*01 RL2024.2 +050700* RL2024.2 +050800 ADD 1 TO REC-CT. RL2024.2 +050900 GO TO REL-TEST-004-3. RL2024.2 +051000 REL-TEST-004-2. RL2024.2 +051100 ADD 1 TO WRK-CS-09V00-005. RL2024.2 +051200 IF RL-FD1-KEY LESS 501 RL2024.2 +051300 GO TO REL-TEST-004-R. RL2024.2 +051400 REL-TEST-004-3. RL2024.2 +051500 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL2024.2 +051600 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL2024.2 +051700 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2024.2 +051800 PERFORM FAIL RL2024.2 +051900 ELSE RL2024.2 +052000 PERFORM PASS. RL2024.2 +052100 PERFORM PRINT-DETAIL. RL2024.2 +052200* RL2024.2 +052300*02 RL2024.2 +052400* RL2024.2 +052500 ADD 1 TO REC-CT. RL2024.2 +052600 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL2024.2 +052700 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL2024.2 +052800 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2024.2 +052900 PERFORM FAIL RL2024.2 +053000 ELSE RL2024.2 +053100 PERFORM PASS. RL2024.2 +053200 PERFORM PRINT-DETAIL. RL2024.2 +053300* RL2024.2 +053400*03 RL2024.2 +053500* RL2024.2 +053600 ADD 1 TO REC-CT. RL2024.2 +053700 CLOSE RL-FD1. RL2024.2 +053800 REL-INIT-005. RL2024.2 +053900 MOVE "REL-TEST-005" TO PAR-NAME. RL2024.2 +054000 OPEN INPUT RL-FD1. RL2024.2 +054100 MOVE 501 TO WRK-CS-09V00-003. RL2024.2 +054200 MOVE ZERO TO WRK-CS-09V00-004. RL2024.2 +054300 MOVE ZERO TO WRK-CS-09V00-005. RL2024.2 +054400 MOVE ZERO TO WRK-CS-09V00-002. RL2024.2 +054500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +054600 MOVE 01 TO REC-CT. RL2024.2 +054700* RL2024.2 +054800 MOVE "READ RANDOM" TO FEATURE. RL2024.2 +054900 REL-TEST-005-R. RL2024.2 +055000 SUBTRACT 1 FROM WRK-CS-09V00-003. RL2024.2 +055100 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +055200 IF WRK-CS-09V00-003 LESS THAN ZERO RL2024.2 +055300 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL2024.2 +055400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2024.2 +055500 MOVE ZERO TO CORRECT-18V0 RL2024.2 +055600 PERFORM FAIL RL2024.2 +055700 PERFORM PRINT-DETAIL RL2024.2 +055800 ADD 1 TO REC-CT RL2024.2 +055900 GO TO REL-TEST-005-3. RL2024.2 +056000 READ RL-FD1 RL2024.2 +056100 INVALID KEY GO TO REL-TEST-005-1. RL2024.2 +056200 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +056300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2024.2 +056400 ADD 1 TO WRK-CS-09V00-004. RL2024.2 +056500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2024.2 +056600 ADD 1 TO WRK-CS-09V00-005. RL2024.2 +056700 GO TO REL-TEST-005-R. RL2024.2 +056800 REL-TEST-005-1. RL2024.2 +056900 IF RL-FD1-KEY GREATER ZERO RL2024.2 +057000 ADD 1 TO WRK-CS-09V00-002 RL2024.2 +057100 GO TO REL-TEST-005-R. RL2024.2 +057200 PERFORM PASS. RL2024.2 +057300 PERFORM PRINT-DETAIL. RL2024.2 +057400 ADD 1 TO REC-CT. RL2024.2 +057500*01 RL2024.2 +057600 GO TO REL-TEST-005-3. RL2024.2 +057700 REL-TEST-005-3. RL2024.2 +057800 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL2024.2 +057900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2024.2 +058000 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2024.2 +058100 MOVE "SHOULD BE 400" TO RE-MARK RL2024.2 +058200 PERFORM FAIL RL2024.2 +058300 ELSE RL2024.2 +058400 PERFORM PASS. RL2024.2 +058500 PERFORM PRINT-DETAIL. RL2024.2 +058600* RL2024.2 +058700* RL2024.2 +058800*02 RL2024.2 +058900* RL2024.2 +059000 ADD 1 TO REC-CT. RL2024.2 +059100 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL2024.2 +059200 MOVE "UPDATED RECORDS" TO COMPUTED-A RL2024.2 +059300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2024.2 +059400 MOVE "SHOULD BE 100" TO RE-MARK RL2024.2 +059500 PERFORM FAIL RL2024.2 +059600 ELSE RL2024.2 +059700 PERFORM PASS. RL2024.2 +059800 PERFORM PRINT-DETAIL. RL2024.2 +059900* RL2024.2 +060000*03 RL2024.2 +060100* RL2024.2 +060200 ADD 1 TO REC-CT. RL2024.2 +060300 IF WRK-CS-09V00-002 GREATER 1 RL2024.2 +060400 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL2024.2 +060500 MOVE "INVALID KEY/READS" TO CORRECT-A RL2024.2 +060600 PERFORM FAIL RL2024.2 +060700 ELSE RL2024.2 +060800 PERFORM PASS. RL2024.2 +060900 PERFORM PRINT-DETAIL. RL2024.2 +061000* RL2024.2 +061100*04 RL2024.2 +061200* RL2024.2 +061300 ADD 1 TO REC-CT. RL2024.2 +061400 CLOSE RL-FD1. RL2024.2 +061500 CCVS-EXIT SECTION. RL2024.2 +061600 CCVS-999999. RL2024.2 +061700 GO TO CLOSE-FILES. RL2024.2 +*END-OF,RL202A +*HEADER,COBOL,RL201A,SUBPRG,RL203A +000100 IDENTIFICATION DIVISION. RL2034.2 +000200 PROGRAM-ID. RL2034.2 +000300 RL203A. RL2034.2 +000400**************************************************************** RL2034.2 +000500* * RL2034.2 +000600* VALIDATION FOR:- * RL2034.2 +000700* * RL2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +000900* * RL2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2034.2 +001100* * RL2034.2 +001200**************************************************************** RL2034.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL2034.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL2034.2 +001500* (ACCESS MODE IS DYNAMIC). THE FILE USED IS THAT RL2034.2 +001600* RESULTING FROM RL102. RL2034.2 +001700* RL2034.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL2034.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL2034.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL2034.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2034.2 +002200* RL2034.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2034.2 +002400* PROGRAM ARE: RL2034.2 +002500* RL2034.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2034.2 +002700* RELATIVE I-O DATA FILE RL2034.2 +002800* X-55 SYSTEM PRINTER RL2034.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2034.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2034.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2034.2 +003200* X-82 SOURCE-COMPUTER RL2034.2 +003300* X-83 OBJECT-COMPUTER. RL2034.2 +003400* RL2034.2 +003500*************************************************** RL2034.2 +003600 ENVIRONMENT DIVISION. RL2034.2 +003700 CONFIGURATION SECTION. RL2034.2 +003800 SOURCE-COMPUTER. RL2034.2 +003900 XXXXX082. RL2034.2 +004000 OBJECT-COMPUTER. RL2034.2 +004100 XXXXX083. RL2034.2 +004200 INPUT-OUTPUT SECTION. RL2034.2 +004300 FILE-CONTROL. RL2034.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2034.2 +004500 XXXXX055. RL2034.2 +004600 SELECT RL-FD1 ASSIGN TO RL2034.2 +004700 XXXXD021 RL2034.2 +004800 ACCESS MODE IS DYNAMIC RL2034.2 +004900 RELATIVE KEY IS RL-FD1-KEY RL2034.2 +005000 ORGANIZATION IS RELATIVE. RL2034.2 +005100 DATA DIVISION. RL2034.2 +005200 FILE SECTION. RL2034.2 +005300 FD PRINT-FILE. RL2034.2 +005400 01 PRINT-REC PICTURE X(120). RL2034.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2034.2 +005600 FD RL-FD1 RL2034.2 +005700 LABEL RECORDS STANDARD RL2034.2 +005800C VALUE OF RL2034.2 +005900C XXXXX074 RL2034.2 +006000C IS RL2034.2 +006100C XXXXX075 RL2034.2 +006200G XXXXX069 RL2034.2 +006300 BLOCK CONTAINS 01 RECORDS RL2034.2 +006400 RECORD CONTAINS 120. RL2034.2 +006500 01 RL-FD1R1-F-G-120. RL2034.2 +006600 02 RL-WRK-120 PIC X(120). RL2034.2 +006700 WORKING-STORAGE SECTION. RL2034.2 +006800 01 RL-FD1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL2034.2 +006900 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007000 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007100 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007200 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007300 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007400 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007500 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2034.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL2034.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL2034.2 +007800 05 FILLER PICTURE X(48) VALUE RL2034.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2034.2 +008000 05 FILLER PICTURE X(46) VALUE RL2034.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2034.2 +008200 05 FILLER PICTURE X(26) VALUE RL2034.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL2034.2 +008400 05 FILLER PICTURE X(37) VALUE RL2034.2 +008500 ",RECKEY= ". RL2034.2 +008600 05 FILLER PICTURE X(38) VALUE RL2034.2 +008700 ",ALTKEY1= ". RL2034.2 +008800 05 FILLER PICTURE X(38) VALUE RL2034.2 +008900 ",ALTKEY2= ". RL2034.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL2034.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2034.2 +009200 05 FILE-RECORD-INFO-P1-120. RL2034.2 +009300 07 FILLER PIC X(5). RL2034.2 +009400 07 XFILE-NAME PIC X(6). RL2034.2 +009500 07 FILLER PIC X(8). RL2034.2 +009600 07 XRECORD-NAME PIC X(6). RL2034.2 +009700 07 FILLER PIC X(1). RL2034.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL2034.2 +009900 07 FILLER PIC X(7). RL2034.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL2034.2 +010100 07 FILLER PIC X(6). RL2034.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL2034.2 +010300 07 FILLER PIC X(5). RL2034.2 +010400 07 ODO-NUMBER PIC 9(4). RL2034.2 +010500 07 FILLER PIC X(5). RL2034.2 +010600 07 XPROGRAM-NAME PIC X(5). RL2034.2 +010700 07 FILLER PIC X(7). RL2034.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL2034.2 +010900 07 FILLER PIC X(7). RL2034.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL2034.2 +011100 07 FILLER PIC X(1). RL2034.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL2034.2 +011300 07 FILLER PIC X(6). RL2034.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL2034.2 +011500 07 FILLER PIC X(5). RL2034.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL2034.2 +011700 07 FILLER PIC X(6). RL2034.2 +011800 07 XLABEL-TYPE PIC X(1). RL2034.2 +011900 05 FILE-RECORD-INFO-P121-240. RL2034.2 +012000 07 FILLER PIC X(8). RL2034.2 +012100 07 XRECORD-KEY PIC X(29). RL2034.2 +012200 07 FILLER PIC X(9). RL2034.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL2034.2 +012400 07 FILLER PIC X(9). RL2034.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL2034.2 +012600 07 FILLER PIC X(7). RL2034.2 +012700 01 TEST-RESULTS. RL2034.2 +012800 02 FILLER PIC X VALUE SPACE. RL2034.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL2034.2 +013000 02 FILLER PIC X VALUE SPACE. RL2034.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL2034.2 +013200 02 FILLER PIC X VALUE SPACE. RL2034.2 +013300 02 PAR-NAME. RL2034.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL2034.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL2034.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL2034.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL2034.2 +013800 02 RE-MARK PIC X(61). RL2034.2 +013900 01 TEST-COMPUTED. RL2034.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL2034.2 +014100 02 FILLER PIC X(17) VALUE RL2034.2 +014200 " COMPUTED=". RL2034.2 +014300 02 COMPUTED-X. RL2034.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2034.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL2034.2 +014600 PIC -9(9).9(9). RL2034.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2034.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2034.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2034.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL2034.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL2034.2 +015200 04 FILLER PIC X. RL2034.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL2034.2 +015400 01 TEST-CORRECT. RL2034.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL2034.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2034.2 +015700 02 CORRECT-X. RL2034.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2034.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2034.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2034.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2034.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2034.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL2034.2 +016400 04 CORRECT-18V0 PIC -9(18). RL2034.2 +016500 04 FILLER PIC X. RL2034.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL2034.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2034.2 +016800 01 CCVS-C-1. RL2034.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2034.2 +017000- "SS PARAGRAPH-NAME RL2034.2 +017100- " REMARKS". RL2034.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL2034.2 +017300 01 CCVS-C-2. RL2034.2 +017400 02 FILLER PIC X VALUE SPACE. RL2034.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL2034.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL2034.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL2034.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL2034.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2034.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL2034.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2034.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2034.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2034.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2034.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2034.2 +019000 01 CCVS-H-1. RL2034.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2034.2 +019200 02 FILLER PIC X(42) VALUE RL2034.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2034.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL2034.2 +019500 01 CCVS-H-2A. RL2034.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL2034.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2034.2 +019800 02 FILLER PIC XXXX VALUE RL2034.2 +019900 "4.2 ". RL2034.2 +020000 02 FILLER PIC X(28) VALUE RL2034.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL2034.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL2034.2 +020300 RL2034.2 +020400 01 CCVS-H-2B. RL2034.2 +020500 02 FILLER PIC X(15) VALUE RL2034.2 +020600 "TEST RESULT OF ". RL2034.2 +020700 02 TEST-ID PIC X(9). RL2034.2 +020800 02 FILLER PIC X(4) VALUE RL2034.2 +020900 " IN ". RL2034.2 +021000 02 FILLER PIC X(12) VALUE RL2034.2 +021100 " HIGH ". RL2034.2 +021200 02 FILLER PIC X(22) VALUE RL2034.2 +021300 " LEVEL VALIDATION FOR ". RL2034.2 +021400 02 FILLER PIC X(58) VALUE RL2034.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +021600 01 CCVS-H-3. RL2034.2 +021700 02 FILLER PIC X(34) VALUE RL2034.2 +021800 " FOR OFFICIAL USE ONLY ". RL2034.2 +021900 02 FILLER PIC X(58) VALUE RL2034.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2034.2 +022100 02 FILLER PIC X(28) VALUE RL2034.2 +022200 " COPYRIGHT 1985 ". RL2034.2 +022300 01 CCVS-E-1. RL2034.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL2034.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2034.2 +022600 02 ID-AGAIN PIC X(9). RL2034.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL2034.2 +022800 01 CCVS-E-2. RL2034.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL2034.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL2034.2 +023100 02 CCVS-E-2-2. RL2034.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2034.2 +023300 03 FILLER PIC X VALUE SPACE. RL2034.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL2034.2 +023500 "ERRORS ENCOUNTERED". RL2034.2 +023600 01 CCVS-E-3. RL2034.2 +023700 02 FILLER PIC X(22) VALUE RL2034.2 +023800 " FOR OFFICIAL USE ONLY". RL2034.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL2034.2 +024000 02 FILLER PIC X(58) VALUE RL2034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL2034.2 +024300 02 FILLER PIC X(15) VALUE RL2034.2 +024400 " COPYRIGHT 1985". RL2034.2 +024500 01 CCVS-E-4. RL2034.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2034.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL2034.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2034.2 +024900 02 FILLER PIC X(40) VALUE RL2034.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2034.2 +025100 01 XXINFO. RL2034.2 +025200 02 FILLER PIC X(19) VALUE RL2034.2 +025300 "*** INFORMATION ***". RL2034.2 +025400 02 INFO-TEXT. RL2034.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL2034.2 +025600 04 XXCOMPUTED PIC X(20). RL2034.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL2034.2 +025800 04 XXCORRECT PIC X(20). RL2034.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL2034.2 +026000 01 HYPHEN-LINE. RL2034.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL2034.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL2034.2 +026300- "*****************************************". RL2034.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL2034.2 +026500- "******************************". RL2034.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL2034.2 +026700 "RL203A". RL2034.2 +026800 PROCEDURE DIVISION. RL2034.2 +026900 CCVS1 SECTION. RL2034.2 +027000 OPEN-FILES. RL2034.2 +027100 OPEN OUTPUT PRINT-FILE. RL2034.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2034.2 +027300 MOVE SPACE TO TEST-RESULTS. RL2034.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2034.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL2034.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2034.2 +027700 CCVS-INIT-FILE. RL2034.2 +027800 ADD 1 TO REC-SKL-SUB. RL2034.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL2034.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2034.2 +028100 CCVS-INIT-EXIT. RL2034.2 +028200 GO TO CCVS1-EXIT. RL2034.2 +028300 CLOSE-FILES. RL2034.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2034.2 +028500 TERMINATE-CCVS. RL2034.2 +028600S EXIT PROGRAM. RL2034.2 +028700STERMINATE-CALL. RL2034.2 +028800 STOP RUN. RL2034.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2034.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2034.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2034.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2034.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL2034.2 +029400 PRINT-DETAIL. RL2034.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL2034.2 +029600 MOVE "." TO PARDOT-X RL2034.2 +029700 MOVE REC-CT TO DOTVALUE. RL2034.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2034.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2034.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2034.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2034.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2034.2 +030300 MOVE SPACE TO CORRECT-X. RL2034.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2034.2 +030500 MOVE SPACE TO RE-MARK. RL2034.2 +030600 HEAD-ROUTINE. RL2034.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2034.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2034.2 +031100 COLUMN-NAMES-ROUTINE. RL2034.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +031500 END-ROUTINE. RL2034.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2034.2 +031700 END-RTN-EXIT. RL2034.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +031900 END-ROUTINE-1. RL2034.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2034.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2034.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL2034.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2034.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2034.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2034.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2034.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2034.2 +032800 END-ROUTINE-12. RL2034.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2034.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2034.2 +033100 MOVE "NO " TO ERROR-TOTAL RL2034.2 +033200 ELSE RL2034.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2034.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2034.2 +033500 PERFORM WRITE-LINE. RL2034.2 +033600 END-ROUTINE-13. RL2034.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2034.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL2034.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2034.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2034.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL2034.2 +034300 MOVE "NO " TO ERROR-TOTAL RL2034.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2034.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034800 WRITE-LINE. RL2034.2 +034900 ADD 1 TO RECORD-COUNT. RL2034.2 +035000Y IF RECORD-COUNT GREATER 50 RL2034.2 +035100Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2034.2 +035200Y MOVE SPACE TO DUMMY-RECORD RL2034.2 +035300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2034.2 +035400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2034.2 +035500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2034.2 +035600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2034.2 +035700Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2034.2 +035800Y MOVE ZERO TO RECORD-COUNT. RL2034.2 +035900 PERFORM WRT-LN. RL2034.2 +036000 WRT-LN. RL2034.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2034.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL2034.2 +036300 BLANK-LINE-PRINT. RL2034.2 +036400 PERFORM WRT-LN. RL2034.2 +036500 FAIL-ROUTINE. RL2034.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE RL2034.2 +036700 GO TO FAIL-ROUTINE-WRITE. RL2034.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2034.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2034.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2034.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2034.2 +037300 GO TO FAIL-ROUTINE-EX. RL2034.2 +037400 FAIL-ROUTINE-WRITE. RL2034.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2034.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2034.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2034.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2034.2 +037900 FAIL-ROUTINE-EX. EXIT. RL2034.2 +038000 BAIL-OUT. RL2034.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2034.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2034.2 +038300 BAIL-OUT-WRITE. RL2034.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2034.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2034.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2034.2 +038800 BAIL-OUT-EX. EXIT. RL2034.2 +038900 CCVS1-EXIT. RL2034.2 +039000 EXIT. RL2034.2 +039100 SECT-RL-03-001 SECTION. RL2034.2 +039200 REL-INIT-006. RL2034.2 +039300 MOVE 99 TO RL-FD1-KEY. RL2034.2 +039400* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL2034.2 +039500 OPEN INPUT RL-FD1. RL2034.2 +039600 MOVE "REL-TEST-006" TO PAR-NAME. RL2034.2 +039700 MOVE ZERO TO WRK-CS-09V00-006. RL2034.2 +039800 MOVE ZERO TO WRK-CS-09V00-007. RL2034.2 +039900 MOVE ZERO TO WRK-CS-09V00-008. RL2034.2 +040000 MOVE ZERO TO WRK-CS-09V00-009. RL2034.2 +040100 MOVE ZERO TO WRK-CS-09V00-010. RL2034.2 +040200 MOVE ZERO TO WRK-CS-09V00-011. RL2034.2 +040300 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +040400 MOVE RL-FD1-KEY TO WRK-CS-09V00-011. RL2034.2 +040500 MOVE 01 TO REC-CT. RL2034.2 +040600 MOVE "READ SEQUENTIAL" TO FEATURE. RL2034.2 +040700 REL-TEST-006-R. RL2034.2 +040800 ADD 1 TO WRK-CS-09V00-006. RL2034.2 +040900 READ RL-FD1 NEXT RECORD RL2034.2 +041000 AT END GO TO REL-TEST-006-3. RL2034.2 +041100 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +041200 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2034.2 +041300 ADD 1 TO WRK-CS-09V00-007 RL2034.2 +041400 GO TO REL-TEST-006-2. RL2034.2 +041500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2034.2 +041600 ADD 1 TO WRK-CS-09V00-008 RL2034.2 +041700 GO TO REL-TEST-006-2. RL2034.2 +041800 ADD 1 TO WRK-CS-09V00-009. RL2034.2 +041900 REL-TEST-006-2. RL2034.2 +042000 IF RL-FD1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL2034.2 +042100 ADD 1 TO WRK-CS-09V00-010. RL2034.2 +042200 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +042300 GO TO REL-TEST-006-3. RL2034.2 +042400 GO TO REL-TEST-006-R. RL2034.2 +042500 REL-TEST-006-3. RL2034.2 +042600 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2034.2 +042700 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2034.2 +042800 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +042900 MOVE 501 TO CORRECT-18V0 RL2034.2 +043000 PERFORM FAIL RL2034.2 +043100 ELSE RL2034.2 +043200 PERFORM PASS. RL2034.2 +043300 PERFORM PRINT-DETAIL. RL2034.2 +043400* .01 RL2034.2 +043500 ADD 1 TO REC-CT. RL2034.2 +043600 IF WRK-CS-09V00-007 EQUAL TO 400 RL2034.2 +043700 PERFORM PASS RL2034.2 +043800 ELSE RL2034.2 +043900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2034.2 +044000 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL2034.2 +044100 MOVE "SHOULD BE 400" TO RE-MARK RL2034.2 +044200 PERFORM FAIL. RL2034.2 +044300 PERFORM PRINT-DETAIL. RL2034.2 +044400 ADD 1 TO REC-CT. RL2034.2 +044500* .02 RL2034.2 +044600 IF WRK-CS-09V00-008 EQUAL TO 100 RL2034.2 +044700 PERFORM PASS RL2034.2 +044800 ELSE RL2034.2 +044900 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2034.2 +045000 MOVE 100 TO CORRECT-18V0 RL2034.2 +045100 MOVE "UPDATED RECORDS" TO RE-MARK RL2034.2 +045200 PERFORM FAIL. RL2034.2 +045300 PERFORM PRINT-DETAIL. RL2034.2 +045400 ADD 1 TO REC-CT. RL2034.2 +045500* .03 RL2034.2 +045600 IF WRK-CS-09V00-009 EQUAL TO ZERO RL2034.2 +045700 PERFORM PASS RL2034.2 +045800 ELSE RL2034.2 +045900 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2034.2 +046000 MOVE ZERO TO CORRECT-18V0 RL2034.2 +046100 MOVE "BAD-UPDATES" TO RE-MARK RL2034.2 +046200 PERFORM FAIL. RL2034.2 +046300 PERFORM PRINT-DETAIL. RL2034.2 +046400 ADD 01 TO REC-CT. RL2034.2 +046500* .04 RL2034.2 +046600 IF WRK-CS-09V00-010 EQUAL TO ZERO RL2034.2 +046700 PERFORM PASS RL2034.2 +046800 ELSE RL2034.2 +046900 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2034.2 +047000 MOVE ZERO TO CORRECT-18V0 RL2034.2 +047100 MOVE "KEY VS RECORD" TO RE-MARK RL2034.2 +047200 PERFORM FAIL. RL2034.2 +047300 PERFORM PRINT-DETAIL. RL2034.2 +047400 ADD 01 TO REC-CT. RL2034.2 +047500* .05 RL2034.2 +047600 MOVE WRK-CS-09V00-011 TO RL-FD1-KEY. RL2034.2 +047700 MOVE RL-FD1-KEY TO COMPUTED-18V0. RL2034.2 +047800 MOVE "INFORMATION" TO CORRECT-A. RL2034.2 +047900 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL2034.2 +048000 PERFORM PRINT-DETAIL. RL2034.2 +048100 ADD 01 TO REC-CT. RL2034.2 +048200* .06 RL2034.2 +048300 CLOSE RL-FD1. RL2034.2 +048400 REL-INIT-007. RL2034.2 +048500 MOVE "REL-TEST-007" TO PAR-NAME RL2034.2 +048600 OPEN I-O RL-FD1. RL2034.2 +048700 MOVE ZERO TO WRK-CS-09V00-006 RL2034.2 +048800 MOVE ZERO TO WRK-CS-09V00-007 RL2034.2 +048900 MOVE ZERO TO WRK-CS-09V00-008 RL2034.2 +049000 MOVE ZERO TO WRK-CS-09V00-009 RL2034.2 +049100 MOVE ZERO TO WRK-CS-09V00-010 RL2034.2 +049200 MOVE ZERO TO WRK-CS-09V00-011 RL2034.2 +049300 MOVE 01 TO REC-CT. RL2034.2 +049400 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +049500 MOVE "DELETE" TO FEATURE. RL2034.2 +049600 REL-TEST-007-R. RL2034.2 +049700 ADD 1 TO WRK-CS-09V00-006 RL2034.2 +049800 ADD 1 TO WRK-CS-09V00-007. RL2034.2 +049900 READ RL-FD1 NEXT RECORD RL2034.2 +050000 AT END RL2034.2 +050100 MOVE "AT END PATH TAKEN " TO RE-MARK RL2034.2 +050200 GO TO REL-TEST-007-3. RL2034.2 +050300 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +050400 IF WRK-CS-09V00-007 EQUAL TO 4 RL2034.2 +050500 GO TO REL-TEST-007-2. RL2034.2 +050600 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +050700 MOVE "AT END NOT TAKEN" TO RE-MARK RL2034.2 +050800 GO TO REL-TEST-007-3. RL2034.2 +050900 GO TO REL-TEST-007-R. RL2034.2 +051000 REL-TEST-007-2. RL2034.2 +051100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2034.2 +051200 MOVE 99 TO UPDATE-NUMBER (1). RL2034.2 +051300 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-120. RL2034.2 +051400 DELETE RL-FD1 RL2034.2 +051500 INVALID KEY GO TO REL-TEST-007-3. RL2034.2 +051600 MOVE ZERO TO WRK-CS-09V00-007. RL2034.2 +051700 ADD 1 TO WRK-CS-09V00-008 RL2034.2 +051800 GO TO REL-TEST-007-R. RL2034.2 +051900 REL-TEST-007-3. RL2034.2 +052000 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2034.2 +052100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +052200 MOVE 501 TO CORRECT-18V0 RL2034.2 +052300 PERFORM FAIL RL2034.2 +052400 ELSE RL2034.2 +052500 PERFORM PASS. RL2034.2 +052600 PERFORM PRINT-DETAIL. RL2034.2 +052700 ADD 01 TO REC-CT. RL2034.2 +052800* .01 RL2034.2 +052900 IF WRK-CS-09V00-008 NOT EQUAL TO 125 RL2034.2 +053000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2034.2 +053100 MOVE 125 TO CORRECT-18V0 RL2034.2 +053200 MOVE "DELETED RECORDS" TO RE-MARK RL2034.2 +053300 PERFORM FAIL RL2034.2 +053400 ELSE RL2034.2 +053500 PERFORM PASS. RL2034.2 +053600 PERFORM PRINT-DETAIL. RL2034.2 +053700 ADD 01 TO REC-CT. RL2034.2 +053800* .02 RL2034.2 +053900 CLOSE RL-FD1. RL2034.2 +054000 REL-INIT-008. RL2034.2 +054100 MOVE "REL-TEST-008" TO PAR-NAME. RL2034.2 +054200 MOVE ZERO TO WRK-CS-09V00-006 RL2034.2 +054300 MOVE ZERO TO WRK-CS-09V00-007 RL2034.2 +054400 MOVE ZERO TO WRK-CS-09V00-008 RL2034.2 +054500 MOVE ZERO TO WRK-CS-09V00-009 RL2034.2 +054600 MOVE ZERO TO WRK-CS-09V00-010 RL2034.2 +054700 MOVE ZERO TO WRK-CS-09V00-011 RL2034.2 +054800 MOVE 01 TO REC-CT. RL2034.2 +054900 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +055000 MOVE ZERO TO RL-FD1-KEY. RL2034.2 +055100 OPEN INPUT RL-FD1. RL2034.2 +055200 MOVE "READ UPDATED FILE" TO FEATURE. RL2034.2 +055300 REL-TEST-008-R. RL2034.2 +055400 ADD 1 TO WRK-CS-09V00-006. RL2034.2 +055500 ADD 1 TO WRK-CS-09V00-007. RL2034.2 +055600 ADD 1 TO WRK-CS-09V00-008. RL2034.2 +055700 READ RL-FD1 NEXT RECORD AT END GO TO REL-TEST-008-3. RL2034.2 +055800 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +055900 IF UPDATE-NUMBER (1) EQUAL TO 99 RL2034.2 +056000 ADD 1 TO WRK-CS-09V00-009. RL2034.2 +056100 IF WRK-CS-09V00-007 EQUAL TO 4 RL2034.2 +056200 MOVE 01 TO WRK-CS-09V00-007 RL2034.2 +056300 ADD 1 TO WRK-CS-09V00-008. RL2034.2 +056400 IF RL-FD1-KEY EQUAL TO XRECORD-NUMBER (1) RL2034.2 +056500 ADD 1 TO WRK-CS-09V00-010. RL2034.2 +056600 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL2034.2 +056700 ADD 1 TO WRK-CS-09V00-011. RL2034.2 +056800 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +056900 GO TO REL-TEST-008-3. RL2034.2 +057000 GO TO REL-TEST-008-R. RL2034.2 +057100 REL-TEST-008-3. RL2034.2 +057200 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL2034.2 +057300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2034.2 +057400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +057500 MOVE 376 TO CORRECT-18V0 RL2034.2 +057600 PERFORM FAIL RL2034.2 +057700 ELSE RL2034.2 +057800 PERFORM PASS. RL2034.2 +057900 PERFORM PRINT-DETAIL. RL2034.2 +058000 ADD 01 TO REC-CT. RL2034.2 +058100* .01 RL2034.2 +058200 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL2034.2 +058300 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2034.2 +058400 MOVE ZERO TO CORRECT-18V0 RL2034.2 +058500 MOVE "DELETED RECORDS" TO RE-MARK RL2034.2 +058600 PERFORM FAIL RL2034.2 +058700 ELSE RL2034.2 +058800 PERFORM PASS. RL2034.2 +058900 PERFORM PRINT-DETAIL. RL2034.2 +059000 ADD 01 TO REC-CT. RL2034.2 +059100* .02 RL2034.2 +059200 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL2034.2 +059300 MOVE "KEY MISMATCH" TO RE-MARK RL2034.2 +059400 MOVE 375 TO CORRECT-18V0 RL2034.2 +059500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2034.2 +059600 PERFORM FAIL RL2034.2 +059700 ELSE RL2034.2 +059800 PERFORM PASS. RL2034.2 +059900 PERFORM PRINT-DETAIL. RL2034.2 +060000 ADD 01 TO REC-CT. RL2034.2 +060100* .03 RL2034.2 +060200 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL2034.2 +060300 MOVE 375 TO CORRECT-18V0 RL2034.2 +060400 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL2034.2 +060500 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL2034.2 +060600 PERFORM FAIL RL2034.2 +060700 ELSE RL2034.2 +060800 PERFORM PASS. RL2034.2 +060900 PERFORM PRINT-DETAIL. RL2034.2 +061000*04 RL2034.2 +061100 CLOSE RL-FD1. RL2034.2 +061200 CCVS-EXIT SECTION. RL2034.2 +061300 CCVS-999999. RL2034.2 +061400 GO TO CLOSE-FILES. RL2034.2 +*END-OF,RL203A +*HEADER,COBOL,RL204A +000100 IDENTIFICATION DIVISION. RL2044.2 +000200 PROGRAM-ID. RL2044.2 +000300 RL204A. RL2044.2 +000400**************************************************************** RL2044.2 +000500* * RL2044.2 +000600* VALIDATION FOR:- * RL2044.2 +000700* * RL2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +000900* * RL2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2044.2 +001100* * RL2044.2 +001200**************************************************************** RL2044.2 +001300* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL2044.2 +001400* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING RL2044.2 +001500* ELEMENTS: RL2044.2 +001600* RL2044.2 +001700* (1) FILE STATUS RL2044.2 +001800* (2) USE AFTER EXCEPTION PROCEDURE ON FILE-NAME RL2044.2 +001900* (3) READ RL2044.2 +002000* (4) WRITE RL2044.2 +002100* (5) REWRITE RL2044.2 +002200* (6) RELATIVE KEY RL2044.2 +002300* (7) ACCESS MODE RL2044.2 +002400* RL2044.2 +002500* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL2044.2 +002600* (ACCESS MODE DYNAMIC) AND THEN UPDATES SELECTIVE RL2044.2 +002700* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL2044.2 +002800* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL2044.2 +002900* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL2044.2 +003000* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL2044.2 +003100* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL2044.2 +003200* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL2044.2 +003300* HAS BEEN SPECIFIED. RL2044.2 +003400* RL2044.2 +003500* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2044.2 +003600* PROGRAM ARE: RL2044.2 +003700* RL2044.2 +003800* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2044.2 +003900* RELATIVE I-O DATA FILE RL2044.2 +004000* X-55 SYSTEM PRINTER RL2044.2 +004100* X-69 ADDITIONAL VALUE OF CLAUSES RL2044.2 +004200* X-74 VALUE OF IMPLEMENTOR-NAME RL2044.2 +004300* X-75 OBJECT OF VALUE OF CLAUSE RL2044.2 +004400* X-82 SOURCE-COMPUTER RL2044.2 +004500* X-83 OBJECT-COMPUTER. RL2044.2 +004600* RL2044.2 +004700*************************************************** RL2044.2 +004800 ENVIRONMENT DIVISION. RL2044.2 +004900 CONFIGURATION SECTION. RL2044.2 +005000 SOURCE-COMPUTER. RL2044.2 +005100 XXXXX082. RL2044.2 +005200 OBJECT-COMPUTER. RL2044.2 +005300 XXXXX083. RL2044.2 +005400 INPUT-OUTPUT SECTION. RL2044.2 +005500 FILE-CONTROL. RL2044.2 +005600 SELECT PRINT-FILE ASSIGN TO RL2044.2 +005700 XXXXX055. RL2044.2 +005800 SELECT RL-FD2 ASSIGN RL2044.2 +005900 XXXXX022 RL2044.2 +006000 ORGANIZATION RELATIVE RL2044.2 +006100 ACCESS DYNAMIC RL2044.2 +006200 RELATIVE RL-FD2-KEY RL2044.2 +006300 FILE STATUS IS RL-FD2-STATUS. RL2044.2 +006400 DATA DIVISION. RL2044.2 +006500 FILE SECTION. RL2044.2 +006600 FD PRINT-FILE. RL2044.2 +006700 01 PRINT-REC PICTURE X(120). RL2044.2 +006800 01 DUMMY-RECORD PICTURE X(120). RL2044.2 +006900 FD RL-FD2 RL2044.2 +007000C VALUE OF RL2044.2 +007100C XXXXX074 RL2044.2 +007200C IS RL2044.2 +007300C XXXXX076 RL2044.2 +007400G XXXXX069 RL2044.2 +007500 LABEL RECORDS ARE STANDARD RL2044.2 +007600 BLOCK CONTAINS 1 RECORDS RL2044.2 +007700 DATA RECORD RL-FD2R1-F-G-240. RL2044.2 +007800 01 RL-FD2R1-F-G-240. RL2044.2 +007900 05 RL-FD2-WRK-120 PIC X(120). RL2044.2 +008000 05 RL-FD2-GRP-120. RL2044.2 +008100 10 RL-FD2-WRK-XN-0001-O120F RL2044.2 +008200 PICTURE X OCCURS 120 TIMES. RL2044.2 +008300 WORKING-STORAGE SECTION. RL2044.2 +008400 01 GRP-0001. RL2044.2 +008500 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL2044.2 +008600 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008700 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008800 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008900 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009000 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009100 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009200 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009300 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL2044.2 +009400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL2044.2 +009500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL2044.2 +009600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL2044.2 +009700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL2044.2 +009800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL2044.2 +009900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL2044.2 +010000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL2044.2 +010100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL2044.2 +010200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL2044.2 +010300 01 FILE-RECORD-INFORMATION-REC. RL2044.2 +010400 03 FILE-RECORD-INFO-SKELETON. RL2044.2 +010500 05 FILLER PICTURE X(48) VALUE RL2044.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2044.2 +010700 05 FILLER PICTURE X(46) VALUE RL2044.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2044.2 +010900 05 FILLER PICTURE X(26) VALUE RL2044.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". RL2044.2 +011100 05 FILLER PICTURE X(37) VALUE RL2044.2 +011200 ",RECKEY= ". RL2044.2 +011300 05 FILLER PICTURE X(38) VALUE RL2044.2 +011400 ",ALTKEY1= ". RL2044.2 +011500 05 FILLER PICTURE X(38) VALUE RL2044.2 +011600 ",ALTKEY2= ". RL2044.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.RL2044.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2044.2 +011900 05 FILE-RECORD-INFO-P1-120. RL2044.2 +012000 07 FILLER PIC X(5). RL2044.2 +012100 07 XFILE-NAME PIC X(6). RL2044.2 +012200 07 FILLER PIC X(8). RL2044.2 +012300 07 XRECORD-NAME PIC X(6). RL2044.2 +012400 07 FILLER PIC X(1). RL2044.2 +012500 07 REELUNIT-NUMBER PIC 9(1). RL2044.2 +012600 07 FILLER PIC X(7). RL2044.2 +012700 07 XRECORD-NUMBER PIC 9(6). RL2044.2 +012800 07 FILLER PIC X(6). RL2044.2 +012900 07 UPDATE-NUMBER PIC 9(2). RL2044.2 +013000 07 FILLER PIC X(5). RL2044.2 +013100 07 ODO-NUMBER PIC 9(4). RL2044.2 +013200 07 FILLER PIC X(5). RL2044.2 +013300 07 XPROGRAM-NAME PIC X(5). RL2044.2 +013400 07 FILLER PIC X(7). RL2044.2 +013500 07 XRECORD-LENGTH PIC 9(6). RL2044.2 +013600 07 FILLER PIC X(7). RL2044.2 +013700 07 CHARS-OR-RECORDS PIC X(2). RL2044.2 +013800 07 FILLER PIC X(1). RL2044.2 +013900 07 XBLOCK-SIZE PIC 9(4). RL2044.2 +014000 07 FILLER PIC X(6). RL2044.2 +014100 07 RECORDS-IN-FILE PIC 9(6). RL2044.2 +014200 07 FILLER PIC X(5). RL2044.2 +014300 07 XFILE-ORGANIZATION PIC X(2). RL2044.2 +014400 07 FILLER PIC X(6). RL2044.2 +014500 07 XLABEL-TYPE PIC X(1). RL2044.2 +014600 05 FILE-RECORD-INFO-P121-240. RL2044.2 +014700 07 FILLER PIC X(8). RL2044.2 +014800 07 XRECORD-KEY PIC X(29). RL2044.2 +014900 07 FILLER PIC X(9). RL2044.2 +015000 07 ALTERNATE-KEY1 PIC X(29). RL2044.2 +015100 07 FILLER PIC X(9). RL2044.2 +015200 07 ALTERNATE-KEY2 PIC X(29). RL2044.2 +015300 07 FILLER PIC X(7). RL2044.2 +015400 01 TEST-RESULTS. RL2044.2 +015500 02 FILLER PIC X VALUE SPACE. RL2044.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. RL2044.2 +015700 02 FILLER PIC X VALUE SPACE. RL2044.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. RL2044.2 +015900 02 FILLER PIC X VALUE SPACE. RL2044.2 +016000 02 PAR-NAME. RL2044.2 +016100 03 FILLER PIC X(19) VALUE SPACE. RL2044.2 +016200 03 PARDOT-X PIC X VALUE SPACE. RL2044.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. RL2044.2 +016400 02 FILLER PIC X(8) VALUE SPACE. RL2044.2 +016500 02 RE-MARK PIC X(61). RL2044.2 +016600 01 TEST-COMPUTED. RL2044.2 +016700 02 FILLER PIC X(30) VALUE SPACE. RL2044.2 +016800 02 FILLER PIC X(17) VALUE RL2044.2 +016900 " COMPUTED=". RL2044.2 +017000 02 COMPUTED-X. RL2044.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2044.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A RL2044.2 +017300 PIC -9(9).9(9). RL2044.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2044.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2044.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2044.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. RL2044.2 +017800 04 COMPUTED-18V0 PIC -9(18). RL2044.2 +017900 04 FILLER PIC X. RL2044.2 +018000 03 FILLER PIC X(50) VALUE SPACE. RL2044.2 +018100 01 TEST-CORRECT. RL2044.2 +018200 02 FILLER PIC X(30) VALUE SPACE. RL2044.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". RL2044.2 +018400 02 CORRECT-X. RL2044.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. RL2044.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2044.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2044.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2044.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2044.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. RL2044.2 +019100 04 CORRECT-18V0 PIC -9(18). RL2044.2 +019200 04 FILLER PIC X. RL2044.2 +019300 03 FILLER PIC X(2) VALUE SPACE. RL2044.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2044.2 +019500 01 CCVS-C-1. RL2044.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2044.2 +019700- "SS PARAGRAPH-NAME RL2044.2 +019800- " REMARKS". RL2044.2 +019900 02 FILLER PIC X(20) VALUE SPACE. RL2044.2 +020000 01 CCVS-C-2. RL2044.2 +020100 02 FILLER PIC X VALUE SPACE. RL2044.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". RL2044.2 +020300 02 FILLER PIC X(15) VALUE SPACE. RL2044.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". RL2044.2 +020500 02 FILLER PIC X(94) VALUE SPACE. RL2044.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2044.2 +020700 01 REC-CT PIC 99 VALUE ZERO. RL2044.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2044.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2044.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2044.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2044.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2044.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2044.2 +021700 01 CCVS-H-1. RL2044.2 +021800 02 FILLER PIC X(39) VALUE SPACES. RL2044.2 +021900 02 FILLER PIC X(42) VALUE RL2044.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2044.2 +022100 02 FILLER PIC X(39) VALUE SPACES. RL2044.2 +022200 01 CCVS-H-2A. RL2044.2 +022300 02 FILLER PIC X(40) VALUE SPACE. RL2044.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2044.2 +022500 02 FILLER PIC XXXX VALUE RL2044.2 +022600 "4.2 ". RL2044.2 +022700 02 FILLER PIC X(28) VALUE RL2044.2 +022800 " COPY - NOT FOR DISTRIBUTION". RL2044.2 +022900 02 FILLER PIC X(41) VALUE SPACE. RL2044.2 +023000 RL2044.2 +023100 01 CCVS-H-2B. RL2044.2 +023200 02 FILLER PIC X(15) VALUE RL2044.2 +023300 "TEST RESULT OF ". RL2044.2 +023400 02 TEST-ID PIC X(9). RL2044.2 +023500 02 FILLER PIC X(4) VALUE RL2044.2 +023600 " IN ". RL2044.2 +023700 02 FILLER PIC X(12) VALUE RL2044.2 +023800 " HIGH ". RL2044.2 +023900 02 FILLER PIC X(22) VALUE RL2044.2 +024000 " LEVEL VALIDATION FOR ". RL2044.2 +024100 02 FILLER PIC X(58) VALUE RL2044.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +024300 01 CCVS-H-3. RL2044.2 +024400 02 FILLER PIC X(34) VALUE RL2044.2 +024500 " FOR OFFICIAL USE ONLY ". RL2044.2 +024600 02 FILLER PIC X(58) VALUE RL2044.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2044.2 +024800 02 FILLER PIC X(28) VALUE RL2044.2 +024900 " COPYRIGHT 1985 ". RL2044.2 +025000 01 CCVS-E-1. RL2044.2 +025100 02 FILLER PIC X(52) VALUE SPACE. RL2044.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2044.2 +025300 02 ID-AGAIN PIC X(9). RL2044.2 +025400 02 FILLER PIC X(45) VALUE SPACES. RL2044.2 +025500 01 CCVS-E-2. RL2044.2 +025600 02 FILLER PIC X(31) VALUE SPACE. RL2044.2 +025700 02 FILLER PIC X(21) VALUE SPACE. RL2044.2 +025800 02 CCVS-E-2-2. RL2044.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2044.2 +026000 03 FILLER PIC X VALUE SPACE. RL2044.2 +026100 03 ENDER-DESC PIC X(44) VALUE RL2044.2 +026200 "ERRORS ENCOUNTERED". RL2044.2 +026300 01 CCVS-E-3. RL2044.2 +026400 02 FILLER PIC X(22) VALUE RL2044.2 +026500 " FOR OFFICIAL USE ONLY". RL2044.2 +026600 02 FILLER PIC X(12) VALUE SPACE. RL2044.2 +026700 02 FILLER PIC X(58) VALUE RL2044.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +026900 02 FILLER PIC X(13) VALUE SPACE. RL2044.2 +027000 02 FILLER PIC X(15) VALUE RL2044.2 +027100 " COPYRIGHT 1985". RL2044.2 +027200 01 CCVS-E-4. RL2044.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2044.2 +027400 02 FILLER PIC X(4) VALUE " OF ". RL2044.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2044.2 +027600 02 FILLER PIC X(40) VALUE RL2044.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". RL2044.2 +027800 01 XXINFO. RL2044.2 +027900 02 FILLER PIC X(19) VALUE RL2044.2 +028000 "*** INFORMATION ***". RL2044.2 +028100 02 INFO-TEXT. RL2044.2 +028200 04 FILLER PIC X(8) VALUE SPACE. RL2044.2 +028300 04 XXCOMPUTED PIC X(20). RL2044.2 +028400 04 FILLER PIC X(5) VALUE SPACE. RL2044.2 +028500 04 XXCORRECT PIC X(20). RL2044.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). RL2044.2 +028700 01 HYPHEN-LINE. RL2044.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. RL2044.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************RL2044.2 +029000- "*****************************************". RL2044.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************RL2044.2 +029200- "******************************". RL2044.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE RL2044.2 +029400 "RL204A". RL2044.2 +029500 PROCEDURE DIVISION. RL2044.2 +029600 DECLARATIVES. RL2044.2 +029700 RL-FD2-01 SECTION. RL2044.2 +029800 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL2044.2 +029900 RL-FD2-01-01. RL2044.2 +030000 ADD 1 TO WRK-CS-09V00-013. RL2044.2 +030100 GO TO RL-FD2-01-03 RL2044.2 +030200 RL-FD2-01-05 RL2044.2 +030300 DEPENDING ON WRK-CS-09V00-012. RL2044.2 +030400 GO TO RL-FD2-01-EXIT. RL2044.2 +030500 RL-FD2-01-03. RL2044.2 +030600*ENTRY FROM SEGMENT REL-TEST-009. RL2044.2 +030700* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL2044.2 +030800 ADD 1 TO WRK-CS-09V00-014. RL2044.2 +030900 RL-FD2-01-05. RL2044.2 +031000 ADD 1 TO WRK-CS-09V00-017. RL2044.2 +031100 IF XRECORD-NUMBER (2) EQUAL TO 500 RL2044.2 +031200 MOVE RL-FD2-STATUS TO WRK-XN-0002-002 RL2044.2 +031300 MOVE "10" TO WRK-XN-0002-003. RL2044.2 +031400 RL-FD2-01-EXIT. RL2044.2 +031500 EXIT. RL2044.2 +031600 END DECLARATIVES. RL2044.2 +031700 CCVS1 SECTION. RL2044.2 +031800 OPEN-FILES. RL2044.2 +031900 OPEN OUTPUT PRINT-FILE. RL2044.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2044.2 +032100 MOVE SPACE TO TEST-RESULTS. RL2044.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2044.2 +032300 MOVE ZERO TO REC-SKL-SUB. RL2044.2 +032400 PERFORM CCVS-INIT-FILE 9 TIMES. RL2044.2 +032500 CCVS-INIT-FILE. RL2044.2 +032600 ADD 1 TO REC-SKL-SUB. RL2044.2 +032700 MOVE FILE-RECORD-INFO-SKELETON RL2044.2 +032800 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2044.2 +032900 CCVS-INIT-EXIT. RL2044.2 +033000 GO TO CCVS1-EXIT. RL2044.2 +033100 CLOSE-FILES. RL2044.2 +033200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2044.2 +033300 TERMINATE-CCVS. RL2044.2 +033400S EXIT PROGRAM. RL2044.2 +033500STERMINATE-CALL. RL2044.2 +033600 STOP RUN. RL2044.2 +033700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2044.2 +033800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2044.2 +033900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2044.2 +034000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2044.2 +034100 MOVE "****TEST DELETED****" TO RE-MARK. RL2044.2 +034200 PRINT-DETAIL. RL2044.2 +034300 IF REC-CT NOT EQUAL TO ZERO RL2044.2 +034400 MOVE "." TO PARDOT-X RL2044.2 +034500 MOVE REC-CT TO DOTVALUE. RL2044.2 +034600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2044.2 +034700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2044.2 +034800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2044.2 +034900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2044.2 +035000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2044.2 +035100 MOVE SPACE TO CORRECT-X. RL2044.2 +035200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2044.2 +035300 MOVE SPACE TO RE-MARK. RL2044.2 +035400 HEAD-ROUTINE. RL2044.2 +035500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +035600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +035700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2044.2 +035800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2044.2 +035900 COLUMN-NAMES-ROUTINE. RL2044.2 +036000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +036100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +036300 END-ROUTINE. RL2044.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2044.2 +036500 END-RTN-EXIT. RL2044.2 +036600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +036700 END-ROUTINE-1. RL2044.2 +036800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2044.2 +036900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2044.2 +037000 ADD PASS-COUNTER TO ERROR-HOLD. RL2044.2 +037100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2044.2 +037200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2044.2 +037300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2044.2 +037400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2044.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2044.2 +037600 END-ROUTINE-12. RL2044.2 +037700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2044.2 +037800 IF ERROR-COUNTER IS EQUAL TO ZERO RL2044.2 +037900 MOVE "NO " TO ERROR-TOTAL RL2044.2 +038000 ELSE RL2044.2 +038100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2044.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2044.2 +038300 PERFORM WRITE-LINE. RL2044.2 +038400 END-ROUTINE-13. RL2044.2 +038500 IF DELETE-COUNTER IS EQUAL TO ZERO RL2044.2 +038600 MOVE "NO " TO ERROR-TOTAL ELSE RL2044.2 +038700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2044.2 +038800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2044.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039000 IF INSPECT-COUNTER EQUAL TO ZERO RL2044.2 +039100 MOVE "NO " TO ERROR-TOTAL RL2044.2 +039200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2044.2 +039300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2044.2 +039400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039600 WRITE-LINE. RL2044.2 +039700 ADD 1 TO RECORD-COUNT. RL2044.2 +039800Y IF RECORD-COUNT GREATER 50 RL2044.2 +039900Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2044.2 +040000Y MOVE SPACE TO DUMMY-RECORD RL2044.2 +040100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2044.2 +040200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2044.2 +040300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2044.2 +040400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2044.2 +040500Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2044.2 +040600Y MOVE ZERO TO RECORD-COUNT. RL2044.2 +040700 PERFORM WRT-LN. RL2044.2 +040800 WRT-LN. RL2044.2 +040900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2044.2 +041000 MOVE SPACE TO DUMMY-RECORD. RL2044.2 +041100 BLANK-LINE-PRINT. RL2044.2 +041200 PERFORM WRT-LN. RL2044.2 +041300 FAIL-ROUTINE. RL2044.2 +041400 IF COMPUTED-X NOT EQUAL TO SPACE RL2044.2 +041500 GO TO FAIL-ROUTINE-WRITE. RL2044.2 +041600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2044.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2044.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2044.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. RL2044.2 +042100 GO TO FAIL-ROUTINE-EX. RL2044.2 +042200 FAIL-ROUTINE-WRITE. RL2044.2 +042300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2044.2 +042400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2044.2 +042500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2044.2 +042600 MOVE SPACES TO COR-ANSI-REFERENCE. RL2044.2 +042700 FAIL-ROUTINE-EX. EXIT. RL2044.2 +042800 BAIL-OUT. RL2044.2 +042900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2044.2 +043000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2044.2 +043100 BAIL-OUT-WRITE. RL2044.2 +043200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2044.2 +043300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2044.2 +043400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +043500 MOVE SPACES TO INF-ANSI-REFERENCE. RL2044.2 +043600 BAIL-OUT-EX. EXIT. RL2044.2 +043700 CCVS1-EXIT. RL2044.2 +043800 EXIT. RL2044.2 +043900 SECT-RL204-001 SECTION. RL2044.2 +044000 REL-INIT-009. RL2044.2 +044100 MOVE "REL-TEST-009" TO PAR-NAME. RL2044.2 +044200 MOVE "CREATE RL-FD2" TO FEATURE RL2044.2 +044300 MOVE "RL-FD2" TO XFILE-NAME (2). RL2044.2 +044400 MOVE "R1-F-G" TO XRECORD-NAME (2). RL2044.2 +044500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL2044.2 +044600 MOVE 000240 TO XRECORD-LENGTH (2). RL2044.2 +044700 MOVE "RC" TO CHARS-OR-RECORDS (2). RL2044.2 +044800 MOVE 0001 TO XBLOCK-SIZE (2). RL2044.2 +044900 MOVE 000500 TO RECORDS-IN-FILE (2). RL2044.2 +045000 MOVE "RL" TO XFILE-ORGANIZATION (2). RL2044.2 +045100 MOVE "S" TO XLABEL-TYPE (2). RL2044.2 +045200 MOVE 000001 TO XRECORD-NUMBER (2). RL2044.2 +045300*INITIALIZE RECORD WORK AREA NUMBER 2. RL2044.2 +045400 MOVE 1 TO WRK-CS-09V00-012. RL2044.2 +045500 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL2044.2 +045600 WRK-CS-09V00-015 WRK-CS-09V00-016 RL2044.2 +045700 WRK-CS-09V00-017 WRK-CS-09V00-018. RL2044.2 +045800 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +045900 MOVE 90000002 TO RL-FD2-KEY. RL2044.2 +046000 MOVE 01 TO REC-CT. RL2044.2 +046100 OPEN OUTPUT RL-FD2. RL2044.2 +046200 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL2044.2 +046300*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL2044.2 +046400 REL-TEST-009-R. RL2044.2 +046500 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL2044.2 +046600 MOVE "99" TO RL-FD2-STATUS. RL2044.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL2044.2 +046800 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL2044.2 +046900 RL-FD2-GRP-120. RL2044.2 +047000 WRITE RL-FD2R1-F-G-240. RL2044.2 +047100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +047200 GO TO REL-TEST-009-2. RL2044.2 +047300 IF XRECORD-NUMBER (2) EQUAL TO 500 RL2044.2 +047400 GO TO REL-TEST-009-2. RL2044.2 +047500 ADD 01 TO XRECORD-NUMBER (2). RL2044.2 +047600 GO TO REL-TEST-009-R. RL2044.2 +047700 REL-TEST-009-2. RL2044.2 +047800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL2044.2 +047900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL2044.2 +048000 MOVE ZERO TO CORRECT-18V0 RL2044.2 +048100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL2044.2 +048200 PERFORM FAIL RL2044.2 +048300 ELSE RL2044.2 +048400 PERFORM PASS. RL2044.2 +048500 PERFORM PRINT-DETAIL. RL2044.2 +048600 ADD 01 TO REC-CT. RL2044.2 +048700* .01 RL2044.2 +048800 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL2044.2 +048900 MOVE "INCORRECT COUNT" TO RE-MARK RL2044.2 +049000 MOVE 500 TO CORRECT-18V0 RL2044.2 +049100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL2044.2 +049200 PERFORM FAIL RL2044.2 +049300 ELSE RL2044.2 +049400 PERFORM PASS. RL2044.2 +049500 PERFORM PRINT-DETAIL. RL2044.2 +049600 ADD 01 TO REC-CT. RL2044.2 +049700* .02 RL2044.2 +049800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL2044.2 +049900 MOVE "STATUS/OPEN" TO RE-MARK RL2044.2 +050000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL2044.2 +050100 MOVE "00" TO CORRECT-A RL2044.2 +050200 PERFORM FAIL RL2044.2 +050300 ELSE RL2044.2 +050400 PERFORM PASS. RL2044.2 +050500 PERFORM PRINT-DETAIL. RL2044.2 +050600 ADD 01 TO REC-CT. RL2044.2 +050700* .03 RL2044.2 +050800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +050900 MOVE "STATUS/WRITE" TO RE-MARK RL2044.2 +051000 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +051100 MOVE "00" TO CORRECT-A RL2044.2 +051200 PERFORM FAIL RL2044.2 +051300 ELSE RL2044.2 +051400 PERFORM PASS. RL2044.2 +051500 PERFORM PRINT-DETAIL. RL2044.2 +051600 ADD 01 TO REC-CT. RL2044.2 +051700* .04 RL2044.2 +051800 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +051900 CLOSE RL-FD2. RL2044.2 +052000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +052100 MOVE "CLOSE/STATUS" TO RE-MARK RL2044.2 +052200 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +052300 MOVE "00" TO CORRECT-A RL2044.2 +052400 PERFORM FAIL RL2044.2 +052500 ELSE RL2044.2 +052600 PERFORM PASS. RL2044.2 +052700 PERFORM PRINT-DETAIL. RL2044.2 +052800 ADD 01 TO REC-CT. RL2044.2 +052900* .05 RL2044.2 +053000 REL-INIT-010. RL2044.2 +053100 MOVE "REL-TEST-010" TO PAR-NAME. RL2044.2 +053200 MOVE 2 TO WRK-CS-09V00-012. RL2044.2 +053300 MOVE ZERO TO WRK-CS-09V00-013. RL2044.2 +053400 MOVE ZERO TO WRK-CS-09V00-014. RL2044.2 +053500 MOVE ZERO TO WRK-CS-09V00-015. RL2044.2 +053600 MOVE ZERO TO WRK-CS-09V00-016. RL2044.2 +053700 MOVE ZERO TO WRK-CS-09V00-017. RL2044.2 +053800 MOVE ZERO TO WRK-CS-09V00-018. RL2044.2 +053900 MOVE 01 TO REC-CT. RL2044.2 +054000 OPEN I-O RL-FD2. RL2044.2 +054100 MOVE SPACE TO WRK-XN-0002-002 RL2044.2 +054200 MOVE SPACE TO WRK-XN-0002-003 RL2044.2 +054300 MOVE SPACE TO WRK-XN-0002-004 RL2044.2 +054400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL2044.2 +054500 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +054600*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL2044.2 +054700 MOVE "USE/FILE STATUS" TO FEATURE. RL2044.2 +054800 REL-TEST-010-R. RL2044.2 +054900 ADD 1 TO WRK-CS-09V00-014. RL2044.2 +055000 ADD 1 TO WRK-CS-09V00-015. RL2044.2 +055100 READ RL-FD2 NEXT RECORD. RL2044.2 +055200 IF RL-FD2-STATUS EQUAL TO "10" RL2044.2 +055300 GO TO REL-TEST-010-3. RL2044.2 +055400 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL2044.2 +055500 IF WRK-CS-09V00-015 EQUAL TO 5 RL2044.2 +055600 ADD 01 TO UPDATE-NUMBER (2) RL2044.2 +055700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL2044.2 +055800 REWRITE RL-FD2R1-F-G-240 RL2044.2 +055900 MOVE ZERO TO WRK-CS-09V00-015 RL2044.2 +056000 GO TO REL-TEST-010-2. RL2044.2 +056100 IF WRK-CS-09V00-014 GREATER 500 RL2044.2 +056200 GO TO REL-TEST-010-3. RL2044.2 +056300 GO TO REL-TEST-010-R. RL2044.2 +056400 REL-TEST-010-2. RL2044.2 +056500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +056600 ADD 1 TO WRK-CS-09V00-016. RL2044.2 +056700 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +056800 GO TO REL-TEST-010-R. RL2044.2 +056900 REL-TEST-010-3. RL2044.2 +057000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL2044.2 +057100 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL2044.2 +057200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL2044.2 +057300 MOVE 1 TO CORRECT-18V0 RL2044.2 +057400 PERFORM FAIL RL2044.2 +057500 ELSE RL2044.2 +057600 PERFORM PASS. RL2044.2 +057700 PERFORM PRINT-DETAIL. RL2044.2 +057800 ADD 01 TO REC-CT. RL2044.2 +057900* .01 RL2044.2 +058000 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL2044.2 +058100 MOVE "INCORRECT COUNT" TO RE-MARK RL2044.2 +058200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL2044.2 +058300 MOVE 501 TO CORRECT-18V0 RL2044.2 +058400 PERFORM FAIL RL2044.2 +058500 ELSE RL2044.2 +058600 PERFORM PASS. RL2044.2 +058700 PERFORM PRINT-DETAIL. RL2044.2 +058800 ADD 01 TO REC-CT. RL2044.2 +058900* .02 RL2044.2 +059000 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL2044.2 +059100 MOVE "OPEN/STATUS" TO RE-MARK RL2044.2 +059200 MOVE WRK-XN-0002-001 TO COMPUTED-A RL2044.2 +059300 MOVE "00" TO CORRECT-A RL2044.2 +059400 PERFORM FAIL RL2044.2 +059500 ELSE RL2044.2 +059600 PERFORM PASS. RL2044.2 +059700 PERFORM PRINT-DETAIL. RL2044.2 +059800 ADD 01 TO REC-CT. RL2044.2 +059900* .03 RL2044.2 +060000 IF RL-FD2-STATUS NOT EQUAL TO "10" RL2044.2 +060100 MOVE "ATEND/STATUS" TO RE-MARK RL2044.2 +060200 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +060300 MOVE "10" TO CORRECT-A RL2044.2 +060400 PERFORM FAIL RL2044.2 +060500 ELSE RL2044.2 +060600 PERFORM PASS. RL2044.2 +060700 PERFORM PRINT-DETAIL. RL2044.2 +060800 ADD 01 TO REC-CT. RL2044.2 +060900* .04 RL2044.2 +061000 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL2044.2 +061100 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL2044.2 +061200 MOVE WRK-XN-0002-002 TO COMPUTED-A RL2044.2 +061300 MOVE "10" TO CORRECT-A RL2044.2 +061400 PERFORM FAIL RL2044.2 +061500 ELSE RL2044.2 +061600 PERFORM PASS. RL2044.2 +061700 PERFORM PRINT-DETAIL. RL2044.2 +061800 ADD 01 TO REC-CT. RL2044.2 +061900* .05 RL2044.2 +062000 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL2044.2 +062100 MOVE "NO/EXCEPTION" TO RE-MARK RL2044.2 +062200 MOVE WRK-XN-0002-003 TO COMPUTED-A RL2044.2 +062300 MOVE "10" TO CORRECT-A RL2044.2 +062400 PERFORM FAIL RL2044.2 +062500 ELSE RL2044.2 +062600 PERFORM PASS. RL2044.2 +062700 PERFORM PRINT-DETAIL RL2044.2 +062800 ADD 01 TO REC-CT. RL2044.2 +062900* .06 RL2044.2 +063000 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +063100 CLOSE RL-FD2 RL2044.2 +063200 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +063300 MOVE "CLOSE/STATUS" TO RE-MARK RL2044.2 +063400 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +063500 MOVE "00" TO CORRECT-A RL2044.2 +063600 PERFORM FAIL RL2044.2 +063700 ELSE RL2044.2 +063800 PERFORM PASS. RL2044.2 +063900 PERFORM PRINT-DETAIL. RL2044.2 +064000 ADD 01 TO REC-CT. RL2044.2 +064100* .07 RL2044.2 +064200 CCVS-EXIT SECTION. RL2044.2 +064300 CCVS-999999. RL2044.2 +064400 GO TO CLOSE-FILES. RL2044.2 +*END-OF,RL204A +*HEADER,COBOL,RL205A +000100 IDENTIFICATION DIVISION. RL2054.2 +000200 PROGRAM-ID. RL2054.2 +000300 RL205A. RL2054.2 +000400**************************************************************** RL2054.2 +000500* * RL2054.2 +000600* VALIDATION FOR:- * RL2054.2 +000700* * RL2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +000900* * RL2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2054.2 +001100* * RL2054.2 +001200**************************************************************** RL2054.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE SYN- RL2054.2 +001400* TACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH LEVEL 2RL2054.2 +001500* OF THE RELATIVE I-O MODULE. THE ELEMENTS TESTED IN THIS RL2054.2 +001600* ROUTINE ARE: RL2054.2 +001700* RL2054.2 +001800* USE AFTER ERROR PROCEDURE FILE-NAME-1 FILE-NAME-2 RL2054.2 +001900* READ ..... NEXT RL2054.2 +002000* READ ..... NEXT RECORD INTO .... RL2054.2 +002100* READ ..... NEXT INTO ..... RL2054.2 +002200* READ ..... NEXT INTO ..... AT END .... RL2054.2 +002300* READ ..... RL2054.2 +002400* READ ..... INTO ..... RL2054.2 +002500* READ ..... RECORD RL2054.2 +002600* READ ..... RECORD INVALID ..... RL2054.2 +002700* READ ..... RECORD INVALID KEY .... RL2054.2 +002800* START FILE-NAME-2 RL2054.2 +002900* START FILE-NAME-2 KEY EQUAL TO .... RL2054.2 +003000* START FILE-NAME-2 KEY IS EQUAL TO .... RL2054.2 +003100* START FILE-NAME-2 KEY IS EQUAL ..... RL2054.2 +003200* START FILE-NAME-2 KEY IS = ...... RL2054.2 +003300* START FILE-NAME-2 KEY IS GREATER ..... RL2054.2 +003400* START FILE-NAME-2 KEY GREATER THAN .... RL2054.2 +003500* START FILE-NAME-2 KEY IS GREATER ..... RL2054.2 +003600* START FILE-NAME-2 KEY IS > .... RL2054.2 +003700* START FILE-NAME-2 KEY > .... RL2054.2 +003800* START FILE-NAME-2 KEY IS NOT LESS THAN .... RL2054.2 +003900* START FILE-NAME-2 KEY IS NOT LESS .... RL2054.2 +004000* START FILE-NAME-2 KEY NOT LESS .... RL2054.2 +004100* START FILE-NAME-2 KEY IS NOT < ..... RL2054.2 +004200* START FILE-NAME-1 KEY IS EQUAL TO INVALID KEY ..... RL2054.2 +004300* START FILE-NAME-1 KEY IS EQUAL TO INVALID .... RL2054.2 +004400* START FILE-NAME-1 INVALID KEY .... RL2054.2 +004500* START FILE-NAME-1 ; INVALID KEY .... RL2054.2 +004600* START FILE-NAME-1 KEY EQUAL TO ..... RL2054.2 +004700* FILE POSITION INDICATOR RL2054.2 +004800* RL2054.2 +004900* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS RL2054.2 +005000* ROUTINE. RL2054.2 +005100* FOR A RELATIVE OR INDEXED FILE IN THE DYNAMIC ACCESS MODE, RL2054.2 +005200* EXECUTION OF AN "OPEN I-O" STATEMENT FOLLOWED BYONE OR RL2054.2 +005300* MORE "WRITE" STATEMENTS AND THEN A "READ NEXT" STATEMENT RL2054.2 +005400* WILL CAUSE THE "READ" STATEMENT TO ACCESS THE FIRST RECORD RL2054.2 +005500* IN THE FILE AT THE TIME OF EXECUTION OF THE "READ" RL2054.2 +005600* STATEMENT. SYNTAX TESTS FOR THE "START" STATEMENT ARE RL2054.2 +005700* ALSO INCLUDED. RL2054.2 +005800* RL2054.2 +005900* RL2054.2 +006000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE RL2054.2 +006100* RL2054.2 +006200* X-21 RELATIVE FILE IMPLEMENTOR-NAME IN ASSGN TO RL2054.2 +006300* CLAUSE FOR DATA FILE RL-FS1 RL2054.2 +006400* X-22 RELATIVE FILE IMPLEMENTOR-NAME IN ASSIGN TO RL2054.2 +006500* CLAUSE FOR DATA FILE RL-FD2 RL2054.2 +006600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER RL2054.2 +006700* X-69 ADDITIONAL VALUE OF PHRASES RL2054.2 +006800* X-74 VALUE OF IMPLEMENTOR-NAME RL2054.2 +006900* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE RL-FS1 RL2054.2 +007000* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE RL-FD2 RL2054.2 +007100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER RL2054.2 +007200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER RL2054.2 +007300* RL2054.2 +007400* NOTE: X-CARDS 69,74,75 AND 76 ARE OPTIONAL RL2054.2 +007500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- RL2054.2 +007600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM RL2054.2 +007700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS RL2054.2 +007800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED RL2054.2 +007900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE RL2054.2 +008000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE RL2054.2 +008100* CONTROL CARD. THE LETTER CORRESPONDS TO A RL2054.2 +008200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND RL2054.2 +008300* THEY ARE AS FOLLOWS RL2054.2 +008400* RL2054.2 +008500* C SELECTS X-CARDS 74,75 AND 76 RL2054.2 +008600* G SELECTS X-CARDS 69 RL2054.2 +008700* RL2054.2 +008800* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM RL2054.2 +008900* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL RL2054.2 +009000* CODE IS IDENTIFIED BY THE LETTER X IN RL2054.2 +009100* POSITION 7 OF THE SOURCE LINE. USE OF RL2054.2 +009200* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS RL2054.2 +009300* OF THE FILES AFTER THE TEST REPORT. RL2054.2 +009400* IF THE VP-ROUTINE IS USED THE APPROPRIATE RL2054.2 +009500* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE RL2054.2 +009600* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLRL2054.2 +009700* CARD. RL2054.2 +009800* RL2054.2 +009900****************************************************** RL2054.2 +010000 ENVIRONMENT DIVISION. RL2054.2 +010100 CONFIGURATION SECTION. RL2054.2 +010200 SOURCE-COMPUTER. RL2054.2 +010300 XXXXX082. RL2054.2 +010400 OBJECT-COMPUTER. RL2054.2 +010500 XXXXX083. RL2054.2 +010600 INPUT-OUTPUT SECTION. RL2054.2 +010700 FILE-CONTROL. RL2054.2 +010800 SELECT PRINT-FILE ASSIGN TO RL2054.2 +010900 XXXXX055. RL2054.2 +011000 SELECT RL-FD1 RL2054.2 +011100 ASSIGN TO RL2054.2 +011200 XXXXX021 RL2054.2 +011300 ORGANIZATION IS RELATIVE RL2054.2 +011400 ACCESS MODE IS DYNAMIC RL2054.2 +011500 RELATIVE KEY IS RL-FD1-KEY. RL2054.2 +011600 SELECT RL-FS2 RL2054.2 +011700 ASSIGN TO RL2054.2 +011800 XXXXX022 RL2054.2 +011900 ACCESS MODE IS SEQUENTIAL RL2054.2 +012000 RELATIVE KEY IS RL-FS2-KEY RL2054.2 +012100 ORGANIZATION IS RELATIVE. RL2054.2 +012200 DATA DIVISION. RL2054.2 +012300 FILE SECTION. RL2054.2 +012400 FD PRINT-FILE. RL2054.2 +012500 01 PRINT-REC PICTURE X(120). RL2054.2 +012600 01 DUMMY-RECORD PICTURE X(120). RL2054.2 +012700 FD RL-FD1 RL2054.2 +012800 RECORD CONTAINS 240 CHARACTERS RL2054.2 +012900C VALUE OF RL2054.2 +013000C XXXXX074 RL2054.2 +013100C IS RL2054.2 +013200C XXXXX075 RL2054.2 +013300G XXXXX069 RL2054.2 +013400 . RL2054.2 +013500 01 RL-FD1R1-F-G-240. RL2054.2 +013600 05 RL-FD1-REC-001-120 PICTURE X(120). RL2054.2 +013700 05 RL-FD1-REC-121-240. RL2054.2 +013800 10 FILLER PICTURE X(8). RL2054.2 +013900 10 RL-FD1-FILLER. RL2054.2 +014000 15 RL-FS1-KEYNUM PICTURE 9(5). RL2054.2 +014100 10 FILLER PICTURE X(5). RL2054.2 +014200 10 FILLER PICTURE X(19). RL2054.2 +014300 10 FILLER PICTURE X(9). RL2054.2 +014400 10 RL-FD1-FILLER1. RL2054.2 +014500 15 RL-FD1-FILLER1NUM PICTURE 9(5). RL2054.2 +014600 10 FILLER PICTURE 9(5). RL2054.2 +014700 10 FILLER PICTURE X(19). RL2054.2 +014800 10 FILLER PICTURE X(45). RL2054.2 +014900 FD RL-FS2 RL2054.2 +015000C VALUE OF RL2054.2 +015100C XXXXX074 RL2054.2 +015200C IS RL2054.2 +015300C XXXXX076 RL2054.2 +015400G XXXXX069 RL2054.2 +015500 . RL2054.2 +015600 01 RL-FS2R1-F-G-240. RL2054.2 +015700 05 RL-FS2-REC-001-120 PICTURE X(120). RL2054.2 +015800 05 RL-FS2-REC-121-240. RL2054.2 +015900 10 FILLER PICTURE X(8). RL2054.2 +016000 10 RL-FS2-FILLER. RL2054.2 +016100 15 RL-FS2-KEYNUM PICTURE 9(5). RL2054.2 +016200 10 FILLER PICTURE 9(5). RL2054.2 +016300 10 FILLER PICTURE X(19). RL2054.2 +016400 10 FILLER PICTURE X(9). RL2054.2 +016500 10 RL-FS2-FILLER1. RL2054.2 +016600 15 RL-FS2-FILLER1NUM PICTURE 9(5). RL2054.2 +016700 10 FILLER PICTURE 9(5). RL2054.2 +016800 10 FILLER PICTURE X(19). RL2054.2 +016900 10 FILLER PICTURE X(45). RL2054.2 +017000 WORKING-STORAGE SECTION. RL2054.2 +017100 01 WRK-XN-00001 PIC X. RL2054.2 +017200 01 WRK-XN-00002 PIC X. RL2054.2 +017300 01 RL-FD1-KEY PICTURE 9(5) VALUE ZERO. RL2054.2 +017400 01 RL-FS2-KEY PICTURE 9(5) VALUE ZERO. RL2054.2 +017500 01 RL-FD1-FILESIZE PICTURE 9(6) VALUE 300. RL2054.2 +017600 01 RL-FS2-FILESIZE PICTURE 9(6) VALUE 300. RL2054.2 +017700 01 WRK-RL-FD1-RECKEY-CHAR. RL2054.2 +017800 03 WRK-RL-FD1-RECKEY PIC 9(5) VALUE ZERO. RL2054.2 +017900 01 WRK-RL-FS2-RECKEY PIC 9(5) VALUE ZERO. RL2054.2 +018000 01 WRK-RL-FD1-FILLER. RL2054.2 +018100 03 WRK-DU-05V00-002 PICTURE 9(5) VALUE ZERO. RL2054.2 +018200 01 WRK-RL-FS2-FILLER. RL2054.2 +018300 03 WRK-DU-05V00-004 PICTURE 9(5) VALUE ZERO. RL2054.2 +018400 01 EXCUT-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. RL2054.2 +018500 01 INV-KEY-COUNTER PICTURE S9(6) VALUE ZERO. RL2054.2 +018600 01 LOGICAL-FILE-REC PICTURE S9(6) VALUE ZERO. RL2054.2 +018700 01 ERROR-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. RL2054.2 +018800 01 ASCEND-DESEND-SWITCH PICTURE XX VALUE "UP". RL2054.2 +018900 88 ASCEND VALUE "UP". RL2054.2 +019000 88 DSCEND VALUE "DN". RL2054.2 +019100 01 FILE-RECORD-INFORMATION-REC. RL2054.2 +019200 03 FILE-RECORD-INFO-SKELETON. RL2054.2 +019300 05 FILLER PICTURE X(48) VALUE RL2054.2 +019400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2054.2 +019500 05 FILLER PICTURE X(46) VALUE RL2054.2 +019600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2054.2 +019700 05 FILLER PICTURE X(26) VALUE RL2054.2 +019800 ",LFIL=000000,ORG= ,LBLR= ". RL2054.2 +019900 05 FILLER PICTURE X(37) VALUE RL2054.2 +020000 ",RECKEY= ". RL2054.2 +020100 05 FILLER PICTURE X(38) VALUE RL2054.2 +020200 ",ALTKEY1= ". RL2054.2 +020300 05 FILLER PICTURE X(38) VALUE RL2054.2 +020400 ",ALTKEY2= ". RL2054.2 +020500 05 FILLER PICTURE X(7) VALUE SPACE.RL2054.2 +020600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2054.2 +020700 05 FILE-RECORD-INFO-P1-120. RL2054.2 +020800 07 FILLER PIC X(5). RL2054.2 +020900 07 XFILE-NAME PIC X(6). RL2054.2 +021000 07 FILLER PIC X(8). RL2054.2 +021100 07 XRECORD-NAME PIC X(6). RL2054.2 +021200 07 FILLER PIC X(1). RL2054.2 +021300 07 REELUNIT-NUMBER PIC 9(1). RL2054.2 +021400 07 FILLER PIC X(7). RL2054.2 +021500 07 XRECORD-NUMBER PIC 9(6). RL2054.2 +021600 07 FILLER PIC X(6). RL2054.2 +021700 07 UPDATE-NUMBER PIC 9(2). RL2054.2 +021800 07 FILLER PIC X(5). RL2054.2 +021900 07 ODO-NUMBER PIC 9(4). RL2054.2 +022000 07 FILLER PIC X(5). RL2054.2 +022100 07 XPROGRAM-NAME PIC X(5). RL2054.2 +022200 07 FILLER PIC X(7). RL2054.2 +022300 07 XRECORD-LENGTH PIC 9(6). RL2054.2 +022400 07 FILLER PIC X(7). RL2054.2 +022500 07 CHARS-OR-RECORDS PIC X(2). RL2054.2 +022600 07 FILLER PIC X(1). RL2054.2 +022700 07 XBLOCK-SIZE PIC 9(4). RL2054.2 +022800 07 FILLER PIC X(6). RL2054.2 +022900 07 RECORDS-IN-FILE PIC 9(6). RL2054.2 +023000 07 FILLER PIC X(5). RL2054.2 +023100 07 XFILE-ORGANIZATION PIC X(2). RL2054.2 +023200 07 FILLER PIC X(6). RL2054.2 +023300 07 XLABEL-TYPE PIC X(1). RL2054.2 +023400 05 FILE-RECORD-INFO-P121-240. RL2054.2 +023500 07 FILLER PIC X(8). RL2054.2 +023600 07 XRECORD-KEY PIC X(29). RL2054.2 +023700 07 FILLER PIC X(9). RL2054.2 +023800 07 ALTERNATE-KEY1 PIC X(29). RL2054.2 +023900 07 FILLER PIC X(9). RL2054.2 +024000 07 ALTERNATE-KEY2 PIC X(29). RL2054.2 +024100 07 FILLER PIC X(7). RL2054.2 +024200 01 TEST-RESULTS. RL2054.2 +024300 02 FILLER PIC X VALUE SPACE. RL2054.2 +024400 02 FEATURE PIC X(20) VALUE SPACE. RL2054.2 +024500 02 FILLER PIC X VALUE SPACE. RL2054.2 +024600 02 P-OR-F PIC X(5) VALUE SPACE. RL2054.2 +024700 02 FILLER PIC X VALUE SPACE. RL2054.2 +024800 02 PAR-NAME. RL2054.2 +024900 03 FILLER PIC X(19) VALUE SPACE. RL2054.2 +025000 03 PARDOT-X PIC X VALUE SPACE. RL2054.2 +025100 03 DOTVALUE PIC 99 VALUE ZERO. RL2054.2 +025200 02 FILLER PIC X(8) VALUE SPACE. RL2054.2 +025300 02 RE-MARK PIC X(61). RL2054.2 +025400 01 TEST-COMPUTED. RL2054.2 +025500 02 FILLER PIC X(30) VALUE SPACE. RL2054.2 +025600 02 FILLER PIC X(17) VALUE RL2054.2 +025700 " COMPUTED=". RL2054.2 +025800 02 COMPUTED-X. RL2054.2 +025900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2054.2 +026000 03 COMPUTED-N REDEFINES COMPUTED-A RL2054.2 +026100 PIC -9(9).9(9). RL2054.2 +026200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2054.2 +026300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2054.2 +026400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2054.2 +026500 03 CM-18V0 REDEFINES COMPUTED-A. RL2054.2 +026600 04 COMPUTED-18V0 PIC -9(18). RL2054.2 +026700 04 FILLER PIC X. RL2054.2 +026800 03 FILLER PIC X(50) VALUE SPACE. RL2054.2 +026900 01 TEST-CORRECT. RL2054.2 +027000 02 FILLER PIC X(30) VALUE SPACE. RL2054.2 +027100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2054.2 +027200 02 CORRECT-X. RL2054.2 +027300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2054.2 +027400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2054.2 +027500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2054.2 +027600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2054.2 +027700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2054.2 +027800 03 CR-18V0 REDEFINES CORRECT-A. RL2054.2 +027900 04 CORRECT-18V0 PIC -9(18). RL2054.2 +028000 04 FILLER PIC X. RL2054.2 +028100 03 FILLER PIC X(2) VALUE SPACE. RL2054.2 +028200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2054.2 +028300 01 CCVS-C-1. RL2054.2 +028400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2054.2 +028500- "SS PARAGRAPH-NAME RL2054.2 +028600- " REMARKS". RL2054.2 +028700 02 FILLER PIC X(20) VALUE SPACE. RL2054.2 +028800 01 CCVS-C-2. RL2054.2 +028900 02 FILLER PIC X VALUE SPACE. RL2054.2 +029000 02 FILLER PIC X(6) VALUE "TESTED". RL2054.2 +029100 02 FILLER PIC X(15) VALUE SPACE. RL2054.2 +029200 02 FILLER PIC X(4) VALUE "FAIL". RL2054.2 +029300 02 FILLER PIC X(94) VALUE SPACE. RL2054.2 +029400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2054.2 +029500 01 REC-CT PIC 99 VALUE ZERO. RL2054.2 +029600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2054.2 +030000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2054.2 +030100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2054.2 +030200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2054.2 +030300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2054.2 +030400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2054.2 +030500 01 CCVS-H-1. RL2054.2 +030600 02 FILLER PIC X(39) VALUE SPACES. RL2054.2 +030700 02 FILLER PIC X(42) VALUE RL2054.2 +030800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2054.2 +030900 02 FILLER PIC X(39) VALUE SPACES. RL2054.2 +031000 01 CCVS-H-2A. RL2054.2 +031100 02 FILLER PIC X(40) VALUE SPACE. RL2054.2 +031200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2054.2 +031300 02 FILLER PIC XXXX VALUE RL2054.2 +031400 "4.2 ". RL2054.2 +031500 02 FILLER PIC X(28) VALUE RL2054.2 +031600 " COPY - NOT FOR DISTRIBUTION". RL2054.2 +031700 02 FILLER PIC X(41) VALUE SPACE. RL2054.2 +031800 RL2054.2 +031900 01 CCVS-H-2B. RL2054.2 +032000 02 FILLER PIC X(15) VALUE RL2054.2 +032100 "TEST RESULT OF ". RL2054.2 +032200 02 TEST-ID PIC X(9). RL2054.2 +032300 02 FILLER PIC X(4) VALUE RL2054.2 +032400 " IN ". RL2054.2 +032500 02 FILLER PIC X(12) VALUE RL2054.2 +032600 " HIGH ". RL2054.2 +032700 02 FILLER PIC X(22) VALUE RL2054.2 +032800 " LEVEL VALIDATION FOR ". RL2054.2 +032900 02 FILLER PIC X(58) VALUE RL2054.2 +033000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +033100 01 CCVS-H-3. RL2054.2 +033200 02 FILLER PIC X(34) VALUE RL2054.2 +033300 " FOR OFFICIAL USE ONLY ". RL2054.2 +033400 02 FILLER PIC X(58) VALUE RL2054.2 +033500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2054.2 +033600 02 FILLER PIC X(28) VALUE RL2054.2 +033700 " COPYRIGHT 1985 ". RL2054.2 +033800 01 CCVS-E-1. RL2054.2 +033900 02 FILLER PIC X(52) VALUE SPACE. RL2054.2 +034000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2054.2 +034100 02 ID-AGAIN PIC X(9). RL2054.2 +034200 02 FILLER PIC X(45) VALUE SPACES. RL2054.2 +034300 01 CCVS-E-2. RL2054.2 +034400 02 FILLER PIC X(31) VALUE SPACE. RL2054.2 +034500 02 FILLER PIC X(21) VALUE SPACE. RL2054.2 +034600 02 CCVS-E-2-2. RL2054.2 +034700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2054.2 +034800 03 FILLER PIC X VALUE SPACE. RL2054.2 +034900 03 ENDER-DESC PIC X(44) VALUE RL2054.2 +035000 "ERRORS ENCOUNTERED". RL2054.2 +035100 01 CCVS-E-3. RL2054.2 +035200 02 FILLER PIC X(22) VALUE RL2054.2 +035300 " FOR OFFICIAL USE ONLY". RL2054.2 +035400 02 FILLER PIC X(12) VALUE SPACE. RL2054.2 +035500 02 FILLER PIC X(58) VALUE RL2054.2 +035600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +035700 02 FILLER PIC X(13) VALUE SPACE. RL2054.2 +035800 02 FILLER PIC X(15) VALUE RL2054.2 +035900 " COPYRIGHT 1985". RL2054.2 +036000 01 CCVS-E-4. RL2054.2 +036100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2054.2 +036200 02 FILLER PIC X(4) VALUE " OF ". RL2054.2 +036300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2054.2 +036400 02 FILLER PIC X(40) VALUE RL2054.2 +036500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2054.2 +036600 01 XXINFO. RL2054.2 +036700 02 FILLER PIC X(19) VALUE RL2054.2 +036800 "*** INFORMATION ***". RL2054.2 +036900 02 INFO-TEXT. RL2054.2 +037000 04 FILLER PIC X(8) VALUE SPACE. RL2054.2 +037100 04 XXCOMPUTED PIC X(20). RL2054.2 +037200 04 FILLER PIC X(5) VALUE SPACE. RL2054.2 +037300 04 XXCORRECT PIC X(20). RL2054.2 +037400 02 INF-ANSI-REFERENCE PIC X(48). RL2054.2 +037500 01 HYPHEN-LINE. RL2054.2 +037600 02 FILLER PIC IS X VALUE IS SPACE. RL2054.2 +037700 02 FILLER PIC IS X(65) VALUE IS "************************RL2054.2 +037800- "*****************************************". RL2054.2 +037900 02 FILLER PIC IS X(54) VALUE IS "************************RL2054.2 +038000- "******************************". RL2054.2 +038100 01 CCVS-PGM-ID PIC X(9) VALUE RL2054.2 +038200 "RL205A". RL2054.2 +038300 PROCEDURE DIVISION. RL2054.2 +038400 DECLARATIVES. RL2054.2 +038500 USE-RL205-TEST SECTION. RL2054.2 +038600 USE AFTER ERROR PROCEDURE RL-FD1 RL-FS2. RL2054.2 +038700 USE-PAR-001. RL2054.2 +038800 ADD 010000 TO ERROR-COUNTER-06V00. RL2054.2 +038900 USE-PAR-EXIT. RL2054.2 +039000 EXIT. RL2054.2 +039100 END DECLARATIVES. RL2054.2 +039200 CCVS1 SECTION. RL2054.2 +039300 OPEN-FILES. RL2054.2 +039400 OPEN OUTPUT PRINT-FILE. RL2054.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2054.2 +039600 MOVE SPACE TO TEST-RESULTS. RL2054.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2054.2 +039800 MOVE ZERO TO REC-SKL-SUB. RL2054.2 +039900 PERFORM CCVS-INIT-FILE 9 TIMES. RL2054.2 +040000 CCVS-INIT-FILE. RL2054.2 +040100 ADD 1 TO REC-SKL-SUB. RL2054.2 +040200 MOVE FILE-RECORD-INFO-SKELETON RL2054.2 +040300 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2054.2 +040400 CCVS-INIT-EXIT. RL2054.2 +040500 GO TO CCVS1-EXIT. RL2054.2 +040600 CLOSE-FILES. RL2054.2 +040700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2054.2 +040800 TERMINATE-CCVS. RL2054.2 +040900S EXIT PROGRAM. RL2054.2 +041000STERMINATE-CALL. RL2054.2 +041100 STOP RUN. RL2054.2 +041200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2054.2 +041300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2054.2 +041400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2054.2 +041500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2054.2 +041600 MOVE "****TEST DELETED****" TO RE-MARK. RL2054.2 +041700 PRINT-DETAIL. RL2054.2 +041800 IF REC-CT NOT EQUAL TO ZERO RL2054.2 +041900 MOVE "." TO PARDOT-X RL2054.2 +042000 MOVE REC-CT TO DOTVALUE. RL2054.2 +042100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2054.2 +042200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2054.2 +042300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2054.2 +042400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2054.2 +042500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2054.2 +042600 MOVE SPACE TO CORRECT-X. RL2054.2 +042700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2054.2 +042800 MOVE SPACE TO RE-MARK. RL2054.2 +042900 HEAD-ROUTINE. RL2054.2 +043000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2054.2 +043300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2054.2 +043400 COLUMN-NAMES-ROUTINE. RL2054.2 +043500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +043600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +043800 END-ROUTINE. RL2054.2 +043900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2054.2 +044000 END-RTN-EXIT. RL2054.2 +044100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +044200 END-ROUTINE-1. RL2054.2 +044300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2054.2 +044400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2054.2 +044500 ADD PASS-COUNTER TO ERROR-HOLD. RL2054.2 +044600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2054.2 +044700 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2054.2 +044800 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2054.2 +044900 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2054.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2054.2 +045100 END-ROUTINE-12. RL2054.2 +045200 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2054.2 +045300 IF ERROR-COUNTER IS EQUAL TO ZERO RL2054.2 +045400 MOVE "NO " TO ERROR-TOTAL RL2054.2 +045500 ELSE RL2054.2 +045600 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2054.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2054.2 +045800 PERFORM WRITE-LINE. RL2054.2 +045900 END-ROUTINE-13. RL2054.2 +046000 IF DELETE-COUNTER IS EQUAL TO ZERO RL2054.2 +046100 MOVE "NO " TO ERROR-TOTAL ELSE RL2054.2 +046200 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2054.2 +046300 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2054.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +046500 IF INSPECT-COUNTER EQUAL TO ZERO RL2054.2 +046600 MOVE "NO " TO ERROR-TOTAL RL2054.2 +046700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2054.2 +046800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2054.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +047000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +047100 WRITE-LINE. RL2054.2 +047200 ADD 1 TO RECORD-COUNT. RL2054.2 +047300Y IF RECORD-COUNT GREATER 50 RL2054.2 +047400Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2054.2 +047500Y MOVE SPACE TO DUMMY-RECORD RL2054.2 +047600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2054.2 +047700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2054.2 +047800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2054.2 +047900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2054.2 +048000Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2054.2 +048100Y MOVE ZERO TO RECORD-COUNT. RL2054.2 +048200 PERFORM WRT-LN. RL2054.2 +048300 WRT-LN. RL2054.2 +048400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2054.2 +048500 MOVE SPACE TO DUMMY-RECORD. RL2054.2 +048600 BLANK-LINE-PRINT. RL2054.2 +048700 PERFORM WRT-LN. RL2054.2 +048800 FAIL-ROUTINE. RL2054.2 +048900 IF COMPUTED-X NOT EQUAL TO SPACE RL2054.2 +049000 GO TO FAIL-ROUTINE-WRITE. RL2054.2 +049100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2054.2 +049200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2054.2 +049300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2054.2 +049400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +049500 MOVE SPACES TO INF-ANSI-REFERENCE. RL2054.2 +049600 GO TO FAIL-ROUTINE-EX. RL2054.2 +049700 FAIL-ROUTINE-WRITE. RL2054.2 +049800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2054.2 +049900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2054.2 +050000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2054.2 +050100 MOVE SPACES TO COR-ANSI-REFERENCE. RL2054.2 +050200 FAIL-ROUTINE-EX. EXIT. RL2054.2 +050300 BAIL-OUT. RL2054.2 +050400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2054.2 +050500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2054.2 +050600 BAIL-OUT-WRITE. RL2054.2 +050700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2054.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2054.2 +050900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +051000 MOVE SPACES TO INF-ANSI-REFERENCE. RL2054.2 +051100 BAIL-OUT-EX. EXIT. RL2054.2 +051200 CCVS1-EXIT. RL2054.2 +051300 EXIT. RL2054.2 +051400 SECT-RL205-0001 SECTION. RL2054.2 +051500 REL-INIT-001. RL2054.2 +051600 OPEN OUTPUT RL-FD1. RL2054.2 +051700 OPEN OUTPUT RL-FS2. RL2054.2 +051800 MOVE "RL-FD1" TO XFILE-NAME (1). RL2054.2 +051900 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2054.2 +052000 MOVE ZERO TO XRECORD-NUMBER (1). RL2054.2 +052100 MOVE ".XXX." TO XPROGRAM-NAME (1). RL2054.2 +052200 MOVE 000240 TO XRECORD-LENGTH (1). RL2054.2 +052300 MOVE 0001 TO XBLOCK-SIZE (1). RL2054.2 +052400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2054.2 +052500 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2054.2 +052600 MOVE "S" TO XLABEL-TYPE (1). RL2054.2 +052700 MOVE 000300 TO RL-FD1-FILESIZE. RL2054.2 +052800 MOVE 000300 TO RECORDS-IN-FILE (1). RL2054.2 +052900 MOVE 00001 TO WRK-RL-FD1-RECKEY. RL2054.2 +053000 MOVE 00300 TO WRK-DU-05V00-002. RL2054.2 +053100 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +053200 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +053300 MOVE "REL-TEST-001" TO PAR-NAME. RL2054.2 +053400 MOVE ZERO TO REC-CT. RL2054.2 +053500 MOVE "RL-FS2" TO XFILE-NAME (2). RL2054.2 +053600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL2054.2 +053700 MOVE ZERO TO XRECORD-NUMBER (2). RL2054.2 +053800 MOVE ".XXX." TO XPROGRAM-NAME (2). RL2054.2 +053900 MOVE 000240 TO XRECORD-LENGTH (2). RL2054.2 +054000 MOVE 0001 TO XBLOCK-SIZE (2). RL2054.2 +054100 MOVE "RC" TO CHARS-OR-RECORDS (2). RL2054.2 +054200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL2054.2 +054300 MOVE "S" TO XLABEL-TYPE (2). RL2054.2 +054400 MOVE 00300 TO RL-FS2-FILESIZE. RL2054.2 +054500 MOVE 00300 TO RECORDS-IN-FILE (2). RL2054.2 +054600 MOVE 00001 TO WRK-RL-FS2-RECKEY. RL2054.2 +054700 MOVE 00300 TO WRK-DU-05V00-004. RL2054.2 +054800 REL-TEST-001-R1. RL2054.2 +054900 ADD 0001 TO XRECORD-NUMBER (1). RL2054.2 +055000 MOVE WRK-RL-FD1-RECKEY TO XRECORD-KEY (1). RL2054.2 +055100 MOVE WRK-RL-FD1-FILLER TO ALTERNATE-KEY1 (1). RL2054.2 +055200 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +055300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +055400 WRITE RL-FD1R1-F-G-240 RL2054.2 +055500 INVALID KEY RL2054.2 +055600 ADD 000001 TO INV-KEY-COUNTER. RL2054.2 +055700 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +055800 ADD 00001 TO WRK-RL-FD1-RECKEY. RL2054.2 +055900 SUBTRACT 00001 FROM WRK-DU-05V00-002. RL2054.2 +056000 IF XRECORD-NUMBER (1) LESS THAN RL-FD1-FILESIZE RL2054.2 +056100 GO TO REL-TEST-001-R1. RL2054.2 +056200 CLOSE RL-FD1. RL2054.2 +056300 REL-TEST-001-01. RL2054.2 +056400 MOVE "CREATE FILE RL-FD1" TO FEATURE. RL2054.2 +056500 MOVE 01 TO REC-CT. RL2054.2 +056600 IF EXCUT-COUNTER-06V00 NOT EQUAL TO RL-FD1-FILESIZE RL2054.2 +056700 PERFORM FAIL RL2054.2 +056800 MOVE RL-FD1-FILESIZE TO CORRECT-N RL2054.2 +056900 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N RL2054.2 +057000 MOVE "INCORRECT NUMBER OF WRITES" TO RE-MARK RL2054.2 +057100 PERFORM PRINT-DETAIL RL2054.2 +057200 GO TO REL-INIT-001-R2. RL2054.2 +057300 IF INV-KEY-COUNTER NOT EQUAL TO ZERO RL2054.2 +057400 PERFORM FAIL RL2054.2 +057500 MOVE INV-KEY-COUNTER TO COMPUTED-N RL2054.2 +057600 MOVE ZERO TO CORRECT-N RL2054.2 +057700 MOVE "INVALID KEY ON WRITE" TO RE-MARK RL2054.2 +057800 PERFORM PRINT-DETAIL RL2054.2 +057900 GO TO REL-INIT-001-R2. RL2054.2 +058000* RL2054.2 +058100* 01 RL2054.2 +058200* RL2054.2 +058300 PERFORM PASS. RL2054.2 +058400 PERFORM REL-WRITE-001. RL2054.2 +058500 REL-INIT-001-R2. RL2054.2 +058600 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +058700 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +058800 REL-TEST-001-R2. RL2054.2 +058900 ADD 0001 TO XRECORD-NUMBER (2). RL2054.2 +059000 MOVE WRK-RL-FS2-RECKEY TO XRECORD-KEY (2). RL2054.2 +059100 MOVE WRK-RL-FS2-FILLER TO ALTERNATE-KEY1 (2). RL2054.2 +059200 MOVE FILE-RECORD-INFO (2) TO RL-FS2R1-F-G-240. RL2054.2 +059300 WRITE RL-FS2R1-F-G-240 RL2054.2 +059400 INVALID KEY RL2054.2 +059500 ADD 000001 TO INV-KEY-COUNTER. RL2054.2 +059600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +059700 ADD 00001 TO WRK-RL-FS2-RECKEY. RL2054.2 +059800 SUBTRACT 00001 FROM WRK-DU-05V00-004. RL2054.2 +059900 IF XRECORD-NUMBER (2) LESS THAN RL-FS2-FILESIZE RL2054.2 +060000 GO TO REL-TEST-001-R2. RL2054.2 +060100 CLOSE RL-FS2. RL2054.2 +060200 REL-TEST-001-02. RL2054.2 +060300 MOVE "CREATE FILE RL-FS2" TO FEATURE. RL2054.2 +060400 MOVE 02 TO REC-CT. RL2054.2 +060500 IF EXCUT-COUNTER-06V00 NOT EQUAL TO RL-FS2-FILESIZE RL2054.2 +060600 PERFORM FAIL RL2054.2 +060700 MOVE RL-FS2-FILESIZE TO CORRECT-N RL2054.2 +060800 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N RL2054.2 +060900 MOVE "INCORRECT NUMBER OF WRITES" TO RE-MARK RL2054.2 +061000 PERFORM PRINT-DETAIL RL2054.2 +061100 GO TO REL-EXIT-001. RL2054.2 +061200* RL2054.2 +061300* 02 RL2054.2 +061400* RL2054.2 +061500 IF INV-KEY-COUNTER NOT EQUAL TO ZERO RL2054.2 +061600 PERFORM FAIL RL2054.2 +061700 MOVE INV-KEY-COUNTER TO COMPUTED-N RL2054.2 +061800 MOVE ZERO TO CORRECT-N RL2054.2 +061900 MOVE "INVALID KEY ON WRITE" TO RE-MARK RL2054.2 +062000 PERFORM PRINT-DETAIL RL2054.2 +062100 GO TO REL-EXIT-001. RL2054.2 +062200 PERFORM PASS. RL2054.2 +062300 PERFORM REL-WRITE-001. RL2054.2 +062400 GO TO REL-EXIT-001. RL2054.2 +062500 REL-WRITE-001. RL2054.2 +062600 PERFORM PRINT-DETAIL. RL2054.2 +062700 REL-DELETE-001. RL2054.2 +062800 PERFORM DE-LETE. RL2054.2 +062900 PERFORM PRINT-DETAIL. RL2054.2 +063000 REL-EXIT-001. RL2054.2 +063100 EXIT. RL2054.2 +063200 REL-INIT-002. RL2054.2 +063300 PERFORM BLANK-LINE-PRINT. RL2054.2 +063400 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS RL2054.2 +063500- "ACCESS MODE IS DYNAMIC." TO PRINT-REC. RL2054.2 +063600 PERFORM WRITE-LINE. RL2054.2 +063700 PERFORM BLANK-LINE-PRINT. RL2054.2 +063800 MOVE "READ NEXT" TO FEATURE. RL2054.2 +063900 MOVE ZERO TO REC-CT. RL2054.2 +064000 MOVE "REL-TEST-002" TO PAR-NAME. RL2054.2 +064100 REL-INIT-002-R1. RL2054.2 +064200 OPEN INPUT RL-FD1. RL2054.2 +064300 PERFORM REL-INIT-002-R. RL2054.2 +064400 REL-TEST-002-R1. RL2054.2 +064500 READ RL-FD1 NEXT. RL2054.2 +064600 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +064700 PERFORM REL-VERIFY-002 RL2054.2 +064800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +064900 GO TO REL-TEST-002-R1. RL2054.2 +065000 CLOSE RL-FD1. RL2054.2 +065100 REL-TEST-002-01. RL2054.2 +065200 MOVE 01 TO REC-CT. RL2054.2 +065300 PERFORM REL-TEST-002. RL2054.2 +065400 GO TO REL-EXIT-002-01. RL2054.2 +065500* RL2054.2 +065600* 01 RL2054.2 +065700* RL2054.2 +065800 REL-DELETE-002-01. RL2054.2 +065900 MOVE 01 TO REC-CT. RL2054.2 +066000 PERFORM DE-LETE. RL2054.2 +066100 PERFORM REL-WRITE-002. RL2054.2 +066200 REL-EXIT-002-01. RL2054.2 +066300 EXIT. RL2054.2 +066400 REL-INIT-002-R2. RL2054.2 +066500 PERFORM REL-INIT-002-R. RL2054.2 +066600 OPEN INPUT RL-FD1. RL2054.2 +066700 REL-TEST-002-R2. RL2054.2 +066800 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +066900 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +067000 READ RL-FD1 NEXT RECORD RL2054.2 +067100 INTO FILE-RECORD-INFO (9). RL2054.2 +067200 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +067300 PERFORM REL-VERIFY-002. RL2054.2 +067400 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +067500 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +067600 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +067700 GO TO REL-TEST-002-R2. RL2054.2 +067800 CLOSE RL-FD1. RL2054.2 +067900 REL-TEST-002-02. RL2054.2 +068000 MOVE 02 TO REC-CT. RL2054.2 +068100 PERFORM REL-TEST-002. RL2054.2 +068200* RL2054.2 +068300* 02 RL2054.2 +068400* RL2054.2 +068500 GO TO REL-EXIT-002-02. RL2054.2 +068600 REL-DELETE-002-02. RL2054.2 +068700 MOVE 02 TO REC-CT. RL2054.2 +068800 PERFORM DE-LETE. RL2054.2 +068900 PERFORM REL-WRITE-002. RL2054.2 +069000 REL-EXIT-002-02. RL2054.2 +069100 EXIT. RL2054.2 +069200 REL-INIT-002-R3. RL2054.2 +069300 OPEN INPUT RL-FD1. RL2054.2 +069400 PERFORM REL-INIT-002-R. RL2054.2 +069500 REL-TEST-002-R3. RL2054.2 +069600 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +069700 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +069800 READ RL-FD1 NEXT RL2054.2 +069900 INTO FILE-RECORD-INFO (9). RL2054.2 +070000 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +070100 PERFORM REL-VERIFY-002. RL2054.2 +070200 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +070300 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +070400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +070500 GO TO REL-TEST-002-R3. RL2054.2 +070600 CLOSE RL-FD1. RL2054.2 +070700 REL-TEST-002-03. RL2054.2 +070800 MOVE 03 TO REC-CT. RL2054.2 +070900 PERFORM REL-TEST-002. RL2054.2 +071000* RL2054.2 +071100* 03 RL2054.2 +071200* RL2054.2 +071300 GO TO REL-EXIT-002-03. RL2054.2 +071400 REL-DELETE-002-03. RL2054.2 +071500 MOVE 03 TO REC-CT. RL2054.2 +071600 PERFORM DE-LETE. RL2054.2 +071700 PERFORM REL-WRITE-002. RL2054.2 +071800 REL-EXIT-002-03. RL2054.2 +071900 EXIT. RL2054.2 +072000 REL-INIT-002-R4. RL2054.2 +072100 OPEN INPUT RL-FD1. RL2054.2 +072200 PERFORM REL-INIT-002-R. RL2054.2 +072300 MOVE RL-FD1-FILESIZE TO ERROR-COUNTER-06V00. RL2054.2 +072400 ADD 000001 TO ERROR-COUNTER-06V00. RL2054.2 +072500 REL-TEST-002-R4. RL2054.2 +072600 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +072700 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +072800 READ RL-FD1 NEXT INTO FILE-RECORD-INFO (9) AT END RL2054.2 +072900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00 RL2054.2 +073000 GO TO REL-TEST-002-04. RL2054.2 +073100 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +073200 PERFORM REL-VERIFY-002. RL2054.2 +073300 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +073400 ADD 00100 TO ERROR-COUNTER-06V00. RL2054.2 +073500 IF EXCUT-COUNTER-06V00 GREATER THAN RL-FD1-FILESIZE RL2054.2 +073600 NEXT SENTENCE RL2054.2 +073700 ELSE RL2054.2 +073800 GO TO REL-TEST-002-R4. RL2054.2 +073900* RL2054.2 +074000* TEST REL-002-04 TESTS THE COBOL CONSTRUCT "READ FILE- RL2054.2 +074100* NAME NEXT INTO IDENTIFIER AT END". THE TEST READS THE FILE RL2054.2 +074200* SEQUENTIALY VIA THE RELATIVE KEY (RECORD KEY IS THE KEY OF RL2054.2 +074300* REFERENCE) UNTIL AN END-OF-FILE CONDITION OCCURS. A CHECK RL2054.2 +074400* IS MADE TO VERIFY THAT THE PROPER RECORDS WERE RETRIVED AND RL2054.2 +074500* THE AT END PATH WAS TAKEN ON THE 301 ST READ. RL2054.2 +074600* RL2054.2 +074700 REL-TEST-002-04. RL2054.2 +074800 CLOSE RL-FD1. RL2054.2 +074900 MOVE 04 TO REC-CT. RL2054.2 +075000 PERFORM REL-TEST-002. RL2054.2 +075100* .04 RL2054.2 +075200 GO TO REL-EXIT-002-04. RL2054.2 +075300 REL-DELETE-002-04. RL2054.2 +075400 MOVE 04 TO REC-CT. RL2054.2 +075500 PERFORM DE-LETE. RL2054.2 +075600 PERFORM REL-WRITE-002. RL2054.2 +075700 REL-EXIT-002-04. RL2054.2 +075800 EXIT. RL2054.2 +075900 REL-INIT-002-R5. RL2054.2 +076000 OPEN INPUT RL-FD1. RL2054.2 +076100 PERFORM REL-INIT-002-R. RL2054.2 +076200 MOVE "READ" TO FEATURE. RL2054.2 +076300 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +076400 REL-TEST-002-R5. RL2054.2 +076500 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +076600 ADD 000004 TO LOGICAL-FILE-REC. RL2054.2 +076700 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +076800 READ RL-FD1. RL2054.2 +076900 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +077000 PERFORM REL-VERIFY-002. RL2054.2 +077100 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +077200 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +077300 GO TO REL-TEST-002-R5. RL2054.2 +077400 CLOSE RL-FD1. RL2054.2 +077500 REL-TEST-002-05. RL2054.2 +077600 MOVE 05 TO REC-CT. RL2054.2 +077700 PERFORM REL-TEST-002. RL2054.2 +077800* .05 RL2054.2 +077900 GO TO REL-EXIT-002-05. RL2054.2 +078000 REL-DELETE-002-05. RL2054.2 +078100 MOVE 05 TO REC-CT. RL2054.2 +078200 PERFORM DE-LETE. RL2054.2 +078300 PERFORM REL-WRITE-002. RL2054.2 +078400 REL-EXIT-002-05. RL2054.2 +078500 EXIT. RL2054.2 +078600 REL-INIT-002-R6. RL2054.2 +078700 OPEN INPUT RL-FD1. RL2054.2 +078800 PERFORM REL-INIT-002-R. RL2054.2 +078900 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +079000 REL-TEST-002-R6. RL2054.2 +079100 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +079200 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +079300 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +079400 ADD 000004 TO LOGICAL-FILE-REC. RL2054.2 +079500 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +079600 READ RL-FD1 INTO FILE-RECORD-INFO (9). RL2054.2 +079700 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +079800 PERFORM REL-VERIFY-002. RL2054.2 +079900 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-RECRL2054.2 +080000 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +080100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +080200 GO TO REL-TEST-002-R6. RL2054.2 +080300 CLOSE RL-FD1. RL2054.2 +080400 REL-TEST-002-06. RL2054.2 +080500 MOVE 06 TO REC-CT. RL2054.2 +080600 PERFORM REL-TEST-002. RL2054.2 +080700* .06 RL2054.2 +080800 GO TO REL-EXIT-002-06. RL2054.2 +080900 REL-DELETE-002-06. RL2054.2 +081000 MOVE 06 TO REC-CT. RL2054.2 +081100 PERFORM DE-LETE. RL2054.2 +081200 PERFORM REL-WRITE-002. RL2054.2 +081300 REL-EXIT-002-06. RL2054.2 +081400 EXIT. RL2054.2 +081500 REL-INIT-002-R7. RL2054.2 +081600 OPEN INPUT RL-FD1. RL2054.2 +081700 PERFORM REL-INIT-002-R. RL2054.2 +081800 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +081900 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +082000 REL-TEST-002-R7. RL2054.2 +082100 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +082200 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +082300 ADD 0004 TO LOGICAL-FILE-REC. RL2054.2 +082400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +082500 READ RL-FD1 RECORD. RL2054.2 +082600 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +082700 PERFORM REL-VERIFY-002. RL2054.2 +082800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +082900 GO TO REL-TEST-002-R7. RL2054.2 +083000 CLOSE RL-FD1. RL2054.2 +083100 REL-TEST-002-07. RL2054.2 +083200 MOVE 07 TO REC-CT. RL2054.2 +083300 PERFORM REL-TEST-002. RL2054.2 +083400* .07 RL2054.2 +083500 GO TO REL-EXIT-002-07. RL2054.2 +083600 REL-DELETE-002-07. RL2054.2 +083700 MOVE 07 TO REC-CT. RL2054.2 +083800 PERFORM DE-LETE. RL2054.2 +083900 PERFORM REL-WRITE-002. RL2054.2 +084000 REL-EXIT-002-07. RL2054.2 +084100 EXIT. RL2054.2 +084200 REL-INIT-002-R8. RL2054.2 +084300 OPEN INPUT RL-FD1. RL2054.2 +084400 PERFORM REL-INIT-002-R. RL2054.2 +084500 MOVE 00301 TO WRK-RL-FD1-RECKEY. RL2054.2 +084600 MOVE SPACE TO RL-FD1R1-F-G-240. RL2054.2 +084700 REL-TEST-002-R8. RL2054.2 +084800 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +084900 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +085000 READ RL-FD1 RECORD INVALID RL2054.2 +085100 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +085200 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +085300 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +085400 GO TO REL-TEST-002-R8. RL2054.2 +085500 CLOSE RL-FD1. RL2054.2 +085600 REL-TEST-002-08. RL2054.2 +085700 MOVE 08 TO REC-CT. RL2054.2 +085800 PERFORM REL-TEST-002. RL2054.2 +085900* .08 RL2054.2 +086000 GO TO REL-EXIT-002-08. RL2054.2 +086100 REL-DELETE-002-08. RL2054.2 +086200 MOVE 08 TO REC-CT. RL2054.2 +086300 PERFORM DE-LETE. RL2054.2 +086400 PERFORM REL-WRITE-002. RL2054.2 +086500 REL-EXIT-002-08. RL2054.2 +086600 EXIT. RL2054.2 +086700 REL-INIT-002-R9. RL2054.2 +086800 OPEN INPUT RL-FD1. RL2054.2 +086900 PERFORM REL-INIT-002-R. RL2054.2 +087000 MOVE 00301 TO WRK-RL-FD1-RECKEY. RL2054.2 +087100 MOVE SPACE TO RL-FD1R1-F-G-240. RL2054.2 +087200 REL-TEST-002-R9. RL2054.2 +087300 ADD 00004 TO WRK-RL-FD1-RECKEY. RL2054.2 +087400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +087500 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +087600 READ RL-FD1 RECORD INVALID KEY RL2054.2 +087700 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +087800 ADD 00001 TO EXCUT-COUNTER-06V00. RL2054.2 +087900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +088000 GO TO REL-TEST-002-R9. RL2054.2 +088100 CLOSE RL-FD1. RL2054.2 +088200 REL-TEST-002-09. RL2054.2 +088300 MOVE 09 TO REC-CT. RL2054.2 +088400 PERFORM REL-TEST-002. RL2054.2 +088500* .09 RL2054.2 +088600 GO TO REL-EXIT-002-09. RL2054.2 +088700 REL-DELETE-002-09. RL2054.2 +088800 MOVE 09 TO REC-CT. RL2054.2 +088900 PERFORM DE-LETE. RL2054.2 +089000 PERFORM REL-WRITE-002. RL2054.2 +089100 REL-EXIT-002-09. RL2054.2 +089200 GO TO REL-EXIT-002. RL2054.2 +089300 REL-INIT-002-R. RL2054.2 +089400 MOVE 00010 TO ERROR-COUNTER-06V00. RL2054.2 +089500 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +089600 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +089700 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +089800 REL-VERIFY-002. RL2054.2 +089900 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +090000 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +090100 IF XRECORD-NUMBER (1) EQUAL TO LOGICAL-FILE-REC RL2054.2 +090200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +090300 REL-TEST-002. RL2054.2 +090400 IF ERROR-COUNTER-06V00 EQUAL TO ZERO RL2054.2 +090500 PERFORM PASS RL2054.2 +090600 ELSE RL2054.2 +090700 PERFORM FAIL RL2054.2 +090800 MOVE ZERO TO CORRECT-N RL2054.2 +090900 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N RL2054.2 +091000 MOVE "SEE PARA. - REL-TEST-002" TO RE-MARK. RL2054.2 +091100 PERFORM REL-WRITE-002. RL2054.2 +091200* RL2054.2 +091300* EACH TEST IS EXECUTED 10 TIMES EXCEPT FOR REL-TEST-002-04RL2054.2 +091400* WHICH IS EXECUTED 300 TIMES. FOLLOWING THE LAST RL2054.2 +091500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS RL2054.2 +091600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO RL2054.2 +091700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED RL2054.2 +091800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED RL2054.2 +091900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 RL2054.2 +092000* IS INITIALIZED WITH A VALUE. EACH TIME THE CORRECT RECORD RL2054.2 +092100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY RL2054.2 +092200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR RL2054.2 +092300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. RL2054.2 +092400* FOR EACH EXECUTION THAT DID NOT PRODUCE THE EXPECTED RL2054.2 +092500* RESULTS THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE RL2054.2 +092600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATERL2054.2 +092700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO RL2054.2 +092800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED RL2054.2 +092900* AS A RESULT OF THE READ OR START WAS NOT-AS EXPECTED. RL2054.2 +093000* RL2054.2 +093100* RL2054.2 +093200* RL2054.2 +093300* COMPUTED RESULT INDICATED RL2054.2 +093400* INCREMENTS ACTION RL2054.2 +093500* RL2054.2 +093600* 000100 THE RECORD FOUND IN THE IDENTIFIER RL2054.2 +093700* SPECIFIED IN THE INTO PHRASE OF THE RL2054.2 +093800* READ STATEMENT WAS NOT THE RECORD RL2054.2 +093900* EXPECTED FOLLOWING EXECUTION OF THE RL2054.2 +094000* READ. RL2054.2 +094100* RL2054.2 +094200* 000001 THE RECORD RETREIVED FROM THE FILE RL2054.2 +094300* FOLLOWING THE READ WAS NOT THE ONE RL2054.2 +094400* EXPECTED. RL2054.2 +094500* RL2054.2 +094600* 010000 AN UNEXPECTED INVALID KEY OR AT END RL2054.2 +094700* CONDITION OCCURRED. NOTE - ASSUMPTION RL2054.2 +094800* IS THAT THE "USE" STATEMENT IS ONLY RL2054.2 +094900* EXECUTED WHEN AN INVALID KEY OR AT END RL2054.2 +095000* CONDITION OCCURS AND THE INVALID KEY OR RL2054.2 +095100* AT END PHRASE HAS NOT BEEN SPECIFIED. RL2054.2 +095200* RL2054.2 +095300 REL-WRITE-002. RL2054.2 +095400 PERFORM PRINT-DETAIL. RL2054.2 +095500 REL-EXIT-002. RL2054.2 +095600 EXIT. RL2054.2 +095700 REL-INIT-003. RL2054.2 +095800 OPEN INPUT RL-FD1. RL2054.2 +095900 OPEN INPUT RL-FS2. RL2054.2 +096000 PERFORM BLANK-LINE-PRINT. RL2054.2 +096100 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINE AS RL2054.2 +096200- "ACCESS MODE IS SEQUENTIAL" TO PRINT-REC. RL2054.2 +096300 PERFORM WRITE-LINE. RL2054.2 +096400 PERFORM BLANK-LINE-PRINT. RL2054.2 +096500 MOVE "START EQUAL TO" TO FEATURE. RL2054.2 +096600 MOVE "REL-TEST-003" TO PAR-NAME. RL2054.2 +096700 MOVE ZERO TO REC-CT. RL2054.2 +096800 PERFORM REL-INIT-003-R. RL2054.2 +096900 REL-TEST-003-R1. RL2054.2 +097000 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +097100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +097200 START RL-FS2. RL2054.2 +097300 READ RL-FS2 RECORD AT END RL2054.2 +097400 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +097500 GO TO REL-TEST-003-01. RL2054.2 +097600 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +097700 PERFORM REL-VERIFY-003A. RL2054.2 +097800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +097900 GO TO REL-TEST-003-R1. RL2054.2 +098000 REL-TEST-003-01. RL2054.2 +098100 MOVE 01 TO REC-CT. RL2054.2 +098200 PERFORM REL-TEST-003. RL2054.2 +098300* .01 RL2054.2 +098400 GO TO REL-EXIT-003-01. RL2054.2 +098500 REL-DELETE-003-01. RL2054.2 +098600 PERFORM DE-LETE. RL2054.2 +098700 PERFORM REL-WRITE-003. RL2054.2 +098800 REL-EXIT-003-01. RL2054.2 +098900 EXIT. RL2054.2 +099000 REL-INIT-003-R2. RL2054.2 +099100 PERFORM REL-INIT-003-R. RL2054.2 +099200 REL-TEST-003-R2. RL2054.2 +099300 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +099400 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +099500 START RL-FS2 KEY EQUAL TO RL-FS2-KEY. RL2054.2 +099600 READ RL-FS2 RECORD AT END RL2054.2 +099700 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +099800 GO TO REL-TEST-003-02. RL2054.2 +099900 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +100000 PERFORM REL-VERIFY-003A. RL2054.2 +100100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +100200 GO TO REL-TEST-003-R2. RL2054.2 +100300 REL-TEST-003-02. RL2054.2 +100400 MOVE 02 TO REC-CT. RL2054.2 +100500 PERFORM REL-TEST-003. RL2054.2 +100600* .02 RL2054.2 +100700 GO TO REL-EXIT-003-02. RL2054.2 +100800 REL-DELETE-003-02. RL2054.2 +100900 MOVE 02 TO REC-CT. RL2054.2 +101000 PERFORM DE-LETE. RL2054.2 +101100 PERFORM REL-WRITE-003. RL2054.2 +101200 REL-EXIT-003-02. RL2054.2 +101300 EXIT. RL2054.2 +101400 REL-INIT-003-R3. RL2054.2 +101500 PERFORM REL-INIT-003-R. RL2054.2 +101600 REL-TEST-003-R3. RL2054.2 +101700 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +101800 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +101900 START RL-FS2 KEY IS EQUAL TO RL-FS2-KEY. RL2054.2 +102000 READ RL-FS2 RECORD AT END RL2054.2 +102100 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +102200 GO TO REL-TEST-003-03. RL2054.2 +102300 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +102400 PERFORM REL-VERIFY-003A. RL2054.2 +102500 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +102600 GO TO REL-TEST-003-R3. RL2054.2 +102700 REL-TEST-003-03. RL2054.2 +102800 MOVE 03 TO REC-CT. RL2054.2 +102900 PERFORM REL-TEST-003. RL2054.2 +103000* .03 RL2054.2 +103100 GO TO REL-EXIT-003-03. RL2054.2 +103200 REL-DELETE-003-03. RL2054.2 +103300 MOVE 03 TO REC-CT. RL2054.2 +103400 PERFORM DE-LETE. RL2054.2 +103500 PERFORM REL-WRITE-003. RL2054.2 +103600 REL-EXIT-003-03. RL2054.2 +103700 EXIT. RL2054.2 +103800 REL-INIT-003-R4. RL2054.2 +103900 PERFORM REL-INIT-003-R. RL2054.2 +104000 REL-TEST-003-R4. RL2054.2 +104100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +104200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +104300 START RL-FS2 KEY IS EQUAL RL-FS2-KEY. RL2054.2 +104400 READ RL-FS2 RECORD AT END RL2054.2 +104500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +104600 GO TO REL-TEST-003-04. RL2054.2 +104700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +104800 PERFORM REL-VERIFY-003A. RL2054.2 +104900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +105000 GO TO REL-TEST-003-R4. RL2054.2 +105100 REL-TEST-003-04. RL2054.2 +105200 MOVE 04 TO REC-CT. RL2054.2 +105300 PERFORM REL-TEST-003. RL2054.2 +105400* .04 RL2054.2 +105500 GO TO REL-EXIT-003-04. RL2054.2 +105600 REL-DELETE-003-04. RL2054.2 +105700 MOVE 04 TO REC-CT. RL2054.2 +105800 PERFORM DE-LETE. RL2054.2 +105900 PERFORM REL-WRITE-003. RL2054.2 +106000 REL-EXIT-003-04. RL2054.2 +106100 EXIT. RL2054.2 +106200 REL-INIT-003-R5. RL2054.2 +106300 PERFORM REL-INIT-003-R. RL2054.2 +106400 REL-TEST-003-R5. RL2054.2 +106500 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +106600 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +106700 START RL-FS2 KEY IS = RL-FS2-KEY. RL2054.2 +106800 READ RL-FS2 RECORD AT END RL2054.2 +106900 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +107000 GO TO REL-TEST-003-05. RL2054.2 +107100 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +107200 PERFORM REL-VERIFY-003A. RL2054.2 +107300 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +107400 GO TO REL-TEST-003-R5. RL2054.2 +107500 REL-TEST-003-05. RL2054.2 +107600 MOVE 05 TO REC-CT. RL2054.2 +107700 PERFORM REL-TEST-003. RL2054.2 +107800* .05 RL2054.2 +107900 GO TO REL-EXIT-003-05. RL2054.2 +108000 REL-DELETE-003-05. RL2054.2 +108100 MOVE 05 TO REC-CT. RL2054.2 +108200 PERFORM DE-LETE. RL2054.2 +108300 PERFORM REL-WRITE-003. RL2054.2 +108400 REL-EXIT-003-05. RL2054.2 +108500 EXIT. RL2054.2 +108600 REL-INIT-003-R6. RL2054.2 +108700 PERFORM REL-INIT-003-R. RL2054.2 +108800 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +108900 MOVE "START GREATER THAN" TO FEATURE. RL2054.2 +109000 REL-TEST-003-R6. RL2054.2 +109100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +109200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +109300 START RL-FS2 KEY IS GREATER THAN RL-FS2-KEY. RL2054.2 +109400 READ RL-FS2 RECORD AT END RL2054.2 +109500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +109600 GO TO REL-TEST-003-06. RL2054.2 +109700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +109800 PERFORM REL-VERIFY-003A. RL2054.2 +109900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +110000 GO TO REL-TEST-003-R6. RL2054.2 +110100 REL-TEST-003-06. RL2054.2 +110200 MOVE 06 TO REC-CT. RL2054.2 +110300 PERFORM REL-TEST-003. RL2054.2 +110400* .06 RL2054.2 +110500 GO TO REL-EXIT-003-06. RL2054.2 +110600 REL-DELETE-003-06. RL2054.2 +110700 MOVE 06 TO REC-CT. RL2054.2 +110800 PERFORM DE-LETE. RL2054.2 +110900 PERFORM REL-WRITE-003. RL2054.2 +111000 REL-EXIT-003-06. RL2054.2 +111100 EXIT. RL2054.2 +111200 REL-INIT-003-R7. RL2054.2 +111300 PERFORM REL-INIT-003-R. RL2054.2 +111400 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +111500 REL-TEST-003-R7. RL2054.2 +111600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +111700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +111800 START RL-FS2 KEY GREATER THAN RL-FS2-KEY. RL2054.2 +111900 READ RL-FS2 RECORD AT END RL2054.2 +112000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +112100 GO TO REL-TEST-003-07. RL2054.2 +112200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +112300 PERFORM REL-VERIFY-003A. RL2054.2 +112400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +112500 GO TO REL-TEST-003-R7. RL2054.2 +112600 REL-TEST-003-07. RL2054.2 +112700 MOVE 07 TO REC-CT. RL2054.2 +112800 PERFORM REL-TEST-003. RL2054.2 +112900* .07 RL2054.2 +113000 GO TO REL-EXIT-003-07. RL2054.2 +113100 REL-DELETE-003-07. RL2054.2 +113200 MOVE 07 TO REC-CT. RL2054.2 +113300 PERFORM DE-LETE. RL2054.2 +113400 PERFORM REL-WRITE-003. RL2054.2 +113500 REL-EXIT-003-07. RL2054.2 +113600 EXIT. RL2054.2 +113700 REL-INIT-003-R8. RL2054.2 +113800 PERFORM REL-INIT-003-R. RL2054.2 +113900 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +114000 REL-TEST-003-R8. RL2054.2 +114100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +114200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +114300 START RL-FS2 KEY IS GREATER RL-FS2-KEY. RL2054.2 +114400 READ RL-FS2 RECORD AT END RL2054.2 +114500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +114600 GO TO REL-TEST-003-08. RL2054.2 +114700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +114800 PERFORM REL-VERIFY-003A. RL2054.2 +114900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +115000 GO TO REL-TEST-003-R8. RL2054.2 +115100 REL-TEST-003-08. RL2054.2 +115200 MOVE 08 TO REC-CT. RL2054.2 +115300 PERFORM REL-TEST-003. RL2054.2 +115400* .08 RL2054.2 +115500 GO TO REL-EXIT-003-08. RL2054.2 +115600 REL-DELETE-003-08. RL2054.2 +115700 MOVE 08 TO REC-CT. RL2054.2 +115800 PERFORM DE-LETE. RL2054.2 +115900 PERFORM REL-WRITE-003. RL2054.2 +116000 REL-EXIT-003-08. RL2054.2 +116100 EXIT. RL2054.2 +116200 REL-INIT-003-R9. RL2054.2 +116300 PERFORM REL-INIT-003-R. RL2054.2 +116400 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +116500 REL-TEST-003-R9. RL2054.2 +116600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +116700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +116800 START RL-FS2 KEY IS > RL-FS2-KEY. RL2054.2 +116900 READ RL-FS2 RECORD AT END RL2054.2 +117000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +117100 GO TO REL-TEST-003-09. RL2054.2 +117200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +117300 PERFORM REL-VERIFY-003A. RL2054.2 +117400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +117500 GO TO REL-TEST-003-R9. RL2054.2 +117600 REL-TEST-003-09. RL2054.2 +117700 MOVE 09 TO REC-CT. RL2054.2 +117800 PERFORM REL-TEST-003. RL2054.2 +117900* .09 RL2054.2 +118000 GO TO REL-EXIT-003-09. RL2054.2 +118100 REL-DELETE-003-09. RL2054.2 +118200 MOVE 09 TO REC-CT. RL2054.2 +118300 PERFORM DE-LETE. RL2054.2 +118400 PERFORM REL-WRITE-003. RL2054.2 +118500 REL-EXIT-003-09. RL2054.2 +118600 EXIT. RL2054.2 +118700 REL-INIT-003-R10. RL2054.2 +118800 PERFORM REL-INIT-003-R. RL2054.2 +118900 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +119000 REL-TEST-003-R10. RL2054.2 +119100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +119200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +119300 START RL-FS2 KEY > RL-FS2-KEY. RL2054.2 +119400 READ RL-FS2 RECORD AT END RL2054.2 +119500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +119600 GO TO REL-TEST-003-10. RL2054.2 +119700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +119800 PERFORM REL-VERIFY-003A. RL2054.2 +119900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +120000 GO TO REL-TEST-003-R10. RL2054.2 +120100 REL-TEST-003-10. RL2054.2 +120200 MOVE 10 TO REC-CT. RL2054.2 +120300 PERFORM REL-TEST-003. RL2054.2 +120400* .10 RL2054.2 +120500 GO TO REL-EXIT-003-10. RL2054.2 +120600 REL-DELETE-003-10. RL2054.2 +120700 MOVE 10 TO REC-CT. RL2054.2 +120800 PERFORM DE-LETE. RL2054.2 +120900 PERFORM REL-WRITE-003. RL2054.2 +121000 REL-EXIT-003-10. RL2054.2 +121100 EXIT. RL2054.2 +121200 REL-INIT-003-R11. RL2054.2 +121300 MOVE "START NOT LESS THAN" TO FEATURE. RL2054.2 +121400 PERFORM REL-INIT-003-R. RL2054.2 +121500 REL-TEST-003-R11. RL2054.2 +121600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +121700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +121800 START RL-FS2 KEY IS NOT LESS THAN RL-FS2-KEY. RL2054.2 +121900 READ RL-FS2 RECORD AT END RL2054.2 +122000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +122100 GO TO REL-TEST-003-11. RL2054.2 +122200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +122300 PERFORM REL-VERIFY-003A. RL2054.2 +122400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +122500 GO TO REL-TEST-003-R11. RL2054.2 +122600 REL-TEST-003-11. RL2054.2 +122700 MOVE 11 TO REC-CT. RL2054.2 +122800 PERFORM REL-TEST-003. RL2054.2 +122900* .11 RL2054.2 +123000 GO TO REL-EXIT-003-11. RL2054.2 +123100 REL-DELETE-003-11. RL2054.2 +123200 MOVE 11 TO REC-CT. RL2054.2 +123300 PERFORM DE-LETE. RL2054.2 +123400 PERFORM REL-WRITE-003. RL2054.2 +123500 REL-EXIT-003-11. RL2054.2 +123600 EXIT. RL2054.2 +123700 REL-INIT-003-R12. RL2054.2 +123800 PERFORM REL-INIT-003-R. RL2054.2 +123900 REL-TEST-003-R12. RL2054.2 +124000 ADD 0003 TO WRK-RL-FS2-RECKEY. RL2054.2 +124100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +124200 START RL-FS2 KEY IS NOT LESS RL-FS2-KEY. RL2054.2 +124300 READ RL-FS2 RECORD AT END RL2054.2 +124400 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +124500 GO TO REL-TEST-003-12. RL2054.2 +124600 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +124700 PERFORM REL-VERIFY-003A. RL2054.2 +124800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +124900 GO TO REL-TEST-003-R12. RL2054.2 +125000 REL-TEST-003-12. RL2054.2 +125100 MOVE 12 TO REC-CT. RL2054.2 +125200 PERFORM REL-TEST-003. RL2054.2 +125300* .12 RL2054.2 +125400 GO TO REL-EXIT-003-12. RL2054.2 +125500 REL-DELETE-003-12. RL2054.2 +125600 MOVE 12 TO REC-CT. RL2054.2 +125700 PERFORM DE-LETE. RL2054.2 +125800 PERFORM REL-WRITE-003. RL2054.2 +125900 REL-EXIT-003-12. RL2054.2 +126000 EXIT. RL2054.2 +126100 REL-INIT-003-R13. RL2054.2 +126200 PERFORM REL-INIT-003-R. RL2054.2 +126300 REL-TEST-003-R13. RL2054.2 +126400 ADD 003 TO WRK-RL-FS2-RECKEY. RL2054.2 +126500 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +126600 START RL-FS2 KEY NOT LESS THAN RL-FS2-KEY. RL2054.2 +126700 READ RL-FS2 RECORD AT END RL2054.2 +126800 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +126900 GO TO REL-TEST-003-13. RL2054.2 +127000 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +127100 PERFORM REL-VERIFY-003A. RL2054.2 +127200 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +127300 GO TO REL-TEST-003-R13. RL2054.2 +127400 REL-TEST-003-13. RL2054.2 +127500 MOVE 13 TO REC-CT. RL2054.2 +127600 PERFORM REL-TEST-003. RL2054.2 +127700* .13 RL2054.2 +127800 GO TO REL-EXIT-003-13. RL2054.2 +127900 REL-DELETE-003-13. RL2054.2 +128000 MOVE 13 TO REC-CT. RL2054.2 +128100 PERFORM DE-LETE. RL2054.2 +128200 PERFORM REL-WRITE-003. RL2054.2 +128300 REL-EXIT-003-13. RL2054.2 +128400 EXIT. RL2054.2 +128500 REL-INIT-003-R14. RL2054.2 +128600 PERFORM REL-INIT-003-R. RL2054.2 +128700 REL-TEST-003-R14. RL2054.2 +128800 ADD 003 TO WRK-RL-FS2-RECKEY. RL2054.2 +128900 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +129000 START RL-FS2 KEY IS NOT < RL-FS2-KEY. RL2054.2 +129100 READ RL-FS2 RECORD AT END RL2054.2 +129200 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +129300 GO TO REL-TEST-003-14. RL2054.2 +129400 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +129500 PERFORM REL-VERIFY-003A. RL2054.2 +129600 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +129700 GO TO REL-TEST-003-R14. RL2054.2 +129800 REL-TEST-003-14. RL2054.2 +129900 MOVE 14 TO REC-CT. RL2054.2 +130000 PERFORM REL-TEST-003. RL2054.2 +130100* .14 RL2054.2 +130200 GO TO REL-EXIT-003-14. RL2054.2 +130300 REL-DELETE-003-14. RL2054.2 +130400 MOVE 14 TO REC-CT. RL2054.2 +130500 PERFORM DE-LETE. RL2054.2 +130600 PERFORM REL-WRITE-003. RL2054.2 +130700 REL-EXIT-003-14. RL2054.2 +130800 EXIT. RL2054.2 +130900 REL-INIT-003-R15. RL2054.2 +131000 PERFORM BLANK-LINE-PRINT. RL2054.2 +131100 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS RL2054.2 +131200- "ACCESS MODE IS DYNAMIC" TO PRINT-REC. RL2054.2 +131300 PERFORM WRITE-LINE. RL2054.2 +131400 PERFORM BLANK-LINE-PRINT. RL2054.2 +131500 MOVE "START EQUAL TO " TO FEATURE. RL2054.2 +131600 PERFORM REL-INIT-003-R. RL2054.2 +131700 REL-TEST-003-R15. RL2054.2 +131800 ADD 0002 TO WRK-RL-FD1-RECKEY. RL2054.2 +131900 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +132000 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY INVALID KEY RL2054.2 +132100 ADD 010000 TO ERROR-COUNTER-06V00. RL2054.2 +132200 READ RL-FD1 NEXT RECORD AT END RL2054.2 +132300 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +132400 GO TO REL-TEST-003-15. RL2054.2 +132500 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +132600 PERFORM REL-VERIFY-003B. RL2054.2 +132700 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +132800 GO TO REL-TEST-003-R15. RL2054.2 +132900 REL-TEST-003-15. RL2054.2 +133000 MOVE 15 TO REC-CT. RL2054.2 +133100 PERFORM REL-TEST-003. RL2054.2 +133200* .15 RL2054.2 +133300 GO TO REL-EXIT-003-15. RL2054.2 +133400 REL-DELETE-003-15. RL2054.2 +133500 MOVE 15 TO REC-CT. RL2054.2 +133600 PERFORM DE-LETE. RL2054.2 +133700 PERFORM REL-WRITE-003. RL2054.2 +133800 REL-EXIT-003-15. RL2054.2 +133900 EXIT. RL2054.2 +134000 REL-INIT-003-R16. RL2054.2 +134100 MOVE "START INVALID KEY" TO FEATURE. RL2054.2 +134200 PERFORM REL-INIT-003-R. RL2054.2 +134300 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +134400 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +134500 REL-TEST-003-R16. RL2054.2 +134600 ADD 0002 TO WRK-RL-FD1-RECKEY. RL2054.2 +134700 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +134800 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY INVALID RL2054.2 +134900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +135000 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +135100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +135200 GO TO REL-TEST-003-R16. RL2054.2 +135300 REL-TEST-003-16. RL2054.2 +135400 MOVE 16 TO REC-CT. RL2054.2 +135500 PERFORM REL-TEST-003. RL2054.2 +135600* .16 RL2054.2 +135700 GO TO REL-EXIT-003-16. RL2054.2 +135800 REL-DELETE-003-16. RL2054.2 +135900 MOVE 16 TO REC-CT. RL2054.2 +136000 PERFORM DE-LETE. RL2054.2 +136100 PERFORM REL-WRITE-003. RL2054.2 +136200 REL-EXIT-003-16. RL2054.2 +136300 EXIT. RL2054.2 +136400 REL-INIT-003-R17. RL2054.2 +136500 PERFORM REL-INIT-003-R. RL2054.2 +136600 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +136700 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +136800 REL-TEST-003-R17. RL2054.2 +136900 ADD 00003 TO WRK-RL-FD1-RECKEY. RL2054.2 +137000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +137100 START RL-FD1 INVALID KEY RL2054.2 +137200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +137300 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +137400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +137500 GO TO REL-TEST-003-R17. RL2054.2 +137600 REL-TEST-003-17. RL2054.2 +137700 MOVE 17 TO REC-CT. RL2054.2 +137800 PERFORM REL-TEST-003. RL2054.2 +137900* .17 RL2054.2 +138000 GO TO REL-EXIT-003-17. RL2054.2 +138100 REL-DELETE-003-17. RL2054.2 +138200 MOVE 17 TO REC-CT. RL2054.2 +138300 PERFORM DE-LETE. RL2054.2 +138400 PERFORM REL-WRITE-003. RL2054.2 +138500 REL-EXIT-003-17. RL2054.2 +138600 EXIT. RL2054.2 +138700 REL-INIT-003-R18. RL2054.2 +138800 PERFORM REL-INIT-003-R. RL2054.2 +138900 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +139000 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +139100 REL-TEST-003-R18. RL2054.2 +139200 ADD 00003 TO WRK-RL-FD1-RECKEY. RL2054.2 +139300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +139400 START RL-FD1 ; INVALID KEY RL2054.2 +139500 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +139600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +139700 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +139800 GO TO REL-TEST-003-R18. RL2054.2 +139900 REL-TEST-003-18. RL2054.2 +140000 MOVE 18 TO REC-CT. RL2054.2 +140100 PERFORM REL-TEST-003. RL2054.2 +140200* .18 RL2054.2 +140300 GO TO REL-EXIT-003-18. RL2054.2 +140400 REL-DELETE-003-18. RL2054.2 +140500 MOVE 18 TO REC-CT. RL2054.2 +140600 PERFORM DE-LETE. RL2054.2 +140700 PERFORM REL-WRITE-003. RL2054.2 +140800 REL-EXIT-003-18. RL2054.2 +140900 EXIT. RL2054.2 +141000 REL-INIT-003-R19. RL2054.2 +141100 PERFORM REL-INIT-003-R. RL2054.2 +141200 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +141300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +141400 REL-TEST-003-R19. RL2054.2 +141500 ADD 000002 TO WRK-RL-FD1-RECKEY. RL2054.2 +141600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +141700 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY ; INVALID KEY RL2054.2 +141800 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +141900 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +142000 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +142100 GO TO REL-TEST-003-R19. RL2054.2 +142200 REL-TEST-003-19. RL2054.2 +142300 MOVE 19 TO REC-CT. RL2054.2 +142400 PERFORM REL-TEST-003. RL2054.2 +142500* .19 RL2054.2 +142600 GO TO REL-END-003. RL2054.2 +142700 REL-DELETE-003-19. RL2054.2 +142800 MOVE 19 TO REC-CT. RL2054.2 +142900 PERFORM DE-LETE. RL2054.2 +143000 PERFORM REL-WRITE-003. RL2054.2 +143100 REL-EXIT-003-19. RL2054.2 +143200 EXIT. RL2054.2 +143300 REL-INIT-003-R. RL2054.2 +143400 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +143500 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +143600 MOVE 00055 TO WRK-DU-05V00-002. RL2054.2 +143700 MOVE 00050 TO WRK-DU-05V00-004. RL2054.2 +143800 MOVE ZERO TO WRK-RL-FS2-RECKEY. RL2054.2 +143900 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +144000 MOVE 10 TO ERROR-COUNTER-06V00. RL2054.2 +144100 REL-VERIFY-003A. RL2054.2 +144200 IF ASCEND RL2054.2 +144300 ADD 000003 TO LOGICAL-FILE-REC RL2054.2 +144400 ELSE RL2054.2 +144500 SUBTRACT 000003 FROM LOGICAL-FILE-REC. RL2054.2 +144600 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (2) RL2054.2 +144700 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +144800 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +144900 REL-VERIFY-003B. RL2054.2 +145000 IF ASCEND RL2054.2 +145100 ADD 000002 TO LOGICAL-FILE-REC RL2054.2 +145200 ELSE RL2054.2 +145300 SUBTRACT 000002 FROM LOGICAL-FILE-REC. RL2054.2 +145400 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (1) RL2054.2 +145500 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +145600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +145700 REL-TEST-003. RL2054.2 +145800 IF EXCUT-COUNTER-06V00 NOT EQUAL TO 000010 RL2054.2 +145900 MULTIPLY 100 BY EXCUT-COUNTER-06V00 RL2054.2 +146000 ADD EXCUT-COUNTER-06V00 TO ERROR-COUNTER-06V00. RL2054.2 +146100 IF ERROR-COUNTER-06V00 EQUAL TO ZERO RL2054.2 +146200 PERFORM PASS RL2054.2 +146300 ELSE RL2054.2 +146400 PERFORM FAIL RL2054.2 +146500 MOVE ZERO TO CORRECT-N RL2054.2 +146600 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N RL2054.2 +146700 MOVE "SEE PARA. - REL-TEST-003" TO RE-MARK. RL2054.2 +146800 PERFORM REL-WRITE-003. RL2054.2 +146900* RL2054.2 +147000* EACH TEST IS EXECUTED 10 TIMES. FOLLOWING THE 10TH RL2054.2 +147100* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS RL2054.2 +147200* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO RL2054.2 +147300* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED RL2054.2 +147400* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED RL2054.2 +147500* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 RL2054.2 +147600* IS LOADED WITH THE VALUE 10. EACH TIME THE CORRECT RECORD RL2054.2 +147700* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY RL2054.2 +147800* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR RL2054.2 +147900* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. RL2054.2 +148000* FOR EACH ACTION THAT DID NOT OCCUR AS RL2054.2 +148100* EXPECTED THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE RL2054.2 +148200* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATERL2054.2 +148300* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO RL2054.2 +148400* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED RL2054.2 +148500* AS A RESULT OF THE READ OR START WAS NOT AS EXPECTED. RL2054.2 +148600* RL2054.2 +148700* COMPUTED RESULT INDICATED RL2054.2 +148800* INCREMENTS ACTION RL2054.2 +148900* RL2054.2 +149000* 000001 THE RECORD RETREIVED FROM THE FILE RL2054.2 +149100* FOLLOWING THE READ WAS NOT THE ONE RL2054.2 +149200* EXPECTED. RL2054.2 +149300* RL2054.2 +149400* 000100 INDICATES,BY 10"S THE NUMBER OF TIMES THE RL2054.2 +149500* TEST WAS EXECUTED. RL2054.2 +149600* RL2054.2 +149700* 010000 AN UNEXPECTED INVALID KEY OR AT END RL2054.2 +149800* CONDITION OCCURRED. NOTE - ASSUMPTION RL2054.2 +149900* IS THAT THE "USE" STATEMENT IS ONLY RL2054.2 +150000* EXECUTED WHEN AN INVALID KEY OR AT END RL2054.2 +150100* CONDITION OCCURS AND THE INVALID KEY OR RL2054.2 +150200* AT END PHRASE HAS NOT BEEN SPECIFIED. RL2054.2 +150300* RL2054.2 +150400 REL-WRITE-003. RL2054.2 +150500 PERFORM PRINT-DETAIL. RL2054.2 +150600 REL-END-003. RL2054.2 +150700 CLOSE RL-FD1. RL2054.2 +150800 CLOSE RL-FS2. RL2054.2 +150900 REL-EXIT-003. RL2054.2 +151000 EXIT. RL2054.2 +151100* RL2054.2 +151200* THE FOLLOWING SECTION CONTAINS ALL THE NEW TESTS FOR 8X: RL2054.2 +151300* RL2054.2 +151400 NEW-COBOL-8X-TESTS SECTION. RL2054.2 +151500*========================== RL2054.2 +151600 REL-8X-INIT-1. RL2054.2 +151700 MOVE "XVII-70 2.2.37" TO ANSI-REFERENCE. RL2054.2 +151800 MOVE "REL-8X-TEST-1" TO PAR-NAME. RL2054.2 +151900 OPEN I-O RL-FD1. RL2054.2 +152000* DELETE THE NEXT LINE TO DELETE THE TEST RL2054.2 +152100* GO TO REL-8X-INIT-1-BETA. RL2054.2 +152200 REL-8X-INIT-1-ALPHA. RL2054.2 +152300 GO TO REL-8X-DELETE-1. RL2054.2 +152400 REL-8X-INIT-1-BETA. RL2054.2 +152500 MOVE LOW-VALUES TO WRK-RL-FD1-RECKEY-CHAR. RL2054.2 +152600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +152700 MOVE 301 TO RECORDS-IN-FILE (1). RL2054.2 +152800 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +152900 WRITE RL-FD1R1-F-G-240 RL2054.2 +153000 INVALID KEY RL2054.2 +153100 MOVE "INVALID KEY ON WRITING NEW 1ST RECORD" RL2054.2 +153200 TO RE-MARK RL2054.2 +153300 PERFORM FAIL RL2054.2 +153400 PERFORM PRINT-DETAIL RL2054.2 +153500 GO TO REL-8X-INIT-2. RL2054.2 +153600 MOVE 302 TO RECORDS-IN-FILE (1). RL2054.2 +153700 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +153800 MOVE ZERO TO RL-FD1-KEY. RL2054.2 +153900 WRITE RL-FD1R1-F-G-240 RL2054.2 +154000 INVALID KEY RL2054.2 +154100 MOVE "INVALID KEY ON WRITING NEW 2ND RECORD" RL2054.2 +154200 TO RE-MARK RL2054.2 +154300 PERFORM FAIL RL2054.2 +154400 PERFORM PRINT-DETAIL RL2054.2 +154500 GO TO REL-8X-INIT-2. RL2054.2 +154600 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +154700 GO TO REL-8X-TEST-1-0. RL2054.2 +154800 REL-8X-DELETE-1. RL2054.2 +154900 PERFORM DE-LETE. RL2054.2 +155000 PERFORM PRINT-DETAIL. RL2054.2 +155100 GO TO REL-8X-INIT-2. RL2054.2 +155200 REL-8X-TEST-1-0. RL2054.2 +155300 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +155400 REL-8X-TEST-1-1. RL2054.2 +155500 IF RECORDS-IN-FILE (1) = 301 RL2054.2 +155600 PERFORM PASS RL2054.2 +155700 GO TO REL-8X-WRITE-1. RL2054.2 +155800 MOVE "FIRST RECORD JUST INSERTED NOT FOUND" TO RE-MARK. RL2054.2 +155900 PERFORM FAIL. RL2054.2 +156000 REL-8X-WRITE-1. RL2054.2 +156100 PERFORM PRINT-DETAIL. RL2054.2 +156200* RL2054.2 +156300 REL-8X-INIT-2. RL2054.2 +156400 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +156500 MOVE "REL-8X-TEST-2" TO PAR-NAME. RL2054.2 +156600 OPEN I-O RL-FS2. RL2054.2 +156700 MOVE 123 TO WRK-RL-FS2-RECKEY. RL2054.2 +156800 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +156900 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +157000 GO TO REL-8X-TEST-2-0. RL2054.2 +157100 REL-8X-DELETE-2. RL2054.2 +157200 PERFORM DE-LETE. RL2054.2 +157300 PERFORM PRINT-DETAIL. RL2054.2 +157400 GO TO REL-8X-INIT-3. RL2054.2 +157500 REL-8X-TEST-2-0. RL2054.2 +157600 START RL-FS2 RL2054.2 +157700 KEY IS GREATER THAN OR EQUAL TO RL-FS2-KEY. RL2054.2 +157800 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +157900 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +158000 PERFORM FAIL RL2054.2 +158100 PERFORM PRINT-DETAIL RL2054.2 +158200 GO TO REL-8X-INIT-3. RL2054.2 +158300 REL-8X-TEST-2-1. RL2054.2 +158400 IF XRECORD-NUMBER (1) < 123 RL2054.2 +158500 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +158600 TO RE-MARK RL2054.2 +158700 MOVE 123 TO CORRECT-N RL2054.2 +158800 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +158900 PERFORM FAIL RL2054.2 +159000 PERFORM PRINT-DETAIL RL2054.2 +159100 ELSE RL2054.2 +159200 PERFORM PASS RL2054.2 +159300 PERFORM PRINT-DETAIL. RL2054.2 +159400* RL2054.2 +159500 REL-8X-INIT-3. RL2054.2 +159600 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +159700 MOVE "REL-8X-TEST-3" TO PAR-NAME. RL2054.2 +159800 MOVE 154 TO WRK-RL-FS2-RECKEY. RL2054.2 +159900 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +160000 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +160100 GO TO REL-8X-TEST-3-0. RL2054.2 +160200 REL-8X-DELETE-3. RL2054.2 +160300 PERFORM DE-LETE. RL2054.2 +160400 PERFORM PRINT-DETAIL. RL2054.2 +160500 GO TO REL-8X-INIT-4. RL2054.2 +160600 REL-8X-TEST-3-0. RL2054.2 +160700 START RL-FS2 RL2054.2 +160800 KEY GREATER OR EQUAL TO RL-FS2-KEY. RL2054.2 +160900 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +161000 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +161100 PERFORM FAIL RL2054.2 +161200 PERFORM PRINT-DETAIL RL2054.2 +161300 GO TO REL-8X-INIT-4. RL2054.2 +161400 REL-8X-TEST-3-1. RL2054.2 +161500 IF XRECORD-NUMBER (1) < 154 RL2054.2 +161600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +161700 TO RE-MARK RL2054.2 +161800 MOVE 154 TO CORRECT-N RL2054.2 +161900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +162000 PERFORM FAIL RL2054.2 +162100 PERFORM PRINT-DETAIL RL2054.2 +162200 ELSE RL2054.2 +162300 PERFORM PASS RL2054.2 +162400 PERFORM PRINT-DETAIL. RL2054.2 +162500* RL2054.2 +162600 REL-8X-INIT-4. RL2054.2 +162700 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +162800 MOVE "REL-8X-TEST-4" TO PAR-NAME. RL2054.2 +162900 MOVE 226 TO WRK-RL-FS2-RECKEY. RL2054.2 +163000 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +163100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +163200 GO TO REL-8X-TEST-4-0. RL2054.2 +163300 REL-8X-DELETE-4. RL2054.2 +163400 PERFORM DE-LETE. RL2054.2 +163500 PERFORM PRINT-DETAIL. RL2054.2 +163600 GO TO REL-8X-INIT-5. RL2054.2 +163700 REL-8X-TEST-4-0. RL2054.2 +163800 START RL-FS2 RL2054.2 +163900 KEY IS >= RL-FS2-KEY. RL2054.2 +164000 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +164100 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +164200 PERFORM FAIL RL2054.2 +164300 PERFORM PRINT-DETAIL RL2054.2 +164400 GO TO REL-8X-INIT-5. RL2054.2 +164500 REL-8X-TEST-4-1. RL2054.2 +164600 IF XRECORD-NUMBER (1) < 226 RL2054.2 +164700 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +164800 TO RE-MARK RL2054.2 +164900 MOVE 226 TO CORRECT-N RL2054.2 +165000 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +165100 PERFORM FAIL RL2054.2 +165200 PERFORM PRINT-DETAIL RL2054.2 +165300 ELSE RL2054.2 +165400 PERFORM PASS RL2054.2 +165500 PERFORM PRINT-DETAIL. RL2054.2 +165600* RL2054.2 +165700 REL-8X-INIT-5. RL2054.2 +165800 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +165900 MOVE "REL-8X-TEST-5" TO PAR-NAME. RL2054.2 +166000 MOVE 300 TO WRK-RL-FS2-RECKEY. RL2054.2 +166100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +166200 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +166300 GO TO REL-8X-TEST-5-0. RL2054.2 +166400 REL-8X-DELETE-5. RL2054.2 +166500 PERFORM DE-LETE. RL2054.2 +166600 PERFORM PRINT-DETAIL. RL2054.2 +166700 GO TO REL-8X-INIT-6. RL2054.2 +166800 REL-8X-TEST-5-0. RL2054.2 +166900 START RL-FS2 RL2054.2 +167000 KEY >= RL-FS2-KEY. RL2054.2 +167100 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +167200 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +167300 PERFORM FAIL RL2054.2 +167400 PERFORM PRINT-DETAIL RL2054.2 +167500 GO TO REL-8X-INIT-6. RL2054.2 +167600 REL-8X-TEST-5-1. RL2054.2 +167700 IF XRECORD-NUMBER (1) < 300 RL2054.2 +167800 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +167900 TO RE-MARK RL2054.2 +168000 MOVE 300 TO CORRECT-N RL2054.2 +168100 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +168200 PERFORM FAIL RL2054.2 +168300 PERFORM PRINT-DETAIL RL2054.2 +168400 ELSE RL2054.2 +168500 PERFORM PASS RL2054.2 +168600 PERFORM PRINT-DETAIL. RL2054.2 +168700* RL2054.2 +168800 REL-8X-INIT-6. RL2054.2 +168900 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +169000 MOVE "REL-8X-TEST-6" TO PAR-NAME. RL2054.2 +169100 MOVE 123 TO WRK-RL-FD1-RECKEY. RL2054.2 +169200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +169300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +169400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +169500 MOVE 1 TO REC-CT. RL2054.2 +169600 GO TO REL-8X-TEST-6-0. RL2054.2 +169700 REL-8X-DELETE-6. RL2054.2 +169800 PERFORM DE-LETE. RL2054.2 +169900 PERFORM PRINT-DETAIL. RL2054.2 +170000 GO TO REL-8X-INIT-7. RL2054.2 +170100 REL-8X-TEST-6-0. RL2054.2 +170200 START RL-FD1 RL2054.2 +170300 KEY IS GREATER THAN OR EQUAL TO RL-FD1-KEY RL2054.2 +170400 NOT INVALID KEY RL2054.2 +170500 MOVE "A" TO WRK-XN-00001. RL2054.2 +170600 REL-8X-TEST-6-1. RL2054.2 +170700 IF WRK-XN-00001 NOT = "A" RL2054.2 +170800 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +170900 TO RE-MARK RL2054.2 +171000 MOVE "A" TO CORRECT-X RL2054.2 +171100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +171200 PERFORM FAIL RL2054.2 +171300 PERFORM PRINT-DETAIL RL2054.2 +171400 ELSE RL2054.2 +171500 PERFORM PASS RL2054.2 +171600 PERFORM PRINT-DETAIL. RL2054.2 +171700 ADD 1 TO REC-CT. RL2054.2 +171800 REL-8X-TEST-6-2. RL2054.2 +171900 MOVE "REL-8X-TEST-6-2" TO PAR-NAME. RL2054.2 +172000 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +172100 IF XRECORD-NUMBER (1) < 123 RL2054.2 +172200 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +172300 TO RE-MARK RL2054.2 +172400 PERFORM FAIL RL2054.2 +172500 PERFORM PRINT-DETAIL RL2054.2 +172600 ELSE RL2054.2 +172700 PERFORM PASS RL2054.2 +172800 PERFORM PRINT-DETAIL. RL2054.2 +172900* RL2054.2 +173000 REL-8X-INIT-7. RL2054.2 +173100 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +173200 MOVE "REL-8X-TEST-7" TO PAR-NAME. RL2054.2 +173300 MOVE 154 TO WRK-RL-FD1-RECKEY. RL2054.2 +173400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +173500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +173600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +173700 MOVE 1 TO REC-CT. RL2054.2 +173800 GO TO REL-8X-TEST-7-0. RL2054.2 +173900 REL-8X-DELETE-7. RL2054.2 +174000 PERFORM DE-LETE. RL2054.2 +174100 PERFORM PRINT-DETAIL. RL2054.2 +174200 GO TO REL-8X-INIT-8. RL2054.2 +174300 REL-8X-TEST-7-0. RL2054.2 +174400 START RL-FD1 RL2054.2 +174500 KEY GREATER OR EQUAL TO RL-FD1-KEY RL2054.2 +174600 NOT INVALID KEY RL2054.2 +174700 MOVE "A" TO WRK-XN-00001. RL2054.2 +174800 REL-8X-TEST-7-1. RL2054.2 +174900 IF WRK-XN-00001 NOT = "A" RL2054.2 +175000 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +175100 TO RE-MARK RL2054.2 +175200 MOVE "A" TO CORRECT-X RL2054.2 +175300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +175400 PERFORM FAIL RL2054.2 +175500 PERFORM PRINT-DETAIL RL2054.2 +175600 ELSE RL2054.2 +175700 PERFORM PASS RL2054.2 +175800 PERFORM PRINT-DETAIL. RL2054.2 +175900 ADD 1 TO REC-CT. RL2054.2 +176000 REL-8X-TEST-7-2. RL2054.2 +176100 MOVE "REL-8X-TEST-7-2" TO PAR-NAME. RL2054.2 +176200 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +176300 IF XRECORD-NUMBER (1) < 154 RL2054.2 +176400 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +176500 TO RE-MARK RL2054.2 +176600 MOVE 154 TO CORRECT-N RL2054.2 +176700 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +176800 PERFORM FAIL RL2054.2 +176900 PERFORM PRINT-DETAIL RL2054.2 +177000 ELSE RL2054.2 +177100 PERFORM PASS RL2054.2 +177200 PERFORM PRINT-DETAIL. RL2054.2 +177300* RL2054.2 +177400 REL-8X-INIT-8. RL2054.2 +177500 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +177600 MOVE "REL-8X-TEST-8" TO PAR-NAME. RL2054.2 +177700 MOVE 226 TO WRK-RL-FD1-RECKEY. RL2054.2 +177800 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +177900 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +178000 MOVE SPACE TO WRK-XN-00001. RL2054.2 +178100 MOVE 1 TO REC-CT. RL2054.2 +178200 GO TO REL-8X-TEST-8-0. RL2054.2 +178300 REL-8X-DELETE-8. RL2054.2 +178400 PERFORM DE-LETE. RL2054.2 +178500 PERFORM PRINT-DETAIL. RL2054.2 +178600 GO TO REL-8X-INIT-9. RL2054.2 +178700 REL-8X-TEST-8-0. RL2054.2 +178800 START RL-FD1 RL2054.2 +178900 KEY IS >= RL-FD1-KEY RL2054.2 +179000 NOT INVALID KEY RL2054.2 +179100 MOVE "A" TO WRK-XN-00001. RL2054.2 +179200 REL-8X-TEST-8-1. RL2054.2 +179300 IF WRK-XN-00001 NOT = "A" RL2054.2 +179400 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +179500 TO RE-MARK RL2054.2 +179600 MOVE "A" TO CORRECT-X RL2054.2 +179700 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +179800 PERFORM FAIL RL2054.2 +179900 PERFORM PRINT-DETAIL RL2054.2 +180000 ELSE RL2054.2 +180100 PERFORM PASS RL2054.2 +180200 PERFORM PRINT-DETAIL. RL2054.2 +180300 ADD 1 TO REC-CT. RL2054.2 +180400 REL-8X-TEST-8-2. RL2054.2 +180500 MOVE "REL-8X-TEST-8-2" TO PAR-NAME. RL2054.2 +180600 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +180700 IF XRECORD-NUMBER (1) < 226 RL2054.2 +180800 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +180900 TO RE-MARK RL2054.2 +181000 MOVE 226 TO CORRECT-N RL2054.2 +181100 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +181200 PERFORM FAIL RL2054.2 +181300 PERFORM PRINT-DETAIL RL2054.2 +181400 ELSE RL2054.2 +181500 PERFORM PASS RL2054.2 +181600 PERFORM PRINT-DETAIL. RL2054.2 +181700* RL2054.2 +181800 REL-8X-INIT-9. RL2054.2 +181900 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +182000 MOVE "REL-8X-TEST-9" TO PAR-NAME. RL2054.2 +182100 MOVE 300 TO WRK-RL-FD1-RECKEY. RL2054.2 +182200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +182300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +182400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +182500 MOVE 1 TO REC-CT. RL2054.2 +182600 GO TO REL-8X-TEST-9-0. RL2054.2 +182700 REL-8X-DELETE-9. RL2054.2 +182800 PERFORM DE-LETE. RL2054.2 +182900 PERFORM PRINT-DETAIL. RL2054.2 +183000 GO TO REL-8X-INIT-10. RL2054.2 +183100 REL-8X-TEST-9-0. RL2054.2 +183200 START RL-FD1 RL2054.2 +183300 KEY >= RL-FD1-KEY RL2054.2 +183400 NOT INVALID KEY RL2054.2 +183500 MOVE "A" TO WRK-XN-00001. RL2054.2 +183600 REL-8X-TEST-9-1. RL2054.2 +183700 IF WRK-XN-00001 NOT = "A" RL2054.2 +183800 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +183900 TO RE-MARK RL2054.2 +184000 MOVE "A" TO CORRECT-X RL2054.2 +184100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +184200 PERFORM FAIL RL2054.2 +184300 PERFORM PRINT-DETAIL RL2054.2 +184400 ELSE RL2054.2 +184500 PERFORM PASS RL2054.2 +184600 PERFORM PRINT-DETAIL. RL2054.2 +184700 ADD 1 TO REC-CT. RL2054.2 +184800 REL-8X-TEST-9-2. RL2054.2 +184900 MOVE "REL-8X-TEST-9-2" TO PAR-NAME. RL2054.2 +185000 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +185100 IF XRECORD-NUMBER (1) < 300 RL2054.2 +185200 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +185300 TO RE-MARK RL2054.2 +185400 MOVE 300 TO CORRECT-N RL2054.2 +185500 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +185600 PERFORM FAIL RL2054.2 +185700 PERFORM PRINT-DETAIL RL2054.2 +185800 ELSE RL2054.2 +185900 PERFORM PASS RL2054.2 +186000 PERFORM PRINT-DETAIL. RL2054.2 +186100* RL2054.2 +186200 REL-8X-INIT-10. RL2054.2 +186300 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +186400 MOVE "REL-8X-TEST-10" TO PAR-NAME. RL2054.2 +186500 MOVE 200 TO WRK-RL-FD1-RECKEY. RL2054.2 +186600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +186700 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +186800 MOVE SPACE TO WRK-XN-00001. RL2054.2 +186900 MOVE 1 TO REC-CT. RL2054.2 +187000 GO TO REL-8X-TEST-10-0. RL2054.2 +187100 REL-8X-DELETE-10. RL2054.2 +187200 PERFORM DE-LETE. RL2054.2 +187300 PERFORM PRINT-DETAIL. RL2054.2 +187400 GO TO REL-8X-INIT-11. RL2054.2 +187500 REL-8X-TEST-10-0. RL2054.2 +187600 START RL-FD1 RL2054.2 +187700 KEY >= RL-FD1-KEY RL2054.2 +187800 INVALID KEY RL2054.2 +187900 MOVE "A" TO WRK-XN-00001. RL2054.2 +188000 REL-8X-TEST-10-1. RL2054.2 +188100 IF WRK-XN-00001 NOT = SPACE RL2054.2 +188200 MOVE "INVALID KEY SHOULD NOT EXECUTE" RL2054.2 +188300 TO RE-MARK RL2054.2 +188400 MOVE SPACE TO CORRECT-X RL2054.2 +188500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +188600 PERFORM FAIL RL2054.2 +188700 PERFORM PRINT-DETAIL RL2054.2 +188800 ELSE RL2054.2 +188900 PERFORM PASS RL2054.2 +189000 PERFORM PRINT-DETAIL. RL2054.2 +189100 ADD 1 TO REC-CT. RL2054.2 +189200 REL-8X-TEST-10-2. RL2054.2 +189300 MOVE "REL-8X-TEST-10-2" TO PAR-NAME. RL2054.2 +189400 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +189500 IF XRECORD-NUMBER (1) < 200 RL2054.2 +189600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +189700 TO RE-MARK RL2054.2 +189800 MOVE 200 TO CORRECT-N RL2054.2 +189900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +190000 PERFORM FAIL RL2054.2 +190100 PERFORM PRINT-DETAIL RL2054.2 +190200 ELSE RL2054.2 +190300 PERFORM PASS RL2054.2 +190400 PERFORM PRINT-DETAIL. RL2054.2 +190500* RL2054.2 +190600 REL-8X-INIT-11. RL2054.2 +190700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +190800 MOVE "REL-8X-TEST-11" TO PAR-NAME. RL2054.2 +190900 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +191000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +191100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +191200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +191300 MOVE 1 TO REC-CT. RL2054.2 +191400 GO TO REL-8X-TEST-11-0. RL2054.2 +191500 REL-8X-DELETE-11. RL2054.2 +191600 PERFORM DE-LETE. RL2054.2 +191700 PERFORM PRINT-DETAIL. RL2054.2 +191800 GO TO REL-8X-INIT-12. RL2054.2 +191900 REL-8X-TEST-11-0. RL2054.2 +192000 START RL-FD1 RL2054.2 +192100 KEY >= RL-FD1-KEY RL2054.2 +192200 INVALID KEY RL2054.2 +192300 MOVE "A" TO WRK-XN-00001. RL2054.2 +192400 REL-8X-TEST-11-1. RL2054.2 +192500 IF WRK-XN-00001 NOT = "A" RL2054.2 +192600 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +192700 TO RE-MARK RL2054.2 +192800 MOVE "A" TO CORRECT-X RL2054.2 +192900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +193000 PERFORM FAIL RL2054.2 +193100 PERFORM PRINT-DETAIL RL2054.2 +193200 ELSE RL2054.2 +193300 PERFORM PASS RL2054.2 +193400 PERFORM PRINT-DETAIL. RL2054.2 +193500* RL2054.2 +193600 REL-8X-INIT-12. RL2054.2 +193700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +193800 MOVE "REL-8X-TEST-12" TO PAR-NAME. RL2054.2 +193900 MOVE 027 TO WRK-RL-FD1-RECKEY. RL2054.2 +194000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +194100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +194200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +194300 MOVE 1 TO REC-CT. RL2054.2 +194400 GO TO REL-8X-TEST-12-0. RL2054.2 +194500 REL-8X-DELETE-12. RL2054.2 +194600 PERFORM DE-LETE. RL2054.2 +194700 PERFORM PRINT-DETAIL. RL2054.2 +194800 GO TO REL-8X-INIT-13. RL2054.2 +194900 REL-8X-TEST-12-0. RL2054.2 +195000 START RL-FD1 RL2054.2 +195100 KEY >= RL-FD1-KEY RL2054.2 +195200 NOT INVALID KEY RL2054.2 +195300 MOVE "A" TO WRK-XN-00001. RL2054.2 +195400 REL-8X-TEST-12-1. RL2054.2 +195500 IF WRK-XN-00001 NOT = "A" RL2054.2 +195600 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +195700 TO RE-MARK RL2054.2 +195800 MOVE "A" TO CORRECT-X RL2054.2 +195900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +196000 PERFORM FAIL RL2054.2 +196100 PERFORM PRINT-DETAIL RL2054.2 +196200 ELSE RL2054.2 +196300 PERFORM PASS RL2054.2 +196400 PERFORM PRINT-DETAIL. RL2054.2 +196500 ADD 1 TO REC-CT. RL2054.2 +196600 REL-8X-TEST-12-2. RL2054.2 +196700 MOVE "REL-8X-TEST-12-2" TO PAR-NAME. RL2054.2 +196800 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +196900 IF XRECORD-NUMBER (1) < 27 RL2054.2 +197000 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +197100 TO RE-MARK RL2054.2 +197200 MOVE 27 TO CORRECT-N RL2054.2 +197300 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +197400 PERFORM FAIL RL2054.2 +197500 PERFORM PRINT-DETAIL RL2054.2 +197600 ELSE RL2054.2 +197700 PERFORM PASS RL2054.2 +197800 PERFORM PRINT-DETAIL. RL2054.2 +197900* RL2054.2 +198000 REL-8X-INIT-13. RL2054.2 +198100 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +198200 MOVE "REL-8X-TEST-13" TO PAR-NAME. RL2054.2 +198300 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +198400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +198500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +198600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +198700 MOVE 1 TO REC-CT. RL2054.2 +198800 GO TO REL-8X-TEST-13-0. RL2054.2 +198900 REL-8X-DELETE-13. RL2054.2 +199000 PERFORM DE-LETE. RL2054.2 +199100 PERFORM PRINT-DETAIL. RL2054.2 +199200 GO TO REL-8X-INIT-14. RL2054.2 +199300 REL-8X-TEST-13-0. RL2054.2 +199400 START RL-FD1 RL2054.2 +199500 KEY >= RL-FD1-KEY RL2054.2 +199600 NOT INVALID KEY RL2054.2 +199700 MOVE "A" TO WRK-XN-00001. RL2054.2 +199800 REL-8X-TEST-13-1. RL2054.2 +199900 IF WRK-XN-00001 NOT = SPACE RL2054.2 +200000 MOVE "NOT INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +200100 TO RE-MARK RL2054.2 +200200 MOVE SPACE TO CORRECT-X RL2054.2 +200300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +200400 PERFORM FAIL RL2054.2 +200500 PERFORM PRINT-DETAIL RL2054.2 +200600 ELSE RL2054.2 +200700 PERFORM PASS RL2054.2 +200800 PERFORM PRINT-DETAIL. RL2054.2 +200900* RL2054.2 +201000 REL-8X-INIT-14. RL2054.2 +201100 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +201200 MOVE "REL-8X-TEST-14" TO PAR-NAME. RL2054.2 +201300 MOVE 101 TO WRK-RL-FD1-RECKEY. RL2054.2 +201400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +201500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +201600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +201700 MOVE 1 TO REC-CT. RL2054.2 +201800 GO TO REL-8X-TEST-14-0. RL2054.2 +201900 REL-8X-DELETE-14. RL2054.2 +202000 PERFORM DE-LETE. RL2054.2 +202100 PERFORM PRINT-DETAIL. RL2054.2 +202200 GO TO REL-8X-INIT-15. RL2054.2 +202300 REL-8X-TEST-14-0. RL2054.2 +202400 START RL-FD1 RL2054.2 +202500 KEY >= RL-FD1-KEY RL2054.2 +202600 INVALID KEY RL2054.2 +202700 MOVE "B" TO WRK-XN-00001 RL2054.2 +202800 NOT INVALID KEY RL2054.2 +202900 MOVE "A" TO WRK-XN-00001. RL2054.2 +203000 REL-8X-TEST-14-1. RL2054.2 +203100 IF WRK-XN-00001 NOT = "A" RL2054.2 +203200 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +203300 TO RE-MARK RL2054.2 +203400 MOVE "A" TO CORRECT-X RL2054.2 +203500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +203600 PERFORM FAIL RL2054.2 +203700 PERFORM PRINT-DETAIL RL2054.2 +203800 ELSE RL2054.2 +203900 PERFORM PASS RL2054.2 +204000 PERFORM PRINT-DETAIL. RL2054.2 +204100 ADD 1 TO REC-CT. RL2054.2 +204200 REL-8X-TEST-14-2. RL2054.2 +204300 MOVE "REL-8X-TEST-14-2" TO PAR-NAME. RL2054.2 +204400 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +204500 IF XRECORD-NUMBER (1) < 101 RL2054.2 +204600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +204700 TO RE-MARK RL2054.2 +204800 MOVE 101 TO CORRECT-N RL2054.2 +204900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +205000 PERFORM FAIL RL2054.2 +205100 PERFORM PRINT-DETAIL RL2054.2 +205200 ELSE RL2054.2 +205300 PERFORM PASS RL2054.2 +205400 PERFORM PRINT-DETAIL. RL2054.2 +205500* RL2054.2 +205600 REL-8X-INIT-15. RL2054.2 +205700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +205800 MOVE "REL-8X-TEST-15" TO PAR-NAME. RL2054.2 +205900 MOVE 666 TO WRK-RL-FD1-RECKEY. RL2054.2 +206000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +206100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +206200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +206300 MOVE 1 TO REC-CT. RL2054.2 +206400 GO TO REL-8X-TEST-15-0. RL2054.2 +206500 REL-8X-DELETE-15. RL2054.2 +206600 PERFORM DE-LETE. RL2054.2 +206700 PERFORM PRINT-DETAIL. RL2054.2 +206800 GO TO REL-8X-INIT-16. RL2054.2 +206900 REL-8X-TEST-15-0. RL2054.2 +207000 START RL-FD1 RL2054.2 +207100 KEY >= RL-FD1-KEY RL2054.2 +207200 INVALID KEY RL2054.2 +207300 MOVE "A" TO WRK-XN-00001 RL2054.2 +207400 NOT INVALID KEY RL2054.2 +207500 MOVE "B" TO WRK-XN-00001. RL2054.2 +207600 REL-8X-TEST-15-1. RL2054.2 +207700 IF WRK-XN-00001 NOT = "A" RL2054.2 +207800 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +207900 TO RE-MARK RL2054.2 +208000 MOVE "A" TO CORRECT-X RL2054.2 +208100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +208200 PERFORM FAIL RL2054.2 +208300 PERFORM PRINT-DETAIL RL2054.2 +208400 ELSE RL2054.2 +208500 PERFORM PASS RL2054.2 +208600 PERFORM PRINT-DETAIL. RL2054.2 +208700* RL2054.2 +208800 REL-8X-INIT-16. RL2054.2 +208900 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +209000 MOVE "REL-8X-TEST-16" TO PAR-NAME. RL2054.2 +209100 MOVE 200 TO WRK-RL-FD1-RECKEY. RL2054.2 +209200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +209300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +209400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +209500 MOVE SPACE TO WRK-XN-00002. RL2054.2 +209600 MOVE 1 TO REC-CT. RL2054.2 +209700 GO TO REL-8X-TEST-16-0. RL2054.2 +209800 REL-8X-DELETE-16. RL2054.2 +209900 PERFORM DE-LETE. RL2054.2 +210000 PERFORM PRINT-DETAIL. RL2054.2 +210100 GO TO REL-8X-INIT-17. RL2054.2 +210200 REL-8X-TEST-16-0. RL2054.2 +210300 START RL-FD1 RL2054.2 +210400 KEY >= RL-FD1-KEY RL2054.2 +210500 INVALID KEY RL2054.2 +210600 MOVE "A" TO WRK-XN-00001 RL2054.2 +210700 END-START RL2054.2 +210800 MOVE "Z" TO WRK-XN-00002. RL2054.2 +210900 REL-8X-TEST-16-1. RL2054.2 +211000 IF WRK-XN-00001 NOT = SPACE RL2054.2 +211100 MOVE "INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +211200 TO RE-MARK RL2054.2 +211300 MOVE SPACE TO CORRECT-X RL2054.2 +211400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +211500 PERFORM FAIL RL2054.2 +211600 PERFORM PRINT-DETAIL RL2054.2 +211700 ELSE RL2054.2 +211800 PERFORM PASS RL2054.2 +211900 PERFORM PRINT-DETAIL. RL2054.2 +212000 ADD 1 TO REC-CT. RL2054.2 +212100 REL-8X-TEST-16-2. RL2054.2 +212200 MOVE "REL-8X-TEST-16-2" TO PAR-NAME. RL2054.2 +212300 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +212400 IF XRECORD-NUMBER (1) < 200 RL2054.2 +212500 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +212600 TO RE-MARK RL2054.2 +212700 MOVE 200 TO CORRECT-N RL2054.2 +212800 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +212900 PERFORM FAIL RL2054.2 +213000 PERFORM PRINT-DETAIL RL2054.2 +213100 ELSE RL2054.2 +213200 PERFORM PASS RL2054.2 +213300 PERFORM PRINT-DETAIL. RL2054.2 +213400 ADD 1 TO REC-CT. RL2054.2 +213500 REL-8X-TEST-16-3. RL2054.2 +213600 MOVE "REL-8X-TEST-16-3" TO PAR-NAME. RL2054.2 +213700 IF WRK-XN-00002 NOT = "Z" RL2054.2 +213800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +213900 MOVE "Z" TO CORRECT-X RL2054.2 +214000 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +214100 PERFORM FAIL RL2054.2 +214200 PERFORM PRINT-DETAIL RL2054.2 +214300 ELSE RL2054.2 +214400 PERFORM PASS RL2054.2 +214500 PERFORM PRINT-DETAIL. RL2054.2 +214600* RL2054.2 +214700 REL-8X-INIT-17. RL2054.2 +214800 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +214900 MOVE "REL-8X-TEST-17" TO PAR-NAME. RL2054.2 +215000 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +215100 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +215200 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +215300 MOVE SPACE TO WRK-XN-00001. RL2054.2 +215400 MOVE SPACE TO WRK-XN-00002. RL2054.2 +215500 MOVE 1 TO REC-CT. RL2054.2 +215600 GO TO REL-8X-TEST-17-0. RL2054.2 +215700 REL-8X-DELETE-17. RL2054.2 +215800 PERFORM DE-LETE. RL2054.2 +215900 PERFORM PRINT-DETAIL. RL2054.2 +216000 GO TO REL-8X-INIT-18. RL2054.2 +216100 REL-8X-TEST-17-0. RL2054.2 +216200 START RL-FD1 RL2054.2 +216300 KEY >= RL-FD1-KEY RL2054.2 +216400 INVALID KEY RL2054.2 +216500 MOVE "A" TO WRK-XN-00001 RL2054.2 +216600 END-START RL2054.2 +216700 MOVE "Z" TO WRK-XN-00002. RL2054.2 +216800 REL-8X-TEST-17-1. RL2054.2 +216900 IF WRK-XN-00001 NOT = "A" RL2054.2 +217000 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +217100 TO RE-MARK RL2054.2 +217200 MOVE "A" TO CORRECT-X RL2054.2 +217300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +217400 PERFORM FAIL RL2054.2 +217500 PERFORM PRINT-DETAIL RL2054.2 +217600 ELSE RL2054.2 +217700 PERFORM PASS RL2054.2 +217800 PERFORM PRINT-DETAIL. RL2054.2 +217900 ADD 1 TO REC-CT. RL2054.2 +218000 REL-8X-TEST-17-2. RL2054.2 +218100 MOVE "REL-8X-TEST-17-2" TO PAR-NAME. RL2054.2 +218200 IF WRK-XN-00002 NOT = "Z" RL2054.2 +218300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +218400 MOVE "Z" TO CORRECT-X RL2054.2 +218500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +218600 PERFORM FAIL RL2054.2 +218700 PERFORM PRINT-DETAIL RL2054.2 +218800 ELSE RL2054.2 +218900 PERFORM PASS RL2054.2 +219000 PERFORM PRINT-DETAIL. RL2054.2 +219100* RL2054.2 +219200 REL-8X-INIT-18. RL2054.2 +219300 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +219400 MOVE "REL-8X-TEST-18" TO PAR-NAME. RL2054.2 +219500 MOVE 027 TO WRK-RL-FD1-RECKEY. RL2054.2 +219600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +219700 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +219800 MOVE SPACE TO WRK-XN-00001. RL2054.2 +219900 MOVE SPACE TO WRK-XN-00002. RL2054.2 +220000 MOVE 1 TO REC-CT. RL2054.2 +220100 GO TO REL-8X-TEST-18-0. RL2054.2 +220200 REL-8X-DELETE-18. RL2054.2 +220300 PERFORM DE-LETE. RL2054.2 +220400 PERFORM PRINT-DETAIL. RL2054.2 +220500 GO TO REL-8X-INIT-19. RL2054.2 +220600 REL-8X-TEST-18-0. RL2054.2 +220700 START RL-FD1 RL2054.2 +220800 KEY >= RL-FD1-KEY RL2054.2 +220900 NOT INVALID KEY RL2054.2 +221000 MOVE "A" TO WRK-XN-00001 RL2054.2 +221100 END-START RL2054.2 +221200 MOVE "Z" TO WRK-XN-00002. RL2054.2 +221300 REL-8X-TEST-18-1. RL2054.2 +221400 IF WRK-XN-00001 NOT = "A" RL2054.2 +221500 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +221600 TO RE-MARK RL2054.2 +221700 MOVE "A" TO CORRECT-X RL2054.2 +221800 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +221900 PERFORM FAIL RL2054.2 +222000 PERFORM PRINT-DETAIL RL2054.2 +222100 ELSE RL2054.2 +222200 PERFORM PASS RL2054.2 +222300 PERFORM PRINT-DETAIL. RL2054.2 +222400 ADD 1 TO REC-CT. RL2054.2 +222500 REL-8X-TEST-18-2. RL2054.2 +222600 MOVE "REL-8X-TEST-18-2" TO PAR-NAME. RL2054.2 +222700 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +222800 IF XRECORD-NUMBER (1) < 27 RL2054.2 +222900 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +223000 TO RE-MARK RL2054.2 +223100 MOVE 27 TO CORRECT-N RL2054.2 +223200 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +223300 PERFORM FAIL RL2054.2 +223400 PERFORM PRINT-DETAIL RL2054.2 +223500 ELSE RL2054.2 +223600 PERFORM PASS RL2054.2 +223700 PERFORM PRINT-DETAIL. RL2054.2 +223800 ADD 1 TO REC-CT. RL2054.2 +223900 REL-8X-TEST-18-3. RL2054.2 +224000 MOVE "REL-8X-TEST-18-3" TO PAR-NAME. RL2054.2 +224100 IF WRK-XN-00002 NOT = "Z" RL2054.2 +224200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +224300 MOVE "Z" TO CORRECT-X RL2054.2 +224400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +224500 PERFORM FAIL RL2054.2 +224600 PERFORM PRINT-DETAIL RL2054.2 +224700 ELSE RL2054.2 +224800 PERFORM PASS RL2054.2 +224900 PERFORM PRINT-DETAIL. RL2054.2 +225000* RL2054.2 +225100 REL-8X-INIT-19. RL2054.2 +225200 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +225300 MOVE "REL-8X-TEST-19" TO PAR-NAME. RL2054.2 +225400 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +225500 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +225600 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +225700 MOVE SPACE TO WRK-XN-00001. RL2054.2 +225800 MOVE SPACE TO WRK-XN-00002. RL2054.2 +225900 MOVE 1 TO REC-CT. RL2054.2 +226000 GO TO REL-8X-TEST-19-0. RL2054.2 +226100 REL-8X-DELETE-19. RL2054.2 +226200 PERFORM DE-LETE. RL2054.2 +226300 PERFORM PRINT-DETAIL. RL2054.2 +226400 GO TO REL-8X-INIT-20. RL2054.2 +226500 REL-8X-TEST-19-0. RL2054.2 +226600 START RL-FD1 RL2054.2 +226700 KEY >= RL-FD1-KEY RL2054.2 +226800 NOT INVALID KEY RL2054.2 +226900 MOVE "A" TO WRK-XN-00001 RL2054.2 +227000 END-START RL2054.2 +227100 MOVE "Z" TO WRK-XN-00002. RL2054.2 +227200 REL-8X-TEST-19-1. RL2054.2 +227300 IF WRK-XN-00001 NOT = SPACE RL2054.2 +227400 MOVE "NOT INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +227500 TO RE-MARK RL2054.2 +227600 MOVE SPACE TO CORRECT-X RL2054.2 +227700 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +227800 PERFORM FAIL RL2054.2 +227900 PERFORM PRINT-DETAIL RL2054.2 +228000 ELSE RL2054.2 +228100 PERFORM PASS RL2054.2 +228200 PERFORM PRINT-DETAIL. RL2054.2 +228300 ADD 1 TO REC-CT. RL2054.2 +228400 REL-8X-TEST-19-2. RL2054.2 +228500 MOVE "REL-8X-TEST-19-2" TO PAR-NAME. RL2054.2 +228600 IF WRK-XN-00002 NOT = "Z" RL2054.2 +228700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +228800 MOVE "Z" TO CORRECT-X RL2054.2 +228900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +229000 PERFORM FAIL RL2054.2 +229100 PERFORM PRINT-DETAIL RL2054.2 +229200 ELSE RL2054.2 +229300 PERFORM PASS RL2054.2 +229400 PERFORM PRINT-DETAIL. RL2054.2 +229500* RL2054.2 +229600 REL-8X-INIT-20. RL2054.2 +229700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +229800 MOVE "REL-8X-TEST-20" TO PAR-NAME. RL2054.2 +229900 MOVE 101 TO WRK-RL-FD1-RECKEY. RL2054.2 +230000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +230100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +230200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +230300 MOVE 1 TO REC-CT. RL2054.2 +230400 GO TO REL-8X-TEST-20-0. RL2054.2 +230500 REL-8X-DELETE-20. RL2054.2 +230600 PERFORM DE-LETE. RL2054.2 +230700 PERFORM PRINT-DETAIL. RL2054.2 +230800 GO TO REL-8X-INIT-21. RL2054.2 +230900 REL-8X-TEST-20-0. RL2054.2 +231000 START RL-FD1 RL2054.2 +231100 KEY >= RL-FD1-KEY RL2054.2 +231200 INVALID KEY RL2054.2 +231300 MOVE "B" TO WRK-XN-00001 RL2054.2 +231400 NOT INVALID KEY RL2054.2 +231500 MOVE "A" TO WRK-XN-00001 RL2054.2 +231600 END-START RL2054.2 +231700 MOVE "Z" TO WRK-XN-00002. RL2054.2 +231800 REL-8X-TEST-20-1. RL2054.2 +231900 IF WRK-XN-00001 NOT = "A" RL2054.2 +232000 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +232100 TO RE-MARK RL2054.2 +232200 MOVE "A" TO CORRECT-X RL2054.2 +232300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +232400 PERFORM FAIL RL2054.2 +232500 PERFORM PRINT-DETAIL RL2054.2 +232600 ELSE RL2054.2 +232700 PERFORM PASS RL2054.2 +232800 PERFORM PRINT-DETAIL. RL2054.2 +232900 ADD 1 TO REC-CT. RL2054.2 +233000 REL-8X-TEST-20-2. RL2054.2 +233100 MOVE "REL-8X-TEST-20-2" TO PAR-NAME. RL2054.2 +233200 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +233300 IF XRECORD-NUMBER (1) < 101 RL2054.2 +233400 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +233500 TO RE-MARK RL2054.2 +233600 MOVE 101 TO CORRECT-N RL2054.2 +233700 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +233800 PERFORM FAIL RL2054.2 +233900 PERFORM PRINT-DETAIL RL2054.2 +234000 ELSE RL2054.2 +234100 PERFORM PASS RL2054.2 +234200 PERFORM PRINT-DETAIL. RL2054.2 +234300 ADD 1 TO REC-CT. RL2054.2 +234400 REL-8X-TEST-20-3. RL2054.2 +234500 MOVE "REL-8X-TEST-20-3" TO PAR-NAME. RL2054.2 +234600 IF WRK-XN-00002 NOT = "Z" RL2054.2 +234700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +234800 MOVE "Z" TO CORRECT-X RL2054.2 +234900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +235000 PERFORM FAIL RL2054.2 +235100 PERFORM PRINT-DETAIL RL2054.2 +235200 ELSE RL2054.2 +235300 PERFORM PASS RL2054.2 +235400 PERFORM PRINT-DETAIL. RL2054.2 +235500* RL2054.2 +235600 REL-8X-INIT-21. RL2054.2 +235700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +235800 MOVE "REL-8X-TEST-21" TO PAR-NAME. RL2054.2 +235900 MOVE 666 TO WRK-RL-FD1-RECKEY. RL2054.2 +236000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +236100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +236200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +236300 MOVE SPACE TO WRK-XN-00002. RL2054.2 +236400 MOVE 1 TO REC-CT. RL2054.2 +236500 GO TO REL-8X-TEST-21-0. RL2054.2 +236600 REL-8X-DELETE-21. RL2054.2 +236700 PERFORM DE-LETE. RL2054.2 +236800 PERFORM PRINT-DETAIL. RL2054.2 +236900 GO TO REL-8X-END-21. RL2054.2 +237000 REL-8X-TEST-21-0. RL2054.2 +237100 START RL-FD1 RL2054.2 +237200 KEY >= RL-FD1-KEY RL2054.2 +237300 INVALID KEY RL2054.2 +237400 MOVE "A" TO WRK-XN-00001 RL2054.2 +237500 NOT INVALID KEY RL2054.2 +237600 MOVE "B" TO WRK-XN-00001 RL2054.2 +237700 END-START RL2054.2 +237800 MOVE "Z" TO WRK-XN-00002. RL2054.2 +237900 REL-8X-TEST-21-1. RL2054.2 +238000 IF WRK-XN-00001 NOT = "A" RL2054.2 +238100 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +238200 TO RE-MARK RL2054.2 +238300 MOVE "A" TO CORRECT-X RL2054.2 +238400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +238500 PERFORM FAIL RL2054.2 +238600 PERFORM PRINT-DETAIL RL2054.2 +238700 ELSE RL2054.2 +238800 PERFORM PASS RL2054.2 +238900 PERFORM PRINT-DETAIL. RL2054.2 +239000 ADD 1 TO REC-CT. RL2054.2 +239100 REL-8X-TEST-21-2. RL2054.2 +239200 MOVE "REL-8X-TEST-21-2" TO PAR-NAME. RL2054.2 +239300 IF WRK-XN-00002 NOT = "Z" RL2054.2 +239400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +239500 MOVE "Z" TO CORRECT-X RL2054.2 +239600 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +239700 PERFORM FAIL RL2054.2 +239800 PERFORM PRINT-DETAIL RL2054.2 +239900 ELSE RL2054.2 +240000 PERFORM PASS RL2054.2 +240100 PERFORM PRINT-DETAIL. RL2054.2 +240200 REL-8X-END-21. RL2054.2 +240300 CLOSE RL-FD1. RL2054.2 +240400 CLOSE RL-FS2. RL2054.2 +240500 REL-8X-EXIT. RL2054.2 +240600 EXIT. RL2054.2 +240700* RL2054.2 +240800 CCVS-EXIT SECTION. RL2054.2 +240900 CCVS-999999. RL2054.2 +241000 GO TO CLOSE-FILES. RL2054.2 +*END-OF,RL205A +*HEADER,COBOL,RL206A +000100 IDENTIFICATION DIVISION. RL2064.2 +000200 PROGRAM-ID. RL2064.2 +000300 RL206A. RL2064.2 +000400**************************************************************** RL2064.2 +000500* * RL2064.2 +000600* VALIDATION FOR:- * RL2064.2 +000700* * RL2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +000900* * RL2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2064.2 +001100* * RL2064.2 +001200**************************************************************** RL2064.2 +001300*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL2064.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL2064.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL2064.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL2064.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL2064.2 +001800* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL2064.2 +001900* RL2064.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2064.2 +002100* PROGRAM ARE: RL2064.2 +002200* RL2064.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2064.2 +002400* RELATIVE I-O DATA FILE RL2064.2 +002500* X-55 SYSTEM PRINTER RL2064.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2064.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2064.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2064.2 +002900* X-82 SOURCE-COMPUTER RL2064.2 +003000* X-83 OBJECT-COMPUTER. RL2064.2 +003100* RL2064.2 +003200**************************************************************** RL2064.2 +003300 ENVIRONMENT DIVISION. RL2064.2 +003400 CONFIGURATION SECTION. RL2064.2 +003500 SOURCE-COMPUTER. RL2064.2 +003600 XXXXX082. RL2064.2 +003700 OBJECT-COMPUTER. RL2064.2 +003800 XXXXX083. RL2064.2 +003900 INPUT-OUTPUT SECTION. RL2064.2 +004000 FILE-CONTROL. RL2064.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2064.2 +004200 XXXXX055. RL2064.2 +004300 SELECT RL-FS1 ASSIGN TO RL2064.2 +004400 XXXXP021 RL2064.2 +004500 ORGANIZATION IS RELATIVE. RL2064.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2064.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2064.2 +004800 DATA DIVISION. RL2064.2 +004900 FILE SECTION. RL2064.2 +005000 FD PRINT-FILE. RL2064.2 +005100 01 PRINT-REC PICTURE X(120). RL2064.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2064.2 +005300 FD RL-FS1 RL2064.2 +005400 LABEL RECORDS STANDARD RL2064.2 +005500C VALUE OF RL2064.2 +005600C XXXXX074 RL2064.2 +005700C IS RL2064.2 +005800C XXXXX075 RL2064.2 +005900G XXXXX069 RL2064.2 +006000 BLOCK CONTAINS 1 RECORDS RL2064.2 +006100 RECORD IS VARYING IN SIZE RL2064.2 +006200 FROM 120 TO 140 CHARACTERS RL2064.2 +006300 DEPENDING ON WRK-SIZE. RL2064.2 +006400 01 RL-FS1R1-F-G-140. RL2064.2 +006500 02 FILLER PIC X(140). RL2064.2 +006600 WORKING-STORAGE SECTION. RL2064.2 +006700 01 WRK-SIZE PIC 9(3). RL2064.2 +006800 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2064.2 +006900 01 FILE-RECORD-INFORMATION-REC. RL2064.2 +007000 03 FILE-RECORD-INFO-SKELETON. RL2064.2 +007100 05 FILLER PICTURE X(48) VALUE RL2064.2 +007200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2064.2 +007300 05 FILLER PICTURE X(46) VALUE RL2064.2 +007400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2064.2 +007500 05 FILLER PICTURE X(26) VALUE RL2064.2 +007600 ",LFIL=000000,ORG= ,LBLR= ". RL2064.2 +007700 05 FILLER PICTURE X(37) VALUE RL2064.2 +007800 ",RECKEY= ". RL2064.2 +007900 05 FILLER PICTURE X(38) VALUE RL2064.2 +008000 ",ALTKEY1= ". RL2064.2 +008100 05 FILLER PICTURE X(38) VALUE RL2064.2 +008200 ",ALTKEY2= ". RL2064.2 +008300 05 FILLER PICTURE X(7) VALUE SPACE.RL2064.2 +008400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2064.2 +008500 05 FILE-RECORD-INFO-P1-120. RL2064.2 +008600 07 FILLER PIC X(5). RL2064.2 +008700 07 XFILE-NAME PIC X(6). RL2064.2 +008800 07 FILLER PIC X(8). RL2064.2 +008900 07 XRECORD-NAME PIC X(6). RL2064.2 +009000 07 FILLER PIC X(1). RL2064.2 +009100 07 REELUNIT-NUMBER PIC 9(1). RL2064.2 +009200 07 FILLER PIC X(7). RL2064.2 +009300 07 XRECORD-NUMBER PIC 9(6). RL2064.2 +009400 07 FILLER PIC X(6). RL2064.2 +009500 07 UPDATE-NUMBER PIC 9(2). RL2064.2 +009600 07 FILLER PIC X(5). RL2064.2 +009700 07 ODO-NUMBER PIC 9(4). RL2064.2 +009800 07 FILLER PIC X(5). RL2064.2 +009900 07 XPROGRAM-NAME PIC X(5). RL2064.2 +010000 07 FILLER PIC X(7). RL2064.2 +010100 07 XRECORD-LENGTH PIC 9(6). RL2064.2 +010200 07 FILLER PIC X(7). RL2064.2 +010300 07 CHARS-OR-RECORDS PIC X(2). RL2064.2 +010400 07 FILLER PIC X(1). RL2064.2 +010500 07 XBLOCK-SIZE PIC 9(4). RL2064.2 +010600 07 FILLER PIC X(6). RL2064.2 +010700 07 RECORDS-IN-FILE PIC 9(6). RL2064.2 +010800 07 FILLER PIC X(5). RL2064.2 +010900 07 XFILE-ORGANIZATION PIC X(2). RL2064.2 +011000 07 FILLER PIC X(6). RL2064.2 +011100 07 XLABEL-TYPE PIC X(1). RL2064.2 +011200 05 FILE-RECORD-INFO-P121-240. RL2064.2 +011300 07 FILLER PIC X(8). RL2064.2 +011400 07 XRECORD-KEY PIC X(29). RL2064.2 +011500 07 FILLER PIC X(9). RL2064.2 +011600 07 ALTERNATE-KEY1 PIC X(29). RL2064.2 +011700 07 FILLER PIC X(9). RL2064.2 +011800 07 ALTERNATE-KEY2 PIC X(29). RL2064.2 +011900 07 FILLER PIC X(7). RL2064.2 +012000 01 NEW-140-CHAR-AREA. RL2064.2 +012100 03 FILLER PIC X(120). RL2064.2 +012200 03 EXTRA-20-CHARS PIC X(20). RL2064.2 +012300 RL2064.2 +012400 01 TEST-RESULTS. RL2064.2 +012500 02 FILLER PIC X VALUE SPACE. RL2064.2 +012600 02 FEATURE PIC X(20) VALUE SPACE. RL2064.2 +012700 02 FILLER PIC X VALUE SPACE. RL2064.2 +012800 02 P-OR-F PIC X(5) VALUE SPACE. RL2064.2 +012900 02 FILLER PIC X VALUE SPACE. RL2064.2 +013000 02 PAR-NAME. RL2064.2 +013100 03 FILLER PIC X(19) VALUE SPACE. RL2064.2 +013200 03 PARDOT-X PIC X VALUE SPACE. RL2064.2 +013300 03 DOTVALUE PIC 99 VALUE ZERO. RL2064.2 +013400 02 FILLER PIC X(8) VALUE SPACE. RL2064.2 +013500 02 RE-MARK PIC X(61). RL2064.2 +013600 01 TEST-COMPUTED. RL2064.2 +013700 02 FILLER PIC X(30) VALUE SPACE. RL2064.2 +013800 02 FILLER PIC X(17) VALUE RL2064.2 +013900 " COMPUTED=". RL2064.2 +014000 02 COMPUTED-X. RL2064.2 +014100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2064.2 +014200 03 COMPUTED-N REDEFINES COMPUTED-A RL2064.2 +014300 PIC -9(9).9(9). RL2064.2 +014400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2064.2 +014500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2064.2 +014600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2064.2 +014700 03 CM-18V0 REDEFINES COMPUTED-A. RL2064.2 +014800 04 COMPUTED-18V0 PIC -9(18). RL2064.2 +014900 04 FILLER PIC X. RL2064.2 +015000 03 FILLER PIC X(50) VALUE SPACE. RL2064.2 +015100 01 TEST-CORRECT. RL2064.2 +015200 02 FILLER PIC X(30) VALUE SPACE. RL2064.2 +015300 02 FILLER PIC X(17) VALUE " CORRECT =". RL2064.2 +015400 02 CORRECT-X. RL2064.2 +015500 03 CORRECT-A PIC X(20) VALUE SPACE. RL2064.2 +015600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2064.2 +015700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2064.2 +015800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2064.2 +015900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2064.2 +016000 03 CR-18V0 REDEFINES CORRECT-A. RL2064.2 +016100 04 CORRECT-18V0 PIC -9(18). RL2064.2 +016200 04 FILLER PIC X. RL2064.2 +016300 03 FILLER PIC X(2) VALUE SPACE. RL2064.2 +016400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2064.2 +016500 01 CCVS-C-1. RL2064.2 +016600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2064.2 +016700- "SS PARAGRAPH-NAME RL2064.2 +016800- " REMARKS". RL2064.2 +016900 02 FILLER PIC X(20) VALUE SPACE. RL2064.2 +017000 01 CCVS-C-2. RL2064.2 +017100 02 FILLER PIC X VALUE SPACE. RL2064.2 +017200 02 FILLER PIC X(6) VALUE "TESTED". RL2064.2 +017300 02 FILLER PIC X(15) VALUE SPACE. RL2064.2 +017400 02 FILLER PIC X(4) VALUE "FAIL". RL2064.2 +017500 02 FILLER PIC X(94) VALUE SPACE. RL2064.2 +017600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2064.2 +017700 01 REC-CT PIC 99 VALUE ZERO. RL2064.2 +017800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2064.2 +017900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2064.2 +018300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2064.2 +018400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2064.2 +018500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2064.2 +018600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2064.2 +018700 01 CCVS-H-1. RL2064.2 +018800 02 FILLER PIC X(39) VALUE SPACES. RL2064.2 +018900 02 FILLER PIC X(42) VALUE RL2064.2 +019000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2064.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2064.2 +019200 01 CCVS-H-2A. RL2064.2 +019300 02 FILLER PIC X(40) VALUE SPACE. RL2064.2 +019400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2064.2 +019500 02 FILLER PIC XXXX VALUE RL2064.2 +019600 "4.2 ". RL2064.2 +019700 02 FILLER PIC X(28) VALUE RL2064.2 +019800 " COPY - NOT FOR DISTRIBUTION". RL2064.2 +019900 02 FILLER PIC X(41) VALUE SPACE. RL2064.2 +020000 RL2064.2 +020100 01 CCVS-H-2B. RL2064.2 +020200 02 FILLER PIC X(15) VALUE RL2064.2 +020300 "TEST RESULT OF ". RL2064.2 +020400 02 TEST-ID PIC X(9). RL2064.2 +020500 02 FILLER PIC X(4) VALUE RL2064.2 +020600 " IN ". RL2064.2 +020700 02 FILLER PIC X(12) VALUE RL2064.2 +020800 " HIGH ". RL2064.2 +020900 02 FILLER PIC X(22) VALUE RL2064.2 +021000 " LEVEL VALIDATION FOR ". RL2064.2 +021100 02 FILLER PIC X(58) VALUE RL2064.2 +021200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +021300 01 CCVS-H-3. RL2064.2 +021400 02 FILLER PIC X(34) VALUE RL2064.2 +021500 " FOR OFFICIAL USE ONLY ". RL2064.2 +021600 02 FILLER PIC X(58) VALUE RL2064.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2064.2 +021800 02 FILLER PIC X(28) VALUE RL2064.2 +021900 " COPYRIGHT 1985 ". RL2064.2 +022000 01 CCVS-E-1. RL2064.2 +022100 02 FILLER PIC X(52) VALUE SPACE. RL2064.2 +022200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2064.2 +022300 02 ID-AGAIN PIC X(9). RL2064.2 +022400 02 FILLER PIC X(45) VALUE SPACES. RL2064.2 +022500 01 CCVS-E-2. RL2064.2 +022600 02 FILLER PIC X(31) VALUE SPACE. RL2064.2 +022700 02 FILLER PIC X(21) VALUE SPACE. RL2064.2 +022800 02 CCVS-E-2-2. RL2064.2 +022900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2064.2 +023000 03 FILLER PIC X VALUE SPACE. RL2064.2 +023100 03 ENDER-DESC PIC X(44) VALUE RL2064.2 +023200 "ERRORS ENCOUNTERED". RL2064.2 +023300 01 CCVS-E-3. RL2064.2 +023400 02 FILLER PIC X(22) VALUE RL2064.2 +023500 " FOR OFFICIAL USE ONLY". RL2064.2 +023600 02 FILLER PIC X(12) VALUE SPACE. RL2064.2 +023700 02 FILLER PIC X(58) VALUE RL2064.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +023900 02 FILLER PIC X(13) VALUE SPACE. RL2064.2 +024000 02 FILLER PIC X(15) VALUE RL2064.2 +024100 " COPYRIGHT 1985". RL2064.2 +024200 01 CCVS-E-4. RL2064.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2064.2 +024400 02 FILLER PIC X(4) VALUE " OF ". RL2064.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2064.2 +024600 02 FILLER PIC X(40) VALUE RL2064.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". RL2064.2 +024800 01 XXINFO. RL2064.2 +024900 02 FILLER PIC X(19) VALUE RL2064.2 +025000 "*** INFORMATION ***". RL2064.2 +025100 02 INFO-TEXT. RL2064.2 +025200 04 FILLER PIC X(8) VALUE SPACE. RL2064.2 +025300 04 XXCOMPUTED PIC X(20). RL2064.2 +025400 04 FILLER PIC X(5) VALUE SPACE. RL2064.2 +025500 04 XXCORRECT PIC X(20). RL2064.2 +025600 02 INF-ANSI-REFERENCE PIC X(48). RL2064.2 +025700 01 HYPHEN-LINE. RL2064.2 +025800 02 FILLER PIC IS X VALUE IS SPACE. RL2064.2 +025900 02 FILLER PIC IS X(65) VALUE IS "************************RL2064.2 +026000- "*****************************************". RL2064.2 +026100 02 FILLER PIC IS X(54) VALUE IS "************************RL2064.2 +026200- "******************************". RL2064.2 +026300 01 CCVS-PGM-ID PIC X(9) VALUE RL2064.2 +026400 "RL206A". RL2064.2 +026500 PROCEDURE DIVISION. RL2064.2 +026600 CCVS1 SECTION. RL2064.2 +026700 OPEN-FILES. RL2064.2 +026800 OPEN OUTPUT PRINT-FILE. RL2064.2 +026900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2064.2 +027000 MOVE SPACE TO TEST-RESULTS. RL2064.2 +027100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2064.2 +027200 MOVE ZERO TO REC-SKL-SUB. RL2064.2 +027300 PERFORM CCVS-INIT-FILE 9 TIMES. RL2064.2 +027400 CCVS-INIT-FILE. RL2064.2 +027500 ADD 1 TO REC-SKL-SUB. RL2064.2 +027600 MOVE FILE-RECORD-INFO-SKELETON RL2064.2 +027700 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2064.2 +027800 CCVS-INIT-EXIT. RL2064.2 +027900 GO TO CCVS1-EXIT. RL2064.2 +028000 CLOSE-FILES. RL2064.2 +028100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2064.2 +028200 TERMINATE-CCVS. RL2064.2 +028300S EXIT PROGRAM. RL2064.2 +028400STERMINATE-CALL. RL2064.2 +028500 STOP RUN. RL2064.2 +028600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2064.2 +028700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2064.2 +028800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2064.2 +028900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2064.2 +029000 MOVE "****TEST DELETED****" TO RE-MARK. RL2064.2 +029100 PRINT-DETAIL. RL2064.2 +029200 IF REC-CT NOT EQUAL TO ZERO RL2064.2 +029300 MOVE "." TO PARDOT-X RL2064.2 +029400 MOVE REC-CT TO DOTVALUE. RL2064.2 +029500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2064.2 +029600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2064.2 +029700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2064.2 +029800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2064.2 +029900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2064.2 +030000 MOVE SPACE TO CORRECT-X. RL2064.2 +030100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2064.2 +030200 MOVE SPACE TO RE-MARK. RL2064.2 +030300 HEAD-ROUTINE. RL2064.2 +030400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +030500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +030600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2064.2 +030700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2064.2 +030800 COLUMN-NAMES-ROUTINE. RL2064.2 +030900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +031000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +031200 END-ROUTINE. RL2064.2 +031300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2064.2 +031400 END-RTN-EXIT. RL2064.2 +031500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +031600 END-ROUTINE-1. RL2064.2 +031700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2064.2 +031800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2064.2 +031900 ADD PASS-COUNTER TO ERROR-HOLD. RL2064.2 +032000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2064.2 +032100 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2064.2 +032200 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2064.2 +032300 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2064.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2064.2 +032500 END-ROUTINE-12. RL2064.2 +032600 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2064.2 +032700 IF ERROR-COUNTER IS EQUAL TO ZERO RL2064.2 +032800 MOVE "NO " TO ERROR-TOTAL RL2064.2 +032900 ELSE RL2064.2 +033000 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2064.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2064.2 +033200 PERFORM WRITE-LINE. RL2064.2 +033300 END-ROUTINE-13. RL2064.2 +033400 IF DELETE-COUNTER IS EQUAL TO ZERO RL2064.2 +033500 MOVE "NO " TO ERROR-TOTAL ELSE RL2064.2 +033600 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2064.2 +033700 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2064.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +033900 IF INSPECT-COUNTER EQUAL TO ZERO RL2064.2 +034000 MOVE "NO " TO ERROR-TOTAL RL2064.2 +034100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2064.2 +034200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2064.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +034400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +034500 WRITE-LINE. RL2064.2 +034600 ADD 1 TO RECORD-COUNT. RL2064.2 +034700Y IF RECORD-COUNT GREATER 50 RL2064.2 +034800Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2064.2 +034900Y MOVE SPACE TO DUMMY-RECORD RL2064.2 +035000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2064.2 +035100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2064.2 +035200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2064.2 +035300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2064.2 +035400Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2064.2 +035500Y MOVE ZERO TO RECORD-COUNT. RL2064.2 +035600 PERFORM WRT-LN. RL2064.2 +035700 WRT-LN. RL2064.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2064.2 +035900 MOVE SPACE TO DUMMY-RECORD. RL2064.2 +036000 BLANK-LINE-PRINT. RL2064.2 +036100 PERFORM WRT-LN. RL2064.2 +036200 FAIL-ROUTINE. RL2064.2 +036300 IF COMPUTED-X NOT EQUAL TO SPACE RL2064.2 +036400 GO TO FAIL-ROUTINE-WRITE. RL2064.2 +036500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2064.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2064.2 +036700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2064.2 +036800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +036900 MOVE SPACES TO INF-ANSI-REFERENCE. RL2064.2 +037000 GO TO FAIL-ROUTINE-EX. RL2064.2 +037100 FAIL-ROUTINE-WRITE. RL2064.2 +037200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2064.2 +037300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2064.2 +037400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2064.2 +037500 MOVE SPACES TO COR-ANSI-REFERENCE. RL2064.2 +037600 FAIL-ROUTINE-EX. EXIT. RL2064.2 +037700 BAIL-OUT. RL2064.2 +037800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2064.2 +037900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2064.2 +038000 BAIL-OUT-WRITE. RL2064.2 +038100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2064.2 +038200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2064.2 +038300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +038400 MOVE SPACES TO INF-ANSI-REFERENCE. RL2064.2 +038500 BAIL-OUT-EX. EXIT. RL2064.2 +038600 CCVS1-EXIT. RL2064.2 +038700 EXIT. RL2064.2 +038800 SECT-RL206A-001 SECTION. RL2064.2 +038900 REL-INIT-001. RL2064.2 +039000 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2064.2 +039100 OPEN OUTPUT RL-FS1. RL2064.2 +039200 MOVE "RL-FS1" TO XFILE-NAME (1). RL2064.2 +039300 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2064.2 +039400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2064.2 +039500 MOVE 000120 TO XRECORD-LENGTH (1). RL2064.2 +039600 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2064.2 +039700 MOVE 0001 TO XBLOCK-SIZE (1). RL2064.2 +039800 MOVE 000500 TO RECORDS-IN-FILE (1). RL2064.2 +039900 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2064.2 +040000 MOVE "S" TO XLABEL-TYPE (1). RL2064.2 +040100 MOVE 000001 TO XRECORD-NUMBER (1). RL2064.2 +040200 REL-TEST-001. RL2064.2 +040300 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-140-CHAR-AREA. RL2064.2 +040400 MOVE "ABCDEFGHIJKLMNOPQRST" TO EXTRA-20-CHARS. RL2064.2 +040500 MOVE NEW-140-CHAR-AREA TO RL-FS1R1-F-G-140. RL2064.2 +040600 IF XRECORD-NUMBER (1) > 32 RL2064.2 +040700 MOVE 140 TO WRK-SIZE. RL2064.2 +040800 IF XRECORD-NUMBER (1) = 32 RL2064.2 +040900 MOVE 135 TO WRK-SIZE. RL2064.2 +041000 IF XRECORD-NUMBER (1) = 31 RL2064.2 +041100 MOVE 125 TO WRK-SIZE. RL2064.2 +041200 IF XRECORD-NUMBER (1) < 31 RL2064.2 +041300 MOVE 140 TO WRK-SIZE. RL2064.2 +041400 IF XRECORD-NUMBER (1) < 21 RL2064.2 +041500 MOVE 130 TO WRK-SIZE. RL2064.2 +041600 IF XRECORD-NUMBER (1) < 11 RL2064.2 +041700 MOVE 120 TO WRK-SIZE. RL2064.2 +041800 WRITE RL-FS1R1-F-G-140 RL2064.2 +041900 INVALID KEY GO TO REL-FAIL-001. RL2064.2 +042000 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2064.2 +042100 GO TO REL-WRITE-001. RL2064.2 +042200 ADD 000001 TO XRECORD-NUMBER (1). RL2064.2 +042300 GO TO REL-TEST-001. RL2064.2 +042400 REL-DELETE-001. RL2064.2 +042500 PERFORM DE-LETE. RL2064.2 +042600 GO TO REL-WRITE-001. RL2064.2 +042700 REL-FAIL-001. RL2064.2 +042800 PERFORM FAIL. RL2064.2 +042900 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2064.2 +043000 REL-WRITE-001. RL2064.2 +043100 MOVE "REL-TEST-001" TO PAR-NAME RL2064.2 +043200 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2064.2 +043300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2064.2 +043400 PERFORM PRINT-DETAIL. RL2064.2 +043500 CLOSE RL-FS1. RL2064.2 +043600 REL-INIT-002. RL2064.2 +043700 OPEN INPUT RL-FS1. RL2064.2 +043800 MOVE ZERO TO WRK-CS-09V00. RL2064.2 +043900 REL-TEST-002. RL2064.2 +044000 READ RL-FS1 INTO NEW-140-CHAR-AREA RL2064.2 +044100 AT END GO TO REL-TEST-002-1. RL2064.2 +044200 ADD 1 TO WRK-CS-09V00. RL2064.2 +044300 IF WRK-CS-09V00 GREATER 500 RL2064.2 +044400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2064.2 +044500 GO TO REL-TEST-002-1. RL2064.2 +044600 PERFORM SIZE-TEST-1. RL2064.2 +044700 GO TO REL-TEST-002. RL2064.2 +044800 REL-DELETE-002. RL2064.2 +044900 PERFORM DE-LETE. RL2064.2 +045000 PERFORM PRINT-DETAIL. RL2064.2 +045100 REL-TEST-002-1. RL2064.2 +045200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2064.2 +045300 PERFORM FAIL RL2064.2 +045400 ELSE RL2064.2 +045500 PERFORM PASS. RL2064.2 +045600 GO TO REL-WRITE-002. RL2064.2 +045700 REL-WRITE-002. RL2064.2 +045800 MOVE "REL-TEST-002" TO PAR-NAME. RL2064.2 +045900 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2064.2 +046000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2064.2 +046100 PERFORM PRINT-DETAIL. RL2064.2 +046200 CLOSE RL-FS1. RL2064.2 +046300 GO TO CCVS-EXIT. RL2064.2 +046400 SIZE-TEST-1 SECTION. RL2064.2 +046500*=================== RL2064.2 +046600 REL-SIZE-TEST-1. RL2064.2 +046700 IF WRK-CS-09V00 > 32 RL2064.2 +046800 PERFORM SIZE-TEST-2. RL2064.2 +046900 IF WRK-CS-09V00 = 32 RL2064.2 +047000 PERFORM SIZE-TEST-3. RL2064.2 +047100 IF WRK-CS-09V00 = 31 RL2064.2 +047200 PERFORM SIZE-TEST-4. RL2064.2 +047300 IF WRK-CS-09V00 < 11 RL2064.2 +047400 PERFORM SIZE-TEST-7 RL2064.2 +047500 GO TO SIZE-TEST-1-EXIT. RL2064.2 +047600 IF WRK-CS-09V00 < 21 RL2064.2 +047700 PERFORM SIZE-TEST-6 RL2064.2 +047800 GO TO SIZE-TEST-1-EXIT. RL2064.2 +047900 IF WRK-CS-09V00 < 31 RL2064.2 +048000 PERFORM SIZE-TEST-5. RL2064.2 +048100 SIZE-TEST-1-EXIT. RL2064.2 +048200 EXIT. RL2064.2 +048300 SIZE-TEST-2 SECTION. RL2064.2 +048400 REL-SIZE-TEST-2. RL2064.2 +048500 IF WRK-SIZE NOT = 140 RL2064.2 +048600 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +048700 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +048800 MOVE 140 TO CORRECT-18V0 RL2064.2 +048900 PERFORM FAIL RL2064.2 +049000 PERFORM PRINT-DETAIL RL2064.2 +049100 ELSE RL2064.2 +049200 PERFORM PASS. RL2064.2 +049300* PERFORM PRINT-DETAIL. RL2064.2 +049400 SIZE-TEST-2-EXIT. RL2064.2 +049500 EXIT. RL2064.2 +049600 SIZE-TEST-3 SECTION. RL2064.2 +049700 REL-SIZE-TEST-3. RL2064.2 +049800 IF WRK-SIZE NOT = 135 RL2064.2 +049900 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +050000 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +050100 MOVE 135 TO CORRECT-18V0 RL2064.2 +050200 PERFORM FAIL RL2064.2 +050300 PERFORM PRINT-DETAIL RL2064.2 +050400 ELSE RL2064.2 +050500 PERFORM PASS. RL2064.2 +050600* PERFORM PRINT-DETAIL. RL2064.2 +050700 SIZE-TEST-3-EXIT. RL2064.2 +050800 EXIT. RL2064.2 +050900 SIZE-TEST-4 SECTION. RL2064.2 +051000 REL-SIZE-TEST-4. RL2064.2 +051100 IF WRK-SIZE NOT = 125 RL2064.2 +051200 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +051300 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +051400 MOVE 125 TO CORRECT-18V0 RL2064.2 +051500 PERFORM FAIL RL2064.2 +051600 PERFORM PRINT-DETAIL RL2064.2 +051700 ELSE RL2064.2 +051800 PERFORM PASS. RL2064.2 +051900* PERFORM PRINT-DETAIL. RL2064.2 +052000 SIZE-TEST-4-EXIT. RL2064.2 +052100 EXIT. RL2064.2 +052200 SIZE-TEST-5 SECTION. RL2064.2 +052300 REL-SIZE-TEST-5. RL2064.2 +052400 IF WRK-SIZE NOT = 140 RL2064.2 +052500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +052600 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +052700 MOVE 140 TO CORRECT-18V0 RL2064.2 +052800 PERFORM FAIL RL2064.2 +052900 PERFORM PRINT-DETAIL RL2064.2 +053000 ELSE RL2064.2 +053100 PERFORM PASS. RL2064.2 +053200* PERFORM PRINT-DETAIL. RL2064.2 +053300 SIZE-TEST-5-EXIT. RL2064.2 +053400 EXIT. RL2064.2 +053500 SIZE-TEST-6 SECTION. RL2064.2 +053600 REL-SIZE-TEST-6. RL2064.2 +053700 IF WRK-SIZE NOT = 130 RL2064.2 +053800 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +053900 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +054000 MOVE 130 TO CORRECT-18V0 RL2064.2 +054100 PERFORM FAIL RL2064.2 +054200 PERFORM PRINT-DETAIL RL2064.2 +054300 ELSE RL2064.2 +054400 PERFORM PASS. RL2064.2 +054500* PERFORM PRINT-DETAIL. RL2064.2 +054600 SIZE-TEST-6-EXIT. RL2064.2 +054700 EXIT. RL2064.2 +054800 SIZE-TEST-7 SECTION. RL2064.2 +054900 REL-SIZE-TEST-7. RL2064.2 +055000 IF WRK-SIZE NOT = 120 RL2064.2 +055100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +055200 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +055300 MOVE 120 TO CORRECT-18V0 RL2064.2 +055400 PERFORM FAIL RL2064.2 +055500 PERFORM PRINT-DETAIL RL2064.2 +055600 ELSE RL2064.2 +055700 PERFORM PASS. RL2064.2 +055800* PERFORM PRINT-DETAIL. RL2064.2 +055900 SIZE-TEST-7-EXIT. RL2064.2 +056000 EXIT. RL2064.2 +056100 CCVS-EXIT SECTION. RL2064.2 +056200 CCVS-999999. RL2064.2 +056300 GO TO CLOSE-FILES. RL2064.2 +*END-OF,RL206A +*HEADER,COBOL,RL206A,SUBPRG,RL207A +000100 IDENTIFICATION DIVISION. RL2074.2 +000200 PROGRAM-ID. RL2074.2 +000300 RL207A. RL2074.2 +000400**************************************************************** RL2074.2 +000500* * RL2074.2 +000600* VALIDATION FOR:- * RL2074.2 +000700* * RL2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +000900* * RL2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2074.2 +001100* * RL2074.2 +001200**************************************************************** RL2074.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL2074.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS DYNAMIC). THE FILE RL2074.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL206A. RL2074.2 +001600* RL2074.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL2074.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL2074.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL2074.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL2074.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2074.2 +002200* RL2074.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2074.2 +002400* PROGRAM ARE: RL2074.2 +002500* RL2074.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2074.2 +002700* RELATIVE I-O DATA FILE RL2074.2 +002800* X-55 SYSTEM PRINTER RL2074.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2074.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2074.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2074.2 +003200* X-82 SOURCE-COMPUTER RL2074.2 +003300* X-83 OBJECT-COMPUTER. RL2074.2 +003400* RL2074.2 +003500**************************************************************** RL2074.2 +003600 ENVIRONMENT DIVISION. RL2074.2 +003700 CONFIGURATION SECTION. RL2074.2 +003800 SOURCE-COMPUTER. RL2074.2 +003900 XXXXX082. RL2074.2 +004000 OBJECT-COMPUTER. RL2074.2 +004100 XXXXX083. RL2074.2 +004200 INPUT-OUTPUT SECTION. RL2074.2 +004300 FILE-CONTROL. RL2074.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2074.2 +004500 XXXXX055. RL2074.2 +004600 SELECT RL-FD1 ASSIGN TO RL2074.2 +004700 XXXXP021 RL2074.2 +004800 ORGANIZATION IS RELATIVE RL2074.2 +004900 ACCESS MODE IS DYNAMIC RL2074.2 +005000 RELATIVE KEY RL-FD1-KEY RL2074.2 +005100 STATUS WS-STATUS. RL2074.2 +005200 DATA DIVISION. RL2074.2 +005300 FILE SECTION. RL2074.2 +005400 FD PRINT-FILE. RL2074.2 +005500 01 PRINT-REC PICTURE X(120). RL2074.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL2074.2 +005700 FD RL-FD1 RL2074.2 +005800 LABEL RECORDS STANDARD RL2074.2 +005900C VALUE OF RL2074.2 +006000C XXXXX074 RL2074.2 +006100C IS RL2074.2 +006200C XXXXX075 RL2074.2 +006300G XXXXX069 RL2074.2 +006400 BLOCK CONTAINS 1 RECORDS RL2074.2 +006500 RECORD VARYING 120 TO 140 DEPENDING WRK-SIZE. RL2074.2 +006600 01 RL-FD1R1-F-G-140. RL2074.2 +006700 02 FILLER PICTURE X(140). RL2074.2 +006800 WORKING-STORAGE SECTION. RL2074.2 +006900 01 WS-STATUS PIC XX. RL2074.2 +007000 01 WRK-SIZE PIC 999. RL2074.2 +007100 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007200 01 RL-FD1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL2074.2 +007300 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL2074.2 +007400 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007500 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007600 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2074.2 +007700 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007800 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007900 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +008000 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL2074.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL2074.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL2074.2 +008300 05 FILLER PICTURE X(48) VALUE RL2074.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2074.2 +008500 05 FILLER PICTURE X(46) VALUE RL2074.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2074.2 +008700 05 FILLER PICTURE X(26) VALUE RL2074.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL2074.2 +008900 05 FILLER PICTURE X(37) VALUE RL2074.2 +009000 ",RECKEY= ". RL2074.2 +009100 05 FILLER PICTURE X(38) VALUE RL2074.2 +009200 ",ALTKEY1= ". RL2074.2 +009300 05 FILLER PICTURE X(38) VALUE RL2074.2 +009400 ",ALTKEY2= ". RL2074.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL2074.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2074.2 +009700 05 FILE-RECORD-INFO-P1-120. RL2074.2 +009800 07 FILLER PIC X(5). RL2074.2 +009900 07 XFILE-NAME PIC X(6). RL2074.2 +010000 07 FILLER PIC X(8). RL2074.2 +010100 07 XRECORD-NAME PIC X(6). RL2074.2 +010200 07 FILLER PIC X(1). RL2074.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL2074.2 +010400 07 FILLER PIC X(7). RL2074.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL2074.2 +010600 07 FILLER PIC X(6). RL2074.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL2074.2 +010800 07 FILLER PIC X(5). RL2074.2 +010900 07 ODO-NUMBER PIC 9(4). RL2074.2 +011000 07 FILLER PIC X(5). RL2074.2 +011100 07 XPROGRAM-NAME PIC X(5). RL2074.2 +011200 07 FILLER PIC X(7). RL2074.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL2074.2 +011400 07 FILLER PIC X(7). RL2074.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL2074.2 +011600 07 FILLER PIC X(1). RL2074.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL2074.2 +011800 07 FILLER PIC X(6). RL2074.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL2074.2 +012000 07 FILLER PIC X(5). RL2074.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL2074.2 +012200 07 FILLER PIC X(6). RL2074.2 +012300 07 XLABEL-TYPE PIC X(1). RL2074.2 +012400 05 FILE-RECORD-INFO-P121-240. RL2074.2 +012500 07 FILLER PIC X(8). RL2074.2 +012600 07 XRECORD-KEY PIC X(29). RL2074.2 +012700 07 FILLER PIC X(9). RL2074.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL2074.2 +012900 07 FILLER PIC X(9). RL2074.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL2074.2 +013100 07 FILLER PIC X(7). RL2074.2 +013200 01 NEW-115-CHAR-AREA. RL2074.2 +013300 03 NEW-115-120 PIC X(115). RL2074.2 +013400 01 NEW-125-CHAR-AREA. RL2074.2 +013500 03 NEW-125-120 PIC X(120). RL2074.2 +013600 03 EXTRA-5-CHARS PIC X(5). RL2074.2 +013700 01 NEW-128-CHAR-AREA. RL2074.2 +013800 03 NEW-128-120 PIC X(120). RL2074.2 +013900 03 EXTRA-8-CHARS PIC X(8). RL2074.2 +014000 01 NEW-130-CHAR-AREA. RL2074.2 +014100 03 NEW-130-120 PIC X(120). RL2074.2 +014200 03 EXTRA-10-CHARS PIC X(10). RL2074.2 +014300 01 NEW-132-CHAR-AREA. RL2074.2 +014400 03 NEW-132-120 PIC X(120). RL2074.2 +014500 03 EXTRA-12-CHARS PIC X(12). RL2074.2 +014600 01 NEW-135-CHAR-AREA. RL2074.2 +014700 03 NEW-135-120 PIC X(120). RL2074.2 +014800 03 EXTRA-15-CHARS PIC X(15). RL2074.2 +014900 01 NEW-140-CHAR-AREA. RL2074.2 +015000 03 NEW-140-120 PIC X(120). RL2074.2 +015100 03 EXTRA-20-CHARS PIC X(20). RL2074.2 +015200 01 NEW-145-CHAR-AREA. RL2074.2 +015300 03 NEW-145-120 PIC X(120). RL2074.2 +015400 03 EXTRA-25-CHARS PIC X(25). RL2074.2 +015500 RL2074.2 +015600 01 TEST-RESULTS. RL2074.2 +015700 02 FILLER PIC X VALUE SPACE. RL2074.2 +015800 02 FEATURE PIC X(20) VALUE SPACE. RL2074.2 +015900 02 FILLER PIC X VALUE SPACE. RL2074.2 +016000 02 P-OR-F PIC X(5) VALUE SPACE. RL2074.2 +016100 02 FILLER PIC X VALUE SPACE. RL2074.2 +016200 02 PAR-NAME. RL2074.2 +016300 03 FILLER PIC X(19) VALUE SPACE. RL2074.2 +016400 03 PARDOT-X PIC X VALUE SPACE. RL2074.2 +016500 03 DOTVALUE PIC 99 VALUE ZERO. RL2074.2 +016600 02 FILLER PIC X(8) VALUE SPACE. RL2074.2 +016700 02 RE-MARK PIC X(61). RL2074.2 +016800 01 TEST-COMPUTED. RL2074.2 +016900 02 FILLER PIC X(30) VALUE SPACE. RL2074.2 +017000 02 FILLER PIC X(17) VALUE RL2074.2 +017100 " COMPUTED=". RL2074.2 +017200 02 COMPUTED-X. RL2074.2 +017300 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2074.2 +017400 03 COMPUTED-N REDEFINES COMPUTED-A RL2074.2 +017500 PIC -9(9).9(9). RL2074.2 +017600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2074.2 +017700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2074.2 +017800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2074.2 +017900 03 CM-18V0 REDEFINES COMPUTED-A. RL2074.2 +018000 04 COMPUTED-18V0 PIC -9(18). RL2074.2 +018100 04 FILLER PIC X. RL2074.2 +018200 03 FILLER PIC X(50) VALUE SPACE. RL2074.2 +018300 01 TEST-CORRECT. RL2074.2 +018400 02 FILLER PIC X(30) VALUE SPACE. RL2074.2 +018500 02 FILLER PIC X(17) VALUE " CORRECT =". RL2074.2 +018600 02 CORRECT-X. RL2074.2 +018700 03 CORRECT-A PIC X(20) VALUE SPACE. RL2074.2 +018800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2074.2 +018900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2074.2 +019000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2074.2 +019100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2074.2 +019200 03 CR-18V0 REDEFINES CORRECT-A. RL2074.2 +019300 04 CORRECT-18V0 PIC -9(18). RL2074.2 +019400 04 FILLER PIC X. RL2074.2 +019500 03 FILLER PIC X(2) VALUE SPACE. RL2074.2 +019600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2074.2 +019700 01 CCVS-C-1. RL2074.2 +019800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2074.2 +019900- "SS PARAGRAPH-NAME RL2074.2 +020000- " REMARKS". RL2074.2 +020100 02 FILLER PIC X(20) VALUE SPACE. RL2074.2 +020200 01 CCVS-C-2. RL2074.2 +020300 02 FILLER PIC X VALUE SPACE. RL2074.2 +020400 02 FILLER PIC X(6) VALUE "TESTED". RL2074.2 +020500 02 FILLER PIC X(15) VALUE SPACE. RL2074.2 +020600 02 FILLER PIC X(4) VALUE "FAIL". RL2074.2 +020700 02 FILLER PIC X(94) VALUE SPACE. RL2074.2 +020800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2074.2 +020900 01 REC-CT PIC 99 VALUE ZERO. RL2074.2 +021000 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021100 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021300 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021400 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2074.2 +021500 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2074.2 +021600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2074.2 +021700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2074.2 +021800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2074.2 +021900 01 CCVS-H-1. RL2074.2 +022000 02 FILLER PIC X(39) VALUE SPACES. RL2074.2 +022100 02 FILLER PIC X(42) VALUE RL2074.2 +022200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2074.2 +022300 02 FILLER PIC X(39) VALUE SPACES. RL2074.2 +022400 01 CCVS-H-2A. RL2074.2 +022500 02 FILLER PIC X(40) VALUE SPACE. RL2074.2 +022600 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2074.2 +022700 02 FILLER PIC XXXX VALUE RL2074.2 +022800 "4.2 ". RL2074.2 +022900 02 FILLER PIC X(28) VALUE RL2074.2 +023000 " COPY - NOT FOR DISTRIBUTION". RL2074.2 +023100 02 FILLER PIC X(41) VALUE SPACE. RL2074.2 +023200 RL2074.2 +023300 01 CCVS-H-2B. RL2074.2 +023400 02 FILLER PIC X(15) VALUE RL2074.2 +023500 "TEST RESULT OF ". RL2074.2 +023600 02 TEST-ID PIC X(9). RL2074.2 +023700 02 FILLER PIC X(4) VALUE RL2074.2 +023800 " IN ". RL2074.2 +023900 02 FILLER PIC X(12) VALUE RL2074.2 +024000 " HIGH ". RL2074.2 +024100 02 FILLER PIC X(22) VALUE RL2074.2 +024200 " LEVEL VALIDATION FOR ". RL2074.2 +024300 02 FILLER PIC X(58) VALUE RL2074.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +024500 01 CCVS-H-3. RL2074.2 +024600 02 FILLER PIC X(34) VALUE RL2074.2 +024700 " FOR OFFICIAL USE ONLY ". RL2074.2 +024800 02 FILLER PIC X(58) VALUE RL2074.2 +024900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2074.2 +025000 02 FILLER PIC X(28) VALUE RL2074.2 +025100 " COPYRIGHT 1985 ". RL2074.2 +025200 01 CCVS-E-1. RL2074.2 +025300 02 FILLER PIC X(52) VALUE SPACE. RL2074.2 +025400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2074.2 +025500 02 ID-AGAIN PIC X(9). RL2074.2 +025600 02 FILLER PIC X(45) VALUE SPACES. RL2074.2 +025700 01 CCVS-E-2. RL2074.2 +025800 02 FILLER PIC X(31) VALUE SPACE. RL2074.2 +025900 02 FILLER PIC X(21) VALUE SPACE. RL2074.2 +026000 02 CCVS-E-2-2. RL2074.2 +026100 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2074.2 +026200 03 FILLER PIC X VALUE SPACE. RL2074.2 +026300 03 ENDER-DESC PIC X(44) VALUE RL2074.2 +026400 "ERRORS ENCOUNTERED". RL2074.2 +026500 01 CCVS-E-3. RL2074.2 +026600 02 FILLER PIC X(22) VALUE RL2074.2 +026700 " FOR OFFICIAL USE ONLY". RL2074.2 +026800 02 FILLER PIC X(12) VALUE SPACE. RL2074.2 +026900 02 FILLER PIC X(58) VALUE RL2074.2 +027000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +027100 02 FILLER PIC X(13) VALUE SPACE. RL2074.2 +027200 02 FILLER PIC X(15) VALUE RL2074.2 +027300 " COPYRIGHT 1985". RL2074.2 +027400 01 CCVS-E-4. RL2074.2 +027500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2074.2 +027600 02 FILLER PIC X(4) VALUE " OF ". RL2074.2 +027700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2074.2 +027800 02 FILLER PIC X(40) VALUE RL2074.2 +027900 " TESTS WERE EXECUTED SUCCESSFULLY". RL2074.2 +028000 01 XXINFO. RL2074.2 +028100 02 FILLER PIC X(19) VALUE RL2074.2 +028200 "*** INFORMATION ***". RL2074.2 +028300 02 INFO-TEXT. RL2074.2 +028400 04 FILLER PIC X(8) VALUE SPACE. RL2074.2 +028500 04 XXCOMPUTED PIC X(20). RL2074.2 +028600 04 FILLER PIC X(5) VALUE SPACE. RL2074.2 +028700 04 XXCORRECT PIC X(20). RL2074.2 +028800 02 INF-ANSI-REFERENCE PIC X(48). RL2074.2 +028900 01 HYPHEN-LINE. RL2074.2 +029000 02 FILLER PIC IS X VALUE IS SPACE. RL2074.2 +029100 02 FILLER PIC IS X(65) VALUE IS "************************RL2074.2 +029200- "*****************************************". RL2074.2 +029300 02 FILLER PIC IS X(54) VALUE IS "************************RL2074.2 +029400- "******************************". RL2074.2 +029500 01 CCVS-PGM-ID PIC X(9) VALUE RL2074.2 +029600 "RL207A". RL2074.2 +029700 PROCEDURE DIVISION. RL2074.2 +029800 CCVS1 SECTION. RL2074.2 +029900 OPEN-FILES. RL2074.2 +030000 OPEN OUTPUT PRINT-FILE. RL2074.2 +030100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2074.2 +030200 MOVE SPACE TO TEST-RESULTS. RL2074.2 +030300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2074.2 +030400 MOVE ZERO TO REC-SKL-SUB. RL2074.2 +030500 PERFORM CCVS-INIT-FILE 9 TIMES. RL2074.2 +030600 CCVS-INIT-FILE. RL2074.2 +030700 ADD 1 TO REC-SKL-SUB. RL2074.2 +030800 MOVE FILE-RECORD-INFO-SKELETON RL2074.2 +030900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2074.2 +031000 CCVS-INIT-EXIT. RL2074.2 +031100 GO TO CCVS1-EXIT. RL2074.2 +031200 CLOSE-FILES. RL2074.2 +031300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2074.2 +031400 TERMINATE-CCVS. RL2074.2 +031500S EXIT PROGRAM. RL2074.2 +031600STERMINATE-CALL. RL2074.2 +031700 STOP RUN. RL2074.2 +031800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2074.2 +031900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2074.2 +032000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2074.2 +032100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2074.2 +032200 MOVE "****TEST DELETED****" TO RE-MARK. RL2074.2 +032300 PRINT-DETAIL. RL2074.2 +032400 IF REC-CT NOT EQUAL TO ZERO RL2074.2 +032500 MOVE "." TO PARDOT-X RL2074.2 +032600 MOVE REC-CT TO DOTVALUE. RL2074.2 +032700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2074.2 +032800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2074.2 +032900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2074.2 +033000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2074.2 +033100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2074.2 +033200 MOVE SPACE TO CORRECT-X. RL2074.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2074.2 +033400 MOVE SPACE TO RE-MARK. RL2074.2 +033500 HEAD-ROUTINE. RL2074.2 +033600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +033700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +033800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2074.2 +033900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2074.2 +034000 COLUMN-NAMES-ROUTINE. RL2074.2 +034100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +034200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +034400 END-ROUTINE. RL2074.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2074.2 +034600 END-RTN-EXIT. RL2074.2 +034700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +034800 END-ROUTINE-1. RL2074.2 +034900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2074.2 +035000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2074.2 +035100 ADD PASS-COUNTER TO ERROR-HOLD. RL2074.2 +035200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2074.2 +035300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2074.2 +035400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2074.2 +035500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2074.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2074.2 +035700 END-ROUTINE-12. RL2074.2 +035800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2074.2 +035900 IF ERROR-COUNTER IS EQUAL TO ZERO RL2074.2 +036000 MOVE "NO " TO ERROR-TOTAL RL2074.2 +036100 ELSE RL2074.2 +036200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2074.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2074.2 +036400 PERFORM WRITE-LINE. RL2074.2 +036500 END-ROUTINE-13. RL2074.2 +036600 IF DELETE-COUNTER IS EQUAL TO ZERO RL2074.2 +036700 MOVE "NO " TO ERROR-TOTAL ELSE RL2074.2 +036800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2074.2 +036900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2074.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037100 IF INSPECT-COUNTER EQUAL TO ZERO RL2074.2 +037200 MOVE "NO " TO ERROR-TOTAL RL2074.2 +037300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2074.2 +037400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2074.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037700 WRITE-LINE. RL2074.2 +037800 ADD 1 TO RECORD-COUNT. RL2074.2 +037900Y IF RECORD-COUNT GREATER 50 RL2074.2 +038000Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2074.2 +038100Y MOVE SPACE TO DUMMY-RECORD RL2074.2 +038200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2074.2 +038300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2074.2 +038400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2074.2 +038500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2074.2 +038600Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2074.2 +038700Y MOVE ZERO TO RECORD-COUNT. RL2074.2 +038800 PERFORM WRT-LN. RL2074.2 +038900 WRT-LN. RL2074.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2074.2 +039100 MOVE SPACE TO DUMMY-RECORD. RL2074.2 +039200 BLANK-LINE-PRINT. RL2074.2 +039300 PERFORM WRT-LN. RL2074.2 +039400 FAIL-ROUTINE. RL2074.2 +039500 IF COMPUTED-X NOT EQUAL TO SPACE RL2074.2 +039600 GO TO FAIL-ROUTINE-WRITE. RL2074.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2074.2 +039800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2074.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2074.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +040100 MOVE SPACES TO INF-ANSI-REFERENCE. RL2074.2 +040200 GO TO FAIL-ROUTINE-EX. RL2074.2 +040300 FAIL-ROUTINE-WRITE. RL2074.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2074.2 +040500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2074.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2074.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. RL2074.2 +040800 FAIL-ROUTINE-EX. EXIT. RL2074.2 +040900 BAIL-OUT. RL2074.2 +041000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2074.2 +041100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2074.2 +041200 BAIL-OUT-WRITE. RL2074.2 +041300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2074.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2074.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL2074.2 +041700 BAIL-OUT-EX. EXIT. RL2074.2 +041800 CCVS1-EXIT. RL2074.2 +041900 EXIT. RL2074.2 +042000 SECT-RL207A-001 SECTION. RL2074.2 +042100 REL-INIT-003. RL2074.2 +042200 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL2074.2 +042300 OPEN INPUT RL-FD1. RL2074.2 +042400 MOVE "REL-TEST-003" TO PAR-NAME. RL2074.2 +042500 MOVE ZERO TO RL-FD1-KEY. RL2074.2 +042600 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +042700 MOVE ZERO TO WRK-CS-09V00-003. RL2074.2 +042800* RL2074.2 +042900 MOVE 01 TO REC-CT. RL2074.2 +043000 MOVE "READ RANDOM" TO FEATURE. RL2074.2 +043100 REL-TEST-003-R. RL2074.2 +043200 ADD 1 TO WRK-CS-09V00-003. RL2074.2 +043300 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +043400 IF RL-FD1-KEY GREATER +501 RL2074.2 +043500 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL2074.2 +043600 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2074.2 +043700 PERFORM FAIL RL2074.2 +043800 PERFORM PRINT-DETAIL RL2074.2 +043900 ADD 1 TO REC-CT RL2074.2 +044000 GO TO REL-WRITE-003. RL2074.2 +044100 READ RL-FD1 RL2074.2 +044200 INVALID KEY GO TO REL-WRITE-003. RL2074.2 +044300 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +044400 IF XRECORD-NUMBER (1) EQUAL TO RL-FD1-KEY RL2074.2 +044500 GO TO REL-TEST-003-R. RL2074.2 +044600 MOVE "YES" TO I-O-ERROR-RL-FD1. RL2074.2 +044700 ADD 1 TO WRK-CS-09V00-002. RL2074.2 +044800 GO TO REL-TEST-003-R. RL2074.2 +044900 REL-WRITE-003. RL2074.2 +045000 IF RL-FD1-KEY NOT EQUAL TO 501 RL2074.2 +045100 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL2074.2 +045200 MOVE RL-FD1-KEY TO COMPUTED-18V0 RL2074.2 +045300 PERFORM FAIL RL2074.2 +045400 ELSE RL2074.2 +045500 PERFORM PASS. RL2074.2 +045600 PERFORM PRINT-DETAIL. RL2074.2 +045700* RL2074.2 +045800*01 RL2074.2 +045900* RL2074.2 +046000 ADD 1 TO REC-CT. RL2074.2 +046100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2074.2 +046200 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL2074.2 +046300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL2074.2 +046400 PERFORM FAIL RL2074.2 +046500 ELSE RL2074.2 +046600 PERFORM PASS. RL2074.2 +046700 PERFORM PRINT-DETAIL. RL2074.2 +046800* RL2074.2 +046900*02 RL2074.2 +047000* RL2074.2 +047100 ADD 1 TO REC-CT. RL2074.2 +047200 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL2074.2 +047300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2074.2 +047400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2074.2 +047500 MOVE 501 TO CORRECT-18V0 RL2074.2 +047600 PERFORM FAIL RL2074.2 +047700 ELSE RL2074.2 +047800 PERFORM PASS. RL2074.2 +047900 PERFORM PRINT-DETAIL. RL2074.2 +048000* RL2074.2 +048100*03 RL2074.2 +048200* RL2074.2 +048300 ADD 1 TO REC-CT. RL2074.2 +048400 IF I-O-ERROR-RL-FD1 EQUAL TO "YES" RL2074.2 +048500 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL2074.2 +048600 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL2074.2 +048700 PERFORM FAIL RL2074.2 +048800 ELSE RL2074.2 +048900 PERFORM PASS. RL2074.2 +049000 PERFORM PRINT-DETAIL. RL2074.2 +049100* RL2074.2 +049200*04 RL2074.2 +049300* RL2074.2 +049400 ADD 1 TO REC-CT. RL2074.2 +049500 CLOSE RL-FD1. RL2074.2 +049600 REL-INIT-004-R . RL2074.2 +049700 MOVE "REL-TEST-004" TO PAR-NAME. RL2074.2 +049800 OPEN I-O RL-FD1. RL2074.2 +049900 MOVE ZERO TO RL-FD1-KEY. RL2074.2 +050000 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +050100 MOVE ZERO TO WRK-CS-09V00-003. RL2074.2 +050200 MOVE ZERO TO WRK-CS-09V00-004. RL2074.2 +050300 MOVE ZERO TO WRK-CS-09V00-005. RL2074.2 +050400* RL2074.2 +050500 MOVE 01 TO REC-CT. RL2074.2 +050600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +050700 MOVE "REWRITE" TO FEATURE. RL2074.2 +050800 REL-TEST-004-R. RL2074.2 +050900 ADD 5 TO WRK-CS-09V00-003. RL2074.2 +051000 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +051100 IF RL-FD1-KEY GREATER 505 RL2074.2 +051200 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL2074.2 +051300 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2074.2 +051400 PERFORM FAIL RL2074.2 +051500 PERFORM PRINT-DETAIL RL2074.2 +051600 ADD 1 TO REC-CT RL2074.2 +051700 GO TO REL-TEST-004-3. RL2074.2 +051800 READ RL-FD1 RL2074.2 +051900 INVALID KEY GO TO REL-TEST-004-1. RL2074.2 +052000 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1) RL2074.2 +052100 ADD 01 TO UPDATE-NUMBER (1). RL2074.2 +052200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2074.2 +052300 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2074.2 +052400 REWRITE RL-FD1R1-F-G-140 RL2074.2 +052500 INVALID KEY GO TO REL-TEST-004-2. RL2074.2 +052600 GO TO REL-TEST-004-R. RL2074.2 +052700 REL-TEST-004-1. RL2074.2 +052800 IF RL-FD1-KEY LESS THAN 501 RL2074.2 +052900 ADD 1 TO WRK-CS-09V00-004 RL2074.2 +053000 GO TO REL-TEST-004-R. RL2074.2 +053100 PERFORM PASS. RL2074.2 +053200 PERFORM PRINT-DETAIL. RL2074.2 +053300* RL2074.2 +053400*01 RL2074.2 +053500* RL2074.2 +053600 ADD 1 TO REC-CT. RL2074.2 +053700 GO TO REL-TEST-004-3. RL2074.2 +053800 REL-TEST-004-2. RL2074.2 +053900 ADD 1 TO WRK-CS-09V00-005. RL2074.2 +054000 IF RL-FD1-KEY LESS 501 RL2074.2 +054100 GO TO REL-TEST-004-R. RL2074.2 +054200 REL-TEST-004-3. RL2074.2 +054300 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL2074.2 +054400 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL2074.2 +054500 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2074.2 +054600 PERFORM FAIL RL2074.2 +054700 ELSE RL2074.2 +054800 PERFORM PASS. RL2074.2 +054900 PERFORM PRINT-DETAIL. RL2074.2 +055000* RL2074.2 +055100*02 RL2074.2 +055200* RL2074.2 +055300 ADD 1 TO REC-CT. RL2074.2 +055400 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL2074.2 +055500 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL2074.2 +055600 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2074.2 +055700 PERFORM FAIL RL2074.2 +055800 ELSE RL2074.2 +055900 PERFORM PASS. RL2074.2 +056000 PERFORM PRINT-DETAIL. RL2074.2 +056100* RL2074.2 +056200*03 RL2074.2 +056300* RL2074.2 +056400 ADD 1 TO REC-CT. RL2074.2 +056500 CLOSE RL-FD1. RL2074.2 +056600 REL-INIT-005. RL2074.2 +056700 MOVE "REL-TEST-005" TO PAR-NAME. RL2074.2 +056800 OPEN INPUT RL-FD1. RL2074.2 +056900 MOVE 501 TO WRK-CS-09V00-003. RL2074.2 +057000 MOVE ZERO TO WRK-CS-09V00-004. RL2074.2 +057100 MOVE ZERO TO WRK-CS-09V00-005. RL2074.2 +057200 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +057300 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +057400 MOVE 01 TO REC-CT. RL2074.2 +057500* RL2074.2 +057600 MOVE "READ RANDOM" TO FEATURE. RL2074.2 +057700 REL-TEST-005-R. RL2074.2 +057800 SUBTRACT 1 FROM WRK-CS-09V00-003. RL2074.2 +057900 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +058000 IF WRK-CS-09V00-003 LESS THAN ZERO RL2074.2 +058100 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL2074.2 +058200 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2074.2 +058300 MOVE ZERO TO CORRECT-18V0 RL2074.2 +058400 PERFORM FAIL RL2074.2 +058500 PERFORM PRINT-DETAIL RL2074.2 +058600 ADD 1 TO REC-CT RL2074.2 +058700 GO TO REL-TEST-005-3. RL2074.2 +058800 READ RL-FD1 RL2074.2 +058900 INVALID KEY GO TO REL-TEST-005-1. RL2074.2 +059000 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +059100 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2074.2 +059200 ADD 1 TO WRK-CS-09V00-004. RL2074.2 +059300 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2074.2 +059400 ADD 1 TO WRK-CS-09V00-005. RL2074.2 +059500 GO TO REL-TEST-005-R. RL2074.2 +059600 REL-TEST-005-1. RL2074.2 +059700 IF RL-FD1-KEY GREATER ZERO RL2074.2 +059800 ADD 1 TO WRK-CS-09V00-002 RL2074.2 +059900 GO TO REL-TEST-005-R. RL2074.2 +060000 PERFORM PASS. RL2074.2 +060100 PERFORM PRINT-DETAIL. RL2074.2 +060200 ADD 1 TO REC-CT. RL2074.2 +060300*01 RL2074.2 +060400 GO TO REL-TEST-005-3. RL2074.2 +060500 REL-TEST-005-3. RL2074.2 +060600 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL2074.2 +060700 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2074.2 +060800 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2074.2 +060900 MOVE "SHOULD BE 400" TO RE-MARK RL2074.2 +061000 PERFORM FAIL RL2074.2 +061100 ELSE RL2074.2 +061200 PERFORM PASS. RL2074.2 +061300 PERFORM PRINT-DETAIL. RL2074.2 +061400* RL2074.2 +061500* RL2074.2 +061600*02 RL2074.2 +061700* RL2074.2 +061800 ADD 1 TO REC-CT. RL2074.2 +061900 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL2074.2 +062000 MOVE "UPDATED RECORDS" TO COMPUTED-A RL2074.2 +062100 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2074.2 +062200 MOVE "SHOULD BE 100" TO RE-MARK RL2074.2 +062300 PERFORM FAIL RL2074.2 +062400 ELSE RL2074.2 +062500 PERFORM PASS. RL2074.2 +062600 PERFORM PRINT-DETAIL. RL2074.2 +062700* RL2074.2 +062800*03 RL2074.2 +062900* RL2074.2 +063000 ADD 1 TO REC-CT. RL2074.2 +063100 IF WRK-CS-09V00-002 GREATER 1 RL2074.2 +063200 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL2074.2 +063300 MOVE "INVALID KEY/READS" TO CORRECT-A RL2074.2 +063400 PERFORM FAIL RL2074.2 +063500 ELSE RL2074.2 +063600 PERFORM PASS. RL2074.2 +063700 PERFORM PRINT-DETAIL. RL2074.2 +063800* RL2074.2 +063900*04 RL2074.2 +064000* RL2074.2 +064100 ADD 1 TO REC-CT. RL2074.2 +064200 CLOSE RL-FD1. RL2074.2 +064300 REL-INIT-006. RL2074.2 +064400 MOVE "REL-TEST-006" TO PAR-NAME. RL2074.2 +064500 OPEN I-O RL-FD1. RL2074.2 +064600 MOVE "VAR. SIZE REC UPDATE" TO FEATURE. RL2074.2 +064700 MOVE 1 TO WRK-CS-09V00-003. RL2074.2 +064800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +064900 READ RL-FD1 RL2074.2 +065000 INVALID KEY MOVE "REL-INIT-006 READ1" TO PAR-NAME RL2074.2 +065100 MOVE "INVALID KEY ON 1ST RECORD READ" RL2074.2 +065200 TO RE-MARK RL2074.2 +065300 PERFORM FAIL RL2074.2 +065400 PERFORM PRINT-DETAIL RL2074.2 +065500 GO TO REL-INIT-007. RL2074.2 +065600 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +065700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +065800 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2074.2 +065900 MOVE 120 TO WRK-SIZE. RL2074.2 +066000 REWRITE RL-FD1R1-F-G-140 RL2074.2 +066100 INVALID KEY MOVE "REL-INIT-006 REWRITE" TO PAR-NAME RL2074.2 +066200 MOVE "INVALID KEY ON 1ST RECORD REWRITE" RL2074.2 +066300 TO RE-MARK RL2074.2 +066400 PERFORM FAIL RL2074.2 +066500 PERFORM PRINT-DETAIL RL2074.2 +066600 GO TO REL-INIT-007. RL2074.2 +066700 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +066800 READ RL-FD1 RL2074.2 +066900 INVALID KEY MOVE "REL-INIT-006 READ2" TO PAR-NAME RL2074.2 +067000 MOVE "INVALID KEY ON 1ST RECORD READ" RL2074.2 +067100 TO RE-MARK RL2074.2 +067200 PERFORM FAIL RL2074.2 +067300 PERFORM PRINT-DETAIL RL2074.2 +067400 GO TO REL-INIT-007. RL2074.2 +067500 REL-TEST-006. RL2074.2 +067600 MOVE "REL-TEST-006" TO PAR-NAME. RL2074.2 +067700 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +067800 IF UPDATE-NUMBER (1) = 98 RL2074.2 +067900 PERFORM PASS RL2074.2 +068000 PERFORM PRINT-DETAIL RL2074.2 +068100 ELSE RL2074.2 +068200 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +068300 TO RE-MARK RL2074.2 +068400 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +068500 MOVE 98 TO CORRECT-N RL2074.2 +068600 PERFORM FAIL RL2074.2 +068700 PERFORM PRINT-DETAIL. RL2074.2 +068800* RL2074.2 +068900 REL-INIT-007. RL2074.2 +069000 MOVE "REL-TEST-007" TO PAR-NAME. RL2074.2 +069100 MOVE 11 TO WRK-CS-09V00-003. RL2074.2 +069200 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +069300 READ RL-FD1 RL2074.2 +069400 INVALID KEY MOVE "REL-INIT-007 READ1" TO PAR-NAME RL2074.2 +069500 MOVE "INVALID KEY ON 11TH RECORD READ" RL2074.2 +069600 TO RE-MARK RL2074.2 +069700 PERFORM FAIL RL2074.2 +069800 PERFORM PRINT-DETAIL RL2074.2 +069900 GO TO REL-INIT-008. RL2074.2 +070000 MOVE RL-FD1R1-F-G-140 TO NEW-130-CHAR-AREA. RL2074.2 +070100 MOVE NEW-130-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +070200 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +070300 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-130-120. RL2074.2 +070400 MOVE NEW-130-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +070500 MOVE 130 TO WRK-SIZE. RL2074.2 +070600 REWRITE RL-FD1R1-F-G-140 RL2074.2 +070700 INVALID KEY MOVE "REL-INIT-007 REWRITE" TO PAR-NAME RL2074.2 +070800 MOVE "INVALID KEY ON 11TH RECORD REWRITE"RL2074.2 +070900 TO RE-MARK RL2074.2 +071000 PERFORM FAIL RL2074.2 +071100 PERFORM PRINT-DETAIL RL2074.2 +071200 GO TO REL-INIT-008. RL2074.2 +071300 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +071400 READ RL-FD1 RL2074.2 +071500 INVALID KEY MOVE "REL-INIT-007 READ2" TO PAR-NAME RL2074.2 +071600 MOVE "INVALID KEY ON 11TH RECORD READ" RL2074.2 +071700 TO RE-MARK RL2074.2 +071800 PERFORM FAIL RL2074.2 +071900 PERFORM PRINT-DETAIL RL2074.2 +072000 GO TO REL-INIT-008. RL2074.2 +072100 REL-TEST-007. RL2074.2 +072200 MOVE "REL-TEST-007" TO PAR-NAME. RL2074.2 +072300 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +072400 IF UPDATE-NUMBER (1) = 98 RL2074.2 +072500 PERFORM PASS RL2074.2 +072600 PERFORM PRINT-DETAIL RL2074.2 +072700 ELSE RL2074.2 +072800 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +072900 TO RE-MARK RL2074.2 +073000 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +073100 MOVE 98 TO CORRECT-N RL2074.2 +073200 PERFORM FAIL RL2074.2 +073300 PERFORM PRINT-DETAIL. RL2074.2 +073400* RL2074.2 +073500 REL-INIT-008. RL2074.2 +073600 MOVE "REL-TEST-008" TO PAR-NAME. RL2074.2 +073700 MOVE 21 TO WRK-CS-09V00-003. RL2074.2 +073800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +073900 READ RL-FD1 RL2074.2 +074000 INVALID KEY MOVE "REL-INIT-008 READ1" TO PAR-NAME RL2074.2 +074100 MOVE "INVALID KEY ON 21ST RECORD READ" RL2074.2 +074200 TO RE-MARK RL2074.2 +074300 PERFORM FAIL RL2074.2 +074400 PERFORM PRINT-DETAIL RL2074.2 +074500 GO TO REL-INIT-009. RL2074.2 +074600 MOVE RL-FD1R1-F-G-140 TO NEW-140-CHAR-AREA. RL2074.2 +074700 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +074800 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +074900 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-140-120. RL2074.2 +075000 MOVE NEW-140-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +075100 MOVE 140 TO WRK-SIZE. RL2074.2 +075200 REWRITE RL-FD1R1-F-G-140 RL2074.2 +075300 INVALID KEY MOVE "REL-INIT-008 REWRITE" TO PAR-NAME RL2074.2 +075400 MOVE "INVALID KEY ON 21ST RECORD REWRITE"RL2074.2 +075500 TO RE-MARK RL2074.2 +075600 PERFORM FAIL RL2074.2 +075700 PERFORM PRINT-DETAIL RL2074.2 +075800 GO TO REL-INIT-009. RL2074.2 +075900 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +076000 READ RL-FD1 RL2074.2 +076100 INVALID KEY MOVE "REL-INIT-008 READ2" TO PAR-NAME RL2074.2 +076200 MOVE "INVALID KEY ON 21ST RECORD READ" RL2074.2 +076300 TO RE-MARK RL2074.2 +076400 PERFORM FAIL RL2074.2 +076500 PERFORM PRINT-DETAIL RL2074.2 +076600 GO TO REL-INIT-009. RL2074.2 +076700 REL-TEST-008. RL2074.2 +076800 MOVE "REL-TEST-008" TO PAR-NAME. RL2074.2 +076900 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +077000 IF UPDATE-NUMBER (1) = 98 RL2074.2 +077100 PERFORM PASS RL2074.2 +077200 PERFORM PRINT-DETAIL RL2074.2 +077300 ELSE RL2074.2 +077400 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +077500 TO RE-MARK RL2074.2 +077600 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +077700 MOVE 98 TO CORRECT-N RL2074.2 +077800 PERFORM FAIL RL2074.2 +077900 PERFORM PRINT-DETAIL. RL2074.2 +078000* RL2074.2 +078100 REL-INIT-009. RL2074.2 +078200 MOVE "REL-TEST-009" TO PAR-NAME. RL2074.2 +078300 MOVE 31 TO WRK-CS-09V00-003. RL2074.2 +078400 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +078500 READ RL-FD1 RL2074.2 +078600 INVALID KEY MOVE "REL-INIT-009 READ1" TO PAR-NAME RL2074.2 +078700 MOVE "INVALID KEY ON 31ST RECORD READ" RL2074.2 +078800 TO RE-MARK RL2074.2 +078900 PERFORM FAIL RL2074.2 +079000 PERFORM PRINT-DETAIL RL2074.2 +079100 GO TO REL-INIT-010. RL2074.2 +079200 MOVE RL-FD1R1-F-G-140 TO NEW-125-CHAR-AREA. RL2074.2 +079300 MOVE NEW-125-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +079400 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +079500 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-128-120. RL2074.2 +079600 MOVE "ABCDEFGH" TO EXTRA-8-CHARS. RL2074.2 +079700 MOVE NEW-128-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +079800 MOVE 128 TO WRK-SIZE. RL2074.2 +079900 REL-TEST-009-1. RL2074.2 +080000 MOVE "REL-TEST-009-1" TO PAR-NAME. RL2074.2 +080100 REWRITE RL-FD1R1-F-G-140 RL2074.2 +080200 INVALID KEY MOVE "INVALID KEY - 31ST RECORD REWRITE" RL2074.2 +080300 TO RE-MARK RL2074.2 +080400 PERFORM FAIL RL2074.2 +080500 PERFORM PRINT-DETAIL RL2074.2 +080600 GO TO REL-INIT-010. RL2074.2 +080700 PERFORM PASS. RL2074.2 +080800 PERFORM PRINT-DETAIL. RL2074.2 +080900 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +081000 READ RL-FD1 RL2074.2 +081100 INVALID KEY MOVE "REL-INIT-009 READ2" TO PAR-NAME RL2074.2 +081200 MOVE "INVALID KEY ON 31ST RECORD READ" RL2074.2 +081300 TO RE-MARK RL2074.2 +081400 PERFORM FAIL RL2074.2 +081500 PERFORM PRINT-DETAIL RL2074.2 +081600 GO TO REL-INIT-010. RL2074.2 +081700 REL-TEST-009-2. RL2074.2 +081800 MOVE "REL-TEST-009-2" TO PAR-NAME. RL2074.2 +081900 MOVE RL-FD1R1-F-G-140 TO NEW-128-CHAR-AREA. RL2074.2 +082000 MOVE NEW-128-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +082100 IF UPDATE-NUMBER (1) = 98 RL2074.2 +082200 PERFORM PASS RL2074.2 +082300 PERFORM PRINT-DETAIL RL2074.2 +082400 ELSE RL2074.2 +082500 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +082600 TO RE-MARK RL2074.2 +082700 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +082800 MOVE 98 TO CORRECT-N RL2074.2 +082900 PERFORM FAIL RL2074.2 +083000 PERFORM PRINT-DETAIL. RL2074.2 +083100 REL-TEST-009-3. RL2074.2 +083200 MOVE "REL-TEST-009-3" TO PAR-NAME. RL2074.2 +083300 IF EXTRA-8-CHARS = "ABCDEFGH" RL2074.2 +083400 PERFORM PASS RL2074.2 +083500 PERFORM PRINT-DETAIL RL2074.2 +083600 ELSE RL2074.2 +083700 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +083800 TO RE-MARK RL2074.2 +083900 MOVE "ABCDEFGH" TO CORRECT-X RL2074.2 +084000 MOVE EXTRA-8-CHARS TO COMPUTED-X RL2074.2 +084100 PERFORM FAIL RL2074.2 +084200 PERFORM PRINT-DETAIL. RL2074.2 +084300* RL2074.2 +084400 REL-INIT-010. RL2074.2 +084500 MOVE "REL-TEST-010" TO PAR-NAME. RL2074.2 +084600 MOVE 32 TO WRK-CS-09V00-003. RL2074.2 +084700 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +084800 READ RL-FD1 RL2074.2 +084900 INVALID KEY MOVE "REL-INIT-010 READ1" TO PAR-NAME RL2074.2 +085000 MOVE "INVALID KEY ON 32ND RECORD READ" RL2074.2 +085100 TO RE-MARK RL2074.2 +085200 PERFORM FAIL RL2074.2 +085300 PERFORM PRINT-DETAIL RL2074.2 +085400 GO TO REL-INIT-011. RL2074.2 +085500 MOVE RL-FD1R1-F-G-140 TO NEW-135-CHAR-AREA. RL2074.2 +085600 MOVE NEW-135-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +085700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +085800 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-132-120. RL2074.2 +085900 MOVE "ABCDEFGHIJKL" TO EXTRA-12-CHARS. RL2074.2 +086000 MOVE NEW-132-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +086100 MOVE 132 TO WRK-SIZE. RL2074.2 +086200 REL-TEST-010-1. RL2074.2 +086300 MOVE "REL-TEST-010-1" TO PAR-NAME. RL2074.2 +086400 REWRITE RL-FD1R1-F-G-140 RL2074.2 +086500 INVALID KEY MOVE "INVALID KEY - 32ND RECORD REWRITE" RL2074.2 +086600 TO RE-MARK RL2074.2 +086700 PERFORM FAIL RL2074.2 +086800 PERFORM PRINT-DETAIL RL2074.2 +086900 GO TO REL-INIT-011. RL2074.2 +087000 PERFORM PASS. RL2074.2 +087100 PERFORM PRINT-DETAIL. RL2074.2 +087200 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +087300 READ RL-FD1 RL2074.2 +087400 INVALID KEY RL2074.2 +087500 MOVE "INVALID KEY ON 32ND RECORD READ" RL2074.2 +087600 TO RE-MARK RL2074.2 +087700 PERFORM FAIL RL2074.2 +087800 PERFORM PRINT-DETAIL RL2074.2 +087900 GO TO REL-INIT-011. RL2074.2 +088000 REL-TEST-010-2. RL2074.2 +088100 MOVE "REL-TEST-010-2" TO PAR-NAME. RL2074.2 +088200 MOVE RL-FD1R1-F-G-140 TO NEW-132-CHAR-AREA. RL2074.2 +088300 MOVE NEW-132-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +088400 IF UPDATE-NUMBER (1) = 98 RL2074.2 +088500 PERFORM PASS RL2074.2 +088600 PERFORM PRINT-DETAIL RL2074.2 +088700 ELSE RL2074.2 +088800 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +088900 TO RE-MARK RL2074.2 +089000 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +089100 MOVE 98 TO CORRECT-N RL2074.2 +089200 PERFORM FAIL RL2074.2 +089300 PERFORM PRINT-DETAIL. RL2074.2 +089400 REL-TEST-010-3. RL2074.2 +089500 MOVE "REL-TEST-010-3" TO PAR-NAME. RL2074.2 +089600 IF EXTRA-12-CHARS = "ABCDEFGHIJKL" RL2074.2 +089700 PERFORM PASS RL2074.2 +089800 PERFORM PRINT-DETAIL RL2074.2 +089900 ELSE RL2074.2 +090000 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +090100 TO RE-MARK RL2074.2 +090200 MOVE "ABCDEFGHIJKL" TO CORRECT-X RL2074.2 +090300 MOVE EXTRA-12-CHARS TO COMPUTED-X RL2074.2 +090400 PERFORM FAIL RL2074.2 +090500 PERFORM PRINT-DETAIL. RL2074.2 +090600* RL2074.2 +090700 REL-INIT-011. RL2074.2 +090800 MOVE "REL-TEST-011" TO PAR-NAME. RL2074.2 +090900 MOVE 33 TO WRK-CS-09V00-003. RL2074.2 +091000 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +091100 READ RL-FD1 RL2074.2 +091200 INVALID KEY MOVE "REL-INIT-011 READ1" TO PAR-NAME RL2074.2 +091300 MOVE "INVALID KEY ON 33RD RECORD READ" RL2074.2 +091400 TO RE-MARK RL2074.2 +091500 PERFORM FAIL RL2074.2 +091600 PERFORM PRINT-DETAIL RL2074.2 +091700 GO TO REL-INIT-012. RL2074.2 +091800 MOVE RL-FD1R1-F-G-140 TO NEW-145-CHAR-AREA. RL2074.2 +091900 MOVE NEW-145-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +092000 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +092100 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-145-120. RL2074.2 +092200 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXY" TO EXTRA-25-CHARS. RL2074.2 +092300 MOVE 145 TO WRK-SIZE. RL2074.2 +092400 REL-TEST-011-1. RL2074.2 +092500 MOVE "REL-TEST-011-1" TO PAR-NAME. RL2074.2 +092600* REWRITE RL-FD1R1-F-G-140 FROM NEW-145-CHAR-AREA RL2074.2 +092700* INVALID GO TO REL-TEST-011-1-A. RL2074.2 +092800*REL-TEST-011-1-A. RL2074.2 +092900* IF WS-STATUS = "44" RL2074.2 +093000* PERFORM PASS RL2074.2 +093100* PERFORM PRINT-DETAIL RL2074.2 +093200* ELSE RL2074.2 +093300* MOVE "INCORRECT FILE STATUS HAS OCCURED" RL2074.2 +093400* TO RE-MARK RL2074.2 +093500* MOVE "44" TO CORRECT-X RL2074.2 +093600* MOVE WS-STATUS TO COMPUTED-X RL2074.2 +093700* PERFORM FAIL RL2074.2 +093800* PERFORM PRINT-DETAIL. RL2074.2 +093900* MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +094000* READ RL-FD1 INTO NEW-140-CHAR-AREA RL2074.2 +094100* INVALID KEY RL2074.2 +094200* MOVE "INVALID KEY ON 33RD RECORD READ" RL2074.2 +094300* TO RE-MARK RL2074.2 +094400* PERFORM FAIL RL2074.2 +094500* PERFORM PRINT-DETAIL RL2074.2 +094600 GO TO CCVS-EXIT. RL2074.2 +094700 REL-TEST-011-2. RL2074.2 +094800 MOVE "REL-TEST-011-2" TO PAR-NAME. RL2074.2 +094900 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +095000 IF UPDATE-NUMBER (1) = ZERO RL2074.2 +095100 PERFORM PASS RL2074.2 +095200 PERFORM PRINT-DETAIL RL2074.2 +095300 ELSE RL2074.2 +095400 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +095500 TO RE-MARK RL2074.2 +095600 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +095700 MOVE 00 TO CORRECT-N RL2074.2 +095800 PERFORM FAIL RL2074.2 +095900 PERFORM PRINT-DETAIL. RL2074.2 +096000 REL-TEST-011-3. RL2074.2 +096100 MOVE "REL-TEST-011-3" TO PAR-NAME. RL2074.2 +096200 IF EXTRA-20-CHARS = "ABCDEFGHIJKLMNOPQRST" RL2074.2 +096300 PERFORM PASS RL2074.2 +096400 PERFORM PRINT-DETAIL RL2074.2 +096500 ELSE RL2074.2 +096600 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +096700 TO RE-MARK RL2074.2 +096800 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-X RL2074.2 +096900 MOVE EXTRA-20-CHARS TO COMPUTED-X RL2074.2 +097000 PERFORM FAIL RL2074.2 +097100 PERFORM PRINT-DETAIL. RL2074.2 +097200 REL-TEST-011-4. RL2074.2 +097300 MOVE "REL-TEST-011-4" TO PAR-NAME. RL2074.2 +097400 IF WRK-SIZE = 140 RL2074.2 +097500 PERFORM PASS RL2074.2 +097600 PERFORM PRINT-DETAIL RL2074.2 +097700 ELSE RL2074.2 +097800 MOVE "INCORRECT RECORD LENGTH READ" RL2074.2 +097900 TO RE-MARK RL2074.2 +098000 MOVE 140 TO CORRECT-18V0 RL2074.2 +098100 MOVE WRK-SIZE TO COMPUTED-18V0 RL2074.2 +098200 PERFORM FAIL RL2074.2 +098300 PERFORM PRINT-DETAIL. RL2074.2 +098400* RL2074.2 +098500 REL-INIT-012. RL2074.2 +098600 MOVE "REL-TEST-012" TO PAR-NAME. RL2074.2 +098700 MOVE 34 TO WRK-CS-09V00-003. RL2074.2 +098800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +098900 READ RL-FD1 RL2074.2 +099000 INVALID KEY MOVE "REL-INIT-012 READ1" TO PAR-NAME RL2074.2 +099100 MOVE "INVALID KEY ON 34TH RECORD READ" RL2074.2 +099200 TO RE-MARK RL2074.2 +099300 PERFORM FAIL RL2074.2 +099400 PERFORM PRINT-DETAIL RL2074.2 +099500 GO TO CCVS-EXIT. RL2074.2 +099600 MOVE LOW-VALUES TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +099700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +099800 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-115-120. RL2074.2 +099900 MOVE 115 TO WRK-SIZE. RL2074.2 +100000 REL-TEST-012-1. RL2074.2 +100100 MOVE "REL-TEST-012-1" TO PAR-NAME. RL2074.2 +100200 RL2074.2 +100300 REWRITE RL-FD1R1-F-G-140 FROM NEW-115-CHAR-AREA RL2074.2 +100400 INVALID GO TO REL-TEST-012-2. RL2074.2 +100500*REL-TEST-012-1-A. RL2074.2 +100600* IF WS-STATUS = "44" RL2074.2 +100700* PERFORM PASS RL2074.2 +100800* PERFORM PRINT-DETAIL RL2074.2 +100900* ELSE RL2074.2 +101000* MOVE "INCORRECT FILE STATUS HAS OCCURED" RL2074.2 +101100* TO RE-MARK RL2074.2 +101200* MOVE "44" TO CORRECT-X RL2074.2 +101300* MOVE WS-STATUS TO COMPUTED-X RL2074.2 +101400* PERFORM FAIL RL2074.2 +101500* PERFORM PRINT-DETAIL. RL2074.2 +101600* MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +101700* READ RL-FD1 INTO NEW-140-CHAR-AREA RL2074.2 +101800* INVALID KEY MOVE "REL-INIT-012 READ2" TO PAR-NAME RL2074.2 +101900* MOVE "INVALID KEY ON 34TH RECORD READ" RL2074.2 +102000* TO RE-MARK RL2074.2 +102100* PERFORM FAIL RL2074.2 +102200* PERFORM PRINT-DETAIL RL2074.2 +102300* GO TO REL-INIT-012. RL2074.2 +102400 REL-TEST-012-2. RL2074.2 +102500 MOVE "REL-TEST-012-2" TO PAR-NAME. RL2074.2 +102600 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +102700 IF UPDATE-NUMBER (1) = ZERO RL2074.2 +102800 PERFORM PASS RL2074.2 +102900 PERFORM PRINT-DETAIL RL2074.2 +103000 ELSE RL2074.2 +103100 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +103200 TO RE-MARK RL2074.2 +103300 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +103400 MOVE 00 TO CORRECT-N RL2074.2 +103500 PERFORM FAIL RL2074.2 +103600 PERFORM PRINT-DETAIL. RL2074.2 +103700 REL-TEST-012-3. RL2074.2 +103800 MOVE "REL-TEST-012-3" TO PAR-NAME. RL2074.2 +103900 IF EXTRA-20-CHARS = "ABCDEFGHIJKLMNOPQRST" RL2074.2 +104000 PERFORM PASS RL2074.2 +104100 PERFORM PRINT-DETAIL RL2074.2 +104200 ELSE RL2074.2 +104300 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +104400 TO RE-MARK RL2074.2 +104500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-X RL2074.2 +104600 MOVE EXTRA-20-CHARS TO COMPUTED-X RL2074.2 +104700 PERFORM FAIL RL2074.2 +104800 PERFORM PRINT-DETAIL. RL2074.2 +104900 REL-TEST-012-4. RL2074.2 +105000 MOVE "REL-TEST-012-4" TO PAR-NAME. RL2074.2 +105100 IF WRK-SIZE = 140 RL2074.2 +105200 PERFORM PASS RL2074.2 +105300 PERFORM PRINT-DETAIL RL2074.2 +105400 ELSE RL2074.2 +105500 MOVE "INCORRECT RECORD LENGTH READ" RL2074.2 +105600 TO RE-MARK RL2074.2 +105700 MOVE 140 TO CORRECT-18V0 RL2074.2 +105800 MOVE WRK-SIZE TO COMPUTED-18V0 RL2074.2 +105900 PERFORM FAIL RL2074.2 +106000 PERFORM PRINT-DETAIL. RL2074.2 +106100* RL2074.2 +106200 CCVS-EXIT SECTION. RL2074.2 +106300 CCVS-999999. RL2074.2 +106400 GO TO CLOSE-FILES. RL2074.2 +*END-OF,RL207A +*HEADER,COBOL,RL206A,SUBPRG,RL208A +000100 IDENTIFICATION DIVISION. RL2084.2 +000200 PROGRAM-ID. RL2084.2 +000300 RL208A. RL2084.2 +000400**************************************************************** RL2084.2 +000500* * RL2084.2 +000600* VALIDATION FOR:- * RL2084.2 +000700* * RL2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +000900* * RL2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2084.2 +001100* * RL2084.2 +001200**************************************************************** RL2084.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL2084.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL2084.2 +001500* (ACCESS MODE IS DYNAMIC). THE FILE USED IS THAT RL2084.2 +001600* RESULTING FROM RL206A RL2084.2 +001700* RL2084.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL2084.2 +001900* RECORDS. SECONDLY, RECORDS OF THE FILE ARE RL2084.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL2084.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2084.2 +002200* RL2084.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2084.2 +002400* PROGRAM ARE: RL2084.2 +002500* RL2084.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2084.2 +002700* RELATIVE I-O DATA FILE RL2084.2 +002800* X-55 SYSTEM PRINTER RL2084.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2084.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2084.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2084.2 +003200* X-82 SOURCE-COMPUTER RL2084.2 +003300* X-83 OBJECT-COMPUTER. RL2084.2 +003400* RL2084.2 +003500**************************************************************** RL2084.2 +003600 ENVIRONMENT DIVISION. RL2084.2 +003700 CONFIGURATION SECTION. RL2084.2 +003800 SOURCE-COMPUTER. RL2084.2 +003900 XXXXX082. RL2084.2 +004000 OBJECT-COMPUTER. RL2084.2 +004100 XXXXX083. RL2084.2 +004200 INPUT-OUTPUT SECTION. RL2084.2 +004300 FILE-CONTROL. RL2084.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2084.2 +004500 XXXXX055. RL2084.2 +004600 SELECT RL-FD1 ASSIGN TO RL2084.2 +004700 XXXXD021 RL2084.2 +004800 ACCESS MODE IS DYNAMIC RL2084.2 +004900 RELATIVE KEY IS RL-FD1-KEY RL2084.2 +005000 ORGANIZATION IS RELATIVE. RL2084.2 +005100 DATA DIVISION. RL2084.2 +005200 FILE SECTION. RL2084.2 +005300 FD PRINT-FILE. RL2084.2 +005400 01 PRINT-REC PICTURE X(132). RL2084.2 +005500 01 DUMMY-RECORD PICTURE X(132). RL2084.2 +005600 FD RL-FD1 RL2084.2 +005700 LABEL RECORDS STANDARD RL2084.2 +005800C VALUE OF RL2084.2 +005900C XXXXX074 RL2084.2 +006000C IS RL2084.2 +006100C XXXXX075 RL2084.2 +006200G XXXXX069 RL2084.2 +006300 BLOCK CONTAINS 01 RECORDS RL2084.2 +006400 RECORD IS VARYING IN SIZE RL2084.2 +006500 FROM 120 TO 140 CHARACTERS. RL2084.2 +006600 01 RL-FD1R1-F-G-140. RL2084.2 +006700 02 RL-WRK-120 PIC X(120). RL2084.2 +006800 02 FILLER PIC X(20). RL2084.2 +006900 WORKING-STORAGE SECTION. RL2084.2 +007000 01 RL-FD1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL2084.2 +007100 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007200 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007300 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007400 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007500 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007600 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007700 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2084.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL2084.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL2084.2 +008000 05 FILLER PICTURE X(48) VALUE RL2084.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2084.2 +008200 05 FILLER PICTURE X(46) VALUE RL2084.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2084.2 +008400 05 FILLER PICTURE X(26) VALUE RL2084.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL2084.2 +008600 05 FILLER PICTURE X(37) VALUE RL2084.2 +008700 ",RECKEY= ". RL2084.2 +008800 05 FILLER PICTURE X(38) VALUE RL2084.2 +008900 ",ALTKEY1= ". RL2084.2 +009000 05 FILLER PICTURE X(38) VALUE RL2084.2 +009100 ",ALTKEY2= ". RL2084.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL2084.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2084.2 +009400 05 FILE-RECORD-INFO-P1-120. RL2084.2 +009500 07 FILLER PIC X(5). RL2084.2 +009600 07 XFILE-NAME PIC X(6). RL2084.2 +009700 07 FILLER PIC X(8). RL2084.2 +009800 07 XRECORD-NAME PIC X(6). RL2084.2 +009900 07 FILLER PIC X(1). RL2084.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL2084.2 +010100 07 FILLER PIC X(7). RL2084.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL2084.2 +010300 07 FILLER PIC X(6). RL2084.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL2084.2 +010500 07 FILLER PIC X(5). RL2084.2 +010600 07 ODO-NUMBER PIC 9(4). RL2084.2 +010700 07 FILLER PIC X(5). RL2084.2 +010800 07 XPROGRAM-NAME PIC X(5). RL2084.2 +010900 07 FILLER PIC X(7). RL2084.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL2084.2 +011100 07 FILLER PIC X(7). RL2084.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL2084.2 +011300 07 FILLER PIC X(1). RL2084.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL2084.2 +011500 07 FILLER PIC X(6). RL2084.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL2084.2 +011700 07 FILLER PIC X(5). RL2084.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL2084.2 +011900 07 FILLER PIC X(6). RL2084.2 +012000 07 XLABEL-TYPE PIC X(1). RL2084.2 +012100 05 FILE-RECORD-INFO-P121-240. RL2084.2 +012200 07 FILLER PIC X(8). RL2084.2 +012300 07 XRECORD-KEY PIC X(29). RL2084.2 +012400 07 FILLER PIC X(9). RL2084.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL2084.2 +012600 07 FILLER PIC X(9). RL2084.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL2084.2 +012800 07 FILLER PIC X(7). RL2084.2 +012900 01 TEST-RESULTS. RL2084.2 +013000 02 FILLER PIC X VALUE SPACE. RL2084.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL2084.2 +013200 02 FILLER PIC X VALUE SPACE. RL2084.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL2084.2 +013400 02 FILLER PIC X VALUE SPACE. RL2084.2 +013500 02 PAR-NAME. RL2084.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL2084.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL2084.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL2084.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL2084.2 +014000 02 RE-MARK PIC X(61). RL2084.2 +014100 01 TEST-COMPUTED. RL2084.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL2084.2 +014300 02 FILLER PIC X(17) VALUE RL2084.2 +014400 " COMPUTED=". RL2084.2 +014500 02 COMPUTED-X. RL2084.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2084.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL2084.2 +014800 PIC -9(9).9(9). RL2084.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2084.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2084.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2084.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL2084.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL2084.2 +015400 04 FILLER PIC X. RL2084.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL2084.2 +015600 01 TEST-CORRECT. RL2084.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL2084.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL2084.2 +015900 02 CORRECT-X. RL2084.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL2084.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2084.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2084.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2084.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2084.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL2084.2 +016600 04 CORRECT-18V0 PIC -9(18). RL2084.2 +016700 04 FILLER PIC X. RL2084.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL2084.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2084.2 +017000 01 CCVS-C-1. RL2084.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2084.2 +017200- "SS PARAGRAPH-NAME RL2084.2 +017300- " REMARKS". RL2084.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL2084.2 +017500 01 CCVS-C-2. RL2084.2 +017600 02 FILLER PIC X VALUE SPACE. RL2084.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL2084.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL2084.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL2084.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL2084.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2084.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL2084.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2084.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2084.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2084.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2084.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2084.2 +019200 01 CCVS-H-1. RL2084.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL2084.2 +019400 02 FILLER PIC X(42) VALUE RL2084.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2084.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2084.2 +019700 01 CCVS-H-2A. RL2084.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL2084.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2084.2 +020000 02 FILLER PIC XXXX VALUE RL2084.2 +020100 "4.2 ". RL2084.2 +020200 02 FILLER PIC X(28) VALUE RL2084.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL2084.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL2084.2 +020500 RL2084.2 +020600 01 CCVS-H-2B. RL2084.2 +020700 02 FILLER PIC X(15) VALUE RL2084.2 +020800 "TEST RESULT OF ". RL2084.2 +020900 02 TEST-ID PIC X(9). RL2084.2 +021000 02 FILLER PIC X(4) VALUE RL2084.2 +021100 " IN ". RL2084.2 +021200 02 FILLER PIC X(12) VALUE RL2084.2 +021300 " HIGH ". RL2084.2 +021400 02 FILLER PIC X(22) VALUE RL2084.2 +021500 " LEVEL VALIDATION FOR ". RL2084.2 +021600 02 FILLER PIC X(58) VALUE RL2084.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +021800 01 CCVS-H-3. RL2084.2 +021900 02 FILLER PIC X(34) VALUE RL2084.2 +022000 " FOR OFFICIAL USE ONLY ". RL2084.2 +022100 02 FILLER PIC X(58) VALUE RL2084.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2084.2 +022300 02 FILLER PIC X(28) VALUE RL2084.2 +022400 " COPYRIGHT 1985 ". RL2084.2 +022500 01 CCVS-E-1. RL2084.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL2084.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2084.2 +022800 02 ID-AGAIN PIC X(9). RL2084.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL2084.2 +023000 01 CCVS-E-2. RL2084.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL2084.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL2084.2 +023300 02 CCVS-E-2-2. RL2084.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2084.2 +023500 03 FILLER PIC X VALUE SPACE. RL2084.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL2084.2 +023700 "ERRORS ENCOUNTERED". RL2084.2 +023800 01 CCVS-E-3. RL2084.2 +023900 02 FILLER PIC X(22) VALUE RL2084.2 +024000 " FOR OFFICIAL USE ONLY". RL2084.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL2084.2 +024200 02 FILLER PIC X(58) VALUE RL2084.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL2084.2 +024500 02 FILLER PIC X(15) VALUE RL2084.2 +024600 " COPYRIGHT 1985". RL2084.2 +024700 01 CCVS-E-4. RL2084.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2084.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL2084.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2084.2 +025100 02 FILLER PIC X(40) VALUE RL2084.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL2084.2 +025300 01 XXINFO. RL2084.2 +025400 02 FILLER PIC X(19) VALUE RL2084.2 +025500 "*** INFORMATION ***". RL2084.2 +025600 02 INFO-TEXT. RL2084.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL2084.2 +025800 04 XXCOMPUTED PIC X(20). RL2084.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL2084.2 +026000 04 XXCORRECT PIC X(20). RL2084.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL2084.2 +026200 01 HYPHEN-LINE. RL2084.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL2084.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL2084.2 +026500- "*****************************************". RL2084.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL2084.2 +026700- "******************************". RL2084.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL2084.2 +026900 "RL208A". RL2084.2 +027000 PROCEDURE DIVISION. RL2084.2 +027100 CCVS1 SECTION. RL2084.2 +027200 OPEN-FILES. RL2084.2 +027300 OPEN OUTPUT PRINT-FILE. RL2084.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2084.2 +027500 MOVE SPACE TO TEST-RESULTS. RL2084.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2084.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL2084.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL2084.2 +027900 CCVS-INIT-FILE. RL2084.2 +028000 ADD 1 TO REC-SKL-SUB. RL2084.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL2084.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2084.2 +028300 CCVS-INIT-EXIT. RL2084.2 +028400 GO TO CCVS1-EXIT. RL2084.2 +028500 CLOSE-FILES. RL2084.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2084.2 +028700 TERMINATE-CCVS. RL2084.2 +028800S EXIT PROGRAM. RL2084.2 +028900STERMINATE-CALL. RL2084.2 +029000 STOP RUN. RL2084.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2084.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2084.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2084.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2084.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL2084.2 +029600 PRINT-DETAIL. RL2084.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL2084.2 +029800 MOVE "." TO PARDOT-X RL2084.2 +029900 MOVE REC-CT TO DOTVALUE. RL2084.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2084.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2084.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2084.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2084.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2084.2 +030500 MOVE SPACE TO CORRECT-X. RL2084.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2084.2 +030700 MOVE SPACE TO RE-MARK. RL2084.2 +030800 HEAD-ROUTINE. RL2084.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2084.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2084.2 +031300 COLUMN-NAMES-ROUTINE. RL2084.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +031700 END-ROUTINE. RL2084.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2084.2 +031900 END-RTN-EXIT. RL2084.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +032100 END-ROUTINE-1. RL2084.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2084.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2084.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL2084.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2084.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2084.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2084.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2084.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2084.2 +033000 END-ROUTINE-12. RL2084.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2084.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL2084.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2084.2 +033400 ELSE RL2084.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2084.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2084.2 +033700 PERFORM WRITE-LINE. RL2084.2 +033800 END-ROUTINE-13. RL2084.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL2084.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL2084.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2084.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2084.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL2084.2 +034500 MOVE "NO " TO ERROR-TOTAL RL2084.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2084.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2084.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +035000 WRITE-LINE. RL2084.2 +035100 ADD 1 TO RECORD-COUNT. RL2084.2 +035200Y IF RECORD-COUNT GREATER 50 RL2084.2 +035300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2084.2 +035400Y MOVE SPACE TO DUMMY-RECORD RL2084.2 +035500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2084.2 +035600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2084.2 +035700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2084.2 +035800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2084.2 +035900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2084.2 +036000Y MOVE ZERO TO RECORD-COUNT. RL2084.2 +036100 PERFORM WRT-LN. RL2084.2 +036200 WRT-LN. RL2084.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2084.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL2084.2 +036500 BLANK-LINE-PRINT. RL2084.2 +036600 PERFORM WRT-LN. RL2084.2 +036700 FAIL-ROUTINE. RL2084.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2084.2 +036900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2084.2 +037000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2084.2 +037100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2084.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +037300 MOVE SPACES TO INF-ANSI-REFERENCE. RL2084.2 +037400 GO TO FAIL-ROUTINE-EX. RL2084.2 +037500 FAIL-ROUTINE-WRITE. RL2084.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2084.2 +037700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2084.2 +037800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2084.2 +037900 MOVE SPACES TO COR-ANSI-REFERENCE. RL2084.2 +038000 FAIL-ROUTINE-EX. EXIT. RL2084.2 +038100 BAIL-OUT. RL2084.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2084.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2084.2 +038400 BAIL-OUT-WRITE. RL2084.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2084.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2084.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. RL2084.2 +038900 BAIL-OUT-EX. EXIT. RL2084.2 +039000 CCVS1-EXIT. RL2084.2 +039100 EXIT. RL2084.2 +039200 SECT-RL208A-001 SECTION. RL2084.2 +039300 REL-INIT-012. RL2084.2 +039400 MOVE 99 TO RL-FD1-KEY. RL2084.2 +039500* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL2084.2 +039600 OPEN INPUT RL-FD1. RL2084.2 +039700 MOVE "REL-TEST-012" TO PAR-NAME. RL2084.2 +039800 MOVE ZERO TO WRK-CS-09V00-006. RL2084.2 +039900 MOVE ZERO TO WRK-CS-09V00-007. RL2084.2 +040000 MOVE ZERO TO WRK-CS-09V00-008. RL2084.2 +040100 MOVE ZERO TO WRK-CS-09V00-009. RL2084.2 +040200 MOVE ZERO TO WRK-CS-09V00-010. RL2084.2 +040300 MOVE ZERO TO WRK-CS-09V00-011. RL2084.2 +040400 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +040500 MOVE RL-FD1-KEY TO WRK-CS-09V00-011. RL2084.2 +040600 MOVE 01 TO REC-CT. RL2084.2 +040700 MOVE "READ SEQUENTIAL" TO FEATURE. RL2084.2 +040800 REL-TEST-012-R. RL2084.2 +040900 ADD 1 TO WRK-CS-09V00-006. RL2084.2 +041000 READ RL-FD1 NEXT RECORD RL2084.2 +041100 AT END GO TO REL-TEST-012-3. RL2084.2 +041200 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +041300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2084.2 +041400 ADD 1 TO WRK-CS-09V00-007 RL2084.2 +041500 GO TO REL-TEST-012-2. RL2084.2 +041600 IF UPDATE-NUMBER (1) EQUAL TO 01 OR 98 RL2084.2 +041700 ADD 1 TO WRK-CS-09V00-008 RL2084.2 +041800 GO TO REL-TEST-012-2. RL2084.2 +041900 ADD 1 TO WRK-CS-09V00-009. RL2084.2 +042000 REL-TEST-012-2. RL2084.2 +042100 IF RL-FD1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL2084.2 +042200 ADD 1 TO WRK-CS-09V00-010. RL2084.2 +042300 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +042400 GO TO REL-TEST-012-3. RL2084.2 +042500 GO TO REL-TEST-012-R. RL2084.2 +042600 REL-TEST-012-3. RL2084.2 +042700 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2084.2 +042800 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2084.2 +042900 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +043000 MOVE 501 TO CORRECT-18V0 RL2084.2 +043100 PERFORM FAIL RL2084.2 +043200 ELSE RL2084.2 +043300 PERFORM PASS. RL2084.2 +043400 PERFORM PRINT-DETAIL. RL2084.2 +043500* .01 RL2084.2 +043600 ADD 1 TO REC-CT. RL2084.2 +043700 IF WRK-CS-09V00-007 EQUAL TO 395 RL2084.2 +043800 PERFORM PASS RL2084.2 +043900 ELSE RL2084.2 +044000 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2084.2 +044100 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL2084.2 +044200 MOVE "SHOULD BE 395" TO RE-MARK RL2084.2 +044300 PERFORM FAIL. RL2084.2 +044400 PERFORM PRINT-DETAIL. RL2084.2 +044500 ADD 1 TO REC-CT. RL2084.2 +044600* .02 RL2084.2 +044700 IF WRK-CS-09V00-008 EQUAL TO 105 RL2084.2 +044800 PERFORM PASS RL2084.2 +044900 ELSE RL2084.2 +045000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2084.2 +045100 MOVE 105 TO CORRECT-18V0 RL2084.2 +045200 MOVE "UPDATED RECORDS" TO RE-MARK RL2084.2 +045300 PERFORM FAIL. RL2084.2 +045400 PERFORM PRINT-DETAIL. RL2084.2 +045500 ADD 1 TO REC-CT. RL2084.2 +045600* .03 RL2084.2 +045700 IF WRK-CS-09V00-009 EQUAL TO ZERO RL2084.2 +045800 PERFORM PASS RL2084.2 +045900 ELSE RL2084.2 +046000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2084.2 +046100 MOVE ZERO TO CORRECT-18V0 RL2084.2 +046200 MOVE "BAD-UPDATES" TO RE-MARK RL2084.2 +046300 PERFORM FAIL. RL2084.2 +046400 PERFORM PRINT-DETAIL. RL2084.2 +046500 ADD 01 TO REC-CT. RL2084.2 +046600* .04 RL2084.2 +046700 IF WRK-CS-09V00-010 EQUAL TO ZERO RL2084.2 +046800 PERFORM PASS RL2084.2 +046900 ELSE RL2084.2 +047000 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2084.2 +047100 MOVE ZERO TO CORRECT-18V0 RL2084.2 +047200 MOVE "KEY VS RECORD" TO RE-MARK RL2084.2 +047300 PERFORM FAIL. RL2084.2 +047400 PERFORM PRINT-DETAIL. RL2084.2 +047500 ADD 01 TO REC-CT. RL2084.2 +047600* .05 RL2084.2 +047700 MOVE WRK-CS-09V00-011 TO RL-FD1-KEY. RL2084.2 +047800 MOVE RL-FD1-KEY TO COMPUTED-18V0. RL2084.2 +047900 MOVE "INFORMATION" TO CORRECT-A. RL2084.2 +048000 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL2084.2 +048100 PERFORM PRINT-DETAIL. RL2084.2 +048200 ADD 01 TO REC-CT. RL2084.2 +048300* .06 RL2084.2 +048400 CLOSE RL-FD1. RL2084.2 +048500 REL-INIT-013. RL2084.2 +048600 MOVE "REL-TEST-013" TO PAR-NAME RL2084.2 +048700 OPEN I-O RL-FD1. RL2084.2 +048800 MOVE ZERO TO WRK-CS-09V00-006 RL2084.2 +048900 MOVE ZERO TO WRK-CS-09V00-007 RL2084.2 +049000 MOVE ZERO TO WRK-CS-09V00-008 RL2084.2 +049100 MOVE ZERO TO WRK-CS-09V00-009 RL2084.2 +049200 MOVE ZERO TO WRK-CS-09V00-010 RL2084.2 +049300 MOVE ZERO TO WRK-CS-09V00-011 RL2084.2 +049400 MOVE 01 TO REC-CT. RL2084.2 +049500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +049600 MOVE "DELETE" TO FEATURE. RL2084.2 +049700 REL-TEST-013-R. RL2084.2 +049800 ADD 1 TO WRK-CS-09V00-006 RL2084.2 +049900 ADD 1 TO WRK-CS-09V00-007. RL2084.2 +050000 READ RL-FD1 NEXT RECORD RL2084.2 +050100 AT END RL2084.2 +050200 MOVE "AT END PATH TAKEN " TO RE-MARK RL2084.2 +050300 GO TO REL-TEST-013-3. RL2084.2 +050400 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +050500 IF (WRK-CS-09V00-007 = 1 OR 11 OR 21 OR 31 OR 32) RL2084.2 +050600 GO TO REL-TEST-013-2. RL2084.2 +050700 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +050800 MOVE "AT END NOT TAKEN" TO RE-MARK RL2084.2 +050900 GO TO REL-TEST-013-3. RL2084.2 +051000 GO TO REL-TEST-013-R. RL2084.2 +051100 REL-TEST-013-2. RL2084.2 +051200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2084.2 +051300 MOVE 99 TO UPDATE-NUMBER (1). RL2084.2 +051400 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2084.2 +051500 DELETE RL-FD1 RL2084.2 +051600 INVALID KEY GO TO REL-TEST-013-3. RL2084.2 +051700 ADD 1 TO WRK-CS-09V00-008 RL2084.2 +051800 GO TO REL-TEST-013-R. RL2084.2 +051900 REL-TEST-013-3. RL2084.2 +052000 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2084.2 +052100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +052200 MOVE 501 TO CORRECT-18V0 RL2084.2 +052300 PERFORM FAIL RL2084.2 +052400 ELSE RL2084.2 +052500 PERFORM PASS. RL2084.2 +052600 PERFORM PRINT-DETAIL. RL2084.2 +052700 ADD 01 TO REC-CT. RL2084.2 +052800* .01 RL2084.2 +052900 IF WRK-CS-09V00-008 NOT EQUAL TO 5 RL2084.2 +053000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2084.2 +053100 MOVE 5 TO CORRECT-18V0 RL2084.2 +053200 MOVE "DELETED RECORDS" TO RE-MARK RL2084.2 +053300 PERFORM FAIL RL2084.2 +053400 ELSE RL2084.2 +053500 PERFORM PASS. RL2084.2 +053600 PERFORM PRINT-DETAIL. RL2084.2 +053700 ADD 01 TO REC-CT. RL2084.2 +053800* .02 RL2084.2 +053900 CLOSE RL-FD1. RL2084.2 +054000 REL-INIT-014. RL2084.2 +054100 MOVE "REL-TEST-014" TO PAR-NAME. RL2084.2 +054200 MOVE ZERO TO WRK-CS-09V00-006 RL2084.2 +054300 MOVE ZERO TO WRK-CS-09V00-007 RL2084.2 +054400 MOVE ZERO TO WRK-CS-09V00-008 RL2084.2 +054500 MOVE ZERO TO WRK-CS-09V00-009 RL2084.2 +054600 MOVE ZERO TO WRK-CS-09V00-010 RL2084.2 +054700 MOVE ZERO TO WRK-CS-09V00-011 RL2084.2 +054800 MOVE 01 TO REC-CT. RL2084.2 +054900 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +055000 MOVE ZERO TO RL-FD1-KEY. RL2084.2 +055100 OPEN INPUT RL-FD1. RL2084.2 +055200 MOVE "READ UPDATED FILE" TO FEATURE. RL2084.2 +055300 REL-TEST-014-R. RL2084.2 +055400 ADD 1 TO WRK-CS-09V00-006. RL2084.2 +055500 ADD 1 TO WRK-CS-09V00-007. RL2084.2 +055600 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +055700 READ RL-FD1 NEXT RECORD AT END GO TO REL-TEST-014-3. RL2084.2 +055800 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +055900 IF UPDATE-NUMBER (1) EQUAL TO 99 RL2084.2 +056000 ADD 1 TO WRK-CS-09V00-009. RL2084.2 +056100 IF (WRK-CS-09V00-008 = 1 OR 11 OR 21 OR 31) RL2084.2 +056200 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +056300 IF (WRK-CS-09V00-008 = 32) RL2084.2 +056400 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +056500 IF RL-FD1-KEY EQUAL TO XRECORD-NUMBER (1) RL2084.2 +056600 ADD 1 TO WRK-CS-09V00-010. RL2084.2 +056700 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL2084.2 +056800 ADD 1 TO WRK-CS-09V00-011. RL2084.2 +056900 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +057000 GO TO REL-TEST-014-3. RL2084.2 +057100 GO TO REL-TEST-014-R. RL2084.2 +057200 REL-TEST-014-3. RL2084.2 +057300 IF WRK-CS-09V00-006 NOT EQUAL TO 496 RL2084.2 +057400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2084.2 +057500 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +057600 MOVE 496 TO CORRECT-18V0 RL2084.2 +057700 PERFORM FAIL RL2084.2 +057800 ELSE RL2084.2 +057900 PERFORM PASS. RL2084.2 +058000 PERFORM PRINT-DETAIL. RL2084.2 +058100 ADD 01 TO REC-CT. RL2084.2 +058200* .01 RL2084.2 +058300 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL2084.2 +058400 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2084.2 +058500 MOVE ZERO TO CORRECT-18V0 RL2084.2 +058600 MOVE "DELETED RECORDS" TO RE-MARK RL2084.2 +058700 PERFORM FAIL RL2084.2 +058800 ELSE RL2084.2 +058900 PERFORM PASS. RL2084.2 +059000 PERFORM PRINT-DETAIL. RL2084.2 +059100 ADD 01 TO REC-CT. RL2084.2 +059200* .02 RL2084.2 +059300 IF WRK-CS-09V00-010 NOT EQUAL TO 495 RL2084.2 +059400 MOVE "KEY MISMATCH" TO RE-MARK RL2084.2 +059500 MOVE 495 TO CORRECT-18V0 RL2084.2 +059600 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2084.2 +059700 PERFORM FAIL RL2084.2 +059800 ELSE RL2084.2 +059900 PERFORM PASS. RL2084.2 +060000 PERFORM PRINT-DETAIL. RL2084.2 +060100 ADD 01 TO REC-CT. RL2084.2 +060200* .03 RL2084.2 +060300 IF WRK-CS-09V00-011 NOT EQUAL TO 495 RL2084.2 +060400 MOVE 495 TO CORRECT-18V0 RL2084.2 +060500 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL2084.2 +060600 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL2084.2 +060700 PERFORM FAIL RL2084.2 +060800 ELSE RL2084.2 +060900 PERFORM PASS. RL2084.2 +061000 PERFORM PRINT-DETAIL. RL2084.2 +061100*04 RL2084.2 +061200 CLOSE RL-FD1. RL2084.2 +061300 CCVS-EXIT SECTION. RL2084.2 +061400 CCVS-999999. RL2084.2 +061500 GO TO CLOSE-FILES. RL2084.2 +*END-OF,RL208A +*HEADER,COBOL,RL209A +000100 IDENTIFICATION DIVISION. RL2094.2 +000200 PROGRAM-ID. RL2094.2 +000300 RL209A. RL2094.2 +000400**************************************************************** RL2094.2 +000500* * RL2094.2 +000600* VALIDATION FOR:- * RL2094.2 +000700* * RL2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +000900* * RL2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2094.2 +001100* * RL2094.2 +001200**************************************************************** RL2094.2 +001300* * RL2094.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2094.2 +001500* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2094.2 +001600* IT WAS CREATED CORRECTLY. * RL2094.2 +001700* THE FILE WILL BE IDENTIFIED AS: "RL-VS1". * RL2094.2 +001800* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2094.2 +001900* LENGTH RECORDS. * RL2094.2 +002000* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2094.2 +002100* * RL2094.2 +002200**************************************************************** RL2094.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2094.2 +002400* PROGRAM ARE: RL2094.2 +002500* RL2094.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2094.2 +002700* RELATIVE I-O DATA FILE RL2094.2 +002800* X-55 SYSTEM PRINTER RL2094.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2094.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2094.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2094.2 +003200* X-82 SOURCE-COMPUTER RL2094.2 +003300* X-83 OBJECT-COMPUTER. RL2094.2 +003400* RL2094.2 +003500**************************************************************** RL2094.2 +003600 ENVIRONMENT DIVISION. RL2094.2 +003700 CONFIGURATION SECTION. RL2094.2 +003800 SOURCE-COMPUTER. RL2094.2 +003900 XXXXX082. RL2094.2 +004000 OBJECT-COMPUTER. RL2094.2 +004100 XXXXX083. RL2094.2 +004200 INPUT-OUTPUT SECTION. RL2094.2 +004300 FILE-CONTROL. RL2094.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2094.2 +004500 XXXXX055. RL2094.2 +004600 SELECT RL-FS1 ASSIGN TO RL2094.2 +004700 XXXXP021 RL2094.2 +004800 ORGANIZATION IS RELATIVE. RL2094.2 +004900* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2094.2 +005000* SEQUENTIAL HAD BEEN SPECIFIED. RL2094.2 +005100 DATA DIVISION. RL2094.2 +005200 FILE SECTION. RL2094.2 +005300 FD PRINT-FILE. RL2094.2 +005400 01 PRINT-REC PICTURE X(120). RL2094.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2094.2 +005600 FD RL-FS1 RL2094.2 +005700 LABEL RECORDS STANDARD RL2094.2 +005800C VALUE OF RL2094.2 +005900C XXXXX074 RL2094.2 +006000C IS RL2094.2 +006100C XXXXX075 RL2094.2 +006200G XXXXX069 RL2094.2 +006300 RECORD IS VARYING IN SIZE RL2094.2 +006400 FROM 120 TO 140 CHARACTERS RL2094.2 +006500 DEPENDING ON WRK-SIZE. RL2094.2 +006600 01 RL-FS1R1-F-G-120. RL2094.2 +006700 02 FILLER PIC X(140). RL2094.2 +006800 WORKING-STORAGE SECTION. RL2094.2 +006900 01 WRK-SIZE PIC 9(3). RL2094.2 +007000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2094.2 +007100 01 FILE-RECORD-INFORMATION-REC. RL2094.2 +007200 03 FILE-RECORD-INFO-SKELETON. RL2094.2 +007300 05 FILLER PICTURE X(48) VALUE RL2094.2 +007400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2094.2 +007500 05 FILLER PICTURE X(46) VALUE RL2094.2 +007600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2094.2 +007700 05 FILLER PICTURE X(26) VALUE RL2094.2 +007800 ",LFIL=000000,ORG= ,LBLR= ". RL2094.2 +007900 05 FILLER PICTURE X(37) VALUE RL2094.2 +008000 ",RECKEY= ". RL2094.2 +008100 05 FILLER PICTURE X(38) VALUE RL2094.2 +008200 ",ALTKEY1= ". RL2094.2 +008300 05 FILLER PICTURE X(38) VALUE RL2094.2 +008400 ",ALTKEY2= ". RL2094.2 +008500 05 FILLER PICTURE X(7) VALUE SPACE.RL2094.2 +008600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2094.2 +008700 05 FILE-RECORD-INFO-P1-120. RL2094.2 +008800 07 FILLER PIC X(5). RL2094.2 +008900 07 XFILE-NAME PIC X(6). RL2094.2 +009000 07 FILLER PIC X(8). RL2094.2 +009100 07 XRECORD-NAME PIC X(6). RL2094.2 +009200 07 FILLER PIC X(1). RL2094.2 +009300 07 REELUNIT-NUMBER PIC 9(1). RL2094.2 +009400 07 FILLER PIC X(7). RL2094.2 +009500 07 XRECORD-NUMBER PIC 9(6). RL2094.2 +009600 07 FILLER PIC X(6). RL2094.2 +009700 07 UPDATE-NUMBER PIC 9(2). RL2094.2 +009800 07 FILLER PIC X(5). RL2094.2 +009900 07 ODO-NUMBER PIC 9(4). RL2094.2 +010000 07 FILLER PIC X(5). RL2094.2 +010100 07 XPROGRAM-NAME PIC X(5). RL2094.2 +010200 07 FILLER PIC X(7). RL2094.2 +010300 07 XRECORD-LENGTH PIC 9(6). RL2094.2 +010400 07 FILLER PIC X(7). RL2094.2 +010500 07 CHARS-OR-RECORDS PIC X(2). RL2094.2 +010600 07 FILLER PIC X(1). RL2094.2 +010700 07 XBLOCK-SIZE PIC 9(4). RL2094.2 +010800 07 FILLER PIC X(6). RL2094.2 +010900 07 RECORDS-IN-FILE PIC 9(6). RL2094.2 +011000 07 FILLER PIC X(5). RL2094.2 +011100 07 XFILE-ORGANIZATION PIC X(2). RL2094.2 +011200 07 FILLER PIC X(6). RL2094.2 +011300 07 XLABEL-TYPE PIC X(1). RL2094.2 +011400 05 FILE-RECORD-INFO-P121-240. RL2094.2 +011500 07 FILLER PIC X(8). RL2094.2 +011600 07 XRECORD-KEY PIC X(29). RL2094.2 +011700 07 FILLER PIC X(9). RL2094.2 +011800 07 ALTERNATE-KEY1 PIC X(29). RL2094.2 +011900 07 FILLER PIC X(9). RL2094.2 +012000 07 ALTERNATE-KEY2 PIC X(29). RL2094.2 +012100 07 FILLER PIC X(7). RL2094.2 +012200 01 TEST-RESULTS. RL2094.2 +012300 02 FILLER PIC X VALUE SPACE. RL2094.2 +012400 02 FEATURE PIC X(20) VALUE SPACE. RL2094.2 +012500 02 FILLER PIC X VALUE SPACE. RL2094.2 +012600 02 P-OR-F PIC X(5) VALUE SPACE. RL2094.2 +012700 02 FILLER PIC X VALUE SPACE. RL2094.2 +012800 02 PAR-NAME. RL2094.2 +012900 03 FILLER PIC X(19) VALUE SPACE. RL2094.2 +013000 03 PARDOT-X PIC X VALUE SPACE. RL2094.2 +013100 03 DOTVALUE PIC 99 VALUE ZERO. RL2094.2 +013200 02 FILLER PIC X(8) VALUE SPACE. RL2094.2 +013300 02 RE-MARK PIC X(61). RL2094.2 +013400 01 TEST-COMPUTED. RL2094.2 +013500 02 FILLER PIC X(30) VALUE SPACE. RL2094.2 +013600 02 FILLER PIC X(17) VALUE RL2094.2 +013700 " COMPUTED=". RL2094.2 +013800 02 COMPUTED-X. RL2094.2 +013900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2094.2 +014000 03 COMPUTED-N REDEFINES COMPUTED-A RL2094.2 +014100 PIC -9(9).9(9). RL2094.2 +014200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2094.2 +014300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2094.2 +014400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2094.2 +014500 03 CM-18V0 REDEFINES COMPUTED-A. RL2094.2 +014600 04 COMPUTED-18V0 PIC -9(18). RL2094.2 +014700 04 FILLER PIC X. RL2094.2 +014800 03 FILLER PIC X(50) VALUE SPACE. RL2094.2 +014900 01 TEST-CORRECT. RL2094.2 +015000 02 FILLER PIC X(30) VALUE SPACE. RL2094.2 +015100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2094.2 +015200 02 CORRECT-X. RL2094.2 +015300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2094.2 +015400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2094.2 +015500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2094.2 +015600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2094.2 +015700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2094.2 +015800 03 CR-18V0 REDEFINES CORRECT-A. RL2094.2 +015900 04 CORRECT-18V0 PIC -9(18). RL2094.2 +016000 04 FILLER PIC X. RL2094.2 +016100 03 FILLER PIC X(2) VALUE SPACE. RL2094.2 +016200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2094.2 +016300 01 CCVS-C-1. RL2094.2 +016400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2094.2 +016500- "SS PARAGRAPH-NAME RL2094.2 +016600- " REMARKS". RL2094.2 +016700 02 FILLER PIC X(20) VALUE SPACE. RL2094.2 +016800 01 CCVS-C-2. RL2094.2 +016900 02 FILLER PIC X VALUE SPACE. RL2094.2 +017000 02 FILLER PIC X(6) VALUE "TESTED". RL2094.2 +017100 02 FILLER PIC X(15) VALUE SPACE. RL2094.2 +017200 02 FILLER PIC X(4) VALUE "FAIL". RL2094.2 +017300 02 FILLER PIC X(94) VALUE SPACE. RL2094.2 +017400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2094.2 +017500 01 REC-CT PIC 99 VALUE ZERO. RL2094.2 +017600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2094.2 +018000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2094.2 +018100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2094.2 +018200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2094.2 +018300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2094.2 +018400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2094.2 +018500 01 CCVS-H-1. RL2094.2 +018600 02 FILLER PIC X(39) VALUE SPACES. RL2094.2 +018700 02 FILLER PIC X(42) VALUE RL2094.2 +018800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2094.2 +018900 02 FILLER PIC X(39) VALUE SPACES. RL2094.2 +019000 01 CCVS-H-2A. RL2094.2 +019100 02 FILLER PIC X(40) VALUE SPACE. RL2094.2 +019200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2094.2 +019300 02 FILLER PIC XXXX VALUE RL2094.2 +019400 "4.2 ". RL2094.2 +019500 02 FILLER PIC X(28) VALUE RL2094.2 +019600 " COPY - NOT FOR DISTRIBUTION". RL2094.2 +019700 02 FILLER PIC X(41) VALUE SPACE. RL2094.2 +019800 RL2094.2 +019900 01 CCVS-H-2B. RL2094.2 +020000 02 FILLER PIC X(15) VALUE RL2094.2 +020100 "TEST RESULT OF ". RL2094.2 +020200 02 TEST-ID PIC X(9). RL2094.2 +020300 02 FILLER PIC X(4) VALUE RL2094.2 +020400 " IN ". RL2094.2 +020500 02 FILLER PIC X(12) VALUE RL2094.2 +020600 " HIGH ". RL2094.2 +020700 02 FILLER PIC X(22) VALUE RL2094.2 +020800 " LEVEL VALIDATION FOR ". RL2094.2 +020900 02 FILLER PIC X(58) VALUE RL2094.2 +021000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +021100 01 CCVS-H-3. RL2094.2 +021200 02 FILLER PIC X(34) VALUE RL2094.2 +021300 " FOR OFFICIAL USE ONLY ". RL2094.2 +021400 02 FILLER PIC X(58) VALUE RL2094.2 +021500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2094.2 +021600 02 FILLER PIC X(28) VALUE RL2094.2 +021700 " COPYRIGHT 1985 ". RL2094.2 +021800 01 CCVS-E-1. RL2094.2 +021900 02 FILLER PIC X(52) VALUE SPACE. RL2094.2 +022000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2094.2 +022100 02 ID-AGAIN PIC X(9). RL2094.2 +022200 02 FILLER PIC X(45) VALUE SPACES. RL2094.2 +022300 01 CCVS-E-2. RL2094.2 +022400 02 FILLER PIC X(31) VALUE SPACE. RL2094.2 +022500 02 FILLER PIC X(21) VALUE SPACE. RL2094.2 +022600 02 CCVS-E-2-2. RL2094.2 +022700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2094.2 +022800 03 FILLER PIC X VALUE SPACE. RL2094.2 +022900 03 ENDER-DESC PIC X(44) VALUE RL2094.2 +023000 "ERRORS ENCOUNTERED". RL2094.2 +023100 01 CCVS-E-3. RL2094.2 +023200 02 FILLER PIC X(22) VALUE RL2094.2 +023300 " FOR OFFICIAL USE ONLY". RL2094.2 +023400 02 FILLER PIC X(12) VALUE SPACE. RL2094.2 +023500 02 FILLER PIC X(58) VALUE RL2094.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +023700 02 FILLER PIC X(13) VALUE SPACE. RL2094.2 +023800 02 FILLER PIC X(15) VALUE RL2094.2 +023900 " COPYRIGHT 1985". RL2094.2 +024000 01 CCVS-E-4. RL2094.2 +024100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2094.2 +024200 02 FILLER PIC X(4) VALUE " OF ". RL2094.2 +024300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2094.2 +024400 02 FILLER PIC X(40) VALUE RL2094.2 +024500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2094.2 +024600 01 XXINFO. RL2094.2 +024700 02 FILLER PIC X(19) VALUE RL2094.2 +024800 "*** INFORMATION ***". RL2094.2 +024900 02 INFO-TEXT. RL2094.2 +025000 04 FILLER PIC X(8) VALUE SPACE. RL2094.2 +025100 04 XXCOMPUTED PIC X(20). RL2094.2 +025200 04 FILLER PIC X(5) VALUE SPACE. RL2094.2 +025300 04 XXCORRECT PIC X(20). RL2094.2 +025400 02 INF-ANSI-REFERENCE PIC X(48). RL2094.2 +025500 01 HYPHEN-LINE. RL2094.2 +025600 02 FILLER PIC IS X VALUE IS SPACE. RL2094.2 +025700 02 FILLER PIC IS X(65) VALUE IS "************************RL2094.2 +025800- "*****************************************". RL2094.2 +025900 02 FILLER PIC IS X(54) VALUE IS "************************RL2094.2 +026000- "******************************". RL2094.2 +026100 01 CCVS-PGM-ID PIC X(9) VALUE RL2094.2 +026200 "RL209A". RL2094.2 +026300 PROCEDURE DIVISION. RL2094.2 +026400 CCVS1 SECTION. RL2094.2 +026500 OPEN-FILES. RL2094.2 +026600 OPEN OUTPUT PRINT-FILE. RL2094.2 +026700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2094.2 +026800 MOVE SPACE TO TEST-RESULTS. RL2094.2 +026900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2094.2 +027000 MOVE ZERO TO REC-SKL-SUB. RL2094.2 +027100 PERFORM CCVS-INIT-FILE 9 TIMES. RL2094.2 +027200 CCVS-INIT-FILE. RL2094.2 +027300 ADD 1 TO REC-SKL-SUB. RL2094.2 +027400 MOVE FILE-RECORD-INFO-SKELETON RL2094.2 +027500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2094.2 +027600 CCVS-INIT-EXIT. RL2094.2 +027700 GO TO CCVS1-EXIT. RL2094.2 +027800 CLOSE-FILES. RL2094.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2094.2 +028000 TERMINATE-CCVS. RL2094.2 +028100S EXIT PROGRAM. RL2094.2 +028200STERMINATE-CALL. RL2094.2 +028300 STOP RUN. RL2094.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2094.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2094.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2094.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2094.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. RL2094.2 +028900 PRINT-DETAIL. RL2094.2 +029000 IF REC-CT NOT EQUAL TO ZERO RL2094.2 +029100 MOVE "." TO PARDOT-X RL2094.2 +029200 MOVE REC-CT TO DOTVALUE. RL2094.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2094.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2094.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2094.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2094.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2094.2 +029800 MOVE SPACE TO CORRECT-X. RL2094.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2094.2 +030000 MOVE SPACE TO RE-MARK. RL2094.2 +030100 HEAD-ROUTINE. RL2094.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2094.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2094.2 +030600 COLUMN-NAMES-ROUTINE. RL2094.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +031000 END-ROUTINE. RL2094.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2094.2 +031200 END-RTN-EXIT. RL2094.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +031400 END-ROUTINE-1. RL2094.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2094.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2094.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. RL2094.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2094.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2094.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2094.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2094.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2094.2 +032300 END-ROUTINE-12. RL2094.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2094.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO RL2094.2 +032600 MOVE "NO " TO ERROR-TOTAL RL2094.2 +032700 ELSE RL2094.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2094.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2094.2 +033000 PERFORM WRITE-LINE. RL2094.2 +033100 END-ROUTINE-13. RL2094.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO RL2094.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE RL2094.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2094.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2094.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO RL2094.2 +033800 MOVE "NO " TO ERROR-TOTAL RL2094.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2094.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2094.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +034300 WRITE-LINE. RL2094.2 +034400 ADD 1 TO RECORD-COUNT. RL2094.2 +034500Y IF RECORD-COUNT GREATER 50 RL2094.2 +034600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2094.2 +034700Y MOVE SPACE TO DUMMY-RECORD RL2094.2 +034800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2094.2 +034900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2094.2 +035000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2094.2 +035100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2094.2 +035200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2094.2 +035300Y MOVE ZERO TO RECORD-COUNT. RL2094.2 +035400 PERFORM WRT-LN. RL2094.2 +035500 WRT-LN. RL2094.2 +035600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2094.2 +035700 MOVE SPACE TO DUMMY-RECORD. RL2094.2 +035800 BLANK-LINE-PRINT. RL2094.2 +035900 PERFORM WRT-LN. RL2094.2 +036000 FAIL-ROUTINE. RL2094.2 +036100 IF COMPUTED-X NOT EQUAL TO SPACE RL2094.2 +036200 GO TO FAIL-ROUTINE-WRITE. RL2094.2 +036300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2094.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2094.2 +036500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2094.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2094.2 +036800 GO TO FAIL-ROUTINE-EX. RL2094.2 +036900 FAIL-ROUTINE-WRITE. RL2094.2 +037000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2094.2 +037100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2094.2 +037200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2094.2 +037300 MOVE SPACES TO COR-ANSI-REFERENCE. RL2094.2 +037400 FAIL-ROUTINE-EX. EXIT. RL2094.2 +037500 BAIL-OUT. RL2094.2 +037600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2094.2 +037700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2094.2 +037800 BAIL-OUT-WRITE. RL2094.2 +037900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2094.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2094.2 +038100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2094.2 +038300 BAIL-OUT-EX. EXIT. RL2094.2 +038400 CCVS1-EXIT. RL2094.2 +038500 EXIT. RL2094.2 +038600 SECT-RL201-001 SECTION. RL2094.2 +038700 REL-INIT-001. RL2094.2 +038800 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2094.2 +038900 OPEN OUTPUT RL-FS1. RL2094.2 +039000 MOVE "RL-FS1" TO XFILE-NAME (1). RL2094.2 +039100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2094.2 +039200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2094.2 +039300 MOVE 000120 TO XRECORD-LENGTH (1). RL2094.2 +039400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2094.2 +039500 MOVE 0001 TO XBLOCK-SIZE (1). RL2094.2 +039600 MOVE 000500 TO RECORDS-IN-FILE (1). RL2094.2 +039700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2094.2 +039800 MOVE "S" TO XLABEL-TYPE (1). RL2094.2 +039900 MOVE 000001 TO XRECORD-NUMBER (1). RL2094.2 +040000 REL-TEST-001. RL2094.2 +040100 MOVE 120 TO WRK-SIZE. RL2094.2 +040200 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2094.2 +040300 WRITE RL-FS1R1-F-G-120 RL2094.2 +040400 INVALID KEY GO TO REL-FAIL-001. RL2094.2 +040500 IF XRECORD-NUMBER (1) EQUAL TO 250 RL2094.2 +040600 GO TO REL-TEST-001-2. RL2094.2 +040700 ADD 000001 TO XRECORD-NUMBER (1). RL2094.2 +040800 GO TO REL-TEST-001. RL2094.2 +040900 REL-TEST-001-1. RL2094.2 +041000 MOVE 140 TO WRK-SIZE XRECORD-LENGTH(1). RL2094.2 +041100 MOVE FILE-RECORD-INFO(1) TO RL-FS1R1-F-G-120. RL2094.2 +041200 WRITE RL-FS1R1-F-G-120 RL2094.2 +041300 INVALID KEY GO TO REL-FAIL-001. RL2094.2 +041400 IF XRECORD-NUMBER(1) EQUAL TO 500 RL2094.2 +041500 GO TO REL-WRITE-001. RL2094.2 +041600 REL-TEST-001-2. RL2094.2 +041700 ADD 000001 TO XRECORD-NUMBER(1). RL2094.2 +041800 GO TO REL-TEST-001-1. RL2094.2 +041900 REL-DELETE-001. RL2094.2 +042000 PERFORM DE-LETE. RL2094.2 +042100 GO TO REL-WRITE-001. RL2094.2 +042200 REL-FAIL-001. RL2094.2 +042300 PERFORM FAIL. RL2094.2 +042400 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2094.2 +042500 REL-WRITE-001. RL2094.2 +042600 MOVE "REL-TEST-001" TO PAR-NAME RL2094.2 +042700 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2094.2 +042800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2094.2 +042900 PERFORM PRINT-DETAIL. RL2094.2 +043000 CLOSE RL-FS1. RL2094.2 +043100 REL-INIT-002. RL2094.2 +043200 OPEN INPUT RL-FS1. RL2094.2 +043300 MOVE ZERO TO WRK-CS-09V00. RL2094.2 +043400 REL-TEST-002. RL2094.2 +043500 READ RL-FS1 RL2094.2 +043600 AT END GO TO REL-TEST-002-1. RL2094.2 +043700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2094.2 +043800 ADD 1 TO WRK-CS-09V00. RL2094.2 +043900 IF WRK-CS-09V00 GREATER 500 RL2094.2 +044000 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2094.2 +044100 GO TO REL-TEST-002-1. RL2094.2 +044200 GO TO REL-TEST-002. RL2094.2 +044300 REL-DELETE-002. RL2094.2 +044400 PERFORM DE-LETE. RL2094.2 +044500 PERFORM PRINT-DETAIL. RL2094.2 +044600 REL-TEST-002-1. RL2094.2 +044700 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2094.2 +044800 PERFORM FAIL RL2094.2 +044900 ELSE RL2094.2 +045000 PERFORM PASS. RL2094.2 +045100 GO TO REL-WRITE-002. RL2094.2 +045200 REL-WRITE-002. RL2094.2 +045300 MOVE "REL-TEST-002" TO PAR-NAME. RL2094.2 +045400 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2094.2 +045500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2094.2 +045600 PERFORM PRINT-DETAIL. RL2094.2 +045700 CLOSE RL-FS1. RL2094.2 +045800 CCVS-EXIT SECTION. RL2094.2 +045900 CCVS-999999. RL2094.2 +046000 GO TO CLOSE-FILES. RL2094.2 +*END-OF,RL209A +*HEADER,COBOL,RL210A +000100 IDENTIFICATION DIVISION. RL2104.2 +000200 PROGRAM-ID. RL2104.2 +000300 RL210A. RL2104.2 +000400**************************************************************** RL2104.2 +000500* * RL2104.2 +000600* VALIDATION FOR:- * RL2104.2 +000700* * RL2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +000900* * RL2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2104.2 +001100* * RL2104.2 +001200**************************************************************** RL2104.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2104.2 +001400* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2104.2 +001500* IT WAS CREATED CORRECTLY. * RL2104.2 +001600* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2104.2 +001700* LENGTH RECORDS. * RL2104.2 +001800* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2104.2 +001900* RL2104.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2104.2 +002100* PROGRAM ARE: RL2104.2 +002200* RL2104.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2104.2 +002400* RELATIVE I-O DATA FILE RL2104.2 +002500* X-55 SYSTEM PRINTER RL2104.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2104.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2104.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2104.2 +002900* X-82 SOURCE-COMPUTER RL2104.2 +003000* X-83 OBJECT-COMPUTER. RL2104.2 +003100* RL2104.2 +003200**************************************************************** RL2104.2 +003300 ENVIRONMENT DIVISION. RL2104.2 +003400 CONFIGURATION SECTION. RL2104.2 +003500 SOURCE-COMPUTER. RL2104.2 +003600 XXXXX082. RL2104.2 +003700 OBJECT-COMPUTER. RL2104.2 +003800 XXXXX083. RL2104.2 +003900 INPUT-OUTPUT SECTION. RL2104.2 +004000 FILE-CONTROL. RL2104.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2104.2 +004200 XXXXX055. RL2104.2 +004300 SELECT RL-VS1 ASSIGN TO RL2104.2 +004400 XXXXP021 RL2104.2 +004500 ORGANIZATION IS RELATIVE. RL2104.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2104.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2104.2 +004800 DATA DIVISION. RL2104.2 +004900 FILE SECTION. RL2104.2 +005000 FD PRINT-FILE. RL2104.2 +005100 01 PRINT-REC PICTURE X(120). RL2104.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2104.2 +005300 FD RL-VS1 RL2104.2 +005400 LABEL RECORDS STANDARD RL2104.2 +005500C VALUE OF RL2104.2 +005600C XXXXX074 RL2104.2 +005700C IS RL2104.2 +005800C XXXXX075 RL2104.2 +005900G XXXXX069 RL2104.2 +006000 BLOCK CONTAINS 1 RECORDS RL2104.2 +006100 RECORD IS VARYING. RL2104.2 +006200 01 RL-VS1R2-F-G-140. RL2104.2 +006300 02 FILLER PIC X(120). RL2104.2 +006400 02 RL-VS1R2-F-G-121-124 PIC 9(4). RL2104.2 +006500 02 RL-GROUP. RL2104.2 +006600 03 RL-VS1R2-F-G-125-140 PIC X OCCURS 1 TO 16 RL2104.2 +006700 DEPENDING ON RL-VS1R2-F-G-121-124. RL2104.2 +006800 01 RL-VS1R1-F-G-120. RL2104.2 +006900 02 FILLER PIC X(120). RL2104.2 +007000 WORKING-STORAGE SECTION. RL2104.2 +007100 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2104.2 +007200 01 FILE-RECORD-INFORMATION-REC. RL2104.2 +007300 03 FILE-RECORD-INFO-SKELETON. RL2104.2 +007400 05 FILLER PICTURE X(48) VALUE RL2104.2 +007500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2104.2 +007600 05 FILLER PICTURE X(46) VALUE RL2104.2 +007700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2104.2 +007800 05 FILLER PICTURE X(26) VALUE RL2104.2 +007900 ",LFIL=000000,ORG= ,LBLR= ". RL2104.2 +008000 05 FILLER PICTURE X(37) VALUE RL2104.2 +008100 ",RECKEY= ". RL2104.2 +008200 05 FILLER PICTURE X(38) VALUE RL2104.2 +008300 ",ALTKEY1= ". RL2104.2 +008400 05 FILLER PICTURE X(38) VALUE RL2104.2 +008500 ",ALTKEY2= ". RL2104.2 +008600 05 FILLER PICTURE X(7) VALUE SPACE.RL2104.2 +008700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2104.2 +008800 05 FILE-RECORD-INFO-P1-120. RL2104.2 +008900 07 FILLER PIC X(5). RL2104.2 +009000 07 XFILE-NAME PIC X(6). RL2104.2 +009100 07 FILLER PIC X(8). RL2104.2 +009200 07 XRECORD-NAME PIC X(6). RL2104.2 +009300 07 FILLER PIC X(1). RL2104.2 +009400 07 REELUNIT-NUMBER PIC 9(1). RL2104.2 +009500 07 FILLER PIC X(7). RL2104.2 +009600 07 XRECORD-NUMBER PIC 9(6). RL2104.2 +009700 07 FILLER PIC X(6). RL2104.2 +009800 07 UPDATE-NUMBER PIC 9(2). RL2104.2 +009900 07 FILLER PIC X(5). RL2104.2 +010000 07 ODO-NUMBER PIC 9(4). RL2104.2 +010100 07 FILLER PIC X(5). RL2104.2 +010200 07 XPROGRAM-NAME PIC X(5). RL2104.2 +010300 07 FILLER PIC X(7). RL2104.2 +010400 07 XRECORD-LENGTH PIC 9(6). RL2104.2 +010500 07 FILLER PIC X(7). RL2104.2 +010600 07 CHARS-OR-RECORDS PIC X(2). RL2104.2 +010700 07 FILLER PIC X(1). RL2104.2 +010800 07 XBLOCK-SIZE PIC 9(4). RL2104.2 +010900 07 FILLER PIC X(6). RL2104.2 +011000 07 RECORDS-IN-FILE PIC 9(6). RL2104.2 +011100 07 FILLER PIC X(5). RL2104.2 +011200 07 XFILE-ORGANIZATION PIC X(2). RL2104.2 +011300 07 FILLER PIC X(6). RL2104.2 +011400 07 XLABEL-TYPE PIC X(1). RL2104.2 +011500 05 FILE-RECORD-INFO-P121-240. RL2104.2 +011600 07 FILLER PIC X(8). RL2104.2 +011700 07 XRECORD-KEY PIC X(29). RL2104.2 +011800 07 FILLER PIC X(9). RL2104.2 +011900 07 ALTERNATE-KEY1 PIC X(29). RL2104.2 +012000 07 FILLER PIC X(9). RL2104.2 +012100 07 ALTERNATE-KEY2 PIC X(29). RL2104.2 +012200 07 FILLER PIC X(7). RL2104.2 +012300 01 TEST-RESULTS. RL2104.2 +012400 02 FILLER PIC X VALUE SPACE. RL2104.2 +012500 02 FEATURE PIC X(20) VALUE SPACE. RL2104.2 +012600 02 FILLER PIC X VALUE SPACE. RL2104.2 +012700 02 P-OR-F PIC X(5) VALUE SPACE. RL2104.2 +012800 02 FILLER PIC X VALUE SPACE. RL2104.2 +012900 02 PAR-NAME. RL2104.2 +013000 03 FILLER PIC X(19) VALUE SPACE. RL2104.2 +013100 03 PARDOT-X PIC X VALUE SPACE. RL2104.2 +013200 03 DOTVALUE PIC 99 VALUE ZERO. RL2104.2 +013300 02 FILLER PIC X(8) VALUE SPACE. RL2104.2 +013400 02 RE-MARK PIC X(61). RL2104.2 +013500 01 TEST-COMPUTED. RL2104.2 +013600 02 FILLER PIC X(30) VALUE SPACE. RL2104.2 +013700 02 FILLER PIC X(17) VALUE RL2104.2 +013800 " COMPUTED=". RL2104.2 +013900 02 COMPUTED-X. RL2104.2 +014000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2104.2 +014100 03 COMPUTED-N REDEFINES COMPUTED-A RL2104.2 +014200 PIC -9(9).9(9). RL2104.2 +014300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2104.2 +014400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2104.2 +014500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2104.2 +014600 03 CM-18V0 REDEFINES COMPUTED-A. RL2104.2 +014700 04 COMPUTED-18V0 PIC -9(18). RL2104.2 +014800 04 FILLER PIC X. RL2104.2 +014900 03 FILLER PIC X(50) VALUE SPACE. RL2104.2 +015000 01 TEST-CORRECT. RL2104.2 +015100 02 FILLER PIC X(30) VALUE SPACE. RL2104.2 +015200 02 FILLER PIC X(17) VALUE " CORRECT =". RL2104.2 +015300 02 CORRECT-X. RL2104.2 +015400 03 CORRECT-A PIC X(20) VALUE SPACE. RL2104.2 +015500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2104.2 +015600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2104.2 +015700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2104.2 +015800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2104.2 +015900 03 CR-18V0 REDEFINES CORRECT-A. RL2104.2 +016000 04 CORRECT-18V0 PIC -9(18). RL2104.2 +016100 04 FILLER PIC X. RL2104.2 +016200 03 FILLER PIC X(2) VALUE SPACE. RL2104.2 +016300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2104.2 +016400 01 CCVS-C-1. RL2104.2 +016500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2104.2 +016600- "SS PARAGRAPH-NAME RL2104.2 +016700- " REMARKS". RL2104.2 +016800 02 FILLER PIC X(20) VALUE SPACE. RL2104.2 +016900 01 CCVS-C-2. RL2104.2 +017000 02 FILLER PIC X VALUE SPACE. RL2104.2 +017100 02 FILLER PIC X(6) VALUE "TESTED". RL2104.2 +017200 02 FILLER PIC X(15) VALUE SPACE. RL2104.2 +017300 02 FILLER PIC X(4) VALUE "FAIL". RL2104.2 +017400 02 FILLER PIC X(94) VALUE SPACE. RL2104.2 +017500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2104.2 +017600 01 REC-CT PIC 99 VALUE ZERO. RL2104.2 +017700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2104.2 +017800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2104.2 +017900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2104.2 +018000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2104.2 +018100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2104.2 +018200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2104.2 +018300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2104.2 +018400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2104.2 +018500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2104.2 +018600 01 CCVS-H-1. RL2104.2 +018700 02 FILLER PIC X(39) VALUE SPACES. RL2104.2 +018800 02 FILLER PIC X(42) VALUE RL2104.2 +018900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2104.2 +019000 02 FILLER PIC X(39) VALUE SPACES. RL2104.2 +019100 01 CCVS-H-2A. RL2104.2 +019200 02 FILLER PIC X(40) VALUE SPACE. RL2104.2 +019300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2104.2 +019400 02 FILLER PIC XXXX VALUE RL2104.2 +019500 "4.2 ". RL2104.2 +019600 02 FILLER PIC X(28) VALUE RL2104.2 +019700 " COPY - NOT FOR DISTRIBUTION". RL2104.2 +019800 02 FILLER PIC X(41) VALUE SPACE. RL2104.2 +019900 RL2104.2 +020000 01 CCVS-H-2B. RL2104.2 +020100 02 FILLER PIC X(15) VALUE RL2104.2 +020200 "TEST RESULT OF ". RL2104.2 +020300 02 TEST-ID PIC X(9). RL2104.2 +020400 02 FILLER PIC X(4) VALUE RL2104.2 +020500 " IN ". RL2104.2 +020600 02 FILLER PIC X(12) VALUE RL2104.2 +020700 " HIGH ". RL2104.2 +020800 02 FILLER PIC X(22) VALUE RL2104.2 +020900 " LEVEL VALIDATION FOR ". RL2104.2 +021000 02 FILLER PIC X(58) VALUE RL2104.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +021200 01 CCVS-H-3. RL2104.2 +021300 02 FILLER PIC X(34) VALUE RL2104.2 +021400 " FOR OFFICIAL USE ONLY ". RL2104.2 +021500 02 FILLER PIC X(58) VALUE RL2104.2 +021600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2104.2 +021700 02 FILLER PIC X(28) VALUE RL2104.2 +021800 " COPYRIGHT 1985 ". RL2104.2 +021900 01 CCVS-E-1. RL2104.2 +022000 02 FILLER PIC X(52) VALUE SPACE. RL2104.2 +022100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2104.2 +022200 02 ID-AGAIN PIC X(9). RL2104.2 +022300 02 FILLER PIC X(45) VALUE SPACES. RL2104.2 +022400 01 CCVS-E-2. RL2104.2 +022500 02 FILLER PIC X(31) VALUE SPACE. RL2104.2 +022600 02 FILLER PIC X(21) VALUE SPACE. RL2104.2 +022700 02 CCVS-E-2-2. RL2104.2 +022800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2104.2 +022900 03 FILLER PIC X VALUE SPACE. RL2104.2 +023000 03 ENDER-DESC PIC X(44) VALUE RL2104.2 +023100 "ERRORS ENCOUNTERED". RL2104.2 +023200 01 CCVS-E-3. RL2104.2 +023300 02 FILLER PIC X(22) VALUE RL2104.2 +023400 " FOR OFFICIAL USE ONLY". RL2104.2 +023500 02 FILLER PIC X(12) VALUE SPACE. RL2104.2 +023600 02 FILLER PIC X(58) VALUE RL2104.2 +023700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +023800 02 FILLER PIC X(13) VALUE SPACE. RL2104.2 +023900 02 FILLER PIC X(15) VALUE RL2104.2 +024000 " COPYRIGHT 1985". RL2104.2 +024100 01 CCVS-E-4. RL2104.2 +024200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2104.2 +024300 02 FILLER PIC X(4) VALUE " OF ". RL2104.2 +024400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2104.2 +024500 02 FILLER PIC X(40) VALUE RL2104.2 +024600 " TESTS WERE EXECUTED SUCCESSFULLY". RL2104.2 +024700 01 XXINFO. RL2104.2 +024800 02 FILLER PIC X(19) VALUE RL2104.2 +024900 "*** INFORMATION ***". RL2104.2 +025000 02 INFO-TEXT. RL2104.2 +025100 04 FILLER PIC X(8) VALUE SPACE. RL2104.2 +025200 04 XXCOMPUTED PIC X(20). RL2104.2 +025300 04 FILLER PIC X(5) VALUE SPACE. RL2104.2 +025400 04 XXCORRECT PIC X(20). RL2104.2 +025500 02 INF-ANSI-REFERENCE PIC X(48). RL2104.2 +025600 01 HYPHEN-LINE. RL2104.2 +025700 02 FILLER PIC IS X VALUE IS SPACE. RL2104.2 +025800 02 FILLER PIC IS X(65) VALUE IS "************************RL2104.2 +025900- "*****************************************". RL2104.2 +026000 02 FILLER PIC IS X(54) VALUE IS "************************RL2104.2 +026100- "******************************". RL2104.2 +026200 01 CCVS-PGM-ID PIC X(9) VALUE RL2104.2 +026300 "RL210A". RL2104.2 +026400 PROCEDURE DIVISION. RL2104.2 +026500 CCVS1 SECTION. RL2104.2 +026600 OPEN-FILES. RL2104.2 +026700 OPEN OUTPUT PRINT-FILE. RL2104.2 +026800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2104.2 +026900 MOVE SPACE TO TEST-RESULTS. RL2104.2 +027000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2104.2 +027100 MOVE ZERO TO REC-SKL-SUB. RL2104.2 +027200 PERFORM CCVS-INIT-FILE 9 TIMES. RL2104.2 +027300 CCVS-INIT-FILE. RL2104.2 +027400 ADD 1 TO REC-SKL-SUB. RL2104.2 +027500 MOVE FILE-RECORD-INFO-SKELETON RL2104.2 +027600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2104.2 +027700 CCVS-INIT-EXIT. RL2104.2 +027800 GO TO CCVS1-EXIT. RL2104.2 +027900 CLOSE-FILES. RL2104.2 +028000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2104.2 +028100 TERMINATE-CCVS. RL2104.2 +028200S EXIT PROGRAM. RL2104.2 +028300STERMINATE-CALL. RL2104.2 +028400 STOP RUN. RL2104.2 +028500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2104.2 +028600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2104.2 +028700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2104.2 +028800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2104.2 +028900 MOVE "****TEST DELETED****" TO RE-MARK. RL2104.2 +029000 PRINT-DETAIL. RL2104.2 +029100 IF REC-CT NOT EQUAL TO ZERO RL2104.2 +029200 MOVE "." TO PARDOT-X RL2104.2 +029300 MOVE REC-CT TO DOTVALUE. RL2104.2 +029400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2104.2 +029500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2104.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2104.2 +029700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2104.2 +029800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2104.2 +029900 MOVE SPACE TO CORRECT-X. RL2104.2 +030000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2104.2 +030100 MOVE SPACE TO RE-MARK. RL2104.2 +030200 HEAD-ROUTINE. RL2104.2 +030300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +030400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +030500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2104.2 +030600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2104.2 +030700 COLUMN-NAMES-ROUTINE. RL2104.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +031100 END-ROUTINE. RL2104.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2104.2 +031300 END-RTN-EXIT. RL2104.2 +031400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +031500 END-ROUTINE-1. RL2104.2 +031600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2104.2 +031700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2104.2 +031800 ADD PASS-COUNTER TO ERROR-HOLD. RL2104.2 +031900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2104.2 +032000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2104.2 +032100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2104.2 +032200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2104.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2104.2 +032400 END-ROUTINE-12. RL2104.2 +032500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2104.2 +032600 IF ERROR-COUNTER IS EQUAL TO ZERO RL2104.2 +032700 MOVE "NO " TO ERROR-TOTAL RL2104.2 +032800 ELSE RL2104.2 +032900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2104.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2104.2 +033100 PERFORM WRITE-LINE. RL2104.2 +033200 END-ROUTINE-13. RL2104.2 +033300 IF DELETE-COUNTER IS EQUAL TO ZERO RL2104.2 +033400 MOVE "NO " TO ERROR-TOTAL ELSE RL2104.2 +033500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2104.2 +033600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2104.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +033800 IF INSPECT-COUNTER EQUAL TO ZERO RL2104.2 +033900 MOVE "NO " TO ERROR-TOTAL RL2104.2 +034000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2104.2 +034100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2104.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +034300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +034400 WRITE-LINE. RL2104.2 +034500 ADD 1 TO RECORD-COUNT. RL2104.2 +034600Y IF RECORD-COUNT GREATER 50 RL2104.2 +034700Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2104.2 +034800Y MOVE SPACE TO DUMMY-RECORD RL2104.2 +034900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2104.2 +035000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2104.2 +035100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2104.2 +035200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2104.2 +035300Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2104.2 +035400Y MOVE ZERO TO RECORD-COUNT. RL2104.2 +035500 PERFORM WRT-LN. RL2104.2 +035600 WRT-LN. RL2104.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2104.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL2104.2 +035900 BLANK-LINE-PRINT. RL2104.2 +036000 PERFORM WRT-LN. RL2104.2 +036100 FAIL-ROUTINE. RL2104.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE RL2104.2 +036300 GO TO FAIL-ROUTINE-WRITE. RL2104.2 +036400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2104.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2104.2 +036600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2104.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. RL2104.2 +036900 GO TO FAIL-ROUTINE-EX. RL2104.2 +037000 FAIL-ROUTINE-WRITE. RL2104.2 +037100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2104.2 +037200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2104.2 +037300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2104.2 +037400 MOVE SPACES TO COR-ANSI-REFERENCE. RL2104.2 +037500 FAIL-ROUTINE-EX. EXIT. RL2104.2 +037600 BAIL-OUT. RL2104.2 +037700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2104.2 +037800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2104.2 +037900 BAIL-OUT-WRITE. RL2104.2 +038000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2104.2 +038100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2104.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. RL2104.2 +038400 BAIL-OUT-EX. EXIT. RL2104.2 +038500 CCVS1-EXIT. RL2104.2 +038600 EXIT. RL2104.2 +038700 SECT-RL210A-001 SECTION. RL2104.2 +038800 REL-INIT-001. RL2104.2 +038900 MOVE "FILE CREATE RL-VS1" TO FEATURE. RL2104.2 +039000 OPEN OUTPUT RL-VS1. RL2104.2 +039100 MOVE "RL-VS1" TO XFILE-NAME (1). RL2104.2 +039200 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2104.2 +039300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2104.2 +039400 MOVE 000120 TO XRECORD-LENGTH (1). RL2104.2 +039500 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2104.2 +039600 MOVE 0001 TO XBLOCK-SIZE (1). RL2104.2 +039700 MOVE 000500 TO RECORDS-IN-FILE (1). RL2104.2 +039800 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2104.2 +039900 MOVE "S" TO XLABEL-TYPE (1). RL2104.2 +040000 MOVE 000001 TO XRECORD-NUMBER (1). RL2104.2 +040100 REL-TEST-001. RL2104.2 +040200 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-VS1R1-F-G-120. RL2104.2 +040300 IF XRECORD-NUMBER (1) < 201 RL2104.2 +040400 WRITE RL-VS1R1-F-G-120 RL2104.2 +040500 INVALID KEY GO TO REL-FAIL-001 RL2104.2 +040600 ELSE RL2104.2 +040700 MOVE 16 TO RL-VS1R2-F-G-121-124 RL2104.2 +040800 MOVE "ABCDEFGHIJKLMNOP" TO RL-GROUP RL2104.2 +040900 WRITE RL-VS1R2-F-G-140 RL2104.2 +041000 INVALID KEY GO TO REL-FAIL-001. RL2104.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2104.2 +041200 GO TO REL-WRITE-001. RL2104.2 +041300 ADD 000001 TO XRECORD-NUMBER (1). RL2104.2 +041400 GO TO REL-TEST-001. RL2104.2 +041500 REL-DELETE-001. RL2104.2 +041600 PERFORM DE-LETE. RL2104.2 +041700 GO TO REL-WRITE-001. RL2104.2 +041800 REL-FAIL-001. RL2104.2 +041900 PERFORM FAIL. RL2104.2 +042000 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2104.2 +042100 REL-WRITE-001. RL2104.2 +042200 MOVE "REL-TEST-001" TO PAR-NAME RL2104.2 +042300 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2104.2 +042400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2104.2 +042500 PERFORM PRINT-DETAIL. RL2104.2 +042600 CLOSE RL-VS1. RL2104.2 +042700 REL-INIT-002. RL2104.2 +042800 OPEN INPUT RL-VS1. RL2104.2 +042900 MOVE ZERO TO WRK-CS-09V00. RL2104.2 +043000 REL-TEST-002. RL2104.2 +043100 MOVE SPACES TO RL-VS1R2-F-G-140. RL2104.2 +043200 READ RL-VS1 RL2104.2 +043300 AT END GO TO REL-TEST-002-2. RL2104.2 +043400 MOVE RL-VS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2104.2 +043500 ADD 1 TO WRK-CS-09V00. RL2104.2 +043600 IF WRK-CS-09V00 GREATER 500 RL2104.2 +043700 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2104.2 +043800 GO TO REL-TEST-002-2. RL2104.2 +043900 REL-TEST-002-1-1. RL2104.2 +044000 MOVE "VIII-31 3.8.4 GR 10B" TO ANSI-REFERENCE. RL2104.2 +044100 MOVE "REL-TEST-002-1-1" TO PAR-NAME. RL2104.2 +044200 IF XLABEL-TYPE (1) NOT = "S" RL2104.2 +044300 MOVE XLABEL-TYPE (1) TO COMPUTED-X RL2104.2 +044400 MOVE "S" TO CORRECT-X RL2104.2 +044500 MOVE "INVALID RECORD READ" TO RE-MARK RL2104.2 +044600 PERFORM FAIL RL2104.2 +044700 PERFORM PRINT-DETAIL. RL2104.2 +044800 REL-TEST-002-1-2. RL2104.2 +044900 MOVE "VIII-31 3.8.4 GR 10C" TO ANSI-REFERENCE. RL2104.2 +045000 MOVE "REL-TEST-002-1-2" TO PAR-NAME. RL2104.2 +045100 IF XRECORD-NUMBER (1) > 200 RL2104.2 +045200 IF RL-VS1R2-F-G-121-124 NOT = 16 RL2104.2 +045300 MOVE RL-VS1R2-F-G-121-124 TO COMPUTED-N RL2104.2 +045400 MOVE 16 TO CORRECT-N RL2104.2 +045500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2104.2 +045600 PERFORM FAIL RL2104.2 +045700 PERFORM PRINT-DETAIL. RL2104.2 +045800 REL-TEST-002-1-3. RL2104.2 +045900 MOVE "VIII-31 3.8.4 GR 10B" TO ANSI-REFERENCE. RL2104.2 +046000 MOVE "REL-TEST-002-1-3" TO PAR-NAME. RL2104.2 +046100 IF XRECORD-NUMBER (1) > 200 RL2104.2 +046200 IF RL-GROUP NOT = "ABCDEFGHIJKLMNOP" RL2104.2 +046300 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-X RL2104.2 +046400 MOVE RL-GROUP TO COMPUTED-X RL2104.2 +046500 MOVE "INVALID RECORD READ" TO RE-MARK RL2104.2 +046600 PERFORM FAIL RL2104.2 +046700 PERFORM PRINT-DETAIL. RL2104.2 +046800 GO TO REL-TEST-002. RL2104.2 +046900 REL-DELETE-002. RL2104.2 +047000 PERFORM DE-LETE. RL2104.2 +047100 PERFORM PRINT-DETAIL. RL2104.2 +047200 REL-TEST-002-2. RL2104.2 +047300 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2104.2 +047400 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2104.2 +047500 PERFORM FAIL RL2104.2 +047600 ELSE RL2104.2 +047700 PERFORM PASS. RL2104.2 +047800 GO TO REL-WRITE-002. RL2104.2 +047900 REL-WRITE-002. RL2104.2 +048000 MOVE "REL-TEST-002" TO PAR-NAME. RL2104.2 +048100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2104.2 +048200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2104.2 +048300 PERFORM PRINT-DETAIL. RL2104.2 +048400 CLOSE RL-VS1. RL2104.2 +048500 CCVS-EXIT SECTION. RL2104.2 +048600 CCVS-999999. RL2104.2 +048700 GO TO CLOSE-FILES. RL2104.2 +*END-OF,RL210A +*HEADER,COBOL,RL211A +000100 IDENTIFICATION DIVISION. RL2114.2 +000200 PROGRAM-ID. RL2114.2 +000300 RL211A. RL2114.2 +000400**************************************************************** RL2114.2 +000500* * RL2114.2 +000600* VALIDATION FOR:- * RL2114.2 +000700* * RL2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +000900* * RL2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2114.2 +001100* * RL2114.2 +001200**************************************************************** RL2114.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2114.2 +001400* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2114.2 +001500* IT WAS CREATED CORRECTLY. * RL2114.2 +001600* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2114.2 +001700* LENGTH RECORDS. * RL2114.2 +001800* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2114.2 +001900* RL2114.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2114.2 +002100* PROGRAM ARE: RL2114.2 +002200* RL2114.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2114.2 +002400* RELATIVE I-O DATA FILE RL2114.2 +002500* X-55 SYSTEM PRINTER RL2114.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2114.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2114.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2114.2 +002900* X-82 SOURCE-COMPUTER RL2114.2 +003000* X-83 OBJECT-COMPUTER. RL2114.2 +003100* RL2114.2 +003200**************************************************************** RL2114.2 +003300 ENVIRONMENT DIVISION. RL2114.2 +003400 CONFIGURATION SECTION. RL2114.2 +003500 SOURCE-COMPUTER. RL2114.2 +003600 XXXXX082. RL2114.2 +003700 OBJECT-COMPUTER. RL2114.2 +003800 XXXXX083. RL2114.2 +003900 INPUT-OUTPUT SECTION. RL2114.2 +004000 FILE-CONTROL. RL2114.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2114.2 +004200 XXXXX055. RL2114.2 +004300 SELECT RL-VS1 ASSIGN TO RL2114.2 +004400 XXXXP021 RL2114.2 +004500 ORGANIZATION IS RELATIVE. RL2114.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2114.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2114.2 +004800 DATA DIVISION. RL2114.2 +004900 FILE SECTION. RL2114.2 +005000 FD PRINT-FILE. RL2114.2 +005100 01 PRINT-REC PICTURE X(120). RL2114.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2114.2 +005300 FD RL-VS1 RL2114.2 +005400 LABEL RECORDS STANDARD RL2114.2 +005500C VALUE OF RL2114.2 +005600C XXXXX074 RL2114.2 +005700C IS RL2114.2 +005800C XXXXX075 RL2114.2 +005900G XXXXX069 RL2114.2 +006000 BLOCK CONTAINS 1 RECORDS RL2114.2 +006100 RECORD IS VARYING. RL2114.2 +006200 01 RL-VS1R1-F-G-140. RL2114.2 +006300 02 FILLER PIC X. RL2114.2 +006400 02 FILLER PIC X(7). RL2114.2 +006500 02 FILLER PIC X(108). RL2114.2 +006600 02 RL-VS1R1-F-G-117-119 PIC 9(3). RL2114.2 +006700 02 RL-GROUP. RL2114.2 +006800 03 RL-VS1R1-F-G-120-140 PIC X OCCURS 1 TO 21 RL2114.2 +006900 DEPENDING ON RL-VS1R1-F-G-117-119. RL2114.2 +007000 WORKING-STORAGE SECTION. RL2114.2 +007100 01 WS-VS1R1-F-G-140. RL2114.2 +007200 02 FILLER PIC X(116). RL2114.2 +007300 02 WS-VS1R1-F-G-117-119 PIC 9(3). RL2114.2 +007400 02 WS-VS1R1-F-G-120-140 PIC X(21). RL2114.2 +007500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2114.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL2114.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL2114.2 +007800 05 FILLER PICTURE X(48) VALUE RL2114.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2114.2 +008000 05 FILLER PICTURE X(46) VALUE RL2114.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2114.2 +008200 05 FILLER PICTURE X(26) VALUE RL2114.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL2114.2 +008400 05 FILLER PICTURE X(37) VALUE RL2114.2 +008500 ",RECKEY= ". RL2114.2 +008600 05 FILLER PICTURE X(38) VALUE RL2114.2 +008700 ",ALTKEY1= ". RL2114.2 +008800 05 FILLER PICTURE X(38) VALUE RL2114.2 +008900 ",ALTKEY2= ". RL2114.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL2114.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2114.2 +009200 05 FILE-RECORD-INFO-P1-120. RL2114.2 +009300 07 FILLER PIC X(5). RL2114.2 +009400 07 XFILE-NAME PIC X(6). RL2114.2 +009500 07 FILLER PIC X(8). RL2114.2 +009600 07 XRECORD-NAME PIC X(6). RL2114.2 +009700 07 FILLER PIC X(1). RL2114.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL2114.2 +009900 07 FILLER PIC X(7). RL2114.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL2114.2 +010100 07 FILLER PIC X(6). RL2114.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL2114.2 +010300 07 FILLER PIC X(5). RL2114.2 +010400 07 ODO-NUMBER PIC 9(4). RL2114.2 +010500 07 FILLER PIC X(5). RL2114.2 +010600 07 XPROGRAM-NAME PIC X(5). RL2114.2 +010700 07 FILLER PIC X(7). RL2114.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL2114.2 +010900 07 FILLER PIC X(7). RL2114.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL2114.2 +011100 07 FILLER PIC X(1). RL2114.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL2114.2 +011300 07 FILLER PIC X(6). RL2114.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL2114.2 +011500 07 FILLER PIC X(5). RL2114.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL2114.2 +011700 07 FILLER PIC X(6). RL2114.2 +011800 07 XLABEL-TYPE PIC X(1). RL2114.2 +011900 05 FILE-RECORD-INFO-P121-240. RL2114.2 +012000 07 FILLER PIC X(8). RL2114.2 +012100 07 XRECORD-KEY PIC X(29). RL2114.2 +012200 07 FILLER PIC X(9). RL2114.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL2114.2 +012400 07 FILLER PIC X(9). RL2114.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL2114.2 +012600 07 FILLER PIC X(7). RL2114.2 +012700 01 TEST-RESULTS. RL2114.2 +012800 02 FILLER PIC X VALUE SPACE. RL2114.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL2114.2 +013000 02 FILLER PIC X VALUE SPACE. RL2114.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL2114.2 +013200 02 FILLER PIC X VALUE SPACE. RL2114.2 +013300 02 PAR-NAME. RL2114.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL2114.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL2114.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL2114.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL2114.2 +013800 02 RE-MARK PIC X(61). RL2114.2 +013900 01 TEST-COMPUTED. RL2114.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL2114.2 +014100 02 FILLER PIC X(17) VALUE RL2114.2 +014200 " COMPUTED=". RL2114.2 +014300 02 COMPUTED-X. RL2114.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2114.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL2114.2 +014600 PIC -9(9).9(9). RL2114.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2114.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2114.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2114.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL2114.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL2114.2 +015200 04 FILLER PIC X. RL2114.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL2114.2 +015400 01 TEST-CORRECT. RL2114.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL2114.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2114.2 +015700 02 CORRECT-X. RL2114.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2114.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2114.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2114.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2114.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2114.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL2114.2 +016400 04 CORRECT-18V0 PIC -9(18). RL2114.2 +016500 04 FILLER PIC X. RL2114.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL2114.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2114.2 +016800 01 CCVS-C-1. RL2114.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2114.2 +017000- "SS PARAGRAPH-NAME RL2114.2 +017100- " REMARKS". RL2114.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL2114.2 +017300 01 CCVS-C-2. RL2114.2 +017400 02 FILLER PIC X VALUE SPACE. RL2114.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL2114.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL2114.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL2114.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL2114.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2114.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL2114.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2114.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2114.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2114.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2114.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2114.2 +019000 01 CCVS-H-1. RL2114.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2114.2 +019200 02 FILLER PIC X(42) VALUE RL2114.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2114.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL2114.2 +019500 01 CCVS-H-2A. RL2114.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL2114.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2114.2 +019800 02 FILLER PIC XXXX VALUE RL2114.2 +019900 "4.2 ". RL2114.2 +020000 02 FILLER PIC X(28) VALUE RL2114.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL2114.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL2114.2 +020300 RL2114.2 +020400 01 CCVS-H-2B. RL2114.2 +020500 02 FILLER PIC X(15) VALUE RL2114.2 +020600 "TEST RESULT OF ". RL2114.2 +020700 02 TEST-ID PIC X(9). RL2114.2 +020800 02 FILLER PIC X(4) VALUE RL2114.2 +020900 " IN ". RL2114.2 +021000 02 FILLER PIC X(12) VALUE RL2114.2 +021100 " HIGH ". RL2114.2 +021200 02 FILLER PIC X(22) VALUE RL2114.2 +021300 " LEVEL VALIDATION FOR ". RL2114.2 +021400 02 FILLER PIC X(58) VALUE RL2114.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +021600 01 CCVS-H-3. RL2114.2 +021700 02 FILLER PIC X(34) VALUE RL2114.2 +021800 " FOR OFFICIAL USE ONLY ". RL2114.2 +021900 02 FILLER PIC X(58) VALUE RL2114.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2114.2 +022100 02 FILLER PIC X(28) VALUE RL2114.2 +022200 " COPYRIGHT 1985 ". RL2114.2 +022300 01 CCVS-E-1. RL2114.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL2114.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2114.2 +022600 02 ID-AGAIN PIC X(9). RL2114.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL2114.2 +022800 01 CCVS-E-2. RL2114.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL2114.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL2114.2 +023100 02 CCVS-E-2-2. RL2114.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2114.2 +023300 03 FILLER PIC X VALUE SPACE. RL2114.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL2114.2 +023500 "ERRORS ENCOUNTERED". RL2114.2 +023600 01 CCVS-E-3. RL2114.2 +023700 02 FILLER PIC X(22) VALUE RL2114.2 +023800 " FOR OFFICIAL USE ONLY". RL2114.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL2114.2 +024000 02 FILLER PIC X(58) VALUE RL2114.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL2114.2 +024300 02 FILLER PIC X(15) VALUE RL2114.2 +024400 " COPYRIGHT 1985". RL2114.2 +024500 01 CCVS-E-4. RL2114.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2114.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL2114.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2114.2 +024900 02 FILLER PIC X(40) VALUE RL2114.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2114.2 +025100 01 XXINFO. RL2114.2 +025200 02 FILLER PIC X(19) VALUE RL2114.2 +025300 "*** INFORMATION ***". RL2114.2 +025400 02 INFO-TEXT. RL2114.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL2114.2 +025600 04 XXCOMPUTED PIC X(20). RL2114.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL2114.2 +025800 04 XXCORRECT PIC X(20). RL2114.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL2114.2 +026000 01 HYPHEN-LINE. RL2114.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL2114.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL2114.2 +026300- "*****************************************". RL2114.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL2114.2 +026500- "******************************". RL2114.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL2114.2 +026700 "RL211A". RL2114.2 +026800 PROCEDURE DIVISION. RL2114.2 +026900 CCVS1 SECTION. RL2114.2 +027000 OPEN-FILES. RL2114.2 +027100 OPEN OUTPUT PRINT-FILE. RL2114.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2114.2 +027300 MOVE SPACE TO TEST-RESULTS. RL2114.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2114.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL2114.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2114.2 +027700 CCVS-INIT-FILE. RL2114.2 +027800 ADD 1 TO REC-SKL-SUB. RL2114.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL2114.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2114.2 +028100 CCVS-INIT-EXIT. RL2114.2 +028200 GO TO CCVS1-EXIT. RL2114.2 +028300 CLOSE-FILES. RL2114.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2114.2 +028500 TERMINATE-CCVS. RL2114.2 +028600S EXIT PROGRAM. RL2114.2 +028700STERMINATE-CALL. RL2114.2 +028800 STOP RUN. RL2114.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2114.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2114.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2114.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2114.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL2114.2 +029400 PRINT-DETAIL. RL2114.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL2114.2 +029600 MOVE "." TO PARDOT-X RL2114.2 +029700 MOVE REC-CT TO DOTVALUE. RL2114.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2114.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2114.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2114.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2114.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2114.2 +030300 MOVE SPACE TO CORRECT-X. RL2114.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2114.2 +030500 MOVE SPACE TO RE-MARK. RL2114.2 +030600 HEAD-ROUTINE. RL2114.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2114.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2114.2 +031100 COLUMN-NAMES-ROUTINE. RL2114.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +031500 END-ROUTINE. RL2114.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2114.2 +031700 END-RTN-EXIT. RL2114.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +031900 END-ROUTINE-1. RL2114.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2114.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2114.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL2114.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2114.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2114.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2114.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2114.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2114.2 +032800 END-ROUTINE-12. RL2114.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2114.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2114.2 +033100 MOVE "NO " TO ERROR-TOTAL RL2114.2 +033200 ELSE RL2114.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2114.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2114.2 +033500 PERFORM WRITE-LINE. RL2114.2 +033600 END-ROUTINE-13. RL2114.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2114.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL2114.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2114.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2114.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL2114.2 +034300 MOVE "NO " TO ERROR-TOTAL RL2114.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2114.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2114.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034800 WRITE-LINE. RL2114.2 +034900 ADD 1 TO RECORD-COUNT. RL2114.2 +035000Y IF RECORD-COUNT GREATER 50 RL2114.2 +035100Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2114.2 +035200Y MOVE SPACE TO DUMMY-RECORD RL2114.2 +035300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2114.2 +035400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2114.2 +035500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2114.2 +035600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2114.2 +035700Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2114.2 +035800Y MOVE ZERO TO RECORD-COUNT. RL2114.2 +035900 PERFORM WRT-LN. RL2114.2 +036000 WRT-LN. RL2114.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2114.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL2114.2 +036300 BLANK-LINE-PRINT. RL2114.2 +036400 PERFORM WRT-LN. RL2114.2 +036500 FAIL-ROUTINE. RL2114.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE RL2114.2 +036700 GO TO FAIL-ROUTINE-WRITE. RL2114.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2114.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2114.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2114.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2114.2 +037300 GO TO FAIL-ROUTINE-EX. RL2114.2 +037400 FAIL-ROUTINE-WRITE. RL2114.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2114.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2114.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2114.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2114.2 +037900 FAIL-ROUTINE-EX. EXIT. RL2114.2 +038000 BAIL-OUT. RL2114.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2114.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2114.2 +038300 BAIL-OUT-WRITE. RL2114.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2114.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2114.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2114.2 +038800 BAIL-OUT-EX. EXIT. RL2114.2 +038900 CCVS1-EXIT. RL2114.2 +039000 EXIT. RL2114.2 +039100 SECT-RL211A-001 SECTION. RL2114.2 +039200 REL-INIT-001. RL2114.2 +039300 MOVE "FILE CREATE RL-VS1" TO FEATURE. RL2114.2 +039400 OPEN OUTPUT RL-VS1. RL2114.2 +039500 MOVE "RL-VS1" TO XFILE-NAME (1). RL2114.2 +039600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2114.2 +039700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2114.2 +039800 MOVE 000120 TO XRECORD-LENGTH (1). RL2114.2 +039900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2114.2 +040000 MOVE 0001 TO XBLOCK-SIZE (1). RL2114.2 +040100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2114.2 +040200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2114.2 +040300 MOVE "S" TO XLABEL-TYPE (1). RL2114.2 +040400 MOVE 000001 TO XRECORD-NUMBER (1). RL2114.2 +040500 REL-TEST-001. RL2114.2 +040600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-VS1R1-F-G-140. RL2114.2 +040700 IF XRECORD-NUMBER (1) > 32 RL2114.2 +040800 MOVE 21 TO RL-VS1R1-F-G-117-119. RL2114.2 +040900 IF XRECORD-NUMBER (1) = 32 RL2114.2 +041000 MOVE 16 TO RL-VS1R1-F-G-117-119. RL2114.2 +041100 IF XRECORD-NUMBER (1) = 31 RL2114.2 +041200 MOVE 6 TO RL-VS1R1-F-G-117-119. RL2114.2 +041300 IF XRECORD-NUMBER (1) < 31 RL2114.2 +041400 MOVE 21 TO RL-VS1R1-F-G-117-119. RL2114.2 +041500 IF XRECORD-NUMBER (1) < 21 RL2114.2 +041600 MOVE 11 TO RL-VS1R1-F-G-117-119. RL2114.2 +041700 IF XRECORD-NUMBER (1) < 11 RL2114.2 +041800 MOVE 1 TO RL-VS1R1-F-G-117-119. RL2114.2 +041900 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO RL-GROUP. RL2114.2 +042000 WRITE RL-VS1R1-F-G-140 RL2114.2 +042100 INVALID KEY GO TO REL-FAIL-001. RL2114.2 +042200 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2114.2 +042300 GO TO REL-WRITE-001. RL2114.2 +042400 ADD 000001 TO XRECORD-NUMBER (1). RL2114.2 +042500 GO TO REL-TEST-001. RL2114.2 +042600 REL-DELETE-001. RL2114.2 +042700 PERFORM DE-LETE. RL2114.2 +042800 GO TO REL-WRITE-001. RL2114.2 +042900 REL-FAIL-001. RL2114.2 +043000 PERFORM FAIL. RL2114.2 +043100 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2114.2 +043200 REL-WRITE-001. RL2114.2 +043300 MOVE "REL-TEST-001" TO PAR-NAME RL2114.2 +043400 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2114.2 +043500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2114.2 +043600 PERFORM PRINT-DETAIL. RL2114.2 +043700 CLOSE RL-VS1. RL2114.2 +043800 OPEN INPUT RL-VS1. RL2114.2 +043900 MOVE ZERO TO WRK-CS-09V00. RL2114.2 +044000 REL-INIT-1. RL2114.2 +044100 MOVE SPACES TO RL-VS1R1-F-G-140. RL2114.2 +044200 READ RL-VS1 RL2114.2 +044300 AT END GO TO REL-TEST-002-2. RL2114.2 +044400 MOVE RL-VS1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2114.2 +044500 MOVE RL-VS1R1-F-G-140 TO WS-VS1R1-F-G-140. RL2114.2 +044600 ADD 1 TO WRK-CS-09V00. RL2114.2 +044700 IF WRK-CS-09V00 GREATER 500 RL2114.2 +044800 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2114.2 +044900 GO TO REL-TEST-002-2. RL2114.2 +045000 REL-TEST-1. RL2114.2 +045100 MOVE "VII-31 3.8.4 GR 5 & 5A" TO ANSI-REFERENCE. RL2114.2 +045200 MOVE "REL-TEST-1" TO PAR-NAME. RL2114.2 +045300 IF WRK-CS-09V00 < 11 RL2114.2 +045400 IF WS-VS1R1-F-G-120-140 = RL2114.2 +045500 "A " RL2114.2 +045600 PERFORM PASS RL2114.2 +045700* PERFORM PRINT-DETAIL RL2114.2 +045800 ELSE RL2114.2 +045900 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +046000 MOVE "A " TO CORRECT-X RL2114.2 +046100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +046200 PERFORM FAIL RL2114.2 +046300 PERFORM PRINT-DETAIL. RL2114.2 +046400 REL-TEST-2. RL2114.2 +046500 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +046600 MOVE "REL-TEST-2" TO PAR-NAME. RL2114.2 +046700 IF (WRK-CS-09V00 > 10 AND < 21) RL2114.2 +046800 IF WS-VS1R1-F-G-120-140 = RL2114.2 +046900 "ABCDEFGHIJK " RL2114.2 +047000 PERFORM PASS RL2114.2 +047100* PERFORM PRINT-DETAIL RL2114.2 +047200 ELSE RL2114.2 +047300 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +047400 MOVE "ABCDEFGHIJK " TO CORRECT-X RL2114.2 +047500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +047600 PERFORM FAIL RL2114.2 +047700 PERFORM PRINT-DETAIL. RL2114.2 +047800 REL-TEST-3. RL2114.2 +047900 MOVE "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE. RL2114.2 +048000 MOVE "REL-TEST-3" TO PAR-NAME. RL2114.2 +048100 IF (WRK-CS-09V00 > 20 AND < 31) RL2114.2 +048200 IF WS-VS1R1-F-G-120-140 = RL2114.2 +048300 "ABCDEFGHIJKLMNOPQRSTU" RL2114.2 +048400 PERFORM PASS RL2114.2 +048500* PERFORM PRINT-DETAIL RL2114.2 +048600 ELSE RL2114.2 +048700 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +048800 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X RL2114.2 +048900 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +049000 PERFORM FAIL RL2114.2 +049100 PERFORM PRINT-DETAIL. RL2114.2 +049200 REL-TEST-4. RL2114.2 +049300 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +049400 MOVE "REL-TEST-4" TO PAR-NAME. RL2114.2 +049500 IF WRK-CS-09V00 = 31 RL2114.2 +049600 IF WS-VS1R1-F-G-120-140 = RL2114.2 +049700 "ABCDEF " RL2114.2 +049800 PERFORM PASS RL2114.2 +049900* PERFORM PRINT-DETAIL RL2114.2 +050000 ELSE RL2114.2 +050100 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +050200 MOVE "ABCDEF " TO CORRECT-X RL2114.2 +050300 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +050400 PERFORM FAIL RL2114.2 +050500 PERFORM PRINT-DETAIL. RL2114.2 +050600 REL-TEST-5. RL2114.2 +050700 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +050800 MOVE "REL-TEST-5" TO PAR-NAME. RL2114.2 +050900 IF WRK-CS-09V00 = 32 RL2114.2 +051000 IF WS-VS1R1-F-G-120-140 = RL2114.2 +051100 "ABCDEFGHIJKLMNOP " RL2114.2 +051200 PERFORM PASS RL2114.2 +051300* PERFORM PRINT-DETAIL RL2114.2 +051400 ELSE RL2114.2 +051500 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +051600 MOVE "ABCDEFGHIJKLMNOP " TO CORRECT-X RL2114.2 +051700 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +051800 PERFORM FAIL RL2114.2 +051900 PERFORM PRINT-DETAIL. RL2114.2 +052000 REL-TEST-6. RL2114.2 +052100 MOVE "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE. RL2114.2 +052200 MOVE "REL-TEST-6" TO PAR-NAME. RL2114.2 +052300 IF WRK-CS-09V00 > 32 RL2114.2 +052400 IF WS-VS1R1-F-G-120-140 = RL2114.2 +052500 "ABCDEFGHIJKLMNOPQRSTU" RL2114.2 +052600 PERFORM PASS RL2114.2 +052700* PERFORM PRINT-DETAIL RL2114.2 +052800 ELSE RL2114.2 +052900 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +053000 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X RL2114.2 +053100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +053200 PERFORM FAIL RL2114.2 +053300 PERFORM PRINT-DETAIL. RL2114.2 +053400 GO TO REL-INIT-1. RL2114.2 +053500 REL-DELETE-002. RL2114.2 +053600 PERFORM DE-LETE. RL2114.2 +053700 PERFORM PRINT-DETAIL. RL2114.2 +053800 REL-TEST-002-2. RL2114.2 +053900 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2114.2 +054000 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2114.2 +054100 PERFORM FAIL RL2114.2 +054200 ELSE RL2114.2 +054300 PERFORM PASS. RL2114.2 +054400 GO TO REL-WRITE-002. RL2114.2 +054500 REL-WRITE-002. RL2114.2 +054600 MOVE "REL-TEST-002" TO PAR-NAME. RL2114.2 +054700 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2114.2 +054800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2114.2 +054900 PERFORM PRINT-DETAIL. RL2114.2 +055000 CLOSE RL-VS1. RL2114.2 +055100 CCVS-EXIT SECTION. RL2114.2 +055200 CCVS-999999. RL2114.2 +055300 GO TO CLOSE-FILES. RL2114.2 +*END-OF,RL211A +*HEADER,COBOL,RL212A +000100 IDENTIFICATION DIVISION. RL2124.2 +000200 PROGRAM-ID. RL2124.2 +000300 RL212A. RL2124.2 +000400**************************************************************** RL2124.2 +000500* * RL2124.2 +000600* VALIDATION FOR:- * RL2124.2 +000700* * RL2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +000900* * RL2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2124.2 +001100* * RL2124.2 +001200**************************************************************** RL2124.2 +001300* THIS RUN UNIT IS THE FIRST OF A SERIES OF TWO PROGRAMS * RL2124.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS * RL2124.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY * RL2124.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS * RL2124.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1" * RL2124.2 +001800* AND WILL CONTAIN 500 RECORDS OF 120 CHARACTERS. * RL2124.2 +001900* * RL2124.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS * RL2124.2 +002100* PROGRAM ARE: * RL2124.2 +002200* * RL2124.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2124.2 +002400* RELATIVE I-O DATA FILE * RL2124.2 +002500* X-55 SYSTEM PRINTER * RL2124.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES * RL2124.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME * RL2124.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE * RL2124.2 +002900* X-82 SOURCE-COMPUTER * RL2124.2 +003000* X-83 OBJECT-COMPUTER. * RL2124.2 +003100* * RL2124.2 +003200**************************************************************** RL2124.2 +003300 ENVIRONMENT DIVISION. RL2124.2 +003400 CONFIGURATION SECTION. RL2124.2 +003500 SOURCE-COMPUTER. RL2124.2 +003600 XXXXX082. RL2124.2 +003700 OBJECT-COMPUTER. RL2124.2 +003800 XXXXX083. RL2124.2 +003900 INPUT-OUTPUT SECTION. RL2124.2 +004000 FILE-CONTROL. RL2124.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2124.2 +004200 XXXXX055. RL2124.2 +004300 SELECT RL-FS1 ASSIGN TO RL2124.2 +004400 XXXXP021 RL2124.2 +004500 ORGANIZATION IS RELATIVE. RL2124.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2124.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2124.2 +004800 DATA DIVISION. RL2124.2 +004900 FILE SECTION. RL2124.2 +005000 FD PRINT-FILE. RL2124.2 +005100 01 PRINT-REC PICTURE X(120). RL2124.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2124.2 +005300 FD RL-FS1 RL2124.2 +005400 LABEL RECORDS STANDARD RL2124.2 +005500C VALUE OF RL2124.2 +005600C XXXXX074 RL2124.2 +005700C IS RL2124.2 +005800C XXXXX075 RL2124.2 +005900G XXXXX069 RL2124.2 +006000 BLOCK CONTAINS 1 RECORDS RL2124.2 +006100 RECORD CONTAINS 120 CHARACTERS. RL2124.2 +006200 01 RL-FS1R1-F-G-120. RL2124.2 +006300 02 FILLER PIC X(120). RL2124.2 +006400 WORKING-STORAGE SECTION. RL2124.2 +006500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2124.2 +006600 01 FILE-RECORD-INFORMATION-REC. RL2124.2 +006700 03 FILE-RECORD-INFO-SKELETON. RL2124.2 +006800 05 FILLER PICTURE X(48) VALUE RL2124.2 +006900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2124.2 +007000 05 FILLER PICTURE X(46) VALUE RL2124.2 +007100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2124.2 +007200 05 FILLER PICTURE X(26) VALUE RL2124.2 +007300 ",LFIL=000000,ORG= ,LBLR= ". RL2124.2 +007400 05 FILLER PICTURE X(37) VALUE RL2124.2 +007500 ",RECKEY= ". RL2124.2 +007600 05 FILLER PICTURE X(38) VALUE RL2124.2 +007700 ",ALTKEY1= ". RL2124.2 +007800 05 FILLER PICTURE X(38) VALUE RL2124.2 +007900 ",ALTKEY2= ". RL2124.2 +008000 05 FILLER PICTURE X(7) VALUE SPACE.RL2124.2 +008100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2124.2 +008200 05 FILE-RECORD-INFO-P1-120. RL2124.2 +008300 07 FILLER PIC X(5). RL2124.2 +008400 07 XFILE-NAME PIC X(6). RL2124.2 +008500 07 FILLER PIC X(8). RL2124.2 +008600 07 XRECORD-NAME PIC X(6). RL2124.2 +008700 07 FILLER PIC X(1). RL2124.2 +008800 07 REELUNIT-NUMBER PIC 9(1). RL2124.2 +008900 07 FILLER PIC X(7). RL2124.2 +009000 07 XRECORD-NUMBER PIC 9(6). RL2124.2 +009100 07 FILLER PIC X(6). RL2124.2 +009200 07 UPDATE-NUMBER PIC 9(2). RL2124.2 +009300 07 FILLER PIC X(5). RL2124.2 +009400 07 ODO-NUMBER PIC 9(4). RL2124.2 +009500 07 FILLER PIC X(5). RL2124.2 +009600 07 XPROGRAM-NAME PIC X(5). RL2124.2 +009700 07 FILLER PIC X(7). RL2124.2 +009800 07 XRECORD-LENGTH PIC 9(6). RL2124.2 +009900 07 FILLER PIC X(7). RL2124.2 +010000 07 CHARS-OR-RECORDS PIC X(2). RL2124.2 +010100 07 FILLER PIC X(1). RL2124.2 +010200 07 XBLOCK-SIZE PIC 9(4). RL2124.2 +010300 07 FILLER PIC X(6). RL2124.2 +010400 07 RECORDS-IN-FILE PIC 9(6). RL2124.2 +010500 07 FILLER PIC X(5). RL2124.2 +010600 07 XFILE-ORGANIZATION PIC X(2). RL2124.2 +010700 07 FILLER PIC X(6). RL2124.2 +010800 07 XLABEL-TYPE PIC X(1). RL2124.2 +010900 05 FILE-RECORD-INFO-P121-240. RL2124.2 +011000 07 FILLER PIC X(8). RL2124.2 +011100 07 XRECORD-KEY PIC X(29). RL2124.2 +011200 07 FILLER PIC X(9). RL2124.2 +011300 07 ALTERNATE-KEY1 PIC X(29). RL2124.2 +011400 07 FILLER PIC X(9). RL2124.2 +011500 07 ALTERNATE-KEY2 PIC X(29). RL2124.2 +011600 07 FILLER PIC X(7). RL2124.2 +011700 01 TEST-RESULTS. RL2124.2 +011800 02 FILLER PIC X VALUE SPACE. RL2124.2 +011900 02 FEATURE PIC X(20) VALUE SPACE. RL2124.2 +012000 02 FILLER PIC X VALUE SPACE. RL2124.2 +012100 02 P-OR-F PIC X(5) VALUE SPACE. RL2124.2 +012200 02 FILLER PIC X VALUE SPACE. RL2124.2 +012300 02 PAR-NAME. RL2124.2 +012400 03 FILLER PIC X(19) VALUE SPACE. RL2124.2 +012500 03 PARDOT-X PIC X VALUE SPACE. RL2124.2 +012600 03 DOTVALUE PIC 99 VALUE ZERO. RL2124.2 +012700 02 FILLER PIC X(8) VALUE SPACE. RL2124.2 +012800 02 RE-MARK PIC X(61). RL2124.2 +012900 01 TEST-COMPUTED. RL2124.2 +013000 02 FILLER PIC X(30) VALUE SPACE. RL2124.2 +013100 02 FILLER PIC X(17) VALUE RL2124.2 +013200 " COMPUTED=". RL2124.2 +013300 02 COMPUTED-X. RL2124.2 +013400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2124.2 +013500 03 COMPUTED-N REDEFINES COMPUTED-A RL2124.2 +013600 PIC -9(9).9(9). RL2124.2 +013700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2124.2 +013800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2124.2 +013900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2124.2 +014000 03 CM-18V0 REDEFINES COMPUTED-A. RL2124.2 +014100 04 COMPUTED-18V0 PIC -9(18). RL2124.2 +014200 04 FILLER PIC X. RL2124.2 +014300 03 FILLER PIC X(50) VALUE SPACE. RL2124.2 +014400 01 TEST-CORRECT. RL2124.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2124.2 +014600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2124.2 +014700 02 CORRECT-X. RL2124.2 +014800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2124.2 +014900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2124.2 +015000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2124.2 +015100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2124.2 +015200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2124.2 +015300 03 CR-18V0 REDEFINES CORRECT-A. RL2124.2 +015400 04 CORRECT-18V0 PIC -9(18). RL2124.2 +015500 04 FILLER PIC X. RL2124.2 +015600 03 FILLER PIC X(2) VALUE SPACE. RL2124.2 +015700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2124.2 +015800 01 CCVS-C-1. RL2124.2 +015900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2124.2 +016000- "SS PARAGRAPH-NAME RL2124.2 +016100- " REMARKS". RL2124.2 +016200 02 FILLER PIC X(20) VALUE SPACE. RL2124.2 +016300 01 CCVS-C-2. RL2124.2 +016400 02 FILLER PIC X VALUE SPACE. RL2124.2 +016500 02 FILLER PIC X(6) VALUE "TESTED". RL2124.2 +016600 02 FILLER PIC X(15) VALUE SPACE. RL2124.2 +016700 02 FILLER PIC X(4) VALUE "FAIL". RL2124.2 +016800 02 FILLER PIC X(94) VALUE SPACE. RL2124.2 +016900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2124.2 +017000 01 REC-CT PIC 99 VALUE ZERO. RL2124.2 +017100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2124.2 +017600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2124.2 +017700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2124.2 +017800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2124.2 +017900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2124.2 +018000 01 CCVS-H-1. RL2124.2 +018100 02 FILLER PIC X(39) VALUE SPACES. RL2124.2 +018200 02 FILLER PIC X(42) VALUE RL2124.2 +018300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2124.2 +018400 02 FILLER PIC X(39) VALUE SPACES. RL2124.2 +018500 01 CCVS-H-2A. RL2124.2 +018600 02 FILLER PIC X(40) VALUE SPACE. RL2124.2 +018700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2124.2 +018800 02 FILLER PIC XXXX VALUE RL2124.2 +018900 "4.2 ". RL2124.2 +019000 02 FILLER PIC X(28) VALUE RL2124.2 +019100 " COPY - NOT FOR DISTRIBUTION". RL2124.2 +019200 02 FILLER PIC X(41) VALUE SPACE. RL2124.2 +019300 RL2124.2 +019400 01 CCVS-H-2B. RL2124.2 +019500 02 FILLER PIC X(15) VALUE RL2124.2 +019600 "TEST RESULT OF ". RL2124.2 +019700 02 TEST-ID PIC X(9). RL2124.2 +019800 02 FILLER PIC X(4) VALUE RL2124.2 +019900 " IN ". RL2124.2 +020000 02 FILLER PIC X(12) VALUE RL2124.2 +020100 " HIGH ". RL2124.2 +020200 02 FILLER PIC X(22) VALUE RL2124.2 +020300 " LEVEL VALIDATION FOR ". RL2124.2 +020400 02 FILLER PIC X(58) VALUE RL2124.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +020600 01 CCVS-H-3. RL2124.2 +020700 02 FILLER PIC X(34) VALUE RL2124.2 +020800 " FOR OFFICIAL USE ONLY ". RL2124.2 +020900 02 FILLER PIC X(58) VALUE RL2124.2 +021000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2124.2 +021100 02 FILLER PIC X(28) VALUE RL2124.2 +021200 " COPYRIGHT 1985 ". RL2124.2 +021300 01 CCVS-E-1. RL2124.2 +021400 02 FILLER PIC X(52) VALUE SPACE. RL2124.2 +021500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2124.2 +021600 02 ID-AGAIN PIC X(9). RL2124.2 +021700 02 FILLER PIC X(45) VALUE SPACES. RL2124.2 +021800 01 CCVS-E-2. RL2124.2 +021900 02 FILLER PIC X(31) VALUE SPACE. RL2124.2 +022000 02 FILLER PIC X(21) VALUE SPACE. RL2124.2 +022100 02 CCVS-E-2-2. RL2124.2 +022200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2124.2 +022300 03 FILLER PIC X VALUE SPACE. RL2124.2 +022400 03 ENDER-DESC PIC X(44) VALUE RL2124.2 +022500 "ERRORS ENCOUNTERED". RL2124.2 +022600 01 CCVS-E-3. RL2124.2 +022700 02 FILLER PIC X(22) VALUE RL2124.2 +022800 " FOR OFFICIAL USE ONLY". RL2124.2 +022900 02 FILLER PIC X(12) VALUE SPACE. RL2124.2 +023000 02 FILLER PIC X(58) VALUE RL2124.2 +023100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +023200 02 FILLER PIC X(13) VALUE SPACE. RL2124.2 +023300 02 FILLER PIC X(15) VALUE RL2124.2 +023400 " COPYRIGHT 1985". RL2124.2 +023500 01 CCVS-E-4. RL2124.2 +023600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2124.2 +023700 02 FILLER PIC X(4) VALUE " OF ". RL2124.2 +023800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2124.2 +023900 02 FILLER PIC X(40) VALUE RL2124.2 +024000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2124.2 +024100 01 XXINFO. RL2124.2 +024200 02 FILLER PIC X(19) VALUE RL2124.2 +024300 "*** INFORMATION ***". RL2124.2 +024400 02 INFO-TEXT. RL2124.2 +024500 04 FILLER PIC X(8) VALUE SPACE. RL2124.2 +024600 04 XXCOMPUTED PIC X(20). RL2124.2 +024700 04 FILLER PIC X(5) VALUE SPACE. RL2124.2 +024800 04 XXCORRECT PIC X(20). RL2124.2 +024900 02 INF-ANSI-REFERENCE PIC X(48). RL2124.2 +025000 01 HYPHEN-LINE. RL2124.2 +025100 02 FILLER PIC IS X VALUE IS SPACE. RL2124.2 +025200 02 FILLER PIC IS X(65) VALUE IS "************************RL2124.2 +025300- "*****************************************". RL2124.2 +025400 02 FILLER PIC IS X(54) VALUE IS "************************RL2124.2 +025500- "******************************". RL2124.2 +025600 01 CCVS-PGM-ID PIC X(9) VALUE RL2124.2 +025700 "RL212A". RL2124.2 +025800 PROCEDURE DIVISION. RL2124.2 +025900 CCVS1 SECTION. RL2124.2 +026000 OPEN-FILES. RL2124.2 +026100 OPEN OUTPUT PRINT-FILE. RL2124.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2124.2 +026300 MOVE SPACE TO TEST-RESULTS. RL2124.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2124.2 +026500 MOVE ZERO TO REC-SKL-SUB. RL2124.2 +026600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2124.2 +026700 CCVS-INIT-FILE. RL2124.2 +026800 ADD 1 TO REC-SKL-SUB. RL2124.2 +026900 MOVE FILE-RECORD-INFO-SKELETON RL2124.2 +027000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2124.2 +027100 CCVS-INIT-EXIT. RL2124.2 +027200 GO TO CCVS1-EXIT. RL2124.2 +027300 CLOSE-FILES. RL2124.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2124.2 +027500 TERMINATE-CCVS. RL2124.2 +027600S EXIT PROGRAM. RL2124.2 +027700STERMINATE-CALL. RL2124.2 +027800 STOP RUN. RL2124.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2124.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2124.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2124.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2124.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. RL2124.2 +028400 PRINT-DETAIL. RL2124.2 +028500 IF REC-CT NOT EQUAL TO ZERO RL2124.2 +028600 MOVE "." TO PARDOT-X RL2124.2 +028700 MOVE REC-CT TO DOTVALUE. RL2124.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2124.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2124.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2124.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2124.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2124.2 +029300 MOVE SPACE TO CORRECT-X. RL2124.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2124.2 +029500 MOVE SPACE TO RE-MARK. RL2124.2 +029600 HEAD-ROUTINE. RL2124.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2124.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2124.2 +030100 COLUMN-NAMES-ROUTINE. RL2124.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +030500 END-ROUTINE. RL2124.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2124.2 +030700 END-RTN-EXIT. RL2124.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +030900 END-ROUTINE-1. RL2124.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2124.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2124.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. RL2124.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2124.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2124.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2124.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2124.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2124.2 +031800 END-ROUTINE-12. RL2124.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2124.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2124.2 +032100 MOVE "NO " TO ERROR-TOTAL RL2124.2 +032200 ELSE RL2124.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2124.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2124.2 +032500 PERFORM WRITE-LINE. RL2124.2 +032600 END-ROUTINE-13. RL2124.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2124.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE RL2124.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2124.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2124.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO RL2124.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2124.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2124.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2124.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033800 WRITE-LINE. RL2124.2 +033900 ADD 1 TO RECORD-COUNT. RL2124.2 +034000Y IF RECORD-COUNT GREATER 50 RL2124.2 +034100Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2124.2 +034200Y MOVE SPACE TO DUMMY-RECORD RL2124.2 +034300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2124.2 +034400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2124.2 +034500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2124.2 +034600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2124.2 +034700Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2124.2 +034800Y MOVE ZERO TO RECORD-COUNT. RL2124.2 +034900 PERFORM WRT-LN. RL2124.2 +035000 WRT-LN. RL2124.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2124.2 +035200 MOVE SPACE TO DUMMY-RECORD. RL2124.2 +035300 BLANK-LINE-PRINT. RL2124.2 +035400 PERFORM WRT-LN. RL2124.2 +035500 FAIL-ROUTINE. RL2124.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE RL2124.2 +035700 GO TO FAIL-ROUTINE-WRITE. RL2124.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2124.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2124.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2124.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2124.2 +036300 GO TO FAIL-ROUTINE-EX. RL2124.2 +036400 FAIL-ROUTINE-WRITE. RL2124.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2124.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2124.2 +036700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2124.2 +036800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2124.2 +036900 FAIL-ROUTINE-EX. EXIT. RL2124.2 +037000 BAIL-OUT. RL2124.2 +037100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2124.2 +037200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2124.2 +037300 BAIL-OUT-WRITE. RL2124.2 +037400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2124.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2124.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2124.2 +037800 BAIL-OUT-EX. EXIT. RL2124.2 +037900 CCVS1-EXIT. RL2124.2 +038000 EXIT. RL2124.2 +038100 SECT-RL212A-001 SECTION. RL2124.2 +038200 REL-INIT-001. RL2124.2 +038300 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2124.2 +038400 OPEN OUTPUT RL-FS1. RL2124.2 +038500 MOVE "RL-FS1" TO XFILE-NAME (1). RL2124.2 +038600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2124.2 +038700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2124.2 +038800 MOVE 000120 TO XRECORD-LENGTH (1). RL2124.2 +038900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2124.2 +039000 MOVE 0001 TO XBLOCK-SIZE (1). RL2124.2 +039100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2124.2 +039200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2124.2 +039300 MOVE "S" TO XLABEL-TYPE (1). RL2124.2 +039400 MOVE 000001 TO XRECORD-NUMBER (1). RL2124.2 +039500 REL-TEST-001. RL2124.2 +039600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2124.2 +039700 WRITE RL-FS1R1-F-G-120 RL2124.2 +039800 INVALID KEY GO TO REL-FAIL-001. RL2124.2 +039900 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2124.2 +040000 GO TO REL-WRITE-001. RL2124.2 +040100 ADD 000001 TO XRECORD-NUMBER (1). RL2124.2 +040200 GO TO REL-TEST-001. RL2124.2 +040300 REL-DELETE-001. RL2124.2 +040400 PERFORM DE-LETE. RL2124.2 +040500 GO TO REL-WRITE-001. RL2124.2 +040600 REL-FAIL-001. RL2124.2 +040700 PERFORM FAIL. RL2124.2 +040800 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2124.2 +040900 REL-WRITE-001. RL2124.2 +041000 MOVE "REL-TEST-001" TO PAR-NAME RL2124.2 +041100 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2124.2 +041200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2124.2 +041300 PERFORM PRINT-DETAIL. RL2124.2 +041400 CLOSE RL-FS1. RL2124.2 +041500 REL-INIT-002. RL2124.2 +041600 OPEN INPUT RL-FS1. RL2124.2 +041700 MOVE ZERO TO WRK-CS-09V00. RL2124.2 +041800 REL-TEST-002. RL2124.2 +041900 READ RL-FS1 RL2124.2 +042000 AT END GO TO REL-TEST-002-1. RL2124.2 +042100 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2124.2 +042200 ADD 1 TO WRK-CS-09V00. RL2124.2 +042300 IF WRK-CS-09V00 GREATER 500 RL2124.2 +042400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2124.2 +042500 GO TO REL-TEST-002-1. RL2124.2 +042600 GO TO REL-TEST-002. RL2124.2 +042700 REL-DELETE-002. RL2124.2 +042800 PERFORM DE-LETE. RL2124.2 +042900 PERFORM PRINT-DETAIL. RL2124.2 +043000 REL-TEST-002-1. RL2124.2 +043100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2124.2 +043200 PERFORM FAIL RL2124.2 +043300 ELSE RL2124.2 +043400 PERFORM PASS. RL2124.2 +043500 GO TO REL-WRITE-002. RL2124.2 +043600 REL-WRITE-002. RL2124.2 +043700 MOVE "REL-TEST-002" TO PAR-NAME. RL2124.2 +043800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2124.2 +043900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2124.2 +044000 PERFORM PRINT-DETAIL. RL2124.2 +044100 CLOSE RL-FS1. RL2124.2 +044200 CCVS-EXIT SECTION. RL2124.2 +044300 CCVS-999999. RL2124.2 +044400 GO TO CLOSE-FILES. RL2124.2 +*END-OF,RL212A +*HEADER,COBOL,RL212A,SUBPRG,RL213A +000100 IDENTIFICATION DIVISION. RL2134.2 +000200 PROGRAM-ID. RL2134.2 +000300 RL213A. RL2134.2 +000400**************************************************************** RL2134.2 +000500* * RL2134.2 +000600* VALIDATION FOR:- * RL2134.2 +000700* * RL2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +000900* * RL2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2134.2 +001100* * RL2134.2 +001200**************************************************************** RL2134.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVE I-O * RL2134.2 +001400* FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL). THE FILE * RL2134.2 +001500* USED AS INPUT IS THE FILE "RL-FS1" CREATED BY RL212A AND * RL2134.2 +001600* THE OTHER FILE "RL-FS2" WILL NOT BE PRESENT AT THE * RL2134.2 +001700* EXECUTION OF THE PROGRAM. * RL2134.2 +001800* * RL2134.2 +001900* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS * RL2134.2 +002000* PROGRAM ARE: * RL2134.2 +002100* * RL2134.2 +002200* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2134.2 +002300* RELATIVE I-O DATA FILE (RL-FS1) * RL2134.2 +002400* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2134.2 +002500* RELATIVE I-O DATA FILE (RL-FS2) * RL2134.2 +002600* X-55 SYSTEM PRINTER * RL2134.2 +002700* X-69 ADDITIONAL VALUE OF CLAUSES * RL2134.2 +002800* X-74 VALUE OF IMPLEMENTOR-NAME * RL2134.2 +002900* X-75 OBJECT OF VALUE OF CLAUSE * RL2134.2 +003000* X-82 SOURCE-COMPUTER * RL2134.2 +003100* X-83 OBJECT-COMPUTER. * RL2134.2 +003200* * RL2134.2 +003300**************************************************************** RL2134.2 +003400 ENVIRONMENT DIVISION. RL2134.2 +003500 CONFIGURATION SECTION. RL2134.2 +003600 SOURCE-COMPUTER. RL2134.2 +003700 XXXXX082. RL2134.2 +003800 OBJECT-COMPUTER. RL2134.2 +003900 XXXXX083. RL2134.2 +004000 INPUT-OUTPUT SECTION. RL2134.2 +004100 FILE-CONTROL. RL2134.2 +004200 SELECT PRINT-FILE ASSIGN TO RL2134.2 +004300 XXXXX055. RL2134.2 +004400 SELECT OPTIONAL RL-FS1 ASSIGN TO RL2134.2 +004500 XXXXX021 RL2134.2 +004600 ORGANIZATION IS RELATIVE RL2134.2 +004700 ACCESS SEQUENTIAL. RL2134.2 +004800 SELECT OPTIONAL RL-FS2 ASSIGN TO RL2134.2 +004900 XXXXX022 RL2134.2 +005000 ORGANIZATION IS RELATIVE RL2134.2 +005100 ACCESS SEQUENTIAL. RL2134.2 +005200 DATA DIVISION. RL2134.2 +005300 FILE SECTION. RL2134.2 +005400 FD PRINT-FILE. RL2134.2 +005500 01 PRINT-REC PICTURE X(120). RL2134.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL2134.2 +005700 FD RL-FS1 RL2134.2 +005800 LABEL RECORDS STANDARD RL2134.2 +005900C VALUE OF RL2134.2 +006000C XXXXX074 RL2134.2 +006100C IS RL2134.2 +006200C XXXXX075 RL2134.2 +006300G XXXXX069 RL2134.2 +006400 BLOCK CONTAINS 1 RECORDS RL2134.2 +006500 RECORD CONTAINS 120 CHARACTERS. RL2134.2 +006600 01 RL-FS1R1-F-G-120. RL2134.2 +006700 02 FILLER PIC X(120). RL2134.2 +006800 FD RL-FS2 RL2134.2 +006900 LABEL RECORDS STANDARD RL2134.2 +007000C VALUE OF RL2134.2 +007100C XXXXX074 RL2134.2 +007200C IS RL2134.2 +007300C XXXXX075 RL2134.2 +007400G XXXXX069 RL2134.2 +007500 BLOCK CONTAINS 1 RECORDS RL2134.2 +007600 RECORD CONTAINS 120 CHARACTERS. RL2134.2 +007700 01 RL-FS2R1-F-G-120. RL2134.2 +007800 02 FILLER PIC X(120). RL2134.2 +007900 WORKING-STORAGE SECTION. RL2134.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2134.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL2134.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL2134.2 +008300 05 FILLER PICTURE X(48) VALUE RL2134.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2134.2 +008500 05 FILLER PICTURE X(46) VALUE RL2134.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2134.2 +008700 05 FILLER PICTURE X(26) VALUE RL2134.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL2134.2 +008900 05 FILLER PICTURE X(37) VALUE RL2134.2 +009000 ",RECKEY= ". RL2134.2 +009100 05 FILLER PICTURE X(38) VALUE RL2134.2 +009200 ",ALTKEY1= ". RL2134.2 +009300 05 FILLER PICTURE X(38) VALUE RL2134.2 +009400 ",ALTKEY2= ". RL2134.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL2134.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2134.2 +009700 05 FILE-RECORD-INFO-P1-120. RL2134.2 +009800 07 FILLER PIC X(5). RL2134.2 +009900 07 XFILE-NAME PIC X(6). RL2134.2 +010000 07 FILLER PIC X(8). RL2134.2 +010100 07 XRECORD-NAME PIC X(6). RL2134.2 +010200 07 FILLER PIC X(1). RL2134.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL2134.2 +010400 07 FILLER PIC X(7). RL2134.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL2134.2 +010600 07 FILLER PIC X(6). RL2134.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL2134.2 +010800 07 FILLER PIC X(5). RL2134.2 +010900 07 ODO-NUMBER PIC 9(4). RL2134.2 +011000 07 FILLER PIC X(5). RL2134.2 +011100 07 XPROGRAM-NAME PIC X(5). RL2134.2 +011200 07 FILLER PIC X(7). RL2134.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL2134.2 +011400 07 FILLER PIC X(7). RL2134.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL2134.2 +011600 07 FILLER PIC X(1). RL2134.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL2134.2 +011800 07 FILLER PIC X(6). RL2134.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL2134.2 +012000 07 FILLER PIC X(5). RL2134.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL2134.2 +012200 07 FILLER PIC X(6). RL2134.2 +012300 07 XLABEL-TYPE PIC X(1). RL2134.2 +012400 05 FILE-RECORD-INFO-P121-240. RL2134.2 +012500 07 FILLER PIC X(8). RL2134.2 +012600 07 XRECORD-KEY PIC X(29). RL2134.2 +012700 07 FILLER PIC X(9). RL2134.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL2134.2 +012900 07 FILLER PIC X(9). RL2134.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL2134.2 +013100 07 FILLER PIC X(7). RL2134.2 +013200 01 TEST-RESULTS. RL2134.2 +013300 02 FILLER PIC X VALUE SPACE. RL2134.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. RL2134.2 +013500 02 FILLER PIC X VALUE SPACE. RL2134.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. RL2134.2 +013700 02 FILLER PIC X VALUE SPACE. RL2134.2 +013800 02 PAR-NAME. RL2134.2 +013900 03 FILLER PIC X(19) VALUE SPACE. RL2134.2 +014000 03 PARDOT-X PIC X VALUE SPACE. RL2134.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. RL2134.2 +014200 02 FILLER PIC X(8) VALUE SPACE. RL2134.2 +014300 02 RE-MARK PIC X(61). RL2134.2 +014400 01 TEST-COMPUTED. RL2134.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2134.2 +014600 02 FILLER PIC X(17) VALUE RL2134.2 +014700 " COMPUTED=". RL2134.2 +014800 02 COMPUTED-X. RL2134.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2134.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A RL2134.2 +015100 PIC -9(9).9(9). RL2134.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2134.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2134.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2134.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. RL2134.2 +015600 04 COMPUTED-18V0 PIC -9(18). RL2134.2 +015700 04 FILLER PIC X. RL2134.2 +015800 03 FILLER PIC X(50) VALUE SPACE. RL2134.2 +015900 01 TEST-CORRECT. RL2134.2 +016000 02 FILLER PIC X(30) VALUE SPACE. RL2134.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2134.2 +016200 02 CORRECT-X. RL2134.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2134.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2134.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2134.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2134.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2134.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. RL2134.2 +016900 04 CORRECT-18V0 PIC -9(18). RL2134.2 +017000 04 FILLER PIC X. RL2134.2 +017100 03 FILLER PIC X(2) VALUE SPACE. RL2134.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2134.2 +017300 01 CCVS-C-1. RL2134.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2134.2 +017500- "SS PARAGRAPH-NAME RL2134.2 +017600- " REMARKS". RL2134.2 +017700 02 FILLER PIC X(20) VALUE SPACE. RL2134.2 +017800 01 CCVS-C-2. RL2134.2 +017900 02 FILLER PIC X VALUE SPACE. RL2134.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". RL2134.2 +018100 02 FILLER PIC X(15) VALUE SPACE. RL2134.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". RL2134.2 +018300 02 FILLER PIC X(94) VALUE SPACE. RL2134.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2134.2 +018500 01 REC-CT PIC 99 VALUE ZERO. RL2134.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2134.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2134.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2134.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2134.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2134.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2134.2 +019500 01 CCVS-H-1. RL2134.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2134.2 +019700 02 FILLER PIC X(42) VALUE RL2134.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2134.2 +019900 02 FILLER PIC X(39) VALUE SPACES. RL2134.2 +020000 01 CCVS-H-2A. RL2134.2 +020100 02 FILLER PIC X(40) VALUE SPACE. RL2134.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2134.2 +020300 02 FILLER PIC XXXX VALUE RL2134.2 +020400 "4.2 ". RL2134.2 +020500 02 FILLER PIC X(28) VALUE RL2134.2 +020600 " COPY - NOT FOR DISTRIBUTION". RL2134.2 +020700 02 FILLER PIC X(41) VALUE SPACE. RL2134.2 +020800 RL2134.2 +020900 01 CCVS-H-2B. RL2134.2 +021000 02 FILLER PIC X(15) VALUE RL2134.2 +021100 "TEST RESULT OF ". RL2134.2 +021200 02 TEST-ID PIC X(9). RL2134.2 +021300 02 FILLER PIC X(4) VALUE RL2134.2 +021400 " IN ". RL2134.2 +021500 02 FILLER PIC X(12) VALUE RL2134.2 +021600 " HIGH ". RL2134.2 +021700 02 FILLER PIC X(22) VALUE RL2134.2 +021800 " LEVEL VALIDATION FOR ". RL2134.2 +021900 02 FILLER PIC X(58) VALUE RL2134.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +022100 01 CCVS-H-3. RL2134.2 +022200 02 FILLER PIC X(34) VALUE RL2134.2 +022300 " FOR OFFICIAL USE ONLY ". RL2134.2 +022400 02 FILLER PIC X(58) VALUE RL2134.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2134.2 +022600 02 FILLER PIC X(28) VALUE RL2134.2 +022700 " COPYRIGHT 1985 ". RL2134.2 +022800 01 CCVS-E-1. RL2134.2 +022900 02 FILLER PIC X(52) VALUE SPACE. RL2134.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2134.2 +023100 02 ID-AGAIN PIC X(9). RL2134.2 +023200 02 FILLER PIC X(45) VALUE SPACES. RL2134.2 +023300 01 CCVS-E-2. RL2134.2 +023400 02 FILLER PIC X(31) VALUE SPACE. RL2134.2 +023500 02 FILLER PIC X(21) VALUE SPACE. RL2134.2 +023600 02 CCVS-E-2-2. RL2134.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2134.2 +023800 03 FILLER PIC X VALUE SPACE. RL2134.2 +023900 03 ENDER-DESC PIC X(44) VALUE RL2134.2 +024000 "ERRORS ENCOUNTERED". RL2134.2 +024100 01 CCVS-E-3. RL2134.2 +024200 02 FILLER PIC X(22) VALUE RL2134.2 +024300 " FOR OFFICIAL USE ONLY". RL2134.2 +024400 02 FILLER PIC X(12) VALUE SPACE. RL2134.2 +024500 02 FILLER PIC X(58) VALUE RL2134.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +024700 02 FILLER PIC X(13) VALUE SPACE. RL2134.2 +024800 02 FILLER PIC X(15) VALUE RL2134.2 +024900 " COPYRIGHT 1985". RL2134.2 +025000 01 CCVS-E-4. RL2134.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2134.2 +025200 02 FILLER PIC X(4) VALUE " OF ". RL2134.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2134.2 +025400 02 FILLER PIC X(40) VALUE RL2134.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2134.2 +025600 01 XXINFO. RL2134.2 +025700 02 FILLER PIC X(19) VALUE RL2134.2 +025800 "*** INFORMATION ***". RL2134.2 +025900 02 INFO-TEXT. RL2134.2 +026000 04 FILLER PIC X(8) VALUE SPACE. RL2134.2 +026100 04 XXCOMPUTED PIC X(20). RL2134.2 +026200 04 FILLER PIC X(5) VALUE SPACE. RL2134.2 +026300 04 XXCORRECT PIC X(20). RL2134.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). RL2134.2 +026500 01 HYPHEN-LINE. RL2134.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. RL2134.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************RL2134.2 +026800- "*****************************************". RL2134.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************RL2134.2 +027000- "******************************". RL2134.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE RL2134.2 +027200 "RL213A". RL2134.2 +027300 PROCEDURE DIVISION. RL2134.2 +027400 CCVS1 SECTION. RL2134.2 +027500 OPEN-FILES. RL2134.2 +027600 OPEN OUTPUT PRINT-FILE. RL2134.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2134.2 +027800 MOVE SPACE TO TEST-RESULTS. RL2134.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2134.2 +028000 MOVE ZERO TO REC-SKL-SUB. RL2134.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. RL2134.2 +028200 CCVS-INIT-FILE. RL2134.2 +028300 ADD 1 TO REC-SKL-SUB. RL2134.2 +028400 MOVE FILE-RECORD-INFO-SKELETON RL2134.2 +028500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2134.2 +028600 CCVS-INIT-EXIT. RL2134.2 +028700 GO TO CCVS1-EXIT. RL2134.2 +028800 CLOSE-FILES. RL2134.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2134.2 +029000 TERMINATE-CCVS. RL2134.2 +029100S EXIT PROGRAM. RL2134.2 +029200STERMINATE-CALL. RL2134.2 +029300 STOP RUN. RL2134.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2134.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2134.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2134.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2134.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. RL2134.2 +029900 PRINT-DETAIL. RL2134.2 +030000 IF REC-CT NOT EQUAL TO ZERO RL2134.2 +030100 MOVE "." TO PARDOT-X RL2134.2 +030200 MOVE REC-CT TO DOTVALUE. RL2134.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2134.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2134.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2134.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2134.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2134.2 +030800 MOVE SPACE TO CORRECT-X. RL2134.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2134.2 +031000 MOVE SPACE TO RE-MARK. RL2134.2 +031100 HEAD-ROUTINE. RL2134.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2134.2 +031500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2134.2 +031600 COLUMN-NAMES-ROUTINE. RL2134.2 +031700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +031800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +032000 END-ROUTINE. RL2134.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2134.2 +032200 END-RTN-EXIT. RL2134.2 +032300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +032400 END-ROUTINE-1. RL2134.2 +032500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2134.2 +032600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2134.2 +032700 ADD PASS-COUNTER TO ERROR-HOLD. RL2134.2 +032800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2134.2 +032900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2134.2 +033000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2134.2 +033100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2134.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2134.2 +033300 END-ROUTINE-12. RL2134.2 +033400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2134.2 +033500 IF ERROR-COUNTER IS EQUAL TO ZERO RL2134.2 +033600 MOVE "NO " TO ERROR-TOTAL RL2134.2 +033700 ELSE RL2134.2 +033800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2134.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2134.2 +034000 PERFORM WRITE-LINE. RL2134.2 +034100 END-ROUTINE-13. RL2134.2 +034200 IF DELETE-COUNTER IS EQUAL TO ZERO RL2134.2 +034300 MOVE "NO " TO ERROR-TOTAL ELSE RL2134.2 +034400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2134.2 +034500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2134.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +034700 IF INSPECT-COUNTER EQUAL TO ZERO RL2134.2 +034800 MOVE "NO " TO ERROR-TOTAL RL2134.2 +034900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2134.2 +035000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2134.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +035200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +035300 WRITE-LINE. RL2134.2 +035400 ADD 1 TO RECORD-COUNT. RL2134.2 +035500Y IF RECORD-COUNT GREATER 50 RL2134.2 +035600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RL2134.2 +035700Y MOVE SPACE TO DUMMY-RECORD RL2134.2 +035800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2134.2 +035900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2134.2 +036000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2134.2 +036100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2134.2 +036200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RL2134.2 +036300Y MOVE ZERO TO RECORD-COUNT. RL2134.2 +036400 PERFORM WRT-LN. RL2134.2 +036500 WRT-LN. RL2134.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2134.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL2134.2 +036800 BLANK-LINE-PRINT. RL2134.2 +036900 PERFORM WRT-LN. RL2134.2 +037000 FAIL-ROUTINE. RL2134.2 +037100 IF COMPUTED-X NOT EQUAL TO SPACE RL2134.2 +037200 GO TO FAIL-ROUTINE-WRITE. RL2134.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2134.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2134.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2134.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2134.2 +037800 GO TO FAIL-ROUTINE-EX. RL2134.2 +037900 FAIL-ROUTINE-WRITE. RL2134.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2134.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2134.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2134.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL2134.2 +038400 FAIL-ROUTINE-EX. EXIT. RL2134.2 +038500 BAIL-OUT. RL2134.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2134.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2134.2 +038800 BAIL-OUT-WRITE. RL2134.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2134.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2134.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2134.2 +039300 BAIL-OUT-EX. EXIT. RL2134.2 +039400 CCVS1-EXIT. RL2134.2 +039500 EXIT. RL2134.2 +039600 SECT-RL213A-001 SECTION. RL2134.2 +039700 REL-INIT-001. RL2134.2 +039800 MOVE "EXTEND FILE RL-FS1" TO FEATURE. RL2134.2 +039900 OPEN EXTEND RL-FS1. RL2134.2 +040000 MOVE "RL-FS1" TO XFILE-NAME (1). RL2134.2 +040100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2134.2 +040200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2134.2 +040300 MOVE 000120 TO XRECORD-LENGTH (1). RL2134.2 +040400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2134.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). RL2134.2 +040600 MOVE 000520 TO RECORDS-IN-FILE (1). RL2134.2 +040700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2134.2 +040800 MOVE "S" TO XLABEL-TYPE (1). RL2134.2 +040900 MOVE 000501 TO XRECORD-NUMBER (1). RL2134.2 +041000 GO TO REL-TEST-001. RL2134.2 +041100 REL-DELETE-001. RL2134.2 +041200 PERFORM DE-LETE. RL2134.2 +041300 PERFORM PRINT-DETAIL. RL2134.2 +041400 GO TO CCVS-EXIT. RL2134.2 +041500 REL-TEST-001. RL2134.2 +041600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2134.2 +041700 WRITE RL-FS1R1-F-G-120 RL2134.2 +041800 INVALID KEY GO TO REL-FAIL-001. RL2134.2 +041900 IF XRECORD-NUMBER (1) EQUAL TO 520 RL2134.2 +042000 GO TO REL-WRITE-001. RL2134.2 +042100 ADD 000001 TO XRECORD-NUMBER (1). RL2134.2 +042200 GO TO REL-TEST-001. RL2134.2 +042300 REL-FAIL-001. RL2134.2 +042400 PERFORM FAIL. RL2134.2 +042500 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2134.2 +042600 REL-WRITE-001. RL2134.2 +042700 MOVE "REL-TEST-001" TO PAR-NAME RL2134.2 +042800 MOVE "FILE EXTENDED, LFILE" TO COMPUTED-A. RL2134.2 +042900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2134.2 +043000 PERFORM PRINT-DETAIL. RL2134.2 +043100 CLOSE RL-FS1. RL2134.2 +043200* RL2134.2 +043300 REL-INIT-002. RL2134.2 +043400 OPEN INPUT RL-FS1. RL2134.2 +043500 MOVE ZERO TO WRK-CS-09V00. RL2134.2 +043600 GO TO REL-TEST-002. RL2134.2 +043700 REL-DELETE-002. RL2134.2 +043800 PERFORM DE-LETE. RL2134.2 +043900 PERFORM PRINT-DETAIL. RL2134.2 +044000 GO TO CCVS-EXIT. RL2134.2 +044100 REL-TEST-002. RL2134.2 +044200 READ RL-FS1 RL2134.2 +044300 AT END GO TO REL-TEST-002-2. RL2134.2 +044400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2134.2 +044500 ADD 1 TO WRK-CS-09V00. RL2134.2 +044600 IF WRK-CS-09V00 GREATER 520 RL2134.2 +044700 MOVE "MORE THAN 520 RECORDS" TO RE-MARK RL2134.2 +044800 GO TO REL-TEST-002-2. RL2134.2 +044900 REL-TEST-002-1. RL2134.2 +045000 MOVE "REL-TEST-002-1" TO PAR-NAME. RL2134.2 +045100 IF XRECORD-NUMBER (1) NOT = WRK-CS-09V00 RL2134.2 +045200 MOVE "INCORRECT RECORD NUMBER" TO RE-MARK RL2134.2 +045300 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2134.2 +045400 MOVE WRK-CS-09V00 TO CORRECT-N RL2134.2 +045500 PERFORM FAIL RL2134.2 +045600 PERFORM PRINT-DETAIL RL2134.2 +045700 ELSE RL2134.2 +045800 PERFORM PASS. RL2134.2 +045900* PERFORM PRINT-DETAIL. RL2134.2 +046000 GO TO REL-TEST-002. RL2134.2 +046100 REL-TEST-002-2. RL2134.2 +046200 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2134.2 +046300 IF XRECORD-NUMBER (1) NOT EQUAL TO 520 RL2134.2 +046400 PERFORM FAIL RL2134.2 +046500 ELSE RL2134.2 +046600 PERFORM PASS. RL2134.2 +046700 REL-WRITE-002. RL2134.2 +046800 MOVE "REL-TEST-002" TO PAR-NAME. RL2134.2 +046900 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2134.2 +047000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2134.2 +047100 PERFORM PRINT-DETAIL. RL2134.2 +047200 CLOSE RL-FS1. RL2134.2 +047300 CCVS-EXIT SECTION. RL2134.2 +047400 CCVS-999999. RL2134.2 +047500 GO TO CLOSE-FILES. RL2134.2 +*END-OF,RL213A +*HEADER,COBOL,RL301M +000100 IDENTIFICATION DIVISION. RL3014.2 +000200 PROGRAM-ID. RL3014.2 +000300 RL301M. RL3014.2 +000400*The following program tests the flagging of intermediate RL3014.2 +000500*subset features that are used in relative RL3014.2 +000600*input-output. RL3014.2 +000700 ENVIRONMENT DIVISION. RL3014.2 +000800 CONFIGURATION SECTION. RL3014.2 +000900 SOURCE-COMPUTER. RL3014.2 +001000 XXXXX082. RL3014.2 +001100 OBJECT-COMPUTER. RL3014.2 +001200 XXXXX083. RL3014.2 +001300 INPUT-OUTPUT SECTION. RL3014.2 +001400 FILE-CONTROL. RL3014.2 +001500 SELECT TFIL ASSIGN RL3014.2 +001600 XXXXX021 RL3014.2 +001700 ORGANIZATION IS RELATIVE RL3014.2 +001800*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +001900 ACCESS MODE IS RANDOM RL3014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +002100 RELATIVE KEY IS RKEY. RL3014.2 +002200 DATA DIVISION. RL3014.2 +002300 FILE SECTION. RL3014.2 +002400 FD TFIL. RL3014.2 +002500 01 FREC. RL3014.2 +002600 03 GUBBINS PIC 9(8). RL3014.2 +002700 RL3014.2 +002800 WORKING-STORAGE SECTION. RL3014.2 +002900 01 VARIABLES. RL3014.2 +003000 03 STATE PIC X(4) VALUE SPACES. RL3014.2 +003100 03 RKEY PIC 9(8) VALUE ZERO. RL3014.2 +003200 RL3014.2 +003300 PROCEDURE DIVISION. RL3014.2 +003400 RL3014.2 +003500 RL301M-CONTROL. RL3014.2 +003600 OPEN I-O TFIL. RL3014.2 +003700 PERFORM RL301M-READ THRU RL301M-DELETE 1 TIMES. RL3014.2 +003800 CLOSE TFIL. RL3014.2 +003900 STOP RUN. RL3014.2 +004000 RL3014.2 +004100 RL301M-READ. RL3014.2 +004200 READ TFIL INVALID KEY PERFORM INV-PARA RL3014.2 +004300 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +004400*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +004500 RL3014.2 +004600 RL301M-REWRITE. RL3014.2 +004700 REWRITE FREC INVALID KEY PERFORM INV-PARA RL3014.2 +004800 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +004900*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +005000 RL3014.2 +005100 RL301M-WRITE. RL3014.2 +005200 WRITE FREC INVALID KEY PERFORM INV-PARA RL3014.2 +005300 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +005500 RL3014.2 +005600 RL301M-DELETE. RL3014.2 +005700 DELETE TFIL INVALID KEY PERFORM INV-PARA RL3014.2 +005800 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +005900*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +006000 RL3014.2 +006100 INV-PARA. RL3014.2 +006200 MOVE "INVA" TO STATE. RL3014.2 +006300 RL3014.2 +006400 DONE-PARA. RL3014.2 +006500 MOVE "DONE" TO STATE. RL3014.2 +006600 RL3014.2 +006700*TOTAL NUMBER OF FLAGS EXPECTED = 6. RL3014.2 +*END-OF,RL301M +*HEADER,COBOL,RL302M +000100 IDENTIFICATION DIVISION. RL3024.2 +000200 PROGRAM-ID. RL3024.2 +000300 RL302M. RL3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RL3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN INTERMEDIATE SUBSET RL3024.2 +000600*RELATIVE INPUT-OUTPUT. RL3024.2 +000700*INPUT-OUTPUT. RL3024.2 +000800 ENVIRONMENT DIVISION. RL3024.2 +000900 CONFIGURATION SECTION. RL3024.2 +001000 SOURCE-COMPUTER. RL3024.2 +001100 XXXXX082. RL3024.2 +001200 OBJECT-COMPUTER. RL3024.2 +001300 XXXXX083. RL3024.2 +001400 INPUT-OUTPUT SECTION. RL3024.2 +001500 FILE-CONTROL. RL3024.2 +001600 SELECT TFIL ASSIGN RL3024.2 +001700 XXXXX021 RL3024.2 +001800 ORGANIZATION IS RELATIVE RL3024.2 +001900 ACCESS MODE IS RANDOM RL3024.2 +002000 RELATIVE KEY IS RKEY. RL3024.2 +002100 RL3024.2 +002200 SELECT SQ-FRR ASSIGN RL3024.2 +002300 XXXXX013 RL3024.2 +002400 ORGANIZATION IS SEQUENTIAL. RL3024.2 +002500 RL3024.2 +002600 SELECT RR-FS1 ASSIGN RL3024.2 +002700 XXXXX021 RL3024.2 +002800 ORGANIZATION IS RELATIVE. RL3024.2 +002900 I-O-CONTROL. RL3024.2 +003000 XXXXX053. RL3024.2 +003100*Message expected for above statement: OBSOLETE RL3024.2 +003200 RL3024.2 +003300 DATA DIVISION. RL3024.2 +003400 FILE SECTION. RL3024.2 +003500 FD TFIL RL3024.2 +003600 LABEL RECORDS STANDARD RL3024.2 +003700*Message expected for above statement: OBSOLETE RL3024.2 +003800 VALUE OF RL3024.2 +003900 XXXXX074 RL3024.2 +004000 IS RL3024.2 +004100 XXXXX075 RL3024.2 +004200*Message expected for above statement: OBSOLETE RL3024.2 +004300 DATA RECORDS ARE FREC. RL3024.2 +004400*Message expected for above statement: OBSOLETE RL3024.2 +004500 RL3024.2 +004600 01 FREC. RL3024.2 +004700 03 GUBBINS PIC 9(8). RL3024.2 +004800 RL3024.2 +004900 FD SQ-FRR. RL3024.2 +005000 01 SREC. RL3024.2 +005100 03 SKEY PIC X(8). RL3024.2 +005200 RL3024.2 +005300 FD RR-FS1. RL3024.2 +005400 01 RREC. RL3024.2 +005500 03 FKEY PIC X(8). RL3024.2 +005600 RL3024.2 +005700 WORKING-STORAGE SECTION. RL3024.2 +005800 RL3024.2 +005900 01 VARIABLES. RL3024.2 +006000 03 RKEY PIC 9(8) VALUE ZERO. RL3024.2 +006100 03 VKEY PIC 9(8) VALUE ZERO. RL3024.2 +006200 03 DKEY PIC 9(8) VALUE ZERO. RL3024.2 +006300 RL3024.2 +006400 PROCEDURE DIVISION. RL3024.2 +006500 RL3024.2 +006600 RL302M-CONTROL. RL3024.2 +006700 DISPLAY "THIS IS A DUMMY PARAGRAPH". RL3024.2 +006800 STOP RUN. RL3024.2 +006900 RL3024.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 4. RL3024.2 +*END-OF,RL302M +*HEADER,COBOL,RL401M +000100 IDENTIFICATION DIVISION. RL4014.2 +000200 PROGRAM-ID. RL4014.2 +000300 RL401M. RL4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RL4014.2 +000500*HIGH SUBSET FEATURES THAT ARE USED IN RELATIVE RL4014.2 +000600*INPUT-OUTPUT. RL4014.2 +000700 ENVIRONMENT DIVISION. RL4014.2 +000800 CONFIGURATION SECTION. RL4014.2 +000900 SOURCE-COMPUTER. RL4014.2 +001000 XXXXX082. RL4014.2 +001100 OBJECT-COMPUTER. RL4014.2 +001200 XXXXX083. RL4014.2 +001300 INPUT-OUTPUT SECTION. RL4014.2 +001400 FILE-CONTROL. RL4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN RL4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +001700 XXXXX021 RL4014.2 +001800 RESERVE 2 AREAS RL4014.2 +001900*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +002000 ORGANIZATION IS RELATIVE RL4014.2 +002100 ACCESS MODE IS DYNAMIC RL4014.2 +002200*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +002300 RELATIVE KEY IS RKEY. RL4014.2 +002400 RL4014.2 +002500 SELECT TFIL2 ASSIGN RL4014.2 +002600 XXXXX022 RL4014.2 +002700 ORGANIZATION IS RELATIVE. RL4014.2 +002800 RL4014.2 +002900 I-O-CONTROL. RL4014.2 +003000 SAME RECORD AREA FOR TFIL2, TFIL. RL4014.2 +003100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +003200 RL4014.2 +003300 DATA DIVISION. RL4014.2 +003400 FILE SECTION. RL4014.2 +003500 FD TFIL RL4014.2 +003600 RECORD IS VARYING IN SIZE FROM 1 TO 8 CHARACTERS. RL4014.2 +003700*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +003800 RL4014.2 +003900 01 FREC. RL4014.2 +004000 03 GUBBINS PIC 9(8). RL4014.2 +004100 RL4014.2 +004200 RL4014.2 +004300 FD TFIL2. RL4014.2 +004400 01 FREC2. RL4014.2 +004500 03 RKEY2 PIC 9(8). RL4014.2 +004600 RL4014.2 +004700 WORKING-STORAGE SECTION. RL4014.2 +004800 01 RKEY PIC 9(8) VALUE ZERO. RL4014.2 +004900 RL4014.2 +005000 PROCEDURE DIVISION. RL4014.2 +005100 RL4014.2 +005200 RL401M-CONTROL. RL4014.2 +005300 OPEN INPUT TFIL. RL4014.2 +005400 PERFORM RL401M-CLOSE THRU RL401M-START. RL4014.2 +005500 CLOSE TFIL. RL4014.2 +005600 CLOSE TFIL2. RL4014.2 +005700 STOP RUN. RL4014.2 +005800 RL4014.2 +005900 RL401M-CLOSE. RL4014.2 +006000 CLOSE TFIL WITH LOCK. RL4014.2 +006100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +006200 OPEN INPUT TFIL. RL4014.2 +006300 RL4014.2 +006400 RL401M-OPENEXT. RL4014.2 +006500 OPEN EXTEND TFIL2. RL4014.2 +006600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +006700 RL4014.2 +006800 RL401M-READNEXT. RL4014.2 +006900 READ TFIL NEXT RECORD RL4014.2 +007000 AT END DISPLAY "AT END". RL4014.2 +007100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +007200 RL4014.2 +007300 RL401M-START. RL4014.2 +007400 START TFIL KEY IS EQUAL TO RKEY RL4014.2 +007500 INVALID KEY STOP RUN. RL4014.2 +007600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +007700 RL4014.2 +007800*TOTAL NUMBER OF FLAGS EXPECTED = 9. RL4014.2 +*END-OF,RL401M +*HEADER,COBOL,RW101A +000100 IDENTIFICATION DIVISION. RW1014.2 +000200 PROGRAM-ID. RW1014.2 +000300 RW101A. RW1014.2 +000400 AUTHOR. RW1014.2 +000500 FEDERAL COMPILER TESTING CENTER. RW1014.2 +000600 INSTALLATION. RW1014.2 +000700 GENERAL SERVICES ADMINISTRATION RW1014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. RW1014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. RW1014.2 +001000 5203 LEESBURG PIKE SUITE 1100 RW1014.2 +001100 FALLS CHURCH VIRGINIA 22041. RW1014.2 +001200 RW1014.2 +001300 PHONE (703) 756-6153 RW1014.2 +001400 RW1014.2 +001500 " HIGH ". RW1014.2 +001600 DATE-WRITTEN. RW1014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. RW1014.2 +001800 CREATION DATE / VALIDATION DATE RW1014.2 +001900 "4.2 ". RW1014.2 +002000 SECURITY. RW1014.2 +002100 NONE. RW1014.2 +002200******************************************************************RW1014.2 +002300* RW1014.2 +002400* THE ROUTINE RW101A TESTS THE BASIC REPORT WRITER MODULE RW1014.2 +002500* FUNCTIONS. A SINGLE OUTPUT REPORT IS PRODUCED BY THE RWCS. RW1014.2 +002600* THE REPORT DESCRIPTION IN THIS ROUTINE CONTAINS A RW1014.2 +002700* PAGE LIMIT IS 20 LINES RW1014.2 +002800* WITHOUT THE OPTIONAL HEADING, FIRST DETAIL, LAST DETAIL OR RW1014.2 +002900* FOOTING PHRASES. THE ASSUMED VALUES FOR THESE PHRASES ARE RW1014.2 +003000* HEADING - VALUE OF 1, RW1014.2 +003100* FIRST DETAIL - VALUE OF 1, RW1014.2 +003200* LAST DETAIL - VALUE OF 20, RW1014.2 +003300* FOOTING - VALUE OF 20. RW1014.2 +003400* A SINGLE DETAIL REPORT GROUP IS DEFINED FOR THE REPORT. RW1014.2 +003500* RW1014.2 +003600* THE ROUTINE RW101A PROCEDURE DIVISION RW1014.2 +003700* OPENS THE OUTPUT SEQUENTIAL FILE FOR THE REPORT, RW1014.2 +003800* INITIATES THE REPORT, RW1014.2 +003900* CHECKS THE VALUES IN LINE-COUNTER AND PAGE-COUNTER RW1014.2 +004000* AFTER EXECUTING THE INITIATE STATEMENT, RW1014.2 +004100* GENERATES THE REPORT BODY WITH RW1014.2 +004200* GENERATE DATA-NAME RW1014.2 +004300* STATEMENTS, CHECKING THE LINE-COUNTER AND PAGE-COUNTERW1014.2 +004400* VALUES AFTER EACH GENERATE STATEMENT, RW1014.2 +004500* TERMINATES THE REPORT, RW1014.2 +004600* CLOSES THE REPORT FILE. RW1014.2 +004700* RW1014.2 +004800* THE OUTPUT OF THIS ROUTINE CONSISTS OF AN OUTPUT REPORT RW1014.2 +004900* IN THE USUAL AUDIT ROUTINE FORMAT PRODUCED USING WRITE RW1014.2 +005000* STATEMENTS AND A REPORT PRODUCED BY THE RWCS. BOTH REPORTS RW1014.2 +005100* MUST BE CAREFULLY EXAMINED TO VERIFY THAT THE TESTS IN RW1014.2 +005200* RW101 WERE EXECUTED CORRECTLY. RW1014.2 +005300* RW1014.2 +005400* THE OUTPUT REPORT GENERATED BY THE RWCS CONSISTS OF RW1014.2 +005500* 20 LINES. ON THE OUTPUT REPORT, THE WORKING-STORAGE LINE RW1014.2 +005600* COUNT IS EQUAL TO THE LINE NUMBER ON WHICH THE LINE IS RW1014.2 +005700* PRESENTED. SINCE LINE-COUNTER IS MOVED TO THE RWCS SOURCE RW1014.2 +005800* FIELD BEFORE THE GENERATE STATEMENT, THE DISPLAYED LINE- RW1014.2 +005900* COUNTER IS ONE LESS THAN THE LINE NUMBER. RW1014.2 +006000* RW1014.2 +006100******************************************************************RW1014.2 +006200* RW1014.2 +006300* REFERENCE AMERICAN NATIONAL STANDARD PROGRAMMING RW1014.2 +006400* LANGUAGE COBOL, X3.23-1974 RW1014.2 +006500* SECTION VIII - REPORT WRITER MODULE RW1014.2 +006600* RW1014.2 +006700******************************************************************RW1014.2 +006800 ENVIRONMENT DIVISION. RW1014.2 +006900 CONFIGURATION SECTION. RW1014.2 +007000 SOURCE-COMPUTER. RW1014.2 +007100 XXXXX082. RW1014.2 +007200 OBJECT-COMPUTER. RW1014.2 +007300 XXXXX083. RW1014.2 +007400 INPUT-OUTPUT SECTION. RW1014.2 +007500 FILE-CONTROL. RW1014.2 +007600 SELECT PRINT-FILE ASSIGN TO RW1014.2 +007700 XXXXX055. RW1014.2 +007800 SELECT RW-FS1 ASSIGN TO RW1014.2 +007900 XXXXX049. RW1014.2 +008000 DATA DIVISION. RW1014.2 +008100 FILE SECTION. RW1014.2 +008200 FD PRINT-FILE RW1014.2 +008300 LABEL RECORDS RW1014.2 +008400 XXXXX084 RW1014.2 +008500 DATA RECORD IS PRINT-REC DUMMY-RECORD. RW1014.2 +008600 01 PRINT-REC PICTURE X(120). RW1014.2 +008700 01 DUMMY-RECORD PICTURE X(120). RW1014.2 +008800 FD RW-FS1 RW1014.2 +008900 LABEL RECORDS ARE STANDARD RW1014.2 +009000C VALUE OF RW1014.2 +009100C XXXXX074 RW1014.2 +009200C IS RW1014.2 +009300C XXXXX075 RW1014.2 +009400G XXXXX069 RW1014.2 +009500 REPORT IS RW-FS1-REPORT-1. RW1014.2 +009600 WORKING-STORAGE SECTION. RW1014.2 +009700 01 LC-ERRORS PICTURE 99 VALUE 0. RW1014.2 +009800 01 PC-ERRORS PICTURE 99 VALUE 0. RW1014.2 +009900 01 REPORT-LINE-IMAGE. RW1014.2 +010000 02 FILLER PICTURE X(43) RW1014.2 +010100 VALUE "DETAIL LINE WORKING-STORAGE LINE COUNTER = ". RW1014.2 +010200 02 WS-COUNTER PICTURE 9(6) VALUE ZERO. RW1014.2 +010300 02 FILLER PICTURE X(21) RW1014.2 +010400 VALUE " RWCS LINE-COUNTER = ". RW1014.2 +010500 02 STORE-LINE-COUNTER PICTURE 9(6). RW1014.2 +010600 01 TEST-RESULTS. RW1014.2 +010700 02 FILLER PICTURE X VALUE SPACE. RW1014.2 +010800 02 FEATURE PICTURE X(20) VALUE SPACE. RW1014.2 +010900 02 FILLER PICTURE X VALUE SPACE. RW1014.2 +011000 02 P-OR-F PICTURE X(5) VALUE SPACE. RW1014.2 +011100 02 FILLER PICTURE X VALUE SPACE. RW1014.2 +011200 02 PAR-NAME. RW1014.2 +011300 03 FILLER PICTURE X(12) VALUE SPACE. RW1014.2 +011400 03 PARDOT-X PICTURE X VALUE SPACE. RW1014.2 +011500 03 DOTVALUE PICTURE 99 VALUE ZERO. RW1014.2 +011600 03 FILLER PIC X(5) VALUE SPACE. RW1014.2 +011700 02 FILLER PIC X(10) VALUE SPACE. RW1014.2 +011800 02 RE-MARK PIC X(61). RW1014.2 +011900 01 TEST-COMPUTED. RW1014.2 +012000 02 FILLER PIC X(30) VALUE SPACE. RW1014.2 +012100 02 FILLER PIC X(17) VALUE " COMPUTED=". RW1014.2 +012200 02 COMPUTED-X. RW1014.2 +012300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. RW1014.2 +012400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). RW1014.2 +012500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). RW1014.2 +012600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). RW1014.2 +012700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). RW1014.2 +012800 03 CM-18V0 REDEFINES COMPUTED-A. RW1014.2 +012900 04 COMPUTED-18V0 PICTURE -9(18). RW1014.2 +013000 04 FILLER PICTURE X. RW1014.2 +013100 03 FILLER PIC X(50) VALUE SPACE. RW1014.2 +013200 01 TEST-CORRECT. RW1014.2 +013300 02 FILLER PIC X(30) VALUE SPACE. RW1014.2 +013400 02 FILLER PIC X(17) VALUE " CORRECT =". RW1014.2 +013500 02 CORRECT-X. RW1014.2 +013600 03 CORRECT-A PICTURE X(20) VALUE SPACE. RW1014.2 +013700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). RW1014.2 +013800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). RW1014.2 +013900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). RW1014.2 +014000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). RW1014.2 +014100 03 CR-18V0 REDEFINES CORRECT-A. RW1014.2 +014200 04 CORRECT-18V0 PICTURE -9(18). RW1014.2 +014300 04 FILLER PICTURE X. RW1014.2 +014400 03 FILLER PIC X(50) VALUE SPACE. RW1014.2 +014500 01 CCVS-C-1. RW1014.2 +014600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PARW1014.2 +014700- "SS PARAGRAPH-NAME RW1014.2 +014800- " REMARKS". RW1014.2 +014900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. RW1014.2 +015000 01 CCVS-C-2. RW1014.2 +015100 02 FILLER PICTURE IS X VALUE IS SPACE. RW1014.2 +015200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". RW1014.2 +015300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. RW1014.2 +015400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". RW1014.2 +015500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. RW1014.2 +015600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. RW1014.2 +015700 01 REC-CT PICTURE 99 VALUE ZERO. RW1014.2 +015800 01 DELETE-CNT PICTURE 999 VALUE ZERO. RW1014.2 +015900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. RW1014.2 +016000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RW1014.2 +016100 01 PASS-COUNTER PIC 999 VALUE ZERO. RW1014.2 +016200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RW1014.2 +016300 01 ERROR-HOLD PIC 999 VALUE ZERO. RW1014.2 +016400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RW1014.2 +016500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RW1014.2 +016600 01 CCVS-H-1. RW1014.2 +016700 02 FILLER PICTURE X(27) VALUE SPACE. RW1014.2 +016800 02 FILLER PICTURE X(67) VALUE RW1014.2 +016900 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION RW1014.2 +017000- " SYSTEM". RW1014.2 +017100 02 FILLER PICTURE X(26) VALUE SPACE. RW1014.2 +017200 01 CCVS-H-2. RW1014.2 +017300 02 FILLER PICTURE X(52) VALUE IS RW1014.2 +017400 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". RW1014.2 +017500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". RW1014.2 +017600 02 TEST-ID PICTURE IS X(9). RW1014.2 +017700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. RW1014.2 +017800 01 CCVS-H-3. RW1014.2 +017900 02 FILLER PICTURE X(34) VALUE RW1014.2 +018000 " FOR OFFICIAL USE ONLY ". RW1014.2 +018100 02 FILLER PICTURE X(58) VALUE RW1014.2 +018200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RW1014.2 +018300 02 FILLER PICTURE X(28) VALUE RW1014.2 +018400 " COPYRIGHT 1974 ". RW1014.2 +018500 01 CCVS-E-1. RW1014.2 +018600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. RW1014.2 +018700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". RW1014.2 +018800 02 ID-AGAIN PICTURE IS X(9). RW1014.2 +018900 02 FILLER PICTURE X(45) VALUE IS RW1014.2 +019000 " NTIS DISTRIBUTION COBOL 74". RW1014.2 +019100 01 CCVS-E-2. RW1014.2 +019200 02 FILLER PICTURE X(31) VALUE RW1014.2 +019300 SPACE. RW1014.2 +019400 02 FILLER PICTURE X(21) VALUE SPACE. RW1014.2 +019500 02 CCVS-E-2-2. RW1014.2 +019600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. RW1014.2 +019700 03 FILLER PICTURE IS X VALUE IS SPACE. RW1014.2 +019800 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". RW1014.2 +019900 01 CCVS-E-3. RW1014.2 +020000 02 FILLER PICTURE X(22) VALUE RW1014.2 +020100 " FOR OFFICIAL USE ONLY". RW1014.2 +020200 02 FILLER PICTURE X(12) VALUE SPACE. RW1014.2 +020300 02 FILLER PICTURE X(58) VALUE RW1014.2 +020400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RW1014.2 +020500 02 FILLER PICTURE X(13) VALUE SPACE. RW1014.2 +020600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". RW1014.2 +020700 01 CCVS-E-4. RW1014.2 +020800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RW1014.2 +020900 02 FILLER PIC XXXX VALUE " OF ". RW1014.2 +021000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RW1014.2 +021100 02 FILLER PIC X(40) VALUE RW1014.2 +021200 " TESTS WERE EXECUTED SUCCESSFULLY". RW1014.2 +021300 01 XXINFO. RW1014.2 +021400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". RW1014.2 +021500 02 INFO-TEXT. RW1014.2 +021600 04 FILLER PIC X(20) VALUE SPACE. RW1014.2 +021700 04 XXCOMPUTED PIC X(20). RW1014.2 +021800 04 FILLER PIC X(5) VALUE SPACE. RW1014.2 +021900 04 XXCORRECT PIC X(20). RW1014.2 +022000 01 HYPHEN-LINE. RW1014.2 +022100 02 FILLER PICTURE IS X VALUE IS SPACE. RW1014.2 +022200 02 FILLER PICTURE IS X(65) VALUE IS "************************RW1014.2 +022300- "*****************************************". RW1014.2 +022400 02 FILLER PICTURE IS X(54) VALUE IS "************************RW1014.2 +022500- "******************************". RW1014.2 +022600 01 CCVS-PGM-ID PIC X(6) VALUE RW1014.2 +022700 "RW101A". RW1014.2 +022800 REPORT SECTION. RW1014.2 +022900 RD RW-FS1-REPORT-1 RW1014.2 +023000 PAGE LIMIT IS 20 LINES. RW1014.2 +023100 01 RW-FS1-GROUP RW1014.2 +023200 TYPE IS DETAIL. RW1014.2 +023300 03 RW-FS1-ELEM RW1014.2 +023400 LINE NUMBER IS PLUS 1 RW1014.2 +023500 COLUMN NUMBER IS 5 RW1014.2 +023600 PICTURE X(76) RW1014.2 +023700 SOURCE IS REPORT-LINE-IMAGE. RW1014.2 +023800 PROCEDURE DIVISION. RW1014.2 +023900 CCVS1 SECTION. RW1014.2 +024000 OPEN-FILES. RW1014.2 +024100 OPEN OUTPUT PRINT-FILE. RW1014.2 +024200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RW1014.2 +024300 MOVE SPACE TO TEST-RESULTS. RW1014.2 +024400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RW1014.2 +024500 GO TO CCVS1-EXIT. RW1014.2 +024600 CLOSE-FILES. RW1014.2 +024700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RW1014.2 +024800 TERMINATE-CCVS. RW1014.2 +024900S EXIT PROGRAM. RW1014.2 +025000STERMINATE-CALL. RW1014.2 +025100 STOP RUN. RW1014.2 +025200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RW1014.2 +025300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RW1014.2 +025400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RW1014.2 +025500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. RW1014.2 +025600 MOVE "****TEST DELETED****" TO RE-MARK. RW1014.2 +025700 PRINT-DETAIL. RW1014.2 +025800 IF REC-CT NOT EQUAL TO ZERO RW1014.2 +025900 MOVE "." TO PARDOT-X RW1014.2 +026000 MOVE REC-CT TO DOTVALUE. RW1014.2 +026100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RW1014.2 +026200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RW1014.2 +026300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RW1014.2 +026400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RW1014.2 +026500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RW1014.2 +026600 MOVE SPACE TO CORRECT-X. RW1014.2 +026700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RW1014.2 +026800 MOVE SPACE TO RE-MARK. RW1014.2 +026900 HEAD-ROUTINE. RW1014.2 +027000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1014.2 +027100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. RW1014.2 +027200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RW1014.2 +027300 COLUMN-NAMES-ROUTINE. RW1014.2 +027400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1014.2 +027500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1014.2 +027600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1014.2 +027700 END-ROUTINE. RW1014.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RW1014.2 +027900 END-RTN-EXIT. RW1014.2 +028000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1014.2 +028100 END-ROUTINE-1. RW1014.2 +028200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RW1014.2 +028300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. RW1014.2 +028400 ADD PASS-COUNTER TO ERROR-HOLD. RW1014.2 +028500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RW1014.2 +028600 MOVE PASS-COUNTER TO CCVS-E-4-1. RW1014.2 +028700 MOVE ERROR-HOLD TO CCVS-E-4-2. RW1014.2 +028800 MOVE CCVS-E-4 TO CCVS-E-2-2. RW1014.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RW1014.2 +029000 END-ROUTINE-12. RW1014.2 +029100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RW1014.2 +029200 IF ERROR-COUNTER IS EQUAL TO ZERO RW1014.2 +029300 MOVE "NO " TO ERROR-TOTAL RW1014.2 +029400 ELSE RW1014.2 +029500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RW1014.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. RW1014.2 +029700 PERFORM WRITE-LINE. RW1014.2 +029800 END-ROUTINE-13. RW1014.2 +029900 IF DELETE-CNT IS EQUAL TO ZERO RW1014.2 +030000 MOVE "NO " TO ERROR-TOTAL ELSE RW1014.2 +030100 MOVE DELETE-CNT TO ERROR-TOTAL. RW1014.2 +030200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RW1014.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1014.2 +030400 IF INSPECT-COUNTER EQUAL TO ZERO RW1014.2 +030500 MOVE "NO " TO ERROR-TOTAL RW1014.2 +030600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RW1014.2 +030700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RW1014.2 +030800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1014.2 +030900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1014.2 +031000 WRITE-LINE. RW1014.2 +031100 ADD 1 TO RECORD-COUNT. RW1014.2 +031200Y IF RECORD-COUNT GREATER 50 RW1014.2 +031300Y MOVE DUMMY-RECORD TO DUMMY-HOLD RW1014.2 +031400Y MOVE SPACE TO DUMMY-RECORD RW1014.2 +031500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RW1014.2 +031600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RW1014.2 +031700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RW1014.2 +031800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RW1014.2 +031900Y MOVE DUMMY-HOLD TO DUMMY-RECORD RW1014.2 +032000Y MOVE ZERO TO RECORD-COUNT. RW1014.2 +032100 PERFORM WRT-LN. RW1014.2 +032200 WRT-LN. RW1014.2 +032300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RW1014.2 +032400 MOVE SPACE TO DUMMY-RECORD. RW1014.2 +032500 BLANK-LINE-PRINT. RW1014.2 +032600 PERFORM WRT-LN. RW1014.2 +032700 FAIL-ROUTINE. RW1014.2 +032800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1014.2 +032900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1014.2 +033000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RW1014.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1014.2 +033200 GO TO FAIL-ROUTINE-EX. RW1014.2 +033300 FAIL-ROUTINE-WRITE. RW1014.2 +033400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RW1014.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RW1014.2 +033600 FAIL-ROUTINE-EX. EXIT. RW1014.2 +033700 BAIL-OUT. RW1014.2 +033800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RW1014.2 +033900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RW1014.2 +034000 BAIL-OUT-WRITE. RW1014.2 +034100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RW1014.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1014.2 +034300 BAIL-OUT-EX. EXIT. RW1014.2 +034400 CCVS1-EXIT. RW1014.2 +034500 EXIT. RW1014.2 +034600 SECT-RW101-0001 SECTION. RW1014.2 +034700 RW101-INIT. RW1014.2 +034800 OPEN OUTPUT RW-FS1. RW1014.2 +034900 INIT-TEST-STATE. RW1014.2 +035000 INITIATE RW-FS1-REPORT-1. RW1014.2 +035100 INIT-TEST-01. RW1014.2 +035200* RW1014.2 +035300* AFTER EXECUTION OF THE INITIATE STATEMENT FOR A REPORT, RW1014.2 +035400* THE REPORT LINE-COUNTER SHOULD BE SET TO ZERO. RW1014.2 +035500* REFERENCE PAGE VIII-53, 3.2.4(1)B, THE INITIATE STATEMENT. RW1014.2 +035600* RW1014.2 +035700 IF LINE-COUNTER EQUAL TO ZERO RW1014.2 +035800 PERFORM PASS RW1014.2 +035900 GO TO INIT-WRITE-01. RW1014.2 +036000 INIT-FAIL-01. RW1014.2 +036100 PERFORM FAIL. RW1014.2 +036200 MOVE ZERO TO CORRECT-18V0. RW1014.2 +036300 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1014.2 +036400 MOVE "LINE-COUNTER AFTER INITIATE" TO RE-MARK. RW1014.2 +036500 INIT-WRITE-01. RW1014.2 +036600 MOVE "INIT-TEST-01" TO PAR-NAME. RW1014.2 +036700 MOVE "INITIATE REPORT" TO FEATURE. RW1014.2 +036800 PERFORM PRINT-DETAIL. RW1014.2 +036900 INIT-TEST-02. RW1014.2 +037000* RW1014.2 +037100* AFTER EXECUTION OF THE INITIATE STATEMENT FOR A REPORT, RW1014.2 +037200* THE REPORT PAGE-COUNTER SHOULD BE SET TO ONE. RW1014.2 +037300* REFERENCE PAGE VIII-53, 3.2.4(1)C, THE INITIATE STATEMENT. RW1014.2 +037400* RW1014.2 +037500 IF PAGE-COUNTER EQUAL TO 1 RW1014.2 +037600 PERFORM PASS RW1014.2 +037700 GO TO INIT-WRITE-02. RW1014.2 +037800 INIT-FAIL-02. RW1014.2 +037900 PERFORM FAIL. RW1014.2 +038000 MOVE 1 TO CORRECT-18V0. RW1014.2 +038100 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1014.2 +038200 MOVE "PAGE-COUNTER AFTER INITIATE" TO RE-MARK. RW1014.2 +038300 INIT-WRITE-02. RW1014.2 +038400 MOVE "INIT-TEST-02" TO PAR-NAME. RW1014.2 +038500 PERFORM PRINT-DETAIL. RW1014.2 +038600 GENER-INIT-01. RW1014.2 +038700* THIS TEST EXECUTES THE CHRONOLOGICALLY FIRST GENERATE RW1014.2 +038800* STATEMENT FOR THE REPORT RW-FS1-REPORT-1. RW1014.2 +038900* REFERENCE PAGE VIII-51, 3.1.4(2), (5)D, GENERATE STATEMENT RW1014.2 +039000* RW1014.2 +039100 ADD 1 TO WS-COUNTER. RW1014.2 +039200 MOVE LINE-COUNTER TO STORE-LINE-COUNTER. RW1014.2 +039300 GENERATE RW-FS1-GROUP. RW1014.2 +039400* RW1014.2 +039500* OUTPUT REPORT INFO RW1014.2 +039600* THE DETAIL REPORT GROUP SHOULD BE PRESENTED ON THE FIRSTRW1014.2 +039700* LINE OF THE REPORT PAGE. RW1014.2 +039800* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE. RULESRW1014.2 +039900* RW1014.2 +040000 GENER-TEST-01. RW1014.2 +040100 IF LINE-COUNTER NOT EQUAL TO 1 RW1014.2 +040200 GO TO GENER-FAIL-01. RW1014.2 +040300* RW1014.2 +040400* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1014.2 +040500* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1014.2 +040600* PRESENTED, IN THIS CASE ONE. RW1014.2 +040700* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1014.2 +040800* RW1014.2 +040900 GENER-PASS-01. RW1014.2 +041000 PERFORM PASS. RW1014.2 +041100 GO TO GENER-WRITE-01. RW1014.2 +041200 GENER-FAIL-01. RW1014.2 +041300 PERFORM FAIL. RW1014.2 +041400 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1014.2 +041500 MOVE 1 TO CORRECT-18V0. RW1014.2 +041600 MOVE "LINE-COUNTER AFTER FIRST GENER" TO RE-MARK. RW1014.2 +041700 GENER-WRITE-01. RW1014.2 +041800 MOVE "GENER-TEST-1" TO PAR-NAME. RW1014.2 +041900 MOVE "FIRST GENERATE" TO FEATURE. RW1014.2 +042000 PERFORM PRINT-DETAIL. RW1014.2 +042100 GENER-TEST-02. RW1014.2 +042200 IF PAGE-COUNTER NOT EQUAL TO 1 RW1014.2 +042300 GO TO GENER-FAIL-02. RW1014.2 +042400* RW1014.2 +042500* EXECUTION OF THE GENERATE STATEMENT SHOULD NOT CHANGE RW1014.2 +042600* THE VALUE OF PAGE-COUNTER. IT SHOULD STILL BE EQUAL TO ONE. RW1014.2 +042700* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES. RW1014.2 +042800* RW1014.2 +042900 GENER-PASS-02. RW1014.2 +043000 PERFORM PASS. RW1014.2 +043100 GO TO GENER-WRITE-02. RW1014.2 +043200 GENER-FAIL-02. RW1014.2 +043300 PERFORM FAIL. RW1014.2 +043400 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1014.2 +043500 MOVE 1 TO CORRECT-18V0. RW1014.2 +043600 MOVE "PAGE-COUNTER AFTER FIRST GENER" TO RE-MARK. RW1014.2 +043700 GENER-WRITE-02. RW1014.2 +043800 MOVE "GENER-TEST-2" TO PAR-NAME. RW1014.2 +043900 PERFORM PRINT-DETAIL. RW1014.2 +044000 GENER-INIT-03. RW1014.2 +044100* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1014.2 +044200* REPORT GROUP 18 TIMES. RW1014.2 +044300* REFERENCE PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1014.2 +044400* RW1014.2 +044500 PERFORM GENER-DETAIL-LINE 18 TIMES. RW1014.2 +044600* RW1014.2 +044700* OUTPUT REPORT INFO RW1014.2 +044800* EIGHTEEN DETAIL LINES SINGLE SPACED SHOULD BE PRESENTED RW1014.2 +044900* ON LINES 2 THROUGH 19 OF THE FIRST REPORT PAGE. RW1014.2 +045000* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULES RW1014.2 +045100* RW1014.2 +045200 GENER-TEST-03. RW1014.2 +045300 IF LC-ERRORS EQUAL TO ZERO RW1014.2 +045400 PERFORM PASS RW1014.2 +045500 GO TO GENER-WRITE-03. RW1014.2 +045600 GENER-FAIL-03. RW1014.2 +045700 PERFORM FAIL. RW1014.2 +045800 MOVE LC-ERRORS TO COMPUTED-18V0. RW1014.2 +045900 MOVE ZERO TO CORRECT-18V0. RW1014.2 +046000 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1014.2 +046100 GENER-WRITE-03. RW1014.2 +046200 MOVE "GENER-TEST-3" TO PAR-NAME. RW1014.2 +046300 MOVE "GENERATE 18 LINES" TO FEATURE. RW1014.2 +046400 PERFORM PRINT-DETAIL. RW1014.2 +046500 GO TO GENER-TEST-04. RW1014.2 +046600 GENER-DETAIL-LINE. RW1014.2 +046700 ADD 1 TO WS-COUNTER. RW1014.2 +046800 MOVE LINE-COUNTER TO STORE-LINE-COUNTER. RW1014.2 +046900 GENERATE RW-FS1-GROUP. RW1014.2 +047000 IF LINE-COUNTER NOT EQUAL TO WS-COUNTER RW1014.2 +047100 ADD 1 TO LC-ERRORS. RW1014.2 +047200* RW1014.2 +047300* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1014.2 +047400* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1014.2 +047500* PRESENTED. RW1014.2 +047600* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1014.2 +047700* RW1014.2 +047800 IF PAGE-COUNTER NOT EQUAL TO 1 RW1014.2 +047900 ADD 1 TO PC-ERRORS. RW1014.2 +048000* RW1014.2 +048100* EXECUTION OF THE GENERATE STATEMENT SHOULD NOT CHANGE RW1014.2 +048200* THE VALUE OF PAGE-COUNTER. IT SHOULD STILL BE EQUAL TO ONE. RW1014.2 +048300* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES. RW1014.2 +048400* RW1014.2 +048500 GENER-TEST-04. RW1014.2 +048600 IF PC-ERRORS EQUAL TO ZERO RW1014.2 +048700 PERFORM PASS RW1014.2 +048800 GO TO GENER-WRITE-04. RW1014.2 +048900 GENER-FAIL-04. RW1014.2 +049000 PERFORM FAIL. RW1014.2 +049100 MOVE PC-ERRORS TO COMPUTED-18V0. RW1014.2 +049200 MOVE ZERO TO CORRECT-18V0. RW1014.2 +049300 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1014.2 +049400 GENER-WRITE-04. RW1014.2 +049500 MOVE "GENER-TEST-4" TO PAR-NAME. RW1014.2 +049600 PERFORM PRINT-DETAIL. RW1014.2 +049700 GENER-INIT-05. RW1014.2 +049800* THIS TEST GENERATES THE 20TH PRINT LINE ON THE REPORT RW1014.2 +049900* PAGE. THE NUMBER OF LINES PER PAGE WAS SPECIFIED TO BE 20. RW1014.2 +050000* RW1014.2 +050100 ADD 1 TO WS-COUNTER. RW1014.2 +050200 MOVE LINE-COUNTER TO STORE-LINE-COUNTER. RW1014.2 +050300 GENERATE RW-FS1-GROUP. RW1014.2 +050400* RW1014.2 +050500* AFTER EXECUTION OF THE GENERATE STATEMENT LINE-COUNTER RW1014.2 +050600* SHOULD EQUAL 20 AND PAGE-COUNTER SHOULD EQUAL ONE. RW1014.2 +050700* RW1014.2 +050800 GENER-TEST-05. RW1014.2 +050900 IF LINE-COUNTER NOT EQUAL TO 20 RW1014.2 +051000 GO TO GENER-FAIL-05. RW1014.2 +051100 GENER-PASS-05. RW1014.2 +051200 PERFORM PASS. RW1014.2 +051300 GO TO GENER-WRITE-05. RW1014.2 +051400 GENER-FAIL-05. RW1014.2 +051500 PERFORM FAIL. RW1014.2 +051600 MOVE 20 TO CORRECT-18V0. RW1014.2 +051700 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1014.2 +051800 MOVE "LINE-COUNTER AFTER LAST GENER" TO RE-MARK. RW1014.2 +051900 GENER-WRITE-05. RW1014.2 +052000 MOVE "GENER-TEST-5" TO PAR-NAME. RW1014.2 +052100 MOVE "LAST GENERATE" TO FEATURE. RW1014.2 +052200 PERFORM PRINT-DETAIL. RW1014.2 +052300 GENER-TEST-06. RW1014.2 +052400 IF PAGE-COUNTER NOT EQUAL TO 1 RW1014.2 +052500 GO TO GENER-FAIL-06. RW1014.2 +052600 GENER-PASS-06. RW1014.2 +052700 PERFORM PASS. RW1014.2 +052800 GO TO GENER-WRITE-06. RW1014.2 +052900 GENER-FAIL-06. RW1014.2 +053000 PERFORM FAIL. RW1014.2 +053100 MOVE 1 TO CORRECT-18V0. RW1014.2 +053200 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1014.2 +053300 MOVE "PAGE-COUNTER AFTER LAST GENER" TO RE-MARK. RW1014.2 +053400 GENER-WRITE-06. RW1014.2 +053500 MOVE "GENER-TEST-6" TO PAR-NAME. RW1014.2 +053600 PERFORM PRINT-DETAIL. RW1014.2 +053700 TERM-TEST-STATE. RW1014.2 +053800 TERMINATE RW-FS1-REPORT-1. RW1014.2 +053900 CLOSE-RW-FS1. RW1014.2 +054000 CLOSE RW-FS1. RW1014.2 +054100 TERM-WRITE-01. RW1014.2 +054200 MOVE "TERMINATE REPORT" TO FEATURE. RW1014.2 +054300 MOVE "TERM-TEST-01" TO PAR-NAME. RW1014.2 +054400 MOVE "1 PAGE REPORT" TO COMPUTED-A. RW1014.2 +054500 MOVE "20 LINES PER PAGE" TO CORRECT-A. RW1014.2 +054600 MOVE "CHECK RWCS OUTPUT REPORT" TO RE-MARK. RW1014.2 +054700 PERFORM PRINT-DETAIL. RW1014.2 +054800 EXIT-RW101. RW1014.2 +054900 EXIT. RW1014.2 +055000 CCVS-EXIT SECTION. RW1014.2 +055100 CCVS-999999. RW1014.2 +055200 GO TO CLOSE-FILES. RW1014.2 +*END-OF,RW101A +*HEADER,COBOL,RW102A +000100 IDENTIFICATION DIVISION. RW1024.2 +000200 PROGRAM-ID. RW1024.2 +000300 RW102A. RW1024.2 +000400 AUTHOR. RW1024.2 +000500 FEDERAL COMPILER TESTING CENTER. RW1024.2 +000600 INSTALLATION. RW1024.2 +000700 GENERAL SERVICES ADMINISTRATION RW1024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. RW1024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. RW1024.2 +001000 5203 LEESBURG PIKE SUITE 1100 RW1024.2 +001100 FALLS CHURCH VIRGINIA 22041. RW1024.2 +001200 RW1024.2 +001300 PHONE (703) 756-6153 RW1024.2 +001400 RW1024.2 +001500 " HIGH ". RW1024.2 +001600 DATE-WRITTEN. RW1024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. RW1024.2 +001800 CREATION DATE / VALIDATION DATE RW1024.2 +001900 "4.2 ". RW1024.2 +002000 SECURITY. RW1024.2 +002100 NONE. RW1024.2 +002200******************************************************************RW1024.2 +002300* RW1024.2 +002400* THE ROUTINE RW102A TESTS BASIC REPORT WRITER MODULE RW1024.2 +002500* FUNCTIONS. A SINGLE OUTPUT REPORT IS PRODUCED BY THE RWCS. RW1024.2 +002600* THE REPORT DESCRIPTION IN THIS ROUTINE CONTAINS RW1024.2 +002700* PAGE LIMIT 20 RW1024.2 +002800* FIRST DETAIL 1, LAST DETAIL 20 RW1024.2 +002900* WITHOUT THE OPTIONAL HEADING OR FOOTING PHRASES. THE RW1024.2 +003000* ASSUMED VALUES FOR THESE PHRASES ARE RW1024.2 +003100* HEADING - VALUE OF 1, RW1024.2 +003200* FOOTING - VALUE OF 20. RW1024.2 +003300* A SINGLE DETAIL REPORT GROUP WITH 5 FORMAT 3 ENTRIES RW1024.2 +003400* SUBORDINATE TO THE FORMAT 1 ENTRY IS DEFINED FOR THE REPORT. RW1024.2 +003500* RW1024.2 +003600* THE PRODECURE DIVISION FOR RW102 IS ESSENTIALLY THE SAME RW1024.2 +003700* AS THE PROCEDURE DIVISION FOR RW101. THE STATEMENTS WHICH RW1024.2 +003800* MOVE LINE-COUNTER TO THE WORKING-STORAGE RECORD AREA ARE RW1024.2 +003900* NOT INCLUDED SINCE LINE-COUNTER IS REFERENCED IN A SOURCE RW1024.2 +004000* CLAUSE. RW1024.2 +004100* RW1024.2 +004200* THE OUTPUT OF THIS ROUTINE CONSISTS OF AN OUTPUT REPORT RW1024.2 +004300* IN THE USUAL AUDIT ROUTINE FORMAT PRODUCED USING WRITE RW1024.2 +004400* STATEMENTS AND A REPORT PRODUCED BY THE RWCS. BOTH REPORTS RW1024.2 +004500* MUST BE CAREFULLY EXAMINED TO VERIFY THAT THE TESTS IN RW1024.2 +004600* RW102 WERE EXECUTED CORRECTLY. RW1024.2 +004700* RW1024.2 +004800* THE OUTPUT REPORT GENERATED BY THE RWCS CONSISTS OF RW1024.2 +004900* 20 LINES. ON THE OUTPUT REPORT, THE WORKING-STORAGE LINE RW1024.2 +005000* COUNT AND LINE-COUNTER ARE EQUAL TO THE LINE NUMBER ON RW1024.2 +005100* WHICH THE LINE IS DISPLAYED. RW1024.2 +005200* RW1024.2 +005300******************************************************************RW1024.2 +005400* RW1024.2 +005500* REFERENCE AMERICAN NATIONAL STANDARD PROGRAMMING RW1024.2 +005600* LANGUAGE COBOL, X3.23-1974 RW1024.2 +005700* SECTION VIII - REPORT WRITER MODULE RW1024.2 +005800* RW1024.2 +005900******************************************************************RW1024.2 +006000 ENVIRONMENT DIVISION. RW1024.2 +006100 CONFIGURATION SECTION. RW1024.2 +006200 SOURCE-COMPUTER. RW1024.2 +006300 XXXXX082. RW1024.2 +006400 OBJECT-COMPUTER. RW1024.2 +006500 XXXXX083. RW1024.2 +006600 INPUT-OUTPUT SECTION. RW1024.2 +006700 FILE-CONTROL. RW1024.2 +006800 SELECT PRINT-FILE ASSIGN TO RW1024.2 +006900 XXXXX055. RW1024.2 +007000 SELECT RW-FS2 ASSIGN TO RW1024.2 +007100 XXXXX049. RW1024.2 +007200 DATA DIVISION. RW1024.2 +007300 FILE SECTION. RW1024.2 +007400 FD PRINT-FILE RW1024.2 +007500 LABEL RECORDS RW1024.2 +007600 XXXXX084 RW1024.2 +007700 DATA RECORD IS PRINT-REC DUMMY-RECORD. RW1024.2 +007800 01 PRINT-REC PICTURE X(120). RW1024.2 +007900 01 DUMMY-RECORD PICTURE X(120). RW1024.2 +008000 FD RW-FS2 RW1024.2 +008100 LABEL RECORDS ARE STANDARD RW1024.2 +008200C VALUE OF RW1024.2 +008300C XXXXX074 RW1024.2 +008400C IS RW1024.2 +008500C XXXXX075 RW1024.2 +008600G XXXXX069 RW1024.2 +008700 REPORT RW-FS2-REPORT-1. RW1024.2 +008800 WORKING-STORAGE SECTION. RW1024.2 +008900 01 LC-ERRORS PIC 99 VALUE 0. RW1024.2 +009000 01 PC-ERRORS PIC 99 VALUE 0. RW1024.2 +009100 01 WS-COUNTER PIC 9(6) VALUE ZERO. RW1024.2 +009200 01 TEST-RESULTS. RW1024.2 +009300 02 FILLER PICTURE X VALUE SPACE. RW1024.2 +009400 02 FEATURE PICTURE X(20) VALUE SPACE. RW1024.2 +009500 02 FILLER PICTURE X VALUE SPACE. RW1024.2 +009600 02 P-OR-F PICTURE X(5) VALUE SPACE. RW1024.2 +009700 02 FILLER PICTURE X VALUE SPACE. RW1024.2 +009800 02 PAR-NAME. RW1024.2 +009900 03 FILLER PICTURE X(12) VALUE SPACE. RW1024.2 +010000 03 PARDOT-X PICTURE X VALUE SPACE. RW1024.2 +010100 03 DOTVALUE PICTURE 99 VALUE ZERO. RW1024.2 +010200 03 FILLER PIC X(5) VALUE SPACE. RW1024.2 +010300 02 FILLER PIC X(10) VALUE SPACE. RW1024.2 +010400 02 RE-MARK PIC X(61). RW1024.2 +010500 01 TEST-COMPUTED. RW1024.2 +010600 02 FILLER PIC X(30) VALUE SPACE. RW1024.2 +010700 02 FILLER PIC X(17) VALUE " COMPUTED=". RW1024.2 +010800 02 COMPUTED-X. RW1024.2 +010900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. RW1024.2 +011000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). RW1024.2 +011100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). RW1024.2 +011200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). RW1024.2 +011300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). RW1024.2 +011400 03 CM-18V0 REDEFINES COMPUTED-A. RW1024.2 +011500 04 COMPUTED-18V0 PICTURE -9(18). RW1024.2 +011600 04 FILLER PICTURE X. RW1024.2 +011700 03 FILLER PIC X(50) VALUE SPACE. RW1024.2 +011800 01 TEST-CORRECT. RW1024.2 +011900 02 FILLER PIC X(30) VALUE SPACE. RW1024.2 +012000 02 FILLER PIC X(17) VALUE " CORRECT =". RW1024.2 +012100 02 CORRECT-X. RW1024.2 +012200 03 CORRECT-A PICTURE X(20) VALUE SPACE. RW1024.2 +012300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). RW1024.2 +012400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). RW1024.2 +012500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). RW1024.2 +012600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). RW1024.2 +012700 03 CR-18V0 REDEFINES CORRECT-A. RW1024.2 +012800 04 CORRECT-18V0 PICTURE -9(18). RW1024.2 +012900 04 FILLER PICTURE X. RW1024.2 +013000 03 FILLER PIC X(50) VALUE SPACE. RW1024.2 +013100 01 CCVS-C-1. RW1024.2 +013200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PARW1024.2 +013300- "SS PARAGRAPH-NAME RW1024.2 +013400- " REMARKS". RW1024.2 +013500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. RW1024.2 +013600 01 CCVS-C-2. RW1024.2 +013700 02 FILLER PICTURE IS X VALUE IS SPACE. RW1024.2 +013800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". RW1024.2 +013900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. RW1024.2 +014000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". RW1024.2 +014100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. RW1024.2 +014200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. RW1024.2 +014300 01 REC-CT PICTURE 99 VALUE ZERO. RW1024.2 +014400 01 DELETE-CNT PICTURE 999 VALUE ZERO. RW1024.2 +014500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. RW1024.2 +014600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RW1024.2 +014700 01 PASS-COUNTER PIC 999 VALUE ZERO. RW1024.2 +014800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RW1024.2 +014900 01 ERROR-HOLD PIC 999 VALUE ZERO. RW1024.2 +015000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RW1024.2 +015100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RW1024.2 +015200 01 CCVS-H-1. RW1024.2 +015300 02 FILLER PICTURE X(27) VALUE SPACE. RW1024.2 +015400 02 FILLER PICTURE X(67) VALUE RW1024.2 +015500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION RW1024.2 +015600- " SYSTEM". RW1024.2 +015700 02 FILLER PICTURE X(26) VALUE SPACE. RW1024.2 +015800 01 CCVS-H-2. RW1024.2 +015900 02 FILLER PICTURE X(52) VALUE IS RW1024.2 +016000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". RW1024.2 +016100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". RW1024.2 +016200 02 TEST-ID PICTURE IS X(9). RW1024.2 +016300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. RW1024.2 +016400 01 CCVS-H-3. RW1024.2 +016500 02 FILLER PICTURE X(34) VALUE RW1024.2 +016600 " FOR OFFICIAL USE ONLY ". RW1024.2 +016700 02 FILLER PICTURE X(58) VALUE RW1024.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RW1024.2 +016900 02 FILLER PICTURE X(28) VALUE RW1024.2 +017000 " COPYRIGHT 1974 ". RW1024.2 +017100 01 CCVS-E-1. RW1024.2 +017200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. RW1024.2 +017300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". RW1024.2 +017400 02 ID-AGAIN PICTURE IS X(9). RW1024.2 +017500 02 FILLER PICTURE X(45) VALUE IS RW1024.2 +017600 " NTIS DISTRIBUTION COBOL 74". RW1024.2 +017700 01 CCVS-E-2. RW1024.2 +017800 02 FILLER PICTURE X(31) VALUE RW1024.2 +017900 SPACE. RW1024.2 +018000 02 FILLER PICTURE X(21) VALUE SPACE. RW1024.2 +018100 02 CCVS-E-2-2. RW1024.2 +018200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. RW1024.2 +018300 03 FILLER PICTURE IS X VALUE IS SPACE. RW1024.2 +018400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". RW1024.2 +018500 01 CCVS-E-3. RW1024.2 +018600 02 FILLER PICTURE X(22) VALUE RW1024.2 +018700 " FOR OFFICIAL USE ONLY". RW1024.2 +018800 02 FILLER PICTURE X(12) VALUE SPACE. RW1024.2 +018900 02 FILLER PICTURE X(58) VALUE RW1024.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RW1024.2 +019100 02 FILLER PICTURE X(13) VALUE SPACE. RW1024.2 +019200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". RW1024.2 +019300 01 CCVS-E-4. RW1024.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RW1024.2 +019500 02 FILLER PIC XXXX VALUE " OF ". RW1024.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RW1024.2 +019700 02 FILLER PIC X(40) VALUE RW1024.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". RW1024.2 +019900 01 XXINFO. RW1024.2 +020000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". RW1024.2 +020100 02 INFO-TEXT. RW1024.2 +020200 04 FILLER PIC X(20) VALUE SPACE. RW1024.2 +020300 04 XXCOMPUTED PIC X(20). RW1024.2 +020400 04 FILLER PIC X(5) VALUE SPACE. RW1024.2 +020500 04 XXCORRECT PIC X(20). RW1024.2 +020600 01 HYPHEN-LINE. RW1024.2 +020700 02 FILLER PICTURE IS X VALUE IS SPACE. RW1024.2 +020800 02 FILLER PICTURE IS X(65) VALUE IS "************************RW1024.2 +020900- "*****************************************". RW1024.2 +021000 02 FILLER PICTURE IS X(54) VALUE IS "************************RW1024.2 +021100- "******************************". RW1024.2 +021200 01 CCVS-PGM-ID PIC X(6) VALUE RW1024.2 +021300 "RW102A". RW1024.2 +021400 REPORT SECTION. RW1024.2 +021500 RD RW-FS2-REPORT-1 RW1024.2 +021600 PAGE LIMIT 20 RW1024.2 +021700 FIRST DETAIL 1 RW1024.2 +021800 LAST DETAIL 20. RW1024.2 +021900 01 RW-FS2-GROUP RW1024.2 +022000 LINE NUMBER IS PLUS 1 RW1024.2 +022100 TYPE IS DETAIL. RW1024.2 +022200 03 COLUMN 5 PIC X(18) RW1024.2 +022300 VALUE IS "RW-FS2 DETAIL LINE". RW1024.2 +022400 03 COLUMN 26 PIC X(31) RW1024.2 +022500 VALUE "WORKING-STORAGE LINE COUNTER = ". RW1024.2 +022600 03 COLUMN 57 PIC 9(3) SOURCE IS WS-COUNTER. RW1024.2 +022700 03 COLUMN 62 PIC X(20) RW1024.2 +022800 VALUE "RWCS LINE-COUNTER = ". RW1024.2 +022900 03 COLUMN NUMBER IS 83 PIC 9(4) RW1024.2 +023000 SOURCE IS LINE-COUNTER. RW1024.2 +023100 PROCEDURE DIVISION. RW1024.2 +023200 CCVS1 SECTION. RW1024.2 +023300 OPEN-FILES. RW1024.2 +023400 OPEN OUTPUT PRINT-FILE. RW1024.2 +023500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RW1024.2 +023600 MOVE SPACE TO TEST-RESULTS. RW1024.2 +023700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RW1024.2 +023800 GO TO CCVS1-EXIT. RW1024.2 +023900 CLOSE-FILES. RW1024.2 +024000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RW1024.2 +024100 TERMINATE-CCVS. RW1024.2 +024200S EXIT PROGRAM. RW1024.2 +024300STERMINATE-CALL. RW1024.2 +024400 STOP RUN. RW1024.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RW1024.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RW1024.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RW1024.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. RW1024.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. RW1024.2 +025000 PRINT-DETAIL. RW1024.2 +025100 IF REC-CT NOT EQUAL TO ZERO RW1024.2 +025200 MOVE "." TO PARDOT-X RW1024.2 +025300 MOVE REC-CT TO DOTVALUE. RW1024.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RW1024.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RW1024.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RW1024.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RW1024.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RW1024.2 +025900 MOVE SPACE TO CORRECT-X. RW1024.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RW1024.2 +026100 MOVE SPACE TO RE-MARK. RW1024.2 +026200 HEAD-ROUTINE. RW1024.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1024.2 +026400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. RW1024.2 +026500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RW1024.2 +026600 COLUMN-NAMES-ROUTINE. RW1024.2 +026700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1024.2 +026800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1024.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1024.2 +027000 END-ROUTINE. RW1024.2 +027100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RW1024.2 +027200 END-RTN-EXIT. RW1024.2 +027300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1024.2 +027400 END-ROUTINE-1. RW1024.2 +027500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RW1024.2 +027600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. RW1024.2 +027700 ADD PASS-COUNTER TO ERROR-HOLD. RW1024.2 +027800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RW1024.2 +027900 MOVE PASS-COUNTER TO CCVS-E-4-1. RW1024.2 +028000 MOVE ERROR-HOLD TO CCVS-E-4-2. RW1024.2 +028100 MOVE CCVS-E-4 TO CCVS-E-2-2. RW1024.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RW1024.2 +028300 END-ROUTINE-12. RW1024.2 +028400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RW1024.2 +028500 IF ERROR-COUNTER IS EQUAL TO ZERO RW1024.2 +028600 MOVE "NO " TO ERROR-TOTAL RW1024.2 +028700 ELSE RW1024.2 +028800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RW1024.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. RW1024.2 +029000 PERFORM WRITE-LINE. RW1024.2 +029100 END-ROUTINE-13. RW1024.2 +029200 IF DELETE-CNT IS EQUAL TO ZERO RW1024.2 +029300 MOVE "NO " TO ERROR-TOTAL ELSE RW1024.2 +029400 MOVE DELETE-CNT TO ERROR-TOTAL. RW1024.2 +029500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RW1024.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1024.2 +029700 IF INSPECT-COUNTER EQUAL TO ZERO RW1024.2 +029800 MOVE "NO " TO ERROR-TOTAL RW1024.2 +029900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RW1024.2 +030000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RW1024.2 +030100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1024.2 +030200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1024.2 +030300 WRITE-LINE. RW1024.2 +030400 ADD 1 TO RECORD-COUNT. RW1024.2 +030500Y IF RECORD-COUNT GREATER 50 RW1024.2 +030600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RW1024.2 +030700Y MOVE SPACE TO DUMMY-RECORD RW1024.2 +030800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RW1024.2 +030900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RW1024.2 +031000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RW1024.2 +031100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RW1024.2 +031200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RW1024.2 +031300Y MOVE ZERO TO RECORD-COUNT. RW1024.2 +031400 PERFORM WRT-LN. RW1024.2 +031500 WRT-LN. RW1024.2 +031600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RW1024.2 +031700 MOVE SPACE TO DUMMY-RECORD. RW1024.2 +031800 BLANK-LINE-PRINT. RW1024.2 +031900 PERFORM WRT-LN. RW1024.2 +032000 FAIL-ROUTINE. RW1024.2 +032100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1024.2 +032200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1024.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RW1024.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1024.2 +032500 GO TO FAIL-ROUTINE-EX. RW1024.2 +032600 FAIL-ROUTINE-WRITE. RW1024.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RW1024.2 +032800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RW1024.2 +032900 FAIL-ROUTINE-EX. EXIT. RW1024.2 +033000 BAIL-OUT. RW1024.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RW1024.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RW1024.2 +033300 BAIL-OUT-WRITE. RW1024.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RW1024.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1024.2 +033600 BAIL-OUT-EX. EXIT. RW1024.2 +033700 CCVS1-EXIT. RW1024.2 +033800 EXIT. RW1024.2 +033900 SECT-RW102-0001 SECTION. RW1024.2 +034000 RW102-INIT. RW1024.2 +034100 OPEN OUTPUT RW-FS2. RW1024.2 +034200 INIT-TEST-03. RW1024.2 +034300 INITIATE RW-FS2-REPORT-1. RW1024.2 +034400* RW1024.2 +034500* AFTER EXECUTION OF THE INITIATE STATEMENT FOR A REPORT, RW1024.2 +034600* THE REPORT LINE-COUNTER SHOULD BE ZERO AND PAGE-COUNTER RW1024.2 +034700* SHOULD BE ONE. RW1024.2 +034800* REFERENCE PAGE VIII-53, 3.2.4(1)B AND C, INITIATE STATEMENTRW1024.2 +034900* RW1024.2 +035000 INIT-TEST-03-01. RW1024.2 +035100 IF LINE-COUNTER EQUAL TO ZERO RW1024.2 +035200 PERFORM PASS RW1024.2 +035300 GO TO INIT-WRITE-03-01. RW1024.2 +035400 INIT-FAIL-03-01. RW1024.2 +035500 PERFORM FAIL. RW1024.2 +035600 MOVE ZERO TO CORRECT-18V0. RW1024.2 +035700 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1024.2 +035800 MOVE "LINE-COUNTER AFTER INITIATE" TO RE-MARK. RW1024.2 +035900 INIT-WRITE-03-01. RW1024.2 +036000 MOVE "INIT-TEST-03" TO PAR-NAME. RW1024.2 +036100 MOVE 1 TO REC-CT. RW1024.2 +036200 MOVE "INITIATE REPORT" TO FEATURE. RW1024.2 +036300 PERFORM PRINT-DETAIL. RW1024.2 +036400 INIT-TEST-03-02. RW1024.2 +036500 IF PAGE-COUNTER EQUAL TO 1 RW1024.2 +036600 PERFORM PASS RW1024.2 +036700 GO TO INIT-WRITE-03-02. RW1024.2 +036800 INIT-FAIL-03-02. RW1024.2 +036900 PERFORM FAIL. RW1024.2 +037000 MOVE 1 TO CORRECT-18V0. RW1024.2 +037100 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1024.2 +037200 MOVE "PAGE-COUNTER AFTER INITIATE" TO RE-MARK. RW1024.2 +037300 INIT-WRITE-03-02. RW1024.2 +037400 MOVE 2 TO REC-CT. RW1024.2 +037500 PERFORM PRINT-DETAIL. RW1024.2 +037600 GENER-TEST-07. RW1024.2 +037700* RW1024.2 +037800* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1024.2 +037900* REPORT GROUP 20 TIMES. RW1024.2 +038000* REFERENCE PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1024.2 +038100* RW1024.2 +038200 PERFORM GENER-DETAIL-LINE 20 TIMES. RW1024.2 +038300* RW1024.2 +038400* OUTPUT REPORT INFO RW1024.2 +038500* TWENTY DETAIL LINES SINGLE SPACED SHOULD BE PRESENTED RW1024.2 +038600* ON LINES 1 THROUGH 20 OF THE FIRST REPORT PAGE. RW1024.2 +038700* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULES RW1024.2 +038800* RW1024.2 +038900 GENER-TEST-07-01. RW1024.2 +039000 IF LC-ERRORS EQUAL TO ZERO RW1024.2 +039100 PERFORM PASS RW1024.2 +039200 GO TO GENER-WRITE-07-01. RW1024.2 +039300 GENER-FAIL-07-01. RW1024.2 +039400 PERFORM FAIL. RW1024.2 +039500 MOVE LC-ERRORS TO COMPUTED-18V0. RW1024.2 +039600 MOVE ZERO TO CORRECT-18V0. RW1024.2 +039700 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1024.2 +039800 GENER-WRITE-07-01. RW1024.2 +039900 MOVE "GENER-TEST-7" TO PAR-NAME. RW1024.2 +040000 MOVE "GENERATE 20 LINES" TO FEATURE. RW1024.2 +040100 MOVE 1 TO REC-CT. RW1024.2 +040200 PERFORM PRINT-DETAIL. RW1024.2 +040300 GO TO GENER-TEST-07-02. RW1024.2 +040400 GENER-DETAIL-LINE. RW1024.2 +040500 ADD 1 TO WS-COUNTER. RW1024.2 +040600 GENERATE RW-FS2-GROUP. RW1024.2 +040700 IF LINE-COUNTER NOT EQUAL TO WS-COUNTER RW1024.2 +040800 ADD 1 TO LC-ERRORS. RW1024.2 +040900* RW1024.2 +041000* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1024.2 +041100* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1024.2 +041200* PRESENTED. RW1024.2 +041300* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1024.2 +041400* RW1024.2 +041500 IF PAGE-COUNTER NOT EQUAL TO 1 RW1024.2 +041600 ADD 1 TO PC-ERRORS. RW1024.2 +041700* RW1024.2 +041800* EXECUTION OF THE GENERATE STATEMENT SHOULD NOT CHANGE RW1024.2 +041900* THE VALUE OF PAGE-COUNTER. IT SHOULD STILL BE EQUAL TO ONE. RW1024.2 +042000* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES. RW1024.2 +042100* RW1024.2 +042200 GENER-TEST-07-02. RW1024.2 +042300 IF PC-ERRORS EQUAL TO ZERO RW1024.2 +042400 PERFORM PASS RW1024.2 +042500 GO TO GENER-WRITE-07-02. RW1024.2 +042600 GENER-FAIL-07-02. RW1024.2 +042700 PERFORM FAIL. RW1024.2 +042800 MOVE PC-ERRORS TO COMPUTED-18V0. RW1024.2 +042900 MOVE ZERO TO CORRECT-18V0. RW1024.2 +043000 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1024.2 +043100 GENER-WRITE-07-02. RW1024.2 +043200 MOVE 2 TO REC-CT. RW1024.2 +043300 PERFORM PRINT-DETAIL. RW1024.2 +043400 TERM-TEST-STATE. RW1024.2 +043500 TERMINATE RW-FS2-REPORT-1. RW1024.2 +043600 CLOSE-RW-FS2. RW1024.2 +043700 CLOSE RW-FS2. RW1024.2 +043800 TERM-WRITE-02. RW1024.2 +043900 MOVE ZERO TO REC-CT. RW1024.2 +044000 MOVE "TERMINATE REPORT" TO FEATURE. RW1024.2 +044100 MOVE "TERM-TEST-02" TO PAR-NAME. RW1024.2 +044200 MOVE "1 PAGE REPORT" TO COMPUTED-A. RW1024.2 +044300 MOVE "20 LINES PER PAGE" TO CORRECT-A. RW1024.2 +044400 MOVE "CHECK RWCS OUTPUT REPORT" TO RE-MARK. RW1024.2 +044500 PERFORM PRINT-DETAIL. RW1024.2 +044600 EXIT-RW102. RW1024.2 +044700 EXIT. RW1024.2 +044800 CCVS-EXIT SECTION. RW1024.2 +044900 CCVS-999999. RW1024.2 +045000 GO TO CLOSE-FILES. RW1024.2 +*END-OF,RW102A +*HEADER,COBOL,RW103A +000100 IDENTIFICATION DIVISION. RW1034.2 +000200 PROGRAM-ID. RW1034.2 +000300 RW103A. RW1034.2 +000400 AUTHOR. RW1034.2 +000500 FEDERAL COMPILER TESTING CENTER. RW1034.2 +000600 INSTALLATION. RW1034.2 +000700 GENERAL SERVICES ADMINISTRATION RW1034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. RW1034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. RW1034.2 +001000 5203 LEESBURG PIKE SUITE 1100 RW1034.2 +001100 FALLS CHURCH VIRGINIA 22041. RW1034.2 +001200 RW1034.2 +001300 PHONE (703) 756-6153 RW1034.2 +001400 RW1034.2 +001500 " HIGH ". RW1034.2 +001600 DATE-WRITTEN. RW1034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. RW1034.2 +001800 CREATION DATE / VALIDATION DATE RW1034.2 +001900 "4.2 ". RW1034.2 +002000 SECURITY. RW1034.2 +002100 NONE. RW1034.2 +002200******************************************************************RW1034.2 +002300* RW1034.2 +002400* THE ROUTINE RW103A TESTS BASIC REPORT WRITER MODULE RW1034.2 +002500* FUNCTIONS. ONE OUTPUT REPORT IS PRODUCED BY THE RWCS. RW1034.2 +002600* THE REPORT DESCRIPTION IN THIS ROUTINE CONTAINS RW1034.2 +002700* PAGE 30 RW1034.2 +002800* HEADING 1 RW1034.2 +002900* FIRST DETAIL 6 RW1034.2 +003000* LAST DETAIL 25 RW1034.2 +003100* WITHOUT THE OPTIONAL FOOTING PHRASE. THE ASSUMED VALUE RW1034.2 +003200* FOR THE FOOTING PHRASE IS RW1034.2 +003300* FOOTING - VALUE OF 25. RW1034.2 +003400* THERE IS A PAGE HEADING REPORT GROUP AND A DETAIL REPORT RW1034.2 +003500* GROUP DEFINED FOR THE REPORT. RW1034.2 +003600* RW1034.2 +003700* THE PROCEDURE DIVISION FOR RW103A RW1034.2 +003800* OPENS THE SEQUENTIAL FILE RW-FS3, RW1034.2 +003900* INITIATES THE REPORT RW-FS3-REPORT-1, RW1034.2 +004000* CHECKS THE VALUES IN LINE-COUNTER AND PAGE-COUNTER RW1034.2 +004100* AFTER EXECUTING THE INITIATE STATEMENT, RW1034.2 +004200* GENERATES A THREE PAGE REPORT WITH GENERATE DATA- RW1034.2 +004300* NAME STATEMENTS, RW1034.2 +004400* CHECKS THE VALUES IN LINE-COUNTER AND PAGE-COUNTER RW1034.2 +004500* AFTER EACH GENERATE STATEMENT, RW1034.2 +004600* CHECKS THAT LINE-COUNTER AND PAGE-COUNTER ARE RESET RW1034.2 +004700* WHEN PAGE ADVANCING PROCESSING HAS OCCURRED, RW1034.2 +004800* TERMINATES THE REPORT RW-FS3-REPORT-1, RW1034.2 +004900* CLOSES THE REPORT FILE RW-FS3. RW1034.2 +005000* RW1034.2 +005100* THE OUTPUT OF THIS ROUTINE CONSISTS OF AN OUTPUT REPORT RW1034.2 +005200* IN THE USUAL AUDIT ROUTINE FORMAT PRODUCED USING WRITE RW1034.2 +005300* STATEMENTS AND A REPORT PRODUCED BY THE RWCS. BOTH REPORTS RW1034.2 +005400* MUST BE CAREFULLY EXAMINED TO VERIFY THAT THE TESTS IN RW1034.2 +005500* RW103 WERE EXECUTED CORRECTLY. RW1034.2 +005600* RW1034.2 +005700* THE OUTPUT REPORT GENERATED BY THE RWCS CONSISTS OF RW1034.2 +005800* THREE PAGES WITH EACH PAGE CONTAINING A SINGLE PAGE HEADING RW1034.2 +005900* ON LINE 1 AND TWENTY DETAIL LINES ON LINES 6 THROUGH 25. RW1034.2 +006000* LINES 2 THROUGH 5 AND 26 THROUGH 30 SHOULD BE BLANK. RW1034.2 +006100* RW1034.2 +006200* THE VALUE OF LINE-COUNTER IN THE DETAIL LINE IS FIVE RW1034.2 +006300* GREATER THAN THE DETAIL LINE NUMBER, AND PAGE-COUNTER IS RW1034.2 +006400* EQUAL TO THE PAGE ON WHICH THE DETAIL LINE IS PRESENTED. RW1034.2 +006500* RW1034.2 +006600******************************************************************RW1034.2 +006700* RW1034.2 +006800* REFERENCE AMERICAN NATIONAL STANDARD PROGRAMMING RW1034.2 +006900* LANGUAGE COBOL, X3.23-1974 RW1034.2 +007000* SECTION VIII - REPORT WRITER MODULE RW1034.2 +007100* RW1034.2 +007200******************************************************************RW1034.2 +007300 ENVIRONMENT DIVISION. RW1034.2 +007400 CONFIGURATION SECTION. RW1034.2 +007500 SOURCE-COMPUTER. RW1034.2 +007600 XXXXX082. RW1034.2 +007700 OBJECT-COMPUTER. RW1034.2 +007800 XXXXX083. RW1034.2 +007900 INPUT-OUTPUT SECTION. RW1034.2 +008000 FILE-CONTROL. RW1034.2 +008100 SELECT PRINT-FILE ASSIGN TO RW1034.2 +008200 XXXXX055. RW1034.2 +008300 SELECT RW-FS3 ASSIGN TO RW1034.2 +008400 XXXXX049. RW1034.2 +008500 DATA DIVISION. RW1034.2 +008600 FILE SECTION. RW1034.2 +008700 FD PRINT-FILE RW1034.2 +008800 LABEL RECORDS RW1034.2 +008900 XXXXX084 RW1034.2 +009000 DATA RECORD IS PRINT-REC DUMMY-RECORD. RW1034.2 +009100 01 PRINT-REC PICTURE X(120). RW1034.2 +009200 01 DUMMY-RECORD PICTURE X(120). RW1034.2 +009300 FD RW-FS3 RW1034.2 +009400 LABEL RECORDS ARE STANDARD RW1034.2 +009500C VALUE OF RW1034.2 +009600C XXXXX074 RW1034.2 +009700C IS RW1034.2 +009800C XXXXX075 RW1034.2 +009900G XXXXX069 RW1034.2 +010000 REPORT IS RW-FS3-REPORT-1. RW1034.2 +010100 WORKING-STORAGE SECTION. RW1034.2 +010200 01 LC-ERRORS PIC 99 VALUE 0. RW1034.2 +010300 01 PC-ERRORS PIC 99 VALUE 0. RW1034.2 +010400 01 WS-COUNTER PIC 99 VALUE 0. RW1034.2 +010500 01 PAGENO PIC 99 VALUE 1. RW1034.2 +010600 01 TEMP-COMP PIC 99. RW1034.2 +010700 01 TEST-RESULTS. RW1034.2 +010800 02 FILLER PICTURE X VALUE SPACE. RW1034.2 +010900 02 FEATURE PICTURE X(20) VALUE SPACE. RW1034.2 +011000 02 FILLER PICTURE X VALUE SPACE. RW1034.2 +011100 02 P-OR-F PICTURE X(5) VALUE SPACE. RW1034.2 +011200 02 FILLER PICTURE X VALUE SPACE. RW1034.2 +011300 02 PAR-NAME. RW1034.2 +011400 03 FILLER PICTURE X(12) VALUE SPACE. RW1034.2 +011500 03 PARDOT-X PICTURE X VALUE SPACE. RW1034.2 +011600 03 DOTVALUE PICTURE 99 VALUE ZERO. RW1034.2 +011700 03 FILLER PIC X(5) VALUE SPACE. RW1034.2 +011800 02 FILLER PIC X(10) VALUE SPACE. RW1034.2 +011900 02 RE-MARK PIC X(61). RW1034.2 +012000 01 TEST-COMPUTED. RW1034.2 +012100 02 FILLER PIC X(30) VALUE SPACE. RW1034.2 +012200 02 FILLER PIC X(17) VALUE " COMPUTED=". RW1034.2 +012300 02 COMPUTED-X. RW1034.2 +012400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. RW1034.2 +012500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). RW1034.2 +012600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). RW1034.2 +012700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). RW1034.2 +012800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). RW1034.2 +012900 03 CM-18V0 REDEFINES COMPUTED-A. RW1034.2 +013000 04 COMPUTED-18V0 PICTURE -9(18). RW1034.2 +013100 04 FILLER PICTURE X. RW1034.2 +013200 03 FILLER PIC X(50) VALUE SPACE. RW1034.2 +013300 01 TEST-CORRECT. RW1034.2 +013400 02 FILLER PIC X(30) VALUE SPACE. RW1034.2 +013500 02 FILLER PIC X(17) VALUE " CORRECT =". RW1034.2 +013600 02 CORRECT-X. RW1034.2 +013700 03 CORRECT-A PICTURE X(20) VALUE SPACE. RW1034.2 +013800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). RW1034.2 +013900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). RW1034.2 +014000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). RW1034.2 +014100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). RW1034.2 +014200 03 CR-18V0 REDEFINES CORRECT-A. RW1034.2 +014300 04 CORRECT-18V0 PICTURE -9(18). RW1034.2 +014400 04 FILLER PICTURE X. RW1034.2 +014500 03 FILLER PIC X(50) VALUE SPACE. RW1034.2 +014600 01 CCVS-C-1. RW1034.2 +014700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PARW1034.2 +014800- "SS PARAGRAPH-NAME RW1034.2 +014900- " REMARKS". RW1034.2 +015000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. RW1034.2 +015100 01 CCVS-C-2. RW1034.2 +015200 02 FILLER PICTURE IS X VALUE IS SPACE. RW1034.2 +015300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". RW1034.2 +015400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. RW1034.2 +015500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". RW1034.2 +015600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. RW1034.2 +015700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. RW1034.2 +015800 01 REC-CT PICTURE 99 VALUE ZERO. RW1034.2 +015900 01 DELETE-CNT PICTURE 999 VALUE ZERO. RW1034.2 +016000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. RW1034.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RW1034.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. RW1034.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. RW1034.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. RW1034.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RW1034.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RW1034.2 +016700 01 CCVS-H-1. RW1034.2 +016800 02 FILLER PICTURE X(27) VALUE SPACE. RW1034.2 +016900 02 FILLER PICTURE X(67) VALUE RW1034.2 +017000 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION RW1034.2 +017100- " SYSTEM". RW1034.2 +017200 02 FILLER PICTURE X(26) VALUE SPACE. RW1034.2 +017300 01 CCVS-H-2. RW1034.2 +017400 02 FILLER PICTURE X(52) VALUE IS RW1034.2 +017500 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". RW1034.2 +017600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". RW1034.2 +017700 02 TEST-ID PICTURE IS X(9). RW1034.2 +017800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. RW1034.2 +017900 01 CCVS-H-3. RW1034.2 +018000 02 FILLER PICTURE X(34) VALUE RW1034.2 +018100 " FOR OFFICIAL USE ONLY ". RW1034.2 +018200 02 FILLER PICTURE X(58) VALUE RW1034.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RW1034.2 +018400 02 FILLER PICTURE X(28) VALUE RW1034.2 +018500 " COPYRIGHT 1974 ". RW1034.2 +018600 01 CCVS-E-1. RW1034.2 +018700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. RW1034.2 +018800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". RW1034.2 +018900 02 ID-AGAIN PICTURE IS X(9). RW1034.2 +019000 02 FILLER PICTURE X(45) VALUE IS RW1034.2 +019100 " NTIS DISTRIBUTION COBOL 74". RW1034.2 +019200 01 CCVS-E-2. RW1034.2 +019300 02 FILLER PICTURE X(31) VALUE RW1034.2 +019400 SPACE. RW1034.2 +019500 02 FILLER PICTURE X(21) VALUE SPACE. RW1034.2 +019600 02 CCVS-E-2-2. RW1034.2 +019700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. RW1034.2 +019800 03 FILLER PICTURE IS X VALUE IS SPACE. RW1034.2 +019900 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". RW1034.2 +020000 01 CCVS-E-3. RW1034.2 +020100 02 FILLER PICTURE X(22) VALUE RW1034.2 +020200 " FOR OFFICIAL USE ONLY". RW1034.2 +020300 02 FILLER PICTURE X(12) VALUE SPACE. RW1034.2 +020400 02 FILLER PICTURE X(58) VALUE RW1034.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RW1034.2 +020600 02 FILLER PICTURE X(13) VALUE SPACE. RW1034.2 +020700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". RW1034.2 +020800 01 CCVS-E-4. RW1034.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RW1034.2 +021000 02 FILLER PIC XXXX VALUE " OF ". RW1034.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RW1034.2 +021200 02 FILLER PIC X(40) VALUE RW1034.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". RW1034.2 +021400 01 XXINFO. RW1034.2 +021500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". RW1034.2 +021600 02 INFO-TEXT. RW1034.2 +021700 04 FILLER PIC X(20) VALUE SPACE. RW1034.2 +021800 04 XXCOMPUTED PIC X(20). RW1034.2 +021900 04 FILLER PIC X(5) VALUE SPACE. RW1034.2 +022000 04 XXCORRECT PIC X(20). RW1034.2 +022100 01 HYPHEN-LINE. RW1034.2 +022200 02 FILLER PICTURE IS X VALUE IS SPACE. RW1034.2 +022300 02 FILLER PICTURE IS X(65) VALUE IS "************************RW1034.2 +022400- "*****************************************". RW1034.2 +022500 02 FILLER PICTURE IS X(54) VALUE IS "************************RW1034.2 +022600- "******************************". RW1034.2 +022700 01 CCVS-PGM-ID PIC X(6) VALUE RW1034.2 +022800 "RW103A". RW1034.2 +022900 REPORT SECTION. RW1034.2 +023000 RD RW-FS3-REPORT-1 RW1034.2 +023100 PAGE 30 RW1034.2 +023200 HEADING 1 RW1034.2 +023300 FIRST DETAIL 6 RW1034.2 +023400 LAST DETAIL 25. RW1034.2 +023500 01 RW-FS3-HEADING RW1034.2 +023600 LINE 1 RW1034.2 +023700 TYPE IS PAGE HEADING. RW1034.2 +023800 03 PIC X(36) COLUMN 20 RW1034.2 +023900 VALUE "U.S. NAVY COBOL AUDIT ROUTINE RW103A". RW1034.2 +024000 03 PIC X(5) COLUMN 60 VALUE "LINE ". RW1034.2 +024100 03 PIC 9 COLUMN 65 SOURCE LINE-COUNTER. RW1034.2 +024200 03 COLUMN 70 PIC X(5) RW1034.2 +024300 VALUE "PAGE ". RW1034.2 +024400 03 COLUMN 75 PIC 9 RW1034.2 +024500 SOURCE PAGE-COUNTER. RW1034.2 +024600 01 RW-FS3-DETAIL RW1034.2 +024700 LINE PLUS 1 RW1034.2 +024800 TYPE IS DE. RW1034.2 +024900 03 PIC X(12) COLUMN 20 RW1034.2 +025000 VALUE "DETAIL LINE ". RW1034.2 +025100 03 PIC 99 COLUMN 32 RW1034.2 +025200 SOURCE IS WS-COUNTER. RW1034.2 +025300 03 PIC X(13) COLUMN 36 RW1034.2 +025400 VALUE "PAGE-COUNTER ". RW1034.2 +025500 03 PIC 9 COLUMN 49 RW1034.2 +025600 SOURCE PAGE-COUNTER. RW1034.2 +025700 03 PIC X(13) COLUMN 55 RW1034.2 +025800 VALUE "LINE-COUNTER ". RW1034.2 +025900 03 PIC 99 COLUMN IS 68 RW1034.2 +026000 SOURCE IS LINE-COUNTER. RW1034.2 +026100 PROCEDURE DIVISION. RW1034.2 +026200 CCVS1 SECTION. RW1034.2 +026300 OPEN-FILES. RW1034.2 +026400 OPEN OUTPUT PRINT-FILE. RW1034.2 +026500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RW1034.2 +026600 MOVE SPACE TO TEST-RESULTS. RW1034.2 +026700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RW1034.2 +026800 GO TO CCVS1-EXIT. RW1034.2 +026900 CLOSE-FILES. RW1034.2 +027000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RW1034.2 +027100 TERMINATE-CCVS. RW1034.2 +027200S EXIT PROGRAM. RW1034.2 +027300STERMINATE-CALL. RW1034.2 +027400 STOP RUN. RW1034.2 +027500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RW1034.2 +027600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RW1034.2 +027700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RW1034.2 +027800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. RW1034.2 +027900 MOVE "****TEST DELETED****" TO RE-MARK. RW1034.2 +028000 PRINT-DETAIL. RW1034.2 +028100 IF REC-CT NOT EQUAL TO ZERO RW1034.2 +028200 MOVE "." TO PARDOT-X RW1034.2 +028300 MOVE REC-CT TO DOTVALUE. RW1034.2 +028400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RW1034.2 +028500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RW1034.2 +028600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RW1034.2 +028700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RW1034.2 +028800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RW1034.2 +028900 MOVE SPACE TO CORRECT-X. RW1034.2 +029000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RW1034.2 +029100 MOVE SPACE TO RE-MARK. RW1034.2 +029200 HEAD-ROUTINE. RW1034.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1034.2 +029400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. RW1034.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RW1034.2 +029600 COLUMN-NAMES-ROUTINE. RW1034.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1034.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1034.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1034.2 +030000 END-ROUTINE. RW1034.2 +030100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RW1034.2 +030200 END-RTN-EXIT. RW1034.2 +030300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1034.2 +030400 END-ROUTINE-1. RW1034.2 +030500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RW1034.2 +030600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. RW1034.2 +030700 ADD PASS-COUNTER TO ERROR-HOLD. RW1034.2 +030800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RW1034.2 +030900 MOVE PASS-COUNTER TO CCVS-E-4-1. RW1034.2 +031000 MOVE ERROR-HOLD TO CCVS-E-4-2. RW1034.2 +031100 MOVE CCVS-E-4 TO CCVS-E-2-2. RW1034.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RW1034.2 +031300 END-ROUTINE-12. RW1034.2 +031400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RW1034.2 +031500 IF ERROR-COUNTER IS EQUAL TO ZERO RW1034.2 +031600 MOVE "NO " TO ERROR-TOTAL RW1034.2 +031700 ELSE RW1034.2 +031800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RW1034.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD. RW1034.2 +032000 PERFORM WRITE-LINE. RW1034.2 +032100 END-ROUTINE-13. RW1034.2 +032200 IF DELETE-CNT IS EQUAL TO ZERO RW1034.2 +032300 MOVE "NO " TO ERROR-TOTAL ELSE RW1034.2 +032400 MOVE DELETE-CNT TO ERROR-TOTAL. RW1034.2 +032500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RW1034.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1034.2 +032700 IF INSPECT-COUNTER EQUAL TO ZERO RW1034.2 +032800 MOVE "NO " TO ERROR-TOTAL RW1034.2 +032900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RW1034.2 +033000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RW1034.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1034.2 +033200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1034.2 +033300 WRITE-LINE. RW1034.2 +033400 ADD 1 TO RECORD-COUNT. RW1034.2 +033500Y IF RECORD-COUNT GREATER 50 RW1034.2 +033600Y MOVE DUMMY-RECORD TO DUMMY-HOLD RW1034.2 +033700Y MOVE SPACE TO DUMMY-RECORD RW1034.2 +033800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RW1034.2 +033900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RW1034.2 +034000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RW1034.2 +034100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RW1034.2 +034200Y MOVE DUMMY-HOLD TO DUMMY-RECORD RW1034.2 +034300Y MOVE ZERO TO RECORD-COUNT. RW1034.2 +034400 PERFORM WRT-LN. RW1034.2 +034500 WRT-LN. RW1034.2 +034600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RW1034.2 +034700 MOVE SPACE TO DUMMY-RECORD. RW1034.2 +034800 BLANK-LINE-PRINT. RW1034.2 +034900 PERFORM WRT-LN. RW1034.2 +035000 FAIL-ROUTINE. RW1034.2 +035100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1034.2 +035200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1034.2 +035300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RW1034.2 +035400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1034.2 +035500 GO TO FAIL-ROUTINE-EX. RW1034.2 +035600 FAIL-ROUTINE-WRITE. RW1034.2 +035700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RW1034.2 +035800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RW1034.2 +035900 FAIL-ROUTINE-EX. EXIT. RW1034.2 +036000 BAIL-OUT. RW1034.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RW1034.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RW1034.2 +036300 BAIL-OUT-WRITE. RW1034.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RW1034.2 +036500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1034.2 +036600 BAIL-OUT-EX. EXIT. RW1034.2 +036700 CCVS1-EXIT. RW1034.2 +036800 EXIT. RW1034.2 +036900 SECT-RW103-0001 SECTION. RW1034.2 +037000 RW103-INIT. RW1034.2 +037100 OPEN OUTPUT RW-FS3. RW1034.2 +037200 INIT-TEST-04. RW1034.2 +037300 INITIATE RW-FS3-REPORT-1. RW1034.2 +037400* RW1034.2 +037500* AFTER EXECUTION OF THE INITIATE STATEMENT FOR A REPORT, RW1034.2 +037600* THE REPORT LINE-COUNTER SHOULD BE ZERO AND PAGE-COUNTER RW1034.2 +037700* SHOULD BE ONE. RW1034.2 +037800* REFERENCE PAGE VIII-53, 3.2.4(1)B AND C, INITIATE STATEMENT RW1034.2 +037900* RW1034.2 +038000 INIT-TEST-04-01. RW1034.2 +038100 IF LINE-COUNTER EQUAL TO ZERO RW1034.2 +038200 PERFORM PASS RW1034.2 +038300 GO TO INIT-WRITE-04-01. RW1034.2 +038400 INIT-FAIL-04-01. RW1034.2 +038500 PERFORM FAIL. RW1034.2 +038600 MOVE ZERO TO CORRECT-18V0. RW1034.2 +038700 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1034.2 +038800 MOVE "LINE-COUNTER AFTER INITIATE" TO RE-MARK. RW1034.2 +038900 INIT-WRITE-04-01. RW1034.2 +039000 MOVE "INIT-TEST-04" TO PAR-NAME. RW1034.2 +039100 MOVE 1 TO REC-CT. RW1034.2 +039200 MOVE "INITIATE REPORT" TO FEATURE. RW1034.2 +039300 PERFORM PRINT-DETAIL. RW1034.2 +039400 INIT-TEST-04-02. RW1034.2 +039500 IF PAGE-COUNTER EQUAL TO 1 RW1034.2 +039600 PERFORM PASS RW1034.2 +039700 GO TO INIT-WRITE-04-02. RW1034.2 +039800 INIT-FAIL-04-02. RW1034.2 +039900 PERFORM FAIL. RW1034.2 +040000 MOVE 1 TO CORRECT-18V0. RW1034.2 +040100 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1034.2 +040200 MOVE "PAGE-COUNTER AFTER INITIATE" TO RE-MARK. RW1034.2 +040300 INIT-WRITE-04-02. RW1034.2 +040400 MOVE 2 TO REC-CT. RW1034.2 +040500 PERFORM PRINT-DETAIL. RW1034.2 +040600 GENER-TEST-08. RW1034.2 +040700* THIS TEST EXECUTES THE CHRONOLOGICALLY FIRST GENERATE RW1034.2 +040800* STATEMENT FOR THE REPORT RW-FS3-REPORT-1. RW1034.2 +040900* REFERENCE PAGE VIII-52, 3.1.4(5)B AND D, GENERATE STATEMENT RW1034.2 +041000* RW1034.2 +041100 ADD 1 TO WS-COUNTER. RW1034.2 +041200 GENERATE RW-FS3-DETAIL. RW1034.2 +041300* RW1034.2 +041400* OUTPUT REPORT INFO RW1034.2 +041500* RW1034.2 +041600* THE PAGE HEADING REPORT GROUP IS PRESENTED ON LINE 1 RW1034.2 +041700* OF PAGE 1. RW1034.2 +041800* REFERENCE PAGE VIII-14, 2.5.5.7, PAGE HEADING PRE. RULES RW1034.2 +041900* RW1034.2 +042000* THE LINE-COUNTER VALUE PRINTED ON THE PH LINE SHOULD RW1034.2 +042100* EQUAL ONE. RW1034.2 +042200* REFERENCE PAGE VIII-5, 2.4.5(6), LINE-COUNTER RULES RW1034.2 +042300* RW1034.2 +042400* THE FIRST DETAIL LINE IS PRESENTED ON LINE 6 OF PAGE 1. RW1034.2 +042500* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULES RW1034.2 +042600* RW1034.2 +042700 GENER-TEST-08-01. RW1034.2 +042800 IF LINE-COUNTER EQUAL TO 6 RW1034.2 +042900 PERFORM PASS RW1034.2 +043000 GO TO GENER-WRITE-08-01. RW1034.2 +043100* RW1034.2 +043200* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1034.2 +043300* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1034.2 +043400* PRESENTED, IN THIS CASE 6. RW1034.2 +043500* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1034.2 +043600* RW1034.2 +043700 GENER-FAIL-08-01. RW1034.2 +043800 PERFORM FAIL. RW1034.2 +043900 MOVE 6 TO CORRECT-18V0. RW1034.2 +044000 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1034.2 +044100 MOVE "LINE-COUNTER AFTER FIRST GENER" TO RE-MARK. RW1034.2 +044200 GENER-WRITE-08-01. RW1034.2 +044300 MOVE "GENER-TEST-8" TO PAR-NAME. RW1034.2 +044400 MOVE "FIRST GENERATE" TO FEATURE. RW1034.2 +044500 MOVE 1 TO REC-CT. RW1034.2 +044600 PERFORM PRINT-DETAIL. RW1034.2 +044700 GENER-TEST-08-02. RW1034.2 +044800 IF PAGE-COUNTER EQUAL TO 1 RW1034.2 +044900 PERFORM PASS RW1034.2 +045000 GO TO GENER-WRITE-08-02. RW1034.2 +045100* RW1034.2 +045200* EXECUTION OF THE FIRST GENERATE STATEMENT SHOULD NOT RW1034.2 +045300* CHANGE THE VALUE OF PAGE-COUNTER. IT SHOULD STILL BE RW1034.2 +045400* EQUAL TO ONE. RW1034.2 +045500* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES RW1034.2 +045600* RW1034.2 +045700 GENER-FAIL-08-02. RW1034.2 +045800 PERFORM FAIL. RW1034.2 +045900 MOVE 1 TO CORRECT-18V0. RW1034.2 +046000 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1034.2 +046100 MOVE "PAGE-COUNTER AFTER GENER" TO RE-MARK. RW1034.2 +046200 GENER-WRITE-08-02. RW1034.2 +046300 MOVE 2 TO REC-CT. RW1034.2 +046400 PERFORM PRINT-DETAIL. RW1034.2 +046500 GENER-TEST-09. RW1034.2 +046600* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1034.2 +046700* REPORT GROUP 19 TIMES. RW1034.2 +046800* REFERENCE PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1034.2 +046900* RW1034.2 +047000 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1034.2 +047100* RW1034.2 +047200* OUTPUT REPORT INFO RW1034.2 +047300* NINETEEN DETAIL LINES SINGLE SPACED ARE PRESENTED ON RW1034.2 +047400* LINES 7 THROUGH 25 OF THE FIRST REPORT PAGE. RW1034.2 +047500* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE. RULESRW1034.2 +047600* RW1034.2 +047700 GO TO GENER-TEST-09-01. RW1034.2 +047800 GENER-DETAIL-LINE. RW1034.2 +047900 ADD 1 TO WS-COUNTER. RW1034.2 +048000 GENERATE RW-FS3-DETAIL. RW1034.2 +048100 MOVE WS-COUNTER TO TEMP-COMP. RW1034.2 +048200 ADD 5 TO TEMP-COMP. RW1034.2 +048300 IF LINE-COUNTER NOT EQUAL TO TEMP-COMP RW1034.2 +048400 ADD 1 TO LC-ERRORS. RW1034.2 +048500* RW1034.2 +048600* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1034.2 +048700* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1034.2 +048800* PRESENTED. THIS NUMBER IS FIVE GREATER THAN THE DETAIL RW1034.2 +048900* LINE NUMBER. RW1034.2 +049000* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1034.2 +049100* RW1034.2 +049200 IF PAGE-COUNTER NOT EQUAL TO PAGENO RW1034.2 +049300 ADD 1 TO PC-ERRORS. RW1034.2 +049400* RW1034.2 +049500* EXECUTION OF A GENERATE STATEMENT WHICH DOES NOT CAUSE RW1034.2 +049600* PAGE ADVANCING SHOULD NOT CHANGE THE VALUE OF PAGE-COUNTER. RW1034.2 +049700* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES. RW1034.2 +049800* RW1034.2 +049900 GENER-TEST-09-01. RW1034.2 +050000 IF LC-ERRORS EQUAL TO ZERO RW1034.2 +050100 PERFORM PASS RW1034.2 +050200 GO TO GENER-WRITE-09-01. RW1034.2 +050300 GENER-FAIL-09-01. RW1034.2 +050400 PERFORM FAIL. RW1034.2 +050500 MOVE LC-ERRORS TO COMPUTED-18V0. RW1034.2 +050600 MOVE ZERO TO CORRECT-18V0. RW1034.2 +050700 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +050800 GENER-WRITE-09-01. RW1034.2 +050900 MOVE "GENER-TEST-9" TO PAR-NAME. RW1034.2 +051000 MOVE 1 TO REC-CT. RW1034.2 +051100 MOVE "GENERATE 19 LINES" TO FEATURE. RW1034.2 +051200 PERFORM PRINT-DETAIL. RW1034.2 +051300 GENER-TEST-09-02. RW1034.2 +051400 IF PC-ERRORS EQUAL TO ZERO RW1034.2 +051500 PERFORM PASS RW1034.2 +051600 GO TO GENER-WRITE-09-02. RW1034.2 +051700 GENER-FAIL-09-02. RW1034.2 +051800 PERFORM FAIL. RW1034.2 +051900 MOVE PC-ERRORS TO COMPUTED-18V0. RW1034.2 +052000 MOVE ZERO TO CORRECT-18V0. RW1034.2 +052100 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +052200 GENER-WRITE-09-02. RW1034.2 +052300 MOVE 2 TO REC-CT. RW1034.2 +052400 PERFORM PRINT-DETAIL. RW1034.2 +052500 GENER-TEST-10. RW1034.2 +052600* RW1034.2 +052700* THIS TEST EXECUTES A GENERATE STATEMENT WHICH CAUSES RW1034.2 +052800* THE PAGE HEADING REPORT GROUP TO BE PRESENTED ON LINE 1 RW1034.2 +052900* OF PAGE 2, AND THE FIRST DETAIL REPORT GROUP TO BE PRESENTED RW1034.2 +053000* ON LINE 6 OF PAGE 2. RW1034.2 +053100* REFERENCES PAGE VIII-51, 3.1.4(4), THE GENERATE STATEMENT RW1034.2 +053200* PAGE VIII-17, 2.5.5.8.1(3)B, (4)B, RW1034.2 +053300* BODY GROUP PRESENTATION RULES RW1034.2 +053400* RW1034.2 +053500 MOVE 1 TO WS-COUNTER. RW1034.2 +053600 GENERATE RW-FS3-DETAIL. RW1034.2 +053700 GENER-TEST-10-01. RW1034.2 +053800 IF LINE-COUNTER EQUAL TO 6 RW1034.2 +053900 PERFORM PASS RW1034.2 +054000 GO TO GENER-WRITE-10-01. RW1034.2 +054100* RW1034.2 +054200* LINE-COUNTER SHOULD BE RESET TO ZERO WHEN THE PAGE RW1034.2 +054300* ADVANCE FROM PAGE 1 TO PAGE 2 IS EXECUTED, AND LINE-COUNTER RW1034.2 +054400* IS SET TO 6 WHEN THE DETAIL REPORT GROUP IS PRESENTED. RW1034.2 +054500* REFERENCES PAGE VIII-5, 2.4.5(4), LINE-COUNTER RULES RW1034.2 +054600* PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1034.2 +054700* RW1034.2 +054800 GENER-FAIL-10-01. RW1034.2 +054900 PERFORM FAIL. RW1034.2 +055000 MOVE 6 TO CORRECT-18V0. RW1034.2 +055100 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1034.2 +055200 MOVE "LINE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1034.2 +055300 GENER-WRITE-10-01. RW1034.2 +055400 MOVE "GENR-TEST-10" TO PAR-NAME. RW1034.2 +055500 MOVE "PAGE ADVANCE" TO FEATURE. RW1034.2 +055600 MOVE 1 TO REC-CT. RW1034.2 +055700 PERFORM PRINT-DETAIL. RW1034.2 +055800 GENER-TEST-10-02. RW1034.2 +055900 IF PAGE-COUNTER EQUAL TO 2 RW1034.2 +056000 PERFORM PASS RW1034.2 +056100 GO TO GENER-WRITE-10-02. RW1034.2 +056200* RW1034.2 +056300* PAGE-COUNTER SHOULD BE INCREMENTED TO 2 WHEN THE PAGE RW1034.2 +056400* ADVANCE FROM PAGE 1 TO PAGE 2 IS EXECUTED. RW1034.2 +056500* REFERENCE PAGE VIII-5, 2.4.4(5), PAGE-COUNTER RULES RW1034.2 +056600* RW1034.2 +056700 GENER-FAIL-10-02. RW1034.2 +056800 PERFORM FAIL. RW1034.2 +056900 MOVE 2 TO CORRECT-18V0. RW1034.2 +057000 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1034.2 +057100 MOVE "PAGE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1034.2 +057200 GENER-WRITE-10-02. RW1034.2 +057300 MOVE 2 TO REC-CT. RW1034.2 +057400 PERFORM PRINT-DETAIL. RW1034.2 +057500 GENER-TEST-11. RW1034.2 +057600* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1034.2 +057700* REPORT GROUP 19 TIMES. NINETEEN DETAIL LINES SINGLE SPACED RW1034.2 +057800* ARE PRESENTED ON LINES 7 THROUGH 25 OF THE SECOND REPORT RW1034.2 +057900* PAGE. RW1034.2 +058000* REFERENCES PAGE VIII-51, 3.1.4(2),(6)B, GENERATE STATEMENT RW1034.2 +058100* PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULESRW1034.2 +058200* RW1034.2 +058300 MOVE 2 TO PAGENO. RW1034.2 +058400 MOVE ZERO TO LC-ERRORS PC-ERRORS. RW1034.2 +058500 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1034.2 +058600 GENER-TEST-11-01. RW1034.2 +058700 IF LC-ERRORS EQUAL TO ZERO RW1034.2 +058800 PERFORM PASS RW1034.2 +058900 GO TO GENER-WRITE-11-01. RW1034.2 +059000 GENER-FAIL-11-01. RW1034.2 +059100 PERFORM FAIL. RW1034.2 +059200 MOVE LC-ERRORS TO COMPUTED-18V0. RW1034.2 +059300 MOVE ZERO TO CORRECT-18V0. RW1034.2 +059400 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +059500 GENER-WRITE-11-01. RW1034.2 +059600 MOVE "GENR-TEST-11" TO PAR-NAME. RW1034.2 +059700 MOVE 1 TO REC-CT. RW1034.2 +059800 MOVE "GENERATE 19 LINES" TO FEATURE. RW1034.2 +059900 PERFORM PRINT-DETAIL. RW1034.2 +060000 GENER-TEST-11-02. RW1034.2 +060100 IF PC-ERRORS EQUAL TO ZERO RW1034.2 +060200 PERFORM PASS RW1034.2 +060300 GO TO GENER-WRITE-11-02. RW1034.2 +060400 GENER-FAIL-11-02. RW1034.2 +060500 PERFORM FAIL. RW1034.2 +060600 MOVE PC-ERRORS TO COMPUTED-18V0. RW1034.2 +060700 MOVE ZERO TO CORRECT-18V0. RW1034.2 +060800 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +060900 GENER-WRITE-11-02. RW1034.2 +061000 MOVE 2 TO REC-CT. RW1034.2 +061100 PERFORM PRINT-DETAIL. RW1034.2 +061200 GENER-TEST-12. RW1034.2 +061300* THIS TEST EXECUTES A GENERATE STATEMENT WHICH CAUSES RW1034.2 +061400* THE PAGE HEADING REPORT GROUP TO BE PRESENTED ON LINE 1 RW1034.2 +061500* OF PAGE 3, AND THE FIRST DETAIL REPORT GROUP TO BE PRESENTED RW1034.2 +061600* ON LINE 6 OF PAGE 3. RW1034.2 +061700* REFERENCES PAGE VIII-51, 3.1.4(4), THE GENERATE STATEMENT RW1034.2 +061800* PAGE VIII-17, 2.5.5.8.1(3)B, (4)B, RW1034.2 +061900* BODY GROUP PRESENTATION RULES RW1034.2 +062000* RW1034.2 +062100 MOVE 1 TO WS-COUNTER. RW1034.2 +062200 GENERATE RW-FS3-DETAIL. RW1034.2 +062300 GENER-TEST-12-01. RW1034.2 +062400 IF LINE-COUNTER EQUAL TO 6 RW1034.2 +062500 PERFORM PASS RW1034.2 +062600 GO TO GENER-WRITE-12-01. RW1034.2 +062700* RW1034.2 +062800* LINE-COUNTER SHOULD BE RESET TO ZERO WHEN THE PAGE RW1034.2 +062900* ADVANCE FROM PAGE 2 TO PAGE 3 IS EXECUTED, AND LINE-COUNTER RW1034.2 +063000* IS SET TO 6 WHEN THE DETAIL REPORT GROUP IS PRESENTED. RW1034.2 +063100* REFERENCES PAGE VIII-5, 2.4.5(4), LINE-COUNTER RULES RW1034.2 +063200* PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1034.2 +063300* RW1034.2 +063400 GENER-FAIL-12-01. RW1034.2 +063500 PERFORM FAIL. RW1034.2 +063600 MOVE 6 TO CORRECT-18V0. RW1034.2 +063700 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1034.2 +063800 MOVE "LINE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1034.2 +063900 GENER-WRITE-12-01. RW1034.2 +064000 MOVE "GENR-TEST-12" TO PAR-NAME. RW1034.2 +064100 MOVE "PAGE ADVANCE" TO FEATURE. RW1034.2 +064200 MOVE 1 TO REC-CT. RW1034.2 +064300 PERFORM PRINT-DETAIL. RW1034.2 +064400 GENER-TEST-12-02. RW1034.2 +064500 IF PAGE-COUNTER EQUAL TO 3 RW1034.2 +064600 PERFORM PASS RW1034.2 +064700 GO TO GENER-WRITE-12-02. RW1034.2 +064800* RW1034.2 +064900* PAGE-COUNTER SHOULD BE INCREMENTED TO 3 WHEN THE PAGE RW1034.2 +065000* ADVANCE FROM PAGE 2 TO PAGE 3 IS EXECUTED. RW1034.2 +065100* REFERENCE PAGE VIII-5, 2.4.4(5), PAGE-COUNTER RULES RW1034.2 +065200* RW1034.2 +065300 GENER-FAIL-12-02. RW1034.2 +065400 PERFORM FAIL. RW1034.2 +065500 MOVE 3 TO CORRECT-18V0. RW1034.2 +065600 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1034.2 +065700 MOVE "PAGE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1034.2 +065800 GENER-WRITE-12-02. RW1034.2 +065900 MOVE 2 TO REC-CT. RW1034.2 +066000 PERFORM PRINT-DETAIL. RW1034.2 +066100 GENER-TEST-13. RW1034.2 +066200* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1034.2 +066300* REPORT GROUP 19 TIMES. NINETEEN DETAIL LINES SINGLE SPACED RW1034.2 +066400* ARE PRESENTED ON LINES 7 THROUGH 25 OF THE THIRD REPORT PAGE.RW1034.2 +066500* REFERENCES PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1034.2 +066600* PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULESRW1034.2 +066700* RW1034.2 +066800 MOVE 3 TO PAGENO. RW1034.2 +066900 MOVE ZERO TO LC-ERRORS PC-ERRORS. RW1034.2 +067000 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1034.2 +067100 GENER-TEST-13-01. RW1034.2 +067200 IF LC-ERRORS EQUAL TO ZERO RW1034.2 +067300 PERFORM PASS RW1034.2 +067400 GO TO GENER-WRITE-13-01. RW1034.2 +067500 GENER-FAIL-13-01. RW1034.2 +067600 PERFORM FAIL. RW1034.2 +067700 MOVE LC-ERRORS TO COMPUTED-18V0. RW1034.2 +067800 MOVE ZERO TO CORRECT-18V0. RW1034.2 +067900 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +068000 GENER-WRITE-13-01. RW1034.2 +068100 MOVE "GENR-TEST-13" TO PAR-NAME. RW1034.2 +068200 MOVE 1 TO REC-CT. RW1034.2 +068300 MOVE "GENERATE 19 LINES" TO FEATURE. RW1034.2 +068400 PERFORM PRINT-DETAIL. RW1034.2 +068500 GENER-TEST-13-02. RW1034.2 +068600 IF PC-ERRORS EQUAL TO ZERO RW1034.2 +068700 PERFORM PASS RW1034.2 +068800 GO TO GENER-WRITE-13-02. RW1034.2 +068900 GENER-FAIL-13-02. RW1034.2 +069000 PERFORM FAIL. RW1034.2 +069100 MOVE PC-ERRORS TO COMPUTED-18V0. RW1034.2 +069200 MOVE ZERO TO CORRECT-18V0. RW1034.2 +069300 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1034.2 +069400 GENER-WRITE-13-02. RW1034.2 +069500 MOVE 2 TO REC-CT. RW1034.2 +069600 PERFORM PRINT-DETAIL. RW1034.2 +069700* RW1034.2 +069800 TERM-TEST-STATE. RW1034.2 +069900 TERMINATE RW-FS3-REPORT-1. RW1034.2 +070000 CLOSE-RW-FS3. RW1034.2 +070100 CLOSE RW-FS3. RW1034.2 +070200 TERM-WRITE-03. RW1034.2 +070300 MOVE "TERMINATE REPORT" TO FEATURE. RW1034.2 +070400 MOVE ZERO TO REC-CT. RW1034.2 +070500 MOVE "TERM-TEST-03" TO PAR-NAME. RW1034.2 +070600 MOVE "3 PAGE REPORT" TO COMPUTED-A. RW1034.2 +070700 MOVE "20 DE LINES PER PAGE" TO CORRECT-A. RW1034.2 +070800 MOVE "CHECK RWCS OUTPUT REPORT" TO RE-MARK. RW1034.2 +070900 PERFORM PRINT-DETAIL. RW1034.2 +071000 EXIT-RW103. RW1034.2 +071100 EXIT. RW1034.2 +071200 CCVS-EXIT SECTION. RW1034.2 +071300 CCVS-999999. RW1034.2 +071400 GO TO CLOSE-FILES. RW1034.2 +*END-OF,RW103A +*HEADER,COBOL,RW104A +000100 IDENTIFICATION DIVISION. RW1044.2 +000200 PROGRAM-ID. RW1044.2 +000300 RW104A. RW1044.2 +000400 AUTHOR. RW1044.2 +000500 FEDERAL COMPILER TESTING CENTER. RW1044.2 +000600 INSTALLATION. RW1044.2 +000700 GENERAL SERVICES ADMINISTRATION RW1044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. RW1044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. RW1044.2 +001000 5203 LEESBURG PIKE SUITE 1100 RW1044.2 +001100 FALLS CHURCH VIRGINIA 22041. RW1044.2 +001200 RW1044.2 +001300 PHONE (703) 756-6153 RW1044.2 +001400 RW1044.2 +001500 " HIGH ". RW1044.2 +001600 DATE-WRITTEN. RW1044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. RW1044.2 +001800 CREATION DATE / VALIDATION DATE RW1044.2 +001900 "4.2 ". RW1044.2 +002000 SECURITY. RW1044.2 +002100 NONE. RW1044.2 +002200******************************************************************RW1044.2 +002300* RW1044.2 +002400* THE ROUTINE RW104A TESTS BASIC REPORT WRITER MODULE RW1044.2 +002500* FUNCTIONS. ONE OUTPUT REPORT IS PRODUCED BY THE RWCS. RW1044.2 +002600* THE REPORT DESCRIPTION IN THIS ROUTINE CONTAINS RW1044.2 +002700* PAGE LIMITS ARE 30 LINES RW1044.2 +002800* HEADING 1 RW1044.2 +002900* FIRST DETAIL 6 RW1044.2 +003000* LAST DETAIL 25 RW1044.2 +003100* FOOTING 29. RW1044.2 +003200* RW1044.2 +003300* THE PROCEDURE DIVISION FOR RW104A RW1044.2 +003400* OPENS THE SEQUENTIAL FILE RW-FS4, RW1044.2 +003500* INITIATES THE REPORT RW-FS4-REPORT-1, RW1044.2 +003600* CHECKS THE VALUES IN LINE-COUNTER AND PAGE-COUNTER RW1044.2 +003700* AFTER EXECUTING THE INITIATE STATEMENT, RW1044.2 +003800* GENERATES A THREE PAGE REPORT WITH GENERATE DATA- RW1044.2 +003900* NAME STATEMENTS, RW1044.2 +004000* CHECKS THE VALUES IN LINE-COUNTER AND PAGE-COUNTER RW1044.2 +004100* AFTER EACH GENERATE STATEMENT, RW1044.2 +004200* CHECKS THAT LINE-COUNTER AND PAGE-COUNTER ARE RESET RW1044.2 +004300* WHEN PAGE ADVANCING PROCESSING HAS OCCURRED, RW1044.2 +004400* TERMINATES THE REPORT RW-FS4-REPORT-1, RW1044.2 +004500* CLOSES THE FILE RW-FS4. RW1044.2 +004600* RW1044.2 +004700* THE OUTPUT OF THIS ROUTINE CONSISTS OF AN OUTPUT REPORT RW1044.2 +004800* IN THE USUAL AUDIT ROUTINE FORMAT PRODUCED USING WRITE RW1044.2 +004900* STATEMENTS AND A REPORT PRODUCED BY THE RWCS. BOTH REPORTS RW1044.2 +005000* MUST BE CAREFULLY EXAMINED TO VERIFY THAT THE TESTS IN RW1044.2 +005100* RW104 WERE EXECUTED CORRECTLY. RW1044.2 +005200* RW1044.2 +005300* THE OUTPUT REPORT GENERATED BY THE RWCS CONSISTS OF RW1044.2 +005400* THREE PAGES WITH EACH PAGE CONTAINING A PAGE HEADING ON RW1044.2 +005500* LINE 1, TWENTY DETAIL LINES ON LINES 6 THROUGH 25, AND A RW1044.2 +005600* PAGE FOOTING ON LINE 30. LINES 2 THROUGH 5 AND 26 THROUGH 29RW1044.2 +005700* SHOULD BE BLANK. RW1044.2 +005800* RW1044.2 +005900* THE VALUE OF LINE-COUNTER IN THE DETAIL LINE IS FIVE RW1044.2 +006000* GREATER THAN THE DETAIL LINE NUMBER, AND PAGE-COUNTER IS RW1044.2 +006100* EQUAL TO THE PAGE ON WHICH THE DETAIL LINE IS PRESENTED. RW1044.2 +006200* RW1044.2 +006300******************************************************************RW1044.2 +006400* RW1044.2 +006500* REFERENCE AMERICAN NATIONAL STANDARD PROGRAMMING RW1044.2 +006600* LANGUAGE COBOL, X3.23-1974 RW1044.2 +006700* SECTION VIII - REPORT WRITER MODULE RW1044.2 +006800* RW1044.2 +006900******************************************************************RW1044.2 +007000 ENVIRONMENT DIVISION. RW1044.2 +007100 CONFIGURATION SECTION. RW1044.2 +007200 SOURCE-COMPUTER. RW1044.2 +007300 XXXXX082. RW1044.2 +007400 OBJECT-COMPUTER. RW1044.2 +007500 XXXXX083. RW1044.2 +007600 INPUT-OUTPUT SECTION. RW1044.2 +007700 FILE-CONTROL. RW1044.2 +007800 SELECT PRINT-FILE ASSIGN TO RW1044.2 +007900 XXXXX055. RW1044.2 +008000 SELECT RW-FS4 ASSIGN TO RW1044.2 +008100 XXXXX049. RW1044.2 +008200 DATA DIVISION. RW1044.2 +008300 FILE SECTION. RW1044.2 +008400 FD PRINT-FILE RW1044.2 +008500 LABEL RECORDS RW1044.2 +008600 XXXXX084 RW1044.2 +008700 DATA RECORD IS PRINT-REC DUMMY-RECORD. RW1044.2 +008800 01 PRINT-REC PICTURE X(120). RW1044.2 +008900 01 DUMMY-RECORD PICTURE X(120). RW1044.2 +009000 FD RW-FS4 RW1044.2 +009100 LABEL RECORDS ARE STANDARD RW1044.2 +009200C VALUE OF RW1044.2 +009300C XXXXX074 RW1044.2 +009400C IS RW1044.2 +009500C XXXXX075 RW1044.2 +009600G XXXXX069 RW1044.2 +009700 REPORT IS RW-FS4-REPORT-1. RW1044.2 +009800 WORKING-STORAGE SECTION. RW1044.2 +009900 01 LC-ERRORS PIC 99 VALUE 0. RW1044.2 +010000 01 PC-ERRORS PIC 99 VALUE 0. RW1044.2 +010100 01 WS-COUNTER PIC 99 VALUE 0. RW1044.2 +010200 01 PAGENO PIC 99 VALUE 1. RW1044.2 +010300 01 TEMP-COMP PIC 99. RW1044.2 +010400 01 TEST-RESULTS. RW1044.2 +010500 02 FILLER PICTURE X VALUE SPACE. RW1044.2 +010600 02 FEATURE PICTURE X(20) VALUE SPACE. RW1044.2 +010700 02 FILLER PICTURE X VALUE SPACE. RW1044.2 +010800 02 P-OR-F PICTURE X(5) VALUE SPACE. RW1044.2 +010900 02 FILLER PICTURE X VALUE SPACE. RW1044.2 +011000 02 PAR-NAME. RW1044.2 +011100 03 FILLER PICTURE X(12) VALUE SPACE. RW1044.2 +011200 03 PARDOT-X PICTURE X VALUE SPACE. RW1044.2 +011300 03 DOTVALUE PICTURE 99 VALUE ZERO. RW1044.2 +011400 03 FILLER PIC X(5) VALUE SPACE. RW1044.2 +011500 02 FILLER PIC X(10) VALUE SPACE. RW1044.2 +011600 02 RE-MARK PIC X(61). RW1044.2 +011700 01 TEST-COMPUTED. RW1044.2 +011800 02 FILLER PIC X(30) VALUE SPACE. RW1044.2 +011900 02 FILLER PIC X(17) VALUE " COMPUTED=". RW1044.2 +012000 02 COMPUTED-X. RW1044.2 +012100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. RW1044.2 +012200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). RW1044.2 +012300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). RW1044.2 +012400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). RW1044.2 +012500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). RW1044.2 +012600 03 CM-18V0 REDEFINES COMPUTED-A. RW1044.2 +012700 04 COMPUTED-18V0 PICTURE -9(18). RW1044.2 +012800 04 FILLER PICTURE X. RW1044.2 +012900 03 FILLER PIC X(50) VALUE SPACE. RW1044.2 +013000 01 TEST-CORRECT. RW1044.2 +013100 02 FILLER PIC X(30) VALUE SPACE. RW1044.2 +013200 02 FILLER PIC X(17) VALUE " CORRECT =". RW1044.2 +013300 02 CORRECT-X. RW1044.2 +013400 03 CORRECT-A PICTURE X(20) VALUE SPACE. RW1044.2 +013500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). RW1044.2 +013600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). RW1044.2 +013700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). RW1044.2 +013800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). RW1044.2 +013900 03 CR-18V0 REDEFINES CORRECT-A. RW1044.2 +014000 04 CORRECT-18V0 PICTURE -9(18). RW1044.2 +014100 04 FILLER PICTURE X. RW1044.2 +014200 03 FILLER PIC X(50) VALUE SPACE. RW1044.2 +014300 01 CCVS-C-1. RW1044.2 +014400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PARW1044.2 +014500- "SS PARAGRAPH-NAME RW1044.2 +014600- " REMARKS". RW1044.2 +014700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. RW1044.2 +014800 01 CCVS-C-2. RW1044.2 +014900 02 FILLER PICTURE IS X VALUE IS SPACE. RW1044.2 +015000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". RW1044.2 +015100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. RW1044.2 +015200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". RW1044.2 +015300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. RW1044.2 +015400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. RW1044.2 +015500 01 REC-CT PICTURE 99 VALUE ZERO. RW1044.2 +015600 01 DELETE-CNT PICTURE 999 VALUE ZERO. RW1044.2 +015700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. RW1044.2 +015800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RW1044.2 +015900 01 PASS-COUNTER PIC 999 VALUE ZERO. RW1044.2 +016000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RW1044.2 +016100 01 ERROR-HOLD PIC 999 VALUE ZERO. RW1044.2 +016200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RW1044.2 +016300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RW1044.2 +016400 01 CCVS-H-1. RW1044.2 +016500 02 FILLER PICTURE X(27) VALUE SPACE. RW1044.2 +016600 02 FILLER PICTURE X(67) VALUE RW1044.2 +016700 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION RW1044.2 +016800- " SYSTEM". RW1044.2 +016900 02 FILLER PICTURE X(26) VALUE SPACE. RW1044.2 +017000 01 CCVS-H-2. RW1044.2 +017100 02 FILLER PICTURE X(52) VALUE IS RW1044.2 +017200 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". RW1044.2 +017300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". RW1044.2 +017400 02 TEST-ID PICTURE IS X(9). RW1044.2 +017500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. RW1044.2 +017600 01 CCVS-H-3. RW1044.2 +017700 02 FILLER PICTURE X(34) VALUE RW1044.2 +017800 " FOR OFFICIAL USE ONLY ". RW1044.2 +017900 02 FILLER PICTURE X(58) VALUE RW1044.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RW1044.2 +018100 02 FILLER PICTURE X(28) VALUE RW1044.2 +018200 " COPYRIGHT 1974 ". RW1044.2 +018300 01 CCVS-E-1. RW1044.2 +018400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. RW1044.2 +018500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". RW1044.2 +018600 02 ID-AGAIN PICTURE IS X(9). RW1044.2 +018700 02 FILLER PICTURE X(45) VALUE IS RW1044.2 +018800 " NTIS DISTRIBUTION COBOL 74". RW1044.2 +018900 01 CCVS-E-2. RW1044.2 +019000 02 FILLER PICTURE X(31) VALUE RW1044.2 +019100 SPACE. RW1044.2 +019200 02 FILLER PICTURE X(21) VALUE SPACE. RW1044.2 +019300 02 CCVS-E-2-2. RW1044.2 +019400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. RW1044.2 +019500 03 FILLER PICTURE IS X VALUE IS SPACE. RW1044.2 +019600 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". RW1044.2 +019700 01 CCVS-E-3. RW1044.2 +019800 02 FILLER PICTURE X(22) VALUE RW1044.2 +019900 " FOR OFFICIAL USE ONLY". RW1044.2 +020000 02 FILLER PICTURE X(12) VALUE SPACE. RW1044.2 +020100 02 FILLER PICTURE X(58) VALUE RW1044.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RW1044.2 +020300 02 FILLER PICTURE X(13) VALUE SPACE. RW1044.2 +020400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". RW1044.2 +020500 01 CCVS-E-4. RW1044.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RW1044.2 +020700 02 FILLER PIC XXXX VALUE " OF ". RW1044.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RW1044.2 +020900 02 FILLER PIC X(40) VALUE RW1044.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". RW1044.2 +021100 01 XXINFO. RW1044.2 +021200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". RW1044.2 +021300 02 INFO-TEXT. RW1044.2 +021400 04 FILLER PIC X(20) VALUE SPACE. RW1044.2 +021500 04 XXCOMPUTED PIC X(20). RW1044.2 +021600 04 FILLER PIC X(5) VALUE SPACE. RW1044.2 +021700 04 XXCORRECT PIC X(20). RW1044.2 +021800 01 HYPHEN-LINE. RW1044.2 +021900 02 FILLER PICTURE IS X VALUE IS SPACE. RW1044.2 +022000 02 FILLER PICTURE IS X(65) VALUE IS "************************RW1044.2 +022100- "*****************************************". RW1044.2 +022200 02 FILLER PICTURE IS X(54) VALUE IS "************************RW1044.2 +022300- "******************************". RW1044.2 +022400 01 CCVS-PGM-ID PIC X(6) VALUE RW1044.2 +022500 "RW104A". RW1044.2 +022600 REPORT SECTION. RW1044.2 +022700 RD RW-FS4-REPORT-1 RW1044.2 +022800 PAGE LIMITS ARE 30 LINES RW1044.2 +022900 HEADING 1 RW1044.2 +023000 FIRST DETAIL 6 RW1044.2 +023100 LAST DETAIL 25 RW1044.2 +023200 FOOTING 29. RW1044.2 +023300 01 RW-FS4-HEADING RW1044.2 +023400 LINE NUMBER 1 RW1044.2 +023500 TYPE PH. RW1044.2 +023600 03 PIC X(36) COLUMN 20 RW1044.2 +023700 VALUE "U.S. NAVY COBOL AUDIT ROUTINE RW104A". RW1044.2 +023800 03 PIC X(5) COLUMN NUMBER 60 VALUE "LINE ". RW1044.2 +023900 03 PIC 9 COLUMN NUMBER IS 65 SOURCE LINE-COUNTER. RW1044.2 +024000 03 COLUMN NUMBER 70 PIC X(5) VALUE "PAGE ". RW1044.2 +024100 03 SOURCE PAGE-COUNTER PIC 9 COLUMN NUMBER IS 75. RW1044.2 +024200 01 RW-FS4-DETAIL RW1044.2 +024300 LINE NUMBER PLUS 1 RW1044.2 +024400 TYPE DE. RW1044.2 +024500 03 VALUE "DETAIL LINE " COLUMN 20 PIC X(12). RW1044.2 +024600 03 PIC 99 COLUMN 32 SOURCE IS WS-COUNTER. RW1044.2 +024700 03 PIC X(13) COLUMN 36 VALUE "PAGE-COUNTER ". RW1044.2 +024800 03 PIC 9 COLUMN 49 SOURCE PAGE-COUNTER. RW1044.2 +024900 03 PIC X(13) COLUMN 55 VALUE "LINE-COUNTER ". RW1044.2 +025000 03 PIC 99 COLUMN 68 SOURCE LINE-COUNTER. RW1044.2 +025100 01 RW-FS4-FOOTING RW1044.2 +025200 LINE NUMBER 30 RW1044.2 +025300 TYPE IS PAGE FOOTING. RW1044.2 +025400 05 PICTURE X(36) COLUMN 20 RW1044.2 +025500 VALUE "PAGE FOOTING ROUTINE RW104 LINE ". RW1044.2 +025600 05 PIC 99 COLUMN 56 SOURCE LINE-COUNTER. RW1044.2 +025700 05 PIC X(5) COLUMN 70 VALUE "PAGE ". RW1044.2 +025800 05 PIC 9 COLUMN 75 SOURCE PAGE-COUNTER. RW1044.2 +025900* RW1044.2 +026000* EXCEPT FOR THE DATA-NAME CLAUSE, THE CLAUSES IN A REPORT RW1044.2 +026100* GROUP DESCRIPTION ENTRY MAY BE WRITTEN IN ANY SEQUENCE. RW1044.2 +026200* REFERENCE VIII-7, 2.5.3(2), REPORT GROUP DESCRIPTION ENTRY RW1044.2 +026300* RW1044.2 +026400 PROCEDURE DIVISION. RW1044.2 +026500 CCVS1 SECTION. RW1044.2 +026600 OPEN-FILES. RW1044.2 +026700 OPEN OUTPUT PRINT-FILE. RW1044.2 +026800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RW1044.2 +026900 MOVE SPACE TO TEST-RESULTS. RW1044.2 +027000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RW1044.2 +027100 GO TO CCVS1-EXIT. RW1044.2 +027200 CLOSE-FILES. RW1044.2 +027300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RW1044.2 +027400 TERMINATE-CCVS. RW1044.2 +027500S EXIT PROGRAM. RW1044.2 +027600STERMINATE-CALL. RW1044.2 +027700 STOP RUN. RW1044.2 +027800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RW1044.2 +027900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RW1044.2 +028000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RW1044.2 +028100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. RW1044.2 +028200 MOVE "****TEST DELETED****" TO RE-MARK. RW1044.2 +028300 PRINT-DETAIL. RW1044.2 +028400 IF REC-CT NOT EQUAL TO ZERO RW1044.2 +028500 MOVE "." TO PARDOT-X RW1044.2 +028600 MOVE REC-CT TO DOTVALUE. RW1044.2 +028700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RW1044.2 +028800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RW1044.2 +028900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RW1044.2 +029000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RW1044.2 +029100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RW1044.2 +029200 MOVE SPACE TO CORRECT-X. RW1044.2 +029300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RW1044.2 +029400 MOVE SPACE TO RE-MARK. RW1044.2 +029500 HEAD-ROUTINE. RW1044.2 +029600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1044.2 +029700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. RW1044.2 +029800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RW1044.2 +029900 COLUMN-NAMES-ROUTINE. RW1044.2 +030000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1044.2 +030100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1044.2 +030200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1044.2 +030300 END-ROUTINE. RW1044.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RW1044.2 +030500 END-RTN-EXIT. RW1044.2 +030600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1044.2 +030700 END-ROUTINE-1. RW1044.2 +030800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RW1044.2 +030900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. RW1044.2 +031000 ADD PASS-COUNTER TO ERROR-HOLD. RW1044.2 +031100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RW1044.2 +031200 MOVE PASS-COUNTER TO CCVS-E-4-1. RW1044.2 +031300 MOVE ERROR-HOLD TO CCVS-E-4-2. RW1044.2 +031400 MOVE CCVS-E-4 TO CCVS-E-2-2. RW1044.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RW1044.2 +031600 END-ROUTINE-12. RW1044.2 +031700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RW1044.2 +031800 IF ERROR-COUNTER IS EQUAL TO ZERO RW1044.2 +031900 MOVE "NO " TO ERROR-TOTAL RW1044.2 +032000 ELSE RW1044.2 +032100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RW1044.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. RW1044.2 +032300 PERFORM WRITE-LINE. RW1044.2 +032400 END-ROUTINE-13. RW1044.2 +032500 IF DELETE-CNT IS EQUAL TO ZERO RW1044.2 +032600 MOVE "NO " TO ERROR-TOTAL ELSE RW1044.2 +032700 MOVE DELETE-CNT TO ERROR-TOTAL. RW1044.2 +032800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RW1044.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1044.2 +033000 IF INSPECT-COUNTER EQUAL TO ZERO RW1044.2 +033100 MOVE "NO " TO ERROR-TOTAL RW1044.2 +033200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RW1044.2 +033300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RW1044.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1044.2 +033500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RW1044.2 +033600 WRITE-LINE. RW1044.2 +033700 ADD 1 TO RECORD-COUNT. RW1044.2 +033800Y IF RECORD-COUNT GREATER 50 RW1044.2 +033900Y MOVE DUMMY-RECORD TO DUMMY-HOLD RW1044.2 +034000Y MOVE SPACE TO DUMMY-RECORD RW1044.2 +034100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE RW1044.2 +034200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RW1044.2 +034300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RW1044.2 +034400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RW1044.2 +034500Y MOVE DUMMY-HOLD TO DUMMY-RECORD RW1044.2 +034600Y MOVE ZERO TO RECORD-COUNT. RW1044.2 +034700 PERFORM WRT-LN. RW1044.2 +034800 WRT-LN. RW1044.2 +034900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RW1044.2 +035000 MOVE SPACE TO DUMMY-RECORD. RW1044.2 +035100 BLANK-LINE-PRINT. RW1044.2 +035200 PERFORM WRT-LN. RW1044.2 +035300 FAIL-ROUTINE. RW1044.2 +035400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1044.2 +035500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RW1044.2 +035600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RW1044.2 +035700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1044.2 +035800 GO TO FAIL-ROUTINE-EX. RW1044.2 +035900 FAIL-ROUTINE-WRITE. RW1044.2 +036000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RW1044.2 +036100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RW1044.2 +036200 FAIL-ROUTINE-EX. EXIT. RW1044.2 +036300 BAIL-OUT. RW1044.2 +036400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RW1044.2 +036500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RW1044.2 +036600 BAIL-OUT-WRITE. RW1044.2 +036700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RW1044.2 +036800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RW1044.2 +036900 BAIL-OUT-EX. EXIT. RW1044.2 +037000 CCVS1-EXIT. RW1044.2 +037100 EXIT. RW1044.2 +037200 SECT-RW104-0001 SECTION. RW1044.2 +037300 RW104-INIT. RW1044.2 +037400 OPEN OUTPUT RW-FS4. RW1044.2 +037500 INIT-TEST-05. RW1044.2 +037600 INITIATE RW-FS4-REPORT-1. RW1044.2 +037700* RW1044.2 +037800* AFTER EXECUTION OF THE INITIATE STATEMENT FOR A REPORT, RW1044.2 +037900* THE REPORT LINE-COUNTER SHOULD BE ZERO AND PAGE-COUNTER RW1044.2 +038000* SHOULD BE ONE. RW1044.2 +038100* REFERENCE PAGE VIII-53, 3.2.4(1)B AND C, INITIATE STATEMENT RW1044.2 +038200* RW1044.2 +038300 INIT-TEST-05-01. RW1044.2 +038400 IF LINE-COUNTER IS EQUAL TO ZERO RW1044.2 +038500 PERFORM PASS RW1044.2 +038600 GO TO INIT-WRITE-05-01. RW1044.2 +038700 INIT-FAIL-05-01. RW1044.2 +038800 PERFORM FAIL. RW1044.2 +038900 MOVE ZERO TO CORRECT-18V0. RW1044.2 +039000 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1044.2 +039100 MOVE "LINE-COUNTER AFTER INITIATE" TO RE-MARK. RW1044.2 +039200 INIT-WRITE-05-01. RW1044.2 +039300 MOVE "INIT-TEST-05" TO PAR-NAME. RW1044.2 +039400 MOVE 1 TO REC-CT. RW1044.2 +039500 MOVE "INITIATE REPORT" TO FEATURE. RW1044.2 +039600 PERFORM PRINT-DETAIL. RW1044.2 +039700 INIT-TEST-05-02. RW1044.2 +039800 IF PAGE-COUNTER IS EQUAL TO 1 RW1044.2 +039900 PERFORM PASS RW1044.2 +040000 GO TO INIT-WRITE-05-02. RW1044.2 +040100 INIT-FAIL-05-02. RW1044.2 +040200 PERFORM FAIL. RW1044.2 +040300 MOVE 1 TO CORRECT-18V0. RW1044.2 +040400 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1044.2 +040500 MOVE "PAGE-COUNTER AFTER INITIATE" TO RE-MARK. RW1044.2 +040600 INIT-WRITE-05-02. RW1044.2 +040700 MOVE 2 TO REC-CT. RW1044.2 +040800 PERFORM PRINT-DETAIL. RW1044.2 +040900 GENER-TEST-14. RW1044.2 +041000* THIS TEST EXECUTES THE CHRONOLOGICALLY FIRST GENERATE RW1044.2 +041100* STATEMENT FOR THE REPORT RW-FS4-REPORT-1. RW1044.2 +041200* REFERENCE PAGE VIII-52, 3.1.4(5)B AND D, GENERATE STATEMENT RW1044.2 +041300* RW1044.2 +041400 ADD 1 TO WS-COUNTER. RW1044.2 +041500 GENERATE RW-FS4-DETAIL. RW1044.2 +041600* RW1044.2 +041700* OUTPUT REPORT INFORMATION RW1044.2 +041800* RW1044.2 +041900* THE PAGE HEADING REPORT GROUP IS PRESENTED ON LINE 1 RW1044.2 +042000* OF PAGE 1. RW1044.2 +042100* REFERENCE PAGE VIII-14, 2.5.5.7, PAGE HEADING PRE. RULES RW1044.2 +042200* RW1044.2 +042300* THE LINE-COUNTER VALUE PRINTED ON THE PH LINE SHOULD RW1044.2 +042400* EQUAL ONE. RW1044.2 +042500* REFERENCE PAGE VIII-5, 2.4.5(6), LINE-COUNTER RULES RW1044.2 +042600* RW1044.2 +042700* THE FIRST DETAIL LINE IS PRESENTED ON LINE 6 OF PAGE 1. RW1044.2 +042800* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULES RW1044.2 +042900* RW1044.2 +043000 GENER-TEST-14-01. RW1044.2 +043100 IF LINE-COUNTER IS EQUAL TO 6 RW1044.2 +043200 PERFORM PASS RW1044.2 +043300 GO TO GENER-WRITE-14-01. RW1044.2 +043400* RW1044.2 +043500* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1044.2 +043600* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1044.2 +043700* PRESENTED, IN THIS CASE 6. RW1044.2 +043800* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1044.2 +043900* RW1044.2 +044000 GENER-FAIL-14-01. RW1044.2 +044100 PERFORM FAIL. RW1044.2 +044200 MOVE 6 TO CORRECT-18V0. RW1044.2 +044300 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1044.2 +044400 MOVE "LINE-COUNTER AFTER FIRST GENER" TO RE-MARK. RW1044.2 +044500 GENER-WRITE-14-01. RW1044.2 +044600 MOVE "GENR-WRITE-14" TO PAR-NAME. RW1044.2 +044700 MOVE "FIRST GENERATE" TO FEATURE. RW1044.2 +044800 MOVE 1 TO REC-CT. RW1044.2 +044900 PERFORM PRINT-DETAIL. RW1044.2 +045000 GENER-TEST-14-02. RW1044.2 +045100 IF PAGE-COUNTER EQUAL TO 1 RW1044.2 +045200 PERFORM PASS RW1044.2 +045300 GO TO GENER-WRITE-14-02. RW1044.2 +045400* RW1044.2 +045500* EXECUTION OF THE FIRST GENERATE STATEMENT SHOULD NOT RW1044.2 +045600* CHANGE THE VALUE OF PAGE-COUNTER. IT SHOULD STILL BE RW1044.2 +045700* EQUAL TO ONE. RW1044.2 +045800* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES RW1044.2 +045900* RW1044.2 +046000 GENER-FAIL-14-02. RW1044.2 +046100 PERFORM FAIL. RW1044.2 +046200 MOVE 1 TO CORRECT-18V0. RW1044.2 +046300 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1044.2 +046400 MOVE "PAGE-COUNTER AFTER FIRST GENER" TO RE-MARK. RW1044.2 +046500 GENER-WRITE-14-02. RW1044.2 +046600 MOVE 2 TO REC-CT. RW1044.2 +046700 PERFORM PRINT-DETAIL. RW1044.2 +046800 GENER-TEST-15. RW1044.2 +046900* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1044.2 +047000* REPORT GROUP 19 TIMES. RW1044.2 +047100* REFERENCE PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1044.2 +047200* RW1044.2 +047300 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1044.2 +047400* RW1044.2 +047500* OUTPUT REPORT INFORMATION RW1044.2 +047600* NINETEEN DETAIL LINES SINGLE SPACED ARE PRESENTED ON RW1044.2 +047700* LINES 7 THROUGH 25 OF THE FIRST PAGE. RW1044.2 +047800* REFERENCE PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE. RULESRW1044.2 +047900* RW1044.2 +048000 GO TO GENER-TEST-15-01. RW1044.2 +048100 GENER-DETAIL-LINE. RW1044.2 +048200 ADD 1 TO WS-COUNTER. RW1044.2 +048300 GENERATE RW-FS4-DETAIL. RW1044.2 +048400 MOVE WS-COUNTER TO TEMP-COMP. RW1044.2 +048500 ADD 5 TO TEMP-COMP. RW1044.2 +048600 IF LINE-COUNTER NOT EQUAL TO TEMP-COMP RW1044.2 +048700 ADD 1 TO LC-ERRORS. RW1044.2 +048800* RW1044.2 +048900* THE LINE-COUNTER SETTING AFTER THE GENERATE STATEMENT RW1044.2 +049000* IS EQUAL TO THE LINE NUMBER ON WHICH THE PRINT LINE WAS RW1044.2 +049100* PRESENTED. THIS NUMBER IS FIVE GREATER THAN THE DETAIL RW1044.2 +049200* LINE NUMBER. RW1044.2 +049300* REFERENCE PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1044.2 +049400* RW1044.2 +049500 IF PAGE-COUNTER NOT EQUAL TO PAGENO RW1044.2 +049600 ADD 1 TO PC-ERRORS. RW1044.2 +049700* RW1044.2 +049800* EXECUTION OF A GENERATE STATEMENT WHICH DOES NOT CAUSE RW1044.2 +049900* PAGE ADVANCING SHOULD NOT CHANGE THE VALUE OF PAGE-COUNTER. RW1044.2 +050000* REFERENCE PAGE VIII-4, 2.4.4, PAGE-COUNTER RULES RW1044.2 +050100* RW1044.2 +050200 GENER-TEST-15-01. RW1044.2 +050300 IF LC-ERRORS EQUAL TO ZERO RW1044.2 +050400 PERFORM PASS RW1044.2 +050500 GO TO GENER-WRITE-15-01. RW1044.2 +050600 GENER-FAIL-15-01. RW1044.2 +050700 PERFORM FAIL. RW1044.2 +050800 MOVE LC-ERRORS TO COMPUTED-18V0. RW1044.2 +050900 MOVE ZERO TO CORRECT-18V0. RW1044.2 +051000 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +051100 GENER-WRITE-15-01. RW1044.2 +051200 MOVE "GENR-TEST-15" TO PAR-NAME. RW1044.2 +051300 MOVE "GENERATE 19 LINES" TO FEATURE. RW1044.2 +051400 MOVE 1 TO REC-CT. RW1044.2 +051500 PERFORM PRINT-DETAIL. RW1044.2 +051600 GENER-TEST-15-02. RW1044.2 +051700 IF PC-ERRORS EQUAL TO ZERO RW1044.2 +051800 PERFORM PASS RW1044.2 +051900 GO TO GENER-WRITE-15-02. RW1044.2 +052000 GENER-FAIL-15-02. RW1044.2 +052100 PERFORM FAIL. RW1044.2 +052200 MOVE PC-ERRORS TO COMPUTED-18V0. RW1044.2 +052300 MOVE ZERO TO CORRECT-18V0. RW1044.2 +052400 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +052500 GENER-WRITE-15-02. RW1044.2 +052600 MOVE 2 TO REC-CT. RW1044.2 +052700 PERFORM PRINT-DETAIL. RW1044.2 +052800 GENER-TEST-16. RW1044.2 +052900* RW1044.2 +053000* THIS TEST EXECUTES A GENERATE STATEMENT WHICH CAUSES RW1044.2 +053100* PAGE ADVANCING FROM PAGE 1 TO PAGE 2. THE PAGE FOOTING RW1044.2 +053200* REPORT GROUP SHOULD BE PRESENTED ON LINE 30 OF PAGE 1, THE RW1044.2 +053300* PAGE HEADINNG REPORT GROUP SHOULD BE PRESENTED ON LINE 1 RW1044.2 +053400* OF PAGE 2 AND THE DETAIL REPORT GROUP SHOULD BE PRESENTED RW1044.2 +053500* ON LINE 6 OF PAGE 2. RW1044.2 +053600* REFERENCES PAGE VIII-51, 3.1.4(4), GENERATE STATEMENT RW1044.2 +053700* PAGE VIII-14, 2.5.5.7, PH PRESENTATION RULES RW1044.2 +053800* PAGE VIII-17, 2.5.5.8, BODY GROUP PRE. RULES RW1044.2 +053900* PAGE VIII-20, 2.5.5.9, PF PRESENTATION RULES RW1044.2 +054000* RW1044.2 +054100 MOVE 1 TO WS-COUNTER. RW1044.2 +054200 GENERATE RW-FS4-DETAIL. RW1044.2 +054300 GENER-TEST-16-01. RW1044.2 +054400 IF LINE-COUNTER EQUAL TO 6 RW1044.2 +054500 PERFORM PASS RW1044.2 +054600 GO TO GENER-WRITE-16-01. RW1044.2 +054700* RW1044.2 +054800* LINE-COUNTER SHOULD BE RESET TO ZERO WHEN THE PAGE RW1044.2 +054900* ADVANCE FROM PAGE 1 TO PAGE 2 IS EXECUTED, AND LINE-COUNTER RW1044.2 +055000* IS SET TO 6 WHEN THE DETAIL REPORT GROUP IS PRESENTED. RW1044.2 +055100* REFERENCES PAGE VIII-5, 2.4.5(4), LINE-COUNTER RULES RW1044.2 +055200* PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1044.2 +055300* RW1044.2 +055400 GENER-FAIL-16-01. RW1044.2 +055500 PERFORM FAIL. RW1044.2 +055600 MOVE 6 TO CORRECT-18V0. RW1044.2 +055700 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1044.2 +055800 MOVE "LINE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1044.2 +055900 GENER-WRITE-16-01. RW1044.2 +056000 MOVE "GENR-TEST-16" TO PAR-NAME. RW1044.2 +056100 MOVE "PAGE ADVANCE" TO FEATURE. RW1044.2 +056200 MOVE 1 TO REC-CT. RW1044.2 +056300 PERFORM PRINT-DETAIL. RW1044.2 +056400 GENER-TEST-16-02. RW1044.2 +056500 IF PAGE-COUNTER EQUAL TO 2 RW1044.2 +056600 PERFORM PASS RW1044.2 +056700 GO TO GENER-WRITE-16-02. RW1044.2 +056800* RW1044.2 +056900* PAGE-COUNTER SHOULD BE INCREMENTED TO 2 WHEN THE PAGE RW1044.2 +057000* ADVANCE FROM PAGE 1 TO PAGE 2 IS EXECUTED. RW1044.2 +057100* REFERENCE PAGE VIII-5, 2.4.4(5), PAGE-COUNTER RULES RW1044.2 +057200* RW1044.2 +057300 GENER-FAIL-16-02. RW1044.2 +057400 PERFORM FAIL. RW1044.2 +057500 MOVE 2 TO CORRECT-18V0. RW1044.2 +057600 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1044.2 +057700 MOVE "PAGE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1044.2 +057800 GENER-WRITE-16-02. RW1044.2 +057900 MOVE 2 TO REC-CT. RW1044.2 +058000 PERFORM PRINT-DETAIL. RW1044.2 +058100 GENER-TEST-17. RW1044.2 +058200* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1044.2 +058300* REPORT GROUP 19 TIMES. NINETEEN DETAIL LINES SINGLE SPACED RW1044.2 +058400* ARE PRESENTED ON LINES 7 THROUGH 25 OF THE SECOND REPORT RW1044.2 +058500* PAGE. RW1044.2 +058600* REFERENCES PAGE VIII-51, 3.1.4(2), (6)B, GENERATE STATEMENT RW1044.2 +058700* PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULESRW1044.2 +058800* RW1044.2 +058900 MOVE 2 TO PAGENO. RW1044.2 +059000 MOVE ZERO TO LC-ERRORS PC-ERRORS. RW1044.2 +059100 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1044.2 +059200 GENER-TEST-17-01. RW1044.2 +059300 IF LC-ERRORS EQUAL TO ZERO RW1044.2 +059400 PERFORM PASS RW1044.2 +059500 GO TO GENER-WRITE-17-01. RW1044.2 +059600 GENER-FAIL-17-01. RW1044.2 +059700 PERFORM FAIL. RW1044.2 +059800 MOVE LC-ERRORS TO COMPUTED-18V0. RW1044.2 +059900 MOVE ZERO TO CORRECT-18V0. RW1044.2 +060000 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +060100 GENER-WRITE-17-01. RW1044.2 +060200 MOVE "GENR-TEST-17" TO PAR-NAME. RW1044.2 +060300 MOVE 1 TO REC-CT. RW1044.2 +060400 MOVE "GENERATE 19 LINES" TO FEATURE. RW1044.2 +060500 PERFORM PRINT-DETAIL. RW1044.2 +060600 GENER-TEST-17-02. RW1044.2 +060700 IF PC-ERRORS EQUAL TO ZERO RW1044.2 +060800 PERFORM PASS RW1044.2 +060900 GO TO GENER-WRITE-17-02. RW1044.2 +061000 GENER-FAIL-17-02. RW1044.2 +061100 PERFORM FAIL. RW1044.2 +061200 MOVE PC-ERRORS TO COMPUTED-18V0. RW1044.2 +061300 MOVE ZERO TO CORRECT-18V0. RW1044.2 +061400 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +061500 GENER-WRITE-17-02. RW1044.2 +061600 MOVE 2 TO REC-CT. RW1044.2 +061700 PERFORM PRINT-DETAIL. RW1044.2 +061800 GENER-TEST-18. RW1044.2 +061900* THIS TEST EXECUTES A GENERATE STATEMENT WHICH CAUSES RW1044.2 +062000* PAGE ADVANCING FROM PAGE 2 TO PAGE 3. THE PAGE FOOTING RW1044.2 +062100* REPORT GROUP SHOULD BE PRESENTED ON LINE 30 OF PAGE 2, THE RW1044.2 +062200* PAGE HEADING REPORT GROUP SHOULD BE PRESENTED ON LINE 1 RW1044.2 +062300* OF PAGE 3 AND THE DETAIL REPORT GROUP SHOULD BE PRESENTED RW1044.2 +062400* ON LINE 6 OF PAGE 3. RW1044.2 +062500* REFERENCES PAGE VIII-51, 3.1.4(4), GENERATE STATEMENT RW1044.2 +062600* PAGE VIII-14, 2.5.5.7, PH PRESENTATION RULES RW1044.2 +062700* PAGE VIII-17, 2.5.5.8, BODY GROUP PRE. RULES RW1044.2 +062800* PAGE VIII-20, 2.5.5.9, PF PRESENTATION RULES RW1044.2 +062900* RW1044.2 +063000 MOVE 1 TO WS-COUNTER. RW1044.2 +063100 GENERATE RW-FS4-DETAIL. RW1044.2 +063200 GENER-TEST-18-01. RW1044.2 +063300 IF LINE-COUNTER EQUAL TO 6 RW1044.2 +063400 PERFORM PASS RW1044.2 +063500 GO TO GENER-WRITE-18-01. RW1044.2 +063600* RW1044.2 +063700* LINE-COUNTER SHOULD BE RESET TO ZERO WHEN THE PAGE RW1044.2 +063800* ADVANCE FROM PAGE 2 TO PAGE 3 IS EXECUTED, AND LINE-COUNTER RW1044.2 +063900* IS SET TO 6 WHEN THE DETAIL REPORT GROUP IS PRESENTED. RW1044.2 +064000* REFERENCES PAGE VIII-5, 2.4.5(4), LINE-COUNTER RULES RW1044.2 +064100* PAGE VIII-19, 2.5.5.8.1(6)D, FINAL L-C SETTING RW1044.2 +064200* RW1044.2 +064300 GENER-FAIL-18-01. RW1044.2 +064400 PERFORM FAIL. RW1044.2 +064500 MOVE 6 TO CORRECT-18V0. RW1044.2 +064600 MOVE LINE-COUNTER TO COMPUTED-18V0. RW1044.2 +064700 MOVE "LINE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1044.2 +064800 GENER-WRITE-18-01. RW1044.2 +064900 MOVE "GENR-TEST-18" TO PAR-NAME. RW1044.2 +065000 MOVE "PAGE ADVANCE" TO FEATURE. RW1044.2 +065100 MOVE 1 TO REC-CT. RW1044.2 +065200 PERFORM PRINT-DETAIL. RW1044.2 +065300 GENER-TEST-18-02. RW1044.2 +065400 IF PAGE-COUNTER EQUAL TO 3 RW1044.2 +065500 PERFORM PASS RW1044.2 +065600 GO TO GENER-WRITE-18-02. RW1044.2 +065700* RW1044.2 +065800* PAGE-COUNTER SHOULD BE INCREMENTED TO 3 WHEN THE PAGE RW1044.2 +065900* ADVANCE FROM PAGE 2 TO PAGE 3 IS EXECUTED. RW1044.2 +066000* REFERENCES PAGE VIII-5, 2.4.4(5), PAGE-COUNTER RULES RW1044.2 +066100* RW1044.2 +066200 GENER-FAIL-18-02. RW1044.2 +066300 PERFORM FAIL. RW1044.2 +066400 MOVE 3 TO CORRECT-18V0. RW1044.2 +066500 MOVE PAGE-COUNTER TO COMPUTED-18V0. RW1044.2 +066600 MOVE "PAGE-COUNTER AFTER PAGE ADVANCE" TO RE-MARK. RW1044.2 +066700 GENER-WRITE-18-02. RW1044.2 +066800 MOVE 2 TO REC-CT. RW1044.2 +066900 PERFORM PRINT-DETAIL. RW1044.2 +067000 GENER-TEST-19. RW1044.2 +067100* THIS TEST EXECUTES A GENERATE STATEMENT FOR THE DETAIL RW1044.2 +067200* REPORT GROUP 19 TIMES. NINETEEN DETAIL LINES SINGLE SPACED RW1044.2 +067300* ARE PRESENTED ON LINES 7 THROUGH 25 OF THE THIRD REPORT RW1044.2 +067400* PAGE. RW1044.2 +067500* REFERENCES PAGE VIII-51, 3.1.4(2),(6), GENERATE STATEMENT RW1044.2 +067600* PAGE VIII-18, 2.5.5.8.1(4)B, BODY GROUP PRE RULESRW1044.2 +067700* RW1044.2 +067800 MOVE 3 TO PAGENO. RW1044.2 +067900 MOVE ZERO TO LC-ERRORS. RW1044.2 +068000 MOVE ZERO TO PC-ERRORS. RW1044.2 +068100 PERFORM GENER-DETAIL-LINE 19 TIMES. RW1044.2 +068200 GENER-TEST-19-01. RW1044.2 +068300 IF LC-ERRORS EQUAL TO ZERO RW1044.2 +068400 PERFORM PASS RW1044.2 +068500 GO TO GENER-WRITE-19-01. RW1044.2 +068600 GENER-FAIL-19-01. RW1044.2 +068700 PERFORM FAIL. RW1044.2 +068800 MOVE LC-ERRORS TO COMPUTED-18V0. RW1044.2 +068900 MOVE ZERO TO CORRECT-18V0. RW1044.2 +069000 MOVE "NUMBER OF LINE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +069100 GENER-WRITE-19-01. RW1044.2 +069200 MOVE "GENR-TEST-19" TO PAR-NAME. RW1044.2 +069300 MOVE 1 TO REC-CT. RW1044.2 +069400 MOVE "GENERATE 19 LINES" TO FEATURE. RW1044.2 +069500 PERFORM PRINT-DETAIL. RW1044.2 +069600 GENER-TEST-19-02. RW1044.2 +069700 IF PC-ERRORS EQUAL TO ZERO RW1044.2 +069800 PERFORM PASS RW1044.2 +069900 GO TO GENER-WRITE-19-02. RW1044.2 +070000 GENER-FAIL-19-02. RW1044.2 +070100 PERFORM FAIL. RW1044.2 +070200 MOVE PC-ERRORS TO COMPUTED-18V0. RW1044.2 +070300 MOVE ZERO TO CORRECT-18V0. RW1044.2 +070400 MOVE "NUMBER OF PAGE-COUNTER ERRORS" TO RE-MARK. RW1044.2 +070500 GENER-WRITE-19-02. RW1044.2 +070600 MOVE 2 TO REC-CT. RW1044.2 +070700 PERFORM PRINT-DETAIL. RW1044.2 +070800 TERM-TEST-04. RW1044.2 +070900* THE TERMINATE STATEMENT SHOULD PRODUCE THE PAGE FOOTING RW1044.2 +071000* REPORT GROUP ON LINE 30 OF PAGE 3. RW1044.2 +071100* REFERENCES PAGE VIII-55, 3.4, TERMINATE STATEMENT RW1044.2 +071200* PAGE VIII-47, 2.21.4(7), TYPE CLAUSE GEN. RULES RW1044.2 +071300* RW1044.2 +071400 TERMINATE RW-FS4-REPORT-1. RW1044.2 +071500 MOVE ZERO TO REC-CT. RW1044.2 +071600 TERM-WRITE-04. RW1044.2 +071700 MOVE "TERMINATE REPORT" TO FEATURE. RW1044.2 +071800 MOVE "TERM-TEST-04" TO PAR-NAME. RW1044.2 +071900 MOVE "3 PAGE REPORT" TO COMPUTED-A. RW1044.2 +072000 MOVE "20 DE LINES PER PAGE" TO CORRECT-A. RW1044.2 +072100 MOVE "CHECK RWCS OUTPUT REPORT" TO RE-MARK. RW1044.2 +072200 PERFORM PRINT-DETAIL. RW1044.2 +072300 CLOSE-RW-FS4. RW1044.2 +072400 CLOSE RW-FS4. RW1044.2 +072500 EXIT-RW104. RW1044.2 +072600 EXIT. RW1044.2 +072700 CCVS-EXIT SECTION. RW1044.2 +072800 CCVS-999999. RW1044.2 +072900 GO TO CLOSE-FILES. RW1044.2 +*END-OF,RW104A +*HEADER,COBOL,RW301M +000100 IDENTIFICATION DIVISION. RW3014.2 +000200 PROGRAM-ID. RW3014.2 +000300 RW301M. RW3014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RW3014.2 +000500*FEATURES THAT ARE USED IN REPORT WRITING. RW3014.2 +000600 ENVIRONMENT DIVISION. RW3014.2 +000700 CONFIGURATION SECTION. RW3014.2 +000800 SOURCE-COMPUTER. RW3014.2 +000900 XXXXX082. RW3014.2 +001000 OBJECT-COMPUTER. RW3014.2 +001100 XXXXX083. RW3014.2 +001200 INPUT-OUTPUT SECTION. RW3014.2 +001300 FILE-CONTROL. RW3014.2 +001400 SELECT TFIL ASSIGN RW3014.2 +001500 XXXXX001 RW3014.2 +001600 ORGANIZATION IS SEQUENTIAL RW3014.2 +001700 ACCESS MODE IS SEQUENTIAL. RW3014.2 +001800 RW3014.2 +001900 SELECT TFIL2 ASSIGN RW3014.2 +002000 XXXXX002 RW3014.2 +002100 ORGANIZATION IS SEQUENTIAL RW3014.2 +002200 ACCESS MODE IS SEQUENTIAL. RW3014.2 +002300 RW3014.2 +002400 RW3014.2 +002500 I-O-CONTROL. RW3014.2 +002600 MULTIPLE FILE TAPE CONTAINS TFIL2. RW3014.2 +002700 RW3014.2 +002800 DATA DIVISION. RW3014.2 +002900 FILE SECTION. RW3014.2 +003000 FD TFIL RW3014.2 +003100 LABEL RECORDS STANDARD RW3014.2 +003200 VALUE OF RW3014.2 +003300 XXXXX074 RW3014.2 +003400 IS RW3014.2 +003500 XXXXX075. RW3014.2 +003600 RW3014.2 +003700 RW3014.2 +003800 01 FREC. RW3014.2 +003900 03 RKEY PIC 9(8). RW3014.2 +004000 RW3014.2 +004100 FD TFIL2 RW3014.2 +004200 REPORT IS RFIL2. RW3014.2 +004300*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +004400 RW3014.2 +004500 WORKING-STORAGE SECTION. RW3014.2 +004600 RW3014.2 +004700 01 VARIABLES. RW3014.2 +004800 03 VKEY PIC 9(8) VALUE ZERO. RW3014.2 +004900 RW3014.2 +005000 REPORT SECTION. RW3014.2 +005100*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +005200 RD RFIL2. RW3014.2 +005300*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +005400 01 RREC RW3014.2 +005500 TYPE IS DETAIL. RW3014.2 +005600*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +005700 02 PIC 9(8) RW3014.2 +005800 SOURCE IS RKEY RW3014.2 +005900*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +006000 COLUMN NUMBER IS 1 RW3014.2 +006100*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +006200 LINE NUMBER IS PLUS 1. RW3014.2 +006300*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +006400 RW3014.2 +006500 PROCEDURE DIVISION. RW3014.2 +006600 RW3014.2 +006700 RW301M-CONTROL. RW3014.2 +006800 OPEN INPUT TFIL. RW3014.2 +006900 READ TFIL RW3014.2 +007000 AT END RW3014.2 +007100 GO TO RW301M-END. RW3014.2 +007200 OPEN OUTPUT TFIL2. RW3014.2 +007300 INITIATE RFIL2. RW3014.2 +007400*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +007500 GENERATE RREC. RW3014.2 +007600*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +007700 TERMINATE RFIL2. RW3014.2 +007800*Message expected for above statement: NON-CONFORMING STANDARD RW3014.2 +007900 RW301M-END. RW3014.2 +008000 CLOSE TFIL, TFIL2. RW3014.2 +008100 STOP RUN. RW3014.2 +008200 RW3014.2 +008300 RW3014.2 +008400*TOTAL NUMBER OF FLAGS EXPECTED = 10 RW3014.2 +*END-OF,RW301M +*HEADER,COBOL,RW302M +000100 IDENTIFICATION DIVISION. RW3024.2 +000200 PROGRAM-ID. RW3024.2 +000300 RW302M. RW3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RW3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN REPORT RW3024.2 +000600*WRITING. RW3024.2 +000700 ENVIRONMENT DIVISION. RW3024.2 +000800 CONFIGURATION SECTION. RW3024.2 +000900 SOURCE-COMPUTER. RW3024.2 +001000 XXXXX082. RW3024.2 +001100 OBJECT-COMPUTER. RW3024.2 +001200 XXXXX083. RW3024.2 +001300 INPUT-OUTPUT SECTION. RW3024.2 +001400 FILE-CONTROL. RW3024.2 +001500 SELECT TFIL ASSIGN RW3024.2 +001600 XXXXX001 RW3024.2 +001700 ORGANIZATION IS SEQUENTIAL RW3024.2 +001800 ACCESS MODE IS SEQUENTIAL. RW3024.2 +001900 RW3024.2 +002000 SELECT TFIL2 ASSIGN RW3024.2 +002100 XXXXX002 RW3024.2 +002200 ORGANIZATION IS SEQUENTIAL RW3024.2 +002300 ACCESS MODE IS SEQUENTIAL. RW3024.2 +002400 RW3024.2 +002500 RW3024.2 +002600 I-O-CONTROL. RW3024.2 +002700 MULTIPLE FILE TAPE CONTAINS TFIL. RW3024.2 +002800*Message expected for above statement: OBSOLETE RW3024.2 +002900 RW3024.2 +003000 RW3024.2 +003100 DATA DIVISION. RW3024.2 +003200 FILE SECTION. RW3024.2 +003300 FD TFIL RW3024.2 +003400 LABEL RECORDS STANDARD RW3024.2 +003500*Message expected for above statement: OBSOLETE RW3024.2 +003600 VALUE OF RW3024.2 +003700 XXXXX074 RW3024.2 +003800 IS RW3024.2 +003900 XXXXX075. RW3024.2 +004000*Message expected for above statement: OBSOLETE RW3024.2 +004100 RW3024.2 +004200 RW3024.2 +004300 01 FREC. RW3024.2 +004400 03 RKEY PIC 9(8). RW3024.2 +004500 RW3024.2 +004600 FD TFIL2 RW3024.2 +004700 REPORT IS RFIL2. RW3024.2 +004800 RW3024.2 +004900 WORKING-STORAGE SECTION. RW3024.2 +005000 RW3024.2 +005100 01 VARIABLES. RW3024.2 +005200 03 VKEY PIC 9(8) VALUE ZERO. RW3024.2 +005300 RW3024.2 +005400 REPORT SECTION. RW3024.2 +005500 RD RFIL2. RW3024.2 +005600 01 RREC RW3024.2 +005700 TYPE IS DETAIL. RW3024.2 +005800 02 PIC 9(8) RW3024.2 +005900 SOURCE IS RKEY RW3024.2 +006000 LINE NUMBER IS PLUS 1 RW3024.2 +006100 COLUMN NUMBER IS 1. RW3024.2 +006200 RW3024.2 +006300 PROCEDURE DIVISION. RW3024.2 +006400 RW3024.2 +006500 RW302M-CONTROL. RW3024.2 +006600 OPEN INPUT TFIL. RW3024.2 +006700 READ TFIL RW3024.2 +006800 AT END RW3024.2 +006900 GO TO RW302M-END. RW3024.2 +007000 OPEN OUTPUT TFIL2. RW3024.2 +007100 INITIATE RFIL2. RW3024.2 +007200 GENERATE RREC. RW3024.2 +007300 TERMINATE RFIL2. RW3024.2 +007400 RW302M-END. RW3024.2 +007500 CLOSE TFIL, TFIL2. RW3024.2 +007600 STOP RUN. RW3024.2 +007700 RW3024.2 +007800 RW3024.2 +007900*TOTAL NUMBER OF FLAGS EXPECTED = 3. RW3024.2 +*END-OF,RW302M +*HEADER,COBOL,SG101A +000100 IDENTIFICATION DIVISION. SG1014.2 +000200 PROGRAM-ID. SG1014.2 +000300 SG101A. SG1014.2 +000400 AUTHOR. SG1014.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1014.2 +000600 INSTALLATION. SG1014.2 +000700 GENERAL SERVICES ADMINISTRATION SG1014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1014.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1014.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1014.2 +001200 SG1014.2 +001300 PHONE (703) 756-6153 SG1014.2 +001400 SG1014.2 +001500 " HIGH ". SG1014.2 +001600 DATE-WRITTEN. SG1014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1014.2 +001800 CREATION DATE / VALIDATION DATE SG1014.2 +001900 "4.2 ". SG1014.2 +002000 SECURITY. SG1014.2 +002100 NONE. SG1014.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1014.2 +002300 THE ABILITY OF THE COMPILER TO ACCEPT 100 SEGMENTS SG1014.2 +002400 AND REFERENCE SEGMENTS GREATER THAN 49 IN THEIR INITIAL SG1014.2 +002500 STATE WITH SEGMENTS LESS THAN 50 IN THEIR LAST-USED SG1014.2 +002600 STATE SG1014.2 +002700 SG1014.2 +002800 ENVIRONMENT DIVISION. SG1014.2 +002900 CONFIGURATION SECTION. SG1014.2 +003000 SOURCE-COMPUTER. SG1014.2 +003100 XXXXX082. SG1014.2 +003200 OBJECT-COMPUTER. SG1014.2 +003300 XXXXX083. SG1014.2 +003400 INPUT-OUTPUT SECTION. SG1014.2 +003500 FILE-CONTROL. SG1014.2 +003600 SELECT PRINT-FILE ASSIGN TO SG1014.2 +003700 XXXXX055. SG1014.2 +003800 DATA DIVISION. SG1014.2 +003900 FILE SECTION. SG1014.2 +004000 FD PRINT-FILE SG1014.2 +004100 LABEL RECORDS SG1014.2 +004200 XXXXX084 SG1014.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1014.2 +004400 01 PRINT-REC PICTURE X(120). SG1014.2 +004500 01 DUMMY-RECORD PICTURE X(120). SG1014.2 +004600 WORKING-STORAGE SECTION. SG1014.2 +004700 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG1014.2 +004800 01 TEST-RESULTS. SG1014.2 +004900 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005000 02 FEATURE PICTURE X(20) VALUE SPACE. SG1014.2 +005100 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005200 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1014.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005400 02 PAR-NAME. SG1014.2 +005500 03 FILLER PICTURE X(12) VALUE SPACE. SG1014.2 +005600 03 PARDOT-X PICTURE X VALUE SPACE. SG1014.2 +005700 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1014.2 +005800 03 FILLER PIC X(5) VALUE SPACE. SG1014.2 +005900 02 FILLER PIC X(10) VALUE SPACE. SG1014.2 +006000 02 RE-MARK PIC X(61). SG1014.2 +006100 01 TEST-COMPUTED. SG1014.2 +006200 02 FILLER PIC X(30) VALUE SPACE. SG1014.2 +006300 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1014.2 +006400 02 COMPUTED-X. SG1014.2 +006500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1014.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1014.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1014.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1014.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1014.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. SG1014.2 +007100 04 COMPUTED-18V0 PICTURE -9(18). SG1014.2 +007200 04 FILLER PICTURE X. SG1014.2 +007300 03 FILLER PIC X(50) VALUE SPACE. SG1014.2 +007400 01 TEST-CORRECT. SG1014.2 +007500 02 FILLER PIC X(30) VALUE SPACE. SG1014.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". SG1014.2 +007700 02 CORRECT-X. SG1014.2 +007800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1014.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1014.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1014.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1014.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1014.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. SG1014.2 +008400 04 CORRECT-18V0 PICTURE -9(18). SG1014.2 +008500 04 FILLER PICTURE X. SG1014.2 +008600 03 FILLER PIC X(50) VALUE SPACE. SG1014.2 +008700 01 CCVS-C-1. SG1014.2 +008800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1014.2 +008900- "SS PARAGRAPH-NAME SG1014.2 +009000- " REMARKS". SG1014.2 +009100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1014.2 +009200 01 CCVS-C-2. SG1014.2 +009300 02 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +009400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1014.2 +009500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1014.2 +009600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1014.2 +009700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1014.2 +009800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1014.2 +009900 01 REC-CT PICTURE 99 VALUE ZERO. SG1014.2 +010000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1014.2 +010100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1014.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1014.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1014.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1014.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1014.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1014.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1014.2 +010800 01 CCVS-H-1. SG1014.2 +010900 02 FILLER PICTURE X(27) VALUE SPACE. SG1014.2 +011000 02 FILLER PICTURE X(67) VALUE SG1014.2 +011100 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1014.2 +011200- " SYSTEM". SG1014.2 +011300 02 FILLER PICTURE X(26) VALUE SPACE. SG1014.2 +011400 01 CCVS-H-2. SG1014.2 +011500 02 FILLER PICTURE X(52) VALUE IS SG1014.2 +011600 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1014.2 +011700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1014.2 +011800 02 TEST-ID PICTURE IS X(9). SG1014.2 +011900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1014.2 +012000 01 CCVS-H-3. SG1014.2 +012100 02 FILLER PICTURE X(34) VALUE SG1014.2 +012200 " FOR OFFICIAL USE ONLY ". SG1014.2 +012300 02 FILLER PICTURE X(58) VALUE SG1014.2 +012400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1014.2 +012500 02 FILLER PICTURE X(28) VALUE SG1014.2 +012600 " COPYRIGHT 1974 ". SG1014.2 +012700 01 CCVS-E-1. SG1014.2 +012800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1014.2 +012900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1014.2 +013000 02 ID-AGAIN PICTURE IS X(9). SG1014.2 +013100 02 FILLER PICTURE X(45) VALUE IS SG1014.2 +013200 " NTIS DISTRIBUTION COBOL 74". SG1014.2 +013300 01 CCVS-E-2. SG1014.2 +013400 02 FILLER PICTURE X(31) VALUE SG1014.2 +013500 SPACE. SG1014.2 +013600 02 FILLER PICTURE X(21) VALUE SPACE. SG1014.2 +013700 02 CCVS-E-2-2. SG1014.2 +013800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1014.2 +013900 03 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +014000 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1014.2 +014100 01 CCVS-E-3. SG1014.2 +014200 02 FILLER PICTURE X(22) VALUE SG1014.2 +014300 " FOR OFFICIAL USE ONLY". SG1014.2 +014400 02 FILLER PICTURE X(12) VALUE SPACE. SG1014.2 +014500 02 FILLER PICTURE X(58) VALUE SG1014.2 +014600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1014.2 +014700 02 FILLER PICTURE X(13) VALUE SPACE. SG1014.2 +014800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1014.2 +014900 01 CCVS-E-4. SG1014.2 +015000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1014.2 +015100 02 FILLER PIC XXXX VALUE " OF ". SG1014.2 +015200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1014.2 +015300 02 FILLER PIC X(40) VALUE SG1014.2 +015400 " TESTS WERE EXECUTED SUCCESSFULLY". SG1014.2 +015500 01 XXINFO. SG1014.2 +015600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1014.2 +015700 02 INFO-TEXT. SG1014.2 +015800 04 FILLER PIC X(20) VALUE SPACE. SG1014.2 +015900 04 XXCOMPUTED PIC X(20). SG1014.2 +016000 04 FILLER PIC X(5) VALUE SPACE. SG1014.2 +016100 04 XXCORRECT PIC X(20). SG1014.2 +016200 01 HYPHEN-LINE. SG1014.2 +016300 02 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +016400 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1014.2 +016500- "*****************************************". SG1014.2 +016600 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1014.2 +016700- "******************************". SG1014.2 +016800 01 CCVS-PGM-ID PIC X(6) VALUE SG1014.2 +016900 "SG101A". SG1014.2 +017000 PROCEDURE DIVISION. SG1014.2 +017100 CCVS1 SECTION. SG1014.2 +017200 OPEN-FILES. SG1014.2 +017300 OPEN OUTPUT PRINT-FILE. SG1014.2 +017400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1014.2 +017500 MOVE SPACE TO TEST-RESULTS. SG1014.2 +017600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1014.2 +017700 GO TO CCVS1-EXIT. SG1014.2 +017800 CLOSE-FILES. SG1014.2 +017900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1014.2 +018000 TERMINATE-CCVS. SG1014.2 +018100S EXIT PROGRAM. SG1014.2 +018200STERMINATE-CALL. SG1014.2 +018300 STOP RUN. SG1014.2 +018400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1014.2 +018500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1014.2 +018600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1014.2 +018700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1014.2 +018800 MOVE "****TEST DELETED****" TO RE-MARK. SG1014.2 +018900 PRINT-DETAIL. SG1014.2 +019000 IF REC-CT NOT EQUAL TO ZERO SG1014.2 +019100 MOVE "." TO PARDOT-X SG1014.2 +019200 MOVE REC-CT TO DOTVALUE. SG1014.2 +019300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1014.2 +019400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1014.2 +019500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1014.2 +019600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1014.2 +019700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1014.2 +019800 MOVE SPACE TO CORRECT-X. SG1014.2 +019900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1014.2 +020000 MOVE SPACE TO RE-MARK. SG1014.2 +020100 HEAD-ROUTINE. SG1014.2 +020200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +020300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1014.2 +020400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1014.2 +020500 COLUMN-NAMES-ROUTINE. SG1014.2 +020600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +020700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +020800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +020900 END-ROUTINE. SG1014.2 +021000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1014.2 +021100 END-RTN-EXIT. SG1014.2 +021200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +021300 END-ROUTINE-1. SG1014.2 +021400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1014.2 +021500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1014.2 +021600 ADD PASS-COUNTER TO ERROR-HOLD. SG1014.2 +021700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1014.2 +021800 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1014.2 +021900 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1014.2 +022000 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1014.2 +022100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1014.2 +022200 END-ROUTINE-12. SG1014.2 +022300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1014.2 +022400 IF ERROR-COUNTER IS EQUAL TO ZERO SG1014.2 +022500 MOVE "NO " TO ERROR-TOTAL SG1014.2 +022600 ELSE SG1014.2 +022700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1014.2 +022800 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1014.2 +022900 PERFORM WRITE-LINE. SG1014.2 +023000 END-ROUTINE-13. SG1014.2 +023100 IF DELETE-CNT IS EQUAL TO ZERO SG1014.2 +023200 MOVE "NO " TO ERROR-TOTAL ELSE SG1014.2 +023300 MOVE DELETE-CNT TO ERROR-TOTAL. SG1014.2 +023400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1014.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +023600 IF INSPECT-COUNTER EQUAL TO ZERO SG1014.2 +023700 MOVE "NO " TO ERROR-TOTAL SG1014.2 +023800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1014.2 +023900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1014.2 +024000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +024100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +024200 WRITE-LINE. SG1014.2 +024300 ADD 1 TO RECORD-COUNT. SG1014.2 +024400Y IF RECORD-COUNT GREATER 50 SG1014.2 +024500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1014.2 +024600Y MOVE SPACE TO DUMMY-RECORD SG1014.2 +024700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1014.2 +024800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1014.2 +024900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1014.2 +025000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1014.2 +025100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1014.2 +025200Y MOVE ZERO TO RECORD-COUNT. SG1014.2 +025300 PERFORM WRT-LN. SG1014.2 +025400 WRT-LN. SG1014.2 +025500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1014.2 +025600 MOVE SPACE TO DUMMY-RECORD. SG1014.2 +025700 BLANK-LINE-PRINT. SG1014.2 +025800 PERFORM WRT-LN. SG1014.2 +025900 FAIL-ROUTINE. SG1014.2 +026000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1014.2 +026100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1014.2 +026200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1014.2 +026300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +026400 GO TO FAIL-ROUTINE-EX. SG1014.2 +026500 FAIL-ROUTINE-WRITE. SG1014.2 +026600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1014.2 +026700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1014.2 +026800 FAIL-ROUTINE-EX. EXIT. SG1014.2 +026900 BAIL-OUT. SG1014.2 +027000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1014.2 +027100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1014.2 +027200 BAIL-OUT-WRITE. SG1014.2 +027300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1014.2 +027400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +027500 BAIL-OUT-EX. EXIT. SG1014.2 +027600 CCVS1-EXIT. SG1014.2 +027700 EXIT. SG1014.2 +027800 SECT-SG-01-001 SECTION 00. SG1014.2 +027900 SG-01-001. SG1014.2 +028000 MOVE "SEGMENTATION" TO FEATURE. SG1014.2 +028100 GO TO SEG-TEST-1. SG1014.2 +028200 00 SECTION 00. SG1014.2 +028300 PARA-00. SG1014.2 +028400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +028500 RUN-THE-TESTS SECTION. SG1014.2 +028600 SEG-TEST-1. SG1014.2 +028700 MOVE SPACE TO TEST-CHECK. SG1014.2 +028800 PERFORM 00. SG1014.2 +028900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +029000 PERFORM PASS SG1014.2 +029100 GO TO SEG-WRITE-1. SG1014.2 +029200 MOVE SPACE TO COMPUTED-A. SG1014.2 +029300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +029400 PERFORM FAIL. SG1014.2 +029500 GO TO SEG-WRITE-1. SG1014.2 +029600 SEG-DELETE-1. SG1014.2 +029700 PERFORM DE-LETE. SG1014.2 +029800 SEG-WRITE-1. SG1014.2 +029900 MOVE "SEG-TEST-1 " TO PAR-NAME. SG1014.2 +030000 PERFORM PRINT-DETAIL. SG1014.2 +030100 SEG-TEST-2. SG1014.2 +030200 MOVE SPACE TO TEST-CHECK. SG1014.2 +030300 PERFORM 01. SG1014.2 +030400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +030500 PERFORM PASS SG1014.2 +030600 GO TO SEG-WRITE-2. SG1014.2 +030700 MOVE SPACE TO COMPUTED-A. SG1014.2 +030800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +030900 PERFORM FAIL. SG1014.2 +031000 GO TO SEG-WRITE-2. SG1014.2 +031100 SEG-DELETE-2. SG1014.2 +031200 PERFORM DE-LETE. SG1014.2 +031300 SEG-WRITE-2. SG1014.2 +031400 MOVE "SEG-TEST-2 " TO PAR-NAME. SG1014.2 +031500 PERFORM PRINT-DETAIL. SG1014.2 +031600 SEG-TEST-3. SG1014.2 +031700 MOVE SPACE TO TEST-CHECK. SG1014.2 +031800 PERFORM 02. SG1014.2 +031900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +032000 PERFORM PASS SG1014.2 +032100 GO TO SEG-WRITE-3. SG1014.2 +032200 MOVE SPACE TO COMPUTED-A. SG1014.2 +032300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +032400 PERFORM FAIL. SG1014.2 +032500 GO TO SEG-WRITE-3. SG1014.2 +032600 SEG-DELETE-3. SG1014.2 +032700 PERFORM DE-LETE. SG1014.2 +032800 SEG-WRITE-3. SG1014.2 +032900 MOVE "SEG-TEST-3 " TO PAR-NAME. SG1014.2 +033000 PERFORM PRINT-DETAIL. SG1014.2 +033100 SEG-TEST-4. SG1014.2 +033200 MOVE SPACE TO TEST-CHECK. SG1014.2 +033300 PERFORM 03. SG1014.2 +033400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +033500 PERFORM PASS SG1014.2 +033600 GO TO SEG-WRITE-4. SG1014.2 +033700 MOVE SPACE TO COMPUTED-A. SG1014.2 +033800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +033900 PERFORM FAIL. SG1014.2 +034000 GO TO SEG-WRITE-4. SG1014.2 +034100 SEG-DELETE-4. SG1014.2 +034200 PERFORM DE-LETE. SG1014.2 +034300 SEG-WRITE-4. SG1014.2 +034400 MOVE "SEG-TEST-4 " TO PAR-NAME. SG1014.2 +034500 PERFORM PRINT-DETAIL. SG1014.2 +034600 SEG-TEST-5. SG1014.2 +034700 MOVE SPACE TO TEST-CHECK. SG1014.2 +034800 PERFORM 04. SG1014.2 +034900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +035000 PERFORM PASS SG1014.2 +035100 GO TO SEG-WRITE-5. SG1014.2 +035200 MOVE SPACE TO COMPUTED-A. SG1014.2 +035300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +035400 PERFORM FAIL. SG1014.2 +035500 GO TO SEG-WRITE-5. SG1014.2 +035600 SEG-DELETE-5. SG1014.2 +035700 PERFORM DE-LETE. SG1014.2 +035800 SEG-WRITE-5. SG1014.2 +035900 MOVE "SEG-TEST-5 " TO PAR-NAME. SG1014.2 +036000 PERFORM PRINT-DETAIL. SG1014.2 +036100 SEG-TEST-6. SG1014.2 +036200 MOVE SPACE TO TEST-CHECK. SG1014.2 +036300 PERFORM 05. SG1014.2 +036400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +036500 PERFORM PASS SG1014.2 +036600 GO TO SEG-WRITE-6. SG1014.2 +036700 MOVE SPACE TO COMPUTED-A. SG1014.2 +036800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +036900 PERFORM FAIL. SG1014.2 +037000 GO TO SEG-WRITE-6. SG1014.2 +037100 SEG-DELETE-6. SG1014.2 +037200 PERFORM DE-LETE. SG1014.2 +037300 SEG-WRITE-6. SG1014.2 +037400 MOVE "SEG-TEST-6 " TO PAR-NAME. SG1014.2 +037500 PERFORM PRINT-DETAIL. SG1014.2 +037600 SEG-TEST-7. SG1014.2 +037700 MOVE SPACE TO TEST-CHECK. SG1014.2 +037800 PERFORM 06. SG1014.2 +037900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +038000 PERFORM PASS SG1014.2 +038100 GO TO SEG-WRITE-7. SG1014.2 +038200 MOVE SPACE TO COMPUTED-A. SG1014.2 +038300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +038400 PERFORM FAIL. SG1014.2 +038500 GO TO SEG-WRITE-7. SG1014.2 +038600 SEG-DELETE-7. SG1014.2 +038700 PERFORM DE-LETE. SG1014.2 +038800 SEG-WRITE-7. SG1014.2 +038900 MOVE "SEG-TEST-7 " TO PAR-NAME. SG1014.2 +039000 PERFORM PRINT-DETAIL. SG1014.2 +039100 SEG-TEST-8. SG1014.2 +039200 MOVE SPACE TO TEST-CHECK. SG1014.2 +039300 PERFORM 07. SG1014.2 +039400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +039500 PERFORM PASS SG1014.2 +039600 GO TO SEG-WRITE-8. SG1014.2 +039700 MOVE SPACE TO COMPUTED-A. SG1014.2 +039800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +039900 PERFORM FAIL. SG1014.2 +040000 GO TO SEG-WRITE-8. SG1014.2 +040100 SEG-DELETE-8. SG1014.2 +040200 PERFORM DE-LETE. SG1014.2 +040300 SEG-WRITE-8. SG1014.2 +040400 MOVE "SEG-TEST-8 " TO PAR-NAME. SG1014.2 +040500 PERFORM PRINT-DETAIL. SG1014.2 +040600 SEG-TEST-9. SG1014.2 +040700 MOVE SPACE TO TEST-CHECK. SG1014.2 +040800 PERFORM 08. SG1014.2 +040900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +041000 PERFORM PASS SG1014.2 +041100 GO TO SEG-WRITE-9. SG1014.2 +041200 MOVE SPACE TO COMPUTED-A. SG1014.2 +041300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +041400 PERFORM FAIL. SG1014.2 +041500 GO TO SEG-WRITE-9. SG1014.2 +041600 SEG-DELETE-9. SG1014.2 +041700 PERFORM DE-LETE. SG1014.2 +041800 SEG-WRITE-9. SG1014.2 +041900 MOVE "SEG-TEST-9 " TO PAR-NAME. SG1014.2 +042000 PERFORM PRINT-DETAIL. SG1014.2 +042100 SEG-TEST-10. SG1014.2 +042200 MOVE SPACE TO TEST-CHECK. SG1014.2 +042300 PERFORM 09. SG1014.2 +042400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +042500 PERFORM PASS SG1014.2 +042600 GO TO SEG-WRITE-10. SG1014.2 +042700 MOVE SPACE TO COMPUTED-A. SG1014.2 +042800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +042900 PERFORM FAIL. SG1014.2 +043000 GO TO SEG-WRITE-10. SG1014.2 +043100 SEG-DELETE-10. SG1014.2 +043200 PERFORM DE-LETE. SG1014.2 +043300 SEG-WRITE-10. SG1014.2 +043400 MOVE "SEG-TEST-10 " TO PAR-NAME. SG1014.2 +043500 PERFORM PRINT-DETAIL. SG1014.2 +043600 SEG-TEST-11. SG1014.2 +043700 MOVE SPACE TO TEST-CHECK. SG1014.2 +043800 PERFORM 10. SG1014.2 +043900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +044000 PERFORM PASS SG1014.2 +044100 GO TO SEG-WRITE-11. SG1014.2 +044200 MOVE SPACE TO COMPUTED-A. SG1014.2 +044300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +044400 PERFORM FAIL. SG1014.2 +044500 GO TO SEG-WRITE-11. SG1014.2 +044600 SEG-DELETE-11. SG1014.2 +044700 PERFORM DE-LETE. SG1014.2 +044800 SEG-WRITE-11. SG1014.2 +044900 MOVE "SEG-TEST-11 " TO PAR-NAME. SG1014.2 +045000 PERFORM PRINT-DETAIL. SG1014.2 +045100 SEG-TEST-12. SG1014.2 +045200 MOVE SPACE TO TEST-CHECK. SG1014.2 +045300 PERFORM 11. SG1014.2 +045400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +045500 PERFORM PASS SG1014.2 +045600 GO TO SEG-WRITE-12. SG1014.2 +045700 MOVE SPACE TO COMPUTED-A. SG1014.2 +045800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +045900 PERFORM FAIL. SG1014.2 +046000 GO TO SEG-WRITE-12. SG1014.2 +046100 SEG-DELETE-12. SG1014.2 +046200 PERFORM DE-LETE. SG1014.2 +046300 SEG-WRITE-12. SG1014.2 +046400 MOVE "SEG-TEST-12 " TO PAR-NAME. SG1014.2 +046500 PERFORM PRINT-DETAIL. SG1014.2 +046600 SEG-TEST-13. SG1014.2 +046700 MOVE SPACE TO TEST-CHECK. SG1014.2 +046800 PERFORM 12. SG1014.2 +046900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +047000 PERFORM PASS SG1014.2 +047100 GO TO SEG-WRITE-13. SG1014.2 +047200 MOVE SPACE TO COMPUTED-A. SG1014.2 +047300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +047400 PERFORM FAIL. SG1014.2 +047500 GO TO SEG-WRITE-13. SG1014.2 +047600 SEG-DELETE-13. SG1014.2 +047700 PERFORM DE-LETE. SG1014.2 +047800 SEG-WRITE-13. SG1014.2 +047900 MOVE "SEG-TEST-13 " TO PAR-NAME. SG1014.2 +048000 PERFORM PRINT-DETAIL. SG1014.2 +048100 SEG-TEST-14. SG1014.2 +048200 MOVE SPACE TO TEST-CHECK. SG1014.2 +048300 PERFORM 13. SG1014.2 +048400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +048500 PERFORM PASS SG1014.2 +048600 GO TO SEG-WRITE-14. SG1014.2 +048700 MOVE SPACE TO COMPUTED-A. SG1014.2 +048800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +048900 PERFORM FAIL. SG1014.2 +049000 GO TO SEG-WRITE-14. SG1014.2 +049100 SEG-DELETE-14. SG1014.2 +049200 PERFORM DE-LETE. SG1014.2 +049300 SEG-WRITE-14. SG1014.2 +049400 MOVE "SEG-TEST-14 " TO PAR-NAME. SG1014.2 +049500 PERFORM PRINT-DETAIL. SG1014.2 +049600 SEG-TEST-15. SG1014.2 +049700 MOVE SPACE TO TEST-CHECK. SG1014.2 +049800 PERFORM 14. SG1014.2 +049900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +050000 PERFORM PASS SG1014.2 +050100 GO TO SEG-WRITE-15. SG1014.2 +050200 MOVE SPACE TO COMPUTED-A. SG1014.2 +050300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +050400 PERFORM FAIL. SG1014.2 +050500 GO TO SEG-WRITE-15. SG1014.2 +050600 SEG-DELETE-15. SG1014.2 +050700 PERFORM DE-LETE. SG1014.2 +050800 SEG-WRITE-15. SG1014.2 +050900 MOVE "SEG-TEST-15 " TO PAR-NAME. SG1014.2 +051000 PERFORM PRINT-DETAIL. SG1014.2 +051100 SEG-TEST-16. SG1014.2 +051200 MOVE SPACE TO TEST-CHECK. SG1014.2 +051300 PERFORM 15. SG1014.2 +051400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +051500 PERFORM PASS SG1014.2 +051600 GO TO SEG-WRITE-16. SG1014.2 +051700 MOVE SPACE TO COMPUTED-A. SG1014.2 +051800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +051900 PERFORM FAIL. SG1014.2 +052000 GO TO SEG-WRITE-16. SG1014.2 +052100 SEG-DELETE-16. SG1014.2 +052200 PERFORM DE-LETE. SG1014.2 +052300 SEG-WRITE-16. SG1014.2 +052400 MOVE "SEG-TEST-16 " TO PAR-NAME. SG1014.2 +052500 PERFORM PRINT-DETAIL. SG1014.2 +052600 SEG-TEST-17. SG1014.2 +052700 MOVE SPACE TO TEST-CHECK. SG1014.2 +052800 PERFORM 16. SG1014.2 +052900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +053000 PERFORM PASS SG1014.2 +053100 GO TO SEG-WRITE-17. SG1014.2 +053200 MOVE SPACE TO COMPUTED-A. SG1014.2 +053300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +053400 PERFORM FAIL. SG1014.2 +053500 GO TO SEG-WRITE-17. SG1014.2 +053600 SEG-DELETE-17. SG1014.2 +053700 PERFORM DE-LETE. SG1014.2 +053800 SEG-WRITE-17. SG1014.2 +053900 MOVE "SEG-TEST-17 " TO PAR-NAME. SG1014.2 +054000 PERFORM PRINT-DETAIL. SG1014.2 +054100 SEG-TEST-18. SG1014.2 +054200 MOVE SPACE TO TEST-CHECK. SG1014.2 +054300 PERFORM 17. SG1014.2 +054400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +054500 PERFORM PASS SG1014.2 +054600 GO TO SEG-WRITE-18. SG1014.2 +054700 MOVE SPACE TO COMPUTED-A. SG1014.2 +054800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +054900 PERFORM FAIL. SG1014.2 +055000 GO TO SEG-WRITE-18. SG1014.2 +055100 SEG-DELETE-18. SG1014.2 +055200 PERFORM DE-LETE. SG1014.2 +055300 SEG-WRITE-18. SG1014.2 +055400 MOVE "SEG-TEST-18 " TO PAR-NAME. SG1014.2 +055500 PERFORM PRINT-DETAIL. SG1014.2 +055600 SEG-TEST-19. SG1014.2 +055700 MOVE SPACE TO TEST-CHECK. SG1014.2 +055800 PERFORM 18. SG1014.2 +055900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +056000 PERFORM PASS SG1014.2 +056100 GO TO SEG-WRITE-19. SG1014.2 +056200 MOVE SPACE TO COMPUTED-A. SG1014.2 +056300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +056400 PERFORM FAIL. SG1014.2 +056500 GO TO SEG-WRITE-19. SG1014.2 +056600 SEG-DELETE-19. SG1014.2 +056700 PERFORM DE-LETE. SG1014.2 +056800 SEG-WRITE-19. SG1014.2 +056900 MOVE "SEG-TEST-19 " TO PAR-NAME. SG1014.2 +057000 PERFORM PRINT-DETAIL. SG1014.2 +057100 SEG-TEST-20. SG1014.2 +057200 MOVE SPACE TO TEST-CHECK. SG1014.2 +057300 PERFORM 19. SG1014.2 +057400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +057500 PERFORM PASS SG1014.2 +057600 GO TO SEG-WRITE-20. SG1014.2 +057700 MOVE SPACE TO COMPUTED-A. SG1014.2 +057800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +057900 PERFORM FAIL. SG1014.2 +058000 GO TO SEG-WRITE-20. SG1014.2 +058100 SEG-DELETE-20. SG1014.2 +058200 PERFORM DE-LETE. SG1014.2 +058300 SEG-WRITE-20. SG1014.2 +058400 MOVE "SEG-TEST-20 " TO PAR-NAME. SG1014.2 +058500 PERFORM PRINT-DETAIL. SG1014.2 +058600 SEG-TEST-21. SG1014.2 +058700 MOVE SPACE TO TEST-CHECK. SG1014.2 +058800 PERFORM 20. SG1014.2 +058900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +059000 PERFORM PASS SG1014.2 +059100 GO TO SEG-WRITE-21. SG1014.2 +059200 MOVE SPACE TO COMPUTED-A. SG1014.2 +059300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +059400 PERFORM FAIL. SG1014.2 +059500 GO TO SEG-WRITE-21. SG1014.2 +059600 SEG-DELETE-21. SG1014.2 +059700 PERFORM DE-LETE. SG1014.2 +059800 SEG-WRITE-21. SG1014.2 +059900 MOVE "SEG-TEST-21 " TO PAR-NAME. SG1014.2 +060000 PERFORM PRINT-DETAIL. SG1014.2 +060100 SEG-TEST-22. SG1014.2 +060200 MOVE SPACE TO TEST-CHECK. SG1014.2 +060300 PERFORM 21. SG1014.2 +060400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +060500 PERFORM PASS SG1014.2 +060600 GO TO SEG-WRITE-22. SG1014.2 +060700 MOVE SPACE TO COMPUTED-A. SG1014.2 +060800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +060900 PERFORM FAIL. SG1014.2 +061000 GO TO SEG-WRITE-22. SG1014.2 +061100 SEG-DELETE-22. SG1014.2 +061200 PERFORM DE-LETE. SG1014.2 +061300 SEG-WRITE-22. SG1014.2 +061400 MOVE "SEG-TEST-22 " TO PAR-NAME. SG1014.2 +061500 PERFORM PRINT-DETAIL. SG1014.2 +061600 SEG-TEST-23. SG1014.2 +061700 MOVE SPACE TO TEST-CHECK. SG1014.2 +061800 PERFORM 22. SG1014.2 +061900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +062000 PERFORM PASS SG1014.2 +062100 GO TO SEG-WRITE-23. SG1014.2 +062200 MOVE SPACE TO COMPUTED-A. SG1014.2 +062300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +062400 PERFORM FAIL. SG1014.2 +062500 GO TO SEG-WRITE-23. SG1014.2 +062600 SEG-DELETE-23. SG1014.2 +062700 PERFORM DE-LETE. SG1014.2 +062800 SEG-WRITE-23. SG1014.2 +062900 MOVE "SEG-TEST-23 " TO PAR-NAME. SG1014.2 +063000 PERFORM PRINT-DETAIL. SG1014.2 +063100 SEG-TEST-24. SG1014.2 +063200 MOVE SPACE TO TEST-CHECK. SG1014.2 +063300 PERFORM 23. SG1014.2 +063400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +063500 PERFORM PASS SG1014.2 +063600 GO TO SEG-WRITE-24. SG1014.2 +063700 MOVE SPACE TO COMPUTED-A. SG1014.2 +063800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +063900 PERFORM FAIL. SG1014.2 +064000 GO TO SEG-WRITE-24. SG1014.2 +064100 SEG-DELETE-24. SG1014.2 +064200 PERFORM DE-LETE. SG1014.2 +064300 SEG-WRITE-24. SG1014.2 +064400 MOVE "SEG-TEST-24 " TO PAR-NAME. SG1014.2 +064500 PERFORM PRINT-DETAIL. SG1014.2 +064600 SEG-TEST-25. SG1014.2 +064700 MOVE SPACE TO TEST-CHECK. SG1014.2 +064800 PERFORM 24. SG1014.2 +064900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +065000 PERFORM PASS SG1014.2 +065100 GO TO SEG-WRITE-25. SG1014.2 +065200 MOVE SPACE TO COMPUTED-A. SG1014.2 +065300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +065400 PERFORM FAIL. SG1014.2 +065500 GO TO SEG-WRITE-25. SG1014.2 +065600 SEG-DELETE-25. SG1014.2 +065700 PERFORM DE-LETE. SG1014.2 +065800 SEG-WRITE-25. SG1014.2 +065900 MOVE "SEG-TEST-25 " TO PAR-NAME. SG1014.2 +066000 PERFORM PRINT-DETAIL. SG1014.2 +066100 SEG-TEST-26. SG1014.2 +066200 MOVE SPACE TO TEST-CHECK. SG1014.2 +066300 PERFORM 25. SG1014.2 +066400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +066500 PERFORM PASS SG1014.2 +066600 GO TO SEG-WRITE-26. SG1014.2 +066700 MOVE SPACE TO COMPUTED-A. SG1014.2 +066800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +066900 PERFORM FAIL. SG1014.2 +067000 GO TO SEG-WRITE-26. SG1014.2 +067100 SEG-DELETE-26. SG1014.2 +067200 PERFORM DE-LETE. SG1014.2 +067300 SEG-WRITE-26. SG1014.2 +067400 MOVE "SEG-TEST-26 " TO PAR-NAME. SG1014.2 +067500 PERFORM PRINT-DETAIL. SG1014.2 +067600 SEG-TEST-27. SG1014.2 +067700 MOVE SPACE TO TEST-CHECK. SG1014.2 +067800 PERFORM 26. SG1014.2 +067900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +068000 PERFORM PASS SG1014.2 +068100 GO TO SEG-WRITE-27. SG1014.2 +068200 MOVE SPACE TO COMPUTED-A. SG1014.2 +068300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +068400 PERFORM FAIL. SG1014.2 +068500 GO TO SEG-WRITE-27. SG1014.2 +068600 SEG-DELETE-27. SG1014.2 +068700 PERFORM DE-LETE. SG1014.2 +068800 SEG-WRITE-27. SG1014.2 +068900 MOVE "SEG-TEST-27 " TO PAR-NAME. SG1014.2 +069000 PERFORM PRINT-DETAIL. SG1014.2 +069100 SEG-TEST-28. SG1014.2 +069200 MOVE SPACE TO TEST-CHECK. SG1014.2 +069300 PERFORM 27. SG1014.2 +069400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +069500 PERFORM PASS SG1014.2 +069600 GO TO SEG-WRITE-28. SG1014.2 +069700 MOVE SPACE TO COMPUTED-A. SG1014.2 +069800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +069900 PERFORM FAIL. SG1014.2 +070000 GO TO SEG-WRITE-28. SG1014.2 +070100 SEG-DELETE-28. SG1014.2 +070200 PERFORM DE-LETE. SG1014.2 +070300 SEG-WRITE-28. SG1014.2 +070400 MOVE "SEG-TEST-28 " TO PAR-NAME. SG1014.2 +070500 PERFORM PRINT-DETAIL. SG1014.2 +070600 SEG-TEST-29. SG1014.2 +070700 MOVE SPACE TO TEST-CHECK. SG1014.2 +070800 PERFORM 28. SG1014.2 +070900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +071000 PERFORM PASS SG1014.2 +071100 GO TO SEG-WRITE-29. SG1014.2 +071200 MOVE SPACE TO COMPUTED-A. SG1014.2 +071300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +071400 PERFORM FAIL. SG1014.2 +071500 GO TO SEG-WRITE-29. SG1014.2 +071600 SEG-DELETE-29. SG1014.2 +071700 PERFORM DE-LETE. SG1014.2 +071800 SEG-WRITE-29. SG1014.2 +071900 MOVE "SEG-TEST-29 " TO PAR-NAME. SG1014.2 +072000 PERFORM PRINT-DETAIL. SG1014.2 +072100 SEG-TEST-30. SG1014.2 +072200 MOVE SPACE TO TEST-CHECK. SG1014.2 +072300 PERFORM 29. SG1014.2 +072400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +072500 PERFORM PASS SG1014.2 +072600 GO TO SEG-WRITE-30. SG1014.2 +072700 MOVE SPACE TO COMPUTED-A. SG1014.2 +072800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +072900 PERFORM FAIL. SG1014.2 +073000 GO TO SEG-WRITE-30. SG1014.2 +073100 SEG-DELETE-30. SG1014.2 +073200 PERFORM DE-LETE. SG1014.2 +073300 SEG-WRITE-30. SG1014.2 +073400 MOVE "SEG-TEST-30 " TO PAR-NAME. SG1014.2 +073500 PERFORM PRINT-DETAIL. SG1014.2 +073600 SEG-TEST-31. SG1014.2 +073700 MOVE SPACE TO TEST-CHECK. SG1014.2 +073800 PERFORM 30. SG1014.2 +073900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +074000 PERFORM PASS SG1014.2 +074100 GO TO SEG-WRITE-31. SG1014.2 +074200 MOVE SPACE TO COMPUTED-A. SG1014.2 +074300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +074400 PERFORM FAIL. SG1014.2 +074500 GO TO SEG-WRITE-31. SG1014.2 +074600 SEG-DELETE-31. SG1014.2 +074700 PERFORM DE-LETE. SG1014.2 +074800 SEG-WRITE-31. SG1014.2 +074900 MOVE "SEG-TEST-31 " TO PAR-NAME. SG1014.2 +075000 PERFORM PRINT-DETAIL. SG1014.2 +075100 SEG-TEST-32. SG1014.2 +075200 MOVE SPACE TO TEST-CHECK. SG1014.2 +075300 PERFORM 31. SG1014.2 +075400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +075500 PERFORM PASS SG1014.2 +075600 GO TO SEG-WRITE-32. SG1014.2 +075700 MOVE SPACE TO COMPUTED-A. SG1014.2 +075800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +075900 PERFORM FAIL. SG1014.2 +076000 GO TO SEG-WRITE-32. SG1014.2 +076100 SEG-DELETE-32. SG1014.2 +076200 PERFORM DE-LETE. SG1014.2 +076300 SEG-WRITE-32. SG1014.2 +076400 MOVE "SEG-TEST-32 " TO PAR-NAME. SG1014.2 +076500 PERFORM PRINT-DETAIL. SG1014.2 +076600 SEG-TEST-33. SG1014.2 +076700 MOVE SPACE TO TEST-CHECK. SG1014.2 +076800 PERFORM 32. SG1014.2 +076900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +077000 PERFORM PASS SG1014.2 +077100 GO TO SEG-WRITE-33. SG1014.2 +077200 MOVE SPACE TO COMPUTED-A. SG1014.2 +077300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +077400 PERFORM FAIL. SG1014.2 +077500 GO TO SEG-WRITE-33. SG1014.2 +077600 SEG-DELETE-33. SG1014.2 +077700 PERFORM DE-LETE. SG1014.2 +077800 SEG-WRITE-33. SG1014.2 +077900 MOVE "SEG-TEST-33 " TO PAR-NAME. SG1014.2 +078000 PERFORM PRINT-DETAIL. SG1014.2 +078100 SEG-TEST-34. SG1014.2 +078200 MOVE SPACE TO TEST-CHECK. SG1014.2 +078300 PERFORM 33. SG1014.2 +078400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +078500 PERFORM PASS SG1014.2 +078600 GO TO SEG-WRITE-34. SG1014.2 +078700 MOVE SPACE TO COMPUTED-A. SG1014.2 +078800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +078900 PERFORM FAIL. SG1014.2 +079000 GO TO SEG-WRITE-34. SG1014.2 +079100 SEG-DELETE-34. SG1014.2 +079200 PERFORM DE-LETE. SG1014.2 +079300 SEG-WRITE-34. SG1014.2 +079400 MOVE "SEG-TEST-34 " TO PAR-NAME. SG1014.2 +079500 PERFORM PRINT-DETAIL. SG1014.2 +079600 SEG-TEST-35. SG1014.2 +079700 MOVE SPACE TO TEST-CHECK. SG1014.2 +079800 PERFORM 34. SG1014.2 +079900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +080000 PERFORM PASS SG1014.2 +080100 GO TO SEG-WRITE-35. SG1014.2 +080200 MOVE SPACE TO COMPUTED-A. SG1014.2 +080300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +080400 PERFORM FAIL. SG1014.2 +080500 GO TO SEG-WRITE-35. SG1014.2 +080600 SEG-DELETE-35. SG1014.2 +080700 PERFORM DE-LETE. SG1014.2 +080800 SEG-WRITE-35. SG1014.2 +080900 MOVE "SEG-TEST-35 " TO PAR-NAME. SG1014.2 +081000 PERFORM PRINT-DETAIL. SG1014.2 +081100 SEG-TEST-36. SG1014.2 +081200 MOVE SPACE TO TEST-CHECK. SG1014.2 +081300 PERFORM 35. SG1014.2 +081400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +081500 PERFORM PASS SG1014.2 +081600 GO TO SEG-WRITE-36. SG1014.2 +081700 MOVE SPACE TO COMPUTED-A. SG1014.2 +081800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +081900 PERFORM FAIL. SG1014.2 +082000 GO TO SEG-WRITE-36. SG1014.2 +082100 SEG-DELETE-36. SG1014.2 +082200 PERFORM DE-LETE. SG1014.2 +082300 SEG-WRITE-36. SG1014.2 +082400 MOVE "SEG-TEST-36 " TO PAR-NAME. SG1014.2 +082500 PERFORM PRINT-DETAIL. SG1014.2 +082600 SEG-TEST-37. SG1014.2 +082700 MOVE SPACE TO TEST-CHECK. SG1014.2 +082800 PERFORM 36. SG1014.2 +082900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +083000 PERFORM PASS SG1014.2 +083100 GO TO SEG-WRITE-37. SG1014.2 +083200 MOVE SPACE TO COMPUTED-A. SG1014.2 +083300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +083400 PERFORM FAIL. SG1014.2 +083500 GO TO SEG-WRITE-37. SG1014.2 +083600 SEG-DELETE-37. SG1014.2 +083700 PERFORM DE-LETE. SG1014.2 +083800 SEG-WRITE-37. SG1014.2 +083900 MOVE "SEG-TEST-37 " TO PAR-NAME. SG1014.2 +084000 PERFORM PRINT-DETAIL. SG1014.2 +084100 SEG-TEST-38. SG1014.2 +084200 MOVE SPACE TO TEST-CHECK. SG1014.2 +084300 PERFORM 37. SG1014.2 +084400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +084500 PERFORM PASS SG1014.2 +084600 GO TO SEG-WRITE-38. SG1014.2 +084700 MOVE SPACE TO COMPUTED-A. SG1014.2 +084800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +084900 PERFORM FAIL. SG1014.2 +085000 GO TO SEG-WRITE-38. SG1014.2 +085100 SEG-DELETE-38. SG1014.2 +085200 PERFORM DE-LETE. SG1014.2 +085300 SEG-WRITE-38. SG1014.2 +085400 MOVE "SEG-TEST-38 " TO PAR-NAME. SG1014.2 +085500 PERFORM PRINT-DETAIL. SG1014.2 +085600 SEG-TEST-39. SG1014.2 +085700 MOVE SPACE TO TEST-CHECK. SG1014.2 +085800 PERFORM 38. SG1014.2 +085900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +086000 PERFORM PASS SG1014.2 +086100 GO TO SEG-WRITE-39. SG1014.2 +086200 MOVE SPACE TO COMPUTED-A. SG1014.2 +086300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +086400 PERFORM FAIL. SG1014.2 +086500 GO TO SEG-WRITE-39. SG1014.2 +086600 SEG-DELETE-39. SG1014.2 +086700 PERFORM DE-LETE. SG1014.2 +086800 SEG-WRITE-39. SG1014.2 +086900 MOVE "SEG-TEST-39 " TO PAR-NAME. SG1014.2 +087000 PERFORM PRINT-DETAIL. SG1014.2 +087100 SEG-TEST-40. SG1014.2 +087200 MOVE SPACE TO TEST-CHECK. SG1014.2 +087300 PERFORM 39. SG1014.2 +087400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +087500 PERFORM PASS SG1014.2 +087600 GO TO SEG-WRITE-40. SG1014.2 +087700 MOVE SPACE TO COMPUTED-A. SG1014.2 +087800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +087900 PERFORM FAIL. SG1014.2 +088000 GO TO SEG-WRITE-40. SG1014.2 +088100 SEG-DELETE-40. SG1014.2 +088200 PERFORM DE-LETE. SG1014.2 +088300 SEG-WRITE-40. SG1014.2 +088400 MOVE "SEG-TEST-40 " TO PAR-NAME. SG1014.2 +088500 PERFORM PRINT-DETAIL. SG1014.2 +088600 SEG-TEST-41. SG1014.2 +088700 MOVE SPACE TO TEST-CHECK. SG1014.2 +088800 PERFORM 40. SG1014.2 +088900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +089000 PERFORM PASS SG1014.2 +089100 GO TO SEG-WRITE-41. SG1014.2 +089200 MOVE SPACE TO COMPUTED-A. SG1014.2 +089300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +089400 PERFORM FAIL. SG1014.2 +089500 GO TO SEG-WRITE-41. SG1014.2 +089600 SEG-DELETE-41. SG1014.2 +089700 PERFORM DE-LETE. SG1014.2 +089800 SEG-WRITE-41. SG1014.2 +089900 MOVE "SEG-TEST-41 " TO PAR-NAME. SG1014.2 +090000 PERFORM PRINT-DETAIL. SG1014.2 +090100 SEG-TEST-42. SG1014.2 +090200 MOVE SPACE TO TEST-CHECK. SG1014.2 +090300 PERFORM 41. SG1014.2 +090400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +090500 PERFORM PASS SG1014.2 +090600 GO TO SEG-WRITE-42. SG1014.2 +090700 MOVE SPACE TO COMPUTED-A. SG1014.2 +090800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +090900 PERFORM FAIL. SG1014.2 +091000 GO TO SEG-WRITE-42. SG1014.2 +091100 SEG-DELETE-42. SG1014.2 +091200 PERFORM DE-LETE. SG1014.2 +091300 SEG-WRITE-42. SG1014.2 +091400 MOVE "SEG-TEST-42 " TO PAR-NAME. SG1014.2 +091500 PERFORM PRINT-DETAIL. SG1014.2 +091600 SEG-TEST-43. SG1014.2 +091700 MOVE SPACE TO TEST-CHECK. SG1014.2 +091800 PERFORM 42. SG1014.2 +091900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +092000 PERFORM PASS SG1014.2 +092100 GO TO SEG-WRITE-43. SG1014.2 +092200 MOVE SPACE TO COMPUTED-A. SG1014.2 +092300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +092400 PERFORM FAIL. SG1014.2 +092500 GO TO SEG-WRITE-43. SG1014.2 +092600 SEG-DELETE-43. SG1014.2 +092700 PERFORM DE-LETE. SG1014.2 +092800 SEG-WRITE-43. SG1014.2 +092900 MOVE "SEG-TEST-43 " TO PAR-NAME. SG1014.2 +093000 PERFORM PRINT-DETAIL. SG1014.2 +093100 SEG-TEST-44. SG1014.2 +093200 MOVE SPACE TO TEST-CHECK. SG1014.2 +093300 PERFORM 43. SG1014.2 +093400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +093500 PERFORM PASS SG1014.2 +093600 GO TO SEG-WRITE-44. SG1014.2 +093700 MOVE SPACE TO COMPUTED-A. SG1014.2 +093800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +093900 PERFORM FAIL. SG1014.2 +094000 GO TO SEG-WRITE-44. SG1014.2 +094100 SEG-DELETE-44. SG1014.2 +094200 PERFORM DE-LETE. SG1014.2 +094300 SEG-WRITE-44. SG1014.2 +094400 MOVE "SEG-TEST-44 " TO PAR-NAME. SG1014.2 +094500 PERFORM PRINT-DETAIL. SG1014.2 +094600 SEG-TEST-45. SG1014.2 +094700 MOVE SPACE TO TEST-CHECK. SG1014.2 +094800 PERFORM 44. SG1014.2 +094900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +095000 PERFORM PASS SG1014.2 +095100 GO TO SEG-WRITE-45. SG1014.2 +095200 MOVE SPACE TO COMPUTED-A. SG1014.2 +095300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +095400 PERFORM FAIL. SG1014.2 +095500 GO TO SEG-WRITE-45. SG1014.2 +095600 SEG-DELETE-45. SG1014.2 +095700 PERFORM DE-LETE. SG1014.2 +095800 SEG-WRITE-45. SG1014.2 +095900 MOVE "SEG-TEST-45 " TO PAR-NAME. SG1014.2 +096000 PERFORM PRINT-DETAIL. SG1014.2 +096100 SEG-TEST-46. SG1014.2 +096200 MOVE SPACE TO TEST-CHECK. SG1014.2 +096300 PERFORM 45. SG1014.2 +096400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +096500 PERFORM PASS SG1014.2 +096600 GO TO SEG-WRITE-46. SG1014.2 +096700 MOVE SPACE TO COMPUTED-A. SG1014.2 +096800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +096900 PERFORM FAIL. SG1014.2 +097000 GO TO SEG-WRITE-46. SG1014.2 +097100 SEG-DELETE-46. SG1014.2 +097200 PERFORM DE-LETE. SG1014.2 +097300 SEG-WRITE-46. SG1014.2 +097400 MOVE "SEG-TEST-46 " TO PAR-NAME. SG1014.2 +097500 PERFORM PRINT-DETAIL. SG1014.2 +097600 SEG-TEST-47. SG1014.2 +097700 MOVE SPACE TO TEST-CHECK. SG1014.2 +097800 PERFORM 46. SG1014.2 +097900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +098000 PERFORM PASS SG1014.2 +098100 GO TO SEG-WRITE-47. SG1014.2 +098200 MOVE SPACE TO COMPUTED-A. SG1014.2 +098300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +098400 PERFORM FAIL. SG1014.2 +098500 GO TO SEG-WRITE-47. SG1014.2 +098600 SEG-DELETE-47. SG1014.2 +098700 PERFORM DE-LETE. SG1014.2 +098800 SEG-WRITE-47. SG1014.2 +098900 MOVE "SEG-TEST-47 " TO PAR-NAME. SG1014.2 +099000 PERFORM PRINT-DETAIL. SG1014.2 +099100 SEG-TEST-48. SG1014.2 +099200 MOVE SPACE TO TEST-CHECK. SG1014.2 +099300 PERFORM 47. SG1014.2 +099400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +099500 PERFORM PASS SG1014.2 +099600 GO TO SEG-WRITE-48. SG1014.2 +099700 MOVE SPACE TO COMPUTED-A. SG1014.2 +099800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +099900 PERFORM FAIL. SG1014.2 +100000 GO TO SEG-WRITE-48. SG1014.2 +100100 SEG-DELETE-48. SG1014.2 +100200 PERFORM DE-LETE. SG1014.2 +100300 SEG-WRITE-48. SG1014.2 +100400 MOVE "SEG-TEST-48 " TO PAR-NAME. SG1014.2 +100500 PERFORM PRINT-DETAIL. SG1014.2 +100600 SEG-TEST-49. SG1014.2 +100700 MOVE SPACE TO TEST-CHECK. SG1014.2 +100800 PERFORM 48. SG1014.2 +100900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +101000 PERFORM PASS SG1014.2 +101100 GO TO SEG-WRITE-49. SG1014.2 +101200 MOVE SPACE TO COMPUTED-A. SG1014.2 +101300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +101400 PERFORM FAIL. SG1014.2 +101500 GO TO SEG-WRITE-49. SG1014.2 +101600 SEG-DELETE-49. SG1014.2 +101700 PERFORM DE-LETE. SG1014.2 +101800 SEG-WRITE-49. SG1014.2 +101900 MOVE "SEG-TEST-49 " TO PAR-NAME. SG1014.2 +102000 PERFORM PRINT-DETAIL. SG1014.2 +102100 SEG-TEST-50. SG1014.2 +102200 MOVE SPACE TO TEST-CHECK. SG1014.2 +102300 PERFORM 49. SG1014.2 +102400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +102500 PERFORM PASS SG1014.2 +102600 GO TO SEG-WRITE-50. SG1014.2 +102700 MOVE SPACE TO COMPUTED-A. SG1014.2 +102800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +102900 PERFORM FAIL. SG1014.2 +103000 GO TO SEG-WRITE-50. SG1014.2 +103100 SEG-DELETE-50. SG1014.2 +103200 PERFORM DE-LETE. SG1014.2 +103300 SEG-WRITE-50. SG1014.2 +103400 MOVE "SEG-TEST-50 " TO PAR-NAME. SG1014.2 +103500 PERFORM PRINT-DETAIL. SG1014.2 +103600 SEG-TEST-51. SG1014.2 +103700 MOVE SPACE TO TEST-CHECK. SG1014.2 +103800 PERFORM 50. SG1014.2 +103900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +104000 PERFORM PASS SG1014.2 +104100 GO TO SEG-WRITE-51. SG1014.2 +104200 MOVE SPACE TO COMPUTED-A. SG1014.2 +104300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +104400 PERFORM FAIL. SG1014.2 +104500 GO TO SEG-WRITE-51. SG1014.2 +104600 SEG-DELETE-51. SG1014.2 +104700 PERFORM DE-LETE. SG1014.2 +104800 SEG-WRITE-51. SG1014.2 +104900 MOVE "SEG-TEST-51 " TO PAR-NAME. SG1014.2 +105000 PERFORM PRINT-DETAIL. SG1014.2 +105100 SEG-TEST-52. SG1014.2 +105200 MOVE SPACE TO TEST-CHECK. SG1014.2 +105300 PERFORM 51. SG1014.2 +105400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +105500 PERFORM PASS SG1014.2 +105600 GO TO SEG-WRITE-52. SG1014.2 +105700 MOVE SPACE TO COMPUTED-A. SG1014.2 +105800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +105900 PERFORM FAIL. SG1014.2 +106000 GO TO SEG-WRITE-52. SG1014.2 +106100 SEG-DELETE-52. SG1014.2 +106200 PERFORM DE-LETE. SG1014.2 +106300 SEG-WRITE-52. SG1014.2 +106400 MOVE "SEG-TEST-52 " TO PAR-NAME. SG1014.2 +106500 PERFORM PRINT-DETAIL. SG1014.2 +106600 SEG-TEST-53. SG1014.2 +106700 MOVE SPACE TO TEST-CHECK. SG1014.2 +106800 PERFORM 52. SG1014.2 +106900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +107000 PERFORM PASS SG1014.2 +107100 GO TO SEG-WRITE-53. SG1014.2 +107200 MOVE SPACE TO COMPUTED-A. SG1014.2 +107300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +107400 PERFORM FAIL. SG1014.2 +107500 GO TO SEG-WRITE-53. SG1014.2 +107600 SEG-DELETE-53. SG1014.2 +107700 PERFORM DE-LETE. SG1014.2 +107800 SEG-WRITE-53. SG1014.2 +107900 MOVE "SEG-TEST-53 " TO PAR-NAME. SG1014.2 +108000 PERFORM PRINT-DETAIL. SG1014.2 +108100 SEG-TEST-54. SG1014.2 +108200 MOVE SPACE TO TEST-CHECK. SG1014.2 +108300 PERFORM 53. SG1014.2 +108400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +108500 PERFORM PASS SG1014.2 +108600 GO TO SEG-WRITE-54. SG1014.2 +108700 MOVE SPACE TO COMPUTED-A. SG1014.2 +108800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +108900 PERFORM FAIL. SG1014.2 +109000 GO TO SEG-WRITE-54. SG1014.2 +109100 SEG-DELETE-54. SG1014.2 +109200 PERFORM DE-LETE. SG1014.2 +109300 SEG-WRITE-54. SG1014.2 +109400 MOVE "SEG-TEST-54 " TO PAR-NAME. SG1014.2 +109500 PERFORM PRINT-DETAIL. SG1014.2 +109600 SEG-TEST-55. SG1014.2 +109700 MOVE SPACE TO TEST-CHECK. SG1014.2 +109800 PERFORM 54. SG1014.2 +109900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +110000 PERFORM PASS SG1014.2 +110100 GO TO SEG-WRITE-55. SG1014.2 +110200 MOVE SPACE TO COMPUTED-A. SG1014.2 +110300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +110400 PERFORM FAIL. SG1014.2 +110500 GO TO SEG-WRITE-55. SG1014.2 +110600 SEG-DELETE-55. SG1014.2 +110700 PERFORM DE-LETE. SG1014.2 +110800 SEG-WRITE-55. SG1014.2 +110900 MOVE "SEG-TEST-55 " TO PAR-NAME. SG1014.2 +111000 PERFORM PRINT-DETAIL. SG1014.2 +111100 SEG-TEST-56. SG1014.2 +111200 MOVE SPACE TO TEST-CHECK. SG1014.2 +111300 PERFORM 55. SG1014.2 +111400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +111500 PERFORM PASS SG1014.2 +111600 GO TO SEG-WRITE-56. SG1014.2 +111700 MOVE SPACE TO COMPUTED-A. SG1014.2 +111800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +111900 PERFORM FAIL. SG1014.2 +112000 GO TO SEG-WRITE-56. SG1014.2 +112100 SEG-DELETE-56. SG1014.2 +112200 PERFORM DE-LETE. SG1014.2 +112300 SEG-WRITE-56. SG1014.2 +112400 MOVE "SEG-TEST-56 " TO PAR-NAME. SG1014.2 +112500 PERFORM PRINT-DETAIL. SG1014.2 +112600 SEG-TEST-57. SG1014.2 +112700 MOVE SPACE TO TEST-CHECK. SG1014.2 +112800 PERFORM 56. SG1014.2 +112900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +113000 PERFORM PASS SG1014.2 +113100 GO TO SEG-WRITE-57. SG1014.2 +113200 MOVE SPACE TO COMPUTED-A. SG1014.2 +113300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +113400 PERFORM FAIL. SG1014.2 +113500 GO TO SEG-WRITE-57. SG1014.2 +113600 SEG-DELETE-57. SG1014.2 +113700 PERFORM DE-LETE. SG1014.2 +113800 SEG-WRITE-57. SG1014.2 +113900 MOVE "SEG-TEST-57 " TO PAR-NAME. SG1014.2 +114000 PERFORM PRINT-DETAIL. SG1014.2 +114100 SEG-TEST-58. SG1014.2 +114200 MOVE SPACE TO TEST-CHECK. SG1014.2 +114300 PERFORM 57. SG1014.2 +114400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +114500 PERFORM PASS SG1014.2 +114600 GO TO SEG-WRITE-58. SG1014.2 +114700 MOVE SPACE TO COMPUTED-A. SG1014.2 +114800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +114900 PERFORM FAIL. SG1014.2 +115000 GO TO SEG-WRITE-58. SG1014.2 +115100 SEG-DELETE-58. SG1014.2 +115200 PERFORM DE-LETE. SG1014.2 +115300 SEG-WRITE-58. SG1014.2 +115400 MOVE "SEG-TEST-58 " TO PAR-NAME. SG1014.2 +115500 PERFORM PRINT-DETAIL. SG1014.2 +115600 SEG-TEST-59. SG1014.2 +115700 MOVE SPACE TO TEST-CHECK. SG1014.2 +115800 PERFORM 58. SG1014.2 +115900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +116000 PERFORM PASS SG1014.2 +116100 GO TO SEG-WRITE-59. SG1014.2 +116200 MOVE SPACE TO COMPUTED-A. SG1014.2 +116300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +116400 PERFORM FAIL. SG1014.2 +116500 GO TO SEG-WRITE-59. SG1014.2 +116600 SEG-DELETE-59. SG1014.2 +116700 PERFORM DE-LETE. SG1014.2 +116800 SEG-WRITE-59. SG1014.2 +116900 MOVE "SEG-TEST-59 " TO PAR-NAME. SG1014.2 +117000 PERFORM PRINT-DETAIL. SG1014.2 +117100 SEG-TEST-60. SG1014.2 +117200 MOVE SPACE TO TEST-CHECK. SG1014.2 +117300 PERFORM 59. SG1014.2 +117400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +117500 PERFORM PASS SG1014.2 +117600 GO TO SEG-WRITE-60. SG1014.2 +117700 MOVE SPACE TO COMPUTED-A. SG1014.2 +117800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +117900 PERFORM FAIL. SG1014.2 +118000 GO TO SEG-WRITE-60. SG1014.2 +118100 SEG-DELETE-60. SG1014.2 +118200 PERFORM DE-LETE. SG1014.2 +118300 SEG-WRITE-60. SG1014.2 +118400 MOVE "SEG-TEST-60 " TO PAR-NAME. SG1014.2 +118500 PERFORM PRINT-DETAIL. SG1014.2 +118600 SEG-TEST-61. SG1014.2 +118700 MOVE SPACE TO TEST-CHECK. SG1014.2 +118800 PERFORM 60. SG1014.2 +118900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +119000 PERFORM PASS SG1014.2 +119100 GO TO SEG-WRITE-61. SG1014.2 +119200 MOVE SPACE TO COMPUTED-A. SG1014.2 +119300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +119400 PERFORM FAIL. SG1014.2 +119500 GO TO SEG-WRITE-61. SG1014.2 +119600 SEG-DELETE-61. SG1014.2 +119700 PERFORM DE-LETE. SG1014.2 +119800 SEG-WRITE-61. SG1014.2 +119900 MOVE "SEG-TEST-61 " TO PAR-NAME. SG1014.2 +120000 PERFORM PRINT-DETAIL. SG1014.2 +120100 SEG-TEST-62. SG1014.2 +120200 MOVE SPACE TO TEST-CHECK. SG1014.2 +120300 PERFORM 61. SG1014.2 +120400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +120500 PERFORM PASS SG1014.2 +120600 GO TO SEG-WRITE-62. SG1014.2 +120700 MOVE SPACE TO COMPUTED-A. SG1014.2 +120800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +120900 PERFORM FAIL. SG1014.2 +121000 GO TO SEG-WRITE-62. SG1014.2 +121100 SEG-DELETE-62. SG1014.2 +121200 PERFORM DE-LETE. SG1014.2 +121300 SEG-WRITE-62. SG1014.2 +121400 MOVE "SEG-TEST-62 " TO PAR-NAME. SG1014.2 +121500 PERFORM PRINT-DETAIL. SG1014.2 +121600 SEG-TEST-63. SG1014.2 +121700 MOVE SPACE TO TEST-CHECK. SG1014.2 +121800 PERFORM 62. SG1014.2 +121900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +122000 PERFORM PASS SG1014.2 +122100 GO TO SEG-WRITE-63. SG1014.2 +122200 MOVE SPACE TO COMPUTED-A. SG1014.2 +122300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +122400 PERFORM FAIL. SG1014.2 +122500 GO TO SEG-WRITE-63. SG1014.2 +122600 SEG-DELETE-63. SG1014.2 +122700 PERFORM DE-LETE. SG1014.2 +122800 SEG-WRITE-63. SG1014.2 +122900 MOVE "SEG-TEST-63 " TO PAR-NAME. SG1014.2 +123000 PERFORM PRINT-DETAIL. SG1014.2 +123100 SEG-TEST-64. SG1014.2 +123200 MOVE SPACE TO TEST-CHECK. SG1014.2 +123300 PERFORM 63. SG1014.2 +123400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +123500 PERFORM PASS SG1014.2 +123600 GO TO SEG-WRITE-64. SG1014.2 +123700 MOVE SPACE TO COMPUTED-A. SG1014.2 +123800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +123900 PERFORM FAIL. SG1014.2 +124000 GO TO SEG-WRITE-64. SG1014.2 +124100 SEG-DELETE-64. SG1014.2 +124200 PERFORM DE-LETE. SG1014.2 +124300 SEG-WRITE-64. SG1014.2 +124400 MOVE "SEG-TEST-64 " TO PAR-NAME. SG1014.2 +124500 PERFORM PRINT-DETAIL. SG1014.2 +124600 SEG-TEST-65. SG1014.2 +124700 MOVE SPACE TO TEST-CHECK. SG1014.2 +124800 PERFORM 64. SG1014.2 +124900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +125000 PERFORM PASS SG1014.2 +125100 GO TO SEG-WRITE-65. SG1014.2 +125200 MOVE SPACE TO COMPUTED-A. SG1014.2 +125300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +125400 PERFORM FAIL. SG1014.2 +125500 GO TO SEG-WRITE-65. SG1014.2 +125600 SEG-DELETE-65. SG1014.2 +125700 PERFORM DE-LETE. SG1014.2 +125800 SEG-WRITE-65. SG1014.2 +125900 MOVE "SEG-TEST-65 " TO PAR-NAME. SG1014.2 +126000 PERFORM PRINT-DETAIL. SG1014.2 +126100 SEG-TEST-66. SG1014.2 +126200 MOVE SPACE TO TEST-CHECK. SG1014.2 +126300 PERFORM 65. SG1014.2 +126400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +126500 PERFORM PASS SG1014.2 +126600 GO TO SEG-WRITE-66. SG1014.2 +126700 MOVE SPACE TO COMPUTED-A. SG1014.2 +126800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +126900 PERFORM FAIL. SG1014.2 +127000 GO TO SEG-WRITE-66. SG1014.2 +127100 SEG-DELETE-66. SG1014.2 +127200 PERFORM DE-LETE. SG1014.2 +127300 SEG-WRITE-66. SG1014.2 +127400 MOVE "SEG-TEST-66 " TO PAR-NAME. SG1014.2 +127500 PERFORM PRINT-DETAIL. SG1014.2 +127600 SEG-TEST-67. SG1014.2 +127700 MOVE SPACE TO TEST-CHECK. SG1014.2 +127800 PERFORM 66. SG1014.2 +127900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +128000 PERFORM PASS SG1014.2 +128100 GO TO SEG-WRITE-67. SG1014.2 +128200 MOVE SPACE TO COMPUTED-A. SG1014.2 +128300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +128400 PERFORM FAIL. SG1014.2 +128500 GO TO SEG-WRITE-67. SG1014.2 +128600 SEG-DELETE-67. SG1014.2 +128700 PERFORM DE-LETE. SG1014.2 +128800 SEG-WRITE-67. SG1014.2 +128900 MOVE "SEG-TEST-67 " TO PAR-NAME. SG1014.2 +129000 PERFORM PRINT-DETAIL. SG1014.2 +129100 SEG-TEST-68. SG1014.2 +129200 MOVE SPACE TO TEST-CHECK. SG1014.2 +129300 PERFORM 67. SG1014.2 +129400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +129500 PERFORM PASS SG1014.2 +129600 GO TO SEG-WRITE-68. SG1014.2 +129700 MOVE SPACE TO COMPUTED-A. SG1014.2 +129800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +129900 PERFORM FAIL. SG1014.2 +130000 GO TO SEG-WRITE-68. SG1014.2 +130100 SEG-DELETE-68. SG1014.2 +130200 PERFORM DE-LETE. SG1014.2 +130300 SEG-WRITE-68. SG1014.2 +130400 MOVE "SEG-TEST-68 " TO PAR-NAME. SG1014.2 +130500 PERFORM PRINT-DETAIL. SG1014.2 +130600 SEG-TEST-69. SG1014.2 +130700 MOVE SPACE TO TEST-CHECK. SG1014.2 +130800 PERFORM 68. SG1014.2 +130900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +131000 PERFORM PASS SG1014.2 +131100 GO TO SEG-WRITE-69. SG1014.2 +131200 MOVE SPACE TO COMPUTED-A. SG1014.2 +131300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +131400 PERFORM FAIL. SG1014.2 +131500 GO TO SEG-WRITE-69. SG1014.2 +131600 SEG-DELETE-69. SG1014.2 +131700 PERFORM DE-LETE. SG1014.2 +131800 SEG-WRITE-69. SG1014.2 +131900 MOVE "SEG-TEST-69 " TO PAR-NAME. SG1014.2 +132000 PERFORM PRINT-DETAIL. SG1014.2 +132100 SEG-TEST-70. SG1014.2 +132200 MOVE SPACE TO TEST-CHECK. SG1014.2 +132300 PERFORM 69. SG1014.2 +132400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +132500 PERFORM PASS SG1014.2 +132600 GO TO SEG-WRITE-70. SG1014.2 +132700 MOVE SPACE TO COMPUTED-A. SG1014.2 +132800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +132900 PERFORM FAIL. SG1014.2 +133000 GO TO SEG-WRITE-70. SG1014.2 +133100 SEG-DELETE-70. SG1014.2 +133200 PERFORM DE-LETE. SG1014.2 +133300 SEG-WRITE-70. SG1014.2 +133400 MOVE "SEG-TEST-70 " TO PAR-NAME. SG1014.2 +133500 PERFORM PRINT-DETAIL. SG1014.2 +133600 SEG-TEST-71. SG1014.2 +133700 MOVE SPACE TO TEST-CHECK. SG1014.2 +133800 PERFORM 70. SG1014.2 +133900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +134000 PERFORM PASS SG1014.2 +134100 GO TO SEG-WRITE-71. SG1014.2 +134200 MOVE SPACE TO COMPUTED-A. SG1014.2 +134300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +134400 PERFORM FAIL. SG1014.2 +134500 GO TO SEG-WRITE-71. SG1014.2 +134600 SEG-DELETE-71. SG1014.2 +134700 PERFORM DE-LETE. SG1014.2 +134800 SEG-WRITE-71. SG1014.2 +134900 MOVE "SEG-TEST-71 " TO PAR-NAME. SG1014.2 +135000 PERFORM PRINT-DETAIL. SG1014.2 +135100 SEG-TEST-72. SG1014.2 +135200 MOVE SPACE TO TEST-CHECK. SG1014.2 +135300 PERFORM 71. SG1014.2 +135400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +135500 PERFORM PASS SG1014.2 +135600 GO TO SEG-WRITE-72. SG1014.2 +135700 MOVE SPACE TO COMPUTED-A. SG1014.2 +135800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +135900 PERFORM FAIL. SG1014.2 +136000 GO TO SEG-WRITE-72. SG1014.2 +136100 SEG-DELETE-72. SG1014.2 +136200 PERFORM DE-LETE. SG1014.2 +136300 SEG-WRITE-72. SG1014.2 +136400 MOVE "SEG-TEST-72 " TO PAR-NAME. SG1014.2 +136500 PERFORM PRINT-DETAIL. SG1014.2 +136600 SEG-TEST-73. SG1014.2 +136700 MOVE SPACE TO TEST-CHECK. SG1014.2 +136800 PERFORM 72. SG1014.2 +136900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +137000 PERFORM PASS SG1014.2 +137100 GO TO SEG-WRITE-73. SG1014.2 +137200 MOVE SPACE TO COMPUTED-A. SG1014.2 +137300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +137400 PERFORM FAIL. SG1014.2 +137500 GO TO SEG-WRITE-73. SG1014.2 +137600 SEG-DELETE-73. SG1014.2 +137700 PERFORM DE-LETE. SG1014.2 +137800 SEG-WRITE-73. SG1014.2 +137900 MOVE "SEG-TEST-73 " TO PAR-NAME. SG1014.2 +138000 PERFORM PRINT-DETAIL. SG1014.2 +138100 SEG-TEST-74. SG1014.2 +138200 MOVE SPACE TO TEST-CHECK. SG1014.2 +138300 PERFORM 73. SG1014.2 +138400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +138500 PERFORM PASS SG1014.2 +138600 GO TO SEG-WRITE-74. SG1014.2 +138700 MOVE SPACE TO COMPUTED-A. SG1014.2 +138800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +138900 PERFORM FAIL. SG1014.2 +139000 GO TO SEG-WRITE-74. SG1014.2 +139100 SEG-DELETE-74. SG1014.2 +139200 PERFORM DE-LETE. SG1014.2 +139300 SEG-WRITE-74. SG1014.2 +139400 MOVE "SEG-TEST-74 " TO PAR-NAME. SG1014.2 +139500 PERFORM PRINT-DETAIL. SG1014.2 +139600 SEG-TEST-75. SG1014.2 +139700 MOVE SPACE TO TEST-CHECK. SG1014.2 +139800 PERFORM 74. SG1014.2 +139900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +140000 PERFORM PASS SG1014.2 +140100 GO TO SEG-WRITE-75. SG1014.2 +140200 MOVE SPACE TO COMPUTED-A. SG1014.2 +140300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +140400 PERFORM FAIL. SG1014.2 +140500 GO TO SEG-WRITE-75. SG1014.2 +140600 SEG-DELETE-75. SG1014.2 +140700 PERFORM DE-LETE. SG1014.2 +140800 SEG-WRITE-75. SG1014.2 +140900 MOVE "SEG-TEST-75 " TO PAR-NAME. SG1014.2 +141000 PERFORM PRINT-DETAIL. SG1014.2 +141100 SEG-TEST-76. SG1014.2 +141200 MOVE SPACE TO TEST-CHECK. SG1014.2 +141300 PERFORM 75. SG1014.2 +141400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +141500 PERFORM PASS SG1014.2 +141600 GO TO SEG-WRITE-76. SG1014.2 +141700 MOVE SPACE TO COMPUTED-A. SG1014.2 +141800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +141900 PERFORM FAIL. SG1014.2 +142000 GO TO SEG-WRITE-76. SG1014.2 +142100 SEG-DELETE-76. SG1014.2 +142200 PERFORM DE-LETE. SG1014.2 +142300 SEG-WRITE-76. SG1014.2 +142400 MOVE "SEG-TEST-76 " TO PAR-NAME. SG1014.2 +142500 PERFORM PRINT-DETAIL. SG1014.2 +142600 SEG-TEST-77. SG1014.2 +142700 MOVE SPACE TO TEST-CHECK. SG1014.2 +142800 PERFORM 76. SG1014.2 +142900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +143000 PERFORM PASS SG1014.2 +143100 GO TO SEG-WRITE-77. SG1014.2 +143200 MOVE SPACE TO COMPUTED-A. SG1014.2 +143300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +143400 PERFORM FAIL. SG1014.2 +143500 GO TO SEG-WRITE-77. SG1014.2 +143600 SEG-DELETE-77. SG1014.2 +143700 PERFORM DE-LETE. SG1014.2 +143800 SEG-WRITE-77. SG1014.2 +143900 MOVE "SEG-TEST-77 " TO PAR-NAME. SG1014.2 +144000 PERFORM PRINT-DETAIL. SG1014.2 +144100 SEG-TEST-78. SG1014.2 +144200 MOVE SPACE TO TEST-CHECK. SG1014.2 +144300 PERFORM 77. SG1014.2 +144400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +144500 PERFORM PASS SG1014.2 +144600 GO TO SEG-WRITE-78. SG1014.2 +144700 MOVE SPACE TO COMPUTED-A. SG1014.2 +144800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +144900 PERFORM FAIL. SG1014.2 +145000 GO TO SEG-WRITE-78. SG1014.2 +145100 SEG-DELETE-78. SG1014.2 +145200 PERFORM DE-LETE. SG1014.2 +145300 SEG-WRITE-78. SG1014.2 +145400 MOVE "SEG-TEST-78 " TO PAR-NAME. SG1014.2 +145500 PERFORM PRINT-DETAIL. SG1014.2 +145600 SEG-TEST-79. SG1014.2 +145700 MOVE SPACE TO TEST-CHECK. SG1014.2 +145800 PERFORM 78. SG1014.2 +145900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +146000 PERFORM PASS SG1014.2 +146100 GO TO SEG-WRITE-79. SG1014.2 +146200 MOVE SPACE TO COMPUTED-A. SG1014.2 +146300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +146400 PERFORM FAIL. SG1014.2 +146500 GO TO SEG-WRITE-79. SG1014.2 +146600 SEG-DELETE-79. SG1014.2 +146700 PERFORM DE-LETE. SG1014.2 +146800 SEG-WRITE-79. SG1014.2 +146900 MOVE "SEG-TEST-79 " TO PAR-NAME. SG1014.2 +147000 PERFORM PRINT-DETAIL. SG1014.2 +147100 SEG-TEST-80. SG1014.2 +147200 MOVE SPACE TO TEST-CHECK. SG1014.2 +147300 PERFORM 79. SG1014.2 +147400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +147500 PERFORM PASS SG1014.2 +147600 GO TO SEG-WRITE-80. SG1014.2 +147700 MOVE SPACE TO COMPUTED-A. SG1014.2 +147800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +147900 PERFORM FAIL. SG1014.2 +148000 GO TO SEG-WRITE-80. SG1014.2 +148100 SEG-DELETE-80. SG1014.2 +148200 PERFORM DE-LETE. SG1014.2 +148300 SEG-WRITE-80. SG1014.2 +148400 MOVE "SEG-TEST-80 " TO PAR-NAME. SG1014.2 +148500 PERFORM PRINT-DETAIL. SG1014.2 +148600 SEG-TEST-81. SG1014.2 +148700 MOVE SPACE TO TEST-CHECK. SG1014.2 +148800 PERFORM 80. SG1014.2 +148900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +149000 PERFORM PASS SG1014.2 +149100 GO TO SEG-WRITE-81. SG1014.2 +149200 MOVE SPACE TO COMPUTED-A. SG1014.2 +149300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +149400 PERFORM FAIL. SG1014.2 +149500 GO TO SEG-WRITE-81. SG1014.2 +149600 SEG-DELETE-81. SG1014.2 +149700 PERFORM DE-LETE. SG1014.2 +149800 SEG-WRITE-81. SG1014.2 +149900 MOVE "SEG-TEST-81 " TO PAR-NAME. SG1014.2 +150000 PERFORM PRINT-DETAIL. SG1014.2 +150100 SEG-TEST-82. SG1014.2 +150200 MOVE SPACE TO TEST-CHECK. SG1014.2 +150300 PERFORM 81. SG1014.2 +150400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +150500 PERFORM PASS SG1014.2 +150600 GO TO SEG-WRITE-82. SG1014.2 +150700 MOVE SPACE TO COMPUTED-A. SG1014.2 +150800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +150900 PERFORM FAIL. SG1014.2 +151000 GO TO SEG-WRITE-82. SG1014.2 +151100 SEG-DELETE-82. SG1014.2 +151200 PERFORM DE-LETE. SG1014.2 +151300 SEG-WRITE-82. SG1014.2 +151400 MOVE "SEG-TEST-82 " TO PAR-NAME. SG1014.2 +151500 PERFORM PRINT-DETAIL. SG1014.2 +151600 SEG-TEST-83. SG1014.2 +151700 MOVE SPACE TO TEST-CHECK. SG1014.2 +151800 PERFORM 82. SG1014.2 +151900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +152000 PERFORM PASS SG1014.2 +152100 GO TO SEG-WRITE-83. SG1014.2 +152200 MOVE SPACE TO COMPUTED-A. SG1014.2 +152300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +152400 PERFORM FAIL. SG1014.2 +152500 GO TO SEG-WRITE-83. SG1014.2 +152600 SEG-DELETE-83. SG1014.2 +152700 PERFORM DE-LETE. SG1014.2 +152800 SEG-WRITE-83. SG1014.2 +152900 MOVE "SEG-TEST-83 " TO PAR-NAME. SG1014.2 +153000 PERFORM PRINT-DETAIL. SG1014.2 +153100 SEG-TEST-84. SG1014.2 +153200 MOVE SPACE TO TEST-CHECK. SG1014.2 +153300 PERFORM 83. SG1014.2 +153400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +153500 PERFORM PASS SG1014.2 +153600 GO TO SEG-WRITE-84. SG1014.2 +153700 MOVE SPACE TO COMPUTED-A. SG1014.2 +153800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +153900 PERFORM FAIL. SG1014.2 +154000 GO TO SEG-WRITE-84. SG1014.2 +154100 SEG-DELETE-84. SG1014.2 +154200 PERFORM DE-LETE. SG1014.2 +154300 SEG-WRITE-84. SG1014.2 +154400 MOVE "SEG-TEST-84 " TO PAR-NAME. SG1014.2 +154500 PERFORM PRINT-DETAIL. SG1014.2 +154600 SEG-TEST-85. SG1014.2 +154700 MOVE SPACE TO TEST-CHECK. SG1014.2 +154800 PERFORM 84. SG1014.2 +154900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +155000 PERFORM PASS SG1014.2 +155100 GO TO SEG-WRITE-85. SG1014.2 +155200 MOVE SPACE TO COMPUTED-A. SG1014.2 +155300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +155400 PERFORM FAIL. SG1014.2 +155500 GO TO SEG-WRITE-85. SG1014.2 +155600 SEG-DELETE-85. SG1014.2 +155700 PERFORM DE-LETE. SG1014.2 +155800 SEG-WRITE-85. SG1014.2 +155900 MOVE "SEG-TEST-85 " TO PAR-NAME. SG1014.2 +156000 PERFORM PRINT-DETAIL. SG1014.2 +156100 SEG-TEST-86. SG1014.2 +156200 MOVE SPACE TO TEST-CHECK. SG1014.2 +156300 PERFORM 85. SG1014.2 +156400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +156500 PERFORM PASS SG1014.2 +156600 GO TO SEG-WRITE-86. SG1014.2 +156700 MOVE SPACE TO COMPUTED-A. SG1014.2 +156800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +156900 PERFORM FAIL. SG1014.2 +157000 GO TO SEG-WRITE-86. SG1014.2 +157100 SEG-DELETE-86. SG1014.2 +157200 PERFORM DE-LETE. SG1014.2 +157300 SEG-WRITE-86. SG1014.2 +157400 MOVE "SEG-TEST-86 " TO PAR-NAME. SG1014.2 +157500 PERFORM PRINT-DETAIL. SG1014.2 +157600 SEG-TEST-87. SG1014.2 +157700 MOVE SPACE TO TEST-CHECK. SG1014.2 +157800 PERFORM 86. SG1014.2 +157900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +158000 PERFORM PASS SG1014.2 +158100 GO TO SEG-WRITE-87. SG1014.2 +158200 MOVE SPACE TO COMPUTED-A. SG1014.2 +158300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +158400 PERFORM FAIL. SG1014.2 +158500 GO TO SEG-WRITE-87. SG1014.2 +158600 SEG-DELETE-87. SG1014.2 +158700 PERFORM DE-LETE. SG1014.2 +158800 SEG-WRITE-87. SG1014.2 +158900 MOVE "SEG-TEST-87 " TO PAR-NAME. SG1014.2 +159000 PERFORM PRINT-DETAIL. SG1014.2 +159100 SEG-TEST-88. SG1014.2 +159200 MOVE SPACE TO TEST-CHECK. SG1014.2 +159300 PERFORM 87. SG1014.2 +159400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +159500 PERFORM PASS SG1014.2 +159600 GO TO SEG-WRITE-88. SG1014.2 +159700 MOVE SPACE TO COMPUTED-A. SG1014.2 +159800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +159900 PERFORM FAIL. SG1014.2 +160000 GO TO SEG-WRITE-88. SG1014.2 +160100 SEG-DELETE-88. SG1014.2 +160200 PERFORM DE-LETE. SG1014.2 +160300 SEG-WRITE-88. SG1014.2 +160400 MOVE "SEG-TEST-88 " TO PAR-NAME. SG1014.2 +160500 PERFORM PRINT-DETAIL. SG1014.2 +160600 SEG-TEST-89. SG1014.2 +160700 MOVE SPACE TO TEST-CHECK. SG1014.2 +160800 PERFORM 88. SG1014.2 +160900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +161000 PERFORM PASS SG1014.2 +161100 GO TO SEG-WRITE-89. SG1014.2 +161200 MOVE SPACE TO COMPUTED-A. SG1014.2 +161300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +161400 PERFORM FAIL. SG1014.2 +161500 GO TO SEG-WRITE-89. SG1014.2 +161600 SEG-DELETE-89. SG1014.2 +161700 PERFORM DE-LETE. SG1014.2 +161800 SEG-WRITE-89. SG1014.2 +161900 MOVE "SEG-TEST-89 " TO PAR-NAME. SG1014.2 +162000 PERFORM PRINT-DETAIL. SG1014.2 +162100 SEG-TEST-90. SG1014.2 +162200 MOVE SPACE TO TEST-CHECK. SG1014.2 +162300 PERFORM 89. SG1014.2 +162400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +162500 PERFORM PASS SG1014.2 +162600 GO TO SEG-WRITE-90. SG1014.2 +162700 MOVE SPACE TO COMPUTED-A. SG1014.2 +162800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +162900 PERFORM FAIL. SG1014.2 +163000 GO TO SEG-WRITE-90. SG1014.2 +163100 SEG-DELETE-90. SG1014.2 +163200 PERFORM DE-LETE. SG1014.2 +163300 SEG-WRITE-90. SG1014.2 +163400 MOVE "SEG-TEST-90 " TO PAR-NAME. SG1014.2 +163500 PERFORM PRINT-DETAIL. SG1014.2 +163600 SEG-TEST-91. SG1014.2 +163700 MOVE SPACE TO TEST-CHECK. SG1014.2 +163800 PERFORM 90. SG1014.2 +163900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +164000 PERFORM PASS SG1014.2 +164100 GO TO SEG-WRITE-91. SG1014.2 +164200 MOVE SPACE TO COMPUTED-A. SG1014.2 +164300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +164400 PERFORM FAIL. SG1014.2 +164500 GO TO SEG-WRITE-91. SG1014.2 +164600 SEG-DELETE-91. SG1014.2 +164700 PERFORM DE-LETE. SG1014.2 +164800 SEG-WRITE-91. SG1014.2 +164900 MOVE "SEG-TEST-91 " TO PAR-NAME. SG1014.2 +165000 PERFORM PRINT-DETAIL. SG1014.2 +165100 SEG-TEST-92. SG1014.2 +165200 MOVE SPACE TO TEST-CHECK. SG1014.2 +165300 PERFORM 91. SG1014.2 +165400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +165500 PERFORM PASS SG1014.2 +165600 GO TO SEG-WRITE-92. SG1014.2 +165700 MOVE SPACE TO COMPUTED-A. SG1014.2 +165800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +165900 PERFORM FAIL. SG1014.2 +166000 GO TO SEG-WRITE-92. SG1014.2 +166100 SEG-DELETE-92. SG1014.2 +166200 PERFORM DE-LETE. SG1014.2 +166300 SEG-WRITE-92. SG1014.2 +166400 MOVE "SEG-TEST-92 " TO PAR-NAME. SG1014.2 +166500 PERFORM PRINT-DETAIL. SG1014.2 +166600 SEG-TEST-93. SG1014.2 +166700 MOVE SPACE TO TEST-CHECK. SG1014.2 +166800 PERFORM 92. SG1014.2 +166900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +167000 PERFORM PASS SG1014.2 +167100 GO TO SEG-WRITE-93. SG1014.2 +167200 MOVE SPACE TO COMPUTED-A. SG1014.2 +167300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +167400 PERFORM FAIL. SG1014.2 +167500 GO TO SEG-WRITE-93. SG1014.2 +167600 SEG-DELETE-93. SG1014.2 +167700 PERFORM DE-LETE. SG1014.2 +167800 SEG-WRITE-93. SG1014.2 +167900 MOVE "SEG-TEST-93 " TO PAR-NAME. SG1014.2 +168000 PERFORM PRINT-DETAIL. SG1014.2 +168100 SEG-TEST-94. SG1014.2 +168200 MOVE SPACE TO TEST-CHECK. SG1014.2 +168300 PERFORM 93. SG1014.2 +168400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +168500 PERFORM PASS SG1014.2 +168600 GO TO SEG-WRITE-94. SG1014.2 +168700 MOVE SPACE TO COMPUTED-A. SG1014.2 +168800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +168900 PERFORM FAIL. SG1014.2 +169000 GO TO SEG-WRITE-94. SG1014.2 +169100 SEG-DELETE-94. SG1014.2 +169200 PERFORM DE-LETE. SG1014.2 +169300 SEG-WRITE-94. SG1014.2 +169400 MOVE "SEG-TEST-94 " TO PAR-NAME. SG1014.2 +169500 PERFORM PRINT-DETAIL. SG1014.2 +169600 SEG-TEST-95. SG1014.2 +169700 MOVE SPACE TO TEST-CHECK. SG1014.2 +169800 PERFORM 94. SG1014.2 +169900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +170000 PERFORM PASS SG1014.2 +170100 GO TO SEG-WRITE-95. SG1014.2 +170200 MOVE SPACE TO COMPUTED-A. SG1014.2 +170300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +170400 PERFORM FAIL. SG1014.2 +170500 GO TO SEG-WRITE-95. SG1014.2 +170600 SEG-DELETE-95. SG1014.2 +170700 PERFORM DE-LETE. SG1014.2 +170800 SEG-WRITE-95. SG1014.2 +170900 MOVE "SEG-TEST-95 " TO PAR-NAME. SG1014.2 +171000 PERFORM PRINT-DETAIL. SG1014.2 +171100 SEG-TEST-96. SG1014.2 +171200 MOVE SPACE TO TEST-CHECK. SG1014.2 +171300 PERFORM 95. SG1014.2 +171400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +171500 PERFORM PASS SG1014.2 +171600 GO TO SEG-WRITE-96. SG1014.2 +171700 MOVE SPACE TO COMPUTED-A. SG1014.2 +171800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +171900 PERFORM FAIL. SG1014.2 +172000 GO TO SEG-WRITE-96. SG1014.2 +172100 SEG-DELETE-96. SG1014.2 +172200 PERFORM DE-LETE. SG1014.2 +172300 SEG-WRITE-96. SG1014.2 +172400 MOVE "SEG-TEST-96 " TO PAR-NAME. SG1014.2 +172500 PERFORM PRINT-DETAIL. SG1014.2 +172600 SEG-TEST-97. SG1014.2 +172700 MOVE SPACE TO TEST-CHECK. SG1014.2 +172800 PERFORM 96. SG1014.2 +172900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +173000 PERFORM PASS SG1014.2 +173100 GO TO SEG-WRITE-97. SG1014.2 +173200 MOVE SPACE TO COMPUTED-A. SG1014.2 +173300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +173400 PERFORM FAIL. SG1014.2 +173500 GO TO SEG-WRITE-97. SG1014.2 +173600 SEG-DELETE-97. SG1014.2 +173700 PERFORM DE-LETE. SG1014.2 +173800 SEG-WRITE-97. SG1014.2 +173900 MOVE "SEG-TEST-97 " TO PAR-NAME. SG1014.2 +174000 PERFORM PRINT-DETAIL. SG1014.2 +174100 SEG-TEST-98. SG1014.2 +174200 MOVE SPACE TO TEST-CHECK. SG1014.2 +174300 PERFORM 97. SG1014.2 +174400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +174500 PERFORM PASS SG1014.2 +174600 GO TO SEG-WRITE-98. SG1014.2 +174700 MOVE SPACE TO COMPUTED-A. SG1014.2 +174800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +174900 PERFORM FAIL. SG1014.2 +175000 GO TO SEG-WRITE-98. SG1014.2 +175100 SEG-DELETE-98. SG1014.2 +175200 PERFORM DE-LETE. SG1014.2 +175300 SEG-WRITE-98. SG1014.2 +175400 MOVE "SEG-TEST-98 " TO PAR-NAME. SG1014.2 +175500 PERFORM PRINT-DETAIL. SG1014.2 +175600 SEG-TEST-99. SG1014.2 +175700 MOVE SPACE TO TEST-CHECK. SG1014.2 +175800 PERFORM 98. SG1014.2 +175900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +176000 PERFORM PASS SG1014.2 +176100 GO TO SEG-WRITE-99. SG1014.2 +176200 MOVE SPACE TO COMPUTED-A. SG1014.2 +176300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +176400 PERFORM FAIL. SG1014.2 +176500 GO TO SEG-WRITE-99. SG1014.2 +176600 SEG-DELETE-99. SG1014.2 +176700 PERFORM DE-LETE. SG1014.2 +176800 SEG-WRITE-99. SG1014.2 +176900 MOVE "SEG-TEST-99 " TO PAR-NAME. SG1014.2 +177000 PERFORM PRINT-DETAIL. SG1014.2 +177100 SEG-TEST-100. SG1014.2 +177200 MOVE SPACE TO TEST-CHECK. SG1014.2 +177300 PERFORM 99. SG1014.2 +177400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +177500 PERFORM PASS SG1014.2 +177600 GO TO SEG-WRITE-100. SG1014.2 +177700 MOVE SPACE TO COMPUTED-A. SG1014.2 +177800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +177900 PERFORM FAIL. SG1014.2 +178000 GO TO SEG-WRITE-100. SG1014.2 +178100 SEG-DELETE-100. SG1014.2 +178200 PERFORM DE-LETE. SG1014.2 +178300 SEG-WRITE-100. SG1014.2 +178400 MOVE "SEG-TEST-100" TO PAR-NAME. SG1014.2 +178500 PERFORM PRINT-DETAIL. SG1014.2 +178600 GO TO SECOND-HALF. SG1014.2 +178700 01 SECTION 01. SG1014.2 +178800 PARA-01. SG1014.2 +178900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179000 02 SECTION 02. SG1014.2 +179100 PARA-02. SG1014.2 +179200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179300 03 SECTION 03. SG1014.2 +179400 PARA-03. SG1014.2 +179500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179600 04 SECTION 04. SG1014.2 +179700 PARA-04. SG1014.2 +179800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179900 05 SECTION 05. SG1014.2 +180000 PARA-05. SG1014.2 +180100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180200 06 SECTION 06. SG1014.2 +180300 PARA-06. SG1014.2 +180400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180500 07 SECTION 07. SG1014.2 +180600 PARA-07. SG1014.2 +180700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180800 08 SECTION 08. SG1014.2 +180900 PARA-08. SG1014.2 +181000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181100 09 SECTION 09. SG1014.2 +181200 PARA-09. SG1014.2 +181300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181400 10 SECTION 10. SG1014.2 +181500 PARA-10. SG1014.2 +181600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181700 11 SECTION 11. SG1014.2 +181800 PARA-11. SG1014.2 +181900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182000 12 SECTION 12. SG1014.2 +182100 PARA-12. SG1014.2 +182200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182300 13 SECTION 13. SG1014.2 +182400 PARA-13. SG1014.2 +182500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182600 14 SECTION 14. SG1014.2 +182700 PARA-14. SG1014.2 +182800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182900 15 SECTION 15. SG1014.2 +183000 PARA-15. SG1014.2 +183100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183200 16 SECTION 16. SG1014.2 +183300 PARA-16. SG1014.2 +183400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183500 17 SECTION 17. SG1014.2 +183600 PARA-17. SG1014.2 +183700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183800 18 SECTION 18. SG1014.2 +183900 PARA-18. SG1014.2 +184000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184100 19 SECTION 19. SG1014.2 +184200 PARA-19. SG1014.2 +184300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184400 20 SECTION 20. SG1014.2 +184500 PARA-20. SG1014.2 +184600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184700 21 SECTION 21. SG1014.2 +184800 PARA-21. SG1014.2 +184900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185000 22 SECTION 22. SG1014.2 +185100 PARA-22. SG1014.2 +185200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185300 23 SECTION 23. SG1014.2 +185400 PARA-23. SG1014.2 +185500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185600 24 SECTION 24. SG1014.2 +185700 PARA-24. SG1014.2 +185800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185900 25 SECTION 25. SG1014.2 +186000 PARA-25. SG1014.2 +186100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186200 26 SECTION 26. SG1014.2 +186300 PARA-26. SG1014.2 +186400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186500 27 SECTION 27. SG1014.2 +186600 PARA-27. SG1014.2 +186700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186800 28 SECTION 28. SG1014.2 +186900 PARA-28. SG1014.2 +187000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187100 29 SECTION 29. SG1014.2 +187200 PARA-29. SG1014.2 +187300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187400 30 SECTION 30. SG1014.2 +187500 PARA-30. SG1014.2 +187600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187700 31 SECTION 31. SG1014.2 +187800 PARA-31. SG1014.2 +187900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188000 32 SECTION 32. SG1014.2 +188100 PARA-32. SG1014.2 +188200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188300 33 SECTION 33. SG1014.2 +188400 PARA-33. SG1014.2 +188500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188600 34 SECTION 34. SG1014.2 +188700 PARA-34. SG1014.2 +188800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188900 35 SECTION 35. SG1014.2 +189000 PARA-35. SG1014.2 +189100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189200 36 SECTION 36. SG1014.2 +189300 PARA-36. SG1014.2 +189400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189500 37 SECTION 37. SG1014.2 +189600 PARA-37. SG1014.2 +189700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189800 38 SECTION 38. SG1014.2 +189900 PARA-38. SG1014.2 +190000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190100 39 SECTION 39. SG1014.2 +190200 PARA-39. SG1014.2 +190300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190400 40 SECTION 40. SG1014.2 +190500 PARA-40. SG1014.2 +190600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190700 41 SECTION 41. SG1014.2 +190800 PARA-41. SG1014.2 +190900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191000 42 SECTION 42. SG1014.2 +191100 PARA-42. SG1014.2 +191200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191300 43 SECTION 43. SG1014.2 +191400 PARA-43. SG1014.2 +191500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191600 44 SECTION 44. SG1014.2 +191700 PARA-44. SG1014.2 +191800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191900 45 SECTION 45. SG1014.2 +192000 PARA-45. SG1014.2 +192100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192200 46 SECTION 46. SG1014.2 +192300 PARA-46. SG1014.2 +192400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192500 47 SECTION 47. SG1014.2 +192600 PARA-47. SG1014.2 +192700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192800 48 SECTION 48. SG1014.2 +192900 PARA-48. SG1014.2 +193000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +193100 49 SECTION 49. SG1014.2 +193200 PARA-49. SG1014.2 +193300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +193400 SECOND-HALF SECTION 50. SG1014.2 +193500 SEG-TEST-101. SG1014.2 +193600 MOVE SPACE TO TEST-CHECK. SG1014.2 +193700 PERFORM 50. SG1014.2 +193800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +193900 PERFORM PASS SG1014.2 +194000 GO TO SEG-WRITE-101. SG1014.2 +194100 MOVE SPACE TO COMPUTED-A. SG1014.2 +194200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +194300 PERFORM FAIL. SG1014.2 +194400 GO TO SEG-WRITE-101. SG1014.2 +194500 SEG-DELETE-101. SG1014.2 +194600 PERFORM DE-LETE. SG1014.2 +194700 SEG-WRITE-101. SG1014.2 +194800 MOVE "SEG-TEST-101" TO PAR-NAME. SG1014.2 +194900 PERFORM PRINT-DETAIL. SG1014.2 +195000 SEG-TEST-102. SG1014.2 +195100 MOVE SPACE TO TEST-CHECK. SG1014.2 +195200 PERFORM 49. SG1014.2 +195300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +195400 PERFORM PASS SG1014.2 +195500 GO TO SEG-WRITE-102. SG1014.2 +195600 MOVE SPACE TO COMPUTED-A. SG1014.2 +195700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +195800 PERFORM FAIL. SG1014.2 +195900 GO TO SEG-WRITE-102. SG1014.2 +196000 SEG-DELETE-102. SG1014.2 +196100 PERFORM DE-LETE. SG1014.2 +196200 SEG-WRITE-102. SG1014.2 +196300 MOVE "SEG-TEST-102" TO PAR-NAME. SG1014.2 +196400 PERFORM PRINT-DETAIL. SG1014.2 +196500 SEG-TEST-103. SG1014.2 +196600 MOVE SPACE TO TEST-CHECK. SG1014.2 +196700 PERFORM 48. SG1014.2 +196800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +196900 PERFORM PASS SG1014.2 +197000 GO TO SEG-WRITE-103. SG1014.2 +197100 MOVE SPACE TO COMPUTED-A. SG1014.2 +197200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +197300 PERFORM FAIL. SG1014.2 +197400 GO TO SEG-WRITE-103. SG1014.2 +197500 SEG-DELETE-103. SG1014.2 +197600 PERFORM DE-LETE. SG1014.2 +197700 SEG-WRITE-103. SG1014.2 +197800 MOVE "SEG-TEST-103" TO PAR-NAME. SG1014.2 +197900 PERFORM PRINT-DETAIL. SG1014.2 +198000 SEG-TEST-104. SG1014.2 +198100 MOVE SPACE TO TEST-CHECK. SG1014.2 +198200 PERFORM 47. SG1014.2 +198300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +198400 PERFORM PASS SG1014.2 +198500 GO TO SEG-WRITE-104. SG1014.2 +198600 MOVE SPACE TO COMPUTED-A. SG1014.2 +198700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +198800 PERFORM FAIL. SG1014.2 +198900 GO TO SEG-WRITE-104. SG1014.2 +199000 SEG-DELETE-104. SG1014.2 +199100 PERFORM DE-LETE. SG1014.2 +199200 SEG-WRITE-104. SG1014.2 +199300 MOVE "SEG-TEST-104" TO PAR-NAME. SG1014.2 +199400 PERFORM PRINT-DETAIL. SG1014.2 +199500 SEG-TEST-105. SG1014.2 +199600 MOVE SPACE TO TEST-CHECK. SG1014.2 +199700 PERFORM 46. SG1014.2 +199800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +199900 PERFORM PASS SG1014.2 +200000 GO TO SEG-WRITE-105. SG1014.2 +200100 MOVE SPACE TO COMPUTED-A. SG1014.2 +200200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +200300 PERFORM FAIL. SG1014.2 +200400 GO TO SEG-WRITE-105. SG1014.2 +200500 SEG-DELETE-105. SG1014.2 +200600 PERFORM DE-LETE. SG1014.2 +200700 SEG-WRITE-105. SG1014.2 +200800 MOVE "SEG-TEST-105" TO PAR-NAME. SG1014.2 +200900 PERFORM PRINT-DETAIL. SG1014.2 +201000 SEG-TEST-106. SG1014.2 +201100 MOVE SPACE TO TEST-CHECK. SG1014.2 +201200 PERFORM 45. SG1014.2 +201300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +201400 PERFORM PASS SG1014.2 +201500 GO TO SEG-WRITE-106. SG1014.2 +201600 MOVE SPACE TO COMPUTED-A. SG1014.2 +201700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +201800 PERFORM FAIL. SG1014.2 +201900 GO TO SEG-WRITE-106. SG1014.2 +202000 SEG-DELETE-106. SG1014.2 +202100 PERFORM DE-LETE. SG1014.2 +202200 SEG-WRITE-106. SG1014.2 +202300 MOVE "SEG-TEST-106" TO PAR-NAME. SG1014.2 +202400 PERFORM PRINT-DETAIL. SG1014.2 +202500 SEG-TEST-107. SG1014.2 +202600 MOVE SPACE TO TEST-CHECK. SG1014.2 +202700 PERFORM 44. SG1014.2 +202800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +202900 PERFORM PASS SG1014.2 +203000 GO TO SEG-WRITE-107. SG1014.2 +203100 MOVE SPACE TO COMPUTED-A. SG1014.2 +203200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +203300 PERFORM FAIL. SG1014.2 +203400 GO TO SEG-WRITE-107. SG1014.2 +203500 SEG-DELETE-107. SG1014.2 +203600 PERFORM DE-LETE. SG1014.2 +203700 SEG-WRITE-107. SG1014.2 +203800 MOVE "SEG-TEST-107" TO PAR-NAME. SG1014.2 +203900 PERFORM PRINT-DETAIL. SG1014.2 +204000 SEG-TEST-108. SG1014.2 +204100 MOVE SPACE TO TEST-CHECK. SG1014.2 +204200 PERFORM 43. SG1014.2 +204300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +204400 PERFORM PASS SG1014.2 +204500 GO TO SEG-WRITE-108. SG1014.2 +204600 MOVE SPACE TO COMPUTED-A. SG1014.2 +204700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +204800 PERFORM FAIL. SG1014.2 +204900 GO TO SEG-WRITE-108. SG1014.2 +205000 SEG-DELETE-108. SG1014.2 +205100 PERFORM DE-LETE. SG1014.2 +205200 SEG-WRITE-108. SG1014.2 +205300 MOVE "SEG-TEST-108" TO PAR-NAME. SG1014.2 +205400 PERFORM PRINT-DETAIL. SG1014.2 +205500 SEG-TEST-109. SG1014.2 +205600 MOVE SPACE TO TEST-CHECK. SG1014.2 +205700 PERFORM 42. SG1014.2 +205800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +205900 PERFORM PASS SG1014.2 +206000 GO TO SEG-WRITE-109. SG1014.2 +206100 MOVE SPACE TO COMPUTED-A. SG1014.2 +206200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +206300 PERFORM FAIL. SG1014.2 +206400 GO TO SEG-WRITE-109. SG1014.2 +206500 SEG-DELETE-109. SG1014.2 +206600 PERFORM DE-LETE. SG1014.2 +206700 SEG-WRITE-109. SG1014.2 +206800 MOVE "SEG-TEST-109" TO PAR-NAME. SG1014.2 +206900 PERFORM PRINT-DETAIL. SG1014.2 +207000 SEG-TEST-110. SG1014.2 +207100 MOVE SPACE TO TEST-CHECK. SG1014.2 +207200 PERFORM 41. SG1014.2 +207300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +207400 PERFORM PASS SG1014.2 +207500 GO TO SEG-WRITE-110. SG1014.2 +207600 MOVE SPACE TO COMPUTED-A. SG1014.2 +207700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +207800 PERFORM FAIL. SG1014.2 +207900 GO TO SEG-WRITE-110. SG1014.2 +208000 SEG-DELETE-110. SG1014.2 +208100 PERFORM DE-LETE. SG1014.2 +208200 SEG-WRITE-110. SG1014.2 +208300 MOVE "SEG-TEST-110" TO PAR-NAME. SG1014.2 +208400 PERFORM PRINT-DETAIL. SG1014.2 +208500 SEG-TEST-111. SG1014.2 +208600 MOVE SPACE TO TEST-CHECK. SG1014.2 +208700 PERFORM 40. SG1014.2 +208800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +208900 PERFORM PASS SG1014.2 +209000 GO TO SEG-WRITE-111. SG1014.2 +209100 MOVE SPACE TO COMPUTED-A. SG1014.2 +209200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +209300 PERFORM FAIL. SG1014.2 +209400 GO TO SEG-WRITE-111. SG1014.2 +209500 SEG-DELETE-111. SG1014.2 +209600 PERFORM DE-LETE. SG1014.2 +209700 SEG-WRITE-111. SG1014.2 +209800 MOVE "SEG-TEST-111" TO PAR-NAME. SG1014.2 +209900 PERFORM PRINT-DETAIL. SG1014.2 +210000 SEG-TEST-112. SG1014.2 +210100 MOVE SPACE TO TEST-CHECK. SG1014.2 +210200 PERFORM 39. SG1014.2 +210300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +210400 PERFORM PASS SG1014.2 +210500 GO TO SEG-WRITE-112. SG1014.2 +210600 MOVE SPACE TO COMPUTED-A. SG1014.2 +210700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +210800 PERFORM FAIL. SG1014.2 +210900 GO TO SEG-WRITE-112. SG1014.2 +211000 SEG-DELETE-112. SG1014.2 +211100 PERFORM DE-LETE. SG1014.2 +211200 SEG-WRITE-112. SG1014.2 +211300 MOVE "SEG-TEST-112" TO PAR-NAME. SG1014.2 +211400 PERFORM PRINT-DETAIL. SG1014.2 +211500 SEG-TEST-113. SG1014.2 +211600 MOVE SPACE TO TEST-CHECK. SG1014.2 +211700 PERFORM 38. SG1014.2 +211800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +211900 PERFORM PASS SG1014.2 +212000 GO TO SEG-WRITE-113. SG1014.2 +212100 MOVE SPACE TO COMPUTED-A. SG1014.2 +212200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +212300 PERFORM FAIL. SG1014.2 +212400 GO TO SEG-WRITE-113. SG1014.2 +212500 SEG-DELETE-113. SG1014.2 +212600 PERFORM DE-LETE. SG1014.2 +212700 SEG-WRITE-113. SG1014.2 +212800 MOVE "SEG-TEST-113" TO PAR-NAME. SG1014.2 +212900 PERFORM PRINT-DETAIL. SG1014.2 +213000 SEG-TEST-114. SG1014.2 +213100 MOVE SPACE TO TEST-CHECK. SG1014.2 +213200 PERFORM 37. SG1014.2 +213300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +213400 PERFORM PASS SG1014.2 +213500 GO TO SEG-WRITE-114. SG1014.2 +213600 MOVE SPACE TO COMPUTED-A. SG1014.2 +213700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +213800 PERFORM FAIL. SG1014.2 +213900 GO TO SEG-WRITE-114. SG1014.2 +214000 SEG-DELETE-114. SG1014.2 +214100 PERFORM DE-LETE. SG1014.2 +214200 SEG-WRITE-114. SG1014.2 +214300 MOVE "SEG-TEST-114" TO PAR-NAME. SG1014.2 +214400 PERFORM PRINT-DETAIL. SG1014.2 +214500 SEG-TEST-115. SG1014.2 +214600 MOVE SPACE TO TEST-CHECK. SG1014.2 +214700 PERFORM 36. SG1014.2 +214800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +214900 PERFORM PASS SG1014.2 +215000 GO TO SEG-WRITE-115. SG1014.2 +215100 MOVE SPACE TO COMPUTED-A. SG1014.2 +215200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +215300 PERFORM FAIL. SG1014.2 +215400 GO TO SEG-WRITE-115. SG1014.2 +215500 SEG-DELETE-115. SG1014.2 +215600 PERFORM DE-LETE. SG1014.2 +215700 SEG-WRITE-115. SG1014.2 +215800 MOVE "SEG-TEST-115" TO PAR-NAME. SG1014.2 +215900 PERFORM PRINT-DETAIL. SG1014.2 +216000 SEG-TEST-116. SG1014.2 +216100 MOVE SPACE TO TEST-CHECK. SG1014.2 +216200 PERFORM 35. SG1014.2 +216300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +216400 PERFORM PASS SG1014.2 +216500 GO TO SEG-WRITE-116. SG1014.2 +216600 MOVE SPACE TO COMPUTED-A. SG1014.2 +216700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +216800 PERFORM FAIL. SG1014.2 +216900 GO TO SEG-WRITE-116. SG1014.2 +217000 SEG-DELETE-116. SG1014.2 +217100 PERFORM DE-LETE. SG1014.2 +217200 SEG-WRITE-116. SG1014.2 +217300 MOVE "SEG-TEST-116" TO PAR-NAME. SG1014.2 +217400 PERFORM PRINT-DETAIL. SG1014.2 +217500 SEG-TEST-117. SG1014.2 +217600 MOVE SPACE TO TEST-CHECK. SG1014.2 +217700 PERFORM 34. SG1014.2 +217800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +217900 PERFORM PASS SG1014.2 +218000 GO TO SEG-WRITE-117. SG1014.2 +218100 MOVE SPACE TO COMPUTED-A. SG1014.2 +218200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +218300 PERFORM FAIL. SG1014.2 +218400 GO TO SEG-WRITE-117. SG1014.2 +218500 SEG-DELETE-117. SG1014.2 +218600 PERFORM DE-LETE. SG1014.2 +218700 SEG-WRITE-117. SG1014.2 +218800 MOVE "SEG-TEST-117" TO PAR-NAME. SG1014.2 +218900 PERFORM PRINT-DETAIL. SG1014.2 +219000 SEG-TEST-118. SG1014.2 +219100 MOVE SPACE TO TEST-CHECK. SG1014.2 +219200 PERFORM 33. SG1014.2 +219300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +219400 PERFORM PASS SG1014.2 +219500 GO TO SEG-WRITE-118. SG1014.2 +219600 MOVE SPACE TO COMPUTED-A. SG1014.2 +219700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +219800 PERFORM FAIL. SG1014.2 +219900 GO TO SEG-WRITE-118. SG1014.2 +220000 SEG-DELETE-118. SG1014.2 +220100 PERFORM DE-LETE. SG1014.2 +220200 SEG-WRITE-118. SG1014.2 +220300 MOVE "SEG-TEST-118" TO PAR-NAME. SG1014.2 +220400 PERFORM PRINT-DETAIL. SG1014.2 +220500 SEG-TEST-119. SG1014.2 +220600 MOVE SPACE TO TEST-CHECK. SG1014.2 +220700 PERFORM 32. SG1014.2 +220800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +220900 PERFORM PASS SG1014.2 +221000 GO TO SEG-WRITE-119. SG1014.2 +221100 MOVE SPACE TO COMPUTED-A. SG1014.2 +221200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +221300 PERFORM FAIL. SG1014.2 +221400 GO TO SEG-WRITE-119. SG1014.2 +221500 SEG-DELETE-119. SG1014.2 +221600 PERFORM DE-LETE. SG1014.2 +221700 SEG-WRITE-119. SG1014.2 +221800 MOVE "SEG-TEST-119" TO PAR-NAME. SG1014.2 +221900 PERFORM PRINT-DETAIL. SG1014.2 +222000 SEG-TEST-120. SG1014.2 +222100 MOVE SPACE TO TEST-CHECK. SG1014.2 +222200 PERFORM 31. SG1014.2 +222300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +222400 PERFORM PASS SG1014.2 +222500 GO TO SEG-WRITE-120. SG1014.2 +222600 MOVE SPACE TO COMPUTED-A. SG1014.2 +222700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +222800 PERFORM FAIL. SG1014.2 +222900 GO TO SEG-WRITE-120. SG1014.2 +223000 SEG-DELETE-120. SG1014.2 +223100 PERFORM DE-LETE. SG1014.2 +223200 SEG-WRITE-120. SG1014.2 +223300 MOVE "SEG-TEST-120" TO PAR-NAME. SG1014.2 +223400 PERFORM PRINT-DETAIL. SG1014.2 +223500 SEG-TEST-121. SG1014.2 +223600 MOVE SPACE TO TEST-CHECK. SG1014.2 +223700 PERFORM 30. SG1014.2 +223800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +223900 PERFORM PASS SG1014.2 +224000 GO TO SEG-WRITE-121. SG1014.2 +224100 MOVE SPACE TO COMPUTED-A. SG1014.2 +224200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +224300 PERFORM FAIL. SG1014.2 +224400 GO TO SEG-WRITE-121. SG1014.2 +224500 SEG-DELETE-121. SG1014.2 +224600 PERFORM DE-LETE. SG1014.2 +224700 SEG-WRITE-121. SG1014.2 +224800 MOVE "SEG-TEST-121" TO PAR-NAME. SG1014.2 +224900 PERFORM PRINT-DETAIL. SG1014.2 +225000 SEG-TEST-122. SG1014.2 +225100 MOVE SPACE TO TEST-CHECK. SG1014.2 +225200 PERFORM 29. SG1014.2 +225300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +225400 PERFORM PASS SG1014.2 +225500 GO TO SEG-WRITE-122. SG1014.2 +225600 MOVE SPACE TO COMPUTED-A. SG1014.2 +225700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +225800 PERFORM FAIL. SG1014.2 +225900 GO TO SEG-WRITE-122. SG1014.2 +226000 SEG-DELETE-122. SG1014.2 +226100 PERFORM DE-LETE. SG1014.2 +226200 SEG-WRITE-122. SG1014.2 +226300 MOVE "SEG-TEST-122" TO PAR-NAME. SG1014.2 +226400 PERFORM PRINT-DETAIL. SG1014.2 +226500 SEG-TEST-123. SG1014.2 +226600 MOVE SPACE TO TEST-CHECK. SG1014.2 +226700 PERFORM 28. SG1014.2 +226800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +226900 PERFORM PASS SG1014.2 +227000 GO TO SEG-WRITE-123. SG1014.2 +227100 MOVE SPACE TO COMPUTED-A. SG1014.2 +227200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +227300 PERFORM FAIL. SG1014.2 +227400 GO TO SEG-WRITE-123. SG1014.2 +227500 SEG-DELETE-123. SG1014.2 +227600 PERFORM DE-LETE. SG1014.2 +227700 SEG-WRITE-123. SG1014.2 +227800 MOVE "SEG-TEST-123" TO PAR-NAME. SG1014.2 +227900 PERFORM PRINT-DETAIL. SG1014.2 +228000 SEG-TEST-124. SG1014.2 +228100 MOVE SPACE TO TEST-CHECK. SG1014.2 +228200 PERFORM 27. SG1014.2 +228300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +228400 PERFORM PASS SG1014.2 +228500 GO TO SEG-WRITE-124. SG1014.2 +228600 MOVE SPACE TO COMPUTED-A. SG1014.2 +228700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +228800 PERFORM FAIL. SG1014.2 +228900 GO TO SEG-WRITE-124. SG1014.2 +229000 SEG-DELETE-124. SG1014.2 +229100 PERFORM DE-LETE. SG1014.2 +229200 SEG-WRITE-124. SG1014.2 +229300 MOVE "SEG-TEST-124" TO PAR-NAME. SG1014.2 +229400 PERFORM PRINT-DETAIL. SG1014.2 +229500 SEG-TEST-125. SG1014.2 +229600 MOVE SPACE TO TEST-CHECK. SG1014.2 +229700 PERFORM 26. SG1014.2 +229800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +229900 PERFORM PASS SG1014.2 +230000 GO TO SEG-WRITE-125. SG1014.2 +230100 MOVE SPACE TO COMPUTED-A. SG1014.2 +230200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +230300 PERFORM FAIL. SG1014.2 +230400 GO TO SEG-WRITE-125. SG1014.2 +230500 SEG-DELETE-125. SG1014.2 +230600 PERFORM DE-LETE. SG1014.2 +230700 SEG-WRITE-125. SG1014.2 +230800 MOVE "SEG-TEST-125" TO PAR-NAME. SG1014.2 +230900 PERFORM PRINT-DETAIL. SG1014.2 +231000 SEG-TEST-126. SG1014.2 +231100 MOVE SPACE TO TEST-CHECK. SG1014.2 +231200 PERFORM 25. SG1014.2 +231300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +231400 PERFORM PASS SG1014.2 +231500 GO TO SEG-WRITE-126. SG1014.2 +231600 MOVE SPACE TO COMPUTED-A. SG1014.2 +231700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +231800 PERFORM FAIL. SG1014.2 +231900 GO TO SEG-WRITE-126. SG1014.2 +232000 SEG-DELETE-126. SG1014.2 +232100 PERFORM DE-LETE. SG1014.2 +232200 SEG-WRITE-126. SG1014.2 +232300 MOVE "SEG-TEST-126" TO PAR-NAME. SG1014.2 +232400 PERFORM PRINT-DETAIL. SG1014.2 +232500 SEG-TEST-127. SG1014.2 +232600 MOVE SPACE TO TEST-CHECK. SG1014.2 +232700 PERFORM 24. SG1014.2 +232800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +232900 PERFORM PASS SG1014.2 +233000 GO TO SEG-WRITE-127. SG1014.2 +233100 MOVE SPACE TO COMPUTED-A. SG1014.2 +233200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +233300 PERFORM FAIL. SG1014.2 +233400 GO TO SEG-WRITE-127. SG1014.2 +233500 SEG-DELETE-127. SG1014.2 +233600 PERFORM DE-LETE. SG1014.2 +233700 SEG-WRITE-127. SG1014.2 +233800 MOVE "SEG-TEST-127" TO PAR-NAME. SG1014.2 +233900 PERFORM PRINT-DETAIL. SG1014.2 +234000 SEG-TEST-128. SG1014.2 +234100 MOVE SPACE TO TEST-CHECK. SG1014.2 +234200 PERFORM 23. SG1014.2 +234300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +234400 PERFORM PASS SG1014.2 +234500 GO TO SEG-WRITE-128. SG1014.2 +234600 MOVE SPACE TO COMPUTED-A. SG1014.2 +234700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +234800 PERFORM FAIL. SG1014.2 +234900 GO TO SEG-WRITE-128. SG1014.2 +235000 SEG-DELETE-128. SG1014.2 +235100 PERFORM DE-LETE. SG1014.2 +235200 SEG-WRITE-128. SG1014.2 +235300 MOVE "SEG-TEST-128" TO PAR-NAME. SG1014.2 +235400 PERFORM PRINT-DETAIL. SG1014.2 +235500 SEG-TEST-129. SG1014.2 +235600 MOVE SPACE TO TEST-CHECK. SG1014.2 +235700 PERFORM 22. SG1014.2 +235800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +235900 PERFORM PASS SG1014.2 +236000 GO TO SEG-WRITE-129. SG1014.2 +236100 MOVE SPACE TO COMPUTED-A. SG1014.2 +236200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +236300 PERFORM FAIL. SG1014.2 +236400 GO TO SEG-WRITE-129. SG1014.2 +236500 SEG-DELETE-129. SG1014.2 +236600 PERFORM DE-LETE. SG1014.2 +236700 SEG-WRITE-129. SG1014.2 +236800 MOVE "SEG-TEST-129" TO PAR-NAME. SG1014.2 +236900 PERFORM PRINT-DETAIL. SG1014.2 +237000 SEG-TEST-130. SG1014.2 +237100 MOVE SPACE TO TEST-CHECK. SG1014.2 +237200 PERFORM 21. SG1014.2 +237300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +237400 PERFORM PASS SG1014.2 +237500 GO TO SEG-WRITE-130. SG1014.2 +237600 MOVE SPACE TO COMPUTED-A. SG1014.2 +237700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +237800 PERFORM FAIL. SG1014.2 +237900 GO TO SEG-WRITE-130. SG1014.2 +238000 SEG-DELETE-130. SG1014.2 +238100 PERFORM DE-LETE. SG1014.2 +238200 SEG-WRITE-130. SG1014.2 +238300 MOVE "SEG-TEST-130" TO PAR-NAME. SG1014.2 +238400 PERFORM PRINT-DETAIL. SG1014.2 +238500 SEG-TEST-131. SG1014.2 +238600 MOVE SPACE TO TEST-CHECK. SG1014.2 +238700 PERFORM 20. SG1014.2 +238800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +238900 PERFORM PASS SG1014.2 +239000 GO TO SEG-WRITE-131. SG1014.2 +239100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +239200 PERFORM FAIL. SG1014.2 +239300 GO TO SEG-WRITE-131. SG1014.2 +239400 SEG-DELETE-131. SG1014.2 +239500 PERFORM DE-LETE. SG1014.2 +239600 SEG-WRITE-131. SG1014.2 +239700 MOVE "SEG-TEST-131" TO PAR-NAME. SG1014.2 +239800 PERFORM PRINT-DETAIL. SG1014.2 +239900 SEG-TEST-132. SG1014.2 +240000 MOVE SPACE TO TEST-CHECK. SG1014.2 +240100 PERFORM 19. SG1014.2 +240200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +240300 PERFORM PASS SG1014.2 +240400 GO TO SEG-WRITE-132. SG1014.2 +240500 MOVE SPACE TO COMPUTED-A. SG1014.2 +240600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +240700 PERFORM FAIL. SG1014.2 +240800 GO TO SEG-WRITE-132. SG1014.2 +240900 SEG-DELETE-132. SG1014.2 +241000 PERFORM DE-LETE. SG1014.2 +241100 SEG-WRITE-132. SG1014.2 +241200 MOVE "SEG-TEST-132" TO PAR-NAME. SG1014.2 +241300 PERFORM PRINT-DETAIL. SG1014.2 +241400 SEG-TEST-133. SG1014.2 +241500 MOVE SPACE TO TEST-CHECK. SG1014.2 +241600 PERFORM 18. SG1014.2 +241700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +241800 PERFORM PASS SG1014.2 +241900 GO TO SEG-WRITE-133. SG1014.2 +242000 MOVE SPACE TO COMPUTED-A. SG1014.2 +242100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +242200 PERFORM FAIL. SG1014.2 +242300 GO TO SEG-WRITE-133. SG1014.2 +242400 SEG-DELETE-133. SG1014.2 +242500 PERFORM DE-LETE. SG1014.2 +242600 SEG-WRITE-133. SG1014.2 +242700 MOVE "SEG-TEST-133" TO PAR-NAME. SG1014.2 +242800 PERFORM PRINT-DETAIL. SG1014.2 +242900 SEG-TEST-134. SG1014.2 +243000 MOVE SPACE TO TEST-CHECK. SG1014.2 +243100 PERFORM 17. SG1014.2 +243200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +243300 PERFORM PASS SG1014.2 +243400 GO TO SEG-WRITE-134. SG1014.2 +243500 MOVE SPACE TO COMPUTED-A. SG1014.2 +243600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +243700 PERFORM FAIL. SG1014.2 +243800 GO TO SEG-WRITE-134. SG1014.2 +243900 SEG-DELETE-134. SG1014.2 +244000 PERFORM DE-LETE. SG1014.2 +244100 SEG-WRITE-134. SG1014.2 +244200 MOVE "SEG-TEST-134" TO PAR-NAME. SG1014.2 +244300 PERFORM PRINT-DETAIL. SG1014.2 +244400 SEG-TEST-135. SG1014.2 +244500 MOVE SPACE TO TEST-CHECK. SG1014.2 +244600 PERFORM 16. SG1014.2 +244700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +244800 PERFORM PASS SG1014.2 +244900 GO TO SEG-WRITE-135. SG1014.2 +245000 MOVE SPACE TO COMPUTED-A. SG1014.2 +245100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +245200 PERFORM FAIL. SG1014.2 +245300 GO TO SEG-WRITE-135. SG1014.2 +245400 SEG-DELETE-135. SG1014.2 +245500 PERFORM DE-LETE. SG1014.2 +245600 SEG-WRITE-135. SG1014.2 +245700 MOVE "SEG-TEST-135" TO PAR-NAME. SG1014.2 +245800 PERFORM PRINT-DETAIL. SG1014.2 +245900 SEG-TEST-136. SG1014.2 +246000 MOVE SPACE TO TEST-CHECK. SG1014.2 +246100 PERFORM 15. SG1014.2 +246200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +246300 PERFORM PASS SG1014.2 +246400 GO TO SEG-WRITE-136. SG1014.2 +246500 MOVE SPACE TO COMPUTED-A. SG1014.2 +246600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +246700 PERFORM FAIL. SG1014.2 +246800 GO TO SEG-WRITE-136. SG1014.2 +246900 SEG-DELETE-136. SG1014.2 +247000 PERFORM DE-LETE. SG1014.2 +247100 SEG-WRITE-136. SG1014.2 +247200 MOVE "SEG-TEST-136" TO PAR-NAME. SG1014.2 +247300 PERFORM PRINT-DETAIL. SG1014.2 +247400 SEG-TEST-137. SG1014.2 +247500 MOVE SPACE TO TEST-CHECK. SG1014.2 +247600 PERFORM 14. SG1014.2 +247700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +247800 PERFORM PASS SG1014.2 +247900 GO TO SEG-WRITE-137. SG1014.2 +248000 MOVE SPACE TO COMPUTED-A. SG1014.2 +248100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +248200 PERFORM FAIL. SG1014.2 +248300 GO TO SEG-WRITE-137. SG1014.2 +248400 SEG-DELETE-137. SG1014.2 +248500 PERFORM DE-LETE. SG1014.2 +248600 SEG-WRITE-137. SG1014.2 +248700 MOVE "SEG-TEST-137" TO PAR-NAME. SG1014.2 +248800 PERFORM PRINT-DETAIL. SG1014.2 +248900 SEG-TEST-138. SG1014.2 +249000 MOVE SPACE TO TEST-CHECK. SG1014.2 +249100 PERFORM 13. SG1014.2 +249200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +249300 PERFORM PASS SG1014.2 +249400 GO TO SEG-WRITE-138. SG1014.2 +249500 MOVE SPACE TO COMPUTED-A. SG1014.2 +249600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +249700 PERFORM FAIL. SG1014.2 +249800 GO TO SEG-WRITE-138. SG1014.2 +249900 SEG-DELETE-138. SG1014.2 +250000 PERFORM DE-LETE. SG1014.2 +250100 SEG-WRITE-138. SG1014.2 +250200 MOVE "SEG-TEST-138" TO PAR-NAME. SG1014.2 +250300 PERFORM PRINT-DETAIL. SG1014.2 +250400 SEG-TEST-139. SG1014.2 +250500 MOVE SPACE TO TEST-CHECK. SG1014.2 +250600 PERFORM 12. SG1014.2 +250700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +250800 PERFORM PASS SG1014.2 +250900 GO TO SEG-WRITE-139. SG1014.2 +251000 MOVE SPACE TO COMPUTED-A. SG1014.2 +251100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +251200 PERFORM FAIL. SG1014.2 +251300 GO TO SEG-WRITE-139. SG1014.2 +251400 SEG-DELETE-139. SG1014.2 +251500 PERFORM DE-LETE. SG1014.2 +251600 SEG-WRITE-139. SG1014.2 +251700 MOVE "SEG-TEST-139" TO PAR-NAME. SG1014.2 +251800 PERFORM PRINT-DETAIL. SG1014.2 +251900 SEG-TEST-140. SG1014.2 +252000 MOVE SPACE TO TEST-CHECK. SG1014.2 +252100 PERFORM 11. SG1014.2 +252200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +252300 PERFORM PASS SG1014.2 +252400 GO TO SEG-WRITE-140. SG1014.2 +252500 MOVE SPACE TO COMPUTED-A. SG1014.2 +252600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +252700 PERFORM FAIL. SG1014.2 +252800 GO TO SEG-WRITE-140. SG1014.2 +252900 SEG-DELETE-140. SG1014.2 +253000 PERFORM DE-LETE. SG1014.2 +253100 SEG-WRITE-140. SG1014.2 +253200 MOVE "SEG-TEST-140" TO PAR-NAME. SG1014.2 +253300 PERFORM PRINT-DETAIL. SG1014.2 +253400 SEG-TEST-141. SG1014.2 +253500 MOVE SPACE TO TEST-CHECK. SG1014.2 +253600 PERFORM 10. SG1014.2 +253700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +253800 PERFORM PASS SG1014.2 +253900 GO TO SEG-WRITE-141. SG1014.2 +254000 MOVE SPACE TO COMPUTED-A. SG1014.2 +254100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +254200 PERFORM FAIL. SG1014.2 +254300 GO TO SEG-WRITE-141. SG1014.2 +254400 SEG-DELETE-141. SG1014.2 +254500 PERFORM DE-LETE. SG1014.2 +254600 SEG-WRITE-141. SG1014.2 +254700 MOVE "SEG-TEST-141" TO PAR-NAME. SG1014.2 +254800 PERFORM PRINT-DETAIL. SG1014.2 +254900 SEG-TEST-142. SG1014.2 +255000 MOVE SPACE TO TEST-CHECK. SG1014.2 +255100 PERFORM 09. SG1014.2 +255200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +255300 PERFORM PASS SG1014.2 +255400 GO TO SEG-WRITE-142. SG1014.2 +255500 MOVE SPACE TO COMPUTED-A. SG1014.2 +255600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +255700 PERFORM FAIL. SG1014.2 +255800 GO TO SEG-WRITE-142. SG1014.2 +255900 SEG-DELETE-142. SG1014.2 +256000 PERFORM DE-LETE. SG1014.2 +256100 SEG-WRITE-142. SG1014.2 +256200 MOVE "SEG-TEST-142" TO PAR-NAME. SG1014.2 +256300 PERFORM PRINT-DETAIL. SG1014.2 +256400 SEG-TEST-143. SG1014.2 +256500 MOVE SPACE TO TEST-CHECK. SG1014.2 +256600 PERFORM 08. SG1014.2 +256700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +256800 PERFORM PASS SG1014.2 +256900 GO TO SEG-WRITE-143. SG1014.2 +257000 MOVE SPACE TO COMPUTED-A. SG1014.2 +257100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +257200 PERFORM FAIL. SG1014.2 +257300 GO TO SEG-WRITE-143. SG1014.2 +257400 SEG-DELETE-143. SG1014.2 +257500 PERFORM DE-LETE. SG1014.2 +257600 SEG-WRITE-143. SG1014.2 +257700 MOVE "SEG-TEST-143" TO PAR-NAME. SG1014.2 +257800 PERFORM PRINT-DETAIL. SG1014.2 +257900 SEG-TEST-144. SG1014.2 +258000 MOVE SPACE TO TEST-CHECK. SG1014.2 +258100 PERFORM 07. SG1014.2 +258200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +258300 PERFORM PASS SG1014.2 +258400 GO TO SEG-WRITE-144. SG1014.2 +258500 MOVE SPACE TO COMPUTED-A. SG1014.2 +258600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +258700 PERFORM FAIL. SG1014.2 +258800 GO TO SEG-WRITE-144. SG1014.2 +258900 SEG-DELETE-144. SG1014.2 +259000 PERFORM DE-LETE. SG1014.2 +259100 SEG-WRITE-144. SG1014.2 +259200 MOVE "SEG-TEST-144" TO PAR-NAME. SG1014.2 +259300 PERFORM PRINT-DETAIL. SG1014.2 +259400 SEG-TEST-145. SG1014.2 +259500 MOVE SPACE TO TEST-CHECK. SG1014.2 +259600 PERFORM 06. SG1014.2 +259700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +259800 PERFORM PASS SG1014.2 +259900 GO TO SEG-WRITE-145. SG1014.2 +260000 MOVE SPACE TO COMPUTED-A. SG1014.2 +260100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +260200 PERFORM FAIL. SG1014.2 +260300 GO TO SEG-WRITE-145. SG1014.2 +260400 SEG-DELETE-145. SG1014.2 +260500 PERFORM DE-LETE. SG1014.2 +260600 SEG-WRITE-145. SG1014.2 +260700 MOVE "SEG-TEST-145" TO PAR-NAME. SG1014.2 +260800 PERFORM PRINT-DETAIL. SG1014.2 +260900 SEG-TEST-146. SG1014.2 +261000 MOVE SPACE TO TEST-CHECK. SG1014.2 +261100 PERFORM 05. SG1014.2 +261200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +261300 PERFORM PASS SG1014.2 +261400 GO TO SEG-WRITE-146. SG1014.2 +261500 MOVE SPACE TO COMPUTED-A. SG1014.2 +261600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +261700 PERFORM FAIL. SG1014.2 +261800 GO TO SEG-WRITE-146. SG1014.2 +261900 SEG-DELETE-146. SG1014.2 +262000 PERFORM DE-LETE. SG1014.2 +262100 SEG-WRITE-146. SG1014.2 +262200 MOVE "SEG-TEST-146" TO PAR-NAME. SG1014.2 +262300 PERFORM PRINT-DETAIL. SG1014.2 +262400 SEG-TEST-147. SG1014.2 +262500 MOVE SPACE TO TEST-CHECK. SG1014.2 +262600 PERFORM 04. SG1014.2 +262700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +262800 PERFORM PASS SG1014.2 +262900 GO TO SEG-WRITE-147. SG1014.2 +263000 MOVE SPACE TO COMPUTED-A. SG1014.2 +263100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +263200 PERFORM FAIL. SG1014.2 +263300 GO TO SEG-WRITE-147. SG1014.2 +263400 SEG-DELETE-147. SG1014.2 +263500 PERFORM DE-LETE. SG1014.2 +263600 SEG-WRITE-147. SG1014.2 +263700 MOVE "SEG-TEST-147" TO PAR-NAME. SG1014.2 +263800 PERFORM PRINT-DETAIL. SG1014.2 +263900 SEG-TEST-148. SG1014.2 +264000 MOVE SPACE TO TEST-CHECK. SG1014.2 +264100 PERFORM 03. SG1014.2 +264200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +264300 PERFORM PASS SG1014.2 +264400 GO TO SEG-WRITE-148. SG1014.2 +264500 MOVE SPACE TO COMPUTED-A. SG1014.2 +264600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +264700 PERFORM FAIL. SG1014.2 +264800 GO TO SEG-WRITE-148. SG1014.2 +264900 SEG-DELETE-148. SG1014.2 +265000 PERFORM DE-LETE. SG1014.2 +265100 SEG-WRITE-148. SG1014.2 +265200 MOVE "SEG-TEST-148" TO PAR-NAME. SG1014.2 +265300 PERFORM PRINT-DETAIL. SG1014.2 +265400 SEG-TEST-149. SG1014.2 +265500 MOVE SPACE TO TEST-CHECK. SG1014.2 +265600 PERFORM 02. SG1014.2 +265700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +265800 PERFORM PASS SG1014.2 +265900 GO TO SEG-WRITE-149. SG1014.2 +266000 MOVE SPACE TO COMPUTED-A. SG1014.2 +266100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +266200 PERFORM FAIL. SG1014.2 +266300 GO TO SEG-WRITE-149. SG1014.2 +266400 SEG-DELETE-149. SG1014.2 +266500 PERFORM DE-LETE. SG1014.2 +266600 SEG-WRITE-149. SG1014.2 +266700 MOVE "SEG-TEST-149" TO PAR-NAME. SG1014.2 +266800 PERFORM PRINT-DETAIL. SG1014.2 +266900 SEG-TEST-150. SG1014.2 +267000 MOVE SPACE TO TEST-CHECK. SG1014.2 +267100 PERFORM 01. SG1014.2 +267200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +267300 PERFORM PASS SG1014.2 +267400 GO TO SEG-WRITE-150. SG1014.2 +267500 MOVE SPACE TO COMPUTED-A. SG1014.2 +267600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +267700 PERFORM FAIL. SG1014.2 +267800 GO TO SEG-WRITE-150. SG1014.2 +267900 SEG-DELETE-150. SG1014.2 +268000 PERFORM DE-LETE. SG1014.2 +268100 SEG-WRITE-150. SG1014.2 +268200 MOVE "SEG-TEST-150" TO PAR-NAME. SG1014.2 +268300 PERFORM PRINT-DETAIL. SG1014.2 +268400 SEG-TEST-151. SG1014.2 +268500 MOVE SPACE TO TEST-CHECK. SG1014.2 +268600 PERFORM 00. SG1014.2 +268700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +268800 PERFORM PASS SG1014.2 +268900 GO TO SEG-WRITE-151. SG1014.2 +269000 MOVE SPACE TO COMPUTED-A. SG1014.2 +269100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +269200 PERFORM FAIL. SG1014.2 +269300 GO TO SEG-WRITE-151. SG1014.2 +269400 SEG-DELETE-151. SG1014.2 +269500 PERFORM DE-LETE. SG1014.2 +269600 SEG-WRITE-151. SG1014.2 +269700 MOVE "SEG-TEST-151" TO PAR-NAME. SG1014.2 +269800 PERFORM PRINT-DETAIL. SG1014.2 +269900 GO TO CLOSE-FILES. SG1014.2 +270000 50 SECTION 50. SG1014.2 +270100 PARA-50. SG1014.2 +270200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270300 51 SECTION 51. SG1014.2 +270400 PARA-51. SG1014.2 +270500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270600 52 SECTION 52. SG1014.2 +270700 PARA-52. SG1014.2 +270800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270900 53 SECTION 53. SG1014.2 +271000 PARA-53. SG1014.2 +271100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271200 54 SECTION 54. SG1014.2 +271300 PARA-54. SG1014.2 +271400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271500 55 SECTION 55. SG1014.2 +271600 PARA-55. SG1014.2 +271700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271800 56 SECTION 56. SG1014.2 +271900 PARA-56. SG1014.2 +272000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272100 57 SECTION 57. SG1014.2 +272200 PARA-57. SG1014.2 +272300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272400 58 SECTION 58. SG1014.2 +272500 PARA-58. SG1014.2 +272600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272700 59 SECTION 59. SG1014.2 +272800 PARA-59. SG1014.2 +272900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273000 60 SECTION 60. SG1014.2 +273100 PARA-60. SG1014.2 +273200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273300 61 SECTION 61. SG1014.2 +273400 PARA-61. SG1014.2 +273500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273600 62 SECTION 62. SG1014.2 +273700 PARA-62. SG1014.2 +273800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273900 63 SECTION 63. SG1014.2 +274000 PARA-63. SG1014.2 +274100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274200 64 SECTION 64. SG1014.2 +274300 PARA-64. SG1014.2 +274400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274500 65 SECTION 65. SG1014.2 +274600 PARA-65. SG1014.2 +274700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274800 66 SECTION 66. SG1014.2 +274900 PARA-66. SG1014.2 +275000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275100 67 SECTION 67. SG1014.2 +275200 PARA-67. SG1014.2 +275300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275400 68 SECTION 68. SG1014.2 +275500 PARA-68. SG1014.2 +275600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275700 69 SECTION 69. SG1014.2 +275800 PARA-69. SG1014.2 +275900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276000 70 SECTION 70. SG1014.2 +276100 PARA-70. SG1014.2 +276200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276300 71 SECTION 71. SG1014.2 +276400 PARA-71. SG1014.2 +276500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276600 72 SECTION 72. SG1014.2 +276700 PARA-72. SG1014.2 +276800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276900 73 SECTION 73. SG1014.2 +277000 PARA-73. SG1014.2 +277100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277200 74 SECTION 74. SG1014.2 +277300 PARA-74. SG1014.2 +277400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277500 75 SECTION 75. SG1014.2 +277600 PARA-75. SG1014.2 +277700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277800 76 SECTION 76. SG1014.2 +277900 PARA-76. SG1014.2 +278000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278100 77 SECTION 77. SG1014.2 +278200 PARA-77. SG1014.2 +278300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278400 78 SECTION 78. SG1014.2 +278500 PARA-78. SG1014.2 +278600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278700 79 SECTION 79. SG1014.2 +278800 PARA-79. SG1014.2 +278900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279000 80 SECTION 80. SG1014.2 +279100 PARA-80. SG1014.2 +279200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279300 81 SECTION 81. SG1014.2 +279400 PARA-81. SG1014.2 +279500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279600 82 SECTION 82. SG1014.2 +279700 PARA-82. SG1014.2 +279800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279900 83 SECTION 83. SG1014.2 +280000 PARA-83. SG1014.2 +280100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280200 84 SECTION 84. SG1014.2 +280300 PARA-84. SG1014.2 +280400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280500 85 SECTION 85. SG1014.2 +280600 PARA-85. SG1014.2 +280700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280800 86 SECTION 86. SG1014.2 +280900 PARA-86. SG1014.2 +281000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281100 87 SECTION 87. SG1014.2 +281200 PARA-87. SG1014.2 +281300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281400 88 SECTION 88. SG1014.2 +281500 PARA-88. SG1014.2 +281600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281700 89 SECTION 89. SG1014.2 +281800 PARA-89. SG1014.2 +281900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282000 90 SECTION 90. SG1014.2 +282100 PARA-90. SG1014.2 +282200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282300 91 SECTION 91. SG1014.2 +282400 PARA-91. SG1014.2 +282500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282600 92 SECTION 92. SG1014.2 +282700 PARA-92. SG1014.2 +282800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282900 93 SECTION 93. SG1014.2 +283000 PARA-93. SG1014.2 +283100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283200 94 SECTION 94. SG1014.2 +283300 PARA-94. SG1014.2 +283400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283500 95 SECTION 95. SG1014.2 +283600 PARA-95. SG1014.2 +283700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283800 96 SECTION 96. SG1014.2 +283900 PARA-96. SG1014.2 +284000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284100 97 SECTION 97. SG1014.2 +284200 PARA-97. SG1014.2 +284300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284400 98 SECTION 98. SG1014.2 +284500 PARA-98. SG1014.2 +284600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284700 99 SECTION 99. SG1014.2 +284800 PARA-99. SG1014.2 +284900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +*END-OF,SG101A +*HEADER,COBOL,SG102A +000100 IDENTIFICATION DIVISION. SG1024.2 +000200 PROGRAM-ID. SG1024.2 +000300 SG102A. SG1024.2 +000400 AUTHOR. SG1024.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1024.2 +000600 INSTALLATION. SG1024.2 +000700 GENERAL SERVICES ADMINISTRATION SG1024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1024.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1024.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1024.2 +001200 SG1024.2 +001300 PHONE (703) 756-6153 SG1024.2 +001400 SG1024.2 +001500 " HIGH ". SG1024.2 +001600 DATE-WRITTEN. SG1024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1024.2 +001800 CREATION DATE / VALIDATION DATE SG1024.2 +001900 "4.2 ". SG1024.2 +002000 SECURITY. SG1024.2 +002100 NONE. SG1024.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1024.2 +002300 VARIOUS ALTER AND PERFORM STATEMENTS ARE EXERCISED SG1024.2 +002400 AND A DIRECTORY IS PREPARED IN EACH TEST TO TRACE SG1024.2 +002500 PROGRAM FLOW. SG1024.2 +002600 SG1024.2 +002700 ENVIRONMENT DIVISION. SG1024.2 +002800 CONFIGURATION SECTION. SG1024.2 +002900 SOURCE-COMPUTER. SG1024.2 +003000 XXXXX082. SG1024.2 +003100 OBJECT-COMPUTER. SG1024.2 +003200 XXXXX083. SG1024.2 +003300 INPUT-OUTPUT SECTION. SG1024.2 +003400 FILE-CONTROL. SG1024.2 +003500 SELECT PRINT-FILE ASSIGN TO SG1024.2 +003600 XXXXX055. SG1024.2 +003700 DATA DIVISION. SG1024.2 +003800 FILE SECTION. SG1024.2 +003900 FD PRINT-FILE SG1024.2 +004000 LABEL RECORDS SG1024.2 +004100 XXXXX084 SG1024.2 +004200 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1024.2 +004300 01 PRINT-REC PICTURE X(120). SG1024.2 +004400 01 DUMMY-RECORD PICTURE X(120). SG1024.2 +004500 WORKING-STORAGE SECTION. SG1024.2 +004600 77 SEG-CALC PICTURE 9 VALUE 0. SG1024.2 +004700 77 RANGE-SUB PICTURE 9 VALUE 0. SG1024.2 +004800 01 COMPUTED-RANGE. SG1024.2 +004900 02 RANGE-X OCCURS 7 TIMES PICTURE X. SG1024.2 +005000 01 TEST-RESULTS. SG1024.2 +005100 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1024.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1024.2 +005500 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005600 02 PAR-NAME. SG1024.2 +005700 03 FILLER PICTURE X(12) VALUE SPACE. SG1024.2 +005800 03 PARDOT-X PICTURE X VALUE SPACE. SG1024.2 +005900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1024.2 +006000 03 FILLER PIC X(5) VALUE SPACE. SG1024.2 +006100 02 FILLER PIC X(10) VALUE SPACE. SG1024.2 +006200 02 RE-MARK PIC X(61). SG1024.2 +006300 01 TEST-COMPUTED. SG1024.2 +006400 02 FILLER PIC X(30) VALUE SPACE. SG1024.2 +006500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1024.2 +006600 02 COMPUTED-X. SG1024.2 +006700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1024.2 +006800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1024.2 +006900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1024.2 +007000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1024.2 +007100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1024.2 +007200 03 CM-18V0 REDEFINES COMPUTED-A. SG1024.2 +007300 04 COMPUTED-18V0 PICTURE -9(18). SG1024.2 +007400 04 FILLER PICTURE X. SG1024.2 +007500 03 FILLER PIC X(50) VALUE SPACE. SG1024.2 +007600 01 TEST-CORRECT. SG1024.2 +007700 02 FILLER PIC X(30) VALUE SPACE. SG1024.2 +007800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1024.2 +007900 02 CORRECT-X. SG1024.2 +008000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1024.2 +008100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1024.2 +008200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1024.2 +008300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1024.2 +008400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1024.2 +008500 03 CR-18V0 REDEFINES CORRECT-A. SG1024.2 +008600 04 CORRECT-18V0 PICTURE -9(18). SG1024.2 +008700 04 FILLER PICTURE X. SG1024.2 +008800 03 FILLER PIC X(50) VALUE SPACE. SG1024.2 +008900 01 CCVS-C-1. SG1024.2 +009000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1024.2 +009100- "SS PARAGRAPH-NAME SG1024.2 +009200- " REMARKS". SG1024.2 +009300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1024.2 +009400 01 CCVS-C-2. SG1024.2 +009500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +009600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1024.2 +009700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1024.2 +009800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1024.2 +009900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1024.2 +010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1024.2 +010100 01 REC-CT PICTURE 99 VALUE ZERO. SG1024.2 +010200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1024.2 +010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1024.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1024.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1024.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1024.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1024.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1024.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1024.2 +011000 01 CCVS-H-1. SG1024.2 +011100 02 FILLER PICTURE X(27) VALUE SPACE. SG1024.2 +011200 02 FILLER PICTURE X(67) VALUE SG1024.2 +011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1024.2 +011400- " SYSTEM". SG1024.2 +011500 02 FILLER PICTURE X(26) VALUE SPACE. SG1024.2 +011600 01 CCVS-H-2. SG1024.2 +011700 02 FILLER PICTURE X(52) VALUE IS SG1024.2 +011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1024.2 +011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1024.2 +012000 02 TEST-ID PICTURE IS X(9). SG1024.2 +012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1024.2 +012200 01 CCVS-H-3. SG1024.2 +012300 02 FILLER PICTURE X(34) VALUE SG1024.2 +012400 " FOR OFFICIAL USE ONLY ". SG1024.2 +012500 02 FILLER PICTURE X(58) VALUE SG1024.2 +012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1024.2 +012700 02 FILLER PICTURE X(28) VALUE SG1024.2 +012800 " COPYRIGHT 1974 ". SG1024.2 +012900 01 CCVS-E-1. SG1024.2 +013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1024.2 +013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1024.2 +013200 02 ID-AGAIN PICTURE IS X(9). SG1024.2 +013300 02 FILLER PICTURE X(45) VALUE IS SG1024.2 +013400 " NTIS DISTRIBUTION COBOL 74". SG1024.2 +013500 01 CCVS-E-2. SG1024.2 +013600 02 FILLER PICTURE X(31) VALUE SG1024.2 +013700 SPACE. SG1024.2 +013800 02 FILLER PICTURE X(21) VALUE SPACE. SG1024.2 +013900 02 CCVS-E-2-2. SG1024.2 +014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1024.2 +014100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1024.2 +014300 01 CCVS-E-3. SG1024.2 +014400 02 FILLER PICTURE X(22) VALUE SG1024.2 +014500 " FOR OFFICIAL USE ONLY". SG1024.2 +014600 02 FILLER PICTURE X(12) VALUE SPACE. SG1024.2 +014700 02 FILLER PICTURE X(58) VALUE SG1024.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1024.2 +014900 02 FILLER PICTURE X(13) VALUE SPACE. SG1024.2 +015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1024.2 +015100 01 CCVS-E-4. SG1024.2 +015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1024.2 +015300 02 FILLER PIC XXXX VALUE " OF ". SG1024.2 +015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1024.2 +015500 02 FILLER PIC X(40) VALUE SG1024.2 +015600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1024.2 +015700 01 XXINFO. SG1024.2 +015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1024.2 +015900 02 INFO-TEXT. SG1024.2 +016000 04 FILLER PIC X(20) VALUE SPACE. SG1024.2 +016100 04 XXCOMPUTED PIC X(20). SG1024.2 +016200 04 FILLER PIC X(5) VALUE SPACE. SG1024.2 +016300 04 XXCORRECT PIC X(20). SG1024.2 +016400 01 HYPHEN-LINE. SG1024.2 +016500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +016600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1024.2 +016700- "*****************************************". SG1024.2 +016800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1024.2 +016900- "******************************". SG1024.2 +017000 01 CCVS-PGM-ID PIC X(6) VALUE SG1024.2 +017100 "SG102A". SG1024.2 +017200 PROCEDURE DIVISION. SG1024.2 +017300 SECT-SG-02-001 SECTION 50. SG1024.2 +017400 SG-02-001. SG1024.2 +017500 PERFORM CCVS1. SG1024.2 +017600 GO TO SEG-TEST-1. SG1024.2 +017700 CCVS1 SECTION. SG1024.2 +017800 OPEN-FILES. SG1024.2 +017900 OPEN OUTPUT PRINT-FILE. SG1024.2 +018000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1024.2 +018100 MOVE SPACE TO TEST-RESULTS. SG1024.2 +018200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1024.2 +018300 GO TO CCVS1-EXIT. SG1024.2 +018400 CLOSE-FILES. SG1024.2 +018500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1024.2 +018600 TERMINATE-CCVS. SG1024.2 +018700S EXIT PROGRAM. SG1024.2 +018800STERMINATE-CALL. SG1024.2 +018900 STOP RUN. SG1024.2 +019000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1024.2 +019100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1024.2 +019200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1024.2 +019300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1024.2 +019400 MOVE "****TEST DELETED****" TO RE-MARK. SG1024.2 +019500 PRINT-DETAIL. SG1024.2 +019600 IF REC-CT NOT EQUAL TO ZERO SG1024.2 +019700 MOVE "." TO PARDOT-X SG1024.2 +019800 MOVE REC-CT TO DOTVALUE. SG1024.2 +019900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1024.2 +020000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1024.2 +020100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1024.2 +020200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1024.2 +020300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1024.2 +020400 MOVE SPACE TO CORRECT-X. SG1024.2 +020500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1024.2 +020600 MOVE SPACE TO RE-MARK. SG1024.2 +020700 HEAD-ROUTINE. SG1024.2 +020800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +020900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1024.2 +021000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1024.2 +021100 COLUMN-NAMES-ROUTINE. SG1024.2 +021200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +021300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +021400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +021500 END-ROUTINE. SG1024.2 +021600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1024.2 +021700 END-RTN-EXIT. SG1024.2 +021800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +021900 END-ROUTINE-1. SG1024.2 +022000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1024.2 +022100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1024.2 +022200 ADD PASS-COUNTER TO ERROR-HOLD. SG1024.2 +022300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1024.2 +022400 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1024.2 +022500 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1024.2 +022600 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1024.2 +022700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1024.2 +022800 END-ROUTINE-12. SG1024.2 +022900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1024.2 +023000 IF ERROR-COUNTER IS EQUAL TO ZERO SG1024.2 +023100 MOVE "NO " TO ERROR-TOTAL SG1024.2 +023200 ELSE SG1024.2 +023300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1024.2 +023400 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1024.2 +023500 PERFORM WRITE-LINE. SG1024.2 +023600 END-ROUTINE-13. SG1024.2 +023700 IF DELETE-CNT IS EQUAL TO ZERO SG1024.2 +023800 MOVE "NO " TO ERROR-TOTAL ELSE SG1024.2 +023900 MOVE DELETE-CNT TO ERROR-TOTAL. SG1024.2 +024000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1024.2 +024100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024200 IF INSPECT-COUNTER EQUAL TO ZERO SG1024.2 +024300 MOVE "NO " TO ERROR-TOTAL SG1024.2 +024400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1024.2 +024500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1024.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024800 WRITE-LINE. SG1024.2 +024900 ADD 1 TO RECORD-COUNT. SG1024.2 +025000Y IF RECORD-COUNT GREATER 50 SG1024.2 +025100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1024.2 +025200Y MOVE SPACE TO DUMMY-RECORD SG1024.2 +025300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1024.2 +025400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1024.2 +025500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1024.2 +025600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1024.2 +025700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1024.2 +025800Y MOVE ZERO TO RECORD-COUNT. SG1024.2 +025900 PERFORM WRT-LN. SG1024.2 +026000 WRT-LN. SG1024.2 +026100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1024.2 +026200 MOVE SPACE TO DUMMY-RECORD. SG1024.2 +026300 BLANK-LINE-PRINT. SG1024.2 +026400 PERFORM WRT-LN. SG1024.2 +026500 FAIL-ROUTINE. SG1024.2 +026600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1024.2 +026700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1024.2 +026800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1024.2 +026900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +027000 GO TO FAIL-ROUTINE-EX. SG1024.2 +027100 FAIL-ROUTINE-WRITE. SG1024.2 +027200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1024.2 +027300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1024.2 +027400 FAIL-ROUTINE-EX. EXIT. SG1024.2 +027500 BAIL-OUT. SG1024.2 +027600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1024.2 +027700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1024.2 +027800 BAIL-OUT-WRITE. SG1024.2 +027900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1024.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +028100 BAIL-OUT-EX. EXIT. SG1024.2 +028200 CCVS1-EXIT. SG1024.2 +028300 EXIT. SG1024.2 +028400 TEST-1 SECTION 00. SG1024.2 +028500 TEST-1A. SG1024.2 +028600 GO TO TEST-1D. SG1024.2 +028700 TEST-1B. SG1024.2 +028800 ADD 2 TO SEG-CALC. SG1024.2 +028900 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +029000 ADD 2 TO RANGE-SUB. SG1024.2 +029100 GO TO TEST-1D. SG1024.2 +029200 TEST-1C. SG1024.2 +029300 ALTER PARA-1-22 TO PROCEED TO PARA-2-22. SG1024.2 +029400* NOTE ALTERED PARAGRAPH IN SECTION 22. SG1024.2 +029500 PERFORM TEST22. SG1024.2 +029600 TEST-1D. SG1024.2 +029700 EXIT. SG1024.2 +029800 SEG-TEST2 SECTION 00. SG1024.2 +029900 SEG-TEST-2. SG1024.2 +030000 MOVE 0 TO SEG-CALC. SG1024.2 +030100 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +030200 ALTER TEST-1A TO PROCEED TO TEST-1B. SG1024.2 +030300 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +030400 MOVE 0 TO RANGE-X (1). SG1024.2 +030500 MOVE 3 TO RANGE-SUB. SG1024.2 +030600 PERFORM TEST-1. SG1024.2 +030700 ALTER TEST-1A TO PROCEED TO TEST-1C. SG1024.2 +030800 PERFORM TEST-1. SG1024.2 +030900 PERFORM TEST-1. SG1024.2 +031000 IF SEG-CALC EQUAL TO 2 SG1024.2 +031100 PERFORM PASS SG1024.2 +031200 GO TO TEST-2-WRITE. SG1024.2 +031300 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +031400 MOVE "0-2-0-2" TO CORRECT-A. SG1024.2 +031500 PERFORM FAIL. SG1024.2 +031600 GO TO TEST-2-WRITE. SG1024.2 +031700 TEST-2-DELETE. SG1024.2 +031800 PERFORM DE-LETE. SG1024.2 +031900 TEST-2-WRITE. SG1024.2 +032000 MOVE "SEG-TEST-2" TO PAR-NAME. SG1024.2 +032100 PERFORM PRINT-DETAIL. SG1024.2 +032200 GO TO SEG-TEST-3. SG1024.2 +032300 TEST-6-1 SECTION 07. SG1024.2 +032400 TEST-6A. SG1024.2 +032500 ALTER TEST-6B TO PROCEED TO TEST-6D. SG1024.2 +032600 TEST-6-2 SECTION 08. SG1024.2 +032700 TEST-6B. SG1024.2 +032800 GO TO TEST-6E. SG1024.2 +032900 TEST-6-3 SECTION 09. SG1024.2 +033000 TEST-6C. SG1024.2 +033100 SUBTRACT 9 FROM SEG-CALC. SG1024.2 +033200 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +033300 ADD 2 TO RANGE-SUB. SG1024.2 +033400 TEST-6-4 SECTION 10. SG1024.2 +033500 TEST-6D. SG1024.2 +033600 ALTER TEST-6B TO PROCEED TO TEST-6F. SG1024.2 +033700 TEST-6-5 SECTION 11. SG1024.2 +033800 TEST-6E. SG1024.2 +033900 SUBTRACT SEG-CALC FROM SEG-CALC. SG1024.2 +034000 MOVE 0 TO RANGE-X (RANGE-SUB). SG1024.2 +034100 ADD 2 TO RANGE-SUB. SG1024.2 +034200 GO TO TEST-6-2. SG1024.2 +034300 START-TESTING SECTION 11. SG1024.2 +034400 SEG-TEST-1. SG1024.2 +034500 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +034600 MOVE 4 TO SEG-CALC. SG1024.2 +034700 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +034800 MOVE 4 TO RANGE-X (1). SG1024.2 +034900 MOVE 3 TO RANGE-SUB. SG1024.2 +035000 ALTER TEST-1A TO PROCEED TO TEST-1C. SG1024.2 +035100* NOTE ALTERED PARAGRAPH IN SECTION 00. SG1024.2 +035200 PERFORM TEST-1. SG1024.2 +035300 PERFORM TEST-1. SG1024.2 +035400* NOTE 2ND PERFORM VERIFIES THAT TEST-1A IS STILL ALTERED SG1024.2 +035500* TO TEST-1B. SG1024.2 +035600 IF SEG-CALC EQUAL TO 2 SG1024.2 +035700 PERFORM PASS SG1024.2 +035800 GO TO TEST-1-WRITE. SG1024.2 +035900 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +036000 MOVE "4-0-2" TO CORRECT-A. SG1024.2 +036100 PERFORM FAIL. SG1024.2 +036200 GO TO TEST-1-WRITE. SG1024.2 +036300 TEST-1-DELETE. SG1024.2 +036400 PERFORM DE-LETE. SG1024.2 +036500 TEST-1-WRITE. SG1024.2 +036600 MOVE "SEG-TEST-1" TO PAR-NAME. SG1024.2 +036700 MOVE "SEGMENTATION" TO FEATURE. SG1024.2 +036800 PERFORM PRINT-DETAIL. SG1024.2 +036900 GO TO SEG-TEST-2. SG1024.2 +037000 TEST-8-BRANCH SECTION 12. SG1024.2 +037100 PARA-8. SG1024.2 +037200 GO TO SEG-TEST8. SG1024.2 +037300 TEST-6-6 SECTION 15. SG1024.2 +037400 TEST-6F. SG1024.2 +037500 ADD 9 TO SEG-CALC. SG1024.2 +037600 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +037700 ADD 2 TO RANGE-SUB. SG1024.2 +037800 TEST-6-7 SECTION 18. SG1024.2 +037900 TEST-6G. SG1024.2 +038000 ALTER TEST-6B TO PROCEED TO TEST-6-8. SG1024.2 +038100 GO TO TEST-6-2. SG1024.2 +038200 TEST-6-8 SECTION 20. SG1024.2 +038300 TEST-6H. SG1024.2 +038400 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +038500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +038600 ADD 2 TO RANGE-SUB. SG1024.2 +038700 TEST-6-9 SECTION 22. SG1024.2 +038800 TEST-6I. SG1024.2 +038900 EXIT. SG1024.2 +039000 TEST22 SECTION 22. SG1024.2 +039100 PARA-1-22. SG1024.2 +039200 GO TO PARA-3-22. SG1024.2 +039300 PARA-2-22. SG1024.2 +039400 MOVE 0 TO SEG-CALC. SG1024.2 +039500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +039600 ADD 2 TO RANGE-SUB. SG1024.2 +039700 ALTER TEST-1A TO PROCEED TO TEST-1B. SG1024.2 +039800 PARA-3-22. SG1024.2 +039900 EXIT. SG1024.2 +040000 TEST-4 SECTION 43. SG1024.2 +040100 TEST-4A. SG1024.2 +040200 GO TO TEST-4C. SG1024.2 +040300 TEST-4B. SG1024.2 +040400 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +040500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +040600 ADD 2 TO RANGE-SUB. SG1024.2 +040700 IF SEG-CALC IS GREATER THAN 0 SG1024.2 +040800 GO TO TEST-4A. SG1024.2 +040900 GO TO TEST-4D. SG1024.2 +041000 TEST-4C. SG1024.2 +041100 ALTER TEST-4A TO PROCEED TO TEST-4B. SG1024.2 +041200 GO TO TEST-4B. SG1024.2 +041300 TEST-4D. SG1024.2 +041400 EXIT. SG1024.2 +041500 SEG-TEST5 SECTION 43. SG1024.2 +041600 SEG-TEST-5. SG1024.2 +041700 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +041800 MOVE 5 TO SEG-CALC. SG1024.2 +041900 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +042000 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +042100 MOVE 3 TO RANGE-SUB. SG1024.2 +042200 PERFORM TEST-5. SG1024.2 +042300 SEG-5A. SG1024.2 +042400 GO TO SEG-5C. SG1024.2 +042500 SEG-5B. SG1024.2 +042600 PERFORM TEST-5B THRU TEST-5C. SG1024.2 +042700 IF SEG-CALC EQUAL TO 7 SG1024.2 +042800 PERFORM PASS SG1024.2 +042900 GO TO TEST-5-WRITE. SG1024.2 +043000 SEG-5C. SG1024.2 +043100 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +043200 MOVE "5-6-7" TO CORRECT-A. SG1024.2 +043300 PERFORM FAIL. SG1024.2 +043400 GO TO TEST-5-WRITE. SG1024.2 +043500 TEST-5-DELETE. SG1024.2 +043600 PERFORM DE-LETE. SG1024.2 +043700 TEST-5-WRITE. SG1024.2 +043800 MOVE "SEG-TEST-5" TO PAR-NAME. SG1024.2 +043900 PERFORM PRINT-DETAIL. SG1024.2 +044000 GO TO SEG-TEST-6. SG1024.2 +044100 SEG-TEST7 SECTION 74. SG1024.2 +044200 SEG-TEST-7. SG1024.2 +044300 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +044400 MOVE 3 TO SEG-CALC. SG1024.2 +044500 MOVE 3 TO RANGE-SUB. SG1024.2 +044600 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +044700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +044800 ALTER TEST-7A TO PROCEED TO TEST-7D. SG1024.2 +044900 PERFORM TEST-7-1 THRU TEST-7-4. SG1024.2 +045000 PERFORM TEST-7-1 THRU TEST-7-4. SG1024.2 +045100 IF SEG-CALC EQUAL TO 4 SG1024.2 +045200 PERFORM PASS SG1024.2 +045300 GO TO TEST-7-WRITE. SG1024.2 +045400 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +045500 MOVE "3-2-5-4" TO CORRECT-A. SG1024.2 +045600 PERFORM FAIL. SG1024.2 +045700 GO TO TEST-7-WRITE. SG1024.2 +045800 TEST-7-DELETE. SG1024.2 +045900 PERFORM DE-LETE. SG1024.2 +046000 TEST-7-WRITE. SG1024.2 +046100 MOVE "SEG-TEST-7" TO PAR-NAME. SG1024.2 +046200 PERFORM PRINT-DETAIL. SG1024.2 +046300 MOVE 0 TO SEG-CALC. SG1024.2 +046400 GO TO TEST-8-BRANCH. SG1024.2 +046500 TEST-7-1 SECTION 74. SG1024.2 +046600 TEST-7A. SG1024.2 +046700 GO TO TEST-7B. SG1024.2 +046800 TEST-7-2 SECTION 74. SG1024.2 +046900 TEST-7B. SG1024.2 +047000 ALTER TEST-7A TO PROCEED TO TEST-7C. SG1024.2 +047100 TEST-7-3 SECTION 74. SG1024.2 +047200 TEST-7C. SG1024.2 +047300 ADD 3 TO SEG-CALC. SG1024.2 +047400 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +047500 ADD 2 TO RANGE-SUB. SG1024.2 +047600 TEST-7D. SG1024.2 +047700 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +047800 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +047900 ADD 2 TO RANGE-SUB. SG1024.2 +048000 PERFORM TEST-7B. SG1024.2 +048100 TEST-7-4 SECTION 74. SG1024.2 +048200 TEST-7E. SG1024.2 +048300 GO TO TEST-7F. SG1024.2 +048400 TEST-7F. SG1024.2 +048500 ALTER TEST-7E TO PROCEED TO TEST-7G. SG1024.2 +048600 TEST-7G. SG1024.2 +048700 EXIT. SG1024.2 +048800 SEG-TEST3 SECTION 66. SG1024.2 +048900 SEG-TEST-3. SG1024.2 +049000 MOVE 2 TO SEG-CALC. SG1024.2 +049100 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +049200 MOVE 2 TO RANGE-X (1). SG1024.2 +049300 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +049400 MOVE 3 TO RANGE-SUB. SG1024.2 +049500 PERFORM TEST-3. SG1024.2 +049600 ALTER TEST-3X TO PROCEED TO TEST-3B. SG1024.2 +049700 ALTER TEST-3A TO PROCEED TO TEST-3C. SG1024.2 +049800 PERFORM TEST-3A THRU TEST-3EXIT. SG1024.2 +049900 PERFORM TEST-3C. SG1024.2 +050000 GO TO TEST-3X. SG1024.2 +050100* NOTE PERFORMING AND GO TO SECTION 66 PARAGRAPHS. SG1024.2 +050200 TEST-3-DELETE. SG1024.2 +050300 PERFORM DE-LETE. SG1024.2 +050400 TEST-3-WRITE. SG1024.2 +050500 MOVE "SEG-TEST-3" TO PAR-NAME. SG1024.2 +050600 PERFORM PRINT-DETAIL. SG1024.2 +050700 GO TO SEG-TEST-4. SG1024.2 +050800 TEST-3 SECTION 66. SG1024.2 +050900 TEST-3X. SG1024.2 +051000 GO TO TEST-3D. SG1024.2 +051100 TEST-3A. SG1024.2 +051200 GO TO TEST-3B. SG1024.2 +051300 TEST-3B. SG1024.2 +051400 IF SEG-CALC EQUAL TO 6 SG1024.2 +051500 PERFORM PASS SG1024.2 +051600 GO TO TEST-3-WRITE. SG1024.2 +051700 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +051800 MOVE "2-4-6" TO CORRECT-A. SG1024.2 +051900 PERFORM FAIL. SG1024.2 +052000 GO TO TEST-3-WRITE. SG1024.2 +052100 TEST-3C. SG1024.2 +052200 ADD 2 TO SEG-CALC. SG1024.2 +052300 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +052400 ADD 2 TO RANGE-SUB. SG1024.2 +052500 TEST-3D. SG1024.2 +052600 IF SEG-CALC EQUAL TO 2 GO TO TEST-3EXIT. SG1024.2 +052700 PERFORM TEST-3C. SG1024.2 +052800 GO TO TEST-3B. SG1024.2 +052900 TEST-3EXIT. SG1024.2 +053000 EXIT. SG1024.2 +053100 SEG-TEST4 SECTION 66. SG1024.2 +053200 SEG-TEST-4. SG1024.2 +053300 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +053400 MOVE 3 TO RANGE-SUB. SG1024.2 +053500 MOVE 3 TO SEG-CALC. SG1024.2 +053600 MOVE 3 TO RANGE-X (1). SG1024.2 +053700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +053800 PERFORM TEST-4. SG1024.2 +053900 IF SEG-CALC EQUAL TO 0 SG1024.2 +054000 PERFORM PASS SG1024.2 +054100 GO TO TEST-4-WRITE. SG1024.2 +054200 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +054300 MOVE "3-2-1-0" TO CORRECT-A. SG1024.2 +054400 PERFORM FAIL. SG1024.2 +054500 GO TO TEST-4-WRITE. SG1024.2 +054600 TEST-4-DELETE. SG1024.2 +054700 PERFORM DE-LETE. SG1024.2 +054800 TEST-4-WRITE. SG1024.2 +054900 MOVE "SEG-TEST-4" TO PAR-NAME. SG1024.2 +055000 PERFORM PRINT-DETAIL. SG1024.2 +055100 GO TO SEG-TEST-5. SG1024.2 +055200 SEG-TEST6 SECTION 83. SG1024.2 +055300 SEG-TEST-6. SG1024.2 +055400 MOVE 9 TO SEG-CALC. SG1024.2 +055500 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +055600 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +055700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +055800 MOVE 3 TO RANGE-SUB. SG1024.2 +055900 PERFORM TEST-6A THRU TEST-6I. SG1024.2 +056000 IF SEG-CALC EQUAL TO 8 SG1024.2 +056100 PERFORM PASS SG1024.2 +056200 GO TO TEST-6-WRITE. SG1024.2 +056300 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +056400 MOVE "9-0-9-8" TO CORRECT-A. SG1024.2 +056500 PERFORM FAIL. SG1024.2 +056600 GO TO TEST-6-WRITE. SG1024.2 +056700 TEST-6-DELETE. SG1024.2 +056800 PERFORM DE-LETE. SG1024.2 +056900 TEST-6-WRITE. SG1024.2 +057000 MOVE "SEG-TEST-6" TO PAR-NAME. SG1024.2 +057100 PERFORM PRINT-DETAIL. SG1024.2 +057200 GO TO SEG-TEST-7. SG1024.2 +057300* NOTE PERFORM RESIDENT SECTIONS 7 THRU 22. SG1024.2 +057400 SEG-TEST8 SECTION 84. SG1024.2 +057500 SEG-TEST-8. SG1024.2 +057600 ALTER PARA-8 TO PROCEED TO SEG-TEST-8A. SG1024.2 +057700 ADD 1 TO SEG-CALC. SG1024.2 +057800 IF SEG-CALC EQUAL TO 2 SG1024.2 +057900 PERFORM FAIL SG1024.2 +058000 GO TO TEST-8-WRITE. SG1024.2 +058100 GO TO TEST-8-BRANCH. SG1024.2 +058200 SEG-TEST-8A SECTION 85. SG1024.2 +058300 PARA-85. SG1024.2 +058400 PERFORM PASS. SG1024.2 +058500 TEST-8-WRITE. SG1024.2 +058600 MOVE "ALTER RES TO NON-RES" TO FEATURE. SG1024.2 +058700 MOVE "SEG-TEST-8" TO PAR-NAME. SG1024.2 +058800 PERFORM PRINT-DETAIL. SG1024.2 +058900 GO TO CLOSE-FILES. SG1024.2 +059000 TEST-5 SECTION 99. SG1024.2 +059100 TEST-5A. SG1024.2 +059200 GO TO TEST-5B. SG1024.2 +059300 TEST-5B. SG1024.2 +059400 ALTER SEG-5A TO PROCEED TO SEG-5B. SG1024.2 +059500 ALTER TEST-5A TO PROCEED TO TEST-5C. SG1024.2 +059600 PERFORM SEG-99A THROUGH SEG-99C. SG1024.2 +059700 GO TO TEST-5A. SG1024.2 +059800 TEST-5C. SG1024.2 +059900 EXIT. SG1024.2 +060000 SEG SECTION 99. SG1024.2 +060100 SEG-99A. SG1024.2 +060200 GO TO SEG-99B. SG1024.2 +060300 SEG-99B. SG1024.2 +060400 ALTER SEG-99A TO PROCEED TO SEG-99C. SG1024.2 +060500 ALTER TEST-5A TO PROCEED TO TEST-5B. SG1024.2 +060600 ADD 1 TO SEG-CALC. SG1024.2 +060700 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +060800 ADD 2 TO RANGE-SUB. SG1024.2 +060900 SEG-99C. SG1024.2 +061000 EXIT. SG1024.2 +*END-OF,SG102A +*HEADER,COBOL,SG103A +000100 IDENTIFICATION DIVISION. SG1034.2 +000200 PROGRAM-ID. SG1034.2 +000300 SG103A. SG1034.2 +000400 AUTHOR. SG1034.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1034.2 +000600 INSTALLATION. SG1034.2 +000700 GENERAL SERVICES ADMINISTRATION SG1034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1034.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1034.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1034.2 +001200 SG1034.2 +001300 PHONE (703) 756-6153 SG1034.2 +001400 SG1034.2 +001500 " HIGH ". SG1034.2 +001600 DATE-WRITTEN. SG1034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1034.2 +001800 CREATION DATE / VALIDATION DATE SG1034.2 +001900 "4.2 ". SG1034.2 +002000 SECURITY. SG1034.2 +002100 NONE. SG1034.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1034.2 +002300 THE ALTER, PERFORM, AND GO TO STATEMENTS ARE USED SG1034.2 +002400 TO CHECK INITIAL AND LAST-USED STATES. SG1034.2 +002500 SG1034.2 +002600 ENVIRONMENT DIVISION. SG1034.2 +002700 CONFIGURATION SECTION. SG1034.2 +002800 SOURCE-COMPUTER. SG1034.2 +002900 XXXXX082. SG1034.2 +003000 OBJECT-COMPUTER. SG1034.2 +003100 XXXXX083. SG1034.2 +003200 INPUT-OUTPUT SECTION. SG1034.2 +003300 FILE-CONTROL. SG1034.2 +003400 SELECT PRINT-FILE ASSIGN TO SG1034.2 +003500 XXXXX055. SG1034.2 +003600 DATA DIVISION. SG1034.2 +003700 FILE SECTION. SG1034.2 +003800 FD PRINT-FILE SG1034.2 +003900 LABEL RECORDS SG1034.2 +004000 XXXXX084 SG1034.2 +004100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1034.2 +004200 01 PRINT-REC PICTURE X(120). SG1034.2 +004300 01 DUMMY-RECORD PICTURE X(120). SG1034.2 +004400 WORKING-STORAGE SECTION. SG1034.2 +004500 77 ENT-COUNTER PIC 9 VALUE ZERO. SG1034.2 +004600 01 INITIAL-STATE-A PICTURE 9 VALUE 0. SG1034.2 +004700 01 GO-TO-IND PICTURE X VALUE " ". SG1034.2 +004800 01 PERFORM-RSLT. SG1034.2 +004900 02 PERFORM-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005000 02 PERFORM-RSLT-2 PICTURE X VALUE " ". SG1034.2 +005100 02 PERFORM-RSLT-3 PICTURE X VALUE " ". SG1034.2 +005200 02 PERFORM-RSLT-4 PICTURE X VALUE " ". SG1034.2 +005300 01 ALTER-RSLT. SG1034.2 +005400 02 ALTER-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005500 02 ALTER-RSLT-2 PICTURE X VALUE " ". SG1034.2 +005600 02 ALTER-RSLT-3 PICTURE X VALUE " ". SG1034.2 +005700 01 FALL-RSLT. SG1034.2 +005800 02 FALL-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005900 02 FALL-RSLT-2 PICTURE X VALUE " ". SG1034.2 +006000 01 TEST-RESULTS. SG1034.2 +006100 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1034.2 +006300 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1034.2 +006500 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006600 02 PAR-NAME. SG1034.2 +006700 03 FILLER PICTURE X(12) VALUE SPACE. SG1034.2 +006800 03 PARDOT-X PICTURE X VALUE SPACE. SG1034.2 +006900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1034.2 +007000 03 FILLER PIC X(5) VALUE SPACE. SG1034.2 +007100 02 FILLER PIC X(10) VALUE SPACE. SG1034.2 +007200 02 RE-MARK PIC X(61). SG1034.2 +007300 01 TEST-COMPUTED. SG1034.2 +007400 02 FILLER PIC X(30) VALUE SPACE. SG1034.2 +007500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1034.2 +007600 02 COMPUTED-X. SG1034.2 +007700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1034.2 +007800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1034.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1034.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1034.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1034.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. SG1034.2 +008300 04 COMPUTED-18V0 PICTURE -9(18). SG1034.2 +008400 04 FILLER PICTURE X. SG1034.2 +008500 03 FILLER PIC X(50) VALUE SPACE. SG1034.2 +008600 01 TEST-CORRECT. SG1034.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SG1034.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1034.2 +008900 02 CORRECT-X. SG1034.2 +009000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1034.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1034.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1034.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1034.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1034.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. SG1034.2 +009600 04 CORRECT-18V0 PICTURE -9(18). SG1034.2 +009700 04 FILLER PICTURE X. SG1034.2 +009800 03 FILLER PIC X(50) VALUE SPACE. SG1034.2 +009900 01 CCVS-C-1. SG1034.2 +010000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1034.2 +010100- "SS PARAGRAPH-NAME SG1034.2 +010200- " REMARKS". SG1034.2 +010300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1034.2 +010400 01 CCVS-C-2. SG1034.2 +010500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +010600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1034.2 +010700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1034.2 +010800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1034.2 +010900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1034.2 +011000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1034.2 +011100 01 REC-CT PICTURE 99 VALUE ZERO. SG1034.2 +011200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1034.2 +011300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1034.2 +011400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1034.2 +011500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1034.2 +011600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1034.2 +011700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1034.2 +011800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1034.2 +011900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1034.2 +012000 01 CCVS-H-1. SG1034.2 +012100 02 FILLER PICTURE X(27) VALUE SPACE. SG1034.2 +012200 02 FILLER PICTURE X(67) VALUE SG1034.2 +012300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1034.2 +012400- " SYSTEM". SG1034.2 +012500 02 FILLER PICTURE X(26) VALUE SPACE. SG1034.2 +012600 01 CCVS-H-2. SG1034.2 +012700 02 FILLER PICTURE X(52) VALUE IS SG1034.2 +012800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1034.2 +012900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1034.2 +013000 02 TEST-ID PICTURE IS X(9). SG1034.2 +013100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1034.2 +013200 01 CCVS-H-3. SG1034.2 +013300 02 FILLER PICTURE X(34) VALUE SG1034.2 +013400 " FOR OFFICIAL USE ONLY ". SG1034.2 +013500 02 FILLER PICTURE X(58) VALUE SG1034.2 +013600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1034.2 +013700 02 FILLER PICTURE X(28) VALUE SG1034.2 +013800 " COPYRIGHT 1974 ". SG1034.2 +013900 01 CCVS-E-1. SG1034.2 +014000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1034.2 +014100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1034.2 +014200 02 ID-AGAIN PICTURE IS X(9). SG1034.2 +014300 02 FILLER PICTURE X(45) VALUE IS SG1034.2 +014400 " NTIS DISTRIBUTION COBOL 74". SG1034.2 +014500 01 CCVS-E-2. SG1034.2 +014600 02 FILLER PICTURE X(31) VALUE SG1034.2 +014700 SPACE. SG1034.2 +014800 02 FILLER PICTURE X(21) VALUE SPACE. SG1034.2 +014900 02 CCVS-E-2-2. SG1034.2 +015000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1034.2 +015100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +015200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1034.2 +015300 01 CCVS-E-3. SG1034.2 +015400 02 FILLER PICTURE X(22) VALUE SG1034.2 +015500 " FOR OFFICIAL USE ONLY". SG1034.2 +015600 02 FILLER PICTURE X(12) VALUE SPACE. SG1034.2 +015700 02 FILLER PICTURE X(58) VALUE SG1034.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1034.2 +015900 02 FILLER PICTURE X(13) VALUE SPACE. SG1034.2 +016000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1034.2 +016100 01 CCVS-E-4. SG1034.2 +016200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1034.2 +016300 02 FILLER PIC XXXX VALUE " OF ". SG1034.2 +016400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1034.2 +016500 02 FILLER PIC X(40) VALUE SG1034.2 +016600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1034.2 +016700 01 XXINFO. SG1034.2 +016800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1034.2 +016900 02 INFO-TEXT. SG1034.2 +017000 04 FILLER PIC X(20) VALUE SPACE. SG1034.2 +017100 04 XXCOMPUTED PIC X(20). SG1034.2 +017200 04 FILLER PIC X(5) VALUE SPACE. SG1034.2 +017300 04 XXCORRECT PIC X(20). SG1034.2 +017400 01 HYPHEN-LINE. SG1034.2 +017500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +017600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1034.2 +017700- "*****************************************". SG1034.2 +017800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1034.2 +017900- "******************************". SG1034.2 +018000 01 CCVS-PGM-ID PIC X(6) VALUE SG1034.2 +018100 "SG103A". SG1034.2 +018200 PROCEDURE DIVISION. SG1034.2 +018300 SEC00 SECTION. SG1034.2 +018400 P0001. SG1034.2 +018500 GO TO P0003. SG1034.2 +018600 CCVS1 SECTION. SG1034.2 +018700 OPEN-FILES. SG1034.2 +018800 OPEN OUTPUT PRINT-FILE. SG1034.2 +018900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1034.2 +019000 MOVE SPACE TO TEST-RESULTS. SG1034.2 +019100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1034.2 +019200 GO TO CCVS1-EXIT. SG1034.2 +019300 CLOSE-FILES. SG1034.2 +019400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1034.2 +019500 TERMINATE-CCVS. SG1034.2 +019600S EXIT PROGRAM. SG1034.2 +019700STERMINATE-CALL. SG1034.2 +019800 STOP RUN. SG1034.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1034.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1034.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1034.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1034.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. SG1034.2 +020400 PRINT-DETAIL. SG1034.2 +020500 IF REC-CT NOT EQUAL TO ZERO SG1034.2 +020600 MOVE "." TO PARDOT-X SG1034.2 +020700 MOVE REC-CT TO DOTVALUE. SG1034.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1034.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1034.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1034.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1034.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1034.2 +021300 MOVE SPACE TO CORRECT-X. SG1034.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1034.2 +021500 MOVE SPACE TO RE-MARK. SG1034.2 +021600 HEAD-ROUTINE. SG1034.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +021800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1034.2 +021900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1034.2 +022000 COLUMN-NAMES-ROUTINE. SG1034.2 +022100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +022200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +022300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +022400 END-ROUTINE. SG1034.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1034.2 +022600 END-RTN-EXIT. SG1034.2 +022700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +022800 END-ROUTINE-1. SG1034.2 +022900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1034.2 +023000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1034.2 +023100 ADD PASS-COUNTER TO ERROR-HOLD. SG1034.2 +023200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1034.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1034.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1034.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1034.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1034.2 +023700 END-ROUTINE-12. SG1034.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1034.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO SG1034.2 +024000 MOVE "NO " TO ERROR-TOTAL SG1034.2 +024100 ELSE SG1034.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1034.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1034.2 +024400 PERFORM WRITE-LINE. SG1034.2 +024500 END-ROUTINE-13. SG1034.2 +024600 IF DELETE-CNT IS EQUAL TO ZERO SG1034.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE SG1034.2 +024800 MOVE DELETE-CNT TO ERROR-TOTAL. SG1034.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1034.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO SG1034.2 +025200 MOVE "NO " TO ERROR-TOTAL SG1034.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1034.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1034.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025700 WRITE-LINE. SG1034.2 +025800 ADD 1 TO RECORD-COUNT. SG1034.2 +025900Y IF RECORD-COUNT GREATER 50 SG1034.2 +026000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1034.2 +026100Y MOVE SPACE TO DUMMY-RECORD SG1034.2 +026200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1034.2 +026300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1034.2 +026400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1034.2 +026500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1034.2 +026600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1034.2 +026700Y MOVE ZERO TO RECORD-COUNT. SG1034.2 +026800 PERFORM WRT-LN. SG1034.2 +026900 WRT-LN. SG1034.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1034.2 +027100 MOVE SPACE TO DUMMY-RECORD. SG1034.2 +027200 BLANK-LINE-PRINT. SG1034.2 +027300 PERFORM WRT-LN. SG1034.2 +027400 FAIL-ROUTINE. SG1034.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1034.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1034.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1034.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +027900 GO TO FAIL-ROUTINE-EX. SG1034.2 +028000 FAIL-ROUTINE-WRITE. SG1034.2 +028100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1034.2 +028200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1034.2 +028300 FAIL-ROUTINE-EX. EXIT. SG1034.2 +028400 BAIL-OUT. SG1034.2 +028500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1034.2 +028600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1034.2 +028700 BAIL-OUT-WRITE. SG1034.2 +028800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1034.2 +028900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +029000 BAIL-OUT-EX. EXIT. SG1034.2 +029100 CCVS1-EXIT. SG1034.2 +029200 EXIT. SG1034.2 +029300 SECT-SG-03-001 SECTION 00. SG1034.2 +029400 P0002. SG1034.2 +029500 MOVE "D" TO PERFORM-RSLT-4. SG1034.2 +029600 P0003. SG1034.2 +029700 PERFORM CCVS1. SG1034.2 +029800 SEC20 SECTION 20. SG1034.2 +029900 TEST-1. SG1034.2 +030000 PERFORM SEC80. SG1034.2 +030100* NOTE THAT AN INDEPENDENT SEGMENT SHOULD BE MADE AVAILABLE TO SG1034.2 +030200* THE PROGRAM IN ITS INITIAL STATE EACH TIME IT IS SG1034.2 +030300* REFERENCED, AN ALTER STATEMENT WILL BE USED TO TEST THISSG1034.2 +030400* FEATURE. SG1034.2 +030500 PERFORM SEC80. SG1034.2 +030600 IF INITIAL-STATE-A EQUAL TO 2 PERFORM PASS SG1034.2 +030700 ELSE MOVE INITIAL-STATE-A TO COMPUTED-A SG1034.2 +030800 MOVE "2" TO CORRECT-A SG1034.2 +030900 PERFORM FAIL. SG1034.2 +031000 GO TO TEST-1-WRITE. SG1034.2 +031100 TEST-1-DELETE. SG1034.2 +031200 PERFORM DE-LETE. SG1034.2 +031300 TEST-1-WRITE. SG1034.2 +031400 MOVE "INITIAL STATE" TO FEATURE. SG1034.2 +031500 MOVE "TEST-1" TO PAR-NAME. SG1034.2 +031600 PERFORM PRINT-DETAIL. SG1034.2 +031700 TEST-2. SG1034.2 +031800 MOVE SPACE TO CORRECT-A. SG1034.2 +031900* NOTE THAT A "GO TO" A NON-RESIDENT ROUTINE WILL BE TESTED. SG1034.2 +032000 GO TO P6001. SG1034.2 +032100 GO-TO-RETURN. SG1034.2 +032200 IF GO-TO-IND EQUAL TO "G" PERFORM PASS SG1034.2 +032300 ELSE MOVE GO-TO-IND TO COMPUTED-A SG1034.2 +032400 MOVE "G" TO CORRECT-A SG1034.2 +032500 PERFORM FAIL. SG1034.2 +032600 GO TO TEST-2-WRITE. SG1034.2 +032700 TEST-2-DELETE. SG1034.2 +032800 PERFORM DE-LETE. SG1034.2 +032900 TEST-2-WRITE. SG1034.2 +033000 MOVE "GO TO INDEP SEG" TO FEATURE. SG1034.2 +033100 MOVE "TEST-2" TO PAR-NAME. SG1034.2 +033200 PERFORM PRINT-DETAIL. SG1034.2 +033300 TEST-3. SG1034.2 +033400 MOVE SPACE TO CORRECT-A. SG1034.2 +033500* NOTE THAT THIS TEST PERFORMS A ROUTINE LOCATED IN AN SG1034.2 +033600* INDEPENDENT SEGMENT. SG1034.2 +033700 PERFORM P9301 THRU P9303. SG1034.2 +033800 IF PERFORM-RSLT EQUAL TO "ABCD" PERFORM PASS SG1034.2 +033900 ELSE MOVE PERFORM-RSLT TO COMPUTED-A SG1034.2 +034000 MOVE "ABCD" TO CORRECT-A SG1034.2 +034100 PERFORM FAIL. SG1034.2 +034200 GO TO TEST-3-WRITE. SG1034.2 +034300 TEST-3-DELETE. SG1034.2 +034400 PERFORM DE-LETE. SG1034.2 +034500 TEST-3-WRITE. SG1034.2 +034600 MOVE "PERFORM IND SEG" TO FEATURE. SG1034.2 +034700 MOVE "TEST-3" TO PAR-NAME. SG1034.2 +034800 PERFORM PRINT-DETAIL. SG1034.2 +034900 TEST-4. SG1034.2 +035000 MOVE SPACE TO CORRECT-A. SG1034.2 +035100* NOTE THAT THIS TEST CAUSES AN INDEPENDENT SEGMENT TO ALTER SG1034.2 +035200* A STATEMENT IN THE FIXED PORTION AND THEN CHECKS TO SG1034.2 +035300* SEE THAT THE ALTER IS IN EFFECT. SG1034.2 +035400 PERFORM SEC95. SG1034.2 +035500 ALTER-RES. SG1034.2 +035600 GO TO ALTER-RES1. SG1034.2 +035700 ALTER-RES1. SG1034.2 +035800 MOVE "A" TO ALTER-RSLT-2. SG1034.2 +035900 GO TO ALTER-RES3. SG1034.2 +036000 ALTER-RES2. SG1034.2 +036100 MOVE "B" TO ALTER-RSLT-3. SG1034.2 +036200 ALTER-RES3. SG1034.2 +036300 IF ALTER-RSLT EQUAL TO "E B" PERFORM PASS SG1034.2 +036400 ELSE MOVE ALTER-RSLT TO COMPUTED-A SG1034.2 +036500 MOVE "E B" TO CORRECT-A SG1034.2 +036600 PERFORM FAIL. SG1034.2 +036700 GO TO TEST-4-WRITE. SG1034.2 +036800 TEST-4-DELETE. SG1034.2 +036900 PERFORM DE-LETE. SG1034.2 +037000 TEST-4-WRITE. SG1034.2 +037100 MOVE "ALT RES FRM IND" TO FEATURE. SG1034.2 +037200 MOVE "TEST-4" TO PAR-NAME. SG1034.2 +037300 PERFORM PRINT-DETAIL. SG1034.2 +037400 TEST-5. SG1034.2 +037500 IF PAR-NAME EQUAL TO "TEST-6 " GO TO P2006. SG1034.2 +037600 MOVE "TEST-5" TO PAR-NAME. SG1034.2 +037700* NOTE THAT THIS TEST REQUIRES THE LOGICAL PATH OF THE PROGRAM SG1034.2 +037800* TO PROCEED FROM THE FIXED PORTION THROUGH AN SG1034.2 +037900* INDEPENDENT SEGMENT. SG1034.2 +038000 P2005. SG1034.2 +038100 MOVE "A" TO FALL-RSLT-1. SG1034.2 +038200 P2006. EXIT. SG1034.2 +038300 SEC51 SECTION 51. SG1034.2 +038400 P5101. SG1034.2 +038500 IF PAR-NAME EQUAL TO "TEST-6 " GO TO P5102. SG1034.2 +038600 MOVE "B" TO FALL-RSLT-2. SG1034.2 +038700 IF FALL-RSLT EQUAL TO "AB" PERFORM PASS SG1034.2 +038800 ELSE MOVE FALL-RSLT TO COMPUTED-A SG1034.2 +038900 MOVE "AB" TO CORRECT-A SG1034.2 +039000 PERFORM FAIL. SG1034.2 +039100 GO TO TEST-5-WRITE. SG1034.2 +039200 TEST-5-DELETE. SG1034.2 +039300 PERFORM DE-LETE. SG1034.2 +039400 TEST-5-WRITE. SG1034.2 +039500 MOVE "FALL THRU TEST" TO FEATURE. SG1034.2 +039600 PERFORM PRINT-DETAIL. SG1034.2 +039700 MOVE "TEST-6" TO PAR-NAME. SG1034.2 +039800 GO TO TEST-5. SG1034.2 +039900 P5102. GO TO P5103. SG1034.2 +040000 P5103. SG1034.2 +040100 ALTER P5102 TO PROCEED TO P5104. SG1034.2 +040200 MOVE SPACE TO FALL-RSLT. SG1034.2 +040300 GO TO P5105. SG1034.2 +040400 P5104. MOVE "XX" TO FALL-RSLT. SG1034.2 +040500 P5105. EXIT. SG1034.2 +040600 P5106. SG1034.2 +040700 ADD 1 TO ENT-COUNTER. SG1034.2 +040800 IF ENT-COUNTER EQUAL TO 2 SG1034.2 +040900 GO TO TEST-6. SG1034.2 +041000 GO TO TEST-5. SG1034.2 +041100 TEST-6. SG1034.2 +041200 IF FALL-RSLT EQUAL TO SPACE SG1034.2 +041300 PERFORM PASS SG1034.2 +041400 GO TO TEST-6-WRITE. SG1034.2 +041500 MOVE "SPACE" TO CORRECT-A. SG1034.2 +041600 MOVE FALL-RSLT TO COMPUTED-A. SG1034.2 +041700 PERFORM FAIL. SG1034.2 +041800 GO TO TEST-6-WRITE. SG1034.2 +041900 TEST-6-DELETE. SG1034.2 +042000 PERFORM DE-LETE. SG1034.2 +042100 TEST-6-WRITE. SG1034.2 +042200 PERFORM PRINT-DETAIL. SG1034.2 +042300 MOVE ZERO TO ENT-COUNTER. SG1034.2 +042400 MOVE SPACE TO GO-TO-IND. SG1034.2 +042500 TEST-7. SG1034.2 +042600 GO TO P9901. SG1034.2 +042700 PARA-7A. SG1034.2 +042800 GO TO P9901. SG1034.2 +042900 PARA-7B. SG1034.2 +043000 IF GO-TO-IND EQUAL TO SPACE SG1034.2 +043100 PERFORM PASS SG1034.2 +043200 GO TO TEST-7-WRITE. SG1034.2 +043300 MOVE "SPACE" TO CORRECT-A. SG1034.2 +043400 MOVE GO-TO-IND TO COMPUTED-A. SG1034.2 +043500 PERFORM FAIL. SG1034.2 +043600 GO TO TEST-7-WRITE. SG1034.2 +043700 TEST-7-DELETE. SG1034.2 +043800 PERFORM DE-LETE. SG1034.2 +043900 TEST-7-WRITE. SG1034.2 +044000 MOVE "TEST-7" TO PAR-NAME. SG1034.2 +044100 MOVE "GO TO ALTER IND" TO FEATURE. SG1034.2 +044200 PERFORM PRINT-DETAIL. SG1034.2 +044300 WRAP-UP. SG1034.2 +044400 GO TO CLOSE-FILES. SG1034.2 +044500 SEC60 SECTION 60. SG1034.2 +044600 P6001. SG1034.2 +044700 MOVE "G" TO GO-TO-IND. SG1034.2 +044800 GO TO GO-TO-RETURN. SG1034.2 +044900 SEC80 SECTION 80. SG1034.2 +045000 P8001. SG1034.2 +045100 GO TO P8002. SG1034.2 +045200 P8002. SG1034.2 +045300 ALTER P8001 TO PROCEED TO P8003. SG1034.2 +045400 ADD 1 TO INITIAL-STATE-A. SG1034.2 +045500 GO TO P8004. SG1034.2 +045600 P8003. SG1034.2 +045700 MOVE 9 TO INITIAL-STATE-A. SG1034.2 +045800 P8004. SG1034.2 +045900 EXIT. SG1034.2 +046000 SEC93 SECTION 93. SG1034.2 +046100 P9301. SG1034.2 +046200 MOVE "A" TO PERFORM-RSLT-1. SG1034.2 +046300 PERFORM P9302. SG1034.2 +046400 MOVE "C" TO PERFORM-RSLT-3. SG1034.2 +046500 GO TO P9303. SG1034.2 +046600 P9302. SG1034.2 +046700 MOVE "B" TO PERFORM-RSLT-2. SG1034.2 +046800 P9303. SG1034.2 +046900 PERFORM P0002. SG1034.2 +047000 SEC95 SECTION 95. SG1034.2 +047100 P9501. SG1034.2 +047200 MOVE "E" TO ALTER-RSLT-1. SG1034.2 +047300 ALTER ALTER-RES TO PROCEED TO ALTER-RES2. SG1034.2 +047400 SEC99 SECTION 99. SG1034.2 +047500 P9901. SG1034.2 +047600 GO TO P9902. SG1034.2 +047700 P9902. SG1034.2 +047800 ALTER P9901 TO P9903. SG1034.2 +047900 IF ENT-COUNTER EQUAL TO ZERO SG1034.2 +048000 ADD 1 TO ENT-COUNTER SG1034.2 +048100 GO TO PARA-7A. SG1034.2 +048200 GO TO PARA-7B. SG1034.2 +048300 P9903. SG1034.2 +048400 MOVE "X" TO GO-TO-IND. SG1034.2 +048500 GO TO PARA-7B. SG1034.2 +*END-OF,SG103A +*HEADER,COBOL,SG104A +000100 IDENTIFICATION DIVISION. SG1044.2 +000200 PROGRAM-ID. SG1044.2 +000300 SG104A. SG1044.2 +000400 AUTHOR. SG1044.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1044.2 +000600 INSTALLATION. SG1044.2 +000700 GENERAL SERVICES ADMINISTRATION SG1044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1044.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1044.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1044.2 +001200 SG1044.2 +001300 PHONE (703) 756-6153 SG1044.2 +001400 SG1044.2 +001500 " HIGH ". SG1044.2 +001600 DATE-WRITTEN. SG1044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1044.2 +001800 CREATION DATE / VALIDATION DATE SG1044.2 +001900 "4.2 ". SG1044.2 +002000 SECURITY. SG1044.2 +002100 NONE. SG1044.2 +002200 SG104A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1044.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1044.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1044.2 +002500 REPORT. SG1044.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1044.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1044.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1044.2 +002900 USAGE JUST JUST USAGESG1044.2 +003000 COMP RIGHT RIGHT COMP SG1044.2 +003100 SG1044.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1044.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1044.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1044.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1044.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1044.2 +004000 SG1044.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1044.2 +004200 ASCENDING KEYS IN ONE FILE. SG1044.2 +004300 SG1044.2 +004400 ENVIRONMENT DIVISION. SG1044.2 +004500 CONFIGURATION SECTION. SG1044.2 +004600 SOURCE-COMPUTER. SG1044.2 +004700 XXXXX082. SG1044.2 +004800 OBJECT-COMPUTER. SG1044.2 +004900 XXXXX083. SG1044.2 +005000 INPUT-OUTPUT SECTION. SG1044.2 +005100 FILE-CONTROL. SG1044.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1044.2 +005300 XXXXX055. SG1044.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1044.2 +005500 XXXXX027. SG1044.2 +005600 DATA DIVISION. SG1044.2 +005700 FILE SECTION. SG1044.2 +005800 FD PRINT-FILE SG1044.2 +005900 LABEL RECORDS SG1044.2 +006000 XXXXX084 SG1044.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1044.2 +006200 01 PRINT-REC PICTURE X(120). SG1044.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1044.2 +006400 SD SORTFILE-1H SG1044.2 +006500 DATA RECORD IS SORTFILE-REC. SG1044.2 +006600 01 SORTFILE-REC. SG1044.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1044.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1044.2 +006900 02 SORTKEY-7 PICTURE 999. SG1044.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1044.2 +007100 02 FILLER PICTURE XX. SG1044.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1044.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1044.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1044.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1044.2 +007600 02 FILLER PICTURE XXX. SG1044.2 +007700 WORKING-STORAGE SECTION. SG1044.2 +007800 77 UTIL-CTR PICTURE S99999. SG1044.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1044.2 +008000 01 TEST-RESULTS. SG1044.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1044.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1044.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008600 02 PAR-NAME. SG1044.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1044.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1044.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1044.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1044.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1044.2 +009200 02 RE-MARK PIC X(61). SG1044.2 +009300 01 TEST-COMPUTED. SG1044.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1044.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1044.2 +009600 02 COMPUTED-X. SG1044.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1044.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1044.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1044.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1044.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1044.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1044.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1044.2 +010400 04 FILLER PICTURE X. SG1044.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1044.2 +010600 01 TEST-CORRECT. SG1044.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1044.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1044.2 +010900 02 CORRECT-X. SG1044.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1044.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1044.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1044.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1044.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1044.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1044.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1044.2 +011700 04 FILLER PICTURE X. SG1044.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1044.2 +011900 01 CCVS-C-1. SG1044.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1044.2 +012100- "SS PARAGRAPH-NAME SG1044.2 +012200- " REMARKS". SG1044.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1044.2 +012400 01 CCVS-C-2. SG1044.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1044.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1044.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1044.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1044.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1044.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1044.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1044.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1044.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1044.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1044.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1044.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1044.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1044.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1044.2 +014000 01 CCVS-H-1. SG1044.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1044.2 +014200 02 FILLER PICTURE X(67) VALUE SG1044.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1044.2 +014400- " SYSTEM". SG1044.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1044.2 +014600 01 CCVS-H-2. SG1044.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1044.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1044.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1044.2 +015000 02 TEST-ID PICTURE IS X(9). SG1044.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1044.2 +015200 01 CCVS-H-3. SG1044.2 +015300 02 FILLER PICTURE X(34) VALUE SG1044.2 +015400 " FOR OFFICIAL USE ONLY ". SG1044.2 +015500 02 FILLER PICTURE X(58) VALUE SG1044.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1044.2 +015700 02 FILLER PICTURE X(28) VALUE SG1044.2 +015800 " COPYRIGHT 1974 ". SG1044.2 +015900 01 CCVS-E-1. SG1044.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1044.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1044.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1044.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1044.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1044.2 +016500 01 CCVS-E-2. SG1044.2 +016600 02 FILLER PICTURE X(31) VALUE SG1044.2 +016700 SPACE. SG1044.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1044.2 +016900 02 CCVS-E-2-2. SG1044.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1044.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1044.2 +017300 01 CCVS-E-3. SG1044.2 +017400 02 FILLER PICTURE X(22) VALUE SG1044.2 +017500 " FOR OFFICIAL USE ONLY". SG1044.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1044.2 +017700 02 FILLER PICTURE X(58) VALUE SG1044.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1044.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1044.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1044.2 +018100 01 CCVS-E-4. SG1044.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1044.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1044.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1044.2 +018500 02 FILLER PIC X(40) VALUE SG1044.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1044.2 +018700 01 XXINFO. SG1044.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1044.2 +018900 02 INFO-TEXT. SG1044.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1044.2 +019100 04 XXCOMPUTED PIC X(20). SG1044.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1044.2 +019300 04 XXCORRECT PIC X(20). SG1044.2 +019400 01 HYPHEN-LINE. SG1044.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1044.2 +019700- "*****************************************". SG1044.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1044.2 +019900- "******************************". SG1044.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1044.2 +020100 "SG104A". SG1044.2 +020200 PROCEDURE DIVISION. SG1044.2 +020300 SORT-PARA SECTION 69. SG1044.2 +020400 SORT-PARAGRAPH. SG1044.2 +020500 SORT SORTFILE-1H ON SG1044.2 +020600 ASCENDING KEY SORTKEY-1 SG1044.2 +020700 ASCENDING SORTKEY-2 SG1044.2 +020800 ASCENDING SORTKEY-3 SG1044.2 +020900 ASCENDING SORTKEY-4 SG1044.2 +021000 ASCENDING SORTKEY-5 SG1044.2 +021100 ASCENDING SORTKEY-6 SG1044.2 +021200 ASCENDING SORTKEY-7 SG1044.2 +021300 ASCENDING SORTKEY-8 SG1044.2 +021400 INPUT PROCEDURE INPROC SG1044.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1044.2 +021600 STOP RUN. SG1044.2 +021700 INPROC SECTION 69. SG1044.2 +021800 BUILD-FILE. SG1044.2 +021900 PERFORM BUILD-RECORD. SG1044.2 +022000 MOVE +123456 TO SORTKEY-1. SG1044.2 +022100 PERFORM RELEASE-RECORD. SG1044.2 +022200 PERFORM BUILD-RECORD. SG1044.2 +022300 MOVE "X" TO SORTKEY-2. SG1044.2 +022400 PERFORM RELEASE-RECORD. SG1044.2 +022500 PERFORM BUILD-RECORD. SG1044.2 +022600 MOVE +.6 TO SORTKEY-3. SG1044.2 +022700 PERFORM RELEASE-RECORD. SG1044.2 +022800 PERFORM BUILD-RECORD. SG1044.2 +022900 MOVE "X" TO SORTKEY-4. SG1044.2 +023000 PERFORM RELEASE-RECORD. SG1044.2 +023100 PERFORM BUILD-RECORD. SG1044.2 +023200 MOVE "Z" TO SORTKEY-5. SG1044.2 +023300 PERFORM RELEASE-RECORD. SG1044.2 +023400 PERFORM BUILD-RECORD. SG1044.2 +023500 MOVE "Z" TO SORTKEY-6. SG1044.2 +023600 PERFORM RELEASE-RECORD. SG1044.2 +023700 PERFORM BUILD-RECORD. SG1044.2 +023800 MOVE +418 TO SORTKEY-7. SG1044.2 +023900 PERFORM RELEASE-RECORD. SG1044.2 +024000 PERFORM BUILD-RECORD. SG1044.2 +024100 MOVE -14 TO SORTKEY-8. SG1044.2 +024200 PERFORM RELEASE-RECORD. SG1044.2 +024300 GO TO BUILD-EXIT. SG1044.2 +024400 BUILD-RECORD. SG1044.2 +024500 MOVE -054321 TO SORTKEY-1. SG1044.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1044.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1044.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1044.2 +024900 MOVE "A" TO SORTKEY-5. SG1044.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1044.2 +025100 MOVE -501 TO SORTKEY-7. SG1044.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1044.2 +025300* FIELD. SG1044.2 +025400 MOVE +99 TO SORTKEY-8. SG1044.2 +025500 RELEASE-RECORD. SG1044.2 +025600 RELEASE SORTFILE-REC. SG1044.2 +025700 BUILD-EXIT. SG1044.2 +025800 EXIT. SG1044.2 +025900 OUTPROC SECTION 69. SG1044.2 +026000 OPEN-FILES. SG1044.2 +026100 OPEN OUTPUT PRINT-FILE. SG1044.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1044.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1044.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1044.2 +026500 IF SPAC-E IS LESS THAN "B" SG1044.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1044.2 +026700 B-IS-LESS-THAN-SPACE SECTION 69. SG1044.2 +026800 SORT-INIT-A. SG1044.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1044.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1044.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1044.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1044.2 +027400 SORT-TEST-1. SG1044.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1044.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1044.2 +027800 SORT-FAIL-1. SG1044.2 +027900 PERFORM FAIL. SG1044.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1044.2 +028100 MOVE 418 TO CORRECT-N. SG1044.2 +028200 SORT-WRITE-1. SG1044.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1044.2 +028400 PERFORM PRINT-DETAIL. SG1044.2 +028500 SORT-TEST-2. SG1044.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1044.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1044.2 +028900 SORT-FAIL-2. SG1044.2 +029000 PERFORM FAIL. SG1044.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1044.2 +029200 MOVE -14 TO CORRECT-N. SG1044.2 +029300 SORT-WRITE-2. SG1044.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1044.2 +029500 PERFORM PRINT-DETAIL. SG1044.2 +029600 SORT-TEST-3. SG1044.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1044.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1044.2 +030000 SORT-FAIL-3. SG1044.2 +030100 PERFORM FAIL. SG1044.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1044.2 +030300 MOVE "Z " TO CORRECT-A. SG1044.2 +030400 SORT-WRITE-3. SG1044.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1044.2 +030600 PERFORM PRINT-DETAIL. SG1044.2 +030700 SORT-TEST-4. SG1044.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1044.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1044.2 +031100 SORT-FAIL-4. SG1044.2 +031200 PERFORM FAIL. SG1044.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1044.2 +031400 MOVE "Z " TO CORRECT-A. SG1044.2 +031500 SORT-WRITE-4. SG1044.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1044.2 +031700 PERFORM PRINT-DETAIL. SG1044.2 +031800 SORT-TEST-5. SG1044.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1044.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1044.2 +032200 SORT-FAIL-5. SG1044.2 +032300 PERFORM FAIL. SG1044.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1044.2 +032500 MOVE " X" TO CORRECT-A. SG1044.2 +032600 SORT-WRITE-5. SG1044.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1044.2 +032800 PERFORM PRINT-DETAIL. SG1044.2 +032900 SORT-TEST-6. SG1044.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1044.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1044.2 +033300 SORT-FAIL-6. SG1044.2 +033400 PERFORM FAIL. SG1044.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1044.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1044.2 +033700 SORT-WRITE-6. SG1044.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1044.2 +033900 PERFORM PRINT-DETAIL. SG1044.2 +034000 SORT-TEST-7. SG1044.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1044.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1044.2 +034400 SORT-FAIL-7. SG1044.2 +034500 PERFORM FAIL. SG1044.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1044.2 +034700 MOVE " X" TO CORRECT-A. SG1044.2 +034800 SORT-WRITE-7. SG1044.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1044.2 +035000 PERFORM PRINT-DETAIL. SG1044.2 +035100 SORT-TEST-8. SG1044.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1044.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1044.2 +035500 SORT-FAIL-8. SG1044.2 +035600 PERFORM FAIL. SG1044.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1044.2 +035800 MOVE +123456 TO CORRECT-N. SG1044.2 +035900 SORT-WRITE-8. SG1044.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1044.2 +036100 PERFORM PRINT-DETAIL. SG1044.2 +036200 SORT-REMARK-A. SG1044.2 +036300 MOVE SPACE TO FEATURE. SG1044.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1044.2 +036500 PERFORM PRINT-DETAIL. SG1044.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1044.2 +036700 PERFORM PRINT-DETAIL. SG1044.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1044.2 +036900 PERFORM PRINT-DETAIL. SG1044.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +037100 GO TO CONTINUE-TESTING. SG1044.2 +037200 SPACE-IS-LESS-THAN-B SECTION 69. SG1044.2 +037300 SORT-REMARK-B. SG1044.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1044.2 +037500 PERFORM PRINT-DETAIL. SG1044.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1044.2 +037700 PERFORM PRINT-DETAIL. SG1044.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1044.2 +037900 PERFORM PRINT-DETAIL. SG1044.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1044.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1044.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1044.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1044.2 +038500 SORT-TEST-9. SG1044.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1044.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1044.2 +038900 SORT-FAIL-9. SG1044.2 +039000 PERFORM FAIL. SG1044.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1044.2 +039200 MOVE " X" TO CORRECT-A. SG1044.2 +039300 SORT-WRITE-9. SG1044.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1044.2 +039500 PERFORM PRINT-DETAIL. SG1044.2 +039600 SORT-TEST-10. SG1044.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1044.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1044.2 +040000 SORT-FAIL-10. SG1044.2 +040100 PERFORM FAIL. SG1044.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1044.2 +040300 MOVE " X" TO CORRECT-A. SG1044.2 +040400 SORT-WRITE-10. SG1044.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1044.2 +040600 PERFORM PRINT-DETAIL. SG1044.2 +040700 SORT-TEST-11. SG1044.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1044.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1044.2 +041100 SORT-FAIL-11. SG1044.2 +041200 PERFORM FAIL. SG1044.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1044.2 +041400 MOVE 418 TO CORRECT-N. SG1044.2 +041500 SORT-WRITE-11. SG1044.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1044.2 +041700 PERFORM PRINT-DETAIL. SG1044.2 +041800 SORT-TEST-12. SG1044.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1044.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1044.2 +042200 SORT-FAIL-12. SG1044.2 +042300 PERFORM FAIL. SG1044.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1044.2 +042500 MOVE -14 TO CORRECT-N. SG1044.2 +042600 SORT-WRITE-12. SG1044.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1044.2 +042800 PERFORM PRINT-DETAIL. SG1044.2 +042900 SORT-TEST-13. SG1044.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1044.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1044.2 +043300 SORT-FAIL-13. SG1044.2 +043400 PERFORM FAIL. SG1044.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1044.2 +043600 MOVE "Z " TO CORRECT-A. SG1044.2 +043700 SORT-WRITE-13. SG1044.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1044.2 +043900 PERFORM PRINT-DETAIL. SG1044.2 +044000 SORT-TEST-14. SG1044.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1044.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1044.2 +044400 SORT-FAIL-14. SG1044.2 +044500 PERFORM FAIL. SG1044.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1044.2 +044700 MOVE "Z " TO CORRECT-A. SG1044.2 +044800 SORT-WRITE-14. SG1044.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1044.2 +045000 PERFORM PRINT-DETAIL. SG1044.2 +045100 SORT-TEST-15. SG1044.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1044.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1044.2 +045500 SORT-FAIL-15. SG1044.2 +045600 PERFORM FAIL. SG1044.2 +045700 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1044.2 +045800 MOVE +.6000000000000000 TO CORRECT-0V18. SG1044.2 +045900 SORT-WRITE-15. SG1044.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1044.2 +046100 PERFORM PRINT-DETAIL. SG1044.2 +046200 SORT-TEST-16. SG1044.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1044.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1044.2 +046600 SORT-FAIL-16. SG1044.2 +046700 PERFORM FAIL. SG1044.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1044.2 +046900 MOVE +123456 TO CORRECT-N. SG1044.2 +047000 SORT-WRITE-16. SG1044.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1044.2 +047200 PERFORM PRINT-DETAIL. SG1044.2 +047300 CONTINUE-TESTING SECTION 69. SG1044.2 +047400 SORT-TEST-17. SG1044.2 +047500 RETURN SORTFILE-1H AT END SG1044.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1044.2 +047700 SORT-FAIL-17. SG1044.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1044.2 +047900 PERFORM FAIL. SG1044.2 +048000 SORT-WRITE-17. SG1044.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1044.2 +048200 PERFORM PRINT-DETAIL. SG1044.2 +048300 GO TO OUTPROC-EXIT. SG1044.2 +048400 RETURN-ERROR. SG1044.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1044.2 +048600 PERFORM FAIL. SG1044.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1044.2 +048800 PERFORM PRINT-DETAIL. SG1044.2 +048900 GO TO CCVS1-EXIT. SG1044.2 +049000 CLOSE-FILES. SG1044.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1044.2 +049200 TERMINATE-CCVS. SG1044.2 +049300S EXIT PROGRAM. SG1044.2 +049400STERMINATE-CALL. SG1044.2 +049500 STOP RUN. SG1044.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1044.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1044.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1044.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1044.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1044.2 +050100 PRINT-DETAIL. SG1044.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1044.2 +050300 MOVE "." TO PARDOT-X SG1044.2 +050400 MOVE REC-CT TO DOTVALUE. SG1044.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1044.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1044.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1044.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1044.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1044.2 +051000 MOVE SPACE TO CORRECT-X. SG1044.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1044.2 +051200 MOVE SPACE TO RE-MARK. SG1044.2 +051300 HEAD-ROUTINE. SG1044.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1044.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1044.2 +051700 COLUMN-NAMES-ROUTINE. SG1044.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +052100 END-ROUTINE. SG1044.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1044.2 +052300 END-RTN-EXIT. SG1044.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +052500 END-ROUTINE-1. SG1044.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1044.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1044.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1044.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1044.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1044.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1044.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1044.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1044.2 +053400 END-ROUTINE-12. SG1044.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1044.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1044.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1044.2 +053800 ELSE SG1044.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1044.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1044.2 +054100 PERFORM WRITE-LINE. SG1044.2 +054200 END-ROUTINE-13. SG1044.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1044.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1044.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1044.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1044.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1044.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1044.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1044.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1044.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +055400 WRITE-LINE. SG1044.2 +055500 ADD 1 TO RECORD-COUNT. SG1044.2 +055600Y IF RECORD-COUNT GREATER 50 SG1044.2 +055700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1044.2 +055800Y MOVE SPACE TO DUMMY-RECORD SG1044.2 +055900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1044.2 +056000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1044.2 +056100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1044.2 +056200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1044.2 +056300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1044.2 +056400Y MOVE ZERO TO RECORD-COUNT. SG1044.2 +056500 PERFORM WRT-LN. SG1044.2 +056600 WRT-LN. SG1044.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1044.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1044.2 +056900 BLANK-LINE-PRINT. SG1044.2 +057000 PERFORM WRT-LN. SG1044.2 +057100 FAIL-ROUTINE. SG1044.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1044.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1044.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1044.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +057600 GO TO FAIL-ROUTINE-EX. SG1044.2 +057700 FAIL-ROUTINE-WRITE. SG1044.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1044.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1044.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1044.2 +058100 BAIL-OUT. SG1044.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1044.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1044.2 +058400 BAIL-OUT-WRITE. SG1044.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1044.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +058700 BAIL-OUT-EX. EXIT. SG1044.2 +058800 CCVS1-EXIT. SG1044.2 +058900 EXIT. SG1044.2 +059000 OUTPROC-EXIT SECTION 69. SG1044.2 +059100 EXIT-ONLY. SG1044.2 +059200 PERFORM CLOSE-FILES. SG1044.2 +*END-OF,SG104A +*HEADER,COBOL,SG105A +000100 IDENTIFICATION DIVISION. SG1054.2 +000200 PROGRAM-ID. SG1054.2 +000300 SG105A. SG1054.2 +000400 AUTHOR. SG1054.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1054.2 +000600 INSTALLATION. SG1054.2 +000700 GENERAL SERVICES ADMINISTRATION SG1054.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1054.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1054.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1054.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1054.2 +001200 SG1054.2 +001300 PHONE (703) 756-6153 SG1054.2 +001400 SG1054.2 +001500 " HIGH ". SG1054.2 +001600 DATE-WRITTEN. SG1054.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1054.2 +001800 CREATION DATE / VALIDATION DATE SG1054.2 +001900 "4.2 ". SG1054.2 +002000 SECURITY. SG1054.2 +002100 NONE. SG1054.2 +002200 SG105A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1054.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1054.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1054.2 +002500 REPORT. SG1054.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1054.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1054.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1054.2 +002900 USAGE JUST JUST USAGESG1054.2 +003000 COMP RIGHT RIGHT COMP SG1054.2 +003100 SG1054.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1054.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1054.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1054.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1054.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1054.2 +004000 SG1054.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1054.2 +004200 ASCENDING KEYS IN ONE FILE. SG1054.2 +004300 SG1054.2 +004400 ENVIRONMENT DIVISION. SG1054.2 +004500 CONFIGURATION SECTION. SG1054.2 +004600 SOURCE-COMPUTER. SG1054.2 +004700 XXXXX082. SG1054.2 +004800 OBJECT-COMPUTER. SG1054.2 +004900 XXXXX083. SG1054.2 +005000 INPUT-OUTPUT SECTION. SG1054.2 +005100 FILE-CONTROL. SG1054.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1054.2 +005300 XXXXX055. SG1054.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1054.2 +005500 XXXXX027. SG1054.2 +005600 DATA DIVISION. SG1054.2 +005700 FILE SECTION. SG1054.2 +005800 FD PRINT-FILE SG1054.2 +005900 LABEL RECORDS SG1054.2 +006000 XXXXX084 SG1054.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1054.2 +006200 01 PRINT-REC PICTURE X(120). SG1054.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1054.2 +006400 SD SORTFILE-1H SG1054.2 +006500 DATA RECORD IS SORTFILE-REC. SG1054.2 +006600 01 SORTFILE-REC. SG1054.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1054.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1054.2 +006900 02 SORTKEY-7 PICTURE 999. SG1054.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1054.2 +007100 02 FILLER PICTURE XX. SG1054.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1054.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1054.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1054.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1054.2 +007600 02 FILLER PICTURE XXX. SG1054.2 +007700 WORKING-STORAGE SECTION. SG1054.2 +007800 77 UTIL-CTR PICTURE S99999. SG1054.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1054.2 +008000 01 TEST-RESULTS. SG1054.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1054.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1054.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008600 02 PAR-NAME. SG1054.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1054.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1054.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1054.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1054.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1054.2 +009200 02 RE-MARK PIC X(61). SG1054.2 +009300 01 TEST-COMPUTED. SG1054.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1054.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1054.2 +009600 02 COMPUTED-X. SG1054.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1054.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1054.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1054.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1054.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1054.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1054.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1054.2 +010400 04 FILLER PICTURE X. SG1054.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1054.2 +010600 01 TEST-CORRECT. SG1054.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1054.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1054.2 +010900 02 CORRECT-X. SG1054.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1054.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1054.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1054.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1054.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1054.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1054.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1054.2 +011700 04 FILLER PICTURE X. SG1054.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1054.2 +011900 01 CCVS-C-1. SG1054.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1054.2 +012100- "SS PARAGRAPH-NAME SG1054.2 +012200- " REMARKS". SG1054.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1054.2 +012400 01 CCVS-C-2. SG1054.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1054.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1054.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1054.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1054.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1054.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1054.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1054.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1054.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1054.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1054.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1054.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1054.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1054.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1054.2 +014000 01 CCVS-H-1. SG1054.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1054.2 +014200 02 FILLER PICTURE X(67) VALUE SG1054.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1054.2 +014400- " SYSTEM". SG1054.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1054.2 +014600 01 CCVS-H-2. SG1054.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1054.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1054.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1054.2 +015000 02 TEST-ID PICTURE IS X(9). SG1054.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1054.2 +015200 01 CCVS-H-3. SG1054.2 +015300 02 FILLER PICTURE X(34) VALUE SG1054.2 +015400 " FOR OFFICIAL USE ONLY ". SG1054.2 +015500 02 FILLER PICTURE X(58) VALUE SG1054.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1054.2 +015700 02 FILLER PICTURE X(28) VALUE SG1054.2 +015800 " COPYRIGHT 1974 ". SG1054.2 +015900 01 CCVS-E-1. SG1054.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1054.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1054.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1054.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1054.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1054.2 +016500 01 CCVS-E-2. SG1054.2 +016600 02 FILLER PICTURE X(31) VALUE SG1054.2 +016700 SPACE. SG1054.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1054.2 +016900 02 CCVS-E-2-2. SG1054.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1054.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1054.2 +017300 01 CCVS-E-3. SG1054.2 +017400 02 FILLER PICTURE X(22) VALUE SG1054.2 +017500 " FOR OFFICIAL USE ONLY". SG1054.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1054.2 +017700 02 FILLER PICTURE X(58) VALUE SG1054.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1054.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1054.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1054.2 +018100 01 CCVS-E-4. SG1054.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1054.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1054.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1054.2 +018500 02 FILLER PIC X(40) VALUE SG1054.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1054.2 +018700 01 XXINFO. SG1054.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1054.2 +018900 02 INFO-TEXT. SG1054.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1054.2 +019100 04 XXCOMPUTED PIC X(20). SG1054.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1054.2 +019300 04 XXCORRECT PIC X(20). SG1054.2 +019400 01 HYPHEN-LINE. SG1054.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1054.2 +019700- "*****************************************". SG1054.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1054.2 +019900- "******************************". SG1054.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1054.2 +020100 "SG105A". SG1054.2 +020200 PROCEDURE DIVISION. SG1054.2 +020300 SORT-PARA SECTION 73. SG1054.2 +020400 SORT-PARAGRAPH. SG1054.2 +020500 SORT SORTFILE-1H ON SG1054.2 +020600 ASCENDING KEY SORTKEY-1 SG1054.2 +020700 ASCENDING SORTKEY-2 SG1054.2 +020800 ASCENDING SORTKEY-3 SG1054.2 +020900 ASCENDING SORTKEY-4 SG1054.2 +021000 ASCENDING SORTKEY-5 SG1054.2 +021100 ASCENDING SORTKEY-6 SG1054.2 +021200 ASCENDING SORTKEY-7 SG1054.2 +021300 ASCENDING SORTKEY-8 SG1054.2 +021400 INPUT PROCEDURE INPROC SG1054.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1054.2 +021600 STOP RUN. SG1054.2 +021700 INPROC SECTION 20. SG1054.2 +021800 BUILD-FILE. SG1054.2 +021900 PERFORM BUILD-RECORD. SG1054.2 +022000 MOVE +123456 TO SORTKEY-1. SG1054.2 +022100 PERFORM RELEASE-RECORD. SG1054.2 +022200 PERFORM BUILD-RECORD. SG1054.2 +022300 MOVE "X" TO SORTKEY-2. SG1054.2 +022400 PERFORM RELEASE-RECORD. SG1054.2 +022500 PERFORM BUILD-RECORD. SG1054.2 +022600 MOVE +.6 TO SORTKEY-3. SG1054.2 +022700 PERFORM RELEASE-RECORD. SG1054.2 +022800 PERFORM BUILD-RECORD. SG1054.2 +022900 MOVE "X" TO SORTKEY-4. SG1054.2 +023000 PERFORM RELEASE-RECORD. SG1054.2 +023100 PERFORM BUILD-RECORD. SG1054.2 +023200 MOVE "Z" TO SORTKEY-5. SG1054.2 +023300 PERFORM RELEASE-RECORD. SG1054.2 +023400 PERFORM BUILD-RECORD. SG1054.2 +023500 MOVE "Z" TO SORTKEY-6. SG1054.2 +023600 PERFORM RELEASE-RECORD. SG1054.2 +023700 PERFORM BUILD-RECORD. SG1054.2 +023800 MOVE +418 TO SORTKEY-7. SG1054.2 +023900 PERFORM RELEASE-RECORD. SG1054.2 +024000 PERFORM BUILD-RECORD. SG1054.2 +024100 MOVE -14 TO SORTKEY-8. SG1054.2 +024200 PERFORM RELEASE-RECORD. SG1054.2 +024300 GO TO BUILD-EXIT. SG1054.2 +024400 BUILD-RECORD. SG1054.2 +024500 MOVE -054321 TO SORTKEY-1. SG1054.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1054.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1054.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1054.2 +024900 MOVE "A" TO SORTKEY-5. SG1054.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1054.2 +025100 MOVE -501 TO SORTKEY-7. SG1054.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1054.2 +025300* FIELD. SG1054.2 +025400 MOVE +99 TO SORTKEY-8. SG1054.2 +025500 RELEASE-RECORD. SG1054.2 +025600 RELEASE SORTFILE-REC. SG1054.2 +025700 BUILD-EXIT. SG1054.2 +025800 EXIT. SG1054.2 +025900 OUTPROC SECTION 00. SG1054.2 +026000 OPEN-FILES. SG1054.2 +026100 OPEN OUTPUT PRINT-FILE. SG1054.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1054.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1054.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1054.2 +026500 IF SPAC-E IS LESS THAN "B" SG1054.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1054.2 +026700 B-IS-LESS-THAN-SPACE SECTION 00. SG1054.2 +026800 SORT-INIT-A. SG1054.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1054.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1054.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1054.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1054.2 +027400 SORT-TEST-1. SG1054.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1054.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1054.2 +027800 SORT-FAIL-1. SG1054.2 +027900 PERFORM FAIL. SG1054.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1054.2 +028100 MOVE 418 TO CORRECT-N. SG1054.2 +028200 SORT-WRITE-1. SG1054.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1054.2 +028400 PERFORM PRINT-DETAIL. SG1054.2 +028500 SORT-TEST-2. SG1054.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1054.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1054.2 +028900 SORT-FAIL-2. SG1054.2 +029000 PERFORM FAIL. SG1054.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1054.2 +029200 MOVE -14 TO CORRECT-N. SG1054.2 +029300 SORT-WRITE-2. SG1054.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1054.2 +029500 PERFORM PRINT-DETAIL. SG1054.2 +029600 SORT-TEST-3. SG1054.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1054.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1054.2 +030000 SORT-FAIL-3. SG1054.2 +030100 PERFORM FAIL. SG1054.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1054.2 +030300 MOVE "Z " TO CORRECT-A. SG1054.2 +030400 SORT-WRITE-3. SG1054.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1054.2 +030600 PERFORM PRINT-DETAIL. SG1054.2 +030700 SORT-TEST-4. SG1054.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1054.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1054.2 +031100 SORT-FAIL-4. SG1054.2 +031200 PERFORM FAIL. SG1054.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1054.2 +031400 MOVE "Z " TO CORRECT-A. SG1054.2 +031500 SORT-WRITE-4. SG1054.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1054.2 +031700 PERFORM PRINT-DETAIL. SG1054.2 +031800 SORT-TEST-5. SG1054.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1054.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1054.2 +032200 SORT-FAIL-5. SG1054.2 +032300 PERFORM FAIL. SG1054.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1054.2 +032500 MOVE " X" TO CORRECT-A. SG1054.2 +032600 SORT-WRITE-5. SG1054.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1054.2 +032800 PERFORM PRINT-DETAIL. SG1054.2 +032900 SORT-TEST-6. SG1054.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1054.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1054.2 +033300 SORT-FAIL-6. SG1054.2 +033400 PERFORM FAIL. SG1054.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1054.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1054.2 +033700 SORT-WRITE-6. SG1054.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1054.2 +033900 PERFORM PRINT-DETAIL. SG1054.2 +034000 SORT-TEST-7. SG1054.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1054.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1054.2 +034400 SORT-FAIL-7. SG1054.2 +034500 PERFORM FAIL. SG1054.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1054.2 +034700 MOVE " X" TO CORRECT-A. SG1054.2 +034800 SORT-WRITE-7. SG1054.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1054.2 +035000 PERFORM PRINT-DETAIL. SG1054.2 +035100 SORT-TEST-8. SG1054.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1054.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1054.2 +035500 SORT-FAIL-8. SG1054.2 +035600 PERFORM FAIL. SG1054.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1054.2 +035800 MOVE +123456 TO CORRECT-N. SG1054.2 +035900 SORT-WRITE-8. SG1054.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1054.2 +036100 PERFORM PRINT-DETAIL. SG1054.2 +036200 SORT-REMARK-A. SG1054.2 +036300 MOVE SPACE TO FEATURE. SG1054.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1054.2 +036500 PERFORM PRINT-DETAIL. SG1054.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1054.2 +036700 PERFORM PRINT-DETAIL. SG1054.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1054.2 +036900 PERFORM PRINT-DETAIL. SG1054.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +037100 GO TO CONTINUE-TESTING. SG1054.2 +037200 SPACE-IS-LESS-THAN-B SECTION 00. SG1054.2 +037300 SORT-REMARK-B. SG1054.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1054.2 +037500 PERFORM PRINT-DETAIL. SG1054.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1054.2 +037700 PERFORM PRINT-DETAIL. SG1054.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1054.2 +037900 PERFORM PRINT-DETAIL. SG1054.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1054.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1054.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1054.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1054.2 +038500 SORT-TEST-9. SG1054.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1054.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1054.2 +038900 SORT-FAIL-9. SG1054.2 +039000 PERFORM FAIL. SG1054.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1054.2 +039200 MOVE " X" TO CORRECT-A. SG1054.2 +039300 SORT-WRITE-9. SG1054.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1054.2 +039500 PERFORM PRINT-DETAIL. SG1054.2 +039600 SORT-TEST-10. SG1054.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1054.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1054.2 +040000 SORT-FAIL-10. SG1054.2 +040100 PERFORM FAIL. SG1054.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1054.2 +040300 MOVE " X" TO CORRECT-A. SG1054.2 +040400 SORT-WRITE-10. SG1054.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1054.2 +040600 PERFORM PRINT-DETAIL. SG1054.2 +040700 SORT-TEST-11. SG1054.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1054.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1054.2 +041100 SORT-FAIL-11. SG1054.2 +041200 PERFORM FAIL. SG1054.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1054.2 +041400 MOVE 418 TO CORRECT-N. SG1054.2 +041500 SORT-WRITE-11. SG1054.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1054.2 +041700 PERFORM PRINT-DETAIL. SG1054.2 +041800 SORT-TEST-12. SG1054.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1054.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1054.2 +042200 SORT-FAIL-12. SG1054.2 +042300 PERFORM FAIL. SG1054.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1054.2 +042500 MOVE -14 TO CORRECT-N. SG1054.2 +042600 SORT-WRITE-12. SG1054.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1054.2 +042800 PERFORM PRINT-DETAIL. SG1054.2 +042900 SORT-TEST-13. SG1054.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1054.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1054.2 +043300 SORT-FAIL-13. SG1054.2 +043400 PERFORM FAIL. SG1054.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1054.2 +043600 MOVE "Z " TO CORRECT-A. SG1054.2 +043700 SORT-WRITE-13. SG1054.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1054.2 +043900 PERFORM PRINT-DETAIL. SG1054.2 +044000 SORT-TEST-14. SG1054.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1054.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1054.2 +044400 SORT-FAIL-14. SG1054.2 +044500 PERFORM FAIL. SG1054.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1054.2 +044700 MOVE "Z " TO CORRECT-A. SG1054.2 +044800 SORT-WRITE-14. SG1054.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1054.2 +045000 PERFORM PRINT-DETAIL. SG1054.2 +045100 SORT-TEST-15. SG1054.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1054.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1054.2 +045500 SORT-FAIL-15. SG1054.2 +045600 PERFORM FAIL. SG1054.2 +045700 MOVE SORTKEY-3 TO COMPUTED-18V0. SG1054.2 +045800 MOVE +.6000000000000000 TO CORRECT-18V0. SG1054.2 +045900 SORT-WRITE-15. SG1054.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1054.2 +046100 PERFORM PRINT-DETAIL. SG1054.2 +046200 SORT-TEST-16. SG1054.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1054.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1054.2 +046600 SORT-FAIL-16. SG1054.2 +046700 PERFORM FAIL. SG1054.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1054.2 +046900 MOVE +123456 TO CORRECT-N. SG1054.2 +047000 SORT-WRITE-16. SG1054.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1054.2 +047200 PERFORM PRINT-DETAIL. SG1054.2 +047300 CONTINUE-TESTING SECTION 00. SG1054.2 +047400 SORT-TEST-17. SG1054.2 +047500 RETURN SORTFILE-1H AT END SG1054.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1054.2 +047700 SORT-FAIL-17. SG1054.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1054.2 +047900 PERFORM FAIL. SG1054.2 +048000 SORT-WRITE-17. SG1054.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1054.2 +048200 PERFORM PRINT-DETAIL. SG1054.2 +048300 GO TO OUTPROC-EXIT. SG1054.2 +048400 RETURN-ERROR. SG1054.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1054.2 +048600 PERFORM FAIL. SG1054.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1054.2 +048800 PERFORM PRINT-DETAIL. SG1054.2 +048900 GO TO CCVS1-EXIT. SG1054.2 +049000 CLOSE-FILES. SG1054.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1054.2 +049200 TERMINATE-CCVS. SG1054.2 +049300S EXIT PROGRAM. SG1054.2 +049400STERMINATE-CALL. SG1054.2 +049500 STOP RUN. SG1054.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1054.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1054.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1054.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1054.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1054.2 +050100 PRINT-DETAIL. SG1054.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1054.2 +050300 MOVE "." TO PARDOT-X SG1054.2 +050400 MOVE REC-CT TO DOTVALUE. SG1054.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1054.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1054.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1054.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1054.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1054.2 +051000 MOVE SPACE TO CORRECT-X. SG1054.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1054.2 +051200 MOVE SPACE TO RE-MARK. SG1054.2 +051300 HEAD-ROUTINE. SG1054.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1054.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1054.2 +051700 COLUMN-NAMES-ROUTINE. SG1054.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +052100 END-ROUTINE. SG1054.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1054.2 +052300 END-RTN-EXIT. SG1054.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +052500 END-ROUTINE-1. SG1054.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1054.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1054.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1054.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1054.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1054.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1054.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1054.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1054.2 +053400 END-ROUTINE-12. SG1054.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1054.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1054.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1054.2 +053800 ELSE SG1054.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1054.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1054.2 +054100 PERFORM WRITE-LINE. SG1054.2 +054200 END-ROUTINE-13. SG1054.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1054.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1054.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1054.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1054.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1054.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1054.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1054.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1054.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +055400 WRITE-LINE. SG1054.2 +055500 ADD 1 TO RECORD-COUNT. SG1054.2 +055600Y IF RECORD-COUNT GREATER 50 SG1054.2 +055700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1054.2 +055800Y MOVE SPACE TO DUMMY-RECORD SG1054.2 +055900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1054.2 +056000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1054.2 +056100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1054.2 +056200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1054.2 +056300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1054.2 +056400Y MOVE ZERO TO RECORD-COUNT. SG1054.2 +056500 PERFORM WRT-LN. SG1054.2 +056600 WRT-LN. SG1054.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1054.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1054.2 +056900 BLANK-LINE-PRINT. SG1054.2 +057000 PERFORM WRT-LN. SG1054.2 +057100 FAIL-ROUTINE. SG1054.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1054.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1054.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1054.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +057600 GO TO FAIL-ROUTINE-EX. SG1054.2 +057700 FAIL-ROUTINE-WRITE. SG1054.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1054.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1054.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1054.2 +058100 BAIL-OUT. SG1054.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1054.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1054.2 +058400 BAIL-OUT-WRITE. SG1054.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1054.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +058700 BAIL-OUT-EX. EXIT. SG1054.2 +058800 CCVS1-EXIT. SG1054.2 +058900 EXIT. SG1054.2 +059000 OUTPROC-EXIT SECTION 00. SG1054.2 +059100 EXIT-ONLY. SG1054.2 +059200 PERFORM CLOSE-FILES. SG1054.2 +*END-OF,SG105A +*HEADER,COBOL,SG106A +000100 IDENTIFICATION DIVISION. SG1064.2 +000200 PROGRAM-ID. SG1064.2 +000300 SG106A. SG1064.2 +000400 AUTHOR. SG1064.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1064.2 +000600 INSTALLATION. SG1064.2 +000700 GENERAL SERVICES ADMINISTRATION SG1064.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1064.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1064.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1064.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1064.2 +001200 SG1064.2 +001300 PHONE (703) 756-6153 SG1064.2 +001400 SG1064.2 +001500 " HIGH ". SG1064.2 +001600 DATE-WRITTEN. SG1064.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1064.2 +001800 CREATION DATE / VALIDATION DATE SG1064.2 +001900 "4.2 ". SG1064.2 +002000 SECURITY. SG1064.2 +002100 NONE. SG1064.2 +002200 SG106A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1064.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1064.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1064.2 +002500 REPORT. SG1064.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1064.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1064.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1064.2 +002900 USAGE JUST JUST USAGESG1064.2 +003000 COMP RIGHT RIGHT COMP SG1064.2 +003100 SG1064.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1064.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1064.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1064.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1064.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1064.2 +004000 SG1064.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1064.2 +004200 ASCENDING KEYS IN ONE FILE. SG1064.2 +004300 SG1064.2 +004400 ENVIRONMENT DIVISION. SG1064.2 +004500 CONFIGURATION SECTION. SG1064.2 +004600 SOURCE-COMPUTER. SG1064.2 +004700 XXXXX082. SG1064.2 +004800 OBJECT-COMPUTER. SG1064.2 +004900 XXXXX083. SG1064.2 +005000 INPUT-OUTPUT SECTION. SG1064.2 +005100 FILE-CONTROL. SG1064.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1064.2 +005300 XXXXX055. SG1064.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1064.2 +005500 XXXXX027. SG1064.2 +005600 DATA DIVISION. SG1064.2 +005700 FILE SECTION. SG1064.2 +005800 FD PRINT-FILE SG1064.2 +005900 LABEL RECORDS SG1064.2 +006000 XXXXX084 SG1064.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1064.2 +006200 01 PRINT-REC PICTURE X(120). SG1064.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1064.2 +006400 SD SORTFILE-1H SG1064.2 +006500 DATA RECORD IS SORTFILE-REC. SG1064.2 +006600 01 SORTFILE-REC. SG1064.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1064.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1064.2 +006900 02 SORTKEY-7 PICTURE 999. SG1064.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1064.2 +007100 02 FILLER PICTURE XX. SG1064.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1064.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1064.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1064.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1064.2 +007600 02 FILLER PICTURE XXX. SG1064.2 +007700 WORKING-STORAGE SECTION. SG1064.2 +007800 77 UTIL-CTR PICTURE S99999. SG1064.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1064.2 +008000 01 TEST-RESULTS. SG1064.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1064.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1064.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008600 02 PAR-NAME. SG1064.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1064.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1064.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1064.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1064.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1064.2 +009200 02 RE-MARK PIC X(61). SG1064.2 +009300 01 TEST-COMPUTED. SG1064.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1064.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1064.2 +009600 02 COMPUTED-X. SG1064.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1064.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1064.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1064.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1064.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1064.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1064.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1064.2 +010400 04 FILLER PICTURE X. SG1064.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1064.2 +010600 01 TEST-CORRECT. SG1064.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1064.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1064.2 +010900 02 CORRECT-X. SG1064.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1064.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1064.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1064.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1064.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1064.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1064.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1064.2 +011700 04 FILLER PICTURE X. SG1064.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1064.2 +011900 01 CCVS-C-1. SG1064.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1064.2 +012100- "SS PARAGRAPH-NAME SG1064.2 +012200- " REMARKS". SG1064.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1064.2 +012400 01 CCVS-C-2. SG1064.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1064.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1064.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1064.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1064.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1064.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1064.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1064.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1064.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1064.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1064.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1064.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1064.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1064.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1064.2 +014000 01 CCVS-H-1. SG1064.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1064.2 +014200 02 FILLER PICTURE X(67) VALUE SG1064.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1064.2 +014400- " SYSTEM". SG1064.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1064.2 +014600 01 CCVS-H-2. SG1064.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1064.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1064.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1064.2 +015000 02 TEST-ID PICTURE IS X(9). SG1064.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1064.2 +015200 01 CCVS-H-3. SG1064.2 +015300 02 FILLER PICTURE X(34) VALUE SG1064.2 +015400 " FOR OFFICIAL USE ONLY ". SG1064.2 +015500 02 FILLER PICTURE X(58) VALUE SG1064.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1064.2 +015700 02 FILLER PICTURE X(28) VALUE SG1064.2 +015800 " COPYRIGHT 1974 ". SG1064.2 +015900 01 CCVS-E-1. SG1064.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1064.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1064.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1064.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1064.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1064.2 +016500 01 CCVS-E-2. SG1064.2 +016600 02 FILLER PICTURE X(31) VALUE SG1064.2 +016700 SPACE. SG1064.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1064.2 +016900 02 CCVS-E-2-2. SG1064.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1064.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1064.2 +017300 01 CCVS-E-3. SG1064.2 +017400 02 FILLER PICTURE X(22) VALUE SG1064.2 +017500 " FOR OFFICIAL USE ONLY". SG1064.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1064.2 +017700 02 FILLER PICTURE X(58) VALUE SG1064.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1064.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1064.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1064.2 +018100 01 CCVS-E-4. SG1064.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1064.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1064.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1064.2 +018500 02 FILLER PIC X(40) VALUE SG1064.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1064.2 +018700 01 XXINFO. SG1064.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1064.2 +018900 02 INFO-TEXT. SG1064.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1064.2 +019100 04 XXCOMPUTED PIC X(20). SG1064.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1064.2 +019300 04 XXCORRECT PIC X(20). SG1064.2 +019400 01 HYPHEN-LINE. SG1064.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1064.2 +019700- "*****************************************". SG1064.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1064.2 +019900- "******************************". SG1064.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1064.2 +020100 "SG106A". SG1064.2 +020200 PROCEDURE DIVISION. SG1064.2 +020300 SORT-PARA SECTION 09. SG1064.2 +020400 SORT-PARAGRAPH. SG1064.2 +020500 SORT SORTFILE-1H ON SG1064.2 +020600 ASCENDING KEY SORTKEY-1 SG1064.2 +020700 ASCENDING SORTKEY-2 SG1064.2 +020800 ASCENDING SORTKEY-3 SG1064.2 +020900 ASCENDING SORTKEY-4 SG1064.2 +021000 ASCENDING SORTKEY-5 SG1064.2 +021100 ASCENDING SORTKEY-6 SG1064.2 +021200 ASCENDING SORTKEY-7 SG1064.2 +021300 ASCENDING SORTKEY-8 SG1064.2 +021400 INPUT PROCEDURE INPROC SG1064.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1064.2 +021600 STOP RUN. SG1064.2 +021700 INPROC SECTION 69. SG1064.2 +021800 BUILD-FILE. SG1064.2 +021900 PERFORM BUILD-RECORD. SG1064.2 +022000 MOVE +123456 TO SORTKEY-1. SG1064.2 +022100 PERFORM RELEASE-RECORD. SG1064.2 +022200 PERFORM BUILD-RECORD. SG1064.2 +022300 MOVE "X" TO SORTKEY-2. SG1064.2 +022400 PERFORM RELEASE-RECORD. SG1064.2 +022500 PERFORM BUILD-RECORD. SG1064.2 +022600 MOVE +.6 TO SORTKEY-3. SG1064.2 +022700 PERFORM RELEASE-RECORD. SG1064.2 +022800 PERFORM BUILD-RECORD. SG1064.2 +022900 MOVE "X" TO SORTKEY-4. SG1064.2 +023000 PERFORM RELEASE-RECORD. SG1064.2 +023100 PERFORM BUILD-RECORD. SG1064.2 +023200 MOVE "Z" TO SORTKEY-5. SG1064.2 +023300 PERFORM RELEASE-RECORD. SG1064.2 +023400 PERFORM BUILD-RECORD. SG1064.2 +023500 MOVE "Z" TO SORTKEY-6. SG1064.2 +023600 PERFORM RELEASE-RECORD. SG1064.2 +023700 PERFORM BUILD-RECORD. SG1064.2 +023800 MOVE +418 TO SORTKEY-7. SG1064.2 +023900 PERFORM RELEASE-RECORD. SG1064.2 +024000 PERFORM BUILD-RECORD. SG1064.2 +024100 MOVE -14 TO SORTKEY-8. SG1064.2 +024200 PERFORM RELEASE-RECORD. SG1064.2 +024300 GO TO BUILD-EXIT. SG1064.2 +024400 BUILD-RECORD. SG1064.2 +024500 MOVE -054321 TO SORTKEY-1. SG1064.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1064.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1064.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1064.2 +024900 MOVE "A" TO SORTKEY-5. SG1064.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1064.2 +025100 MOVE -501 TO SORTKEY-7. SG1064.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1064.2 +025300* FIELD. SG1064.2 +025400 MOVE +99 TO SORTKEY-8. SG1064.2 +025500 RELEASE-RECORD. SG1064.2 +025600 RELEASE SORTFILE-REC. SG1064.2 +025700 BUILD-EXIT. SG1064.2 +025800 EXIT. SG1064.2 +025900 OUTPROC SECTION 99. SG1064.2 +026000 OPEN-FILES. SG1064.2 +026100 OPEN OUTPUT PRINT-FILE. SG1064.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1064.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1064.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1064.2 +026500 IF SPAC-E IS LESS THAN "B" SG1064.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1064.2 +026700 B-IS-LESS-THAN-SPACE SECTION 99. SG1064.2 +026800 SORT-INIT-A. SG1064.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1064.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1064.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1064.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1064.2 +027400 SORT-TEST-1. SG1064.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1064.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1064.2 +027800 SORT-FAIL-1. SG1064.2 +027900 PERFORM FAIL. SG1064.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1064.2 +028100 MOVE 418 TO CORRECT-N. SG1064.2 +028200 SORT-WRITE-1. SG1064.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1064.2 +028400 PERFORM PRINT-DETAIL. SG1064.2 +028500 SORT-TEST-2. SG1064.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1064.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1064.2 +028900 SORT-FAIL-2. SG1064.2 +029000 PERFORM FAIL. SG1064.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1064.2 +029200 MOVE -14 TO CORRECT-N. SG1064.2 +029300 SORT-WRITE-2. SG1064.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1064.2 +029500 PERFORM PRINT-DETAIL. SG1064.2 +029600 SORT-TEST-3. SG1064.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1064.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1064.2 +030000 SORT-FAIL-3. SG1064.2 +030100 PERFORM FAIL. SG1064.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1064.2 +030300 MOVE "Z " TO CORRECT-A. SG1064.2 +030400 SORT-WRITE-3. SG1064.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1064.2 +030600 PERFORM PRINT-DETAIL. SG1064.2 +030700 SORT-TEST-4. SG1064.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1064.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1064.2 +031100 SORT-FAIL-4. SG1064.2 +031200 PERFORM FAIL. SG1064.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1064.2 +031400 MOVE "Z " TO CORRECT-A. SG1064.2 +031500 SORT-WRITE-4. SG1064.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1064.2 +031700 PERFORM PRINT-DETAIL. SG1064.2 +031800 SORT-TEST-5. SG1064.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1064.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1064.2 +032200 SORT-FAIL-5. SG1064.2 +032300 PERFORM FAIL. SG1064.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1064.2 +032500 MOVE " X" TO CORRECT-A. SG1064.2 +032600 SORT-WRITE-5. SG1064.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1064.2 +032800 PERFORM PRINT-DETAIL. SG1064.2 +032900 SORT-TEST-6. SG1064.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1064.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1064.2 +033300 SORT-FAIL-6. SG1064.2 +033400 PERFORM FAIL. SG1064.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1064.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1064.2 +033700 SORT-WRITE-6. SG1064.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1064.2 +033900 PERFORM PRINT-DETAIL. SG1064.2 +034000 SORT-TEST-7. SG1064.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1064.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1064.2 +034400 SORT-FAIL-7. SG1064.2 +034500 PERFORM FAIL. SG1064.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1064.2 +034700 MOVE " X" TO CORRECT-A. SG1064.2 +034800 SORT-WRITE-7. SG1064.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1064.2 +035000 PERFORM PRINT-DETAIL. SG1064.2 +035100 SORT-TEST-8. SG1064.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1064.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1064.2 +035500 SORT-FAIL-8. SG1064.2 +035600 PERFORM FAIL. SG1064.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1064.2 +035800 MOVE +123456 TO CORRECT-N. SG1064.2 +035900 SORT-WRITE-8. SG1064.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1064.2 +036100 PERFORM PRINT-DETAIL. SG1064.2 +036200 SORT-REMARK-A. SG1064.2 +036300 MOVE SPACE TO FEATURE. SG1064.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1064.2 +036500 PERFORM PRINT-DETAIL. SG1064.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1064.2 +036700 PERFORM PRINT-DETAIL. SG1064.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1064.2 +036900 PERFORM PRINT-DETAIL. SG1064.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +037100 GO TO CONTINUE-TESTING. SG1064.2 +037200 SPACE-IS-LESS-THAN-B SECTION 99. SG1064.2 +037300 SORT-REMARK-B. SG1064.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1064.2 +037500 PERFORM PRINT-DETAIL. SG1064.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1064.2 +037700 PERFORM PRINT-DETAIL. SG1064.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1064.2 +037900 PERFORM PRINT-DETAIL. SG1064.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1064.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1064.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1064.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1064.2 +038500 SORT-TEST-9. SG1064.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1064.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1064.2 +038900 SORT-FAIL-9. SG1064.2 +039000 PERFORM FAIL. SG1064.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1064.2 +039200 MOVE " X" TO CORRECT-A. SG1064.2 +039300 SORT-WRITE-9. SG1064.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1064.2 +039500 PERFORM PRINT-DETAIL. SG1064.2 +039600 SORT-TEST-10. SG1064.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1064.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1064.2 +040000 SORT-FAIL-10. SG1064.2 +040100 PERFORM FAIL. SG1064.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1064.2 +040300 MOVE " X" TO CORRECT-A. SG1064.2 +040400 SORT-WRITE-10. SG1064.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1064.2 +040600 PERFORM PRINT-DETAIL. SG1064.2 +040700 SORT-TEST-11. SG1064.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1064.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1064.2 +041100 SORT-FAIL-11. SG1064.2 +041200 PERFORM FAIL. SG1064.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1064.2 +041400 MOVE 418 TO CORRECT-N. SG1064.2 +041500 SORT-WRITE-11. SG1064.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1064.2 +041700 PERFORM PRINT-DETAIL. SG1064.2 +041800 SORT-TEST-12. SG1064.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1064.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1064.2 +042200 SORT-FAIL-12. SG1064.2 +042300 PERFORM FAIL. SG1064.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1064.2 +042500 MOVE -14 TO CORRECT-N. SG1064.2 +042600 SORT-WRITE-12. SG1064.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1064.2 +042800 PERFORM PRINT-DETAIL. SG1064.2 +042900 SORT-TEST-13. SG1064.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1064.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1064.2 +043300 SORT-FAIL-13. SG1064.2 +043400 PERFORM FAIL. SG1064.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1064.2 +043600 MOVE "Z " TO CORRECT-A. SG1064.2 +043700 SORT-WRITE-13. SG1064.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1064.2 +043900 PERFORM PRINT-DETAIL. SG1064.2 +044000 SORT-TEST-14. SG1064.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1064.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1064.2 +044400 SORT-FAIL-14. SG1064.2 +044500 PERFORM FAIL. SG1064.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1064.2 +044700 MOVE "Z " TO CORRECT-A. SG1064.2 +044800 SORT-WRITE-14. SG1064.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1064.2 +045000 PERFORM PRINT-DETAIL. SG1064.2 +045100 SORT-TEST-15. SG1064.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1064.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1064.2 +045500 SORT-FAIL-15. SG1064.2 +045600 PERFORM FAIL. SG1064.2 +045700 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1064.2 +045800 MOVE +.6000000000000000 TO CORRECT-0V18. SG1064.2 +045900 SORT-WRITE-15. SG1064.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1064.2 +046100 PERFORM PRINT-DETAIL. SG1064.2 +046200 SORT-TEST-16. SG1064.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1064.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1064.2 +046600 SORT-FAIL-16. SG1064.2 +046700 PERFORM FAIL. SG1064.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1064.2 +046900 MOVE +123456 TO CORRECT-N. SG1064.2 +047000 SORT-WRITE-16. SG1064.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1064.2 +047200 PERFORM PRINT-DETAIL. SG1064.2 +047300 CONTINUE-TESTING SECTION 99. SG1064.2 +047400 SORT-TEST-17. SG1064.2 +047500 RETURN SORTFILE-1H AT END SG1064.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1064.2 +047700 SORT-FAIL-17. SG1064.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1064.2 +047900 PERFORM FAIL. SG1064.2 +048000 SORT-WRITE-17. SG1064.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1064.2 +048200 PERFORM PRINT-DETAIL. SG1064.2 +048300 GO TO OUTPROC-EXIT. SG1064.2 +048400 RETURN-ERROR. SG1064.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1064.2 +048600 PERFORM FAIL. SG1064.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1064.2 +048800 PERFORM PRINT-DETAIL. SG1064.2 +048900 GO TO CCVS1-EXIT. SG1064.2 +049000 CLOSE-FILES. SG1064.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1064.2 +049200 TERMINATE-CCVS. SG1064.2 +049300S EXIT PROGRAM. SG1064.2 +049400STERMINATE-CALL. SG1064.2 +049500 STOP RUN. SG1064.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1064.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1064.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1064.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1064.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1064.2 +050100 PRINT-DETAIL. SG1064.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1064.2 +050300 MOVE "." TO PARDOT-X SG1064.2 +050400 MOVE REC-CT TO DOTVALUE. SG1064.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1064.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1064.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1064.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1064.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1064.2 +051000 MOVE SPACE TO CORRECT-X. SG1064.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1064.2 +051200 MOVE SPACE TO RE-MARK. SG1064.2 +051300 HEAD-ROUTINE. SG1064.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1064.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1064.2 +051700 COLUMN-NAMES-ROUTINE. SG1064.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +052100 END-ROUTINE. SG1064.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1064.2 +052300 END-RTN-EXIT. SG1064.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +052500 END-ROUTINE-1. SG1064.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1064.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1064.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1064.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1064.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1064.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1064.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1064.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1064.2 +053400 END-ROUTINE-12. SG1064.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1064.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1064.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1064.2 +053800 ELSE SG1064.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1064.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1064.2 +054100 PERFORM WRITE-LINE. SG1064.2 +054200 END-ROUTINE-13. SG1064.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1064.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1064.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1064.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1064.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1064.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1064.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1064.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1064.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +055400 WRITE-LINE. SG1064.2 +055500 ADD 1 TO RECORD-COUNT. SG1064.2 +055600Y IF RECORD-COUNT GREATER 50 SG1064.2 +055700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG1064.2 +055800Y MOVE SPACE TO DUMMY-RECORD SG1064.2 +055900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1064.2 +056000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1064.2 +056100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1064.2 +056200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1064.2 +056300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG1064.2 +056400Y MOVE ZERO TO RECORD-COUNT. SG1064.2 +056500 PERFORM WRT-LN. SG1064.2 +056600 WRT-LN. SG1064.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1064.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1064.2 +056900 BLANK-LINE-PRINT. SG1064.2 +057000 PERFORM WRT-LN. SG1064.2 +057100 FAIL-ROUTINE. SG1064.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1064.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1064.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1064.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +057600 GO TO FAIL-ROUTINE-EX. SG1064.2 +057700 FAIL-ROUTINE-WRITE. SG1064.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1064.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1064.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1064.2 +058100 BAIL-OUT. SG1064.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1064.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1064.2 +058400 BAIL-OUT-WRITE. SG1064.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1064.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +058700 BAIL-OUT-EX. EXIT. SG1064.2 +058800 CCVS1-EXIT. SG1064.2 +058900 EXIT. SG1064.2 +059000 OUTPROC-EXIT SECTION 99. SG1064.2 +059100 EXIT-ONLY. SG1064.2 +059200 PERFORM CLOSE-FILES. SG1064.2 +*END-OF,SG106A +*HEADER,COBOL,SG201A +000100 IDENTIFICATION DIVISION. SG2014.2 +000200 PROGRAM-ID. SG2014.2 +000300 SG201A. SG2014.2 +000400 AUTHOR. SG2014.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2014.2 +000600 INSTALLATION. SG2014.2 +000700 GENERAL SERVICES ADMINISTRATION SG2014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2014.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2014.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2014.2 +001200 SG2014.2 +001300 PHONE (703) 756-6153 SG2014.2 +001400 SG2014.2 +001500 " HIGH ". SG2014.2 +001600 DATE-WRITTEN. SG2014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2014.2 +001800 CREATION DATE / VALIDATION DATE SG2014.2 +001900 "4.2 ". SG2014.2 +002000 SECURITY. SG2014.2 +002100 NONE. SG2014.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2014.2 +002300 SEGMENT-LIMIT FEATURE IS TESTED BY USE OF ALTER SG2014.2 +002400 PERFORM AND GO TO STATEMENTS VERIFYING LAST-USED SG2014.2 +002500 STATE ON SEGMENTS GREATER THAN AND EQUAL TO THE SG2014.2 +002600 SEGMENT-LIMIT INCLUDING SEGMENTS PERMANENTLY RESIDENT SG2014.2 +002700 (LESS THAN SEGMENT-LIMIT) WITH THE INITIAL STATE SG2014.2 +002800 ON SEGMENTS GREATER THAN 49. SG2014.2 +002900 SG2014.2 +003000* SG2014.2 +003100 ENVIRONMENT DIVISION. SG2014.2 +003200 CONFIGURATION SECTION. SG2014.2 +003300 SOURCE-COMPUTER. SG2014.2 +003400 XXXXX082. SG2014.2 +003500 OBJECT-COMPUTER. SG2014.2 +003600 XXXXX083 SG2014.2 +003700 SEGMENT-LIMIT IS 30. SG2014.2 +003800 INPUT-OUTPUT SECTION. SG2014.2 +003900 FILE-CONTROL. SG2014.2 +004000 SELECT PRINT-FILE ASSIGN TO SG2014.2 +004100 XXXXX055. SG2014.2 +004200 DATA DIVISION. SG2014.2 +004300 FILE SECTION. SG2014.2 +004400 FD PRINT-FILE SG2014.2 +004500 LABEL RECORDS SG2014.2 +004600 XXXXX084 SG2014.2 +004700 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2014.2 +004800 01 PRINT-REC PICTURE X(120). SG2014.2 +004900 01 DUMMY-RECORD PICTURE X(120). SG2014.2 +005000 WORKING-STORAGE SECTION. SG2014.2 +005100 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG2014.2 +005200 01 TEST-RESULTS. SG2014.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2014.2 +005500 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2014.2 +005700 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005800 02 PAR-NAME. SG2014.2 +005900 03 FILLER PICTURE X(12) VALUE SPACE. SG2014.2 +006000 03 PARDOT-X PICTURE X VALUE SPACE. SG2014.2 +006100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2014.2 +006200 03 FILLER PIC X(5) VALUE SPACE. SG2014.2 +006300 02 FILLER PIC X(10) VALUE SPACE. SG2014.2 +006400 02 RE-MARK PIC X(61). SG2014.2 +006500 01 TEST-COMPUTED. SG2014.2 +006600 02 FILLER PIC X(30) VALUE SPACE. SG2014.2 +006700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2014.2 +006800 02 COMPUTED-X. SG2014.2 +006900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2014.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2014.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2014.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2014.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2014.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. SG2014.2 +007500 04 COMPUTED-18V0 PICTURE -9(18). SG2014.2 +007600 04 FILLER PICTURE X. SG2014.2 +007700 03 FILLER PIC X(50) VALUE SPACE. SG2014.2 +007800 01 TEST-CORRECT. SG2014.2 +007900 02 FILLER PIC X(30) VALUE SPACE. SG2014.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2014.2 +008100 02 CORRECT-X. SG2014.2 +008200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2014.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2014.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2014.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2014.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2014.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. SG2014.2 +008800 04 CORRECT-18V0 PICTURE -9(18). SG2014.2 +008900 04 FILLER PICTURE X. SG2014.2 +009000 03 FILLER PIC X(50) VALUE SPACE. SG2014.2 +009100 01 CCVS-C-1. SG2014.2 +009200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2014.2 +009300- "SS PARAGRAPH-NAME SG2014.2 +009400- " REMARKS". SG2014.2 +009500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2014.2 +009600 01 CCVS-C-2. SG2014.2 +009700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +009800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2014.2 +009900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2014.2 +010000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2014.2 +010100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2014.2 +010200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2014.2 +010300 01 REC-CT PICTURE 99 VALUE ZERO. SG2014.2 +010400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2014.2 +010500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2014.2 +010600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2014.2 +010700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2014.2 +010800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2014.2 +010900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2014.2 +011000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2014.2 +011100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2014.2 +011200 01 CCVS-H-1. SG2014.2 +011300 02 FILLER PICTURE X(27) VALUE SPACE. SG2014.2 +011400 02 FILLER PICTURE X(67) VALUE SG2014.2 +011500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2014.2 +011600- " SYSTEM". SG2014.2 +011700 02 FILLER PICTURE X(26) VALUE SPACE. SG2014.2 +011800 01 CCVS-H-2. SG2014.2 +011900 02 FILLER PICTURE X(52) VALUE IS SG2014.2 +012000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2014.2 +012100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2014.2 +012200 02 TEST-ID PICTURE IS X(9). SG2014.2 +012300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2014.2 +012400 01 CCVS-H-3. SG2014.2 +012500 02 FILLER PICTURE X(34) VALUE SG2014.2 +012600 " FOR OFFICIAL USE ONLY ". SG2014.2 +012700 02 FILLER PICTURE X(58) VALUE SG2014.2 +012800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2014.2 +012900 02 FILLER PICTURE X(28) VALUE SG2014.2 +013000 " COPYRIGHT 1974 ". SG2014.2 +013100 01 CCVS-E-1. SG2014.2 +013200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2014.2 +013300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2014.2 +013400 02 ID-AGAIN PICTURE IS X(9). SG2014.2 +013500 02 FILLER PICTURE X(45) VALUE IS SG2014.2 +013600 " NTIS DISTRIBUTION COBOL 74". SG2014.2 +013700 01 CCVS-E-2. SG2014.2 +013800 02 FILLER PICTURE X(31) VALUE SG2014.2 +013900 SPACE. SG2014.2 +014000 02 FILLER PICTURE X(21) VALUE SPACE. SG2014.2 +014100 02 CCVS-E-2-2. SG2014.2 +014200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2014.2 +014300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +014400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2014.2 +014500 01 CCVS-E-3. SG2014.2 +014600 02 FILLER PICTURE X(22) VALUE SG2014.2 +014700 " FOR OFFICIAL USE ONLY". SG2014.2 +014800 02 FILLER PICTURE X(12) VALUE SPACE. SG2014.2 +014900 02 FILLER PICTURE X(58) VALUE SG2014.2 +015000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2014.2 +015100 02 FILLER PICTURE X(13) VALUE SPACE. SG2014.2 +015200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2014.2 +015300 01 CCVS-E-4. SG2014.2 +015400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2014.2 +015500 02 FILLER PIC XXXX VALUE " OF ". SG2014.2 +015600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2014.2 +015700 02 FILLER PIC X(40) VALUE SG2014.2 +015800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2014.2 +015900 01 XXINFO. SG2014.2 +016000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2014.2 +016100 02 INFO-TEXT. SG2014.2 +016200 04 FILLER PIC X(20) VALUE SPACE. SG2014.2 +016300 04 XXCOMPUTED PIC X(20). SG2014.2 +016400 04 FILLER PIC X(5) VALUE SPACE. SG2014.2 +016500 04 XXCORRECT PIC X(20). SG2014.2 +016600 01 HYPHEN-LINE. SG2014.2 +016700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +016800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2014.2 +016900- "*****************************************". SG2014.2 +017000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2014.2 +017100- "******************************". SG2014.2 +017200 01 CCVS-PGM-ID PIC X(6) VALUE SG2014.2 +017300 "SG201A". SG2014.2 +017400 PROCEDURE DIVISION. SG2014.2 +017500 HOUSEKEEPING SECTION 50. SG2014.2 +017600 PARAGRAPH-1. SG2014.2 +017700 PERFORM CCVS1. SG2014.2 +017800 GO TO SEG-TEST-1. SG2014.2 +017900 CCVS1 SECTION. SG2014.2 +018000 OPEN-FILES. SG2014.2 +018100 OPEN OUTPUT PRINT-FILE. SG2014.2 +018200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2014.2 +018300 MOVE SPACE TO TEST-RESULTS. SG2014.2 +018400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2014.2 +018500 GO TO CCVS1-EXIT. SG2014.2 +018600 CLOSE-FILES. SG2014.2 +018700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2014.2 +018800 TERMINATE-CCVS. SG2014.2 +018900S EXIT PROGRAM. SG2014.2 +019000STERMINATE-CALL. SG2014.2 +019100 STOP RUN. SG2014.2 +019200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2014.2 +019300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2014.2 +019400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2014.2 +019500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2014.2 +019600 MOVE "****TEST DELETED****" TO RE-MARK. SG2014.2 +019700 PRINT-DETAIL. SG2014.2 +019800 IF REC-CT NOT EQUAL TO ZERO SG2014.2 +019900 MOVE "." TO PARDOT-X SG2014.2 +020000 MOVE REC-CT TO DOTVALUE. SG2014.2 +020100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2014.2 +020200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2014.2 +020300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2014.2 +020400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2014.2 +020500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2014.2 +020600 MOVE SPACE TO CORRECT-X. SG2014.2 +020700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2014.2 +020800 MOVE SPACE TO RE-MARK. SG2014.2 +020900 HEAD-ROUTINE. SG2014.2 +021000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +021100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2014.2 +021200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2014.2 +021300 COLUMN-NAMES-ROUTINE. SG2014.2 +021400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +021500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +021600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +021700 END-ROUTINE. SG2014.2 +021800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2014.2 +021900 END-RTN-EXIT. SG2014.2 +022000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +022100 END-ROUTINE-1. SG2014.2 +022200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2014.2 +022300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2014.2 +022400 ADD PASS-COUNTER TO ERROR-HOLD. SG2014.2 +022500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2014.2 +022600 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2014.2 +022700 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2014.2 +022800 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2014.2 +022900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2014.2 +023000 END-ROUTINE-12. SG2014.2 +023100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2014.2 +023200 IF ERROR-COUNTER IS EQUAL TO ZERO SG2014.2 +023300 MOVE "NO " TO ERROR-TOTAL SG2014.2 +023400 ELSE SG2014.2 +023500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2014.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2014.2 +023700 PERFORM WRITE-LINE. SG2014.2 +023800 END-ROUTINE-13. SG2014.2 +023900 IF DELETE-CNT IS EQUAL TO ZERO SG2014.2 +024000 MOVE "NO " TO ERROR-TOTAL ELSE SG2014.2 +024100 MOVE DELETE-CNT TO ERROR-TOTAL. SG2014.2 +024200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2014.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +024400 IF INSPECT-COUNTER EQUAL TO ZERO SG2014.2 +024500 MOVE "NO " TO ERROR-TOTAL SG2014.2 +024600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2014.2 +024700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2014.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +024900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +025000 WRITE-LINE. SG2014.2 +025100 ADD 1 TO RECORD-COUNT. SG2014.2 +025200Y IF RECORD-COUNT GREATER 50 SG2014.2 +025300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2014.2 +025400Y MOVE SPACE TO DUMMY-RECORD SG2014.2 +025500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2014.2 +025600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2014.2 +025700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2014.2 +025800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2014.2 +025900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2014.2 +026000Y MOVE ZERO TO RECORD-COUNT. SG2014.2 +026100 PERFORM WRT-LN. SG2014.2 +026200 WRT-LN. SG2014.2 +026300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2014.2 +026400 MOVE SPACE TO DUMMY-RECORD. SG2014.2 +026500 BLANK-LINE-PRINT. SG2014.2 +026600 PERFORM WRT-LN. SG2014.2 +026700 FAIL-ROUTINE. SG2014.2 +026800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2014.2 +026900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2014.2 +027000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2014.2 +027100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +027200 GO TO FAIL-ROUTINE-EX. SG2014.2 +027300 FAIL-ROUTINE-WRITE. SG2014.2 +027400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2014.2 +027500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2014.2 +027600 FAIL-ROUTINE-EX. EXIT. SG2014.2 +027700 BAIL-OUT. SG2014.2 +027800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2014.2 +027900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2014.2 +028000 BAIL-OUT-WRITE. SG2014.2 +028100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2014.2 +028200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +028300 BAIL-OUT-EX. EXIT. SG2014.2 +028400 CCVS1-EXIT. SG2014.2 +028500 EXIT. SG2014.2 +028600 RUN-THE-TESTS SECTION. SG2014.2 +028700 SEG-TEST-1. SG2014.2 +028800 MOVE SPACE TO TEST-CHECK. SG2014.2 +028900 PERFORM 00. SG2014.2 +029000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +029100 PERFORM PASS SG2014.2 +029200 GO TO SEG-WRITE-1. SG2014.2 +029300 MOVE SPACE TO COMPUTED-A. SG2014.2 +029400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +029500 PERFORM FAIL. SG2014.2 +029600 GO TO SEG-WRITE-1. SG2014.2 +029700 SEG-DELETE-1. SG2014.2 +029800 PERFORM DE-LETE. SG2014.2 +029900 SEG-WRITE-1. SG2014.2 +030000 MOVE "SEGMENT-LIMIT" TO FEATURE. SG2014.2 +030100 MOVE "SEG-TEST-1 " TO PAR-NAME. SG2014.2 +030200 PERFORM PRINT-DETAIL. SG2014.2 +030300 SEG-TEST-2. SG2014.2 +030400 MOVE SPACE TO TEST-CHECK. SG2014.2 +030500 PERFORM 30. SG2014.2 +030600 PERFORM 30. SG2014.2 +030700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +030800 PERFORM PASS SG2014.2 +030900 GO TO SEG-WRITE-2. SG2014.2 +031000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +031100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +031200 PERFORM FAIL. SG2014.2 +031300 GO TO SEG-WRITE-2. SG2014.2 +031400 SEG-DELETE-2. SG2014.2 +031500 PERFORM DE-LETE. SG2014.2 +031600 SEG-WRITE-2. SG2014.2 +031700 MOVE "SEG-TEST-2 " TO PAR-NAME. SG2014.2 +031800 PERFORM PRINT-DETAIL. SG2014.2 +031900 SEG-TEST-3. SG2014.2 +032000 MOVE SPACE TO TEST-CHECK. SG2014.2 +032100 PERFORM 31. SG2014.2 +032200 PERFORM 31. SG2014.2 +032300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +032400 PERFORM PASS SG2014.2 +032500 GO TO SEG-WRITE-3. SG2014.2 +032600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +032700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +032800 PERFORM FAIL. SG2014.2 +032900 GO TO SEG-WRITE-3. SG2014.2 +033000 SEG-DELETE-3. SG2014.2 +033100 PERFORM DE-LETE. SG2014.2 +033200 SEG-WRITE-3. SG2014.2 +033300 MOVE "SEG-TEST-3 " TO PAR-NAME. SG2014.2 +033400 PERFORM PRINT-DETAIL. SG2014.2 +033500 SEG-TEST-4. SG2014.2 +033600 MOVE SPACE TO TEST-CHECK. SG2014.2 +033700 PERFORM 32. SG2014.2 +033800 PERFORM 32. SG2014.2 +033900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +034000 PERFORM PASS SG2014.2 +034100 GO TO SEG-WRITE-4. SG2014.2 +034200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +034300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +034400 PERFORM FAIL. SG2014.2 +034500 GO TO SEG-WRITE-4. SG2014.2 +034600 SEG-DELETE-4. SG2014.2 +034700 PERFORM DE-LETE. SG2014.2 +034800 SEG-WRITE-4. SG2014.2 +034900 MOVE "SEG-TEST-4 " TO PAR-NAME. SG2014.2 +035000 PERFORM PRINT-DETAIL. SG2014.2 +035100 SEG-TEST-5. SG2014.2 +035200 MOVE SPACE TO TEST-CHECK. SG2014.2 +035300 PERFORM 33. SG2014.2 +035400 PERFORM 33. SG2014.2 +035500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +035600 PERFORM PASS SG2014.2 +035700 GO TO SEG-WRITE-5. SG2014.2 +035800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +035900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +036000 PERFORM FAIL. SG2014.2 +036100 GO TO SEG-WRITE-5. SG2014.2 +036200 SEG-DELETE-5. SG2014.2 +036300 PERFORM DE-LETE. SG2014.2 +036400 SEG-WRITE-5. SG2014.2 +036500 MOVE "SEG-TEST-5 " TO PAR-NAME. SG2014.2 +036600 PERFORM PRINT-DETAIL. SG2014.2 +036700 SEG-TEST-6. SG2014.2 +036800 MOVE SPACE TO TEST-CHECK. SG2014.2 +036900 PERFORM 34. SG2014.2 +037000 PERFORM 34. SG2014.2 +037100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +037200 PERFORM PASS SG2014.2 +037300 GO TO SEG-WRITE-6. SG2014.2 +037400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +037500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +037600 PERFORM FAIL. SG2014.2 +037700 GO TO SEG-WRITE-6. SG2014.2 +037800 SEG-DELETE-6. SG2014.2 +037900 PERFORM DE-LETE. SG2014.2 +038000 SEG-WRITE-6. SG2014.2 +038100 MOVE "SEG-TEST-6 " TO PAR-NAME. SG2014.2 +038200 PERFORM PRINT-DETAIL. SG2014.2 +038300 SEG-TEST-7. SG2014.2 +038400 MOVE SPACE TO TEST-CHECK. SG2014.2 +038500 PERFORM 35. SG2014.2 +038600 PERFORM 35. SG2014.2 +038700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +038800 PERFORM PASS SG2014.2 +038900 GO TO SEG-WRITE-7. SG2014.2 +039000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +039100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +039200 PERFORM FAIL. SG2014.2 +039300 GO TO SEG-WRITE-7. SG2014.2 +039400 SEG-DELETE-7. SG2014.2 +039500 PERFORM DE-LETE. SG2014.2 +039600 SEG-WRITE-7. SG2014.2 +039700 MOVE "SEG-TEST-7 " TO PAR-NAME. SG2014.2 +039800 PERFORM PRINT-DETAIL. SG2014.2 +039900 SEG-TEST-8. SG2014.2 +040000 MOVE SPACE TO TEST-CHECK. SG2014.2 +040100 PERFORM 36. SG2014.2 +040200 PERFORM 36. SG2014.2 +040300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +040400 PERFORM PASS SG2014.2 +040500 GO TO SEG-WRITE-8. SG2014.2 +040600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +040700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +040800 PERFORM FAIL. SG2014.2 +040900 GO TO SEG-WRITE-8. SG2014.2 +041000 SEG-DELETE-8. SG2014.2 +041100 PERFORM DE-LETE. SG2014.2 +041200 SEG-WRITE-8. SG2014.2 +041300 MOVE "SEG-TEST-8 " TO PAR-NAME. SG2014.2 +041400 PERFORM PRINT-DETAIL. SG2014.2 +041500 SEG-TEST-9. SG2014.2 +041600 MOVE SPACE TO TEST-CHECK. SG2014.2 +041700 PERFORM 37. SG2014.2 +041800 PERFORM 37. SG2014.2 +041900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +042000 PERFORM PASS SG2014.2 +042100 GO TO SEG-WRITE-9. SG2014.2 +042200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +042300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +042400 PERFORM FAIL. SG2014.2 +042500 GO TO SEG-WRITE-9. SG2014.2 +042600 SEG-DELETE-9. SG2014.2 +042700 PERFORM DE-LETE. SG2014.2 +042800 SEG-WRITE-9. SG2014.2 +042900 MOVE "SEG-TEST-9 " TO PAR-NAME. SG2014.2 +043000 PERFORM PRINT-DETAIL. SG2014.2 +043100 SEG-TEST-10. SG2014.2 +043200 MOVE SPACE TO TEST-CHECK. SG2014.2 +043300 PERFORM 38. SG2014.2 +043400 PERFORM 38. SG2014.2 +043500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +043600 PERFORM PASS SG2014.2 +043700 GO TO SEG-WRITE-10. SG2014.2 +043800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +043900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +044000 PERFORM FAIL. SG2014.2 +044100 GO TO SEG-WRITE-10. SG2014.2 +044200 SEG-DELETE-10. SG2014.2 +044300 PERFORM DE-LETE. SG2014.2 +044400 SEG-WRITE-10. SG2014.2 +044500 MOVE "SEG-TEST-10 " TO PAR-NAME. SG2014.2 +044600 PERFORM PRINT-DETAIL. SG2014.2 +044700 SEG-TEST-11. SG2014.2 +044800 MOVE SPACE TO TEST-CHECK. SG2014.2 +044900 PERFORM 39. SG2014.2 +045000 PERFORM 39. SG2014.2 +045100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +045200 PERFORM PASS SG2014.2 +045300 GO TO SEG-WRITE-11. SG2014.2 +045400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +045500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +045600 PERFORM FAIL. SG2014.2 +045700 GO TO SEG-WRITE-11. SG2014.2 +045800 SEG-DELETE-11. SG2014.2 +045900 PERFORM DE-LETE. SG2014.2 +046000 SEG-WRITE-11. SG2014.2 +046100 MOVE "SEG-TEST-11 " TO PAR-NAME. SG2014.2 +046200 PERFORM PRINT-DETAIL. SG2014.2 +046300 SEG-TEST-12. SG2014.2 +046400 MOVE SPACE TO TEST-CHECK. SG2014.2 +046500 PERFORM 40. SG2014.2 +046600 PERFORM 40. SG2014.2 +046700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +046800 PERFORM PASS SG2014.2 +046900 GO TO SEG-WRITE-12. SG2014.2 +047000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +047100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +047200 PERFORM FAIL. SG2014.2 +047300 GO TO SEG-WRITE-12. SG2014.2 +047400 SEG-DELETE-12. SG2014.2 +047500 PERFORM DE-LETE. SG2014.2 +047600 SEG-WRITE-12. SG2014.2 +047700 MOVE "SEG-TEST-12 " TO PAR-NAME. SG2014.2 +047800 PERFORM PRINT-DETAIL. SG2014.2 +047900 SEG-TEST-13. SG2014.2 +048000 MOVE SPACE TO TEST-CHECK. SG2014.2 +048100 PERFORM 41. SG2014.2 +048200 PERFORM 41. SG2014.2 +048300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +048400 PERFORM PASS SG2014.2 +048500 GO TO SEG-WRITE-13. SG2014.2 +048600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +048700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +048800 PERFORM FAIL. SG2014.2 +048900 GO TO SEG-WRITE-13. SG2014.2 +049000 SEG-DELETE-13. SG2014.2 +049100 PERFORM DE-LETE. SG2014.2 +049200 SEG-WRITE-13. SG2014.2 +049300 MOVE "SEG-TEST-13 " TO PAR-NAME. SG2014.2 +049400 PERFORM PRINT-DETAIL. SG2014.2 +049500 SEG-TEST-14. SG2014.2 +049600 MOVE SPACE TO TEST-CHECK. SG2014.2 +049700 PERFORM 42. SG2014.2 +049800 PERFORM 42. SG2014.2 +049900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +050000 PERFORM PASS SG2014.2 +050100 GO TO SEG-WRITE-14. SG2014.2 +050200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +050300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +050400 PERFORM FAIL. SG2014.2 +050500 GO TO SEG-WRITE-14. SG2014.2 +050600 SEG-DELETE-14. SG2014.2 +050700 PERFORM DE-LETE. SG2014.2 +050800 SEG-WRITE-14. SG2014.2 +050900 MOVE "SEG-TEST-14 " TO PAR-NAME. SG2014.2 +051000 PERFORM PRINT-DETAIL. SG2014.2 +051100 SEG-TEST-15. SG2014.2 +051200 MOVE SPACE TO TEST-CHECK. SG2014.2 +051300 PERFORM 43. SG2014.2 +051400 PERFORM 43. SG2014.2 +051500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +051600 PERFORM PASS SG2014.2 +051700 GO TO SEG-WRITE-15. SG2014.2 +051800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +051900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +052000 PERFORM FAIL. SG2014.2 +052100 GO TO SEG-WRITE-15. SG2014.2 +052200 SEG-DELETE-15. SG2014.2 +052300 PERFORM DE-LETE. SG2014.2 +052400 SEG-WRITE-15. SG2014.2 +052500 MOVE "SEG-TEST-15 " TO PAR-NAME. SG2014.2 +052600 PERFORM PRINT-DETAIL. SG2014.2 +052700 SEG-TEST-16. SG2014.2 +052800 MOVE SPACE TO TEST-CHECK. SG2014.2 +052900 PERFORM 44. SG2014.2 +053000 PERFORM 44. SG2014.2 +053100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +053200 PERFORM PASS SG2014.2 +053300 GO TO SEG-WRITE-16. SG2014.2 +053400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +053500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +053600 PERFORM FAIL. SG2014.2 +053700 GO TO SEG-WRITE-16. SG2014.2 +053800 SEG-DELETE-16. SG2014.2 +053900 PERFORM DE-LETE. SG2014.2 +054000 SEG-WRITE-16. SG2014.2 +054100 MOVE "SEG-TEST-16 " TO PAR-NAME. SG2014.2 +054200 PERFORM PRINT-DETAIL. SG2014.2 +054300 SEG-TEST-17. SG2014.2 +054400 MOVE SPACE TO TEST-CHECK. SG2014.2 +054500 PERFORM 45. SG2014.2 +054600 PERFORM 45. SG2014.2 +054700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +054800 PERFORM PASS SG2014.2 +054900 GO TO SEG-WRITE-17. SG2014.2 +055000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +055100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +055200 PERFORM FAIL. SG2014.2 +055300 GO TO SEG-WRITE-17. SG2014.2 +055400 SEG-DELETE-17. SG2014.2 +055500 PERFORM DE-LETE. SG2014.2 +055600 SEG-WRITE-17. SG2014.2 +055700 MOVE "SEG-TEST-17 " TO PAR-NAME. SG2014.2 +055800 PERFORM PRINT-DETAIL. SG2014.2 +055900 SEG-TEST-18. SG2014.2 +056000 MOVE SPACE TO TEST-CHECK. SG2014.2 +056100 PERFORM 46. SG2014.2 +056200 PERFORM 46. SG2014.2 +056300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +056400 PERFORM PASS SG2014.2 +056500 GO TO SEG-WRITE-18. SG2014.2 +056600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +056700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +056800 PERFORM FAIL. SG2014.2 +056900 GO TO SEG-WRITE-18. SG2014.2 +057000 SEG-DELETE-18. SG2014.2 +057100 PERFORM DE-LETE. SG2014.2 +057200 SEG-WRITE-18. SG2014.2 +057300 MOVE "SEG-TEST-18 " TO PAR-NAME. SG2014.2 +057400 PERFORM PRINT-DETAIL. SG2014.2 +057500 SEG-TEST-19. SG2014.2 +057600 MOVE SPACE TO TEST-CHECK. SG2014.2 +057700 PERFORM 47. SG2014.2 +057800 PERFORM 47. SG2014.2 +057900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +058000 PERFORM PASS SG2014.2 +058100 GO TO SEG-WRITE-19. SG2014.2 +058200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +058300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +058400 PERFORM FAIL. SG2014.2 +058500 GO TO SEG-WRITE-19. SG2014.2 +058600 SEG-DELETE-19. SG2014.2 +058700 PERFORM DE-LETE. SG2014.2 +058800 SEG-WRITE-19. SG2014.2 +058900 MOVE "SEG-TEST-19 " TO PAR-NAME. SG2014.2 +059000 PERFORM PRINT-DETAIL. SG2014.2 +059100 SEG-TEST-20. SG2014.2 +059200 MOVE SPACE TO TEST-CHECK. SG2014.2 +059300 PERFORM 48. SG2014.2 +059400 PERFORM 48. SG2014.2 +059500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +059600 PERFORM PASS SG2014.2 +059700 GO TO SEG-WRITE-20. SG2014.2 +059800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +059900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +060000 PERFORM FAIL. SG2014.2 +060100 GO TO SEG-WRITE-20. SG2014.2 +060200 SEG-DELETE-20. SG2014.2 +060300 PERFORM DE-LETE. SG2014.2 +060400 SEG-WRITE-20. SG2014.2 +060500 MOVE "SEG-TEST-20 " TO PAR-NAME. SG2014.2 +060600 PERFORM PRINT-DETAIL. SG2014.2 +060700 SEG-TEST-21. SG2014.2 +060800 MOVE SPACE TO TEST-CHECK. SG2014.2 +060900 PERFORM 49. SG2014.2 +061000 PERFORM 49. SG2014.2 +061100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +061200 PERFORM PASS SG2014.2 +061300 GO TO SEG-WRITE-21. SG2014.2 +061400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +061500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +061600 PERFORM FAIL. SG2014.2 +061700 GO TO SEG-WRITE-21. SG2014.2 +061800 SEG-DELETE-21. SG2014.2 +061900 PERFORM DE-LETE. SG2014.2 +062000 SEG-WRITE-21. SG2014.2 +062100 MOVE "SEG-TEST-21 " TO PAR-NAME. SG2014.2 +062200 PERFORM PRINT-DETAIL. SG2014.2 +062300 SEG-TEST-22. SG2014.2 +062400 MOVE SPACE TO TEST-CHECK. SG2014.2 +062500 PERFORM 50. SG2014.2 +062600 MOVE SPACE TO TEST-CHECK. SG2014.2 +062700 PERFORM 50. SG2014.2 +062800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +062900 PERFORM PASS SG2014.2 +063000 GO TO SEG-WRITE-22. SG2014.2 +063100 MOVE SPACE TO COMPUTED-A. SG2014.2 +063200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +063300 PERFORM FAIL. SG2014.2 +063400 GO TO SEG-WRITE-22. SG2014.2 +063500 SEG-DELETE-22. SG2014.2 +063600 PERFORM DE-LETE. SG2014.2 +063700 SEG-WRITE-22. SG2014.2 +063800 MOVE "SEG-TEST-22 " TO PAR-NAME. SG2014.2 +063900 PERFORM PRINT-DETAIL. SG2014.2 +064000 SEG-TEST-23. SG2014.2 +064100 MOVE SPACE TO TEST-CHECK. SG2014.2 +064200 PERFORM 51. SG2014.2 +064300 MOVE SPACE TO TEST-CHECK. SG2014.2 +064400 PERFORM 51. SG2014.2 +064500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +064600 PERFORM PASS SG2014.2 +064700 GO TO SEG-WRITE-23. SG2014.2 +064800 MOVE SPACE TO COMPUTED-A. SG2014.2 +064900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +065000 PERFORM FAIL. SG2014.2 +065100 GO TO SEG-WRITE-23. SG2014.2 +065200 SEG-DELETE-23. SG2014.2 +065300 PERFORM DE-LETE. SG2014.2 +065400 SEG-WRITE-23. SG2014.2 +065500 MOVE "SEG-TEST-23 " TO PAR-NAME. SG2014.2 +065600 PERFORM PRINT-DETAIL. SG2014.2 +065700 SEG-TEST-24. SG2014.2 +065800 MOVE SPACE TO TEST-CHECK. SG2014.2 +065900 PERFORM 52. SG2014.2 +066000 MOVE SPACE TO TEST-CHECK. SG2014.2 +066100 PERFORM 52. SG2014.2 +066200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +066300 PERFORM PASS SG2014.2 +066400 GO TO SEG-WRITE-24. SG2014.2 +066500 MOVE SPACE TO COMPUTED-A. SG2014.2 +066600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +066700 PERFORM FAIL. SG2014.2 +066800 GO TO SEG-WRITE-24. SG2014.2 +066900 SEG-DELETE-24. SG2014.2 +067000 PERFORM DE-LETE. SG2014.2 +067100 SEG-WRITE-24. SG2014.2 +067200 MOVE "SEG-TEST-24 " TO PAR-NAME. SG2014.2 +067300 PERFORM PRINT-DETAIL. SG2014.2 +067400 SEG-TEST-25. SG2014.2 +067500 MOVE SPACE TO TEST-CHECK. SG2014.2 +067600 PERFORM 53. SG2014.2 +067700 MOVE SPACE TO TEST-CHECK. SG2014.2 +067800 PERFORM 53. SG2014.2 +067900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +068000 PERFORM PASS SG2014.2 +068100 GO TO SEG-WRITE-25. SG2014.2 +068200 MOVE SPACE TO COMPUTED-A. SG2014.2 +068300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +068400 PERFORM FAIL. SG2014.2 +068500 GO TO SEG-WRITE-25. SG2014.2 +068600 SEG-DELETE-25. SG2014.2 +068700 PERFORM DE-LETE. SG2014.2 +068800 SEG-WRITE-25. SG2014.2 +068900 MOVE "SEG-TEST-25 " TO PAR-NAME. SG2014.2 +069000 PERFORM PRINT-DETAIL. SG2014.2 +069100 SEG-TEST-26. SG2014.2 +069200 MOVE SPACE TO TEST-CHECK. SG2014.2 +069300 PERFORM 54. SG2014.2 +069400 MOVE SPACE TO TEST-CHECK. SG2014.2 +069500 PERFORM 54. SG2014.2 +069600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +069700 PERFORM PASS SG2014.2 +069800 GO TO SEG-WRITE-26. SG2014.2 +069900 MOVE SPACE TO COMPUTED-A. SG2014.2 +070000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +070100 PERFORM FAIL. SG2014.2 +070200 GO TO SEG-WRITE-26. SG2014.2 +070300 SEG-DELETE-26. SG2014.2 +070400 PERFORM DE-LETE. SG2014.2 +070500 SEG-WRITE-26. SG2014.2 +070600 MOVE "SEG-TEST-26 " TO PAR-NAME. SG2014.2 +070700 PERFORM PRINT-DETAIL. SG2014.2 +070800 SEG-TEST-27. SG2014.2 +070900 MOVE SPACE TO TEST-CHECK. SG2014.2 +071000 PERFORM 55. SG2014.2 +071100 MOVE SPACE TO TEST-CHECK. SG2014.2 +071200 PERFORM 55. SG2014.2 +071300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +071400 PERFORM PASS SG2014.2 +071500 GO TO SEG-WRITE-27. SG2014.2 +071600 MOVE SPACE TO COMPUTED-A. SG2014.2 +071700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +071800 PERFORM FAIL. SG2014.2 +071900 GO TO SEG-WRITE-27. SG2014.2 +072000 SEG-DELETE-27. SG2014.2 +072100 PERFORM DE-LETE. SG2014.2 +072200 SEG-WRITE-27. SG2014.2 +072300 MOVE "SEG-TEST-27 " TO PAR-NAME. SG2014.2 +072400 PERFORM PRINT-DETAIL. SG2014.2 +072500 SEG-TEST-28. SG2014.2 +072600 MOVE SPACE TO TEST-CHECK. SG2014.2 +072700 PERFORM 56. SG2014.2 +072800 MOVE SPACE TO TEST-CHECK. SG2014.2 +072900 PERFORM 56. SG2014.2 +073000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +073100 PERFORM PASS SG2014.2 +073200 GO TO SEG-WRITE-28. SG2014.2 +073300 MOVE SPACE TO COMPUTED-A. SG2014.2 +073400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +073500 PERFORM FAIL. SG2014.2 +073600 GO TO SEG-WRITE-28. SG2014.2 +073700 SEG-DELETE-28. SG2014.2 +073800 PERFORM DE-LETE. SG2014.2 +073900 SEG-WRITE-28. SG2014.2 +074000 MOVE "SEG-TEST-28 " TO PAR-NAME. SG2014.2 +074100 PERFORM PRINT-DETAIL. SG2014.2 +074200 SEG-TEST-29. SG2014.2 +074300 MOVE SPACE TO TEST-CHECK. SG2014.2 +074400 PERFORM 57. SG2014.2 +074500 MOVE SPACE TO TEST-CHECK. SG2014.2 +074600 PERFORM 57. SG2014.2 +074700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +074800 PERFORM PASS SG2014.2 +074900 GO TO SEG-WRITE-29. SG2014.2 +075000 MOVE SPACE TO COMPUTED-A. SG2014.2 +075100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +075200 PERFORM FAIL. SG2014.2 +075300 GO TO SEG-WRITE-29. SG2014.2 +075400 SEG-DELETE-29. SG2014.2 +075500 PERFORM DE-LETE. SG2014.2 +075600 SEG-WRITE-29. SG2014.2 +075700 MOVE "SEG-TEST-29 " TO PAR-NAME. SG2014.2 +075800 PERFORM PRINT-DETAIL. SG2014.2 +075900 SEG-TEST-30. SG2014.2 +076000 MOVE SPACE TO TEST-CHECK. SG2014.2 +076100 PERFORM 58. SG2014.2 +076200 MOVE SPACE TO TEST-CHECK. SG2014.2 +076300 PERFORM 58. SG2014.2 +076400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +076500 PERFORM PASS SG2014.2 +076600 GO TO SEG-WRITE-30. SG2014.2 +076700 MOVE SPACE TO COMPUTED-A. SG2014.2 +076800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +076900 PERFORM FAIL. SG2014.2 +077000 GO TO SEG-WRITE-30. SG2014.2 +077100 SEG-DELETE-30. SG2014.2 +077200 PERFORM DE-LETE. SG2014.2 +077300 SEG-WRITE-30. SG2014.2 +077400 MOVE "SEG-TEST-30 " TO PAR-NAME. SG2014.2 +077500 PERFORM PRINT-DETAIL. SG2014.2 +077600 SEG-TEST-31. SG2014.2 +077700 MOVE SPACE TO TEST-CHECK. SG2014.2 +077800 PERFORM 59. SG2014.2 +077900 MOVE SPACE TO TEST-CHECK. SG2014.2 +078000 PERFORM 59. SG2014.2 +078100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +078200 PERFORM PASS SG2014.2 +078300 GO TO SEG-WRITE-31. SG2014.2 +078400 MOVE SPACE TO COMPUTED-A. SG2014.2 +078500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +078600 PERFORM FAIL. SG2014.2 +078700 GO TO SEG-WRITE-31. SG2014.2 +078800 SEG-DELETE-31. SG2014.2 +078900 PERFORM DE-LETE. SG2014.2 +079000 SEG-WRITE-31. SG2014.2 +079100 MOVE "SEG-TEST-31 " TO PAR-NAME. SG2014.2 +079200 PERFORM PRINT-DETAIL. SG2014.2 +079300 SEG-TEST-32. SG2014.2 +079400 MOVE SPACE TO TEST-CHECK. SG2014.2 +079500 PERFORM 60. SG2014.2 +079600 MOVE SPACE TO TEST-CHECK. SG2014.2 +079700 PERFORM 60. SG2014.2 +079800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +079900 PERFORM PASS SG2014.2 +080000 GO TO SEG-WRITE-32. SG2014.2 +080100 MOVE SPACE TO COMPUTED-A. SG2014.2 +080200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +080300 PERFORM FAIL. SG2014.2 +080400 GO TO SEG-WRITE-32. SG2014.2 +080500 SEG-DELETE-32. SG2014.2 +080600 PERFORM DE-LETE. SG2014.2 +080700 SEG-WRITE-32. SG2014.2 +080800 MOVE "SEG-TEST-32 " TO PAR-NAME. SG2014.2 +080900 PERFORM PRINT-DETAIL. SG2014.2 +081000 SEG-TEST-33. SG2014.2 +081100 MOVE SPACE TO TEST-CHECK. SG2014.2 +081200 PERFORM 60. SG2014.2 +081300 MOVE SPACE TO TEST-CHECK. SG2014.2 +081400 PERFORM 60. SG2014.2 +081500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +081600 PERFORM PASS SG2014.2 +081700 GO TO SEG-WRITE-33. SG2014.2 +081800 MOVE SPACE TO COMPUTED-A. SG2014.2 +081900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +082000 PERFORM FAIL. SG2014.2 +082100 GO TO SEG-WRITE-33. SG2014.2 +082200 SEG-DELETE-33. SG2014.2 +082300 PERFORM DE-LETE. SG2014.2 +082400 SEG-WRITE-33. SG2014.2 +082500 MOVE "SEG-TEST-33 " TO PAR-NAME. SG2014.2 +082600 PERFORM PRINT-DETAIL. SG2014.2 +082700 SEG-TEST-34. SG2014.2 +082800 MOVE SPACE TO TEST-CHECK. SG2014.2 +082900 PERFORM 59. SG2014.2 +083000 MOVE SPACE TO TEST-CHECK. SG2014.2 +083100 PERFORM 59. SG2014.2 +083200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +083300 PERFORM PASS SG2014.2 +083400 GO TO SEG-WRITE-34. SG2014.2 +083500 MOVE SPACE TO COMPUTED-A. SG2014.2 +083600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +083700 PERFORM FAIL. SG2014.2 +083800 GO TO SEG-WRITE-34. SG2014.2 +083900 SEG-DELETE-34. SG2014.2 +084000 PERFORM DE-LETE. SG2014.2 +084100 SEG-WRITE-34. SG2014.2 +084200 MOVE "SEG-TEST-34 " TO PAR-NAME. SG2014.2 +084300 PERFORM PRINT-DETAIL. SG2014.2 +084400 SEG-TEST-35. SG2014.2 +084500 MOVE SPACE TO TEST-CHECK. SG2014.2 +084600 PERFORM 58. SG2014.2 +084700 MOVE SPACE TO TEST-CHECK. SG2014.2 +084800 PERFORM 58. SG2014.2 +084900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +085000 PERFORM PASS SG2014.2 +085100 GO TO SEG-WRITE-35. SG2014.2 +085200 MOVE SPACE TO COMPUTED-A. SG2014.2 +085300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +085400 PERFORM FAIL. SG2014.2 +085500 GO TO SEG-WRITE-35. SG2014.2 +085600 SEG-DELETE-35. SG2014.2 +085700 PERFORM DE-LETE. SG2014.2 +085800 SEG-WRITE-35. SG2014.2 +085900 MOVE "SEG-TEST-35 " TO PAR-NAME. SG2014.2 +086000 PERFORM PRINT-DETAIL. SG2014.2 +086100 SEG-TEST-36. SG2014.2 +086200 MOVE SPACE TO TEST-CHECK. SG2014.2 +086300 PERFORM 57. SG2014.2 +086400 MOVE SPACE TO TEST-CHECK. SG2014.2 +086500 PERFORM 57. SG2014.2 +086600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +086700 PERFORM PASS SG2014.2 +086800 GO TO SEG-WRITE-36. SG2014.2 +086900 MOVE SPACE TO COMPUTED-A. SG2014.2 +087000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +087100 PERFORM FAIL. SG2014.2 +087200 GO TO SEG-WRITE-36. SG2014.2 +087300 SEG-DELETE-36. SG2014.2 +087400 PERFORM DE-LETE. SG2014.2 +087500 SEG-WRITE-36. SG2014.2 +087600 MOVE "SEG-TEST-36 " TO PAR-NAME. SG2014.2 +087700 PERFORM PRINT-DETAIL. SG2014.2 +087800 SEG-TEST-37. SG2014.2 +087900 MOVE SPACE TO TEST-CHECK. SG2014.2 +088000 PERFORM 56. SG2014.2 +088100 MOVE SPACE TO TEST-CHECK. SG2014.2 +088200 PERFORM 56. SG2014.2 +088300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +088400 PERFORM PASS SG2014.2 +088500 GO TO SEG-WRITE-37. SG2014.2 +088600 MOVE SPACE TO COMPUTED-A. SG2014.2 +088700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +088800 PERFORM FAIL. SG2014.2 +088900 GO TO SEG-WRITE-37. SG2014.2 +089000 SEG-DELETE-37. SG2014.2 +089100 PERFORM DE-LETE. SG2014.2 +089200 SEG-WRITE-37. SG2014.2 +089300 MOVE "SEG-TEST-37 " TO PAR-NAME. SG2014.2 +089400 PERFORM PRINT-DETAIL. SG2014.2 +089500 SEG-TEST-38. SG2014.2 +089600 MOVE SPACE TO TEST-CHECK. SG2014.2 +089700 PERFORM 55. SG2014.2 +089800 MOVE SPACE TO TEST-CHECK. SG2014.2 +089900 PERFORM 55. SG2014.2 +090000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +090100 PERFORM PASS SG2014.2 +090200 GO TO SEG-WRITE-38. SG2014.2 +090300 MOVE SPACE TO COMPUTED-A. SG2014.2 +090400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +090500 GO TO SEG-WRITE-38. SG2014.2 +090600 SEG-DELETE-38. SG2014.2 +090700 PERFORM DE-LETE. SG2014.2 +090800 SEG-WRITE-38. SG2014.2 +090900 MOVE "SEG-TEST-38 " TO PAR-NAME. SG2014.2 +091000 PERFORM PRINT-DETAIL. SG2014.2 +091100 SEG-TEST-39. SG2014.2 +091200 MOVE SPACE TO TEST-CHECK. SG2014.2 +091300 PERFORM 54. SG2014.2 +091400 MOVE SPACE TO TEST-CHECK. SG2014.2 +091500 PERFORM 54. SG2014.2 +091600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +091700 PERFORM PASS SG2014.2 +091800 GO TO SEG-WRITE-39. SG2014.2 +091900 MOVE SPACE TO COMPUTED-A. SG2014.2 +092000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +092100 PERFORM FAIL. SG2014.2 +092200 GO TO SEG-WRITE-39. SG2014.2 +092300 SEG-DELETE-39. SG2014.2 +092400 PERFORM DE-LETE. SG2014.2 +092500 SEG-WRITE-39. SG2014.2 +092600 MOVE "SEG-TEST-39 " TO PAR-NAME. SG2014.2 +092700 PERFORM PRINT-DETAIL. SG2014.2 +092800 SEG-TEST-40. SG2014.2 +092900 MOVE SPACE TO TEST-CHECK. SG2014.2 +093000 PERFORM 53. SG2014.2 +093100 MOVE SPACE TO TEST-CHECK. SG2014.2 +093200 PERFORM 53. SG2014.2 +093300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +093400 PERFORM PASS SG2014.2 +093500 GO TO SEG-WRITE-40. SG2014.2 +093600 MOVE SPACE TO COMPUTED-A. SG2014.2 +093700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +093800 PERFORM FAIL. SG2014.2 +093900 GO TO SEG-WRITE-40. SG2014.2 +094000 SEG-DELETE-40. SG2014.2 +094100 PERFORM DE-LETE. SG2014.2 +094200 SEG-WRITE-40. SG2014.2 +094300 MOVE "SEG-TEST-40 " TO PAR-NAME. SG2014.2 +094400 PERFORM PRINT-DETAIL. SG2014.2 +094500 SEG-TEST-41. SG2014.2 +094600 MOVE SPACE TO TEST-CHECK. SG2014.2 +094700 PERFORM 52. SG2014.2 +094800 MOVE SPACE TO TEST-CHECK. SG2014.2 +094900 PERFORM 52. SG2014.2 +095000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +095100 PERFORM PASS SG2014.2 +095200 GO TO SEG-WRITE-41. SG2014.2 +095300 MOVE SPACE TO COMPUTED-A. SG2014.2 +095400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +095500 PERFORM FAIL. SG2014.2 +095600 GO TO SEG-WRITE-41. SG2014.2 +095700 SEG-DELETE-41. SG2014.2 +095800 PERFORM DE-LETE. SG2014.2 +095900 SEG-WRITE-41. SG2014.2 +096000 MOVE "SEG-TEST-41 " TO PAR-NAME. SG2014.2 +096100 PERFORM PRINT-DETAIL. SG2014.2 +096200 SEG-TEST-42. SG2014.2 +096300 MOVE SPACE TO TEST-CHECK. SG2014.2 +096400 PERFORM 51. SG2014.2 +096500 MOVE SPACE TO TEST-CHECK. SG2014.2 +096600 PERFORM 51. SG2014.2 +096700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +096800 PERFORM PASS SG2014.2 +096900 GO TO SEG-WRITE-42. SG2014.2 +097000 MOVE SPACE TO COMPUTED-A. SG2014.2 +097100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +097200 PERFORM FAIL. SG2014.2 +097300 GO TO SEG-WRITE-42. SG2014.2 +097400 SEG-DELETE-42. SG2014.2 +097500 PERFORM DE-LETE. SG2014.2 +097600 SEG-WRITE-42. SG2014.2 +097700 MOVE "SEG-TEST-42 " TO PAR-NAME. SG2014.2 +097800 PERFORM PRINT-DETAIL. SG2014.2 +097900 SEG-TEST-43. SG2014.2 +098000 MOVE SPACE TO TEST-CHECK. SG2014.2 +098100 PERFORM 50. SG2014.2 +098200 MOVE SPACE TO TEST-CHECK. SG2014.2 +098300 PERFORM 50. SG2014.2 +098400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +098500 PERFORM PASS SG2014.2 +098600 GO TO SEG-WRITE-43. SG2014.2 +098700 MOVE SPACE TO COMPUTED-A. SG2014.2 +098800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +098900 PERFORM FAIL. SG2014.2 +099000 GO TO SEG-WRITE-43. SG2014.2 +099100 SEG-DELETE-43. SG2014.2 +099200 PERFORM DE-LETE. SG2014.2 +099300 SEG-WRITE-43. SG2014.2 +099400 MOVE "SEG-TEST-43 " TO PAR-NAME. SG2014.2 +099500 PERFORM PRINT-DETAIL. SG2014.2 +099600 SEG-TEST-44. SG2014.2 +099700 MOVE SPACE TO TEST-CHECK. SG2014.2 +099800 PERFORM 49. SG2014.2 +099900 MOVE SPACE TO TEST-CHECK. SG2014.2 +100000 PERFORM 49. SG2014.2 +100100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +100200 PERFORM PASS SG2014.2 +100300 GO TO SEG-WRITE-44. SG2014.2 +100400 MOVE SPACE TO COMPUTED-A. SG2014.2 +100500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +100600 PERFORM FAIL. SG2014.2 +100700 GO TO SEG-WRITE-44. SG2014.2 +100800 SEG-DELETE-44. SG2014.2 +100900 PERFORM DE-LETE. SG2014.2 +101000 SEG-WRITE-44. SG2014.2 +101100 MOVE "SEG-TEST-44 " TO PAR-NAME. SG2014.2 +101200 PERFORM PRINT-DETAIL. SG2014.2 +101300 SEG-TEST-45. SG2014.2 +101400 MOVE SPACE TO TEST-CHECK. SG2014.2 +101500 PERFORM 48. SG2014.2 +101600 MOVE SPACE TO TEST-CHECK. SG2014.2 +101700 PERFORM 48. SG2014.2 +101800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +101900 PERFORM PASS SG2014.2 +102000 GO TO SEG-WRITE-45. SG2014.2 +102100 MOVE SPACE TO COMPUTED-A. SG2014.2 +102200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +102300 PERFORM FAIL. SG2014.2 +102400 GO TO SEG-WRITE-45. SG2014.2 +102500 SEG-DELETE-45. SG2014.2 +102600 PERFORM DE-LETE. SG2014.2 +102700 SEG-WRITE-45. SG2014.2 +102800 MOVE "SEG-TEST-45 " TO PAR-NAME. SG2014.2 +102900 PERFORM PRINT-DETAIL. SG2014.2 +103000 SEG-TEST-46. SG2014.2 +103100 MOVE SPACE TO TEST-CHECK. SG2014.2 +103200 PERFORM 47. SG2014.2 +103300 MOVE SPACE TO TEST-CHECK. SG2014.2 +103400 PERFORM 47. SG2014.2 +103500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +103600 PERFORM PASS SG2014.2 +103700 GO TO SEG-WRITE-46. SG2014.2 +103800 MOVE SPACE TO COMPUTED-A. SG2014.2 +103900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +104000 PERFORM FAIL. SG2014.2 +104100 GO TO SEG-WRITE-46. SG2014.2 +104200 SEG-DELETE-46. SG2014.2 +104300 PERFORM DE-LETE. SG2014.2 +104400 SEG-WRITE-46. SG2014.2 +104500 MOVE "SEG-TEST-46 " TO PAR-NAME. SG2014.2 +104600 PERFORM PRINT-DETAIL. SG2014.2 +104700 SEG-TEST-47. SG2014.2 +104800 MOVE SPACE TO TEST-CHECK. SG2014.2 +104900 PERFORM 46. SG2014.2 +105000 MOVE SPACE TO TEST-CHECK. SG2014.2 +105100 PERFORM 46. SG2014.2 +105200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +105300 PERFORM PASS SG2014.2 +105400 GO TO SEG-WRITE-47. SG2014.2 +105500 MOVE SPACE TO COMPUTED-A. SG2014.2 +105600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +105700 PERFORM FAIL. SG2014.2 +105800 GO TO SEG-WRITE-47. SG2014.2 +105900 SEG-DELETE-47. SG2014.2 +106000 PERFORM DE-LETE. SG2014.2 +106100 SEG-WRITE-47. SG2014.2 +106200 MOVE "SEG-TEST-47 " TO PAR-NAME. SG2014.2 +106300 PERFORM PRINT-DETAIL. SG2014.2 +106400 SEG-TEST-48. SG2014.2 +106500 MOVE SPACE TO TEST-CHECK. SG2014.2 +106600 PERFORM 45. SG2014.2 +106700 MOVE SPACE TO TEST-CHECK. SG2014.2 +106800 PERFORM 45. SG2014.2 +106900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +107000 PERFORM PASS SG2014.2 +107100 GO TO SEG-WRITE-48. SG2014.2 +107200 MOVE SPACE TO COMPUTED-A. SG2014.2 +107300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +107400 PERFORM FAIL. SG2014.2 +107500 GO TO SEG-WRITE-48. SG2014.2 +107600 SEG-DELETE-48. SG2014.2 +107700 PERFORM DE-LETE. SG2014.2 +107800 SEG-WRITE-48. SG2014.2 +107900 MOVE "SEG-TEST-48 " TO PAR-NAME. SG2014.2 +108000 PERFORM PRINT-DETAIL. SG2014.2 +108100 SEG-TEST-49. SG2014.2 +108200 MOVE SPACE TO TEST-CHECK. SG2014.2 +108300 PERFORM 44. SG2014.2 +108400 MOVE SPACE TO TEST-CHECK. SG2014.2 +108500 PERFORM 44. SG2014.2 +108600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +108700 PERFORM PASS SG2014.2 +108800 GO TO SEG-WRITE-49. SG2014.2 +108900 MOVE SPACE TO COMPUTED-A. SG2014.2 +109000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +109100 PERFORM FAIL. SG2014.2 +109200 GO TO SEG-WRITE-49. SG2014.2 +109300 SEG-DELETE-49. SG2014.2 +109400 PERFORM DE-LETE. SG2014.2 +109500 SEG-WRITE-49. SG2014.2 +109600 MOVE "SEG-TEST-49 " TO PAR-NAME. SG2014.2 +109700 PERFORM PRINT-DETAIL. SG2014.2 +109800 SEG-TEST-50. SG2014.2 +109900 MOVE SPACE TO TEST-CHECK. SG2014.2 +110000 PERFORM 43. SG2014.2 +110100 MOVE SPACE TO TEST-CHECK. SG2014.2 +110200 PERFORM 43. SG2014.2 +110300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +110400 PERFORM PASS SG2014.2 +110500 GO TO SEG-WRITE-50. SG2014.2 +110600 MOVE SPACE TO COMPUTED-A. SG2014.2 +110700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +110800 PERFORM FAIL. SG2014.2 +110900 GO TO SEG-WRITE-50. SG2014.2 +111000 SEG-DELETE-50. SG2014.2 +111100 PERFORM DE-LETE. SG2014.2 +111200 SEG-WRITE-50. SG2014.2 +111300 MOVE "SEG-TEST-50 " TO PAR-NAME. SG2014.2 +111400 PERFORM PRINT-DETAIL. SG2014.2 +111500 SEG-TEST-51. SG2014.2 +111600 MOVE SPACE TO TEST-CHECK. SG2014.2 +111700 PERFORM 42. SG2014.2 +111800 MOVE SPACE TO TEST-CHECK. SG2014.2 +111900 PERFORM 42. SG2014.2 +112000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +112100 PERFORM PASS SG2014.2 +112200 GO TO SEG-WRITE-51. SG2014.2 +112300 MOVE SPACE TO COMPUTED-A. SG2014.2 +112400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +112500 PERFORM FAIL. SG2014.2 +112600 GO TO SEG-WRITE-51. SG2014.2 +112700 SEG-DELETE-51. SG2014.2 +112800 PERFORM DE-LETE. SG2014.2 +112900 SEG-WRITE-51. SG2014.2 +113000 MOVE "SEG-TEST-51 " TO PAR-NAME. SG2014.2 +113100 PERFORM PRINT-DETAIL. SG2014.2 +113200 SEG-TEST-52. SG2014.2 +113300 MOVE SPACE TO TEST-CHECK. SG2014.2 +113400 PERFORM 41. SG2014.2 +113500 MOVE SPACE TO TEST-CHECK. SG2014.2 +113600 PERFORM 41. SG2014.2 +113700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +113800 PERFORM PASS SG2014.2 +113900 GO TO SEG-WRITE-52. SG2014.2 +114000 MOVE SPACE TO COMPUTED-A. SG2014.2 +114100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +114200 PERFORM FAIL. SG2014.2 +114300 GO TO SEG-WRITE-52. SG2014.2 +114400 SEG-DELETE-52. SG2014.2 +114500 PERFORM DE-LETE. SG2014.2 +114600 SEG-WRITE-52. SG2014.2 +114700 MOVE "SEG-TEST-52 " TO PAR-NAME. SG2014.2 +114800 PERFORM PRINT-DETAIL. SG2014.2 +114900 SEG-TEST-53. SG2014.2 +115000 MOVE SPACE TO TEST-CHECK. SG2014.2 +115100 PERFORM 40. SG2014.2 +115200 MOVE SPACE TO TEST-CHECK. SG2014.2 +115300 PERFORM 40. SG2014.2 +115400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +115500 PERFORM PASS SG2014.2 +115600 GO TO SEG-WRITE-53. SG2014.2 +115700 MOVE SPACE TO COMPUTED-A. SG2014.2 +115800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +115900 PERFORM FAIL. SG2014.2 +116000 GO TO SEG-WRITE-53. SG2014.2 +116100 SEG-DELETE-53. SG2014.2 +116200 PERFORM DE-LETE. SG2014.2 +116300 SEG-WRITE-53. SG2014.2 +116400 MOVE "SEG-TEST-53 " TO PAR-NAME. SG2014.2 +116500 PERFORM PRINT-DETAIL. SG2014.2 +116600 SEG-TEST-54. SG2014.2 +116700 MOVE SPACE TO TEST-CHECK. SG2014.2 +116800 PERFORM 39. SG2014.2 +116900 MOVE SPACE TO TEST-CHECK. SG2014.2 +117000 PERFORM 39. SG2014.2 +117100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +117200 PERFORM PASS SG2014.2 +117300 GO TO SEG-WRITE-54. SG2014.2 +117400 MOVE SPACE TO COMPUTED-A. SG2014.2 +117500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +117600 PERFORM FAIL. SG2014.2 +117700 GO TO SEG-WRITE-54. SG2014.2 +117800 SEG-DELETE-54. SG2014.2 +117900 PERFORM DE-LETE. SG2014.2 +118000 SEG-WRITE-54. SG2014.2 +118100 MOVE "SEG-TEST-54 " TO PAR-NAME. SG2014.2 +118200 PERFORM PRINT-DETAIL. SG2014.2 +118300 SEG-TEST-55. SG2014.2 +118400 MOVE SPACE TO TEST-CHECK. SG2014.2 +118500 PERFORM 38. SG2014.2 +118600 MOVE SPACE TO TEST-CHECK. SG2014.2 +118700 PERFORM 38. SG2014.2 +118800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +118900 PERFORM PASS SG2014.2 +119000 GO TO SEG-WRITE-55. SG2014.2 +119100 MOVE SPACE TO COMPUTED-A. SG2014.2 +119200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +119300 PERFORM FAIL. SG2014.2 +119400 GO TO SEG-WRITE-55. SG2014.2 +119500 SEG-DELETE-55. SG2014.2 +119600 PERFORM DE-LETE. SG2014.2 +119700 SEG-WRITE-55. SG2014.2 +119800 MOVE "SEG-TEST-55 " TO PAR-NAME. SG2014.2 +119900 PERFORM PRINT-DETAIL. SG2014.2 +120000 SEG-TEST-56. SG2014.2 +120100 MOVE SPACE TO TEST-CHECK. SG2014.2 +120200 PERFORM 37. SG2014.2 +120300 MOVE SPACE TO TEST-CHECK. SG2014.2 +120400 PERFORM 37. SG2014.2 +120500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +120600 PERFORM PASS SG2014.2 +120700 GO TO SEG-WRITE-56. SG2014.2 +120800 MOVE SPACE TO COMPUTED-A. SG2014.2 +120900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +121000 PERFORM FAIL. SG2014.2 +121100 GO TO SEG-WRITE-56. SG2014.2 +121200 SEG-DELETE-56. SG2014.2 +121300 PERFORM DE-LETE. SG2014.2 +121400 SEG-WRITE-56. SG2014.2 +121500 MOVE "SEG-TEST-56 " TO PAR-NAME. SG2014.2 +121600 PERFORM PRINT-DETAIL. SG2014.2 +121700 SEG-TEST-57. SG2014.2 +121800 MOVE SPACE TO TEST-CHECK. SG2014.2 +121900 PERFORM 36. SG2014.2 +122000 MOVE SPACE TO TEST-CHECK. SG2014.2 +122100 PERFORM 36. SG2014.2 +122200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +122300 PERFORM PASS SG2014.2 +122400 GO TO SEG-WRITE-57. SG2014.2 +122500 MOVE SPACE TO COMPUTED-A. SG2014.2 +122600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +122700 PERFORM FAIL. SG2014.2 +122800 GO TO SEG-WRITE-57. SG2014.2 +122900 SEG-DELETE-57. SG2014.2 +123000 PERFORM DE-LETE. SG2014.2 +123100 SEG-WRITE-57. SG2014.2 +123200 MOVE "SEG-TEST-57 " TO PAR-NAME. SG2014.2 +123300 PERFORM PRINT-DETAIL. SG2014.2 +123400 SEG-TEST-58. SG2014.2 +123500 MOVE SPACE TO TEST-CHECK. SG2014.2 +123600 PERFORM 35. SG2014.2 +123700 MOVE SPACE TO TEST-CHECK. SG2014.2 +123800 PERFORM 35. SG2014.2 +123900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +124000 PERFORM PASS SG2014.2 +124100 GO TO SEG-WRITE-58. SG2014.2 +124200 MOVE SPACE TO COMPUTED-A. SG2014.2 +124300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +124400 PERFORM FAIL. SG2014.2 +124500 GO TO SEG-WRITE-58. SG2014.2 +124600 SEG-DELETE-58. SG2014.2 +124700 PERFORM DE-LETE. SG2014.2 +124800 SEG-WRITE-58. SG2014.2 +124900 MOVE "SEG-TEST-58 " TO PAR-NAME. SG2014.2 +125000 PERFORM PRINT-DETAIL. SG2014.2 +125100 SEG-TEST-59. SG2014.2 +125200 MOVE SPACE TO TEST-CHECK. SG2014.2 +125300 PERFORM 34. SG2014.2 +125400 MOVE SPACE TO TEST-CHECK. SG2014.2 +125500 PERFORM 34. SG2014.2 +125600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +125700 PERFORM PASS SG2014.2 +125800 GO TO SEG-WRITE-59. SG2014.2 +125900 MOVE SPACE TO COMPUTED-A. SG2014.2 +126000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +126100 PERFORM FAIL. SG2014.2 +126200 GO TO SEG-WRITE-59. SG2014.2 +126300 SEG-DELETE-59. SG2014.2 +126400 PERFORM DE-LETE. SG2014.2 +126500 SEG-WRITE-59. SG2014.2 +126600 MOVE "SEG-TEST-59 " TO PAR-NAME. SG2014.2 +126700 PERFORM PRINT-DETAIL. SG2014.2 +126800 SEG-TEST-60. SG2014.2 +126900 MOVE SPACE TO TEST-CHECK. SG2014.2 +127000 PERFORM 33. SG2014.2 +127100 MOVE SPACE TO TEST-CHECK. SG2014.2 +127200 PERFORM 33. SG2014.2 +127300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +127400 PERFORM PASS SG2014.2 +127500 GO TO SEG-WRITE-60. SG2014.2 +127600 MOVE SPACE TO COMPUTED-A. SG2014.2 +127700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +127800 PERFORM FAIL. SG2014.2 +127900 GO TO SEG-WRITE-60. SG2014.2 +128000 SEG-DELETE-60. SG2014.2 +128100 PERFORM DE-LETE. SG2014.2 +128200 SEG-WRITE-60. SG2014.2 +128300 MOVE "SEG-TEST-60 " TO PAR-NAME. SG2014.2 +128400 PERFORM PRINT-DETAIL. SG2014.2 +128500 SEG-TEST-61. SG2014.2 +128600 MOVE SPACE TO TEST-CHECK. SG2014.2 +128700 PERFORM 32. SG2014.2 +128800 MOVE SPACE TO TEST-CHECK. SG2014.2 +128900 PERFORM 32. SG2014.2 +129000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +129100 PERFORM PASS SG2014.2 +129200 GO TO SEG-WRITE-61. SG2014.2 +129300 MOVE SPACE TO COMPUTED-A. SG2014.2 +129400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +129500 PERFORM FAIL. SG2014.2 +129600 GO TO SEG-WRITE-61. SG2014.2 +129700 SEG-DELETE-61. SG2014.2 +129800 PERFORM DE-LETE. SG2014.2 +129900 SEG-WRITE-61. SG2014.2 +130000 MOVE "SEG-TEST-61 " TO PAR-NAME. SG2014.2 +130100 PERFORM PRINT-DETAIL. SG2014.2 +130200 SEG-TEST-62. SG2014.2 +130300 MOVE SPACE TO TEST-CHECK. SG2014.2 +130400 PERFORM 31. SG2014.2 +130500 MOVE SPACE TO TEST-CHECK. SG2014.2 +130600 PERFORM 31. SG2014.2 +130700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +130800 PERFORM PASS SG2014.2 +130900 GO TO SEG-WRITE-62. SG2014.2 +131000 MOVE SPACE TO COMPUTED-A. SG2014.2 +131100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +131200 PERFORM FAIL. SG2014.2 +131300 GO TO SEG-WRITE-62. SG2014.2 +131400 SEG-DELETE-62. SG2014.2 +131500 PERFORM DE-LETE. SG2014.2 +131600 SEG-WRITE-62. SG2014.2 +131700 MOVE "SEG-TEST-62 " TO PAR-NAME. SG2014.2 +131800 PERFORM PRINT-DETAIL. SG2014.2 +131900 SEG-TEST-63. SG2014.2 +132000 MOVE SPACE TO TEST-CHECK. SG2014.2 +132100 PERFORM 30. SG2014.2 +132200 MOVE SPACE TO TEST-CHECK. SG2014.2 +132300 PERFORM 30. SG2014.2 +132400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +132500 PERFORM PASS SG2014.2 +132600 GO TO SEG-WRITE-63. SG2014.2 +132700 MOVE SPACE TO COMPUTED-A. SG2014.2 +132800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +132900 PERFORM FAIL. SG2014.2 +133000 GO TO SEG-WRITE-63. SG2014.2 +133100 SEG-DELETE-63. SG2014.2 +133200 PERFORM DE-LETE. SG2014.2 +133300 SEG-WRITE-63. SG2014.2 +133400 MOVE "SEG-TEST-63 " TO PAR-NAME. SG2014.2 +133500 PERFORM PRINT-DETAIL. SG2014.2 +133600 SEG-TEST-64. SG2014.2 +133700 MOVE SPACE TO TEST-CHECK. SG2014.2 +133800 PERFORM 99. SG2014.2 +133900 MOVE SPACE TO TEST-CHECK. SG2014.2 +134000 PERFORM 99. SG2014.2 +134100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +134200 PERFORM PASS SG2014.2 +134300 GO TO SEG-WRITE-64. SG2014.2 +134400 MOVE SPACE TO COMPUTED-A. SG2014.2 +134500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +134600 PERFORM FAIL. SG2014.2 +134700 GO TO SEG-WRITE-64. SG2014.2 +134800 SEG-DELETE-64. SG2014.2 +134900 PERFORM DE-LETE. SG2014.2 +135000 SEG-WRITE-64. SG2014.2 +135100 MOVE "SEG-TEST-64 " TO PAR-NAME. SG2014.2 +135200 PERFORM PRINT-DETAIL. SG2014.2 +135300 SEG-TEST-65. SG2014.2 +135400 MOVE SPACE TO TEST-CHECK. SG2014.2 +135500 PERFORM 99. SG2014.2 +135600 MOVE SPACE TO TEST-CHECK. SG2014.2 +135700 PERFORM 99. SG2014.2 +135800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +135900 PERFORM PASS SG2014.2 +136000 GO TO SEG-WRITE-65. SG2014.2 +136100 MOVE SPACE TO COMPUTED-A. SG2014.2 +136200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +136300 PERFORM FAIL. SG2014.2 +136400 GO TO SEG-WRITE-65. SG2014.2 +136500 SEG-DELETE-65. SG2014.2 +136600 PERFORM DE-LETE. SG2014.2 +136700 SEG-WRITE-65. SG2014.2 +136800 MOVE "SEG-TEST-65 " TO PAR-NAME. SG2014.2 +136900 PERFORM PRINT-DETAIL. SG2014.2 +137000 SEG-TEST-66. SG2014.2 +137100 MOVE SPACE TO TEST-CHECK. SG2014.2 +137200 PERFORM 37. SG2014.2 +137300 MOVE SPACE TO TEST-CHECK. SG2014.2 +137400 PERFORM 37. SG2014.2 +137500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +137600 PERFORM PASS SG2014.2 +137700 GO TO SEG-WRITE-66. SG2014.2 +137800 MOVE SPACE TO COMPUTED-A. SG2014.2 +137900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +138000 PERFORM FAIL. SG2014.2 +138100 GO TO SEG-WRITE-66. SG2014.2 +138200 SEG-DELETE-66. SG2014.2 +138300 PERFORM DE-LETE. SG2014.2 +138400 SEG-WRITE-66. SG2014.2 +138500 MOVE "SEG-TEST-66 " TO PAR-NAME. SG2014.2 +138600 PERFORM PRINT-DETAIL. SG2014.2 +138700 SEG-TEST-67. SG2014.2 +138800 MOVE SPACE TO TEST-CHECK. SG2014.2 +138900 PERFORM 38. SG2014.2 +139000 MOVE SPACE TO TEST-CHECK. SG2014.2 +139100 PERFORM 38. SG2014.2 +139200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +139300 PERFORM PASS SG2014.2 +139400 GO TO SEG-WRITE-67. SG2014.2 +139500 MOVE SPACE TO COMPUTED-A. SG2014.2 +139600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +139700 PERFORM FAIL. SG2014.2 +139800 GO TO SEG-WRITE-67. SG2014.2 +139900 SEG-DELETE-67. SG2014.2 +140000 PERFORM DE-LETE. SG2014.2 +140100 SEG-WRITE-67. SG2014.2 +140200 MOVE "SEG-TEST-67 " TO PAR-NAME. SG2014.2 +140300 PERFORM PRINT-DETAIL. SG2014.2 +140400 SEG-TEST-68. SG2014.2 +140500 MOVE SPACE TO TEST-CHECK. SG2014.2 +140600 PERFORM 39. SG2014.2 +140700 MOVE SPACE TO TEST-CHECK. SG2014.2 +140800 PERFORM 39. SG2014.2 +140900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +141000 PERFORM PASS SG2014.2 +141100 GO TO SEG-WRITE-68. SG2014.2 +141200 MOVE SPACE TO COMPUTED-A. SG2014.2 +141300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +141400 PERFORM FAIL. SG2014.2 +141500 GO TO SEG-WRITE-68. SG2014.2 +141600 SEG-DELETE-68. SG2014.2 +141700 PERFORM DE-LETE. SG2014.2 +141800 SEG-WRITE-68. SG2014.2 +141900 MOVE "SEG-TEST-68 " TO PAR-NAME. SG2014.2 +142000 PERFORM PRINT-DETAIL. SG2014.2 +142100 SEG-TEST-69. SG2014.2 +142200 MOVE SPACE TO TEST-CHECK. SG2014.2 +142300 PERFORM 40. SG2014.2 +142400 MOVE SPACE TO TEST-CHECK. SG2014.2 +142500 PERFORM 40. SG2014.2 +142600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +142700 PERFORM PASS SG2014.2 +142800 GO TO SEG-WRITE-69. SG2014.2 +142900 MOVE SPACE TO COMPUTED-A. SG2014.2 +143000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +143100 PERFORM FAIL. SG2014.2 +143200 GO TO SEG-WRITE-69. SG2014.2 +143300 SEG-DELETE-69. SG2014.2 +143400 PERFORM DE-LETE. SG2014.2 +143500 SEG-WRITE-69. SG2014.2 +143600 MOVE "SEG-TEST-69 " TO PAR-NAME. SG2014.2 +143700 PERFORM PRINT-DETAIL. SG2014.2 +143800 SEG-TEST-70. SG2014.2 +143900 MOVE SPACE TO TEST-CHECK. SG2014.2 +144000 PERFORM 41. SG2014.2 +144100 MOVE SPACE TO TEST-CHECK. SG2014.2 +144200 PERFORM 41. SG2014.2 +144300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +144400 PERFORM PASS SG2014.2 +144500 GO TO SEG-WRITE-70. SG2014.2 +144600 MOVE SPACE TO COMPUTED-A. SG2014.2 +144700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +144800 PERFORM FAIL. SG2014.2 +144900 GO TO SEG-WRITE-70. SG2014.2 +145000 SEG-DELETE-70. SG2014.2 +145100 PERFORM DE-LETE. SG2014.2 +145200 SEG-WRITE-70. SG2014.2 +145300 MOVE "SEG-TEST-70 " TO PAR-NAME. SG2014.2 +145400 PERFORM PRINT-DETAIL. SG2014.2 +145500 SEG-TEST-71. SG2014.2 +145600 MOVE SPACE TO TEST-CHECK. SG2014.2 +145700 PERFORM 42. SG2014.2 +145800 MOVE SPACE TO TEST-CHECK. SG2014.2 +145900 PERFORM 42. SG2014.2 +146000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +146100 PERFORM PASS SG2014.2 +146200 GO TO SEG-WRITE-71. SG2014.2 +146300 MOVE SPACE TO COMPUTED-A. SG2014.2 +146400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +146500 PERFORM FAIL. SG2014.2 +146600 GO TO SEG-WRITE-71. SG2014.2 +146700 SEG-DELETE-71. SG2014.2 +146800 PERFORM DE-LETE. SG2014.2 +146900 SEG-WRITE-71. SG2014.2 +147000 MOVE "SEG-TEST-71 " TO PAR-NAME. SG2014.2 +147100 PERFORM PRINT-DETAIL. SG2014.2 +147200 SEG-TEST-72. SG2014.2 +147300 MOVE SPACE TO TEST-CHECK. SG2014.2 +147400 PERFORM 43. SG2014.2 +147500 MOVE SPACE TO TEST-CHECK. SG2014.2 +147600 PERFORM 43. SG2014.2 +147700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +147800 PERFORM PASS SG2014.2 +147900 GO TO SEG-WRITE-72. SG2014.2 +148000 MOVE SPACE TO COMPUTED-A. SG2014.2 +148100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +148200 PERFORM FAIL. SG2014.2 +148300 GO TO SEG-WRITE-72. SG2014.2 +148400 SEG-DELETE-72. SG2014.2 +148500 PERFORM DE-LETE. SG2014.2 +148600 SEG-WRITE-72. SG2014.2 +148700 MOVE "SEG-TEST-72 " TO PAR-NAME. SG2014.2 +148800 PERFORM PRINT-DETAIL. SG2014.2 +148900 SEG-TEST-73. SG2014.2 +149000 MOVE SPACE TO TEST-CHECK. SG2014.2 +149100 PERFORM 44. SG2014.2 +149200 MOVE SPACE TO TEST-CHECK. SG2014.2 +149300 PERFORM 44. SG2014.2 +149400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +149500 PERFORM PASS SG2014.2 +149600 GO TO SEG-WRITE-73. SG2014.2 +149700 MOVE SPACE TO COMPUTED-A. SG2014.2 +149800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +149900 PERFORM FAIL. SG2014.2 +150000 GO TO SEG-WRITE-73. SG2014.2 +150100 SEG-DELETE-73. SG2014.2 +150200 PERFORM DE-LETE. SG2014.2 +150300 SEG-WRITE-73. SG2014.2 +150400 MOVE "SEG-TEST-73 " TO PAR-NAME. SG2014.2 +150500 PERFORM PRINT-DETAIL. SG2014.2 +150600 SECOND-HALF SECTION 50. SG2014.2 +150700 SEG-TEST-74. SG2014.2 +150800 MOVE SPACE TO TEST-CHECK. SG2014.2 +150900 PERFORM 01. SG2014.2 +151000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +151100 PERFORM PASS SG2014.2 +151200 GO TO SEG-WRITE-74. SG2014.2 +151300 MOVE SPACE TO COMPUTED-A. SG2014.2 +151400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +151500 PERFORM FAIL. SG2014.2 +151600 GO TO SEG-WRITE-74. SG2014.2 +151700 SEG-DELETE-74. SG2014.2 +151800 PERFORM DE-LETE. SG2014.2 +151900 SEG-WRITE-74. SG2014.2 +152000 MOVE "SEG-TEST-74 " TO PAR-NAME. SG2014.2 +152100 PERFORM PRINT-DETAIL. SG2014.2 +152200 SEG-TEST-75. SG2014.2 +152300 MOVE SPACE TO TEST-CHECK. SG2014.2 +152400 PERFORM 02. SG2014.2 +152500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +152600 PERFORM PASS SG2014.2 +152700 GO TO SEG-WRITE-75. SG2014.2 +152800 MOVE SPACE TO COMPUTED-A. SG2014.2 +152900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +153000 PERFORM FAIL. SG2014.2 +153100 GO TO SEG-WRITE-75. SG2014.2 +153200 SEG-DELETE-75. SG2014.2 +153300 PERFORM DE-LETE. SG2014.2 +153400 SEG-WRITE-75. SG2014.2 +153500 MOVE "SEG-TEST-75 " TO PAR-NAME. SG2014.2 +153600 PERFORM PRINT-DETAIL. SG2014.2 +153700 SEG-TEST-76. SG2014.2 +153800 MOVE SPACE TO TEST-CHECK. SG2014.2 +153900 PERFORM 03. SG2014.2 +154000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +154100 PERFORM PASS SG2014.2 +154200 GO TO SEG-WRITE-76. SG2014.2 +154300 MOVE SPACE TO COMPUTED-A. SG2014.2 +154400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +154500 PERFORM FAIL. SG2014.2 +154600 GO TO SEG-WRITE-76. SG2014.2 +154700 SEG-DELETE-76. SG2014.2 +154800 PERFORM DE-LETE. SG2014.2 +154900 SEG-WRITE-76. SG2014.2 +155000 MOVE "SEG-TEST-76 " TO PAR-NAME. SG2014.2 +155100 PERFORM PRINT-DETAIL. SG2014.2 +155200 SEG-TEST-77. SG2014.2 +155300 MOVE SPACE TO TEST-CHECK. SG2014.2 +155400 PERFORM 04. SG2014.2 +155500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +155600 PERFORM PASS SG2014.2 +155700 GO TO SEG-WRITE-77. SG2014.2 +155800 MOVE SPACE TO COMPUTED-A. SG2014.2 +155900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +156000 PERFORM FAIL. SG2014.2 +156100 GO TO SEG-WRITE-77. SG2014.2 +156200 SEG-DELETE-77. SG2014.2 +156300 PERFORM DE-LETE. SG2014.2 +156400 SEG-WRITE-77. SG2014.2 +156500 MOVE "SEG-TEST-77 " TO PAR-NAME. SG2014.2 +156600 PERFORM PRINT-DETAIL. SG2014.2 +156700 SEG-TEST-78. SG2014.2 +156800 MOVE SPACE TO TEST-CHECK. SG2014.2 +156900 PERFORM 05. SG2014.2 +157000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +157100 PERFORM PASS SG2014.2 +157200 GO TO SEG-WRITE-78. SG2014.2 +157300 MOVE SPACE TO COMPUTED-A. SG2014.2 +157400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +157500 PERFORM FAIL. SG2014.2 +157600 GO TO SEG-WRITE-78. SG2014.2 +157700 SEG-DELETE-78. SG2014.2 +157800 PERFORM DE-LETE. SG2014.2 +157900 SEG-WRITE-78. SG2014.2 +158000 MOVE "SEG-TEST-78 " TO PAR-NAME. SG2014.2 +158100 PERFORM PRINT-DETAIL. SG2014.2 +158200 SEG-TEST-79. SG2014.2 +158300 MOVE SPACE TO TEST-CHECK. SG2014.2 +158400 PERFORM 06. SG2014.2 +158500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +158600 PERFORM PASS SG2014.2 +158700 GO TO SEG-WRITE-79. SG2014.2 +158800 MOVE SPACE TO COMPUTED-A. SG2014.2 +158900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +159000 PERFORM FAIL. SG2014.2 +159100 GO TO SEG-WRITE-79. SG2014.2 +159200 SEG-DELETE-79. SG2014.2 +159300 PERFORM DE-LETE. SG2014.2 +159400 SEG-WRITE-79. SG2014.2 +159500 MOVE "SEG-TEST-79 " TO PAR-NAME. SG2014.2 +159600 PERFORM PRINT-DETAIL. SG2014.2 +159700 GO TO CLOSE-FILES. SG2014.2 +159800 00 SECTION 00. SG2014.2 +159900 PARA-00. SG2014.2 +160000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160100 01 SECTION 01. SG2014.2 +160200 PARA-01. SG2014.2 +160300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160400 02 SECTION 02. SG2014.2 +160500 PARA-02. SG2014.2 +160600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160700 03 SECTION 03. SG2014.2 +160800 PARA-03. SG2014.2 +160900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161000 04 SECTION 04. SG2014.2 +161100 PARA-04. SG2014.2 +161200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161300 05 SECTION 05. SG2014.2 +161400 PARA-05. SG2014.2 +161500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161600 06 SECTION 06. SG2014.2 +161700 PARA-06. SG2014.2 +161800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161900 30 SECTION 30. SG2014.2 +162000 PARA-30. SG2014.2 +162100 GO TO PARA-30C. SG2014.2 +162200 PARA-30A. SG2014.2 +162300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +162400 PARA-30B. SG2014.2 +162500 GO TO PARA-30D. SG2014.2 +162600 PARA-30C. SG2014.2 +162700 ALTER PARA-30 TO PROCEED TO PARA-30A. SG2014.2 +162800 PARA-30D. SG2014.2 +162900 EXIT. SG2014.2 +163000 31 SECTION 31. SG2014.2 +163100 PARA-31. SG2014.2 +163200 GO TO PARA-31C. SG2014.2 +163300 PARA-31A. SG2014.2 +163400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +163500 PARA-31B. SG2014.2 +163600 GO TO PARA-31D. SG2014.2 +163700 PARA-31C. SG2014.2 +163800 ALTER PARA-31 TO PROCEED TO PARA-31A. SG2014.2 +163900 PARA-31D. SG2014.2 +164000 EXIT. SG2014.2 +164100 32 SECTION 32. SG2014.2 +164200 PARA-32. SG2014.2 +164300 GO TO PARA-32C. SG2014.2 +164400 PARA-32A. SG2014.2 +164500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +164600 PARA-32B. SG2014.2 +164700 GO TO PARA-32D. SG2014.2 +164800 PARA-32C. SG2014.2 +164900 ALTER PARA-32 TO PROCEED TO PARA-32A. SG2014.2 +165000 PARA-32D. SG2014.2 +165100 EXIT. SG2014.2 +165200 33 SECTION 33. SG2014.2 +165300 PARA-33. SG2014.2 +165400 GO TO PARA-33C. SG2014.2 +165500 PARA-33A. SG2014.2 +165600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +165700 PARA-33B. SG2014.2 +165800 GO TO PARA-33D. SG2014.2 +165900 PARA-33C. SG2014.2 +166000 ALTER PARA-33 TO PROCEED TO PARA-33A. SG2014.2 +166100 PARA-33D. SG2014.2 +166200 EXIT. SG2014.2 +166300 34 SECTION 34. SG2014.2 +166400 PARA-34. SG2014.2 +166500 GO TO PARA-34C. SG2014.2 +166600 PARA-34A. SG2014.2 +166700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +166800 PARA-34B. SG2014.2 +166900 GO TO PARA-34D. SG2014.2 +167000 PARA-34C. SG2014.2 +167100 ALTER PARA-34 TO PROCEED TO PARA-34A. SG2014.2 +167200 PARA-34D. SG2014.2 +167300 EXIT. SG2014.2 +167400 35 SECTION 35. SG2014.2 +167500 PARA-35. SG2014.2 +167600 GO TO PARA-35C. SG2014.2 +167700 PARA-35A. SG2014.2 +167800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +167900 PARA-35B. SG2014.2 +168000 GO TO PARA-35D. SG2014.2 +168100 PARA-35C. SG2014.2 +168200 ALTER PARA-35 TO PROCEED TO PARA-35A. SG2014.2 +168300 PARA-35D. SG2014.2 +168400 EXIT. SG2014.2 +168500 36 SECTION 36. SG2014.2 +168600 PARA-36. SG2014.2 +168700 GO TO PARA-36C. SG2014.2 +168800 PARA-36A. SG2014.2 +168900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +169000 PARA-36B. SG2014.2 +169100 GO TO PARA-36D. SG2014.2 +169200 PARA-36C. SG2014.2 +169300 ALTER PARA-36 TO PROCEED TO PARA-36A. SG2014.2 +169400 PARA-36D. SG2014.2 +169500 EXIT. SG2014.2 +169600 37 SECTION 37. SG2014.2 +169700 PARA-37. SG2014.2 +169800 GO TO PARA-37C. SG2014.2 +169900 PARA-37A. SG2014.2 +170000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +170100 PARA-37B. SG2014.2 +170200 GO TO PARA-37D. SG2014.2 +170300 PARA-37C. SG2014.2 +170400 ALTER PARA-37 TO PROCEED TO PARA-37A. SG2014.2 +170500 PARA-37D. SG2014.2 +170600 EXIT. SG2014.2 +170700 38 SECTION 38. SG2014.2 +170800 PARA-38. SG2014.2 +170900 GO TO PARA-38C. SG2014.2 +171000 PARA-38A. SG2014.2 +171100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +171200 PARA-38B. SG2014.2 +171300 GO TO PARA-38D. SG2014.2 +171400 PARA-38C. SG2014.2 +171500 ALTER PARA-38 TO PROCEED TO PARA-38A. SG2014.2 +171600 PARA-38D. SG2014.2 +171700 EXIT. SG2014.2 +171800 39 SECTION 39. SG2014.2 +171900 PARA-39. SG2014.2 +172000 GO TO PARA-39C. SG2014.2 +172100 PARA-39A. SG2014.2 +172200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +172300 PARA-39B. SG2014.2 +172400 GO TO PARA-39D. SG2014.2 +172500 PARA-39C. SG2014.2 +172600 ALTER PARA-39 TO PROCEED TO PARA-39A. SG2014.2 +172700 PARA-39D. SG2014.2 +172800 EXIT. SG2014.2 +172900 40 SECTION 40. SG2014.2 +173000 PARA-40. SG2014.2 +173100 GO TO PARA-40C. SG2014.2 +173200 PARA-40A. SG2014.2 +173300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +173400 PARA-40B. SG2014.2 +173500 GO TO PARA-40D. SG2014.2 +173600 PARA-40C. SG2014.2 +173700 ALTER PARA-40 TO PROCEED TO PARA-40A. SG2014.2 +173800 PARA-40D. SG2014.2 +173900 EXIT. SG2014.2 +174000 41 SECTION 41. SG2014.2 +174100 PARA-41. SG2014.2 +174200 GO TO PARA-41C. SG2014.2 +174300 PARA-41A. SG2014.2 +174400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +174500 PARA-41B. SG2014.2 +174600 GO TO PARA-41D. SG2014.2 +174700 PARA-41C. SG2014.2 +174800 ALTER PARA-41 TO PROCEED TO PARA-41A. SG2014.2 +174900 PARA-41D. SG2014.2 +175000 EXIT. SG2014.2 +175100 42 SECTION 42. SG2014.2 +175200 PARA-42. SG2014.2 +175300 GO TO PARA-42C. SG2014.2 +175400 PARA-42A. SG2014.2 +175500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +175600 PARA-42B. SG2014.2 +175700 GO TO PARA-42D. SG2014.2 +175800 PARA-42C. SG2014.2 +175900 ALTER PARA-42 TO PROCEED TO PARA-42A. SG2014.2 +176000 PARA-42D. SG2014.2 +176100 EXIT. SG2014.2 +176200 43 SECTION 43. SG2014.2 +176300 PARA-43. SG2014.2 +176400 GO TO PARA-43C. SG2014.2 +176500 PARA-43A. SG2014.2 +176600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +176700 PARA-43B. SG2014.2 +176800 GO TO PARA-43D. SG2014.2 +176900 PARA-43C. SG2014.2 +177000 ALTER PARA-43 TO PROCEED TO PARA-43A. SG2014.2 +177100 PARA-43D. SG2014.2 +177200 EXIT. SG2014.2 +177300 44 SECTION 44. SG2014.2 +177400 PARA-44. SG2014.2 +177500 GO TO PARA-44C. SG2014.2 +177600 PARA-44A. SG2014.2 +177700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +177800 PARA-44B. SG2014.2 +177900 GO TO PARA-44D. SG2014.2 +178000 PARA-44C. SG2014.2 +178100 ALTER PARA-44 TO PROCEED TO PARA-44A. SG2014.2 +178200 PARA-44D. SG2014.2 +178300 EXIT. SG2014.2 +178400 45 SECTION 45. SG2014.2 +178500 PARA-45. SG2014.2 +178600 GO TO PARA-45C. SG2014.2 +178700 PARA-45A. SG2014.2 +178800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +178900 PARA-45B. SG2014.2 +179000 GO TO PARA-45D. SG2014.2 +179100 PARA-45C. SG2014.2 +179200 ALTER PARA-45 TO PROCEED TO PARA-45A. SG2014.2 +179300 PARA-45D. SG2014.2 +179400 EXIT. SG2014.2 +179500 46 SECTION 46. SG2014.2 +179600 PARA-46. SG2014.2 +179700 GO TO PARA-46C. SG2014.2 +179800 PARA-46A. SG2014.2 +179900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +180000 PARA-46B. SG2014.2 +180100 GO TO PARA-46D. SG2014.2 +180200 PARA-46C. SG2014.2 +180300 ALTER PARA-46 TO PROCEED TO PARA-46A. SG2014.2 +180400 PARA-46D. SG2014.2 +180500 EXIT. SG2014.2 +180600 47 SECTION 47. SG2014.2 +180700 PARA-47. SG2014.2 +180800 GO TO PARA-47C. SG2014.2 +180900 PARA-47A. SG2014.2 +181000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +181100 PARA-47B. SG2014.2 +181200 GO TO PARA-47D. SG2014.2 +181300 PARA-47C. SG2014.2 +181400 ALTER PARA-47 TO PROCEED TO PARA-47A. SG2014.2 +181500 PARA-47D. SG2014.2 +181600 EXIT. SG2014.2 +181700 48 SECTION 48. SG2014.2 +181800 PARA-48. SG2014.2 +181900 GO TO PARA-48C. SG2014.2 +182000 PARA-48A. SG2014.2 +182100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +182200 PARA-48B. SG2014.2 +182300 GO TO PARA-48D. SG2014.2 +182400 PARA-48C. SG2014.2 +182500 ALTER PARA-48 TO PROCEED TO PARA-48A. SG2014.2 +182600 PARA-48D. SG2014.2 +182700 EXIT. SG2014.2 +182800 49 SECTION 49. SG2014.2 +182900 PARA-49. SG2014.2 +183000 GO TO PARA-49C. SG2014.2 +183100 PARA-49A. SG2014.2 +183200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +183300 PARA-49B. SG2014.2 +183400 GO TO PARA-49D. SG2014.2 +183500 PARA-49C. SG2014.2 +183600 ALTER PARA-49 TO PROCEED TO PARA-49A. SG2014.2 +183700 PARA-49D. SG2014.2 +183800 EXIT. SG2014.2 +183900 50 SECTION 50. SG2014.2 +184000 PARA-50. SG2014.2 +184100 GO TO PARA-50A. SG2014.2 +184200 PARA-50A. SG2014.2 +184300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +184400 PARA-50B. SG2014.2 +184500 ALTER PARA-50 TO PROCEED TO PARA-50C. SG2014.2 +184600 PARA-50C. SG2014.2 +184700 EXIT. SG2014.2 +184800 51 SECTION 51. SG2014.2 +184900 PARA-51. SG2014.2 +185000 GO TO PARA-51A. SG2014.2 +185100 PARA-51A. SG2014.2 +185200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +185300 PARA-51B. SG2014.2 +185400 ALTER PARA-51 TO PROCEED TO PARA-51C. SG2014.2 +185500 PARA-51C. SG2014.2 +185600 EXIT. SG2014.2 +185700 52 SECTION 52. SG2014.2 +185800 PARA-52. SG2014.2 +185900 GO TO PARA-52A. SG2014.2 +186000 PARA-52A. SG2014.2 +186100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +186200 PARA-52B. SG2014.2 +186300 ALTER PARA-52 TO PROCEED TO PARA-52C. SG2014.2 +186400 PARA-52C. SG2014.2 +186500 EXIT. SG2014.2 +186600 53 SECTION 53. SG2014.2 +186700 PARA-53. SG2014.2 +186800 GO TO PARA-53A. SG2014.2 +186900 PARA-53A. SG2014.2 +187000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +187100 PARA-53B. SG2014.2 +187200 ALTER PARA-53 TO PROCEED TO PARA-53C. SG2014.2 +187300 PARA-53C. SG2014.2 +187400 EXIT. SG2014.2 +187500 54 SECTION 54. SG2014.2 +187600 PARA-54. SG2014.2 +187700 GO TO PARA-54A. SG2014.2 +187800 PARA-54A. SG2014.2 +187900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +188000 PARA-54B. SG2014.2 +188100 ALTER PARA-54 TO PROCEED TO PARA-54C. SG2014.2 +188200 PARA-54C. SG2014.2 +188300 EXIT. SG2014.2 +188400 55 SECTION 55. SG2014.2 +188500 PARA-55. SG2014.2 +188600 GO TO PARA-55A. SG2014.2 +188700 PARA-55A. SG2014.2 +188800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +188900 PARA-55B. SG2014.2 +189000 ALTER PARA-55 TO PROCEED TO PARA-55C. SG2014.2 +189100 PARA-55C. SG2014.2 +189200 EXIT. SG2014.2 +189300 56 SECTION 56. SG2014.2 +189400 PARA-56. SG2014.2 +189500 GO TO PARA-56A. SG2014.2 +189600 PARA-56A. SG2014.2 +189700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +189800 PARA-56B. SG2014.2 +189900 ALTER PARA-56 TO PROCEED TO PARA-56C. SG2014.2 +190000 PARA-56C. SG2014.2 +190100 EXIT. SG2014.2 +190200 57 SECTION 57. SG2014.2 +190300 PARA-57. SG2014.2 +190400 GO TO PARA-57A. SG2014.2 +190500 PARA-57A. SG2014.2 +190600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +190700 PARA-57B. SG2014.2 +190800 ALTER PARA-57 TO PROCEED TO PARA-57C. SG2014.2 +190900 PARA-57C. SG2014.2 +191000 EXIT. SG2014.2 +191100 58 SECTION 58. SG2014.2 +191200 PARA-58. SG2014.2 +191300 GO TO PARA-58A. SG2014.2 +191400 PARA-58A. SG2014.2 +191500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +191600 PARA-58B. SG2014.2 +191700 ALTER PARA-58 TO PROCEED TO PARA-58C. SG2014.2 +191800 PARA-58C. SG2014.2 +191900 EXIT. SG2014.2 +192000 59 SECTION 59. SG2014.2 +192100 PARA-59. SG2014.2 +192200 GO TO PARA-59A. SG2014.2 +192300 PARA-59A. SG2014.2 +192400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +192500 PARA-59B. SG2014.2 +192600 ALTER PARA-59 TO PROCEED TO PARA-59C. SG2014.2 +192700 PARA-59C. SG2014.2 +192800 EXIT. SG2014.2 +192900 60 SECTION 60. SG2014.2 +193000 PARA-60. SG2014.2 +193100 GO TO PARA-60A. SG2014.2 +193200 PARA-60A. SG2014.2 +193300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +193400 PARA-60B. SG2014.2 +193500 ALTER PARA-60 TO PROCEED TO PARA-60C. SG2014.2 +193600 PARA-60C. SG2014.2 +193700 EXIT. SG2014.2 +193800 99 SECTION 99. SG2014.2 +193900 PARA-99. SG2014.2 +194000 GO TO PARA-99A. SG2014.2 +194100 PARA-99A. SG2014.2 +194200 ALTER PARA-99 TO PARA-99B. SG2014.2 +194300 GO TO PARA-99C. SG2014.2 +194400 PARA-99B. SG2014.2 +194500 MOVE SPACE TO TEST-CHECK. SG2014.2 +194600 GO TO PARA-99D. SG2014.2 +194700 PARA-99C. SG2014.2 +194800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +194900 PARA-99D. SG2014.2 +195000 EXIT. SG2014.2 +*END-OF,SG201A +*HEADER,COBOL,SG202A +000100 IDENTIFICATION DIVISION. SG2024.2 +000200 PROGRAM-ID. SG2024.2 +000300 SG202A. SG2024.2 +000400 AUTHOR. SG2024.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2024.2 +000600 INSTALLATION. SG2024.2 +000700 GENERAL SERVICES ADMINISTRATION SG2024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2024.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2024.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2024.2 +001200 SG2024.2 +001300 PHONE (703) 756-6153 SG2024.2 +001400 SG2024.2 +001500 " HIGH ". SG2024.2 +001600 DATE-WRITTEN. SG2024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2024.2 +001800 CREATION DATE / VALIDATION DATE SG2024.2 +001900 "4.2 ". SG2024.2 +002000 SECURITY. SG2024.2 +002100 NONE. SG2024.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2024.2 +002300 BASED ON A SEGMENT-LIMIT OF 25 THESE TESTS ARE SG2024.2 +002400 DESIGNED TO ALTER SEGMENTS THAT HAVE NOT YET BEEN SG2024.2 +002500 CALLED FOR EXECUTION, FALL THRU TO INDEPENDENT SG2024.2 +002600 SEGMENTS, AND PERFORM FIXED OVERLAYABLE SEGMENTS. SG2024.2 +002700 SG2024.2 +002800* SG2024.2 +002900 ENVIRONMENT DIVISION. SG2024.2 +003000 CONFIGURATION SECTION. SG2024.2 +003100 SOURCE-COMPUTER. SG2024.2 +003200 XXXXX082. SG2024.2 +003300 OBJECT-COMPUTER. SG2024.2 +003400 XXXXX083 SG2024.2 +003500 SEGMENT-LIMIT IS 25. SG2024.2 +003600 INPUT-OUTPUT SECTION. SG2024.2 +003700 FILE-CONTROL. SG2024.2 +003800 SELECT PRINT-FILE ASSIGN TO SG2024.2 +003900 XXXXX055. SG2024.2 +004000 DATA DIVISION. SG2024.2 +004100 FILE SECTION. SG2024.2 +004200 FD PRINT-FILE SG2024.2 +004300 LABEL RECORDS SG2024.2 +004400 XXXXX084 SG2024.2 +004500 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2024.2 +004600 01 PRINT-REC PICTURE X(120). SG2024.2 +004700 01 DUMMY-RECORD PICTURE X(120). SG2024.2 +004800 WORKING-STORAGE SECTION. SG2024.2 +004900 01 LAST-STATE-A. SG2024.2 +005000 02 LAST-STATE-B PICTURE 9 VALUE 0. SG2024.2 +005100 02 LAST-STATE-C PICTURE 9 VALUE 0. SG2024.2 +005200 01 ALTER-NOT-CALL PICTURE X. SG2024.2 +005300 01 PERF-OVER-RES. SG2024.2 +005400 02 PERF-OVER-RES-A PICTURE X. SG2024.2 +005500 02 PERF-OVER-RES-B PICTURE X. SG2024.2 +005600 01 PERF-RES-OVER. SG2024.2 +005700 02 PERF-RES-OVER-A PICTURE X. SG2024.2 +005800 02 PERF-RES-OVER-B PICTURE X. SG2024.2 +005900 01 FALL-RSLT. SG2024.2 +006000 02 FALL-RSLT-1 PICTURE X VALUE " ". SG2024.2 +006100 02 FALL-RSLT-2 PICTURE X VALUE " ". SG2024.2 +006200 01 TEST-RESULTS. SG2024.2 +006300 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2024.2 +006500 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2024.2 +006700 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006800 02 PAR-NAME. SG2024.2 +006900 03 FILLER PICTURE X(12) VALUE SPACE. SG2024.2 +007000 03 PARDOT-X PICTURE X VALUE SPACE. SG2024.2 +007100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2024.2 +007200 03 FILLER PIC X(5) VALUE SPACE. SG2024.2 +007300 02 FILLER PIC X(10) VALUE SPACE. SG2024.2 +007400 02 RE-MARK PIC X(61). SG2024.2 +007500 01 TEST-COMPUTED. SG2024.2 +007600 02 FILLER PIC X(30) VALUE SPACE. SG2024.2 +007700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2024.2 +007800 02 COMPUTED-X. SG2024.2 +007900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2024.2 +008000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2024.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2024.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2024.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2024.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. SG2024.2 +008500 04 COMPUTED-18V0 PICTURE -9(18). SG2024.2 +008600 04 FILLER PICTURE X. SG2024.2 +008700 03 FILLER PIC X(50) VALUE SPACE. SG2024.2 +008800 01 TEST-CORRECT. SG2024.2 +008900 02 FILLER PIC X(30) VALUE SPACE. SG2024.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2024.2 +009100 02 CORRECT-X. SG2024.2 +009200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2024.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2024.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2024.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2024.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2024.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. SG2024.2 +009800 04 CORRECT-18V0 PICTURE -9(18). SG2024.2 +009900 04 FILLER PICTURE X. SG2024.2 +010000 03 FILLER PIC X(50) VALUE SPACE. SG2024.2 +010100 01 CCVS-C-1. SG2024.2 +010200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2024.2 +010300- "SS PARAGRAPH-NAME SG2024.2 +010400- " REMARKS". SG2024.2 +010500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2024.2 +010600 01 CCVS-C-2. SG2024.2 +010700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +010800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2024.2 +010900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2024.2 +011000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2024.2 +011100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2024.2 +011200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2024.2 +011300 01 REC-CT PICTURE 99 VALUE ZERO. SG2024.2 +011400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2024.2 +011500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2024.2 +011600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2024.2 +011700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2024.2 +011800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2024.2 +011900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2024.2 +012000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2024.2 +012100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2024.2 +012200 01 CCVS-H-1. SG2024.2 +012300 02 FILLER PICTURE X(27) VALUE SPACE. SG2024.2 +012400 02 FILLER PICTURE X(67) VALUE SG2024.2 +012500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2024.2 +012600- " SYSTEM". SG2024.2 +012700 02 FILLER PICTURE X(26) VALUE SPACE. SG2024.2 +012800 01 CCVS-H-2. SG2024.2 +012900 02 FILLER PICTURE X(52) VALUE IS SG2024.2 +013000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2024.2 +013100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2024.2 +013200 02 TEST-ID PICTURE IS X(9). SG2024.2 +013300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2024.2 +013400 01 CCVS-H-3. SG2024.2 +013500 02 FILLER PICTURE X(34) VALUE SG2024.2 +013600 " FOR OFFICIAL USE ONLY ". SG2024.2 +013700 02 FILLER PICTURE X(58) VALUE SG2024.2 +013800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2024.2 +013900 02 FILLER PICTURE X(28) VALUE SG2024.2 +014000 " COPYRIGHT 1974 ". SG2024.2 +014100 01 CCVS-E-1. SG2024.2 +014200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2024.2 +014300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2024.2 +014400 02 ID-AGAIN PICTURE IS X(9). SG2024.2 +014500 02 FILLER PICTURE X(45) VALUE IS SG2024.2 +014600 " NTIS DISTRIBUTION COBOL 74". SG2024.2 +014700 01 CCVS-E-2. SG2024.2 +014800 02 FILLER PICTURE X(31) VALUE SG2024.2 +014900 SPACE. SG2024.2 +015000 02 FILLER PICTURE X(21) VALUE SPACE. SG2024.2 +015100 02 CCVS-E-2-2. SG2024.2 +015200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2024.2 +015300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +015400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2024.2 +015500 01 CCVS-E-3. SG2024.2 +015600 02 FILLER PICTURE X(22) VALUE SG2024.2 +015700 " FOR OFFICIAL USE ONLY". SG2024.2 +015800 02 FILLER PICTURE X(12) VALUE SPACE. SG2024.2 +015900 02 FILLER PICTURE X(58) VALUE SG2024.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2024.2 +016100 02 FILLER PICTURE X(13) VALUE SPACE. SG2024.2 +016200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2024.2 +016300 01 CCVS-E-4. SG2024.2 +016400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2024.2 +016500 02 FILLER PIC XXXX VALUE " OF ". SG2024.2 +016600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2024.2 +016700 02 FILLER PIC X(40) VALUE SG2024.2 +016800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2024.2 +016900 01 XXINFO. SG2024.2 +017000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2024.2 +017100 02 INFO-TEXT. SG2024.2 +017200 04 FILLER PIC X(20) VALUE SPACE. SG2024.2 +017300 04 XXCOMPUTED PIC X(20). SG2024.2 +017400 04 FILLER PIC X(5) VALUE SPACE. SG2024.2 +017500 04 XXCORRECT PIC X(20). SG2024.2 +017600 01 HYPHEN-LINE. SG2024.2 +017700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +017800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2024.2 +017900- "*****************************************". SG2024.2 +018000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2024.2 +018100- "******************************". SG2024.2 +018200 01 CCVS-PGM-ID PIC X(6) VALUE SG2024.2 +018300 "SG202A". SG2024.2 +018400 PROCEDURE DIVISION. SG2024.2 +018500 SEC00 SECTION. SG2024.2 +018600 PARAGRAPH-NAME-1. SG2024.2 +018700 GO TO P0010. SG2024.2 +018800 CCVS1 SECTION. SG2024.2 +018900 OPEN-FILES. SG2024.2 +019000 OPEN OUTPUT PRINT-FILE. SG2024.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2024.2 +019200 MOVE SPACE TO TEST-RESULTS. SG2024.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2024.2 +019400 GO TO CCVS1-EXIT. SG2024.2 +019500 CLOSE-FILES. SG2024.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2024.2 +019700 TERMINATE-CCVS. SG2024.2 +019800S EXIT PROGRAM. SG2024.2 +019900STERMINATE-CALL. SG2024.2 +020000 STOP RUN. SG2024.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2024.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2024.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2024.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2024.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. SG2024.2 +020600 PRINT-DETAIL. SG2024.2 +020700 IF REC-CT NOT EQUAL TO ZERO SG2024.2 +020800 MOVE "." TO PARDOT-X SG2024.2 +020900 MOVE REC-CT TO DOTVALUE. SG2024.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2024.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2024.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2024.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2024.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2024.2 +021500 MOVE SPACE TO CORRECT-X. SG2024.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2024.2 +021700 MOVE SPACE TO RE-MARK. SG2024.2 +021800 HEAD-ROUTINE. SG2024.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +022000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2024.2 +022100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2024.2 +022200 COLUMN-NAMES-ROUTINE. SG2024.2 +022300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +022400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +022600 END-ROUTINE. SG2024.2 +022700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2024.2 +022800 END-RTN-EXIT. SG2024.2 +022900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +023000 END-ROUTINE-1. SG2024.2 +023100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2024.2 +023200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2024.2 +023300 ADD PASS-COUNTER TO ERROR-HOLD. SG2024.2 +023400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2024.2 +023500 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2024.2 +023600 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2024.2 +023700 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2024.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2024.2 +023900 END-ROUTINE-12. SG2024.2 +024000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2024.2 +024100 IF ERROR-COUNTER IS EQUAL TO ZERO SG2024.2 +024200 MOVE "NO " TO ERROR-TOTAL SG2024.2 +024300 ELSE SG2024.2 +024400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2024.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2024.2 +024600 PERFORM WRITE-LINE. SG2024.2 +024700 END-ROUTINE-13. SG2024.2 +024800 IF DELETE-CNT IS EQUAL TO ZERO SG2024.2 +024900 MOVE "NO " TO ERROR-TOTAL ELSE SG2024.2 +025000 MOVE DELETE-CNT TO ERROR-TOTAL. SG2024.2 +025100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2024.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025300 IF INSPECT-COUNTER EQUAL TO ZERO SG2024.2 +025400 MOVE "NO " TO ERROR-TOTAL SG2024.2 +025500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2024.2 +025600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2024.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025900 WRITE-LINE. SG2024.2 +026000 ADD 1 TO RECORD-COUNT. SG2024.2 +026100Y IF RECORD-COUNT GREATER 50 SG2024.2 +026200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2024.2 +026300Y MOVE SPACE TO DUMMY-RECORD SG2024.2 +026400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2024.2 +026500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2024.2 +026600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2024.2 +026700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2024.2 +026800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2024.2 +026900Y MOVE ZERO TO RECORD-COUNT. SG2024.2 +027000 PERFORM WRT-LN. SG2024.2 +027100 WRT-LN. SG2024.2 +027200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2024.2 +027300 MOVE SPACE TO DUMMY-RECORD. SG2024.2 +027400 BLANK-LINE-PRINT. SG2024.2 +027500 PERFORM WRT-LN. SG2024.2 +027600 FAIL-ROUTINE. SG2024.2 +027700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2024.2 +027800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2024.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2024.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +028100 GO TO FAIL-ROUTINE-EX. SG2024.2 +028200 FAIL-ROUTINE-WRITE. SG2024.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2024.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2024.2 +028500 FAIL-ROUTINE-EX. EXIT. SG2024.2 +028600 BAIL-OUT. SG2024.2 +028700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2024.2 +028800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2024.2 +028900 BAIL-OUT-WRITE. SG2024.2 +029000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2024.2 +029100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +029200 BAIL-OUT-EX. EXIT. SG2024.2 +029300 CCVS1-EXIT. SG2024.2 +029400 EXIT. SG2024.2 +029500 SECT-SG-02-001 SECTION 00 . SG2024.2 +029600 SG-02-001. SG2024.2 +029700 P0003. SG2024.2 +029800 MOVE "B" TO PERF-OVER-RES-B. SG2024.2 +029900 P0004. SG2024.2 +030000 MOVE "X" TO PERF-RES-OVER-A. SG2024.2 +030100 GO TO P4801. SG2024.2 +030200 P0010. SG2024.2 +030300 PERFORM CCVS1. SG2024.2 +030400 TEST-1. SG2024.2 +030500 MOVE SPACE TO CORRECT-A. SG2024.2 +030600* NOTE THAT A TEST WILL BE MADE TO ENSURE THAT A ROUTINE SG2024.2 +030700* PERFORMED IN THE OVERLAYABLE PART OF THE PERMANENT SG2024.2 +030800* SEGMENT WILL BE LEFT IN ITS LAST USED STATE --- AN SG2024.2 +030900* ALTER STATEMENT WILL BE USED FOR THIS TEST. SG2024.2 +031000 PERFORM SEC39. SG2024.2 +031100 PERFORM P3901 THRU P3904. SG2024.2 +031200 PERFORM SEC39. SG2024.2 +031300 IF LAST-STATE-A EQUAL TO "23" PERFORM PASS SG2024.2 +031400 ELSE MOVE LAST-STATE-A TO COMPUTED-A SG2024.2 +031500 MOVE "23" TO CORRECT-A SG2024.2 +031600 PERFORM FAIL. SG2024.2 +031700 GO TO TEST-1-WRITE. SG2024.2 +031800 TEST-1-DELETE. SG2024.2 +031900 PERFORM DE-LETE. SG2024.2 +032000 TEST-1-WRITE. SG2024.2 +032100 MOVE "TEST-1" TO PAR-NAME. SG2024.2 +032200 MOVE "LAST USED STATE" TO FEATURE. SG2024.2 +032300 PERFORM PRINT-DETAIL. SG2024.2 +032400 TEST-2. SG2024.2 +032500 MOVE SPACE TO CORRECT-A. SG2024.2 +032600* NOTE THAT A TEST WILL BE MADE TO ENSURE THAT A STATEMENT SG2024.2 +032700* IN THE OVERLAYABLE PART OF THE FIXED PORTION CAN BE SG2024.2 +032800* ALTERED FROM THE PERMANENT SEGMENT EVEN THOUGH THE SG2024.2 +032900* ALTER REFERS TO A SEGMENT NOT YET CALLED FOR SG2024.2 +033000* EXECUTION. SG2024.2 +033100 ALTER P4001 TO PROCEED TO P4003. SG2024.2 +033200 PERFORM SEC40. SG2024.2 +033300 IF ALTER-NOT-CALL EQUAL TO "B" PERFORM PASS SG2024.2 +033400 ELSE MOVE ALTER-NOT-CALL TO COMPUTED-A SG2024.2 +033500 MOVE "B" TO CORRECT-A SG2024.2 +033600 PERFORM FAIL. SG2024.2 +033700 GO TO TEST-2-WRITE. SG2024.2 +033800 TEST-2-DELETE. SG2024.2 +033900 PERFORM DE-LETE. SG2024.2 +034000 TEST-2-WRITE. SG2024.2 +034100 MOVE "TEST-2" TO PAR-NAME. SG2024.2 +034200 MOVE "ALTER NOT CALLD" TO FEATURE. SG2024.2 +034300 PERFORM PRINT-DETAIL. SG2024.2 +034400 TEST-3. SG2024.2 +034500 MOVE SPACE TO CORRECT-A. SG2024.2 +034600* NOTE THIS TEST WILL ENSURE THAT A PERFORM STATEMENT SG2024.2 +034700* REFERENCING A OVERLAYABLE FOLLOWED BY A PERMANENT SG2024.2 +034800* SEGMENT OF THE FIXED PORTION WILL BE EXECUTED OK. SG2024.2 +034900 PERFORM P4501 THRU P0003. SG2024.2 +035000 IF PERF-OVER-RES IS EQUAL TO "AB" PERFORM PASS SG2024.2 +035100 ELSE MOVE PERF-OVER-RES TO COMPUTED-A SG2024.2 +035200 MOVE "AB" TO CORRECT-A SG2024.2 +035300 PERFORM FAIL. SG2024.2 +035400 GO TO TEST-3-WRITE. SG2024.2 +035500 TEST-3-DELETE. SG2024.2 +035600 PERFORM DE-LETE. SG2024.2 +035700 TEST-3-WRITE. SG2024.2 +035800 MOVE "TEST-3" TO PAR-NAME. SG2024.2 +035900 MOVE "PERFORM OVER/FIX" TO FEATURE. SG2024.2 +036000 PERFORM PRINT-DETAIL. SG2024.2 +036100 TEST-4. SG2024.2 +036200 MOVE SPACE TO CORRECT-A. SG2024.2 +036300* NOTE THIS TEST WILL ENSURE THAT A PERFORM STATEMENT SG2024.2 +036400* REFERENCING A PERMANENT SEGMENT FOLLOWED BY AN SG2024.2 +036500* OVERLAYABLE SEGMENT OF THE FIXED PORTION WILL SG2024.2 +036600* BE EXECUTED OK. SG2024.2 +036700 PERFORM P0004 THRU P4802. SG2024.2 +036800 IF PERF-RES-OVER EQUAL TO "XY" PERFORM PASS SG2024.2 +036900 ELSE MOVE PERF-RES-OVER TO COMPUTED-A SG2024.2 +037000 MOVE "XY" TO CORRECT-A SG2024.2 +037100 PERFORM FAIL. SG2024.2 +037200 GO TO TEST-4-WRITE. SG2024.2 +037300 TEST-4-DELETE. SG2024.2 +037400 PERFORM DE-LETE. SG2024.2 +037500 TEST-4-WRITE. SG2024.2 +037600 MOVE "TEST-4" TO PAR-NAME. SG2024.2 +037700 MOVE "PERFORM FIX/OVER" TO FEATURE. SG2024.2 +037800 PERFORM PRINT-DETAIL. SG2024.2 +037900 TEST-5. SG2024.2 +038000 MOVE SPACE TO CORRECT-A. SG2024.2 +038100* NOTE THIS TEST WILL ENSURE THAT THE LOGICAL PATH OF A SG2024.2 +038200* PROGRAM CAN PROCEED FROM THE PERMANENT SEGMENT OF SG2024.2 +038300* OF THE FIXED PORTION (IE IMPLIED FALL-THRU). SG2024.2 +038400 MOVE "A" TO FALL-RSLT-1. SG2024.2 +038500 SEC28 SECTION 28. SG2024.2 +038600 P2801. SG2024.2 +038700 MOVE "B" TO FALL-RSLT-2. SG2024.2 +038800 IF FALL-RSLT EQUAL TO "AB" PERFORM PASS SG2024.2 +038900 ELSE MOVE FALL-RSLT TO COMPUTED-A SG2024.2 +039000 MOVE "AB" TO CORRECT-A SG2024.2 +039100 PERFORM FAIL. SG2024.2 +039200 GO TO TEST-5-WRITE. SG2024.2 +039300 TEST-5-DELETE. SG2024.2 +039400 PERFORM DE-LETE. SG2024.2 +039500 TEST-5-WRITE. SG2024.2 +039600 MOVE "TEST-5" TO PAR-NAME. SG2024.2 +039700 MOVE "FALL THRU IMPLIED" TO FEATURE. SG2024.2 +039800 PERFORM PRINT-DETAIL. SG2024.2 +039900 CLOSE-ROUTINE. SG2024.2 +040000 GO TO CLOSE-FILES. SG2024.2 +040100 SEC39 SECTION 39. SG2024.2 +040200 P3901. SG2024.2 +040300 GO TO P3902. SG2024.2 +040400 P3902. SG2024.2 +040500 ALTER P3901 TO PROCEED TO P3903. SG2024.2 +040600 ADD 1 TO LAST-STATE-B. SG2024.2 +040700 GO TO P3904. SG2024.2 +040800 P3903. SG2024.2 +040900 ALTER P3901 TO PROCEED TO P3902. SG2024.2 +041000 ADD 3 TO LAST-STATE-C. SG2024.2 +041100 P3904. SG2024.2 +041200 EXIT. SG2024.2 +041300 SEC40 SECTION 40. SG2024.2 +041400 P4001. SG2024.2 +041500 GO TO P4002. SG2024.2 +041600 P4002. SG2024.2 +041700 MOVE "A" TO ALTER-NOT-CALL. SG2024.2 +041800 GO TO P4004. SG2024.2 +041900 P4003. SG2024.2 +042000 MOVE "B" TO ALTER-NOT-CALL. SG2024.2 +042100 P4004. SG2024.2 +042200 EXIT. SG2024.2 +042300 SEC45 SECTION 45. SG2024.2 +042400 P4501. SG2024.2 +042500 MOVE "A" TO PERF-OVER-RES-A. SG2024.2 +042600 P4502. SG2024.2 +042700 GO TO P0003. SG2024.2 +042800 SEC48 SECTION 48. SG2024.2 +042900 P4801. SG2024.2 +043000 MOVE "Y" TO PERF-RES-OVER-B. SG2024.2 +043100 P4802. SG2024.2 +043200 EXIT. SG2024.2 +*END-OF,SG202A +*HEADER,COBOL,SG203A +000100 IDENTIFICATION DIVISION. SG2034.2 +000200 PROGRAM-ID. SG2034.2 +000300 SG203A. SG2034.2 +000400 AUTHOR. SG2034.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2034.2 +000600 INSTALLATION. SG2034.2 +000700 GENERAL SERVICES ADMINISTRATION SG2034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2034.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2034.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2034.2 +001200 SG2034.2 +001300 PHONE (703) 756-6153 SG2034.2 +001400 SG2034.2 +001500 " HIGH ". SG2034.2 +001600 DATE-WRITTEN. SG2034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2034.2 +001800 CREATION DATE / VALIDATION DATE SG2034.2 +001900 "4.2 ". SG2034.2 +002000 SECURITY. SG2034.2 +002100 NONE. SG2034.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2034.2 +002300 VARIOUS OPTIONS OF THE PERFORM AND ALTER STATEMENTS SG2034.2 +002400 ARE USED IN CONJUNCTION WITH THE SEGMENT-LIMIT CLAUSE SG2034.2 +002500 CHECKING INITIAL AND LAST-USED STATES. SG2034.2 +002600* SG2034.2 +002700 ENVIRONMENT DIVISION. SG2034.2 +002800 CONFIGURATION SECTION. SG2034.2 +002900 SOURCE-COMPUTER. SG2034.2 +003000 XXXXX082. SG2034.2 +003100 OBJECT-COMPUTER. SG2034.2 +003200 XXXXX083 SG2034.2 +003300 SEGMENT-LIMIT IS 30. SG2034.2 +003400 INPUT-OUTPUT SECTION. SG2034.2 +003500 FILE-CONTROL. SG2034.2 +003600 SELECT PRINT-FILE ASSIGN TO SG2034.2 +003700 XXXXX055. SG2034.2 +003800 DATA DIVISION. SG2034.2 +003900 FILE SECTION. SG2034.2 +004000 FD PRINT-FILE SG2034.2 +004100 LABEL RECORDS SG2034.2 +004200 XXXXX084 SG2034.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2034.2 +004400 01 PRINT-REC PICTURE X(120). SG2034.2 +004500 01 DUMMY-RECORD PICTURE X(120). SG2034.2 +004600 WORKING-STORAGE SECTION. SG2034.2 +004700 77 TEST-COUNTER PICTURE 99 VALUE ZERO. SG2034.2 +004800 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG2034.2 +004900 01 TEST-RESULTS. SG2034.2 +005000 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005100 02 FEATURE PICTURE X(20) VALUE SPACE. SG2034.2 +005200 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005300 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2034.2 +005400 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005500 02 PAR-NAME. SG2034.2 +005600 03 FILLER PICTURE X(12) VALUE SPACE. SG2034.2 +005700 03 PARDOT-X PICTURE X VALUE SPACE. SG2034.2 +005800 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2034.2 +005900 03 FILLER PIC X(5) VALUE SPACE. SG2034.2 +006000 02 FILLER PIC X(10) VALUE SPACE. SG2034.2 +006100 02 RE-MARK PIC X(61). SG2034.2 +006200 01 TEST-COMPUTED. SG2034.2 +006300 02 FILLER PIC X(30) VALUE SPACE. SG2034.2 +006400 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2034.2 +006500 02 COMPUTED-X. SG2034.2 +006600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2034.2 +006700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2034.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2034.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2034.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2034.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. SG2034.2 +007200 04 COMPUTED-18V0 PICTURE -9(18). SG2034.2 +007300 04 FILLER PICTURE X. SG2034.2 +007400 03 FILLER PIC X(50) VALUE SPACE. SG2034.2 +007500 01 TEST-CORRECT. SG2034.2 +007600 02 FILLER PIC X(30) VALUE SPACE. SG2034.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". SG2034.2 +007800 02 CORRECT-X. SG2034.2 +007900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2034.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2034.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2034.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2034.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2034.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. SG2034.2 +008500 04 CORRECT-18V0 PICTURE -9(18). SG2034.2 +008600 04 FILLER PICTURE X. SG2034.2 +008700 03 FILLER PIC X(50) VALUE SPACE. SG2034.2 +008800 01 CCVS-C-1. SG2034.2 +008900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2034.2 +009000- "SS PARAGRAPH-NAME SG2034.2 +009100- " REMARKS". SG2034.2 +009200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2034.2 +009300 01 CCVS-C-2. SG2034.2 +009400 02 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +009500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2034.2 +009600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2034.2 +009700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2034.2 +009800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2034.2 +009900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2034.2 +010000 01 REC-CT PICTURE 99 VALUE ZERO. SG2034.2 +010100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2034.2 +010200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2034.2 +010300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2034.2 +010400 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2034.2 +010500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2034.2 +010600 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2034.2 +010700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2034.2 +010800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2034.2 +010900 01 CCVS-H-1. SG2034.2 +011000 02 FILLER PICTURE X(27) VALUE SPACE. SG2034.2 +011100 02 FILLER PICTURE X(67) VALUE SG2034.2 +011200 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2034.2 +011300- " SYSTEM". SG2034.2 +011400 02 FILLER PICTURE X(26) VALUE SPACE. SG2034.2 +011500 01 CCVS-H-2. SG2034.2 +011600 02 FILLER PICTURE X(52) VALUE IS SG2034.2 +011700 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2034.2 +011800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2034.2 +011900 02 TEST-ID PICTURE IS X(9). SG2034.2 +012000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2034.2 +012100 01 CCVS-H-3. SG2034.2 +012200 02 FILLER PICTURE X(34) VALUE SG2034.2 +012300 " FOR OFFICIAL USE ONLY ". SG2034.2 +012400 02 FILLER PICTURE X(58) VALUE SG2034.2 +012500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2034.2 +012600 02 FILLER PICTURE X(28) VALUE SG2034.2 +012700 " COPYRIGHT 1974 ". SG2034.2 +012800 01 CCVS-E-1. SG2034.2 +012900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2034.2 +013000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2034.2 +013100 02 ID-AGAIN PICTURE IS X(9). SG2034.2 +013200 02 FILLER PICTURE X(45) VALUE IS SG2034.2 +013300 " NTIS DISTRIBUTION COBOL 74". SG2034.2 +013400 01 CCVS-E-2. SG2034.2 +013500 02 FILLER PICTURE X(31) VALUE SG2034.2 +013600 SPACE. SG2034.2 +013700 02 FILLER PICTURE X(21) VALUE SPACE. SG2034.2 +013800 02 CCVS-E-2-2. SG2034.2 +013900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2034.2 +014000 03 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +014100 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2034.2 +014200 01 CCVS-E-3. SG2034.2 +014300 02 FILLER PICTURE X(22) VALUE SG2034.2 +014400 " FOR OFFICIAL USE ONLY". SG2034.2 +014500 02 FILLER PICTURE X(12) VALUE SPACE. SG2034.2 +014600 02 FILLER PICTURE X(58) VALUE SG2034.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2034.2 +014800 02 FILLER PICTURE X(13) VALUE SPACE. SG2034.2 +014900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2034.2 +015000 01 CCVS-E-4. SG2034.2 +015100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2034.2 +015200 02 FILLER PIC XXXX VALUE " OF ". SG2034.2 +015300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2034.2 +015400 02 FILLER PIC X(40) VALUE SG2034.2 +015500 " TESTS WERE EXECUTED SUCCESSFULLY". SG2034.2 +015600 01 XXINFO. SG2034.2 +015700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2034.2 +015800 02 INFO-TEXT. SG2034.2 +015900 04 FILLER PIC X(20) VALUE SPACE. SG2034.2 +016000 04 XXCOMPUTED PIC X(20). SG2034.2 +016100 04 FILLER PIC X(5) VALUE SPACE. SG2034.2 +016200 04 XXCORRECT PIC X(20). SG2034.2 +016300 01 HYPHEN-LINE. SG2034.2 +016400 02 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +016500 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2034.2 +016600- "*****************************************". SG2034.2 +016700 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2034.2 +016800- "******************************". SG2034.2 +016900 01 CCVS-PGM-ID PIC X(6) VALUE SG2034.2 +017000 "SG203A". SG2034.2 +017100 PROCEDURE DIVISION. SG2034.2 +017200 SECT-SG-03-001 SECTION 49. SG2034.2 +017300 INIT-SG203. SG2034.2 +017400 PERFORM CCVS1. SG2034.2 +017500 GO TO 50. SG2034.2 +017600 CCVS1 SECTION. SG2034.2 +017700 OPEN-FILES. SG2034.2 +017800 OPEN OUTPUT PRINT-FILE. SG2034.2 +017900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2034.2 +018000 MOVE SPACE TO TEST-RESULTS. SG2034.2 +018100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2034.2 +018200 GO TO CCVS1-EXIT. SG2034.2 +018300 CLOSE-FILES. SG2034.2 +018400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2034.2 +018500 TERMINATE-CCVS. SG2034.2 +018600S EXIT PROGRAM. SG2034.2 +018700STERMINATE-CALL. SG2034.2 +018800 STOP RUN. SG2034.2 +018900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2034.2 +019000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2034.2 +019100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2034.2 +019200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2034.2 +019300 MOVE "****TEST DELETED****" TO RE-MARK. SG2034.2 +019400 PRINT-DETAIL. SG2034.2 +019500 IF REC-CT NOT EQUAL TO ZERO SG2034.2 +019600 MOVE "." TO PARDOT-X SG2034.2 +019700 MOVE REC-CT TO DOTVALUE. SG2034.2 +019800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2034.2 +019900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2034.2 +020000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2034.2 +020100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2034.2 +020200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2034.2 +020300 MOVE SPACE TO CORRECT-X. SG2034.2 +020400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2034.2 +020500 MOVE SPACE TO RE-MARK. SG2034.2 +020600 HEAD-ROUTINE. SG2034.2 +020700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +020800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2034.2 +020900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2034.2 +021000 COLUMN-NAMES-ROUTINE. SG2034.2 +021100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +021200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +021300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +021400 END-ROUTINE. SG2034.2 +021500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2034.2 +021600 END-RTN-EXIT. SG2034.2 +021700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +021800 END-ROUTINE-1. SG2034.2 +021900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2034.2 +022000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2034.2 +022100 ADD PASS-COUNTER TO ERROR-HOLD. SG2034.2 +022200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2034.2 +022300 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2034.2 +022400 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2034.2 +022500 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2034.2 +022600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2034.2 +022700 END-ROUTINE-12. SG2034.2 +022800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2034.2 +022900 IF ERROR-COUNTER IS EQUAL TO ZERO SG2034.2 +023000 MOVE "NO " TO ERROR-TOTAL SG2034.2 +023100 ELSE SG2034.2 +023200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2034.2 +023300 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2034.2 +023400 PERFORM WRITE-LINE. SG2034.2 +023500 END-ROUTINE-13. SG2034.2 +023600 IF DELETE-CNT IS EQUAL TO ZERO SG2034.2 +023700 MOVE "NO " TO ERROR-TOTAL ELSE SG2034.2 +023800 MOVE DELETE-CNT TO ERROR-TOTAL. SG2034.2 +023900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2034.2 +024000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024100 IF INSPECT-COUNTER EQUAL TO ZERO SG2034.2 +024200 MOVE "NO " TO ERROR-TOTAL SG2034.2 +024300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2034.2 +024400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2034.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024700 WRITE-LINE. SG2034.2 +024800 ADD 1 TO RECORD-COUNT. SG2034.2 +024900Y IF RECORD-COUNT GREATER 50 SG2034.2 +025000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2034.2 +025100Y MOVE SPACE TO DUMMY-RECORD SG2034.2 +025200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2034.2 +025300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2034.2 +025400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2034.2 +025500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2034.2 +025600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2034.2 +025700Y MOVE ZERO TO RECORD-COUNT. SG2034.2 +025800 PERFORM WRT-LN. SG2034.2 +025900 WRT-LN. SG2034.2 +026000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2034.2 +026100 MOVE SPACE TO DUMMY-RECORD. SG2034.2 +026200 BLANK-LINE-PRINT. SG2034.2 +026300 PERFORM WRT-LN. SG2034.2 +026400 FAIL-ROUTINE. SG2034.2 +026500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2034.2 +026600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2034.2 +026700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2034.2 +026800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +026900 GO TO FAIL-ROUTINE-EX. SG2034.2 +027000 FAIL-ROUTINE-WRITE. SG2034.2 +027100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2034.2 +027200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2034.2 +027300 FAIL-ROUTINE-EX. EXIT. SG2034.2 +027400 BAIL-OUT. SG2034.2 +027500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2034.2 +027600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2034.2 +027700 BAIL-OUT-WRITE. SG2034.2 +027800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2034.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +028000 BAIL-OUT-EX. EXIT. SG2034.2 +028100 CCVS1-EXIT. SG2034.2 +028200 EXIT. SG2034.2 +028300 50 SECTION 50. SG2034.2 +028400 PARA-50. SG2034.2 +028500 MOVE SPACE TO TEST-CHECK. SG2034.2 +028600 29 SECTION 29. SG2034.2 +028700 PARA-29. SG2034.2 +028800 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +028900* NOTE *******TEST 1 BEGINS HERE**********. SG2034.2 +029000 67 SECTION 67. SG2034.2 +029100 PARA-67. SG2034.2 +029200 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +029300 PERFORM PASS SG2034.2 +029400 GO TO WRITE-67. SG2034.2 +029500 MOVE "GOOD" TO CORRECT-A. SG2034.2 +029600 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +029700 PERFORM FAIL. SG2034.2 +029800 GO TO WRITE-67. SG2034.2 +029900 DELETE-67. SG2034.2 +030000 PERFORM DE-LETE. SG2034.2 +030100 WRITE-67. SG2034.2 +030200 MOVE "SEGM-TEST-01" TO PAR-NAME. SG2034.2 +030300 MOVE "TEST BEGINS IN PARA-67" TO RE-MARK. SG2034.2 +030400 MOVE "FALL THRU IND SEG" TO FEATURE. SG2034.2 +030500 PERFORM PRINT-DETAIL. SG2034.2 +030600* NOTE *******TEST 2 BEGINS HERE**********. SG2034.2 +030700 30 SECTION 30. SG2034.2 +030800 PARA-30. SG2034.2 +030900 MOVE SPACE TO TEST-CHECK. SG2034.2 +031000 51 SECTION 51. SG2034.2 +031100 PARA-51. SG2034.2 +031200 MOVE "BAD " TO TEST-CHECK. SG2034.2 +031300 52 SECTION 52. SG2034.2 +031400 PARA-52. SG2034.2 +031500 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +031600 31 SECTION 31. SG2034.2 +031700 PARA-31. SG2034.2 +031800 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +031900 PERFORM PASS SG2034.2 +032000 GO TO WRITE-31. SG2034.2 +032100 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +032200 MOVE "GOOD" TO CORRECT-A. SG2034.2 +032300 PERFORM FAIL. SG2034.2 +032400 GO TO WRITE-31. SG2034.2 +032500 DELETE-31. SG2034.2 +032600 PERFORM DE-LETE. SG2034.2 +032700 WRITE-31. SG2034.2 +032800 MOVE "SEGM-TEST-02" TO PAR-NAME. SG2034.2 +032900 MOVE "TEST BEGINS IN PARA-31" TO RE-MARK. SG2034.2 +033000 PERFORM PRINT-DETAIL. SG2034.2 +033100* NOTE *******TEST 3 BEGINS HERE**********. SG2034.2 +033200 53 SECTION 53. SG2034.2 +033300 PARA-53. SG2034.2 +033400 GO TO PARA-54. SG2034.2 +033500 99 SECTION 99. SG2034.2 +033600 PARA-99. SG2034.2 +033700 PERFORM PARA-32 THROUGH PARA-33 8 TIMES. SG2034.2 +033800 IF TEST-COUNTER EQUAL TO 8 SG2034.2 +033900 PERFORM PASS SG2034.2 +034000 GO TO WRITE-99. SG2034.2 +034100 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +034200 MOVE 8 TO CORRECT-N. SG2034.2 +034300 PERFORM FAIL. SG2034.2 +034400 GO TO WRITE-99. SG2034.2 +034500 DELETE-99. SG2034.2 +034600 PERFORM DE-LETE. SG2034.2 +034700 WRITE-99. SG2034.2 +034800 MOVE "SEGM-TEST-03" TO PAR-NAME. SG2034.2 +034900 MOVE "TEST BEGINS IN PARA-99" TO RE-MARK. SG2034.2 +035000 MOVE "PERFORM IND SEG " TO FEATURE. SG2034.2 +035100 PERFORM PRINT-DETAIL. SG2034.2 +035200* NOTE *******TEST 4 BEGINS HERE**********. SG2034.2 +035300 ALTER PARA-32 TO PARA-32A. SG2034.2 +035400 GO TO PARA-34. SG2034.2 +035500 54 SECTION 54. SG2034.2 +035600 PARA-54. SG2034.2 +035700 GO TO PARA-54A. SG2034.2 +035800 PARA-54A. SG2034.2 +035900 ALTER PARA-54 TO PROCEED TO PARA-54B. SG2034.2 +036000 GO TO PARA-54. SG2034.2 +036100 PARA-54B. SG2034.2 +036200 ALTER PARA-54 TO PROCEED TO PARA-54A. SG2034.2 +036300 GO TO PARA-99. SG2034.2 +036400 32 SECTION 32. SG2034.2 +036500 PARA-32. SG2034.2 +036600 GO TO PARA-32A. SG2034.2 +036700 PARA-32A. SG2034.2 +036800 ALTER PARA-32 TO PROCEED TO PARA-32C. SG2034.2 +036900 PARA-32B. SG2034.2 +037000 MOVE 16 TO TEST-COUNTER. SG2034.2 +037100 GO TO PARA-32. SG2034.2 +037200 PARA-32C. SG2034.2 +037300 SUBTRACT 1 FROM TEST-COUNTER. SG2034.2 +037400 33 SECTION 33. SG2034.2 +037500 PARA-33. SG2034.2 +037600 EXIT. SG2034.2 +037700 34 SECTION 34. SG2034.2 +037800 PARA-34. SG2034.2 +037900 GO TO PARA-34A. SG2034.2 +038000 PARA-34A. SG2034.2 +038100 ALTER PARA-34 TO PROCEED TO PARA-55. SG2034.2 +038200 GO TO PARA-32. SG2034.2 +038300 55 SECTION 55. SG2034.2 +038400 PARA-55. SG2034.2 +038500 IF TEST-COUNTER EQUAL TO 15 SG2034.2 +038600 PERFORM PASS SG2034.2 +038700 GO TO WRITE-55. SG2034.2 +038800 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +038900 MOVE 15 TO CORRECT-N. SG2034.2 +039000 PERFORM FAIL. SG2034.2 +039100 GO TO WRITE-55. SG2034.2 +039200 DELETE-55. SG2034.2 +039300 PERFORM DE-LETE. SG2034.2 +039400 WRITE-55. SG2034.2 +039500 MOVE "SEGM-TEST-04" TO PAR-NAME. SG2034.2 +039600 MOVE "TEST BEGINS IN PARA-55" TO RE-MARK. SG2034.2 +039700 MOVE "ALTER OVLY FIXED SEG" TO FEATURE. SG2034.2 +039800 PERFORM PRINT-DETAIL. SG2034.2 +039900* NOTE *******TEST 5 BEGINS HERE**********. SG2034.2 +040000 56 SECTION 56. SG2034.2 +040100 PARA-56. SG2034.2 +040200 ALTER PARA-34 TO PROCEED TO PARA-56A. SG2034.2 +040300 MOVE 5 TO TEST-COUNTER. SG2034.2 +040400 GO TO PARA-32C. SG2034.2 +040500 PARA-56A. SG2034.2 +040600 IF TEST-COUNTER EQUAL TO 4 SG2034.2 +040700 PERFORM PASS SG2034.2 +040800 GO TO WRITE-56. SG2034.2 +040900 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +041000 MOVE 4 TO CORRECT-N. SG2034.2 +041100 PERFORM FAIL. SG2034.2 +041200 GO TO WRITE-56. SG2034.2 +041300 DELETE-56. SG2034.2 +041400 PERFORM DE-LETE. SG2034.2 +041500 WRITE-56. SG2034.2 +041600 MOVE "SEGM-TEST-05" TO PAR-NAME. SG2034.2 +041700 MOVE "TEST BEGINS IN PARA-56" TO RE-MARK. SG2034.2 +041800 PERFORM PRINT-DETAIL. SG2034.2 +041900* NOTE *******TEST 6 BEGINS HERE**********. SG2034.2 +042000 57 SECTION 57. SG2034.2 +042100 PARA-57. SG2034.2 +042200 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +042300 ALTER PARA-00 TO PROCEED TO PARA-00B. SG2034.2 +042400 GO TO PARA-00. SG2034.2 +042500 PARA-00. SG2034.2 +042600 GO TO PARA-00A. SG2034.2 +042700 PARA-00A. SG2034.2 +042800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +042900 PARA-00B. SG2034.2 +043000* NOTE THIS PARAGRAPH SERVES NO PURPOSE OTHER THAN TO SG2034.2 +043100* VERIFY THAT FALLING THRU WILL NOT DISTURB PROGRAM FLOW. SG2034.2 +043200 59 SECTION 59. SG2034.2 +043300 PARA-59. SG2034.2 +043400* THIS SECTION SERVES NO PURPOSE EXCEPT TO VERIFY THAT SG2034.2 +043500* PROGRAM FLOW WILL NOT BE AFFECTED AND THE FOLLOWING SG2034.2 +043600* STATEMENT WILL BE IGNORED. SG2034.2 +043700 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +043800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +043900 01 SECTION 01. SG2034.2 +044000 PARA-01. SG2034.2 +044100 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +044200 PERFORM PASS SG2034.2 +044300 GO TO WRITE-01. SG2034.2 +044400 MOVE "GOOD" TO CORRECT-A. SG2034.2 +044500 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +044600 PERFORM FAIL. SG2034.2 +044700 GO TO WRITE-01. SG2034.2 +044800 DELETE-01. SG2034.2 +044900 PERFORM DE-LETE. SG2034.2 +045000 WRITE-01. SG2034.2 +045100 MOVE "SEGM-TEST-06" TO PAR-NAME. SG2034.2 +045200 MOVE "TEST BEGINS IN PARA-01" TO RE-MARK. SG2034.2 +045300 MOVE "FALL THRU IND SEG" TO FEATURE. SG2034.2 +045400 PERFORM PRINT-DETAIL. SG2034.2 +045500* NOTE *******TEST 7 BEGINS HERE**********. SG2034.2 +045600 02 SECTION 02. SG2034.2 +045700 PARA-02. SG2034.2 +045800 MOVE SPACE TO TEST-CHECK. SG2034.2 +045900 PERFORM 59. SG2034.2 +046000 IF TEST-CHECK EQUAL TO SPACE SG2034.2 +046100 PERFORM PASS SG2034.2 +046200 GO TO WRITE-02. SG2034.2 +046300 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +046400 MOVE SPACE TO CORRECT-A. SG2034.2 +046500 PERFORM FAIL. SG2034.2 +046600 GO TO WRITE-02. SG2034.2 +046700 DELETE-02. SG2034.2 +046800 PERFORM DE-LETE. SG2034.2 +046900 WRITE-02. SG2034.2 +047000 MOVE "SEGM-TEST-07" TO PAR-NAME. SG2034.2 +047100 MOVE "TEST BEGINS IN PARA-02" TO RE-MARK. SG2034.2 +047200 MOVE "PERFORM IND SEG" TO FEATURE. SG2034.2 +047300 PERFORM PRINT-DETAIL. SG2034.2 +047400* NOTE *******TEST 8 BEGINS HERE**********. SG2034.2 +047500 35 SECTION 35. SG2034.2 +047600 PARA-35. SG2034.2 +047700 ALTER PARA-34 TO PROCEED TO PARA-35A. SG2034.2 +047800 MOVE 1 TO TEST-COUNTER. SG2034.2 +047900 GO TO PARA-32. SG2034.2 +048000 PARA-35A. SG2034.2 +048100 IF TEST-COUNTER EQUAL TO ZERO SG2034.2 +048200 PERFORM PASS SG2034.2 +048300 GO TO WRITE-35. SG2034.2 +048400 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +048500 MOVE 0 TO CORRECT-N. SG2034.2 +048600 PERFORM FAIL. SG2034.2 +048700 GO TO WRITE-35. SG2034.2 +048800 DELETE-35. SG2034.2 +048900 PERFORM DE-LETE. SG2034.2 +049000 WRITE-35. SG2034.2 +049100 MOVE "SEGM-TEST-08" TO PAR-NAME. SG2034.2 +049200 MOVE "TEST BEGINS IN PARA-35" TO RE-MARK. SG2034.2 +049300 MOVE "ALTER OVLY FIXED SEG" TO FEATURE. SG2034.2 +049400 PERFORM PRINT-DETAIL. SG2034.2 +049500* NOTE *******TEST 9 BEGINS HERE**********. SG2034.2 +049600 36 SECTION 36. SG2034.2 +049700 PARA-36. SG2034.2 +049800 GO TO PARA-36A. SG2034.2 +049900 PARA-36A. SG2034.2 +050000 ALTER PARA-36 TO PROCEED TO PARA-36B. SG2034.2 +050100 MOVE SPACE TO TEST-CHECK. SG2034.2 +050200 GO TO 85. SG2034.2 +050300 PARA-36B. SG2034.2 +050400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +050500 PERFORM PASS SG2034.2 +050600 GO TO WRITE-36. SG2034.2 +050700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +050800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +050900 PERFORM FAIL. SG2034.2 +051000 GO TO WRITE-36. SG2034.2 +051100 DELETE-36. SG2034.2 +051200 PERFORM DE-LETE. SG2034.2 +051300 WRITE-36. SG2034.2 +051400 MOVE "SEGM-TEST-09" TO PAR-NAME. SG2034.2 +051500 MOVE "TEST BEGINS IN PARA-36" TO RE-MARK. SG2034.2 +051600 MOVE "GO TO NON-RES SEG" TO FEATURE. SG2034.2 +051700 PERFORM PRINT-DETAIL. SG2034.2 +051800* NOTE *******TEST 10 BEGINS HERE*********. SG2034.2 +051900 GO TO PARA-58. SG2034.2 +052000 85 SECTION 85. SG2034.2 +052100 PARA-85. SG2034.2 +052200 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +052300 GO TO 36. SG2034.2 +052400 98 SECTION 98. SG2034.2 +052500 PARA-98. SG2034.2 +052600 MOVE "GOOD" TO TEST-CHECK SG2034.2 +052700 GO TO PARA-37. SG2034.2 +052800 58 SECTION 58. SG2034.2 +052900 PARA-58. SG2034.2 +053000 MOVE SPACE TO TEST-CHECK. SG2034.2 +053100 PARA-58A. SG2034.2 +053200 GO TO PARA-58B. SG2034.2 +053300 PARA-58B. SG2034.2 +053400 MOVE "BAD " TO TEST-CHECK. SG2034.2 +053500 GO TO PARA-58D. SG2034.2 +053600 PARA-58C. SG2034.2 +053700 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +053800 GO TO PARA-58E. SG2034.2 +053900 PARA-58D. SG2034.2 +054000 ALTER PARA-58A TO PARA-58C. SG2034.2 +054100 PARA-58E. SG2034.2 +054200 EXIT. SG2034.2 +054300 37 SECTION 37. SG2034.2 +054400 PARA-37. SG2034.2 +054500 PERFORM PARA-58A THRU PARA-58E. SG2034.2 +054600 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +054700 PERFORM PASS SG2034.2 +054800 GO TO WRITE-37. SG2034.2 +054900 MOVE "BAD " TO CORRECT-A. SG2034.2 +055000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +055100 PERFORM FAIL. SG2034.2 +055200 GO TO WRITE-37. SG2034.2 +055300 DELETE-37. SG2034.2 +055400 PERFORM DE-LETE. SG2034.2 +055500 WRITE-37. SG2034.2 +055600 MOVE "SEGM-TEST-10" TO PAR-NAME. SG2034.2 +055700 MOVE "TEST BEGINS IN PARA-37" TO RE-MARK. SG2034.2 +055800 MOVE "INITIAL STATE" TO FEATURE. SG2034.2 +055900 PERFORM PRINT-DETAIL. SG2034.2 +056000* NOTE *******TEST 11 BEGINS HERE*********. SG2034.2 +056100 38 SECTION 38. SG2034.2 +056200 PARA-38. SG2034.2 +056300 PERFORM PARA-58D. SG2034.2 +056400 PERFORM PARA-58A THRU PARA-58E. SG2034.2 +056500 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +056600 PERFORM PASS SG2034.2 +056700 GO TO WRITE-38. SG2034.2 +056800 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +056900 MOVE "BAD " TO CORRECT-A. SG2034.2 +057000 PERFORM FAIL. SG2034.2 +057100 GO TO WRITE-38. SG2034.2 +057200 DELETE-38. SG2034.2 +057300 PERFORM DE-LETE. SG2034.2 +057400 WRITE-38. SG2034.2 +057500 MOVE "SEGM-TEST-11" TO PAR-NAME. SG2034.2 +057600 MOVE "TEST BEGINS IN PARA-38" TO RE-MARK. SG2034.2 +057700 PERFORM PRINT-DETAIL. SG2034.2 +057800* NOTE *******TEST 12 BEGINS HERE*********. SG2034.2 +057900 03 SECTION 03. SG2034.2 +058000 PARA-03. SG2034.2 +058100 MOVE SPACE TO TEST-CHECK. SG2034.2 +058200 PERFORM PARA-39D. SG2034.2 +058300 PERFORM PARA-39A THROUGH PARA-39E. SG2034.2 +058400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +058500 PERFORM PASS SG2034.2 +058600 GO TO WRITE-03. SG2034.2 +058700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +058800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +058900 PERFORM FAIL. SG2034.2 +059000 GO TO WRITE-03. SG2034.2 +059100 DELETE-03. SG2034.2 +059200 PERFORM DE-LETE. SG2034.2 +059300 WRITE-03. SG2034.2 +059400 MOVE "SEGM-TEST-12" TO PAR-NAME. SG2034.2 +059500 MOVE "TEST BEGINS IN PARA-03" TO RE-MARK. SG2034.2 +059600 MOVE "LAST USED STATE" TO FEATURE. SG2034.2 +059700 PERFORM PRINT-DETAIL. SG2034.2 +059800* NOTE *******TEST 13 BEGINS HERE*********. SG2034.2 +059900 39 SECTION 39. SG2034.2 +060000 PARA-39A. SG2034.2 +060100 GO TO PARA-39B. SG2034.2 +060200 PARA-39B. SG2034.2 +060300 MOVE "BAD " TO TEST-CHECK. SG2034.2 +060400 GO TO PARA-39D. SG2034.2 +060500 PARA-39C. SG2034.2 +060600 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +060700 GO TO PARA-39E. SG2034.2 +060800 PARA-39D. SG2034.2 +060900 ALTER PARA-39A TO PARA-39C. SG2034.2 +061000 PARA-39E. SG2034.2 +061100 EXIT. SG2034.2 +061200 04 SECTION 04. SG2034.2 +061300 PARA-04. SG2034.2 +061400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +061500 PERFORM PASS SG2034.2 +061600 GO TO WRITE-04. SG2034.2 +061700 MOVE "GOOD" TO CORRECT-A. SG2034.2 +061800 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +061900 PERFORM FAIL. SG2034.2 +062000 GO TO WRITE-04. SG2034.2 +062100 DELETE-04. SG2034.2 +062200 PERFORM DE-LETE. SG2034.2 +062300 WRITE-04. SG2034.2 +062400 MOVE "SEGM-TEST-13" TO PAR-NAME. SG2034.2 +062500 MOVE "TEST BEGINS IN PARA-04" TO RE-MARK. SG2034.2 +062600 PERFORM PRINT-DETAIL. SG2034.2 +062700* NOTE *******TEST 14 BEGINS HERE*********. SG2034.2 +062800 MOVE SPACE TO TEST-CHECK. SG2034.2 +062900 MOVE 0 TO TEST-COUNTER. SG2034.2 +063000 40 SECTION 40. SG2034.2 +063100 PARA-40. SG2034.2 +063200 GO TO PARA-68. SG2034.2 +063300 PARA-40A. SG2034.2 +063400 GO TO PARA-68. SG2034.2 +063500 PARA-40B. SG2034.2 +063600 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +063700 PERFORM PASS SG2034.2 +063800 GO TO WRITE-40. SG2034.2 +063900 MOVE "GOOD" TO CORRECT-A. SG2034.2 +064000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +064100 PERFORM FAIL. SG2034.2 +064200 GO TO WRITE-40. SG2034.2 +064300 DELETE-40. SG2034.2 +064400 PERFORM DE-LETE. SG2034.2 +064500 WRITE-40. SG2034.2 +064600 MOVE "SEGM-TEST-14" TO PAR-NAME. SG2034.2 +064700 MOVE "TEST BEGINS IN PARA-40B" TO RE-MARK. SG2034.2 +064800 MOVE "INITIAL STATE" TO FEATURE. SG2034.2 +064900 PERFORM PRINT-DETAIL. SG2034.2 +065000* NOTE *******TEST 15 BEGINS HERE*********. SG2034.2 +065100 MOVE SPACE TO TEST-CHECK. SG2034.2 +065200 IF TEST-COUNTER EQUAL TO 2 GO TO PARA-68C. SG2034.2 +065300* NOTE ***** THE PREVIOUS IF STMT WAS INSERTED TO KEEP TEST-14 SG2034.2 +065400* FROM LOOPING IF SEGMENT 68 WAS NOT IN THE INITIAL STATE SG2034.2 +065500* EACH TIME IT WAS ENTERED -- TEST-15 WILL ALSO FAIL SG2034.2 +065600* IN THIS CASE *****. SG2034.2 +065700 MOVE 2 TO TEST-COUNTER. SG2034.2 +065800* NOTE FALL THRU. SG2034.2 +065900 68 SECTION 68. SG2034.2 +066000 PARA-68. SG2034.2 +066100 GO TO PARA-68A. SG2034.2 +066200 PARA-68A. SG2034.2 +066300 ALTER PARA-68 TO PROCEED TO PARA-68B. SG2034.2 +066400 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +066500 IF TEST-COUNTER EQUAL TO 0 SG2034.2 +066600 ADD 1 TO TEST-COUNTER SG2034.2 +066700 GO TO PARA-40A. SG2034.2 +066800 IF TEST-COUNTER EQUAL TO 1 GO TO PARA-40B. SG2034.2 +066900 GO TO PARA-68C. SG2034.2 +067000 PARA-68B. SG2034.2 +067100 MOVE "BAD " TO TEST-CHECK. SG2034.2 +067200 ADD 1 TO TEST-COUNTER. SG2034.2 +067300 GO TO PARA-40B. SG2034.2 +067400 PARA-68C. SG2034.2 +067500 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +067600 PERFORM PASS SG2034.2 +067700 GO TO WRITE-68. SG2034.2 +067800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +067900 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +068000 PERFORM FAIL. SG2034.2 +068100 GO TO WRITE-68. SG2034.2 +068200 DELETE-68. SG2034.2 +068300 PERFORM DE-LETE. SG2034.2 +068400 WRITE-68. SG2034.2 +068500 MOVE "SEGM-TEST-15" TO PAR-NAME. SG2034.2 +068600 MOVE "TEST BEGINS IN PARA-68C" TO RE-MARK. SG2034.2 +068700 PERFORM PRINT-DETAIL. SG2034.2 +068800 41 SECTION 41. SG2034.2 +068900 PARA-41A. SG2034.2 +069000 MOVE SPACE TO TEST-CHECK. SG2034.2 +069100* NOTE ***** TEST 16 BEGINS HERE *****. SG2034.2 +069200 PERFORM TEST-16. SG2034.2 +069300 ALTER PARA-41B TO PARA-41D. SG2034.2 +069400 PERFORM PARA-41B THRU PARA-41E. SG2034.2 +069500 PERFORM TEST-16. SG2034.2 +069600 IF TEST-CHECK EQUAL TO "END" SG2034.2 +069700 PERFORM PASS SG2034.2 +069800 GO TO WRITE-41. SG2034.2 +069900 MOVE "END " TO CORRECT-A. SG2034.2 +070000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +070100 PERFORM FAIL. SG2034.2 +070200 GO TO WRITE-41. SG2034.2 +070300 DELETE-41. SG2034.2 +070400 PERFORM DE-LETE. SG2034.2 +070500 WRITE-41. SG2034.2 +070600 MOVE "SEGM-TEST-16" TO PAR-NAME. SG2034.2 +070700 MOVE "TEST BEGINS IN PARA-41A" TO RE-MARK. SG2034.2 +070800 PERFORM PRINT-DETAIL. SG2034.2 +070900 GO TO 45. SG2034.2 +071000 TEST-16 SECTION 41. SG2034.2 +071100 PARA-41B. SG2034.2 +071200 GO TO PARA-41C. SG2034.2 +071300 PARA-41C. SG2034.2 +071400 MOVE "PFM1" TO TEST-CHECK. SG2034.2 +071500 GO TO PARA-41E. SG2034.2 +071600 PARA-41D. SG2034.2 +071700 MOVE "ALT1" TO TEST-CHECK. SG2034.2 +071800 ALTER PARA-41B TO PARA-41F. SG2034.2 +071900 GO TO TEST-16. SG2034.2 +072000 PARA-41F. SG2034.2 +072100 MOVE "END " TO TEST-CHECK. SG2034.2 +072200 GO TO PARA-41E. SG2034.2 +072300 PARA-41E. SG2034.2 +072400 EXIT. SG2034.2 +072500 TEST-16A SECTION 41. SG2034.2 +072600 61DUMMY. SG2034.2 +072700 EXIT. SG2034.2 +072800 45 SECTION 45. SG2034.2 +072900 PARA-45A. SG2034.2 +073000 MOVE SPACE TO TEST-CHECK. SG2034.2 +073100* NOTE ***** TEST 17 BEGINS HERE *****. SG2034.2 +073200 PERFORM PARA-45C. SG2034.2 +073300* NOTE PERFORM PARAGRAPH THAT ALTERS A PARAGRAPH IN A UNIQUE SG2034.2 +073400* SEGMENT CONTAINING THE SAME PRIORITY NUMBER. SG2034.2 +073500 PERFORM 45A THRU 45B. SG2034.2 +073600* NOTE THE WRITE PARAGRAPH FOR THIS TEST IS IN SEGMENT 46. SG2034.2 +073700 GO TO 45A. SG2034.2 +073800 DELETE-45. SG2034.2 +073900 PERFORM DE-LETE. SG2034.2 +074000 GO TO WRITE-46. SG2034.2 +074100 45A SECTION 45. SG2034.2 +074200 PARA-45B. SG2034.2 +074300 GO TO PARA-45D. SG2034.2 +074400 45B SECTION 45. SG2034.2 +074500 PARA-45C. SG2034.2 +074600 ALTER PARA-45B TO PROCEED TO PARA-45E. SG2034.2 +074700 PARA-45D. SG2034.2 +074800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +074900 GO TO PARA-45G. SG2034.2 +075000 PARA-45E. SG2034.2 +075100 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +075200 ALTER PARA-45B TO PROCEED TO PARA-45F. SG2034.2 +075300 GO TO PARA-45G. SG2034.2 +075400 PARA-45F. SG2034.2 +075500 MOVE "BETR" TO TEST-CHECK. SG2034.2 +075600* NOTE THE GO TO STMT IN PARA-45A SHOULD SHIFT CONTROL THRU SG2034.2 +075700* THIS PARAGRAPH AND FALL THRU TO THE EXIT FOLLOWED BY THE SG2034.2 +075800* COMPARISON OF TEST-CHECK. SG2034.2 +075900 PARA-45G. SG2034.2 +076000 EXIT. SG2034.2 +076100 46 SECTION 46. SG2034.2 +076200 PARA-46. SG2034.2 +076300 IF TEST-CHECK EQUAL TO "BETR" SG2034.2 +076400 PERFORM PASS SG2034.2 +076500 GO TO WRITE-46. SG2034.2 +076600 MOVE "BETR" TO CORRECT-A. SG2034.2 +076700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +076800 PERFORM FAIL. SG2034.2 +076900 WRITE-46. SG2034.2 +077000 MOVE "SEGM-TEST-17" TO PAR-NAME. SG2034.2 +077100 MOVE "TEST BEGINS IN PARA-46" TO RE-MARK. SG2034.2 +077200 PERFORM PRINT-DETAIL. SG2034.2 +077300 TEST-18 SECTION 47. SG2034.2 +077400 PARA-47. SG2034.2 +077500 MOVE SPACE TO TEST-CHECK. SG2034.2 +077600* NOTE ************** TEST 18 BEGINS HERE ***************. SG2034.2 +077700 ALTER PARA-05 TO PROCEED TO 69. SG2034.2 +077800 GO TO 05. SG2034.2 +077900 05 SECTION 05. SG2034.2 +078000 PARA-05. SG2034.2 +078100 GO TO. SG2034.2 +078200 PARA-05A. SG2034.2 +078300 MOVE "BAD" TO COMPUTED-A. SG2034.2 +078400 PERFORM FAIL. SG2034.2 +078500 GO TO WRITE-69. SG2034.2 +078600 69 SECTION 69. SG2034.2 +078700 PARA-69. SG2034.2 +078800 PERFORM PASS. SG2034.2 +078900 WRITE-69. SG2034.2 +079000 MOVE "ALTER RES TO NON-RES" TO FEATURE. SG2034.2 +079100 MOVE "SEGM-TEST-18" TO PAR-NAME. SG2034.2 +079200 MOVE "TEST BEGINS IN PARA-47" TO RE-MARK. SG2034.2 +079300 PERFORM PRINT-DETAIL. SG2034.2 +079400 GO TO CLOSE-FILES. SG2034.2 +*END-OF,SG203A +*HEADER,COBOL,SG204A +000100 IDENTIFICATION DIVISION. SG2044.2 +000200 PROGRAM-ID. SG2044.2 +000300 SG204A. SG2044.2 +000400 AUTHOR. SG2044.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2044.2 +000600 INSTALLATION. SG2044.2 +000700 GENERAL SERVICES ADMINISTRATION SG2044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2044.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2044.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2044.2 +001200 SG2044.2 +001300 PHONE (703) 756-6153 SG2044.2 +001400 SG2044.2 +001500 " HIGH ". SG2044.2 +001600 DATE-WRITTEN. SG2044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2044.2 +001800 CREATION DATE / VALIDATION DATE SG2044.2 +001900 "4.2 ". SG2044.2 +002000 SECURITY. SG2044.2 +002100 NONE. SG2044.2 +002200 THIS PROGRAM CONTAINS 3 SORTS USING NUMERIC OR ALPHABETIC SG2044.2 +002300 KEYS - BUT NOT BOTH IN THE SAME KEY DUE TO DIFFERING SG2044.2 +002400 COLLATING SEQUENCES AMONG COMPUTERS. EXTERNAL FILES ARE SG2044.2 +002500 GENERATED INTERNALLY FOR SUBSEQUENT USE. THE SELECT CLAUSE SG2044.2 +002600 IS HIGHLY DEPENDENT ON HARDWARE. THE USER SHOULD EXERCISE THESG2044.2 +002700 VARIOUS OPTIONS OF HARDWARE ASSIGNMENTS TO THE EXTENT THEY SG2044.2 +002800 ARE AVAILABLE. THE SORT OF A MULTI-REEL FILE IS EXERCISED SG2044.2 +002900 IN PROGRAM ST202. HOWEVER THE EXERCISE OF THE "FOR MULTIPLE SG2044.2 +003000 REEL-UNIT" OF THE GIVING OPTION IS NOT DUE TO THE INDETER- SG2044.2 +003100 MINATE LENGTH OF SUCH A FILE (E.G. RECORDING DENSITY OR SIZE SG2044.2 +003200 OF UNIT) AND PROCESSING COST. SORT INPUT-OUTPUT OPTIONS SG2044.2 +003300 WILL BE EXERCISED AS FOLLOWS. SG2044.2 +003400 SORT 1 USING GIVING SG2044.2 +003500 SORT 2 INPUT PROC GIVING SG2044.2 +003600 SORT 3 INPUT PROC OUTPUT PROC SG2044.2 +003700 THIS PROGRAM ALSO EXERCISES THE "SAME RECORD AREA" CLAUSE. SG2044.2 +003800 SG2044.2 +003900 ENVIRONMENT DIVISION. SG2044.2 +004000 CONFIGURATION SECTION. SG2044.2 +004100 SOURCE-COMPUTER. SG2044.2 +004200 XXXXX082. SG2044.2 +004300 OBJECT-COMPUTER. SG2044.2 +004400 XXXXX083. SG2044.2 +004500 INPUT-OUTPUT SECTION. SG2044.2 +004600 FILE-CONTROL. SG2044.2 +004700 SELECT PRINT-FILE ASSIGN TO SG2044.2 +004800 XXXXX055. SG2044.2 +004900 SELECT SORT1 ASSIGN TO SG2044.2 +005000 XXXXX027. SG2044.2 +005100 SELECT SORT2 ASSIGN TO SG2044.2 +005200 XXXXX028. SG2044.2 +005300 SELECT SORT3 ASSIGN TO SG2044.2 +005400 XXXXX029. SG2044.2 +005500 SELECT FILE1 ASSIGN TO SG2044.2 +005600 XXXXX001. SG2044.2 +005700 SELECT FILE2 ASSIGN TO SG2044.2 +005800 XXXXX014 SG2044.2 +005900 RESERVE 1 AREA. SG2044.2 +006000 SELECT FILE3 ASSIGN TO SG2044.2 +006100 XXXXX015 SG2044.2 +006200 RESERVE 4 AREAS. SG2044.2 +006300 I-O-CONTROL. SG2044.2 +006400 SAME RECORD AREA FOR SORT1 SORT2 SG2044.2 +006500 SAME RECORD AREA FOR SORT3 FILE3. SG2044.2 +006600 DATA DIVISION. SG2044.2 +006700 FILE SECTION. SG2044.2 +006800 FD PRINT-FILE SG2044.2 +006900 LABEL RECORDS SG2044.2 +007000 XXXXX084 SG2044.2 +007100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2044.2 +007200 01 PRINT-REC PICTURE X(120). SG2044.2 +007300 01 DUMMY-RECORD PICTURE X(120). SG2044.2 +007400 FD FILE1 SG2044.2 +007500 LABEL RECORDS ARE STANDARD SG2044.2 +007600 VALUE OF SG2044.2 +007700 XXXXX074 SG2044.2 +007800 IS SG2044.2 +007900 XXXXX075 SG2044.2 +008000 BLOCK CONTAINS 10 RECORDS SG2044.2 +008100 DATA RECORD R1. SG2044.2 +008200 01 R1. SG2044.2 +008300 02 FILLER PICTURE X(120). SG2044.2 +008400 FD FILE2 SG2044.2 +008500 LABEL RECORDS ARE STANDARD SG2044.2 +008600 VALUE OF SG2044.2 +008700 XXXXX074 SG2044.2 +008800 IS SG2044.2 +008900 XXXXX076 SG2044.2 +009000 BLOCK CONTAINS 10 RECORDS SG2044.2 +009100 DATA RECORD R2. SG2044.2 +009200 01 R2. SG2044.2 +009300 02 R2-KEYS. SG2044.2 +009400 03 R2-1 PICTURE 999. SG2044.2 +009500 03 R2-2 PICTURE AA. SG2044.2 +009600 03 R2-3 PICTURE AA. SG2044.2 +009700 02 FILLER PICTURE X(113). SG2044.2 +009800 FD FILE3 SG2044.2 +009900 BLOCK CONTAINS 10 RECORDS SG2044.2 +010000 LABEL RECORDS ARE STANDARD SG2044.2 +010100 VALUE OF SG2044.2 +010200 XXXXX074 SG2044.2 +010300 IS SG2044.2 +010400 XXXXX077 SG2044.2 +010500 DATA RECORD IS R3. SG2044.2 +010600 01 R3. SG2044.2 +010700 02 R3-KEYS. SG2044.2 +010800 03 R3-1 PICTURE 999. SG2044.2 +010900 03 R3-2 PICTURE AA. SG2044.2 +011000 03 R3-3 PICTURE AA. SG2044.2 +011100 03 R3-4 PICTURE 9999. SG2044.2 +011200 02 FILLER PICTURE X(109). SG2044.2 +011300 SD SORT1 SG2044.2 +011400 RECORD CONTAINS 120 CHARACTERS SG2044.2 +011500 DATA RECORD IS S1. SG2044.2 +011600 01 S1. SG2044.2 +011700 02 S1-KEYS. SG2044.2 +011800 03 S1-1 PICTURE 999. SG2044.2 +011900 03 S1-2 PICTURE AA. SG2044.2 +012000 02 FILLER PICTURE X(115). SG2044.2 +012100 SD SORT2 SG2044.2 +012200 RECORD 120 SG2044.2 +012300 DATA RECORD IS S2. SG2044.2 +012400 01 S2. SG2044.2 +012500 02 S2-KEYS. SG2044.2 +012600 03 S2-1 PICTURE 999. SG2044.2 +012700 03 S2-2 PICTURE AA. SG2044.2 +012800 03 S2-3 PICTURE AA. SG2044.2 +012900 02 FILLER PICTURE X(113). SG2044.2 +013000 SD SORT3 SG2044.2 +013100 RECORD 120 CHARACTERS SG2044.2 +013200 DATA RECORD S3. SG2044.2 +013300 01 S3. SG2044.2 +013400 02 S3-KEYS. SG2044.2 +013500 03 S3-1 PICTURE 999. SG2044.2 +013600 03 S3-2 PICTURE AA. SG2044.2 +013700 03 S3-3 PICTURE AA. SG2044.2 +013800 03 S3-4 PICTURE 9999. SG2044.2 +013900 02 FILLER PICTURE X(109). SG2044.2 +014000 WORKING-STORAGE SECTION. SG2044.2 +014100 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. SG2044.2 +014200 77 C0 PICTURE 99 COMPUTATIONAL VALUE ZERO. SG2044.2 +014300 77 C1 PICTURE 99 COMPUTATIONAL VALUE 1. SG2044.2 +014400 77 CA PICTURE A VALUE "A". SG2044.2 +014500 77 CB PICTURE A VALUE "B". SG2044.2 +014600 01 ALPHA-TABLE. SG2044.2 +014700 02 ALPHA-TAB PICTURE IS A(25) VALUE IS "ABCDEFGHIJKLMNPQRSTUSG2044.2 +014800- "VWXYZ". SG2044.2 +014900 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. SG2044.2 +015000 01 W-KEYS. SG2044.2 +015100 02 W-S3-KEYS. SG2044.2 +015200 03 W-S2-KEYS. SG2044.2 +015300 04 W-S1-KEYS. SG2044.2 +015400 05 S1-1W PICTURE 999 VALUE 567. SG2044.2 +015500 05 S1-2W. SG2044.2 +015600 06 S1-2W-A PICTURE A. SG2044.2 +015700 06 S1-2W-B PICTURE A. SG2044.2 +015800 04 S2-3W. SG2044.2 +015900 05 S2-3W-A PICTURE A. SG2044.2 +016000 05 S2-3W-B PICTURE A. SG2044.2 +016100 03 S3-4W PICTURE 9999 VALUE 7051. SG2044.2 +016200 01 TEST-RESULTS. SG2044.2 +016300 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2044.2 +016500 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2044.2 +016700 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016800 02 PAR-NAME. SG2044.2 +016900 03 FILLER PICTURE X(12) VALUE SPACE. SG2044.2 +017000 03 PARDOT-X PICTURE X VALUE SPACE. SG2044.2 +017100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2044.2 +017200 03 FILLER PIC X(5) VALUE SPACE. SG2044.2 +017300 02 FILLER PIC X(10) VALUE SPACE. SG2044.2 +017400 02 RE-MARK PIC X(61). SG2044.2 +017500 01 TEST-COMPUTED. SG2044.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SG2044.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2044.2 +017800 02 COMPUTED-X. SG2044.2 +017900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2044.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2044.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2044.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2044.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2044.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SG2044.2 +018500 04 COMPUTED-18V0 PICTURE -9(18). SG2044.2 +018600 04 FILLER PICTURE X. SG2044.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SG2044.2 +018800 01 TEST-CORRECT. SG2044.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SG2044.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2044.2 +019100 02 CORRECT-X. SG2044.2 +019200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2044.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2044.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2044.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2044.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2044.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SG2044.2 +019800 04 CORRECT-18V0 PICTURE -9(18). SG2044.2 +019900 04 FILLER PICTURE X. SG2044.2 +020000 03 FILLER PIC X(50) VALUE SPACE. SG2044.2 +020100 01 CCVS-C-1. SG2044.2 +020200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2044.2 +020300- "SS PARAGRAPH-NAME SG2044.2 +020400- " REMARKS". SG2044.2 +020500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2044.2 +020600 01 CCVS-C-2. SG2044.2 +020700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +020800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2044.2 +020900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2044.2 +021000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2044.2 +021100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2044.2 +021200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2044.2 +021300 01 REC-CT PICTURE 99 VALUE ZERO. SG2044.2 +021400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2044.2 +021500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2044.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2044.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2044.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2044.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2044.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2044.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2044.2 +022200 01 CCVS-H-1. SG2044.2 +022300 02 FILLER PICTURE X(27) VALUE SPACE. SG2044.2 +022400 02 FILLER PICTURE X(67) VALUE SG2044.2 +022500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2044.2 +022600- " SYSTEM". SG2044.2 +022700 02 FILLER PICTURE X(26) VALUE SPACE. SG2044.2 +022800 01 CCVS-H-2. SG2044.2 +022900 02 FILLER PICTURE X(52) VALUE IS SG2044.2 +023000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2044.2 +023100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2044.2 +023200 02 TEST-ID PICTURE IS X(9). SG2044.2 +023300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2044.2 +023400 01 CCVS-H-3. SG2044.2 +023500 02 FILLER PICTURE X(34) VALUE SG2044.2 +023600 " FOR OFFICIAL USE ONLY ". SG2044.2 +023700 02 FILLER PICTURE X(58) VALUE SG2044.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2044.2 +023900 02 FILLER PICTURE X(28) VALUE SG2044.2 +024000 " COPYRIGHT 1974 ". SG2044.2 +024100 01 CCVS-E-1. SG2044.2 +024200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2044.2 +024300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2044.2 +024400 02 ID-AGAIN PICTURE IS X(9). SG2044.2 +024500 02 FILLER PICTURE X(45) VALUE IS SG2044.2 +024600 " NTIS DISTRIBUTION COBOL 74". SG2044.2 +024700 01 CCVS-E-2. SG2044.2 +024800 02 FILLER PICTURE X(31) VALUE SG2044.2 +024900 SPACE. SG2044.2 +025000 02 FILLER PICTURE X(21) VALUE SPACE. SG2044.2 +025100 02 CCVS-E-2-2. SG2044.2 +025200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2044.2 +025300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +025400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2044.2 +025500 01 CCVS-E-3. SG2044.2 +025600 02 FILLER PICTURE X(22) VALUE SG2044.2 +025700 " FOR OFFICIAL USE ONLY". SG2044.2 +025800 02 FILLER PICTURE X(12) VALUE SPACE. SG2044.2 +025900 02 FILLER PICTURE X(58) VALUE SG2044.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2044.2 +026100 02 FILLER PICTURE X(13) VALUE SPACE. SG2044.2 +026200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2044.2 +026300 01 CCVS-E-4. SG2044.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2044.2 +026500 02 FILLER PIC XXXX VALUE " OF ". SG2044.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2044.2 +026700 02 FILLER PIC X(40) VALUE SG2044.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2044.2 +026900 01 XXINFO. SG2044.2 +027000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2044.2 +027100 02 INFO-TEXT. SG2044.2 +027200 04 FILLER PIC X(20) VALUE SPACE. SG2044.2 +027300 04 XXCOMPUTED PIC X(20). SG2044.2 +027400 04 FILLER PIC X(5) VALUE SPACE. SG2044.2 +027500 04 XXCORRECT PIC X(20). SG2044.2 +027600 01 HYPHEN-LINE. SG2044.2 +027700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +027800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2044.2 +027900- "*****************************************". SG2044.2 +028000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2044.2 +028100- "******************************". SG2044.2 +028200 01 CCVS-PGM-ID PIC X(6) VALUE SG2044.2 +028300 "SG204A". SG2044.2 +028400 PROCEDURE DIVISION. SG2044.2 +028500 CCVS1 SECTION. SG2044.2 +028600 OPEN-FILES. SG2044.2 +028700 OPEN OUTPUT PRINT-FILE. SG2044.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2044.2 +028900 MOVE SPACE TO TEST-RESULTS. SG2044.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2044.2 +029100 GO TO CCVS1-EXIT. SG2044.2 +029200 CLOSE-FILES. SG2044.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2044.2 +029400 TERMINATE-CCVS. SG2044.2 +029500S EXIT PROGRAM. SG2044.2 +029600STERMINATE-CALL. SG2044.2 +029700 STOP RUN. SG2044.2 +029800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +029900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +030000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +030100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +030200 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +030300 PRINT-DETAIL. SG2044.2 +030400 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +030500 MOVE "." TO PARDOT-X SG2044.2 +030600 MOVE REC-CT TO DOTVALUE. SG2044.2 +030700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2044.2 +030800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2044.2 +030900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2044.2 +031000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2044.2 +031100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +031200 MOVE SPACE TO CORRECT-X. SG2044.2 +031300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +031400 MOVE SPACE TO RE-MARK. SG2044.2 +031500 HEAD-ROUTINE. SG2044.2 +031600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +031700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2044.2 +031800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2044.2 +031900 COLUMN-NAMES-ROUTINE. SG2044.2 +032000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +032100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +032300 END-ROUTINE. SG2044.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2044.2 +032500 END-RTN-EXIT. SG2044.2 +032600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +032700 END-ROUTINE-1. SG2044.2 +032800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2044.2 +032900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2044.2 +033000 ADD PASS-COUNTER TO ERROR-HOLD. SG2044.2 +033100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2044.2 +033200 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2044.2 +033300 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2044.2 +033400 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2044.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2044.2 +033600 END-ROUTINE-12. SG2044.2 +033700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2044.2 +033800 IF ERROR-COUNTER IS EQUAL TO ZERO SG2044.2 +033900 MOVE "NO " TO ERROR-TOTAL SG2044.2 +034000 ELSE SG2044.2 +034100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2044.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2044.2 +034300 PERFORM WRITE-LINE. SG2044.2 +034400 END-ROUTINE-13. SG2044.2 +034500 IF DELETE-CNT IS EQUAL TO ZERO SG2044.2 +034600 MOVE "NO " TO ERROR-TOTAL ELSE SG2044.2 +034700 MOVE DELETE-CNT TO ERROR-TOTAL. SG2044.2 +034800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2044.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035000 IF INSPECT-COUNTER EQUAL TO ZERO SG2044.2 +035100 MOVE "NO " TO ERROR-TOTAL SG2044.2 +035200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2044.2 +035300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2044.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035600 WRITE-LINE. SG2044.2 +035700 ADD 1 TO RECORD-COUNT. SG2044.2 +035800Y IF RECORD-COUNT GREATER 50 SG2044.2 +035900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +036000Y MOVE SPACE TO DUMMY-RECORD SG2044.2 +036100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +036200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2044.2 +036300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2044.2 +036400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2044.2 +036500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +036600Y MOVE ZERO TO RECORD-COUNT. SG2044.2 +036700 PERFORM WRT-LN. SG2044.2 +036800 WRT-LN. SG2044.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +037000 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +037100 BLANK-LINE-PRINT. SG2044.2 +037200 PERFORM WRT-LN. SG2044.2 +037300 FAIL-ROUTINE. SG2044.2 +037400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2044.2 +037500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2044.2 +037600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +037700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +037800 GO TO FAIL-ROUTINE-EX. SG2044.2 +037900 FAIL-ROUTINE-WRITE. SG2044.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2044.2 +038100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2044.2 +038200 FAIL-ROUTINE-EX. EXIT. SG2044.2 +038300 BAIL-OUT. SG2044.2 +038400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2044.2 +038500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2044.2 +038600 BAIL-OUT-WRITE. SG2044.2 +038700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +038900 BAIL-OUT-EX. EXIT. SG2044.2 +039000 CCVS1-EXIT. SG2044.2 +039100 EXIT. SG2044.2 +039200 P1-CREATE-F1. SG2044.2 +039300 OPEN OUTPUT FILE1. SG2044.2 +039400 MOVE CA TO S1-2W-A. SG2044.2 +039500 MOVE CB TO S2-3W-A. SG2044.2 +039600 P2-CREATE-F1. SG2044.2 +039700 PERFORM P4-CREATE-F1 2 TIMES. SG2044.2 +039800 P3-CREATE-F1. SG2044.2 +039900 MOVE CA TO S2-3W-A. SG2044.2 +040000 PERFORM P4-CREATE-F1 2 TIMES. SG2044.2 +040100 CLOSE FILE1. SG2044.2 +040200 GO TO FIRST-SORT. SG2044.2 +040300 P4-CREATE-F1. SG2044.2 +040400 MOVE C0 TO SUBSCRIPT-1. SG2044.2 +040500 PERFORM P5-CREATE-F1 25 TIMES. SG2044.2 +040600 P5-CREATE-F1. SG2044.2 +040700 ADD C1 TO SUBSCRIPT-1. SG2044.2 +040800 SUBTRACT C1 FROM S3-4W. SG2044.2 +040900 MOVE ALPHA-TBL (SUBSCRIPT-1) TO S1-2W-B S2-3W-B. SG2044.2 +041000 MOVE W-S3-KEYS TO R1. SG2044.2 +041100 WRITE R1. SG2044.2 +041200 F1-NOTE. SG2044.2 +041300* NOTE. SG2044.2 +041400* KEY-1 WILL BE 567 IN ALL RECORDS. SG2044.2 +041500* KEY-2 WILL BE >A> IN FIRST LETTER WITH 4 OCCURRENCES OF THESG2044.2 +041600* ALPHABET IN THE SECOND LETTER. SG2044.2 +041700* KEY-3 WILL BE >A> OR >B> IN FIRST LETTER WITH 2 OCCURRENCESSG2044.2 +041800* OF THE ALPHABET FOR EACH IN THE SECOND LETTER. SG2044.2 +041900* KEY-4 WILL VARY FROM 7050 THRU 6951. SG2044.2 +042000* THE LETTER "O" HAS BEEN OMITTED. SG2044.2 +042100 SRT-1 SECTION 69. SG2044.2 +042200 FIRST-SORT. SG2044.2 +042300 SORT SORT1 SG2044.2 +042400 ON DESCENDING KEY S1-1 SG2044.2 +042500 ON ASCENDING KEY S1-2 SG2044.2 +042600 USING FILE1 SG2044.2 +042700 GIVING FILE2. SG2044.2 +042800* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS. SG2044.2 +042900* NOTE OUTPUT WILL BE TESTED IN THE FOLLOWING INPUT PROCEDURE. SG2044.2 +043000 SRT-2 SECTION 48. SG2044.2 +043100 SECOND-SORT. SG2044.2 +043200 SORT SORT2 SG2044.2 +043300 ASCENDING S2-1 SG2044.2 +043400 DESCENDING S2-2 SG2044.2 +043500 ASCENDING S2-3 SG2044.2 +043600 INPUT PROCEDURE SRT-2-INPUT SG2044.2 +043700 GIVING FILE3. SG2044.2 +043800* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS OMITTED. SG2044.2 +043900 GO TO SRT-3. SG2044.2 +044000 SRT-2-INPUT SECTION 74. SG2044.2 +044100 OPEN-1. SG2044.2 +044200 OPEN INPUT FILE2. SG2044.2 +044300 MOVE "SORT, INPUT PROC" TO FEATURE. SG2044.2 +044400 SORT-TEST-1. SG2044.2 +044500 PERFORM READ-RELEASE-FILE2. SG2044.2 +044600 IF W-S1-KEYS EQUAL TO "567AA" SG2044.2 +044700 PERFORM PASS-1 GO TO SORT-WRITE-1. SG2044.2 +044800 GO TO SORT-FAIL-1. SG2044.2 +044900 SORT-DELETE-1. SG2044.2 +045000 PERFORM DE-LETE-1. SG2044.2 +045100 GO TO SORT-WRITE-1. SG2044.2 +045200 SORT-FAIL-1. SG2044.2 +045300 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +045400 MOVE "567AA" TO CORRECT-A. SG2044.2 +045500 PERFORM FAIL-1. SG2044.2 +045600 SORT-WRITE-1. SG2044.2 +045700 MOVE "SORT-TEST-1 " TO PAR-NAME. SG2044.2 +045800 PERFORM PRINT-DETAIL-1. SG2044.2 +045900 SORT-TEST-2. SG2044.2 +046000 PERFORM READ-RELEASE-FILE2 35 TIMES. SG2044.2 +046100 IF W-S1-KEYS EQUAL TO "567AI" SG2044.2 +046200 PERFORM PASS-1 GO TO SORT-WRITE-2. SG2044.2 +046300 GO TO SORT-FAIL-2. SG2044.2 +046400 SORT-DELETE-2. SG2044.2 +046500 PERFORM DE-LETE-1. SG2044.2 +046600 GO TO SORT-WRITE-2. SG2044.2 +046700 SORT-FAIL-2. SG2044.2 +046800 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +046900 MOVE "567AI" TO CORRECT-A. SG2044.2 +047000 PERFORM FAIL-1. SG2044.2 +047100 SORT-WRITE-2. SG2044.2 +047200 MOVE "SORT-TEST-2 " TO PAR-NAME. SG2044.2 +047300 PERFORM PRINT-DETAIL-1. SG2044.2 +047400 SORT-TEST-3. SG2044.2 +047500 PERFORM READ-RELEASE-FILE2 35 TIMES. SG2044.2 +047600 IF W-S1-KEYS EQUAL TO "567AS" SG2044.2 +047700 PERFORM PASS-1 GO TO SORT-WRITE-3. SG2044.2 +047800 GO TO SORT-FAIL-3. SG2044.2 +047900 SORT-DELETE-3. SG2044.2 +048000 PERFORM DE-LETE-1. SG2044.2 +048100 GO TO SORT-WRITE-3. SG2044.2 +048200 SORT-FAIL-3. SG2044.2 +048300 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +048400 MOVE "567AS" TO CORRECT-A. SG2044.2 +048500 PERFORM FAIL-1. SG2044.2 +048600 SORT-WRITE-3. SG2044.2 +048700 MOVE "SORT-TEST-3 " TO PAR-NAME. SG2044.2 +048800 PERFORM PRINT-DETAIL-1. SG2044.2 +048900 SORT-TEST-4. SG2044.2 +049000 PERFORM READ-RELEASE-FILE2 29 TIMES. SG2044.2 +049100 IF W-S1-KEYS EQUAL TO "567AZ" SG2044.2 +049200 PERFORM PASS-1 GO TO SORT-WRITE-4. SG2044.2 +049300 GO TO SORT-FAIL-4. SG2044.2 +049400 SORT-DELETE-4. SG2044.2 +049500 PERFORM DE-LETE-1. SG2044.2 +049600 GO TO SORT-WRITE-4. SG2044.2 +049700 SORT-FAIL-4. SG2044.2 +049800 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +049900 MOVE "567AZ" TO CORRECT-A. SG2044.2 +050000 PERFORM FAIL-1. SG2044.2 +050100 SORT-WRITE-4. SG2044.2 +050200 MOVE "SORT-TEST-4 " TO PAR-NAME. SG2044.2 +050300 PERFORM PRINT-DETAIL-1. SG2044.2 +050400 CLOSE-1. SG2044.2 +050500 CLOSE FILE2. SG2044.2 +050600 GO TO EXIT-1. SG2044.2 +050700 READ-RELEASE-FILE2. SG2044.2 +050800 READ FILE2 AT END GO TO TERMINAL-1. SG2044.2 +050900 MOVE R2 TO W-S3-KEYS. SG2044.2 +051000 RELEASE S2 FROM R2. SG2044.2 +051100 TERMINAL-1. SG2044.2 +051200 PERFORM FAIL-1. SG2044.2 +051300 MOVE "TERMINAL-1" TO PAR-NAME. SG2044.2 +051400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +051500 PERFORM PRINT-DETAIL-1. SG2044.2 +051600 MOVE SPACE TO FEATURE. SG2044.2 +051700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +051800 PERFORM PRINT-DETAIL-1. SG2044.2 +051900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. SG2044.2 +052000 PERFORM PRINT-DETAIL-1. SG2044.2 +052100 GO TO CLOSE-1. SG2044.2 +052200 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +052300 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +052400 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +052500 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +052600 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +052700 PRINT-DETAIL-1. SG2044.2 +052800 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +052900 MOVE "." TO PARDOT-X SG2044.2 +053000 MOVE REC-CT TO DOTVALUE. SG2044.2 +053100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SG2044.2 +053200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SG2044.2 +053300 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SG2044.2 +053400 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SG2044.2 +053500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +053600 MOVE SPACE TO CORRECT-X. SG2044.2 +053700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +053800 MOVE SPACE TO RE-MARK. SG2044.2 +053900 WRITE-LINE-1. SG2044.2 +054000 ADD 1 TO RECORD-COUNT. SG2044.2 +054100Y IF RECORD-COUNT GREATER 50 SG2044.2 +054200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +054300Y MOVE SPACE TO DUMMY-RECORD SG2044.2 +054400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +054500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SG2044.2 +054600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SG2044.2 +054700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SG2044.2 +054800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +054900Y MOVE ZERO TO RECORD-COUNT. SG2044.2 +055000 PERFORM WRT-LN-1. SG2044.2 +055100 WRT-LN-1. SG2044.2 +055200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +055300 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +055400 BLANK-LINE-PRINT-1. SG2044.2 +055500 PERFORM WRT-LN-1. SG2044.2 +055600 FAIL-ROUTINE-1. SG2044.2 +055700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SG2044.2 +055800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SG2044.2 +055900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +056000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +056100 GO TO FAIL-ROUTINE-EX-1. SG2044.2 +056200 FAIL-RTN-WRITE-1. SG2044.2 +056300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SG2044.2 +056400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +056500 FAIL-ROUTINE-EX-1. EXIT. SG2044.2 +056600 BAIL-OUT-1. SG2044.2 +056700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SG2044.2 +056800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SG2044.2 +056900 BAIL-OUT-WRITE-1. SG2044.2 +057000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +057200 BAIL-OUT-EX-1. EXIT. SG2044.2 +057300 EXIT-1. SG2044.2 +057400 EXIT. SG2044.2 +057500 SRT-3 SECTION. SG2044.2 +057600 THIRD-SORT. SG2044.2 +057700 SORT SORT3 SG2044.2 +057800 ON DESCENDING KEY S3-1 S3-2 S3-3 SG2044.2 +057900 ASCENDING S3-4 SG2044.2 +058000 INPUT PROCEDURE IS SRT3-INPUT SG2044.2 +058100 OUTPUT PROCEDURE SRT3-OUTPUT-1 THRU SRT3-OUTPUT-2. SG2044.2 +058200 NOTE-SORT-3. SG2044.2 +058300* NOTE SORT STATEMENT WITH INCLUSION-OMISSION OF OPTIONAL SG2044.2 +058400* WORDS AND THRU OPTION. THE OUTPUT OF SRT-2 IS TESTED SG2044.2 +058500* IN THE INPUT PROCEDURE OF THIS (THIRD) SORT. THE OUTPUT SG2044.2 +058600* OF THE THIRD SORT IS TESTED IN THE OUTPUT PROCEDURE SG2044.2 +058700* WITHOUT THE GENERATION OF AN OUTPUT FILE. SG2044.2 +058800 END-FIRST-PROGRAM. SG2044.2 +058900 GO TO CCVS-EXIT. SG2044.2 +059000 SRT3-INPUT SECTION 49. SG2044.2 +059100 OPEN-2. SG2044.2 +059200 OPEN INPUT FILE3. SG2044.2 +059300 MOVE "SORT, INPUT PROC" TO FEATURE. SG2044.2 +059400 SORT-TEST-5. SG2044.2 +059500 PERFORM READ-RELEASE-FILE3. SG2044.2 +059600 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +059700 IF W-S2-KEYS EQUAL TO "567AZAZ" SG2044.2 +059800 PERFORM PASS-2 GO TO SORT-WRITE-5. SG2044.2 +059900 GO TO SORT-FAIL-5. SG2044.2 +060000 SORT-DELETE-5. SG2044.2 +060100 PERFORM DE-LETE-2. SG2044.2 +060200 GO TO SORT-WRITE-5. SG2044.2 +060300 SORT-FAIL-5. SG2044.2 +060400 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +060500 MOVE "567AZAZ" TO CORRECT-A. SG2044.2 +060600 PERFORM FAIL-2. SG2044.2 +060700 SORT-WRITE-5. SG2044.2 +060800 MOVE "SORT-TEST-5 " TO PAR-NAME. SG2044.2 +060900 PERFORM PRINT-DETAIL-2. SG2044.2 +061000 SORT-TEST-6. SG2044.2 +061100 PERFORM READ-RELEASE-FILE3 35 TIMES. SG2044.2 +061200 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +061300 IF W-S2-KEYS EQUAL TO "567ARBR" SG2044.2 +061400 PERFORM PASS-2 GO TO SORT-WRITE-6. SG2044.2 +061500 GO TO SORT-FAIL-6. SG2044.2 +061600 SORT-DELETE-6. SG2044.2 +061700 PERFORM DE-LETE-2. SG2044.2 +061800 GO TO SORT-WRITE-6. SG2044.2 +061900 SORT-FAIL-6. SG2044.2 +062000 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +062100 MOVE "567ARBR" TO CORRECT-A. SG2044.2 +062200 PERFORM FAIL-2. SG2044.2 +062300 SORT-WRITE-6. SG2044.2 +062400 MOVE "SORT-TEST-6 " TO PAR-NAME. SG2044.2 +062500 PERFORM PRINT-DETAIL-2. SG2044.2 +062600 SORT-TEST-7. SG2044.2 +062700 PERFORM READ-RELEASE-FILE3 35 TIMES. SG2044.2 +062800 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +062900 IF W-S2-KEYS EQUAL TO "567AHBH" SG2044.2 +063000 PERFORM PASS-2 GO TO SORT-WRITE-7. SG2044.2 +063100 GO TO SORT-FAIL-7. SG2044.2 +063200 SORT-DELETE-7. SG2044.2 +063300 PERFORM DE-LETE-2. SG2044.2 +063400 GO TO SORT-WRITE-7. SG2044.2 +063500 SORT-FAIL-7. SG2044.2 +063600 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +063700 MOVE "567AHBH" TO CORRECT-A. SG2044.2 +063800 PERFORM FAIL-2. SG2044.2 +063900 SORT-WRITE-7. SG2044.2 +064000 MOVE "SORT-TEST-7 " TO PAR-NAME. SG2044.2 +064100 PERFORM PRINT-DETAIL-2. SG2044.2 +064200 SORT-TEST-8. SG2044.2 +064300 PERFORM READ-RELEASE-FILE3 29 TIMES. SG2044.2 +064400 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +064500 IF W-S2-KEYS EQUAL TO "567AABA" SG2044.2 +064600 PERFORM PASS-2 GO TO SORT-WRITE-8. SG2044.2 +064700 GO TO SORT-FAIL-8. SG2044.2 +064800 SORT-DELETE-8. SG2044.2 +064900 PERFORM DE-LETE-2. SG2044.2 +065000 GO TO SORT-WRITE-8. SG2044.2 +065100 SORT-FAIL-8. SG2044.2 +065200 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +065300 MOVE "567AABA" TO CORRECT-A. SG2044.2 +065400 PERFORM FAIL-2. SG2044.2 +065500 SORT-WRITE-8. SG2044.2 +065600 MOVE "SORT-TEST-8 " TO PAR-NAME. SG2044.2 +065700 PERFORM PRINT-DETAIL-2. SG2044.2 +065800 CLOSE-2. SG2044.2 +065900 CLOSE FILE3. SG2044.2 +066000 GO TO EXIT-2. SG2044.2 +066100 READ-RELEASE-FILE3. SG2044.2 +066200 READ FILE3 AT END GO TO TERMINAL-2. SG2044.2 +066300 RELEASE S3. SG2044.2 +066400* NOTE THE FROM OPTION AND MOVE ARE REDUNDANT WITH SAME SG2044.2 +066500* RECORD AREA CLAUSE IN I-O CONTROL PARAGRAPH. SG2044.2 +066600 TERMINAL-2. SG2044.2 +066700 PERFORM FAIL-2. SG2044.2 +066800 MOVE "TERMINAL-2" TO PAR-NAME. SG2044.2 +066900 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +067000 PERFORM PRINT-DETAIL-2. SG2044.2 +067100 MOVE SPACE TO FEATURE. SG2044.2 +067200 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +067300 PERFORM PRINT-DETAIL-2. SG2044.2 +067400 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. SG2044.2 +067500 PERFORM PRINT-DETAIL-2. SG2044.2 +067600 GO TO CLOSE-2. SG2044.2 +067700 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +067800 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +067900 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +068000 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +068100 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +068200 PRINT-DETAIL-2. SG2044.2 +068300 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +068400 MOVE "." TO PARDOT-X SG2044.2 +068500 MOVE REC-CT TO DOTVALUE. SG2044.2 +068600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. SG2044.2 +068700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 SG2044.2 +068800 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 SG2044.2 +068900 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. SG2044.2 +069000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +069100 MOVE SPACE TO CORRECT-X. SG2044.2 +069200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +069300 MOVE SPACE TO RE-MARK. SG2044.2 +069400 WRITE-LINE-2. SG2044.2 +069500 ADD 1 TO RECORD-COUNT. SG2044.2 +069600Y IF RECORD-COUNT GREATER 50 SG2044.2 +069700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +069800Y MOVE SPACE TO DUMMY-RECORD SG2044.2 +069900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +070000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 SG2044.2 +070100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES SG2044.2 +070200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 SG2044.2 +070300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +070400Y MOVE ZERO TO RECORD-COUNT. SG2044.2 +070500 PERFORM WRT-LN-2. SG2044.2 +070600 WRT-LN-2. SG2044.2 +070700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +070800 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +070900 BLANK-LINE-PRINT-2. SG2044.2 +071000 PERFORM WRT-LN-2. SG2044.2 +071100 FAIL-ROUTINE-2. SG2044.2 +071200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. SG2044.2 +071300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. SG2044.2 +071400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +071500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +071600 GO TO FAIL-ROUTINE-EX-2. SG2044.2 +071700 FAIL-RTN-WRITE-2. SG2044.2 +071800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 SG2044.2 +071900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +072000 FAIL-ROUTINE-EX-2. EXIT. SG2044.2 +072100 BAIL-OUT-2. SG2044.2 +072200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. SG2044.2 +072300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. SG2044.2 +072400 BAIL-OUT-WRITE-2. SG2044.2 +072500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +072600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +072700 BAIL-OUT-EX-2. EXIT. SG2044.2 +072800 EXIT-2. SG2044.2 +072900 EXIT. SG2044.2 +073000 SRT3-OUTPUT-1 SECTION 25. SG2044.2 +073100 INIT-3. SG2044.2 +073200 MOVE "SORT, OUTPUT PROC" TO FEATURE. SG2044.2 +073300 SORT-TEST-9. SG2044.2 +073400 PERFORM RETURN-SORT3. SG2044.2 +073500 IF S3-KEYS EQUAL TO "567AZBZ7001" SG2044.2 +073600 PERFORM PASS-3 GO TO SORT-WRITE-9. SG2044.2 +073700 GO TO SORT-FAIL-9. SG2044.2 +073800 SORT-DELETE-9. SG2044.2 +073900 PERFORM DE-LETE-3. SG2044.2 +074000 GO TO SORT-WRITE-9. SG2044.2 +074100 SORT-FAIL-9. SG2044.2 +074200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +074300 MOVE "567AZBZ7001" TO CORRECT-A. SG2044.2 +074400 PERFORM FAIL-3. SG2044.2 +074500 SORT-WRITE-9. SG2044.2 +074600 MOVE "SORT-TEST-9 " TO PAR-NAME. SG2044.2 +074700 PERFORM PRINT-DETAIL-3. SG2044.2 +074800 SORT-TEST-10. SG2044.2 +074900 PERFORM RETURN-SORT3. SG2044.2 +075000 IF S3-KEYS EQUAL TO "567AZBZ7026" SG2044.2 +075100 PERFORM PASS-3 GO TO SORT-WRITE-10. SG2044.2 +075200 GO TO SORT-FAIL-10. SG2044.2 +075300 SORT-DELETE-10. SG2044.2 +075400 PERFORM DE-LETE-3. SG2044.2 +075500 GO TO SORT-WRITE-10. SG2044.2 +075600 SORT-FAIL-10. SG2044.2 +075700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +075800 MOVE "567AZBZ7026" TO CORRECT-A. SG2044.2 +075900 PERFORM FAIL-3. SG2044.2 +076000 SORT-WRITE-10. SG2044.2 +076100 MOVE "SORT-TEST-10" TO PAR-NAME. SG2044.2 +076200 PERFORM PRINT-DETAIL-3. SG2044.2 +076300 SORT-TEST-11. SG2044.2 +076400 PERFORM RETURN-SORT3 35 TIMES. SG2044.2 +076500 IF S3-KEYS EQUAL TO "567AQBQ7010" SG2044.2 +076600 PERFORM PASS-3 GO TO SORT-WRITE-11. SG2044.2 +076700 GO TO SORT-FAIL-11. SG2044.2 +076800 SORT-DELETE-11. SG2044.2 +076900 PERFORM DE-LETE-3. SG2044.2 +077000 GO TO SORT-WRITE-11. SG2044.2 +077100 SORT-FAIL-11. SG2044.2 +077200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +077300 MOVE "567AQBQ7010" TO CORRECT-A. SG2044.2 +077400 PERFORM FAIL-3. SG2044.2 +077500 SORT-WRITE-11. SG2044.2 +077600 MOVE "SORT-TEST-11" TO PAR-NAME. SG2044.2 +077700 PERFORM PRINT-DETAIL-3. SG2044.2 +077800 SORT-TEST-12. SG2044.2 +077900 PERFORM RETURN-SORT3. SG2044.2 +078000 IF S3-KEYS EQUAL TO "567AQBQ7035" SG2044.2 +078100 PERFORM PASS-3 GO TO SORT-WRITE-12. SG2044.2 +078200 GO TO SORT-FAIL-12. SG2044.2 +078300 SORT-DELETE-12. SG2044.2 +078400 PERFORM DE-LETE-3. SG2044.2 +078500 GO TO SORT-WRITE-12. SG2044.2 +078600 SORT-FAIL-12. SG2044.2 +078700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +078800 MOVE "567AQBQ7035" TO CORRECT-A. SG2044.2 +078900 PERFORM FAIL-3. SG2044.2 +079000 SORT-WRITE-12. SG2044.2 +079100 MOVE "SORT-TEST-12" TO PAR-NAME. SG2044.2 +079200 PERFORM PRINT-DETAIL-3. SG2044.2 +079300 SORT-TEST-13. SG2044.2 +079400 PERFORM RETURN-SORT3 35 TIMES. SG2044.2 +079500 IF S3-KEYS EQUAL TO "567AGBG7019" SG2044.2 +079600 PERFORM PASS-3 GO TO SORT-WRITE-13. SG2044.2 +079700 GO TO SORT-FAIL-13. SG2044.2 +079800 SORT-DELETE-13. SG2044.2 +079900 PERFORM DE-LETE-3. SG2044.2 +080000 GO TO SORT-WRITE-13. SG2044.2 +080100 SORT-FAIL-13. SG2044.2 +080200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +080300 MOVE "567AGBG7019" TO CORRECT-A. SG2044.2 +080400 PERFORM FAIL-3. SG2044.2 +080500 SORT-WRITE-13. SG2044.2 +080600 MOVE "SORT-TEST-13" TO PAR-NAME. SG2044.2 +080700 PERFORM PRINT-DETAIL-3. SG2044.2 +080800 SORT-TEST-14. SG2044.2 +080900 PERFORM RETURN-SORT3 27 TIMES. SG2044.2 +081000 IF S3-KEYS EQUAL TO "567AAAA7000" SG2044.2 +081100 PERFORM PASS-3 GO TO SORT-WRITE-14. SG2044.2 +081200 GO TO SORT-FAIL-14. SG2044.2 +081300 SORT-DELETE-14. SG2044.2 +081400 PERFORM DE-LETE-3. SG2044.2 +081500 GO TO SORT-WRITE-14. SG2044.2 +081600 SORT-FAIL-14. SG2044.2 +081700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +081800 MOVE "567AAAA7000" TO CORRECT-A. SG2044.2 +081900 PERFORM FAIL-3. SG2044.2 +082000 SORT-WRITE-14. SG2044.2 +082100 MOVE "SORT-TEST-14" TO PAR-NAME. SG2044.2 +082200 PERFORM PRINT-DETAIL-3. SG2044.2 +082300 SORT-TEST-15. SG2044.2 +082400 RETURN SORT3 RECORD AT END SG2044.2 +082500 PERFORM PASS-3 GO TO SORT-WRITE-15. SG2044.2 +082600* NOTE THE FOLLOWING SENTENCES SHOULD NOT BE EXECUTED. SG2044.2 +082700 PERFORM FAIL-3. SG2044.2 +082800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG2044.2 +082900 GO TO SORT-WRITE-15. SG2044.2 +083000 SORT-DELETE-15. SG2044.2 +083100 PERFORM DE-LETE-3. SG2044.2 +083200 SORT-WRITE-15. SG2044.2 +083300 MOVE "SORT-TEST-15" TO PAR-NAME. SG2044.2 +083400 PERFORM PRINT-DETAIL-3. SG2044.2 +083500 CLOSE-3. SG2044.2 +083600 GO TO EXIT-3. SG2044.2 +083700 SRT3-OUTPUT-2 SECTION 25. SG2044.2 +083800 RETURN-SORT3. SG2044.2 +083900 RETURN SORT3 RECORD AT END GO TO TERMINAL-3. SG2044.2 +084000* NOTE RETURN VERB WITH ALL OPTIONS EXCEPT INTO. SG2044.2 +084100 TERMINAL-3. SG2044.2 +084200 PERFORM FAIL-3. SG2044.2 +084300 MOVE "TERMINAL-3" TO PAR-NAME. SG2044.2 +084400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +084500 PERFORM PRINT-DETAIL-3. SG2044.2 +084600 MOVE SPACE TO FEATURE. SG2044.2 +084700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +084800 PERFORM PRINT-DETAIL-3. SG2044.2 +084900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK SG2044.2 +085000 PERFORM PRINT-DETAIL-3. SG2044.2 +085100 GO TO CLOSE-3. SG2044.2 +085200 PASS-3. SG2044.2 +085300 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +085400 FAIL-3. SG2044.2 +085500 ADD 1 TO ERROR-COUNTER. SG2044.2 +085600 MOVE "FAIL*" TO P-OR-F. SG2044.2 +085700 DE-LETE-3. SG2044.2 +085800 MOVE SPACE TO P-OR-F. SG2044.2 +085900 MOVE " ************ " TO COMPUTED-A. SG2044.2 +086000 MOVE " ************ " TO CORRECT-A. SG2044.2 +086100 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +086200 ADD 1 TO DELETE-CNT. SG2044.2 +086300 PRINT-DETAIL-3. SG2044.2 +086400 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +086500 MOVE "." TO PARDOT-X SG2044.2 +086600 MOVE REC-CT TO DOTVALUE. SG2044.2 +086700 MOVE TEST-RESULTS TO PRINT-REC. SG2044.2 +086800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +086900 MOVE SPACE TO P-OR-F. SG2044.2 +087000 MOVE SPACE TO COMPUTED-A. SG2044.2 +087100 MOVE SPACE TO CORRECT-A. SG2044.2 +087200 IF REC-CT EQUAL TO ZERO SG2044.2 +087300 MOVE SPACE TO PAR-NAME. SG2044.2 +087400 MOVE SPACE TO RE-MARK. SG2044.2 +087500 EXIT-3. SG2044.2 +087600 EXIT. SG2044.2 +087700 END-CCVS SECTION 25. SG2044.2 +087800 CCVS-EXIT SECTION. SG2044.2 +087900 CCVS-999999. SG2044.2 +088000 GO TO CLOSE-FILES. SG2044.2 +*END-OF,SG204A +*HEADER,COBOL,SG302M +000100 IDENTIFICATION DIVISION. SG3024.2 +000200 PROGRAM-ID. SG3024.2 +000300 SG302M. SG3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SG3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN SEGMENTATION LEVEL 1. SG3024.2 +000600 ENVIRONMENT DIVISION. SG3024.2 +000700 CONFIGURATION SECTION. SG3024.2 +000800 SOURCE-COMPUTER. SG3024.2 +000900 XXXXX082. SG3024.2 +001000 OBJECT-COMPUTER. SG3024.2 +001100 XXXXX083. SG3024.2 +001200 SG3024.2 +001300 SG3024.2 +001400 DATA DIVISION. SG3024.2 +001500 PROCEDURE DIVISION. SG3024.2 +001600 BEANO SECTION 1. SG3024.2 +001700*Message expected for above statement: OBSOLETE SG3024.2 +001800 SG302M-CONTROL. SG3024.2 +001900 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG3024.2 +002000 STOP RUN. SG3024.2 +002100*TOTAL NUMBER OF FLAGS EXPECTED = 1. SG3024.2 +*END-OF,SG302M +*HEADER,COBOL,SG303M +000100 IDENTIFICATION DIVISION. SG3034.2 +000200 PROGRAM-ID. SG3034.2 +000300 SG303M. SG3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SG3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN SEGMENTATION LEVEL 2. SG3034.2 +000600 ENVIRONMENT DIVISION. SG3034.2 +000700 CONFIGURATION SECTION. SG3034.2 +000800 SOURCE-COMPUTER. SG3034.2 +000900 XXXXX082. SG3034.2 +001000 OBJECT-COMPUTER. SG3034.2 +001100 XXXXX083 SG3034.2 +001200 SEGMENT-LIMIT IS 20. SG3034.2 +001300*Message expected for above statement: OBSOLETE SG3034.2 +001400 DATA DIVISION. SG3034.2 +001500 PROCEDURE DIVISION. SG3034.2 +001600 SG3034.2 +001700 NUMBER1 SECTION 18. SG3034.2 +001800*Message expected for above statement: OBSOLETE SG3034.2 +001900 SG3034.2 +002000 SG303M-CONTROL. SG3034.2 +002100 EXIT. SG3034.2 +002200 SG3034.2 +002300 NUMBER2 SECTION 19. SG3034.2 +002400*Message expected for above statement: OBSOLETE SG3034.2 +002500 SG3034.2 +002600 SG303M-DUMMY1. SG3034.2 +002700 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG3034.2 +002800 SG3034.2 +002900 NUMBER3 SECTION 18. SG3034.2 +003000*Message expected for above statement: OBSOLETE SG3034.2 +003100 SG3034.2 +003200 SG303M-DUMMY2. SG3034.2 +003300 DISPLAY "THIS IS A DUMMY PARAGRAPH TOO!". SG3034.2 +003400 SG3034.2 +003500 SG3034.2 +003600 SG3034.2 +003700*TOTAL NUMBER OF FLAGS EXPECTED = 4. SG3034.2 +*END-OF,SG303M +*HEADER,COBOL,SG401M +000100 IDENTIFICATION DIVISION. SG4014.2 +000200 PROGRAM-ID. SG4014.2 +000300 SG401M. SG4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 2 SG4014.2 +000500*FEATURES OF THE SEGMENTATION MODULE. SG4014.2 +000600 ENVIRONMENT DIVISION. SG4014.2 +000700 CONFIGURATION SECTION. SG4014.2 +000800 SOURCE-COMPUTER. SG4014.2 +000900 XXXXX082. SG4014.2 +001000 OBJECT-COMPUTER. SG4014.2 +001100 XXXXX083 SG4014.2 +001200 SEGMENT-LIMIT IS 18. SG4014.2 +001300*Message expected for above statement: NON-CONFORMING STANDARD SG4014.2 +001400 SG4014.2 +001500 SG4014.2 +001600 DATA DIVISION. SG4014.2 +001700 PROCEDURE DIVISION. SG4014.2 +001800 SG4014.2 +001900 NUMBER1 SECTION 18. SG4014.2 +002000 SG4014.2 +002100 SG401M-CONTROL. SG4014.2 +002200 EXIT. SG4014.2 +002300 SG4014.2 +002400 NUMBER2 SECTION 19. SG4014.2 +002500 SG4014.2 +002600 SG401M-DUMMY. SG4014.2 +002700 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG4014.2 +002800 SG4014.2 +002900 NUMBER3 SECTION 18. SG4014.2 +003000*Message expected for above statement: NON-CONFORMING STANDARD SG4014.2 +003100 SG401M-DUMMY2. SG4014.2 +003200 DISPLAY "THIS IS A DUMMY PARAGRAPH TOO!". SG4014.2 +003300 SG4014.2 +003400 SG4014.2 +003500* A MESSAGE IS EXPECTED FOR THE EXISTENCE OF TWO SECTIONS SG4014.2 +003600* WITH THE SAME SECTION NUMBER THAT ARE NOT SG4014.2 +003700* "PHYSICALLY CONTIGUOUS IN THE SOURCE PROGRAM". SG4014.2 +003800 SG4014.2 +003900*TOTAL NUMBER OF FLAGS EXPECTED = 2. SG4014.2 +*END-OF,SG401M +*HEADER,COBOL,SM101A +000100 IDENTIFICATION DIVISION. SM1014.2 +000200 PROGRAM-ID. SM1014.2 +000300 SM101A. SM1014.2 +000400**************************************************************** SM1014.2 +000500* * SM1014.2 +000600* VALIDATION FOR:- * SM1014.2 +000700* * SM1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +000900* * SM1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1014.2 +001100* * SM1014.2 +001200* * SM1014.2 +001300* X-CARDS USED BY THIS PROGRAM ARE :- * SM1014.2 +001400* * SM1014.2 +001500* X-55 - SYSTEM PRINTER NAME. * SM1014.2 +001600* X-82 - SOURCE COMPUTER NAME. * SM1014.2 +001700* X-83 - OBJECT COMPUTER NAME. * SM1014.2 +001800* * SM1014.2 +001900**************************************************************** SM1014.2 +002000* * SM1014.2 +002100* PROGRAM SM101A TESTS THE USE OF THE "COPY" STATEMENT * SM1014.2 +002200* IN A FILE DESCRIPTION WITH ITS RELATED 01 ENTRIES IN THE * SM1014.2 +002300* WORKING-STORAGE SECTION AND IN THE PROCEDURE DIVISION. * SM1014.2 +002400* IT CREATES A SEQUENTIAL FILE WHICH IS INPUT TO SM102A TO * SM1014.2 +002500* CHECK THE PROPER EXECUTION OF THE "COPY" STATEMENT IN * SM1014.2 +002600* SM101A. IT ALSO TESTS THE EFFECT OF A "COPY" STATEMENT * SM1014.2 +002700* APPEARING ON A DEBUGGING LINE. * SM1014.2 +002800* * SM1014.2 +002900**************************************************************** SM1014.2 +003000 ENVIRONMENT DIVISION. SM1014.2 +003100 CONFIGURATION SECTION. SM1014.2 +003200 SOURCE-COMPUTER. SM1014.2 +003300 XXXXX082. SM1014.2 +003400 OBJECT-COMPUTER. SM1014.2 +003500 XXXXX083. SM1014.2 +003600 INPUT-OUTPUT SECTION. SM1014.2 +003700 FILE-CONTROL. SM1014.2 +003800 SELECT PRINT-FILE ASSIGN TO SM1014.2 +003900 XXXXX055. SM1014.2 +004000 SELECT TEST-FILE ASSIGN TO SM1014.2 +004100 XXXXP001. SM1014.2 +004200 DATA DIVISION. SM1014.2 +004300 FILE SECTION. SM1014.2 +004400 FD PRINT-FILE. SM1014.2 +004500 01 PRINT-REC PICTURE X(120). SM1014.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1014.2 +004700 SM1014.2 +004800 SM1014.2 +004900 SM1014.2 +005000 SM1014.2 +005100 SM1014.2 +005200* SM1014.2 +005300*********************** COPY STATEMENT USED **********************SM1014.2 +005400* SM1014.2 +005500*FD TEST-FILE COPY K1FDA. SM1014.2 +005600* SM1014.2 +005700******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +005800 FD TEST-FILE COPY K1FDA.SM1014.2 +005900*********************** END OF COPIED TEXT ***********************SM1014.2 +006000 SM1014.2 +006100 SM1014.2 +006200 SM1014.2 +006300 SM1014.2 +006400 SM1014.2 +006500* SM1014.2 +006600*********************** COPY STATEMENT USED **********************SM1014.2 +006700* SM1014.2 +006800*01 TST-TEST COPY K101A. SM1014.2 +006900* SM1014.2 +007000******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +007100 01 TST-TEST COPY K101A.SM1014.2 +007200*********************** END OF COPIED TEXT ***********************SM1014.2 +007300 WORKING-STORAGE SECTION. SM1014.2 +007400* SM1014.2 +007500*********************** COPY STATEMENT USED **********************SM1014.2 +007600* SM1014.2 +007700*77 RCD-1 COPY K1W01. SM1014.2 +007800* SM1014.2 +007900******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +008000 77 RCD-1 COPY K1W01.SM1014.2 +008100*********************** END OF COPIED TEXT ***********************SM1014.2 +008200 77 RCD-3 PICTURE 9(5) VALUE 10901. SM1014.2 +008300* SM1014.2 +008400*********************** COPY STATEMENT USED **********************SM1014.2 +008500* SM1014.2 +008600*77 COPY K1W02. SM1014.2 +008700* SM1014.2 +008800******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +008900 77 COPY K1W02. SM1014.2 +009000*********************** END OF COPIED TEXT ***********************SM1014.2 +009100 14003. SM1014.2 +009200 77 RCD-6 PICTURE 9(5) VALUE 19922. SM1014.2 +009300* SM1014.2 +009400*********************** COPY STATEMENT USED **********************SM1014.2 +009500* SM1014.2 +009600*77 COPY K1W03. VALUE 3543. SM1014.2 +009700* SM1014.2 +009800******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +009900 77 COPY K1W03. VALUE 3543. SM1014.2 +010000*********************** END OF COPIED TEXT ***********************SM1014.2 +010100 77 COPYSECT-1 PICTURE 9(5) VALUE 72459. SM1014.2 +010200 77 COPYSECT-2 PICTURE 9(5) VALUE 12132. SM1014.2 +010300 77 COPYSECT-3 PICTURE X(5) VALUE "TSTLI". SM1014.2 +010400 77 COPYSECT-4 PICTURE X(5) VALUE "BCOPY". SM1014.2 +010500* SM1014.2 +010600*********************** COPY STATEMENT USED **********************SM1014.2 +010700* SM1014.2 +010800*COPY K1W04. SM1014.2 +010900* SM1014.2 +011000******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +011100 COPY K1W04. SM1014.2 +011200*********************** END OF COPIED TEXT ***********************SM1014.2 +011300 77 PROC-1 PICTURE 999 VALUE 123. SM1014.2 +011400 77 PROC-2 PICTURE 999 VALUE 456. SM1014.2 +011500 77 WSTR-1 PICTURE X(3) VALUE "ABC". SM1014.2 +011600 SM1014.2 +011700 SM1014.2 +011800 SM1014.2 +011900 SM1014.2 +012000 SM1014.2 +012100 01 WSTR-2. SM1014.2 +012200* SM1014.2 +012300*********************** COPY STATEMENT USED **********************SM1014.2 +012400* SM1014.2 +012500* COPY K1WKA. SM1014.2 +012600* SM1014.2 +012700******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +012800 COPY K1WKA. SM1014.2 +012900*********************** END OF COPIED TEXT ***********************SM1014.2 +013000 01 TEST-RESULTS. SM1014.2 +013100 02 FILLER PIC X VALUE SPACE. SM1014.2 +013200 02 FEATURE PIC X(20) VALUE SPACE. SM1014.2 +013300 02 FILLER PIC X VALUE SPACE. SM1014.2 +013400 02 P-OR-F PIC X(5) VALUE SPACE. SM1014.2 +013500 02 FILLER PIC X VALUE SPACE. SM1014.2 +013600 02 PAR-NAME. SM1014.2 +013700 03 FILLER PIC X(19) VALUE SPACE. SM1014.2 +013800 03 PARDOT-X PIC X VALUE SPACE. SM1014.2 +013900 03 DOTVALUE PIC 99 VALUE ZERO. SM1014.2 +014000 02 FILLER PIC X(8) VALUE SPACE. SM1014.2 +014100 02 RE-MARK PIC X(61). SM1014.2 +014200 01 TEST-COMPUTED. SM1014.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SM1014.2 +014400 02 FILLER PIC X(17) VALUE SM1014.2 +014500 " COMPUTED=". SM1014.2 +014600 02 COMPUTED-X. SM1014.2 +014700 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1014.2 +014800 03 COMPUTED-N REDEFINES COMPUTED-A SM1014.2 +014900 PIC -9(9).9(9). SM1014.2 +015000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1014.2 +015100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1014.2 +015200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1014.2 +015300 03 CM-18V0 REDEFINES COMPUTED-A. SM1014.2 +015400 04 COMPUTED-18V0 PIC -9(18). SM1014.2 +015500 04 FILLER PIC X. SM1014.2 +015600 03 FILLER PIC X(50) VALUE SPACE. SM1014.2 +015700 01 TEST-CORRECT. SM1014.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SM1014.2 +015900 02 FILLER PIC X(17) VALUE " CORRECT =". SM1014.2 +016000 02 CORRECT-X. SM1014.2 +016100 03 CORRECT-A PIC X(20) VALUE SPACE. SM1014.2 +016200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1014.2 +016300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1014.2 +016400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1014.2 +016500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1014.2 +016600 03 CR-18V0 REDEFINES CORRECT-A. SM1014.2 +016700 04 CORRECT-18V0 PIC -9(18). SM1014.2 +016800 04 FILLER PIC X. SM1014.2 +016900 03 FILLER PIC X(2) VALUE SPACE. SM1014.2 +017000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1014.2 +017100 01 CCVS-C-1. SM1014.2 +017200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1014.2 +017300- "SS PARAGRAPH-NAME SM1014.2 +017400- " REMARKS". SM1014.2 +017500 02 FILLER PIC X(20) VALUE SPACE. SM1014.2 +017600 01 CCVS-C-2. SM1014.2 +017700 02 FILLER PIC X VALUE SPACE. SM1014.2 +017800 02 FILLER PIC X(6) VALUE "TESTED". SM1014.2 +017900 02 FILLER PIC X(15) VALUE SPACE. SM1014.2 +018000 02 FILLER PIC X(4) VALUE "FAIL". SM1014.2 +018100 02 FILLER PIC X(94) VALUE SPACE. SM1014.2 +018200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1014.2 +018300 01 REC-CT PIC 99 VALUE ZERO. SM1014.2 +018400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018700 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1014.2 +018900 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1014.2 +019000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1014.2 +019100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1014.2 +019200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1014.2 +019300 01 CCVS-H-1. SM1014.2 +019400 02 FILLER PIC X(39) VALUE SPACES. SM1014.2 +019500 02 FILLER PIC X(42) VALUE SM1014.2 +019600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1014.2 +019700 02 FILLER PIC X(39) VALUE SPACES. SM1014.2 +019800 01 CCVS-H-2A. SM1014.2 +019900 02 FILLER PIC X(40) VALUE SPACE. SM1014.2 +020000 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1014.2 +020100 02 FILLER PIC XXXX VALUE SM1014.2 +020200 "4.2 ". SM1014.2 +020300 02 FILLER PIC X(28) VALUE SM1014.2 +020400 " COPY - NOT FOR DISTRIBUTION". SM1014.2 +020500 02 FILLER PIC X(41) VALUE SPACE. SM1014.2 +020600 SM1014.2 +020700 01 CCVS-H-2B. SM1014.2 +020800 02 FILLER PIC X(15) VALUE SM1014.2 +020900 "TEST RESULT OF ". SM1014.2 +021000 02 TEST-ID PIC X(9). SM1014.2 +021100 02 FILLER PIC X(4) VALUE SM1014.2 +021200 " IN ". SM1014.2 +021300 02 FILLER PIC X(12) VALUE SM1014.2 +021400 " HIGH ". SM1014.2 +021500 02 FILLER PIC X(22) VALUE SM1014.2 +021600 " LEVEL VALIDATION FOR ". SM1014.2 +021700 02 FILLER PIC X(58) VALUE SM1014.2 +021800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +021900 01 CCVS-H-3. SM1014.2 +022000 02 FILLER PIC X(34) VALUE SM1014.2 +022100 " FOR OFFICIAL USE ONLY ". SM1014.2 +022200 02 FILLER PIC X(58) VALUE SM1014.2 +022300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1014.2 +022400 02 FILLER PIC X(28) VALUE SM1014.2 +022500 " COPYRIGHT 1985 ". SM1014.2 +022600 01 CCVS-E-1. SM1014.2 +022700 02 FILLER PIC X(52) VALUE SPACE. SM1014.2 +022800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1014.2 +022900 02 ID-AGAIN PIC X(9). SM1014.2 +023000 02 FILLER PIC X(45) VALUE SPACES. SM1014.2 +023100 01 CCVS-E-2. SM1014.2 +023200 02 FILLER PIC X(31) VALUE SPACE. SM1014.2 +023300 02 FILLER PIC X(21) VALUE SPACE. SM1014.2 +023400 02 CCVS-E-2-2. SM1014.2 +023500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1014.2 +023600 03 FILLER PIC X VALUE SPACE. SM1014.2 +023700 03 ENDER-DESC PIC X(44) VALUE SM1014.2 +023800 "ERRORS ENCOUNTERED". SM1014.2 +023900 01 CCVS-E-3. SM1014.2 +024000 02 FILLER PIC X(22) VALUE SM1014.2 +024100 " FOR OFFICIAL USE ONLY". SM1014.2 +024200 02 FILLER PIC X(12) VALUE SPACE. SM1014.2 +024300 02 FILLER PIC X(58) VALUE SM1014.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +024500 02 FILLER PIC X(13) VALUE SPACE. SM1014.2 +024600 02 FILLER PIC X(15) VALUE SM1014.2 +024700 " COPYRIGHT 1985". SM1014.2 +024800 01 CCVS-E-4. SM1014.2 +024900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1014.2 +025000 02 FILLER PIC X(4) VALUE " OF ". SM1014.2 +025100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1014.2 +025200 02 FILLER PIC X(40) VALUE SM1014.2 +025300 " TESTS WERE EXECUTED SUCCESSFULLY". SM1014.2 +025400 01 XXINFO. SM1014.2 +025500 02 FILLER PIC X(19) VALUE SM1014.2 +025600 "*** INFORMATION ***". SM1014.2 +025700 02 INFO-TEXT. SM1014.2 +025800 04 FILLER PIC X(8) VALUE SPACE. SM1014.2 +025900 04 XXCOMPUTED PIC X(20). SM1014.2 +026000 04 FILLER PIC X(5) VALUE SPACE. SM1014.2 +026100 04 XXCORRECT PIC X(20). SM1014.2 +026200 02 INF-ANSI-REFERENCE PIC X(48). SM1014.2 +026300 01 HYPHEN-LINE. SM1014.2 +026400 02 FILLER PIC IS X VALUE IS SPACE. SM1014.2 +026500 02 FILLER PIC IS X(65) VALUE IS "************************SM1014.2 +026600- "*****************************************". SM1014.2 +026700 02 FILLER PIC IS X(54) VALUE IS "************************SM1014.2 +026800- "******************************". SM1014.2 +026900 01 CCVS-PGM-ID PIC X(9) VALUE SM1014.2 +027000 "SM101A". SM1014.2 +027100 PROCEDURE DIVISION. SM1014.2 +027200 CCVS1 SECTION. SM1014.2 +027300 OPEN-FILES. SM1014.2 +027400 OPEN OUTPUT PRINT-FILE. SM1014.2 +027500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1014.2 +027600 MOVE SPACE TO TEST-RESULTS. SM1014.2 +027700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1014.2 +027800 GO TO CCVS1-EXIT. SM1014.2 +027900 CLOSE-FILES. SM1014.2 +028000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1014.2 +028100 TERMINATE-CCVS. SM1014.2 +028200S EXIT PROGRAM. SM1014.2 +028300STERMINATE-CALL. SM1014.2 +028400 STOP RUN. SM1014.2 +028500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1014.2 +028600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1014.2 +028700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1014.2 +028800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1014.2 +028900 MOVE "****TEST DELETED****" TO RE-MARK. SM1014.2 +029000 PRINT-DETAIL. SM1014.2 +029100 IF REC-CT NOT EQUAL TO ZERO SM1014.2 +029200 MOVE "." TO PARDOT-X SM1014.2 +029300 MOVE REC-CT TO DOTVALUE. SM1014.2 +029400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1014.2 +029500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1014.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1014.2 +029700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1014.2 +029800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1014.2 +029900 MOVE SPACE TO CORRECT-X. SM1014.2 +030000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1014.2 +030100 MOVE SPACE TO RE-MARK. SM1014.2 +030200 HEAD-ROUTINE. SM1014.2 +030300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +030400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +030500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1014.2 +030600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1014.2 +030700 COLUMN-NAMES-ROUTINE. SM1014.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +031100 END-ROUTINE. SM1014.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1014.2 +031300 END-RTN-EXIT. SM1014.2 +031400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +031500 END-ROUTINE-1. SM1014.2 +031600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1014.2 +031700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1014.2 +031800 ADD PASS-COUNTER TO ERROR-HOLD. SM1014.2 +031900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1014.2 +032000 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1014.2 +032100 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1014.2 +032200 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1014.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1014.2 +032400 END-ROUTINE-12. SM1014.2 +032500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1014.2 +032600 IF ERROR-COUNTER IS EQUAL TO ZERO SM1014.2 +032700 MOVE "NO " TO ERROR-TOTAL SM1014.2 +032800 ELSE SM1014.2 +032900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1014.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1014.2 +033100 PERFORM WRITE-LINE. SM1014.2 +033200 END-ROUTINE-13. SM1014.2 +033300 IF DELETE-COUNTER IS EQUAL TO ZERO SM1014.2 +033400 MOVE "NO " TO ERROR-TOTAL ELSE SM1014.2 +033500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1014.2 +033600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1014.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +033800 IF INSPECT-COUNTER EQUAL TO ZERO SM1014.2 +033900 MOVE "NO " TO ERROR-TOTAL SM1014.2 +034000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1014.2 +034100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1014.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +034300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +034400 WRITE-LINE. SM1014.2 +034500 ADD 1 TO RECORD-COUNT. SM1014.2 +034600Y IF RECORD-COUNT GREATER 50 SM1014.2 +034700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1014.2 +034800Y MOVE SPACE TO DUMMY-RECORD SM1014.2 +034900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1014.2 +035000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1014.2 +035100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1014.2 +035200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1014.2 +035300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1014.2 +035400Y MOVE ZERO TO RECORD-COUNT. SM1014.2 +035500 PERFORM WRT-LN. SM1014.2 +035600 WRT-LN. SM1014.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1014.2 +035800 MOVE SPACE TO DUMMY-RECORD. SM1014.2 +035900 BLANK-LINE-PRINT. SM1014.2 +036000 PERFORM WRT-LN. SM1014.2 +036100 FAIL-ROUTINE. SM1014.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1014.2 +036300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1014.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1014.2 +036500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1014.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1014.2 +036800 GO TO FAIL-ROUTINE-EX. SM1014.2 +036900 FAIL-ROUTINE-WRITE. SM1014.2 +037000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1014.2 +037100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1014.2 +037200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1014.2 +037300 MOVE SPACES TO COR-ANSI-REFERENCE. SM1014.2 +037400 FAIL-ROUTINE-EX. EXIT. SM1014.2 +037500 BAIL-OUT. SM1014.2 +037600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1014.2 +037700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1014.2 +037800 BAIL-OUT-WRITE. SM1014.2 +037900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1014.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1014.2 +038100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1014.2 +038300 BAIL-OUT-EX. EXIT. SM1014.2 +038400 CCVS1-EXIT. SM1014.2 +038500 EXIT. SM1014.2 +038600 INITIALIZATION SECTION. SM1014.2 +038700 SM101A-INIT. SM1014.2 +038800 OPEN OUTPUT TEST-FILE. SM1014.2 +038900 MOVE "OUTPUT OF SM101A IS USED AS" TO RE-MARK. SM1014.2 +039000 PERFORM PRINT-DETAIL. SM1014.2 +039100 MOVE "INPUT FOR SM102A." TO RE-MARK. SM1014.2 +039200 PERFORM PRINT-DETAIL. SM1014.2 +039300 MOVE "COPY ---" TO FEATURE. SM1014.2 +039400 PERFORM PRINT-DETAIL. SM1014.2 +039500 WORKING-STORAGE-TEST SECTION. SM1014.2 +039600 COPY-TEST-1. SM1014.2 +039700 IF WSTR-1 EQUAL TO WSTR-2 SM1014.2 +039800 PERFORM PASS GO TO COPY-WRITE-1. SM1014.2 +039900* NOTE TESTS COPYING OF WORKING-STORAGE ENTRIES. SM1014.2 +040000 GO TO COPY-FAIL-1. SM1014.2 +040100 COPY-DELETE-1. SM1014.2 +040200 PERFORM DE-LETE. SM1014.2 +040300 GO TO COPY-WRITE-1. SM1014.2 +040400 COPY-FAIL-1. SM1014.2 +040500 MOVE WSTR-2 TO COMPUTED-A. SM1014.2 +040600 MOVE "ABC" TO CORRECT-A SM1014.2 +040700 PERFORM FAIL. SM1014.2 +040800 COPY-WRITE-1. SM1014.2 +040900 MOVE " WKNG-STORAGE ENTRY" TO FEATURE SM1014.2 +041000 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1014.2 +041100 PERFORM PRINT-DETAIL. SM1014.2 +041200 PARAGRAPH-TEST SECTION. SM1014.2 +041300 COPY-TEST-2. SM1014.2 +041400 SM1014.2 +041500 SM1014.2 +041600 SM1014.2 +041700 SM1014.2 +041800 SM1014.2 +041900* SM1014.2 +042000*********************** COPY STATEMENT USED **********************SM1014.2 +042100* SM1014.2 +042200* COPY K1PRA. SM1014.2 +042300* SM1014.2 +042400******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +042500 COPY K1PRA.SM1014.2 +042600*********************** END OF COPIED TEXT ***********************SM1014.2 +042700 COPY-TESTT-2. SM1014.2 +042800 IF PROC-1 EQUAL TO PROC-2 SM1014.2 +042900 PERFORM PASS GO TO COPY-WRITE-2. SM1014.2 +043000* NOTE TESTS COPYING OF A PROCEDURE DIVISION STATEMENT. SM1014.2 +043100 GO TO COPY-FAIL-2. SM1014.2 +043200 COPY-DELETE-2. SM1014.2 +043300 PERFORM DE-LETE. SM1014.2 +043400 GO TO COPY-WRITE-2. SM1014.2 +043500 COPY-FAIL-2. SM1014.2 +043600 MOVE PROC-2 TO COMPUTED-N. SM1014.2 +043700 MOVE 123 TO CORRECT-N. SM1014.2 +043800 PERFORM FAIL. SM1014.2 +043900 COPY-WRITE-2. SM1014.2 +044000 MOVE " PROCEDURE" TO FEATURE SM1014.2 +044100 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1014.2 +044200 PERFORM PRINT-DETAIL. SM1014.2 +044300 SECTION-TEST SECTION. SM1014.2 +044400 SM1014.2 +044500 SM1014.2 +044600 SM1014.2 +044700 SM1014.2 +044800 SM1014.2 +044900* SM1014.2 +045000*********************** COPY STATEMENT USED **********************SM1014.2 +045100* SM1014.2 +045200* COPY K1SEA. SM1014.2 +045300* SM1014.2 +045400******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +045500 COPY K1SEA.SM1014.2 +045600D COPY K1SEA.SM1014.2 +045700*********************** END OF COPIED TEXT ***********************SM1014.2 +045800 COPY-INIT-A. SM1014.2 +045900 MOVE " SECTION" TO FEATURE. SM1014.2 +046000 COPY-TEST-3. SM1014.2 +046100 IF COPYSECT-1 EQUAL TO 95427 SM1014.2 +046200 PERFORM PASS GO TO COPY-WRITE-3. SM1014.2 +046300* NOTE COPY-TEST-3, 4, 5, 6 TEST THE COPYING OF AN SM1014.2 +046400* ENTIRE SECTION. SM1014.2 +046500 GO TO COPY-FAIL-3. SM1014.2 +046600 COPY-DELETE-3. SM1014.2 +046700 PERFORM DE-LETE. SM1014.2 +046800 GO TO COPY-WRITE-3. SM1014.2 +046900 COPY-FAIL-3. SM1014.2 +047000 MOVE COPYSECT-1 TO COMPUTED-N. SM1014.2 +047100 MOVE 95427 TO CORRECT-N. SM1014.2 +047200 PERFORM FAIL. SM1014.2 +047300 COPY-WRITE-3. SM1014.2 +047400 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1014.2 +047500 PERFORM PRINT-DETAIL. SM1014.2 +047600 COPY-TEST-4. SM1014.2 +047700 IF COPYSECT-2 EQUAL TO 23121 SM1014.2 +047800 PERFORM PASS GO TO COPY-WRITE-4. SM1014.2 +047900 GO TO COPY-FAIL-4. SM1014.2 +048000 COPY-DELETE-4. SM1014.2 +048100 PERFORM DE-LETE. SM1014.2 +048200 GO TO COPY-WRITE-4. SM1014.2 +048300 COPY-FAIL-4. SM1014.2 +048400 MOVE COPYSECT-2 TO COMPUTED-N. SM1014.2 +048500 MOVE 23121 TO CORRECT-N. SM1014.2 +048600 PERFORM FAIL. SM1014.2 +048700 COPY-WRITE-4. SM1014.2 +048800 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1014.2 +048900 PERFORM PRINT-DETAIL. SM1014.2 +049000 COPY-TEST-5. SM1014.2 +049100 IF COPYSECT-3 EQUAL TO "LIBCO" SM1014.2 +049200 PERFORM PASS GO TO COPY-WRITE-5. SM1014.2 +049300 GO TO COPY-FAIL-5. SM1014.2 +049400 COPY-DELETE-5. SM1014.2 +049500 PERFORM DE-LETE. SM1014.2 +049600 GO TO COPY-WRITE-5. SM1014.2 +049700 COPY-FAIL-5. SM1014.2 +049800 MOVE COPYSECT-3 TO COMPUTED-A. SM1014.2 +049900 MOVE "LIBCO" TO CORRECT-A. SM1014.2 +050000 PERFORM FAIL. SM1014.2 +050100 COPY-WRITE-5. SM1014.2 +050200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1014.2 +050300 PERFORM PRINT-DETAIL. SM1014.2 +050400 COPY-TEST-6. SM1014.2 +050500 IF COPYSECT-4 EQUAL TO "PYTST" SM1014.2 +050600 PERFORM PASS GO TO COPY-WRITE-6. SM1014.2 +050700 GO TO COPY-FAIL-6. SM1014.2 +050800 COPY-DELETE-6. SM1014.2 +050900 PERFORM DE-LETE. SM1014.2 +051000 GO TO COPY-WRITE-6. SM1014.2 +051100 COPY-FAIL-6. SM1014.2 +051200 MOVE COPYSECT-4 TO COMPUTED-A. SM1014.2 +051300 MOVE "PYTST" TO CORRECT-A. SM1014.2 +051400 PERFORM FAIL. SM1014.2 +051500 COPY-WRITE-6. SM1014.2 +051600 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1014.2 +051700 PERFORM PRINT-DETAIL. SM1014.2 +051800 BUILD SECTION. SM1014.2 +051900 COPY-TEST-7. SM1014.2 +052000 MOVE RCD-1 TO TST-FLD-1. SM1014.2 +052100 WRITE TST-TEST. SM1014.2 +052200 MOVE RCD-2 TO TST-FLD-1. SM1014.2 +052300 WRITE TST-TEST. SM1014.2 +052400 MOVE RCD-3 TO TST-FLD-1. SM1014.2 +052500 WRITE TST-TEST. SM1014.2 +052600 MOVE RCD-4 TO TST-FLD-1. SM1014.2 +052700 WRITE TST-TEST. SM1014.2 +052800 MOVE RCD-5 TO TST-FLD-1. SM1014.2 +052900 WRITE TST-TEST. SM1014.2 +053000 MOVE RCD-6 TO TST-FLD-1. SM1014.2 +053100 WRITE TST-TEST. SM1014.2 +053200 MOVE RCD-7 TO TST-FLD-1. SM1014.2 +053300 WRITE TST-TEST. SM1014.2 +053400 PERFORM PASS. SM1014.2 +053500 GO TO COPY-WRITE-7. SM1014.2 +053600 COPY-DELETE-7. SM1014.2 +053700 PERFORM DE-LETE. SM1014.2 +053800 COPY-WRITE-7. SM1014.2 +053900 MOVE " FILE DESCRIPTION" TO FEATURE. SM1014.2 +054000 MOVE "COPY-TEST-7" TO PAR-NAME. SM1014.2 +054100 MOVE "OUTPUT CHECKED IN SM102A" TO RE-MARK. SM1014.2 +054200 PERFORM PRINT-DETAIL. SM1014.2 +054300 COPY-TEST-8. SM1014.2 +054400* SM1014.2 +054500*********************** COPY STATEMENT USED **********************SM1014.2 +054600* SM1014.2 +054700* ADD COPY K1P01. TO WRK-DS-05V00. SM1014.2 +054800* SM1014.2 +054900******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +055000 ADD COPY K1P01. TO WRK-DS-05V00. SM1014.2 +055100*********************** END OF COPIED TEXT ***********************SM1014.2 +055200 IF WRK-DS-05V00 EQUAL TO 97523 SM1014.2 +055300 PERFORM PASS SM1014.2 +055400 GO TO COPY-WRITE-8. SM1014.2 +055500 GO TO COPY-FAIL-8. SM1014.2 +055600 COPY-DELETE-8. SM1014.2 +055700 PERFORM DE-LETE. SM1014.2 +055800 GO TO COPY-WRITE-8. SM1014.2 +055900 COPY-FAIL-8. SM1014.2 +056000 MOVE WRK-DS-05V00 TO COMPUTED-N. SM1014.2 +056100 MOVE 97523 TO CORRECT-N. SM1014.2 +056200 PERFORM FAIL. SM1014.2 +056300 COPY-WRITE-8. SM1014.2 +056400 MOVE "COPY-TEST-8" TO PAR-NAME. SM1014.2 +056500 PERFORM PRINT-DETAIL. SM1014.2 +056600 CLOSE TEST-FILE. SM1014.2 +056700 CCVS-EXIT SECTION. SM1014.2 +056800 CCVS-999999. SM1014.2 +056900 GO TO CLOSE-FILES. SM1014.2 +*END-OF,SM101A +*HEADER,COBOL,SM101A,SUBPRG,SM102A +000100 IDENTIFICATION DIVISION. SM1024.2 +000200 PROGRAM-ID. SM1024.2 +000300 SM102A. SM1024.2 +000400**************************************************************** SM1024.2 +000500* * SM1024.2 +000600* VALIDATION FOR:- * SM1024.2 +000700* * SM1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +000900* * SM1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1024.2 +001100* * SM1024.2 +001200**************************************************************** SM1024.2 +001300* * SM1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1024.2 +001500* * SM1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1024.2 +001900* * SM1024.2 +002000**************************************************************** SM1024.2 +002100* * SM1024.2 +002200* PROGRAM SM102A TESTS THE OUTPUT FILE PRODUCED BY SM101A * SM1024.2 +002300* TO ENSURE THE PROPER EXECUTION OF THE "COPY" STATEMENT * SM1024.2 +002400* IN THAT PROGRAM. * SM1024.2 +002500* * SM1024.2 +002600**************************************************************** SM1024.2 +002700 ENVIRONMENT DIVISION. SM1024.2 +002800 CONFIGURATION SECTION. SM1024.2 +002900 SOURCE-COMPUTER. SM1024.2 +003000 XXXXX082. SM1024.2 +003100 OBJECT-COMPUTER. SM1024.2 +003200 XXXXX083. SM1024.2 +003300 INPUT-OUTPUT SECTION. SM1024.2 +003400 FILE-CONTROL. SM1024.2 +003500 SELECT PRINT-FILE ASSIGN TO SM1024.2 +003600 XXXXX055. SM1024.2 +003700 SELECT TEST-FILE ASSIGN TO SM1024.2 +003800 XXXXD001. SM1024.2 +003900 DATA DIVISION. SM1024.2 +004000 FILE SECTION. SM1024.2 +004100 FD PRINT-FILE. SM1024.2 +004200 01 PRINT-REC PICTURE X(120). SM1024.2 +004300 01 DUMMY-RECORD PICTURE X(120). SM1024.2 +004400 FD TEST-FILE SM1024.2 +004500 LABEL RECORD STANDARD SM1024.2 +004600C VALUE OF SM1024.2 +004700C XXXXX074 SM1024.2 +004800C IS SM1024.2 +004900C XXXXX075 SM1024.2 +005000G XXXXX069 SM1024.2 +005100 DATA RECORD IS TST-TEST. SM1024.2 +005200 01 TST-TEST. SM1024.2 +005300 02 TST-FLD-1 PICTURE 9(5). SM1024.2 +005400 02 FILLER PICTURE X(115). SM1024.2 +005500 WORKING-STORAGE SECTION. SM1024.2 +005600 01 TEST-RESULTS. SM1024.2 +005700 02 FILLER PIC X VALUE SPACE. SM1024.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. SM1024.2 +005900 02 FILLER PIC X VALUE SPACE. SM1024.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. SM1024.2 +006100 02 FILLER PIC X VALUE SPACE. SM1024.2 +006200 02 PAR-NAME. SM1024.2 +006300 03 FILLER PIC X(19) VALUE SPACE. SM1024.2 +006400 03 PARDOT-X PIC X VALUE SPACE. SM1024.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. SM1024.2 +006600 02 FILLER PIC X(8) VALUE SPACE. SM1024.2 +006700 02 RE-MARK PIC X(61). SM1024.2 +006800 01 TEST-COMPUTED. SM1024.2 +006900 02 FILLER PIC X(30) VALUE SPACE. SM1024.2 +007000 02 FILLER PIC X(17) VALUE SM1024.2 +007100 " COMPUTED=". SM1024.2 +007200 02 COMPUTED-X. SM1024.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1024.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A SM1024.2 +007500 PIC -9(9).9(9). SM1024.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1024.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1024.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1024.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. SM1024.2 +008000 04 COMPUTED-18V0 PIC -9(18). SM1024.2 +008100 04 FILLER PIC X. SM1024.2 +008200 03 FILLER PIC X(50) VALUE SPACE. SM1024.2 +008300 01 TEST-CORRECT. SM1024.2 +008400 02 FILLER PIC X(30) VALUE SPACE. SM1024.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". SM1024.2 +008600 02 CORRECT-X. SM1024.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. SM1024.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1024.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1024.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1024.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1024.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. SM1024.2 +009300 04 CORRECT-18V0 PIC -9(18). SM1024.2 +009400 04 FILLER PIC X. SM1024.2 +009500 03 FILLER PIC X(2) VALUE SPACE. SM1024.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1024.2 +009700 01 CCVS-C-1. SM1024.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1024.2 +009900- "SS PARAGRAPH-NAME SM1024.2 +010000- " REMARKS". SM1024.2 +010100 02 FILLER PIC X(20) VALUE SPACE. SM1024.2 +010200 01 CCVS-C-2. SM1024.2 +010300 02 FILLER PIC X VALUE SPACE. SM1024.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". SM1024.2 +010500 02 FILLER PIC X(15) VALUE SPACE. SM1024.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". SM1024.2 +010700 02 FILLER PIC X(94) VALUE SPACE. SM1024.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1024.2 +010900 01 REC-CT PIC 99 VALUE ZERO. SM1024.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1024.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1024.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1024.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1024.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1024.2 +011900 01 CCVS-H-1. SM1024.2 +012000 02 FILLER PIC X(39) VALUE SPACES. SM1024.2 +012100 02 FILLER PIC X(42) VALUE SM1024.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1024.2 +012300 02 FILLER PIC X(39) VALUE SPACES. SM1024.2 +012400 01 CCVS-H-2A. SM1024.2 +012500 02 FILLER PIC X(40) VALUE SPACE. SM1024.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1024.2 +012700 02 FILLER PIC XXXX VALUE SM1024.2 +012800 "4.2 ". SM1024.2 +012900 02 FILLER PIC X(28) VALUE SM1024.2 +013000 " COPY - NOT FOR DISTRIBUTION". SM1024.2 +013100 02 FILLER PIC X(41) VALUE SPACE. SM1024.2 +013200 SM1024.2 +013300 01 CCVS-H-2B. SM1024.2 +013400 02 FILLER PIC X(15) VALUE SM1024.2 +013500 "TEST RESULT OF ". SM1024.2 +013600 02 TEST-ID PIC X(9). SM1024.2 +013700 02 FILLER PIC X(4) VALUE SM1024.2 +013800 " IN ". SM1024.2 +013900 02 FILLER PIC X(12) VALUE SM1024.2 +014000 " HIGH ". SM1024.2 +014100 02 FILLER PIC X(22) VALUE SM1024.2 +014200 " LEVEL VALIDATION FOR ". SM1024.2 +014300 02 FILLER PIC X(58) VALUE SM1024.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +014500 01 CCVS-H-3. SM1024.2 +014600 02 FILLER PIC X(34) VALUE SM1024.2 +014700 " FOR OFFICIAL USE ONLY ". SM1024.2 +014800 02 FILLER PIC X(58) VALUE SM1024.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1024.2 +015000 02 FILLER PIC X(28) VALUE SM1024.2 +015100 " COPYRIGHT 1985 ". SM1024.2 +015200 01 CCVS-E-1. SM1024.2 +015300 02 FILLER PIC X(52) VALUE SPACE. SM1024.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1024.2 +015500 02 ID-AGAIN PIC X(9). SM1024.2 +015600 02 FILLER PIC X(45) VALUE SPACES. SM1024.2 +015700 01 CCVS-E-2. SM1024.2 +015800 02 FILLER PIC X(31) VALUE SPACE. SM1024.2 +015900 02 FILLER PIC X(21) VALUE SPACE. SM1024.2 +016000 02 CCVS-E-2-2. SM1024.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1024.2 +016200 03 FILLER PIC X VALUE SPACE. SM1024.2 +016300 03 ENDER-DESC PIC X(44) VALUE SM1024.2 +016400 "ERRORS ENCOUNTERED". SM1024.2 +016500 01 CCVS-E-3. SM1024.2 +016600 02 FILLER PIC X(22) VALUE SM1024.2 +016700 " FOR OFFICIAL USE ONLY". SM1024.2 +016800 02 FILLER PIC X(12) VALUE SPACE. SM1024.2 +016900 02 FILLER PIC X(58) VALUE SM1024.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +017100 02 FILLER PIC X(13) VALUE SPACE. SM1024.2 +017200 02 FILLER PIC X(15) VALUE SM1024.2 +017300 " COPYRIGHT 1985". SM1024.2 +017400 01 CCVS-E-4. SM1024.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1024.2 +017600 02 FILLER PIC X(4) VALUE " OF ". SM1024.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1024.2 +017800 02 FILLER PIC X(40) VALUE SM1024.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". SM1024.2 +018000 01 XXINFO. SM1024.2 +018100 02 FILLER PIC X(19) VALUE SM1024.2 +018200 "*** INFORMATION ***". SM1024.2 +018300 02 INFO-TEXT. SM1024.2 +018400 04 FILLER PIC X(8) VALUE SPACE. SM1024.2 +018500 04 XXCOMPUTED PIC X(20). SM1024.2 +018600 04 FILLER PIC X(5) VALUE SPACE. SM1024.2 +018700 04 XXCORRECT PIC X(20). SM1024.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). SM1024.2 +018900 01 HYPHEN-LINE. SM1024.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. SM1024.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************SM1024.2 +019200- "*****************************************". SM1024.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************SM1024.2 +019400- "******************************". SM1024.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE SM1024.2 +019600 "SM102A". SM1024.2 +019700 PROCEDURE DIVISION. SM1024.2 +019800 CCVS1 SECTION. SM1024.2 +019900 OPEN-FILES. SM1024.2 +020000 OPEN OUTPUT PRINT-FILE. SM1024.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1024.2 +020200 MOVE SPACE TO TEST-RESULTS. SM1024.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1024.2 +020400 GO TO CCVS1-EXIT. SM1024.2 +020500 CLOSE-FILES. SM1024.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1024.2 +020700 TERMINATE-CCVS. SM1024.2 +020800S EXIT PROGRAM. SM1024.2 +020900STERMINATE-CALL. SM1024.2 +021000 STOP RUN. SM1024.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1024.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1024.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1024.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1024.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. SM1024.2 +021600 PRINT-DETAIL. SM1024.2 +021700 IF REC-CT NOT EQUAL TO ZERO SM1024.2 +021800 MOVE "." TO PARDOT-X SM1024.2 +021900 MOVE REC-CT TO DOTVALUE. SM1024.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1024.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1024.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1024.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1024.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1024.2 +022500 MOVE SPACE TO CORRECT-X. SM1024.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1024.2 +022700 MOVE SPACE TO RE-MARK. SM1024.2 +022800 HEAD-ROUTINE. SM1024.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1024.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1024.2 +023300 COLUMN-NAMES-ROUTINE. SM1024.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +023700 END-ROUTINE. SM1024.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1024.2 +023900 END-RTN-EXIT. SM1024.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +024100 END-ROUTINE-1. SM1024.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1024.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1024.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. SM1024.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1024.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1024.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1024.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1024.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1024.2 +025000 END-ROUTINE-12. SM1024.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1024.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO SM1024.2 +025300 MOVE "NO " TO ERROR-TOTAL SM1024.2 +025400 ELSE SM1024.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1024.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1024.2 +025700 PERFORM WRITE-LINE. SM1024.2 +025800 END-ROUTINE-13. SM1024.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO SM1024.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE SM1024.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1024.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1024.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO SM1024.2 +026500 MOVE "NO " TO ERROR-TOTAL SM1024.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1024.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1024.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +027000 WRITE-LINE. SM1024.2 +027100 ADD 1 TO RECORD-COUNT. SM1024.2 +027200Y IF RECORD-COUNT GREATER 50 SM1024.2 +027300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1024.2 +027400Y MOVE SPACE TO DUMMY-RECORD SM1024.2 +027500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1024.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1024.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1024.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1024.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1024.2 +028000Y MOVE ZERO TO RECORD-COUNT. SM1024.2 +028100 PERFORM WRT-LN. SM1024.2 +028200 WRT-LN. SM1024.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1024.2 +028400 MOVE SPACE TO DUMMY-RECORD. SM1024.2 +028500 BLANK-LINE-PRINT. SM1024.2 +028600 PERFORM WRT-LN. SM1024.2 +028700 FAIL-ROUTINE. SM1024.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1024.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1024.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1024.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1024.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. SM1024.2 +029400 GO TO FAIL-ROUTINE-EX. SM1024.2 +029500 FAIL-ROUTINE-WRITE. SM1024.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1024.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1024.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1024.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. SM1024.2 +030000 FAIL-ROUTINE-EX. EXIT. SM1024.2 +030100 BAIL-OUT. SM1024.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1024.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1024.2 +030400 BAIL-OUT-WRITE. SM1024.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1024.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1024.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. SM1024.2 +030900 BAIL-OUT-EX. EXIT. SM1024.2 +031000 CCVS1-EXIT. SM1024.2 +031100 EXIT. SM1024.2 +031200 INITIALIZATION SECTION. SM1024.2 +031300 SM102-INIT. SM1024.2 +031400 OPEN INPUT TEST-FILE. SM1024.2 +031500 MOVE "SM102A CHECKS A FILE WHICH" TO RE-MARK. SM1024.2 +031600 PERFORM PRINT-DETAIL. SM1024.2 +031700 MOVE "WAS GENERATED IN SM101A." TO RE-MARK. SM1024.2 +031800 PERFORM PRINT-DETAIL. SM1024.2 +031900 MOVE "COPY FILE DESCR" TO FEATURE. SM1024.2 +032000 FD-TEST SECTION. SM1024.2 +032100 COPY-TEST-8. SM1024.2 +032200 PERFORM READ-TSTFILE. SM1024.2 +032300 IF TST-FLD-1 EQUAL TO 97523 SM1024.2 +032400 PERFORM PASS GO TO COPY-WRITE-8. SM1024.2 +032500 GO TO COPY-FAIL-8. SM1024.2 +032600 COPY-DELETE-8. SM1024.2 +032700 PERFORM DE-LETE. SM1024.2 +032800 GO TO COPY-WRITE-8. SM1024.2 +032900 COPY-FAIL-8. SM1024.2 +033000 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +033100 MOVE 97523 TO CORRECT-N. SM1024.2 +033200 PERFORM FAIL. SM1024.2 +033300 COPY-WRITE-8. SM1024.2 +033400 MOVE "COPY-TEST-8 " TO PAR-NAME. SM1024.2 +033500 PERFORM PRINT-DETAIL. SM1024.2 +033600 COPY-TEST-9. SM1024.2 +033700 PERFORM READ-TSTFILE. SM1024.2 +033800 IF TST-FLD-1 EQUAL TO 23497 SM1024.2 +033900 PERFORM PASS GO TO COPY-WRITE-9. SM1024.2 +034000 GO TO COPY-FAIL-9. SM1024.2 +034100 COPY-DELETE-9. SM1024.2 +034200 PERFORM DE-LETE. SM1024.2 +034300 GO TO COPY-WRITE-9. SM1024.2 +034400 COPY-FAIL-9. SM1024.2 +034500 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +034600 MOVE 23497 TO CORRECT-N. SM1024.2 +034700 PERFORM FAIL. SM1024.2 +034800 COPY-WRITE-9. SM1024.2 +034900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM1024.2 +035000 PERFORM PRINT-DETAIL. SM1024.2 +035100 COPY-TEST-10. SM1024.2 +035200 PERFORM READ-TSTFILE 3 TIMES. SM1024.2 +035300 IF TST-FLD-1 EQUAL TO 14003 SM1024.2 +035400 PERFORM PASS GO TO COPY-WRITE-10. SM1024.2 +035500 GO TO COPY-FAIL-10. SM1024.2 +035600 COPY-DELETE-10. SM1024.2 +035700 PERFORM DE-LETE. SM1024.2 +035800 GO TO COPY-WRITE-10. SM1024.2 +035900 COPY-FAIL-10. SM1024.2 +036000 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +036100 MOVE 14003 TO CORRECT-N. SM1024.2 +036200 PERFORM FAIL. SM1024.2 +036300 COPY-WRITE-10. SM1024.2 +036400 MOVE "COPY-TEST-10 " TO PAR-NAME. SM1024.2 +036500 PERFORM PRINT-DETAIL. SM1024.2 +036600 COPY-TEST-11. SM1024.2 +036700 PERFORM READ-TSTFILE 2 TIMES. SM1024.2 +036800 IF TST-FLD-1 EQUAL TO 03543 SM1024.2 +036900 PERFORM PASS GO TO COPY-WRITE-11. SM1024.2 +037000 GO TO COPY-FAIL-11. SM1024.2 +037100 COPY-DELETE-11. SM1024.2 +037200 PERFORM DE-LETE. SM1024.2 +037300 GO TO COPY-WRITE-11. SM1024.2 +037400 COPY-FAIL-11. SM1024.2 +037500 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +037600 MOVE 03543 TO CORRECT-N. SM1024.2 +037700 PERFORM FAIL. SM1024.2 +037800 COPY-WRITE-11. SM1024.2 +037900 MOVE "COPY-TEST-11 " TO PAR-NAME. SM1024.2 +038000 PERFORM PRINT-DETAIL. SM1024.2 +038100 CLOSE TEST-FILE. SM1024.2 +038200 GO TO CCVS-EXIT. SM1024.2 +038300 READ-TSTFILE. SM1024.2 +038400 READ TEST-FILE AT END GO TO BAD-FILE. SM1024.2 +038500 BAD-FILE. SM1024.2 +038600 PERFORM FAIL. SM1024.2 +038700 MOVE "BAD-FILE" TO PAR-NAME. SM1024.2 +038800 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1024.2 +038900 PERFORM PRINT-DETAIL. SM1024.2 +039000 CLOSE TEST-FILE. SM1024.2 +039100 CCVS-EXIT SECTION. SM1024.2 +039200 CCVS-999999. SM1024.2 +039300 GO TO CLOSE-FILES. SM1024.2 +*END-OF,SM102A +*HEADER,COBOL,SM103A +000100 IDENTIFICATION DIVISION. SM1034.2 +000200 PROGRAM-ID. SM1034.2 +000300 SM103A. SM1034.2 +000400**************************************************************** SM1034.2 +000500* * SM1034.2 +000600* VALIDATION FOR:- * SM1034.2 +000700* * SM1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +000900* * SM1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1034.2 +001100* * SM1034.2 +001200**************************************************************** SM1034.2 +001300* * SM1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1034.2 +001500* * SM1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1034.2 +001900* * SM1034.2 +002000**************************************************************** SM1034.2 +002100* * SM1034.2 +002200* PROGRAM SM103A TESTS THE USE OF THE "COPY" STATEMENT IN * SM1034.2 +002300* THE IDENTIFICATION DIVISION AND ENVIRONMENT DIVISION * SM1034.2 +002400* (SOURCE-COMPUTER, OBJECT-COMPUTER, SPECIAL-NAMES, * SM1034.2 +002500* FILE-CONTROL AND I-O-CONTROL ENTRIES). * SM1034.2 +002600* A SEQUENTIAL FILE IS PRODUCED WHICH IS READ AND CHECKED * SM1034.2 +002700* BY SM104A. * SM1034.2 +002800* THE MAXIMUM AND MINIMUM LENGTHS OF A LIBRARY TEXT WORD * SM1034.2 +002900* ARE ALSO TESTED. * SM1034.2 +003000* * SM1034.2 +003100**************************************************************** SM1034.2 +003200 SECURITY. SM1034.2 +003300 COPY K3SNA. SM1034.2 +003400 ENVIRONMENT DIVISION. SM1034.2 +003500 CONFIGURATION SECTION. SM1034.2 +003600 SM1034.2 +003700 SM1034.2 +003800 SM1034.2 +003900 SM1034.2 +004000 SM1034.2 +004100* SM1034.2 +004200*********************** COPY STATEMENT USED **********************SM1034.2 +004300* SM1034.2 +004400*SOURCE-COMPUTER. COPY K3SCA SM1034.2 +004500* SM1034.2 +004600******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +004700 SOURCE-COMPUTER. COPY K3SCA.SM1034.2 +004800*********************** END OF COPIED TEXT ***********************SM1034.2 +004900 SM1034.2 +005000 SM1034.2 +005100 SM1034.2 +005200 SM1034.2 +005300 SM1034.2 +005400* SM1034.2 +005500*********************** COPY STATEMENT USED **********************SM1034.2 +005600* SM1034.2 +005700*OBJECT-COMPUTER. COPY K3OCA SM1034.2 +005800* SM1034.2 +005900******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +006000 OBJECT-COMPUTER. COPY K3OCA.SM1034.2 +006100*********************** END OF COPIED TEXT ***********************SM1034.2 +006200 SM1034.2 +006300 SM1034.2 +006400 SM1034.2 +006500 SM1034.2 +006600 SM1034.2 +006700* SM1034.2 +006800*********************** COPY STATEMENT USED **********************SM1034.2 +006900* SM1034.2 +007000*SPECIAL-NAMES. COPY K3SNA. SM1034.2 +007100* SM1034.2 +007200******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +007300 SPECIAL-NAMES. COPY K3SNA.SM1034.2 +007400*********************** END OF COPIED TEXT ***********************SM1034.2 +007500 INPUT-OUTPUT SECTION. SM1034.2 +007600 SM1034.2 +007700 SM1034.2 +007800 SM1034.2 +007900 SM1034.2 +008000 SM1034.2 +008100* SM1034.2 +008200*********************** COPY STATEMENT USED **********************SM1034.2 +008300* SM1034.2 +008400*FILE-CONTROL. COPY K3FCA. SM1034.2 +008500* SM1034.2 +008600******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +008700 FILE-CONTROL. COPY K3FCA.SM1034.2 +008800*********************** END OF COPIED TEXT ***********************SM1034.2 +008900 SM1034.2 +009000 SM1034.2 +009100 SM1034.2 +009200 SM1034.2 +009300 SM1034.2 +009400* SM1034.2 +009500*********************** COPY STATEMENT USED **********************SM1034.2 +009600* SM1034.2 +009700*I-O-CONTROL COPY K3IOA SM1034.2 +009800* SM1034.2 +009900******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +010000 I-O-CONTROL. COPY K3IOA.SM1034.2 +010100*********************** END OF COPIED TEXT ***********************SM1034.2 +010200 DATA DIVISION. SM1034.2 +010300 FILE SECTION. SM1034.2 +010400 FD PRINT-FILE. SM1034.2 +010500 01 PRINT-REC PICTURE X(120). SM1034.2 +010600 01 DUMMY-RECORD PICTURE X(120). SM1034.2 +010700 FD TEST-FILE SM1034.2 +010800 LABEL RECORD STANDARD SM1034.2 +010900C VALUE OF SM1034.2 +011000C XXXXX074 SM1034.2 +011100C IS SM1034.2 +011200C XXXXX075 SM1034.2 +011300G XXXXX069 SM1034.2 +011400 DATA RECORD TEST-REC. SM1034.2 +011500 01 TEST-REC. SM1034.2 +011600 02 TST-FLD-1 PICTURE 9(5). SM1034.2 +011700 02 TST-FLD-2 PICTURE X(13). SM1034.2 +011800 02 FILLER PICTURE X(102). SM1034.2 +011900 FD TEST-FILE2 SM1034.2 +012000 LABEL RECORD STANDARD SM1034.2 +012100C VALUE OF SM1034.2 +012200C XXXXX074 SM1034.2 +012300C IS SM1034.2 +012400C XXXXX076 SM1034.2 +012500G XXXXX069 SM1034.2 +012600 DATA RECORD TEST-REC2. SM1034.2 +012700 01 TEST-REC2. SM1034.2 +012800 02 TST-FLD-3 PICTURE 9(5). SM1034.2 +012900 02 TST-FLD-4 PICTURE X(13). SM1034.2 +013000 02 FILLER PICTURE X(102). SM1034.2 +013100 WORKING-STORAGE SECTION. SM1034.2 +013200 77 RCD-1 PICTURE 9(5) VALUE 97532. SM1034.2 +013300 77 RCD-2 PICTURE 9(5) VALUE 23479. SM1034.2 +013400 77 RCD-3 PICTURE 9(5) VALUE 10901. SM1034.2 +013500 77 RCD-4 PICTURE 9(5) VALUE 02734. SM1034.2 +013600 77 RCD-5 PICTURE 9(5) VALUE 14003. SM1034.2 +013700 77 RCD-6 PICTURE 9(5) VALUE 19922. SM1034.2 +013800 77 RCD-7 PICTURE 9(5) VALUE 03543. SM1034.2 +013900 01 S-N-1 PICTURE 9(8)V99 VALUE IS 12345678,91. SM1034.2 +014000 01 S-N-2 PICTURE ZZ.ZZZ.ZZZ,99. SM1034.2 +014100 01 WRK-DU-9 PIC 9 VALUE ZERO. SM1034.2 +014200 01 WRK-DU-99 PIC 99 VALUE ZERO. SM1034.2 +014300 01 WRK-DU-99-LONGER PIC 99 VALUE ZERO. SM1034.2 +014400 01 WRK-DU-00001 PIC 9. SM1034.2 +014500 01 WRK-XN-00322 PIC X(322). SM1034.2 +014600 01 FILLER REDEFINES WRK-XN-00322. SM1034.2 +014700 03 WRK-XN-00322-1 PIC X. SM1034.2 +014800 03 WRK-XN-00322-2-322. SM1034.2 +014900 05 WRK-XN-00322-2-3 PIC X. SM1034.2 +015000 05 WRK-XN-00322-20 PIC X(20) SM1034.2 +015100 OCCURS 16 SM1034.2 +015200 INDEXED BY X1. SM1034.2 +015300 01 TEST-RESULTS. SM1034.2 +015400 02 FILLER PIC X VALUE SPACE. SM1034.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. SM1034.2 +015600 02 FILLER PIC X VALUE SPACE. SM1034.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. SM1034.2 +015800 02 FILLER PIC X VALUE SPACE. SM1034.2 +015900 02 PAR-NAME. SM1034.2 +016000 03 FILLER PIC X(19) VALUE SPACE. SM1034.2 +016100 03 PARDOT-X PIC X VALUE SPACE. SM1034.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. SM1034.2 +016300 02 FILLER PIC X(8) VALUE SPACE. SM1034.2 +016400 02 RE-MARK PIC X(61). SM1034.2 +016500 01 TEST-COMPUTED. SM1034.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SM1034.2 +016700 02 FILLER PIC X(17) VALUE SM1034.2 +016800 " COMPUTED=". SM1034.2 +016900 02 COMPUTED-X. SM1034.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1034.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A SM1034.2 +017200 PIC -9(9).9(9). SM1034.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1034.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1034.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1034.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. SM1034.2 +017700 04 COMPUTED-18V0 PIC -9(18). SM1034.2 +017800 04 FILLER PIC X. SM1034.2 +017900 03 FILLER PIC X(50) VALUE SPACE. SM1034.2 +018000 01 TEST-CORRECT. SM1034.2 +018100 02 FILLER PIC X(30) VALUE SPACE. SM1034.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". SM1034.2 +018300 02 CORRECT-X. SM1034.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. SM1034.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1034.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1034.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1034.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1034.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. SM1034.2 +019000 04 CORRECT-18V0 PIC -9(18). SM1034.2 +019100 04 FILLER PIC X. SM1034.2 +019200 03 FILLER PIC X(2) VALUE SPACE. SM1034.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1034.2 +019400 01 CCVS-C-1. SM1034.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1034.2 +019600- "SS PARAGRAPH-NAME SM1034.2 +019700- " REMARKS". SM1034.2 +019800 02 FILLER PIC X(20) VALUE SPACE. SM1034.2 +019900 01 CCVS-C-2. SM1034.2 +020000 02 FILLER PIC X VALUE SPACE. SM1034.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". SM1034.2 +020200 02 FILLER PIC X(15) VALUE SPACE. SM1034.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". SM1034.2 +020400 02 FILLER PIC X(94) VALUE SPACE. SM1034.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1034.2 +020600 01 REC-CT PIC 99 VALUE ZERO. SM1034.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1034.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1034.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1034.2 +021600 01 CCVS-H-1. SM1034.2 +021700 02 FILLER PIC X(39) VALUE SPACES. SM1034.2 +021800 02 FILLER PIC X(42) VALUE SM1034.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1034.2 +022000 02 FILLER PIC X(39) VALUE SPACES. SM1034.2 +022100 01 CCVS-H-2A. SM1034.2 +022200 02 FILLER PIC X(40) VALUE SPACE. SM1034.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1034.2 +022400 02 FILLER PIC XXXX VALUE SM1034.2 +022500 "4.2 ". SM1034.2 +022600 02 FILLER PIC X(28) VALUE SM1034.2 +022700 " COPY - NOT FOR DISTRIBUTION". SM1034.2 +022800 02 FILLER PIC X(41) VALUE SPACE. SM1034.2 +022900 SM1034.2 +023000 01 CCVS-H-2B. SM1034.2 +023100 02 FILLER PIC X(15) VALUE SM1034.2 +023200 "TEST RESULT OF ". SM1034.2 +023300 02 TEST-ID PIC X(9). SM1034.2 +023400 02 FILLER PIC X(4) VALUE SM1034.2 +023500 " IN ". SM1034.2 +023600 02 FILLER PIC X(12) VALUE SM1034.2 +023700 " HIGH ". SM1034.2 +023800 02 FILLER PIC X(22) VALUE SM1034.2 +023900 " LEVEL VALIDATION FOR ". SM1034.2 +024000 02 FILLER PIC X(58) VALUE SM1034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +024200 01 CCVS-H-3. SM1034.2 +024300 02 FILLER PIC X(34) VALUE SM1034.2 +024400 " FOR OFFICIAL USE ONLY ". SM1034.2 +024500 02 FILLER PIC X(58) VALUE SM1034.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1034.2 +024700 02 FILLER PIC X(28) VALUE SM1034.2 +024800 " COPYRIGHT 1985 ". SM1034.2 +024900 01 CCVS-E-1. SM1034.2 +025000 02 FILLER PIC X(52) VALUE SPACE. SM1034.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1034.2 +025200 02 ID-AGAIN PIC X(9). SM1034.2 +025300 02 FILLER PIC X(45) VALUE SPACES. SM1034.2 +025400 01 CCVS-E-2. SM1034.2 +025500 02 FILLER PIC X(31) VALUE SPACE. SM1034.2 +025600 02 FILLER PIC X(21) VALUE SPACE. SM1034.2 +025700 02 CCVS-E-2-2. SM1034.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1034.2 +025900 03 FILLER PIC X VALUE SPACE. SM1034.2 +026000 03 ENDER-DESC PIC X(44) VALUE SM1034.2 +026100 "ERRORS ENCOUNTERED". SM1034.2 +026200 01 CCVS-E-3. SM1034.2 +026300 02 FILLER PIC X(22) VALUE SM1034.2 +026400 " FOR OFFICIAL USE ONLY". SM1034.2 +026500 02 FILLER PIC X(12) VALUE SPACE. SM1034.2 +026600 02 FILLER PIC X(58) VALUE SM1034.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +026800 02 FILLER PIC X(13) VALUE SPACE. SM1034.2 +026900 02 FILLER PIC X(15) VALUE SM1034.2 +027000 " COPYRIGHT 1985". SM1034.2 +027100 01 CCVS-E-4. SM1034.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1034.2 +027300 02 FILLER PIC X(4) VALUE " OF ". SM1034.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1034.2 +027500 02 FILLER PIC X(40) VALUE SM1034.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". SM1034.2 +027700 01 XXINFO. SM1034.2 +027800 02 FILLER PIC X(19) VALUE SM1034.2 +027900 "*** INFORMATION ***". SM1034.2 +028000 02 INFO-TEXT. SM1034.2 +028100 04 FILLER PIC X(8) VALUE SPACE. SM1034.2 +028200 04 XXCOMPUTED PIC X(20). SM1034.2 +028300 04 FILLER PIC X(5) VALUE SPACE. SM1034.2 +028400 04 XXCORRECT PIC X(20). SM1034.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). SM1034.2 +028600 01 HYPHEN-LINE. SM1034.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. SM1034.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************SM1034.2 +028900- "*****************************************". SM1034.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************SM1034.2 +029100- "******************************". SM1034.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE SM1034.2 +029300 "SM103A". SM1034.2 +029400 PROCEDURE DIVISION. SM1034.2 +029500 CCVS1 SECTION. SM1034.2 +029600 OPEN-FILES. SM1034.2 +029700 OPEN OUTPUT PRINT-FILE. SM1034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1034.2 +029900 MOVE SPACE TO TEST-RESULTS. SM1034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1034.2 +030100 GO TO CCVS1-EXIT. SM1034.2 +030200 CLOSE-FILES. SM1034.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1034.2 +030400 TERMINATE-CCVS. SM1034.2 +030500S EXIT PROGRAM. SM1034.2 +030600STERMINATE-CALL. SM1034.2 +030700 STOP RUN. SM1034.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1034.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1034.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1034.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1034.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SM1034.2 +031300 PRINT-DETAIL. SM1034.2 +031400 IF REC-CT NOT EQUAL TO ZERO SM1034.2 +031500 MOVE "." TO PARDOT-X SM1034.2 +031600 MOVE REC-CT TO DOTVALUE. SM1034.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1034.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1034.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1034.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1034.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1034.2 +032200 MOVE SPACE TO CORRECT-X. SM1034.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1034.2 +032400 MOVE SPACE TO RE-MARK. SM1034.2 +032500 HEAD-ROUTINE. SM1034.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1034.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1034.2 +033000 COLUMN-NAMES-ROUTINE. SM1034.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +033400 END-ROUTINE. SM1034.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1034.2 +033600 END-RTN-EXIT. SM1034.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +033800 END-ROUTINE-1. SM1034.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1034.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1034.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SM1034.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1034.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1034.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1034.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1034.2 +034700 END-ROUTINE-12. SM1034.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1034.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SM1034.2 +035000 MOVE "NO " TO ERROR-TOTAL SM1034.2 +035100 ELSE SM1034.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1034.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1034.2 +035400 PERFORM WRITE-LINE. SM1034.2 +035500 END-ROUTINE-13. SM1034.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO SM1034.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SM1034.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1034.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1034.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SM1034.2 +036200 MOVE "NO " TO ERROR-TOTAL SM1034.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1034.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1034.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036700 WRITE-LINE. SM1034.2 +036800 ADD 1 TO RECORD-COUNT. SM1034.2 +036900Y IF RECORD-COUNT GREATER 50 SM1034.2 +037000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1034.2 +037100Y MOVE SPACE TO DUMMY-RECORD SM1034.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1034.2 +037300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1034.2 +037400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1034.2 +037500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1034.2 +037600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1034.2 +037700Y MOVE ZERO TO RECORD-COUNT. SM1034.2 +037800 PERFORM WRT-LN. SM1034.2 +037900 WRT-LN. SM1034.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1034.2 +038100 MOVE SPACE TO DUMMY-RECORD. SM1034.2 +038200 BLANK-LINE-PRINT. SM1034.2 +038300 PERFORM WRT-LN. SM1034.2 +038400 FAIL-ROUTINE. SM1034.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1034.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1034.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1034.2 +038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1034.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +039000 MOVE SPACES TO INF-ANSI-REFERENCE. SM1034.2 +039100 GO TO FAIL-ROUTINE-EX. SM1034.2 +039200 FAIL-ROUTINE-WRITE. SM1034.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1034.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1034.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1034.2 +039600 MOVE SPACES TO COR-ANSI-REFERENCE. SM1034.2 +039700 FAIL-ROUTINE-EX. EXIT. SM1034.2 +039800 BAIL-OUT. SM1034.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1034.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1034.2 +040100 BAIL-OUT-WRITE. SM1034.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1034.2 +040300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1034.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. SM1034.2 +040600 BAIL-OUT-EX. EXIT. SM1034.2 +040700 CCVS1-EXIT. SM1034.2 +040800 EXIT. SM1034.2 +040900 INITIALIZATION SECTION. SM1034.2 +041000 SM103A-INIT. SM1034.2 +041100 MOVE "ALL TESTS IN SM103A PRODUCE" TO RE-MARK. SM1034.2 +041200 PERFORM PRINT-DETAIL. SM1034.2 +041300 MOVE "OUTPUT CHECKED IN SM104A." TO RE-MARK. SM1034.2 +041400 PERFORM PRINT-DETAIL. SM1034.2 +041500 MOVE "COPY ---" TO FEATURE. SM1034.2 +041600 PERFORM PRINT-DETAIL. SM1034.2 +041700 SPECIAL-NAMES-TEST SECTION. SM1034.2 +041800 COPY-TEST-1. SM1034.2 +041900 MOVE S-N-1 TO S-N-2. SM1034.2 +042000* NOTE THIS ROUTINE USES A COPIED DECIMAL-POINT IS COMMA SM1034.2 +042100* CLAUSE IN SPECIAL-NAMES --- THE EDITING IN S-N-2 SM1034.2 +042200* WOULD NOT BE VALID WITHOUT THIS CLAUSE. SM1034.2 +042300 PERFORM PASS. SM1034.2 +042400 GO TO COPY-WRITE-1. SM1034.2 +042500 COPY-DELETE-1. SM1034.2 +042600 PERFORM DE-LETE. SM1034.2 +042700 COPY-WRITE-1. SM1034.2 +042800 MOVE " DEC POINT IS COMMA" TO FEATURE. SM1034.2 +042900 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1034.2 +043000 PERFORM PRINT-DETAIL. SM1034.2 +043100 BUILD SECTION. SM1034.2 +043200 COPY-TEST-2. SM1034.2 +043300 OPEN OUTPUT TEST-FILE. SM1034.2 +043400 MOVE S-N-2 TO TST-FLD-2. SM1034.2 +043500 MOVE RCD-1 TO TST-FLD-1. SM1034.2 +043600 WRITE TEST-REC. SM1034.2 +043700 MOVE RCD-2 TO TST-FLD-1. SM1034.2 +043800 WRITE TEST-REC. SM1034.2 +043900 MOVE RCD-3 TO TST-FLD-1. SM1034.2 +044000 WRITE TEST-REC. SM1034.2 +044100 MOVE RCD-4 TO TST-FLD-1. SM1034.2 +044200 WRITE TEST-REC. SM1034.2 +044300 MOVE RCD-5 TO TST-FLD-1. SM1034.2 +044400 WRITE TEST-REC. SM1034.2 +044500 MOVE RCD-6 TO TST-FLD-1. SM1034.2 +044600 WRITE TEST-REC. SM1034.2 +044700 MOVE RCD-7 TO TST-FLD-1. SM1034.2 +044800 WRITE TEST-REC. SM1034.2 +044900 CLOSE TEST-FILE. SM1034.2 +045000 OPEN OUTPUT TEST-FILE2. SM1034.2 +045100 MOVE ZERO TO TST-FLD-3. SM1034.2 +045200 MOVE "DDDDD" TO TST-FLD-4. SM1034.2 +045300 WRITE TEST-REC2. SM1034.2 +045400 CLOSE TEST-FILE2. SM1034.2 +045500 PERFORM PASS. SM1034.2 +045600 GO TO COPY-WRITE-2. SM1034.2 +045700 COPY-DELETE-2. SM1034.2 +045800 PERFORM DE-LETE. SM1034.2 +045900 COPY-WRITE-2. SM1034.2 +046000 MOVE " ENVIR DIV ENTRIES" TO FEATURE. SM1034.2 +046100 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1034.2 +046200 PERFORM PRINT-DETAIL. SM1034.2 +046300* SM1034.2 +046400 COPY-TEST-3. SM1034.2 +046500* ===--> MINIMUM LENGTH TEXT WORD <--=== SM1034.2 +046600 MOVE "XII-2 2.3 SR8" TO ANSI-REFERENCE. SM1034.2 +046700 MOVE "COPY-TEST-3" TO PAR-NAME. SM1034.2 +046800 MOVE 8 TO WRK-DU-00001. SM1034.2 +046900 GO TO COPY-TEST-3-0. SM1034.2 +047000 COPY-DELETE-3. SM1034.2 +047100 PERFORM DE-LETE. SM1034.2 +047200 PERFORM PRINT-DETAIL. SM1034.2 +047300 GO TO COPY-INIT-4. SM1034.2 +047400 COPY-TEST-3-0. SM1034.2 +047500********************* COPY TEXT USED *************************** SM1034.2 +047600* 8 * SM1034.2 +047700*********************END OF COPY TEXT*************************** SM1034.2 +047800 IF WRK-DU-00001 = SM1034.2 +047900 COPY K3SML. SM1034.2 +048000 PERFORM PASS SM1034.2 +048100 PERFORM PRINT-DETAIL SM1034.2 +048200 ELSE SM1034.2 +048300 MOVE "COPYING SINGLE CHARACTER FAILED" SM1034.2 +048400 TO RE-MARK SM1034.2 +048500 MOVE 8 TO CORRECT-N SM1034.2 +048600 MOVE WRK-DU-00001 TO COMPUTED-N SM1034.2 +048700 PERFORM FAIL SM1034.2 +048800 PERFORM PRINT-DETAIL. SM1034.2 +048900* SM1034.2 +049000 COPY-INIT-4. SM1034.2 +049100* ===--> MAXIMUM LENGTH TEXT WORD <--=== SM1034.2 +049200 MOVE "XII-2 2.3 (SR8) AND XII-5 2.4(GR11)" SM1034.2 +049300 TO ANSI-REFERENCE. SM1034.2 +049400 MOVE "COPY-TEST-4" TO PAR-NAME. SM1034.2 +049500 MOVE SPACES TO WRK-XN-00322. SM1034.2 +049600 MOVE 1 TO REC-CT. SM1034.2 +049700 GO TO COPY-TEST-4-0. SM1034.2 +049800 COPY-DELETE-4. SM1034.2 +049900 PERFORM DE-LETE. SM1034.2 +050000 PERFORM PRINT-DETAIL. SM1034.2 +050100 GO TO CCVS-EXIT. SM1034.2 +050200 COPY-TEST-4-0. SM1034.2 +050300********************* COPY TEXT USED *************************** SM1034.2 +050400* MOVE 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADDSM1034.2 +050500* 1 TO WRK-DU-99, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1SM1034.2 +050600* TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 SM1034.2 +050700* TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1 TO SM1034.2 +050800* WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 10 TO SM1034.2 +050900* WRK-DU-99-LONGER. SM1034.2 +051000*********************END OF COPY TEXT*************************** SM1034.2 +051100* SM1034.2 +051200 COPY K3LGE. SM1034.2 +051300* SM1034.2 +051400 COPY-TEST-4-1. SM1034.2 +051500 MOVE "COPY-TEST-4-1" TO PAR-NAME. SM1034.2 +051600 IF WRK-DU-9 = 6 SM1034.2 +051700 PERFORM PASS SM1034.2 +051800 PERFORM PRINT-DETAIL SM1034.2 +051900 ELSE SM1034.2 +052000 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +052100 TO RE-MARK SM1034.2 +052200 MOVE 6 TO CORRECT-N SM1034.2 +052300 MOVE WRK-DU-9 TO COMPUTED-N SM1034.2 +052400 PERFORM FAIL SM1034.2 +052500 PERFORM PRINT-DETAIL. SM1034.2 +052600 ADD 1 TO REC-CT. SM1034.2 +052700 COPY-TEST-4-2. SM1034.2 +052800 MOVE "COPY-TEST-4-2" TO PAR-NAME. SM1034.2 +052900 IF WRK-DU-99 = 9 SM1034.2 +053000 PERFORM PASS SM1034.2 +053100 PERFORM PRINT-DETAIL SM1034.2 +053200 ELSE SM1034.2 +053300 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +053400 TO RE-MARK SM1034.2 +053500 MOVE 9 TO CORRECT-N SM1034.2 +053600 MOVE WRK-DU-99 TO COMPUTED-N SM1034.2 +053700 PERFORM FAIL SM1034.2 +053800 PERFORM PRINT-DETAIL. SM1034.2 +053900 ADD 1 TO REC-CT. SM1034.2 +054000 COPY-TEST-4-3. SM1034.2 +054100 MOVE "COPY-TEST-4-3" TO PAR-NAME. SM1034.2 +054200 IF WRK-DU-99-LONGER = 10 SM1034.2 +054300 PERFORM PASS SM1034.2 +054400 PERFORM PRINT-DETAIL SM1034.2 +054500 ELSE SM1034.2 +054600 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +054700 TO RE-MARK SM1034.2 +054800 MOVE 10 TO CORRECT-N SM1034.2 +054900 MOVE WRK-DU-99-LONGER TO COMPUTED-N SM1034.2 +055000 PERFORM FAIL SM1034.2 +055100 PERFORM PRINT-DETAIL. SM1034.2 +055200* SM1034.2 +055300 CCVS-EXIT SECTION. SM1034.2 +055400 CCVS-999999. SM1034.2 +055500 GO TO CLOSE-FILES. SM1034.2 +*END-OF,SM103A +*HEADER,COBOL,SM103A,SUBPRG,SM104A +000100 IDENTIFICATION DIVISION. SM1044.2 +000200 PROGRAM-ID. SM1044.2 +000300 SM104A. SM1044.2 +000400**************************************************************** SM1044.2 +000500* * SM1044.2 +000600* VALIDATION FOR:- * SM1044.2 +000700* * SM1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +000900* * SM1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1044.2 +001100* * SM1044.2 +001200**************************************************************** SM1044.2 +001300* * SM1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1044.2 +001500* * SM1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1044.2 +001900* * SM1044.2 +002000**************************************************************** SM1044.2 +002100* * SM1044.2 +002200* PROGRAM SM104A READS AND CHECKS THE FILE PRODUCED BY * SM1044.2 +002300* SM103A TO VERIFY THE PROPER EXECUTION OF THE "COPY" * SM1044.2 +002400* STATEMENTS IN THAT PROGRAM. * SM1044.2 +002500* * SM1044.2 +002600**************************************************************** SM1044.2 +002700 ENVIRONMENT DIVISION. SM1044.2 +002800 CONFIGURATION SECTION. SM1044.2 +002900 SOURCE-COMPUTER. SM1044.2 +003000 XXXXX082. SM1044.2 +003100 OBJECT-COMPUTER. SM1044.2 +003200 XXXXX083. SM1044.2 +003300 INPUT-OUTPUT SECTION. SM1044.2 +003400 FILE-CONTROL. SM1044.2 +003500 SELECT PRINT-FILE ASSIGN TO SM1044.2 +003600 XXXXX055. SM1044.2 +003700 SELECT TEST-FILE ASSIGN TO SM1044.2 +003800* THE FOLLOWING LINE WILL BE CHANGED BY TPF ONLY WHEN THE SM1044.2 +003900* PROGRAM-ID IS PART OF THE REPLACEMENT BY THE X-CARD SM1044.2 +004000* DURING EXTRACTION. SM1044.2 +004100 XXXXD001. SM1044.2 +004200 DATA DIVISION. SM1044.2 +004300 FILE SECTION. SM1044.2 +004400 FD PRINT-FILE. SM1044.2 +004500 01 PRINT-REC PICTURE X(120). SM1044.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1044.2 +004700 FD TEST-FILE SM1044.2 +004800 LABEL RECORD STANDARD SM1044.2 +004900C VALUE OF SM1044.2 +005000C XXXXX074 SM1044.2 +005100C IS SM1044.2 +005200C XXXXX075 SM1044.2 +005300G XXXXX069 SM1044.2 +005400 DATA RECORD TEST-REC. SM1044.2 +005500 01 TEST-REC. SM1044.2 +005600 02 TST-FLD-1 PICTURE 9(5). SM1044.2 +005700 02 TST-FLD-2 PICTURE X(13). SM1044.2 +005800 02 FILLER PICTURE X(102). SM1044.2 +005900 WORKING-STORAGE SECTION. SM1044.2 +006000 01 TEST-RESULTS. SM1044.2 +006100 02 FILLER PIC X VALUE SPACE. SM1044.2 +006200 02 FEATURE PIC X(20) VALUE SPACE. SM1044.2 +006300 02 FILLER PIC X VALUE SPACE. SM1044.2 +006400 02 P-OR-F PIC X(5) VALUE SPACE. SM1044.2 +006500 02 FILLER PIC X VALUE SPACE. SM1044.2 +006600 02 PAR-NAME. SM1044.2 +006700 03 FILLER PIC X(19) VALUE SPACE. SM1044.2 +006800 03 PARDOT-X PIC X VALUE SPACE. SM1044.2 +006900 03 DOTVALUE PIC 99 VALUE ZERO. SM1044.2 +007000 02 FILLER PIC X(8) VALUE SPACE. SM1044.2 +007100 02 RE-MARK PIC X(61). SM1044.2 +007200 01 TEST-COMPUTED. SM1044.2 +007300 02 FILLER PIC X(30) VALUE SPACE. SM1044.2 +007400 02 FILLER PIC X(17) VALUE SM1044.2 +007500 " COMPUTED=". SM1044.2 +007600 02 COMPUTED-X. SM1044.2 +007700 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1044.2 +007800 03 COMPUTED-N REDEFINES COMPUTED-A SM1044.2 +007900 PIC -9(9).9(9). SM1044.2 +008000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1044.2 +008100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1044.2 +008200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1044.2 +008300 03 CM-18V0 REDEFINES COMPUTED-A. SM1044.2 +008400 04 COMPUTED-18V0 PIC -9(18). SM1044.2 +008500 04 FILLER PIC X. SM1044.2 +008600 03 FILLER PIC X(50) VALUE SPACE. SM1044.2 +008700 01 TEST-CORRECT. SM1044.2 +008800 02 FILLER PIC X(30) VALUE SPACE. SM1044.2 +008900 02 FILLER PIC X(17) VALUE " CORRECT =". SM1044.2 +009000 02 CORRECT-X. SM1044.2 +009100 03 CORRECT-A PIC X(20) VALUE SPACE. SM1044.2 +009200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1044.2 +009300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1044.2 +009400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1044.2 +009500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1044.2 +009600 03 CR-18V0 REDEFINES CORRECT-A. SM1044.2 +009700 04 CORRECT-18V0 PIC -9(18). SM1044.2 +009800 04 FILLER PIC X. SM1044.2 +009900 03 FILLER PIC X(2) VALUE SPACE. SM1044.2 +010000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1044.2 +010100 01 CCVS-C-1. SM1044.2 +010200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1044.2 +010300- "SS PARAGRAPH-NAME SM1044.2 +010400- " REMARKS". SM1044.2 +010500 02 FILLER PIC X(20) VALUE SPACE. SM1044.2 +010600 01 CCVS-C-2. SM1044.2 +010700 02 FILLER PIC X VALUE SPACE. SM1044.2 +010800 02 FILLER PIC X(6) VALUE "TESTED". SM1044.2 +010900 02 FILLER PIC X(15) VALUE SPACE. SM1044.2 +011000 02 FILLER PIC X(4) VALUE "FAIL". SM1044.2 +011100 02 FILLER PIC X(94) VALUE SPACE. SM1044.2 +011200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1044.2 +011300 01 REC-CT PIC 99 VALUE ZERO. SM1044.2 +011400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011700 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1044.2 +011900 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1044.2 +012000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1044.2 +012100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1044.2 +012200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1044.2 +012300 01 CCVS-H-1. SM1044.2 +012400 02 FILLER PIC X(39) VALUE SPACES. SM1044.2 +012500 02 FILLER PIC X(42) VALUE SM1044.2 +012600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1044.2 +012700 02 FILLER PIC X(39) VALUE SPACES. SM1044.2 +012800 01 CCVS-H-2A. SM1044.2 +012900 02 FILLER PIC X(40) VALUE SPACE. SM1044.2 +013000 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1044.2 +013100 02 FILLER PIC XXXX VALUE SM1044.2 +013200 "4.2 ". SM1044.2 +013300 02 FILLER PIC X(28) VALUE SM1044.2 +013400 " COPY - NOT FOR DISTRIBUTION". SM1044.2 +013500 02 FILLER PIC X(41) VALUE SPACE. SM1044.2 +013600 SM1044.2 +013700 01 CCVS-H-2B. SM1044.2 +013800 02 FILLER PIC X(15) VALUE SM1044.2 +013900 "TEST RESULT OF ". SM1044.2 +014000 02 TEST-ID PIC X(9). SM1044.2 +014100 02 FILLER PIC X(4) VALUE SM1044.2 +014200 " IN ". SM1044.2 +014300 02 FILLER PIC X(12) VALUE SM1044.2 +014400 " HIGH ". SM1044.2 +014500 02 FILLER PIC X(22) VALUE SM1044.2 +014600 " LEVEL VALIDATION FOR ". SM1044.2 +014700 02 FILLER PIC X(58) VALUE SM1044.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +014900 01 CCVS-H-3. SM1044.2 +015000 02 FILLER PIC X(34) VALUE SM1044.2 +015100 " FOR OFFICIAL USE ONLY ". SM1044.2 +015200 02 FILLER PIC X(58) VALUE SM1044.2 +015300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1044.2 +015400 02 FILLER PIC X(28) VALUE SM1044.2 +015500 " COPYRIGHT 1985 ". SM1044.2 +015600 01 CCVS-E-1. SM1044.2 +015700 02 FILLER PIC X(52) VALUE SPACE. SM1044.2 +015800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1044.2 +015900 02 ID-AGAIN PIC X(9). SM1044.2 +016000 02 FILLER PIC X(45) VALUE SPACES. SM1044.2 +016100 01 CCVS-E-2. SM1044.2 +016200 02 FILLER PIC X(31) VALUE SPACE. SM1044.2 +016300 02 FILLER PIC X(21) VALUE SPACE. SM1044.2 +016400 02 CCVS-E-2-2. SM1044.2 +016500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1044.2 +016600 03 FILLER PIC X VALUE SPACE. SM1044.2 +016700 03 ENDER-DESC PIC X(44) VALUE SM1044.2 +016800 "ERRORS ENCOUNTERED". SM1044.2 +016900 01 CCVS-E-3. SM1044.2 +017000 02 FILLER PIC X(22) VALUE SM1044.2 +017100 " FOR OFFICIAL USE ONLY". SM1044.2 +017200 02 FILLER PIC X(12) VALUE SPACE. SM1044.2 +017300 02 FILLER PIC X(58) VALUE SM1044.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +017500 02 FILLER PIC X(13) VALUE SPACE. SM1044.2 +017600 02 FILLER PIC X(15) VALUE SM1044.2 +017700 " COPYRIGHT 1985". SM1044.2 +017800 01 CCVS-E-4. SM1044.2 +017900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1044.2 +018000 02 FILLER PIC X(4) VALUE " OF ". SM1044.2 +018100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1044.2 +018200 02 FILLER PIC X(40) VALUE SM1044.2 +018300 " TESTS WERE EXECUTED SUCCESSFULLY". SM1044.2 +018400 01 XXINFO. SM1044.2 +018500 02 FILLER PIC X(19) VALUE SM1044.2 +018600 "*** INFORMATION ***". SM1044.2 +018700 02 INFO-TEXT. SM1044.2 +018800 04 FILLER PIC X(8) VALUE SPACE. SM1044.2 +018900 04 XXCOMPUTED PIC X(20). SM1044.2 +019000 04 FILLER PIC X(5) VALUE SPACE. SM1044.2 +019100 04 XXCORRECT PIC X(20). SM1044.2 +019200 02 INF-ANSI-REFERENCE PIC X(48). SM1044.2 +019300 01 HYPHEN-LINE. SM1044.2 +019400 02 FILLER PIC IS X VALUE IS SPACE. SM1044.2 +019500 02 FILLER PIC IS X(65) VALUE IS "************************SM1044.2 +019600- "*****************************************". SM1044.2 +019700 02 FILLER PIC IS X(54) VALUE IS "************************SM1044.2 +019800- "******************************". SM1044.2 +019900 01 CCVS-PGM-ID PIC X(9) VALUE SM1044.2 +020000 "SM104A". SM1044.2 +020100 PROCEDURE DIVISION. SM1044.2 +020200 CCVS1 SECTION. SM1044.2 +020300 OPEN-FILES. SM1044.2 +020400 OPEN OUTPUT PRINT-FILE. SM1044.2 +020500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1044.2 +020600 MOVE SPACE TO TEST-RESULTS. SM1044.2 +020700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1044.2 +020800 GO TO CCVS1-EXIT. SM1044.2 +020900 CLOSE-FILES. SM1044.2 +021000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1044.2 +021100 TERMINATE-CCVS. SM1044.2 +021200S EXIT PROGRAM. SM1044.2 +021300STERMINATE-CALL. SM1044.2 +021400 STOP RUN. SM1044.2 +021500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1044.2 +021600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1044.2 +021700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1044.2 +021800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1044.2 +021900 MOVE "****TEST DELETED****" TO RE-MARK. SM1044.2 +022000 PRINT-DETAIL. SM1044.2 +022100 IF REC-CT NOT EQUAL TO ZERO SM1044.2 +022200 MOVE "." TO PARDOT-X SM1044.2 +022300 MOVE REC-CT TO DOTVALUE. SM1044.2 +022400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1044.2 +022500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1044.2 +022600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1044.2 +022700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1044.2 +022800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1044.2 +022900 MOVE SPACE TO CORRECT-X. SM1044.2 +023000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1044.2 +023100 MOVE SPACE TO RE-MARK. SM1044.2 +023200 HEAD-ROUTINE. SM1044.2 +023300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +023400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +023500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1044.2 +023600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1044.2 +023700 COLUMN-NAMES-ROUTINE. SM1044.2 +023800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +023900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +024000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +024100 END-ROUTINE. SM1044.2 +024200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1044.2 +024300 END-RTN-EXIT. SM1044.2 +024400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +024500 END-ROUTINE-1. SM1044.2 +024600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1044.2 +024700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1044.2 +024800 ADD PASS-COUNTER TO ERROR-HOLD. SM1044.2 +024900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1044.2 +025000 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1044.2 +025100 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1044.2 +025200 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1044.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1044.2 +025400 END-ROUTINE-12. SM1044.2 +025500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1044.2 +025600 IF ERROR-COUNTER IS EQUAL TO ZERO SM1044.2 +025700 MOVE "NO " TO ERROR-TOTAL SM1044.2 +025800 ELSE SM1044.2 +025900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1044.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1044.2 +026100 PERFORM WRITE-LINE. SM1044.2 +026200 END-ROUTINE-13. SM1044.2 +026300 IF DELETE-COUNTER IS EQUAL TO ZERO SM1044.2 +026400 MOVE "NO " TO ERROR-TOTAL ELSE SM1044.2 +026500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1044.2 +026600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1044.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +026800 IF INSPECT-COUNTER EQUAL TO ZERO SM1044.2 +026900 MOVE "NO " TO ERROR-TOTAL SM1044.2 +027000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1044.2 +027100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1044.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +027300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +027400 WRITE-LINE. SM1044.2 +027500 ADD 1 TO RECORD-COUNT. SM1044.2 +027600Y IF RECORD-COUNT GREATER 50 SM1044.2 +027700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1044.2 +027800Y MOVE SPACE TO DUMMY-RECORD SM1044.2 +027900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1044.2 +028000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1044.2 +028100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1044.2 +028200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1044.2 +028300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1044.2 +028400Y MOVE ZERO TO RECORD-COUNT. SM1044.2 +028500 PERFORM WRT-LN. SM1044.2 +028600 WRT-LN. SM1044.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1044.2 +028800 MOVE SPACE TO DUMMY-RECORD. SM1044.2 +028900 BLANK-LINE-PRINT. SM1044.2 +029000 PERFORM WRT-LN. SM1044.2 +029100 FAIL-ROUTINE. SM1044.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1044.2 +029300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1044.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1044.2 +029500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1044.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1044.2 +029800 GO TO FAIL-ROUTINE-EX. SM1044.2 +029900 FAIL-ROUTINE-WRITE. SM1044.2 +030000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1044.2 +030100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1044.2 +030200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1044.2 +030300 MOVE SPACES TO COR-ANSI-REFERENCE. SM1044.2 +030400 FAIL-ROUTINE-EX. EXIT. SM1044.2 +030500 BAIL-OUT. SM1044.2 +030600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1044.2 +030700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1044.2 +030800 BAIL-OUT-WRITE. SM1044.2 +030900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1044.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1044.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1044.2 +031300 BAIL-OUT-EX. EXIT. SM1044.2 +031400 CCVS1-EXIT. SM1044.2 +031500 EXIT. SM1044.2 +031600 INITIALIZATION SECTION. SM1044.2 +031700 SM104A-INIT. SM1044.2 +031800 OPEN INPUT TEST-FILE. SM1044.2 +031900 MOVE "ALL TESTS IN SM104A CHECK" TO RE-MARK. SM1044.2 +032000 PERFORM PRINT-DETAIL. SM1044.2 +032100 MOVE "OUTPUT OF SM103A." TO RE-MARK. SM1044.2 +032200 PERFORM PRINT-DETAIL. SM1044.2 +032300 MOVE "COPY ---" TO FEATURE. SM1044.2 +032400 PERFORM PRINT-DETAIL. SM1044.2 +032500 COPY-INIT-A. SM1044.2 +032600 MOVE "COPY WITHIN NOTE" TO FEATURE. SM1044.2 +032700 COPY-TEST-1. SM1044.2 +032800 SM1044.2 +032900 SM1044.2 +033000 SM1044.2 +033100 SM1044.2 +033200 SM1044.2 +033300* SM1044.2 +033400******************* COPY WITHIN NOTE USED ************************SM1044.2 +033500* SM1044.2 +033600* NOTE COPY K4NTA. SM1044.2 +033700* SM1044.2 +033800**************** NO TEXT EXPANSION SHOULD OCCUR ******************SM1044.2 +033900* NOTE COPY K4NTA.SM1044.2 +034000 COPY-PASS-1. SM1044.2 +034100 PERFORM PASS. SM1044.2 +034200* NOTE K4NTA IS IN THE LIBRARY BUT IT SHOULD SM1044.2 +034300* NOT BE COPIED. SM1044.2 +034400 COPY-WRITE-1. SM1044.2 +034500 MOVE "COPY-TEST-1" TO PAR-NAME. SM1044.2 +034600 PERFORM PRINT-DETAIL. SM1044.2 +034700 COPY-TEST-2. SM1044.2 +034800* NOTE THE WORDS COPY WHICH ARE IN THIS NOTE SHOULD SM1044.2 +034900* NOT BE TREATED AS COPY VERBS, AND THE FOLLOWING SM1044.2 +035000* "STATEMENTS" SHOULD BE TREATED AS PART OF THIS NOTE.SM1044.2 +035100* PERFORM FAIL. SM1044.2 +035200* MOVE "SEE COPY-TEST-2" TO RE-MARK. SM1044.2 +035300* GO TO COPY-WRITE-2. SM1044.2 +035400 COPY-PASS-2. SM1044.2 +035500 PERFORM PASS. SM1044.2 +035600 COPY-WRITE-2. SM1044.2 +035700 MOVE "COPY-TEST-2" TO PAR-NAME. SM1044.2 +035800 PERFORM PRINT-DETAIL. SM1044.2 +035900 ENVIRONMENT-TEST SECTION. SM1044.2 +036000 COPY-TEST-3. SM1044.2 +036100 PERFORM READ-TEST-FILE. SM1044.2 +036200 IF TST-FLD-2 EQUAL TO "12.345.678,91" SM1044.2 +036300 PERFORM PASS GO TO COPY-WRITE-3. SM1044.2 +036400 GO TO COPY-FAIL-3. SM1044.2 +036500 COPY-DELETE-3. SM1044.2 +036600 PERFORM DE-LETE. SM1044.2 +036700 GO TO COPY-WRITE-3. SM1044.2 +036800 COPY-FAIL-3. SM1044.2 +036900 MOVE TST-FLD-2 TO COMPUTED-N. SM1044.2 +037000 MOVE "12.345.678,91" TO CORRECT-A. SM1044.2 +037100 PERFORM FAIL. SM1044.2 +037200 COPY-WRITE-3. SM1044.2 +037300 MOVE " DEC POINT IS COMMA" TO FEATURE. SM1044.2 +037400 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1044.2 +037500 PERFORM PRINT-DETAIL. SM1044.2 +037600 COPY-INIT-B. SM1044.2 +037700 MOVE " ENVIR DIV ENTRIES" TO FEATURE. SM1044.2 +037800 COPY-TEST-4. SM1044.2 +037900 IF TST-FLD-1 EQUAL TO 97532 SM1044.2 +038000 PERFORM PASS GO TO COPY-WRITE-4. SM1044.2 +038100 GO TO COPY-FAIL-4. SM1044.2 +038200 COPY-DELETE-4. SM1044.2 +038300 PERFORM DE-LETE. SM1044.2 +038400 GO TO COPY-WRITE-4. SM1044.2 +038500 COPY-FAIL-4. SM1044.2 +038600 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +038700 MOVE 97532 TO CORRECT-N. SM1044.2 +038800 PERFORM FAIL. SM1044.2 +038900 COPY-WRITE-4. SM1044.2 +039000 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1044.2 +039100 PERFORM PRINT-DETAIL. SM1044.2 +039200 COPY-TEST-5. SM1044.2 +039300 PERFORM READ-TEST-FILE. SM1044.2 +039400 IF TST-FLD-1 EQUAL TO 23479 SM1044.2 +039500 PERFORM PASS GO TO COPY-WRITE-5. SM1044.2 +039600 GO TO COPY-FAIL-5. SM1044.2 +039700 COPY-DELETE-5. SM1044.2 +039800 PERFORM DE-LETE. SM1044.2 +039900 GO TO COPY-WRITE-5. SM1044.2 +040000 COPY-FAIL-5. SM1044.2 +040100 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +040200 MOVE 23479 TO CORRECT-N. SM1044.2 +040300 PERFORM FAIL. SM1044.2 +040400 COPY-WRITE-5. SM1044.2 +040500 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1044.2 +040600 PERFORM PRINT-DETAIL. SM1044.2 +040700 COPY-TEST-6. SM1044.2 +040800 PERFORM READ-TEST-FILE 3 TIMES. SM1044.2 +040900 IF TST-FLD-1 EQUAL TO 14003 SM1044.2 +041000 PERFORM PASS GO TO COPY-WRITE-6. SM1044.2 +041100 GO TO COPY-FAIL-6. SM1044.2 +041200 COPY-DELETE-6. SM1044.2 +041300 PERFORM DE-LETE. SM1044.2 +041400 GO TO COPY-WRITE-6. SM1044.2 +041500 COPY-FAIL-6. SM1044.2 +041600 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +041700 MOVE 14003 TO CORRECT-N. SM1044.2 +041800 PERFORM FAIL. SM1044.2 +041900 COPY-WRITE-6. SM1044.2 +042000 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1044.2 +042100 PERFORM PRINT-DETAIL. SM1044.2 +042200 COPY-TEST-7. SM1044.2 +042300 PERFORM READ-TEST-FILE 2 TIMES. SM1044.2 +042400 IF TST-FLD-1 EQUAL TO 03543 SM1044.2 +042500 PERFORM PASS GO TO COPY-WRITE-7. SM1044.2 +042600 GO TO COPY-FAIL-7. SM1044.2 +042700 COPY-DELETE-7. SM1044.2 +042800 PERFORM DE-LETE. SM1044.2 +042900 GO TO COPY-WRITE-7. SM1044.2 +043000 COPY-FAIL-7. SM1044.2 +043100 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +043200 MOVE 03543 TO CORRECT-N. SM1044.2 +043300 PERFORM FAIL. SM1044.2 +043400 COPY-WRITE-7. SM1044.2 +043500 MOVE "COPY-TEST-7 " TO PAR-NAME. SM1044.2 +043600 PERFORM PRINT-DETAIL. SM1044.2 +043700 CLOSE TEST-FILE. SM1044.2 +043800 GO TO CCVS-EXIT. SM1044.2 +043900 READ-TEST-FILE. SM1044.2 +044000 READ TEST-FILE AT END GO TO BAD-FILE. SM1044.2 +044100 BAD-FILE. SM1044.2 +044200 MOVE "BAD-FILE" TO PAR-NAME. SM1044.2 +044300 PERFORM FAIL. SM1044.2 +044400 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1044.2 +044500 PERFORM PRINT-DETAIL. SM1044.2 +044600 CLOSE TEST-FILE. SM1044.2 +044700 CCVS-EXIT SECTION. SM1044.2 +044800 CCVS-999999. SM1044.2 +044900 GO TO CLOSE-FILES. SM1044.2 +*END-OF,SM104A +*HEADER,COBOL,SM105A +000100 IDENTIFICATION DIVISION. SM1054.2 +000200 PROGRAM-ID. SM1054.2 +000300 SM105A. SM1054.2 +000400**************************************************************** SM1054.2 +000500* * SM1054.2 +000600* VALIDATION FOR:- * SM1054.2 +000700* * SM1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +000900* * SM1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1054.2 +001100* * SM1054.2 +001200**************************************************************** SM1054.2 +001300* * SM1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1054.2 +001500* * SM1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1054.2 +001900* * SM1054.2 +002000**************************************************************** SM1054.2 +002100* * SM1054.2 +002200* PROGRAM NC105A TESTS THE USE OF THE "COPY" STATEMENT IN * SM1054.2 +002300* THE DATA DIVISION FOR A SORT DESCRIPTION ENTRY AND THE * SM1054.2 +002400* ASSOCIATED RECORD DESCRIPTION ENTRIES. * SM1054.2 +002500* * SM1054.2 +002600**************************************************************** SM1054.2 +002700 SM1054.2 +002800 ENVIRONMENT DIVISION. SM1054.2 +002900 CONFIGURATION SECTION. SM1054.2 +003000 SOURCE-COMPUTER. SM1054.2 +003100 XXXXX082. SM1054.2 +003200 OBJECT-COMPUTER. SM1054.2 +003300 XXXXX083. SM1054.2 +003400 INPUT-OUTPUT SECTION. SM1054.2 +003500 FILE-CONTROL. SM1054.2 +003600 SELECT PRINT-FILE ASSIGN TO SM1054.2 +003700 XXXXX055. SM1054.2 +003800 SELECT SORTFILE-1E ASSIGN TO SM1054.2 +003900 XXXXX027. SM1054.2 +004000 SELECT SORTOUT-1E ASSIGN TO SM1054.2 +004100 XXXXX001. SM1054.2 +004200 DATA DIVISION. SM1054.2 +004300 FILE SECTION. SM1054.2 +004400 FD PRINT-FILE. SM1054.2 +004500 01 PRINT-REC PICTURE X(120). SM1054.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1054.2 +004700 SM1054.2 +004800 SM1054.2 +004900 SM1054.2 +005000 SM1054.2 +005100 SM1054.2 +005200* SM1054.2 +005300*********************** COPY STATEMENT USED **********************SM1054.2 +005400* SM1054.2 +005500*SD SORTFILE-1E COPY K5SDA. SM1054.2 +005600* SM1054.2 +005700******************** COPIED TEXT BEGINS BELOW ********************SM1054.2 +005800 SD SORTFILE-1E COPY K5SDA.SM1054.2 +005900*********************** END OF COPIED TEXT ***********************SM1054.2 +006000 SM1054.2 +006100 SM1054.2 +006200 SM1054.2 +006300 SM1054.2 +006400 SM1054.2 +006500 01 S-RECORD. SM1054.2 +006600* SM1054.2 +006700*********************** COPY STATEMENT USED **********************SM1054.2 +006800* SM1054.2 +006900* COPY K501A. SM1054.2 +007000* SM1054.2 +007100******************** COPIED TEXT BEGINS BELOW ********************SM1054.2 +007200 COPY K501A.SM1054.2 +007300*********************** END OF COPIED TEXT ***********************SM1054.2 +007400 FD SORTOUT-1E SM1054.2 +007500 BLOCK CONTAINS 10 RECORDS SM1054.2 +007600 LABEL RECORDS ARE STANDARD SM1054.2 +007700C VALUE OF SM1054.2 +007800C XXXXX074 SM1054.2 +007900C IS SM1054.2 +008000C XXXXX075 SM1054.2 +008100G XXXXX069 SM1054.2 +008200 DATA RECORD SORTED. SM1054.2 +008300 01 SORTED PICTURE X(120). SM1054.2 +008400 WORKING-STORAGE SECTION. SM1054.2 +008500 77 C0 PICTURE 9 VALUE 0. SM1054.2 +008600 77 C1 PICTURE 9 VALUE 1. SM1054.2 +008700 77 C2 PICTURE 9 VALUE 2. SM1054.2 +008800 77 C6 PICTURE 9 VALUE 6. SM1054.2 +008900 77 C3 PICTURE 9 VALUE 3. SM1054.2 +009000 01 WKEYS-GROUP. SM1054.2 +009100 02 WKEY-1 PICTURE 9. SM1054.2 +009200 02 WKEY-2 PICTURE 99. SM1054.2 +009300 02 WKEY-3 PICTURE 999. SM1054.2 +009400 02 WKEY-4 PICTURE 9999. SM1054.2 +009500 02 WKEY-5 PICTURE 9(5). SM1054.2 +009600 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). SM1054.2 +009700 01 TEST-RESULTS. SM1054.2 +009800 02 FILLER PIC X VALUE SPACE. SM1054.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. SM1054.2 +010000 02 FILLER PIC X VALUE SPACE. SM1054.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. SM1054.2 +010200 02 FILLER PIC X VALUE SPACE. SM1054.2 +010300 02 PAR-NAME. SM1054.2 +010400 03 FILLER PIC X(19) VALUE SPACE. SM1054.2 +010500 03 PARDOT-X PIC X VALUE SPACE. SM1054.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. SM1054.2 +010700 02 FILLER PIC X(8) VALUE SPACE. SM1054.2 +010800 02 RE-MARK PIC X(61). SM1054.2 +010900 01 TEST-COMPUTED. SM1054.2 +011000 02 FILLER PIC X(30) VALUE SPACE. SM1054.2 +011100 02 FILLER PIC X(17) VALUE SM1054.2 +011200 " COMPUTED=". SM1054.2 +011300 02 COMPUTED-X. SM1054.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1054.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A SM1054.2 +011600 PIC -9(9).9(9). SM1054.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1054.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1054.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1054.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. SM1054.2 +012100 04 COMPUTED-18V0 PIC -9(18). SM1054.2 +012200 04 FILLER PIC X. SM1054.2 +012300 03 FILLER PIC X(50) VALUE SPACE. SM1054.2 +012400 01 TEST-CORRECT. SM1054.2 +012500 02 FILLER PIC X(30) VALUE SPACE. SM1054.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". SM1054.2 +012700 02 CORRECT-X. SM1054.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. SM1054.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1054.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1054.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1054.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1054.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. SM1054.2 +013400 04 CORRECT-18V0 PIC -9(18). SM1054.2 +013500 04 FILLER PIC X. SM1054.2 +013600 03 FILLER PIC X(2) VALUE SPACE. SM1054.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1054.2 +013800 01 CCVS-C-1. SM1054.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1054.2 +014000- "SS PARAGRAPH-NAME SM1054.2 +014100- " REMARKS". SM1054.2 +014200 02 FILLER PIC X(20) VALUE SPACE. SM1054.2 +014300 01 CCVS-C-2. SM1054.2 +014400 02 FILLER PIC X VALUE SPACE. SM1054.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". SM1054.2 +014600 02 FILLER PIC X(15) VALUE SPACE. SM1054.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". SM1054.2 +014800 02 FILLER PIC X(94) VALUE SPACE. SM1054.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1054.2 +015000 01 REC-CT PIC 99 VALUE ZERO. SM1054.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1054.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1054.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1054.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1054.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1054.2 +016000 01 CCVS-H-1. SM1054.2 +016100 02 FILLER PIC X(39) VALUE SPACES. SM1054.2 +016200 02 FILLER PIC X(42) VALUE SM1054.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1054.2 +016400 02 FILLER PIC X(39) VALUE SPACES. SM1054.2 +016500 01 CCVS-H-2A. SM1054.2 +016600 02 FILLER PIC X(41) VALUE SPACE. SM1054.2 +016700 02 FILLER PIC X(39) VALUE SM1054.2 +016800 "CCVS85 NCC COPY - NOT FOR DISTRIBUTION". SM1054.2 +016900 02 FILLER PIC X(40) VALUE SPACE. SM1054.2 +017000 SM1054.2 +017100 01 CCVS-H-2B. SM1054.2 +017200 02 FILLER PIC X(15) VALUE SM1054.2 +017300 "TEST RESULT OF ". SM1054.2 +017400 02 TEST-ID PIC X(9). SM1054.2 +017500 02 FILLER PIC X(4) VALUE SM1054.2 +017600 " IN ". SM1054.2 +017700 02 FILLER PIC X(12) VALUE SM1054.2 +017800 " HIGH ". SM1054.2 +017900 02 FILLER PIC X(22) VALUE SM1054.2 +018000 " LEVEL VALIDATION FOR ". SM1054.2 +018100 02 FILLER PIC X(58) VALUE SM1054.2 +018200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +018300 01 CCVS-H-3. SM1054.2 +018400 02 FILLER PIC X(34) VALUE SM1054.2 +018500 " FOR OFFICIAL USE ONLY ". SM1054.2 +018600 02 FILLER PIC X(58) VALUE SM1054.2 +018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1054.2 +018800 02 FILLER PIC X(28) VALUE SM1054.2 +018900 " COPYRIGHT 1985 ". SM1054.2 +019000 01 CCVS-E-1. SM1054.2 +019100 02 FILLER PIC X(52) VALUE SPACE. SM1054.2 +019200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1054.2 +019300 02 ID-AGAIN PIC X(9). SM1054.2 +019400 02 FILLER PIC X(45) VALUE SM1054.2 +019500 " NTIS DISTRIBUTION COBOL 85". SM1054.2 +019600 01 CCVS-E-2. SM1054.2 +019700 02 FILLER PIC X(31) VALUE SPACE. SM1054.2 +019800 02 FILLER PIC X(21) VALUE SPACE. SM1054.2 +019900 02 CCVS-E-2-2. SM1054.2 +020000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1054.2 +020100 03 FILLER PIC X VALUE SPACE. SM1054.2 +020200 03 ENDER-DESC PIC X(44) VALUE SM1054.2 +020300 "ERRORS ENCOUNTERED". SM1054.2 +020400 01 CCVS-E-3. SM1054.2 +020500 02 FILLER PIC X(22) VALUE SM1054.2 +020600 " FOR OFFICIAL USE ONLY". SM1054.2 +020700 02 FILLER PIC X(12) VALUE SPACE. SM1054.2 +020800 02 FILLER PIC X(58) VALUE SM1054.2 +020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +021000 02 FILLER PIC X(13) VALUE SPACE. SM1054.2 +021100 02 FILLER PIC X(15) VALUE SM1054.2 +021200 " COPYRIGHT 1985". SM1054.2 +021300 01 CCVS-E-4. SM1054.2 +021400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1054.2 +021500 02 FILLER PIC X(4) VALUE " OF ". SM1054.2 +021600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1054.2 +021700 02 FILLER PIC X(40) VALUE SM1054.2 +021800 " TESTS WERE EXECUTED SUCCESSFULLY". SM1054.2 +021900 01 XXINFO. SM1054.2 +022000 02 FILLER PIC X(19) VALUE SM1054.2 +022100 "*** INFORMATION ***". SM1054.2 +022200 02 INFO-TEXT. SM1054.2 +022300 04 FILLER PIC X(8) VALUE SPACE. SM1054.2 +022400 04 XXCOMPUTED PIC X(20). SM1054.2 +022500 04 FILLER PIC X(5) VALUE SPACE. SM1054.2 +022600 04 XXCORRECT PIC X(20). SM1054.2 +022700 02 INF-ANSI-REFERENCE PIC X(48). SM1054.2 +022800 01 HYPHEN-LINE. SM1054.2 +022900 02 FILLER PIC IS X VALUE IS SPACE. SM1054.2 +023000 02 FILLER PIC IS X(65) VALUE IS "************************SM1054.2 +023100- "*****************************************". SM1054.2 +023200 02 FILLER PIC IS X(54) VALUE IS "************************SM1054.2 +023300- "******************************". SM1054.2 +023400 01 CCVS-PGM-ID PIC X(9) VALUE SM1054.2 +023500 "SM105A". SM1054.2 +023600 PROCEDURE DIVISION. SM1054.2 +023700 CCVS1 SECTION. SM1054.2 +023800 OPEN-FILES. SM1054.2 +023900 OPEN OUTPUT PRINT-FILE. SM1054.2 +024000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1054.2 +024100 MOVE SPACE TO TEST-RESULTS. SM1054.2 +024200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1054.2 +024300 GO TO CCVS1-EXIT. SM1054.2 +024400 CLOSE-FILES. SM1054.2 +024500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1054.2 +024600 TERMINATE-CCVS. SM1054.2 +024700S EXIT PROGRAM. SM1054.2 +024800STERMINATE-CALL. SM1054.2 +024900 STOP RUN. SM1054.2 +025000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1054.2 +025100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1054.2 +025200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1054.2 +025300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1054.2 +025400 MOVE "****TEST DELETED****" TO RE-MARK. SM1054.2 +025500 PRINT-DETAIL. SM1054.2 +025600 IF REC-CT NOT EQUAL TO ZERO SM1054.2 +025700 MOVE "." TO PARDOT-X SM1054.2 +025800 MOVE REC-CT TO DOTVALUE. SM1054.2 +025900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1054.2 +026000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1054.2 +026100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1054.2 +026200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1054.2 +026300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1054.2 +026400 MOVE SPACE TO CORRECT-X. SM1054.2 +026500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1054.2 +026600 MOVE SPACE TO RE-MARK. SM1054.2 +026700 HEAD-ROUTINE. SM1054.2 +026800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +026900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +027000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1054.2 +027100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1054.2 +027200 COLUMN-NAMES-ROUTINE. SM1054.2 +027300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +027400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +027600 END-ROUTINE. SM1054.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1054.2 +027800 END-RTN-EXIT. SM1054.2 +027900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +028000 END-ROUTINE-1. SM1054.2 +028100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1054.2 +028200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1054.2 +028300 ADD PASS-COUNTER TO ERROR-HOLD. SM1054.2 +028400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1054.2 +028500 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1054.2 +028600 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1054.2 +028700 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1054.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1054.2 +028900 END-ROUTINE-12. SM1054.2 +029000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1054.2 +029100 IF ERROR-COUNTER IS EQUAL TO ZERO SM1054.2 +029200 MOVE "NO " TO ERROR-TOTAL SM1054.2 +029300 ELSE SM1054.2 +029400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1054.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1054.2 +029600 PERFORM WRITE-LINE. SM1054.2 +029700 END-ROUTINE-13. SM1054.2 +029800 IF DELETE-COUNTER IS EQUAL TO ZERO SM1054.2 +029900 MOVE "NO " TO ERROR-TOTAL ELSE SM1054.2 +030000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1054.2 +030100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1054.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030300 IF INSPECT-COUNTER EQUAL TO ZERO SM1054.2 +030400 MOVE "NO " TO ERROR-TOTAL SM1054.2 +030500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1054.2 +030600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1054.2 +030700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030900 WRITE-LINE. SM1054.2 +031000 ADD 1 TO RECORD-COUNT. SM1054.2 +031100Y IF RECORD-COUNT GREATER 50 SM1054.2 +031200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1054.2 +031300Y MOVE SPACE TO DUMMY-RECORD SM1054.2 +031400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1054.2 +031500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1054.2 +031600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1054.2 +031700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1054.2 +031800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1054.2 +031900Y MOVE ZERO TO RECORD-COUNT. SM1054.2 +032000 PERFORM WRT-LN. SM1054.2 +032100 WRT-LN. SM1054.2 +032200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1054.2 +032300 MOVE SPACE TO DUMMY-RECORD. SM1054.2 +032400 BLANK-LINE-PRINT. SM1054.2 +032500 PERFORM WRT-LN. SM1054.2 +032600 FAIL-ROUTINE. SM1054.2 +032700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1054.2 +032800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1054.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1054.2 +033000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1054.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1054.2 +033300 GO TO FAIL-ROUTINE-EX. SM1054.2 +033400 FAIL-ROUTINE-WRITE. SM1054.2 +033500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1054.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1054.2 +033700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1054.2 +033800 MOVE SPACES TO COR-ANSI-REFERENCE. SM1054.2 +033900 FAIL-ROUTINE-EX. EXIT. SM1054.2 +034000 BAIL-OUT. SM1054.2 +034100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1054.2 +034200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1054.2 +034300 BAIL-OUT-WRITE. SM1054.2 +034400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1054.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1054.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1054.2 +034800 BAIL-OUT-EX. EXIT. SM1054.2 +034900 CCVS1-EXIT. SM1054.2 +035000 EXIT. SM1054.2 +035100 SORT-INIT SECTION. SM1054.2 +035200 I-1. SM1054.2 +035300 SORT SORTFILE-1E SM1054.2 +035400 ON ASCENDING KEY KEY-1 SM1054.2 +035500 ON DESCENDING KEY KEY-2 SM1054.2 +035600 ON ASCENDING KEY KEY-3 SM1054.2 +035700 DESCENDING KEY-4 KEY-5 SM1054.2 +035800 INPUT PROCEDURE IS INSORT SM1054.2 +035900 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. SM1054.2 +036000 I-2. SM1054.2 +036100 GO TO CLOSE-FILES. SM1054.2 +036200 INSORT SECTION. SM1054.2 +036300 IN-2. SM1054.2 +036400 MOVE 900009000000000 TO RDF-KEYS. SM1054.2 +036500 RELEASE S-RECORD. SM1054.2 +036600 MOVE 009000000900009 TO RDF-KEYS. SM1054.2 +036700 RELEASE S-RECORD. SM1054.2 +036800 MOVE 900008000000000 TO RDF-KEYS. SM1054.2 +036900 RELEASE S-RECORD. SM1054.2 +037000 MOVE 009000000900008 TO RDF-KEYS. SM1054.2 +037100 RELEASE S-RECORD. SM1054.2 +037200* NOTE HI-LOW CONTROL RECORDS DONE. SM1054.2 +037300 MOVE 300003000000000 TO WKEYS-RDF. SM1054.2 +037400 IN-3. SM1054.2 +037500 PERFORM IN-4 2 TIMES. SM1054.2 +037600 GO TO IN-EXIT. SM1054.2 +037700 IN-4. SM1054.2 +037800 SUBTRACT C1 FROM WKEY-1. SM1054.2 +037900 PERFORM IN-5 6 TIMES. SM1054.2 +038000 IN-5. SM1054.2 +038100 IF WKEY-2 IS EQUAL TO C6 SM1054.2 +038200 MOVE C0 TO WKEY-2. SM1054.2 +038300 ADD C1 TO WKEY-2. SM1054.2 +038400 PERFORM IN-6 2 TIMES. SM1054.2 +038500 IN-6. SM1054.2 +038600 IF WKEY-3 IS EQUAL TO C1 SM1054.2 +038700 MOVE C3 TO WKEY-3. SM1054.2 +038800 SUBTRACT C1 FROM WKEY-3. SM1054.2 +038900 PERFORM IN-7 2 TIMES. SM1054.2 +039000 IN-7. SM1054.2 +039100 IF WKEY-4 EQUAL TO C2 SM1054.2 +039200 MOVE C0 TO WKEY-4. SM1054.2 +039300 ADD C1 TO WKEY-4. SM1054.2 +039400 PERFORM IN-8 2 TIMES. SM1054.2 +039500 IN-8. SM1054.2 +039600 IF WKEY-5 IS EQUAL TO C2 SM1054.2 +039700 MOVE C0 TO WKEY-5. SM1054.2 +039800 ADD C1 TO WKEY-5. SM1054.2 +039900 MOVE WKEYS-RDF TO RDF-KEYS. SM1054.2 +040000 RELEASE S-RECORD. SM1054.2 +040100 IN-EXIT. SM1054.2 +040200 EXIT. SM1054.2 +040300 OUTP1 SECTION. SM1054.2 +040400 SM105-INIT. SM1054.2 +040500 OPEN OUTPUT SORTOUT-1E. SM1054.2 +040600 MOVE "COPY SORT DESCR" TO FEATURE. SM1054.2 +040700 COPY-TEST-1. SM1054.2 +040800 PERFORM RET-1. SM1054.2 +040900 IF RDF-KEYS EQUAL TO 009000000900009 SM1054.2 +041000 PERFORM PASS-1 GO TO COPY-WRITE-1. SM1054.2 +041100 GO TO COPY-FAIL-1-1. SM1054.2 +041200 COPY-DELETE-1. SM1054.2 +041300 PERFORM DE-LETE-1. SM1054.2 +041400 GO TO COPY-WRITE-1. SM1054.2 +041500 COPY-FAIL-1-1. SM1054.2 +041600 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +041700 MOVE 009000000900009 TO CORRECT-18V0. SM1054.2 +041800 PERFORM FAIL-1. SM1054.2 +041900 COPY-WRITE-1. SM1054.2 +042000 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1054.2 +042100 PERFORM PRINT-DETAIL-1. SM1054.2 +042200 COPY-TEST-2. SM1054.2 +042300 PERFORM RET-1. SM1054.2 +042400 IF RDF-KEYS EQUAL TO 009000000900008 SM1054.2 +042500 PERFORM PASS-1 GO TO COPY-WRITE-2. SM1054.2 +042600 GO TO COPY-FAIL-1-2. SM1054.2 +042700 COPY-DELETE-2. SM1054.2 +042800 PERFORM DE-LETE-1. SM1054.2 +042900 GO TO COPY-WRITE-2. SM1054.2 +043000 COPY-FAIL-1-2. SM1054.2 +043100 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +043200 MOVE 009000000900008 TO CORRECT-18V0. SM1054.2 +043300 PERFORM FAIL-1. SM1054.2 +043400 COPY-WRITE-2. SM1054.2 +043500 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1054.2 +043600 PERFORM PRINT-DETAIL-1. SM1054.2 +043700 COPY-TEST-3. SM1054.2 +043800 PERFORM RET-1. SM1054.2 +043900 IF RDF-KEYS EQUAL TO 106001000200002 SM1054.2 +044000 PERFORM PASS-1 GO TO COPY-WRITE-3. SM1054.2 +044100 GO TO COPY-FAIL-1-3. SM1054.2 +044200 COPY-DELETE-3. SM1054.2 +044300 PERFORM DE-LETE-1. SM1054.2 +044400 GO TO COPY-WRITE-3. SM1054.2 +044500 COPY-FAIL-1-3. SM1054.2 +044600 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +044700 MOVE 106001000200002 TO CORRECT-18V0. SM1054.2 +044800 PERFORM FAIL-1. SM1054.2 +044900 COPY-WRITE-3. SM1054.2 +045000 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1054.2 +045100 PERFORM PRINT-DETAIL-1. SM1054.2 +045200 OUTP2 SECTION. SM1054.2 +045300 COPY-TEST-4. SM1054.2 +045400 PERFORM RET-2 48 TIMES. SM1054.2 +045500 IF RDF-KEYS EQUAL TO 206001000200002 SM1054.2 +045600 PERFORM PASS-1 GO TO COPY-WRITE-4. SM1054.2 +045700 GO TO COPY-FAIL-1-4. SM1054.2 +045800 COPY-DELETE-4. SM1054.2 +045900 PERFORM DE-LETE-1. SM1054.2 +046000 GO TO COPY-WRITE-4. SM1054.2 +046100 COPY-FAIL-1-4. SM1054.2 +046200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +046300 MOVE 206001000200002 TO CORRECT-18V0. SM1054.2 +046400 PERFORM FAIL-1. SM1054.2 +046500 COPY-WRITE-4. SM1054.2 +046600 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1054.2 +046700 PERFORM PRINT-DETAIL-1. SM1054.2 +046800 COPY-TEST-5. SM1054.2 +046900 PERFORM RET-2 40 TIMES. SM1054.2 +047000 IF RDF-KEYS EQUAL TO 201001000200002 SM1054.2 +047100 PERFORM PASS-1 GO TO COPY-WRITE-5. SM1054.2 +047200 GO TO COPY-FAIL-1-5. SM1054.2 +047300 COPY-DELETE-5. SM1054.2 +047400 PERFORM DE-LETE-1. SM1054.2 +047500 GO TO COPY-WRITE-5. SM1054.2 +047600 COPY-FAIL-1-5. SM1054.2 +047700 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +047800 MOVE 201001000200002 TO CORRECT-18V0. SM1054.2 +047900 PERFORM FAIL-1. SM1054.2 +048000 COPY-WRITE-5. SM1054.2 +048100 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1054.2 +048200 PERFORM PRINT-DETAIL-1. SM1054.2 +048300 COPY-TEST-6. SM1054.2 +048400 PERFORM RET-2 7 TIMES. SM1054.2 +048500 IF RDF-KEYS EQUAL TO 201002000100001 SM1054.2 +048600 PERFORM PASS-1 GO TO COPY-WRITE-6. SM1054.2 +048700 GO TO COPY-FAIL-1-6. SM1054.2 +048800 COPY-DELETE-6. SM1054.2 +048900 PERFORM DE-LETE-1. SM1054.2 +049000 GO TO COPY-WRITE-6. SM1054.2 +049100 COPY-FAIL-1-6. SM1054.2 +049200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +049300 MOVE 201002000100001 TO CORRECT-18V0. SM1054.2 +049400 PERFORM FAIL-1. SM1054.2 +049500 COPY-WRITE-6. SM1054.2 +049600 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1054.2 +049700 PERFORM PRINT-DETAIL-1. SM1054.2 +049800 COPY-TEST-7. SM1054.2 +049900 PERFORM RET-2. SM1054.2 +050000 IF RDF-KEYS EQUAL TO 900008000000000 SM1054.2 +050100 PERFORM PASS-1 GO TO COPY-WRITE-7. SM1054.2 +050200 GO TO COPY-FAIL-1-7. SM1054.2 +050300 COPY-DELETE-7. SM1054.2 +050400 PERFORM DE-LETE-1. SM1054.2 +050500 GO TO COPY-WRITE-7. SM1054.2 +050600 COPY-FAIL-1-7. SM1054.2 +050700 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +050800 MOVE 900008000000000 TO CORRECT-18V0. SM1054.2 +050900 PERFORM FAIL-1. SM1054.2 +051000 COPY-WRITE-7. SM1054.2 +051100 MOVE "COPY-TEST-7 " TO PAR-NAME. SM1054.2 +051200 PERFORM PRINT-DETAIL-1. SM1054.2 +051300 COPY-TEST-8. SM1054.2 +051400 PERFORM RET-2. SM1054.2 +051500 IF RDF-KEYS EQUAL TO 900009000000000 SM1054.2 +051600 PERFORM PASS-1 GO TO COPY-WRITE-8. SM1054.2 +051700 GO TO COPY-FAIL-1-8. SM1054.2 +051800 COPY-DELETE-8. SM1054.2 +051900 PERFORM DE-LETE-1. SM1054.2 +052000 GO TO COPY-WRITE-8. SM1054.2 +052100 COPY-FAIL-1-8. SM1054.2 +052200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +052300 MOVE 900009000000000 TO CORRECT-18V0. SM1054.2 +052400 PERFORM FAIL-1. SM1054.2 +052500 COPY-WRITE-8. SM1054.2 +052600 MOVE "COPY-TEST-8 " TO PAR-NAME. SM1054.2 +052700 PERFORM PRINT-DETAIL-1. SM1054.2 +052800 COPY-TEST-9. SM1054.2 +052900 RETURN SORTFILE-1E END SM1054.2 +053000 PERFORM PASS-1 GO TO COPY-WRITE-9. SM1054.2 +053100* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. SM1054.2 +053200 PERFORM FAIL-1. SM1054.2 +053300 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +053400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SM1054.2 +053500 GO TO COPY-WRITE-9. SM1054.2 +053600 COPY-DELETE-9. SM1054.2 +053700 PERFORM DE-LETE-1. SM1054.2 +053800 COPY-WRITE-9. SM1054.2 +053900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM1054.2 +054000 PERFORM PRINT-DETAIL-1. SM1054.2 +054100 OUTP3 SECTION. SM1054.2 +054200 RET-0. SM1054.2 +054300 CLOSE SORTOUT-1E. SM1054.2 +054400 GO TO LIB1E-EXIT. SM1054.2 +054500 RET-1. SM1054.2 +054600 RETURN SORTFILE-1E RECORD AT END GO TO BAD-FILE. SM1054.2 +054700 MOVE S-RECORD TO SORTED. SM1054.2 +054800 WRITE SORTED. SM1054.2 +054900 RET-2. SM1054.2 +055000 RETURN SORTFILE-1E END GO TO BAD-FILE. SM1054.2 +055100 MOVE S-RECORD TO SORTED. SM1054.2 +055200 WRITE SORTED. SM1054.2 +055300 BAD-FILE. SM1054.2 +055400 PERFORM FAIL-1. SM1054.2 +055500 MOVE "BAD-FILE" TO PAR-NAME. SM1054.2 +055600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1054.2 +055700 PERFORM PRINT-DETAIL-1. SM1054.2 +055800 CLOSE SORTOUT-1E. SM1054.2 +055900 GO TO LIB1E-EXIT. SM1054.2 +056000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1054.2 +056100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1054.2 +056200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1054.2 +056300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1054.2 +056400 MOVE "****TEST DELETED****" TO RE-MARK. SM1054.2 +056500 PRINT-DETAIL-1. SM1054.2 +056600 IF REC-CT NOT EQUAL TO ZERO SM1054.2 +056700 MOVE "." TO PARDOT-X SM1054.2 +056800 MOVE REC-CT TO DOTVALUE. SM1054.2 +056900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SM1054.2 +057000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SM1054.2 +057100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SM1054.2 +057200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SM1054.2 +057300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1054.2 +057400 MOVE SPACE TO CORRECT-X. SM1054.2 +057500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1054.2 +057600 MOVE SPACE TO RE-MARK. SM1054.2 +057700 WRITE-LINE-1. SM1054.2 +057800 ADD 1 TO RECORD-COUNT. SM1054.2 +057900Y IF RECORD-COUNT GREATER 50 SM1054.2 +058000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1054.2 +058100Y MOVE SPACE TO DUMMY-RECORD SM1054.2 +058200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1054.2 +058300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SM1054.2 +058400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SM1054.2 +058500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SM1054.2 +058600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1054.2 +058700Y MOVE ZERO TO RECORD-COUNT. SM1054.2 +058800 PERFORM WRT-LN-1. SM1054.2 +058900 WRT-LN-1. SM1054.2 +059000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1054.2 +059100 MOVE SPACE TO DUMMY-RECORD. SM1054.2 +059200 BLANK-LINE-PRINT-1. SM1054.2 +059300 PERFORM WRT-LN-1. SM1054.2 +059400 FAIL-ROUTINE-1. SM1054.2 +059500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM1054.2 +059600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM1054.2 +059700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1054.2 +059800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +059900 GO TO FAIL-ROUTINE-EX-1. SM1054.2 +060000 FAIL-RTN-WRITE-1. SM1054.2 +060100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SM1054.2 +060200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +060300 FAIL-ROUTINE-EX-1. EXIT. SM1054.2 +060400 BAIL-OUT-1. SM1054.2 +060500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SM1054.2 +060600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SM1054.2 +060700 BAIL-OUT-WRITE-1. SM1054.2 +060800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1054.2 +060900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +061000 BAIL-OUT-EX-1. EXIT. SM1054.2 +061100 LIB1E-EXIT. SM1054.2 +061200 EXIT. SM1054.2 +*END-OF,SM105A +*HEADER,COBOL,SM106A +000100 IDENTIFICATION DIVISION. SM1064.2 +000200 PROGRAM-ID. SM1064.2 +000300 SM106A. SM1064.2 +000400**************************************************************** SM1064.2 +000500* * SM1064.2 +000600* VALIDATION FOR:- * SM1064.2 +000700* * SM1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1064.2 +000900* * SM1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1064.2 +001100* * SM1064.2 +001200**************************************************************** SM1064.2 +001300* * SM1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1064.2 +001500* * SM1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1064.2 +001900* * SM1064.2 +002000**************************************************************** SM1064.2 +002100 ENVIRONMENT DIVISION. SM1064.2 +002200* SM1064.2 +002300*********************** COPY STATEMENT USED **********************SM1064.2 +002400* SM1064.2 +002500*COPY K6SCA SM1064.2 +002600* SM1064.2 +002700******************** COPIED TEXT BEGINS BELOW ********************SM1064.2 +002800 COPY K6SCA. SM1064.2 +002900*********************** END OF COPIED TEXT ***********************SM1064.2 +*END-OF,SM106A +*HEADER,COBOL,SM107A +000100 IDENTIFICATION DIVISION. SM1074.2 +000200 PROGRAM-ID. SM1074.2 +000300 SM107A. SM1074.2 +000400**************************************************************** SM1074.2 +000500* * SM1074.2 +000600* VALIDATION FOR:- * SM1074.2 +000700* * SM1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +000900* * SM1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1074.2 +001100* * SM1074.2 +001200**************************************************************** SM1074.2 +001300* * SM1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1074.2 +001500* * SM1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1074.2 +001900* * SM1074.2 +002000**************************************************************** SM1074.2 +002100* * SM1074.2 +002200* PROGRAM SM107A TESTS THE CAPABILITY TO COPY 1599 RECORDS * SM1074.2 +002300* BY A SINGLE "COPY" STATEMENT IN THE PROCEDURE DIVISION. * SM1074.2 +002400* * SM1074.2 +002500**************************************************************** SM1074.2 +002600 ENVIRONMENT DIVISION. SM1074.2 +002700 CONFIGURATION SECTION. SM1074.2 +002800 SOURCE-COMPUTER. SM1074.2 +002900 XXXXX082. SM1074.2 +003000 OBJECT-COMPUTER. SM1074.2 +003100 XXXXX083. SM1074.2 +003200 INPUT-OUTPUT SECTION. SM1074.2 +003300 FILE-CONTROL. SM1074.2 +003400 SELECT PRINT-FILE ASSIGN TO SM1074.2 +003500 XXXXX055. SM1074.2 +003600 DATA DIVISION. SM1074.2 +003700 FILE SECTION. SM1074.2 +003800 FD PRINT-FILE. SM1074.2 +003900 01 PRINT-REC PICTURE X(120). SM1074.2 +004000 01 DUMMY-RECORD PICTURE X(120). SM1074.2 +004100 WORKING-STORAGE SECTION. SM1074.2 +004200 01 TEST-RESULTS. SM1074.2 +004300 02 FILLER PIC X VALUE SPACE. SM1074.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. SM1074.2 +004500 02 FILLER PIC X VALUE SPACE. SM1074.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. SM1074.2 +004700 02 FILLER PIC X VALUE SPACE. SM1074.2 +004800 02 PAR-NAME. SM1074.2 +004900 03 FILLER PIC X(19) VALUE SPACE. SM1074.2 +005000 03 PARDOT-X PIC X VALUE SPACE. SM1074.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. SM1074.2 +005200 02 FILLER PIC X(8) VALUE SPACE. SM1074.2 +005300 02 RE-MARK PIC X(61). SM1074.2 +005400 01 TEST-COMPUTED. SM1074.2 +005500 02 FILLER PIC X(30) VALUE SPACE. SM1074.2 +005600 02 FILLER PIC X(17) VALUE SM1074.2 +005700 " COMPUTED=". SM1074.2 +005800 02 COMPUTED-X. SM1074.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1074.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A SM1074.2 +006100 PIC -9(9).9(9). SM1074.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1074.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1074.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1074.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. SM1074.2 +006600 04 COMPUTED-18V0 PIC -9(18). SM1074.2 +006700 04 FILLER PIC X. SM1074.2 +006800 03 FILLER PIC X(50) VALUE SPACE. SM1074.2 +006900 01 TEST-CORRECT. SM1074.2 +007000 02 FILLER PIC X(30) VALUE SPACE. SM1074.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". SM1074.2 +007200 02 CORRECT-X. SM1074.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. SM1074.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1074.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1074.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1074.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1074.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. SM1074.2 +007900 04 CORRECT-18V0 PIC -9(18). SM1074.2 +008000 04 FILLER PIC X. SM1074.2 +008100 03 FILLER PIC X(2) VALUE SPACE. SM1074.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1074.2 +008300 01 CCVS-C-1. SM1074.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1074.2 +008500- "SS PARAGRAPH-NAME SM1074.2 +008600- " REMARKS". SM1074.2 +008700 02 FILLER PIC X(20) VALUE SPACE. SM1074.2 +008800 01 CCVS-C-2. SM1074.2 +008900 02 FILLER PIC X VALUE SPACE. SM1074.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". SM1074.2 +009100 02 FILLER PIC X(15) VALUE SPACE. SM1074.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". SM1074.2 +009300 02 FILLER PIC X(94) VALUE SPACE. SM1074.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1074.2 +009500 01 REC-CT PIC 99 VALUE ZERO. SM1074.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1074.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1074.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1074.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1074.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1074.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1074.2 +010500 01 CCVS-H-1. SM1074.2 +010600 02 FILLER PIC X(39) VALUE SPACES. SM1074.2 +010700 02 FILLER PIC X(42) VALUE SM1074.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1074.2 +010900 02 FILLER PIC X(39) VALUE SPACES. SM1074.2 +011000 01 CCVS-H-2A. SM1074.2 +011100 02 FILLER PIC X(40) VALUE SPACE. SM1074.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1074.2 +011300 02 FILLER PIC XXXX VALUE SM1074.2 +011400 "4.2 ". SM1074.2 +011500 02 FILLER PIC X(28) VALUE SM1074.2 +011600 " COPY - NOT FOR DISTRIBUTION". SM1074.2 +011700 02 FILLER PIC X(41) VALUE SPACE. SM1074.2 +011800 SM1074.2 +011900 01 CCVS-H-2B. SM1074.2 +012000 02 FILLER PIC X(15) VALUE SM1074.2 +012100 "TEST RESULT OF ". SM1074.2 +012200 02 TEST-ID PIC X(9). SM1074.2 +012300 02 FILLER PIC X(4) VALUE SM1074.2 +012400 " IN ". SM1074.2 +012500 02 FILLER PIC X(12) VALUE SM1074.2 +012600 " HIGH ". SM1074.2 +012700 02 FILLER PIC X(22) VALUE SM1074.2 +012800 " LEVEL VALIDATION FOR ". SM1074.2 +012900 02 FILLER PIC X(58) VALUE SM1074.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +013100 01 CCVS-H-3. SM1074.2 +013200 02 FILLER PIC X(34) VALUE SM1074.2 +013300 " FOR OFFICIAL USE ONLY ". SM1074.2 +013400 02 FILLER PIC X(58) VALUE SM1074.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1074.2 +013600 02 FILLER PIC X(28) VALUE SM1074.2 +013700 " COPYRIGHT 1985 ". SM1074.2 +013800 01 CCVS-E-1. SM1074.2 +013900 02 FILLER PIC X(52) VALUE SPACE. SM1074.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1074.2 +014100 02 ID-AGAIN PIC X(9). SM1074.2 +014200 02 FILLER PIC X(45) VALUE SPACES. SM1074.2 +014300 01 CCVS-E-2. SM1074.2 +014400 02 FILLER PIC X(31) VALUE SPACE. SM1074.2 +014500 02 FILLER PIC X(21) VALUE SPACE. SM1074.2 +014600 02 CCVS-E-2-2. SM1074.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1074.2 +014800 03 FILLER PIC X VALUE SPACE. SM1074.2 +014900 03 ENDER-DESC PIC X(44) VALUE SM1074.2 +015000 "ERRORS ENCOUNTERED". SM1074.2 +015100 01 CCVS-E-3. SM1074.2 +015200 02 FILLER PIC X(22) VALUE SM1074.2 +015300 " FOR OFFICIAL USE ONLY". SM1074.2 +015400 02 FILLER PIC X(12) VALUE SPACE. SM1074.2 +015500 02 FILLER PIC X(58) VALUE SM1074.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +015700 02 FILLER PIC X(13) VALUE SPACE. SM1074.2 +015800 02 FILLER PIC X(15) VALUE SM1074.2 +015900 " COPYRIGHT 1985". SM1074.2 +016000 01 CCVS-E-4. SM1074.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1074.2 +016200 02 FILLER PIC X(4) VALUE " OF ". SM1074.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1074.2 +016400 02 FILLER PIC X(40) VALUE SM1074.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". SM1074.2 +016600 01 XXINFO. SM1074.2 +016700 02 FILLER PIC X(19) VALUE SM1074.2 +016800 "*** INFORMATION ***". SM1074.2 +016900 02 INFO-TEXT. SM1074.2 +017000 04 FILLER PIC X(8) VALUE SPACE. SM1074.2 +017100 04 XXCOMPUTED PIC X(20). SM1074.2 +017200 04 FILLER PIC X(5) VALUE SPACE. SM1074.2 +017300 04 XXCORRECT PIC X(20). SM1074.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). SM1074.2 +017500 01 HYPHEN-LINE. SM1074.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. SM1074.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************SM1074.2 +017800- "*****************************************". SM1074.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************SM1074.2 +018000- "******************************". SM1074.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE SM1074.2 +018200 "SM107A". SM1074.2 +018300 PROCEDURE DIVISION. SM1074.2 +018400 CCVS1 SECTION. SM1074.2 +018500 OPEN-FILES. SM1074.2 +018600 OPEN OUTPUT PRINT-FILE. SM1074.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1074.2 +018800 MOVE SPACE TO TEST-RESULTS. SM1074.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1074.2 +019000 GO TO CCVS1-EXIT. SM1074.2 +019100 CLOSE-FILES. SM1074.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1074.2 +019300 TERMINATE-CCVS. SM1074.2 +019400S EXIT PROGRAM. SM1074.2 +019500STERMINATE-CALL. SM1074.2 +019600 STOP RUN. SM1074.2 +019700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1074.2 +019800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1074.2 +019900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1074.2 +020000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1074.2 +020100 MOVE "****TEST DELETED****" TO RE-MARK. SM1074.2 +020200 PRINT-DETAIL. SM1074.2 +020300 IF REC-CT NOT EQUAL TO ZERO SM1074.2 +020400 MOVE "." TO PARDOT-X SM1074.2 +020500 MOVE REC-CT TO DOTVALUE. SM1074.2 +020600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1074.2 +020700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1074.2 +020800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1074.2 +020900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1074.2 +021000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1074.2 +021100 MOVE SPACE TO CORRECT-X. SM1074.2 +021200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1074.2 +021300 MOVE SPACE TO RE-MARK. SM1074.2 +021400 HEAD-ROUTINE. SM1074.2 +021500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +021600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +021700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1074.2 +021800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1074.2 +021900 COLUMN-NAMES-ROUTINE. SM1074.2 +022000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +022100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +022300 END-ROUTINE. SM1074.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1074.2 +022500 END-RTN-EXIT. SM1074.2 +022600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +022700 END-ROUTINE-1. SM1074.2 +022800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1074.2 +022900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1074.2 +023000 ADD PASS-COUNTER TO ERROR-HOLD. SM1074.2 +023100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1074.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1074.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1074.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1074.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1074.2 +023600 END-ROUTINE-12. SM1074.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1074.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO SM1074.2 +023900 MOVE "NO " TO ERROR-TOTAL SM1074.2 +024000 ELSE SM1074.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1074.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1074.2 +024300 PERFORM WRITE-LINE. SM1074.2 +024400 END-ROUTINE-13. SM1074.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO SM1074.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE SM1074.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1074.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1074.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO SM1074.2 +025100 MOVE "NO " TO ERROR-TOTAL SM1074.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1074.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1074.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025600 WRITE-LINE. SM1074.2 +025700 ADD 1 TO RECORD-COUNT. SM1074.2 +025800Y IF RECORD-COUNT GREATER 50 SM1074.2 +025900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM1074.2 +026000Y MOVE SPACE TO DUMMY-RECORD SM1074.2 +026100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1074.2 +026200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1074.2 +026300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1074.2 +026400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1074.2 +026500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM1074.2 +026600Y MOVE ZERO TO RECORD-COUNT. SM1074.2 +026700 PERFORM WRT-LN. SM1074.2 +026800 WRT-LN. SM1074.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1074.2 +027000 MOVE SPACE TO DUMMY-RECORD. SM1074.2 +027100 BLANK-LINE-PRINT. SM1074.2 +027200 PERFORM WRT-LN. SM1074.2 +027300 FAIL-ROUTINE. SM1074.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1074.2 +027500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1074.2 +027600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1074.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1074.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +027900 MOVE SPACES TO INF-ANSI-REFERENCE. SM1074.2 +028000 GO TO FAIL-ROUTINE-EX. SM1074.2 +028100 FAIL-ROUTINE-WRITE. SM1074.2 +028200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1074.2 +028300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1074.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1074.2 +028500 MOVE SPACES TO COR-ANSI-REFERENCE. SM1074.2 +028600 FAIL-ROUTINE-EX. EXIT. SM1074.2 +028700 BAIL-OUT. SM1074.2 +028800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1074.2 +028900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1074.2 +029000 BAIL-OUT-WRITE. SM1074.2 +029100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1074.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1074.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. SM1074.2 +029500 BAIL-OUT-EX. EXIT. SM1074.2 +029600 CCVS1-EXIT. SM1074.2 +029700 EXIT. SM1074.2 +029800 WARNING-MSG. SM1074.2 +029900 MOVE " IF NO OTHER REPORT LINES APPEAR BELOW, ""COPY K7SEA"" SM1074.2 +030000- "FAILED." TO PRINT-REC. SM1074.2 +030100 PERFORM WRITE-LINE. SM1074.2 +030200* SM1074.2 +030300*********************** COPY STATEMENT USED **********************SM1074.2 +030400* SM1074.2 +030500*COPY K7SEA SM1074.2 +030600* SM1074.2 +030700******************** COPIED TEXT BEGINS BELOW ********************SM1074.2 +030800 COPY K7SEA. SM1074.2 +030900*********************** END OF COPIED TEXT ***********************SM1074.2 +031000 CCVS-EXIT SECTION. SM1074.2 +031100 CCVS-999999. SM1074.2 +031200 GO TO CLOSE-FILES. SM1074.2 +*END-OF,SM107A +*HEADER,COBOL,SM201A +000100 IDENTIFICATION DIVISION. SM2014.2 +000200 PROGRAM-ID. SM2014.2 +000300 SM201A. SM2014.2 +000400**************************************************************** SM2014.2 +000500* * SM2014.2 +000600* VALIDATION FOR:- * SM2014.2 +000700* * SM2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +000900* * SM2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2014.2 +001100* * SM2014.2 +001200**************************************************************** SM2014.2 +001300* * SM2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2014.2 +001500* * SM2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2014.2 +001900* * SM2014.2 +002000**************************************************************** SM2014.2 +002100* * SM2014.2 +002200* PROGRAM SM201A TESTS THE "REPLACING" PHRASE OF THE "COPY" * SM2014.2 +002300* STATEMENT IN THE WORKING-STORAGE SECTION AND * SM2014.2 +002400* PROCEDURE DIVISION AND PRODUCES A SEQUENTIAL OUTPUT FILE * SM2014.2 +002500* USING "COPY"ED CODE, WHICH IS SUBSEQUENTLY CHECKED BY * SM2014.2 +002600* SM202A. * SM2014.2 +002700* * SM2014.2 +002800**************************************************************** SM2014.2 +002900 ENVIRONMENT DIVISION. SM2014.2 +003000 CONFIGURATION SECTION. SM2014.2 +003100 SOURCE-COMPUTER. SM2014.2 +003200 XXXXX082. SM2014.2 +003300 OBJECT-COMPUTER. SM2014.2 +003400 XXXXX083. SM2014.2 +003500 INPUT-OUTPUT SECTION. SM2014.2 +003600 FILE-CONTROL. SM2014.2 +003700 SELECT PRINT-FILE ASSIGN TO SM2014.2 +003800 XXXXX055. SM2014.2 +003900 SELECT TEST-FILE ASSIGN TO SM2014.2 +004000 XXXXP001. SM2014.2 +004100 DATA DIVISION. SM2014.2 +004200 FILE SECTION. SM2014.2 +004300 FD PRINT-FILE. SM2014.2 +004400 01 PRINT-REC PICTURE X(120). SM2014.2 +004500 01 DUMMY-RECORD PICTURE X(120). SM2014.2 +004600 SM2014.2 +004700 SM2014.2 +004800 SM2014.2 +004900 SM2014.2 +005000 SM2014.2 +005100* SM2014.2 +005200*********************** COPY STATEMENT USED **********************SM2014.2 +005300* SM2014.2 +005400*FD TEST-FILE COPY K1FDA SM2014.2 +005500* REPLACING SM2014.2 +005600* PROOF-REC BY TST-TEST. SM2014.2 +005700* SM2014.2 +005800******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +005900 FD TEST-FILE COPY K1FDA SM2014.2 +006000 REPLACING SM2014.2 +006100 PROOF-REC BY TST-TEST. SM2014.2 +006200*********************** END OF COPIED TEXT ***********************SM2014.2 +006300 SM2014.2 +006400 SM2014.2 +006500 SM2014.2 +006600 SM2014.2 +006700 SM2014.2 +006800* SM2014.2 +006900*********************** COPY STATEMENT USED **********************SM2014.2 +007000* SM2014.2 +007100*01 TST-TEST COPY K101A SM2014.2 +007200* REPLACING SM2014.2 +007300* TST-FLD-1 BY TF-1. SM2014.2 +007400* SM2014.2 +007500******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +007600 01 TST-TEST COPY K101A SM2014.2 +007700 REPLACING SM2014.2 +007800 TST-FLD-1 BY TF-1. SM2014.2 +007900*********************** END OF COPIED TEXT ***********************SM2014.2 +008000 WORKING-STORAGE SECTION. SM2014.2 +008100 77 RCD-1 PICTURE 9(5) VALUE 97532. SM2014.2 +008200 77 RCD-2 PICTURE 9(5) VALUE 23479. SM2014.2 +008300 77 RCD-3 PICTURE 9(5) VALUE 10901. SM2014.2 +008400 77 RCD-4 PICTURE 9(5) VALUE 02734. SM2014.2 +008500 77 RCD-5 PICTURE 9(5) VALUE 14003. SM2014.2 +008600 77 RCD-6 PICTURE 9(5) VALUE 19922. SM2014.2 +008700 77 RCD-7 PICTURE 9(5) VALUE 03543. SM2014.2 +008800* SM2014.2 +008900*********************** COPY STATEMENT USED **********************SM2014.2 +009000* SM2014.2 +009100*01 TEXT-TEST-1 COPY K101A SM2014.2 +009200* REPLACING ==02 TST-FLD-1 PICTURE 9(5). 02 FILLER SM2014.2 +009300* PICTURE X(115)== SM2014.2 +009400* BY ==02 FILLER PICTURE X(115). 02 TXT-FLD-1 SM2014.2 +009500* PIC 9(5)==. SM2014.2 +009600* SM2014.2 +009700******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +009800 01 TEXT-TEST-1 COPY K101A SM2014.2 +009900 REPLACING ==02 TST-FLD-1 PICTURE 9(5). 02 FILLER SM2014.2 +010000 PICTURE X(115)== SM2014.2 +010100 BY ==02 FILLER PICTURE X(115). 02 TXT-FLD-1 SM2014.2 +010200 PIC 9(5)==. SM2014.2 +010300*********************** END OF COPIED TEXT ***********************SM2014.2 +010400 01 WSTR-1. SM2014.2 +010500 02 WSTR-1A PICTURE XXX VALUE "ABC". SM2014.2 +010600 SM2014.2 +010700 SM2014.2 +010800 SM2014.2 +010900 SM2014.2 +011000 SM2014.2 +011100 01 WSTR-2. SM2014.2 +011200* SM2014.2 +011300*********************** COPY STATEMENT USED **********************SM2014.2 +011400* SM2014.2 +011500* COPY K1WKA SM2014.2 +011600* REPLACING WSTR-2A BY WSTR999. SM2014.2 +011700* SM2014.2 +011800******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +011900 COPY K1WKA SM2014.2 +012000 REPLACING WSTR-2A BY WSTR999. SM2014.2 +012100*********************** END OF COPIED TEXT ***********************SM2014.2 +012200 SM2014.2 +012300 SM2014.2 +012400 SM2014.2 +012500 SM2014.2 +012600 SM2014.2 +012700 01 WSTR-3. SM2014.2 +012800* SM2014.2 +012900*********************** COPY STATEMENT USED **********************SM2014.2 +013000* SM2014.2 +013100* COPY K1WKA.SM2014.2 +013200* SM2014.2 +013300******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +013400 COPY K1WKA.SM2014.2 +013500*********************** END OF COPIED TEXT ***********************SM2014.2 +013600 SM2014.2 +013700 SM2014.2 +013800 SM2014.2 +013900 SM2014.2 +014000 SM2014.2 +014100* SM2014.2 +014200*********************** COPY STATEMENT USED **********************SM2014.2 +014300* SM2014.2 +014400*01 WSTR-4. COPY K1WKB SM2014.2 +014500* REPLACING WSTR4A BY WSTR91 SM2014.2 +014600* WSTR4B BY WSTR92 SM2014.2 +014700* WSTR4C BY WSTR93. SM2014.2 +014800* SM2014.2 +014900******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +015000 01 WSTR-4. COPY K1WKB SM2014.2 +015100 REPLACING WSTR4A BY WSTR91 SM2014.2 +015200 WSTR4B BY WSTR92 SM2014.2 +015300 WSTR4C BY WSTR93. SM2014.2 +015400*********************** END OF COPIED TEXT ***********************SM2014.2 +015500 SM2014.2 +015600 SM2014.2 +015700 SM2014.2 +015800 SM2014.2 +015900 SM2014.2 +016000* SM2014.2 +016100*********************** COPY STATEMENT USED **********************SM2014.2 +016200* SM2014.2 +016300*01 WSTR-5. COPY K1WKB.SM2014.2 +016400* SM2014.2 +016500******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +016600 01 WSTR-5. COPY K1WKB.SM2014.2 +016700*********************** END OF COPIED TEXT ***********************SM2014.2 +016800 01 TEST-RESULTS. SM2014.2 +016900 02 FILLER PIC X VALUE SPACE. SM2014.2 +017000 02 FEATURE PIC X(20) VALUE SPACE. SM2014.2 +017100 02 FILLER PIC X VALUE SPACE. SM2014.2 +017200 02 P-OR-F PIC X(5) VALUE SPACE. SM2014.2 +017300 02 FILLER PIC X VALUE SPACE. SM2014.2 +017400 02 PAR-NAME. SM2014.2 +017500 03 FILLER PIC X(19) VALUE SPACE. SM2014.2 +017600 03 PARDOT-X PIC X VALUE SPACE. SM2014.2 +017700 03 DOTVALUE PIC 99 VALUE ZERO. SM2014.2 +017800 02 FILLER PIC X(8) VALUE SPACE. SM2014.2 +017900 02 RE-MARK PIC X(61). SM2014.2 +018000 01 TEST-COMPUTED. SM2014.2 +018100 02 FILLER PIC X(30) VALUE SPACE. SM2014.2 +018200 02 FILLER PIC X(17) VALUE SM2014.2 +018300 " COMPUTED=". SM2014.2 +018400 02 COMPUTED-X. SM2014.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2014.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A SM2014.2 +018700 PIC -9(9).9(9). SM2014.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2014.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2014.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2014.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SM2014.2 +019200 04 COMPUTED-18V0 PIC -9(18). SM2014.2 +019300 04 FILLER PIC X. SM2014.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SM2014.2 +019500 01 TEST-CORRECT. SM2014.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SM2014.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SM2014.2 +019800 02 CORRECT-X. SM2014.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SM2014.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2014.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2014.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2014.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2014.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SM2014.2 +020500 04 CORRECT-18V0 PIC -9(18). SM2014.2 +020600 04 FILLER PIC X. SM2014.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SM2014.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2014.2 +020900 01 CCVS-C-1. SM2014.2 +021000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2014.2 +021100- "SS PARAGRAPH-NAME SM2014.2 +021200- " REMARKS". SM2014.2 +021300 02 FILLER PIC X(20) VALUE SPACE. SM2014.2 +021400 01 CCVS-C-2. SM2014.2 +021500 02 FILLER PIC X VALUE SPACE. SM2014.2 +021600 02 FILLER PIC X(6) VALUE "TESTED". SM2014.2 +021700 02 FILLER PIC X(15) VALUE SPACE. SM2014.2 +021800 02 FILLER PIC X(4) VALUE "FAIL". SM2014.2 +021900 02 FILLER PIC X(94) VALUE SPACE. SM2014.2 +022000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2014.2 +022100 01 REC-CT PIC 99 VALUE ZERO. SM2014.2 +022200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2014.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2014.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2014.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2014.2 +023000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2014.2 +023100 01 CCVS-H-1. SM2014.2 +023200 02 FILLER PIC X(39) VALUE SPACES. SM2014.2 +023300 02 FILLER PIC X(42) VALUE SM2014.2 +023400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2014.2 +023500 02 FILLER PIC X(39) VALUE SPACES. SM2014.2 +023600 01 CCVS-H-2A. SM2014.2 +023700 02 FILLER PIC X(40) VALUE SPACE. SM2014.2 +023800 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2014.2 +023900 02 FILLER PIC XXXX VALUE SM2014.2 +024000 "4.2 ". SM2014.2 +024100 02 FILLER PIC X(28) VALUE SM2014.2 +024200 " COPY - NOT FOR DISTRIBUTION". SM2014.2 +024300 02 FILLER PIC X(41) VALUE SPACE. SM2014.2 +024400 SM2014.2 +024500 01 CCVS-H-2B. SM2014.2 +024600 02 FILLER PIC X(15) VALUE SM2014.2 +024700 "TEST RESULT OF ". SM2014.2 +024800 02 TEST-ID PIC X(9). SM2014.2 +024900 02 FILLER PIC X(4) VALUE SM2014.2 +025000 " IN ". SM2014.2 +025100 02 FILLER PIC X(12) VALUE SM2014.2 +025200 " HIGH ". SM2014.2 +025300 02 FILLER PIC X(22) VALUE SM2014.2 +025400 " LEVEL VALIDATION FOR ". SM2014.2 +025500 02 FILLER PIC X(58) VALUE SM2014.2 +025600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +025700 01 CCVS-H-3. SM2014.2 +025800 02 FILLER PIC X(34) VALUE SM2014.2 +025900 " FOR OFFICIAL USE ONLY ". SM2014.2 +026000 02 FILLER PIC X(58) VALUE SM2014.2 +026100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2014.2 +026200 02 FILLER PIC X(28) VALUE SM2014.2 +026300 " COPYRIGHT 1985 ". SM2014.2 +026400 01 CCVS-E-1. SM2014.2 +026500 02 FILLER PIC X(52) VALUE SPACE. SM2014.2 +026600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2014.2 +026700 02 ID-AGAIN PIC X(9). SM2014.2 +026800 02 FILLER PIC X(45) VALUE SPACES. SM2014.2 +026900 01 CCVS-E-2. SM2014.2 +027000 02 FILLER PIC X(31) VALUE SPACE. SM2014.2 +027100 02 FILLER PIC X(21) VALUE SPACE. SM2014.2 +027200 02 CCVS-E-2-2. SM2014.2 +027300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2014.2 +027400 03 FILLER PIC X VALUE SPACE. SM2014.2 +027500 03 ENDER-DESC PIC X(44) VALUE SM2014.2 +027600 "ERRORS ENCOUNTERED". SM2014.2 +027700 01 CCVS-E-3. SM2014.2 +027800 02 FILLER PIC X(22) VALUE SM2014.2 +027900 " FOR OFFICIAL USE ONLY". SM2014.2 +028000 02 FILLER PIC X(12) VALUE SPACE. SM2014.2 +028100 02 FILLER PIC X(58) VALUE SM2014.2 +028200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +028300 02 FILLER PIC X(13) VALUE SPACE. SM2014.2 +028400 02 FILLER PIC X(15) VALUE SM2014.2 +028500 " COPYRIGHT 1985". SM2014.2 +028600 01 CCVS-E-4. SM2014.2 +028700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2014.2 +028800 02 FILLER PIC X(4) VALUE " OF ". SM2014.2 +028900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2014.2 +029000 02 FILLER PIC X(40) VALUE SM2014.2 +029100 " TESTS WERE EXECUTED SUCCESSFULLY". SM2014.2 +029200 01 XXINFO. SM2014.2 +029300 02 FILLER PIC X(19) VALUE SM2014.2 +029400 "*** INFORMATION ***". SM2014.2 +029500 02 INFO-TEXT. SM2014.2 +029600 04 FILLER PIC X(8) VALUE SPACE. SM2014.2 +029700 04 XXCOMPUTED PIC X(20). SM2014.2 +029800 04 FILLER PIC X(5) VALUE SPACE. SM2014.2 +029900 04 XXCORRECT PIC X(20). SM2014.2 +030000 02 INF-ANSI-REFERENCE PIC X(48). SM2014.2 +030100 01 HYPHEN-LINE. SM2014.2 +030200 02 FILLER PIC IS X VALUE IS SPACE. SM2014.2 +030300 02 FILLER PIC IS X(65) VALUE IS "************************SM2014.2 +030400- "*****************************************". SM2014.2 +030500 02 FILLER PIC IS X(54) VALUE IS "************************SM2014.2 +030600- "******************************". SM2014.2 +030700 01 CCVS-PGM-ID PIC X(9) VALUE SM2014.2 +030800 "SM201A". SM2014.2 +030900 PROCEDURE DIVISION. SM2014.2 +031000 CCVS1 SECTION. SM2014.2 +031100 OPEN-FILES. SM2014.2 +031200 OPEN OUTPUT PRINT-FILE. SM2014.2 +031300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2014.2 +031400 MOVE SPACE TO TEST-RESULTS. SM2014.2 +031500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2014.2 +031600 GO TO CCVS1-EXIT. SM2014.2 +031700 CLOSE-FILES. SM2014.2 +031800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2014.2 +031900 TERMINATE-CCVS. SM2014.2 +032000S EXIT PROGRAM. SM2014.2 +032100STERMINATE-CALL. SM2014.2 +032200 STOP RUN. SM2014.2 +032300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2014.2 +032400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2014.2 +032500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2014.2 +032600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2014.2 +032700 MOVE "****TEST DELETED****" TO RE-MARK. SM2014.2 +032800 PRINT-DETAIL. SM2014.2 +032900 IF REC-CT NOT EQUAL TO ZERO SM2014.2 +033000 MOVE "." TO PARDOT-X SM2014.2 +033100 MOVE REC-CT TO DOTVALUE. SM2014.2 +033200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2014.2 +033300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2014.2 +033400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2014.2 +033500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2014.2 +033600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2014.2 +033700 MOVE SPACE TO CORRECT-X. SM2014.2 +033800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2014.2 +033900 MOVE SPACE TO RE-MARK. SM2014.2 +034000 HEAD-ROUTINE. SM2014.2 +034100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2014.2 +034400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2014.2 +034500 COLUMN-NAMES-ROUTINE. SM2014.2 +034600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +034700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +034900 END-ROUTINE. SM2014.2 +035000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2014.2 +035100 END-RTN-EXIT. SM2014.2 +035200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +035300 END-ROUTINE-1. SM2014.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2014.2 +035500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2014.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SM2014.2 +035700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2014.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2014.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2014.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2014.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2014.2 +036200 END-ROUTINE-12. SM2014.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2014.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SM2014.2 +036500 MOVE "NO " TO ERROR-TOTAL SM2014.2 +036600 ELSE SM2014.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2014.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2014.2 +036900 PERFORM WRITE-LINE. SM2014.2 +037000 END-ROUTINE-13. SM2014.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SM2014.2 +037200 MOVE "NO " TO ERROR-TOTAL ELSE SM2014.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2014.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2014.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +037600 IF INSPECT-COUNTER EQUAL TO ZERO SM2014.2 +037700 MOVE "NO " TO ERROR-TOTAL SM2014.2 +037800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2014.2 +037900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2014.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +038100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +038200 WRITE-LINE. SM2014.2 +038300 ADD 1 TO RECORD-COUNT. SM2014.2 +038400Y IF RECORD-COUNT GREATER 50 SM2014.2 +038500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2014.2 +038600Y MOVE SPACE TO DUMMY-RECORD SM2014.2 +038700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2014.2 +038800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2014.2 +038900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2014.2 +039000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2014.2 +039100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2014.2 +039200Y MOVE ZERO TO RECORD-COUNT. SM2014.2 +039300 PERFORM WRT-LN. SM2014.2 +039400 WRT-LN. SM2014.2 +039500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2014.2 +039600 MOVE SPACE TO DUMMY-RECORD. SM2014.2 +039700 BLANK-LINE-PRINT. SM2014.2 +039800 PERFORM WRT-LN. SM2014.2 +039900 FAIL-ROUTINE. SM2014.2 +040000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2014.2 +040100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2014.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2014.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2014.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2014.2 +040600 GO TO FAIL-ROUTINE-EX. SM2014.2 +040700 FAIL-ROUTINE-WRITE. SM2014.2 +040800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2014.2 +040900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2014.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2014.2 +041100 MOVE SPACES TO COR-ANSI-REFERENCE. SM2014.2 +041200 FAIL-ROUTINE-EX. EXIT. SM2014.2 +041300 BAIL-OUT. SM2014.2 +041400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2014.2 +041500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2014.2 +041600 BAIL-OUT-WRITE. SM2014.2 +041700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2014.2 +041800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2014.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2014.2 +042100 BAIL-OUT-EX. EXIT. SM2014.2 +042200 CCVS1-EXIT. SM2014.2 +042300 EXIT. SM2014.2 +042400 INITIALIZATION SECTION. SM2014.2 +042500 SM201A-INIT. SM2014.2 +042600 OPEN OUTPUT TEST-FILE. SM2014.2 +042700 MOVE "OUTPUT OF SM201A IS USED AS" TO RE-MARK. SM2014.2 +042800 PERFORM PRINT-DETAIL. SM2014.2 +042900 MOVE "INPUT FOR SM202A." TO RE-MARK. SM2014.2 +043000 PERFORM PRINT-DETAIL. SM2014.2 +043100 MOVE "COPY 01 LEVEL --- " TO FEATURE. SM2014.2 +043200 PERFORM PRINT-DETAIL. SM2014.2 +043300 WORKING-STORAGE-TEST SECTION. SM2014.2 +043400 COPY-TEST-1. SM2014.2 +043500 IF WSTR-1A EQUAL TO WSTR999 SM2014.2 +043600 PERFORM PASS GO TO COPY-WRITE-1. SM2014.2 +043700* NOTE TESTS COPYING WITH REPLACEMENT IN WORKING-STORAGE. SM2014.2 +043800 GO TO COPY-FAIL-1. SM2014.2 +043900 COPY-DELETE-1. SM2014.2 +044000 PERFORM DE-LETE. SM2014.2 +044100 GO TO COPY-WRITE-1. SM2014.2 +044200 COPY-FAIL-1. SM2014.2 +044300 MOVE WSTR999 TO COMPUTED-A. SM2014.2 +044400 MOVE "ABC" TO CORRECT-A. SM2014.2 +044500 PERFORM FAIL. SM2014.2 +044600 COPY-WRITE-1. SM2014.2 +044700 MOVE " REPLACING" TO FEATURE. SM2014.2 +044800 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2014.2 +044900 PERFORM PRINT-DETAIL. SM2014.2 +045000 COPY-TEST-2. SM2014.2 +045100 IF WSTR-2A EQUAL TO "ABC" SM2014.2 +045200 PERFORM PASS GO TO COPY-WRITE-2. SM2014.2 +045300* NOTE TESTS ORDINARY COPY OF ENTRIES WHICH ARE ALSO COPIEDSM2014.2 +045400* BY COPY REPLACING. SM2014.2 +045500 GO TO COPY-FAIL-2. SM2014.2 +045600 COPY-DELETE-2. SM2014.2 +045700 PERFORM DE-LETE. SM2014.2 +045800 GO TO COPY-WRITE-2. SM2014.2 +045900 COPY-FAIL-2. SM2014.2 +046000 MOVE WSTR-2A TO COMPUTED-A. SM2014.2 +046100 MOVE "ABC" TO CORRECT-A. SM2014.2 +046200 PERFORM FAIL. SM2014.2 +046300 COPY-WRITE-2. SM2014.2 +046400 MOVE " (NO REPLACING)" TO FEATURE. SM2014.2 +046500 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2014.2 +046600 PERFORM PRINT-DETAIL. SM2014.2 +046700 COPY-INIT-A. SM2014.2 +046800 MOVE " REPLACING" TO FEATURE. SM2014.2 +046900 COPY-TEST-3. SM2014.2 +047000 IF WSTR91 EQUAL TO "ABC" SM2014.2 +047100 PERFORM PASS GO TO COPY-WRITE-3. SM2014.2 +047200* NOTE COPY-TEST-3, 4, AND 5 TEST COPYING WITH A SM2014.2 +047300* SERIES OF REPLACEMENTS. SM2014.2 +047400 GO TO COPY-FAIL-3. SM2014.2 +047500 COPY-DELETE-3. SM2014.2 +047600 PERFORM DE-LETE. SM2014.2 +047700 GO TO COPY-WRITE-3. SM2014.2 +047800 COPY-FAIL-3. SM2014.2 +047900 MOVE WSTR91 TO COMPUTED-A. SM2014.2 +048000 MOVE "ABC" TO CORRECT-A. SM2014.2 +048100 PERFORM FAIL. SM2014.2 +048200 COPY-WRITE-3. SM2014.2 +048300 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2014.2 +048400 PERFORM PRINT-DETAIL. SM2014.2 +048500 COPY-TEST-4. SM2014.2 +048600 IF WSTR92 EQUAL TO "DEF" SM2014.2 +048700 PERFORM PASS GO TO COPY-WRITE-4. SM2014.2 +048800 GO TO COPY-FAIL-4. SM2014.2 +048900 COPY-DELETE-4. SM2014.2 +049000 PERFORM DE-LETE. SM2014.2 +049100 GO TO COPY-WRITE-4. SM2014.2 +049200 COPY-FAIL-4. SM2014.2 +049300 MOVE WSTR92 TO COMPUTED-A. SM2014.2 +049400 MOVE "DEF" TO CORRECT-A. SM2014.2 +049500 PERFORM FAIL. SM2014.2 +049600 COPY-WRITE-4. SM2014.2 +049700 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2014.2 +049800 PERFORM PRINT-DETAIL. SM2014.2 +049900 COPY-TEST-5. SM2014.2 +050000 IF WSTR93 EQUAL TO "GHI" SM2014.2 +050100 PERFORM PASS GO TO COPY-WRITE-5. SM2014.2 +050200 GO TO COPY-FAIL-5. SM2014.2 +050300 COPY-DELETE-5. SM2014.2 +050400 PERFORM DE-LETE. SM2014.2 +050500 GO TO COPY-WRITE-5. SM2014.2 +050600 COPY-FAIL-5. SM2014.2 +050700 MOVE WSTR93 TO COMPUTED-A. SM2014.2 +050800 MOVE "GHI" TO CORRECT-A. SM2014.2 +050900 PERFORM FAIL. SM2014.2 +051000 COPY-WRITE-5. SM2014.2 +051100 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2014.2 +051200 PERFORM PRINT-DETAIL. SM2014.2 +051300 COPY-INIT-B. SM2014.2 +051400 MOVE " (NOT REPLACING)" TO FEATURE. SM2014.2 +051500 COPY-TEST-6. SM2014.2 +051600 IF WSTR4A EQUAL TO "ABC" SM2014.2 +051700 PERFORM PASS GO TO COPY-WRITE-6. SM2014.2 +051800* NOTE COPY-TEST-6, 7, AND 8 TEST ORDINARY COPYING OF SM2014.2 +051900* ENTRIES WHICH ARE ALSO COPIED WITH REPLACEMENT. SM2014.2 +052000 GO TO COPY-FAIL-6. SM2014.2 +052100 COPY-DELETE-6. SM2014.2 +052200 PERFORM DE-LETE. SM2014.2 +052300 GO TO COPY-WRITE-6. SM2014.2 +052400 COPY-FAIL-6. SM2014.2 +052500 MOVE WSTR4A TO COMPUTED-A. SM2014.2 +052600 MOVE "ABC" TO CORRECT-A. SM2014.2 +052700 PERFORM FAIL. SM2014.2 +052800 COPY-WRITE-6. SM2014.2 +052900 MOVE "COPY-TEST-6 " TO PAR-NAME. SM2014.2 +053000 PERFORM PRINT-DETAIL. SM2014.2 +053100 COPY-TEST-7. SM2014.2 +053200 IF WSTR4B EQUAL TO "DEF" SM2014.2 +053300 PERFORM PASS GO TO COPY-WRITE-7. SM2014.2 +053400 GO TO COPY-FAIL-7. SM2014.2 +053500 COPY-DELETE-7. SM2014.2 +053600 PERFORM DE-LETE. SM2014.2 +053700 GO TO COPY-WRITE-7. SM2014.2 +053800 COPY-FAIL-7. SM2014.2 +053900 MOVE WSTR4B TO COMPUTED-A. SM2014.2 +054000 MOVE "DEF" TO CORRECT-A. SM2014.2 +054100 PERFORM FAIL. SM2014.2 +054200 COPY-WRITE-7. SM2014.2 +054300 MOVE "COPY-TEST-7 " TO PAR-NAME. SM2014.2 +054400 PERFORM PRINT-DETAIL. SM2014.2 +054500 COPY-TEST-8. SM2014.2 +054600 IF WSTR4C EQUAL TO "GHI" SM2014.2 +054700 PERFORM PASS GO TO COPY-WRITE-8. SM2014.2 +054800 GO TO COPY-FAIL-8. SM2014.2 +054900 COPY-DELETE-8. SM2014.2 +055000 PERFORM DE-LETE. SM2014.2 +055100 GO TO COPY-WRITE-8. SM2014.2 +055200 COPY-FAIL-8. SM2014.2 +055300 MOVE WSTR4C TO COMPUTED-A. SM2014.2 +055400 MOVE "GHI" TO CORRECT-A. SM2014.2 +055500 PERFORM FAIL. SM2014.2 +055600 COPY-WRITE-8. SM2014.2 +055700 MOVE "COPY-TEST-8 " TO PAR-NAME. SM2014.2 +055800 PERFORM PRINT-DETAIL. SM2014.2 +055900 PARAGRAPH-TEST SECTION. SM2014.2 +056000 COPY-TEST-9. SM2014.2 +056100 SM2014.2 +056200 SM2014.2 +056300 SM2014.2 +056400 SM2014.2 +056500 SM2014.2 +056600* SM2014.2 +056700*********************** COPY STATEMENT USED **********************SM2014.2 +056800* SM2014.2 +056900* COPY K1PRB SM2014.2 +057000* REPLACING WSTR4C BY WSTR4B. SM2014.2 +057100* SM2014.2 +057200******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +057300 COPY K1PRB SM2014.2 +057400 REPLACING WSTR4C BY WSTR4B. SM2014.2 +057500*********************** END OF COPIED TEXT ***********************SM2014.2 +057600* NOTE COPY A PROCEDURE WHICH REFERENCES COPIED DATA. SM2014.2 +057700 IF WSTR-4 EQUAL TO "DEFABCDEF" SM2014.2 +057800 PERFORM PASS GO TO COPY-WRITE-9. SM2014.2 +057900 GO TO COPY-FAIL-9. SM2014.2 +058000 COPY-DELETE-9. SM2014.2 +058100 PERFORM DE-LETE. SM2014.2 +058200 GO TO COPY-WRITE-9. SM2014.2 +058300 COPY-FAIL-9. SM2014.2 +058400 MOVE WSTR-4 TO COMPUTED-A. SM2014.2 +058500 MOVE "DEFABCDEF" TO CORRECT-A. SM2014.2 +058600 PERFORM FAIL. SM2014.2 +058700 COPY-WRITE-9. SM2014.2 +058800 MOVE "COPY PARA REPLACING" TO FEATURE. SM2014.2 +058900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM2014.2 +059000 PERFORM PRINT-DETAIL. SM2014.2 +059100 BUILD SECTION. SM2014.2 +059200 COPY-TEST-10. SM2014.2 +059300 MOVE RCD-1 TO TF-1. SM2014.2 +059400 WRITE TST-TEST. SM2014.2 +059500 MOVE RCD-2 TO TF-1. SM2014.2 +059600 WRITE TST-TEST. SM2014.2 +059700 MOVE RCD-3 TO TF-1. SM2014.2 +059800 WRITE TST-TEST. SM2014.2 +059900 MOVE RCD-4 TO TF-1. SM2014.2 +060000 WRITE TST-TEST. SM2014.2 +060100 MOVE RCD-5 TO TF-1. SM2014.2 +060200 WRITE TST-TEST. SM2014.2 +060300 MOVE RCD-6 TO TF-1. SM2014.2 +060400 WRITE TST-TEST. SM2014.2 +060500 MOVE RCD-7 TO TF-1. SM2014.2 +060600 WRITE TST-TEST. SM2014.2 +060700 PERFORM PASS. SM2014.2 +060800 GO TO COPY-WRITE-10. SM2014.2 +060900 COPY-DELETE-10. SM2014.2 +061000 PERFORM DE-LETE. SM2014.2 +061100 COPY-WRITE-10. SM2014.2 +061200 MOVE "COPY FD REPLACING" TO FEATURE. SM2014.2 +061300 MOVE "COPY-TEST-10 " TO PAR-NAME. SM2014.2 +061400 MOVE "OUTPUT PASSED ONTO SM202" TO RE-MARK. SM2014.2 +061500 PERFORM PRINT-DETAIL. SM2014.2 +061600 CLOSE TEST-FILE. SM2014.2 +061700 MORE-TESTS SECTION. SM2014.2 +061800 COPY-TEST-11. SM2014.2 +061900 MOVE SPACES TO TEXT-TEST-1. SM2014.2 +062000 MOVE 12345 TO TXT-FLD-1. SM2014.2 +062100 IF TEXT-TEST-1 IS EQUAL TO " SM2014.2 +062200- " SM2014.2 +062300- " 12345" SM2014.2 +062400 PERFORM PASS ELSE PERFORM FAIL. SM2014.2 +062500 GO TO COPY-WRITE-11. SM2014.2 +062600 COPY-DELETE-11. SM2014.2 +062700 PERFORM DE-LETE. SM2014.2 +062800 COPY-WRITE-11. SM2014.2 +062900 MOVE "PSEUDO TEXT" TO FEATURE. SM2014.2 +063000 MOVE "COPY-TEST-11" TO PAR-NAME. SM2014.2 +063100 PERFORM PRINT-DETAIL. SM2014.2 +063200 CCVS-EXIT SECTION. SM2014.2 +063300 CCVS-999999. SM2014.2 +063400 GO TO CLOSE-FILES. SM2014.2 +*END-OF,SM201A +*HEADER,COBOL,SM201A,SUBPRG,SM202A +000100 IDENTIFICATION DIVISION. SM2024.2 +000200 PROGRAM-ID. SM2024.2 +000300 SM202A. SM2024.2 +000400**************************************************************** SM2024.2 +000500* * SM2024.2 +000600* VALIDATION FOR:- * SM2024.2 +000700* * SM2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +000900* * SM2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2024.2 +001100* * SM2024.2 +001200**************************************************************** SM2024.2 +001300* * SM2024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2024.2 +001500* * SM2024.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2024.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2024.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2024.2 +001900* * SM2024.2 +002000**************************************************************** SM2024.2 +002100* * SM2024.2 +002200* PROGRAM SM202A READS THE FILE PRODUCED BY SM201A TO * SM2024.2 +002300* VERIFY THE PROPER EXECUTION OF THE "COPY REPLACING" * SM2024.2 +002400* STATEMENTS IN SM201A. A NUMBER OF FURTHER TESTS USING * SM2024.2 +002500* VARIOUS NUMERIC AMD ALPHANUMERIC LITERALS, QUALIFIED * SM2024.2 +002600* DATA NAMES AND MULTIPLE "REPLACING" OPERANDS ARE ALSO * SM2024.2 +002700* CARRIED OUT. * SM2024.2 +002800* * SM2024.2 +002900**************************************************************** SM2024.2 +003000 ENVIRONMENT DIVISION. SM2024.2 +003100 CONFIGURATION SECTION. SM2024.2 +003200 SOURCE-COMPUTER. SM2024.2 +003300 XXXXX082. SM2024.2 +003400 OBJECT-COMPUTER. SM2024.2 +003500 XXXXX083. SM2024.2 +003600 INPUT-OUTPUT SECTION. SM2024.2 +003700 FILE-CONTROL. SM2024.2 +003800 SELECT PRINT-FILE ASSIGN TO SM2024.2 +003900 XXXXX055. SM2024.2 +004000 SELECT TEST-FILE ASSIGN TO SM2024.2 +004100 XXXXD001. SM2024.2 +004200 DATA DIVISION. SM2024.2 +004300 FILE SECTION. SM2024.2 +004400 FD PRINT-FILE. SM2024.2 +004500 01 PRINT-REC PICTURE X(120). SM2024.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2024.2 +004700 FD TEST-FILE SM2024.2 +004800 LABEL RECORD STANDARD SM2024.2 +004900C VALUE OF SM2024.2 +005000C XXXXX074 SM2024.2 +005100C IS SM2024.2 +005200C XXXXX075 SM2024.2 +005300G XXXXX069 SM2024.2 +005400 DATA RECORD IS PROOF-REC. SM2024.2 +005500 01 PROOF-REC. SM2024.2 +005600 02 TF-1 PICTURE 9(5). SM2024.2 +005700 02 FILLER PICTURE X(115). SM2024.2 +005800 WORKING-STORAGE SECTION. SM2024.2 +005900 01 COUNTER-16 PICTURE 9 VALUE 1. SM2024.2 +006000 01 TOTAL-AREA. SM2024.2 +006100 02 AREA-1 PICTURE AAAAA. SM2024.2 +006200 02 AREA-2 PICTURE XXXXB. SM2024.2 +006300 02 AREA-3 PICTURE XXXXX. SM2024.2 +006400 02 AREA-4 PICTURE ZZZZZ. SM2024.2 +006500 01 MISLEADING-DATA. SM2024.2 +006600 02 FALSE-DATA-1 PICTURE AAAAA VALUE "FALSE". SM2024.2 +006700 02 FALSE-DATA-2 PICTURE XXXXX VALUE " TENT". SM2024.2 +006800 02 FALSE-DATA-3 PICTURE XXXXX VALUE "- 5 =". SM2024.2 +006900 02 FALSE-DATA-4 PICTURE 99999 VALUE 00012. SM2024.2 +007000 01 QUALIFIED-DATA. SM2024.2 +007100 02 TRUE-Q-02. SM2024.2 +007200 03 TRUE-Q-03. SM2024.2 +007300 04 TRUE-Q-04 PICTURE A(5) VALUE "TRUE ". SM2024.2 +007400 03 FALSE-Q-03. SM2024.2 +007500 04 TRUE-Q-04 PICTURE A(5) VALUE "FIGHT". SM2024.2 +007600 02 FALSE-Q-02. SM2024.2 +007700 03 TRUE-Q-03. SM2024.2 +007800 04 TRUE-Q-04 PICTURE A(5) VALUE "DRIVE". SM2024.2 +007900 03 FALSE-Q-03. SM2024.2 +008000 04 TRUE-Q-04 PICTURE A(5) VALUE "THROW". SM2024.2 +008100 01 RE-SUB-DATA PICTURE X(40) VALUE SM2024.2 +008200 "ABCDEFGHIJKLMNOPQRST+ 2 =UVWXYZYXWVUTSRQ". SM2024.2 +008300 01 SUBSCRIPTED-DATA REDEFINES RE-SUB-DATA. SM2024.2 +008400 02 X OCCURS 2 TIMES. SM2024.2 +008500 03 Y OCCURS 2 TIMES. SM2024.2 +008600 04 Z OCCURS 2 TIMES PICTURE X(5). SM2024.2 +008700 01 TEST-RESULTS. SM2024.2 +008800 02 FILLER PIC X VALUE SPACE. SM2024.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. SM2024.2 +009000 02 FILLER PIC X VALUE SPACE. SM2024.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. SM2024.2 +009200 02 FILLER PIC X VALUE SPACE. SM2024.2 +009300 02 PAR-NAME. SM2024.2 +009400 03 FILLER PIC X(19) VALUE SPACE. SM2024.2 +009500 03 PARDOT-X PIC X VALUE SPACE. SM2024.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. SM2024.2 +009700 02 FILLER PIC X(8) VALUE SPACE. SM2024.2 +009800 02 RE-MARK PIC X(61). SM2024.2 +009900 01 TEST-COMPUTED. SM2024.2 +010000 02 FILLER PIC X(30) VALUE SPACE. SM2024.2 +010100 02 FILLER PIC X(17) VALUE SM2024.2 +010200 " COMPUTED=". SM2024.2 +010300 02 COMPUTED-X. SM2024.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2024.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A SM2024.2 +010600 PIC -9(9).9(9). SM2024.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2024.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2024.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2024.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. SM2024.2 +011100 04 COMPUTED-18V0 PIC -9(18). SM2024.2 +011200 04 FILLER PIC X. SM2024.2 +011300 03 FILLER PIC X(50) VALUE SPACE. SM2024.2 +011400 01 TEST-CORRECT. SM2024.2 +011500 02 FILLER PIC X(30) VALUE SPACE. SM2024.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". SM2024.2 +011700 02 CORRECT-X. SM2024.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. SM2024.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2024.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2024.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2024.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2024.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. SM2024.2 +012400 04 CORRECT-18V0 PIC -9(18). SM2024.2 +012500 04 FILLER PIC X. SM2024.2 +012600 03 FILLER PIC X(2) VALUE SPACE. SM2024.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2024.2 +012800 01 CCVS-C-1. SM2024.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2024.2 +013000- "SS PARAGRAPH-NAME SM2024.2 +013100- " REMARKS". SM2024.2 +013200 02 FILLER PIC X(20) VALUE SPACE. SM2024.2 +013300 01 CCVS-C-2. SM2024.2 +013400 02 FILLER PIC X VALUE SPACE. SM2024.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". SM2024.2 +013600 02 FILLER PIC X(15) VALUE SPACE. SM2024.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". SM2024.2 +013800 02 FILLER PIC X(94) VALUE SPACE. SM2024.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2024.2 +014000 01 REC-CT PIC 99 VALUE ZERO. SM2024.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2024.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2024.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2024.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2024.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2024.2 +015000 01 CCVS-H-1. SM2024.2 +015100 02 FILLER PIC X(39) VALUE SPACES. SM2024.2 +015200 02 FILLER PIC X(42) VALUE SM2024.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2024.2 +015400 02 FILLER PIC X(39) VALUE SPACES. SM2024.2 +015500 01 CCVS-H-2A. SM2024.2 +015600 02 FILLER PIC X(40) VALUE SPACE. SM2024.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2024.2 +015800 02 FILLER PIC XXXX VALUE SM2024.2 +015900 "4.2 ". SM2024.2 +016000 02 FILLER PIC X(28) VALUE SM2024.2 +016100 " COPY - NOT FOR DISTRIBUTION". SM2024.2 +016200 02 FILLER PIC X(41) VALUE SPACE. SM2024.2 +016300 SM2024.2 +016400 01 CCVS-H-2B. SM2024.2 +016500 02 FILLER PIC X(15) VALUE SM2024.2 +016600 "TEST RESULT OF ". SM2024.2 +016700 02 TEST-ID PIC X(9). SM2024.2 +016800 02 FILLER PIC X(4) VALUE SM2024.2 +016900 " IN ". SM2024.2 +017000 02 FILLER PIC X(12) VALUE SM2024.2 +017100 " HIGH ". SM2024.2 +017200 02 FILLER PIC X(22) VALUE SM2024.2 +017300 " LEVEL VALIDATION FOR ". SM2024.2 +017400 02 FILLER PIC X(58) VALUE SM2024.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +017600 01 CCVS-H-3. SM2024.2 +017700 02 FILLER PIC X(34) VALUE SM2024.2 +017800 " FOR OFFICIAL USE ONLY ". SM2024.2 +017900 02 FILLER PIC X(58) VALUE SM2024.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2024.2 +018100 02 FILLER PIC X(28) VALUE SM2024.2 +018200 " COPYRIGHT 1985 ". SM2024.2 +018300 01 CCVS-E-1. SM2024.2 +018400 02 FILLER PIC X(52) VALUE SPACE. SM2024.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2024.2 +018600 02 ID-AGAIN PIC X(9). SM2024.2 +018700 02 FILLER PIC X(45) VALUE SPACES. SM2024.2 +018800 01 CCVS-E-2. SM2024.2 +018900 02 FILLER PIC X(31) VALUE SPACE. SM2024.2 +019000 02 FILLER PIC X(21) VALUE SPACE. SM2024.2 +019100 02 CCVS-E-2-2. SM2024.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2024.2 +019300 03 FILLER PIC X VALUE SPACE. SM2024.2 +019400 03 ENDER-DESC PIC X(44) VALUE SM2024.2 +019500 "ERRORS ENCOUNTERED". SM2024.2 +019600 01 CCVS-E-3. SM2024.2 +019700 02 FILLER PIC X(22) VALUE SM2024.2 +019800 " FOR OFFICIAL USE ONLY". SM2024.2 +019900 02 FILLER PIC X(12) VALUE SPACE. SM2024.2 +020000 02 FILLER PIC X(58) VALUE SM2024.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +020200 02 FILLER PIC X(13) VALUE SPACE. SM2024.2 +020300 02 FILLER PIC X(15) VALUE SM2024.2 +020400 " COPYRIGHT 1985". SM2024.2 +020500 01 CCVS-E-4. SM2024.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2024.2 +020700 02 FILLER PIC X(4) VALUE " OF ". SM2024.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2024.2 +020900 02 FILLER PIC X(40) VALUE SM2024.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". SM2024.2 +021100 01 XXINFO. SM2024.2 +021200 02 FILLER PIC X(19) VALUE SM2024.2 +021300 "*** INFORMATION ***". SM2024.2 +021400 02 INFO-TEXT. SM2024.2 +021500 04 FILLER PIC X(8) VALUE SPACE. SM2024.2 +021600 04 XXCOMPUTED PIC X(20). SM2024.2 +021700 04 FILLER PIC X(5) VALUE SPACE. SM2024.2 +021800 04 XXCORRECT PIC X(20). SM2024.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). SM2024.2 +022000 01 HYPHEN-LINE. SM2024.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. SM2024.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************SM2024.2 +022300- "*****************************************". SM2024.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************SM2024.2 +022500- "******************************". SM2024.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE SM2024.2 +022700 "SM202A". SM2024.2 +022800 PROCEDURE DIVISION. SM2024.2 +022900 CCVS1 SECTION. SM2024.2 +023000 OPEN-FILES. SM2024.2 +023100 OPEN OUTPUT PRINT-FILE. SM2024.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2024.2 +023300 MOVE SPACE TO TEST-RESULTS. SM2024.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2024.2 +023500 GO TO CCVS1-EXIT. SM2024.2 +023600 CLOSE-FILES. SM2024.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2024.2 +023800 TERMINATE-CCVS. SM2024.2 +023900S EXIT PROGRAM. SM2024.2 +024000STERMINATE-CALL. SM2024.2 +024100 STOP RUN. SM2024.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2024.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2024.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2024.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2024.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. SM2024.2 +024700 PRINT-DETAIL. SM2024.2 +024800 IF REC-CT NOT EQUAL TO ZERO SM2024.2 +024900 MOVE "." TO PARDOT-X SM2024.2 +025000 MOVE REC-CT TO DOTVALUE. SM2024.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2024.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2024.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2024.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2024.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2024.2 +025600 MOVE SPACE TO CORRECT-X. SM2024.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2024.2 +025800 MOVE SPACE TO RE-MARK. SM2024.2 +025900 HEAD-ROUTINE. SM2024.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2024.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2024.2 +026400 COLUMN-NAMES-ROUTINE. SM2024.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +026800 END-ROUTINE. SM2024.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2024.2 +027000 END-RTN-EXIT. SM2024.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +027200 END-ROUTINE-1. SM2024.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2024.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2024.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. SM2024.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2024.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2024.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2024.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2024.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2024.2 +028100 END-ROUTINE-12. SM2024.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2024.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO SM2024.2 +028400 MOVE "NO " TO ERROR-TOTAL SM2024.2 +028500 ELSE SM2024.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2024.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2024.2 +028800 PERFORM WRITE-LINE. SM2024.2 +028900 END-ROUTINE-13. SM2024.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO SM2024.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE SM2024.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2024.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2024.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO SM2024.2 +029600 MOVE "NO " TO ERROR-TOTAL SM2024.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2024.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2024.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +030100 WRITE-LINE. SM2024.2 +030200 ADD 1 TO RECORD-COUNT. SM2024.2 +030300Y IF RECORD-COUNT GREATER 50 SM2024.2 +030400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2024.2 +030500Y MOVE SPACE TO DUMMY-RECORD SM2024.2 +030600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2024.2 +030700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2024.2 +030800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2024.2 +030900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2024.2 +031000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2024.2 +031100Y MOVE ZERO TO RECORD-COUNT. SM2024.2 +031200 PERFORM WRT-LN. SM2024.2 +031300 WRT-LN. SM2024.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2024.2 +031500 MOVE SPACE TO DUMMY-RECORD. SM2024.2 +031600 BLANK-LINE-PRINT. SM2024.2 +031700 PERFORM WRT-LN. SM2024.2 +031800 FAIL-ROUTINE. SM2024.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2024.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2024.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2024.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2024.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. SM2024.2 +032500 GO TO FAIL-ROUTINE-EX. SM2024.2 +032600 FAIL-ROUTINE-WRITE. SM2024.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2024.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2024.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2024.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. SM2024.2 +033100 FAIL-ROUTINE-EX. EXIT. SM2024.2 +033200 BAIL-OUT. SM2024.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2024.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2024.2 +033500 BAIL-OUT-WRITE. SM2024.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2024.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2024.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. SM2024.2 +034000 BAIL-OUT-EX. EXIT. SM2024.2 +034100 CCVS1-EXIT. SM2024.2 +034200 EXIT. SM2024.2 +034300 INITIALIZATION SECTION. SM2024.2 +034400 SM202A-INIT. SM2024.2 +034500 OPEN INPUT TEST-FILE. SM2024.2 +034600 MOVE "SM202A CHECKS A FILE WHICH" TO RE-MARK. SM2024.2 +034700 PERFORM PRINT-DETAIL. SM2024.2 +034800 MOVE "WAS GENERATED IN SM201A." TO RE-MARK. SM2024.2 +034900 PERFORM PRINT-DETAIL. SM2024.2 +035000 MOVE "COPY FD REPLACING" TO FEATURE. SM2024.2 +035100 FD-TEST SECTION. SM2024.2 +035200 COPY-TEST-11. SM2024.2 +035300 PERFORM READ-TEST-FILE. SM2024.2 +035400 IF TF-1 EQUAL TO 97532 SM2024.2 +035500 PERFORM PASS GO TO COPY-WRITE-11. SM2024.2 +035600 GO TO COPY-FAIL-11. SM2024.2 +035700 COPY-DELETE-11. SM2024.2 +035800 PERFORM DE-LETE. SM2024.2 +035900 GO TO COPY-WRITE-11. SM2024.2 +036000 COPY-FAIL-11. SM2024.2 +036100 MOVE TF-1 TO COMPUTED-N. SM2024.2 +036200 MOVE 97532 TO CORRECT-N. SM2024.2 +036300 PERFORM FAIL. SM2024.2 +036400 COPY-WRITE-11. SM2024.2 +036500 MOVE "COPY-TEST-11 " TO PAR-NAME. SM2024.2 +036600 PERFORM PRINT-DETAIL. SM2024.2 +036700 COPY-TEST-12. SM2024.2 +036800 PERFORM READ-TEST-FILE. SM2024.2 +036900 IF TF-1 EQUAL TO 23479 SM2024.2 +037000 PERFORM PASS GO TO COPY-WRITE-12. SM2024.2 +037100 GO TO COPY-FAIL-12. SM2024.2 +037200 COPY-DELETE-12. SM2024.2 +037300 PERFORM DE-LETE. SM2024.2 +037400 GO TO COPY-WRITE-12. SM2024.2 +037500 COPY-FAIL-12. SM2024.2 +037600 MOVE TF-1 TO COMPUTED-N. SM2024.2 +037700 MOVE 23479 TO CORRECT-N. SM2024.2 +037800 PERFORM FAIL. SM2024.2 +037900 COPY-WRITE-12. SM2024.2 +038000 MOVE "COPY-TEST-12 " TO PAR-NAME. SM2024.2 +038100 PERFORM PRINT-DETAIL. SM2024.2 +038200 COPY-TEST-13. SM2024.2 +038300 PERFORM READ-TEST-FILE 3 TIMES. SM2024.2 +038400 IF TF-1 EQUAL TO 14003 SM2024.2 +038500 PERFORM PASS GO TO COPY-WRITE-13. SM2024.2 +038600 GO TO COPY-FAIL-13. SM2024.2 +038700 COPY-DELETE-13. SM2024.2 +038800 PERFORM DE-LETE. SM2024.2 +038900 GO TO COPY-WRITE-13. SM2024.2 +039000 COPY-FAIL-13. SM2024.2 +039100 MOVE TF-1 TO COMPUTED-N. SM2024.2 +039200 MOVE 14003 TO CORRECT-N. SM2024.2 +039300 PERFORM FAIL. SM2024.2 +039400 COPY-WRITE-13. SM2024.2 +039500 MOVE "COPY-TEST-13 " TO PAR-NAME. SM2024.2 +039600 PERFORM PRINT-DETAIL. SM2024.2 +039700 COPY-TEST-14. SM2024.2 +039800 PERFORM READ-TEST-FILE 2 TIMES. SM2024.2 +039900 IF TF-1 EQUAL TO 03543 SM2024.2 +040000 PERFORM PASS GO TO COPY-WRITE-14. SM2024.2 +040100 GO TO COPY-FAIL-14. SM2024.2 +040200 COPY-DELETE-14. SM2024.2 +040300 PERFORM DE-LETE. SM2024.2 +040400 GO TO COPY-WRITE-14. SM2024.2 +040500 COPY-FAIL-14. SM2024.2 +040600 MOVE TF-1 TO COMPUTED-N. SM2024.2 +040700 MOVE 03543 TO CORRECT-N. SM2024.2 +040800 PERFORM FAIL. SM2024.2 +040900 COPY-WRITE-14. SM2024.2 +041000 MOVE "COPY-TEST-14 " TO PAR-NAME. SM2024.2 +041100 PERFORM PRINT-DETAIL. SM2024.2 +041200 COPY-INIT-A. SM2024.2 +041300 MOVE "COPY REPLACING --- " TO FEATURE. SM2024.2 +041400 PERFORM PRINT-DETAIL. SM2024.2 +041500 MOVE " PARAGRAPH-NAMES " TO FEATURE. SM2024.2 +041600 COPY-TEST-15 SECTION. SM2024.2 +041700 SM2024.2 +041800 SM2024.2 +041900 SM2024.2 +042000 SM2024.2 +042100 SM2024.2 +042200* SM2024.2 +042300*********************** COPY STATEMENT USED **********************SM2024.2 +042400* SM2024.2 +042500* COPY K2SEA SM2024.2 +042600* REPLACING PARA-X BY PARA-2 SM2024.2 +042700* 12345 BY PARA-3 SM2024.2 +042800* DUMMY-PASS BY PASS. SM2024.2 +042900* SM2024.2 +043000******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +043100 COPY K2SEA SM2024.2 +043200 REPLACING PARA-X BY PARA-2 SM2024.2 +043300 12345 BY PARA-3 SM2024.2 +043400 DUMMY-PASS BY PASS. SM2024.2 +043500*********************** END OF COPIED TEXT ***********************SM2024.2 +043600 COPY-A-15 SECTION. SM2024.2 +043700 COPY-DELETE-15. SM2024.2 +043800 PERFORM DE-LETE. SM2024.2 +043900 COPY-WRITE-15. SM2024.2 +044000 MOVE "COPY-TEST-15" TO PAR-NAME. SM2024.2 +044100 PERFORM PRINT-DETAIL. SM2024.2 +044200 COPY-PARA SECTION. SM2024.2 +044300 COPY-INIT-B. SM2024.2 +044400 MOVE " BY LITERALS " TO FEATURE. SM2024.2 +044500 COPY-TEST-16. SM2024.2 +044600 SM2024.2 +044700 SM2024.2 +044800 SM2024.2 +044900 SM2024.2 +045000 SM2024.2 +045100* SM2024.2 +045200*********************** COPY STATEMENT USED **********************SM2024.2 +045300* SM2024.2 +045400* COPY K2PRA SM2024.2 +045500* REPLACING FALSE-DATA-1 BY "TRUE " SM2024.2 +045600* FALSE-DATA-2 BY " TWO$" SM2024.2 +045700* FALSE-DATA-3 BY "+ 2 =" SM2024.2 +045800* FALSE-DATA-4 BY 4. SM2024.2 +045900* SM2024.2 +046000******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +046100 COPY K2PRA SM2024.2 +046200 REPLACING FALSE-DATA-1 BY "TRUE " SM2024.2 +046300 FALSE-DATA-2 BY " TWO$" SM2024.2 +046400 FALSE-DATA-3 BY "+ 2 =" SM2024.2 +046500 FALSE-DATA-4 BY 4. SM2024.2 +046600*********************** END OF COPIED TEXT ***********************SM2024.2 +046700 COPY-DELETE-16. SM2024.2 +046800 PERFORM DE-LETE. SM2024.2 +046900 COPY-WRITE-16. SM2024.2 +047000 IF COUNTER-16 IS EQUAL TO 0 SM2024.2 +047100 PERFORM FAIL SM2024.2 +047200 GO TO COPY-WRITE-17 SM2024.2 +047300 ELSE SM2024.2 +047400 SUBTRACT 1 FROM COUNTER-16. SM2024.2 +047500 IF P-OR-F EQUAL TO "FAIL*" SM2024.2 +047600 MOVE TOTAL-AREA TO COMPUTED-A SM2024.2 +047700 MOVE "TRUE TWO + 2 = 4" TO CORRECT-A. SM2024.2 +047800 MOVE "COPY-TEST-16" TO PAR-NAME. SM2024.2 +047900 PERFORM PRINT-DETAIL. SM2024.2 +048000 COPY-INIT-17. SM2024.2 +048100 MOVE SPACE TO TOTAL-AREA. SM2024.2 +048200 COPY-TEST-17. SM2024.2 +048300 SM2024.2 +048400 SM2024.2 +048500 SM2024.2 +048600 SM2024.2 +048700 SM2024.2 +048800* SM2024.2 +048900*********************** COPY STATEMENT USED **********************SM2024.2 +049000* SM2024.2 +049100* COPY K2PRA SM2024.2 +049200* REPLACING FALSE-DATA-1 BY TRUE-Q-04 OF TRUE-Q-03 SM2024.2 +049300* IN TRUE-Q-02 SM2024.2 +049400* COPY-WRITE-16 BY COPY-WRITE-17 SM2024.2 +049500* FALSE-DATA-2 BY " TWO FIVE " SM2024.2 +049600* FALSE-DATA-3 BY Z(2, 1, 1) SM2024.2 +049700* FALSE-DATA-4 BY +000004.99. SM2024.2 +049800* SM2024.2 +049900******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +050000 COPY K2PRA SM2024.2 +050100 REPLACING FALSE-DATA-1 BY TRUE-Q-04 OF TRUE-Q-03 SM2024.2 +050200 IN TRUE-Q-02 SM2024.2 +050300 COPY-WRITE-16 BY COPY-WRITE-17 SM2024.2 +050400 FALSE-DATA-2 BY " TWO FIVE " SM2024.2 +050500 FALSE-DATA-3 BY Z (2, 1, 1) SM2024.2 +050600 FALSE-DATA-4 BY +000004.99. SM2024.2 +050700*********************** END OF COPIED TEXT ***********************SM2024.2 +050800 COPY-DELETE-17. SM2024.2 +050900 PERFORM DE-LETE. SM2024.2 +051000 COPY-WRITE-17. SM2024.2 +051100 IF P-OR-F EQUAL TO "FAIL*" SM2024.2 +051200 MOVE TOTAL-AREA TO COMPUTED-A SM2024.2 +051300 MOVE "TRUE TWO + 2 = 4" TO CORRECT-A. SM2024.2 +051400 MOVE "COPY-TEST-17" TO PAR-NAME. SM2024.2 +051500 PERFORM PRINT-DETAIL. SM2024.2 +051600 CLOSE TEST-FILE. SM2024.2 +051700 GO TO CCVS-EXIT. SM2024.2 +051800 READ-TEST-FILE. SM2024.2 +051900 READ TEST-FILE AT END GO TO BAD-FILE. SM2024.2 +052000 BAD-FILE. SM2024.2 +052100 PERFORM FAIL. SM2024.2 +052200 MOVE "BAD-FILE" TO PAR-NAME. SM2024.2 +052300 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM2024.2 +052400 PERFORM PRINT-DETAIL. SM2024.2 +052500 CLOSE TEST-FILE. SM2024.2 +052600 GO TO CCVS-EXIT. SM2024.2 +052700 CCVS-EXIT SECTION. SM2024.2 +052800 CCVS-999999. SM2024.2 +052900 GO TO CLOSE-FILES. SM2024.2 +*END-OF,SM202A +*HEADER,COBOL,SM203A +000100 IDENTIFICATION DIVISION. SM2034.2 +000200 PROGRAM-ID. SM2034.2 +000300 SM203A. SM2034.2 +000400**************************************************************** SM2034.2 +000500* * SM2034.2 +000600* VALIDATION FOR:- * SM2034.2 +000700* * SM2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +000900* * SM2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2034.2 +001100* * SM2034.2 +001200**************************************************************** SM2034.2 +001300* * SM2034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2034.2 +001500* * SM2034.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2034.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2034.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2034.2 +001900* * SM2034.2 +002000**************************************************************** SM2034.2 +002100* * SM2034.2 +002200* PROGRAM SM203A TESTS THE USE OF THE "COPY" STATEMENT * SM2034.2 +002300* "REPLACING" PHRASE IN THE ENVIRONMENT DIVISION. * SM2034.2 +002400* A SEQUENTIAL FILE IS PRODUCED USING "COPY"ED TEXT AND * SM2034.2 +002500* THIS IS CHECKED IN PROGRAM SM204A. * SM2034.2 +002600* * SM2034.2 +002700**************************************************************** SM2034.2 +002800 ENVIRONMENT DIVISION. SM2034.2 +002900 CONFIGURATION SECTION. SM2034.2 +003000 SOURCE-COMPUTER. SM2034.2 +003100 XXXXX082. SM2034.2 +003200 OBJECT-COMPUTER. SM2034.2 +003300 XXXXX083. SM2034.2 +003400ASPECIAL-NAMES. COPY K3SNB SM2034.2 +003500A REPLACING DUMMY-SW-1 BY SW-1 SM2034.2 +003600A DUMMY-ON BY SWITCH-ON SM2034.2 +003700A DUMMY-OFF BY SWITCH-OFF. SM2034.2 +003800 INPUT-OUTPUT SECTION. SM2034.2 +003900 SM2034.2 +004000 SM2034.2 +004100 SM2034.2 +004200 SM2034.2 +004300 SM2034.2 +004400* SM2034.2 +004500*********************** COPY STATEMENT USED **********************SM2034.2 +004600* SM2034.2 +004700*FILE-CONTROL. COPY K3FCB SM2034.2 +004800* REPLACING DUMMY-TEST-FILE BY TEST-FILE. SM2034.2 +004900* SM2034.2 +005000******************** COPIED TEXT BEGINS BELOW ********************SM2034.2 +005100 FILE-CONTROL. COPY K3FCB SM2034.2 +005200 REPLACING DUMMY-TEST-FILE BY TEST-FILE. SM2034.2 +005300*********************** END OF COPIED TEXT ***********************SM2034.2 +005400 SM2034.2 +005500 SM2034.2 +005600 SM2034.2 +005700 SM2034.2 +005800 SM2034.2 +005900* SM2034.2 +006000*********************** COPY STATEMENT USED **********************SM2034.2 +006100* SM2034.2 +006200*I-O-CONTROL. COPY K3IOB SM2034.2 +006300* REPLACING DUMMY-PRINT-FILE BY PRINT-FILE. SM2034.2 +006400* SM2034.2 +006500******************** COPIED TEXT BEGINS BELOW ********************SM2034.2 +006600 I-O-CONTROL. COPY K3IOB SM2034.2 +006700 REPLACING DUMMY-PRINT-FILE BY PRINT-FILE. SM2034.2 +006800*********************** END OF COPIED TEXT ***********************SM2034.2 +006900 DATA DIVISION. SM2034.2 +007000 FILE SECTION. SM2034.2 +007100 FD PRINT-FILE. SM2034.2 +007200 01 PRINT-REC PICTURE X(120). SM2034.2 +007300 01 DUMMY-RECORD PICTURE X(120). SM2034.2 +007400 FD TEST-FILE SM2034.2 +007500 LABEL RECORD STANDARD SM2034.2 +007600C VALUE OF SM2034.2 +007700C XXXXX074 SM2034.2 +007800C IS SM2034.2 +007900C XXXXX077 SM2034.2 +008000G XXXXX069 SM2034.2 +008100 DATA RECORD IS PROOF-REC. SM2034.2 +008200 01 PROOF-REC. SM2034.2 +008300 02 TF-1 PICTURE 9(5). SM2034.2 +008400 02 FILLER PICTURE X(115). SM2034.2 +008500 WORKING-STORAGE SECTION. SM2034.2 +008600 77 RCD-1 PICTURE 9(5) VALUE 97532. SM2034.2 +008700 77 RCD-2 PICTURE 9(5) VALUE 23479. SM2034.2 +008800 77 RCD-3 PICTURE 9(5) VALUE 10901. SM2034.2 +008900 77 RCD-4 PICTURE 9(5) VALUE 02734. SM2034.2 +009000 77 RCD-5 PICTURE 9(5) VALUE 14003. SM2034.2 +009100 77 RCD-6 PICTURE 9(5) VALUE 19922. SM2034.2 +009200 77 RCD-7 PICTURE 9(5) VALUE 03543. SM2034.2 +009300 01 TEST-RESULTS. SM2034.2 +009400 02 FILLER PIC X VALUE SPACE. SM2034.2 +009500 02 FEATURE PIC X(20) VALUE SPACE. SM2034.2 +009600 02 FILLER PIC X VALUE SPACE. SM2034.2 +009700 02 P-OR-F PIC X(5) VALUE SPACE. SM2034.2 +009800 02 FILLER PIC X VALUE SPACE. SM2034.2 +009900 02 PAR-NAME. SM2034.2 +010000 03 FILLER PIC X(19) VALUE SPACE. SM2034.2 +010100 03 PARDOT-X PIC X VALUE SPACE. SM2034.2 +010200 03 DOTVALUE PIC 99 VALUE ZERO. SM2034.2 +010300 02 FILLER PIC X(8) VALUE SPACE. SM2034.2 +010400 02 RE-MARK PIC X(61). SM2034.2 +010500 01 TEST-COMPUTED. SM2034.2 +010600 02 FILLER PIC X(30) VALUE SPACE. SM2034.2 +010700 02 FILLER PIC X(17) VALUE SM2034.2 +010800 " COMPUTED=". SM2034.2 +010900 02 COMPUTED-X. SM2034.2 +011000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2034.2 +011100 03 COMPUTED-N REDEFINES COMPUTED-A SM2034.2 +011200 PIC -9(9).9(9). SM2034.2 +011300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2034.2 +011400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2034.2 +011500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2034.2 +011600 03 CM-18V0 REDEFINES COMPUTED-A. SM2034.2 +011700 04 COMPUTED-18V0 PIC -9(18). SM2034.2 +011800 04 FILLER PIC X. SM2034.2 +011900 03 FILLER PIC X(50) VALUE SPACE. SM2034.2 +012000 01 TEST-CORRECT. SM2034.2 +012100 02 FILLER PIC X(30) VALUE SPACE. SM2034.2 +012200 02 FILLER PIC X(17) VALUE " CORRECT =". SM2034.2 +012300 02 CORRECT-X. SM2034.2 +012400 03 CORRECT-A PIC X(20) VALUE SPACE. SM2034.2 +012500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2034.2 +012600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2034.2 +012700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2034.2 +012800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2034.2 +012900 03 CR-18V0 REDEFINES CORRECT-A. SM2034.2 +013000 04 CORRECT-18V0 PIC -9(18). SM2034.2 +013100 04 FILLER PIC X. SM2034.2 +013200 03 FILLER PIC X(2) VALUE SPACE. SM2034.2 +013300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2034.2 +013400 01 CCVS-C-1. SM2034.2 +013500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2034.2 +013600- "SS PARAGRAPH-NAME SM2034.2 +013700- " REMARKS". SM2034.2 +013800 02 FILLER PIC X(20) VALUE SPACE. SM2034.2 +013900 01 CCVS-C-2. SM2034.2 +014000 02 FILLER PIC X VALUE SPACE. SM2034.2 +014100 02 FILLER PIC X(6) VALUE "TESTED". SM2034.2 +014200 02 FILLER PIC X(15) VALUE SPACE. SM2034.2 +014300 02 FILLER PIC X(4) VALUE "FAIL". SM2034.2 +014400 02 FILLER PIC X(94) VALUE SPACE. SM2034.2 +014500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2034.2 +014600 01 REC-CT PIC 99 VALUE ZERO. SM2034.2 +014700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2034.2 +014800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2034.2 +014900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2034.2 +015000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2034.2 +015100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2034.2 +015200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2034.2 +015300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2034.2 +015400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2034.2 +015500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2034.2 +015600 01 CCVS-H-1. SM2034.2 +015700 02 FILLER PIC X(39) VALUE SPACES. SM2034.2 +015800 02 FILLER PIC X(42) VALUE SM2034.2 +015900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2034.2 +016000 02 FILLER PIC X(39) VALUE SPACES. SM2034.2 +016100 01 CCVS-H-2A. SM2034.2 +016200 02 FILLER PIC X(40) VALUE SPACE. SM2034.2 +016300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2034.2 +016400 02 FILLER PIC XXXX VALUE SM2034.2 +016500 "4.2 ". SM2034.2 +016600 02 FILLER PIC X(28) VALUE SM2034.2 +016700 " COPY - NOT FOR DISTRIBUTION". SM2034.2 +016800 02 FILLER PIC X(41) VALUE SPACE. SM2034.2 +016900 SM2034.2 +017000 01 CCVS-H-2B. SM2034.2 +017100 02 FILLER PIC X(15) VALUE SM2034.2 +017200 "TEST RESULT OF ". SM2034.2 +017300 02 TEST-ID PIC X(9). SM2034.2 +017400 02 FILLER PIC X(4) VALUE SM2034.2 +017500 " IN ". SM2034.2 +017600 02 FILLER PIC X(12) VALUE SM2034.2 +017700 " HIGH ". SM2034.2 +017800 02 FILLER PIC X(22) VALUE SM2034.2 +017900 " LEVEL VALIDATION FOR ". SM2034.2 +018000 02 FILLER PIC X(58) VALUE SM2034.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +018200 01 CCVS-H-3. SM2034.2 +018300 02 FILLER PIC X(34) VALUE SM2034.2 +018400 " FOR OFFICIAL USE ONLY ". SM2034.2 +018500 02 FILLER PIC X(58) VALUE SM2034.2 +018600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2034.2 +018700 02 FILLER PIC X(28) VALUE SM2034.2 +018800 " COPYRIGHT 1985 ". SM2034.2 +018900 01 CCVS-E-1. SM2034.2 +019000 02 FILLER PIC X(52) VALUE SPACE. SM2034.2 +019100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2034.2 +019200 02 ID-AGAIN PIC X(9). SM2034.2 +019300 02 FILLER PIC X(45) VALUE SPACES. SM2034.2 +019400 01 CCVS-E-2. SM2034.2 +019500 02 FILLER PIC X(31) VALUE SPACE. SM2034.2 +019600 02 FILLER PIC X(21) VALUE SPACE. SM2034.2 +019700 02 CCVS-E-2-2. SM2034.2 +019800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2034.2 +019900 03 FILLER PIC X VALUE SPACE. SM2034.2 +020000 03 ENDER-DESC PIC X(44) VALUE SM2034.2 +020100 "ERRORS ENCOUNTERED". SM2034.2 +020200 01 CCVS-E-3. SM2034.2 +020300 02 FILLER PIC X(22) VALUE SM2034.2 +020400 " FOR OFFICIAL USE ONLY". SM2034.2 +020500 02 FILLER PIC X(12) VALUE SPACE. SM2034.2 +020600 02 FILLER PIC X(58) VALUE SM2034.2 +020700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +020800 02 FILLER PIC X(13) VALUE SPACE. SM2034.2 +020900 02 FILLER PIC X(15) VALUE SM2034.2 +021000 " COPYRIGHT 1985". SM2034.2 +021100 01 CCVS-E-4. SM2034.2 +021200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2034.2 +021300 02 FILLER PIC X(4) VALUE " OF ". SM2034.2 +021400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2034.2 +021500 02 FILLER PIC X(40) VALUE SM2034.2 +021600 " TESTS WERE EXECUTED SUCCESSFULLY". SM2034.2 +021700 01 XXINFO. SM2034.2 +021800 02 FILLER PIC X(19) VALUE SM2034.2 +021900 "*** INFORMATION ***". SM2034.2 +022000 02 INFO-TEXT. SM2034.2 +022100 04 FILLER PIC X(8) VALUE SPACE. SM2034.2 +022200 04 XXCOMPUTED PIC X(20). SM2034.2 +022300 04 FILLER PIC X(5) VALUE SPACE. SM2034.2 +022400 04 XXCORRECT PIC X(20). SM2034.2 +022500 02 INF-ANSI-REFERENCE PIC X(48). SM2034.2 +022600 01 HYPHEN-LINE. SM2034.2 +022700 02 FILLER PIC IS X VALUE IS SPACE. SM2034.2 +022800 02 FILLER PIC IS X(65) VALUE IS "************************SM2034.2 +022900- "*****************************************". SM2034.2 +023000 02 FILLER PIC IS X(54) VALUE IS "************************SM2034.2 +023100- "******************************". SM2034.2 +023200 01 CCVS-PGM-ID PIC X(9) VALUE SM2034.2 +023300 "SM203A". SM2034.2 +023400 PROCEDURE DIVISION. SM2034.2 +023500 CCVS1 SECTION. SM2034.2 +023600 OPEN-FILES. SM2034.2 +023700 OPEN OUTPUT PRINT-FILE. SM2034.2 +023800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2034.2 +023900 MOVE SPACE TO TEST-RESULTS. SM2034.2 +024000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2034.2 +024100 GO TO CCVS1-EXIT. SM2034.2 +024200 CLOSE-FILES. SM2034.2 +024300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2034.2 +024400 TERMINATE-CCVS. SM2034.2 +024500S EXIT PROGRAM. SM2034.2 +024600STERMINATE-CALL. SM2034.2 +024700 STOP RUN. SM2034.2 +024800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2034.2 +024900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2034.2 +025000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2034.2 +025100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2034.2 +025200 MOVE "****TEST DELETED****" TO RE-MARK. SM2034.2 +025300 PRINT-DETAIL. SM2034.2 +025400 IF REC-CT NOT EQUAL TO ZERO SM2034.2 +025500 MOVE "." TO PARDOT-X SM2034.2 +025600 MOVE REC-CT TO DOTVALUE. SM2034.2 +025700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2034.2 +025800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2034.2 +025900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2034.2 +026000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2034.2 +026100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2034.2 +026200 MOVE SPACE TO CORRECT-X. SM2034.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2034.2 +026400 MOVE SPACE TO RE-MARK. SM2034.2 +026500 HEAD-ROUTINE. SM2034.2 +026600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +026700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +026800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2034.2 +026900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2034.2 +027000 COLUMN-NAMES-ROUTINE. SM2034.2 +027100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +027200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +027300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +027400 END-ROUTINE. SM2034.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2034.2 +027600 END-RTN-EXIT. SM2034.2 +027700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +027800 END-ROUTINE-1. SM2034.2 +027900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2034.2 +028000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2034.2 +028100 ADD PASS-COUNTER TO ERROR-HOLD. SM2034.2 +028200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2034.2 +028300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2034.2 +028400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2034.2 +028500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2034.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2034.2 +028700 END-ROUTINE-12. SM2034.2 +028800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2034.2 +028900 IF ERROR-COUNTER IS EQUAL TO ZERO SM2034.2 +029000 MOVE "NO " TO ERROR-TOTAL SM2034.2 +029100 ELSE SM2034.2 +029200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2034.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2034.2 +029400 PERFORM WRITE-LINE. SM2034.2 +029500 END-ROUTINE-13. SM2034.2 +029600 IF DELETE-COUNTER IS EQUAL TO ZERO SM2034.2 +029700 MOVE "NO " TO ERROR-TOTAL ELSE SM2034.2 +029800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2034.2 +029900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2034.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030100 IF INSPECT-COUNTER EQUAL TO ZERO SM2034.2 +030200 MOVE "NO " TO ERROR-TOTAL SM2034.2 +030300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2034.2 +030400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2034.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030700 WRITE-LINE. SM2034.2 +030800 ADD 1 TO RECORD-COUNT. SM2034.2 +030900Y IF RECORD-COUNT GREATER 50 SM2034.2 +031000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2034.2 +031100Y MOVE SPACE TO DUMMY-RECORD SM2034.2 +031200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2034.2 +031300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2034.2 +031400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2034.2 +031500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2034.2 +031600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2034.2 +031700Y MOVE ZERO TO RECORD-COUNT. SM2034.2 +031800 PERFORM WRT-LN. SM2034.2 +031900 WRT-LN. SM2034.2 +032000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2034.2 +032100 MOVE SPACE TO DUMMY-RECORD. SM2034.2 +032200 BLANK-LINE-PRINT. SM2034.2 +032300 PERFORM WRT-LN. SM2034.2 +032400 FAIL-ROUTINE. SM2034.2 +032500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2034.2 +032600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2034.2 +032700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2034.2 +032800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2034.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2034.2 +033100 GO TO FAIL-ROUTINE-EX. SM2034.2 +033200 FAIL-ROUTINE-WRITE. SM2034.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2034.2 +033400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2034.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2034.2 +033600 MOVE SPACES TO COR-ANSI-REFERENCE. SM2034.2 +033700 FAIL-ROUTINE-EX. EXIT. SM2034.2 +033800 BAIL-OUT. SM2034.2 +033900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2034.2 +034000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2034.2 +034100 BAIL-OUT-WRITE. SM2034.2 +034200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2034.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2034.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2034.2 +034600 BAIL-OUT-EX. EXIT. SM2034.2 +034700 CCVS1-EXIT. SM2034.2 +034800 EXIT. SM2034.2 +034900 INITIALIZATION SECTION. SM2034.2 +035000 SM203-INIT. SM2034.2 +035100 OPEN OUTPUT TEST-FILE. SM2034.2 +035200 BUILD SECTION. SM2034.2 +035300 COPY-TEST-1. SM2034.2 +035400 MOVE RCD-1 TO TF-1. SM2034.2 +035500 WRITE PROOF-REC. SM2034.2 +035600 MOVE RCD-2 TO TF-1. SM2034.2 +035700 WRITE PROOF-REC. SM2034.2 +035800 MOVE RCD-3 TO TF-1. SM2034.2 +035900 WRITE PROOF-REC. SM2034.2 +036000 MOVE RCD-4 TO TF-1. SM2034.2 +036100 WRITE PROOF-REC. SM2034.2 +036200 MOVE RCD-5 TO TF-1. SM2034.2 +036300 WRITE PROOF-REC. SM2034.2 +036400 MOVE RCD-6 TO TF-1. SM2034.2 +036500 WRITE PROOF-REC. SM2034.2 +036600 MOVE RCD-7 TO TF-1. SM2034.2 +036700 WRITE PROOF-REC. SM2034.2 +036800 PERFORM PASS. SM2034.2 +036900 GO TO COPY-WRITE-1. SM2034.2 +037000 COPY-DELETE-1. SM2034.2 +037100 PERFORM DE-LETE. SM2034.2 +037200 COPY-WRITE-1. SM2034.2 +037300 MOVE "COPY ENV DIV REPLAC" TO FEATURE. SM2034.2 +037400 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2034.2 +037500 PERFORM PRINT-DETAIL. SM2034.2 +037600 CLOSE TEST-FILE. SM2034.2 +037700 CCVS-EXIT SECTION. SM2034.2 +037800 CCVS-999999. SM2034.2 +037900 GO TO CLOSE-FILES. SM2034.2 +*END-OF,SM203A +*HEADER,COBOL,SM203A,SUBPRG,SM204A +000100 IDENTIFICATION DIVISION. SM2044.2 +000200 PROGRAM-ID. SM2044.2 +000300 SM204A. SM2044.2 +000400**************************************************************** SM2044.2 +000500* * SM2044.2 +000600* VALIDATION FOR:- * SM2044.2 +000700* * SM2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +000900* * SM2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2044.2 +001100* * SM2044.2 +001200**************************************************************** SM2044.2 +001300* * SM2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2044.2 +001500* * SM2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2044.2 +001900* * SM2044.2 +002000**************************************************************** SM2044.2 +002100* * SM2044.2 +002200* SM204A CHECKS THE FILE PRODUCED BY PROGRAM SM203A TO * SM2044.2 +002300* VERIFY THE PROPER EXECUTION OF THE "COPY"ED STATEMENTS * SM2044.2 +002400* IN THAT PROGRAM'S ENVIRONMENT DIVISION. * SM2044.2 +002500* * SM2044.2 +002600**************************************************************** SM2044.2 +002700 ENVIRONMENT DIVISION. SM2044.2 +002800 CONFIGURATION SECTION. SM2044.2 +002900 SOURCE-COMPUTER. SM2044.2 +003000 XXXXX082. SM2044.2 +003100 OBJECT-COMPUTER. SM2044.2 +003200 XXXXX083. SM2044.2 +003300 INPUT-OUTPUT SECTION. SM2044.2 +003400 FILE-CONTROL. SM2044.2 +003500 SELECT PRINT-FILE ASSIGN TO SM2044.2 +003600 XXXXX055. SM2044.2 +003700 SELECT TEST-FILE ASSIGN TO SM2044.2 +003800* THE FOLLOWING LINE WILL BE CHANGED BY TPF ONLY WHEN THE SM2044.2 +003900* PROGRAM-ID IS PART OF THE REPLACEMENT BY THE X-CARD SM2044.2 +004000* DURING EXTRACTION. SM2044.2 +004100 XXXXD002. SM2044.2 +004200 DATA DIVISION. SM2044.2 +004300 FILE SECTION. SM2044.2 +004400 FD PRINT-FILE. SM2044.2 +004500 01 PRINT-REC PICTURE X(120). SM2044.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2044.2 +004700 FD TEST-FILE SM2044.2 +004800 LABEL RECORD STANDARD SM2044.2 +004900C VALUE OF SM2044.2 +005000C XXXXX074 SM2044.2 +005100C IS SM2044.2 +005200C XXXXX077 SM2044.2 +005300G XXXXX069 SM2044.2 +005400 DATA RECORD PROOF-REC. SM2044.2 +005500 01 PROOF-REC. SM2044.2 +005600 02 TF-1 PICTURE 9(5). SM2044.2 +005700 02 FILLER PICTURE X(115). SM2044.2 +005800 WORKING-STORAGE SECTION. SM2044.2 +005900 01 TEST-RESULTS. SM2044.2 +006000 02 FILLER PIC X VALUE SPACE. SM2044.2 +006100 02 FEATURE PIC X(20) VALUE SPACE. SM2044.2 +006200 02 FILLER PIC X VALUE SPACE. SM2044.2 +006300 02 P-OR-F PIC X(5) VALUE SPACE. SM2044.2 +006400 02 FILLER PIC X VALUE SPACE. SM2044.2 +006500 02 PAR-NAME. SM2044.2 +006600 03 FILLER PIC X(19) VALUE SPACE. SM2044.2 +006700 03 PARDOT-X PIC X VALUE SPACE. SM2044.2 +006800 03 DOTVALUE PIC 99 VALUE ZERO. SM2044.2 +006900 02 FILLER PIC X(8) VALUE SPACE. SM2044.2 +007000 02 RE-MARK PIC X(61). SM2044.2 +007100 01 TEST-COMPUTED. SM2044.2 +007200 02 FILLER PIC X(30) VALUE SPACE. SM2044.2 +007300 02 FILLER PIC X(17) VALUE SM2044.2 +007400 " COMPUTED=". SM2044.2 +007500 02 COMPUTED-X. SM2044.2 +007600 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2044.2 +007700 03 COMPUTED-N REDEFINES COMPUTED-A SM2044.2 +007800 PIC -9(9).9(9). SM2044.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2044.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2044.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2044.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. SM2044.2 +008300 04 COMPUTED-18V0 PIC -9(18). SM2044.2 +008400 04 FILLER PIC X. SM2044.2 +008500 03 FILLER PIC X(50) VALUE SPACE. SM2044.2 +008600 01 TEST-CORRECT. SM2044.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SM2044.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". SM2044.2 +008900 02 CORRECT-X. SM2044.2 +009000 03 CORRECT-A PIC X(20) VALUE SPACE. SM2044.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2044.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2044.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2044.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2044.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. SM2044.2 +009600 04 CORRECT-18V0 PIC -9(18). SM2044.2 +009700 04 FILLER PIC X. SM2044.2 +009800 03 FILLER PIC X(2) VALUE SPACE. SM2044.2 +009900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2044.2 +010000 01 CCVS-C-1. SM2044.2 +010100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2044.2 +010200- "SS PARAGRAPH-NAME SM2044.2 +010300- " REMARKS". SM2044.2 +010400 02 FILLER PIC X(20) VALUE SPACE. SM2044.2 +010500 01 CCVS-C-2. SM2044.2 +010600 02 FILLER PIC X VALUE SPACE. SM2044.2 +010700 02 FILLER PIC X(6) VALUE "TESTED". SM2044.2 +010800 02 FILLER PIC X(15) VALUE SPACE. SM2044.2 +010900 02 FILLER PIC X(4) VALUE "FAIL". SM2044.2 +011000 02 FILLER PIC X(94) VALUE SPACE. SM2044.2 +011100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2044.2 +011200 01 REC-CT PIC 99 VALUE ZERO. SM2044.2 +011300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011600 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2044.2 +011800 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2044.2 +011900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2044.2 +012000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2044.2 +012100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2044.2 +012200 01 CCVS-H-1. SM2044.2 +012300 02 FILLER PIC X(39) VALUE SPACES. SM2044.2 +012400 02 FILLER PIC X(42) VALUE SM2044.2 +012500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2044.2 +012600 02 FILLER PIC X(39) VALUE SPACES. SM2044.2 +012700 01 CCVS-H-2A. SM2044.2 +012800 02 FILLER PIC X(40) VALUE SPACE. SM2044.2 +012900 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2044.2 +013000 02 FILLER PIC XXXX VALUE SM2044.2 +013100 "4.2 ". SM2044.2 +013200 02 FILLER PIC X(28) VALUE SM2044.2 +013300 " COPY - NOT FOR DISTRIBUTION". SM2044.2 +013400 02 FILLER PIC X(41) VALUE SPACE. SM2044.2 +013500 SM2044.2 +013600 01 CCVS-H-2B. SM2044.2 +013700 02 FILLER PIC X(15) VALUE SM2044.2 +013800 "TEST RESULT OF ". SM2044.2 +013900 02 TEST-ID PIC X(9). SM2044.2 +014000 02 FILLER PIC X(4) VALUE SM2044.2 +014100 " IN ". SM2044.2 +014200 02 FILLER PIC X(12) VALUE SM2044.2 +014300 " HIGH ". SM2044.2 +014400 02 FILLER PIC X(22) VALUE SM2044.2 +014500 " LEVEL VALIDATION FOR ". SM2044.2 +014600 02 FILLER PIC X(58) VALUE SM2044.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +014800 01 CCVS-H-3. SM2044.2 +014900 02 FILLER PIC X(34) VALUE SM2044.2 +015000 " FOR OFFICIAL USE ONLY ". SM2044.2 +015100 02 FILLER PIC X(58) VALUE SM2044.2 +015200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2044.2 +015300 02 FILLER PIC X(28) VALUE SM2044.2 +015400 " COPYRIGHT 1985 ". SM2044.2 +015500 01 CCVS-E-1. SM2044.2 +015600 02 FILLER PIC X(52) VALUE SPACE. SM2044.2 +015700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2044.2 +015800 02 ID-AGAIN PIC X(9). SM2044.2 +015900 02 FILLER PIC X(45) VALUE SPACES. SM2044.2 +016000 01 CCVS-E-2. SM2044.2 +016100 02 FILLER PIC X(31) VALUE SPACE. SM2044.2 +016200 02 FILLER PIC X(21) VALUE SPACE. SM2044.2 +016300 02 CCVS-E-2-2. SM2044.2 +016400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2044.2 +016500 03 FILLER PIC X VALUE SPACE. SM2044.2 +016600 03 ENDER-DESC PIC X(44) VALUE SM2044.2 +016700 "ERRORS ENCOUNTERED". SM2044.2 +016800 01 CCVS-E-3. SM2044.2 +016900 02 FILLER PIC X(22) VALUE SM2044.2 +017000 " FOR OFFICIAL USE ONLY". SM2044.2 +017100 02 FILLER PIC X(12) VALUE SPACE. SM2044.2 +017200 02 FILLER PIC X(58) VALUE SM2044.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +017400 02 FILLER PIC X(13) VALUE SPACE. SM2044.2 +017500 02 FILLER PIC X(15) VALUE SM2044.2 +017600 " COPYRIGHT 1985". SM2044.2 +017700 01 CCVS-E-4. SM2044.2 +017800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2044.2 +017900 02 FILLER PIC X(4) VALUE " OF ". SM2044.2 +018000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2044.2 +018100 02 FILLER PIC X(40) VALUE SM2044.2 +018200 " TESTS WERE EXECUTED SUCCESSFULLY". SM2044.2 +018300 01 XXINFO. SM2044.2 +018400 02 FILLER PIC X(19) VALUE SM2044.2 +018500 "*** INFORMATION ***". SM2044.2 +018600 02 INFO-TEXT. SM2044.2 +018700 04 FILLER PIC X(8) VALUE SPACE. SM2044.2 +018800 04 XXCOMPUTED PIC X(20). SM2044.2 +018900 04 FILLER PIC X(5) VALUE SPACE. SM2044.2 +019000 04 XXCORRECT PIC X(20). SM2044.2 +019100 02 INF-ANSI-REFERENCE PIC X(48). SM2044.2 +019200 01 HYPHEN-LINE. SM2044.2 +019300 02 FILLER PIC IS X VALUE IS SPACE. SM2044.2 +019400 02 FILLER PIC IS X(65) VALUE IS "************************SM2044.2 +019500- "*****************************************". SM2044.2 +019600 02 FILLER PIC IS X(54) VALUE IS "************************SM2044.2 +019700- "******************************". SM2044.2 +019800 01 CCVS-PGM-ID PIC X(9) VALUE SM2044.2 +019900 "SM204A". SM2044.2 +020000 PROCEDURE DIVISION. SM2044.2 +020100 CCVS1 SECTION. SM2044.2 +020200 OPEN-FILES. SM2044.2 +020300 OPEN OUTPUT PRINT-FILE. SM2044.2 +020400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2044.2 +020500 MOVE SPACE TO TEST-RESULTS. SM2044.2 +020600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2044.2 +020700 GO TO CCVS1-EXIT. SM2044.2 +020800 CLOSE-FILES. SM2044.2 +020900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2044.2 +021000 TERMINATE-CCVS. SM2044.2 +021100S EXIT PROGRAM. SM2044.2 +021200STERMINATE-CALL. SM2044.2 +021300 STOP RUN. SM2044.2 +021400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2044.2 +021500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2044.2 +021600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2044.2 +021700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2044.2 +021800 MOVE "****TEST DELETED****" TO RE-MARK. SM2044.2 +021900 PRINT-DETAIL. SM2044.2 +022000 IF REC-CT NOT EQUAL TO ZERO SM2044.2 +022100 MOVE "." TO PARDOT-X SM2044.2 +022200 MOVE REC-CT TO DOTVALUE. SM2044.2 +022300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2044.2 +022400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2044.2 +022500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2044.2 +022600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2044.2 +022700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2044.2 +022800 MOVE SPACE TO CORRECT-X. SM2044.2 +022900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2044.2 +023000 MOVE SPACE TO RE-MARK. SM2044.2 +023100 HEAD-ROUTINE. SM2044.2 +023200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2044.2 +023500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2044.2 +023600 COLUMN-NAMES-ROUTINE. SM2044.2 +023700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +023800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +024000 END-ROUTINE. SM2044.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2044.2 +024200 END-RTN-EXIT. SM2044.2 +024300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +024400 END-ROUTINE-1. SM2044.2 +024500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2044.2 +024600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2044.2 +024700 ADD PASS-COUNTER TO ERROR-HOLD. SM2044.2 +024800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2044.2 +024900 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2044.2 +025000 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2044.2 +025100 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2044.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2044.2 +025300 END-ROUTINE-12. SM2044.2 +025400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2044.2 +025500 IF ERROR-COUNTER IS EQUAL TO ZERO SM2044.2 +025600 MOVE "NO " TO ERROR-TOTAL SM2044.2 +025700 ELSE SM2044.2 +025800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2044.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2044.2 +026000 PERFORM WRITE-LINE. SM2044.2 +026100 END-ROUTINE-13. SM2044.2 +026200 IF DELETE-COUNTER IS EQUAL TO ZERO SM2044.2 +026300 MOVE "NO " TO ERROR-TOTAL ELSE SM2044.2 +026400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2044.2 +026500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2044.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +026700 IF INSPECT-COUNTER EQUAL TO ZERO SM2044.2 +026800 MOVE "NO " TO ERROR-TOTAL SM2044.2 +026900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2044.2 +027000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2044.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +027200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +027300 WRITE-LINE. SM2044.2 +027400 ADD 1 TO RECORD-COUNT. SM2044.2 +027500Y IF RECORD-COUNT GREATER 50 SM2044.2 +027600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2044.2 +027700Y MOVE SPACE TO DUMMY-RECORD SM2044.2 +027800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2044.2 +027900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2044.2 +028000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2044.2 +028100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2044.2 +028200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2044.2 +028300Y MOVE ZERO TO RECORD-COUNT. SM2044.2 +028400 PERFORM WRT-LN. SM2044.2 +028500 WRT-LN. SM2044.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2044.2 +028700 MOVE SPACE TO DUMMY-RECORD. SM2044.2 +028800 BLANK-LINE-PRINT. SM2044.2 +028900 PERFORM WRT-LN. SM2044.2 +029000 FAIL-ROUTINE. SM2044.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2044.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2044.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2044.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2044.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2044.2 +029700 GO TO FAIL-ROUTINE-EX. SM2044.2 +029800 FAIL-ROUTINE-WRITE. SM2044.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2044.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2044.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2044.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. SM2044.2 +030300 FAIL-ROUTINE-EX. EXIT. SM2044.2 +030400 BAIL-OUT. SM2044.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2044.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2044.2 +030700 BAIL-OUT-WRITE. SM2044.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2044.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2044.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2044.2 +031200 BAIL-OUT-EX. EXIT. SM2044.2 +031300 CCVS1-EXIT. SM2044.2 +031400 EXIT. SM2044.2 +031500 INITIALIZATION SECTION. SM2044.2 +031600 SM204-INIT. SM2044.2 +031700 OPEN INPUT TEST-FILE. SM2044.2 +031800 MOVE "ALL TESTS IN SM204A CHECK" TO RE-MARK. SM2044.2 +031900 PERFORM PRINT-DETAIL. SM2044.2 +032000 MOVE "OUTPUT OF SM203A." TO RE-MARK. SM2044.2 +032100 PERFORM PRINT-DETAIL. SM2044.2 +032200 MOVE "COPY ENV DIV REPLAC" TO FEATURE. SM2044.2 +032300 COPY-TEST-2. SM2044.2 +032400 PERFORM READ-TEST-FILE. SM2044.2 +032500 IF TF-1 EQUAL TO 97532 SM2044.2 +032600 PERFORM PASS GO TO COPY-WRITE-2. SM2044.2 +032700 GO TO COPY-FAIL-2. SM2044.2 +032800 COPY-DELETE-2. SM2044.2 +032900 PERFORM DE-LETE. SM2044.2 +033000 GO TO COPY-WRITE-2. SM2044.2 +033100 COPY-FAIL-2. SM2044.2 +033200 MOVE TF-1 TO COMPUTED-N. SM2044.2 +033300 MOVE 97532 TO CORRECT-N. SM2044.2 +033400 PERFORM FAIL. SM2044.2 +033500 COPY-WRITE-2. SM2044.2 +033600 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2044.2 +033700 PERFORM PRINT-DETAIL. SM2044.2 +033800 COPY-TEST-3. SM2044.2 +033900 PERFORM READ-TEST-FILE. SM2044.2 +034000 IF TF-1 EQUAL TO 23479 SM2044.2 +034100 PERFORM PASS GO TO COPY-WRITE-3. SM2044.2 +034200 GO TO COPY-FAIL-3. SM2044.2 +034300 COPY-DELETE-3. SM2044.2 +034400 PERFORM DE-LETE. SM2044.2 +034500 GO TO COPY-WRITE-3. SM2044.2 +034600 COPY-FAIL-3. SM2044.2 +034700 MOVE TF-1 TO COMPUTED-N. SM2044.2 +034800 MOVE 23479 TO CORRECT-N. SM2044.2 +034900 PERFORM FAIL. SM2044.2 +035000 COPY-WRITE-3. SM2044.2 +035100 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2044.2 +035200 PERFORM PRINT-DETAIL. SM2044.2 +035300 COPY-TEST-4. SM2044.2 +035400 PERFORM READ-TEST-FILE 3 TIMES. SM2044.2 +035500 IF TF-1 EQUAL TO 14003 SM2044.2 +035600 PERFORM PASS GO TO COPY-WRITE-4. SM2044.2 +035700 GO TO COPY-FAIL-4. SM2044.2 +035800 COPY-DELETE-4. SM2044.2 +035900 PERFORM DE-LETE. SM2044.2 +036000 GO TO COPY-WRITE-4. SM2044.2 +036100 COPY-FAIL-4. SM2044.2 +036200 MOVE TF-1 TO COMPUTED-N. SM2044.2 +036300 MOVE 14003 TO CORRECT-N. SM2044.2 +036400 PERFORM FAIL. SM2044.2 +036500 COPY-WRITE-4. SM2044.2 +036600 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2044.2 +036700 PERFORM PRINT-DETAIL. SM2044.2 +036800 COPY-TEST-5. SM2044.2 +036900 PERFORM READ-TEST-FILE 2 TIMES. SM2044.2 +037000 IF TF-1 EQUAL TO 03543 SM2044.2 +037100 PERFORM PASS GO TO COPY-WRITE-5. SM2044.2 +037200 GO TO COPY-FAIL-5. SM2044.2 +037300 COPY-DELETE-5. SM2044.2 +037400 PERFORM DE-LETE. SM2044.2 +037500 GO TO COPY-WRITE-5. SM2044.2 +037600 COPY-FAIL-5. SM2044.2 +037700 MOVE TF-1 TO COMPUTED-N. SM2044.2 +037800 MOVE 03543 TO CORRECT-N. SM2044.2 +037900 PERFORM FAIL. SM2044.2 +038000 COPY-WRITE-5. SM2044.2 +038100 MOVE "COPY SPECIAL-NAMES" TO FEATURE. SM2044.2 +038200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2044.2 +038300 PERFORM PRINT-DETAIL. SM2044.2 +038400 CLOSE TEST-FILE. SM2044.2 +038500 GO TO CCVS-EXIT. SM2044.2 +038600 READ-TEST-FILE. SM2044.2 +038700 READ TEST-FILE AT END GO TO BAD-FILE. SM2044.2 +038800 BAD-FILE. SM2044.2 +038900 PERFORM FAIL. SM2044.2 +039000 MOVE "BAD-FILE" TO PAR-NAME. SM2044.2 +039100 MOVE "EOF FOUND PREMATURELY" TO RE-MARK. SM2044.2 +039200 PERFORM PRINT-DETAIL. SM2044.2 +039300 CLOSE TEST-FILE. SM2044.2 +039400 GO TO CCVS-EXIT. SM2044.2 +039500 CCVS-EXIT SECTION. SM2044.2 +039600 CCVS-999999. SM2044.2 +039700 GO TO CLOSE-FILES. SM2044.2 +*END-OF,SM204A +*HEADER,COBOL,SM205A +000100 IDENTIFICATION DIVISION. SM2054.2 +000200 PROGRAM-ID. SM2054.2 +000300 SM205A. SM2054.2 +000400**************************************************************** SM2054.2 +000500* * SM2054.2 +000600* VALIDATION FOR:- * SM2054.2 +000700* * SM2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +000900* * SM2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2054.2 +001100* * SM2054.2 +001200**************************************************************** SM2054.2 +001300* * SM2054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2054.2 +001500* * SM2054.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2054.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2054.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2054.2 +001900* * SM2054.2 +002000**************************************************************** SM2054.2 +002100* * SM2054.2 +002200* PROGRAM SM205A TESTS THE USE OF THE "COPY" STATEMENT WITH * SM2054.2 +002300* ITS "REPLACING" PHRASE FOR A SORT DESCRIPTION AND RELATED * SM2054.2 +002400* ENTRIES. (THIS PROGRAM ASSUMES THAT PROGRAM ST101 * SM2054.2 +002500* PERFORMS CORRECTLY). * SM2054.2 +002600* * SM2054.2 +002700**************************************************************** SM2054.2 +002800 ENVIRONMENT DIVISION. SM2054.2 +002900 CONFIGURATION SECTION. SM2054.2 +003000 SOURCE-COMPUTER. SM2054.2 +003100 XXXXX082. SM2054.2 +003200 OBJECT-COMPUTER. SM2054.2 +003300 XXXXX083. SM2054.2 +003400 INPUT-OUTPUT SECTION. SM2054.2 +003500 FILE-CONTROL. SM2054.2 +003600 SELECT PRINT-FILE ASSIGN TO SM2054.2 +003700 XXXXX055. SM2054.2 +003800 SELECT SORTFILE-2E ASSIGN TO SM2054.2 +003900 XXXXX027. SM2054.2 +004000 SELECT SORTOUT-2E ASSIGN TO SM2054.2 +004100 XXXXX001. SM2054.2 +004200 DATA DIVISION. SM2054.2 +004300 FILE SECTION. SM2054.2 +004400 FD PRINT-FILE. SM2054.2 +004500 01 PRINT-REC PICTURE X(120). SM2054.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2054.2 +004700 SM2054.2 +004800 SM2054.2 +004900 SM2054.2 +005000 SM2054.2 +005100 SM2054.2 +005200* SM2054.2 +005300*********************** COPY STATEMENT USED **********************SM2054.2 +005400* SM2054.2 +005500*SD SORTFILE-2E COPY K5SDB SM2054.2 +005600* REPLACING J-RECORD BY S-RECORD. SM2054.2 +005700* SM2054.2 +005800******************** COPIED TEXT BEGINS BELOW ********************SM2054.2 +005900 SD SORTFILE-2E COPY K5SDB SM2054.2 +006000 REPLACING J-RECORD BY S-RECORD. SM2054.2 +006100*********************** END OF COPIED TEXT ***********************SM2054.2 +006200 SM2054.2 +006300 SM2054.2 +006400 SM2054.2 +006500 SM2054.2 +006600 SM2054.2 +006700* SM2054.2 +006800*********************** COPY STATEMENT USED **********************SM2054.2 +006900* SM2054.2 +007000*01 S-RECORD. COPY K501B SM2054.2 +007100* REPLACING KEY-A BY KEY-1 SM2054.2 +007200* XYZ-KEYS BY RDF-KEYS. SM2054.2 +007300* SM2054.2 +007400******************** COPIED TEXT BEGINS BELOW ********************SM2054.2 +007500 01 S-RECORD. COPY K501B SM2054.2 +007600 REPLACING KEY-A BY KEY-1 SM2054.2 +007700 XYZ-KEYS BY RDF-KEYS. SM2054.2 +007800*********************** END OF COPIED TEXT ***********************SM2054.2 +007900 FD SORTOUT-2E SM2054.2 +008000 BLOCK CONTAINS 10 RECORDS SM2054.2 +008100 LABEL RECORDS ARE STANDARD SM2054.2 +008200C VALUE OF SM2054.2 +008300C XXXXX074 SM2054.2 +008400C IS SM2054.2 +008500C XXXXX076 SM2054.2 +008600G XXXXX069 SM2054.2 +008700 DATA RECORD SORTED. SM2054.2 +008800 01 SORTED PICTURE X(120). SM2054.2 +008900 WORKING-STORAGE SECTION. SM2054.2 +009000 77 C0 PICTURE 9 VALUE 0. SM2054.2 +009100 77 C1 PICTURE 9 VALUE 1. SM2054.2 +009200 77 C2 PICTURE 9 VALUE 2. SM2054.2 +009300 77 C6 PICTURE 9 VALUE 6. SM2054.2 +009400 77 C3 PICTURE 9 VALUE 3. SM2054.2 +009500 01 WKEYS-GROUP. SM2054.2 +009600 02 WKEY-1 PICTURE 9. SM2054.2 +009700 02 WKEY-2 PICTURE 99. SM2054.2 +009800 02 WKEY-3 PICTURE 999. SM2054.2 +009900 02 WKEY-4 PICTURE 9999. SM2054.2 +010000 02 WKEY-5 PICTURE 9(5). SM2054.2 +010100 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). SM2054.2 +010200 01 TEST-RESULTS. SM2054.2 +010300 02 FILLER PIC X VALUE SPACE. SM2054.2 +010400 02 FEATURE PIC X(20) VALUE SPACE. SM2054.2 +010500 02 FILLER PIC X VALUE SPACE. SM2054.2 +010600 02 P-OR-F PIC X(5) VALUE SPACE. SM2054.2 +010700 02 FILLER PIC X VALUE SPACE. SM2054.2 +010800 02 PAR-NAME. SM2054.2 +010900 03 FILLER PIC X(19) VALUE SPACE. SM2054.2 +011000 03 PARDOT-X PIC X VALUE SPACE. SM2054.2 +011100 03 DOTVALUE PIC 99 VALUE ZERO. SM2054.2 +011200 02 FILLER PIC X(8) VALUE SPACE. SM2054.2 +011300 02 RE-MARK PIC X(61). SM2054.2 +011400 01 TEST-COMPUTED. SM2054.2 +011500 02 FILLER PIC X(30) VALUE SPACE. SM2054.2 +011600 02 FILLER PIC X(17) VALUE SM2054.2 +011700 " COMPUTED=". SM2054.2 +011800 02 COMPUTED-X. SM2054.2 +011900 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2054.2 +012000 03 COMPUTED-N REDEFINES COMPUTED-A SM2054.2 +012100 PIC -9(9).9(9). SM2054.2 +012200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2054.2 +012300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2054.2 +012400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2054.2 +012500 03 CM-18V0 REDEFINES COMPUTED-A. SM2054.2 +012600 04 COMPUTED-18V0 PIC -9(18). SM2054.2 +012700 04 FILLER PIC X. SM2054.2 +012800 03 FILLER PIC X(50) VALUE SPACE. SM2054.2 +012900 01 TEST-CORRECT. SM2054.2 +013000 02 FILLER PIC X(30) VALUE SPACE. SM2054.2 +013100 02 FILLER PIC X(17) VALUE " CORRECT =". SM2054.2 +013200 02 CORRECT-X. SM2054.2 +013300 03 CORRECT-A PIC X(20) VALUE SPACE. SM2054.2 +013400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2054.2 +013500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2054.2 +013600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2054.2 +013700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2054.2 +013800 03 CR-18V0 REDEFINES CORRECT-A. SM2054.2 +013900 04 CORRECT-18V0 PIC -9(18). SM2054.2 +014000 04 FILLER PIC X. SM2054.2 +014100 03 FILLER PIC X(2) VALUE SPACE. SM2054.2 +014200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2054.2 +014300 01 CCVS-C-1. SM2054.2 +014400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2054.2 +014500- "SS PARAGRAPH-NAME SM2054.2 +014600- " REMARKS". SM2054.2 +014700 02 FILLER PIC X(20) VALUE SPACE. SM2054.2 +014800 01 CCVS-C-2. SM2054.2 +014900 02 FILLER PIC X VALUE SPACE. SM2054.2 +015000 02 FILLER PIC X(6) VALUE "TESTED". SM2054.2 +015100 02 FILLER PIC X(15) VALUE SPACE. SM2054.2 +015200 02 FILLER PIC X(4) VALUE "FAIL". SM2054.2 +015300 02 FILLER PIC X(94) VALUE SPACE. SM2054.2 +015400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2054.2 +015500 01 REC-CT PIC 99 VALUE ZERO. SM2054.2 +015600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015900 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2054.2 +016000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2054.2 +016100 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2054.2 +016200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2054.2 +016300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2054.2 +016400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2054.2 +016500 01 CCVS-H-1. SM2054.2 +016600 02 FILLER PIC X(39) VALUE SPACES. SM2054.2 +016700 02 FILLER PIC X(42) VALUE SM2054.2 +016800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2054.2 +016900 02 FILLER PIC X(39) VALUE SPACES. SM2054.2 +017000 01 CCVS-H-2A. SM2054.2 +017100 02 FILLER PIC X(40) VALUE SPACE. SM2054.2 +017200 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2054.2 +017300 02 FILLER PIC XXXX VALUE SM2054.2 +017400 "4.2 ". SM2054.2 +017500 02 FILLER PIC X(28) VALUE SM2054.2 +017600 " COPY - NOT FOR DISTRIBUTION". SM2054.2 +017700 02 FILLER PIC X(41) VALUE SPACE. SM2054.2 +017800 SM2054.2 +017900 01 CCVS-H-2B. SM2054.2 +018000 02 FILLER PIC X(15) VALUE SM2054.2 +018100 "TEST RESULT OF ". SM2054.2 +018200 02 TEST-ID PIC X(9). SM2054.2 +018300 02 FILLER PIC X(4) VALUE SM2054.2 +018400 " IN ". SM2054.2 +018500 02 FILLER PIC X(12) VALUE SM2054.2 +018600 " HIGH ". SM2054.2 +018700 02 FILLER PIC X(22) VALUE SM2054.2 +018800 " LEVEL VALIDATION FOR ". SM2054.2 +018900 02 FILLER PIC X(58) VALUE SM2054.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +019100 01 CCVS-H-3. SM2054.2 +019200 02 FILLER PIC X(34) VALUE SM2054.2 +019300 " FOR OFFICIAL USE ONLY ". SM2054.2 +019400 02 FILLER PIC X(58) VALUE SM2054.2 +019500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2054.2 +019600 02 FILLER PIC X(28) VALUE SM2054.2 +019700 " COPYRIGHT 1985 ". SM2054.2 +019800 01 CCVS-E-1. SM2054.2 +019900 02 FILLER PIC X(52) VALUE SPACE. SM2054.2 +020000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2054.2 +020100 02 ID-AGAIN PIC X(9). SM2054.2 +020200 02 FILLER PIC X(45) VALUE SPACES. SM2054.2 +020300 01 CCVS-E-2. SM2054.2 +020400 02 FILLER PIC X(31) VALUE SPACE. SM2054.2 +020500 02 FILLER PIC X(21) VALUE SPACE. SM2054.2 +020600 02 CCVS-E-2-2. SM2054.2 +020700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2054.2 +020800 03 FILLER PIC X VALUE SPACE. SM2054.2 +020900 03 ENDER-DESC PIC X(44) VALUE SM2054.2 +021000 "ERRORS ENCOUNTERED". SM2054.2 +021100 01 CCVS-E-3. SM2054.2 +021200 02 FILLER PIC X(22) VALUE SM2054.2 +021300 " FOR OFFICIAL USE ONLY". SM2054.2 +021400 02 FILLER PIC X(12) VALUE SPACE. SM2054.2 +021500 02 FILLER PIC X(58) VALUE SM2054.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +021700 02 FILLER PIC X(13) VALUE SPACE. SM2054.2 +021800 02 FILLER PIC X(15) VALUE SM2054.2 +021900 " COPYRIGHT 1985". SM2054.2 +022000 01 CCVS-E-4. SM2054.2 +022100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2054.2 +022200 02 FILLER PIC X(4) VALUE " OF ". SM2054.2 +022300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2054.2 +022400 02 FILLER PIC X(40) VALUE SM2054.2 +022500 " TESTS WERE EXECUTED SUCCESSFULLY". SM2054.2 +022600 01 XXINFO. SM2054.2 +022700 02 FILLER PIC X(19) VALUE SM2054.2 +022800 "*** INFORMATION ***". SM2054.2 +022900 02 INFO-TEXT. SM2054.2 +023000 04 FILLER PIC X(8) VALUE SPACE. SM2054.2 +023100 04 XXCOMPUTED PIC X(20). SM2054.2 +023200 04 FILLER PIC X(5) VALUE SPACE. SM2054.2 +023300 04 XXCORRECT PIC X(20). SM2054.2 +023400 02 INF-ANSI-REFERENCE PIC X(48). SM2054.2 +023500 01 HYPHEN-LINE. SM2054.2 +023600 02 FILLER PIC IS X VALUE IS SPACE. SM2054.2 +023700 02 FILLER PIC IS X(65) VALUE IS "************************SM2054.2 +023800- "*****************************************". SM2054.2 +023900 02 FILLER PIC IS X(54) VALUE IS "************************SM2054.2 +024000- "******************************". SM2054.2 +024100 01 CCVS-PGM-ID PIC X(9) VALUE SM2054.2 +024200 "SM205A". SM2054.2 +024300 PROCEDURE DIVISION. SM2054.2 +024400 CCVS1 SECTION. SM2054.2 +024500 OPEN-FILES. SM2054.2 +024600 OPEN OUTPUT PRINT-FILE. SM2054.2 +024700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2054.2 +024800 MOVE SPACE TO TEST-RESULTS. SM2054.2 +024900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2054.2 +025000 GO TO CCVS1-EXIT. SM2054.2 +025100 CLOSE-FILES. SM2054.2 +025200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2054.2 +025300 TERMINATE-CCVS. SM2054.2 +025400S EXIT PROGRAM. SM2054.2 +025500STERMINATE-CALL. SM2054.2 +025600 STOP RUN. SM2054.2 +025700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2054.2 +025800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2054.2 +025900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2054.2 +026000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2054.2 +026100 MOVE "****TEST DELETED****" TO RE-MARK. SM2054.2 +026200 PRINT-DETAIL. SM2054.2 +026300 IF REC-CT NOT EQUAL TO ZERO SM2054.2 +026400 MOVE "." TO PARDOT-X SM2054.2 +026500 MOVE REC-CT TO DOTVALUE. SM2054.2 +026600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2054.2 +026700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2054.2 +026800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2054.2 +026900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2054.2 +027000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2054.2 +027100 MOVE SPACE TO CORRECT-X. SM2054.2 +027200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2054.2 +027300 MOVE SPACE TO RE-MARK. SM2054.2 +027400 HEAD-ROUTINE. SM2054.2 +027500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +027600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +027700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2054.2 +027800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2054.2 +027900 COLUMN-NAMES-ROUTINE. SM2054.2 +028000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +028100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +028300 END-ROUTINE. SM2054.2 +028400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2054.2 +028500 END-RTN-EXIT. SM2054.2 +028600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +028700 END-ROUTINE-1. SM2054.2 +028800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2054.2 +028900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2054.2 +029000 ADD PASS-COUNTER TO ERROR-HOLD. SM2054.2 +029100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2054.2 +029200 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2054.2 +029300 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2054.2 +029400 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2054.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2054.2 +029600 END-ROUTINE-12. SM2054.2 +029700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2054.2 +029800 IF ERROR-COUNTER IS EQUAL TO ZERO SM2054.2 +029900 MOVE "NO " TO ERROR-TOTAL SM2054.2 +030000 ELSE SM2054.2 +030100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2054.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2054.2 +030300 PERFORM WRITE-LINE. SM2054.2 +030400 END-ROUTINE-13. SM2054.2 +030500 IF DELETE-COUNTER IS EQUAL TO ZERO SM2054.2 +030600 MOVE "NO " TO ERROR-TOTAL ELSE SM2054.2 +030700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2054.2 +030800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2054.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031000 IF INSPECT-COUNTER EQUAL TO ZERO SM2054.2 +031100 MOVE "NO " TO ERROR-TOTAL SM2054.2 +031200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2054.2 +031300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2054.2 +031400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031600 WRITE-LINE. SM2054.2 +031700 ADD 1 TO RECORD-COUNT. SM2054.2 +031800Y IF RECORD-COUNT GREATER 50 SM2054.2 +031900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2054.2 +032000Y MOVE SPACE TO DUMMY-RECORD SM2054.2 +032100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2054.2 +032200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2054.2 +032300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2054.2 +032400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2054.2 +032500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2054.2 +032600Y MOVE ZERO TO RECORD-COUNT. SM2054.2 +032700 PERFORM WRT-LN. SM2054.2 +032800 WRT-LN. SM2054.2 +032900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2054.2 +033000 MOVE SPACE TO DUMMY-RECORD. SM2054.2 +033100 BLANK-LINE-PRINT. SM2054.2 +033200 PERFORM WRT-LN. SM2054.2 +033300 FAIL-ROUTINE. SM2054.2 +033400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2054.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2054.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2054.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2054.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. SM2054.2 +034000 GO TO FAIL-ROUTINE-EX. SM2054.2 +034100 FAIL-ROUTINE-WRITE. SM2054.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2054.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2054.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2054.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. SM2054.2 +034600 FAIL-ROUTINE-EX. EXIT. SM2054.2 +034700 BAIL-OUT. SM2054.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2054.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2054.2 +035000 BAIL-OUT-WRITE. SM2054.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2054.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2054.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. SM2054.2 +035500 BAIL-OUT-EX. EXIT. SM2054.2 +035600 CCVS1-EXIT. SM2054.2 +035700 EXIT. SM2054.2 +035800 SORT-INIT SECTION. SM2054.2 +035900 I-1. SM2054.2 +036000 SORT SORTFILE-2E SM2054.2 +036100 ON ASCENDING KEY KEY-1 SM2054.2 +036200 ON DESCENDING KEY KEY-2 SM2054.2 +036300 ON ASCENDING KEY KEY-3 SM2054.2 +036400 DESCENDING KEY-4 KEY-5 SM2054.2 +036500 INPUT PROCEDURE IS INSORT SM2054.2 +036600 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. SM2054.2 +036700 I-2. SM2054.2 +036800 GO TO CLOSE-FILES. SM2054.2 +036900 INSORT SECTION. SM2054.2 +037000 IN-1. SM2054.2 +037100* NOTE TESTS ORDINARY COPYING OF ENTRIES WHICH ARE ALSO SM2054.2 +037200* COPIED WITH REPLACEMENT. SM2054.2 +037300 IN-2. SM2054.2 +037400 MOVE 900009000000000 TO RDF-KEYS. SM2054.2 +037500 RELEASE S-RECORD. SM2054.2 +037600 MOVE 009000000900009 TO RDF-KEYS. SM2054.2 +037700 RELEASE S-RECORD. SM2054.2 +037800 MOVE 900008000000000 TO RDF-KEYS. SM2054.2 +037900 RELEASE S-RECORD. SM2054.2 +038000 MOVE 009000000900008 TO RDF-KEYS. SM2054.2 +038100 RELEASE S-RECORD. SM2054.2 +038200* NOTE HI-LOW CONTROL RECORDS DONE. SM2054.2 +038300 MOVE 300003000000000 TO WKEYS-RDF. SM2054.2 +038400 IN-3. SM2054.2 +038500 PERFORM IN-4 2 TIMES. SM2054.2 +038600 GO TO IN-EXIT. SM2054.2 +038700 IN-4. SM2054.2 +038800 SUBTRACT C1 FROM WKEY-1. SM2054.2 +038900 PERFORM IN-5 6 TIMES. SM2054.2 +039000 IN-5. SM2054.2 +039100 IF WKEY-2 IS EQUAL TO C6 SM2054.2 +039200 MOVE C0 TO WKEY-2. SM2054.2 +039300 ADD C1 TO WKEY-2. SM2054.2 +039400 PERFORM IN-6 2 TIMES. SM2054.2 +039500 IN-6. SM2054.2 +039600 IF WKEY-3 IS EQUAL TO C1 SM2054.2 +039700 MOVE C3 TO WKEY-3. SM2054.2 +039800 SUBTRACT C1 FROM WKEY-3. SM2054.2 +039900 PERFORM IN-7 2 TIMES. SM2054.2 +040000 IN-7. SM2054.2 +040100 IF WKEY-4 EQUAL TO C2 SM2054.2 +040200 MOVE C0 TO WKEY-4. SM2054.2 +040300 ADD C1 TO WKEY-4. SM2054.2 +040400 PERFORM IN-8 2 TIMES. SM2054.2 +040500 IN-8. SM2054.2 +040600 IF WKEY-5 IS EQUAL TO C2 SM2054.2 +040700 MOVE C0 TO WKEY-5. SM2054.2 +040800 ADD C1 TO WKEY-5. SM2054.2 +040900 MOVE WKEYS-RDF TO RDF-KEYS. SM2054.2 +041000 RELEASE S-RECORD. SM2054.2 +041100 IN-EXIT. SM2054.2 +041200 EXIT. SM2054.2 +041300 OUTP1 SECTION. SM2054.2 +041400 WOUTPT1. SM2054.2 +041500 OPEN OUTPUT SORTOUT-2E. SM2054.2 +041600 MOVE SPACE TO TEST-RESULTS. SM2054.2 +041700 MOVE "COPY SD REPLACING" TO FEATURE. SM2054.2 +041800 COPY-TEST-1. SM2054.2 +041900 PERFORM RET-1. SM2054.2 +042000 IF RDF-KEYS EQUAL TO 009000000900009 SM2054.2 +042100 PERFORM PASS-1 GO TO COPY-WRITE-1. SM2054.2 +042200 GO TO COPY-FAIL-1-1. SM2054.2 +042300 COPY-DELETE-1. SM2054.2 +042400 PERFORM DE-LETE-1. SM2054.2 +042500 GO TO COPY-WRITE-1. SM2054.2 +042600 COPY-FAIL-1-1. SM2054.2 +042700 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +042800 MOVE 009000000900009 TO CORRECT-18V0. SM2054.2 +042900 PERFORM FAIL-1. SM2054.2 +043000 COPY-WRITE-1. SM2054.2 +043100 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2054.2 +043200 PERFORM PRINT-DETAIL-1. SM2054.2 +043300 COPY-TEST-2. SM2054.2 +043400 PERFORM RET-1. SM2054.2 +043500 IF RDF-KEYS EQUAL TO 009000000900008 SM2054.2 +043600 PERFORM PASS-1 GO TO COPY-WRITE-2. SM2054.2 +043700 GO TO COPY-FAIL-1-2. SM2054.2 +043800 COPY-DELETE-2. SM2054.2 +043900 PERFORM DE-LETE-1. SM2054.2 +044000 GO TO COPY-WRITE-2. SM2054.2 +044100 COPY-FAIL-1-2. SM2054.2 +044200 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +044300 MOVE 009000000900008 TO CORRECT-18V0. SM2054.2 +044400 PERFORM FAIL-1. SM2054.2 +044500 COPY-WRITE-2. SM2054.2 +044600 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2054.2 +044700 PERFORM PRINT-DETAIL-1. SM2054.2 +044800 COPY-TEST-3. SM2054.2 +044900 PERFORM RET-1. SM2054.2 +045000 IF RDF-KEYS EQUAL TO 106001000200002 SM2054.2 +045100 PERFORM PASS-1 GO TO COPY-WRITE-3. SM2054.2 +045200 GO TO COPY-FAIL-1-3. SM2054.2 +045300 COPY-DELETE-3. SM2054.2 +045400 PERFORM DE-LETE-1. SM2054.2 +045500 GO TO COPY-WRITE-3. SM2054.2 +045600 COPY-FAIL-1-3. SM2054.2 +045700 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +045800 MOVE 106001000200002 TO CORRECT-18V0. SM2054.2 +045900 PERFORM FAIL-1. SM2054.2 +046000 COPY-WRITE-3. SM2054.2 +046100 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2054.2 +046200 PERFORM PRINT-DETAIL-1. SM2054.2 +046300 COPY-TEST-4. SM2054.2 +046400 PERFORM RET-2 48 TIMES. SM2054.2 +046500 IF RDF-KEYS EQUAL TO 206001000200002 SM2054.2 +046600 PERFORM PASS-1 GO TO COPY-WRITE-4. SM2054.2 +046700 GO TO COPY-FAIL-1-4. SM2054.2 +046800 COPY-DELETE-4. SM2054.2 +046900 PERFORM DE-LETE-1. SM2054.2 +047000 GO TO COPY-WRITE-4. SM2054.2 +047100 COPY-FAIL-1-4. SM2054.2 +047200 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +047300 MOVE 206001000200002 TO CORRECT-18V0. SM2054.2 +047400 PERFORM FAIL-1. SM2054.2 +047500 COPY-WRITE-4. SM2054.2 +047600* NOTE COPYING OF A PROCEDURE WHICH REFERENCES COPIED DATA.SM2054.2 +047700 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2054.2 +047800 PERFORM PRINT-DETAIL-1. SM2054.2 +047900 COPY-TEST-5. SM2054.2 +048000 PERFORM RET-2 40 TIMES. SM2054.2 +048100 IF RDF-KEYS EQUAL TO 201001000200002 SM2054.2 +048200 PERFORM PASS-1 GO TO COPY-WRITE-5. SM2054.2 +048300 GO TO COPY-FAIL-1-5. SM2054.2 +048400 COPY-DELETE-5. SM2054.2 +048500 PERFORM DE-LETE-1. SM2054.2 +048600 GO TO COPY-WRITE-5. SM2054.2 +048700 COPY-FAIL-1-5. SM2054.2 +048800 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +048900 MOVE 201001000200002 TO CORRECT-18V0. SM2054.2 +049000 PERFORM FAIL-1. SM2054.2 +049100 COPY-WRITE-5. SM2054.2 +049200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2054.2 +049300 PERFORM PRINT-DETAIL-1. SM2054.2 +049400 COPY-TEST-6. SM2054.2 +049500 PERFORM RET-2 7 TIMES. SM2054.2 +049600 IF RDF-KEYS EQUAL TO 201002000100001 SM2054.2 +049700 PERFORM PASS-1 GO TO COPY-WRITE-6. SM2054.2 +049800 GO TO COPY-FAIL-1-6. SM2054.2 +049900 COPY-DELETE-6. SM2054.2 +050000 PERFORM DE-LETE-1. SM2054.2 +050100 GO TO COPY-WRITE-6. SM2054.2 +050200 COPY-FAIL-1-6. SM2054.2 +050300 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +050400 MOVE 201002000100001 TO CORRECT-18V0. SM2054.2 +050500 PERFORM FAIL-1. SM2054.2 +050600 COPY-WRITE-6. SM2054.2 +050700 MOVE "COPY-TEST-6 " TO PAR-NAME. SM2054.2 +050800 PERFORM PRINT-DETAIL-1. SM2054.2 +050900 COPY-TEST-7. SM2054.2 +051000 PERFORM RET-2. SM2054.2 +051100 IF RDF-KEYS EQUAL TO 900008000000000 SM2054.2 +051200 PERFORM PASS-1 GO TO COPY-WRITE-7. SM2054.2 +051300 GO TO COPY-FAIL-1-7. SM2054.2 +051400 COPY-DELETE-7. SM2054.2 +051500 PERFORM DE-LETE-1. SM2054.2 +051600 GO TO COPY-WRITE-7. SM2054.2 +051700 COPY-FAIL-1-7. SM2054.2 +051800 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +051900 MOVE 900008000000000 TO CORRECT-18V0. SM2054.2 +052000 PERFORM FAIL-1. SM2054.2 +052100 COPY-WRITE-7. SM2054.2 +052200 MOVE "COPY-TEST-7 " TO PAR-NAME. SM2054.2 +052300 PERFORM PRINT-DETAIL-1. SM2054.2 +052400 COPY-TEST-8. SM2054.2 +052500 PERFORM RET-2. SM2054.2 +052600 IF RDF-KEYS EQUAL TO 900009000000000 SM2054.2 +052700 PERFORM PASS-1 GO TO COPY-WRITE-8. SM2054.2 +052800 GO TO COPY-FAIL-1-8. SM2054.2 +052900 COPY-DELETE-8. SM2054.2 +053000 PERFORM DE-LETE-1. SM2054.2 +053100 GO TO COPY-WRITE-8. SM2054.2 +053200 COPY-FAIL-1-8. SM2054.2 +053300 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +053400 MOVE 900009000000000 TO CORRECT-18V0. SM2054.2 +053500 PERFORM FAIL-1. SM2054.2 +053600 COPY-WRITE-8. SM2054.2 +053700 MOVE "COPY-TEST-8 " TO PAR-NAME. SM2054.2 +053800 PERFORM PRINT-DETAIL-1. SM2054.2 +053900 OUTP2 SECTION. SM2054.2 +054000 COPY-TEST-9. SM2054.2 +054100 RETURN SORTFILE-2E END SM2054.2 +054200 PERFORM PASS-1 GO TO COPY-WRITE-9. SM2054.2 +054300* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. SM2054.2 +054400 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +054500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SM2054.2 +054600 COPY-DELETE-9. SM2054.2 +054700 PERFORM DE-LETE-1. SM2054.2 +054800 COPY-WRITE-9. SM2054.2 +054900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM2054.2 +055000 PERFORM PRINT-DETAIL-1. SM2054.2 +055100 CLOSE SORTOUT-2E. SM2054.2 +055200 GO TO LIB2E-EXIT. SM2054.2 +055300 OUTP3 SECTION. SM2054.2 +055400 RET-1. SM2054.2 +055500 RETURN SORTFILE-2E RECORD AT END GO TO BAD-FILE. SM2054.2 +055600 MOVE S-RECORD TO SORTED. SM2054.2 +055700 WRITE SORTED. SM2054.2 +055800 RET-2. SM2054.2 +055900 RETURN SORTFILE-2E END GO TO BAD-FILE. SM2054.2 +056000 MOVE S-RECORD TO SORTED. SM2054.2 +056100 WRITE SORTED. SM2054.2 +056200 BAD-FILE. SM2054.2 +056300 PERFORM FAIL-1. SM2054.2 +056400 MOVE "BAD-FILE" TO PAR-NAME. SM2054.2 +056500 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM2054.2 +056600 PERFORM PRINT-DETAIL-1. SM2054.2 +056700 CLOSE SORTOUT-2E. SM2054.2 +056800 GO TO LIB2E-EXIT. SM2054.2 +056900 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2054.2 +057000 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2054.2 +057100 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2054.2 +057200 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2054.2 +057300 MOVE "****TEST DELETED****" TO RE-MARK. SM2054.2 +057400 PRINT-DETAIL-1. SM2054.2 +057500 IF REC-CT NOT EQUAL TO ZERO SM2054.2 +057600 MOVE "." TO PARDOT-X SM2054.2 +057700 MOVE REC-CT TO DOTVALUE. SM2054.2 +057800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SM2054.2 +057900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SM2054.2 +058000 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SM2054.2 +058100 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SM2054.2 +058200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2054.2 +058300 MOVE SPACE TO CORRECT-X. SM2054.2 +058400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2054.2 +058500 MOVE SPACE TO RE-MARK. SM2054.2 +058600 WRITE-LINE-1. SM2054.2 +058700 ADD 1 TO RECORD-COUNT. SM2054.2 +058800Y IF RECORD-COUNT GREATER 50 SM2054.2 +058900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2054.2 +059000Y MOVE SPACE TO DUMMY-RECORD SM2054.2 +059100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2054.2 +059200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SM2054.2 +059300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SM2054.2 +059400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SM2054.2 +059500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2054.2 +059600Y MOVE ZERO TO RECORD-COUNT. SM2054.2 +059700 PERFORM WRT-LN-1. SM2054.2 +059800 WRT-LN-1. SM2054.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2054.2 +060000 MOVE SPACE TO DUMMY-RECORD. SM2054.2 +060100 BLANK-LINE-PRINT-1. SM2054.2 +060200 PERFORM WRT-LN-1. SM2054.2 +060300 FAIL-ROUTINE-1. SM2054.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM2054.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM2054.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2054.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +060800 GO TO FAIL-ROUTINE-EX-1. SM2054.2 +060900 FAIL-RTN-WRITE-1. SM2054.2 +061000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SM2054.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +061200 FAIL-ROUTINE-EX-1. EXIT. SM2054.2 +061300 BAIL-OUT-1. SM2054.2 +061400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SM2054.2 +061500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SM2054.2 +061600 BAIL-OUT-WRITE-1. SM2054.2 +061700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2054.2 +061800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +061900 BAIL-OUT-EX-1. EXIT. SM2054.2 +062000 LIB2E-EXIT. SM2054.2 +062100 EXIT. SM2054.2 +*END-OF,SM205A +*HEADER,COBOL,SM206A +000100 IDENTIFICATION DIVISION. SM2064.2 +000200 PROGRAM-ID. SM2064.2 +000300 SM206A. SM2064.2 +000400**************************************************************** SM2064.2 +000500* * SM2064.2 +000600* VALIDATION FOR:- * SM2064.2 +000700* * SM2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +000900* * SM2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2064.2 +001100* * SM2064.2 +001200**************************************************************** SM2064.2 +001300* * SM2064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2064.2 +001500* * SM2064.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2064.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2064.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2064.2 +001900* * SM2064.2 +002000**************************************************************** SM2064.2 +002100* * SM2064.2 +002200* PROGRAM NC206A TESTS THE "REPLACING" PHRASE OF THE "COPY" * SM2064.2 +002300* STATEMENT USING A VARIETY OF PSEUDO-TEXT OPERANDS. * SM2064.2 +002400* MAXIMUM AND MINIMUM LENGTH TEXT WORDS ARE ALSO TESTED. * SM2064.2 +002500* * SM2064.2 +002600**************************************************************** SM2064.2 +002700 ENVIRONMENT DIVISION. SM2064.2 +002800 CONFIGURATION SECTION. SM2064.2 +002900 SOURCE-COMPUTER. SM2064.2 +003000 XXXXX082. SM2064.2 +003100 OBJECT-COMPUTER. SM2064.2 +003200 XXXXX083. SM2064.2 +003300 INPUT-OUTPUT SECTION. SM2064.2 +003400 FILE-CONTROL. SM2064.2 +003500 SELECT PRINT-FILE ASSIGN TO SM2064.2 +003600 XXXXX055. SM2064.2 +003700 DATA DIVISION. SM2064.2 +003800 FILE SECTION. SM2064.2 +003900 FD PRINT-FILE. SM2064.2 +004000 01 PRINT-REC PICTURE X(120). SM2064.2 +004100 01 DUMMY-RECORD PICTURE X(120). SM2064.2 +004200 WORKING-STORAGE SECTION. SM2064.2 +004300 01 GRP-001. SM2064.2 +004400 02 GRP-002. SM2064.2 +004500 04 GRP-004. SM2064.2 +004600 06 GRP-006. SM2064.2 +004700 08 WRK-XN-00005-001 PIC X(5) VALUE "FIRST". SM2064.2 +004800 08 WRK-XN-00050-O005F-001 OCCURS 5 TIMES. SM2064.2 +004900 10 WRK-XN-00005-O005-001 PIC X(5). SM2064.2 +005000 10 WRK-DS-05V00-O005-001 PIC S9(5). SM2064.2 +005100 02 GRP-003. SM2064.2 +005200 04 GRP-004. SM2064.2 +005300 06 GRP-006. SM2064.2 +005400 08 WRK-XN-00005-001 PIC X(5) VALUE "SECON". SM2064.2 +005500 08 WRK-XN-00050-O005F-001 OCCURS 5 TIMES. SM2064.2 +005600 10 WRK-XN-00005-O005-001 PIC X(5). SM2064.2 +005700 10 WRK-DS-05V00-O005-001 PIC S9(5). SM2064.2 +005800 01 GRP-007. SM2064.2 +005900 08 WRK-XN-00005-001 PIC X(5) VALUE "THIRD". SM2064.2 +006000 01 WRK-DS-09V00-901 PIC S9(9) VALUE ZERO. SM2064.2 +006100 01 WRK-DS-09V00-902 PIC S9(9) VALUE ZERO. SM2064.2 +006200 01 WRK-XN-00001 PIC X. SM2064.2 +006300 01 WRK-XN-00322 PIC X(322). SM2064.2 +006400 01 FILLER REDEFINES WRK-XN-00322. SM2064.2 +006500 03 WRK-XN-00322-1 PIC X. SM2064.2 +006600 03 WRK-XN-00322-2-322. SM2064.2 +006700 05 WRK-XN-00322-2-3 PIC X. SM2064.2 +006800 05 WRK-XN-00322-20 PIC X(20) SM2064.2 +006900 OCCURS 16 SM2064.2 +007000 INDEXED BY X1. SM2064.2 +007100 01 WRK-DU-9 PIC 9 VALUE ZERO. SM2064.2 +007200 01 WRK-DU-99 PIC 99 VALUE ZERO. SM2064.2 +007300 01 WRK-DU-99-LONGER PIC 99 VALUE ZERO. SM2064.2 +007400 01 TEST-RESULTS. SM2064.2 +007500 02 FILLER PIC X VALUE SPACE. SM2064.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. SM2064.2 +007700 02 FILLER PIC X VALUE SPACE. SM2064.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. SM2064.2 +007900 02 FILLER PIC X VALUE SPACE. SM2064.2 +008000 02 PAR-NAME. SM2064.2 +008100 03 FILLER PIC X(19) VALUE SPACE. SM2064.2 +008200 03 PARDOT-X PIC X VALUE SPACE. SM2064.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. SM2064.2 +008400 02 FILLER PIC X(8) VALUE SPACE. SM2064.2 +008500 02 RE-MARK PIC X(61). SM2064.2 +008600 01 TEST-COMPUTED. SM2064.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SM2064.2 +008800 02 FILLER PIC X(17) VALUE SM2064.2 +008900 " COMPUTED=". SM2064.2 +009000 02 COMPUTED-X. SM2064.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2064.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A SM2064.2 +009300 PIC -9(9).9(9). SM2064.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2064.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2064.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2064.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. SM2064.2 +009800 04 COMPUTED-18V0 PIC -9(18). SM2064.2 +009900 04 FILLER PIC X. SM2064.2 +010000 03 FILLER PIC X(50) VALUE SPACE. SM2064.2 +010100 01 TEST-CORRECT. SM2064.2 +010200 02 FILLER PIC X(30) VALUE SPACE. SM2064.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". SM2064.2 +010400 02 CORRECT-X. SM2064.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. SM2064.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2064.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2064.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2064.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2064.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. SM2064.2 +011100 04 CORRECT-18V0 PIC -9(18). SM2064.2 +011200 04 FILLER PIC X. SM2064.2 +011300 03 FILLER PIC X(2) VALUE SPACE. SM2064.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2064.2 +011500 01 CCVS-C-1. SM2064.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2064.2 +011700- "SS PARAGRAPH-NAME SM2064.2 +011800- " REMARKS". SM2064.2 +011900 02 FILLER PIC X(20) VALUE SPACE. SM2064.2 +012000 01 CCVS-C-2. SM2064.2 +012100 02 FILLER PIC X VALUE SPACE. SM2064.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". SM2064.2 +012300 02 FILLER PIC X(15) VALUE SPACE. SM2064.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". SM2064.2 +012500 02 FILLER PIC X(94) VALUE SPACE. SM2064.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2064.2 +012700 01 REC-CT PIC 99 VALUE ZERO. SM2064.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2064.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2064.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2064.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2064.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2064.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2064.2 +013700 01 CCVS-H-1. SM2064.2 +013800 02 FILLER PIC X(39) VALUE SPACES. SM2064.2 +013900 02 FILLER PIC X(42) VALUE SM2064.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2064.2 +014100 02 FILLER PIC X(39) VALUE SPACES. SM2064.2 +014200 01 CCVS-H-2A. SM2064.2 +014300 02 FILLER PIC X(40) VALUE SPACE. SM2064.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2064.2 +014500 02 FILLER PIC XXXX VALUE SM2064.2 +014600 "4.2 ". SM2064.2 +014700 02 FILLER PIC X(28) VALUE SM2064.2 +014800 " COPY - NOT FOR DISTRIBUTION". SM2064.2 +014900 02 FILLER PIC X(41) VALUE SPACE. SM2064.2 +015000 SM2064.2 +015100 01 CCVS-H-2B. SM2064.2 +015200 02 FILLER PIC X(15) VALUE SM2064.2 +015300 "TEST RESULT OF ". SM2064.2 +015400 02 TEST-ID PIC X(9). SM2064.2 +015500 02 FILLER PIC X(4) VALUE SM2064.2 +015600 " IN ". SM2064.2 +015700 02 FILLER PIC X(12) VALUE SM2064.2 +015800 " HIGH ". SM2064.2 +015900 02 FILLER PIC X(22) VALUE SM2064.2 +016000 " LEVEL VALIDATION FOR ". SM2064.2 +016100 02 FILLER PIC X(58) VALUE SM2064.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +016300 01 CCVS-H-3. SM2064.2 +016400 02 FILLER PIC X(34) VALUE SM2064.2 +016500 " FOR OFFICIAL USE ONLY ". SM2064.2 +016600 02 FILLER PIC X(58) VALUE SM2064.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2064.2 +016800 02 FILLER PIC X(28) VALUE SM2064.2 +016900 " COPYRIGHT 1985 ". SM2064.2 +017000 01 CCVS-E-1. SM2064.2 +017100 02 FILLER PIC X(52) VALUE SPACE. SM2064.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2064.2 +017300 02 ID-AGAIN PIC X(9). SM2064.2 +017400 02 FILLER PIC X(45) VALUE SPACES. SM2064.2 +017500 01 CCVS-E-2. SM2064.2 +017600 02 FILLER PIC X(31) VALUE SPACE. SM2064.2 +017700 02 FILLER PIC X(21) VALUE SPACE. SM2064.2 +017800 02 CCVS-E-2-2. SM2064.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2064.2 +018000 03 FILLER PIC X VALUE SPACE. SM2064.2 +018100 03 ENDER-DESC PIC X(44) VALUE SM2064.2 +018200 "ERRORS ENCOUNTERED". SM2064.2 +018300 01 CCVS-E-3. SM2064.2 +018400 02 FILLER PIC X(22) VALUE SM2064.2 +018500 " FOR OFFICIAL USE ONLY". SM2064.2 +018600 02 FILLER PIC X(12) VALUE SPACE. SM2064.2 +018700 02 FILLER PIC X(58) VALUE SM2064.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +018900 02 FILLER PIC X(13) VALUE SPACE. SM2064.2 +019000 02 FILLER PIC X(15) VALUE SM2064.2 +019100 " COPYRIGHT 1985". SM2064.2 +019200 01 CCVS-E-4. SM2064.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2064.2 +019400 02 FILLER PIC X(4) VALUE " OF ". SM2064.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2064.2 +019600 02 FILLER PIC X(40) VALUE SM2064.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". SM2064.2 +019800 01 XXINFO. SM2064.2 +019900 02 FILLER PIC X(19) VALUE SM2064.2 +020000 "*** INFORMATION ***". SM2064.2 +020100 02 INFO-TEXT. SM2064.2 +020200 04 FILLER PIC X(8) VALUE SPACE. SM2064.2 +020300 04 XXCOMPUTED PIC X(20). SM2064.2 +020400 04 FILLER PIC X(5) VALUE SPACE. SM2064.2 +020500 04 XXCORRECT PIC X(20). SM2064.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). SM2064.2 +020700 01 HYPHEN-LINE. SM2064.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. SM2064.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************SM2064.2 +021000- "*****************************************". SM2064.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************SM2064.2 +021200- "******************************". SM2064.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE SM2064.2 +021400 "SM206A". SM2064.2 +021500 PROCEDURE DIVISION. SM2064.2 +021600 CCVS1 SECTION. SM2064.2 +021700 OPEN-FILES. SM2064.2 +021800 OPEN OUTPUT PRINT-FILE. SM2064.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2064.2 +022000 MOVE SPACE TO TEST-RESULTS. SM2064.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2064.2 +022200 GO TO CCVS1-EXIT. SM2064.2 +022300 CLOSE-FILES. SM2064.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2064.2 +022500 TERMINATE-CCVS. SM2064.2 +022600S EXIT PROGRAM. SM2064.2 +022700STERMINATE-CALL. SM2064.2 +022800 STOP RUN. SM2064.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2064.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2064.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2064.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2064.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. SM2064.2 +023400 PRINT-DETAIL. SM2064.2 +023500 IF REC-CT NOT EQUAL TO ZERO SM2064.2 +023600 MOVE "." TO PARDOT-X SM2064.2 +023700 MOVE REC-CT TO DOTVALUE. SM2064.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2064.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2064.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2064.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2064.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2064.2 +024300 MOVE SPACE TO CORRECT-X. SM2064.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2064.2 +024500 MOVE SPACE TO RE-MARK. SM2064.2 +024600 HEAD-ROUTINE. SM2064.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2064.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2064.2 +025100 COLUMN-NAMES-ROUTINE. SM2064.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +025500 END-ROUTINE. SM2064.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2064.2 +025700 END-RTN-EXIT. SM2064.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +025900 END-ROUTINE-1. SM2064.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2064.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2064.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. SM2064.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2064.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2064.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2064.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2064.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2064.2 +026800 END-ROUTINE-12. SM2064.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2064.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO SM2064.2 +027100 MOVE "NO " TO ERROR-TOTAL SM2064.2 +027200 ELSE SM2064.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2064.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2064.2 +027500 PERFORM WRITE-LINE. SM2064.2 +027600 END-ROUTINE-13. SM2064.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO SM2064.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE SM2064.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2064.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2064.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO SM2064.2 +028300 MOVE "NO " TO ERROR-TOTAL SM2064.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2064.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2064.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028800 WRITE-LINE. SM2064.2 +028900 ADD 1 TO RECORD-COUNT. SM2064.2 +029000Y IF RECORD-COUNT GREATER 50 SM2064.2 +029100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2064.2 +029200Y MOVE SPACE TO DUMMY-RECORD SM2064.2 +029300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2064.2 +029400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2064.2 +029500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2064.2 +029600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2064.2 +029700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2064.2 +029800Y MOVE ZERO TO RECORD-COUNT. SM2064.2 +029900 PERFORM WRT-LN. SM2064.2 +030000 WRT-LN. SM2064.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2064.2 +030200 MOVE SPACE TO DUMMY-RECORD. SM2064.2 +030300 BLANK-LINE-PRINT. SM2064.2 +030400 PERFORM WRT-LN. SM2064.2 +030500 FAIL-ROUTINE. SM2064.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2064.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2064.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2064.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2064.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2064.2 +031200 GO TO FAIL-ROUTINE-EX. SM2064.2 +031300 FAIL-ROUTINE-WRITE. SM2064.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2064.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2064.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2064.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. SM2064.2 +031800 FAIL-ROUTINE-EX. EXIT. SM2064.2 +031900 BAIL-OUT. SM2064.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2064.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2064.2 +032200 BAIL-OUT-WRITE. SM2064.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2064.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2064.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2064.2 +032700 BAIL-OUT-EX. EXIT. SM2064.2 +032800 CCVS1-EXIT. SM2064.2 +032900 EXIT. SM2064.2 +033000 SECT-SM206-0001 SECTION. SM2064.2 +033100* SM2064.2 +033200*********************** COPY STATEMENT USED **********************SM2064.2 +033300* SM2064.2 +033400* COPY KP001SM2064.2 +033500* REPLACING ==PERFORM FAIL. == BY ====. SM2064.2 +033600* SM2064.2 +033700******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +033800 COPY KP001SM2064.2 +033900 REPLACING ==PERFORM FAIL. == BY ====. SM2064.2 +034000*********************** END OF COPIED TEXT ***********************SM2064.2 +034100 SECT-SM206-0002 SECTION. SM2064.2 +034200 PST-INIT-002. SM2064.2 +034300 MOVE +00005 TO WRK-DS-05V00-O005-001 OF GRP-002 (1). SM2064.2 +034400 MOVE +000000005 TO WRK-DS-09V00-901. SM2064.2 +034500 PST-TEST-002. SM2064.2 +034600* THIS TEST EXERCISES THE REPLACING PHRASE BY REPLACING SM2064.2 +034700* PSEUDO-TEXT BY AN IDENTIFIER. SM2064.2 +034800 MOVE "PSEUDO-TEXT/IDENTIFR" TO FEATURE. SM2064.2 +034900* SM2064.2 +035000*********************** COPY STATEMENT USED **********************SM2064.2 +035100* SM2064.2 +035200* COPY KP002SM2064.2 +035300* REPLACING == WRK-DS-09V00-901 SM2064.2 +035400* SUBTRACT 1 FROM SM2064.2 +035500* WRK-DS-05V00-O005-001 IN GRP-002 (1)== SM2064.2 +035600* BY WRK-DS-05V00-O005-001 IN WRK-XN-00050-0005 SM2064.2 +035700*-(COL 7) F-001 IN GRP-006 IN GRP-004 IN GRP-002 IN GRP-0SM2064.2 +035800*-(COL 7) 01 (1). SM2064.2 +035900* SM2064.2 +036000******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +036100 COPY KP002SM2064.2 +036200 REPLACING == WRK-DS-09V00-901 SM2064.2 +036300 SUBTRACT 1 FROM SM2064.2 +036400 WRK-DS-05V00-O005-001 IN GRP-002 (1)== SM2064.2 +036500 BY WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005SM2064.2 +036600- F-001 IN GRP-006 IN GRP-004 IN GRP-002 IN GRP-0SM2064.2 +036700- 01 (1). SM2064.2 +036800*********************** END OF COPIED TEXT ***********************SM2064.2 +036900 MOVE "PST-TEST-002" TO PAR-NAME. SM2064.2 +037000 MOVE 01 TO REC-CT. SM2064.2 +037100 IF WRK-DS-05V00-O005-001 OF GRP-002 (1) EQUAL TO +6 SM2064.2 +037200 PERFORM PASS SM2064.2 +037300 ELSE SM2064.2 +037400 MOVE +6 TO CORRECT-18V0 SM2064.2 +037500 MOVE WRK-DS-05V00-O005-001 OF GRP-002 (1) TO SM2064.2 +037600 COMPUTED-18V0 SM2064.2 +037700 PERFORM FAIL. SM2064.2 +037800 PERFORM PRINT-DETAIL. SM2064.2 +037900* THIS IDENTIFIER SHOULD HAVE BEEN INCREMENTED BY ONE AS A SM2064.2 +038000* RESULT OF THE REPLACING PHRASE SPECIFIED IN THE COPY SM2064.2 +038100* STATEMENT. SM2064.2 +038200 ADD +01 TO REC-CT. SM2064.2 +038300 IF WRK-DS-09V00-901 NOT EQUAL TO +5 SM2064.2 +038400 MOVE +5 TO CORRECT-18V0 SM2064.2 +038500 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0 SM2064.2 +038600 PERFORM FAIL SM2064.2 +038700 ELSE SM2064.2 +038800 PERFORM PASS. SM2064.2 +038900* THIS IDENTIFIER SHOULD NOT HAVE BEEN ALTERED AS A RESULT OF SM2064.2 +039000* THE REPLACING PHRASE OF THE COPY STATEMENT. SM2064.2 +039100 PERFORM PRINT-DETAIL. SM2064.2 +039200 ADD +01 TO REC-CT. SM2064.2 +039300 IF WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005F-001 IN SM2064.2 +039400 GRP-006 IN GRP-004 IN GRP-003 (2) EQUAL TO +9 SM2064.2 +039500 PERFORM PASS SM2064.2 +039600 ELSE SM2064.2 +039700 MOVE WRK-DS-05V00-O005-001 IN SM2064.2 +039800 WRK-XN-00050-O005F-001 IN SM2064.2 +039900 GRP-006 IN SM2064.2 +040000 GRP-004 IN SM2064.2 +040100 GRP-003 (2) TO COMPUTED-18V0 SM2064.2 +040200 MOVE +9 TO CORRECT-18V0 SM2064.2 +040300 PERFORM FAIL. SM2064.2 +040400* THE REPLACING PHRASE SHOULD NOT HAVE AFFECTED THE ACTION TO SM2064.2 +040500* BE TAKEN ON THIS IDENTIFIER IN THE TEXT BEING COPIED. SM2064.2 +040600* SM2064.2 +040700* SM2064.2 +040800 PERFORM PRINT-DETAIL. SM2064.2 +040900*THIS IS THE BEGINNING OF PST-TEST-003. SM2064.2 +041000* SM2064.2 +041100 PST-INIT-003. SM2064.2 +041200 MOVE "PSEUDO-TEXT/LITERAL" TO FEATURE. SM2064.2 +041300 MOVE "PST-TEST-003" TO PAR-NAME. SM2064.2 +041400 MOVE +00005 TO WRK-DS-05V00-O005-001 OF GRP-002 (3). SM2064.2 +041500 MOVE +000000005 TO WRK-DS-09V00-901. SM2064.2 +041600 MOVE ZERO TO WRK-DS-05V00-O005-001 IN GRP-003 (3). SM2064.2 +041700* SM2064.2 +041800*********************** COPY STATEMENT USED **********************SM2064.2 +041900* SM2064.2 +042000* COPY KP003SM2064.2 +042100* REPLACING ==+00001== BY +2 SM2064.2 +042200* == 1 == BY -3. SM2064.2 +042300* SM2064.2 +042400******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +042500 COPY KP003SM2064.2 +042600 REPLACING ==+00001== BY +2 SM2064.2 +042700 == 1 == BY -3 . SM2064.2 +042800*********************** END OF COPIED TEXT ***********************SM2064.2 +042900 PST-TEST-003-1. SM2064.2 +043000 MOVE 01 TO REC-CT. SM2064.2 +043100 IF WRK-DS-05V00-O005-001 IN GRP-003 (3) EQUAL TO +00009 SM2064.2 +043200 PERFORM PASS SM2064.2 +043300 ELSE SM2064.2 +043400 MOVE +009 TO CORRECT-18V0 SM2064.2 +043500 MOVE WRK-DS-05V00-O005-001 IN SM2064.2 +043600 GRP-003 (3) TO COMPUTED-18V0 SM2064.2 +043700 PERFORM FAIL. SM2064.2 +043800 PERFORM PRINT-DETAIL. SM2064.2 +043900 ADD +01 TO REC-CT. SM2064.2 +044000 IF WRK-DS-09V00-901 EQUAL TO +000000007 SM2064.2 +044100 PERFORM PASS SM2064.2 +044200 ELSE SM2064.2 +044300 PERFORM FAIL SM2064.2 +044400 MOVE +7 TO CORRECT-18V0 SM2064.2 +044500 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +044600 PERFORM PRINT-DETAIL. SM2064.2 +044700 ADD +01 TO REC-CT. SM2064.2 +044800 IF WRK-DS-05V00-O005-001 OF GRP-002 (3) EQUAL TO +8 SM2064.2 +044900 PERFORM PASS SM2064.2 +045000 ELSE SM2064.2 +045100 MOVE +8 TO CORRECT-18V0 SM2064.2 +045200 PERFORM FAIL SM2064.2 +045300 MOVE WRK-DS-05V00-O005-001 IN GRP-002 (3) TO SM2064.2 +045400 COMPUTED-18V0. SM2064.2 +045500 PERFORM PRINT-DETAIL. SM2064.2 +045600 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +045700*THE NEXT BIT OF CODING REPRESENTS WHAT WE FEEL IS PST-TEST-004, SM2064.2 +045800* WHAT YOU SEE IS WHAT THIS COMPILER FEELS IS SM2064.2 +045900* PST-TEST-004. SM2064.2 +046000* SM2064.2 +046100*********************** COPY STATEMENT USED **********************SM2064.2 +046200* SM2064.2 +046300* COPY KP004SM2064.2 +046400* REPLACING ==THIS IS NOT REAL COBOL-74 SYNTAX HOWESM2064.2 +046500*-(COL 7) VER SHOVE== SM2064.2 +046600* BY MOVE SM2064.2 +046700* == DELETE== SM2064.2 +046800* BY DE-LETE. SM2064.2 +046900* SM2064.2 +047000******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +047100 COPY KP004 SM2064.2 +047200 REPLACING ==THIS IS NOT REAL COBOL-74 SYNTAX HOWESM2064.2 +047300- VER SHOVE== SM2064.2 +047400 BY MOVE SM2064.2 +047500 == DELETE== SM2064.2 +047600 BY DE-LETE. SM2064.2 +047700*********************** END OF COPIED TEXT ***********************SM2064.2 +047800 PST-WRITE-004. SM2064.2 +047900 MOVE "PST-TEST-004" TO PAR-NAME. SM2064.2 +048000 MOVE 01 TO REC-CT. SM2064.2 +048100 IF WRK-DS-09V00-901 EQUAL TO 5 SM2064.2 +048200 PERFORM PASS SM2064.2 +048300 ELSE SM2064.2 +048400 PERFORM FAIL SM2064.2 +048500 MOVE 5 TO CORRECT-18V0 SM2064.2 +048600 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +048700 PERFORM PRINT-DETAIL. SM2064.2 +048800 ADD 1 TO REC-CT. SM2064.2 +048900 IF WRK-DS-09V00-902 EQUAL TO 2 SM2064.2 +049000 PERFORM PASS SM2064.2 +049100 ELSE SM2064.2 +049200 MOVE 2 TO CORRECT-18V0 SM2064.2 +049300 MOVE WRK-DS-09V00-902 TO COMPUTED-18V0 SM2064.2 +049400 PERFORM FAIL. SM2064.2 +049500 PERFORM PRINT-DETAIL. SM2064.2 +049600 PST-TEST-005. SM2064.2 +049700 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +049800* SM2064.2 +049900*********************** COPY STATEMENT USED **********************SM2064.2 +050000* SM2064.2 +050100* COPY KP005SM2064.2 +050200* REPLACING == 1 == BY == 5 == SM2064.2 +050300* == 5 == BY == 7 ==. SM2064.2 +050400* SM2064.2 +050500******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +050600 COPY KP005SM2064.2 +050700 REPLACING == 1 == BY == 5 == SM2064.2 +050800 == 5 == BY == 7 ==. SM2064.2 +050900*********************** END OF COPIED TEXT ***********************SM2064.2 +051000 IF WRK-DS-09V00-901 IS EQUAL TO 5 SM2064.2 +051100 PERFORM PASS GO TO PST-WRITE-005. SM2064.2 +051200 PERFORM FAIL. SM2064.2 +051300 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +051400 MOVE 5 TO CORRECT-18V0. SM2064.2 +051500 IF WRK-DS-09V00-901 IS EQUAL TO 7 SM2064.2 +051600 MOVE "CASCADED REPLACEMENT PERFORMED" TO RE-MARK. SM2064.2 +051700 GO TO PST-WRITE-005. SM2064.2 +051800 PST-DELETE-005. SM2064.2 +051900 PERFORM DE-LETE. SM2064.2 +052000 PST-WRITE-005. SM2064.2 +052100 MOVE "CASCADED REPLACE PST" TO FEATURE. SM2064.2 +052200 MOVE "PST-TEST-005" TO PAR-NAME. SM2064.2 +052300 MOVE 01 TO REC-CT. SM2064.2 +052400 PERFORM PRINT-DETAIL. SM2064.2 +052500 PST-TEST-006. SM2064.2 +052600 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +052700* SM2064.2 +052800*********************** COPY STATEMENT USED **********************SM2064.2 +052900* SM2064.2 +053000* COPY KP006SM2064.2 +053100* REPLACING ==001== BY == 3 == SM2064.2 +053200* ==005== BY == 7 ==. SM2064.2 +053300* SM2064.2 +053400******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +053500 COPY KP006SM2064.2 +053600 REPLACING ==001== BY == 3 == SM2064.2 +053700 ==005== BY == 7 ==. SM2064.2 +053800*********************** END OF COPIED TEXT ***********************SM2064.2 +053900 IF WRK-DS-09V00-901 IS EQUAL TO 1005 SM2064.2 +054000 PERFORM PASS GO TO PST-WRITE-006. SM2064.2 +054100 PERFORM FAIL. SM2064.2 +054200 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +054300 MOVE 1005 TO CORRECT-18V0. SM2064.2 +054400 IF WRK-DS-09V00-901 IS EQUAL TO 10 SM2064.2 +054500 MOVE "PART REPLACING, CONT IGNORED" TO RE-MARK. SM2064.2 +054600 IF WRK-DS-09V00-901 IS EQUAL TO 37 SM2064.2 +054700 MOVE "PART REPLACING, CONT HONORED" TO RE-MARK. SM2064.2 +054800 GO TO PST-WRITE-006. SM2064.2 +054900 PST-DELETE-006. SM2064.2 +055000 PERFORM DE-LETE. SM2064.2 +055100 PST-WRITE-006. SM2064.2 +055200 MOVE "CONT LIT/PST PART RPL" TO FEATURE. SM2064.2 +055300 MOVE "PST-TEST-006" TO PAR-NAME. SM2064.2 +055400 PERFORM PRINT-DETAIL. SM2064.2 +055500 PST-TEST-007. SM2064.2 +055600 PERFORM FAIL. SM2064.2 +055700 SUBTRACT 1 FROM ERROR-COUNTER. SM2064.2 +055800* SM2064.2 +055900*********************** COPY STATEMENT USED **********************SM2064.2 +056000* SM2064.2 +056100* COPY KP007 SM2064.2 +056200* REPLACING ==FAIL. SUBTRACT 1 FROM ERROR-COUNTER. == SM2064.2 +056300* BY ==PASS. ==. SM2064.2 +056400* SM2064.2 +056500******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +056600 COPY KP007 SM2064.2 +056700 REPLACING ==FAIL. SUBTRACT 1 FROM ERROR-COUNTER. == SM2064.2 +056800 BY ==PASS. ==. SM2064.2 +056900*********************** END OF COPIED TEXT ***********************SM2064.2 +057000 IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +057100 GO TO PST-WRITE-007. SM2064.2 +057200 PST-DELETE-007. SM2064.2 +057300 PERFORM DE-LETE. SM2064.2 +057400 PST-WRITE-007. SM2064.2 +057500 MOVE "PST/EMBEDDED COMMENT" TO FEATURE. SM2064.2 +057600 MOVE "PST-TEST-007" TO PAR-NAME. SM2064.2 +057700 MOVE 01 TO REC-CT. SM2064.2 +057800 PERFORM PRINT-DETAIL. SM2064.2 +057900 PST-TEST-008. SM2064.2 +058000* PERFORM PASS. SM2064.2 +058100* SM2064.2 +058200*********************** COPY STATEMENT USED **********************SM2064.2 +058300* SM2064.2 +058400*D COPY KP007. SM2064.2 +058500* SM2064.2 +058600******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +058700*D COPY KP007. SM2064.2 +058800*********************** END OF COPIED TEXT ***********************SM2064.2 +058900* IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +059000* GO TO PST-WRITE-008. SM2064.2 +059100 PST-DELETE-008. SM2064.2 +059200 PERFORM DE-LETE. SM2064.2 +059300 PST-WRITE-008. SM2064.2 +059400 MOVE "COPY IN DEBUG LINE" TO FEATURE. SM2064.2 +059500 MOVE "PST-TEST-008" TO PAR-NAME. SM2064.2 +059600 PERFORM PRINT-DETAIL. SM2064.2 +059700 PST-TEST-009. SM2064.2 +059800 PERFORM FAIL. SM2064.2 +059900 SUBTRACT 1 FROM ERROR-COUNTER. SM2064.2 +060000* SM2064.2 +060100*********************** COPY STATEMENT USED **********************SM2064.2 +060200* SM2064.2 +060300* COPY KP008 SM2064.2 +060400* REPLACING ==FAIL. THIS IS GARBAGE. SUBTRACT 1 FROM SM2064.2 +060500* ERROR-COUNTER. == SM2064.2 +060600* BY ==PASS. ==. SM2064.2 +060700* SM2064.2 +060800******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +060900 COPY KP008 SM2064.2 +061000 REPLACING ==FAIL. THIS IS GARBAGE. SUBTRACT 1 FROM SM2064.2 +061100 ERROR-COUNTER. == SM2064.2 +061200 BY ==PASS. ==. SM2064.2 +061300*********************** END OF COPIED TEXT ***********************SM2064.2 +061400 IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +061500 GO TO PST-WRITE-009. SM2064.2 +061600 PST-DELETE-009. SM2064.2 +061700 PERFORM DE-LETE. SM2064.2 +061800 PST-WRITE-009. SM2064.2 +061900 MOVE "DEBUG LINE IN TEXT" TO FEATURE. SM2064.2 +062000 MOVE "PST-TEST-009" TO PAR-NAME. SM2064.2 +062100 PERFORM PRINT-DETAIL. SM2064.2 +062200* SM2064.2 +062300 PST-TEST-10. SM2064.2 +062400* ===--> MINIMUM LENGTH TEXT WORD <--=== SM2064.2 +062500 MOVE "XII-2 2.3 SR8" TO ANSI-REFERENCE. SM2064.2 +062600 MOVE "PST-TEST-10" TO PAR-NAME. SM2064.2 +062700 MOVE "T" TO WRK-XN-00001. SM2064.2 +062800 GO TO PST-TEST-10-0. SM2064.2 +062900 PST-DELETE-10. SM2064.2 +063000 PERFORM DE-LETE. SM2064.2 +063100 PERFORM PRINT-DETAIL. SM2064.2 +063200 GO TO PST-INIT-11. SM2064.2 +063300 PST-TEST-10-0. SM2064.2 +063400********************* COPY TEXT USED *************************** SM2064.2 +063500* IF WRK-XN-00001 = "G" * SM2064.2 +063600*********************END OF COPY TEXT*************************** SM2064.2 +063700 COPY KP009 SM2064.2 +063800 REPLACING =="G"== BY =="T"==. SM2064.2 +063900 SM2064.2 +064000 PERFORM PASS SM2064.2 +064100 PERFORM PRINT-DETAIL SM2064.2 +064200 ELSE SM2064.2 +064300 MOVE "REPLACING SINGLE CHARACTER FAILED" SM2064.2 +064400 TO RE-MARK SM2064.2 +064500 MOVE "T" TO CORRECT-X SM2064.2 +064600 MOVE WRK-XN-00001 TO COMPUTED-X SM2064.2 +064700 PERFORM FAIL SM2064.2 +064800 PERFORM PRINT-DETAIL. SM2064.2 +064900* SM2064.2 +065000 PST-INIT-11. SM2064.2 +065100* ===--> MAXIMUM LENGTH TEXT WORD <--=== SM2064.2 +065200 MOVE "XII-2 2.3 (SR8) AND XII-5 2.4(GR11)" SM2064.2 +065300 TO ANSI-REFERENCE. SM2064.2 +065400 MOVE "PST-TEST-11" TO PAR-NAME. SM2064.2 +065500 MOVE SPACES TO WRK-XN-00322. SM2064.2 +065600 MOVE 1 TO REC-CT. SM2064.2 +065700 REP-TEST-11-0. SM2064.2 +065800********************* COPY TEXT USED *************************** SM2064.2 +065900* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066000* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066100* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066200* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066300* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066400* YYYYYYYYYYYYYYYYY SM2064.2 +066500*********************END OF COPY TEXT*************************** SM2064.2 +066600 PST-DELETE-11. SM2064.2 +066700 PERFORM DE-LETE. SM2064.2 +066800 PERFORM PRINT-DETAIL. SM2064.2 +066900 GO TO CCVS-EXIT. SM2064.2 +067000 PST-TEST-11-1. SM2064.2 +067100 MOVE "PST-TEST-11-1" TO PAR-NAME. SM2064.2 +067200 IF WRK-DU-9 = 6 SM2064.2 +067300 PERFORM PASS SM2064.2 +067400 PERFORM PRINT-DETAIL SM2064.2 +067500 ELSE SM2064.2 +067600 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +067700 TO RE-MARK SM2064.2 +067800 MOVE 6 TO CORRECT-N SM2064.2 +067900 MOVE WRK-DU-9 TO COMPUTED-N SM2064.2 +068000 PERFORM FAIL SM2064.2 +068100 PERFORM PRINT-DETAIL. SM2064.2 +068200 ADD 1 TO REC-CT. SM2064.2 +068300 PST-TEST-11-2. SM2064.2 +068400 MOVE "PST-TEST-11-2" TO PAR-NAME. SM2064.2 +068500 IF WRK-DU-99 = 9 SM2064.2 +068600 PERFORM PASS SM2064.2 +068700 PERFORM PRINT-DETAIL SM2064.2 +068800 ELSE SM2064.2 +068900 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +069000 TO RE-MARK SM2064.2 +069100 MOVE 9 TO CORRECT-N SM2064.2 +069200 MOVE WRK-DU-99 TO COMPUTED-N SM2064.2 +069300 PERFORM FAIL SM2064.2 +069400 PERFORM PRINT-DETAIL. SM2064.2 +069500 ADD 1 TO REC-CT. SM2064.2 +069600 PST-TEST-11-3. SM2064.2 +069700 MOVE "PST-TEST-11-3" TO PAR-NAME. SM2064.2 +069800 IF WRK-DU-99-LONGER = 10 SM2064.2 +069900 PERFORM PASS SM2064.2 +070000 PERFORM PRINT-DETAIL SM2064.2 +070100 ELSE SM2064.2 +070200 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +070300 TO RE-MARK SM2064.2 +070400 MOVE 10 TO CORRECT-N SM2064.2 +070500 MOVE WRK-DU-99-LONGER TO COMPUTED-N SM2064.2 +070600 PERFORM FAIL SM2064.2 +070700 PERFORM PRINT-DETAIL. SM2064.2 +070800* SM2064.2 +070900 CCVS-EXIT SECTION. SM2064.2 +071000 CCVS-999999. SM2064.2 +071100 GO TO CLOSE-FILES. SM2064.2 +*END-OF,SM206A +*HEADER,COBOL,SM207A +000100 IDENTIFICATION DIVISION. SM2074.2 +000200 PROGRAM-ID. SM2074.2 +000300 SM207A. SM2074.2 +000400**************************************************************** SM2074.2 +000500* * SM2074.2 +000600* VALIDATION FOR:- * SM2074.2 +000700* * SM2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +000900* * SM2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2074.2 +001100* * SM2074.2 +001200**************************************************************** SM2074.2 +001300* * SM2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2074.2 +001500* * SM2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2074.2 +001900* * SM2074.2 +002000**************************************************************** SM2074.2 +002100* * SM2074.2 +002200* PROGRAM SM207A TESTS THE "COPY" STATEMENT USING TWO * SM2074.2 +002300* DIFFERENT LIBRARY NAMES TO QUALIFY THE SAME TEXT NAME. * SM2074.2 +002400* * SM2074.2 +002500**************************************************************** SM2074.2 +002600* VP-ROUTINE CONTROL OF LIBRARY CREATION SM2074.2 +002700* -------------------------------------- SM2074.2 +002800* WHEN THE LIBRARIES ARE PREPARED (CREATED) IN PREPARATION FOR SM2074.2 +002900* RUNNING OF SM207, THE TEXT WHICH WILL BE PLACED IN THE SM2074.2 +003000* LIBRARY EQUATED TO X-47 SHOULD BE SELECTED FROM THE SM2074.2 +003100* POPULATION FILE USING THE PLUS-CARD "+ALTLB". THE TEXT SM2074.2 +003200* WHICH WILL BE PLACED IN THE LIBRARY EQUATED TO X-48 SHOULD SM2074.2 +003300* BE SELECTED FROM THE POPULATION FILE USING THE PLUS-CARD SM2074.2 +003400* "+ALTL1,,,ALTLB". SM2074.2 +003500 SM2074.2 +003600 SM2074.2 +003700 ENVIRONMENT DIVISION. SM2074.2 +003800 CONFIGURATION SECTION. SM2074.2 +003900 SOURCE-COMPUTER. SM2074.2 +004000 XXXXX082. SM2074.2 +004100 OBJECT-COMPUTER. SM2074.2 +004200 XXXXX083. SM2074.2 +004300 INPUT-OUTPUT SECTION. SM2074.2 +004400 FILE-CONTROL. SM2074.2 +004500 SELECT PRINT-FILE ASSIGN TO SM2074.2 +004600 XXXXX055. SM2074.2 +004700 DATA DIVISION. SM2074.2 +004800 FILE SECTION. SM2074.2 +004900 FD PRINT-FILE. SM2074.2 +005000 01 PRINT-REC PICTURE X(120). SM2074.2 +005100 01 DUMMY-RECORD PICTURE X(120). SM2074.2 +005200 WORKING-STORAGE SECTION. SM2074.2 +005300 01 TEST-RESULTS. SM2074.2 +005400 02 FILLER PIC X VALUE SPACE. SM2074.2 +005500 02 FEATURE PIC X(20) VALUE SPACE. SM2074.2 +005600 02 FILLER PIC X VALUE SPACE. SM2074.2 +005700 02 P-OR-F PIC X(5) VALUE SPACE. SM2074.2 +005800 02 FILLER PIC X VALUE SPACE. SM2074.2 +005900 02 PAR-NAME. SM2074.2 +006000 03 FILLER PIC X(19) VALUE SPACE. SM2074.2 +006100 03 PARDOT-X PIC X VALUE SPACE. SM2074.2 +006200 03 DOTVALUE PIC 99 VALUE ZERO. SM2074.2 +006300 02 FILLER PIC X(8) VALUE SPACE. SM2074.2 +006400 02 RE-MARK PIC X(61). SM2074.2 +006500 01 TEST-COMPUTED. SM2074.2 +006600 02 FILLER PIC X(30) VALUE SPACE. SM2074.2 +006700 02 FILLER PIC X(17) VALUE SM2074.2 +006800 " COMPUTED=". SM2074.2 +006900 02 COMPUTED-X. SM2074.2 +007000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2074.2 +007100 03 COMPUTED-N REDEFINES COMPUTED-A SM2074.2 +007200 PIC -9(9).9(9). SM2074.2 +007300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2074.2 +007400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2074.2 +007500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2074.2 +007600 03 CM-18V0 REDEFINES COMPUTED-A. SM2074.2 +007700 04 COMPUTED-18V0 PIC -9(18). SM2074.2 +007800 04 FILLER PIC X. SM2074.2 +007900 03 FILLER PIC X(50) VALUE SPACE. SM2074.2 +008000 01 TEST-CORRECT. SM2074.2 +008100 02 FILLER PIC X(30) VALUE SPACE. SM2074.2 +008200 02 FILLER PIC X(17) VALUE " CORRECT =". SM2074.2 +008300 02 CORRECT-X. SM2074.2 +008400 03 CORRECT-A PIC X(20) VALUE SPACE. SM2074.2 +008500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2074.2 +008600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2074.2 +008700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2074.2 +008800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2074.2 +008900 03 CR-18V0 REDEFINES CORRECT-A. SM2074.2 +009000 04 CORRECT-18V0 PIC -9(18). SM2074.2 +009100 04 FILLER PIC X. SM2074.2 +009200 03 FILLER PIC X(2) VALUE SPACE. SM2074.2 +009300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2074.2 +009400 01 CCVS-C-1. SM2074.2 +009500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2074.2 +009600- "SS PARAGRAPH-NAME SM2074.2 +009700- " REMARKS". SM2074.2 +009800 02 FILLER PIC X(20) VALUE SPACE. SM2074.2 +009900 01 CCVS-C-2. SM2074.2 +010000 02 FILLER PIC X VALUE SPACE. SM2074.2 +010100 02 FILLER PIC X(6) VALUE "TESTED". SM2074.2 +010200 02 FILLER PIC X(15) VALUE SPACE. SM2074.2 +010300 02 FILLER PIC X(4) VALUE "FAIL". SM2074.2 +010400 02 FILLER PIC X(94) VALUE SPACE. SM2074.2 +010500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2074.2 +010600 01 REC-CT PIC 99 VALUE ZERO. SM2074.2 +010700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2074.2 +010800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2074.2 +010900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2074.2 +011000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2074.2 +011100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2074.2 +011200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2074.2 +011300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2074.2 +011400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2074.2 +011500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2074.2 +011600 01 CCVS-H-1. SM2074.2 +011700 02 FILLER PIC X(39) VALUE SPACES. SM2074.2 +011800 02 FILLER PIC X(42) VALUE SM2074.2 +011900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2074.2 +012000 02 FILLER PIC X(39) VALUE SPACES. SM2074.2 +012100 01 CCVS-H-2A. SM2074.2 +012200 02 FILLER PIC X(40) VALUE SPACE. SM2074.2 +012300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2074.2 +012400 02 FILLER PIC XXXX VALUE SM2074.2 +012500 "4.2 ". SM2074.2 +012600 02 FILLER PIC X(28) VALUE SM2074.2 +012700 " COPY - NOT FOR DISTRIBUTION". SM2074.2 +012800 02 FILLER PIC X(41) VALUE SPACE. SM2074.2 +012900 SM2074.2 +013000 01 CCVS-H-2B. SM2074.2 +013100 02 FILLER PIC X(15) VALUE SM2074.2 +013200 "TEST RESULT OF ". SM2074.2 +013300 02 TEST-ID PIC X(9). SM2074.2 +013400 02 FILLER PIC X(4) VALUE SM2074.2 +013500 " IN ". SM2074.2 +013600 02 FILLER PIC X(12) VALUE SM2074.2 +013700 " HIGH ". SM2074.2 +013800 02 FILLER PIC X(22) VALUE SM2074.2 +013900 " LEVEL VALIDATION FOR ". SM2074.2 +014000 02 FILLER PIC X(58) VALUE SM2074.2 +014100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +014200 01 CCVS-H-3. SM2074.2 +014300 02 FILLER PIC X(34) VALUE SM2074.2 +014400 " FOR OFFICIAL USE ONLY ". SM2074.2 +014500 02 FILLER PIC X(58) VALUE SM2074.2 +014600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2074.2 +014700 02 FILLER PIC X(28) VALUE SM2074.2 +014800 " COPYRIGHT 1985 ". SM2074.2 +014900 01 CCVS-E-1. SM2074.2 +015000 02 FILLER PIC X(52) VALUE SPACE. SM2074.2 +015100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2074.2 +015200 02 ID-AGAIN PIC X(9). SM2074.2 +015300 02 FILLER PIC X(45) VALUE SPACES. SM2074.2 +015400 01 CCVS-E-2. SM2074.2 +015500 02 FILLER PIC X(31) VALUE SPACE. SM2074.2 +015600 02 FILLER PIC X(21) VALUE SPACE. SM2074.2 +015700 02 CCVS-E-2-2. SM2074.2 +015800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2074.2 +015900 03 FILLER PIC X VALUE SPACE. SM2074.2 +016000 03 ENDER-DESC PIC X(44) VALUE SM2074.2 +016100 "ERRORS ENCOUNTERED". SM2074.2 +016200 01 CCVS-E-3. SM2074.2 +016300 02 FILLER PIC X(22) VALUE SM2074.2 +016400 " FOR OFFICIAL USE ONLY". SM2074.2 +016500 02 FILLER PIC X(12) VALUE SPACE. SM2074.2 +016600 02 FILLER PIC X(58) VALUE SM2074.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +016800 02 FILLER PIC X(13) VALUE SPACE. SM2074.2 +016900 02 FILLER PIC X(15) VALUE SM2074.2 +017000 " COPYRIGHT 1985". SM2074.2 +017100 01 CCVS-E-4. SM2074.2 +017200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2074.2 +017300 02 FILLER PIC X(4) VALUE " OF ". SM2074.2 +017400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2074.2 +017500 02 FILLER PIC X(40) VALUE SM2074.2 +017600 " TESTS WERE EXECUTED SUCCESSFULLY". SM2074.2 +017700 01 XXINFO. SM2074.2 +017800 02 FILLER PIC X(19) VALUE SM2074.2 +017900 "*** INFORMATION ***". SM2074.2 +018000 02 INFO-TEXT. SM2074.2 +018100 04 FILLER PIC X(8) VALUE SPACE. SM2074.2 +018200 04 XXCOMPUTED PIC X(20). SM2074.2 +018300 04 FILLER PIC X(5) VALUE SPACE. SM2074.2 +018400 04 XXCORRECT PIC X(20). SM2074.2 +018500 02 INF-ANSI-REFERENCE PIC X(48). SM2074.2 +018600 01 HYPHEN-LINE. SM2074.2 +018700 02 FILLER PIC IS X VALUE IS SPACE. SM2074.2 +018800 02 FILLER PIC IS X(65) VALUE IS "************************SM2074.2 +018900- "*****************************************". SM2074.2 +019000 02 FILLER PIC IS X(54) VALUE IS "************************SM2074.2 +019100- "******************************". SM2074.2 +019200 01 CCVS-PGM-ID PIC X(9) VALUE SM2074.2 +019300 "SM207A". SM2074.2 +019400 PROCEDURE DIVISION. SM2074.2 +019500 CCVS1 SECTION. SM2074.2 +019600 OPEN-FILES. SM2074.2 +019700 OPEN OUTPUT PRINT-FILE. SM2074.2 +019800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2074.2 +019900 MOVE SPACE TO TEST-RESULTS. SM2074.2 +020000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2074.2 +020100 GO TO CCVS1-EXIT. SM2074.2 +020200 CLOSE-FILES. SM2074.2 +020300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2074.2 +020400 TERMINATE-CCVS. SM2074.2 +020500S EXIT PROGRAM. SM2074.2 +020600STERMINATE-CALL. SM2074.2 +020700 STOP RUN. SM2074.2 +020800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2074.2 +020900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2074.2 +021000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2074.2 +021100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2074.2 +021200 MOVE "****TEST DELETED****" TO RE-MARK. SM2074.2 +021300 PRINT-DETAIL. SM2074.2 +021400 IF REC-CT NOT EQUAL TO ZERO SM2074.2 +021500 MOVE "." TO PARDOT-X SM2074.2 +021600 MOVE REC-CT TO DOTVALUE. SM2074.2 +021700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2074.2 +021800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2074.2 +021900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2074.2 +022000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2074.2 +022100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2074.2 +022200 MOVE SPACE TO CORRECT-X. SM2074.2 +022300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2074.2 +022400 MOVE SPACE TO RE-MARK. SM2074.2 +022500 HEAD-ROUTINE. SM2074.2 +022600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +022700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +022800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2074.2 +022900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2074.2 +023000 COLUMN-NAMES-ROUTINE. SM2074.2 +023100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +023200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +023400 END-ROUTINE. SM2074.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2074.2 +023600 END-RTN-EXIT. SM2074.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +023800 END-ROUTINE-1. SM2074.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2074.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2074.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. SM2074.2 +024200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2074.2 +024300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2074.2 +024400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2074.2 +024500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2074.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2074.2 +024700 END-ROUTINE-12. SM2074.2 +024800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2074.2 +024900 IF ERROR-COUNTER IS EQUAL TO ZERO SM2074.2 +025000 MOVE "NO " TO ERROR-TOTAL SM2074.2 +025100 ELSE SM2074.2 +025200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2074.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2074.2 +025400 PERFORM WRITE-LINE. SM2074.2 +025500 END-ROUTINE-13. SM2074.2 +025600 IF DELETE-COUNTER IS EQUAL TO ZERO SM2074.2 +025700 MOVE "NO " TO ERROR-TOTAL ELSE SM2074.2 +025800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2074.2 +025900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2074.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026100 IF INSPECT-COUNTER EQUAL TO ZERO SM2074.2 +026200 MOVE "NO " TO ERROR-TOTAL SM2074.2 +026300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2074.2 +026400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2074.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026700 WRITE-LINE. SM2074.2 +026800 ADD 1 TO RECORD-COUNT. SM2074.2 +026900Y IF RECORD-COUNT GREATER 50 SM2074.2 +027000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2074.2 +027100Y MOVE SPACE TO DUMMY-RECORD SM2074.2 +027200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2074.2 +027300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2074.2 +027400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2074.2 +027500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2074.2 +027600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2074.2 +027700Y MOVE ZERO TO RECORD-COUNT. SM2074.2 +027800 PERFORM WRT-LN. SM2074.2 +027900 WRT-LN. SM2074.2 +028000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2074.2 +028100 MOVE SPACE TO DUMMY-RECORD. SM2074.2 +028200 BLANK-LINE-PRINT. SM2074.2 +028300 PERFORM WRT-LN. SM2074.2 +028400 FAIL-ROUTINE. SM2074.2 +028500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2074.2 +028600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2074.2 +028700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2074.2 +028800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2074.2 +028900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +029000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2074.2 +029100 GO TO FAIL-ROUTINE-EX. SM2074.2 +029200 FAIL-ROUTINE-WRITE. SM2074.2 +029300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2074.2 +029400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2074.2 +029500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2074.2 +029600 MOVE SPACES TO COR-ANSI-REFERENCE. SM2074.2 +029700 FAIL-ROUTINE-EX. EXIT. SM2074.2 +029800 BAIL-OUT. SM2074.2 +029900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2074.2 +030000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2074.2 +030100 BAIL-OUT-WRITE. SM2074.2 +030200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2074.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2074.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2074.2 +030600 BAIL-OUT-EX. EXIT. SM2074.2 +030700 CCVS1-EXIT. SM2074.2 +030800 EXIT. SM2074.2 +030900 SECT-SM207A-001 SECTION. SM2074.2 +031000 QUAL-TEST-01. SM2074.2 +031100 MOVE "NOTHING COPIED" TO RE-MARK. SM2074.2 +031200 PERFORM FAIL. SM2074.2 +031300* SM2074.2 +031400*********************** COPY STATEMENT USED **********************SM2074.2 +031500* SM2074.2 +031600* COPY ALTLB OF SM2074.2 +031700* XXXXX047. SM2074.2 +031800* SM2074.2 +031900******************** COPIED TEXT BEGINS BELOW ********************SM2074.2 +032000 COPY ALTLB OF SM2074.2 +032100 XXXXX047. SM2074.2 +032200*********************** END OF COPIED TEXT ***********************SM2074.2 +032300 GO TO QUAL-WRITE-01. SM2074.2 +032400 QUAL-DELETE-01. SM2074.2 +032500 PERFORM DE-LETE. SM2074.2 +032600 QUAL-WRITE-01. SM2074.2 +032700 MOVE "QUAL-TEST-01" TO PAR-NAME. SM2074.2 +032800 MOVE "QUALIFIED LIBRY NAME" TO FEATURE. SM2074.2 +032900 PERFORM PRINT-DETAIL. SM2074.2 +033000 QUAL-TEST-02. SM2074.2 +033100 ADD 1 TO ERROR-COUNTER. SM2074.2 +033200* SM2074.2 +033300*********************** COPY STATEMENT USED **********************SM2074.2 +033400* SM2074.2 +033500* COPY ALTLB IN SM2074.2 +033600* XXXXX048. SM2074.2 +033700* SM2074.2 +033800******************** COPIED TEXT BEGINS BELOW ********************SM2074.2 +033900 COPY ALTLB IN SM2074.2 +034000 XXXXX048. SM2074.2 +034100*********************** END OF COPIED TEXT ***********************SM2074.2 +034200 IF P-OR-F IS EQUAL TO "PASS " SM2074.2 +034300 PERFORM FAIL SM2074.2 +034400 MOVE "TEXT COPIED FROM WRONG LIBRARY" TO RE-MARK SM2074.2 +034500 GO TO QUAL-WRITE-02. SM2074.2 +034600 IF P-OR-F IS EQUAL TO "FAIL*" SM2074.2 +034700 PERFORM PASS SM2074.2 +034800 SUBTRACT 1 FROM ERROR-COUNTER SM2074.2 +034900 MOVE SPACES TO RE-MARK SM2074.2 +035000 GO TO QUAL-WRITE-02. SM2074.2 +035100 PERFORM FAIL. SM2074.2 +035200 SUBTRACT 1 FROM ERROR-COUNTER. SM2074.2 +035300 MOVE "NOTHING COPIED" TO RE-MARK. SM2074.2 +035400 GO TO QUAL-WRITE-02. SM2074.2 +035500 QUAL-DELETE-02. SM2074.2 +035600 PERFORM DE-LETE. SM2074.2 +035700 QUAL-WRITE-02. SM2074.2 +035800 MOVE "QUAL-TEST-02" TO PAR-NAME. SM2074.2 +035900 PERFORM PRINT-DETAIL. SM2074.2 +036000 CCVS-EXIT SECTION. SM2074.2 +036100 CCVS-999999. SM2074.2 +036200 GO TO CLOSE-FILES. SM2074.2 +*END-OF,SM207A +*HEADER,COBOL,SM208A +000100 IDENTIFICATION DIVISION. SM2084.2 +000200 PROGRAM-ID. SM208A. SM2084.2 +000300 REPLACE OFF. SM2084.2 +000400**************************************************************** SM2084.2 +000500* * SM2084.2 +000600* VALIDATION FOR:- * SM2084.2 +000700* * SM2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +000900* * SM2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2084.2 +001100* * SM2084.2 +001200**************************************************************** SM2084.2 +001300* * SM2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2084.2 +001500* * SM2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2084.2 +001900* * SM2084.2 +002000**************************************************************** SM2084.2 +002100* * SM2084.2 +002200* PROGRAM SM208A TESTS FORMATS 1 AND 2 OF THE "REPLACE" * SM2084.2 +002300* STATEMENT WITH VARIOUS COMBINATIONS OF PSEUDO-TEXT IN * SM2084.2 +002400* EACH OF THE FOUR DIVISIONS. * SM2084.2 +002500* * SM2084.2 +002600**************************************************************** SM2084.2 +002700 SM2084.2 +002800 SM2084.2 +002900 ENVIRONMENT DIVISION. SM2084.2 +003000 CONFIGURATION SECTION. SM2084.2 +003100 SOURCE-COMPUTER. SM2084.2 +003200 XXXXX082. SM2084.2 +003300 OBJECT-COMPUTER. SM2084.2 +003400 XXXXX083. SM2084.2 +003500 INPUT-OUTPUT SECTION. SM2084.2 +003600 FILE-CONTROL. SM2084.2 +003700 SELECT PRINT-FILE ASSIGN TO SM2084.2 +003800 XXXXX055. SM2084.2 +003900 DATA DIVISION. SM2084.2 +004000 FILE SECTION. SM2084.2 +004100 FD PRINT-FILE. SM2084.2 +004200 01 PRINT-REC PICTURE X(120). SM2084.2 +004300 01 DUMMY-RECORD PICTURE X(120). SM2084.2 +004400 WORKING-STORAGE SECTION. SM2084.2 +004500* THE ANSI-REFERENCE FOR THE TEST OF THE FIRST FOUR "01" SM2084.2 +004600* LEVEL DATA-ITEMS IS "XII-7 3.4 GR3 AND XII-6 3.4 GR2". SM2084.2 +004700 REPLACE ==PICTURE== BY ==PIC==. SM2084.2 +004800 01 A PICTURE X. SM2084.2 +004900 01 B PICTURE S9(7) COMP. SM2084.2 +005000 01 C PICTURE XXBXX/XX. SM2084.2 +005100 REPLACE OFF. SM2084.2 +005200 01 D PICTURE X(7) VALUE "PICTURE". SM2084.2 +005300 01 WRK-XN-00001 PIC X. SM2084.2 +005400 01 WRK-XN-00020 PIC X(20). SM2084.2 +005500 01 WRK-XN-00322 PIC X(322). SM2084.2 +005600 01 FILLER REDEFINES WRK-XN-00322. SM2084.2 +005700 03 WRK-XN-00322-1 PIC X. SM2084.2 +005800 03 WRK-XN-00322-2-322. SM2084.2 +005900 05 WRK-XN-00322-2 PIC X. SM2084.2 +006000 05 WRK-XN-00322-20 PIC X(20) SM2084.2 +006100 OCCURS 16 SM2084.2 +006200 INDEXED BY X1. SM2084.2 +006300 01 WS-A PIC X. SM2084.2 +006400 01 WS-B PIC X. SM2084.2 +006500 01 WS-C PIC X. SM2084.2 +006600 01 WS-D PIC X. SM2084.2 +006700 01 WS-E PIC X. SM2084.2 +006800 01 WS-F PIC X. SM2084.2 +006900 01 TEST-RESULTS. SM2084.2 +007000 02 FILLER PIC X VALUE SPACE. SM2084.2 +007100 02 FEATURE PIC X(20) VALUE SPACE. SM2084.2 +007200 02 FILLER PIC X VALUE SPACE. SM2084.2 +007300 02 P-OR-F PIC X(5) VALUE SPACE. SM2084.2 +007400 02 FILLER PIC X VALUE SPACE. SM2084.2 +007500 02 PAR-NAME. SM2084.2 +007600 03 FILLER PIC X(19) VALUE SPACE. SM2084.2 +007700 03 PARDOT-X PIC X VALUE SPACE. SM2084.2 +007800 03 DOTVALUE PIC 99 VALUE ZERO. SM2084.2 +007900 02 FILLER PIC X(8) VALUE SPACE. SM2084.2 +008000 02 RE-MARK PIC X(61). SM2084.2 +008100 01 TEST-COMPUTED. SM2084.2 +008200 02 FILLER PIC X(30) VALUE SPACE. SM2084.2 +008300 02 FILLER PIC X(17) VALUE SM2084.2 +008400 " COMPUTED=". SM2084.2 +008500 02 COMPUTED-X. SM2084.2 +008600 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2084.2 +008700 03 COMPUTED-N REDEFINES COMPUTED-A SM2084.2 +008800 PIC -9(9).9(9). SM2084.2 +008900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2084.2 +009000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2084.2 +009100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2084.2 +009200 03 CM-18V0 REDEFINES COMPUTED-A. SM2084.2 +009300 04 COMPUTED-18V0 PIC -9(18). SM2084.2 +009400 04 FILLER PIC X. SM2084.2 +009500 03 FILLER PIC X(50) VALUE SPACE. SM2084.2 +009600 01 TEST-CORRECT. SM2084.2 +009700 02 FILLER PIC X(30) VALUE SPACE. SM2084.2 +009800 02 FILLER PIC X(17) VALUE " CORRECT =". SM2084.2 +009900 02 CORRECT-X. SM2084.2 +010000 03 CORRECT-A PIC X(20) VALUE SPACE. SM2084.2 +010100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2084.2 +010200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2084.2 +010300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2084.2 +010400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2084.2 +010500 03 CR-18V0 REDEFINES CORRECT-A. SM2084.2 +010600 04 CORRECT-18V0 PIC -9(18). SM2084.2 +010700 04 FILLER PIC X. SM2084.2 +010800 03 FILLER PIC X(2) VALUE SPACE. SM2084.2 +010900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2084.2 +011000 01 CCVS-C-1. SM2084.2 +011100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2084.2 +011200- "SS PARAGRAPH-NAME SM2084.2 +011300- " REMARKS". SM2084.2 +011400 02 FILLER PIC X(20) VALUE SPACE. SM2084.2 +011500 01 CCVS-C-2. SM2084.2 +011600 02 FILLER PIC X VALUE SPACE. SM2084.2 +011700 02 FILLER PIC X(6) VALUE "TESTED". SM2084.2 +011800 02 FILLER PIC X(15) VALUE SPACE. SM2084.2 +011900 02 FILLER PIC X(4) VALUE "FAIL". SM2084.2 +012000 02 FILLER PIC X(94) VALUE SPACE. SM2084.2 +012100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2084.2 +012200 01 REC-CT PIC 99 VALUE ZERO. SM2084.2 +012300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012600 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2084.2 +012800 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2084.2 +012900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2084.2 +013000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2084.2 +013100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2084.2 +013200 01 CCVS-H-1. SM2084.2 +013300 02 FILLER PIC X(39) VALUE SPACES. SM2084.2 +013400 02 FILLER PIC X(42) VALUE SM2084.2 +013500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2084.2 +013600 02 FILLER PIC X(39) VALUE SPACES. SM2084.2 +013700 01 CCVS-H-2A. SM2084.2 +013800 02 FILLER PIC X(40) VALUE SPACE. SM2084.2 +013900 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2084.2 +014000 02 FILLER PIC XXXX VALUE SM2084.2 +014100 "4.2 ". SM2084.2 +014200 02 FILLER PIC X(28) VALUE SM2084.2 +014300 " COPY - NOT FOR DISTRIBUTION". SM2084.2 +014400 02 FILLER PIC X(41) VALUE SPACE. SM2084.2 +014500 SM2084.2 +014600 01 CCVS-H-2B. SM2084.2 +014700 02 FILLER PIC X(15) VALUE SM2084.2 +014800 "TEST RESULT OF ". SM2084.2 +014900 02 TEST-ID PIC X(9). SM2084.2 +015000 02 FILLER PIC X(4) VALUE SM2084.2 +015100 " IN ". SM2084.2 +015200 02 FILLER PIC X(12) VALUE SM2084.2 +015300 " HIGH ". SM2084.2 +015400 02 FILLER PIC X(22) VALUE SM2084.2 +015500 " LEVEL VALIDATION FOR ". SM2084.2 +015600 02 FILLER PIC X(58) VALUE SM2084.2 +015700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +015800 01 CCVS-H-3. SM2084.2 +015900 02 FILLER PIC X(34) VALUE SM2084.2 +016000 " FOR OFFICIAL USE ONLY ". SM2084.2 +016100 02 FILLER PIC X(58) VALUE SM2084.2 +016200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2084.2 +016300 02 FILLER PIC X(28) VALUE SM2084.2 +016400 " COPYRIGHT 1985 ". SM2084.2 +016500 01 CCVS-E-1. SM2084.2 +016600 02 FILLER PIC X(52) VALUE SPACE. SM2084.2 +016700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2084.2 +016800 02 ID-AGAIN PIC X(9). SM2084.2 +016900 02 FILLER PIC X(45) VALUE SPACES. SM2084.2 +017000 01 CCVS-E-2. SM2084.2 +017100 02 FILLER PIC X(31) VALUE SPACE. SM2084.2 +017200 02 FILLER PIC X(21) VALUE SPACE. SM2084.2 +017300 02 CCVS-E-2-2. SM2084.2 +017400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2084.2 +017500 03 FILLER PIC X VALUE SPACE. SM2084.2 +017600 03 ENDER-DESC PIC X(44) VALUE SM2084.2 +017700 "ERRORS ENCOUNTERED". SM2084.2 +017800 01 CCVS-E-3. SM2084.2 +017900 02 FILLER PIC X(22) VALUE SM2084.2 +018000 " FOR OFFICIAL USE ONLY". SM2084.2 +018100 02 FILLER PIC X(12) VALUE SPACE. SM2084.2 +018200 02 FILLER PIC X(58) VALUE SM2084.2 +018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +018400 02 FILLER PIC X(13) VALUE SPACE. SM2084.2 +018500 02 FILLER PIC X(15) VALUE SM2084.2 +018600 " COPYRIGHT 1985". SM2084.2 +018700 01 CCVS-E-4. SM2084.2 +018800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2084.2 +018900 02 FILLER PIC X(4) VALUE " OF ". SM2084.2 +019000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2084.2 +019100 02 FILLER PIC X(40) VALUE SM2084.2 +019200 " TESTS WERE EXECUTED SUCCESSFULLY". SM2084.2 +019300 01 XXINFO. SM2084.2 +019400 02 FILLER PIC X(19) VALUE SM2084.2 +019500 "*** INFORMATION ***". SM2084.2 +019600 02 INFO-TEXT. SM2084.2 +019700 04 FILLER PIC X(8) VALUE SPACE. SM2084.2 +019800 04 XXCOMPUTED PIC X(20). SM2084.2 +019900 04 FILLER PIC X(5) VALUE SPACE. SM2084.2 +020000 04 XXCORRECT PIC X(20). SM2084.2 +020100 02 INF-ANSI-REFERENCE PIC X(48). SM2084.2 +020200 01 HYPHEN-LINE. SM2084.2 +020300 02 FILLER PIC IS X VALUE IS SPACE. SM2084.2 +020400 02 FILLER PIC IS X(65) VALUE IS "************************SM2084.2 +020500- "*****************************************". SM2084.2 +020600 02 FILLER PIC IS X(54) VALUE IS "************************SM2084.2 +020700- "******************************". SM2084.2 +020800 01 CCVS-PGM-ID PIC X(9) VALUE SM2084.2 +020900 "SM208A". SM2084.2 +021000 PROCEDURE DIVISION. SM2084.2 +021100 CCVS1 SECTION. SM2084.2 +021200 OPEN-FILES. SM2084.2 +021300 OPEN OUTPUT PRINT-FILE. SM2084.2 +021400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2084.2 +021500 MOVE SPACE TO TEST-RESULTS. SM2084.2 +021600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2084.2 +021700 GO TO CCVS1-EXIT. SM2084.2 +021800 CLOSE-FILES. SM2084.2 +021900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2084.2 +022000 TERMINATE-CCVS. SM2084.2 +022100S EXIT PROGRAM. SM2084.2 +022200STERMINATE-CALL. SM2084.2 +022300 STOP RUN. SM2084.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2084.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2084.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2084.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2084.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. SM2084.2 +022900 PRINT-DETAIL. SM2084.2 +023000 IF REC-CT NOT EQUAL TO ZERO SM2084.2 +023100 MOVE "." TO PARDOT-X SM2084.2 +023200 MOVE REC-CT TO DOTVALUE. SM2084.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2084.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2084.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2084.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2084.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2084.2 +023800 MOVE SPACE TO CORRECT-X. SM2084.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2084.2 +024000 MOVE SPACE TO RE-MARK. SM2084.2 +024100 HEAD-ROUTINE. SM2084.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2084.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2084.2 +024600 COLUMN-NAMES-ROUTINE. SM2084.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +025000 END-ROUTINE. SM2084.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2084.2 +025200 END-RTN-EXIT. SM2084.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +025400 END-ROUTINE-1. SM2084.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2084.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2084.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. SM2084.2 +025800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2084.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2084.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2084.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2084.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2084.2 +026300 END-ROUTINE-12. SM2084.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2084.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO SM2084.2 +026600 MOVE "NO " TO ERROR-TOTAL SM2084.2 +026700 ELSE SM2084.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2084.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2084.2 +027000 PERFORM WRITE-LINE. SM2084.2 +027100 END-ROUTINE-13. SM2084.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO SM2084.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE SM2084.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2084.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2084.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO SM2084.2 +027800 MOVE "NO " TO ERROR-TOTAL SM2084.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2084.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2084.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +028300 WRITE-LINE. SM2084.2 +028400 ADD 1 TO RECORD-COUNT. SM2084.2 +028500Y IF RECORD-COUNT GREATER 50 SM2084.2 +028600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SM2084.2 +028700Y MOVE SPACE TO DUMMY-RECORD SM2084.2 +028800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2084.2 +028900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2084.2 +029000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2084.2 +029100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2084.2 +029200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SM2084.2 +029300Y MOVE ZERO TO RECORD-COUNT. SM2084.2 +029400 PERFORM WRT-LN. SM2084.2 +029500 WRT-LN. SM2084.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2084.2 +029700 MOVE SPACE TO DUMMY-RECORD. SM2084.2 +029800 BLANK-LINE-PRINT. SM2084.2 +029900 PERFORM WRT-LN. SM2084.2 +030000 FAIL-ROUTINE. SM2084.2 +030100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2084.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2084.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2084.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2084.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2084.2 +030700 GO TO FAIL-ROUTINE-EX. SM2084.2 +030800 FAIL-ROUTINE-WRITE. SM2084.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2084.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2084.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2084.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. SM2084.2 +031300 FAIL-ROUTINE-EX. EXIT. SM2084.2 +031400 BAIL-OUT. SM2084.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2084.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2084.2 +031700 BAIL-OUT-WRITE. SM2084.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2084.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2084.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2084.2 +032200 BAIL-OUT-EX. EXIT. SM2084.2 +032300 CCVS1-EXIT. SM2084.2 +032400 EXIT. SM2084.2 +032500 SECT-SM208A-001 SECTION. SM2084.2 +032600 REP-INIT-1. SM2084.2 +032700* ===--> MULTIPLE OPERANDS <--=== SM2084.2 +032800 MOVE "XII-6 3.2" TO ANSI-REFERENCE. SM2084.2 +032900 MOVE "REP-TEST-1" TO PAR-NAME. SM2084.2 +033000 MOVE SPACE TO WRK-XN-00001. SM2084.2 +033100 REP-TEST-1-0. SM2084.2 +033200 REPLACE ==AO== BY ==TO== SM2084.2 +033300 ==IE== BY ==IF== SM2084.2 +033400 == = == BY ==EQUAL==. SM2084.2 +033500 GO TO REP-TEST-1-1. SM2084.2 +033600 REP-DELETE-1. SM2084.2 +033700 PERFORM DE-LETE. SM2084.2 +033800 PERFORM PRINT-DETAIL. SM2084.2 +033900 GO TO REP-INIT-2. SM2084.2 +034000 REP-TEST-1-1. SM2084.2 +034100 MOVE "*" AO WRK-XN-00001. SM2084.2 +034200 IE WRK-XN-00001 = "*" SM2084.2 +034300 PERFORM PASS SM2084.2 +034400 PERFORM PRINT-DETAIL SM2084.2 +034500 ELSE SM2084.2 +034600 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +034700 MOVE "*" TO CORRECT-X SM2084.2 +034800 MOVE WRK-XN-00001 TO COMPUTED-X SM2084.2 +034900 PERFORM FAIL SM2084.2 +035000 PERFORM PRINT-DETAIL. SM2084.2 +035100 REPLACE OFF. SM2084.2 +035200* SM2084.2 +035300 REP-INIT-2. SM2084.2 +035400* ===--> MINIMUM AND MAXIMUM LENGTHS <--=== SM2084.2 +035500 MOVE "XII-6 3.3 (SR5&6) AND XII-8 3.4(GR11)" SM2084.2 +035600 TO ANSI-REFERENCE. SM2084.2 +035700 MOVE "REP-TEST-2" TO PAR-NAME. SM2084.2 +035800 MOVE SPACES TO WRK-XN-00322. SM2084.2 +035900 MOVE 1 TO REC-CT. SM2084.2 +036000 REP-TEST-2-0. SM2084.2 +036100 REPLACE =="Z"== BY =="""""""""""""""""SM2084.2 +036200- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036400- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036500- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036700- """"""==. SM2084.2 +036800 MOVE "Z" TO WRK-XN-00322. SM2084.2 +036900 REPLACE OFF. SM2084.2 +037000 GO TO REP-TEST-2-1. SM2084.2 +037100 REP-DELETE-2. SM2084.2 +037200 PERFORM DE-LETE. SM2084.2 +037300 PERFORM PRINT-DETAIL. SM2084.2 +037400 GO TO REP-INIT-3. SM2084.2 +037500 REP-TEST-2-1. SM2084.2 +037600 IF WRK-XN-00322 = """""""""""""""""SM2084.2 +037700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +037800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +037900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038100- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038200- """""" SM2084.2 +038300 PERFORM PASS SM2084.2 +038400 PERFORM PRINT-DETAIL SM2084.2 +038500 ELSE SM2084.2 +038600 MOVE "REPLACING SINGLE CHARACTER BY 160 QUOTES" SM2084.2 +038700 TO RE-MARK SM2084.2 +038800 MOVE """" TO CORRECT-X SM2084.2 +038900 MOVE WRK-XN-00322-1 TO COMPUTED-X SM2084.2 +039000 PERFORM FAIL SM2084.2 +039100 PERFORM PRINT-DETAIL SM2084.2 +039200 ADD 1 TO REC-CT SM2084.2 +039300 MOVE """""""""""""""" TO CORRECT-X SM2084.2 +039400 MOVE WRK-XN-00322-2 TO COMPUTED-X SM2084.2 +039500* PERFORM FAIL SM2084.2 +039600 PERFORM PRINT-DETAIL SM2084.2 +039700 PERFORM WITH TEST AFTER SM2084.2 +039800 VARYING X1 FROM 1 BY 1 SM2084.2 +039900 UNTIL X1 > 7 SM2084.2 +040000 ADD 1 TO REC-CT SM2084.2 +040100 MOVE """""""""""""""""""""""""""""""""""""""""" SM2084.2 +040200 TO CORRECT-X SM2084.2 +040300 MOVE WRK-XN-00322-20 (X1) TO COMPUTED-X SM2084.2 +040400 PERFORM PRINT-DETAIL SM2084.2 +040500 END-PERFORM. SM2084.2 +040600* SM2084.2 +040700 REP-INIT-3. SM2084.2 +040800* ===--> MINIMUM AND MAXIMUM LENGTHS <--=== SM2084.2 +040900 MOVE "XII-6 3.3 (SR5&6) AND XII-8 3.4(GR11)" SM2084.2 +041000 TO ANSI-REFERENCE. SM2084.2 +041100 MOVE "REP-TEST-3" TO PAR-NAME. SM2084.2 +041200 MOVE SPACES TO WRK-XN-00322. SM2084.2 +041300 MOVE 1 TO REC-CT. SM2084.2 +041400 REP-TEST-3-0. SM2084.2 +041500 REPLACE =="""""""""""""""""SM2084.2 +041600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042100- """"""== BY =="Y"==. SM2084.2 +042200 MOVE """""""""""""""""SM2084.2 +042300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042400- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042500- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042800- """""" TO WRK-XN-00322. SM2084.2 +042900 REPLACE OFF. SM2084.2 +043000 GO TO REP-TEST-3-1. SM2084.2 +043100 REP-DELETE-3. SM2084.2 +043200 PERFORM DE-LETE. SM2084.2 +043300 PERFORM PRINT-DETAIL. SM2084.2 +043400 GO TO REP-INIT-4. SM2084.2 +043500 REP-TEST-3-1. SM2084.2 +043600 IF WRK-XN-00322-1 = "Y" SM2084.2 +043700 AND WRK-XN-00322-2-322 = SPACES SM2084.2 +043800 PERFORM PASS SM2084.2 +043900 PERFORM PRINT-DETAIL SM2084.2 +044000 ELSE SM2084.2 +044100 MOVE "REPLACING 160 QUOTES BY A SINGLE CHARACTER" SM2084.2 +044200 TO RE-MARK SM2084.2 +044300 MOVE "Y" TO CORRECT-X SM2084.2 +044400 MOVE WRK-XN-00322-1 TO COMPUTED-X SM2084.2 +044500 PERFORM FAIL SM2084.2 +044600 PERFORM PRINT-DETAIL SM2084.2 +044700 ADD 1 TO REC-CT SM2084.2 +044800 MOVE SPACE TO CORRECT-X SM2084.2 +044900 MOVE WRK-XN-00322-2 TO COMPUTED-X SM2084.2 +045000* PERFORM FAIL SM2084.2 +045100 PERFORM PRINT-DETAIL SM2084.2 +045200 PERFORM WITH TEST AFTER SM2084.2 +045300 VARYING X1 FROM 1 BY 1 SM2084.2 +045400 UNTIL X1 > 7 SM2084.2 +045500 ADD 1 TO REC-CT SM2084.2 +045600 MOVE SPACES TO CORRECT-X SM2084.2 +045700 MOVE WRK-XN-00322-20 (X1) TO COMPUTED-X SM2084.2 +045800 PERFORM PRINT-DETAIL SM2084.2 +045900 END-PERFORM. SM2084.2 +046000* SM2084.2 +046100 REP-INIT-4. SM2084.2 +046200* ===--> INSERTING SPACES <--=== SM2084.2 +046300 MOVE "XII-8 3.4 (GR10)" TO ANSI-REFERENCE. SM2084.2 +046400 MOVE "REP-TEST-4" TO PAR-NAME. SM2084.2 +046500 MOVE SPACE TO WRK-XN-00001. SM2084.2 +046600 REP-TEST-4-0. SM2084.2 +046700 REPLACE ==MOVE "*" AO WRK-XN-00001. SM2084.2 +046800 IE WRK-XN-00001 = "*"== SM2084.2 +046900 BY SM2084.2 +047000 ==MOVE "*" TO WRK-XN-00001. SM2084.2 +047100 SM2084.2 +047200 IF WRK-XN-00001 = "*"==. SM2084.2 +047300 GO TO REP-TEST-4-1. SM2084.2 +047400 REP-DELETE-4. SM2084.2 +047500 PERFORM DE-LETE. SM2084.2 +047600 PERFORM PRINT-DETAIL. SM2084.2 +047700 GO TO REP-INIT-5. SM2084.2 +047800 REP-TEST-4-1. SM2084.2 +047900 MOVE "*" AO WRK-XN-00001. SM2084.2 +048000 IE WRK-XN-00001 = "*" SM2084.2 +048100 PERFORM PASS SM2084.2 +048200 PERFORM PRINT-DETAIL SM2084.2 +048300 ELSE SM2084.2 +048400 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +048500 MOVE "*" TO CORRECT-X SM2084.2 +048600 MOVE WRK-XN-00001 TO COMPUTED-X SM2084.2 +048700 PERFORM FAIL SM2084.2 +048800 PERFORM PRINT-DETAIL. SM2084.2 +048900 REPLACE OFF. SM2084.2 +049000* SM2084.2 +049100 REP-INIT-5. SM2084.2 +049200* ===--> DELETING SOURCE <--=== SM2084.2 +049300 MOVE "XII-6 3.3 (SR4)" TO ANSI-REFERENCE. SM2084.2 +049400 MOVE "REP-TEST-5" TO PAR-NAME. SM2084.2 +049500 MOVE SPACES TO WRK-XN-00020 WRK-XN-00001. SM2084.2 +049600 REP-TEST-5-0. SM2084.2 +049700 REPLACE ==NOT== BY ====. SM2084.2 +049800 MOVE "AA BB CC DD EE FF GG" TO WRK-XN-00020. SM2084.2 +049900 IF WRK-XN-00020 NOT EQUAL SPACES SM2084.2 +050000 MOVE "*" TO WRK-XN-00001. SM2084.2 +050100 REPLACE OFF. SM2084.2 +050200 GO TO REP-TEST-5-1. SM2084.2 +050300 REP-DELETE-5. SM2084.2 +050400 PERFORM DE-LETE. SM2084.2 +050500 PERFORM PRINT-DETAIL. SM2084.2 +050600 GO TO REP-INIT-6. SM2084.2 +050700 REP-TEST-5-1. SM2084.2 +050800 IF WRK-XN-00001 EQUAL SPACES SM2084.2 +050900 PERFORM PASS SM2084.2 +051000 PERFORM PRINT-DETAIL SM2084.2 +051100 ELSE SM2084.2 +051200 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +051300 PERFORM FAIL SM2084.2 +051400 PERFORM PRINT-DETAIL. SM2084.2 +051500* SM2084.2 +051600 REP-INIT-6. SM2084.2 +051700* ===--> EMBEDDED COMMENT AND BLANK LINES <--=== SM2084.2 +051800 MOVE "XII-7/8 3.4 (GR7)" TO ANSI-REFERENCE. SM2084.2 +051900 MOVE "REP-TEST-6" TO PAR-NAME. SM2084.2 +052000 REP-TEST-6-0. SM2084.2 +052100 REPLACE ==MOVE "FAIL" TO== SM2084.2 +052200 BY ==MOVE "PASS" TO==. SM2084.2 +052300 MOVE SM2084.2 +052400* SM2084.2 +052500* SM2084.2 +052600* SM2084.2 +052700 "FAIL" SM2084.2 +052800 SM2084.2 +052900 TO P-OR-F. SM2084.2 +053000 SM2084.2 +053100* SM2084.2 +053200 REPLACE OFF. SM2084.2 +053300 GO TO REP-TEST-6-1. SM2084.2 +053400 REP-DELETE-6. SM2084.2 +053500 PERFORM DE-LETE. SM2084.2 +053600 PERFORM PRINT-DETAIL. SM2084.2 +053700 GO TO REP-INIT-7. SM2084.2 +053800 REP-TEST-6-1. SM2084.2 +053900 IF P-OR-F = "PASS" SM2084.2 +054000 PERFORM PASS SM2084.2 +054100 PERFORM PRINT-DETAIL SM2084.2 +054200 ELSE SM2084.2 +054300 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +054400 MOVE "PASS" TO CORRECT-X SM2084.2 +054500 MOVE P-OR-F TO COMPUTED-X SM2084.2 +054600 PERFORM FAIL SM2084.2 +054700 PERFORM PRINT-DETAIL. SM2084.2 +054800* SM2084.2 +054900 REP-INIT-7. SM2084.2 +055000* ===--> EMBEDDED DEBUG LINES <--=== SM2084.2 +055100 MOVE "XII-8 3.4 (GR8)" TO ANSI-REFERENCE. SM2084.2 +055200 MOVE "REP-TEST-7" TO PAR-NAME. SM2084.2 +055300 MOVE "A" TO WS-A. SM2084.2 +055400 MOVE "B" TO WS-B. SM2084.2 +055500 MOVE "C" TO WS-C. SM2084.2 +055600 MOVE "D" TO WS-D. SM2084.2 +055700 MOVE "E" TO WS-E. SM2084.2 +055800 MOVE "F" TO WS-F. SM2084.2 +055900 REP-TEST-7-0. SM2084.2 +056000 REPLACE ==MOVE WS-A TO WS-B== SM2084.2 +056100 BY ==MOVE WS-C TO WS-B== SM2084.2 +056200 ==MOVE WS-D TO WS-F== SM2084.2 +056300 BY ==MOVE WS-E TO WS-F==. SM2084.2 +056400 SM2084.2 +056500 MOVE WS-A TO WS-B. SM2084.2 +056600 SM2084.2 +056700*D MOVE SM2084.2 +056800*D WS-D SM2084.2 +056900*D TO WS-F. SM2084.2 +057000 SM2084.2 +057100* SM2084.2 +057200 REPLACE OFF. SM2084.2 +057300* GO TO REP-TEST-7-1. SM2084.2 +057400 REP-DELETE-7. SM2084.2 +057500 PERFORM DE-LETE. SM2084.2 +057600 PERFORM PRINT-DETAIL. SM2084.2 +057700 GO TO REP-INIT-8. SM2084.2 +057800 REP-TEST-7-1. SM2084.2 +057900 IF WS-B = "C" SM2084.2 +058000 PERFORM PASS SM2084.2 +058100 PERFORM PRINT-DETAIL SM2084.2 +058200 ELSE SM2084.2 +058300 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +058400 MOVE "C" TO CORRECT-X SM2084.2 +058500 MOVE WS-B TO COMPUTED-X SM2084.2 +058600 PERFORM FAIL SM2084.2 +058700 PERFORM PRINT-DETAIL. SM2084.2 +058800* SM2084.2 +058900 REP-INIT-8. SM2084.2 +059000* ===--> SEPARATORS <--=== SM2084.2 +059100 MOVE "XII-7 3.4 GR6(b)" TO ANSI-REFERENCE. SM2084.2 +059200 MOVE "REP-TEST-8" TO PAR-NAME. SM2084.2 +059300 MOVE SPACES TO P-OR-F. SM2084.2 +059400 REP-TEST-8-0. SM2084.2 +059500 REPLACE ==MOVE; "FAIL" , TO== SM2084.2 +059600 BY ==MOVE "PASS" TO==. SM2084.2 +059700 MOVE , "FAIL"; TO P-OR-F. SM2084.2 +059800 REPLACE OFF. SM2084.2 +059900 GO TO REP-TEST-8-1. SM2084.2 +060000 REP-DELETE-8. SM2084.2 +060100 PERFORM DE-LETE. SM2084.2 +060200 PERFORM PRINT-DETAIL. SM2084.2 +060300 GO TO REP-INIT-9. SM2084.2 +060400 REP-TEST-8-1. SM2084.2 +060500 IF P-OR-F = "PASS" SM2084.2 +060600 PERFORM PASS SM2084.2 +060700 PERFORM PRINT-DETAIL SM2084.2 +060800 ELSE SM2084.2 +060900 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +061000 MOVE "PASS" TO CORRECT-X SM2084.2 +061100 MOVE P-OR-F TO COMPUTED-X SM2084.2 +061200 PERFORM FAIL SM2084.2 +061300 PERFORM PRINT-DETAIL. SM2084.2 +061400* SM2084.2 +061500 REP-INIT-9. SM2084.2 +061600* ===--> SEQUENCE OF COPY AND REPLACE STATEMENTS <--=== SM2084.2 +061700 MOVE "XII-7 3.4 GR4" TO ANSI-REFERENCE. SM2084.2 +061800 MOVE "REP-TEST-9" TO PAR-NAME. SM2084.2 +061900 MOVE "FAIL" TO P-OR-F. SM2084.2 +062000 REP-TEST-9-0. SM2084.2 +062100 REPLACE =="FAIL"== BY =="PASS"==. SM2084.2 +062200 COPY KK208A. SM2084.2 +062300 REPLACE OFF. SM2084.2 +062400 GO TO REP-TEST-9-1. SM2084.2 +062500 REP-DELETE-9. SM2084.2 +062600 PERFORM DE-LETE. SM2084.2 +062700 PERFORM PRINT-DETAIL. SM2084.2 +062800 GO TO CCVS-EXIT. SM2084.2 +062900 REP-TEST-9-1. SM2084.2 +063000 IF P-OR-F = "PASS" SM2084.2 +063100 PERFORM PASS SM2084.2 +063200 PERFORM PRINT-DETAIL SM2084.2 +063300 ELSE SM2084.2 +063400 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +063500 MOVE "PASS" TO CORRECT-X SM2084.2 +063600 MOVE P-OR-F TO COMPUTED-X SM2084.2 +063700 PERFORM FAIL SM2084.2 +063800 PERFORM PRINT-DETAIL. SM2084.2 +063900* SM2084.2 +064000 CCVS-EXIT SECTION. SM2084.2 +064100 CCVS-999999. SM2084.2 +064200 GO TO CLOSE-FILES. SM2084.2 +*END-OF,SM208A +*HEADER,COBOL,SM301M +000100 IDENTIFICATION DIVISION. SM3014.2 +000200 PROGRAM-ID. SM3014.2 +000300 SM301M. SM3014.2 +000400*The following program tests the flagging of the intermediate SM3014.2 +000500*subset COPY feature. SM3014.2 +000600 ENVIRONMENT DIVISION. SM3014.2 +000700 CONFIGURATION SECTION. SM3014.2 +000800 SOURCE-COMPUTER. SM3014.2 +000900 XXXXX082. SM3014.2 +001000 OBJECT-COMPUTER. SM3014.2 +001100 XXXXX083. SM3014.2 +001200 SM3014.2 +001300 SM3014.2 +001400 DATA DIVISION. SM3014.2 +001500 SM3014.2 +001600 PROCEDURE DIVISION. SM3014.2 +001700 SM3014.2 +001800 SM301M-CONTROL. SM3014.2 +001900 PERFORM SM301M-COPY. SM3014.2 +002000 STOP RUN. SM3014.2 +002100 SM3014.2 +002200 SM301M-COPY. SM3014.2 +002300*Message expected for following statement: NON-CONFORMING STANDARDSM3014.2 +002400 COPY KSM31. SM3014.2 +002500 SM3014.2 +002600 SM3014.2 +002700*TOTAL NUMBER OF FLAGS EXPECTED = 1. SM3014.2 +*END-OF,SM301M +*HEADER,COBOL,SM401M +000100 IDENTIFICATION DIVISION. SM4014.2 +000200 PROGRAM-ID. SM4014.2 +000300 SM401M. SM4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH SM4014.2 +000500*SUBSET FEATURES THAT ARE USED IN SOURCE TEXT SM4014.2 +000600*MANIPULATION. SM4014.2 +000700 ENVIRONMENT DIVISION. SM4014.2 +000800 CONFIGURATION SECTION. SM4014.2 +000900 SOURCE-COMPUTER. SM4014.2 +001000 XXXXX082. SM4014.2 +001100 OBJECT-COMPUTER. SM4014.2 +001200 XXXXX083. SM4014.2 +001300 SM4014.2 +001400 SM4014.2 +001500 DATA DIVISION. SM4014.2 +001600 PROCEDURE DIVISION. SM4014.2 +001700 SM4014.2 +001800 SM401M-CONTROL. SM4014.2 +001900 PERFORM SM401M-COPYREP THRU SM401M-REPL. SM4014.2 +002000 STOP RUN. SM4014.2 +002100 SM4014.2 +002200 SM401M-COPYREP. SM4014.2 +002300*Message expected for following statement: NON-CONFORMING STANDARDSM3014.2 +002400 COPY KSM41 REPLACING "PIG" BY "HORSE". SM4014.2 +002500 SM4014.2 +002600 SM401M-REPL. SM4014.2 +002700 REPLACE OFF. SM4014.2 +002800*Message expected for above statement: NON-CONFORMING STANDARD SM4014.2 +002900 SM4014.2 +003000*TOTAL NUMBER OF FLAGS EXPECTED = 2. SM4014.2 +*END-OF,SM401M +*HEADER,COBOL,SQ101M +000100 IDENTIFICATION DIVISION. SQ1014.2 +000200 PROGRAM-ID. SQ1014.2 +000300 SQ101M. SQ1014.2 +000400**************************************************************** SQ1014.2 +000500* * SQ1014.2 +000600* VALIDATION FOR:- * SQ1014.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1014.2 +000900* REVISED 1986, AUGUST * SQ1014.2 +001000* * SQ1014.2 +001100* CREATION DATE / VALIDATION DATE * SQ1014.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1014.2 +001300* * SQ1014.2 +001400**************************************************************** SQ1014.2 +001500* * SQ1014.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1014.2 +001700* * SQ1014.2 +001800* X-55 SYSTEM PRINTER * SQ1014.2 +001900* X-82 SOURCE-COMPUTER * SQ1014.2 +002000* X-83 OBJECT-COMPUTER. * SQ1014.2 +002100* * SQ1014.2 +002200**************************************************************** SQ1014.2 +002300* * SQ1014.2 +002400* SQ101M TESTS THE LEVEL 1 FACILITIES FOR CONTROL OF THE * SQ1014.2 +002500* POSITION OF LINES ON A PRINTED PAGE. THE PRINCIPAL * SQ1014.2 +002600* FACILITY IS THE ADVANCING PHRASE OF THE WRITE STATEMENT * SQ1014.2 +002700* WHEN THE ASSOCIATED PHYSICAL FILE IS DESIGNATED AS A * SQ1014.2 +002800* PRINTER. THE FROM PHRASE OF THE WRITE STATEMENT IS ALSO * SQ1014.2 +002900* TESTED. * SQ1014.2 +003000* * SQ1014.2 +003100* ALL POSSIBLE LEVEL 1 COMBINATIONS OF THE FORMAT OF THE * SQ1014.2 +003200* ADVANCING PHRASE ARE TESTED WITH AND WITHOUT THE FROM * SQ1014.2 +003300* PHRASE. THE VALUES USED FOR INTEGER INCLUDE ONE-DIGIT * SQ1014.2 +003400* AND TWO-DIGIT UNSIGNED NUMERIC LITERALS, EIGHTEEN DIGIT * SQ1014.2 +003500* NUMERIC LITERALS WITH LEADING ZEROS, AND THE FIGURATIVE * SQ1014.2 +003600* CONSTANT ZERO. DATA ITEMS USED AS IDENTIFIER-2 INCLUDE * SQ1014.2 +003700* LEVEL 77, LEVEL 01, AND SUBORDINATE ELEMENTARY ITEMS. A * SQ1014.2 +003800* SIMILAR RANGE OF TYPES, BUT INCLUDING GROUP ITEMS, IS * SQ1014.2 +003900* USED FOR IDENTIFIER-2. * SQ1014.2 +004000* * SQ1014.2 +004100* IN ADDITION TO THE ABOVE TESTS, A TEST IS MADE TO ENSURE * SQ1014.2 +004200* THAT CHARACTERS DESIGNATED TO BE PRINTED IN COLUMN 1 DO * SQ1014.2 +004300* NOT ACT AS CARRIAGE CONTROL CHARACTERS. * SQ1014.2 +004400* * SQ1014.2 +004500* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" * SQ1014.2 +004600* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE PRINTED * SQ1014.2 +004700* OUTPUT MUST BE EXAMINED TO DETERMINE WHETHER EACH TEST * SQ1014.2 +004800* HAS BEEN PASSED OR FAILED. * SQ1014.2 +004900* * SQ1014.2 +005000**************************************************************** SQ1014.2 +005100* SQ1014.2 +005200* SQ1014.2 +005300 ENVIRONMENT DIVISION. SQ1014.2 +005400 CONFIGURATION SECTION. SQ1014.2 +005500 SOURCE-COMPUTER. SQ1014.2 +005600 XXXXX082. SQ1014.2 +005700 OBJECT-COMPUTER. SQ1014.2 +005800 XXXXX083. SQ1014.2 +005900* SQ1014.2 +006000 INPUT-OUTPUT SECTION. SQ1014.2 +006100 FILE-CONTROL. SQ1014.2 +006200 SELECT PRINT-FILE ASSIGN TO SQ1014.2 +006300 XXXXX055. SQ1014.2 +006400* SQ1014.2 +006500P SELECT RAW-DATA ASSIGN TO SQ1014.2 +006600P XXXXX062 SQ1014.2 +006700P ORGANIZATION IS INDEXED SQ1014.2 +006800P ACCESS MODE IS RANDOM SQ1014.2 +006900P RECORD-KEY IS RAW-DATA-KEY. SQ1014.2 +007000P SQ1014.2 +007100* SQ1014.2 +007200 DATA DIVISION. SQ1014.2 +007300 FILE SECTION. SQ1014.2 +007400 FD PRINT-FILE SQ1014.2 +007500C LABEL RECORDS SQ1014.2 +007600C XXXXX084 SQ1014.2 +007700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1014.2 +007800 . SQ1014.2 +007900 01 PRINT-REC PICTURE X(120). SQ1014.2 +008000 01 DUMMY-RECORD PICTURE X(120). SQ1014.2 +008100P SQ1014.2 +008200PFD RAW-DATA. SQ1014.2 +008300P01 RAW-DATA-SATZ. SQ1014.2 +008400P 05 RAW-DATA-KEY PIC X(6). SQ1014.2 +008500P 05 C-DATE PIC 9(6). SQ1014.2 +008600P 05 C-TIME PIC 9(8). SQ1014.2 +008700P 05 NO-OF-TESTS PIC 99. SQ1014.2 +008800P 05 C-OK PIC 999. SQ1014.2 +008900P 05 C-ALL PIC 999. SQ1014.2 +009000P 05 C-FAIL PIC 999. SQ1014.2 +009100P 05 C-DELETED PIC 999. SQ1014.2 +009200P 05 C-INSPECT PIC 999. SQ1014.2 +009300P 05 C-NOTE PIC X(13). SQ1014.2 +009400P 05 C-INDENT PIC X. SQ1014.2 +009500P 05 C-ABORT PIC X(8). SQ1014.2 +009600* SQ1014.2 +009700* SQ1014.2 +009800 WORKING-STORAGE SECTION. SQ1014.2 +009900* SQ1014.2 +010000*************************************************************** SQ1014.2 +010100* * SQ1014.2 +010200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1014.2 +010300* * SQ1014.2 +010400*************************************************************** SQ1014.2 +010500* SQ1014.2 +010600 77 QU-OTE PIC X VALUE QUOTE. SQ1014.2 +010700 77 IDENTIFIER-2 PIC 99 VALUE 0. SQ1014.2 +010800 77 LONG-ZERO PIC 9(18) VALUE 0. SQ1014.2 +010900 77 LONG-ONE PIC 9(18) VALUE 1. SQ1014.2 +011000 01 IDENT-2-S99 PIC S99. SQ1014.2 +011100 01 IDENT-2-C99 PIC 99 COMP. SQ1014.2 +011200* SQ1014.2 +011300 01 ONE PIC 9 VALUE 1. SQ1014.2 +011400* SQ1014.2 +011500 01 SPACING-VALUES-1. SQ1014.2 +011600 02 TWO PIC 9 VALUE 2. SQ1014.2 +011700 02 SPACING-VALUES-2. SQ1014.2 +011800 03 THREE PIC 9 VALUE 3. SQ1014.2 +011900 03 SPACING-VALUES-3. SQ1014.2 +012000 04 FOUR PIC 9 VALUE 4. SQ1014.2 +012100* SQ1014.2 +012200 01 CHAR-LINE. SQ1014.2 +012300 03 LIN-CH PIC X. SQ1014.2 +012400 03 FILLER PIC X. SQ1014.2 +012500 03 LIN-SER PIC 999. SQ1014.2 +012600 03 FILLER PIC X(115). SQ1014.2 +012700* SQ1014.2 +012800 77 SEVENTY-SEVEN PIC X(120) VALUE " THIS WAS WRITTEN FROMSQ1014.2 +012900- " A 77 LEVEL ENTRY. IT SHOULD BE 2 LINES BELOW AND 1 LINE ABSQ1014.2 +013000- "OVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013100* SQ1014.2 +013200 77 SEVENTY-SEVEN-2 PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +013300- "FROM A 77 LEVEL ENTRY. IT SHOULD BE 7 LINES BELOW AND 1 LINSQ1014.2 +013400- "E ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013500* SQ1014.2 +013600 01 OH-ONE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +013700- "FROM AN 01 LEVEL ENTRY. IT SHOULD BE 1 LINE BELOW AND 5 LINESQ1014.2 +013800- "S ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013900* SQ1014.2 +014000 01 LEVEL-1. SQ1014.2 +014100 03 OH-THREE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +014200- "FROM AN 03 LEVEL ENTRY. IT SHOULD BE 1 LINE BELOW AND 6 LSQ1014.2 +014300- "INES ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +014400* SQ1014.2 +014500 01 TEST-LINE-1. SQ1014.2 +014600 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +014700 02 FILLER PIC X(20) VALUE "THIS LINE SHOULD BE ". SQ1014.2 +014800 02 LINES-BELOW-1 PIC XX. SQ1014.2 +014900 02 FILLER PIC X(17) VALUE " LINES BELOW AND ". SQ1014.2 +015000 02 LINES-ABOVE-1 PIC XX. SQ1014.2 +015100 02 FILLER PIC X(59) VALUE SQ1014.2 +015200 " LINES ABOVE THE BRACKETING WRT-TEST LINES". SQ1014.2 +015300* SQ1014.2 +015400 01 LEVEL-ONE. SQ1014.2 +015500 02 LEVEL-TWO. SQ1014.2 +015600 03 TEST-LINE-2. SQ1014.2 +015700 04 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +015800 04 FILLER PIC X(20) VALUE "THIS LINE SHOULD SQ1014.2 +015900- "BE ". SQ1014.2 +016000 04 LINES-BELOW-2 PIC XX. SQ1014.2 +016100 04 FILLER PIC X(17) VALUE " LINES BELOW AND ".SQ1014.2 +016200 04 LINES-ABOVE-2 PIC XX. SQ1014.2 +016300 04 FILLER PIC X(59) VALUE SQ1014.2 +016400 " LINES ABOVE THE BRACKETING WRT-TEST LINES". SQ1014.2 +016500* SQ1014.2 +016600 01 OVERPRINTED-LINE. SQ1014.2 +016700 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +016800 02 FILLER PIC X(9) VALUE "WRT-TEST-". SQ1014.2 +016900 02 OVERPRINTED-TEST PIC XX. SQ1014.2 +017000 02 FILLER PIC X(89) VALUE "/ THIS LINE SHOULD BE SQ1014.2 +017100- "OVERPRINTED. AAAAAAA". SQ1014.2 +017200 01 OVERPRINT-LINE. SQ1014.2 +017300 02 FILLER PIC X(68) VALUE SPACE. SQ1014.2 +017400 02 FILLER PIC X(17) VALUE "BBBBBBB WRT-TEST-". SQ1014.2 +017500 02 OVERPRINT-TEST PIC XX. SQ1014.2 +017600 02 FILLER PIC X(33) VALUE SQ1014.2 +017700 "/ THIS LINE SHOULD OVERPRINT". SQ1014.2 +017800 01 LAST-LINE. SQ1014.2 +017900 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +018000 02 FILLER PIC X(100) VALUE "THIS LINE SHOULD BE 1 SQ1014.2 +018100- "LINE BELOW THE WRT-TEST LINE AND ALSO BE THE LAST LINE ONSQ1014.2 +018200- " THIS PAGE". SQ1014.2 +018300* SQ1014.2 +018400 01 NEW-PAGE-LINE. SQ1014.2 +018500 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +018600 02 FILLER PIC X(100) VALUE "THIS LINE SHOULD APPEASQ1014.2 +018700- "R AT THE TOP OF A NEW PAGE". SQ1014.2 +018800 01 NEXT-LINE. SQ1014.2 +018900 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +019000 02 FILLER PIC X(100) VALUE "A WRT-TEST LINE SHOULDSQ1014.2 +019100- " FOLLOW IMMEDIATELY ON THE NEXT LINE". SQ1014.2 +019200* SQ1014.2 +019300 01 NOTE-1. SQ1014.2 +019400 02 FILLER PIC X(40) VALUE "BECAUSE OF THE NATURE SQ1014.2 +019500- "OF THESE TESTS A ". SQ1014.2 +019600 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +019700 02 FILLER PIC X(4) VALUE "PASS". SQ1014.2 +019800 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +019900 02 FILLER PIC X(4) VALUE " OR ". SQ1014.2 +020000 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +020100 02 FILLER PIC X(4) VALUE "FAIL". SQ1014.2 +020200 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +020300 02 FILLER PIC X(64) VALUE " CANNOT BE DETERMINED SQ1014.2 +020400- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ1014.2 +020500 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ1014.2 +020600- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ1014.2 +020700- "IONS. NOTE THAT SOME OVERPRINTING". SQ1014.2 +020800 01 NOTE-3 PIC X(120) VALUE "SHOULD OCCUR, AND IN ESQ1014.2 +020900- "VERY CASE THE OVERPRINTED LINE WILL READ---". SQ1014.2 +021000 01 NOTE-4. SQ1014.2 +021100 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +021200 02 FILLER PIC X(100) VALUE "WRT-TEST-XX/ THIS LINESQ1014.2 +021300- " SHOULD BE OVERPRINTED. AAAAAAA". SQ1014.2 +021400 01 NOTE-5 PIC X(120) VALUE "---AND THE LINE WHICH SQ1014.2 +021500- "OVERPRINTS SHOULD READ---". SQ1014.2 +021600 01 NOTE-6. SQ1014.2 +021700 02 FILLER PIC X(68) VALUE SPACE. SQ1014.2 +021800 02 FILLER PIC X(52) VALUE "BBBBBBB WRT-TEST-XX/ TSQ1014.2 +021900- "HIS LINE SHOULD OVERPRINT". SQ1014.2 +022000 01 NOTE-7 PIC X(120) VALUE "ONLY FIVE OF THE LETTESQ1014.2 +022100- "RS A AND B SHOULD BE JUMBLED TOGETHER; THE REST SHOULD BE RESQ1014.2 +022200- "ADABLE. IF ANY OTHER LINE IS". SQ1014.2 +022300* SQ1014.2 +022400 01 NOTE-8 PIC X(120) VALUE SQ1014.2 +022500 "INVOLVED IN OVERPRINTING, AN ERROR HAS OCCURRED". SQ1014.2 +022600* SQ1014.2 +022700*************************************************************** SQ1014.2 +022800* * SQ1014.2 +022900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1014.2 +023000* * SQ1014.2 +023100*************************************************************** SQ1014.2 +023200* SQ1014.2 +023300 01 REC-SKEL-SUB PIC 99. SQ1014.2 +023400* SQ1014.2 +023500 01 FILE-RECORD-INFORMATION-REC. SQ1014.2 +023600 03 FILE-RECORD-INFO-SKELETON. SQ1014.2 +023700 05 FILLER PICTURE X(48) VALUE SQ1014.2 +023800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1014.2 +023900 05 FILLER PICTURE X(46) VALUE SQ1014.2 +024000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1014.2 +024100 05 FILLER PICTURE X(26) VALUE SQ1014.2 +024200 ",LFIL=000000,ORG= ,LBLR= ". SQ1014.2 +024300 05 FILLER PICTURE X(37) VALUE SQ1014.2 +024400 ",RECKEY= ". SQ1014.2 +024500 05 FILLER PICTURE X(38) VALUE SQ1014.2 +024600 ",ALTKEY1= ". SQ1014.2 +024700 05 FILLER PICTURE X(38) VALUE SQ1014.2 +024800 ",ALTKEY2= ". SQ1014.2 +024900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1014.2 +025000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1014.2 +025100 05 FILE-RECORD-INFO-P1-120. SQ1014.2 +025200 07 FILLER PIC X(5). SQ1014.2 +025300 07 XFILE-NAME PIC X(6). SQ1014.2 +025400 07 FILLER PIC X(8). SQ1014.2 +025500 07 XRECORD-NAME PIC X(6). SQ1014.2 +025600 07 FILLER PIC X(1). SQ1014.2 +025700 07 REELUNIT-NUMBER PIC 9(1). SQ1014.2 +025800 07 FILLER PIC X(7). SQ1014.2 +025900 07 XRECORD-NUMBER PIC 9(6). SQ1014.2 +026000 07 FILLER PIC X(6). SQ1014.2 +026100 07 UPDATE-NUMBER PIC 9(2). SQ1014.2 +026200 07 FILLER PIC X(5). SQ1014.2 +026300 07 ODO-NUMBER PIC 9(4). SQ1014.2 +026400 07 FILLER PIC X(5). SQ1014.2 +026500 07 XPROGRAM-NAME PIC X(5). SQ1014.2 +026600 07 FILLER PIC X(7). SQ1014.2 +026700 07 XRECORD-LENGTH PIC 9(6). SQ1014.2 +026800 07 FILLER PIC X(7). SQ1014.2 +026900 07 CHARS-OR-RECORDS PIC X(2). SQ1014.2 +027000 07 FILLER PIC X(1). SQ1014.2 +027100 07 XBLOCK-SIZE PIC 9(4). SQ1014.2 +027200 07 FILLER PIC X(6). SQ1014.2 +027300 07 RECORDS-IN-FILE PIC 9(6). SQ1014.2 +027400 07 FILLER PIC X(5). SQ1014.2 +027500 07 XFILE-ORGANIZATION PIC X(2). SQ1014.2 +027600 07 FILLER PIC X(6). SQ1014.2 +027700 07 XLABEL-TYPE PIC X(1). SQ1014.2 +027800 05 FILE-RECORD-INFO-P121-240. SQ1014.2 +027900 07 FILLER PIC X(8). SQ1014.2 +028000 07 XRECORD-KEY PIC X(29). SQ1014.2 +028100 07 FILLER PIC X(9). SQ1014.2 +028200 07 ALTERNATE-KEY1 PIC X(29). SQ1014.2 +028300 07 FILLER PIC X(9). SQ1014.2 +028400 07 ALTERNATE-KEY2 PIC X(29). SQ1014.2 +028500 07 FILLER PIC X(7). SQ1014.2 +028600* SQ1014.2 +028700 01 TEST-RESULTS. SQ1014.2 +028800 02 FILLER PIC X VALUE SPACE. SQ1014.2 +028900 02 FEATURE PIC X(24) VALUE SPACE. SQ1014.2 +029000 02 FILLER PIC X VALUE SPACE. SQ1014.2 +029100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1014.2 +029200 02 FILLER PIC X VALUE SPACE. SQ1014.2 +029300 02 PAR-NAME. SQ1014.2 +029400 03 FILLER PIC X(14) VALUE SPACE. SQ1014.2 +029500 03 PARDOT-X PIC X VALUE SPACE. SQ1014.2 +029600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1014.2 +029700 02 FILLER PIC X(9) VALUE SPACE. SQ1014.2 +029800 02 RE-MARK PIC X(61). SQ1014.2 +029900 01 TEST-COMPUTED. SQ1014.2 +030000 02 FILLER PIC X(30) VALUE SPACE. SQ1014.2 +030100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1014.2 +030200 02 COMPUTED-X. SQ1014.2 +030300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1014.2 +030400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1014.2 +030500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1014.2 +030600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1014.2 +030700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1014.2 +030800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1014.2 +030900 04 COMPUTED-18V0 PIC -9(18). SQ1014.2 +031000 04 FILLER PIC X. SQ1014.2 +031100 03 FILLER PIC X(50) VALUE SPACE. SQ1014.2 +031200 01 TEST-CORRECT. SQ1014.2 +031300 02 FILLER PIC X(30) VALUE SPACE. SQ1014.2 +031400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1014.2 +031500 02 CORRECT-X. SQ1014.2 +031600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1014.2 +031700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1014.2 +031800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1014.2 +031900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1014.2 +032000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1014.2 +032100 03 CR-18V0 REDEFINES CORRECT-A. SQ1014.2 +032200 04 CORRECT-18V0 PIC -9(18). SQ1014.2 +032300 04 FILLER PIC X. SQ1014.2 +032400 03 FILLER PIC X(2) VALUE SPACE. SQ1014.2 +032500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1014.2 +032600 01 CCVS-C-1. SQ1014.2 +032700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1014.2 +032800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1014.2 +032900- "SS PARAGRAPH-NAME SQ1014.2 +033000- " REMARKS". SQ1014.2 +033100 02 FILLER PIC X(17) VALUE SPACE. SQ1014.2 +033200 01 CCVS-C-2. SQ1014.2 +033300 02 FILLER PIC XXXX VALUE SPACE. SQ1014.2 +033400 02 FILLER PIC X(6) VALUE "TESTED". SQ1014.2 +033500 02 FILLER PIC X(16) VALUE SPACE. SQ1014.2 +033600 02 FILLER PIC X(4) VALUE "FAIL". SQ1014.2 +033700 02 FILLER PIC X(90) VALUE SPACE. SQ1014.2 +033800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1014.2 +033900 01 REC-CT PIC 99 VALUE ZERO. SQ1014.2 +034000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1014.2 +034500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1014.2 +034600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1014.2 +034700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1014.2 +034800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1014.2 +034900 01 CCVS-H-1. SQ1014.2 +035000 02 FILLER PIC X(39) VALUE SPACES. SQ1014.2 +035100 02 FILLER PIC X(42) VALUE SQ1014.2 +035200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1014.2 +035300 02 FILLER PIC X(39) VALUE SPACES. SQ1014.2 +035400 01 CCVS-H-2A. SQ1014.2 +035500 02 FILLER PIC X(40) VALUE SPACE. SQ1014.2 +035600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1014.2 +035700 02 FILLER PIC XXXX VALUE SQ1014.2 +035800 "4.2 ". SQ1014.2 +035900 02 FILLER PIC X(28) VALUE SQ1014.2 +036000 " COPY - NOT FOR DISTRIBUTION". SQ1014.2 +036100 02 FILLER PIC X(41) VALUE SPACE. SQ1014.2 +036200* SQ1014.2 +036300 01 CCVS-H-2B. SQ1014.2 +036400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1014.2 +036500 02 TEST-ID PIC X(9). SQ1014.2 +036600 02 FILLER PIC X(4) VALUE " IN ". SQ1014.2 +036700 02 FILLER PIC X(12) VALUE SQ1014.2 +036800 " HIGH ". SQ1014.2 +036900 02 FILLER PIC X(22) VALUE SQ1014.2 +037000 " LEVEL VALIDATION FOR ". SQ1014.2 +037100 02 FILLER PIC X(58) VALUE SQ1014.2 +037200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +037300 01 CCVS-H-3. SQ1014.2 +037400 02 FILLER PIC X(34) VALUE SQ1014.2 +037500 " FOR OFFICIAL USE ONLY ". SQ1014.2 +037600 02 FILLER PIC X(58) VALUE SQ1014.2 +037700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1014.2 +037800 02 FILLER PIC X(28) VALUE SQ1014.2 +037900 " COPYRIGHT 1985,1986 ". SQ1014.2 +038000 01 CCVS-E-1. SQ1014.2 +038100 02 FILLER PIC X(52) VALUE SPACE. SQ1014.2 +038200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1014.2 +038300 02 ID-AGAIN PIC X(9). SQ1014.2 +038400 02 FILLER PIC X(45) VALUE SPACES. SQ1014.2 +038500 01 CCVS-E-2. SQ1014.2 +038600 02 FILLER PIC X(31) VALUE SPACE. SQ1014.2 +038700 02 FILLER PIC X(21) VALUE SPACE. SQ1014.2 +038800 02 CCVS-E-2-2. SQ1014.2 +038900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1014.2 +039000 03 FILLER PIC X VALUE SPACE. SQ1014.2 +039100 03 ENDER-DESC PIC X(44) VALUE SQ1014.2 +039200 "ERRORS ENCOUNTERED". SQ1014.2 +039300 01 CCVS-E-3. SQ1014.2 +039400 02 FILLER PIC X(22) VALUE SQ1014.2 +039500 " FOR OFFICIAL USE ONLY". SQ1014.2 +039600 02 FILLER PIC X(12) VALUE SPACE. SQ1014.2 +039700 02 FILLER PIC X(58) VALUE SQ1014.2 +039800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +039900 02 FILLER PIC X(8) VALUE SPACE. SQ1014.2 +040000 02 FILLER PIC X(20) VALUE SQ1014.2 +040100 " COPYRIGHT 1985,1986". SQ1014.2 +040200 01 CCVS-E-4. SQ1014.2 +040300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1014.2 +040400 02 FILLER PIC X(4) VALUE " OF ". SQ1014.2 +040500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1014.2 +040600 02 FILLER PIC X(40) VALUE SQ1014.2 +040700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1014.2 +040800 01 XXINFO. SQ1014.2 +040900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1014.2 +041000 02 INFO-TEXT. SQ1014.2 +041100 04 FILLER PIC X(8) VALUE SPACE. SQ1014.2 +041200 04 XXCOMPUTED PIC X(20). SQ1014.2 +041300 04 FILLER PIC X(5) VALUE SPACE. SQ1014.2 +041400 04 XXCORRECT PIC X(20). SQ1014.2 +041500 02 INF-ANSI-REFERENCE PIC X(48). SQ1014.2 +041600 01 HYPHEN-LINE. SQ1014.2 +041700 02 FILLER PIC IS X VALUE IS SPACE. SQ1014.2 +041800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1014.2 +041900- "*****************************************". SQ1014.2 +042000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1014.2 +042100- "******************************". SQ1014.2 +042200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1014.2 +042300 "SQ101M". SQ1014.2 +042400 PROCEDURE DIVISION. SQ1014.2 +042500 CCVS1 SECTION. SQ1014.2 +042600 OPEN-FILES. SQ1014.2 +042700P OPEN I-O RAW-DATA. SQ1014.2 +042800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1014.2 +042900P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1014.2 +043000P MOVE "ABORTED " TO C-ABORT. SQ1014.2 +043100P ADD 1 TO C-NO-OF-TESTS. SQ1014.2 +043200P ACCEPT C-DATE FROM DATE. SQ1014.2 +043300P ACCEPT C-TIME FROM TIME. SQ1014.2 +043400P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1014.2 +043500PEND-E-1. SQ1014.2 +043600P CLOSE RAW-DATA. SQ1014.2 +043700 OPEN OUTPUT PRINT-FILE. SQ1014.2 +043800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1014.2 +043900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1014.2 +044000 MOVE SPACE TO TEST-RESULTS. SQ1014.2 +044100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1014.2 +044200 MOVE ZERO TO REC-SKEL-SUB. SQ1014.2 +044300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1014.2 +044400 GO TO CCVS1-EXIT. SQ1014.2 +044500* SQ1014.2 +044600 CCVS-INIT-FILE. SQ1014.2 +044700 ADD 1 TO REC-SKL-SUB. SQ1014.2 +044800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1014.2 +044900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1014.2 +045000* SQ1014.2 +045100 CLOSE-FILES. SQ1014.2 +045200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1014.2 +045300 CLOSE PRINT-FILE. SQ1014.2 +045400P OPEN I-O RAW-DATA. SQ1014.2 +045500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1014.2 +045600P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1014.2 +045700P MOVE "OK. " TO C-ABORT. SQ1014.2 +045800P MOVE PASS-COUNTER TO C-OK. SQ1014.2 +045900P MOVE ERROR-HOLD TO C-ALL. SQ1014.2 +046000P MOVE ERROR-COUNTER TO C-FAIL. SQ1014.2 +046100P MOVE DELETE-CNT TO C-DELETED. SQ1014.2 +046200P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1014.2 +046300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1014.2 +046400PEND-E-2. SQ1014.2 +046500P CLOSE RAW-DATA. SQ1014.2 +046600 TERMINATE-CCVS. SQ1014.2 +046700S EXIT PROGRAM. SQ1014.2 +046800 STOP RUN. SQ1014.2 +046900* SQ1014.2 +047000 INSPT. SQ1014.2 +047100 MOVE "INSPT" TO P-OR-F. SQ1014.2 +047200 ADD 1 TO INSPECT-COUNTER. SQ1014.2 +047300* SQ1014.2 +047400 PASS. SQ1014.2 +047500 MOVE "PASS " TO P-OR-F. SQ1014.2 +047600 ADD 1 TO PASS-COUNTER. SQ1014.2 +047700* SQ1014.2 +047800 FAIL. SQ1014.2 +047900 MOVE "FAIL*" TO P-OR-F. SQ1014.2 +048000 ADD 1 TO ERROR-COUNTER. SQ1014.2 +048100* SQ1014.2 +048200 DE-LETE. SQ1014.2 +048300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1014.2 +048400 MOVE "*****" TO P-OR-F. SQ1014.2 +048500 ADD 1 TO DELETE-COUNTER. SQ1014.2 +048600 PERFORM PRINT-DETAIL. SQ1014.2 +048700* SQ1014.2 +048800 PRINT-DETAIL. SQ1014.2 +048900 IF REC-CT NOT EQUAL TO ZERO SQ1014.2 +049000 MOVE "." TO PARDOT-X SQ1014.2 +049100 MOVE REC-CT TO DOTVALUE. SQ1014.2 +049200 MOVE TEST-RESULTS TO PRINT-REC. SQ1014.2 +049300 PERFORM WRITE-LINE. SQ1014.2 +049400 IF P-OR-F EQUAL TO "FAIL*" SQ1014.2 +049500 PERFORM WRITE-LINE SQ1014.2 +049600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1014.2 +049700 ELSE SQ1014.2 +049800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1014.2 +049900 MOVE SPACE TO P-OR-F. SQ1014.2 +050000 MOVE SPACE TO COMPUTED-X. SQ1014.2 +050100 MOVE SPACE TO CORRECT-X. SQ1014.2 +050200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1014.2 +050300 MOVE SPACE TO RE-MARK. SQ1014.2 +050400* SQ1014.2 +050500 HEAD-ROUTINE. SQ1014.2 +050600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +050700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +050800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1014.2 +050900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1014.2 +051000 COLUMN-NAMES-ROUTINE. SQ1014.2 +051100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +051200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +051400 END-ROUTINE. SQ1014.2 +051500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1014.2 +051600 PERFORM WRITE-LINE 5 TIMES. SQ1014.2 +051700 END-RTN-EXIT. SQ1014.2 +051800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1014.2 +051900 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +052000* SQ1014.2 +052100 END-ROUTINE-1. SQ1014.2 +052200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1014.2 +052300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1014.2 +052400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1014.2 +052500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1014.2 +052600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1014.2 +052700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1014.2 +052800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1014.2 +052900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1014.2 +053000 PERFORM WRITE-LINE. SQ1014.2 +053100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1014.2 +053200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1014.2 +053300 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +053400 ELSE SQ1014.2 +053500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1014.2 +053600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1014.2 +053700 PERFORM WRITE-LINE. SQ1014.2 +053800 END-ROUTINE-13. SQ1014.2 +053900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1014.2 +054000 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +054100 ELSE SQ1014.2 +054200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1014.2 +054300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1014.2 +054400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1014.2 +054500 PERFORM WRITE-LINE. SQ1014.2 +054600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1014.2 +054700 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +054800 ELSE SQ1014.2 +054900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1014.2 +055000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1014.2 +055100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +055200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +055300* SQ1014.2 +055400 WRITE-LINE. SQ1014.2 +055500 ADD 1 TO RECORD-COUNT. SQ1014.2 +055600Y IF RECORD-COUNT GREATER 50 SQ1014.2 +055700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1014.2 +055800Y MOVE SPACE TO DUMMY-RECORD SQ1014.2 +055900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1014.2 +056000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1014.2 +056100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1014.2 +056200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1014.2 +056300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1014.2 +056400Y MOVE ZERO TO RECORD-COUNT. SQ1014.2 +056500 PERFORM WRT-LN. SQ1014.2 +056600* SQ1014.2 +056700 WRT-LN. SQ1014.2 +056800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1014.2 +056900 MOVE SPACE TO DUMMY-RECORD. SQ1014.2 +057000 BLANK-LINE-PRINT. SQ1014.2 +057100 PERFORM WRT-LN. SQ1014.2 +057200 FAIL-ROUTINE. SQ1014.2 +057300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1014.2 +057400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1014.2 +057500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1014.2 +057600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1014.2 +057700 MOVE XXINFO TO DUMMY-RECORD. SQ1014.2 +057800 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +057900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1014.2 +058000 GO TO FAIL-ROUTINE-EX. SQ1014.2 +058100 FAIL-ROUTINE-WRITE. SQ1014.2 +058200 MOVE TEST-COMPUTED TO PRINT-REC SQ1014.2 +058300 PERFORM WRITE-LINE SQ1014.2 +058400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1014.2 +058500 MOVE TEST-CORRECT TO PRINT-REC SQ1014.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +058700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1014.2 +058800 FAIL-ROUTINE-EX. SQ1014.2 +058900 EXIT. SQ1014.2 +059000 BAIL-OUT. SQ1014.2 +059100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1014.2 +059200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1014.2 +059300 BAIL-OUT-WRITE. SQ1014.2 +059400 MOVE CORRECT-A TO XXCORRECT. SQ1014.2 +059500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1014.2 +059600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1014.2 +059700 MOVE XXINFO TO DUMMY-RECORD. SQ1014.2 +059800 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +059900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1014.2 +060000 BAIL-OUT-EX. SQ1014.2 +060100 EXIT. SQ1014.2 +060200 CCVS1-EXIT. SQ1014.2 +060300 EXIT. SQ1014.2 +060400* SQ1014.2 +060500**************************************************************** SQ1014.2 +060600* * SQ1014.2 +060700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1014.2 +060800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1014.2 +060900* * SQ1014.2 +061000**************************************************************** SQ1014.2 +061100* SQ1014.2 +061200 SECT-SQ101-0001 SECTION. SQ1014.2 +061300 WRT-PREAMBLE. SQ1014.2 +061400 MOVE NOTE-1 TO PRINT-REC. SQ1014.2 +061500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +061600 MOVE NOTE-2 TO PRINT-REC. SQ1014.2 +061700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +061800 MOVE NOTE-3 TO PRINT-REC. SQ1014.2 +061900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062000 MOVE NOTE-4 TO PRINT-REC. SQ1014.2 +062100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062200 MOVE NOTE-5 TO PRINT-REC. SQ1014.2 +062300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062400 MOVE NOTE-6 TO PRINT-REC. SQ1014.2 +062500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062600 MOVE NOTE-7 TO PRINT-REC. SQ1014.2 +062700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062800 MOVE NOTE-8 TO PRINT-REC. SQ1014.2 +062900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +063000 MOVE SPACE TO DUMMY-RECORD. SQ1014.2 +063100 PERFORM BLANK-LINE-PRINT. SQ1014.2 +063200* SQ1014.2 +063300**************************************************************** SQ1014.2 +063400* * SQ1014.2 +063500* THE STANDARD PAGE HEADING OF THE MONITOR OUTPUT AND THE * SQ1014.2 +063600* PREAMBLE DESCRIBING MONTORING REQUIREMENTS WILL HAVE USED * SQ1014.2 +063700* 24 LINES ON THE FIRST PAGE OF PRINTED OUTPUT. THE TESTS * SQ1014.2 +063800* ARE ARRANGED WHEREVER POSSIBLE SO THAT THE BLANK LINES * SQ1014.2 +063900* WHICH MUST BE COUNTED DO NOT INCLUDE A BOUNDARY BETWEEN * SQ1014.2 +064000* TWO PAGES. * SQ1014.2 +064100* * SQ1014.2 +064200* IT IS ASSUMED THAT A PHYSICAL PAGE CAN SHOW AT LEAST 60 * SQ1014.2 +064300* PRINTED LINES. THERE ARE THUS AT LEAST 36 LINES LEFT ON * SQ1014.2 +064400* THIS FIRST PAGE. * SQ1014.2 +064500* * SQ1014.2 +064600**************************************************************** SQ1014.2 +064700* SQ1014.2 +064800 WRT-INIT-GF-01. SQ1014.2 +064900* SQ1014.2 +065000* THIS TEST ADVANCES THE PRINT POSITION 8 LINES SQ1014.2 +065100* SQ1014.2 +065200 MOVE "WRT BEFORE ADV INT LINES" TO FEATURE. SQ1014.2 +065300 MOVE "WRT-TEST-GF-01" TO PAR-NAME. SQ1014.2 +065400 GO TO WRT-TEST-GF-01. SQ1014.2 +065500 WRT-DELETE-GF-01. SQ1014.2 +065600 PERFORM DE-LETE. SQ1014.2 +065700 GO TO WRT-END-GF-01. SQ1014.2 +065800 WRT-TEST-GF-01. SQ1014.2 +065900 PERFORM INSPT. SQ1014.2 +066000 PERFORM WRITE-TEST-LINE. SQ1014.2 +066100 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +066200 MOVE "8" TO LINES-ABOVE-1. SQ1014.2 +066300 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +066400 WRITE PRINT-REC BEFORE ADVANCING 7 LINES. SQ1014.2 +066500 WRT-END-GF-01. SQ1014.2 +066600* SQ1014.2 +066700 WRT-INIT-GF-02. SQ1014.2 +066800* SQ1014.2 +066900* THIS TEST ADVANCES THE PRINT POSITION 7 LINES SQ1014.2 +067000* SQ1014.2 +067100 MOVE "WRT BEFORE ADV INT LINE" TO FEATURE. SQ1014.2 +067200 MOVE "WRT-TEST-GF-02" TO PAR-NAME. SQ1014.2 +067300 GO TO WRT-TEST-GF-02. SQ1014.2 +067400 WRT-DELETE-GF-02. SQ1014.2 +067500 PERFORM DE-LETE. SQ1014.2 +067600 GO TO WRT-END-GF-02. SQ1014.2 +067700 WRT-TEST-GF-02. SQ1014.2 +067800 PERFORM INSPT. SQ1014.2 +067900 PERFORM WRITE-TEST-LINE. SQ1014.2 +068000 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +068100 MOVE "7" TO LINES-ABOVE-1. SQ1014.2 +068200 MOVE TEST-LINE-1 TO DUMMY-RECORD. SQ1014.2 +068300 WRITE DUMMY-RECORD BEFORE ADVANCING 6 LINE. SQ1014.2 +068400 WRT-END-GF-02. SQ1014.2 +068500* SQ1014.2 +068600 WRT-INIT-GF-03. SQ1014.2 +068700* SQ1014.2 +068800* THIS TEST ADVANCES THE PRINT POSITION 6 LINES SQ1014.2 +068900* SQ1014.2 +069000 MOVE "WRT BEFORE INTEGER LINES" TO FEATURE. SQ1014.2 +069100 MOVE "WRT-TEST-GF-03" TO PAR-NAME. SQ1014.2 +069200 GO TO WRT-TEST-GF-03. SQ1014.2 +069300 WRT-DELETE-GF-03. SQ1014.2 +069400 PERFORM DE-LETE. SQ1014.2 +069500 GO TO WRT-END-GF-03. SQ1014.2 +069600 WRT-TEST-GF-03. SQ1014.2 +069700 PERFORM INSPT. SQ1014.2 +069800 PERFORM WRITE-TEST-LINE. SQ1014.2 +069900 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +070000 MOVE "6" TO LINES-ABOVE-2. SQ1014.2 +070100 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +070200 WRITE PRINT-REC BEFORE 5 LINES. SQ1014.2 +070300 WRT-END-GF-03. SQ1014.2 +070400* SQ1014.2 +070500 WRT-INIT-GF-04. SQ1014.2 +070600* SQ1014.2 +070700* THIS TEST ADVANCES THE PRINT POSITION 5 LINES SQ1014.2 +070800* SQ1014.2 +070900 MOVE "WRT BEFORE INTEGER LINE" TO FEATURE. SQ1014.2 +071000 MOVE "WRT-TEST-GF-04" TO PAR-NAME. SQ1014.2 +071100 GO TO WRT-TEST-GF-04. SQ1014.2 +071200 WRT-DELETE-GF-04. SQ1014.2 +071300 PERFORM DE-LETE. SQ1014.2 +071400 GO TO WRT-END-GF-04. SQ1014.2 +071500 WRT-TEST-GF-04. SQ1014.2 +071600 PERFORM INSPT. SQ1014.2 +071700 PERFORM WRITE-TEST-LINE. SQ1014.2 +071800 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +071900 MOVE "5" TO LINES-ABOVE-2. SQ1014.2 +072000 MOVE TEST-LINE-2 TO DUMMY-RECORD. SQ1014.2 +072100 WRITE DUMMY-RECORD BEFORE 4 LINE. SQ1014.2 +072200 WRT-END-GF-04. SQ1014.2 +072300* SQ1014.2 +072400 WRT-INIT-GF-05. SQ1014.2 +072500* SQ1014.2 +072600* THIS TEST ADVANCES THE PRINT POSITION 5 LINES SQ1014.2 +072700* SQ1014.2 +072800 MOVE "WRT AFTER ADV INT LINES" TO FEATURE. SQ1014.2 +072900 MOVE "WRT-TEST-GF-05" TO PAR-NAME. SQ1014.2 +073000 GO TO WRT-TEST-GF-05. SQ1014.2 +073100 WRT-DELETE-GF-05. SQ1014.2 +073200 PERFORM DE-LETE. SQ1014.2 +073300 GO TO WRT-END-GF-05. SQ1014.2 +073400 WRT-TEST-GF-05. SQ1014.2 +073500 PERFORM INSPT. SQ1014.2 +073600 PERFORM WRITE-TEST-LINE. SQ1014.2 +073700 MOVE "4" TO LINES-BELOW-1. SQ1014.2 +073800 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +073900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +074000 WRITE PRINT-REC AFTER ADVANCING 3 LINES. SQ1014.2 +074100 WRT-END-GF-05. SQ1014.2 +074200* SQ1014.2 +074300 WRT-INIT-GF-06. SQ1014.2 +074400* SQ1014.2 +074500* THE NEXT TEST IN NORMAL SEQUENCE WOULD COME VERY NEAR TO SQ1014.2 +074600* OVERFLOWING THE CURRENT PAGE, SO THE FIRST OF THE TESTS OF SQ1014.2 +074700* ADVANCING PAGE IS INSERTED HERE. IT SHOULD LEAVE LINE 2 SQ1014.2 +074800* ON THE NEW PAGE AS THE CURRENT LINE, SO THAT THE FIRST SQ1014.2 +074900* WRT-TEST LINE ON THE NEW PAGE IS THE THIRD PRINTABLE LINE. SQ1014.2 +075000* SQ1014.2 +075100 MOVE "WRT BEFORE ADV PAGE" TO FEATURE. SQ1014.2 +075200 MOVE "WRT-TEST-GF-06" TO PAR-NAME. SQ1014.2 +075300 GO TO WRT-TEST-GF-06. SQ1014.2 +075400 WRT-DELETE-GF-06. SQ1014.2 +075500 PERFORM DE-LETE. SQ1014.2 +075600 GO TO WRT-END-GF-06. SQ1014.2 +075700 WRT-TEST-GF-06. SQ1014.2 +075800 PERFORM INSPT. SQ1014.2 +075900 PERFORM WRITE-TEST-LINE. SQ1014.2 +076000 MOVE LAST-LINE TO PRINT-REC. SQ1014.2 +076100 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ1014.2 +076200 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +076300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +076400 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +076500 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +076600 WRT-END-GF-06. SQ1014.2 +076700* SQ1014.2 +076800 WRT-INIT-GF-07. SQ1014.2 +076900* SQ1014.2 +077000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES TO LINE 6 SQ1014.2 +077100* SQ1014.2 +077200 MOVE "WRT AFTER ADV INT LINE" TO FEATURE. SQ1014.2 +077300 MOVE "WRT-TEST-GF-07" TO PAR-NAME. SQ1014.2 +077400 GO TO WRT-TEST-GF-07. SQ1014.2 +077500 WRT-DELETE-GF-07. SQ1014.2 +077600 PERFORM DE-LETE. SQ1014.2 +077700 GO TO WRT-END-GF-07. SQ1014.2 +077800 WRT-TEST-GF-07. SQ1014.2 +077900 PERFORM INSPT. SQ1014.2 +078000 PERFORM WRITE-TEST-LINE. SQ1014.2 +078100 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +078200 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +078300 MOVE TEST-LINE-1 TO DUMMY-RECORD. SQ1014.2 +078400 WRITE DUMMY-RECORD AFTER ADVANCING 2 LINES. SQ1014.2 +078500 WRT-END-GF-07. SQ1014.2 +078600* SQ1014.2 +078700 WRT-INIT-GF-08. SQ1014.2 +078800* SQ1014.2 +078900* THIS TEST IS IN TWO PARTS. IT PRINTS ON THE LINE BELOW SQ1014.2 +079000* THE MARKER LINE, THEN OVERPRINTS THAT LINE, ADVANCING ZERO SQ1014.2 +079100* LINES AFTER PRINTING. SQ1014.2 +079200* TOTAL PAPER ADVANCE IS TWO LINES, TO LINE 8. SQ1014.2 +079300* SQ1014.2 +079400 MOVE "WRT AFTER INT LINE/S" TO FEATURE. SQ1014.2 +079500 MOVE "WRT-TEST-GF-08" TO PAR-NAME. SQ1014.2 +079600 GO TO WRT-TEST-GF-08. SQ1014.2 +079700 WRT-DELETE-GF-08. SQ1014.2 +079800 PERFORM DE-LETE. SQ1014.2 +079900 GO TO WRT-END-GF-08. SQ1014.2 +080000 WRT-TEST-GF-08. SQ1014.2 +080100 PERFORM INSPT. SQ1014.2 +080200 PERFORM WRITE-TEST-LINE. SQ1014.2 +080300 MOVE "08" TO OVERPRINTED-TEST. SQ1014.2 +080400 MOVE OVERPRINTED-LINE TO PRINT-REC. SQ1014.2 +080500 WRITE PRINT-REC AFTER 1 LINES. SQ1014.2 +080600 MOVE "08" TO OVERPRINT-TEST. SQ1014.2 +080700 MOVE OVERPRINT-LINE TO PRINT-REC. SQ1014.2 +080800 WRITE PRINT-REC AFTER 0 LINE. SQ1014.2 +080900 WRT-END-GF-08. SQ1014.2 +081000* SQ1014.2 +081100 WRT-INIT-GF-09. SQ1014.2 +081200* SQ1014.2 +081300* THIS TEST ADVANCES THE PRINT POSITION 12 LINES, TO LINE 20 SQ1014.2 +081400* SQ1014.2 +081500 MOVE 1 TO REC-CT. SQ1014.2 +081600 MOVE "WRT FRM BFR ADV INT LINS" TO FEATURE. SQ1014.2 +081700 MOVE "WRT-TEST-GF-09" TO PAR-NAME. SQ1014.2 +081800 GO TO WRT-TEST-GF-09. SQ1014.2 +081900 WRT-DELETE-GF-09. SQ1014.2 +082000 PERFORM DE-LETE. SQ1014.2 +082100 GO TO WRT-END-GF-09. SQ1014.2 +082200 WRT-TEST-GF-09. SQ1014.2 +082300 PERFORM INSPT. SQ1014.2 +082400 PERFORM WRITE-TEST-LINE. SQ1014.2 +082500 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +082600 MOVE "11" TO LINES-ABOVE-1. SQ1014.2 +082700 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING 10 LINES. SQ1014.2 +082800 WRT-END-GF-09. SQ1014.2 +082900* SQ1014.2 +083000 WRT-INIT-GF-10. SQ1014.2 +083100* SQ1014.2 +083200* THIS TEST ADVANCES THE PRINT POSITION 22 LINES, TO LINE 44 SQ1014.2 +083300* SQ1014.2 +083400 MOVE "WRT FRM BFR ADV INT LINE" TO FEATURE. SQ1014.2 +083500 MOVE "WRT-TEST-GF-10" TO PAR-NAME. SQ1014.2 +083600 GO TO WRT-TEST-GF-10. SQ1014.2 +083700 WRT-DELETE-GF-10. SQ1014.2 +083800 PERFORM DE-LETE. SQ1014.2 +083900 GO TO WRT-END-GF-10. SQ1014.2 +084000 WRT-TEST-GF-10. SQ1014.2 +084100 PERFORM INSPT. SQ1014.2 +084200 PERFORM WRITE-TEST-LINE. SQ1014.2 +084300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +084400 MOVE "21" TO LINES-ABOVE-2. SQ1014.2 +084500 WRITE DUMMY-RECORD FROM TEST-LINE-2 BEFORE ADVANCING 20 LINE.SQ1014.2 +084600 WRT-END-GF-10. SQ1014.2 +084700* SQ1014.2 +084800 WRT-INIT-GF-11. SQ1014.2 +084900* SQ1014.2 +085000* THIS TEST ADVANCES THE PRINT POSITION 13 LINES, TO LINE 57 SQ1014.2 +085100* SQ1014.2 +085200 MOVE "WRT FRM BEFORE INT LINES" TO FEATURE. SQ1014.2 +085300 MOVE "WRT-TEST-GF-11" TO PAR-NAME. SQ1014.2 +085400 GO TO WRT-TEST-GF-11. SQ1014.2 +085500 WRT-DELETE-GF-11. SQ1014.2 +085600 PERFORM DE-LETE. SQ1014.2 +085700 GO TO WRT-END-GF-11. SQ1014.2 +085800 WRT-TEST-GF-11. SQ1014.2 +085900 PERFORM INSPT. SQ1014.2 +086000 PERFORM WRITE-TEST-LINE. SQ1014.2 +086100 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +086200 MOVE "12" TO LINES-ABOVE-1. SQ1014.2 +086300 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE 11 LINES. SQ1014.2 +086400 WRT-END-GF-11. SQ1014.2 +086500* SQ1014.2 +086600 WRT-INIT-GF-12. SQ1014.2 +086700* SQ1014.2 +086800* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +086900* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +087000* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +087100* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +087200* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +087300* SQ1014.2 +087400 MOVE "WRITE BEFORE PAGE" TO FEATURE. SQ1014.2 +087500 MOVE "WRT-TEST-GF-12" TO PAR-NAME. SQ1014.2 +087600 GO TO WRT-TEST-GF-12. SQ1014.2 +087700 WRT-DELETE-GF-12. SQ1014.2 +087800 PERFORM DE-LETE. SQ1014.2 +087900 GO TO WRT-END-GF-12. SQ1014.2 +088000 WRT-TEST-GF-12. SQ1014.2 +088100 PERFORM INSPT. SQ1014.2 +088200 PERFORM WRITE-TEST-LINE. SQ1014.2 +088300 MOVE LAST-LINE TO PRINT-REC. SQ1014.2 +088400 WRITE PRINT-REC BEFORE PAGE. SQ1014.2 +088500 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +088600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +088700 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +088800 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +088900 WRT-END-GF-12. SQ1014.2 +089000* SQ1014.2 +089100 WRT-INIT-GF-13. SQ1014.2 +089200* SQ1014.2 +089300* THIS TEST ADVANCES THE PRINT POSITION 42 LINES, TO LINE 44 SQ1014.2 +089400* SQ1014.2 +089500 MOVE "WRT FROM BEFORE INT LINE" TO FEATURE. SQ1014.2 +089600 MOVE "WRT-TEST-GF-13" TO PAR-NAME. SQ1014.2 +089700 GO TO WRT-TEST-GF-13. SQ1014.2 +089800 WRT-DELETE-GF-13. SQ1014.2 +089900 PERFORM DE-LETE. SQ1014.2 +090000 GO TO WRT-END-GF-13. SQ1014.2 +090100 WRT-TEST-GF-13. SQ1014.2 +090200 PERFORM INSPT. SQ1014.2 +090300 PERFORM WRITE-TEST-LINE. SQ1014.2 +090400 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +090500 MOVE "41" TO LINES-ABOVE-2. SQ1014.2 +090600 WRITE DUMMY-RECORD FROM TEST-LINE-2 BEFORE 40 LINE. SQ1014.2 +090700 WRT-END-GF-13. SQ1014.2 +090800* SQ1014.2 +090900 WRT-INIT-GF-14. SQ1014.2 +091000* SQ1014.2 +091100* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +091200* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +091300* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +091400* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +091500* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +091600* SQ1014.2 +091700 MOVE "WRT AFTER ADV PAGE" TO FEATURE. SQ1014.2 +091800 MOVE "WRT-TEST-GF-14" TO PAR-NAME. SQ1014.2 +091900 GO TO WRT-TEST-GF-14. SQ1014.2 +092000 WRT-DELETE-GF-14. SQ1014.2 +092100 PERFORM DE-LETE. SQ1014.2 +092200 GO TO WRT-END-GF-14. SQ1014.2 +092300 WRT-TEST-GF-14. SQ1014.2 +092400 PERFORM INSPT. SQ1014.2 +092500 PERFORM WRITE-TEST-LINE. SQ1014.2 +092600 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +092700 WRITE PRINT-REC AFTER ADVANCING PAGE. SQ1014.2 +092800 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +092900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +093000 WRT-END-GF-14. SQ1014.2 +093100* SQ1014.2 +093200 WRT-INIT-GF-15. SQ1014.2 +093300* SQ1014.2 +093400* THIS TEST ADVANCES THE PRINT POSITION 52 LINES, TO LINE 54 SQ1014.2 +093500* SQ1014.2 +093600 MOVE "WRT FRM AFT ADV INT LINS" TO FEATURE. SQ1014.2 +093700 MOVE "WRT-TEST-GF-15" TO PAR-NAME. SQ1014.2 +093800 GO TO WRT-TEST-GF-15. SQ1014.2 +093900 WRT-DELETE-GF-15. SQ1014.2 +094000 PERFORM DE-LETE. SQ1014.2 +094100 GO TO WRT-END-GF-15. SQ1014.2 +094200 WRT-TEST-GF-15. SQ1014.2 +094300 PERFORM INSPT. SQ1014.2 +094400 PERFORM WRITE-TEST-LINE. SQ1014.2 +094500 MOVE "51" TO LINES-BELOW-1. SQ1014.2 +094600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +094700 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING 50 LINES. SQ1014.2 +094800 WRT-END-GF-15. SQ1014.2 +094900* SQ1014.2 +095000 WRT-INIT-GF-16. SQ1014.2 +095100* SQ1014.2 +095200* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 55 SQ1014.2 +095300* SQ1014.2 +095400 MOVE "WRT FRM AFT ADV INT LINE" TO FEATURE. SQ1014.2 +095500 MOVE "WRT-TEST-GF-16" TO PAR-NAME. SQ1014.2 +095600 GO TO WRT-TEST-GF-16. SQ1014.2 +095700 WRT-DELETE-GF-16. SQ1014.2 +095800 PERFORM DE-LETE. SQ1014.2 +095900 GO TO WRT-END-GF-16. SQ1014.2 +096000 WRT-TEST-GF-16. SQ1014.2 +096100 PERFORM INSPT. SQ1014.2 +096200 PERFORM WRITE-TEST-LINE. SQ1014.2 +096300 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +096400 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +096500 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING 1 LINE. SQ1014.2 +096600 WRT-END-GF-16. SQ1014.2 +096700* SQ1014.2 +096800 WRT-INIT-GF-17. SQ1014.2 +096900* SQ1014.2 +097000* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +097100* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +097200* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +097300* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +097400* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +097500* SQ1014.2 +097600 MOVE "WRITE AFTER PAGE" TO FEATURE. SQ1014.2 +097700 MOVE "WRT-TEST-GF-17" TO PAR-NAME. SQ1014.2 +097800 GO TO WRT-TEST-GF-17. SQ1014.2 +097900 WRT-DELETE-GF-17. SQ1014.2 +098000 PERFORM DE-LETE. SQ1014.2 +098100 GO TO WRT-END-GF-17. SQ1014.2 +098200 WRT-TEST-GF-17. SQ1014.2 +098300 PERFORM INSPT. SQ1014.2 +098400 PERFORM WRITE-TEST-LINE. SQ1014.2 +098500 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +098600 WRITE PRINT-REC AFTER PAGE. SQ1014.2 +098700 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +098800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +098900 WRT-END-GF-17. SQ1014.2 +099000* SQ1014.2 +099100 WRT-INIT-GF-18. SQ1014.2 +099200* SQ1014.2 +099300* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 5 SQ1014.2 +099400* SQ1014.2 +099500 MOVE "WRT FRM AFTER INT LINE/S" TO FEATURE. SQ1014.2 +099600 MOVE "WRT-TEST-GF-18" TO PAR-NAME. SQ1014.2 +099700 GO TO WRT-TEST-GF-18. SQ1014.2 +099800 WRT-DELETE-GF-18. SQ1014.2 +099900 PERFORM DE-LETE. SQ1014.2 +100000 GO TO WRT-END-GF-18. SQ1014.2 +100100 WRT-TEST-GF-18. SQ1014.2 +100200 PERFORM INSPT. SQ1014.2 +100300 PERFORM WRITE-TEST-LINE. SQ1014.2 +100400 MOVE "18" TO OVERPRINTED-TEST. SQ1014.2 +100500 WRITE PRINT-REC FROM OVERPRINTED-LINE AFTER SQ1014.2 +100600 000000000000000001 LINE. SQ1014.2 +100700 MOVE "18" TO OVERPRINT-TEST. SQ1014.2 +100800 WRITE PRINT-REC FROM OVERPRINT-LINE AFTER SQ1014.2 +100900 000000000000000000 LINES. SQ1014.2 +101000 WRT-END-GF-18. SQ1014.2 +101100* SQ1014.2 +101200 WRT-INIT-GF-19. SQ1014.2 +101300* SQ1014.2 +101400* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 8 SQ1014.2 +101500* SQ1014.2 +101600 MOVE "WRITE" TO FEATURE. SQ1014.2 +101700 MOVE "WRT-TEST-GF-19" TO PAR-NAME. SQ1014.2 +101800 GO TO WRT-TEST-GF-19. SQ1014.2 +101900 WRT-DELETE-GF-19. SQ1014.2 +102000 PERFORM DE-LETE. SQ1014.2 +102100 GO TO WRT-END-GF-19. SQ1014.2 +102200 WRT-TEST-GF-19. SQ1014.2 +102300 PERFORM INSPT. SQ1014.2 +102400 PERFORM WRITE-TEST-LINE. SQ1014.2 +102500 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +102600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +102700 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +102800 WRITE PRINT-REC. SQ1014.2 +102900 WRT-END-GF-19. SQ1014.2 +103000* SQ1014.2 +103100 WRT-INIT-GF-20. SQ1014.2 +103200* SQ1014.2 +103300* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 11 SQ1014.2 +103400* SQ1014.2 +103500 MOVE "WRITE FROM" TO FEATURE. SQ1014.2 +103600 MOVE "WRT-TEST-GF-20" TO PAR-NAME. SQ1014.2 +103700 GO TO WRT-TEST-GF-20. SQ1014.2 +103800 WRT-DELETE-GF-20. SQ1014.2 +103900 PERFORM DE-LETE. SQ1014.2 +104000 GO TO WRT-END-GF-20. SQ1014.2 +104100 WRT-TEST-GF-20. SQ1014.2 +104200 PERFORM INSPT. SQ1014.2 +104300 PERFORM WRITE-TEST-LINE. SQ1014.2 +104400 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +104500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +104600 WRITE PRINT-REC FROM TEST-LINE-1. SQ1014.2 +104700 WRT-END-GF-20. SQ1014.2 +104800* SQ1014.2 +104900 WRT-INIT-GF-21. SQ1014.2 +105000* SQ1014.2 +105100* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 14 SQ1014.2 +105200* IDENTIFIER-1 IS A SUBORDINATE GROUP ITEM SQ1014.2 +105300* SQ1014.2 +105400 MOVE "WRT SUBGR BFR ADV INT" TO FEATURE. SQ1014.2 +105500 MOVE "WRT-TEST-GF-21" TO PAR-NAME. SQ1014.2 +105600 GO TO WRT-TEST-GF-21. SQ1014.2 +105700 WRT-DELETE-GF-21. SQ1014.2 +105800 PERFORM DE-LETE. SQ1014.2 +105900 GO TO WRT-END-GF-21. SQ1014.2 +106000 WRT-TEST-GF-21. SQ1014.2 +106100 PERFORM INSPT. SQ1014.2 +106200 PERFORM WRITE-TEST-LINE. SQ1014.2 +106300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +106400 MOVE "2" TO LINES-ABOVE-2. SQ1014.2 +106500 WRITE PRINT-REC FROM TEST-LINE-2 BEFORE ADVANCING 1. SQ1014.2 +106600 WRT-END-GF-21. SQ1014.2 +106700* SQ1014.2 +106800 WRT-INIT-GF-22. SQ1014.2 +106900* SQ1014.2 +107000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 18 SQ1014.2 +107100* IDENTIFIER-1 IS A SUBORDINATE GROUP ITEM SQ1014.2 +107200* SQ1014.2 +107300 MOVE "WRT SUBGRP BEFORE INT" TO FEATURE. SQ1014.2 +107400 MOVE "WRT-TEST-GF-22" TO PAR-NAME. SQ1014.2 +107500 GO TO WRT-TEST-GF-22. SQ1014.2 +107600 WRT-DELETE-GF-22. SQ1014.2 +107700 PERFORM DE-LETE. SQ1014.2 +107800 GO TO WRT-END-GF-22. SQ1014.2 +107900 WRT-TEST-GF-22. SQ1014.2 +108000 PERFORM INSPT. SQ1014.2 +108100 PERFORM WRITE-TEST-LINE. SQ1014.2 +108200 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +108300 MOVE "3" TO LINES-ABOVE-2. SQ1014.2 +108400 WRITE PRINT-REC FROM TEST-LINE-2 BEFORE 2. SQ1014.2 +108500 WRT-END-GF-22. SQ1014.2 +108600* SQ1014.2 +108700 WRT-INIT-GF-23. SQ1014.2 +108800* SQ1014.2 +108900* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 21 SQ1014.2 +109000* SQ1014.2 +109100 MOVE "WRT FROM 77 AFT ADV INT" TO FEATURE. SQ1014.2 +109200 MOVE "WRT-TEST-23" TO PAR-NAME. SQ1014.2 +109300 GO TO WRT-TEST-GF-23. SQ1014.2 +109400 WRT-DELETE-GF-23. SQ1014.2 +109500 PERFORM DE-LETE. SQ1014.2 +109600 GO TO WRT-END-GF-23. SQ1014.2 +109700 WRT-TEST-GF-23. SQ1014.2 +109800 PERFORM INSPT. SQ1014.2 +109900 PERFORM WRITE-TEST-LINE. SQ1014.2 +110000 WRITE PRINT-REC FROM SEVENTY-SEVEN AFTER ADVANCING 1. SQ1014.2 +110100 WRT-END-GF-23. SQ1014.2 +110200* SQ1014.2 +110300 WRT-INIT-GF-24. SQ1014.2 +110400* SQ1014.2 +110500* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 26 SQ1014.2 +110600* SQ1014.2 +110700 MOVE "WRT FROM AFTER INT" TO FEATURE. SQ1014.2 +110800 MOVE "WRT-TEST-GF-24" TO PAR-NAME. SQ1014.2 +110900 GO TO WRT-TEST-GF-24. SQ1014.2 +111000 WRT-DELETE-GF-24. SQ1014.2 +111100 PERFORM DE-LETE. SQ1014.2 +111200 GO TO WRT-END-GF-24. SQ1014.2 +111300 WRT-TEST-GF-24. SQ1014.2 +111400 PERFORM INSPT. SQ1014.2 +111500 PERFORM WRITE-TEST-LINE. SQ1014.2 +111600 MOVE "4" TO LINES-BELOW-1. SQ1014.2 +111700 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +111800 WRITE PRINT-REC FROM TEST-LINE-1 AFTER 3. SQ1014.2 +111900 WRT-END-GF-24. SQ1014.2 +112000* SQ1014.2 +112100 WRT-INIT-GF-25. SQ1014.2 +112200* SQ1014.2 +112300* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 28 SQ1014.2 +112400* SQ1014.2 +112500 MOVE "WRT BEFORE ADV ZERO" TO FEATURE. SQ1014.2 +112600 MOVE "WRT-TEST-GF-25" TO PAR-NAME. SQ1014.2 +112700 GO TO WRT-TEST-GF-25. SQ1014.2 +112800 WRT-DELETE-GF-25. SQ1014.2 +112900 PERFORM DE-LETE. SQ1014.2 +113000 GO TO WRT-END-GF-25. SQ1014.2 +113100 WRT-TEST-GF-25. SQ1014.2 +113200 PERFORM INSPT. SQ1014.2 +113300 PERFORM WRITE-TEST-LINE. SQ1014.2 +113400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +113500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +113600 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +113700 WRITE PRINT-REC BEFORE ADVANCING ZERO. SQ1014.2 +113800 WRT-END-GF-25. SQ1014.2 +113900* SQ1014.2 +114000 WRT-INIT-GF-26. SQ1014.2 +114100* SQ1014.2 +114200* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 35 SQ1014.2 +114300* SQ1014.2 +114400 MOVE "WRT BEFORE INT" TO FEATURE. SQ1014.2 +114500 MOVE "WRT-TEST-GF-26" TO PAR-NAME. SQ1014.2 +114600 GO TO WRT-TEST-GF-26. SQ1014.2 +114700 WRT-DELETE-GF-26. SQ1014.2 +114800 PERFORM DE-LETE. SQ1014.2 +114900 GO TO WRT-END-GF-26. SQ1014.2 +115000 WRT-TEST-GF-26. SQ1014.2 +115100 PERFORM INSPT. SQ1014.2 +115200 PERFORM WRITE-TEST-LINE. SQ1014.2 +115300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +115400 MOVE "6" TO LINES-ABOVE-2. SQ1014.2 +115500 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +115600 WRITE PRINT-REC BEFORE 5. SQ1014.2 +115700 WRT-END-GF-26. SQ1014.2 +115800* SQ1014.2 +115900 WRT-INIT-GF-27. SQ1014.2 +116000* SQ1014.2 +116100* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 42 SQ1014.2 +116200* SQ1014.2 +116300 MOVE "WRT AFTER ADVANCING INT" TO FEATURE. SQ1014.2 +116400 MOVE "WRT-TEST-GF-27" TO PAR-NAME. SQ1014.2 +116500 GO TO WRT-TEST-GF-27. SQ1014.2 +116600 WRT-DELETE-GF-27. SQ1014.2 +116700 PERFORM DE-LETE. SQ1014.2 +116800 GO TO WRT-END-GF-27. SQ1014.2 +116900 WRT-TEST-GF-27. SQ1014.2 +117000 PERFORM INSPT. SQ1014.2 +117100 PERFORM WRITE-TEST-LINE. SQ1014.2 +117200 MOVE "6" TO LINES-BELOW-2. SQ1014.2 +117300 MOVE "1" TO LINES-ABOVE-2. SQ1014.2 +117400 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +117500 WRITE PRINT-REC AFTER ADVANCING 5. SQ1014.2 +117600 WRT-END-GF-27. SQ1014.2 +117700* SQ1014.2 +117800 WRT-INIT-GF-28. SQ1014.2 +117900* SQ1014.2 +118000* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 45 SQ1014.2 +118100* SQ1014.2 +118200 MOVE "WRT AFTER INT" TO FEATURE. SQ1014.2 +118300 MOVE "WRT-TEST-GF-28" TO PAR-NAME. SQ1014.2 +118400 GO TO WRT-TEST-GF-28. SQ1014.2 +118500 WRT-DELETE-GF-28. SQ1014.2 +118600 PERFORM DE-LETE. SQ1014.2 +118700 GO TO WRT-END-GF-28. SQ1014.2 +118800 WRT-TEST-GF-28. SQ1014.2 +118900 PERFORM INSPT. SQ1014.2 +119000 PERFORM WRITE-TEST-LINE. SQ1014.2 +119100 MOVE "2" TO LINES-BELOW-2. SQ1014.2 +119200 MOVE "1" TO LINES-ABOVE-2. SQ1014.2 +119300 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +119400 WRITE PRINT-REC AFTER 1. SQ1014.2 +119500 WRT-END-GF-28. SQ1014.2 +119600* SQ1014.2 +119700 WRT-INIT-GF-29. SQ1014.2 +119800* SQ1014.2 +119900* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +120000* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +120100* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +120200* THIRD PRINTABLE LINE. SQ1014.2 +120300* SQ1014.2 +120400 MOVE "WRT FROM BEFORE ADV PAGE" TO FEATURE. SQ1014.2 +120500 MOVE "WRT-TEST-GF-29" TO PAR-NAME. SQ1014.2 +120600 GO TO WRT-TEST-GF-29. SQ1014.2 +120700 WRT-DELETE-GF-29. SQ1014.2 +120800 PERFORM DE-LETE. SQ1014.2 +120900 GO TO WRT-END-GF-29. SQ1014.2 +121000 WRT-TEST-GF-29. SQ1014.2 +121100 PERFORM INSPT. SQ1014.2 +121200 PERFORM WRITE-TEST-LINE. SQ1014.2 +121300 WRITE DUMMY-RECORD FROM LAST-LINE BEFORE ADVANCING PAGE. SQ1014.2 +121400 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +121500 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +121600 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +121700 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +121800 WRT-END-GF-29. SQ1014.2 +121900* SQ1014.2 +122000 WRT-INIT-GF-30. SQ1014.2 +122100* SQ1014.2 +122200* THIS TEST ADVANCES THE PRINT POSITION MANY LINES, SQ1014.2 +122300* OVERFLOWING SEVERAL PAGES. NO SPECIAL PROVISION IS MADE SQ1014.2 +122400* FOR OVERFLOW HANDLING. SQ1014.2 +122500* SQ1014.2 +122600 MOVE "CHARACTERS IN COLUMN 1" TO FEATURE. SQ1014.2 +122700 MOVE "WRT-TEST-GF-30" TO PAR-NAME. SQ1014.2 +122800 GO TO WRT-TEST-GF-30. SQ1014.2 +122900 WRT-DELETE-GF-30. SQ1014.2 +123000 PERFORM DE-LETE. SQ1014.2 +123100 GO TO WRT-END-GF-30. SQ1014.2 +123200 WRT-TEST-GF-30. SQ1014.2 +123300 PERFORM INSPT. SQ1014.2 +123400 PERFORM WRITE-TEST-LINE. SQ1014.2 +123500 PERFORM BLANK-LINE-PRINT. SQ1014.2 +123600 MOVE " COLUMN 1 OF EACH OF THE LINES BELOW CONTAINS A NON-BLASQ1014.2 +123700- "NK CHARACTER. IN THE PAST, CHARACTERS IN THIS POSITION MIGHSQ1014.2 +123800- "T" TO PRINT-REC. SQ1014.2 +123900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +124000 MOVE " HAVE CONTROLLED PAPER MOVEMENT AND BEEN SUPPRESSED. TSQ1014.2 +124100- "HIS PRACTICE DOES NOT CONFORM TO THE STANDARD." SQ1014.2 +124200 TO PRINT-REC. SQ1014.2 +124300 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ1014.2 +124400 MOVE " ALL LINES SHOULD BE PRINTED SINGLE-SPACED, AND EACH SQ1014.2 +124500- " CONTAINS A SEQUENCE NUMBER, STARTING WITH 001" SQ1014.2 +124600 TO PRINT-REC. SQ1014.2 +124700 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ1014.2 +124800 MOVE " THE CHARACTERS PRINTED SHOULD BE AS FOLLOWS --- 0 1 2 SQ1014.2 +124900- "3 4 5 6 7 8 9 + - * / = $ , . ; ( ) < > A B C . . . Z AND" SQ1014.2 +125000 TO PRINT-REC. SQ1014.2 +125100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125200 MOVE " a b c . . . z AND QUOTE" TO PRINT-REC. SQ1014.2 +125300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125400 MOVE " PRINTING BEGINS ON THE NEXT LINE BELOW ---" SQ1014.2 +125500 TO PRINT-REC. SQ1014.2 +125600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125700 MOVE SPACES TO CHAR-LINE. SQ1014.2 +125800 MOVE ZERO TO LIN-SER. SQ1014.2 +125900 MOVE "0" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126000 MOVE "1" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126100 MOVE "2" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126200 MOVE "3" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126300 MOVE "4" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126400 MOVE "5" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126500 MOVE "6" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126600 MOVE "7" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126700 MOVE "8" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126800 MOVE "9" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126900 MOVE "+" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127000 MOVE "-" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127100 MOVE "*" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127200 MOVE "/" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127300 MOVE "=" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127400 MOVE "$" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127500 MOVE "," TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127600 MOVE "." TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127700 MOVE ";" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127800 MOVE "(" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127900 MOVE ")" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128000 MOVE "<" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128100 MOVE ">" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128200 MOVE "A" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128300 MOVE "B" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128400 MOVE "C" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128500 MOVE "D" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128600 MOVE "E" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128700 MOVE "F" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128800 MOVE "G" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128900 MOVE "H" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129000 MOVE "I" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129100 MOVE "J" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129200 MOVE "K" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129300 MOVE "L" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129400 MOVE "M" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129500 MOVE "N" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129600 MOVE "O" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129700 MOVE "P" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129800 MOVE "Q" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129900 MOVE "R" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130000 MOVE "S" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130100 MOVE "T" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130200 MOVE "U" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130300 MOVE "V" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130400 MOVE "W" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130500 MOVE "X" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130600 MOVE "Y" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130700 MOVE "Z" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130800 MOVE "a" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130900 MOVE "b" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131000 MOVE "c" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131100 MOVE "d" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131200 MOVE "e" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131300 MOVE "f" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131400 MOVE "g" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131500 MOVE "h" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131600 MOVE "i" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131700 MOVE "j" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131800 MOVE "k" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131900 MOVE "l" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132000 MOVE "m" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132100 MOVE "n" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132200 MOVE "o" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132300 MOVE "p" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132400 MOVE "q" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132500 MOVE "r" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132600 MOVE "s" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132700 MOVE "t" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132800 MOVE "u" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132900 MOVE "v" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133000 MOVE "w" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133100 MOVE "x" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133200 MOVE "y" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133300 MOVE "z" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133400 MOVE QU-OTE TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133500 WRT-END-GF-30. SQ1014.2 +133600* SQ1014.2 +133700 WRT-INIT-GF-31. SQ1014.2 +133800* SQ1014.2 +133900* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +134000* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +134100* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +134200* THIRD PRINTABLE LINE. SQ1014.2 +134300* SQ1014.2 +134400 MOVE "WRT FROM BEFORE PAGE" TO FEATURE. SQ1014.2 +134500 MOVE "WRT-TEST-GF-31" TO PAR-NAME. SQ1014.2 +134600 GO TO WRT-TEST-GF-31. SQ1014.2 +134700 WRT-DELETE-GF-31. SQ1014.2 +134800 PERFORM DE-LETE. SQ1014.2 +134900 GO TO WRT-END-GF-31. SQ1014.2 +135000 WRT-TEST-GF-31. SQ1014.2 +135100 PERFORM INSPT. SQ1014.2 +135200 PERFORM WRITE-TEST-LINE. SQ1014.2 +135300 WRITE DUMMY-RECORD FROM LAST-LINE BEFORE PAGE. SQ1014.2 +135400 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +135500 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +135600 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +135700 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +135800 WRT-END-GF-31. SQ1014.2 +135900* SQ1014.2 +136000 WRT-INIT-GF-32. SQ1014.2 +136100* SQ1014.2 +136200* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 5 SQ1014.2 +136300* SQ1014.2 +136400 MOVE "WRT FRM BFR ADV P99 LINE" TO FEATURE. SQ1014.2 +136500 MOVE "WRT-TEST-GF-32" TO PAR-NAME. SQ1014.2 +136600 GO TO WRT-TEST-GF-32. SQ1014.2 +136700 WRT-DELETE-GF-32. SQ1014.2 +136800 PERFORM DE-LETE. SQ1014.2 +136900 GO TO WRT-END-GF-32. SQ1014.2 +137000 WRT-TEST-GF-32. SQ1014.2 +137100 PERFORM INSPT. SQ1014.2 +137200 PERFORM WRITE-TEST-LINE. SQ1014.2 +137300 MOVE 0 TO IDENTIFIER-2. SQ1014.2 +137400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +137500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +137600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +137700 IDENTIFIER-2 LINE. SQ1014.2 +137800 WRT-END-GF-32. SQ1014.2 +137900* SQ1014.2 +138000 WRT-INIT-GF-33. SQ1014.2 +138100* SQ1014.2 +138200* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 8 SQ1014.2 +138300* SQ1014.2 +138400 MOVE "WRT FRM BFR ADV P99 LINS" TO FEATURE. SQ1014.2 +138500 MOVE "WRT-TEST-GF-33" TO PAR-NAME. SQ1014.2 +138600 GO TO WRT-TEST-GF-33. SQ1014.2 +138700 WRT-DELETE-GF-33. SQ1014.2 +138800 PERFORM DE-LETE. SQ1014.2 +138900 GO TO WRT-END-GF-33. SQ1014.2 +139000 WRT-TEST-GF-33. SQ1014.2 +139100 PERFORM INSPT. SQ1014.2 +139200 PERFORM WRITE-TEST-LINE. SQ1014.2 +139300 MOVE 1 TO IDENTIFIER-2. SQ1014.2 +139400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +139500 MOVE "2" TO LINES-ABOVE-1. SQ1014.2 +139600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +139700 IDENTIFIER-2 LINES. SQ1014.2 +139800 WRT-END-GF-33. SQ1014.2 +139900* SQ1014.2 +140000 WRT-INIT-GF-34. SQ1014.2 +140100* SQ1014.2 +140200* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 12 SQ1014.2 +140300* SQ1014.2 +140400 MOVE "WRT FRM BEFORE ADV PIC99" TO FEATURE. SQ1014.2 +140500 MOVE "WRT-TEST-GF-34" TO PAR-NAME. SQ1014.2 +140600 GO TO WRT-TEST-GF-34. SQ1014.2 +140700 WRT-DELETE-GF-34. SQ1014.2 +140800 PERFORM DE-LETE. SQ1014.2 +140900 GO TO WRT-END-GF-34. SQ1014.2 +141000 WRT-TEST-GF-34. SQ1014.2 +141100 PERFORM INSPT. SQ1014.2 +141200 PERFORM WRITE-TEST-LINE. SQ1014.2 +141300 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +141400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +141500 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +141600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +141700 IDENTIFIER-2. SQ1014.2 +141800 WRT-END-GF-34. SQ1014.2 +141900* SQ1014.2 +142000 WRT-INIT-GF-35. SQ1014.2 +142100* SQ1014.2 +142200* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 17 SQ1014.2 +142300* SQ1014.2 +142400 MOVE "WRT FROM BEFORE P99 LINE" TO FEATURE. SQ1014.2 +142500 MOVE "WRT-TEST-GF-35" TO PAR-NAME. SQ1014.2 +142600 GO TO WRT-TEST-GF-35. SQ1014.2 +142700 WRT-DELETE-GF-35. SQ1014.2 +142800 PERFORM DE-LETE. SQ1014.2 +142900 GO TO WRT-END-GF-35. SQ1014.2 +143000 WRT-TEST-GF-35. SQ1014.2 +143100 PERFORM INSPT. SQ1014.2 +143200 PERFORM WRITE-TEST-LINE. SQ1014.2 +143300 MOVE 3 TO IDENTIFIER-2. SQ1014.2 +143400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +143500 MOVE "4" TO LINES-ABOVE-1. SQ1014.2 +143600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE IDENTIFIER-2 LINE. SQ1014.2 +143700 WRT-END-GF-35. SQ1014.2 +143800* SQ1014.2 +143900 WRT-INIT-GF-36. SQ1014.2 +144000* SQ1014.2 +144100* THIS TEST ADVANCES THE PRINT POSITION 6 LINES, TO LINE 23 SQ1014.2 +144200* SQ1014.2 +144300 MOVE "WRT FRM BEFORE P99 LINES" TO FEATURE. SQ1014.2 +144400 MOVE "WRT-TEST-GF-36" TO PAR-NAME. SQ1014.2 +144500 GO TO WRT-TEST-GF-36. SQ1014.2 +144600 WRT-DELETE-GF-36. SQ1014.2 +144700 PERFORM DE-LETE. SQ1014.2 +144800 GO TO WRT-END-GF-36. SQ1014.2 +144900 WRT-TEST-GF-36. SQ1014.2 +145000 PERFORM INSPT. SQ1014.2 +145100 PERFORM WRITE-TEST-LINE. SQ1014.2 +145200 MOVE 4 TO IDENTIFIER-2. SQ1014.2 +145300 WRITE PRINT-REC FROM OH-ONE BEFORE IDENTIFIER-2 LINES. SQ1014.2 +145400 WRT-END-GF-36. SQ1014.2 +145500* SQ1014.2 +145600 WRT-INIT-GF-37. SQ1014.2 +145700* SQ1014.2 +145800* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 29 SQ1014.2 +145900* SQ1014.2 +146000 MOVE "WRT FROM 03 BEFORE PIC99" TO FEATURE. SQ1014.2 +146100 MOVE "WRT-TEST-GF-37" TO PAR-NAME. SQ1014.2 +146200 GO TO WRT-TEST-GF-37. SQ1014.2 +146300 WRT-DELETE-GF-37. SQ1014.2 +146400 PERFORM DE-LETE. SQ1014.2 +146500 GO TO WRT-END-GF-37. SQ1014.2 +146600 WRT-TEST-GF-37. SQ1014.2 +146700 PERFORM INSPT. SQ1014.2 +146800 PERFORM WRITE-TEST-LINE. SQ1014.2 +146900 MOVE 5 TO IDENTIFIER-2. SQ1014.2 +147000 WRITE PRINT-REC FROM OH-THREE BEFORE IDENTIFIER-2. SQ1014.2 +147100 WRT-END-GF-37. SQ1014.2 +147200* SQ1014.2 +147300 WRT-INIT-GF-38. SQ1014.2 +147400* SQ1014.2 +147500* THIS TEST ADVANCES THE PRINT POSITION 8 LINES, TO LINE 37 SQ1014.2 +147600* SQ1014.2 +147700 MOVE "WRT FRM AFT ADV P99 LINE" TO FEATURE. SQ1014.2 +147800 MOVE "WRT-TEST-GF-38" TO PAR-NAME. SQ1014.2 +147900 GO TO WRT-TEST-GF-38. SQ1014.2 +148000 WRT-DELETE-GF-38. SQ1014.2 +148100 PERFORM DE-LETE. SQ1014.2 +148200 GO TO WRT-END-GF-38. SQ1014.2 +148300 WRT-TEST-GF-38. SQ1014.2 +148400 PERFORM INSPT. SQ1014.2 +148500 PERFORM WRITE-TEST-LINE. SQ1014.2 +148600 MOVE 6 TO IDENTIFIER-2. SQ1014.2 +148700 WRITE PRINT-REC FROM SEVENTY-SEVEN-2 AFTER ADVANCING SQ1014.2 +148800 IDENTIFIER-2 LINE. SQ1014.2 +148900 WRT-END-GF-38. SQ1014.2 +149000* SQ1014.2 +149100 WRT-INIT-GF-39. SQ1014.2 +149200* SQ1014.2 +149300* THIS TEST ADVANCES THE PRINT POSITION 9 LINES, TO LINE 46 SQ1014.2 +149400* SQ1014.2 +149500 MOVE "WRT FRM AFT ADV P99 LINS" TO FEATURE. SQ1014.2 +149600 MOVE "WRT-TEST-GF-39" TO PAR-NAME. SQ1014.2 +149700 GO TO WRT-TEST-GF-39. SQ1014.2 +149800 WRT-DELETE-GF-39. SQ1014.2 +149900 PERFORM DE-LETE. SQ1014.2 +150000 GO TO WRT-END-GF-39. SQ1014.2 +150100 WRT-TEST-GF-39. SQ1014.2 +150200 PERFORM INSPT. SQ1014.2 +150300 PERFORM WRITE-TEST-LINE. SQ1014.2 +150400 MOVE 7 TO IDENTIFIER-2. SQ1014.2 +150500 MOVE "8" TO LINES-BELOW-1. SQ1014.2 +150600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +150700 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING SQ1014.2 +150800 IDENTIFIER-2 LINES. SQ1014.2 +150900 WRT-END-GF-39. SQ1014.2 +151000* SQ1014.2 +151100 WRT-INIT-GF-40. SQ1014.2 +151200* SQ1014.2 +151300* THIS TEST ADVANCES THE PRINT POSITION 10 LINES, TO LINE 56 SQ1014.2 +151400* SQ1014.2 +151500 MOVE "WRT FRM AFT ADV ID2" TO FEATURE. SQ1014.2 +151600 MOVE "WRT-TEST-44" TO PAR-NAME. SQ1014.2 +151700 PERFORM WRITE-TEST-LINE. SQ1014.2 +151800 MOVE 8 TO IDENTIFIER-2. SQ1014.2 +151900 MOVE "9" TO LINES-BELOW-1. SQ1014.2 +152000 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +152100 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING SQ1014.2 +152200 IDENTIFIER-2. SQ1014.2 +152300 WRT-END-GF-40. SQ1014.2 +152400* SQ1014.2 +152500 WRT-INIT-GF-41. SQ1014.2 +152600* SQ1014.2 +152700* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +152800* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +152900* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +153000* THIRD PRINTABLE LINE. SQ1014.2 +153100* SQ1014.2 +153200 MOVE "WRT FROM AFTER ADV PAGE" TO FEATURE. SQ1014.2 +153300 MOVE "WRT-TEST-GF-41" TO PAR-NAME. SQ1014.2 +153400 GO TO WRT-TEST-GF-41. SQ1014.2 +153500 WRT-DELETE-GF-41. SQ1014.2 +153600 PERFORM DE-LETE. SQ1014.2 +153700 GO TO WRT-END-GF-41. SQ1014.2 +153800 WRT-TEST-GF-41. SQ1014.2 +153900 PERFORM INSPT. SQ1014.2 +154000 PERFORM WRITE-TEST-LINE. SQ1014.2 +154100 WRITE PRINT-REC FROM NEW-PAGE-LINE AFTER ADVANCING PAGE. SQ1014.2 +154200 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +154300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +154400 WRT-END-GF-41. SQ1014.2 +154500* SQ1014.2 +154600 WRT-INIT-GF-42. SQ1014.2 +154700* SQ1014.2 +154800* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 5 SQ1014.2 +154900* SQ1014.2 +155000 MOVE "WRT FROM AFTER ID2 LINE" TO FEATURE. SQ1014.2 +155100 MOVE "WRT-TEST-GF-42" TO PAR-NAME. SQ1014.2 +155200 GO TO WRT-TEST-GF-42. SQ1014.2 +155300 WRT-DELETE-GF-42. SQ1014.2 +155400 PERFORM DE-LETE. SQ1014.2 +155500 GO TO WRT-END-GF-42. SQ1014.2 +155600 WRT-TEST-GF-42. SQ1014.2 +155700 PERFORM INSPT. SQ1014.2 +155800 PERFORM WRITE-TEST-LINE. SQ1014.2 +155900 MOVE 0 TO IDENTIFIER-2. SQ1014.2 +156000 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +156100 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +156200 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENTIFIER-2 LINE. SQ1014.2 +156300 WRT-END-GF-42. SQ1014.2 +156400* SQ1014.2 +156500 WRT-INIT-GF-43. SQ1014.2 +156600* SQ1014.2 +156700* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 9 SQ1014.2 +156800* SQ1014.2 +156900 MOVE "WRT FROM AFTER S99 LINES" TO FEATURE. SQ1014.2 +157000 MOVE "WRT-TEST-GF-43" TO PAR-NAME. SQ1014.2 +157100 GO TO WRT-TEST-GF-43. SQ1014.2 +157200 WRT-DELETE-GF-43. SQ1014.2 +157300 PERFORM DE-LETE. SQ1014.2 +157400 GO TO WRT-END-GF-43. SQ1014.2 +157500 WRT-TEST-GF-43. SQ1014.2 +157600 PERFORM INSPT. SQ1014.2 +157700 PERFORM WRITE-TEST-LINE. SQ1014.2 +157800 MOVE 2 TO IDENT-2-S99. SQ1014.2 +157900 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +158000 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +158100 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENT-2-S99 LINES. SQ1014.2 +158200 WRT-END-GF-43. SQ1014.2 +158300* SQ1014.2 +158400 WRT-INIT-GF-44. SQ1014.2 +158500* SQ1014.2 +158600* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 12 SQ1014.2 +158700* SQ1014.2 +158800 MOVE "WRT FROM AFTER C99" TO FEATURE. SQ1014.2 +158900 MOVE "WRT-TEST-GF-44" TO PAR-NAME. SQ1014.2 +159000 GO TO WRT-TEST-GF-44. SQ1014.2 +159100 WRT-DELETE-GF-44. SQ1014.2 +159200 PERFORM DE-LETE. SQ1014.2 +159300 GO TO WRT-END-GF-44. SQ1014.2 +159400 WRT-TEST-GF-44. SQ1014.2 +159500 PERFORM INSPT. SQ1014.2 +159600 PERFORM WRITE-TEST-LINE. SQ1014.2 +159700 MOVE 1 TO IDENT-2-C99. SQ1014.2 +159800 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +159900 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +160000 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENT-2-C99. SQ1014.2 +160100 WRT-END-GF-44. SQ1014.2 +160200* SQ1014.2 +160300 WRT-INIT-GF-45. SQ1014.2 +160400* SQ1014.2 +160500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 16 SQ1014.2 +160600* SQ1014.2 +160700 MOVE "WRT BEFORE ADV S99 LINE" TO FEATURE. SQ1014.2 +160800 MOVE "WRT-TEST-GF-45" TO PAR-NAME. SQ1014.2 +160900 GO TO WRT-TEST-GF-45. SQ1014.2 +161000 WRT-DELETE-GF-45. SQ1014.2 +161100 PERFORM DE-LETE. SQ1014.2 +161200 GO TO WRT-END-GF-45. SQ1014.2 +161300 WRT-TEST-GF-45. SQ1014.2 +161400 PERFORM INSPT. SQ1014.2 +161500 PERFORM WRITE-TEST-LINE. SQ1014.2 +161600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +161700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +161800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +161900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +162000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99 LINE. SQ1014.2 +162100 WRT-END-GF-45. SQ1014.2 +162200* SQ1014.2 +162300 WRT-INIT-GF-46. SQ1014.2 +162400* SQ1014.2 +162500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 20 SQ1014.2 +162600* SQ1014.2 +162700 MOVE "WRT BEFORE ADV S99 LINES" TO FEATURE. SQ1014.2 +162800 MOVE "WRT-TEST-GF-46" TO PAR-NAME. SQ1014.2 +162900 GO TO WRT-TEST-GF-46. SQ1014.2 +163000 WRT-DELETE-GF-46. SQ1014.2 +163100 PERFORM DE-LETE. SQ1014.2 +163200 GO TO WRT-END-GF-46. SQ1014.2 +163300 WRT-TEST-GF-46. SQ1014.2 +163400 PERFORM INSPT. SQ1014.2 +163500 PERFORM WRITE-TEST-LINE. SQ1014.2 +163600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +163700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +163800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +163900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +164000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99 LINES. SQ1014.2 +164100 WRT-END-GF-46. SQ1014.2 +164200* SQ1014.2 +164300 WRT-INIT-GF-47. SQ1014.2 +164400* SQ1014.2 +164500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 24 SQ1014.2 +164600* SQ1014.2 +164700 MOVE "WRT BEFORE ADV S99" TO FEATURE. SQ1014.2 +164800 MOVE "WRT-TEST-GF-47" TO PAR-NAME. SQ1014.2 +164900 GO TO WRT-TEST-GF-47. SQ1014.2 +165000 WRT-DELETE-GF-47. SQ1014.2 +165100 PERFORM DE-LETE. SQ1014.2 +165200 GO TO WRT-END-GF-47. SQ1014.2 +165300 WRT-TEST-GF-47. SQ1014.2 +165400 PERFORM INSPT. SQ1014.2 +165500 PERFORM WRITE-TEST-LINE. SQ1014.2 +165600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +165700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +165800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +165900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +166000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99. SQ1014.2 +166100 WRT-END-GF-47. SQ1014.2 +166200* SQ1014.2 +166300 WRT-INIT-GF-48. SQ1014.2 +166400* SQ1014.2 +166500* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 27 SQ1014.2 +166600* SQ1014.2 +166700 MOVE "WRT BEFORE PIC9 LINE" TO FEATURE. SQ1014.2 +166800 MOVE "WRT-TEST-GF-48" TO PAR-NAME. SQ1014.2 +166900 GO TO WRT-TEST-GF-48. SQ1014.2 +167000 WRT-DELETE-GF-48. SQ1014.2 +167100 PERFORM DE-LETE. SQ1014.2 +167200 GO TO WRT-END-GF-48. SQ1014.2 +167300 WRT-TEST-GF-48. SQ1014.2 +167400 PERFORM INSPT. SQ1014.2 +167500 PERFORM WRITE-TEST-LINE. SQ1014.2 +167600 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +167700 MOVE "2" TO LINES-ABOVE-1. SQ1014.2 +167800 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +167900 WRITE PRINT-REC BEFORE ONE LINE. SQ1014.2 +168000 PERFORM INSPT. SQ1014.2 +168100 WRT-END-GF-48. SQ1014.2 +168200* SQ1014.2 +168300 WRT-INIT-GF-49. SQ1014.2 +168400* SQ1014.2 +168500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 31 SQ1014.2 +168600* SQ1014.2 +168700 MOVE "WRT BEFORE PIC9 LINES" TO FEATURE. SQ1014.2 +168800 MOVE "WRT-TEST-GF-49" TO PAR-NAME. SQ1014.2 +168900 GO TO WRT-TEST-GF-49. SQ1014.2 +169000 WRT-DELETE-GF-49. SQ1014.2 +169100 PERFORM DE-LETE. SQ1014.2 +169200 GO TO WRT-END-GF-49. SQ1014.2 +169300 WRT-TEST-GF-49. SQ1014.2 +169400 PERFORM INSPT. SQ1014.2 +169500 PERFORM WRITE-TEST-LINE. SQ1014.2 +169600 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +169700 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +169800 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +169900 WRITE PRINT-REC BEFORE TWO LINES. SQ1014.2 +170000 WRT-END-GF-49. SQ1014.2 +170100* SQ1014.2 +170200 WRT-INIT-GF-50. SQ1014.2 +170300* SQ1014.2 +170400* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 36 SQ1014.2 +170500* SQ1014.2 +170600 MOVE "WRT BEFORE PIC9" TO FEATURE. SQ1014.2 +170700 MOVE "WRT-TEST-GF-50" TO PAR-NAME. SQ1014.2 +170800 GO TO WRT-TEST-GF-50. SQ1014.2 +170900 WRT-DELETE-GF-50. SQ1014.2 +171000 PERFORM DE-LETE. SQ1014.2 +171100 GO TO WRT-END-GF-50. SQ1014.2 +171200 WRT-TEST-GF-50. SQ1014.2 +171300 PERFORM INSPT. SQ1014.2 +171400 PERFORM WRITE-TEST-LINE. SQ1014.2 +171500 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +171600 MOVE "4" TO LINES-ABOVE-1. SQ1014.2 +171700 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +171800 WRITE PRINT-REC BEFORE THREE. SQ1014.2 +171900 WRT-END-GF-50. SQ1014.2 +172000* SQ1014.2 +172100 WRT-INIT-GF-51. SQ1014.2 +172200* SQ1014.2 +172300* THIS TEST ADVANCES THE PRINT POSITION 6 LINES, TO LINE 42 SQ1014.2 +172400* SQ1014.2 +172500 MOVE "WRT AFTER ADV PIC9 LINE" TO FEATURE. SQ1014.2 +172600 MOVE "WRT-TEST-GF-51" TO PAR-NAME. SQ1014.2 +172700 GO TO WRT-TEST-GF-51. SQ1014.2 +172800 WRT-DELETE-GF-51. SQ1014.2 +172900 PERFORM DE-LETE. SQ1014.2 +173000 GO TO WRT-END-GF-51. SQ1014.2 +173100 WRT-TEST-GF-51. SQ1014.2 +173200 PERFORM INSPT. SQ1014.2 +173300 PERFORM WRITE-TEST-LINE. SQ1014.2 +173400 MOVE "5" TO LINES-BELOW-1. SQ1014.2 +173500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +173600 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +173700 WRITE PRINT-REC AFTER ADVANCING FOUR LINE. SQ1014.2 +173800 WRT-END-GF-51. SQ1014.2 +173900* SQ1014.2 +174000 WRT-INIT-GF-52. SQ1014.2 +174100* SQ1014.2 +174200* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 44 SQ1014.2 +174300* SQ1014.2 +174400 MOVE "WRT AFT ADV 9(18) LINES" TO FEATURE. SQ1014.2 +174500 MOVE "WRT-TEST-GF-52" TO PAR-NAME. SQ1014.2 +174600 GO TO WRT-TEST-GF-52. SQ1014.2 +174700 WRT-DELETE-GF-52. SQ1014.2 +174800 PERFORM DE-LETE. SQ1014.2 +174900 GO TO WRT-END-GF-52. SQ1014.2 +175000 WRT-TEST-GF-52. SQ1014.2 +175100 PERFORM INSPT. SQ1014.2 +175200 PERFORM WRITE-TEST-LINE. SQ1014.2 +175300 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +175400 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +175500 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +175600 WRITE PRINT-REC AFTER ADVANCING LONG-ZERO LINES. SQ1014.2 +175700 WRT-END-GF-52. SQ1014.2 +175800* SQ1014.2 +175900 WRT-INIT-GF-53. SQ1014.2 +176000* SQ1014.2 +176100* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 47 SQ1014.2 +176200* SQ1014.2 +176300 MOVE "WRT AFTER ADV 9(18)" TO FEATURE. SQ1014.2 +176400 MOVE "WRT-TEST-GF-53" TO PAR-NAME. SQ1014.2 +176500 GO TO WRT-TEST-GF-53. SQ1014.2 +176600 WRT-DELETE-GF-53. SQ1014.2 +176700 PERFORM DE-LETE. SQ1014.2 +176800 GO TO WRT-END-GF-53. SQ1014.2 +176900 WRT-TEST-GF-53. SQ1014.2 +177000 PERFORM INSPT. SQ1014.2 +177100 PERFORM WRITE-TEST-LINE. SQ1014.2 +177200 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +177300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +177400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +177500 WRITE PRINT-REC AFTER ADVANCING LONG-ONE. SQ1014.2 +177600 WRT-END-GF-53. SQ1014.2 +177700* SQ1014.2 +177800 WRT-INIT-GF-54. SQ1014.2 +177900* SQ1014.2 +178000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 51 SQ1014.2 +178100* SQ1014.2 +178200 MOVE "WRT AFTER S99 LINE" TO FEATURE. SQ1014.2 +178300 MOVE "WRT-TEST-GF-54" TO PAR-NAME. SQ1014.2 +178400 GO TO WRT-TEST-GF-54. SQ1014.2 +178500 WRT-DELETE-GF-54. SQ1014.2 +178600 PERFORM DE-LETE. SQ1014.2 +178700 GO TO WRT-END-GF-54. SQ1014.2 +178800 WRT-TEST-GF-54. SQ1014.2 +178900 PERFORM INSPT. SQ1014.2 +179000 PERFORM WRITE-TEST-LINE. SQ1014.2 +179100 MOVE 2 TO IDENT-2-S99. SQ1014.2 +179200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +179300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +179400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +179500 WRITE PRINT-REC AFTER IDENT-2-S99 LINE. SQ1014.2 +179600 WRT-END-GF-54. SQ1014.2 +179700* SQ1014.2 +179800 WRT-INIT-GF-55. SQ1014.2 +179900* SQ1014.2 +180000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 55 SQ1014.2 +180100* SQ1014.2 +180200 MOVE "WRT AFTER PIC99 LINES" TO FEATURE. SQ1014.2 +180300 MOVE "WRT-TEST-GF-55" TO PAR-NAME. SQ1014.2 +180400 GO TO WRT-TEST-GF-55. SQ1014.2 +180500 WRT-DELETE-GF-55. SQ1014.2 +180600 PERFORM DE-LETE. SQ1014.2 +180700 GO TO WRT-END-GF-55. SQ1014.2 +180800 WRT-TEST-GF-55. SQ1014.2 +180900 PERFORM INSPT. SQ1014.2 +181000 PERFORM WRITE-TEST-LINE. SQ1014.2 +181100 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +181200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +181300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +181400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +181500 WRITE PRINT-REC AFTER IDENTIFIER-2 LINES. SQ1014.2 +181600 WRT-END-GF-55. SQ1014.2 +181700* SQ1014.2 +181800 WRT-INIT-GF-56. SQ1014.2 +181900* SQ1014.2 +182000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 59 SQ1014.2 +182100* SQ1014.2 +182200 MOVE "WRT AFTER PIC99" TO FEATURE. SQ1014.2 +182300 MOVE "WRT-TEST-GF-56" TO PAR-NAME. SQ1014.2 +182400 GO TO WRT-TEST-GF-56. SQ1014.2 +182500 WRT-DELETE-GF-56. SQ1014.2 +182600 PERFORM DE-LETE. SQ1014.2 +182700 GO TO WRT-END-GF-56. SQ1014.2 +182800 WRT-TEST-GF-56. SQ1014.2 +182900 PERFORM INSPT. SQ1014.2 +183000 PERFORM WRITE-TEST-LINE. SQ1014.2 +183100 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +183200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +183300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +183400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +183500 WRITE PRINT-REC AFTER IDENTIFIER-2. SQ1014.2 +183600 WRT-END-GF-56. SQ1014.2 +183700* SQ1014.2 +183800 WRT-INIT-GF-57. SQ1014.2 +183900* SQ1014.2 +184000* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +184100* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +184200* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +184300* THIRD PRINTABLE LINE. SQ1014.2 +184400* SQ1014.2 +184500 MOVE "WRT FROM AFTER PAGE" TO FEATURE. SQ1014.2 +184600 MOVE "WRT-TEST-GF-57" TO PAR-NAME. SQ1014.2 +184700 GO TO WRT-TEST-GF-57. SQ1014.2 +184800 WRT-DELETE-GF-57. SQ1014.2 +184900 PERFORM DE-LETE. SQ1014.2 +185000 GO TO WRT-END-GF-57. SQ1014.2 +185100 WRT-TEST-GF-57. SQ1014.2 +185200 PERFORM INSPT. SQ1014.2 +185300 PERFORM WRITE-TEST-LINE. SQ1014.2 +185400 WRITE PRINT-REC FROM NEW-PAGE-LINE AFTER PAGE. SQ1014.2 +185500 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +185600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +185700 WRT-END-GF-57. SQ1014.2 +185800* SQ1014.2 +185900 AFTER-LAST-TEST. SQ1014.2 +186000 MOVE "FINAL WRT TEST LINE" TO FEATURE. SQ1014.2 +186100 MOVE "AFTER-LAST-TEST" TO PAR-NAME. SQ1014.2 +186200 PERFORM WRITE-TEST-LINE. SQ1014.2 +186300* SQ1014.2 +186400* SQ1014.2 +186500 SQ-END-ROUTINE. SQ1014.2 +186600 GO TO CCVS-EXIT. SQ1014.2 +186700* SQ1014.2 +186800 WRITE-TEST-LINE. SQ1014.2 +186900 MOVE TEST-RESULTS TO PRINT-REC. SQ1014.2 +187000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187100 MOVE SPACE TO PRINT-REC. SQ1014.2 +187200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187300* SQ1014.2 +187400 COL-1-CHAR-PRINT. SQ1014.2 +187500 ADD 1 TO LIN-SER SQ1014.2 +187600 MOVE CHAR-LINE TO PRINT-REC SQ1014.2 +187700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187800* SQ1014.2 +187900 CCVS-EXIT SECTION. SQ1014.2 +188000 CCVS-999999. SQ1014.2 +188100 GO TO CLOSE-FILES. SQ1014.2 +*END-OF,SQ101M +*HEADER,COBOL,SQ102A +000100 IDENTIFICATION DIVISION. SQ1024.2 +000200 PROGRAM-ID. SQ1024.2 +000300 SQ102A. SQ1024.2 +000400**************************************************************** SQ1024.2 +000500* * SQ1024.2 +000600* VALIDATION FOR:- * SQ1024.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1024.2 +000900* REVISED 1986, AUGUST * SQ1024.2 +001000* * SQ1024.2 +001100* CREATION DATE / VALIDATION DATE * SQ1024.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1024.2 +001300* * SQ1024.2 +001400**************************************************************** SQ1024.2 +001500* * SQ1024.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1024.2 +001700* * SQ1024.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE * SQ1024.2 +001900* X-55 SYSTEM PRINTER * SQ1024.2 +002000* X-82 SOURCE-COMPUTER * SQ1024.2 +002100* X-83 OBJECT-COMPUTER. * SQ1024.2 +002200* * SQ1024.2 +002300**************************************************************** SQ1024.2 +002400* * SQ1024.2 +002500* SQ102A CREATES A MAGNETIC TAPE FILE CONTAINING 750 FIXED * SQ1024.2 +002600* LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS * SQ1024.2 +002700* READ TWICE. THE FIRST PASS CHECKS THAT ALL THE EXPECTED * SQ1024.2 +002800* RECORDS ARE PRESENT. THE SECOND PASS PERFORMS SIMILAR * SQ1024.2 +002900* CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ STATEMENT * SQ1024.2 +003000* WITH THE END PHRASE THAT CAN BE PRODUCED BY INCLUDING OR * SQ1024.2 +003100* OMITTING THE OPTIONAL WORDS "RECORD" AND "AT". * SQ1024.2 +003200* * SQ1024.2 +003300* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1024.2 +003400* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1024.2 +003500* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1024.2 +003600* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1024.2 +003700* * SQ1024.2 +003800**************************************************************** SQ1024.2 +003900* SQ1024.2 +004000* SQ1024.2 +004100 ENVIRONMENT DIVISION. SQ1024.2 +004200 CONFIGURATION SECTION. SQ1024.2 +004300 SOURCE-COMPUTER. SQ1024.2 +004400 XXXXX082. SQ1024.2 +004500 OBJECT-COMPUTER. SQ1024.2 +004600 XXXXX083. SQ1024.2 +004700* SQ1024.2 +004800 INPUT-OUTPUT SECTION. SQ1024.2 +004900 FILE-CONTROL. SQ1024.2 +005000 SELECT PRINT-FILE ASSIGN TO SQ1024.2 +005100 XXXXX055. SQ1024.2 +005200* SQ1024.2 +005300P SELECT RAW-DATA ASSIGN TO SQ1024.2 +005400P XXXXX062 SQ1024.2 +005500P ORGANIZATION IS INDEXED SQ1024.2 +005600P ACCESS MODE IS RANDOM SQ1024.2 +005700P RECORD-KEY IS RAW-DATA-KEY. SQ1024.2 +005800P SQ1024.2 +005900 SELECT SQ-FS1 SQ1024.2 +006000 ACCESS MODE IS SEQUENTIAL SQ1024.2 +006100 SEQUENTIAL SQ1024.2 +006200 ASSIGN TO SQ1024.2 +006300 XXXXX001 SQ1024.2 +006400 . SQ1024.2 +006500* SQ1024.2 +006600* SQ1024.2 +006700 DATA DIVISION. SQ1024.2 +006800 FILE SECTION. SQ1024.2 +006900 FD PRINT-FILE SQ1024.2 +007000C LABEL RECORDS SQ1024.2 +007100C XXXXX084 SQ1024.2 +007200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1024.2 +007300 . SQ1024.2 +007400 01 PRINT-REC PICTURE X(120). SQ1024.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ1024.2 +007600P SQ1024.2 +007700PFD RAW-DATA. SQ1024.2 +007800P01 RAW-DATA-SATZ. SQ1024.2 +007900P 05 RAW-DATA-KEY PIC X(6). SQ1024.2 +008000P 05 C-DATE PIC 9(6). SQ1024.2 +008100P 05 C-TIME PIC 9(8). SQ1024.2 +008200P 05 NO-OF-TESTS PIC 99. SQ1024.2 +008300P 05 C-OK PIC 999. SQ1024.2 +008400P 05 C-ALL PIC 999. SQ1024.2 +008500P 05 C-FAIL PIC 999. SQ1024.2 +008600P 05 C-DELETED PIC 999. SQ1024.2 +008700P 05 C-INSPECT PIC 999. SQ1024.2 +008800P 05 C-NOTE PIC X(13). SQ1024.2 +008900P 05 C-INDENT PIC X. SQ1024.2 +009000P 05 C-ABORT PIC X(8). SQ1024.2 +009100* SQ1024.2 +009200 FD SQ-FS1 SQ1024.2 +009300C LABEL RECORD IS STANDARD SQ1024.2 +009400 . SQ1024.2 +009500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1024.2 +009600* SQ1024.2 +009700 WORKING-STORAGE SECTION. SQ1024.2 +009800* SQ1024.2 +009900*************************************************************** SQ1024.2 +010000* * SQ1024.2 +010100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1024.2 +010200* * SQ1024.2 +010300*************************************************************** SQ1024.2 +010400* SQ1024.2 +010500 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1024.2 +010600 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1024.2 +010700 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1024.2 +010800* SQ1024.2 +010900*************************************************************** SQ1024.2 +011000* * SQ1024.2 +011100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1024.2 +011200* * SQ1024.2 +011300*************************************************************** SQ1024.2 +011400* SQ1024.2 +011500 01 REC-SKEL-SUB PIC 99. SQ1024.2 +011600* SQ1024.2 +011700 01 FILE-RECORD-INFORMATION-REC. SQ1024.2 +011800 03 FILE-RECORD-INFO-SKELETON. SQ1024.2 +011900 05 FILLER PICTURE X(48) VALUE SQ1024.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1024.2 +012100 05 FILLER PICTURE X(46) VALUE SQ1024.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1024.2 +012300 05 FILLER PICTURE X(26) VALUE SQ1024.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". SQ1024.2 +012500 05 FILLER PICTURE X(37) VALUE SQ1024.2 +012600 ",RECKEY= ". SQ1024.2 +012700 05 FILLER PICTURE X(38) VALUE SQ1024.2 +012800 ",ALTKEY1= ". SQ1024.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1024.2 +013000 ",ALTKEY2= ". SQ1024.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1024.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1024.2 +013300 05 FILE-RECORD-INFO-P1-120. SQ1024.2 +013400 07 FILLER PIC X(5). SQ1024.2 +013500 07 XFILE-NAME PIC X(6). SQ1024.2 +013600 07 FILLER PIC X(8). SQ1024.2 +013700 07 XRECORD-NAME PIC X(6). SQ1024.2 +013800 07 FILLER PIC X(1). SQ1024.2 +013900 07 REELUNIT-NUMBER PIC 9(1). SQ1024.2 +014000 07 FILLER PIC X(7). SQ1024.2 +014100 07 XRECORD-NUMBER PIC 9(6). SQ1024.2 +014200 07 FILLER PIC X(6). SQ1024.2 +014300 07 UPDATE-NUMBER PIC 9(2). SQ1024.2 +014400 07 FILLER PIC X(5). SQ1024.2 +014500 07 ODO-NUMBER PIC 9(4). SQ1024.2 +014600 07 FILLER PIC X(5). SQ1024.2 +014700 07 XPROGRAM-NAME PIC X(5). SQ1024.2 +014800 07 FILLER PIC X(7). SQ1024.2 +014900 07 XRECORD-LENGTH PIC 9(6). SQ1024.2 +015000 07 FILLER PIC X(7). SQ1024.2 +015100 07 CHARS-OR-RECORDS PIC X(2). SQ1024.2 +015200 07 FILLER PIC X(1). SQ1024.2 +015300 07 XBLOCK-SIZE PIC 9(4). SQ1024.2 +015400 07 FILLER PIC X(6). SQ1024.2 +015500 07 RECORDS-IN-FILE PIC 9(6). SQ1024.2 +015600 07 FILLER PIC X(5). SQ1024.2 +015700 07 XFILE-ORGANIZATION PIC X(2). SQ1024.2 +015800 07 FILLER PIC X(6). SQ1024.2 +015900 07 XLABEL-TYPE PIC X(1). SQ1024.2 +016000 05 FILE-RECORD-INFO-P121-240. SQ1024.2 +016100 07 FILLER PIC X(8). SQ1024.2 +016200 07 XRECORD-KEY PIC X(29). SQ1024.2 +016300 07 FILLER PIC X(9). SQ1024.2 +016400 07 ALTERNATE-KEY1 PIC X(29). SQ1024.2 +016500 07 FILLER PIC X(9). SQ1024.2 +016600 07 ALTERNATE-KEY2 PIC X(29). SQ1024.2 +016700 07 FILLER PIC X(7). SQ1024.2 +016800* SQ1024.2 +016900 01 TEST-RESULTS. SQ1024.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017100 02 PAR-NAME. SQ1024.2 +017200 03 FILLER PIC X(14) VALUE SPACE. SQ1024.2 +017300 03 PARDOT-X PIC X VALUE SPACE. SQ1024.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1024.2 +017500 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017600 02 FEATURE PIC X(24) VALUE SPACE. SQ1024.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1024.2 +017900 02 FILLER PIC X(9) VALUE SPACE. SQ1024.2 +018000 02 RE-MARK PIC X(61). SQ1024.2 +018100 01 TEST-COMPUTED. SQ1024.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ1024.2 +018300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1024.2 +018400 02 COMPUTED-X. SQ1024.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1024.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1024.2 +018700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1024.2 +018800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1024.2 +018900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1024.2 +019000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1024.2 +019100 04 COMPUTED-18V0 PIC -9(18). SQ1024.2 +019200 04 FILLER PIC X. SQ1024.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ1024.2 +019400 01 TEST-CORRECT. SQ1024.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1024.2 +019600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1024.2 +019700 02 CORRECT-X. SQ1024.2 +019800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1024.2 +019900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1024.2 +020000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1024.2 +020100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1024.2 +020200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1024.2 +020300 03 CR-18V0 REDEFINES CORRECT-A. SQ1024.2 +020400 04 CORRECT-18V0 PIC -9(18). SQ1024.2 +020500 04 FILLER PIC X. SQ1024.2 +020600 03 FILLER PIC X(2) VALUE SPACE. SQ1024.2 +020700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1024.2 +020800 01 CCVS-C-1. SQ1024.2 +020900 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1024.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1024.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1024.2 +021500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1024.2 +021600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1024.2 +021700 01 CCVS-C-2. SQ1024.2 +021800 02 FILLER PIC X(19) VALUE SPACE. SQ1024.2 +021900 02 FILLER PIC X(6) VALUE "TESTED". SQ1024.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1024.2 +022100 02 FILLER PIC X(4) VALUE "FAIL". SQ1024.2 +022200 02 FILLER PIC X(72) VALUE SPACE. SQ1024.2 +022300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1024.2 +022400 01 REC-CT PIC 99 VALUE ZERO. SQ1024.2 +022500 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022600 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022800 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022900 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1024.2 +023000 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1024.2 +023100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1024.2 +023200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1024.2 +023300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1024.2 +023400 01 CCVS-H-1. SQ1024.2 +023500 02 FILLER PIC X(39) VALUE SPACES. SQ1024.2 +023600 02 FILLER PIC X(42) VALUE SQ1024.2 +023700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1024.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1024.2 +023900 01 CCVS-H-2A. SQ1024.2 +024000 02 FILLER PIC X(40) VALUE SPACE. SQ1024.2 +024100 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1024.2 +024200 02 FILLER PIC XXXX VALUE SQ1024.2 +024300 "4.2 ". SQ1024.2 +024400 02 FILLER PIC X(28) VALUE SQ1024.2 +024500 " COPY - NOT FOR DISTRIBUTION". SQ1024.2 +024600 02 FILLER PIC X(41) VALUE SPACE. SQ1024.2 +024700* SQ1024.2 +024800 01 CCVS-H-2B. SQ1024.2 +024900 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1024.2 +025000 02 TEST-ID PIC X(9). SQ1024.2 +025100 02 FILLER PIC X(4) VALUE " IN ". SQ1024.2 +025200 02 FILLER PIC X(12) VALUE SQ1024.2 +025300 " HIGH ". SQ1024.2 +025400 02 FILLER PIC X(22) VALUE SQ1024.2 +025500 " LEVEL VALIDATION FOR ". SQ1024.2 +025600 02 FILLER PIC X(58) VALUE SQ1024.2 +025700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +025800 01 CCVS-H-3. SQ1024.2 +025900 02 FILLER PIC X(34) VALUE SQ1024.2 +026000 " FOR OFFICIAL USE ONLY ". SQ1024.2 +026100 02 FILLER PIC X(58) VALUE SQ1024.2 +026200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1024.2 +026300 02 FILLER PIC X(28) VALUE SQ1024.2 +026400 " COPYRIGHT 1985,1986 ". SQ1024.2 +026500 01 CCVS-E-1. SQ1024.2 +026600 02 FILLER PIC X(52) VALUE SPACE. SQ1024.2 +026700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1024.2 +026800 02 ID-AGAIN PIC X(9). SQ1024.2 +026900 02 FILLER PIC X(45) VALUE SPACES. SQ1024.2 +027000 01 CCVS-E-2. SQ1024.2 +027100 02 FILLER PIC X(31) VALUE SPACE. SQ1024.2 +027200 02 FILLER PIC X(21) VALUE SPACE. SQ1024.2 +027300 02 CCVS-E-2-2. SQ1024.2 +027400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1024.2 +027500 03 FILLER PIC X VALUE SPACE. SQ1024.2 +027600 03 ENDER-DESC PIC X(44) VALUE SQ1024.2 +027700 "ERRORS ENCOUNTERED". SQ1024.2 +027800 01 CCVS-E-3. SQ1024.2 +027900 02 FILLER PIC X(22) VALUE SQ1024.2 +028000 " FOR OFFICIAL USE ONLY". SQ1024.2 +028100 02 FILLER PIC X(12) VALUE SPACE. SQ1024.2 +028200 02 FILLER PIC X(58) VALUE SQ1024.2 +028300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +028400 02 FILLER PIC X(8) VALUE SPACE. SQ1024.2 +028500 02 FILLER PIC X(20) VALUE SQ1024.2 +028600 " COPYRIGHT 1985,1986". SQ1024.2 +028700 01 CCVS-E-4. SQ1024.2 +028800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1024.2 +028900 02 FILLER PIC X(4) VALUE " OF ". SQ1024.2 +029000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1024.2 +029100 02 FILLER PIC X(40) VALUE SQ1024.2 +029200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1024.2 +029300 01 XXINFO. SQ1024.2 +029400 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1024.2 +029500 02 INFO-TEXT. SQ1024.2 +029600 04 FILLER PIC X(8) VALUE SPACE. SQ1024.2 +029700 04 XXCOMPUTED PIC X(20). SQ1024.2 +029800 04 FILLER PIC X(5) VALUE SPACE. SQ1024.2 +029900 04 XXCORRECT PIC X(20). SQ1024.2 +030000 02 INF-ANSI-REFERENCE PIC X(48). SQ1024.2 +030100 01 HYPHEN-LINE. SQ1024.2 +030200 02 FILLER PIC IS X VALUE IS SPACE. SQ1024.2 +030300 02 FILLER PIC IS X(65) VALUE IS "************************SQ1024.2 +030400- "*****************************************". SQ1024.2 +030500 02 FILLER PIC IS X(54) VALUE IS "************************SQ1024.2 +030600- "******************************". SQ1024.2 +030700 01 CCVS-PGM-ID PIC X(9) VALUE SQ1024.2 +030800 "SQ102A". SQ1024.2 +030900* SQ1024.2 +031000* SQ1024.2 +031100 PROCEDURE DIVISION. SQ1024.2 +031200* SQ1024.2 +031300 CCVS1 SECTION. SQ1024.2 +031400 OPEN-FILES. SQ1024.2 +031500P OPEN I-O RAW-DATA. SQ1024.2 +031600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1024.2 +031700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1024.2 +031800P MOVE "ABORTED " TO C-ABORT. SQ1024.2 +031900P ADD 1 TO C-NO-OF-TESTS. SQ1024.2 +032000P ACCEPT C-DATE FROM DATE. SQ1024.2 +032100P ACCEPT C-TIME FROM TIME. SQ1024.2 +032200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1024.2 +032300PEND-E-1. SQ1024.2 +032400P CLOSE RAW-DATA. SQ1024.2 +032500 OPEN OUTPUT PRINT-FILE. SQ1024.2 +032600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1024.2 +032700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1024.2 +032800 MOVE SPACE TO TEST-RESULTS. SQ1024.2 +032900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1024.2 +033000 MOVE ZERO TO REC-SKEL-SUB. SQ1024.2 +033100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1024.2 +033200 GO TO CCVS1-EXIT. SQ1024.2 +033300* SQ1024.2 +033400 CCVS-INIT-FILE. SQ1024.2 +033500 ADD 1 TO REC-SKL-SUB. SQ1024.2 +033600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1024.2 +033700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1024.2 +033800* SQ1024.2 +033900 CLOSE-FILES. SQ1024.2 +034000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1024.2 +034100 CLOSE PRINT-FILE. SQ1024.2 +034200P OPEN I-O RAW-DATA. SQ1024.2 +034300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1024.2 +034400P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1024.2 +034500P MOVE "OK. " TO C-ABORT. SQ1024.2 +034600P MOVE PASS-COUNTER TO C-OK. SQ1024.2 +034700P MOVE ERROR-HOLD TO C-ALL. SQ1024.2 +034800P MOVE ERROR-COUNTER TO C-FAIL. SQ1024.2 +034900P MOVE DELETE-CNT TO C-DELETED. SQ1024.2 +035000P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1024.2 +035100P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1024.2 +035200PEND-E-2. SQ1024.2 +035300P CLOSE RAW-DATA. SQ1024.2 +035400 TERMINATE-CCVS. SQ1024.2 +035500S EXIT PROGRAM. SQ1024.2 +035600 STOP RUN. SQ1024.2 +035700* SQ1024.2 +035800 INSPT. SQ1024.2 +035900 MOVE "INSPT" TO P-OR-F. SQ1024.2 +036000 ADD 1 TO INSPECT-COUNTER. SQ1024.2 +036100 PERFORM PRINT-DETAIL. SQ1024.2 +036200* SQ1024.2 +036300 PASS. SQ1024.2 +036400 MOVE "PASS " TO P-OR-F. SQ1024.2 +036500 ADD 1 TO PASS-COUNTER. SQ1024.2 +036600 PERFORM PRINT-DETAIL. SQ1024.2 +036700* SQ1024.2 +036800 FAIL. SQ1024.2 +036900 MOVE "FAIL*" TO P-OR-F. SQ1024.2 +037000 ADD 1 TO ERROR-COUNTER. SQ1024.2 +037100 PERFORM PRINT-DETAIL. SQ1024.2 +037200* SQ1024.2 +037300 DE-LETE. SQ1024.2 +037400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1024.2 +037500 MOVE "*****" TO P-OR-F. SQ1024.2 +037600 ADD 1 TO DELETE-COUNTER. SQ1024.2 +037700 PERFORM PRINT-DETAIL. SQ1024.2 +037800* SQ1024.2 +037900 PRINT-DETAIL. SQ1024.2 +038000 IF REC-CT NOT EQUAL TO ZERO SQ1024.2 +038100 MOVE "." TO PARDOT-X SQ1024.2 +038200 MOVE REC-CT TO DOTVALUE. SQ1024.2 +038300 MOVE TEST-RESULTS TO PRINT-REC. SQ1024.2 +038400 PERFORM WRITE-LINE. SQ1024.2 +038500 IF P-OR-F EQUAL TO "FAIL*" SQ1024.2 +038600 PERFORM WRITE-LINE SQ1024.2 +038700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1024.2 +038800 ELSE SQ1024.2 +038900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1024.2 +039000 MOVE SPACE TO P-OR-F. SQ1024.2 +039100 MOVE SPACE TO COMPUTED-X. SQ1024.2 +039200 MOVE SPACE TO CORRECT-X. SQ1024.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1024.2 +039400 MOVE SPACE TO RE-MARK. SQ1024.2 +039500* SQ1024.2 +039600 HEAD-ROUTINE. SQ1024.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1024.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1024.2 +040100 COLUMN-NAMES-ROUTINE. SQ1024.2 +040200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +040300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +040500 END-ROUTINE. SQ1024.2 +040600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1024.2 +040700 PERFORM WRITE-LINE 5 TIMES. SQ1024.2 +040800 END-RTN-EXIT. SQ1024.2 +040900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1024.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +041100* SQ1024.2 +041200 END-ROUTINE-1. SQ1024.2 +041300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1024.2 +041400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1024.2 +041500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1024.2 +041600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1024.2 +041700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1024.2 +041800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1024.2 +041900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1024.2 +042000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1024.2 +042100 PERFORM WRITE-LINE. SQ1024.2 +042200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1024.2 +042300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1024.2 +042400 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +042500 ELSE SQ1024.2 +042600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1024.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1024.2 +042800 PERFORM WRITE-LINE. SQ1024.2 +042900 END-ROUTINE-13. SQ1024.2 +043000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1024.2 +043100 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +043200 ELSE SQ1024.2 +043300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1024.2 +043400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1024.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1024.2 +043600 PERFORM WRITE-LINE. SQ1024.2 +043700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1024.2 +043800 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +043900 ELSE SQ1024.2 +044000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1024.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1024.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +044400* SQ1024.2 +044500 WRITE-LINE. SQ1024.2 +044600 ADD 1 TO RECORD-COUNT. SQ1024.2 +044700Y IF RECORD-COUNT GREATER 50 SQ1024.2 +044800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1024.2 +044900Y MOVE SPACE TO DUMMY-RECORD SQ1024.2 +045000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1024.2 +045100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1024.2 +045200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1024.2 +045300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1024.2 +045400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1024.2 +045500Y MOVE ZERO TO RECORD-COUNT. SQ1024.2 +045600 PERFORM WRT-LN. SQ1024.2 +045700* SQ1024.2 +045800 WRT-LN. SQ1024.2 +045900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1024.2 +046000 MOVE SPACE TO DUMMY-RECORD. SQ1024.2 +046100 BLANK-LINE-PRINT. SQ1024.2 +046200 PERFORM WRT-LN. SQ1024.2 +046300 FAIL-ROUTINE. SQ1024.2 +046400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1024.2 +046500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1024.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1024.2 +046700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1024.2 +046800 MOVE XXINFO TO DUMMY-RECORD. SQ1024.2 +046900 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1024.2 +047100 GO TO FAIL-ROUTINE-EX. SQ1024.2 +047200 FAIL-ROUTINE-WRITE. SQ1024.2 +047300 MOVE TEST-COMPUTED TO PRINT-REC SQ1024.2 +047400 PERFORM WRITE-LINE SQ1024.2 +047500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1024.2 +047600 MOVE TEST-CORRECT TO PRINT-REC SQ1024.2 +047700 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +047800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1024.2 +047900 FAIL-ROUTINE-EX. SQ1024.2 +048000 EXIT. SQ1024.2 +048100 BAIL-OUT. SQ1024.2 +048200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1024.2 +048300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1024.2 +048400 BAIL-OUT-WRITE. SQ1024.2 +048500 MOVE CORRECT-A TO XXCORRECT. SQ1024.2 +048600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1024.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1024.2 +048800 MOVE XXINFO TO DUMMY-RECORD. SQ1024.2 +048900 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +049000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1024.2 +049100 BAIL-OUT-EX. SQ1024.2 +049200 EXIT. SQ1024.2 +049300 CCVS1-EXIT. SQ1024.2 +049400 EXIT. SQ1024.2 +049500* SQ1024.2 +049600**************************************************************** SQ1024.2 +049700* * SQ1024.2 +049800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1024.2 +049900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1024.2 +050000* * SQ1024.2 +050100**************************************************************** SQ1024.2 +050200* SQ1024.2 +050300 SECT-SQ102-0001 SECTION. SQ1024.2 +050400 SEQ-INIT-WR-01. SQ1024.2 +050500 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1024.2 +050600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1024.2 +050700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1024.2 +050800 MOVE 000120 TO XRECORD-LENGTH (1). SQ1024.2 +050900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1024.2 +051000 MOVE 0001 TO XBLOCK-SIZE (1). SQ1024.2 +051100 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1024.2 +051200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1024.2 +051300 MOVE "S" TO XLABEL-TYPE (1). SQ1024.2 +051400 MOVE ZERO TO XRECORD-NUMBER (1). SQ1024.2 +051500 MOVE "CREATE 750 RECORD FILE" TO FEATURE. SQ1024.2 +051600 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1024.2 +051700* SQ1024.2 +051800 SEQ-TEST-WR-01. SQ1024.2 +051900 OPEN OUTPUT SQ-FS1. SQ1024.2 +052000* SQ1024.2 +052100 SEQ-TEST-WR-01-LOOP. SQ1024.2 +052200 ADD 1 TO XRECORD-NUMBER (1). SQ1024.2 +052300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1024.2 +052400 WRITE SQ-FS1R1-F-G-120. SQ1024.2 +052500 IF XRECORD-NUMBER (1) LESS THAN 750 SQ1024.2 +052600 GO TO SEQ-TEST-WR-01-LOOP. SQ1024.2 +052700* SQ1024.2 +052800 CLOSE SQ-FS1. SQ1024.2 +052900* SQ1024.2 +053000* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 750 SQ1024.2 +053100* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1024.2 +053200* READ AND THE RECORDS VERIFIED. SQ1024.2 +053300* SQ1024.2 +053400 SEQ-INIT-GF-02. SQ1024.2 +053500 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1024.2 +053600 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1024.2 +053700 MOVE 1 TO REC-CT. SQ1024.2 +053800 GO TO SEQ-TEST-GF-02-01. SQ1024.2 +053900 SEQ-DELETE-02-01. SQ1024.2 +054000 GO TO SEQ-DELETE-02-02. SQ1024.2 +054100 SEQ-TEST-GF-02-01. SQ1024.2 +054200 OPEN INPUT SQ-FS1. SQ1024.2 +054300* SQ1024.2 +054400 SEQ-INIT-GF-02-02. SQ1024.2 +054500 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1024.2 +054600 TO FILE-RECORD-INFO-P1-120 (2). SQ1024.2 +054700 MOVE ZERO TO XRECORD-NUMBER (2). SQ1024.2 +054800 GO TO SEQ-TEST-GF-02-02. SQ1024.2 +054900 SEQ-DELETE-02-02. SQ1024.2 +055000 PERFORM DE-LETE. SQ1024.2 +055100 ADD 1 TO REC-CT. SQ1024.2 +055200 PERFORM DE-LETE. SQ1024.2 +055300 GO TO SEQ-DELETE-GF-02-05. SQ1024.2 +055400 SEQ-TEST-GF-02-02. SQ1024.2 +055500 SEQ-TEST-GF-02-02-LOOP. SQ1024.2 +055600 READ SQ-FS1 SQ1024.2 +055700 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1024.2 +055800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +055900 ADD 1 TO XRECORD-NUMBER (2). SQ1024.2 +056000 IF XRECORD-NUMBER (2) GREATER THAN 750 SQ1024.2 +056100 GO TO SEQ-TEST-GF-02-02-1. SQ1024.2 +056200 IF FILE-RECORD-INFO-P1-120 (1) SQ1024.2 +056300 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1024.2 +056400 ADD 1 TO RECORDS-IN-ERROR. SQ1024.2 +056500 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1024.2 +056600* SQ1024.2 +056700 SEQ-TEST-GF-02-02-1. SQ1024.2 +056800 IF XRECORD-NUMBER (2) = 750 SQ1024.2 +056900 PERFORM PASS SQ1024.2 +057000 ELSE SQ1024.2 +057100 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1024.2 +057200 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +057300 MOVE 750 TO CORRECT-18V0 SQ1024.2 +057400 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +057500 PERFORM FAIL. SQ1024.2 +057600* SQ1024.2 +057700 ADD 1 TO REC-CT. SQ1024.2 +057800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1024.2 +057900 PERFORM PASS SQ1024.2 +058000 ELSE SQ1024.2 +058100 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1024.2 +058200 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +058300 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1024.2 +058400 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1024.2 +058500 PERFORM FAIL. SQ1024.2 +058600* SQ1024.2 +058700 SEQ-INIT-GF-02-05. SQ1024.2 +058800 GO TO SEQ-TEST-GF-02-05. SQ1024.2 +058900 SEQ-DELETE-GF-02-05. SQ1024.2 +059000 GO TO SEQ-TEST-GF-02-END. SQ1024.2 +059100 SEQ-TEST-GF-02-05. SQ1024.2 +059200 CLOSE SQ-FS1. SQ1024.2 +059300 SEQ-TEST-GF-02-END. SQ1024.2 +059400* SQ1024.2 +059500* SQ1024.2 +059600 SEQ-INIT-GF-03. SQ1024.2 +059700 GO TO SEQ-TEST-GF-03. SQ1024.2 +059800 SEQ-DELETE-03. SQ1024.2 +059900 GO TO SEQ-TEST-03-END. SQ1024.2 +060000 SEQ-TEST-GF-03. SQ1024.2 +060100 OPEN INPUT SQ-FS1. SQ1024.2 +060200 SEQ-TEST-03-END. SQ1024.2 +060300* SQ1024.2 +060400* SQ1024.2 +060500* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1024.2 +060600* THE READ STATEMENT SQ1024.2 +060700* SQ1024.2 +060800 SEQ-INIT-GF-04. SQ1024.2 +060900 MOVE ZERO TO XRECORD-NUMBER (2). SQ1024.2 +061000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +061100 MOVE "READ...RECORD AT END" TO FEATURE. SQ1024.2 +061200 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1024.2 +061300 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +061400 MOVE 1 TO REC-CT. SQ1024.2 +061500 GO TO SEQ-TEST-GF-04. SQ1024.2 +061600 SEQ-DELETE-04. SQ1024.2 +061700 PERFORM DE-LETE. SQ1024.2 +061800 ADD 1 TO REC-CT. SQ1024.2 +061900 PERFORM DE-LETE. SQ1024.2 +062000 GO TO SEQ-TEST-04-END. SQ1024.2 +062100 SEQ-TEST-GF-04. SQ1024.2 +062200 READ SQ-FS1 RECORD AT END SQ1024.2 +062300 MOVE 1 TO EOF-FLAG SQ1024.2 +062400 GO TO SEQ-TEST-GF-04-01. SQ1024.2 +062500 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +062600 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +062700 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +062800 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +062900 MOVE 1 TO ERROR-FLAG. SQ1024.2 +063000 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1024.2 +063100 GO TO SEQ-TEST-GF-04. SQ1024.2 +063200* SQ1024.2 +063300 SEQ-TEST-GF-04-01. SQ1024.2 +063400 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +063500 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +063600 MOVE 750 TO CORRECT-18V0 SQ1024.2 +063700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +063800 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +063900 PERFORM FAIL SQ1024.2 +064000 ELSE SQ1024.2 +064100 PERFORM PASS. SQ1024.2 +064200* SQ1024.2 +064300 SEQ-TEST-GF-04-02. SQ1024.2 +064400 ADD 1 TO REC-CT. SQ1024.2 +064500 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +064600 PERFORM PASS SQ1024.2 +064700 ELSE SQ1024.2 +064800 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +064900 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +065000 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +065100 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +065200 PERFORM FAIL. SQ1024.2 +065300 SEQ-TEST-04-END. SQ1024.2 +065400* SQ1024.2 +065500* SQ1024.2 +065600 SEQ-INIT-GF-O5. SQ1024.2 +065700 MOVE 1 TO REC-CT. SQ1024.2 +065800 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +065900 GO TO SEQ-DELETE-05. SQ1024.2 +066000 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +066100 MOVE "READ...AT END..." TO FEATURE SQ1024.2 +066200 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1024.2 +066300 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +066400 GO TO SEQ-TEST-GF-05. SQ1024.2 +066500 SEQ-DELETE-05. SQ1024.2 +066600 PERFORM DE-LETE. SQ1024.2 +066700 ADD 1 TO REC-CT. SQ1024.2 +066800 PERFORM DE-LETE. SQ1024.2 +066900 GO TO SEQ-TEST-05-END. SQ1024.2 +067000 SEQ-TEST-GF-05. SQ1024.2 +067100 READ SQ-FS1 AT END SQ1024.2 +067200 MOVE 1 TO EOF-FLAG SQ1024.2 +067300 GO TO SEQ-TEST-GF-05-01. SQ1024.2 +067400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +067500 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +067600 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +067700 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +067800 MOVE 1 TO ERROR-FLAG. SQ1024.2 +067900 IF XRECORD-NUMBER (2) LESS THAN 400 SQ1024.2 +068000 GO TO SEQ-TEST-GF-05. SQ1024.2 +068100* SQ1024.2 +068200 SEQ-TEST-GF-05-01. SQ1024.2 +068300 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +068400 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +068500 MOVE 750 TO CORRECT-18V0 SQ1024.2 +068600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +068700 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +068800 PERFORM FAIL SQ1024.2 +068900 ELSE SQ1024.2 +069000 PERFORM PASS. SQ1024.2 +069100* SQ1024.2 +069200 SEQ-TEST-GF-05-02. SQ1024.2 +069300 ADD 1 TO REC-CT. SQ1024.2 +069400 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +069500 PERFORM PASS SQ1024.2 +069600 ELSE SQ1024.2 +069700 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +069800 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +069900 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +070000 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +070100 PERFORM FAIL. SQ1024.2 +070200 SEQ-TEST-05-END. SQ1024.2 +070300* SQ1024.2 +070400* SQ1024.2 +070500 SEQ-INIT-GF-O6. SQ1024.2 +070600 MOVE 1 TO REC-CT. SQ1024.2 +070700 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +070800 GO TO SEQ-DELETE-06. SQ1024.2 +070900 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +071000 MOVE "READ...RECORD END..." TO FEATURE SQ1024.2 +071100 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1024.2 +071200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +071300 GO TO SEQ-TEST-GF-06. SQ1024.2 +071400 SEQ-DELETE-06. SQ1024.2 +071500 PERFORM DE-LETE. SQ1024.2 +071600 ADD 1 TO REC-CT. SQ1024.2 +071700 PERFORM DE-LETE. SQ1024.2 +071800 GO TO SEQ-TEST-06-END. SQ1024.2 +071900 SEQ-TEST-GF-06. SQ1024.2 +072000 READ SQ-FS1 RECORD END SQ1024.2 +072100 MOVE 1 TO EOF-FLAG SQ1024.2 +072200 GO TO SEQ-TEST-GF-06-01. SQ1024.2 +072300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +072400 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +072500 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +072600 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +072700 MOVE 1 TO ERROR-FLAG. SQ1024.2 +072800 IF XRECORD-NUMBER (2) LESS THAN 600 SQ1024.2 +072900 GO TO SEQ-TEST-GF-06. SQ1024.2 +073000* SQ1024.2 +073100 SEQ-TEST-GF-06-01. SQ1024.2 +073200 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +073300 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +073400 MOVE 750 TO CORRECT-18V0 SQ1024.2 +073500 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +073600 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +073700 PERFORM FAIL SQ1024.2 +073800 ELSE SQ1024.2 +073900 PERFORM PASS. SQ1024.2 +074000* SQ1024.2 +074100 SEQ-TEST-GF-06-02. SQ1024.2 +074200 ADD 1 TO REC-CT. SQ1024.2 +074300 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +074400 PERFORM PASS SQ1024.2 +074500 ELSE SQ1024.2 +074600 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +074700 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +074800 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +074900 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +075000 PERFORM FAIL. SQ1024.2 +075100 SEQ-TEST-06-END. SQ1024.2 +075200* SQ1024.2 +075300* SQ1024.2 +075400 SEQ-INIT-GF-O7. SQ1024.2 +075500 MOVE 1 TO REC-CT. SQ1024.2 +075600 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +075700 GO TO SEQ-DELETE-07. SQ1024.2 +075800 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +075900 MOVE "READ... END..." TO FEATURE SQ1024.2 +076000 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1024.2 +076100 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +076200 GO TO SEQ-TEST-GF-07. SQ1024.2 +076300 SEQ-DELETE-07. SQ1024.2 +076400 PERFORM DE-LETE. SQ1024.2 +076500 ADD 1 TO REC-CT. SQ1024.2 +076600 PERFORM DE-LETE. SQ1024.2 +076700 GO TO SEQ-TEST-07-END. SQ1024.2 +076800 SEQ-TEST-GF-07. SQ1024.2 +076900 READ SQ-FS1 END SQ1024.2 +077000 MOVE 1 TO EOF-FLAG SQ1024.2 +077100 GO TO SEQ-TEST-GF-07-01. SQ1024.2 +077200 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +077300 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +077400 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +077500 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +077600 MOVE 1 TO ERROR-FLAG. SQ1024.2 +077700 IF XRECORD-NUMBER (2) LESS THAN 750 SQ1024.2 +077800 GO TO SEQ-TEST-GF-07. SQ1024.2 +077900* SQ1024.2 +078000 SEQ-TEST-GF-07-01. SQ1024.2 +078100 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +078200 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +078300 MOVE 750 TO CORRECT-18V0 SQ1024.2 +078400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +078500 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +078600 PERFORM FAIL SQ1024.2 +078700 ELSE SQ1024.2 +078800 PERFORM PASS. SQ1024.2 +078900* SQ1024.2 +079000 SEQ-TEST-GF-07-02. SQ1024.2 +079100 ADD 1 TO REC-CT. SQ1024.2 +079200 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +079300 PERFORM PASS SQ1024.2 +079400 ELSE SQ1024.2 +079500 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +079600 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +079700 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +079800 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +079900 PERFORM FAIL. SQ1024.2 +080000 SEQ-TEST-07-END. SQ1024.2 +080100* SQ1024.2 +080200* SQ1024.2 +080300 SEQ-INIT-GF-O8. SQ1024.2 +080400 MOVE 1 TO REC-CT. SQ1024.2 +080500 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +080600 GO TO SEQ-DELETE-08. SQ1024.2 +080700 MOVE "READ... END... AT EOF" TO FEATURE SQ1024.2 +080800 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1024.2 +080900 GO TO SEQ-TEST-GF-08. SQ1024.2 +081000 SEQ-DELETE-08. SQ1024.2 +081100 PERFORM DE-LETE. SQ1024.2 +081200 GO TO SEQ-TEST-08-END. SQ1024.2 +081300 SEQ-TEST-GF-08. SQ1024.2 +081400 READ SQ-FS1 END SQ1024.2 +081500 MOVE 1 TO EOF-FLAG. SQ1024.2 +081600* SQ1024.2 +081700 SEQ-TEST-GF-08-01. SQ1024.2 +081800 IF EOF-FLAG NOT EQUAL TO 1 SQ1024.2 +081900 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1024.2 +082000 MOVE 1 TO CORRECT-18V0 SQ1024.2 +082100 MOVE "EOF NOT FOUND AFTER 750 RECORDS" TO RE-MARK SQ1024.2 +082200 PERFORM FAIL SQ1024.2 +082300 ELSE SQ1024.2 +082400 PERFORM PASS. SQ1024.2 +082500 SEQ-TEST-08-END. SQ1024.2 +082600* SQ1024.2 +082700* SQ1024.2 +082800 SEQ-INIT-GF-O9. SQ1024.2 +082900 GO TO SEQ-TEST-GF-09. SQ1024.2 +083000 SEQ-DELETE-09. SQ1024.2 +083100 GO TO SEQ-TEST-09-END. SQ1024.2 +083200 SEQ-TEST-GF-09. SQ1024.2 +083300 CLOSE SQ-FS1. SQ1024.2 +083400 SEQ-TEST-09-END. SQ1024.2 +083500* SQ1024.2 +083600* SQ1024.2 +083700 TERMINATE-ROUTINE. SQ1024.2 +083800 EXIT. SQ1024.2 +083900 CCVS-EXIT SECTION. SQ1024.2 +084000 CCVS-999999. SQ1024.2 +084100 GO TO CLOSE-FILES. SQ1024.2 +*END-OF,SQ102A +*HEADER,COBOL,SQ103A +000100 IDENTIFICATION DIVISION. SQ1034.2 +000200 PROGRAM-ID. SQ1034.2 +000300 SQ103A. SQ1034.2 +000400**************************************************************** SQ1034.2 +000500* * SQ1034.2 +000600* VALIDATION FOR:- * SQ1034.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1034.2 +000900* REVISED 1986, AUGUST * SQ1034.2 +001000* * SQ1034.2 +001100* CREATION DATE / VALIDATION DATE * SQ1034.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1034.2 +001300* * SQ1034.2 +001400**************************************************************** SQ1034.2 +001500* * SQ1034.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1034.2 +001700* * SQ1034.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE SQ1034.2 +001900* X-55 SYSTEM PRINTER * SQ1034.2 +002000* X-82 SOURCE-COMPUTER * SQ1034.2 +002100* X-83 OBJECT-COMPUTER. * SQ1034.2 +002200* * SQ1034.2 +002300**************************************************************** SQ1034.2 +002400* * SQ1034.2 +002500* THIS PROGRAM CREATES A TAPE FILE OF 500 FIXED LENGTH * SQ1034.2 +002600* RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS CLOSED * SQ1034.2 +002700* AND OPENED AGAIN AS AN INPUT FILE. THE FILE IS READ * SQ1034.2 +002800* USING A READ STATEMENT WITH THE AT END PHRASE. RECORDS * SQ1034.2 +002900* ARE COUNTED AND COMPARED WITH THE VALUES WRITTEN TO * SQ1034.2 +003000* ENSURE THAT THEY WERE PROCESSED CORRECTLY. THERE IS A * SQ1034.2 +003100* DECLARATIVE PROCEDURE FOR THE FILE AND TESTS ARE MADE * SQ1034.2 +003200* DURING THIS PASS TO CHECK THAT IT IS NOT ENTERED AFTER * SQ1034.2 +003300* I-O STATEMENT, INCLUDING THAT WHICH RAISES THE AT END * SQ1034.2 +003400* CONDITION. THE FILE IS CLOSED AND OPENED IN THE INPUT * SQ1034.2 +003500* MODE AGAIN. ON THIS PASS, THE FILE IS READ USING READ * SQ1034.2 +003600* STATEMENTS WITHOUT THE AT END PHRASE. FIRST HUNDRED * SQ1034.2 +003700* RECORDS ARE READ USING A READ STATEMENT WITH THE OPTIONAL * SQ1034.2 +003800* WORD "RECORD", THE REMAINDER WITHOUT IT. ON THIS PASS, * SQ1034.2 +003900* THE AT END CONDITION SHOULD CAUSE EXECUTION OF THE * SQ1034.2 +004000* DECLARATIVE PROCEDURE. * SQ1034.2 +004100* * SQ1034.2 +004200* THE FILE-CONTROL ENTRY FOR THE FILE CONTAINS A FILE * SQ1034.2 +004300* STATUS CLAUSE, AND TESTS CHECK THAT EACH I-O OPERATION * SQ1034.2 +004400* RETURNS THE APPROPRIATE STATUS VALUE. * SQ1034.2 +004500* * SQ1034.2 +004600**************************************************************** SQ1034.2 +004700* SQ1034.2 +004800* SQ1034.2 +004900 ENVIRONMENT DIVISION. SQ1034.2 +005000 CONFIGURATION SECTION. SQ1034.2 +005100 SOURCE-COMPUTER. SQ1034.2 +005200 XXXXX082. SQ1034.2 +005300 OBJECT-COMPUTER. SQ1034.2 +005400 XXXXX083. SQ1034.2 +005500* SQ1034.2 +005600 INPUT-OUTPUT SECTION. SQ1034.2 +005700 FILE-CONTROL. SQ1034.2 +005800 SELECT PRINT-FILE ASSIGN TO SQ1034.2 +005900 XXXXX055. SQ1034.2 +006000* SQ1034.2 +006100P SELECT RAW-DATA ASSIGN TO SQ1034.2 +006200P XXXXX062 SQ1034.2 +006300P ORGANIZATION IS INDEXED SQ1034.2 +006400P ACCESS MODE IS RANDOM SQ1034.2 +006500P RECORD-KEY IS RAW-DATA-KEY. SQ1034.2 +006600P SQ1034.2 +006700 SELECT SQ-FS2 ASSIGN TO SQ1034.2 +006800 XXXXX001 SQ1034.2 +006900 ACCESS MODE IS SEQUENTIAL SQ1034.2 +007000 FILE STATUS IS SQ-FS2-STATUS SQ1034.2 +007100 ORGANIZATION SEQUENTIAL SQ1034.2 +007200 . SQ1034.2 +007300* SQ1034.2 +007400* SQ1034.2 +007500 DATA DIVISION. SQ1034.2 +007600 FILE SECTION. SQ1034.2 +007700 FD PRINT-FILE SQ1034.2 +007800C LABEL RECORDS SQ1034.2 +007900C XXXXX084 SQ1034.2 +008000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1034.2 +008100 . SQ1034.2 +008200 01 PRINT-REC PICTURE X(120). SQ1034.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ1034.2 +008400P SQ1034.2 +008500PFD RAW-DATA. SQ1034.2 +008600P01 RAW-DATA-SATZ. SQ1034.2 +008700P 05 RAW-DATA-KEY PIC X(6). SQ1034.2 +008800P 05 C-DATE PIC 9(6). SQ1034.2 +008900P 05 C-TIME PIC 9(8). SQ1034.2 +009000P 05 NO-OF-TESTS PIC 99. SQ1034.2 +009100P 05 C-OK PIC 999. SQ1034.2 +009200P 05 C-ALL PIC 999. SQ1034.2 +009300P 05 C-FAIL PIC 999. SQ1034.2 +009400P 05 C-DELETED PIC 999. SQ1034.2 +009500P 05 C-INSPECT PIC 999. SQ1034.2 +009600P 05 C-NOTE PIC X(13). SQ1034.2 +009700P 05 C-INDENT PIC X. SQ1034.2 +009800P 05 C-ABORT PIC X(8). SQ1034.2 +009900* SQ1034.2 +010000 FD SQ-FS2 SQ1034.2 +010100C LABEL RECORD IS STANDARD SQ1034.2 +010200 . SQ1034.2 +010300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ1034.2 +010400* SQ1034.2 +010500 WORKING-STORAGE SECTION. SQ1034.2 +010600* SQ1034.2 +010700*************************************************************** SQ1034.2 +010800* * SQ1034.2 +010900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1034.2 +011000* * SQ1034.2 +011100*************************************************************** SQ1034.2 +011200* SQ1034.2 +011300 01 SQ-FS2-STATUS. SQ1034.2 +011400 03 SQ-FS2-KEY-1 PIC X. SQ1034.2 +011500 03 SQ-FS2-KEY-2 PIC X. SQ1034.2 +011600* SQ1034.2 +011700 01 SQ-FS2-STATUS-COPY PIC XX. SQ1034.2 +011800 01 DECL-EXEC-SW PIC 9. SQ1034.2 +011900 01 DECL-EXEC-COUNT PIC 99999. SQ1034.2 +012000 01 EOF-FLAG PIC 9 VALUE 0. SQ1034.2 +012100 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMPUTATIONAL. SQ1034.2 +012200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP. SQ1034.2 +012300 01 ERROR-FLAG PICTURE 9. SQ1034.2 +012400* SQ1034.2 +012500*************************************************************** SQ1034.2 +012600* * SQ1034.2 +012700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1034.2 +012800* * SQ1034.2 +012900*************************************************************** SQ1034.2 +013000* SQ1034.2 +013100 01 REC-SKEL-SUB PIC 99. SQ1034.2 +013200* SQ1034.2 +013300 01 FILE-RECORD-INFORMATION-REC. SQ1034.2 +013400 03 FILE-RECORD-INFO-SKELETON. SQ1034.2 +013500 05 FILLER PICTURE X(48) VALUE SQ1034.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1034.2 +013700 05 FILLER PICTURE X(46) VALUE SQ1034.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1034.2 +013900 05 FILLER PICTURE X(26) VALUE SQ1034.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". SQ1034.2 +014100 05 FILLER PICTURE X(37) VALUE SQ1034.2 +014200 ",RECKEY= ". SQ1034.2 +014300 05 FILLER PICTURE X(38) VALUE SQ1034.2 +014400 ",ALTKEY1= ". SQ1034.2 +014500 05 FILLER PICTURE X(38) VALUE SQ1034.2 +014600 ",ALTKEY2= ". SQ1034.2 +014700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1034.2 +014800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1034.2 +014900 05 FILE-RECORD-INFO-P1-120. SQ1034.2 +015000 07 FILLER PIC X(5). SQ1034.2 +015100 07 XFILE-NAME PIC X(6). SQ1034.2 +015200 07 FILLER PIC X(8). SQ1034.2 +015300 07 XRECORD-NAME PIC X(6). SQ1034.2 +015400 07 FILLER PIC X(1). SQ1034.2 +015500 07 REELUNIT-NUMBER PIC 9(1). SQ1034.2 +015600 07 FILLER PIC X(7). SQ1034.2 +015700 07 XRECORD-NUMBER PIC 9(6). SQ1034.2 +015800 07 FILLER PIC X(6). SQ1034.2 +015900 07 UPDATE-NUMBER PIC 9(2). SQ1034.2 +016000 07 FILLER PIC X(5). SQ1034.2 +016100 07 ODO-NUMBER PIC 9(4). SQ1034.2 +016200 07 FILLER PIC X(5). SQ1034.2 +016300 07 XPROGRAM-NAME PIC X(5). SQ1034.2 +016400 07 FILLER PIC X(7). SQ1034.2 +016500 07 XRECORD-LENGTH PIC 9(6). SQ1034.2 +016600 07 FILLER PIC X(7). SQ1034.2 +016700 07 CHARS-OR-RECORDS PIC X(2). SQ1034.2 +016800 07 FILLER PIC X(1). SQ1034.2 +016900 07 XBLOCK-SIZE PIC 9(4). SQ1034.2 +017000 07 FILLER PIC X(6). SQ1034.2 +017100 07 RECORDS-IN-FILE PIC 9(6). SQ1034.2 +017200 07 FILLER PIC X(5). SQ1034.2 +017300 07 XFILE-ORGANIZATION PIC X(2). SQ1034.2 +017400 07 FILLER PIC X(6). SQ1034.2 +017500 07 XLABEL-TYPE PIC X(1). SQ1034.2 +017600 05 FILE-RECORD-INFO-P121-240. SQ1034.2 +017700 07 FILLER PIC X(8). SQ1034.2 +017800 07 XRECORD-KEY PIC X(29). SQ1034.2 +017900 07 FILLER PIC X(9). SQ1034.2 +018000 07 ALTERNATE-KEY1 PIC X(29). SQ1034.2 +018100 07 FILLER PIC X(9). SQ1034.2 +018200 07 ALTERNATE-KEY2 PIC X(29). SQ1034.2 +018300 07 FILLER PIC X(7). SQ1034.2 +018400* SQ1034.2 +018500 01 TEST-RESULTS. SQ1034.2 +018600 02 FILLER PIC X VALUE SPACE. SQ1034.2 +018700 02 PAR-NAME. SQ1034.2 +018800 03 FILLER PIC X(14) VALUE SPACE. SQ1034.2 +018900 03 PARDOT-X PIC X VALUE SPACE. SQ1034.2 +019000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1034.2 +019100 02 FILLER PIC X VALUE SPACE. SQ1034.2 +019200 02 FEATURE PIC X(24) VALUE SPACE. SQ1034.2 +019300 02 FILLER PIC X VALUE SPACE. SQ1034.2 +019400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1034.2 +019500 02 FILLER PIC X(9) VALUE SPACE. SQ1034.2 +019600 02 RE-MARK PIC X(61). SQ1034.2 +019700 01 TEST-COMPUTED. SQ1034.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1034.2 +019900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1034.2 +020000 02 COMPUTED-X. SQ1034.2 +020100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1034.2 +020200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1034.2 +020300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1034.2 +020400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1034.2 +020500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1034.2 +020600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1034.2 +020700 04 COMPUTED-18V0 PIC -9(18). SQ1034.2 +020800 04 FILLER PIC X. SQ1034.2 +020900 03 FILLER PIC X(50) VALUE SPACE. SQ1034.2 +021000 01 TEST-CORRECT. SQ1034.2 +021100 02 FILLER PIC X(30) VALUE SPACE. SQ1034.2 +021200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1034.2 +021300 02 CORRECT-X. SQ1034.2 +021400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1034.2 +021500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1034.2 +021600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1034.2 +021700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1034.2 +021800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1034.2 +021900 03 CR-18V0 REDEFINES CORRECT-A. SQ1034.2 +022000 04 CORRECT-18V0 PIC -9(18). SQ1034.2 +022100 04 FILLER PIC X. SQ1034.2 +022200 03 FILLER PIC X(2) VALUE SPACE. SQ1034.2 +022300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1034.2 +022400* SQ1034.2 +022500 01 CCVS-C-1. SQ1034.2 +022600 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +022700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1034.2 +022800 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +022900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1034.2 +023000 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +023100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1034.2 +023200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1034.2 +023300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1034.2 +023400 01 CCVS-C-2. SQ1034.2 +023500 02 FILLER PIC X(20) VALUE SPACE. SQ1034.2 +023600 02 FILLER PIC X(6) VALUE "TESTED". SQ1034.2 +023700 02 FILLER PIC X(18) VALUE SPACE. SQ1034.2 +023800 02 FILLER PIC X(4) VALUE "FAIL". SQ1034.2 +023900 02 FILLER PIC X(72) VALUE SPACE. SQ1034.2 +024000* SQ1034.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1034.2 +024200 01 REC-CT PIC 99 VALUE ZERO. SQ1034.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1034.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1034.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1034.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1034.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1034.2 +025200 01 CCVS-H-1. SQ1034.2 +025300 02 FILLER PIC X(39) VALUE SPACES. SQ1034.2 +025400 02 FILLER PIC X(42) VALUE SQ1034.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1034.2 +025600 02 FILLER PIC X(39) VALUE SPACES. SQ1034.2 +025700 01 CCVS-H-2A. SQ1034.2 +025800 02 FILLER PIC X(40) VALUE SPACE. SQ1034.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1034.2 +026000 02 FILLER PIC XXXX VALUE SQ1034.2 +026100 "4.2 ". SQ1034.2 +026200 02 FILLER PIC X(28) VALUE SQ1034.2 +026300 " COPY - NOT FOR DISTRIBUTION". SQ1034.2 +026400 02 FILLER PIC X(41) VALUE SPACE. SQ1034.2 +026500* SQ1034.2 +026600 01 CCVS-H-2B. SQ1034.2 +026700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1034.2 +026800 02 TEST-ID PIC X(9). SQ1034.2 +026900 02 FILLER PIC X(4) VALUE " IN ". SQ1034.2 +027000 02 FILLER PIC X(12) VALUE SQ1034.2 +027100 " HIGH ". SQ1034.2 +027200 02 FILLER PIC X(22) VALUE SQ1034.2 +027300 " LEVEL VALIDATION FOR ". SQ1034.2 +027400 02 FILLER PIC X(58) VALUE SQ1034.2 +027500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +027600 01 CCVS-H-3. SQ1034.2 +027700 02 FILLER PIC X(34) VALUE SQ1034.2 +027800 " FOR OFFICIAL USE ONLY ". SQ1034.2 +027900 02 FILLER PIC X(58) VALUE SQ1034.2 +028000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1034.2 +028100 02 FILLER PIC X(28) VALUE SQ1034.2 +028200 " COPYRIGHT 1985,1986 ". SQ1034.2 +028300 01 CCVS-E-1. SQ1034.2 +028400 02 FILLER PIC X(52) VALUE SPACE. SQ1034.2 +028500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1034.2 +028600 02 ID-AGAIN PIC X(9). SQ1034.2 +028700 02 FILLER PIC X(45) VALUE SPACES. SQ1034.2 +028800 01 CCVS-E-2. SQ1034.2 +028900 02 FILLER PIC X(31) VALUE SPACE. SQ1034.2 +029000 02 FILLER PIC X(21) VALUE SPACE. SQ1034.2 +029100 02 CCVS-E-2-2. SQ1034.2 +029200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1034.2 +029300 03 FILLER PIC X VALUE SPACE. SQ1034.2 +029400 03 ENDER-DESC PIC X(44) VALUE SQ1034.2 +029500 "ERRORS ENCOUNTERED". SQ1034.2 +029600 01 CCVS-E-3. SQ1034.2 +029700 02 FILLER PIC X(22) VALUE SQ1034.2 +029800 " FOR OFFICIAL USE ONLY". SQ1034.2 +029900 02 FILLER PIC X(12) VALUE SPACE. SQ1034.2 +030000 02 FILLER PIC X(58) VALUE SQ1034.2 +030100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +030200 02 FILLER PIC X(8) VALUE SPACE. SQ1034.2 +030300 02 FILLER PIC X(20) VALUE SQ1034.2 +030400 " COPYRIGHT 1985,1986". SQ1034.2 +030500 01 CCVS-E-4. SQ1034.2 +030600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1034.2 +030700 02 FILLER PIC X(4) VALUE " OF ". SQ1034.2 +030800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1034.2 +030900 02 FILLER PIC X(40) VALUE SQ1034.2 +031000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1034.2 +031100 01 XXINFO. SQ1034.2 +031200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1034.2 +031300 02 INFO-TEXT. SQ1034.2 +031400 04 FILLER PIC X(8) VALUE SPACE. SQ1034.2 +031500 04 XXCOMPUTED PIC X(20). SQ1034.2 +031600 04 FILLER PIC X(5) VALUE SPACE. SQ1034.2 +031700 04 XXCORRECT PIC X(20). SQ1034.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). SQ1034.2 +031900 01 HYPHEN-LINE. SQ1034.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. SQ1034.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1034.2 +032200- "*****************************************". SQ1034.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1034.2 +032400- "******************************". SQ1034.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1034.2 +032600 "SQ103A". SQ1034.2 +032700* SQ1034.2 +032800* SQ1034.2 +032900 PROCEDURE DIVISION. SQ1034.2 +033000 DECLARATIVES. SQ1034.2 +033100 SECT-SQ103-0001 SECTION. SQ1034.2 +033200 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS2. SQ1034.2 +033300 TEST-STATUS. SQ1034.2 +033400 MOVE ZERO TO DECL-EXEC-SW. SQ1034.2 +033500 ADD 1 TO DECL-EXEC-COUNT. SQ1034.2 +033600 END DECLARATIVES. SQ1034.2 +033700* SQ1034.2 +033800 CCVS1 SECTION. SQ1034.2 +033900 OPEN-FILES. SQ1034.2 +034000P OPEN I-O RAW-DATA. SQ1034.2 +034100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1034.2 +034200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1034.2 +034300P MOVE "ABORTED " TO C-ABORT. SQ1034.2 +034400P ADD 1 TO C-NO-OF-TESTS. SQ1034.2 +034500P ACCEPT C-DATE FROM DATE. SQ1034.2 +034600P ACCEPT C-TIME FROM TIME. SQ1034.2 +034700P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1034.2 +034800PEND-E-1. SQ1034.2 +034900P CLOSE RAW-DATA. SQ1034.2 +035000 OPEN OUTPUT PRINT-FILE. SQ1034.2 +035100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1034.2 +035200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1034.2 +035300 MOVE SPACE TO TEST-RESULTS. SQ1034.2 +035400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1034.2 +035500 MOVE ZERO TO REC-SKEL-SUB. SQ1034.2 +035600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1034.2 +035700 GO TO CCVS1-EXIT. SQ1034.2 +035800* SQ1034.2 +035900 CCVS-INIT-FILE. SQ1034.2 +036000 ADD 1 TO REC-SKL-SUB. SQ1034.2 +036100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1034.2 +036200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1034.2 +036300* SQ1034.2 +036400 CLOSE-FILES. SQ1034.2 +036500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1034.2 +036600 CLOSE PRINT-FILE. SQ1034.2 +036700P OPEN I-O RAW-DATA. SQ1034.2 +036800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1034.2 +036900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1034.2 +037000P MOVE "OK. " TO C-ABORT. SQ1034.2 +037100P MOVE PASS-COUNTER TO C-OK. SQ1034.2 +037200P MOVE ERROR-HOLD TO C-ALL. SQ1034.2 +037300P MOVE ERROR-COUNTER TO C-FAIL. SQ1034.2 +037400P MOVE DELETE-CNT TO C-DELETED. SQ1034.2 +037500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1034.2 +037600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1034.2 +037700PEND-E-2. SQ1034.2 +037800P CLOSE RAW-DATA. SQ1034.2 +037900 TERMINATE-CCVS. SQ1034.2 +038000S EXIT PROGRAM. SQ1034.2 +038100 STOP RUN. SQ1034.2 +038200* SQ1034.2 +038300 INSPT. SQ1034.2 +038400 MOVE "INSPT" TO P-OR-F. SQ1034.2 +038500 ADD 1 TO INSPECT-COUNTER. SQ1034.2 +038600 PERFORM PRINT-DETAIL. SQ1034.2 +038700* SQ1034.2 +038800 PASS. SQ1034.2 +038900 MOVE "PASS " TO P-OR-F. SQ1034.2 +039000 ADD 1 TO PASS-COUNTER. SQ1034.2 +039100 PERFORM PRINT-DETAIL. SQ1034.2 +039200* SQ1034.2 +039300 FAIL. SQ1034.2 +039400 MOVE "FAIL*" TO P-OR-F. SQ1034.2 +039500 ADD 1 TO ERROR-COUNTER. SQ1034.2 +039600 PERFORM PRINT-DETAIL. SQ1034.2 +039700* SQ1034.2 +039800 DE-LETE. SQ1034.2 +039900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1034.2 +040000 MOVE "*****" TO P-OR-F. SQ1034.2 +040100 ADD 1 TO DELETE-COUNTER. SQ1034.2 +040200 PERFORM PRINT-DETAIL. SQ1034.2 +040300* SQ1034.2 +040400 PRINT-DETAIL. SQ1034.2 +040500 IF REC-CT NOT EQUAL TO ZERO SQ1034.2 +040600 MOVE "." TO PARDOT-X SQ1034.2 +040700 MOVE REC-CT TO DOTVALUE. SQ1034.2 +040800 MOVE TEST-RESULTS TO PRINT-REC. SQ1034.2 +040900 PERFORM WRITE-LINE. SQ1034.2 +041000 IF P-OR-F EQUAL TO "FAIL*" SQ1034.2 +041100 PERFORM WRITE-LINE SQ1034.2 +041200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1034.2 +041300 ELSE SQ1034.2 +041400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1034.2 +041500 MOVE SPACE TO P-OR-F. SQ1034.2 +041600 MOVE SPACE TO COMPUTED-X. SQ1034.2 +041700 MOVE SPACE TO CORRECT-X. SQ1034.2 +041800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1034.2 +041900 MOVE SPACE TO RE-MARK. SQ1034.2 +042000* SQ1034.2 +042100 HEAD-ROUTINE. SQ1034.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1034.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1034.2 +042600 COLUMN-NAMES-ROUTINE. SQ1034.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +043000 END-ROUTINE. SQ1034.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1034.2 +043200 PERFORM WRITE-LINE 5 TIMES. SQ1034.2 +043300 END-RTN-EXIT. SQ1034.2 +043400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1034.2 +043500 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +043600* SQ1034.2 +043700 END-ROUTINE-1. SQ1034.2 +043800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1034.2 +043900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1034.2 +044000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1034.2 +044100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1034.2 +044200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1034.2 +044300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1034.2 +044400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1034.2 +044500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1034.2 +044600 PERFORM WRITE-LINE. SQ1034.2 +044700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1034.2 +044800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1034.2 +044900 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +045000 ELSE SQ1034.2 +045100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1034.2 +045200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1034.2 +045300 PERFORM WRITE-LINE. SQ1034.2 +045400 END-ROUTINE-13. SQ1034.2 +045500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1034.2 +045600 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +045700 ELSE SQ1034.2 +045800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1034.2 +045900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1034.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1034.2 +046100 PERFORM WRITE-LINE. SQ1034.2 +046200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1034.2 +046300 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +046400 ELSE SQ1034.2 +046500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1034.2 +046600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1034.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +046800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +046900* SQ1034.2 +047000 WRITE-LINE. SQ1034.2 +047100 ADD 1 TO RECORD-COUNT. SQ1034.2 +047200Y IF RECORD-COUNT GREATER 50 SQ1034.2 +047300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1034.2 +047400Y MOVE SPACE TO DUMMY-RECORD SQ1034.2 +047500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1034.2 +047600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1034.2 +047700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1034.2 +047800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1034.2 +047900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1034.2 +048000Y MOVE ZERO TO RECORD-COUNT. SQ1034.2 +048100 PERFORM WRT-LN. SQ1034.2 +048200* SQ1034.2 +048300 WRT-LN. SQ1034.2 +048400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1034.2 +048500 MOVE SPACE TO DUMMY-RECORD. SQ1034.2 +048600 BLANK-LINE-PRINT. SQ1034.2 +048700 PERFORM WRT-LN. SQ1034.2 +048800 FAIL-ROUTINE. SQ1034.2 +048900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1034.2 +049000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1034.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1034.2 +049200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1034.2 +049300 MOVE XXINFO TO DUMMY-RECORD. SQ1034.2 +049400 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +049500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1034.2 +049600 GO TO FAIL-ROUTINE-EX. SQ1034.2 +049700 FAIL-ROUTINE-WRITE. SQ1034.2 +049800 MOVE TEST-COMPUTED TO PRINT-REC SQ1034.2 +049900 PERFORM WRITE-LINE SQ1034.2 +050000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1034.2 +050100 MOVE TEST-CORRECT TO PRINT-REC SQ1034.2 +050200 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +050300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1034.2 +050400 FAIL-ROUTINE-EX. SQ1034.2 +050500 EXIT. SQ1034.2 +050600 BAIL-OUT. SQ1034.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1034.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1034.2 +050900 BAIL-OUT-WRITE. SQ1034.2 +051000 MOVE CORRECT-A TO XXCORRECT. SQ1034.2 +051100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1034.2 +051200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1034.2 +051300 MOVE XXINFO TO DUMMY-RECORD. SQ1034.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +051500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1034.2 +051600 BAIL-OUT-EX. SQ1034.2 +051700 EXIT. SQ1034.2 +051800 CCVS1-EXIT. SQ1034.2 +051900 EXIT. SQ1034.2 +052000* SQ1034.2 +052100**************************************************************** SQ1034.2 +052200* * SQ1034.2 +052300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1034.2 +052400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1034.2 +052500* * SQ1034.2 +052600**************************************************************** SQ1034.2 +052700* SQ1034.2 +052800 SECT-SQ103-0002 SECTION. SQ1034.2 +052900 INITIAL-PARA. SQ1034.2 +053000 MOVE "SQ-FS2" TO XFILE-NAME (1). SQ1034.2 +053100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1034.2 +053200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1034.2 +053300 MOVE 120 TO XRECORD-LENGTH (1). SQ1034.2 +053400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1034.2 +053500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1034.2 +053600 MOVE 500 TO RECORDS-IN-FILE (1). SQ1034.2 +053700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1034.2 +053800 MOVE "S" TO XLABEL-TYPE (1). SQ1034.2 +053900* SQ1034.2 +054000 SEQ-INIT-01. SQ1034.2 +054100 MOVE "SEQ-TEST-GF-01" TO PAR-NAME. SQ1034.2 +054200 MOVE "OPEN OUTPUT, TAPE FILE" TO FEATURE. SQ1034.2 +054300 MOVE 1 TO REC-CT. SQ1034.2 +054400 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +054500 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +054600 MOVE 000001 TO XRECORD-NUMBER (1). SQ1034.2 +054700 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +054800 GO TO SEQ-TEST-GF-01. SQ1034.2 +054900 SEQ-DELETE-01. SQ1034.2 +055000 PERFORM DE-LETE. SQ1034.2 +055100 ADD 1 TO REC-CT SQ1034.2 +055200 PERFORM DE-LETE. SQ1034.2 +055300 GO TO SEQ-DELETE-02. SQ1034.2 +055400 SEQ-TEST-GF-01. SQ1034.2 +055500 OPEN OUTPUT SQ-FS2. SQ1034.2 +055600 IF DECL-EXEC-SW = 1 SQ1034.2 +055700 PERFORM PASS SQ1034.2 +055800 ELSE SQ1034.2 +055900 MOVE 1 TO CORRECT-18V0 SQ1034.2 +056000 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +056100 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +056200 PERFORM FAIL. SQ1034.2 +056300 ADD 1 TO REC-CT. SQ1034.2 +056400 IF SQ-FS2-STATUS EQUAL "00" SQ1034.2 +056500 PERFORM PASS SQ1034.2 +056600 ELSE SQ1034.2 +056700 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +056800 MOVE "00" TO CORRECT-A SQ1034.2 +056900 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1034.2 +057000 PERFORM FAIL. SQ1034.2 +057100* SQ1034.2 +057200 SEQ-INIT-02. SQ1034.2 +057300 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +057400 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +057500 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +057600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +057700 GO TO SEQ-TEST-GF-02. SQ1034.2 +057800 SEQ-DELETE-02. SQ1034.2 +057900 MOVE 1 TO REC-CT. SQ1034.2 +058000 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1034.2 +058100 MOVE "WRITE 500 RECORDS" TO FEATURE. SQ1034.2 +058200 PERFORM DE-LETE. SQ1034.2 +058300 ADD 1 TO REC-CT. SQ1034.2 +058400 PERFORM DE-LETE. SQ1034.2 +058500 GO TO SEQ-TEST-02-END. SQ1034.2 +058600 SEQ-TEST-GF-02. SQ1034.2 +058700 MOVE 1 TO REC-CT. SQ1034.2 +058800 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1034.2 +058900 MOVE "WRITE 500 RECORDS" TO FEATURE. SQ1034.2 +059000 SEQ-TEST-GF-02-LOOP. SQ1034.2 +059100 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +059200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. SQ1034.2 +059300 WRITE SQ-FS2R1-F-G-120. SQ1034.2 +059400 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +059500 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +059600 IF XRECORD-NUMBER (1) LESS THAN 500 SQ1034.2 +059700 GO TO SEQ-TEST-GF-02-LOOP. SQ1034.2 +059800* SQ1034.2 +059900 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +060000 PERFORM PASS SQ1034.2 +060100 ELSE SQ1034.2 +060200 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +060300 MOVE 1 TO CORRECT-18V0 SQ1034.2 +060400 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +060500 PERFORM FAIL. SQ1034.2 +060600 ADD 1 TO REC-CT. SQ1034.2 +060700 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +060800 PERFORM PASS SQ1034.2 +060900 ELSE SQ1034.2 +061000 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +061100 MOVE "00" TO CORRECT-A SQ1034.2 +061200 MOVE "AT LEAST ONE UNSUCCESSFUL WRITE" TO RE-MARK SQ1034.2 +061300 PERFORM FAIL. SQ1034.2 +061400 SEQ-TEST-02-END. SQ1034.2 +061500* SQ1034.2 +061600 SEQ-INIT-03. SQ1034.2 +061700 MOVE 1 TO REC-CT. SQ1034.2 +061800 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1034.2 +061900 MOVE "CLOSE FILE FROM OUTPUT" TO FEATURE. SQ1034.2 +062000 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +062100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +062200 GO TO SEQ-TEST-GF-03. SQ1034.2 +062300 SEQ-DELETE-03. SQ1034.2 +062400 PERFORM DE-LETE. SQ1034.2 +062500 ADD 1 TO REC-CT. SQ1034.2 +062600 PERFORM DE-LETE. SQ1034.2 +062700 GO TO SEQ-TEST-03-END. SQ1034.2 +062800 SEQ-TEST-GF-03. SQ1034.2 +062900 CLOSE SQ-FS2. SQ1034.2 +063000 IF DECL-EXEC-SW = 1 SQ1034.2 +063100 PERFORM PASS SQ1034.2 +063200 ELSE SQ1034.2 +063300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +063400 MOVE 1 TO CORRECT-18V0 SQ1034.2 +063500 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +063600 TO RE-MARK SQ1034.2 +063700 PERFORM FAIL. SQ1034.2 +063800 ADD 1 TO REC-CT. SQ1034.2 +063900 IF SQ-FS2-STATUS = "00" SQ1034.2 +064000 PERFORM PASS SQ1034.2 +064100 ELSE SQ1034.2 +064200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +064300 MOVE "00" TO CORRECT-A SQ1034.2 +064400 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +064500 TO RE-MARK SQ1034.2 +064600 PERFORM FAIL. SQ1034.2 +064700 SEQ-TEST-03-END. SQ1034.2 +064800* SQ1034.2 +064900* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 500 SQ1034.2 +065000* FIXED-LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE NEXT SQ1034.2 +065100* GROUP OF TESTS READS THIS FILE, COUNTING THE RECORDS AND SQ1034.2 +065200* CHECKING THEIR CONTENT. SQ1034.2 +065300* SQ1034.2 +065400 SEQ-INIT-04. SQ1034.2 +065500 MOVE 1 TO REC-CT. SQ1034.2 +065600 MOVE "SEQ-TEST-GF-04" TO PAR-NAME. SQ1034.2 +065700 MOVE "OPEN NEWLY-WRITTEN FILE" TO FEATURE. SQ1034.2 +065800 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +065900 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +066000 GO TO SEQ-TEST-GF-04. SQ1034.2 +066100 SEQ-DELETE-04. SQ1034.2 +066200 PERFORM DE-LETE. SQ1034.2 +066300 ADD 1 TO REC-CT. SQ1034.2 +066400 PERFORM DE-LETE. SQ1034.2 +066500 GO TO SEQ-TEST-04-END. SQ1034.2 +066600 SEQ-TEST-GF-04. SQ1034.2 +066700 OPEN INPUT SQ-FS2. SQ1034.2 +066800 IF SQ-FS2-STATUS = "00" SQ1034.2 +066900 PERFORM PASS SQ1034.2 +067000 ELSE SQ1034.2 +067100 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +067200 MOVE "00" TO CORRECT-A SQ1034.2 +067300 MOVE "I-O STATUS INDICATES ABNORMAL OPEN" TO RE-MARK SQ1034.2 +067400 PERFORM FAIL. SQ1034.2 +067500 ADD 1 TO REC-CT. SQ1034.2 +067600 IF DECL-EXEC-SW = 1 SQ1034.2 +067700 PERFORM PASS SQ1034.2 +067800 ELSE SQ1034.2 +067900 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +068000 MOVE 1 TO CORRECT-18V0 SQ1034.2 +068100 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +068200 PERFORM FAIL. SQ1034.2 +068300 SEQ-TEST-04-END. SQ1034.2 +068400* SQ1034.2 +068500 SEQ-INIT-05. SQ1034.2 +068600 MOVE 1 TO REC-CT. SQ1034.2 +068700 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +068800 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +068900 MOVE ZERO TO EOF-FLAG. SQ1034.2 +069000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1034.2 +069100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +069200 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +069300 MOVE "READ 500 RECORD FILE" TO FEATURE. SQ1034.2 +069400 MOVE "SEQ-TEST-GF-05" TO PAR-NAME. SQ1034.2 +069500 GO TO SEQ-TEST-GF-05. SQ1034.2 +069600 SEQ-DELETE-05. SQ1034.2 +069700 PERFORM DE-LETE. SQ1034.2 +069800 ADD 1 TO REC-CT. SQ1034.2 +069900 PERFORM DE-LETE. SQ1034.2 +070000 ADD 1 TO REC-CT. SQ1034.2 +070100 PERFORM DE-LETE. SQ1034.2 +070200 ADD 1 TO REC-CT. SQ1034.2 +070300 PERFORM DE-LETE. SQ1034.2 +070400 ADD 1 TO REC-CT. SQ1034.2 +070500 PERFORM DE-LETE. SQ1034.2 +070600 ADD 1 TO REC-CT. SQ1034.2 +070700 PERFORM DE-LETE. SQ1034.2 +070800 GO TO SEQ-TEST-05-END. SQ1034.2 +070900 SEQ-TEST-GF-05. SQ1034.2 +071000 SEQ-TEST-GF-05-LOOP. SQ1034.2 +071100 READ SQ-FS2 RECORD END SQ1034.2 +071200 MOVE 1 TO EOF-FLAG SQ1034.2 +071300 GO TO SEQ-TEST-GF-05-02. SQ1034.2 +071400 IF SQ-FS2-STATUS = "10" SQ1034.2 +071500 GO TO SEQ-TEST-GF-05-02. SQ1034.2 +071600 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +071700 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +071800 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +071900 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +072000 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +072100 IF XRECORD-NUMBER (1) LESS THAN OR EQUAL TO 500 SQ1034.2 +072200 GO TO SEQ-TEST-GF-05-LOOP. SQ1034.2 +072300* SQ1034.2 +072400 SEQ-TEST-GF-05-02. SQ1034.2 +072500 IF XRECORD-NUMBER (1) = 500 SQ1034.2 +072600 PERFORM PASS SQ1034.2 +072700 ELSE SQ1034.2 +072800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +072900 MOVE 500 TO CORRECT-18V0 SQ1034.2 +073000 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +073100 TO RE-MARK SQ1034.2 +073200 PERFORM FAIL. SQ1034.2 +073300 ADD 1 TO REC-CT. SQ1034.2 +073400 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +073500 PERFORM PASS SQ1034.2 +073600 ELSE SQ1034.2 +073700 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +073800 MOVE 1 TO CORRECT-18V0 SQ1034.2 +073900 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +074000 PERFORM FAIL. SQ1034.2 +074100 ADD 1 TO REC-CT. SQ1034.2 +074200 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +074300 PERFORM PASS SQ1034.2 +074400 ELSE SQ1034.2 +074500 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +074600 MOVE "00" TO CORRECT-A SQ1034.2 +074700 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +074800 PERFORM FAIL. SQ1034.2 +074900 ADD 1 TO REC-CT. SQ1034.2 +075000 IF EOF-FLAG = 1 SQ1034.2 +075100 PERFORM PASS SQ1034.2 +075200 ELSE SQ1034.2 +075300 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1034.2 +075400 MOVE 1 TO CORRECT-18V0 SQ1034.2 +075500 MOVE "AT END STATEMENT NOT EXECUTED" TO RE-MARK SQ1034.2 +075600 MOVE "VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1034.2 +075700 PERFORM FAIL. SQ1034.2 +075800 ADD 1 TO REC-CT. SQ1034.2 +075900 IF SQ-FS2-STATUS EQUAL TO "10" SQ1034.2 +076000 PERFORM PASS SQ1034.2 +076100 ELSE SQ1034.2 +076200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +076300 MOVE "10" TO CORRECT-A SQ1034.2 +076400 MOVE "UNEXPECTED I-O STATUS FROM FINAL READ" SQ1034.2 +076500 TO RE-MARK SQ1034.2 +076600 MOVE "VII-46, 4.4.4(10)A, VII-3" TO ANSI-REFERENCE SQ1034.2 +076700 PERFORM FAIL. SQ1034.2 +076800 ADD 1 TO REC-CT. SQ1034.2 +076900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +077000 PERFORM PASS SQ1034.2 +077100 ELSE SQ1034.2 +077200 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +077300 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +077400 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +077500 PERFORM FAIL. SQ1034.2 +077600 SEQ-TEST-05-END. SQ1034.2 +077700* SQ1034.2 +077800 SEQ-INIT-06. SQ1034.2 +077900 MOVE "SEQ-TEST-GF-06" TO PAR-NAME. SQ1034.2 +078000 MOVE "CLOSE FILE FROM INPUT" TO FEATURE. SQ1034.2 +078100 MOVE 1 TO REC-CT. SQ1034.2 +078200 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +078300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +078400 GO TO SEQ-TEST-GF-06. SQ1034.2 +078500 SEQ-DELETE-06. SQ1034.2 +078600 PERFORM DE-LETE. SQ1034.2 +078700 ADD 1 TO REC-CT. SQ1034.2 +078800 PERFORM DE-LETE. SQ1034.2 +078900 GO TO SEQ-TEST-06-END. SQ1034.2 +079000 SEQ-TEST-GF-06. SQ1034.2 +079100 CLOSE SQ-FS2. SQ1034.2 +079200 IF DECL-EXEC-SW = 1 SQ1034.2 +079300 PERFORM PASS SQ1034.2 +079400 ELSE SQ1034.2 +079500 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +079600 MOVE 1 TO CORRECT-18V0 SQ1034.2 +079700 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +079800 TO RE-MARK SQ1034.2 +079900 PERFORM FAIL. SQ1034.2 +080000 ADD 1 TO REC-CT. SQ1034.2 +080100 IF SQ-FS2-STATUS = "00" SQ1034.2 +080200 PERFORM PASS SQ1034.2 +080300 ELSE SQ1034.2 +080400 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +080500 MOVE "00" TO CORRECT-A SQ1034.2 +080600 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +080700 TO RE-MARK SQ1034.2 +080800 PERFORM FAIL. SQ1034.2 +080900 SEQ-TEST-06-END. SQ1034.2 +081000* SQ1034.2 +081100* SQ1034.2 +081200* TWO OPTIONS FOR THE READ STATEMENT ARE CHECKED IN THIS SQ1034.2 +081300* SERIES OF TESTS, THE ABSENCE OF ALL OPTIONAL PHRASES, AND SQ1034.2 +081400* THE ABSENCE OF ALL EXCEPT THE OPTIONAL WORD "RECORD". SQ1034.2 +081500* SQ1034.2 +081600 SEQ-INIT-07. SQ1034.2 +081700 MOVE 1 TO REC-CT. SQ1034.2 +081800 MOVE "SEQ-TEST-GF-07" TO PAR-NAME. SQ1034.2 +081900 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1034.2 +082000 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +082100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +082200 GO TO SEQ-TEST-GF-07. SQ1034.2 +082300 SEQ-DELETE-07. SQ1034.2 +082400 PERFORM DE-LETE. SQ1034.2 +082500 ADD 1 TO REC-CT. SQ1034.2 +082600 PERFORM DE-LETE. SQ1034.2 +082700 GO TO SEQ-TEST-07-END. SQ1034.2 +082800 SEQ-TEST-GF-07. SQ1034.2 +082900 OPEN INPUT SQ-FS2. SQ1034.2 +083000 IF SQ-FS2-STATUS = "00" SQ1034.2 +083100 PERFORM PASS SQ1034.2 +083200 ELSE SQ1034.2 +083300 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +083400 MOVE "00" TO CORRECT-A SQ1034.2 +083500 MOVE "I-O STATUS INDICATES ABNORMAL OPEN" TO RE-MARK SQ1034.2 +083600 PERFORM FAIL. SQ1034.2 +083700 ADD 1 TO REC-CT. SQ1034.2 +083800 IF DECL-EXEC-SW = 1 SQ1034.2 +083900 PERFORM PASS SQ1034.2 +084000 ELSE SQ1034.2 +084100 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +084200 MOVE 1 TO CORRECT-18V0 SQ1034.2 +084300 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +084400 PERFORM FAIL. SQ1034.2 +084500 SEQ-TEST-07-END. SQ1034.2 +084600* SQ1034.2 +084700 SEQ-INIT-08. SQ1034.2 +084800 MOVE 1 TO REC-CT. SQ1034.2 +084900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1034.2 +085000 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +085100 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +085200 MOVE ZERO TO EOF-FLAG. SQ1034.2 +085300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +085400 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +085500 MOVE "READ ... RECORD" TO FEATURE. SQ1034.2 +085600 MOVE "SEQ-TEST-GF-08" TO PAR-NAME. SQ1034.2 +085700 GO TO SEQ-TEST-GF-08. SQ1034.2 +085800 SEQ-DELETE-08. SQ1034.2 +085900 PERFORM DE-LETE. SQ1034.2 +086000 ADD 1 TO REC-CT. SQ1034.2 +086100 PERFORM DE-LETE. SQ1034.2 +086200 ADD 1 TO REC-CT. SQ1034.2 +086300 PERFORM DE-LETE. SQ1034.2 +086400 ADD 1 TO REC-CT. SQ1034.2 +086500 PERFORM DE-LETE. SQ1034.2 +086600 GO TO SEQ-TEST-08-END. SQ1034.2 +086700 SEQ-TEST-GF-08. SQ1034.2 +086800 SEQ-TEST-GF-08-LOOP. SQ1034.2 +086900 READ SQ-FS2 RECORD. SQ1034.2 +087000 IF SQ-FS2-STATUS = "10" SQ1034.2 +087100 MOVE 1 TO EOF-FLAG SQ1034.2 +087200 GO TO SEQ-TEST-GF-08-02. SQ1034.2 +087300 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +087400 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +087500 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +087600 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +087700 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +087800 IF XRECORD-NUMBER (1) LESS THAN 100 SQ1034.2 +087900 GO TO SEQ-TEST-GF-08-LOOP. SQ1034.2 +088000* SQ1034.2 +088100 SEQ-TEST-GF-08-02. SQ1034.2 +088200 IF XRECORD-NUMBER (1) = 100 SQ1034.2 +088300 PERFORM PASS SQ1034.2 +088400 ELSE SQ1034.2 +088500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +088600 MOVE 100 TO CORRECT-18V0 SQ1034.2 +088700 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +088800 TO RE-MARK SQ1034.2 +088900 PERFORM FAIL. SQ1034.2 +089000 ADD 1 TO REC-CT. SQ1034.2 +089100 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +089200 PERFORM PASS SQ1034.2 +089300 ELSE SQ1034.2 +089400 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +089500 MOVE 1 TO CORRECT-18V0 SQ1034.2 +089600 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +089700 PERFORM FAIL. SQ1034.2 +089800 ADD 1 TO REC-CT. SQ1034.2 +089900 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +090000 PERFORM PASS SQ1034.2 +090100 ELSE SQ1034.2 +090200 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +090300 MOVE "00" TO CORRECT-A SQ1034.2 +090400 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +090500 PERFORM FAIL. SQ1034.2 +090600 ADD 1 TO REC-CT. SQ1034.2 +090700 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +090800 PERFORM PASS SQ1034.2 +090900 ELSE SQ1034.2 +091000 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +091100 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +091200 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +091300 PERFORM FAIL. SQ1034.2 +091400 SEQ-TEST-08-END. SQ1034.2 +091500* SQ1034.2 +091600 SEQ-INIT-09. SQ1034.2 +091700 MOVE 1 TO REC-CT. SQ1034.2 +091800 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +091900 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +092000 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +092100 MOVE "READ ..." TO FEATURE. SQ1034.2 +092200 MOVE "SEQ-TEST-GF-09" TO PAR-NAME. SQ1034.2 +092300 GO TO SEQ-TEST-GF-09. SQ1034.2 +092400 SEQ-DELETE-09. SQ1034.2 +092500 PERFORM DE-LETE. SQ1034.2 +092600 ADD 1 TO REC-CT. SQ1034.2 +092700 PERFORM DE-LETE. SQ1034.2 +092800 ADD 1 TO REC-CT. SQ1034.2 +092900 PERFORM DE-LETE. SQ1034.2 +093000 ADD 1 TO REC-CT. SQ1034.2 +093100 PERFORM DE-LETE. SQ1034.2 +093200 GO TO SEQ-TEST-09-END. SQ1034.2 +093300 SEQ-TEST-GF-09. SQ1034.2 +093400 IF EOF-FLAG = 1 SQ1034.2 +093500 GO TO SEQ-TEST-GF-09-02. SQ1034.2 +093600 SEQ-TEST-GF-09-LOOP. SQ1034.2 +093700 READ SQ-FS2. SQ1034.2 +093800 IF SQ-FS2-STATUS = "10" SQ1034.2 +093900 MOVE 1 TO EOF-FLAG SQ1034.2 +094000 GO TO SEQ-TEST-GF-09-02. SQ1034.2 +094100 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +094200 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +094300 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +094400 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +094500 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +094600 IF XRECORD-NUMBER (1) LESS THAN OR EQUAL TO 499 SQ1034.2 +094700 GO TO SEQ-TEST-GF-09-LOOP. SQ1034.2 +094800* SQ1034.2 +094900 SEQ-TEST-GF-09-02. SQ1034.2 +095000 IF XRECORD-NUMBER (1) = 500 SQ1034.2 +095100 PERFORM PASS SQ1034.2 +095200 ELSE SQ1034.2 +095300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +095400 MOVE 500 TO CORRECT-18V0 SQ1034.2 +095500 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +095600 TO RE-MARK SQ1034.2 +095700 PERFORM FAIL. SQ1034.2 +095800 ADD 1 TO REC-CT. SQ1034.2 +095900 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +096000 PERFORM PASS SQ1034.2 +096100 ELSE SQ1034.2 +096200 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +096300 MOVE 1 TO CORRECT-18V0 SQ1034.2 +096400 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +096500 PERFORM FAIL. SQ1034.2 +096600 ADD 1 TO REC-CT. SQ1034.2 +096700 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +096800 PERFORM PASS SQ1034.2 +096900 ELSE SQ1034.2 +097000 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +097100 MOVE "00" TO CORRECT-A SQ1034.2 +097200 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +097300 PERFORM FAIL. SQ1034.2 +097400 ADD 1 TO REC-CT. SQ1034.2 +097500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +097600 PERFORM PASS SQ1034.2 +097700 ELSE SQ1034.2 +097800 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +097900 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +098000 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +098100 PERFORM FAIL. SQ1034.2 +098200 SEQ-TEST-09-END. SQ1034.2 +098300* SQ1034.2 +098400 SEQ-INIT-10. SQ1034.2 +098500 MOVE 1 TO REC-CT. SQ1034.2 +098600 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +098700 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +098800 MOVE "SEQ-TEST-GF-10" TO PAR-NAME. SQ1034.2 +098900 MOVE "READ ... RAISING AT END" TO FEATURE. SQ1034.2 +099000 IF EOF-FLAG NOT EQUAL TO ZERO SQ1034.2 +099100 GO TO SEQ-DELETE-10. SQ1034.2 +099200 GO TO SEQ-TEST-GF-10. SQ1034.2 +099300 SEQ-DELETE-10. SQ1034.2 +099400 PERFORM DE-LETE. SQ1034.2 +099500 ADD 1 TO REC-CT. SQ1034.2 +099600 PERFORM DE-LETE. SQ1034.2 +099700 GO TO SEQ-TEST-10-END. SQ1034.2 +099800 SEQ-TEST-GF-10. SQ1034.2 +099900 READ SQ-FS2. SQ1034.2 +100000 IF DECL-EXEC-SW = 0 SQ1034.2 +100100 PERFORM PASS SQ1034.2 +100200 ELSE SQ1034.2 +100300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +100400 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +100500 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1034.2 +100600 MOVE "VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1034.2 +100700 PERFORM FAIL. SQ1034.2 +100800 ADD 1 TO REC-CT. SQ1034.2 +100900 IF SQ-FS2-STATUS = "10" SQ1034.2 +101000 PERFORM PASS SQ1034.2 +101100 ELSE SQ1034.2 +101200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +101300 MOVE "10" TO CORRECT-A SQ1034.2 +101400 MOVE "I-O STATUS FOR END OF FILE EXPECTED" TO RE-MARK SQ1034.2 +101500 PERFORM FAIL. SQ1034.2 +101600 SEQ-TEST-10-END. SQ1034.2 +101700* SQ1034.2 +101800 SEQ-INIT-11. SQ1034.2 +101900 MOVE "SEQ-TEST-GF-11" TO PAR-NAME. SQ1034.2 +102000 MOVE "CLOSE FILE FROM INPUT" TO FEATURE. SQ1034.2 +102100 MOVE 1 TO REC-CT. SQ1034.2 +102200 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +102300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +102400 GO TO SEQ-TEST-GF-11. SQ1034.2 +102500 SEQ-DELETE-11. SQ1034.2 +102600 PERFORM DE-LETE. SQ1034.2 +102700 ADD 1 TO REC-CT. SQ1034.2 +102800 PERFORM DE-LETE. SQ1034.2 +102900 GO TO SEQ-TEST-11-END. SQ1034.2 +103000 SEQ-TEST-GF-11. SQ1034.2 +103100 CLOSE SQ-FS2. SQ1034.2 +103200 IF DECL-EXEC-SW = 1 SQ1034.2 +103300 PERFORM PASS SQ1034.2 +103400 ELSE SQ1034.2 +103500 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +103600 MOVE 1 TO CORRECT-18V0 SQ1034.2 +103700 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +103800 TO RE-MARK SQ1034.2 +103900 PERFORM FAIL. SQ1034.2 +104000 ADD 1 TO REC-CT. SQ1034.2 +104100 IF SQ-FS2-STATUS = "00" SQ1034.2 +104200 PERFORM PASS SQ1034.2 +104300 ELSE SQ1034.2 +104400 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +104500 MOVE "00" TO CORRECT-A SQ1034.2 +104600 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +104700 TO RE-MARK SQ1034.2 +104800 PERFORM FAIL. SQ1034.2 +104900 SEQ-TEST-11-END. SQ1034.2 +105000* SQ1034.2 +105100 TERMINATE-ROUTINE. SQ1034.2 +105200 EXIT. SQ1034.2 +105300 CCVS-EXIT SECTION. SQ1034.2 +105400 CCVS-999999. SQ1034.2 +105500 GO TO CLOSE-FILES. SQ1034.2 +*END-OF,SQ103A +*HEADER,COBOL,SQ104A +000100 IDENTIFICATION DIVISION. SQ1044.2 +000200 PROGRAM-ID. SQ1044.2 +000300 SQ104A. SQ1044.2 +000400**************************************************************** SQ1044.2 +000500* * SQ1044.2 +000600* VALIDATION FOR:- * SQ1044.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1044.2 +000900* REVISED 1986, AUGUST * SQ1044.2 +001000* * SQ1044.2 +001100* CREATION DATE / VALIDATION DATE * SQ1044.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1044.2 +001300* * SQ1044.2 +001400**************************************************************** SQ1044.2 +001500* * SQ1044.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1044.2 +001700* * SQ1044.2 +001800* X-14 SEQUENTIAL MASS STORAGE * SQ1044.2 +001900* X-55 SYSTEM PRINTER * SQ1044.2 +002000* X-82 SOURCE-COMPUTER * SQ1044.2 +002100* X-83 OBJECT-COMPUTER. * SQ1044.2 +002200* * SQ1044.2 +002300**************************************************************** SQ1044.2 +002400* * SQ1044.2 +002500* SQ104A CREATES A SEQUENTIAL MASS STORAGE FILE CONTAINING * SQ1044.2 +002600* 649 FIXED LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE * SQ1044.2 +002700* FILE READ IS TWICE. THE FIRST PASS CHECKS THAT ALL THE * SQ1044.2 +002800* EXPECTED RECORDS ARE PRESENT. THE SECOND PASS PERFORMS * SQ1044.2 +002900* SIMILAR CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ * SQ1044.2 +003000* STATEMENT WITH THE END PHRASE THAT CAN BE PRODUCED BY * SQ1044.2 +003100* INCLUDING OR OMITTING THE OPTIONAL WORDS "RECORD" AND * SQ1044.2 +003200* "AT". * SQ1044.2 +003300* * SQ1044.2 +003400* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1044.2 +003500* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1044.2 +003600* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1044.2 +003700* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1044.2 +003800* * SQ1044.2 +003900**************************************************************** SQ1044.2 +004000* SQ1044.2 +004100* SQ1044.2 +004200 ENVIRONMENT DIVISION. SQ1044.2 +004300 CONFIGURATION SECTION. SQ1044.2 +004400 SOURCE-COMPUTER. SQ1044.2 +004500 XXXXX082. SQ1044.2 +004600 OBJECT-COMPUTER. SQ1044.2 +004700 XXXXX083. SQ1044.2 +004800* SQ1044.2 +004900 INPUT-OUTPUT SECTION. SQ1044.2 +005000 FILE-CONTROL. SQ1044.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1044.2 +005200 XXXXX055. SQ1044.2 +005300* SQ1044.2 +005400P SELECT RAW-DATA ASSIGN TO SQ1044.2 +005500P XXXXX062 SQ1044.2 +005600P ORGANIZATION IS INDEXED SQ1044.2 +005700P ACCESS MODE IS RANDOM SQ1044.2 +005800P RECORD-KEY IS RAW-DATA-KEY. SQ1044.2 +005900P SQ1044.2 +006000 SELECT SQ-FS3 SQ1044.2 +006100 ACCESS MODE SEQUENTIAL SQ1044.2 +006200 ASSIGN TO SQ1044.2 +006300 XXXXX014 SQ1044.2 +006400 ORGANIZATION IS SEQUENTIAL SQ1044.2 +006500 . SQ1044.2 +006600* SQ1044.2 +006700* SQ1044.2 +006800 DATA DIVISION. SQ1044.2 +006900 FILE SECTION. SQ1044.2 +007000P SQ1044.2 +007100PFD RAW-DATA. SQ1044.2 +007200P01 RAW-DATA-SATZ. SQ1044.2 +007300P 05 RAW-DATA-KEY PIC X(6). SQ1044.2 +007400P 05 C-DATE PIC 9(6). SQ1044.2 +007500P 05 C-TIME PIC 9(8). SQ1044.2 +007600P 05 NO-OF-TESTS PIC 99. SQ1044.2 +007700P 05 C-OK PIC 999. SQ1044.2 +007800P 05 C-ALL PIC 999. SQ1044.2 +007900P 05 C-FAIL PIC 999. SQ1044.2 +008000P 05 C-DELETED PIC 999. SQ1044.2 +008100P 05 C-INSPECT PIC 999. SQ1044.2 +008200P 05 C-NOTE PIC X(13). SQ1044.2 +008300P 05 C-INDENT PIC X. SQ1044.2 +008400P 05 C-ABORT PIC X(8). SQ1044.2 +008500* SQ1044.2 +008600 FD SQ-FS3 SQ1044.2 +008700C LABEL RECORD IS STANDARD SQ1044.2 +008800C DATA RECORD SQ-FS3R1-F-G-120 SQ1044.2 +008900 BLOCK CONTAINS 120 CHARACTERS SQ1044.2 +009000 RECORD CONTAINS 120 CHARACTERS. SQ1044.2 +009100 01 SQ-FS3R1-F-G-120 PIC X(120). SQ1044.2 +009200* SQ1044.2 +009300 FD PRINT-FILE SQ1044.2 +009400C LABEL RECORDS SQ1044.2 +009500C XXXXX084 SQ1044.2 +009600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1044.2 +009700 . SQ1044.2 +009800 01 PRINT-REC PICTURE X(120). SQ1044.2 +009900 01 DUMMY-RECORD PICTURE X(120). SQ1044.2 +010000* SQ1044.2 +010100 WORKING-STORAGE SECTION. SQ1044.2 +010200* SQ1044.2 +010300*************************************************************** SQ1044.2 +010400* * SQ1044.2 +010500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1044.2 +010600* * SQ1044.2 +010700*************************************************************** SQ1044.2 +010800* SQ1044.2 +010900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1044.2 +011000 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1044.2 +011100 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1044.2 +011200* SQ1044.2 +011300*************************************************************** SQ1044.2 +011400* * SQ1044.2 +011500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1044.2 +011600* * SQ1044.2 +011700*************************************************************** SQ1044.2 +011800* SQ1044.2 +011900 01 REC-SKEL-SUB PIC 99. SQ1044.2 +012000* SQ1044.2 +012100 01 FILE-RECORD-INFORMATION-REC. SQ1044.2 +012200 03 FILE-RECORD-INFO-SKELETON. SQ1044.2 +012300 05 FILLER PICTURE X(48) VALUE SQ1044.2 +012400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1044.2 +012500 05 FILLER PICTURE X(46) VALUE SQ1044.2 +012600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1044.2 +012700 05 FILLER PICTURE X(26) VALUE SQ1044.2 +012800 ",LFIL=000000,ORG= ,LBLR= ". SQ1044.2 +012900 05 FILLER PICTURE X(37) VALUE SQ1044.2 +013000 ",RECKEY= ". SQ1044.2 +013100 05 FILLER PICTURE X(38) VALUE SQ1044.2 +013200 ",ALTKEY1= ". SQ1044.2 +013300 05 FILLER PICTURE X(38) VALUE SQ1044.2 +013400 ",ALTKEY2= ". SQ1044.2 +013500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1044.2 +013600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1044.2 +013700 05 FILE-RECORD-INFO-P1-120. SQ1044.2 +013800 07 FILLER PIC X(5). SQ1044.2 +013900 07 XFILE-NAME PIC X(6). SQ1044.2 +014000 07 FILLER PIC X(8). SQ1044.2 +014100 07 XRECORD-NAME PIC X(6). SQ1044.2 +014200 07 FILLER PIC X(1). SQ1044.2 +014300 07 REELUNIT-NUMBER PIC 9(1). SQ1044.2 +014400 07 FILLER PIC X(7). SQ1044.2 +014500 07 XRECORD-NUMBER PIC 9(6). SQ1044.2 +014600 07 FILLER PIC X(6). SQ1044.2 +014700 07 UPDATE-NUMBER PIC 9(2). SQ1044.2 +014800 07 FILLER PIC X(5). SQ1044.2 +014900 07 ODO-NUMBER PIC 9(4). SQ1044.2 +015000 07 FILLER PIC X(5). SQ1044.2 +015100 07 XPROGRAM-NAME PIC X(5). SQ1044.2 +015200 07 FILLER PIC X(7). SQ1044.2 +015300 07 XRECORD-LENGTH PIC 9(6). SQ1044.2 +015400 07 FILLER PIC X(7). SQ1044.2 +015500 07 CHARS-OR-RECORDS PIC X(2). SQ1044.2 +015600 07 FILLER PIC X(1). SQ1044.2 +015700 07 XBLOCK-SIZE PIC 9(4). SQ1044.2 +015800 07 FILLER PIC X(6). SQ1044.2 +015900 07 RECORDS-IN-FILE PIC 9(6). SQ1044.2 +016000 07 FILLER PIC X(5). SQ1044.2 +016100 07 XFILE-ORGANIZATION PIC X(2). SQ1044.2 +016200 07 FILLER PIC X(6). SQ1044.2 +016300 07 XLABEL-TYPE PIC X(1). SQ1044.2 +016400 05 FILE-RECORD-INFO-P121-240. SQ1044.2 +016500 07 FILLER PIC X(8). SQ1044.2 +016600 07 XRECORD-KEY PIC X(29). SQ1044.2 +016700 07 FILLER PIC X(9). SQ1044.2 +016800 07 ALTERNATE-KEY1 PIC X(29). SQ1044.2 +016900 07 FILLER PIC X(9). SQ1044.2 +017000 07 ALTERNATE-KEY2 PIC X(29). SQ1044.2 +017100 07 FILLER PIC X(7). SQ1044.2 +017200* SQ1044.2 +017300 01 TEST-RESULTS. SQ1044.2 +017400 02 FILLER PIC X VALUE SPACE. SQ1044.2 +017500 02 PAR-NAME. SQ1044.2 +017600 03 FILLER PIC X(14) VALUE SPACE. SQ1044.2 +017700 03 PARDOT-X PIC X VALUE SPACE. SQ1044.2 +017800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1044.2 +017900 02 FILLER PIC X VALUE SPACE. SQ1044.2 +018000 02 FEATURE PIC X(24) VALUE SPACE. SQ1044.2 +018100 02 FILLER PIC X VALUE SPACE. SQ1044.2 +018200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1044.2 +018300 02 FILLER PIC X(9) VALUE SPACE. SQ1044.2 +018400 02 RE-MARK PIC X(61). SQ1044.2 +018500 01 TEST-COMPUTED. SQ1044.2 +018600 02 FILLER PIC X(30) VALUE SPACE. SQ1044.2 +018700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1044.2 +018800 02 COMPUTED-X. SQ1044.2 +018900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1044.2 +019000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1044.2 +019100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1044.2 +019200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1044.2 +019300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1044.2 +019400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1044.2 +019500 04 COMPUTED-18V0 PIC -9(18). SQ1044.2 +019600 04 FILLER PIC X. SQ1044.2 +019700 03 FILLER PIC X(50) VALUE SPACE. SQ1044.2 +019800 01 TEST-CORRECT. SQ1044.2 +019900 02 FILLER PIC X(30) VALUE SPACE. SQ1044.2 +020000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1044.2 +020100 02 CORRECT-X. SQ1044.2 +020200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1044.2 +020300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1044.2 +020400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1044.2 +020500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1044.2 +020600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1044.2 +020700 03 CR-18V0 REDEFINES CORRECT-A. SQ1044.2 +020800 04 CORRECT-18V0 PIC -9(18). SQ1044.2 +020900 04 FILLER PIC X. SQ1044.2 +021000 03 FILLER PIC X(2) VALUE SPACE. SQ1044.2 +021100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1044.2 +021200 01 CCVS-C-1. SQ1044.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1044.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1044.2 +021700 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1044.2 +021900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1044.2 +022000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1044.2 +022100 01 CCVS-C-2. SQ1044.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1044.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". SQ1044.2 +022400 02 FILLER PIC X(19) VALUE SPACE. SQ1044.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". SQ1044.2 +022600 02 FILLER PIC X(72) VALUE SPACE. SQ1044.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1044.2 +022800 01 REC-CT PIC 99 VALUE ZERO. SQ1044.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1044.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1044.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1044.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1044.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1044.2 +023800 01 CCVS-H-1. SQ1044.2 +023900 02 FILLER PIC X(39) VALUE SPACES. SQ1044.2 +024000 02 FILLER PIC X(42) VALUE SQ1044.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1044.2 +024200 02 FILLER PIC X(39) VALUE SPACES. SQ1044.2 +024300 01 CCVS-H-2A. SQ1044.2 +024400 02 FILLER PIC X(40) VALUE SPACE. SQ1044.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1044.2 +024600 02 FILLER PIC XXXX VALUE SQ1044.2 +024700 "4.2 ". SQ1044.2 +024800 02 FILLER PIC X(28) VALUE SQ1044.2 +024900 " COPY - NOT FOR DISTRIBUTION". SQ1044.2 +025000 02 FILLER PIC X(41) VALUE SPACE. SQ1044.2 +025100* SQ1044.2 +025200 01 CCVS-H-2B. SQ1044.2 +025300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1044.2 +025400 02 TEST-ID PIC X(9). SQ1044.2 +025500 02 FILLER PIC X(4) VALUE " IN ". SQ1044.2 +025600 02 FILLER PIC X(12) VALUE SQ1044.2 +025700 " HIGH ". SQ1044.2 +025800 02 FILLER PIC X(22) VALUE SQ1044.2 +025900 " LEVEL VALIDATION FOR ". SQ1044.2 +026000 02 FILLER PIC X(58) VALUE SQ1044.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +026200 01 CCVS-H-3. SQ1044.2 +026300 02 FILLER PIC X(34) VALUE SQ1044.2 +026400 " FOR OFFICIAL USE ONLY ". SQ1044.2 +026500 02 FILLER PIC X(58) VALUE SQ1044.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1044.2 +026700 02 FILLER PIC X(28) VALUE SQ1044.2 +026800 " COPYRIGHT 1985,1986 ". SQ1044.2 +026900 01 CCVS-E-1. SQ1044.2 +027000 02 FILLER PIC X(52) VALUE SPACE. SQ1044.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1044.2 +027200 02 ID-AGAIN PIC X(9). SQ1044.2 +027300 02 FILLER PIC X(45) VALUE SPACES. SQ1044.2 +027400 01 CCVS-E-2. SQ1044.2 +027500 02 FILLER PIC X(31) VALUE SPACE. SQ1044.2 +027600 02 FILLER PIC X(21) VALUE SPACE. SQ1044.2 +027700 02 CCVS-E-2-2. SQ1044.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1044.2 +027900 03 FILLER PIC X VALUE SPACE. SQ1044.2 +028000 03 ENDER-DESC PIC X(44) VALUE SQ1044.2 +028100 "ERRORS ENCOUNTERED". SQ1044.2 +028200 01 CCVS-E-3. SQ1044.2 +028300 02 FILLER PIC X(22) VALUE SQ1044.2 +028400 " FOR OFFICIAL USE ONLY". SQ1044.2 +028500 02 FILLER PIC X(12) VALUE SPACE. SQ1044.2 +028600 02 FILLER PIC X(58) VALUE SQ1044.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +028800 02 FILLER PIC X(8) VALUE SPACE. SQ1044.2 +028900 02 FILLER PIC X(20) VALUE SQ1044.2 +029000 " COPYRIGHT 1985,1986". SQ1044.2 +029100 01 CCVS-E-4. SQ1044.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1044.2 +029300 02 FILLER PIC X(4) VALUE " OF ". SQ1044.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1044.2 +029500 02 FILLER PIC X(40) VALUE SQ1044.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1044.2 +029700 01 XXINFO. SQ1044.2 +029800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1044.2 +029900 02 INFO-TEXT. SQ1044.2 +030000 04 FILLER PIC X(8) VALUE SPACE. SQ1044.2 +030100 04 XXCOMPUTED PIC X(20). SQ1044.2 +030200 04 FILLER PIC X(5) VALUE SPACE. SQ1044.2 +030300 04 XXCORRECT PIC X(20). SQ1044.2 +030400 02 INF-ANSI-REFERENCE PIC X(48). SQ1044.2 +030500 01 HYPHEN-LINE. SQ1044.2 +030600 02 FILLER PIC IS X VALUE IS SPACE. SQ1044.2 +030700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1044.2 +030800- "*****************************************". SQ1044.2 +030900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1044.2 +031000- "******************************". SQ1044.2 +031100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1044.2 +031200 "SQ104A". SQ1044.2 +031300* SQ1044.2 +031400* SQ1044.2 +031500 PROCEDURE DIVISION. SQ1044.2 +031600* SQ1044.2 +031700 CCVS1 SECTION. SQ1044.2 +031800 OPEN-FILES. SQ1044.2 +031900P OPEN I-O RAW-DATA. SQ1044.2 +032000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1044.2 +032100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1044.2 +032200P MOVE "ABORTED " TO C-ABORT. SQ1044.2 +032300P ADD 1 TO C-NO-OF-TESTS. SQ1044.2 +032400P ACCEPT C-DATE FROM DATE. SQ1044.2 +032500P ACCEPT C-TIME FROM TIME. SQ1044.2 +032600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1044.2 +032700PEND-E-1. SQ1044.2 +032800P CLOSE RAW-DATA. SQ1044.2 +032900 OPEN OUTPUT PRINT-FILE. SQ1044.2 +033000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1044.2 +033100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1044.2 +033200 MOVE SPACE TO TEST-RESULTS. SQ1044.2 +033300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1044.2 +033400 MOVE ZERO TO REC-SKEL-SUB. SQ1044.2 +033500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1044.2 +033600 GO TO CCVS1-EXIT. SQ1044.2 +033700* SQ1044.2 +033800 CCVS-INIT-FILE. SQ1044.2 +033900 ADD 1 TO REC-SKL-SUB. SQ1044.2 +034000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1044.2 +034100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1044.2 +034200* SQ1044.2 +034300 CLOSE-FILES. SQ1044.2 +034400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1044.2 +034500 CLOSE PRINT-FILE. SQ1044.2 +034600P OPEN I-O RAW-DATA. SQ1044.2 +034700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1044.2 +034800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1044.2 +034900P MOVE "OK. " TO C-ABORT. SQ1044.2 +035000P MOVE PASS-COUNTER TO C-OK. SQ1044.2 +035100P MOVE ERROR-HOLD TO C-ALL. SQ1044.2 +035200P MOVE ERROR-COUNTER TO C-FAIL. SQ1044.2 +035300P MOVE DELETE-CNT TO C-DELETED. SQ1044.2 +035400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1044.2 +035500P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1044.2 +035600PEND-E-2. SQ1044.2 +035700P CLOSE RAW-DATA. SQ1044.2 +035800 TERMINATE-CCVS. SQ1044.2 +035900S EXIT PROGRAM. SQ1044.2 +036000 STOP RUN. SQ1044.2 +036100* SQ1044.2 +036200 INSPT. SQ1044.2 +036300 MOVE "INSPT" TO P-OR-F. SQ1044.2 +036400 ADD 1 TO INSPECT-COUNTER. SQ1044.2 +036500 PERFORM PRINT-DETAIL. SQ1044.2 +036600* SQ1044.2 +036700 PASS. SQ1044.2 +036800 MOVE "PASS " TO P-OR-F. SQ1044.2 +036900 ADD 1 TO PASS-COUNTER. SQ1044.2 +037000 PERFORM PRINT-DETAIL. SQ1044.2 +037100* SQ1044.2 +037200 FAIL. SQ1044.2 +037300 MOVE "FAIL*" TO P-OR-F. SQ1044.2 +037400 ADD 1 TO ERROR-COUNTER. SQ1044.2 +037500 PERFORM PRINT-DETAIL. SQ1044.2 +037600* SQ1044.2 +037700 DE-LETE. SQ1044.2 +037800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1044.2 +037900 MOVE "*****" TO P-OR-F. SQ1044.2 +038000 ADD 1 TO DELETE-COUNTER. SQ1044.2 +038100 PERFORM PRINT-DETAIL. SQ1044.2 +038200* SQ1044.2 +038300 PRINT-DETAIL. SQ1044.2 +038400 IF REC-CT NOT EQUAL TO ZERO SQ1044.2 +038500 MOVE "." TO PARDOT-X SQ1044.2 +038600 MOVE REC-CT TO DOTVALUE. SQ1044.2 +038700 MOVE TEST-RESULTS TO PRINT-REC. SQ1044.2 +038800 PERFORM WRITE-LINE. SQ1044.2 +038900 IF P-OR-F EQUAL TO "FAIL*" SQ1044.2 +039000 PERFORM WRITE-LINE SQ1044.2 +039100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1044.2 +039200 ELSE SQ1044.2 +039300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1044.2 +039400 MOVE SPACE TO P-OR-F. SQ1044.2 +039500 MOVE SPACE TO COMPUTED-X. SQ1044.2 +039600 MOVE SPACE TO CORRECT-X. SQ1044.2 +039700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1044.2 +039800 MOVE SPACE TO RE-MARK. SQ1044.2 +039900* SQ1044.2 +040000 HEAD-ROUTINE. SQ1044.2 +040100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1044.2 +040400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1044.2 +040500 COLUMN-NAMES-ROUTINE. SQ1044.2 +040600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +040700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +040900 END-ROUTINE. SQ1044.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1044.2 +041100 PERFORM WRITE-LINE 5 TIMES. SQ1044.2 +041200 END-RTN-EXIT. SQ1044.2 +041300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1044.2 +041400 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +041500* SQ1044.2 +041600 END-ROUTINE-1. SQ1044.2 +041700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1044.2 +041800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1044.2 +041900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1044.2 +042000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1044.2 +042100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1044.2 +042200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1044.2 +042300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1044.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1044.2 +042500 PERFORM WRITE-LINE. SQ1044.2 +042600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1044.2 +042700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1044.2 +042800 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +042900 ELSE SQ1044.2 +043000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1044.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1044.2 +043200 PERFORM WRITE-LINE. SQ1044.2 +043300 END-ROUTINE-13. SQ1044.2 +043400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1044.2 +043500 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +043600 ELSE SQ1044.2 +043700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1044.2 +043800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1044.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1044.2 +044000 PERFORM WRITE-LINE. SQ1044.2 +044100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1044.2 +044200 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +044300 ELSE SQ1044.2 +044400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1044.2 +044500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1044.2 +044600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +044700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +044800* SQ1044.2 +044900 WRITE-LINE. SQ1044.2 +045000 ADD 1 TO RECORD-COUNT. SQ1044.2 +045100Y IF RECORD-COUNT GREATER 50 SQ1044.2 +045200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1044.2 +045300Y MOVE SPACE TO DUMMY-RECORD SQ1044.2 +045400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1044.2 +045500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1044.2 +045600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1044.2 +045700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1044.2 +045800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1044.2 +045900Y MOVE ZERO TO RECORD-COUNT. SQ1044.2 +046000 PERFORM WRT-LN. SQ1044.2 +046100* SQ1044.2 +046200 WRT-LN. SQ1044.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1044.2 +046400 MOVE SPACE TO DUMMY-RECORD. SQ1044.2 +046500 BLANK-LINE-PRINT. SQ1044.2 +046600 PERFORM WRT-LN. SQ1044.2 +046700 FAIL-ROUTINE. SQ1044.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1044.2 +046900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1044.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1044.2 +047100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1044.2 +047200 MOVE XXINFO TO DUMMY-RECORD. SQ1044.2 +047300 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +047400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1044.2 +047500 GO TO FAIL-ROUTINE-EX. SQ1044.2 +047600 FAIL-ROUTINE-WRITE. SQ1044.2 +047700 MOVE TEST-COMPUTED TO PRINT-REC SQ1044.2 +047800 PERFORM WRITE-LINE SQ1044.2 +047900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1044.2 +048000 MOVE TEST-CORRECT TO PRINT-REC SQ1044.2 +048100 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +048200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1044.2 +048300 FAIL-ROUTINE-EX. SQ1044.2 +048400 EXIT. SQ1044.2 +048500 BAIL-OUT. SQ1044.2 +048600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1044.2 +048700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1044.2 +048800 BAIL-OUT-WRITE. SQ1044.2 +048900 MOVE CORRECT-A TO XXCORRECT. SQ1044.2 +049000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1044.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1044.2 +049200 MOVE XXINFO TO DUMMY-RECORD. SQ1044.2 +049300 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +049400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1044.2 +049500 BAIL-OUT-EX. SQ1044.2 +049600 EXIT. SQ1044.2 +049700 CCVS1-EXIT. SQ1044.2 +049800 EXIT. SQ1044.2 +049900* SQ1044.2 +050000**************************************************************** SQ1044.2 +050100* * SQ1044.2 +050200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1044.2 +050300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1044.2 +050400* * SQ1044.2 +050500**************************************************************** SQ1044.2 +050600* SQ1044.2 +050700 SECT-SQ104-0001 SECTION. SQ1044.2 +050800 SEQ-INIT-WR-01. SQ1044.2 +050900 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1044.2 +051000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1044.2 +051100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1044.2 +051200 MOVE 000120 TO XRECORD-LENGTH (1). SQ1044.2 +051300 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1044.2 +051400 MOVE 0120 TO XBLOCK-SIZE (1). SQ1044.2 +051500 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1044.2 +051600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1044.2 +051700 MOVE "S" TO XLABEL-TYPE (1). SQ1044.2 +051800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1044.2 +051900 MOVE "CREATE 649 RECORD FILE" TO FEATURE. SQ1044.2 +052000 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1044.2 +052100* SQ1044.2 +052200 SEQ-TEST-WR-01. SQ1044.2 +052300 OPEN OUTPUT SQ-FS3. SQ1044.2 +052400* SQ1044.2 +052500 SEQ-TEST-WR-01-LOOP. SQ1044.2 +052600 ADD 1 TO XRECORD-NUMBER (1). SQ1044.2 +052700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1044.2 +052800 WRITE SQ-FS3R1-F-G-120. SQ1044.2 +052900 IF XRECORD-NUMBER (1) LESS THAN 649 SQ1044.2 +053000 GO TO SEQ-TEST-WR-01-LOOP. SQ1044.2 +053100* SQ1044.2 +053200 CLOSE SQ-FS3. SQ1044.2 +053300* SQ1044.2 +053400* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 649 SQ1044.2 +053500* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1044.2 +053600* READ AND THE RECORDS VERIFIED. SQ1044.2 +053700* SQ1044.2 +053800 SEQ-INIT-GF-02. SQ1044.2 +053900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1044.2 +054000 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1044.2 +054100 MOVE 1 TO REC-CT. SQ1044.2 +054200 GO TO SEQ-TEST-GF-02-01. SQ1044.2 +054300 SEQ-DELETE-02-01. SQ1044.2 +054400 GO TO SEQ-DELETE-02-02. SQ1044.2 +054500 SEQ-TEST-GF-02-01. SQ1044.2 +054600 OPEN INPUT SQ-FS3. SQ1044.2 +054700* SQ1044.2 +054800 SEQ-INIT-GF-02-02. SQ1044.2 +054900 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1044.2 +055000 TO FILE-RECORD-INFO-P1-120 (2). SQ1044.2 +055100 MOVE ZERO TO XRECORD-NUMBER (2). SQ1044.2 +055200 GO TO SEQ-TEST-GF-02-02. SQ1044.2 +055300 SEQ-DELETE-02-02. SQ1044.2 +055400 PERFORM DE-LETE. SQ1044.2 +055500 ADD 1 TO REC-CT. SQ1044.2 +055600 PERFORM DE-LETE. SQ1044.2 +055700 GO TO SEQ-DELETE-GF-02-05. SQ1044.2 +055800 SEQ-TEST-GF-02-02. SQ1044.2 +055900 SEQ-TEST-GF-02-02-LOOP. SQ1044.2 +056000 READ SQ-FS3 SQ1044.2 +056100 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1044.2 +056200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +056300 ADD 1 TO XRECORD-NUMBER (2). SQ1044.2 +056400 IF XRECORD-NUMBER (2) GREATER THAN 649 SQ1044.2 +056500 GO TO SEQ-TEST-GF-02-02-1. SQ1044.2 +056600 IF FILE-RECORD-INFO-P1-120 (1) SQ1044.2 +056700 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1044.2 +056800 ADD 1 TO RECORDS-IN-ERROR. SQ1044.2 +056900 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1044.2 +057000* SQ1044.2 +057100 SEQ-TEST-GF-02-02-1. SQ1044.2 +057200 IF XRECORD-NUMBER (2) = 649 SQ1044.2 +057300 PERFORM PASS SQ1044.2 +057400 ELSE SQ1044.2 +057500 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1044.2 +057600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +057700 MOVE 649 TO CORRECT-18V0 SQ1044.2 +057800 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +057900 PERFORM FAIL. SQ1044.2 +058000* SQ1044.2 +058100 ADD 1 TO REC-CT. SQ1044.2 +058200 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1044.2 +058300 PERFORM PASS SQ1044.2 +058400 ELSE SQ1044.2 +058500 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1044.2 +058600 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +058700 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1044.2 +058800 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1044.2 +058900 PERFORM FAIL. SQ1044.2 +059000* SQ1044.2 +059100 SEQ-INIT-GF-02-05. SQ1044.2 +059200 GO TO SEQ-TEST-GF-02-05. SQ1044.2 +059300 SEQ-DELETE-GF-02-05. SQ1044.2 +059400 GO TO SEQ-TEST-GF-02-END. SQ1044.2 +059500 SEQ-TEST-GF-02-05. SQ1044.2 +059600 CLOSE SQ-FS3. SQ1044.2 +059700 SEQ-TEST-GF-02-END. SQ1044.2 +059800* SQ1044.2 +059900* SQ1044.2 +060000 SEQ-INIT-GF-03. SQ1044.2 +060100 GO TO SEQ-TEST-GF-03. SQ1044.2 +060200 SEQ-DELETE-03. SQ1044.2 +060300 GO TO SEQ-TEST-03-END. SQ1044.2 +060400 SEQ-TEST-GF-03. SQ1044.2 +060500 OPEN INPUT SQ-FS3. SQ1044.2 +060600 SEQ-TEST-03-END. SQ1044.2 +060700* SQ1044.2 +060800* SQ1044.2 +060900* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1044.2 +061000* THE READ STATEMENT SQ1044.2 +061100* SQ1044.2 +061200 SEQ-INIT-GF-04. SQ1044.2 +061300 MOVE ZERO TO XRECORD-NUMBER (2). SQ1044.2 +061400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +061500 MOVE "READ...RECORD AT END" TO FEATURE. SQ1044.2 +061600 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1044.2 +061700 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +061800 MOVE 1 TO REC-CT. SQ1044.2 +061900 GO TO SEQ-TEST-GF-04. SQ1044.2 +062000 SEQ-DELETE-04. SQ1044.2 +062100 PERFORM DE-LETE. SQ1044.2 +062200 ADD 1 TO REC-CT. SQ1044.2 +062300 PERFORM DE-LETE. SQ1044.2 +062400 GO TO SEQ-TEST-04-END. SQ1044.2 +062500 SEQ-TEST-GF-04. SQ1044.2 +062600 READ SQ-FS3 RECORD AT END SQ1044.2 +062700 MOVE 1 TO EOF-FLAG SQ1044.2 +062800 GO TO SEQ-TEST-GF-04-01. SQ1044.2 +062900 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +063000 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +063100 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +063200 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +063300 MOVE 1 TO ERROR-FLAG. SQ1044.2 +063400 IF XRECORD-NUMBER (2) LESS THAN 50 SQ1044.2 +063500 GO TO SEQ-TEST-GF-04. SQ1044.2 +063600* SQ1044.2 +063700 SEQ-TEST-GF-04-01. SQ1044.2 +063800 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +063900 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +064000 MOVE 649 TO CORRECT-18V0 SQ1044.2 +064100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +064200 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +064300 PERFORM FAIL SQ1044.2 +064400 ELSE SQ1044.2 +064500 PERFORM PASS. SQ1044.2 +064600* SQ1044.2 +064700 SEQ-TEST-GF-04-02. SQ1044.2 +064800 ADD 1 TO REC-CT. SQ1044.2 +064900 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +065000 PERFORM PASS SQ1044.2 +065100 ELSE SQ1044.2 +065200 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +065300 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +065400 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +065500 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +065600 PERFORM FAIL. SQ1044.2 +065700 SEQ-TEST-04-END. SQ1044.2 +065800* SQ1044.2 +065900* SQ1044.2 +066000 SEQ-INIT-GF-O5. SQ1044.2 +066100 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +066200 GO TO SEQ-DELETE-05. SQ1044.2 +066300 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +066400 MOVE "READ...AT END..." TO FEATURE SQ1044.2 +066500 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1044.2 +066600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +066700 MOVE 1 TO REC-CT. SQ1044.2 +066800 GO TO SEQ-TEST-GF-05. SQ1044.2 +066900 SEQ-DELETE-05. SQ1044.2 +067000 PERFORM DE-LETE. SQ1044.2 +067100 ADD 1 TO REC-CT. SQ1044.2 +067200 PERFORM DE-LETE. SQ1044.2 +067300 GO TO SEQ-TEST-05-END. SQ1044.2 +067400 SEQ-TEST-GF-05. SQ1044.2 +067500 READ SQ-FS3 AT END SQ1044.2 +067600 MOVE 1 TO EOF-FLAG SQ1044.2 +067700 GO TO SEQ-TEST-GF-05-01. SQ1044.2 +067800 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +067900 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +068000 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +068100 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +068200 MOVE 1 TO ERROR-FLAG. SQ1044.2 +068300 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1044.2 +068400 GO TO SEQ-TEST-GF-05. SQ1044.2 +068500* SQ1044.2 +068600 SEQ-TEST-GF-05-01. SQ1044.2 +068700 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +068800 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +068900 MOVE 649 TO CORRECT-18V0 SQ1044.2 +069000 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +069100 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +069200 PERFORM FAIL SQ1044.2 +069300 ELSE SQ1044.2 +069400 PERFORM PASS. SQ1044.2 +069500* SQ1044.2 +069600 SEQ-TEST-GF-05-02. SQ1044.2 +069700 ADD 1 TO REC-CT. SQ1044.2 +069800 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +069900 PERFORM PASS SQ1044.2 +070000 ELSE SQ1044.2 +070100 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +070200 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +070300 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +070400 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +070500 PERFORM FAIL. SQ1044.2 +070600 SEQ-TEST-05-END. SQ1044.2 +070700* SQ1044.2 +070800* SQ1044.2 +070900 SEQ-INIT-GF-O6. SQ1044.2 +071000 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +071100 GO TO SEQ-DELETE-06. SQ1044.2 +071200 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +071300 MOVE "READ...RECORD END..." TO FEATURE SQ1044.2 +071400 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1044.2 +071500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +071600 MOVE 1 TO REC-CT. SQ1044.2 +071700 GO TO SEQ-TEST-GF-06. SQ1044.2 +071800 SEQ-DELETE-06. SQ1044.2 +071900 PERFORM DE-LETE. SQ1044.2 +072000 ADD 1 TO REC-CT. SQ1044.2 +072100 PERFORM DE-LETE. SQ1044.2 +072200 GO TO SEQ-TEST-06-END. SQ1044.2 +072300 SEQ-TEST-GF-06. SQ1044.2 +072400 READ SQ-FS3 RECORD END SQ1044.2 +072500 MOVE 1 TO EOF-FLAG SQ1044.2 +072600 GO TO SEQ-TEST-GF-06-01. SQ1044.2 +072700 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +072800 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +072900 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +073000 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +073100 MOVE 1 TO ERROR-FLAG. SQ1044.2 +073200 IF XRECORD-NUMBER (2) LESS THAN 499 SQ1044.2 +073300 GO TO SEQ-TEST-GF-06. SQ1044.2 +073400* SQ1044.2 +073500 SEQ-TEST-GF-06-01. SQ1044.2 +073600 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +073700 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +073800 MOVE 649 TO CORRECT-18V0 SQ1044.2 +073900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +074000 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +074100 PERFORM FAIL SQ1044.2 +074200 ELSE SQ1044.2 +074300 PERFORM PASS. SQ1044.2 +074400* SQ1044.2 +074500 SEQ-TEST-GF-06-02. SQ1044.2 +074600 ADD 1 TO REC-CT. SQ1044.2 +074700 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +074800 PERFORM PASS SQ1044.2 +074900 ELSE SQ1044.2 +075000 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +075100 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +075200 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +075300 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +075400 PERFORM FAIL. SQ1044.2 +075500 SEQ-TEST-06-END. SQ1044.2 +075600* SQ1044.2 +075700* SQ1044.2 +075800 SEQ-INIT-GF-O7. SQ1044.2 +075900 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +076000 GO TO SEQ-DELETE-07. SQ1044.2 +076100 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +076200 MOVE "READ... END..." TO FEATURE SQ1044.2 +076300 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1044.2 +076400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +076500 MOVE 1 TO REC-CT. SQ1044.2 +076600 GO TO SEQ-TEST-GF-07. SQ1044.2 +076700 SEQ-DELETE-07. SQ1044.2 +076800 PERFORM DE-LETE. SQ1044.2 +076900 ADD 1 TO REC-CT. SQ1044.2 +077000 PERFORM DE-LETE. SQ1044.2 +077100 GO TO SEQ-TEST-07-END. SQ1044.2 +077200 SEQ-TEST-GF-07. SQ1044.2 +077300 READ SQ-FS3 END SQ1044.2 +077400 MOVE 1 TO EOF-FLAG SQ1044.2 +077500 GO TO SEQ-TEST-GF-07-01. SQ1044.2 +077600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +077700 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +077800 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +077900 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +078000 MOVE 1 TO ERROR-FLAG. SQ1044.2 +078100 IF XRECORD-NUMBER (2) LESS THAN 649 SQ1044.2 +078200 GO TO SEQ-TEST-GF-07. SQ1044.2 +078300* SQ1044.2 +078400 SEQ-TEST-GF-07-01. SQ1044.2 +078500 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +078600 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +078700 MOVE 649 TO CORRECT-18V0 SQ1044.2 +078800 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +078900 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +079000 PERFORM FAIL SQ1044.2 +079100 ELSE SQ1044.2 +079200 PERFORM PASS. SQ1044.2 +079300* SQ1044.2 +079400 SEQ-TEST-GF-07-02. SQ1044.2 +079500 ADD 1 TO REC-CT. SQ1044.2 +079600 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +079700 PERFORM PASS SQ1044.2 +079800 ELSE SQ1044.2 +079900 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +080000 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +080100 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +080200 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +080300 PERFORM FAIL. SQ1044.2 +080400 SEQ-TEST-07-END. SQ1044.2 +080500* SQ1044.2 +080600* SQ1044.2 +080700 SEQ-INIT-GF-O8. SQ1044.2 +080800 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +080900 GO TO SEQ-DELETE-08. SQ1044.2 +081000 MOVE "READ... END... AT EOF" TO FEATURE SQ1044.2 +081100 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1044.2 +081200 MOVE 1 TO REC-CT. SQ1044.2 +081300 GO TO SEQ-TEST-GF-08. SQ1044.2 +081400 SEQ-DELETE-08. SQ1044.2 +081500 PERFORM DE-LETE. SQ1044.2 +081600 GO TO SEQ-TEST-08-END. SQ1044.2 +081700 SEQ-TEST-GF-08. SQ1044.2 +081800 READ SQ-FS3 END SQ1044.2 +081900 MOVE 1 TO EOF-FLAG. SQ1044.2 +082000* SQ1044.2 +082100 SEQ-TEST-GF-08-01. SQ1044.2 +082200 IF EOF-FLAG NOT EQUAL TO 1 SQ1044.2 +082300 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1044.2 +082400 MOVE 1 TO CORRECT-18V0 SQ1044.2 +082500 MOVE "EOF NOT FOUND AFTER 649 RECORDS" TO RE-MARK SQ1044.2 +082600 PERFORM FAIL SQ1044.2 +082700 ELSE SQ1044.2 +082800 PERFORM PASS. SQ1044.2 +082900 SEQ-TEST-08-END. SQ1044.2 +083000* SQ1044.2 +083100* SQ1044.2 +083200 SEQ-INIT-GF-O9. SQ1044.2 +083300 GO TO SEQ-TEST-GF-09. SQ1044.2 +083400 SEQ-DELETE-09. SQ1044.2 +083500 GO TO SEQ-TEST-09-END. SQ1044.2 +083600 SEQ-TEST-GF-09. SQ1044.2 +083700 CLOSE SQ-FS3. SQ1044.2 +083800 SEQ-TEST-09-END. SQ1044.2 +083900* SQ1044.2 +084000* SQ1044.2 +084100 TERMINATE-ROUTINE. SQ1044.2 +084200 EXIT. SQ1044.2 +084300 CCVS-EXIT SECTION. SQ1044.2 +084400 CCVS-999999. SQ1044.2 +084500 GO TO CLOSE-FILES. SQ1044.2 +*END-OF,SQ104A +*HEADER,COBOL,SQ105A +000100 IDENTIFICATION DIVISION. SQ1054.2 +000200 PROGRAM-ID. SQ1054.2 +000300 SQ105A. SQ1054.2 +000400**************************************************************** SQ1054.2 +000500* * SQ1054.2 +000600* VALIDATION FOR:- * SQ1054.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1054.2 +000900* REVISED 1986, AUGUST * SQ1054.2 +001000* * SQ1054.2 +001100* CREATION DATE / VALIDATION DATE * SQ1054.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1054.2 +001300* * SQ1054.2 +001400**************************************************************** SQ1054.2 +001500* * SQ1054.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1054.2 +001700* * SQ1054.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1054.2 +001900* X-55 SYSTEM PRINTER * SQ1054.2 +002000* X-82 SOURCE-COMPUTER * SQ1054.2 +002100* X-83 OBJECT-COMPUTER. * SQ1054.2 +002200* * SQ1054.2 +002300**************************************************************** SQ1054.2 +002400* * SQ1054.2 +002500* SQ105A CREATES A SEQUENTIAL MASS STORAGE FILE CONTAINING * SQ1054.2 +002600* 980 RECORDS, EACH 125 CHARACTERS LONG. THERE ARE TWO * SQ1054.2 +002700* USE PROCEDURES IN THE DECLARATIVE SECTION, ONE FOR * SQ1054.2 +002800* EXCEPTION ON OUTPUT, THE OTHER FOR EXCEPTION ON INPUT. * SQ1054.2 +002900* THE FILE IS READ TWICE. IN THE FIRST PASS, RECORDS ARE * SQ1054.2 +003000* READ WITH READ STATEMENTS WHICH DO NOT CONTAIN ANY * SQ1054.2 +003100* OPTIONAL PHRASES EXCEPT THE OPTIONAL WORD "RECORD". ON * SQ1054.2 +003200* THE SECOND PASS, THE READ STATEMENT CONTAINS NO OPTIONAL * SQ1054.2 +003300* WORDS OR PHRASES AT ALL. ON BOTH PASSES, THE END OF FILE * SQ1054.2 +003400* SHOULD CAUSE EXECUTION OF THE DECLARATIVE PROCEDURE FOR * SQ1054.2 +003500* INPUT. THE DECLARATIVE PROCEDURE FOR OUTPUT SHOULD BE * SQ1054.2 +003600* ON BOTH PASSES. * SQ1054.2 +003700* * SQ1054.2 +003800* THE OPTIONAL ORGANIZATION AND ACCESS MODE CLAUSES ARE * SQ1054.2 +003900* BOTH OMITTED. * SQ1054.2 +004000* * SQ1054.2 +004100**************************************************************** SQ1054.2 +004200* SQ1054.2 +004300* SQ1054.2 +004400 ENVIRONMENT DIVISION. SQ1054.2 +004500 CONFIGURATION SECTION. SQ1054.2 +004600 SOURCE-COMPUTER. SQ1054.2 +004700 XXXXX082. SQ1054.2 +004800 OBJECT-COMPUTER. SQ1054.2 +004900 XXXXX083. SQ1054.2 +005000* SQ1054.2 +005100 INPUT-OUTPUT SECTION. SQ1054.2 +005200 FILE-CONTROL. SQ1054.2 +005300 SELECT PRINT-FILE ASSIGN TO SQ1054.2 +005400 XXXXX055. SQ1054.2 +005500* SQ1054.2 +005600P SELECT RAW-DATA ASSIGN TO SQ1054.2 +005700P XXXXX062 SQ1054.2 +005800P ORGANIZATION IS INDEXED SQ1054.2 +005900P ACCESS MODE IS RANDOM SQ1054.2 +006000P RECORD-KEY IS RAW-DATA-KEY. SQ1054.2 +006100P SQ1054.2 +006200 SELECT SQ-FS4 ASSIGN SQ1054.2 +006300 XXXXX014 SQ1054.2 +006400 STATUS SQ-FS4-STATUS. SQ1054.2 +006500* SQ1054.2 +006600* SQ1054.2 +006700 DATA DIVISION. SQ1054.2 +006800 FILE SECTION. SQ1054.2 +006900 FD PRINT-FILE SQ1054.2 +007000C LABEL RECORDS SQ1054.2 +007100C XXXXX084 SQ1054.2 +007200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1054.2 +007300 . SQ1054.2 +007400 01 PRINT-REC PICTURE X(120). SQ1054.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ1054.2 +007600P SQ1054.2 +007700PFD RAW-DATA. SQ1054.2 +007800P01 RAW-DATA-SATZ. SQ1054.2 +007900P 05 RAW-DATA-KEY PIC X(6). SQ1054.2 +008000P 05 C-DATE PIC 9(6). SQ1054.2 +008100P 05 C-TIME PIC 9(8). SQ1054.2 +008200P 05 NO-OF-TESTS PIC 99. SQ1054.2 +008300P 05 C-OK PIC 999. SQ1054.2 +008400P 05 C-ALL PIC 999. SQ1054.2 +008500P 05 C-FAIL PIC 999. SQ1054.2 +008600P 05 C-DELETED PIC 999. SQ1054.2 +008700P 05 C-INSPECT PIC 999. SQ1054.2 +008800P 05 C-NOTE PIC X(13). SQ1054.2 +008900P 05 C-INDENT PIC X. SQ1054.2 +009000P 05 C-ABORT PIC X(8). SQ1054.2 +009100* SQ1054.2 +009200 FD SQ-FS4 SQ1054.2 +009300 BLOCK CONTAINS 2 RECORDS SQ1054.2 +009400 RECORD 125 SQ1054.2 +009500C LABEL RECORD STANDARD SQ1054.2 +009600 DATA RECORDS SQ-FS4R1-F-G-125. SQ1054.2 +009700* SQ1054.2 +009800 01 SQ-FS4R1-F-G-125. SQ1054.2 +009900 02 SQ-FS4-FIRST PIC X(120). SQ1054.2 +010000 02 SQ-FS4-REC-NO PIC 9(5). SQ1054.2 +010100* SQ1054.2 +010200 WORKING-STORAGE SECTION. SQ1054.2 +010300* SQ1054.2 +010400*************************************************************** SQ1054.2 +010500* * SQ1054.2 +010600* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1054.2 +010700* * SQ1054.2 +010800*************************************************************** SQ1054.2 +010900* SQ1054.2 +011000 01 SQ-FS4-STATUS. SQ1054.2 +011100 03 SQ-FS4-STATUS-1 PIC X. SQ1054.2 +011200 03 SQ-FS4-STATUS-2 PIC X. SQ1054.2 +011300* SQ1054.2 +011400 01 SQ-FS4-STATUS-COPY PIC XX. SQ1054.2 +011500 01 DECL-EXEC-SW. SQ1054.2 +011600 05 DECL-EXEC-SW-O PIC X. SQ1054.2 +011700 05 DECL-EXEC-SW-I PIC X. SQ1054.2 +011800 01 WRK-CS-09V00 PIC S9(9) USAGE COMPUTATIONAL VALUE ZERO. SQ1054.2 +011900 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1054.2 +012000 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1054.2 +012100 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1054.2 +012200 01 PERM-ERRORS PIC S9(5) USAGE COMP VALUE ZERO. SQ1054.2 +012300* SQ1054.2 +012400 01 MAJOR-DELETIONS PIC 99. SQ1054.2 +012500 01 COUNT-OF-RECS PIC 9(5). SQ1054.2 +012600* SQ1054.2 +012700* SQ1054.2 +012800*************************************************************** SQ1054.2 +012900* * SQ1054.2 +013000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1054.2 +013100* * SQ1054.2 +013200*************************************************************** SQ1054.2 +013300* SQ1054.2 +013400 01 REC-SKEL-SUB PIC 99. SQ1054.2 +013500* SQ1054.2 +013600 01 FILE-RECORD-INFORMATION-REC. SQ1054.2 +013700 03 FILE-RECORD-INFO-SKELETON. SQ1054.2 +013800 05 FILLER PICTURE X(48) VALUE SQ1054.2 +013900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1054.2 +014000 05 FILLER PICTURE X(46) VALUE SQ1054.2 +014100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1054.2 +014200 05 FILLER PICTURE X(26) VALUE SQ1054.2 +014300 ",LFIL=000000,ORG= ,LBLR= ". SQ1054.2 +014400 05 FILLER PICTURE X(37) VALUE SQ1054.2 +014500 ",RECKEY= ". SQ1054.2 +014600 05 FILLER PICTURE X(38) VALUE SQ1054.2 +014700 ",ALTKEY1= ". SQ1054.2 +014800 05 FILLER PICTURE X(38) VALUE SQ1054.2 +014900 ",ALTKEY2= ". SQ1054.2 +015000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1054.2 +015100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1054.2 +015200 05 FILE-RECORD-INFO-P1-120. SQ1054.2 +015300 07 FILLER PIC X(5). SQ1054.2 +015400 07 XFILE-NAME PIC X(6). SQ1054.2 +015500 07 FILLER PIC X(8). SQ1054.2 +015600 07 XRECORD-NAME PIC X(6). SQ1054.2 +015700 07 FILLER PIC X(1). SQ1054.2 +015800 07 REELUNIT-NUMBER PIC 9(1). SQ1054.2 +015900 07 FILLER PIC X(7). SQ1054.2 +016000 07 XRECORD-NUMBER PIC 9(6). SQ1054.2 +016100 07 FILLER PIC X(6). SQ1054.2 +016200 07 UPDATE-NUMBER PIC 9(2). SQ1054.2 +016300 07 FILLER PIC X(5). SQ1054.2 +016400 07 ODO-NUMBER PIC 9(4). SQ1054.2 +016500 07 FILLER PIC X(5). SQ1054.2 +016600 07 XPROGRAM-NAME PIC X(5). SQ1054.2 +016700 07 FILLER PIC X(7). SQ1054.2 +016800 07 XRECORD-LENGTH PIC 9(6). SQ1054.2 +016900 07 FILLER PIC X(7). SQ1054.2 +017000 07 CHARS-OR-RECORDS PIC X(2). SQ1054.2 +017100 07 FILLER PIC X(1). SQ1054.2 +017200 07 XBLOCK-SIZE PIC 9(4). SQ1054.2 +017300 07 FILLER PIC X(6). SQ1054.2 +017400 07 RECORDS-IN-FILE PIC 9(6). SQ1054.2 +017500 07 FILLER PIC X(5). SQ1054.2 +017600 07 XFILE-ORGANIZATION PIC X(2). SQ1054.2 +017700 07 FILLER PIC X(6). SQ1054.2 +017800 07 XLABEL-TYPE PIC X(1). SQ1054.2 +017900 05 FILE-RECORD-INFO-P121-240. SQ1054.2 +018000 07 FILLER PIC X(8). SQ1054.2 +018100 07 XRECORD-KEY PIC X(29). SQ1054.2 +018200 07 FILLER PIC X(9). SQ1054.2 +018300 07 ALTERNATE-KEY1 PIC X(29). SQ1054.2 +018400 07 FILLER PIC X(9). SQ1054.2 +018500 07 ALTERNATE-KEY2 PIC X(29). SQ1054.2 +018600 07 FILLER PIC X(7). SQ1054.2 +018700* SQ1054.2 +018800 01 TEST-RESULTS. SQ1054.2 +018900 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019000 02 PAR-NAME. SQ1054.2 +019100 03 FILLER PIC X(14) VALUE SPACE. SQ1054.2 +019200 03 PARDOT-X PIC X VALUE SPACE. SQ1054.2 +019300 03 DOTVALUE PIC 99 VALUE ZERO. SQ1054.2 +019400 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019500 02 FEATURE PIC X(24) VALUE SPACE. SQ1054.2 +019600 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1054.2 +019800 02 FILLER PIC X(9) VALUE SPACE. SQ1054.2 +019900 02 RE-MARK PIC X(61). SQ1054.2 +020000 01 TEST-COMPUTED. SQ1054.2 +020100 02 FILLER PIC X(30) VALUE SPACE. SQ1054.2 +020200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1054.2 +020300 02 COMPUTED-X. SQ1054.2 +020400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1054.2 +020500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1054.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1054.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1054.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1054.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1054.2 +021000 04 COMPUTED-18V0 PIC -9(18). SQ1054.2 +021100 04 FILLER PIC X. SQ1054.2 +021200 03 FILLER PIC X(50) VALUE SPACE. SQ1054.2 +021300 01 TEST-CORRECT. SQ1054.2 +021400 02 FILLER PIC X(30) VALUE SPACE. SQ1054.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1054.2 +021600 02 CORRECT-X. SQ1054.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1054.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1054.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1054.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1054.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1054.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. SQ1054.2 +022300 04 CORRECT-18V0 PIC -9(18). SQ1054.2 +022400 04 FILLER PIC X. SQ1054.2 +022500 03 FILLER PIC X(2) VALUE SPACE. SQ1054.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1054.2 +022700* SQ1054.2 +022800 01 CCVS-C-1. SQ1054.2 +022900 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1054.2 +023100 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1054.2 +023300 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1054.2 +023500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1054.2 +023600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1054.2 +023700 01 CCVS-C-2. SQ1054.2 +023800 02 FILLER PIC X(19) VALUE SPACE. SQ1054.2 +023900 02 FILLER PIC X(6) VALUE "TESTED". SQ1054.2 +024000 02 FILLER PIC X(19) VALUE SPACE. SQ1054.2 +024100 02 FILLER PIC X(4) VALUE "FAIL". SQ1054.2 +024200 02 FILLER PIC X(72) VALUE SPACE. SQ1054.2 +024300* SQ1054.2 +024400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1054.2 +024500 01 REC-CT PIC 99 VALUE ZERO. SQ1054.2 +024600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +025000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1054.2 +025100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1054.2 +025200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1054.2 +025300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1054.2 +025400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1054.2 +025500 01 CCVS-H-1. SQ1054.2 +025600 02 FILLER PIC X(39) VALUE SPACES. SQ1054.2 +025700 02 FILLER PIC X(42) VALUE SQ1054.2 +025800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1054.2 +025900 02 FILLER PIC X(39) VALUE SPACES. SQ1054.2 +026000 01 CCVS-H-2A. SQ1054.2 +026100 02 FILLER PIC X(40) VALUE SPACE. SQ1054.2 +026200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1054.2 +026300 02 FILLER PIC XXXX VALUE SQ1054.2 +026400 "4.2 ". SQ1054.2 +026500 02 FILLER PIC X(28) VALUE SQ1054.2 +026600 " COPY - NOT FOR DISTRIBUTION". SQ1054.2 +026700 02 FILLER PIC X(41) VALUE SPACE. SQ1054.2 +026800* SQ1054.2 +026900 01 CCVS-H-2B. SQ1054.2 +027000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1054.2 +027100 02 TEST-ID PIC X(9). SQ1054.2 +027200 02 FILLER PIC X(4) VALUE " IN ". SQ1054.2 +027300 02 FILLER PIC X(12) VALUE SQ1054.2 +027400 " HIGH ". SQ1054.2 +027500 02 FILLER PIC X(22) VALUE SQ1054.2 +027600 " LEVEL VALIDATION FOR ". SQ1054.2 +027700 02 FILLER PIC X(58) VALUE SQ1054.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +027900 01 CCVS-H-3. SQ1054.2 +028000 02 FILLER PIC X(34) VALUE SQ1054.2 +028100 " FOR OFFICIAL USE ONLY ". SQ1054.2 +028200 02 FILLER PIC X(58) VALUE SQ1054.2 +028300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1054.2 +028400 02 FILLER PIC X(28) VALUE SQ1054.2 +028500 " COPYRIGHT 1985,1986 ". SQ1054.2 +028600 01 CCVS-E-1. SQ1054.2 +028700 02 FILLER PIC X(52) VALUE SPACE. SQ1054.2 +028800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1054.2 +028900 02 ID-AGAIN PIC X(9). SQ1054.2 +029000 02 FILLER PIC X(45) VALUE SPACES. SQ1054.2 +029100 01 CCVS-E-2. SQ1054.2 +029200 02 FILLER PIC X(31) VALUE SPACE. SQ1054.2 +029300 02 FILLER PIC X(21) VALUE SPACE. SQ1054.2 +029400 02 CCVS-E-2-2. SQ1054.2 +029500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1054.2 +029600 03 FILLER PIC X VALUE SPACE. SQ1054.2 +029700 03 ENDER-DESC PIC X(44) VALUE SQ1054.2 +029800 "ERRORS ENCOUNTERED". SQ1054.2 +029900 01 CCVS-E-3. SQ1054.2 +030000 02 FILLER PIC X(22) VALUE SQ1054.2 +030100 " FOR OFFICIAL USE ONLY". SQ1054.2 +030200 02 FILLER PIC X(12) VALUE SPACE. SQ1054.2 +030300 02 FILLER PIC X(58) VALUE SQ1054.2 +030400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +030500 02 FILLER PIC X(8) VALUE SPACE. SQ1054.2 +030600 02 FILLER PIC X(20) VALUE SQ1054.2 +030700 " COPYRIGHT 1985,1986". SQ1054.2 +030800 01 CCVS-E-4. SQ1054.2 +030900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1054.2 +031000 02 FILLER PIC X(4) VALUE " OF ". SQ1054.2 +031100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1054.2 +031200 02 FILLER PIC X(40) VALUE SQ1054.2 +031300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1054.2 +031400 01 XXINFO. SQ1054.2 +031500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1054.2 +031600 02 INFO-TEXT. SQ1054.2 +031700 04 FILLER PIC X(8) VALUE SPACE. SQ1054.2 +031800 04 XXCOMPUTED PIC X(20). SQ1054.2 +031900 04 FILLER PIC X(5) VALUE SPACE. SQ1054.2 +032000 04 XXCORRECT PIC X(20). SQ1054.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). SQ1054.2 +032200 01 HYPHEN-LINE. SQ1054.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. SQ1054.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1054.2 +032500- "*****************************************". SQ1054.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1054.2 +032700- "******************************". SQ1054.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1054.2 +032900 "SQ105A". SQ1054.2 +033000* SQ1054.2 +033100* SQ1054.2 +033200 PROCEDURE DIVISION. SQ1054.2 +033300 DECLARATIVES. SQ1054.2 +033400 SECT-SQ105-0001 SECTION. SQ1054.2 +033500 USE AFTER STANDARD ERROR PROCEDURE OUTPUT. SQ1054.2 +033600 OUTPUT-ERROR-PROCESS. SQ1054.2 +033700 MOVE "O" TO DECL-EXEC-SW-O. SQ1054.2 +033800 MOVE 2 TO PERM-ERRORS. SQ1054.2 +033900 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +034000 IF SQ-FS4-STATUS-1 EQUAL TO "3" SQ1054.2 +034100 MOVE 1 TO PERM-ERRORS. SQ1054.2 +034200 SECT-SQ105-0002 SECTION. SQ1054.2 +034300 USE AFTER ERROR PROCEDURE ON INPUT. SQ1054.2 +034400 INPUT-PROCESS. SQ1054.2 +034500 MOVE "I" TO DECL-EXEC-SW-I. SQ1054.2 +034600 IF SQ-FS4-STATUS-1 EQUAL TO "1" SQ1054.2 +034700 MOVE 1 TO EOF-FLAG. SQ1054.2 +034800 IF SQ-FS4-STATUS-1 GREATER THAN "1" SQ1054.2 +034900 MOVE 1 TO PERM-ERRORS. SQ1054.2 +035000* SQ1054.2 +035100 END DECLARATIVES. SQ1054.2 +035200* SQ1054.2 +035300* SQ1054.2 +035400 CCVS1 SECTION. SQ1054.2 +035500 OPEN-FILES. SQ1054.2 +035600P OPEN I-O RAW-DATA. SQ1054.2 +035700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1054.2 +035800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1054.2 +035900P MOVE "ABORTED " TO C-ABORT. SQ1054.2 +036000P ADD 1 TO C-NO-OF-TESTS. SQ1054.2 +036100P ACCEPT C-DATE FROM DATE. SQ1054.2 +036200P ACCEPT C-TIME FROM TIME. SQ1054.2 +036300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1054.2 +036400PEND-E-1. SQ1054.2 +036500P CLOSE RAW-DATA. SQ1054.2 +036600 OPEN OUTPUT PRINT-FILE. SQ1054.2 +036700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1054.2 +036800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1054.2 +036900 MOVE SPACE TO TEST-RESULTS. SQ1054.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1054.2 +037100 MOVE ZERO TO REC-SKEL-SUB. SQ1054.2 +037200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1054.2 +037300 GO TO CCVS1-EXIT. SQ1054.2 +037400* SQ1054.2 +037500 CCVS-INIT-FILE. SQ1054.2 +037600 ADD 1 TO REC-SKL-SUB. SQ1054.2 +037700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1054.2 +037800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1054.2 +037900* SQ1054.2 +038000 CLOSE-FILES. SQ1054.2 +038100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1054.2 +038200 CLOSE PRINT-FILE. SQ1054.2 +038300P OPEN I-O RAW-DATA. SQ1054.2 +038400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1054.2 +038500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1054.2 +038600P MOVE "OK. " TO C-ABORT. SQ1054.2 +038700P MOVE PASS-COUNTER TO C-OK. SQ1054.2 +038800P MOVE ERROR-HOLD TO C-ALL. SQ1054.2 +038900P MOVE ERROR-COUNTER TO C-FAIL. SQ1054.2 +039000P MOVE DELETE-CNT TO C-DELETED. SQ1054.2 +039100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1054.2 +039200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1054.2 +039300PEND-E-2. SQ1054.2 +039400P CLOSE RAW-DATA. SQ1054.2 +039500 TERMINATE-CCVS. SQ1054.2 +039600S EXIT PROGRAM. SQ1054.2 +039700 STOP RUN. SQ1054.2 +039800* SQ1054.2 +039900 INSPT. SQ1054.2 +040000 MOVE "INSPT" TO P-OR-F. SQ1054.2 +040100 ADD 1 TO INSPECT-COUNTER. SQ1054.2 +040200 PERFORM PRINT-DETAIL. SQ1054.2 +040300* SQ1054.2 +040400 PASS. SQ1054.2 +040500 MOVE "PASS " TO P-OR-F. SQ1054.2 +040600 ADD 1 TO PASS-COUNTER. SQ1054.2 +040700 PERFORM PRINT-DETAIL. SQ1054.2 +040800* SQ1054.2 +040900 FAIL. SQ1054.2 +041000 MOVE "FAIL*" TO P-OR-F. SQ1054.2 +041100 ADD 1 TO ERROR-COUNTER. SQ1054.2 +041200 PERFORM PRINT-DETAIL. SQ1054.2 +041300* SQ1054.2 +041400 DE-LETE. SQ1054.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1054.2 +041600 MOVE "*****" TO P-OR-F. SQ1054.2 +041700 ADD 1 TO DELETE-COUNTER. SQ1054.2 +041800 PERFORM PRINT-DETAIL. SQ1054.2 +041900* SQ1054.2 +042000 PRINT-DETAIL. SQ1054.2 +042100 IF REC-CT NOT EQUAL TO ZERO SQ1054.2 +042200 MOVE "." TO PARDOT-X SQ1054.2 +042300 MOVE REC-CT TO DOTVALUE. SQ1054.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. SQ1054.2 +042500 PERFORM WRITE-LINE. SQ1054.2 +042600 IF P-OR-F EQUAL TO "FAIL*" SQ1054.2 +042700 PERFORM WRITE-LINE SQ1054.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1054.2 +042900 ELSE SQ1054.2 +043000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1054.2 +043100 MOVE SPACE TO P-OR-F. SQ1054.2 +043200 MOVE SPACE TO COMPUTED-X. SQ1054.2 +043300 MOVE SPACE TO CORRECT-X. SQ1054.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1054.2 +043500 MOVE SPACE TO RE-MARK. SQ1054.2 +043600* SQ1054.2 +043700 HEAD-ROUTINE. SQ1054.2 +043800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +043900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +044000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1054.2 +044100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1054.2 +044200 COLUMN-NAMES-ROUTINE. SQ1054.2 +044300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +044400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +044600 END-ROUTINE. SQ1054.2 +044700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1054.2 +044800 PERFORM WRITE-LINE 5 TIMES. SQ1054.2 +044900 END-RTN-EXIT. SQ1054.2 +045000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1054.2 +045100 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +045200* SQ1054.2 +045300 END-ROUTINE-1. SQ1054.2 +045400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1054.2 +045500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1054.2 +045600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1054.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1054.2 +045800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1054.2 +045900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1054.2 +046000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1054.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1054.2 +046200 PERFORM WRITE-LINE. SQ1054.2 +046300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1054.2 +046400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1054.2 +046500 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +046600 ELSE SQ1054.2 +046700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1054.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1054.2 +046900 PERFORM WRITE-LINE. SQ1054.2 +047000 END-ROUTINE-13. SQ1054.2 +047100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1054.2 +047200 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +047300 ELSE SQ1054.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1054.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1054.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1054.2 +047700 PERFORM WRITE-LINE. SQ1054.2 +047800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1054.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +048000 ELSE SQ1054.2 +048100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1054.2 +048200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1054.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +048400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +048500* SQ1054.2 +048600 WRITE-LINE. SQ1054.2 +048700 ADD 1 TO RECORD-COUNT. SQ1054.2 +048800Y IF RECORD-COUNT GREATER 50 SQ1054.2 +048900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1054.2 +049000Y MOVE SPACE TO DUMMY-RECORD SQ1054.2 +049100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1054.2 +049200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1054.2 +049300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1054.2 +049400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1054.2 +049500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1054.2 +049600Y MOVE ZERO TO RECORD-COUNT. SQ1054.2 +049700 PERFORM WRT-LN. SQ1054.2 +049800* SQ1054.2 +049900 WRT-LN. SQ1054.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1054.2 +050100 MOVE SPACE TO DUMMY-RECORD. SQ1054.2 +050200 BLANK-LINE-PRINT. SQ1054.2 +050300 PERFORM WRT-LN. SQ1054.2 +050400 FAIL-ROUTINE. SQ1054.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1054.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1054.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1054.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1054.2 +050900 MOVE XXINFO TO DUMMY-RECORD. SQ1054.2 +051000 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1054.2 +051200 GO TO FAIL-ROUTINE-EX. SQ1054.2 +051300 FAIL-ROUTINE-WRITE. SQ1054.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC SQ1054.2 +051500 PERFORM WRITE-LINE SQ1054.2 +051600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1054.2 +051700 MOVE TEST-CORRECT TO PRINT-REC SQ1054.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +051900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1054.2 +052000 FAIL-ROUTINE-EX. SQ1054.2 +052100 EXIT. SQ1054.2 +052200 BAIL-OUT. SQ1054.2 +052300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1054.2 +052400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1054.2 +052500 BAIL-OUT-WRITE. SQ1054.2 +052600 MOVE CORRECT-A TO XXCORRECT. SQ1054.2 +052700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1054.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1054.2 +052900 MOVE XXINFO TO DUMMY-RECORD. SQ1054.2 +053000 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +053100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1054.2 +053200 BAIL-OUT-EX. SQ1054.2 +053300 EXIT. SQ1054.2 +053400 CCVS1-EXIT. SQ1054.2 +053500 EXIT. SQ1054.2 +053600* SQ1054.2 +053700**************************************************************** SQ1054.2 +053800* * SQ1054.2 +053900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1054.2 +054000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1054.2 +054100* * SQ1054.2 +054200**************************************************************** SQ1054.2 +054300* SQ1054.2 +054400 SECT-SQ105-0003 SECTION. SQ1054.2 +054500 INITIAL-PARA. SQ1054.2 +054600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1054.2 +054700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1054.2 +054800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1054.2 +054900 MOVE 000125 TO XRECORD-LENGTH (1). SQ1054.2 +055000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1054.2 +055100 MOVE 0002 TO XBLOCK-SIZE (1). SQ1054.2 +055200 MOVE 000980 TO RECORDS-IN-FILE (1). SQ1054.2 +055300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1054.2 +055400 MOVE "S" TO XLABEL-TYPE (1). SQ1054.2 +055500 MOVE ZERO TO MAJOR-DELETIONS. SQ1054.2 +055600* SQ1054.2 +055700* THE INITIAL ACTIONS ARE TO CREATE A FILE FOR USE SQ1054.2 +055800* IN LATER TESTS. FILE STATUS VALUES AND DECLARATIVE SQ1054.2 +055900* EXECUTION DURING THE CREATION PROCESS ARE MONITORED. SQ1054.2 +056000* SQ1054.2 +056100 SEQ-INIT-01. SQ1054.2 +056200 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +056300 MOVE 0 TO COUNT-OF-RECS. SQ1054.2 +056400 MOVE "CREATE 980 RECORD FILE" TO FEATURE. SQ1054.2 +056500 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1054.2 +056600 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +056700 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +056800 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +056900 MOVE 1 TO REC-CT. SQ1054.2 +057000 GO TO SEQ-TEST-WR-01. SQ1054.2 +057100 SEQ-DELETE-01. SQ1054.2 +057200 MOVE 1 TO MAJOR-DELETIONS. SQ1054.2 +057300 GO TO SEQ-DELETE-01-01. SQ1054.2 +057400 SEQ-TEST-WR-01. SQ1054.2 +057500 OPEN OUTPUT SQ-FS4. SQ1054.2 +057600 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +057700 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +057800 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +057900* SQ1054.2 +058000 SEQ-TEST-WR-01-LOOP. SQ1054.2 +058100 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +058200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1054.2 +058300 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +058400 MOVE COUNT-OF-RECS TO SQ-FS4-REC-NO. SQ1054.2 +058500 WRITE SQ-FS4R1-F-G-125. SQ1054.2 +058600 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +058700 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +058800 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +058900 IF PERM-ERRORS EQUAL TO 1 SQ1054.2 +059000 GO TO SEQ-TEST-WR-01-LOOP-EXIT. SQ1054.2 +059100 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +059200 GO TO SEQ-TEST-WR-01-LOOP. SQ1054.2 +059300* SQ1054.2 +059400 SEQ-TEST-WR-01-LOOP-EXIT. SQ1054.2 +059500* SQ1054.2 +059600 CLOSE SQ-FS4. SQ1054.2 +059700 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +059800 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +059900 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +060000* SQ1054.2 +060100 GO TO SEQ-TEST-WR-01-01. SQ1054.2 +060200 SEQ-DELETE-01-01. SQ1054.2 +060300 PERFORM DE-LETE. SQ1054.2 +060400 GO TO SEQ-INIT-WR-01-02. SQ1054.2 +060500 SEQ-TEST-WR-01-01. SQ1054.2 +060600* SQ1054.2 +060700 IF SQ-FS4-STATUS-COPY EQUAL "00" SQ1054.2 +060800 PERFORM PASS SQ1054.2 +060900 ELSE SQ1054.2 +061000 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +061100 MOVE "00" TO CORRECT-A SQ1054.2 +061200 MOVE "ERROR I-O STATUS DURING FILE CREATION" SQ1054.2 +061300 TO RE-MARK SQ1054.2 +061400 PERFORM FAIL. SQ1054.2 +061500* SQ1054.2 +061600 SEQ-INIT-WR-01-02. SQ1054.2 +061700 ADD 1 TO REC-CT. SQ1054.2 +061800 IF MAJOR-DELETIONS = 1 SQ1054.2 +061900 GO TO SEQ-DELETE-01-02. SQ1054.2 +062000 GO TO SEQ-TEST-WR-01-02. SQ1054.2 +062100 SEQ-DELETE-01-02. SQ1054.2 +062200 PERFORM DE-LETE. SQ1054.2 +062300 GO TO SEQ-TEST-01-END. SQ1054.2 +062400 SEQ-TEST-WR-01-02. SQ1054.2 +062500 IF DECL-EXEC-SW = "**" SQ1054.2 +062600 PERFORM PASS SQ1054.2 +062700 ELSE SQ1054.2 +062800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +062900 MOVE "**" TO CORRECT-A SQ1054.2 +063000 MOVE SQ1054.2 +063100 "UNEXPECTED DECLARATIVE EXECUTION DURING FILE CREATION" SQ1054.2 +063200 TO RE-MARK SQ1054.2 +063300 PERFORM FAIL. SQ1054.2 +063400 SEQ-TEST-01-END. SQ1054.2 +063500* SQ1054.2 +063600* A SEQUENTIAL MASS STORAGE FILE WITH 125 CHARACTER RECORDS, SQ1054.2 +063700* TWO RECORDS PER BLOCK, HAS BEEN CREATED. THE FILE SQ1054.2 +063800* CONTAINS 980 RECORDS. THE FOLLOWING TESTS READ AND SQ1054.2 +063900* VERIFY THE RECORDS IN THE FILE. THE READ STATEMENT DOES SQ1054.2 +064000* NOT CONTAIN AN AT END PHRASE, SO THE INPUT DECLARATIVE SQ1054.2 +064100* SHOULD BE EXECUTED AT THE END OF THE FILE. THE READ SQ1054.2 +064200* STATEMENT CONTAINS THE OPTIONAL WORD "RECORD" SQ1054.2 +064300* SQ1054.2 +064400 SEQ-INIT-02. SQ1054.2 +064500 MOVE 1 TO REC-CT. SQ1054.2 +064600 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +064700 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +064800 MOVE "OPEN FILE FOR CHECK" TO FEATURE. SQ1054.2 +064900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1054.2 +065000 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +065100 GO TO SEQ-DELETE-02. SQ1054.2 +065200 GO TO SEQ-TEST-GF-02. SQ1054.2 +065300 SEQ-DELETE-02. SQ1054.2 +065400 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +065500 GO TO SEQ-DELETE-02-01. SQ1054.2 +065600* SQ1054.2 +065700 SEQ-TEST-GF-02. SQ1054.2 +065800 OPEN INPUT SQ-FS4. SQ1054.2 +065900 GO TO SEQ-TEST-GF-02-01. SQ1054.2 +066000 SEQ-DELETE-02-01. SQ1054.2 +066100 PERFORM DE-LETE. SQ1054.2 +066200 GO TO SEQ-TEST-02-01-END. SQ1054.2 +066300 SEQ-TEST-GF-02-01. SQ1054.2 +066400 IF SQ-FS4-STATUS = "00" SQ1054.2 +066500 PERFORM PASS SQ1054.2 +066600 ELSE SQ1054.2 +066700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +066800 MOVE "00" TO CORRECT-A SQ1054.2 +066900 MOVE "FAILURE STATUS CODE AFTER OPEN" TO RE-MARK SQ1054.2 +067000 PERFORM FAIL. SQ1054.2 +067100 IF SQ-FS4-STATUS GREATER THAN "10" SQ1054.2 +067200 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +067300 SEQ-TEST-02-01-END. SQ1054.2 +067400* SQ1054.2 +067500 ADD 1 TO REC-CT. SQ1054.2 +067600 GO TO SEQ-TEST-GF-02-02. SQ1054.2 +067700 SEQ-DELETE-02-02. SQ1054.2 +067800 PERFORM DE-LETE. SQ1054.2 +067900 GO TO SEQ-TEST-02-02-END. SQ1054.2 +068000 SEQ-TEST-GF-02-02. SQ1054.2 +068100 IF DECL-EXEC-SW = "**" SQ1054.2 +068200 PERFORM PASS SQ1054.2 +068300 ELSE SQ1054.2 +068400 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +068500 MOVE "**" TO CORRECT-A SQ1054.2 +068600 MOVE "DECLARATIVE EXECUTED ON OPEN" TO RE-MARK SQ1054.2 +068700 PERFORM FAIL. SQ1054.2 +068800 SEQ-TEST-02-02-END. SQ1054.2 +068900* SQ1054.2 +069000 SEQ-INIT-03. SQ1054.2 +069100 MOVE 1 TO REC-CT. SQ1054.2 +069200 MOVE "READ ... RECORD" TO FEATURE. SQ1054.2 +069300 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1054.2 +069400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +069500 GO TO SEQ-DELETE-03. SQ1054.2 +069600 GO TO SEQ-TEST-GF-03. SQ1054.2 +069700 SEQ-DELETE-03. SQ1054.2 +069800 ADD 4 TO MAJOR-DELETIONS. SQ1054.2 +069900 GO TO SEQ-DELETE-03-01. SQ1054.2 +070000 SEQ-TEST-GF-03. SQ1054.2 +070100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +070200 MOVE ZERO TO COUNT-OF-RECS. SQ1054.2 +070300 MOVE ZERO TO PERM-ERRORS. SQ1054.2 +070400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1054.2 +070500 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +070600 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +070700 SEQ-TEST-03-LOOP. SQ1054.2 +070800 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +070900 READ SQ-FS4 RECORD. SQ1054.2 +071000 IF DECL-EXEC-SW NOT = "**" SQ1054.2 +071100 GO TO SEQ-TEST-GF-03-01. SQ1054.2 +071200 IF SQ-FS4-STATUS = "10" SQ1054.2 +071300 GO TO SEQ-TEST-GF-03-LOOP-END. SQ1054.2 +071400 IF SQ-FS4-STATUS NOT = "00" SQ1054.2 +071500 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY. SQ1054.2 +071600 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +071700 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +071800 IF SQ-FS4-FIRST NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1054.2 +071900 OR SQ-FS4-REC-NO NOT EQUAL TO COUNT-OF-RECS SQ1054.2 +072000 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +072100 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +072200 GO TO SEQ-TEST-03-LOOP. SQ1054.2 +072300* SQ1054.2 +072400 SEQ-TEST-GF-03-LOOP-END. SQ1054.2 +072500 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +072600 GO TO SEQ-DELETE-03-01. SQ1054.2 +072700 GO TO SEQ-TEST-GF-03-01. SQ1054.2 +072800 SEQ-DELETE-03-01. SQ1054.2 +072900 PERFORM DE-LETE. SQ1054.2 +073000 GO TO SEQ-TEST-03-01-END. SQ1054.2 +073100 SEQ-TEST-GF-03-01. SQ1054.2 +073200 IF COUNT-OF-RECS EQUAL TO 980 SQ1054.2 +073300 PERFORM PASS SQ1054.2 +073400 ELSE SQ1054.2 +073500 MOVE COUNT-OF-RECS TO COMPUTED-18V0 SQ1054.2 +073600 MOVE 980 TO CORRECT-18V0 SQ1054.2 +073700 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1054.2 +073800 TO RE-MARK SQ1054.2 +073900 PERFORM FAIL. SQ1054.2 +074000 SEQ-TEST-03-01-END. SQ1054.2 +074100* SQ1054.2 +074200 ADD 1 TO REC-CT. SQ1054.2 +074300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +074400 GO TO SEQ-TEST-03-02-END. SQ1054.2 +074500 GO TO SEQ-TEST-GF-03-02. SQ1054.2 +074600 SEQ-DELETE-03-02. SQ1054.2 +074700 PERFORM DE-LETE. SQ1054.2 +074800 GO TO SEQ-TEST-03-02-END. SQ1054.2 +074900 SEQ-TEST-GF-03-02. SQ1054.2 +075000 IF DECL-EXEC-SW = "**" SQ1054.2 +075100 PERFORM PASS SQ1054.2 +075200 ELSE SQ1054.2 +075300 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +075400 MOVE "**" TO CORRECT-A SQ1054.2 +075500 MOVE "DECLARATIVES ENTERED AT LEAST ONCE" TO RE-MARK SQ1054.2 +075600 PERFORM FAIL. SQ1054.2 +075700 SEQ-TEST-03-02-END. SQ1054.2 +075800* SQ1054.2 +075900 ADD 1 TO REC-CT. SQ1054.2 +076000 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +076100 GO TO SEQ-TEST-03-03-END. SQ1054.2 +076200 GO TO SEQ-TEST-GF-03-03. SQ1054.2 +076300 SEQ-DELETE-03-03. SQ1054.2 +076400 PERFORM DE-LETE. SQ1054.2 +076500 GO TO SEQ-TEST-03-03-END. SQ1054.2 +076600 SEQ-TEST-GF-03-03. SQ1054.2 +076700 IF SQ-FS4-STATUS-COPY = "00" SQ1054.2 +076800 PERFORM PASS SQ1054.2 +076900 ELSE SQ1054.2 +077000 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +077100 MOVE "00" TO CORRECT-A SQ1054.2 +077200 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1054.2 +077300 MOVE "VII-2" TO ANSI-REFERENCE SQ1054.2 +077400 PERFORM FAIL. SQ1054.2 +077500 SEQ-TEST-03-03-END. SQ1054.2 +077600* SQ1054.2 +077700 ADD 1 TO REC-CT. SQ1054.2 +077800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +077900 GO TO SEQ-TEST-03-04-END. SQ1054.2 +078000 GO TO SEQ-TEST-GF-03-04. SQ1054.2 +078100 SEQ-DELETE-03-04. SQ1054.2 +078200 PERFORM DE-LETE. SQ1054.2 +078300 GO TO SEQ-TEST-03-04-END. SQ1054.2 +078400 SEQ-TEST-GF-03-04. SQ1054.2 +078500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1054.2 +078600 PERFORM PASS SQ1054.2 +078700 ELSE SQ1054.2 +078800 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1054.2 +078900 MOVE ZERO TO CORRECT-18V0 SQ1054.2 +079000 MOVE "ONE OR MORE ERRORS IN RECORDS READ" TO RE-MARK SQ1054.2 +079100 PERFORM FAIL. SQ1054.2 +079200 SEQ-TEST-03-04-END. SQ1054.2 +079300* SQ1054.2 +079400* SQ1054.2 +079500 SEQ-INIT-04. SQ1054.2 +079600 MOVE 1 TO REC-CT. SQ1054.2 +079700 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +079800 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +079900 MOVE "READ ... RECORD, EOF" TO FEATURE. SQ1054.2 +080000 MOVE "SEQ-TEST-GF-04" TO PAR-NAME. SQ1054.2 +080100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +080200 GO TO SEQ-DELETE-04. SQ1054.2 +080300 GO TO SEQ-TEST-GF-04. SQ1054.2 +080400 SEQ-DELETE-04. SQ1054.2 +080500 ADD 8 TO MAJOR-DELETIONS. SQ1054.2 +080600 PERFORM DE-LETE. SQ1054.2 +080700 GO TO SEQ-DELETE-04-01. SQ1054.2 +080800 SEQ-TEST-GF-04. SQ1054.2 +080900 READ SQ-FS4 RECORD. SQ1054.2 +081000* SQ1054.2 +081100 GO TO SEQ-TEST-GF-04-01. SQ1054.2 +081200 SEQ-DELETE-04-01. SQ1054.2 +081300 PERFORM DE-LETE. SQ1054.2 +081400 GO TO SEQ-TEST-04-01-END. SQ1054.2 +081500 SEQ-TEST-GF-04-01. SQ1054.2 +081600 IF SQ-FS4-STATUS = "10" SQ1054.2 +081700 PERFORM PASS SQ1054.2 +081800 ELSE SQ1054.2 +081900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +082000 MOVE "10" TO CORRECT-A SQ1054.2 +082100 MOVE "END OF FILE STATUS CODE NOT GIVEN AT EOF" SQ1054.2 +082200 TO RE-MARK SQ1054.2 +082300 MOVE "VII-3, 1.3.5(2)A" TO ANSI-REFERENCE SQ1054.2 +082400 PERFORM FAIL. SQ1054.2 +082500 SEQ-TEST-04-01-END. SQ1054.2 +082600* SQ1054.2 +082700 ADD 1 TO REC-CT. SQ1054.2 +082800 IF MAJOR-DELETIONS NOT EQUAL TO 0 SQ1054.2 +082900 GO TO SEQ-DELETE-04-02. SQ1054.2 +083000 GO TO SEQ-TEST-GF-04-02. SQ1054.2 +083100 SEQ-DELETE-04-02. SQ1054.2 +083200 PERFORM DE-LETE. SQ1054.2 +083300 GO TO SEQ-TEST-04-02-END. SQ1054.2 +083400 SEQ-TEST-GF-04-02. SQ1054.2 +083500 IF DECL-EXEC-SW EQUAL "*I" SQ1054.2 +083600 PERFORM PASS SQ1054.2 +083700 ELSE SQ1054.2 +083800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +083900 MOVE "*I" TO CORRECT-A SQ1054.2 +084000 MOVE "CORRECT DECLARATIVE NOT EXECUTED AT EOF" SQ1054.2 +084100 TO RE-MARK SQ1054.2 +084200 MOVE "VII-2, VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1054.2 +084300 PERFORM FAIL. SQ1054.2 +084400 SEQ-TEST-04-02-END. SQ1054.2 +084500* SQ1054.2 +084600* SQ1054.2 +084700 SEQ-INIT-05. SQ1054.2 +084800 MOVE 1 TO REC-CT. SQ1054.2 +084900 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +085000 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +085100 MOVE "CLOSE AFTER READ" TO FEATURE. SQ1054.2 +085200 MOVE "SEQ-TEST-GF-05" TO PAR-NAME. SQ1054.2 +085300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +085400 GO TO SEQ-DELETE-05. SQ1054.2 +085500 GO TO SEQ-TEST-GF-05. SQ1054.2 +085600 SEQ-DELETE-05. SQ1054.2 +085700 GO TO SEQ-DELETE-05-01. SQ1054.2 +085800 SEQ-TEST-GF-05. SQ1054.2 +085900 CLOSE SQ-FS4. SQ1054.2 +086000* SQ1054.2 +086100 GO TO SEQ-TEST-GF-05-01. SQ1054.2 +086200 SEQ-DELETE-05-01. SQ1054.2 +086300 PERFORM DE-LETE. SQ1054.2 +086400 GO TO SEQ-TEST-05-01-END. SQ1054.2 +086500 SEQ-TEST-GF-05-01. SQ1054.2 +086600 IF SQ-FS4-STATUS = "00" SQ1054.2 +086700 PERFORM PASS SQ1054.2 +086800 ELSE SQ1054.2 +086900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +087000 MOVE "00" TO CORRECT-A SQ1054.2 +087100 MOVE "UNEXPECTED I-O STATUS VALUE FROM CLOSE" SQ1054.2 +087200 TO RE-MARK SQ1054.2 +087300 MOVE "VII-3, VII-38, 4.2.4(4)" TO ANSI-REFERENCE SQ1054.2 +087400 PERFORM FAIL. SQ1054.2 +087500 SEQ-TEST-05-01-END. SQ1054.2 +087600* SQ1054.2 +087700 ADD 1 TO REC-CT. SQ1054.2 +087800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +087900 GO TO SEQ-DELETE-05-02. SQ1054.2 +088000 GO TO SEQ-TEST-GF-05-02. SQ1054.2 +088100 SEQ-DELETE-05-02. SQ1054.2 +088200 PERFORM DE-LETE. SQ1054.2 +088300 GO TO SEQ-TEST-05-02-END. SQ1054.2 +088400 SEQ-TEST-GF-05-02. SQ1054.2 +088500 IF DECL-EXEC-SW = "**" SQ1054.2 +088600 PERFORM PASS SQ1054.2 +088700 ELSE SQ1054.2 +088800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +088900 MOVE "**" TO CORRECT-A SQ1054.2 +089000 MOVE "DECLARATIVE EXECUTED ON CLOSE FILE" TO RE-MARK SQ1054.2 +089100 PERFORM FAIL. SQ1054.2 +089200 SEQ-TEST-05-02-END. SQ1054.2 +089300 IF MAJOR-DELETIONS NOT LESS THAN 8 SQ1054.2 +089400 SUBTRACT 8 FROM MAJOR-DELETIONS. SQ1054.2 +089500 IF MAJOR-DELETIONS NOT LESS THAN 4 SQ1054.2 +089600 SUBTRACT 4 FROM MAJOR-DELETIONS. SQ1054.2 +089700 IF MAJOR-DELETIONS NOT LESS THAN 2 SQ1054.2 +089800 SUBTRACT 2 FROM MAJOR-DELETIONS. SQ1054.2 +089900* SQ1054.2 +090000* SQ1054.2 +090100* HAVING PROCESSED THE FILE WITH A READ ... RECORD STATEMENT, SQ1054.2 +090200* IT WILL NOW BE PROCESSED WITH A READ STATEMENT WITHOUT THE SQ1054.2 +090300* OPTIONAL WORD RECORD, AND THE SAME TESTS CARRIED OUT. SQ1054.2 +090400* SQ1054.2 +090500 SEQ-INIT-06. SQ1054.2 +090600 MOVE 1 TO REC-CT. SQ1054.2 +090700 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +090800 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +090900 MOVE "OPEN FILE FOR CHECK" TO FEATURE. SQ1054.2 +091000 MOVE "SEQ-TEST-GF-06" TO PAR-NAME. SQ1054.2 +091100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +091200 GO TO SEQ-DELETE-06. SQ1054.2 +091300 GO TO SEQ-TEST-GF-06. SQ1054.2 +091400 SEQ-DELETE-06. SQ1054.2 +091500 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +091600 GO TO SEQ-DELETE-06-01. SQ1054.2 +091700* SQ1054.2 +091800 SEQ-TEST-GF-06. SQ1054.2 +091900 OPEN INPUT SQ-FS4. SQ1054.2 +092000 GO TO SEQ-TEST-GF-06-01. SQ1054.2 +092100 SEQ-DELETE-06-01. SQ1054.2 +092200 PERFORM DE-LETE. SQ1054.2 +092300 GO TO SEQ-TEST-06-01-END. SQ1054.2 +092400 SEQ-TEST-GF-06-01. SQ1054.2 +092500 IF SQ-FS4-STATUS = "00" SQ1054.2 +092600 PERFORM PASS SQ1054.2 +092700 ELSE SQ1054.2 +092800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +092900 MOVE "00" TO CORRECT-A SQ1054.2 +093000 MOVE "FAILURE STATUS CODE AFTER OPEN" TO RE-MARK SQ1054.2 +093100 PERFORM FAIL. SQ1054.2 +093200 IF SQ-FS4-STATUS GREATER THAN "10" SQ1054.2 +093300 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +093400 SEQ-TEST-06-01-END. SQ1054.2 +093500* SQ1054.2 +093600 ADD 1 TO REC-CT. SQ1054.2 +093700 GO TO SEQ-TEST-GF-06-02. SQ1054.2 +093800 SEQ-DELETE-06-02. SQ1054.2 +093900 PERFORM DE-LETE. SQ1054.2 +094000 GO TO SEQ-TEST-06-02-END. SQ1054.2 +094100 SEQ-TEST-GF-06-02. SQ1054.2 +094200 IF DECL-EXEC-SW = "**" SQ1054.2 +094300 PERFORM PASS SQ1054.2 +094400 ELSE SQ1054.2 +094500 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +094600 MOVE "**" TO CORRECT-A SQ1054.2 +094700 MOVE "DECLARATIVE EXECUTED ON OPEN" TO RE-MARK SQ1054.2 +094800 PERFORM FAIL. SQ1054.2 +094900 SEQ-TEST-06-02-END. SQ1054.2 +095000* SQ1054.2 +095100* SQ1054.2 +095200* THE NEXT GROUP OF TEST READ THE RECORDS FROM THE FILE, SQ1054.2 +095300* USING A READ STATEMENT WITHOUT OPTIONAL PHRASES. THE SQ1054.2 +095400* RECORDS RETURNED FROM THE FILE ARE CHECKED FOR EXPECTED SQ1054.2 +095500* CONTENTS. FILE STATUS VALUES AND EXECUTION OF SQ1054.2 +095600* DECLARATIVE PROCEDURES ARE ALSO CHECKED. SQ1054.2 +095700* SQ1054.2 +095800 SEQ-INIT-07. SQ1054.2 +095900 MOVE 1 TO REC-CT. SQ1054.2 +096000 MOVE "READ ..." TO FEATURE. SQ1054.2 +096100 MOVE "SEQ-TEST-GF-07" TO PAR-NAME. SQ1054.2 +096200 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +096300 GO TO SEQ-DELETE-07. SQ1054.2 +096400 GO TO SEQ-TEST-GF-07. SQ1054.2 +096500 SEQ-DELETE-07. SQ1054.2 +096600 ADD 4 TO MAJOR-DELETIONS. SQ1054.2 +096700 GO TO SEQ-DELETE-07-01. SQ1054.2 +096800 SEQ-TEST-GF-07. SQ1054.2 +096900 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +097000 MOVE ZERO TO COUNT-OF-RECS. SQ1054.2 +097100 MOVE ZERO TO PERM-ERRORS. SQ1054.2 +097200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1054.2 +097300 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +097400 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +097500 SEQ-TEST-07-LOOP. SQ1054.2 +097600 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +097700 READ SQ-FS4. SQ1054.2 +097800 IF DECL-EXEC-SW NOT = "**" SQ1054.2 +097900 GO TO SEQ-TEST-GF-07-01. SQ1054.2 +098000 IF SQ-FS4-STATUS = "10" SQ1054.2 +098100 GO TO SEQ-TEST-GF-07-LOOP-END. SQ1054.2 +098200 IF SQ-FS4-STATUS NOT = "00" SQ1054.2 +098300 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY. SQ1054.2 +098400 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +098500 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +098600 IF SQ-FS4-FIRST NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1054.2 +098700 OR SQ-FS4-REC-NO NOT EQUAL TO COUNT-OF-RECS SQ1054.2 +098800 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +098900 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +099000 GO TO SEQ-TEST-07-LOOP. SQ1054.2 +099100* SQ1054.2 +099200 SEQ-TEST-GF-07-LOOP-END. SQ1054.2 +099300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +099400 GO TO SEQ-DELETE-07-01. SQ1054.2 +099500 GO TO SEQ-TEST-GF-07-01. SQ1054.2 +099600 SEQ-DELETE-07-01. SQ1054.2 +099700 PERFORM DE-LETE. SQ1054.2 +099800 GO TO SEQ-TEST-07-01-END. SQ1054.2 +099900 SEQ-TEST-GF-07-01. SQ1054.2 +100000 IF COUNT-OF-RECS EQUAL TO 980 SQ1054.2 +100100 PERFORM PASS SQ1054.2 +100200 ELSE SQ1054.2 +100300 MOVE COUNT-OF-RECS TO COMPUTED-18V0 SQ1054.2 +100400 MOVE 980 TO CORRECT-18V0 SQ1054.2 +100500 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1054.2 +100600 TO RE-MARK SQ1054.2 +100700 PERFORM FAIL. SQ1054.2 +100800 SEQ-TEST-07-01-END. SQ1054.2 +100900* SQ1054.2 +101000 ADD 1 TO REC-CT. SQ1054.2 +101100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +101200 GO TO SEQ-TEST-07-02-END. SQ1054.2 +101300 GO TO SEQ-TEST-GF-07-02. SQ1054.2 +101400 SEQ-DELETE-07-02. SQ1054.2 +101500 PERFORM DE-LETE. SQ1054.2 +101600 GO TO SEQ-TEST-07-02-END. SQ1054.2 +101700 SEQ-TEST-GF-07-02. SQ1054.2 +101800 IF DECL-EXEC-SW = "**" SQ1054.2 +101900 PERFORM PASS SQ1054.2 +102000 ELSE SQ1054.2 +102100 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +102200 MOVE "**" TO CORRECT-A SQ1054.2 +102300 MOVE "DECLARATIVES ENTERED AT LEAST ONCE" TO RE-MARK SQ1054.2 +102400 PERFORM FAIL. SQ1054.2 +102500 SEQ-TEST-07-02-END. SQ1054.2 +102600* SQ1054.2 +102700 ADD 1 TO REC-CT. SQ1054.2 +102800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +102900 GO TO SEQ-TEST-07-03-END. SQ1054.2 +103000 GO TO SEQ-TEST-GF-07-03. SQ1054.2 +103100 SEQ-DELETE-07-03. SQ1054.2 +103200 PERFORM DE-LETE. SQ1054.2 +103300 GO TO SEQ-TEST-07-03-END. SQ1054.2 +103400 SEQ-TEST-GF-07-03. SQ1054.2 +103500 IF SQ-FS4-STATUS-COPY = "00" SQ1054.2 +103600 PERFORM PASS SQ1054.2 +103700 ELSE SQ1054.2 +103800 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +103900 MOVE "00" TO CORRECT-A SQ1054.2 +104000 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1054.2 +104100 MOVE "VII-2" TO ANSI-REFERENCE SQ1054.2 +104200 PERFORM FAIL. SQ1054.2 +104300 SEQ-TEST-07-03-END. SQ1054.2 +104400* SQ1054.2 +104500 ADD 1 TO REC-CT. SQ1054.2 +104600 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +104700 GO TO SEQ-TEST-07-04-END. SQ1054.2 +104800 GO TO SEQ-TEST-GF-07-04. SQ1054.2 +104900 SEQ-DELETE-07-04. SQ1054.2 +105000 PERFORM DE-LETE. SQ1054.2 +105100 GO TO SEQ-TEST-07-04-END. SQ1054.2 +105200 SEQ-TEST-GF-07-04. SQ1054.2 +105300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1054.2 +105400 PERFORM PASS SQ1054.2 +105500 ELSE SQ1054.2 +105600 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1054.2 +105700 MOVE ZERO TO CORRECT-18V0 SQ1054.2 +105800 MOVE "ONE OR MORE ERRORS IN RECORDS READ" TO RE-MARK SQ1054.2 +105900 PERFORM FAIL. SQ1054.2 +106000 SEQ-TEST-07-04-END. SQ1054.2 +106100* SQ1054.2 +106200* SQ1054.2 +106300* THE NEXT TEST EXECUTES ONE READ STATEMENT WITH THE FILE SQ1054.2 +106400* POSITIONED AFTER THE LAST RECORD. THE READ STATEMENT DOES SQ1054.2 +106500* NOT CONTAIN AN AT END PHRASE, SO THE APPROPRIATE SQ1054.2 +106600* DECLARATIVE SHOULD BE EXECUTED. SQ1054.2 +106700* SQ1054.2 +106800 SEQ-INIT-08. SQ1054.2 +106900 MOVE 1 TO REC-CT. SQ1054.2 +107000 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +107100 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +107200 MOVE "READ ... EOF" TO FEATURE. SQ1054.2 +107300 MOVE "SEQ-TEST-GF-08" TO PAR-NAME. SQ1054.2 +107400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +107500 GO TO SEQ-DELETE-08. SQ1054.2 +107600 GO TO SEQ-TEST-GF-08. SQ1054.2 +107700 SEQ-DELETE-08. SQ1054.2 +107800 ADD 8 TO MAJOR-DELETIONS. SQ1054.2 +107900 PERFORM DE-LETE. SQ1054.2 +108000 GO TO SEQ-DELETE-08-01. SQ1054.2 +108100 SEQ-TEST-GF-08. SQ1054.2 +108200 READ SQ-FS4. SQ1054.2 +108300* SQ1054.2 +108400 GO TO SEQ-TEST-GF-08-01. SQ1054.2 +108500 SEQ-DELETE-08-01. SQ1054.2 +108600 PERFORM DE-LETE. SQ1054.2 +108700 GO TO SEQ-TEST-08-01-END. SQ1054.2 +108800 SEQ-TEST-GF-08-01. SQ1054.2 +108900 IF SQ-FS4-STATUS = "10" SQ1054.2 +109000 PERFORM PASS SQ1054.2 +109100 ELSE SQ1054.2 +109200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +109300 MOVE "10" TO CORRECT-A SQ1054.2 +109400 MOVE "END OF FILE STATUS CODE NOT GIVEN AT EOF" SQ1054.2 +109500 TO RE-MARK SQ1054.2 +109600 MOVE "VII-3, 1.3.5(2)A" TO ANSI-REFERENCE SQ1054.2 +109700 PERFORM FAIL. SQ1054.2 +109800 SEQ-TEST-08-01-END. SQ1054.2 +109900* SQ1054.2 +110000 ADD 1 TO REC-CT. SQ1054.2 +110100 IF MAJOR-DELETIONS NOT EQUAL TO 0 SQ1054.2 +110200 GO TO SEQ-DELETE-08-02. SQ1054.2 +110300 GO TO SEQ-TEST-GF-08-02. SQ1054.2 +110400 SEQ-DELETE-08-02. SQ1054.2 +110500 PERFORM DE-LETE. SQ1054.2 +110600 GO TO SEQ-TEST-08-02-END. SQ1054.2 +110700 SEQ-TEST-GF-08-02. SQ1054.2 +110800 IF DECL-EXEC-SW EQUAL "*I" SQ1054.2 +110900 PERFORM PASS SQ1054.2 +111000 ELSE SQ1054.2 +111100 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +111200 MOVE "*I" TO CORRECT-A SQ1054.2 +111300 MOVE "CORRECT DECLARATIVE NOT EXECUTED AT EOF" SQ1054.2 +111400 TO RE-MARK SQ1054.2 +111500 MOVE "VII-2, VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1054.2 +111600 PERFORM FAIL. SQ1054.2 +111700 SEQ-TEST-08-02-END. SQ1054.2 +111800* SQ1054.2 +111900* SQ1054.2 +112000* CLOSE THE FILE AND CHECK FILE STATUS AND THAT THE SQ1054.2 +112100* DECLARATIVE IS NOT EXECUTED SQ1054.2 +112200* SQ1054.2 +112300 SEQ-INIT-09. SQ1054.2 +112400 MOVE 1 TO REC-CT. SQ1054.2 +112500 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +112600 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +112700 MOVE "CLOSE AFTER READ" TO FEATURE. SQ1054.2 +112800 MOVE "SEQ-TEST-GF-09" TO PAR-NAME. SQ1054.2 +112900 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +113000 GO TO SEQ-DELETE-09. SQ1054.2 +113100 GO TO SEQ-TEST-GF-09. SQ1054.2 +113200 SEQ-DELETE-09. SQ1054.2 +113300 GO TO SEQ-DELETE-09-01. SQ1054.2 +113400 SEQ-TEST-GF-09. SQ1054.2 +113500 CLOSE SQ-FS4. SQ1054.2 +113600* SQ1054.2 +113700 GO TO SEQ-TEST-GF-09-01. SQ1054.2 +113800 SEQ-DELETE-09-01. SQ1054.2 +113900 PERFORM DE-LETE. SQ1054.2 +114000 GO TO SEQ-TEST-09-01-END. SQ1054.2 +114100 SEQ-TEST-GF-09-01. SQ1054.2 +114200 IF SQ-FS4-STATUS = "00" SQ1054.2 +114300 PERFORM PASS SQ1054.2 +114400 ELSE SQ1054.2 +114500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +114600 MOVE "00" TO CORRECT-A SQ1054.2 +114700 MOVE "UNEXPECTED I-O STATUS VALUE FROM CLOSE" SQ1054.2 +114800 TO RE-MARK SQ1054.2 +114900 MOVE "VII-3, VII-38, 4.2.4(4)" TO ANSI-REFERENCE SQ1054.2 +115000 PERFORM FAIL. SQ1054.2 +115100 SEQ-TEST-09-01-END. SQ1054.2 +115200* SQ1054.2 +115300 ADD 1 TO REC-CT. SQ1054.2 +115400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +115500 GO TO SEQ-DELETE-09-02. SQ1054.2 +115600 GO TO SEQ-TEST-GF-09-02. SQ1054.2 +115700 SEQ-DELETE-09-02. SQ1054.2 +115800 PERFORM DE-LETE. SQ1054.2 +115900 GO TO SEQ-TEST-09-02-END. SQ1054.2 +116000 SEQ-TEST-GF-09-02. SQ1054.2 +116100 IF DECL-EXEC-SW = "**" SQ1054.2 +116200 PERFORM PASS SQ1054.2 +116300 ELSE SQ1054.2 +116400 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +116500 MOVE "**" TO CORRECT-A SQ1054.2 +116600 MOVE "DECLARATIVE EXECUTED ON CLOSE FILE" TO RE-MARK SQ1054.2 +116700 PERFORM FAIL. SQ1054.2 +116800 SEQ-TEST-09-02-END. SQ1054.2 +116900* SQ1054.2 +117000 TERMINATE-ROUTINE. SQ1054.2 +117100 EXIT. SQ1054.2 +117200 CCVS-EXIT SECTION. SQ1054.2 +117300 CCVS-999999. SQ1054.2 +117400 GO TO CLOSE-FILES. SQ1054.2 +*END-OF,SQ105A +*HEADER,COBOL,SQ106A +000100 IDENTIFICATION DIVISION. SQ1064.2 +000200 PROGRAM-ID. SQ1064.2 +000300 SQ106A. SQ1064.2 +000400**************************************************************** SQ1064.2 +000500* * SQ1064.2 +000600* VALIDATION FOR:- * SQ1064.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1064.2 +000900* REVISED 1986, AUGUST * SQ1064.2 +001000* * SQ1064.2 +001100* CREATION DATE / VALIDATION DATE * SQ1064.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1064.2 +001300* * SQ1064.2 +001400**************************************************************** SQ1064.2 +001500* * SQ1064.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1064.2 +001700* * SQ1064.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE * SQ1064.2 +001900* X-55 SYSTEM PRINTER * SQ1064.2 +002000* X-82 SOURCE-COMPUTER * SQ1064.2 +002100* X-83 OBJECT-COMPUTER. * SQ1064.2 +002200* * SQ1064.2 +002300**************************************************************** SQ1064.2 +002400 SQ1064.2 +002500* THIS PROGRAM BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS * SQ1064.2 +002600* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. * SQ1064.2 +002700* * SQ1064.2 +002800* THE SEQUENCE OF RECORD TYPES IS SLSSLSLLLSS, WHERE S * SQ1064.2 +002900* INDICATES 120 CHARACTERS AND L INDICATES 151 CHARACTERS, * SQ1064.2 +003000* FOR A TOTAL OF 11 RECORDS IN THE FILE. SIX OF THE * SQ1064.2 +003100* RECORDS ARE WRITEN USING WRITE FROM, THE OTHERS USING A * SQ1064.2 +003200* WRITE STATEMENT WITHOUT THE FROM PHRASE. THE FILE IS * SQ1064.2 +003300* THEN CLOSED AND REOPENED FOR INPUT. IT IS READ USING * SQ1064.2 +003400* TWELVE DIFFERENT FORMATS OF THE READ STATEMENT. THE * SQ1064.2 +003500* VARIANTS ARE PRODUCED BY INCLUDING OR OMITTING THE NOT AT * SQ1064.2 +003600* END AND END-READ PHRASES, AND INCLUDING OR EXCLUDING THE * SQ1064.2 +003700* OPTIONAL WORD "AT" IN THE END AND NOT END PHRASES. * SQ1064.2 +003800* FIELDS IN EACH RECORD ARE CHECKED AGAINST THE EXPECTED * SQ1064.2 +003900* VALUES. * SQ1064.2 +004000* * SQ1064.2 +004100* WHERE A SHORT RECORD IS EXPECTED, A CHECK IS MADE THAT * SQ1064.2 +004200* THE RECORD AREA DOES NOT CONTAIN THE VALUES THAT WERE * SQ1064.2 +004300* PRESENT IN THAT PART OF THE RECORD AREA BEYOND THE RECORD * SQ1064.2 +004400* WHEN IT WAS WRITTEN. THIS ASSUMPTION IS NOT FULLY * SQ1064.2 +004500* JUSTIFIED, AS THE CONTENT OF THE RECORD AREA BEYOND THE * SQ1064.2 +004600* END OF THE RECORD WHEN A SHORT RECORD IS READ IS * SQ1064.2 +004700* UNDEFINED, BUT IT IS UNLIKELY THAT THE VALUES TESTED FOR * SQ1064.2 +004800* WOULD OCCUR BY CHANCE. * SQ1064.2 +004900* * SQ1064.2 +005000**************************************************************** SQ1064.2 +005100* SQ1064.2 +005200 ENVIRONMENT DIVISION. SQ1064.2 +005300 CONFIGURATION SECTION. SQ1064.2 +005400 SOURCE-COMPUTER. SQ1064.2 +005500 XXXXX082. SQ1064.2 +005600 OBJECT-COMPUTER. SQ1064.2 +005700 XXXXX083. SQ1064.2 +005800 INPUT-OUTPUT SECTION. SQ1064.2 +005900 FILE-CONTROL. SQ1064.2 +006000P SELECT RAW-DATA ASSIGN TO SQ1064.2 +006100P XXXXX062 SQ1064.2 +006200P ORGANIZATION IS INDEXED SQ1064.2 +006300P ACCESS MODE IS RANDOM SQ1064.2 +006400P RECORD KEY IS RAW-DATA-KEY. SQ1064.2 +006500* SQ1064.2 +006600 SELECT PRINT-FILE ASSIGN TO SQ1064.2 +006700 XXXXX055. SQ1064.2 +006800* SQ1064.2 +006900 SELECT SQ-VS6 ASSIGN SQ1064.2 +007000 XXXXX001 SQ1064.2 +007100 STATUS SQ-STATUS SQ1064.2 +007200 ORGANIZATION IS SEQUENTIAL. SQ1064.2 +007300* SQ1064.2 +007400* SQ1064.2 +007500 DATA DIVISION. SQ1064.2 +007600 FILE SECTION. SQ1064.2 +007700P SQ1064.2 +007800PFD RAW-DATA. SQ1064.2 +007900P SQ1064.2 +008000P01 RAW-DATA-SATZ. SQ1064.2 +008100P 05 RAW-DATA-KEY PIC X(6). SQ1064.2 +008200P 05 C-DATE PIC 9(6). SQ1064.2 +008300P 05 C-TIME PIC 9(8). SQ1064.2 +008400P 05 C-NO-OF-TESTS PIC 99. SQ1064.2 +008500P 05 C-OK PIC 999. SQ1064.2 +008600P 05 C-ALL PIC 999. SQ1064.2 +008700P 05 C-FAIL PIC 999. SQ1064.2 +008800P 05 C-DELETED PIC 999. SQ1064.2 +008900P 05 C-INSPECT PIC 999. SQ1064.2 +009000P 05 C-NOTE PIC X(13). SQ1064.2 +009100P 05 C-INDENT PIC X. SQ1064.2 +009200P 05 C-ABORT PIC X(8). SQ1064.2 +009300* SQ1064.2 +009400 FD PRINT-FILE SQ1064.2 +009500C LABEL RECORDS SQ1064.2 +009600C XXXXX084 SQ1064.2 +009700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1064.2 +009800 . SQ1064.2 +009900 01 PRINT-REC PICTURE X(120). SQ1064.2 +010000 01 DUMMY-RECORD PICTURE X(120). SQ1064.2 +010100* SQ1064.2 +010200* SQ1064.2 +010300 FD SQ-VS6 SQ1064.2 +010400C LABEL RECORDS ARE STANDARD SQ1064.2 +010500C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ1064.2 +010600 RECORD CONTAINS 120 TO 151 CHARACTERS. SQ1064.2 +010700* SQ1064.2 +010800 01 SQ-VS6R1-M-G-120. SQ1064.2 +010900 02 SQ-VS6R1-FIRST PIC X(120). SQ1064.2 +011000* SQ1064.2 +011100 01 SQ-VS6R2-M-G-151. SQ1064.2 +011200 02 SQ-VS6R2-FIRST PIC X(120). SQ1064.2 +011300 02 SQ-VS6R2-SECOND. SQ1064.2 +011400 05 SQ-VS6R2-SECOND-L. SQ1064.2 +011500 07 LONG-OR-SHORT PIC X(5). SQ1064.2 +011600 07 SQ-VS6-RECNO PIC X(5). SQ1064.2 +011700 05 SQ-VS6R2-SECOND-R. SQ1064.2 +011800 07 SQ-VS6-FILLER PIC X(21). SQ1064.2 +011900* SQ1064.2 +012000* SQ1064.2 +012100 WORKING-STORAGE SECTION. SQ1064.2 +012200* SQ1064.2 +012300*************************************************************** SQ1064.2 +012400* * SQ1064.2 +012500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1064.2 +012600* * SQ1064.2 +012700*************************************************************** SQ1064.2 +012800* SQ1064.2 +012900 01 SQ-STATUS. SQ1064.2 +013000 03 SQ-STATUS-1 PIC X. SQ1064.2 +013100 03 SQ-STATUS-2 PIC X. SQ1064.2 +013200* SQ1064.2 +013300 01 BUFFER-COPY. SQ1064.2 +013400 03 BUFFER-COPY-120 PIC X(120). SQ1064.2 +013500 03 BUFFER-COPY-SECOND. SQ1064.2 +013600 05 BUFFER-COPY-SECOND-L. SQ1064.2 +013700 07 BUFFER-COPY-L-OR-S PIC X(5). SQ1064.2 +013800 07 BUFFER-COPY-RECNO PIC 9(5). SQ1064.2 +013900 05 BUFFER-COPY-SECOND-R. SQ1064.2 +014000 07 BUFFER-COPY-END PIC X(21). SQ1064.2 +014100* SQ1064.2 +014200 01 EOF-FLAG PIC X(12). SQ1064.2 +014300 01 NOT-EOF-FLAG PIC X(12). SQ1064.2 +014400 01 END-READ-FLAG PIC X(12). SQ1064.2 +014500* SQ1064.2 +014600 01 DELETE-SW. SQ1064.2 +014700 03 DELETE-SW-1 PIC X. SQ1064.2 +014800 03 DELETE-SW-1-GROUP. SQ1064.2 +014900 05 DELETE-SW-2 PIC X. SQ1064.2 +015000 05 DELETE-SW-2-GROUP. SQ1064.2 +015100 07 DELETE-SW-3 PIC X. SQ1064.2 +015200* SQ1064.2 +015300*************************************************************** SQ1064.2 +015400* * SQ1064.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1064.2 +015600* * SQ1064.2 +015700*************************************************************** SQ1064.2 +015800* SQ1064.2 +015900 01 REC-SKEL-SUB PIC 99. SQ1064.2 +016000* SQ1064.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ1064.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ1064.2 +016300 05 FILLER PICTURE X(48) VALUE SQ1064.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1064.2 +016500 05 FILLER PICTURE X(46) VALUE SQ1064.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1064.2 +016700 05 FILLER PICTURE X(26) VALUE SQ1064.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ1064.2 +016900 05 FILLER PICTURE X(37) VALUE SQ1064.2 +017000 ",RECKEY= ". SQ1064.2 +017100 05 FILLER PICTURE X(38) VALUE SQ1064.2 +017200 ",ALTKEY1= ". SQ1064.2 +017300 05 FILLER PICTURE X(38) VALUE SQ1064.2 +017400 ",ALTKEY2= ". SQ1064.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1064.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1064.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ1064.2 +017800 07 FILLER PIC X(5). SQ1064.2 +017900 07 XFILE-NAME PIC X(6). SQ1064.2 +018000 07 FILLER PIC X(8). SQ1064.2 +018100 07 XRECORD-NAME PIC X(6). SQ1064.2 +018200 07 FILLER PIC X(1). SQ1064.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ1064.2 +018400 07 FILLER PIC X(7). SQ1064.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ1064.2 +018600 07 FILLER PIC X(6). SQ1064.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ1064.2 +018800 07 FILLER PIC X(5). SQ1064.2 +018900 07 ODO-NUMBER PIC 9(4). SQ1064.2 +019000 07 FILLER PIC X(5). SQ1064.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ1064.2 +019200 07 FILLER PIC X(7). SQ1064.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ1064.2 +019400 07 FILLER PIC X(7). SQ1064.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ1064.2 +019600 07 FILLER PIC X(1). SQ1064.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ1064.2 +019800 07 FILLER PIC X(6). SQ1064.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ1064.2 +020000 07 FILLER PIC X(5). SQ1064.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ1064.2 +020200 07 FILLER PIC X(6). SQ1064.2 +020300 07 XLABEL-TYPE PIC X(1). SQ1064.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ1064.2 +020500 07 FILLER PIC X(8). SQ1064.2 +020600 07 XRECORD-KEY PIC X(29). SQ1064.2 +020700 07 FILLER PIC X(9). SQ1064.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ1064.2 +020900 07 FILLER PIC X(9). SQ1064.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ1064.2 +021100 07 FILLER PIC X(7). SQ1064.2 +021200* SQ1064.2 +021300 01 TEST-RESULTS. SQ1064.2 +021400 02 FILLER PIC X VALUE SPACE. SQ1064.2 +021500 02 PAR-NAME. SQ1064.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ1064.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ1064.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1064.2 +021900 02 FILLER PIC X VALUE SPACE. SQ1064.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ1064.2 +022100 02 FILLER PIC X VALUE SPACE. SQ1064.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1064.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ1064.2 +022400 02 RE-MARK PIC X(61). SQ1064.2 +022500 01 TEST-COMPUTED. SQ1064.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ1064.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1064.2 +022800 02 COMPUTED-X. SQ1064.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1064.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1064.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1064.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1064.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1064.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1064.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ1064.2 +023600 04 FILLER PIC X. SQ1064.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ1064.2 +023800 01 TEST-CORRECT. SQ1064.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ1064.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1064.2 +024100 02 CORRECT-X. SQ1064.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1064.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1064.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1064.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1064.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1064.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ1064.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ1064.2 +024900 04 FILLER PIC X. SQ1064.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ1064.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1064.2 +025200* SQ1064.2 +025300 01 CCVS-C-1. SQ1064.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1064.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1064.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1064.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ1064.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1064.2 +026200 01 CCVS-C-2. SQ1064.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ1064.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ1064.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ1064.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ1064.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ1064.2 +026800* SQ1064.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1064.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ1064.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1064.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1064.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1064.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1064.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1064.2 +028000 01 CCVS-H-1. SQ1064.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ1064.2 +028200 02 FILLER PIC X(42) VALUE SQ1064.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ1064.2 +028500 01 CCVS-H-2A. SQ1064.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ1064.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1064.2 +028800 02 FILLER PIC XXXX VALUE SQ1064.2 +028900 "4.2 ". SQ1064.2 +029000 02 FILLER PIC X(28) VALUE SQ1064.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ1064.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ1064.2 +029300* SQ1064.2 +029400 01 CCVS-H-2B. SQ1064.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1064.2 +029600 02 TEST-ID PIC X(9). SQ1064.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ1064.2 +029800 02 FILLER PIC X(12) VALUE SQ1064.2 +029900 " HIGH ". SQ1064.2 +030000 02 FILLER PIC X(22) VALUE SQ1064.2 +030100 " LEVEL VALIDATION FOR ". SQ1064.2 +030200 02 FILLER PIC X(58) VALUE SQ1064.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +030400 01 CCVS-H-3. SQ1064.2 +030500 02 FILLER PIC X(34) VALUE SQ1064.2 +030600 " FOR OFFICIAL USE ONLY ". SQ1064.2 +030700 02 FILLER PIC X(58) VALUE SQ1064.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1064.2 +030900 02 FILLER PIC X(28) VALUE SQ1064.2 +031000 " COPYRIGHT 1985,1986 ". SQ1064.2 +031100 01 CCVS-E-1. SQ1064.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ1064.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1064.2 +031400 02 ID-AGAIN PIC X(9). SQ1064.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ1064.2 +031600 01 CCVS-E-2. SQ1064.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ1064.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ1064.2 +031900 02 CCVS-E-2-2. SQ1064.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1064.2 +032100 03 FILLER PIC X VALUE SPACE. SQ1064.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ1064.2 +032300 "ERRORS ENCOUNTERED". SQ1064.2 +032400 01 CCVS-E-3. SQ1064.2 +032500 02 FILLER PIC X(22) VALUE SQ1064.2 +032600 " FOR OFFICIAL USE ONLY". SQ1064.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ1064.2 +032800 02 FILLER PIC X(58) VALUE SQ1064.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ1064.2 +033100 02 FILLER PIC X(20) VALUE SQ1064.2 +033200 " COPYRIGHT 1985,1986". SQ1064.2 +033300 01 CCVS-E-4. SQ1064.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1064.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ1064.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1064.2 +033700 02 FILLER PIC X(40) VALUE SQ1064.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1064.2 +033900 01 XXINFO. SQ1064.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1064.2 +034100 02 INFO-TEXT. SQ1064.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ1064.2 +034300 04 XXCOMPUTED PIC X(20). SQ1064.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ1064.2 +034500 04 XXCORRECT PIC X(20). SQ1064.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ1064.2 +034700 01 HYPHEN-LINE. SQ1064.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ1064.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1064.2 +035000- "*****************************************". SQ1064.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1064.2 +035200- "******************************". SQ1064.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1064.2 +035400 "SQ106A". SQ1064.2 +035500* SQ1064.2 +035600* SQ1064.2 +035700 PROCEDURE DIVISION. SQ1064.2 +035800 CCVS1 SECTION. SQ1064.2 +035900 OPEN-FILES. SQ1064.2 +036000P OPEN I-O RAW-DATA. SQ1064.2 +036100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1064.2 +036200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1064.2 +036300P MOVE "ABORTED " TO C-ABORT. SQ1064.2 +036400P ADD 1 TO C-NO-OF-TESTS. SQ1064.2 +036500P ACCEPT C-DATE FROM DATE. SQ1064.2 +036600P ACCEPT C-TIME FROM TIME. SQ1064.2 +036700P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1064.2 +036800PEND-E-1. SQ1064.2 +036900P CLOSE RAW-DATA. SQ1064.2 +037000 OPEN OUTPUT PRINT-FILE. SQ1064.2 +037100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1064.2 +037200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1064.2 +037300 MOVE SPACE TO TEST-RESULTS. SQ1064.2 +037400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1064.2 +037500 MOVE ZERO TO REC-SKEL-SUB. SQ1064.2 +037600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1064.2 +037700 GO TO CCVS1-EXIT. SQ1064.2 +037800* SQ1064.2 +037900 CCVS-INIT-FILE. SQ1064.2 +038000 ADD 1 TO REC-SKL-SUB. SQ1064.2 +038100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1064.2 +038200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1064.2 +038300* SQ1064.2 +038400 CLOSE-FILES. SQ1064.2 +038500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1064.2 +038600 CLOSE PRINT-FILE. SQ1064.2 +038700P OPEN I-O RAW-DATA. SQ1064.2 +038800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1064.2 +038900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1064.2 +039000P MOVE "OK. " TO C-ABORT. SQ1064.2 +039100P MOVE PASS-COUNTER TO C-OK. SQ1064.2 +039200P MOVE ERROR-HOLD TO C-ALL. SQ1064.2 +039300P MOVE ERROR-COUNTER TO C-FAIL. SQ1064.2 +039400P MOVE DELETE-CNT TO C-DELETED. SQ1064.2 +039500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1064.2 +039600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1064.2 +039700PEND-E-2. SQ1064.2 +039800P CLOSE RAW-DATA. SQ1064.2 +039900 TERMINATE-CCVS. SQ1064.2 +040000S EXIT PROGRAM. SQ1064.2 +040100 STOP RUN. SQ1064.2 +040200* SQ1064.2 +040300 INSPT. SQ1064.2 +040400 MOVE "INSPT" TO P-OR-F. SQ1064.2 +040500 ADD 1 TO INSPECT-COUNTER. SQ1064.2 +040600 PERFORM PRINT-DETAIL. SQ1064.2 +040700* SQ1064.2 +040800 PASS. SQ1064.2 +040900 MOVE "PASS " TO P-OR-F. SQ1064.2 +041000 ADD 1 TO PASS-COUNTER. SQ1064.2 +041100 PERFORM PRINT-DETAIL. SQ1064.2 +041200* SQ1064.2 +041300 FAIL. SQ1064.2 +041400 MOVE "FAIL*" TO P-OR-F. SQ1064.2 +041500 ADD 1 TO ERROR-COUNTER. SQ1064.2 +041600 PERFORM PRINT-DETAIL. SQ1064.2 +041700* SQ1064.2 +041800 DE-LETE. SQ1064.2 +041900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1064.2 +042000 MOVE "*****" TO P-OR-F. SQ1064.2 +042100 ADD 1 TO DELETE-COUNTER. SQ1064.2 +042200 PERFORM PRINT-DETAIL. SQ1064.2 +042300* SQ1064.2 +042400 PRINT-DETAIL. SQ1064.2 +042500 IF REC-CT NOT EQUAL TO ZERO SQ1064.2 +042600 MOVE "." TO PARDOT-X SQ1064.2 +042700 MOVE REC-CT TO DOTVALUE. SQ1064.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. SQ1064.2 +042900 PERFORM WRITE-LINE. SQ1064.2 +043000 IF P-OR-F EQUAL TO "FAIL*" SQ1064.2 +043100 PERFORM WRITE-LINE SQ1064.2 +043200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1064.2 +043300 ELSE SQ1064.2 +043400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1064.2 +043500 MOVE SPACE TO P-OR-F. SQ1064.2 +043600 MOVE SPACE TO COMPUTED-X. SQ1064.2 +043700 MOVE SPACE TO CORRECT-X. SQ1064.2 +043800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1064.2 +043900 MOVE SPACE TO RE-MARK. SQ1064.2 +044000* SQ1064.2 +044100 HEAD-ROUTINE. SQ1064.2 +044200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1064.2 +044500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1064.2 +044600 COLUMN-NAMES-ROUTINE. SQ1064.2 +044700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +044800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +045000 END-ROUTINE. SQ1064.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1064.2 +045200 PERFORM WRITE-LINE 5 TIMES. SQ1064.2 +045300 END-RTN-EXIT. SQ1064.2 +045400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1064.2 +045500 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +045600* SQ1064.2 +045700 END-ROUTINE-1. SQ1064.2 +045800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1064.2 +045900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1064.2 +046000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1064.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1064.2 +046200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1064.2 +046300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1064.2 +046400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1064.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1064.2 +046600 PERFORM WRITE-LINE. SQ1064.2 +046700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1064.2 +046800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1064.2 +046900 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +047000 ELSE SQ1064.2 +047100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1064.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1064.2 +047300 PERFORM WRITE-LINE. SQ1064.2 +047400 END-ROUTINE-13. SQ1064.2 +047500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1064.2 +047600 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +047700 ELSE SQ1064.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1064.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1064.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1064.2 +048100 PERFORM WRITE-LINE. SQ1064.2 +048200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1064.2 +048300 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +048400 ELSE SQ1064.2 +048500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1064.2 +048600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1064.2 +048700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +048800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +048900* SQ1064.2 +049000 WRITE-LINE. SQ1064.2 +049100 ADD 1 TO RECORD-COUNT. SQ1064.2 +049200Y IF RECORD-COUNT GREATER 50 SQ1064.2 +049300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1064.2 +049400Y MOVE SPACE TO DUMMY-RECORD SQ1064.2 +049500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1064.2 +049600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1064.2 +049700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1064.2 +049800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1064.2 +049900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1064.2 +050000Y MOVE ZERO TO RECORD-COUNT. SQ1064.2 +050100 PERFORM WRT-LN. SQ1064.2 +050200* SQ1064.2 +050300 WRT-LN. SQ1064.2 +050400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1064.2 +050500 MOVE SPACE TO DUMMY-RECORD. SQ1064.2 +050600 BLANK-LINE-PRINT. SQ1064.2 +050700 PERFORM WRT-LN. SQ1064.2 +050800 FAIL-ROUTINE. SQ1064.2 +050900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1064.2 +051000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1064.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1064.2 +051200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1064.2 +051300 MOVE XXINFO TO DUMMY-RECORD. SQ1064.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +051500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1064.2 +051600 GO TO FAIL-ROUTINE-EX. SQ1064.2 +051700 FAIL-ROUTINE-WRITE. SQ1064.2 +051800 MOVE TEST-COMPUTED TO PRINT-REC SQ1064.2 +051900 PERFORM WRITE-LINE SQ1064.2 +052000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1064.2 +052100 MOVE TEST-CORRECT TO PRINT-REC SQ1064.2 +052200 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +052300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1064.2 +052400 FAIL-ROUTINE-EX. SQ1064.2 +052500 EXIT. SQ1064.2 +052600 BAIL-OUT. SQ1064.2 +052700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1064.2 +052800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1064.2 +052900 BAIL-OUT-WRITE. SQ1064.2 +053000 MOVE CORRECT-A TO XXCORRECT. SQ1064.2 +053100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1064.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1064.2 +053300 MOVE XXINFO TO DUMMY-RECORD. SQ1064.2 +053400 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1064.2 +053600 BAIL-OUT-EX. SQ1064.2 +053700 EXIT. SQ1064.2 +053800 CCVS1-EXIT. SQ1064.2 +053900 EXIT. SQ1064.2 +054000* SQ1064.2 +054100**************************************************************** SQ1064.2 +054200* * SQ1064.2 +054300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1064.2 +054400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1064.2 +054500* * SQ1064.2 +054600**************************************************************** SQ1064.2 +054700* SQ1064.2 +054800 SECT-SQ106-0001 SECTION. SQ1064.2 +054900 SEQ-INIT-01. SQ1064.2 +055000 MOVE SPACE TO DELETE-SW. SQ1064.2 +055100* SQ1064.2 +055200 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ1064.2 +055300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1064.2 +055400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1064.2 +055500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1064.2 +055600 MOVE 11 TO RECORDS-IN-FILE (1). SQ1064.2 +055700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1064.2 +055800 MOVE "S" TO XLABEL-TYPE (1). SQ1064.2 +055900 MOVE 0 TO XRECORD-NUMBER (1). SQ1064.2 +056000 MOVE ZERO TO BUFFER-COPY-RECNO. SQ1064.2 +056100 MOVE "MULTIPLE REC LENGTHS" TO BUFFER-COPY-END. SQ1064.2 +056200* SQ1064.2 +056300* THE FIRST ACTION IS TO OPEN THE FILE FOR OUTPUT, AND SO SQ1064.2 +056400* CREATE IT. IF THE OPEN IS DELETED, ALL SUCCEDING TESTS SQ1064.2 +056500* ARE AUTOMATICALLY DELETED WITH IT. A SUBORDINATE TEST SQ1064.2 +056600* CHECKS THE I-O STATUS RETURNED FROM THE OPEN OPERATION. SQ1064.2 +056700* SQ1064.2 +056800 MOVE "**" TO SQ-STATUS. SQ1064.2 +056900 MOVE "OPEN FILE FOR OUTPUT" TO FEATURE. SQ1064.2 +057000 MOVE "SEQ-TEST-GF-01" TO PAR-NAME. SQ1064.2 +057100 GO TO SEQ-TEST-GF-01. SQ1064.2 +057200 SEQ-DELETE-01. SQ1064.2 +057300 MOVE "*" TO DELETE-SW-1. SQ1064.2 +057400 GO TO SEQ-DELETE-01-01. SQ1064.2 +057500 SEQ-TEST-GF-01. SQ1064.2 +057600 OPEN OUTPUT SQ-VS6. SQ1064.2 +057700 GO TO SEQ-TEST-GF-01-01. SQ1064.2 +057800 SEQ-DELETE-01-01. SQ1064.2 +057900 PERFORM DE-LETE. SQ1064.2 +058000 GO TO SEQ-TEST-01-01-END. SQ1064.2 +058100 SEQ-TEST-GF-01-01. SQ1064.2 +058200 IF SQ-STATUS = "00" SQ1064.2 +058300 PERFORM PASS SQ1064.2 +058400 ELSE SQ1064.2 +058500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +058600 MOVE "00" TO CORRECT-A SQ1064.2 +058700 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1064.2 +058800 MOVE "VII-2, VII-39" TO ANSI-REFERENCE SQ1064.2 +058900 PERFORM FAIL SQ1064.2 +059000 MOVE "*" TO DELETE-SW-1. SQ1064.2 +059100 SEQ-TEST-01-01-END. SQ1064.2 +059200* SQ1064.2 +059300* SQ1064.2 +059400* UNLESS AN ERROR OCCURRED DURING EXECUTION OF THE OPEN SQ1064.2 +059500* STATEMENT, THE FILE IS NOW OPEN, AND READY FOR RECORDS TO SQ1064.2 +059600* BE WRITTEN TO IT. IF AN ERROR I-O STATUS VALUE WAS SQ1064.2 +059700* RETURNED, ALL THE REMAINING TESTS ARE DELETED. SQ1064.2 +059800* SQ1064.2 +059900* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +060000* SQ1064.2 +060100 SEQ-INIT-02. SQ1064.2 +060200 MOVE 1 TO REC-CT. SQ1064.2 +060300 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +060400 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1064.2 +060500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +060600 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +060700 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +060800 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +060900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +061000 MOVE "**" TO SQ-STATUS. SQ1064.2 +061100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +061200 GO TO SEQ-DELETE-02. SQ1064.2 +061300 GO TO SEQ-TEST-WR-02. SQ1064.2 +061400 SEQ-DELETE-02. SQ1064.2 +061500 GO TO SEQ-DELETE-02-01. SQ1064.2 +061600 SEQ-TEST-WR-02. SQ1064.2 +061700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +061800 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +061900 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +062000 GO TO SEQ-TEST-WR-02-01. SQ1064.2 +062100 SEQ-DELETE-02-01. SQ1064.2 +062200 PERFORM DE-LETE. SQ1064.2 +062300 GO TO SEQ-TEST-02-01-END. SQ1064.2 +062400 SEQ-TEST-WR-02-01. SQ1064.2 +062500 IF SQ-STATUS = "00" SQ1064.2 +062600 PERFORM PASS SQ1064.2 +062700 ELSE SQ1064.2 +062800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +062900 MOVE "00" TO CORRECT-A SQ1064.2 +063000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +063100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +063200 PERFORM FAIL. SQ1064.2 +063300 SEQ-TEST-02-01-END. SQ1064.2 +063400* SQ1064.2 +063500* CREATE A LONG RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +063600* SQ1064.2 +063700 SEQ-INIT-03. SQ1064.2 +063800 MOVE 1 TO REC-CT. SQ1064.2 +063900 MOVE "WRITE LONG RECORD" TO FEATURE. SQ1064.2 +064000 MOVE "SEQ-TEST-WR-03" TO PAR-NAME. SQ1064.2 +064100 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +064200 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +064300 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +064400 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +064500 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +064600 MOVE "**" TO SQ-STATUS. SQ1064.2 +064700 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +064800 GO TO SEQ-DELETE-03. SQ1064.2 +064900 GO TO SEQ-TEST-WR-03. SQ1064.2 +065000 SEQ-DELETE-03. SQ1064.2 +065100 GO TO SEQ-DELETE-03-01. SQ1064.2 +065200 SEQ-TEST-WR-03. SQ1064.2 +065300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +065400 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +065500 WRITE SQ-VS6R2-M-G-151. SQ1064.2 +065600 GO TO SEQ-TEST-WR-03-01. SQ1064.2 +065700 SEQ-DELETE-03-01. SQ1064.2 +065800 PERFORM DE-LETE. SQ1064.2 +065900 GO TO SEQ-TEST-03-01-END. SQ1064.2 +066000 SEQ-TEST-WR-03-01. SQ1064.2 +066100 IF SQ-STATUS = "00" SQ1064.2 +066200 PERFORM PASS SQ1064.2 +066300 ELSE SQ1064.2 +066400 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +066500 MOVE "00" TO CORRECT-A SQ1064.2 +066600 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +066700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +066800 PERFORM FAIL. SQ1064.2 +066900 SEQ-TEST-03-01-END. SQ1064.2 +067000* SQ1064.2 +067100* SQ1064.2 +067200* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +067300* CHARACTER AREA AS THE SOURCE. SQ1064.2 +067400* SQ1064.2 +067500 SEQ-INIT-04. SQ1064.2 +067600 MOVE 1 TO REC-CT. SQ1064.2 +067700 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +067800 MOVE "SEQ-TEST-WR-04" TO PAR-NAME. SQ1064.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +068000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +068100 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +068200 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +068300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +068400 MOVE "**" TO SQ-STATUS. SQ1064.2 +068500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +068600 GO TO SEQ-DELETE-04. SQ1064.2 +068700 GO TO SEQ-TEST-WR-04. SQ1064.2 +068800 SEQ-DELETE-04. SQ1064.2 +068900 GO TO SEQ-DELETE-04-01. SQ1064.2 +069000 SEQ-TEST-WR-04. SQ1064.2 +069100 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +069200 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +069300 GO TO SEQ-TEST-WR-04-01. SQ1064.2 +069400 SEQ-DELETE-04-01. SQ1064.2 +069500 PERFORM DE-LETE. SQ1064.2 +069600 GO TO SEQ-TEST-04-01-END. SQ1064.2 +069700 SEQ-TEST-WR-04-01. SQ1064.2 +069800 IF SQ-STATUS = "00" SQ1064.2 +069900 PERFORM PASS SQ1064.2 +070000 ELSE SQ1064.2 +070100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +070200 MOVE "00" TO CORRECT-A SQ1064.2 +070300 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +070400 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +070500 PERFORM FAIL. SQ1064.2 +070600 SEQ-TEST-04-01-END. SQ1064.2 +070700* SQ1064.2 +070800* SQ1064.2 +070900* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +071000* CHARACTER SOURCE FIELD. SQ1064.2 +071100* SQ1064.2 +071200 SEQ-INIT-05. SQ1064.2 +071300 MOVE 1 TO REC-CT. SQ1064.2 +071400 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +071500 MOVE "SEQ-TEST-WR-05" TO PAR-NAME. SQ1064.2 +071600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +071700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +071800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +071900 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +072000 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +072100 MOVE "**" TO SQ-STATUS. SQ1064.2 +072200 IF DELETE-SW-1 NOT EQUAL SPACE SQ1064.2 +072300 GO TO SEQ-DELETE-05. SQ1064.2 +072400 GO TO SEQ-TEST-WR-05. SQ1064.2 +072500 SEQ-DELETE-05. SQ1064.2 +072600 GO TO SEQ-DELETE-05-01. SQ1064.2 +072700 SEQ-TEST-WR-05. SQ1064.2 +072800 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +072900 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +073000 GO TO SEQ-TEST-WR-05-01. SQ1064.2 +073100 SEQ-DELETE-05-01. SQ1064.2 +073200 PERFORM DE-LETE. SQ1064.2 +073300 GO TO SEQ-TEST-05-01-END. SQ1064.2 +073400 SEQ-TEST-WR-05-01. SQ1064.2 +073500 IF SQ-STATUS = "00" SQ1064.2 +073600 PERFORM PASS SQ1064.2 +073700 ELSE SQ1064.2 +073800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +073900 MOVE "00" TO CORRECT-A SQ1064.2 +074000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +074100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +074200 PERFORM FAIL. SQ1064.2 +074300 SEQ-TEST-05-01-END. SQ1064.2 +074400* SQ1064.2 +074500* SQ1064.2 +074600* CREATE A LONG RECORD USING WRITE FROM. SQ1064.2 +074700* SQ1064.2 +074800 SEQ-INIT-06. SQ1064.2 +074900 MOVE 1 TO REC-CT. SQ1064.2 +075000 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +075100 MOVE "SEQ-TEST-WR-06" TO PAR-NAME. SQ1064.2 +075200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +075300 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +075400 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +075500 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +075600 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +075700 MOVE "**" TO SQ-STATUS. SQ1064.2 +075800 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +075900 GO TO SEQ-DELETE-06. SQ1064.2 +076000 GO TO SEQ-TEST-WR-06. SQ1064.2 +076100 SEQ-DELETE-06. SQ1064.2 +076200 GO TO SEQ-DELETE-06-01. SQ1064.2 +076300 SEQ-TEST-WR-06. SQ1064.2 +076400 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +076500 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +076600 GO TO SEQ-TEST-WR-06-01. SQ1064.2 +076700 SEQ-DELETE-06-01. SQ1064.2 +076800 PERFORM DE-LETE. SQ1064.2 +076900 GO TO SEQ-TEST-06-01-END. SQ1064.2 +077000 SEQ-TEST-WR-06-01. SQ1064.2 +077100 IF SQ-STATUS = "00" SQ1064.2 +077200 PERFORM PASS SQ1064.2 +077300 ELSE SQ1064.2 +077400 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +077500 MOVE "00" TO CORRECT-A SQ1064.2 +077600 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +077700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +077800 PERFORM FAIL. SQ1064.2 +077900 SEQ-TEST-06-01-END. SQ1064.2 +078000* SQ1064.2 +078100* SQ1064.2 +078200* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +078300* CHARACTER AREA AS THE SOURCE. SQ1064.2 +078400* SQ1064.2 +078500 SEQ-INIT-07. SQ1064.2 +078600 MOVE 1 TO REC-CT. SQ1064.2 +078700 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +078800 MOVE "SEQ-TEST-WR-07" TO PAR-NAME. SQ1064.2 +078900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +079000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +079100 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +079200 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +079300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +079400 MOVE "**" TO SQ-STATUS. SQ1064.2 +079500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +079600 GO TO SEQ-DELETE-07. SQ1064.2 +079700 GO TO SEQ-TEST-WR-07. SQ1064.2 +079800 SEQ-DELETE-07. SQ1064.2 +079900 GO TO SEQ-DELETE-07-01. SQ1064.2 +080000 SEQ-TEST-WR-07. SQ1064.2 +080100 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +080200 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +080300 GO TO SEQ-TEST-WR-07-01. SQ1064.2 +080400 SEQ-DELETE-07-01. SQ1064.2 +080500 PERFORM DE-LETE. SQ1064.2 +080600 GO TO SEQ-TEST-07-01-END. SQ1064.2 +080700 SEQ-TEST-WR-07-01. SQ1064.2 +080800 IF SQ-STATUS = "00" SQ1064.2 +080900 PERFORM PASS SQ1064.2 +081000 ELSE SQ1064.2 +081100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +081200 MOVE "00" TO CORRECT-A SQ1064.2 +081300 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +081400 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +081500 PERFORM FAIL. SQ1064.2 +081600 SEQ-TEST-07-01-END. SQ1064.2 +081700* SQ1064.2 +081800* SQ1064.2 +081900* CREATE A LONG RECORD USING WRITE FROM, USING A 151 SQ1064.2 +082000* CHARACTER SOURCE AREA. SQ1064.2 +082100* SQ1064.2 +082200 SEQ-INIT-08. SQ1064.2 +082300 MOVE 1 TO REC-CT. SQ1064.2 +082400 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +082500 MOVE "SEQ-TEST-WR-08" TO PAR-NAME. SQ1064.2 +082600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +082700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +082800 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +082900 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +083000 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +083100 MOVE "**" TO SQ-STATUS. SQ1064.2 +083200 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +083300 GO TO SEQ-DELETE-08. SQ1064.2 +083400 GO TO SEQ-TEST-WR-08. SQ1064.2 +083500 SEQ-DELETE-08. SQ1064.2 +083600 GO TO SEQ-DELETE-08-01. SQ1064.2 +083700 SEQ-TEST-WR-08. SQ1064.2 +083800 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +083900 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +084000 GO TO SEQ-TEST-WR-08-01. SQ1064.2 +084100 SEQ-DELETE-08-01. SQ1064.2 +084200 PERFORM DE-LETE. SQ1064.2 +084300 GO TO SEQ-TEST-08-01-END. SQ1064.2 +084400 SEQ-TEST-WR-08-01. SQ1064.2 +084500 IF SQ-STATUS = "00" SQ1064.2 +084600 PERFORM PASS SQ1064.2 +084700 ELSE SQ1064.2 +084800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +084900 MOVE "00" TO CORRECT-A SQ1064.2 +085000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +085100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +085200 PERFORM FAIL. SQ1064.2 +085300 SEQ-TEST-08-01-END. SQ1064.2 +085400* SQ1064.2 +085500* SQ1064.2 +085600* CREATE A LONG RECORD USING WRITE FROM, USING A 151 SQ1064.2 +085700* CHARACTER SOURCE AREA. SQ1064.2 +085800* SQ1064.2 +085900 SEQ-INIT-09. SQ1064.2 +086000 MOVE 1 TO REC-CT. SQ1064.2 +086100 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +086200 MOVE "SEQ-TEST-WR-09" TO PAR-NAME. SQ1064.2 +086300 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +086400 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +086500 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +086600 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +086700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +086800 MOVE "**" TO SQ-STATUS. SQ1064.2 +086900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +087000 GO TO SEQ-DELETE-09. SQ1064.2 +087100 GO TO SEQ-TEST-WR-09. SQ1064.2 +087200 SEQ-DELETE-09. SQ1064.2 +087300 GO TO SEQ-DELETE-09-01. SQ1064.2 +087400 SEQ-TEST-WR-09. SQ1064.2 +087500 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +087600 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +087700 GO TO SEQ-TEST-WR-09-01. SQ1064.2 +087800 SEQ-DELETE-09-01. SQ1064.2 +087900 PERFORM DE-LETE. SQ1064.2 +088000 GO TO SEQ-TEST-09-01-END. SQ1064.2 +088100 SEQ-TEST-WR-09-01. SQ1064.2 +088200 IF SQ-STATUS = "00" SQ1064.2 +088300 PERFORM PASS SQ1064.2 +088400 ELSE SQ1064.2 +088500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +088600 MOVE "00" TO CORRECT-A SQ1064.2 +088700 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +088800 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +088900 PERFORM FAIL. SQ1064.2 +089000 SEQ-TEST-09-01-END. SQ1064.2 +089100* SQ1064.2 +089200* SQ1064.2 +089300* CREATE A LONG RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +089400* SQ1064.2 +089500 SEQ-INIT-10. SQ1064.2 +089600 MOVE 1 TO REC-CT. SQ1064.2 +089700 MOVE "WRITE LONG RECORD" TO FEATURE. SQ1064.2 +089800 MOVE "SEQ-TEST-WR-10" TO PAR-NAME. SQ1064.2 +089900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +090000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +090100 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +090200 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +090300 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +090400 MOVE "**" TO SQ-STATUS. SQ1064.2 +090500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +090600 GO TO SEQ-DELETE-10. SQ1064.2 +090700 GO TO SEQ-TEST-WR-10. SQ1064.2 +090800 SEQ-DELETE-10. SQ1064.2 +090900 GO TO SEQ-DELETE-10-01. SQ1064.2 +091000 SEQ-TEST-WR-10. SQ1064.2 +091100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +091200 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +091300 WRITE SQ-VS6R2-M-G-151. SQ1064.2 +091400 GO TO SEQ-TEST-WR-10-01. SQ1064.2 +091500 SEQ-DELETE-10-01. SQ1064.2 +091600 PERFORM DE-LETE. SQ1064.2 +091700 GO TO SEQ-TEST-10-01-END. SQ1064.2 +091800 SEQ-TEST-WR-10-01. SQ1064.2 +091900 IF SQ-STATUS = "00" SQ1064.2 +092000 PERFORM PASS SQ1064.2 +092100 ELSE SQ1064.2 +092200 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +092300 MOVE "00" TO CORRECT-A SQ1064.2 +092400 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +092500 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +092600 PERFORM FAIL. SQ1064.2 +092700 SEQ-TEST-10-01-END. SQ1064.2 +092800* SQ1064.2 +092900* SQ1064.2 +093000* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +093100* SQ1064.2 +093200 SEQ-INIT-11. SQ1064.2 +093300 MOVE 1 TO REC-CT. SQ1064.2 +093400 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +093500 MOVE "SEQ-TEST-WR-11" TO PAR-NAME. SQ1064.2 +093600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +093700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +093800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +093900 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +094000 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +094100 MOVE "**" TO SQ-STATUS. SQ1064.2 +094200 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +094300 GO TO SEQ-DELETE-11. SQ1064.2 +094400 GO TO SEQ-TEST-WR-11. SQ1064.2 +094500 SEQ-DELETE-11. SQ1064.2 +094600 GO TO SEQ-DELETE-11-01. SQ1064.2 +094700 SEQ-TEST-WR-11. SQ1064.2 +094800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +094900 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +095000 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +095100 GO TO SEQ-TEST-WR-11-01. SQ1064.2 +095200 SEQ-DELETE-11-01. SQ1064.2 +095300 PERFORM DE-LETE. SQ1064.2 +095400 GO TO SEQ-TEST-11-01-END. SQ1064.2 +095500 SEQ-TEST-WR-11-01. SQ1064.2 +095600 IF SQ-STATUS = "00" SQ1064.2 +095700 PERFORM PASS SQ1064.2 +095800 ELSE SQ1064.2 +095900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +096000 MOVE "00" TO CORRECT-A SQ1064.2 +096100 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +096200 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +096300 PERFORM FAIL. SQ1064.2 +096400 SEQ-TEST-11-01-END. SQ1064.2 +096500* SQ1064.2 +096600* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +096700* SQ1064.2 +096800 SEQ-INIT-12. SQ1064.2 +096900 MOVE 1 TO REC-CT. SQ1064.2 +097000 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +097100 MOVE "SEQ-TEST-WR-12" TO PAR-NAME. SQ1064.2 +097200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +097300 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +097400 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +097500 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +097600 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +097700 MOVE "**" TO SQ-STATUS. SQ1064.2 +097800 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +097900 GO TO SEQ-DELETE-12. SQ1064.2 +098000 GO TO SEQ-TEST-WR-12. SQ1064.2 +098100 SEQ-DELETE-12. SQ1064.2 +098200 GO TO SEQ-DELETE-12-01. SQ1064.2 +098300 SEQ-TEST-WR-12. SQ1064.2 +098400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +098500 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +098600 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +098700 GO TO SEQ-TEST-WR-12-01. SQ1064.2 +098800 SEQ-DELETE-12-01. SQ1064.2 +098900 PERFORM DE-LETE. SQ1064.2 +099000 GO TO SEQ-TEST-12-01-END. SQ1064.2 +099100 SEQ-TEST-WR-12-01. SQ1064.2 +099200 IF SQ-STATUS = "00" SQ1064.2 +099300 PERFORM PASS SQ1064.2 +099400 ELSE SQ1064.2 +099500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +099600 MOVE "00" TO CORRECT-A SQ1064.2 +099700 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +099800 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +099900 PERFORM FAIL. SQ1064.2 +100000 SEQ-TEST-12-01-END. SQ1064.2 +100100* SQ1064.2 +100200* SQ1064.2 +100300* ALL REQUIRED RECORDS HAVE BEEN WRITTEN, SO THE FILE SQ1064.2 +100400* CAN BE CLOSED. SQ1064.2 +100500* SQ1064.2 +100600 SEQ-INIT-13. SQ1064.2 +100700 MOVE 1 TO REC-CT. SQ1064.2 +100800 MOVE "CLOSE NEW FILE" TO FEATURE. SQ1064.2 +100900 MOVE "SEQ-TEST-WR-13" TO PAR-NAME. SQ1064.2 +101000 MOVE "**" TO SQ-STATUS. SQ1064.2 +101100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +101200 GO TO SEQ-DELETE-13. SQ1064.2 +101300 GO TO SEQ-TEST-WR-13. SQ1064.2 +101400 SEQ-DELETE-13. SQ1064.2 +101500 GO TO SEQ-DELETE-13-01. SQ1064.2 +101600 SEQ-TEST-WR-13. SQ1064.2 +101700 CLOSE SQ-VS6. SQ1064.2 +101800 GO TO SEQ-TEST-WR-13-01. SQ1064.2 +101900 SEQ-DELETE-13-01. SQ1064.2 +102000 PERFORM DE-LETE. SQ1064.2 +102100 GO TO SEQ-TEST-13-01-END. SQ1064.2 +102200 SEQ-TEST-WR-13-01. SQ1064.2 +102300 IF SQ-STATUS = "00" SQ1064.2 +102400 PERFORM PASS SQ1064.2 +102500 ELSE SQ1064.2 +102600 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +102700 MOVE "00" TO CORRECT-A SQ1064.2 +102800 MOVE "UNEXPECTED I-O STATUS FROM CLOSE" TO RE-MARK SQ1064.2 +102900 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1064.2 +103000 PERFORM FAIL. SQ1064.2 +103100 SEQ-TEST-13-01-END. SQ1064.2 +103200* SQ1064.2 +103300* SQ1064.2 +103400* A SEQUENTIAL TAPE FILE CONTAINING 11 RECORDS HAS BEEN SQ1064.2 +103500* CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS AND SQ1064.2 +103600* RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ1064.2 +103700* RECORDS WERE WRITTEN IS SLSSLSLLLSS. THE NEXT GROUP OF SQ1064.2 +103800* OPENS THE FILE FOR INPUT AND READS IT, USING TWELVE SQ1064.2 +103900* DIFFERENT FORMATS OF THE READ STATEMENT. DELETION OF THIS SQ1064.2 +104000* TEST CAUSES DELETION OF ALL SUBSEQUENT TESTS. SQ1064.2 +104100* SQ1064.2 +104200* SQ1064.2 +104300 SEQ-INIT-14. SQ1064.2 +104400 MOVE "**" TO SQ-STATUS. SQ1064.2 +104500 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1064.2 +104600 MOVE "SEQ-TEST-GF-14" TO PAR-NAME. SQ1064.2 +104700 IF DELETE-SW NOT = SPACE SQ1064.2 +104800 GO TO SEQ-DELETE-14. SQ1064.2 +104900 GO TO SEQ-TEST-GF-14. SQ1064.2 +105000 SEQ-DELETE-14. SQ1064.2 +105100 MOVE "*" TO DELETE-SW-1. SQ1064.2 +105200 GO TO SEQ-DELETE-14-01. SQ1064.2 +105300 SEQ-TEST-GF-14. SQ1064.2 +105400 OPEN INPUT SQ-VS6. SQ1064.2 +105500 GO TO SEQ-TEST-GF-14-01. SQ1064.2 +105600 SEQ-DELETE-14-01. SQ1064.2 +105700 PERFORM DE-LETE. SQ1064.2 +105800 GO TO SEQ-TEST-14-01-END. SQ1064.2 +105900 SEQ-TEST-GF-14-01. SQ1064.2 +106000 IF SQ-STATUS = "00" SQ1064.2 +106100 PERFORM PASS SQ1064.2 +106200 ELSE SQ1064.2 +106300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +106400 MOVE "00" TO CORRECT-A SQ1064.2 +106500 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1064.2 +106600 MOVE "VII-2, VII-39" TO ANSI-REFERENCE SQ1064.2 +106700 PERFORM FAIL SQ1064.2 +106800 MOVE "*" TO DELETE-SW-1. SQ1064.2 +106900 SEQ-TEST-14-01-END. SQ1064.2 +107000* SQ1064.2 +107100* SQ1064.2 +107200* UNLESS AN ERROR OCCURRED DURING EXECUTION OF THE OPEN SQ1064.2 +107300* STATEMENT, THE FILE IS NOW OPEN, AND READY FOR RECORDS TO SQ1064.2 +107400* BE WRITTEN TO IT. IF AN ERROR I-O STATUS VALUE WAS SQ1064.2 +107500* RETURNED, ALL THE REMAINING TESTS ARE DELETED. SQ1064.2 +107600* SQ1064.2 +107700* READ A SHORT RECORD, USING READ ... AT END SQ1064.2 +107800* SQ1064.2 +107900 SEQ-INIT-15. SQ1064.2 +108000 MOVE 1 TO REC-CT. SQ1064.2 +108100 MOVE 1 TO XRECORD-NUMBER (1). SQ1064.2 +108200 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +108300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +108400 MOVE 1 TO BUFFER-COPY-RECNO. SQ1064.2 +108500 MOVE "**" TO SQ-STATUS. SQ1064.2 +108600 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +108700 MOVE "READ SHORT AT END" TO FEATURE. SQ1064.2 +108800 MOVE "SEQ-TEST-RD-15" TO PAR-NAME. SQ1064.2 +108900 IF DELETE-SW NOT = SPACE SQ1064.2 +109000 GO TO SEQ-DELETE-15. SQ1064.2 +109100 GO TO SEQ-TEST-RD-15. SQ1064.2 +109200 SEQ-DELETE-15. SQ1064.2 +109300 MOVE "*" TO DELETE-SW-3. SQ1064.2 +109400 GO TO SEQ-DELETE-15-01. SQ1064.2 +109500* SQ1064.2 +109600* EXECUTE THE READ STATEMENT SQ1064.2 +109700* SQ1064.2 +109800 SEQ-TEST-RD-15. SQ1064.2 +109900 READ SQ-VS6 AT END SQ1064.2 +110000 MOVE "EXECUTED" TO EOF-FLAG. SQ1064.2 +110100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +110200 GO TO SEQ-TEST-RD-15-01. SQ1064.2 +110300* SQ1064.2 +110400* CHECK THE FILE STATUS VALUE SQ1064.2 +110500* SQ1064.2 +110600 SEQ-DELETE-15-01. SQ1064.2 +110700 PERFORM DE-LETE. SQ1064.2 +110800 GO TO SEQ-TEST-15-01-END. SQ1064.2 +110900 SEQ-TEST-RD-15-01. SQ1064.2 +111000 IF SQ-STATUS = "00" SQ1064.2 +111100 PERFORM PASS SQ1064.2 +111200 ELSE SQ1064.2 +111300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +111400 MOVE "00" TO CORRECT-A SQ1064.2 +111500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +111600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +111700 PERFORM FAIL. SQ1064.2 +111800 SEQ-TEST-15-01-END. SQ1064.2 +111900* SQ1064.2 +112000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +112100* SQ1064.2 +112200 ADD 1 TO REC-CT. SQ1064.2 +112300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +112400 GO TO SEQ-DELETE-15-02. SQ1064.2 +112500 GO TO SEQ-TEST-RD-15-02. SQ1064.2 +112600 SEQ-DELETE-15-02. SQ1064.2 +112700 PERFORM DE-LETE. SQ1064.2 +112800 GO TO SEQ-TEST-15-02-END. SQ1064.2 +112900 SEQ-TEST-RD-15-02. SQ1064.2 +113000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +113100 PERFORM PASS SQ1064.2 +113200 ELSE SQ1064.2 +113300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +113400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +113500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +113600 PERFORM FAIL. SQ1064.2 +113700 SEQ-TEST-15-02-END. SQ1064.2 +113800* SQ1064.2 +113900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +114000* SQ1064.2 +114100 ADD 1 TO REC-CT. SQ1064.2 +114200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +114300* GO TO SEQ-DELETE-15-03. SQ1064.2 +114400* GO TO SEQ-TEST-RD-15-03. SQ1064.2 +114500 SEQ-DELETE-15-03. SQ1064.2 +114600 PERFORM DE-LETE. SQ1064.2 +114700 GO TO SEQ-TEST-15-03-END. SQ1064.2 +114800 SEQ-TEST-RD-15-03. SQ1064.2 +114900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +115000 PERFORM PASS SQ1064.2 +115100 ELSE SQ1064.2 +115200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +115300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +115400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +115500 PERFORM FAIL. SQ1064.2 +115600 SEQ-TEST-15-03-END. SQ1064.2 +115700* SQ1064.2 +115800* CHECK EXECUTION OF THE END PATH SQ1064.2 +115900* SQ1064.2 +116000 ADD 1 TO REC-CT. SQ1064.2 +116100 IF DELETE-SW NOT = SPACE SQ1064.2 +116200 GO TO SEQ-DELETE-15-04. SQ1064.2 +116300 GO TO SEQ-TEST-RD-15-04. SQ1064.2 +116400 SEQ-DELETE-15-04. SQ1064.2 +116500 PERFORM DE-LETE. SQ1064.2 +116600 GO TO SEQ-TEST-15-04-END. SQ1064.2 +116700 SEQ-TEST-RD-15-04. SQ1064.2 +116800 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +116900 PERFORM PASS SQ1064.2 +117000 ELSE SQ1064.2 +117100 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +117200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +117300 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +117400 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +117500 MOVE "*" TO DELETE-SW-2 SQ1064.2 +117600 PERFORM FAIL. SQ1064.2 +117700 SEQ-TEST-15-04-END. SQ1064.2 +117800 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +117900* SQ1064.2 +118000* SQ1064.2 +118100* READ A LONG RECORD, USING READ ... END SQ1064.2 +118200* SQ1064.2 +118300 SEQ-INIT-16. SQ1064.2 +118400 MOVE 1 TO REC-CT. SQ1064.2 +118500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +118600 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +118700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +118800 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +118900 MOVE "**" TO SQ-STATUS. SQ1064.2 +119000 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +119100 MOVE "READ LONG END" TO FEATURE. SQ1064.2 +119200 MOVE "SEQ-TEST-RD-16" TO PAR-NAME. SQ1064.2 +119300 IF DELETE-SW NOT = SPACE SQ1064.2 +119400 GO TO SEQ-DELETE-16. SQ1064.2 +119500 GO TO SEQ-TEST-RD-16. SQ1064.2 +119600 SEQ-DELETE-16. SQ1064.2 +119700 MOVE "*" TO DELETE-SW-3. SQ1064.2 +119800 GO TO SEQ-DELETE-16-01. SQ1064.2 +119900* SQ1064.2 +120000* EXECUTE THE READ STATEMENT SQ1064.2 +120100* SQ1064.2 +120200 SEQ-TEST-RD-16. SQ1064.2 +120300 READ SQ-VS6 END SQ1064.2 +120400 MOVE "EXECUTED" TO EOF-FLAG. SQ1064.2 +120500 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +120600 GO TO SEQ-TEST-RD-16-01. SQ1064.2 +120700 SEQ-DELETE-16-01. SQ1064.2 +120800 PERFORM DE-LETE. SQ1064.2 +120900 GO TO SEQ-TEST-16-01-END. SQ1064.2 +121000* SQ1064.2 +121100* CHECK THE FILE STATUS RETURNED SQ1064.2 +121200* SQ1064.2 +121300 SEQ-TEST-RD-16-01. SQ1064.2 +121400 IF SQ-STATUS = "00" SQ1064.2 +121500 PERFORM PASS SQ1064.2 +121600 ELSE SQ1064.2 +121700 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +121800 MOVE "00" TO CORRECT-A SQ1064.2 +121900 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +122000 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +122100 PERFORM FAIL. SQ1064.2 +122200 SEQ-TEST-16-01-END. SQ1064.2 +122300* SQ1064.2 +122400* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +122500* SQ1064.2 +122600 ADD 1 TO REC-CT. SQ1064.2 +122700 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +122800 GO TO SEQ-DELETE-16-02. SQ1064.2 +122900 GO TO SEQ-TEST-RD-16-02. SQ1064.2 +123000 SEQ-DELETE-16-02. SQ1064.2 +123100 PERFORM DE-LETE. SQ1064.2 +123200 GO TO SEQ-TEST-16-02-END. SQ1064.2 +123300 SEQ-TEST-RD-16-02. SQ1064.2 +123400 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +123500 PERFORM PASS SQ1064.2 +123600 ELSE SQ1064.2 +123700 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +123800 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +123900 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +124000 PERFORM FAIL. SQ1064.2 +124100 SEQ-TEST-16-02-END. SQ1064.2 +124200* SQ1064.2 +124300* CHECK THE RECORD EXTENSION AREA SQ1064.2 +124400* SQ1064.2 +124500 ADD 1 TO REC-CT. SQ1064.2 +124600 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +124700 GO TO SEQ-DELETE-16-03. SQ1064.2 +124800 GO TO SEQ-TEST-RD-16-03. SQ1064.2 +124900 SEQ-DELETE-16-03. SQ1064.2 +125000 PERFORM DE-LETE. SQ1064.2 +125100 GO TO SEQ-TEST-16-03-END. SQ1064.2 +125200 SEQ-TEST-RD-16-03. SQ1064.2 +125300 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +125400 PERFORM PASS SQ1064.2 +125500 ELSE SQ1064.2 +125600 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +125700 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +125800 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +125900 PERFORM FAIL. SQ1064.2 +126000 SEQ-TEST-16-03-END. SQ1064.2 +126100* SQ1064.2 +126200* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +126300* SQ1064.2 +126400 ADD 1 TO REC-CT. SQ1064.2 +126500 IF DELETE-SW NOT = SPACE SQ1064.2 +126600 GO TO SEQ-DELETE-16-04. SQ1064.2 +126700 GO TO SEQ-TEST-RD-16-04. SQ1064.2 +126800 SEQ-DELETE-16-04. SQ1064.2 +126900 PERFORM DE-LETE. SQ1064.2 +127000 GO TO SEQ-TEST-16-04-END. SQ1064.2 +127100 SEQ-TEST-RD-16-04. SQ1064.2 +127200 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +127300 PERFORM PASS SQ1064.2 +127400 ELSE SQ1064.2 +127500 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +127600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +127700 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +127800 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +127900 MOVE "*" TO DELETE-SW-2 SQ1064.2 +128000 PERFORM FAIL. SQ1064.2 +128100 SEQ-TEST-16-04-END. SQ1064.2 +128200 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +128300* SQ1064.2 +128400* SQ1064.2 +128500* READ A SHORT RECORD, USING READ ... AT END ... NOT AT END SQ1064.2 +128600* SQ1064.2 +128700 SEQ-INIT-17. SQ1064.2 +128800 MOVE 1 TO REC-CT. SQ1064.2 +128900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +129000 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +129100 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +129200 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +129300 MOVE "**" TO SQ-STATUS. SQ1064.2 +129400 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +129500 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +129600 MOVE "READ SHORT AT END N A E" TO FEATURE. SQ1064.2 +129700 MOVE "SEQ-TEST-RD-17" TO PAR-NAME. SQ1064.2 +129800 IF DELETE-SW NOT = SPACE SQ1064.2 +129900 GO TO SEQ-DELETE-17. SQ1064.2 +130000 GO TO SEQ-TEST-RD-17. SQ1064.2 +130100 SEQ-DELETE-17. SQ1064.2 +130200 MOVE "*" TO DELETE-SW-3. SQ1064.2 +130300 GO TO SEQ-DELETE-17-01. SQ1064.2 +130400* SQ1064.2 +130500* EXECUTE THE READ STATEMENT SQ1064.2 +130600* SQ1064.2 +130700 SEQ-TEST-RD-17. SQ1064.2 +130800 READ SQ-VS6 SQ1064.2 +130900 AT END SQ1064.2 +131000 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +131100 NOT AT END SQ1064.2 +131200 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +131300 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +131400 GO TO SEQ-TEST-RD-17-01. SQ1064.2 +131500* SQ1064.2 +131600* CHECK THE FILE STATUS VALUE SQ1064.2 +131700* SQ1064.2 +131800 SEQ-DELETE-17-01. SQ1064.2 +131900 PERFORM DE-LETE. SQ1064.2 +132000 GO TO SEQ-TEST-17-01-END. SQ1064.2 +132100 SEQ-TEST-RD-17-01. SQ1064.2 +132200 IF SQ-STATUS = "00" SQ1064.2 +132300 PERFORM PASS SQ1064.2 +132400 ELSE SQ1064.2 +132500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +132600 MOVE "00" TO CORRECT-A SQ1064.2 +132700 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +132800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +132900 PERFORM FAIL. SQ1064.2 +133000 SEQ-TEST-17-01-END. SQ1064.2 +133100* SQ1064.2 +133200* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +133300* SQ1064.2 +133400 ADD 1 TO REC-CT. SQ1064.2 +133500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +133600 GO TO SEQ-DELETE-17-02. SQ1064.2 +133700 GO TO SEQ-TEST-RD-17-02. SQ1064.2 +133800 SEQ-DELETE-17-02. SQ1064.2 +133900 PERFORM DE-LETE. SQ1064.2 +134000 GO TO SEQ-TEST-17-02-END. SQ1064.2 +134100 SEQ-TEST-RD-17-02. SQ1064.2 +134200 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +134300 PERFORM PASS SQ1064.2 +134400 ELSE SQ1064.2 +134500 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +134600 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +134700 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +134800 PERFORM FAIL. SQ1064.2 +134900 SEQ-TEST-17-02-END. SQ1064.2 +135000* SQ1064.2 +135100* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +135200* SQ1064.2 +135300 ADD 1 TO REC-CT. SQ1064.2 +135400* IF DELETE-SW NOT = TO SPACE SQ1064.2 +135500* GO TO SEQ-DELETE-17-03. SQ1064.2 +135600* GO TO SEQ-TEST-RD-17-03. SQ1064.2 +135700 SEQ-DELETE-17-03. SQ1064.2 +135800 PERFORM DE-LETE. SQ1064.2 +135900 GO TO SEQ-TEST-17-03-END. SQ1064.2 +136000 SEQ-TEST-RD-17-03. SQ1064.2 +136100 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +136200 PERFORM PASS SQ1064.2 +136300 ELSE SQ1064.2 +136400 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +136500 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +136600 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +136700 PERFORM FAIL. SQ1064.2 +136800 SEQ-TEST-17-03-END. SQ1064.2 +136900* SQ1064.2 +137000* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +137100* SQ1064.2 +137200 ADD 1 TO REC-CT. SQ1064.2 +137300 IF DELETE-SW NOT = SPACE SQ1064.2 +137400 GO TO SEQ-DELETE-17-04. SQ1064.2 +137500 GO TO SEQ-TEST-RD-17-04. SQ1064.2 +137600 SEQ-DELETE-17-04. SQ1064.2 +137700 PERFORM DE-LETE. SQ1064.2 +137800 GO TO SEQ-TEST-17-04-END. SQ1064.2 +137900 SEQ-TEST-RD-17-04. SQ1064.2 +138000 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +138100 PERFORM PASS SQ1064.2 +138200 ELSE SQ1064.2 +138300 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +138400 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +138500 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +138600 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +138700 PERFORM FAIL. SQ1064.2 +138800 SEQ-TEST-17-04-END. SQ1064.2 +138900* SQ1064.2 +139000* CHECK EXECUTION OF THE END PATH SQ1064.2 +139100* SQ1064.2 +139200 ADD 1 TO REC-CT. SQ1064.2 +139300 IF DELETE-SW NOT = SPACE SQ1064.2 +139400 GO TO SEQ-DELETE-17-05. SQ1064.2 +139500 GO TO SEQ-TEST-RD-17-05. SQ1064.2 +139600 SEQ-DELETE-17-05. SQ1064.2 +139700 PERFORM DE-LETE. SQ1064.2 +139800 GO TO SEQ-TEST-17-05-END. SQ1064.2 +139900 SEQ-TEST-RD-17-05. SQ1064.2 +140000 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +140100 PERFORM PASS SQ1064.2 +140200 ELSE SQ1064.2 +140300 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +140400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +140500 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +140600 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +140700 MOVE "*" TO DELETE-SW-2 SQ1064.2 +140800 PERFORM FAIL. SQ1064.2 +140900 SEQ-TEST-17-05-END. SQ1064.2 +141000 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +141100* SQ1064.2 +141200* SQ1064.2 +141300* READ A SHORT RECORD, USING READ ... END ... NOT AT END SQ1064.2 +141400* SQ1064.2 +141500 SEQ-INIT-18. SQ1064.2 +141600 MOVE 1 TO REC-CT. SQ1064.2 +141700 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +141800 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +141900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +142000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +142100 MOVE "**" TO SQ-STATUS. SQ1064.2 +142200 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +142300 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +142400 MOVE "READ SHORT END N A E" TO FEATURE. SQ1064.2 +142500 MOVE "SEQ-TEST-RD-18" TO PAR-NAME. SQ1064.2 +142600 IF DELETE-SW NOT = SPACE SQ1064.2 +142700 GO TO SEQ-DELETE-18. SQ1064.2 +142800 GO TO SEQ-TEST-RD-18. SQ1064.2 +142900 SEQ-DELETE-18. SQ1064.2 +143000 MOVE "*" TO DELETE-SW-3. SQ1064.2 +143100 GO TO SEQ-DELETE-18-01. SQ1064.2 +143200* SQ1064.2 +143300* EXECUTE THE READ STATEMENT SQ1064.2 +143400* SQ1064.2 +143500 SEQ-TEST-RD-18. SQ1064.2 +143600 READ SQ-VS6 SQ1064.2 +143700 END SQ1064.2 +143800 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +143900 NOT AT END SQ1064.2 +144000 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +144100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +144200 GO TO SEQ-TEST-RD-18-01. SQ1064.2 +144300* SQ1064.2 +144400* CHECK THE FILE STATUS VALUE SQ1064.2 +144500* SQ1064.2 +144600 SEQ-DELETE-18-01. SQ1064.2 +144700 PERFORM DE-LETE. SQ1064.2 +144800 GO TO SEQ-TEST-18-01-END. SQ1064.2 +144900 SEQ-TEST-RD-18-01. SQ1064.2 +145000 IF SQ-STATUS = "00" SQ1064.2 +145100 PERFORM PASS SQ1064.2 +145200 ELSE SQ1064.2 +145300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +145400 MOVE "00" TO CORRECT-A SQ1064.2 +145500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +145600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +145700 PERFORM FAIL. SQ1064.2 +145800 SEQ-TEST-18-01-END. SQ1064.2 +145900* SQ1064.2 +146000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +146100* SQ1064.2 +146200 ADD 1 TO REC-CT. SQ1064.2 +146300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +146400 GO TO SEQ-DELETE-18-02. SQ1064.2 +146500 GO TO SEQ-TEST-RD-18-02. SQ1064.2 +146600 SEQ-DELETE-18-02. SQ1064.2 +146700 PERFORM DE-LETE. SQ1064.2 +146800 GO TO SEQ-TEST-18-02-END. SQ1064.2 +146900 SEQ-TEST-RD-18-02. SQ1064.2 +147000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +147100 PERFORM PASS SQ1064.2 +147200 ELSE SQ1064.2 +147300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +147400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +147500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +147600 PERFORM FAIL. SQ1064.2 +147700 SEQ-TEST-18-02-END. SQ1064.2 +147800* SQ1064.2 +147900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +148000* SQ1064.2 +148100 ADD 1 TO REC-CT. SQ1064.2 +148200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +148300* GO TO SEQ-DELETE-18-03. SQ1064.2 +148400* GO TO SEQ-TEST-RD-18-03. SQ1064.2 +148500 SEQ-DELETE-18-03. SQ1064.2 +148600 PERFORM DE-LETE. SQ1064.2 +148700 GO TO SEQ-TEST-18-03-END. SQ1064.2 +148800 SEQ-TEST-RD-18-03. SQ1064.2 +148900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +149000 PERFORM PASS SQ1064.2 +149100 ELSE SQ1064.2 +149200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +149300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +149400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +149500 PERFORM FAIL. SQ1064.2 +149600 SEQ-TEST-18-03-END. SQ1064.2 +149700* SQ1064.2 +149800* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +149900* SQ1064.2 +150000 ADD 1 TO REC-CT. SQ1064.2 +150100 IF DELETE-SW NOT = SPACE SQ1064.2 +150200 GO TO SEQ-DELETE-18-04. SQ1064.2 +150300 GO TO SEQ-TEST-RD-18-04. SQ1064.2 +150400 SEQ-DELETE-18-04. SQ1064.2 +150500 PERFORM DE-LETE. SQ1064.2 +150600 GO TO SEQ-TEST-18-04-END. SQ1064.2 +150700 SEQ-TEST-RD-18-04. SQ1064.2 +150800 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +150900 PERFORM PASS SQ1064.2 +151000 ELSE SQ1064.2 +151100 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +151200 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +151300 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +151400 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +151500 PERFORM FAIL. SQ1064.2 +151600 SEQ-TEST-18-04-END. SQ1064.2 +151700* SQ1064.2 +151800* CHECK EXECUTION OF THE END PATH SQ1064.2 +151900* SQ1064.2 +152000 ADD 1 TO REC-CT. SQ1064.2 +152100 IF DELETE-SW NOT = SPACE SQ1064.2 +152200 GO TO SEQ-DELETE-18-05. SQ1064.2 +152300 GO TO SEQ-TEST-RD-18-05. SQ1064.2 +152400 SEQ-DELETE-18-05. SQ1064.2 +152500 PERFORM DE-LETE. SQ1064.2 +152600 GO TO SEQ-TEST-18-05-END. SQ1064.2 +152700 SEQ-TEST-RD-18-05. SQ1064.2 +152800 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +152900 PERFORM PASS SQ1064.2 +153000 ELSE SQ1064.2 +153100 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +153200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +153300 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +153400 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +153500 MOVE "*" TO DELETE-SW-2 SQ1064.2 +153600 PERFORM FAIL. SQ1064.2 +153700 SEQ-TEST-18-05-END. SQ1064.2 +153800 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +153900* SQ1064.2 +154000* SQ1064.2 +154100* READ A LONG RECORD, USING READ ... AT END ... NOT END ... SQ1064.2 +154200* SQ1064.2 +154300 SEQ-INIT-19. SQ1064.2 +154400 MOVE 1 TO REC-CT. SQ1064.2 +154500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +154600 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +154700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +154800 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +154900 MOVE "**" TO SQ-STATUS. SQ1064.2 +155000 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +155100 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +155200 MOVE "READ LONG AT END NOT END" TO FEATURE. SQ1064.2 +155300 MOVE "SEQ-TEST-RD-19" TO PAR-NAME. SQ1064.2 +155400 IF DELETE-SW NOT = SPACE SQ1064.2 +155500 GO TO SEQ-DELETE-19. SQ1064.2 +155600 GO TO SEQ-TEST-RD-19. SQ1064.2 +155700 SEQ-DELETE-19. SQ1064.2 +155800 MOVE "*" TO DELETE-SW-3. SQ1064.2 +155900 GO TO SEQ-DELETE-19-01. SQ1064.2 +156000* SQ1064.2 +156100* EXECUTE THE READ STATEMENT SQ1064.2 +156200* SQ1064.2 +156300 SEQ-TEST-RD-19. SQ1064.2 +156400 READ SQ-VS6 SQ1064.2 +156500 AT END SQ1064.2 +156600 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +156700 NOT END SQ1064.2 +156800 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +156900 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +157000 GO TO SEQ-TEST-RD-19-01. SQ1064.2 +157100 SEQ-DELETE-19-01. SQ1064.2 +157200 PERFORM DE-LETE. SQ1064.2 +157300 GO TO SEQ-TEST-19-01-END. SQ1064.2 +157400* SQ1064.2 +157500* CHECK THE FILE STATUS RETURNED SQ1064.2 +157600* SQ1064.2 +157700 SEQ-TEST-RD-19-01. SQ1064.2 +157800 IF SQ-STATUS = "00" SQ1064.2 +157900 PERFORM PASS SQ1064.2 +158000 ELSE SQ1064.2 +158100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +158200 MOVE "00" TO CORRECT-A SQ1064.2 +158300 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +158400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +158500 PERFORM FAIL. SQ1064.2 +158600 SEQ-TEST-19-01-END. SQ1064.2 +158700* SQ1064.2 +158800* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +158900* SQ1064.2 +159000 ADD 1 TO REC-CT. SQ1064.2 +159100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +159200 GO TO SEQ-DELETE-19-02. SQ1064.2 +159300 GO TO SEQ-TEST-RD-19-02. SQ1064.2 +159400 SEQ-DELETE-19-02. SQ1064.2 +159500 PERFORM DE-LETE. SQ1064.2 +159600 GO TO SEQ-TEST-19-02-END. SQ1064.2 +159700 SEQ-TEST-RD-19-02. SQ1064.2 +159800 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +159900 PERFORM PASS SQ1064.2 +160000 ELSE SQ1064.2 +160100 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +160200 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +160300 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +160400 PERFORM FAIL. SQ1064.2 +160500 SEQ-TEST-19-02-END. SQ1064.2 +160600* SQ1064.2 +160700* CHECK THE RECORD EXTENSION AREA SQ1064.2 +160800* SQ1064.2 +160900 ADD 1 TO REC-CT. SQ1064.2 +161000 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +161100 GO TO SEQ-DELETE-19-03. SQ1064.2 +161200 GO TO SEQ-TEST-RD-19-03. SQ1064.2 +161300 SEQ-DELETE-19-03. SQ1064.2 +161400 PERFORM DE-LETE. SQ1064.2 +161500 GO TO SEQ-TEST-19-03-END. SQ1064.2 +161600 SEQ-TEST-RD-19-03. SQ1064.2 +161700 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +161800 PERFORM PASS SQ1064.2 +161900 ELSE SQ1064.2 +162000 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +162100 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +162200 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +162300 PERFORM FAIL. SQ1064.2 +162400 SEQ-TEST-19-03-END. SQ1064.2 +162500* SQ1064.2 +162600* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +162700* SQ1064.2 +162800 ADD 1 TO REC-CT. SQ1064.2 +162900 IF DELETE-SW NOT = SPACE SQ1064.2 +163000 GO TO SEQ-DELETE-19-04. SQ1064.2 +163100 GO TO SEQ-TEST-RD-19-04. SQ1064.2 +163200 SEQ-DELETE-19-04. SQ1064.2 +163300 PERFORM DE-LETE. SQ1064.2 +163400 GO TO SEQ-TEST-19-04-END. SQ1064.2 +163500 SEQ-TEST-RD-19-04. SQ1064.2 +163600 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +163700 PERFORM PASS SQ1064.2 +163800 ELSE SQ1064.2 +163900 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +164000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +164100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +164200 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +164300 PERFORM FAIL. SQ1064.2 +164400 SEQ-TEST-19-04-END. SQ1064.2 +164500* SQ1064.2 +164600* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +164700* SQ1064.2 +164800 ADD 1 TO REC-CT. SQ1064.2 +164900 IF DELETE-SW NOT = SPACE SQ1064.2 +165000 GO TO SEQ-DELETE-19-05. SQ1064.2 +165100 GO TO SEQ-TEST-RD-19-05. SQ1064.2 +165200 SEQ-DELETE-19-05. SQ1064.2 +165300 PERFORM DE-LETE. SQ1064.2 +165400 GO TO SEQ-TEST-19-05-END. SQ1064.2 +165500 SEQ-TEST-RD-19-05. SQ1064.2 +165600 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +165700 PERFORM PASS SQ1064.2 +165800 ELSE SQ1064.2 +165900 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +166000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +166100 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +166200 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +166300 MOVE "*" TO DELETE-SW-2 SQ1064.2 +166400 PERFORM FAIL. SQ1064.2 +166500 SEQ-TEST-19-05-END. SQ1064.2 +166600 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +166700* SQ1064.2 +166800* SQ1064.2 +166900* READ A SHORT RECORD, USING READ ... END ... NOT END SQ1064.2 +167000* SQ1064.2 +167100 SEQ-INIT-20. SQ1064.2 +167200 MOVE 1 TO REC-CT. SQ1064.2 +167300 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +167400 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +167500 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +167600 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +167700 MOVE "**" TO SQ-STATUS. SQ1064.2 +167800 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +167900 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +168000 MOVE "READ SHORT END NOT END" TO FEATURE. SQ1064.2 +168100 MOVE "SEQ-TEST-RD-20" TO PAR-NAME. SQ1064.2 +168200 IF DELETE-SW NOT = SPACE SQ1064.2 +168300 GO TO SEQ-DELETE-20. SQ1064.2 +168400 GO TO SEQ-TEST-RD-20. SQ1064.2 +168500 SEQ-DELETE-20. SQ1064.2 +168600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +168700 GO TO SEQ-DELETE-20-01. SQ1064.2 +168800* SQ1064.2 +168900* EXECUTE THE READ STATEMENT SQ1064.2 +169000* SQ1064.2 +169100 SEQ-TEST-RD-20. SQ1064.2 +169200 READ SQ-VS6 SQ1064.2 +169300 END SQ1064.2 +169400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +169500 NOT END SQ1064.2 +169600 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +169700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +169800 GO TO SEQ-TEST-RD-20-01. SQ1064.2 +169900* SQ1064.2 +170000* CHECK THE FILE STATUS VALUE SQ1064.2 +170100* SQ1064.2 +170200 SEQ-DELETE-20-01. SQ1064.2 +170300 PERFORM DE-LETE. SQ1064.2 +170400 GO TO SEQ-TEST-20-01-END. SQ1064.2 +170500 SEQ-TEST-RD-20-01. SQ1064.2 +170600 IF SQ-STATUS = "00" SQ1064.2 +170700 PERFORM PASS SQ1064.2 +170800 ELSE SQ1064.2 +170900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +171000 MOVE "00" TO CORRECT-A SQ1064.2 +171100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +171200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +171300 PERFORM FAIL. SQ1064.2 +171400 SEQ-TEST-20-01-END. SQ1064.2 +171500* SQ1064.2 +171600* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +171700* SQ1064.2 +171800 ADD 1 TO REC-CT. SQ1064.2 +171900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +172000 GO TO SEQ-DELETE-20-02. SQ1064.2 +172100 GO TO SEQ-TEST-RD-20-02. SQ1064.2 +172200 SEQ-DELETE-20-02. SQ1064.2 +172300 PERFORM DE-LETE. SQ1064.2 +172400 GO TO SEQ-TEST-20-02-END. SQ1064.2 +172500 SEQ-TEST-RD-20-02. SQ1064.2 +172600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +172700 PERFORM PASS SQ1064.2 +172800 ELSE SQ1064.2 +172900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +173000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +173100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +173200 PERFORM FAIL. SQ1064.2 +173300 SEQ-TEST-20-02-END. SQ1064.2 +173400* SQ1064.2 +173500* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +173600* SQ1064.2 +173700 ADD 1 TO REC-CT. SQ1064.2 +173800* IF DELETE-SW NOT = TO SPACE SQ1064.2 +173900* GO TO SEQ-DELETE-20-03. SQ1064.2 +174000* GO TO SEQ-TEST-RD-20-03. SQ1064.2 +174100 SEQ-DELETE-20-03. SQ1064.2 +174200 PERFORM DE-LETE. SQ1064.2 +174300 GO TO SEQ-TEST-20-03-END. SQ1064.2 +174400 SEQ-TEST-RD-20-03. SQ1064.2 +174500 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +174600 PERFORM PASS SQ1064.2 +174700 ELSE SQ1064.2 +174800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +174900 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +175000 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +175100 PERFORM FAIL. SQ1064.2 +175200 SEQ-TEST-20-03-END. SQ1064.2 +175300* SQ1064.2 +175400* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +175500* SQ1064.2 +175600 ADD 1 TO REC-CT. SQ1064.2 +175700 IF DELETE-SW NOT = SPACE SQ1064.2 +175800 GO TO SEQ-DELETE-20-04. SQ1064.2 +175900 GO TO SEQ-TEST-RD-20-04. SQ1064.2 +176000 SEQ-DELETE-20-04. SQ1064.2 +176100 PERFORM DE-LETE. SQ1064.2 +176200 GO TO SEQ-TEST-20-04-END. SQ1064.2 +176300 SEQ-TEST-RD-20-04. SQ1064.2 +176400 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +176500 PERFORM PASS SQ1064.2 +176600 ELSE SQ1064.2 +176700 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +176800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +176900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +177000 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +177100 PERFORM FAIL. SQ1064.2 +177200 SEQ-TEST-20-04-END. SQ1064.2 +177300* SQ1064.2 +177400* CHECK EXECUTION OF THE END PATH SQ1064.2 +177500* SQ1064.2 +177600 ADD 1 TO REC-CT. SQ1064.2 +177700 IF DELETE-SW NOT = SPACE SQ1064.2 +177800 GO TO SEQ-DELETE-20-05. SQ1064.2 +177900 GO TO SEQ-TEST-RD-20-05. SQ1064.2 +178000 SEQ-DELETE-20-05. SQ1064.2 +178100 PERFORM DE-LETE. SQ1064.2 +178200 GO TO SEQ-TEST-20-05-END. SQ1064.2 +178300 SEQ-TEST-RD-20-05. SQ1064.2 +178400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +178500 PERFORM PASS SQ1064.2 +178600 ELSE SQ1064.2 +178700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +178800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +178900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +179000 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +179100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +179200 PERFORM FAIL. SQ1064.2 +179300 SEQ-TEST-20-05-END. SQ1064.2 +179400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +179500* SQ1064.2 +179600* SQ1064.2 +179700* READ A LONG RECORD, SQ1064.2 +179800* USING READ ... AT END ... END-READ SQ1064.2 +179900* SQ1064.2 +180000 SEQ-INIT-21. SQ1064.2 +180100 MOVE 1 TO REC-CT. SQ1064.2 +180200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +180300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +180400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +180500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +180600 MOVE "**" TO SQ-STATUS. SQ1064.2 +180700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +180800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +180900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +181000 MOVE "READ LONG AT END END-RD" TO FEATURE. SQ1064.2 +181100 MOVE "SEQ-TEST-RD-21" TO PAR-NAME. SQ1064.2 +181200 IF DELETE-SW NOT = SPACE SQ1064.2 +181300 GO TO SEQ-DELETE-21. SQ1064.2 +181400 GO TO SEQ-TEST-RD-21. SQ1064.2 +181500 SEQ-DELETE-21. SQ1064.2 +181600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +181700 GO TO SEQ-DELETE-21-01. SQ1064.2 +181800* SQ1064.2 +181900* EXECUTE THE READ STATEMENT SQ1064.2 +182000* SQ1064.2 +182100 SEQ-TEST-RD-21. SQ1064.2 +182200 READ SQ-VS6 SQ1064.2 +182300 AT END SQ1064.2 +182400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +182500 END-READ SQ1064.2 +182600 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +182700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +182800 GO TO SEQ-TEST-RD-21-01. SQ1064.2 +182900 SEQ-DELETE-21-01. SQ1064.2 +183000 PERFORM DE-LETE. SQ1064.2 +183100 GO TO SEQ-TEST-21-01-END. SQ1064.2 +183200* SQ1064.2 +183300* CHECK THE FILE STATUS RETURNED SQ1064.2 +183400* SQ1064.2 +183500 SEQ-TEST-RD-21-01. SQ1064.2 +183600 IF SQ-STATUS = "00" SQ1064.2 +183700 PERFORM PASS SQ1064.2 +183800 ELSE SQ1064.2 +183900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +184000 MOVE "00" TO CORRECT-A SQ1064.2 +184100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +184200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +184300 PERFORM FAIL. SQ1064.2 +184400 SEQ-TEST-21-01-END. SQ1064.2 +184500* SQ1064.2 +184600* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +184700* SQ1064.2 +184800 ADD 1 TO REC-CT. SQ1064.2 +184900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +185000 GO TO SEQ-DELETE-21-02. SQ1064.2 +185100 GO TO SEQ-TEST-RD-21-02. SQ1064.2 +185200 SEQ-DELETE-21-02. SQ1064.2 +185300 PERFORM DE-LETE. SQ1064.2 +185400 GO TO SEQ-TEST-21-02-END. SQ1064.2 +185500 SEQ-TEST-RD-21-02. SQ1064.2 +185600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +185700 PERFORM PASS SQ1064.2 +185800 ELSE SQ1064.2 +185900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +186000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +186100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +186200 PERFORM FAIL. SQ1064.2 +186300 SEQ-TEST-21-02-END. SQ1064.2 +186400* SQ1064.2 +186500* CHECK THE RECORD EXTENSION AREA SQ1064.2 +186600* SQ1064.2 +186700 ADD 1 TO REC-CT. SQ1064.2 +186800 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +186900 GO TO SEQ-DELETE-21-03. SQ1064.2 +187000 GO TO SEQ-TEST-RD-21-03. SQ1064.2 +187100 SEQ-DELETE-21-03. SQ1064.2 +187200 PERFORM DE-LETE. SQ1064.2 +187300 GO TO SEQ-TEST-21-03-END. SQ1064.2 +187400 SEQ-TEST-RD-21-03. SQ1064.2 +187500 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +187600 PERFORM PASS SQ1064.2 +187700 ELSE SQ1064.2 +187800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +187900 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +188000 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +188100 PERFORM FAIL. SQ1064.2 +188200 SEQ-TEST-21-03-END. SQ1064.2 +188300* SQ1064.2 +188400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +188500* SQ1064.2 +188600 ADD 1 TO REC-CT. SQ1064.2 +188700 IF DELETE-SW NOT = SPACE SQ1064.2 +188800 GO TO SEQ-DELETE-21-04. SQ1064.2 +188900 GO TO SEQ-TEST-RD-21-04. SQ1064.2 +189000 SEQ-DELETE-21-04. SQ1064.2 +189100 PERFORM DE-LETE. SQ1064.2 +189200 GO TO SEQ-TEST-21-04-END. SQ1064.2 +189300 SEQ-TEST-RD-21-04. SQ1064.2 +189400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +189500 PERFORM PASS SQ1064.2 +189600 ELSE SQ1064.2 +189700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +189800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +189900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +190000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +190100 PERFORM FAIL. SQ1064.2 +190200 SEQ-TEST-21-04-END. SQ1064.2 +190300* SQ1064.2 +190400* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +190500* SQ1064.2 +190600 ADD 1 TO REC-CT. SQ1064.2 +190700 IF DELETE-SW NOT = SPACE SQ1064.2 +190800 GO TO SEQ-DELETE-21-05. SQ1064.2 +190900 GO TO SEQ-TEST-RD-21-05. SQ1064.2 +191000 SEQ-DELETE-21-05. SQ1064.2 +191100 PERFORM DE-LETE. SQ1064.2 +191200 GO TO SEQ-TEST-21-05-END. SQ1064.2 +191300 SEQ-TEST-RD-21-05. SQ1064.2 +191400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +191500 PERFORM PASS SQ1064.2 +191600 ELSE SQ1064.2 +191700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +191800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +191900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +192000 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +192100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +192200 PERFORM FAIL. SQ1064.2 +192300 SEQ-TEST-21-05-END. SQ1064.2 +192400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +192500* SQ1064.2 +192600* SQ1064.2 +192700* READ A LONG RECORD, SQ1064.2 +192800* USING READ ... END ... END-READ SQ1064.2 +192900* SQ1064.2 +193000 SEQ-INIT-22. SQ1064.2 +193100 MOVE 1 TO REC-CT. SQ1064.2 +193200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +193300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +193400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +193500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +193600 MOVE "**" TO SQ-STATUS. SQ1064.2 +193700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +193800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +193900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +194000 MOVE "READ LONG END END-READ" TO FEATURE. SQ1064.2 +194100 MOVE "SEQ-TEST-RD-22" TO PAR-NAME. SQ1064.2 +194200 IF DELETE-SW NOT = SPACE SQ1064.2 +194300 GO TO SEQ-DELETE-22. SQ1064.2 +194400 GO TO SEQ-TEST-RD-22. SQ1064.2 +194500 SEQ-DELETE-22. SQ1064.2 +194600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +194700 GO TO SEQ-DELETE-22-01. SQ1064.2 +194800* SQ1064.2 +194900* EXECUTE THE READ STATEMENT SQ1064.2 +195000* SQ1064.2 +195100 SEQ-TEST-RD-22. SQ1064.2 +195200 READ SQ-VS6 SQ1064.2 +195300 END SQ1064.2 +195400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +195500 END-READ SQ1064.2 +195600 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +195700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +195800 GO TO SEQ-TEST-RD-22-01. SQ1064.2 +195900 SEQ-DELETE-22-01. SQ1064.2 +196000 PERFORM DE-LETE. SQ1064.2 +196100 GO TO SEQ-TEST-22-01-END. SQ1064.2 +196200* SQ1064.2 +196300* CHECK THE FILE STATUS RETURNED SQ1064.2 +196400* SQ1064.2 +196500 SEQ-TEST-RD-22-01. SQ1064.2 +196600 IF SQ-STATUS = "00" SQ1064.2 +196700 PERFORM PASS SQ1064.2 +196800 ELSE SQ1064.2 +196900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +197000 MOVE "00" TO CORRECT-A SQ1064.2 +197100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +197200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +197300 PERFORM FAIL. SQ1064.2 +197400 SEQ-TEST-22-01-END. SQ1064.2 +197500* SQ1064.2 +197600* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +197700* SQ1064.2 +197800 ADD 1 TO REC-CT. SQ1064.2 +197900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +198000 GO TO SEQ-DELETE-22-02. SQ1064.2 +198100 GO TO SEQ-TEST-RD-22-02. SQ1064.2 +198200 SEQ-DELETE-22-02. SQ1064.2 +198300 PERFORM DE-LETE. SQ1064.2 +198400 GO TO SEQ-TEST-22-02-END. SQ1064.2 +198500 SEQ-TEST-RD-22-02. SQ1064.2 +198600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +198700 PERFORM PASS SQ1064.2 +198800 ELSE SQ1064.2 +198900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +199000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +199100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +199200 PERFORM FAIL. SQ1064.2 +199300 SEQ-TEST-22-02-END. SQ1064.2 +199400* SQ1064.2 +199500* CHECK THE RECORD EXTENSION AREA SQ1064.2 +199600* SQ1064.2 +199700 ADD 1 TO REC-CT. SQ1064.2 +199800 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +199900 GO TO SEQ-DELETE-22-03. SQ1064.2 +200000 GO TO SEQ-TEST-RD-22-03. SQ1064.2 +200100 SEQ-DELETE-22-03. SQ1064.2 +200200 PERFORM DE-LETE. SQ1064.2 +200300 GO TO SEQ-TEST-22-03-END. SQ1064.2 +200400 SEQ-TEST-RD-22-03. SQ1064.2 +200500 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +200600 PERFORM PASS SQ1064.2 +200700 ELSE SQ1064.2 +200800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +200900 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +201000 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +201100 PERFORM FAIL. SQ1064.2 +201200 SEQ-TEST-22-03-END. SQ1064.2 +201300* SQ1064.2 +201400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +201500* SQ1064.2 +201600 ADD 1 TO REC-CT. SQ1064.2 +201700 IF DELETE-SW NOT = SPACE SQ1064.2 +201800 GO TO SEQ-DELETE-22-04. SQ1064.2 +201900 GO TO SEQ-TEST-RD-22-04. SQ1064.2 +202000 SEQ-DELETE-22-04. SQ1064.2 +202100 PERFORM DE-LETE. SQ1064.2 +202200 GO TO SEQ-TEST-22-04-END. SQ1064.2 +202300 SEQ-TEST-RD-22-04. SQ1064.2 +202400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +202500 PERFORM PASS SQ1064.2 +202600 ELSE SQ1064.2 +202700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +202800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +202900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +203000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +203100 PERFORM FAIL. SQ1064.2 +203200 SEQ-TEST-22-04-END. SQ1064.2 +203300* SQ1064.2 +203400* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +203500* SQ1064.2 +203600 ADD 1 TO REC-CT. SQ1064.2 +203700 IF DELETE-SW NOT = SPACE SQ1064.2 +203800 GO TO SEQ-DELETE-22-05. SQ1064.2 +203900 GO TO SEQ-TEST-RD-22-05. SQ1064.2 +204000 SEQ-DELETE-22-05. SQ1064.2 +204100 PERFORM DE-LETE. SQ1064.2 +204200 GO TO SEQ-TEST-22-05-END. SQ1064.2 +204300 SEQ-TEST-RD-22-05. SQ1064.2 +204400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +204500 PERFORM PASS SQ1064.2 +204600 ELSE SQ1064.2 +204700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +204800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +204900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +205000 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +205100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +205200 PERFORM FAIL. SQ1064.2 +205300 SEQ-TEST-22-05-END. SQ1064.2 +205400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +205500* SQ1064.2 +205600* SQ1064.2 +205700* READ A LONG RECORD, SQ1064.2 +205800* USING READ ... AT END ... NOT AT END ... END-READ SQ1064.2 +205900* SQ1064.2 +206000 SEQ-INIT-23. SQ1064.2 +206100 MOVE 1 TO REC-CT. SQ1064.2 +206200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +206300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +206400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +206500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +206600 MOVE "**" TO SQ-STATUS. SQ1064.2 +206700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +206800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +206900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +207000 MOVE "READ LONG AT END NAE E-R" TO FEATURE. SQ1064.2 +207100 MOVE "SEQ-TEST-RD-23" TO PAR-NAME. SQ1064.2 +207200 IF DELETE-SW NOT = SPACE SQ1064.2 +207300 GO TO SEQ-DELETE-23. SQ1064.2 +207400 GO TO SEQ-TEST-RD-23. SQ1064.2 +207500 SEQ-DELETE-23. SQ1064.2 +207600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +207700 GO TO SEQ-DELETE-23-01. SQ1064.2 +207800* SQ1064.2 +207900* EXECUTE THE READ STATEMENT SQ1064.2 +208000* SQ1064.2 +208100 SEQ-TEST-RD-23. SQ1064.2 +208200 READ SQ-VS6 SQ1064.2 +208300 AT END SQ1064.2 +208400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +208500 NOT AT END SQ1064.2 +208600 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +208700 END-READ SQ1064.2 +208800 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +208900 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +209000 GO TO SEQ-TEST-RD-23-01. SQ1064.2 +209100 SEQ-DELETE-23-01. SQ1064.2 +209200 PERFORM DE-LETE. SQ1064.2 +209300 GO TO SEQ-TEST-23-01-END. SQ1064.2 +209400* SQ1064.2 +209500* CHECK THE FILE STATUS RETURNED SQ1064.2 +209600* SQ1064.2 +209700 SEQ-TEST-RD-23-01. SQ1064.2 +209800 IF SQ-STATUS = "00" SQ1064.2 +209900 PERFORM PASS SQ1064.2 +210000 ELSE SQ1064.2 +210100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +210200 MOVE "00" TO CORRECT-A SQ1064.2 +210300 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +210400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +210500 PERFORM FAIL. SQ1064.2 +210600 SEQ-TEST-23-01-END. SQ1064.2 +210700* SQ1064.2 +210800* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +210900* SQ1064.2 +211000 ADD 1 TO REC-CT. SQ1064.2 +211100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +211200 GO TO SEQ-DELETE-23-02. SQ1064.2 +211300 GO TO SEQ-TEST-RD-23-02. SQ1064.2 +211400 SEQ-DELETE-23-02. SQ1064.2 +211500 PERFORM DE-LETE. SQ1064.2 +211600 GO TO SEQ-TEST-23-02-END. SQ1064.2 +211700 SEQ-TEST-RD-23-02. SQ1064.2 +211800 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +211900 PERFORM PASS SQ1064.2 +212000 ELSE SQ1064.2 +212100 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +212200 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +212300 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +212400 PERFORM FAIL. SQ1064.2 +212500 SEQ-TEST-23-02-END. SQ1064.2 +212600* SQ1064.2 +212700* CHECK THE RECORD EXTENSION AREA SQ1064.2 +212800* SQ1064.2 +212900 ADD 1 TO REC-CT. SQ1064.2 +213000 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +213100 GO TO SEQ-DELETE-23-03. SQ1064.2 +213200 GO TO SEQ-TEST-RD-23-03. SQ1064.2 +213300 SEQ-DELETE-23-03. SQ1064.2 +213400 PERFORM DE-LETE. SQ1064.2 +213500 GO TO SEQ-TEST-23-03-END. SQ1064.2 +213600 SEQ-TEST-RD-23-03. SQ1064.2 +213700 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +213800 PERFORM PASS SQ1064.2 +213900 ELSE SQ1064.2 +214000 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +214100 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +214200 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +214300 PERFORM FAIL. SQ1064.2 +214400 SEQ-TEST-23-03-END. SQ1064.2 +214500* SQ1064.2 +214600* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +214700* SQ1064.2 +214800 ADD 1 TO REC-CT. SQ1064.2 +214900 IF DELETE-SW NOT = SPACE SQ1064.2 +215000 GO TO SEQ-DELETE-23-04. SQ1064.2 +215100 GO TO SEQ-TEST-RD-23-04. SQ1064.2 +215200 SEQ-DELETE-23-04. SQ1064.2 +215300 PERFORM DE-LETE. SQ1064.2 +215400 GO TO SEQ-TEST-23-04-END. SQ1064.2 +215500 SEQ-TEST-RD-23-04. SQ1064.2 +215600 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +215700 PERFORM PASS SQ1064.2 +215800 ELSE SQ1064.2 +215900 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +216000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +216100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +216200 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +216300 PERFORM FAIL. SQ1064.2 +216400 SEQ-TEST-23-04-END. SQ1064.2 +216500* SQ1064.2 +216600* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +216700* SQ1064.2 +216800 ADD 1 TO REC-CT. SQ1064.2 +216900 IF DELETE-SW NOT = SPACE SQ1064.2 +217000 GO TO SEQ-DELETE-23-05. SQ1064.2 +217100 GO TO SEQ-TEST-RD-23-05. SQ1064.2 +217200 SEQ-DELETE-23-05. SQ1064.2 +217300 PERFORM DE-LETE. SQ1064.2 +217400 GO TO SEQ-TEST-23-05-END. SQ1064.2 +217500 SEQ-TEST-RD-23-05. SQ1064.2 +217600 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +217700 PERFORM PASS SQ1064.2 +217800 ELSE SQ1064.2 +217900 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +218000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +218100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +218200 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +218300 PERFORM FAIL. SQ1064.2 +218400 SEQ-TEST-23-05-END. SQ1064.2 +218500* SQ1064.2 +218600* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +218700* SQ1064.2 +218800 ADD 1 TO REC-CT. SQ1064.2 +218900 IF DELETE-SW NOT = SPACE SQ1064.2 +219000 GO TO SEQ-DELETE-23-06. SQ1064.2 +219100 GO TO SEQ-TEST-RD-23-06. SQ1064.2 +219200 SEQ-DELETE-23-06. SQ1064.2 +219300 PERFORM DE-LETE. SQ1064.2 +219400 GO TO SEQ-TEST-23-06-END. SQ1064.2 +219500 SEQ-TEST-RD-23-06. SQ1064.2 +219600 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +219700 PERFORM PASS SQ1064.2 +219800 ELSE SQ1064.2 +219900 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +220000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +220100 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +220200 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +220300 MOVE "*" TO DELETE-SW-2 SQ1064.2 +220400 PERFORM FAIL. SQ1064.2 +220500 SEQ-TEST-23-06-END. SQ1064.2 +220600 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +220700* SQ1064.2 +220800* SQ1064.2 +220900* READ A SHORT RECORD, SQ1064.2 +221000* USING READ ... END ... NOT AT END ... END-READ SQ1064.2 +221100* SQ1064.2 +221200 SEQ-INIT-24. SQ1064.2 +221300 MOVE 1 TO REC-CT. SQ1064.2 +221400 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +221500 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +221600 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +221700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +221800 MOVE "**" TO SQ-STATUS. SQ1064.2 +221900 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +222000 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +222100 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +222200 MOVE "READ SHORT END N A R E-R" TO FEATURE. SQ1064.2 +222300 MOVE "SEQ-TEST-RD-24" TO PAR-NAME. SQ1064.2 +222400 IF DELETE-SW NOT = SPACE SQ1064.2 +222500 GO TO SEQ-DELETE-24. SQ1064.2 +222600 GO TO SEQ-TEST-RD-24. SQ1064.2 +222700 SEQ-DELETE-24. SQ1064.2 +222800 MOVE "*" TO DELETE-SW-3. SQ1064.2 +222900 GO TO SEQ-DELETE-24-01. SQ1064.2 +223000* SQ1064.2 +223100* EXECUTE THE READ STATEMENT SQ1064.2 +223200* SQ1064.2 +223300 SEQ-TEST-RD-24. SQ1064.2 +223400 READ SQ-VS6 SQ1064.2 +223500 END SQ1064.2 +223600 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +223700 NOT AT END SQ1064.2 +223800 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +223900 END-READ SQ1064.2 +224000 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +224100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +224200 GO TO SEQ-TEST-RD-24-01. SQ1064.2 +224300* SQ1064.2 +224400* CHECK THE FILE STATUS VALUE SQ1064.2 +224500* SQ1064.2 +224600 SEQ-DELETE-24-01. SQ1064.2 +224700 PERFORM DE-LETE. SQ1064.2 +224800 GO TO SEQ-TEST-24-01-END. SQ1064.2 +224900 SEQ-TEST-RD-24-01. SQ1064.2 +225000 IF SQ-STATUS = "00" SQ1064.2 +225100 PERFORM PASS SQ1064.2 +225200 ELSE SQ1064.2 +225300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +225400 MOVE "00" TO CORRECT-A SQ1064.2 +225500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +225600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +225700 PERFORM FAIL. SQ1064.2 +225800 SEQ-TEST-24-01-END. SQ1064.2 +225900* SQ1064.2 +226000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +226100* SQ1064.2 +226200 ADD 1 TO REC-CT. SQ1064.2 +226300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +226400 GO TO SEQ-DELETE-24-02. SQ1064.2 +226500 GO TO SEQ-TEST-RD-24-02. SQ1064.2 +226600 SEQ-DELETE-24-02. SQ1064.2 +226700 PERFORM DE-LETE. SQ1064.2 +226800 GO TO SEQ-TEST-24-02-END. SQ1064.2 +226900 SEQ-TEST-RD-24-02. SQ1064.2 +227000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +227100 PERFORM PASS SQ1064.2 +227200 ELSE SQ1064.2 +227300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +227400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +227500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +227600 PERFORM FAIL. SQ1064.2 +227700 SEQ-TEST-24-02-END. SQ1064.2 +227800* SQ1064.2 +227900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +228000* SQ1064.2 +228100 ADD 1 TO REC-CT. SQ1064.2 +228200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +228300* GO TO SEQ-DELETE-24-03. SQ1064.2 +228400* GO TO SEQ-TEST-RD-24-03. SQ1064.2 +228500 SEQ-DELETE-24-03. SQ1064.2 +228600 PERFORM DE-LETE. SQ1064.2 +228700 GO TO SEQ-TEST-24-03-END. SQ1064.2 +228800 SEQ-TEST-RD-24-03. SQ1064.2 +228900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +229000 PERFORM PASS SQ1064.2 +229100 ELSE SQ1064.2 +229200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +229300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +229400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +229500 PERFORM FAIL. SQ1064.2 +229600 SEQ-TEST-24-03-END. SQ1064.2 +229700* SQ1064.2 +229800* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +229900* SQ1064.2 +230000 ADD 1 TO REC-CT. SQ1064.2 +230100 IF DELETE-SW NOT = SPACE SQ1064.2 +230200 GO TO SEQ-DELETE-24-04. SQ1064.2 +230300 GO TO SEQ-TEST-RD-24-04. SQ1064.2 +230400 SEQ-DELETE-24-04. SQ1064.2 +230500 PERFORM DE-LETE. SQ1064.2 +230600 GO TO SEQ-TEST-24-04-END. SQ1064.2 +230700 SEQ-TEST-RD-24-04. SQ1064.2 +230800 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +230900 PERFORM PASS SQ1064.2 +231000 ELSE SQ1064.2 +231100 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +231200 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +231300 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +231400 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +231500 PERFORM FAIL. SQ1064.2 +231600 SEQ-TEST-24-04-END. SQ1064.2 +231700* SQ1064.2 +231800* SQ1064.2 +231900* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +232000* SQ1064.2 +232100 ADD 1 TO REC-CT. SQ1064.2 +232200 IF DELETE-SW NOT = SPACE SQ1064.2 +232300 GO TO SEQ-DELETE-24-05. SQ1064.2 +232400 GO TO SEQ-TEST-RD-24-05. SQ1064.2 +232500 SEQ-DELETE-24-05. SQ1064.2 +232600 PERFORM DE-LETE. SQ1064.2 +232700 GO TO SEQ-TEST-24-05-END. SQ1064.2 +232800 SEQ-TEST-RD-24-05. SQ1064.2 +232900 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +233000 PERFORM PASS SQ1064.2 +233100 ELSE SQ1064.2 +233200 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +233300 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +233400 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +233500 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +233600 PERFORM FAIL. SQ1064.2 +233700 SEQ-TEST-24-05-END. SQ1064.2 +233800* SQ1064.2 +233900* CHECK EXECUTION OF THE END PATH SQ1064.2 +234000* SQ1064.2 +234100 ADD 1 TO REC-CT. SQ1064.2 +234200 IF DELETE-SW NOT = SPACE SQ1064.2 +234300 GO TO SEQ-DELETE-24-06. SQ1064.2 +234400 GO TO SEQ-TEST-RD-24-06. SQ1064.2 +234500 SEQ-DELETE-24-06. SQ1064.2 +234600 PERFORM DE-LETE. SQ1064.2 +234700 GO TO SEQ-TEST-24-06-END. SQ1064.2 +234800 SEQ-TEST-RD-24-06. SQ1064.2 +234900 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +235000 PERFORM PASS SQ1064.2 +235100 ELSE SQ1064.2 +235200 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +235300 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +235400 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +235500 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +235600 MOVE "*" TO DELETE-SW-2 SQ1064.2 +235700 PERFORM FAIL. SQ1064.2 +235800 SEQ-TEST-24-06-END. SQ1064.2 +235900 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +236000* SQ1064.2 +236100* SQ1064.2 +236200* READ A SHORT RECORD, SQ1064.2 +236300* USING READ ... AT END ... NOT END ... END-READ SQ1064.2 +236400* SQ1064.2 +236500 SEQ-INIT-25. SQ1064.2 +236600 MOVE 1 TO REC-CT. SQ1064.2 +236700 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +236800 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +236900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +237000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +237100 MOVE "**" TO SQ-STATUS. SQ1064.2 +237200 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +237300 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +237400 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +237500 MOVE "READ SHORT A END N E E-R" TO FEATURE. SQ1064.2 +237600 MOVE "SEQ-TEST-RD-25" TO PAR-NAME. SQ1064.2 +237700 IF DELETE-SW NOT = SPACE SQ1064.2 +237800 GO TO SEQ-DELETE-25. SQ1064.2 +237900 GO TO SEQ-TEST-RD-25. SQ1064.2 +238000 SEQ-DELETE-25. SQ1064.2 +238100 MOVE "*" TO DELETE-SW-3. SQ1064.2 +238200 GO TO SEQ-DELETE-25-01. SQ1064.2 +238300* SQ1064.2 +238400* EXECUTE THE READ STATEMENT SQ1064.2 +238500* SQ1064.2 +238600 SEQ-TEST-RD-25. SQ1064.2 +238700 READ SQ-VS6 SQ1064.2 +238800 AT END SQ1064.2 +238900 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +239000 NOT END SQ1064.2 +239100 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +239200 END-READ SQ1064.2 +239300 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +239400 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +239500 GO TO SEQ-TEST-RD-25-01. SQ1064.2 +239600* SQ1064.2 +239700* CHECK THE FILE STATUS VALUE SQ1064.2 +239800* SQ1064.2 +239900 SEQ-DELETE-25-01. SQ1064.2 +240000 PERFORM DE-LETE. SQ1064.2 +240100 GO TO SEQ-TEST-25-01-END. SQ1064.2 +240200 SEQ-TEST-RD-25-01. SQ1064.2 +240300 IF SQ-STATUS = "00" SQ1064.2 +240400 PERFORM PASS SQ1064.2 +240500 ELSE SQ1064.2 +240600 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +240700 MOVE "00" TO CORRECT-A SQ1064.2 +240800 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +240900 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +241000 PERFORM FAIL. SQ1064.2 +241100 SEQ-TEST-25-01-END. SQ1064.2 +241200* SQ1064.2 +241300* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +241400* SQ1064.2 +241500 ADD 1 TO REC-CT. SQ1064.2 +241600 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +241700 GO TO SEQ-DELETE-25-02. SQ1064.2 +241800 GO TO SEQ-TEST-RD-25-02. SQ1064.2 +241900 SEQ-DELETE-25-02. SQ1064.2 +242000 PERFORM DE-LETE. SQ1064.2 +242100 GO TO SEQ-TEST-25-02-END. SQ1064.2 +242200 SEQ-TEST-RD-25-02. SQ1064.2 +242300 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +242400 PERFORM PASS SQ1064.2 +242500 ELSE SQ1064.2 +242600 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +242700 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +242800 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +242900 PERFORM FAIL. SQ1064.2 +243000 SEQ-TEST-25-02-END. SQ1064.2 +243100* SQ1064.2 +243200* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +243300* SQ1064.2 +243400 ADD 1 TO REC-CT. SQ1064.2 +243500* IF DELETE-SW NOT = TO SPACE SQ1064.2 +243600* GO TO SEQ-DELETE-25-03. SQ1064.2 +243700* GO TO SEQ-TEST-RD-25-03. SQ1064.2 +243800 SEQ-DELETE-25-03. SQ1064.2 +243900 PERFORM DE-LETE. SQ1064.2 +244000 GO TO SEQ-TEST-25-03-END. SQ1064.2 +244100 SEQ-TEST-RD-25-03. SQ1064.2 +244200 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +244300 PERFORM PASS SQ1064.2 +244400 ELSE SQ1064.2 +244500 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +244600 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +244700 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +244800 PERFORM FAIL. SQ1064.2 +244900 SEQ-TEST-25-03-END. SQ1064.2 +245000* SQ1064.2 +245100* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +245200* SQ1064.2 +245300 ADD 1 TO REC-CT. SQ1064.2 +245400 IF DELETE-SW NOT = SPACE SQ1064.2 +245500 GO TO SEQ-DELETE-25-04. SQ1064.2 +245600 GO TO SEQ-TEST-RD-25-04. SQ1064.2 +245700 SEQ-DELETE-25-04. SQ1064.2 +245800 PERFORM DE-LETE. SQ1064.2 +245900 GO TO SEQ-TEST-25-04-END. SQ1064.2 +246000 SEQ-TEST-RD-25-04. SQ1064.2 +246100 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +246200 PERFORM PASS SQ1064.2 +246300 ELSE SQ1064.2 +246400 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +246500 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +246600 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +246700 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +246800 PERFORM FAIL. SQ1064.2 +246900 SEQ-TEST-25-04-END. SQ1064.2 +247000* SQ1064.2 +247100* SQ1064.2 +247200* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +247300* SQ1064.2 +247400 ADD 1 TO REC-CT. SQ1064.2 +247500 IF DELETE-SW NOT = SPACE SQ1064.2 +247600 GO TO SEQ-DELETE-25-05. SQ1064.2 +247700 GO TO SEQ-TEST-RD-25-05. SQ1064.2 +247800 SEQ-DELETE-25-05. SQ1064.2 +247900 PERFORM DE-LETE. SQ1064.2 +248000 GO TO SEQ-TEST-25-05-END. SQ1064.2 +248100 SEQ-TEST-RD-25-05. SQ1064.2 +248200 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +248300 PERFORM PASS SQ1064.2 +248400 ELSE SQ1064.2 +248500 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +248600 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +248700 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +248800 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +248900 PERFORM FAIL. SQ1064.2 +249000 SEQ-TEST-25-05-END. SQ1064.2 +249100* SQ1064.2 +249200* CHECK EXECUTION OF THE END PATH SQ1064.2 +249300* SQ1064.2 +249400 ADD 1 TO REC-CT. SQ1064.2 +249500 IF DELETE-SW NOT = SPACE SQ1064.2 +249600 GO TO SEQ-DELETE-25-06. SQ1064.2 +249700 GO TO SEQ-TEST-RD-25-06. SQ1064.2 +249800 SEQ-DELETE-25-06. SQ1064.2 +249900 PERFORM DE-LETE. SQ1064.2 +250000 GO TO SEQ-TEST-25-06-END. SQ1064.2 +250100 SEQ-TEST-RD-25-06. SQ1064.2 +250200 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +250300 PERFORM PASS SQ1064.2 +250400 ELSE SQ1064.2 +250500 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +250600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +250700 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +250800 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +250900 MOVE "*" TO DELETE-SW-2 SQ1064.2 +251000 PERFORM FAIL. SQ1064.2 +251100 SEQ-TEST-25-06-END. SQ1064.2 +251200 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +251300* SQ1064.2 +251400* SQ1064.2 +251500* READ AT END OF FILE, RAISING EOF CONDITION SQ1064.2 +251600* USING READ ... END ... NOT END ... END-READ SQ1064.2 +251700* SQ1064.2 +251800 SEQ-INIT-26. SQ1064.2 +251900 MOVE 1 TO REC-CT. SQ1064.2 +252000 MOVE "**" TO SQ-STATUS. SQ1064.2 +252100 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +252200 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +252300 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +252400 MOVE "READ SHORT A END N E E-R" TO FEATURE. SQ1064.2 +252500 MOVE "SEQ-TEST-RD-26" TO PAR-NAME. SQ1064.2 +252600 IF DELETE-SW NOT = SPACE SQ1064.2 +252700 GO TO SEQ-DELETE-26. SQ1064.2 +252800 GO TO SEQ-TEST-RD-26. SQ1064.2 +252900 SEQ-DELETE-26. SQ1064.2 +253000 MOVE "*" TO DELETE-SW-3. SQ1064.2 +253100 GO TO SEQ-DELETE-26-01. SQ1064.2 +253200* SQ1064.2 +253300* EXECUTE THE READ STATEMENT SQ1064.2 +253400* SQ1064.2 +253500 SEQ-TEST-RD-26. SQ1064.2 +253600 READ SQ-VS6 SQ1064.2 +253700 END SQ1064.2 +253800 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +253900 NOT END SQ1064.2 +254000 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +254100 END-READ SQ1064.2 +254200 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +254300 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +254400 GO TO SEQ-TEST-RD-26-01. SQ1064.2 +254500* SQ1064.2 +254600* CHECK THE FILE STATUS VALUE SQ1064.2 +254700* SQ1064.2 +254800 SEQ-DELETE-26-01. SQ1064.2 +254900 PERFORM DE-LETE. SQ1064.2 +255000 GO TO SEQ-TEST-26-01-END. SQ1064.2 +255100 SEQ-TEST-RD-26-01. SQ1064.2 +255200 IF SQ-STATUS = "10" SQ1064.2 +255300 PERFORM PASS SQ1064.2 +255400 ELSE SQ1064.2 +255500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +255600 MOVE "10" TO CORRECT-A SQ1064.2 +255700 MOVE "I-O STATUS FOR EOF NOT RETURNED" TO RE-MARK SQ1064.2 +255800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +255900 PERFORM FAIL. SQ1064.2 +256000 SEQ-TEST-26-01-END. SQ1064.2 +256100* SQ1064.2 +256200* SQ1064.2 +256300* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +256400* SQ1064.2 +256500 ADD 1 TO REC-CT. SQ1064.2 +256600 IF DELETE-SW NOT = SPACE SQ1064.2 +256700 GO TO SEQ-DELETE-26-02. SQ1064.2 +256800 GO TO SEQ-TEST-RD-26-02. SQ1064.2 +256900 SEQ-DELETE-26-02. SQ1064.2 +257000 PERFORM DE-LETE. SQ1064.2 +257100 GO TO SEQ-TEST-26-02-END. SQ1064.2 +257200 SEQ-TEST-RD-26-02. SQ1064.2 +257300 IF NOT-EOF-FLAG = "NOT EXECUTED" SQ1064.2 +257400 PERFORM PASS SQ1064.2 +257500 ELSE SQ1064.2 +257600 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +257700 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +257800 MOVE "NOT END PATH EXECUTED AT EOF" TO RE-MARK SQ1064.2 +257900 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +258000 PERFORM FAIL. SQ1064.2 +258100 SEQ-TEST-26-02-END. SQ1064.2 +258200* SQ1064.2 +258300* SQ1064.2 +258400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +258500* SQ1064.2 +258600 ADD 1 TO REC-CT. SQ1064.2 +258700 IF DELETE-SW NOT = SPACE SQ1064.2 +258800 GO TO SEQ-DELETE-26-03. SQ1064.2 +258900 GO TO SEQ-TEST-RD-26-03. SQ1064.2 +259000 SEQ-DELETE-26-03. SQ1064.2 +259100 PERFORM DE-LETE. SQ1064.2 +259200 GO TO SEQ-TEST-26-03-END. SQ1064.2 +259300 SEQ-TEST-RD-26-03. SQ1064.2 +259400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +259500 PERFORM PASS SQ1064.2 +259600 ELSE SQ1064.2 +259700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +259800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +259900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +260000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +260100 PERFORM FAIL. SQ1064.2 +260200 SEQ-TEST-26-03-END. SQ1064.2 +260300* SQ1064.2 +260400* CHECK EXECUTION OF THE END PATH SQ1064.2 +260500* SQ1064.2 +260600 ADD 1 TO REC-CT. SQ1064.2 +260700 IF DELETE-SW NOT = SPACE SQ1064.2 +260800 GO TO SEQ-DELETE-26-04. SQ1064.2 +260900 GO TO SEQ-TEST-RD-26-04. SQ1064.2 +261000 SEQ-DELETE-26-04. SQ1064.2 +261100 PERFORM DE-LETE. SQ1064.2 +261200 GO TO SEQ-TEST-26-04-END. SQ1064.2 +261300 SEQ-TEST-RD-26-04. SQ1064.2 +261400 IF EOF-FLAG = "EXECUTED" SQ1064.2 +261500 PERFORM PASS SQ1064.2 +261600 ELSE SQ1064.2 +261700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +261800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +261900 MOVE "AT END BRANCH NOT TAKEN AT EOF" TO RE-MARK SQ1064.2 +262000 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +262100 PERFORM FAIL. SQ1064.2 +262200 SEQ-TEST-26-04-END. SQ1064.2 +262300 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +262400* SQ1064.2 +262500* SQ1064.2 +262600* THE END OF THE FILE HAS BEEN REACHED, SO IT CAN BE CLOSED SQ1064.2 +262700* SQ1064.2 +262800 SEQ-INIT-27. SQ1064.2 +262900 MOVE 1 TO REC-CT. SQ1064.2 +263000 MOVE "CLOSE FILE AFTER READING" TO FEATURE. SQ1064.2 +263100 MOVE "SEQ-TEST-CL-27" TO PAR-NAME. SQ1064.2 +263200 MOVE "**" TO SQ-STATUS. SQ1064.2 +263300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +263400 GO TO SEQ-DELETE-27. SQ1064.2 +263500 GO TO SEQ-TEST-CL-27. SQ1064.2 +263600 SEQ-DELETE-27. SQ1064.2 +263700 GO TO SEQ-DELETE-27-01. SQ1064.2 +263800 SEQ-TEST-CL-27. SQ1064.2 +263900 CLOSE SQ-VS6. SQ1064.2 +264000 GO TO SEQ-TEST-CL-27-01. SQ1064.2 +264100 SEQ-DELETE-27-01. SQ1064.2 +264200 PERFORM DE-LETE. SQ1064.2 +264300 GO TO SEQ-TEST-27-01-END. SQ1064.2 +264400 SEQ-TEST-CL-27-01. SQ1064.2 +264500 IF SQ-STATUS = "00" SQ1064.2 +264600 PERFORM PASS SQ1064.2 +264700 ELSE SQ1064.2 +264800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +264900 MOVE "00" TO CORRECT-A SQ1064.2 +265000 MOVE "UNEXPECTED I-O STATUS FROM CLOSE" TO RE-MARK SQ1064.2 +265100 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1064.2 +265200 PERFORM FAIL. SQ1064.2 +265300 SEQ-TEST-27-01-END. SQ1064.2 +265400* SQ1064.2 +265500* SQ1064.2 +265600 TERMINATE-ROUTINE. SQ1064.2 +265700 EXIT. SQ1064.2 +265800 CCVS-EXIT SECTION. SQ1064.2 +265900 CCVS-999999. SQ1064.2 +266000 GO TO CLOSE-FILES. SQ1064.2 +*END-OF,SQ106A +*HEADER,COBOL,SQ107A +000100 IDENTIFICATION DIVISION. SQ1074.2 +000200 PROGRAM-ID. SQ1074.2 +000300 SQ107A. SQ1074.2 +000400**************************************************************** SQ1074.2 +000500* * SQ1074.2 +000600* VALIDATION FOR:- * SQ1074.2 +000700* " HIGH ". SQ1074.2 +000800* * SQ1074.2 +000900* CREATION DATE / VALIDATION DATE * SQ1074.2 +001000* "4.2 ". SQ1074.2 +001100* * SQ1074.2 +001200**************************************************************** SQ1074.2 +001300 SQ1074.2 +001400* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ1074.2 +001500* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ1074.2 +001600* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ1074.2 +001700* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ1074.2 +001800* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ1074.2 +001900* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ1074.2 +002000* AGAINST THE EXPECTED VALUES. SQ1074.2 +002100* SQ1074.2 +002200* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ1074.2 +002300* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ1074.2 +002400* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ1074.2 +002500* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ1074.2 +002600* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ1074.2 +002700* SQ1074.2 +002800* NEW FEATURE: THE LOGICAL RECORD EXTEND ACROSS THE PHYSICAL SQ1074.2 +002900* RECORD. (VII-23; 3.3.3 (2) A) SQ1074.2 +003000* SQ1074.2 +003100* SQ1074.2 +003200* USED X-CARDS: SQ1074.2 +003300* XXXXX014 SQ1074.2 +003400* XXXXX055 SQ1074.2 +003500* P XXXXX062 SQ1074.2 +003600* XXXXX082 SQ1074.2 +003700* XXXXX083 SQ1074.2 +003800* C XXXXX084 SQ1074.2 +003900* SQ1074.2 +004000* SQ1074.2 +004100 ENVIRONMENT DIVISION. SQ1074.2 +004200 CONFIGURATION SECTION. SQ1074.2 +004300 SOURCE-COMPUTER. SQ1074.2 +004400 XXXXX082. SQ1074.2 +004500 OBJECT-COMPUTER. SQ1074.2 +004600 XXXXX083. SQ1074.2 +004700 INPUT-OUTPUT SECTION. SQ1074.2 +004800 FILE-CONTROL. SQ1074.2 +004900P SELECT RAW-DATA ASSIGN TO SQ1074.2 +005000P XXXXX062 SQ1074.2 +005100P ORGANIZATION IS INDEXED SQ1074.2 +005200P ACCESS MODE IS RANDOM SQ1074.2 +005300P RECORD KEY IS RAW-DATA-KEY. SQ1074.2 +005400 SELECT PRINT-FILE ASSIGN TO SQ1074.2 +005500 XXXXX055. SQ1074.2 +005600 SELECT SQ-VS7 ASSIGN TO SQ1074.2 +005700 XXXXX014 SQ1074.2 +005800 ORGANIZATION SEQUENTIAL SQ1074.2 +005900 ACCESS SEQUENTIAL. SQ1074.2 +006000 DATA DIVISION. SQ1074.2 +006100 FILE SECTION. SQ1074.2 +006200P SQ1074.2 +006300PFD RAW-DATA. SQ1074.2 +006400P SQ1074.2 +006500P01 RAW-DATA-SATZ. SQ1074.2 +006600P 05 RAW-DATA-KEY PIC X(6). SQ1074.2 +006700P 05 C-DATE PIC 9(6). SQ1074.2 +006800P 05 C-TIME PIC 9(8). SQ1074.2 +006900P 05 C-NO-OF-TESTS PIC 99. SQ1074.2 +007000P 05 C-OK PIC 999. SQ1074.2 +007100P 05 C-ALL PIC 999. SQ1074.2 +007200P 05 C-FAIL PIC 999. SQ1074.2 +007300P 05 C-DELETED PIC 999. SQ1074.2 +007400P 05 C-INSPECT PIC 999. SQ1074.2 +007500P 05 C-NOTE PIC X(13). SQ1074.2 +007600P 05 C-INDENT PIC X. SQ1074.2 +007700P 05 C-ABORT PIC X(8). SQ1074.2 +007800 FD PRINT-FILE SQ1074.2 +007900C LABEL RECORDS SQ1074.2 +008000C XXXXX084 SQ1074.2 +008100C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1074.2 +008200 . SQ1074.2 +008300 01 PRINT-REC PICTURE X(120). SQ1074.2 +008400 01 DUMMY-RECORD PICTURE X(120). SQ1074.2 +008500 FD SQ-VS7 SQ1074.2 +008600C LABEL RECORDS ARE STANDARD SQ1074.2 +008700 BLOCK CONTAINS 100 CHARACTERS. SQ1074.2 +008800 01 SQ-VS7R1-M-G-120. SQ1074.2 +008900 02 SQ-VS7R1-FIRST PICTURE X(120). SQ1074.2 +009000 01 SQ-VS7R2-M-G-151. SQ1074.2 +009100 02 SQ-VS7R2-FIRST PICTURE X(120). SQ1074.2 +009200 02 LONG-OR-SHORT PICTURE X(5). SQ1074.2 +009300 02 SQ-VS7-RECNO PICTURE X(5). SQ1074.2 +009400 02 SQ-VS7-FILLER PICTURE X(21). SQ1074.2 +009500 WORKING-STORAGE SECTION. SQ1074.2 +009600 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ1074.2 +009700 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ1074.2 +009800 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ1074.2 +009900 01 ERROR-FLAG PICTURE 9. SQ1074.2 +010000 01 EOF-FLAG PICTURE 9. SQ1074.2 +010100 01 DUMP-AREA. SQ1074.2 +010200 02 TYPE-OF-REC PICTURE X(5). SQ1074.2 +010300 02 RECNO PICTURE 9(5). SQ1074.2 +010400 02 REC-FILLER PICTURE X(21). SQ1074.2 +010500 01 FILE-RECORD-INFORMATION-REC. SQ1074.2 +010600 03 FILE-RECORD-INFO-SKELETON. SQ1074.2 +010700 05 FILLER PICTURE X(48) VALUE SQ1074.2 +010800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1074.2 +010900 05 FILLER PICTURE X(46) VALUE SQ1074.2 +011000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1074.2 +011100 05 FILLER PICTURE X(26) VALUE SQ1074.2 +011200 ",LFIL=000000,ORG= ,LBLR= ". SQ1074.2 +011300 05 FILLER PICTURE X(37) VALUE SQ1074.2 +011400 ",RECKEY= ". SQ1074.2 +011500 05 FILLER PICTURE X(38) VALUE SQ1074.2 +011600 ",ALTKEY1= ". SQ1074.2 +011700 05 FILLER PICTURE X(38) VALUE SQ1074.2 +011800 ",ALTKEY2= ". SQ1074.2 +011900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1074.2 +012000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1074.2 +012100 05 FILE-RECORD-INFO-P1-120. SQ1074.2 +012200 07 FILLER PIC X(5). SQ1074.2 +012300 07 XFILE-NAME PIC X(6). SQ1074.2 +012400 07 FILLER PIC X(8). SQ1074.2 +012500 07 XRECORD-NAME PIC X(6). SQ1074.2 +012600 07 FILLER PIC X(1). SQ1074.2 +012700 07 REELUNIT-NUMBER PIC 9(1). SQ1074.2 +012800 07 FILLER PIC X(7). SQ1074.2 +012900 07 XRECORD-NUMBER PIC 9(6). SQ1074.2 +013000 07 FILLER PIC X(6). SQ1074.2 +013100 07 UPDATE-NUMBER PIC 9(2). SQ1074.2 +013200 07 FILLER PIC X(5). SQ1074.2 +013300 07 ODO-NUMBER PIC 9(4). SQ1074.2 +013400 07 FILLER PIC X(5). SQ1074.2 +013500 07 XPROGRAM-NAME PIC X(5). SQ1074.2 +013600 07 FILLER PIC X(7). SQ1074.2 +013700 07 XRECORD-LENGTH PIC 9(6). SQ1074.2 +013800 07 FILLER PIC X(7). SQ1074.2 +013900 07 CHARS-OR-RECORDS PIC X(2). SQ1074.2 +014000 07 FILLER PIC X(1). SQ1074.2 +014100 07 XBLOCK-SIZE PIC 9(4). SQ1074.2 +014200 07 FILLER PIC X(6). SQ1074.2 +014300 07 RECORDS-IN-FILE PIC 9(6). SQ1074.2 +014400 07 FILLER PIC X(5). SQ1074.2 +014500 07 XFILE-ORGANIZATION PIC X(2). SQ1074.2 +014600 07 FILLER PIC X(6). SQ1074.2 +014700 07 XLABEL-TYPE PIC X(1). SQ1074.2 +014800 05 FILE-RECORD-INFO-P121-240. SQ1074.2 +014900 07 FILLER PIC X(8). SQ1074.2 +015000 07 XRECORD-KEY PIC X(29). SQ1074.2 +015100 07 FILLER PIC X(9). SQ1074.2 +015200 07 ALTERNATE-KEY1 PIC X(29). SQ1074.2 +015300 07 FILLER PIC X(9). SQ1074.2 +015400 07 ALTERNATE-KEY2 PIC X(29). SQ1074.2 +015500 07 FILLER PIC X(7). SQ1074.2 +015600 01 TEST-RESULTS. SQ1074.2 +015700 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +015800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1074.2 +015900 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +016000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1074.2 +016100 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +016200 02 PAR-NAME. SQ1074.2 +016300 03 FILLER PICTURE X(12) VALUE SPACE. SQ1074.2 +016400 03 PARDOT-X PICTURE X VALUE SPACE. SQ1074.2 +016500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1074.2 +016600 03 FILLER PIC X(5) VALUE SPACE. SQ1074.2 +016700 02 FILLER PIC X(10) VALUE SPACE. SQ1074.2 +016800 02 RE-MARK PIC X(61). SQ1074.2 +016900 01 TEST-COMPUTED. SQ1074.2 +017000 02 FILLER PIC X(30) VALUE SPACE. SQ1074.2 +017100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1074.2 +017200 02 COMPUTED-X. SQ1074.2 +017300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1074.2 +017400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1074.2 +017500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1074.2 +017600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1074.2 +017700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1074.2 +017800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1074.2 +017900 04 COMPUTED-18V0 PICTURE -9(18). SQ1074.2 +018000 04 FILLER PICTURE X. SQ1074.2 +018100 03 FILLER PIC X(50) VALUE SPACE. SQ1074.2 +018200 01 TEST-CORRECT. SQ1074.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1074.2 +018400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1074.2 +018500 02 CORRECT-X. SQ1074.2 +018600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1074.2 +018700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1074.2 +018800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1074.2 +018900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1074.2 +019000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1074.2 +019100 03 CR-18V0 REDEFINES CORRECT-A. SQ1074.2 +019200 04 CORRECT-18V0 PICTURE -9(18). SQ1074.2 +019300 04 FILLER PICTURE X. SQ1074.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1074.2 +019500 01 CCVS-C-1. SQ1074.2 +019600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1074.2 +019700- "SS PARAGRAPH-NAME SQ1074.2 +019800- " REMARKS". SQ1074.2 +019900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1074.2 +020000 01 CCVS-C-2. SQ1074.2 +020100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +020200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1074.2 +020300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1074.2 +020400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1074.2 +020500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1074.2 +020600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1074.2 +020700 01 REC-CT PICTURE 99 VALUE ZERO. SQ1074.2 +020800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1074.2 +020900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1074.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1074.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1074.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1074.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1074.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1074.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1074.2 +021600 01 CCVS-H-1. SQ1074.2 +021700 02 FILLER PICTURE X(27) VALUE SPACE. SQ1074.2 +021800 02 FILLER PICTURE X(67) VALUE SQ1074.2 +021900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1074.2 +022000- " SYSTEM". SQ1074.2 +022100 02 FILLER PICTURE X(26) VALUE SPACE. SQ1074.2 +022200 01 CCVS-H-2. SQ1074.2 +022300 02 FILLER PICTURE X(52) VALUE IS SQ1074.2 +022400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1074.2 +022500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1074.2 +022600 02 TEST-ID PICTURE IS X(9). SQ1074.2 +022700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1074.2 +022800 01 CCVS-H-3. SQ1074.2 +022900 02 FILLER PICTURE X(34) VALUE SQ1074.2 +023000 " FOR OFFICIAL USE ONLY ". SQ1074.2 +023100 02 FILLER PICTURE X(58) VALUE SQ1074.2 +023200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1074.2 +023300 02 FILLER PICTURE X(28) VALUE SQ1074.2 +023400 " COPYRIGHT 1985 ". SQ1074.2 +023500 01 CCVS-E-1. SQ1074.2 +023600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1074.2 +023700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1074.2 +023800 02 ID-AGAIN PICTURE IS X(9). SQ1074.2 +023900 02 FILLER PICTURE X(45) VALUE IS SQ1074.2 +024000 " NTIS DISTRIBUTION COBOL 85". SQ1074.2 +024100 01 CCVS-E-2. SQ1074.2 +024200 02 FILLER PICTURE X(31) VALUE SQ1074.2 +024300 SPACE. SQ1074.2 +024400 02 FILLER PICTURE X(21) VALUE SPACE. SQ1074.2 +024500 02 CCVS-E-2-2. SQ1074.2 +024600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1074.2 +024700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +024800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1074.2 +024900 01 CCVS-E-3. SQ1074.2 +025000 02 FILLER PICTURE X(22) VALUE SQ1074.2 +025100 " FOR OFFICIAL USE ONLY". SQ1074.2 +025200 02 FILLER PICTURE X(12) VALUE SPACE. SQ1074.2 +025300 02 FILLER PICTURE X(58) VALUE SQ1074.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1074.2 +025500 02 FILLER PICTURE X(13) VALUE SPACE. SQ1074.2 +025600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1074.2 +025700 01 CCVS-E-4. SQ1074.2 +025800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1074.2 +025900 02 FILLER PIC XXXX VALUE " OF ". SQ1074.2 +026000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1074.2 +026100 02 FILLER PIC X(40) VALUE SQ1074.2 +026200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1074.2 +026300 01 XXINFO. SQ1074.2 +026400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1074.2 +026500 02 INFO-TEXT. SQ1074.2 +026600 04 FILLER PIC X(20) VALUE SPACE. SQ1074.2 +026700 04 XXCOMPUTED PIC X(20). SQ1074.2 +026800 04 FILLER PIC X(5) VALUE SPACE. SQ1074.2 +026900 04 XXCORRECT PIC X(20). SQ1074.2 +027000 01 HYPHEN-LINE. SQ1074.2 +027100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +027200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1074.2 +027300- "*****************************************". SQ1074.2 +027400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1074.2 +027500- "******************************". SQ1074.2 +027600 01 CCVS-PGM-ID PIC X(6) VALUE SQ1074.2 +027700 "SQ107A". SQ1074.2 +027800 PROCEDURE DIVISION. SQ1074.2 +027900 CCVS1 SECTION. SQ1074.2 +028000 OPEN-FILES. SQ1074.2 +028100P OPEN I-O RAW-DATA. SQ1074.2 +028200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1074.2 +028300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1074.2 +028400P MOVE "ABORTED " TO C-ABORT. SQ1074.2 +028500P ADD 1 TO C-NO-OF-TESTS. SQ1074.2 +028600P ACCEPT C-DATE FROM DATE. SQ1074.2 +028700P ACCEPT C-TIME FROM TIME. SQ1074.2 +028800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1074.2 +028900PEND-E-1. SQ1074.2 +029000P CLOSE RAW-DATA. SQ1074.2 +029100 OPEN OUTPUT PRINT-FILE. SQ1074.2 +029200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1074.2 +029300 MOVE SPACE TO TEST-RESULTS. SQ1074.2 +029400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1074.2 +029500 MOVE ZERO TO REC-SKL-SUB. SQ1074.2 +029600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1074.2 +029700 CCVS-INIT-FILE. SQ1074.2 +029800 ADD 1 TO REC-SKL-SUB. SQ1074.2 +029900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1074.2 +030000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1074.2 +030100 CCVS-INIT-EXIT. SQ1074.2 +030200 GO TO CCVS1-EXIT. SQ1074.2 +030300 CLOSE-FILES. SQ1074.2 +030400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1074.2 +030500P OPEN I-O RAW-DATA. SQ1074.2 +030600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1074.2 +030700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1074.2 +030800P MOVE "OK. " TO C-ABORT. SQ1074.2 +030900P MOVE PASS-COUNTER TO C-OK. SQ1074.2 +031000P MOVE ERROR-HOLD TO C-ALL. SQ1074.2 +031100P MOVE ERROR-COUNTER TO C-FAIL. SQ1074.2 +031200P MOVE DELETE-CNT TO C-DELETED. SQ1074.2 +031300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1074.2 +031400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1074.2 +031500PEND-E-2. SQ1074.2 +031600P CLOSE RAW-DATA. SQ1074.2 +031700 TERMINATE-CCVS. SQ1074.2 +031800S EXIT PROGRAM. SQ1074.2 +031900STERMINATE-CALL. SQ1074.2 +032000 STOP RUN. SQ1074.2 +032100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1074.2 +032200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1074.2 +032300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1074.2 +032400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1074.2 +032500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1074.2 +032600 PRINT-DETAIL. SQ1074.2 +032700 IF REC-CT NOT EQUAL TO ZERO SQ1074.2 +032800 MOVE "." TO PARDOT-X SQ1074.2 +032900 MOVE REC-CT TO DOTVALUE. SQ1074.2 +033000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1074.2 +033100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1074.2 +033200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1074.2 +033300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1074.2 +033400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1074.2 +033500 MOVE SPACE TO CORRECT-X. SQ1074.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1074.2 +033700 MOVE SPACE TO RE-MARK. SQ1074.2 +033800 HEAD-ROUTINE. SQ1074.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +034000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1074.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1074.2 +034200 COLUMN-NAMES-ROUTINE. SQ1074.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +034600 END-ROUTINE. SQ1074.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1074.2 +034800 END-RTN-EXIT. SQ1074.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +035000 END-ROUTINE-1. SQ1074.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1074.2 +035200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1074.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1074.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1074.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1074.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1074.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1074.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1074.2 +035900 END-ROUTINE-12. SQ1074.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1074.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1074.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ1074.2 +036300 ELSE SQ1074.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1074.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1074.2 +036600 PERFORM WRITE-LINE. SQ1074.2 +036700 END-ROUTINE-13. SQ1074.2 +036800 IF DELETE-CNT IS EQUAL TO ZERO SQ1074.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE SQ1074.2 +037000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1074.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1074.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO SQ1074.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ1074.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1074.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1074.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037900 WRITE-LINE. SQ1074.2 +038000 ADD 1 TO RECORD-COUNT. SQ1074.2 +038100Y IF RECORD-COUNT GREATER 50 SQ1074.2 +038200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1074.2 +038300Y MOVE SPACE TO DUMMY-RECORD SQ1074.2 +038400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1074.2 +038500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1074.2 +038600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1074.2 +038700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1074.2 +038800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1074.2 +038900Y MOVE ZERO TO RECORD-COUNT. SQ1074.2 +039000 PERFORM WRT-LN. SQ1074.2 +039100 WRT-LN. SQ1074.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1074.2 +039300 MOVE SPACE TO DUMMY-RECORD. SQ1074.2 +039400 BLANK-LINE-PRINT. SQ1074.2 +039500 PERFORM WRT-LN. SQ1074.2 +039600 FAIL-ROUTINE. SQ1074.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1074.2 +039800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1074.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1074.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +040100 GO TO FAIL-ROUTINE-EX. SQ1074.2 +040200 FAIL-ROUTINE-WRITE. SQ1074.2 +040300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1074.2 +040400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +040500 FAIL-ROUTINE-EX. EXIT. SQ1074.2 +040600 BAIL-OUT. SQ1074.2 +040700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1074.2 +040800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1074.2 +040900 BAIL-OUT-WRITE. SQ1074.2 +041000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1074.2 +041100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +041200 BAIL-OUT-EX. EXIT. SQ1074.2 +041300 CCVS1-EXIT. SQ1074.2 +041400 EXIT. SQ1074.2 +041500 SECT-SQ107A-0001 SECTION. SQ1074.2 +041600 SEQ-INIT-017. SQ1074.2 +041700 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ1074.2 +041800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1074.2 +041900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1074.2 +042000 MOVE 0001 TO XBLOCK-SIZE (1). SQ1074.2 +042100 MOVE 000450 TO RECORDS-IN-FILE (1). SQ1074.2 +042200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1074.2 +042300 MOVE "S" TO XLABEL-TYPE (1). SQ1074.2 +042400 MOVE 000000 TO XRECORD-NUMBER (1). SQ1074.2 +042500 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +042600 OPEN OUTPUT SQ-VS7. SQ1074.2 +042700 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ1074.2 +042800 SEQ-TEST-017. SQ1074.2 +042900 PERFORM WRITE-SHORT-REC. SQ1074.2 +043000 PERFORM WRITE-LONG-REC. SQ1074.2 +043100 PERFORM WRITE-SHORT-REC 10 TIMES. SQ1074.2 +043200 PERFORM WRITE-LONG-REC 100 TIMES. SQ1074.2 +043300 PERFORM WRITE-SHORT-REC 338 TIMES. SQ1074.2 +043400 SEQ-WRITE-017. SQ1074.2 +043500 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ1074.2 +043600 MOVE "SEQ-TEST-017" TO PAR-NAME. SQ1074.2 +043700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1074.2 +043800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1074.2 +043900 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ1074.2 +044000 PERFORM PRINT-DETAIL. SQ1074.2 +044100* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ1074.2 +044200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ1074.2 +044300* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ1074.2 +044400* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ1074.2 +044500* 100L-338S. SQ1074.2 +044600 SEQ-CLOSE-017. SQ1074.2 +044700 CLOSE SQ-VS7. SQ1074.2 +044800 GO TO READ-INIT-GF-01. SQ1074.2 +044900 WRITE-SHORT-REC. SQ1074.2 +045000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1074.2 +045100 MOVE 000120 TO XRECORD-LENGTH (1). SQ1074.2 +045200 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +045300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1074.2 +045400 MOVE "SHORT" TO LONG-OR-SHORT. SQ1074.2 +045500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ1074.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ1074.2 +045700 WRITE SQ-VS7R1-M-G-120. SQ1074.2 +045800 WRITE-LONG-REC. SQ1074.2 +045900 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1074.2 +046000 MOVE 000151 TO XRECORD-LENGTH (1). SQ1074.2 +046100 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +046200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1074.2 +046300 MOVE "LONG" TO LONG-OR-SHORT. SQ1074.2 +046400 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ1074.2 +046500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ1074.2 +046600 WRITE SQ-VS7R2-M-G-151. SQ1074.2 +046700 READ-INIT-GF-01. SQ1074.2 +046800 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +046900 MOVE ZERO TO EOF-FLAG. SQ1074.2 +047000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1074.2 +047100 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +047200 OPEN INPUT SQ-VS7. SQ1074.2 +047300 READ-TEST-GF-01. SQ1074.2 +047400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ1074.2 +047500 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +047600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ1074.2 +047700 GO TO SEQ-EOF-018. SQ1074.2 +047800 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +047900 GO TO READ-FAIL-GF-01. SQ1074.2 +048000 READ-PASS-GF-01. SQ1074.2 +048100 PERFORM PASS. SQ1074.2 +048200 GO TO READ-WRITE-GF-01. SQ1074.2 +048300 READ-FAIL-GF-01. SQ1074.2 +048400 PERFORM FAIL. SQ1074.2 +048500 MOVE "ERROR ON FIRST READ" TO RE-MARK. SQ1074.2 +048600 READ-WRITE-GF-01. SQ1074.2 +048700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +048800 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1074.2 +048900 PERFORM PRINT-DETAIL. SQ1074.2 +049000 GO TO READ-INIT-GF-02. SQ1074.2 +049100 READ-SHORT-REC. SQ1074.2 +049200 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +049300 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +049400 READ SQ-VS7 AT END SQ1074.2 +049500 MOVE 1 TO EOF-FLAG SQ1074.2 +049600 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +049700 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +049800 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1074.2 +049900 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ1074.2 +050000 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050100 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ1074.2 +050200 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1074.2 +050400 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050500 IF XLABEL-TYPE (1) EQUAL TO "S" SQ1074.2 +050600 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +050700 READ-SHORT-REC-ERROR. SQ1074.2 +050800 ADD 1 TO RECORDS-IN-ERROR. SQ1074.2 +050900 MOVE 1 TO ERROR-FLAG. SQ1074.2 +051000 READ-SHORT-REC-EXIT. SQ1074.2 +051100 EXIT. SQ1074.2 +051200 READ-INIT-GF-02. SQ1074.2 +051300 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +051400 READ-TEST-GF-02. SQ1074.2 +051500 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ1074.2 +051600 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +051700 MOVE "EOF ON SECOND READ" TO RE-MARK SQ1074.2 +051800 GO TO SEQ-EOF-018. SQ1074.2 +051900 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +052000 GO TO READ-FAIL-GF-02. SQ1074.2 +052100 READ-PASS-GF-02. SQ1074.2 +052200 PERFORM PASS. SQ1074.2 +052300 GO TO READ-WRITE-GF-02. SQ1074.2 +052400 READ-FAIL-GF-02. SQ1074.2 +052500 PERFORM FAIL. SQ1074.2 +052600 MOVE "VII-23; ERROR ON SECOND READ" TO RE-MARK. SQ1074.2 +052700 READ-WRITE-GF-02. SQ1074.2 +052800 MOVE "READ LONG RECORD" TO FEATURE. SQ1074.2 +052900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1074.2 +053000 PERFORM PRINT-DETAIL. SQ1074.2 +053100 GO TO READ-INIT-GF-03. SQ1074.2 +053200 READ-LONG-REC. SQ1074.2 +053300 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +053400 GO TO READ-LONG-REC-EXIT. SQ1074.2 +053500 READ SQ-VS7 END SQ1074.2 +053600 MOVE 1 TO EOF-FLAG SQ1074.2 +053700 GO TO READ-LONG-REC-EXIT. SQ1074.2 +053800 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +053900 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1074.2 +054000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ1074.2 +054100 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ1074.2 +054300 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ1074.2 +054500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ1074.2 +054600 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ1074.2 +054800 GO TO READ-LONG-REC-EXIT. SQ1074.2 +054900 READ-LONG-REC-ERROR. SQ1074.2 +055000 ADD 1 TO RECORDS-IN-ERROR. SQ1074.2 +055100 MOVE 1 TO ERROR-FLAG. SQ1074.2 +055200 READ-LONG-REC-EXIT. SQ1074.2 +055300 EXIT. SQ1074.2 +055400 READ-INIT-GF-03. SQ1074.2 +055500 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +055600 READ-TEST-GF-03. SQ1074.2 +055700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ1074.2 +055800 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +055900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +056000 GO TO SEQ-EOF-018. SQ1074.2 +056100 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +056200 GO TO READ-FAIL-GF-03. SQ1074.2 +056300 READ-PASS-GF-03. SQ1074.2 +056400 PERFORM PASS. SQ1074.2 +056500 GO TO READ-WRITE-GF-03. SQ1074.2 +056600 READ-FAIL-GF-03. SQ1074.2 +056700 MOVE "VII-23; ERROR READING SHORT RECORD" TO RE-MARK. SQ1074.2 +056800 PERFORM FAIL. SQ1074.2 +056900 READ-WRITE-GF-03. SQ1074.2 +057000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ1074.2 +057100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1074.2 +057200 PERFORM PRINT-DETAIL. SQ1074.2 +057300 READ-INIT-GF-04. SQ1074.2 +057400 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +057500 READ-TEST-GF-04. SQ1074.2 +057600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ1074.2 +057700 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +057800 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +057900 GO TO SEQ-EOF-018. SQ1074.2 +058000 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +058100 GO TO READ-FAIL-GF-04. SQ1074.2 +058200 READ-PASS-GF-04. SQ1074.2 +058300 PERFORM PASS. SQ1074.2 +058400 GO TO READ-WRITE-GF-04. SQ1074.2 +058500 READ-FAIL-GF-04. SQ1074.2 +058600 PERFORM FAIL. SQ1074.2 +058700 MOVE "VII-23; ERROR READING LONG RECORD" TO RE-MARK. SQ1074.2 +058800 READ-WRITE-GF-04. SQ1074.2 +058900 MOVE "READ LONG RECORDS" TO FEATURE. SQ1074.2 +059000 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1074.2 +059100 PERFORM PRINT-DETAIL. SQ1074.2 +059200 READ-INIT-GF-06. SQ1074.2 +059300 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +059400 READ-TEST-GF-05. SQ1074.2 +059500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ1074.2 +059600 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +059700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +059800 GO TO SEQ-EOF-018. SQ1074.2 +059900 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +060000 GO TO READ-FAIL-GF-05. SQ1074.2 +060100 READ-PASS-GF-05. SQ1074.2 +060200 PERFORM PASS. SQ1074.2 +060300 GO TO READ-WRITE-GF-05. SQ1074.2 +060400 READ-FAIL-GF-05. SQ1074.2 +060500 PERFORM FAIL. SQ1074.2 +060600 MOVE "VII-23; ERROR READING SHORT RECORD" TO RE-MARK. SQ1074.2 +060700 READ-WRITE-GF-05. SQ1074.2 +060800 MOVE "READ SHORT RECORDS" TO FEATURE. SQ1074.2 +060900 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1074.2 +061000 PERFORM PRINT-DETAIL. SQ1074.2 +061100 SEQ-INIT-018. SQ1074.2 +061200 READ SQ-VS7 RECORD END SQ1074.2 +061300 GO TO SEQ-TEST-018. SQ1074.2 +061400 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ1074.2 +061500 GO TO SEQ-FAIL-018. SQ1074.2 +061600 SEQ-EOF-018. SQ1074.2 +061700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1074.2 +061800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1074.2 +061900 GO TO SEQ-FAIL-018. SQ1074.2 +062000 SEQ-TEST-018. SQ1074.2 +062100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1074.2 +062200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1074.2 +062300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1074.2 +062400 GO TO SEQ-FAIL-018. SQ1074.2 +062500 SEQ-PASS-018. SQ1074.2 +062600 PERFORM PASS. SQ1074.2 +062700 GO TO SEQ-WRITE-018. SQ1074.2 +062800 SEQ-FAIL-018. SQ1074.2 +062900 PERFORM FAIL. SQ1074.2 +063000 SEQ-WRITE-018. SQ1074.2 +063100 MOVE "SEQ-TEST-018" TO PAR-NAME. SQ1074.2 +063200 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ1074.2 +063300 PERFORM PRINT-DETAIL. SQ1074.2 +063400 SEQ-CLOSE-018. SQ1074.2 +063500 CLOSE SQ-VS7. SQ1074.2 +063600 SECT-SQ107A-0002 SECTION. SQ1074.2 +063700* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ1074.2 +063800* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ1074.2 +063900* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ1074.2 +064000* 130 IS UNIQUE FOR EACH RECORD. SQ1074.2 +064100 INFO-INIT-004. SQ1074.2 +064200 OPEN INPUT SQ-VS7. SQ1074.2 +064300 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +064400 INFO-TEST-004. SQ1074.2 +064500 READ SQ-VS7 AT END SQ1074.2 +064600 GO TO INFO-END. SQ1074.2 +064700 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +064800 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ1074.2 +064900 GO TO NO-INFO-004. SQ1074.2 +065000 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +065100 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +065200 MOVE 0001 TO CORRECT-18V0. SQ1074.2 +065300 GO TO INFO-WRITE-004. SQ1074.2 +065400 NO-INFO-004. SQ1074.2 +065500 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +065600 INFO-WRITE-004. SQ1074.2 +065700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +065800 MOVE "SEQ-INFO-004" TO PAR-NAME. SQ1074.2 +065900 PERFORM PRINT-DETAIL. SQ1074.2 +066000 INFO-INIT-005. SQ1074.2 +066100 READ SQ-VS7 RECORD AT END SQ1074.2 +066200 GO TO INFO-END. SQ1074.2 +066300 READ SQ-VS7 END SQ1074.2 +066400 GO TO INFO-END. SQ1074.2 +066500 INFO-TEST-005. SQ1074.2 +066600 READ SQ-VS7 AT END SQ1074.2 +066700 GO TO INFO-END. SQ1074.2 +066800 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ1074.2 +066900 GO TO NO-INFO-005. SQ1074.2 +067000 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +067100 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +067200 MOVE 0004 TO CORRECT-18V0. SQ1074.2 +067300 GO TO INFO-WRITE-005. SQ1074.2 +067400 NO-INFO-005. SQ1074.2 +067500 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +067600 INFO-WRITE-005. SQ1074.2 +067700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +067800 MOVE "SEQ-INFO-005" TO PAR-NAME. SQ1074.2 +067900 PERFORM PRINT-DETAIL. SQ1074.2 +068000 INFO-INIT-006. SQ1074.2 +068100 ADD 3 TO COUNT-OF-RECS. SQ1074.2 +068200 INFO-INIT-006-1. SQ1074.2 +068300 READ SQ-VS7 RECORD SQ1074.2 +068400 END GO TO INFO-END. SQ1074.2 +068500 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +068600 IF COUNT-OF-RECS EQUAL TO 450 SQ1074.2 +068700 GO TO INFO-TEST-006. SQ1074.2 +068800 GO TO INFO-INIT-006-1. SQ1074.2 +068900 INFO-TEST-006. SQ1074.2 +069000 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ1074.2 +069100 GO TO NO-INFO-006. SQ1074.2 +069200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +069300 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +069400 MOVE 0450 TO CORRECT-18V0. SQ1074.2 +069500 GO TO INFO-WRITE-006. SQ1074.2 +069600 NO-INFO-006. SQ1074.2 +069700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +069800 INFO-WRITE-006. SQ1074.2 +069900 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +070000 MOVE "SEQ-INFO-006" TO PAR-NAME. SQ1074.2 +070100 PERFORM PRINT-DETAIL. SQ1074.2 +070200 INFO-END. SQ1074.2 +070300 CLOSE SQ-VS7. SQ1074.2 +070400 TERMINATE-ROUTINE. SQ1074.2 +070500 EXIT. SQ1074.2 +070600 CCVS-EXIT SECTION. SQ1074.2 +070700 CCVS-999999. SQ1074.2 +070800 GO TO CLOSE-FILES. SQ1074.2 +*END-OF,SQ107A +*HEADER,COBOL,SQ108A +000100 IDENTIFICATION DIVISION. SQ1084.2 +000200 PROGRAM-ID. SQ1084.2 +000300 SQ108A. SQ1084.2 +000400**************************************************************** SQ1084.2 +000500* * SQ1084.2 +000600* VALIDATION FOR:- * SQ1084.2 +000700* " HIGH ". SQ1084.2 +000800* * SQ1084.2 +000900* CREATION DATE / VALIDATION DATE * SQ1084.2 +001000* "4.2 ". SQ1084.2 +001100* * SQ1084.2 +001200**************************************************************** SQ1084.2 +001300 SQ1084.2 +001400* THE ROUTINE SQ108A CREATES A FIXED LENGTH MASS STORAGE SQ1084.2 +001500* FILE. THE FILE IS CREATED USING WRITE STATEMENTS, VERIFIED SQ1084.2 +001600* IN SEQ-TEST-20 AND THEN READ USING READ...INTO STATEMENTS. SQ1084.2 +001700* THE READ...INTO TESTS CHECK FOR TRUNCATION AND BLANK FILL SQ1084.2 +001800* OF THE IDENTIFIER AREA. SQ1084.2 +001900* SQ1084.2 +002000* USED X-CARDS: SQ1084.2 +002100* XXXXX014 SQ1084.2 +002200* XXXXX055 SQ1084.2 +002300* P XXXXX062 SQ1084.2 +002400* XXXXX082 SQ1084.2 +002500* XXXXX083 SQ1084.2 +002600* C XXXXX084 SQ1084.2 +002700* SQ1084.2 +002800* SQ1084.2 +002900 ENVIRONMENT DIVISION. SQ1084.2 +003000 CONFIGURATION SECTION. SQ1084.2 +003100 SOURCE-COMPUTER. SQ1084.2 +003200 XXXXX082. SQ1084.2 +003300 OBJECT-COMPUTER. SQ1084.2 +003400 XXXXX083. SQ1084.2 +003500 INPUT-OUTPUT SECTION. SQ1084.2 +003600 FILE-CONTROL. SQ1084.2 +003700P SELECT RAW-DATA ASSIGN TO SQ1084.2 +003800P XXXXX062 SQ1084.2 +003900P ORGANIZATION IS INDEXED SQ1084.2 +004000P ACCESS MODE IS RANDOM SQ1084.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ1084.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1084.2 +004300 XXXXX055. SQ1084.2 +004400 SELECT SQ-FS8 ASSIGN TO SQ1084.2 +004500 XXXXX014 SQ1084.2 +004600 ORGANIZATION IS SEQUENTIAL SQ1084.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ1084.2 +004800 DATA DIVISION. SQ1084.2 +004900 FILE SECTION. SQ1084.2 +005000P SQ1084.2 +005100PFD RAW-DATA. SQ1084.2 +005200P SQ1084.2 +005300P01 RAW-DATA-SATZ. SQ1084.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ1084.2 +005500P 05 C-DATE PIC 9(6). SQ1084.2 +005600P 05 C-TIME PIC 9(8). SQ1084.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ1084.2 +005800P 05 C-OK PIC 999. SQ1084.2 +005900P 05 C-ALL PIC 999. SQ1084.2 +006000P 05 C-FAIL PIC 999. SQ1084.2 +006100P 05 C-DELETED PIC 999. SQ1084.2 +006200P 05 C-INSPECT PIC 999. SQ1084.2 +006300P 05 C-NOTE PIC X(13). SQ1084.2 +006400P 05 C-INDENT PIC X. SQ1084.2 +006500P 05 C-ABORT PIC X(8). SQ1084.2 +006600 FD PRINT-FILE SQ1084.2 +006700C LABEL RECORDS SQ1084.2 +006800C XXXXX084 SQ1084.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1084.2 +007000 . SQ1084.2 +007100 01 PRINT-REC PICTURE X(120). SQ1084.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1084.2 +007300 FD SQ-FS8 SQ1084.2 +007400C LABEL RECORD STANDARD SQ1084.2 +007500 BLOCK CONTAINS 1 RECORDS. SQ1084.2 +007600 01 SQ-FS8R1-F-G-141. SQ1084.2 +007700 02 SQ-FS8R1-PART1 PICTURE X(120). SQ1084.2 +007800 02 SQ-FS8R1-PART2 PICTURE X(21). SQ1084.2 +007900 WORKING-STORAGE SECTION. SQ1084.2 +008000 01 END-OF-RECORD-AREA. SQ1084.2 +008100 02 ALPHA-AREA PIC X(17). SQ1084.2 +008200 02 NUMBER-AREA PIC 9999. SQ1084.2 +008300 01 COUNT-OF-RECS PIC 9999. SQ1084.2 +008400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1084.2 +008500 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1084.2 +008600 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1084.2 +008700 01 READ-INTO-AREA1. SQ1084.2 +008800 02 AREA1-1 PIC X(87). SQ1084.2 +008900 01 FOLLOWS-AREA1 PIC X(10). SQ1084.2 +009000 01 READ-INTO-AREA2. SQ1084.2 +009100 02 AREA2-1 PIC X(120). SQ1084.2 +009200 01 FOLLOWS-AREA2 PIC X(10). SQ1084.2 +009300 01 READ-INTO-AREA3. SQ1084.2 +009400 02 AREA3-1 PIC X(141). SQ1084.2 +009500 02 AREA3-2 PIC X(7). SQ1084.2 +009600 01 READ-INTO-AREA4. SQ1084.2 +009700 02 AREA4-1 PICTURE X(120). SQ1084.2 +009800 02 AREA4-2 PICTURE X(21). SQ1084.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ1084.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ1084.2 +010100 05 FILLER PICTURE X(48) VALUE SQ1084.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1084.2 +010300 05 FILLER PICTURE X(46) VALUE SQ1084.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1084.2 +010500 05 FILLER PICTURE X(26) VALUE SQ1084.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ1084.2 +010700 05 FILLER PICTURE X(37) VALUE SQ1084.2 +010800 ",RECKEY= ". SQ1084.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1084.2 +011000 ",ALTKEY1= ". SQ1084.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1084.2 +011200 ",ALTKEY2= ". SQ1084.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1084.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1084.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ1084.2 +011600 07 FILLER PIC X(5). SQ1084.2 +011700 07 XFILE-NAME PIC X(6). SQ1084.2 +011800 07 FILLER PIC X(8). SQ1084.2 +011900 07 XRECORD-NAME PIC X(6). SQ1084.2 +012000 07 FILLER PIC X(1). SQ1084.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ1084.2 +012200 07 FILLER PIC X(7). SQ1084.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ1084.2 +012400 07 FILLER PIC X(6). SQ1084.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ1084.2 +012600 07 FILLER PIC X(5). SQ1084.2 +012700 07 ODO-NUMBER PIC 9(4). SQ1084.2 +012800 07 FILLER PIC X(5). SQ1084.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ1084.2 +013000 07 FILLER PIC X(7). SQ1084.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ1084.2 +013200 07 FILLER PIC X(7). SQ1084.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ1084.2 +013400 07 FILLER PIC X(1). SQ1084.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ1084.2 +013600 07 FILLER PIC X(6). SQ1084.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ1084.2 +013800 07 FILLER PIC X(5). SQ1084.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ1084.2 +014000 07 FILLER PIC X(6). SQ1084.2 +014100 07 XLABEL-TYPE PIC X(1). SQ1084.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ1084.2 +014300 07 FILLER PIC X(8). SQ1084.2 +014400 07 XRECORD-KEY PIC X(29). SQ1084.2 +014500 07 FILLER PIC X(9). SQ1084.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ1084.2 +014700 07 FILLER PIC X(9). SQ1084.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ1084.2 +014900 07 FILLER PIC X(7). SQ1084.2 +015000 01 TEST-RESULTS. SQ1084.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1084.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1084.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015600 02 PAR-NAME. SQ1084.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ1084.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ1084.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1084.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ1084.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ1084.2 +016200 02 RE-MARK PIC X(61). SQ1084.2 +016300 01 TEST-COMPUTED. SQ1084.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1084.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1084.2 +016600 02 COMPUTED-X. SQ1084.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1084.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1084.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1084.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1084.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1084.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1084.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ1084.2 +017400 04 FILLER PICTURE X. SQ1084.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ1084.2 +017600 01 TEST-CORRECT. SQ1084.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ1084.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1084.2 +017900 02 CORRECT-X. SQ1084.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1084.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1084.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1084.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1084.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1084.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ1084.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ1084.2 +018700 04 FILLER PICTURE X. SQ1084.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ1084.2 +018900 01 CCVS-C-1. SQ1084.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1084.2 +019100- "SS PARAGRAPH-NAME SQ1084.2 +019200- " REMARKS". SQ1084.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1084.2 +019400 01 CCVS-C-2. SQ1084.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1084.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1084.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1084.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1084.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1084.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ1084.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1084.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1084.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1084.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1084.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1084.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1084.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1084.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1084.2 +021000 01 CCVS-H-1. SQ1084.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ1084.2 +021200 02 FILLER PICTURE X(67) VALUE SQ1084.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1084.2 +021400- " SYSTEM". SQ1084.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ1084.2 +021600 01 CCVS-H-2. SQ1084.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ1084.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1084.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1084.2 +022000 02 TEST-ID PICTURE IS X(9). SQ1084.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1084.2 +022200 01 CCVS-H-3. SQ1084.2 +022300 02 FILLER PICTURE X(34) VALUE SQ1084.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1084.2 +022500 02 FILLER PICTURE X(58) VALUE SQ1084.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1084.2 +022700 02 FILLER PICTURE X(28) VALUE SQ1084.2 +022800 " COPYRIGHT 1985 ". SQ1084.2 +022900 01 CCVS-E-1. SQ1084.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1084.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1084.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ1084.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ1084.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ1084.2 +023500 01 CCVS-E-2. SQ1084.2 +023600 02 FILLER PICTURE X(31) VALUE SQ1084.2 +023700 SPACE. SQ1084.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ1084.2 +023900 02 CCVS-E-2-2. SQ1084.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1084.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1084.2 +024300 01 CCVS-E-3. SQ1084.2 +024400 02 FILLER PICTURE X(22) VALUE SQ1084.2 +024500 " FOR OFFICIAL USE ONLY". SQ1084.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ1084.2 +024700 02 FILLER PICTURE X(58) VALUE SQ1084.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1084.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ1084.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1084.2 +025100 01 CCVS-E-4. SQ1084.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1084.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ1084.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1084.2 +025500 02 FILLER PIC X(40) VALUE SQ1084.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1084.2 +025700 01 XXINFO. SQ1084.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1084.2 +025900 02 INFO-TEXT. SQ1084.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ1084.2 +026100 04 XXCOMPUTED PIC X(20). SQ1084.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1084.2 +026300 04 XXCORRECT PIC X(20). SQ1084.2 +026400 01 HYPHEN-LINE. SQ1084.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1084.2 +026700- "*****************************************". SQ1084.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1084.2 +026900- "******************************". SQ1084.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ1084.2 +027100 "SQ108A". SQ1084.2 +027200 PROCEDURE DIVISION. SQ1084.2 +027300 CCVS1 SECTION. SQ1084.2 +027400 OPEN-FILES. SQ1084.2 +027500P OPEN I-O RAW-DATA. SQ1084.2 +027600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1084.2 +027700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1084.2 +027800P MOVE "ABORTED " TO C-ABORT. SQ1084.2 +027900P ADD 1 TO C-NO-OF-TESTS. SQ1084.2 +028000P ACCEPT C-DATE FROM DATE. SQ1084.2 +028100P ACCEPT C-TIME FROM TIME. SQ1084.2 +028200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1084.2 +028300PEND-E-1. SQ1084.2 +028400P CLOSE RAW-DATA. SQ1084.2 +028500 OPEN OUTPUT PRINT-FILE. SQ1084.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1084.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ1084.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1084.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ1084.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1084.2 +029100 CCVS-INIT-FILE. SQ1084.2 +029200 ADD 1 TO REC-SKL-SUB. SQ1084.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1084.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1084.2 +029500 CCVS-INIT-EXIT. SQ1084.2 +029600 GO TO CCVS1-EXIT. SQ1084.2 +029700 CLOSE-FILES. SQ1084.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1084.2 +029900P OPEN I-O RAW-DATA. SQ1084.2 +030000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1084.2 +030100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1084.2 +030200P MOVE "OK. " TO C-ABORT. SQ1084.2 +030300P MOVE PASS-COUNTER TO C-OK. SQ1084.2 +030400P MOVE ERROR-HOLD TO C-ALL. SQ1084.2 +030500P MOVE ERROR-COUNTER TO C-FAIL. SQ1084.2 +030600P MOVE DELETE-CNT TO C-DELETED. SQ1084.2 +030700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1084.2 +030800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1084.2 +030900PEND-E-2. SQ1084.2 +031000P CLOSE RAW-DATA. SQ1084.2 +031100 TERMINATE-CCVS. SQ1084.2 +031200S EXIT PROGRAM. SQ1084.2 +031300STERMINATE-CALL. SQ1084.2 +031400 STOP RUN. SQ1084.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1084.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1084.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1084.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1084.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1084.2 +032000 PRINT-DETAIL. SQ1084.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1084.2 +032200 MOVE "." TO PARDOT-X SQ1084.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1084.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1084.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1084.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1084.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1084.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1084.2 +032900 MOVE SPACE TO CORRECT-X. SQ1084.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1084.2 +033100 MOVE SPACE TO RE-MARK. SQ1084.2 +033200 HEAD-ROUTINE. SQ1084.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1084.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1084.2 +033600 COLUMN-NAMES-ROUTINE. SQ1084.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +034000 END-ROUTINE. SQ1084.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1084.2 +034200 END-RTN-EXIT. SQ1084.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +034400 END-ROUTINE-1. SQ1084.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1084.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1084.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1084.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1084.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1084.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1084.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1084.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1084.2 +035300 END-ROUTINE-12. SQ1084.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1084.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1084.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1084.2 +035700 ELSE SQ1084.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1084.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1084.2 +036000 PERFORM WRITE-LINE. SQ1084.2 +036100 END-ROUTINE-13. SQ1084.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ1084.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1084.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1084.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1084.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1084.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ1084.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1084.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1084.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +037300 WRITE-LINE. SQ1084.2 +037400 ADD 1 TO RECORD-COUNT. SQ1084.2 +037500Y IF RECORD-COUNT GREATER 50 SQ1084.2 +037600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1084.2 +037700Y MOVE SPACE TO DUMMY-RECORD SQ1084.2 +037800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1084.2 +037900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1084.2 +038000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1084.2 +038100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1084.2 +038200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1084.2 +038300Y MOVE ZERO TO RECORD-COUNT. SQ1084.2 +038400 PERFORM WRT-LN. SQ1084.2 +038500 WRT-LN. SQ1084.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1084.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1084.2 +038800 BLANK-LINE-PRINT. SQ1084.2 +038900 PERFORM WRT-LN. SQ1084.2 +039000 FAIL-ROUTINE. SQ1084.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1084.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1084.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1084.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +039500 GO TO FAIL-ROUTINE-EX. SQ1084.2 +039600 FAIL-ROUTINE-WRITE. SQ1084.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1084.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ1084.2 +040000 BAIL-OUT. SQ1084.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1084.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1084.2 +040300 BAIL-OUT-WRITE. SQ1084.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1084.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +040600 BAIL-OUT-EX. EXIT. SQ1084.2 +040700 CCVS1-EXIT. SQ1084.2 +040800 EXIT. SQ1084.2 +040900 SECT-SQ-108-0001 SECTION. SQ1084.2 +041000 SEQ-INIT-019. SQ1084.2 +041100 MOVE "SQ-FS8" TO XFILE-NAME (1). SQ1084.2 +041200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1084.2 +041300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1084.2 +041400 MOVE 141 TO XRECORD-LENGTH (1). SQ1084.2 +041500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1084.2 +041600 MOVE 1 TO XBLOCK-SIZE (1). SQ1084.2 +041700 MOVE 710 TO RECORDS-IN-FILE (1). SQ1084.2 +041800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1084.2 +041900 MOVE "O" TO XLABEL-TYPE (1). SQ1084.2 +042000 MOVE 0 TO NUMBER-AREA. SQ1084.2 +042100 MOVE "READ...INTO FILE " TO ALPHA-AREA. SQ1084.2 +042200 OPEN OUTPUT SQ-FS8. SQ1084.2 +042300 SEQ-TEST-019. SQ1084.2 +042400 ADD 1 TO NUMBER-AREA. SQ1084.2 +042500 MOVE NUMBER-AREA TO XRECORD-NUMBER (1). SQ1084.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS8R1-PART1. SQ1084.2 +042700 MOVE END-OF-RECORD-AREA TO SQ-FS8R1-PART2. SQ1084.2 +042800 WRITE SQ-FS8R1-F-G-141. SQ1084.2 +042900 IF NUMBER-AREA EQUAL TO 710 SQ1084.2 +043000 GO TO SEQ-WRITE-019. SQ1084.2 +043100 GO TO SEQ-TEST-019. SQ1084.2 +043200 SEQ-WRITE-019. SQ1084.2 +043300 MOVE "CREATE FILE SQ-FS8" TO FEATURE. SQ1084.2 +043400 MOVE "SEQ-TEST-019" TO PAR-NAME. SQ1084.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1084.2 +043600 MOVE NUMBER-AREA TO CORRECT-18V0. SQ1084.2 +043700 PERFORM PRINT-DETAIL. SQ1084.2 +043800 CLOSE SQ-FS8. SQ1084.2 +043900* A MASS STORAGE SEQUENTIAL FILE WITH 141 CHARACTER SQ1084.2 +044000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 710 RECORDS. SQ1084.2 +044100 RERAD-INIT-020. SQ1084.2 +044200 MOVE ZERO TO COUNT-OF-RECS. SQ1084.2 +044300* THIS TEST READS AND CHECKS THE FILE CREATED SQ1084.2 +044400* IN RERAD-TEST-019. SQ1084.2 +044500 OPEN INPUT SQ-FS8. SQ1084.2 +044600 SEQ-TEST-020. SQ1084.2 +044700 READ SQ-FS8 RECORD SQ1084.2 +044800 AT END GO TO SEQ-TEST-020-1. SQ1084.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +045000 IF COUNT-OF-RECS GREATER THAN 710 SQ1084.2 +045100 MOVE "MORE THAN 710 RECORDS" TO RE-MARK SQ1084.2 +045200 GO TO SEQ-FAIL-020. SQ1084.2 +045300 MOVE SQ-FS8R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +045400 MOVE SQ-FS8R1-PART2 TO END-OF-RECORD-AREA. SQ1084.2 +045500 IF COUNT-OF-RECS NOT EQUAL TO NUMBER-AREA SQ1084.2 +045600 GO TO SEQ-TEST-020-2. SQ1084.2 +045700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +045800 GO TO SEQ-TEST-020-2. SQ1084.2 +045900 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +046000 GO TO SEQ-TEST-020-2. SQ1084.2 +046100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1084.2 +046200 GO TO SEQ-TEST-020-2. SQ1084.2 +046300 IF ALPHA-AREA EQUAL TO "READ...INTO FILE " SQ1084.2 +046400 GO TO SEQ-TEST-020. SQ1084.2 +046500 SEQ-TEST-020-2. SQ1084.2 +046600 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +046700 GO TO SEQ-TEST-020. SQ1084.2 +046800 SEQ-TEST-020-1. SQ1084.2 +046900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1084.2 +047000 GO TO SEQ-PASS-020. SQ1084.2 +047100 MOVE "ERRORS IN READING SQ-FS8" TO RE-MARK. SQ1084.2 +047200 SEQ-FAIL-020. SQ1084.2 +047300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1084.2 +047400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1084.2 +047500 PERFORM FAIL. SQ1084.2 +047600 GO TO SEQ-WRITE-020. SQ1084.2 +047700 SEQ-PASS-020. SQ1084.2 +047800 PERFORM PASS. SQ1084.2 +047900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1084.2 +048000 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1084.2 +048100 SEQ-WRITE-020. SQ1084.2 +048200 MOVE "SEQ-TEST-020" TO PAR-NAME. SQ1084.2 +048300 MOVE "VERIFY FILE SQ-FS8" TO FEATURE. SQ1084.2 +048400 PERFORM PRINT-DETAIL. SQ1084.2 +048500 SEQ-CLOSE-020. SQ1084.2 +048600 CLOSE SQ-FS8. SQ1084.2 +048700 READ-INIT-GF-01. SQ1084.2 +048800 MOVE ZERO TO COUNT-OF-RECS. SQ1084.2 +048900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1084.2 +049000 MOVE ZERO TO ERROR-FLAG. SQ1084.2 +049100 MOVE ZERO TO EOF-FLAG. SQ1084.2 +049200 MOVE "READ 141 INTO 87 " TO FEATURE. SQ1084.2 +049300 MOVE "READ...RECORD INTO...AT END 01 LEVEL" TO RE-MARK. SQ1084.2 +049400 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1084.2 +049500* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A SQ1084.2 +049600* WORKING-STORAGE AREA OF 87 CHARACTERS AND CHECKS THE AREA SQ1084.2 +049700* FOLLOWING TO ENSURE TRUNCATION TOOK PLACE. OTHER FIELDS SQ1084.2 +049800* IN THE RECORD AREA ARE ALSO CHECKED. SQ1084.2 +049900 OPEN INPUT SQ-FS8. SQ1084.2 +050000 READ-TEST-GF-01. SQ1084.2 +050100 MOVE SPACE TO FOLLOWS-AREA1. SQ1084.2 +050200 READ SQ-FS8 RECORD INTO READ-INTO-AREA1 SQ1084.2 +050300 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +050400 MOVE 1 TO EOF-FLAG SQ1084.2 +050500 GO TO READ-FAIL-GF-01. SQ1084.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +050700 IF COUNT-OF-RECS EQUAL TO 125 SQ1084.2 +050800 GO TO READ-TEST-GF-01-1. SQ1084.2 +050900 IF FOLLOWS-AREA1 NOT EQUAL TO SPACE SQ1084.2 +051000 MOVE "WORKING-STORAGE CLOBBERED" TO RE-MARK SQ1084.2 +051100 MOVE FOLLOWS-AREA1 TO COMPUTED-A SQ1084.2 +051200 GO TO READ-FAIL-GF-01. SQ1084.2 +051300 MOVE SPACE TO CHARS-OR-RECORDS (1). SQ1084.2 +051400 MOVE AREA1-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +051500 IF CHARS-OR-RECORDS (1) EQUAL TO "RC" SQ1084.2 +051600 MOVE "NO TRUNC ON READ" TO COMPUTED-A SQ1084.2 +051700 GO TO READ-FAIL-GF-01. SQ1084.2 +051800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +051900 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +052000 GO TO READ-TEST-GF-01. SQ1084.2 +052100 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +052200 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +052300 GO TO READ-TEST-GF-01. SQ1084.2 +052400 READ-TEST-GF-01-1. SQ1084.2 +052500 IF RECORDS-IN-ERROR EQUAL TO 0 SQ1084.2 +052600 GO TO READ-PASS-GF-01. SQ1084.2 +052700 READ-FAIL-GF-01. SQ1084.2 +052800 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +052900 MOVE "VII-45; 4.4.3 (7), (8) " TO RE-MARK.SQ1084.2 +053000 PERFORM FAIL. SQ1084.2 +053100 GO TO READ-WRITE-GF-01. SQ1084.2 +053200 READ-PASS-GF-01. SQ1084.2 +053300 PERFORM PASS. SQ1084.2 +053400 READ-WRITE-GF-01. SQ1084.2 +053500 PERFORM PRINT-DETAIL. SQ1084.2 +053600 READ-INIT-GF-02. SQ1084.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +053800 GO TO SEQ-EOF-21. SQ1084.2 +053900 MOVE 0 TO ERROR-FLAG. SQ1084.2 +054000* THIS TEST READS RECORDS OF 141 CHARACTERS INTO AN 02 SQ1084.2 +054100* LEVEL IDENTIFIER WITH PIC X(120). SQ1084.2 +054200 MOVE "READ 141 INTO 120 " TO FEATURE. SQ1084.2 +054300 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1084.2 +054400 MOVE "READ...INTO...AT END 02 LEVEL" TO RE-MARK. SQ1084.2 +054500 READ-TEST-GF-02. SQ1084.2 +054600 MOVE SPACE TO FOLLOWS-AREA2. SQ1084.2 +054700 READ SQ-FS8 INTO AREA2-1 SQ1084.2 +054800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +054900 MOVE 1 TO EOF-FLAG SQ1084.2 +055000 GO TO READ-FAIL-GF-02. SQ1084.2 +055100 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +055200 IF COUNT-OF-RECS EQUAL TO 250 SQ1084.2 +055300 GO TO READ-TEST-GF-02-1. SQ1084.2 +055400 IF FOLLOWS-AREA2 NOT EQUAL TO SPACE SQ1084.2 +055500 MOVE "WORKING-STORAGE CLOBBERED" TO RE-MARK SQ1084.2 +055600 MOVE FOLLOWS-AREA2 TO COMPUTED-A SQ1084.2 +055700 GO TO READ-FAIL-GF-02. SQ1084.2 +055800 MOVE AREA2-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +055900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +056000 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +056100 MOVE 1 TO ERROR-FLAG SQ1084.2 +056200 GO TO READ-TEST-GF-02. SQ1084.2 +056300 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +056500 MOVE 1 TO ERROR-FLAG. SQ1084.2 +056600 GO TO READ-TEST-GF-02. SQ1084.2 +056700 READ-TEST-GF-02-1. SQ1084.2 +056800 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +056900 GO TO READ-PASS-GF-02. SQ1084.2 +057000 READ-FAIL-GF-02. SQ1084.2 +057100 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +057200 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +057300 PERFORM FAIL. SQ1084.2 +057400 GO TO READ-WRITE-GF-02. SQ1084.2 +057500 READ-PASS-GF-02. SQ1084.2 +057600 PERFORM PASS. SQ1084.2 +057700 READ-WRITE-GF-02. SQ1084.2 +057800 PERFORM PRINT-DETAIL. SQ1084.2 +057900 READ-INIT-GF-03. SQ1084.2 +058000 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +058100 GO TO SEQ-EOF-21. SQ1084.2 +058200 MOVE 0 TO ERROR-FLAG. SQ1084.2 +058300 MOVE "READ 141 INTO 148 " TO FEATURE. SQ1084.2 +058400 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1084.2 +058500 MOVE "READ...RECORD INTO...END 01 LEVEL" TO RE-MARK. SQ1084.2 +058600* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A WORKING-SQ1084.2 +058700* STORAGE RECORD OF 148 CHARACTERS. THE LAST 7 CHARACTERS ARE SQ1084.2 +058800* TESTED TO ENSURE THAT SPACE FILLING ON THE RIGHT OCCURRED. SQ1084.2 +058900 READ-TEST-GF-03. SQ1084.2 +059000 MOVE "ABCDEFG" TO AREA3-2. SQ1084.2 +059100 READ SQ-FS8 RECORD INTO READ-INTO-AREA3 SQ1084.2 +059200 END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +059300 MOVE 1 TO EOF-FLAG SQ1084.2 +059400 GO TO READ-FAIL-GF-03. SQ1084.2 +059500 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +059600 IF COUNT-OF-RECS EQUAL TO 350 SQ1084.2 +059700 GO TO READ-TEST-GF-03-1. SQ1084.2 +059800 IF AREA3-2 NOT EQUAL TO SPACE SQ1084.2 +059900 MOVE "NO SPACE FILL" TO RE-MARK SQ1084.2 +060000 MOVE AREA3-2 TO COMPUTED-A SQ1084.2 +060100 GO TO READ-FAIL-GF-03. SQ1084.2 +060200 MOVE AREA3-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +060300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +060400 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +060500 MOVE 1 TO ERROR-FLAG SQ1084.2 +060600 GO TO READ-TEST-GF-03. SQ1084.2 +060700 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +060800 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +060900 MOVE 1 TO ERROR-FLAG SQ1084.2 +061000 GO TO READ-TEST-GF-03. SQ1084.2 +061100 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +061200 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +061300 MOVE 1 TO ERROR-FLAG. SQ1084.2 +061400 GO TO READ-TEST-GF-03. SQ1084.2 +061500 READ-TEST-GF-03-1. SQ1084.2 +061600 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +061700 GO TO READ-PASS-GF-03. SQ1084.2 +061800 READ-FAIL-GF-03. SQ1084.2 +061900 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +062000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +062100 PERFORM FAIL. SQ1084.2 +062200 GO TO READ-WRITE-GF-03. SQ1084.2 +062300 READ-PASS-GF-03. SQ1084.2 +062400 PERFORM PASS. SQ1084.2 +062500 READ-WRITE-GF-03. SQ1084.2 +062600 PERFORM PRINT-DETAIL. SQ1084.2 +062700 READ-INIT-GF-04. SQ1084.2 +062800 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +062900 GO TO SEQ-EOF-21. SQ1084.2 +063000 MOVE 0 TO ERROR-FLAG. SQ1084.2 +063100 MOVE "READ 141 INTO 141" TO FEATURE. SQ1084.2 +063200 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1084.2 +063300 MOVE "READ...INTO...END 01 LEVEL" TO RE-MARK. SQ1084.2 +063400* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A SQ1084.2 +063500* WORKING-STORAGE RECORD OF 141 CHARACTERS. SQ1084.2 +063600 READ-TEST-GF-04. SQ1084.2 +063700 READ SQ-FS8 INTO READ-INTO-AREA4 SQ1084.2 +063800 END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +063900 MOVE 1 TO EOF-FLAG SQ1084.2 +064000 GO TO READ-FAIL-GF-04. SQ1084.2 +064100 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +064200 IF COUNT-OF-RECS EQUAL TO 400 SQ1084.2 +064300 GO TO READ-TEST-GF-04-1. SQ1084.2 +064400 MOVE AREA4-2 TO END-OF-RECORD-AREA. SQ1084.2 +064500 IF ALPHA-AREA NOT EQUAL TO "READ...INTO FILE " SQ1084.2 +064600 GO TO READ-FAIL-GF-04-1. SQ1084.2 +064700 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +064800 GO TO READ-FAIL-GF-04-1. SQ1084.2 +064900 MOVE AREA4-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +065000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +065100 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +065300 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +065500 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065600 GO TO READ-TEST-GF-04. SQ1084.2 +065700 READ-FAIL-GF-04-1. SQ1084.2 +065800 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +065900 MOVE 1 TO ERROR-FLAG. SQ1084.2 +066000 GO TO READ-TEST-GF-04. SQ1084.2 +066100 READ-TEST-GF-04-1. SQ1084.2 +066200 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +066300 GO TO READ-PASS-GF-04. SQ1084.2 +066400 READ-FAIL-GF-04. SQ1084.2 +066500 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +066600 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +066700 PERFORM FAIL. SQ1084.2 +066800 GO TO READ-WRITE-GF-04. SQ1084.2 +066900 READ-PASS-GF-04. SQ1084.2 +067000 PERFORM PASS. SQ1084.2 +067100 READ-WRITE-GF-04. SQ1084.2 +067200 PERFORM PRINT-DETAIL. SQ1084.2 +067300 READ-INIT-GF-05. SQ1084.2 +067400 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +067500 GO TO SEQ-EOF-21. SQ1084.2 +067600 MOVE 0 TO ERROR-FLAG. SQ1084.2 +067700 MOVE "READ 141 INTO 120" TO FEATURE. SQ1084.2 +067800 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1084.2 +067900 MOVE "READ INTO SUBSCRIPTED DATA ITEM 05 LEVEL" TO RE-MARK. SQ1084.2 +068000* THIS TEST READS A RECORD OF 141 CHARACTERS INTO A SQ1084.2 +068100* SUBSCRIPTED DATA ITEM OF 120 CHARACTERS. SQ1084.2 +068200 READ-TEST-GF-05. SQ1084.2 +068300 READ SQ-FS8 RECORD INTO FILE-RECORD-INFO-P1-120 (1) SQ1084.2 +068400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +068500 MOVE 1 TO EOF-FLAG SQ1084.2 +068600 GO TO READ-FAIL-GF-05. SQ1084.2 +068700 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +068800 IF COUNT-OF-RECS EQUAL TO 425 SQ1084.2 +068900 GO TO READ-TEST-GF-05-1. SQ1084.2 +069000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +069100 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +069300 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +069500 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069600 GO TO READ-TEST-GF-05. SQ1084.2 +069700 READ-FAIL-GF-05-1. SQ1084.2 +069800 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +069900 MOVE 1 TO ERROR-FLAG. SQ1084.2 +070000 GO TO READ-TEST-GF-05. SQ1084.2 +070100 READ-TEST-GF-05-1. SQ1084.2 +070200 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +070300 GO TO READ-PASS-GF-05. SQ1084.2 +070400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +070500 READ-FAIL-GF-05. SQ1084.2 +070600 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +070700 PERFORM FAIL. SQ1084.2 +070800 GO TO READ-WRITE-GF-05. SQ1084.2 +070900 READ-PASS-GF-05. SQ1084.2 +071000 PERFORM PASS. SQ1084.2 +071100 READ-WRITE-GF-05. SQ1084.2 +071200 PERFORM PRINT-DETAIL. SQ1084.2 +071300 READ-INIT-GF-06. SQ1084.2 +071400 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +071500 GO TO SEQ-EOF-21. SQ1084.2 +071600 MOVE 0 TO ERROR-FLAG. SQ1084.2 +071700 MOVE "READ 141 INTO 141" TO FEATURE. SQ1084.2 +071800 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1084.2 +071900 MOVE "CHECK OF FD RECORD ON RD INTO 01 LEVEL" TO RE-MARK. SQ1084.2 +072000* THIS TEST READS A RECORD INTO A WORKING-STORAGE AREA SQ1084.2 +072100* AND CHECKS THE CONTENTS OF THE FD RECORD AREA TO ENSURE SQ1084.2 +072200* THAT IT IS NOT AFFECTED BY THE INTO PHRASE. SQ1084.2 +072300 READ-TEST-GF-06. SQ1084.2 +072400 READ SQ-FS8 RECORD INTO READ-INTO-AREA4 SQ1084.2 +072500 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +072600 MOVE 1 TO EOF-FLAG SQ1084.2 +072700 GO TO READ-FAIL-GF-06. SQ1084.2 +072800 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +072900 IF COUNT-OF-RECS EQUAL TO 710 SQ1084.2 +073000 GO TO READ-TEST-GF-06-1. SQ1084.2 +073100 MOVE SQ-FS8R1-PART2 TO END-OF-RECORD-AREA. SQ1084.2 +073200 IF ALPHA-AREA NOT EQUAL TO "READ...INTO FILE " SQ1084.2 +073300 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073400 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +073500 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073600 MOVE SQ-FS8R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +073700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +073800 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073900 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +074000 GO TO READ-FAIL-GF-06-1. SQ1084.2 +074100 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +074200 GO TO READ-FAIL-GF-06-1. SQ1084.2 +074300 GO TO READ-TEST-GF-06. SQ1084.2 +074400 READ-FAIL-GF-06-1. SQ1084.2 +074500 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +074600 MOVE 1 TO ERROR-FLAG. SQ1084.2 +074700 GO TO READ-TEST-GF-06. SQ1084.2 +074800 READ-TEST-GF-06-1. SQ1084.2 +074900 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +075000 GO TO READ-TEST-GF-06-2. SQ1084.2 +075100 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +075200 GO TO READ-FAIL-GF-06. SQ1084.2 +075300 READ-TEST-GF-06-2. SQ1084.2 +075400 IF READ-INTO-AREA4 EQUAL TO SQ-FS8R1-F-G-141 SQ1084.2 +075500 GO TO READ-PASS-GF-06. SQ1084.2 +075600 READ-FAIL-GF-06. SQ1084.2 +075700 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +075800 PERFORM FAIL. SQ1084.2 +075900 GO TO READ-WRITE-GF-06. SQ1084.2 +076000 READ-PASS-GF-06. SQ1084.2 +076100 PERFORM PASS. SQ1084.2 +076200 READ-WRITE-GF-06. SQ1084.2 +076300 PERFORM PRINT-DETAIL. SQ1084.2 +076400 SEQ-INIT-21. SQ1084.2 +076500* THIS TEST CHECKS IF ANY ERRORS WERE ENCOUNTERED ON THE SQ1084.2 +076600* PRECEDING READS, AND READS THE FILE ONCE MORE EXPECTING SQ1084.2 +076700* THE END CONDITION TO OCCUR. SQ1084.2 +076800 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +076900 GO TO SEQ-EOF-21. SQ1084.2 +077000 SEQ-TEST-21. SQ1084.2 +077100 READ SQ-FS8 RECORD INTO READ-INTO-AREA4 SQ1084.2 +077200 AT END GO TO SEQ-TEST-21-1. SQ1084.2 +077300 MOVE "MORE THAN 710 RECORDS" TO RE-MARK. SQ1084.2 +077400 GO TO SEQ-FAIL-21. SQ1084.2 +077500 SEQ-TEST-21-1. SQ1084.2 +077600 IF RECORDS-IN-ERROR NOT EQUAL TO 0 SQ1084.2 +077700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1084.2 +077800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1084.2 +077900 GO TO SEQ-FAIL-21. SQ1084.2 +078000 SEQ-PASS-21. SQ1084.2 +078100 PERFORM PASS. SQ1084.2 +078200 GO TO SEQ-WRITE-21. SQ1084.2 +078300 SEQ-EOF-21. SQ1084.2 +078400 MOVE "LESS THAN 710 RECORDS" TO RE-MARK. SQ1084.2 +078500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1084.2 +078600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1084.2 +078700 SEQ-FAIL-21. SQ1084.2 +078800 PERFORM FAIL. SQ1084.2 +078900 SEQ-WRITE-21. SQ1084.2 +079000 MOVE "SEQ-TEST-21" TO PAR-NAME. SQ1084.2 +079100 MOVE "READ SQ-FS8 INTO END" TO FEATURE. SQ1084.2 +079200 PERFORM PRINT-DETAIL. SQ1084.2 +079300 SEQ-CLOSE-021. SQ1084.2 +079400 CLOSE SQ-FS8. SQ1084.2 +079500 TERMINATE-ROUTINE. SQ1084.2 +079600 EXIT. SQ1084.2 +079700 CCVS-EXIT SECTION. SQ1084.2 +079800 CCVS-999999. SQ1084.2 +079900 GO TO CLOSE-FILES. SQ1084.2 +*END-OF,SQ108A +*HEADER,COBOL,SQ109M +000100 IDENTIFICATION DIVISION. SQ1094.2 +000200 PROGRAM-ID. SQ1094.2 +000300 SQ109M. SQ1094.2 +000400**************************************************************** SQ1094.2 +000500* * SQ1094.2 +000600* VALIDATION FOR:- * SQ1094.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1094.2 +000800* * SQ1094.2 +000900* CREATION DATE / VALIDATION DATE * SQ1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1094.2 +001100* * SQ1094.2 +001200**************************************************************** SQ1094.2 +001300 SQ1094.2 +001400* THIS ROUTINE CREATES A 2 REEL TAPE FILE OF FIXED SQ1094.2 +001500* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ1094.2 +001600* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ1094.2 +001700* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ1094.2 +001800* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ1094.2 +001900* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ1094.2 +002000* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ1094.2 +002100* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ1094.2 +002200* LEVEL ONE FEATURES. SQ1094.2 +002300* SQ1094.2 +002400* USED X-CARDS: SQ1094.2 +002500* XXXXX006 SQ1094.2 +002600* XXXXX055 SQ1094.2 +002700* P XXXXX062 SQ1094.2 +002800* XXXXX082 SQ1094.2 +002900* XXXXX083 SQ1094.2 +003000* C XXXXX084 SQ1094.2 +003100* SQ1094.2 +003200* SQ1094.2 +003300 ENVIRONMENT DIVISION. SQ1094.2 +003400 CONFIGURATION SECTION. SQ1094.2 +003500 SOURCE-COMPUTER. SQ1094.2 +003600 XXXXX082. SQ1094.2 +003700 OBJECT-COMPUTER. SQ1094.2 +003800 XXXXX083. SQ1094.2 +003900 INPUT-OUTPUT SECTION. SQ1094.2 +004000 FILE-CONTROL. SQ1094.2 +004100P SELECT RAW-DATA ASSIGN TO SQ1094.2 +004200P XXXXX062 SQ1094.2 +004300P ORGANIZATION IS INDEXED SQ1094.2 +004400P ACCESS MODE IS RANDOM SQ1094.2 +004500P RECORD KEY IS RAW-DATA-KEY. SQ1094.2 +004600 SELECT PRINT-FILE ASSIGN TO SQ1094.2 +004700 XXXXX055. SQ1094.2 +004800 SELECT SQ-FS1 ASSIGN TO SQ1094.2 +004900 XXXXX006 SQ1094.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1094.2 +005100 ACCESS MODE IS SEQUENTIAL. SQ1094.2 +005200 DATA DIVISION. SQ1094.2 +005300 FILE SECTION. SQ1094.2 +005400P SQ1094.2 +005500PFD RAW-DATA. SQ1094.2 +005600P SQ1094.2 +005700P01 RAW-DATA-SATZ. SQ1094.2 +005800P 05 RAW-DATA-KEY PIC X(6). SQ1094.2 +005900P 05 C-DATE PIC 9(6). SQ1094.2 +006000P 05 C-TIME PIC 9(8). SQ1094.2 +006100P 05 C-NO-OF-TESTS PIC 99. SQ1094.2 +006200P 05 C-OK PIC 999. SQ1094.2 +006300P 05 C-ALL PIC 999. SQ1094.2 +006400P 05 C-FAIL PIC 999. SQ1094.2 +006500P 05 C-DELETED PIC 999. SQ1094.2 +006600P 05 C-INSPECT PIC 999. SQ1094.2 +006700P 05 C-NOTE PIC X(13). SQ1094.2 +006800P 05 C-INDENT PIC X. SQ1094.2 +006900P 05 C-ABORT PIC X(8). SQ1094.2 +007000 FD PRINT-FILE SQ1094.2 +007100C LABEL RECORDS SQ1094.2 +007200C XXXXX084 SQ1094.2 +007300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1094.2 +007400 . SQ1094.2 +007500 01 PRINT-REC PICTURE X(120). SQ1094.2 +007600 01 DUMMY-RECORD PICTURE X(120). SQ1094.2 +007700 FD SQ-FS1 SQ1094.2 +007800C LABEL RECORD STANDARD SQ1094.2 +007900 . SQ1094.2 +008000 01 SQ-FS1R1-F-G-120. SQ1094.2 +008100 02 FILLER PIC X(120). SQ1094.2 +008200 WORKING-STORAGE SECTION. SQ1094.2 +008300 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1094.2 +008400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1094.2 +008500 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1094.2 +008600 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1094.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1094.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1094.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1094.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1094.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1094.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1094.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1094.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1094.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1094.2 +009600 ",RECKEY= ". SQ1094.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1094.2 +009800 ",ALTKEY1= ". SQ1094.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1094.2 +010000 ",ALTKEY2= ". SQ1094.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1094.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1094.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1094.2 +010400 07 FILLER PIC X(5). SQ1094.2 +010500 07 XFILE-NAME PIC X(6). SQ1094.2 +010600 07 FILLER PIC X(8). SQ1094.2 +010700 07 XRECORD-NAME PIC X(6). SQ1094.2 +010800 07 FILLER PIC X(1). SQ1094.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1094.2 +011000 07 FILLER PIC X(7). SQ1094.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1094.2 +011200 07 FILLER PIC X(6). SQ1094.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1094.2 +011400 07 FILLER PIC X(5). SQ1094.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1094.2 +011600 07 FILLER PIC X(5). SQ1094.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1094.2 +011800 07 FILLER PIC X(7). SQ1094.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1094.2 +012000 07 FILLER PIC X(7). SQ1094.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1094.2 +012200 07 FILLER PIC X(1). SQ1094.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1094.2 +012400 07 FILLER PIC X(6). SQ1094.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1094.2 +012600 07 FILLER PIC X(5). SQ1094.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1094.2 +012800 07 FILLER PIC X(6). SQ1094.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1094.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1094.2 +013100 07 FILLER PIC X(8). SQ1094.2 +013200 07 XRECORD-KEY PIC X(29). SQ1094.2 +013300 07 FILLER PIC X(9). SQ1094.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1094.2 +013500 07 FILLER PIC X(9). SQ1094.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1094.2 +013700 07 FILLER PIC X(7). SQ1094.2 +013800 01 TEST-RESULTS. SQ1094.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1094.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1094.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014400 02 PAR-NAME. SQ1094.2 +014500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1094.2 +014600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1094.2 +014700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1094.2 +014800 03 FILLER PIC X(5) VALUE SPACE. SQ1094.2 +014900 02 FILLER PIC X(10) VALUE SPACE. SQ1094.2 +015000 02 RE-MARK PIC X(61). SQ1094.2 +015100 01 TEST-COMPUTED. SQ1094.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1094.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1094.2 +015400 02 COMPUTED-X. SQ1094.2 +015500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1094.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1094.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1094.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1094.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1094.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1094.2 +016100 04 COMPUTED-18V0 PICTURE -9(18). SQ1094.2 +016200 04 FILLER PICTURE X. SQ1094.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1094.2 +016400 01 TEST-CORRECT. SQ1094.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1094.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1094.2 +016700 02 CORRECT-X. SQ1094.2 +016800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1094.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1094.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1094.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1094.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1094.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1094.2 +017400 04 CORRECT-18V0 PICTURE -9(18). SQ1094.2 +017500 04 FILLER PICTURE X. SQ1094.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1094.2 +017700 01 CCVS-C-1. SQ1094.2 +017800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1094.2 +017900- "SS PARAGRAPH-NAME SQ1094.2 +018000- " REMARKS". SQ1094.2 +018100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1094.2 +018200 01 CCVS-C-2. SQ1094.2 +018300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +018400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1094.2 +018500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1094.2 +018600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1094.2 +018700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1094.2 +018800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1094.2 +018900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1094.2 +019000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1094.2 +019100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1094.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1094.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1094.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1094.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1094.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1094.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1094.2 +019800 01 CCVS-H-1. SQ1094.2 +019900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1094.2 +020000 02 FILLER PICTURE X(67) VALUE SQ1094.2 +020100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1094.2 +020200- " SYSTEM". SQ1094.2 +020300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1094.2 +020400 01 CCVS-H-2. SQ1094.2 +020500 02 FILLER PICTURE X(52) VALUE IS SQ1094.2 +020600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1094.2 +020700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1094.2 +020800 02 TEST-ID PICTURE IS X(9). SQ1094.2 +020900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1094.2 +021000 01 CCVS-H-3. SQ1094.2 +021100 02 FILLER PICTURE X(34) VALUE SQ1094.2 +021200 " FOR OFFICIAL USE ONLY ". SQ1094.2 +021300 02 FILLER PICTURE X(58) VALUE SQ1094.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1094.2 +021500 02 FILLER PICTURE X(28) VALUE SQ1094.2 +021600 " COPYRIGHT 1985 ". SQ1094.2 +021700 01 CCVS-E-1. SQ1094.2 +021800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1094.2 +021900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1094.2 +022000 02 ID-AGAIN PICTURE IS X(9). SQ1094.2 +022100 02 FILLER PICTURE X(45) VALUE IS SQ1094.2 +022200 " NTIS DISTRIBUTION COBOL 85". SQ1094.2 +022300 01 CCVS-E-2. SQ1094.2 +022400 02 FILLER PICTURE X(31) VALUE SQ1094.2 +022500 SPACE. SQ1094.2 +022600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1094.2 +022700 02 CCVS-E-2-2. SQ1094.2 +022800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1094.2 +022900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +023000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1094.2 +023100 01 CCVS-E-3. SQ1094.2 +023200 02 FILLER PICTURE X(22) VALUE SQ1094.2 +023300 " FOR OFFICIAL USE ONLY". SQ1094.2 +023400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1094.2 +023500 02 FILLER PICTURE X(58) VALUE SQ1094.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1094.2 +023700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1094.2 +023800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1094.2 +023900 01 CCVS-E-4. SQ1094.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1094.2 +024100 02 FILLER PIC XXXX VALUE " OF ". SQ1094.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1094.2 +024300 02 FILLER PIC X(40) VALUE SQ1094.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1094.2 +024500 01 XXINFO. SQ1094.2 +024600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1094.2 +024700 02 INFO-TEXT. SQ1094.2 +024800 04 FILLER PIC X(20) VALUE SPACE. SQ1094.2 +024900 04 XXCOMPUTED PIC X(20). SQ1094.2 +025000 04 FILLER PIC X(5) VALUE SPACE. SQ1094.2 +025100 04 XXCORRECT PIC X(20). SQ1094.2 +025200 01 HYPHEN-LINE. SQ1094.2 +025300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +025400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1094.2 +025500- "*****************************************". SQ1094.2 +025600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1094.2 +025700- "******************************". SQ1094.2 +025800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1094.2 +025900 "SQ109M". SQ1094.2 +026000 PROCEDURE DIVISION. SQ1094.2 +026100 CCVS1 SECTION. SQ1094.2 +026200 OPEN-FILES. SQ1094.2 +026300P OPEN I-O RAW-DATA. SQ1094.2 +026400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1094.2 +026500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1094.2 +026600P MOVE "ABORTED " TO C-ABORT. SQ1094.2 +026700P ADD 1 TO C-NO-OF-TESTS. SQ1094.2 +026800P ACCEPT C-DATE FROM DATE. SQ1094.2 +026900P ACCEPT C-TIME FROM TIME. SQ1094.2 +027000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1094.2 +027100PEND-E-1. SQ1094.2 +027200P CLOSE RAW-DATA. SQ1094.2 +027300 OPEN OUTPUT PRINT-FILE. SQ1094.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1094.2 +027500 MOVE SPACE TO TEST-RESULTS. SQ1094.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1094.2 +027700 MOVE ZERO TO REC-SKL-SUB. SQ1094.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1094.2 +027900 CCVS-INIT-FILE. SQ1094.2 +028000 ADD 1 TO REC-SKL-SUB. SQ1094.2 +028100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1094.2 +028200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1094.2 +028300 CCVS-INIT-EXIT. SQ1094.2 +028400 GO TO CCVS1-EXIT. SQ1094.2 +028500 CLOSE-FILES. SQ1094.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1094.2 +028700P OPEN I-O RAW-DATA. SQ1094.2 +028800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1094.2 +028900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1094.2 +029000P MOVE "OK. " TO C-ABORT. SQ1094.2 +029100P MOVE PASS-COUNTER TO C-OK. SQ1094.2 +029200P MOVE ERROR-HOLD TO C-ALL. SQ1094.2 +029300P MOVE ERROR-COUNTER TO C-FAIL. SQ1094.2 +029400P MOVE DELETE-CNT TO C-DELETED. SQ1094.2 +029500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1094.2 +029600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1094.2 +029700PEND-E-2. SQ1094.2 +029800P CLOSE RAW-DATA. SQ1094.2 +029900 TERMINATE-CCVS. SQ1094.2 +030000S EXIT PROGRAM. SQ1094.2 +030100STERMINATE-CALL. SQ1094.2 +030200 STOP RUN. SQ1094.2 +030300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1094.2 +030400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1094.2 +030500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1094.2 +030600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1094.2 +030700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1094.2 +030800 PRINT-DETAIL. SQ1094.2 +030900 IF REC-CT NOT EQUAL TO ZERO SQ1094.2 +031000 MOVE "." TO PARDOT-X SQ1094.2 +031100 MOVE REC-CT TO DOTVALUE. SQ1094.2 +031200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1094.2 +031300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1094.2 +031400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1094.2 +031500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1094.2 +031600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1094.2 +031700 MOVE SPACE TO CORRECT-X. SQ1094.2 +031800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1094.2 +031900 MOVE SPACE TO RE-MARK. SQ1094.2 +032000 HEAD-ROUTINE. SQ1094.2 +032100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +032200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1094.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1094.2 +032400 COLUMN-NAMES-ROUTINE. SQ1094.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +032800 END-ROUTINE. SQ1094.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1094.2 +033000 END-RTN-EXIT. SQ1094.2 +033100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +033200 END-ROUTINE-1. SQ1094.2 +033300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1094.2 +033400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1094.2 +033500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1094.2 +033600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1094.2 +033700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1094.2 +033800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1094.2 +033900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1094.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1094.2 +034100 END-ROUTINE-12. SQ1094.2 +034200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1094.2 +034300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1094.2 +034400 MOVE "NO " TO ERROR-TOTAL SQ1094.2 +034500 ELSE SQ1094.2 +034600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1094.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1094.2 +034800 PERFORM WRITE-LINE. SQ1094.2 +034900 END-ROUTINE-13. SQ1094.2 +035000 IF DELETE-CNT IS EQUAL TO ZERO SQ1094.2 +035100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1094.2 +035200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1094.2 +035300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1094.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +035500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1094.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1094.2 +035700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1094.2 +035800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1094.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +036000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +036100 WRITE-LINE. SQ1094.2 +036200 ADD 1 TO RECORD-COUNT. SQ1094.2 +036300Y IF RECORD-COUNT GREATER 50 SQ1094.2 +036400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1094.2 +036500Y MOVE SPACE TO DUMMY-RECORD SQ1094.2 +036600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1094.2 +036700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1094.2 +036800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1094.2 +036900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1094.2 +037000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1094.2 +037100Y MOVE ZERO TO RECORD-COUNT. SQ1094.2 +037200 PERFORM WRT-LN. SQ1094.2 +037300 WRT-LN. SQ1094.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1094.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1094.2 +037600 BLANK-LINE-PRINT. SQ1094.2 +037700 PERFORM WRT-LN. SQ1094.2 +037800 FAIL-ROUTINE. SQ1094.2 +037900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1094.2 +038000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1094.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1094.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +038300 GO TO FAIL-ROUTINE-EX. SQ1094.2 +038400 FAIL-ROUTINE-WRITE. SQ1094.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1094.2 +038600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +038700 FAIL-ROUTINE-EX. EXIT. SQ1094.2 +038800 BAIL-OUT. SQ1094.2 +038900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1094.2 +039000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1094.2 +039100 BAIL-OUT-WRITE. SQ1094.2 +039200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1094.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +039400 BAIL-OUT-EX. EXIT. SQ1094.2 +039500 CCVS1-EXIT. SQ1094.2 +039600 EXIT. SQ1094.2 +039700 SECT-SQ109-0001 SECTION. SQ1094.2 +039800 SEQ-INIT-001. SQ1094.2 +039900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1094.2 +040000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1094.2 +040100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1094.2 +040200 MOVE 000120 TO XRECORD-LENGTH (1). SQ1094.2 +040300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1094.2 +040400 MOVE 0001 TO XBLOCK-SIZE (1). SQ1094.2 +040500 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1094.2 +040600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1094.2 +040700 MOVE "S" TO XLABEL-TYPE (1). SQ1094.2 +040800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1094.2 +040900 OPEN OUTPUT SQ-FS1. SQ1094.2 +041000 SEQ-TEST-001. SQ1094.2 +041100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1094.2 +041200 WRITE SQ-FS1R1-F-G-120. SQ1094.2 +041300 IF XRECORD-NUMBER (1) EQUAL TO 325 SQ1094.2 +041400H ADD 1 TO REELUNIT-NUMBER (1) SQ1094.2 +041500H CLOSE SQ-FS1 REEL. SQ1094.2 +041600I MOVE "CLOSE REEL DELETED" TO RE-MARK. SQ1094.2 +041700 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1094.2 +041800 GO TO SEQ-WRITE-001. SQ1094.2 +041900 ADD 1 TO XRECORD-NUMBER (1). SQ1094.2 +042000 GO TO SEQ-TEST-001. SQ1094.2 +042100 SEQ-WRITE-001. SQ1094.2 +042200 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ1094.2 +042300 MOVE "SEQ-TEST-001" TO PAR-NAME. SQ1094.2 +042400 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1094.2 +042500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1094.2 +042600 PERFORM PRINT-DETAIL. SQ1094.2 +042700 CLOSE SQ-FS1. SQ1094.2 +042800* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1094.2 +042900* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1094.2 +043000 SEQ-INIT-002. SQ1094.2 +043100 MOVE ZERO TO WRK-CS-09V00. SQ1094.2 +043200* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1094.2 +043300* SEQ-TEST-001. SQ1094.2 +043400 OPEN INPUT SQ-FS1. SQ1094.2 +043500 SEQ-TEST-002. SQ1094.2 +043600 READ SQ-FS1 SQ1094.2 +043700 AT END GO TO SEQ-TEST-002-1. SQ1094.2 +043800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1094.2 +043900 ADD 1 TO WRK-CS-09V00. SQ1094.2 +044000 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +044100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1094.2 +044200 GO TO SEQ-FAIL-002. SQ1094.2 +044300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1094.2 +044400 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +044500 GO TO SEQ-TEST-002. SQ1094.2 +044600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1094.2 +044700 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +044800 GO TO SEQ-TEST-002. SQ1094.2 +044900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1094.2 +045000 ADD 1 TO RECORDS-IN-ERROR. SQ1094.2 +045100 GO TO SEQ-TEST-002. SQ1094.2 +045200 SEQ-TEST-002-1. SQ1094.2 +045300 IF WRK-CS-09V00 EQUAL TO ZERO SQ1094.2 +045400 MOVE "AT END ON FIRST READ" TO RE-MARK SQ1094.2 +045500 GO TO SEQ-FAIL-002. SQ1094.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1094.2 +045700 GO TO SEQ-PASS-002. SQ1094.2 +045800 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1094.2 +045900 SEQ-FAIL-002. SQ1094.2 +046000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1094.2 +046100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1094.2 +046200 PERFORM FAIL. SQ1094.2 +046300 GO TO SEQ-WRITE-002. SQ1094.2 +046400 SEQ-PASS-002. SQ1094.2 +046500 PERFORM PASS. SQ1094.2 +046600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1094.2 +046700 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1094.2 +046800 SEQ-WRITE-002. SQ1094.2 +046900 MOVE "SEQ-TEST-002" TO PAR-NAME. SQ1094.2 +047000 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1094.2 +047100 PERFORM PRINT-DETAIL. SQ1094.2 +047200 SEQ-CLOSE-002. SQ1094.2 +047300 CLOSE SQ-FS1. SQ1094.2 +047400 READ-INIT-GF-01. SQ1094.2 +047500 MOVE ZERO TO WRK-CS-09V00. SQ1094.2 +047600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1094.2 +047700 OPEN INPUT SQ-FS1. SQ1094.2 +047800* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1094.2 +047900* IN THIS SERIES OF TESTS. SQ1094.2 +048000 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1094.2 +048100 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1094.2 +048200 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +048300 READ-TEST-GF-01. SQ1094.2 +048400 READ SQ-FS1 RECORD AT END SQ1094.2 +048500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +048600 MOVE 1 TO EOF-FLAG SQ1094.2 +048700 GO TO READ-FAIL-GF-01. SQ1094.2 +048800 PERFORM RECORD-CHECK. SQ1094.2 +048900 IF WRK-CS-09V00 EQUAL TO 200 SQ1094.2 +049000 GO TO READ-TEST-GF-01-1. SQ1094.2 +049100 GO TO READ-TEST-GF-01. SQ1094.2 +049200 RECORD-CHECK. SQ1094.2 +049300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1094.2 +049400 ADD 1 TO WRK-CS-09V00. SQ1094.2 +049500 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1094.2 +049600 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +049700 MOVE 1 TO ERROR-FLAG. SQ1094.2 +049800 READ-TEST-GF-01-1. SQ1094.2 +049900 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +050000 GO TO READ-PASS-GF-01. SQ1094.2 +050100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +050200 READ-FAIL-GF-01. SQ1094.2 +050300 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +050400 PERFORM FAIL. SQ1094.2 +050500 GO TO READ-WRITE-GF-01. SQ1094.2 +050600 READ-PASS-GF-01. SQ1094.2 +050700 PERFORM PASS. SQ1094.2 +050800 READ-WRITE-GF-01. SQ1094.2 +050900 PERFORM PRINT-DETAIL. SQ1094.2 +051000 READ-INIT-GF-02. SQ1094.2 +051100 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +051200 GO TO SEQ-EOF-003. SQ1094.2 +051300 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +051400 MOVE "READ...AT END..." TO FEATURE. SQ1094.2 +051500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1094.2 +051600 READ-TEST-GF-02. SQ1094.2 +051700 READ SQ-FS1 AT END SQ1094.2 +051800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +051900 MOVE 1 TO EOF-FLAG SQ1094.2 +052000 GO TO READ-FAIL-GF-02. SQ1094.2 +052100 PERFORM RECORD-CHECK. SQ1094.2 +052200 IF WRK-CS-09V00 EQUAL TO 400 SQ1094.2 +052300 GO TO READ-TEST-GF-02-1. SQ1094.2 +052400 GO TO READ-TEST-GF-02. SQ1094.2 +052500 READ-TEST-GF-02-1. SQ1094.2 +052600 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +052700 GO TO READ-PASS-GF-02. SQ1094.2 +052800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +052900 READ-FAIL-GF-02. SQ1094.2 +053000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +053100 PERFORM FAIL. SQ1094.2 +053200 GO TO READ-WRITE-GF-02. SQ1094.2 +053300 READ-PASS-GF-02. SQ1094.2 +053400 PERFORM PASS. SQ1094.2 +053500 READ-WRITE-GF-02. SQ1094.2 +053600 PERFORM PRINT-DETAIL. SQ1094.2 +053700 READ-INIT-GF-03. SQ1094.2 +053800 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +053900 GO TO SEQ-EOF-003. SQ1094.2 +054000 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +054100 MOVE "READ...RECORD END..." TO FEATURE. SQ1094.2 +054200 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1094.2 +054300 READ-TEST-GF-03. SQ1094.2 +054400 READ SQ-FS1 RECORD END SQ1094.2 +054500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +054600 MOVE 1 TO EOF-FLAG SQ1094.2 +054700 GO TO READ-FAIL-GF-03. SQ1094.2 +054800 PERFORM RECORD-CHECK. SQ1094.2 +054900 IF WRK-CS-09V00 EQUAL TO 600 SQ1094.2 +055000 GO TO READ-TEST-GF-03-1. SQ1094.2 +055100 GO TO READ-TEST-GF-03. SQ1094.2 +055200 READ-TEST-GF-03-1. SQ1094.2 +055300 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +055400 GO TO READ-PASS-GF-03. SQ1094.2 +055500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +055600 READ-FAIL-GF-03. SQ1094.2 +055700 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +055800 PERFORM FAIL. SQ1094.2 +055900 GO TO READ-WRITE-GF-03. SQ1094.2 +056000 READ-PASS-GF-03. SQ1094.2 +056100 PERFORM PASS. SQ1094.2 +056200 READ-WRITE-GF-03. SQ1094.2 +056300 PERFORM PRINT-DETAIL. SQ1094.2 +056400 READ-INIT-GF-04. SQ1094.2 +056500 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +056600 GO TO SEQ-EOF-003. SQ1094.2 +056700 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +056800 MOVE "READ...END..." TO FEATURE. SQ1094.2 +056900 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1094.2 +057000 READ-TEST-GF-04. SQ1094.2 +057100 READ SQ-FS1 END GO TO READ-TEST-GF-04-1. SQ1094.2 +057200 PERFORM RECORD-CHECK. SQ1094.2 +057300 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +057400 GO TO READ-TEST-GF-04-1. SQ1094.2 +057500 GO TO READ-TEST-GF-04. SQ1094.2 +057600 READ-TEST-GF-04-1. SQ1094.2 +057700 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +057800 GO TO READ-PASS-GF-04. SQ1094.2 +057900 READ-FAIL-GF-04. SQ1094.2 +058000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +058100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +058200 PERFORM FAIL. SQ1094.2 +058300 GO TO READ-WRITE-GF-04. SQ1094.2 +058400 READ-PASS-GF-04. SQ1094.2 +058500 PERFORM PASS. SQ1094.2 +058600 READ-WRITE-GF-04. SQ1094.2 +058700 PERFORM PRINT-DETAIL. SQ1094.2 +058800 SEQ-TEST-003. SQ1094.2 +058900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1094.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1094.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1094.2 +059200 GO TO SEQ-FAIL-003. SQ1094.2 +059300 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +059400 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1094.2 +059500 GO TO SEQ-FAIL-003. SQ1094.2 +059600 SEQ-PASS-003. SQ1094.2 +059700 PERFORM PASS. SQ1094.2 +059800 GO TO SEQ-WRITE-003. SQ1094.2 +059900 SEQ-EOF-003. SQ1094.2 +060000 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ1094.2 +060100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1094.2 +060200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1094.2 +060300 SEQ-FAIL-003. SQ1094.2 +060400 PERFORM FAIL. SQ1094.2 +060500 SEQ-WRITE-003. SQ1094.2 +060600 MOVE "SEQ-TEST-003" TO PAR-NAME. SQ1094.2 +060700 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1094.2 +060800 PERFORM PRINT-DETAIL. SQ1094.2 +060900 SEQ-CLOSE-003. SQ1094.2 +061000 CLOSE SQ-FS1. SQ1094.2 +061100 TERMINATE-ROUTINE. SQ1094.2 +061200 EXIT. SQ1094.2 +061300 CCVS-EXIT SECTION. SQ1094.2 +061400 CCVS-999999. SQ1094.2 +061500 GO TO CLOSE-FILES. SQ1094.2 +*END-OF,SQ109M +*HEADER,COBOL,SQ110M +000100 IDENTIFICATION DIVISION. SQ1104.2 +000200 PROGRAM-ID. SQ1104.2 +000300 SQ110M. SQ1104.2 +000400**************************************************************** SQ1104.2 +000500* * SQ1104.2 +000600* VALIDATION FOR:- * SQ1104.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1104.2 +000800* * SQ1104.2 +000900* CREATION DATE / VALIDATION DATE * SQ1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1104.2 +001100* * SQ1104.2 +001200**************************************************************** SQ1104.2 +001300 SQ1104.2 +001400* THIS ROUTINE CREATES A 2 UNIT MASS-STORAGE SQ1104.2 +001500* FILE WHICH HAS FIXED LENGTH RECORDS. THE FILE IS THEN SQ1104.2 +001600* CLOSED AND OPENED AS AN INPUT FILE. THE FILE IS READ AND SQ1104.2 +001700* FIELDS IN THE INPUT RECORDS ARE COMPARED TO THE VALUES SQ1104.2 +001800* WRITTEN TO ENSURE THAT THE RECORDS WERE PROCESSED CORRECTLY. SQ1104.2 +001900* SQ1104.2 +002000* THE FILE IS CLOSED AND OPENED AGAIN AS AN INPUT FILE. FOUR SQ1104.2 +002100* READ FORMAT OPTIONS ARE USED TO READ THE FILE AND FIELDS IN SQ1104.2 +002200* THE RECORDS ARE VERIFIED. THE OPEN, CLOSE, READ, AND WRITE SQ1104.2 +002300* STATEMENTS ARE TESTED FOR LEVEL ONE FEATURES. SQ1104.2 +002400* SQ1104.2 +002500* USED X-CARDS: SQ1104.2 +002600* XXXXX019 SQ1104.2 +002700* XXXXX055 SQ1104.2 +002800* P XXXXX062 SQ1104.2 +002900* XXXXX082 SQ1104.2 +003000* XXXXX083 SQ1104.2 +003100* C XXXXX084 SQ1104.2 +003200* SQ1104.2 +003300* SQ1104.2 +003400 ENVIRONMENT DIVISION. SQ1104.2 +003500 CONFIGURATION SECTION. SQ1104.2 +003600 SOURCE-COMPUTER. SQ1104.2 +003700 XXXXX082. SQ1104.2 +003800 OBJECT-COMPUTER. SQ1104.2 +003900 XXXXX083. SQ1104.2 +004000 INPUT-OUTPUT SECTION. SQ1104.2 +004100 FILE-CONTROL. SQ1104.2 +004200P SELECT RAW-DATA ASSIGN TO SQ1104.2 +004300P XXXXX062 SQ1104.2 +004400P ORGANIZATION IS INDEXED SQ1104.2 +004500P ACCESS MODE IS RANDOM SQ1104.2 +004600P RECORD KEY IS RAW-DATA-KEY. SQ1104.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ1104.2 +004800 XXXXX055. SQ1104.2 +004900 SELECT SQ-FS3 ASSIGN TO SQ1104.2 +005000 XXXXX019 SQ1104.2 +005100 ORGANIZATION IS SEQUENTIAL SQ1104.2 +005200 ACCESS MODE IS SEQUENTIAL. SQ1104.2 +005300 DATA DIVISION. SQ1104.2 +005400 FILE SECTION. SQ1104.2 +005500P SQ1104.2 +005600PFD RAW-DATA. SQ1104.2 +005700P SQ1104.2 +005800P01 RAW-DATA-SATZ. SQ1104.2 +005900P 05 RAW-DATA-KEY PIC X(6). SQ1104.2 +006000P 05 C-DATE PIC 9(6). SQ1104.2 +006100P 05 C-TIME PIC 9(8). SQ1104.2 +006200P 05 C-NO-OF-TESTS PIC 99. SQ1104.2 +006300P 05 C-OK PIC 999. SQ1104.2 +006400P 05 C-ALL PIC 999. SQ1104.2 +006500P 05 C-FAIL PIC 999. SQ1104.2 +006600P 05 C-DELETED PIC 999. SQ1104.2 +006700P 05 C-INSPECT PIC 999. SQ1104.2 +006800P 05 C-NOTE PIC X(13). SQ1104.2 +006900P 05 C-INDENT PIC X. SQ1104.2 +007000P 05 C-ABORT PIC X(8). SQ1104.2 +007100 FD PRINT-FILE SQ1104.2 +007200C LABEL RECORDS SQ1104.2 +007300C XXXXX084 SQ1104.2 +007400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1104.2 +007500 . SQ1104.2 +007600 01 PRINT-REC PICTURE X(120). SQ1104.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1104.2 +007800 FD SQ-FS3 SQ1104.2 +007900C LABEL RECORDS ARE STANDARD SQ1104.2 +008000C DATA RECORD SQ-FS3R1-F-G-120 SQ1104.2 +008100 BLOCK CONTAINS 120 CHARACTERS SQ1104.2 +008200 RECORD CONTAINS 120 CHARACTERS. SQ1104.2 +008300 01 SQ-FS3R1-F-G-120. SQ1104.2 +008400 02 FILLER PIC X(120). SQ1104.2 +008500 WORKING-STORAGE SECTION. SQ1104.2 +008600 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. SQ1104.2 +008700 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1104.2 +008800 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1104.2 +008900 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1104.2 +009000 01 FILE-RECORD-INFORMATION-REC. SQ1104.2 +009100 03 FILE-RECORD-INFO-SKELETON. SQ1104.2 +009200 05 FILLER PICTURE X(48) VALUE SQ1104.2 +009300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1104.2 +009400 05 FILLER PICTURE X(46) VALUE SQ1104.2 +009500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1104.2 +009600 05 FILLER PICTURE X(26) VALUE SQ1104.2 +009700 ",LFIL=000000,ORG= ,LBLR= ". SQ1104.2 +009800 05 FILLER PICTURE X(37) VALUE SQ1104.2 +009900 ",RECKEY= ". SQ1104.2 +010000 05 FILLER PICTURE X(38) VALUE SQ1104.2 +010100 ",ALTKEY1= ". SQ1104.2 +010200 05 FILLER PICTURE X(38) VALUE SQ1104.2 +010300 ",ALTKEY2= ". SQ1104.2 +010400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1104.2 +010500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1104.2 +010600 05 FILE-RECORD-INFO-P1-120. SQ1104.2 +010700 07 FILLER PIC X(5). SQ1104.2 +010800 07 XFILE-NAME PIC X(6). SQ1104.2 +010900 07 FILLER PIC X(8). SQ1104.2 +011000 07 XRECORD-NAME PIC X(6). SQ1104.2 +011100 07 FILLER PIC X(1). SQ1104.2 +011200 07 REELUNIT-NUMBER PIC 9(1). SQ1104.2 +011300 07 FILLER PIC X(7). SQ1104.2 +011400 07 XRECORD-NUMBER PIC 9(6). SQ1104.2 +011500 07 FILLER PIC X(6). SQ1104.2 +011600 07 UPDATE-NUMBER PIC 9(2). SQ1104.2 +011700 07 FILLER PIC X(5). SQ1104.2 +011800 07 ODO-NUMBER PIC 9(4). SQ1104.2 +011900 07 FILLER PIC X(5). SQ1104.2 +012000 07 XPROGRAM-NAME PIC X(5). SQ1104.2 +012100 07 FILLER PIC X(7). SQ1104.2 +012200 07 XRECORD-LENGTH PIC 9(6). SQ1104.2 +012300 07 FILLER PIC X(7). SQ1104.2 +012400 07 CHARS-OR-RECORDS PIC X(2). SQ1104.2 +012500 07 FILLER PIC X(1). SQ1104.2 +012600 07 XBLOCK-SIZE PIC 9(4). SQ1104.2 +012700 07 FILLER PIC X(6). SQ1104.2 +012800 07 RECORDS-IN-FILE PIC 9(6). SQ1104.2 +012900 07 FILLER PIC X(5). SQ1104.2 +013000 07 XFILE-ORGANIZATION PIC X(2). SQ1104.2 +013100 07 FILLER PIC X(6). SQ1104.2 +013200 07 XLABEL-TYPE PIC X(1). SQ1104.2 +013300 05 FILE-RECORD-INFO-P121-240. SQ1104.2 +013400 07 FILLER PIC X(8). SQ1104.2 +013500 07 XRECORD-KEY PIC X(29). SQ1104.2 +013600 07 FILLER PIC X(9). SQ1104.2 +013700 07 ALTERNATE-KEY1 PIC X(29). SQ1104.2 +013800 07 FILLER PIC X(9). SQ1104.2 +013900 07 ALTERNATE-KEY2 PIC X(29). SQ1104.2 +014000 07 FILLER PIC X(7). SQ1104.2 +014100 01 TEST-RESULTS. SQ1104.2 +014200 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1104.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1104.2 +014600 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014700 02 PAR-NAME. SQ1104.2 +014800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1104.2 +014900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1104.2 +015000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1104.2 +015100 03 FILLER PIC X(5) VALUE SPACE. SQ1104.2 +015200 02 FILLER PIC X(10) VALUE SPACE. SQ1104.2 +015300 02 RE-MARK PIC X(61). SQ1104.2 +015400 01 TEST-COMPUTED. SQ1104.2 +015500 02 FILLER PIC X(30) VALUE SPACE. SQ1104.2 +015600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1104.2 +015700 02 COMPUTED-X. SQ1104.2 +015800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1104.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1104.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1104.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1104.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1104.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1104.2 +016400 04 COMPUTED-18V0 PICTURE -9(18). SQ1104.2 +016500 04 FILLER PICTURE X. SQ1104.2 +016600 03 FILLER PIC X(50) VALUE SPACE. SQ1104.2 +016700 01 TEST-CORRECT. SQ1104.2 +016800 02 FILLER PIC X(30) VALUE SPACE. SQ1104.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1104.2 +017000 02 CORRECT-X. SQ1104.2 +017100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1104.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1104.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1104.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1104.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1104.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. SQ1104.2 +017700 04 CORRECT-18V0 PICTURE -9(18). SQ1104.2 +017800 04 FILLER PICTURE X. SQ1104.2 +017900 03 FILLER PIC X(50) VALUE SPACE. SQ1104.2 +018000 01 CCVS-C-1. SQ1104.2 +018100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1104.2 +018200- "SS PARAGRAPH-NAME SQ1104.2 +018300- " REMARKS". SQ1104.2 +018400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1104.2 +018500 01 CCVS-C-2. SQ1104.2 +018600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +018700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1104.2 +018800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1104.2 +018900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1104.2 +019000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1104.2 +019100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1104.2 +019200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1104.2 +019300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1104.2 +019400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1104.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1104.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1104.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1104.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1104.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1104.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1104.2 +020100 01 CCVS-H-1. SQ1104.2 +020200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1104.2 +020300 02 FILLER PICTURE X(67) VALUE SQ1104.2 +020400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1104.2 +020500- " SYSTEM". SQ1104.2 +020600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1104.2 +020700 01 CCVS-H-2. SQ1104.2 +020800 02 FILLER PICTURE X(52) VALUE IS SQ1104.2 +020900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1104.2 +021000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1104.2 +021100 02 TEST-ID PICTURE IS X(9). SQ1104.2 +021200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1104.2 +021300 01 CCVS-H-3. SQ1104.2 +021400 02 FILLER PICTURE X(34) VALUE SQ1104.2 +021500 " FOR OFFICIAL USE ONLY ". SQ1104.2 +021600 02 FILLER PICTURE X(58) VALUE SQ1104.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1104.2 +021800 02 FILLER PICTURE X(28) VALUE SQ1104.2 +021900 " COPYRIGHT 1985 ". SQ1104.2 +022000 01 CCVS-E-1. SQ1104.2 +022100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1104.2 +022200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1104.2 +022300 02 ID-AGAIN PICTURE IS X(9). SQ1104.2 +022400 02 FILLER PICTURE X(45) VALUE IS SQ1104.2 +022500 " NTIS DISTRIBUTION COBOL 85". SQ1104.2 +022600 01 CCVS-E-2. SQ1104.2 +022700 02 FILLER PICTURE X(31) VALUE SQ1104.2 +022800 SPACE. SQ1104.2 +022900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1104.2 +023000 02 CCVS-E-2-2. SQ1104.2 +023100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1104.2 +023200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +023300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1104.2 +023400 01 CCVS-E-3. SQ1104.2 +023500 02 FILLER PICTURE X(22) VALUE SQ1104.2 +023600 " FOR OFFICIAL USE ONLY". SQ1104.2 +023700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1104.2 +023800 02 FILLER PICTURE X(58) VALUE SQ1104.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1104.2 +024000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1104.2 +024100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1104.2 +024200 01 CCVS-E-4. SQ1104.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1104.2 +024400 02 FILLER PIC XXXX VALUE " OF ". SQ1104.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1104.2 +024600 02 FILLER PIC X(40) VALUE SQ1104.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1104.2 +024800 01 XXINFO. SQ1104.2 +024900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1104.2 +025000 02 INFO-TEXT. SQ1104.2 +025100 04 FILLER PIC X(20) VALUE SPACE. SQ1104.2 +025200 04 XXCOMPUTED PIC X(20). SQ1104.2 +025300 04 FILLER PIC X(5) VALUE SPACE. SQ1104.2 +025400 04 XXCORRECT PIC X(20). SQ1104.2 +025500 01 HYPHEN-LINE. SQ1104.2 +025600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +025700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1104.2 +025800- "*****************************************". SQ1104.2 +025900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1104.2 +026000- "******************************". SQ1104.2 +026100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1104.2 +026200 "SQ110M". SQ1104.2 +026300 PROCEDURE DIVISION. SQ1104.2 +026400 CCVS1 SECTION. SQ1104.2 +026500 OPEN-FILES. SQ1104.2 +026600P OPEN I-O RAW-DATA. SQ1104.2 +026700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1104.2 +026800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1104.2 +026900P MOVE "ABORTED " TO C-ABORT. SQ1104.2 +027000P ADD 1 TO C-NO-OF-TESTS. SQ1104.2 +027100P ACCEPT C-DATE FROM DATE. SQ1104.2 +027200P ACCEPT C-TIME FROM TIME. SQ1104.2 +027300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1104.2 +027400PEND-E-1. SQ1104.2 +027500P CLOSE RAW-DATA. SQ1104.2 +027600 OPEN OUTPUT PRINT-FILE. SQ1104.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1104.2 +027800 MOVE SPACE TO TEST-RESULTS. SQ1104.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1104.2 +028000 MOVE ZERO TO REC-SKL-SUB. SQ1104.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1104.2 +028200 CCVS-INIT-FILE. SQ1104.2 +028300 ADD 1 TO REC-SKL-SUB. SQ1104.2 +028400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1104.2 +028500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1104.2 +028600 CCVS-INIT-EXIT. SQ1104.2 +028700 GO TO CCVS1-EXIT. SQ1104.2 +028800 CLOSE-FILES. SQ1104.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1104.2 +029000P OPEN I-O RAW-DATA. SQ1104.2 +029100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1104.2 +029200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1104.2 +029300P MOVE "OK. " TO C-ABORT. SQ1104.2 +029400P MOVE PASS-COUNTER TO C-OK. SQ1104.2 +029500P MOVE ERROR-HOLD TO C-ALL. SQ1104.2 +029600P MOVE ERROR-COUNTER TO C-FAIL. SQ1104.2 +029700P MOVE DELETE-CNT TO C-DELETED. SQ1104.2 +029800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1104.2 +029900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1104.2 +030000PEND-E-2. SQ1104.2 +030100P CLOSE RAW-DATA. SQ1104.2 +030200 TERMINATE-CCVS. SQ1104.2 +030300S EXIT PROGRAM. SQ1104.2 +030400STERMINATE-CALL. SQ1104.2 +030500 STOP RUN. SQ1104.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1104.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1104.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1104.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1104.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1104.2 +031100 PRINT-DETAIL. SQ1104.2 +031200 IF REC-CT NOT EQUAL TO ZERO SQ1104.2 +031300 MOVE "." TO PARDOT-X SQ1104.2 +031400 MOVE REC-CT TO DOTVALUE. SQ1104.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1104.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1104.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1104.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1104.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1104.2 +032000 MOVE SPACE TO CORRECT-X. SQ1104.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1104.2 +032200 MOVE SPACE TO RE-MARK. SQ1104.2 +032300 HEAD-ROUTINE. SQ1104.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +032500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1104.2 +032600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1104.2 +032700 COLUMN-NAMES-ROUTINE. SQ1104.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +033000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +033100 END-ROUTINE. SQ1104.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1104.2 +033300 END-RTN-EXIT. SQ1104.2 +033400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +033500 END-ROUTINE-1. SQ1104.2 +033600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1104.2 +033700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1104.2 +033800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1104.2 +033900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1104.2 +034000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1104.2 +034100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1104.2 +034200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1104.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1104.2 +034400 END-ROUTINE-12. SQ1104.2 +034500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1104.2 +034600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1104.2 +034700 MOVE "NO " TO ERROR-TOTAL SQ1104.2 +034800 ELSE SQ1104.2 +034900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1104.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1104.2 +035100 PERFORM WRITE-LINE. SQ1104.2 +035200 END-ROUTINE-13. SQ1104.2 +035300 IF DELETE-CNT IS EQUAL TO ZERO SQ1104.2 +035400 MOVE "NO " TO ERROR-TOTAL ELSE SQ1104.2 +035500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1104.2 +035600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1104.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +035800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1104.2 +035900 MOVE "NO " TO ERROR-TOTAL SQ1104.2 +036000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1104.2 +036100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1104.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +036300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +036400 WRITE-LINE. SQ1104.2 +036500 ADD 1 TO RECORD-COUNT. SQ1104.2 +036600Y IF RECORD-COUNT GREATER 50 SQ1104.2 +036700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1104.2 +036800Y MOVE SPACE TO DUMMY-RECORD SQ1104.2 +036900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1104.2 +037000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1104.2 +037100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1104.2 +037200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1104.2 +037300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1104.2 +037400Y MOVE ZERO TO RECORD-COUNT. SQ1104.2 +037500 PERFORM WRT-LN. SQ1104.2 +037600 WRT-LN. SQ1104.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1104.2 +037800 MOVE SPACE TO DUMMY-RECORD. SQ1104.2 +037900 BLANK-LINE-PRINT. SQ1104.2 +038000 PERFORM WRT-LN. SQ1104.2 +038100 FAIL-ROUTINE. SQ1104.2 +038200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1104.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1104.2 +038400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1104.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +038600 GO TO FAIL-ROUTINE-EX. SQ1104.2 +038700 FAIL-ROUTINE-WRITE. SQ1104.2 +038800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1104.2 +038900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +039000 FAIL-ROUTINE-EX. EXIT. SQ1104.2 +039100 BAIL-OUT. SQ1104.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1104.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1104.2 +039400 BAIL-OUT-WRITE. SQ1104.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1104.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +039700 BAIL-OUT-EX. EXIT. SQ1104.2 +039800 CCVS1-EXIT. SQ1104.2 +039900 EXIT. SQ1104.2 +040000 SECT-SQ110M-0001 SECTION. SQ1104.2 +040100 SEQ-INIT-007. SQ1104.2 +040200 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1104.2 +040300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1104.2 +040400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1104.2 +040500 MOVE 120 TO XRECORD-LENGTH (1). SQ1104.2 +040600 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1104.2 +040700 MOVE 120 TO XBLOCK-SIZE (1). SQ1104.2 +040800 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1104.2 +040900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1104.2 +041000 MOVE "S" TO XLABEL-TYPE (1). SQ1104.2 +041100 MOVE 000001 TO XRECORD-NUMBER (1). SQ1104.2 +041200 OPEN OUTPUT SQ-FS3. SQ1104.2 +041300 SEQ-TEST-007. SQ1104.2 +041400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1104.2 +041500 WRITE SQ-FS3R1-F-G-120. SQ1104.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO 196 SQ1104.2 +041700E ADD 1 TO REELUNIT-NUMBER (1) SQ1104.2 +041800E CLOSE SQ-FS3 UNIT. SQ1104.2 +041900F MOVE "CLOSE UNIT DELETED" TO RE-MARK. SQ1104.2 +042000 IF XRECORD-NUMBER (1) EQUAL TO 649 SQ1104.2 +042100 GO TO SEQ-WRITE-007. SQ1104.2 +042200 ADD 1 TO XRECORD-NUMBER (1). SQ1104.2 +042300 GO TO SEQ-TEST-007. SQ1104.2 +042400 SEQ-WRITE-007. SQ1104.2 +042500 MOVE "CREATE FILE SQ-FS3" TO FEATURE. SQ1104.2 +042600 MOVE "SEQ-TEST-007" TO PAR-NAME. SQ1104.2 +042700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1104.2 +042800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1104.2 +042900 PERFORM PRINT-DETAIL. SQ1104.2 +043000 CLOSE SQ-FS3. SQ1104.2 +043100* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1104.2 +043200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1104.2 +043300 SEQ-INIT-008. SQ1104.2 +043400 MOVE ZERO TO WRK-CS-09V00. SQ1104.2 +043500* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1104.2 +043600* SEQ-TEST-007. SQ1104.2 +043700 OPEN INPUT SQ-FS3. SQ1104.2 +043800 SEQ-TEST-008. SQ1104.2 +043900 READ SQ-FS3 RECORD SQ1104.2 +044000 AT END GO TO SEQ-TEST-008-1. SQ1104.2 +044100 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1104.2 +044200 ADD 1 TO WRK-CS-09V00. SQ1104.2 +044300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +044400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1104.2 +044500 GO TO SEQ-FAIL-008. SQ1104.2 +044600 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1104.2 +044700 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +044800 GO TO SEQ-TEST-008. SQ1104.2 +044900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" SQ1104.2 +045000 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +045100 GO TO SEQ-TEST-008. SQ1104.2 +045200 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1104.2 +045300 ADD 1 TO RECORDS-IN-ERROR. SQ1104.2 +045400 GO TO SEQ-TEST-008. SQ1104.2 +045500 SEQ-TEST-008-1. SQ1104.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1104.2 +045700 GO TO SEQ-PASS-008. SQ1104.2 +045800 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1104.2 +045900 SEQ-FAIL-008. SQ1104.2 +046000 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1104.2 +046100 PERFORM FAIL. SQ1104.2 +046200 GO TO SEQ-WRITE-008. SQ1104.2 +046300 SEQ-PASS-008. SQ1104.2 +046400 PERFORM PASS. SQ1104.2 +046500 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1104.2 +046600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1104.2 +046700 SEQ-WRITE-008. SQ1104.2 +046800 MOVE "SEQ-TEST-008" TO PAR-NAME. SQ1104.2 +046900 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1104.2 +047000 PERFORM PRINT-DETAIL. SQ1104.2 +047100 SEQ-CLOSE-008. SQ1104.2 +047200 CLOSE SQ-FS3. SQ1104.2 +047300 READ-INIT-GF-01. SQ1104.2 +047400 MOVE ZERO TO WRK-CS-09V00. SQ1104.2 +047500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1104.2 +047600 OPEN INPUT SQ-FS3. SQ1104.2 +047700* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1104.2 +047800* IN THIS SERIES OF TESTS. SQ1104.2 +047900 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1104.2 +048000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1104.2 +048100 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +048200 READ-TEST-GF-01. SQ1104.2 +048300 READ SQ-FS3 RECORD SQ1104.2 +048400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +048500 MOVE 1 TO EOF-FLAG SQ1104.2 +048600 GO TO READ-FAIL-GF-01. SQ1104.2 +048700 PERFORM RECORD-CHECK. SQ1104.2 +048800 IF WRK-CS-09V00 EQUAL TO 50 SQ1104.2 +048900 GO TO READ-TEST-GF-01-1. SQ1104.2 +049000 GO TO READ-TEST-GF-01. SQ1104.2 +049100 RECORD-CHECK. SQ1104.2 +049200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1104.2 +049300 ADD 1 TO WRK-CS-09V00. SQ1104.2 +049400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1104.2 +049500 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +049600 MOVE 1 TO ERROR-FLAG. SQ1104.2 +049700 READ-TEST-GF-01-1. SQ1104.2 +049800 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +049900 GO TO READ-PASS-GF-01. SQ1104.2 +050000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +050100 READ-FAIL-GF-01. SQ1104.2 +050200 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +050300 PERFORM FAIL. SQ1104.2 +050400 GO TO READ-WRITE-GF-01. SQ1104.2 +050500 READ-PASS-GF-01. SQ1104.2 +050600 PERFORM PASS. SQ1104.2 +050700 READ-WRITE-GF-01. SQ1104.2 +050800 PERFORM PRINT-DETAIL. SQ1104.2 +050900 READ-INIT-GF-02. SQ1104.2 +051000 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +051100 GO TO SEQ-EOF-009. SQ1104.2 +051200 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +051300 MOVE "READ...AT END..." TO FEATURE. SQ1104.2 +051400 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1104.2 +051500 READ-TEST-GF-02. SQ1104.2 +051600 READ SQ-FS3 AT END SQ1104.2 +051700 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +051800 MOVE 1 TO EOF-FLAG SQ1104.2 +051900 GO TO READ-FAIL-GF-02. SQ1104.2 +052000 PERFORM RECORD-CHECK. SQ1104.2 +052100 IF WRK-CS-09V00 EQUAL TO 200 SQ1104.2 +052200 GO TO READ-TEST-GF-02-1. SQ1104.2 +052300 GO TO READ-TEST-GF-02. SQ1104.2 +052400 READ-TEST-GF-02-1. SQ1104.2 +052500 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +052600 GO TO READ-PASS-GF-02. SQ1104.2 +052700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +052800 READ-FAIL-GF-02. SQ1104.2 +052900 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +053000 PERFORM FAIL. SQ1104.2 +053100 GO TO READ-WRITE-GF-02. SQ1104.2 +053200 READ-PASS-GF-02. SQ1104.2 +053300 PERFORM PASS. SQ1104.2 +053400 READ-WRITE-GF-02. SQ1104.2 +053500 PERFORM PRINT-DETAIL. SQ1104.2 +053600 READ-INIT-GF-03. SQ1104.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +053800 GO TO SEQ-EOF-009. SQ1104.2 +053900 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +054000 MOVE "READ...RECORD END..." TO FEATURE. SQ1104.2 +054100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1104.2 +054200 READ-TEST-GF-03. SQ1104.2 +054300 READ SQ-FS3 RECORD END SQ1104.2 +054400 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +054500 MOVE 1 TO EOF-FLAG SQ1104.2 +054600 GO TO READ-FAIL-GF-03. SQ1104.2 +054700 PERFORM RECORD-CHECK. SQ1104.2 +054800 IF WRK-CS-09V00 EQUAL TO 499 SQ1104.2 +054900 GO TO READ-TEST-GF-03-1. SQ1104.2 +055000 GO TO READ-TEST-GF-03. SQ1104.2 +055100 READ-TEST-GF-03-1. SQ1104.2 +055200 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +055300 GO TO READ-PASS-GF-03. SQ1104.2 +055400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +055500 READ-FAIL-GF-03. SQ1104.2 +055600 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +055700 PERFORM FAIL. SQ1104.2 +055800 GO TO READ-WRITE-GF-03. SQ1104.2 +055900 READ-PASS-GF-03. SQ1104.2 +056000 PERFORM PASS. SQ1104.2 +056100 READ-WRITE-GF-03. SQ1104.2 +056200 PERFORM PRINT-DETAIL. SQ1104.2 +056300 READ-INIT-GF-04. SQ1104.2 +056400 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +056500 GO TO SEQ-EOF-009. SQ1104.2 +056600 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +056700 MOVE "READ...END..." TO FEATURE. SQ1104.2 +056800 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1104.2 +056900 READ-TEST-GF-04. SQ1104.2 +057000 READ SQ-FS3 END SQ1104.2 +057100 GO TO READ-TEST-GF-04-1. SQ1104.2 +057200 PERFORM RECORD-CHECK. SQ1104.2 +057300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +057400 GO TO READ-TEST-GF-04-1. SQ1104.2 +057500 GO TO READ-TEST-GF-04. SQ1104.2 +057600 READ-TEST-GF-04-1. SQ1104.2 +057700 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +057800 GO TO READ-PASS-GF-04. SQ1104.2 +057900 READ-FAIL-GF-04. SQ1104.2 +058000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +058100 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +058200 PERFORM FAIL. SQ1104.2 +058300 GO TO READ-WRITE-GF-04. SQ1104.2 +058400 READ-PASS-GF-04. SQ1104.2 +058500 PERFORM PASS. SQ1104.2 +058600 READ-WRITE-GF-04. SQ1104.2 +058700 PERFORM PRINT-DETAIL. SQ1104.2 +058800 SEQ-TEST-009. SQ1104.2 +058900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1104.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1104.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1104.2 +059200 GO TO SEQ-FAIL-009. SQ1104.2 +059300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +059400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1104.2 +059500 GO TO SEQ-FAIL-009. SQ1104.2 +059600 SEQ-PASS-009. SQ1104.2 +059700 PERFORM PASS SQ1104.2 +059800 GO TO SEQ-WRITE-009. SQ1104.2 +059900 SEQ-EOF-009. SQ1104.2 +060000 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1104.2 +060100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1104.2 +060200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1104.2 +060300 SEQ-FAIL-009. SQ1104.2 +060400 PERFORM FAIL. SQ1104.2 +060500 SEQ-WRITE-009. SQ1104.2 +060600 MOVE "SEQ-TEST-009" TO PAR-NAME. SQ1104.2 +060700 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1104.2 +060800 PERFORM PRINT-DETAIL. SQ1104.2 +060900 SEQ-CLOSE-009. SQ1104.2 +061000 CLOSE SQ-FS3. SQ1104.2 +061100 TERMINATE-ROUTINE. SQ1104.2 +061200 EXIT. SQ1104.2 +061300 CCVS-EXIT SECTION. SQ1104.2 +061400 CCVS-999999. SQ1104.2 +061500 GO TO CLOSE-FILES. SQ1104.2 +*END-OF,SQ110M +*HEADER,COBOL,SQ111A +000100 IDENTIFICATION DIVISION. SQ1114.2 +000200 PROGRAM-ID. SQ1114.2 +000300 SQ111A. SQ1114.2 +000400**************************************************************** SQ1114.2 +000500* * SQ1114.2 +000600* VALIDATION FOR:- * SQ1114.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1114.2 +000800* * SQ1114.2 +000900* CREATION DATE / VALIDATION DATE * SQ1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1114.2 +001100* * SQ1114.2 +001200**************************************************************** SQ1114.2 +001300 SQ1114.2 +001400* THIS ROUTINE CREATES A SEQUENTIAL TAPE FILE CONTAINING SQ1114.2 +001500* 595 RECORDS, EACH RECORD CONTAINING 155 CHARACTERS. THE SQ1114.2 +001600* CODE-SET CLAUSE IS INCLUDED IN THE FILE DESCRIPTION ENTRY SQ1114.2 +001700* FOR THE FILE. THE RECORD DESCRIPTION FOR THE FILE CONTAINS SQ1114.2 +001800* AN ITEM WITH THE SIGN IS SEPARATE CHARACTER CLAUSE. SQ1114.2 +001900* A SEQUENTIAL TAPE FILE WITH 595 RECORDS HAS BEEN SQ1114.2 +002000* CREATED. THE FD FOR THE FILE CONTAINS A CODE-SET CLAUSE. SQ1114.2 +002100* THERE ARE 155 CHARACTERS PER RECORD INCLUDING A NUMERIC SQ1114.2 +002200* ITEM WITH THE SIGN IS SEPARATE CLAUSE. SQ1114.2 +002300* SQ1114.2 +002400* USED X-CARDS: SQ1114.2 +002500* XXXXX001 SQ1114.2 +002600* XXXXX055 SQ1114.2 +002700* P XXXXX062 SQ1114.2 +002800* XXXXX082 SQ1114.2 +002900* XXXXX083 SQ1114.2 +003000* C XXXXX084 SQ1114.2 +003100* SQ1114.2 +003200* SQ1114.2 +003300 ENVIRONMENT DIVISION. SQ1114.2 +003400 CONFIGURATION SECTION. SQ1114.2 +003500 SOURCE-COMPUTER. SQ1114.2 +003600 XXXXX082. SQ1114.2 +003700 OBJECT-COMPUTER. SQ1114.2 +003800 XXXXX083. SQ1114.2 +003900 SPECIAL-NAMES. SQ1114.2 +004000 ALPHABET TAPE-CHARACTER-SET IS STANDARD-1. SQ1114.2 +004100 INPUT-OUTPUT SECTION. SQ1114.2 +004200 FILE-CONTROL. SQ1114.2 +004300P SELECT RAW-DATA ASSIGN TO SQ1114.2 +004400P XXXXX062 SQ1114.2 +004500P ORGANIZATION IS INDEXED SQ1114.2 +004600P ACCESS MODE IS RANDOM SQ1114.2 +004700P RECORD KEY IS RAW-DATA-KEY. SQ1114.2 +004800 SELECT PRINT-FILE ASSIGN TO SQ1114.2 +004900 XXXXX055. SQ1114.2 +005000 SELECT SQ-FS1 ASSIGN TO SQ1114.2 +005100 XXXXX001 SQ1114.2 +005200 ORGANIZATION IS SEQUENTIAL. SQ1114.2 +005300 DATA DIVISION. SQ1114.2 +005400 FILE SECTION. SQ1114.2 +005500P SQ1114.2 +005600PFD RAW-DATA. SQ1114.2 +005700P SQ1114.2 +005800P01 RAW-DATA-SATZ. SQ1114.2 +005900P 05 RAW-DATA-KEY PIC X(6). SQ1114.2 +006000P 05 C-DATE PIC 9(6). SQ1114.2 +006100P 05 C-TIME PIC 9(8). SQ1114.2 +006200P 05 C-NO-OF-TESTS PIC 99. SQ1114.2 +006300P 05 C-OK PIC 999. SQ1114.2 +006400P 05 C-ALL PIC 999. SQ1114.2 +006500P 05 C-FAIL PIC 999. SQ1114.2 +006600P 05 C-DELETED PIC 999. SQ1114.2 +006700P 05 C-INSPECT PIC 999. SQ1114.2 +006800P 05 C-NOTE PIC X(13). SQ1114.2 +006900P 05 C-INDENT PIC X. SQ1114.2 +007000P 05 C-ABORT PIC X(8). SQ1114.2 +007100 FD PRINT-FILE SQ1114.2 +007200C LABEL RECORDS SQ1114.2 +007300C XXXXX084 SQ1114.2 +007400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1114.2 +007500 . SQ1114.2 +007600 01 PRINT-REC PICTURE X(120). SQ1114.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1114.2 +007800 FD SQ-FS1 SQ1114.2 +007900C LABEL RECORD STANDARD SQ1114.2 +008000 CODE-SET IS TAPE-CHARACTER-SET . SQ1114.2 +008100 01 SQ-FS1R1-F-G-155. SQ1114.2 +008200 02 SQ-FS1-FIRST PICTURE X(120). SQ1114.2 +008300 02 SQ-FS1-RECNO PIC S9(5) SIGN IS LEADING SQ1114.2 +008400 SEPARATE CHARACTER. SQ1114.2 +008500 02 SQ-FS1-FILLER PICTURE X(30). SQ1114.2 +008600 WORKING-STORAGE SECTION. SQ1114.2 +008700 01 COUNT-OF-RECS PIC S9(5) VALUE ZERO. SQ1114.2 +008800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1114.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1114.2 +009000 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1114.2 +009100 01 COMPARE-ITEM. SQ1114.2 +009200 02 FILLER PICTURE X. SQ1114.2 +009300 02 COMPARE-REC-NO PICTURE 9(5). SQ1114.2 +009400 01 TEMP-STORE-FOR-PRINT. SQ1114.2 +009500 02 TEMP-FIRST PIC X(120). SQ1114.2 +009600 02 TEMP-SECOND. SQ1114.2 +009700 03 TEMP-RECNO PIC X(6). SQ1114.2 +009800 03 TEMP-FILLER PIC X(30). SQ1114.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ1114.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ1114.2 +010100 05 FILLER PICTURE X(48) VALUE SQ1114.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1114.2 +010300 05 FILLER PICTURE X(46) VALUE SQ1114.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1114.2 +010500 05 FILLER PICTURE X(26) VALUE SQ1114.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ1114.2 +010700 05 FILLER PICTURE X(37) VALUE SQ1114.2 +010800 ",RECKEY= ". SQ1114.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1114.2 +011000 ",ALTKEY1= ". SQ1114.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1114.2 +011200 ",ALTKEY2= ". SQ1114.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1114.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1114.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ1114.2 +011600 07 FILLER PIC X(5). SQ1114.2 +011700 07 XFILE-NAME PIC X(6). SQ1114.2 +011800 07 FILLER PIC X(8). SQ1114.2 +011900 07 XRECORD-NAME PIC X(6). SQ1114.2 +012000 07 FILLER PIC X(1). SQ1114.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ1114.2 +012200 07 FILLER PIC X(7). SQ1114.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ1114.2 +012400 07 FILLER PIC X(6). SQ1114.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ1114.2 +012600 07 FILLER PIC X(5). SQ1114.2 +012700 07 ODO-NUMBER PIC 9(4). SQ1114.2 +012800 07 FILLER PIC X(5). SQ1114.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ1114.2 +013000 07 FILLER PIC X(7). SQ1114.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ1114.2 +013200 07 FILLER PIC X(7). SQ1114.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ1114.2 +013400 07 FILLER PIC X(1). SQ1114.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ1114.2 +013600 07 FILLER PIC X(6). SQ1114.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ1114.2 +013800 07 FILLER PIC X(5). SQ1114.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ1114.2 +014000 07 FILLER PIC X(6). SQ1114.2 +014100 07 XLABEL-TYPE PIC X(1). SQ1114.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ1114.2 +014300 07 FILLER PIC X(8). SQ1114.2 +014400 07 XRECORD-KEY PIC X(29). SQ1114.2 +014500 07 FILLER PIC X(9). SQ1114.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ1114.2 +014700 07 FILLER PIC X(9). SQ1114.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ1114.2 +014900 07 FILLER PIC X(7). SQ1114.2 +015000 01 TEST-RESULTS. SQ1114.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1114.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1114.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015600 02 PAR-NAME. SQ1114.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ1114.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ1114.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1114.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ1114.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ1114.2 +016200 02 RE-MARK PIC X(61). SQ1114.2 +016300 01 TEST-COMPUTED. SQ1114.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1114.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1114.2 +016600 02 COMPUTED-X. SQ1114.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1114.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1114.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1114.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1114.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1114.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1114.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ1114.2 +017400 04 FILLER PICTURE X. SQ1114.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ1114.2 +017600 01 TEST-CORRECT. SQ1114.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ1114.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1114.2 +017900 02 CORRECT-X. SQ1114.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1114.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1114.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1114.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1114.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1114.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ1114.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ1114.2 +018700 04 FILLER PICTURE X. SQ1114.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ1114.2 +018900 01 CCVS-C-1. SQ1114.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1114.2 +019100- "SS PARAGRAPH-NAME SQ1114.2 +019200- " REMARKS". SQ1114.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1114.2 +019400 01 CCVS-C-2. SQ1114.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1114.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1114.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1114.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1114.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1114.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ1114.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1114.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1114.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1114.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1114.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1114.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1114.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1114.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1114.2 +021000 01 CCVS-H-1. SQ1114.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ1114.2 +021200 02 FILLER PICTURE X(67) VALUE SQ1114.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1114.2 +021400- " SYSTEM". SQ1114.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ1114.2 +021600 01 CCVS-H-2. SQ1114.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ1114.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1114.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1114.2 +022000 02 TEST-ID PICTURE IS X(9). SQ1114.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1114.2 +022200 01 CCVS-H-3. SQ1114.2 +022300 02 FILLER PICTURE X(34) VALUE SQ1114.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1114.2 +022500 02 FILLER PICTURE X(58) VALUE SQ1114.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1114.2 +022700 02 FILLER PICTURE X(28) VALUE SQ1114.2 +022800 " COPYRIGHT 1985 ". SQ1114.2 +022900 01 CCVS-E-1. SQ1114.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1114.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1114.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ1114.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ1114.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ1114.2 +023500 01 CCVS-E-2. SQ1114.2 +023600 02 FILLER PICTURE X(31) VALUE SQ1114.2 +023700 SPACE. SQ1114.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ1114.2 +023900 02 CCVS-E-2-2. SQ1114.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1114.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1114.2 +024300 01 CCVS-E-3. SQ1114.2 +024400 02 FILLER PICTURE X(22) VALUE SQ1114.2 +024500 " FOR OFFICIAL USE ONLY". SQ1114.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ1114.2 +024700 02 FILLER PICTURE X(58) VALUE SQ1114.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1114.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ1114.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1114.2 +025100 01 CCVS-E-4. SQ1114.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1114.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ1114.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1114.2 +025500 02 FILLER PIC X(40) VALUE SQ1114.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1114.2 +025700 01 XXINFO. SQ1114.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1114.2 +025900 02 INFO-TEXT. SQ1114.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ1114.2 +026100 04 XXCOMPUTED PIC X(20). SQ1114.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1114.2 +026300 04 XXCORRECT PIC X(20). SQ1114.2 +026400 01 HYPHEN-LINE. SQ1114.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1114.2 +026700- "*****************************************". SQ1114.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1114.2 +026900- "******************************". SQ1114.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ1114.2 +027100 "SQ111A". SQ1114.2 +027200 PROCEDURE DIVISION. SQ1114.2 +027300 CCVS1 SECTION. SQ1114.2 +027400 OPEN-FILES. SQ1114.2 +027500P OPEN I-O RAW-DATA. SQ1114.2 +027600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1114.2 +027700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1114.2 +027800P MOVE "ABORTED " TO C-ABORT. SQ1114.2 +027900P ADD 1 TO C-NO-OF-TESTS. SQ1114.2 +028000P ACCEPT C-DATE FROM DATE. SQ1114.2 +028100P ACCEPT C-TIME FROM TIME. SQ1114.2 +028200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1114.2 +028300PEND-E-1. SQ1114.2 +028400P CLOSE RAW-DATA. SQ1114.2 +028500 OPEN OUTPUT PRINT-FILE. SQ1114.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1114.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ1114.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1114.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ1114.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1114.2 +029100 CCVS-INIT-FILE. SQ1114.2 +029200 ADD 1 TO REC-SKL-SUB. SQ1114.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1114.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1114.2 +029500 CCVS-INIT-EXIT. SQ1114.2 +029600 GO TO CCVS1-EXIT. SQ1114.2 +029700 CLOSE-FILES. SQ1114.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1114.2 +029900P OPEN I-O RAW-DATA. SQ1114.2 +030000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1114.2 +030100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1114.2 +030200P MOVE "OK. " TO C-ABORT. SQ1114.2 +030300P MOVE PASS-COUNTER TO C-OK. SQ1114.2 +030400P MOVE ERROR-HOLD TO C-ALL. SQ1114.2 +030500P MOVE ERROR-COUNTER TO C-FAIL. SQ1114.2 +030600P MOVE DELETE-CNT TO C-DELETED. SQ1114.2 +030700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1114.2 +030800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1114.2 +030900PEND-E-2. SQ1114.2 +031000P CLOSE RAW-DATA. SQ1114.2 +031100 TERMINATE-CCVS. SQ1114.2 +031200S EXIT PROGRAM. SQ1114.2 +031300STERMINATE-CALL. SQ1114.2 +031400 STOP RUN. SQ1114.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1114.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1114.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1114.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1114.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1114.2 +032000 PRINT-DETAIL. SQ1114.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1114.2 +032200 MOVE "." TO PARDOT-X SQ1114.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1114.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1114.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1114.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1114.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1114.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1114.2 +032900 MOVE SPACE TO CORRECT-X. SQ1114.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1114.2 +033100 MOVE SPACE TO RE-MARK. SQ1114.2 +033200 HEAD-ROUTINE. SQ1114.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1114.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1114.2 +033600 COLUMN-NAMES-ROUTINE. SQ1114.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +034000 END-ROUTINE. SQ1114.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1114.2 +034200 END-RTN-EXIT. SQ1114.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +034400 END-ROUTINE-1. SQ1114.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1114.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1114.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1114.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1114.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1114.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1114.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1114.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1114.2 +035300 END-ROUTINE-12. SQ1114.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1114.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1114.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1114.2 +035700 ELSE SQ1114.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1114.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1114.2 +036000 PERFORM WRITE-LINE. SQ1114.2 +036100 END-ROUTINE-13. SQ1114.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ1114.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1114.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1114.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1114.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1114.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ1114.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1114.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1114.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +037300 WRITE-LINE. SQ1114.2 +037400 ADD 1 TO RECORD-COUNT. SQ1114.2 +037500Y IF RECORD-COUNT GREATER 50 SQ1114.2 +037600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1114.2 +037700Y MOVE SPACE TO DUMMY-RECORD SQ1114.2 +037800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1114.2 +037900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1114.2 +038000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1114.2 +038100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1114.2 +038200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1114.2 +038300Y MOVE ZERO TO RECORD-COUNT. SQ1114.2 +038400 PERFORM WRT-LN. SQ1114.2 +038500 WRT-LN. SQ1114.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1114.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1114.2 +038800 BLANK-LINE-PRINT. SQ1114.2 +038900 PERFORM WRT-LN. SQ1114.2 +039000 FAIL-ROUTINE. SQ1114.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1114.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1114.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1114.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +039500 GO TO FAIL-ROUTINE-EX. SQ1114.2 +039600 FAIL-ROUTINE-WRITE. SQ1114.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1114.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ1114.2 +040000 BAIL-OUT. SQ1114.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1114.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1114.2 +040300 BAIL-OUT-WRITE. SQ1114.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1114.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +040600 BAIL-OUT-EX. EXIT. SQ1114.2 +040700 CCVS1-EXIT. SQ1114.2 +040800 EXIT. SQ1114.2 +040900 SECT-SQ111A-0001 SECTION. SQ1114.2 +041000 WRITE-INIT-GF-01. SQ1114.2 +041100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1114.2 +041200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1114.2 +041300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1114.2 +041400 MOVE 000155 TO XRECORD-LENGTH (1). SQ1114.2 +041500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1114.2 +041600 MOVE 0001 TO XBLOCK-SIZE (1). SQ1114.2 +041700 MOVE 000595 TO RECORDS-IN-FILE (1). SQ1114.2 +041800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1114.2 +041900 MOVE "S" TO XLABEL-TYPE (1). SQ1114.2 +042000 MOVE 000001 TO XRECORD-NUMBER (1). SQ1114.2 +042100 OPEN OUTPUT SQ-FS1. SQ1114.2 +042200 WRITE-TEST-GF-01. SQ1114.2 +042300 ADD 1 TO COUNT-OF-RECS. SQ1114.2 +042400 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1114.2 +042500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1-FIRST. SQ1114.2 +042600 MOVE COUNT-OF-RECS TO SQ-FS1-RECNO. SQ1114.2 +042700 MOVE "WRITE-SET USED IN CREATING FILE" TO SQ-FS1-FILLER. SQ1114.2 +042800 WRITE SQ-FS1R1-F-G-155. SQ1114.2 +042900 IF COUNT-OF-RECS EQUAL TO 595 SQ1114.2 +043000 GO TO WRITE-WRITE-GF-01. SQ1114.2 +043100 GO TO WRITE-TEST-GF-01. SQ1114.2 +043200 WRITE-WRITE-GF-01. SQ1114.2 +043300 MOVE "WRITE FILE SQ-FS1" TO FEATURE. SQ1114.2 +043400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1114.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1114.2 +043600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1114.2 +043700 MOVE "CODE-SET CLAUSE IN FD" TO RE-MARK. SQ1114.2 +043800 PERFORM PRINT-DETAIL. SQ1114.2 +043900 CLOSE SQ-FS1. SQ1114.2 +044000 READ-INIT-GF-01. SQ1114.2 +044100 MOVE ZERO TO COUNT-OF-RECS. SQ1114.2 +044200* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1114.2 +044300* READ-TEST-GF-01. SQ1114.2 +044400 OPEN INPUT SQ-FS1. SQ1114.2 +044500 READ-TEST-GF-01. SQ1114.2 +044600 READ SQ-FS1 RECORD SQ1114.2 +044700 AT END GO TO READ-TEST-GF-01-1. SQ1114.2 +044800 ADD 1 TO COUNT-OF-RECS. SQ1114.2 +044900 IF COUNT-OF-RECS EQUAL TO 596 SQ1114.2 +045000 MOVE "MORE THAN 595 RECORDS" TO RE-MARK SQ1114.2 +045100 GO TO READ-FAIL-GF-01-1. SQ1114.2 +045200 MOVE SQ-FS1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1114.2 +045300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1114.2 +045400 ADD 1 TO RECORDS-IN-ERROR SQ1114.2 +045500 GO TO READ-TEST-GF-01. SQ1114.2 +045600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1114.2 +045700 ADD 1 TO RECORDS-IN-ERROR SQ1114.2 +045800 GO TO READ-TEST-GF-01. SQ1114.2 +045900 MOVE SQ-FS1-RECNO TO COMPARE-ITEM. SQ1114.2 +046000 IF COMPARE-REC-NO EQUAL TO COUNT-OF-RECS SQ1114.2 +046100 GO TO READ-TEST-GF-01. SQ1114.2 +046200 ADD 1 TO RECORDS-IN-ERROR. SQ1114.2 +046300 GO TO READ-TEST-GF-01. SQ1114.2 +046400 READ-TEST-GF-01-1. SQ1114.2 +046500 IF COUNT-OF-RECS NOT EQUAL TO 595 SQ1114.2 +046600 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1114.2 +046700 MOVE "RECORDS READ =" TO COMPUTED-A SQ1114.2 +046800 MOVE COUNT-OF-RECS TO CORRECT-18V0 SQ1114.2 +046900 GO TO READ-FAIL-GF-01. SQ1114.2 +047000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1114.2 +047100 GO TO READ-PASS-GF-01. SQ1114.2 +047200 MOVE "VII-44; 4.4.2; ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1114.2 +047300 READ-FAIL-GF-01-1. SQ1114.2 +047400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1114.2 +047500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1114.2 +047600 READ-FAIL-GF-01. SQ1114.2 +047700 PERFORM FAIL. SQ1114.2 +047800 GO TO READ-WRITE-GF-01. SQ1114.2 +047900 READ-PASS-GF-01. SQ1114.2 +048000 PERFORM PASS. SQ1114.2 +048100 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1114.2 +048200 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1114.2 +048300 READ-WRITE-GF-01. SQ1114.2 +048400 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1114.2 +048500 MOVE "READ TO VERIFY " TO FEATURE. SQ1114.2 +048600 PERFORM PRINT-DETAIL. SQ1114.2 +048700 READ-CLOSE-GF-01. SQ1114.2 +048800 CLOSE SQ-FS1. SQ1114.2 +048900 CCVS-EXIT SECTION. SQ1114.2 +049000 CCVS-999999. SQ1114.2 +049100 GO TO CLOSE-FILES. SQ1114.2 +*END-OF,SQ111A +*HEADER,COBOL,SQ112A +000100 IDENTIFICATION DIVISION. SQ1124.2 +000200 PROGRAM-ID. SQ1124.2 +000300 SQ112A. SQ1124.2 +000400**************************************************************** SQ1124.2 +000500* * SQ1124.2 +000600* VALIDATION FOR:- * SQ1124.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1124.2 +000800* * SQ1124.2 +000900* CREATION DATE / VALIDATION DATE * SQ1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1124.2 +001100* * SQ1124.2 +001200**************************************************************** SQ1124.2 +001300 SQ1124.2 +001400* THE ROUTINE SQ112A CREATES A FILE WHICH HAS FIXED LENGTH SQ1124.2 +001500* RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN INPUT FILESQ1124.2 +001600* AND THE FILE IS READ AND FIELDS IN THE INPUT RECORDS ARE SQ1124.2 +001700* COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDS SQ1124.2 +001800* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ1124.2 +001900* AGAIN FOR OUTPUT. THE DATA WRITTEN TO THE FILE PREVIOUSLY SQ1124.2 +002000* SHOULD BE ELIMINATED. ADDITIONAL RECORDS ARE WRITTEN TO SQ1124.2 +002100* THE FILE. THE FILE IS CLOSED AND OPENED AS AN INPUT FILE. SQ1124.2 +002200* THE CONTENT OF THE FILE IS VERIFIED TO ASCERTAIN THAT ONLY SQ1124.2 +002300* DATA WRITTEN AFTER THE FILE HAD BEEN OPENED OUTPUT THE SQ1124.2 +002400* SQ1124.2 +002500* SECOND TIME IS PRESENT. SQ1124.2 +002600* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ1124.2 +002700* LEVEL ONE FEATURES. SQ1124.2 +002800* SQ1124.2 +002900* USED X-CARDS: SQ1124.2 +003000* XXXXX001 SQ1124.2 +003100* XXXXX055 SQ1124.2 +003200* P XXXXX062 SQ1124.2 +003300* XXXXX082 SQ1124.2 +003400* XXXXX083 SQ1124.2 +003500* C XXXXX084 SQ1124.2 +003600* SQ1124.2 +003700* SQ1124.2 +003800 ENVIRONMENT DIVISION. SQ1124.2 +003900 CONFIGURATION SECTION. SQ1124.2 +004000 SOURCE-COMPUTER. SQ1124.2 +004100 XXXXX082. SQ1124.2 +004200 OBJECT-COMPUTER. SQ1124.2 +004300 XXXXX083. SQ1124.2 +004400 INPUT-OUTPUT SECTION. SQ1124.2 +004500 FILE-CONTROL. SQ1124.2 +004600P SELECT RAW-DATA ASSIGN TO SQ1124.2 +004700P XXXXX062 SQ1124.2 +004800P ORGANIZATION IS INDEXED SQ1124.2 +004900P ACCESS MODE IS RANDOM SQ1124.2 +005000P RECORD KEY IS RAW-DATA-KEY. SQ1124.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1124.2 +005200 XXXXX055. SQ1124.2 +005300 SELECT SQ-FS1 ASSIGN TO SQ1124.2 +005400 XXXXX001 SQ1124.2 +005500 ORGANIZATION IS SEQUENTIAL SQ1124.2 +005600 ACCESS MODE IS SEQUENTIAL. SQ1124.2 +005700 DATA DIVISION. SQ1124.2 +005800 FILE SECTION. SQ1124.2 +005900P SQ1124.2 +006000PFD RAW-DATA. SQ1124.2 +006100P SQ1124.2 +006200P01 RAW-DATA-SATZ. SQ1124.2 +006300P 05 RAW-DATA-KEY PIC X(6). SQ1124.2 +006400P 05 C-DATE PIC 9(6). SQ1124.2 +006500P 05 C-TIME PIC 9(8). SQ1124.2 +006600P 05 C-NO-OF-TESTS PIC 99. SQ1124.2 +006700P 05 C-OK PIC 999. SQ1124.2 +006800P 05 C-ALL PIC 999. SQ1124.2 +006900P 05 C-FAIL PIC 999. SQ1124.2 +007000P 05 C-DELETED PIC 999. SQ1124.2 +007100P 05 C-INSPECT PIC 999. SQ1124.2 +007200P 05 C-NOTE PIC X(13). SQ1124.2 +007300P 05 C-INDENT PIC X. SQ1124.2 +007400P 05 C-ABORT PIC X(8). SQ1124.2 +007500 FD PRINT-FILE SQ1124.2 +007600C LABEL RECORDS SQ1124.2 +007700C XXXXX084 SQ1124.2 +007800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1124.2 +007900 . SQ1124.2 +008000 01 PRINT-REC PICTURE X(120). SQ1124.2 +008100 01 DUMMY-RECORD PICTURE X(120). SQ1124.2 +008200 FD SQ-FS1 SQ1124.2 +008300C LABEL RECORD STANDARD SQ1124.2 +008400 . SQ1124.2 +008500 01 SQ-FS1R1-F-G-120. SQ1124.2 +008600 02 FILLER PIC X(120). SQ1124.2 +008700 WORKING-STORAGE SECTION. SQ1124.2 +008800 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1124.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1124.2 +009000 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1124.2 +009100 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1124.2 +009200 01 FILE-RECORD-INFORMATION-REC. SQ1124.2 +009300 03 FILE-RECORD-INFO-SKELETON. SQ1124.2 +009400 05 FILLER PICTURE X(48) VALUE SQ1124.2 +009500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1124.2 +009600 05 FILLER PICTURE X(46) VALUE SQ1124.2 +009700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1124.2 +009800 05 FILLER PICTURE X(26) VALUE SQ1124.2 +009900 ",LFIL=000000,ORG= ,LBLR= ". SQ1124.2 +010000 05 FILLER PICTURE X(37) VALUE SQ1124.2 +010100 ",RECKEY= ". SQ1124.2 +010200 05 FILLER PICTURE X(38) VALUE SQ1124.2 +010300 ",ALTKEY1= ". SQ1124.2 +010400 05 FILLER PICTURE X(38) VALUE SQ1124.2 +010500 ",ALTKEY2= ". SQ1124.2 +010600 05 FILLER PICTURE X(7) VALUE SPACE.SQ1124.2 +010700 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1124.2 +010800 05 FILE-RECORD-INFO-P1-120. SQ1124.2 +010900 07 FILLER PIC X(5). SQ1124.2 +011000 07 XFILE-NAME PIC X(6). SQ1124.2 +011100 07 FILLER PIC X(8). SQ1124.2 +011200 07 XRECORD-NAME PIC X(6). SQ1124.2 +011300 07 FILLER PIC X(1). SQ1124.2 +011400 07 REELUNIT-NUMBER PIC 9(1). SQ1124.2 +011500 07 FILLER PIC X(7). SQ1124.2 +011600 07 XRECORD-NUMBER PIC 9(6). SQ1124.2 +011700 07 FILLER PIC X(6). SQ1124.2 +011800 07 UPDATE-NUMBER PIC 9(2). SQ1124.2 +011900 07 FILLER PIC X(5). SQ1124.2 +012000 07 ODO-NUMBER PIC 9(4). SQ1124.2 +012100 07 FILLER PIC X(5). SQ1124.2 +012200 07 XPROGRAM-NAME PIC X(5). SQ1124.2 +012300 07 FILLER PIC X(7). SQ1124.2 +012400 07 XRECORD-LENGTH PIC 9(6). SQ1124.2 +012500 07 FILLER PIC X(7). SQ1124.2 +012600 07 CHARS-OR-RECORDS PIC X(2). SQ1124.2 +012700 07 FILLER PIC X(1). SQ1124.2 +012800 07 XBLOCK-SIZE PIC 9(4). SQ1124.2 +012900 07 FILLER PIC X(6). SQ1124.2 +013000 07 RECORDS-IN-FILE PIC 9(6). SQ1124.2 +013100 07 FILLER PIC X(5). SQ1124.2 +013200 07 XFILE-ORGANIZATION PIC X(2). SQ1124.2 +013300 07 FILLER PIC X(6). SQ1124.2 +013400 07 XLABEL-TYPE PIC X(1). SQ1124.2 +013500 05 FILE-RECORD-INFO-P121-240. SQ1124.2 +013600 07 FILLER PIC X(8). SQ1124.2 +013700 07 XRECORD-KEY PIC X(29). SQ1124.2 +013800 07 FILLER PIC X(9). SQ1124.2 +013900 07 ALTERNATE-KEY1 PIC X(29). SQ1124.2 +014000 07 FILLER PIC X(9). SQ1124.2 +014100 07 ALTERNATE-KEY2 PIC X(29). SQ1124.2 +014200 07 FILLER PIC X(7). SQ1124.2 +014300 01 TEST-RESULTS. SQ1124.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014500 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1124.2 +014600 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014700 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1124.2 +014800 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014900 02 PAR-NAME. SQ1124.2 +015000 03 FILLER PICTURE X(12) VALUE SPACE. SQ1124.2 +015100 03 PARDOT-X PICTURE X VALUE SPACE. SQ1124.2 +015200 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1124.2 +015300 03 FILLER PIC X(5) VALUE SPACE. SQ1124.2 +015400 02 FILLER PIC X(10) VALUE SPACE. SQ1124.2 +015500 02 RE-MARK PIC X(61). SQ1124.2 +015600 01 TEST-COMPUTED. SQ1124.2 +015700 02 FILLER PIC X(30) VALUE SPACE. SQ1124.2 +015800 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1124.2 +015900 02 COMPUTED-X. SQ1124.2 +016000 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1124.2 +016100 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1124.2 +016200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1124.2 +016300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1124.2 +016400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1124.2 +016500 03 CM-18V0 REDEFINES COMPUTED-A. SQ1124.2 +016600 04 COMPUTED-18V0 PICTURE -9(18). SQ1124.2 +016700 04 FILLER PICTURE X. SQ1124.2 +016800 03 FILLER PIC X(50) VALUE SPACE. SQ1124.2 +016900 01 TEST-CORRECT. SQ1124.2 +017000 02 FILLER PIC X(30) VALUE SPACE. SQ1124.2 +017100 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1124.2 +017200 02 CORRECT-X. SQ1124.2 +017300 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1124.2 +017400 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1124.2 +017500 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1124.2 +017600 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1124.2 +017700 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1124.2 +017800 03 CR-18V0 REDEFINES CORRECT-A. SQ1124.2 +017900 04 CORRECT-18V0 PICTURE -9(18). SQ1124.2 +018000 04 FILLER PICTURE X. SQ1124.2 +018100 03 FILLER PIC X(50) VALUE SPACE. SQ1124.2 +018200 01 CCVS-C-1. SQ1124.2 +018300 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1124.2 +018400- "SS PARAGRAPH-NAME SQ1124.2 +018500- " REMARKS". SQ1124.2 +018600 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1124.2 +018700 01 CCVS-C-2. SQ1124.2 +018800 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +018900 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1124.2 +019000 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1124.2 +019100 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1124.2 +019200 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1124.2 +019300 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1124.2 +019400 01 REC-CT PICTURE 99 VALUE ZERO. SQ1124.2 +019500 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1124.2 +019600 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1124.2 +019700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1124.2 +019800 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1124.2 +019900 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1124.2 +020000 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1124.2 +020100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1124.2 +020200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1124.2 +020300 01 CCVS-H-1. SQ1124.2 +020400 02 FILLER PICTURE X(27) VALUE SPACE. SQ1124.2 +020500 02 FILLER PICTURE X(67) VALUE SQ1124.2 +020600 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1124.2 +020700- " SYSTEM". SQ1124.2 +020800 02 FILLER PICTURE X(26) VALUE SPACE. SQ1124.2 +020900 01 CCVS-H-2. SQ1124.2 +021000 02 FILLER PICTURE X(52) VALUE IS SQ1124.2 +021100 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1124.2 +021200 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1124.2 +021300 02 TEST-ID PICTURE IS X(9). SQ1124.2 +021400 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1124.2 +021500 01 CCVS-H-3. SQ1124.2 +021600 02 FILLER PICTURE X(34) VALUE SQ1124.2 +021700 " FOR OFFICIAL USE ONLY ". SQ1124.2 +021800 02 FILLER PICTURE X(58) VALUE SQ1124.2 +021900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1124.2 +022000 02 FILLER PICTURE X(28) VALUE SQ1124.2 +022100 " COPYRIGHT 1985 ". SQ1124.2 +022200 01 CCVS-E-1. SQ1124.2 +022300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1124.2 +022400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1124.2 +022500 02 ID-AGAIN PICTURE IS X(9). SQ1124.2 +022600 02 FILLER PICTURE X(45) VALUE IS SQ1124.2 +022700 " NTIS DISTRIBUTION COBOL 85". SQ1124.2 +022800 01 CCVS-E-2. SQ1124.2 +022900 02 FILLER PICTURE X(31) VALUE SQ1124.2 +023000 SPACE. SQ1124.2 +023100 02 FILLER PICTURE X(21) VALUE SPACE. SQ1124.2 +023200 02 CCVS-E-2-2. SQ1124.2 +023300 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1124.2 +023400 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +023500 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1124.2 +023600 01 CCVS-E-3. SQ1124.2 +023700 02 FILLER PICTURE X(22) VALUE SQ1124.2 +023800 " FOR OFFICIAL USE ONLY". SQ1124.2 +023900 02 FILLER PICTURE X(12) VALUE SPACE. SQ1124.2 +024000 02 FILLER PICTURE X(58) VALUE SQ1124.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1124.2 +024200 02 FILLER PICTURE X(13) VALUE SPACE. SQ1124.2 +024300 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1124.2 +024400 01 CCVS-E-4. SQ1124.2 +024500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1124.2 +024600 02 FILLER PIC XXXX VALUE " OF ". SQ1124.2 +024700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1124.2 +024800 02 FILLER PIC X(40) VALUE SQ1124.2 +024900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1124.2 +025000 01 XXINFO. SQ1124.2 +025100 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1124.2 +025200 02 INFO-TEXT. SQ1124.2 +025300 04 FILLER PIC X(20) VALUE SPACE. SQ1124.2 +025400 04 XXCOMPUTED PIC X(20). SQ1124.2 +025500 04 FILLER PIC X(5) VALUE SPACE. SQ1124.2 +025600 04 XXCORRECT PIC X(20). SQ1124.2 +025700 01 HYPHEN-LINE. SQ1124.2 +025800 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +025900 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1124.2 +026000- "*****************************************". SQ1124.2 +026100 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1124.2 +026200- "******************************". SQ1124.2 +026300 01 CCVS-PGM-ID PIC X(6) VALUE SQ1124.2 +026400 "SQ112A". SQ1124.2 +026500 PROCEDURE DIVISION. SQ1124.2 +026600 CCVS1 SECTION. SQ1124.2 +026700 OPEN-FILES. SQ1124.2 +026800P OPEN I-O RAW-DATA. SQ1124.2 +026900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1124.2 +027000P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1124.2 +027100P MOVE "ABORTED " TO C-ABORT. SQ1124.2 +027200P ADD 1 TO C-NO-OF-TESTS. SQ1124.2 +027300P ACCEPT C-DATE FROM DATE. SQ1124.2 +027400P ACCEPT C-TIME FROM TIME. SQ1124.2 +027500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1124.2 +027600PEND-E-1. SQ1124.2 +027700P CLOSE RAW-DATA. SQ1124.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1124.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1124.2 +028000 MOVE SPACE TO TEST-RESULTS. SQ1124.2 +028100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1124.2 +028200 MOVE ZERO TO REC-SKL-SUB. SQ1124.2 +028300 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1124.2 +028400 CCVS-INIT-FILE. SQ1124.2 +028500 ADD 1 TO REC-SKL-SUB. SQ1124.2 +028600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1124.2 +028700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1124.2 +028800 CCVS-INIT-EXIT. SQ1124.2 +028900 GO TO CCVS1-EXIT. SQ1124.2 +029000 CLOSE-FILES. SQ1124.2 +029100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1124.2 +029200P OPEN I-O RAW-DATA. SQ1124.2 +029300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1124.2 +029400P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1124.2 +029500P MOVE "OK. " TO C-ABORT. SQ1124.2 +029600P MOVE PASS-COUNTER TO C-OK. SQ1124.2 +029700P MOVE ERROR-HOLD TO C-ALL. SQ1124.2 +029800P MOVE ERROR-COUNTER TO C-FAIL. SQ1124.2 +029900P MOVE DELETE-CNT TO C-DELETED. SQ1124.2 +030000P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1124.2 +030100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1124.2 +030200PEND-E-2. SQ1124.2 +030300P CLOSE RAW-DATA. SQ1124.2 +030400 TERMINATE-CCVS. SQ1124.2 +030500S EXIT PROGRAM. SQ1124.2 +030600STERMINATE-CALL. SQ1124.2 +030700 STOP RUN. SQ1124.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1124.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1124.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1124.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1124.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1124.2 +031300 PRINT-DETAIL. SQ1124.2 +031400 IF REC-CT NOT EQUAL TO ZERO SQ1124.2 +031500 MOVE "." TO PARDOT-X SQ1124.2 +031600 MOVE REC-CT TO DOTVALUE. SQ1124.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1124.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1124.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1124.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1124.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1124.2 +032200 MOVE SPACE TO CORRECT-X. SQ1124.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1124.2 +032400 MOVE SPACE TO RE-MARK. SQ1124.2 +032500 HEAD-ROUTINE. SQ1124.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +032700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1124.2 +032800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1124.2 +032900 COLUMN-NAMES-ROUTINE. SQ1124.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +033300 END-ROUTINE. SQ1124.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1124.2 +033500 END-RTN-EXIT. SQ1124.2 +033600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +033700 END-ROUTINE-1. SQ1124.2 +033800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1124.2 +033900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1124.2 +034000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1124.2 +034100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1124.2 +034200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1124.2 +034300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1124.2 +034400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1124.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1124.2 +034600 END-ROUTINE-12. SQ1124.2 +034700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1124.2 +034800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1124.2 +034900 MOVE "NO " TO ERROR-TOTAL SQ1124.2 +035000 ELSE SQ1124.2 +035100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1124.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1124.2 +035300 PERFORM WRITE-LINE. SQ1124.2 +035400 END-ROUTINE-13. SQ1124.2 +035500 IF DELETE-CNT IS EQUAL TO ZERO SQ1124.2 +035600 MOVE "NO " TO ERROR-TOTAL ELSE SQ1124.2 +035700 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1124.2 +035800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1124.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036000 IF INSPECT-COUNTER EQUAL TO ZERO SQ1124.2 +036100 MOVE "NO " TO ERROR-TOTAL SQ1124.2 +036200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1124.2 +036300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1124.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036600 WRITE-LINE. SQ1124.2 +036700 ADD 1 TO RECORD-COUNT. SQ1124.2 +036800Y IF RECORD-COUNT GREATER 50 SQ1124.2 +036900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1124.2 +037000Y MOVE SPACE TO DUMMY-RECORD SQ1124.2 +037100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1124.2 +037200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1124.2 +037300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1124.2 +037400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1124.2 +037500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1124.2 +037600Y MOVE ZERO TO RECORD-COUNT. SQ1124.2 +037700 PERFORM WRT-LN. SQ1124.2 +037800 WRT-LN. SQ1124.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1124.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1124.2 +038100 BLANK-LINE-PRINT. SQ1124.2 +038200 PERFORM WRT-LN. SQ1124.2 +038300 FAIL-ROUTINE. SQ1124.2 +038400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1124.2 +038500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1124.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1124.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +038800 GO TO FAIL-ROUTINE-EX. SQ1124.2 +038900 FAIL-ROUTINE-WRITE. SQ1124.2 +039000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1124.2 +039100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +039200 FAIL-ROUTINE-EX. EXIT. SQ1124.2 +039300 BAIL-OUT. SQ1124.2 +039400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1124.2 +039500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1124.2 +039600 BAIL-OUT-WRITE. SQ1124.2 +039700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1124.2 +039800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +039900 BAIL-OUT-EX. EXIT. SQ1124.2 +040000 CCVS1-EXIT. SQ1124.2 +040100 EXIT. SQ1124.2 +040200 SECT-SQ112A-0001 SECTION. SQ1124.2 +040300 WRITE-INIT-GF-01. SQ1124.2 +040400 MOVE "SQ112X" TO XFILE-NAME (1). SQ1124.2 +040500 MOVE "OUTPUT" TO XRECORD-NAME (1). SQ1124.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1124.2 +040700 MOVE 000120 TO XRECORD-LENGTH (1). SQ1124.2 +040800 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1124.2 +040900 MOVE 0001 TO XBLOCK-SIZE (1). SQ1124.2 +041000 MOVE 000150 TO RECORDS-IN-FILE (1). SQ1124.2 +041100 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1124.2 +041200 MOVE "S" TO XLABEL-TYPE (1). SQ1124.2 +041300 MOVE 000001 TO XRECORD-NUMBER (1). SQ1124.2 +041400 OPEN OUTPUT SQ-FS1. SQ1124.2 +041500 WRITE-TEST-GF-01. SQ1124.2 +041600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1124.2 +041700 WRITE SQ-FS1R1-F-G-120. SQ1124.2 +041800 IF XRECORD-NUMBER (1) EQUAL TO 150 SQ1124.2 +041900 GO TO WRITE-WRITE-GF-01. SQ1124.2 +042000 ADD 1 TO XRECORD-NUMBER (1). SQ1124.2 +042100 GO TO WRITE-TEST-GF-01. SQ1124.2 +042200 WRITE-WRITE-GF-01. SQ1124.2 +042300 MOVE "WRITE 150 RECORDS " TO FEATURE. SQ1124.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1124.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1124.2 +042600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1124.2 +042700 PERFORM PRINT-DETAIL. SQ1124.2 +042800 CLOSE SQ-FS1. SQ1124.2 +042900* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1124.2 +043000* HAS BEEN CREATED. THE FILE CONTAINS 150 RECORDS. SQ1124.2 +043100 READ-INIT-GF-01. SQ1124.2 +043200 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +043300* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1124.2 +043400* READ-TEST-001. SQ1124.2 +043500 OPEN INPUT SQ-FS1. SQ1124.2 +043600 READ-TEST-GF-01. SQ1124.2 +043700 READ SQ-FS1 SQ1124.2 +043800 AT END GO TO READ-TEST-GF-01-1. SQ1124.2 +043900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +044000 ADD 1 TO WRK-CS-09V00. SQ1124.2 +044100 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +044200 MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +044300 GO TO READ-FAIL-GF-01. SQ1124.2 +044400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +044500 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +044600 GO TO READ-TEST-GF-01. SQ1124.2 +044700 IF XFILE-NAME (1) NOT EQUAL TO "SQ112X" SQ1124.2 +044800 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +044900 GO TO READ-TEST-GF-01. SQ1124.2 +045000 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1124.2 +045100 ADD 1 TO RECORDS-IN-ERROR. SQ1124.2 +045200 GO TO READ-TEST-GF-01. SQ1124.2 +045300 READ-TEST-GF-01-1. SQ1124.2 +045400 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1124.2 +045500 GO TO READ-PASS-GF-01. SQ1124.2 +045600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1124.2 +045700 READ-FAIL-GF-01. SQ1124.2 +045800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1124.2 +045900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1124.2 +046000 PERFORM FAIL. SQ1124.2 +046100 GO TO READ-READ-GF-01. SQ1124.2 +046200 READ-PASS-GF-01. SQ1124.2 +046300 PERFORM PASS. SQ1124.2 +046400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1124.2 +046500 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +046600 READ-READ-GF-01. SQ1124.2 +046700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1124.2 +046800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1124.2 +046900 PERFORM PRINT-DETAIL. SQ1124.2 +047000 READ-CLOSE-GF-01. SQ1124.2 +047100 CLOSE SQ-FS1. SQ1124.2 +047200 SECT-SQ112A-0002 SECTION. SQ1124.2 +047300 WRITE-INIT-GF-02. SQ1124.2 +047400 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1124.2 +047500 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1124.2 +047600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1124.2 +047700 MOVE 000120 TO XRECORD-LENGTH (1). SQ1124.2 +047800 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1124.2 +047900 MOVE 0001 TO XBLOCK-SIZE (1). SQ1124.2 +048000 MOVE 000150 TO RECORDS-IN-FILE (1). SQ1124.2 +048100 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1124.2 +048200 MOVE "S" TO XLABEL-TYPE (1). SQ1124.2 +048300 MOVE 000001 TO XRECORD-NUMBER (1). SQ1124.2 +048400 OPEN OUTPUT SQ-FS1. SQ1124.2 +048500 WRITE-TEST-GF-02. SQ1124.2 +048600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1124.2 +048700 WRITE SQ-FS1R1-F-G-120. SQ1124.2 +048800 IF XRECORD-NUMBER (1) EQUAL TO 150 SQ1124.2 +048900 GO TO WRITE-WRITE-GF-02. SQ1124.2 +049000 ADD 1 TO XRECORD-NUMBER (1). SQ1124.2 +049100 GO TO WRITE-TEST-GF-02. SQ1124.2 +049200 WRITE-WRITE-GF-02. SQ1124.2 +049300 MOVE "WRITE 150 RECS 2ND" TO FEATURE. SQ1124.2 +049400 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ1124.2 +049500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1124.2 +049600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1124.2 +049700 PERFORM PRINT-DETAIL. SQ1124.2 +049800 CLOSE SQ-FS1. SQ1124.2 +049900* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1124.2 +050000* HAS BEEN CREATED. THE FILE CONTAINS 150 RECORDS. SQ1124.2 +050100 READ-INIT-GF-02. SQ1124.2 +050200 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +050300* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1124.2 +050400* READ-TEST-001. SQ1124.2 +050500 OPEN INPUT SQ-FS1. SQ1124.2 +050600 READ-TEST-GF-02. SQ1124.2 +050700 READ SQ-FS1 SQ1124.2 +050800 AT END GO TO READ-TEST-GF-02-1. SQ1124.2 +050900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +051000 ADD 1 TO WRK-CS-09V00. SQ1124.2 +051100* IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +051200* MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +051300* GO TO READ-FAIL-GF-02. SQ1124.2 +051400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +051500 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +051600 GO TO READ-TEST-GF-02. SQ1124.2 +051700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1124.2 +051800 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +051900 GO TO READ-TEST-GF-02. SQ1124.2 +052000 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1124.2 +052100 ADD 1 TO RECORDS-IN-ERROR. SQ1124.2 +052200 GO TO READ-TEST-GF-02. SQ1124.2 +052300 READ-TEST-GF-02-1. SQ1124.2 +052400 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1124.2 +052500 GO TO READ-PASS-GF-02. SQ1124.2 +052600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1124.2 +052700 READ-FAIL-GF-02. SQ1124.2 +052800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1124.2 +052900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1124.2 +053000 MOVE "VII-43;4.3.4 (21) " TO RE-MARK.SQ1124.2 +053100 PERFORM FAIL. SQ1124.2 +053200 GO TO READ-WRITE-GF-02. SQ1124.2 +053300 READ-PASS-GF-02. SQ1124.2 +053400 PERFORM PASS. SQ1124.2 +053500 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1124.2 +053600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +053700 READ-WRITE-GF-02. SQ1124.2 +053800 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1124.2 +053900 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1124.2 +054000 PERFORM PRINT-DETAIL. SQ1124.2 +054100 READ-CLOSE-GF-02. SQ1124.2 +054200 CLOSE SQ-FS1. SQ1124.2 +054300 SECT-SQ112A-0003 SECTION. SQ1124.2 +054400 READ-INIT-GF-03. SQ1124.2 +054500 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +054600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1124.2 +054700 OPEN INPUT SQ-FS1. SQ1124.2 +054800* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1124.2 +054900* IN THIS SERIES OF TESTS. SQ1124.2 +055000 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1124.2 +055100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1124.2 +055200 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +055300 READ-TEST-GF-03. SQ1124.2 +055400 READ SQ-FS1 RECORD AT END SQ1124.2 +055500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +055600 MOVE 1 TO EOF-FLAG SQ1124.2 +055700 GO TO READ-FAIL-GF-03. SQ1124.2 +055800 PERFORM RECORD-CHECK. SQ1124.2 +055900 IF WRK-CS-09V00 EQUAL TO 40 SQ1124.2 +056000 GO TO READ-TEST-GF-03-1. SQ1124.2 +056100 GO TO READ-TEST-GF-03. SQ1124.2 +056200 RECORD-CHECK. SQ1124.2 +056300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +056400 ADD 1 TO WRK-CS-09V00. SQ1124.2 +056500 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +056600 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +056700 MOVE 1 TO ERROR-FLAG. SQ1124.2 +056800 READ-TEST-GF-03-1. SQ1124.2 +056900 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +057000 GO TO READ-PASS-GF-03. SQ1124.2 +057100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +057200 READ-FAIL-GF-03. SQ1124.2 +057300 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +057400 PERFORM FAIL. SQ1124.2 +057500 GO TO READ-WRITE-GF-03. SQ1124.2 +057600 READ-PASS-GF-03. SQ1124.2 +057700 PERFORM PASS. SQ1124.2 +057800 READ-WRITE-GF-03. SQ1124.2 +057900 PERFORM PRINT-DETAIL. SQ1124.2 +058000 READ-INIT-GF-04. SQ1124.2 +058100 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +058200 GO TO SEQ-EOF-005. SQ1124.2 +058300 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +058400 MOVE "READ...AT END..." TO FEATURE. SQ1124.2 +058500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1124.2 +058600 READ-TEST-GF-04. SQ1124.2 +058700 READ SQ-FS1 AT END SQ1124.2 +058800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +058900 MOVE 1 TO EOF-FLAG SQ1124.2 +059000 GO TO READ-FAIL-GF-04. SQ1124.2 +059100 PERFORM RECORD-CHECK. SQ1124.2 +059200 IF WRK-CS-09V00 EQUAL TO 80 SQ1124.2 +059300 GO TO READ-TEST-GF-04-1. SQ1124.2 +059400 GO TO READ-TEST-GF-04. SQ1124.2 +059500 READ-TEST-GF-04-1. SQ1124.2 +059600 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +059700 GO TO READ-PASS-GF-04. SQ1124.2 +059800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +059900 READ-FAIL-GF-04. SQ1124.2 +060000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +060100 PERFORM FAIL. SQ1124.2 +060200 GO TO READ-WRITE-GF-04. SQ1124.2 +060300 READ-PASS-GF-04. SQ1124.2 +060400 PERFORM PASS. SQ1124.2 +060500 READ-WRITE-GF-04. SQ1124.2 +060600 PERFORM PRINT-DETAIL. SQ1124.2 +060700 READ-INIT-GF-05. SQ1124.2 +060800 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +060900 GO TO SEQ-EOF-005. SQ1124.2 +061000 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +061100 MOVE "READ...RECORD END..." TO FEATURE. SQ1124.2 +061200 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1124.2 +061300 READ-TEST-GF-05. SQ1124.2 +061400 READ SQ-FS1 RECORD END SQ1124.2 +061500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +061600 MOVE 1 TO EOF-FLAG SQ1124.2 +061700 GO TO READ-FAIL-GF-05. SQ1124.2 +061800 PERFORM RECORD-CHECK. SQ1124.2 +061900 IF WRK-CS-09V00 EQUAL TO 120 SQ1124.2 +062000 GO TO READ-TEST-GF-05-1. SQ1124.2 +062100 GO TO READ-TEST-GF-05. SQ1124.2 +062200 READ-TEST-GF-05-1. SQ1124.2 +062300 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +062400 GO TO READ-PASS-GF-05. SQ1124.2 +062500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +062600 READ-FAIL-GF-05. SQ1124.2 +062700 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +062800 PERFORM FAIL. SQ1124.2 +062900 GO TO READ-WRITE-GF-05. SQ1124.2 +063000 READ-PASS-GF-05. SQ1124.2 +063100 PERFORM PASS. SQ1124.2 +063200 READ-WRITE-GF-05. SQ1124.2 +063300 PERFORM PRINT-DETAIL. SQ1124.2 +063400 READ-INIT-GF-06. SQ1124.2 +063500 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +063600 GO TO SEQ-EOF-005. SQ1124.2 +063700 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +063800 MOVE "READ...END..." TO FEATURE. SQ1124.2 +063900 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1124.2 +064000 READ-TEST-GF-06. SQ1124.2 +064100 READ SQ-FS1 END GO TO READ-TEST-GF-06-1. SQ1124.2 +064200 PERFORM RECORD-CHECK. SQ1124.2 +064300 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +064400 GO TO READ-TEST-GF-06-1. SQ1124.2 +064500 GO TO READ-TEST-GF-06. SQ1124.2 +064600 READ-TEST-GF-06-1. SQ1124.2 +064700 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +064800 GO TO READ-PASS-GF-06. SQ1124.2 +064900 READ-FAIL-GF-06. SQ1124.2 +065000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +065100 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +065200 PERFORM FAIL. SQ1124.2 +065300 GO TO READ-WRITE-GF-06. SQ1124.2 +065400 READ-PASS-GF-06. SQ1124.2 +065500 PERFORM PASS. SQ1124.2 +065600 READ-WRITE-GF-06. SQ1124.2 +065700 PERFORM PRINT-DETAIL. SQ1124.2 +065800 SEQ-TEST-005. SQ1124.2 +065900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1124.2 +066000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1124.2 +066100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1124.2 +066200 GO TO SEQ-FAIL-005. SQ1124.2 +066300 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +066400 MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +066500 GO TO SEQ-FAIL-005. SQ1124.2 +066600 SEQ-PASS-005. SQ1124.2 +066700 PERFORM PASS. SQ1124.2 +066800 GO TO SEQ-WRITE-005. SQ1124.2 +066900 SEQ-EOF-005. SQ1124.2 +067000 MOVE "LESS THAN 150 RECORDS" TO RE-MARK. SQ1124.2 +067100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1124.2 +067200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +067300 SEQ-FAIL-005. SQ1124.2 +067400 MOVE "VII-43;4.3.4 (21) " TO RE-MARK.SQ1124.2 +067500 PERFORM FAIL. SQ1124.2 +067600 SEQ-WRITE-005. SQ1124.2 +067700 MOVE "SEQ-TEST-005" TO PAR-NAME. SQ1124.2 +067800 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1124.2 +067900 PERFORM PRINT-DETAIL. SQ1124.2 +068000 SEQ-CLOSE-005. SQ1124.2 +068100 CLOSE SQ-FS1. SQ1124.2 +068200 TERMINATE-ROUTINE. SQ1124.2 +068300 EXIT. SQ1124.2 +068400 CCVS-EXIT SECTION. SQ1124.2 +068500 CCVS-999999. SQ1124.2 +068600 GO TO CLOSE-FILES. SQ1124.2 +*END-OF,SQ112A +*HEADER,COBOL,SQ113A +000100 IDENTIFICATION DIVISION. SQ1134.2 +000200 PROGRAM-ID. SQ1134.2 +000300 SQ113A. SQ1134.2 +000400**************************************************************** SQ1134.2 +000500* * SQ1134.2 +000600* VALIDATION FOR:- * SQ1134.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1134.2 +000900* REVISED 1986, AUGUST * SQ1134.2 +001000* * SQ1134.2 +001100* CREATION DATE / VALIDATION DATE * SQ1134.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1134.2 +001300* * SQ1134.2 +001400**************************************************************** SQ1134.2 +001500* * SQ1134.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1134.2 +001700* * SQ1134.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE * SQ1134.2 +001900* X-55 SYSTEM PRINTER * SQ1134.2 +002000* X-82 SOURCE-COMPUTER * SQ1134.2 +002100* X-83 OBJECT-COMPUTER. * SQ1134.2 +002200* * SQ1134.2 +002300**************************************************************** SQ1134.2 +002400* * SQ1134.2 +002500* SQ113A CREATES A MAGNETIC TAPE FILE CONTAINING 750 FIXED * SQ1134.2 +002600* LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS * SQ1134.2 +002700* READ TWICE. THE FIRST PASS CHECKS THAT ALL THE EXPECTED * SQ1134.2 +002800* RECORDS ARE PRESENT. THE SECOND PASS PERFORMS SIMILAR * SQ1134.2 +002900* CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ STATEMENT * SQ1134.2 +003000* WITH THE END PHRASE THAT CAN BE PRODUCED BY INCLUDING OR * SQ1134.2 +003100* OMITTING THE OPTIONAL WORDS "RECORD" AND "AT". * SQ1134.2 +003200* * SQ1134.2 +003300* THE PROGRAM IS ALMOST IDENTICAL TO SQ102A, AND IS DERIVED * SQ1134.2 +003400* FROM THAT PROGRAM BY INCLUDING A FILE STATUS CLAUSE IN * SQ1134.2 +003500* THE FILE-CONTROL ENTRY FOR THE TEST FILE, AND INCLUDING * SQ1134.2 +003600* TESTS ON THE I-O STATUS RETURNED AFTER EACH OPERATION ON * SQ1134.2 +003700* THE FILE * SQ1134.2 +003800* * SQ1134.2 +003900* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1134.2 +004000* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1134.2 +004100* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1134.2 +004200* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1134.2 +004300* * SQ1134.2 +004400**************************************************************** SQ1134.2 +004500* SQ1134.2 +004600* SQ1134.2 +004700 ENVIRONMENT DIVISION. SQ1134.2 +004800 CONFIGURATION SECTION. SQ1134.2 +004900 SOURCE-COMPUTER. SQ1134.2 +005000 XXXXX082. SQ1134.2 +005100 OBJECT-COMPUTER. SQ1134.2 +005200 XXXXX083. SQ1134.2 +005300* SQ1134.2 +005400 INPUT-OUTPUT SECTION. SQ1134.2 +005500 FILE-CONTROL. SQ1134.2 +005600 SELECT PRINT-FILE ASSIGN TO SQ1134.2 +005700 XXXXX055. SQ1134.2 +005800* SQ1134.2 +005900P SELECT RAW-DATA ASSIGN TO SQ1134.2 +006000P XXXXX062 SQ1134.2 +006100P ORGANIZATION IS INDEXED SQ1134.2 +006200P ACCESS MODE IS RANDOM SQ1134.2 +006300P RECORD-KEY IS RAW-DATA-KEY. SQ1134.2 +006400P SQ1134.2 +006500 SELECT SQ-FS1 SQ1134.2 +006600 ACCESS MODE IS SEQUENTIAL SQ1134.2 +006700 SEQUENTIAL SQ1134.2 +006800 ASSIGN TO SQ1134.2 +006900 XXXXX001 SQ1134.2 +007000 FILE STATUS IS SQ-FS1-STATUS. SQ1134.2 +007100* SQ1134.2 +007200* SQ1134.2 +007300 DATA DIVISION. SQ1134.2 +007400 FILE SECTION. SQ1134.2 +007500 FD PRINT-FILE SQ1134.2 +007600C LABEL RECORDS SQ1134.2 +007700C XXXXX084 SQ1134.2 +007800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1134.2 +007900 . SQ1134.2 +008000 01 PRINT-REC PICTURE X(120). SQ1134.2 +008100 01 DUMMY-RECORD PICTURE X(120). SQ1134.2 +008200P SQ1134.2 +008300PFD RAW-DATA. SQ1134.2 +008400P01 RAW-DATA-SATZ. SQ1134.2 +008500P 05 RAW-DATA-KEY PIC X(6). SQ1134.2 +008600P 05 C-DATE PIC 9(6). SQ1134.2 +008700P 05 C-TIME PIC 9(8). SQ1134.2 +008800P 05 NO-OF-TESTS PIC 99. SQ1134.2 +008900P 05 C-OK PIC 999. SQ1134.2 +009000P 05 C-ALL PIC 999. SQ1134.2 +009100P 05 C-FAIL PIC 999. SQ1134.2 +009200P 05 C-DELETED PIC 999. SQ1134.2 +009300P 05 C-INSPECT PIC 999. SQ1134.2 +009400P 05 C-NOTE PIC X(13). SQ1134.2 +009500P 05 C-INDENT PIC X. SQ1134.2 +009600P 05 C-ABORT PIC X(8). SQ1134.2 +009700* SQ1134.2 +009800 FD SQ-FS1 SQ1134.2 +009900C LABEL RECORD IS STANDARD SQ1134.2 +010000 . SQ1134.2 +010100 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1134.2 +010200* SQ1134.2 +010300 WORKING-STORAGE SECTION. SQ1134.2 +010400* SQ1134.2 +010500*************************************************************** SQ1134.2 +010600* * SQ1134.2 +010700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1134.2 +010800* * SQ1134.2 +010900*************************************************************** SQ1134.2 +011000* SQ1134.2 +011100 01 SQ-FS1-STATUS. SQ1134.2 +011200 03 SQ-FS1-KEY-1 PIC X. SQ1134.2 +011300 03 SQ-FS1-KEY-2 PIC X. SQ1134.2 +011400* SQ1134.2 +011500 01 SQ-FS1-STATUS-COPY PIC XX. SQ1134.2 +011600* SQ1134.2 +011700 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1134.2 +011800 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1134.2 +011900 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1134.2 +012000 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1134.2 +012100* SQ1134.2 +012200*************************************************************** SQ1134.2 +012300* * SQ1134.2 +012400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1134.2 +012500* * SQ1134.2 +012600*************************************************************** SQ1134.2 +012700* SQ1134.2 +012800 01 REC-SKEL-SUB PIC 99. SQ1134.2 +012900* SQ1134.2 +013000 01 FILE-RECORD-INFORMATION-REC. SQ1134.2 +013100 03 FILE-RECORD-INFO-SKELETON. SQ1134.2 +013200 05 FILLER PICTURE X(48) VALUE SQ1134.2 +013300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1134.2 +013400 05 FILLER PICTURE X(46) VALUE SQ1134.2 +013500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1134.2 +013600 05 FILLER PICTURE X(26) VALUE SQ1134.2 +013700 ",LFIL=000000,ORG= ,LBLR= ". SQ1134.2 +013800 05 FILLER PICTURE X(37) VALUE SQ1134.2 +013900 ",RECKEY= ". SQ1134.2 +014000 05 FILLER PICTURE X(38) VALUE SQ1134.2 +014100 ",ALTKEY1= ". SQ1134.2 +014200 05 FILLER PICTURE X(38) VALUE SQ1134.2 +014300 ",ALTKEY2= ". SQ1134.2 +014400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1134.2 +014500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1134.2 +014600 05 FILE-RECORD-INFO-P1-120. SQ1134.2 +014700 07 FILLER PIC X(5). SQ1134.2 +014800 07 XFILE-NAME PIC X(6). SQ1134.2 +014900 07 FILLER PIC X(8). SQ1134.2 +015000 07 XRECORD-NAME PIC X(6). SQ1134.2 +015100 07 FILLER PIC X(1). SQ1134.2 +015200 07 REELUNIT-NUMBER PIC 9(1). SQ1134.2 +015300 07 FILLER PIC X(7). SQ1134.2 +015400 07 XRECORD-NUMBER PIC 9(6). SQ1134.2 +015500 07 FILLER PIC X(6). SQ1134.2 +015600 07 UPDATE-NUMBER PIC 9(2). SQ1134.2 +015700 07 FILLER PIC X(5). SQ1134.2 +015800 07 ODO-NUMBER PIC 9(4). SQ1134.2 +015900 07 FILLER PIC X(5). SQ1134.2 +016000 07 XPROGRAM-NAME PIC X(5). SQ1134.2 +016100 07 FILLER PIC X(7). SQ1134.2 +016200 07 XRECORD-LENGTH PIC 9(6). SQ1134.2 +016300 07 FILLER PIC X(7). SQ1134.2 +016400 07 CHARS-OR-RECORDS PIC X(2). SQ1134.2 +016500 07 FILLER PIC X(1). SQ1134.2 +016600 07 XBLOCK-SIZE PIC 9(4). SQ1134.2 +016700 07 FILLER PIC X(6). SQ1134.2 +016800 07 RECORDS-IN-FILE PIC 9(6). SQ1134.2 +016900 07 FILLER PIC X(5). SQ1134.2 +017000 07 XFILE-ORGANIZATION PIC X(2). SQ1134.2 +017100 07 FILLER PIC X(6). SQ1134.2 +017200 07 XLABEL-TYPE PIC X(1). SQ1134.2 +017300 05 FILE-RECORD-INFO-P121-240. SQ1134.2 +017400 07 FILLER PIC X(8). SQ1134.2 +017500 07 XRECORD-KEY PIC X(29). SQ1134.2 +017600 07 FILLER PIC X(9). SQ1134.2 +017700 07 ALTERNATE-KEY1 PIC X(29). SQ1134.2 +017800 07 FILLER PIC X(9). SQ1134.2 +017900 07 ALTERNATE-KEY2 PIC X(29). SQ1134.2 +018000 07 FILLER PIC X(7). SQ1134.2 +018100* SQ1134.2 +018200 01 TEST-RESULTS. SQ1134.2 +018300 02 FILLER PIC X VALUE SPACE. SQ1134.2 +018400 02 PAR-NAME. SQ1134.2 +018500 03 FILLER PIC X(14) VALUE SPACE. SQ1134.2 +018600 03 PARDOT-X PIC X VALUE SPACE. SQ1134.2 +018700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1134.2 +018800 02 FILLER PIC X VALUE SPACE. SQ1134.2 +018900 02 FEATURE PIC X(24) VALUE SPACE. SQ1134.2 +019000 02 FILLER PIC X VALUE SPACE. SQ1134.2 +019100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1134.2 +019200 02 FILLER PIC X(9) VALUE SPACE. SQ1134.2 +019300 02 RE-MARK PIC X(61). SQ1134.2 +019400 01 TEST-COMPUTED. SQ1134.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1134.2 +019600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1134.2 +019700 02 COMPUTED-X. SQ1134.2 +019800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1134.2 +019900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1134.2 +020000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1134.2 +020100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1134.2 +020200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1134.2 +020300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1134.2 +020400 04 COMPUTED-18V0 PIC -9(18). SQ1134.2 +020500 04 FILLER PIC X. SQ1134.2 +020600 03 FILLER PIC X(50) VALUE SPACE. SQ1134.2 +020700 01 TEST-CORRECT. SQ1134.2 +020800 02 FILLER PIC X(30) VALUE SPACE. SQ1134.2 +020900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1134.2 +021000 02 CORRECT-X. SQ1134.2 +021100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1134.2 +021200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1134.2 +021300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1134.2 +021400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1134.2 +021500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1134.2 +021600 03 CR-18V0 REDEFINES CORRECT-A. SQ1134.2 +021700 04 CORRECT-18V0 PIC -9(18). SQ1134.2 +021800 04 FILLER PIC X. SQ1134.2 +021900 03 FILLER PIC X(2) VALUE SPACE. SQ1134.2 +022000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1134.2 +022100* SQ1134.2 +022200 01 CCVS-C-1. SQ1134.2 +022300 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1134.2 +022500 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1134.2 +022700 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1134.2 +022900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1134.2 +023000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1134.2 +023100 01 CCVS-C-2. SQ1134.2 +023200 02 FILLER PIC X(19) VALUE SPACE. SQ1134.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". SQ1134.2 +023400 02 FILLER PIC X(19) VALUE SPACE. SQ1134.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". SQ1134.2 +023600 02 FILLER PIC X(72) VALUE SPACE. SQ1134.2 +023700* SQ1134.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1134.2 +023900 01 REC-CT PIC 99 VALUE ZERO. SQ1134.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1134.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1134.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1134.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1134.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1134.2 +024900 01 CCVS-H-1. SQ1134.2 +025000 02 FILLER PIC X(39) VALUE SPACES. SQ1134.2 +025100 02 FILLER PIC X(42) VALUE SQ1134.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1134.2 +025300 02 FILLER PIC X(39) VALUE SPACES. SQ1134.2 +025400 01 CCVS-H-2A. SQ1134.2 +025500 02 FILLER PIC X(40) VALUE SPACE. SQ1134.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1134.2 +025700 02 FILLER PIC XXXX VALUE SQ1134.2 +025800 "4.2 ". SQ1134.2 +025900 02 FILLER PIC X(28) VALUE SQ1134.2 +026000 " COPY - NOT FOR DISTRIBUTION". SQ1134.2 +026100 02 FILLER PIC X(41) VALUE SPACE. SQ1134.2 +026200* SQ1134.2 +026300 01 CCVS-H-2B. SQ1134.2 +026400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1134.2 +026500 02 TEST-ID PIC X(9). SQ1134.2 +026600 02 FILLER PIC X(4) VALUE " IN ". SQ1134.2 +026700 02 FILLER PIC X(12) VALUE SQ1134.2 +026800 " HIGH ". SQ1134.2 +026900 02 FILLER PIC X(22) VALUE SQ1134.2 +027000 " LEVEL VALIDATION FOR ". SQ1134.2 +027100 02 FILLER PIC X(58) VALUE SQ1134.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +027300 01 CCVS-H-3. SQ1134.2 +027400 02 FILLER PIC X(34) VALUE SQ1134.2 +027500 " FOR OFFICIAL USE ONLY ". SQ1134.2 +027600 02 FILLER PIC X(58) VALUE SQ1134.2 +027700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1134.2 +027800 02 FILLER PIC X(28) VALUE SQ1134.2 +027900 " COPYRIGHT 1985,1986 ". SQ1134.2 +028000 01 CCVS-E-1. SQ1134.2 +028100 02 FILLER PIC X(52) VALUE SPACE. SQ1134.2 +028200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1134.2 +028300 02 ID-AGAIN PIC X(9). SQ1134.2 +028400 02 FILLER PIC X(45) VALUE SPACES. SQ1134.2 +028500 01 CCVS-E-2. SQ1134.2 +028600 02 FILLER PIC X(31) VALUE SPACE. SQ1134.2 +028700 02 FILLER PIC X(21) VALUE SPACE. SQ1134.2 +028800 02 CCVS-E-2-2. SQ1134.2 +028900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1134.2 +029000 03 FILLER PIC X VALUE SPACE. SQ1134.2 +029100 03 ENDER-DESC PIC X(44) VALUE SQ1134.2 +029200 "ERRORS ENCOUNTERED". SQ1134.2 +029300 01 CCVS-E-3. SQ1134.2 +029400 02 FILLER PIC X(22) VALUE SQ1134.2 +029500 " FOR OFFICIAL USE ONLY". SQ1134.2 +029600 02 FILLER PIC X(12) VALUE SPACE. SQ1134.2 +029700 02 FILLER PIC X(58) VALUE SQ1134.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +029900 02 FILLER PIC X(8) VALUE SPACE. SQ1134.2 +030000 02 FILLER PIC X(20) VALUE SQ1134.2 +030100 " COPYRIGHT 1985,1986". SQ1134.2 +030200 01 CCVS-E-4. SQ1134.2 +030300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1134.2 +030400 02 FILLER PIC X(4) VALUE " OF ". SQ1134.2 +030500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1134.2 +030600 02 FILLER PIC X(40) VALUE SQ1134.2 +030700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1134.2 +030800 01 XXINFO. SQ1134.2 +030900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1134.2 +031000 02 INFO-TEXT. SQ1134.2 +031100 04 FILLER PIC X(8) VALUE SPACE. SQ1134.2 +031200 04 XXCOMPUTED PIC X(20). SQ1134.2 +031300 04 FILLER PIC X(5) VALUE SPACE. SQ1134.2 +031400 04 XXCORRECT PIC X(20). SQ1134.2 +031500 02 INF-ANSI-REFERENCE PIC X(48). SQ1134.2 +031600 01 HYPHEN-LINE. SQ1134.2 +031700 02 FILLER PIC IS X VALUE IS SPACE. SQ1134.2 +031800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1134.2 +031900- "*****************************************". SQ1134.2 +032000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1134.2 +032100- "******************************". SQ1134.2 +032200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1134.2 +032300 "SQ113A". SQ1134.2 +032400* SQ1134.2 +032500* SQ1134.2 +032600 PROCEDURE DIVISION. SQ1134.2 +032700* SQ1134.2 +032800 CCVS1 SECTION. SQ1134.2 +032900 OPEN-FILES. SQ1134.2 +033000P OPEN I-O RAW-DATA. SQ1134.2 +033100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1134.2 +033200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1134.2 +033300P MOVE "ABORTED " TO C-ABORT. SQ1134.2 +033400P ADD 1 TO C-NO-OF-TESTS. SQ1134.2 +033500P ACCEPT C-DATE FROM DATE. SQ1134.2 +033600P ACCEPT C-TIME FROM TIME. SQ1134.2 +033700P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1134.2 +033800PEND-E-1. SQ1134.2 +033900P CLOSE RAW-DATA. SQ1134.2 +034000 OPEN OUTPUT PRINT-FILE. SQ1134.2 +034100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1134.2 +034200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1134.2 +034300 MOVE SPACE TO TEST-RESULTS. SQ1134.2 +034400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1134.2 +034500 MOVE ZERO TO REC-SKEL-SUB. SQ1134.2 +034600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1134.2 +034700 GO TO CCVS1-EXIT. SQ1134.2 +034800* SQ1134.2 +034900 CCVS-INIT-FILE. SQ1134.2 +035000 ADD 1 TO REC-SKL-SUB. SQ1134.2 +035100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1134.2 +035200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1134.2 +035300* SQ1134.2 +035400 CLOSE-FILES. SQ1134.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1134.2 +035600 CLOSE PRINT-FILE. SQ1134.2 +035700P OPEN I-O RAW-DATA. SQ1134.2 +035800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1134.2 +035900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1134.2 +036000P MOVE "OK. " TO C-ABORT. SQ1134.2 +036100P MOVE PASS-COUNTER TO C-OK. SQ1134.2 +036200P MOVE ERROR-HOLD TO C-ALL. SQ1134.2 +036300P MOVE ERROR-COUNTER TO C-FAIL. SQ1134.2 +036400P MOVE DELETE-CNT TO C-DELETED. SQ1134.2 +036500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1134.2 +036600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1134.2 +036700PEND-E-2. SQ1134.2 +036800P CLOSE RAW-DATA. SQ1134.2 +036900 TERMINATE-CCVS. SQ1134.2 +037000S EXIT PROGRAM. SQ1134.2 +037100 STOP RUN. SQ1134.2 +037200* SQ1134.2 +037300 INSPT. SQ1134.2 +037400 MOVE "INSPT" TO P-OR-F. SQ1134.2 +037500 ADD 1 TO INSPECT-COUNTER. SQ1134.2 +037600 PERFORM PRINT-DETAIL. SQ1134.2 +037700* SQ1134.2 +037800 PASS. SQ1134.2 +037900 MOVE "PASS " TO P-OR-F. SQ1134.2 +038000 ADD 1 TO PASS-COUNTER. SQ1134.2 +038100 PERFORM PRINT-DETAIL. SQ1134.2 +038200* SQ1134.2 +038300 FAIL. SQ1134.2 +038400 MOVE "FAIL*" TO P-OR-F. SQ1134.2 +038500 ADD 1 TO ERROR-COUNTER. SQ1134.2 +038600 PERFORM PRINT-DETAIL. SQ1134.2 +038700* SQ1134.2 +038800 DE-LETE. SQ1134.2 +038900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1134.2 +039000 MOVE "*****" TO P-OR-F. SQ1134.2 +039100 ADD 1 TO DELETE-COUNTER. SQ1134.2 +039200 PERFORM PRINT-DETAIL. SQ1134.2 +039300* SQ1134.2 +039400 PRINT-DETAIL. SQ1134.2 +039500 IF REC-CT NOT EQUAL TO ZERO SQ1134.2 +039600 MOVE "." TO PARDOT-X SQ1134.2 +039700 MOVE REC-CT TO DOTVALUE. SQ1134.2 +039800 MOVE TEST-RESULTS TO PRINT-REC. SQ1134.2 +039900 PERFORM WRITE-LINE. SQ1134.2 +040000 IF P-OR-F EQUAL TO "FAIL*" SQ1134.2 +040100 PERFORM WRITE-LINE SQ1134.2 +040200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1134.2 +040300 ELSE SQ1134.2 +040400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1134.2 +040500 MOVE SPACE TO P-OR-F. SQ1134.2 +040600 MOVE SPACE TO COMPUTED-X. SQ1134.2 +040700 MOVE SPACE TO CORRECT-X. SQ1134.2 +040800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1134.2 +040900 MOVE SPACE TO RE-MARK. SQ1134.2 +041000* SQ1134.2 +041100 HEAD-ROUTINE. SQ1134.2 +041200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1134.2 +041500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1134.2 +041600 COLUMN-NAMES-ROUTINE. SQ1134.2 +041700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +041800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +042000 END-ROUTINE. SQ1134.2 +042100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1134.2 +042200 PERFORM WRITE-LINE 5 TIMES. SQ1134.2 +042300 END-RTN-EXIT. SQ1134.2 +042400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1134.2 +042500 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +042600* SQ1134.2 +042700 END-ROUTINE-1. SQ1134.2 +042800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1134.2 +042900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1134.2 +043000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1134.2 +043100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1134.2 +043200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1134.2 +043300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1134.2 +043400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1134.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1134.2 +043600 PERFORM WRITE-LINE. SQ1134.2 +043700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1134.2 +043800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1134.2 +043900 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +044000 ELSE SQ1134.2 +044100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1134.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1134.2 +044300 PERFORM WRITE-LINE. SQ1134.2 +044400 END-ROUTINE-13. SQ1134.2 +044500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1134.2 +044600 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +044700 ELSE SQ1134.2 +044800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1134.2 +044900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1134.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1134.2 +045100 PERFORM WRITE-LINE. SQ1134.2 +045200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1134.2 +045300 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +045400 ELSE SQ1134.2 +045500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1134.2 +045600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1134.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +045800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +045900* SQ1134.2 +046000 WRITE-LINE. SQ1134.2 +046100 ADD 1 TO RECORD-COUNT. SQ1134.2 +046200Y IF RECORD-COUNT GREATER 50 SQ1134.2 +046300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1134.2 +046400Y MOVE SPACE TO DUMMY-RECORD SQ1134.2 +046500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1134.2 +046600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1134.2 +046700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1134.2 +046800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1134.2 +046900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1134.2 +047000Y MOVE ZERO TO RECORD-COUNT. SQ1134.2 +047100 PERFORM WRT-LN. SQ1134.2 +047200* SQ1134.2 +047300 WRT-LN. SQ1134.2 +047400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1134.2 +047500 MOVE SPACE TO DUMMY-RECORD. SQ1134.2 +047600 BLANK-LINE-PRINT. SQ1134.2 +047700 PERFORM WRT-LN. SQ1134.2 +047800 FAIL-ROUTINE. SQ1134.2 +047900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1134.2 +048000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1134.2 +048100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1134.2 +048200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1134.2 +048300 MOVE XXINFO TO DUMMY-RECORD. SQ1134.2 +048400 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +048500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1134.2 +048600 GO TO FAIL-ROUTINE-EX. SQ1134.2 +048700 FAIL-ROUTINE-WRITE. SQ1134.2 +048800 MOVE TEST-COMPUTED TO PRINT-REC SQ1134.2 +048900 PERFORM WRITE-LINE SQ1134.2 +049000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1134.2 +049100 MOVE TEST-CORRECT TO PRINT-REC SQ1134.2 +049200 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +049300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1134.2 +049400 FAIL-ROUTINE-EX. SQ1134.2 +049500 EXIT. SQ1134.2 +049600 BAIL-OUT. SQ1134.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1134.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1134.2 +049900 BAIL-OUT-WRITE. SQ1134.2 +050000 MOVE CORRECT-A TO XXCORRECT. SQ1134.2 +050100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1134.2 +050200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1134.2 +050300 MOVE XXINFO TO DUMMY-RECORD. SQ1134.2 +050400 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +050500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1134.2 +050600 BAIL-OUT-EX. SQ1134.2 +050700 EXIT. SQ1134.2 +050800 CCVS1-EXIT. SQ1134.2 +050900 EXIT. SQ1134.2 +051000* SQ1134.2 +051100**************************************************************** SQ1134.2 +051200* * SQ1134.2 +051300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1134.2 +051400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1134.2 +051500* * SQ1134.2 +051600**************************************************************** SQ1134.2 +051700* SQ1134.2 +051800 SECT-SQ113-0001 SECTION. SQ1134.2 +051900 SEQ-INIT-WR-01. SQ1134.2 +052000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1134.2 +052100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1134.2 +052200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1134.2 +052300 MOVE 000120 TO XRECORD-LENGTH (1). SQ1134.2 +052400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1134.2 +052500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1134.2 +052600 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1134.2 +052700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1134.2 +052800 MOVE "S" TO XLABEL-TYPE (1). SQ1134.2 +052900 MOVE ZERO TO XRECORD-NUMBER (1). SQ1134.2 +053000 MOVE "CREATE 750 RECORD FILE" TO FEATURE. SQ1134.2 +053100 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1134.2 +053200 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +053300 MOVE "00" TO SQ-FS1-STATUS-COPY. SQ1134.2 +053400* SQ1134.2 +053500 SEQ-TEST-WR-01. SQ1134.2 +053600 OPEN OUTPUT SQ-FS1. SQ1134.2 +053700 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +053800 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +053900 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +054000* SQ1134.2 +054100 SEQ-TEST-WR-01-LOOP. SQ1134.2 +054200 ADD 1 TO XRECORD-NUMBER (1). SQ1134.2 +054300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1134.2 +054400 WRITE SQ-FS1R1-F-G-120. SQ1134.2 +054500 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +054600 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +054700 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +054800 IF XRECORD-NUMBER (1) LESS THAN 750 SQ1134.2 +054900 GO TO SEQ-TEST-WR-01-LOOP. SQ1134.2 +055000* SQ1134.2 +055100 CLOSE SQ-FS1. SQ1134.2 +055200 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +055300 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +055400 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +055500* SQ1134.2 +055600 IF SQ-FS1-STATUS-COPY EQUAL "00" SQ1134.2 +055700 PERFORM PASS SQ1134.2 +055800 ELSE SQ1134.2 +055900 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +056000 MOVE "00" TO CORRECT-A SQ1134.2 +056100 MOVE "ERROR DURING FILE CREATION" TO RE-MARK SQ1134.2 +056200 PERFORM FAIL. SQ1134.2 +056300* SQ1134.2 +056400* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 750 SQ1134.2 +056500* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1134.2 +056600* READ AND THE RECORDS VERIFIED. SQ1134.2 +056700* SQ1134.2 +056800 SEQ-INIT-GF-02. SQ1134.2 +056900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1134.2 +057000 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1134.2 +057100 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +057200 MOVE 1 TO REC-CT. SQ1134.2 +057300 GO TO SEQ-TEST-GF-02-01. SQ1134.2 +057400 SEQ-DELETE-02-01. SQ1134.2 +057500 PERFORM DE-LETE. SQ1134.2 +057600 GO TO SEQ-DELETE-02-02. SQ1134.2 +057700 SEQ-TEST-GF-02-01. SQ1134.2 +057800 OPEN INPUT SQ-FS1. SQ1134.2 +057900 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +058000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +058100 MOVE "00" TO CORRECT-A SQ1134.2 +058200 MOVE "FAILURE FILE STATUS FROM OPEN" TO RE-MARK SQ1134.2 +058300 PERFORM FAIL SQ1134.2 +058400 GO TO SEQ-DELETE-02-02 SQ1134.2 +058500 ELSE SQ1134.2 +058600 PERFORM PASS. SQ1134.2 +058700* SQ1134.2 +058800 SEQ-INIT-GF-02-02. SQ1134.2 +058900 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1134.2 +059000 TO FILE-RECORD-INFO-P1-120 (2). SQ1134.2 +059100 MOVE ZERO TO XRECORD-NUMBER (2). SQ1134.2 +059200 MOVE "00" TO SQ-FS1-STATUS-COPY. SQ1134.2 +059300 GO TO SEQ-TEST-GF-02-02. SQ1134.2 +059400 SEQ-DELETE-02-02. SQ1134.2 +059500 ADD 1 TO REC-CT. SQ1134.2 +059600 PERFORM DE-LETE. SQ1134.2 +059700 ADD 1 TO REC-CT. SQ1134.2 +059800 PERFORM DE-LETE. SQ1134.2 +059900 ADD 1 TO REC-CT. SQ1134.2 +060000 PERFORM DE-LETE. SQ1134.2 +060100 GO TO SEQ-DELETE-GF-02-05. SQ1134.2 +060200 SEQ-TEST-GF-02-02. SQ1134.2 +060300 ADD 1 TO REC-CT. SQ1134.2 +060400 SEQ-TEST-GF-02-02-LOOP. SQ1134.2 +060500 READ SQ-FS1 SQ1134.2 +060600 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1134.2 +060700 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +060800 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +060900 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +061000 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +061100 ADD 1 TO XRECORD-NUMBER (2). SQ1134.2 +061200 IF XRECORD-NUMBER (2) GREATER THAN 750 SQ1134.2 +061300 GO TO SEQ-TEST-GF-02-02-1. SQ1134.2 +061400 IF FILE-RECORD-INFO-P1-120 (1) SQ1134.2 +061500 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1134.2 +061600 ADD 1 TO RECORDS-IN-ERROR. SQ1134.2 +061700 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1134.2 +061800* SQ1134.2 +061900 SEQ-TEST-GF-02-02-1. SQ1134.2 +062000 IF XRECORD-NUMBER (2) = 750 SQ1134.2 +062100 PERFORM PASS SQ1134.2 +062200 ELSE SQ1134.2 +062300 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1134.2 +062400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +062500 MOVE 750 TO CORRECT-18V0 SQ1134.2 +062600 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +062700 PERFORM FAIL. SQ1134.2 +062800* SQ1134.2 +062900 ADD 1 TO REC-CT. SQ1134.2 +063000 IF SQ-FS1-STATUS-COPY NOT EQUAL "00" SQ1134.2 +063100 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1134.2 +063200 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +063300 MOVE "00" TO CORRECT-A SQ1134.2 +063400 PERFORM FAIL SQ1134.2 +063500 ELSE SQ1134.2 +063600 PERFORM PASS. SQ1134.2 +063700* SQ1134.2 +063800 ADD 1 TO REC-CT. SQ1134.2 +063900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1134.2 +064000 PERFORM PASS SQ1134.2 +064100 ELSE SQ1134.2 +064200 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1134.2 +064300 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +064400 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1134.2 +064500 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1134.2 +064600 PERFORM FAIL. SQ1134.2 +064700* SQ1134.2 +064800 SEQ-INIT-GF-02-05. SQ1134.2 +064900 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +065000 GO TO SEQ-TEST-GF-02-05. SQ1134.2 +065100 SEQ-DELETE-GF-02-05. SQ1134.2 +065200 ADD 1 TO REC-CT. SQ1134.2 +065300 PERFORM DE-LETE. SQ1134.2 +065400 GO TO SEQ-TEST-GF-02-END. SQ1134.2 +065500 SEQ-TEST-GF-02-05. SQ1134.2 +065600 ADD 1 TO REC-CT. SQ1134.2 +065700 CLOSE SQ-FS1. SQ1134.2 +065800 IF SQ-FS1-STATUS EQUAL "00" SQ1134.2 +065900 PERFORM PASS SQ1134.2 +066000 ELSE SQ1134.2 +066100 MOVE "UNEXPECTED FILE STATUS ON CLOSE" TO RE-MARK SQ1134.2 +066200 MOVE "00" TO CORRECT-A SQ1134.2 +066300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +066400 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1134.2 +066500 PERFORM FAIL. SQ1134.2 +066600* SQ1134.2 +066700 SEQ-TEST-GF-02-END. SQ1134.2 +066800* SQ1134.2 +066900* SQ1134.2 +067000 SEQ-INIT-GF-03. SQ1134.2 +067100 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1134.2 +067200 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1134.2 +067300 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +067400 MOVE 1 TO REC-CT. SQ1134.2 +067500 GO TO SEQ-TEST-GF-03. SQ1134.2 +067600 SEQ-DELETE-03. SQ1134.2 +067700 PERFORM DE-LETE. SQ1134.2 +067800 GO TO SEQ-TEST-03-END. SQ1134.2 +067900 SEQ-TEST-GF-03. SQ1134.2 +068000 OPEN INPUT SQ-FS1. SQ1134.2 +068100 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +068200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +068300 MOVE "00" TO CORRECT-A SQ1134.2 +068400 MOVE "FAILURE FILE STATUS FROM OPEN" TO RE-MARK SQ1134.2 +068500 PERFORM FAIL SQ1134.2 +068600 ELSE SQ1134.2 +068700 PERFORM PASS. SQ1134.2 +068800 SEQ-TEST-03-END. SQ1134.2 +068900* SQ1134.2 +069000* SQ1134.2 +069100* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1134.2 +069200* THE READ STATEMENT SQ1134.2 +069300* SQ1134.2 +069400 SEQ-INIT-GF-04. SQ1134.2 +069500 MOVE ZERO TO XRECORD-NUMBER (2). SQ1134.2 +069600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +069700 MOVE "READ...RECORD AT END" TO FEATURE. SQ1134.2 +069800 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1134.2 +069900 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +070000 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +070100 MOVE 1 TO REC-CT. SQ1134.2 +070200 GO TO SEQ-TEST-GF-04. SQ1134.2 +070300 SEQ-DELETE-04. SQ1134.2 +070400 PERFORM DE-LETE. SQ1134.2 +070500 ADD 1 TO REC-CT. SQ1134.2 +070600 PERFORM DE-LETE. SQ1134.2 +070700 ADD 1 TO REC-CT. SQ1134.2 +070800 PERFORM DE-LETE. SQ1134.2 +070900 GO TO SEQ-TEST-04-END. SQ1134.2 +071000 SEQ-TEST-GF-04. SQ1134.2 +071100 READ SQ-FS1 RECORD AT END SQ1134.2 +071200 MOVE 1 TO EOF-FLAG SQ1134.2 +071300 GO TO SEQ-TEST-GF-04-01. SQ1134.2 +071400 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +071500 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +071600 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +071700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +071800 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +071900 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +072000 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +072100 MOVE 1 TO ERROR-FLAG. SQ1134.2 +072200 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1134.2 +072300 GO TO SEQ-TEST-GF-04. SQ1134.2 +072400* SQ1134.2 +072500 SEQ-TEST-GF-04-01. SQ1134.2 +072600 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +072700 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +072800 MOVE 750 TO CORRECT-18V0 SQ1134.2 +072900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +073000 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +073100 PERFORM FAIL SQ1134.2 +073200 ELSE SQ1134.2 +073300 PERFORM PASS. SQ1134.2 +073400* SQ1134.2 +073500 SEQ-TEST-GF-04-02. SQ1134.2 +073600 ADD 1 TO REC-CT. SQ1134.2 +073700 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +073800 PERFORM PASS SQ1134.2 +073900 ELSE SQ1134.2 +074000 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +074100 MOVE "**" TO CORRECT-A SQ1134.2 +074200 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +074300 TO RE-MARK SQ1134.2 +074400 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +074500 PERFORM FAIL. SQ1134.2 +074600* SQ1134.2 +074700 SEQ-TEST-GF-04-03. SQ1134.2 +074800 ADD 1 TO REC-CT. SQ1134.2 +074900 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +075000 PERFORM PASS SQ1134.2 +075100 ELSE SQ1134.2 +075200 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +075300 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +075400 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +075500 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +075600 PERFORM FAIL. SQ1134.2 +075700 SEQ-TEST-04-END. SQ1134.2 +075800* SQ1134.2 +075900* SQ1134.2 +076000 SEQ-INIT-GF-O5. SQ1134.2 +076100 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +076200 GO TO SEQ-DELETE-05. SQ1134.2 +076300 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +076400 MOVE "READ...AT END..." TO FEATURE SQ1134.2 +076500 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1134.2 +076600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +076700 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +076800 MOVE 1 TO REC-CT. SQ1134.2 +076900 GO TO SEQ-TEST-GF-05. SQ1134.2 +077000 SEQ-DELETE-05. SQ1134.2 +077100 PERFORM DE-LETE. SQ1134.2 +077200 ADD 1 TO REC-CT. SQ1134.2 +077300 PERFORM DE-LETE. SQ1134.2 +077400 ADD 1 TO REC-CT. SQ1134.2 +077500 PERFORM DE-LETE. SQ1134.2 +077600 GO TO SEQ-TEST-05-END. SQ1134.2 +077700 SEQ-TEST-GF-05. SQ1134.2 +077800 READ SQ-FS1 AT END SQ1134.2 +077900 MOVE 1 TO EOF-FLAG SQ1134.2 +078000 GO TO SEQ-TEST-GF-05-01. SQ1134.2 +078100 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +078200 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +078300 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +078400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +078500 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +078600 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +078700 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +078800 MOVE 1 TO ERROR-FLAG. SQ1134.2 +078900 IF XRECORD-NUMBER (2) LESS THAN 400 SQ1134.2 +079000 GO TO SEQ-TEST-GF-05. SQ1134.2 +079100* SQ1134.2 +079200 SEQ-TEST-GF-05-01. SQ1134.2 +079300 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +079400 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +079500 MOVE 750 TO CORRECT-18V0 SQ1134.2 +079600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +079700 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +079800 PERFORM FAIL SQ1134.2 +079900 ELSE SQ1134.2 +080000 PERFORM PASS. SQ1134.2 +080100* SQ1134.2 +080200 SEQ-TEST-GF-05-02. SQ1134.2 +080300 ADD 1 TO REC-CT. SQ1134.2 +080400 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +080500 PERFORM PASS SQ1134.2 +080600 ELSE SQ1134.2 +080700 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +080800 MOVE "**" TO CORRECT-A SQ1134.2 +080900 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +081000 TO RE-MARK SQ1134.2 +081100 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +081200 PERFORM FAIL. SQ1134.2 +081300* SQ1134.2 +081400 SEQ-TEST-GF-05-03. SQ1134.2 +081500 ADD 1 TO REC-CT. SQ1134.2 +081600 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +081700 PERFORM PASS SQ1134.2 +081800 ELSE SQ1134.2 +081900 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +082000 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +082100 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +082200 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +082300 PERFORM FAIL. SQ1134.2 +082400 SEQ-TEST-05-END. SQ1134.2 +082500* SQ1134.2 +082600* SQ1134.2 +082700 SEQ-INIT-GF-O6. SQ1134.2 +082800 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +082900 GO TO SEQ-DELETE-06. SQ1134.2 +083000 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +083100 MOVE "READ...RECORD END..." TO FEATURE SQ1134.2 +083200 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1134.2 +083300 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +083400 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +083500 MOVE 1 TO REC-CT. SQ1134.2 +083600 GO TO SEQ-TEST-GF-06. SQ1134.2 +083700 SEQ-DELETE-06. SQ1134.2 +083800 PERFORM DE-LETE. SQ1134.2 +083900 ADD 1 TO REC-CT. SQ1134.2 +084000 PERFORM DE-LETE. SQ1134.2 +084100 ADD 1 TO REC-CT. SQ1134.2 +084200 PERFORM DE-LETE. SQ1134.2 +084300 GO TO SEQ-TEST-06-END. SQ1134.2 +084400 SEQ-TEST-GF-06. SQ1134.2 +084500 READ SQ-FS1 RECORD END SQ1134.2 +084600 MOVE 1 TO EOF-FLAG SQ1134.2 +084700 GO TO SEQ-TEST-GF-06-01. SQ1134.2 +084800 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +084900 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +085000 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +085100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +085200 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +085300 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +085400 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +085500 MOVE 1 TO ERROR-FLAG. SQ1134.2 +085600 IF XRECORD-NUMBER (2) LESS THAN 600 SQ1134.2 +085700 GO TO SEQ-TEST-GF-06. SQ1134.2 +085800* SQ1134.2 +085900 SEQ-TEST-GF-06-01. SQ1134.2 +086000 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +086100 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +086200 MOVE 750 TO CORRECT-18V0 SQ1134.2 +086300 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +086400 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +086500 PERFORM FAIL SQ1134.2 +086600 ELSE SQ1134.2 +086700 PERFORM PASS. SQ1134.2 +086800* SQ1134.2 +086900 SEQ-TEST-GF-06-02. SQ1134.2 +087000 ADD 1 TO REC-CT. SQ1134.2 +087100 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +087200 PERFORM PASS SQ1134.2 +087300 ELSE SQ1134.2 +087400 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +087500 MOVE "**" TO CORRECT-A SQ1134.2 +087600 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +087700 TO RE-MARK SQ1134.2 +087800 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +087900 PERFORM FAIL. SQ1134.2 +088000* SQ1134.2 +088100 SEQ-TEST-GF-06-03. SQ1134.2 +088200 ADD 1 TO REC-CT. SQ1134.2 +088300 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +088400 PERFORM PASS SQ1134.2 +088500 ELSE SQ1134.2 +088600 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +088700 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +088800 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +088900 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +089000 PERFORM FAIL. SQ1134.2 +089100 SEQ-TEST-06-END. SQ1134.2 +089200* SQ1134.2 +089300* SQ1134.2 +089400 SEQ-INIT-GF-O7. SQ1134.2 +089500 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +089600 GO TO SEQ-DELETE-07. SQ1134.2 +089700 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +089800 MOVE "READ... END..." TO FEATURE SQ1134.2 +089900 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1134.2 +090000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +090100 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +090200 MOVE 1 TO REC-CT. SQ1134.2 +090300 GO TO SEQ-TEST-GF-07. SQ1134.2 +090400 SEQ-DELETE-07. SQ1134.2 +090500 PERFORM DE-LETE. SQ1134.2 +090600 ADD 1 TO REC-CT. SQ1134.2 +090700 PERFORM DE-LETE. SQ1134.2 +090800 ADD 1 TO REC-CT. SQ1134.2 +090900 PERFORM DE-LETE. SQ1134.2 +091000 GO TO SEQ-TEST-07-END. SQ1134.2 +091100 SEQ-TEST-GF-07. SQ1134.2 +091200 READ SQ-FS1 END SQ1134.2 +091300 MOVE 1 TO EOF-FLAG SQ1134.2 +091400 GO TO SEQ-TEST-GF-07-01. SQ1134.2 +091500 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +091600 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +091700 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +091800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +091900 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +092000 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +092100 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +092200 MOVE 1 TO ERROR-FLAG. SQ1134.2 +092300 IF XRECORD-NUMBER (2) LESS THAN 750 SQ1134.2 +092400 GO TO SEQ-TEST-GF-07. SQ1134.2 +092500* SQ1134.2 +092600 SEQ-TEST-GF-07-01. SQ1134.2 +092700 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +092800 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +092900 MOVE 750 TO CORRECT-18V0 SQ1134.2 +093000 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +093100 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +093200 PERFORM FAIL SQ1134.2 +093300 ELSE SQ1134.2 +093400 PERFORM PASS. SQ1134.2 +093500* SQ1134.2 +093600 SEQ-TEST-GF-07-02. SQ1134.2 +093700 ADD 1 TO REC-CT. SQ1134.2 +093800 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +093900 PERFORM PASS SQ1134.2 +094000 ELSE SQ1134.2 +094100 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +094200 MOVE "**" TO CORRECT-A SQ1134.2 +094300 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +094400 TO RE-MARK SQ1134.2 +094500 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +094600 PERFORM FAIL. SQ1134.2 +094700* SQ1134.2 +094800 SEQ-TEST-GF-07-03. SQ1134.2 +094900 ADD 1 TO REC-CT. SQ1134.2 +095000 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +095100 PERFORM PASS SQ1134.2 +095200 ELSE SQ1134.2 +095300 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +095400 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +095500 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +095600 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +095700 PERFORM FAIL. SQ1134.2 +095800 SEQ-TEST-07-END. SQ1134.2 +095900* SQ1134.2 +096000* SQ1134.2 +096100 SEQ-INIT-GF-O8. SQ1134.2 +096200 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +096300 GO TO SEQ-DELETE-08. SQ1134.2 +096400 MOVE "READ... END... AT EOF" TO FEATURE SQ1134.2 +096500 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1134.2 +096600 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +096700 MOVE 1 TO REC-CT. SQ1134.2 +096800 GO TO SEQ-TEST-GF-08. SQ1134.2 +096900 SEQ-DELETE-08. SQ1134.2 +097000 PERFORM DE-LETE. SQ1134.2 +097100 GO TO SEQ-TEST-08-END. SQ1134.2 +097200 SEQ-TEST-GF-08. SQ1134.2 +097300 READ SQ-FS1 END SQ1134.2 +097400 MOVE 1 TO EOF-FLAG. SQ1134.2 +097500 IF SQ-FS1-STATUS NOT EQUAL TO "10" SQ1134.2 +097600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +097700 MOVE "00" TO CORRECT-A SQ1134.2 +097800 MOVE "EXPECTED EOF STATUS CODE NOT RETURNED" SQ1134.2 +097900 TO RE-MARK SQ1134.2 +098000 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1134.2 +098100 PERFORM FAIL SQ1134.2 +098200 ELSE SQ1134.2 +098300 PERFORM PASS. SQ1134.2 +098400* SQ1134.2 +098500 SEQ-TEST-GF-08-02. SQ1134.2 +098600 ADD 1 TO REC-CT. SQ1134.2 +098700 IF EOF-FLAG NOT EQUAL TO 1 SQ1134.2 +098800 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1134.2 +098900 MOVE 1 TO CORRECT-18V0 SQ1134.2 +099000 MOVE "EOF NOT FOUND AFTER 750 RECORDS" TO RE-MARK SQ1134.2 +099100 PERFORM FAIL SQ1134.2 +099200 ELSE SQ1134.2 +099300 PERFORM PASS. SQ1134.2 +099400 SEQ-TEST-08-END. SQ1134.2 +099500* SQ1134.2 +099600* SQ1134.2 +099700 SEQ-INIT-GF-O9. SQ1134.2 +099800 MOVE "CLOSE FILE " TO FEATURE SQ1134.2 +099900 MOVE "SEQ-TEST-GF-O9" TO PAR-NAME. SQ1134.2 +100000 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +100100 MOVE 1 TO REC-CT. SQ1134.2 +100200 GO TO SEQ-TEST-GF-09. SQ1134.2 +100300 SEQ-DELETE-09. SQ1134.2 +100400 PERFORM DE-LETE. SQ1134.2 +100500 GO TO SEQ-TEST-09-END. SQ1134.2 +100600 SEQ-TEST-GF-09. SQ1134.2 +100700 CLOSE SQ-FS1. SQ1134.2 +100800 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +100900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +101000 MOVE "00" TO CORRECT-A SQ1134.2 +101100 MOVE "UNEXPECTED FILE STATUS FROM CLOSE" TO RE-MARK SQ1134.2 +101200 PERFORM FAIL SQ1134.2 +101300 ELSE SQ1134.2 +101400 PERFORM PASS. SQ1134.2 +101500 SEQ-TEST-09-END. SQ1134.2 +101600* SQ1134.2 +101700* SQ1134.2 +101800 TERMINATE-ROUTINE. SQ1134.2 +101900 EXIT. SQ1134.2 +102000 CCVS-EXIT SECTION. SQ1134.2 +102100 CCVS-999999. SQ1134.2 +102200 GO TO CLOSE-FILES. SQ1134.2 +*END-OF,SQ113A +*HEADER,COBOL,SQ114A +000100 IDENTIFICATION DIVISION. SQ1144.2 +000200 PROGRAM-ID. SQ1144.2 +000300 SQ114A. SQ1144.2 +000400**************************************************************** SQ1144.2 +000500* * SQ1144.2 +000600* VALIDATION FOR:- * SQ1144.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1144.2 +000800* * SQ1144.2 +000900* CREATION DATE / VALIDATION DATE * SQ1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1144.2 +001100* * SQ1144.2 +001200**************************************************************** SQ1144.2 +001300 SQ1144.2 +001400* SQ1144.2 +001500* SQ1144.2 +001600* NEW TEST: SQ1144.2 +001700* OPEN OUTPUT FILE-1, FILE-2. SQ1144.2 +001800* OPEN INPUT FILE-1, FILE-2. SQ1144.2 +001900* CLOSE FILE-1, FILE-2. SQ1144.2 +002000* SQ1144.2 +002100* THE ROUTINE SQ114A TESTS THE USE OF THE SAME AREA SQ1144.2 +002200* CLAUSE FOR TWO FILES, ONE A TAPE FILE AND THE OTHER A SQ1144.2 +002300* MASS STORAGE FILE. THIS ROUTINE IS A COMBINATION OF THE SQ1144.2 +002400* ROUTINES SQ102 AND SQ104. SQ1144.2 +002500* SQ1144.2 +002600* USED X-CARDS: SQ1144.2 +002700* XXXXX001 SQ1144.2 +002800* XXXXX014 SQ1144.2 +002900* XXXXX055 SQ1144.2 +003000* P XXXXX062 SQ1144.2 +003100* XXXXX082 SQ1144.2 +003200* XXXXX083 SQ1144.2 +003300* C XXXXX084 SQ1144.2 +003400* SQ1144.2 +003500* SQ1144.2 +003600 ENVIRONMENT DIVISION. SQ1144.2 +003700 CONFIGURATION SECTION. SQ1144.2 +003800 SOURCE-COMPUTER. SQ1144.2 +003900 XXXXX082. SQ1144.2 +004000 OBJECT-COMPUTER. SQ1144.2 +004100 XXXXX083. SQ1144.2 +004200 INPUT-OUTPUT SECTION. SQ1144.2 +004300 FILE-CONTROL. SQ1144.2 +004400P SELECT RAW-DATA ASSIGN TO SQ1144.2 +004500P XXXXX062 SQ1144.2 +004600P ORGANIZATION IS INDEXED SQ1144.2 +004700P ACCESS MODE IS RANDOM SQ1144.2 +004800P RECORD KEY IS RAW-DATA-KEY. SQ1144.2 +004900 SELECT PRINT-FILE ASSIGN TO SQ1144.2 +005000 XXXXX055. SQ1144.2 +005100 SELECT SQ-FS1 ASSIGN TO SQ1144.2 +005200 XXXXX001 SQ1144.2 +005300 ORGANIZATION IS SEQUENTIAL SQ1144.2 +005400 ACCESS MODE IS SEQUENTIAL SQ1144.2 +005500 FILE STATUS IS FILE-STATUS-SQ-FS1. SQ1144.2 +005600 SELECT SQ-FS2 ASSIGN TO SQ1144.2 +005700 XXXXX014 SQ1144.2 +005800 ORGANIZATION IS SEQUENTIAL SQ1144.2 +005900 ACCESS MODE IS SEQUENTIAL SQ1144.2 +006000 FILE STATUS IS FILE-STATUS-SQ-FS2. SQ1144.2 +006100 SELECT SQ-FS3 ASSIGN TO SQ1144.2 +006200 XXXXX014 SQ1144.2 +006300 ORGANIZATION IS SEQUENTIAL SQ1144.2 +006400 ACCESS MODE IS SEQUENTIAL SQ1144.2 +006500 FILE STATUS IS FILE-STATUS-SQ-FS3. SQ1144.2 +006600 I-O-CONTROL. SQ1144.2 +006700 SAME AREA SQ-FS1 SQ-FS3. SQ1144.2 +006800 DATA DIVISION. SQ1144.2 +006900 FILE SECTION. SQ1144.2 +007000P SQ1144.2 +007100PFD RAW-DATA. SQ1144.2 +007200P SQ1144.2 +007300P01 RAW-DATA-SATZ. SQ1144.2 +007400P 05 RAW-DATA-KEY PIC X(6). SQ1144.2 +007500P 05 C-DATE PIC 9(6). SQ1144.2 +007600P 05 C-TIME PIC 9(8). SQ1144.2 +007700P 05 C-NO-OF-TESTS PIC 99. SQ1144.2 +007800P 05 C-OK PIC 999. SQ1144.2 +007900P 05 C-ALL PIC 999. SQ1144.2 +008000P 05 C-FAIL PIC 999. SQ1144.2 +008100P 05 C-DELETED PIC 999. SQ1144.2 +008200P 05 C-INSPECT PIC 999. SQ1144.2 +008300P 05 C-NOTE PIC X(13). SQ1144.2 +008400P 05 C-INDENT PIC X. SQ1144.2 +008500P 05 C-ABORT PIC X(8). SQ1144.2 +008600 FD PRINT-FILE SQ1144.2 +008700C LABEL RECORDS SQ1144.2 +008800C XXXXX084 SQ1144.2 +008900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1144.2 +009000 . SQ1144.2 +009100 01 PRINT-REC PICTURE X(120). SQ1144.2 +009200 01 DUMMY-RECORD PICTURE X(120). SQ1144.2 +009300 FD SQ-FS1 SQ1144.2 +009400C LABEL RECORD STANDARD SQ1144.2 +009500 . SQ1144.2 +009600 01 SQ-FS1R1-F-G-120. SQ1144.2 +009700 02 FILLER PIC X(120). SQ1144.2 +009800 FD SQ-FS2 SQ1144.2 +009900C LABEL RECORDS ARE STANDARD SQ1144.2 +010000C DATA RECORD SQ-FS2R1-F-G-120 SQ1144.2 +010100 BLOCK CONTAINS 120 CHARACTERS SQ1144.2 +010200 RECORD CONTAINS 120 CHARACTERS. SQ1144.2 +010300 01 SQ-FS2R1-F-G-120. SQ1144.2 +010400 02 FILLER PIC X(120). SQ1144.2 +010500 FD SQ-FS3 SQ1144.2 +010600C LABEL RECORDS ARE STANDARD SQ1144.2 +010700C DATA RECORD SQ-FS3R1-F-G-120 SQ1144.2 +010800 BLOCK CONTAINS 120 CHARACTERS SQ1144.2 +010900 RECORD CONTAINS 120 CHARACTERS. SQ1144.2 +011000 01 SQ-FS3R1-F-G-120. SQ1144.2 +011100 02 FILLER PIC X(120). SQ1144.2 +011200 WORKING-STORAGE SECTION. SQ1144.2 +011300 01 FILE-STATUS-SQ-FS1 PIC XX VALUE SPACE. SQ1144.2 +011400 01 FILE-STATUS-SQ-FS3 PIC XX VALUE SPACE. SQ1144.2 +011500 01 FILE-STATUS-SQ-FS2 PIC XX VALUE SPACE. SQ1144.2 +011600 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1144.2 +011700 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1144.2 +011800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1144.2 +011900 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1144.2 +012000 01 FILE-RECORD-INFORMATION-REC. SQ1144.2 +012100 03 FILE-RECORD-INFO-SKELETON. SQ1144.2 +012200 05 FILLER PICTURE X(48) VALUE SQ1144.2 +012300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1144.2 +012400 05 FILLER PICTURE X(46) VALUE SQ1144.2 +012500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1144.2 +012600 05 FILLER PICTURE X(26) VALUE SQ1144.2 +012700 ",LFIL=000000,ORG= ,LBLR= ". SQ1144.2 +012800 05 FILLER PICTURE X(37) VALUE SQ1144.2 +012900 ",RECKEY= ". SQ1144.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1144.2 +013100 ",ALTKEY1= ". SQ1144.2 +013200 05 FILLER PICTURE X(38) VALUE SQ1144.2 +013300 ",ALTKEY2= ". SQ1144.2 +013400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1144.2 +013500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1144.2 +013600 05 FILE-RECORD-INFO-P1-120. SQ1144.2 +013700 07 FILLER PIC X(5). SQ1144.2 +013800 07 XFILE-NAME PIC X(6). SQ1144.2 +013900 07 FILLER PIC X(8). SQ1144.2 +014000 07 XRECORD-NAME PIC X(6). SQ1144.2 +014100 07 FILLER PIC X(1). SQ1144.2 +014200 07 REELUNIT-NUMBER PIC 9(1). SQ1144.2 +014300 07 FILLER PIC X(7). SQ1144.2 +014400 07 XRECORD-NUMBER PIC 9(6). SQ1144.2 +014500 07 FILLER PIC X(6). SQ1144.2 +014600 07 UPDATE-NUMBER PIC 9(2). SQ1144.2 +014700 07 FILLER PIC X(5). SQ1144.2 +014800 07 ODO-NUMBER PIC 9(4). SQ1144.2 +014900 07 FILLER PIC X(5). SQ1144.2 +015000 07 XPROGRAM-NAME PIC X(5). SQ1144.2 +015100 07 FILLER PIC X(7). SQ1144.2 +015200 07 XRECORD-LENGTH PIC 9(6). SQ1144.2 +015300 07 FILLER PIC X(7). SQ1144.2 +015400 07 CHARS-OR-RECORDS PIC X(2). SQ1144.2 +015500 07 FILLER PIC X(1). SQ1144.2 +015600 07 XBLOCK-SIZE PIC 9(4). SQ1144.2 +015700 07 FILLER PIC X(6). SQ1144.2 +015800 07 RECORDS-IN-FILE PIC 9(6). SQ1144.2 +015900 07 FILLER PIC X(5). SQ1144.2 +016000 07 XFILE-ORGANIZATION PIC X(2). SQ1144.2 +016100 07 FILLER PIC X(6). SQ1144.2 +016200 07 XLABEL-TYPE PIC X(1). SQ1144.2 +016300 05 FILE-RECORD-INFO-P121-240. SQ1144.2 +016400 07 FILLER PIC X(8). SQ1144.2 +016500 07 XRECORD-KEY PIC X(29). SQ1144.2 +016600 07 FILLER PIC X(9). SQ1144.2 +016700 07 ALTERNATE-KEY1 PIC X(29). SQ1144.2 +016800 07 FILLER PIC X(9). SQ1144.2 +016900 07 ALTERNATE-KEY2 PIC X(29). SQ1144.2 +017000 07 FILLER PIC X(7). SQ1144.2 +017100 01 TEST-RESULTS. SQ1144.2 +017200 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1144.2 +017400 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1144.2 +017600 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017700 02 PAR-NAME. SQ1144.2 +017800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1144.2 +017900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1144.2 +018000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1144.2 +018100 03 FILLER PIC X(5) VALUE SPACE. SQ1144.2 +018200 02 FILLER PIC X(10) VALUE SPACE. SQ1144.2 +018300 02 RE-MARK PIC X(61). SQ1144.2 +018400 01 TEST-COMPUTED. SQ1144.2 +018500 02 FILLER PIC X(30) VALUE SPACE. SQ1144.2 +018600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1144.2 +018700 02 COMPUTED-X. SQ1144.2 +018800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1144.2 +018900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1144.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1144.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1144.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1144.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1144.2 +019400 04 COMPUTED-18V0 PICTURE -9(18). SQ1144.2 +019500 04 FILLER PICTURE X. SQ1144.2 +019600 03 FILLER PIC X(50) VALUE SPACE. SQ1144.2 +019700 01 TEST-CORRECT. SQ1144.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1144.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1144.2 +020000 02 CORRECT-X. SQ1144.2 +020100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1144.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1144.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1144.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1144.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1144.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. SQ1144.2 +020700 04 CORRECT-18V0 PICTURE -9(18). SQ1144.2 +020800 04 FILLER PICTURE X. SQ1144.2 +020900 03 FILLER PIC X(50) VALUE SPACE. SQ1144.2 +021000 01 CCVS-C-1. SQ1144.2 +021100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1144.2 +021200- "SS PARAGRAPH-NAME SQ1144.2 +021300- " REMARKS". SQ1144.2 +021400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1144.2 +021500 01 CCVS-C-2. SQ1144.2 +021600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +021700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1144.2 +021800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1144.2 +021900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1144.2 +022000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1144.2 +022100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1144.2 +022200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1144.2 +022300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1144.2 +022400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1144.2 +022500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1144.2 +022600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1144.2 +022700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1144.2 +022800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1144.2 +022900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1144.2 +023000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1144.2 +023100 01 CCVS-H-1. SQ1144.2 +023200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1144.2 +023300 02 FILLER PICTURE X(67) VALUE SQ1144.2 +023400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1144.2 +023500- " SYSTEM". SQ1144.2 +023600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1144.2 +023700 01 CCVS-H-2. SQ1144.2 +023800 02 FILLER PICTURE X(52) VALUE IS SQ1144.2 +023900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1144.2 +024000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1144.2 +024100 02 TEST-ID PICTURE IS X(9). SQ1144.2 +024200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1144.2 +024300 01 CCVS-H-3. SQ1144.2 +024400 02 FILLER PICTURE X(34) VALUE SQ1144.2 +024500 " FOR OFFICIAL USE ONLY ". SQ1144.2 +024600 02 FILLER PICTURE X(58) VALUE SQ1144.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1144.2 +024800 02 FILLER PICTURE X(28) VALUE SQ1144.2 +024900 " COPYRIGHT 1985 ". SQ1144.2 +025000 01 CCVS-E-1. SQ1144.2 +025100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1144.2 +025200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1144.2 +025300 02 ID-AGAIN PICTURE IS X(9). SQ1144.2 +025400 02 FILLER PICTURE X(45) VALUE IS SQ1144.2 +025500 " NTIS DISTRIBUTION COBOL 85". SQ1144.2 +025600 01 CCVS-E-2. SQ1144.2 +025700 02 FILLER PICTURE X(31) VALUE SQ1144.2 +025800 SPACE. SQ1144.2 +025900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1144.2 +026000 02 CCVS-E-2-2. SQ1144.2 +026100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1144.2 +026200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +026300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1144.2 +026400 01 CCVS-E-3. SQ1144.2 +026500 02 FILLER PICTURE X(22) VALUE SQ1144.2 +026600 " FOR OFFICIAL USE ONLY". SQ1144.2 +026700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1144.2 +026800 02 FILLER PICTURE X(58) VALUE SQ1144.2 +026900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1144.2 +027000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1144.2 +027100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1144.2 +027200 01 CCVS-E-4. SQ1144.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1144.2 +027400 02 FILLER PIC XXXX VALUE " OF ". SQ1144.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1144.2 +027600 02 FILLER PIC X(40) VALUE SQ1144.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1144.2 +027800 01 XXINFO. SQ1144.2 +027900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1144.2 +028000 02 INFO-TEXT. SQ1144.2 +028100 04 FILLER PIC X(20) VALUE SPACE. SQ1144.2 +028200 04 XXCOMPUTED PIC X(20). SQ1144.2 +028300 04 FILLER PIC X(5) VALUE SPACE. SQ1144.2 +028400 04 XXCORRECT PIC X(20). SQ1144.2 +028500 01 HYPHEN-LINE. SQ1144.2 +028600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +028700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1144.2 +028800- "*****************************************". SQ1144.2 +028900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1144.2 +029000- "******************************". SQ1144.2 +029100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1144.2 +029200 "SQ114A". SQ1144.2 +029300 PROCEDURE DIVISION. SQ1144.2 +029400 CCVS1 SECTION. SQ1144.2 +029500 OPEN-FILES. SQ1144.2 +029600P OPEN I-O RAW-DATA. SQ1144.2 +029700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1144.2 +029800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1144.2 +029900P MOVE "ABORTED " TO C-ABORT. SQ1144.2 +030000P ADD 1 TO C-NO-OF-TESTS. SQ1144.2 +030100P ACCEPT C-DATE FROM DATE. SQ1144.2 +030200P ACCEPT C-TIME FROM TIME. SQ1144.2 +030300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1144.2 +030400PEND-E-1. SQ1144.2 +030500P CLOSE RAW-DATA. SQ1144.2 +030600 OPEN OUTPUT PRINT-FILE. SQ1144.2 +030700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1144.2 +030800 MOVE SPACE TO TEST-RESULTS. SQ1144.2 +030900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1144.2 +031000 MOVE ZERO TO REC-SKL-SUB. SQ1144.2 +031100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1144.2 +031200 CCVS-INIT-FILE. SQ1144.2 +031300 ADD 1 TO REC-SKL-SUB. SQ1144.2 +031400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1144.2 +031500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1144.2 +031600 CCVS-INIT-EXIT. SQ1144.2 +031700 GO TO CCVS1-EXIT. SQ1144.2 +031800 CLOSE-FILES. SQ1144.2 +031900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1144.2 +032000P OPEN I-O RAW-DATA. SQ1144.2 +032100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1144.2 +032200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1144.2 +032300P MOVE "OK. " TO C-ABORT. SQ1144.2 +032400P MOVE PASS-COUNTER TO C-OK. SQ1144.2 +032500P MOVE ERROR-HOLD TO C-ALL. SQ1144.2 +032600P MOVE ERROR-COUNTER TO C-FAIL. SQ1144.2 +032700P MOVE DELETE-CNT TO C-DELETED. SQ1144.2 +032800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1144.2 +032900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1144.2 +033000PEND-E-2. SQ1144.2 +033100P CLOSE RAW-DATA. SQ1144.2 +033200 TERMINATE-CCVS. SQ1144.2 +033300S EXIT PROGRAM. SQ1144.2 +033400STERMINATE-CALL. SQ1144.2 +033500 STOP RUN. SQ1144.2 +033600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1144.2 +033700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1144.2 +033800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1144.2 +033900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1144.2 +034000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1144.2 +034100 PRINT-DETAIL. SQ1144.2 +034200 IF REC-CT NOT EQUAL TO ZERO SQ1144.2 +034300 MOVE "." TO PARDOT-X SQ1144.2 +034400 MOVE REC-CT TO DOTVALUE. SQ1144.2 +034500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1144.2 +034600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1144.2 +034700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1144.2 +034800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1144.2 +034900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1144.2 +035000 MOVE SPACE TO CORRECT-X. SQ1144.2 +035100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1144.2 +035200 MOVE SPACE TO RE-MARK. SQ1144.2 +035300 HEAD-ROUTINE. SQ1144.2 +035400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +035500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1144.2 +035600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1144.2 +035700 COLUMN-NAMES-ROUTINE. SQ1144.2 +035800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +035900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +036100 END-ROUTINE. SQ1144.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1144.2 +036300 END-RTN-EXIT. SQ1144.2 +036400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +036500 END-ROUTINE-1. SQ1144.2 +036600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1144.2 +036700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1144.2 +036800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1144.2 +036900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1144.2 +037000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1144.2 +037100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1144.2 +037200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1144.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1144.2 +037400 END-ROUTINE-12. SQ1144.2 +037500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1144.2 +037600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1144.2 +037700 MOVE "NO " TO ERROR-TOTAL SQ1144.2 +037800 ELSE SQ1144.2 +037900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1144.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1144.2 +038100 PERFORM WRITE-LINE. SQ1144.2 +038200 END-ROUTINE-13. SQ1144.2 +038300 IF DELETE-CNT IS EQUAL TO ZERO SQ1144.2 +038400 MOVE "NO " TO ERROR-TOTAL ELSE SQ1144.2 +038500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1144.2 +038600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1144.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +038800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1144.2 +038900 MOVE "NO " TO ERROR-TOTAL SQ1144.2 +039000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1144.2 +039100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1144.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +039300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +039400 WRITE-LINE. SQ1144.2 +039500 ADD 1 TO RECORD-COUNT. SQ1144.2 +039600Y IF RECORD-COUNT GREATER 50 SQ1144.2 +039700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1144.2 +039800Y MOVE SPACE TO DUMMY-RECORD SQ1144.2 +039900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1144.2 +040000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1144.2 +040100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1144.2 +040200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1144.2 +040300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1144.2 +040400Y MOVE ZERO TO RECORD-COUNT. SQ1144.2 +040500 PERFORM WRT-LN. SQ1144.2 +040600 WRT-LN. SQ1144.2 +040700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1144.2 +040800 MOVE SPACE TO DUMMY-RECORD. SQ1144.2 +040900 BLANK-LINE-PRINT. SQ1144.2 +041000 PERFORM WRT-LN. SQ1144.2 +041100 FAIL-ROUTINE. SQ1144.2 +041200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1144.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1144.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1144.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +041600 GO TO FAIL-ROUTINE-EX. SQ1144.2 +041700 FAIL-ROUTINE-WRITE. SQ1144.2 +041800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1144.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +042000 FAIL-ROUTINE-EX. EXIT. SQ1144.2 +042100 BAIL-OUT. SQ1144.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1144.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1144.2 +042400 BAIL-OUT-WRITE. SQ1144.2 +042500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1144.2 +042600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +042700 BAIL-OUT-EX. EXIT. SQ1144.2 +042800 CCVS1-EXIT. SQ1144.2 +042900 EXIT. SQ1144.2 +043000 SECT-SQ102-0001 SECTION. SQ1144.2 +043100 SEQ-INIT-001. SQ1144.2 +043200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1144.2 +043300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1144.2 +043400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1144.2 +043500 MOVE 000120 TO XRECORD-LENGTH (1). SQ1144.2 +043600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1144.2 +043700 MOVE 0001 TO XBLOCK-SIZE (1). SQ1144.2 +043800 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1144.2 +043900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1144.2 +044000 MOVE "S" TO XLABEL-TYPE (1). SQ1144.2 +044100 MOVE 000001 TO XRECORD-NUMBER (1). SQ1144.2 +044200 OPEN-TEST-GF-01. SQ1144.2 +044300************************************************************** SQ1144.2 +044400* OPEN OUTPUT FILE-1, FILE-2. WILL BE TESTED IN THIS TEST.* SQ1144.2 +044500* VII; 4.3.2 (PAGE VII-39) * SQ1144.2 +044600************************************************************** SQ1144.2 +044700 SQ1144.2 +044800 MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +044900 MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +045000 OPEN OUTPUT SQ-FS1 SQ-FS2. SQ1144.2 +045100 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +045200 OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +045300 GO TO OPEN-FAIL-GF-01. SQ1144.2 +045400 OPEN-PASS-GF-01. SQ1144.2 +045500 PERFORM PASS SQ1144.2 +045600 GO TO OPEN-WRITE-GF-01. SQ1144.2 +045700 OPEN-FAIL-GF-01. SQ1144.2 +045800 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +045900 MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +046000 MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +046100 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +046200 PERFORM FAIL SQ1144.2 +046300 PERFORM OPEN-WRITE-GF-01. SQ1144.2 +046400 IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +046500 MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +046600 MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +046700 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +046800 PERFORM FAIL. SQ1144.2 +046900 OPEN-WRITE-GF-01. SQ1144.2 +047000 MOVE "OPEN-TEST-GF-01" TO PAR-NAME. SQ1144.2 +047100 MOVE "OPEN OUTPUT FIL1 FIL2" TO FEATURE. SQ1144.2 +047200 PERFORM PRINT-DETAIL. SQ1144.2 +047300 WRITE-TEST-GF-01. SQ1144.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1144.2 +047500 WRITE SQ-FS1R1-F-G-120. SQ1144.2 +047600 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1144.2 +047700 GO TO WRITE-WRITE-GF-01. SQ1144.2 +047800 ADD 1 TO XRECORD-NUMBER (1). SQ1144.2 +047900 GO TO WRITE-TEST-GF-01. SQ1144.2 +048000 WRITE-WRITE-GF-01. SQ1144.2 +048100 MOVE "WRITE FILE SQ-FS1" TO FEATURE. SQ1144.2 +048200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1144.2 +048300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1144.2 +048400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1144.2 +048500 PERFORM PRINT-DETAIL. SQ1144.2 +048600 CLOSE SQ-FS1. SQ1144.2 +048700* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1144.2 +048800* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1144.2 +048900 SEQ-INIT-002. SQ1144.2 +049000 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +049100* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1144.2 +049200* SEQ-TEST-001. SQ1144.2 +049300 OPEN INPUT SQ-FS1. SQ1144.2 +049400 SEQ-TEST-002. SQ1144.2 +049500 READ SQ-FS1 SQ1144.2 +049600 AT END GO TO SEQ-TEST-002-1. SQ1144.2 +049700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1144.2 +049800 ADD 1 TO WRK-CS-09V00. SQ1144.2 +049900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +050000 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1144.2 +050100 GO TO SEQ-FAIL-002. SQ1144.2 +050200 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1144.2 +050300 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +050400 GO TO SEQ-TEST-002. SQ1144.2 +050500 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1144.2 +050600 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +050700 GO TO SEQ-TEST-002. SQ1144.2 +050800 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1144.2 +050900 ADD 1 TO RECORDS-IN-ERROR. SQ1144.2 +051000 GO TO SEQ-TEST-002. SQ1144.2 +051100 SEQ-TEST-002-1. SQ1144.2 +051200 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1144.2 +051300 GO TO SEQ-PASS-002. SQ1144.2 +051400 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1144.2 +051500 SEQ-FAIL-002. SQ1144.2 +051600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1144.2 +051700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1144.2 +051800 PERFORM FAIL. SQ1144.2 +051900 GO TO SEQ-WRITE-002. SQ1144.2 +052000 SEQ-PASS-002. SQ1144.2 +052100 PERFORM PASS. SQ1144.2 +052200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1144.2 +052300 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +052400 SEQ-WRITE-002. SQ1144.2 +052500 MOVE "SEQ-TEST-002" TO PAR-NAME. SQ1144.2 +052600 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1144.2 +052700 PERFORM PRINT-DETAIL. SQ1144.2 +052800 SEQ-CLOSE-002. SQ1144.2 +052900 CLOSE SQ-FS1. SQ1144.2 +053000 READ-INIT-GF-01. SQ1144.2 +053100 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +053200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +053300 OPEN INPUT SQ-FS1. SQ1144.2 +053400* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1144.2 +053500* IN THIS SERIES OF TESTS. SQ1144.2 +053600 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1144.2 +053700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1144.2 +053800 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +053900 READ-TEST-GF-01. SQ1144.2 +054000 READ SQ-FS1 RECORD AT END SQ1144.2 +054100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +054200 MOVE 1 TO EOF-FLAG SQ1144.2 +054300 GO TO READ-FAIL-GF-01. SQ1144.2 +054400 PERFORM RECORD-CHECK. SQ1144.2 +054500 IF WRK-CS-09V00 EQUAL TO 200 SQ1144.2 +054600 GO TO READ-TEST-GF-01-1. SQ1144.2 +054700 GO TO READ-TEST-GF-01. SQ1144.2 +054800 RECORD-CHECK. SQ1144.2 +054900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1144.2 +055000 ADD 1 TO WRK-CS-09V00. SQ1144.2 +055100 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1144.2 +055200 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +055300 MOVE 1 TO ERROR-FLAG. SQ1144.2 +055400 READ-TEST-GF-01-1. SQ1144.2 +055500 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +055600 GO TO READ-PASS-GF-01. SQ1144.2 +055700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +055800 READ-FAIL-GF-01. SQ1144.2 +055900 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +056000 PERFORM FAIL. SQ1144.2 +056100 GO TO READ-WRITE-GF-01. SQ1144.2 +056200 READ-PASS-GF-01. SQ1144.2 +056300 PERFORM PASS. SQ1144.2 +056400 READ-WRITE-GF-01. SQ1144.2 +056500 PERFORM PRINT-DETAIL. SQ1144.2 +056600 READ-INIT-GF-02. SQ1144.2 +056700 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +056800 GO TO READ-EOF-GF-05. SQ1144.2 +056900 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +057000 MOVE "READ...AT END..." TO FEATURE. SQ1144.2 +057100 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1144.2 +057200 READ-TEST-GF-02. SQ1144.2 +057300 READ SQ-FS1 AT END SQ1144.2 +057400 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +057500 MOVE 1 TO EOF-FLAG SQ1144.2 +057600 GO TO READ-FAIL-GF-02. SQ1144.2 +057700 PERFORM RECORD-CHECK. SQ1144.2 +057800 IF WRK-CS-09V00 EQUAL TO 400 SQ1144.2 +057900 GO TO READ-TEST-GF-02-1. SQ1144.2 +058000 GO TO READ-TEST-GF-02. SQ1144.2 +058100 READ-TEST-GF-02-1. SQ1144.2 +058200 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +058300 GO TO READ-PASS-GF-02. SQ1144.2 +058400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +058500 READ-FAIL-GF-02. SQ1144.2 +058600 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +058700 PERFORM FAIL. SQ1144.2 +058800 GO TO READ-WRITE-GF-02. SQ1144.2 +058900 READ-PASS-GF-02. SQ1144.2 +059000 PERFORM PASS. SQ1144.2 +059100 READ-WRITE-GF-02. SQ1144.2 +059200 PERFORM PRINT-DETAIL. SQ1144.2 +059300 READ-INIT-GF-03. SQ1144.2 +059400 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +059500 GO TO READ-EOF-GF-05. SQ1144.2 +059600 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +059700 MOVE "READ...RECORD END..." TO RE-MARK. SQ1144.2 +059800 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1144.2 +059900 READ-TEST-GF-03. SQ1144.2 +060000 READ SQ-FS1 RECORD END SQ1144.2 +060100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +060200 MOVE 1 TO EOF-FLAG SQ1144.2 +060300 GO TO READ-FAIL-GF-03. SQ1144.2 +060400 PERFORM RECORD-CHECK. SQ1144.2 +060500 IF WRK-CS-09V00 EQUAL TO 600 SQ1144.2 +060600 GO TO READ-TEST-GF-03-1. SQ1144.2 +060700 GO TO READ-TEST-GF-03. SQ1144.2 +060800 READ-TEST-GF-03-1. SQ1144.2 +060900 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +061000 GO TO READ-PASS-GF-03. SQ1144.2 +061100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +061200 READ-FAIL-GF-03. SQ1144.2 +061300 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +061400 PERFORM FAIL. SQ1144.2 +061500 GO TO READ-WRITE-GF-03. SQ1144.2 +061600 READ-PASS-GF-03. SQ1144.2 +061700 PERFORM PASS. SQ1144.2 +061800 READ-WRITE-GF-03. SQ1144.2 +061900 PERFORM PRINT-DETAIL. SQ1144.2 +062000 READ-INIT-GF-04. SQ1144.2 +062100 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +062200 GO TO READ-EOF-GF-05. SQ1144.2 +062300 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +062400 MOVE "READ...END..." TO FEATURE. SQ1144.2 +062500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1144.2 +062600 READ-TEST-GF-04. SQ1144.2 +062700 READ SQ-FS1 END GO TO READ-TEST-GF-04-1. SQ1144.2 +062800 PERFORM RECORD-CHECK. SQ1144.2 +062900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +063000 GO TO READ-TEST-GF-04-1. SQ1144.2 +063100 GO TO READ-TEST-GF-04. SQ1144.2 +063200 READ-TEST-GF-04-1. SQ1144.2 +063300 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +063400 GO TO READ-PASS-GF-04. SQ1144.2 +063500 READ-FAIL-GF-04. SQ1144.2 +063600 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +063700 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +063800 PERFORM FAIL. SQ1144.2 +063900 GO TO READ-WRITE-GF-04. SQ1144.2 +064000 READ-PASS-GF-04. SQ1144.2 +064100 PERFORM PASS. SQ1144.2 +064200 READ-WRITE-GF-04. SQ1144.2 +064300 PERFORM PRINT-DETAIL. SQ1144.2 +064400 READ-TEST-GF-05. SQ1144.2 +064500 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1144.2 +064600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1144.2 +064700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1144.2 +064800 GO TO READ-FAIL-GF-05. SQ1144.2 +064900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +065000 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1144.2 +065100 GO TO READ-FAIL-GF-05. SQ1144.2 +065200 READ-PASS-GF-05. SQ1144.2 +065300 PERFORM PASS. SQ1144.2 +065400 GO TO READ-WRITE-GF-05. SQ1144.2 +065500 READ-EOF-GF-05. SQ1144.2 +065600 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ1144.2 +065700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1144.2 +065800 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +065900 READ-FAIL-GF-05. SQ1144.2 +066000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +066100 PERFORM FAIL. SQ1144.2 +066200 READ-WRITE-GF-05. SQ1144.2 +066300 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1144.2 +066400 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1144.2 +066500 PERFORM PRINT-DETAIL. SQ1144.2 +066600 READ-CLOSE-GF-05. SQ1144.2 +066700 CLOSE SQ-FS1. SQ1144.2 +066800 CLOSE SQ-FS2. SQ1144.2 +066900 SECT-SQ104-0001 SECTION. SQ1144.2 +067000 OPEN-TEST-GF-02. SQ1144.2 +067100 OPEN OUTPUT SQ-FS3. SQ1144.2 +067200 IF FILE-STATUS-SQ-FS3 NOT = "00" SQ1144.2 +067300 GO TO OPEN-FAIL-GF-03. SQ1144.2 +067400 OPEN-PASS-GF-01. SQ1144.2 +067500 PERFORM PASS SQ1144.2 +067600 GO TO OPEN-WRITE-GF-02. SQ1144.2 +067700 OPEN-FAIL-GF-02. SQ1144.2 +067800 IF FILE-STATUS-SQ-FS3 NOT = "00" SQ1144.2 +067900 MOVE "STATUS 3: 00" TO CORRECT-A SQ1144.2 +068000 MOVE FILE-STATUS-SQ-FS3 TO COMPUTED-A SQ1144.2 +068100 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +068200 PERFORM FAIL. SQ1144.2 +068300 OPEN-WRITE-GF-02. SQ1144.2 +068400 MOVE "OPEN-TEST-GF-02" TO PAR-NAME. SQ1144.2 +068500 MOVE "OPEN OUTPUT FIL3" TO FEATURE. SQ1144.2 +068600 PERFORM PRINT-DETAIL. SQ1144.2 +068700 WRITE-INIT-GF-02. SQ1144.2 +068800 MOVE "SQ-FS3" TO XFILE-NAME (2). SQ1144.2 +068900 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ1144.2 +069000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). SQ1144.2 +069100 MOVE 120 TO XRECORD-LENGTH (2). SQ1144.2 +069200 MOVE "CH" TO CHARS-OR-RECORDS (2). SQ1144.2 +069300 MOVE 120 TO XBLOCK-SIZE (2). SQ1144.2 +069400 MOVE 000649 TO RECORDS-IN-FILE (2). SQ1144.2 +069500 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ1144.2 +069600 MOVE "S" TO XLABEL-TYPE (2). SQ1144.2 +069700 MOVE 000001 TO XRECORD-NUMBER (2). SQ1144.2 +069800 WRITE-TEST-GF-02. SQ1144.2 +069900 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS3R1-F-G-120. SQ1144.2 +070000 WRITE SQ-FS3R1-F-G-120. SQ1144.2 +070100 IF XRECORD-NUMBER (2) EQUAL TO 649 SQ1144.2 +070200 GO TO WRITE-WRITE-GF-02. SQ1144.2 +070300 ADD 1 TO XRECORD-NUMBER (2). SQ1144.2 +070400 GO TO WRITE-TEST-GF-02. SQ1144.2 +070500 WRITE-WRITE-GF-02. SQ1144.2 +070600 MOVE "WRITE SQ-FS3 649RE" TO FEATURE. SQ1144.2 +070700 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ1144.2 +070800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1144.2 +070900 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ1144.2 +071000 PERFORM PRINT-DETAIL. SQ1144.2 +071100 CLOSE SQ-FS3. SQ1144.2 +071200* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1144.2 +071300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1144.2 +071400 READ-INIT-GF-06. SQ1144.2 +071500 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +071600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +071700* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1144.2 +071800* READ-TEST-007. SQ1144.2 +071900 OPEN INPUT SQ-FS3. SQ1144.2 +072000 READ-TEST-GF-06. SQ1144.2 +072100 READ SQ-FS3 RECORD SQ1144.2 +072200 AT END GO TO READ-TEST-GF-06-1. SQ1144.2 +072300 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1144.2 +072400 ADD 1 TO WRK-CS-09V00. SQ1144.2 +072500 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +072600 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1144.2 +072700 GO TO READ-FAIL-GF-06. SQ1144.2 +072800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) SQ1144.2 +072900 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +073000 GO TO READ-TEST-GF-06. SQ1144.2 +073100 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS3" SQ1144.2 +073200 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +073300 GO TO READ-TEST-GF-06. SQ1144.2 +073400 IF XLABEL-TYPE (2) NOT EQUAL TO "S" SQ1144.2 +073500 ADD 1 TO RECORDS-IN-ERROR. SQ1144.2 +073600 GO TO READ-TEST-GF-06. SQ1144.2 +073700 READ-TEST-GF-06-1. SQ1144.2 +073800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1144.2 +073900 GO TO READ-PASS-GF-06. SQ1144.2 +074000 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1144.2 +074100 READ-FAIL-GF-06. SQ1144.2 +074200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1144.2 +074300 PERFORM FAIL. SQ1144.2 +074400 GO TO READ-WRITE-GF-06. SQ1144.2 +074500 READ-PASS-GF-06. SQ1144.2 +074600 PERFORM PASS. SQ1144.2 +074700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1144.2 +074800 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +074900 READ-WRITE-GF-06. SQ1144.2 +075000 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1144.2 +075100 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1144.2 +075200 PERFORM PRINT-DETAIL. SQ1144.2 +075300 READ-CLOSE-GF-06. SQ1144.2 +075400 CLOSE SQ-FS3. SQ1144.2 +075500 READ-INIT-GF-07. SQ1144.2 +075600 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +075700 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +075800 OPEN INPUT SQ-FS3. SQ1144.2 +075900* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1144.2 +076000* IN THIS SERIES OF TESTS. SQ1144.2 +076100 MOVE "LEV 1 READ STATEMENT" TO FEATURE. SQ1144.2 +076200 MOVE ZERO TO EOF-FLAG. SQ1144.2 +076300 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1144.2 +076400 MOVE "READ-TEST-GF-07" TO PAR-NAME. SQ1144.2 +076500 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +076600 READ-TEST-GF-07. SQ1144.2 +076700 READ SQ-FS3 RECORD SQ1144.2 +076800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +076900 MOVE 1 TO EOF-FLAG SQ1144.2 +077000 GO TO READ-FAIL-GF-07. SQ1144.2 +077100 PERFORM RECORD-CHECK-1. SQ1144.2 +077200 IF WRK-CS-09V00 EQUAL TO 50 SQ1144.2 +077300 GO TO READ-TEST-GF-07-1. SQ1144.2 +077400 GO TO READ-TEST-GF-07. SQ1144.2 +077500 RECORD-CHECK-1. SQ1144.2 +077600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1144.2 +077700 ADD 1 TO WRK-CS-09V00. SQ1144.2 +077800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) SQ1144.2 +077900 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +078000 MOVE 1 TO ERROR-FLAG. SQ1144.2 +078100 READ-TEST-GF-07-1. SQ1144.2 +078200 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +078300 GO TO READ-PASS-GF-07. SQ1144.2 +078400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +078500 READ-FAIL-GF-07. SQ1144.2 +078600 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +078700 PERFORM FAIL. SQ1144.2 +078800 GO TO READ-WRITE-GF-07. SQ1144.2 +078900 READ-PASS-GF-07. SQ1144.2 +079000 PERFORM PASS. SQ1144.2 +079100 READ-WRITE-GF-07. SQ1144.2 +079200 PERFORM PRINT-DETAIL. SQ1144.2 +079300 READ-INIT-GF-08. SQ1144.2 +079400 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +079500 GO TO READ-EOF-GF-11. SQ1144.2 +079600 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +079700 MOVE "READ...AT END..." TO FEATURE. SQ1144.2 +079800 MOVE "READ-TEST-GF-08" TO PAR-NAME. SQ1144.2 +079900 READ-TEST-GF-08. SQ1144.2 +080000 READ SQ-FS3 AT END SQ1144.2 +080100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +080200 MOVE 1 TO EOF-FLAG SQ1144.2 +080300 GO TO READ-FAIL-GF-08. SQ1144.2 +080400 PERFORM RECORD-CHECK-1. SQ1144.2 +080500 IF WRK-CS-09V00 EQUAL TO 200 SQ1144.2 +080600 GO TO READ-TEST-GF-08-1. SQ1144.2 +080700 GO TO READ-TEST-GF-08. SQ1144.2 +080800 READ-TEST-GF-08-1. SQ1144.2 +080900 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +081000 GO TO READ-PASS-GF-08. SQ1144.2 +081100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +081200 READ-FAIL-GF-08. SQ1144.2 +081300 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +081400 PERFORM FAIL. SQ1144.2 +081500 GO TO READ-WRITE-GF-08. SQ1144.2 +081600 READ-PASS-GF-08. SQ1144.2 +081700 PERFORM PASS. SQ1144.2 +081800 READ-WRITE-GF-08. SQ1144.2 +081900 PERFORM PRINT-DETAIL. SQ1144.2 +082000 READ-INIT-GF-09. SQ1144.2 +082100 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +082200 GO TO READ-EOF-GF-11. SQ1144.2 +082300 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +082400 MOVE "READ...RECORD END..." TO FEATURE. SQ1144.2 +082500 MOVE "READ-TEST-GF-09" TO PAR-NAME. SQ1144.2 +082600 READ-TEST-GF-09. SQ1144.2 +082700 READ SQ-FS3 RECORD END SQ1144.2 +082800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +082900 MOVE 1 TO EOF-FLAG SQ1144.2 +083000 GO TO READ-FAIL-GF-09. SQ1144.2 +083100 PERFORM RECORD-CHECK-1. SQ1144.2 +083200 IF WRK-CS-09V00 EQUAL TO 499 SQ1144.2 +083300 GO TO READ-TEST-GF-09-1. SQ1144.2 +083400 GO TO READ-TEST-GF-09. SQ1144.2 +083500 READ-TEST-GF-09-1. SQ1144.2 +083600 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +083700 GO TO READ-PASS-GF-09. SQ1144.2 +083800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +083900 READ-FAIL-GF-09. SQ1144.2 +084000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +084100 PERFORM FAIL. SQ1144.2 +084200 GO TO READ-WRITE-GF-09. SQ1144.2 +084300 READ-PASS-GF-09. SQ1144.2 +084400 PERFORM PASS. SQ1144.2 +084500 READ-WRITE-GF-09. SQ1144.2 +084600 PERFORM PRINT-DETAIL. SQ1144.2 +084700 READ-INIT-GF-10. SQ1144.2 +084800 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +084900 GO TO READ-EOF-GF-11. SQ1144.2 +085000 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +085100 MOVE "READ...END..." TO FEATURE. SQ1144.2 +085200 MOVE "READ-TEST-GF-10" TO PAR-NAME. SQ1144.2 +085300 READ-TEST-GF-10. SQ1144.2 +085400 READ SQ-FS3 END SQ1144.2 +085500 GO TO READ-TEST-GF-10-1. SQ1144.2 +085600 PERFORM RECORD-CHECK-1. SQ1144.2 +085700 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +085800 GO TO READ-TEST-GF-10-1. SQ1144.2 +085900 GO TO READ-TEST-GF-10. SQ1144.2 +086000 READ-TEST-GF-10-1. SQ1144.2 +086100 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +086200 GO TO READ-PASS-GF-10. SQ1144.2 +086300 READ-FAIL-GF-10. SQ1144.2 +086400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +086500 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +086600 PERFORM FAIL. SQ1144.2 +086700 GO TO READ-WRITE-GF-10. SQ1144.2 +086800 READ-PASS-GF-10. SQ1144.2 +086900 PERFORM PASS. SQ1144.2 +087000 READ-WRITE-GF-10. SQ1144.2 +087100 PERFORM PRINT-DETAIL. SQ1144.2 +087200 READ-TEST-GF-11. SQ1144.2 +087300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1144.2 +087400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1144.2 +087500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1144.2 +087600 GO TO READ-FAIL-GF-11. SQ1144.2 +087700 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +087800 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1144.2 +087900 GO TO READ-FAIL-GF-11. SQ1144.2 +088000 READ-PASS-GF-11. SQ1144.2 +088100 PERFORM PASS SQ1144.2 +088200 GO TO READ-WRITE-GF-11. SQ1144.2 +088300 READ-EOF-GF-11. SQ1144.2 +088400 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1144.2 +088500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1144.2 +088600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +088700 READ-FAIL-GF-11. SQ1144.2 +088800 PERFORM FAIL. SQ1144.2 +088900 READ-WRITE-GF-11. SQ1144.2 +089000 MOVE "READ-TEST-GF-11" TO PAR-NAME. SQ1144.2 +089100 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1144.2 +089200 PERFORM PRINT-DETAIL. SQ1144.2 +089300 READ-CLOSE-GF-11. SQ1144.2 +089400 CLOSE SQ-FS3. SQ1144.2 +089500 OPEN-TEST-GF-03. SQ1144.2 +089600************************************************************** SQ1144.2 +089700* OPEN OUTPUT FILE-1, FILE-2. WILL BE TESTED IN THIS TEST.* SQ1144.2 +089800* VII; 4.3.2 (PAGE VII-39) * SQ1144.2 +089900************************************************************** SQ1144.2 +090000 SQ1144.2 +090100 MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +090200 MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +090300 OPEN INPUT SQ-FS1 SQ-FS2. SQ1144.2 +090400 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +090500 OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +090600 GO TO OPEN-FAIL-GF-02. SQ1144.2 +090700 OPEN-PASS-GF-03. SQ1144.2 +090800 PERFORM PASS SQ1144.2 +090900 GO TO OPEN-WRITE-GF-03. SQ1144.2 +091000 OPEN-FAIL-GF-03. SQ1144.2 +091100 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +091200 MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +091300 MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +091400 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK SQ1144.2 +091500 PERFORM FAIL SQ1144.2 +091600 PERFORM OPEN-WRITE-GF-03. SQ1144.2 +091700 IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +091800 MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +091900 MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +092000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK SQ1144.2 +092100 PERFORM FAIL. SQ1144.2 +092200 OPEN-WRITE-GF-03. SQ1144.2 +092300 MOVE "OPEN-TEST-GF-03" TO PAR-NAME. SQ1144.2 +092400 MOVE "OPEN INPUT FILE1, FILE2" TO FEATURE. SQ1144.2 +092500 PERFORM PRINT-DETAIL. SQ1144.2 +092600 SQ1144.2 +092700*CLOSE-TEST-GF-01. SQ1144.2 +092800******************************************************************SQ1144.2 +092900* CLOSE FILE-1, FILE-2 WITH LOCK. WILL BE TESTED IN THIS TEST. *SQ1144.2 +093000* VII; 4.2 (PAGE VII-35) *SQ1144.2 +093100******************************************************************SQ1144.2 +093200 SQ1144.2 +093300* MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +093400* MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +093500* CLOSE SQ-FS1 WITH LOCK, SQ-FS2 WITH LOCK. SQ1144.2 +093600* IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +093700* OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +093800* GO TO CLOSE-FAIL-GF-01. SQ1144.2 +093900*CLOSE-PASS-GF-01. SQ1144.2 +094000* PERFORM PASS SQ1144.2 +094100* GO TO CLOSE-WRITE-GF-01. SQ1144.2 +094200*CLOSE-FAIL-GF-01. SQ1144.2 +094300* IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +094400* MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +094500* MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +094600* MOVE "VII-35; 4.2.2 " TO RE-MARK SQ1144.2 +094700* PERFORM FAIL SQ1144.2 +094800* PERFORM CLOSE-WRITE-GF-01. SQ1144.2 +094900* IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +095000* MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +095100* MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +095200* MOVE "VII-35; 4.2.2 " TO RE-MARK SQ1144.2 +095300* PERFORM FAIL. SQ1144.2 +095400*CLOSE-WRITE-GF-01. SQ1144.2 +095500* MOVE "CLOSE-TEST-GF-01" TO PAR-NAME. SQ1144.2 +095600* MOVE "CLOSE FILE1, FILE2" TO FEATURE. SQ1144.2 +095700* PERFORM PRINT-DETAIL. SQ1144.2 +095800 TERMINATE-ROUTINE. SQ1144.2 +095900 EXIT. SQ1144.2 +096000 CCVS-EXIT SECTION. SQ1144.2 +096100 CCVS-999999. SQ1144.2 +096200 GO TO CLOSE-FILES. SQ1144.2 +*END-OF,SQ114A +*HEADER,COBOL,SQ115A +000100 IDENTIFICATION DIVISION. SQ1154.2 +000200 PROGRAM-ID. SQ1154.2 +000300 SQ115A. SQ1154.2 +000400**************************************************************** SQ1154.2 +000500* * SQ1154.2 +000600* VALIDATION FOR:- * SQ1154.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1154.2 +000800* * SQ1154.2 +000900* CREATION DATE / VALIDATION DATE * SQ1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1154.2 +001100* * SQ1154.2 +001200**************************************************************** SQ1154.2 +001300 SQ1154.2 +001400* THIS ROUTINE CREATES A MASS STORAGE FILE CONTAINING SQ1154.2 +001500* 550 RECORDS. EACH RECORD CONTAINS 126 CHARACTERS. THE SQ1154.2 +001600* FILE IS CLOSED AND OPENED AS AN INPUT-OUTPUT FILE. EVERY SQ1154.2 +001700* TENTH RECORD IS REWRITTEN. THE FILE IS CLOSED AND OPENED SQ1154.2 +001800* AGAIN AS AN INPUT FILE. FIELDS IN EACH RECORD ARE CHECKED SQ1154.2 +001900* TO ENSURE THAT THE RECORDS REWRITTEN ARE CORRECT AND THAT SQ1154.2 +002000* THE RECORDS WHICH WERE NOT UPDATED WERE NOT CHANGED. SQ1154.2 +002100* SQ1154.2 +002200* USED X-CARDS: SQ1154.2 +002300* XXXXX014 SQ1154.2 +002400* XXXXX055 SQ1154.2 +002500* P XXXXX062 SQ1154.2 +002600* XXXXX082 SQ1154.2 +002700* XXXXX083 SQ1154.2 +002800* C XXXXX084 SQ1154.2 +002900* SQ1154.2 +003000* SQ1154.2 +003100 ENVIRONMENT DIVISION. SQ1154.2 +003200 CONFIGURATION SECTION. SQ1154.2 +003300 SOURCE-COMPUTER. SQ1154.2 +003400 XXXXX082. SQ1154.2 +003500 OBJECT-COMPUTER. SQ1154.2 +003600 XXXXX083. SQ1154.2 +003700 INPUT-OUTPUT SECTION. SQ1154.2 +003800 FILE-CONTROL. SQ1154.2 +003900P SELECT RAW-DATA ASSIGN TO SQ1154.2 +004000P XXXXX062 SQ1154.2 +004100P ORGANIZATION IS INDEXED SQ1154.2 +004200P ACCESS MODE IS RANDOM SQ1154.2 +004300P RECORD KEY IS RAW-DATA-KEY. SQ1154.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1154.2 +004500 XXXXX055. SQ1154.2 +004600 SELECT SQ-FS5 ASSIGN SQ1154.2 +004700 XXXXX014 SQ1154.2 +004800 ORGANIZATION SEQUENTIAL SQ1154.2 +004900 ACCESS MODE SEQUENTIAL. SQ1154.2 +005000 DATA DIVISION. SQ1154.2 +005100 FILE SECTION. SQ1154.2 +005200P SQ1154.2 +005300PFD RAW-DATA. SQ1154.2 +005400P SQ1154.2 +005500P01 RAW-DATA-SATZ. SQ1154.2 +005600P 05 RAW-DATA-KEY PIC X(6). SQ1154.2 +005700P 05 C-DATE PIC 9(6). SQ1154.2 +005800P 05 C-TIME PIC 9(8). SQ1154.2 +005900P 05 C-NO-OF-TESTS PIC 99. SQ1154.2 +006000P 05 C-OK PIC 999. SQ1154.2 +006100P 05 C-ALL PIC 999. SQ1154.2 +006200P 05 C-FAIL PIC 999. SQ1154.2 +006300P 05 C-DELETED PIC 999. SQ1154.2 +006400P 05 C-INSPECT PIC 999. SQ1154.2 +006500P 05 C-NOTE PIC X(13). SQ1154.2 +006600P 05 C-INDENT PIC X. SQ1154.2 +006700P 05 C-ABORT PIC X(8). SQ1154.2 +006800 FD PRINT-FILE SQ1154.2 +006900C LABEL RECORDS SQ1154.2 +007000C XXXXX084 SQ1154.2 +007100C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1154.2 +007200 . SQ1154.2 +007300 01 PRINT-REC PICTURE X(120). SQ1154.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ1154.2 +007500 FD SQ-FS5 SQ1154.2 +007600C LABEL RECORD STANDARD SQ1154.2 +007700 . SQ1154.2 +007800 01 SQ-FS5R1-F-G-126. SQ1154.2 +007900 02 SQ-FS5-120 PICTURE X(120). SQ1154.2 +008000 02 SQ-FS5-UPDATE PICTURE X(6). SQ1154.2 +008100 WORKING-STORAGE SECTION. SQ1154.2 +008200 01 COUNT-OF-RECORDS PIC S9(5) COMPUTATIONAL. SQ1154.2 +008300 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1154.2 +008400 01 ERROR-FLAG PIC 9. SQ1154.2 +008500 01 EOF-FLAG PIC 9. SQ1154.2 +008600 01 LOOP-COUNT PIC 99. SQ1154.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1154.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1154.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1154.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1154.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1154.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1154.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1154.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1154.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1154.2 +009600 ",RECKEY= ". SQ1154.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1154.2 +009800 ",ALTKEY1= ". SQ1154.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1154.2 +010000 ",ALTKEY2= ". SQ1154.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1154.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1154.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1154.2 +010400 07 FILLER PIC X(5). SQ1154.2 +010500 07 XFILE-NAME PIC X(6). SQ1154.2 +010600 07 FILLER PIC X(8). SQ1154.2 +010700 07 XRECORD-NAME PIC X(6). SQ1154.2 +010800 07 FILLER PIC X(1). SQ1154.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1154.2 +011000 07 FILLER PIC X(7). SQ1154.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1154.2 +011200 07 FILLER PIC X(6). SQ1154.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1154.2 +011400 07 FILLER PIC X(5). SQ1154.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1154.2 +011600 07 FILLER PIC X(5). SQ1154.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1154.2 +011800 07 FILLER PIC X(7). SQ1154.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1154.2 +012000 07 FILLER PIC X(7). SQ1154.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1154.2 +012200 07 FILLER PIC X(1). SQ1154.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1154.2 +012400 07 FILLER PIC X(6). SQ1154.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1154.2 +012600 07 FILLER PIC X(5). SQ1154.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1154.2 +012800 07 FILLER PIC X(6). SQ1154.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1154.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1154.2 +013100 07 FILLER PIC X(8). SQ1154.2 +013200 07 XRECORD-KEY PIC X(29). SQ1154.2 +013300 07 FILLER PIC X(9). SQ1154.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1154.2 +013500 07 FILLER PIC X(9). SQ1154.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1154.2 +013700 07 FILLER PIC X(7). SQ1154.2 +013800 01 TEST-RESULTS. SQ1154.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1154.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1154.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014400 02 PAR-NAME. SQ1154.2 +014500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1154.2 +014600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1154.2 +014700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1154.2 +014800 03 FILLER PIC X(5) VALUE SPACE. SQ1154.2 +014900 02 FILLER PIC X(10) VALUE SPACE. SQ1154.2 +015000 02 RE-MARK PIC X(61). SQ1154.2 +015100 01 TEST-COMPUTED. SQ1154.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1154.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1154.2 +015400 02 COMPUTED-X. SQ1154.2 +015500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1154.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1154.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1154.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1154.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1154.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1154.2 +016100 04 COMPUTED-18V0 PICTURE -9(18). SQ1154.2 +016200 04 FILLER PICTURE X. SQ1154.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1154.2 +016400 01 TEST-CORRECT. SQ1154.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1154.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1154.2 +016700 02 CORRECT-X. SQ1154.2 +016800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1154.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1154.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1154.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1154.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1154.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1154.2 +017400 04 CORRECT-18V0 PICTURE -9(18). SQ1154.2 +017500 04 FILLER PICTURE X. SQ1154.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1154.2 +017700 01 CCVS-C-1. SQ1154.2 +017800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1154.2 +017900- "SS PARAGRAPH-NAME SQ1154.2 +018000- " REMARKS". SQ1154.2 +018100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1154.2 +018200 01 CCVS-C-2. SQ1154.2 +018300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +018400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1154.2 +018500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1154.2 +018600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1154.2 +018700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1154.2 +018800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1154.2 +018900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1154.2 +019000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1154.2 +019100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1154.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1154.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1154.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1154.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1154.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1154.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1154.2 +019800 01 CCVS-H-1. SQ1154.2 +019900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1154.2 +020000 02 FILLER PICTURE X(67) VALUE SQ1154.2 +020100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1154.2 +020200- " SYSTEM". SQ1154.2 +020300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1154.2 +020400 01 CCVS-H-2. SQ1154.2 +020500 02 FILLER PICTURE X(52) VALUE IS SQ1154.2 +020600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1154.2 +020700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1154.2 +020800 02 TEST-ID PICTURE IS X(9). SQ1154.2 +020900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1154.2 +021000 01 CCVS-H-3. SQ1154.2 +021100 02 FILLER PICTURE X(34) VALUE SQ1154.2 +021200 " FOR OFFICIAL USE ONLY ". SQ1154.2 +021300 02 FILLER PICTURE X(58) VALUE SQ1154.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1154.2 +021500 02 FILLER PICTURE X(28) VALUE SQ1154.2 +021600 " COPYRIGHT 1985 ". SQ1154.2 +021700 01 CCVS-E-1. SQ1154.2 +021800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1154.2 +021900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1154.2 +022000 02 ID-AGAIN PICTURE IS X(9). SQ1154.2 +022100 02 FILLER PICTURE X(45) VALUE IS SQ1154.2 +022200 " NTIS DISTRIBUTION COBOL 85". SQ1154.2 +022300 01 CCVS-E-2. SQ1154.2 +022400 02 FILLER PICTURE X(31) VALUE SQ1154.2 +022500 SPACE. SQ1154.2 +022600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1154.2 +022700 02 CCVS-E-2-2. SQ1154.2 +022800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1154.2 +022900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +023000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1154.2 +023100 01 CCVS-E-3. SQ1154.2 +023200 02 FILLER PICTURE X(22) VALUE SQ1154.2 +023300 " FOR OFFICIAL USE ONLY". SQ1154.2 +023400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1154.2 +023500 02 FILLER PICTURE X(58) VALUE SQ1154.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1154.2 +023700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1154.2 +023800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1154.2 +023900 01 CCVS-E-4. SQ1154.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1154.2 +024100 02 FILLER PIC XXXX VALUE " OF ". SQ1154.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1154.2 +024300 02 FILLER PIC X(40) VALUE SQ1154.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1154.2 +024500 01 XXINFO. SQ1154.2 +024600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1154.2 +024700 02 INFO-TEXT. SQ1154.2 +024800 04 FILLER PIC X(20) VALUE SPACE. SQ1154.2 +024900 04 XXCOMPUTED PIC X(20). SQ1154.2 +025000 04 FILLER PIC X(5) VALUE SPACE. SQ1154.2 +025100 04 XXCORRECT PIC X(20). SQ1154.2 +025200 01 HYPHEN-LINE. SQ1154.2 +025300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +025400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1154.2 +025500- "*****************************************". SQ1154.2 +025600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1154.2 +025700- "******************************". SQ1154.2 +025800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1154.2 +025900 "SQ115A". SQ1154.2 +026000 PROCEDURE DIVISION. SQ1154.2 +026100 CCVS1 SECTION. SQ1154.2 +026200 OPEN-FILES. SQ1154.2 +026300P OPEN I-O RAW-DATA. SQ1154.2 +026400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1154.2 +026500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1154.2 +026600P MOVE "ABORTED " TO C-ABORT. SQ1154.2 +026700P ADD 1 TO C-NO-OF-TESTS. SQ1154.2 +026800P ACCEPT C-DATE FROM DATE. SQ1154.2 +026900P ACCEPT C-TIME FROM TIME. SQ1154.2 +027000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1154.2 +027100PEND-E-1. SQ1154.2 +027200P CLOSE RAW-DATA. SQ1154.2 +027300 OPEN OUTPUT PRINT-FILE. SQ1154.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1154.2 +027500 MOVE SPACE TO TEST-RESULTS. SQ1154.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1154.2 +027700 MOVE ZERO TO REC-SKL-SUB. SQ1154.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1154.2 +027900 CCVS-INIT-FILE. SQ1154.2 +028000 ADD 1 TO REC-SKL-SUB. SQ1154.2 +028100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1154.2 +028200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1154.2 +028300 CCVS-INIT-EXIT. SQ1154.2 +028400 GO TO CCVS1-EXIT. SQ1154.2 +028500 CLOSE-FILES. SQ1154.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1154.2 +028700P OPEN I-O RAW-DATA. SQ1154.2 +028800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1154.2 +028900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1154.2 +029000P MOVE "OK. " TO C-ABORT. SQ1154.2 +029100P MOVE PASS-COUNTER TO C-OK. SQ1154.2 +029200P MOVE ERROR-HOLD TO C-ALL. SQ1154.2 +029300P MOVE ERROR-COUNTER TO C-FAIL. SQ1154.2 +029400P MOVE DELETE-CNT TO C-DELETED. SQ1154.2 +029500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1154.2 +029600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1154.2 +029700PEND-E-2. SQ1154.2 +029800P CLOSE RAW-DATA. SQ1154.2 +029900 TERMINATE-CCVS. SQ1154.2 +030000S EXIT PROGRAM. SQ1154.2 +030100STERMINATE-CALL. SQ1154.2 +030200 STOP RUN. SQ1154.2 +030300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1154.2 +030400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1154.2 +030500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1154.2 +030600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1154.2 +030700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1154.2 +030800 PRINT-DETAIL. SQ1154.2 +030900 IF REC-CT NOT EQUAL TO ZERO SQ1154.2 +031000 MOVE "." TO PARDOT-X SQ1154.2 +031100 MOVE REC-CT TO DOTVALUE. SQ1154.2 +031200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1154.2 +031300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1154.2 +031400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1154.2 +031500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1154.2 +031600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1154.2 +031700 MOVE SPACE TO CORRECT-X. SQ1154.2 +031800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1154.2 +031900 MOVE SPACE TO RE-MARK. SQ1154.2 +032000 HEAD-ROUTINE. SQ1154.2 +032100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +032200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1154.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1154.2 +032400 COLUMN-NAMES-ROUTINE. SQ1154.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +032800 END-ROUTINE. SQ1154.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1154.2 +033000 END-RTN-EXIT. SQ1154.2 +033100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +033200 END-ROUTINE-1. SQ1154.2 +033300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1154.2 +033400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1154.2 +033500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1154.2 +033600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1154.2 +033700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1154.2 +033800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1154.2 +033900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1154.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1154.2 +034100 END-ROUTINE-12. SQ1154.2 +034200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1154.2 +034300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1154.2 +034400 MOVE "NO " TO ERROR-TOTAL SQ1154.2 +034500 ELSE SQ1154.2 +034600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1154.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1154.2 +034800 PERFORM WRITE-LINE. SQ1154.2 +034900 END-ROUTINE-13. SQ1154.2 +035000 IF DELETE-CNT IS EQUAL TO ZERO SQ1154.2 +035100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1154.2 +035200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1154.2 +035300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1154.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +035500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1154.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1154.2 +035700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1154.2 +035800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1154.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +036000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +036100 WRITE-LINE. SQ1154.2 +036200 ADD 1 TO RECORD-COUNT. SQ1154.2 +036300Y IF RECORD-COUNT GREATER 50 SQ1154.2 +036400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1154.2 +036500Y MOVE SPACE TO DUMMY-RECORD SQ1154.2 +036600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1154.2 +036700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1154.2 +036800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1154.2 +036900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1154.2 +037000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1154.2 +037100Y MOVE ZERO TO RECORD-COUNT. SQ1154.2 +037200 PERFORM WRT-LN. SQ1154.2 +037300 WRT-LN. SQ1154.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1154.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1154.2 +037600 BLANK-LINE-PRINT. SQ1154.2 +037700 PERFORM WRT-LN. SQ1154.2 +037800 FAIL-ROUTINE. SQ1154.2 +037900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1154.2 +038000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1154.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1154.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +038300 GO TO FAIL-ROUTINE-EX. SQ1154.2 +038400 FAIL-ROUTINE-WRITE. SQ1154.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1154.2 +038600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +038700 FAIL-ROUTINE-EX. EXIT. SQ1154.2 +038800 BAIL-OUT. SQ1154.2 +038900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1154.2 +039000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1154.2 +039100 BAIL-OUT-WRITE. SQ1154.2 +039200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1154.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +039400 BAIL-OUT-EX. EXIT. SQ1154.2 +039500 CCVS1-EXIT. SQ1154.2 +039600 EXIT. SQ1154.2 +039700 SECT-SQ-115-0001 SECTION. SQ1154.2 +039800 SEQ-INIT-013. SQ1154.2 +039900 MOVE "SQ-FS5" TO XFILE-NAME (1). SQ1154.2 +040000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1154.2 +040100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1154.2 +040200 MOVE 000126 TO XRECORD-LENGTH (1). SQ1154.2 +040300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1154.2 +040400 MOVE 0001 TO XBLOCK-SIZE (1). SQ1154.2 +040500 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1154.2 +040600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1154.2 +040700 MOVE "S" TO XLABEL-TYPE (1). SQ1154.2 +040800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1154.2 +040900 OPEN OUTPUT SQ-FS5. SQ1154.2 +041000 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +041100 SEQ-TEST-013. SQ1154.2 +041200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1154.2 +041300 MOVE "FIRST " TO SQ-FS5-UPDATE. SQ1154.2 +041400 WRITE SQ-FS5R1-F-G-126. SQ1154.2 +041500 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +041600 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1154.2 +041700 GO TO SEQ-WRITE-013. SQ1154.2 +041800 ADD 1 TO XRECORD-NUMBER (1). SQ1154.2 +041900 GO TO SEQ-TEST-013. SQ1154.2 +042000 SEQ-WRITE-013. SQ1154.2 +042100 MOVE "CREATE SQ-FS5 550R" TO FEATURE. SQ1154.2 +042200 MOVE "SEQ-TEST-013" TO PAR-NAME. SQ1154.2 +042300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1154.2 +042400 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +042500 PERFORM PRINT-DETAIL. SQ1154.2 +042600 CLOSE SQ-FS5. SQ1154.2 +042700* A SEQUENTIAL MASS STORAGE FILE WITH 126 CHARACTER SQ1154.2 +042800* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1154.2 +042900 SEQ-INIT-014. SQ1154.2 +043000 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +043100* THIS TEST READS AND CHECKS THE FILE CREATED SQ1154.2 +043200* IN SEQ-TEST-013. SQ1154.2 +043300 OPEN INPUT SQ-FS5. SQ1154.2 +043400 SEQ-TEST-014. SQ1154.2 +043500 READ SQ-FS5 AT END SQ1154.2 +043600 GO TO SEQ-TEST-014-1. SQ1154.2 +043700 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +043800 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +043900 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1154.2 +044000 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1154.2 +044100 GO TO SEQ-FAIL-014. SQ1154.2 +044200 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) SQ1154.2 +044300 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +044400 GO TO SEQ-TEST-014. SQ1154.2 +044500 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1154.2 +044600 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +044700 GO TO SEQ-TEST-014. SQ1154.2 +044800 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1154.2 +044900 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +045000 GO TO SEQ-TEST-014. SQ1154.2 +045100 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1154.2 +045200 GO TO SEQ-TEST-014. SQ1154.2 +045300 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +045400 GO TO SEQ-TEST-014. SQ1154.2 +045500 SEQ-TEST-014-1. SQ1154.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1154.2 +045700 GO TO SEQ-PASS-014. SQ1154.2 +045800 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK. SQ1154.2 +045900 SEQ-FAIL-014. SQ1154.2 +046000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1154.2 +046100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1154.2 +046200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +046300 PERFORM FAIL. SQ1154.2 +046400 GO TO SEQ-WRITE-014. SQ1154.2 +046500 SEQ-PASS-014. SQ1154.2 +046600 PERFORM PASS. SQ1154.2 +046700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1154.2 +046800 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +046900 SEQ-WRITE-014. SQ1154.2 +047000 MOVE "SEQ-TEST-014" TO PAR-NAME. SQ1154.2 +047100 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1154.2 +047200 PERFORM PRINT-DETAIL. SQ1154.2 +047300 SEQ-CLOSE-014. SQ1154.2 +047400 CLOSE SQ-FS5. SQ1154.2 +047500 REWRITE-INIT-GF-01. SQ1154.2 +047600 OPEN I-O SQ-FS5. SQ1154.2 +047700 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +047800 MOVE ZERO TO EOF-FLAG. SQ1154.2 +047900* THIS TEST REWRITES EVERY TENTH RECORD SQ1154.2 +048000* OF THE FILE SQ-FS5. SQ1154.2 +048100 REWRITE-TEST-GF-01. SQ1154.2 +048200 PERFORM READ-SQ-FS5 THRU READ-SQ-FS5-EXIT 10 TIMES. SQ1154.2 +048300 IF EOF-FLAG EQUAL TO 1 SQ1154.2 +048400 GO TO REWRITE-TEST-GF-01-1. SQ1154.2 +048500 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +048600 ADD 1 TO UPDATE-NUMBER (1). SQ1154.2 +048700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1154.2 +048800 MOVE "SECOND" TO SQ-FS5-UPDATE. SQ1154.2 +048900 REWRITE SQ-FS5R1-F-G-126. SQ1154.2 +049000 GO TO REWRITE-TEST-GF-01. SQ1154.2 +049100 READ-SQ-FS5. SQ1154.2 +049200 IF EOF-FLAG EQUAL TO 1 SQ1154.2 +049300 GO TO READ-SQ-FS5-EXIT. SQ1154.2 +049400 READ SQ-FS5 RECORD SQ1154.2 +049500 AT END MOVE 1 TO EOF-FLAG SQ1154.2 +049600 GO TO READ-SQ-FS5-EXIT. SQ1154.2 +049700 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +049800 READ-SQ-FS5-EXIT. SQ1154.2 +049900 EXIT. SQ1154.2 +050000 REWRITE-TEST-GF-01-1. SQ1154.2 +050100 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1154.2 +050200 GO TO REWRITE-PASS-GF-01. SQ1154.2 +050300 REWRITE-FAIL-GF-01. SQ1154.2 +050400 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +050500 PERFORM FAIL. SQ1154.2 +050600 MOVE "550 RECORDS SHOULD BE READ" TO RE-MARK. SQ1154.2 +050700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1154.2 +050800 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +050900 GO TO REWRITE-WRITE-GF-01. SQ1154.2 +051000 REWRITE-PASS-GF-01. SQ1154.2 +051100 PERFORM PASS. SQ1154.2 +051200 REWRITE-WRITE-GF-01. SQ1154.2 +051300 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1154.2 +051400 MOVE "REWRITE FILE SQ-FS5" TO FEATURE. SQ1154.2 +051500 PERFORM PRINT-DETAIL. SQ1154.2 +051600 REWRITE-CLOSE-GF-01. SQ1154.2 +051700 CLOSE SQ-FS5. SQ1154.2 +051800 REWRITE-INIT-GF-02. SQ1154.2 +051900 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +052000 MOVE ZERO TO EOF-FLAG. SQ1154.2 +052100 OPEN INPUT SQ-FS5. SQ1154.2 +052200* THIS TEST READS AND CHECKS THE FILE WHICH WAS SQ1154.2 +052300* REWRITTEN IN REWRITE-TEST-01. SQ1154.2 +052400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1154.2 +052500 MOVE ZERO TO LOOP-COUNT. SQ1154.2 +052600 REWRITE-TEST-GF-02. SQ1154.2 +052700 READ SQ-FS5 END SQ1154.2 +052800 MOVE 1 TO EOF-FLAG SQ1154.2 +052900 GO TO REWRITE-TEST-GF-02-2. SQ1154.2 +053000 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +053100 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1154.2 +053200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1154.2 +053300 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +053400 ADD 1 TO LOOP-COUNT. SQ1154.2 +053500 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +053600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1154.2 +053700 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +053800 GO TO REWRITE-TEST-GF-02. SQ1154.2 +053900 IF LOOP-COUNT EQUAL TO 10 SQ1154.2 +054000 MOVE ZERO TO LOOP-COUNT SQ1154.2 +054100 GO TO REWRITE-TEST-GF-02-1. SQ1154.2 +054200 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1154.2 +054300 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +054400 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054500 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1154.2 +054600 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054700 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +054800 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054900 REWRITE-TEST-GF-02-1. SQ1154.2 +055000 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1154.2 +055100 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +055200 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055300 IF SQ-FS5-UPDATE EQUAL TO "SECOND" SQ1154.2 +055400 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055500 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +055600 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055700 REWRITE-TEST-GF-02-2. SQ1154.2 +055800 IF COUNT-OF-RECORDS NOT EQUAL TO 550 SQ1154.2 +055900 MOVE "LESS THAN 550 RECORDS" TO RE-MARK SQ1154.2 +056000 MOVE "RECORDS READ =" TO COMPUTED-A SQ1154.2 +056100 MOVE COUNT-OF-RECORDS TO CORRECT-18V0 SQ1154.2 +056200 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +056300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1154.2 +056400 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK SQ1154.2 +056500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1154.2 +056600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1154.2 +056700 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +056800 REWRITE-PASS-GF-02. SQ1154.2 +056900 PERFORM PASS. SQ1154.2 +057000 GO TO REWRITE-WRITE-GF-02. SQ1154.2 +057100 REWRITE-FAIL-GF-02. SQ1154.2 +057200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +057300 PERFORM FAIL. SQ1154.2 +057400 REWRITE-WRITE-GF-02. SQ1154.2 +057500 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1154.2 +057600 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1154.2 +057700 PERFORM PRINT-DETAIL. SQ1154.2 +057800 REWRITE-CLOSE-GF-02. SQ1154.2 +057900 CLOSE SQ-FS5. SQ1154.2 +058000 TERMINATE-ROUTINE. SQ1154.2 +058100 EXIT. SQ1154.2 +058200 CCVS-EXIT SECTION. SQ1154.2 +058300 CCVS-999999. SQ1154.2 +058400 GO TO CLOSE-FILES. SQ1154.2 +*END-OF,SQ115A +*HEADER,COBOL,SQ116A +000100 IDENTIFICATION DIVISION. SQ1164.2 +000200 PROGRAM-ID. SQ1164.2 +000300 SQ116A. SQ1164.2 +000400**************************************************************** SQ1164.2 +000500* * SQ1164.2 +000600* VALIDATION FOR:- * SQ1164.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1164.2 +000800* * SQ1164.2 +000900* CREATION DATE / VALIDATION DATE * SQ1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1164.2 +001100* * SQ1164.2 +001200**************************************************************** SQ1164.2 +001300 SQ1164.2 +001400* THIS PROGRAM CREATES A SEQUENTIAL MASS STORAGE FILE SQ1164.2 +001500* OF 550 RECORDS. THE FILE IS THEN OPENED IN THE I-O MODE AND SQ1164.2 +001600* RECORDS ARE UPDATED USING REWRITE...FROM STATEMENTS. THE SQ1164.2 +001700* FILE IS THEN READ AGAIN CHECKING EACH RECORD TO ENSURE SQ1164.2 +001800* THE REWRITES WERE EXECUTED CORRECTLY. SQ1164.2 +001900* SQ1164.2 +002000* USED X-CARDS: SQ1164.2 +002100* XXXXX014 SQ1164.2 +002200* XXXXX055 SQ1164.2 +002300* P XXXXX062 SQ1164.2 +002400* XXXXX082 SQ1164.2 +002500* XXXXX083 SQ1164.2 +002600* C XXXXX084 SQ1164.2 +002700* SQ1164.2 +002800* SQ1164.2 +002900 ENVIRONMENT DIVISION. SQ1164.2 +003000 CONFIGURATION SECTION. SQ1164.2 +003100 SOURCE-COMPUTER. SQ1164.2 +003200 XXXXX082. SQ1164.2 +003300 OBJECT-COMPUTER. SQ1164.2 +003400 XXXXX083. SQ1164.2 +003500 INPUT-OUTPUT SECTION. SQ1164.2 +003600 FILE-CONTROL. SQ1164.2 +003700P SELECT RAW-DATA ASSIGN TO SQ1164.2 +003800P XXXXX062 SQ1164.2 +003900P ORGANIZATION IS INDEXED SQ1164.2 +004000P ACCESS MODE IS RANDOM SQ1164.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ1164.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1164.2 +004300 XXXXX055. SQ1164.2 +004400 SELECT SQ-FS6 ASSIGN SQ1164.2 +004500 XXXXX014 SQ1164.2 +004600 ORGANIZATION SEQUENTIAL SQ1164.2 +004700 ACCESS MODE SEQUENTIAL. SQ1164.2 +004800 DATA DIVISION. SQ1164.2 +004900 FILE SECTION. SQ1164.2 +005000P SQ1164.2 +005100PFD RAW-DATA. SQ1164.2 +005200P SQ1164.2 +005300P01 RAW-DATA-SATZ. SQ1164.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ1164.2 +005500P 05 C-DATE PIC 9(6). SQ1164.2 +005600P 05 C-TIME PIC 9(8). SQ1164.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ1164.2 +005800P 05 C-OK PIC 999. SQ1164.2 +005900P 05 C-ALL PIC 999. SQ1164.2 +006000P 05 C-FAIL PIC 999. SQ1164.2 +006100P 05 C-DELETED PIC 999. SQ1164.2 +006200P 05 C-INSPECT PIC 999. SQ1164.2 +006300P 05 C-NOTE PIC X(13). SQ1164.2 +006400P 05 C-INDENT PIC X. SQ1164.2 +006500P 05 C-ABORT PIC X(8). SQ1164.2 +006600 FD PRINT-FILE SQ1164.2 +006700C LABEL RECORDS SQ1164.2 +006800C XXXXX084 SQ1164.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1164.2 +007000 . SQ1164.2 +007100 01 PRINT-REC PICTURE X(120). SQ1164.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1164.2 +007300 FD SQ-FS6 SQ1164.2 +007400C LABEL RECORD STANDARD SQ1164.2 +007500 . SQ1164.2 +007600 01 SQ-FS6R1-F-G-130. SQ1164.2 +007700 02 SQ-FS6R1-PART1 PICTURE X(120). SQ1164.2 +007800 02 SQ-FS6R1-PART2 PICTURE X(10). SQ1164.2 +007900 WORKING-STORAGE SECTION. SQ1164.2 +008000 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ1164.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1164.2 +008200 01 ERROR-FLAG PIC 9. SQ1164.2 +008300 01 EOF-FLAG PIC 9. SQ1164.2 +008400 01 END-OF-RECORD-AREA. SQ1164.2 +008500 02 UPDATE-AREA-ONLY PIC X(6). SQ1164.2 +008600 02 NUMBER-AREA PIC 9999. SQ1164.2 +008700 01 REWRT-FROM-AREA1. SQ1164.2 +008800 02 AREA1-1 PICTURE X(120). SQ1164.2 +008900 02 AREA1-2. SQ1164.2 +009000 03 AREA1-21 PIC X(6). SQ1164.2 +009100 03 AREA1-22 PIC 9999. SQ1164.2 +009200 01 REWRT-FROM-AREA2. SQ1164.2 +009300 02 AREA2-1. SQ1164.2 +009400 03 AREA2-11 PIC X(120). SQ1164.2 +009500 03 AREA2-12 PIC X(6). SQ1164.2 +009600 03 AREA2-13 PIC 9999. SQ1164.2 +009700 02 AREA2-2 PIC X(9). SQ1164.2 +009800 01 RWRT-FROM-AREA3. SQ1164.2 +009900 02 AREA3-1 PICTURE X(87). SQ1164.2 +010000 01 FOLLOWS-AREA3 PICTURE X(9). SQ1164.2 +010100 01 FILE-RECORD-INFORMATION-REC. SQ1164.2 +010200 03 FILE-RECORD-INFO-SKELETON. SQ1164.2 +010300 05 FILLER PICTURE X(48) VALUE SQ1164.2 +010400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1164.2 +010500 05 FILLER PICTURE X(46) VALUE SQ1164.2 +010600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1164.2 +010700 05 FILLER PICTURE X(26) VALUE SQ1164.2 +010800 ",LFIL=000000,ORG= ,LBLR= ". SQ1164.2 +010900 05 FILLER PICTURE X(37) VALUE SQ1164.2 +011000 ",RECKEY= ". SQ1164.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1164.2 +011200 ",ALTKEY1= ". SQ1164.2 +011300 05 FILLER PICTURE X(38) VALUE SQ1164.2 +011400 ",ALTKEY2= ". SQ1164.2 +011500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1164.2 +011600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1164.2 +011700 05 FILE-RECORD-INFO-P1-120. SQ1164.2 +011800 07 FILLER PIC X(5). SQ1164.2 +011900 07 XFILE-NAME PIC X(6). SQ1164.2 +012000 07 FILLER PIC X(8). SQ1164.2 +012100 07 XRECORD-NAME PIC X(6). SQ1164.2 +012200 07 FILLER PIC X(1). SQ1164.2 +012300 07 REELUNIT-NUMBER PIC 9(1). SQ1164.2 +012400 07 FILLER PIC X(7). SQ1164.2 +012500 07 XRECORD-NUMBER PIC 9(6). SQ1164.2 +012600 07 FILLER PIC X(6). SQ1164.2 +012700 07 UPDATE-NUMBER PIC 9(2). SQ1164.2 +012800 07 FILLER PIC X(5). SQ1164.2 +012900 07 ODO-NUMBER PIC 9(4). SQ1164.2 +013000 07 FILLER PIC X(5). SQ1164.2 +013100 07 XPROGRAM-NAME PIC X(5). SQ1164.2 +013200 07 FILLER PIC X(7). SQ1164.2 +013300 07 XRECORD-LENGTH PIC 9(6). SQ1164.2 +013400 07 FILLER PIC X(7). SQ1164.2 +013500 07 CHARS-OR-RECORDS PIC X(2). SQ1164.2 +013600 07 FILLER PIC X(1). SQ1164.2 +013700 07 XBLOCK-SIZE PIC 9(4). SQ1164.2 +013800 07 FILLER PIC X(6). SQ1164.2 +013900 07 RECORDS-IN-FILE PIC 9(6). SQ1164.2 +014000 07 FILLER PIC X(5). SQ1164.2 +014100 07 XFILE-ORGANIZATION PIC X(2). SQ1164.2 +014200 07 FILLER PIC X(6). SQ1164.2 +014300 07 XLABEL-TYPE PIC X(1). SQ1164.2 +014400 05 FILE-RECORD-INFO-P121-240. SQ1164.2 +014500 07 FILLER PIC X(8). SQ1164.2 +014600 07 XRECORD-KEY PIC X(29). SQ1164.2 +014700 07 FILLER PIC X(9). SQ1164.2 +014800 07 ALTERNATE-KEY1 PIC X(29). SQ1164.2 +014900 07 FILLER PIC X(9). SQ1164.2 +015000 07 ALTERNATE-KEY2 PIC X(29). SQ1164.2 +015100 07 FILLER PIC X(7). SQ1164.2 +015200 01 TEST-RESULTS. SQ1164.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015400 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1164.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015600 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1164.2 +015700 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015800 02 PAR-NAME. SQ1164.2 +015900 03 FILLER PICTURE X(12) VALUE SPACE. SQ1164.2 +016000 03 PARDOT-X PICTURE X VALUE SPACE. SQ1164.2 +016100 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1164.2 +016200 03 FILLER PIC X(5) VALUE SPACE. SQ1164.2 +016300 02 FILLER PIC X(10) VALUE SPACE. SQ1164.2 +016400 02 RE-MARK PIC X(61). SQ1164.2 +016500 01 TEST-COMPUTED. SQ1164.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ1164.2 +016700 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1164.2 +016800 02 COMPUTED-X. SQ1164.2 +016900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1164.2 +017000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1164.2 +017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1164.2 +017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1164.2 +017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1164.2 +017400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1164.2 +017500 04 COMPUTED-18V0 PICTURE -9(18). SQ1164.2 +017600 04 FILLER PICTURE X. SQ1164.2 +017700 03 FILLER PIC X(50) VALUE SPACE. SQ1164.2 +017800 01 TEST-CORRECT. SQ1164.2 +017900 02 FILLER PIC X(30) VALUE SPACE. SQ1164.2 +018000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1164.2 +018100 02 CORRECT-X. SQ1164.2 +018200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1164.2 +018300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1164.2 +018400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1164.2 +018500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1164.2 +018600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1164.2 +018700 03 CR-18V0 REDEFINES CORRECT-A. SQ1164.2 +018800 04 CORRECT-18V0 PICTURE -9(18). SQ1164.2 +018900 04 FILLER PICTURE X. SQ1164.2 +019000 03 FILLER PIC X(50) VALUE SPACE. SQ1164.2 +019100 01 CCVS-C-1. SQ1164.2 +019200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1164.2 +019300- "SS PARAGRAPH-NAME SQ1164.2 +019400- " REMARKS". SQ1164.2 +019500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1164.2 +019600 01 CCVS-C-2. SQ1164.2 +019700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +019800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1164.2 +019900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1164.2 +020000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1164.2 +020100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1164.2 +020200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1164.2 +020300 01 REC-CT PICTURE 99 VALUE ZERO. SQ1164.2 +020400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1164.2 +020500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1164.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1164.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1164.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1164.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1164.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1164.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1164.2 +021200 01 CCVS-H-1. SQ1164.2 +021300 02 FILLER PICTURE X(27) VALUE SPACE. SQ1164.2 +021400 02 FILLER PICTURE X(67) VALUE SQ1164.2 +021500 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1164.2 +021600- " SYSTEM". SQ1164.2 +021700 02 FILLER PICTURE X(26) VALUE SPACE. SQ1164.2 +021800 01 CCVS-H-2. SQ1164.2 +021900 02 FILLER PICTURE X(52) VALUE IS SQ1164.2 +022000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1164.2 +022100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1164.2 +022200 02 TEST-ID PICTURE IS X(9). SQ1164.2 +022300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1164.2 +022400 01 CCVS-H-3. SQ1164.2 +022500 02 FILLER PICTURE X(34) VALUE SQ1164.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1164.2 +022700 02 FILLER PICTURE X(58) VALUE SQ1164.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1164.2 +022900 02 FILLER PICTURE X(28) VALUE SQ1164.2 +023000 " COPYRIGHT 1985 ". SQ1164.2 +023100 01 CCVS-E-1. SQ1164.2 +023200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1164.2 +023300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1164.2 +023400 02 ID-AGAIN PICTURE IS X(9). SQ1164.2 +023500 02 FILLER PICTURE X(45) VALUE IS SQ1164.2 +023600 " NTIS DISTRIBUTION COBOL 85". SQ1164.2 +023700 01 CCVS-E-2. SQ1164.2 +023800 02 FILLER PICTURE X(31) VALUE SQ1164.2 +023900 SPACE. SQ1164.2 +024000 02 FILLER PICTURE X(21) VALUE SPACE. SQ1164.2 +024100 02 CCVS-E-2-2. SQ1164.2 +024200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1164.2 +024300 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +024400 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1164.2 +024500 01 CCVS-E-3. SQ1164.2 +024600 02 FILLER PICTURE X(22) VALUE SQ1164.2 +024700 " FOR OFFICIAL USE ONLY". SQ1164.2 +024800 02 FILLER PICTURE X(12) VALUE SPACE. SQ1164.2 +024900 02 FILLER PICTURE X(58) VALUE SQ1164.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1164.2 +025100 02 FILLER PICTURE X(13) VALUE SPACE. SQ1164.2 +025200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1164.2 +025300 01 CCVS-E-4. SQ1164.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1164.2 +025500 02 FILLER PIC XXXX VALUE " OF ". SQ1164.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1164.2 +025700 02 FILLER PIC X(40) VALUE SQ1164.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1164.2 +025900 01 XXINFO. SQ1164.2 +026000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1164.2 +026100 02 INFO-TEXT. SQ1164.2 +026200 04 FILLER PIC X(20) VALUE SPACE. SQ1164.2 +026300 04 XXCOMPUTED PIC X(20). SQ1164.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1164.2 +026500 04 XXCORRECT PIC X(20). SQ1164.2 +026600 01 HYPHEN-LINE. SQ1164.2 +026700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +026800 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1164.2 +026900- "*****************************************". SQ1164.2 +027000 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1164.2 +027100- "******************************". SQ1164.2 +027200 01 CCVS-PGM-ID PIC X(6) VALUE SQ1164.2 +027300 "SQ116A". SQ1164.2 +027400 PROCEDURE DIVISION. SQ1164.2 +027500 CCVS1 SECTION. SQ1164.2 +027600 OPEN-FILES. SQ1164.2 +027700P OPEN I-O RAW-DATA. SQ1164.2 +027800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1164.2 +027900P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1164.2 +028000P MOVE "ABORTED " TO C-ABORT. SQ1164.2 +028100P ADD 1 TO C-NO-OF-TESTS. SQ1164.2 +028200P ACCEPT C-DATE FROM DATE. SQ1164.2 +028300P ACCEPT C-TIME FROM TIME. SQ1164.2 +028400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1164.2 +028500PEND-E-1. SQ1164.2 +028600P CLOSE RAW-DATA. SQ1164.2 +028700 OPEN OUTPUT PRINT-FILE. SQ1164.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1164.2 +028900 MOVE SPACE TO TEST-RESULTS. SQ1164.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1164.2 +029100 MOVE ZERO TO REC-SKL-SUB. SQ1164.2 +029200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1164.2 +029300 CCVS-INIT-FILE. SQ1164.2 +029400 ADD 1 TO REC-SKL-SUB. SQ1164.2 +029500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1164.2 +029600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1164.2 +029700 CCVS-INIT-EXIT. SQ1164.2 +029800 GO TO CCVS1-EXIT. SQ1164.2 +029900 CLOSE-FILES. SQ1164.2 +030000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1164.2 +030100P OPEN I-O RAW-DATA. SQ1164.2 +030200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1164.2 +030300P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1164.2 +030400P MOVE "OK. " TO C-ABORT. SQ1164.2 +030500P MOVE PASS-COUNTER TO C-OK. SQ1164.2 +030600P MOVE ERROR-HOLD TO C-ALL. SQ1164.2 +030700P MOVE ERROR-COUNTER TO C-FAIL. SQ1164.2 +030800P MOVE DELETE-CNT TO C-DELETED. SQ1164.2 +030900P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1164.2 +031000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1164.2 +031100PEND-E-2. SQ1164.2 +031200P CLOSE RAW-DATA. SQ1164.2 +031300 TERMINATE-CCVS. SQ1164.2 +031400S EXIT PROGRAM. SQ1164.2 +031500STERMINATE-CALL. SQ1164.2 +031600 STOP RUN. SQ1164.2 +031700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1164.2 +031800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1164.2 +031900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1164.2 +032000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1164.2 +032100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1164.2 +032200 PRINT-DETAIL. SQ1164.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ1164.2 +032400 MOVE "." TO PARDOT-X SQ1164.2 +032500 MOVE REC-CT TO DOTVALUE. SQ1164.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1164.2 +032700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1164.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1164.2 +032900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1164.2 +033000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1164.2 +033100 MOVE SPACE TO CORRECT-X. SQ1164.2 +033200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1164.2 +033300 MOVE SPACE TO RE-MARK. SQ1164.2 +033400 HEAD-ROUTINE. SQ1164.2 +033500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +033600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1164.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1164.2 +033800 COLUMN-NAMES-ROUTINE. SQ1164.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +034200 END-ROUTINE. SQ1164.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1164.2 +034400 END-RTN-EXIT. SQ1164.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +034600 END-ROUTINE-1. SQ1164.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1164.2 +034800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1164.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. SQ1164.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1164.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1164.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1164.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1164.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1164.2 +035500 END-ROUTINE-12. SQ1164.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1164.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1164.2 +035800 MOVE "NO " TO ERROR-TOTAL SQ1164.2 +035900 ELSE SQ1164.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1164.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1164.2 +036200 PERFORM WRITE-LINE. SQ1164.2 +036300 END-ROUTINE-13. SQ1164.2 +036400 IF DELETE-CNT IS EQUAL TO ZERO SQ1164.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE SQ1164.2 +036600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1164.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1164.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1164.2 +037000 MOVE "NO " TO ERROR-TOTAL SQ1164.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1164.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1164.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +037500 WRITE-LINE. SQ1164.2 +037600 ADD 1 TO RECORD-COUNT. SQ1164.2 +037700Y IF RECORD-COUNT GREATER 50 SQ1164.2 +037800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1164.2 +037900Y MOVE SPACE TO DUMMY-RECORD SQ1164.2 +038000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1164.2 +038100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1164.2 +038200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1164.2 +038300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1164.2 +038400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1164.2 +038500Y MOVE ZERO TO RECORD-COUNT. SQ1164.2 +038600 PERFORM WRT-LN. SQ1164.2 +038700 WRT-LN. SQ1164.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1164.2 +038900 MOVE SPACE TO DUMMY-RECORD. SQ1164.2 +039000 BLANK-LINE-PRINT. SQ1164.2 +039100 PERFORM WRT-LN. SQ1164.2 +039200 FAIL-ROUTINE. SQ1164.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1164.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1164.2 +039500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1164.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +039700 GO TO FAIL-ROUTINE-EX. SQ1164.2 +039800 FAIL-ROUTINE-WRITE. SQ1164.2 +039900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1164.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +040100 FAIL-ROUTINE-EX. EXIT. SQ1164.2 +040200 BAIL-OUT. SQ1164.2 +040300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1164.2 +040400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1164.2 +040500 BAIL-OUT-WRITE. SQ1164.2 +040600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1164.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +040800 BAIL-OUT-EX. EXIT. SQ1164.2 +040900 CCVS1-EXIT. SQ1164.2 +041000 EXIT. SQ1164.2 +041100 SECT-SQ116A-0001 SECTION. SQ1164.2 +041200 SEQ-INIT-023. SQ1164.2 +041300 MOVE "SQ-FS6" TO XFILE-NAME (1). SQ1164.2 +041400 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1164.2 +041500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1164.2 +041600 MOVE 130 TO XRECORD-LENGTH (1). SQ1164.2 +041700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1164.2 +041800 MOVE 0001 TO XBLOCK-SIZE (1). SQ1164.2 +041900 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1164.2 +042000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1164.2 +042100 MOVE "O" TO XLABEL-TYPE (1). SQ1164.2 +042200 MOVE "FIRST " TO UPDATE-AREA-ONLY. SQ1164.2 +042300 MOVE ZERO TO COUNT-OF-RECS. SQ1164.2 +042400 OPEN OUTPUT SQ-FS6. SQ1164.2 +042500 SEQ-TEST-023. SQ1164.2 +042600 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +042700 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1164.2 +042800 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1164.2 +042900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS6R1-PART1. SQ1164.2 +043000 MOVE END-OF-RECORD-AREA TO SQ-FS6R1-PART2. SQ1164.2 +043100 WRITE SQ-FS6R1-F-G-130. SQ1164.2 +043200 IF COUNT-OF-RECS EQUAL TO 550 SQ1164.2 +043300 GO TO SEQ-WRITE-023. SQ1164.2 +043400 GO TO SEQ-TEST-023. SQ1164.2 +043500 SEQ-WRITE-023. SQ1164.2 +043600 MOVE "CREATE FILE SQ-FS6" TO FEATURE. SQ1164.2 +043700 MOVE "SEQ-WRITE-023" TO PAR-NAME. SQ1164.2 +043800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1164.2 +043900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +044000 PERFORM PRINT-DETAIL. SQ1164.2 +044100 CLOSE SQ-FS6. SQ1164.2 +044200* A SEQUENTIAL MASS STORAGE FILE WITH 130 CHARACTER SQ1164.2 +044300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1164.2 +044400 SEQ-INIT-024. SQ1164.2 +044500 MOVE ZERO TO COUNT-OF-RECS. SQ1164.2 +044600* THIS TEST VERIFIES THE FILE CREATED IN SEQ-TEST-023. SQ1164.2 +044700 OPEN INPUT SQ-FS6. SQ1164.2 +044800 SEQ-TEST-024. SQ1164.2 +044900 READ SQ-FS6 AT END GO TO SEQ-TEST-024-1. SQ1164.2 +045000 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +045100 IF COUNT-OF-RECS GREATER THAN 550 SQ1164.2 +045200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1164.2 +045300 GO TO SEQ-FAIL-024. SQ1164.2 +045400 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +045500 MOVE SQ-FS6R1-PART2 TO END-OF-RECORD-AREA. SQ1164.2 +045600 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +045700 GO TO SEQ-FAIL-024-1. SQ1164.2 +045800 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +045900 GO TO SEQ-FAIL-024-1. SQ1164.2 +046000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +046100 GO TO SEQ-FAIL-024-1. SQ1164.2 +046200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +046300 GO TO SEQ-FAIL-024-1. SQ1164.2 +046400 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1164.2 +046500 GO TO SEQ-FAIL-024-1. SQ1164.2 +046600 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +046700 GO TO SEQ-FAIL-024-1. SQ1164.2 +046800 GO TO SEQ-TEST-024. SQ1164.2 +046900 SEQ-FAIL-024-1. SQ1164.2 +047000 ADD 1 TO RECORDS-IN-ERROR. SQ1164.2 +047100 GO TO SEQ-TEST-024. SQ1164.2 +047200 SEQ-TEST-024-1. SQ1164.2 +047300 IF RECORDS-IN-ERROR EQUAL TO 0 SQ1164.2 +047400 GO TO SEQ-PASS-024. SQ1164.2 +047500 MOVE "ERRORS IN READING SQ-FS6" TO RE-MARK. SQ1164.2 +047600 SEQ-FAIL-024. SQ1164.2 +047700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1164.2 +047800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1164.2 +047900 PERFORM FAIL. SQ1164.2 +048000 GO TO SEQ-WRITE-024. SQ1164.2 +048100 SEQ-PASS-024. SQ1164.2 +048200 PERFORM PASS. SQ1164.2 +048300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1164.2 +048400 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +048500 SEQ-WRITE-024. SQ1164.2 +048600 MOVE "SEQ-TEST-024" TO PAR-NAME. SQ1164.2 +048700 MOVE "VERIFY FILE SQ-FS6" TO FEATURE. SQ1164.2 +048800 PERFORM PRINT-DETAIL. SQ1164.2 +048900 SEQ-CLOSE-024. SQ1164.2 +049000 CLOSE SQ-FS6. SQ1164.2 +049100 REWRITE-INIT-GF-01. SQ1164.2 +049200 OPEN I-O SQ-FS6. SQ1164.2 +049300 MOVE 0 TO COUNT-OF-RECS. SQ1164.2 +049400 MOVE 0 TO EOF-FLAG. SQ1164.2 +049500 MOVE 0 TO ERROR-FLAG. SQ1164.2 +049600* SKIP THE FIRST 30 RECORDS. SQ1164.2 +049700 PERFORM READ-SQ-FS6 THRU READ-SQ-FS6-EXIT 30 TIMES. SQ1164.2 +049800 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +049900 GO TO CANT-TEST. SQ1164.2 +050000 GO TO REWRITE-TEST-GF-01. SQ1164.2 +050100 READ-SQ-FS6. SQ1164.2 +050200 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +050300 GO TO READ-SQ-FS6-EXIT. SQ1164.2 +050400 READ SQ-FS6 AT END SQ1164.2 +050500 MOVE 1 TO EOF-FLAG. SQ1164.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +050700 READ-SQ-FS6-EXIT. SQ1164.2 +050800 EXIT. SQ1164.2 +050900 REWRITE-TEST-GF-01. SQ1164.2 +051000* THIS TEST REWRITES RECORDS FROM A WORKING-STORAGE AREA SQ1164.2 +051100* THE SAME SIZE AS THE FD 01 RECORD AREA. A CHECK IS MADE TO SQ1164.2 +051200* ENSURE THAT THE FROM AREA WAS NOT DESTROYED BY THE REWRITE...SQ1164.2 +051300* FROM STATEMENT. SQ1164.2 +051400 IF COUNT-OF-RECS EQUAL TO 80 SQ1164.2 +051500 GO TO REWRITE-TEST-GF-01-1. SQ1164.2 +051600 READ SQ-FS6 RECORD SQ1164.2 +051700 AT END GO TO CANT-TEST. SQ1164.2 +051800 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +051900 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +052000 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +052100 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA1-1. SQ1164.2 +052200 MOVE SQ-FS6R1-PART2 TO AREA1-2. SQ1164.2 +052300 MOVE "SECOND" TO AREA1-21. SQ1164.2 +052400 REWRITE SQ-FS6R1-F-G-130 FROM REWRT-FROM-AREA1. SQ1164.2 +052500 IF AREA1-1 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1164.2 +052600 GO TO REWRITE-FAIL-GF-01-1. SQ1164.2 +052700 IF AREA1-21 NOT EQUAL TO "SECOND" SQ1164.2 +052800 GO TO REWRITE-FAIL-GF-01-1. SQ1164.2 +052900 IF AREA1-22 EQUAL TO COUNT-OF-RECS SQ1164.2 +053000 GO TO REWRITE-TEST-GF-01. SQ1164.2 +053100 REWRITE-FAIL-GF-01-1. SQ1164.2 +053200 MOVE 1 TO ERROR-FLAG. SQ1164.2 +053300 GO TO REWRITE-TEST-GF-01. SQ1164.2 +053400 REWRITE-TEST-GF-01-1. SQ1164.2 +053500 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +053600 GO TO REWRITE-PASS-GF-01. SQ1164.2 +053700 REWRITE-FAIL-GF-01. SQ1164.2 +053800 MOVE "FROM AREA CLOBBERED" TO COMPUTED-A. SQ1164.2 +053900 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +054000 PERFORM FAIL. SQ1164.2 +054100 GO TO REWRITE-WRITE-GF-01. SQ1164.2 +054200 REWRITE-PASS-GF-01. SQ1164.2 +054300 PERFORM PASS. SQ1164.2 +054400 REWRITE-WRITE-GF-01. SQ1164.2 +054500 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1164.2 +054600 MOVE "REWRITE...FROM 01 L" TO FEATURE. SQ1164.2 +054700 PERFORM PRINT-DETAIL. SQ1164.2 +054800 REWRITE-INIT-GF-02-A. SQ1164.2 +054900* THIS TEST REWRITES A RECORD FROM A WORKING-STORAGE AREA SQ1164.2 +055000* LARGER THAN THE FD 01 RECORD AREA. TRUNCATION SHOULD SQ1164.2 +055100* OCCUR ON THE RIGHTMOST CHARACTERS. SQ1164.2 +055200 READ SQ-FS6 RECORD SQ1164.2 +055300 AT END GO TO CANT-TEST. SQ1164.2 +055400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +055500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +055600 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +055700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-11. SQ1164.2 +055800 MOVE "SECOND" TO AREA2-12. SQ1164.2 +055900 MOVE COUNT-OF-RECS TO AREA2-13. SQ1164.2 +056000 MOVE "JUNK-AREA" TO AREA2-2. SQ1164.2 +056100 REWRITE SQ-FS6R1-F-G-130 FROM REWRT-FROM-AREA2. SQ1164.2 +056200 IF COUNT-OF-RECS EQUAL TO 120 SQ1164.2 +056300 GO TO REWRITE-INIT-GF-03-A. SQ1164.2 +056400 GO TO REWRITE-INIT-GF-02-A. SQ1164.2 +056500 REWRITE-INIT-GF-03-A. SQ1164.2 +056600* THIS TEST REWRITES A RECORD FROM AN 87 CHARACTER SQ1164.2 +056700* WORKING-STORAGE ITEM. THE REST OF THE 130 CHARACTERS SQ1164.2 +056800* SHOULD BE SPACE FILLED DURING THE REWRITE STATEMENT. SQ1164.2 +056900 READ SQ-FS6 RECORD SQ1164.2 +057000 AT END GO TO CANT-TEST. SQ1164.2 +057100 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +057200 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +057300 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA3-1. SQ1164.2 +057500 MOVE "JUNK-AREA" TO FOLLOWS-AREA3. SQ1164.2 +057600 REWRITE SQ-FS6R1-F-G-130 FROM RWRT-FROM-AREA3. SQ1164.2 +057700 IF COUNT-OF-RECS EQUAL TO 160 SQ1164.2 +057800 GO TO REWRITE-INIT-GF-04-A. SQ1164.2 +057900 GO TO REWRITE-INIT-GF-03-A. SQ1164.2 +058000 REWRITE-INIT-GF-04-A. SQ1164.2 +058100* THIS TEST REWRITES A RECORD FROM AN 02 LEVEL DATA ITEM. SQ1164.2 +058200 READ SQ-FS6 RECORD SQ1164.2 +058300 AT END GO TO CANT-TEST. SQ1164.2 +058400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +058500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +058600 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +058700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-11. SQ1164.2 +058800 MOVE "SECOND" TO AREA2-12. SQ1164.2 +058900 MOVE COUNT-OF-RECS TO AREA2-13. SQ1164.2 +059000 MOVE "JUNK-AREA" TO AREA2-2. SQ1164.2 +059100 REWRITE SQ-FS6R1-F-G-130 FROM AREA2-1. SQ1164.2 +059200 IF COUNT-OF-RECS EQUAL TO 200 SQ1164.2 +059300 GO TO REWRITE-INIT-GF-05-A. SQ1164.2 +059400 GO TO REWRITE-INIT-GF-04-A. SQ1164.2 +059500 REWRITE-INIT-GF-05-A. SQ1164.2 +059600* THIS TEST REWRITES A RECORD FROM A SUBSCRIPTED DATA SQ1164.2 +059700* ITEM OF 120 CHARACTERS. THE DATA ITEM IS LEVEL 05. SQ1164.2 +059800 READ SQ-FS6 RECORD SQ1164.2 +059900 AT END GO TO CANT-TEST. SQ1164.2 +060000 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +060100 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (2). SQ1164.2 +060200 ADD 1 TO UPDATE-NUMBER (2). SQ1164.2 +060300 MOVE SPACE TO SQ-FS6R1-PART2. SQ1164.2 +060400 REWRITE SQ-FS6R1-F-G-130 FROM FILE-RECORD-INFO-P1-120 (2). SQ1164.2 +060500 IF COUNT-OF-RECS EQUAL TO 240 SQ1164.2 +060600 GO TO REWRITE-CLOSE-SQ-FS6. SQ1164.2 +060700 GO TO REWRITE-INIT-GF-05-A. SQ1164.2 +060800 REWRITE-CLOSE-SQ-FS6. SQ1164.2 +060900 CLOSE SQ-FS6. SQ1164.2 +061000 GO TO REWRITE-READ-INIT-GF-02. SQ1164.2 +061100 CANT-TEST. SQ1164.2 +061200* THIS PARAGRAPH IS EXECUTED ONLY WHEN AN AT END SQ1164.2 +061300* CONDITION OCCURRED WHEN TRYING TO READ AND REWRITE SQ1164.2 +061400* THE FILE SQ-FS6. SQ1164.2 +061500 MOVE "UNEXPECTED EOF" TO COMPUTED-A. SQ1164.2 +061600 MOVE "UNABLE TO UPDATE FILE" TO RE-MARK. SQ1164.2 +061700 PERFORM PRINT-DETAIL. SQ1164.2 +061800 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ1164.2 +061900 MOVE "**** REWRITE TESTS DELETED ****" TO DUMMY-RECORD. SQ1164.2 +062000 PERFORM WRITE-LINE. SQ1164.2 +062100 GO TO SEQ-CLOSE-025. SQ1164.2 +062200 REWRITE-READ-INIT-GF-02. SQ1164.2 +062300 MOVE 0 TO COUNT-OF-RECS. SQ1164.2 +062400 MOVE 0 TO EOF-FLAG. SQ1164.2 +062500 MOVE 0 TO ERROR-FLAG. SQ1164.2 +062600 MOVE 0 TO RECORDS-IN-ERROR. SQ1164.2 +062700 OPEN INPUT SQ-FS6. SQ1164.2 +062800 REWRITE-TEST-GF-02. SQ1164.2 +062900* CHECK THE FIRST 30 RECORDS OF THE FILE. SQ1164.2 +063000* THESE RECORDS WERE NOT REWRITTEN. SQ1164.2 +063100 IF COUNT-OF-RECS EQUAL TO 30 SQ1164.2 +063200 GO TO REWRITE-TEST-GF-02-1. SQ1164.2 +063300 READ SQ-FS6 RECORD SQ1164.2 +063400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +063500 MOVE 1 TO EOF-FLAG SQ1164.2 +063600 GO TO REWRITE-FAIL-GF-02. SQ1164.2 +063700 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +063800 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +063900 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +064000 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064100 IF UPDATE-NUMBER (1) NOT EQUAL TO 0 SQ1164.2 +064200 PERFORM CHECK-RECORD-FAIL SQ1164.2 +064300 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064400 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +064500 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +064600 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064700 REWRITE-TEST-GF-02-1. SQ1164.2 +064800 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +064900 GO TO REWRITE-PASS-GF-02. SQ1164.2 +065000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +065100 REWRITE-FAIL-GF-02. SQ1164.2 +065200 MOVE "VII-48; 4.5.2 RWRT LARGER RECORDS: TRUNC." TO RE-MARK.SQ1164.2 +065300 PERFORM FAIL. SQ1164.2 +065400 MOVE "CHECK RECORDS NOT REWRITTEN" TO RE-MARK. SQ1164.2 +065500 GO TO REWRITE-WRITE-GF-02. SQ1164.2 +065600 REWRITE-PASS-GF-02. SQ1164.2 +065700 PERFORM PASS. SQ1164.2 +065800 REWRITE-WRITE-GF-02. SQ1164.2 +065900 MOVE "RWRT; LARGER RECORDS " TO FEATURE. SQ1164.2 +066000 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1164.2 +066100 PERFORM PRINT-DETAIL. SQ1164.2 +066200 GO TO REWRITE-INIT-GF-03. SQ1164.2 +066300 CHECK-RECORD. SQ1164.2 +066400 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +066500 MOVE SQ-FS6R1-PART2 TO END-OF-RECORD-AREA. SQ1164.2 +066600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +066700 GO TO CHECK-RECORD-FAIL. SQ1164.2 +066800 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1164.2 +066900 GO TO CHECK-RECORD-FAIL. SQ1164.2 +067000 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +067100 GO TO CHECK-RECORD-FAIL. SQ1164.2 +067200 IF NUMBER-AREA EQUAL TO COUNT-OF-RECS SQ1164.2 +067300 GO TO CHECK-RECORD-EXIT. SQ1164.2 +067400 CHECK-RECORD-FAIL. SQ1164.2 +067500 ADD 1 TO RECORDS-IN-ERROR. SQ1164.2 +067600 MOVE 1 TO ERROR-FLAG. SQ1164.2 +067700 CHECK-RECORD-EXIT. SQ1164.2 +067800 EXIT. SQ1164.2 +067900 REWRITE-INIT-GF-03. SQ1164.2 +068000 MOVE 0 TO ERROR-FLAG. SQ1164.2 +068100 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +068200 GO TO SEQ-EOF-025. SQ1164.2 +068300* THIS TEST CHECKS RECORDS 31 THRU 80 WHICH WERE REWRITTEN. SQ1164.2 +068400 REWRITE-TEST-GF-03. SQ1164.2 +068500 IF COUNT-OF-RECS EQUAL TO 80 SQ1164.2 +068600 GO TO REWRITE-TEST-GF-03-1. SQ1164.2 +068700 READ SQ-FS6 RECORD SQ1164.2 +068800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +068900 MOVE 1 TO EOF-FLAG SQ1164.2 +069000 GO TO REWRITE-FAIL-GF-03. SQ1164.2 +069100 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +069200 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +069300 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +069400 GO TO REWRITE-TEST-GF-03. SQ1164.2 +069500 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +069600 PERFORM CHECK-RECORD-FAIL SQ1164.2 +069700 GO TO REWRITE-TEST-GF-03. SQ1164.2 +069800 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +069900 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +070000 GO TO REWRITE-TEST-GF-03. SQ1164.2 +070100 REWRITE-TEST-GF-03-1. SQ1164.2 +070200 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +070300 GO TO REWRITE-PASS-GF-03. SQ1164.2 +070400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +070500 REWRITE-FAIL-GF-03. SQ1164.2 +070600 MOVE "VII-48; 4.5.2 REWRITE OF 130 CHAR RECS " TO RE-MARK.SQ1164.2 +070700 PERFORM FAIL. SQ1164.2 +070800 GO TO REWRITE-WRITE-GF-03. SQ1164.2 +070900 REWRITE-PASS-GF-03. SQ1164.2 +071000 PERFORM PASS. SQ1164.2 +071100 REWRITE-WRITE-GF-03. SQ1164.2 +071200 MOVE "RWRT; SHORTER RECORDS " TO FEATURE. SQ1164.2 +071300 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. SQ1164.2 +071400 PERFORM PRINT-DETAIL. SQ1164.2 +071500 REWRITE-INIT-GF-04. SQ1164.2 +071600 MOVE 0 TO REC-CT. SQ1164.2 +071700 MOVE 0 TO ERROR-FLAG. SQ1164.2 +071800 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +071900 GO TO SEQ-EOF-025. SQ1164.2 +072000* THIS TEST CHECKS THE RECORDS WHICH WERE REWRITTEN SQ1164.2 +072100* FROM AN 139 CHARACTER RECORD. SQ1164.2 +072200 REWRITE-TEST-GF-04. SQ1164.2 +072300 IF COUNT-OF-RECS EQUAL TO 120 SQ1164.2 +072400 GO TO REWRITE-TEST-GF-04-1. SQ1164.2 +072500 READ SQ-FS6 RECORD SQ1164.2 +072600 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +072700 MOVE 1 TO EOF-FLAG SQ1164.2 +072800 GO TO REWRITE-FAIL-GF-04. SQ1164.2 +072900 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +073000 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +073100 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +073200 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073300 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +073400 PERFORM CHECK-RECORD-FAIL SQ1164.2 +073500 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073600 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +073700 PERFORM CHECK-RECORD-FAIL SQ1164.2 +073800 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073900 MOVE SPACE TO AREA2-2. SQ1164.2 +074000 MOVE SQ-FS6R1-F-G-130 TO REWRT-FROM-AREA2. SQ1164.2 +074100 IF AREA2-2 NOT EQUAL TO SPACE SQ1164.2 +074200 MOVE "NO RECORD TRUNCATION" TO RE-MARK SQ1164.2 +074300 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +074400 GO TO REWRITE-TEST-GF-04. SQ1164.2 +074500 REWRITE-TEST-GF-04-1. SQ1164.2 +074600 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +074700 GO TO REWRITE-PASS-GF-04. SQ1164.2 +074800 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +074900 REWRITE-FAIL-GF-04. SQ1164.2 +075000 MOVE "VII-48; 4.5.2 RWRT FROM 139 CHAR REC " TO RE-MARK.SQ1164.2 +075100 PERFORM FAIL. SQ1164.2 +075200 GO TO REWRITE-WRITE-GF-04. SQ1164.2 +075300 REWRITE-PASS-GF-04. SQ1164.2 +075400 PERFORM PASS. SQ1164.2 +075500 REWRITE-WRITE-GF-04. SQ1164.2 +075600 MOVE "RWRT FROM 139" TO FEATURE. SQ1164.2 +075700 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. SQ1164.2 +075800 PERFORM PRINT-DETAIL. SQ1164.2 +075900 REWRITE-INIT-GF-05. SQ1164.2 +076000 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +076100 GO TO SEQ-EOF-025. SQ1164.2 +076200 MOVE 0 TO ERROR-FLAG. SQ1164.2 +076300* THIS TEST CHECKS THE 87 CHARACTER RECORDS WHICH SQ1164.2 +076400* WERE REWRITTEN. CHARACTERS 88 THRU 130 SHOULD BE SPACES. SQ1164.2 +076500 REWRITE-TEST-GF-05. SQ1164.2 +076600 IF COUNT-OF-RECS EQUAL TO 160 SQ1164.2 +076700 GO TO REWRITE-TEST-GF-05-1. SQ1164.2 +076800 READ SQ-FS6 RECORD SQ1164.2 +076900 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +077000 MOVE 1 TO EOF-FLAG SQ1164.2 +077100 GO TO REWRITE-FAIL-GF-05. SQ1164.2 +077200 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +077300 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +077400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +077500 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +077600 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1164.2 +077700 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +077800 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +077900 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078000 IF CHARS-OR-RECORDS (1) NOT EQUAL TO SPACE SQ1164.2 +078100 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +078200 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078300 IF SQ-FS6R1-PART2 NOT EQUAL TO SPACE SQ1164.2 +078400 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +078500 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078600 GO TO REWRITE-TEST-GF-05. SQ1164.2 +078700 REWRITE-FAIL-GF-05-1. SQ1164.2 +078800 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +078900 GO TO REWRITE-TEST-GF-05. SQ1164.2 +079000 REWRITE-TEST-GF-05-1. SQ1164.2 +079100 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +079200 GO TO REWRITE-PASS-GF-05. SQ1164.2 +079300 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +079400 REWRITE-FAIL-GF-05. SQ1164.2 +079500 MOVE "VII-48; 4.5.2 CHARS 88 THRU 139: SPACE} " TO RE-MARK.SQ1164.2 +079600 PERFORM FAIL. SQ1164.2 +079700 GO TO REWRITE-WRITE-GF-05. SQ1164.2 +079800 REWRITE-PASS-GF-05. SQ1164.2 +079900 PERFORM PASS. SQ1164.2 +080000 REWRITE-WRITE-GF-05. SQ1164.2 +080100 MOVE "RWRT SHORTER RECORDS" TO FEATURE. SQ1164.2 +080200 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. SQ1164.2 +080300 PERFORM PRINT-DETAIL. SQ1164.2 +080400 REWRITE-INIT-GF-06. SQ1164.2 +080500 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +080600 GO TO SEQ-EOF-025. SQ1164.2 +080700 MOVE 0 TO ERROR-FLAG. SQ1164.2 +080800* THIS TEST CHECKS THE RECORDS REWRITTEN FROM AN 02 SQ1164.2 +080900* LEVEL ITEM OF 130 CHARACTERS. SQ1164.2 +081000 REWRITE-TEST-GF-06. SQ1164.2 +081100 IF COUNT-OF-RECS EQUAL TO 200 SQ1164.2 +081200 GO TO REWRITE-TEST-GF-06-1. SQ1164.2 +081300 READ SQ-FS6 RECORD SQ1164.2 +081400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +081500 MOVE 1 TO EOF-FLAG SQ1164.2 +081600 GO TO REWRITE-FAIL-GF-06. SQ1164.2 +081700 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +081800 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +081900 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +082000 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082100 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +082200 PERFORM CHECK-RECORD-FAIL SQ1164.2 +082300 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082400 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +082500 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +082600 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082700 REWRITE-TEST-GF-06-1. SQ1164.2 +082800 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +082900 GO TO REWRITE-PASS-GF-06. SQ1164.2 +083000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +083100 REWRITE-FAIL-GF-06. SQ1164.2 +083200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +083300 PERFORM FAIL. SQ1164.2 +083400 GO TO REWRITE-WRITE-GF-06. SQ1164.2 +083500 REWRITE-PASS-GF-06. SQ1164.2 +083600 PERFORM PASS. SQ1164.2 +083700 REWRITE-WRITE-GF-06. SQ1164.2 +083800 MOVE "RWRT FROM 02 LEVEL" TO FEATURE. SQ1164.2 +083900 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. SQ1164.2 +084000 PERFORM PRINT-DETAIL. SQ1164.2 +084100 REWRITE-INIT-GF-07. SQ1164.2 +084200 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +084300 GO TO SEQ-EOF-025. SQ1164.2 +084400 MOVE 0 TO ERROR-FLAG. SQ1164.2 +084500* THIS TEST CHECKS THE RECORDS REWRITTEN FROM AN 05 LEVEL SQ1164.2 +084600* SUBSCRIPTED ITEM. SQ1164.2 +084700 REWRITE-TEST-GF-07. SQ1164.2 +084800 IF COUNT-OF-RECS EQUAL TO 240 SQ1164.2 +084900 GO TO REWRITE-TEST-GF-07-1. SQ1164.2 +085000 READ SQ-FS6 RECORD SQ1164.2 +085100 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +085200 MOVE 1 TO EOF-FLAG SQ1164.2 +085300 GO TO REWRITE-FAIL-GF-07. SQ1164.2 +085400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +085500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +085600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +085700 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +085800 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +085900 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086000 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +086100 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086200 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +086300 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086400 IF SQ-FS6R1-PART2 NOT EQUAL TO SPACE SQ1164.2 +086500 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +086600 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086700 GO TO REWRITE-TEST-GF-07. SQ1164.2 +086800 REWRITE-FAIL-GF-07-1. SQ1164.2 +086900 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +087000 GO TO REWRITE-TEST-GF-07. SQ1164.2 +087100 REWRITE-TEST-GF-07-1. SQ1164.2 +087200 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +087300 GO TO REWRITE-PASS-GF-07. SQ1164.2 +087400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +087500 REWRITE-FAIL-GF-07. SQ1164.2 +087600 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +087700 PERFORM FAIL. SQ1164.2 +087800 GO TO REWRITE-WRITE-GF-07. SQ1164.2 +087900 REWRITE-PASS-GF-07. SQ1164.2 +088000 PERFORM PASS. SQ1164.2 +088100 REWRITE-WRITE-GF-07. SQ1164.2 +088200 MOVE "RWRT FROM 05 LEVEL" TO FEATURE. SQ1164.2 +088300 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. SQ1164.2 +088400 PERFORM PRINT-DETAIL. SQ1164.2 +088500 REWRITE-INIT-GF-08. SQ1164.2 +088600 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +088700 GO TO SEQ-EOF-025. SQ1164.2 +088800 MOVE 0 TO ERROR-FLAG. SQ1164.2 +088900* THIS TEST CHECKS RECORDS 241 THRU 550 WHICH WERE NOT SQ1164.2 +089000* REWRITTEN. SQ1164.2 +089100 REWRITE-TEST-GF-08. SQ1164.2 +089200 IF COUNT-OF-RECS EQUAL TO 550 SQ1164.2 +089300 GO TO REWRITE-TEST-GF-08-1. SQ1164.2 +089400 READ SQ-FS6 RECORD SQ1164.2 +089500 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +089600 MOVE 1 TO EOF-FLAG SQ1164.2 +089700 GO TO REWRITE-FAIL-GF-08. SQ1164.2 +089800 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +089900 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +090000 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +090100 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090200 IF UPDATE-NUMBER (1) NOT EQUAL TO 0 SQ1164.2 +090300 PERFORM CHECK-RECORD-FAIL SQ1164.2 +090400 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090500 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +090600 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +090700 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090800 REWRITE-TEST-GF-08-1. SQ1164.2 +090900 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +091000 GO TO REWRITE-PASS-GF-08. SQ1164.2 +091100 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +091200 REWRITE-FAIL-GF-08. SQ1164.2 +091300 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +091400 PERFORM FAIL. SQ1164.2 +091500 GO TO REWRITE-WRITE-GF-08. SQ1164.2 +091600 REWRITE-PASS-GF-08. SQ1164.2 +091700 PERFORM PASS. SQ1164.2 +091800 REWRITE-WRITE-GF-08. SQ1164.2 +091900 MOVE "RWRT-TEST-GF-08" TO PAR-NAME. SQ1164.2 +092000 MOVE "RECORD NOT REWRITTEN" TO FEATURE. SQ1164.2 +092100 PERFORM PRINT-DETAIL. SQ1164.2 +092200 SEQ-INIT-025. SQ1164.2 +092300* THIS TEST CHECKS IF THERE WERE ANY ERRORS IN THE SQ1164.2 +092400* UPDATED FILE AND READS THE FILE ONCE MORE EXPECTING SQ1164.2 +092500* THE AT END CONDITION TO OCCUR. SQ1164.2 +092600 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +092700 GO TO SEQ-EOF-025. SQ1164.2 +092800 SEQ-TEST-025. SQ1164.2 +092900 READ SQ-FS6 RECORD SQ1164.2 +093000 AT END GO TO SEQ-TEST-25-1. SQ1164.2 +093100 MOVE "MORE THAN 550 RECORDS" TO RE-MARK. SQ1164.2 +093200 GO TO SEQ-FAIL-025. SQ1164.2 +093300 SEQ-TEST-25-1. SQ1164.2 +093400 IF RECORDS-IN-ERROR NOT EQUAL TO 0 SQ1164.2 +093500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1164.2 +093600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1164.2 +093700 GO TO SEQ-FAIL-025. SQ1164.2 +093800 SEQ-PASS-025. SQ1164.2 +093900 PERFORM PASS. SQ1164.2 +094000 GO TO SEQ-WRITE-025. SQ1164.2 +094100 SEQ-EOF-025. SQ1164.2 +094200 MOVE "LESS THAN 550 RECORDS" TO RE-MARK. SQ1164.2 +094300 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1164.2 +094400 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +094500 SEQ-FAIL-025. SQ1164.2 +094600 PERFORM FAIL. SQ1164.2 +094700 SEQ-WRITE-025. SQ1164.2 +094800 MOVE "SEQ-TEST-025" TO PAR-NAME. SQ1164.2 +094900 MOVE "READ LAST RECORD" TO FEATURE. SQ1164.2 +095000 PERFORM PRINT-DETAIL. SQ1164.2 +095100 SEQ-CLOSE-025. SQ1164.2 +095200 CLOSE SQ-FS6. SQ1164.2 +095300 TERMINATE-ROUTINE. SQ1164.2 +095400 EXIT. SQ1164.2 +095500 CCVS-EXIT SECTION. SQ1164.2 +095600 CCVS-999999. SQ1164.2 +095700 GO TO CLOSE-FILES. SQ1164.2 +*END-OF,SQ116A +*HEADER,COBOL,SQ117A +000100 IDENTIFICATION DIVISION. SQ1174.2 +000200 PROGRAM-ID. SQ1174.2 +000300 SQ117A. SQ1174.2 +000400**************************************************************** SQ1174.2 +000500* * SQ1174.2 +000600* VALIDATION FOR:- * SQ1174.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1174.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1174.2 +000900* * SQ1174.2 +001000* CREATION DATE / VALIDATION DATE * SQ1174.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1174.2 +001200* * SQ1174.2 +001300**************************************************************** SQ1174.2 +001400 SQ1174.2 +001500* THIS ROUTINE CREATES A SEQUENTIAL MASS STORAGE FILE SQ1174.2 +001600* USING WRITE...FROM STATEMENTS. THE FILE IS READ AND FIELDS SQ1174.2 +001700* IN THE RECORDS ARE CHECKED TO ENSURE THAT TRUNCATION AND SQ1174.2 +001800* BLANK FILLING OF THE RECORD OCCURS WHEN REQUIRED. SQ1174.2 +001900* SQ1174.2 +002000* USED X-CARDS: SQ1174.2 +002100* XXXXX014 SQ1174.2 +002200* XXXXX055 SQ1174.2 +002300* P XXXXX062 SQ1174.2 +002400* XXXXX082 SQ1174.2 +002500* XXXXX083 SQ1174.2 +002600* C XXXXX084 SQ1174.2 +002700* SQ1174.2 +002800* SQ1174.2 +002900 ENVIRONMENT DIVISION. SQ1174.2 +003000 CONFIGURATION SECTION. SQ1174.2 +003100 SOURCE-COMPUTER. SQ1174.2 +003200 XXXXX082. SQ1174.2 +003300 OBJECT-COMPUTER. SQ1174.2 +003400 XXXXX083. SQ1174.2 +003500 INPUT-OUTPUT SECTION. SQ1174.2 +003600 FILE-CONTROL. SQ1174.2 +003700P SELECT RAW-DATA ASSIGN TO SQ1174.2 +003800P XXXXX062 SQ1174.2 +003900P ORGANIZATION IS INDEXED SQ1174.2 +004000P ACCESS MODE IS RANDOM SQ1174.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ1174.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1174.2 +004300 XXXXX055. SQ1174.2 +004400 SELECT SQ-FS9 ASSIGN TO SQ1174.2 +004500 XXXXX014 SQ1174.2 +004600 ORGANIZATION IS SEQUENTIAL SQ1174.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ1174.2 +004800 DATA DIVISION. SQ1174.2 +004900 FILE SECTION. SQ1174.2 +005000P SQ1174.2 +005100PFD RAW-DATA. SQ1174.2 +005200P SQ1174.2 +005300P01 RAW-DATA-SATZ. SQ1174.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ1174.2 +005500P 05 C-DATE PIC 9(6). SQ1174.2 +005600P 05 C-TIME PIC 9(8). SQ1174.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ1174.2 +005800P 05 C-OK PIC 999. SQ1174.2 +005900P 05 C-ALL PIC 999. SQ1174.2 +006000P 05 C-FAIL PIC 999. SQ1174.2 +006100P 05 C-DELETED PIC 999. SQ1174.2 +006200P 05 C-INSPECT PIC 999. SQ1174.2 +006300P 05 C-NOTE PIC X(13). SQ1174.2 +006400P 05 C-INDENT PIC X. SQ1174.2 +006500P 05 C-ABORT PIC X(8). SQ1174.2 +006600 FD PRINT-FILE SQ1174.2 +006700C LABEL RECORDS SQ1174.2 +006800C XXXXX084 SQ1174.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1174.2 +007000 . SQ1174.2 +007100 01 PRINT-REC PICTURE X(120). SQ1174.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1174.2 +007300 FD SQ-FS9 SQ1174.2 +007400C LABEL RECORD STANDARD SQ1174.2 +007500 BLOCK CONTAINS 1 RECORDS. SQ1174.2 +007600 01 SQ-FS9R1-F-G-141. SQ1174.2 +007700 02 SQ-FS9R1-PART1 PICTURE X(120). SQ1174.2 +007800 02 SQ-FS9R1-PART2 PICTURE X(21). SQ1174.2 +007900 WORKING-STORAGE SECTION. SQ1174.2 +008000 01 COUNT-OF-RECS PICTURE 9(5) VALUE 0. SQ1174.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1174.2 +008200 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1174.2 +008300 01 EOF-FLAG PIC 9 VALUE 0. SQ1174.2 +008400 01 WRITE-FROM-AREA1. SQ1174.2 +008500 02 AREA1-1 PIC X(87). SQ1174.2 +008600 01 FOLLOWS-AREA1 PIC X(10). SQ1174.2 +008700 01 WRITE-FROM-AREA2. SQ1174.2 +008800 02 AREA2-1 PIC X(120). SQ1174.2 +008900 01 WRITE-FROM-AREA3. SQ1174.2 +009000 02 AREA3-1 PIC X(141). SQ1174.2 +009100 02 AREA3-2 PIC X(7). SQ1174.2 +009200 01 WRITE-FROM-AREA4. SQ1174.2 +009300 02 AREA4-1 PIC X(120). SQ1174.2 +009400 02 AREA4-2 PIC X(21). SQ1174.2 +009500 01 END-OF-RECORD-AREA. SQ1174.2 +009600 02 ALPHA-AREA PIC X(17). SQ1174.2 +009700 02 NUMBER-AREA PIC 9999. SQ1174.2 +009800 01 FILE-RECORD-INFORMATION-REC. SQ1174.2 +009900 03 FILE-RECORD-INFO-SKELETON. SQ1174.2 +010000 05 FILLER PICTURE X(48) VALUE SQ1174.2 +010100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1174.2 +010200 05 FILLER PICTURE X(46) VALUE SQ1174.2 +010300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1174.2 +010400 05 FILLER PICTURE X(26) VALUE SQ1174.2 +010500 ",LFIL=000000,ORG= ,LBLR= ". SQ1174.2 +010600 05 FILLER PICTURE X(37) VALUE SQ1174.2 +010700 ",RECKEY= ". SQ1174.2 +010800 05 FILLER PICTURE X(38) VALUE SQ1174.2 +010900 ",ALTKEY1= ". SQ1174.2 +011000 05 FILLER PICTURE X(38) VALUE SQ1174.2 +011100 ",ALTKEY2= ". SQ1174.2 +011200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1174.2 +011300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1174.2 +011400 05 FILE-RECORD-INFO-P1-120. SQ1174.2 +011500 07 FILLER PIC X(5). SQ1174.2 +011600 07 XFILE-NAME PIC X(6). SQ1174.2 +011700 07 FILLER PIC X(8). SQ1174.2 +011800 07 XRECORD-NAME PIC X(6). SQ1174.2 +011900 07 FILLER PIC X(1). SQ1174.2 +012000 07 REELUNIT-NUMBER PIC 9(1). SQ1174.2 +012100 07 FILLER PIC X(7). SQ1174.2 +012200 07 XRECORD-NUMBER PIC 9(6). SQ1174.2 +012300 07 FILLER PIC X(6). SQ1174.2 +012400 07 UPDATE-NUMBER PIC 9(2). SQ1174.2 +012500 07 FILLER PIC X(5). SQ1174.2 +012600 07 ODO-NUMBER PIC 9(4). SQ1174.2 +012700 07 FILLER PIC X(5). SQ1174.2 +012800 07 XPROGRAM-NAME PIC X(5). SQ1174.2 +012900 07 FILLER PIC X(7). SQ1174.2 +013000 07 XRECORD-LENGTH PIC 9(6). SQ1174.2 +013100 07 FILLER PIC X(7). SQ1174.2 +013200 07 CHARS-OR-RECORDS PIC X(2). SQ1174.2 +013300 07 FILLER PIC X(1). SQ1174.2 +013400 07 XBLOCK-SIZE PIC 9(4). SQ1174.2 +013500 07 FILLER PIC X(6). SQ1174.2 +013600 07 RECORDS-IN-FILE PIC 9(6). SQ1174.2 +013700 07 FILLER PIC X(5). SQ1174.2 +013800 07 XFILE-ORGANIZATION PIC X(2). SQ1174.2 +013900 07 FILLER PIC X(6). SQ1174.2 +014000 07 XLABEL-TYPE PIC X(1). SQ1174.2 +014100 05 FILE-RECORD-INFO-P121-240. SQ1174.2 +014200 07 FILLER PIC X(8). SQ1174.2 +014300 07 XRECORD-KEY PIC X(29). SQ1174.2 +014400 07 FILLER PIC X(9). SQ1174.2 +014500 07 ALTERNATE-KEY1 PIC X(29). SQ1174.2 +014600 07 FILLER PIC X(9). SQ1174.2 +014700 07 ALTERNATE-KEY2 PIC X(29). SQ1174.2 +014800 07 FILLER PIC X(7). SQ1174.2 +014900 01 TEST-RESULTS. SQ1174.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1174.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1174.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015500 02 PAR-NAME. SQ1174.2 +015600 03 FILLER PICTURE X(12) VALUE SPACE. SQ1174.2 +015700 03 PARDOT-X PICTURE X VALUE SPACE. SQ1174.2 +015800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1174.2 +015900 03 FILLER PIC X(5) VALUE SPACE. SQ1174.2 +016000 02 FILLER PIC X(10) VALUE SPACE. SQ1174.2 +016100 02 RE-MARK PIC X(61). SQ1174.2 +016200 01 TEST-COMPUTED. SQ1174.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1174.2 +016400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1174.2 +016500 02 COMPUTED-X. SQ1174.2 +016600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1174.2 +016700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1174.2 +016800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1174.2 +016900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1174.2 +017000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1174.2 +017100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1174.2 +017200 04 COMPUTED-18V0 PICTURE -9(18). SQ1174.2 +017300 04 FILLER PICTURE X. SQ1174.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ1174.2 +017500 01 TEST-CORRECT. SQ1174.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ1174.2 +017700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1174.2 +017800 02 CORRECT-X. SQ1174.2 +017900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1174.2 +018000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1174.2 +018100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1174.2 +018200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1174.2 +018300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1174.2 +018400 03 CR-18V0 REDEFINES CORRECT-A. SQ1174.2 +018500 04 CORRECT-18V0 PICTURE -9(18). SQ1174.2 +018600 04 FILLER PICTURE X. SQ1174.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ1174.2 +018800 01 CCVS-C-1. SQ1174.2 +018900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1174.2 +019000- "SS PARAGRAPH-NAME SQ1174.2 +019100- " REMARKS". SQ1174.2 +019200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1174.2 +019300 01 CCVS-C-2. SQ1174.2 +019400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +019500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1174.2 +019600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1174.2 +019700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1174.2 +019800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1174.2 +019900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1174.2 +020000 01 REC-CT PICTURE 99 VALUE ZERO. SQ1174.2 +020100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1174.2 +020200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1174.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1174.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1174.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1174.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1174.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1174.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1174.2 +020900 01 CCVS-H-1. SQ1174.2 +021000 02 FILLER PICTURE X(27) VALUE SPACE. SQ1174.2 +021100 02 FILLER PICTURE X(67) VALUE SQ1174.2 +021200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1174.2 +021300- " SYSTEM". SQ1174.2 +021400 02 FILLER PICTURE X(26) VALUE SPACE. SQ1174.2 +021500 01 CCVS-H-2. SQ1174.2 +021600 02 FILLER PICTURE X(52) VALUE IS SQ1174.2 +021700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1174.2 +021800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1174.2 +021900 02 TEST-ID PICTURE IS X(9). SQ1174.2 +022000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1174.2 +022100 01 CCVS-H-3. SQ1174.2 +022200 02 FILLER PICTURE X(34) VALUE SQ1174.2 +022300 " FOR OFFICIAL USE ONLY ". SQ1174.2 +022400 02 FILLER PICTURE X(58) VALUE SQ1174.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1174.2 +022600 02 FILLER PICTURE X(28) VALUE SQ1174.2 +022700 " COPYRIGHT 1985 ". SQ1174.2 +022800 01 CCVS-E-1. SQ1174.2 +022900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1174.2 +023000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1174.2 +023100 02 ID-AGAIN PICTURE IS X(9). SQ1174.2 +023200 02 FILLER PICTURE X(45) VALUE IS SQ1174.2 +023300 " NTIS DISTRIBUTION COBOL 85". SQ1174.2 +023400 01 CCVS-E-2. SQ1174.2 +023500 02 FILLER PICTURE X(31) VALUE SQ1174.2 +023600 SPACE. SQ1174.2 +023700 02 FILLER PICTURE X(21) VALUE SPACE. SQ1174.2 +023800 02 CCVS-E-2-2. SQ1174.2 +023900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1174.2 +024000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +024100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1174.2 +024200 01 CCVS-E-3. SQ1174.2 +024300 02 FILLER PICTURE X(22) VALUE SQ1174.2 +024400 " FOR OFFICIAL USE ONLY". SQ1174.2 +024500 02 FILLER PICTURE X(12) VALUE SPACE. SQ1174.2 +024600 02 FILLER PICTURE X(58) VALUE SQ1174.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1174.2 +024800 02 FILLER PICTURE X(13) VALUE SPACE. SQ1174.2 +024900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1174.2 +025000 01 CCVS-E-4. SQ1174.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1174.2 +025200 02 FILLER PIC XXXX VALUE " OF ". SQ1174.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1174.2 +025400 02 FILLER PIC X(40) VALUE SQ1174.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1174.2 +025600 01 XXINFO. SQ1174.2 +025700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1174.2 +025800 02 INFO-TEXT. SQ1174.2 +025900 04 FILLER PIC X(20) VALUE SPACE. SQ1174.2 +026000 04 XXCOMPUTED PIC X(20). SQ1174.2 +026100 04 FILLER PIC X(5) VALUE SPACE. SQ1174.2 +026200 04 XXCORRECT PIC X(20). SQ1174.2 +026300 01 HYPHEN-LINE. SQ1174.2 +026400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +026500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1174.2 +026600- "*****************************************". SQ1174.2 +026700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1174.2 +026800- "******************************". SQ1174.2 +026900 01 CCVS-PGM-ID PIC X(6) VALUE SQ1174.2 +027000 "SQ117A". SQ1174.2 +027100 PROCEDURE DIVISION. SQ1174.2 +027200 CCVS1 SECTION. SQ1174.2 +027300 OPEN-FILES. SQ1174.2 +027400P OPEN I-O RAW-DATA. SQ1174.2 +027500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1174.2 +027600P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1174.2 +027700P MOVE "ABORTED " TO C-ABORT. SQ1174.2 +027800P ADD 1 TO C-NO-OF-TESTS. SQ1174.2 +027900P ACCEPT C-DATE FROM DATE. SQ1174.2 +028000P ACCEPT C-TIME FROM TIME. SQ1174.2 +028100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1174.2 +028200PEND-E-1. SQ1174.2 +028300P CLOSE RAW-DATA. SQ1174.2 +028400 OPEN OUTPUT PRINT-FILE. SQ1174.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1174.2 +028600 MOVE SPACE TO TEST-RESULTS. SQ1174.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1174.2 +028800 MOVE ZERO TO REC-SKL-SUB. SQ1174.2 +028900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1174.2 +029000 CCVS-INIT-FILE. SQ1174.2 +029100 ADD 1 TO REC-SKL-SUB. SQ1174.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ1174.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ1174.2 +029400 CCVS-INIT-EXIT. SQ1174.2 +029500 GO TO CCVS1-EXIT. SQ1174.2 +029600 CLOSE-FILES. SQ1174.2 +029700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1174.2 +029800P OPEN I-O RAW-DATA. SQ1174.2 +029900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1174.2 +030000P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1174.2 +030100P MOVE "OK. " TO C-ABORT. SQ1174.2 +030200P MOVE PASS-COUNTER TO C-OK. SQ1174.2 +030300P MOVE ERROR-HOLD TO C-ALL. SQ1174.2 +030400P MOVE ERROR-COUNTER TO C-FAIL. SQ1174.2 +030500P MOVE DELETE-CNT TO C-DELETED. SQ1174.2 +030600P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1174.2 +030700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1174.2 +030800PEND-E-2. SQ1174.2 +030900P CLOSE RAW-DATA. SQ1174.2 +031000 TERMINATE-CCVS. SQ1174.2 +031100S EXIT PROGRAM. SQ1174.2 +031200STERMINATE-CALL. SQ1174.2 +031300 STOP RUN. SQ1174.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1174.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1174.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1174.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1174.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1174.2 +031900 PRINT-DETAIL. SQ1174.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1174.2 +032100 MOVE "." TO PARDOT-X SQ1174.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1174.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1174.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1174.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1174.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1174.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1174.2 +032800 MOVE SPACE TO CORRECT-X. SQ1174.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1174.2 +033000 MOVE SPACE TO RE-MARK. SQ1174.2 +033100 HEAD-ROUTINE. SQ1174.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +033300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1174.2 +033400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1174.2 +033500 COLUMN-NAMES-ROUTINE. SQ1174.2 +033600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +033700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +033900 END-ROUTINE. SQ1174.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1174.2 +034100 END-RTN-EXIT. SQ1174.2 +034200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +034300 END-ROUTINE-1. SQ1174.2 +034400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1174.2 +034500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1174.2 +034600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1174.2 +034700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1174.2 +034800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1174.2 +034900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1174.2 +035000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1174.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1174.2 +035200 END-ROUTINE-12. SQ1174.2 +035300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1174.2 +035400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1174.2 +035500 MOVE "NO " TO ERROR-TOTAL SQ1174.2 +035600 ELSE SQ1174.2 +035700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1174.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1174.2 +035900 PERFORM WRITE-LINE. SQ1174.2 +036000 END-ROUTINE-13. SQ1174.2 +036100 IF DELETE-CNT IS EQUAL TO ZERO SQ1174.2 +036200 MOVE "NO " TO ERROR-TOTAL ELSE SQ1174.2 +036300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1174.2 +036400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1174.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +036600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1174.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ1174.2 +036800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1174.2 +036900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1174.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +037100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +037200 WRITE-LINE. SQ1174.2 +037300 ADD 1 TO RECORD-COUNT. SQ1174.2 +037400Y IF RECORD-COUNT GREATER 50 SQ1174.2 +037500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1174.2 +037600Y MOVE SPACE TO DUMMY-RECORD SQ1174.2 +037700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1174.2 +037800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1174.2 +037900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1174.2 +038000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1174.2 +038100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1174.2 +038200Y MOVE ZERO TO RECORD-COUNT. SQ1174.2 +038300 PERFORM WRT-LN. SQ1174.2 +038400 WRT-LN. SQ1174.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1174.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ1174.2 +038700 BLANK-LINE-PRINT. SQ1174.2 +038800 PERFORM WRT-LN. SQ1174.2 +038900 FAIL-ROUTINE. SQ1174.2 +039000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1174.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1174.2 +039200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1174.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +039400 GO TO FAIL-ROUTINE-EX. SQ1174.2 +039500 FAIL-ROUTINE-WRITE. SQ1174.2 +039600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1174.2 +039700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +039800 FAIL-ROUTINE-EX. EXIT. SQ1174.2 +039900 BAIL-OUT. SQ1174.2 +040000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1174.2 +040100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1174.2 +040200 BAIL-OUT-WRITE. SQ1174.2 +040300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1174.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +040500 BAIL-OUT-EX. EXIT. SQ1174.2 +040600 CCVS1-EXIT. SQ1174.2 +040700 EXIT. SQ1174.2 +040800 SECT-SQ117A-0001 SECTION. SQ1174.2 +040900 WRITE-INIT-GF-01. SQ1174.2 +041000 MOVE "SQ-FS9" TO XFILE-NAME (1). SQ1174.2 +041100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1174.2 +041200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1174.2 +041300 MOVE 141 TO XRECORD-LENGTH (1). SQ1174.2 +041400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1174.2 +041500 MOVE 1 TO XBLOCK-SIZE (1). SQ1174.2 +041600 MOVE 493 TO RECORDS-IN-FILE (1). SQ1174.2 +041700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1174.2 +041800 MOVE "O" TO XLABEL-TYPE (1). SQ1174.2 +041900 OPEN OUTPUT SQ-FS9. SQ1174.2 +042000 MOVE "WRITE...FROM FILE" TO ALPHA-AREA. SQ1174.2 +042100 WRITE-TEST-GF-01. SQ1174.2 +042200 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +042300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +042400 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +042500 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +042600 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +042700 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA4. SQ1174.2 +042800* THIS TEST CONTAINS A WRITE RECORD FROM IDENTIFIER SQ1174.2 +042900* STATEMENT WITH THE SIZE OF THE IDENTIFIER EQUAL TO THE SIZE SQ1174.2 +043000* OF FILE RECORD. THE IDENTIFIER AREA IS CHECKED AFTER THE SQ1174.2 +043100* WRITE TO ENSURE THIS AREA WAS LEFT INTACT BY THE WRITE SQ1174.2 +043200* STATEMENT. SQ1174.2 +043300 IF FILE-RECORD-INFO-P1-120 (1) NOT EQUAL TO AREA4-1 SQ1174.2 +043400 MOVE 1 TO ERROR-FLAG. SQ1174.2 +043500 IF END-OF-RECORD-AREA NOT EQUAL TO AREA4-2 SQ1174.2 +043600 MOVE 1 TO ERROR-FLAG. SQ1174.2 +043700 IF COUNT-OF-RECS EQUAL TO 50 SQ1174.2 +043800 GO TO WRITE-TEST-GF-01-1. SQ1174.2 +043900 GO TO WRITE-TEST-GF-01. SQ1174.2 +044000 WRITE-TEST-GF-01-1. SQ1174.2 +044100 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +044200 GO TO WRITE-PASS-GF-01. SQ1174.2 +044300 WRITE-FAIL-GF-01. SQ1174.2 +044400 MOVE "VII-53; 4.7.3 (4); FROM AREA DESTROYED BY WRITE" SQ1174.2 +044500 TO RE-MARK. SQ1174.2 +044600 GO TO WRITE-WRITE-GF-01. SQ1174.2 +044700 WRITE-PASS-GF-01. SQ1174.2 +044800 PERFORM PASS. SQ1174.2 +044900 WRITE-WRITE-GF-01. SQ1174.2 +045000 MOVE "WRTE-TEST-GF-01" TO PAR-NAME. SQ1174.2 +045100 MOVE "WRITE...FROM EQUAL" TO FEATURE. SQ1174.2 +045200 PERFORM PRINT-DETAIL. SQ1174.2 +045300 WRITE-INIT-GF-02-A. SQ1174.2 +045400* THIS TEST WRITES A RECORD FROM AN IDENTIFIER WHICH IS SQ1174.2 +045500* LARGER THAN THE SIZE OF THE FILE RECORD. THE RIGHTMOST 7 SQ1174.2 +045600* CHARACTERS SHOULD BE TRUNCATED IN THE OUTPUT RECORD. SQ1174.2 +045700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +045800 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +045900 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +046000 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +046100 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +046200 MOVE WRITE-FROM-AREA4 TO AREA3-1. SQ1174.2 +046300 MOVE "ABCDEFG" TO AREA3-2. SQ1174.2 +046400 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA3. SQ1174.2 +046500 IF COUNT-OF-RECS EQUAL TO 100 SQ1174.2 +046600 GO TO WRITE-INIT-GF-03-A. SQ1174.2 +046700 GO TO WRITE-INIT-GF-02-A. SQ1174.2 +046800 WRITE-INIT-GF-03-A. SQ1174.2 +046900* THIS TEST WRITES A RECORD FROM AN IDENTIFIER OF 87 SQ1174.2 +047000* CHARACTERS LENGTH. IN THE OUTPUT RECORD CHARACTERS 88 SQ1174.2 +047100* THROUGH 141 SHOULD BE BLANK. ONLY THE NUMBER OF CHARACTERS SQ1174.2 +047200* IN THE FROM IDENTIFIER SHOULD BE MOVED TO THE OUTPUT RECORD. SQ1174.2 +047300* THE CHARACTERS IN THE AREA FOLLOWING IDENTIFIER SQ1174.2 +047400* ARE NOT MOVED INTO THE OUTPUT AREA. SQ1174.2 +047500 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +047600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +047700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA1-1. SQ1174.2 +047800 MOVE "ZXYUVST" TO FOLLOWS-AREA1. SQ1174.2 +047900 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA1. SQ1174.2 +048000 IF COUNT-OF-RECS EQUAL TO 150 SQ1174.2 +048100 GO TO WRITE-INIT-GF-04-A. SQ1174.2 +048200 GO TO WRITE-INIT-GF-03-A. SQ1174.2 +048300 WRITE-INIT-GF-04-A. SQ1174.2 +048400* THIS TEST WRITES A RECORD FROM AN IDENTIFIER OF 120 SQ1174.2 +048500* CHARACTERS. THE LAST 21 CHARACTERS IN THE FD RECORD AREA SQ1174.2 +048600* ARE SET TO JUNK WHICH SHOULD BE REPLACED WITH BLANKS DURING SQ1174.2 +048700* THE WRITE...FROM STATEMENT. THE IDENTIFIER IS LEVEL 02. SQ1174.2 +048800 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +048900 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +049000 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-1. SQ1174.2 +049100 MOVE "AREA SHOULD BE BLANK" TO SQ-FS9R1-PART2. SQ1174.2 +049200 WRITE SQ-FS9R1-F-G-141 FROM AREA2-1. SQ1174.2 +049300 IF COUNT-OF-RECS EQUAL TO 200 SQ1174.2 +049400 GO TO WRITE-INIT-GF-05-A. SQ1174.2 +049500 GO TO WRITE-INIT-GF-04-A. SQ1174.2 +049600 WRITE-INIT-GF-05-A. SQ1174.2 +049700* THIS TEST WRITES A RECORD OF 121 CHARACTERS FROM A SQ1174.2 +049800* SUBSCRIPTED DATA ITEM. THE LAST 21 CHARACTERS IN THE FD SQ1174.2 +049900* RECORD AREA ARE SET TO JUNK WHICH SHOULD BE REPLACED WITH SQ1174.2 +050000* BLANKS DURING THE WRITE...FROM STATEMENT. IDENT IS LEVEL 05. SQ1174.2 +050100 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +050200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +050300 MOVE "AREA SHOULD BE BLANK" TO SQ-FS9R1-PART2. SQ1174.2 +050400 WRITE SQ-FS9R1-F-G-141 FROM FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +050500 IF COUNT-OF-RECS EQUAL TO 250 SQ1174.2 +050600 GO TO WRITE-INIT-GF-06-A. SQ1174.2 +050700 GO TO WRITE-INIT-GF-05-A. SQ1174.2 +050800 WRITE-INIT-GF-06-A. SQ1174.2 +050900* THIS TEST WRITES RECORDS FROM AN IDENTIFIER THE SAME SQ1174.2 +051000* SIZE AS THE OUTPUT RECORD AREA. SQ1174.2 +051100 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +051200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +051300 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +051400 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +051500 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +051600 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA4. SQ1174.2 +051700 IF COUNT-OF-RECS EQUAL TO 493 SQ1174.2 +051800 GO TO WRITE-FROM-CLOSE. SQ1174.2 +051900 GO TO WRITE-INIT-GF-06-A. SQ1174.2 +052000 WRITE-FROM-CLOSE. SQ1174.2 +052100 CLOSE SQ-FS9. SQ1174.2 +052200 MOVE 0 TO ERROR-FLAG. SQ1174.2 +052300 MOVE 0 TO COUNT-OF-RECS. SQ1174.2 +052400 WRITE-INIT-GF-02. SQ1174.2 +052500 OPEN INPUT SQ-FS9. SQ1174.2 +052600 WRITE-TEST-GF-02. SQ1174.2 +052700 IF COUNT-OF-RECS EQUAL TO 50 SQ1174.2 +052800 GO TO WRITE-TEST-GF-02-1. SQ1174.2 +052900 READ SQ-FS9 RECORD SQ1174.2 +053000 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +053100 MOVE 1 TO EOF-FLAG SQ1174.2 +053200 GO TO WRITE-FAIL-GF-02. SQ1174.2 +053300 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +053400 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +053500 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +053600 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +053700 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +053800 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +053900 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +054100 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +054300 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +054500 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054600 GO TO WRITE-TEST-GF-02. SQ1174.2 +054700 WRITE-FAIL-GF-02-1. SQ1174.2 +054800 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +054900 MOVE 1 TO ERROR-FLAG. SQ1174.2 +055000 GO TO WRITE-TEST-GF-02. SQ1174.2 +055100 WRITE-TEST-GF-02-1. SQ1174.2 +055200 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +055300 GO TO WRITE-PASS-GF-02. SQ1174.2 +055400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +055500 WRITE-FAIL-GF-02. SQ1174.2 +055600 MOVE "VII-53; 4.7.3 (3) LARGER RECORDS:TRUNCATED "SQ1174.2 +055700 TO RE-MARK. SQ1174.2 +055800 PERFORM FAIL. SQ1174.2 +055900 GO TO WRITE-WRITE-GF-02. SQ1174.2 +056000 WRITE-PASS-GF-02. SQ1174.2 +056100 PERFORM PASS. SQ1174.2 +056200 WRITE-WRITE-GF-02. SQ1174.2 +056300 MOVE "WRITE .. FROM LARGER" TO FEATURE. SQ1174.2 +056400 MOVE "WRTE-TEST-GF-02" TO PAR-NAME. SQ1174.2 +056500 PERFORM PRINT-DETAIL. SQ1174.2 +056600 WRITE-INIT-GF-03. SQ1174.2 +056700 MOVE 0 TO ERROR-FLAG. SQ1174.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +056900 GO TO SEQ-EOF-22. SQ1174.2 +057000 MOVE "WRTE-TEST-GF-03" TO PAR-NAME. SQ1174.2 +057100 MOVE "WRITE ... FROP SHORTER" TO FEATURE. SQ1174.2 +057200 WRITE-TEST-GF-03. SQ1174.2 +057300 IF COUNT-OF-RECS EQUAL TO 100 SQ1174.2 +057400 GO TO WRITE-TEST-GF-03-1. SQ1174.2 +057500 READ SQ-FS9 RECORD SQ1174.2 +057600 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +057700 MOVE 1 TO EOF-FLAG SQ1174.2 +057800 GO TO WRITE-FAIL-GF-03. SQ1174.2 +057900 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +058000 MOVE SPACE TO AREA3-2. SQ1174.2 +058100 MOVE SQ-FS9R1-F-G-141 TO WRITE-FROM-AREA3. SQ1174.2 +058200 IF AREA3-2 NOT EQUAL TO SPACE SQ1174.2 +058300 MOVE "NO TRUNCATION" TO RE-MARK SQ1174.2 +058400 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +058500 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +058600 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +058700 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +058800 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +058900 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +059000 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059100 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +059200 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +059400 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059500 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +059600 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059700 GO TO WRITE-TEST-GF-03. SQ1174.2 +059800 WRITE-FAIL-GF-03-1. SQ1174.2 +059900 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +060000 MOVE 1 TO ERROR-FLAG. SQ1174.2 +060100 GO TO WRITE-TEST-GF-03. SQ1174.2 +060200 WRITE-TEST-GF-03-1. SQ1174.2 +060300 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +060400 GO TO WRITE-PASS-GF-03. SQ1174.2 +060500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +060600 WRITE-FAIL-GF-03. SQ1174.2 +060700 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +060800 TO RE-MARK. SQ1174.2 +060900 PERFORM FAIL. SQ1174.2 +061000 GO TO WRITE-WRITE-GF-03. SQ1174.2 +061100 WRITE-PASS-GF-03. SQ1174.2 +061200 PERFORM PASS. SQ1174.2 +061300 WRITE-WRITE-GF-03. SQ1174.2 +061400 PERFORM PRINT-DETAIL. SQ1174.2 +061500 WRITE-INIT-GF-04. SQ1174.2 +061600 MOVE 0 TO ERROR-FLAG. SQ1174.2 +061700 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +061800 GO TO SEQ-EOF-22. SQ1174.2 +061900 MOVE "WRTE-TEST-GF-04" TO PAR-NAME. SQ1174.2 +062000 WRITE-TEST-GF-04. SQ1174.2 +062100 IF COUNT-OF-RECS EQUAL TO 150 SQ1174.2 +062200 GO TO WRITE-TEST-GF-04-1. SQ1174.2 +062300 READ SQ-FS9 RECORD SQ1174.2 +062400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +062500 MOVE 1 TO EOF-FLAG SQ1174.2 +062600 GO TO WRITE-FAIL-GF-04. SQ1174.2 +062700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +062800 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +062900 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063000 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063100 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +063200 IF CHARS-OR-RECORDS (1) NOT EQUAL TO SPACE SQ1174.2 +063300 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063400 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063500 IF XLABEL-TYPE (1) NOT EQUAL TO SPACE SQ1174.2 +063600 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063700 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063800 IF XFILE-NAME (1) NOT EQUAL "SQ-FS9" SQ1174.2 +063900 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +064000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +064100 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +064200 GO TO WRITE-TEST-GF-04. SQ1174.2 +064300 WRITE-FAIL-GF-04-1. SQ1174.2 +064400 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +064500 MOVE 1 TO ERROR-FLAG. SQ1174.2 +064600 GO TO WRITE-TEST-GF-04. SQ1174.2 +064700 WRITE-TEST-GF-04-1. SQ1174.2 +064800 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +064900 GO TO WRITE-PASS-GF-04. SQ1174.2 +065000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +065100 WRITE-FAIL-GF-04. SQ1174.2 +065200 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +065300 TO RE-MARK. SQ1174.2 +065400 PERFORM FAIL. SQ1174.2 +065500 GO TO WRITE-WRITE-GF-04. SQ1174.2 +065600 WRITE-PASS-GF-04. SQ1174.2 +065700 PERFORM PASS. SQ1174.2 +065800 WRITE-WRITE-GF-04. SQ1174.2 +065900 MOVE "WRITE ... FROM 02 SHORT RECS" TO FEATURE. SQ1174.2 +066000 PERFORM PRINT-DETAIL. SQ1174.2 +066100 WRITE-INIT-GF-05. SQ1174.2 +066200 MOVE 0 TO ERROR-FLAG. SQ1174.2 +066300 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +066400 GO TO SEQ-EOF-22. SQ1174.2 +066500 MOVE "WRTE-TEST-GF-05" TO PAR-NAME. SQ1174.2 +066600 WRITE-TEST-GF-05. SQ1174.2 +066700 IF COUNT-OF-RECS EQUAL TO 200 SQ1174.2 +066800 GO TO WRITE-TEST-GF-05-1. SQ1174.2 +066900 READ SQ-FS9 RECORD SQ1174.2 +067000 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +067100 MOVE 1 TO EOF-FLAG SQ1174.2 +067200 GO TO WRITE-FAIL-GF-05. SQ1174.2 +067300 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +067400 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +067500 MOVE "NOT BLANK FILLED" TO RE-MARK SQ1174.2 +067600 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +067700 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +067800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +067900 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +068100 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068200 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +068300 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068400 GO TO WRITE-TEST-GF-05. SQ1174.2 +068500 WRITE-FAIL-GF-05-1. SQ1174.2 +068600 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +068700 MOVE 1 TO ERROR-FLAG. SQ1174.2 +068800 GO TO WRITE-TEST-GF-05. SQ1174.2 +068900 WRITE-TEST-GF-05-1. SQ1174.2 +069000 IF ERROR-FLAG EQUAL TO 0 SQ1174.2 +069100 GO TO WRITE-PASS-GF-05. SQ1174.2 +069200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +069300 WRITE-FAIL-GF-05. SQ1174.2 +069400 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +069500 TO RE-MARK. SQ1174.2 +069600 PERFORM FAIL. SQ1174.2 +069700 GO TO WRITE-WRITE-GF-05. SQ1174.2 +069800 WRITE-PASS-GF-05. SQ1174.2 +069900 PERFORM PASS. SQ1174.2 +070000 WRITE-WRITE-GF-05. SQ1174.2 +070100 MOVE "WRITE .. FROM SHORT SUBSC 02" TO FEATURE. SQ1174.2 +070200 PERFORM PRINT-DETAIL. SQ1174.2 +070300 WRITE-INIT-GF-06. SQ1174.2 +070400 MOVE 0 TO ERROR-FLAG. SQ1174.2 +070500 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +070600 GO TO SEQ-EOF-22. SQ1174.2 +070700 MOVE "WRTE-TEST-GF-06" TO PAR-NAME. SQ1174.2 +070800 WRITE-TEST-GF-06. SQ1174.2 +070900 IF COUNT-OF-RECS EQUAL TO 250 SQ1174.2 +071000 GO TO WRITE-TEST-GF-06-1. SQ1174.2 +071100 READ SQ-FS9 RECORD SQ1174.2 +071200 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +071300 MOVE 1 TO EOF-FLAG SQ1174.2 +071400 GO TO WRITE-FAIL-GF-06. SQ1174.2 +071500 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +071600 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +071700 MOVE "NOT BLANK FILLED" TO RE-MARK SQ1174.2 +071800 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +071900 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +072000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +072100 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +072300 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +072500 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072600 GO TO WRITE-TEST-GF-06. SQ1174.2 +072700 WRITE-FAIL-GF-06-1. SQ1174.2 +072800 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +072900 MOVE 1 TO ERROR-FLAG. SQ1174.2 +073000 GO TO WRITE-TEST-GF-06. SQ1174.2 +073100 WRITE-TEST-GF-06-1. SQ1174.2 +073200 IF ERROR-FLAG EQUAL TO 0 SQ1174.2 +073300 GO TO WRITE-PASS-GF-06. SQ1174.2 +073400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +073500 WRITE-FAIL-GF-06. SQ1174.2 +073600 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +073700 TO RE-MARK. SQ1174.2 +073800 PERFORM FAIL. SQ1174.2 +073900 GO TO WRITE-WRITE-GF-06. SQ1174.2 +074000 WRITE-PASS-GF-06. SQ1174.2 +074100 PERFORM PASS. SQ1174.2 +074200 WRITE-WRITE-GF-06. SQ1174.2 +074300 MOVE "WRITE .. FROM SHORT SUBSC 05 " TO FEATURE. SQ1174.2 +074400 PERFORM PRINT-DETAIL. SQ1174.2 +074500 WRITE-INIT-GF-07. SQ1174.2 +074600 MOVE 0 TO ERROR-FLAG. SQ1174.2 +074700 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +074800 GO TO SEQ-EOF-22. SQ1174.2 +074900 MOVE "WRTE-TEST-GF-07" TO PAR-NAME. SQ1174.2 +075000 WRITE-TEST-GF-07. SQ1174.2 +075100 IF COUNT-OF-RECS EQUAL TO 493 SQ1174.2 +075200 GO TO WRITE-TEST-GF-07-1. SQ1174.2 +075300 READ SQ-FS9 RECORD SQ1174.2 +075400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +075500 MOVE 1 TO EOF-FLAG SQ1174.2 +075600 GO TO WRITE-FAIL-GF-07. SQ1174.2 +075700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +075800 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +075900 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +076000 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +076100 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076200 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +076300 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +076500 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076600 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +076700 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076800 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +076900 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +077000 GO TO WRITE-TEST-GF-07. SQ1174.2 +077100 WRITE-FAIL-GF-07-1. SQ1174.2 +077200 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +077300 MOVE 1 TO ERROR-FLAG. SQ1174.2 +077400 GO TO WRITE-TEST-GF-07. SQ1174.2 +077500 WRITE-TEST-GF-07-1. SQ1174.2 +077600 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +077700 GO TO WRITE-PASS-GF-07. SQ1174.2 +077800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +077900 WRITE-FAIL-GF-07. SQ1174.2 +078000 MOVE "VII-53; 4.7.3 (3) SAME SIZE" TO RE-MARK. SQ1174.2 +078100 PERFORM FAIL. SQ1174.2 +078200 GO TO WRITE-WRITE-GF-07. SQ1174.2 +078300 WRITE-PASS-GF-07. SQ1174.2 +078400 PERFORM PASS. SQ1174.2 +078500 WRITE-WRITE-GF-07. SQ1174.2 +078600 MOVE "WRITE .. FROM SAME SIZE" TO FEATURE. SQ1174.2 +078700 PERFORM PRINT-DETAIL. SQ1174.2 +078800 SEQ-TEST-022. SQ1174.2 +078900 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +079000 GO TO SEQ-EOF-22. SQ1174.2 +079100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1174.2 +079200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1174.2 +079300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1174.2 +079400 GO TO SEQ-FAIL-22. SQ1174.2 +079500 READ SQ-FS9 RECORD SQ1174.2 +079600 AT END PERFORM PASS SQ1174.2 +079700 GO TO SEQ-WRITE-22. SQ1174.2 +079800 MOVE "MORE THAN 493 RECORDS" TO RE-MARK. SQ1174.2 +079900 GO TO SEQ-FAIL-22. SQ1174.2 +080000 SEQ-EOF-22. SQ1174.2 +080100 MOVE "LESS THAN 493 RECORDS" TO RE-MARK. SQ1174.2 +080200 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1174.2 +080300 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1174.2 +080400 SEQ-FAIL-22. SQ1174.2 +080500 MOVE "VII-52; 4.7.2 (3) " TO RE-MARK.SQ1174.2 +080600 PERFORM FAIL. SQ1174.2 +080700 SEQ-WRITE-22. SQ1174.2 +080800 MOVE "READ FILE SQ-FS9" TO FEATURE. SQ1174.2 +080900 MOVE "SEQ-TEST-022" TO PAR-NAME. SQ1174.2 +081000 PERFORM PRINT-DETAIL. SQ1174.2 +081100 SEQ-CLOSE-22. SQ1174.2 +081200 CLOSE SQ-FS9. SQ1174.2 +081300 TERMINATE-ROUTINE. SQ1174.2 +081400 EXIT. SQ1174.2 +081500 CCVS-EXIT SECTION. SQ1174.2 +081600 CCVS-999999. SQ1174.2 +081700 GO TO CLOSE-FILES. SQ1174.2 +*END-OF,SQ117A +*HEADER,COBOL,SQ121A +000100 IDENTIFICATION DIVISION. SQ1214.2 +000200 PROGRAM-ID. SQ1214.2 +000300 SQ121A. SQ1214.2 +000400**************************************************************** SQ1214.2 +000500* * SQ1214.2 +000600* VALIDATION FOR:- * SQ1214.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1214.2 +000800* * SQ1214.2 +000900* CREATION DATE / VALIDATION DATE * SQ1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1214.2 +001100* * SQ1214.2 +001200**************************************************************** SQ1214.2 +001300 SQ1214.2 +001400* THE ROUTINE SQ121A TESTS THE USE OF THE USE AFTER ERROR SQ1214.2 +001500* PROCEDURE ON I-O. SQ121A IS BASICALLY A REWRITE OF SQ115A SQ1214.2 +001600* WITH THE ADDITION OF THE USE PROCEDURE. SQ1214.2 +001700* THIS ROUTINE CREATES A MASS STORAGE FILE CONTAINING SQ1214.2 +001800* 550 RECORDS. EACH RECORD CONTAINS 126 CHARACTERS. THE SQ1214.2 +001900* FILE IS CLOSED AND OPENED AS AN INPUT-OUTPUT FILE. EVERY SQ1214.2 +002000* TENTH RECORD IS REWRITTEN. THE FILE IS CLOSED AND OPENED SQ1214.2 +002100* AGAIN AS AN INPUT FILE. FIELDS IN EACH RECORD ARE CHECKED SQ1214.2 +002200* TO ENSURE THAT THE RECORDS REWRITTEN ARE CORRECT AND THAT SQ1214.2 +002300* THE RECORDS WHICH WERE NOT UPDATED WERE NOT CHANGED. SQ1214.2 +002400* THE READ STATEMENT WITHIN THE REWRITE SECTION OF SQ121A DOES SQ1214.2 +002500* NOT HAVE AN AT END CLAUSE. EOF PROCESSING IS HANDLED BY SQ1214.2 +002600* SETTING AN EOF-FLAG IN THE DECLARATIVE SECTION. ANY SQ1214.2 +002700* PERMANENT ERRORS ENCOUNTERED DURING THE REWRITE OF SQ-FS5 SQ1214.2 +002800* ARE TREATED AS INFORMATION ITEMS. SQ1214.2 +002900* SQ1214.2 +003000* USED X-CARDS: SQ1214.2 +003100* XXXXX014 SQ1214.2 +003200* XXXXX055 SQ1214.2 +003300* P XXXXX062 SQ1214.2 +003400* XXXXX082 SQ1214.2 +003500* XXXXX083 SQ1214.2 +003600* C XXXXX084 SQ1214.2 +003700* SQ1214.2 +003800* SQ1214.2 +003900 ENVIRONMENT DIVISION. SQ1214.2 +004000 CONFIGURATION SECTION. SQ1214.2 +004100 SOURCE-COMPUTER. SQ1214.2 +004200 XXXXX082. SQ1214.2 +004300 OBJECT-COMPUTER. SQ1214.2 +004400 XXXXX083. SQ1214.2 +004500 INPUT-OUTPUT SECTION. SQ1214.2 +004600 FILE-CONTROL. SQ1214.2 +004700P SELECT RAW-DATA ASSIGN TO SQ1214.2 +004800P XXXXX062 SQ1214.2 +004900P ORGANIZATION IS INDEXED SQ1214.2 +005000P ACCESS MODE IS RANDOM SQ1214.2 +005100P RECORD KEY IS RAW-DATA-KEY. SQ1214.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ1214.2 +005300 XXXXX055. SQ1214.2 +005400 SELECT SQ-FS5 ASSIGN SQ1214.2 +005500 XXXXX014 SQ1214.2 +005600 ORGANIZATION SEQUENTIAL SQ1214.2 +005700 ACCESS MODE SEQUENTIAL SQ1214.2 +005800 FILE STATUS IS STAT-GROUP. SQ1214.2 +005900 DATA DIVISION. SQ1214.2 +006000 FILE SECTION. SQ1214.2 +006100P SQ1214.2 +006200PFD RAW-DATA. SQ1214.2 +006300P SQ1214.2 +006400P01 RAW-DATA-SATZ. SQ1214.2 +006500P 05 RAW-DATA-KEY PIC X(6). SQ1214.2 +006600P 05 C-DATE PIC 9(6). SQ1214.2 +006700P 05 C-TIME PIC 9(8). SQ1214.2 +006800P 05 C-NO-OF-TESTS PIC 99. SQ1214.2 +006900P 05 C-OK PIC 999. SQ1214.2 +007000P 05 C-ALL PIC 999. SQ1214.2 +007100P 05 C-FAIL PIC 999. SQ1214.2 +007200P 05 C-DELETED PIC 999. SQ1214.2 +007300P 05 C-INSPECT PIC 999. SQ1214.2 +007400P 05 C-NOTE PIC X(13). SQ1214.2 +007500P 05 C-INDENT PIC X. SQ1214.2 +007600P 05 C-ABORT PIC X(8). SQ1214.2 +007700 FD PRINT-FILE SQ1214.2 +007800C LABEL RECORDS SQ1214.2 +007900C XXXXX084 SQ1214.2 +008000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1214.2 +008100 . SQ1214.2 +008200 01 PRINT-REC PICTURE X(120). SQ1214.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ1214.2 +008400 FD SQ-FS5 SQ1214.2 +008500C LABEL RECORD STANDARD SQ1214.2 +008600 . SQ1214.2 +008700 01 SQ-FS5R1-F-G-126. SQ1214.2 +008800 02 SQ-FS5-120 PICTURE X(120). SQ1214.2 +008900 02 SQ-FS5-UPDATE PICTURE X(6). SQ1214.2 +009000 WORKING-STORAGE SECTION. SQ1214.2 +009100 01 COUNT-OF-RECORDS PIC S9(5) COMPUTATIONAL. SQ1214.2 +009200 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1214.2 +009300 01 ERROR-FLAG PIC 9. SQ1214.2 +009400 01 STAT-GROUP. SQ1214.2 +009500 02 INPUT-STAT1 PIC X. SQ1214.2 +009600 02 INPUT-STAT2 PIC X. SQ1214.2 +009700 01 EOF-FLAG PIC 9 VALUE 0. SQ1214.2 +009800 01 PERM-ERRORS PIC 9 VALUE 0. SQ1214.2 +009900 01 LOOP-COUNT PIC 99. SQ1214.2 +010000 01 FILE-RECORD-INFORMATION-REC. SQ1214.2 +010100 03 FILE-RECORD-INFO-SKELETON. SQ1214.2 +010200 05 FILLER PICTURE X(48) VALUE SQ1214.2 +010300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1214.2 +010400 05 FILLER PICTURE X(46) VALUE SQ1214.2 +010500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1214.2 +010600 05 FILLER PICTURE X(26) VALUE SQ1214.2 +010700 ",LFIL=000000,ORG= ,LBLR= ". SQ1214.2 +010800 05 FILLER PICTURE X(37) VALUE SQ1214.2 +010900 ",RECKEY= ". SQ1214.2 +011000 05 FILLER PICTURE X(38) VALUE SQ1214.2 +011100 ",ALTKEY1= ". SQ1214.2 +011200 05 FILLER PICTURE X(38) VALUE SQ1214.2 +011300 ",ALTKEY2= ". SQ1214.2 +011400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1214.2 +011500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1214.2 +011600 05 FILE-RECORD-INFO-P1-120. SQ1214.2 +011700 07 FILLER PIC X(5). SQ1214.2 +011800 07 XFILE-NAME PIC X(6). SQ1214.2 +011900 07 FILLER PIC X(8). SQ1214.2 +012000 07 XRECORD-NAME PIC X(6). SQ1214.2 +012100 07 FILLER PIC X(1). SQ1214.2 +012200 07 REELUNIT-NUMBER PIC 9(1). SQ1214.2 +012300 07 FILLER PIC X(7). SQ1214.2 +012400 07 XRECORD-NUMBER PIC 9(6). SQ1214.2 +012500 07 FILLER PIC X(6). SQ1214.2 +012600 07 UPDATE-NUMBER PIC 9(2). SQ1214.2 +012700 07 FILLER PIC X(5). SQ1214.2 +012800 07 ODO-NUMBER PIC 9(4). SQ1214.2 +012900 07 FILLER PIC X(5). SQ1214.2 +013000 07 XPROGRAM-NAME PIC X(5). SQ1214.2 +013100 07 FILLER PIC X(7). SQ1214.2 +013200 07 XRECORD-LENGTH PIC 9(6). SQ1214.2 +013300 07 FILLER PIC X(7). SQ1214.2 +013400 07 CHARS-OR-RECORDS PIC X(2). SQ1214.2 +013500 07 FILLER PIC X(1). SQ1214.2 +013600 07 XBLOCK-SIZE PIC 9(4). SQ1214.2 +013700 07 FILLER PIC X(6). SQ1214.2 +013800 07 RECORDS-IN-FILE PIC 9(6). SQ1214.2 +013900 07 FILLER PIC X(5). SQ1214.2 +014000 07 XFILE-ORGANIZATION PIC X(2). SQ1214.2 +014100 07 FILLER PIC X(6). SQ1214.2 +014200 07 XLABEL-TYPE PIC X(1). SQ1214.2 +014300 05 FILE-RECORD-INFO-P121-240. SQ1214.2 +014400 07 FILLER PIC X(8). SQ1214.2 +014500 07 XRECORD-KEY PIC X(29). SQ1214.2 +014600 07 FILLER PIC X(9). SQ1214.2 +014700 07 ALTERNATE-KEY1 PIC X(29). SQ1214.2 +014800 07 FILLER PIC X(9). SQ1214.2 +014900 07 ALTERNATE-KEY2 PIC X(29). SQ1214.2 +015000 07 FILLER PIC X(7). SQ1214.2 +015100 01 TEST-RESULTS. SQ1214.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1214.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1214.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015700 02 PAR-NAME. SQ1214.2 +015800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1214.2 +015900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1214.2 +016000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1214.2 +016100 03 FILLER PIC X(5) VALUE SPACE. SQ1214.2 +016200 02 FILLER PIC X(10) VALUE SPACE. SQ1214.2 +016300 02 RE-MARK PIC X(61). SQ1214.2 +016400 01 TEST-COMPUTED. SQ1214.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1214.2 +016600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1214.2 +016700 02 COMPUTED-X. SQ1214.2 +016800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1214.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1214.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1214.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1214.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1214.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1214.2 +017400 04 COMPUTED-18V0 PICTURE -9(18). SQ1214.2 +017500 04 FILLER PICTURE X. SQ1214.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1214.2 +017700 01 TEST-CORRECT. SQ1214.2 +017800 02 FILLER PIC X(30) VALUE SPACE. SQ1214.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1214.2 +018000 02 CORRECT-X. SQ1214.2 +018100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1214.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1214.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1214.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1214.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1214.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. SQ1214.2 +018700 04 CORRECT-18V0 PICTURE -9(18). SQ1214.2 +018800 04 FILLER PICTURE X. SQ1214.2 +018900 03 FILLER PIC X(50) VALUE SPACE. SQ1214.2 +019000 01 CCVS-C-1. SQ1214.2 +019100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1214.2 +019200- "SS PARAGRAPH-NAME SQ1214.2 +019300- " REMARKS". SQ1214.2 +019400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1214.2 +019500 01 CCVS-C-2. SQ1214.2 +019600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +019700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1214.2 +019800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1214.2 +019900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1214.2 +020000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1214.2 +020100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1214.2 +020200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1214.2 +020300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1214.2 +020400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1214.2 +020500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1214.2 +020600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1214.2 +020700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1214.2 +020800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1214.2 +020900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1214.2 +021000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1214.2 +021100 01 CCVS-H-1. SQ1214.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1214.2 +021300 02 FILLER PICTURE X(67) VALUE SQ1214.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1214.2 +021500- " SYSTEM". SQ1214.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1214.2 +021700 01 CCVS-H-2. SQ1214.2 +021800 02 FILLER PICTURE X(52) VALUE IS SQ1214.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1214.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1214.2 +022100 02 TEST-ID PICTURE IS X(9). SQ1214.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1214.2 +022300 01 CCVS-H-3. SQ1214.2 +022400 02 FILLER PICTURE X(34) VALUE SQ1214.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1214.2 +022600 02 FILLER PICTURE X(58) VALUE SQ1214.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1214.2 +022800 02 FILLER PICTURE X(28) VALUE SQ1214.2 +022900 " COPYRIGHT 1985 ". SQ1214.2 +023000 01 CCVS-E-1. SQ1214.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1214.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1214.2 +023300 02 ID-AGAIN PICTURE IS X(9). SQ1214.2 +023400 02 FILLER PICTURE X(45) VALUE IS SQ1214.2 +023500 " NTIS DISTRIBUTION COBOL 85". SQ1214.2 +023600 01 CCVS-E-2. SQ1214.2 +023700 02 FILLER PICTURE X(31) VALUE SQ1214.2 +023800 SPACE. SQ1214.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1214.2 +024000 02 CCVS-E-2-2. SQ1214.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1214.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1214.2 +024400 01 CCVS-E-3. SQ1214.2 +024500 02 FILLER PICTURE X(22) VALUE SQ1214.2 +024600 " FOR OFFICIAL USE ONLY". SQ1214.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1214.2 +024800 02 FILLER PICTURE X(58) VALUE SQ1214.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1214.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1214.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1214.2 +025200 01 CCVS-E-4. SQ1214.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1214.2 +025400 02 FILLER PIC XXXX VALUE " OF ". SQ1214.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1214.2 +025600 02 FILLER PIC X(40) VALUE SQ1214.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1214.2 +025800 01 XXINFO. SQ1214.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1214.2 +026000 02 INFO-TEXT. SQ1214.2 +026100 04 FILLER PIC X(20) VALUE SPACE. SQ1214.2 +026200 04 XXCOMPUTED PIC X(20). SQ1214.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1214.2 +026400 04 XXCORRECT PIC X(20). SQ1214.2 +026500 01 HYPHEN-LINE. SQ1214.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1214.2 +026800- "*****************************************". SQ1214.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1214.2 +027000- "******************************". SQ1214.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1214.2 +027200 "SQ121A". SQ1214.2 +027300 PROCEDURE DIVISION. SQ1214.2 +027400 DECLARATIVES. SQ1214.2 +027500 SECT-SQ121A-0001 SECTION. SQ1214.2 +027600 USE AFTER STANDARD ERROR PROCEDURE ON I-O. SQ1214.2 +027700 I-O-ERROR-PROCESS. SQ1214.2 +027800 IF INPUT-STAT1 EQUAL TO "1" SQ1214.2 +027900 MOVE 1 TO EOF-FLAG. SQ1214.2 +028000 IF INPUT-STAT1 GREATER THAN "1" SQ1214.2 +028100 MOVE 1 TO PERM-ERRORS. SQ1214.2 +028200 END DECLARATIVES. SQ1214.2 +028300 CCVS1 SECTION. SQ1214.2 +028400 OPEN-FILES. SQ1214.2 +028500P OPEN I-O RAW-DATA. SQ1214.2 +028600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1214.2 +028700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1214.2 +028800P MOVE "ABORTED " TO C-ABORT. SQ1214.2 +028900P ADD 1 TO C-NO-OF-TESTS. SQ1214.2 +029000P ACCEPT C-DATE FROM DATE. SQ1214.2 +029100P ACCEPT C-TIME FROM TIME. SQ1214.2 +029200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1214.2 +029300PEND-E-1. SQ1214.2 +029400P CLOSE RAW-DATA. SQ1214.2 +029500 OPEN OUTPUT PRINT-FILE. SQ1214.2 +029600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1214.2 +029700 MOVE SPACE TO TEST-RESULTS. SQ1214.2 +029800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1214.2 +029900 MOVE ZERO TO REC-SKL-SUB. SQ1214.2 +030000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1214.2 +030100 CCVS-INIT-FILE. SQ1214.2 +030200 ADD 1 TO REC-SKL-SUB. SQ1214.2 +030300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1214.2 +030400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1214.2 +030500 CCVS-INIT-EXIT. SQ1214.2 +030600 GO TO CCVS1-EXIT. SQ1214.2 +030700 CLOSE-FILES. SQ1214.2 +030800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1214.2 +030900P OPEN I-O RAW-DATA. SQ1214.2 +031000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1214.2 +031100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1214.2 +031200P MOVE "OK. " TO C-ABORT. SQ1214.2 +031300P MOVE PASS-COUNTER TO C-OK. SQ1214.2 +031400P MOVE ERROR-HOLD TO C-ALL. SQ1214.2 +031500P MOVE ERROR-COUNTER TO C-FAIL. SQ1214.2 +031600P MOVE DELETE-CNT TO C-DELETED. SQ1214.2 +031700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1214.2 +031800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1214.2 +031900PEND-E-2. SQ1214.2 +032000P CLOSE RAW-DATA. SQ1214.2 +032100 TERMINATE-CCVS. SQ1214.2 +032200S EXIT PROGRAM. SQ1214.2 +032300STERMINATE-CALL. SQ1214.2 +032400 STOP RUN. SQ1214.2 +032500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1214.2 +032600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1214.2 +032700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1214.2 +032800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1214.2 +032900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1214.2 +033000 PRINT-DETAIL. SQ1214.2 +033100 IF REC-CT NOT EQUAL TO ZERO SQ1214.2 +033200 MOVE "." TO PARDOT-X SQ1214.2 +033300 MOVE REC-CT TO DOTVALUE. SQ1214.2 +033400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1214.2 +033500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1214.2 +033600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1214.2 +033700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1214.2 +033800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1214.2 +033900 MOVE SPACE TO CORRECT-X. SQ1214.2 +034000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1214.2 +034100 MOVE SPACE TO RE-MARK. SQ1214.2 +034200 HEAD-ROUTINE. SQ1214.2 +034300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +034400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1214.2 +034500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1214.2 +034600 COLUMN-NAMES-ROUTINE. SQ1214.2 +034700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +034800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +035000 END-ROUTINE. SQ1214.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1214.2 +035200 END-RTN-EXIT. SQ1214.2 +035300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +035400 END-ROUTINE-1. SQ1214.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1214.2 +035600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1214.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1214.2 +035800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1214.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1214.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1214.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1214.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1214.2 +036300 END-ROUTINE-12. SQ1214.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1214.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1214.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1214.2 +036700 ELSE SQ1214.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1214.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1214.2 +037000 PERFORM WRITE-LINE. SQ1214.2 +037100 END-ROUTINE-13. SQ1214.2 +037200 IF DELETE-CNT IS EQUAL TO ZERO SQ1214.2 +037300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1214.2 +037400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1214.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1214.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1214.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1214.2 +037900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1214.2 +038000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1214.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +038200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +038300 WRITE-LINE. SQ1214.2 +038400 ADD 1 TO RECORD-COUNT. SQ1214.2 +038500Y IF RECORD-COUNT GREATER 50 SQ1214.2 +038600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1214.2 +038700Y MOVE SPACE TO DUMMY-RECORD SQ1214.2 +038800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1214.2 +038900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1214.2 +039000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1214.2 +039100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1214.2 +039200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1214.2 +039300Y MOVE ZERO TO RECORD-COUNT. SQ1214.2 +039400 PERFORM WRT-LN. SQ1214.2 +039500 WRT-LN. SQ1214.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1214.2 +039700 MOVE SPACE TO DUMMY-RECORD. SQ1214.2 +039800 BLANK-LINE-PRINT. SQ1214.2 +039900 PERFORM WRT-LN. SQ1214.2 +040000 FAIL-ROUTINE. SQ1214.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1214.2 +040200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1214.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1214.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +040500 GO TO FAIL-ROUTINE-EX. SQ1214.2 +040600 FAIL-ROUTINE-WRITE. SQ1214.2 +040700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1214.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +040900 FAIL-ROUTINE-EX. EXIT. SQ1214.2 +041000 BAIL-OUT. SQ1214.2 +041100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1214.2 +041200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1214.2 +041300 BAIL-OUT-WRITE. SQ1214.2 +041400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1214.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +041600 BAIL-OUT-EX. EXIT. SQ1214.2 +041700 CCVS1-EXIT. SQ1214.2 +041800 EXIT. SQ1214.2 +041900 SECT-SQ-115-0001 SECTION. SQ1214.2 +042000 SEQ-INIT-013. SQ1214.2 +042100 MOVE "SQ-FS5" TO XFILE-NAME (1). SQ1214.2 +042200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1214.2 +042300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1214.2 +042400 MOVE 000126 TO XRECORD-LENGTH (1). SQ1214.2 +042500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1214.2 +042600 MOVE 0001 TO XBLOCK-SIZE (1). SQ1214.2 +042700 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1214.2 +042800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1214.2 +042900 MOVE "S" TO XLABEL-TYPE (1). SQ1214.2 +043000 MOVE 000001 TO XRECORD-NUMBER (1). SQ1214.2 +043100 OPEN OUTPUT SQ-FS5. SQ1214.2 +043200 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +043300 SEQ-TEST-013. SQ1214.2 +043400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1214.2 +043500 MOVE "FIRST " TO SQ-FS5-UPDATE. SQ1214.2 +043600 WRITE SQ-FS5R1-F-G-126. SQ1214.2 +043700 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +043800 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1214.2 +043900 GO TO SEQ-WRITE-013. SQ1214.2 +044000 ADD 1 TO XRECORD-NUMBER (1). SQ1214.2 +044100 GO TO SEQ-TEST-013. SQ1214.2 +044200 SEQ-WRITE-013. SQ1214.2 +044300 MOVE "CREATE FILE SQ-FS5" TO FEATURE. SQ1214.2 +044400 MOVE "SEQ-TEST-013" TO PAR-NAME. SQ1214.2 +044500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1214.2 +044600 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +044700 PERFORM PRINT-DETAIL. SQ1214.2 +044800 CLOSE SQ-FS5. SQ1214.2 +044900* A SEQUENTIAL MASS STORAGE FILE WITH 126 CHARACTER SQ1214.2 +045000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1214.2 +045100 SEQ-INIT-014. SQ1214.2 +045200 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +045300* THIS TEST READS AND CHECKS THE FILE CREATED SQ1214.2 +045400* IN SEQ-TEST-013. SQ1214.2 +045500 OPEN INPUT SQ-FS5. SQ1214.2 +045600 SEQ-TEST-014. SQ1214.2 +045700 READ SQ-FS5 AT END SQ1214.2 +045800 GO TO SEQ-TEST-014-1. SQ1214.2 +045900 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +046000 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +046100 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1214.2 +046200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1214.2 +046300 GO TO SEQ-FAIL-014. SQ1214.2 +046400 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) SQ1214.2 +046500 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +046600 GO TO SEQ-TEST-014. SQ1214.2 +046700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1214.2 +046800 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +046900 GO TO SEQ-TEST-014. SQ1214.2 +047000 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1214.2 +047100 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +047200 GO TO SEQ-TEST-014. SQ1214.2 +047300 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1214.2 +047400 GO TO SEQ-TEST-014. SQ1214.2 +047500 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +047600 GO TO SEQ-TEST-014. SQ1214.2 +047700 SEQ-TEST-014-1. SQ1214.2 +047800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1214.2 +047900 GO TO SEQ-PASS-014. SQ1214.2 +048000 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK. SQ1214.2 +048100 SEQ-FAIL-014. SQ1214.2 +048200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1214.2 +048300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1214.2 +048400 PERFORM FAIL. SQ1214.2 +048500 GO TO SEQ-WRITE-014. SQ1214.2 +048600 SEQ-PASS-014. SQ1214.2 +048700 PERFORM PASS. SQ1214.2 +048800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1214.2 +048900 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +049000 SEQ-WRITE-014. SQ1214.2 +049100 MOVE "SEQ-TEST-014" TO PAR-NAME. SQ1214.2 +049200 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1214.2 +049300 PERFORM PRINT-DETAIL. SQ1214.2 +049400 SEQ-CLOSE-014. SQ1214.2 +049500 CLOSE SQ-FS5. SQ1214.2 +049600 REWRITE-INIT-GF-01. SQ1214.2 +049700 OPEN I-O SQ-FS5. SQ1214.2 +049800 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +049900 MOVE ZERO TO EOF-FLAG. SQ1214.2 +050000* THIS TEST REWRITES EVERY TENTH RECORD SQ1214.2 +050100* OF THE FILE SQ-FS5. SQ1214.2 +050200 REWRITE-TEST-GF-01. SQ1214.2 +050300 PERFORM READ-SQ-FS5 THRU READ-SQ-FS5-EXIT 10 TIMES. SQ1214.2 +050400 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +050500 GO TO REWRITE-TEST-GF-01-1. SQ1214.2 +050600 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +050700 ADD 1 TO UPDATE-NUMBER (1). SQ1214.2 +050800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1214.2 +050900 MOVE "SECOND" TO SQ-FS5-UPDATE. SQ1214.2 +051000 REWRITE SQ-FS5R1-F-G-126. SQ1214.2 +051100 GO TO REWRITE-TEST-GF-01. SQ1214.2 +051200 READ-SQ-FS5. SQ1214.2 +051300 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +051400 GO TO READ-SQ-FS5-EXIT. SQ1214.2 +051500 READ SQ-FS5 RECORD. SQ1214.2 +051600 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +051700 GO TO READ-SQ-FS5-EXIT. SQ1214.2 +051800 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +051900 READ-SQ-FS5-EXIT. SQ1214.2 +052000 EXIT. SQ1214.2 +052100 REWRITE-TEST-GF-01-1. SQ1214.2 +052200 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1214.2 +052300 GO TO REWRITE-PASS-GF-01. SQ1214.2 +052400 REWRITE-FAIL-GF-01. SQ1214.2 +052500 MOVE "VII-48 4.5.2 " TO RE-MARK.SQ1214.2 +052600 PERFORM FAIL. SQ1214.2 +052700 MOVE "550 RECORDS SHOULD BE READ" TO RE-MARK. SQ1214.2 +052800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1214.2 +052900 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +053000 GO TO REWRITE-WRITE-GF-01. SQ1214.2 +053100 REWRITE-PASS-GF-01. SQ1214.2 +053200 PERFORM PASS. SQ1214.2 +053300 REWRITE-WRITE-GF-01. SQ1214.2 +053400 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1214.2 +053500 MOVE "REWRITE FILE SQ-FS5" TO FEATURE. SQ1214.2 +053600 PERFORM PRINT-DETAIL. SQ1214.2 +053700 IF PERM-ERRORS EQUAL TO 1 SQ1214.2 +053800 MOVE "PERMANENT ERRORS ENCOUNTERED ON PREVIOUS I-O OPERATION"SQ1214.2 +053900 TO PRINT-REC SQ1214.2 +054000 PERFORM WRITE-LINE. SQ1214.2 +054100 REWRITE-CLOSE-GF-01. SQ1214.2 +054200 CLOSE SQ-FS5. SQ1214.2 +054300 REWRITE-INIT-GF-02. SQ1214.2 +054400 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +054500 MOVE ZERO TO EOF-FLAG. SQ1214.2 +054600 OPEN INPUT SQ-FS5. SQ1214.2 +054700* THIS TEST READS AND CHECKS THE FILE WHICH WAS SQ1214.2 +054800* REWRITTEN IN REWRITE-TEST-01. SQ1214.2 +054900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1214.2 +055000 MOVE ZERO TO LOOP-COUNT. SQ1214.2 +055100 REWRITE-TEST-GF-02. SQ1214.2 +055200 READ SQ-FS5 END SQ1214.2 +055300 MOVE 1 TO EOF-FLAG SQ1214.2 +055400 GO TO REWRITE-TEST-GF-02-2. SQ1214.2 +055500 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +055600 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1214.2 +055700 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1214.2 +055800 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +055900 ADD 1 TO LOOP-COUNT. SQ1214.2 +056000 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +056100 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1214.2 +056200 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +056300 GO TO REWRITE-TEST-GF-02. SQ1214.2 +056400 IF LOOP-COUNT EQUAL TO 10 SQ1214.2 +056500 MOVE ZERO TO LOOP-COUNT SQ1214.2 +056600 GO TO REWRITE-TEST-GF-02-1. SQ1214.2 +056700 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1214.2 +056800 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +056900 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057000 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1214.2 +057100 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057200 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +057300 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057400 REWRITE-TEST-GF-02-1. SQ1214.2 +057500 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1214.2 +057600 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +057700 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057800 IF SQ-FS5-UPDATE EQUAL TO "SECOND" SQ1214.2 +057900 GO TO REWRITE-TEST-GF-02. SQ1214.2 +058000 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +058100 GO TO REWRITE-TEST-GF-02. SQ1214.2 +058200 REWRITE-TEST-GF-02-2. SQ1214.2 +058300 IF COUNT-OF-RECORDS NOT EQUAL TO 550 SQ1214.2 +058400 MOVE "LESS THAN 550 RECORDS" TO RE-MARK SQ1214.2 +058500 MOVE "RECORDS READ =" TO COMPUTED-A SQ1214.2 +058600 MOVE COUNT-OF-RECORDS TO CORRECT-18V0 SQ1214.2 +058700 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +058800 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1214.2 +058900 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK SQ1214.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1214.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1214.2 +059200 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +059300 REWRITE-PASS-GF-02. SQ1214.2 +059400 PERFORM PASS. SQ1214.2 +059500 GO TO REWRITE-WRITE-GF-02. SQ1214.2 +059600 REWRITE-FAIL-GF-02. SQ1214.2 +059700 PERFORM FAIL. SQ1214.2 +059800 REWRITE-WRITE-GF-02. SQ1214.2 +059900 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1214.2 +060000 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1214.2 +060100 PERFORM PRINT-DETAIL. SQ1214.2 +060200 REWRITE-CLOSE-GF-02. SQ1214.2 +060300 CLOSE SQ-FS5. SQ1214.2 +060400 TERMINATE-ROUTINE. SQ1214.2 +060500 EXIT. SQ1214.2 +060600 CCVS-EXIT SECTION. SQ1214.2 +060700 CCVS-999999. SQ1214.2 +060800 GO TO CLOSE-FILES. SQ1214.2 +*END-OF,SQ121A +*HEADER,COBOL,SQ122A +000100 IDENTIFICATION DIVISION. SQ1224.2 +000200 PROGRAM-ID. SQ1224.2 +000300 SQ122A. SQ1224.2 +000400**************************************************************** SQ1224.2 +000500* * SQ1224.2 +000600* VALIDATION FOR:- * SQ1224.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +000800* USING CCVS85 VERSION 3.1 * SQ1224.2 +000900* * SQ1224.2 +001000* CREATION DATE / VALIDATION DATE * SQ1224.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1224.2 +001200* * SQ1224.2 +001300**************************************************************** SQ1224.2 +001400* * SQ1224.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1224.2 +001600* * SQ1224.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1224.2 +001800* X-55 SYSTEM PRINTER * SQ1224.2 +001900* X-82 SOURCE-COMPUTER * SQ1224.2 +002000* X-83 OBJECT-COMPUTER * SQ1224.2 +002100* X-84 LABEL RECORDS OPTION * SQ1224.2 +002200* * SQ1224.2 +002300**************************************************************** SQ1224.2 +002400* * SQ1224.2 +002500* A ONE RECORD FILE WITH TWO CHARACTERS PER BLOCK IS CREATED* SQ1224.2 +002600* WITH THE INTENTION THAT IT SHOULD END PART-WAY THROUGH A * SQ1224.2 +002700* BLOCK. THE FILE IS RE-OPENED AND * SQ1224.2 +002800* THREE READ STATEMENTS EXECUTED. THE FIRST SHOULD BE * SQ1224.2 +002900* EXECUTED SUCCESSFULLY, THE SECOND RAISE THE AT END * SQ1224.2 +003000* CONDITION, AND THE THIRD, WHICH IS A READ AFTER END OF * SQ1224.2 +003100* FILE, SHOULD CAUSE THE I-O STATUS CODE 46. * SQ1224.2 +003200* * SQ1224.2 +003300**************************************************************** SQ1224.2 +003400* SQ1224.2 +003500 ENVIRONMENT DIVISION. SQ1224.2 +003600 CONFIGURATION SECTION. SQ1224.2 +003700 SOURCE-COMPUTER. SQ1224.2 +003800 XXXXX082. SQ1224.2 +003900 OBJECT-COMPUTER. SQ1224.2 +004000 XXXXX083. SQ1224.2 +004100* SQ1224.2 +004200 INPUT-OUTPUT SECTION. SQ1224.2 +004300 FILE-CONTROL. SQ1224.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1224.2 +004500 XXXXX055. SQ1224.2 +004600* SQ1224.2 +004700 SELECT SQ-FS4 ASSIGN SQ1224.2 +004800 XXXXX014 SQ1224.2 +004900 FILE STATUS IS SQ-FS4-STATUS. SQ1224.2 +005000* SQ1224.2 +005100* SQ1224.2 +005200 DATA DIVISION. SQ1224.2 +005300 FILE SECTION. SQ1224.2 +005400 FD PRINT-FILE SQ1224.2 +005500C LABEL RECORDS SQ1224.2 +005600C XXXXX084 SQ1224.2 +005700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1224.2 +005800 . SQ1224.2 +005900 01 PRINT-REC PICTURE X(120). SQ1224.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1224.2 +006100* SQ1224.2 +006200 FD SQ-FS4 SQ1224.2 +006300C LABEL RECORD IS STANDARD SQ1224.2 +006400 BLOCK 2 RECORDS SQ1224.2 +006500 RECORD 125 SQ1224.2 +006600 . SQ1224.2 +006700 01 SQ-FS4R1-F-G-125. SQ1224.2 +006800 05 SQ-FS4-FIRST PIC X(120). SQ1224.2 +006900 05 SQ-FS4-REC-NO PIC 99999. SQ1224.2 +007000* SQ1224.2 +007100 WORKING-STORAGE SECTION. SQ1224.2 +007200* SQ1224.2 +007300*************************************************************** SQ1224.2 +007400* * SQ1224.2 +007500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1224.2 +007600* * SQ1224.2 +007700*************************************************************** SQ1224.2 +007800* SQ1224.2 +007900 01 SQ-FS4-STATUS. SQ1224.2 +008000 03 SQ-FS4-KEY-1 PIC X. SQ1224.2 +008100 03 SQ-FS4-KEY-2 PIC X. SQ1224.2 +008200* SQ1224.2 +008300*************************************************************** SQ1224.2 +008400* * SQ1224.2 +008500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1224.2 +008600* * SQ1224.2 +008700*************************************************************** SQ1224.2 +008800* SQ1224.2 +008900 01 REC-SKEL-SUB PIC 99. SQ1224.2 +009000* SQ1224.2 +009100 01 FILE-RECORD-INFORMATION-REC. SQ1224.2 +009200 03 FILE-RECORD-INFO-SKELETON. SQ1224.2 +009300 05 FILLER PICTURE X(48) VALUE SQ1224.2 +009400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1224.2 +009500 05 FILLER PICTURE X(46) VALUE SQ1224.2 +009600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1224.2 +009700 05 FILLER PICTURE X(26) VALUE SQ1224.2 +009800 ",LFIL=000000,ORG= ,LBLR= ". SQ1224.2 +009900 05 FILLER PICTURE X(37) VALUE SQ1224.2 +010000 ",RECKEY= ". SQ1224.2 +010100 05 FILLER PICTURE X(38) VALUE SQ1224.2 +010200 ",ALTKEY1= ". SQ1224.2 +010300 05 FILLER PICTURE X(38) VALUE SQ1224.2 +010400 ",ALTKEY2= ". SQ1224.2 +010500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1224.2 +010600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1224.2 +010700 05 FILE-RECORD-INFO-P1-120. SQ1224.2 +010800 07 FILLER PIC X(5). SQ1224.2 +010900 07 XFILE-NAME PIC X(6). SQ1224.2 +011000 07 FILLER PIC X(8). SQ1224.2 +011100 07 XRECORD-NAME PIC X(6). SQ1224.2 +011200 07 FILLER PIC X(1). SQ1224.2 +011300 07 REELUNIT-NUMBER PIC 9(1). SQ1224.2 +011400 07 FILLER PIC X(7). SQ1224.2 +011500 07 XRECORD-NUMBER PIC 9(6). SQ1224.2 +011600 07 FILLER PIC X(6). SQ1224.2 +011700 07 UPDATE-NUMBER PIC 9(2). SQ1224.2 +011800 07 FILLER PIC X(5). SQ1224.2 +011900 07 ODO-NUMBER PIC 9(4). SQ1224.2 +012000 07 FILLER PIC X(5). SQ1224.2 +012100 07 XPROGRAM-NAME PIC X(5). SQ1224.2 +012200 07 FILLER PIC X(7). SQ1224.2 +012300 07 XRECORD-LENGTH PIC 9(6). SQ1224.2 +012400 07 FILLER PIC X(7). SQ1224.2 +012500 07 CHARS-OR-RECORDS PIC X(2). SQ1224.2 +012600 07 FILLER PIC X(1). SQ1224.2 +012700 07 XBLOCK-SIZE PIC 9(4). SQ1224.2 +012800 07 FILLER PIC X(6). SQ1224.2 +012900 07 RECORDS-IN-FILE PIC 9(6). SQ1224.2 +013000 07 FILLER PIC X(5). SQ1224.2 +013100 07 XFILE-ORGANIZATION PIC X(2). SQ1224.2 +013200 07 FILLER PIC X(6). SQ1224.2 +013300 07 XLABEL-TYPE PIC X(1). SQ1224.2 +013400 05 FILE-RECORD-INFO-P121-240. SQ1224.2 +013500 07 FILLER PIC X(8). SQ1224.2 +013600 07 XRECORD-KEY PIC X(29). SQ1224.2 +013700 07 FILLER PIC X(9). SQ1224.2 +013800 07 ALTERNATE-KEY1 PIC X(29). SQ1224.2 +013900 07 FILLER PIC X(9). SQ1224.2 +014000 07 ALTERNATE-KEY2 PIC X(29). SQ1224.2 +014100 07 FILLER PIC X(7). SQ1224.2 +014200* SQ1224.2 +014300 01 TEST-RESULTS. SQ1224.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1224.2 +014500 02 PAR-NAME. SQ1224.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1224.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1224.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1224.2 +014900 02 FILLER PIC X VALUE SPACE. SQ1224.2 +015000 02 FEATURE PIC X(24) VALUE SPACE. SQ1224.2 +015100 02 FILLER PIC X VALUE SPACE. SQ1224.2 +015200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1224.2 +015300 02 FILLER PIC X(9) VALUE SPACE. SQ1224.2 +015400 02 RE-MARK PIC X(61). SQ1224.2 +015500 01 TEST-COMPUTED. SQ1224.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ1224.2 +015700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1224.2 +015800 02 COMPUTED-X. SQ1224.2 +015900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1224.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1224.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1224.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1224.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1224.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1224.2 +016500 04 COMPUTED-18V0 PIC -9(18). SQ1224.2 +016600 04 FILLER PIC X. SQ1224.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ1224.2 +016800 01 TEST-CORRECT. SQ1224.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ1224.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1224.2 +017100 02 CORRECT-X. SQ1224.2 +017200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1224.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1224.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1224.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1224.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1224.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. SQ1224.2 +017800 04 CORRECT-18V0 PIC -9(18). SQ1224.2 +017900 04 FILLER PIC X. SQ1224.2 +018000 03 FILLER PIC X(2) VALUE SPACE. SQ1224.2 +018100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1224.2 +018200* SQ1224.2 +018300 01 CCVS-C-1. SQ1224.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1224.2 +018600 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1224.2 +018800 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1224.2 +019000 02 FILLER PIC IS X(9) VALUE SPACE. SQ1224.2 +019100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1224.2 +019200 01 CCVS-C-2. SQ1224.2 +019300 02 FILLER PIC X(19) VALUE SPACE. SQ1224.2 +019400 02 FILLER PIC X(6) VALUE "TESTED". SQ1224.2 +019500 02 FILLER PIC X(19) VALUE SPACE. SQ1224.2 +019600 02 FILLER PIC X(4) VALUE "FAIL". SQ1224.2 +019700 02 FILLER PIC X(72) VALUE SPACE. SQ1224.2 +019800* SQ1224.2 +019900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1224.2 +020000 01 REC-CT PIC 99 VALUE ZERO. SQ1224.2 +020100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1224.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1224.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1224.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1224.2 +020900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1224.2 +021000 01 CCVS-H-1. SQ1224.2 +021100 02 FILLER PIC X(39) VALUE SPACES. SQ1224.2 +021200 02 FILLER PIC X(42) VALUE SQ1224.2 +021300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1224.2 +021400 02 FILLER PIC X(39) VALUE SPACES. SQ1224.2 +021500 01 CCVS-H-2A. SQ1224.2 +021600 02 FILLER PIC X(40) VALUE SPACE. SQ1224.2 +021700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1224.2 +021800 02 FILLER PIC XXXX VALUE SQ1224.2 +021900 "4.2 ". SQ1224.2 +022000 02 FILLER PIC X(28) VALUE SQ1224.2 +022100 " COPY - NOT FOR DISTRIBUTION". SQ1224.2 +022200 02 FILLER PIC X(41) VALUE SPACE. SQ1224.2 +022300* SQ1224.2 +022400 01 CCVS-H-2B. SQ1224.2 +022500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1224.2 +022600 02 TEST-ID PIC X(9). SQ1224.2 +022700 02 FILLER PIC X(4) VALUE " IN ". SQ1224.2 +022800 02 FILLER PIC X(12) VALUE SQ1224.2 +022900 " HIGH ". SQ1224.2 +023000 02 FILLER PIC X(22) VALUE SQ1224.2 +023100 " LEVEL VALIDATION FOR ". SQ1224.2 +023200 02 FILLER PIC X(58) VALUE SQ1224.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +023400 01 CCVS-H-3. SQ1224.2 +023500 02 FILLER PIC X(34) VALUE SQ1224.2 +023600 " FOR OFFICIAL USE ONLY ". SQ1224.2 +023700 02 FILLER PIC X(58) VALUE SQ1224.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1224.2 +023900 02 FILLER PIC X(28) VALUE SQ1224.2 +024000 " COPYRIGHT 1985,1986 ". SQ1224.2 +024100 01 CCVS-E-1. SQ1224.2 +024200 02 FILLER PIC X(52) VALUE SPACE. SQ1224.2 +024300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1224.2 +024400 02 ID-AGAIN PIC X(9). SQ1224.2 +024500 02 FILLER PIC X(45) VALUE SPACES. SQ1224.2 +024600 01 CCVS-E-2. SQ1224.2 +024700 02 FILLER PIC X(31) VALUE SPACE. SQ1224.2 +024800 02 FILLER PIC X(21) VALUE SPACE. SQ1224.2 +024900 02 CCVS-E-2-2. SQ1224.2 +025000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1224.2 +025100 03 FILLER PIC X VALUE SPACE. SQ1224.2 +025200 03 ENDER-DESC PIC X(44) VALUE SQ1224.2 +025300 "ERRORS ENCOUNTERED". SQ1224.2 +025400 01 CCVS-E-3. SQ1224.2 +025500 02 FILLER PIC X(22) VALUE SQ1224.2 +025600 " FOR OFFICIAL USE ONLY". SQ1224.2 +025700 02 FILLER PIC X(12) VALUE SPACE. SQ1224.2 +025800 02 FILLER PIC X(58) VALUE SQ1224.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +026000 02 FILLER PIC X(8) VALUE SPACE. SQ1224.2 +026100 02 FILLER PIC X(20) VALUE SQ1224.2 +026200 " COPYRIGHT 1985,1986". SQ1224.2 +026300 01 CCVS-E-4. SQ1224.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1224.2 +026500 02 FILLER PIC X(4) VALUE " OF ". SQ1224.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1224.2 +026700 02 FILLER PIC X(40) VALUE SQ1224.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1224.2 +026900 01 XXINFO. SQ1224.2 +027000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1224.2 +027100 02 INFO-TEXT. SQ1224.2 +027200 04 FILLER PIC X(8) VALUE SPACE. SQ1224.2 +027300 04 XXCOMPUTED PIC X(20). SQ1224.2 +027400 04 FILLER PIC X(5) VALUE SPACE. SQ1224.2 +027500 04 XXCORRECT PIC X(20). SQ1224.2 +027600 02 INF-ANSI-REFERENCE PIC X(48). SQ1224.2 +027700 01 HYPHEN-LINE. SQ1224.2 +027800 02 FILLER PIC IS X VALUE IS SPACE. SQ1224.2 +027900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1224.2 +028000- "*****************************************". SQ1224.2 +028100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1224.2 +028200- "******************************". SQ1224.2 +028300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1224.2 +028400 "SQ122A". SQ1224.2 +028500* SQ1224.2 +028600* SQ1224.2 +028700 PROCEDURE DIVISION. SQ1224.2 +028800 DECLARATIVES. SQ1224.2 +028900 SECT-SQ122A-0002 SECTION. SQ1224.2 +029000 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1224.2 +029100 INPUT-ERROR-PROCESS. SQ1224.2 +029200 IF SQ-FS4-STATUS = "10" SQ1224.2 +029300 GO TO END-DECLS. SQ1224.2 +029400 IF SQ-FS4-STATUS = "46" SQ1224.2 +029500 PERFORM DECL-PASS SQ1224.2 +029600 GO TO ABNORMAL-TERM-DECL SQ1224.2 +029700 ELSE SQ1224.2 +029800 MOVE "46" TO CORRECT-A SQ1224.2 +029900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +030000 MOVE "STATUS OF READ AFTER EOF READ INCORRECT" SQ1224.2 +030100 TO RE-MARK SQ1224.2 +030200 MOVE "VII-4, 1.3.5(4)E, FILE STATUS" SQ1224.2 +030300 TO ANSI-REFERENCE SQ1224.2 +030400 PERFORM DECL-FAIL SQ1224.2 +030500 GO TO ABNORMAL-TERM-DECL SQ1224.2 +030600 END-IF. SQ1224.2 +030700* SQ1224.2 +030800 DECL-PASS. SQ1224.2 +030900 MOVE "PASS " TO P-OR-F. SQ1224.2 +031000 ADD 1 TO PASS-COUNTER. SQ1224.2 +031100 PERFORM DECL-PRINT-DETAIL. SQ1224.2 +031200* SQ1224.2 +031300 DECL-FAIL. SQ1224.2 +031400 MOVE "FAIL*" TO P-OR-F. SQ1224.2 +031500 ADD 1 TO ERROR-COUNTER. SQ1224.2 +031600 PERFORM DECL-PRINT-DETAIL. SQ1224.2 +031700* SQ1224.2 +031800 DECL-PRINT-DETAIL. SQ1224.2 +031900 IF REC-CT NOT EQUAL TO ZERO SQ1224.2 +032000 MOVE "." TO PARDOT-X SQ1224.2 +032100 MOVE REC-CT TO DOTVALUE. SQ1224.2 +032200 MOVE TEST-RESULTS TO PRINT-REC. SQ1224.2 +032300 PERFORM DECL-WRITE-LINE. SQ1224.2 +032400 IF P-OR-F EQUAL TO "FAIL*" SQ1224.2 +032500 PERFORM DECL-WRITE-LINE SQ1224.2 +032600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1224.2 +032700 ELSE SQ1224.2 +032800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1224.2 +032900 MOVE SPACE TO P-OR-F. SQ1224.2 +033000 MOVE SPACE TO COMPUTED-X. SQ1224.2 +033100 MOVE SPACE TO CORRECT-X. SQ1224.2 +033200 IF REC-CT EQUAL TO ZERO SQ1224.2 +033300 MOVE SPACE TO PAR-NAME. SQ1224.2 +033400 MOVE SPACE TO RE-MARK. SQ1224.2 +033500* SQ1224.2 +033600 DECL-WRITE-LINE. SQ1224.2 +033700 ADD 1 TO RECORD-COUNT. SQ1224.2 +033800Y IF RECORD-COUNT GREATER 50 SQ1224.2 +033900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1224.2 +034000Y MOVE SPACE TO DUMMY-RECORD SQ1224.2 +034100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1224.2 +034200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1224.2 +034300Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1224.2 +034400Y PERFORM DECL-WRT-LN 2 TIMES SQ1224.2 +034500Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1224.2 +034600Y PERFORM DECL-WRT-LN SQ1224.2 +034700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1224.2 +034800Y MOVE ZERO TO RECORD-COUNT. SQ1224.2 +034900 PERFORM DECL-WRT-LN. SQ1224.2 +035000* SQ1224.2 +035100 DECL-WRT-LN. SQ1224.2 +035200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1224.2 +035300 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +035400* SQ1224.2 +035500 DECL-FAIL-ROUTINE. SQ1224.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1224.2 +035700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1224.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1224.2 +036000 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +036100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +036300 GO TO DECL-FAIL-EX. SQ1224.2 +036400 DECL-FAIL-WRITE. SQ1224.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC SQ1224.2 +036600 PERFORM DECL-WRITE-LINE SQ1224.2 +036700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1224.2 +036800 MOVE TEST-CORRECT TO PRINT-REC SQ1224.2 +036900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +037000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1224.2 +037100 DECL-FAIL-EX. SQ1224.2 +037200 EXIT. SQ1224.2 +037300* SQ1224.2 +037400 DECL-BAIL. SQ1224.2 +037500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1224.2 +037600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1224.2 +037700 DECL-BAIL-WRITE. SQ1224.2 +037800 MOVE CORRECT-A TO XXCORRECT. SQ1224.2 +037900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1224.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +038200 DECL-BAIL-EX. SQ1224.2 +038300 EXIT. SQ1224.2 +038400* SQ1224.2 +038500 ABNORMAL-TERM-DECL. SQ1224.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +038700 PERFORM DECL-WRITE-LINE. SQ1224.2 +038800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1224.2 +038900 TO DUMMY-RECORD. SQ1224.2 +039000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1224.2 +039100* SQ1224.2 +039200 END-DECLS. SQ1224.2 +039300 END DECLARATIVES. SQ1224.2 +039400* SQ1224.2 +039500* SQ1224.2 +039600 CCVS1 SECTION. SQ1224.2 +039700 OPEN-FILES. SQ1224.2 +039800 OPEN OUTPUT PRINT-FILE. SQ1224.2 +039900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1224.2 +040000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1224.2 +040100 MOVE SPACE TO TEST-RESULTS. SQ1224.2 +040200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1224.2 +040300 MOVE ZERO TO REC-SKEL-SUB. SQ1224.2 +040400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1224.2 +040500 GO TO CCVS1-EXIT. SQ1224.2 +040600* SQ1224.2 +040700 CCVS-INIT-FILE. SQ1224.2 +040800 ADD 1 TO REC-SKL-SUB. SQ1224.2 +040900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1224.2 +041000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1224.2 +041100* SQ1224.2 +041200 CLOSE-FILES. SQ1224.2 +041300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1224.2 +041400 CLOSE PRINT-FILE. SQ1224.2 +041500 TERMINATE-CCVS. SQ1224.2 +041600 STOP RUN. SQ1224.2 +041700* SQ1224.2 +041800 INSPT. SQ1224.2 +041900 MOVE "INSPT" TO P-OR-F. SQ1224.2 +042000 ADD 1 TO INSPECT-COUNTER. SQ1224.2 +042100 PERFORM PRINT-DETAIL. SQ1224.2 +042200* SQ1224.2 +042300 PASS. SQ1224.2 +042400 MOVE "PASS " TO P-OR-F. SQ1224.2 +042500 ADD 1 TO PASS-COUNTER. SQ1224.2 +042600 PERFORM PRINT-DETAIL. SQ1224.2 +042700* SQ1224.2 +042800 FAIL. SQ1224.2 +042900 MOVE "FAIL*" TO P-OR-F. SQ1224.2 +043000 ADD 1 TO ERROR-COUNTER. SQ1224.2 +043100 PERFORM PRINT-DETAIL. SQ1224.2 +043200* SQ1224.2 +043300 DE-LETE. SQ1224.2 +043400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1224.2 +043500 MOVE "*****" TO P-OR-F. SQ1224.2 +043600 ADD 1 TO DELETE-COUNTER. SQ1224.2 +043700 PERFORM PRINT-DETAIL. SQ1224.2 +043800* SQ1224.2 +043900 PRINT-DETAIL. SQ1224.2 +044000 IF REC-CT NOT EQUAL TO ZERO SQ1224.2 +044100 MOVE "." TO PARDOT-X SQ1224.2 +044200 MOVE REC-CT TO DOTVALUE. SQ1224.2 +044300 MOVE TEST-RESULTS TO PRINT-REC. SQ1224.2 +044400 PERFORM WRITE-LINE. SQ1224.2 +044500 IF P-OR-F EQUAL TO "FAIL*" SQ1224.2 +044600 PERFORM WRITE-LINE SQ1224.2 +044700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1224.2 +044800 ELSE SQ1224.2 +044900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1224.2 +045000 MOVE SPACE TO P-OR-F. SQ1224.2 +045100 MOVE SPACE TO COMPUTED-X. SQ1224.2 +045200 MOVE SPACE TO CORRECT-X. SQ1224.2 +045300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1224.2 +045400 MOVE SPACE TO RE-MARK. SQ1224.2 +045500* SQ1224.2 +045600 HEAD-ROUTINE. SQ1224.2 +045700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +045800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +045900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1224.2 +046000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1224.2 +046100 COLUMN-NAMES-ROUTINE. SQ1224.2 +046200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +046300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +046400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +046500 END-ROUTINE. SQ1224.2 +046600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1224.2 +046700 PERFORM WRITE-LINE 5 TIMES. SQ1224.2 +046800 END-RTN-EXIT. SQ1224.2 +046900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1224.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +047100* SQ1224.2 +047200 END-ROUTINE-1. SQ1224.2 +047300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1224.2 +047400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1224.2 +047500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1224.2 +047600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1224.2 +047700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1224.2 +047800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1224.2 +047900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1224.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1224.2 +048100 PERFORM WRITE-LINE. SQ1224.2 +048200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1224.2 +048300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1224.2 +048400 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +048500 ELSE SQ1224.2 +048600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1224.2 +048700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1224.2 +048800 PERFORM WRITE-LINE. SQ1224.2 +048900 END-ROUTINE-13. SQ1224.2 +049000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1224.2 +049100 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +049200 ELSE SQ1224.2 +049300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1224.2 +049400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1224.2 +049500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1224.2 +049600 PERFORM WRITE-LINE. SQ1224.2 +049700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1224.2 +049800 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +049900 ELSE SQ1224.2 +050000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1224.2 +050100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1224.2 +050200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +050300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +050400* SQ1224.2 +050500 WRITE-LINE. SQ1224.2 +050600 ADD 1 TO RECORD-COUNT. SQ1224.2 +050700Y IF RECORD-COUNT GREATER 50 SQ1224.2 +050800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1224.2 +050900Y MOVE SPACE TO DUMMY-RECORD SQ1224.2 +051000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1224.2 +051100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1224.2 +051200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1224.2 +051300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1224.2 +051400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1224.2 +051500Y MOVE ZERO TO RECORD-COUNT. SQ1224.2 +051600 PERFORM WRT-LN. SQ1224.2 +051700* SQ1224.2 +051800 WRT-LN. SQ1224.2 +051900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1224.2 +052000 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +052100 BLANK-LINE-PRINT. SQ1224.2 +052200 PERFORM WRT-LN. SQ1224.2 +052300 FAIL-ROUTINE. SQ1224.2 +052400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1224.2 +052500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1224.2 +052600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +052700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1224.2 +052800 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +052900 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +053000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +053100 GO TO FAIL-ROUTINE-EX. SQ1224.2 +053200 FAIL-ROUTINE-WRITE. SQ1224.2 +053300 MOVE TEST-COMPUTED TO PRINT-REC SQ1224.2 +053400 PERFORM WRITE-LINE SQ1224.2 +053500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1224.2 +053600 MOVE TEST-CORRECT TO PRINT-REC SQ1224.2 +053700 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +053800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1224.2 +053900 FAIL-ROUTINE-EX. SQ1224.2 +054000 EXIT. SQ1224.2 +054100 BAIL-OUT. SQ1224.2 +054200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1224.2 +054300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1224.2 +054400 BAIL-OUT-WRITE. SQ1224.2 +054500 MOVE CORRECT-A TO XXCORRECT. SQ1224.2 +054600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1224.2 +054700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +054800 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +054900 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +055000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +055100 BAIL-OUT-EX. SQ1224.2 +055200 EXIT. SQ1224.2 +055300 CCVS1-EXIT. SQ1224.2 +055400 EXIT. SQ1224.2 +055500* SQ1224.2 +055600**************************************************************** SQ1224.2 +055700* * SQ1224.2 +055800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1224.2 +055900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1224.2 +056000* * SQ1224.2 +056100**************************************************************** SQ1224.2 +056200* SQ1224.2 +056300 SECT-SQ122A-0004 SECTION. SQ1224.2 +056400 STA-INIT. SQ1224.2 +056500* SQ1224.2 +056600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1224.2 +056700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1224.2 +056800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1224.2 +056900 MOVE 125 TO XRECORD-LENGTH (1). SQ1224.2 +057000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1224.2 +057100 MOVE 2 TO XBLOCK-SIZE (1). SQ1224.2 +057200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1224.2 +057300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1224.2 +057400 MOVE "S" TO XLABEL-TYPE (1). SQ1224.2 +057500 MOVE ZERO TO XRECORD-NUMBER (1). SQ1224.2 +057600* SQ1224.2 +057700* OPEN THE FILE IN THE OUTPUT MODE SQ1224.2 +057800* SQ1224.2 +057900 SEQ-INIT-01. SQ1224.2 +058000 MOVE 0 TO REC-CT. SQ1224.2 +058100 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +058200 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1224.2 +058300 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1224.2 +058400 SEQ-TEST-OP-01. SQ1224.2 +058500 OPEN OUTPUT SQ-FS4. SQ1224.2 +058600* SQ1224.2 +058700* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1224.2 +058800* SQ1224.2 +058900 ADD 1 TO REC-CT. SQ1224.2 +059000 SEQ-TEST-OP-01-01. SQ1224.2 +059100 IF SQ-FS4-STATUS = "00" SQ1224.2 +059200 PERFORM PASS SQ1224.2 +059300 ELSE SQ1224.2 +059400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +059500 MOVE "00" TO CORRECT-A SQ1224.2 +059600 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1224.2 +059700 TO RE-MARK SQ1224.2 +059800 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1224.2 +059900 PERFORM FAIL. SQ1224.2 +060000 SEQ-TEST-01-01-END. SQ1224.2 +060100* SQ1224.2 +060200* SQ1224.2 +060300* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1224.2 +060400* SQ1224.2 +060500 SEQ-INIT-02. SQ1224.2 +060600 MOVE 0 TO REC-CT. SQ1224.2 +060700 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +060800 ADD 1 TO XRECORD-NUMBER (1). SQ1224.2 +060900 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1224.2 +061000 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1224.2 +061100 SEQ-TEST-WR-02. SQ1224.2 +061200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1224.2 +061300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1224.2 +061400 WRITE SQ-FS4R1-F-G-125. SQ1224.2 +061500* SQ1224.2 +061600* CHECK I-O STATUS RETURNED FROM WRITE SQ1224.2 +061700* SQ1224.2 +061800 ADD 1 TO REC-CT. SQ1224.2 +061900 SEQ-TEST-WR-02-01. SQ1224.2 +062000 IF SQ-FS4-STATUS = "00" SQ1224.2 +062100 PERFORM PASS SQ1224.2 +062200 ELSE SQ1224.2 +062300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +062400 MOVE "00" TO CORRECT-A SQ1224.2 +062500 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1224.2 +062600 TO RE-MARK SQ1224.2 +062700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1224.2 +062800 PERFORM FAIL. SQ1224.2 +062900 SEQ-TEST-02-01-END. SQ1224.2 +063000* SQ1224.2 +063100* SQ1224.2 +063200* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1224.2 +063300* SQ1224.2 +063400 SEQ-INIT-03. SQ1224.2 +063500 MOVE 0 TO REC-CT. SQ1224.2 +063600 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +063700 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1224.2 +063800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1224.2 +063900 SEQ-TEST-CL-03. SQ1224.2 +064000 CLOSE SQ-FS4. SQ1224.2 +064100* SQ1224.2 +064200* CHECK I-O STATUS RETURNED FROM CLOSE SQ1224.2 +064300* SQ1224.2 +064400 ADD 1 TO REC-CT. SQ1224.2 +064500 SEQ-TEST-CL-03-01. SQ1224.2 +064600 IF SQ-FS4-STATUS = "00" SQ1224.2 +064700 PERFORM PASS SQ1224.2 +064800 ELSE SQ1224.2 +064900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +065000 MOVE "00" TO CORRECT-A SQ1224.2 +065100 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1224.2 +065200 TO RE-MARK SQ1224.2 +065300 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1224.2 +065400 PERFORM FAIL. SQ1224.2 +065500 SEQ-TEST-03-01-END. SQ1224.2 +065600* SQ1224.2 +065700* SQ1224.2 +065800* CREATION OF THE FILE IS NOW COMPLETE. THE NEXT ACTION SQ1224.2 +065900* IS TO OPEN THE FILE IN THE INPUT MODE SQ1224.2 +066000* SQ1224.2 +066100 SEQ-INIT-04. SQ1224.2 +066200 MOVE 0 TO REC-CT. SQ1224.2 +066300 MOVE ZERO TO XRECORD-NUMBER (1). SQ1224.2 +066400 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +066500 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1224.2 +066600 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1224.2 +066700 SEQ-TEST-OP-04. SQ1224.2 +066800* SQ1224.2 +066900* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1224.2 +067000* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1224.2 +067100* THE LAST RECORD WRITTEN IN IT. SQ1224.2 +067200* SQ1224.2 +067300 OPEN INPUT SQ-FS4. SQ1224.2 +067400 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1224.2 +067500* SQ1224.2 +067600* CHECK I-O STATUS RETURNED FROM OPEN INPUT SQ1224.2 +067700* SQ1224.2 +067800 ADD 1 TO REC-CT. SQ1224.2 +067900 SEQ-TEST-OP-04-01. SQ1224.2 +068000 IF SQ-FS4-STATUS = "00" SQ1224.2 +068100 PERFORM PASS SQ1224.2 +068200 ELSE SQ1224.2 +068300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +068400 MOVE "00" TO CORRECT-A SQ1224.2 +068500 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ1224.2 +068600 TO RE-MARK SQ1224.2 +068700 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1224.2 +068800 PERFORM FAIL. SQ1224.2 +068900 SEQ-TEST-04-01-END. SQ1224.2 +069000* SQ1224.2 +069100* SQ1224.2 +069200* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1224.2 +069300* SQ1224.2 +069400 SEQ-INIT-05. SQ1224.2 +069500 MOVE 0 TO REC-CT. SQ1224.2 +069600 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +069700 MOVE "READ FIRST RECORD" TO FEATURE. SQ1224.2 +069800 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1224.2 +069900 SEQ-TEST-RD-05. SQ1224.2 +070000 READ SQ-FS4. SQ1224.2 +070100 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1224.2 +070200* SQ1224.2 +070300* CHECK I-O STATUS RETURNED FROM READ SQ1224.2 +070400* SQ1224.2 +070500 ADD 1 TO REC-CT. SQ1224.2 +070600 SEQ-TEST-RD-05-01. SQ1224.2 +070700 IF SQ-FS4-STATUS = "00" SQ1224.2 +070800 PERFORM PASS SQ1224.2 +070900 ELSE SQ1224.2 +071000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +071100 MOVE "00" TO CORRECT-A SQ1224.2 +071200 MOVE "UNEXPECTED I-O STATUS FROM READ" SQ1224.2 +071300 TO RE-MARK SQ1224.2 +071400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1224.2 +071500 PERFORM FAIL. SQ1224.2 +071600 SEQ-TEST-05-01-END. SQ1224.2 +071700* SQ1224.2 +071800* SQ1224.2 +071900* READ AGAIN, TO RAISE THE AT END CONDITION SQ1224.2 +072000* SQ1224.2 +072100 SEQ-INIT-06. SQ1224.2 +072200 MOVE 0 TO REC-CT. SQ1224.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +072400 MOVE "READ, GIVING AT END" TO FEATURE. SQ1224.2 +072500 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1224.2 +072600 SEQ-TEST-RD-06. SQ1224.2 +072700 READ SQ-FS4. SQ1224.2 +072800* SQ1224.2 +072900* CHECK I-O STATUS RETURNED FROM READ SQ1224.2 +073000* SQ1224.2 +073100 ADD 1 TO REC-CT. SQ1224.2 +073200 SEQ-TEST-RD-06-01. SQ1224.2 +073300 IF SQ-FS4-STATUS = "10" SQ1224.2 +073400 PERFORM PASS SQ1224.2 +073500 ELSE SQ1224.2 +073600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +073700 MOVE "10" TO CORRECT-A SQ1224.2 +073800 MOVE "UNEXPECTED I-O STATUS AT END OF FILE" SQ1224.2 +073900 TO RE-MARK SQ1224.2 +074000 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1224.2 +074100 PERFORM FAIL. SQ1224.2 +074200 SEQ-TEST-06-01-END. SQ1224.2 +074300* SQ1224.2 +074400* SQ1224.2 +074500* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1224.2 +074600* SQ1224.2 +074700 SEQ-INIT-07. SQ1224.2 +074800 MOVE 0 TO REC-CT. SQ1224.2 +074900 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +075000 MOVE "READ AFTER AT END" TO FEATURE. SQ1224.2 +075100 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1224.2 +075200 SEQ-TEST-RD-07. SQ1224.2 +075300 READ SQ-FS4. SQ1224.2 +075400 CCVS-EXIT SECTION. SQ1224.2 +075500 CCVS-999999. SQ1224.2 +075600 GO TO CLOSE-FILES. SQ1224.2 +*END-OF,SQ122A +*HEADER,COBOL,SQ123A +000100 IDENTIFICATION DIVISION. SQ1234.2 +000200 PROGRAM-ID. SQ1234.2 +000300 SQ123A. SQ1234.2 +000400**************************************************************** SQ1234.2 +000500* * SQ1234.2 +000600* VALIDATION FOR:- * SQ1234.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1234.2 +000900* REVISED 1986, AUGUST * SQ1234.2 +001000* * SQ1234.2 +001100* CREATION DATE / VALIDATION DATE * SQ1234.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1234.2 +001300* * SQ1234.2 +001400**************************************************************** SQ1234.2 +001500* * SQ1234.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1234.2 +001700* * SQ1234.2 +001800* X-14 SEQUENTIAL NON-UNIT MASS STORAGE FILE * SQ1234.2 +001900* X-55 SYSTEM PRINTER * SQ1234.2 +002000* X-82 SOURCE-COMPUTER * SQ1234.2 +002100* X-83 OBJECT-COMPUTER. * SQ1234.2 +002200* * SQ1234.2 +002300**************************************************************** SQ1234.2 +002400* * SQ1234.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1234.2 +002600* TO A MEDIUM WHICH IS NOT A REEL/UNIT MEDIUM. A CLOSE * SQ1234.2 +002700* REEL STATEMENT IS EXECUTED. THIS SHOULD HAVE NO EFFECT * SQ1234.2 +002800* ON THE FILE, EXCEPT TO CAUSE I-O STATUS 07. THE FILE * SQ1234.2 +002900* SHOULD REMAIN OPEN. A NORMAL, UNQUALIFIED, CLOSE * SQ1234.2 +003000* STATEMENT IS THEN EXECUTED, WHICH SHOULD BE SUCCESSFUL * SQ1234.2 +003100* AND CLOSE THE FILE. THERE IS AN ERROR DECLARATIVE FOR * SQ1234.2 +003200* THE FILE, WHICH SHOULD NOT BE ENTERED. * SQ1234.2 +003300* * SQ1234.2 +003400**************************************************************** SQ1234.2 +003500* SQ1234.2 +003600 ENVIRONMENT DIVISION. SQ1234.2 +003700 CONFIGURATION SECTION. SQ1234.2 +003800 SOURCE-COMPUTER. SQ1234.2 +003900 XXXXX082. SQ1234.2 +004000 OBJECT-COMPUTER. SQ1234.2 +004100 XXXXX083. SQ1234.2 +004200* SQ1234.2 +004300 INPUT-OUTPUT SECTION. SQ1234.2 +004400 FILE-CONTROL. SQ1234.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ1234.2 +004600 XXXXX055. SQ1234.2 +004700* SQ1234.2 +004800P SELECT RAW-DATA ASSIGN TO SQ1234.2 +004900P XXXXX062 SQ1234.2 +005000P ORGANIZATION IS INDEXED SQ1234.2 +005100P ACCESS MODE IS RANDOM SQ1234.2 +005200P RECORD-KEY IS RAW-DATA-KEY. SQ1234.2 +005300P SQ1234.2 +005400 SELECT SQ-FS4 ASSIGN SQ1234.2 +005500 XXXXX014 SQ1234.2 +005600 SEQUENTIAL SQ1234.2 +005700 ACCESS IS SEQUENTIAL SQ1234.2 +005800 STATUS IS SQ-FS4-STATUS. SQ1234.2 +005900* SQ1234.2 +006000* SQ1234.2 +006100 DATA DIVISION. SQ1234.2 +006200 FILE SECTION. SQ1234.2 +006300 FD PRINT-FILE SQ1234.2 +006400C LABEL RECORDS SQ1234.2 +006500C XXXXX084 SQ1234.2 +006600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1234.2 +006700 . SQ1234.2 +006800 01 PRINT-REC PICTURE X(120). SQ1234.2 +006900 01 DUMMY-RECORD PICTURE X(120). SQ1234.2 +007000P SQ1234.2 +007100PFD RAW-DATA. SQ1234.2 +007200P01 RAW-DATA-SATZ. SQ1234.2 +007300P 05 RAW-DATA-KEY PIC X(6). SQ1234.2 +007400P 05 C-DATE PIC 9(6). SQ1234.2 +007500P 05 C-TIME PIC 9(8). SQ1234.2 +007600P 05 NO-OF-TESTS PIC 99. SQ1234.2 +007700P 05 C-OK PIC 999. SQ1234.2 +007800P 05 C-ALL PIC 999. SQ1234.2 +007900P 05 C-FAIL PIC 999. SQ1234.2 +008000P 05 C-DELETED PIC 999. SQ1234.2 +008100P 05 C-INSPECT PIC 999. SQ1234.2 +008200P 05 C-NOTE PIC X(13). SQ1234.2 +008300P 05 C-INDENT PIC X. SQ1234.2 +008400P 05 C-ABORT PIC X(8). SQ1234.2 +008500* SQ1234.2 +008600 FD SQ-FS4 SQ1234.2 +008700C LABEL RECORD IS STANDARD SQ1234.2 +008800 . SQ1234.2 +008900 01 SQ-FS4R1-F-G-120 PIC X(120). SQ1234.2 +009000* SQ1234.2 +009100 WORKING-STORAGE SECTION. SQ1234.2 +009200* SQ1234.2 +009300*************************************************************** SQ1234.2 +009400* * SQ1234.2 +009500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1234.2 +009600* * SQ1234.2 +009700*************************************************************** SQ1234.2 +009800* SQ1234.2 +009900 01 SQ-FS4-STATUS. SQ1234.2 +010000 03 SQ-FS4-KEY-1 PIC X. SQ1234.2 +010100 03 SQ-FS4-KEY-2 PIC X. SQ1234.2 +010200* SQ1234.2 +010300 01 DELETE-SW. SQ1234.2 +010400 03 DELETE-SW-1 PIC X. SQ1234.2 +010500 03 DELETE-SW-1-GROUP. SQ1234.2 +010600 05 DELETE-SW-2 PIC X. SQ1234.2 +010700* SQ1234.2 +010800 01 DECL-EXEC-I PIC X(12). SQ1234.2 +010900 01 DECL-EXEC-O PIC X(12). SQ1234.2 +011000 01 DECL-EXEC-SW PIC X. SQ1234.2 +011100* SQ1234.2 +011200*************************************************************** SQ1234.2 +011300* * SQ1234.2 +011400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1234.2 +011500* * SQ1234.2 +011600*************************************************************** SQ1234.2 +011700* SQ1234.2 +011800 01 REC-SKEL-SUB PIC 99. SQ1234.2 +011900* SQ1234.2 +012000 01 FILE-RECORD-INFORMATION-REC. SQ1234.2 +012100 03 FILE-RECORD-INFO-SKELETON. SQ1234.2 +012200 05 FILLER PICTURE X(48) VALUE SQ1234.2 +012300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1234.2 +012400 05 FILLER PICTURE X(46) VALUE SQ1234.2 +012500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1234.2 +012600 05 FILLER PICTURE X(26) VALUE SQ1234.2 +012700 ",LFIL=000000,ORG= ,LBLR= ". SQ1234.2 +012800 05 FILLER PICTURE X(37) VALUE SQ1234.2 +012900 ",RECKEY= ". SQ1234.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1234.2 +013100 ",ALTKEY1= ". SQ1234.2 +013200 05 FILLER PICTURE X(38) VALUE SQ1234.2 +013300 ",ALTKEY2= ". SQ1234.2 +013400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1234.2 +013500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1234.2 +013600 05 FILE-RECORD-INFO-P1-120. SQ1234.2 +013700 07 FILLER PIC X(5). SQ1234.2 +013800 07 XFILE-NAME PIC X(6). SQ1234.2 +013900 07 FILLER PIC X(8). SQ1234.2 +014000 07 XRECORD-NAME PIC X(6). SQ1234.2 +014100 07 FILLER PIC X(1). SQ1234.2 +014200 07 REELUNIT-NUMBER PIC 9(1). SQ1234.2 +014300 07 FILLER PIC X(7). SQ1234.2 +014400 07 XRECORD-NUMBER PIC 9(6). SQ1234.2 +014500 07 FILLER PIC X(6). SQ1234.2 +014600 07 UPDATE-NUMBER PIC 9(2). SQ1234.2 +014700 07 FILLER PIC X(5). SQ1234.2 +014800 07 ODO-NUMBER PIC 9(4). SQ1234.2 +014900 07 FILLER PIC X(5). SQ1234.2 +015000 07 XPROGRAM-NAME PIC X(5). SQ1234.2 +015100 07 FILLER PIC X(7). SQ1234.2 +015200 07 XRECORD-LENGTH PIC 9(6). SQ1234.2 +015300 07 FILLER PIC X(7). SQ1234.2 +015400 07 CHARS-OR-RECORDS PIC X(2). SQ1234.2 +015500 07 FILLER PIC X(1). SQ1234.2 +015600 07 XBLOCK-SIZE PIC 9(4). SQ1234.2 +015700 07 FILLER PIC X(6). SQ1234.2 +015800 07 RECORDS-IN-FILE PIC 9(6). SQ1234.2 +015900 07 FILLER PIC X(5). SQ1234.2 +016000 07 XFILE-ORGANIZATION PIC X(2). SQ1234.2 +016100 07 FILLER PIC X(6). SQ1234.2 +016200 07 XLABEL-TYPE PIC X(1). SQ1234.2 +016300 05 FILE-RECORD-INFO-P121-240. SQ1234.2 +016400 07 FILLER PIC X(8). SQ1234.2 +016500 07 XRECORD-KEY PIC X(29). SQ1234.2 +016600 07 FILLER PIC X(9). SQ1234.2 +016700 07 ALTERNATE-KEY1 PIC X(29). SQ1234.2 +016800 07 FILLER PIC X(9). SQ1234.2 +016900 07 ALTERNATE-KEY2 PIC X(29). SQ1234.2 +017000 07 FILLER PIC X(7). SQ1234.2 +017100* SQ1234.2 +017200 01 TEST-RESULTS. SQ1234.2 +017300 02 FILLER PIC X VALUE SPACE. SQ1234.2 +017400 02 PAR-NAME. SQ1234.2 +017500 03 FILLER PIC X(14) VALUE SPACE. SQ1234.2 +017600 03 PARDOT-X PIC X VALUE SPACE. SQ1234.2 +017700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1234.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1234.2 +017900 02 FEATURE PIC X(24) VALUE SPACE. SQ1234.2 +018000 02 FILLER PIC X VALUE SPACE. SQ1234.2 +018100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1234.2 +018200 02 FILLER PIC X(9) VALUE SPACE. SQ1234.2 +018300 02 RE-MARK PIC X(61). SQ1234.2 +018400 01 TEST-COMPUTED. SQ1234.2 +018500 02 FILLER PIC X(30) VALUE SPACE. SQ1234.2 +018600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1234.2 +018700 02 COMPUTED-X. SQ1234.2 +018800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1234.2 +018900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1234.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1234.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1234.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1234.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1234.2 +019400 04 COMPUTED-18V0 PIC -9(18). SQ1234.2 +019500 04 FILLER PIC X. SQ1234.2 +019600 03 FILLER PIC X(50) VALUE SPACE. SQ1234.2 +019700 01 TEST-CORRECT. SQ1234.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1234.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1234.2 +020000 02 CORRECT-X. SQ1234.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1234.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1234.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1234.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1234.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1234.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. SQ1234.2 +020700 04 CORRECT-18V0 PIC -9(18). SQ1234.2 +020800 04 FILLER PIC X. SQ1234.2 +020900 03 FILLER PIC X(2) VALUE SPACE. SQ1234.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1234.2 +021100* SQ1234.2 +021200 01 CCVS-C-1. SQ1234.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1234.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1234.2 +021700 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1234.2 +021900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1234.2 +022000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1234.2 +022100 01 CCVS-C-2. SQ1234.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1234.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". SQ1234.2 +022400 02 FILLER PIC X(19) VALUE SPACE. SQ1234.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". SQ1234.2 +022600 02 FILLER PIC X(72) VALUE SPACE. SQ1234.2 +022700* SQ1234.2 +022800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1234.2 +022900 01 REC-CT PIC 99 VALUE ZERO. SQ1234.2 +023000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1234.2 +023500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1234.2 +023600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1234.2 +023700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1234.2 +023800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1234.2 +023900 01 CCVS-H-1. SQ1234.2 +024000 02 FILLER PIC X(39) VALUE SPACES. SQ1234.2 +024100 02 FILLER PIC X(42) VALUE SQ1234.2 +024200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1234.2 +024300 02 FILLER PIC X(39) VALUE SPACES. SQ1234.2 +024400 01 CCVS-H-2A. SQ1234.2 +024500 02 FILLER PIC X(40) VALUE SPACE. SQ1234.2 +024600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1234.2 +024700 02 FILLER PIC XXXX VALUE SQ1234.2 +024800 "4.2 ". SQ1234.2 +024900 02 FILLER PIC X(28) VALUE SQ1234.2 +025000 " COPY - NOT FOR DISTRIBUTION". SQ1234.2 +025100 02 FILLER PIC X(41) VALUE SPACE. SQ1234.2 +025200* SQ1234.2 +025300 01 CCVS-H-2B. SQ1234.2 +025400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1234.2 +025500 02 TEST-ID PIC X(9). SQ1234.2 +025600 02 FILLER PIC X(4) VALUE " IN ". SQ1234.2 +025700 02 FILLER PIC X(12) VALUE SQ1234.2 +025800 " HIGH ". SQ1234.2 +025900 02 FILLER PIC X(22) VALUE SQ1234.2 +026000 " LEVEL VALIDATION FOR ". SQ1234.2 +026100 02 FILLER PIC X(58) VALUE SQ1234.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +026300 01 CCVS-H-3. SQ1234.2 +026400 02 FILLER PIC X(34) VALUE SQ1234.2 +026500 " FOR OFFICIAL USE ONLY ". SQ1234.2 +026600 02 FILLER PIC X(58) VALUE SQ1234.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1234.2 +026800 02 FILLER PIC X(28) VALUE SQ1234.2 +026900 " COPYRIGHT 1985,1986 ". SQ1234.2 +027000 01 CCVS-E-1. SQ1234.2 +027100 02 FILLER PIC X(52) VALUE SPACE. SQ1234.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1234.2 +027300 02 ID-AGAIN PIC X(9). SQ1234.2 +027400 02 FILLER PIC X(45) VALUE SPACES. SQ1234.2 +027500 01 CCVS-E-2. SQ1234.2 +027600 02 FILLER PIC X(31) VALUE SPACE. SQ1234.2 +027700 02 FILLER PIC X(21) VALUE SPACE. SQ1234.2 +027800 02 CCVS-E-2-2. SQ1234.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1234.2 +028000 03 FILLER PIC X VALUE SPACE. SQ1234.2 +028100 03 ENDER-DESC PIC X(44) VALUE SQ1234.2 +028200 "ERRORS ENCOUNTERED". SQ1234.2 +028300 01 CCVS-E-3. SQ1234.2 +028400 02 FILLER PIC X(22) VALUE SQ1234.2 +028500 " FOR OFFICIAL USE ONLY". SQ1234.2 +028600 02 FILLER PIC X(12) VALUE SPACE. SQ1234.2 +028700 02 FILLER PIC X(58) VALUE SQ1234.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +028900 02 FILLER PIC X(8) VALUE SPACE. SQ1234.2 +029000 02 FILLER PIC X(20) VALUE SQ1234.2 +029100 " COPYRIGHT 1985,1986". SQ1234.2 +029200 01 CCVS-E-4. SQ1234.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1234.2 +029400 02 FILLER PIC X(4) VALUE " OF ". SQ1234.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1234.2 +029600 02 FILLER PIC X(40) VALUE SQ1234.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1234.2 +029800 01 XXINFO. SQ1234.2 +029900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1234.2 +030000 02 INFO-TEXT. SQ1234.2 +030100 04 FILLER PIC X(8) VALUE SPACE. SQ1234.2 +030200 04 XXCOMPUTED PIC X(20). SQ1234.2 +030300 04 FILLER PIC X(5) VALUE SPACE. SQ1234.2 +030400 04 XXCORRECT PIC X(20). SQ1234.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). SQ1234.2 +030600 01 HYPHEN-LINE. SQ1234.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. SQ1234.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1234.2 +030900- "*****************************************". SQ1234.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1234.2 +031100- "******************************". SQ1234.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1234.2 +031300 "SQ123A". SQ1234.2 +031400* SQ1234.2 +031500* SQ1234.2 +031600 PROCEDURE DIVISION. SQ1234.2 +031700 DECLARATIVES. SQ1234.2 +031800* SQ1234.2 +031900* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1234.2 +032000* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1234.2 +032100* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1234.2 +032200* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1234.2 +032300* SQ1234.2 +032400 SECT-SQ123A-0000 SECTION. SQ1234.2 +032500 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1234.2 +032600 PRINT-FILE-ERROR-PROCESS. SQ1234.2 +032700 EXIT. SQ1234.2 +032800* SQ1234.2 +032900 SECT-SQ123A-0001 SECTION. SQ1234.2 +033000 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1234.2 +033100 INPUT-ERROR-PROCESS. SQ1234.2 +033200 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1234.2 +033300* SQ1234.2 +033400 SECT-SQ123A-0002 SECTION. SQ1234.2 +033500 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1234.2 +033600 OUTPUT-ERROR-PROCESS. SQ1234.2 +033700 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1234.2 +033800* SQ1234.2 +033900 IF DECL-EXEC-SW NOT = SPACE SQ1234.2 +034000 GO TO END-DECLS. SQ1234.2 +034100* SQ1234.2 +034200 MOVE 1 TO REC-CT. SQ1234.2 +034300 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1234.2 +034400 MOVE "DECL-CLOSE-02" TO PAR-NAME. SQ1234.2 +034500 GO TO DECL-CLOSE-02. SQ1234.2 +034600 DECL-DELETE-02. SQ1234.2 +034700 PERFORM DECL-DE-LETE. SQ1234.2 +034800 GO TO DECL-TEST-01-END. SQ1234.2 +034900 DECL-CLOSE-02. SQ1234.2 +035000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +035100 MOVE "00" TO CORRECT-A SQ1234.2 +035200 MOVE "DECLARATIVE ENTERED ON CLOSE OF FILE WHICH IS OPEN" SQ1234.2 +035300 TO RE-MARK SQ1234.2 +035400 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1234.2 +035500 PERFORM DECL-FAIL. SQ1234.2 +035600 DECL-TEST-01-END. SQ1234.2 +035700* SQ1234.2 +035800 GO TO END-DECLS. SQ1234.2 +035900* SQ1234.2 +036000* SQ1234.2 +036100 DECL-PASS. SQ1234.2 +036200 MOVE "PASS " TO P-OR-F. SQ1234.2 +036300 ADD 1 TO PASS-COUNTER. SQ1234.2 +036400 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +036500* SQ1234.2 +036600 DECL-FAIL. SQ1234.2 +036700 MOVE "FAIL*" TO P-OR-F. SQ1234.2 +036800 ADD 1 TO ERROR-COUNTER. SQ1234.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +037000* SQ1234.2 +037100 DECL-DE-LETE. SQ1234.2 +037200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1234.2 +037300 MOVE "*****" TO P-OR-F. SQ1234.2 +037400 ADD 1 TO DELETE-COUNTER. SQ1234.2 +037500 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +037600* SQ1234.2 +037700 DECL-PRINT-DETAIL. SQ1234.2 +037800 IF REC-CT NOT EQUAL TO ZERO SQ1234.2 +037900 MOVE "." TO PARDOT-X SQ1234.2 +038000 MOVE REC-CT TO DOTVALUE. SQ1234.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. SQ1234.2 +038200 PERFORM DECL-WRITE-LINE. SQ1234.2 +038300 IF P-OR-F EQUAL TO "FAIL*" SQ1234.2 +038400 PERFORM DECL-WRITE-LINE SQ1234.2 +038500 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1234.2 +038600 ELSE SQ1234.2 +038700 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1234.2 +038800 MOVE SPACE TO P-OR-F. SQ1234.2 +038900 MOVE SPACE TO COMPUTED-X. SQ1234.2 +039000 MOVE SPACE TO CORRECT-X. SQ1234.2 +039100 IF REC-CT EQUAL TO ZERO SQ1234.2 +039200 MOVE SPACE TO PAR-NAME. SQ1234.2 +039300 MOVE SPACE TO RE-MARK. SQ1234.2 +039400* SQ1234.2 +039500 DECL-WRITE-LINE. SQ1234.2 +039600 ADD 1 TO RECORD-COUNT. SQ1234.2 +039700Y IF RECORD-COUNT GREATER 50 SQ1234.2 +039800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1234.2 +039900Y MOVE SPACE TO DUMMY-RECORD SQ1234.2 +040000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1234.2 +040100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1234.2 +040200Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1234.2 +040300Y PERFORM DECL-WRT-LN 2 TIMES SQ1234.2 +040400Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1234.2 +040500Y PERFORM DECL-WRT-LN SQ1234.2 +040600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1234.2 +040700Y MOVE ZERO TO RECORD-COUNT. SQ1234.2 +040800 PERFORM DECL-WRT-LN. SQ1234.2 +040900* SQ1234.2 +041000 DECL-WRT-LN. SQ1234.2 +041100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1234.2 +041200 MOVE SPACE TO DUMMY-RECORD. SQ1234.2 +041300* SQ1234.2 +041400 DECL-FAIL-ROUTINE. SQ1234.2 +041500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1234.2 +041600 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1234.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1234.2 +041900 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +042000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +042100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +042200 GO TO DECL-FAIL-EX. SQ1234.2 +042300 DECL-FAIL-WRITE. SQ1234.2 +042400 MOVE TEST-COMPUTED TO PRINT-REC SQ1234.2 +042500 PERFORM DECL-WRITE-LINE SQ1234.2 +042600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1234.2 +042700 MOVE TEST-CORRECT TO PRINT-REC SQ1234.2 +042800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +042900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1234.2 +043000 DECL-FAIL-EX. SQ1234.2 +043100 EXIT. SQ1234.2 +043200* SQ1234.2 +043300 DECL-BAIL. SQ1234.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1234.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1234.2 +043600 DECL-BAIL-WRITE. SQ1234.2 +043700 MOVE CORRECT-A TO XXCORRECT. SQ1234.2 +043800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1234.2 +043900 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +044000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +044100 DECL-BAIL-EX. SQ1234.2 +044200 EXIT. SQ1234.2 +044300* SQ1234.2 +044400 END-DECLS. SQ1234.2 +044500 END DECLARATIVES. SQ1234.2 +044600* SQ1234.2 +044700* SQ1234.2 +044800 CCVS1 SECTION. SQ1234.2 +044900 OPEN-FILES. SQ1234.2 +045000P OPEN I-O RAW-DATA. SQ1234.2 +045100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1234.2 +045200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1234.2 +045300P MOVE "ABORTED " TO C-ABORT. SQ1234.2 +045400P ADD 1 TO C-NO-OF-TESTS. SQ1234.2 +045500P ACCEPT C-DATE FROM DATE. SQ1234.2 +045600P ACCEPT C-TIME FROM TIME. SQ1234.2 +045700P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1234.2 +045800PEND-E-1. SQ1234.2 +045900P CLOSE RAW-DATA. SQ1234.2 +046000 OPEN OUTPUT PRINT-FILE. SQ1234.2 +046100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1234.2 +046200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1234.2 +046300 MOVE SPACE TO TEST-RESULTS. SQ1234.2 +046400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1234.2 +046500 MOVE ZERO TO REC-SKEL-SUB. SQ1234.2 +046600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1234.2 +046700 GO TO CCVS1-EXIT. SQ1234.2 +046800* SQ1234.2 +046900 CCVS-INIT-FILE. SQ1234.2 +047000 ADD 1 TO REC-SKL-SUB. SQ1234.2 +047100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1234.2 +047200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1234.2 +047300* SQ1234.2 +047400 CLOSE-FILES. SQ1234.2 +047500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1234.2 +047600 CLOSE PRINT-FILE. SQ1234.2 +047700P OPEN I-O RAW-DATA. SQ1234.2 +047800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1234.2 +047900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1234.2 +048000P MOVE "OK. " TO C-ABORT. SQ1234.2 +048100P MOVE PASS-COUNTER TO C-OK. SQ1234.2 +048200P MOVE ERROR-HOLD TO C-ALL. SQ1234.2 +048300P MOVE ERROR-COUNTER TO C-FAIL. SQ1234.2 +048400P MOVE DELETE-CNT TO C-DELETED. SQ1234.2 +048500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1234.2 +048600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1234.2 +048700PEND-E-2. SQ1234.2 +048800P CLOSE RAW-DATA. SQ1234.2 +048900 TERMINATE-CCVS. SQ1234.2 +049000S EXIT PROGRAM. SQ1234.2 +049100 STOP RUN. SQ1234.2 +049200* SQ1234.2 +049300 INSPT. SQ1234.2 +049400 MOVE "INSPT" TO P-OR-F. SQ1234.2 +049500 ADD 1 TO INSPECT-COUNTER. SQ1234.2 +049600 PERFORM PRINT-DETAIL. SQ1234.2 +049700* SQ1234.2 +049800 PASS. SQ1234.2 +049900 MOVE "PASS " TO P-OR-F. SQ1234.2 +050000 ADD 1 TO PASS-COUNTER. SQ1234.2 +050100 PERFORM PRINT-DETAIL. SQ1234.2 +050200* SQ1234.2 +050300 FAIL. SQ1234.2 +050400 MOVE "FAIL*" TO P-OR-F. SQ1234.2 +050500 ADD 1 TO ERROR-COUNTER. SQ1234.2 +050600 PERFORM PRINT-DETAIL. SQ1234.2 +050700* SQ1234.2 +050800 DE-LETE. SQ1234.2 +050900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1234.2 +051000 MOVE "*****" TO P-OR-F. SQ1234.2 +051100 ADD 1 TO DELETE-COUNTER. SQ1234.2 +051200 PERFORM PRINT-DETAIL. SQ1234.2 +051300* SQ1234.2 +051400 PRINT-DETAIL. SQ1234.2 +051500 IF REC-CT NOT EQUAL TO ZERO SQ1234.2 +051600 MOVE "." TO PARDOT-X SQ1234.2 +051700 MOVE REC-CT TO DOTVALUE. SQ1234.2 +051800 MOVE TEST-RESULTS TO PRINT-REC. SQ1234.2 +051900 PERFORM WRITE-LINE. SQ1234.2 +052000 IF P-OR-F EQUAL TO "FAIL*" SQ1234.2 +052100 PERFORM WRITE-LINE SQ1234.2 +052200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1234.2 +052300 ELSE SQ1234.2 +052400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1234.2 +052500 MOVE SPACE TO P-OR-F. SQ1234.2 +052600 MOVE SPACE TO COMPUTED-X. SQ1234.2 +052700 MOVE SPACE TO CORRECT-X. SQ1234.2 +052800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1234.2 +052900 MOVE SPACE TO RE-MARK. SQ1234.2 +053000* SQ1234.2 +053100 HEAD-ROUTINE. SQ1234.2 +053200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1234.2 +053500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1234.2 +053600 COLUMN-NAMES-ROUTINE. SQ1234.2 +053700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +053800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +054000 END-ROUTINE. SQ1234.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1234.2 +054200 PERFORM WRITE-LINE 5 TIMES. SQ1234.2 +054300 END-RTN-EXIT. SQ1234.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1234.2 +054500 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +054600* SQ1234.2 +054700 END-ROUTINE-1. SQ1234.2 +054800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1234.2 +054900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1234.2 +055000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1234.2 +055100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1234.2 +055200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1234.2 +055300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1234.2 +055400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1234.2 +055500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1234.2 +055600 PERFORM WRITE-LINE. SQ1234.2 +055700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1234.2 +055800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1234.2 +055900 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +056000 ELSE SQ1234.2 +056100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1234.2 +056200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1234.2 +056300 PERFORM WRITE-LINE. SQ1234.2 +056400 END-ROUTINE-13. SQ1234.2 +056500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1234.2 +056600 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +056700 ELSE SQ1234.2 +056800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1234.2 +056900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1234.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1234.2 +057100 PERFORM WRITE-LINE. SQ1234.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1234.2 +057300 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +057400 ELSE SQ1234.2 +057500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1234.2 +057600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1234.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +057800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +057900* SQ1234.2 +058000 WRITE-LINE. SQ1234.2 +058100 ADD 1 TO RECORD-COUNT. SQ1234.2 +058200Y IF RECORD-COUNT GREATER 50 SQ1234.2 +058300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1234.2 +058400Y MOVE SPACE TO DUMMY-RECORD SQ1234.2 +058500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1234.2 +058600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1234.2 +058700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1234.2 +058800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1234.2 +058900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1234.2 +059000Y MOVE ZERO TO RECORD-COUNT. SQ1234.2 +059100 PERFORM WRT-LN. SQ1234.2 +059200* SQ1234.2 +059300 WRT-LN. SQ1234.2 +059400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1234.2 +059500 MOVE SPACE TO DUMMY-RECORD. SQ1234.2 +059600 BLANK-LINE-PRINT. SQ1234.2 +059700 PERFORM WRT-LN. SQ1234.2 +059800 FAIL-ROUTINE. SQ1234.2 +059900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1234.2 +060000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1234.2 +060100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +060200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1234.2 +060300 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +060400 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +060500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +060600 GO TO FAIL-ROUTINE-EX. SQ1234.2 +060700 FAIL-ROUTINE-WRITE. SQ1234.2 +060800 MOVE TEST-COMPUTED TO PRINT-REC SQ1234.2 +060900 PERFORM WRITE-LINE SQ1234.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1234.2 +061100 MOVE TEST-CORRECT TO PRINT-REC SQ1234.2 +061200 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +061300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1234.2 +061400 FAIL-ROUTINE-EX. SQ1234.2 +061500 EXIT. SQ1234.2 +061600 BAIL-OUT. SQ1234.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1234.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1234.2 +061900 BAIL-OUT-WRITE. SQ1234.2 +062000 MOVE CORRECT-A TO XXCORRECT. SQ1234.2 +062100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1234.2 +062200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +062300 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +062400 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +062500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +062600 BAIL-OUT-EX. SQ1234.2 +062700 EXIT. SQ1234.2 +062800 CCVS1-EXIT. SQ1234.2 +062900 EXIT. SQ1234.2 +063000* SQ1234.2 +063100**************************************************************** SQ1234.2 +063200* * SQ1234.2 +063300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1234.2 +063400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1234.2 +063500* * SQ1234.2 +063600**************************************************************** SQ1234.2 +063700* SQ1234.2 +063800 SECT-SQ123A-0004 SECTION. SQ1234.2 +063900 STA-INIT. SQ1234.2 +064000 MOVE SPACE TO DELETE-SW. SQ1234.2 +064100* SQ1234.2 +064200 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1234.2 +064300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1234.2 +064400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1234.2 +064500 MOVE 125 TO XRECORD-LENGTH (1). SQ1234.2 +064600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1234.2 +064700 MOVE 1 TO XBLOCK-SIZE (1). SQ1234.2 +064800 MOVE 0 TO RECORDS-IN-FILE (1). SQ1234.2 +064900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1234.2 +065000 MOVE "S" TO XLABEL-TYPE (1). SQ1234.2 +065100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1234.2 +065200* SQ1234.2 +065300* OPEN THE FILE IN THE OUTPUT MODE SQ1234.2 +065400* SQ1234.2 +065500 SEQ-INIT-01. SQ1234.2 +065600 MOVE 0 TO REC-CT. SQ1234.2 +065700 MOVE "*" TO DECL-EXEC-SW. SQ1234.2 +065800 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +065900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +066000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +066100 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1234.2 +066200 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1234.2 +066300 GO TO SEQ-TEST-OP-01. SQ1234.2 +066400 SEQ-DELETE-01. SQ1234.2 +066500 MOVE "*" TO DELETE-SW-1. SQ1234.2 +066600 GO TO SEQ-DELETE-01-01. SQ1234.2 +066700 SEQ-TEST-OP-01. SQ1234.2 +066800 OPEN OUTPUT SQ-FS4. SQ1234.2 +066900* SQ1234.2 +067000* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1234.2 +067100* SQ1234.2 +067200 ADD 1 TO REC-CT. SQ1234.2 +067300 IF DELETE-SW NOT = SPACE SQ1234.2 +067400 GO TO SEQ-DELETE-01-01. SQ1234.2 +067500 GO TO SEQ-TEST-OP-01-01. SQ1234.2 +067600 SEQ-DELETE-01-01. SQ1234.2 +067700 PERFORM DE-LETE. SQ1234.2 +067800 GO TO SEQ-TEST-01-01-END. SQ1234.2 +067900 SEQ-TEST-OP-01-01. SQ1234.2 +068000 IF SQ-FS4-STATUS = "00" SQ1234.2 +068100 PERFORM PASS SQ1234.2 +068200 ELSE SQ1234.2 +068300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +068400 MOVE "00" TO CORRECT-A SQ1234.2 +068500 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1234.2 +068600 TO RE-MARK SQ1234.2 +068700 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1234.2 +068800 PERFORM FAIL. SQ1234.2 +068900 SEQ-TEST-01-01-END. SQ1234.2 +069000* SQ1234.2 +069100* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +069200* SQ1234.2 +069300 ADD 1 TO REC-CT. SQ1234.2 +069400 IF DELETE-SW NOT = SPACE SQ1234.2 +069500 GO TO SEQ-DELETE-01-02. SQ1234.2 +069600 GO TO SEQ-TEST-OP-01-02. SQ1234.2 +069700 SEQ-DELETE-01-02. SQ1234.2 +069800 PERFORM DE-LETE. SQ1234.2 +069900 GO TO SEQ-TEST-01-02-END. SQ1234.2 +070000 SEQ-TEST-OP-01-02. SQ1234.2 +070100 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +070200 PERFORM PASS SQ1234.2 +070300 ELSE SQ1234.2 +070400 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +070500 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +070600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +070700 TO RE-MARK SQ1234.2 +070800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +070900 PERFORM FAIL. SQ1234.2 +071000 SEQ-TEST-01-02-END. SQ1234.2 +071100* SQ1234.2 +071200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +071300* SQ1234.2 +071400 ADD 1 TO REC-CT. SQ1234.2 +071500 IF DELETE-SW NOT = SPACE SQ1234.2 +071600 GO TO SEQ-DELETE-01-03. SQ1234.2 +071700 GO TO SEQ-TEST-OP-01-03. SQ1234.2 +071800 SEQ-DELETE-01-03. SQ1234.2 +071900 PERFORM DE-LETE. SQ1234.2 +072000 GO TO SEQ-TEST-01-03-END. SQ1234.2 +072100 SEQ-TEST-OP-01-03. SQ1234.2 +072200 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +072300 PERFORM PASS SQ1234.2 +072400 ELSE SQ1234.2 +072500 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +072600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +072700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +072800 TO RE-MARK SQ1234.2 +072900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +073000 PERFORM FAIL. SQ1234.2 +073100 SEQ-TEST-01-03-END. SQ1234.2 +073200* SQ1234.2 +073300* SQ1234.2 +073400* THE FILE HAS BEEN CREATED. WE NOW EXECUTE CLOSE REEL SQ1234.2 +073500* SQ1234.2 +073600 SEQ-INIT-02. SQ1234.2 +073700 MOVE 0 TO REC-CT. SQ1234.2 +073800 MOVE "*" TO DECL-EXEC-SW. SQ1234.2 +073900 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +074000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +074100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +074200 MOVE "CLOSE REEL, NON-REEL" TO FEATURE. SQ1234.2 +074300 MOVE "SEQ-TEST-CR-02" TO PAR-NAME. SQ1234.2 +074400 IF DELETE-SW NOT EQUAL TO SPACE SQ1234.2 +074500 GO TO SEQ-DELETE-02. SQ1234.2 +074600 GO TO SEQ-TEST-CR-02. SQ1234.2 +074700 SEQ-DELETE-02. SQ1234.2 +074800 MOVE "*" TO DELETE-SW-2. SQ1234.2 +074900 GO TO SEQ-DELETE-02-01. SQ1234.2 +075000 SEQ-TEST-CR-02. SQ1234.2 +075100 CLOSE SQ-FS4 REEL. SQ1234.2 +075200* SQ1234.2 +075300* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1234.2 +075400* SQ1234.2 +075500 ADD 1 TO REC-CT. SQ1234.2 +075600 IF DELETE-SW NOT = SPACE SQ1234.2 +075700 GO TO SEQ-DELETE-02-01. SQ1234.2 +075800 GO TO SEQ-TEST-CR-02-01. SQ1234.2 +075900 SEQ-DELETE-02-01. SQ1234.2 +076000 PERFORM DE-LETE. SQ1234.2 +076100 GO TO SEQ-TEST-02-01-END. SQ1234.2 +076200 SEQ-TEST-CR-02-01. SQ1234.2 +076300 IF SQ-FS4-STATUS = "07" SQ1234.2 +076400 PERFORM PASS SQ1234.2 +076500 ELSE SQ1234.2 +076600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +076700 MOVE "07" TO CORRECT-A SQ1234.2 +076800 MOVE "UNEXPECTED I-O STATUS FROM CLOSE REEL" SQ1234.2 +076900 TO RE-MARK SQ1234.2 +077000 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1234.2 +077100 PERFORM FAIL. SQ1234.2 +077200 SEQ-TEST-02-01-END. SQ1234.2 +077300* SQ1234.2 +077400* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +077500* SQ1234.2 +077600 ADD 1 TO REC-CT. SQ1234.2 +077700 IF DELETE-SW NOT = SPACE SQ1234.2 +077800 GO TO SEQ-DELETE-02-02. SQ1234.2 +077900 GO TO SEQ-TEST-CR-02-02. SQ1234.2 +078000 SEQ-DELETE-02-02. SQ1234.2 +078100 PERFORM DE-LETE. SQ1234.2 +078200 GO TO SEQ-TEST-02-02-END. SQ1234.2 +078300 SEQ-TEST-CR-02-02. SQ1234.2 +078400 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +078500 PERFORM PASS SQ1234.2 +078600 ELSE SQ1234.2 +078700 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +078800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +078900 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +079000 TO RE-MARK SQ1234.2 +079100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +079200 PERFORM FAIL. SQ1234.2 +079300 SEQ-TEST-02-02-END. SQ1234.2 +079400* SQ1234.2 +079500* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +079600* SQ1234.2 +079700 ADD 1 TO REC-CT. SQ1234.2 +079800 IF DELETE-SW NOT = SPACE SQ1234.2 +079900 GO TO SEQ-DELETE-02-03. SQ1234.2 +080000 GO TO SEQ-TEST-CR-02-03. SQ1234.2 +080100 SEQ-DELETE-02-03. SQ1234.2 +080200 PERFORM DE-LETE. SQ1234.2 +080300 GO TO SEQ-TEST-02-03-END. SQ1234.2 +080400 SEQ-TEST-CR-02-03. SQ1234.2 +080500 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +080600 PERFORM PASS SQ1234.2 +080700 ELSE SQ1234.2 +080800 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +080900 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +081000 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1234.2 +081100 TO RE-MARK SQ1234.2 +081200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +081300 PERFORM FAIL. SQ1234.2 +081400 SEQ-TEST-02-03-END. SQ1234.2 +081500 MOVE SPACE TO DELETE-SW-2. SQ1234.2 +081600* SQ1234.2 +081700* SQ1234.2 +081800* NOW EXECUTE A NORMAL CLOSE ON THE EMPTY FILE. SQ1234.2 +081900* SQ1234.2 +082000 SEQ-INIT-03. SQ1234.2 +082100 MOVE 0 TO REC-CT. SQ1234.2 +082200 MOVE SPACE TO DECL-EXEC-SW. SQ1234.2 +082300 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +082400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +082500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +082600 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1234.2 +082700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1234.2 +082800 IF DELETE-SW NOT EQUAL TO SPACE SQ1234.2 +082900 GO TO SEQ-DELETE-03. SQ1234.2 +083000 GO TO SEQ-TEST-CL-03. SQ1234.2 +083100 SEQ-DELETE-03. SQ1234.2 +083200 MOVE "*" TO DELETE-SW-2. SQ1234.2 +083300 GO TO SEQ-DELETE-03-01. SQ1234.2 +083400 SEQ-TEST-CL-03. SQ1234.2 +083500 CLOSE SQ-FS4. SQ1234.2 +083600* SQ1234.2 +083700* CHECK I-O STATUS RETURNED FROM CLOSE SQ1234.2 +083800* SQ1234.2 +083900 ADD 1 TO REC-CT. SQ1234.2 +084000 IF DELETE-SW NOT = SPACE SQ1234.2 +084100 GO TO SEQ-DELETE-03-01. SQ1234.2 +084200 GO TO SEQ-TEST-CL-03-01. SQ1234.2 +084300 SEQ-DELETE-03-01. SQ1234.2 +084400 PERFORM DE-LETE. SQ1234.2 +084500 GO TO SEQ-TEST-03-01-END. SQ1234.2 +084600 SEQ-TEST-CL-03-01. SQ1234.2 +084700 IF SQ-FS4-STATUS = "00" SQ1234.2 +084800 PERFORM PASS SQ1234.2 +084900 ELSE SQ1234.2 +085000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +085100 MOVE "00" TO CORRECT-A SQ1234.2 +085200 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1234.2 +085300 TO RE-MARK SQ1234.2 +085400 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1234.2 +085500 PERFORM FAIL. SQ1234.2 +085600 SEQ-TEST-03-01-END. SQ1234.2 +085700* SQ1234.2 +085800* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +085900* SQ1234.2 +086000 ADD 1 TO REC-CT. SQ1234.2 +086100 IF DELETE-SW NOT = SPACE SQ1234.2 +086200 GO TO SEQ-DELETE-03-02. SQ1234.2 +086300 GO TO SEQ-TEST-CL-03-02. SQ1234.2 +086400 SEQ-DELETE-03-02. SQ1234.2 +086500 PERFORM DE-LETE. SQ1234.2 +086600 GO TO SEQ-TEST-03-02-END. SQ1234.2 +086700 SEQ-TEST-CL-03-02. SQ1234.2 +086800 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +086900 PERFORM PASS SQ1234.2 +087000 ELSE SQ1234.2 +087100 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +087200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +087300 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +087400 TO RE-MARK SQ1234.2 +087500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +087600 PERFORM FAIL. SQ1234.2 +087700 SEQ-TEST-03-02-END. SQ1234.2 +087800* SQ1234.2 +087900* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +088000* SQ1234.2 +088100 ADD 1 TO REC-CT. SQ1234.2 +088200 IF DELETE-SW NOT = SPACE SQ1234.2 +088300 GO TO SEQ-DELETE-03-03. SQ1234.2 +088400 GO TO SEQ-TEST-CL-03-03. SQ1234.2 +088500 SEQ-DELETE-03-03. SQ1234.2 +088600 PERFORM DE-LETE. SQ1234.2 +088700 GO TO SEQ-TEST-03-03-END. SQ1234.2 +088800 SEQ-TEST-CL-03-03. SQ1234.2 +088900 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +089000 PERFORM PASS SQ1234.2 +089100 ELSE SQ1234.2 +089200 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +089300 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +089400 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1234.2 +089500 TO RE-MARK SQ1234.2 +089600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +089700 PERFORM FAIL. SQ1234.2 +089800 SEQ-TEST-03-03-END. SQ1234.2 +089900 MOVE SPACE TO DELETE-SW-2. SQ1234.2 +090000* SQ1234.2 +090100* SQ1234.2 +090200 CCVS-EXIT SECTION. SQ1234.2 +090300 CCVS-999999. SQ1234.2 +090400 GO TO CLOSE-FILES. SQ1234.2 +*END-OF,SQ123A +*HEADER,COBOL,SQ124A +000100 IDENTIFICATION DIVISION. SQ1244.2 +000200 PROGRAM-ID. SQ1244.2 +000300 SQ124A. SQ1244.2 +000400**************************************************************** SQ1244.2 +000500* * SQ1244.2 +000600* VALIDATION FOR:- * SQ1244.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1244.2 +000900* REVISED 1986, AUGUST * SQ1244.2 +001000* * SQ1244.2 +001100* CREATION DATE / VALIDATION DATE * SQ1244.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1244.2 +001300* * SQ1244.2 +001400**************************************************************** SQ1244.2 +001500* * SQ1244.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1244.2 +001700* * SQ1244.2 +001800* X-14 SEQUENTIAL NON-UNIT MASS STORAGE FILE * SQ1244.2 +001900* X-55 SYSTEM PRINTER * SQ1244.2 +002000* X-82 SOURCE-COMPUTER * SQ1244.2 +002100* X-83 OBJECT-COMPUTER. * SQ1244.2 +002200* * SQ1244.2 +002300**************************************************************** SQ1244.2 +002400* * SQ1244.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1244.2 +002600* TO A MEDIUM WHICH IS NOT A REEL/UNIT MEDIUM. ONE RECORD * SQ1244.2 +002700* IS WRITTEN TO THE FILE AND A CLOSE UNIT STATEMENT IS * SQ1244.2 +002800* EXECUTED. THIS SHOULD HAVE NO EFFECT ON THE FILE, EXCEPT * SQ1244.2 +002900* TO CAUSE I-O STATUS 07. THE FILE SHOULD REMAIN OPEN. A * SQ1244.2 +003000* SECOND RECORD IS THEN WRITTEN AND A NORMAL, UNQUALIFIED, * SQ1244.2 +003100* CLOSE STATEMENT IS EXECUTED. THIS SHOULD BE SUCCESSFUL * SQ1244.2 +003200* AND CLOSE THE FILE. THE FILE IS THEN REOPENED FOR INPUT * SQ1244.2 +003300* AND THE TWO RECORDS CHECKED. A CLOSE UNIT STATEMENT IS * SQ1244.2 +003400* EXECUTED BEFORE THE FIRST RECORD IS READ, AND AGAIN THIS * SQ1244.2 +003500* SHOULD HAVE NO EFFECT ON SUBSEQUENT OPERATIONS ON THE * SQ1244.2 +003600* FILE. AFTER THE TWO RECORDS HAVE BEEN READ, A FURTHER * SQ1244.2 +003700* READ STATEMENT IS EXECUTED TO RAISE THE AT END CONDITION, * SQ1244.2 +003800* WHICH IS CHECKED, AND THE FILE IS CLOSED. * SQ1244.2 +003900* * SQ1244.2 +004000**************************************************************** SQ1244.2 +004100* SQ1244.2 +004200 ENVIRONMENT DIVISION. SQ1244.2 +004300 CONFIGURATION SECTION. SQ1244.2 +004400 SOURCE-COMPUTER. SQ1244.2 +004500 XXXXX082. SQ1244.2 +004600 OBJECT-COMPUTER. SQ1244.2 +004700 XXXXX083. SQ1244.2 +004800* SQ1244.2 +004900 INPUT-OUTPUT SECTION. SQ1244.2 +005000 FILE-CONTROL. SQ1244.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1244.2 +005200 XXXXX055. SQ1244.2 +005300* SQ1244.2 +005400P SELECT RAW-DATA ASSIGN TO SQ1244.2 +005500P XXXXX062 SQ1244.2 +005600P ORGANIZATION IS INDEXED SQ1244.2 +005700P ACCESS MODE IS RANDOM SQ1244.2 +005800P RECORD-KEY IS RAW-DATA-KEY. SQ1244.2 +005900P SQ1244.2 +006000 SELECT SQ-FS4 ASSIGN SQ1244.2 +006100 XXXXX014 SQ1244.2 +006200 ORGANIZATION IS SEQUENTIAL SQ1244.2 +006300 ACCESS SEQUENTIAL SQ1244.2 +006400 FILE STATUS SQ-FS4-STATUS SQ1244.2 +006500 IN STATUS-GROUP SQ1244.2 +006600 . SQ1244.2 +006700* SQ1244.2 +006800* SQ1244.2 +006900 DATA DIVISION. SQ1244.2 +007000 FILE SECTION. SQ1244.2 +007100 FD PRINT-FILE SQ1244.2 +007200C LABEL RECORDS SQ1244.2 +007300C XXXXX084 SQ1244.2 +007400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1244.2 +007500 . SQ1244.2 +007600 01 PRINT-REC PICTURE X(120). SQ1244.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1244.2 +007800P SQ1244.2 +007900PFD RAW-DATA. SQ1244.2 +008000P01 RAW-DATA-SATZ. SQ1244.2 +008100P 05 RAW-DATA-KEY PIC X(6). SQ1244.2 +008200P 05 C-DATE PIC 9(6). SQ1244.2 +008300P 05 C-TIME PIC 9(8). SQ1244.2 +008400P 05 NO-OF-TESTS PIC 99. SQ1244.2 +008500P 05 C-OK PIC 999. SQ1244.2 +008600P 05 C-ALL PIC 999. SQ1244.2 +008700P 05 C-FAIL PIC 999. SQ1244.2 +008800P 05 C-DELETED PIC 999. SQ1244.2 +008900P 05 C-INSPECT PIC 999. SQ1244.2 +009000P 05 C-NOTE PIC X(13). SQ1244.2 +009100P 05 C-INDENT PIC X. SQ1244.2 +009200P 05 C-ABORT PIC X(8). SQ1244.2 +009300* SQ1244.2 +009400 FD SQ-FS4 SQ1244.2 +009500C LABEL RECORD IS STANDARD SQ1244.2 +009600 . SQ1244.2 +009700 01 SQ-FS4R1-F-G-120. SQ1244.2 +009800 05 SQ-FS4R1-RECORD-INFO-P1-120. SQ1244.2 +009900 07 FILLER PIC X(5). SQ1244.2 +010000 07 FFILE-NAME PIC X(6). SQ1244.2 +010100 07 FILLER PIC X(8). SQ1244.2 +010200 07 FRECORD-NAME PIC X(6). SQ1244.2 +010300 07 FILLER PIC X(1). SQ1244.2 +010400 07 FREELUNIT-NUMBER PIC 9(1). SQ1244.2 +010500 07 FILLER PIC X(7). SQ1244.2 +010600 07 FRECORD-NUMBER PIC 9(6). SQ1244.2 +010700 07 FILLER PIC X(6). SQ1244.2 +010800 07 FUPDATE-NUMBER PIC 9(2). SQ1244.2 +010900 07 FILLER PIC X(5). SQ1244.2 +011000 07 FODO-NUMBER PIC 9(4). SQ1244.2 +011100 07 FILLER PIC X(5). SQ1244.2 +011200 07 FPROGRAM-NAME PIC X(5). SQ1244.2 +011300 07 FILLER PIC X(7). SQ1244.2 +011400 07 FRECORD-LENGTH PIC 9(6). SQ1244.2 +011500 07 FILLER PIC X(7). SQ1244.2 +011600 07 FCHARS-OR-RECORDS PIC X(2). SQ1244.2 +011700 07 FILLER PIC X(1). SQ1244.2 +011800 07 FBLOCK-SIZE PIC 9(4). SQ1244.2 +011900 07 FILLER PIC X(6). SQ1244.2 +012000 07 FRECORDS-IN-FILE PIC 9(6). SQ1244.2 +012100 07 FILLER PIC X(5). SQ1244.2 +012200 07 FFILE-ORGANIZATION PIC X(2). SQ1244.2 +012300 07 FILLER PIC X(6). SQ1244.2 +012400 07 FLABEL-TYPE PIC X(1). SQ1244.2 +012500* SQ1244.2 +012600 WORKING-STORAGE SECTION. SQ1244.2 +012700* SQ1244.2 +012800*************************************************************** SQ1244.2 +012900* * SQ1244.2 +013000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1244.2 +013100* * SQ1244.2 +013200*************************************************************** SQ1244.2 +013300* SQ1244.2 +013400 01 STATUS-GROUP. SQ1244.2 +013500 03 SQ-FS4-STATUS. SQ1244.2 +013600 05 SQ-FS4-KEY-1 PIC X. SQ1244.2 +013700 05 SQ-FS4-KEY-2 PIC X. SQ1244.2 +013800* SQ1244.2 +013900 01 DELETE-SW. SQ1244.2 +014000 03 DELETE-SW-1 PIC X. SQ1244.2 +014100 03 DELETE-SW-1-GROUP. SQ1244.2 +014200 05 DELETE-SW-2 PIC X. SQ1244.2 +014300 05 DELETE-SW-2-GROUP. SQ1244.2 +014400 07 DELETE-SW-3 PIC X. SQ1244.2 +014500* SQ1244.2 +014600 01 AT-END-SW PIC X(12). SQ1244.2 +014700 01 NOT-END-SW PIC X(12). SQ1244.2 +014800* SQ1244.2 +014900*************************************************************** SQ1244.2 +015000* * SQ1244.2 +015100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1244.2 +015200* * SQ1244.2 +015300*************************************************************** SQ1244.2 +015400* SQ1244.2 +015500 01 REC-SKEL-SUB PIC 99. SQ1244.2 +015600* SQ1244.2 +015700 01 FILE-RECORD-INFORMATION-REC. SQ1244.2 +015800 03 FILE-RECORD-INFO-SKELETON. SQ1244.2 +015900 05 FILLER PICTURE X(48) VALUE SQ1244.2 +016000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1244.2 +016100 05 FILLER PICTURE X(46) VALUE SQ1244.2 +016200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1244.2 +016300 05 FILLER PICTURE X(26) VALUE SQ1244.2 +016400 ",LFIL=000000,ORG= ,LBLR= ". SQ1244.2 +016500 05 FILLER PICTURE X(37) VALUE SQ1244.2 +016600 ",RECKEY= ". SQ1244.2 +016700 05 FILLER PICTURE X(38) VALUE SQ1244.2 +016800 ",ALTKEY1= ". SQ1244.2 +016900 05 FILLER PICTURE X(38) VALUE SQ1244.2 +017000 ",ALTKEY2= ". SQ1244.2 +017100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1244.2 +017200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1244.2 +017300 05 FILE-RECORD-INFO-P1-120. SQ1244.2 +017400 07 FILLER PIC X(5). SQ1244.2 +017500 07 XFILE-NAME PIC X(6). SQ1244.2 +017600 07 FILLER PIC X(8). SQ1244.2 +017700 07 XRECORD-NAME PIC X(6). SQ1244.2 +017800 07 FILLER PIC X(1). SQ1244.2 +017900 07 REELUNIT-NUMBER PIC 9(1). SQ1244.2 +018000 07 FILLER PIC X(7). SQ1244.2 +018100 07 XRECORD-NUMBER PIC 9(6). SQ1244.2 +018200 07 FILLER PIC X(6). SQ1244.2 +018300 07 UPDATE-NUMBER PIC 9(2). SQ1244.2 +018400 07 FILLER PIC X(5). SQ1244.2 +018500 07 ODO-NUMBER PIC 9(4). SQ1244.2 +018600 07 FILLER PIC X(5). SQ1244.2 +018700 07 XPROGRAM-NAME PIC X(5). SQ1244.2 +018800 07 FILLER PIC X(7). SQ1244.2 +018900 07 XRECORD-LENGTH PIC 9(6). SQ1244.2 +019000 07 FILLER PIC X(7). SQ1244.2 +019100 07 CHARS-OR-RECORDS PIC X(2). SQ1244.2 +019200 07 FILLER PIC X(1). SQ1244.2 +019300 07 XBLOCK-SIZE PIC 9(4). SQ1244.2 +019400 07 FILLER PIC X(6). SQ1244.2 +019500 07 RECORDS-IN-FILE PIC 9(6). SQ1244.2 +019600 07 FILLER PIC X(5). SQ1244.2 +019700 07 XFILE-ORGANIZATION PIC X(2). SQ1244.2 +019800 07 FILLER PIC X(6). SQ1244.2 +019900 07 XLABEL-TYPE PIC X(1). SQ1244.2 +020000 05 FILE-RECORD-INFO-P121-240. SQ1244.2 +020100 07 FILLER PIC X(8). SQ1244.2 +020200 07 XRECORD-KEY PIC X(29). SQ1244.2 +020300 07 FILLER PIC X(9). SQ1244.2 +020400 07 ALTERNATE-KEY1 PIC X(29). SQ1244.2 +020500 07 FILLER PIC X(9). SQ1244.2 +020600 07 ALTERNATE-KEY2 PIC X(29). SQ1244.2 +020700 07 FILLER PIC X(7). SQ1244.2 +020800* SQ1244.2 +020900 01 TEST-RESULTS. SQ1244.2 +021000 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021100 02 PAR-NAME. SQ1244.2 +021200 03 FILLER PIC X(14) VALUE SPACE. SQ1244.2 +021300 03 PARDOT-X PIC X VALUE SPACE. SQ1244.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1244.2 +021500 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021600 02 FEATURE PIC X(24) VALUE SPACE. SQ1244.2 +021700 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1244.2 +021900 02 FILLER PIC X(9) VALUE SPACE. SQ1244.2 +022000 02 RE-MARK PIC X(61). SQ1244.2 +022100 01 TEST-COMPUTED. SQ1244.2 +022200 02 FILLER PIC X(30) VALUE SPACE. SQ1244.2 +022300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1244.2 +022400 02 COMPUTED-X. SQ1244.2 +022500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1244.2 +022600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1244.2 +022700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1244.2 +022800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1244.2 +022900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1244.2 +023000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1244.2 +023100 04 COMPUTED-18V0 PIC -9(18). SQ1244.2 +023200 04 FILLER PIC X. SQ1244.2 +023300 03 FILLER PIC X(50) VALUE SPACE. SQ1244.2 +023400 01 TEST-CORRECT. SQ1244.2 +023500 02 FILLER PIC X(30) VALUE SPACE. SQ1244.2 +023600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1244.2 +023700 02 CORRECT-X. SQ1244.2 +023800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1244.2 +023900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1244.2 +024000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1244.2 +024100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1244.2 +024200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1244.2 +024300 03 CR-18V0 REDEFINES CORRECT-A. SQ1244.2 +024400 04 CORRECT-18V0 PIC -9(18). SQ1244.2 +024500 04 FILLER PIC X. SQ1244.2 +024600 03 FILLER PIC X(2) VALUE SPACE. SQ1244.2 +024700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1244.2 +024800* SQ1244.2 +024900 01 CCVS-C-1. SQ1244.2 +025000 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1244.2 +025200 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1244.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1244.2 +025600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1244.2 +025700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1244.2 +025800 01 CCVS-C-2. SQ1244.2 +025900 02 FILLER PIC X(19) VALUE SPACE. SQ1244.2 +026000 02 FILLER PIC X(6) VALUE "TESTED". SQ1244.2 +026100 02 FILLER PIC X(19) VALUE SPACE. SQ1244.2 +026200 02 FILLER PIC X(4) VALUE "FAIL". SQ1244.2 +026300 02 FILLER PIC X(72) VALUE SPACE. SQ1244.2 +026400* SQ1244.2 +026500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1244.2 +026600 01 REC-CT PIC 99 VALUE ZERO. SQ1244.2 +026700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +026800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +026900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +027000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +027100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1244.2 +027200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1244.2 +027300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1244.2 +027400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1244.2 +027500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1244.2 +027600 01 CCVS-H-1. SQ1244.2 +027700 02 FILLER PIC X(39) VALUE SPACES. SQ1244.2 +027800 02 FILLER PIC X(42) VALUE SQ1244.2 +027900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1244.2 +028000 02 FILLER PIC X(39) VALUE SPACES. SQ1244.2 +028100 01 CCVS-H-2A. SQ1244.2 +028200 02 FILLER PIC X(40) VALUE SPACE. SQ1244.2 +028300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1244.2 +028400 02 FILLER PIC XXXX VALUE SQ1244.2 +028500 "4.2 ". SQ1244.2 +028600 02 FILLER PIC X(28) VALUE SQ1244.2 +028700 " COPY - NOT FOR DISTRIBUTION". SQ1244.2 +028800 02 FILLER PIC X(41) VALUE SPACE. SQ1244.2 +028900* SQ1244.2 +029000 01 CCVS-H-2B. SQ1244.2 +029100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1244.2 +029200 02 TEST-ID PIC X(9). SQ1244.2 +029300 02 FILLER PIC X(4) VALUE " IN ". SQ1244.2 +029400 02 FILLER PIC X(12) VALUE SQ1244.2 +029500 " HIGH ". SQ1244.2 +029600 02 FILLER PIC X(22) VALUE SQ1244.2 +029700 " LEVEL VALIDATION FOR ". SQ1244.2 +029800 02 FILLER PIC X(58) VALUE SQ1244.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +030000 01 CCVS-H-3. SQ1244.2 +030100 02 FILLER PIC X(34) VALUE SQ1244.2 +030200 " FOR OFFICIAL USE ONLY ". SQ1244.2 +030300 02 FILLER PIC X(58) VALUE SQ1244.2 +030400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1244.2 +030500 02 FILLER PIC X(28) VALUE SQ1244.2 +030600 " COPYRIGHT 1985,1986 ". SQ1244.2 +030700 01 CCVS-E-1. SQ1244.2 +030800 02 FILLER PIC X(52) VALUE SPACE. SQ1244.2 +030900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1244.2 +031000 02 ID-AGAIN PIC X(9). SQ1244.2 +031100 02 FILLER PIC X(45) VALUE SPACES. SQ1244.2 +031200 01 CCVS-E-2. SQ1244.2 +031300 02 FILLER PIC X(31) VALUE SPACE. SQ1244.2 +031400 02 FILLER PIC X(21) VALUE SPACE. SQ1244.2 +031500 02 CCVS-E-2-2. SQ1244.2 +031600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1244.2 +031700 03 FILLER PIC X VALUE SPACE. SQ1244.2 +031800 03 ENDER-DESC PIC X(44) VALUE SQ1244.2 +031900 "ERRORS ENCOUNTERED". SQ1244.2 +032000 01 CCVS-E-3. SQ1244.2 +032100 02 FILLER PIC X(22) VALUE SQ1244.2 +032200 " FOR OFFICIAL USE ONLY". SQ1244.2 +032300 02 FILLER PIC X(12) VALUE SPACE. SQ1244.2 +032400 02 FILLER PIC X(58) VALUE SQ1244.2 +032500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +032600 02 FILLER PIC X(8) VALUE SPACE. SQ1244.2 +032700 02 FILLER PIC X(20) VALUE SQ1244.2 +032800 " COPYRIGHT 1985,1986". SQ1244.2 +032900 01 CCVS-E-4. SQ1244.2 +033000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1244.2 +033100 02 FILLER PIC X(4) VALUE " OF ". SQ1244.2 +033200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1244.2 +033300 02 FILLER PIC X(40) VALUE SQ1244.2 +033400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1244.2 +033500 01 XXINFO. SQ1244.2 +033600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1244.2 +033700 02 INFO-TEXT. SQ1244.2 +033800 04 FILLER PIC X(8) VALUE SPACE. SQ1244.2 +033900 04 XXCOMPUTED PIC X(20). SQ1244.2 +034000 04 FILLER PIC X(5) VALUE SPACE. SQ1244.2 +034100 04 XXCORRECT PIC X(20). SQ1244.2 +034200 02 INF-ANSI-REFERENCE PIC X(48). SQ1244.2 +034300 01 HYPHEN-LINE. SQ1244.2 +034400 02 FILLER PIC IS X VALUE IS SPACE. SQ1244.2 +034500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1244.2 +034600- "*****************************************". SQ1244.2 +034700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1244.2 +034800- "******************************". SQ1244.2 +034900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1244.2 +035000 "SQ124A". SQ1244.2 +035100* SQ1244.2 +035200* SQ1244.2 +035300 PROCEDURE DIVISION. SQ1244.2 +035400 CCVS1 SECTION. SQ1244.2 +035500 OPEN-FILES. SQ1244.2 +035600P OPEN I-O RAW-DATA. SQ1244.2 +035700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1244.2 +035800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1244.2 +035900P MOVE "ABORTED " TO C-ABORT. SQ1244.2 +036000P ADD 1 TO C-NO-OF-TESTS. SQ1244.2 +036100P ACCEPT C-DATE FROM DATE. SQ1244.2 +036200P ACCEPT C-TIME FROM TIME. SQ1244.2 +036300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1244.2 +036400PEND-E-1. SQ1244.2 +036500P CLOSE RAW-DATA. SQ1244.2 +036600 OPEN OUTPUT PRINT-FILE. SQ1244.2 +036700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1244.2 +036800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1244.2 +036900 MOVE SPACE TO TEST-RESULTS. SQ1244.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1244.2 +037100 MOVE ZERO TO REC-SKEL-SUB. SQ1244.2 +037200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1244.2 +037300 GO TO CCVS1-EXIT. SQ1244.2 +037400* SQ1244.2 +037500 CCVS-INIT-FILE. SQ1244.2 +037600 ADD 1 TO REC-SKL-SUB. SQ1244.2 +037700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1244.2 +037800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1244.2 +037900* SQ1244.2 +038000 CLOSE-FILES. SQ1244.2 +038100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1244.2 +038200 CLOSE PRINT-FILE. SQ1244.2 +038300P OPEN I-O RAW-DATA. SQ1244.2 +038400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1244.2 +038500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1244.2 +038600P MOVE "OK. " TO C-ABORT. SQ1244.2 +038700P MOVE PASS-COUNTER TO C-OK. SQ1244.2 +038800P MOVE ERROR-HOLD TO C-ALL. SQ1244.2 +038900P MOVE ERROR-COUNTER TO C-FAIL. SQ1244.2 +039000P MOVE DELETE-CNT TO C-DELETED. SQ1244.2 +039100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1244.2 +039200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1244.2 +039300PEND-E-2. SQ1244.2 +039400P CLOSE RAW-DATA. SQ1244.2 +039500 TERMINATE-CCVS. SQ1244.2 +039600S EXIT PROGRAM. SQ1244.2 +039700 STOP RUN. SQ1244.2 +039800* SQ1244.2 +039900 INSPT. SQ1244.2 +040000 MOVE "INSPT" TO P-OR-F. SQ1244.2 +040100 ADD 1 TO INSPECT-COUNTER. SQ1244.2 +040200 PERFORM PRINT-DETAIL. SQ1244.2 +040300* SQ1244.2 +040400 PASS. SQ1244.2 +040500 MOVE "PASS " TO P-OR-F. SQ1244.2 +040600 ADD 1 TO PASS-COUNTER. SQ1244.2 +040700 PERFORM PRINT-DETAIL. SQ1244.2 +040800* SQ1244.2 +040900 FAIL. SQ1244.2 +041000 MOVE "FAIL*" TO P-OR-F. SQ1244.2 +041100 ADD 1 TO ERROR-COUNTER. SQ1244.2 +041200 PERFORM PRINT-DETAIL. SQ1244.2 +041300* SQ1244.2 +041400 DE-LETE. SQ1244.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1244.2 +041600 MOVE "*****" TO P-OR-F. SQ1244.2 +041700 ADD 1 TO DELETE-COUNTER. SQ1244.2 +041800 PERFORM PRINT-DETAIL. SQ1244.2 +041900* SQ1244.2 +042000 PRINT-DETAIL. SQ1244.2 +042100 IF REC-CT NOT EQUAL TO ZERO SQ1244.2 +042200 MOVE "." TO PARDOT-X SQ1244.2 +042300 MOVE REC-CT TO DOTVALUE. SQ1244.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. SQ1244.2 +042500 PERFORM WRITE-LINE. SQ1244.2 +042600 IF P-OR-F EQUAL TO "FAIL*" SQ1244.2 +042700 PERFORM WRITE-LINE SQ1244.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1244.2 +042900 ELSE SQ1244.2 +043000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1244.2 +043100 MOVE SPACE TO P-OR-F. SQ1244.2 +043200 MOVE SPACE TO COMPUTED-X. SQ1244.2 +043300 MOVE SPACE TO CORRECT-X. SQ1244.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1244.2 +043500 MOVE SPACE TO RE-MARK. SQ1244.2 +043600* SQ1244.2 +043700 HEAD-ROUTINE. SQ1244.2 +043800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +043900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +044000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1244.2 +044100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1244.2 +044200 COLUMN-NAMES-ROUTINE. SQ1244.2 +044300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +044400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +044600 END-ROUTINE. SQ1244.2 +044700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1244.2 +044800 PERFORM WRITE-LINE 5 TIMES. SQ1244.2 +044900 END-RTN-EXIT. SQ1244.2 +045000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1244.2 +045100 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +045200* SQ1244.2 +045300 END-ROUTINE-1. SQ1244.2 +045400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1244.2 +045500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1244.2 +045600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1244.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1244.2 +045800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1244.2 +045900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1244.2 +046000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1244.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1244.2 +046200 PERFORM WRITE-LINE. SQ1244.2 +046300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1244.2 +046400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1244.2 +046500 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +046600 ELSE SQ1244.2 +046700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1244.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1244.2 +046900 PERFORM WRITE-LINE. SQ1244.2 +047000 END-ROUTINE-13. SQ1244.2 +047100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1244.2 +047200 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +047300 ELSE SQ1244.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1244.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1244.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1244.2 +047700 PERFORM WRITE-LINE. SQ1244.2 +047800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1244.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +048000 ELSE SQ1244.2 +048100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1244.2 +048200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1244.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +048400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +048500* SQ1244.2 +048600 WRITE-LINE. SQ1244.2 +048700 ADD 1 TO RECORD-COUNT. SQ1244.2 +048800Y IF RECORD-COUNT GREATER 50 SQ1244.2 +048900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1244.2 +049000Y MOVE SPACE TO DUMMY-RECORD SQ1244.2 +049100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1244.2 +049200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1244.2 +049300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1244.2 +049400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1244.2 +049500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1244.2 +049600Y MOVE ZERO TO RECORD-COUNT. SQ1244.2 +049700 PERFORM WRT-LN. SQ1244.2 +049800* SQ1244.2 +049900 WRT-LN. SQ1244.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1244.2 +050100 MOVE SPACE TO DUMMY-RECORD. SQ1244.2 +050200 BLANK-LINE-PRINT. SQ1244.2 +050300 PERFORM WRT-LN. SQ1244.2 +050400 FAIL-ROUTINE. SQ1244.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1244.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1244.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1244.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1244.2 +050900 MOVE XXINFO TO DUMMY-RECORD. SQ1244.2 +051000 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1244.2 +051200 GO TO FAIL-ROUTINE-EX. SQ1244.2 +051300 FAIL-ROUTINE-WRITE. SQ1244.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC SQ1244.2 +051500 PERFORM WRITE-LINE SQ1244.2 +051600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1244.2 +051700 MOVE TEST-CORRECT TO PRINT-REC SQ1244.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +051900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1244.2 +052000 FAIL-ROUTINE-EX. SQ1244.2 +052100 EXIT. SQ1244.2 +052200 BAIL-OUT. SQ1244.2 +052300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1244.2 +052400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1244.2 +052500 BAIL-OUT-WRITE. SQ1244.2 +052600 MOVE CORRECT-A TO XXCORRECT. SQ1244.2 +052700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1244.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1244.2 +052900 MOVE XXINFO TO DUMMY-RECORD. SQ1244.2 +053000 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +053100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1244.2 +053200 BAIL-OUT-EX. SQ1244.2 +053300 EXIT. SQ1244.2 +053400 CCVS1-EXIT. SQ1244.2 +053500 EXIT. SQ1244.2 +053600* SQ1244.2 +053700**************************************************************** SQ1244.2 +053800* * SQ1244.2 +053900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1244.2 +054000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1244.2 +054100* * SQ1244.2 +054200**************************************************************** SQ1244.2 +054300* SQ1244.2 +054400 SECT-SQ124A-0004 SECTION. SQ1244.2 +054500 STA-INIT. SQ1244.2 +054600 MOVE SPACE TO DELETE-SW. SQ1244.2 +054700* SQ1244.2 +054800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1244.2 +054900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1244.2 +055000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1244.2 +055100 MOVE 125 TO XRECORD-LENGTH (1). SQ1244.2 +055200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1244.2 +055300 MOVE 1 TO XBLOCK-SIZE (1). SQ1244.2 +055400 MOVE 2 TO RECORDS-IN-FILE (1). SQ1244.2 +055500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1244.2 +055600 MOVE "S" TO XLABEL-TYPE (1). SQ1244.2 +055700 MOVE ZERO TO XRECORD-NUMBER (1). SQ1244.2 +055800* SQ1244.2 +055900* OPEN THE FILE IN THE OUTPUT MODE SQ1244.2 +056000* DELETION OF THE OPEN OPERATION DELETES EVERY TEST SQ1244.2 +056100* IN THE PROGRAM SQ1244.2 +056200* SQ1244.2 +056300 SEQ-INIT-01. SQ1244.2 +056400 MOVE 0 TO REC-CT. SQ1244.2 +056500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +056600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1244.2 +056700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1244.2 +056800 GO TO SEQ-TEST-OP-01. SQ1244.2 +056900 SEQ-DELETE-01. SQ1244.2 +057000 MOVE "*" TO DELETE-SW-1. SQ1244.2 +057100 GO TO SEQ-DELETE-01-01. SQ1244.2 +057200 SEQ-TEST-OP-01. SQ1244.2 +057300 OPEN OUTPUT SQ-FS4. SQ1244.2 +057400* SQ1244.2 +057500* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1244.2 +057600* SQ1244.2 +057700 ADD 1 TO REC-CT. SQ1244.2 +057800 IF DELETE-SW NOT = SPACE SQ1244.2 +057900 GO TO SEQ-DELETE-01-01. SQ1244.2 +058000 GO TO SEQ-TEST-OP-01-01. SQ1244.2 +058100 SEQ-DELETE-01-01. SQ1244.2 +058200 PERFORM DE-LETE. SQ1244.2 +058300 GO TO SEQ-TEST-01-01-END. SQ1244.2 +058400 SEQ-TEST-OP-01-01. SQ1244.2 +058500 IF SQ-FS4-STATUS = "00" SQ1244.2 +058600 PERFORM PASS SQ1244.2 +058700 ELSE SQ1244.2 +058800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +058900 MOVE "00" TO CORRECT-A SQ1244.2 +059000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1244.2 +059100 TO RE-MARK SQ1244.2 +059200 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1244.2 +059300 PERFORM FAIL. SQ1244.2 +059400 SEQ-TEST-01-01-END. SQ1244.2 +059500* SQ1244.2 +059600* SQ1244.2 +059700* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD SQ1244.2 +059800* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +059900* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +060000* SQ1244.2 +060100 SEQ-INIT-02. SQ1244.2 +060200 MOVE 0 TO REC-CT. SQ1244.2 +060300 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +060400 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +060500 MOVE "WRITE FIRST RECORD" TO FEATURE. SQ1244.2 +060600 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1244.2 +060700 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +060800 GO TO SEQ-DELETE-02. SQ1244.2 +060900 GO TO SEQ-TEST-WR-02. SQ1244.2 +061000 SEQ-DELETE-02. SQ1244.2 +061100 MOVE "*" TO DELETE-SW-2. SQ1244.2 +061200 GO TO SEQ-DELETE-02-01. SQ1244.2 +061300 SEQ-TEST-WR-02. SQ1244.2 +061400 MOVE FILE-RECORD-INFO (1) TO SQ-FS4R1-F-G-120. SQ1244.2 +061500 WRITE SQ-FS4R1-F-G-120. SQ1244.2 +061600* SQ1244.2 +061700* CHECK I-O STATUS RETURNED FROM WRITE SQ1244.2 +061800* SQ1244.2 +061900 ADD 1 TO REC-CT. SQ1244.2 +062000 IF DELETE-SW NOT = SPACE SQ1244.2 +062100 GO TO SEQ-DELETE-02-01. SQ1244.2 +062200 GO TO SEQ-TEST-WR-02-01. SQ1244.2 +062300 SEQ-DELETE-02-01. SQ1244.2 +062400 PERFORM DE-LETE. SQ1244.2 +062500 GO TO SEQ-TEST-02-01-END. SQ1244.2 +062600 SEQ-TEST-WR-02-01. SQ1244.2 +062700 IF SQ-FS4-STATUS = "00" SQ1244.2 +062800 PERFORM PASS SQ1244.2 +062900 ELSE SQ1244.2 +063000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +063100 MOVE "00" TO CORRECT-A SQ1244.2 +063200 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1244.2 +063300 MOVE "VII-3, VII-53,4.7.4(5)" TO ANSI-REFERENCE SQ1244.2 +063400 PERFORM FAIL. SQ1244.2 +063500 SEQ-TEST-02-01-END. SQ1244.2 +063600 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +063700* SQ1244.2 +063800* SQ1244.2 +063900* ONE RECORD HAS BEEN WRITTEN. WE NOW EXECUTE CLOSE REEL SQ1244.2 +064000* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +064100* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +064200* SQ1244.2 +064300 SEQ-INIT-03. SQ1244.2 +064400 MOVE 0 TO REC-CT. SQ1244.2 +064500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +064600 MOVE "CLOSE UNIT, NON-UNIT" TO FEATURE. SQ1244.2 +064700 MOVE "SEQ-TEST-CR-03" TO PAR-NAME. SQ1244.2 +064800 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +064900 GO TO SEQ-DELETE-03. SQ1244.2 +065000 GO TO SEQ-TEST-CR-03. SQ1244.2 +065100 SEQ-DELETE-03. SQ1244.2 +065200 MOVE "*" TO DELETE-SW-2. SQ1244.2 +065300 GO TO SEQ-DELETE-03-01. SQ1244.2 +065400 SEQ-TEST-CR-03. SQ1244.2 +065500 CLOSE SQ-FS4 UNIT. SQ1244.2 +065600* SQ1244.2 +065700* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1244.2 +065800* SQ1244.2 +065900 ADD 1 TO REC-CT. SQ1244.2 +066000 IF DELETE-SW NOT = SPACE SQ1244.2 +066100 GO TO SEQ-DELETE-03-01. SQ1244.2 +066200 GO TO SEQ-TEST-CR-03-01. SQ1244.2 +066300 SEQ-DELETE-03-01. SQ1244.2 +066400 PERFORM DE-LETE. SQ1244.2 +066500 GO TO SEQ-TEST-03-01-END. SQ1244.2 +066600 SEQ-TEST-CR-03-01. SQ1244.2 +066700 IF SQ-FS4-STATUS = "07" SQ1244.2 +066800 PERFORM PASS SQ1244.2 +066900 ELSE SQ1244.2 +067000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +067100 MOVE "07" TO CORRECT-A SQ1244.2 +067200 MOVE "UNEXPECTED I-O STATUS FROM CLOSE REEL" SQ1244.2 +067300 TO RE-MARK SQ1244.2 +067400 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1244.2 +067500 PERFORM FAIL. SQ1244.2 +067600 SEQ-TEST-03-01-END. SQ1244.2 +067700 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +067800* SQ1244.2 +067900* THE FILE SHOULD STILL BE OPEN. WE NOW WRITE ONE MORE RECORD SQ1244.2 +068000* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +068100* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +068200* SQ1244.2 +068300 SEQ-INIT-04. SQ1244.2 +068400 MOVE 0 TO REC-CT. SQ1244.2 +068500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +068600 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +068700 MOVE "WRITE SECOND RECORD" TO FEATURE. SQ1244.2 +068800 MOVE "SEQ-TEST-WR-04" TO PAR-NAME. SQ1244.2 +068900 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +069000 GO TO SEQ-DELETE-04. SQ1244.2 +069100 GO TO SEQ-TEST-WR-04. SQ1244.2 +069200 SEQ-DELETE-04. SQ1244.2 +069300 MOVE "*" TO DELETE-SW-2. SQ1244.2 +069400 GO TO SEQ-DELETE-04-01. SQ1244.2 +069500 SEQ-TEST-WR-04. SQ1244.2 +069600 MOVE FILE-RECORD-INFO (1) TO SQ-FS4R1-F-G-120. SQ1244.2 +069700 WRITE SQ-FS4R1-F-G-120. SQ1244.2 +069800* SQ1244.2 +069900* CHECK I-O STATUS RETURNED FROM WRITE SQ1244.2 +070000* SQ1244.2 +070100 ADD 1 TO REC-CT. SQ1244.2 +070200 IF DELETE-SW NOT = SPACE SQ1244.2 +070300 GO TO SEQ-DELETE-04-01. SQ1244.2 +070400 GO TO SEQ-TEST-WR-04-01. SQ1244.2 +070500 SEQ-DELETE-04-01. SQ1244.2 +070600 PERFORM DE-LETE. SQ1244.2 +070700 GO TO SEQ-TEST-04-01-END. SQ1244.2 +070800 SEQ-TEST-WR-04-01. SQ1244.2 +070900 IF SQ-FS4-STATUS = "00" SQ1244.2 +071000 PERFORM PASS SQ1244.2 +071100 ELSE SQ1244.2 +071200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +071300 MOVE "00" TO CORRECT-A SQ1244.2 +071400 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1244.2 +071500 MOVE "VII-3, VII-53,4.7.4(5)" TO ANSI-REFERENCE SQ1244.2 +071600 PERFORM FAIL. SQ1244.2 +071700 SEQ-TEST-04-01-END. SQ1244.2 +071800 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +071900* SQ1244.2 +072000* SQ1244.2 +072100* NOW EXECUTE A NORMAL CLOSE ON THE FILE. SQ1244.2 +072200* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +072300* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +072400* SQ1244.2 +072500 SEQ-INIT-05. SQ1244.2 +072600 MOVE 0 TO REC-CT. SQ1244.2 +072700 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +072800 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1244.2 +072900 MOVE "SEQ-TEST-CL-05" TO PAR-NAME. SQ1244.2 +073000 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +073100 GO TO SEQ-DELETE-05. SQ1244.2 +073200 GO TO SEQ-TEST-CL-05. SQ1244.2 +073300 SEQ-DELETE-05. SQ1244.2 +073400 MOVE "*" TO DELETE-SW-2. SQ1244.2 +073500 GO TO SEQ-DELETE-05-01. SQ1244.2 +073600 SEQ-TEST-CL-05. SQ1244.2 +073700 CLOSE SQ-FS4. SQ1244.2 +073800* SQ1244.2 +073900* CHECK I-O STATUS RETURNED FROM CLOSE SQ1244.2 +074000* SQ1244.2 +074100 ADD 1 TO REC-CT. SQ1244.2 +074200 IF DELETE-SW NOT = SPACE SQ1244.2 +074300 GO TO SEQ-DELETE-05-01. SQ1244.2 +074400 GO TO SEQ-TEST-CL-05-01. SQ1244.2 +074500 SEQ-DELETE-05-01. SQ1244.2 +074600 PERFORM DE-LETE. SQ1244.2 +074700 GO TO SEQ-TEST-05-01-END. SQ1244.2 +074800 SEQ-TEST-CL-05-01. SQ1244.2 +074900 IF SQ-FS4-STATUS = "00" SQ1244.2 +075000 PERFORM PASS SQ1244.2 +075100 ELSE SQ1244.2 +075200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +075300 MOVE "00" TO CORRECT-A SQ1244.2 +075400 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1244.2 +075500 TO RE-MARK SQ1244.2 +075600 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1244.2 +075700 PERFORM FAIL. SQ1244.2 +075800 SEQ-TEST-05-01-END. SQ1244.2 +075900 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +076000* SQ1244.2 +076100* SQ1244.2 +076200* NOW OPEN THE FILE FOR INPUT. SQ1244.2 +076300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +076400* AND ALSO DELETES THE SUBSEQUENT OPERATIONS. SQ1244.2 +076500* SQ1244.2 +076600 SEQ-INIT-06. SQ1244.2 +076700 MOVE 0 TO REC-CT. SQ1244.2 +076800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1244.2 +076900 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +077000 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1244.2 +077100 MOVE "SEQ-TEST-OP-06" TO PAR-NAME. SQ1244.2 +077200 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +077300 GO TO SEQ-DELETE-06. SQ1244.2 +077400 GO TO SEQ-TEST-OP-06. SQ1244.2 +077500 SEQ-DELETE-06. SQ1244.2 +077600 MOVE "*" TO DELETE-SW-2. SQ1244.2 +077700 GO TO SEQ-DELETE-06-01. SQ1244.2 +077800 SEQ-TEST-OP-06. SQ1244.2 +077900 OPEN INPUT SQ-FS4. SQ1244.2 +078000 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +078100* SQ1244.2 +078200* CHECK I-O STATUS RETURNED FROM OPEN SQ1244.2 +078300* SQ1244.2 +078400 ADD 1 TO REC-CT. SQ1244.2 +078500 IF DELETE-SW NOT = SPACE SQ1244.2 +078600 GO TO SEQ-DELETE-06-01. SQ1244.2 +078700 GO TO SEQ-TEST-OP-06-01. SQ1244.2 +078800 SEQ-DELETE-06-01. SQ1244.2 +078900 PERFORM DE-LETE. SQ1244.2 +079000 GO TO SEQ-TEST-06-01-END. SQ1244.2 +079100 SEQ-TEST-OP-06-01. SQ1244.2 +079200 IF SQ-FS4-STATUS = "00" SQ1244.2 +079300 PERFORM PASS SQ1244.2 +079400 ELSE SQ1244.2 +079500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +079600 MOVE "00" TO CORRECT-A SQ1244.2 +079700 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ1244.2 +079800 TO RE-MARK SQ1244.2 +079900 MOVE "VII-3, VII-43,4.3.4(23)" TO ANSI-REFERENCE SQ1244.2 +080000 PERFORM FAIL. SQ1244.2 +080100 SEQ-TEST-06-01-END. SQ1244.2 +080200* SQ1244.2 +080300* SQ1244.2 +080400* WE NOW EXECUTE CLOSE REEL BEFORE ANY RECORD HAS BEEN READ. SQ1244.2 +080500* APART FROM SETTING I-O STATUS 07 THIS SHOULD HAVE NO EFFECT SQ1244.2 +080600* ON THE FILE OR THE SUBSEQUENT RETRIEVAL OF RECORDS. SQ1244.2 +080700* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +080800* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +080900* SQ1244.2 +081000 SEQ-INIT-07. SQ1244.2 +081100 MOVE 0 TO REC-CT. SQ1244.2 +081200 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +081300 MOVE "CLOSE UNIT, NON-UNIT" TO FEATURE. SQ1244.2 +081400 MOVE "SEQ-TEST-CU-07" TO PAR-NAME. SQ1244.2 +081500 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +081600 GO TO SEQ-DELETE-07. SQ1244.2 +081700 GO TO SEQ-TEST-CU-07. SQ1244.2 +081800 SEQ-DELETE-07. SQ1244.2 +081900 MOVE "*" TO DELETE-SW-3. SQ1244.2 +082000 GO TO SEQ-DELETE-07-01. SQ1244.2 +082100 SEQ-TEST-CU-07. SQ1244.2 +082200 CLOSE SQ-FS4 UNIT. SQ1244.2 +082300* SQ1244.2 +082400* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1244.2 +082500* SQ1244.2 +082600 ADD 1 TO REC-CT. SQ1244.2 +082700 IF DELETE-SW NOT = SPACE SQ1244.2 +082800 GO TO SEQ-DELETE-07-01. SQ1244.2 +082900 GO TO SEQ-TEST-CU-07-01. SQ1244.2 +083000 SEQ-DELETE-07-01. SQ1244.2 +083100 PERFORM DE-LETE. SQ1244.2 +083200 GO TO SEQ-TEST-07-01-END. SQ1244.2 +083300 SEQ-TEST-CU-07-01. SQ1244.2 +083400 IF SQ-FS4-STATUS = "07" SQ1244.2 +083500 PERFORM PASS SQ1244.2 +083600 ELSE SQ1244.2 +083700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +083800 MOVE "07" TO CORRECT-A SQ1244.2 +083900 MOVE "UNEXPECTED I-O STATUS FROM CLOSE UNIT" SQ1244.2 +084000 TO RE-MARK SQ1244.2 +084100 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1244.2 +084200 PERFORM FAIL. SQ1244.2 +084300 SEQ-TEST-07-01-END. SQ1244.2 +084400 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +084500* SQ1244.2 +084600* THE FILE SHOULD STILL BE OPEN. WE NOW READ A RECORD. SQ1244.2 +084700* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +084800* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +084900* SQ1244.2 +085000 SEQ-INIT-08. SQ1244.2 +085100 MOVE 0 TO REC-CT. SQ1244.2 +085200 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +085300 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +085400 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +085500 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +085600 MOVE "READ FIRST RECORD" TO FEATURE. SQ1244.2 +085700 MOVE "SEQ-TEST-RD-08" TO PAR-NAME. SQ1244.2 +085800 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +085900 GO TO SEQ-DELETE-08. SQ1244.2 +086000 GO TO SEQ-TEST-RD-08. SQ1244.2 +086100 SEQ-DELETE-08. SQ1244.2 +086200 MOVE "*" TO DELETE-SW-3. SQ1244.2 +086300 GO TO SEQ-DELETE-08-01. SQ1244.2 +086400 SEQ-TEST-RD-08. SQ1244.2 +086500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +086600 READ SQ-FS4 SQ1244.2 +086700 AT END SQ1244.2 +086800 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +086900 NOT END SQ1244.2 +087000 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +087100* SQ1244.2 +087200* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +087300* SQ1244.2 +087400 ADD 1 TO REC-CT. SQ1244.2 +087500 IF DELETE-SW NOT = SPACE SQ1244.2 +087600 GO TO SEQ-DELETE-08-01. SQ1244.2 +087700 GO TO SEQ-TEST-RD-08-01. SQ1244.2 +087800 SEQ-DELETE-08-01. SQ1244.2 +087900 PERFORM DE-LETE. SQ1244.2 +088000 GO TO SEQ-TEST-08-01-END. SQ1244.2 +088100 SEQ-TEST-RD-08-01. SQ1244.2 +088200 IF SQ-FS4-STATUS = "00" SQ1244.2 +088300 PERFORM PASS SQ1244.2 +088400 ELSE SQ1244.2 +088500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +088600 MOVE "00" TO CORRECT-A SQ1244.2 +088700 MOVE "UNEXPECTED I-O STATUS FROM READ" TO RE-MARK SQ1244.2 +088800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +088900 PERFORM FAIL. SQ1244.2 +089000 SEQ-TEST-08-01-END. SQ1244.2 +089100* SQ1244.2 +089200* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +089300* SQ1244.2 +089400 ADD 1 TO REC-CT. SQ1244.2 +089500 IF DELETE-SW NOT = SPACE SQ1244.2 +089600 GO TO SEQ-DELETE-08-02. SQ1244.2 +089700 GO TO SEQ-TEST-RD-08-02. SQ1244.2 +089800 SEQ-DELETE-08-02. SQ1244.2 +089900 PERFORM DE-LETE. SQ1244.2 +090000 GO TO SEQ-TEST-08-02-END. SQ1244.2 +090100 SEQ-TEST-RD-08-02. SQ1244.2 +090200 IF AT-END-SW = "NOT EXECUTED" SQ1244.2 +090300 PERFORM PASS SQ1244.2 +090400 ELSE SQ1244.2 +090500 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +090600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +090700 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +090800 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +090900 PERFORM FAIL. SQ1244.2 +091000 SEQ-TEST-08-02-END. SQ1244.2 +091100* SQ1244.2 +091200* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +091300* SQ1244.2 +091400 ADD 1 TO REC-CT. SQ1244.2 +091500 IF DELETE-SW NOT = SPACE SQ1244.2 +091600 GO TO SEQ-DELETE-08-03. SQ1244.2 +091700 GO TO SEQ-TEST-RD-08-03. SQ1244.2 +091800 SEQ-DELETE-08-03. SQ1244.2 +091900 PERFORM DE-LETE. SQ1244.2 +092000 GO TO SEQ-TEST-08-03-END. SQ1244.2 +092100 SEQ-TEST-RD-08-03. SQ1244.2 +092200 IF NOT-END-SW = "EXECUTED" SQ1244.2 +092300 PERFORM PASS SQ1244.2 +092400 ELSE SQ1244.2 +092500 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +092600 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +092700 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +092800 TO RE-MARK SQ1244.2 +092900 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +093000 PERFORM FAIL. SQ1244.2 +093100 SEQ-TEST-08-03-END. SQ1244.2 +093200* SQ1244.2 +093300* CHECK THE RECORD NUMBER OF THE RECORD JUST READ. SQ1244.2 +093400* SQ1244.2 +093500 ADD 1 TO REC-CT. SQ1244.2 +093600 IF DELETE-SW NOT = SPACE SQ1244.2 +093700 GO TO SEQ-DELETE-08-04. SQ1244.2 +093800 GO TO SEQ-TEST-RD-08-04. SQ1244.2 +093900 SEQ-DELETE-08-04. SQ1244.2 +094000 PERFORM DE-LETE. SQ1244.2 +094100 GO TO SEQ-TEST-08-04-END. SQ1244.2 +094200 SEQ-TEST-RD-08-04. SQ1244.2 +094300 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1244.2 +094400 PERFORM PASS SQ1244.2 +094500 ELSE SQ1244.2 +094600 MOVE FRECORD-NUMBER TO COMPUTED-A SQ1244.2 +094700 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1244.2 +094800 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1244.2 +094900 PERFORM FAIL. SQ1244.2 +095000 SEQ-TEST-08-04-END. SQ1244.2 +095100 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +095200* SQ1244.2 +095300* SQ1244.2 +095400* WE NOW READ THE SECOND AND FINAL RECORD. SQ1244.2 +095500* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +095600* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +095700* SQ1244.2 +095800 SEQ-INIT-09. SQ1244.2 +095900 MOVE 0 TO REC-CT. SQ1244.2 +096000 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +096100 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +096200 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +096300 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +096400 MOVE "READ SECOND RECORD" TO FEATURE. SQ1244.2 +096500 MOVE "SEQ-TEST-RD-09" TO PAR-NAME. SQ1244.2 +096600 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +096700 GO TO SEQ-DELETE-09. SQ1244.2 +096800 GO TO SEQ-TEST-RD-09. SQ1244.2 +096900 SEQ-DELETE-09. SQ1244.2 +097000 MOVE "*" TO DELETE-SW-3. SQ1244.2 +097100 GO TO SEQ-DELETE-09-01. SQ1244.2 +097200 SEQ-TEST-RD-09. SQ1244.2 +097300 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +097400 READ SQ-FS4 SQ1244.2 +097500 END SQ1244.2 +097600 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +097700 NOT AT END SQ1244.2 +097800 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +097900* SQ1244.2 +098000* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +098100* SQ1244.2 +098200 ADD 1 TO REC-CT. SQ1244.2 +098300 IF DELETE-SW NOT = SPACE SQ1244.2 +098400 GO TO SEQ-DELETE-09-01. SQ1244.2 +098500 GO TO SEQ-TEST-RD-09-01. SQ1244.2 +098600 SEQ-DELETE-09-01. SQ1244.2 +098700 PERFORM DE-LETE. SQ1244.2 +098800 GO TO SEQ-TEST-09-01-END. SQ1244.2 +098900 SEQ-TEST-RD-09-01. SQ1244.2 +099000 IF SQ-FS4-STATUS = "00" SQ1244.2 +099100 PERFORM PASS SQ1244.2 +099200 ELSE SQ1244.2 +099300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +099400 MOVE "00" TO CORRECT-A SQ1244.2 +099500 MOVE "UNEXPECTED I-O STATUS FROM READ" TO RE-MARK SQ1244.2 +099600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +099700 PERFORM FAIL. SQ1244.2 +099800 SEQ-TEST-09-01-END. SQ1244.2 +099900* SQ1244.2 +100000* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +100100* SQ1244.2 +100200 ADD 1 TO REC-CT. SQ1244.2 +100300 IF DELETE-SW NOT = SPACE SQ1244.2 +100400 GO TO SEQ-DELETE-09-02. SQ1244.2 +100500 GO TO SEQ-TEST-RD-09-02. SQ1244.2 +100600 SEQ-DELETE-09-02. SQ1244.2 +100700 PERFORM DE-LETE. SQ1244.2 +100800 GO TO SEQ-TEST-09-02-END. SQ1244.2 +100900 SEQ-TEST-RD-09-02. SQ1244.2 +101000 IF AT-END-SW = "NOT EXECUTED" SQ1244.2 +101100 PERFORM PASS SQ1244.2 +101200 ELSE SQ1244.2 +101300 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +101400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +101500 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +101600 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +101700 PERFORM FAIL. SQ1244.2 +101800 SEQ-TEST-09-02-END. SQ1244.2 +101900* SQ1244.2 +102000* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +102100* SQ1244.2 +102200 ADD 1 TO REC-CT. SQ1244.2 +102300 IF DELETE-SW NOT = SPACE SQ1244.2 +102400 GO TO SEQ-DELETE-09-03. SQ1244.2 +102500 GO TO SEQ-TEST-RD-09-03. SQ1244.2 +102600 SEQ-DELETE-09-03. SQ1244.2 +102700 PERFORM DE-LETE. SQ1244.2 +102800 GO TO SEQ-TEST-09-03-END. SQ1244.2 +102900 SEQ-TEST-RD-09-03. SQ1244.2 +103000 IF NOT-END-SW = "EXECUTED" SQ1244.2 +103100 PERFORM PASS SQ1244.2 +103200 ELSE SQ1244.2 +103300 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +103400 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +103500 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +103600 TO RE-MARK SQ1244.2 +103700 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +103800 PERFORM FAIL. SQ1244.2 +103900 SEQ-TEST-09-03-END. SQ1244.2 +104000* SQ1244.2 +104100* CHECK THE RECORD NUMBER OF THE RECORD JUST READ. SQ1244.2 +104200* SQ1244.2 +104300 ADD 1 TO REC-CT. SQ1244.2 +104400 IF DELETE-SW NOT = SPACE SQ1244.2 +104500 GO TO SEQ-DELETE-09-04. SQ1244.2 +104600 GO TO SEQ-TEST-RD-09-04. SQ1244.2 +104700 SEQ-DELETE-09-04. SQ1244.2 +104800 PERFORM DE-LETE. SQ1244.2 +104900 GO TO SEQ-TEST-09-04-END. SQ1244.2 +105000 SEQ-TEST-RD-09-04. SQ1244.2 +105100 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1244.2 +105200 PERFORM PASS SQ1244.2 +105300 ELSE SQ1244.2 +105400 MOVE FRECORD-NUMBER TO COMPUTED-A SQ1244.2 +105500 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1244.2 +105600 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1244.2 +105700 PERFORM FAIL. SQ1244.2 +105800 SEQ-TEST-09-04-END. SQ1244.2 +105900 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +106000* SQ1244.2 +106100* SQ1244.2 +106200* WE NOW ATTEMPT ANOTHER READ, WHICH SHOULD RAISE AT END. SQ1244.2 +106300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +106400* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +106500* SQ1244.2 +106600 SEQ-INIT-10. SQ1244.2 +106700 MOVE 0 TO REC-CT. SQ1244.2 +106800 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +106900 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +107000 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +107100 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +107200 MOVE "READ TO GIVE AT END" TO FEATURE. SQ1244.2 +107300 MOVE "SEQ-TEST-RD-10" TO PAR-NAME. SQ1244.2 +107400 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +107500 GO TO SEQ-DELETE-10. SQ1244.2 +107600 GO TO SEQ-TEST-RD-10. SQ1244.2 +107700 SEQ-DELETE-10. SQ1244.2 +107800 MOVE "*" TO DELETE-SW-3. SQ1244.2 +107900 GO TO SEQ-DELETE-10-01. SQ1244.2 +108000 SEQ-TEST-RD-10. SQ1244.2 +108100 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +108200 READ SQ-FS4 SQ1244.2 +108300 END SQ1244.2 +108400 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +108500 NOT AT END SQ1244.2 +108600 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +108700* SQ1244.2 +108800* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +108900* SQ1244.2 +109000 ADD 1 TO REC-CT. SQ1244.2 +109100 IF DELETE-SW NOT = SPACE SQ1244.2 +109200 GO TO SEQ-DELETE-10-01. SQ1244.2 +109300 GO TO SEQ-TEST-RD-10-01. SQ1244.2 +109400 SEQ-DELETE-10-01. SQ1244.2 +109500 PERFORM DE-LETE. SQ1244.2 +109600 GO TO SEQ-TEST-10-01-END. SQ1244.2 +109700 SEQ-TEST-RD-10-01. SQ1244.2 +109800 IF SQ-FS4-STATUS = "10" SQ1244.2 +109900 PERFORM PASS SQ1244.2 +110000 ELSE SQ1244.2 +110100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +110200 MOVE "10" TO CORRECT-A SQ1244.2 +110300 MOVE "UNEXPECTED I-O STATUS AFTER LAST RECORD" SQ1244.2 +110400 TO RE-MARK SQ1244.2 +110500 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +110600 PERFORM FAIL. SQ1244.2 +110700 SEQ-TEST-10-01-END. SQ1244.2 +110800* SQ1244.2 +110900* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +111000* SQ1244.2 +111100 ADD 1 TO REC-CT. SQ1244.2 +111200 IF DELETE-SW NOT = SPACE SQ1244.2 +111300 GO TO SEQ-DELETE-10-02. SQ1244.2 +111400 GO TO SEQ-TEST-RD-10-02. SQ1244.2 +111500 SEQ-DELETE-10-02. SQ1244.2 +111600 PERFORM DE-LETE. SQ1244.2 +111700 GO TO SEQ-TEST-10-02-END. SQ1244.2 +111800 SEQ-TEST-RD-10-02. SQ1244.2 +111900 IF AT-END-SW = "EXECUTED" SQ1244.2 +112000 PERFORM PASS SQ1244.2 +112100 ELSE SQ1244.2 +112200 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +112300 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +112400 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +112500 TO RE-MARK SQ1244.2 +112600 MOVE "VII-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1244.2 +112700 PERFORM FAIL. SQ1244.2 +112800 SEQ-TEST-10-02-END. SQ1244.2 +112900* SQ1244.2 +113000* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +113100* SQ1244.2 +113200 ADD 1 TO REC-CT. SQ1244.2 +113300 IF DELETE-SW NOT = SPACE SQ1244.2 +113400 GO TO SEQ-DELETE-10-03. SQ1244.2 +113500 GO TO SEQ-TEST-RD-10-03. SQ1244.2 +113600 SEQ-DELETE-10-03. SQ1244.2 +113700 PERFORM DE-LETE. SQ1244.2 +113800 GO TO SEQ-TEST-10-03-END. SQ1244.2 +113900 SEQ-TEST-RD-10-03. SQ1244.2 +114000 IF NOT-END-SW = "NOT EXECUTED" SQ1244.2 +114100 PERFORM PASS SQ1244.2 +114200 ELSE SQ1244.2 +114300 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +114400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +114500 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +114600 MOVE "VII-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1244.2 +114700 PERFORM FAIL. SQ1244.2 +114800 SEQ-TEST-10-03-END. SQ1244.2 +114900 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +115000* SQ1244.2 +115100* SQ1244.2 +115200* NOW EXECUTE A NORMAL CLOSE ON THE FILE. SQ1244.2 +115300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS. SQ1244.2 +115400* SQ1244.2 +115500 SEQ-INIT-11. SQ1244.2 +115600 MOVE 0 TO REC-CT. SQ1244.2 +115700 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +115800 MOVE "CLOSE AFTER READING" TO FEATURE. SQ1244.2 +115900 MOVE "SEQ-TEST-CL-11" TO PAR-NAME. SQ1244.2 +116000 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +116100 GO TO SEQ-DELETE-11. SQ1244.2 +116200 GO TO SEQ-TEST-CL-11. SQ1244.2 +116300 SEQ-DELETE-11. SQ1244.2 +116400 MOVE "*" TO DELETE-SW-3. SQ1244.2 +116500 GO TO SEQ-DELETE-11-01. SQ1244.2 +116600 SEQ-TEST-CL-11. SQ1244.2 +116700 CLOSE SQ-FS4. SQ1244.2 +116800* SQ1244.2 +116900* CHECK I-O STATUS RETURNED FROM CLOSE SQ1244.2 +117000* SQ1244.2 +117100 ADD 1 TO REC-CT. SQ1244.2 +117200 IF DELETE-SW NOT = SPACE SQ1244.2 +117300 GO TO SEQ-DELETE-11-01. SQ1244.2 +117400 GO TO SEQ-TEST-CL-11-01. SQ1244.2 +117500 SEQ-DELETE-11-01. SQ1244.2 +117600 PERFORM DE-LETE. SQ1244.2 +117700 GO TO SEQ-TEST-11-01-END. SQ1244.2 +117800 SEQ-TEST-CL-11-01. SQ1244.2 +117900 IF SQ-FS4-STATUS = "00" SQ1244.2 +118000 PERFORM PASS SQ1244.2 +118100 ELSE SQ1244.2 +118200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +118300 MOVE "00" TO CORRECT-A SQ1244.2 +118400 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1244.2 +118500 TO RE-MARK SQ1244.2 +118600 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1244.2 +118700 PERFORM FAIL. SQ1244.2 +118800 SEQ-TEST-11-01-END. SQ1244.2 +118900* SQ1244.2 +119000 CCVS-EXIT SECTION. SQ1244.2 +119100 CCVS-999999. SQ1244.2 +119200 GO TO CLOSE-FILES. SQ1244.2 +*END-OF,SQ124A +*HEADER,COBOL,SQ125A +000100 IDENTIFICATION DIVISION. SQ1254.2 +000200 PROGRAM-ID. SQ1254.2 +000300 SQ125A. SQ1254.2 +000400**************************************************************** SQ1254.2 +000500* * SQ1254.2 +000600* VALIDATION FOR:- * SQ1254.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +000800* USING CCVS85 VERSION 3.0 * SQ1254.2 +000900* REVISED 1986, AUGUST * SQ1254.2 +001000* * SQ1254.2 +001100* CREATION DATE / VALIDATION DATE * SQ1254.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1254.2 +001300* * SQ1254.2 +001400**************************************************************** SQ1254.2 +001500* * SQ1254.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1254.2 +001700* * SQ1254.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1254.2 +001900* X-55 SYSTEM PRINTER * SQ1254.2 +002000* X-82 SOURCE-COMPUTER * SQ1254.2 +002100* X-83 OBJECT-COMPUTER * SQ1254.2 +002200* X-84 LABEL RECORDS OPTION * SQ1254.2 +002300* * SQ1254.2 +002400* * SQ1254.2 +002500**************************************************************** SQ1254.2 +002600* * SQ1254.2 +002700* SQ125A ATTEMPTS TO OPEN FOR OUTPUT A MAGNETIC TAPE FILE * SQ1254.2 +002800* WHICH IS ALREADY OPEN IN THE OUTPUT MODE. THIS SHOULD * SQ1254.2 +002900* RESULT IN A RECOGNITION OF A LOGIC ERROR CONDITION AND AN * SQ1254.2 +003000* I-O STATUS OF "41". THE PROGRAM CONTAINS AN APPLICABLE * SQ1254.2 +003100* DECLARATIVE PROCEDURE, WHICH SHOULD BE IMPLEMENTED. * SQ1254.2 +003200* * SQ1254.2 +003300**************************************************************** SQ1254.2 +003400* SQ1254.2 +003500 ENVIRONMENT DIVISION. SQ1254.2 +003600 CONFIGURATION SECTION. SQ1254.2 +003700 SOURCE-COMPUTER. SQ1254.2 +003800 XXXXX082. SQ1254.2 +003900 OBJECT-COMPUTER. SQ1254.2 +004000 XXXXX083. SQ1254.2 +004100* SQ1254.2 +004200 INPUT-OUTPUT SECTION. SQ1254.2 +004300 FILE-CONTROL. SQ1254.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1254.2 +004500 XXXXX055. SQ1254.2 +004600* SQ1254.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ1254.2 +004800 XXXXX001 SQ1254.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ1254.2 +005000* SQ1254.2 +005100* SQ1254.2 +005200 DATA DIVISION. SQ1254.2 +005300 FILE SECTION. SQ1254.2 +005400 FD PRINT-FILE SQ1254.2 +005500C LABEL RECORDS SQ1254.2 +005600C XXXXX084 SQ1254.2 +005700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1254.2 +005800 . SQ1254.2 +005900 01 PRINT-REC PICTURE X(120). SQ1254.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1254.2 +006100* SQ1254.2 +006200 FD SQ-FS1 SQ1254.2 +006300C LABEL RECORD IS STANDARD SQ1254.2 +006400 . SQ1254.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1254.2 +006600* SQ1254.2 +006700 WORKING-STORAGE SECTION. SQ1254.2 +006800* SQ1254.2 +006900*************************************************************** SQ1254.2 +007000* * SQ1254.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1254.2 +007200* * SQ1254.2 +007300*************************************************************** SQ1254.2 +007400* SQ1254.2 +007500 01 SQ-FS1-STATUS. SQ1254.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ1254.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ1254.2 +007800* SQ1254.2 +007900*************************************************************** SQ1254.2 +008000* * SQ1254.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1254.2 +008200* * SQ1254.2 +008300*************************************************************** SQ1254.2 +008400* SQ1254.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1254.2 +008600* SQ1254.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1254.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1254.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1254.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1254.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1254.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1254.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1254.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1254.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1254.2 +009600 ",RECKEY= ". SQ1254.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1254.2 +009800 ",ALTKEY1= ". SQ1254.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1254.2 +010000 ",ALTKEY2= ". SQ1254.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1254.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1254.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1254.2 +010400 07 FILLER PIC X(5). SQ1254.2 +010500 07 XFILE-NAME PIC X(6). SQ1254.2 +010600 07 FILLER PIC X(8). SQ1254.2 +010700 07 XRECORD-NAME PIC X(6). SQ1254.2 +010800 07 FILLER PIC X(1). SQ1254.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1254.2 +011000 07 FILLER PIC X(7). SQ1254.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1254.2 +011200 07 FILLER PIC X(6). SQ1254.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1254.2 +011400 07 FILLER PIC X(5). SQ1254.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1254.2 +011600 07 FILLER PIC X(5). SQ1254.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1254.2 +011800 07 FILLER PIC X(7). SQ1254.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1254.2 +012000 07 FILLER PIC X(7). SQ1254.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1254.2 +012200 07 FILLER PIC X(1). SQ1254.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1254.2 +012400 07 FILLER PIC X(6). SQ1254.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1254.2 +012600 07 FILLER PIC X(5). SQ1254.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1254.2 +012800 07 FILLER PIC X(6). SQ1254.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1254.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1254.2 +013100 07 FILLER PIC X(8). SQ1254.2 +013200 07 XRECORD-KEY PIC X(29). SQ1254.2 +013300 07 FILLER PIC X(9). SQ1254.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1254.2 +013500 07 FILLER PIC X(9). SQ1254.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1254.2 +013700 07 FILLER PIC X(7). SQ1254.2 +013800* SQ1254.2 +013900 01 TEST-RESULTS. SQ1254.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014100 02 PAR-NAME. SQ1254.2 +014200 03 FILLER PIC X(14) VALUE SPACE. SQ1254.2 +014300 03 PARDOT-X PIC X VALUE SPACE. SQ1254.2 +014400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1254.2 +014500 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014600 02 FEATURE PIC X(24) VALUE SPACE. SQ1254.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1254.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1254.2 +015000 02 RE-MARK PIC X(61). SQ1254.2 +015100 01 TEST-COMPUTED. SQ1254.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1254.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1254.2 +015400 02 COMPUTED-X. SQ1254.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1254.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1254.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1254.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1254.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1254.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1254.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1254.2 +016200 04 FILLER PIC X. SQ1254.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1254.2 +016400 01 TEST-CORRECT. SQ1254.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1254.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1254.2 +016700 02 CORRECT-X. SQ1254.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1254.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1254.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1254.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1254.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1254.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1254.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1254.2 +017500 04 FILLER PIC X. SQ1254.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1254.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1254.2 +017800* SQ1254.2 +017900 01 CCVS-C-1. SQ1254.2 +018000 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1254.2 +018200 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1254.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1254.2 +018600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1254.2 +018700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1254.2 +018800 01 CCVS-C-2. SQ1254.2 +018900 02 FILLER PIC X(19) VALUE SPACE. SQ1254.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". SQ1254.2 +019100 02 FILLER PIC X(19) VALUE SPACE. SQ1254.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". SQ1254.2 +019300 02 FILLER PIC X(72) VALUE SPACE. SQ1254.2 +019400* SQ1254.2 +019500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1254.2 +019600 01 REC-CT PIC 99 VALUE ZERO. SQ1254.2 +019700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +019800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +019900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +020000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +020100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1254.2 +020200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1254.2 +020300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1254.2 +020400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1254.2 +020500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1254.2 +020600 01 CCVS-H-1. SQ1254.2 +020700 02 FILLER PIC X(39) VALUE SPACES. SQ1254.2 +020800 02 FILLER PIC X(42) VALUE SQ1254.2 +020900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1254.2 +021000 02 FILLER PIC X(39) VALUE SPACES. SQ1254.2 +021100 01 CCVS-H-2A. SQ1254.2 +021200 02 FILLER PIC X(40) VALUE SPACE. SQ1254.2 +021300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1254.2 +021400 02 FILLER PIC XXXX VALUE SQ1254.2 +021500 "4.2 ". SQ1254.2 +021600 02 FILLER PIC X(28) VALUE SQ1254.2 +021700 " COPY - NOT FOR DISTRIBUTION". SQ1254.2 +021800 02 FILLER PIC X(41) VALUE SPACE. SQ1254.2 +021900* SQ1254.2 +022000 01 CCVS-H-2B. SQ1254.2 +022100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1254.2 +022200 02 TEST-ID PIC X(9). SQ1254.2 +022300 02 FILLER PIC X(4) VALUE " IN ". SQ1254.2 +022400 02 FILLER PIC X(12) VALUE SQ1254.2 +022500 " HIGH ". SQ1254.2 +022600 02 FILLER PIC X(22) VALUE SQ1254.2 +022700 " LEVEL VALIDATION FOR ". SQ1254.2 +022800 02 FILLER PIC X(58) VALUE SQ1254.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +023000 01 CCVS-H-3. SQ1254.2 +023100 02 FILLER PIC X(34) VALUE SQ1254.2 +023200 " FOR OFFICIAL USE ONLY ". SQ1254.2 +023300 02 FILLER PIC X(58) VALUE SQ1254.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1254.2 +023500 02 FILLER PIC X(28) VALUE SQ1254.2 +023600 " COPYRIGHT 1985,1986 ". SQ1254.2 +023700 01 CCVS-E-1. SQ1254.2 +023800 02 FILLER PIC X(52) VALUE SPACE. SQ1254.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1254.2 +024000 02 ID-AGAIN PIC X(9). SQ1254.2 +024100 02 FILLER PIC X(45) VALUE SPACES. SQ1254.2 +024200 01 CCVS-E-2. SQ1254.2 +024300 02 FILLER PIC X(31) VALUE SPACE. SQ1254.2 +024400 02 FILLER PIC X(21) VALUE SPACE. SQ1254.2 +024500 02 CCVS-E-2-2. SQ1254.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1254.2 +024700 03 FILLER PIC X VALUE SPACE. SQ1254.2 +024800 03 ENDER-DESC PIC X(44) VALUE SQ1254.2 +024900 "ERRORS ENCOUNTERED". SQ1254.2 +025000 01 CCVS-E-3. SQ1254.2 +025100 02 FILLER PIC X(22) VALUE SQ1254.2 +025200 " FOR OFFICIAL USE ONLY". SQ1254.2 +025300 02 FILLER PIC X(12) VALUE SPACE. SQ1254.2 +025400 02 FILLER PIC X(58) VALUE SQ1254.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +025600 02 FILLER PIC X(8) VALUE SPACE. SQ1254.2 +025700 02 FILLER PIC X(20) VALUE SQ1254.2 +025800 " COPYRIGHT 1985,1986". SQ1254.2 +025900 01 CCVS-E-4. SQ1254.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1254.2 +026100 02 FILLER PIC X(4) VALUE " OF ". SQ1254.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1254.2 +026300 02 FILLER PIC X(40) VALUE SQ1254.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1254.2 +026500 01 XXINFO. SQ1254.2 +026600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1254.2 +026700 02 INFO-TEXT. SQ1254.2 +026800 04 FILLER PIC X(8) VALUE SPACE. SQ1254.2 +026900 04 XXCOMPUTED PIC X(20). SQ1254.2 +027000 04 FILLER PIC X(5) VALUE SPACE. SQ1254.2 +027100 04 XXCORRECT PIC X(20). SQ1254.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). SQ1254.2 +027300 01 HYPHEN-LINE. SQ1254.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. SQ1254.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1254.2 +027600- "*****************************************". SQ1254.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1254.2 +027800- "******************************". SQ1254.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1254.2 +028000 "SQ125A". SQ1254.2 +028100* SQ1254.2 +028200* SQ1254.2 +028300 PROCEDURE DIVISION. SQ1254.2 +028400 DECLARATIVES. SQ1254.2 +028500 SQ125A-DECLARATIVE-001-SECT SECTION. SQ1254.2 +028600 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1254.2 +028700 INPUT-ERROR-PROCEDURE. SQ1254.2 +028800 IF SQ-FS1-STATUS = "41" SQ1254.2 +028900 PERFORM DECL-PASS SQ1254.2 +029000 GO TO ABNORMAL-TERM-DECL SQ1254.2 +029100 ELSE SQ1254.2 +029200 MOVE "41" TO CORRECT-A SQ1254.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1254.2 +029400 MOVE "INCORRECT I-O STATUS FOR SECOND OPEN" SQ1254.2 +029500 TO RE-MARK SQ1254.2 +029600 PERFORM DECL-FAIL SQ1254.2 +029700 GO TO ABNORMAL-TERM-DECL SQ1254.2 +029800 END-IF. SQ1254.2 +029900* SQ1254.2 +030000* SQ1254.2 +030100 DECL-PASS. SQ1254.2 +030200 MOVE "PASS " TO P-OR-F. SQ1254.2 +030300 ADD 1 TO PASS-COUNTER. SQ1254.2 +030400 PERFORM DECL-PRINT-DETAIL. SQ1254.2 +030500* SQ1254.2 +030600 DECL-FAIL. SQ1254.2 +030700 MOVE "FAIL*" TO P-OR-F. SQ1254.2 +030800 ADD 1 TO ERROR-COUNTER. SQ1254.2 +030900 PERFORM DECL-PRINT-DETAIL. SQ1254.2 +031000* SQ1254.2 +031100 DECL-PRINT-DETAIL. SQ1254.2 +031200 IF REC-CT NOT EQUAL TO ZERO SQ1254.2 +031300 MOVE "." TO PARDOT-X SQ1254.2 +031400 MOVE REC-CT TO DOTVALUE. SQ1254.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. SQ1254.2 +031600 PERFORM DECL-WRITE-LINE. SQ1254.2 +031700 IF P-OR-F EQUAL TO "FAIL*" SQ1254.2 +031800 PERFORM DECL-WRITE-LINE SQ1254.2 +031900 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1254.2 +032000 ELSE SQ1254.2 +032100 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1254.2 +032200 MOVE SPACE TO P-OR-F. SQ1254.2 +032300 MOVE SPACE TO COMPUTED-X. SQ1254.2 +032400 MOVE SPACE TO CORRECT-X. SQ1254.2 +032500 IF REC-CT EQUAL TO ZERO SQ1254.2 +032600 MOVE SPACE TO PAR-NAME. SQ1254.2 +032700 MOVE SPACE TO RE-MARK. SQ1254.2 +032800* SQ1254.2 +032900 DECL-WRITE-LINE. SQ1254.2 +033000 ADD 1 TO RECORD-COUNT. SQ1254.2 +033100Y IF RECORD-COUNT GREATER 50 SQ1254.2 +033200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1254.2 +033300Y MOVE SPACE TO DUMMY-RECORD SQ1254.2 +033400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1254.2 +033500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1254.2 +033600Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1254.2 +033700Y PERFORM DECL-WRT-LN 2 TIMES SQ1254.2 +033800Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1254.2 +033900Y PERFORM DECL-WRT-LN SQ1254.2 +034000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1254.2 +034100Y MOVE ZERO TO RECORD-COUNT. SQ1254.2 +034200 PERFORM DECL-WRT-LN. SQ1254.2 +034300* SQ1254.2 +034400 DECL-WRT-LN. SQ1254.2 +034500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1254.2 +034600 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +034700* SQ1254.2 +034800 DECL-FAIL-ROUTINE. SQ1254.2 +034900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1254.2 +035000 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1254.2 +035100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +035200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1254.2 +035300 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +035400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +035500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +035600 GO TO DECL-FAIL-EX. SQ1254.2 +035700 DECL-FAIL-WRITE. SQ1254.2 +035800 MOVE TEST-COMPUTED TO PRINT-REC SQ1254.2 +035900 PERFORM DECL-WRITE-LINE SQ1254.2 +036000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1254.2 +036100 MOVE TEST-CORRECT TO PRINT-REC SQ1254.2 +036200 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +036300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1254.2 +036400 DECL-FAIL-EX. SQ1254.2 +036500 EXIT. SQ1254.2 +036600* SQ1254.2 +036700 DECL-BAIL. SQ1254.2 +036800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1254.2 +036900 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1254.2 +037000 DECL-BAIL-WRITE. SQ1254.2 +037100 MOVE CORRECT-A TO XXCORRECT. SQ1254.2 +037200 MOVE COMPUTED-A TO XXCOMPUTED. SQ1254.2 +037300 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +037400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +037500 DECL-BAIL-EX. SQ1254.2 +037600 EXIT. SQ1254.2 +037700* SQ1254.2 +037800 ABNORMAL-TERM-DECL. SQ1254.2 +037900 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +038000 PERFORM DECL-WRITE-LINE. SQ1254.2 +038100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1254.2 +038200 TO DUMMY-RECORD. SQ1254.2 +038300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1254.2 +038400* SQ1254.2 +038500* SQ1254.2 +038600 END-DECLS. SQ1254.2 +038700 END DECLARATIVES. SQ1254.2 +038800* SQ1254.2 +038900* SQ1254.2 +039000 CCVS1 SECTION. SQ1254.2 +039100 OPEN-FILES. SQ1254.2 +039200 OPEN OUTPUT PRINT-FILE. SQ1254.2 +039300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1254.2 +039400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1254.2 +039500 MOVE SPACE TO TEST-RESULTS. SQ1254.2 +039600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1254.2 +039700 MOVE ZERO TO REC-SKEL-SUB. SQ1254.2 +039800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1254.2 +039900 GO TO CCVS1-EXIT. SQ1254.2 +040000* SQ1254.2 +040100 CCVS-INIT-FILE. SQ1254.2 +040200 ADD 1 TO REC-SKL-SUB. SQ1254.2 +040300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1254.2 +040400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1254.2 +040500* SQ1254.2 +040600 CLOSE-FILES. SQ1254.2 +040700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1254.2 +040800 CLOSE PRINT-FILE. SQ1254.2 +040900 TERMINATE-CCVS. SQ1254.2 +041000 STOP RUN. SQ1254.2 +041100* SQ1254.2 +041200 INSPT. SQ1254.2 +041300 MOVE "INSPT" TO P-OR-F. SQ1254.2 +041400 ADD 1 TO INSPECT-COUNTER. SQ1254.2 +041500 PERFORM PRINT-DETAIL. SQ1254.2 +041600 SQ1254.2 +041700 PASS. SQ1254.2 +041800 MOVE "PASS " TO P-OR-F. SQ1254.2 +041900 ADD 1 TO PASS-COUNTER. SQ1254.2 +042000 PERFORM PRINT-DETAIL. SQ1254.2 +042100* SQ1254.2 +042200 FAIL. SQ1254.2 +042300 MOVE "FAIL*" TO P-OR-F. SQ1254.2 +042400 ADD 1 TO ERROR-COUNTER. SQ1254.2 +042500 PERFORM PRINT-DETAIL. SQ1254.2 +042600* SQ1254.2 +042700 DE-LETE. SQ1254.2 +042800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1254.2 +042900 MOVE "*****" TO P-OR-F. SQ1254.2 +043000 ADD 1 TO DELETE-COUNTER. SQ1254.2 +043100 PERFORM PRINT-DETAIL. SQ1254.2 +043200* SQ1254.2 +043300 PRINT-DETAIL. SQ1254.2 +043400 IF REC-CT NOT EQUAL TO ZERO SQ1254.2 +043500 MOVE "." TO PARDOT-X SQ1254.2 +043600 MOVE REC-CT TO DOTVALUE. SQ1254.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. SQ1254.2 +043800 PERFORM WRITE-LINE. SQ1254.2 +043900 IF P-OR-F EQUAL TO "FAIL*" SQ1254.2 +044000 PERFORM WRITE-LINE SQ1254.2 +044100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1254.2 +044200 ELSE SQ1254.2 +044300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1254.2 +044400 MOVE SPACE TO P-OR-F. SQ1254.2 +044500 MOVE SPACE TO COMPUTED-X. SQ1254.2 +044600 MOVE SPACE TO CORRECT-X. SQ1254.2 +044700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1254.2 +044800 MOVE SPACE TO RE-MARK. SQ1254.2 +044900* SQ1254.2 +045000 HEAD-ROUTINE. SQ1254.2 +045100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1254.2 +045400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1254.2 +045500 COLUMN-NAMES-ROUTINE. SQ1254.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +045900 END-ROUTINE. SQ1254.2 +046000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1254.2 +046100 PERFORM WRITE-LINE 5 TIMES. SQ1254.2 +046200 END-RTN-EXIT. SQ1254.2 +046300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1254.2 +046400 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +046500* SQ1254.2 +046600 END-ROUTINE-1. SQ1254.2 +046700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1254.2 +046800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1254.2 +046900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1254.2 +047000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1254.2 +047100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1254.2 +047200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1254.2 +047300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1254.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1254.2 +047500 PERFORM WRITE-LINE. SQ1254.2 +047600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1254.2 +047700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1254.2 +047800 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +047900 ELSE SQ1254.2 +048000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1254.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1254.2 +048200 PERFORM WRITE-LINE. SQ1254.2 +048300 END-ROUTINE-13. SQ1254.2 +048400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1254.2 +048500 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +048600 ELSE SQ1254.2 +048700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1254.2 +048800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1254.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1254.2 +049000 PERFORM WRITE-LINE. SQ1254.2 +049100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1254.2 +049200 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +049300 ELSE SQ1254.2 +049400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1254.2 +049500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1254.2 +049600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +049700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +049800* SQ1254.2 +049900 WRITE-LINE. SQ1254.2 +050000 ADD 1 TO RECORD-COUNT. SQ1254.2 +050100Y IF RECORD-COUNT GREATER 50 SQ1254.2 +050200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1254.2 +050300Y MOVE SPACE TO DUMMY-RECORD SQ1254.2 +050400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1254.2 +050500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1254.2 +050600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1254.2 +050700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1254.2 +050800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1254.2 +050900Y MOVE ZERO TO RECORD-COUNT. SQ1254.2 +051000 PERFORM WRT-LN. SQ1254.2 +051100* SQ1254.2 +051200 WRT-LN. SQ1254.2 +051300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1254.2 +051400 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +051500 BLANK-LINE-PRINT. SQ1254.2 +051600 PERFORM WRT-LN. SQ1254.2 +051700 FAIL-ROUTINE. SQ1254.2 +051800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1254.2 +051900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1254.2 +052000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +052100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1254.2 +052200 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +052300 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +052500 GO TO FAIL-ROUTINE-EX. SQ1254.2 +052600 FAIL-ROUTINE-WRITE. SQ1254.2 +052700 MOVE TEST-COMPUTED TO PRINT-REC SQ1254.2 +052800 PERFORM WRITE-LINE SQ1254.2 +052900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1254.2 +053000 MOVE TEST-CORRECT TO PRINT-REC SQ1254.2 +053100 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +053200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1254.2 +053300 FAIL-ROUTINE-EX. SQ1254.2 +053400 EXIT. SQ1254.2 +053500 BAIL-OUT. SQ1254.2 +053600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1254.2 +053700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1254.2 +053800 BAIL-OUT-WRITE. SQ1254.2 +053900 MOVE CORRECT-A TO XXCORRECT. SQ1254.2 +054000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1254.2 +054100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +054200 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +054300 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +054400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +054500 BAIL-OUT-EX. SQ1254.2 +054600 EXIT. SQ1254.2 +054700 CCVS1-EXIT. SQ1254.2 +054800 EXIT. SQ1254.2 +054900* SQ1254.2 +055000**************************************************************** SQ1254.2 +055100* * SQ1254.2 +055200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1254.2 +055300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1254.2 +055400* * SQ1254.2 +055500**************************************************************** SQ1254.2 +055600* SQ1254.2 +055700 SECT-SQ125A-MAIN SECTION. SQ1254.2 +055800* SQ1254.2 +055900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1254.2 +056000* OPEN OUTPUT STATEMENT. SQ1254.2 +056100* SQ1254.2 +056200 SEQ-INIT-01. SQ1254.2 +056300* SQ1254.2 +056400 MOVE 1 TO REC-CT SQ1254.2 +056500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1254.2 +056600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1254.2 +056700 MOVE "**" TO SQ-FS1-STATUS. SQ1254.2 +056800 SEQ-TEST-OP-01. SQ1254.2 +056900 OPEN OUTPUT SQ-FS1. SQ1254.2 +057000 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1254.2 +057100 MOVE 1 TO REC-CT. SQ1254.2 +057200 SEQ-TEST-OP-01-01. SQ1254.2 +057300* SQ1254.2 +057400* CHECK THE I-O STATUS VALUE RETURNED BY THE FIRST OPEN. SQ1254.2 +057500* SQ1254.2 +057600 IF SQ-FS1-STATUS = "00" SQ1254.2 +057700 PERFORM PASS SQ1254.2 +057800 ELSE SQ1254.2 +057900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1254.2 +058000 MOVE "00" TO CORRECT-A SQ1254.2 +058100 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1254.2 +058200 TO RE-MARK SQ1254.2 +058300 MOVE "VII-3, 1.5.3(1)A" TO ANSI-REFERENCE SQ1254.2 +058400 PERFORM FAIL. SQ1254.2 +058500 SEQ-TEST-01-01-END. SQ1254.2 +058600* SQ1254.2 +058700* SQ1254.2 +058800* HAVING OPENED THE FILE, THE NEXT ACTION IS TO ATTEMPT SQ1254.2 +058900* TO OPEN IT FOR OUTPUT AGAIN. SQ1254.2 +059000* SQ1254.2 +059100 SEQ-INIT-02. SQ1254.2 +059200 MOVE 1 TO REC-CT SQ1254.2 +059300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1254.2 +059400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1254.2 +059500 MOVE "**" TO SQ-FS1-STATUS. SQ1254.2 +059600 SEQ-TEST-OP-02. SQ1254.2 +059700 OPEN OUTPUT SQ-FS1. SQ1254.2 +059800 CCVS-EXIT SECTION. SQ1254.2 +059900 CCVS-999999. SQ1254.2 +060000 GO TO CLOSE-FILES. SQ1254.2 +*END-OF,SQ125A +*HEADER,COBOL,SQ126A +000100 IDENTIFICATION DIVISION. SQ1264.2 +000200 PROGRAM-ID. SQ1264.2 +000300 SQ126A. SQ1264.2 +000400**************************************************************** SQ1264.2 +000500* * SQ1264.2 +000600* VALIDATION FOR:- * SQ1264.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1264.2 +000800* * SQ1264.2 +000900* CREATION DATE / VALIDATION DATE * SQ1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1264.2 +001100* * SQ1264.2 +001200**************************************************************** SQ1264.2 +001300 SQ1264.2 +001400* SQ1264.2 +001500* SQ1264.2 +001600******************************************************************SQ1264.2 +001700* *SQ1264.2 +001800* NEW TESTS: *SQ1264.2 +001900* *SQ1264.2 +002000* READ ... AT END ... NOT AT END ... *SQ1264.2 +002100* *SQ1264.2 +002200* READ ... RECORD AT END ... NOT END *SQ1264.2 +002300* *SQ1264.2 +002400* IF ... READ ... AT END ... NOT AT END ... END-READ *SQ1264.2 +002500* *SQ1264.2 +002600* IF ... READ ... RECORD END ... NOT END ... END-READ ... *SQ1264.2 +002700* *SQ1264.2 +002800******************************************************************SQ1264.2 +002900* SQ1264.2 +003000* THE ROUTINE SQ126A TESTS THE USE OF THE NOT AT END SQ1264.2 +003100* PHRASE FOR THE READ STATEMENT AND ALSO THE END-READ PHRASE. SQ1264.2 +003200* SQ1264.2 +003300* SQ1264.2 +003400* USED X-CARDS: SQ1264.2 +003500* XXXXX001 SQ1264.2 +003600* XXXXX055 SQ1264.2 +003700* P XXXXX062 SQ1264.2 +003800* XXXXX082 SQ1264.2 +003900* XXXXX083 SQ1264.2 +004000* C XXXXX084 SQ1264.2 +004100* SQ1264.2 +004200* SQ1264.2 +004300 ENVIRONMENT DIVISION. SQ1264.2 +004400 CONFIGURATION SECTION. SQ1264.2 +004500 SOURCE-COMPUTER. SQ1264.2 +004600 XXXXX082. SQ1264.2 +004700 OBJECT-COMPUTER. SQ1264.2 +004800 XXXXX083. SQ1264.2 +004900 INPUT-OUTPUT SECTION. SQ1264.2 +005000 FILE-CONTROL. SQ1264.2 +005100P SELECT RAW-DATA ASSIGN TO SQ1264.2 +005200P XXXXX062 SQ1264.2 +005300P ORGANIZATION IS INDEXED SQ1264.2 +005400P ACCESS MODE IS RANDOM SQ1264.2 +005500P RECORD KEY IS RAW-DATA-KEY. SQ1264.2 +005600 SELECT PRINT-FILE ASSIGN TO SQ1264.2 +005700 XXXXX055. SQ1264.2 +005800 SELECT SQ-FS1 ASSIGN TO SQ1264.2 +005900 XXXXX001 SQ1264.2 +006000 ORGANIZATION IS SEQUENTIAL SQ1264.2 +006100 ACCESS MODE IS SEQUENTIAL. SQ1264.2 +006200 SQ1264.2 +006300 DATA DIVISION. SQ1264.2 +006400 SQ1264.2 +006500 FILE SECTION. SQ1264.2 +006600P SQ1264.2 +006700PFD RAW-DATA. SQ1264.2 +006800P SQ1264.2 +006900P01 RAW-DATA-SATZ. SQ1264.2 +007000P 05 RAW-DATA-KEY PIC X(6). SQ1264.2 +007100P 05 C-DATE PIC 9(6). SQ1264.2 +007200P 05 C-TIME PIC 9(8). SQ1264.2 +007300P 05 C-NO-OF-TESTS PIC 99. SQ1264.2 +007400P 05 C-OK PIC 999. SQ1264.2 +007500P 05 C-ALL PIC 999. SQ1264.2 +007600P 05 C-FAIL PIC 999. SQ1264.2 +007700P 05 C-DELETED PIC 999. SQ1264.2 +007800P 05 C-INSPECT PIC 999. SQ1264.2 +007900P 05 C-NOTE PIC X(13). SQ1264.2 +008000P 05 C-INDENT PIC X. SQ1264.2 +008100P 05 C-ABORT PIC X(8). SQ1264.2 +008200 SQ1264.2 +008300 FD PRINT-FILE SQ1264.2 +008400C LABEL RECORDS SQ1264.2 +008500C XXXXX084 SQ1264.2 +008600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1264.2 +008700 . SQ1264.2 +008800 SQ1264.2 +008900 01 PRINT-REC PIC X(120). SQ1264.2 +009000 SQ1264.2 +009100 01 DUMMY-RECORD PIC X(120). SQ1264.2 +009200 SQ1264.2 +009300 FD SQ-FS1 SQ1264.2 +009400C LABEL RECORD STANDARD SQ1264.2 +009500 . SQ1264.2 +009600 SQ1264.2 +009700 01 SQ-FS1R1-F-G-120. SQ1264.2 +009800 05 FILLER PIC X(120). SQ1264.2 +009900 SQ1264.2 +010000 WORKING-STORAGE SECTION. SQ1264.2 +010100 SQ1264.2 +010200 01 SWITCH-READ1 PIC 9 VALUE ZERO. SQ1264.2 +010300 01 SWITCH-READ2 PIC 9 VALUE ZERO. SQ1264.2 +010400 01 SWITCH-READ3 PIC 9 VALUE ZERO. SQ1264.2 +010500 01 FILE-STATUS-SQ-FS1 PIC XX VALUE SPACE. SQ1264.2 +010600 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. SQ1264.2 +010700 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1264.2 +010800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1264.2 +010900 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1264.2 +011000 SQ1264.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ1264.2 +011200 05 FILE-RECORD-INFO-SKELETON. SQ1264.2 +011300 10 FILLER PIC X(48) VALUE SQ1264.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1264.2 +011500 10 FILLER PIC X(46) VALUE SQ1264.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1264.2 +011700 10 FILLER PIC X(26) VALUE SQ1264.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ1264.2 +011900 10 FILLER PIC X(37) VALUE SQ1264.2 +012000 ",RECKEY= ". SQ1264.2 +012100 10 FILLER PIC X(38) VALUE SQ1264.2 +012200 ",ALTKEY1= ". SQ1264.2 +012300 10 FILLER PIC X(38) VALUE SQ1264.2 +012400 ",ALTKEY2= ". SQ1264.2 +012500 10 FILLER PIC X(7) VALUE SPACE. SQ1264.2 +012600 05 FILE-RECORD-INFO OCCURS 10. SQ1264.2 +012700 10 FILE-RECORD-INFO-P1-120. SQ1264.2 +012800 15 FILLER PIC X(5). SQ1264.2 +012900 15 XFILE-NAME PIC X(6). SQ1264.2 +013000 15 FILLER PIC X(8). SQ1264.2 +013100 15 XRECORD-NAME PIC X(6). SQ1264.2 +013200 15 FILLER PIC X(1). SQ1264.2 +013300 15 REELUNIT-NUMBER PIC 9(1). SQ1264.2 +013400 15 FILLER PIC X(7). SQ1264.2 +013500 15 XRECORD-NUMBER PIC 9(6). SQ1264.2 +013600 15 FILLER PIC X(6). SQ1264.2 +013700 15 UPDATE-NUMBER PIC 9(2). SQ1264.2 +013800 15 FILLER PIC X(5). SQ1264.2 +013900 15 ODO-NUMBER PIC 9(4). SQ1264.2 +014000 15 FILLER PIC X(5). SQ1264.2 +014100 15 XPROGRAM-NAME PIC X(5). SQ1264.2 +014200 15 FILLER PIC X(7). SQ1264.2 +014300 15 XRECORD-LENGTH PIC 9(6). SQ1264.2 +014400 15 FILLER PIC X(7). SQ1264.2 +014500 15 CHARS-OR-RECORDS PIC X(2). SQ1264.2 +014600 15 FILLER PIC X(1). SQ1264.2 +014700 15 XBLOCK-SIZE PIC 9(4). SQ1264.2 +014800 15 FILLER PIC X(6). SQ1264.2 +014900 15 RECORDS-IN-FILE PIC 9(6). SQ1264.2 +015000 15 FILLER PIC X(5). SQ1264.2 +015100 15 XFILE-ORGANIZATION PIC X(2). SQ1264.2 +015200 15 FILLER PIC X(6). SQ1264.2 +015300 15 XLABEL-TYPE PIC X(1). SQ1264.2 +015400 10 FILE-RECORD-INFO-P121-240. SQ1264.2 +015500 15 FILLER PIC X(8). SQ1264.2 +015600 15 XRECORD-KEY PIC X(29). SQ1264.2 +015700 15 FILLER PIC X(9). SQ1264.2 +015800 15 ALTERNATE-KEY1 PIC X(29). SQ1264.2 +015900 15 FILLER PIC X(9). SQ1264.2 +016000 15 ALTERNATE-KEY2 PIC X(29). SQ1264.2 +016100 15 FILLER PIC X(7). SQ1264.2 +016200 SQ1264.2 +016300 01 TEST-RESULTS. SQ1264.2 +016400 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016500 05 FEATURE PIC X(20) VALUE SPACE. SQ1264.2 +016600 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016700 05 P-OR-F PIC X(5) VALUE SPACE. SQ1264.2 +016800 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016900 05 PAR-NAME. SQ1264.2 +017000 10 FILLER PIC X(12) VALUE SPACE. SQ1264.2 +017100 10 PARDOT-X PIC X VALUE SPACE. SQ1264.2 +017200 10 DOTVALUE PIC 99 VALUE ZERO. SQ1264.2 +017300 10 FILLER PIC X(5) VALUE SPACE. SQ1264.2 +017400 05 FILLER PIC X(10) VALUE SPACE. SQ1264.2 +017500 05 RE-MARK PIC X(61). SQ1264.2 +017600 SQ1264.2 +017700 01 TEST-COMPUTED. SQ1264.2 +017800 05 FILLER PIC X(30) VALUE SPACE. SQ1264.2 +017900 05 FILLER PIC X(17) VALUE " COMPUTED=". SQ1264.2 +018000 05 COMPUTED-X. SQ1264.2 +018100 10 COMPUTED-A PIC X(20) VALUE SPACE. SQ1264.2 +018200 10 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1264.2 +018300 10 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1264.2 +018400 10 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1264.2 +018500 10 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1264.2 +018600 10 CM-18V0 REDEFINES COMPUTED-A. SQ1264.2 +018700 15 COMPUTED-18V0 PIC -9(18). SQ1264.2 +018800 15 FILLER PIC X. SQ1264.2 +018900 10 FILLER PIC X(50) SQ1264.2 +019000 VALUE SPACE. SQ1264.2 +019100 SQ1264.2 +019200 01 TEST-CORRECT. SQ1264.2 +019300 05 FILLER PIC X(30) VALUE SPACE. SQ1264.2 +019400 05 FILLER PIC X(17) VALUE " CORRECT =". SQ1264.2 +019500 05 CORRECT-X. SQ1264.2 +019600 10 CORRECT-A PIC X(20) VALUE SPACE. SQ1264.2 +019700 10 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1264.2 +019800 10 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1264.2 +019900 10 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1264.2 +020000 10 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1264.2 +020100 10 CR-18V0 REDEFINES CORRECT-A. SQ1264.2 +020200 15 CORRECT-18V0 PIC -9(18). SQ1264.2 +020300 15 FILLER PIC X. SQ1264.2 +020400 10 FILLER PIC X(50) SQ1264.2 +020500 VALUE SPACE. SQ1264.2 +020600 SQ1264.2 +020700 01 CCVS-C-1. SQ1264.2 +020800 05 FILLER PIC X(99) VALUE SQ1264.2 +020900 " FEATURE PASS PARAGRAPH-NAME SQ1264.2 +021000- " REMARKS". SQ1264.2 +021100 05 FILLER PIC X(20) VALUE SPACE. SQ1264.2 +021200 SQ1264.2 +021300 01 CCVS-C-2. SQ1264.2 +021400 05 FILLER PIC X VALUE SPACE. SQ1264.2 +021500 05 FILLER PIC X(6) VALUE "TESTED". SQ1264.2 +021600 05 FILLER PIC X(15) VALUE SPACE. SQ1264.2 +021700 05 FILLER PIC X(4) VALUE "FAIL". SQ1264.2 +021800 05 FILLER PIC X(94) VALUE SPACE. SQ1264.2 +021900 SQ1264.2 +022000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1264.2 +022100 01 REC-CT PIC 99 VALUE ZERO. SQ1264.2 +022200 01 DELETE-CNT PIC 999 VALUE ZERO. SQ1264.2 +022300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1264.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1264.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1264.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1264.2 +023000 SQ1264.2 +023100 01 CCVS-H-1. SQ1264.2 +023200 05 FILLER PIC X(27) VALUE SPACE. SQ1264.2 +023300 05 FILLER PIC X(67) VALUE SQ1264.2 +023400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1264.2 +023500- " SYSTEM". SQ1264.2 +023600 05 FILLER PIC X(26) VALUE SPACE. SQ1264.2 +023700 SQ1264.2 +023800 01 CCVS-H-2. SQ1264.2 +023900 05 FILLER PIC X(52) VALUE SQ1264.2 +024000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1264.2 +024100 05 FILLER PIC X(19) VALUE SQ1264.2 +024200 "TEST RESULTS SET- ". SQ1264.2 +024300 05 TEST-ID PIC X(9). SQ1264.2 +024400 05 FILLER PIC X(40) VALUE SPACE. SQ1264.2 +024500 SQ1264.2 +024600 01 CCVS-H-3. SQ1264.2 +024700 05 FILLER PIC X(34) VALUE SQ1264.2 +024800 " FOR OFFICIAL USE ONLY ". SQ1264.2 +024900 05 FILLER PIC X(58) VALUE SQ1264.2 +025000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1264.2 +025100 SQ1264.2 +025200 05 FILLER PIC X(28) VALUE SQ1264.2 +025300 " COPYRIGHT 1985 ". SQ1264.2 +025400 SQ1264.2 +025500 01 CCVS-E-1. SQ1264.2 +025600 05 FILLER PIC X(52) VALUE SPACE. SQ1264.2 +025700 05 FILLER PIC X(14) VALUE "END OF TEST- ". SQ1264.2 +025800 05 ID-AGAIN PIC X(9). SQ1264.2 +025900 05 FILLER PIC X(45) VALUE SQ1264.2 +026000 " NTIS DISTRIBUTION COBOL 85". SQ1264.2 +026100 SQ1264.2 +026200 01 CCVS-E-2. SQ1264.2 +026300 05 FILLER PIC X(31) VALUE SPACE. SQ1264.2 +026400 05 FILLER PIC X(21) VALUE SPACE. SQ1264.2 +026500 05 CCVS-E-2-2. SQ1264.2 +026600 10 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1264.2 +026700 10 FILLER PIC X VALUE SPACE. SQ1264.2 +026800 10 ENDER-DESC PIC X(44) VALUE SQ1264.2 +026900 "ERRORS ENCOUNTERED". SQ1264.2 +027000 SQ1264.2 +027100 01 CCVS-E-3. SQ1264.2 +027200 05 FILLER PIC X(22) VALUE SQ1264.2 +027300 " FOR OFFICIAL USE ONLY". SQ1264.2 +027400 05 FILLER PIC X(12) VALUE SPACE. SQ1264.2 +027500 05 FILLER PIC X(58) VALUE SQ1264.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1264.2 +027700 SQ1264.2 +027800 05 FILLER PIC X(13) VALUE SPACE. SQ1264.2 +027900 05 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1264.2 +028000 SQ1264.2 +028100 01 CCVS-E-4. SQ1264.2 +028200 05 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1264.2 +028300 05 FILLER PIC X(4) VALUE " OF ". SQ1264.2 +028400 05 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1264.2 +028500 05 FILLER PIC X(40) VALUE SQ1264.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1264.2 +028700 SQ1264.2 +028800 01 XXINFO. SQ1264.2 +028900 05 FILLER PIC X(30) VALUE SQ1264.2 +029000 " *** INFORMATION ***". SQ1264.2 +029100 05 INFO-TEXT. SQ1264.2 +029200 10 FILLER PIC X(20) VALUE SPACE. SQ1264.2 +029300 10 XXCOMPUTED PIC X(20). SQ1264.2 +029400 10 FILLER PIC X(5) VALUE SPACE. SQ1264.2 +029500 10 XXCORRECT PIC X(20). SQ1264.2 +029600 SQ1264.2 +029700 01 HYPHEN-LINE. SQ1264.2 +029800 05 FILLER PIC X VALUE SPACE. SQ1264.2 +029900 05 FILLER PIC X(65) VALUE SQ1264.2 +030000 "************************************************************SQ1264.2 +030100- "*****". SQ1264.2 +030200 05 FILLER PIC X(54) VALUE SQ1264.2 +030300 "******************************************************". SQ1264.2 +030400 SQ1264.2 +030500 01 CCVS-PGM-ID PIC X(6) VALUE "SQ126A". SQ1264.2 +030600 SQ1264.2 +030700 PROCEDURE DIVISION. SQ1264.2 +030800 SQ1264.2 +030900 CCVS1 SECTION. SQ1264.2 +031000 OPEN-FILES. SQ1264.2 +031100P OPEN I-O RAW-DATA. SQ1264.2 +031200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1264.2 +031300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1264.2 +031400P MOVE "ABORTED " TO C-ABORT. SQ1264.2 +031500P ADD 1 TO C-NO-OF-TESTS. SQ1264.2 +031600P ACCEPT C-DATE FROM DATE. SQ1264.2 +031700P ACCEPT C-TIME FROM TIME. SQ1264.2 +031800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1264.2 +031900PEND-E-1. SQ1264.2 +032000P CLOSE RAW-DATA. SQ1264.2 +032100 OPEN SQ1264.2 +032200 OUTPUT PRINT-FILE. SQ1264.2 +032300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1264.2 +032400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1264.2 +032500 MOVE SPACE TO TEST-RESULTS. SQ1264.2 +032600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1264.2 +032700 MOVE ZERO TO REC-SKL-SUB. SQ1264.2 +032800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1264.2 +032900 CCVS-INIT-FILE. SQ1264.2 +033000 ADD 1 TO REC-SKL-SUB. SQ1264.2 +033100 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO SQ1264.2 +033200 (REC-SKL-SUB). SQ1264.2 +033300 CCVS-INIT-EXIT. SQ1264.2 +033400 GO TO CCVS1-EXIT. SQ1264.2 +033500 CLOSE-FILES. SQ1264.2 +033600 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1264.2 +033700 CLOSE PRINT-FILE. SQ1264.2 +033800P OPEN I-O RAW-DATA. SQ1264.2 +033900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1264.2 +034000P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1264.2 +034100P MOVE "OK. " TO C-ABORT. SQ1264.2 +034200P MOVE PASS-COUNTER TO C-OK. SQ1264.2 +034300P MOVE ERROR-HOLD TO C-ALL. SQ1264.2 +034400P MOVE ERROR-COUNTER TO C-FAIL. SQ1264.2 +034500P MOVE DELETE-CNT TO C-DELETED. SQ1264.2 +034600P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1264.2 +034700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1264.2 +034800PEND-E-2. SQ1264.2 +034900P CLOSE RAW-DATA. SQ1264.2 +035000 TERMINATE-CCVS. SQ1264.2 +035100S EXIT PROGRAM. SQ1264.2 +035200STERMINATE-CALL. SQ1264.2 +035300 STOP RUN. SQ1264.2 +035400 INSPT. SQ1264.2 +035500 MOVE "INSPT" TO P-OR-F. SQ1264.2 +035600 ADD 1 TO INSPECT-COUNTER. SQ1264.2 +035700 PASS. SQ1264.2 +035800 MOVE "PASS " TO P-OR-F. SQ1264.2 +035900 ADD 1 TO PASS-COUNTER. SQ1264.2 +036000 FAIL. SQ1264.2 +036100 MOVE "FAIL*" TO P-OR-F. SQ1264.2 +036200 ADD 1 TO ERROR-COUNTER. SQ1264.2 +036300 DE-LETE. SQ1264.2 +036400 MOVE "*****" TO P-OR-F. SQ1264.2 +036500 ADD 1 TO DELETE-CNT. SQ1264.2 +036600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1264.2 +036700 PRINT-DETAIL. SQ1264.2 +036800 IF REC-CT NOT EQUAL TO ZERO SQ1264.2 +036900 MOVE "." TO PARDOT-X SQ1264.2 +037000 MOVE REC-CT TO DOTVALUE. SQ1264.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. SQ1264.2 +037200 PERFORM WRITE-LINE. SQ1264.2 +037300 IF P-OR-F EQUAL TO "FAIL*" SQ1264.2 +037400 PERFORM WRITE-LINE SQ1264.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1264.2 +037600 ELSE SQ1264.2 +037700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1264.2 +037800 MOVE SPACE TO P-OR-F. SQ1264.2 +037900 MOVE SPACE TO COMPUTED-X. SQ1264.2 +038000 MOVE SPACE TO CORRECT-X. SQ1264.2 +038100 IF REC-CT EQUAL TO ZERO SQ1264.2 +038200 MOVE SPACE TO PAR-NAME. SQ1264.2 +038300 MOVE SPACE TO RE-MARK. SQ1264.2 +038400 HEAD-ROUTINE. SQ1264.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD. SQ1264.2 +038600 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +038700 MOVE CCVS-H-2 TO DUMMY-RECORD. SQ1264.2 +038800 PERFORM WRITE-LINE 5 TIMES. SQ1264.2 +038900 MOVE CCVS-H-3 TO DUMMY-RECORD. SQ1264.2 +039000 PERFORM WRITE-LINE 3 TIMES. SQ1264.2 +039100 COLUMN-NAMES-ROUTINE. SQ1264.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD. SQ1264.2 +039300 PERFORM WRITE-LINE. SQ1264.2 +039400 MOVE CCVS-C-2 TO DUMMY-RECORD. SQ1264.2 +039500 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1264.2 +039700 PERFORM WRITE-LINE. SQ1264.2 +039800 END-ROUTINE. SQ1264.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1264.2 +040000 PERFORM WRITE-LINE 5 TIMES. SQ1264.2 +040100 END-RTN-EXIT. SQ1264.2 +040200 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1264.2 +040300 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +040400 END-ROUTINE-1. SQ1264.2 +040500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1264.2 +040600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1264.2 +040700 ADD DELETE-CNT TO ERROR-HOLD. SQ1264.2 +040800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1264.2 +040900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1264.2 +041000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1264.2 +041100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1264.2 +041200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1264.2 +041300 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1264.2 +041400 PERFORM WRITE-LINE. SQ1264.2 +041500 END-ROUTINE-12. SQ1264.2 +041600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1264.2 +041700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1264.2 +041800 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +041900 ELSE SQ1264.2 +042000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1264.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +042200 PERFORM WRITE-LINE. SQ1264.2 +042300 END-ROUTINE-13. SQ1264.2 +042400 IF DELETE-CNT IS EQUAL TO ZERO SQ1264.2 +042500 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +042600 ELSE SQ1264.2 +042700 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1264.2 +042800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1264.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +043000 PERFORM WRITE-LINE. SQ1264.2 +043100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1264.2 +043200 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +043300 ELSE SQ1264.2 +043400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1264.2 +043500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1264.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +043700 PERFORM WRITE-LINE. SQ1264.2 +043800 MOVE CCVS-E-3 TO DUMMY-RECORD. SQ1264.2 +043900 PERFORM WRITE-LINE. SQ1264.2 +044000 WRITE-LINE. SQ1264.2 +044100 ADD 1 TO RECORD-COUNT. SQ1264.2 +044200Y IF RECORD-COUNT GREATER 50 SQ1264.2 +044300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1264.2 +044400Y MOVE SPACE TO DUMMY-RECORD SQ1264.2 +044500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1264.2 +044600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1264.2 +044700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1264.2 +044800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1264.2 +044900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1264.2 +045000Y MOVE ZERO TO RECORD-COUNT. SQ1264.2 +045100 PERFORM WRT-LN. SQ1264.2 +045200 WRT-LN. SQ1264.2 +045300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1264.2 +045400 MOVE SPACE TO DUMMY-RECORD. SQ1264.2 +045500 BLANK-LINE-PRINT. SQ1264.2 +045600 PERFORM WRT-LN. SQ1264.2 +045700 FAIL-ROUTINE. SQ1264.2 +045800 IF COMPUTED-X NOT EQUAL TO SPACE SQ1264.2 +045900 GO TO FAIL-ROUTINE-WRITE. SQ1264.2 +046000 IF CORRECT-X NOT EQUAL TO SPACE SQ1264.2 +046100 GO TO FAIL-ROUTINE-WRITE. SQ1264.2 +046200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1264.2 +046300 MOVE XXINFO TO DUMMY-RECORD. SQ1264.2 +046400 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +046500 GO TO FAIL-ROUTINE-EX. SQ1264.2 +046600 FAIL-ROUTINE-WRITE. SQ1264.2 +046700 MOVE TEST-COMPUTED TO PRINT-REC SQ1264.2 +046800 PERFORM WRITE-LINE SQ1264.2 +046900 MOVE TEST-CORRECT TO PRINT-REC SQ1264.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +047100 FAIL-ROUTINE-EX. SQ1264.2 +047200 EXIT. SQ1264.2 +047300 BAIL-OUT. SQ1264.2 +047400 IF COMPUTED-A NOT EQUAL TO SPACE SQ1264.2 +047500 GO TO BAIL-OUT-WRITE. SQ1264.2 +047600 IF CORRECT-A EQUAL TO SPACE SQ1264.2 +047700 GO TO BAIL-OUT-EX. SQ1264.2 +047800 BAIL-OUT-WRITE. SQ1264.2 +047900 MOVE CORRECT-A TO XXCORRECT. SQ1264.2 +048000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1264.2 +048100 MOVE XXINFO TO DUMMY-RECORD. SQ1264.2 +048200 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +048300 BAIL-OUT-EX. SQ1264.2 +048400 EXIT. SQ1264.2 +048500 CCVS1-EXIT. SQ1264.2 +048600 EXIT. SQ1264.2 +048700 SQ1264.2 +048800 SECT-SQ126-0001 SECTION. SQ1264.2 +048900 SEQ-INIT-001. SQ1264.2 +049000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1264.2 +049100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1264.2 +049200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1264.2 +049300 MOVE 000120 TO XRECORD-LENGTH (1). SQ1264.2 +049400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1264.2 +049500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1264.2 +049600 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1264.2 +049700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1264.2 +049800 MOVE "S" TO XLABEL-TYPE (1). SQ1264.2 +049900 MOVE 000001 TO XRECORD-NUMBER (1). SQ1264.2 +050000 OPEN SQ1264.2 +050100 OUTPUT SQ-FS1. SQ1264.2 +050200 SEQ-TEST-001. SQ1264.2 +050300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1264.2 +050400 WRITE SQ-FS1R1-F-G-120. SQ1264.2 +050500 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1264.2 +050600 GO TO SEQ-WRITE-001. SQ1264.2 +050700 ADD 1 TO XRECORD-NUMBER (1). SQ1264.2 +050800 GO TO SEQ-TEST-001. SQ1264.2 +050900 SEQ-WRITE-001. SQ1264.2 +051000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ1264.2 +051100 MOVE "SEQ-TEST-001" TO PAR-NAME. SQ1264.2 +051200 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1264.2 +051300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1264.2 +051400 PERFORM PRINT-DETAIL. SQ1264.2 +051500 CLOSE SQ-FS1. SQ1264.2 +051600* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1264.2 +051700* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1264.2 +051800 READ-INIT-GF-01. SQ1264.2 +051900 MOVE ZERO TO WRK-CS-09V00. SQ1264.2 +052000 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +052100* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1264.2 +052200* READ-TEST-001 AND CHECKS THE NOT AT END CONDITION. SQ1264.2 +052300 OPEN SQ1264.2 +052400 INPUT SQ-FS1. SQ1264.2 +052500 READ-TEST-GF-01. SQ1264.2 +052600******************************************************************SQ1264.2 +052700* *SQ1264.2 +052800* READ ... AT END --- NOT AT END ... *SQ1264.2 +052900* *SQ1264.2 +053000******************************************************************SQ1264.2 +053100 READ SQ-FS1 AT END SQ1264.2 +053200 GO TO READ-TEST-GF-01-1 SQ1264.2 +053300 NOT AT END SQ1264.2 +053400 MOVE 1 TO SWITCH-READ1. SQ1264.2 +053500 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1264.2 +053600 ADD 1 TO WRK-CS-09V00. SQ1264.2 +053700 IF WRK-CS-09V00 GREATER THAN 750 SQ1264.2 +053800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1264.2 +053900 GO TO READ-FAIL-GF-01. SQ1264.2 +054000 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1264.2 +054100 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +054200 GO TO READ-TEST-GF-01. SQ1264.2 +054300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1264.2 +054400 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +054500 GO TO READ-TEST-GF-01. SQ1264.2 +054600 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1264.2 +054700 ADD 1 TO RECORDS-IN-ERROR. SQ1264.2 +054800 GO TO READ-TEST-GF-01. SQ1264.2 +054900 READ-TEST-GF-01-1. SQ1264.2 +055000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1264.2 +055100 GO TO READ-PASS-GF-01. SQ1264.2 +055200 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1264.2 +055300 READ-FAIL-GF-01. SQ1264.2 +055400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1264.2 +055500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1264.2 +055600 PERFORM FAIL. SQ1264.2 +055700 GO TO READ-WRITE-GF-01. SQ1264.2 +055800 READ-PASS-GF-01. SQ1264.2 +055900 PERFORM PASS. SQ1264.2 +056000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1264.2 +056100 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1264.2 +056200 READ-WRITE-GF-01. SQ1264.2 +056300 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1264.2 +056400 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1264.2 +056500 PERFORM PRINT-DETAIL. SQ1264.2 +056600 READ-TEST-GF-01-2. SQ1264.2 +056700 MOVE "READ...AT END...NOT AT END" TO RE-MARK. SQ1264.2 +056800 MOVE "NOT AT END" TO FEATURE. SQ1264.2 +056900 IF SWITCH-READ1 = 1 SQ1264.2 +057000 GO TO READ-PASS-GF-01-2. SQ1264.2 +057100 READ-FAIL-GF-01-2. SQ1264.2 +057200 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +057300 PERFORM FAIL. SQ1264.2 +057400 GO TO READ-WRITE-GF-01-2. SQ1264.2 +057500 READ-PASS-GF-01-2. SQ1264.2 +057600 PERFORM PASS. SQ1264.2 +057700 READ-WRITE-GF-01-2. SQ1264.2 +057800 MOVE "READ-TEST-GF-01-2" TO PAR-NAME. SQ1264.2 +057900 PERFORM PRINT-DETAIL. SQ1264.2 +058000 SEQ-CLOSE-GF-01. SQ1264.2 +058100 CLOSE SQ-FS1. SQ1264.2 +058200 READ-INIT-GF-02. SQ1264.2 +058300 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +058400 MOVE ZERO TO WRK-CS-09V00. SQ1264.2 +058500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1264.2 +058600 OPEN SQ1264.2 +058700 INPUT SQ-FS1. SQ1264.2 +058800 MOVE "NOT END " TO FEATURE. SQ1264.2 +058900 MOVE "READ...RECORD AT END ... NOT END " TO RE-MARK. SQ1264.2 +059000 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1264.2 +059100 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +059200 READ-TEST-GF-02. SQ1264.2 +059300******************************************************************SQ1264.2 +059400* *SQ1264.2 +059500* READ ... RECORD AT END ... NOT END *SQ1264.2 +059600* *SQ1264.2 +059700******************************************************************SQ1264.2 +059800 READ SQ-FS1 RECORD AT END SQ1264.2 +059900 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +060000 MOVE 1 TO EOF-FLAG SQ1264.2 +060100 GO TO READ-FAIL-GF-02 SQ1264.2 +060200 NOT END SQ1264.2 +060300 MOVE 1 TO SWITCH-READ1. SQ1264.2 +060400 PERFORM RECORD-CHECK. SQ1264.2 +060500 IF WRK-CS-09V00 EQUAL TO 200 SQ1264.2 +060600 GO TO READ-TEST-GF-02-1. SQ1264.2 +060700 GO TO READ-TEST-GF-02. SQ1264.2 +060800 RECORD-CHECK. SQ1264.2 +060900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1264.2 +061000 ADD 1 TO WRK-CS-09V00. SQ1264.2 +061100 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1264.2 +061200 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +061300 MOVE 1 TO ERROR-FLAG. SQ1264.2 +061400 READ-TEST-GF-02-1. SQ1264.2 +061500 IF SWITCH-READ1 = 1 SQ1264.2 +061600 GO TO READ-PASS-GF-02. SQ1264.2 +061700 MOVE "NOT PASSED" TO COMPUTED-A. SQ1264.2 +061800 READ-FAIL-GF-02. SQ1264.2 +061900 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +062000 PERFORM FAIL. SQ1264.2 +062100 GO TO READ-WRITE-GF-02. SQ1264.2 +062200 READ-PASS-GF-02. SQ1264.2 +062300 PERFORM PASS. SQ1264.2 +062400 READ-WRITE-GF-02. SQ1264.2 +062500 PERFORM PRINT-DETAIL. SQ1264.2 +062600 PERFORM PRINT-DETAIL. SQ1264.2 +062700 READ-INIT-GF-03. SQ1264.2 +062800 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +062900 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +063000 MOVE 1 TO SWITCH-READ2. SQ1264.2 +063100 MOVE ZERO TO SWITCH-READ3. SQ1264.2 +063200 MOVE "IF...READ...AT END...NOT AT END..." TO RE-MARK. SQ1264.2 +063300 MOVE "READ-TEST-GF-03-1" TO PAR-NAME. SQ1264.2 +063400 MOVE "NOT AT END;END-READ" TO FEATURE. SQ1264.2 +063500 READ-TEST-GF-03. SQ1264.2 +063600******************************************************************SQ1264.2 +063700* *SQ1264.2 +063800* IF ... READ ... AT END ... NOT AT END ... END-READ *SQ1264.2 +063900* *SQ1264.2 +064000******************************************************************SQ1264.2 +064100 IF SWITCH-READ2 = 1 SQ1264.2 +064200 READ SQ-FS1 AT END SQ1264.2 +064300 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +064400 MOVE 1 TO EOF-FLAG SQ1264.2 +064500 GO TO READ-FAIL-GF-03 SQ1264.2 +064600 NOT AT END SQ1264.2 +064700 MOVE 1 TO SWITCH-READ1 SQ1264.2 +064800 END-READ SQ1264.2 +064900 MOVE 1 TO SWITCH-READ3. SQ1264.2 +065000 PERFORM RECORD-CHECK. SQ1264.2 +065100 IF WRK-CS-09V00 EQUAL TO 400 SQ1264.2 +065200 GO TO READ-TEST-GF-03-1. SQ1264.2 +065300 GO TO READ-TEST-GF-03. SQ1264.2 +065400 READ-TEST-GF-03-1. SQ1264.2 +065500 IF SWITCH-READ1 = 1 SQ1264.2 +065600 GO TO READ-PASS-GF-03. SQ1264.2 +065700 READ-FAIL-GF-03. SQ1264.2 +065800 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +065900 PERFORM FAIL. SQ1264.2 +066000 GO TO READ-WRITE-GF-03. SQ1264.2 +066100 READ-PASS-GF-03. SQ1264.2 +066200 PERFORM PASS. SQ1264.2 +066300 READ-WRITE-GF-03. SQ1264.2 +066400 PERFORM PRINT-DETAIL. SQ1264.2 +066500 READ-TEST-GF-03-2. SQ1264.2 +066600 IF SWITCH-READ3 = 1 SQ1264.2 +066700 GO TO READ-PASS-GF-03-2. SQ1264.2 +066800 READ-FAIL-GF-03-2. SQ1264.2 +066900 MOVE "VII-47 4.4.4 (14) " TO RE-MARK. SQ1264.2 +067000 PERFORM FAIL. SQ1264.2 +067100 GO TO READ-WRITE-GF-03-2. SQ1264.2 +067200 READ-PASS-GF-03-2. SQ1264.2 +067300 PERFORM PASS. SQ1264.2 +067400 READ-WRITE-GF-03-2. SQ1264.2 +067500 MOVE "READ-TEST-GF-03-2" TO PAR-NAME. SQ1264.2 +067600 PERFORM PRINT-DETAIL. SQ1264.2 +067700 READ-INIT-GF-04. SQ1264.2 +067800 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +067900 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +068000 MOVE ZERO TO SWITCH-READ2. SQ1264.2 +068100 MOVE 1 TO SWITCH-READ3. SQ1264.2 +068200 MOVE "READ...RECORD END...NOT END;END-READ" TO RE-MARK. SQ1264.2 +068300 MOVE "READ-TEST-GF-04-1" TO PAR-NAME. SQ1264.2 +068400 READ-TEST-GF-04. SQ1264.2 +068500******************************************************************SQ1264.2 +068600* *SQ1264.2 +068700* IF ... READ ... RECORD END ... NOT END ... END-READ ... *SQ1264.2 +068800* *SQ1264.2 +068900******************************************************************SQ1264.2 +069000 IF SWITCH-READ3 = 1 SQ1264.2 +069100 READ SQ-FS1 RECORD END SQ1264.2 +069200 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +069300 MOVE 1 TO EOF-FLAG SQ1264.2 +069400 GO TO READ-FAIL-GF-04-1 SQ1264.2 +069500 NOT END SQ1264.2 +069600 MOVE 1 TO SWITCH-READ1 SQ1264.2 +069700 END-READ SQ1264.2 +069800 MOVE 1 TO SWITCH-READ2. SQ1264.2 +069900 PERFORM RECORD-CHECK. SQ1264.2 +070000 IF WRK-CS-09V00 EQUAL TO 600 SQ1264.2 +070100 GO TO READ-TEST-GF-04-1. SQ1264.2 +070200 GO TO READ-TEST-GF-04. SQ1264.2 +070300 READ-TEST-GF-04-1. SQ1264.2 +070400 IF SWITCH-READ1 EQUAL TO 1 SQ1264.2 +070500 GO TO READ-PASS-GF-04-1. SQ1264.2 +070600 MOVE "NOT PASSED" TO COMPUTED-A. SQ1264.2 +070700 READ-FAIL-GF-04-1. SQ1264.2 +070800 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +070900 PERFORM FAIL. SQ1264.2 +071000 GO TO READ-WRITE-GF-04-1. SQ1264.2 +071100 READ-PASS-GF-04-1. SQ1264.2 +071200 PERFORM PASS. SQ1264.2 +071300 READ-WRITE-GF-04-1. SQ1264.2 +071400 PERFORM PRINT-DETAIL. SQ1264.2 +071500 READ-TEST-GF-04-2. SQ1264.2 +071600 IF SWITCH-READ2 EQUAL TO 1 SQ1264.2 +071700 GO TO READ-PASS-GF-04-2. SQ1264.2 +071800 MOVE "END-READ: NOT PASSED" TO COMPUTED-A. SQ1264.2 +071900 MOVE "READ-TEST-GF-04-2" TO PAR-NAME. SQ1264.2 +072000 READ-FAIL-GF-04-2. SQ1264.2 +072100 MOVE "VII-47 4.4.4 (14) " TO RE-MARK. SQ1264.2 +072200 PERFORM FAIL. SQ1264.2 +072300 GO TO READ-WRITE-GF-04-2. SQ1264.2 +072400 READ-PASS-GF-04-2. SQ1264.2 +072500 PERFORM PASS. SQ1264.2 +072600 READ-WRITE-GF-04-2. SQ1264.2 +072700 PERFORM PRINT-DETAIL. SQ1264.2 +072800 SEQ-CLOSE-003. SQ1264.2 +072900 CLOSE SQ-FS1. SQ1264.2 +073000 TERMINATE-ROUTINE. SQ1264.2 +073100 EXIT. SQ1264.2 +073200 SQ1264.2 +073300 CCVS-EXIT SECTION. SQ1264.2 +073400 CCVS-999999. SQ1264.2 +073500 GO TO CLOSE-FILES. SQ1264.2 +*END-OF,SQ126A +*HEADER,COBOL,SQ127A +000100 IDENTIFICATION DIVISION. SQ1274.2 +000200 PROGRAM-ID. SQ1274.2 +000300 SQ127A. SQ1274.2 +000400**************************************************************** SQ1274.2 +000500* * SQ1274.2 +000600* VALIDATION FOR:- * SQ1274.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1274.2 +000800* * SQ1274.2 +000900* CREATION DATE / VALIDATION DATE * SQ1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1274.2 +001100* * SQ1274.2 +001200**************************************************************** SQ1274.2 +001300 SQ1274.2 +001400* THIS ROUTINE CHECKS THE SAME AS SQ104 IN COMBINATION SQ1274.2 +001500* WITH SQ1274.2 +001600* SQ1274.2 +001700* SELECT ... ASSIGN TO "LITERAL-1" SQ1274.2 +001800* ----------- SQ1274.2 +001900* (X-CARD X-60 IS UESD FOR LITERAL-1) SQ1274.2 +002000* SQ1274.2 +002100* SQ1274.2 +002200* THE ROUTINE SQ127A CREATES A SEQUENTIAL MASS STORAGE SQ1274.2 +002300* FILE WHICH HAS FIXED LENGTH RECORDS. THE FILE IS THEN SQ1274.2 +002400* CLOSED AND OPENED AS AN INPUT FILE. THE FILE IS READ AND SQ1274.2 +002500* FIELDS IN THE INPUT RECORDS ARE COMPARED TO THE VALUES SQ1274.2 +002600* WRITTEN TO ENSURE THAT THE RECORDS WERE PROCESSED CORRECTLY. SQ1274.2 +002700* THE FILE IS CLOSED AND OPENED AGAIN AS AN INPUT FILE. FOUR SQ1274.2 +002800* READ FORMAT OPTIONS ARE USED TO READ THE FILE AND FIELDS IN SQ1274.2 +002900* THE RECORDS ARE VERIFIED. THE OPEN, CLOSE, READ, AND WRITE SQ1274.2 +003000* STATEMENTS ARE TESTED FOR LEVEL ONE FEATURES. SQ1274.2 +003100* SQ1274.2 +003200* USED X-CARDS: SQ1274.2 +003300* XXXXX055 SQ1274.2 +003400* XXXXX060 FOR "SQ-FS3" SQ1274.2 +003500* P XXXXX062 SQ1274.2 +003600* XXXXX082 SQ1274.2 +003700* XXXXX083 SQ1274.2 +003800* C XXXXX084 SQ1274.2 +003900* SQ1274.2 +004000* SQ1274.2 +004100 ENVIRONMENT DIVISION. SQ1274.2 +004200 CONFIGURATION SECTION. SQ1274.2 +004300 SOURCE-COMPUTER. SQ1274.2 +004400 XXXXX082. SQ1274.2 +004500 OBJECT-COMPUTER. SQ1274.2 +004600 XXXXX083. SQ1274.2 +004700 INPUT-OUTPUT SECTION. SQ1274.2 +004800 FILE-CONTROL. SQ1274.2 +004900P SELECT RAW-DATA ASSIGN TO SQ1274.2 +005000P XXXXX062 SQ1274.2 +005100P ORGANIZATION IS INDEXED SQ1274.2 +005200P ACCESS MODE IS RANDOM SQ1274.2 +005300P RECORD KEY IS RAW-DATA-KEY. SQ1274.2 +005400 SELECT PRINT-FILE ASSIGN TO SQ1274.2 +005500 XXXXX055. SQ1274.2 +005600 SELECT SQ-FS3 ASSIGN TO SQ1274.2 +005700 XXXXX060 SQ1274.2 +005800 ORGANIZATION IS SEQUENTIAL SQ1274.2 +005900 ACCESS MODE IS SEQUENTIAL. SQ1274.2 +006000 DATA DIVISION. SQ1274.2 +006100 FILE SECTION. SQ1274.2 +006200P SQ1274.2 +006300PFD RAW-DATA. SQ1274.2 +006400P SQ1274.2 +006500P01 RAW-DATA-SATZ. SQ1274.2 +006600P 05 RAW-DATA-KEY PIC X(6). SQ1274.2 +006700P 05 C-DATE PIC 9(6). SQ1274.2 +006800P 05 C-TIME PIC 9(8). SQ1274.2 +006900P 05 C-NO-OF-TESTS PIC 99. SQ1274.2 +007000P 05 C-OK PIC 999. SQ1274.2 +007100P 05 C-ALL PIC 999. SQ1274.2 +007200P 05 C-FAIL PIC 999. SQ1274.2 +007300P 05 C-DELETED PIC 999. SQ1274.2 +007400P 05 C-INSPECT PIC 999. SQ1274.2 +007500P 05 C-NOTE PIC X(13). SQ1274.2 +007600P 05 C-INDENT PIC X. SQ1274.2 +007700P 05 C-ABORT PIC X(8). SQ1274.2 +007800 FD PRINT-FILE SQ1274.2 +007900C LABEL RECORDS SQ1274.2 +008000C XXXXX084 SQ1274.2 +008100C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1274.2 +008200 . SQ1274.2 +008300 01 PRINT-REC PICTURE X(120). SQ1274.2 +008400 01 DUMMY-RECORD PICTURE X(120). SQ1274.2 +008500 FD SQ-FS3 SQ1274.2 +008600C LABEL RECORDS ARE STANDARD SQ1274.2 +008700C DATA RECORD SQ-FS3R1-F-G-120 SQ1274.2 +008800 BLOCK CONTAINS 120 CHARACTERS SQ1274.2 +008900 RECORD CONTAINS 120 CHARACTERS. SQ1274.2 +009000 01 SQ-FS3R1-F-G-120. SQ1274.2 +009100 02 FILLER PIC X(120). SQ1274.2 +009200 WORKING-STORAGE SECTION. SQ1274.2 +009300 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. SQ1274.2 +009400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1274.2 +009500 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1274.2 +009600 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1274.2 +009700 01 FILE-RECORD-INFORMATION-REC. SQ1274.2 +009800 03 FILE-RECORD-INFO-SKELETON. SQ1274.2 +009900 05 FILLER PICTURE X(48) VALUE SQ1274.2 +010000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1274.2 +010100 05 FILLER PICTURE X(46) VALUE SQ1274.2 +010200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1274.2 +010300 05 FILLER PICTURE X(26) VALUE SQ1274.2 +010400 ",LFIL=000000,ORG= ,LBLR= ". SQ1274.2 +010500 05 FILLER PICTURE X(37) VALUE SQ1274.2 +010600 ",RECKEY= ". SQ1274.2 +010700 05 FILLER PICTURE X(38) VALUE SQ1274.2 +010800 ",ALTKEY1= ". SQ1274.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1274.2 +011000 ",ALTKEY2= ". SQ1274.2 +011100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1274.2 +011200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1274.2 +011300 05 FILE-RECORD-INFO-P1-120. SQ1274.2 +011400 07 FILLER PIC X(5). SQ1274.2 +011500 07 XFILE-NAME PIC X(6). SQ1274.2 +011600 07 FILLER PIC X(8). SQ1274.2 +011700 07 XRECORD-NAME PIC X(6). SQ1274.2 +011800 07 FILLER PIC X(1). SQ1274.2 +011900 07 REELUNIT-NUMBER PIC 9(1). SQ1274.2 +012000 07 FILLER PIC X(7). SQ1274.2 +012100 07 XRECORD-NUMBER PIC 9(6). SQ1274.2 +012200 07 FILLER PIC X(6). SQ1274.2 +012300 07 UPDATE-NUMBER PIC 9(2). SQ1274.2 +012400 07 FILLER PIC X(5). SQ1274.2 +012500 07 ODO-NUMBER PIC 9(4). SQ1274.2 +012600 07 FILLER PIC X(5). SQ1274.2 +012700 07 XPROGRAM-NAME PIC X(5). SQ1274.2 +012800 07 FILLER PIC X(7). SQ1274.2 +012900 07 XRECORD-LENGTH PIC 9(6). SQ1274.2 +013000 07 FILLER PIC X(7). SQ1274.2 +013100 07 CHARS-OR-RECORDS PIC X(2). SQ1274.2 +013200 07 FILLER PIC X(1). SQ1274.2 +013300 07 XBLOCK-SIZE PIC 9(4). SQ1274.2 +013400 07 FILLER PIC X(6). SQ1274.2 +013500 07 RECORDS-IN-FILE PIC 9(6). SQ1274.2 +013600 07 FILLER PIC X(5). SQ1274.2 +013700 07 XFILE-ORGANIZATION PIC X(2). SQ1274.2 +013800 07 FILLER PIC X(6). SQ1274.2 +013900 07 XLABEL-TYPE PIC X(1). SQ1274.2 +014000 05 FILE-RECORD-INFO-P121-240. SQ1274.2 +014100 07 FILLER PIC X(8). SQ1274.2 +014200 07 XRECORD-KEY PIC X(29). SQ1274.2 +014300 07 FILLER PIC X(9). SQ1274.2 +014400 07 ALTERNATE-KEY1 PIC X(29). SQ1274.2 +014500 07 FILLER PIC X(9). SQ1274.2 +014600 07 ALTERNATE-KEY2 PIC X(29). SQ1274.2 +014700 07 FILLER PIC X(7). SQ1274.2 +014800 01 TEST-RESULTS. SQ1274.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1274.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1274.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015400 02 PAR-NAME. SQ1274.2 +015500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1274.2 +015600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1274.2 +015700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1274.2 +015800 03 FILLER PIC X(5) VALUE SPACE. SQ1274.2 +015900 02 FILLER PIC X(10) VALUE SPACE. SQ1274.2 +016000 02 RE-MARK PIC X(61). SQ1274.2 +016100 01 TEST-COMPUTED. SQ1274.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ1274.2 +016300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1274.2 +016400 02 COMPUTED-X. SQ1274.2 +016500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1274.2 +016600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1274.2 +016700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1274.2 +016800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1274.2 +016900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1274.2 +017000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1274.2 +017100 04 COMPUTED-18V0 PICTURE -9(18). SQ1274.2 +017200 04 FILLER PICTURE X. SQ1274.2 +017300 03 FILLER PIC X(50) VALUE SPACE. SQ1274.2 +017400 01 TEST-CORRECT. SQ1274.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1274.2 +017600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1274.2 +017700 02 CORRECT-X. SQ1274.2 +017800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1274.2 +017900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1274.2 +018000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1274.2 +018100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1274.2 +018200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1274.2 +018300 03 CR-18V0 REDEFINES CORRECT-A. SQ1274.2 +018400 04 CORRECT-18V0 PICTURE -9(18). SQ1274.2 +018500 04 FILLER PICTURE X. SQ1274.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1274.2 +018700 01 CCVS-C-1. SQ1274.2 +018800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1274.2 +018900- "SS PARAGRAPH-NAME SQ1274.2 +019000- " REMARKS". SQ1274.2 +019100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1274.2 +019200 01 CCVS-C-2. SQ1274.2 +019300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +019400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1274.2 +019500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1274.2 +019600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1274.2 +019700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1274.2 +019800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1274.2 +019900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1274.2 +020000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1274.2 +020100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1274.2 +020200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1274.2 +020300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1274.2 +020400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1274.2 +020500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1274.2 +020600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1274.2 +020700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1274.2 +020800 01 CCVS-H-1. SQ1274.2 +020900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1274.2 +021000 02 FILLER PICTURE X(67) VALUE SQ1274.2 +021100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1274.2 +021200- " SYSTEM". SQ1274.2 +021300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1274.2 +021400 01 CCVS-H-2. SQ1274.2 +021500 02 FILLER PICTURE X(52) VALUE IS SQ1274.2 +021600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1274.2 +021700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1274.2 +021800 02 TEST-ID PICTURE IS X(9). SQ1274.2 +021900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1274.2 +022000 01 CCVS-H-3. SQ1274.2 +022100 02 FILLER PICTURE X(34) VALUE SQ1274.2 +022200 " FOR OFFICIAL USE ONLY ". SQ1274.2 +022300 02 FILLER PICTURE X(58) VALUE SQ1274.2 +022400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1274.2 +022500 02 FILLER PICTURE X(28) VALUE SQ1274.2 +022600 " COPYRIGHT 1985 ". SQ1274.2 +022700 01 CCVS-E-1. SQ1274.2 +022800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1274.2 +022900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1274.2 +023000 02 ID-AGAIN PICTURE IS X(9). SQ1274.2 +023100 02 FILLER PICTURE X(45) VALUE IS SQ1274.2 +023200 " NTIS DISTRIBUTION COBOL 85". SQ1274.2 +023300 01 CCVS-E-2. SQ1274.2 +023400 02 FILLER PICTURE X(31) VALUE SQ1274.2 +023500 SPACE. SQ1274.2 +023600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1274.2 +023700 02 CCVS-E-2-2. SQ1274.2 +023800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1274.2 +023900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +024000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1274.2 +024100 01 CCVS-E-3. SQ1274.2 +024200 02 FILLER PICTURE X(22) VALUE SQ1274.2 +024300 " FOR OFFICIAL USE ONLY". SQ1274.2 +024400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1274.2 +024500 02 FILLER PICTURE X(58) VALUE SQ1274.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1274.2 +024700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1274.2 +024800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1274.2 +024900 01 CCVS-E-4. SQ1274.2 +025000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1274.2 +025100 02 FILLER PIC XXXX VALUE " OF ". SQ1274.2 +025200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1274.2 +025300 02 FILLER PIC X(40) VALUE SQ1274.2 +025400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1274.2 +025500 01 XXINFO. SQ1274.2 +025600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1274.2 +025700 02 INFO-TEXT. SQ1274.2 +025800 04 FILLER PIC X(20) VALUE SPACE. SQ1274.2 +025900 04 XXCOMPUTED PIC X(20). SQ1274.2 +026000 04 FILLER PIC X(5) VALUE SPACE. SQ1274.2 +026100 04 XXCORRECT PIC X(20). SQ1274.2 +026200 01 HYPHEN-LINE. SQ1274.2 +026300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +026400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1274.2 +026500- "*****************************************". SQ1274.2 +026600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1274.2 +026700- "******************************". SQ1274.2 +026800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1274.2 +026900 "SQ127A". SQ1274.2 +027000 PROCEDURE DIVISION. SQ1274.2 +027100 CCVS1 SECTION. SQ1274.2 +027200 OPEN-FILES. SQ1274.2 +027300P OPEN I-O RAW-DATA. SQ1274.2 +027400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1274.2 +027500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1274.2 +027600P MOVE "ABORTED " TO C-ABORT. SQ1274.2 +027700P ADD 1 TO C-NO-OF-TESTS. SQ1274.2 +027800P ACCEPT C-DATE FROM DATE. SQ1274.2 +027900P ACCEPT C-TIME FROM TIME. SQ1274.2 +028000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1274.2 +028100PEND-E-1. SQ1274.2 +028200P CLOSE RAW-DATA. SQ1274.2 +028300 OPEN OUTPUT PRINT-FILE. SQ1274.2 +028400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1274.2 +028500 MOVE SPACE TO TEST-RESULTS. SQ1274.2 +028600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1274.2 +028700 MOVE ZERO TO REC-SKL-SUB. SQ1274.2 +028800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1274.2 +028900 CCVS-INIT-FILE. SQ1274.2 +029000 ADD 1 TO REC-SKL-SUB. SQ1274.2 +029100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1274.2 +029200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1274.2 +029300 CCVS-INIT-EXIT. SQ1274.2 +029400 GO TO CCVS1-EXIT. SQ1274.2 +029500 CLOSE-FILES. SQ1274.2 +029600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1274.2 +029700P OPEN I-O RAW-DATA. SQ1274.2 +029800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1274.2 +029900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1274.2 +030000P MOVE "OK. " TO C-ABORT. SQ1274.2 +030100P MOVE PASS-COUNTER TO C-OK. SQ1274.2 +030200P MOVE ERROR-HOLD TO C-ALL. SQ1274.2 +030300P MOVE ERROR-COUNTER TO C-FAIL. SQ1274.2 +030400P MOVE DELETE-CNT TO C-DELETED. SQ1274.2 +030500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1274.2 +030600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1274.2 +030700PEND-E-2. SQ1274.2 +030800P CLOSE RAW-DATA. SQ1274.2 +030900 TERMINATE-CCVS. SQ1274.2 +031000S EXIT PROGRAM. SQ1274.2 +031100STERMINATE-CALL. SQ1274.2 +031200 STOP RUN. SQ1274.2 +031300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1274.2 +031400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1274.2 +031500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1274.2 +031600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1274.2 +031700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1274.2 +031800 PRINT-DETAIL. SQ1274.2 +031900 IF REC-CT NOT EQUAL TO ZERO SQ1274.2 +032000 MOVE "." TO PARDOT-X SQ1274.2 +032100 MOVE REC-CT TO DOTVALUE. SQ1274.2 +032200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1274.2 +032300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1274.2 +032400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1274.2 +032500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1274.2 +032600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1274.2 +032700 MOVE SPACE TO CORRECT-X. SQ1274.2 +032800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1274.2 +032900 MOVE SPACE TO RE-MARK. SQ1274.2 +033000 HEAD-ROUTINE. SQ1274.2 +033100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +033200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1274.2 +033300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1274.2 +033400 COLUMN-NAMES-ROUTINE. SQ1274.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +033800 END-ROUTINE. SQ1274.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1274.2 +034000 END-RTN-EXIT. SQ1274.2 +034100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +034200 END-ROUTINE-1. SQ1274.2 +034300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1274.2 +034400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1274.2 +034500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1274.2 +034600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1274.2 +034700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1274.2 +034800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1274.2 +034900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1274.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1274.2 +035100 END-ROUTINE-12. SQ1274.2 +035200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1274.2 +035300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1274.2 +035400 MOVE "NO " TO ERROR-TOTAL SQ1274.2 +035500 ELSE SQ1274.2 +035600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1274.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1274.2 +035800 PERFORM WRITE-LINE. SQ1274.2 +035900 END-ROUTINE-13. SQ1274.2 +036000 IF DELETE-CNT IS EQUAL TO ZERO SQ1274.2 +036100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1274.2 +036200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1274.2 +036300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1274.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +036500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1274.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1274.2 +036700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1274.2 +036800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1274.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +037000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +037100 WRITE-LINE. SQ1274.2 +037200 ADD 1 TO RECORD-COUNT. SQ1274.2 +037300Y IF RECORD-COUNT GREATER 50 SQ1274.2 +037400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1274.2 +037500Y MOVE SPACE TO DUMMY-RECORD SQ1274.2 +037600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1274.2 +037700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1274.2 +037800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1274.2 +037900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1274.2 +038000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1274.2 +038100Y MOVE ZERO TO RECORD-COUNT. SQ1274.2 +038200 PERFORM WRT-LN. SQ1274.2 +038300 WRT-LN. SQ1274.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1274.2 +038500 MOVE SPACE TO DUMMY-RECORD. SQ1274.2 +038600 BLANK-LINE-PRINT. SQ1274.2 +038700 PERFORM WRT-LN. SQ1274.2 +038800 FAIL-ROUTINE. SQ1274.2 +038900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1274.2 +039000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1274.2 +039100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1274.2 +039200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +039300 GO TO FAIL-ROUTINE-EX. SQ1274.2 +039400 FAIL-ROUTINE-WRITE. SQ1274.2 +039500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1274.2 +039600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +039700 FAIL-ROUTINE-EX. EXIT. SQ1274.2 +039800 BAIL-OUT. SQ1274.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1274.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1274.2 +040100 BAIL-OUT-WRITE. SQ1274.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1274.2 +040300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +040400 BAIL-OUT-EX. EXIT. SQ1274.2 +040500 CCVS1-EXIT. SQ1274.2 +040600 EXIT. SQ1274.2 +040700 SECT-SQ127A-0001 SECTION. SQ1274.2 +040800 SEQ-INIT-007. SQ1274.2 +040900 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1274.2 +041000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1274.2 +041100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1274.2 +041200 MOVE 120 TO XRECORD-LENGTH (1). SQ1274.2 +041300 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1274.2 +041400 MOVE 120 TO XBLOCK-SIZE (1). SQ1274.2 +041500 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1274.2 +041600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1274.2 +041700 MOVE "S" TO XLABEL-TYPE (1). SQ1274.2 +041800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1274.2 +041900 OPEN OUTPUT SQ-FS3. SQ1274.2 +042000 SEQ-TEST-007. SQ1274.2 +042100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1274.2 +042200 WRITE SQ-FS3R1-F-G-120. SQ1274.2 +042300 IF XRECORD-NUMBER (1) EQUAL TO 649 SQ1274.2 +042400 GO TO SEQ-WRITE-007. SQ1274.2 +042500 ADD 1 TO XRECORD-NUMBER (1). SQ1274.2 +042600 GO TO SEQ-TEST-007. SQ1274.2 +042700 SEQ-WRITE-007. SQ1274.2 +042800 MOVE "CREATE FILE SQ-FS3" TO FEATURE. SQ1274.2 +042900 MOVE "SEQ-TEST-007" TO PAR-NAME. SQ1274.2 +043000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1274.2 +043100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1274.2 +043200 PERFORM PRINT-DETAIL. SQ1274.2 +043300 CLOSE SQ-FS3. SQ1274.2 +043400* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1274.2 +043500* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1274.2 +043600 READ-INIT-GF-01. SQ1274.2 +043700 MOVE ZERO TO WRK-CS-09V00. SQ1274.2 +043800* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1274.2 +043900* SEQ-TEST-007. SQ1274.2 +044000 OPEN INPUT SQ-FS3. SQ1274.2 +044100 READ-TEST-GF-01. SQ1274.2 +044200 READ SQ-FS3 RECORD SQ1274.2 +044300 AT END GO TO READ-TEST-GF-01-1. SQ1274.2 +044400 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1274.2 +044500 ADD 1 TO WRK-CS-09V00. SQ1274.2 +044600 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +044700 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1274.2 +044800 GO TO READ-FAIL-GF-01. SQ1274.2 +044900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1274.2 +045000 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +045100 GO TO READ-TEST-GF-01. SQ1274.2 +045200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" SQ1274.2 +045300 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +045400 GO TO READ-TEST-GF-01. SQ1274.2 +045500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1274.2 +045600 ADD 1 TO RECORDS-IN-ERROR. SQ1274.2 +045700 GO TO READ-TEST-GF-01. SQ1274.2 +045800 READ-TEST-GF-01-1. SQ1274.2 +045900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1274.2 +046000 GO TO READ-PASS-GF-01. SQ1274.2 +046100 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1274.2 +046200 READ-FAIL-GF-01. SQ1274.2 +046300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1274.2 +046400 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +046500 PERFORM FAIL. SQ1274.2 +046600 GO TO READ-WRITE-GF-01. SQ1274.2 +046700 READ-PASS-GF-01. SQ1274.2 +046800 PERFORM PASS. SQ1274.2 +046900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1274.2 +047000 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1274.2 +047100 READ-WRITE-GF-01. SQ1274.2 +047200 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1274.2 +047300 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1274.2 +047400 PERFORM PRINT-DETAIL. SQ1274.2 +047500 SEQ-CLOSE-008. SQ1274.2 +047600 CLOSE SQ-FS3. SQ1274.2 +047700 READ-INIT-GF-02. SQ1274.2 +047800 MOVE ZERO TO WRK-CS-09V00. SQ1274.2 +047900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1274.2 +048000 OPEN INPUT SQ-FS3. SQ1274.2 +048100* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1274.2 +048200* IN THIS SERIES OF TESTS. SQ1274.2 +048300 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1274.2 +048400 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1274.2 +048500 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +048600 READ-TEST-GF-02. SQ1274.2 +048700 READ SQ-FS3 RECORD SQ1274.2 +048800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +048900 MOVE 1 TO EOF-FLAG SQ1274.2 +049000 GO TO READ-FAIL-GF-02. SQ1274.2 +049100 PERFORM RECORD-CHECK. SQ1274.2 +049200 IF WRK-CS-09V00 EQUAL TO 50 SQ1274.2 +049300 GO TO READ-TEST-GF-02-1. SQ1274.2 +049400 GO TO READ-TEST-GF-02. SQ1274.2 +049500 RECORD-CHECK. SQ1274.2 +049600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1274.2 +049700 ADD 1 TO WRK-CS-09V00. SQ1274.2 +049800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1274.2 +049900 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +050000 MOVE 1 TO ERROR-FLAG. SQ1274.2 +050100 READ-TEST-GF-02-1. SQ1274.2 +050200 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +050300 GO TO READ-PASS-GF-02. SQ1274.2 +050400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +050500 READ-FAIL-GF-02. SQ1274.2 +050600 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +050700 PERFORM FAIL. SQ1274.2 +050800 GO TO READ-WRITE-GF-02. SQ1274.2 +050900 READ-PASS-GF-02. SQ1274.2 +051000 PERFORM PASS. SQ1274.2 +051100 READ-WRITE-GF-02. SQ1274.2 +051200 PERFORM PRINT-DETAIL. SQ1274.2 +051300 READ-INIT-GF-03. SQ1274.2 +051400 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +051500 GO TO READ-EOF-GF-06. SQ1274.2 +051600 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +051700 MOVE "READ...AT END..." TO FEATURE. SQ1274.2 +051800 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1274.2 +051900 READ-TEST-GF-03. SQ1274.2 +052000 READ SQ-FS3 AT END SQ1274.2 +052100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +052200 MOVE 1 TO EOF-FLAG SQ1274.2 +052300 GO TO READ-FAIL-GF-03. SQ1274.2 +052400 PERFORM RECORD-CHECK. SQ1274.2 +052500 IF WRK-CS-09V00 EQUAL TO 200 SQ1274.2 +052600 GO TO READ-TEST-GF-03-1. SQ1274.2 +052700 GO TO READ-TEST-GF-03. SQ1274.2 +052800 READ-TEST-GF-03-1. SQ1274.2 +052900 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +053000 GO TO READ-PASS-GF-03. SQ1274.2 +053100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +053200 READ-FAIL-GF-03. SQ1274.2 +053300 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +053400 PERFORM FAIL. SQ1274.2 +053500 GO TO READ-WRITE-GF-03. SQ1274.2 +053600 READ-PASS-GF-03. SQ1274.2 +053700 PERFORM PASS. SQ1274.2 +053800 READ-WRITE-GF-03. SQ1274.2 +053900 PERFORM PRINT-DETAIL. SQ1274.2 +054000 READ-INIT-GF-04. SQ1274.2 +054100 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +054200 GO TO READ-EOF-GF-06. SQ1274.2 +054300 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +054400 MOVE "READ...RECORD END..." TO FEATURE. SQ1274.2 +054500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1274.2 +054600 READ-TEST-GF-04. SQ1274.2 +054700 READ SQ-FS3 RECORD END SQ1274.2 +054800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +054900 MOVE 1 TO EOF-FLAG SQ1274.2 +055000 GO TO READ-FAIL-GF-04. SQ1274.2 +055100 PERFORM RECORD-CHECK. SQ1274.2 +055200 IF WRK-CS-09V00 EQUAL TO 499 SQ1274.2 +055300 GO TO READ-TEST-GF-04-1. SQ1274.2 +055400 GO TO READ-TEST-GF-04. SQ1274.2 +055500 READ-TEST-GF-04-1. SQ1274.2 +055600 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +055700 GO TO READ-PASS-GF-04. SQ1274.2 +055800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +055900 READ-FAIL-GF-04. SQ1274.2 +056000 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +056100 PERFORM FAIL. SQ1274.2 +056200 GO TO READ-WRITE-GF-04. SQ1274.2 +056300 READ-PASS-GF-04. SQ1274.2 +056400 PERFORM PASS. SQ1274.2 +056500 READ-WRITE-GF-04. SQ1274.2 +056600 PERFORM PRINT-DETAIL. SQ1274.2 +056700 READ-INIT-GF-05. SQ1274.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +056900 GO TO READ-EOF-GF-06. SQ1274.2 +057000 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +057100 MOVE "READ...END..." TO FEATURE. SQ1274.2 +057200 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1274.2 +057300 READ-TEST-GF-05. SQ1274.2 +057400 READ SQ-FS3 END SQ1274.2 +057500 GO TO READ-TEST-GF-05-1. SQ1274.2 +057600 PERFORM RECORD-CHECK. SQ1274.2 +057700 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +057800 GO TO READ-TEST-GF-05-1. SQ1274.2 +057900 GO TO READ-TEST-GF-05. SQ1274.2 +058000 READ-TEST-GF-05-1. SQ1274.2 +058100 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +058200 GO TO READ-PASS-GF-05. SQ1274.2 +058300 READ-FAIL-GF-05. SQ1274.2 +058400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +058500 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +058600 PERFORM FAIL. SQ1274.2 +058700 GO TO READ-WRITE-GF-05. SQ1274.2 +058800 READ-PASS-GF-05. SQ1274.2 +058900 PERFORM PASS. SQ1274.2 +059000 READ-WRITE-GF-05. SQ1274.2 +059100 PERFORM PRINT-DETAIL. SQ1274.2 +059200 READ-TEST-GF-06. SQ1274.2 +059300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1274.2 +059400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1274.2 +059500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1274.2 +059600 GO TO READ-FAIL-GF-06. SQ1274.2 +059700 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +059800 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1274.2 +059900 GO TO READ-FAIL-GF-06. SQ1274.2 +060000 READ-PASS-GF-06. SQ1274.2 +060100 PERFORM PASS SQ1274.2 +060200 GO TO READ-WRITE-GF-06. SQ1274.2 +060300 READ-EOF-GF-06. SQ1274.2 +060400 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1274.2 +060500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1274.2 +060600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1274.2 +060700 READ-FAIL-GF-06. SQ1274.2 +060800 PERFORM FAIL. SQ1274.2 +060900 READ-WRITE-GF-06. SQ1274.2 +061000 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1274.2 +061100 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1274.2 +061200 PERFORM PRINT-DETAIL. SQ1274.2 +061300 READ-CLOSE-GF-06. SQ1274.2 +061400 CLOSE SQ-FS3. SQ1274.2 +061500 TERMINATE-ROUTINE. SQ1274.2 +061600 EXIT. SQ1274.2 +061700 CCVS-EXIT SECTION. SQ1274.2 +061800 CCVS-999999. SQ1274.2 +061900 GO TO CLOSE-FILES. SQ1274.2 +*END-OF,SQ127A +*HEADER,COBOL,SQ128A +000100 IDENTIFICATION DIVISION. SQ1284.2 +000200 PROGRAM-ID. SQ1284.2 +000300 SQ128A. SQ1284.2 +000400**************************************************************** SQ1284.2 +000500* * SQ1284.2 +000600* VALIDATION FOR:- * SQ1284.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1284.2 +000800* * SQ1284.2 +000900* CREATION DATE / VALIDATION DATE * SQ1284.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1284.2 +001100* * SQ1284.2 +001200* THE ROUTINE SQ128A TESTS THE USE OF THE LEVEL 1 OPEN SQ1284.2 +001300* SERIES AND CLOSE SERIES STATEMENTS. INPUT AND OUTPUT CLAUSESSQ1284.2 +001400* ARE USED IN SERIES TOGETHER AND SEPARATELY. SEVERAL FILES SQ1284.2 +001500* ARE CREATED AND PROCESSED ON BOTH TAPE AND MASS STORAGE. SQ1284.2 +001600 ENVIRONMENT DIVISION. SQ1284.2 +001700 CONFIGURATION SECTION. SQ1284.2 +001800 SOURCE-COMPUTER. SQ1284.2 +001900 XXXXX082. SQ1284.2 +002000 OBJECT-COMPUTER. SQ1284.2 +002100 XXXXX083. SQ1284.2 +002200 INPUT-OUTPUT SECTION. SQ1284.2 +002300 FILE-CONTROL. SQ1284.2 +002400P SELECT RAW-DATA ASSIGN TO SQ1284.2 +002500P XXXXX062 SQ1284.2 +002600P ORGANIZATION IS INDEXED SQ1284.2 +002700P ACCESS MODE IS RANDOM SQ1284.2 +002800P RECORD KEY IS RAW-DATA-KEY. SQ1284.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ1284.2 +003000 XXXXX055. SQ1284.2 +003100 SELECT SQ-FS1 ASSIGN TO SQ1284.2 +003200 XXXXX001. SQ1284.2 +003300 SELECT SQ-FS2 ASSIGN TO SQ1284.2 +003400 XXXXX014. SQ1284.2 +003500 SELECT SQ-FS3 ASSIGN TO SQ1284.2 +003600 XXXXX015. SQ1284.2 +003700 DATA DIVISION. SQ1284.2 +003800 FILE SECTION. SQ1284.2 +003900P SQ1284.2 +004000PFD RAW-DATA. SQ1284.2 +004100P SQ1284.2 +004200P01 RAW-DATA-SATZ. SQ1284.2 +004300P 05 RAW-DATA-KEY PIC X(6). SQ1284.2 +004400P 05 C-DATE PIC 9(6). SQ1284.2 +004500P 05 C-TIME PIC 9(8). SQ1284.2 +004600P 05 C-NO-OF-TESTS PIC 99. SQ1284.2 +004700P 05 C-OK PIC 999. SQ1284.2 +004800P 05 C-ALL PIC 999. SQ1284.2 +004900P 05 C-FAIL PIC 999. SQ1284.2 +005000P 05 C-DELETED PIC 999. SQ1284.2 +005100P 05 C-INSPECT PIC 999. SQ1284.2 +005200P 05 C-NOTE PIC X(13). SQ1284.2 +005300P 05 C-INDENT PIC X. SQ1284.2 +005400P 05 C-ABORT PIC X(8). SQ1284.2 +005500 FD PRINT-FILE SQ1284.2 +005600C LABEL RECORDS SQ1284.2 +005700C XXXXX084 SQ1284.2 +005800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1284.2 +005900 . SQ1284.2 +006000 01 PRINT-REC PICTURE X(120). SQ1284.2 +006100 01 DUMMY-RECORD PICTURE X(120). SQ1284.2 +006200 FD SQ-FS1 SQ1284.2 +006300C LABEL RECORD STANDARD SQ1284.2 +006400 DATA RECORD IS SQ-FS1R1-F-G-120. SQ1284.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1284.2 +006600 FD SQ-FS2 SQ1284.2 +006700C LABEL RECORD STANDARD SQ1284.2 +006800 BLOCK CONTAINS 10 RECORDS SQ1284.2 +006900 DATA RECORD IS SQ-FS2R1-F-G-120. SQ1284.2 +007000 01 SQ-FS2R1-F-G-120 PIC X(120). SQ1284.2 +007100 FD SQ-FS3 SQ1284.2 +007200 LABEL RECORD STANDARD SQ1284.2 +007300 BLOCK 120 CHARACTERS SQ1284.2 +007400 DATA RECORD IS SQ-FS3R1-F-G-120. SQ1284.2 +007500 01 SQ-FS3R1-F-G-120 PIC X(120). SQ1284.2 +007600 WORKING-STORAGE SECTION. SQ1284.2 +007700 01 COUNT-OF-RECS PIC 9999. SQ1284.2 +007800 01 FILE-RECORD-INFORMATION-REC. SQ1284.2 +007900 03 FILE-RECORD-INFO-SKELETON. SQ1284.2 +008000 05 FILLER PICTURE X(48) VALUE SQ1284.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1284.2 +008200 05 FILLER PICTURE X(46) VALUE SQ1284.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1284.2 +008400 05 FILLER PICTURE X(26) VALUE SQ1284.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". SQ1284.2 +008600 05 FILLER PICTURE X(37) VALUE SQ1284.2 +008700 ",RECKEY= ". SQ1284.2 +008800 05 FILLER PICTURE X(38) VALUE SQ1284.2 +008900 ",ALTKEY1= ". SQ1284.2 +009000 05 FILLER PICTURE X(38) VALUE SQ1284.2 +009100 ",ALTKEY2= ". SQ1284.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1284.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1284.2 +009400 05 FILE-RECORD-INFO-P1-120. SQ1284.2 +009500 07 FILLER PIC X(5). SQ1284.2 +009600 07 XFILE-NAME PIC X(6). SQ1284.2 +009700 07 FILLER PIC X(8). SQ1284.2 +009800 07 XRECORD-NAME PIC X(6). SQ1284.2 +009900 07 FILLER PIC X(1). SQ1284.2 +010000 07 REELUNIT-NUMBER PIC 9(1). SQ1284.2 +010100 07 FILLER PIC X(7). SQ1284.2 +010200 07 XRECORD-NUMBER PIC 9(6). SQ1284.2 +010300 07 FILLER PIC X(6). SQ1284.2 +010400 07 UPDATE-NUMBER PIC 9(2). SQ1284.2 +010500 07 FILLER PIC X(5). SQ1284.2 +010600 07 ODO-NUMBER PIC 9(4). SQ1284.2 +010700 07 FILLER PIC X(5). SQ1284.2 +010800 07 XPROGRAM-NAME PIC X(5). SQ1284.2 +010900 07 FILLER PIC X(7). SQ1284.2 +011000 07 XRECORD-LENGTH PIC 9(6). SQ1284.2 +011100 07 FILLER PIC X(7). SQ1284.2 +011200 07 CHARS-OR-RECORDS PIC X(2). SQ1284.2 +011300 07 FILLER PIC X(1). SQ1284.2 +011400 07 XBLOCK-SIZE PIC 9(4). SQ1284.2 +011500 07 FILLER PIC X(6). SQ1284.2 +011600 07 RECORDS-IN-FILE PIC 9(6). SQ1284.2 +011700 07 FILLER PIC X(5). SQ1284.2 +011800 07 XFILE-ORGANIZATION PIC X(2). SQ1284.2 +011900 07 FILLER PIC X(6). SQ1284.2 +012000 07 XLABEL-TYPE PIC X(1). SQ1284.2 +012100 05 FILE-RECORD-INFO-P121-240. SQ1284.2 +012200 07 FILLER PIC X(8). SQ1284.2 +012300 07 XRECORD-KEY PIC X(29). SQ1284.2 +012400 07 FILLER PIC X(9). SQ1284.2 +012500 07 ALTERNATE-KEY1 PIC X(29). SQ1284.2 +012600 07 FILLER PIC X(9). SQ1284.2 +012700 07 ALTERNATE-KEY2 PIC X(29). SQ1284.2 +012800 07 FILLER PIC X(7). SQ1284.2 +012900 01 TEST-RESULTS. SQ1284.2 +013000 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1284.2 +013200 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1284.2 +013400 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013500 02 PAR-NAME. SQ1284.2 +013600 03 FILLER PICTURE X(12) VALUE SPACE. SQ1284.2 +013700 03 PARDOT-X PICTURE X VALUE SPACE. SQ1284.2 +013800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1284.2 +013900 03 FILLER PIC X(5) VALUE SPACE. SQ1284.2 +014000 02 FILLER PIC X(10) VALUE SPACE. SQ1284.2 +014100 02 RE-MARK PIC X(61). SQ1284.2 +014200 01 TEST-COMPUTED. SQ1284.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SQ1284.2 +014400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1284.2 +014500 02 COMPUTED-X. SQ1284.2 +014600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1284.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1284.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1284.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1284.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1284.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1284.2 +015200 04 COMPUTED-18V0 PICTURE -9(18). SQ1284.2 +015300 04 FILLER PICTURE X. SQ1284.2 +015400 03 FILLER PIC X(50) VALUE SPACE. SQ1284.2 +015500 01 TEST-CORRECT. SQ1284.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ1284.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1284.2 +015800 02 CORRECT-X. SQ1284.2 +015900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1284.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1284.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1284.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1284.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1284.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. SQ1284.2 +016500 04 CORRECT-18V0 PICTURE -9(18). SQ1284.2 +016600 04 FILLER PICTURE X. SQ1284.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ1284.2 +016800 01 CCVS-C-1. SQ1284.2 +016900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1284.2 +017000- "SS PARAGRAPH-NAME SQ1284.2 +017100- " REMARKS". SQ1284.2 +017200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1284.2 +017300 01 CCVS-C-2. SQ1284.2 +017400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +017500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1284.2 +017600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1284.2 +017700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1284.2 +017800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1284.2 +017900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1284.2 +018000 01 REC-CT PICTURE 99 VALUE ZERO. SQ1284.2 +018100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1284.2 +018200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1284.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1284.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1284.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1284.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1284.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1284.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1284.2 +018900 01 CCVS-H-1. SQ1284.2 +019000 02 FILLER PICTURE X(27) VALUE SPACE. SQ1284.2 +019100 02 FILLER PICTURE X(67) VALUE SQ1284.2 +019200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1284.2 +019300- " SYSTEM". SQ1284.2 +019400 02 FILLER PICTURE X(26) VALUE SPACE. SQ1284.2 +019500 01 CCVS-H-2. SQ1284.2 +019600 02 FILLER PICTURE X(52) VALUE IS SQ1284.2 +019700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1284.2 +019800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1284.2 +019900 02 TEST-ID PICTURE IS X(9). SQ1284.2 +020000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1284.2 +020100 01 CCVS-H-3. SQ1284.2 +020200 02 FILLER PICTURE X(34) VALUE SQ1284.2 +020300 " FOR OFFICIAL USE ONLY ". SQ1284.2 +020400 02 FILLER PICTURE X(58) VALUE SQ1284.2 +020500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1284.2 +020600 02 FILLER PICTURE X(28) VALUE SQ1284.2 +020700 " COPYRIGHT 1985 ". SQ1284.2 +020800 01 CCVS-E-1. SQ1284.2 +020900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1284.2 +021000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1284.2 +021100 02 ID-AGAIN PICTURE IS X(9). SQ1284.2 +021200 02 FILLER PICTURE X(45) VALUE IS SQ1284.2 +021300 " NTIS DISTRIBUTION COBOL 85". SQ1284.2 +021400 01 CCVS-E-2. SQ1284.2 +021500 02 FILLER PICTURE X(31) VALUE SQ1284.2 +021600 SPACE. SQ1284.2 +021700 02 FILLER PICTURE X(21) VALUE SPACE. SQ1284.2 +021800 02 CCVS-E-2-2. SQ1284.2 +021900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1284.2 +022000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +022100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1284.2 +022200 01 CCVS-E-3. SQ1284.2 +022300 02 FILLER PICTURE X(22) VALUE SQ1284.2 +022400 " FOR OFFICIAL USE ONLY". SQ1284.2 +022500 02 FILLER PICTURE X(12) VALUE SPACE. SQ1284.2 +022600 02 FILLER PICTURE X(58) VALUE SQ1284.2 +022700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1284.2 +022800 02 FILLER PICTURE X(13) VALUE SPACE. SQ1284.2 +022900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1284.2 +023000 01 CCVS-E-4. SQ1284.2 +023100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1284.2 +023200 02 FILLER PIC XXXX VALUE " OF ". SQ1284.2 +023300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1284.2 +023400 02 FILLER PIC X(40) VALUE SQ1284.2 +023500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1284.2 +023600 01 XXINFO. SQ1284.2 +023700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1284.2 +023800 02 INFO-TEXT. SQ1284.2 +023900 04 FILLER PIC X(20) VALUE SPACE. SQ1284.2 +024000 04 XXCOMPUTED PIC X(20). SQ1284.2 +024100 04 FILLER PIC X(5) VALUE SPACE. SQ1284.2 +024200 04 XXCORRECT PIC X(20). SQ1284.2 +024300 01 HYPHEN-LINE. SQ1284.2 +024400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +024500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1284.2 +024600- "*****************************************". SQ1284.2 +024700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1284.2 +024800- "******************************". SQ1284.2 +024900 01 CCVS-PGM-ID PIC X(6) VALUE SQ1284.2 +025000 "SQ128A". SQ1284.2 +025100 PROCEDURE DIVISION. SQ1284.2 +025200 CCVS1 SECTION. SQ1284.2 +025300 OPEN-FILES. SQ1284.2 +025400P OPEN I-O RAW-DATA. SQ1284.2 +025500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1284.2 +025600P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1284.2 +025700P MOVE "ABORTED " TO C-ABORT. SQ1284.2 +025800P ADD 1 TO C-NO-OF-TESTS. SQ1284.2 +025900P ACCEPT C-DATE FROM DATE. SQ1284.2 +026000P ACCEPT C-TIME FROM TIME. SQ1284.2 +026100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1284.2 +026200PEND-E-1. SQ1284.2 +026300P CLOSE RAW-DATA. SQ1284.2 +026400 OPEN OUTPUT PRINT-FILE. SQ1284.2 +026500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1284.2 +026600 MOVE SPACE TO TEST-RESULTS. SQ1284.2 +026700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1284.2 +026800 MOVE ZERO TO REC-SKL-SUB. SQ1284.2 +026900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1284.2 +027000 CCVS-INIT-FILE. SQ1284.2 +027100 ADD 1 TO REC-SKL-SUB. SQ1284.2 +027200 MOVE FILE-RECORD-INFO-SKELETON TO SQ1284.2 +027300 FILE-RECORD-INFO (REC-SKL-SUB). SQ1284.2 +027400 CCVS-INIT-EXIT. SQ1284.2 +027500 GO TO CCVS1-EXIT. SQ1284.2 +027600 CLOSE-FILES. SQ1284.2 +027700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1284.2 +027800P OPEN I-O RAW-DATA. SQ1284.2 +027900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1284.2 +028000P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1284.2 +028100P MOVE "OK. " TO C-ABORT. SQ1284.2 +028200P MOVE PASS-COUNTER TO C-OK. SQ1284.2 +028300P MOVE ERROR-HOLD TO C-ALL. SQ1284.2 +028400P MOVE ERROR-COUNTER TO C-FAIL. SQ1284.2 +028500P MOVE DELETE-CNT TO C-DELETED. SQ1284.2 +028600P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1284.2 +028700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1284.2 +028800PEND-E-2. SQ1284.2 +028900P CLOSE RAW-DATA. SQ1284.2 +029000 TERMINATE-CCVS. SQ1284.2 +029100S EXIT PROGRAM. SQ1284.2 +029200STERMINATE-CALL. SQ1284.2 +029300 STOP RUN. SQ1284.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1284.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1284.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1284.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1284.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1284.2 +029900 PRINT-DETAIL. SQ1284.2 +030000 IF REC-CT NOT EQUAL TO ZERO SQ1284.2 +030100 MOVE "." TO PARDOT-X SQ1284.2 +030200 MOVE REC-CT TO DOTVALUE. SQ1284.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1284.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1284.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1284.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1284.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1284.2 +030800 MOVE SPACE TO CORRECT-X. SQ1284.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1284.2 +031000 MOVE SPACE TO RE-MARK. SQ1284.2 +031100 HEAD-ROUTINE. SQ1284.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +031300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1284.2 +031400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1284.2 +031500 COLUMN-NAMES-ROUTINE. SQ1284.2 +031600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +031700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +031900 END-ROUTINE. SQ1284.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1284.2 +032100 END-RTN-EXIT. SQ1284.2 +032200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +032300 END-ROUTINE-1. SQ1284.2 +032400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1284.2 +032500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1284.2 +032600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1284.2 +032700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1284.2 +032800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1284.2 +032900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1284.2 +033000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1284.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1284.2 +033200 END-ROUTINE-12. SQ1284.2 +033300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1284.2 +033400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1284.2 +033500 MOVE "NO " TO ERROR-TOTAL SQ1284.2 +033600 ELSE SQ1284.2 +033700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1284.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1284.2 +033900 PERFORM WRITE-LINE. SQ1284.2 +034000 END-ROUTINE-13. SQ1284.2 +034100 IF DELETE-CNT IS EQUAL TO ZERO SQ1284.2 +034200 MOVE "NO " TO ERROR-TOTAL ELSE SQ1284.2 +034300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1284.2 +034400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1284.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +034600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1284.2 +034700 MOVE "NO " TO ERROR-TOTAL SQ1284.2 +034800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1284.2 +034900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1284.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +035100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +035200 WRITE-LINE. SQ1284.2 +035300 ADD 1 TO RECORD-COUNT. SQ1284.2 +035400Y IF RECORD-COUNT GREATER 50 SQ1284.2 +035500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1284.2 +035600Y MOVE SPACE TO DUMMY-RECORD SQ1284.2 +035700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1284.2 +035800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1284.2 +035900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1284.2 +036000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1284.2 +036100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1284.2 +036200Y MOVE ZERO TO RECORD-COUNT. SQ1284.2 +036300 PERFORM WRT-LN. SQ1284.2 +036400 WRT-LN. SQ1284.2 +036500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1284.2 +036600 MOVE SPACE TO DUMMY-RECORD. SQ1284.2 +036700 BLANK-LINE-PRINT. SQ1284.2 +036800 PERFORM WRT-LN. SQ1284.2 +036900 FAIL-ROUTINE. SQ1284.2 +037000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1284.2 +037100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1284.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1284.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +037400 GO TO FAIL-ROUTINE-EX. SQ1284.2 +037500 FAIL-ROUTINE-WRITE. SQ1284.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1284.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +037800 FAIL-ROUTINE-EX. EXIT. SQ1284.2 +037900 BAIL-OUT. SQ1284.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1284.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1284.2 +038200 BAIL-OUT-WRITE. SQ1284.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1284.2 +038400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +038500 BAIL-OUT-EX. EXIT. SQ1284.2 +038600 CCVS1-EXIT. SQ1284.2 +038700 EXIT. SQ1284.2 +038800 SECT-SQ128A-0001 SECTION. SQ1284.2 +038900 OPEN-INIT-GF-01. SQ1284.2 +039000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1284.2 +039100 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ1284.2 +039200 MOVE "SQ-FS3" TO XFILE-NAME (3). SQ1284.2 +039300 MOVE "R1-F-G" TO XRECORD-NAME (1) SQ1284.2 +039400 XRECORD-NAME (2) SQ1284.2 +039500 XRECORD-NAME (3). SQ1284.2 +039600 MOVE "SQ128A" TO XPROGRAM-NAME (1) SQ1284.2 +039700 XPROGRAM-NAME (2) SQ1284.2 +039800 XPROGRAM-NAME (3). SQ1284.2 +039900 MOVE 000120 TO XRECORD-LENGTH (1) SQ1284.2 +040000 XRECORD-LENGTH (2) SQ1284.2 +040100 XRECORD-LENGTH (3). SQ1284.2 +040200 MOVE "RC" TO CHARS-OR-RECORDS (1) SQ1284.2 +040300 CHARS-OR-RECORDS (2). SQ1284.2 +040400 MOVE "CH" TO CHARS-OR-RECORDS (3). SQ1284.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1284.2 +040600 MOVE 0010 TO XBLOCK-SIZE (2). SQ1284.2 +040700 MOVE 0120 TO XBLOCK-SIZE (3). SQ1284.2 +040800 MOVE 0750 TO RECORDS-IN-FILE (1) SQ1284.2 +040900 RECORDS-IN-FILE (2) SQ1284.2 +041000 RECORDS-IN-FILE (3). SQ1284.2 +041100 MOVE "SQ" TO XFILE-ORGANIZATION (1) SQ1284.2 +041200 XFILE-ORGANIZATION (2) SQ1284.2 +041300 XFILE-ORGANIZATION (3). SQ1284.2 +041400 MOVE "S" TO XLABEL-TYPE (1) SQ1284.2 +041500 XLABEL-TYPE (2) SQ1284.2 +041600 XLABEL-TYPE (3). SQ1284.2 +041700 OPN-TEST-GF-01. SQ1284.2 +041800 OPEN OUTPUT SQ-FS1 SQ1284.2 +041900 SQ-FS2. SQ1284.2 +042000 MOVE 00001 TO XRECORD-NUMBER (1) SQ1284.2 +042100 XRECORD-NUMBER (2). SQ1284.2 +042200 OPN-TEST-GF-01-1. SQ1284.2 +042300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1284.2 +042400 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ1284.2 +042500 WRITE SQ-FS1R1-F-G-120. SQ1284.2 +042600 WRITE SQ-FS2R1-F-G-120. SQ1284.2 +042700 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1284.2 +042800 GO TO OPN-WRITE-GF-01. SQ1284.2 +042900 ADD 1 TO XRECORD-NUMBER (1). SQ1284.2 +043000 ADD 1 TO XRECORD-NUMBER (2). SQ1284.2 +043100 GO TO OPN-TEST-GF-01-1. SQ1284.2 +043200 OPN-WRITE-GF-01. SQ1284.2 +043300 MOVE "OPEN OUT 1 & 2 " TO FEATURE. SQ1284.2 +043400 MOVE "OPN-TEST-GF-01" TO PAR-NAME. SQ1284.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +043600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1284.2 +043700 PERFORM PRINT-DETAIL. SQ1284.2 +043800 PERFORM PASS. SQ1284.2 +043900 MOVE "OPN-TEST-GF-02" TO PAR-NAME. SQ1284.2 +044000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +044100 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ1284.2 +044200 PERFORM PRINT-DETAIL. SQ1284.2 +044300 CLOSE-INIT-GF-01. SQ1284.2 +044400* THIS TEST CLOSES THE TWO OUTPUT FILES FROM SQ1284.2 +044500* SEQ-TEST-001 WITH ONE CLOSE STATEMENT. SQ1284.2 +044600 CLOSE SQ-FS1, SQ1284.2 +044700 SQ-FS2. SQ1284.2 +044800 CLOSE-WRITE-GF-01. SQ1284.2 +044900 MOVE "CLOSE FILE 1 & 2 " TO FEATURE. SQ1284.2 +045000 MOVE "CLOSE-TEST-GF-01" TO PAR-NAME. SQ1284.2 +045100 MOVE SPACES TO CORRECT-A. SQ1284.2 +045200 PERFORM PASS. SQ1284.2 +045300 PERFORM PRINT-DETAIL. SQ1284.2 +045400 OPEN-TEST-GF-02. SQ1284.2 +045500* THIS TEST OPENS FOR INPUT THE TWO FILES CREATED IN SQ1284.2 +045600* SEQ-TEST-001. SQ1284.2 +045700 OPEN INPUT SQ-FS1, SQ1284.2 +045800 SQ-FS2. SQ1284.2 +045900 MOVE "OPEN INPUT 1 & 2" TO FEATURE. SQ1284.2 +046000 MOVE "OPEN-TEST-GF-02" TO PAR-NAME. SQ1284.2 +046100 PERFORM PASS. SQ1284.2 +046200 PERFORM PRINT-DETAIL. SQ1284.2 +046300 READ-TEST-F1-01. SQ1284.2 +046400* THIS PART OF THE TEST READS AND VALIDATES ONE SQ1284.2 +046500* RECORD FROM FILES SQ-FS1 AND SQ-FS2. SQ1284.2 +046600 READ SQ-FS1 AT END GO TO READ-FAIL-F1-01. SQ1284.2 +046700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1284.2 +046800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1284.2 +046900 GO TO READ-FAIL-F1-01. SQ1284.2 +047000 IF XRECORD-NUMBER (1) NOT EQUAL TO 1 SQ1284.2 +047100 GO TO READ-FAIL-F1-01. SQ1284.2 +047200 GO TO READ-PASS-F1-01. SQ1284.2 +047300 READ-FAIL-F1-01. SQ1284.2 +047400 MOVE "ERRORS IN READING SQ-FS1; VII-44, 4.4.2 " TO RE-MARK.SQ1284.2 +047500 PERFORM FAIL. SQ1284.2 +047600 GO TO READ-WRITE-F1-01. SQ1284.2 +047700 READ-PASS-F1-01. SQ1284.2 +047800 PERFORM PASS. SQ1284.2 +047900 MOVE "FIRST RECORD IS VALID" TO RE-MARK. SQ1284.2 +048000 READ-WRITE-F1-01. SQ1284.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ1284.2 +048200 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1284.2 +048300 PERFORM PRINT-DETAIL. SQ1284.2 +048400 READ-TEST-F1-02. SQ1284.2 +048500 READ SQ-FS2 AT END GO TO READ-FAIL-F1-02. SQ1284.2 +048600 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1284.2 +048700 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ1284.2 +048800 GO TO READ-FAIL-F1-02. SQ1284.2 +048900 IF XRECORD-NUMBER (2) NOT EQUAL TO 1 SQ1284.2 +049000 GO TO READ-FAIL-F1-02. SQ1284.2 +049100 GO TO READ-PASS-F1-02. SQ1284.2 +049200 READ-FAIL-F1-02. SQ1284.2 +049300 MOVE "ERRORS IN READING SQ-FS2; VII-44, 4.4.2 " TO RE-MARK.SQ1284.2 +049400 PERFORM FAIL. SQ1284.2 +049500 GO TO READ-WRITE-F1-02. SQ1284.2 +049600 READ-PASS-F1-02. SQ1284.2 +049700 PERFORM PASS. SQ1284.2 +049800 MOVE "FIRST RECORD IS VALID" TO RE-MARK. SQ1284.2 +049900 READ-WRITE-F1-02. SQ1284.2 +050000 MOVE "READ-TEST-F1" TO PAR-NAME. SQ1284.2 +050100 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ1284.2 +050200 PERFORM PRINT-DETAIL. SQ1284.2 +050300 OPEN-INIT-03. SQ1284.2 +050400 CLOSE SQ-FS1. SQ1284.2 +050500 OPEN-TEST-GF-03. SQ1284.2 +050600* THIS TEST OPENS A FILE FOR INPUT AND A FILE FOR SQ1284.2 +050700* OUTPUT WITH THE SAME OPEN STATEMENT. SQ1284.2 +050800 OPEN INPUT SQ-FS1 SQ1284.2 +050900 OUTPUT SQ-FS3. SQ1284.2 +051000 MOVE 00001 TO XRECORD-NUMBER (3). SQ1284.2 +051100 OPEN-TEST-GF-03-1. SQ1284.2 +051200 MOVE FILE-RECORD-INFO-P1-120 (3) TO SQ-FS3R1-F-G-120. SQ1284.2 +051300 WRITE SQ-FS3R1-F-G-120. SQ1284.2 +051400 IF XRECORD-NUMBER (3) EQUAL TO 750 SQ1284.2 +051500 GO TO OPEN-WRITE-GF-03. SQ1284.2 +051600 ADD 1 TO XRECORD-NUMBER (3). SQ1284.2 +051700 GO TO OPEN-TEST-GF-03-1. SQ1284.2 +051800 OPEN-WRITE-GF-03. SQ1284.2 +051900 MOVE "OPEN FILE SQ-FS3" TO FEATURE. SQ1284.2 +052000 MOVE "OPEN-TEST-GF-03" TO PAR-NAME. SQ1284.2 +052100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +052200 MOVE XRECORD-NUMBER (3) TO CORRECT-18V0. SQ1284.2 +052300 PERFORM PASS. SQ1284.2 +052400 PERFORM PRINT-DETAIL. SQ1284.2 +052500 CLOSE-TEST-02. SQ1284.2 +052600* THIS TEST CLOSES ONE OUTPUT FILE AND TWO INPUT FILESSQ1284.2 +052700* WITH ONE CLOSE STATEMENT. SQ1284.2 +052800 CLOSE SQ-FS1, SQ1284.2 +052900 SQ-FS2, SQ1284.2 +053000 SQ-FS3. SQ1284.2 +053100 CLOSE-WRITE-02. SQ1284.2 +053200 MOVE "CLOSE FILE SQ-FS1" TO FEATURE. SQ1284.2 +053300 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +053400 MOVE SPACES TO CORRECT-A. SQ1284.2 +053500 PERFORM PASS. SQ1284.2 +053600 PERFORM PRINT-DETAIL. SQ1284.2 +053700 MOVE "CLOSE FILE SQ-FS2" TO FEATURE. SQ1284.2 +053800 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +053900 PERFORM PASS. SQ1284.2 +054000 PERFORM PRINT-DETAIL. SQ1284.2 +054100 MOVE "CLOSE FILE SQ-FS3" TO FEATURE. SQ1284.2 +054200 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +054300 PERFORM PASS. SQ1284.2 +054400 PERFORM PRINT-DETAIL. SQ1284.2 +054500 SQ128A-END-ROUTINE. SQ1284.2 +054600 MOVE " END OF SQ128A VALIDATION TESTS" TO PRINT-REC. SQ1284.2 +054700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1284.2 +054800 TERMINATE-SQ128A. SQ1284.2 +054900 EXIT. SQ1284.2 +055000 CCVS-EXIT SECTION. SQ1284.2 +055100 CCVS-999999. SQ1284.2 +055200 GO TO CLOSE-FILES. SQ1284.2 +*END-OF,SQ128A +*HEADER,COBOL,SQ129A +000100 IDENTIFICATION DIVISION. SQ1294.2 +000200 PROGRAM-ID. SQ1294.2 +000300 SQ129A. SQ1294.2 +000400**************************************************************** SQ1294.2 +000500* * SQ1294.2 +000600* VALIDATION FOR:- * SQ1294.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1294.2 +000900* REVISED 1986, AUGUST * SQ1294.2 +001000* * SQ1294.2 +001100* CREATION DATE / VALIDATION DATE * SQ1294.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1294.2 +001300* * SQ1294.2 +001400**************************************************************** SQ1294.2 +001500* * SQ1294.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1294.2 +001700* * SQ1294.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1294.2 +001900* X-55 SYSTEM PRINTER * SQ1294.2 +002000* X-82 SOURCE-COMPUTER * SQ1294.2 +002100* X-83 OBJECT-COMPUTER. * SQ1294.2 +002200* * SQ1294.2 +002300* * SQ1294.2 +002400**************************************************************** SQ1294.2 +002500* * SQ1294.2 +002600* SQ129A ATTEMPTS TO OPEN FOR INPUT A MAGNETIC TAPE FILE * SQ1294.2 +002700* WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A PERMANENT * SQ1294.2 +002800* ERROR AND AN I-O STATUS OF "35". * SQ1294.2 +002900* * SQ1294.2 +003000* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1294.2 +003100* THE NEW PROGRAMS ARE SQ141A AND SQ142A. * SQ1294.2 +003200* * SQ1294.2 +003300* * SQ1294.2 +003400**************************************************************** SQ1294.2 +003500* SQ1294.2 +003600 ENVIRONMENT DIVISION. SQ1294.2 +003700 CONFIGURATION SECTION. SQ1294.2 +003800 SOURCE-COMPUTER. SQ1294.2 +003900 XXXXX082. SQ1294.2 +004000 OBJECT-COMPUTER. SQ1294.2 +004100 XXXXX083. SQ1294.2 +004200* SQ1294.2 +004300 INPUT-OUTPUT SECTION. SQ1294.2 +004400 FILE-CONTROL. SQ1294.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ1294.2 +004600 XXXXX055. SQ1294.2 +004700* SQ1294.2 +004800P SELECT RAW-DATA ASSIGN TO SQ1294.2 +004900P XXXXX062 SQ1294.2 +005000P ORGANIZATION IS INDEXED SQ1294.2 +005100P ACCESS MODE IS RANDOM SQ1294.2 +005200P RECORD-KEY IS RAW-DATA-KEY. SQ1294.2 +005300P SQ1294.2 +005400 SELECT SQ-FS1 ASSIGN TO SQ1294.2 +005500 XXXXX001 SQ1294.2 +005600 FILE STATUS IS SQ-FS1-STATUS. SQ1294.2 +005700* SQ1294.2 +005800* SQ1294.2 +005900 DATA DIVISION. SQ1294.2 +006000 FILE SECTION. SQ1294.2 +006100 FD PRINT-FILE SQ1294.2 +006200C LABEL RECORDS SQ1294.2 +006300C XXXXX084 SQ1294.2 +006400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1294.2 +006500 . SQ1294.2 +006600 01 PRINT-REC PICTURE X(120). SQ1294.2 +006700 01 DUMMY-RECORD PICTURE X(120). SQ1294.2 +006800P SQ1294.2 +006900PFD RAW-DATA. SQ1294.2 +007000P01 RAW-DATA-SATZ. SQ1294.2 +007100P 05 RAW-DATA-KEY PIC X(6). SQ1294.2 +007200P 05 C-DATE PIC 9(6). SQ1294.2 +007300P 05 C-TIME PIC 9(8). SQ1294.2 +007400P 05 NO-OF-TESTS PIC 99. SQ1294.2 +007500P 05 C-OK PIC 999. SQ1294.2 +007600P 05 C-ALL PIC 999. SQ1294.2 +007700P 05 C-FAIL PIC 999. SQ1294.2 +007800P 05 C-DELETED PIC 999. SQ1294.2 +007900P 05 C-INSPECT PIC 999. SQ1294.2 +008000P 05 C-NOTE PIC X(13). SQ1294.2 +008100P 05 C-INDENT PIC X. SQ1294.2 +008200P 05 C-ABORT PIC X(8). SQ1294.2 +008300* SQ1294.2 +008400 FD SQ-FS1 SQ1294.2 +008500C LABEL RECORD IS STANDARD SQ1294.2 +008600 . SQ1294.2 +008700 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1294.2 +008800* SQ1294.2 +008900 WORKING-STORAGE SECTION. SQ1294.2 +009000* SQ1294.2 +009100*************************************************************** SQ1294.2 +009200* * SQ1294.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1294.2 +009400* * SQ1294.2 +009500*************************************************************** SQ1294.2 +009600* SQ1294.2 +009700 01 SQ-FS1-STATUS. SQ1294.2 +009800 03 SQ-FS1-KEY-1 PIC X. SQ1294.2 +009900 03 SQ-FS1-KEY-2 PIC X. SQ1294.2 +010000* SQ1294.2 +010100 01 DECL-EXEC-SW PIC 9. SQ1294.2 +010200* SQ1294.2 +010300*************************************************************** SQ1294.2 +010400* * SQ1294.2 +010500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1294.2 +010600* * SQ1294.2 +010700*************************************************************** SQ1294.2 +010800* SQ1294.2 +010900 01 REC-SKEL-SUB PIC 99. SQ1294.2 +011000* SQ1294.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ1294.2 +011200 03 FILE-RECORD-INFO-SKELETON. SQ1294.2 +011300 05 FILLER PICTURE X(48) VALUE SQ1294.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1294.2 +011500 05 FILLER PICTURE X(46) VALUE SQ1294.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1294.2 +011700 05 FILLER PICTURE X(26) VALUE SQ1294.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ1294.2 +011900 05 FILLER PICTURE X(37) VALUE SQ1294.2 +012000 ",RECKEY= ". SQ1294.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1294.2 +012200 ",ALTKEY1= ". SQ1294.2 +012300 05 FILLER PICTURE X(38) VALUE SQ1294.2 +012400 ",ALTKEY2= ". SQ1294.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1294.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1294.2 +012700 05 FILE-RECORD-INFO-P1-120. SQ1294.2 +012800 07 FILLER PIC X(5). SQ1294.2 +012900 07 XFILE-NAME PIC X(6). SQ1294.2 +013000 07 FILLER PIC X(8). SQ1294.2 +013100 07 XRECORD-NAME PIC X(6). SQ1294.2 +013200 07 FILLER PIC X(1). SQ1294.2 +013300 07 REELUNIT-NUMBER PIC 9(1). SQ1294.2 +013400 07 FILLER PIC X(7). SQ1294.2 +013500 07 XRECORD-NUMBER PIC 9(6). SQ1294.2 +013600 07 FILLER PIC X(6). SQ1294.2 +013700 07 UPDATE-NUMBER PIC 9(2). SQ1294.2 +013800 07 FILLER PIC X(5). SQ1294.2 +013900 07 ODO-NUMBER PIC 9(4). SQ1294.2 +014000 07 FILLER PIC X(5). SQ1294.2 +014100 07 XPROGRAM-NAME PIC X(5). SQ1294.2 +014200 07 FILLER PIC X(7). SQ1294.2 +014300 07 XRECORD-LENGTH PIC 9(6). SQ1294.2 +014400 07 FILLER PIC X(7). SQ1294.2 +014500 07 CHARS-OR-RECORDS PIC X(2). SQ1294.2 +014600 07 FILLER PIC X(1). SQ1294.2 +014700 07 XBLOCK-SIZE PIC 9(4). SQ1294.2 +014800 07 FILLER PIC X(6). SQ1294.2 +014900 07 RECORDS-IN-FILE PIC 9(6). SQ1294.2 +015000 07 FILLER PIC X(5). SQ1294.2 +015100 07 XFILE-ORGANIZATION PIC X(2). SQ1294.2 +015200 07 FILLER PIC X(6). SQ1294.2 +015300 07 XLABEL-TYPE PIC X(1). SQ1294.2 +015400 05 FILE-RECORD-INFO-P121-240. SQ1294.2 +015500 07 FILLER PIC X(8). SQ1294.2 +015600 07 XRECORD-KEY PIC X(29). SQ1294.2 +015700 07 FILLER PIC X(9). SQ1294.2 +015800 07 ALTERNATE-KEY1 PIC X(29). SQ1294.2 +015900 07 FILLER PIC X(9). SQ1294.2 +016000 07 ALTERNATE-KEY2 PIC X(29). SQ1294.2 +016100 07 FILLER PIC X(7). SQ1294.2 +016200* SQ1294.2 +016300 01 TEST-RESULTS. SQ1294.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016500 02 FEATURE PIC X(24) VALUE SPACE. SQ1294.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1294.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016900 02 PAR-NAME. SQ1294.2 +017000 03 FILLER PIC X(14) VALUE SPACE. SQ1294.2 +017100 03 PARDOT-X PIC X VALUE SPACE. SQ1294.2 +017200 03 DOTVALUE PIC 99 VALUE ZERO. SQ1294.2 +017300 02 FILLER PIC X(9) VALUE SPACE. SQ1294.2 +017400 02 RE-MARK PIC X(61). SQ1294.2 +017500 01 TEST-COMPUTED. SQ1294.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ1294.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1294.2 +017800 02 COMPUTED-X. SQ1294.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1294.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1294.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1294.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1294.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1294.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1294.2 +018500 04 COMPUTED-18V0 PIC -9(18). SQ1294.2 +018600 04 FILLER PIC X. SQ1294.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ1294.2 +018800 01 TEST-CORRECT. SQ1294.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ1294.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1294.2 +019100 02 CORRECT-X. SQ1294.2 +019200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1294.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1294.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1294.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1294.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1294.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SQ1294.2 +019800 04 CORRECT-18V0 PIC -9(18). SQ1294.2 +019900 04 FILLER PIC X. SQ1294.2 +020000 03 FILLER PIC X(2) VALUE SPACE. SQ1294.2 +020100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1294.2 +020200 01 CCVS-C-1. SQ1294.2 +020300 02 FILLER PIC IS X(4) VALUE SPACE. SQ1294.2 +020400 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1294.2 +020500- "SS PARAGRAPH-NAME SQ1294.2 +020600- " REMARKS". SQ1294.2 +020700 02 FILLER PIC X(17) VALUE SPACE. SQ1294.2 +020800 01 CCVS-C-2. SQ1294.2 +020900 02 FILLER PIC XXXX VALUE SPACE. SQ1294.2 +021000 02 FILLER PIC X(6) VALUE "TESTED". SQ1294.2 +021100 02 FILLER PIC X(16) VALUE SPACE. SQ1294.2 +021200 02 FILLER PIC X(4) VALUE "FAIL". SQ1294.2 +021300 02 FILLER PIC X(90) VALUE SPACE. SQ1294.2 +021400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1294.2 +021500 01 REC-CT PIC 99 VALUE ZERO. SQ1294.2 +021600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1294.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1294.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1294.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1294.2 +022400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1294.2 +022500 01 CCVS-H-1. SQ1294.2 +022600 02 FILLER PIC X(39) VALUE SPACES. SQ1294.2 +022700 02 FILLER PIC X(42) VALUE SQ1294.2 +022800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1294.2 +022900 02 FILLER PIC X(39) VALUE SPACES. SQ1294.2 +023000 01 CCVS-H-2A. SQ1294.2 +023100 02 FILLER PIC X(40) VALUE SPACE. SQ1294.2 +023200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1294.2 +023300 02 FILLER PIC XXXX VALUE SQ1294.2 +023400 "4.2 ". SQ1294.2 +023500 02 FILLER PIC X(28) VALUE SQ1294.2 +023600 " COPY - NOT FOR DISTRIBUTION". SQ1294.2 +023700 02 FILLER PIC X(41) VALUE SPACE. SQ1294.2 +023800* SQ1294.2 +023900 01 CCVS-H-2B. SQ1294.2 +024000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1294.2 +024100 02 TEST-ID PIC X(9). SQ1294.2 +024200 02 FILLER PIC X(4) VALUE " IN ". SQ1294.2 +024300 02 FILLER PIC X(12) VALUE SQ1294.2 +024400 " HIGH ". SQ1294.2 +024500 02 FILLER PIC X(22) VALUE SQ1294.2 +024600 " LEVEL VALIDATION FOR ". SQ1294.2 +024700 02 FILLER PIC X(58) VALUE SQ1294.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +024900 01 CCVS-H-3. SQ1294.2 +025000 02 FILLER PIC X(34) VALUE SQ1294.2 +025100 " FOR OFFICIAL USE ONLY ". SQ1294.2 +025200 02 FILLER PIC X(58) VALUE SQ1294.2 +025300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1294.2 +025400 02 FILLER PIC X(28) VALUE SQ1294.2 +025500 " COPYRIGHT 1985,1986 ". SQ1294.2 +025600 01 CCVS-E-1. SQ1294.2 +025700 02 FILLER PIC X(52) VALUE SPACE. SQ1294.2 +025800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1294.2 +025900 02 ID-AGAIN PIC X(9). SQ1294.2 +026000 02 FILLER PIC X(45) VALUE SPACES. SQ1294.2 +026100 01 CCVS-E-2. SQ1294.2 +026200 02 FILLER PIC X(31) VALUE SPACE. SQ1294.2 +026300 02 FILLER PIC X(21) VALUE SPACE. SQ1294.2 +026400 02 CCVS-E-2-2. SQ1294.2 +026500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1294.2 +026600 03 FILLER PIC X VALUE SPACE. SQ1294.2 +026700 03 ENDER-DESC PIC X(44) VALUE SQ1294.2 +026800 "ERRORS ENCOUNTERED". SQ1294.2 +026900 01 CCVS-E-3. SQ1294.2 +027000 02 FILLER PIC X(22) VALUE SQ1294.2 +027100 " FOR OFFICIAL USE ONLY". SQ1294.2 +027200 02 FILLER PIC X(12) VALUE SPACE. SQ1294.2 +027300 02 FILLER PIC X(58) VALUE SQ1294.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +027500 02 FILLER PIC X(8) VALUE SPACE. SQ1294.2 +027600 02 FILLER PIC X(20) VALUE SQ1294.2 +027700 " COPYRIGHT 1985,1986". SQ1294.2 +027800 01 CCVS-E-4. SQ1294.2 +027900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1294.2 +028000 02 FILLER PIC X(4) VALUE " OF ". SQ1294.2 +028100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1294.2 +028200 02 FILLER PIC X(40) VALUE SQ1294.2 +028300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1294.2 +028400 01 XXINFO. SQ1294.2 +028500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1294.2 +028600 02 INFO-TEXT. SQ1294.2 +028700 04 FILLER PIC X(8) VALUE SPACE. SQ1294.2 +028800 04 XXCOMPUTED PIC X(20). SQ1294.2 +028900 04 FILLER PIC X(5) VALUE SPACE. SQ1294.2 +029000 04 XXCORRECT PIC X(20). SQ1294.2 +029100 02 INF-ANSI-REFERENCE PIC X(48). SQ1294.2 +029200 01 HYPHEN-LINE. SQ1294.2 +029300 02 FILLER PIC IS X VALUE IS SPACE. SQ1294.2 +029400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1294.2 +029500- "*****************************************". SQ1294.2 +029600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1294.2 +029700- "******************************". SQ1294.2 +029800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1294.2 +029900 "SQ129A". SQ1294.2 +030000* SQ1294.2 +030100* SQ1294.2 +030200 PROCEDURE DIVISION. SQ1294.2 +030300 DECLARATIVES. SQ1294.2 +030400 SQ129A-DECLARATIVE-001-SECT SECTION. SQ1294.2 +030500 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1294.2 +030600 INPUT-ERROR-PROCEDURE. SQ1294.2 +030700 IF DECL-EXEC-SW NOT = 9 SQ1294.2 +030800 GO TO NOT-DECL-9. SQ1294.2 +030900* SQ1294.2 +031000* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1294.2 +031100* SQ1294.2 +031200 DECL-OPEN-TEST. SQ1294.2 +031300 MOVE "DECL-OPEN-TEST" TO PAR-NAME. SQ1294.2 +031400 MOVE 1 TO REC-CT. SQ1294.2 +031500 IF SQ-FS1-STATUS = "35" SQ1294.2 +031600 PERFORM DECL-PASS SQ1294.2 +031700 ELSE SQ1294.2 +031800 MOVE "35" TO CORRECT-A SQ1294.2 +031900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1294.2 +032000 MOVE "INCORRECT FILE STATUS FOR NON-AVAILABLE FILE" SQ1294.2 +032100 TO RE-MARK SQ1294.2 +032200 PERFORM DECL-FAIL. SQ1294.2 +032300 MOVE SPACE TO DUMMY-RECORD SQ1294.2 +032400 PERFORM DECL-WRITE-LINE SQ1294.2 +032500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1294.2 +032600 GO TO END-DECLS. SQ1294.2 +032700* SQ1294.2 +032800* SQ1294.2 +032900 NOT-DECL-9. SQ1294.2 +033000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1294.2 +033100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1294.2 +033200 MOVE 9 TO CORRECT-18V0. SQ1294.2 +033300 PERFORM DECL-FAIL. SQ1294.2 +033400 GO TO END-DECLS. SQ1294.2 +033500* SQ1294.2 +033600* SQ1294.2 +033700* SQ1294.2 +033800 DECL-PASS. SQ1294.2 +033900 MOVE "PASS " TO P-OR-F. SQ1294.2 +034000 ADD 1 TO PASS-COUNTER. SQ1294.2 +034100 PERFORM DECL-PRINT-DETAIL. SQ1294.2 +034200* SQ1294.2 +034300 DECL-FAIL. SQ1294.2 +034400 MOVE "FAIL*" TO P-OR-F. SQ1294.2 +034500 ADD 1 TO ERROR-COUNTER. SQ1294.2 +034600 PERFORM DECL-PRINT-DETAIL. SQ1294.2 +034700* SQ1294.2 +034800 DECL-PRINT-DETAIL. SQ1294.2 +034900 IF REC-CT NOT EQUAL TO ZERO SQ1294.2 +035000 MOVE "." TO PARDOT-X SQ1294.2 +035100 MOVE REC-CT TO DOTVALUE. SQ1294.2 +035200 MOVE TEST-RESULTS TO PRINT-REC. SQ1294.2 +035300 PERFORM DECL-WRITE-LINE. SQ1294.2 +035400 IF P-OR-F EQUAL TO "FAIL*" SQ1294.2 +035500 PERFORM DECL-WRITE-LINE SQ1294.2 +035600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1294.2 +035700 ELSE SQ1294.2 +035800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1294.2 +035900 MOVE SPACE TO P-OR-F. SQ1294.2 +036000 MOVE SPACE TO COMPUTED-X. SQ1294.2 +036100 MOVE SPACE TO CORRECT-X. SQ1294.2 +036200 IF REC-CT EQUAL TO ZERO SQ1294.2 +036300 MOVE SPACE TO PAR-NAME. SQ1294.2 +036400 MOVE SPACE TO RE-MARK. SQ1294.2 +036500* SQ1294.2 +036600 DECL-WRITE-LINE. SQ1294.2 +036700 ADD 1 TO RECORD-COUNT. SQ1294.2 +036800Y IF RECORD-COUNT GREATER 50 SQ1294.2 +036900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1294.2 +037000Y MOVE SPACE TO DUMMY-RECORD SQ1294.2 +037100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1294.2 +037200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1294.2 +037300Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1294.2 +037400Y PERFORM DECL-WRT-LN 2 TIMES SQ1294.2 +037500Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1294.2 +037600Y PERFORM DECL-WRT-LN SQ1294.2 +037700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1294.2 +037800Y MOVE ZERO TO RECORD-COUNT. SQ1294.2 +037900 PERFORM DECL-WRT-LN. SQ1294.2 +038000* SQ1294.2 +038100 DECL-WRT-LN. SQ1294.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1294.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ1294.2 +038400* SQ1294.2 +038500 DECL-FAIL-ROUTINE. SQ1294.2 +038600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1294.2 +038700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1294.2 +038800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1294.2 +039000 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +039100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +039300 GO TO DECL-FAIL-EX. SQ1294.2 +039400 DECL-FAIL-WRITE. SQ1294.2 +039500 MOVE TEST-COMPUTED TO PRINT-REC SQ1294.2 +039600 PERFORM DECL-WRITE-LINE SQ1294.2 +039700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1294.2 +039800 MOVE TEST-CORRECT TO PRINT-REC SQ1294.2 +039900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +040000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1294.2 +040100 DECL-FAIL-EX. SQ1294.2 +040200 EXIT. SQ1294.2 +040300* SQ1294.2 +040400 DECL-BAIL. SQ1294.2 +040500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1294.2 +040600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1294.2 +040700 DECL-BAIL-WRITE. SQ1294.2 +040800 MOVE CORRECT-A TO XXCORRECT. SQ1294.2 +040900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1294.2 +041000 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +041100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +041200 DECL-BAIL-EX. SQ1294.2 +041300 EXIT. SQ1294.2 +041400* SQ1294.2 +041500 END-DECLS. SQ1294.2 +041600 MOVE ZERO TO DECL-EXEC-SW. SQ1294.2 +041700 END DECLARATIVES. SQ1294.2 +041800* SQ1294.2 +041900* SQ1294.2 +042000 CCVS1 SECTION. SQ1294.2 +042100 OPEN-FILES. SQ1294.2 +042200P OPEN I-O RAW-DATA. SQ1294.2 +042300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1294.2 +042400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1294.2 +042500P MOVE "ABORTED " TO C-ABORT. SQ1294.2 +042600P ADD 1 TO C-NO-OF-TESTS. SQ1294.2 +042700P ACCEPT C-DATE FROM DATE. SQ1294.2 +042800P ACCEPT C-TIME FROM TIME. SQ1294.2 +042900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1294.2 +043000PEND-E-1. SQ1294.2 +043100P CLOSE RAW-DATA. SQ1294.2 +043200 OPEN OUTPUT PRINT-FILE. SQ1294.2 +043300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1294.2 +043400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1294.2 +043500 MOVE SPACE TO TEST-RESULTS. SQ1294.2 +043600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1294.2 +043700 MOVE ZERO TO REC-SKEL-SUB. SQ1294.2 +043800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1294.2 +043900 GO TO CCVS1-EXIT. SQ1294.2 +044000* SQ1294.2 +044100 CCVS-INIT-FILE. SQ1294.2 +044200 ADD 1 TO REC-SKL-SUB. SQ1294.2 +044300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1294.2 +044400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1294.2 +044500* SQ1294.2 +044600 CLOSE-FILES. SQ1294.2 +044700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1294.2 +044800 CLOSE PRINT-FILE. SQ1294.2 +044900P OPEN I-O RAW-DATA. SQ1294.2 +045000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1294.2 +045100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1294.2 +045200P MOVE "OK. " TO C-ABORT. SQ1294.2 +045300P MOVE PASS-COUNTER TO C-OK. SQ1294.2 +045400P MOVE ERROR-HOLD TO C-ALL. SQ1294.2 +045500P MOVE ERROR-COUNTER TO C-FAIL. SQ1294.2 +045600P MOVE DELETE-CNT TO C-DELETED. SQ1294.2 +045700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1294.2 +045800P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1294.2 +045900PEND-E-2. SQ1294.2 +046000P CLOSE RAW-DATA. SQ1294.2 +046100 TERMINATE-CCVS. SQ1294.2 +046200S EXIT PROGRAM. SQ1294.2 +046300 STOP RUN. SQ1294.2 +046400* SQ1294.2 +046500 INSPT. SQ1294.2 +046600 MOVE "INSPT" TO P-OR-F. SQ1294.2 +046700 ADD 1 TO INSPECT-COUNTER. SQ1294.2 +046800 PERFORM PRINT-DETAIL. SQ1294.2 +046900 SQ1294.2 +047000 PASS. SQ1294.2 +047100 MOVE "PASS " TO P-OR-F. SQ1294.2 +047200 ADD 1 TO PASS-COUNTER. SQ1294.2 +047300 PERFORM PRINT-DETAIL. SQ1294.2 +047400* SQ1294.2 +047500 FAIL. SQ1294.2 +047600 MOVE "FAIL*" TO P-OR-F. SQ1294.2 +047700 ADD 1 TO ERROR-COUNTER. SQ1294.2 +047800 PERFORM PRINT-DETAIL. SQ1294.2 +047900* SQ1294.2 +048000 DE-LETE. SQ1294.2 +048100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1294.2 +048200 MOVE "*****" TO P-OR-F. SQ1294.2 +048300 ADD 1 TO DELETE-COUNTER. SQ1294.2 +048400 PERFORM PRINT-DETAIL. SQ1294.2 +048500* SQ1294.2 +048600 PRINT-DETAIL. SQ1294.2 +048700 IF REC-CT NOT EQUAL TO ZERO SQ1294.2 +048800 MOVE "." TO PARDOT-X SQ1294.2 +048900 MOVE REC-CT TO DOTVALUE. SQ1294.2 +049000 MOVE TEST-RESULTS TO PRINT-REC. SQ1294.2 +049100 PERFORM WRITE-LINE. SQ1294.2 +049200 IF P-OR-F EQUAL TO "FAIL*" SQ1294.2 +049300 PERFORM WRITE-LINE SQ1294.2 +049400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1294.2 +049500 ELSE SQ1294.2 +049600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1294.2 +049700 MOVE SPACE TO P-OR-F. SQ1294.2 +049800 MOVE SPACE TO COMPUTED-X. SQ1294.2 +049900 MOVE SPACE TO CORRECT-X. SQ1294.2 +050000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1294.2 +050100 MOVE SPACE TO RE-MARK. SQ1294.2 +050200* SQ1294.2 +050300 HEAD-ROUTINE. SQ1294.2 +050400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +050500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +050600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1294.2 +050700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1294.2 +050800 COLUMN-NAMES-ROUTINE. SQ1294.2 +050900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +051000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +051100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +051200 END-ROUTINE. SQ1294.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1294.2 +051400 PERFORM WRITE-LINE 5 TIMES. SQ1294.2 +051500 END-RTN-EXIT. SQ1294.2 +051600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1294.2 +051700 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +051800* SQ1294.2 +051900 END-ROUTINE-1. SQ1294.2 +052000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1294.2 +052100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1294.2 +052200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1294.2 +052300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1294.2 +052400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1294.2 +052500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1294.2 +052600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1294.2 +052700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1294.2 +052800 PERFORM WRITE-LINE. SQ1294.2 +052900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1294.2 +053000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1294.2 +053100 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +053200 ELSE SQ1294.2 +053300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1294.2 +053400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1294.2 +053500 PERFORM WRITE-LINE. SQ1294.2 +053600 END-ROUTINE-13. SQ1294.2 +053700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1294.2 +053800 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +053900 ELSE SQ1294.2 +054000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1294.2 +054100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1294.2 +054200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1294.2 +054300 PERFORM WRITE-LINE. SQ1294.2 +054400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1294.2 +054500 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +054600 ELSE SQ1294.2 +054700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1294.2 +054800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1294.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +055000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +055100* SQ1294.2 +055200 WRITE-LINE. SQ1294.2 +055300 ADD 1 TO RECORD-COUNT. SQ1294.2 +055400Y IF RECORD-COUNT GREATER 50 SQ1294.2 +055500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1294.2 +055600Y MOVE SPACE TO DUMMY-RECORD SQ1294.2 +055700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1294.2 +055800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1294.2 +055900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1294.2 +056000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1294.2 +056100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1294.2 +056200Y MOVE ZERO TO RECORD-COUNT. SQ1294.2 +056300 PERFORM WRT-LN. SQ1294.2 +056400* SQ1294.2 +056500 WRT-LN. SQ1294.2 +056600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1294.2 +056700 MOVE SPACE TO DUMMY-RECORD. SQ1294.2 +056800 BLANK-LINE-PRINT. SQ1294.2 +056900 PERFORM WRT-LN. SQ1294.2 +057000 FAIL-ROUTINE. SQ1294.2 +057100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1294.2 +057200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1294.2 +057300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1294.2 +057500 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +057600 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +057700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +057800 GO TO FAIL-ROUTINE-EX. SQ1294.2 +057900 FAIL-ROUTINE-WRITE. SQ1294.2 +058000 MOVE TEST-COMPUTED TO PRINT-REC SQ1294.2 +058100 PERFORM WRITE-LINE SQ1294.2 +058200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1294.2 +058300 MOVE TEST-CORRECT TO PRINT-REC SQ1294.2 +058400 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +058500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1294.2 +058600 FAIL-ROUTINE-EX. SQ1294.2 +058700 EXIT. SQ1294.2 +058800 BAIL-OUT. SQ1294.2 +058900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1294.2 +059000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1294.2 +059100 BAIL-OUT-WRITE. SQ1294.2 +059200 MOVE CORRECT-A TO XXCORRECT. SQ1294.2 +059300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1294.2 +059400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +059500 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +059600 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +059800 BAIL-OUT-EX. SQ1294.2 +059900 EXIT. SQ1294.2 +060000 CCVS1-EXIT. SQ1294.2 +060100 EXIT. SQ1294.2 +060200* SQ1294.2 +060300**************************************************************** SQ1294.2 +060400* * SQ1294.2 +060500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1294.2 +060600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1294.2 +060700* * SQ1294.2 +060800**************************************************************** SQ1294.2 +060900* SQ1294.2 +061000 SECT-SQ129A-MAIN SECTION. SQ1294.2 +061100 OPEN-INIT-01. SQ1294.2 +061200* SQ1294.2 +061300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1294.2 +061400* PRESENT AND AVAILABLE TO IT. SQ1294.2 +061500* SQ1294.2 +061600 MOVE 1 TO REC-CT SQ1294.2 +061700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1294.2 +061800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1294.2 +061900 MOVE 9 TO DECL-EXEC-SW SQ1294.2 +062000 MOVE "**" TO SQ-FS1-STATUS. SQ1294.2 +062100 OPEN-TEST-01. SQ1294.2 +062200 OPEN INPUT SQ-FS1. SQ1294.2 +062300 CCVS-EXIT SECTION. SQ1294.2 +062400 CCVS-999999. SQ1294.2 +062500 GO TO CLOSE-FILES. SQ1294.2 +*END-OF,SQ129A +*HEADER,COBOL,SQ130A +000100 IDENTIFICATION DIVISION. SQ1304.2 +000200 PROGRAM-ID. SQ1304.2 +000300 SQ130A. SQ1304.2 +000400**************************************************************** SQ1304.2 +000500* * SQ1304.2 +000600* VALIDATION FOR:- * SQ1304.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1304.2 +000900* REVISED 1986, AUGUST * SQ1304.2 +001000* * SQ1304.2 +001100* CREATION DATE / VALIDATION DATE * SQ1304.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1304.2 +001300* * SQ1304.2 +001400**************************************************************** SQ1304.2 +001500* * SQ1304.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1304.2 +001700* * SQ1304.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1304.2 +001900* X-55 SYSTEM PRINTER * SQ1304.2 +002000* X-82 SOURCE-COMPUTER * SQ1304.2 +002100* X-83 OBJECT-COMPUTER. * SQ1304.2 +002200* * SQ1304.2 +002300* * SQ1304.2 +002400**************************************************************** SQ1304.2 +002500* * SQ1304.2 +002600* SQ130A ATTEMPTS TO OPEN FOR INPUT-OUTPUT A MASS STORAGE * SQ1304.2 +002700* FILE WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A * SQ1304.2 +002800* PERMANENT ERROR AND AN I-O STATUS OF "35". THE PROGRAM * SQ1304.2 +002900* DOES NOT CONTAIN AN APPLICABLE DECLARATIVE PROCEDURE. IN * SQ1304.2 +003000* THESE CIRCUMSTANCES THE STANDARD ALLOWS THE IMPLEMENTOR * SQ1304.2 +003100* TO TERMINATE EXECUTION OF THE PROGRAM OR TO CONTINUE. * SQ1304.2 +003200* * SQ1304.2 +003300**************************************************************** SQ1304.2 +003400* SQ1304.2 +003500 ENVIRONMENT DIVISION. SQ1304.2 +003600 CONFIGURATION SECTION. SQ1304.2 +003700 SOURCE-COMPUTER. SQ1304.2 +003800 XXXXX082. SQ1304.2 +003900 OBJECT-COMPUTER. SQ1304.2 +004000 XXXXX083. SQ1304.2 +004100* SQ1304.2 +004200 INPUT-OUTPUT SECTION. SQ1304.2 +004300 FILE-CONTROL. SQ1304.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1304.2 +004500 XXXXX055. SQ1304.2 +004600* SQ1304.2 +004700P SELECT RAW-DATA ASSIGN TO SQ1304.2 +004800P XXXXX062 SQ1304.2 +004900P ORGANIZATION IS INDEXED SQ1304.2 +005000P ACCESS MODE IS RANDOM SQ1304.2 +005100P RECORD-KEY IS RAW-DATA-KEY. SQ1304.2 +005200P SQ1304.2 +005300 SELECT SQ-FS1 ASSIGN TO SQ1304.2 +005400 XXXXX014 SQ1304.2 +005500 FILE STATUS IS SQ-FS1-STATUS. SQ1304.2 +005600* SQ1304.2 +005700* SQ1304.2 +005800 DATA DIVISION. SQ1304.2 +005900 FILE SECTION. SQ1304.2 +006000 FD PRINT-FILE SQ1304.2 +006100C LABEL RECORDS SQ1304.2 +006200C XXXXX084 SQ1304.2 +006300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1304.2 +006400 . SQ1304.2 +006500 01 PRINT-REC PICTURE X(120). SQ1304.2 +006600 01 DUMMY-RECORD PICTURE X(120). SQ1304.2 +006700P SQ1304.2 +006800PFD RAW-DATA. SQ1304.2 +006900P01 RAW-DATA-SATZ. SQ1304.2 +007000P 05 RAW-DATA-KEY PIC X(6). SQ1304.2 +007100P 05 C-DATE PIC 9(6). SQ1304.2 +007200P 05 C-TIME PIC 9(8). SQ1304.2 +007300P 05 NO-OF-TESTS PIC 99. SQ1304.2 +007400P 05 C-OK PIC 999. SQ1304.2 +007500P 05 C-ALL PIC 999. SQ1304.2 +007600P 05 C-FAIL PIC 999. SQ1304.2 +007700P 05 C-DELETED PIC 999. SQ1304.2 +007800P 05 C-INSPECT PIC 999. SQ1304.2 +007900P 05 C-NOTE PIC X(13). SQ1304.2 +008000P 05 C-INDENT PIC X. SQ1304.2 +008100P 05 C-ABORT PIC X(8). SQ1304.2 +008200* SQ1304.2 +008300 FD SQ-FS1 SQ1304.2 +008400C LABEL RECORD IS STANDARD SQ1304.2 +008500 . SQ1304.2 +008600 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1304.2 +008700* SQ1304.2 +008800 WORKING-STORAGE SECTION. SQ1304.2 +008900* SQ1304.2 +009000*************************************************************** SQ1304.2 +009100* * SQ1304.2 +009200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1304.2 +009300* * SQ1304.2 +009400*************************************************************** SQ1304.2 +009500* SQ1304.2 +009600 01 SQ-FS1-STATUS. SQ1304.2 +009700 03 SQ-FS1-KEY-1 PIC X. SQ1304.2 +009800 03 SQ-FS1-KEY-2 PIC X. SQ1304.2 +009900* SQ1304.2 +010000* SQ1304.2 +010100*************************************************************** SQ1304.2 +010200* * SQ1304.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1304.2 +010400* * SQ1304.2 +010500*************************************************************** SQ1304.2 +010600* SQ1304.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1304.2 +010800* SQ1304.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1304.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1304.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1304.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1304.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1304.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1304.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1304.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1304.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1304.2 +011800 ",RECKEY= ". SQ1304.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1304.2 +012000 ",ALTKEY1= ". SQ1304.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1304.2 +012200 ",ALTKEY2= ". SQ1304.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1304.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1304.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1304.2 +012600 07 FILLER PIC X(5). SQ1304.2 +012700 07 XFILE-NAME PIC X(6). SQ1304.2 +012800 07 FILLER PIC X(8). SQ1304.2 +012900 07 XRECORD-NAME PIC X(6). SQ1304.2 +013000 07 FILLER PIC X(1). SQ1304.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1304.2 +013200 07 FILLER PIC X(7). SQ1304.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1304.2 +013400 07 FILLER PIC X(6). SQ1304.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1304.2 +013600 07 FILLER PIC X(5). SQ1304.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1304.2 +013800 07 FILLER PIC X(5). SQ1304.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1304.2 +014000 07 FILLER PIC X(7). SQ1304.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1304.2 +014200 07 FILLER PIC X(7). SQ1304.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1304.2 +014400 07 FILLER PIC X(1). SQ1304.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1304.2 +014600 07 FILLER PIC X(6). SQ1304.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1304.2 +014800 07 FILLER PIC X(5). SQ1304.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1304.2 +015000 07 FILLER PIC X(6). SQ1304.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1304.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1304.2 +015300 07 FILLER PIC X(8). SQ1304.2 +015400 07 XRECORD-KEY PIC X(29). SQ1304.2 +015500 07 FILLER PIC X(9). SQ1304.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1304.2 +015700 07 FILLER PIC X(9). SQ1304.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1304.2 +015900 07 FILLER PIC X(7). SQ1304.2 +016000* SQ1304.2 +016100 01 TEST-RESULTS. SQ1304.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1304.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1304.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016700 02 PAR-NAME. SQ1304.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1304.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1304.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1304.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1304.2 +017200 02 RE-MARK PIC X(61). SQ1304.2 +017300 01 TEST-COMPUTED. SQ1304.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1304.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1304.2 +017600 02 COMPUTED-X. SQ1304.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1304.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1304.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1304.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1304.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1304.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1304.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1304.2 +018400 04 FILLER PIC X. SQ1304.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1304.2 +018600 01 TEST-CORRECT. SQ1304.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1304.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1304.2 +018900 02 CORRECT-X. SQ1304.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1304.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1304.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1304.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1304.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1304.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1304.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1304.2 +019700 04 FILLER PIC X. SQ1304.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1304.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1304.2 +020000 01 CCVS-C-1. SQ1304.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1304.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1304.2 +020300- "SS PARAGRAPH-NAME SQ1304.2 +020400- " REMARKS". SQ1304.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1304.2 +020600 01 CCVS-C-2. SQ1304.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1304.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1304.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1304.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1304.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1304.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1304.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1304.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1304.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1304.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1304.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1304.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1304.2 +022300 01 CCVS-H-1. SQ1304.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1304.2 +022500 02 FILLER PIC X(42) VALUE SQ1304.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1304.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1304.2 +022800 01 CCVS-H-2A. SQ1304.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1304.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1304.2 +023100 02 FILLER PIC XXXX VALUE SQ1304.2 +023200 "4.2 ". SQ1304.2 +023300 02 FILLER PIC X(28) VALUE SQ1304.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1304.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1304.2 +023600* SQ1304.2 +023700 01 CCVS-H-2B. SQ1304.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1304.2 +023900 02 TEST-ID PIC X(9). SQ1304.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1304.2 +024100 02 FILLER PIC X(12) VALUE SQ1304.2 +024200 " HIGH ". SQ1304.2 +024300 02 FILLER PIC X(22) VALUE SQ1304.2 +024400 " LEVEL VALIDATION FOR ". SQ1304.2 +024500 02 FILLER PIC X(58) VALUE SQ1304.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +024700 01 CCVS-H-3. SQ1304.2 +024800 02 FILLER PIC X(34) VALUE SQ1304.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1304.2 +025000 02 FILLER PIC X(58) VALUE SQ1304.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1304.2 +025200 02 FILLER PIC X(28) VALUE SQ1304.2 +025300 " COPYRIGHT 1985,1986 ". SQ1304.2 +025400 01 CCVS-E-1. SQ1304.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1304.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1304.2 +025700 02 ID-AGAIN PIC X(9). SQ1304.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1304.2 +025900 01 CCVS-E-2. SQ1304.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1304.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1304.2 +026200 02 CCVS-E-2-2. SQ1304.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1304.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1304.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1304.2 +026600 "ERRORS ENCOUNTERED". SQ1304.2 +026700 01 CCVS-E-3. SQ1304.2 +026800 02 FILLER PIC X(22) VALUE SQ1304.2 +026900 " FOR OFFICIAL USE ONLY". SQ1304.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1304.2 +027100 02 FILLER PIC X(58) VALUE SQ1304.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1304.2 +027400 02 FILLER PIC X(20) VALUE SQ1304.2 +027500 " COPYRIGHT 1985,1986". SQ1304.2 +027600 01 CCVS-E-4. SQ1304.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1304.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1304.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1304.2 +028000 02 FILLER PIC X(40) VALUE SQ1304.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1304.2 +028200 01 XXINFO. SQ1304.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1304.2 +028400 02 INFO-TEXT. SQ1304.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1304.2 +028600 04 XXCOMPUTED PIC X(20). SQ1304.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1304.2 +028800 04 XXCORRECT PIC X(20). SQ1304.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1304.2 +029000 01 HYPHEN-LINE. SQ1304.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1304.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1304.2 +029300- "*****************************************". SQ1304.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1304.2 +029500- "******************************". SQ1304.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1304.2 +029700 "SQ130A". SQ1304.2 +029800* SQ1304.2 +029900* SQ1304.2 +030000 PROCEDURE DIVISION. SQ1304.2 +030100 CCVS1 SECTION. SQ1304.2 +030200 OPEN-FILES. SQ1304.2 +030300P OPEN I-O RAW-DATA. SQ1304.2 +030400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1304.2 +030500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1304.2 +030600P MOVE "ABORTED " TO C-ABORT. SQ1304.2 +030700P ADD 1 TO C-NO-OF-TESTS. SQ1304.2 +030800P ACCEPT C-DATE FROM DATE. SQ1304.2 +030900P ACCEPT C-TIME FROM TIME. SQ1304.2 +031000P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1304.2 +031100PEND-E-1. SQ1304.2 +031200P CLOSE RAW-DATA. SQ1304.2 +031300 OPEN OUTPUT PRINT-FILE. SQ1304.2 +031400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1304.2 +031500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1304.2 +031600 MOVE SPACE TO TEST-RESULTS. SQ1304.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1304.2 +031800 MOVE ZERO TO REC-SKEL-SUB. SQ1304.2 +031900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1304.2 +032000 GO TO CCVS1-EXIT. SQ1304.2 +032100* SQ1304.2 +032200 CCVS-INIT-FILE. SQ1304.2 +032300 ADD 1 TO REC-SKL-SUB. SQ1304.2 +032400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1304.2 +032500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1304.2 +032600* SQ1304.2 +032700 CLOSE-FILES. SQ1304.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1304.2 +032900 CLOSE PRINT-FILE. SQ1304.2 +033000P OPEN I-O RAW-DATA. SQ1304.2 +033100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1304.2 +033200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1304.2 +033300P MOVE "OK. " TO C-ABORT. SQ1304.2 +033400P MOVE PASS-COUNTER TO C-OK. SQ1304.2 +033500P MOVE ERROR-HOLD TO C-ALL. SQ1304.2 +033600P MOVE ERROR-COUNTER TO C-FAIL. SQ1304.2 +033700P MOVE DELETE-CNT TO C-DELETED. SQ1304.2 +033800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1304.2 +033900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1304.2 +034000PEND-E-2. SQ1304.2 +034100P CLOSE RAW-DATA. SQ1304.2 +034200 TERMINATE-CCVS. SQ1304.2 +034300S EXIT PROGRAM. SQ1304.2 +034400 STOP RUN. SQ1304.2 +034500* SQ1304.2 +034600 INSPT. SQ1304.2 +034700 MOVE "INSPT" TO P-OR-F. SQ1304.2 +034800 ADD 1 TO INSPECT-COUNTER. SQ1304.2 +034900 PERFORM PRINT-DETAIL. SQ1304.2 +035000* SQ1304.2 +035100 PASS. SQ1304.2 +035200 MOVE "PASS " TO P-OR-F. SQ1304.2 +035300 ADD 1 TO PASS-COUNTER. SQ1304.2 +035400 PERFORM PRINT-DETAIL. SQ1304.2 +035500* SQ1304.2 +035600 FAIL. SQ1304.2 +035700 MOVE "FAIL*" TO P-OR-F. SQ1304.2 +035800 ADD 1 TO ERROR-COUNTER. SQ1304.2 +035900 PERFORM PRINT-DETAIL. SQ1304.2 +036000* SQ1304.2 +036100 DE-LETE. SQ1304.2 +036200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1304.2 +036300 MOVE "*****" TO P-OR-F. SQ1304.2 +036400 ADD 1 TO DELETE-COUNTER. SQ1304.2 +036500 PERFORM PRINT-DETAIL. SQ1304.2 +036600* SQ1304.2 +036700 PRINT-DETAIL. SQ1304.2 +036800 IF REC-CT NOT EQUAL TO ZERO SQ1304.2 +036900 MOVE "." TO PARDOT-X SQ1304.2 +037000 MOVE REC-CT TO DOTVALUE. SQ1304.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. SQ1304.2 +037200 PERFORM WRITE-LINE. SQ1304.2 +037300 IF P-OR-F EQUAL TO "FAIL*" SQ1304.2 +037400 PERFORM WRITE-LINE SQ1304.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1304.2 +037600 ELSE SQ1304.2 +037700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1304.2 +037800 MOVE SPACE TO P-OR-F. SQ1304.2 +037900 MOVE SPACE TO COMPUTED-X. SQ1304.2 +038000 MOVE SPACE TO CORRECT-X. SQ1304.2 +038100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1304.2 +038200 MOVE SPACE TO RE-MARK. SQ1304.2 +038300* SQ1304.2 +038400 HEAD-ROUTINE. SQ1304.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +038600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +038700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +038800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +038900 COLUMN-NAMES-ROUTINE. SQ1304.2 +039000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +039100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +039300 END-ROUTINE. SQ1304.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1304.2 +039500 PERFORM WRITE-LINE 5 TIMES. SQ1304.2 +039600 END-RTN-EXIT. SQ1304.2 +039700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1304.2 +039800 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +039900* SQ1304.2 +040000 END-ROUTINE-1. SQ1304.2 +040100 ADD ERROR-COUNTER TO ERROR-HOLD SQ1304.2 +040200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1304.2 +040300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1304.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. SQ1304.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1304.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1304.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1304.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1304.2 +040900 PERFORM WRITE-LINE. SQ1304.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1304.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1304.2 +041200 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +041300 ELSE SQ1304.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1304.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1304.2 +041600 PERFORM WRITE-LINE. SQ1304.2 +041700 END-ROUTINE-13. SQ1304.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1304.2 +041900 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +042000 ELSE SQ1304.2 +042100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1304.2 +042200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1304.2 +042300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1304.2 +042400 PERFORM WRITE-LINE. SQ1304.2 +042500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1304.2 +042600 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +042700 ELSE SQ1304.2 +042800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1304.2 +042900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1304.2 +043000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +043100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +043200* SQ1304.2 +043300 WRITE-LINE. SQ1304.2 +043400 ADD 1 TO RECORD-COUNT. SQ1304.2 +043500Y IF RECORD-COUNT GREATER 50 SQ1304.2 +043600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1304.2 +043700Y MOVE SPACE TO DUMMY-RECORD SQ1304.2 +043800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1304.2 +043900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1304.2 +044000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1304.2 +044100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1304.2 +044200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1304.2 +044300Y MOVE ZERO TO RECORD-COUNT. SQ1304.2 +044400 PERFORM WRT-LN. SQ1304.2 +044500* SQ1304.2 +044600 WRT-LN. SQ1304.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1304.2 +044800 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +044900 BLANK-LINE-PRINT. SQ1304.2 +045000 PERFORM WRT-LN. SQ1304.2 +045100 FAIL-ROUTINE. SQ1304.2 +045200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1304.2 +045300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1304.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1304.2 +045500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1304.2 +045600 MOVE XXINFO TO DUMMY-RECORD. SQ1304.2 +045700 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +045800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1304.2 +045900 GO TO FAIL-ROUTINE-EX. SQ1304.2 +046000 FAIL-ROUTINE-WRITE. SQ1304.2 +046100 MOVE TEST-COMPUTED TO PRINT-REC SQ1304.2 +046200 PERFORM WRITE-LINE SQ1304.2 +046300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1304.2 +046400 MOVE TEST-CORRECT TO PRINT-REC SQ1304.2 +046500 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +046600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1304.2 +046700 FAIL-ROUTINE-EX. SQ1304.2 +046800 EXIT. SQ1304.2 +046900 BAIL-OUT. SQ1304.2 +047000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1304.2 +047100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1304.2 +047200 BAIL-OUT-WRITE. SQ1304.2 +047300 MOVE CORRECT-A TO XXCORRECT. SQ1304.2 +047400 MOVE COMPUTED-A TO XXCOMPUTED. SQ1304.2 +047500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1304.2 +047600 MOVE XXINFO TO DUMMY-RECORD. SQ1304.2 +047700 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +047800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1304.2 +047900 BAIL-OUT-EX. SQ1304.2 +048000 EXIT. SQ1304.2 +048100 CCVS1-EXIT. SQ1304.2 +048200 EXIT. SQ1304.2 +048300* SQ1304.2 +048400**************************************************************** SQ1304.2 +048500* * SQ1304.2 +048600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1304.2 +048700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1304.2 +048800* * SQ1304.2 +048900**************************************************************** SQ1304.2 +049000* SQ1304.2 +049100 SECT-SQ130A-MAIN SECTION. SQ1304.2 +049200 OPEN-INIT-01. SQ1304.2 +049300* SQ1304.2 +049400* THIS PROGRAM ATTEMPTS TO OPEN IN THE INPUT-OUTPUT MODE SQ1304.2 +049500* A FILE WHICH IS NOT PRESENT AND AVAILABLE TO IT. SQ1304.2 +049600* SQ1304.2 +049700 MOVE 1 TO REC-CT SQ1304.2 +049800 MOVE "OPEN ABSENT FILE I-O" TO FEATURE SQ1304.2 +049900 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1304.2 +050000 MOVE "**" TO SQ-FS1-STATUS. SQ1304.2 +050100* SQ1304.2 +050200 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +050300 PERFORM WRITE-LINE. SQ1304.2 +050400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1304.2 +050500 TO DUMMY-RECORD. SQ1304.2 +050600 PERFORM WRITE-LINE. SQ1304.2 +050700 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +050800 PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +050900* SQ1304.2 +051000 OPEN-TEST-01. SQ1304.2 +051100 OPEN I-O SQ-FS1. SQ1304.2 +051200 IF SQ-FS1-STATUS NOT = "35" SQ1304.2 +051300 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ1304.2 +051400 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ1304.2 +051500 MOVE "35" TO CORRECT-A SQ1304.2 +051600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1304.2 +051700 PERFORM FAIL SQ1304.2 +051800 ELSE SQ1304.2 +051900 PERFORM PASS. SQ1304.2 +052000* SQ1304.2 +052100* SQ1304.2 +052200 CCVS-EXIT SECTION. SQ1304.2 +052300 CCVS-999999. SQ1304.2 +052400 GO TO CLOSE-FILES. SQ1304.2 +*END-OF,SQ130A +*HEADER,COBOL,SQ131A +000100 IDENTIFICATION DIVISION. SQ1314.2 +000200 PROGRAM-ID. SQ1314.2 +000300 SQ131A. SQ1314.2 +000400**************************************************************** SQ1314.2 +000500* * SQ1314.2 +000600* VALIDATION FOR:- * SQ1314.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1314.2 +000900* REVISED 1986, AUGUST * SQ1314.2 +001000* * SQ1314.2 +001100* CREATION DATE / VALIDATION DATE * SQ1314.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1314.2 +001300* * SQ1314.2 +001400**************************************************************** SQ1314.2 +001500* * SQ1314.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1314.2 +001700* * SQ1314.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1314.2 +001900* X-55 SYSTEM PRINTER * SQ1314.2 +002000* X-82 SOURCE-COMPUTER * SQ1314.2 +002100* X-83 OBJECT-COMPUTER. * SQ1314.2 +002200* * SQ1314.2 +002300* * SQ1314.2 +002400**************************************************************** SQ1314.2 +002500* * SQ1314.2 +002600* SQ131A ATTEMPTS TO OPEN IN THE I-O MODE A MASS STORAGE * SQ1314.2 +002700* FILE WHICH IS ALREADY OPEN IN THE OUTPUT MODE. THIS * SQ1314.2 +002800* SHOULD RESULT IN RECOGNITION OF A LOGIC ERROR CONDITION * SQ1314.2 +002900* AND RETURN OF I-O STATUS OF "41". THE PROGRAM DOES NOT * SQ1314.2 +003000* CONTAIN DECLARATIVE PROCEDURES, AND IN THIS CASE THE * SQ1314.2 +003100* STANDARD ALLOWS THE IMPLEMENTOR TO TERMINATE EXECUTION OF * SQ1314.2 +003200* THE PROGRAM AS PART OF THE EXECUTION OF THE OPEN * SQ1314.2 +003300* STATEMENT. HOWEVER, THE STANDARD ALSO ALLOWS EXECUTION * SQ1314.2 +003400* OF THE PROGRAM TO CONTINUE, AND THERE ARE TESTS TO COVER * SQ1314.2 +003500* THIS CASE. * SQ1314.2 +003600* * SQ1314.2 +003700* THE PROGRAM CONTAINS NO PROVISION FOR DELETION OF * SQ1314.2 +003800* OPERATIONS ON THE FILES, BUT INDIVIDUAL SUBORDINATE TESTS * SQ1314.2 +003900* MAY BE DELETED. * SQ1314.2 +004000* * SQ1314.2 +004100**************************************************************** SQ1314.2 +004200* SQ1314.2 +004300 ENVIRONMENT DIVISION. SQ1314.2 +004400 CONFIGURATION SECTION. SQ1314.2 +004500 SOURCE-COMPUTER. SQ1314.2 +004600 XXXXX082. SQ1314.2 +004700 OBJECT-COMPUTER. SQ1314.2 +004800 XXXXX083. SQ1314.2 +004900* SQ1314.2 +005000 INPUT-OUTPUT SECTION. SQ1314.2 +005100 FILE-CONTROL. SQ1314.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ1314.2 +005300 XXXXX055. SQ1314.2 +005400* SQ1314.2 +005500P SELECT RAW-DATA ASSIGN TO SQ1314.2 +005600P XXXXX062 SQ1314.2 +005700P ORGANIZATION IS INDEXED SQ1314.2 +005800P ACCESS MODE IS RANDOM SQ1314.2 +005900P RECORD-KEY IS RAW-DATA-KEY. SQ1314.2 +006000P SQ1314.2 +006100 SELECT SQ-FS1 ASSIGN TO SQ1314.2 +006200 XXXXX014 SQ1314.2 +006300 FILE STATUS IS SQ-FS1-STATUS. SQ1314.2 +006400* SQ1314.2 +006500* SQ1314.2 +006600 DATA DIVISION. SQ1314.2 +006700 FILE SECTION. SQ1314.2 +006800 FD PRINT-FILE SQ1314.2 +006900C LABEL RECORDS SQ1314.2 +007000C XXXXX084 SQ1314.2 +007100C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1314.2 +007200 . SQ1314.2 +007300 01 PRINT-REC PICTURE X(120). SQ1314.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ1314.2 +007500P SQ1314.2 +007600PFD RAW-DATA. SQ1314.2 +007700P01 RAW-DATA-SATZ. SQ1314.2 +007800P 05 RAW-DATA-KEY PIC X(6). SQ1314.2 +007900P 05 C-DATE PIC 9(6). SQ1314.2 +008000P 05 C-TIME PIC 9(8). SQ1314.2 +008100P 05 NO-OF-TESTS PIC 99. SQ1314.2 +008200P 05 C-OK PIC 999. SQ1314.2 +008300P 05 C-ALL PIC 999. SQ1314.2 +008400P 05 C-FAIL PIC 999. SQ1314.2 +008500P 05 C-DELETED PIC 999. SQ1314.2 +008600P 05 C-INSPECT PIC 999. SQ1314.2 +008700P 05 C-NOTE PIC X(13). SQ1314.2 +008800P 05 C-INDENT PIC X. SQ1314.2 +008900P 05 C-ABORT PIC X(8). SQ1314.2 +009000* SQ1314.2 +009100 FD SQ-FS1 SQ1314.2 +009200C LABEL RECORD IS STANDARD SQ1314.2 +009300 . SQ1314.2 +009400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1314.2 +009500* SQ1314.2 +009600 WORKING-STORAGE SECTION. SQ1314.2 +009700* SQ1314.2 +009800*************************************************************** SQ1314.2 +009900* * SQ1314.2 +010000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1314.2 +010100* * SQ1314.2 +010200*************************************************************** SQ1314.2 +010300* SQ1314.2 +010400 01 SQ-FS1-STATUS. SQ1314.2 +010500 03 SQ-FS1-KEY-1 PIC X. SQ1314.2 +010600 03 SQ-FS1-KEY-2 PIC X. SQ1314.2 +010700* SQ1314.2 +010800* SQ1314.2 +010900*************************************************************** SQ1314.2 +011000* * SQ1314.2 +011100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1314.2 +011200* * SQ1314.2 +011300*************************************************************** SQ1314.2 +011400* SQ1314.2 +011500 01 REC-SKEL-SUB PIC 99. SQ1314.2 +011600* SQ1314.2 +011700 01 FILE-RECORD-INFORMATION-REC. SQ1314.2 +011800 03 FILE-RECORD-INFO-SKELETON. SQ1314.2 +011900 05 FILLER PICTURE X(48) VALUE SQ1314.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1314.2 +012100 05 FILLER PICTURE X(46) VALUE SQ1314.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1314.2 +012300 05 FILLER PICTURE X(26) VALUE SQ1314.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". SQ1314.2 +012500 05 FILLER PICTURE X(37) VALUE SQ1314.2 +012600 ",RECKEY= ". SQ1314.2 +012700 05 FILLER PICTURE X(38) VALUE SQ1314.2 +012800 ",ALTKEY1= ". SQ1314.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1314.2 +013000 ",ALTKEY2= ". SQ1314.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1314.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1314.2 +013300 05 FILE-RECORD-INFO-P1-120. SQ1314.2 +013400 07 FILLER PIC X(5). SQ1314.2 +013500 07 XFILE-NAME PIC X(6). SQ1314.2 +013600 07 FILLER PIC X(8). SQ1314.2 +013700 07 XRECORD-NAME PIC X(6). SQ1314.2 +013800 07 FILLER PIC X(1). SQ1314.2 +013900 07 REELUNIT-NUMBER PIC 9(1). SQ1314.2 +014000 07 FILLER PIC X(7). SQ1314.2 +014100 07 XRECORD-NUMBER PIC 9(6). SQ1314.2 +014200 07 FILLER PIC X(6). SQ1314.2 +014300 07 UPDATE-NUMBER PIC 9(2). SQ1314.2 +014400 07 FILLER PIC X(5). SQ1314.2 +014500 07 ODO-NUMBER PIC 9(4). SQ1314.2 +014600 07 FILLER PIC X(5). SQ1314.2 +014700 07 XPROGRAM-NAME PIC X(5). SQ1314.2 +014800 07 FILLER PIC X(7). SQ1314.2 +014900 07 XRECORD-LENGTH PIC 9(6). SQ1314.2 +015000 07 FILLER PIC X(7). SQ1314.2 +015100 07 CHARS-OR-RECORDS PIC X(2). SQ1314.2 +015200 07 FILLER PIC X(1). SQ1314.2 +015300 07 XBLOCK-SIZE PIC 9(4). SQ1314.2 +015400 07 FILLER PIC X(6). SQ1314.2 +015500 07 RECORDS-IN-FILE PIC 9(6). SQ1314.2 +015600 07 FILLER PIC X(5). SQ1314.2 +015700 07 XFILE-ORGANIZATION PIC X(2). SQ1314.2 +015800 07 FILLER PIC X(6). SQ1314.2 +015900 07 XLABEL-TYPE PIC X(1). SQ1314.2 +016000 05 FILE-RECORD-INFO-P121-240. SQ1314.2 +016100 07 FILLER PIC X(8). SQ1314.2 +016200 07 XRECORD-KEY PIC X(29). SQ1314.2 +016300 07 FILLER PIC X(9). SQ1314.2 +016400 07 ALTERNATE-KEY1 PIC X(29). SQ1314.2 +016500 07 FILLER PIC X(9). SQ1314.2 +016600 07 ALTERNATE-KEY2 PIC X(29). SQ1314.2 +016700 07 FILLER PIC X(7). SQ1314.2 +016800* SQ1314.2 +016900 01 TEST-RESULTS. SQ1314.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017100 02 PAR-NAME. SQ1314.2 +017200 03 FILLER PIC X(14) VALUE SPACE. SQ1314.2 +017300 03 PARDOT-X PIC X VALUE SPACE. SQ1314.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1314.2 +017500 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017600 02 FEATURE PIC X(24) VALUE SPACE. SQ1314.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1314.2 +017900 02 FILLER PIC X(9) VALUE SPACE. SQ1314.2 +018000 02 RE-MARK PIC X(61). SQ1314.2 +018100 01 TEST-COMPUTED. SQ1314.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ1314.2 +018300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1314.2 +018400 02 COMPUTED-X. SQ1314.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1314.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1314.2 +018700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1314.2 +018800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1314.2 +018900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1314.2 +019000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1314.2 +019100 04 COMPUTED-18V0 PIC -9(18). SQ1314.2 +019200 04 FILLER PIC X. SQ1314.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ1314.2 +019400 01 TEST-CORRECT. SQ1314.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1314.2 +019600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1314.2 +019700 02 CORRECT-X. SQ1314.2 +019800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1314.2 +019900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1314.2 +020000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1314.2 +020100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1314.2 +020200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1314.2 +020300 03 CR-18V0 REDEFINES CORRECT-A. SQ1314.2 +020400 04 CORRECT-18V0 PIC -9(18). SQ1314.2 +020500 04 FILLER PIC X. SQ1314.2 +020600 03 FILLER PIC X(2) VALUE SPACE. SQ1314.2 +020700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1314.2 +020800* SQ1314.2 +020900 01 CCVS-C-1. SQ1314.2 +021000 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1314.2 +021200 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1314.2 +021400 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1314.2 +021600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1314.2 +021700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1314.2 +021800 01 CCVS-C-2. SQ1314.2 +021900 02 FILLER PIC X(19) VALUE SPACE. SQ1314.2 +022000 02 FILLER PIC X(6) VALUE "TESTED". SQ1314.2 +022100 02 FILLER PIC X(19) VALUE SPACE. SQ1314.2 +022200 02 FILLER PIC X(4) VALUE "FAIL". SQ1314.2 +022300 02 FILLER PIC X(72) VALUE SPACE. SQ1314.2 +022400* SQ1314.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1314.2 +022600 01 REC-CT PIC 99 VALUE ZERO. SQ1314.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1314.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1314.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1314.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1314.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1314.2 +023600 01 CCVS-H-1. SQ1314.2 +023700 02 FILLER PIC X(39) VALUE SPACES. SQ1314.2 +023800 02 FILLER PIC X(42) VALUE SQ1314.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1314.2 +024000 02 FILLER PIC X(39) VALUE SPACES. SQ1314.2 +024100 01 CCVS-H-2A. SQ1314.2 +024200 02 FILLER PIC X(40) VALUE SPACE. SQ1314.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1314.2 +024400 02 FILLER PIC XXXX VALUE SQ1314.2 +024500 "4.2 ". SQ1314.2 +024600 02 FILLER PIC X(28) VALUE SQ1314.2 +024700 " COPY - NOT FOR DISTRIBUTION". SQ1314.2 +024800 02 FILLER PIC X(41) VALUE SPACE. SQ1314.2 +024900* SQ1314.2 +025000 01 CCVS-H-2B. SQ1314.2 +025100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1314.2 +025200 02 TEST-ID PIC X(9). SQ1314.2 +025300 02 FILLER PIC X(4) VALUE " IN ". SQ1314.2 +025400 02 FILLER PIC X(12) VALUE SQ1314.2 +025500 " HIGH ". SQ1314.2 +025600 02 FILLER PIC X(22) VALUE SQ1314.2 +025700 " LEVEL VALIDATION FOR ". SQ1314.2 +025800 02 FILLER PIC X(58) VALUE SQ1314.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +026000 01 CCVS-H-3. SQ1314.2 +026100 02 FILLER PIC X(34) VALUE SQ1314.2 +026200 " FOR OFFICIAL USE ONLY ". SQ1314.2 +026300 02 FILLER PIC X(58) VALUE SQ1314.2 +026400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1314.2 +026500 02 FILLER PIC X(28) VALUE SQ1314.2 +026600 " COPYRIGHT 1985,1986 ". SQ1314.2 +026700 01 CCVS-E-1. SQ1314.2 +026800 02 FILLER PIC X(52) VALUE SPACE. SQ1314.2 +026900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1314.2 +027000 02 ID-AGAIN PIC X(9). SQ1314.2 +027100 02 FILLER PIC X(45) VALUE SPACES. SQ1314.2 +027200 01 CCVS-E-2. SQ1314.2 +027300 02 FILLER PIC X(31) VALUE SPACE. SQ1314.2 +027400 02 FILLER PIC X(21) VALUE SPACE. SQ1314.2 +027500 02 CCVS-E-2-2. SQ1314.2 +027600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1314.2 +027700 03 FILLER PIC X VALUE SPACE. SQ1314.2 +027800 03 ENDER-DESC PIC X(44) VALUE SQ1314.2 +027900 "ERRORS ENCOUNTERED". SQ1314.2 +028000 01 CCVS-E-3. SQ1314.2 +028100 02 FILLER PIC X(22) VALUE SQ1314.2 +028200 " FOR OFFICIAL USE ONLY". SQ1314.2 +028300 02 FILLER PIC X(12) VALUE SPACE. SQ1314.2 +028400 02 FILLER PIC X(58) VALUE SQ1314.2 +028500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +028600 02 FILLER PIC X(8) VALUE SPACE. SQ1314.2 +028700 02 FILLER PIC X(20) VALUE SQ1314.2 +028800 " COPYRIGHT 1985,1986". SQ1314.2 +028900 01 CCVS-E-4. SQ1314.2 +029000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1314.2 +029100 02 FILLER PIC X(4) VALUE " OF ". SQ1314.2 +029200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1314.2 +029300 02 FILLER PIC X(40) VALUE SQ1314.2 +029400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1314.2 +029500 01 XXINFO. SQ1314.2 +029600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1314.2 +029700 02 INFO-TEXT. SQ1314.2 +029800 04 FILLER PIC X(8) VALUE SPACE. SQ1314.2 +029900 04 XXCOMPUTED PIC X(20). SQ1314.2 +030000 04 FILLER PIC X(5) VALUE SPACE. SQ1314.2 +030100 04 XXCORRECT PIC X(20). SQ1314.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). SQ1314.2 +030300 01 HYPHEN-LINE. SQ1314.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. SQ1314.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1314.2 +030600- "*****************************************". SQ1314.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1314.2 +030800- "******************************". SQ1314.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1314.2 +031000 "SQ131A". SQ1314.2 +031100* SQ1314.2 +031200* SQ1314.2 +031300 PROCEDURE DIVISION. SQ1314.2 +031400 CCVS1 SECTION. SQ1314.2 +031500 OPEN-FILES. SQ1314.2 +031600P OPEN I-O RAW-DATA. SQ1314.2 +031700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1314.2 +031800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1314.2 +031900P MOVE "ABORTED " TO C-ABORT. SQ1314.2 +032000P ADD 1 TO C-NO-OF-TESTS. SQ1314.2 +032100P ACCEPT C-DATE FROM DATE. SQ1314.2 +032200P ACCEPT C-TIME FROM TIME. SQ1314.2 +032300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1314.2 +032400PEND-E-1. SQ1314.2 +032500P CLOSE RAW-DATA. SQ1314.2 +032600 OPEN OUTPUT PRINT-FILE. SQ1314.2 +032700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1314.2 +032800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1314.2 +032900 MOVE SPACE TO TEST-RESULTS. SQ1314.2 +033000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1314.2 +033100 MOVE ZERO TO REC-SKEL-SUB. SQ1314.2 +033200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1314.2 +033300 GO TO CCVS1-EXIT. SQ1314.2 +033400* SQ1314.2 +033500 CCVS-INIT-FILE. SQ1314.2 +033600 ADD 1 TO REC-SKL-SUB. SQ1314.2 +033700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1314.2 +033800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1314.2 +033900* SQ1314.2 +034000 CLOSE-FILES. SQ1314.2 +034100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1314.2 +034200 CLOSE PRINT-FILE. SQ1314.2 +034300P OPEN I-O RAW-DATA. SQ1314.2 +034400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1314.2 +034500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1314.2 +034600P MOVE "OK. " TO C-ABORT. SQ1314.2 +034700P MOVE PASS-COUNTER TO C-OK. SQ1314.2 +034800P MOVE ERROR-HOLD TO C-ALL. SQ1314.2 +034900P MOVE ERROR-COUNTER TO C-FAIL. SQ1314.2 +035000P MOVE DELETE-CNT TO C-DELETED. SQ1314.2 +035100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1314.2 +035200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1314.2 +035300PEND-E-2. SQ1314.2 +035400P CLOSE RAW-DATA. SQ1314.2 +035500 TERMINATE-CCVS. SQ1314.2 +035600S EXIT PROGRAM. SQ1314.2 +035700 STOP RUN. SQ1314.2 +035800* SQ1314.2 +035900 INSPT. SQ1314.2 +036000 MOVE "INSPT" TO P-OR-F. SQ1314.2 +036100 ADD 1 TO INSPECT-COUNTER. SQ1314.2 +036200 PERFORM PRINT-DETAIL. SQ1314.2 +036300 SQ1314.2 +036400 PASS. SQ1314.2 +036500 MOVE "PASS " TO P-OR-F. SQ1314.2 +036600 ADD 1 TO PASS-COUNTER. SQ1314.2 +036700 PERFORM PRINT-DETAIL. SQ1314.2 +036800* SQ1314.2 +036900 FAIL. SQ1314.2 +037000 MOVE "FAIL*" TO P-OR-F. SQ1314.2 +037100 ADD 1 TO ERROR-COUNTER. SQ1314.2 +037200 PERFORM PRINT-DETAIL. SQ1314.2 +037300* SQ1314.2 +037400 DE-LETE. SQ1314.2 +037500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1314.2 +037600 MOVE "*****" TO P-OR-F. SQ1314.2 +037700 ADD 1 TO DELETE-COUNTER. SQ1314.2 +037800 PERFORM PRINT-DETAIL. SQ1314.2 +037900* SQ1314.2 +038000 PRINT-DETAIL. SQ1314.2 +038100 IF REC-CT NOT EQUAL TO ZERO SQ1314.2 +038200 MOVE "." TO PARDOT-X SQ1314.2 +038300 MOVE REC-CT TO DOTVALUE. SQ1314.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. SQ1314.2 +038500 PERFORM WRITE-LINE. SQ1314.2 +038600 IF P-OR-F EQUAL TO "FAIL*" SQ1314.2 +038700 PERFORM WRITE-LINE SQ1314.2 +038800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1314.2 +038900 ELSE SQ1314.2 +039000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1314.2 +039100 MOVE SPACE TO P-OR-F. SQ1314.2 +039200 MOVE SPACE TO COMPUTED-X. SQ1314.2 +039300 MOVE SPACE TO CORRECT-X. SQ1314.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1314.2 +039500 MOVE SPACE TO RE-MARK. SQ1314.2 +039600* SQ1314.2 +039700 HEAD-ROUTINE. SQ1314.2 +039800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +039900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +040000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +040100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +040200 COLUMN-NAMES-ROUTINE. SQ1314.2 +040300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +040400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +040500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +040600 END-ROUTINE. SQ1314.2 +040700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1314.2 +040800 PERFORM WRITE-LINE 5 TIMES. SQ1314.2 +040900 END-RTN-EXIT. SQ1314.2 +041000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1314.2 +041100 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +041200* SQ1314.2 +041300 END-ROUTINE-1. SQ1314.2 +041400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1314.2 +041500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1314.2 +041600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1314.2 +041700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1314.2 +041800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1314.2 +041900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1314.2 +042000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1314.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1314.2 +042200 PERFORM WRITE-LINE. SQ1314.2 +042300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1314.2 +042400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1314.2 +042500 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +042600 ELSE SQ1314.2 +042700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1314.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1314.2 +042900 PERFORM WRITE-LINE. SQ1314.2 +043000 END-ROUTINE-13. SQ1314.2 +043100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1314.2 +043200 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +043300 ELSE SQ1314.2 +043400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1314.2 +043500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1314.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1314.2 +043700 PERFORM WRITE-LINE. SQ1314.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1314.2 +043900 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +044000 ELSE SQ1314.2 +044100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1314.2 +044200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1314.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +044400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +044500* SQ1314.2 +044600 WRITE-LINE. SQ1314.2 +044700 ADD 1 TO RECORD-COUNT. SQ1314.2 +044800Y IF RECORD-COUNT GREATER 50 SQ1314.2 +044900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1314.2 +045000Y MOVE SPACE TO DUMMY-RECORD SQ1314.2 +045100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1314.2 +045200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1314.2 +045300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1314.2 +045400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1314.2 +045500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1314.2 +045600Y MOVE ZERO TO RECORD-COUNT. SQ1314.2 +045700 PERFORM WRT-LN. SQ1314.2 +045800* SQ1314.2 +045900 WRT-LN. SQ1314.2 +046000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1314.2 +046100 MOVE SPACE TO DUMMY-RECORD. SQ1314.2 +046200 BLANK-LINE-PRINT. SQ1314.2 +046300 PERFORM WRT-LN. SQ1314.2 +046400 FAIL-ROUTINE. SQ1314.2 +046500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1314.2 +046600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1314.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1314.2 +046800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1314.2 +046900 MOVE XXINFO TO DUMMY-RECORD. SQ1314.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1314.2 +047200 GO TO FAIL-ROUTINE-EX. SQ1314.2 +047300 FAIL-ROUTINE-WRITE. SQ1314.2 +047400 MOVE TEST-COMPUTED TO PRINT-REC SQ1314.2 +047500 PERFORM WRITE-LINE SQ1314.2 +047600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1314.2 +047700 MOVE TEST-CORRECT TO PRINT-REC SQ1314.2 +047800 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +047900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1314.2 +048000 FAIL-ROUTINE-EX. SQ1314.2 +048100 EXIT. SQ1314.2 +048200 BAIL-OUT. SQ1314.2 +048300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1314.2 +048400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1314.2 +048500 BAIL-OUT-WRITE. SQ1314.2 +048600 MOVE CORRECT-A TO XXCORRECT. SQ1314.2 +048700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1314.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1314.2 +048900 MOVE XXINFO TO DUMMY-RECORD. SQ1314.2 +049000 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1314.2 +049200 BAIL-OUT-EX. SQ1314.2 +049300 EXIT. SQ1314.2 +049400 CCVS1-EXIT. SQ1314.2 +049500 EXIT. SQ1314.2 +049600* SQ1314.2 +049700**************************************************************** SQ1314.2 +049800* * SQ1314.2 +049900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1314.2 +050000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1314.2 +050100* * SQ1314.2 +050200**************************************************************** SQ1314.2 +050300* SQ1314.2 +050400 SECT-SQ131A-MAIN SECTION. SQ1314.2 +050500* SQ1314.2 +050600* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1314.2 +050700* OPEN OUTPUT STATEMENT. SQ1314.2 +050800* SQ1314.2 +050900 SEQ-INIT-01. SQ1314.2 +051000* SQ1314.2 +051100 MOVE 0 TO REC-CT SQ1314.2 +051200 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1314.2 +051300 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1314.2 +051400 MOVE "**" TO SQ-FS1-STATUS. SQ1314.2 +051500 SEQ-TEST-OP-01. SQ1314.2 +051600 OPEN OUTPUT SQ-FS1. SQ1314.2 +051700* SQ1314.2 +051800* CHECK THE I-O STATUS VALUE RETURNED BY THE FIRST OPEN. SQ1314.2 +051900* SQ1314.2 +052000 ADD 1 TO REC-CT. SQ1314.2 +052100 GO TO SEQ-TEST-OP-01-01. SQ1314.2 +052200 SEQ-DELETE-01-01. SQ1314.2 +052300 PERFORM DE-LETE. SQ1314.2 +052400 GO TO SEQ-TEST-01-01-END. SQ1314.2 +052500 SEQ-TEST-OP-01-01. SQ1314.2 +052600 IF SQ-FS1-STATUS = "00" SQ1314.2 +052700 PERFORM PASS SQ1314.2 +052800 ELSE SQ1314.2 +052900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1314.2 +053000 MOVE "00" TO CORRECT-A SQ1314.2 +053100 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1314.2 +053200 TO RE-MARK SQ1314.2 +053300 MOVE "VII-3, 1.5.3(1)A" TO ANSI-REFERENCE SQ1314.2 +053400 PERFORM FAIL. SQ1314.2 +053500 SEQ-TEST-01-01-END. SQ1314.2 +053600* SQ1314.2 +053700* SQ1314.2 +053800* HAVING OPENED THE FILE FOR OUTPUT, THE NEXT ACTION IS TO SQ1314.2 +053900* ATTEMPT TO OPEN IT FOR I-O. THE STANDARD PERMITS THE SQ1314.2 +054000* TERMINATION OF PROGRAM EXECUTION ON SUCH AN ATTEMPT TO SQ1314.2 +054100* OPEN A FILE WHICH IS ALREADY OPEN, BUT ALSO ALLOWS SQ1314.2 +054200* EXECUTION TO CONTINUE. SQ1314.2 +054300* SQ1314.2 +054400 MOVE SPACE TO DUMMY-RECORD SQ1314.2 +054500 PERFORM WRITE-LINE. SQ1314.2 +054600 MOVE "ABOUT TO ATTEMPT TO OPEN AN OPEN FILE" SQ1314.2 +054700 TO DUMMY-RECORD SQ1314.2 +054800 PERFORM WRITE-LINE. SQ1314.2 +054900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1314.2 +055000 TO DUMMY-RECORD SQ1314.2 +055100 PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +055200* SQ1314.2 +055300 SEQ-INIT-02. SQ1314.2 +055400 MOVE 0 TO REC-CT SQ1314.2 +055500 MOVE "OPEN I-O ON AN OPEN FILE" TO FEATURE SQ1314.2 +055600 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1314.2 +055700 MOVE "**" TO SQ-FS1-STATUS. SQ1314.2 +055800 SEQ-TEST-OP-02. SQ1314.2 +055900 OPEN I-O SQ-FS1. SQ1314.2 +056000* SQ1314.2 +056100* CHECK THE I-O STATUS VALUE RETURNED BY THE SECOND OPEN. SQ1314.2 +056200* SQ1314.2 +056300 ADD 1 TO REC-CT. SQ1314.2 +056400 GO TO SEQ-TEST-OP-02-01. SQ1314.2 +056500 SEQ-DELETE-02-01. SQ1314.2 +056600 PERFORM DE-LETE. SQ1314.2 +056700 GO TO SEQ-TEST-02-01-END. SQ1314.2 +056800 SEQ-TEST-OP-02-01. SQ1314.2 +056900 IF SQ-FS1-STATUS = "41" SQ1314.2 +057000 PERFORM PASS SQ1314.2 +057100 ELSE SQ1314.2 +057200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1314.2 +057300 MOVE "41" TO CORRECT-A SQ1314.2 +057400 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1314.2 +057500 TO RE-MARK SQ1314.2 +057600 MOVE "VII-4, 1.5.3(4)A" TO ANSI-REFERENCE SQ1314.2 +057700 PERFORM FAIL. SQ1314.2 +057800 SEQ-TEST-02-01-END. SQ1314.2 +057900* SQ1314.2 +058000* SQ1314.2 +058100 CCVS-EXIT SECTION. SQ1314.2 +058200 CCVS-999999. SQ1314.2 +058300 GO TO CLOSE-FILES. SQ1314.2 +*END-OF,SQ131A +*HEADER,COBOL,SQ132A +000100 IDENTIFICATION DIVISION. SQ1324.2 +000200 PROGRAM-ID. SQ1324.2 +000300 SQ132A. SQ1324.2 +000400*************************************************************** SQ1324.2 +000500* * SQ1324.2 +000600* VALIDATION FOR:- * SQ1324.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +000800* USING CCVS85 VERSION 4.2. * SQ1324.2 +000900* * SQ1324.2 +001000* CREATION DATE / VALIDATION DATE * SQ1324.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1324.2 +001200* * SQ1324.2 +001300*************************************************************** SQ1324.2 +001400* * SQ1324.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1324.2 +001600* * SQ1324.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1324.2 +001800* X-55 SYSTEM PRINTER * SQ1324.2 +001900* X-82 SOURCE-COMPUTER * SQ1324.2 +002000* X-83 OBJECT-COMPUTER * SQ1324.2 +002100* X-84 LABEL RECORDS OPTION * SQ1324.2 +002200* * SQ1324.2 +002300*************************************************************** SQ1324.2 +002400* * SQ1324.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TOCLOSING * SQ1324.2 +002600* AN UNOPENED FILE. THE TEST FOR CORRECT I-O STATUS CODE * SQ1324.2 +002700* 42 IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1324.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1324.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1324.2 +003000* LINE CODE. * SQ1324.2 +003100* * SQ1324.2 +003200*************************************************************** SQ1324.2 +003300* SQ1324.2 +003400 ENVIRONMENT DIVISION. SQ1324.2 +003500 CONFIGURATION SECTION. SQ1324.2 +003600 SOURCE-COMPUTER. SQ1324.2 +003700 XXXXX082. SQ1324.2 +003800 OBJECT-COMPUTER. SQ1324.2 +003900 XXXXX083. SQ1324.2 +004000* SQ1324.2 +004100 INPUT-OUTPUT SECTION. SQ1324.2 +004200 FILE-CONTROL. SQ1324.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1324.2 +004400 XXXXX055. SQ1324.2 +004500* SQ1324.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1324.2 +004700 XXXXX014 SQ1324.2 +004800 FILE STATUS SQ-FS1-STATUS. SQ1324.2 +004900* SQ1324.2 +005000* SQ1324.2 +005100 DATA DIVISION. SQ1324.2 +005200 FILE SECTION. SQ1324.2 +005300 FD PRINT-FILE SQ1324.2 +005400C LABEL RECORDS SQ1324.2 +005500C XXXXX084 SQ1324.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1324.2 +005700 . SQ1324.2 +005800 01 PRINT-REC PICTURE X(120). SQ1324.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1324.2 +006000* SQ1324.2 +006100 FD SQ-FS1 SQ1324.2 +006200C LABEL RECORD IS STANDARD SQ1324.2 +006300 . SQ1324.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1324.2 +006500* SQ1324.2 +006600 WORKING-STORAGE SECTION. SQ1324.2 +006700* SQ1324.2 +006800************************************************************** SQ1324.2 +006900* * SQ1324.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1324.2 +007100* * SQ1324.2 +007200************************************************************** SQ1324.2 +007300* SQ1324.2 +007400 01 SQ-FS1-STATUS. SQ1324.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1324.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1324.2 +007700* SQ1324.2 +007800************************************************************** SQ1324.2 +007900* * SQ1324.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1324.2 +008100* * SQ1324.2 +008200************************************************************** SQ1324.2 +008300* SQ1324.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1324.2 +008500* SQ1324.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1324.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1324.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1324.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1324.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1324.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1324.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1324.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1324.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1324.2 +009500 ",RECKEY= ". SQ1324.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1324.2 +009700 ",ALTKEY1= ". SQ1324.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1324.2 +009900 ",ALTKEY2= ". SQ1324.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE. SQ1324.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1324.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1324.2 +010300 07 FILLER PIC X(5). SQ1324.2 +010400 07 XFILE-NAME PIC X(6). SQ1324.2 +010500 07 FILLER PIC X(8). SQ1324.2 +010600 07 XRECORD-NAME PIC X(6). SQ1324.2 +010700 07 FILLER PIC X(1). SQ1324.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1324.2 +010900 07 FILLER PIC X(7). SQ1324.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1324.2 +011100 07 FILLER PIC X(6). SQ1324.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1324.2 +011300 07 FILLER PIC X(5). SQ1324.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1324.2 +011500 07 FILLER PIC X(5). SQ1324.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1324.2 +011700 07 FILLER PIC X(7). SQ1324.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1324.2 +011900 07 FILLER PIC X(7). SQ1324.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1324.2 +012100 07 FILLER PIC X(1). SQ1324.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1324.2 +012300 07 FILLER PIC X(6). SQ1324.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1324.2 +012500 07 FILLER PIC X(5). SQ1324.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1324.2 +012700 07 FILLER PIC X(6). SQ1324.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1324.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1324.2 +013000 07 FILLER PIC X(8). SQ1324.2 +013100 07 XRECORD-KEY PIC X(29). SQ1324.2 +013200 07 FILLER PIC X(9). SQ1324.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1324.2 +013400 07 FILLER PIC X(9). SQ1324.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1324.2 +013600 07 FILLER PIC X(7). SQ1324.2 +013700* SQ1324.2 +013800 01 TEST-RESULTS. SQ1324.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014000 02 PAR-NAME. SQ1324.2 +014100 03 FILLER PIC X(14) VALUE SPACE. SQ1324.2 +014200 03 PARDOT-X PIC X VALUE SPACE. SQ1324.2 +014300 03 DOTVALUE PIC 99 VALUE ZERO. SQ1324.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014500 02 FEATURE PIC X(24) VALUE SPACE. SQ1324.2 +014600 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1324.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1324.2 +014900 02 RE-MARK PIC X(61). SQ1324.2 +015000 01 TEST-COMPUTED. SQ1324.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1324.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1324.2 +015300 02 COMPUTED-X. SQ1324.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1324.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1324.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1324.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1324.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1324.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1324.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1324.2 +016100 04 FILLER PIC X. SQ1324.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1324.2 +016300 01 TEST-CORRECT. SQ1324.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1324.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1324.2 +016600 02 CORRECT-X. SQ1324.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1324.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1324.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1324.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1324.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1324.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1324.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1324.2 +017400 04 FILLER PIC X. SQ1324.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1324.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1324.2 +017700* SQ1324.2 +017800 01 CCVS-C-1. SQ1324.2 +017900 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1324.2 +018100 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1324.2 +018300 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1324.2 +018500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1324.2 +018600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1324.2 +018700 01 CCVS-C-2. SQ1324.2 +018800 02 FILLER PIC X(19) VALUE SPACE. SQ1324.2 +018900 02 FILLER PIC X(6) VALUE "TESTED". SQ1324.2 +019000 02 FILLER PIC X(19) VALUE SPACE. SQ1324.2 +019100 02 FILLER PIC X(4) VALUE "FAIL". SQ1324.2 +019200 02 FILLER PIC X(72) VALUE SPACE. SQ1324.2 +019300* SQ1324.2 +019400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1324.2 +019500 01 REC-CT PIC 99 VALUE ZERO. SQ1324.2 +019600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1324.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1324.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1324.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1324.2 +020400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1324.2 +020500 01 CCVS-H-1. SQ1324.2 +020600 02 FILLER PIC X(39) VALUE SPACES. SQ1324.2 +020700 02 FILLER PIC X(42) VALUE SQ1324.2 +020800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1324.2 +020900 02 FILLER PIC X(39) VALUE SPACES. SQ1324.2 +021000 01 CCVS-H-2A. SQ1324.2 +021100 02 FILLER PIC X(40) VALUE SPACE. SQ1324.2 +021200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1324.2 +021300 02 FILLER PIC XXXX VALUE SQ1324.2 +021400 "4.2 ". SQ1324.2 +021500 02 FILLER PIC X(28) VALUE SQ1324.2 +021600 " COPY - NOT FOR DISTRIBUTION". SQ1324.2 +021700 02 FILLER PIC X(41) VALUE SPACE. SQ1324.2 +021800* SQ1324.2 +021900 01 CCVS-H-2B. SQ1324.2 +022000 02 FILLER PIC X(15) VALUE "TEST RESULT OF". SQ1324.2 +022100 02 TEST-ID PIC X(9). SQ1324.2 +022200 02 FILLER PIC X(4) VALUE " IN ". SQ1324.2 +022300 02 FILLER PIC X(12) VALUE SQ1324.2 +022400 " HIGH ". SQ1324.2 +022500 02 FILLER PIC X(22) VALUE SQ1324.2 +022600 " LEVEL VALIDATION FOR ". SQ1324.2 +022700 02 FILLER PIC X(58) VALUE SQ1324.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +022900 01 CCVS-H-3. SQ1324.2 +023000 02 FILLER PIC X(34) VALUE SQ1324.2 +023100 " FOR OFFICIAL USE ONLY ". SQ1324.2 +023200 02 FILLER PIC X(58) VALUE SQ1324.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1324.2 +023400 02 FILLER PIC X(28) VALUE SQ1324.2 +023500 " COPYRIGHT 1985,1986 ". SQ1324.2 +023600 01 CCVS-E-1. SQ1324.2 +023700 02 FILLER PIC X(52) VALUE SPACE. SQ1324.2 +023800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1324.2 +023900 02 ID-AGAIN PIC X(9). SQ1324.2 +024000 02 FILLER PIC X(45) VALUE SPACES. SQ1324.2 +024100 01 CCVS-E-2. SQ1324.2 +024200 02 FILLER PIC X(31) VALUE SPACE. SQ1324.2 +024300 02 FILLER PIC X(21) VALUE SPACE. SQ1324.2 +024400 02 CCVS-E-2-2. SQ1324.2 +024500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1324.2 +024600 03 FILLER PIC X VALUE SPACE. SQ1324.2 +024700 03 ENDER-DESC PIC X(44) VALUE SQ1324.2 +024800 "ERRORS ENCOUNTERED". SQ1324.2 +024900 01 CCVS-E-3. SQ1324.2 +025000 02 FILLER PIC X(22) VALUE SQ1324.2 +025100 " FOR OFFICIAL USE ONLY". SQ1324.2 +025200 02 FILLER PIC X(12) VALUE SPACE. SQ1324.2 +025300 02 FILLER PIC X(58) VALUE SQ1324.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +025500 02 FILLER PIC X(8) VALUE SPACE. SQ1324.2 +025600 02 FILLER PIC X(20) VALUE SQ1324.2 +025700 " COPYRIGHT 1985,1986". SQ1324.2 +025800 01 CCVS-E-4. SQ1324.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1324.2 +026000 02 FILLER PIC X(4) VALUE " OF ". SQ1324.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1324.2 +026200 02 FILLER PIC X(40) VALUE SQ1324.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1324.2 +026400 01 XXINFO. SQ1324.2 +026500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1324.2 +026600 02 INFO-TEXT. SQ1324.2 +026700 04 FILLER PIC X(8) VALUE SPACE. SQ1324.2 +026800 04 XXCOMPUTED PIC X(20). SQ1324.2 +026900 04 FILLER PIC X(5) VALUE SPACE. SQ1324.2 +027000 04 XXCORRECT PIC X(20). SQ1324.2 +027100 02 INF-ANSI-REFERENCE PIC X(48). SQ1324.2 +027200 01 HYPHEN-LINE. SQ1324.2 +027300 02 FILLER PIC IS X VALUE IS SPACE. SQ1324.2 +027400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1324.2 +027500- "*****************************************". SQ1324.2 +027600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1324.2 +027700- "******************************". SQ1324.2 +027800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1324.2 +027900 "SQ132A". SQ1324.2 +028000* SQ1324.2 +028100* SQ1324.2 +028200 PROCEDURE DIVISION. SQ1324.2 +028300 DECLARATIVES. SQ1324.2 +028400 SQ132A-DECLARATIVE-001-SECT SECTION. SQ1324.2 +028500 USE AFTER STANDARD ERROR PROCEDURE SQ-FS1. SQ1324.2 +028600 SQ-FS1-ERROR-PROCEDURE. SQ1324.2 +028700 DECL-CLOSE-01. SQ1324.2 +028800 IF SQ-FS1-STATUS = "42" SQ1324.2 +028900 PERFORM DECL-PASS SQ1324.2 +029000 GO TO DECL-ABNORMAL-TERM SQ1324.2 +029100 ELSE SQ1324.2 +029200 MOVE "42" TO CORRECT-A SQ1324.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1324.2 +029400 MOVE "STATUS FOR CLOSE OF UNOPENED FILE INCORRECT" SQ1324.2 +029500 TO RE-MARK SQ1324.2 +029600 PERFORM DECL-FAIL SQ1324.2 +029700 GO TO DECL-ABNORMAL-TERM SQ1324.2 +029800 END-IF. SQ1324.2 +029900* SQ1324.2 +030000 DECL-PASS. SQ1324.2 +030100 MOVE "PASS " TO P-OR-F. SQ1324.2 +030200 ADD 1 TO PASS-COUNTER. SQ1324.2 +030300 PERFORM DECL-PRINT-DETAIL. SQ1324.2 +030400* SQ1324.2 +030500 DECL-FAIL. SQ1324.2 +030600 MOVE "FAIL*" TO P-OR-F. SQ1324.2 +030700 ADD 1 TO ERROR-COUNTER. SQ1324.2 +030800 PERFORM DECL-PRINT-DETAIL. SQ1324.2 +030900* SQ1324.2 +031000 DECL-PRINT-DETAIL. SQ1324.2 +031100 IF REC-CT NOT EQUAL TO ZERO SQ1324.2 +031200 MOVE "." TO PARDOT-X SQ1324.2 +031300 MOVE REC-CT TO DOTVALUE. SQ1324.2 +031400 MOVE TEST-RESULTS TO PRINT-REC. SQ1324.2 +031500 PERFORM DECL-WRITE-LINE. SQ1324.2 +031600 IF P-OR-F EQUAL TO "FAIL*" SQ1324.2 +031700 PERFORM DECL-WRITE-LINE SQ1324.2 +031800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1324.2 +031900 ELSE SQ1324.2 +032000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1324.2 +032100 MOVE SPACE TO P-OR-F. SQ1324.2 +032200 MOVE SPACE TO COMPUTED-X. SQ1324.2 +032300 MOVE SPACE TO CORRECT-X. SQ1324.2 +032400 IF REC-CT EQUAL TO ZERO SQ1324.2 +032500 MOVE SPACE TO PAR-NAME. SQ1324.2 +032600 MOVE SPACE TO RE-MARK. SQ1324.2 +032700* SQ1324.2 +032800 DECL-WRITE-LINE. SQ1324.2 +032900 ADD 1 TO RECORD-COUNT. SQ1324.2 +033000Y IF RECORD-COUNT GREATER 50 SQ1324.2 +033100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1324.2 +033200Y MOVE SPACE TO DUMMY-RECORD SQ1324.2 +033300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1324.2 +033400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1324.2 +033500Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1324.2 +033600Y PERFORM DECL-WRT-LN 2 TIMES SQ1324.2 +033700Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1324.2 +033800Y PERFORM DECL-WRT-LN SQ1324.2 +033900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1324.2 +034000Y MOVE ZERO TO RECORD-COUNT. SQ1324.2 +034100 PERFORM DECL-WRT-LN. SQ1324.2 +034200* SQ1324.2 +034300 DECL-WRT-LN. SQ1324.2 +034400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1324.2 +034500 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +034600* SQ1324.2 +034700 DECL-FAIL-ROUTINE. SQ1324.2 +034800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1324.2 +034900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1324.2 +035000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +035100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1324.2 +035200 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +035300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +035500 GO TO DECL-FAIL-EX. SQ1324.2 +035600 DECL-FAIL-WRITE. SQ1324.2 +035700 MOVE TEST-COMPUTED TO PRINT-REC SQ1324.2 +035800 PERFORM DECL-WRITE-LINE SQ1324.2 +035900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1324.2 +036000 MOVE TEST-CORRECT TO PRINT-REC SQ1324.2 +036100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +036200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1324.2 +036300 DECL-FAIL-EX. SQ1324.2 +036400 EXIT. SQ1324.2 +036500* SQ1324.2 +036600 DECL-BAIL. SQ1324.2 +036700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1324.2 +036800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1324.2 +036900 DECL-BAIL-WRITE. SQ1324.2 +037000 MOVE CORRECT-A TO XXCORRECT. SQ1324.2 +037100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1324.2 +037200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +037300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +037400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +037500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +037600 DECL-BAIL-EX. SQ1324.2 +037700 EXIT. SQ1324.2 +037800* SQ1324.2 +037900 DECL-ABNORMAL-TERM. SQ1324.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +038100 PERFORM DECL-WRITE-LINE. SQ1324.2 +038200 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1324.2 +038300 TO DUMMY-RECORD. SQ1324.2 +038400 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1324.2 +038500* SQ1324.2 +038600 END-DECLS. SQ1324.2 +038700 EXIT. SQ1324.2 +038800 END DECLARATIVES. SQ1324.2 +038900* SQ1324.2 +039000* SQ1324.2 +039100 CCVS1 SECTION. SQ1324.2 +039200 OPEN-FILES. SQ1324.2 +039300 OPEN OUTPUT PRINT-FILE. SQ1324.2 +039400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1324.2 +039500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1324.2 +039600 MOVE SPACE TO TEST-RESULTS. SQ1324.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1324.2 +039800 MOVE ZERO TO REC-SKEL-SUB. SQ1324.2 +039900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1324.2 +040000 GO TO CCVS1-EXIT. SQ1324.2 +040100* SQ1324.2 +040200 CCVS-INIT-FILE. SQ1324.2 +040300 ADD 1 TO REC-SKL-SUB. SQ1324.2 +040400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1324.2 +040500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1324.2 +040600* SQ1324.2 +040700 CLOSE-FILES. SQ1324.2 +040800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1324.2 +040900 CLOSE PRINT-FILE. SQ1324.2 +041000 TERMINATE-CCVS. SQ1324.2 +041100 STOP RUN. SQ1324.2 +041200* SQ1324.2 +041300 INSPT. SQ1324.2 +041400 MOVE "INSPT" TO P-OR-F. SQ1324.2 +041500 ADD 1 TO INSPECT-COUNTER. SQ1324.2 +041600 PERFORM PRINT-DETAIL. SQ1324.2 +041700 SQ1324.2 +041800 PASS. SQ1324.2 +041900 MOVE "PASS " TO P-OR-F. SQ1324.2 +042000 ADD 1 TO PASS-COUNTER. SQ1324.2 +042100 PERFORM PRINT-DETAIL. SQ1324.2 +042200* SQ1324.2 +042300 FAIL. SQ1324.2 +042400 MOVE "FAIL*" TO P-OR-F. SQ1324.2 +042500 ADD 1 TO ERROR-COUNTER. SQ1324.2 +042600 PERFORM PRINT-DETAIL. SQ1324.2 +042700* SQ1324.2 +042800 DE-LETE. SQ1324.2 +042900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1324.2 +043000 MOVE "*****" TO P-OR-F. SQ1324.2 +043100 ADD 1 TO DELETE-COUNTER. SQ1324.2 +043200 PERFORM PRINT-DETAIL. SQ1324.2 +043300* SQ1324.2 +043400 PRINT-DETAIL. SQ1324.2 +043500 IF REC-CT NOT EQUAL TO ZERO SQ1324.2 +043600 MOVE "." TO PARDOT-X SQ1324.2 +043700 MOVE REC-CT TO DOTVALUE. SQ1324.2 +043800 MOVE TEST-RESULTS TO PRINT-REC. SQ1324.2 +043900 PERFORM WRITE-LINE. SQ1324.2 +044000 IF P-OR-F EQUAL TO "FAIL*" SQ1324.2 +044100 PERFORM WRITE-LINE SQ1324.2 +044200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1324.2 +044300 ELSE SQ1324.2 +044400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1324.2 +044500 MOVE SPACE TO P-OR-F. SQ1324.2 +044600 MOVE SPACE TO COMPUTED-X. SQ1324.2 +044700 MOVE SPACE TO CORRECT-X. SQ1324.2 +044800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1324.2 +044900 MOVE SPACE TO RE-MARK. SQ1324.2 +045000* SQ1324.2 +045100 HEAD-ROUTINE. SQ1324.2 +045200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1324.2 +045500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1324.2 +045600 COLUMN-NAMES-ROUTINE. SQ1324.2 +045700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +045800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +046000 END-ROUTINE. SQ1324.2 +046100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1324.2 +046200 PERFORM WRITE-LINE 5 TIMES. SQ1324.2 +046300 END-RTN-EXIT. SQ1324.2 +046400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1324.2 +046500 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +046600* SQ1324.2 +046700 END-ROUTINE-1. SQ1324.2 +046800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1324.2 +046900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1324.2 +047000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1324.2 +047100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1324.2 +047200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1324.2 +047300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1324.2 +047400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1324.2 +047500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1324.2 +047600 PERFORM WRITE-LINE. SQ1324.2 +047700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1324.2 +047800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1324.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +048000 ELSE SQ1324.2 +048100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1324.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1324.2 +048300 PERFORM WRITE-LINE. SQ1324.2 +048400 END-ROUTINE-13. SQ1324.2 +048500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1324.2 +048600 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +048700 ELSE SQ1324.2 +048800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1324.2 +048900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1324.2 +049000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1324.2 +049100 PERFORM WRITE-LINE. SQ1324.2 +049200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1324.2 +049300 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +049400 ELSE SQ1324.2 +049500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1324.2 +049600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1324.2 +049700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +049800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +049900* SQ1324.2 +050000 WRITE-LINE. SQ1324.2 +050100 ADD 1 TO RECORD-COUNT. SQ1324.2 +050200Y IF RECORD-COUNT GREATER 50 SQ1324.2 +050300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1324.2 +050400Y MOVE SPACE TO DUMMY-RECORD SQ1324.2 +050500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1324.2 +050600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1324.2 +050700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1324.2 +050800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1324.2 +050900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1324.2 +051000Y MOVE ZERO TO RECORD-COUNT. SQ1324.2 +051100 PERFORM WRT-LN. SQ1324.2 +051200* SQ1324.2 +051300 WRT-LN. SQ1324.2 +051400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1324.2 +051500 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +051600 BLANK-LINE-PRINT. SQ1324.2 +051700 PERFORM WRT-LN. SQ1324.2 +051800 FAIL-ROUTINE. SQ1324.2 +051900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1324.2 +052000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1324.2 +052100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +052200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1324.2 +052300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +052500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +052600 GO TO FAIL-ROUTINE-EX. SQ1324.2 +052700 FAIL-ROUTINE-WRITE. SQ1324.2 +052800 MOVE TEST-COMPUTED TO PRINT-REC SQ1324.2 +052900 PERFORM WRITE-LINE SQ1324.2 +053000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1324.2 +053100 MOVE TEST-CORRECT TO PRINT-REC SQ1324.2 +053200 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +053300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1324.2 +053400 FAIL-ROUTINE-EX. SQ1324.2 +053500 EXIT. SQ1324.2 +053600 BAIL-OUT. SQ1324.2 +053700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1324.2 +053800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1324.2 +053900 BAIL-OUT-WRITE. SQ1324.2 +054000 MOVE CORRECT-A TO XXCORRECT. SQ1324.2 +054100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1324.2 +054200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +054300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +054400 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +054500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +054600 BAIL-OUT-EX. SQ1324.2 +054700 EXIT. SQ1324.2 +054800 CCVS1-EXIT. SQ1324.2 +054900 EXIT. SQ1324.2 +055000* SQ1324.2 +055100*************************************************************** SQ1324.2 +055200* * SQ1324.2 +055300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND* SQ1324.2 +055400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1324.2 +055500* * SQ1324.2 +055600*************************************************************** SQ1324.2 +055700* SQ1324.2 +055800 SECT-SQ132A-0001 SECTION. SQ1324.2 +055900* SQ1324.2 +056000* THIS TEST CLOSES A FILE THAT HAS NEVER BEEN OPENED. SQ1324.2 +056100* I-O STATUS CODE 42 SHOULD BE GENERATED. SQ1324.2 +056200* SQ1324.2 +056300 CLOSE-INIT-O1. SQ1324.2 +056400 MOVE "CLOSED UNOPENED FILE" TO FEATURE. SQ1324.2 +056500 MOVE "**" TO SQ-FS1-STATUS. SQ1324.2 +056600 MOVE "CLOS-TEST-01" TO PAR-NAME. SQ1324.2 +056700 MOVE 1 TO REC-CT. SQ1324.2 +056800* SQ1324.2 +056900 CLOSE-TEST-01. SQ1324.2 +057000 IF REC-CT = 0 SQ1324.2 +057100 OPEN INPUT SQ-FS1. SQ1324.2 +057200* THIS IF STATEMENT SHOULD NEVER BE TRUE. IT IS INCLUDED IN SQ1324.2 +057300* AN ATTEMPT TO AVOID A COMPILER DETECTING THE CLOSE OF AN SQ1324.2 +057400* UNOPENED FILE WITHOUT EXECUTING THE PROGRAM. HOWEVER, IF SQ1324.2 +057500* THE DETECTION IS MADE AT COMPILE TIME, THE TEST SHOULD BE SQ1324.2 +057600* CONSIDERED PASSED. SQ1324.2 +057700* SQ1324.2 +057800 CLOSE SQ-FS1. SQ1324.2 +057900* SQ1324.2 +058000 CCVS-EXIT SECTION. SQ1324.2 +058100 CCVS-999999. SQ1324.2 +058200 GO TO CLOSE-FILES. SQ1324.2 +*END-OF,SQ132A +*HEADER,COBOL,SQ133A +000100 IDENTIFICATION DIVISION. SQ1334.2 +000200 PROGRAM-ID. SQ1334.2 +000300 SQ133A. SQ1334.2 +000400**************************************************************** SQ1334.2 +000500* * SQ1334.2 +000600* VALIDATION FOR:- * SQ1334.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1334.2 +000900* REVISED 1986, AUGUST * SQ1334.2 +001000* * SQ1334.2 +001100* CREATION DATE / VALIDATION DATE * SQ1334.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1334.2 +001300* * SQ1334.2 +001400**************************************************************** SQ1334.2 +001500* * SQ1334.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1334.2 +001700* * SQ1334.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1334.2 +001900* X-55 SYSTEM PRINTER * SQ1334.2 +002000* X-82 SOURCE-COMPUTER * SQ1334.2 +002100* X-83 OBJECT-COMPUTER. * SQ1334.2 +002200* * SQ1334.2 +002300**************************************************************** SQ1334.2 +002400* * SQ1334.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1334.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ1334.2 +002700* THE FILE. THE FILE IS THEN OPENED FOR I-O, AND TWO READ * SQ1334.2 +002800* STATEMENTS EXECUTED. THE SECOND SHOULD CAUSE AN AT END * SQ1334.2 +002900* CONDITION, AND THUS BE UNSUCCESSFUL. A REWRITE STATEMENT * SQ1334.2 +003000* IS THEN EXECUTED. THIS SHOULD CAUSE AN EXCEPTION * SQ1334.2 +003100* CONDITION, WITH I-O STATUS "43" AND ENTRY TO THE * SQ1334.2 +003200* APPLICABLE ERROR DECLARATIVE. * SQ1334.2 +003300* * SQ1334.2 +003400* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1334.2 +003500* THE NEW PROGRAM IS SQ144A. * SQ1334.2 +003600**************************************************************** SQ1334.2 +003700* SQ1334.2 +003800 ENVIRONMENT DIVISION. SQ1334.2 +003900 CONFIGURATION SECTION. SQ1334.2 +004000 SOURCE-COMPUTER. SQ1334.2 +004100 XXXXX082. SQ1334.2 +004200 OBJECT-COMPUTER. SQ1334.2 +004300 XXXXX083. SQ1334.2 +004400* SQ1334.2 +004500 INPUT-OUTPUT SECTION. SQ1334.2 +004600 FILE-CONTROL. SQ1334.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ1334.2 +004800 XXXXX055. SQ1334.2 +004900* SQ1334.2 +005000P SELECT RAW-DATA ASSIGN TO SQ1334.2 +005100P XXXXX062 SQ1334.2 +005200P ORGANIZATION IS INDEXED SQ1334.2 +005300P ACCESS MODE IS RANDOM SQ1334.2 +005400P RECORD-KEY IS RAW-DATA-KEY. SQ1334.2 +005500P SQ1334.2 +005600 SELECT SQ-FS4 SQ1334.2 +005700 ASSIGN SQ1334.2 +005800 XXXXX014 SQ1334.2 +005900 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1334.2 +006000 SEQUENTIAL SQ1334.2 +006100 . SQ1334.2 +006200* SQ1334.2 +006300* SQ1334.2 +006400 DATA DIVISION. SQ1334.2 +006500 FILE SECTION. SQ1334.2 +006600 FD PRINT-FILE SQ1334.2 +006700C LABEL RECORDS SQ1334.2 +006800C XXXXX084 SQ1334.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1334.2 +007000 . SQ1334.2 +007100 01 PRINT-REC PICTURE X(120). SQ1334.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1334.2 +007300P SQ1334.2 +007400PFD RAW-DATA. SQ1334.2 +007500P01 RAW-DATA-SATZ. SQ1334.2 +007600P 05 RAW-DATA-KEY PIC X(6). SQ1334.2 +007700P 05 C-DATE PIC 9(6). SQ1334.2 +007800P 05 C-TIME PIC 9(8). SQ1334.2 +007900P 05 NO-OF-TESTS PIC 99. SQ1334.2 +008000P 05 C-OK PIC 999. SQ1334.2 +008100P 05 C-ALL PIC 999. SQ1334.2 +008200P 05 C-FAIL PIC 999. SQ1334.2 +008300P 05 C-DELETED PIC 999. SQ1334.2 +008400P 05 C-INSPECT PIC 999. SQ1334.2 +008500P 05 C-NOTE PIC X(13). SQ1334.2 +008600P 05 C-INDENT PIC X. SQ1334.2 +008700P 05 C-ABORT PIC X(8). SQ1334.2 +008800* SQ1334.2 +008900 FD SQ-FS4 SQ1334.2 +009000C LABEL RECORD IS STANDARD SQ1334.2 +009100 BLOCK 120 CHARACTERS SQ1334.2 +009200 RECORD CONTAINS 120 CHARACTERS SQ1334.2 +009300 . SQ1334.2 +009400 01 SQ-FS4R1-F-G-120. SQ1334.2 +009500 05 FFILE-RECORD-INFO-P1-120. SQ1334.2 +009600 07 FILLER PIC X(5). SQ1334.2 +009700 07 FFILE-NAME PIC X(6). SQ1334.2 +009800 07 FILLER PIC X(8). SQ1334.2 +009900 07 FRECORD-NAME PIC X(6). SQ1334.2 +010000 07 FILLER PIC X(1). SQ1334.2 +010100 07 FREELUNIT-NUMBER PIC 9(1). SQ1334.2 +010200 07 FILLER PIC X(7). SQ1334.2 +010300 07 FRECORD-NUMBER PIC 9(6). SQ1334.2 +010400 07 FILLER PIC X(6). SQ1334.2 +010500 07 FUPDATE-NUMBER PIC 9(2). SQ1334.2 +010600 07 FILLER PIC X(5). SQ1334.2 +010700 07 FODO-NUMBER PIC 9(4). SQ1334.2 +010800 07 FILLER PIC X(5). SQ1334.2 +010900 07 FPROGRAM-NAME PIC X(5). SQ1334.2 +011000 07 FILLER PIC X(7). SQ1334.2 +011100 07 FRECORD-LENGTH PIC 9(6). SQ1334.2 +011200 07 FILLER PIC X(7). SQ1334.2 +011300 07 FCHARS-OR-RECORDS PIC X(2). SQ1334.2 +011400 07 FILLER PIC X(1). SQ1334.2 +011500 07 FBLOCK-SIZE PIC 9(4). SQ1334.2 +011600 07 FILLER PIC X(6). SQ1334.2 +011700 07 FRECORDS-IN-FILE PIC 9(6). SQ1334.2 +011800 07 FILLER PIC X(5). SQ1334.2 +011900 07 FFILE-ORGANIZATION PIC X(2). SQ1334.2 +012000 07 FILLER PIC X(6). SQ1334.2 +012100 07 FLABEL-TYPE PIC X(1). SQ1334.2 +012200* SQ1334.2 +012300 WORKING-STORAGE SECTION. SQ1334.2 +012400* SQ1334.2 +012500*************************************************************** SQ1334.2 +012600* * SQ1334.2 +012700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1334.2 +012800* * SQ1334.2 +012900*************************************************************** SQ1334.2 +013000* SQ1334.2 +013100 01 STATUS-GROUP. SQ1334.2 +013200 04 SQ-FS4-STATUS. SQ1334.2 +013300 07 SQ-FS4-KEY-1 PIC X. SQ1334.2 +013400 07 SQ-FS4-KEY-2 PIC X. SQ1334.2 +013500* SQ1334.2 +013600 01 DELETE-SW. SQ1334.2 +013700 03 DELETE-SW-1 PIC X. SQ1334.2 +013800 03 DELETE-SW-1-GROUP. SQ1334.2 +013900 05 DELETE-SW-2 PIC X. SQ1334.2 +014000* SQ1334.2 +014100 01 DECL-EXEC-I-O PIC X(12). SQ1334.2 +014200* SQ1334.2 +014300 01 DECL-EXEC-SW PIC X. SQ1334.2 +014400* SQ1334.2 +014500*************************************************************** SQ1334.2 +014600* * SQ1334.2 +014700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1334.2 +014800* * SQ1334.2 +014900*************************************************************** SQ1334.2 +015000* SQ1334.2 +015100 01 REC-SKEL-SUB PIC 99. SQ1334.2 +015200* SQ1334.2 +015300 01 FILE-RECORD-INFORMATION-REC. SQ1334.2 +015400 03 FILE-RECORD-INFO-SKELETON. SQ1334.2 +015500 05 FILLER PICTURE X(48) VALUE SQ1334.2 +015600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1334.2 +015700 05 FILLER PICTURE X(46) VALUE SQ1334.2 +015800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1334.2 +015900 05 FILLER PICTURE X(26) VALUE SQ1334.2 +016000 ",LFIL=000000,ORG= ,LBLR= ". SQ1334.2 +016100 05 FILLER PICTURE X(37) VALUE SQ1334.2 +016200 ",RECKEY= ". SQ1334.2 +016300 05 FILLER PICTURE X(38) VALUE SQ1334.2 +016400 ",ALTKEY1= ". SQ1334.2 +016500 05 FILLER PICTURE X(38) VALUE SQ1334.2 +016600 ",ALTKEY2= ". SQ1334.2 +016700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1334.2 +016800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1334.2 +016900 05 FILE-RECORD-INFO-P1-120. SQ1334.2 +017000 07 FILLER PIC X(5). SQ1334.2 +017100 07 XFILE-NAME PIC X(6). SQ1334.2 +017200 07 FILLER PIC X(8). SQ1334.2 +017300 07 XRECORD-NAME PIC X(6). SQ1334.2 +017400 07 FILLER PIC X(1). SQ1334.2 +017500 07 REELUNIT-NUMBER PIC 9(1). SQ1334.2 +017600 07 FILLER PIC X(7). SQ1334.2 +017700 07 XRECORD-NUMBER PIC 9(6). SQ1334.2 +017800 07 FILLER PIC X(6). SQ1334.2 +017900 07 UPDATE-NUMBER PIC 9(2). SQ1334.2 +018000 07 FILLER PIC X(5). SQ1334.2 +018100 07 ODO-NUMBER PIC 9(4). SQ1334.2 +018200 07 FILLER PIC X(5). SQ1334.2 +018300 07 XPROGRAM-NAME PIC X(5). SQ1334.2 +018400 07 FILLER PIC X(7). SQ1334.2 +018500 07 XRECORD-LENGTH PIC 9(6). SQ1334.2 +018600 07 FILLER PIC X(7). SQ1334.2 +018700 07 CHARS-OR-RECORDS PIC X(2). SQ1334.2 +018800 07 FILLER PIC X(1). SQ1334.2 +018900 07 XBLOCK-SIZE PIC 9(4). SQ1334.2 +019000 07 FILLER PIC X(6). SQ1334.2 +019100 07 RECORDS-IN-FILE PIC 9(6). SQ1334.2 +019200 07 FILLER PIC X(5). SQ1334.2 +019300 07 XFILE-ORGANIZATION PIC X(2). SQ1334.2 +019400 07 FILLER PIC X(6). SQ1334.2 +019500 07 XLABEL-TYPE PIC X(1). SQ1334.2 +019600 05 FILE-RECORD-INFO-P121-240. SQ1334.2 +019700 07 FILLER PIC X(8). SQ1334.2 +019800 07 XRECORD-KEY PIC X(29). SQ1334.2 +019900 07 FILLER PIC X(9). SQ1334.2 +020000 07 ALTERNATE-KEY1 PIC X(29). SQ1334.2 +020100 07 FILLER PIC X(9). SQ1334.2 +020200 07 ALTERNATE-KEY2 PIC X(29). SQ1334.2 +020300 07 FILLER PIC X(7). SQ1334.2 +020400* SQ1334.2 +020500 01 TEST-RESULTS. SQ1334.2 +020600 02 FILLER PIC X VALUE SPACE. SQ1334.2 +020700 02 PAR-NAME. SQ1334.2 +020800 03 FILLER PIC X(14) VALUE SPACE. SQ1334.2 +020900 03 PARDOT-X PIC X VALUE SPACE. SQ1334.2 +021000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1334.2 +021100 02 FILLER PIC X VALUE SPACE. SQ1334.2 +021200 02 FEATURE PIC X(24) VALUE SPACE. SQ1334.2 +021300 02 FILLER PIC X VALUE SPACE. SQ1334.2 +021400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1334.2 +021500 02 FILLER PIC X(9) VALUE SPACE. SQ1334.2 +021600 02 RE-MARK PIC X(61). SQ1334.2 +021700 01 TEST-COMPUTED. SQ1334.2 +021800 02 FILLER PIC X(30) VALUE SPACE. SQ1334.2 +021900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1334.2 +022000 02 COMPUTED-X. SQ1334.2 +022100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1334.2 +022200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1334.2 +022300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1334.2 +022400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1334.2 +022500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1334.2 +022600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1334.2 +022700 04 COMPUTED-18V0 PIC -9(18). SQ1334.2 +022800 04 FILLER PIC X. SQ1334.2 +022900 03 FILLER PIC X(50) VALUE SPACE. SQ1334.2 +023000 01 TEST-CORRECT. SQ1334.2 +023100 02 FILLER PIC X(30) VALUE SPACE. SQ1334.2 +023200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1334.2 +023300 02 CORRECT-X. SQ1334.2 +023400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1334.2 +023500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1334.2 +023600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1334.2 +023700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1334.2 +023800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1334.2 +023900 03 CR-18V0 REDEFINES CORRECT-A. SQ1334.2 +024000 04 CORRECT-18V0 PIC -9(18). SQ1334.2 +024100 04 FILLER PIC X. SQ1334.2 +024200 03 FILLER PIC X(2) VALUE SPACE. SQ1334.2 +024300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1334.2 +024400* SQ1334.2 +024500 01 CCVS-C-1. SQ1334.2 +024600 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +024700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1334.2 +024800 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +024900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1334.2 +025000 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +025100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1334.2 +025200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1334.2 +025300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1334.2 +025400 01 CCVS-C-2. SQ1334.2 +025500 02 FILLER PIC X(19) VALUE SPACE. SQ1334.2 +025600 02 FILLER PIC X(6) VALUE "TESTED". SQ1334.2 +025700 02 FILLER PIC X(19) VALUE SPACE. SQ1334.2 +025800 02 FILLER PIC X(4) VALUE "FAIL". SQ1334.2 +025900 02 FILLER PIC X(72) VALUE SPACE. SQ1334.2 +026000* SQ1334.2 +026100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1334.2 +026200 01 REC-CT PIC 99 VALUE ZERO. SQ1334.2 +026300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1334.2 +026800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1334.2 +026900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1334.2 +027000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1334.2 +027100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1334.2 +027200 01 CCVS-H-1. SQ1334.2 +027300 02 FILLER PIC X(39) VALUE SPACES. SQ1334.2 +027400 02 FILLER PIC X(42) VALUE SQ1334.2 +027500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1334.2 +027600 02 FILLER PIC X(39) VALUE SPACES. SQ1334.2 +027700 01 CCVS-H-2A. SQ1334.2 +027800 02 FILLER PIC X(40) VALUE SPACE. SQ1334.2 +027900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1334.2 +028000 02 FILLER PIC XXXX VALUE SQ1334.2 +028100 "4.2 ". SQ1334.2 +028200 02 FILLER PIC X(28) VALUE SQ1334.2 +028300 " COPY - NOT FOR DISTRIBUTION". SQ1334.2 +028400 02 FILLER PIC X(41) VALUE SPACE. SQ1334.2 +028500* SQ1334.2 +028600 01 CCVS-H-2B. SQ1334.2 +028700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1334.2 +028800 02 TEST-ID PIC X(9). SQ1334.2 +028900 02 FILLER PIC X(4) VALUE " IN ". SQ1334.2 +029000 02 FILLER PIC X(12) VALUE SQ1334.2 +029100 " HIGH ". SQ1334.2 +029200 02 FILLER PIC X(22) VALUE SQ1334.2 +029300 " LEVEL VALIDATION FOR ". SQ1334.2 +029400 02 FILLER PIC X(58) VALUE SQ1334.2 +029500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +029600 01 CCVS-H-3. SQ1334.2 +029700 02 FILLER PIC X(34) VALUE SQ1334.2 +029800 " FOR OFFICIAL USE ONLY ". SQ1334.2 +029900 02 FILLER PIC X(58) VALUE SQ1334.2 +030000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1334.2 +030100 02 FILLER PIC X(28) VALUE SQ1334.2 +030200 " COPYRIGHT 1985,1986 ". SQ1334.2 +030300 01 CCVS-E-1. SQ1334.2 +030400 02 FILLER PIC X(52) VALUE SPACE. SQ1334.2 +030500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1334.2 +030600 02 ID-AGAIN PIC X(9). SQ1334.2 +030700 02 FILLER PIC X(45) VALUE SPACES. SQ1334.2 +030800 01 CCVS-E-2. SQ1334.2 +030900 02 FILLER PIC X(31) VALUE SPACE. SQ1334.2 +031000 02 FILLER PIC X(21) VALUE SPACE. SQ1334.2 +031100 02 CCVS-E-2-2. SQ1334.2 +031200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1334.2 +031300 03 FILLER PIC X VALUE SPACE. SQ1334.2 +031400 03 ENDER-DESC PIC X(44) VALUE SQ1334.2 +031500 "ERRORS ENCOUNTERED". SQ1334.2 +031600 01 CCVS-E-3. SQ1334.2 +031700 02 FILLER PIC X(22) VALUE SQ1334.2 +031800 " FOR OFFICIAL USE ONLY". SQ1334.2 +031900 02 FILLER PIC X(12) VALUE SPACE. SQ1334.2 +032000 02 FILLER PIC X(58) VALUE SQ1334.2 +032100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +032200 02 FILLER PIC X(8) VALUE SPACE. SQ1334.2 +032300 02 FILLER PIC X(20) VALUE SQ1334.2 +032400 " COPYRIGHT 1985,1986". SQ1334.2 +032500 01 CCVS-E-4. SQ1334.2 +032600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1334.2 +032700 02 FILLER PIC X(4) VALUE " OF ". SQ1334.2 +032800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1334.2 +032900 02 FILLER PIC X(40) VALUE SQ1334.2 +033000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1334.2 +033100 01 XXINFO. SQ1334.2 +033200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1334.2 +033300 02 INFO-TEXT. SQ1334.2 +033400 04 FILLER PIC X(8) VALUE SPACE. SQ1334.2 +033500 04 XXCOMPUTED PIC X(20). SQ1334.2 +033600 04 FILLER PIC X(5) VALUE SPACE. SQ1334.2 +033700 04 XXCORRECT PIC X(20). SQ1334.2 +033800 02 INF-ANSI-REFERENCE PIC X(48). SQ1334.2 +033900 01 HYPHEN-LINE. SQ1334.2 +034000 02 FILLER PIC IS X VALUE IS SPACE. SQ1334.2 +034100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1334.2 +034200- "*****************************************". SQ1334.2 +034300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1334.2 +034400- "******************************". SQ1334.2 +034500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1334.2 +034600 "SQ133A". SQ1334.2 +034700* SQ1334.2 +034800* SQ1334.2 +034900 PROCEDURE DIVISION. SQ1334.2 +035000 DECLARATIVES. SQ1334.2 +035100* SQ1334.2 +035200 SECT-SQ133A-0001 SECTION. SQ1334.2 +035300 USE AFTER EXCEPTION PROCEDURE I-O. SQ1334.2 +035400 I-O-ERROR-PROCESS. SQ1334.2 +035500 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +035600 IF DECL-EXEC-SW NOT = SPACE SQ1334.2 +035700 GO TO END-DECLS. SQ1334.2 +035800* SQ1334.2 +035900 MOVE 1 TO REC-CT. SQ1334.2 +036000 MOVE "REWRITE AFTER FAILED RD" TO FEATURE. SQ1334.2 +036100 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1334.2 +036200 GO TO DCL-REWRITE-01. SQ1334.2 +036300 DECL-DELETE-01. SQ1334.2 +036400 PERFORM DECL-DE-LETE. SQ1334.2 +036500 GO TO DECL-TEST-01-END. SQ1334.2 +036600 DCL-REWRITE-01. SQ1334.2 +036700 IF SQ-FS4-STATUS = "43" SQ1334.2 +036800 PERFORM DECL-PASS SQ1334.2 +036900 ELSE SQ1334.2 +037000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +037100 MOVE "43" TO CORRECT-A SQ1334.2 +037200 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ1334.2 +037300 TO RE-MARK SQ1334.2 +037400 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ1334.2 +037500 PERFORM DECL-FAIL. SQ1334.2 +037600 DECL-TEST-01-END. SQ1334.2 +037700* SQ1334.2 +037800 PERFORM DECL-WRITE-LINE. SQ1334.2 +037900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1334.2 +038000 TO DUMMY-RECORD. SQ1334.2 +038100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1334.2 +038200 GO TO END-DECLS. SQ1334.2 +038300* SQ1334.2 +038400* SQ1334.2 +038500 DECL-PASS. SQ1334.2 +038600 MOVE "PASS " TO P-OR-F. SQ1334.2 +038700 ADD 1 TO PASS-COUNTER. SQ1334.2 +038800 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +038900* SQ1334.2 +039000 DECL-FAIL. SQ1334.2 +039100 MOVE "FAIL*" TO P-OR-F. SQ1334.2 +039200 ADD 1 TO ERROR-COUNTER. SQ1334.2 +039300 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +039400* SQ1334.2 +039500 DECL-DE-LETE. SQ1334.2 +039600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1334.2 +039700 MOVE "*****" TO P-OR-F. SQ1334.2 +039800 ADD 1 TO DELETE-COUNTER. SQ1334.2 +039900 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +040000* SQ1334.2 +040100 DECL-PRINT-DETAIL. SQ1334.2 +040200 IF REC-CT NOT EQUAL TO ZERO SQ1334.2 +040300 MOVE "." TO PARDOT-X SQ1334.2 +040400 MOVE REC-CT TO DOTVALUE. SQ1334.2 +040500 MOVE TEST-RESULTS TO PRINT-REC. SQ1334.2 +040600 PERFORM DECL-WRITE-LINE. SQ1334.2 +040700 IF P-OR-F EQUAL TO "FAIL*" SQ1334.2 +040800 PERFORM DECL-WRITE-LINE SQ1334.2 +040900 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1334.2 +041000 ELSE SQ1334.2 +041100 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1334.2 +041200 MOVE SPACE TO P-OR-F. SQ1334.2 +041300 MOVE SPACE TO COMPUTED-X. SQ1334.2 +041400 MOVE SPACE TO CORRECT-X. SQ1334.2 +041500 IF REC-CT EQUAL TO ZERO SQ1334.2 +041600 MOVE SPACE TO PAR-NAME. SQ1334.2 +041700 MOVE SPACE TO RE-MARK. SQ1334.2 +041800* SQ1334.2 +041900 DECL-WRITE-LINE. SQ1334.2 +042000 ADD 1 TO RECORD-COUNT. SQ1334.2 +042100Y IF RECORD-COUNT GREATER 50 SQ1334.2 +042200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1334.2 +042300Y MOVE SPACE TO DUMMY-RECORD SQ1334.2 +042400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1334.2 +042500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1334.2 +042600Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1334.2 +042700Y PERFORM DECL-WRT-LN 2 TIMES SQ1334.2 +042800Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1334.2 +042900Y PERFORM DECL-WRT-LN SQ1334.2 +043000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1334.2 +043100Y MOVE ZERO TO RECORD-COUNT. SQ1334.2 +043200 PERFORM DECL-WRT-LN. SQ1334.2 +043300* SQ1334.2 +043400 DECL-WRT-LN. SQ1334.2 +043500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1334.2 +043600 MOVE SPACE TO DUMMY-RECORD. SQ1334.2 +043700* SQ1334.2 +043800 DECL-FAIL-ROUTINE. SQ1334.2 +043900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1334.2 +044000 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1334.2 +044100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +044200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1334.2 +044300 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +044400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +044500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +044600 GO TO DECL-FAIL-EX. SQ1334.2 +044700 DECL-FAIL-WRITE. SQ1334.2 +044800 MOVE TEST-COMPUTED TO PRINT-REC SQ1334.2 +044900 PERFORM DECL-WRITE-LINE SQ1334.2 +045000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1334.2 +045100 MOVE TEST-CORRECT TO PRINT-REC SQ1334.2 +045200 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1334.2 +045400 DECL-FAIL-EX. SQ1334.2 +045500 EXIT. SQ1334.2 +045600* SQ1334.2 +045700 DECL-BAIL. SQ1334.2 +045800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1334.2 +045900 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1334.2 +046000 DECL-BAIL-WRITE. SQ1334.2 +046100 MOVE CORRECT-A TO XXCORRECT. SQ1334.2 +046200 MOVE COMPUTED-A TO XXCOMPUTED. SQ1334.2 +046300 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +046400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +046500 DECL-BAIL-EX. SQ1334.2 +046600 EXIT. SQ1334.2 +046700* SQ1334.2 +046800 END-DECLS. SQ1334.2 +046900 END DECLARATIVES. SQ1334.2 +047000* SQ1334.2 +047100* SQ1334.2 +047200 CCVS1 SECTION. SQ1334.2 +047300 OPEN-FILES. SQ1334.2 +047400P OPEN I-O RAW-DATA. SQ1334.2 +047500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1334.2 +047600P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1334.2 +047700P MOVE "ABORTED " TO C-ABORT. SQ1334.2 +047800P ADD 1 TO C-NO-OF-TESTS. SQ1334.2 +047900P ACCEPT C-DATE FROM DATE. SQ1334.2 +048000P ACCEPT C-TIME FROM TIME. SQ1334.2 +048100P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1334.2 +048200PEND-E-1. SQ1334.2 +048300P CLOSE RAW-DATA. SQ1334.2 +048400 OPEN OUTPUT PRINT-FILE. SQ1334.2 +048500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1334.2 +048600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1334.2 +048700 MOVE SPACE TO TEST-RESULTS. SQ1334.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1334.2 +048900 MOVE ZERO TO REC-SKEL-SUB. SQ1334.2 +049000 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1334.2 +049100 GO TO CCVS1-EXIT. SQ1334.2 +049200* SQ1334.2 +049300 CCVS-INIT-FILE. SQ1334.2 +049400 ADD 1 TO REC-SKL-SUB. SQ1334.2 +049500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1334.2 +049600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1334.2 +049700* SQ1334.2 +049800 CLOSE-FILES. SQ1334.2 +049900 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1334.2 +050000 CLOSE PRINT-FILE. SQ1334.2 +050100P OPEN I-O RAW-DATA. SQ1334.2 +050200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1334.2 +050300P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1334.2 +050400P MOVE "OK. " TO C-ABORT. SQ1334.2 +050500P MOVE PASS-COUNTER TO C-OK. SQ1334.2 +050600P MOVE ERROR-HOLD TO C-ALL. SQ1334.2 +050700P MOVE ERROR-COUNTER TO C-FAIL. SQ1334.2 +050800P MOVE DELETE-CNT TO C-DELETED. SQ1334.2 +050900P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1334.2 +051000P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1334.2 +051100PEND-E-2. SQ1334.2 +051200P CLOSE RAW-DATA. SQ1334.2 +051300 TERMINATE-CCVS. SQ1334.2 +051400S EXIT PROGRAM. SQ1334.2 +051500 STOP RUN. SQ1334.2 +051600* SQ1334.2 +051700 INSPT. SQ1334.2 +051800 MOVE "INSPT" TO P-OR-F. SQ1334.2 +051900 ADD 1 TO INSPECT-COUNTER. SQ1334.2 +052000 PERFORM PRINT-DETAIL. SQ1334.2 +052100* SQ1334.2 +052200 PASS. SQ1334.2 +052300 MOVE "PASS " TO P-OR-F. SQ1334.2 +052400 ADD 1 TO PASS-COUNTER. SQ1334.2 +052500 PERFORM PRINT-DETAIL. SQ1334.2 +052600* SQ1334.2 +052700 FAIL. SQ1334.2 +052800 MOVE "FAIL*" TO P-OR-F. SQ1334.2 +052900 ADD 1 TO ERROR-COUNTER. SQ1334.2 +053000 PERFORM PRINT-DETAIL. SQ1334.2 +053100* SQ1334.2 +053200 DE-LETE. SQ1334.2 +053300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1334.2 +053400 MOVE "*****" TO P-OR-F. SQ1334.2 +053500 ADD 1 TO DELETE-COUNTER. SQ1334.2 +053600 PERFORM PRINT-DETAIL. SQ1334.2 +053700* SQ1334.2 +053800 PRINT-DETAIL. SQ1334.2 +053900 IF REC-CT NOT EQUAL TO ZERO SQ1334.2 +054000 MOVE "." TO PARDOT-X SQ1334.2 +054100 MOVE REC-CT TO DOTVALUE. SQ1334.2 +054200 MOVE TEST-RESULTS TO PRINT-REC. SQ1334.2 +054300 PERFORM WRITE-LINE. SQ1334.2 +054400 IF P-OR-F EQUAL TO "FAIL*" SQ1334.2 +054500 PERFORM WRITE-LINE SQ1334.2 +054600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1334.2 +054700 ELSE SQ1334.2 +054800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1334.2 +054900 MOVE SPACE TO P-OR-F. SQ1334.2 +055000 MOVE SPACE TO COMPUTED-X. SQ1334.2 +055100 MOVE SPACE TO CORRECT-X. SQ1334.2 +055200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1334.2 +055300 MOVE SPACE TO RE-MARK. SQ1334.2 +055400* SQ1334.2 +055500 HEAD-ROUTINE. SQ1334.2 +055600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +055700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +055800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1334.2 +055900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1334.2 +056000 COLUMN-NAMES-ROUTINE. SQ1334.2 +056100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +056200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +056300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +056400 END-ROUTINE. SQ1334.2 +056500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1334.2 +056600 PERFORM WRITE-LINE 5 TIMES. SQ1334.2 +056700 END-RTN-EXIT. SQ1334.2 +056800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1334.2 +056900 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +057000* SQ1334.2 +057100 END-ROUTINE-1. SQ1334.2 +057200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1334.2 +057300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1334.2 +057400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1334.2 +057500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1334.2 +057600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1334.2 +057700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1334.2 +057800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1334.2 +057900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1334.2 +058000 PERFORM WRITE-LINE. SQ1334.2 +058100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1334.2 +058200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1334.2 +058300 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +058400 ELSE SQ1334.2 +058500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1334.2 +058600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1334.2 +058700 PERFORM WRITE-LINE. SQ1334.2 +058800 END-ROUTINE-13. SQ1334.2 +058900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1334.2 +059000 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +059100 ELSE SQ1334.2 +059200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1334.2 +059300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1334.2 +059400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1334.2 +059500 PERFORM WRITE-LINE. SQ1334.2 +059600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1334.2 +059700 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +059800 ELSE SQ1334.2 +059900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1334.2 +060000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1334.2 +060100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +060200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +060300* SQ1334.2 +060400 WRITE-LINE. SQ1334.2 +060500 ADD 1 TO RECORD-COUNT. SQ1334.2 +060600Y IF RECORD-COUNT GREATER 50 SQ1334.2 +060700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1334.2 +060800Y MOVE SPACE TO DUMMY-RECORD SQ1334.2 +060900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1334.2 +061000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1334.2 +061100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1334.2 +061200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1334.2 +061300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1334.2 +061400Y MOVE ZERO TO RECORD-COUNT. SQ1334.2 +061500 PERFORM WRT-LN. SQ1334.2 +061600* SQ1334.2 +061700 WRT-LN. SQ1334.2 +061800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1334.2 +061900 MOVE SPACE TO DUMMY-RECORD. SQ1334.2 +062000 BLANK-LINE-PRINT. SQ1334.2 +062100 PERFORM WRT-LN. SQ1334.2 +062200 FAIL-ROUTINE. SQ1334.2 +062300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1334.2 +062400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1334.2 +062500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +062600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1334.2 +062700 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +062800 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +062900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +063000 GO TO FAIL-ROUTINE-EX. SQ1334.2 +063100 FAIL-ROUTINE-WRITE. SQ1334.2 +063200 MOVE TEST-COMPUTED TO PRINT-REC SQ1334.2 +063300 PERFORM WRITE-LINE SQ1334.2 +063400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1334.2 +063500 MOVE TEST-CORRECT TO PRINT-REC SQ1334.2 +063600 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +063700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1334.2 +063800 FAIL-ROUTINE-EX. SQ1334.2 +063900 EXIT. SQ1334.2 +064000 BAIL-OUT. SQ1334.2 +064100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1334.2 +064200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1334.2 +064300 BAIL-OUT-WRITE. SQ1334.2 +064400 MOVE CORRECT-A TO XXCORRECT. SQ1334.2 +064500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1334.2 +064600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +064700 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +064800 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +064900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +065000 BAIL-OUT-EX. SQ1334.2 +065100 EXIT. SQ1334.2 +065200 CCVS1-EXIT. SQ1334.2 +065300 EXIT. SQ1334.2 +065400* SQ1334.2 +065500**************************************************************** SQ1334.2 +065600* * SQ1334.2 +065700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1334.2 +065800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1334.2 +065900* * SQ1334.2 +066000**************************************************************** SQ1334.2 +066100* SQ1334.2 +066200 SECT-SQ133A-0002 SECTION. SQ1334.2 +066300 STA-INIT. SQ1334.2 +066400 MOVE SPACE TO DELETE-SW. SQ1334.2 +066500* SQ1334.2 +066600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1334.2 +066700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1334.2 +066800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1334.2 +066900 MOVE 120 TO XRECORD-LENGTH (1). SQ1334.2 +067000 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1334.2 +067100 MOVE 1 TO XBLOCK-SIZE (1). SQ1334.2 +067200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1334.2 +067300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1334.2 +067400 MOVE "S" TO XLABEL-TYPE (1). SQ1334.2 +067500* SQ1334.2 +067600* OPEN THE FILE IN THE OUTPUT MODE SQ1334.2 +067700* SQ1334.2 +067800 SEQ-INIT-01. SQ1334.2 +067900 MOVE 0 TO REC-CT. SQ1334.2 +068000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +068100 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +068300 MOVE ZERO TO XRECORD-NUMBER (1). SQ1334.2 +068400 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1334.2 +068500 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1334.2 +068600 GO TO SEQ-TEST-OP-01. SQ1334.2 +068700 SEQ-DELETE-01. SQ1334.2 +068800 MOVE "*" TO DELETE-SW-1. SQ1334.2 +068900 GO TO SEQ-DELETE-01-01. SQ1334.2 +069000 SEQ-TEST-OP-01. SQ1334.2 +069100 OPEN OUTPUT SQ-FS4. SQ1334.2 +069200* SQ1334.2 +069300* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1334.2 +069400* SQ1334.2 +069500 ADD 1 TO REC-CT. SQ1334.2 +069600 IF DELETE-SW NOT = SPACE SQ1334.2 +069700 GO TO SEQ-DELETE-01-01. SQ1334.2 +069800 GO TO SEQ-TEST-OP-01-01. SQ1334.2 +069900 SEQ-DELETE-01-01. SQ1334.2 +070000 PERFORM DE-LETE. SQ1334.2 +070100 GO TO SEQ-TEST-01-01-END. SQ1334.2 +070200 SEQ-TEST-OP-01-01. SQ1334.2 +070300 IF SQ-FS4-STATUS = "00" SQ1334.2 +070400 PERFORM PASS SQ1334.2 +070500 ELSE SQ1334.2 +070600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +070700 MOVE "00" TO CORRECT-A SQ1334.2 +070800 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1334.2 +070900 TO RE-MARK SQ1334.2 +071000 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1334.2 +071100 PERFORM FAIL. SQ1334.2 +071200 SEQ-TEST-01-01-END. SQ1334.2 +071300* SQ1334.2 +071400* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +071500* SQ1334.2 +071600 ADD 1 TO REC-CT. SQ1334.2 +071700 IF DELETE-SW NOT = SPACE SQ1334.2 +071800 GO TO SEQ-DELETE-01-02. SQ1334.2 +071900 GO TO SEQ-TEST-OP-01-02. SQ1334.2 +072000 SEQ-DELETE-01-02. SQ1334.2 +072100 PERFORM DE-LETE. SQ1334.2 +072200 GO TO SEQ-TEST-01-02-END. SQ1334.2 +072300 SEQ-TEST-OP-01-02. SQ1334.2 +072400 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +072500 PERFORM PASS SQ1334.2 +072600 ELSE SQ1334.2 +072700 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +072800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +072900 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +073000 TO RE-MARK SQ1334.2 +073100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +073200 PERFORM FAIL. SQ1334.2 +073300 SEQ-TEST-01-02-END. SQ1334.2 +073400* SQ1334.2 +073500* SQ1334.2 +073600* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD. SQ1334.2 +073700* SQ1334.2 +073800 SEQ-INIT-02. SQ1334.2 +073900 MOVE 0 TO REC-CT. SQ1334.2 +074000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +074100 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +074200 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +074300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +074400 MOVE "WRITE A RECORD" TO FEATURE. SQ1334.2 +074500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1334.2 +074600 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +074700 GO TO SEQ-DELETE-02. SQ1334.2 +074800 GO TO SEQ-TEST-WR-02. SQ1334.2 +074900 SEQ-DELETE-02. SQ1334.2 +075000 MOVE "*" TO DELETE-SW-2. SQ1334.2 +075100 GO TO SEQ-DELETE-02-01. SQ1334.2 +075200 SEQ-TEST-WR-02. SQ1334.2 +075300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1334.2 +075400 WRITE SQ-FS4R1-F-G-120. SQ1334.2 +075500* SQ1334.2 +075600* CHECK I-O STATUS RETURNED FROM WRITE SQ1334.2 +075700* SQ1334.2 +075800 ADD 1 TO REC-CT. SQ1334.2 +075900 IF DELETE-SW NOT = SPACE SQ1334.2 +076000 GO TO SEQ-DELETE-02-01. SQ1334.2 +076100 GO TO SEQ-TEST-WR-02-01. SQ1334.2 +076200 SEQ-DELETE-02-01. SQ1334.2 +076300 PERFORM DE-LETE. SQ1334.2 +076400 GO TO SEQ-TEST-02-01-END. SQ1334.2 +076500 SEQ-TEST-WR-02-01. SQ1334.2 +076600 IF SQ-FS4-STATUS = "00" SQ1334.2 +076700 PERFORM PASS SQ1334.2 +076800 ELSE SQ1334.2 +076900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +077000 MOVE "00" TO CORRECT-A SQ1334.2 +077100 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1334.2 +077200 TO RE-MARK SQ1334.2 +077300 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ1334.2 +077400 PERFORM FAIL. SQ1334.2 +077500 SEQ-TEST-02-01-END. SQ1334.2 +077600* SQ1334.2 +077700* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +077800* SQ1334.2 +077900 ADD 1 TO REC-CT. SQ1334.2 +078000 IF DELETE-SW NOT = SPACE SQ1334.2 +078100 GO TO SEQ-DELETE-02-02. SQ1334.2 +078200 GO TO SEQ-TEST-WR-02-02. SQ1334.2 +078300 SEQ-DELETE-02-02. SQ1334.2 +078400 PERFORM DE-LETE. SQ1334.2 +078500 GO TO SEQ-TEST-02-02-END. SQ1334.2 +078600 SEQ-TEST-WR-02-02. SQ1334.2 +078700 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +078800 PERFORM PASS SQ1334.2 +078900 ELSE SQ1334.2 +079000 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +079100 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +079200 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +079300 TO RE-MARK SQ1334.2 +079400 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +079500 PERFORM FAIL. SQ1334.2 +079600 SEQ-TEST-02-02-END. SQ1334.2 +079700* SQ1334.2 +079800* SQ1334.2 +079900* NOW CLOSE THE FILE. SQ1334.2 +080000* SQ1334.2 +080100 SEQ-INIT-03. SQ1334.2 +080200 MOVE 0 TO REC-CT. SQ1334.2 +080300 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +080400 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +080500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +080600 MOVE "CLOSE FILE" TO FEATURE. SQ1334.2 +080700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1334.2 +080800 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +080900 GO TO SEQ-DELETE-03. SQ1334.2 +081000 GO TO SEQ-TEST-CL-03. SQ1334.2 +081100 SEQ-DELETE-03. SQ1334.2 +081200 MOVE "*" TO DELETE-SW-2. SQ1334.2 +081300 GO TO SEQ-DELETE-03-01. SQ1334.2 +081400 SEQ-TEST-CL-03. SQ1334.2 +081500 CLOSE SQ-FS4. SQ1334.2 +081600* SQ1334.2 +081700* CHECK I-O STATUS RETURNED FROM CLOSE SQ1334.2 +081800* SQ1334.2 +081900 ADD 1 TO REC-CT. SQ1334.2 +082000 IF DELETE-SW NOT = SPACE SQ1334.2 +082100 GO TO SEQ-DELETE-03-01. SQ1334.2 +082200 GO TO SEQ-TEST-CL-03-01. SQ1334.2 +082300 SEQ-DELETE-03-01. SQ1334.2 +082400 PERFORM DE-LETE. SQ1334.2 +082500 GO TO SEQ-TEST-03-01-END. SQ1334.2 +082600 SEQ-TEST-CL-03-01. SQ1334.2 +082700 IF SQ-FS4-STATUS = "00" SQ1334.2 +082800 PERFORM PASS SQ1334.2 +082900 ELSE SQ1334.2 +083000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +083100 MOVE "00" TO CORRECT-A SQ1334.2 +083200 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1334.2 +083300 TO RE-MARK SQ1334.2 +083400 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1334.2 +083500 PERFORM FAIL. SQ1334.2 +083600 SEQ-TEST-03-01-END. SQ1334.2 +083700* SQ1334.2 +083800* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +083900* SQ1334.2 +084000 ADD 1 TO REC-CT. SQ1334.2 +084100 IF DELETE-SW NOT = SPACE SQ1334.2 +084200 GO TO SEQ-DELETE-03-02. SQ1334.2 +084300 GO TO SEQ-TEST-CL-03-02. SQ1334.2 +084400 SEQ-DELETE-03-02. SQ1334.2 +084500 PERFORM DE-LETE. SQ1334.2 +084600 GO TO SEQ-TEST-03-02-END. SQ1334.2 +084700 SEQ-TEST-CL-03-02. SQ1334.2 +084800 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +084900 PERFORM PASS SQ1334.2 +085000 ELSE SQ1334.2 +085100 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +085200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +085300 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +085400 TO RE-MARK SQ1334.2 +085500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +085600 PERFORM FAIL. SQ1334.2 +085700 SEQ-TEST-03-02-END. SQ1334.2 +085800 MOVE SPACE TO DELETE-SW-2. SQ1334.2 +085900* SQ1334.2 +086000* SQ1334.2 +086100* OPEN THE FILE IN THE I-O MODE SQ1334.2 +086200* SQ1334.2 +086300 SEQ-INIT-04. SQ1334.2 +086400 MOVE 0 TO REC-CT. SQ1334.2 +086500 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +086600 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +086700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +086800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1334.2 +086900 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1334.2 +087000 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1334.2 +087100 IF DELETE-SW NOT = SPACE SQ1334.2 +087200 GO TO SEQ-DELETE-04-01. SQ1334.2 +087300 GO TO SEQ-TEST-OP-04. SQ1334.2 +087400 SEQ-DELETE-04. SQ1334.2 +087500 MOVE "*" TO DELETE-SW-2. SQ1334.2 +087600 GO TO SEQ-DELETE-04-01. SQ1334.2 +087700 SEQ-TEST-OP-04. SQ1334.2 +087800 OPEN I-O SQ-FS4. SQ1334.2 +087900* SQ1334.2 +088000* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ1334.2 +088100* SQ1334.2 +088200 ADD 1 TO REC-CT. SQ1334.2 +088300 IF DELETE-SW NOT = SPACE SQ1334.2 +088400 GO TO SEQ-DELETE-04-01. SQ1334.2 +088500 GO TO SEQ-TEST-OP-04-01. SQ1334.2 +088600 SEQ-DELETE-04-01. SQ1334.2 +088700 PERFORM DE-LETE. SQ1334.2 +088800 GO TO SEQ-TEST-04-01-END. SQ1334.2 +088900 SEQ-TEST-OP-04-01. SQ1334.2 +089000 IF SQ-FS4-STATUS = "00" SQ1334.2 +089100 PERFORM PASS SQ1334.2 +089200 ELSE SQ1334.2 +089300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +089400 MOVE "00" TO CORRECT-A SQ1334.2 +089500 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1334.2 +089600 TO RE-MARK SQ1334.2 +089700 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ1334.2 +089800 PERFORM FAIL. SQ1334.2 +089900 SEQ-TEST-04-01-END. SQ1334.2 +090000* SQ1334.2 +090100* SQ1334.2 +090200 ADD 1 TO REC-CT. SQ1334.2 +090300 IF DELETE-SW NOT = SPACE SQ1334.2 +090400 GO TO SEQ-DELETE-04-02. SQ1334.2 +090500 GO TO SEQ-TEST-OP-04-02. SQ1334.2 +090600 SEQ-DELETE-04-02. SQ1334.2 +090700 PERFORM DE-LETE. SQ1334.2 +090800 GO TO SEQ-TEST-04-02-END. SQ1334.2 +090900 SEQ-TEST-OP-04-02. SQ1334.2 +091000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +091100 PERFORM PASS SQ1334.2 +091200 ELSE SQ1334.2 +091300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +091400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +091500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +091600 TO RE-MARK SQ1334.2 +091700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +091800 PERFORM FAIL. SQ1334.2 +091900 SEQ-TEST-04-02-END. SQ1334.2 +092000* SQ1334.2 +092100* SQ1334.2 +092200* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ1334.2 +092300* SQ1334.2 +092400 SEQ-INIT-05. SQ1334.2 +092500 MOVE 0 TO REC-CT. SQ1334.2 +092600 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +092700 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +092800 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +092900 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +093000 MOVE "READ FIRST RECORD" TO FEATURE. SQ1334.2 +093100 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1334.2 +093200 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +093300 GO TO SEQ-DELETE-05. SQ1334.2 +093400 GO TO SEQ-TEST-RD-05. SQ1334.2 +093500 SEQ-DELETE-05. SQ1334.2 +093600 MOVE "*" TO DELETE-SW-2. SQ1334.2 +093700 GO TO SEQ-DELETE-05-01. SQ1334.2 +093800 SEQ-TEST-RD-05. SQ1334.2 +093900 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1334.2 +094000 READ SQ-FS4. SQ1334.2 +094100* SQ1334.2 +094200* CHECK I-O STATUS RETURNED FROM READ SQ1334.2 +094300* SQ1334.2 +094400 ADD 1 TO REC-CT. SQ1334.2 +094500 IF DELETE-SW NOT = SPACE SQ1334.2 +094600 GO TO SEQ-DELETE-05-01. SQ1334.2 +094700 GO TO SEQ-TEST-RD-05-01. SQ1334.2 +094800 SEQ-DELETE-05-01. SQ1334.2 +094900 PERFORM DE-LETE. SQ1334.2 +095000 GO TO SEQ-TEST-05-01-END. SQ1334.2 +095100 SEQ-TEST-RD-05-01. SQ1334.2 +095200 IF SQ-FS4-STATUS = "00" SQ1334.2 +095300 PERFORM PASS SQ1334.2 +095400 ELSE SQ1334.2 +095500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +095600 MOVE "00" TO CORRECT-A SQ1334.2 +095700 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ1334.2 +095800 TO RE-MARK SQ1334.2 +095900 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1334.2 +096000 PERFORM FAIL. SQ1334.2 +096100 SEQ-TEST-05-01-END. SQ1334.2 +096200* SQ1334.2 +096300* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +096400* SQ1334.2 +096500 ADD 1 TO REC-CT. SQ1334.2 +096600 IF DELETE-SW NOT = SPACE SQ1334.2 +096700 GO TO SEQ-DELETE-05-02. SQ1334.2 +096800 GO TO SEQ-TEST-RD-05-02. SQ1334.2 +096900 SEQ-DELETE-05-02. SQ1334.2 +097000 PERFORM DE-LETE. SQ1334.2 +097100 GO TO SEQ-TEST-05-02-END. SQ1334.2 +097200 SEQ-TEST-RD-05-02. SQ1334.2 +097300 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +097400 PERFORM PASS SQ1334.2 +097500 ELSE SQ1334.2 +097600 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +097700 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +097800 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +097900 TO RE-MARK SQ1334.2 +098000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +098100 PERFORM FAIL. SQ1334.2 +098200 SEQ-TEST-05-02-END. SQ1334.2 +098300* SQ1334.2 +098400* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ1334.2 +098500* CHECKING THE RECORD-NUMBER FIELD. SQ1334.2 +098600* SQ1334.2 +098700 ADD 1 TO REC-CT. SQ1334.2 +098800 IF DELETE-SW NOT = SPACE SQ1334.2 +098900 GO TO SEQ-DELETE-05-03. SQ1334.2 +099000 GO TO SEQ-TEST-RD-05-03. SQ1334.2 +099100 SEQ-DELETE-05-03. SQ1334.2 +099200 PERFORM DE-LETE. SQ1334.2 +099300 GO TO SEQ-TEST-05-03-END. SQ1334.2 +099400 SEQ-TEST-RD-05-03. SQ1334.2 +099500 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1334.2 +099600 PERFORM PASS SQ1334.2 +099700 ELSE SQ1334.2 +099800 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ1334.2 +099900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ1334.2 +100000 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1334.2 +100100 PERFORM FAIL. SQ1334.2 +100200 SEQ-TEST-05-03-END. SQ1334.2 +100300 MOVE SPACE TO DELETE-SW-2. SQ1334.2 +100400* SQ1334.2 +100500* SQ1334.2 +100600* ANOTHER READ SHOULD CAUSE THE AT END CONDITION. SQ1334.2 +100700* SQ1334.2 +100800 SEQ-INIT-06. SQ1334.2 +100900 MOVE 0 TO REC-CT. SQ1334.2 +101000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +101100 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +101200 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +101300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +101400 MOVE "READ GIVING AT END" TO FEATURE. SQ1334.2 +101500 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1334.2 +101600 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +101700 GO TO SEQ-DELETE-06. SQ1334.2 +101800 GO TO SEQ-TEST-RD-06. SQ1334.2 +101900 SEQ-DELETE-06. SQ1334.2 +102000 MOVE "*" TO DELETE-SW-2. SQ1334.2 +102100 GO TO SEQ-DELETE-06-01. SQ1334.2 +102200 SEQ-TEST-RD-06. SQ1334.2 +102300 READ SQ-FS4 RECORD. SQ1334.2 +102400* SQ1334.2 +102500* CHECK I-O STATUS RETURNED FROM READ SQ1334.2 +102600* SQ1334.2 +102700 ADD 1 TO REC-CT. SQ1334.2 +102800 IF DELETE-SW NOT = SPACE SQ1334.2 +102900 GO TO SEQ-DELETE-06-01. SQ1334.2 +103000 GO TO SEQ-TEST-RD-06-01. SQ1334.2 +103100 SEQ-DELETE-06-01. SQ1334.2 +103200 PERFORM DE-LETE. SQ1334.2 +103300 GO TO SEQ-TEST-06-01-END. SQ1334.2 +103400 SEQ-TEST-RD-06-01. SQ1334.2 +103500 IF SQ-FS4-STATUS = "10" SQ1334.2 +103600 PERFORM PASS SQ1334.2 +103700 ELSE SQ1334.2 +103800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +103900 MOVE "10" TO CORRECT-A SQ1334.2 +104000 MOVE "AT END STATUS NOT RETURNED FROM READ" SQ1334.2 +104100 TO RE-MARK SQ1334.2 +104200 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1334.2 +104300 PERFORM FAIL. SQ1334.2 +104400 SEQ-TEST-06-01-END. SQ1334.2 +104500* SQ1334.2 +104600* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +104700* SQ1334.2 +104800 ADD 1 TO REC-CT. SQ1334.2 +104900 IF DELETE-SW NOT = SPACE SQ1334.2 +105000 GO TO SEQ-DELETE-06-02. SQ1334.2 +105100 GO TO SEQ-TEST-RD-06-02. SQ1334.2 +105200 SEQ-DELETE-06-02. SQ1334.2 +105300 PERFORM DE-LETE. SQ1334.2 +105400 GO TO SEQ-TEST-06-02-END. SQ1334.2 +105500 SEQ-TEST-RD-06-02. SQ1334.2 +105600 IF DECL-EXEC-I-O = "EXECUTED" SQ1334.2 +105700 PERFORM PASS SQ1334.2 +105800 ELSE SQ1334.2 +105900 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +106000 MOVE "EXECUTED" TO CORRECT-A SQ1334.2 +106100 MOVE "I-O DECLARATIVE NOT EXECUTED AT END OF FILE" SQ1334.2 +106200 TO RE-MARK SQ1334.2 +106300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +106400 PERFORM FAIL. SQ1334.2 +106500 SEQ-TEST-06-02-END. SQ1334.2 +106600* SQ1334.2 +106700* SQ1334.2 +106800* FINALLY, TRY TO EXECUTE A REWRITE AFTER THE FAILED READ SQ1334.2 +106900* SQ1334.2 +107000 SEQ-INIT-07. SQ1334.2 +107100 MOVE 0 TO REC-CT. SQ1334.2 +107200 MOVE SPACE TO DECL-EXEC-SW. SQ1334.2 +107300 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +107400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +107500 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1334.2 +107600 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1334.2 +107700 IF DELETE-SW NOT = SPACE SQ1334.2 +107800 GO TO SEQ-DELETE-07-01. SQ1334.2 +107900 GO TO SEQ-TEST-RW-07. SQ1334.2 +108000 SEQ-DELETE-07. SQ1334.2 +108100 MOVE "*" TO DELETE-SW-2. SQ1334.2 +108200 GO TO SEQ-DELETE-07-01. SQ1334.2 +108300 SEQ-TEST-RW-07. SQ1334.2 +108400 REWRITE SQ-FS4R1-F-G-120. SQ1334.2 +108500 MOVE 0 TO REC-CT. SQ1334.2 +108600 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1334.2 +108700 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1334.2 +108800* SQ1334.2 +108900* CHECK I-O STATUS RETURNED FROM REWRITE SQ1334.2 +109000* SQ1334.2 +109100 ADD 1 TO REC-CT. SQ1334.2 +109200 IF DELETE-SW NOT = SPACE SQ1334.2 +109300 GO TO SEQ-DELETE-07-01. SQ1334.2 +109400 GO TO SEQ-TEST-RW-07-01. SQ1334.2 +109500 SEQ-DELETE-07-01. SQ1334.2 +109600 PERFORM DE-LETE. SQ1334.2 +109700 GO TO SEQ-TEST-07-01-END. SQ1334.2 +109800 SEQ-TEST-RW-07-01. SQ1334.2 +109900 IF SQ-FS4-STATUS = "43" SQ1334.2 +110000 PERFORM PASS SQ1334.2 +110100 ELSE SQ1334.2 +110200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +110300 MOVE "43" TO CORRECT-A SQ1334.2 +110400 MOVE "UNEXPECTED STATUS CODE FROM FAILED REWRITE" SQ1334.2 +110500 TO RE-MARK SQ1334.2 +110600 MOVE "VII-4,1.5.3(4)C, VII-48" TO ANSI-REFERENCE SQ1334.2 +110700 PERFORM FAIL. SQ1334.2 +110800 SEQ-TEST-07-01-END. SQ1334.2 +110900* SQ1334.2 +111000* SQ1334.2 +111100 CCVS-EXIT SECTION. SQ1334.2 +111200 CCVS-999999. SQ1334.2 +111300 GO TO CLOSE-FILES. SQ1334.2 +*END-OF,SQ133A +*HEADER,COBOL,SQ134A +000100 IDENTIFICATION DIVISION. SQ1344.2 +000200 PROGRAM-ID. SQ1344.2 +000300 SQ134A. SQ1344.2 +000400**************************************************************** SQ1344.2 +000500* * SQ1344.2 +000600* VALIDATION FOR:- * SQ1344.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1344.2 +000900* REVISED 1986, AUGUST * SQ1344.2 +001000* * SQ1344.2 +001100* CREATION DATE / VALIDATION DATE * SQ1344.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1344.2 +001300* * SQ1344.2 +001400**************************************************************** SQ1344.2 +001500* * SQ1344.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1344.2 +001700* * SQ1344.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1344.2 +001900* X-55 SYSTEM PRINTER * SQ1344.2 +002000* X-82 SOURCE-COMPUTER * SQ1344.2 +002100* X-83 OBJECT-COMPUTER. * SQ1344.2 +002200* * SQ1344.2 +002300**************************************************************** SQ1344.2 +002400* * SQ1344.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1344.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ1344.2 +002700* THE FILE. TWO RECORD SIZES ARE DEFINED FOR THE FILE, BY * SQ1344.2 +002800* MEANS OF THE RECORD CONTAINS CLAUSE. THE FILE IS THEN * SQ1344.2 +002900* OPENED FOR I-O, AND A READ STATEMENT AND A REWRITE * SQ1344.2 +003000* STATEMENT ARE EXECUTED. THE REWRITE STATEMENT REFERENCES * SQ1344.2 +003100* A RECORD OF A DIFFERENT SIZE TO THAT REFERENCED IN THE * SQ1344.2 +003200* WRITE STATEMENT, AND SHOULD CAUSE AN EXCEPTION CONDITION * SQ1344.2 +003300* WITH I-O STATUS "44". THIS LOGIC ERROR SHOULD CAUSE * SQ1344.2 +003400* ENTRY TO THE APPLICABLE ERROR DECLARATIVE. * SQ1344.2 +003500* * SQ1344.2 +003600* THIS PROGRAM SHOULD BE RUN ONLY WHEN AN IMPLEMENTATION * SQ1344.2 +003700* PROVIDES VARIABLE LENGTH RECORDS FOR THE RECORDS CONTAINS * SQ1344.2 +003800* INTEGER TO INTEGER CLAUSE * SQ1344.2 +003900* * SQ1344.2 +004000* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1344.2 +004100* THE NEW PROGRAM IS SQ145A. * SQ1344.2 +004200**************************************************************** SQ1344.2 +004300* SQ1344.2 +004400 ENVIRONMENT DIVISION. SQ1344.2 +004500 CONFIGURATION SECTION. SQ1344.2 +004600 SOURCE-COMPUTER. SQ1344.2 +004700 XXXXX082. SQ1344.2 +004800 OBJECT-COMPUTER. SQ1344.2 +004900 XXXXX083. SQ1344.2 +005000* SQ1344.2 +005100 INPUT-OUTPUT SECTION. SQ1344.2 +005200 FILE-CONTROL. SQ1344.2 +005300 SELECT PRINT-FILE ASSIGN TO SQ1344.2 +005400 XXXXX055. SQ1344.2 +005500* SQ1344.2 +005600P SELECT RAW-DATA ASSIGN TO SQ1344.2 +005700P XXXXX062 SQ1344.2 +005800P ORGANIZATION IS INDEXED SQ1344.2 +005900P ACCESS MODE IS RANDOM SQ1344.2 +006000P RECORD-KEY IS RAW-DATA-KEY. SQ1344.2 +006100P SQ1344.2 +006200 SELECT SQ-FS4 SQ1344.2 +006300 ASSIGN SQ1344.2 +006400 XXXXX014 SQ1344.2 +006500 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1344.2 +006600 SEQUENTIAL SQ1344.2 +006700 . SQ1344.2 +006800* SQ1344.2 +006900* SQ1344.2 +007000 DATA DIVISION. SQ1344.2 +007100 FILE SECTION. SQ1344.2 +007200 FD PRINT-FILE SQ1344.2 +007300C LABEL RECORDS SQ1344.2 +007400C XXXXX084 SQ1344.2 +007500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1344.2 +007600 . SQ1344.2 +007700 01 PRINT-REC PICTURE X(120). SQ1344.2 +007800 01 DUMMY-RECORD PICTURE X(120). SQ1344.2 +007900P SQ1344.2 +008000PFD RAW-DATA. SQ1344.2 +008100P01 RAW-DATA-SATZ. SQ1344.2 +008200P 05 RAW-DATA-KEY PIC X(6). SQ1344.2 +008300P 05 C-DATE PIC 9(6). SQ1344.2 +008400P 05 C-TIME PIC 9(8). SQ1344.2 +008500P 05 NO-OF-TESTS PIC 99. SQ1344.2 +008600P 05 C-OK PIC 999. SQ1344.2 +008700P 05 C-ALL PIC 999. SQ1344.2 +008800P 05 C-FAIL PIC 999. SQ1344.2 +008900P 05 C-DELETED PIC 999. SQ1344.2 +009000P 05 C-INSPECT PIC 999. SQ1344.2 +009100P 05 C-NOTE PIC X(13). SQ1344.2 +009200P 05 C-INDENT PIC X. SQ1344.2 +009300P 05 C-ABORT PIC X(8). SQ1344.2 +009400* SQ1344.2 +009500 FD SQ-FS4 SQ1344.2 +009600C LABEL RECORD IS STANDARD SQ1344.2 +009700 BLOCK 120 CHARACTERS SQ1344.2 +009800 RECORD CONTAINS 120 TO 138 CHARACTERS SQ1344.2 +009900 . SQ1344.2 +010000 01 SQ-FS4R1-F-G-120. SQ1344.2 +010100 05 FFILE-RECORD-INFO-P1-120. SQ1344.2 +010200 07 FILLER PIC X(5). SQ1344.2 +010300 07 FFILE-NAME PIC X(6). SQ1344.2 +010400 07 FILLER PIC X(8). SQ1344.2 +010500 07 FRECORD-NAME PIC X(6). SQ1344.2 +010600 07 FILLER PIC X(1). SQ1344.2 +010700 07 FREELUNIT-NUMBER PIC 9(1). SQ1344.2 +010800 07 FILLER PIC X(7). SQ1344.2 +010900 07 FRECORD-NUMBER PIC 9(6). SQ1344.2 +011000 07 FILLER PIC X(6). SQ1344.2 +011100 07 FUPDATE-NUMBER PIC 9(2). SQ1344.2 +011200 07 FILLER PIC X(5). SQ1344.2 +011300 07 FODO-NUMBER PIC 9(4). SQ1344.2 +011400 07 FILLER PIC X(5). SQ1344.2 +011500 07 FPROGRAM-NAME PIC X(5). SQ1344.2 +011600 07 FILLER PIC X(7). SQ1344.2 +011700 07 FRECORD-LENGTH PIC 9(6). SQ1344.2 +011800 07 FILLER PIC X(7). SQ1344.2 +011900 07 FCHARS-OR-RECORDS PIC X(2). SQ1344.2 +012000 07 FILLER PIC X(1). SQ1344.2 +012100 07 FBLOCK-SIZE PIC 9(4). SQ1344.2 +012200 07 FILLER PIC X(6). SQ1344.2 +012300 07 FRECORDS-IN-FILE PIC 9(6). SQ1344.2 +012400 07 FILLER PIC X(5). SQ1344.2 +012500 07 FFILE-ORGANIZATION PIC X(2). SQ1344.2 +012600 07 FILLER PIC X(6). SQ1344.2 +012700 07 FLABEL-TYPE PIC X(1). SQ1344.2 +012800* SQ1344.2 +012900 01 SQ-FS4R2-F-G-138. SQ1344.2 +013000 03 FILLER PIC X(120). SQ1344.2 +013100 03 EXT-18 PIC X(18). SQ1344.2 +013200* SQ1344.2 +013300 WORKING-STORAGE SECTION. SQ1344.2 +013400* SQ1344.2 +013500*************************************************************** SQ1344.2 +013600* * SQ1344.2 +013700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1344.2 +013800* * SQ1344.2 +013900*************************************************************** SQ1344.2 +014000* SQ1344.2 +014100 01 STATUS-GROUP. SQ1344.2 +014200 04 SQ-FS4-STATUS. SQ1344.2 +014300 07 SQ-FS4-KEY-1 PIC X. SQ1344.2 +014400 07 SQ-FS4-KEY-2 PIC X. SQ1344.2 +014500* SQ1344.2 +014600 01 DELETE-SW. SQ1344.2 +014700 03 DELETE-SW-1 PIC X. SQ1344.2 +014800 03 DELETE-SW-1-GROUP. SQ1344.2 +014900 05 DELETE-SW-2 PIC X. SQ1344.2 +015000* SQ1344.2 +015100 01 DECL-EXEC-I-O PIC X(12). SQ1344.2 +015200* SQ1344.2 +015300 01 DECL-EXEC-SW PIC X. SQ1344.2 +015400* SQ1344.2 +015500*************************************************************** SQ1344.2 +015600* * SQ1344.2 +015700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1344.2 +015800* * SQ1344.2 +015900*************************************************************** SQ1344.2 +016000* SQ1344.2 +016100 01 REC-SKEL-SUB PIC 99. SQ1344.2 +016200* SQ1344.2 +016300 01 FILE-RECORD-INFORMATION-REC. SQ1344.2 +016400 03 FILE-RECORD-INFO-SKELETON. SQ1344.2 +016500 05 FILLER PICTURE X(48) VALUE SQ1344.2 +016600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1344.2 +016700 05 FILLER PICTURE X(46) VALUE SQ1344.2 +016800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1344.2 +016900 05 FILLER PICTURE X(26) VALUE SQ1344.2 +017000 ",LFIL=000000,ORG= ,LBLR= ". SQ1344.2 +017100 05 FILLER PICTURE X(37) VALUE SQ1344.2 +017200 ",RECKEY= ". SQ1344.2 +017300 05 FILLER PICTURE X(38) VALUE SQ1344.2 +017400 ",ALTKEY1= ". SQ1344.2 +017500 05 FILLER PICTURE X(38) VALUE SQ1344.2 +017600 ",ALTKEY2= ". SQ1344.2 +017700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1344.2 +017800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1344.2 +017900 05 FILE-RECORD-INFO-P1-120. SQ1344.2 +018000 07 FILLER PIC X(5). SQ1344.2 +018100 07 XFILE-NAME PIC X(6). SQ1344.2 +018200 07 FILLER PIC X(8). SQ1344.2 +018300 07 XRECORD-NAME PIC X(6). SQ1344.2 +018400 07 FILLER PIC X(1). SQ1344.2 +018500 07 REELUNIT-NUMBER PIC 9(1). SQ1344.2 +018600 07 FILLER PIC X(7). SQ1344.2 +018700 07 XRECORD-NUMBER PIC 9(6). SQ1344.2 +018800 07 FILLER PIC X(6). SQ1344.2 +018900 07 UPDATE-NUMBER PIC 9(2). SQ1344.2 +019000 07 FILLER PIC X(5). SQ1344.2 +019100 07 ODO-NUMBER PIC 9(4). SQ1344.2 +019200 07 FILLER PIC X(5). SQ1344.2 +019300 07 XPROGRAM-NAME PIC X(5). SQ1344.2 +019400 07 FILLER PIC X(7). SQ1344.2 +019500 07 XRECORD-LENGTH PIC 9(6). SQ1344.2 +019600 07 FILLER PIC X(7). SQ1344.2 +019700 07 CHARS-OR-RECORDS PIC X(2). SQ1344.2 +019800 07 FILLER PIC X(1). SQ1344.2 +019900 07 XBLOCK-SIZE PIC 9(4). SQ1344.2 +020000 07 FILLER PIC X(6). SQ1344.2 +020100 07 RECORDS-IN-FILE PIC 9(6). SQ1344.2 +020200 07 FILLER PIC X(5). SQ1344.2 +020300 07 XFILE-ORGANIZATION PIC X(2). SQ1344.2 +020400 07 FILLER PIC X(6). SQ1344.2 +020500 07 XLABEL-TYPE PIC X(1). SQ1344.2 +020600 05 FILE-RECORD-INFO-P121-240. SQ1344.2 +020700 07 FILLER PIC X(8). SQ1344.2 +020800 07 XRECORD-KEY PIC X(29). SQ1344.2 +020900 07 FILLER PIC X(9). SQ1344.2 +021000 07 ALTERNATE-KEY1 PIC X(29). SQ1344.2 +021100 07 FILLER PIC X(9). SQ1344.2 +021200 07 ALTERNATE-KEY2 PIC X(29). SQ1344.2 +021300 07 FILLER PIC X(7). SQ1344.2 +021400* SQ1344.2 +021500 01 TEST-RESULTS. SQ1344.2 +021600 02 FILLER PIC X VALUE SPACE. SQ1344.2 +021700 02 PAR-NAME. SQ1344.2 +021800 03 FILLER PIC X(14) VALUE SPACE. SQ1344.2 +021900 03 PARDOT-X PIC X VALUE SPACE. SQ1344.2 +022000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1344.2 +022100 02 FILLER PIC X VALUE SPACE. SQ1344.2 +022200 02 FEATURE PIC X(24) VALUE SPACE. SQ1344.2 +022300 02 FILLER PIC X VALUE SPACE. SQ1344.2 +022400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1344.2 +022500 02 FILLER PIC X(9) VALUE SPACE. SQ1344.2 +022600 02 RE-MARK PIC X(61). SQ1344.2 +022700 01 TEST-COMPUTED. SQ1344.2 +022800 02 FILLER PIC X(30) VALUE SPACE. SQ1344.2 +022900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1344.2 +023000 02 COMPUTED-X. SQ1344.2 +023100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1344.2 +023200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1344.2 +023300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1344.2 +023400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1344.2 +023500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1344.2 +023600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1344.2 +023700 04 COMPUTED-18V0 PIC -9(18). SQ1344.2 +023800 04 FILLER PIC X. SQ1344.2 +023900 03 FILLER PIC X(50) VALUE SPACE. SQ1344.2 +024000 01 TEST-CORRECT. SQ1344.2 +024100 02 FILLER PIC X(30) VALUE SPACE. SQ1344.2 +024200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1344.2 +024300 02 CORRECT-X. SQ1344.2 +024400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1344.2 +024500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1344.2 +024600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1344.2 +024700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1344.2 +024800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1344.2 +024900 03 CR-18V0 REDEFINES CORRECT-A. SQ1344.2 +025000 04 CORRECT-18V0 PIC -9(18). SQ1344.2 +025100 04 FILLER PIC X. SQ1344.2 +025200 03 FILLER PIC X(2) VALUE SPACE. SQ1344.2 +025300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1344.2 +025400* SQ1344.2 +025500 01 CCVS-C-1. SQ1344.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +025700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1344.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +025900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1344.2 +026000 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +026100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1344.2 +026200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1344.2 +026300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1344.2 +026400 01 CCVS-C-2. SQ1344.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ1344.2 +026600 02 FILLER PIC X(6) VALUE "TESTED". SQ1344.2 +026700 02 FILLER PIC X(19) VALUE SPACE. SQ1344.2 +026800 02 FILLER PIC X(4) VALUE "FAIL". SQ1344.2 +026900 02 FILLER PIC X(72) VALUE SPACE. SQ1344.2 +027000* SQ1344.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1344.2 +027200 01 REC-CT PIC 99 VALUE ZERO. SQ1344.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1344.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1344.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1344.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1344.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1344.2 +028200 01 CCVS-H-1. SQ1344.2 +028300 02 FILLER PIC X(39) VALUE SPACES. SQ1344.2 +028400 02 FILLER PIC X(42) VALUE SQ1344.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1344.2 +028600 02 FILLER PIC X(39) VALUE SPACES. SQ1344.2 +028700 01 CCVS-H-2A. SQ1344.2 +028800 02 FILLER PIC X(40) VALUE SPACE. SQ1344.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1344.2 +029000 02 FILLER PIC XXXX VALUE SQ1344.2 +029100 "4.2 ". SQ1344.2 +029200 02 FILLER PIC X(28) VALUE SQ1344.2 +029300 " COPY - NOT FOR DISTRIBUTION". SQ1344.2 +029400 02 FILLER PIC X(41) VALUE SPACE. SQ1344.2 +029500* SQ1344.2 +029600 01 CCVS-H-2B. SQ1344.2 +029700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1344.2 +029800 02 TEST-ID PIC X(9). SQ1344.2 +029900 02 FILLER PIC X(4) VALUE " IN ". SQ1344.2 +030000 02 FILLER PIC X(12) VALUE SQ1344.2 +030100 " HIGH ". SQ1344.2 +030200 02 FILLER PIC X(22) VALUE SQ1344.2 +030300 " LEVEL VALIDATION FOR ". SQ1344.2 +030400 02 FILLER PIC X(58) VALUE SQ1344.2 +030500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +030600 01 CCVS-H-3. SQ1344.2 +030700 02 FILLER PIC X(34) VALUE SQ1344.2 +030800 " FOR OFFICIAL USE ONLY ". SQ1344.2 +030900 02 FILLER PIC X(58) VALUE SQ1344.2 +031000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1344.2 +031100 02 FILLER PIC X(28) VALUE SQ1344.2 +031200 " COPYRIGHT 1985,1986 ". SQ1344.2 +031300 01 CCVS-E-1. SQ1344.2 +031400 02 FILLER PIC X(52) VALUE SPACE. SQ1344.2 +031500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1344.2 +031600 02 ID-AGAIN PIC X(9). SQ1344.2 +031700 02 FILLER PIC X(45) VALUE SPACES. SQ1344.2 +031800 01 CCVS-E-2. SQ1344.2 +031900 02 FILLER PIC X(31) VALUE SPACE. SQ1344.2 +032000 02 FILLER PIC X(21) VALUE SPACE. SQ1344.2 +032100 02 CCVS-E-2-2. SQ1344.2 +032200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1344.2 +032300 03 FILLER PIC X VALUE SPACE. SQ1344.2 +032400 03 ENDER-DESC PIC X(44) VALUE SQ1344.2 +032500 "ERRORS ENCOUNTERED". SQ1344.2 +032600 01 CCVS-E-3. SQ1344.2 +032700 02 FILLER PIC X(22) VALUE SQ1344.2 +032800 " FOR OFFICIAL USE ONLY". SQ1344.2 +032900 02 FILLER PIC X(12) VALUE SPACE. SQ1344.2 +033000 02 FILLER PIC X(58) VALUE SQ1344.2 +033100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +033200 02 FILLER PIC X(8) VALUE SPACE. SQ1344.2 +033300 02 FILLER PIC X(20) VALUE SQ1344.2 +033400 " COPYRIGHT 1985,1986". SQ1344.2 +033500 01 CCVS-E-4. SQ1344.2 +033600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1344.2 +033700 02 FILLER PIC X(4) VALUE " OF ". SQ1344.2 +033800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1344.2 +033900 02 FILLER PIC X(40) VALUE SQ1344.2 +034000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1344.2 +034100 01 XXINFO. SQ1344.2 +034200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1344.2 +034300 02 INFO-TEXT. SQ1344.2 +034400 04 FILLER PIC X(8) VALUE SPACE. SQ1344.2 +034500 04 XXCOMPUTED PIC X(20). SQ1344.2 +034600 04 FILLER PIC X(5) VALUE SPACE. SQ1344.2 +034700 04 XXCORRECT PIC X(20). SQ1344.2 +034800 02 INF-ANSI-REFERENCE PIC X(48). SQ1344.2 +034900 01 HYPHEN-LINE. SQ1344.2 +035000 02 FILLER PIC IS X VALUE IS SPACE. SQ1344.2 +035100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1344.2 +035200- "*****************************************". SQ1344.2 +035300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1344.2 +035400- "******************************". SQ1344.2 +035500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1344.2 +035600 "SQ134A". SQ1344.2 +035700* SQ1344.2 +035800* SQ1344.2 +035900 PROCEDURE DIVISION. SQ1344.2 +036000 DECLARATIVES. SQ1344.2 +036100* SQ1344.2 +036200 SECT-SQ134A-0001 SECTION. SQ1344.2 +036300 USE AFTER EXCEPTION PROCEDURE I-O. SQ1344.2 +036400 I-O-ERROR-PROCESS. SQ1344.2 +036500 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +036600 IF DECL-EXEC-SW NOT = SPACE SQ1344.2 +036700 GO TO END-DECLS. SQ1344.2 +036800* SQ1344.2 +036900 MOVE 1 TO REC-CT. SQ1344.2 +037000 MOVE "REWRITE SHORTER RECORD" TO FEATURE. SQ1344.2 +037100 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1344.2 +037200 GO TO DCL-REWRITE-01-01. SQ1344.2 +037300 DECL-DELETE-01-01. SQ1344.2 +037400 PERFORM DECL-DE-LETE. SQ1344.2 +037500 GO TO DECL-TEST-01-01-END. SQ1344.2 +037600 DCL-REWRITE-01-01. SQ1344.2 +037700 IF SQ-FS4-STATUS = "44" SQ1344.2 +037800 PERFORM DECL-PASS SQ1344.2 +037900 ELSE SQ1344.2 +038000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +038100 MOVE "44" TO CORRECT-A SQ1344.2 +038200 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ1344.2 +038300 TO RE-MARK SQ1344.2 +038400 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ1344.2 +038500 PERFORM DECL-FAIL. SQ1344.2 +038600 DECL-TEST-01-01-END. SQ1344.2 +038700* SQ1344.2 +038800 ADD 1 TO REC-CT. SQ1344.2 +038900 GO TO DCL-REWRITE-01-02. SQ1344.2 +039000 DECL-DELETE-01-02. SQ1344.2 +039100 PERFORM DECL-DE-LETE. SQ1344.2 +039200 GO TO DECL-TEST-01-02-END. SQ1344.2 +039300 DCL-REWRITE-01-02. SQ1344.2 +039400 IF SQ-FS4R1-F-G-120 = FILE-RECORD-INFO-P1-120 (1) SQ1344.2 +039500 PERFORM DECL-PASS SQ1344.2 +039600 ELSE SQ1344.2 +039700 MOVE "FIRST 120 CHARACTERS OF RECORD AREA CHANGED" SQ1344.2 +039800 TO RE-MARK SQ1344.2 +039900 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ1344.2 +040000 PERFORM DECL-FAIL. SQ1344.2 +040100 DECL-TEST-01-02-END. SQ1344.2 +040200* SQ1344.2 +040300 ADD 1 TO REC-CT. SQ1344.2 +040400 GO TO DCL-REWRITE-01-03. SQ1344.2 +040500 DECL-DELETE-01-03. SQ1344.2 +040600 PERFORM DECL-DE-LETE. SQ1344.2 +040700 GO TO DECL-TEST-01-03-END. SQ1344.2 +040800 DCL-REWRITE-01-03. SQ1344.2 +040900 IF EXT-18 = "ABCDEFGHIJKLMNOPQR" SQ1344.2 +041000 PERFORM DECL-PASS SQ1344.2 +041100 ELSE SQ1344.2 +041200 MOVE EXT-18 TO COMPUTED-A SQ1344.2 +041300 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A SQ1344.2 +041400 MOVE "LAST 18 CHARACTERS OF RECORD CHANGED" SQ1344.2 +041500 TO RE-MARK SQ1344.2 +041600 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ1344.2 +041700 PERFORM DECL-FAIL. SQ1344.2 +041800 DECL-TEST-01-03-END. SQ1344.2 +041900* SQ1344.2 +042000 PERFORM DECL-WRITE-LINE. SQ1344.2 +042100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1344.2 +042200 TO DUMMY-RECORD. SQ1344.2 +042300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1344.2 +042400 GO TO END-DECLS. SQ1344.2 +042500* SQ1344.2 +042600* SQ1344.2 +042700 DECL-PASS. SQ1344.2 +042800 MOVE "PASS " TO P-OR-F. SQ1344.2 +042900 ADD 1 TO PASS-COUNTER. SQ1344.2 +043000 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +043100* SQ1344.2 +043200 DECL-FAIL. SQ1344.2 +043300 MOVE "FAIL*" TO P-OR-F. SQ1344.2 +043400 ADD 1 TO ERROR-COUNTER. SQ1344.2 +043500 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +043600* SQ1344.2 +043700 DECL-DE-LETE. SQ1344.2 +043800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1344.2 +043900 MOVE "*****" TO P-OR-F. SQ1344.2 +044000 ADD 1 TO DELETE-COUNTER. SQ1344.2 +044100 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +044200* SQ1344.2 +044300 DECL-PRINT-DETAIL. SQ1344.2 +044400 IF REC-CT NOT EQUAL TO ZERO SQ1344.2 +044500 MOVE "." TO PARDOT-X SQ1344.2 +044600 MOVE REC-CT TO DOTVALUE. SQ1344.2 +044700 MOVE TEST-RESULTS TO PRINT-REC. SQ1344.2 +044800 PERFORM DECL-WRITE-LINE. SQ1344.2 +044900 IF P-OR-F EQUAL TO "FAIL*" SQ1344.2 +045000 PERFORM DECL-WRITE-LINE SQ1344.2 +045100 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1344.2 +045200 ELSE SQ1344.2 +045300 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1344.2 +045400 MOVE SPACE TO P-OR-F. SQ1344.2 +045500 MOVE SPACE TO COMPUTED-X. SQ1344.2 +045600 MOVE SPACE TO CORRECT-X. SQ1344.2 +045700 IF REC-CT EQUAL TO ZERO SQ1344.2 +045800 MOVE SPACE TO PAR-NAME. SQ1344.2 +045900 MOVE SPACE TO RE-MARK. SQ1344.2 +046000* SQ1344.2 +046100 DECL-WRITE-LINE. SQ1344.2 +046200 ADD 1 TO RECORD-COUNT. SQ1344.2 +046300Y IF RECORD-COUNT GREATER 50 SQ1344.2 +046400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1344.2 +046500Y MOVE SPACE TO DUMMY-RECORD SQ1344.2 +046600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1344.2 +046700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1344.2 +046800Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1344.2 +046900Y PERFORM DECL-WRT-LN 2 TIMES SQ1344.2 +047000Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1344.2 +047100Y PERFORM DECL-WRT-LN SQ1344.2 +047200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1344.2 +047300Y MOVE ZERO TO RECORD-COUNT. SQ1344.2 +047400 PERFORM DECL-WRT-LN. SQ1344.2 +047500* SQ1344.2 +047600 DECL-WRT-LN. SQ1344.2 +047700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1344.2 +047800 MOVE SPACE TO DUMMY-RECORD. SQ1344.2 +047900* SQ1344.2 +048000 DECL-FAIL-ROUTINE. SQ1344.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1344.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1344.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1344.2 +048500 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +048600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +048800 GO TO DECL-FAIL-EX. SQ1344.2 +048900 DECL-FAIL-WRITE. SQ1344.2 +049000 MOVE TEST-COMPUTED TO PRINT-REC SQ1344.2 +049100 PERFORM DECL-WRITE-LINE SQ1344.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1344.2 +049300 MOVE TEST-CORRECT TO PRINT-REC SQ1344.2 +049400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +049500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1344.2 +049600 DECL-FAIL-EX. SQ1344.2 +049700 EXIT. SQ1344.2 +049800* SQ1344.2 +049900 DECL-BAIL. SQ1344.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1344.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1344.2 +050200 DECL-BAIL-WRITE. SQ1344.2 +050300 MOVE CORRECT-A TO XXCORRECT. SQ1344.2 +050400 MOVE COMPUTED-A TO XXCOMPUTED. SQ1344.2 +050500 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +050600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +050700 DECL-BAIL-EX. SQ1344.2 +050800 EXIT. SQ1344.2 +050900* SQ1344.2 +051000 END-DECLS. SQ1344.2 +051100 END DECLARATIVES. SQ1344.2 +051200* SQ1344.2 +051300* SQ1344.2 +051400 CCVS1 SECTION. SQ1344.2 +051500 OPEN-FILES. SQ1344.2 +051600P OPEN I-O RAW-DATA. SQ1344.2 +051700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1344.2 +051800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1344.2 +051900P MOVE "ABORTED " TO C-ABORT. SQ1344.2 +052000P ADD 1 TO C-NO-OF-TESTS. SQ1344.2 +052100P ACCEPT C-DATE FROM DATE. SQ1344.2 +052200P ACCEPT C-TIME FROM TIME. SQ1344.2 +052300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1344.2 +052400PEND-E-1. SQ1344.2 +052500P CLOSE RAW-DATA. SQ1344.2 +052600 OPEN OUTPUT PRINT-FILE. SQ1344.2 +052700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1344.2 +052800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1344.2 +052900 MOVE SPACE TO TEST-RESULTS. SQ1344.2 +053000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1344.2 +053100 MOVE ZERO TO REC-SKEL-SUB. SQ1344.2 +053200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1344.2 +053300 GO TO CCVS1-EXIT. SQ1344.2 +053400* SQ1344.2 +053500 CCVS-INIT-FILE. SQ1344.2 +053600 ADD 1 TO REC-SKL-SUB. SQ1344.2 +053700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1344.2 +053800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1344.2 +053900* SQ1344.2 +054000 CLOSE-FILES. SQ1344.2 +054100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1344.2 +054200 CLOSE PRINT-FILE. SQ1344.2 +054300P OPEN I-O RAW-DATA. SQ1344.2 +054400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1344.2 +054500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1344.2 +054600P MOVE "OK. " TO C-ABORT. SQ1344.2 +054700P MOVE PASS-COUNTER TO C-OK. SQ1344.2 +054800P MOVE ERROR-HOLD TO C-ALL. SQ1344.2 +054900P MOVE ERROR-COUNTER TO C-FAIL. SQ1344.2 +055000P MOVE DELETE-CNT TO C-DELETED. SQ1344.2 +055100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1344.2 +055200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1344.2 +055300PEND-E-2. SQ1344.2 +055400P CLOSE RAW-DATA. SQ1344.2 +055500 TERMINATE-CCVS. SQ1344.2 +055600S EXIT PROGRAM. SQ1344.2 +055700 STOP RUN. SQ1344.2 +055800* SQ1344.2 +055900 INSPT. SQ1344.2 +056000 MOVE "INSPT" TO P-OR-F. SQ1344.2 +056100 ADD 1 TO INSPECT-COUNTER. SQ1344.2 +056200 PERFORM PRINT-DETAIL. SQ1344.2 +056300* SQ1344.2 +056400 PASS. SQ1344.2 +056500 MOVE "PASS " TO P-OR-F. SQ1344.2 +056600 ADD 1 TO PASS-COUNTER. SQ1344.2 +056700 PERFORM PRINT-DETAIL. SQ1344.2 +056800* SQ1344.2 +056900 FAIL. SQ1344.2 +057000 MOVE "FAIL*" TO P-OR-F. SQ1344.2 +057100 ADD 1 TO ERROR-COUNTER. SQ1344.2 +057200 PERFORM PRINT-DETAIL. SQ1344.2 +057300* SQ1344.2 +057400 DE-LETE. SQ1344.2 +057500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1344.2 +057600 MOVE "*****" TO P-OR-F. SQ1344.2 +057700 ADD 1 TO DELETE-COUNTER. SQ1344.2 +057800 PERFORM PRINT-DETAIL. SQ1344.2 +057900* SQ1344.2 +058000 PRINT-DETAIL. SQ1344.2 +058100 IF REC-CT NOT EQUAL TO ZERO SQ1344.2 +058200 MOVE "." TO PARDOT-X SQ1344.2 +058300 MOVE REC-CT TO DOTVALUE. SQ1344.2 +058400 MOVE TEST-RESULTS TO PRINT-REC. SQ1344.2 +058500 PERFORM WRITE-LINE. SQ1344.2 +058600 IF P-OR-F EQUAL TO "FAIL*" SQ1344.2 +058700 PERFORM WRITE-LINE SQ1344.2 +058800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1344.2 +058900 ELSE SQ1344.2 +059000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1344.2 +059100 MOVE SPACE TO P-OR-F. SQ1344.2 +059200 MOVE SPACE TO COMPUTED-X. SQ1344.2 +059300 MOVE SPACE TO CORRECT-X. SQ1344.2 +059400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1344.2 +059500 MOVE SPACE TO RE-MARK. SQ1344.2 +059600* SQ1344.2 +059700 HEAD-ROUTINE. SQ1344.2 +059800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +059900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +060000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1344.2 +060100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1344.2 +060200 COLUMN-NAMES-ROUTINE. SQ1344.2 +060300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +060400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +060600 END-ROUTINE. SQ1344.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1344.2 +060800 PERFORM WRITE-LINE 5 TIMES. SQ1344.2 +060900 END-RTN-EXIT. SQ1344.2 +061000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1344.2 +061100 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +061200* SQ1344.2 +061300 END-ROUTINE-1. SQ1344.2 +061400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1344.2 +061500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1344.2 +061600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1344.2 +061700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1344.2 +061800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1344.2 +061900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1344.2 +062000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1344.2 +062100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1344.2 +062200 PERFORM WRITE-LINE. SQ1344.2 +062300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1344.2 +062400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1344.2 +062500 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +062600 ELSE SQ1344.2 +062700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1344.2 +062800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1344.2 +062900 PERFORM WRITE-LINE. SQ1344.2 +063000 END-ROUTINE-13. SQ1344.2 +063100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1344.2 +063200 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +063300 ELSE SQ1344.2 +063400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1344.2 +063500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1344.2 +063600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1344.2 +063700 PERFORM WRITE-LINE. SQ1344.2 +063800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1344.2 +063900 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +064000 ELSE SQ1344.2 +064100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1344.2 +064200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1344.2 +064300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +064400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +064500* SQ1344.2 +064600 WRITE-LINE. SQ1344.2 +064700 ADD 1 TO RECORD-COUNT. SQ1344.2 +064800Y IF RECORD-COUNT GREATER 50 SQ1344.2 +064900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1344.2 +065000Y MOVE SPACE TO DUMMY-RECORD SQ1344.2 +065100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1344.2 +065200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1344.2 +065300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1344.2 +065400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1344.2 +065500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1344.2 +065600Y MOVE ZERO TO RECORD-COUNT. SQ1344.2 +065700 PERFORM WRT-LN. SQ1344.2 +065800* SQ1344.2 +065900 WRT-LN. SQ1344.2 +066000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1344.2 +066100 MOVE SPACE TO DUMMY-RECORD. SQ1344.2 +066200 BLANK-LINE-PRINT. SQ1344.2 +066300 PERFORM WRT-LN. SQ1344.2 +066400 FAIL-ROUTINE. SQ1344.2 +066500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1344.2 +066600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1344.2 +066700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +066800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1344.2 +066900 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +067000 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +067100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +067200 GO TO FAIL-ROUTINE-EX. SQ1344.2 +067300 FAIL-ROUTINE-WRITE. SQ1344.2 +067400 MOVE TEST-COMPUTED TO PRINT-REC SQ1344.2 +067500 PERFORM WRITE-LINE SQ1344.2 +067600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1344.2 +067700 MOVE TEST-CORRECT TO PRINT-REC SQ1344.2 +067800 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +067900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1344.2 +068000 FAIL-ROUTINE-EX. SQ1344.2 +068100 EXIT. SQ1344.2 +068200 BAIL-OUT. SQ1344.2 +068300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1344.2 +068400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1344.2 +068500 BAIL-OUT-WRITE. SQ1344.2 +068600 MOVE CORRECT-A TO XXCORRECT. SQ1344.2 +068700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1344.2 +068800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +068900 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +069000 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +069100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +069200 BAIL-OUT-EX. SQ1344.2 +069300 EXIT. SQ1344.2 +069400 CCVS1-EXIT. SQ1344.2 +069500 EXIT. SQ1344.2 +069600* SQ1344.2 +069700**************************************************************** SQ1344.2 +069800* * SQ1344.2 +069900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1344.2 +070000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1344.2 +070100* * SQ1344.2 +070200**************************************************************** SQ1344.2 +070300* SQ1344.2 +070400 SECT-SQ134A-0002 SECTION. SQ1344.2 +070500 STA-INIT. SQ1344.2 +070600 MOVE SPACE TO DELETE-SW. SQ1344.2 +070700* SQ1344.2 +070800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1344.2 +070900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1344.2 +071000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1344.2 +071100 MOVE 120 TO XRECORD-LENGTH (1). SQ1344.2 +071200 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1344.2 +071300 MOVE 1 TO XBLOCK-SIZE (1). SQ1344.2 +071400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1344.2 +071500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1344.2 +071600 MOVE "S" TO XLABEL-TYPE (1). SQ1344.2 +071700* SQ1344.2 +071800* OPEN THE FILE IN THE OUTPUT MODE SQ1344.2 +071900* SQ1344.2 +072000 SEQ-INIT-01. SQ1344.2 +072100 MOVE 0 TO REC-CT. SQ1344.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +072500 MOVE ZERO TO XRECORD-NUMBER (1). SQ1344.2 +072600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1344.2 +072700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1344.2 +072800 GO TO SEQ-TEST-OP-01. SQ1344.2 +072900 SEQ-DELETE-01. SQ1344.2 +073000 MOVE "*" TO DELETE-SW-1. SQ1344.2 +073100 GO TO SEQ-DELETE-01-01. SQ1344.2 +073200 SEQ-TEST-OP-01. SQ1344.2 +073300 OPEN OUTPUT SQ-FS4. SQ1344.2 +073400* SQ1344.2 +073500* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1344.2 +073600* SQ1344.2 +073700 ADD 1 TO REC-CT. SQ1344.2 +073800 IF DELETE-SW NOT = SPACE SQ1344.2 +073900 GO TO SEQ-DELETE-01-01. SQ1344.2 +074000 GO TO SEQ-TEST-OP-01-01. SQ1344.2 +074100 SEQ-DELETE-01-01. SQ1344.2 +074200 PERFORM DE-LETE. SQ1344.2 +074300 GO TO SEQ-TEST-01-01-END. SQ1344.2 +074400 SEQ-TEST-OP-01-01. SQ1344.2 +074500 IF SQ-FS4-STATUS = "00" SQ1344.2 +074600 PERFORM PASS SQ1344.2 +074700 ELSE SQ1344.2 +074800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +074900 MOVE "00" TO CORRECT-A SQ1344.2 +075000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1344.2 +075100 TO RE-MARK SQ1344.2 +075200 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1344.2 +075300 PERFORM FAIL. SQ1344.2 +075400 SEQ-TEST-01-01-END. SQ1344.2 +075500* SQ1344.2 +075600* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +075700* SQ1344.2 +075800 ADD 1 TO REC-CT. SQ1344.2 +075900 IF DELETE-SW NOT = SPACE SQ1344.2 +076000 GO TO SEQ-DELETE-01-02. SQ1344.2 +076100 GO TO SEQ-TEST-OP-01-02. SQ1344.2 +076200 SEQ-DELETE-01-02. SQ1344.2 +076300 PERFORM DE-LETE. SQ1344.2 +076400 GO TO SEQ-TEST-01-02-END. SQ1344.2 +076500 SEQ-TEST-OP-01-02. SQ1344.2 +076600 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +076700 PERFORM PASS SQ1344.2 +076800 ELSE SQ1344.2 +076900 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +077000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +077100 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +077200 TO RE-MARK SQ1344.2 +077300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +077400 PERFORM FAIL. SQ1344.2 +077500 SEQ-TEST-01-02-END. SQ1344.2 +077600* SQ1344.2 +077700* SQ1344.2 +077800* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD OF 138 CHARS. SQ1344.2 +077900* SQ1344.2 +078000 SEQ-INIT-02. SQ1344.2 +078100 MOVE 0 TO REC-CT. SQ1344.2 +078200 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +078300 ADD 1 TO XRECORD-NUMBER (1). SQ1344.2 +078400 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +078500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +078600 MOVE "WRITE A RECORD" TO FEATURE. SQ1344.2 +078700 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1344.2 +078800 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +078900 GO TO SEQ-DELETE-02. SQ1344.2 +079000 GO TO SEQ-TEST-WR-02. SQ1344.2 +079100 SEQ-DELETE-02. SQ1344.2 +079200 MOVE "*" TO DELETE-SW-2. SQ1344.2 +079300 GO TO SEQ-DELETE-02-01. SQ1344.2 +079400 SEQ-TEST-WR-02. SQ1344.2 +079500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1344.2 +079600 MOVE "987654321123456789" TO EXT-18. SQ1344.2 +079700 WRITE SQ-FS4R2-F-G-138. SQ1344.2 +079800* SQ1344.2 +079900* CHECK I-O STATUS RETURNED FROM WRITE SQ1344.2 +080000* SQ1344.2 +080100 ADD 1 TO REC-CT. SQ1344.2 +080200 IF DELETE-SW NOT = SPACE SQ1344.2 +080300 GO TO SEQ-DELETE-02-01. SQ1344.2 +080400 GO TO SEQ-TEST-WR-02-01. SQ1344.2 +080500 SEQ-DELETE-02-01. SQ1344.2 +080600 PERFORM DE-LETE. SQ1344.2 +080700 GO TO SEQ-TEST-02-01-END. SQ1344.2 +080800 SEQ-TEST-WR-02-01. SQ1344.2 +080900 IF SQ-FS4-STATUS = "00" SQ1344.2 +081000 PERFORM PASS SQ1344.2 +081100 ELSE SQ1344.2 +081200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +081300 MOVE "00" TO CORRECT-A SQ1344.2 +081400 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1344.2 +081500 TO RE-MARK SQ1344.2 +081600 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ1344.2 +081700 PERFORM FAIL. SQ1344.2 +081800 SEQ-TEST-02-01-END. SQ1344.2 +081900* SQ1344.2 +082000* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +082100* SQ1344.2 +082200 ADD 1 TO REC-CT. SQ1344.2 +082300 IF DELETE-SW NOT = SPACE SQ1344.2 +082400 GO TO SEQ-DELETE-02-02. SQ1344.2 +082500 GO TO SEQ-TEST-WR-02-02. SQ1344.2 +082600 SEQ-DELETE-02-02. SQ1344.2 +082700 PERFORM DE-LETE. SQ1344.2 +082800 GO TO SEQ-TEST-02-02-END. SQ1344.2 +082900 SEQ-TEST-WR-02-02. SQ1344.2 +083000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +083100 PERFORM PASS SQ1344.2 +083200 ELSE SQ1344.2 +083300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +083400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +083500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +083600 TO RE-MARK SQ1344.2 +083700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +083800 PERFORM FAIL. SQ1344.2 +083900 SEQ-TEST-02-02-END. SQ1344.2 +084000* SQ1344.2 +084100* SQ1344.2 +084200* NOW CLOSE THE FILE. SQ1344.2 +084300* SQ1344.2 +084400 SEQ-INIT-03. SQ1344.2 +084500 MOVE 0 TO REC-CT. SQ1344.2 +084600 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +084700 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +084800 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +084900 MOVE "CLOSE FILE" TO FEATURE. SQ1344.2 +085000 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1344.2 +085100 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +085200 GO TO SEQ-DELETE-03. SQ1344.2 +085300 GO TO SEQ-TEST-CL-03. SQ1344.2 +085400 SEQ-DELETE-03. SQ1344.2 +085500 MOVE "*" TO DELETE-SW-2. SQ1344.2 +085600 GO TO SEQ-DELETE-03-01. SQ1344.2 +085700 SEQ-TEST-CL-03. SQ1344.2 +085800 CLOSE SQ-FS4. SQ1344.2 +085900* SQ1344.2 +086000* CHECK I-O STATUS RETURNED FROM CLOSE SQ1344.2 +086100* SQ1344.2 +086200 ADD 1 TO REC-CT. SQ1344.2 +086300 IF DELETE-SW NOT = SPACE SQ1344.2 +086400 GO TO SEQ-DELETE-03-01. SQ1344.2 +086500 GO TO SEQ-TEST-CL-03-01. SQ1344.2 +086600 SEQ-DELETE-03-01. SQ1344.2 +086700 PERFORM DE-LETE. SQ1344.2 +086800 GO TO SEQ-TEST-03-01-END. SQ1344.2 +086900 SEQ-TEST-CL-03-01. SQ1344.2 +087000 IF SQ-FS4-STATUS = "00" SQ1344.2 +087100 PERFORM PASS SQ1344.2 +087200 ELSE SQ1344.2 +087300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +087400 MOVE "00" TO CORRECT-A SQ1344.2 +087500 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1344.2 +087600 TO RE-MARK SQ1344.2 +087700 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1344.2 +087800 PERFORM FAIL. SQ1344.2 +087900 SEQ-TEST-03-01-END. SQ1344.2 +088000* SQ1344.2 +088100* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +088200* SQ1344.2 +088300 ADD 1 TO REC-CT. SQ1344.2 +088400 IF DELETE-SW NOT = SPACE SQ1344.2 +088500 GO TO SEQ-DELETE-03-02. SQ1344.2 +088600 GO TO SEQ-TEST-CL-03-02. SQ1344.2 +088700 SEQ-DELETE-03-02. SQ1344.2 +088800 PERFORM DE-LETE. SQ1344.2 +088900 GO TO SEQ-TEST-03-02-END. SQ1344.2 +089000 SEQ-TEST-CL-03-02. SQ1344.2 +089100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +089200 PERFORM PASS SQ1344.2 +089300 ELSE SQ1344.2 +089400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +089500 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +089600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +089700 TO RE-MARK SQ1344.2 +089800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +089900 PERFORM FAIL. SQ1344.2 +090000 SEQ-TEST-03-02-END. SQ1344.2 +090100 MOVE SPACE TO DELETE-SW-2. SQ1344.2 +090200* SQ1344.2 +090300* SQ1344.2 +090400* OPEN THE FILE IN THE I-O MODE SQ1344.2 +090500* SQ1344.2 +090600 SEQ-INIT-04. SQ1344.2 +090700 MOVE 0 TO REC-CT. SQ1344.2 +090800 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +090900 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +091000 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +091100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1344.2 +091200 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1344.2 +091300 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1344.2 +091400 IF DELETE-SW NOT = SPACE SQ1344.2 +091500 GO TO SEQ-DELETE-04-01. SQ1344.2 +091600 GO TO SEQ-TEST-OP-04. SQ1344.2 +091700 SEQ-DELETE-04. SQ1344.2 +091800 MOVE "*" TO DELETE-SW-2. SQ1344.2 +091900 GO TO SEQ-DELETE-04-01. SQ1344.2 +092000 SEQ-TEST-OP-04. SQ1344.2 +092100 OPEN I-O SQ-FS4. SQ1344.2 +092200* SQ1344.2 +092300* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ1344.2 +092400* SQ1344.2 +092500 ADD 1 TO REC-CT. SQ1344.2 +092600 IF DELETE-SW NOT = SPACE SQ1344.2 +092700 GO TO SEQ-DELETE-04-01. SQ1344.2 +092800 GO TO SEQ-TEST-OP-04-01. SQ1344.2 +092900 SEQ-DELETE-04-01. SQ1344.2 +093000 PERFORM DE-LETE. SQ1344.2 +093100 GO TO SEQ-TEST-04-01-END. SQ1344.2 +093200 SEQ-TEST-OP-04-01. SQ1344.2 +093300 IF SQ-FS4-STATUS = "00" SQ1344.2 +093400 PERFORM PASS SQ1344.2 +093500 ELSE SQ1344.2 +093600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +093700 MOVE "00" TO CORRECT-A SQ1344.2 +093800 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1344.2 +093900 TO RE-MARK SQ1344.2 +094000 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ1344.2 +094100 PERFORM FAIL. SQ1344.2 +094200 SEQ-TEST-04-01-END. SQ1344.2 +094300* SQ1344.2 +094400 ADD 1 TO REC-CT. SQ1344.2 +094500 IF DELETE-SW NOT = SPACE SQ1344.2 +094600 GO TO SEQ-DELETE-04-02. SQ1344.2 +094700 GO TO SEQ-TEST-OP-04-02. SQ1344.2 +094800 SEQ-DELETE-04-02. SQ1344.2 +094900 PERFORM DE-LETE. SQ1344.2 +095000 GO TO SEQ-TEST-04-02-END. SQ1344.2 +095100 SEQ-TEST-OP-04-02. SQ1344.2 +095200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +095300 PERFORM PASS SQ1344.2 +095400 ELSE SQ1344.2 +095500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +095600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +095700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE ON OPEN" SQ1344.2 +095800 TO RE-MARK SQ1344.2 +095900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +096000 PERFORM FAIL. SQ1344.2 +096100 SEQ-TEST-04-02-END. SQ1344.2 +096200* SQ1344.2 +096300* SQ1344.2 +096400* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ1344.2 +096500* SQ1344.2 +096600 SEQ-INIT-05. SQ1344.2 +096700 MOVE 0 TO REC-CT. SQ1344.2 +096800 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +096900 ADD 1 TO XRECORD-NUMBER (1). SQ1344.2 +097000 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ1344.2 +097100 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +097200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +097300 MOVE "READ FIRST RECORD" TO FEATURE. SQ1344.2 +097400 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1344.2 +097500 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +097600 GO TO SEQ-DELETE-05. SQ1344.2 +097700 GO TO SEQ-TEST-RD-05. SQ1344.2 +097800 SEQ-DELETE-05. SQ1344.2 +097900 MOVE "*" TO DELETE-SW-2. SQ1344.2 +098000 GO TO SEQ-DELETE-05-01. SQ1344.2 +098100 SEQ-TEST-RD-05. SQ1344.2 +098200 READ SQ-FS4. SQ1344.2 +098300* SQ1344.2 +098400* CHECK I-O STATUS RETURNED FROM READ SQ1344.2 +098500* SQ1344.2 +098600 ADD 1 TO REC-CT. SQ1344.2 +098700 IF DELETE-SW NOT = SPACE SQ1344.2 +098800 GO TO SEQ-DELETE-05-01. SQ1344.2 +098900 GO TO SEQ-TEST-RD-05-01. SQ1344.2 +099000 SEQ-DELETE-05-01. SQ1344.2 +099100 PERFORM DE-LETE. SQ1344.2 +099200 GO TO SEQ-TEST-05-01-END. SQ1344.2 +099300 SEQ-TEST-RD-05-01. SQ1344.2 +099400 IF SQ-FS4-STATUS = "00" SQ1344.2 +099500 PERFORM PASS SQ1344.2 +099600 ELSE SQ1344.2 +099700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +099800 MOVE "00" TO CORRECT-A SQ1344.2 +099900 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ1344.2 +100000 TO RE-MARK SQ1344.2 +100100 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1344.2 +100200 PERFORM FAIL. SQ1344.2 +100300 SEQ-TEST-05-01-END. SQ1344.2 +100400* SQ1344.2 +100500* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +100600* SQ1344.2 +100700 ADD 1 TO REC-CT. SQ1344.2 +100800 IF DELETE-SW NOT = SPACE SQ1344.2 +100900 GO TO SEQ-DELETE-05-02. SQ1344.2 +101000 GO TO SEQ-TEST-RD-05-02. SQ1344.2 +101100 SEQ-DELETE-05-02. SQ1344.2 +101200 PERFORM DE-LETE. SQ1344.2 +101300 GO TO SEQ-TEST-05-02-END. SQ1344.2 +101400 SEQ-TEST-RD-05-02. SQ1344.2 +101500 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +101600 PERFORM PASS SQ1344.2 +101700 ELSE SQ1344.2 +101800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +101900 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +102000 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +102100 TO RE-MARK SQ1344.2 +102200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +102300 PERFORM FAIL. SQ1344.2 +102400 SEQ-TEST-05-02-END. SQ1344.2 +102500* SQ1344.2 +102600* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ1344.2 +102700* CHECKING THE RECORD-NUMBER FIELD. SQ1344.2 +102800* SQ1344.2 +102900 ADD 1 TO REC-CT. SQ1344.2 +103000 IF DELETE-SW NOT = SPACE SQ1344.2 +103100 GO TO SEQ-DELETE-05-03. SQ1344.2 +103200 GO TO SEQ-TEST-RD-05-03. SQ1344.2 +103300 SEQ-DELETE-05-03. SQ1344.2 +103400 PERFORM DE-LETE. SQ1344.2 +103500 GO TO SEQ-TEST-05-03-END. SQ1344.2 +103600 SEQ-TEST-RD-05-03. SQ1344.2 +103700 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1344.2 +103800 PERFORM PASS SQ1344.2 +103900 ELSE SQ1344.2 +104000 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ1344.2 +104100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ1344.2 +104200 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1344.2 +104300 PERFORM FAIL. SQ1344.2 +104400 SEQ-TEST-05-03-END. SQ1344.2 +104500 MOVE SPACE TO DELETE-SW-2. SQ1344.2 +104600* SQ1344.2 +104700* FINALLY, TRY TO REWRITE A SMALLER RECORD SQ1344.2 +104800* SQ1344.2 +104900 SEQ-INIT-06. SQ1344.2 +105000 MOVE 0 TO REC-CT. SQ1344.2 +105100 MOVE SPACE TO DECL-EXEC-SW. SQ1344.2 +105200 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +105300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +105400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1344.2 +105500 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ1344.2 +105600 MOVE "REWRITE SMALLER RECORD" TO FEATURE. SQ1344.2 +105700 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ1344.2 +105800 IF DELETE-SW NOT = SPACE SQ1344.2 +105900 GO TO SEQ-DELETE-06-01. SQ1344.2 +106000 GO TO SEQ-TEST-RW-06. SQ1344.2 +106100 SEQ-DELETE-06. SQ1344.2 +106200 MOVE "*" TO DELETE-SW-2. SQ1344.2 +106300 GO TO SEQ-DELETE-06-01. SQ1344.2 +106400 SEQ-TEST-RW-06. SQ1344.2 +106500 REWRITE SQ-FS4R1-F-G-120. SQ1344.2 +106600 MOVE 0 TO REC-CT. SQ1344.2 +106700 MOVE "REWRITE SMALLER RECORD" TO FEATURE. SQ1344.2 +106800 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ1344.2 +106900* SQ1344.2 +107000* CHECK I-O STATUS RETURNED FROM REWRITE SQ1344.2 +107100* SQ1344.2 +107200 ADD 1 TO REC-CT. SQ1344.2 +107300 IF DELETE-SW NOT = SPACE SQ1344.2 +107400 GO TO SEQ-DELETE-06-01. SQ1344.2 +107500 GO TO SEQ-TEST-RW-06-01. SQ1344.2 +107600 SEQ-DELETE-06-01. SQ1344.2 +107700 PERFORM DE-LETE. SQ1344.2 +107800 SEQ-TEST-RW-06-01. SQ1344.2 +107900 IF SQ-FS4-STATUS = "44" SQ1344.2 +108000 PERFORM PASS SQ1344.2 +108100 ELSE SQ1344.2 +108200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +108300 MOVE "44" TO CORRECT-A SQ1344.2 +108400 MOVE "UNEXPECTED STATUS CODE FROM REWRITE SHORTER" SQ1344.2 +108500 TO RE-MARK SQ1344.2 +108600 MOVE "VII-4,1.5.3(4)D, VII-48" TO ANSI-REFERENCE SQ1344.2 +108700 PERFORM FAIL. SQ1344.2 +108800 CCVS-EXIT SECTION. SQ1344.2 +108900 CCVS-999999. SQ1344.2 +109000 GO TO CLOSE-FILES. SQ1344.2 +*END-OF,SQ134A +*HEADER,COBOL,SQ135A +000100 IDENTIFICATION DIVISION. SQ1354.2 +000200 PROGRAM-ID. SQ1354.2 +000300 SQ135A. SQ1354.2 +000400**************************************************************** SQ1354.2 +000500* * SQ1354.2 +000600* VALIDATION FOR:- * SQ1354.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +000800* USING CCVS85 VERSION 3.0. * SQ1354.2 +000900* * SQ1354.2 +001000* CREATION DATE / VALIDATION DATE * SQ1354.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1354.2 +001200* * SQ1354.2 +001300**************************************************************** SQ1354.2 +001400* * SQ1354.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1354.2 +001600* * SQ1354.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ1354.2 +001800* X-55 SYSTEM PRINTER * SQ1354.2 +001900* X-82 SOURCE-COMPUTER * SQ1354.2 +002000* X-83 OBJECT-COMPUTER. * SQ1354.2 +002100* X-84 LABEL RECORDS OPTION SQ1354.2 +002200* * SQ1354.2 +002300**************************************************************** SQ1354.2 +002400* * SQ1354.2 +002500* SPLIT FROM SQ215A, THE PROGRAM REPEATS THE SEQUENCE OF * SQ1354.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1354.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO CLOSE * SQ1354.2 +002800* AN ALREADY CLOSED FILE. I-O STATUS 42 IS EXPECTED AND * SQ1354.2 +002900* TESTED IN THE DECLARATIVES. * SQ1354.2 +003000**************************************************************** SQ1354.2 +003100* SQ1354.2 +003200 ENVIRONMENT DIVISION. SQ1354.2 +003300 CONFIGURATION SECTION. SQ1354.2 +003400 SOURCE-COMPUTER. SQ1354.2 +003500 XXXXX082. SQ1354.2 +003600 OBJECT-COMPUTER. SQ1354.2 +003700 XXXXX083. SQ1354.2 +003800* SQ1354.2 +003900 INPUT-OUTPUT SECTION. SQ1354.2 +004000 FILE-CONTROL. SQ1354.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1354.2 +004200 XXXXX055. SQ1354.2 +004300* SQ1354.2 +004400 SELECT SQ-FS1 ASSIGN TO SQ1354.2 +004500 XXXXX014 SQ1354.2 +004600 FILE STATUS IS SQ-FS1-STATUS. SQ1354.2 +004700* SQ1354.2 +004800* SQ1354.2 +004900 DATA DIVISION. SQ1354.2 +005000 FILE SECTION. SQ1354.2 +005100 FD PRINT-FILE SQ1354.2 +005200C LABEL RECORDS SQ1354.2 +005300C XXXXX084 SQ1354.2 +005400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1354.2 +005500 . SQ1354.2 +005600 01 PRINT-REC PICTURE X(120). SQ1354.2 +005700 01 DUMMY-RECORD PICTURE X(120). SQ1354.2 +005800* SQ1354.2 +005900 FD SQ-FS1 SQ1354.2 +006000C LABEL RECORD IS STANDARD SQ1354.2 +006100 . SQ1354.2 +006200 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1354.2 +006300* SQ1354.2 +006400 WORKING-STORAGE SECTION. SQ1354.2 +006500* SQ1354.2 +006600*************************************************************** SQ1354.2 +006700* * SQ1354.2 +006800* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1354.2 +006900* * SQ1354.2 +007000*************************************************************** SQ1354.2 +007100* SQ1354.2 +007200 01 SQ-FS1-STATUS. SQ1354.2 +007300 03 SQ-FS1-KEY-1 PIC X. SQ1354.2 +007400 03 SQ-FS1-KEY-2 PIC X. SQ1354.2 +007500* SQ1354.2 +007600*************************************************************** SQ1354.2 +007700* * SQ1354.2 +007800* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1354.2 +007900* * SQ1354.2 +008000*************************************************************** SQ1354.2 +008100* SQ1354.2 +008200 01 REC-SKEL-SUB PIC 99. SQ1354.2 +008300* SQ1354.2 +008400 01 FILE-RECORD-INFORMATION-REC. SQ1354.2 +008500 03 FILE-RECORD-INFO-SKELETON. SQ1354.2 +008600 05 FILLER PICTURE X(48) VALUE SQ1354.2 +008700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1354.2 +008800 05 FILLER PICTURE X(46) VALUE SQ1354.2 +008900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1354.2 +009000 05 FILLER PICTURE X(26) VALUE SQ1354.2 +009100 ",LFIL=000000,ORG= ,LBLR= ". SQ1354.2 +009200 05 FILLER PICTURE X(37) VALUE SQ1354.2 +009300 ",RECKEY= ". SQ1354.2 +009400 05 FILLER PICTURE X(38) VALUE SQ1354.2 +009500 ",ALTKEY1= ". SQ1354.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1354.2 +009700 ",ALTKEY2= ". SQ1354.2 +009800 05 FILLER PICTURE X(7) VALUE SPACE.SQ1354.2 +009900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1354.2 +010000 05 FILE-RECORD-INFO-P1-120. SQ1354.2 +010100 07 FILLER PIC X(5). SQ1354.2 +010200 07 XFILE-NAME PIC X(6). SQ1354.2 +010300 07 FILLER PIC X(8). SQ1354.2 +010400 07 XRECORD-NAME PIC X(6). SQ1354.2 +010500 07 FILLER PIC X(1). SQ1354.2 +010600 07 REELUNIT-NUMBER PIC 9(1). SQ1354.2 +010700 07 FILLER PIC X(7). SQ1354.2 +010800 07 XRECORD-NUMBER PIC 9(6). SQ1354.2 +010900 07 FILLER PIC X(6). SQ1354.2 +011000 07 UPDATE-NUMBER PIC 9(2). SQ1354.2 +011100 07 FILLER PIC X(5). SQ1354.2 +011200 07 ODO-NUMBER PIC 9(4). SQ1354.2 +011300 07 FILLER PIC X(5). SQ1354.2 +011400 07 XPROGRAM-NAME PIC X(5). SQ1354.2 +011500 07 FILLER PIC X(7). SQ1354.2 +011600 07 XRECORD-LENGTH PIC 9(6). SQ1354.2 +011700 07 FILLER PIC X(7). SQ1354.2 +011800 07 CHARS-OR-RECORDS PIC X(2). SQ1354.2 +011900 07 FILLER PIC X(1). SQ1354.2 +012000 07 XBLOCK-SIZE PIC 9(4). SQ1354.2 +012100 07 FILLER PIC X(6). SQ1354.2 +012200 07 RECORDS-IN-FILE PIC 9(6). SQ1354.2 +012300 07 FILLER PIC X(5). SQ1354.2 +012400 07 XFILE-ORGANIZATION PIC X(2). SQ1354.2 +012500 07 FILLER PIC X(6). SQ1354.2 +012600 07 XLABEL-TYPE PIC X(1). SQ1354.2 +012700 05 FILE-RECORD-INFO-P121-240. SQ1354.2 +012800 07 FILLER PIC X(8). SQ1354.2 +012900 07 XRECORD-KEY PIC X(29). SQ1354.2 +013000 07 FILLER PIC X(9). SQ1354.2 +013100 07 ALTERNATE-KEY1 PIC X(29). SQ1354.2 +013200 07 FILLER PIC X(9). SQ1354.2 +013300 07 ALTERNATE-KEY2 PIC X(29). SQ1354.2 +013400 07 FILLER PIC X(7). SQ1354.2 +013500* SQ1354.2 +013600 01 TEST-RESULTS. SQ1354.2 +013700 02 FILLER PIC X VALUE SPACE. SQ1354.2 +013800 02 FEATURE PIC X(24) VALUE SPACE. SQ1354.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1354.2 +014000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1354.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1354.2 +014200 02 PAR-NAME. SQ1354.2 +014300 03 FILLER PIC X(14) VALUE SPACE. SQ1354.2 +014400 03 PARDOT-X PIC X VALUE SPACE. SQ1354.2 +014500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1354.2 +014600 02 FILLER PIC X(9) VALUE SPACE. SQ1354.2 +014700 02 RE-MARK PIC X(61). SQ1354.2 +014800 01 TEST-COMPUTED. SQ1354.2 +014900 02 FILLER PIC X(30) VALUE SPACE. SQ1354.2 +015000 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1354.2 +015100 02 COMPUTED-X. SQ1354.2 +015200 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1354.2 +015300 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1354.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1354.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1354.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1354.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. SQ1354.2 +015800 04 COMPUTED-18V0 PIC -9(18). SQ1354.2 +015900 04 FILLER PIC X. SQ1354.2 +016000 03 FILLER PIC X(50) VALUE SPACE. SQ1354.2 +016100 01 TEST-CORRECT. SQ1354.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ1354.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1354.2 +016400 02 CORRECT-X. SQ1354.2 +016500 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1354.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1354.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1354.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1354.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1354.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. SQ1354.2 +017100 04 CORRECT-18V0 PIC -9(18). SQ1354.2 +017200 04 FILLER PIC X. SQ1354.2 +017300 03 FILLER PIC X(2) VALUE SPACE. SQ1354.2 +017400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1354.2 +017500 01 CCVS-C-1. SQ1354.2 +017600 02 FILLER PIC IS X(4) VALUE SPACE. SQ1354.2 +017700 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1354.2 +017800- "SS PARAGRAPH-NAME SQ1354.2 +017900- " REMARKS". SQ1354.2 +018000 02 FILLER PIC X(17) VALUE SPACE. SQ1354.2 +018100 01 CCVS-C-2. SQ1354.2 +018200 02 FILLER PIC XXXX VALUE SPACE. SQ1354.2 +018300 02 FILLER PIC X(6) VALUE "TESTED". SQ1354.2 +018400 02 FILLER PIC X(16) VALUE SPACE. SQ1354.2 +018500 02 FILLER PIC X(4) VALUE "FAIL". SQ1354.2 +018600 02 FILLER PIC X(90) VALUE SPACE. SQ1354.2 +018700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1354.2 +018800 01 REC-CT PIC 99 VALUE ZERO. SQ1354.2 +018900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1354.2 +019400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1354.2 +019500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1354.2 +019600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1354.2 +019700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1354.2 +019800 01 CCVS-H-1. SQ1354.2 +019900 02 FILLER PIC X(39) VALUE SPACES. SQ1354.2 +020000 02 FILLER PIC X(42) VALUE SQ1354.2 +020100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1354.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1354.2 +020300 01 CCVS-H-2A. SQ1354.2 +020400 02 FILLER PIC X(40) VALUE SPACE. SQ1354.2 +020500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1354.2 +020600 02 FILLER PIC XXXX VALUE SQ1354.2 +020700 "4.2 ". SQ1354.2 +020800 02 FILLER PIC X(28) VALUE SQ1354.2 +020900 " COPY - NOT FOR DISTRIBUTION". SQ1354.2 +021000 02 FILLER PIC X(41) VALUE SPACE. SQ1354.2 +021100* SQ1354.2 +021200 01 CCVS-H-2B. SQ1354.2 +021300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1354.2 +021400 02 TEST-ID PIC X(9). SQ1354.2 +021500 02 FILLER PIC X(4) VALUE " IN ". SQ1354.2 +021600 02 FILLER PIC X(12) VALUE SQ1354.2 +021700 " HIGH ". SQ1354.2 +021800 02 FILLER PIC X(22) VALUE SQ1354.2 +021900 " LEVEL VALIDATION FOR ". SQ1354.2 +022000 02 FILLER PIC X(58) VALUE SQ1354.2 +022100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +022200 01 CCVS-H-3. SQ1354.2 +022300 02 FILLER PIC X(34) VALUE SQ1354.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1354.2 +022500 02 FILLER PIC X(58) VALUE SQ1354.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1354.2 +022700 02 FILLER PIC X(28) VALUE SQ1354.2 +022800 " COPYRIGHT 1985,1986 ". SQ1354.2 +022900 01 CCVS-E-1. SQ1354.2 +023000 02 FILLER PIC X(52) VALUE SPACE. SQ1354.2 +023100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1354.2 +023200 02 ID-AGAIN PIC X(9). SQ1354.2 +023300 02 FILLER PIC X(45) VALUE SPACES. SQ1354.2 +023400 01 CCVS-E-2. SQ1354.2 +023500 02 FILLER PIC X(31) VALUE SPACE. SQ1354.2 +023600 02 FILLER PIC X(21) VALUE SPACE. SQ1354.2 +023700 02 CCVS-E-2-2. SQ1354.2 +023800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1354.2 +023900 03 FILLER PIC X VALUE SPACE. SQ1354.2 +024000 03 ENDER-DESC PIC X(44) VALUE SQ1354.2 +024100 "ERRORS ENCOUNTERED". SQ1354.2 +024200 01 CCVS-E-3. SQ1354.2 +024300 02 FILLER PIC X(22) VALUE SQ1354.2 +024400 " FOR OFFICIAL USE ONLY". SQ1354.2 +024500 02 FILLER PIC X(12) VALUE SPACE. SQ1354.2 +024600 02 FILLER PIC X(58) VALUE SQ1354.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +024800 02 FILLER PIC X(8) VALUE SPACE. SQ1354.2 +024900 02 FILLER PIC X(20) VALUE SQ1354.2 +025000 " COPYRIGHT 1985,1986". SQ1354.2 +025100 01 CCVS-E-4. SQ1354.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1354.2 +025300 02 FILLER PIC X(4) VALUE " OF ". SQ1354.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1354.2 +025500 02 FILLER PIC X(40) VALUE SQ1354.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1354.2 +025700 01 XXINFO. SQ1354.2 +025800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1354.2 +025900 02 INFO-TEXT. SQ1354.2 +026000 04 FILLER PIC X(8) VALUE SPACE. SQ1354.2 +026100 04 XXCOMPUTED PIC X(20). SQ1354.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1354.2 +026300 04 XXCORRECT PIC X(20). SQ1354.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). SQ1354.2 +026500 01 HYPHEN-LINE. SQ1354.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. SQ1354.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1354.2 +026800- "*****************************************". SQ1354.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1354.2 +027000- "******************************". SQ1354.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1354.2 +027200 "SQ135A". SQ1354.2 +027300* SQ1354.2 +027400 PROCEDURE DIVISION. SQ1354.2 +027500 DECLARATIVES. SQ1354.2 +027600 SQ-FS1-DECLARATIVE SECTION. SQ1354.2 +027700 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ1354.2 +027800 OUTPUT-ERROR-PROCESS. SQ1354.2 +027900 IF SQ-FS1-STATUS = "42" SQ1354.2 +028000 PERFORM PASS-DECL SQ1354.2 +028100 GO TO ABNORMAL-TERM-DECL SQ1354.2 +028200 ELSE SQ1354.2 +028300 MOVE "42" TO CORRECT-A SQ1354.2 +028400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1354.2 +028500 MOVE "STATUS AFTER OPEN OF A CLOSED FILE INCORRECT" SQ1354.2 +028600 TO RE-MARK SQ1354.2 +028700 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1354.2 +028800 PERFORM FAIL-DECL SQ1354.2 +028900 GO TO ABNORMAL-TERM-DECL SQ1354.2 +029000 END-IF. SQ1354.2 +029100* SQ1354.2 +029200 PASS-DECL. SQ1354.2 +029300 MOVE "PASS " TO P-OR-F. SQ1354.2 +029400 ADD 1 TO PASS-COUNTER. SQ1354.2 +029500 PERFORM PRINT-DETAIL-DECL. SQ1354.2 +029600* SQ1354.2 +029700 FAIL-DECL. SQ1354.2 +029800 MOVE "FAIL*" TO P-OR-F. SQ1354.2 +029900 ADD 1 TO ERROR-COUNTER. SQ1354.2 +030000 PERFORM PRINT-DETAIL-DECL. SQ1354.2 +030100* SQ1354.2 +030200 PRINT-DETAIL-DECL. SQ1354.2 +030300 IF REC-CT NOT EQUAL TO ZERO SQ1354.2 +030400 MOVE "." TO PARDOT-X SQ1354.2 +030500 MOVE REC-CT TO DOTVALUE. SQ1354.2 +030600 MOVE TEST-RESULTS TO PRINT-REC. SQ1354.2 +030700 PERFORM WRITE-LINE-DECL. SQ1354.2 +030800 IF P-OR-F EQUAL TO "FAIL*" SQ1354.2 +030900 PERFORM WRITE-LINE-DECL SQ1354.2 +031000 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ1354.2 +031100 ELSE SQ1354.2 +031200 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ1354.2 +031300 MOVE SPACE TO P-OR-F. SQ1354.2 +031400 MOVE SPACE TO COMPUTED-X. SQ1354.2 +031500 MOVE SPACE TO CORRECT-X. SQ1354.2 +031600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1354.2 +031700 MOVE SPACE TO RE-MARK. SQ1354.2 +031800* SQ1354.2 +031900 WRITE-LINE-DECL. SQ1354.2 +032000 ADD 1 TO RECORD-COUNT. SQ1354.2 +032100Y IF RECORD-COUNT GREATER 50 SQ1354.2 +032200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1354.2 +032300Y MOVE SPACE TO DUMMY-RECORD SQ1354.2 +032400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1354.2 +032500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1354.2 +032600Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1354.2 +032700Y PERFORM WRT-LN-DECL 2 TIMES SQ1354.2 +032800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1354.2 +032900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1354.2 +033000Y MOVE ZERO TO RECORD-COUNT. SQ1354.2 +033100 PERFORM WRT-LN-DECL. SQ1354.2 +033200* SQ1354.2 +033300 WRT-LN-DECL. SQ1354.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1354.2 +033500 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +033600 BLANK-LINE-PRINT-DECL. SQ1354.2 +033700 PERFORM WRT-LN-DECL. SQ1354.2 +033800 FAIL-ROUTINE-DECL. SQ1354.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE SQ1354.2 +034000 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE SQ1354.2 +034200 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1354.2 +034500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +034600 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +034800 GO TO FAIL-ROUTINE-EX-DECL. SQ1354.2 +034900 FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +035000 MOVE TEST-COMPUTED TO PRINT-REC SQ1354.2 +035100 PERFORM WRITE-LINE-DECL SQ1354.2 +035200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1354.2 +035300 MOVE TEST-CORRECT TO PRINT-REC SQ1354.2 +035400 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +035500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1354.2 +035600 FAIL-ROUTINE-EX-DECL. SQ1354.2 +035700 EXIT. SQ1354.2 +035800 BAIL-OUT-DECL. SQ1354.2 +035900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ1354.2 +036000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ1354.2 +036100 BAIL-OUT-WRITE-DECL. SQ1354.2 +036200 MOVE CORRECT-A TO XXCORRECT. SQ1354.2 +036300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1354.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +036500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +036600 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +036800 BAIL-OUT-EX-DECL. SQ1354.2 +036900 EXIT. SQ1354.2 +037000* SQ1354.2 +037100 ABNORMAL-TERM-DECL. SQ1354.2 +037200 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +037300 PERFORM WRITE-LINE-DECL. SQ1354.2 +037400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1354.2 +037500 TO DUMMY-RECORD. SQ1354.2 +037600 PERFORM WRITE-LINE-DECL 3 TIMES. SQ1354.2 +037700* SQ1354.2 +037800 EXIT-DECL. SQ1354.2 +037900 EXIT. SQ1354.2 +038000 END DECLARATIVES. SQ1354.2 +038100* SQ1354.2 +038200 CCVS1 SECTION. SQ1354.2 +038300 OPEN-FILES. SQ1354.2 +038400 OPEN OUTPUT PRINT-FILE. SQ1354.2 +038500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1354.2 +038600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1354.2 +038700 MOVE SPACE TO TEST-RESULTS. SQ1354.2 +038800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1354.2 +038900 MOVE ZERO TO REC-SKEL-SUB. SQ1354.2 +039000 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1354.2 +039100 GO TO CCVS1-EXIT. SQ1354.2 +039200* SQ1354.2 +039300 CCVS-INIT-FILE. SQ1354.2 +039400 ADD 1 TO REC-SKL-SUB. SQ1354.2 +039500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1354.2 +039600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1354.2 +039700* SQ1354.2 +039800 CLOSE-FILES. SQ1354.2 +039900 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1354.2 +040000 CLOSE PRINT-FILE. SQ1354.2 +040100 TERMINATE-CCVS. SQ1354.2 +040200S EXIT PROGRAM. SQ1354.2 +040300 STOP RUN. SQ1354.2 +040400* SQ1354.2 +040500 INSPT. SQ1354.2 +040600 MOVE "INSPT" TO P-OR-F. SQ1354.2 +040700 ADD 1 TO INSPECT-COUNTER. SQ1354.2 +040800 PERFORM PRINT-DETAIL. SQ1354.2 +040900 SQ1354.2 +041000 PASS. SQ1354.2 +041100 MOVE "PASS " TO P-OR-F. SQ1354.2 +041200 ADD 1 TO PASS-COUNTER. SQ1354.2 +041300 PERFORM PRINT-DETAIL. SQ1354.2 +041400* SQ1354.2 +041500 FAIL. SQ1354.2 +041600 MOVE "FAIL*" TO P-OR-F. SQ1354.2 +041700 ADD 1 TO ERROR-COUNTER. SQ1354.2 +041800 PERFORM PRINT-DETAIL. SQ1354.2 +041900* SQ1354.2 +042000 DE-LETE. SQ1354.2 +042100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1354.2 +042200 MOVE "*****" TO P-OR-F. SQ1354.2 +042300 ADD 1 TO DELETE-COUNTER. SQ1354.2 +042400 PERFORM PRINT-DETAIL. SQ1354.2 +042500* SQ1354.2 +042600 PRINT-DETAIL. SQ1354.2 +042700 IF REC-CT NOT EQUAL TO ZERO SQ1354.2 +042800 MOVE "." TO PARDOT-X SQ1354.2 +042900 MOVE REC-CT TO DOTVALUE. SQ1354.2 +043000 MOVE TEST-RESULTS TO PRINT-REC. SQ1354.2 +043100 PERFORM WRITE-LINE. SQ1354.2 +043200 IF P-OR-F EQUAL TO "FAIL*" SQ1354.2 +043300 PERFORM WRITE-LINE SQ1354.2 +043400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1354.2 +043500 ELSE SQ1354.2 +043600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1354.2 +043700 MOVE SPACE TO P-OR-F. SQ1354.2 +043800 MOVE SPACE TO COMPUTED-X. SQ1354.2 +043900 MOVE SPACE TO CORRECT-X. SQ1354.2 +044000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1354.2 +044100 MOVE SPACE TO RE-MARK. SQ1354.2 +044200* SQ1354.2 +044300 HEAD-ROUTINE. SQ1354.2 +044400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +044500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +044600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1354.2 +044700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1354.2 +044800 COLUMN-NAMES-ROUTINE. SQ1354.2 +044900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +045000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +045200 END-ROUTINE. SQ1354.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1354.2 +045400 PERFORM WRITE-LINE 5 TIMES. SQ1354.2 +045500 END-RTN-EXIT. SQ1354.2 +045600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1354.2 +045700 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +045800* SQ1354.2 +045900 END-ROUTINE-1. SQ1354.2 +046000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1354.2 +046100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1354.2 +046200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1354.2 +046300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1354.2 +046400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1354.2 +046500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1354.2 +046600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1354.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1354.2 +046800 PERFORM WRITE-LINE. SQ1354.2 +046900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1354.2 +047000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1354.2 +047100 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +047200 ELSE SQ1354.2 +047300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1354.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1354.2 +047500 PERFORM WRITE-LINE. SQ1354.2 +047600 END-ROUTINE-13. SQ1354.2 +047700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1354.2 +047800 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +047900 ELSE SQ1354.2 +048000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1354.2 +048100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1354.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1354.2 +048300 PERFORM WRITE-LINE. SQ1354.2 +048400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1354.2 +048500 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +048600 ELSE SQ1354.2 +048700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1354.2 +048800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1354.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +049000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +049100* SQ1354.2 +049200 WRITE-LINE. SQ1354.2 +049300 ADD 1 TO RECORD-COUNT. SQ1354.2 +049400Y IF RECORD-COUNT GREATER 50 SQ1354.2 +049500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1354.2 +049600Y MOVE SPACE TO DUMMY-RECORD SQ1354.2 +049700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1354.2 +049800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1354.2 +049900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1354.2 +050000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1354.2 +050100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1354.2 +050200Y MOVE ZERO TO RECORD-COUNT. SQ1354.2 +050300 PERFORM WRT-LN. SQ1354.2 +050400* SQ1354.2 +050500 WRT-LN. SQ1354.2 +050600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1354.2 +050700 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +050800 BLANK-LINE-PRINT. SQ1354.2 +050900 PERFORM WRT-LN. SQ1354.2 +051000 FAIL-ROUTINE. SQ1354.2 +051100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1354.2 +051200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1354.2 +051300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +051400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1354.2 +051500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +051600 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +051700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +051800 GO TO FAIL-ROUTINE-EX. SQ1354.2 +051900 FAIL-ROUTINE-WRITE. SQ1354.2 +052000 MOVE TEST-COMPUTED TO PRINT-REC SQ1354.2 +052100 PERFORM WRITE-LINE SQ1354.2 +052200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1354.2 +052300 MOVE TEST-CORRECT TO PRINT-REC SQ1354.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +052500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1354.2 +052600 FAIL-ROUTINE-EX. SQ1354.2 +052700 EXIT. SQ1354.2 +052800 BAIL-OUT. SQ1354.2 +052900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1354.2 +053000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1354.2 +053100 BAIL-OUT-WRITE. SQ1354.2 +053200 MOVE CORRECT-A TO XXCORRECT. SQ1354.2 +053300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1354.2 +053400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +053500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +053600 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +053700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +053800 BAIL-OUT-EX. SQ1354.2 +053900 EXIT. SQ1354.2 +054000 CCVS1-EXIT. SQ1354.2 +054100 EXIT. SQ1354.2 +054200* SQ1354.2 +054300**************************************************************** SQ1354.2 +054400* * SQ1354.2 +054500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1354.2 +054600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1354.2 +054700* * SQ1354.2 +054800**************************************************************** SQ1354.2 +054900* SQ1354.2 +055000 SECT-SQ135A-0001 SECTION. SQ1354.2 +055100 WRITE-INIT-GF-01. SQ1354.2 +055200* SQ1354.2 +055300* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1354.2 +055400* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1354.2 +055500* SQ1354.2 +055600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1354.2 +055700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1354.2 +055800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1354.2 +055900 MOVE 120 TO XRECORD-LENGTH (1). SQ1354.2 +056000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1354.2 +056100 MOVE 1 TO XBLOCK-SIZE (1). SQ1354.2 +056200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1354.2 +056300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1354.2 +056400 MOVE "S" TO XLABEL-TYPE (1). SQ1354.2 +056500 MOVE 1 TO XRECORD-NUMBER (1). SQ1354.2 +056600* SQ1354.2 +056700 WRITE-OPEN-01. SQ1354.2 +056800 OPEN OUTPUT SQ-FS1. SQ1354.2 +056900* SQ1354.2 +057000* WRITE A SINGLE RECORD TO THE FILE SQ1354.2 +057100* SQ1354.2 +057200 WRITE-INIT-01. SQ1354.2 +057300 WRITE-TEST-01-01. SQ1354.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1354.2 +057500 WRITE SQ-FS1R1-F-G-120. SQ1354.2 +057600* SQ1354.2 +057700 CLOSE-INIT-01. SQ1354.2 +057800 CLOSE-TEST-01. SQ1354.2 +057900 CLOSE SQ-FS1. SQ1354.2 +058000* SQ1354.2 +058100* HAVING CLOSED THE FILE, WE NOW TRY TO CLOSE IT AGAIN. SQ1354.2 +058200* THE TEST PASSES IF THE FILE CANNOT BE RECLOSED AND SQ1354.2 +058300* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ1354.2 +058400* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF A SQ1354.2 +058500* PROGRAM WHICH ATTEMPTS TO RECLOSE AN ALREADY CLOSED FILE.SQ1354.2 +058600 CLOSE-INIT-02. SQ1354.2 +058700* SQ1354.2 +058800 MOVE 1 TO REC-CT. SQ1354.2 +058900 MOVE "CLOSE-TEST-02" TO PAR-NAME SQ1354.2 +059000 MOVE "CLOSE OF CLOSED FILE" TO FEATURE. SQ1354.2 +059100 CLOSE-TEST-02. SQ1354.2 +059200 CLOSE SQ-FS1. SQ1354.2 +059300* SQ1354.2 +059400 CCVS-EXIT SECTION. SQ1354.2 +059500 CCVS-999999. SQ1354.2 +059600 GO TO CLOSE-FILES. SQ1354.2 +*END-OF,SQ135A +*HEADER,COBOL,SQ136A +000100 IDENTIFICATION DIVISION. SQ1364.2 +000200 PROGRAM-ID. SQ1364.2 +000300 SQ136A. SQ1364.2 +000400**************************************************************** SQ1364.2 +000500* * SQ1364.2 +000600* VALIDATION FOR:- * SQ1364.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1364.2 +000900* REVISED 1986, AUGUST * SQ1364.2 +001000* * SQ1364.2 +001100* CREATION DATE / VALIDATION DATE * SQ1364.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1364.2 +001300* * SQ1364.2 +001400**************************************************************** SQ1364.2 +001500* * SQ1364.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1364.2 +001700* * SQ1364.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1364.2 +001900* X-55 SYSTEM PRINTER * SQ1364.2 +002000* X-82 SOURCE-COMPUTER * SQ1364.2 +002100* X-83 OBJECT-COMPUTER. * SQ1364.2 +002200* * SQ1364.2 +002300**************************************************************** SQ1364.2 +002400* * SQ1364.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1364.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1364.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1364.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1364.2 +002900* * SQ1364.2 +003000**************************************************************** SQ1364.2 +003100* SQ1364.2 +003200 ENVIRONMENT DIVISION. SQ1364.2 +003300 CONFIGURATION SECTION. SQ1364.2 +003400 SOURCE-COMPUTER. SQ1364.2 +003500 XXXXX082. SQ1364.2 +003600 OBJECT-COMPUTER. SQ1364.2 +003700 XXXXX083. SQ1364.2 +003800* SQ1364.2 +003900 INPUT-OUTPUT SECTION. SQ1364.2 +004000 FILE-CONTROL. SQ1364.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1364.2 +004200 XXXXX055. SQ1364.2 +004300* SQ1364.2 +004400P SELECT RAW-DATA ASSIGN TO SQ1364.2 +004500P XXXXX062 SQ1364.2 +004600P ORGANIZATION IS INDEXED SQ1364.2 +004700P ACCESS MODE IS RANDOM SQ1364.2 +004800P RECORD-KEY IS RAW-DATA-KEY. SQ1364.2 +004900P SQ1364.2 +005000 SELECT SQ-FS4 ASSIGN SQ1364.2 +005100 XXXXX014 SQ1364.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1364.2 +005300* SQ1364.2 +005400* SQ1364.2 +005500 DATA DIVISION. SQ1364.2 +005600 FILE SECTION. SQ1364.2 +005700 FD PRINT-FILE SQ1364.2 +005800C LABEL RECORDS SQ1364.2 +005900C XXXXX084 SQ1364.2 +006000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1364.2 +006100 . SQ1364.2 +006200 01 PRINT-REC PICTURE X(120). SQ1364.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1364.2 +006400P SQ1364.2 +006500PFD RAW-DATA. SQ1364.2 +006600P01 RAW-DATA-SATZ. SQ1364.2 +006700P 05 RAW-DATA-KEY PIC X(6). SQ1364.2 +006800P 05 C-DATE PIC 9(6). SQ1364.2 +006900P 05 C-TIME PIC 9(8). SQ1364.2 +007000P 05 NO-OF-TESTS PIC 99. SQ1364.2 +007100P 05 C-OK PIC 999. SQ1364.2 +007200P 05 C-ALL PIC 999. SQ1364.2 +007300P 05 C-FAIL PIC 999. SQ1364.2 +007400P 05 C-DELETED PIC 999. SQ1364.2 +007500P 05 C-INSPECT PIC 999. SQ1364.2 +007600P 05 C-NOTE PIC X(13). SQ1364.2 +007700P 05 C-INDENT PIC X. SQ1364.2 +007800P 05 C-ABORT PIC X(8). SQ1364.2 +007900* SQ1364.2 +008000 FD SQ-FS4 SQ1364.2 +008100C LABEL RECORD IS STANDARD SQ1364.2 +008200 BLOCK 2 RECORDS SQ1364.2 +008300 RECORD 125 SQ1364.2 +008400 . SQ1364.2 +008500 01 SQ-FS4R1-F-G-125. SQ1364.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1364.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1364.2 +008800* SQ1364.2 +008900 WORKING-STORAGE SECTION. SQ1364.2 +009000* SQ1364.2 +009100*************************************************************** SQ1364.2 +009200* * SQ1364.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1364.2 +009400* * SQ1364.2 +009500*************************************************************** SQ1364.2 +009600* SQ1364.2 +009700 01 SQ-FS4-STATUS. SQ1364.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1364.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1364.2 +010000* SQ1364.2 +010100 01 DELETE-SW. SQ1364.2 +010200 03 DELETE-SW-1 PIC X. SQ1364.2 +010300 03 DELETE-SW-1-GROUP. SQ1364.2 +010400 05 DELETE-SW-2 PIC X. SQ1364.2 +010500* SQ1364.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1364.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1364.2 +010800 01 DECL-EXEC-SW PIC X. SQ1364.2 +010900* SQ1364.2 +011000*************************************************************** SQ1364.2 +011100* * SQ1364.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1364.2 +011300* * SQ1364.2 +011400*************************************************************** SQ1364.2 +011500* SQ1364.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1364.2 +011700* SQ1364.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1364.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1364.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1364.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1364.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1364.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1364.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1364.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1364.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1364.2 +012700 ",RECKEY= ". SQ1364.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1364.2 +012900 ",ALTKEY1= ". SQ1364.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1364.2 +013100 ",ALTKEY2= ". SQ1364.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1364.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1364.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1364.2 +013500 07 FILLER PIC X(5). SQ1364.2 +013600 07 XFILE-NAME PIC X(6). SQ1364.2 +013700 07 FILLER PIC X(8). SQ1364.2 +013800 07 XRECORD-NAME PIC X(6). SQ1364.2 +013900 07 FILLER PIC X(1). SQ1364.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1364.2 +014100 07 FILLER PIC X(7). SQ1364.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1364.2 +014300 07 FILLER PIC X(6). SQ1364.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1364.2 +014500 07 FILLER PIC X(5). SQ1364.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1364.2 +014700 07 FILLER PIC X(5). SQ1364.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1364.2 +014900 07 FILLER PIC X(7). SQ1364.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1364.2 +015100 07 FILLER PIC X(7). SQ1364.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1364.2 +015300 07 FILLER PIC X(1). SQ1364.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1364.2 +015500 07 FILLER PIC X(6). SQ1364.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1364.2 +015700 07 FILLER PIC X(5). SQ1364.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1364.2 +015900 07 FILLER PIC X(6). SQ1364.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1364.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1364.2 +016200 07 FILLER PIC X(8). SQ1364.2 +016300 07 XRECORD-KEY PIC X(29). SQ1364.2 +016400 07 FILLER PIC X(9). SQ1364.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1364.2 +016600 07 FILLER PIC X(9). SQ1364.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1364.2 +016800 07 FILLER PIC X(7). SQ1364.2 +016900* SQ1364.2 +017000 01 TEST-RESULTS. SQ1364.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017200 02 PAR-NAME. SQ1364.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1364.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1364.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1364.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1364.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1364.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1364.2 +018100 02 RE-MARK PIC X(61). SQ1364.2 +018200 01 TEST-COMPUTED. SQ1364.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1364.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1364.2 +018500 02 COMPUTED-X. SQ1364.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1364.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1364.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1364.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1364.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1364.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1364.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1364.2 +019300 04 FILLER PIC X. SQ1364.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1364.2 +019500 01 TEST-CORRECT. SQ1364.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1364.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1364.2 +019800 02 CORRECT-X. SQ1364.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1364.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1364.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1364.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1364.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1364.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1364.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1364.2 +020600 04 FILLER PIC X. SQ1364.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1364.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1364.2 +020900* SQ1364.2 +021000 01 CCVS-C-1. SQ1364.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1364.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1364.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1364.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1364.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1364.2 +021900 01 CCVS-C-2. SQ1364.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1364.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1364.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1364.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1364.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1364.2 +022500* SQ1364.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1364.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1364.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1364.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1364.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1364.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1364.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1364.2 +023700 01 CCVS-H-1. SQ1364.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1364.2 +023900 02 FILLER PIC X(42) VALUE SQ1364.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1364.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1364.2 +024200 01 CCVS-H-2A. SQ1364.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1364.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1364.2 +024500 02 FILLER PIC XXXX VALUE SQ1364.2 +024600 "4.2 ". SQ1364.2 +024700 02 FILLER PIC X(28) VALUE SQ1364.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1364.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1364.2 +025000* SQ1364.2 +025100 01 CCVS-H-2B. SQ1364.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1364.2 +025300 02 TEST-ID PIC X(9). SQ1364.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1364.2 +025500 02 FILLER PIC X(12) VALUE SQ1364.2 +025600 " HIGH ". SQ1364.2 +025700 02 FILLER PIC X(22) VALUE SQ1364.2 +025800 " LEVEL VALIDATION FOR ". SQ1364.2 +025900 02 FILLER PIC X(58) VALUE SQ1364.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +026100 01 CCVS-H-3. SQ1364.2 +026200 02 FILLER PIC X(34) VALUE SQ1364.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1364.2 +026400 02 FILLER PIC X(58) VALUE SQ1364.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1364.2 +026600 02 FILLER PIC X(28) VALUE SQ1364.2 +026700 " COPYRIGHT 1985,1986 ". SQ1364.2 +026800 01 CCVS-E-1. SQ1364.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1364.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1364.2 +027100 02 ID-AGAIN PIC X(9). SQ1364.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1364.2 +027300 01 CCVS-E-2. SQ1364.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1364.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1364.2 +027600 02 CCVS-E-2-2. SQ1364.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1364.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1364.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1364.2 +028000 "ERRORS ENCOUNTERED". SQ1364.2 +028100 01 CCVS-E-3. SQ1364.2 +028200 02 FILLER PIC X(22) VALUE SQ1364.2 +028300 " FOR OFFICIAL USE ONLY". SQ1364.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1364.2 +028500 02 FILLER PIC X(58) VALUE SQ1364.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1364.2 +028800 02 FILLER PIC X(20) VALUE SQ1364.2 +028900 " COPYRIGHT 1985,1986". SQ1364.2 +029000 01 CCVS-E-4. SQ1364.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1364.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1364.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1364.2 +029400 02 FILLER PIC X(40) VALUE SQ1364.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1364.2 +029600 01 XXINFO. SQ1364.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1364.2 +029800 02 INFO-TEXT. SQ1364.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1364.2 +030000 04 XXCOMPUTED PIC X(20). SQ1364.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1364.2 +030200 04 XXCORRECT PIC X(20). SQ1364.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1364.2 +030400 01 HYPHEN-LINE. SQ1364.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1364.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1364.2 +030700- "*****************************************". SQ1364.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1364.2 +030900- "******************************". SQ1364.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1364.2 +031100 "SQ136A". SQ1364.2 +031200* SQ1364.2 +031300* SQ1364.2 +031400 PROCEDURE DIVISION. SQ1364.2 +031500 DECLARATIVES. SQ1364.2 +031600* SQ1364.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1364.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1364.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1364.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1364.2 +032100* SQ1364.2 +032200 SECT-SQ136A-0000 SECTION. SQ1364.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1364.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1364.2 +032500 EXIT. SQ1364.2 +032600* SQ1364.2 +032700 SECT-SQ136A-0001 SECTION. SQ1364.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1364.2 +032900 OUTPUT-ERROR-PROCESS. SQ1364.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1364.2 +033100* SQ1364.2 +033200 SECT-SQ136A-0002 SECTION. SQ1364.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1364.2 +033400 INPUT-ERROR-PROCESS. SQ1364.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1364.2 +033600* SQ1364.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1364.2 +033800 GO TO END-DECLS. SQ1364.2 +033900* SQ1364.2 +034000 MOVE 1 TO REC-CT. SQ1364.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1364.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1364.2 +034300 GO TO DECL-EOF-READ-01. SQ1364.2 +034400 DECL-DELETE-01. SQ1364.2 +034500 PERFORM DECL-DE-LETE. SQ1364.2 +034600 GO TO DECL-TEST-01-END. SQ1364.2 +034700 DECL-EOF-READ-01. SQ1364.2 +034800 DECL-TEST-01-END. SQ1364.2 +034900* SQ1364.2 +035000 ADD 1 TO REC-CT. SQ1364.2 +035100 GO TO DECL-EOF-READ-02. SQ1364.2 +035200 DECL-DELETE-02. SQ1364.2 +035300 PERFORM DECL-DE-LETE. SQ1364.2 +035400 GO TO DECL-TEST-02-END. SQ1364.2 +035500 DECL-EOF-READ-02. SQ1364.2 +035600 DECL-TEST-02-END. SQ1364.2 +035700* SQ1364.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +035900 PERFORM DECL-WRITE-LINE. SQ1364.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1364.2 +036100 TO DUMMY-RECORD. SQ1364.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1364.2 +036300 GO TO END-DECLS. SQ1364.2 +036400* SQ1364.2 +036500* SQ1364.2 +036600 DECL-PASS. SQ1364.2 +036700 MOVE "PASS " TO P-OR-F. SQ1364.2 +036800 ADD 1 TO PASS-COUNTER. SQ1364.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +037000* SQ1364.2 +037100 DECL-FAIL. SQ1364.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1364.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1364.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +037500* SQ1364.2 +037600 DECL-DE-LETE. SQ1364.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1364.2 +037800 MOVE "*****" TO P-OR-F. SQ1364.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1364.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +038100* SQ1364.2 +038200 DECL-PRINT-DETAIL. SQ1364.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1364.2 +038400 MOVE "." TO PARDOT-X SQ1364.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1364.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1364.2 +038700 PERFORM DECL-WRITE-LINE. SQ1364.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1364.2 +038900 PERFORM DECL-WRITE-LINE SQ1364.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1364.2 +039100 ELSE SQ1364.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1364.2 +039300 MOVE SPACE TO P-OR-F. SQ1364.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1364.2 +039500 MOVE SPACE TO CORRECT-X. SQ1364.2 +039600 IF REC-CT EQUAL TO ZERO SQ1364.2 +039700 MOVE SPACE TO PAR-NAME. SQ1364.2 +039800 MOVE SPACE TO RE-MARK. SQ1364.2 +039900* SQ1364.2 +040000 DECL-WRITE-LINE. SQ1364.2 +040100 ADD 1 TO RECORD-COUNT. SQ1364.2 +040200Y IF RECORD-COUNT GREATER 50 SQ1364.2 +040300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1364.2 +040400Y MOVE SPACE TO DUMMY-RECORD SQ1364.2 +040500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1364.2 +040600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1364.2 +040700Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1364.2 +040800Y PERFORM DECL-WRT-LN 2 TIMES SQ1364.2 +040900Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1364.2 +041000Y PERFORM DECL-WRT-LN SQ1364.2 +041100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1364.2 +041200Y MOVE ZERO TO RECORD-COUNT. SQ1364.2 +041300 PERFORM DECL-WRT-LN. SQ1364.2 +041400* SQ1364.2 +041500 DECL-WRT-LN. SQ1364.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1364.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +041800* SQ1364.2 +041900 DECL-FAIL-ROUTINE. SQ1364.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1364.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1364.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1364.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +042700 GO TO DECL-FAIL-EX. SQ1364.2 +042800 DECL-FAIL-WRITE. SQ1364.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1364.2 +043000 PERFORM DECL-WRITE-LINE SQ1364.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1364.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1364.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1364.2 +043500 DECL-FAIL-EX. SQ1364.2 +043600 EXIT. SQ1364.2 +043700* SQ1364.2 +043800 DECL-BAIL. SQ1364.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1364.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1364.2 +044100 DECL-BAIL-WRITE. SQ1364.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1364.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1364.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +044600 DECL-BAIL-EX. SQ1364.2 +044700 EXIT. SQ1364.2 +044800* SQ1364.2 +044900 END-DECLS. SQ1364.2 +045000 END DECLARATIVES. SQ1364.2 +045100* SQ1364.2 +045200* SQ1364.2 +045300 CCVS1 SECTION. SQ1364.2 +045400 OPEN-FILES. SQ1364.2 +045500P OPEN I-O RAW-DATA. SQ1364.2 +045600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1364.2 +045700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1364.2 +045800P MOVE "ABORTED " TO C-ABORT. SQ1364.2 +045900P ADD 1 TO C-NO-OF-TESTS. SQ1364.2 +046000P ACCEPT C-DATE FROM DATE. SQ1364.2 +046100P ACCEPT C-TIME FROM TIME. SQ1364.2 +046200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1364.2 +046300PEND-E-1. SQ1364.2 +046400P CLOSE RAW-DATA. SQ1364.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1364.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1364.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1364.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1364.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1364.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1364.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1364.2 +047200 GO TO CCVS1-EXIT. SQ1364.2 +047300* SQ1364.2 +047400 CCVS-INIT-FILE. SQ1364.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1364.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1364.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1364.2 +047800* SQ1364.2 +047900 CLOSE-FILES. SQ1364.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1364.2 +048100 CLOSE PRINT-FILE. SQ1364.2 +048200P OPEN I-O RAW-DATA. SQ1364.2 +048300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1364.2 +048400P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1364.2 +048500P MOVE "OK. " TO C-ABORT. SQ1364.2 +048600P MOVE PASS-COUNTER TO C-OK. SQ1364.2 +048700P MOVE ERROR-HOLD TO C-ALL. SQ1364.2 +048800P MOVE ERROR-COUNTER TO C-FAIL. SQ1364.2 +048900P MOVE DELETE-CNT TO C-DELETED. SQ1364.2 +049000P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1364.2 +049100P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1364.2 +049200PEND-E-2. SQ1364.2 +049300P CLOSE RAW-DATA. SQ1364.2 +049400 TERMINATE-CCVS. SQ1364.2 +049500S EXIT PROGRAM. SQ1364.2 +049600 STOP RUN. SQ1364.2 +049700* SQ1364.2 +049800 INSPT. SQ1364.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1364.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1364.2 +050100 PERFORM PRINT-DETAIL. SQ1364.2 +050200* SQ1364.2 +050300 PASS. SQ1364.2 +050400 MOVE "PASS " TO P-OR-F. SQ1364.2 +050500 ADD 1 TO PASS-COUNTER. SQ1364.2 +050600 PERFORM PRINT-DETAIL. SQ1364.2 +050700* SQ1364.2 +050800 FAIL. SQ1364.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1364.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1364.2 +051100 PERFORM PRINT-DETAIL. SQ1364.2 +051200* SQ1364.2 +051300 DE-LETE. SQ1364.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1364.2 +051500 MOVE "*****" TO P-OR-F. SQ1364.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1364.2 +051700 PERFORM PRINT-DETAIL. SQ1364.2 +051800* SQ1364.2 +051900 PRINT-DETAIL. SQ1364.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1364.2 +052100 MOVE "." TO PARDOT-X SQ1364.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1364.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1364.2 +052400 PERFORM WRITE-LINE. SQ1364.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1364.2 +052600 PERFORM WRITE-LINE SQ1364.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1364.2 +052800 ELSE SQ1364.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1364.2 +053000 MOVE SPACE TO P-OR-F. SQ1364.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1364.2 +053200 MOVE SPACE TO CORRECT-X. SQ1364.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1364.2 +053400 MOVE SPACE TO RE-MARK. SQ1364.2 +053500* SQ1364.2 +053600 HEAD-ROUTINE. SQ1364.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1364.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1364.2 +054100 COLUMN-NAMES-ROUTINE. SQ1364.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +054500 END-ROUTINE. SQ1364.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1364.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1364.2 +054800 END-RTN-EXIT. SQ1364.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1364.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +055100* SQ1364.2 +055200 END-ROUTINE-1. SQ1364.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1364.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1364.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1364.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1364.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1364.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1364.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1364.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1364.2 +056100 PERFORM WRITE-LINE. SQ1364.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1364.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1364.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +056500 ELSE SQ1364.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1364.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1364.2 +056800 PERFORM WRITE-LINE. SQ1364.2 +056900 END-ROUTINE-13. SQ1364.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1364.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +057200 ELSE SQ1364.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1364.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1364.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1364.2 +057600 PERFORM WRITE-LINE. SQ1364.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1364.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +057900 ELSE SQ1364.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1364.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1364.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +058400* SQ1364.2 +058500 WRITE-LINE. SQ1364.2 +058600 ADD 1 TO RECORD-COUNT. SQ1364.2 +058700Y IF RECORD-COUNT GREATER 50 SQ1364.2 +058800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1364.2 +058900Y MOVE SPACE TO DUMMY-RECORD SQ1364.2 +059000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1364.2 +059100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1364.2 +059200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1364.2 +059300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1364.2 +059400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1364.2 +059500Y MOVE ZERO TO RECORD-COUNT. SQ1364.2 +059600 PERFORM WRT-LN. SQ1364.2 +059700* SQ1364.2 +059800 WRT-LN. SQ1364.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1364.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +060100 BLANK-LINE-PRINT. SQ1364.2 +060200 PERFORM WRT-LN. SQ1364.2 +060300 FAIL-ROUTINE. SQ1364.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1364.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1364.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1364.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1364.2 +061200 FAIL-ROUTINE-WRITE. SQ1364.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1364.2 +061400 PERFORM WRITE-LINE SQ1364.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1364.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1364.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1364.2 +061900 FAIL-ROUTINE-EX. SQ1364.2 +062000 EXIT. SQ1364.2 +062100 BAIL-OUT. SQ1364.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1364.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1364.2 +062400 BAIL-OUT-WRITE. SQ1364.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1364.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1364.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +063100 BAIL-OUT-EX. SQ1364.2 +063200 EXIT. SQ1364.2 +063300 CCVS1-EXIT. SQ1364.2 +063400 EXIT. SQ1364.2 +063500* SQ1364.2 +063600**************************************************************** SQ1364.2 +063700* * SQ1364.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1364.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1364.2 +064000* * SQ1364.2 +064100**************************************************************** SQ1364.2 +064200* SQ1364.2 +064300 SECT-SQ136A-0004 SECTION. SQ1364.2 +064400 STA-INIT. SQ1364.2 +064500 MOVE SPACE TO DELETE-SW. SQ1364.2 +064600* SQ1364.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1364.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1364.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1364.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1364.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1364.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1364.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1364.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1364.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1364.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1364.2 +065700* SQ1364.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1364.2 +065900* SQ1364.2 +066000 SEQ-INIT-01. SQ1364.2 +066100 MOVE 0 TO REC-CT. SQ1364.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1364.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1364.2 +066800 GO TO SEQ-TEST-OP-01. SQ1364.2 +066900 SEQ-DELETE-01. SQ1364.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1364.2 +067100 SEQ-TEST-OP-01. SQ1364.2 +067200 OPEN OUTPUT SQ-FS4. SQ1364.2 +067300 SEQ-INIT-02. SQ1364.2 +067400 MOVE 0 TO REC-CT. SQ1364.2 +067500 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +067600 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +067700 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +067800 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1364.2 +068000 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1364.2 +068100 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1364.2 +068200 IF DELETE-SW NOT EQUAL TO SPACE SQ1364.2 +068300 GO TO SEQ-DELETE-02. SQ1364.2 +068400 GO TO SEQ-TEST-WR-02. SQ1364.2 +068500 SEQ-DELETE-02. SQ1364.2 +068600 MOVE "*" TO DELETE-SW-2. SQ1364.2 +068700 SEQ-TEST-WR-02. SQ1364.2 +068800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1364.2 +068900 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1364.2 +069000 WRITE SQ-FS4R1-F-G-125. SQ1364.2 +069100 SEQ-INIT-03. SQ1364.2 +069200 MOVE 0 TO REC-CT. SQ1364.2 +069300 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +069400 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +069500 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +069600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +069700 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1364.2 +069800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1364.2 +069900 IF DELETE-SW NOT EQUAL TO SPACE SQ1364.2 +070000 GO TO SEQ-DELETE-03. SQ1364.2 +070100 GO TO SEQ-TEST-CL-03. SQ1364.2 +070200 SEQ-DELETE-03. SQ1364.2 +070300 MOVE "*" TO DELETE-SW-2. SQ1364.2 +070400 SEQ-TEST-CL-03. SQ1364.2 +070500 CLOSE SQ-FS4. SQ1364.2 +070600 SEQ-INIT-04. SQ1364.2 +070700 MOVE 0 TO REC-CT. SQ1364.2 +070800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1364.2 +070900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +071000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +071100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +071200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +071300 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1364.2 +071400 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1364.2 +071500 IF DELETE-SW NOT = SPACE SQ1364.2 +071600 GO TO SEQ-DELETE-04. SQ1364.2 +071700 GO TO SEQ-TEST-OP-04. SQ1364.2 +071800 SEQ-DELETE-04. SQ1364.2 +071900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +072000 SEQ-TEST-OP-04. SQ1364.2 +072100 OPEN INPUT SQ-FS4. SQ1364.2 +072200 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1364.2 +072300* SQ1364.2 +072400* SQ1364.2 +072500* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1364.2 +072600* SQ1364.2 +072700 SEQ-INIT-05. SQ1364.2 +072800 MOVE 0 TO REC-CT. SQ1364.2 +072900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +073000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +073100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +073200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +073300 MOVE "READ FIRST RECORD" TO FEATURE. SQ1364.2 +073400 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1364.2 +073500 IF DELETE-SW NOT = SPACE SQ1364.2 +073600 GO TO SEQ-DELETE-05. SQ1364.2 +073700 GO TO SEQ-TEST-RD-05. SQ1364.2 +073800 SEQ-DELETE-05. SQ1364.2 +073900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +074000 SEQ-TEST-RD-05. SQ1364.2 +074100 READ SQ-FS4. SQ1364.2 +074200 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1364.2 +074300* SQ1364.2 +074400* SQ1364.2 +074500* READ AGAIN, TO RAISE THE AT END CONDITION SQ1364.2 +074600* SQ1364.2 +074700 SEQ-INIT-06. SQ1364.2 +074800 MOVE 0 TO REC-CT. SQ1364.2 +074900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +075000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +075100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +075200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +075300 MOVE "READ, GIVING AT END" TO FEATURE. SQ1364.2 +075400 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1364.2 +075500 IF DELETE-SW NOT = SPACE SQ1364.2 +075600 GO TO SEQ-DELETE-06. SQ1364.2 +075700 GO TO SEQ-TEST-RD-06. SQ1364.2 +075800 SEQ-DELETE-06. SQ1364.2 +075900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +076000 SEQ-TEST-RD-06. SQ1364.2 +076100 READ SQ-FS4. SQ1364.2 +076200* SQ1364.2 +076300* SQ1364.2 +076400* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1364.2 +076500* SQ1364.2 +076600 SEQ-INIT-07. SQ1364.2 +076700 MOVE 0 TO REC-CT. SQ1364.2 +076800 MOVE SPACE TO DECL-EXEC-SW. SQ1364.2 +076900 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +077000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +077100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +077200 MOVE "READ AFTER AT END" TO FEATURE. SQ1364.2 +077300 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1364.2 +077400 IF DELETE-SW NOT = SPACE SQ1364.2 +077500 GO TO SEQ-DELETE-07. SQ1364.2 +077600 GO TO SEQ-TEST-RD-07. SQ1364.2 +077700 SEQ-DELETE-07. SQ1364.2 +077800 MOVE "*" TO DELETE-SW-2. SQ1364.2 +077900 GO TO SEQ-DELETE-07-01. SQ1364.2 +078000 SEQ-TEST-RD-07. SQ1364.2 +078100 READ SQ-FS4. SQ1364.2 +078200* SQ1364.2 +078300* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1364.2 +078400* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1364.2 +078500* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1364.2 +078600* SQ1364.2 +078700 MOVE ZERO TO REC-CT. SQ1364.2 +078800 MOVE "READ AFTER AT END" TO FEATURE. SQ1364.2 +078900 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1364.2 +079000* SQ1364.2 +079100* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1364.2 +079200* SQ1364.2 +079300 ADD 1 TO REC-CT. SQ1364.2 +079400 IF DELETE-SW NOT = SPACE SQ1364.2 +079500 GO TO SEQ-DELETE-07-01. SQ1364.2 +079600 GO TO SEQ-TEST-RD-07-01. SQ1364.2 +079700 SEQ-DELETE-07-01. SQ1364.2 +079800 PERFORM DE-LETE. SQ1364.2 +079900 GO TO SEQ-TEST-07-01-END. SQ1364.2 +080000 SEQ-TEST-RD-07-01. SQ1364.2 +080100 IF SQ-FS4-STATUS = "46" SQ1364.2 +080200 PERFORM PASS SQ1364.2 +080300 ELSE SQ1364.2 +080400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1364.2 +080500 MOVE "46" TO CORRECT-A SQ1364.2 +080600 MOVE "UNEXPECTED I-O STATUS BEYOND END OF FILE" SQ1364.2 +080700 TO RE-MARK SQ1364.2 +080800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1364.2 +080900 PERFORM FAIL. SQ1364.2 +081000 SEQ-TEST-07-01-END. SQ1364.2 +081100 CCVS-EXIT SECTION. SQ1364.2 +081200 CCVS-999999. SQ1364.2 +081300 GO TO CLOSE-FILES. SQ1364.2 +*END-OF,SQ136A +*HEADER,COBOL,SQ137A +000100 IDENTIFICATION DIVISION. SQ1374.2 +000200 PROGRAM-ID. SQ1374.2 +000300 SQ137A. SQ1374.2 +000400**************************************************************** SQ1374.2 +000500* * SQ1374.2 +000600* VALIDATION FOR:- * SQ1374.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1374.2 +000900* REVISED 1986, AUGUST * SQ1374.2 +001000* * SQ1374.2 +001100* CREATION DATE / VALIDATION DATE * SQ1374.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1374.2 +001300* * SQ1374.2 +001400**************************************************************** SQ1374.2 +001500* * SQ1374.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1374.2 +001700* * SQ1374.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1374.2 +001900* X-55 SYSTEM PRINTER * SQ1374.2 +002000* X-82 SOURCE-COMPUTER * SQ1374.2 +002100* X-83 OBJECT-COMPUTER. * SQ1374.2 +002200* * SQ1374.2 +002300**************************************************************** SQ1374.2 +002400* * SQ1374.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1374.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1374.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1374.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1374.2 +002900* * SQ1374.2 +003000**************************************************************** SQ1374.2 +003100* SQ1374.2 +003200 ENVIRONMENT DIVISION. SQ1374.2 +003300 CONFIGURATION SECTION. SQ1374.2 +003400 SOURCE-COMPUTER. SQ1374.2 +003500 XXXXX082. SQ1374.2 +003600 OBJECT-COMPUTER. SQ1374.2 +003700 XXXXX083. SQ1374.2 +003800* SQ1374.2 +003900 INPUT-OUTPUT SECTION. SQ1374.2 +004000 FILE-CONTROL. SQ1374.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1374.2 +004200 XXXXX055. SQ1374.2 +004300* SQ1374.2 +004400P SELECT RAW-DATA ASSIGN TO SQ1374.2 +004500P XXXXX062 SQ1374.2 +004600P ORGANIZATION IS INDEXED SQ1374.2 +004700P ACCESS MODE IS RANDOM SQ1374.2 +004800P RECORD-KEY IS RAW-DATA-KEY. SQ1374.2 +004900P SQ1374.2 +005000 SELECT SQ-FS4 ASSIGN SQ1374.2 +005100 XXXXX014 SQ1374.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1374.2 +005300* SQ1374.2 +005400* SQ1374.2 +005500 DATA DIVISION. SQ1374.2 +005600 FILE SECTION. SQ1374.2 +005700 FD PRINT-FILE SQ1374.2 +005800C LABEL RECORDS SQ1374.2 +005900C XXXXX084 SQ1374.2 +006000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1374.2 +006100 . SQ1374.2 +006200 01 PRINT-REC PICTURE X(120). SQ1374.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1374.2 +006400P SQ1374.2 +006500PFD RAW-DATA. SQ1374.2 +006600P01 RAW-DATA-SATZ. SQ1374.2 +006700P 05 RAW-DATA-KEY PIC X(6). SQ1374.2 +006800P 05 C-DATE PIC 9(6). SQ1374.2 +006900P 05 C-TIME PIC 9(8). SQ1374.2 +007000P 05 NO-OF-TESTS PIC 99. SQ1374.2 +007100P 05 C-OK PIC 999. SQ1374.2 +007200P 05 C-ALL PIC 999. SQ1374.2 +007300P 05 C-FAIL PIC 999. SQ1374.2 +007400P 05 C-DELETED PIC 999. SQ1374.2 +007500P 05 C-INSPECT PIC 999. SQ1374.2 +007600P 05 C-NOTE PIC X(13). SQ1374.2 +007700P 05 C-INDENT PIC X. SQ1374.2 +007800P 05 C-ABORT PIC X(8). SQ1374.2 +007900* SQ1374.2 +008000 FD SQ-FS4 SQ1374.2 +008100C LABEL RECORD IS STANDARD SQ1374.2 +008200 BLOCK 2 RECORDS SQ1374.2 +008300 RECORD 125 SQ1374.2 +008400 . SQ1374.2 +008500 01 SQ-FS4R1-F-G-125. SQ1374.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1374.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1374.2 +008800* SQ1374.2 +008900 WORKING-STORAGE SECTION. SQ1374.2 +009000* SQ1374.2 +009100*************************************************************** SQ1374.2 +009200* * SQ1374.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1374.2 +009400* * SQ1374.2 +009500*************************************************************** SQ1374.2 +009600* SQ1374.2 +009700 01 SQ-FS4-STATUS. SQ1374.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1374.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1374.2 +010000* SQ1374.2 +010100 01 DELETE-SW. SQ1374.2 +010200 03 DELETE-SW-1 PIC X. SQ1374.2 +010300 03 DELETE-SW-1-GROUP. SQ1374.2 +010400 05 DELETE-SW-2 PIC X. SQ1374.2 +010500* SQ1374.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1374.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1374.2 +010800 01 DECL-EXEC-SW PIC X. SQ1374.2 +010900* SQ1374.2 +011000*************************************************************** SQ1374.2 +011100* * SQ1374.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1374.2 +011300* * SQ1374.2 +011400*************************************************************** SQ1374.2 +011500* SQ1374.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1374.2 +011700* SQ1374.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1374.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1374.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1374.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1374.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1374.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1374.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1374.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1374.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1374.2 +012700 ",RECKEY= ". SQ1374.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1374.2 +012900 ",ALTKEY1= ". SQ1374.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1374.2 +013100 ",ALTKEY2= ". SQ1374.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1374.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1374.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1374.2 +013500 07 FILLER PIC X(5). SQ1374.2 +013600 07 XFILE-NAME PIC X(6). SQ1374.2 +013700 07 FILLER PIC X(8). SQ1374.2 +013800 07 XRECORD-NAME PIC X(6). SQ1374.2 +013900 07 FILLER PIC X(1). SQ1374.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1374.2 +014100 07 FILLER PIC X(7). SQ1374.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1374.2 +014300 07 FILLER PIC X(6). SQ1374.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1374.2 +014500 07 FILLER PIC X(5). SQ1374.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1374.2 +014700 07 FILLER PIC X(5). SQ1374.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1374.2 +014900 07 FILLER PIC X(7). SQ1374.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1374.2 +015100 07 FILLER PIC X(7). SQ1374.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1374.2 +015300 07 FILLER PIC X(1). SQ1374.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1374.2 +015500 07 FILLER PIC X(6). SQ1374.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1374.2 +015700 07 FILLER PIC X(5). SQ1374.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1374.2 +015900 07 FILLER PIC X(6). SQ1374.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1374.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1374.2 +016200 07 FILLER PIC X(8). SQ1374.2 +016300 07 XRECORD-KEY PIC X(29). SQ1374.2 +016400 07 FILLER PIC X(9). SQ1374.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1374.2 +016600 07 FILLER PIC X(9). SQ1374.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1374.2 +016800 07 FILLER PIC X(7). SQ1374.2 +016900* SQ1374.2 +017000 01 TEST-RESULTS. SQ1374.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017200 02 PAR-NAME. SQ1374.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1374.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1374.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1374.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1374.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1374.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1374.2 +018100 02 RE-MARK PIC X(61). SQ1374.2 +018200 01 TEST-COMPUTED. SQ1374.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1374.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1374.2 +018500 02 COMPUTED-X. SQ1374.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1374.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1374.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1374.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1374.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1374.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1374.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1374.2 +019300 04 FILLER PIC X. SQ1374.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1374.2 +019500 01 TEST-CORRECT. SQ1374.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1374.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1374.2 +019800 02 CORRECT-X. SQ1374.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1374.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1374.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1374.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1374.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1374.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1374.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1374.2 +020600 04 FILLER PIC X. SQ1374.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1374.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1374.2 +020900* SQ1374.2 +021000 01 CCVS-C-1. SQ1374.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1374.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1374.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1374.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1374.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1374.2 +021900 01 CCVS-C-2. SQ1374.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1374.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1374.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1374.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1374.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1374.2 +022500* SQ1374.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1374.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1374.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1374.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1374.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1374.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1374.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1374.2 +023700 01 CCVS-H-1. SQ1374.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1374.2 +023900 02 FILLER PIC X(42) VALUE SQ1374.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1374.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1374.2 +024200 01 CCVS-H-2A. SQ1374.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1374.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1374.2 +024500 02 FILLER PIC XXXX VALUE SQ1374.2 +024600 "4.2 ". SQ1374.2 +024700 02 FILLER PIC X(28) VALUE SQ1374.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1374.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1374.2 +025000* SQ1374.2 +025100 01 CCVS-H-2B. SQ1374.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1374.2 +025300 02 TEST-ID PIC X(9). SQ1374.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1374.2 +025500 02 FILLER PIC X(12) VALUE SQ1374.2 +025600 " HIGH ". SQ1374.2 +025700 02 FILLER PIC X(22) VALUE SQ1374.2 +025800 " LEVEL VALIDATION FOR ". SQ1374.2 +025900 02 FILLER PIC X(58) VALUE SQ1374.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +026100 01 CCVS-H-3. SQ1374.2 +026200 02 FILLER PIC X(34) VALUE SQ1374.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1374.2 +026400 02 FILLER PIC X(58) VALUE SQ1374.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1374.2 +026600 02 FILLER PIC X(28) VALUE SQ1374.2 +026700 " COPYRIGHT 1985,1986 ". SQ1374.2 +026800 01 CCVS-E-1. SQ1374.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1374.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1374.2 +027100 02 ID-AGAIN PIC X(9). SQ1374.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1374.2 +027300 01 CCVS-E-2. SQ1374.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1374.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1374.2 +027600 02 CCVS-E-2-2. SQ1374.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1374.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1374.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1374.2 +028000 "ERRORS ENCOUNTERED". SQ1374.2 +028100 01 CCVS-E-3. SQ1374.2 +028200 02 FILLER PIC X(22) VALUE SQ1374.2 +028300 " FOR OFFICIAL USE ONLY". SQ1374.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1374.2 +028500 02 FILLER PIC X(58) VALUE SQ1374.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1374.2 +028800 02 FILLER PIC X(20) VALUE SQ1374.2 +028900 " COPYRIGHT 1985,1986". SQ1374.2 +029000 01 CCVS-E-4. SQ1374.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1374.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1374.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1374.2 +029400 02 FILLER PIC X(40) VALUE SQ1374.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1374.2 +029600 01 XXINFO. SQ1374.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1374.2 +029800 02 INFO-TEXT. SQ1374.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1374.2 +030000 04 XXCOMPUTED PIC X(20). SQ1374.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1374.2 +030200 04 XXCORRECT PIC X(20). SQ1374.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1374.2 +030400 01 HYPHEN-LINE. SQ1374.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1374.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1374.2 +030700- "*****************************************". SQ1374.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1374.2 +030900- "******************************". SQ1374.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1374.2 +031100 "SQ137A". SQ1374.2 +031200* SQ1374.2 +031300* SQ1374.2 +031400 PROCEDURE DIVISION. SQ1374.2 +031500 DECLARATIVES. SQ1374.2 +031600* SQ1374.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1374.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1374.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1374.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1374.2 +032100* SQ1374.2 +032200 SECT-SQ137A-0000 SECTION. SQ1374.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1374.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1374.2 +032500 EXIT. SQ1374.2 +032600* SQ1374.2 +032700 SECT-SQ137A-0001 SECTION. SQ1374.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1374.2 +032900 OUTPUT-ERROR-PROCESS. SQ1374.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1374.2 +033100* SQ1374.2 +033200 SECT-SQ137A-0002 SECTION. SQ1374.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1374.2 +033400 INPUT-ERROR-PROCESS. SQ1374.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1374.2 +033600* SQ1374.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1374.2 +033800 GO TO END-DECLS. SQ1374.2 +033900* SQ1374.2 +034000 MOVE 1 TO REC-CT. SQ1374.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1374.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1374.2 +034300 GO TO DECL-EOF-READ-01. SQ1374.2 +034400 DECL-DELETE-01. SQ1374.2 +034500 PERFORM DECL-DE-LETE. SQ1374.2 +034600 GO TO DECL-TEST-01-END. SQ1374.2 +034700 DECL-EOF-READ-01. SQ1374.2 +034800 DECL-TEST-01-END. SQ1374.2 +034900* SQ1374.2 +035000 ADD 1 TO REC-CT. SQ1374.2 +035100 GO TO DECL-EOF-READ-02. SQ1374.2 +035200 DECL-DELETE-02. SQ1374.2 +035300 PERFORM DECL-DE-LETE. SQ1374.2 +035400 GO TO DECL-TEST-02-END. SQ1374.2 +035500 DECL-EOF-READ-02. SQ1374.2 +035600 DECL-TEST-02-END. SQ1374.2 +035700* SQ1374.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +035900 PERFORM DECL-WRITE-LINE. SQ1374.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1374.2 +036100 TO DUMMY-RECORD. SQ1374.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1374.2 +036300 GO TO END-DECLS. SQ1374.2 +036400* SQ1374.2 +036500* SQ1374.2 +036600 DECL-PASS. SQ1374.2 +036700 MOVE "PASS " TO P-OR-F. SQ1374.2 +036800 ADD 1 TO PASS-COUNTER. SQ1374.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +037000* SQ1374.2 +037100 DECL-FAIL. SQ1374.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1374.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1374.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +037500* SQ1374.2 +037600 DECL-DE-LETE. SQ1374.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1374.2 +037800 MOVE "*****" TO P-OR-F. SQ1374.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1374.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +038100* SQ1374.2 +038200 DECL-PRINT-DETAIL. SQ1374.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1374.2 +038400 MOVE "." TO PARDOT-X SQ1374.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1374.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1374.2 +038700 PERFORM DECL-WRITE-LINE. SQ1374.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1374.2 +038900 PERFORM DECL-WRITE-LINE SQ1374.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1374.2 +039100 ELSE SQ1374.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1374.2 +039300 MOVE SPACE TO P-OR-F. SQ1374.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1374.2 +039500 MOVE SPACE TO CORRECT-X. SQ1374.2 +039600 IF REC-CT EQUAL TO ZERO SQ1374.2 +039700 MOVE SPACE TO PAR-NAME. SQ1374.2 +039800 MOVE SPACE TO RE-MARK. SQ1374.2 +039900* SQ1374.2 +040000 DECL-WRITE-LINE. SQ1374.2 +040100 ADD 1 TO RECORD-COUNT. SQ1374.2 +040200Y IF RECORD-COUNT GREATER 50 SQ1374.2 +040300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1374.2 +040400Y MOVE SPACE TO DUMMY-RECORD SQ1374.2 +040500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1374.2 +040600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1374.2 +040700Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1374.2 +040800Y PERFORM DECL-WRT-LN 2 TIMES SQ1374.2 +040900Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1374.2 +041000Y PERFORM DECL-WRT-LN SQ1374.2 +041100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1374.2 +041200Y MOVE ZERO TO RECORD-COUNT. SQ1374.2 +041300 PERFORM DECL-WRT-LN. SQ1374.2 +041400* SQ1374.2 +041500 DECL-WRT-LN. SQ1374.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1374.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +041800* SQ1374.2 +041900 DECL-FAIL-ROUTINE. SQ1374.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1374.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1374.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1374.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +042700 GO TO DECL-FAIL-EX. SQ1374.2 +042800 DECL-FAIL-WRITE. SQ1374.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1374.2 +043000 PERFORM DECL-WRITE-LINE SQ1374.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1374.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1374.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1374.2 +043500 DECL-FAIL-EX. SQ1374.2 +043600 EXIT. SQ1374.2 +043700* SQ1374.2 +043800 DECL-BAIL. SQ1374.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1374.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1374.2 +044100 DECL-BAIL-WRITE. SQ1374.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1374.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1374.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +044600 DECL-BAIL-EX. SQ1374.2 +044700 EXIT. SQ1374.2 +044800* SQ1374.2 +044900 END-DECLS. SQ1374.2 +045000 END DECLARATIVES. SQ1374.2 +045100* SQ1374.2 +045200* SQ1374.2 +045300 CCVS1 SECTION. SQ1374.2 +045400 OPEN-FILES. SQ1374.2 +045500P OPEN I-O RAW-DATA. SQ1374.2 +045600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1374.2 +045700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1374.2 +045800P MOVE "ABORTED " TO C-ABORT. SQ1374.2 +045900P ADD 1 TO C-NO-OF-TESTS. SQ1374.2 +046000P ACCEPT C-DATE FROM DATE. SQ1374.2 +046100P ACCEPT C-TIME FROM TIME. SQ1374.2 +046200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1374.2 +046300PEND-E-1. SQ1374.2 +046400P CLOSE RAW-DATA. SQ1374.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1374.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1374.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1374.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1374.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1374.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1374.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1374.2 +047200 GO TO CCVS1-EXIT. SQ1374.2 +047300* SQ1374.2 +047400 CCVS-INIT-FILE. SQ1374.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1374.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1374.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1374.2 +047800* SQ1374.2 +047900 CLOSE-FILES. SQ1374.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1374.2 +048100 CLOSE PRINT-FILE. SQ1374.2 +048200P OPEN I-O RAW-DATA. SQ1374.2 +048300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1374.2 +048400P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1374.2 +048500P MOVE "OK. " TO C-ABORT. SQ1374.2 +048600P MOVE PASS-COUNTER TO C-OK. SQ1374.2 +048700P MOVE ERROR-HOLD TO C-ALL. SQ1374.2 +048800P MOVE ERROR-COUNTER TO C-FAIL. SQ1374.2 +048900P MOVE DELETE-CNT TO C-DELETED. SQ1374.2 +049000P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1374.2 +049100P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1374.2 +049200PEND-E-2. SQ1374.2 +049300P CLOSE RAW-DATA. SQ1374.2 +049400 TERMINATE-CCVS. SQ1374.2 +049500S EXIT PROGRAM. SQ1374.2 +049600 STOP RUN. SQ1374.2 +049700* SQ1374.2 +049800 INSPT. SQ1374.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1374.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1374.2 +050100 PERFORM PRINT-DETAIL. SQ1374.2 +050200* SQ1374.2 +050300 PASS. SQ1374.2 +050400 MOVE "PASS " TO P-OR-F. SQ1374.2 +050500 ADD 1 TO PASS-COUNTER. SQ1374.2 +050600 PERFORM PRINT-DETAIL. SQ1374.2 +050700* SQ1374.2 +050800 FAIL. SQ1374.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1374.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1374.2 +051100 PERFORM PRINT-DETAIL. SQ1374.2 +051200* SQ1374.2 +051300 DE-LETE. SQ1374.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1374.2 +051500 MOVE "*****" TO P-OR-F. SQ1374.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1374.2 +051700 PERFORM PRINT-DETAIL. SQ1374.2 +051800* SQ1374.2 +051900 PRINT-DETAIL. SQ1374.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1374.2 +052100 MOVE "." TO PARDOT-X SQ1374.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1374.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1374.2 +052400 PERFORM WRITE-LINE. SQ1374.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1374.2 +052600 PERFORM WRITE-LINE SQ1374.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1374.2 +052800 ELSE SQ1374.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1374.2 +053000 MOVE SPACE TO P-OR-F. SQ1374.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1374.2 +053200 MOVE SPACE TO CORRECT-X. SQ1374.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1374.2 +053400 MOVE SPACE TO RE-MARK. SQ1374.2 +053500* SQ1374.2 +053600 HEAD-ROUTINE. SQ1374.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1374.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1374.2 +054100 COLUMN-NAMES-ROUTINE. SQ1374.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +054500 END-ROUTINE. SQ1374.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1374.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1374.2 +054800 END-RTN-EXIT. SQ1374.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1374.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +055100* SQ1374.2 +055200 END-ROUTINE-1. SQ1374.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1374.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1374.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1374.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1374.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1374.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1374.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1374.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1374.2 +056100 PERFORM WRITE-LINE. SQ1374.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1374.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1374.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +056500 ELSE SQ1374.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1374.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1374.2 +056800 PERFORM WRITE-LINE. SQ1374.2 +056900 END-ROUTINE-13. SQ1374.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1374.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +057200 ELSE SQ1374.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1374.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1374.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1374.2 +057600 PERFORM WRITE-LINE. SQ1374.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1374.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +057900 ELSE SQ1374.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1374.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1374.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +058400* SQ1374.2 +058500 WRITE-LINE. SQ1374.2 +058600 ADD 1 TO RECORD-COUNT. SQ1374.2 +058700Y IF RECORD-COUNT GREATER 50 SQ1374.2 +058800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1374.2 +058900Y MOVE SPACE TO DUMMY-RECORD SQ1374.2 +059000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1374.2 +059100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1374.2 +059200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1374.2 +059300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1374.2 +059400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1374.2 +059500Y MOVE ZERO TO RECORD-COUNT. SQ1374.2 +059600 PERFORM WRT-LN. SQ1374.2 +059700* SQ1374.2 +059800 WRT-LN. SQ1374.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1374.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +060100 BLANK-LINE-PRINT. SQ1374.2 +060200 PERFORM WRT-LN. SQ1374.2 +060300 FAIL-ROUTINE. SQ1374.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1374.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1374.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1374.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1374.2 +061200 FAIL-ROUTINE-WRITE. SQ1374.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1374.2 +061400 PERFORM WRITE-LINE SQ1374.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1374.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1374.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1374.2 +061900 FAIL-ROUTINE-EX. SQ1374.2 +062000 EXIT. SQ1374.2 +062100 BAIL-OUT. SQ1374.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1374.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1374.2 +062400 BAIL-OUT-WRITE. SQ1374.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1374.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1374.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +063100 BAIL-OUT-EX. SQ1374.2 +063200 EXIT. SQ1374.2 +063300 CCVS1-EXIT. SQ1374.2 +063400 EXIT. SQ1374.2 +063500* SQ1374.2 +063600**************************************************************** SQ1374.2 +063700* * SQ1374.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1374.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1374.2 +064000* * SQ1374.2 +064100**************************************************************** SQ1374.2 +064200* SQ1374.2 +064300 SECT-SQ137A-0004 SECTION. SQ1374.2 +064400 STA-INIT. SQ1374.2 +064500 MOVE SPACE TO DELETE-SW. SQ1374.2 +064600* SQ1374.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1374.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1374.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1374.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1374.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1374.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1374.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1374.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1374.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1374.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1374.2 +065700* SQ1374.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1374.2 +065900* SQ1374.2 +066000 SEQ-INIT-01. SQ1374.2 +066100 MOVE 0 TO REC-CT. SQ1374.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1374.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1374.2 +066800 GO TO SEQ-TEST-OP-01. SQ1374.2 +066900 SEQ-DELETE-01. SQ1374.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1374.2 +067100 SEQ-TEST-OP-01. SQ1374.2 +067200 OPEN OUTPUT SQ-FS4. SQ1374.2 +067300* SQ1374.2 +067400* SQ1374.2 +067500* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1374.2 +067600* SQ1374.2 +067700 SEQ-INIT-02. SQ1374.2 +067800 MOVE 0 TO REC-CT. SQ1374.2 +067900 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +068300 ADD 1 TO XRECORD-NUMBER (1). SQ1374.2 +068400 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1374.2 +068500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1374.2 +068600 IF DELETE-SW NOT EQUAL TO SPACE SQ1374.2 +068700 GO TO SEQ-DELETE-02. SQ1374.2 +068800 GO TO SEQ-TEST-WR-02. SQ1374.2 +068900 SEQ-DELETE-02. SQ1374.2 +069000 MOVE "*" TO DELETE-SW-2. SQ1374.2 +069100 SEQ-TEST-WR-02. SQ1374.2 +069200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1374.2 +069300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1374.2 +069400 WRITE SQ-FS4R1-F-G-125. SQ1374.2 +069500* SQ1374.2 +069600* SQ1374.2 +069700* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1374.2 +069800* SQ1374.2 +069900 SEQ-INIT-03. SQ1374.2 +070000 MOVE 0 TO REC-CT. SQ1374.2 +070100 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +070400 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +070500 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1374.2 +070600 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1374.2 +070700 IF DELETE-SW NOT EQUAL TO SPACE SQ1374.2 +070800 GO TO SEQ-DELETE-03. SQ1374.2 +070900 GO TO SEQ-TEST-CL-03. SQ1374.2 +071000 SEQ-DELETE-03. SQ1374.2 +071100 MOVE "*" TO DELETE-SW-2. SQ1374.2 +071200 SEQ-TEST-CL-03. SQ1374.2 +071300 CLOSE SQ-FS4. SQ1374.2 +071400* SQ1374.2 +071500* SQ1374.2 +071600* CREATION OF THE FILE IS NOW COMPLETE. THE NEXT ACTION SQ1374.2 +071700* IS TO OPEN THE FILE IN THE OUTPUT MODE SQ1374.2 +071800* SQ1374.2 +071900 SEQ-INIT-04. SQ1374.2 +072000 MOVE 0 TO REC-CT. SQ1374.2 +072100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1374.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +072500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +072600 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1374.2 +072700 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1374.2 +072800 IF DELETE-SW NOT = SPACE SQ1374.2 +072900 GO TO SEQ-DELETE-04. SQ1374.2 +073000 GO TO SEQ-TEST-OP-04. SQ1374.2 +073100 SEQ-DELETE-04. SQ1374.2 +073200 MOVE "*" TO DELETE-SW-2. SQ1374.2 +073300 SEQ-TEST-OP-04. SQ1374.2 +073400* SQ1374.2 +073500* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1374.2 +073600* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1374.2 +073700* THE LAST RECORD WRITTEN IN IT. SQ1374.2 +073800* SQ1374.2 +073900 OPEN INPUT SQ-FS4. SQ1374.2 +074000 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1374.2 +074100* SQ1374.2 +074200* SQ1374.2 +074300* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1374.2 +074400* SQ1374.2 +074500 SEQ-INIT-05. SQ1374.2 +074600 MOVE 0 TO REC-CT. SQ1374.2 +074700 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +074800 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +074900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +075000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +075100 MOVE "READ FIRST RECORD" TO FEATURE. SQ1374.2 +075200 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1374.2 +075300 IF DELETE-SW NOT = SPACE SQ1374.2 +075400 GO TO SEQ-DELETE-05. SQ1374.2 +075500 GO TO SEQ-TEST-RD-05. SQ1374.2 +075600 SEQ-DELETE-05. SQ1374.2 +075700 MOVE "*" TO DELETE-SW-2. SQ1374.2 +075800 SEQ-TEST-RD-05. SQ1374.2 +075900 READ SQ-FS4. SQ1374.2 +076000 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1374.2 +076100* SQ1374.2 +076200* SQ1374.2 +076300* READ AGAIN, TO RAISE THE AT END CONDITION SQ1374.2 +076400* SQ1374.2 +076500 SEQ-INIT-06. SQ1374.2 +076600 MOVE 0 TO REC-CT. SQ1374.2 +076700 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +076800 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +076900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +077000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +077100 MOVE "READ, GIVING AT END" TO FEATURE. SQ1374.2 +077200 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1374.2 +077300 IF DELETE-SW NOT = SPACE SQ1374.2 +077400 GO TO SEQ-DELETE-06. SQ1374.2 +077500 GO TO SEQ-TEST-RD-06. SQ1374.2 +077600 SEQ-DELETE-06. SQ1374.2 +077700 MOVE "*" TO DELETE-SW-2. SQ1374.2 +077800 SEQ-TEST-RD-06. SQ1374.2 +077900 READ SQ-FS4. SQ1374.2 +078000* SQ1374.2 +078100* SQ1374.2 +078200* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1374.2 +078300* SQ1374.2 +078400 SEQ-INIT-07. SQ1374.2 +078500 MOVE 0 TO REC-CT. SQ1374.2 +078600 MOVE SPACE TO DECL-EXEC-SW. SQ1374.2 +078700 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +078800 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +078900 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +079000 MOVE "READ AFTER AT END" TO FEATURE. SQ1374.2 +079100 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1374.2 +079200 IF DELETE-SW NOT = SPACE SQ1374.2 +079300 GO TO SEQ-DELETE-07. SQ1374.2 +079400 GO TO SEQ-TEST-RD-07. SQ1374.2 +079500 SEQ-DELETE-07. SQ1374.2 +079600 MOVE "*" TO DELETE-SW-2. SQ1374.2 +079700 SEQ-TEST-RD-07. SQ1374.2 +079800 READ SQ-FS4. SQ1374.2 +079900* SQ1374.2 +080000* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1374.2 +080100* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1374.2 +080200* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1374.2 +080300* SQ1374.2 +080400 MOVE ZERO TO REC-CT. SQ1374.2 +080500 MOVE "READ AFTER AT END" TO FEATURE. SQ1374.2 +080600 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1374.2 +080700* SQ1374.2 +080800* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1374.2 +080900* SQ1374.2 +081000 ADD 1 TO REC-CT. SQ1374.2 +081100 SEQ-TEST-07-01-END. SQ1374.2 +081200* SQ1374.2 +081300* CHECK EXECUTION OF INPUT DECLARATIVE SQ1374.2 +081400* SQ1374.2 +081500 ADD 1 TO REC-CT. SQ1374.2 +081600 IF DELETE-SW NOT = SPACE SQ1374.2 +081700 GO TO SEQ-DELETE-07-02. SQ1374.2 +081800 GO TO SEQ-TEST-RD-07-02. SQ1374.2 +081900 SEQ-DELETE-07-02. SQ1374.2 +082000 PERFORM DE-LETE. SQ1374.2 +082100 GO TO SEQ-TEST-07-02-END. SQ1374.2 +082200 SEQ-TEST-RD-07-02. SQ1374.2 +082300 IF DECL-EXEC-I = "EXECUTED" SQ1374.2 +082400 PERFORM PASS SQ1374.2 +082500 ELSE SQ1374.2 +082600 MOVE DECL-EXEC-I TO COMPUTED-A SQ1374.2 +082700 MOVE "EXECUTED" TO CORRECT-A SQ1374.2 +082800 MOVE "INPUT DECLARATIVE NOT EXECUTED" SQ1374.2 +082900 TO RE-MARK SQ1374.2 +083000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1374.2 +083100 PERFORM FAIL. SQ1374.2 +083200 SEQ-TEST-07-02-END. SQ1374.2 +083300 CCVS-EXIT SECTION. SQ1374.2 +083400 CCVS-999999. SQ1374.2 +083500 GO TO CLOSE-FILES. SQ1374.2 +*END-OF,SQ137A +*HEADER,COBOL,SQ138A +000100 IDENTIFICATION DIVISION. SQ1384.2 +000200 PROGRAM-ID. SQ1384.2 +000300 SQ138A. SQ1384.2 +000400**************************************************************** SQ1384.2 +000500* * SQ1384.2 +000600* VALIDATION FOR:- * SQ1384.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1384.2 +000900* REVISED 1986, AUGUST * SQ1384.2 +001000* * SQ1384.2 +001100* CREATION DATE / VALIDATION DATE * SQ1384.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1384.2 +001300* * SQ1384.2 +001400**************************************************************** SQ1384.2 +001500* * SQ1384.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1384.2 +001700* * SQ1384.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1384.2 +001900* X-55 SYSTEM PRINTER * SQ1384.2 +002000* X-82 SOURCE-COMPUTER * SQ1384.2 +002100* X-83 OBJECT-COMPUTER. * SQ1384.2 +002200* * SQ1384.2 +002300**************************************************************** SQ1384.2 +002400* * SQ1384.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1384.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1384.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1384.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1384.2 +002900* * SQ1384.2 +003000**************************************************************** SQ1384.2 +003100* SQ1384.2 +003200 ENVIRONMENT DIVISION. SQ1384.2 +003300 CONFIGURATION SECTION. SQ1384.2 +003400 SOURCE-COMPUTER. SQ1384.2 +003500 XXXXX082. SQ1384.2 +003600 OBJECT-COMPUTER. SQ1384.2 +003700 XXXXX083. SQ1384.2 +003800* SQ1384.2 +003900 INPUT-OUTPUT SECTION. SQ1384.2 +004000 FILE-CONTROL. SQ1384.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1384.2 +004200 XXXXX055. SQ1384.2 +004300* SQ1384.2 +004400P SELECT RAW-DATA ASSIGN TO SQ1384.2 +004500P XXXXX062 SQ1384.2 +004600P ORGANIZATION IS INDEXED SQ1384.2 +004700P ACCESS MODE IS RANDOM SQ1384.2 +004800P RECORD-KEY IS RAW-DATA-KEY. SQ1384.2 +004900P SQ1384.2 +005000 SELECT SQ-FS4 ASSIGN SQ1384.2 +005100 XXXXX014 SQ1384.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1384.2 +005300* SQ1384.2 +005400* SQ1384.2 +005500 DATA DIVISION. SQ1384.2 +005600 FILE SECTION. SQ1384.2 +005700 FD PRINT-FILE SQ1384.2 +005800C LABEL RECORDS SQ1384.2 +005900C XXXXX084 SQ1384.2 +006000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1384.2 +006100 . SQ1384.2 +006200 01 PRINT-REC PICTURE X(120). SQ1384.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1384.2 +006400P SQ1384.2 +006500PFD RAW-DATA. SQ1384.2 +006600P01 RAW-DATA-SATZ. SQ1384.2 +006700P 05 RAW-DATA-KEY PIC X(6). SQ1384.2 +006800P 05 C-DATE PIC 9(6). SQ1384.2 +006900P 05 C-TIME PIC 9(8). SQ1384.2 +007000P 05 NO-OF-TESTS PIC 99. SQ1384.2 +007100P 05 C-OK PIC 999. SQ1384.2 +007200P 05 C-ALL PIC 999. SQ1384.2 +007300P 05 C-FAIL PIC 999. SQ1384.2 +007400P 05 C-DELETED PIC 999. SQ1384.2 +007500P 05 C-INSPECT PIC 999. SQ1384.2 +007600P 05 C-NOTE PIC X(13). SQ1384.2 +007700P 05 C-INDENT PIC X. SQ1384.2 +007800P 05 C-ABORT PIC X(8). SQ1384.2 +007900* SQ1384.2 +008000 FD SQ-FS4 SQ1384.2 +008100C LABEL RECORD IS STANDARD SQ1384.2 +008200 BLOCK 2 RECORDS SQ1384.2 +008300 RECORD 125 SQ1384.2 +008400 . SQ1384.2 +008500 01 SQ-FS4R1-F-G-125. SQ1384.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1384.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1384.2 +008800* SQ1384.2 +008900 WORKING-STORAGE SECTION. SQ1384.2 +009000* SQ1384.2 +009100*************************************************************** SQ1384.2 +009200* * SQ1384.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1384.2 +009400* * SQ1384.2 +009500*************************************************************** SQ1384.2 +009600* SQ1384.2 +009700 01 SQ-FS4-STATUS. SQ1384.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1384.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1384.2 +010000* SQ1384.2 +010100 01 DELETE-SW. SQ1384.2 +010200 03 DELETE-SW-1 PIC X. SQ1384.2 +010300 03 DELETE-SW-1-GROUP. SQ1384.2 +010400 05 DELETE-SW-2 PIC X. SQ1384.2 +010500* SQ1384.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1384.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1384.2 +010800 01 DECL-EXEC-SW PIC X. SQ1384.2 +010900* SQ1384.2 +011000*************************************************************** SQ1384.2 +011100* * SQ1384.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1384.2 +011300* * SQ1384.2 +011400*************************************************************** SQ1384.2 +011500* SQ1384.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1384.2 +011700* SQ1384.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1384.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1384.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1384.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1384.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1384.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1384.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1384.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1384.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1384.2 +012700 ",RECKEY= ". SQ1384.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1384.2 +012900 ",ALTKEY1= ". SQ1384.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1384.2 +013100 ",ALTKEY2= ". SQ1384.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1384.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1384.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1384.2 +013500 07 FILLER PIC X(5). SQ1384.2 +013600 07 XFILE-NAME PIC X(6). SQ1384.2 +013700 07 FILLER PIC X(8). SQ1384.2 +013800 07 XRECORD-NAME PIC X(6). SQ1384.2 +013900 07 FILLER PIC X(1). SQ1384.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1384.2 +014100 07 FILLER PIC X(7). SQ1384.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1384.2 +014300 07 FILLER PIC X(6). SQ1384.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1384.2 +014500 07 FILLER PIC X(5). SQ1384.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1384.2 +014700 07 FILLER PIC X(5). SQ1384.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1384.2 +014900 07 FILLER PIC X(7). SQ1384.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1384.2 +015100 07 FILLER PIC X(7). SQ1384.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1384.2 +015300 07 FILLER PIC X(1). SQ1384.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1384.2 +015500 07 FILLER PIC X(6). SQ1384.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1384.2 +015700 07 FILLER PIC X(5). SQ1384.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1384.2 +015900 07 FILLER PIC X(6). SQ1384.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1384.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1384.2 +016200 07 FILLER PIC X(8). SQ1384.2 +016300 07 XRECORD-KEY PIC X(29). SQ1384.2 +016400 07 FILLER PIC X(9). SQ1384.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1384.2 +016600 07 FILLER PIC X(9). SQ1384.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1384.2 +016800 07 FILLER PIC X(7). SQ1384.2 +016900* SQ1384.2 +017000 01 TEST-RESULTS. SQ1384.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017200 02 PAR-NAME. SQ1384.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1384.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1384.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1384.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1384.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1384.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1384.2 +018100 02 RE-MARK PIC X(61). SQ1384.2 +018200 01 TEST-COMPUTED. SQ1384.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1384.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1384.2 +018500 02 COMPUTED-X. SQ1384.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1384.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1384.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1384.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1384.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1384.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1384.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1384.2 +019300 04 FILLER PIC X. SQ1384.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1384.2 +019500 01 TEST-CORRECT. SQ1384.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1384.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1384.2 +019800 02 CORRECT-X. SQ1384.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1384.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1384.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1384.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1384.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1384.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1384.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1384.2 +020600 04 FILLER PIC X. SQ1384.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1384.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1384.2 +020900* SQ1384.2 +021000 01 CCVS-C-1. SQ1384.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1384.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1384.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1384.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1384.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1384.2 +021900 01 CCVS-C-2. SQ1384.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1384.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1384.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1384.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1384.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1384.2 +022500* SQ1384.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1384.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1384.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1384.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1384.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1384.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1384.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1384.2 +023700 01 CCVS-H-1. SQ1384.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1384.2 +023900 02 FILLER PIC X(42) VALUE SQ1384.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1384.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1384.2 +024200 01 CCVS-H-2A. SQ1384.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1384.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1384.2 +024500 02 FILLER PIC XXXX VALUE SQ1384.2 +024600 "4.2 ". SQ1384.2 +024700 02 FILLER PIC X(28) VALUE SQ1384.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1384.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1384.2 +025000* SQ1384.2 +025100 01 CCVS-H-2B. SQ1384.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1384.2 +025300 02 TEST-ID PIC X(9). SQ1384.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1384.2 +025500 02 FILLER PIC X(12) VALUE SQ1384.2 +025600 " HIGH ". SQ1384.2 +025700 02 FILLER PIC X(22) VALUE SQ1384.2 +025800 " LEVEL VALIDATION FOR ". SQ1384.2 +025900 02 FILLER PIC X(58) VALUE SQ1384.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +026100 01 CCVS-H-3. SQ1384.2 +026200 02 FILLER PIC X(34) VALUE SQ1384.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1384.2 +026400 02 FILLER PIC X(58) VALUE SQ1384.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1384.2 +026600 02 FILLER PIC X(28) VALUE SQ1384.2 +026700 " COPYRIGHT 1985,1986 ". SQ1384.2 +026800 01 CCVS-E-1. SQ1384.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1384.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1384.2 +027100 02 ID-AGAIN PIC X(9). SQ1384.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1384.2 +027300 01 CCVS-E-2. SQ1384.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1384.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1384.2 +027600 02 CCVS-E-2-2. SQ1384.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1384.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1384.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1384.2 +028000 "ERRORS ENCOUNTERED". SQ1384.2 +028100 01 CCVS-E-3. SQ1384.2 +028200 02 FILLER PIC X(22) VALUE SQ1384.2 +028300 " FOR OFFICIAL USE ONLY". SQ1384.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1384.2 +028500 02 FILLER PIC X(58) VALUE SQ1384.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1384.2 +028800 02 FILLER PIC X(20) VALUE SQ1384.2 +028900 " COPYRIGHT 1985,1986". SQ1384.2 +029000 01 CCVS-E-4. SQ1384.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1384.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1384.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1384.2 +029400 02 FILLER PIC X(40) VALUE SQ1384.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1384.2 +029600 01 XXINFO. SQ1384.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1384.2 +029800 02 INFO-TEXT. SQ1384.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1384.2 +030000 04 XXCOMPUTED PIC X(20). SQ1384.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1384.2 +030200 04 XXCORRECT PIC X(20). SQ1384.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1384.2 +030400 01 HYPHEN-LINE. SQ1384.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1384.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1384.2 +030700- "*****************************************". SQ1384.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1384.2 +030900- "******************************". SQ1384.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1384.2 +031100 "SQ138A". SQ1384.2 +031200* SQ1384.2 +031300* SQ1384.2 +031400 PROCEDURE DIVISION. SQ1384.2 +031500 DECLARATIVES. SQ1384.2 +031600* SQ1384.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1384.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1384.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1384.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1384.2 +032100* SQ1384.2 +032200 SECT-SQ138A-0000 SECTION. SQ1384.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1384.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1384.2 +032500 EXIT. SQ1384.2 +032600* SQ1384.2 +032700 SECT-SQ138A-0001 SECTION. SQ1384.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1384.2 +032900 OUTPUT-ERROR-PROCESS. SQ1384.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1384.2 +033100* SQ1384.2 +033200 SECT-SQ138A-0002 SECTION. SQ1384.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1384.2 +033400 INPUT-ERROR-PROCESS. SQ1384.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1384.2 +033600* SQ1384.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1384.2 +033800 GO TO END-DECLS. SQ1384.2 +033900* SQ1384.2 +034000 MOVE 1 TO REC-CT. SQ1384.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1384.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1384.2 +034300 GO TO DECL-EOF-READ-01. SQ1384.2 +034400 DECL-DELETE-01. SQ1384.2 +034500 PERFORM DECL-DE-LETE. SQ1384.2 +034600 GO TO DECL-TEST-01-END. SQ1384.2 +034700 DECL-EOF-READ-01. SQ1384.2 +034800 DECL-TEST-01-END. SQ1384.2 +034900* SQ1384.2 +035000 ADD 1 TO REC-CT. SQ1384.2 +035100 GO TO DECL-EOF-READ-02. SQ1384.2 +035200 DECL-DELETE-02. SQ1384.2 +035300 PERFORM DECL-DE-LETE. SQ1384.2 +035400 GO TO DECL-TEST-02-END. SQ1384.2 +035500 DECL-EOF-READ-02. SQ1384.2 +035600 DECL-TEST-02-END. SQ1384.2 +035700* SQ1384.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +035900 PERFORM DECL-WRITE-LINE. SQ1384.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1384.2 +036100 TO DUMMY-RECORD. SQ1384.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1384.2 +036300 GO TO END-DECLS. SQ1384.2 +036400* SQ1384.2 +036500* SQ1384.2 +036600 DECL-PASS. SQ1384.2 +036700 MOVE "PASS " TO P-OR-F. SQ1384.2 +036800 ADD 1 TO PASS-COUNTER. SQ1384.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +037000* SQ1384.2 +037100 DECL-FAIL. SQ1384.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1384.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1384.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +037500* SQ1384.2 +037600 DECL-DE-LETE. SQ1384.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1384.2 +037800 MOVE "*****" TO P-OR-F. SQ1384.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1384.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +038100* SQ1384.2 +038200 DECL-PRINT-DETAIL. SQ1384.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1384.2 +038400 MOVE "." TO PARDOT-X SQ1384.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1384.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1384.2 +038700 PERFORM DECL-WRITE-LINE. SQ1384.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1384.2 +038900 PERFORM DECL-WRITE-LINE SQ1384.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1384.2 +039100 ELSE SQ1384.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1384.2 +039300 MOVE SPACE TO P-OR-F. SQ1384.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1384.2 +039500 MOVE SPACE TO CORRECT-X. SQ1384.2 +039600 IF REC-CT EQUAL TO ZERO SQ1384.2 +039700 MOVE SPACE TO PAR-NAME. SQ1384.2 +039800 MOVE SPACE TO RE-MARK. SQ1384.2 +039900* SQ1384.2 +040000 DECL-WRITE-LINE. SQ1384.2 +040100 ADD 1 TO RECORD-COUNT. SQ1384.2 +040200Y IF RECORD-COUNT GREATER 50 SQ1384.2 +040300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1384.2 +040400Y MOVE SPACE TO DUMMY-RECORD SQ1384.2 +040500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1384.2 +040600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1384.2 +040700Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1384.2 +040800Y PERFORM DECL-WRT-LN 2 TIMES SQ1384.2 +040900Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1384.2 +041000Y PERFORM DECL-WRT-LN SQ1384.2 +041100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1384.2 +041200Y MOVE ZERO TO RECORD-COUNT. SQ1384.2 +041300 PERFORM DECL-WRT-LN. SQ1384.2 +041400* SQ1384.2 +041500 DECL-WRT-LN. SQ1384.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1384.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +041800* SQ1384.2 +041900 DECL-FAIL-ROUTINE. SQ1384.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1384.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1384.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1384.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +042700 GO TO DECL-FAIL-EX. SQ1384.2 +042800 DECL-FAIL-WRITE. SQ1384.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1384.2 +043000 PERFORM DECL-WRITE-LINE SQ1384.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1384.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1384.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1384.2 +043500 DECL-FAIL-EX. SQ1384.2 +043600 EXIT. SQ1384.2 +043700* SQ1384.2 +043800 DECL-BAIL. SQ1384.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1384.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1384.2 +044100 DECL-BAIL-WRITE. SQ1384.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1384.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1384.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +044600 DECL-BAIL-EX. SQ1384.2 +044700 EXIT. SQ1384.2 +044800* SQ1384.2 +044900 END-DECLS. SQ1384.2 +045000 END DECLARATIVES. SQ1384.2 +045100* SQ1384.2 +045200* SQ1384.2 +045300 CCVS1 SECTION. SQ1384.2 +045400 OPEN-FILES. SQ1384.2 +045500P OPEN I-O RAW-DATA. SQ1384.2 +045600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1384.2 +045700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1384.2 +045800P MOVE "ABORTED " TO C-ABORT. SQ1384.2 +045900P ADD 1 TO C-NO-OF-TESTS. SQ1384.2 +046000P ACCEPT C-DATE FROM DATE. SQ1384.2 +046100P ACCEPT C-TIME FROM TIME. SQ1384.2 +046200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1384.2 +046300PEND-E-1. SQ1384.2 +046400P CLOSE RAW-DATA. SQ1384.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1384.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1384.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1384.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1384.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1384.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1384.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1384.2 +047200 GO TO CCVS1-EXIT. SQ1384.2 +047300* SQ1384.2 +047400 CCVS-INIT-FILE. SQ1384.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1384.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1384.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1384.2 +047800* SQ1384.2 +047900 CLOSE-FILES. SQ1384.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1384.2 +048100 CLOSE PRINT-FILE. SQ1384.2 +048200P OPEN I-O RAW-DATA. SQ1384.2 +048300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1384.2 +048400P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1384.2 +048500P MOVE "OK. " TO C-ABORT. SQ1384.2 +048600P MOVE PASS-COUNTER TO C-OK. SQ1384.2 +048700P MOVE ERROR-HOLD TO C-ALL. SQ1384.2 +048800P MOVE ERROR-COUNTER TO C-FAIL. SQ1384.2 +048900P MOVE DELETE-CNT TO C-DELETED. SQ1384.2 +049000P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1384.2 +049100P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1384.2 +049200PEND-E-2. SQ1384.2 +049300P CLOSE RAW-DATA. SQ1384.2 +049400 TERMINATE-CCVS. SQ1384.2 +049500S EXIT PROGRAM. SQ1384.2 +049600 STOP RUN. SQ1384.2 +049700* SQ1384.2 +049800 INSPT. SQ1384.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1384.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1384.2 +050100 PERFORM PRINT-DETAIL. SQ1384.2 +050200* SQ1384.2 +050300 PASS. SQ1384.2 +050400 MOVE "PASS " TO P-OR-F. SQ1384.2 +050500 ADD 1 TO PASS-COUNTER. SQ1384.2 +050600 PERFORM PRINT-DETAIL. SQ1384.2 +050700* SQ1384.2 +050800 FAIL. SQ1384.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1384.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1384.2 +051100 PERFORM PRINT-DETAIL. SQ1384.2 +051200* SQ1384.2 +051300 DE-LETE. SQ1384.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1384.2 +051500 MOVE "*****" TO P-OR-F. SQ1384.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1384.2 +051700 PERFORM PRINT-DETAIL. SQ1384.2 +051800* SQ1384.2 +051900 PRINT-DETAIL. SQ1384.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1384.2 +052100 MOVE "." TO PARDOT-X SQ1384.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1384.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1384.2 +052400 PERFORM WRITE-LINE. SQ1384.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1384.2 +052600 PERFORM WRITE-LINE SQ1384.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1384.2 +052800 ELSE SQ1384.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1384.2 +053000 MOVE SPACE TO P-OR-F. SQ1384.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1384.2 +053200 MOVE SPACE TO CORRECT-X. SQ1384.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1384.2 +053400 MOVE SPACE TO RE-MARK. SQ1384.2 +053500* SQ1384.2 +053600 HEAD-ROUTINE. SQ1384.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1384.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1384.2 +054100 COLUMN-NAMES-ROUTINE. SQ1384.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +054500 END-ROUTINE. SQ1384.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1384.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1384.2 +054800 END-RTN-EXIT. SQ1384.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1384.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +055100* SQ1384.2 +055200 END-ROUTINE-1. SQ1384.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1384.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1384.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1384.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1384.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1384.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1384.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1384.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1384.2 +056100 PERFORM WRITE-LINE. SQ1384.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1384.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1384.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +056500 ELSE SQ1384.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1384.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1384.2 +056800 PERFORM WRITE-LINE. SQ1384.2 +056900 END-ROUTINE-13. SQ1384.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1384.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +057200 ELSE SQ1384.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1384.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1384.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1384.2 +057600 PERFORM WRITE-LINE. SQ1384.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1384.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +057900 ELSE SQ1384.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1384.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1384.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +058400* SQ1384.2 +058500 WRITE-LINE. SQ1384.2 +058600 ADD 1 TO RECORD-COUNT. SQ1384.2 +058700Y IF RECORD-COUNT GREATER 50 SQ1384.2 +058800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1384.2 +058900Y MOVE SPACE TO DUMMY-RECORD SQ1384.2 +059000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1384.2 +059100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1384.2 +059200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1384.2 +059300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1384.2 +059400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1384.2 +059500Y MOVE ZERO TO RECORD-COUNT. SQ1384.2 +059600 PERFORM WRT-LN. SQ1384.2 +059700* SQ1384.2 +059800 WRT-LN. SQ1384.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1384.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +060100 BLANK-LINE-PRINT. SQ1384.2 +060200 PERFORM WRT-LN. SQ1384.2 +060300 FAIL-ROUTINE. SQ1384.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1384.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1384.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1384.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1384.2 +061200 FAIL-ROUTINE-WRITE. SQ1384.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1384.2 +061400 PERFORM WRITE-LINE SQ1384.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1384.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1384.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1384.2 +061900 FAIL-ROUTINE-EX. SQ1384.2 +062000 EXIT. SQ1384.2 +062100 BAIL-OUT. SQ1384.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1384.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1384.2 +062400 BAIL-OUT-WRITE. SQ1384.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1384.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1384.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +063100 BAIL-OUT-EX. SQ1384.2 +063200 EXIT. SQ1384.2 +063300 CCVS1-EXIT. SQ1384.2 +063400 EXIT. SQ1384.2 +063500* SQ1384.2 +063600**************************************************************** SQ1384.2 +063700* * SQ1384.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1384.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1384.2 +064000* * SQ1384.2 +064100**************************************************************** SQ1384.2 +064200* SQ1384.2 +064300 SECT-SQ138A-0004 SECTION. SQ1384.2 +064400 STA-INIT. SQ1384.2 +064500 MOVE SPACE TO DELETE-SW. SQ1384.2 +064600* SQ1384.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1384.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1384.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1384.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1384.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1384.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1384.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1384.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1384.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1384.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1384.2 +065700* SQ1384.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1384.2 +065900* SQ1384.2 +066000 SEQ-INIT-01. SQ1384.2 +066100 MOVE 0 TO REC-CT. SQ1384.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1384.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1384.2 +066800 GO TO SEQ-TEST-OP-01. SQ1384.2 +066900 SEQ-DELETE-01. SQ1384.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1384.2 +067100 SEQ-TEST-OP-01. SQ1384.2 +067200 OPEN OUTPUT SQ-FS4. SQ1384.2 +067300* SQ1384.2 +067400* SQ1384.2 +067500* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1384.2 +067600* SQ1384.2 +067700 SEQ-INIT-02. SQ1384.2 +067800 MOVE 0 TO REC-CT. SQ1384.2 +067900 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +068300 ADD 1 TO XRECORD-NUMBER (1). SQ1384.2 +068400 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1384.2 +068500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1384.2 +068600 IF DELETE-SW NOT EQUAL TO SPACE SQ1384.2 +068700 GO TO SEQ-DELETE-02. SQ1384.2 +068800 GO TO SEQ-TEST-WR-02. SQ1384.2 +068900 SEQ-DELETE-02. SQ1384.2 +069000 MOVE "*" TO DELETE-SW-2. SQ1384.2 +069100 SEQ-TEST-WR-02. SQ1384.2 +069200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1384.2 +069300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1384.2 +069400 WRITE SQ-FS4R1-F-G-125. SQ1384.2 +069500* SQ1384.2 +069600* SQ1384.2 +069700* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1384.2 +069800* SQ1384.2 +069900 SEQ-INIT-03. SQ1384.2 +070000 MOVE 0 TO REC-CT. SQ1384.2 +070100 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +070400 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +070500 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1384.2 +070600 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1384.2 +070700 IF DELETE-SW NOT EQUAL TO SPACE SQ1384.2 +070800 GO TO SEQ-DELETE-03. SQ1384.2 +070900 GO TO SEQ-TEST-CL-03. SQ1384.2 +071000 SEQ-DELETE-03. SQ1384.2 +071100 MOVE "*" TO DELETE-SW-2. SQ1384.2 +071200 SEQ-TEST-CL-03. SQ1384.2 +071300 CLOSE SQ-FS4. SQ1384.2 +071400 SEQ-INIT-04. SQ1384.2 +071500 MOVE 0 TO REC-CT. SQ1384.2 +071600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1384.2 +071700 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +071800 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +071900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +072000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +072100 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1384.2 +072200 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1384.2 +072300 IF DELETE-SW NOT = SPACE SQ1384.2 +072400 GO TO SEQ-DELETE-04. SQ1384.2 +072500 GO TO SEQ-TEST-OP-04. SQ1384.2 +072600 SEQ-DELETE-04. SQ1384.2 +072700 MOVE "*" TO DELETE-SW-2. SQ1384.2 +072800 SEQ-TEST-OP-04. SQ1384.2 +072900* SQ1384.2 +073000* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1384.2 +073100* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1384.2 +073200* THE LAST RECORD WRITTEN IN IT. SQ1384.2 +073300* SQ1384.2 +073400 OPEN INPUT SQ-FS4. SQ1384.2 +073500 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1384.2 +073600* SQ1384.2 +073700* SQ1384.2 +073800* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1384.2 +073900* SQ1384.2 +074000 SEQ-INIT-05. SQ1384.2 +074100 MOVE 0 TO REC-CT. SQ1384.2 +074200 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +074300 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +074400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +074500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +074600 MOVE "READ FIRST RECORD" TO FEATURE. SQ1384.2 +074700 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1384.2 +074800 IF DELETE-SW NOT = SPACE SQ1384.2 +074900 GO TO SEQ-DELETE-05. SQ1384.2 +075000 GO TO SEQ-TEST-RD-05. SQ1384.2 +075100 SEQ-DELETE-05. SQ1384.2 +075200 MOVE "*" TO DELETE-SW-2. SQ1384.2 +075300 SEQ-TEST-RD-05. SQ1384.2 +075400 READ SQ-FS4. SQ1384.2 +075500 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1384.2 +075600 SEQ-INIT-06. SQ1384.2 +075700 MOVE 0 TO REC-CT. SQ1384.2 +075800 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +075900 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +076000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +076100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +076200 MOVE "READ, GIVING AT END" TO FEATURE. SQ1384.2 +076300 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1384.2 +076400 IF DELETE-SW NOT = SPACE SQ1384.2 +076500 GO TO SEQ-DELETE-06. SQ1384.2 +076600 GO TO SEQ-TEST-RD-06. SQ1384.2 +076700 SEQ-DELETE-06. SQ1384.2 +076800 MOVE "*" TO DELETE-SW-2. SQ1384.2 +076900 SEQ-TEST-RD-06. SQ1384.2 +077000 READ SQ-FS4. SQ1384.2 +077100* SQ1384.2 +077200* SQ1384.2 +077300* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1384.2 +077400* SQ1384.2 +077500 SEQ-INIT-07. SQ1384.2 +077600 MOVE 0 TO REC-CT. SQ1384.2 +077700 MOVE SPACE TO DECL-EXEC-SW. SQ1384.2 +077800 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +077900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +078000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +078100 MOVE "READ AFTER AT END" TO FEATURE. SQ1384.2 +078200 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1384.2 +078300 IF DELETE-SW NOT = SPACE SQ1384.2 +078400 GO TO SEQ-DELETE-07. SQ1384.2 +078500 GO TO SEQ-TEST-RD-07. SQ1384.2 +078600 SEQ-DELETE-07. SQ1384.2 +078700 MOVE "*" TO DELETE-SW-2. SQ1384.2 +078800 SEQ-TEST-RD-07. SQ1384.2 +078900 READ SQ-FS4. SQ1384.2 +079000* SQ1384.2 +079100* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1384.2 +079200* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1384.2 +079300* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1384.2 +079400* SQ1384.2 +079500 MOVE ZERO TO REC-CT. SQ1384.2 +079600 MOVE "READ AFTER AT END" TO FEATURE. SQ1384.2 +079700 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1384.2 +079800* SQ1384.2 +079900* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1384.2 +080000* SQ1384.2 +080100 ADD 1 TO REC-CT. SQ1384.2 +080200 SEQ-TEST-07-01-END. SQ1384.2 +080300 ADD 1 TO REC-CT. SQ1384.2 +080400 SEQ-TEST-07-02-END. SQ1384.2 +080500* SQ1384.2 +080600* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1384.2 +080700* SQ1384.2 +080800 ADD 1 TO REC-CT. SQ1384.2 +080900 IF DELETE-SW NOT = SPACE SQ1384.2 +081000 GO TO SEQ-DELETE-07-03. SQ1384.2 +081100 GO TO SEQ-TEST-RD-07-03. SQ1384.2 +081200 SEQ-DELETE-07-03. SQ1384.2 +081300 PERFORM DE-LETE. SQ1384.2 +081400 GO TO SEQ-TEST-07-03-END. SQ1384.2 +081500 SEQ-TEST-RD-07-03. SQ1384.2 +081600 IF DECL-EXEC-O = "NOT EXECUTED" SQ1384.2 +081700 PERFORM PASS SQ1384.2 +081800 ELSE SQ1384.2 +081900 MOVE DECL-EXEC-O TO COMPUTED-A SQ1384.2 +082000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1384.2 +082100 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1384.2 +082200 TO RE-MARK SQ1384.2 +082300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1384.2 +082400 PERFORM FAIL. SQ1384.2 +082500 SEQ-TEST-07-03-END. SQ1384.2 +082600 MOVE SPACE TO DELETE-SW-2. SQ1384.2 +082700* SQ1384.2 +082800* SQ1384.2 +082900 CCVS-EXIT SECTION. SQ1384.2 +083000 CCVS-999999. SQ1384.2 +083100 GO TO CLOSE-FILES. SQ1384.2 +*END-OF,SQ138A +*HEADER,COBOL,SQ139A +000100 IDENTIFICATION DIVISION. SQ1394.2 +000200 PROGRAM-ID. SQ1394.2 +000300 SQ139A. SQ1394.2 +000400**************************************************************** SQ1394.2 +000500* * SQ1394.2 +000600* VALIDATION FOR:- * SQ1394.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1394.2 +000900* REVISED 1986, AUGUST * SQ1394.2 +001000* * SQ1394.2 +001100* CREATION DATE / VALIDATION DATE * SQ1394.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1394.2 +001300* * SQ1394.2 +001400**************************************************************** SQ1394.2 +001500* * SQ1394.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1394.2 +001700* * SQ1394.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1394.2 +001900* X-55 SYSTEM PRINTER * SQ1394.2 +002000* X-82 SOURCE-COMPUTER * SQ1394.2 +002100* X-83 OBJECT-COMPUTER. * SQ1394.2 +002200* * SQ1394.2 +002300* * SQ1394.2 +002400**************************************************************** SQ1394.2 +002500* * SQ1394.2 +002600* SPLIT FROM SQ125A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1394.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1394.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1394.2 +002900* OPEN FOR OUTPUT FOR A MAGNETIC TAPE FILE WHICH IS ALREADY * SQ1394.2 +003000* OPEN IN THE OUTPUT MODE. (SEE SQ125A). * SQ1394.2 +003100* * SQ1394.2 +003200**************************************************************** SQ1394.2 +003300* SQ1394.2 +003400 ENVIRONMENT DIVISION. SQ1394.2 +003500 CONFIGURATION SECTION. SQ1394.2 +003600 SOURCE-COMPUTER. SQ1394.2 +003700 XXXXX082. SQ1394.2 +003800 OBJECT-COMPUTER. SQ1394.2 +003900 XXXXX083. SQ1394.2 +004000* SQ1394.2 +004100 INPUT-OUTPUT SECTION. SQ1394.2 +004200 FILE-CONTROL. SQ1394.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1394.2 +004400 XXXXX055. SQ1394.2 +004500* SQ1394.2 +004600P SELECT RAW-DATA ASSIGN TO SQ1394.2 +004700P XXXXX062 SQ1394.2 +004800P ORGANIZATION IS INDEXED SQ1394.2 +004900P ACCESS MODE IS RANDOM SQ1394.2 +005000P RECORD-KEY IS RAW-DATA-KEY. SQ1394.2 +005100P SQ1394.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1394.2 +005300 XXXXX001 SQ1394.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1394.2 +005500* SQ1394.2 +005600* SQ1394.2 +005700 DATA DIVISION. SQ1394.2 +005800 FILE SECTION. SQ1394.2 +005900 FD PRINT-FILE SQ1394.2 +006000C LABEL RECORDS SQ1394.2 +006100C XXXXX084 SQ1394.2 +006200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1394.2 +006300 . SQ1394.2 +006400 01 PRINT-REC PICTURE X(120). SQ1394.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1394.2 +006600P SQ1394.2 +006700PFD RAW-DATA. SQ1394.2 +006800P01 RAW-DATA-SATZ. SQ1394.2 +006900P 05 RAW-DATA-KEY PIC X(6). SQ1394.2 +007000P 05 C-DATE PIC 9(6). SQ1394.2 +007100P 05 C-TIME PIC 9(8). SQ1394.2 +007200P 05 NO-OF-TESTS PIC 99. SQ1394.2 +007300P 05 C-OK PIC 999. SQ1394.2 +007400P 05 C-ALL PIC 999. SQ1394.2 +007500P 05 C-FAIL PIC 999. SQ1394.2 +007600P 05 C-DELETED PIC 999. SQ1394.2 +007700P 05 C-INSPECT PIC 999. SQ1394.2 +007800P 05 C-NOTE PIC X(13). SQ1394.2 +007900P 05 C-INDENT PIC X. SQ1394.2 +008000P 05 C-ABORT PIC X(8). SQ1394.2 +008100* SQ1394.2 +008200 FD SQ-FS1 SQ1394.2 +008300C LABEL RECORD IS STANDARD SQ1394.2 +008400 . SQ1394.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1394.2 +008600* SQ1394.2 +008700 WORKING-STORAGE SECTION. SQ1394.2 +008800* SQ1394.2 +008900*************************************************************** SQ1394.2 +009000* * SQ1394.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1394.2 +009200* * SQ1394.2 +009300*************************************************************** SQ1394.2 +009400* SQ1394.2 +009500 01 SQ-FS1-STATUS. SQ1394.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1394.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1394.2 +009800* SQ1394.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1394.2 +010000* SQ1394.2 +010100* SQ1394.2 +010200*************************************************************** SQ1394.2 +010300* * SQ1394.2 +010400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1394.2 +010500* * SQ1394.2 +010600*************************************************************** SQ1394.2 +010700* SQ1394.2 +010800 01 REC-SKEL-SUB PIC 99. SQ1394.2 +010900* SQ1394.2 +011000 01 FILE-RECORD-INFORMATION-REC. SQ1394.2 +011100 03 FILE-RECORD-INFO-SKELETON. SQ1394.2 +011200 05 FILLER PICTURE X(48) VALUE SQ1394.2 +011300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1394.2 +011400 05 FILLER PICTURE X(46) VALUE SQ1394.2 +011500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1394.2 +011600 05 FILLER PICTURE X(26) VALUE SQ1394.2 +011700 ",LFIL=000000,ORG= ,LBLR= ". SQ1394.2 +011800 05 FILLER PICTURE X(37) VALUE SQ1394.2 +011900 ",RECKEY= ". SQ1394.2 +012000 05 FILLER PICTURE X(38) VALUE SQ1394.2 +012100 ",ALTKEY1= ". SQ1394.2 +012200 05 FILLER PICTURE X(38) VALUE SQ1394.2 +012300 ",ALTKEY2= ". SQ1394.2 +012400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1394.2 +012500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1394.2 +012600 05 FILE-RECORD-INFO-P1-120. SQ1394.2 +012700 07 FILLER PIC X(5). SQ1394.2 +012800 07 XFILE-NAME PIC X(6). SQ1394.2 +012900 07 FILLER PIC X(8). SQ1394.2 +013000 07 XRECORD-NAME PIC X(6). SQ1394.2 +013100 07 FILLER PIC X(1). SQ1394.2 +013200 07 REELUNIT-NUMBER PIC 9(1). SQ1394.2 +013300 07 FILLER PIC X(7). SQ1394.2 +013400 07 XRECORD-NUMBER PIC 9(6). SQ1394.2 +013500 07 FILLER PIC X(6). SQ1394.2 +013600 07 UPDATE-NUMBER PIC 9(2). SQ1394.2 +013700 07 FILLER PIC X(5). SQ1394.2 +013800 07 ODO-NUMBER PIC 9(4). SQ1394.2 +013900 07 FILLER PIC X(5). SQ1394.2 +014000 07 XPROGRAM-NAME PIC X(5). SQ1394.2 +014100 07 FILLER PIC X(7). SQ1394.2 +014200 07 XRECORD-LENGTH PIC 9(6). SQ1394.2 +014300 07 FILLER PIC X(7). SQ1394.2 +014400 07 CHARS-OR-RECORDS PIC X(2). SQ1394.2 +014500 07 FILLER PIC X(1). SQ1394.2 +014600 07 XBLOCK-SIZE PIC 9(4). SQ1394.2 +014700 07 FILLER PIC X(6). SQ1394.2 +014800 07 RECORDS-IN-FILE PIC 9(6). SQ1394.2 +014900 07 FILLER PIC X(5). SQ1394.2 +015000 07 XFILE-ORGANIZATION PIC X(2). SQ1394.2 +015100 07 FILLER PIC X(6). SQ1394.2 +015200 07 XLABEL-TYPE PIC X(1). SQ1394.2 +015300 05 FILE-RECORD-INFO-P121-240. SQ1394.2 +015400 07 FILLER PIC X(8). SQ1394.2 +015500 07 XRECORD-KEY PIC X(29). SQ1394.2 +015600 07 FILLER PIC X(9). SQ1394.2 +015700 07 ALTERNATE-KEY1 PIC X(29). SQ1394.2 +015800 07 FILLER PIC X(9). SQ1394.2 +015900 07 ALTERNATE-KEY2 PIC X(29). SQ1394.2 +016000 07 FILLER PIC X(7). SQ1394.2 +016100* SQ1394.2 +016200 01 TEST-RESULTS. SQ1394.2 +016300 02 FILLER PIC X VALUE SPACE. SQ1394.2 +016400 02 PAR-NAME. SQ1394.2 +016500 03 FILLER PIC X(14) VALUE SPACE. SQ1394.2 +016600 03 PARDOT-X PIC X VALUE SPACE. SQ1394.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1394.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1394.2 +016900 02 FEATURE PIC X(24) VALUE SPACE. SQ1394.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1394.2 +017100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1394.2 +017200 02 FILLER PIC X(9) VALUE SPACE. SQ1394.2 +017300 02 RE-MARK PIC X(61). SQ1394.2 +017400 01 TEST-COMPUTED. SQ1394.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1394.2 +017600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1394.2 +017700 02 COMPUTED-X. SQ1394.2 +017800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1394.2 +017900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1394.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1394.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1394.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1394.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1394.2 +018400 04 COMPUTED-18V0 PIC -9(18). SQ1394.2 +018500 04 FILLER PIC X. SQ1394.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1394.2 +018700 01 TEST-CORRECT. SQ1394.2 +018800 02 FILLER PIC X(30) VALUE SPACE. SQ1394.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1394.2 +019000 02 CORRECT-X. SQ1394.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1394.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1394.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1394.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1394.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1394.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. SQ1394.2 +019700 04 CORRECT-18V0 PIC -9(18). SQ1394.2 +019800 04 FILLER PIC X. SQ1394.2 +019900 03 FILLER PIC X(2) VALUE SPACE. SQ1394.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1394.2 +020100* SQ1394.2 +020200 01 CCVS-C-1. SQ1394.2 +020300 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1394.2 +020500 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1394.2 +020700 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1394.2 +020900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1394.2 +021000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1394.2 +021100 01 CCVS-C-2. SQ1394.2 +021200 02 FILLER PIC X(19) VALUE SPACE. SQ1394.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". SQ1394.2 +021400 02 FILLER PIC X(19) VALUE SPACE. SQ1394.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". SQ1394.2 +021600 02 FILLER PIC X(72) VALUE SPACE. SQ1394.2 +021700* SQ1394.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1394.2 +021900 01 REC-CT PIC 99 VALUE ZERO. SQ1394.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1394.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1394.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1394.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1394.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1394.2 +022900 01 CCVS-H-1. SQ1394.2 +023000 02 FILLER PIC X(39) VALUE SPACES. SQ1394.2 +023100 02 FILLER PIC X(42) VALUE SQ1394.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1394.2 +023300 02 FILLER PIC X(39) VALUE SPACES. SQ1394.2 +023400 01 CCVS-H-2A. SQ1394.2 +023500 02 FILLER PIC X(40) VALUE SPACE. SQ1394.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1394.2 +023700 02 FILLER PIC XXXX VALUE SQ1394.2 +023800 "4.2 ". SQ1394.2 +023900 02 FILLER PIC X(28) VALUE SQ1394.2 +024000 " COPY - NOT FOR DISTRIBUTION". SQ1394.2 +024100 02 FILLER PIC X(41) VALUE SPACE. SQ1394.2 +024200* SQ1394.2 +024300 01 CCVS-H-2B. SQ1394.2 +024400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1394.2 +024500 02 TEST-ID PIC X(9). SQ1394.2 +024600 02 FILLER PIC X(4) VALUE " IN ". SQ1394.2 +024700 02 FILLER PIC X(12) VALUE SQ1394.2 +024800 " HIGH ". SQ1394.2 +024900 02 FILLER PIC X(22) VALUE SQ1394.2 +025000 " LEVEL VALIDATION FOR ". SQ1394.2 +025100 02 FILLER PIC X(58) VALUE SQ1394.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +025300 01 CCVS-H-3. SQ1394.2 +025400 02 FILLER PIC X(34) VALUE SQ1394.2 +025500 " FOR OFFICIAL USE ONLY ". SQ1394.2 +025600 02 FILLER PIC X(58) VALUE SQ1394.2 +025700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1394.2 +025800 02 FILLER PIC X(28) VALUE SQ1394.2 +025900 " COPYRIGHT 1985,1986 ". SQ1394.2 +026000 01 CCVS-E-1. SQ1394.2 +026100 02 FILLER PIC X(52) VALUE SPACE. SQ1394.2 +026200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1394.2 +026300 02 ID-AGAIN PIC X(9). SQ1394.2 +026400 02 FILLER PIC X(45) VALUE SPACES. SQ1394.2 +026500 01 CCVS-E-2. SQ1394.2 +026600 02 FILLER PIC X(31) VALUE SPACE. SQ1394.2 +026700 02 FILLER PIC X(21) VALUE SPACE. SQ1394.2 +026800 02 CCVS-E-2-2. SQ1394.2 +026900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1394.2 +027000 03 FILLER PIC X VALUE SPACE. SQ1394.2 +027100 03 ENDER-DESC PIC X(44) VALUE SQ1394.2 +027200 "ERRORS ENCOUNTERED". SQ1394.2 +027300 01 CCVS-E-3. SQ1394.2 +027400 02 FILLER PIC X(22) VALUE SQ1394.2 +027500 " FOR OFFICIAL USE ONLY". SQ1394.2 +027600 02 FILLER PIC X(12) VALUE SPACE. SQ1394.2 +027700 02 FILLER PIC X(58) VALUE SQ1394.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +027900 02 FILLER PIC X(8) VALUE SPACE. SQ1394.2 +028000 02 FILLER PIC X(20) VALUE SQ1394.2 +028100 " COPYRIGHT 1985,1986". SQ1394.2 +028200 01 CCVS-E-4. SQ1394.2 +028300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1394.2 +028400 02 FILLER PIC X(4) VALUE " OF ". SQ1394.2 +028500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1394.2 +028600 02 FILLER PIC X(40) VALUE SQ1394.2 +028700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1394.2 +028800 01 XXINFO. SQ1394.2 +028900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1394.2 +029000 02 INFO-TEXT. SQ1394.2 +029100 04 FILLER PIC X(8) VALUE SPACE. SQ1394.2 +029200 04 XXCOMPUTED PIC X(20). SQ1394.2 +029300 04 FILLER PIC X(5) VALUE SPACE. SQ1394.2 +029400 04 XXCORRECT PIC X(20). SQ1394.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). SQ1394.2 +029600 01 HYPHEN-LINE. SQ1394.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. SQ1394.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1394.2 +029900- "*****************************************". SQ1394.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1394.2 +030100- "******************************". SQ1394.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1394.2 +030300 "SQ139A". SQ1394.2 +030400* SQ1394.2 +030500* SQ1394.2 +030600 PROCEDURE DIVISION. SQ1394.2 +030700 DECLARATIVES. SQ1394.2 +030800 SQ139A-DECLARATIVE-001-SECT SECTION. SQ1394.2 +030900 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1394.2 +031000 INPUT-ERROR-PROCEDURE. SQ1394.2 +031100 IF DECL-EXEC-SW NOT = 9 SQ1394.2 +031200 GO TO NOT-DECL-9. SQ1394.2 +031300* SQ1394.2 +031400* DECLARATIVE PROCEDURE ENTERED FROM SECOND OPEN OUTPUT SQ1394.2 +031500* SQ1394.2 +031600 DECL-OPEN-TEST. SQ1394.2 +031700 MOVE SPACE TO DUMMY-RECORD SQ1394.2 +031800 PERFORM DECL-WRITE-LINE SQ1394.2 +031900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1394.2 +032000 TO DUMMY-RECORD SQ1394.2 +032100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1394.2 +032200 GO TO END-DECLS. SQ1394.2 +032300* SQ1394.2 +032400* SQ1394.2 +032500 NOT-DECL-9. SQ1394.2 +032600 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1394.2 +032700 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1394.2 +032800 MOVE 9 TO CORRECT-18V0. SQ1394.2 +032900 MOVE "UNEXPECTED ENTRY TO DECLARATIVES" TO RE-MARK. SQ1394.2 +033000 PERFORM DECL-FAIL. SQ1394.2 +033100 GO TO END-DECLS. SQ1394.2 +033200* SQ1394.2 +033300* SQ1394.2 +033400* SQ1394.2 +033500 DECL-PASS. SQ1394.2 +033600 MOVE "PASS " TO P-OR-F. SQ1394.2 +033700 ADD 1 TO PASS-COUNTER. SQ1394.2 +033800 PERFORM DECL-PRINT-DETAIL. SQ1394.2 +033900* SQ1394.2 +034000 DECL-FAIL. SQ1394.2 +034100 MOVE "FAIL*" TO P-OR-F. SQ1394.2 +034200 ADD 1 TO ERROR-COUNTER. SQ1394.2 +034300 PERFORM DECL-PRINT-DETAIL. SQ1394.2 +034400* SQ1394.2 +034500 DECL-PRINT-DETAIL. SQ1394.2 +034600 IF REC-CT NOT EQUAL TO ZERO SQ1394.2 +034700 MOVE "." TO PARDOT-X SQ1394.2 +034800 MOVE REC-CT TO DOTVALUE. SQ1394.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. SQ1394.2 +035000 PERFORM DECL-WRITE-LINE. SQ1394.2 +035100 IF P-OR-F EQUAL TO "FAIL*" SQ1394.2 +035200 PERFORM DECL-WRITE-LINE SQ1394.2 +035300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1394.2 +035400 ELSE SQ1394.2 +035500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1394.2 +035600 MOVE SPACE TO P-OR-F. SQ1394.2 +035700 MOVE SPACE TO COMPUTED-X. SQ1394.2 +035800 MOVE SPACE TO CORRECT-X. SQ1394.2 +035900 IF REC-CT EQUAL TO ZERO SQ1394.2 +036000 MOVE SPACE TO PAR-NAME. SQ1394.2 +036100 MOVE SPACE TO RE-MARK. SQ1394.2 +036200* SQ1394.2 +036300 DECL-WRITE-LINE. SQ1394.2 +036400 ADD 1 TO RECORD-COUNT. SQ1394.2 +036500Y IF RECORD-COUNT GREATER 50 SQ1394.2 +036600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1394.2 +036700Y MOVE SPACE TO DUMMY-RECORD SQ1394.2 +036800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1394.2 +036900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1394.2 +037000Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1394.2 +037100Y PERFORM DECL-WRT-LN 2 TIMES SQ1394.2 +037200Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1394.2 +037300Y PERFORM DECL-WRT-LN SQ1394.2 +037400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1394.2 +037500Y MOVE ZERO TO RECORD-COUNT. SQ1394.2 +037600 PERFORM DECL-WRT-LN. SQ1394.2 +037700* SQ1394.2 +037800 DECL-WRT-LN. SQ1394.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1394.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1394.2 +038100* SQ1394.2 +038200 DECL-FAIL-ROUTINE. SQ1394.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1394.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1394.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1394.2 +038700 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +038800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +039000 GO TO DECL-FAIL-EX. SQ1394.2 +039100 DECL-FAIL-WRITE. SQ1394.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC SQ1394.2 +039300 PERFORM DECL-WRITE-LINE SQ1394.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1394.2 +039500 MOVE TEST-CORRECT TO PRINT-REC SQ1394.2 +039600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +039700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1394.2 +039800 DECL-FAIL-EX. SQ1394.2 +039900 EXIT. SQ1394.2 +040000* SQ1394.2 +040100 DECL-BAIL. SQ1394.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1394.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1394.2 +040400 DECL-BAIL-WRITE. SQ1394.2 +040500 MOVE CORRECT-A TO XXCORRECT. SQ1394.2 +040600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1394.2 +040700 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +040800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +040900 DECL-BAIL-EX. SQ1394.2 +041000 EXIT. SQ1394.2 +041100* SQ1394.2 +041200 END-DECLS. SQ1394.2 +041300 MOVE ZERO TO DECL-EXEC-SW. SQ1394.2 +041400 END DECLARATIVES. SQ1394.2 +041500* SQ1394.2 +041600* SQ1394.2 +041700 CCVS1 SECTION. SQ1394.2 +041800 OPEN-FILES. SQ1394.2 +041900P OPEN I-O RAW-DATA. SQ1394.2 +042000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1394.2 +042100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1394.2 +042200P MOVE "ABORTED " TO C-ABORT. SQ1394.2 +042300P ADD 1 TO C-NO-OF-TESTS. SQ1394.2 +042400P ACCEPT C-DATE FROM DATE. SQ1394.2 +042500P ACCEPT C-TIME FROM TIME. SQ1394.2 +042600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1394.2 +042700PEND-E-1. SQ1394.2 +042800P CLOSE RAW-DATA. SQ1394.2 +042900 OPEN OUTPUT PRINT-FILE. SQ1394.2 +043000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1394.2 +043100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1394.2 +043200 MOVE SPACE TO TEST-RESULTS. SQ1394.2 +043300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1394.2 +043400 MOVE ZERO TO REC-SKEL-SUB. SQ1394.2 +043500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1394.2 +043600 GO TO CCVS1-EXIT. SQ1394.2 +043700* SQ1394.2 +043800 CCVS-INIT-FILE. SQ1394.2 +043900 ADD 1 TO REC-SKL-SUB. SQ1394.2 +044000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1394.2 +044100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1394.2 +044200* SQ1394.2 +044300 CLOSE-FILES. SQ1394.2 +044400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1394.2 +044500 CLOSE PRINT-FILE. SQ1394.2 +044600P OPEN I-O RAW-DATA. SQ1394.2 +044700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1394.2 +044800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1394.2 +044900P MOVE "OK. " TO C-ABORT. SQ1394.2 +045000P MOVE PASS-COUNTER TO C-OK. SQ1394.2 +045100P MOVE ERROR-HOLD TO C-ALL. SQ1394.2 +045200P MOVE ERROR-COUNTER TO C-FAIL. SQ1394.2 +045300P MOVE DELETE-CNT TO C-DELETED. SQ1394.2 +045400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1394.2 +045500P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1394.2 +045600PEND-E-2. SQ1394.2 +045700P CLOSE RAW-DATA. SQ1394.2 +045800 TERMINATE-CCVS. SQ1394.2 +045900S EXIT PROGRAM. SQ1394.2 +046000 STOP RUN. SQ1394.2 +046100* SQ1394.2 +046200 INSPT. SQ1394.2 +046300 MOVE "INSPT" TO P-OR-F. SQ1394.2 +046400 ADD 1 TO INSPECT-COUNTER. SQ1394.2 +046500 PERFORM PRINT-DETAIL. SQ1394.2 +046600 SQ1394.2 +046700 PASS. SQ1394.2 +046800 MOVE "PASS " TO P-OR-F. SQ1394.2 +046900 ADD 1 TO PASS-COUNTER. SQ1394.2 +047000 PERFORM PRINT-DETAIL. SQ1394.2 +047100* SQ1394.2 +047200 FAIL. SQ1394.2 +047300 MOVE "FAIL*" TO P-OR-F. SQ1394.2 +047400 ADD 1 TO ERROR-COUNTER. SQ1394.2 +047500 PERFORM PRINT-DETAIL. SQ1394.2 +047600* SQ1394.2 +047700 DE-LETE. SQ1394.2 +047800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1394.2 +047900 MOVE "*****" TO P-OR-F. SQ1394.2 +048000 ADD 1 TO DELETE-COUNTER. SQ1394.2 +048100 PERFORM PRINT-DETAIL. SQ1394.2 +048200* SQ1394.2 +048300 PRINT-DETAIL. SQ1394.2 +048400 IF REC-CT NOT EQUAL TO ZERO SQ1394.2 +048500 MOVE "." TO PARDOT-X SQ1394.2 +048600 MOVE REC-CT TO DOTVALUE. SQ1394.2 +048700 MOVE TEST-RESULTS TO PRINT-REC. SQ1394.2 +048800 PERFORM WRITE-LINE. SQ1394.2 +048900 IF P-OR-F EQUAL TO "FAIL*" SQ1394.2 +049000 PERFORM WRITE-LINE SQ1394.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1394.2 +049200 ELSE SQ1394.2 +049300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1394.2 +049400 MOVE SPACE TO P-OR-F. SQ1394.2 +049500 MOVE SPACE TO COMPUTED-X. SQ1394.2 +049600 MOVE SPACE TO CORRECT-X. SQ1394.2 +049700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1394.2 +049800 MOVE SPACE TO RE-MARK. SQ1394.2 +049900* SQ1394.2 +050000 HEAD-ROUTINE. SQ1394.2 +050100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1394.2 +050400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1394.2 +050500 COLUMN-NAMES-ROUTINE. SQ1394.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +050900 END-ROUTINE. SQ1394.2 +051000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1394.2 +051100 PERFORM WRITE-LINE 5 TIMES. SQ1394.2 +051200 END-RTN-EXIT. SQ1394.2 +051300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1394.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +051500* SQ1394.2 +051600 END-ROUTINE-1. SQ1394.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1394.2 +051800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1394.2 +051900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1394.2 +052000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1394.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1394.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1394.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1394.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1394.2 +052500 PERFORM WRITE-LINE. SQ1394.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1394.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1394.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +052900 ELSE SQ1394.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1394.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1394.2 +053200 PERFORM WRITE-LINE. SQ1394.2 +053300 END-ROUTINE-13. SQ1394.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1394.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +053600 ELSE SQ1394.2 +053700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1394.2 +053800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1394.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1394.2 +054000 PERFORM WRITE-LINE. SQ1394.2 +054100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1394.2 +054200 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +054300 ELSE SQ1394.2 +054400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1394.2 +054500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1394.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +054700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +054800* SQ1394.2 +054900 WRITE-LINE. SQ1394.2 +055000 ADD 1 TO RECORD-COUNT. SQ1394.2 +055100Y IF RECORD-COUNT GREATER 50 SQ1394.2 +055200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1394.2 +055300Y MOVE SPACE TO DUMMY-RECORD SQ1394.2 +055400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1394.2 +055500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1394.2 +055600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1394.2 +055700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1394.2 +055800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1394.2 +055900Y MOVE ZERO TO RECORD-COUNT. SQ1394.2 +056000 PERFORM WRT-LN. SQ1394.2 +056100* SQ1394.2 +056200 WRT-LN. SQ1394.2 +056300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1394.2 +056400 MOVE SPACE TO DUMMY-RECORD. SQ1394.2 +056500 BLANK-LINE-PRINT. SQ1394.2 +056600 PERFORM WRT-LN. SQ1394.2 +056700 FAIL-ROUTINE. SQ1394.2 +056800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1394.2 +056900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1394.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +057100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1394.2 +057200 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +057300 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +057400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +057500 GO TO FAIL-ROUTINE-EX. SQ1394.2 +057600 FAIL-ROUTINE-WRITE. SQ1394.2 +057700 MOVE TEST-COMPUTED TO PRINT-REC SQ1394.2 +057800 PERFORM WRITE-LINE SQ1394.2 +057900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1394.2 +058000 MOVE TEST-CORRECT TO PRINT-REC SQ1394.2 +058100 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +058200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1394.2 +058300 FAIL-ROUTINE-EX. SQ1394.2 +058400 EXIT. SQ1394.2 +058500 BAIL-OUT. SQ1394.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1394.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1394.2 +058800 BAIL-OUT-WRITE. SQ1394.2 +058900 MOVE CORRECT-A TO XXCORRECT. SQ1394.2 +059000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1394.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +059200 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +059300 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +059500 BAIL-OUT-EX. SQ1394.2 +059600 EXIT. SQ1394.2 +059700 CCVS1-EXIT. SQ1394.2 +059800 EXIT. SQ1394.2 +059900* SQ1394.2 +060000**************************************************************** SQ1394.2 +060100* * SQ1394.2 +060200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1394.2 +060300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1394.2 +060400* * SQ1394.2 +060500**************************************************************** SQ1394.2 +060600* SQ1394.2 +060700 SECT-SQ139A-MAIN SECTION. SQ1394.2 +060800* SQ1394.2 +060900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1394.2 +061000* OPEN OUTPUT STATEMENT. SQ1394.2 +061100* SQ1394.2 +061200 SEQ-INIT-01. SQ1394.2 +061300* SQ1394.2 +061400 MOVE 1 TO REC-CT SQ1394.2 +061500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1394.2 +061600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1394.2 +061700 MOVE 1 TO DECL-EXEC-SW SQ1394.2 +061800 MOVE "**" TO SQ-FS1-STATUS. SQ1394.2 +061900 SEQ-TEST-OP-01. SQ1394.2 +062000 OPEN OUTPUT SQ-FS1. SQ1394.2 +062100 SEQ-INIT-02. SQ1394.2 +062200 MOVE 1 TO REC-CT SQ1394.2 +062300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1394.2 +062400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1394.2 +062500 MOVE 9 TO DECL-EXEC-SW SQ1394.2 +062600 MOVE "**" TO SQ-FS1-STATUS. SQ1394.2 +062700 SEQ-TEST-OP-02. SQ1394.2 +062800 OPEN OUTPUT SQ-FS1. SQ1394.2 +062900* SQ1394.2 +063000* CHECK EXECUTION OF DECLARATIVE. SQ1394.2 +063100* SQ1394.2 +063200 MOVE "SEQ-TEST-OP-02" TO PAR-NAME. SQ1394.2 +063300 MOVE 1 TO REC-CT. SQ1394.2 +063400 GO TO SEQ-TEST-OP-02-01. SQ1394.2 +063500 SEQ-DELETE-02-01. SQ1394.2 +063600 PERFORM DE-LETE. SQ1394.2 +063700 GO TO SEQ-TEST-02-01-END. SQ1394.2 +063800 SEQ-TEST-OP-02-01. SQ1394.2 +063900 IF DECL-EXEC-SW = 0 SQ1394.2 +064000 PERFORM PASS SQ1394.2 +064100 ELSE SQ1394.2 +064200 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1394.2 +064300 MOVE 0 TO CORRECT-18V0 SQ1394.2 +064400 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1394.2 +064500 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ1394.2 +064600 PERFORM FAIL. SQ1394.2 +064700 SEQ-TEST-02-01-END. SQ1394.2 +064800 CCVS-EXIT SECTION. SQ1394.2 +064900 CCVS-999999. SQ1394.2 +065000 GO TO CLOSE-FILES. SQ1394.2 +*END-OF,SQ139A +*HEADER,COBOL,SQ140A +000100 IDENTIFICATION DIVISION. SQ1404.2 +000200 PROGRAM-ID. SQ1404.2 +000300 SQ140A. SQ1404.2 +000400**************************************************************** SQ1404.2 +000500* * SQ1404.2 +000600* VALIDATION FOR:- * SQ1404.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1404.2 +000900* REVISED 1986, AUGUST * SQ1404.2 +001000* * SQ1404.2 +001100* CREATION DATE / VALIDATION DATE * SQ1404.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1404.2 +001300* * SQ1404.2 +001400**************************************************************** SQ1404.2 +001500* * SQ1404.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1404.2 +001700* * SQ1404.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1404.2 +001900* X-55 SYSTEM PRINTER * SQ1404.2 +002000* X-82 SOURCE-COMPUTER * SQ1404.2 +002100* X-83 OBJECT-COMPUTER. * SQ1404.2 +002200* * SQ1404.2 +002300* * SQ1404.2 +002400**************************************************************** SQ1404.2 +002500* * SQ1404.2 +002600* SPLIT FROM SQ125A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1404.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1404.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1404.2 +002900* OPEN FOR OUTPUT FOR A MAGNETIC TAPE FILE WHICH IS ALREADY * SQ1404.2 +003000* OPEN IN THE OUTPUT MODE. (SEE SQ125A). * SQ1404.2 +003100* * SQ1404.2 +003200**************************************************************** SQ1404.2 +003300* SQ1404.2 +003400 ENVIRONMENT DIVISION. SQ1404.2 +003500 CONFIGURATION SECTION. SQ1404.2 +003600 SOURCE-COMPUTER. SQ1404.2 +003700 XXXXX082. SQ1404.2 +003800 OBJECT-COMPUTER. SQ1404.2 +003900 XXXXX083. SQ1404.2 +004000* SQ1404.2 +004100 INPUT-OUTPUT SECTION. SQ1404.2 +004200 FILE-CONTROL. SQ1404.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1404.2 +004400 XXXXX055. SQ1404.2 +004500* SQ1404.2 +004600P SELECT RAW-DATA ASSIGN TO SQ1404.2 +004700P XXXXX062 SQ1404.2 +004800P ORGANIZATION IS INDEXED SQ1404.2 +004900P ACCESS MODE IS RANDOM SQ1404.2 +005000P RECORD-KEY IS RAW-DATA-KEY. SQ1404.2 +005100P SQ1404.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1404.2 +005300 XXXXX001 SQ1404.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1404.2 +005500* SQ1404.2 +005600* SQ1404.2 +005700 DATA DIVISION. SQ1404.2 +005800 FILE SECTION. SQ1404.2 +005900 FD PRINT-FILE SQ1404.2 +006000C LABEL RECORDS SQ1404.2 +006100C XXXXX084 SQ1404.2 +006200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1404.2 +006300 . SQ1404.2 +006400 01 PRINT-REC PICTURE X(120). SQ1404.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1404.2 +006600P SQ1404.2 +006700PFD RAW-DATA. SQ1404.2 +006800P01 RAW-DATA-SATZ. SQ1404.2 +006900P 05 RAW-DATA-KEY PIC X(6). SQ1404.2 +007000P 05 C-DATE PIC 9(6). SQ1404.2 +007100P 05 C-TIME PIC 9(8). SQ1404.2 +007200P 05 NO-OF-TESTS PIC 99. SQ1404.2 +007300P 05 C-OK PIC 999. SQ1404.2 +007400P 05 C-ALL PIC 999. SQ1404.2 +007500P 05 C-FAIL PIC 999. SQ1404.2 +007600P 05 C-DELETED PIC 999. SQ1404.2 +007700P 05 C-INSPECT PIC 999. SQ1404.2 +007800P 05 C-NOTE PIC X(13). SQ1404.2 +007900P 05 C-INDENT PIC X. SQ1404.2 +008000P 05 C-ABORT PIC X(8). SQ1404.2 +008100* SQ1404.2 +008200 FD SQ-FS1 SQ1404.2 +008300C LABEL RECORD IS STANDARD SQ1404.2 +008400 . SQ1404.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1404.2 +008600* SQ1404.2 +008700 WORKING-STORAGE SECTION. SQ1404.2 +008800* SQ1404.2 +008900*************************************************************** SQ1404.2 +009000* * SQ1404.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1404.2 +009200* * SQ1404.2 +009300*************************************************************** SQ1404.2 +009400* SQ1404.2 +009500 01 SQ-FS1-STATUS. SQ1404.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1404.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1404.2 +009800* SQ1404.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1404.2 +010000* SQ1404.2 +010100* SQ1404.2 +010200*************************************************************** SQ1404.2 +010300* * SQ1404.2 +010400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1404.2 +010500* * SQ1404.2 +010600*************************************************************** SQ1404.2 +010700* SQ1404.2 +010800 01 REC-SKEL-SUB PIC 99. SQ1404.2 +010900* SQ1404.2 +011000 01 FILE-RECORD-INFORMATION-REC. SQ1404.2 +011100 03 FILE-RECORD-INFO-SKELETON. SQ1404.2 +011200 05 FILLER PICTURE X(48) VALUE SQ1404.2 +011300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1404.2 +011400 05 FILLER PICTURE X(46) VALUE SQ1404.2 +011500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1404.2 +011600 05 FILLER PICTURE X(26) VALUE SQ1404.2 +011700 ",LFIL=000000,ORG= ,LBLR= ". SQ1404.2 +011800 05 FILLER PICTURE X(37) VALUE SQ1404.2 +011900 ",RECKEY= ". SQ1404.2 +012000 05 FILLER PICTURE X(38) VALUE SQ1404.2 +012100 ",ALTKEY1= ". SQ1404.2 +012200 05 FILLER PICTURE X(38) VALUE SQ1404.2 +012300 ",ALTKEY2= ". SQ1404.2 +012400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1404.2 +012500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1404.2 +012600 05 FILE-RECORD-INFO-P1-120. SQ1404.2 +012700 07 FILLER PIC X(5). SQ1404.2 +012800 07 XFILE-NAME PIC X(6). SQ1404.2 +012900 07 FILLER PIC X(8). SQ1404.2 +013000 07 XRECORD-NAME PIC X(6). SQ1404.2 +013100 07 FILLER PIC X(1). SQ1404.2 +013200 07 REELUNIT-NUMBER PIC 9(1). SQ1404.2 +013300 07 FILLER PIC X(7). SQ1404.2 +013400 07 XRECORD-NUMBER PIC 9(6). SQ1404.2 +013500 07 FILLER PIC X(6). SQ1404.2 +013600 07 UPDATE-NUMBER PIC 9(2). SQ1404.2 +013700 07 FILLER PIC X(5). SQ1404.2 +013800 07 ODO-NUMBER PIC 9(4). SQ1404.2 +013900 07 FILLER PIC X(5). SQ1404.2 +014000 07 XPROGRAM-NAME PIC X(5). SQ1404.2 +014100 07 FILLER PIC X(7). SQ1404.2 +014200 07 XRECORD-LENGTH PIC 9(6). SQ1404.2 +014300 07 FILLER PIC X(7). SQ1404.2 +014400 07 CHARS-OR-RECORDS PIC X(2). SQ1404.2 +014500 07 FILLER PIC X(1). SQ1404.2 +014600 07 XBLOCK-SIZE PIC 9(4). SQ1404.2 +014700 07 FILLER PIC X(6). SQ1404.2 +014800 07 RECORDS-IN-FILE PIC 9(6). SQ1404.2 +014900 07 FILLER PIC X(5). SQ1404.2 +015000 07 XFILE-ORGANIZATION PIC X(2). SQ1404.2 +015100 07 FILLER PIC X(6). SQ1404.2 +015200 07 XLABEL-TYPE PIC X(1). SQ1404.2 +015300 05 FILE-RECORD-INFO-P121-240. SQ1404.2 +015400 07 FILLER PIC X(8). SQ1404.2 +015500 07 XRECORD-KEY PIC X(29). SQ1404.2 +015600 07 FILLER PIC X(9). SQ1404.2 +015700 07 ALTERNATE-KEY1 PIC X(29). SQ1404.2 +015800 07 FILLER PIC X(9). SQ1404.2 +015900 07 ALTERNATE-KEY2 PIC X(29). SQ1404.2 +016000 07 FILLER PIC X(7). SQ1404.2 +016100* SQ1404.2 +016200 01 TEST-RESULTS. SQ1404.2 +016300 02 FILLER PIC X VALUE SPACE. SQ1404.2 +016400 02 PAR-NAME. SQ1404.2 +016500 03 FILLER PIC X(14) VALUE SPACE. SQ1404.2 +016600 03 PARDOT-X PIC X VALUE SPACE. SQ1404.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1404.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1404.2 +016900 02 FEATURE PIC X(24) VALUE SPACE. SQ1404.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1404.2 +017100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1404.2 +017200 02 FILLER PIC X(9) VALUE SPACE. SQ1404.2 +017300 02 RE-MARK PIC X(61). SQ1404.2 +017400 01 TEST-COMPUTED. SQ1404.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1404.2 +017600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1404.2 +017700 02 COMPUTED-X. SQ1404.2 +017800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1404.2 +017900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1404.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1404.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1404.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1404.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1404.2 +018400 04 COMPUTED-18V0 PIC -9(18). SQ1404.2 +018500 04 FILLER PIC X. SQ1404.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1404.2 +018700 01 TEST-CORRECT. SQ1404.2 +018800 02 FILLER PIC X(30) VALUE SPACE. SQ1404.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1404.2 +019000 02 CORRECT-X. SQ1404.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1404.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1404.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1404.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1404.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1404.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. SQ1404.2 +019700 04 CORRECT-18V0 PIC -9(18). SQ1404.2 +019800 04 FILLER PIC X. SQ1404.2 +019900 03 FILLER PIC X(2) VALUE SPACE. SQ1404.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1404.2 +020100* SQ1404.2 +020200 01 CCVS-C-1. SQ1404.2 +020300 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1404.2 +020500 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1404.2 +020700 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1404.2 +020900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1404.2 +021000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1404.2 +021100 01 CCVS-C-2. SQ1404.2 +021200 02 FILLER PIC X(19) VALUE SPACE. SQ1404.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". SQ1404.2 +021400 02 FILLER PIC X(19) VALUE SPACE. SQ1404.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". SQ1404.2 +021600 02 FILLER PIC X(72) VALUE SPACE. SQ1404.2 +021700* SQ1404.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1404.2 +021900 01 REC-CT PIC 99 VALUE ZERO. SQ1404.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1404.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1404.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1404.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1404.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1404.2 +022900 01 CCVS-H-1. SQ1404.2 +023000 02 FILLER PIC X(39) VALUE SPACES. SQ1404.2 +023100 02 FILLER PIC X(42) VALUE SQ1404.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1404.2 +023300 02 FILLER PIC X(39) VALUE SPACES. SQ1404.2 +023400 01 CCVS-H-2A. SQ1404.2 +023500 02 FILLER PIC X(40) VALUE SPACE. SQ1404.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1404.2 +023700 02 FILLER PIC XXXX VALUE SQ1404.2 +023800 "4.2 ". SQ1404.2 +023900 02 FILLER PIC X(28) VALUE SQ1404.2 +024000 " COPY - NOT FOR DISTRIBUTION". SQ1404.2 +024100 02 FILLER PIC X(41) VALUE SPACE. SQ1404.2 +024200* SQ1404.2 +024300 01 CCVS-H-2B. SQ1404.2 +024400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1404.2 +024500 02 TEST-ID PIC X(9). SQ1404.2 +024600 02 FILLER PIC X(4) VALUE " IN ". SQ1404.2 +024700 02 FILLER PIC X(12) VALUE SQ1404.2 +024800 " HIGH ". SQ1404.2 +024900 02 FILLER PIC X(22) VALUE SQ1404.2 +025000 " LEVEL VALIDATION FOR ". SQ1404.2 +025100 02 FILLER PIC X(58) VALUE SQ1404.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +025300 01 CCVS-H-3. SQ1404.2 +025400 02 FILLER PIC X(34) VALUE SQ1404.2 +025500 " FOR OFFICIAL USE ONLY ". SQ1404.2 +025600 02 FILLER PIC X(58) VALUE SQ1404.2 +025700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1404.2 +025800 02 FILLER PIC X(28) VALUE SQ1404.2 +025900 " COPYRIGHT 1985,1986 ". SQ1404.2 +026000 01 CCVS-E-1. SQ1404.2 +026100 02 FILLER PIC X(52) VALUE SPACE. SQ1404.2 +026200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1404.2 +026300 02 ID-AGAIN PIC X(9). SQ1404.2 +026400 02 FILLER PIC X(45) VALUE SPACES. SQ1404.2 +026500 01 CCVS-E-2. SQ1404.2 +026600 02 FILLER PIC X(31) VALUE SPACE. SQ1404.2 +026700 02 FILLER PIC X(21) VALUE SPACE. SQ1404.2 +026800 02 CCVS-E-2-2. SQ1404.2 +026900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1404.2 +027000 03 FILLER PIC X VALUE SPACE. SQ1404.2 +027100 03 ENDER-DESC PIC X(44) VALUE SQ1404.2 +027200 "ERRORS ENCOUNTERED". SQ1404.2 +027300 01 CCVS-E-3. SQ1404.2 +027400 02 FILLER PIC X(22) VALUE SQ1404.2 +027500 " FOR OFFICIAL USE ONLY". SQ1404.2 +027600 02 FILLER PIC X(12) VALUE SPACE. SQ1404.2 +027700 02 FILLER PIC X(58) VALUE SQ1404.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +027900 02 FILLER PIC X(8) VALUE SPACE. SQ1404.2 +028000 02 FILLER PIC X(20) VALUE SQ1404.2 +028100 " COPYRIGHT 1985,1986". SQ1404.2 +028200 01 CCVS-E-4. SQ1404.2 +028300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1404.2 +028400 02 FILLER PIC X(4) VALUE " OF ". SQ1404.2 +028500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1404.2 +028600 02 FILLER PIC X(40) VALUE SQ1404.2 +028700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1404.2 +028800 01 XXINFO. SQ1404.2 +028900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1404.2 +029000 02 INFO-TEXT. SQ1404.2 +029100 04 FILLER PIC X(8) VALUE SPACE. SQ1404.2 +029200 04 XXCOMPUTED PIC X(20). SQ1404.2 +029300 04 FILLER PIC X(5) VALUE SPACE. SQ1404.2 +029400 04 XXCORRECT PIC X(20). SQ1404.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). SQ1404.2 +029600 01 HYPHEN-LINE. SQ1404.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. SQ1404.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1404.2 +029900- "*****************************************". SQ1404.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1404.2 +030100- "******************************". SQ1404.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1404.2 +030300 "SQ140A". SQ1404.2 +030400* SQ1404.2 +030500* SQ1404.2 +030600 PROCEDURE DIVISION. SQ1404.2 +030700 DECLARATIVES. SQ1404.2 +030800 SQ140A-DECLARATIVE-001-SECT SECTION. SQ1404.2 +030900 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1404.2 +031000 INPUT-ERROR-PROCEDURE. SQ1404.2 +031100 IF DECL-EXEC-SW NOT = 9 SQ1404.2 +031200 GO TO NOT-DECL-9. SQ1404.2 +031300* SQ1404.2 +031400* DECLARATIVE PROCEDURE ENTERED FROM SECOND OPEN OUTPUT SQ1404.2 +031500* SQ1404.2 +031600 DECL-OPEN-TEST. SQ1404.2 +031700 MOVE SPACE TO DUMMY-RECORD SQ1404.2 +031800 PERFORM DECL-WRITE-LINE SQ1404.2 +031900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1404.2 +032000 TO DUMMY-RECORD SQ1404.2 +032100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1404.2 +032200 GO TO END-DECLS. SQ1404.2 +032300* SQ1404.2 +032400* SQ1404.2 +032500 NOT-DECL-9. SQ1404.2 +032600 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1404.2 +032700 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1404.2 +032800 MOVE 9 TO CORRECT-18V0. SQ1404.2 +032900 MOVE "UNEXPECTED ENTRY TO DECLARATIVES" TO RE-MARK. SQ1404.2 +033000 PERFORM DECL-FAIL. SQ1404.2 +033100 GO TO END-DECLS. SQ1404.2 +033200* SQ1404.2 +033300* SQ1404.2 +033400* SQ1404.2 +033500 DECL-PASS. SQ1404.2 +033600 MOVE "PASS " TO P-OR-F. SQ1404.2 +033700 ADD 1 TO PASS-COUNTER. SQ1404.2 +033800 PERFORM DECL-PRINT-DETAIL. SQ1404.2 +033900* SQ1404.2 +034000 DECL-FAIL. SQ1404.2 +034100 MOVE "FAIL*" TO P-OR-F. SQ1404.2 +034200 ADD 1 TO ERROR-COUNTER. SQ1404.2 +034300 PERFORM DECL-PRINT-DETAIL. SQ1404.2 +034400* SQ1404.2 +034500 DECL-PRINT-DETAIL. SQ1404.2 +034600 IF REC-CT NOT EQUAL TO ZERO SQ1404.2 +034700 MOVE "." TO PARDOT-X SQ1404.2 +034800 MOVE REC-CT TO DOTVALUE. SQ1404.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. SQ1404.2 +035000 PERFORM DECL-WRITE-LINE. SQ1404.2 +035100 IF P-OR-F EQUAL TO "FAIL*" SQ1404.2 +035200 PERFORM DECL-WRITE-LINE SQ1404.2 +035300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1404.2 +035400 ELSE SQ1404.2 +035500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1404.2 +035600 MOVE SPACE TO P-OR-F. SQ1404.2 +035700 MOVE SPACE TO COMPUTED-X. SQ1404.2 +035800 MOVE SPACE TO CORRECT-X. SQ1404.2 +035900 IF REC-CT EQUAL TO ZERO SQ1404.2 +036000 MOVE SPACE TO PAR-NAME. SQ1404.2 +036100 MOVE SPACE TO RE-MARK. SQ1404.2 +036200* SQ1404.2 +036300 DECL-WRITE-LINE. SQ1404.2 +036400 ADD 1 TO RECORD-COUNT. SQ1404.2 +036500Y IF RECORD-COUNT GREATER 50 SQ1404.2 +036600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1404.2 +036700Y MOVE SPACE TO DUMMY-RECORD SQ1404.2 +036800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1404.2 +036900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1404.2 +037000Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1404.2 +037100Y PERFORM DECL-WRT-LN 2 TIMES SQ1404.2 +037200Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1404.2 +037300Y PERFORM DECL-WRT-LN SQ1404.2 +037400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1404.2 +037500Y MOVE ZERO TO RECORD-COUNT. SQ1404.2 +037600 PERFORM DECL-WRT-LN. SQ1404.2 +037700* SQ1404.2 +037800 DECL-WRT-LN. SQ1404.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1404.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1404.2 +038100* SQ1404.2 +038200 DECL-FAIL-ROUTINE. SQ1404.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1404.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1404.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1404.2 +038700 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +038800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +039000 GO TO DECL-FAIL-EX. SQ1404.2 +039100 DECL-FAIL-WRITE. SQ1404.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC SQ1404.2 +039300 PERFORM DECL-WRITE-LINE SQ1404.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1404.2 +039500 MOVE TEST-CORRECT TO PRINT-REC SQ1404.2 +039600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +039700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1404.2 +039800 DECL-FAIL-EX. SQ1404.2 +039900 EXIT. SQ1404.2 +040000* SQ1404.2 +040100 DECL-BAIL. SQ1404.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1404.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1404.2 +040400 DECL-BAIL-WRITE. SQ1404.2 +040500 MOVE CORRECT-A TO XXCORRECT. SQ1404.2 +040600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1404.2 +040700 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +040800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +040900 DECL-BAIL-EX. SQ1404.2 +041000 EXIT. SQ1404.2 +041100* SQ1404.2 +041200 END-DECLS. SQ1404.2 +041300 MOVE ZERO TO DECL-EXEC-SW. SQ1404.2 +041400 END DECLARATIVES. SQ1404.2 +041500* SQ1404.2 +041600* SQ1404.2 +041700 CCVS1 SECTION. SQ1404.2 +041800 OPEN-FILES. SQ1404.2 +041900P OPEN I-O RAW-DATA. SQ1404.2 +042000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1404.2 +042100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1404.2 +042200P MOVE "ABORTED " TO C-ABORT. SQ1404.2 +042300P ADD 1 TO C-NO-OF-TESTS. SQ1404.2 +042400P ACCEPT C-DATE FROM DATE. SQ1404.2 +042500P ACCEPT C-TIME FROM TIME. SQ1404.2 +042600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1404.2 +042700PEND-E-1. SQ1404.2 +042800P CLOSE RAW-DATA. SQ1404.2 +042900 OPEN OUTPUT PRINT-FILE. SQ1404.2 +043000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1404.2 +043100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1404.2 +043200 MOVE SPACE TO TEST-RESULTS. SQ1404.2 +043300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1404.2 +043400 MOVE ZERO TO REC-SKEL-SUB. SQ1404.2 +043500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1404.2 +043600 GO TO CCVS1-EXIT. SQ1404.2 +043700* SQ1404.2 +043800 CCVS-INIT-FILE. SQ1404.2 +043900 ADD 1 TO REC-SKL-SUB. SQ1404.2 +044000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1404.2 +044100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1404.2 +044200* SQ1404.2 +044300 CLOSE-FILES. SQ1404.2 +044400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1404.2 +044500 CLOSE PRINT-FILE. SQ1404.2 +044600P OPEN I-O RAW-DATA. SQ1404.2 +044700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1404.2 +044800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1404.2 +044900P MOVE "OK. " TO C-ABORT. SQ1404.2 +045000P MOVE PASS-COUNTER TO C-OK. SQ1404.2 +045100P MOVE ERROR-HOLD TO C-ALL. SQ1404.2 +045200P MOVE ERROR-COUNTER TO C-FAIL. SQ1404.2 +045300P MOVE DELETE-CNT TO C-DELETED. SQ1404.2 +045400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1404.2 +045500P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1404.2 +045600PEND-E-2. SQ1404.2 +045700P CLOSE RAW-DATA. SQ1404.2 +045800 TERMINATE-CCVS. SQ1404.2 +045900S EXIT PROGRAM. SQ1404.2 +046000 STOP RUN. SQ1404.2 +046100* SQ1404.2 +046200 INSPT. SQ1404.2 +046300 MOVE "INSPT" TO P-OR-F. SQ1404.2 +046400 ADD 1 TO INSPECT-COUNTER. SQ1404.2 +046500 PERFORM PRINT-DETAIL. SQ1404.2 +046600 SQ1404.2 +046700 PASS. SQ1404.2 +046800 MOVE "PASS " TO P-OR-F. SQ1404.2 +046900 ADD 1 TO PASS-COUNTER. SQ1404.2 +047000 PERFORM PRINT-DETAIL. SQ1404.2 +047100* SQ1404.2 +047200 FAIL. SQ1404.2 +047300 MOVE "FAIL*" TO P-OR-F. SQ1404.2 +047400 ADD 1 TO ERROR-COUNTER. SQ1404.2 +047500 PERFORM PRINT-DETAIL. SQ1404.2 +047600* SQ1404.2 +047700 DE-LETE. SQ1404.2 +047800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1404.2 +047900 MOVE "*****" TO P-OR-F. SQ1404.2 +048000 ADD 1 TO DELETE-COUNTER. SQ1404.2 +048100 PERFORM PRINT-DETAIL. SQ1404.2 +048200* SQ1404.2 +048300 PRINT-DETAIL. SQ1404.2 +048400 IF REC-CT NOT EQUAL TO ZERO SQ1404.2 +048500 MOVE "." TO PARDOT-X SQ1404.2 +048600 MOVE REC-CT TO DOTVALUE. SQ1404.2 +048700 MOVE TEST-RESULTS TO PRINT-REC. SQ1404.2 +048800 PERFORM WRITE-LINE. SQ1404.2 +048900 IF P-OR-F EQUAL TO "FAIL*" SQ1404.2 +049000 PERFORM WRITE-LINE SQ1404.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1404.2 +049200 ELSE SQ1404.2 +049300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1404.2 +049400 MOVE SPACE TO P-OR-F. SQ1404.2 +049500 MOVE SPACE TO COMPUTED-X. SQ1404.2 +049600 MOVE SPACE TO CORRECT-X. SQ1404.2 +049700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1404.2 +049800 MOVE SPACE TO RE-MARK. SQ1404.2 +049900* SQ1404.2 +050000 HEAD-ROUTINE. SQ1404.2 +050100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1404.2 +050400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1404.2 +050500 COLUMN-NAMES-ROUTINE. SQ1404.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +050900 END-ROUTINE. SQ1404.2 +051000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1404.2 +051100 PERFORM WRITE-LINE 5 TIMES. SQ1404.2 +051200 END-RTN-EXIT. SQ1404.2 +051300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1404.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +051500* SQ1404.2 +051600 END-ROUTINE-1. SQ1404.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1404.2 +051800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1404.2 +051900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1404.2 +052000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1404.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1404.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1404.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1404.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1404.2 +052500 PERFORM WRITE-LINE. SQ1404.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1404.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1404.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +052900 ELSE SQ1404.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1404.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1404.2 +053200 PERFORM WRITE-LINE. SQ1404.2 +053300 END-ROUTINE-13. SQ1404.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1404.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +053600 ELSE SQ1404.2 +053700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1404.2 +053800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1404.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1404.2 +054000 PERFORM WRITE-LINE. SQ1404.2 +054100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1404.2 +054200 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +054300 ELSE SQ1404.2 +054400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1404.2 +054500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1404.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +054700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +054800* SQ1404.2 +054900 WRITE-LINE. SQ1404.2 +055000 ADD 1 TO RECORD-COUNT. SQ1404.2 +055100Y IF RECORD-COUNT GREATER 50 SQ1404.2 +055200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1404.2 +055300Y MOVE SPACE TO DUMMY-RECORD SQ1404.2 +055400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1404.2 +055500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1404.2 +055600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1404.2 +055700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1404.2 +055800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1404.2 +055900Y MOVE ZERO TO RECORD-COUNT. SQ1404.2 +056000 PERFORM WRT-LN. SQ1404.2 +056100* SQ1404.2 +056200 WRT-LN. SQ1404.2 +056300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1404.2 +056400 MOVE SPACE TO DUMMY-RECORD. SQ1404.2 +056500 BLANK-LINE-PRINT. SQ1404.2 +056600 PERFORM WRT-LN. SQ1404.2 +056700 FAIL-ROUTINE. SQ1404.2 +056800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1404.2 +056900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1404.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +057100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1404.2 +057200 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +057300 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +057400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +057500 GO TO FAIL-ROUTINE-EX. SQ1404.2 +057600 FAIL-ROUTINE-WRITE. SQ1404.2 +057700 MOVE TEST-COMPUTED TO PRINT-REC SQ1404.2 +057800 PERFORM WRITE-LINE SQ1404.2 +057900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1404.2 +058000 MOVE TEST-CORRECT TO PRINT-REC SQ1404.2 +058100 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +058200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1404.2 +058300 FAIL-ROUTINE-EX. SQ1404.2 +058400 EXIT. SQ1404.2 +058500 BAIL-OUT. SQ1404.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1404.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1404.2 +058800 BAIL-OUT-WRITE. SQ1404.2 +058900 MOVE CORRECT-A TO XXCORRECT. SQ1404.2 +059000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1404.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +059200 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +059300 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +059500 BAIL-OUT-EX. SQ1404.2 +059600 EXIT. SQ1404.2 +059700 CCVS1-EXIT. SQ1404.2 +059800 EXIT. SQ1404.2 +059900* SQ1404.2 +060000**************************************************************** SQ1404.2 +060100* * SQ1404.2 +060200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1404.2 +060300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1404.2 +060400* * SQ1404.2 +060500**************************************************************** SQ1404.2 +060600* SQ1404.2 +060700 SECT-SQ140A-MAIN SECTION. SQ1404.2 +060800* SQ1404.2 +060900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1404.2 +061000* OPEN OUTPUT STATEMENT. SQ1404.2 +061100* SQ1404.2 +061200 SEQ-INIT-01. SQ1404.2 +061300* SQ1404.2 +061400 MOVE 1 TO REC-CT SQ1404.2 +061500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1404.2 +061600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1404.2 +061700 MOVE 1 TO DECL-EXEC-SW SQ1404.2 +061800 MOVE "**" TO SQ-FS1-STATUS. SQ1404.2 +061900 SEQ-TEST-OP-01. SQ1404.2 +062000 OPEN OUTPUT SQ-FS1. SQ1404.2 +062100 SEQ-INIT-02. SQ1404.2 +062200 MOVE 1 TO REC-CT SQ1404.2 +062300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1404.2 +062400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1404.2 +062500 MOVE 9 TO DECL-EXEC-SW SQ1404.2 +062600 MOVE "**" TO SQ-FS1-STATUS. SQ1404.2 +062700 SEQ-TEST-OP-02. SQ1404.2 +062800 OPEN OUTPUT SQ-FS1. SQ1404.2 +062900* SQ1404.2 +063000* CHECK EXECUTION OF DECLARATIVE. SQ1404.2 +063100* SQ1404.2 +063200 MOVE "SEQ-TEST-OP-02" TO PAR-NAME. SQ1404.2 +063300 MOVE 1 TO REC-CT. SQ1404.2 +063400 SEQ-TEST-02-01-END. SQ1404.2 +063500* SQ1404.2 +063600* CHECK THE I-O STATUS VALUE RETURNED BY THE SECOND OPEN. SQ1404.2 +063700* SQ1404.2 +063800 ADD 1 TO REC-CT. SQ1404.2 +063900 GO TO SEQ-TEST-OP-02-02. SQ1404.2 +064000 SEQ-DELETE-02-02. SQ1404.2 +064100 PERFORM DE-LETE. SQ1404.2 +064200 GO TO SEQ-TEST-02-02-END. SQ1404.2 +064300 SEQ-TEST-OP-02-02. SQ1404.2 +064400 IF SQ-FS1-STATUS = "41" SQ1404.2 +064500 PERFORM PASS SQ1404.2 +064600 ELSE SQ1404.2 +064700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1404.2 +064800 MOVE "41" TO CORRECT-A SQ1404.2 +064900 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1404.2 +065000 TO RE-MARK SQ1404.2 +065100 MOVE "VII-4, 1.5.3(4)A" TO ANSI-REFERENCE SQ1404.2 +065200 PERFORM FAIL. SQ1404.2 +065300 SEQ-TEST-02-02-END. SQ1404.2 +065400* SQ1404.2 +065500* SQ1404.2 +065600 CCVS-EXIT SECTION. SQ1404.2 +065700 CCVS-999999. SQ1404.2 +065800 GO TO CLOSE-FILES. SQ1404.2 +*END-OF,SQ140A +*HEADER,COBOL,SQ141A +000100 IDENTIFICATION DIVISION. SQ1414.2 +000200 PROGRAM-ID. SQ1414.2 +000300 SQ141A. SQ1414.2 +000400**************************************************************** SQ1414.2 +000500* * SQ1414.2 +000600* VALIDATION FOR:- * SQ1414.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1414.2 +000900* REVISED 1986, AUGUST * SQ1414.2 +001000* * SQ1414.2 +001100* CREATION DATE / VALIDATION DATE * SQ1414.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1414.2 +001300* * SQ1414.2 +001400**************************************************************** SQ1414.2 +001500* * SQ1414.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1414.2 +001700* * SQ1414.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1414.2 +001900* X-55 SYSTEM PRINTER * SQ1414.2 +002000* X-82 SOURCE-COMPUTER * SQ1414.2 +002100* X-83 OBJECT-COMPUTER. * SQ1414.2 +002200* * SQ1414.2 +002300* * SQ1414.2 +002400**************************************************************** SQ1414.2 +002500* * SQ1414.2 +002600* SPLIT FROM SQ129A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1414.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1414.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1414.2 +002900* OPEN FOR INPUT ON A TAPE FILE WHICH IS NOT PRESENT. * SQ1414.2 +003000* (SEE SQ129A). * SQ1414.2 +003100* * SQ1414.2 +003200**************************************************************** SQ1414.2 +003300* SQ1414.2 +003400 ENVIRONMENT DIVISION. SQ1414.2 +003500 CONFIGURATION SECTION. SQ1414.2 +003600 SOURCE-COMPUTER. SQ1414.2 +003700 XXXXX082. SQ1414.2 +003800 OBJECT-COMPUTER. SQ1414.2 +003900 XXXXX083. SQ1414.2 +004000* SQ1414.2 +004100 INPUT-OUTPUT SECTION. SQ1414.2 +004200 FILE-CONTROL. SQ1414.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1414.2 +004400 XXXXX055. SQ1414.2 +004500* SQ1414.2 +004600P SELECT RAW-DATA ASSIGN TO SQ1414.2 +004700P XXXXX062 SQ1414.2 +004800P ORGANIZATION IS INDEXED SQ1414.2 +004900P ACCESS MODE IS RANDOM SQ1414.2 +005000P RECORD-KEY IS RAW-DATA-KEY. SQ1414.2 +005100P SQ1414.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1414.2 +005300 XXXXX001 SQ1414.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1414.2 +005500* SQ1414.2 +005600* SQ1414.2 +005700 DATA DIVISION. SQ1414.2 +005800 FILE SECTION. SQ1414.2 +005900 FD PRINT-FILE SQ1414.2 +006000C LABEL RECORDS SQ1414.2 +006100C XXXXX084 SQ1414.2 +006200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1414.2 +006300 . SQ1414.2 +006400 01 PRINT-REC PICTURE X(120). SQ1414.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1414.2 +006600P SQ1414.2 +006700PFD RAW-DATA. SQ1414.2 +006800P01 RAW-DATA-SATZ. SQ1414.2 +006900P 05 RAW-DATA-KEY PIC X(6). SQ1414.2 +007000P 05 C-DATE PIC 9(6). SQ1414.2 +007100P 05 C-TIME PIC 9(8). SQ1414.2 +007200P 05 NO-OF-TESTS PIC 99. SQ1414.2 +007300P 05 C-OK PIC 999. SQ1414.2 +007400P 05 C-ALL PIC 999. SQ1414.2 +007500P 05 C-FAIL PIC 999. SQ1414.2 +007600P 05 C-DELETED PIC 999. SQ1414.2 +007700P 05 C-INSPECT PIC 999. SQ1414.2 +007800P 05 C-NOTE PIC X(13). SQ1414.2 +007900P 05 C-INDENT PIC X. SQ1414.2 +008000P 05 C-ABORT PIC X(8). SQ1414.2 +008100* SQ1414.2 +008200 FD SQ-FS1 SQ1414.2 +008300C LABEL RECORD IS STANDARD SQ1414.2 +008400 . SQ1414.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1414.2 +008600* SQ1414.2 +008700 WORKING-STORAGE SECTION. SQ1414.2 +008800* SQ1414.2 +008900*************************************************************** SQ1414.2 +009000* * SQ1414.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1414.2 +009200* * SQ1414.2 +009300*************************************************************** SQ1414.2 +009400* SQ1414.2 +009500 01 SQ-FS1-STATUS. SQ1414.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1414.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1414.2 +009800* SQ1414.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1414.2 +010000* SQ1414.2 +010100*************************************************************** SQ1414.2 +010200* * SQ1414.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1414.2 +010400* * SQ1414.2 +010500*************************************************************** SQ1414.2 +010600* SQ1414.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1414.2 +010800* SQ1414.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1414.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1414.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1414.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1414.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1414.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1414.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1414.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1414.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1414.2 +011800 ",RECKEY= ". SQ1414.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1414.2 +012000 ",ALTKEY1= ". SQ1414.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1414.2 +012200 ",ALTKEY2= ". SQ1414.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1414.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1414.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1414.2 +012600 07 FILLER PIC X(5). SQ1414.2 +012700 07 XFILE-NAME PIC X(6). SQ1414.2 +012800 07 FILLER PIC X(8). SQ1414.2 +012900 07 XRECORD-NAME PIC X(6). SQ1414.2 +013000 07 FILLER PIC X(1). SQ1414.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1414.2 +013200 07 FILLER PIC X(7). SQ1414.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1414.2 +013400 07 FILLER PIC X(6). SQ1414.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1414.2 +013600 07 FILLER PIC X(5). SQ1414.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1414.2 +013800 07 FILLER PIC X(5). SQ1414.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1414.2 +014000 07 FILLER PIC X(7). SQ1414.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1414.2 +014200 07 FILLER PIC X(7). SQ1414.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1414.2 +014400 07 FILLER PIC X(1). SQ1414.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1414.2 +014600 07 FILLER PIC X(6). SQ1414.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1414.2 +014800 07 FILLER PIC X(5). SQ1414.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1414.2 +015000 07 FILLER PIC X(6). SQ1414.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1414.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1414.2 +015300 07 FILLER PIC X(8). SQ1414.2 +015400 07 XRECORD-KEY PIC X(29). SQ1414.2 +015500 07 FILLER PIC X(9). SQ1414.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1414.2 +015700 07 FILLER PIC X(9). SQ1414.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1414.2 +015900 07 FILLER PIC X(7). SQ1414.2 +016000* SQ1414.2 +016100 01 TEST-RESULTS. SQ1414.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1414.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1414.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016700 02 PAR-NAME. SQ1414.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1414.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1414.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1414.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1414.2 +017200 02 RE-MARK PIC X(61). SQ1414.2 +017300 01 TEST-COMPUTED. SQ1414.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1414.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1414.2 +017600 02 COMPUTED-X. SQ1414.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1414.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1414.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1414.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1414.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1414.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1414.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1414.2 +018400 04 FILLER PIC X. SQ1414.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1414.2 +018600 01 TEST-CORRECT. SQ1414.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1414.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1414.2 +018900 02 CORRECT-X. SQ1414.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1414.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1414.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1414.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1414.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1414.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1414.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1414.2 +019700 04 FILLER PIC X. SQ1414.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1414.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1414.2 +020000 01 CCVS-C-1. SQ1414.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1414.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1414.2 +020300- "SS PARAGRAPH-NAME SQ1414.2 +020400- " REMARKS". SQ1414.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1414.2 +020600 01 CCVS-C-2. SQ1414.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1414.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1414.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1414.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1414.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1414.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1414.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1414.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1414.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1414.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1414.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1414.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1414.2 +022300 01 CCVS-H-1. SQ1414.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1414.2 +022500 02 FILLER PIC X(42) VALUE SQ1414.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1414.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1414.2 +022800 01 CCVS-H-2A. SQ1414.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1414.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1414.2 +023100 02 FILLER PIC XXXX VALUE SQ1414.2 +023200 "4.2 ". SQ1414.2 +023300 02 FILLER PIC X(28) VALUE SQ1414.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1414.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1414.2 +023600* SQ1414.2 +023700 01 CCVS-H-2B. SQ1414.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1414.2 +023900 02 TEST-ID PIC X(9). SQ1414.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1414.2 +024100 02 FILLER PIC X(12) VALUE SQ1414.2 +024200 " HIGH ". SQ1414.2 +024300 02 FILLER PIC X(22) VALUE SQ1414.2 +024400 " LEVEL VALIDATION FOR ". SQ1414.2 +024500 02 FILLER PIC X(58) VALUE SQ1414.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +024700 01 CCVS-H-3. SQ1414.2 +024800 02 FILLER PIC X(34) VALUE SQ1414.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1414.2 +025000 02 FILLER PIC X(58) VALUE SQ1414.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1414.2 +025200 02 FILLER PIC X(28) VALUE SQ1414.2 +025300 " COPYRIGHT 1985,1986 ". SQ1414.2 +025400 01 CCVS-E-1. SQ1414.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1414.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1414.2 +025700 02 ID-AGAIN PIC X(9). SQ1414.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1414.2 +025900 01 CCVS-E-2. SQ1414.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1414.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1414.2 +026200 02 CCVS-E-2-2. SQ1414.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1414.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1414.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1414.2 +026600 "ERRORS ENCOUNTERED". SQ1414.2 +026700 01 CCVS-E-3. SQ1414.2 +026800 02 FILLER PIC X(22) VALUE SQ1414.2 +026900 " FOR OFFICIAL USE ONLY". SQ1414.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1414.2 +027100 02 FILLER PIC X(58) VALUE SQ1414.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1414.2 +027400 02 FILLER PIC X(20) VALUE SQ1414.2 +027500 " COPYRIGHT 1985,1986". SQ1414.2 +027600 01 CCVS-E-4. SQ1414.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1414.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1414.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1414.2 +028000 02 FILLER PIC X(40) VALUE SQ1414.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1414.2 +028200 01 XXINFO. SQ1414.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1414.2 +028400 02 INFO-TEXT. SQ1414.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1414.2 +028600 04 XXCOMPUTED PIC X(20). SQ1414.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1414.2 +028800 04 XXCORRECT PIC X(20). SQ1414.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1414.2 +029000 01 HYPHEN-LINE. SQ1414.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1414.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1414.2 +029300- "*****************************************". SQ1414.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1414.2 +029500- "******************************". SQ1414.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1414.2 +029700 "SQ141A". SQ1414.2 +029800* SQ1414.2 +029900* SQ1414.2 +030000 PROCEDURE DIVISION. SQ1414.2 +030100 DECLARATIVES. SQ1414.2 +030200 SQ141A-DECLARATIVE-001-SECT SECTION. SQ1414.2 +030300 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1414.2 +030400 INPUT-ERROR-PROCEDURE. SQ1414.2 +030500 IF DECL-EXEC-SW NOT = 9 SQ1414.2 +030600 GO TO NOT-DECL-9. SQ1414.2 +030700* SQ1414.2 +030800* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1414.2 +030900* SQ1414.2 +031000 DECL-OPEN-TEST. SQ1414.2 +031100 MOVE SPACE TO DUMMY-RECORD SQ1414.2 +031200 PERFORM DECL-WRITE-LINE SQ1414.2 +031300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1414.2 +031400 TO DUMMY-RECORD SQ1414.2 +031500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1414.2 +031600 GO TO END-DECLS. SQ1414.2 +031700* SQ1414.2 +031800* SQ1414.2 +031900 NOT-DECL-9. SQ1414.2 +032000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1414.2 +032100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1414.2 +032200 MOVE 9 TO CORRECT-18V0. SQ1414.2 +032300 PERFORM DECL-FAIL. SQ1414.2 +032400 GO TO END-DECLS. SQ1414.2 +032500* SQ1414.2 +032600* SQ1414.2 +032700* SQ1414.2 +032800 DECL-PASS. SQ1414.2 +032900 MOVE "PASS " TO P-OR-F. SQ1414.2 +033000 ADD 1 TO PASS-COUNTER. SQ1414.2 +033100 PERFORM DECL-PRINT-DETAIL. SQ1414.2 +033200* SQ1414.2 +033300 DECL-FAIL. SQ1414.2 +033400 MOVE "FAIL*" TO P-OR-F. SQ1414.2 +033500 ADD 1 TO ERROR-COUNTER. SQ1414.2 +033600 PERFORM DECL-PRINT-DETAIL. SQ1414.2 +033700* SQ1414.2 +033800 DECL-PRINT-DETAIL. SQ1414.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ1414.2 +034000 MOVE "." TO PARDOT-X SQ1414.2 +034100 MOVE REC-CT TO DOTVALUE. SQ1414.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. SQ1414.2 +034300 PERFORM DECL-WRITE-LINE. SQ1414.2 +034400 IF P-OR-F EQUAL TO "FAIL*" SQ1414.2 +034500 PERFORM DECL-WRITE-LINE SQ1414.2 +034600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1414.2 +034700 ELSE SQ1414.2 +034800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1414.2 +034900 MOVE SPACE TO P-OR-F. SQ1414.2 +035000 MOVE SPACE TO COMPUTED-X. SQ1414.2 +035100 MOVE SPACE TO CORRECT-X. SQ1414.2 +035200 IF REC-CT EQUAL TO ZERO SQ1414.2 +035300 MOVE SPACE TO PAR-NAME. SQ1414.2 +035400 MOVE SPACE TO RE-MARK. SQ1414.2 +035500* SQ1414.2 +035600 DECL-WRITE-LINE. SQ1414.2 +035700 ADD 1 TO RECORD-COUNT. SQ1414.2 +035800Y IF RECORD-COUNT GREATER 50 SQ1414.2 +035900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1414.2 +036000Y MOVE SPACE TO DUMMY-RECORD SQ1414.2 +036100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1414.2 +036200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1414.2 +036300Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1414.2 +036400Y PERFORM DECL-WRT-LN 2 TIMES SQ1414.2 +036500Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1414.2 +036600Y PERFORM DECL-WRT-LN SQ1414.2 +036700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1414.2 +036800Y MOVE ZERO TO RECORD-COUNT. SQ1414.2 +036900 PERFORM DECL-WRT-LN. SQ1414.2 +037000* SQ1414.2 +037100 DECL-WRT-LN. SQ1414.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1414.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1414.2 +037400* SQ1414.2 +037500 DECL-FAIL-ROUTINE. SQ1414.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1414.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1414.2 +037800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1414.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +038300 GO TO DECL-FAIL-EX. SQ1414.2 +038400 DECL-FAIL-WRITE. SQ1414.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC SQ1414.2 +038600 PERFORM DECL-WRITE-LINE SQ1414.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1414.2 +038800 MOVE TEST-CORRECT TO PRINT-REC SQ1414.2 +038900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +039000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1414.2 +039100 DECL-FAIL-EX. SQ1414.2 +039200 EXIT. SQ1414.2 +039300* SQ1414.2 +039400 DECL-BAIL. SQ1414.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1414.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1414.2 +039700 DECL-BAIL-WRITE. SQ1414.2 +039800 MOVE CORRECT-A TO XXCORRECT. SQ1414.2 +039900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1414.2 +040000 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +040200 DECL-BAIL-EX. SQ1414.2 +040300 EXIT. SQ1414.2 +040400* SQ1414.2 +040500 END-DECLS. SQ1414.2 +040600 MOVE ZERO TO DECL-EXEC-SW. SQ1414.2 +040700 END DECLARATIVES. SQ1414.2 +040800* SQ1414.2 +040900* SQ1414.2 +041000 CCVS1 SECTION. SQ1414.2 +041100 OPEN-FILES. SQ1414.2 +041200P OPEN I-O RAW-DATA. SQ1414.2 +041300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1414.2 +041400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1414.2 +041500P MOVE "ABORTED " TO C-ABORT. SQ1414.2 +041600P ADD 1 TO C-NO-OF-TESTS. SQ1414.2 +041700P ACCEPT C-DATE FROM DATE. SQ1414.2 +041800P ACCEPT C-TIME FROM TIME. SQ1414.2 +041900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1414.2 +042000PEND-E-1. SQ1414.2 +042100P CLOSE RAW-DATA. SQ1414.2 +042200 OPEN OUTPUT PRINT-FILE. SQ1414.2 +042300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1414.2 +042400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1414.2 +042500 MOVE SPACE TO TEST-RESULTS. SQ1414.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1414.2 +042700 MOVE ZERO TO REC-SKEL-SUB. SQ1414.2 +042800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1414.2 +042900 GO TO CCVS1-EXIT. SQ1414.2 +043000* SQ1414.2 +043100 CCVS-INIT-FILE. SQ1414.2 +043200 ADD 1 TO REC-SKL-SUB. SQ1414.2 +043300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1414.2 +043400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1414.2 +043500* SQ1414.2 +043600 CLOSE-FILES. SQ1414.2 +043700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1414.2 +043800 CLOSE PRINT-FILE. SQ1414.2 +043900P OPEN I-O RAW-DATA. SQ1414.2 +044000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1414.2 +044100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1414.2 +044200P MOVE "OK. " TO C-ABORT. SQ1414.2 +044300P MOVE PASS-COUNTER TO C-OK. SQ1414.2 +044400P MOVE ERROR-HOLD TO C-ALL. SQ1414.2 +044500P MOVE ERROR-COUNTER TO C-FAIL. SQ1414.2 +044600P MOVE DELETE-CNT TO C-DELETED. SQ1414.2 +044700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1414.2 +044800P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1414.2 +044900PEND-E-2. SQ1414.2 +045000P CLOSE RAW-DATA. SQ1414.2 +045100 TERMINATE-CCVS. SQ1414.2 +045200S EXIT PROGRAM. SQ1414.2 +045300 STOP RUN. SQ1414.2 +045400* SQ1414.2 +045500 INSPT. SQ1414.2 +045600 MOVE "INSPT" TO P-OR-F. SQ1414.2 +045700 ADD 1 TO INSPECT-COUNTER. SQ1414.2 +045800 PERFORM PRINT-DETAIL. SQ1414.2 +045900 SQ1414.2 +046000 PASS. SQ1414.2 +046100 MOVE "PASS " TO P-OR-F. SQ1414.2 +046200 ADD 1 TO PASS-COUNTER. SQ1414.2 +046300 PERFORM PRINT-DETAIL. SQ1414.2 +046400* SQ1414.2 +046500 FAIL. SQ1414.2 +046600 MOVE "FAIL*" TO P-OR-F. SQ1414.2 +046700 ADD 1 TO ERROR-COUNTER. SQ1414.2 +046800 PERFORM PRINT-DETAIL. SQ1414.2 +046900* SQ1414.2 +047000 DE-LETE. SQ1414.2 +047100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1414.2 +047200 MOVE "*****" TO P-OR-F. SQ1414.2 +047300 ADD 1 TO DELETE-COUNTER. SQ1414.2 +047400 PERFORM PRINT-DETAIL. SQ1414.2 +047500* SQ1414.2 +047600 PRINT-DETAIL. SQ1414.2 +047700 IF REC-CT NOT EQUAL TO ZERO SQ1414.2 +047800 MOVE "." TO PARDOT-X SQ1414.2 +047900 MOVE REC-CT TO DOTVALUE. SQ1414.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. SQ1414.2 +048100 PERFORM WRITE-LINE. SQ1414.2 +048200 IF P-OR-F EQUAL TO "FAIL*" SQ1414.2 +048300 PERFORM WRITE-LINE SQ1414.2 +048400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1414.2 +048500 ELSE SQ1414.2 +048600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1414.2 +048700 MOVE SPACE TO P-OR-F. SQ1414.2 +048800 MOVE SPACE TO COMPUTED-X. SQ1414.2 +048900 MOVE SPACE TO CORRECT-X. SQ1414.2 +049000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1414.2 +049100 MOVE SPACE TO RE-MARK. SQ1414.2 +049200* SQ1414.2 +049300 HEAD-ROUTINE. SQ1414.2 +049400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +049500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +049600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1414.2 +049700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1414.2 +049800 COLUMN-NAMES-ROUTINE. SQ1414.2 +049900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +050000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +050200 END-ROUTINE. SQ1414.2 +050300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1414.2 +050400 PERFORM WRITE-LINE 5 TIMES. SQ1414.2 +050500 END-RTN-EXIT. SQ1414.2 +050600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1414.2 +050700 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +050800* SQ1414.2 +050900 END-ROUTINE-1. SQ1414.2 +051000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1414.2 +051100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1414.2 +051200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1414.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1414.2 +051400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1414.2 +051500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1414.2 +051600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1414.2 +051700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1414.2 +051800 PERFORM WRITE-LINE. SQ1414.2 +051900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1414.2 +052000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1414.2 +052100 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +052200 ELSE SQ1414.2 +052300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1414.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1414.2 +052500 PERFORM WRITE-LINE. SQ1414.2 +052600 END-ROUTINE-13. SQ1414.2 +052700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1414.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +052900 ELSE SQ1414.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1414.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1414.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1414.2 +053300 PERFORM WRITE-LINE. SQ1414.2 +053400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1414.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +053600 ELSE SQ1414.2 +053700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1414.2 +053800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1414.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +054000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +054100* SQ1414.2 +054200 WRITE-LINE. SQ1414.2 +054300 ADD 1 TO RECORD-COUNT. SQ1414.2 +054400Y IF RECORD-COUNT GREATER 50 SQ1414.2 +054500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1414.2 +054600Y MOVE SPACE TO DUMMY-RECORD SQ1414.2 +054700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1414.2 +054800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1414.2 +054900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1414.2 +055000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1414.2 +055100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1414.2 +055200Y MOVE ZERO TO RECORD-COUNT. SQ1414.2 +055300 PERFORM WRT-LN. SQ1414.2 +055400* SQ1414.2 +055500 WRT-LN. SQ1414.2 +055600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1414.2 +055700 MOVE SPACE TO DUMMY-RECORD. SQ1414.2 +055800 BLANK-LINE-PRINT. SQ1414.2 +055900 PERFORM WRT-LN. SQ1414.2 +056000 FAIL-ROUTINE. SQ1414.2 +056100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1414.2 +056200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1414.2 +056300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +056400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1414.2 +056500 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +056600 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +056700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +056800 GO TO FAIL-ROUTINE-EX. SQ1414.2 +056900 FAIL-ROUTINE-WRITE. SQ1414.2 +057000 MOVE TEST-COMPUTED TO PRINT-REC SQ1414.2 +057100 PERFORM WRITE-LINE SQ1414.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1414.2 +057300 MOVE TEST-CORRECT TO PRINT-REC SQ1414.2 +057400 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +057500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1414.2 +057600 FAIL-ROUTINE-EX. SQ1414.2 +057700 EXIT. SQ1414.2 +057800 BAIL-OUT. SQ1414.2 +057900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1414.2 +058000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1414.2 +058100 BAIL-OUT-WRITE. SQ1414.2 +058200 MOVE CORRECT-A TO XXCORRECT. SQ1414.2 +058300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1414.2 +058400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +058500 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +058800 BAIL-OUT-EX. SQ1414.2 +058900 EXIT. SQ1414.2 +059000 CCVS1-EXIT. SQ1414.2 +059100 EXIT. SQ1414.2 +059200* SQ1414.2 +059300**************************************************************** SQ1414.2 +059400* * SQ1414.2 +059500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1414.2 +059600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1414.2 +059700* * SQ1414.2 +059800**************************************************************** SQ1414.2 +059900* SQ1414.2 +060000 SECT-SQ141A-MAIN SECTION. SQ1414.2 +060100 OPEN-INIT-01. SQ1414.2 +060200* SQ1414.2 +060300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1414.2 +060400* PRESENT AND AVAILABLE TO IT. SQ1414.2 +060500* SQ1414.2 +060600 MOVE 1 TO REC-CT SQ1414.2 +060700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1414.2 +060800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1414.2 +060900 MOVE 9 TO DECL-EXEC-SW SQ1414.2 +061000 MOVE "**" TO SQ-FS1-STATUS. SQ1414.2 +061100 OPEN-TEST-01. SQ1414.2 +061200 OPEN INPUT SQ-FS1. SQ1414.2 +061300 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ1414.2 +061400 MOVE 1 TO REC-CT. SQ1414.2 +061500 IF DECL-EXEC-SW = 0 SQ1414.2 +061600 PERFORM PASS SQ1414.2 +061700 ELSE SQ1414.2 +061800 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1414.2 +061900 MOVE ZERO TO CORRECT-18V0 SQ1414.2 +062000 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1414.2 +062100 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ1414.2 +062200 PERFORM FAIL. SQ1414.2 +062300 CCVS-EXIT SECTION. SQ1414.2 +062400 CCVS-999999. SQ1414.2 +062500 GO TO CLOSE-FILES. SQ1414.2 +*END-OF,SQ141A +*HEADER,COBOL,SQ142A +000100 IDENTIFICATION DIVISION. SQ1424.2 +000200 PROGRAM-ID. SQ1424.2 +000300 SQ142A. SQ1424.2 +000400**************************************************************** SQ1424.2 +000500* * SQ1424.2 +000600* VALIDATION FOR:- * SQ1424.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1424.2 +000900* REVISED 1986, AUGUST * SQ1424.2 +001000* * SQ1424.2 +001100* CREATION DATE / VALIDATION DATE * SQ1424.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1424.2 +001300* * SQ1424.2 +001400**************************************************************** SQ1424.2 +001500* * SQ1424.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1424.2 +001700* * SQ1424.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1424.2 +001900* X-55 SYSTEM PRINTER * SQ1424.2 +002000* X-82 SOURCE-COMPUTER * SQ1424.2 +002100* X-83 OBJECT-COMPUTER. * SQ1424.2 +002200* * SQ1424.2 +002300* * SQ1424.2 +002400**************************************************************** SQ1424.2 +002500* * SQ1424.2 +002600* SPLIT FROM SQ129A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1424.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1424.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1424.2 +002900* OPEN FOR INPUT ON A TAPE FILE WHICH IS NOT PRESENT. * SQ1424.2 +003000* (SEE SQ129A). * SQ1424.2 +003100* * SQ1424.2 +003200**************************************************************** SQ1424.2 +003300* SQ1424.2 +003400 ENVIRONMENT DIVISION. SQ1424.2 +003500 CONFIGURATION SECTION. SQ1424.2 +003600 SOURCE-COMPUTER. SQ1424.2 +003700 XXXXX082. SQ1424.2 +003800 OBJECT-COMPUTER. SQ1424.2 +003900 XXXXX083. SQ1424.2 +004000* SQ1424.2 +004100 INPUT-OUTPUT SECTION. SQ1424.2 +004200 FILE-CONTROL. SQ1424.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1424.2 +004400 XXXXX055. SQ1424.2 +004500* SQ1424.2 +004600P SELECT RAW-DATA ASSIGN TO SQ1424.2 +004700P XXXXX062 SQ1424.2 +004800P ORGANIZATION IS INDEXED SQ1424.2 +004900P ACCESS MODE IS RANDOM SQ1424.2 +005000P RECORD-KEY IS RAW-DATA-KEY. SQ1424.2 +005100P SQ1424.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1424.2 +005300 XXXXX001 SQ1424.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1424.2 +005500* SQ1424.2 +005600* SQ1424.2 +005700 DATA DIVISION. SQ1424.2 +005800 FILE SECTION. SQ1424.2 +005900 FD PRINT-FILE SQ1424.2 +006000C LABEL RECORDS SQ1424.2 +006100C XXXXX084 SQ1424.2 +006200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1424.2 +006300 . SQ1424.2 +006400 01 PRINT-REC PICTURE X(120). SQ1424.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1424.2 +006600P SQ1424.2 +006700PFD RAW-DATA. SQ1424.2 +006800P01 RAW-DATA-SATZ. SQ1424.2 +006900P 05 RAW-DATA-KEY PIC X(6). SQ1424.2 +007000P 05 C-DATE PIC 9(6). SQ1424.2 +007100P 05 C-TIME PIC 9(8). SQ1424.2 +007200P 05 NO-OF-TESTS PIC 99. SQ1424.2 +007300P 05 C-OK PIC 999. SQ1424.2 +007400P 05 C-ALL PIC 999. SQ1424.2 +007500P 05 C-FAIL PIC 999. SQ1424.2 +007600P 05 C-DELETED PIC 999. SQ1424.2 +007700P 05 C-INSPECT PIC 999. SQ1424.2 +007800P 05 C-NOTE PIC X(13). SQ1424.2 +007900P 05 C-INDENT PIC X. SQ1424.2 +008000P 05 C-ABORT PIC X(8). SQ1424.2 +008100* SQ1424.2 +008200 FD SQ-FS1 SQ1424.2 +008300C LABEL RECORD IS STANDARD SQ1424.2 +008400 . SQ1424.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1424.2 +008600* SQ1424.2 +008700 WORKING-STORAGE SECTION. SQ1424.2 +008800* SQ1424.2 +008900*************************************************************** SQ1424.2 +009000* * SQ1424.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1424.2 +009200* * SQ1424.2 +009300*************************************************************** SQ1424.2 +009400* SQ1424.2 +009500 01 SQ-FS1-STATUS. SQ1424.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1424.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1424.2 +009800* SQ1424.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1424.2 +010000* SQ1424.2 +010100*************************************************************** SQ1424.2 +010200* * SQ1424.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1424.2 +010400* * SQ1424.2 +010500*************************************************************** SQ1424.2 +010600* SQ1424.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1424.2 +010800* SQ1424.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1424.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1424.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1424.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1424.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1424.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1424.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1424.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1424.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1424.2 +011800 ",RECKEY= ". SQ1424.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1424.2 +012000 ",ALTKEY1= ". SQ1424.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1424.2 +012200 ",ALTKEY2= ". SQ1424.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1424.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1424.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1424.2 +012600 07 FILLER PIC X(5). SQ1424.2 +012700 07 XFILE-NAME PIC X(6). SQ1424.2 +012800 07 FILLER PIC X(8). SQ1424.2 +012900 07 XRECORD-NAME PIC X(6). SQ1424.2 +013000 07 FILLER PIC X(1). SQ1424.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1424.2 +013200 07 FILLER PIC X(7). SQ1424.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1424.2 +013400 07 FILLER PIC X(6). SQ1424.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1424.2 +013600 07 FILLER PIC X(5). SQ1424.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1424.2 +013800 07 FILLER PIC X(5). SQ1424.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1424.2 +014000 07 FILLER PIC X(7). SQ1424.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1424.2 +014200 07 FILLER PIC X(7). SQ1424.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1424.2 +014400 07 FILLER PIC X(1). SQ1424.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1424.2 +014600 07 FILLER PIC X(6). SQ1424.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1424.2 +014800 07 FILLER PIC X(5). SQ1424.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1424.2 +015000 07 FILLER PIC X(6). SQ1424.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1424.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1424.2 +015300 07 FILLER PIC X(8). SQ1424.2 +015400 07 XRECORD-KEY PIC X(29). SQ1424.2 +015500 07 FILLER PIC X(9). SQ1424.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1424.2 +015700 07 FILLER PIC X(9). SQ1424.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1424.2 +015900 07 FILLER PIC X(7). SQ1424.2 +016000* SQ1424.2 +016100 01 TEST-RESULTS. SQ1424.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1424.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1424.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016700 02 PAR-NAME. SQ1424.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1424.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1424.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1424.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1424.2 +017200 02 RE-MARK PIC X(61). SQ1424.2 +017300 01 TEST-COMPUTED. SQ1424.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1424.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1424.2 +017600 02 COMPUTED-X. SQ1424.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1424.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1424.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1424.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1424.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1424.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1424.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1424.2 +018400 04 FILLER PIC X. SQ1424.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1424.2 +018600 01 TEST-CORRECT. SQ1424.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1424.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1424.2 +018900 02 CORRECT-X. SQ1424.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1424.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1424.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1424.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1424.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1424.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1424.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1424.2 +019700 04 FILLER PIC X. SQ1424.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1424.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1424.2 +020000 01 CCVS-C-1. SQ1424.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1424.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1424.2 +020300- "SS PARAGRAPH-NAME SQ1424.2 +020400- " REMARKS". SQ1424.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1424.2 +020600 01 CCVS-C-2. SQ1424.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1424.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1424.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1424.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1424.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1424.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1424.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1424.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1424.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1424.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1424.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1424.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1424.2 +022300 01 CCVS-H-1. SQ1424.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1424.2 +022500 02 FILLER PIC X(42) VALUE SQ1424.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1424.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1424.2 +022800 01 CCVS-H-2A. SQ1424.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1424.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1424.2 +023100 02 FILLER PIC XXXX VALUE SQ1424.2 +023200 "4.2 ". SQ1424.2 +023300 02 FILLER PIC X(28) VALUE SQ1424.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1424.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1424.2 +023600* SQ1424.2 +023700 01 CCVS-H-2B. SQ1424.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1424.2 +023900 02 TEST-ID PIC X(9). SQ1424.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1424.2 +024100 02 FILLER PIC X(12) VALUE SQ1424.2 +024200 " HIGH ". SQ1424.2 +024300 02 FILLER PIC X(22) VALUE SQ1424.2 +024400 " LEVEL VALIDATION FOR ". SQ1424.2 +024500 02 FILLER PIC X(58) VALUE SQ1424.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +024700 01 CCVS-H-3. SQ1424.2 +024800 02 FILLER PIC X(34) VALUE SQ1424.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1424.2 +025000 02 FILLER PIC X(58) VALUE SQ1424.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1424.2 +025200 02 FILLER PIC X(28) VALUE SQ1424.2 +025300 " COPYRIGHT 1985,1986 ". SQ1424.2 +025400 01 CCVS-E-1. SQ1424.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1424.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1424.2 +025700 02 ID-AGAIN PIC X(9). SQ1424.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1424.2 +025900 01 CCVS-E-2. SQ1424.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1424.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1424.2 +026200 02 CCVS-E-2-2. SQ1424.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1424.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1424.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1424.2 +026600 "ERRORS ENCOUNTERED". SQ1424.2 +026700 01 CCVS-E-3. SQ1424.2 +026800 02 FILLER PIC X(22) VALUE SQ1424.2 +026900 " FOR OFFICIAL USE ONLY". SQ1424.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1424.2 +027100 02 FILLER PIC X(58) VALUE SQ1424.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1424.2 +027400 02 FILLER PIC X(20) VALUE SQ1424.2 +027500 " COPYRIGHT 1985,1986". SQ1424.2 +027600 01 CCVS-E-4. SQ1424.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1424.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1424.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1424.2 +028000 02 FILLER PIC X(40) VALUE SQ1424.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1424.2 +028200 01 XXINFO. SQ1424.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1424.2 +028400 02 INFO-TEXT. SQ1424.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1424.2 +028600 04 XXCOMPUTED PIC X(20). SQ1424.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1424.2 +028800 04 XXCORRECT PIC X(20). SQ1424.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1424.2 +029000 01 HYPHEN-LINE. SQ1424.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1424.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1424.2 +029300- "*****************************************". SQ1424.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1424.2 +029500- "******************************". SQ1424.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1424.2 +029700 "SQ142A". SQ1424.2 +029800* SQ1424.2 +029900* SQ1424.2 +030000 PROCEDURE DIVISION. SQ1424.2 +030100 DECLARATIVES. SQ1424.2 +030200 SQ142A-DECLARATIVE-001-SECT SECTION. SQ1424.2 +030300 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1424.2 +030400 INPUT-ERROR-PROCEDURE. SQ1424.2 +030500 IF DECL-EXEC-SW NOT = 9 SQ1424.2 +030600 GO TO NOT-DECL-9. SQ1424.2 +030700* SQ1424.2 +030800* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1424.2 +030900* SQ1424.2 +031000 DECL-OPEN-TEST. SQ1424.2 +031100 MOVE SPACE TO DUMMY-RECORD SQ1424.2 +031200 PERFORM DECL-WRITE-LINE SQ1424.2 +031300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1424.2 +031400 TO DUMMY-RECORD SQ1424.2 +031500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1424.2 +031600 GO TO END-DECLS. SQ1424.2 +031700* SQ1424.2 +031800* SQ1424.2 +031900 NOT-DECL-9. SQ1424.2 +032000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1424.2 +032100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1424.2 +032200 MOVE 9 TO CORRECT-18V0. SQ1424.2 +032300 PERFORM DECL-FAIL. SQ1424.2 +032400 GO TO END-DECLS. SQ1424.2 +032500* SQ1424.2 +032600* SQ1424.2 +032700* SQ1424.2 +032800 DECL-PASS. SQ1424.2 +032900 MOVE "PASS " TO P-OR-F. SQ1424.2 +033000 ADD 1 TO PASS-COUNTER. SQ1424.2 +033100 PERFORM DECL-PRINT-DETAIL. SQ1424.2 +033200* SQ1424.2 +033300 DECL-FAIL. SQ1424.2 +033400 MOVE "FAIL*" TO P-OR-F. SQ1424.2 +033500 ADD 1 TO ERROR-COUNTER. SQ1424.2 +033600 PERFORM DECL-PRINT-DETAIL. SQ1424.2 +033700* SQ1424.2 +033800 DECL-PRINT-DETAIL. SQ1424.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ1424.2 +034000 MOVE "." TO PARDOT-X SQ1424.2 +034100 MOVE REC-CT TO DOTVALUE. SQ1424.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. SQ1424.2 +034300 PERFORM DECL-WRITE-LINE. SQ1424.2 +034400 IF P-OR-F EQUAL TO "FAIL*" SQ1424.2 +034500 PERFORM DECL-WRITE-LINE SQ1424.2 +034600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1424.2 +034700 ELSE SQ1424.2 +034800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1424.2 +034900 MOVE SPACE TO P-OR-F. SQ1424.2 +035000 MOVE SPACE TO COMPUTED-X. SQ1424.2 +035100 MOVE SPACE TO CORRECT-X. SQ1424.2 +035200 IF REC-CT EQUAL TO ZERO SQ1424.2 +035300 MOVE SPACE TO PAR-NAME. SQ1424.2 +035400 MOVE SPACE TO RE-MARK. SQ1424.2 +035500* SQ1424.2 +035600 DECL-WRITE-LINE. SQ1424.2 +035700 ADD 1 TO RECORD-COUNT. SQ1424.2 +035800Y IF RECORD-COUNT GREATER 50 SQ1424.2 +035900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1424.2 +036000Y MOVE SPACE TO DUMMY-RECORD SQ1424.2 +036100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1424.2 +036200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1424.2 +036300Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1424.2 +036400Y PERFORM DECL-WRT-LN 2 TIMES SQ1424.2 +036500Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1424.2 +036600Y PERFORM DECL-WRT-LN SQ1424.2 +036700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1424.2 +036800Y MOVE ZERO TO RECORD-COUNT. SQ1424.2 +036900 PERFORM DECL-WRT-LN. SQ1424.2 +037000* SQ1424.2 +037100 DECL-WRT-LN. SQ1424.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1424.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1424.2 +037400* SQ1424.2 +037500 DECL-FAIL-ROUTINE. SQ1424.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1424.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1424.2 +037800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1424.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +038300 GO TO DECL-FAIL-EX. SQ1424.2 +038400 DECL-FAIL-WRITE. SQ1424.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC SQ1424.2 +038600 PERFORM DECL-WRITE-LINE SQ1424.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1424.2 +038800 MOVE TEST-CORRECT TO PRINT-REC SQ1424.2 +038900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +039000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1424.2 +039100 DECL-FAIL-EX. SQ1424.2 +039200 EXIT. SQ1424.2 +039300* SQ1424.2 +039400 DECL-BAIL. SQ1424.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1424.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1424.2 +039700 DECL-BAIL-WRITE. SQ1424.2 +039800 MOVE CORRECT-A TO XXCORRECT. SQ1424.2 +039900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1424.2 +040000 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +040200 DECL-BAIL-EX. SQ1424.2 +040300 EXIT. SQ1424.2 +040400* SQ1424.2 +040500 END-DECLS. SQ1424.2 +040600 MOVE ZERO TO DECL-EXEC-SW. SQ1424.2 +040700 END DECLARATIVES. SQ1424.2 +040800* SQ1424.2 +040900* SQ1424.2 +041000 CCVS1 SECTION. SQ1424.2 +041100 OPEN-FILES. SQ1424.2 +041200P OPEN I-O RAW-DATA. SQ1424.2 +041300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1424.2 +041400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1424.2 +041500P MOVE "ABORTED " TO C-ABORT. SQ1424.2 +041600P ADD 1 TO C-NO-OF-TESTS. SQ1424.2 +041700P ACCEPT C-DATE FROM DATE. SQ1424.2 +041800P ACCEPT C-TIME FROM TIME. SQ1424.2 +041900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1424.2 +042000PEND-E-1. SQ1424.2 +042100P CLOSE RAW-DATA. SQ1424.2 +042200 OPEN OUTPUT PRINT-FILE. SQ1424.2 +042300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1424.2 +042400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1424.2 +042500 MOVE SPACE TO TEST-RESULTS. SQ1424.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1424.2 +042700 MOVE ZERO TO REC-SKEL-SUB. SQ1424.2 +042800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1424.2 +042900 GO TO CCVS1-EXIT. SQ1424.2 +043000* SQ1424.2 +043100 CCVS-INIT-FILE. SQ1424.2 +043200 ADD 1 TO REC-SKL-SUB. SQ1424.2 +043300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1424.2 +043400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1424.2 +043500* SQ1424.2 +043600 CLOSE-FILES. SQ1424.2 +043700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1424.2 +043800 CLOSE PRINT-FILE. SQ1424.2 +043900P OPEN I-O RAW-DATA. SQ1424.2 +044000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1424.2 +044100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1424.2 +044200P MOVE "OK. " TO C-ABORT. SQ1424.2 +044300P MOVE PASS-COUNTER TO C-OK. SQ1424.2 +044400P MOVE ERROR-HOLD TO C-ALL. SQ1424.2 +044500P MOVE ERROR-COUNTER TO C-FAIL. SQ1424.2 +044600P MOVE DELETE-CNT TO C-DELETED. SQ1424.2 +044700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1424.2 +044800P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1424.2 +044900PEND-E-2. SQ1424.2 +045000P CLOSE RAW-DATA. SQ1424.2 +045100 TERMINATE-CCVS. SQ1424.2 +045200S EXIT PROGRAM. SQ1424.2 +045300 STOP RUN. SQ1424.2 +045400* SQ1424.2 +045500 INSPT. SQ1424.2 +045600 MOVE "INSPT" TO P-OR-F. SQ1424.2 +045700 ADD 1 TO INSPECT-COUNTER. SQ1424.2 +045800 PERFORM PRINT-DETAIL. SQ1424.2 +045900 SQ1424.2 +046000 PASS. SQ1424.2 +046100 MOVE "PASS " TO P-OR-F. SQ1424.2 +046200 ADD 1 TO PASS-COUNTER. SQ1424.2 +046300 PERFORM PRINT-DETAIL. SQ1424.2 +046400* SQ1424.2 +046500 FAIL. SQ1424.2 +046600 MOVE "FAIL*" TO P-OR-F. SQ1424.2 +046700 ADD 1 TO ERROR-COUNTER. SQ1424.2 +046800 PERFORM PRINT-DETAIL. SQ1424.2 +046900* SQ1424.2 +047000 DE-LETE. SQ1424.2 +047100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1424.2 +047200 MOVE "*****" TO P-OR-F. SQ1424.2 +047300 ADD 1 TO DELETE-COUNTER. SQ1424.2 +047400 PERFORM PRINT-DETAIL. SQ1424.2 +047500* SQ1424.2 +047600 PRINT-DETAIL. SQ1424.2 +047700 IF REC-CT NOT EQUAL TO ZERO SQ1424.2 +047800 MOVE "." TO PARDOT-X SQ1424.2 +047900 MOVE REC-CT TO DOTVALUE. SQ1424.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. SQ1424.2 +048100 PERFORM WRITE-LINE. SQ1424.2 +048200 IF P-OR-F EQUAL TO "FAIL*" SQ1424.2 +048300 PERFORM WRITE-LINE SQ1424.2 +048400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1424.2 +048500 ELSE SQ1424.2 +048600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1424.2 +048700 MOVE SPACE TO P-OR-F. SQ1424.2 +048800 MOVE SPACE TO COMPUTED-X. SQ1424.2 +048900 MOVE SPACE TO CORRECT-X. SQ1424.2 +049000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1424.2 +049100 MOVE SPACE TO RE-MARK. SQ1424.2 +049200* SQ1424.2 +049300 HEAD-ROUTINE. SQ1424.2 +049400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +049500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +049600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1424.2 +049700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1424.2 +049800 COLUMN-NAMES-ROUTINE. SQ1424.2 +049900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +050000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +050200 END-ROUTINE. SQ1424.2 +050300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1424.2 +050400 PERFORM WRITE-LINE 5 TIMES. SQ1424.2 +050500 END-RTN-EXIT. SQ1424.2 +050600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1424.2 +050700 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +050800* SQ1424.2 +050900 END-ROUTINE-1. SQ1424.2 +051000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1424.2 +051100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1424.2 +051200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1424.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1424.2 +051400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1424.2 +051500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1424.2 +051600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1424.2 +051700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1424.2 +051800 PERFORM WRITE-LINE. SQ1424.2 +051900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1424.2 +052000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1424.2 +052100 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +052200 ELSE SQ1424.2 +052300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1424.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1424.2 +052500 PERFORM WRITE-LINE. SQ1424.2 +052600 END-ROUTINE-13. SQ1424.2 +052700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1424.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +052900 ELSE SQ1424.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1424.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1424.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1424.2 +053300 PERFORM WRITE-LINE. SQ1424.2 +053400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1424.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +053600 ELSE SQ1424.2 +053700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1424.2 +053800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1424.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +054000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +054100* SQ1424.2 +054200 WRITE-LINE. SQ1424.2 +054300 ADD 1 TO RECORD-COUNT. SQ1424.2 +054400Y IF RECORD-COUNT GREATER 50 SQ1424.2 +054500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1424.2 +054600Y MOVE SPACE TO DUMMY-RECORD SQ1424.2 +054700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1424.2 +054800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1424.2 +054900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1424.2 +055000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1424.2 +055100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1424.2 +055200Y MOVE ZERO TO RECORD-COUNT. SQ1424.2 +055300 PERFORM WRT-LN. SQ1424.2 +055400* SQ1424.2 +055500 WRT-LN. SQ1424.2 +055600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1424.2 +055700 MOVE SPACE TO DUMMY-RECORD. SQ1424.2 +055800 BLANK-LINE-PRINT. SQ1424.2 +055900 PERFORM WRT-LN. SQ1424.2 +056000 FAIL-ROUTINE. SQ1424.2 +056100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1424.2 +056200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1424.2 +056300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +056400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1424.2 +056500 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +056600 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +056700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +056800 GO TO FAIL-ROUTINE-EX. SQ1424.2 +056900 FAIL-ROUTINE-WRITE. SQ1424.2 +057000 MOVE TEST-COMPUTED TO PRINT-REC SQ1424.2 +057100 PERFORM WRITE-LINE SQ1424.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1424.2 +057300 MOVE TEST-CORRECT TO PRINT-REC SQ1424.2 +057400 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +057500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1424.2 +057600 FAIL-ROUTINE-EX. SQ1424.2 +057700 EXIT. SQ1424.2 +057800 BAIL-OUT. SQ1424.2 +057900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1424.2 +058000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1424.2 +058100 BAIL-OUT-WRITE. SQ1424.2 +058200 MOVE CORRECT-A TO XXCORRECT. SQ1424.2 +058300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1424.2 +058400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +058500 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +058800 BAIL-OUT-EX. SQ1424.2 +058900 EXIT. SQ1424.2 +059000 CCVS1-EXIT. SQ1424.2 +059100 EXIT. SQ1424.2 +059200* SQ1424.2 +059300**************************************************************** SQ1424.2 +059400* * SQ1424.2 +059500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1424.2 +059600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1424.2 +059700* * SQ1424.2 +059800**************************************************************** SQ1424.2 +059900* SQ1424.2 +060000 SECT-SQ142A-MAIN SECTION. SQ1424.2 +060100 OPEN-INIT-01. SQ1424.2 +060200* SQ1424.2 +060300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1424.2 +060400* PRESENT AND AVAILABLE TO IT. SQ1424.2 +060500* SQ1424.2 +060600 MOVE 1 TO REC-CT SQ1424.2 +060700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1424.2 +060800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1424.2 +060900 MOVE 9 TO DECL-EXEC-SW SQ1424.2 +061000 MOVE "**" TO SQ-FS1-STATUS. SQ1424.2 +061100 OPEN-TEST-01. SQ1424.2 +061200 OPEN INPUT SQ-FS1. SQ1424.2 +061300 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ1424.2 +061400 MOVE 1 TO REC-CT. SQ1424.2 +061500 ADD 1 TO REC-CT. SQ1424.2 +061600 IF SQ-FS1-STATUS NOT = "35" SQ1424.2 +061700 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ1424.2 +061800 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ1424.2 +061900 MOVE "35" TO CORRECT-A SQ1424.2 +062000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1424.2 +062100 PERFORM FAIL SQ1424.2 +062200 ELSE SQ1424.2 +062300 PERFORM PASS. SQ1424.2 +062400* SQ1424.2 +062500* SQ1424.2 +062600 CCVS-EXIT SECTION. SQ1424.2 +062700 CCVS-999999. SQ1424.2 +062800 GO TO CLOSE-FILES. SQ1424.2 +*END-OF,SQ142A +*HEADER,COBOL,SQ143A +000100 IDENTIFICATION DIVISION. SQ1434.2 +000200 PROGRAM-ID. SQ1434.2 +000300 SQ143A. SQ1434.2 +000400**************************************************************** SQ1434.2 +000500* * SQ1434.2 +000600* VALIDATION FOR:- * SQ1434.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +000800* USING CCVS85 VERSION 3.0. * SQ1434.2 +000900* * SQ1434.2 +001000* CREATION DATE / VALIDATION DATE * SQ1434.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1434.2 +001200* * SQ1434.2 +001300**************************************************************** SQ1434.2 +001400* * SQ1434.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1434.2 +001600* * SQ1434.2 +001700* X-01 SEQUENTIAL TAPE * SQ1434.2 +001800* X-55 SYSTEM PRINTER * SQ1434.2 +001900* X-82 SOURCE-COMPUTER * SQ1434.2 +002000* X-83 OBJECT-COMPUTER. * SQ1434.2 +002100* X-84 LABEL RECORDS OPTION * SQ1434.2 +002200* * SQ1434.2 +002300**************************************************************** SQ1434.2 +002400* * SQ1434.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO CLOSING * SQ1434.2 +002600* AN UNOPENED FILE. THE TEST FOR CORRECT I-O STATUS CODE * SQ1434.2 +002700* 42 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1434.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1434.2 +002900* CODE IS ACCOMPLISHED. * SQ1434.2 +003000* * SQ1434.2 +003100**************************************************************** SQ1434.2 +003200* SQ1434.2 +003300 ENVIRONMENT DIVISION. SQ1434.2 +003400 CONFIGURATION SECTION. SQ1434.2 +003500 SOURCE-COMPUTER. SQ1434.2 +003600 XXXXX082. SQ1434.2 +003700 OBJECT-COMPUTER. SQ1434.2 +003800 XXXXX083. SQ1434.2 +003900* SQ1434.2 +004000 INPUT-OUTPUT SECTION. SQ1434.2 +004100 FILE-CONTROL. SQ1434.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1434.2 +004300 XXXXX055. SQ1434.2 +004400* SQ1434.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1434.2 +004600 XXXXX001 SQ1434.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1434.2 +004800* SQ1434.2 +004900* SQ1434.2 +005000 DATA DIVISION. SQ1434.2 +005100 FILE SECTION. SQ1434.2 +005200 FD PRINT-FILE SQ1434.2 +005300C LABEL RECORDS SQ1434.2 +005400C XXXXX084 SQ1434.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1434.2 +005600 . SQ1434.2 +005700 01 PRINT-REC PICTURE X(120). SQ1434.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1434.2 +005900* SQ1434.2 +006000 FD SQ-FS1 SQ1434.2 +006100C LABEL RECORD IS STANDARD SQ1434.2 +006200 . SQ1434.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1434.2 +006400* SQ1434.2 +006500 WORKING-STORAGE SECTION. SQ1434.2 +006600* SQ1434.2 +006700*************************************************************** SQ1434.2 +006800* * SQ1434.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1434.2 +007000* * SQ1434.2 +007100*************************************************************** SQ1434.2 +007200* SQ1434.2 +007300 01 SQ-FS1-STATUS. SQ1434.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1434.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1434.2 +007600* SQ1434.2 +007700*************************************************************** SQ1434.2 +007800* * SQ1434.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1434.2 +008000* * SQ1434.2 +008100*************************************************************** SQ1434.2 +008200* SQ1434.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1434.2 +008400* SQ1434.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1434.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1434.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1434.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1434.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1434.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1434.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1434.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1434.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1434.2 +009400 ",RECKEY= ". SQ1434.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1434.2 +009600 ",ALTKEY1= ". SQ1434.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1434.2 +009800 ",ALTKEY2= ". SQ1434.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1434.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1434.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1434.2 +010200 07 FILLER PIC X(5). SQ1434.2 +010300 07 XFILE-NAME PIC X(6). SQ1434.2 +010400 07 FILLER PIC X(8). SQ1434.2 +010500 07 XRECORD-NAME PIC X(6). SQ1434.2 +010600 07 FILLER PIC X(1). SQ1434.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1434.2 +010800 07 FILLER PIC X(7). SQ1434.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1434.2 +011000 07 FILLER PIC X(6). SQ1434.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1434.2 +011200 07 FILLER PIC X(5). SQ1434.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1434.2 +011400 07 FILLER PIC X(5). SQ1434.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1434.2 +011600 07 FILLER PIC X(7). SQ1434.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1434.2 +011800 07 FILLER PIC X(7). SQ1434.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1434.2 +012000 07 FILLER PIC X(1). SQ1434.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1434.2 +012200 07 FILLER PIC X(6). SQ1434.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1434.2 +012400 07 FILLER PIC X(5). SQ1434.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1434.2 +012600 07 FILLER PIC X(6). SQ1434.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1434.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1434.2 +012900 07 FILLER PIC X(8). SQ1434.2 +013000 07 XRECORD-KEY PIC X(29). SQ1434.2 +013100 07 FILLER PIC X(9). SQ1434.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1434.2 +013300 07 FILLER PIC X(9). SQ1434.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1434.2 +013500 07 FILLER PIC X(7). SQ1434.2 +013600* SQ1434.2 +013700 01 TEST-RESULTS. SQ1434.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1434.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1434.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1434.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1434.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1434.2 +014300 02 PAR-NAME. SQ1434.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1434.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1434.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1434.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1434.2 +014800 02 RE-MARK PIC X(61). SQ1434.2 +014900 01 TEST-COMPUTED. SQ1434.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1434.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1434.2 +015200 02 COMPUTED-X. SQ1434.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1434.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1434.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1434.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1434.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1434.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1434.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1434.2 +016000 04 FILLER PIC X. SQ1434.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1434.2 +016200 01 TEST-CORRECT. SQ1434.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1434.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1434.2 +016500 02 CORRECT-X. SQ1434.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1434.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1434.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1434.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1434.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1434.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1434.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1434.2 +017300 04 FILLER PIC X. SQ1434.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1434.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1434.2 +017600 01 CCVS-C-1. SQ1434.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1434.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1434.2 +017900- "SS PARAGRAPH-NAME SQ1434.2 +018000- " REMARKS". SQ1434.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1434.2 +018200 01 CCVS-C-2. SQ1434.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1434.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1434.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1434.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1434.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1434.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1434.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1434.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1434.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1434.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1434.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1434.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1434.2 +019900 01 CCVS-H-1. SQ1434.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1434.2 +020100 02 FILLER PIC X(42) VALUE SQ1434.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1434.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1434.2 +020400 01 CCVS-H-2A. SQ1434.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1434.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1434.2 +020700 02 FILLER PIC XXXX VALUE SQ1434.2 +020800 "4.2 ". SQ1434.2 +020900 02 FILLER PIC X(28) VALUE SQ1434.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1434.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1434.2 +021200* SQ1434.2 +021300 01 CCVS-H-2B. SQ1434.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1434.2 +021500 02 TEST-ID PIC X(9). SQ1434.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1434.2 +021700 02 FILLER PIC X(12) VALUE SQ1434.2 +021800 " HIGH ". SQ1434.2 +021900 02 FILLER PIC X(22) VALUE SQ1434.2 +022000 " LEVEL VALIDATION FOR ". SQ1434.2 +022100 02 FILLER PIC X(58) VALUE SQ1434.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +022300 01 CCVS-H-3. SQ1434.2 +022400 02 FILLER PIC X(34) VALUE SQ1434.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1434.2 +022600 02 FILLER PIC X(58) VALUE SQ1434.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1434.2 +022800 02 FILLER PIC X(28) VALUE SQ1434.2 +022900 " COPYRIGHT 1985,1986 ". SQ1434.2 +023000 01 CCVS-E-1. SQ1434.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1434.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1434.2 +023300 02 ID-AGAIN PIC X(9). SQ1434.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1434.2 +023500 01 CCVS-E-2. SQ1434.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1434.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1434.2 +023800 02 CCVS-E-2-2. SQ1434.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1434.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1434.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1434.2 +024200 "ERRORS ENCOUNTERED". SQ1434.2 +024300 01 CCVS-E-3. SQ1434.2 +024400 02 FILLER PIC X(22) VALUE SQ1434.2 +024500 " FOR OFFICIAL USE ONLY". SQ1434.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1434.2 +024700 02 FILLER PIC X(58) VALUE SQ1434.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1434.2 +025000 02 FILLER PIC X(20) VALUE SQ1434.2 +025100 " COPYRIGHT 1985,1986". SQ1434.2 +025200 01 CCVS-E-4. SQ1434.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1434.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1434.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1434.2 +025600 02 FILLER PIC X(40) VALUE SQ1434.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1434.2 +025800 01 XXINFO. SQ1434.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1434.2 +026000 02 INFO-TEXT. SQ1434.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1434.2 +026200 04 XXCOMPUTED PIC X(20). SQ1434.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1434.2 +026400 04 XXCORRECT PIC X(20). SQ1434.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1434.2 +026600 01 HYPHEN-LINE. SQ1434.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1434.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1434.2 +026900- "*****************************************". SQ1434.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1434.2 +027100- "******************************". SQ1434.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1434.2 +027300 "SQ143A". SQ1434.2 +027400* SQ1434.2 +027500 PROCEDURE DIVISION. SQ1434.2 +027600 CCVS1 SECTION. SQ1434.2 +027700 OPEN-FILES. SQ1434.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1434.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1434.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1434.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1434.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1434.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1434.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1434.2 +028500 GO TO CCVS1-EXIT. SQ1434.2 +028600* SQ1434.2 +028700 CCVS-INIT-FILE. SQ1434.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1434.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1434.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1434.2 +029100* SQ1434.2 +029200 CLOSE-FILES. SQ1434.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1434.2 +029400 CLOSE PRINT-FILE. SQ1434.2 +029500 TERMINATE-CCVS. SQ1434.2 +029600 STOP RUN. SQ1434.2 +029700* SQ1434.2 +029800 INSPT. SQ1434.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1434.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1434.2 +030100 PERFORM PRINT-DETAIL. SQ1434.2 +030200 SQ1434.2 +030300 PASS. SQ1434.2 +030400 MOVE "PASS " TO P-OR-F. SQ1434.2 +030500 ADD 1 TO PASS-COUNTER. SQ1434.2 +030600 PERFORM PRINT-DETAIL. SQ1434.2 +030700* SQ1434.2 +030800 FAIL. SQ1434.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1434.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1434.2 +031100 PERFORM PRINT-DETAIL. SQ1434.2 +031200* SQ1434.2 +031300 DE-LETE. SQ1434.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1434.2 +031500 MOVE "*****" TO P-OR-F. SQ1434.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1434.2 +031700 PERFORM PRINT-DETAIL. SQ1434.2 +031800* SQ1434.2 +031900 PRINT-DETAIL. SQ1434.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1434.2 +032100 MOVE "." TO PARDOT-X SQ1434.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1434.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1434.2 +032400 PERFORM WRITE-LINE. SQ1434.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1434.2 +032600 PERFORM WRITE-LINE SQ1434.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1434.2 +032800 ELSE SQ1434.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1434.2 +033000 MOVE SPACE TO P-OR-F. SQ1434.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1434.2 +033200 MOVE SPACE TO CORRECT-X. SQ1434.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1434.2 +033400 MOVE SPACE TO RE-MARK. SQ1434.2 +033500* SQ1434.2 +033600 HEAD-ROUTINE. SQ1434.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +034100 COLUMN-NAMES-ROUTINE. SQ1434.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +034500 END-ROUTINE. SQ1434.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1434.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1434.2 +034800 END-RTN-EXIT. SQ1434.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1434.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +035100* SQ1434.2 +035200 END-ROUTINE-1. SQ1434.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1434.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1434.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1434.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1434.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1434.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1434.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1434.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1434.2 +036100 PERFORM WRITE-LINE. SQ1434.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1434.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1434.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +036500 ELSE SQ1434.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1434.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1434.2 +036800 PERFORM WRITE-LINE. SQ1434.2 +036900 END-ROUTINE-13. SQ1434.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1434.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +037200 ELSE SQ1434.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1434.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1434.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1434.2 +037600 PERFORM WRITE-LINE. SQ1434.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1434.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +037900 ELSE SQ1434.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1434.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1434.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +038400* SQ1434.2 +038500 WRITE-LINE. SQ1434.2 +038600 ADD 1 TO RECORD-COUNT. SQ1434.2 +038700Y IF RECORD-COUNT GREATER 50 SQ1434.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1434.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ1434.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1434.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1434.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1434.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1434.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1434.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ1434.2 +039600 PERFORM WRT-LN. SQ1434.2 +039700* SQ1434.2 +039800 WRT-LN. SQ1434.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1434.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1434.2 +040100 BLANK-LINE-PRINT. SQ1434.2 +040200 PERFORM WRT-LN. SQ1434.2 +040300 FAIL-ROUTINE. SQ1434.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1434.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1434.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1434.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1434.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1434.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1434.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1434.2 +041200 FAIL-ROUTINE-WRITE. SQ1434.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1434.2 +041400 PERFORM WRITE-LINE SQ1434.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1434.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1434.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1434.2 +041900 FAIL-ROUTINE-EX. SQ1434.2 +042000 EXIT. SQ1434.2 +042100 BAIL-OUT. SQ1434.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1434.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1434.2 +042400 BAIL-OUT-WRITE. SQ1434.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1434.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1434.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1434.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1434.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1434.2 +043100 BAIL-OUT-EX. SQ1434.2 +043200 EXIT. SQ1434.2 +043300 CCVS1-EXIT. SQ1434.2 +043400 EXIT. SQ1434.2 +043500* SQ1434.2 +043600**************************************************************** SQ1434.2 +043700* * SQ1434.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1434.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1434.2 +044000* * SQ1434.2 +044100**************************************************************** SQ1434.2 +044200* SQ1434.2 +044300 SECT-SQ143A-0001 SECTION. SQ1434.2 +044400 CLOSE-INIT-01. SQ1434.2 +044500* SQ1434.2 +044600* THIS TEST CLOSES A FILE THAT HAS NEVER BEEN OPENED. SQ1434.2 +044700* I-O STATUS CODE 42 SHOULD BE GENERATED. SQ1434.2 +044800* SQ1434.2 +044900 MOVE "CLOSE UNOPENED FILE" TO FEATURE. SQ1434.2 +045000 MOVE "**" TO SQ-FS1-STATUS. SQ1434.2 +045100 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ1434.2 +045200 MOVE 1 TO REC-CT. SQ1434.2 +045300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1434.2 +045400 TO DUMMY-RECORD. SQ1434.2 +045500 PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +045600 CLOSE-TEST-01. SQ1434.2 +045700 IF REC-CT = 0 SQ1434.2 +045800 OPEN INPUT SQ-FS1. SQ1434.2 +045900* THIS IF STATEMENT SHOULD NEVER BE TRUE. IT IS INCLUDED IN SQ1434.2 +046000* AN ATTEMPT TO AVOID A COMPILER DETECTING THE CLOSE OF AN SQ1434.2 +046100* UNOPENED FILE WITHOUT EXECUTING THE PROGRAM. HOWEVER, IF SQ1434.2 +046200* THE DETECTION IS MADE AT COMPILE TIME, THE TEST SHOULD BE SQ1434.2 +046300* CONSIDERED PASSED. SQ1434.2 +046400* SQ1434.2 +046500 CLOSE SQ-FS1. SQ1434.2 +046600 IF SQ-FS1-STATUS = "42" SQ1434.2 +046700 PERFORM PASS SQ1434.2 +046800 ELSE SQ1434.2 +046900 MOVE "42" TO CORRECT-A SQ1434.2 +047000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1434.2 +047100 MOVE "STATUS FOR CLOSE OF UNOPENED FILE INCORRECT" SQ1434.2 +047200 TO RE-MARK SQ1434.2 +047300 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1434.2 +047400 PERFORM FAIL SQ1434.2 +047500 END-IF. SQ1434.2 +047600* SQ1434.2 +047700 CCVS-EXIT SECTION. SQ1434.2 +047800 CCVS-999999. SQ1434.2 +047900 GO TO CLOSE-FILES. SQ1434.2 +*END-OF,SQ143A +*HEADER,COBOL,SQ144A +000100 IDENTIFICATION DIVISION. SQ1444.2 +000200 PROGRAM-ID. SQ1444.2 +000300 SQ144A. SQ1444.2 +000400**************************************************************** SQ1444.2 +000500* * SQ1444.2 +000600* VALIDATION FOR:- * SQ1444.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1444.2 +000900* REVISED 1986, AUGUST * SQ1444.2 +001000* * SQ1444.2 +001100* CREATION DATE / VALIDATION DATE * SQ1444.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1444.2 +001300* * SQ1444.2 +001400**************************************************************** SQ1444.2 +001500* * SQ1444.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1444.2 +001700* * SQ1444.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1444.2 +001900* X-55 SYSTEM PRINTER * SQ1444.2 +002000* X-82 SOURCE-COMPUTER * SQ1444.2 +002100* X-83 OBJECT-COMPUTER. * SQ1444.2 +002200* * SQ1444.2 +002300**************************************************************** SQ1444.2 +002400* * SQ1444.2 +002500* SPLIT FROM SQ133A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1444.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1444.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE WHEN AN * SQ1444.2 +002800* ATTEMPT IS MADE TO REWRITE AFTER AT END. (SEE SQ133A). * SQ1444.2 +002900* * SQ1444.2 +003000**************************************************************** SQ1444.2 +003100* SQ1444.2 +003200 ENVIRONMENT DIVISION. SQ1444.2 +003300 CONFIGURATION SECTION. SQ1444.2 +003400 SOURCE-COMPUTER. SQ1444.2 +003500 XXXXX082. SQ1444.2 +003600 OBJECT-COMPUTER. SQ1444.2 +003700 XXXXX083. SQ1444.2 +003800* SQ1444.2 +003900 INPUT-OUTPUT SECTION. SQ1444.2 +004000 FILE-CONTROL. SQ1444.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1444.2 +004200 XXXXX055. SQ1444.2 +004300* SQ1444.2 +004400P SELECT RAW-DATA ASSIGN TO SQ1444.2 +004500P XXXXX062 SQ1444.2 +004600P ORGANIZATION IS INDEXED SQ1444.2 +004700P ACCESS MODE IS RANDOM SQ1444.2 +004800P RECORD-KEY IS RAW-DATA-KEY. SQ1444.2 +004900P SQ1444.2 +005000 SELECT SQ-FS4 SQ1444.2 +005100 ASSIGN SQ1444.2 +005200 XXXXX014 SQ1444.2 +005300 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1444.2 +005400 SEQUENTIAL SQ1444.2 +005500 . SQ1444.2 +005600* SQ1444.2 +005700* SQ1444.2 +005800 DATA DIVISION. SQ1444.2 +005900 FILE SECTION. SQ1444.2 +006000 FD PRINT-FILE SQ1444.2 +006100C LABEL RECORDS SQ1444.2 +006200C XXXXX084 SQ1444.2 +006300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1444.2 +006400 . SQ1444.2 +006500 01 PRINT-REC PICTURE X(120). SQ1444.2 +006600 01 DUMMY-RECORD PICTURE X(120). SQ1444.2 +006700P SQ1444.2 +006800PFD RAW-DATA. SQ1444.2 +006900P01 RAW-DATA-SATZ. SQ1444.2 +007000P 05 RAW-DATA-KEY PIC X(6). SQ1444.2 +007100P 05 C-DATE PIC 9(6). SQ1444.2 +007200P 05 C-TIME PIC 9(8). SQ1444.2 +007300P 05 NO-OF-TESTS PIC 99. SQ1444.2 +007400P 05 C-OK PIC 999. SQ1444.2 +007500P 05 C-ALL PIC 999. SQ1444.2 +007600P 05 C-FAIL PIC 999. SQ1444.2 +007700P 05 C-DELETED PIC 999. SQ1444.2 +007800P 05 C-INSPECT PIC 999. SQ1444.2 +007900P 05 C-NOTE PIC X(13). SQ1444.2 +008000P 05 C-INDENT PIC X. SQ1444.2 +008100P 05 C-ABORT PIC X(8). SQ1444.2 +008200* SQ1444.2 +008300 FD SQ-FS4 SQ1444.2 +008400C LABEL RECORD IS STANDARD SQ1444.2 +008500 BLOCK 120 CHARACTERS SQ1444.2 +008600 RECORD CONTAINS 120 CHARACTERS SQ1444.2 +008700 . SQ1444.2 +008800 01 SQ-FS4R1-F-G-120. SQ1444.2 +008900 05 FFILE-RECORD-INFO-P1-120. SQ1444.2 +009000 07 FILLER PIC X(5). SQ1444.2 +009100 07 FFILE-NAME PIC X(6). SQ1444.2 +009200 07 FILLER PIC X(8). SQ1444.2 +009300 07 FRECORD-NAME PIC X(6). SQ1444.2 +009400 07 FILLER PIC X(1). SQ1444.2 +009500 07 FREELUNIT-NUMBER PIC 9(1). SQ1444.2 +009600 07 FILLER PIC X(7). SQ1444.2 +009700 07 FRECORD-NUMBER PIC 9(6). SQ1444.2 +009800 07 FILLER PIC X(6). SQ1444.2 +009900 07 FUPDATE-NUMBER PIC 9(2). SQ1444.2 +010000 07 FILLER PIC X(5). SQ1444.2 +010100 07 FODO-NUMBER PIC 9(4). SQ1444.2 +010200 07 FILLER PIC X(5). SQ1444.2 +010300 07 FPROGRAM-NAME PIC X(5). SQ1444.2 +010400 07 FILLER PIC X(7). SQ1444.2 +010500 07 FRECORD-LENGTH PIC 9(6). SQ1444.2 +010600 07 FILLER PIC X(7). SQ1444.2 +010700 07 FCHARS-OR-RECORDS PIC X(2). SQ1444.2 +010800 07 FILLER PIC X(1). SQ1444.2 +010900 07 FBLOCK-SIZE PIC 9(4). SQ1444.2 +011000 07 FILLER PIC X(6). SQ1444.2 +011100 07 FRECORDS-IN-FILE PIC 9(6). SQ1444.2 +011200 07 FILLER PIC X(5). SQ1444.2 +011300 07 FFILE-ORGANIZATION PIC X(2). SQ1444.2 +011400 07 FILLER PIC X(6). SQ1444.2 +011500 07 FLABEL-TYPE PIC X(1). SQ1444.2 +011600* SQ1444.2 +011700 WORKING-STORAGE SECTION. SQ1444.2 +011800* SQ1444.2 +011900*************************************************************** SQ1444.2 +012000* * SQ1444.2 +012100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1444.2 +012200* * SQ1444.2 +012300*************************************************************** SQ1444.2 +012400* SQ1444.2 +012500 01 STATUS-GROUP. SQ1444.2 +012600 04 SQ-FS4-STATUS. SQ1444.2 +012700 07 SQ-FS4-KEY-1 PIC X. SQ1444.2 +012800 07 SQ-FS4-KEY-2 PIC X. SQ1444.2 +012900* SQ1444.2 +013000 01 DELETE-SW. SQ1444.2 +013100 03 DELETE-SW-1 PIC X. SQ1444.2 +013200 03 DELETE-SW-1-GROUP. SQ1444.2 +013300 05 DELETE-SW-2 PIC X. SQ1444.2 +013400* SQ1444.2 +013500 01 DECL-EXEC-I-O PIC X(12). SQ1444.2 +013600* SQ1444.2 +013700 01 DECL-EXEC-SW PIC X. SQ1444.2 +013800* SQ1444.2 +013900*************************************************************** SQ1444.2 +014000* * SQ1444.2 +014100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1444.2 +014200* * SQ1444.2 +014300*************************************************************** SQ1444.2 +014400* SQ1444.2 +014500 01 REC-SKEL-SUB PIC 99. SQ1444.2 +014600* SQ1444.2 +014700 01 FILE-RECORD-INFORMATION-REC. SQ1444.2 +014800 03 FILE-RECORD-INFO-SKELETON. SQ1444.2 +014900 05 FILLER PICTURE X(48) VALUE SQ1444.2 +015000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1444.2 +015100 05 FILLER PICTURE X(46) VALUE SQ1444.2 +015200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1444.2 +015300 05 FILLER PICTURE X(26) VALUE SQ1444.2 +015400 ",LFIL=000000,ORG= ,LBLR= ". SQ1444.2 +015500 05 FILLER PICTURE X(37) VALUE SQ1444.2 +015600 ",RECKEY= ". SQ1444.2 +015700 05 FILLER PICTURE X(38) VALUE SQ1444.2 +015800 ",ALTKEY1= ". SQ1444.2 +015900 05 FILLER PICTURE X(38) VALUE SQ1444.2 +016000 ",ALTKEY2= ". SQ1444.2 +016100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1444.2 +016200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1444.2 +016300 05 FILE-RECORD-INFO-P1-120. SQ1444.2 +016400 07 FILLER PIC X(5). SQ1444.2 +016500 07 XFILE-NAME PIC X(6). SQ1444.2 +016600 07 FILLER PIC X(8). SQ1444.2 +016700 07 XRECORD-NAME PIC X(6). SQ1444.2 +016800 07 FILLER PIC X(1). SQ1444.2 +016900 07 REELUNIT-NUMBER PIC 9(1). SQ1444.2 +017000 07 FILLER PIC X(7). SQ1444.2 +017100 07 XRECORD-NUMBER PIC 9(6). SQ1444.2 +017200 07 FILLER PIC X(6). SQ1444.2 +017300 07 UPDATE-NUMBER PIC 9(2). SQ1444.2 +017400 07 FILLER PIC X(5). SQ1444.2 +017500 07 ODO-NUMBER PIC 9(4). SQ1444.2 +017600 07 FILLER PIC X(5). SQ1444.2 +017700 07 XPROGRAM-NAME PIC X(5). SQ1444.2 +017800 07 FILLER PIC X(7). SQ1444.2 +017900 07 XRECORD-LENGTH PIC 9(6). SQ1444.2 +018000 07 FILLER PIC X(7). SQ1444.2 +018100 07 CHARS-OR-RECORDS PIC X(2). SQ1444.2 +018200 07 FILLER PIC X(1). SQ1444.2 +018300 07 XBLOCK-SIZE PIC 9(4). SQ1444.2 +018400 07 FILLER PIC X(6). SQ1444.2 +018500 07 RECORDS-IN-FILE PIC 9(6). SQ1444.2 +018600 07 FILLER PIC X(5). SQ1444.2 +018700 07 XFILE-ORGANIZATION PIC X(2). SQ1444.2 +018800 07 FILLER PIC X(6). SQ1444.2 +018900 07 XLABEL-TYPE PIC X(1). SQ1444.2 +019000 05 FILE-RECORD-INFO-P121-240. SQ1444.2 +019100 07 FILLER PIC X(8). SQ1444.2 +019200 07 XRECORD-KEY PIC X(29). SQ1444.2 +019300 07 FILLER PIC X(9). SQ1444.2 +019400 07 ALTERNATE-KEY1 PIC X(29). SQ1444.2 +019500 07 FILLER PIC X(9). SQ1444.2 +019600 07 ALTERNATE-KEY2 PIC X(29). SQ1444.2 +019700 07 FILLER PIC X(7). SQ1444.2 +019800* SQ1444.2 +019900 01 TEST-RESULTS. SQ1444.2 +020000 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020100 02 PAR-NAME. SQ1444.2 +020200 03 FILLER PIC X(14) VALUE SPACE. SQ1444.2 +020300 03 PARDOT-X PIC X VALUE SPACE. SQ1444.2 +020400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1444.2 +020500 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020600 02 FEATURE PIC X(24) VALUE SPACE. SQ1444.2 +020700 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1444.2 +020900 02 FILLER PIC X(9) VALUE SPACE. SQ1444.2 +021000 02 RE-MARK PIC X(61). SQ1444.2 +021100 01 TEST-COMPUTED. SQ1444.2 +021200 02 FILLER PIC X(30) VALUE SPACE. SQ1444.2 +021300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1444.2 +021400 02 COMPUTED-X. SQ1444.2 +021500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1444.2 +021600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1444.2 +021700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1444.2 +021800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1444.2 +021900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1444.2 +022000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1444.2 +022100 04 COMPUTED-18V0 PIC -9(18). SQ1444.2 +022200 04 FILLER PIC X. SQ1444.2 +022300 03 FILLER PIC X(50) VALUE SPACE. SQ1444.2 +022400 01 TEST-CORRECT. SQ1444.2 +022500 02 FILLER PIC X(30) VALUE SPACE. SQ1444.2 +022600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1444.2 +022700 02 CORRECT-X. SQ1444.2 +022800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1444.2 +022900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1444.2 +023000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1444.2 +023100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1444.2 +023200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1444.2 +023300 03 CR-18V0 REDEFINES CORRECT-A. SQ1444.2 +023400 04 CORRECT-18V0 PIC -9(18). SQ1444.2 +023500 04 FILLER PIC X. SQ1444.2 +023600 03 FILLER PIC X(2) VALUE SPACE. SQ1444.2 +023700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1444.2 +023800* SQ1444.2 +023900 01 CCVS-C-1. SQ1444.2 +024000 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1444.2 +024200 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1444.2 +024400 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1444.2 +024600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1444.2 +024700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1444.2 +024800 01 CCVS-C-2. SQ1444.2 +024900 02 FILLER PIC X(19) VALUE SPACE. SQ1444.2 +025000 02 FILLER PIC X(6) VALUE "TESTED". SQ1444.2 +025100 02 FILLER PIC X(19) VALUE SPACE. SQ1444.2 +025200 02 FILLER PIC X(4) VALUE "FAIL". SQ1444.2 +025300 02 FILLER PIC X(72) VALUE SPACE. SQ1444.2 +025400* SQ1444.2 +025500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1444.2 +025600 01 REC-CT PIC 99 VALUE ZERO. SQ1444.2 +025700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +025800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +025900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +026000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +026100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1444.2 +026200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1444.2 +026300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1444.2 +026400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1444.2 +026500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1444.2 +026600 01 CCVS-H-1. SQ1444.2 +026700 02 FILLER PIC X(39) VALUE SPACES. SQ1444.2 +026800 02 FILLER PIC X(42) VALUE SQ1444.2 +026900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1444.2 +027000 02 FILLER PIC X(39) VALUE SPACES. SQ1444.2 +027100 01 CCVS-H-2A. SQ1444.2 +027200 02 FILLER PIC X(40) VALUE SPACE. SQ1444.2 +027300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1444.2 +027400 02 FILLER PIC XXXX VALUE SQ1444.2 +027500 "4.2 ". SQ1444.2 +027600 02 FILLER PIC X(28) VALUE SQ1444.2 +027700 " COPY - NOT FOR DISTRIBUTION". SQ1444.2 +027800 02 FILLER PIC X(41) VALUE SPACE. SQ1444.2 +027900* SQ1444.2 +028000 01 CCVS-H-2B. SQ1444.2 +028100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1444.2 +028200 02 TEST-ID PIC X(9). SQ1444.2 +028300 02 FILLER PIC X(4) VALUE " IN ". SQ1444.2 +028400 02 FILLER PIC X(12) VALUE SQ1444.2 +028500 " HIGH ". SQ1444.2 +028600 02 FILLER PIC X(22) VALUE SQ1444.2 +028700 " LEVEL VALIDATION FOR ". SQ1444.2 +028800 02 FILLER PIC X(58) VALUE SQ1444.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +029000 01 CCVS-H-3. SQ1444.2 +029100 02 FILLER PIC X(34) VALUE SQ1444.2 +029200 " FOR OFFICIAL USE ONLY ". SQ1444.2 +029300 02 FILLER PIC X(58) VALUE SQ1444.2 +029400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1444.2 +029500 02 FILLER PIC X(28) VALUE SQ1444.2 +029600 " COPYRIGHT 1985,1986 ". SQ1444.2 +029700 01 CCVS-E-1. SQ1444.2 +029800 02 FILLER PIC X(52) VALUE SPACE. SQ1444.2 +029900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1444.2 +030000 02 ID-AGAIN PIC X(9). SQ1444.2 +030100 02 FILLER PIC X(45) VALUE SPACES. SQ1444.2 +030200 01 CCVS-E-2. SQ1444.2 +030300 02 FILLER PIC X(31) VALUE SPACE. SQ1444.2 +030400 02 FILLER PIC X(21) VALUE SPACE. SQ1444.2 +030500 02 CCVS-E-2-2. SQ1444.2 +030600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1444.2 +030700 03 FILLER PIC X VALUE SPACE. SQ1444.2 +030800 03 ENDER-DESC PIC X(44) VALUE SQ1444.2 +030900 "ERRORS ENCOUNTERED". SQ1444.2 +031000 01 CCVS-E-3. SQ1444.2 +031100 02 FILLER PIC X(22) VALUE SQ1444.2 +031200 " FOR OFFICIAL USE ONLY". SQ1444.2 +031300 02 FILLER PIC X(12) VALUE SPACE. SQ1444.2 +031400 02 FILLER PIC X(58) VALUE SQ1444.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +031600 02 FILLER PIC X(8) VALUE SPACE. SQ1444.2 +031700 02 FILLER PIC X(20) VALUE SQ1444.2 +031800 " COPYRIGHT 1985,1986". SQ1444.2 +031900 01 CCVS-E-4. SQ1444.2 +032000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1444.2 +032100 02 FILLER PIC X(4) VALUE " OF ". SQ1444.2 +032200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1444.2 +032300 02 FILLER PIC X(40) VALUE SQ1444.2 +032400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1444.2 +032500 01 XXINFO. SQ1444.2 +032600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1444.2 +032700 02 INFO-TEXT. SQ1444.2 +032800 04 FILLER PIC X(8) VALUE SPACE. SQ1444.2 +032900 04 XXCOMPUTED PIC X(20). SQ1444.2 +033000 04 FILLER PIC X(5) VALUE SPACE. SQ1444.2 +033100 04 XXCORRECT PIC X(20). SQ1444.2 +033200 02 INF-ANSI-REFERENCE PIC X(48). SQ1444.2 +033300 01 HYPHEN-LINE. SQ1444.2 +033400 02 FILLER PIC IS X VALUE IS SPACE. SQ1444.2 +033500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1444.2 +033600- "*****************************************". SQ1444.2 +033700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1444.2 +033800- "******************************". SQ1444.2 +033900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1444.2 +034000 "SQ144A". SQ1444.2 +034100* SQ1444.2 +034200* SQ1444.2 +034300 PROCEDURE DIVISION. SQ1444.2 +034400 DECLARATIVES. SQ1444.2 +034500* SQ1444.2 +034600 SECT-SQ144A-0001 SECTION. SQ1444.2 +034700 USE AFTER EXCEPTION PROCEDURE I-O. SQ1444.2 +034800 I-O-ERROR-PROCESS. SQ1444.2 +034900 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +035000 IF DECL-EXEC-SW NOT = SPACE SQ1444.2 +035100 GO TO END-DECLS. SQ1444.2 +035200* SQ1444.2 +035300 MOVE 1 TO REC-CT. SQ1444.2 +035400 MOVE "REWRITE AFTER FAILED RD" TO FEATURE. SQ1444.2 +035500 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1444.2 +035600 GO TO DCL-REWRITE-01. SQ1444.2 +035700 DECL-DELETE-01. SQ1444.2 +035800 PERFORM DECL-DE-LETE. SQ1444.2 +035900 GO TO DECL-TEST-01-END. SQ1444.2 +036000 DCL-REWRITE-01. SQ1444.2 +036100 DECL-TEST-01-END. SQ1444.2 +036200* SQ1444.2 +036300 PERFORM DECL-WRITE-LINE. SQ1444.2 +036400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1444.2 +036500 TO DUMMY-RECORD. SQ1444.2 +036600 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1444.2 +036700 GO TO END-DECLS. SQ1444.2 +036800* SQ1444.2 +036900* SQ1444.2 +037000 DECL-PASS. SQ1444.2 +037100 MOVE "PASS " TO P-OR-F. SQ1444.2 +037200 ADD 1 TO PASS-COUNTER. SQ1444.2 +037300 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +037400* SQ1444.2 +037500 DECL-FAIL. SQ1444.2 +037600 MOVE "FAIL*" TO P-OR-F. SQ1444.2 +037700 ADD 1 TO ERROR-COUNTER. SQ1444.2 +037800 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +037900* SQ1444.2 +038000 DECL-DE-LETE. SQ1444.2 +038100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1444.2 +038200 MOVE "*****" TO P-OR-F. SQ1444.2 +038300 ADD 1 TO DELETE-COUNTER. SQ1444.2 +038400 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +038500* SQ1444.2 +038600 DECL-PRINT-DETAIL. SQ1444.2 +038700 IF REC-CT NOT EQUAL TO ZERO SQ1444.2 +038800 MOVE "." TO PARDOT-X SQ1444.2 +038900 MOVE REC-CT TO DOTVALUE. SQ1444.2 +039000 MOVE TEST-RESULTS TO PRINT-REC. SQ1444.2 +039100 PERFORM DECL-WRITE-LINE. SQ1444.2 +039200 IF P-OR-F EQUAL TO "FAIL*" SQ1444.2 +039300 PERFORM DECL-WRITE-LINE SQ1444.2 +039400 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1444.2 +039500 ELSE SQ1444.2 +039600 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1444.2 +039700 MOVE SPACE TO P-OR-F. SQ1444.2 +039800 MOVE SPACE TO COMPUTED-X. SQ1444.2 +039900 MOVE SPACE TO CORRECT-X. SQ1444.2 +040000 IF REC-CT EQUAL TO ZERO SQ1444.2 +040100 MOVE SPACE TO PAR-NAME. SQ1444.2 +040200 MOVE SPACE TO RE-MARK. SQ1444.2 +040300* SQ1444.2 +040400 DECL-WRITE-LINE. SQ1444.2 +040500 ADD 1 TO RECORD-COUNT. SQ1444.2 +040600Y IF RECORD-COUNT GREATER 50 SQ1444.2 +040700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1444.2 +040800Y MOVE SPACE TO DUMMY-RECORD SQ1444.2 +040900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1444.2 +041000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1444.2 +041100Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1444.2 +041200Y PERFORM DECL-WRT-LN 2 TIMES SQ1444.2 +041300Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1444.2 +041400Y PERFORM DECL-WRT-LN SQ1444.2 +041500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1444.2 +041600Y MOVE ZERO TO RECORD-COUNT. SQ1444.2 +041700 PERFORM DECL-WRT-LN. SQ1444.2 +041800* SQ1444.2 +041900 DECL-WRT-LN. SQ1444.2 +042000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1444.2 +042100 MOVE SPACE TO DUMMY-RECORD. SQ1444.2 +042200* SQ1444.2 +042300 DECL-FAIL-ROUTINE. SQ1444.2 +042400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1444.2 +042500 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1444.2 +042600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +042700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1444.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +042900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +043100 GO TO DECL-FAIL-EX. SQ1444.2 +043200 DECL-FAIL-WRITE. SQ1444.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC SQ1444.2 +043400 PERFORM DECL-WRITE-LINE SQ1444.2 +043500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1444.2 +043600 MOVE TEST-CORRECT TO PRINT-REC SQ1444.2 +043700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +043800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1444.2 +043900 DECL-FAIL-EX. SQ1444.2 +044000 EXIT. SQ1444.2 +044100* SQ1444.2 +044200 DECL-BAIL. SQ1444.2 +044300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1444.2 +044400 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1444.2 +044500 DECL-BAIL-WRITE. SQ1444.2 +044600 MOVE CORRECT-A TO XXCORRECT. SQ1444.2 +044700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1444.2 +044800 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +044900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +045000 DECL-BAIL-EX. SQ1444.2 +045100 EXIT. SQ1444.2 +045200* SQ1444.2 +045300 END-DECLS. SQ1444.2 +045400 END DECLARATIVES. SQ1444.2 +045500* SQ1444.2 +045600* SQ1444.2 +045700 CCVS1 SECTION. SQ1444.2 +045800 OPEN-FILES. SQ1444.2 +045900P OPEN I-O RAW-DATA. SQ1444.2 +046000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1444.2 +046100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1444.2 +046200P MOVE "ABORTED " TO C-ABORT. SQ1444.2 +046300P ADD 1 TO C-NO-OF-TESTS. SQ1444.2 +046400P ACCEPT C-DATE FROM DATE. SQ1444.2 +046500P ACCEPT C-TIME FROM TIME. SQ1444.2 +046600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1444.2 +046700PEND-E-1. SQ1444.2 +046800P CLOSE RAW-DATA. SQ1444.2 +046900 OPEN OUTPUT PRINT-FILE. SQ1444.2 +047000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1444.2 +047100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1444.2 +047200 MOVE SPACE TO TEST-RESULTS. SQ1444.2 +047300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1444.2 +047400 MOVE ZERO TO REC-SKEL-SUB. SQ1444.2 +047500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1444.2 +047600 GO TO CCVS1-EXIT. SQ1444.2 +047700* SQ1444.2 +047800 CCVS-INIT-FILE. SQ1444.2 +047900 ADD 1 TO REC-SKL-SUB. SQ1444.2 +048000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1444.2 +048100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1444.2 +048200* SQ1444.2 +048300 CLOSE-FILES. SQ1444.2 +048400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1444.2 +048500 CLOSE PRINT-FILE. SQ1444.2 +048600P OPEN I-O RAW-DATA. SQ1444.2 +048700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1444.2 +048800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1444.2 +048900P MOVE "OK. " TO C-ABORT. SQ1444.2 +049000P MOVE PASS-COUNTER TO C-OK. SQ1444.2 +049100P MOVE ERROR-HOLD TO C-ALL. SQ1444.2 +049200P MOVE ERROR-COUNTER TO C-FAIL. SQ1444.2 +049300P MOVE DELETE-CNT TO C-DELETED. SQ1444.2 +049400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1444.2 +049500P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1444.2 +049600PEND-E-2. SQ1444.2 +049700P CLOSE RAW-DATA. SQ1444.2 +049800 TERMINATE-CCVS. SQ1444.2 +049900S EXIT PROGRAM. SQ1444.2 +050000 STOP RUN. SQ1444.2 +050100* SQ1444.2 +050200 INSPT. SQ1444.2 +050300 MOVE "INSPT" TO P-OR-F. SQ1444.2 +050400 ADD 1 TO INSPECT-COUNTER. SQ1444.2 +050500 PERFORM PRINT-DETAIL. SQ1444.2 +050600* SQ1444.2 +050700 PASS. SQ1444.2 +050800 MOVE "PASS " TO P-OR-F. SQ1444.2 +050900 ADD 1 TO PASS-COUNTER. SQ1444.2 +051000 PERFORM PRINT-DETAIL. SQ1444.2 +051100* SQ1444.2 +051200 FAIL. SQ1444.2 +051300 MOVE "FAIL*" TO P-OR-F. SQ1444.2 +051400 ADD 1 TO ERROR-COUNTER. SQ1444.2 +051500 PERFORM PRINT-DETAIL. SQ1444.2 +051600* SQ1444.2 +051700 DE-LETE. SQ1444.2 +051800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1444.2 +051900 MOVE "*****" TO P-OR-F. SQ1444.2 +052000 ADD 1 TO DELETE-COUNTER. SQ1444.2 +052100 PERFORM PRINT-DETAIL. SQ1444.2 +052200* SQ1444.2 +052300 PRINT-DETAIL. SQ1444.2 +052400 IF REC-CT NOT EQUAL TO ZERO SQ1444.2 +052500 MOVE "." TO PARDOT-X SQ1444.2 +052600 MOVE REC-CT TO DOTVALUE. SQ1444.2 +052700 MOVE TEST-RESULTS TO PRINT-REC. SQ1444.2 +052800 PERFORM WRITE-LINE. SQ1444.2 +052900 IF P-OR-F EQUAL TO "FAIL*" SQ1444.2 +053000 PERFORM WRITE-LINE SQ1444.2 +053100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1444.2 +053200 ELSE SQ1444.2 +053300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1444.2 +053400 MOVE SPACE TO P-OR-F. SQ1444.2 +053500 MOVE SPACE TO COMPUTED-X. SQ1444.2 +053600 MOVE SPACE TO CORRECT-X. SQ1444.2 +053700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1444.2 +053800 MOVE SPACE TO RE-MARK. SQ1444.2 +053900* SQ1444.2 +054000 HEAD-ROUTINE. SQ1444.2 +054100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1444.2 +054400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1444.2 +054500 COLUMN-NAMES-ROUTINE. SQ1444.2 +054600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +054700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +054900 END-ROUTINE. SQ1444.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1444.2 +055100 PERFORM WRITE-LINE 5 TIMES. SQ1444.2 +055200 END-RTN-EXIT. SQ1444.2 +055300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1444.2 +055400 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +055500* SQ1444.2 +055600 END-ROUTINE-1. SQ1444.2 +055700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1444.2 +055800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1444.2 +055900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1444.2 +056000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1444.2 +056100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1444.2 +056200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1444.2 +056300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1444.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1444.2 +056500 PERFORM WRITE-LINE. SQ1444.2 +056600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1444.2 +056700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1444.2 +056800 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +056900 ELSE SQ1444.2 +057000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1444.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1444.2 +057200 PERFORM WRITE-LINE. SQ1444.2 +057300 END-ROUTINE-13. SQ1444.2 +057400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1444.2 +057500 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +057600 ELSE SQ1444.2 +057700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1444.2 +057800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1444.2 +057900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1444.2 +058000 PERFORM WRITE-LINE. SQ1444.2 +058100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1444.2 +058200 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +058300 ELSE SQ1444.2 +058400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1444.2 +058500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1444.2 +058600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +058700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +058800* SQ1444.2 +058900 WRITE-LINE. SQ1444.2 +059000 ADD 1 TO RECORD-COUNT. SQ1444.2 +059100Y IF RECORD-COUNT GREATER 50 SQ1444.2 +059200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1444.2 +059300Y MOVE SPACE TO DUMMY-RECORD SQ1444.2 +059400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1444.2 +059500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1444.2 +059600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1444.2 +059700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1444.2 +059800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1444.2 +059900Y MOVE ZERO TO RECORD-COUNT. SQ1444.2 +060000 PERFORM WRT-LN. SQ1444.2 +060100* SQ1444.2 +060200 WRT-LN. SQ1444.2 +060300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1444.2 +060400 MOVE SPACE TO DUMMY-RECORD. SQ1444.2 +060500 BLANK-LINE-PRINT. SQ1444.2 +060600 PERFORM WRT-LN. SQ1444.2 +060700 FAIL-ROUTINE. SQ1444.2 +060800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1444.2 +060900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1444.2 +061000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +061100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1444.2 +061200 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +061300 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +061400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +061500 GO TO FAIL-ROUTINE-EX. SQ1444.2 +061600 FAIL-ROUTINE-WRITE. SQ1444.2 +061700 MOVE TEST-COMPUTED TO PRINT-REC SQ1444.2 +061800 PERFORM WRITE-LINE SQ1444.2 +061900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1444.2 +062000 MOVE TEST-CORRECT TO PRINT-REC SQ1444.2 +062100 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +062200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1444.2 +062300 FAIL-ROUTINE-EX. SQ1444.2 +062400 EXIT. SQ1444.2 +062500 BAIL-OUT. SQ1444.2 +062600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1444.2 +062700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1444.2 +062800 BAIL-OUT-WRITE. SQ1444.2 +062900 MOVE CORRECT-A TO XXCORRECT. SQ1444.2 +063000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1444.2 +063100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +063200 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +063300 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +063400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +063500 BAIL-OUT-EX. SQ1444.2 +063600 EXIT. SQ1444.2 +063700 CCVS1-EXIT. SQ1444.2 +063800 EXIT. SQ1444.2 +063900* SQ1444.2 +064000**************************************************************** SQ1444.2 +064100* * SQ1444.2 +064200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1444.2 +064300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1444.2 +064400* * SQ1444.2 +064500**************************************************************** SQ1444.2 +064600* SQ1444.2 +064700 SECT-SQ144A-0002 SECTION. SQ1444.2 +064800 STA-INIT. SQ1444.2 +064900 MOVE SPACE TO DELETE-SW. SQ1444.2 +065000* SQ1444.2 +065100 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1444.2 +065200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1444.2 +065300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1444.2 +065400 MOVE 120 TO XRECORD-LENGTH (1). SQ1444.2 +065500 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1444.2 +065600 MOVE 1 TO XBLOCK-SIZE (1). SQ1444.2 +065700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1444.2 +065800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1444.2 +065900 MOVE "S" TO XLABEL-TYPE (1). SQ1444.2 +066000* SQ1444.2 +066100* OPEN THE FILE IN THE OUTPUT MODE SQ1444.2 +066200* SQ1444.2 +066300 SEQ-INIT-01. SQ1444.2 +066400 MOVE 0 TO REC-CT. SQ1444.2 +066500 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +066600 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +066700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +066800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1444.2 +066900 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1444.2 +067000 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1444.2 +067100 GO TO SEQ-TEST-OP-01. SQ1444.2 +067200 SEQ-DELETE-01. SQ1444.2 +067300 MOVE "*" TO DELETE-SW-1. SQ1444.2 +067400 SEQ-TEST-OP-01. SQ1444.2 +067500 OPEN OUTPUT SQ-FS4. SQ1444.2 +067600 SEQ-INIT-02. SQ1444.2 +067700 MOVE 0 TO REC-CT. SQ1444.2 +067800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +068200 MOVE "WRITE A RECORD" TO FEATURE. SQ1444.2 +068300 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1444.2 +068400 SEQ-TEST-WR-02. SQ1444.2 +068500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1444.2 +068600 WRITE SQ-FS4R1-F-G-120. SQ1444.2 +068700 SEQ-INIT-03. SQ1444.2 +068800 MOVE 0 TO REC-CT. SQ1444.2 +068900 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +069000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +069100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +069200 MOVE "CLOSE FILE" TO FEATURE. SQ1444.2 +069300 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1444.2 +069400 SEQ-TEST-CL-03. SQ1444.2 +069500 CLOSE SQ-FS4. SQ1444.2 +069600 SEQ-INIT-04. SQ1444.2 +069700 MOVE 0 TO REC-CT. SQ1444.2 +069800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +069900 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +070000 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +070100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1444.2 +070200 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1444.2 +070300 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1444.2 +070400 SEQ-TEST-OP-04. SQ1444.2 +070500 OPEN I-O SQ-FS4. SQ1444.2 +070600 SEQ-INIT-05. SQ1444.2 +070700 MOVE 0 TO REC-CT. SQ1444.2 +070800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +070900 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +071000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +071100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +071200 MOVE "READ FIRST RECORD" TO FEATURE. SQ1444.2 +071300 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1444.2 +071400 SEQ-TEST-RD-05. SQ1444.2 +071500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1444.2 +071600 READ SQ-FS4. SQ1444.2 +071700 SEQ-INIT-06. SQ1444.2 +071800 MOVE 0 TO REC-CT. SQ1444.2 +071900 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +072000 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +072100 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +072200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +072300 MOVE "READ GIVING AT END" TO FEATURE. SQ1444.2 +072400 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1444.2 +072500 SEQ-TEST-RD-06. SQ1444.2 +072600 READ SQ-FS4 RECORD. SQ1444.2 +072700 SEQ-INIT-07. SQ1444.2 +072800 MOVE 0 TO REC-CT. SQ1444.2 +072900 MOVE SPACE TO DECL-EXEC-SW. SQ1444.2 +073000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +073100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +073200 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1444.2 +073300 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1444.2 +073400 SEQ-TEST-RW-07. SQ1444.2 +073500 REWRITE SQ-FS4R1-F-G-120. SQ1444.2 +073600 MOVE 0 TO REC-CT. SQ1444.2 +073700 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1444.2 +073800 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1444.2 +073900* SQ1444.2 +074000* CHECK I-O STATUS RETURNED FROM REWRITE SQ1444.2 +074100* SQ1444.2 +074200 ADD 1 TO REC-CT. SQ1444.2 +074300 SEQ-TEST-07-01-END. SQ1444.2 +074400* SQ1444.2 +074500* CHECK EXECUTION OF I-O DECLARATIVE SQ1444.2 +074600* SQ1444.2 +074700 ADD 1 TO REC-CT. SQ1444.2 +074800 IF DELETE-SW NOT = SPACE SQ1444.2 +074900 GO TO SEQ-DELETE-07-02. SQ1444.2 +075000 GO TO SEQ-TEST-RW-07-02. SQ1444.2 +075100 SEQ-DELETE-07-02. SQ1444.2 +075200 PERFORM DE-LETE. SQ1444.2 +075300 GO TO SEQ-TEST-07-02-END. SQ1444.2 +075400 SEQ-TEST-RW-07-02. SQ1444.2 +075500 IF DECL-EXEC-I-O = "EXECUTED" SQ1444.2 +075600 PERFORM PASS SQ1444.2 +075700 ELSE SQ1444.2 +075800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1444.2 +075900 MOVE "EXECUTED" TO CORRECT-A SQ1444.2 +076000 MOVE "I-O DECLARATIVE NOT EXECUTED" SQ1444.2 +076100 TO RE-MARK SQ1444.2 +076200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1444.2 +076300 PERFORM FAIL. SQ1444.2 +076400 SEQ-TEST-07-02-END. SQ1444.2 +076500* SQ1444.2 +076600* SQ1444.2 +076700 CCVS-EXIT SECTION. SQ1444.2 +076800 CCVS-999999. SQ1444.2 +076900 GO TO CLOSE-FILES. SQ1444.2 +*END-OF,SQ144A +*HEADER,COBOL,SQ146A +000100 IDENTIFICATION DIVISION. SQ1464.2 +000200 PROGRAM-ID. SQ1464.2 +000300 SQ146A. SQ1464.2 +000400**************************************************************** SQ1464.2 +000500* * SQ1464.2 +000600* VALIDATION FOR:- * SQ1464.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +000800* USING CCVS85 VERSION 3.0. * SQ1464.2 +000900* * SQ1464.2 +001000* CREATION DATE / VALIDATION DATE * SQ1464.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1464.2 +001200* * SQ1464.2 +001300**************************************************************** SQ1464.2 +001400* * SQ1464.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1464.2 +001600* * SQ1464.2 +001700* X-01 SEQUENTIAL TAPE * SQ1464.2 +001800* X-55 SYSTEM PRINTER * SQ1464.2 +001900* X-82 SOURCE-COMPUTER * SQ1464.2 +002000* X-83 OBJECT-COMPUTER. * SQ1464.2 +002100* X-84 LABEL RECORDS OPTION * SQ1464.2 +002200* * SQ1464.2 +002300**************************************************************** SQ1464.2 +002400* * SQ1464.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO CLOSE OF * SQ1464.2 +002600* AN ALREADY CLOSED FILE. THE TEST FOR CORRECT I-O STATUS * SQ1464.2 +002700* CODE 42 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1464.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1464.2 +002900* CODE IS ACCOMPLISHED. * SQ1464.2 +003000* * SQ1464.2 +003100**************************************************************** SQ1464.2 +003200* SQ1464.2 +003300 ENVIRONMENT DIVISION. SQ1464.2 +003400 CONFIGURATION SECTION. SQ1464.2 +003500 SOURCE-COMPUTER. SQ1464.2 +003600 XXXXX082. SQ1464.2 +003700 OBJECT-COMPUTER. SQ1464.2 +003800 XXXXX083. SQ1464.2 +003900* SQ1464.2 +004000 INPUT-OUTPUT SECTION. SQ1464.2 +004100 FILE-CONTROL. SQ1464.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1464.2 +004300 XXXXX055. SQ1464.2 +004400* SQ1464.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1464.2 +004600 XXXXX001 SQ1464.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1464.2 +004800* SQ1464.2 +004900* SQ1464.2 +005000 DATA DIVISION. SQ1464.2 +005100 FILE SECTION. SQ1464.2 +005200 FD PRINT-FILE SQ1464.2 +005300C LABEL RECORDS SQ1464.2 +005400C XXXXX084 SQ1464.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1464.2 +005600 . SQ1464.2 +005700 01 PRINT-REC PICTURE X(120). SQ1464.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1464.2 +005900* SQ1464.2 +006000 FD SQ-FS1 SQ1464.2 +006100C LABEL RECORD IS STANDARD SQ1464.2 +006200 . SQ1464.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1464.2 +006400* SQ1464.2 +006500 WORKING-STORAGE SECTION. SQ1464.2 +006600* SQ1464.2 +006700*************************************************************** SQ1464.2 +006800* * SQ1464.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1464.2 +007000* * SQ1464.2 +007100*************************************************************** SQ1464.2 +007200* SQ1464.2 +007300 01 SQ-FS1-STATUS. SQ1464.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1464.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1464.2 +007600* SQ1464.2 +007700 01 DECL-EXEC-SW PIC 9. SQ1464.2 +007800* SQ1464.2 +007900*************************************************************** SQ1464.2 +008000* * SQ1464.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1464.2 +008200* * SQ1464.2 +008300*************************************************************** SQ1464.2 +008400* SQ1464.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1464.2 +008600* SQ1464.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1464.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1464.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1464.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1464.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1464.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1464.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1464.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1464.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1464.2 +009600 ",RECKEY= ". SQ1464.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1464.2 +009800 ",ALTKEY1= ". SQ1464.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1464.2 +010000 ",ALTKEY2= ". SQ1464.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1464.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1464.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1464.2 +010400 07 FILLER PIC X(5). SQ1464.2 +010500 07 XFILE-NAME PIC X(6). SQ1464.2 +010600 07 FILLER PIC X(8). SQ1464.2 +010700 07 XRECORD-NAME PIC X(6). SQ1464.2 +010800 07 FILLER PIC X(1). SQ1464.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1464.2 +011000 07 FILLER PIC X(7). SQ1464.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1464.2 +011200 07 FILLER PIC X(6). SQ1464.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1464.2 +011400 07 FILLER PIC X(5). SQ1464.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1464.2 +011600 07 FILLER PIC X(5). SQ1464.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1464.2 +011800 07 FILLER PIC X(7). SQ1464.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1464.2 +012000 07 FILLER PIC X(7). SQ1464.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1464.2 +012200 07 FILLER PIC X(1). SQ1464.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1464.2 +012400 07 FILLER PIC X(6). SQ1464.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1464.2 +012600 07 FILLER PIC X(5). SQ1464.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1464.2 +012800 07 FILLER PIC X(6). SQ1464.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1464.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1464.2 +013100 07 FILLER PIC X(8). SQ1464.2 +013200 07 XRECORD-KEY PIC X(29). SQ1464.2 +013300 07 FILLER PIC X(9). SQ1464.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1464.2 +013500 07 FILLER PIC X(9). SQ1464.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1464.2 +013700 07 FILLER PIC X(7). SQ1464.2 +013800* SQ1464.2 +013900 01 TEST-RESULTS. SQ1464.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ1464.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ1464.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014500 02 PAR-NAME. SQ1464.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1464.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1464.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1464.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1464.2 +015000 02 RE-MARK PIC X(61). SQ1464.2 +015100 01 TEST-COMPUTED. SQ1464.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1464.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1464.2 +015400 02 COMPUTED-X. SQ1464.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1464.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1464.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1464.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1464.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1464.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1464.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1464.2 +016200 04 FILLER PIC X. SQ1464.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1464.2 +016400 01 TEST-CORRECT. SQ1464.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1464.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1464.2 +016700 02 CORRECT-X. SQ1464.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1464.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1464.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1464.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1464.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1464.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1464.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1464.2 +017500 04 FILLER PIC X. SQ1464.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1464.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1464.2 +017800 01 CCVS-C-1. SQ1464.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ1464.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1464.2 +018100- "SS PARAGRAPH-NAME SQ1464.2 +018200- " REMARKS". SQ1464.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ1464.2 +018400 01 CCVS-C-2. SQ1464.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ1464.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ1464.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ1464.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ1464.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ1464.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1464.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ1464.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1464.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1464.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1464.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1464.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1464.2 +020100 01 CCVS-H-1. SQ1464.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1464.2 +020300 02 FILLER PIC X(42) VALUE SQ1464.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1464.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ1464.2 +020600 01 CCVS-H-2A. SQ1464.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ1464.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1464.2 +020900 02 FILLER PIC XXXX VALUE SQ1464.2 +021000 "4.2 ". SQ1464.2 +021100 02 FILLER PIC X(28) VALUE SQ1464.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ1464.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ1464.2 +021400* SQ1464.2 +021500 01 CCVS-H-2B. SQ1464.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1464.2 +021700 02 TEST-ID PIC X(9). SQ1464.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ1464.2 +021900 02 FILLER PIC X(12) VALUE SQ1464.2 +022000 " HIGH ". SQ1464.2 +022100 02 FILLER PIC X(22) VALUE SQ1464.2 +022200 " LEVEL VALIDATION FOR ". SQ1464.2 +022300 02 FILLER PIC X(58) VALUE SQ1464.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +022500 01 CCVS-H-3. SQ1464.2 +022600 02 FILLER PIC X(34) VALUE SQ1464.2 +022700 " FOR OFFICIAL USE ONLY ". SQ1464.2 +022800 02 FILLER PIC X(58) VALUE SQ1464.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1464.2 +023000 02 FILLER PIC X(28) VALUE SQ1464.2 +023100 " COPYRIGHT 1985,1986 ". SQ1464.2 +023200 01 CCVS-E-1. SQ1464.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ1464.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1464.2 +023500 02 ID-AGAIN PIC X(9). SQ1464.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ1464.2 +023700 01 CCVS-E-2. SQ1464.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ1464.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ1464.2 +024000 02 CCVS-E-2-2. SQ1464.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1464.2 +024200 03 FILLER PIC X VALUE SPACE. SQ1464.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ1464.2 +024400 "ERRORS ENCOUNTERED". SQ1464.2 +024500 01 CCVS-E-3. SQ1464.2 +024600 02 FILLER PIC X(22) VALUE SQ1464.2 +024700 " FOR OFFICIAL USE ONLY". SQ1464.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ1464.2 +024900 02 FILLER PIC X(58) VALUE SQ1464.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ1464.2 +025200 02 FILLER PIC X(20) VALUE SQ1464.2 +025300 " COPYRIGHT 1985,1986". SQ1464.2 +025400 01 CCVS-E-4. SQ1464.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1464.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ1464.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1464.2 +025800 02 FILLER PIC X(40) VALUE SQ1464.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1464.2 +026000 01 XXINFO. SQ1464.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1464.2 +026200 02 INFO-TEXT. SQ1464.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ1464.2 +026400 04 XXCOMPUTED PIC X(20). SQ1464.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ1464.2 +026600 04 XXCORRECT PIC X(20). SQ1464.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ1464.2 +026800 01 HYPHEN-LINE. SQ1464.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ1464.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ1464.2 +027100- "*****************************************". SQ1464.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ1464.2 +027300- "******************************". SQ1464.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ1464.2 +027500 "SQ146A". SQ1464.2 +027600* SQ1464.2 +027700 PROCEDURE DIVISION. SQ1464.2 +027800 CCVS1 SECTION. SQ1464.2 +027900 OPEN-FILES. SQ1464.2 +028000 OPEN OUTPUT PRINT-FILE. SQ1464.2 +028100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1464.2 +028200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1464.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ1464.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1464.2 +028500 MOVE ZERO TO REC-SKEL-SUB. SQ1464.2 +028600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1464.2 +028700 GO TO CCVS1-EXIT. SQ1464.2 +028800* SQ1464.2 +028900 CCVS-INIT-FILE. SQ1464.2 +029000 ADD 1 TO REC-SKL-SUB. SQ1464.2 +029100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1464.2 +029200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1464.2 +029300* SQ1464.2 +029400 CLOSE-FILES. SQ1464.2 +029500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1464.2 +029600 CLOSE PRINT-FILE. SQ1464.2 +029700 TERMINATE-CCVS. SQ1464.2 +029800 STOP RUN. SQ1464.2 +029900* SQ1464.2 +030000 INSPT. SQ1464.2 +030100 MOVE "INSPT" TO P-OR-F. SQ1464.2 +030200 ADD 1 TO INSPECT-COUNTER. SQ1464.2 +030300 PERFORM PRINT-DETAIL. SQ1464.2 +030400 SQ1464.2 +030500 PASS. SQ1464.2 +030600 MOVE "PASS " TO P-OR-F. SQ1464.2 +030700 ADD 1 TO PASS-COUNTER. SQ1464.2 +030800 PERFORM PRINT-DETAIL. SQ1464.2 +030900* SQ1464.2 +031000 FAIL. SQ1464.2 +031100 MOVE "FAIL*" TO P-OR-F. SQ1464.2 +031200 ADD 1 TO ERROR-COUNTER. SQ1464.2 +031300 PERFORM PRINT-DETAIL. SQ1464.2 +031400* SQ1464.2 +031500 DE-LETE. SQ1464.2 +031600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1464.2 +031700 MOVE "*****" TO P-OR-F. SQ1464.2 +031800 ADD 1 TO DELETE-COUNTER. SQ1464.2 +031900 PERFORM PRINT-DETAIL. SQ1464.2 +032000* SQ1464.2 +032100 PRINT-DETAIL. SQ1464.2 +032200 IF REC-CT NOT EQUAL TO ZERO SQ1464.2 +032300 MOVE "." TO PARDOT-X SQ1464.2 +032400 MOVE REC-CT TO DOTVALUE. SQ1464.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. SQ1464.2 +032600 PERFORM WRITE-LINE. SQ1464.2 +032700 IF P-OR-F EQUAL TO "FAIL*" SQ1464.2 +032800 PERFORM WRITE-LINE SQ1464.2 +032900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1464.2 +033000 ELSE SQ1464.2 +033100 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1464.2 +033200 MOVE SPACE TO P-OR-F. SQ1464.2 +033300 MOVE SPACE TO COMPUTED-X. SQ1464.2 +033400 MOVE SPACE TO CORRECT-X. SQ1464.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1464.2 +033600 MOVE SPACE TO RE-MARK. SQ1464.2 +033700* SQ1464.2 +033800 HEAD-ROUTINE. SQ1464.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +034300 COLUMN-NAMES-ROUTINE. SQ1464.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +034700 END-ROUTINE. SQ1464.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1464.2 +034900 PERFORM WRITE-LINE 5 TIMES. SQ1464.2 +035000 END-RTN-EXIT. SQ1464.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1464.2 +035200 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +035300* SQ1464.2 +035400 END-ROUTINE-1. SQ1464.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1464.2 +035600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1464.2 +035700 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1464.2 +035800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1464.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1464.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1464.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1464.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1464.2 +036300 PERFORM WRITE-LINE. SQ1464.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1464.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1464.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +036700 ELSE SQ1464.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1464.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1464.2 +037000 PERFORM WRITE-LINE. SQ1464.2 +037100 END-ROUTINE-13. SQ1464.2 +037200 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1464.2 +037300 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +037400 ELSE SQ1464.2 +037500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1464.2 +037600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1464.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1464.2 +037800 PERFORM WRITE-LINE. SQ1464.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1464.2 +038000 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +038100 ELSE SQ1464.2 +038200 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1464.2 +038300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1464.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +038500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +038600* SQ1464.2 +038700 WRITE-LINE. SQ1464.2 +038800 ADD 1 TO RECORD-COUNT. SQ1464.2 +038900Y IF RECORD-COUNT GREATER 50 SQ1464.2 +039000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1464.2 +039100Y MOVE SPACE TO DUMMY-RECORD SQ1464.2 +039200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1464.2 +039300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1464.2 +039400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1464.2 +039500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1464.2 +039600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1464.2 +039700Y MOVE ZERO TO RECORD-COUNT. SQ1464.2 +039800 PERFORM WRT-LN. SQ1464.2 +039900* SQ1464.2 +040000 WRT-LN. SQ1464.2 +040100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1464.2 +040200 MOVE SPACE TO DUMMY-RECORD. SQ1464.2 +040300 BLANK-LINE-PRINT. SQ1464.2 +040400 PERFORM WRT-LN. SQ1464.2 +040500 FAIL-ROUTINE. SQ1464.2 +040600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1464.2 +040700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1464.2 +040800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1464.2 +040900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1464.2 +041000 MOVE XXINFO TO DUMMY-RECORD. SQ1464.2 +041100 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +041200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1464.2 +041300 GO TO FAIL-ROUTINE-EX. SQ1464.2 +041400 FAIL-ROUTINE-WRITE. SQ1464.2 +041500 MOVE TEST-COMPUTED TO PRINT-REC SQ1464.2 +041600 PERFORM WRITE-LINE SQ1464.2 +041700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1464.2 +041800 MOVE TEST-CORRECT TO PRINT-REC SQ1464.2 +041900 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1464.2 +042100 FAIL-ROUTINE-EX. SQ1464.2 +042200 EXIT. SQ1464.2 +042300 BAIL-OUT. SQ1464.2 +042400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1464.2 +042500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1464.2 +042600 BAIL-OUT-WRITE. SQ1464.2 +042700 MOVE CORRECT-A TO XXCORRECT. SQ1464.2 +042800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1464.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1464.2 +043000 MOVE XXINFO TO DUMMY-RECORD. SQ1464.2 +043100 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1464.2 +043300 BAIL-OUT-EX. SQ1464.2 +043400 EXIT. SQ1464.2 +043500 CCVS1-EXIT. SQ1464.2 +043600 EXIT. SQ1464.2 +043700* SQ1464.2 +043800**************************************************************** SQ1464.2 +043900* * SQ1464.2 +044000* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1464.2 +044100* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1464.2 +044200* * SQ1464.2 +044300**************************************************************** SQ1464.2 +044400* SQ1464.2 +044500 SECT-SQ146A-0001 SECTION. SQ1464.2 +044600 WRITE-INIT-GF-01. SQ1464.2 +044700* SQ1464.2 +044800* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1464.2 +044900* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1464.2 +045000* SQ1464.2 +045100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1464.2 +045200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1464.2 +045300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1464.2 +045400 MOVE 120 TO XRECORD-LENGTH (1). SQ1464.2 +045500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1464.2 +045600 MOVE 1 TO XBLOCK-SIZE (1). SQ1464.2 +045700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1464.2 +045800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1464.2 +045900 MOVE "S" TO XLABEL-TYPE (1). SQ1464.2 +046000 MOVE 1 TO XRECORD-NUMBER (1). SQ1464.2 +046100* SQ1464.2 +046200 WRITE-OPEN-01. SQ1464.2 +046300 OPEN OUTPUT SQ-FS1. SQ1464.2 +046400* SQ1464.2 +046500* WRITE A SINGLE RECORD TO THE FILE SQ1464.2 +046600* SQ1464.2 +046700 WRITE-INIT-01. SQ1464.2 +046800 WRITE-TEST-01-01. SQ1464.2 +046900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1464.2 +047000 WRITE SQ-FS1R1-F-G-120. SQ1464.2 +047100* SQ1464.2 +047200* CLOSE THE FILE. SQ1464.2 +047300* SQ1464.2 +047400 CLOSE-INIT-01. SQ1464.2 +047500 CLOSE-TEST-01. SQ1464.2 +047600 CLOSE SQ-FS1. SQ1464.2 +047700* SQ1464.2 +047800* HAVING CLOSED THE FILE, WE NOW TRY TO CLOSE IT AGAIN. SQ1464.2 +047900* THE TEST PASSES IF THE FILE CANNOT BE RECLOSED AND SQ1464.2 +048000* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ1464.2 +048100* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF THE SQ1464.2 +048200* PROGRAM ON EXECUTION OF THE CLOSE OR MAY RETURN CONTROL SQ1464.2 +048300* TO THE STATEMENT FOLLOWING THE CLOSE STATEMENT. SQ1464.2 +048400* SQ1464.2 +048500 CLOSE-INIT-02. SQ1464.2 +048600* SQ1464.2 +048700 MOVE "CLOSE A CLOSED FILE" TO FEATURE. SQ1464.2 +048800 MOVE "**" TO SQ-FS1-STATUS. SQ1464.2 +048900 MOVE 1 TO REC-CT. SQ1464.2 +049000 MOVE "CLOSE-TEST-02" TO PAR-NAME. SQ1464.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1464.2 +049200 TO DUMMY-RECORD. SQ1464.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +049400* SQ1464.2 +049500 CLOSE-TEST-02. SQ1464.2 +049600 CLOSE SQ-FS1. SQ1464.2 +049700 IF SQ-FS1-STATUS = "42" SQ1464.2 +049800 PERFORM PASS SQ1464.2 +049900 ELSE SQ1464.2 +050000 MOVE "42" TO CORRECT-A SQ1464.2 +050100 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1464.2 +050200 MOVE "STATUS OF CLOSE OF CLOSED FILE INCORRECT" SQ1464.2 +050300 TO RE-MARK SQ1464.2 +050400 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1464.2 +050500 PERFORM FAIL SQ1464.2 +050600 END-IF. SQ1464.2 +050700* SQ1464.2 +050800 CCVS-EXIT SECTION. SQ1464.2 +050900 CCVS-999999. SQ1464.2 +051000 GO TO CLOSE-FILES. SQ1464.2 +*END-OF,SQ146A +*HEADER,COBOL,SQ147A +000100 IDENTIFICATION DIVISION. SQ1474.2 +000200 PROGRAM-ID. SQ1474.2 +000300 SQ147A. SQ1474.2 +000400**************************************************************** SQ1474.2 +000500* * SQ1474.2 +000600* VALIDATION FOR:- * SQ1474.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +000800* USING CCVS85 VERSION 3.0. * SQ1474.2 +000900* * SQ1474.2 +001000* CREATION DATE / VALIDATION DATE * SQ1474.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 +001200* * SQ1474.2 +001300**************************************************************** SQ1474.2 +001400* * SQ1474.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1474.2 +001600* * SQ1474.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1474.2 +001800* X-55 SYSTEM PRINTER * SQ1474.2 +001900* X-82 SOURCE-COMPUTER * SQ1474.2 +002000* X-83 OBJECT-COMPUTER * SQ1474.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1474.2 +002200* * SQ1474.2 +002300**************************************************************** SQ1474.2 +002400* * SQ1474.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1474.2 +002600* A CLOSED FILE. THE TEST FOR CORRECT I-O STATUS CODE 47 * SQ1474.2 +002700* IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1474.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1474.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1474.2 +003000* LINE CODE. * SQ1474.2 +003100* * SQ1474.2 +003200**************************************************************** SQ1474.2 +003300* SQ1474.2 +003400 ENVIRONMENT DIVISION. SQ1474.2 +003500 CONFIGURATION SECTION. SQ1474.2 +003600 SOURCE-COMPUTER. SQ1474.2 +003700 XXXXX082. SQ1474.2 +003800 OBJECT-COMPUTER. SQ1474.2 +003900 XXXXX083. SQ1474.2 +004000* SQ1474.2 +004100 INPUT-OUTPUT SECTION. SQ1474.2 +004200 FILE-CONTROL. SQ1474.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1474.2 +004400 XXXXX055. SQ1474.2 +004500* SQ1474.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1474.2 +004700 XXXXX014 SQ1474.2 +004800 FILE STATUS SQ-FS1-STATUS. SQ1474.2 +004900* SQ1474.2 +005000* SQ1474.2 +005100 DATA DIVISION. SQ1474.2 +005200 FILE SECTION. SQ1474.2 +005300 FD PRINT-FILE SQ1474.2 +005400C LABEL RECORDS SQ1474.2 +005500C XXXXX084 SQ1474.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1474.2 +005700 . SQ1474.2 +005800 01 PRINT-REC PICTURE X(120). SQ1474.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1474.2 +006000* SQ1474.2 +006100 FD SQ-FS1 SQ1474.2 +006200C LABEL RECORD IS STANDARD SQ1474.2 +006300 . SQ1474.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1474.2 +006500* SQ1474.2 +006600 WORKING-STORAGE SECTION. SQ1474.2 +006700* SQ1474.2 +006800*************************************************************** SQ1474.2 +006900* * SQ1474.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1474.2 +007100* * SQ1474.2 +007200*************************************************************** SQ1474.2 +007300* SQ1474.2 +007400 01 SQ-FS1-STATUS. SQ1474.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1474.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1474.2 +007700* SQ1474.2 +007800* SQ1474.2 +007900*************************************************************** SQ1474.2 +008000* * SQ1474.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1474.2 +008200* * SQ1474.2 +008300*************************************************************** SQ1474.2 +008400* SQ1474.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1474.2 +008600* SQ1474.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1474.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1474.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1474.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1474.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1474.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1474.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1474.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1474.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1474.2 +009600 ",RECKEY= ". SQ1474.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1474.2 +009800 ",ALTKEY1= ". SQ1474.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1474.2 +010000 ",ALTKEY2= ". SQ1474.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1474.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1474.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1474.2 +010400 07 FILLER PIC X(5). SQ1474.2 +010500 07 XFILE-NAME PIC X(6). SQ1474.2 +010600 07 FILLER PIC X(8). SQ1474.2 +010700 07 XRECORD-NAME PIC X(6). SQ1474.2 +010800 07 FILLER PIC X(1). SQ1474.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1474.2 +011000 07 FILLER PIC X(7). SQ1474.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1474.2 +011200 07 FILLER PIC X(6). SQ1474.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1474.2 +011400 07 FILLER PIC X(5). SQ1474.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1474.2 +011600 07 FILLER PIC X(5). SQ1474.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1474.2 +011800 07 FILLER PIC X(7). SQ1474.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1474.2 +012000 07 FILLER PIC X(7). SQ1474.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1474.2 +012200 07 FILLER PIC X(1). SQ1474.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1474.2 +012400 07 FILLER PIC X(6). SQ1474.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1474.2 +012600 07 FILLER PIC X(5). SQ1474.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1474.2 +012800 07 FILLER PIC X(6). SQ1474.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1474.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1474.2 +013100 07 FILLER PIC X(8). SQ1474.2 +013200 07 XRECORD-KEY PIC X(29). SQ1474.2 +013300 07 FILLER PIC X(9). SQ1474.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1474.2 +013500 07 FILLER PIC X(9). SQ1474.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1474.2 +013700 07 FILLER PIC X(7). SQ1474.2 +013800* SQ1474.2 +013900 01 TEST-RESULTS. SQ1474.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014100 02 PAR-NAME. SQ1474.2 +014200 03 FILLER PIC X(14) VALUE SPACE. SQ1474.2 +014300 03 PARDOT-X PIC X VALUE SPACE. SQ1474.2 +014400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1474.2 +014500 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014600 02 FEATURE PIC X(24) VALUE SPACE. SQ1474.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1474.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1474.2 +015000 02 RE-MARK PIC X(61). SQ1474.2 +015100 01 TEST-COMPUTED. SQ1474.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1474.2 +015400 02 COMPUTED-X. SQ1474.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1474.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1474.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1474.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1474.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1474.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1474.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1474.2 +016200 04 FILLER PIC X. SQ1474.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1474.2 +016400 01 TEST-CORRECT. SQ1474.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1474.2 +016700 02 CORRECT-X. SQ1474.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1474.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1474.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1474.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1474.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1474.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1474.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1474.2 +017500 04 FILLER PIC X. SQ1474.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1474.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1474.2 +017800* SQ1474.2 +017900 01 CCVS-C-1. SQ1474.2 +018000 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1474.2 +018200 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1474.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1474.2 +018600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1474.2 +018700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1474.2 +018800 01 CCVS-C-2. SQ1474.2 +018900 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". SQ1474.2 +019100 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". SQ1474.2 +019300 02 FILLER PIC X(72) VALUE SPACE. SQ1474.2 +019400* SQ1474.2 +019500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1474.2 +019600 01 REC-CT PIC 99 VALUE ZERO. SQ1474.2 +019700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +019800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +019900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +020000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +020100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1474.2 +020200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1474.2 +020300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1474.2 +020400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1474.2 +020500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1474.2 +020600 01 CCVS-H-1. SQ1474.2 +020700 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 +020800 02 FILLER PIC X(42) VALUE SQ1474.2 +020900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1474.2 +021000 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 +021100 01 CCVS-H-2A. SQ1474.2 +021200 02 FILLER PIC X(40) VALUE SPACE. SQ1474.2 +021300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1474.2 +021400 02 FILLER PIC XXXX VALUE SQ1474.2 +021500 "4.2 ". SQ1474.2 +021600 02 FILLER PIC X(28) VALUE SQ1474.2 +021700 " COPY - NOT FOR DISTRIBUTION". SQ1474.2 +021800 02 FILLER PIC X(41) VALUE SPACE. SQ1474.2 +021900* SQ1474.2 +022000 01 CCVS-H-2B. SQ1474.2 +022100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1474.2 +022200 02 TEST-ID PIC X(9). SQ1474.2 +022300 02 FILLER PIC X(4) VALUE " IN ". SQ1474.2 +022400 02 FILLER PIC X(12) VALUE SQ1474.2 +022500 " HIGH ". SQ1474.2 +022600 02 FILLER PIC X(22) VALUE SQ1474.2 +022700 " LEVEL VALIDATION FOR ". SQ1474.2 +022800 02 FILLER PIC X(58) VALUE SQ1474.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +023000 01 CCVS-H-3. SQ1474.2 +023100 02 FILLER PIC X(34) VALUE SQ1474.2 +023200 " FOR OFFICIAL USE ONLY ". SQ1474.2 +023300 02 FILLER PIC X(58) VALUE SQ1474.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 +023500 02 FILLER PIC X(28) VALUE SQ1474.2 +023600 " COPYRIGHT 1985,1986 ". SQ1474.2 +023700 01 CCVS-E-1. SQ1474.2 +023800 02 FILLER PIC X(52) VALUE SPACE. SQ1474.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1474.2 +024000 02 ID-AGAIN PIC X(9). SQ1474.2 +024100 02 FILLER PIC X(45) VALUE SPACES. SQ1474.2 +024200 01 CCVS-E-2. SQ1474.2 +024300 02 FILLER PIC X(31) VALUE SPACE. SQ1474.2 +024400 02 FILLER PIC X(21) VALUE SPACE. SQ1474.2 +024500 02 CCVS-E-2-2. SQ1474.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1474.2 +024700 03 FILLER PIC X VALUE SPACE. SQ1474.2 +024800 03 ENDER-DESC PIC X(44) VALUE SQ1474.2 +024900 "ERRORS ENCOUNTERED". SQ1474.2 +025000 01 CCVS-E-3. SQ1474.2 +025100 02 FILLER PIC X(22) VALUE SQ1474.2 +025200 " FOR OFFICIAL USE ONLY". SQ1474.2 +025300 02 FILLER PIC X(12) VALUE SPACE. SQ1474.2 +025400 02 FILLER PIC X(58) VALUE SQ1474.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +025600 02 FILLER PIC X(8) VALUE SPACE. SQ1474.2 +025700 02 FILLER PIC X(20) VALUE SQ1474.2 +025800 " COPYRIGHT 1985,1986". SQ1474.2 +025900 01 CCVS-E-4. SQ1474.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1474.2 +026100 02 FILLER PIC X(4) VALUE " OF ". SQ1474.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1474.2 +026300 02 FILLER PIC X(40) VALUE SQ1474.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1474.2 +026500 01 XXINFO. SQ1474.2 +026600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1474.2 +026700 02 INFO-TEXT. SQ1474.2 +026800 04 FILLER PIC X(8) VALUE SPACE. SQ1474.2 +026900 04 XXCOMPUTED PIC X(20). SQ1474.2 +027000 04 FILLER PIC X(5) VALUE SPACE. SQ1474.2 +027100 04 XXCORRECT PIC X(20). SQ1474.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). SQ1474.2 +027300 01 HYPHEN-LINE. SQ1474.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. SQ1474.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1474.2 +027600- "*****************************************". SQ1474.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1474.2 +027800- "******************************". SQ1474.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1474.2 +028000 "SQ147A". SQ1474.2 +028100* SQ1474.2 +028200* SQ1474.2 +028300 PROCEDURE DIVISION. SQ1474.2 +028400 DECLARATIVES. SQ1474.2 +028500 SQ147A-DECLARATIVE-001-SECT SECTION. SQ1474.2 +028600 USE AFTER STANDARD ERROR PROCEDURE SQ-FS1. SQ1474.2 +028700 SQ-FS1-ERROR-PROCEDURE. SQ1474.2 +028800 IF SQ-FS1-STATUS = "47" SQ1474.2 +028900 PERFORM DECL-PASS SQ1474.2 +029000 GO TO DECL-ABNORMAL-TERM SQ1474.2 +029100 ELSE SQ1474.2 +029200 MOVE "47" TO CORRECT-A SQ1474.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1474.2 +029400 MOVE "STATUS FOR READ OF CLOSED FILE INCORRECT" SQ1474.2 +029500 TO RE-MARK SQ1474.2 +029600 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ1474.2 +029700 PERFORM DECL-FAIL SQ1474.2 +029800 GO TO DECL-ABNORMAL-TERM SQ1474.2 +029900 END-IF. SQ1474.2 +030000* SQ1474.2 +030100 DECL-PASS. SQ1474.2 +030200 MOVE "PASS " TO P-OR-F. SQ1474.2 +030300 ADD 1 TO PASS-COUNTER. SQ1474.2 +030400 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +030500* SQ1474.2 +030600 DECL-FAIL. SQ1474.2 +030700 MOVE "FAIL*" TO P-OR-F. SQ1474.2 +030800 ADD 1 TO ERROR-COUNTER. SQ1474.2 +030900 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +031000* SQ1474.2 +031100 DECL-DE-LETE. SQ1474.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 +031300 MOVE "*****" TO P-OR-F. SQ1474.2 +031400 ADD 1 TO DELETE-COUNTER. SQ1474.2 +031500 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +031600* SQ1474.2 +031700 DECL-PRINT-DETAIL. SQ1474.2 +031800 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 +031900 MOVE "." TO PARDOT-X SQ1474.2 +032000 MOVE REC-CT TO DOTVALUE. SQ1474.2 +032100 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 +032200 PERFORM DECL-WRITE-LINE. SQ1474.2 +032300 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 +032400 PERFORM DECL-WRITE-LINE SQ1474.2 +032500 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1474.2 +032600 ELSE SQ1474.2 +032700 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1474.2 +032800 MOVE SPACE TO P-OR-F. SQ1474.2 +032900 MOVE SPACE TO COMPUTED-X. SQ1474.2 +033000 MOVE SPACE TO CORRECT-X. SQ1474.2 +033100 IF REC-CT EQUAL TO ZERO SQ1474.2 +033200 MOVE SPACE TO PAR-NAME. SQ1474.2 +033300 MOVE SPACE TO RE-MARK. SQ1474.2 +033400* SQ1474.2 +033500 DECL-WRITE-LINE. SQ1474.2 +033600 ADD 1 TO RECORD-COUNT. SQ1474.2 +033700Y IF RECORD-COUNT GREATER 50 SQ1474.2 +033800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 +033900Y MOVE SPACE TO DUMMY-RECORD SQ1474.2 +034000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 +034100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1474.2 +034200Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1474.2 +034300Y PERFORM DECL-WRT-LN 2 TIMES SQ1474.2 +034400Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1474.2 +034500Y PERFORM DECL-WRT-LN SQ1474.2 +034600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 +034700Y MOVE ZERO TO RECORD-COUNT. SQ1474.2 +034800 PERFORM DECL-WRT-LN. SQ1474.2 +034900* SQ1474.2 +035000 DECL-WRT-LN. SQ1474.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 +035200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +035300* SQ1474.2 +035400 DECL-FAIL-ROUTINE. SQ1474.2 +035500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 +035600 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 +035700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +035800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 +035900 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +036000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +036200 GO TO DECL-FAIL-EX. SQ1474.2 +036300 DECL-FAIL-WRITE. SQ1474.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 +036500 PERFORM DECL-WRITE-LINE SQ1474.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 +036700 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +036900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 +037000 DECL-FAIL-EX. SQ1474.2 +037100 EXIT. SQ1474.2 +037200* SQ1474.2 +037300 DECL-BAIL. SQ1474.2 +037400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1474.2 +037500 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1474.2 +037600 DECL-BAIL-WRITE. SQ1474.2 +037700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 +037800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 +037900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +038200 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1474.2 +038300 DECL-BAIL-EX. SQ1474.2 +038400 EXIT. SQ1474.2 +038500* SQ1474.2 +038600 DECL-ABNORMAL-TERM. SQ1474.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +038800 PERFORM DECL-WRITE-LINE. SQ1474.2 +038900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1474.2 +039000 TO DUMMY-RECORD. SQ1474.2 +039100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1474.2 +039200* SQ1474.2 +039300 END-DECLS. SQ1474.2 +039400 EXIT. SQ1474.2 +039500 END DECLARATIVES. SQ1474.2 +039600* SQ1474.2 +039700* SQ1474.2 +039800 CCVS1 SECTION. SQ1474.2 +039900 OPEN-FILES. SQ1474.2 +040000 OPEN OUTPUT PRINT-FILE. SQ1474.2 +040100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1474.2 +040200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1474.2 +040300 MOVE SPACE TO TEST-RESULTS. SQ1474.2 +040400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1474.2 +040500 MOVE ZERO TO REC-SKEL-SUB. SQ1474.2 +040600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1474.2 +040700 GO TO CCVS1-EXIT. SQ1474.2 +040800* SQ1474.2 +040900 CCVS-INIT-FILE. SQ1474.2 +041000 ADD 1 TO REC-SKL-SUB. SQ1474.2 +041100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1474.2 +041200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1474.2 +041300* SQ1474.2 +041400 CLOSE-FILES. SQ1474.2 +041500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1474.2 +041600 CLOSE PRINT-FILE. SQ1474.2 +041700 TERMINATE-CCVS. SQ1474.2 +041800 STOP RUN. SQ1474.2 +041900* SQ1474.2 +042000 INSPT. SQ1474.2 +042100 MOVE "INSPT" TO P-OR-F. SQ1474.2 +042200 ADD 1 TO INSPECT-COUNTER. SQ1474.2 +042300 PERFORM PRINT-DETAIL. SQ1474.2 +042400 SQ1474.2 +042500 PASS. SQ1474.2 +042600 MOVE "PASS " TO P-OR-F. SQ1474.2 +042700 ADD 1 TO PASS-COUNTER. SQ1474.2 +042800 PERFORM PRINT-DETAIL. SQ1474.2 +042900* SQ1474.2 +043000 FAIL. SQ1474.2 +043100 MOVE "FAIL*" TO P-OR-F. SQ1474.2 +043200 ADD 1 TO ERROR-COUNTER. SQ1474.2 +043300 PERFORM PRINT-DETAIL. SQ1474.2 +043400* SQ1474.2 +043500 DE-LETE. SQ1474.2 +043600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 +043700 MOVE "*****" TO P-OR-F. SQ1474.2 +043800 ADD 1 TO DELETE-COUNTER. SQ1474.2 +043900 PERFORM PRINT-DETAIL. SQ1474.2 +044000* SQ1474.2 +044100 PRINT-DETAIL. SQ1474.2 +044200 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 +044300 MOVE "." TO PARDOT-X SQ1474.2 +044400 MOVE REC-CT TO DOTVALUE. SQ1474.2 +044500 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 +044600 PERFORM WRITE-LINE. SQ1474.2 +044700 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 +044800 PERFORM WRITE-LINE SQ1474.2 +044900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1474.2 +045000 ELSE SQ1474.2 +045100 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1474.2 +045200 MOVE SPACE TO P-OR-F. SQ1474.2 +045300 MOVE SPACE TO COMPUTED-X. SQ1474.2 +045400 MOVE SPACE TO CORRECT-X. SQ1474.2 +045500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1474.2 +045600 MOVE SPACE TO RE-MARK. SQ1474.2 +045700* SQ1474.2 +045800 HEAD-ROUTINE. SQ1474.2 +045900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 +046200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 +046300 COLUMN-NAMES-ROUTINE. SQ1474.2 +046400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +046500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +046700 END-ROUTINE. SQ1474.2 +046800 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1474.2 +046900 PERFORM WRITE-LINE 5 TIMES. SQ1474.2 +047000 END-RTN-EXIT. SQ1474.2 +047100 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1474.2 +047200 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +047300* SQ1474.2 +047400 END-ROUTINE-1. SQ1474.2 +047500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1474.2 +047600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1474.2 +047700 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1474.2 +047800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1474.2 +047900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1474.2 +048000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1474.2 +048100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1474.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1474.2 +048300 PERFORM WRITE-LINE. SQ1474.2 +048400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1474.2 +048500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1474.2 +048600 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +048700 ELSE SQ1474.2 +048800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1474.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 +049000 PERFORM WRITE-LINE. SQ1474.2 +049100 END-ROUTINE-13. SQ1474.2 +049200 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1474.2 +049300 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +049400 ELSE SQ1474.2 +049500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1474.2 +049600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1474.2 +049700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 +049800 PERFORM WRITE-LINE. SQ1474.2 +049900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1474.2 +050000 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +050100 ELSE SQ1474.2 +050200 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1474.2 +050300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1474.2 +050400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +050500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +050600* SQ1474.2 +050700 WRITE-LINE. SQ1474.2 +050800 ADD 1 TO RECORD-COUNT. SQ1474.2 +050900Y IF RECORD-COUNT GREATER 50 SQ1474.2 +051000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 +051100Y MOVE SPACE TO DUMMY-RECORD SQ1474.2 +051200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 +051300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 +051400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1474.2 +051500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 +051600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 +051700Y MOVE ZERO TO RECORD-COUNT. SQ1474.2 +051800 PERFORM WRT-LN. SQ1474.2 +051900* SQ1474.2 +052000 WRT-LN. SQ1474.2 +052100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 +052200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +052300 BLANK-LINE-PRINT. SQ1474.2 +052400 PERFORM WRT-LN. SQ1474.2 +052500 FAIL-ROUTINE. SQ1474.2 +052600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 +052700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +052900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 +053000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +053100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +053200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +053300 GO TO FAIL-ROUTINE-EX. SQ1474.2 +053400 FAIL-ROUTINE-WRITE. SQ1474.2 +053500 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 +053600 PERFORM WRITE-LINE SQ1474.2 +053700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 +053800 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 +053900 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +054000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 +054100 FAIL-ROUTINE-EX. SQ1474.2 +054200 EXIT. SQ1474.2 +054300 BAIL-OUT. SQ1474.2 +054400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1474.2 +054500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1474.2 +054600 BAIL-OUT-WRITE. SQ1474.2 +054700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 +054800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 +054900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +055000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +055100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +055200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +055300 BAIL-OUT-EX. SQ1474.2 +055400 EXIT. SQ1474.2 +055500 CCVS1-EXIT. SQ1474.2 +055600 EXIT. SQ1474.2 +055700* SQ1474.2 +055800**************************************************************** SQ1474.2 +055900* * SQ1474.2 +056000* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1474.2 +056100* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1474.2 +056200* * SQ1474.2 +056300**************************************************************** SQ1474.2 +056400* SQ1474.2 +056500 SECT-SQ147A-0001 SECTION. SQ1474.2 +056600 WRITE-INIT-FG-01. SQ1474.2 +056700* SQ1474.2 +056800* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1474.2 +056900* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1474.2 +057000* SQ1474.2 +057100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1474.2 +057200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1474.2 +057300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1474.2 +057400 MOVE 120 TO XRECORD-LENGTH (1). SQ1474.2 +057500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1474.2 +057600 MOVE 1 TO XBLOCK-SIZE (1). SQ1474.2 +057700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1474.2 +057800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1474.2 +057900 MOVE "S" TO XLABEL-TYPE (1). SQ1474.2 +058000 MOVE 1 TO XRECORD-NUMBER (1). SQ1474.2 +058100* SQ1474.2 +058200 WRITE-OPEN-01. SQ1474.2 +058300 OPEN OUTPUT SQ-FS1. SQ1474.2 +058400* SQ1474.2 +058500* WRITE A SINGLE RECORD TO THE FILE SQ1474.2 +058600* SQ1474.2 +058700 WRITE-INIT-01. SQ1474.2 +058800 WRITE-TEST-01-01. SQ1474.2 +058900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1474.2 +059000 WRITE SQ-FS1R1-F-G-120. SQ1474.2 +059100* SQ1474.2 +059200* CLOSE THE FILE. SQ1474.2 +059300* SQ1474.2 +059400 CLOSE-INIT-01. SQ1474.2 +059500 CLOSE-TEST-01. SQ1474.2 +059600 CLOSE SQ-FS1. SQ1474.2 +059700* SQ1474.2 +059800 READ-INIT-01. SQ1474.2 +059900* SQ1474.2 +060000* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE SQ1474.2 +060100* CLOSED FILE. I-O STATUS 47 SHOULD BE GENERATED. SQ1474.2 +060200* SQ1474.2 +060300 MOVE "READ CLOSED FILE" TO FEATURE. SQ1474.2 +060400 MOVE "**" TO SQ-FS1-STATUS. SQ1474.2 +060500 MOVE "READ-TEST-01" TO PAR-NAME. SQ1474.2 +060600 MOVE 1 TO REC-CT. SQ1474.2 +060700* SQ1474.2 +060800 READ-TEST-01. SQ1474.2 +060900 READ SQ-FS1. SQ1474.2 +061000* SQ1474.2 +061100 CCVS-EXIT SECTION. SQ1474.2 +061200 CCVS-999999. SQ1474.2 +061300 GO TO CLOSE-FILES. SQ1474.2 +*END-OF,SQ147A +*HEADER,COBOL,SQ148A +000100 IDENTIFICATION DIVISION. SQ1484.2 +000200 PROGRAM-ID. SQ1484.2 +000300 SQ148A. SQ1484.2 +000400**************************************************************** SQ1484.2 +000500* * SQ1484.2 +000600* VALIDATION FOR:- * SQ1484.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +000800* USING CCVS85 VERSION 3.0. * SQ1484.2 +000900* * SQ1484.2 +001000* CREATION DATE / VALIDATION DATE * SQ1484.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1484.2 +001200* * SQ1484.2 +001300**************************************************************** SQ1484.2 +001400* * SQ1484.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1484.2 +001600* * SQ1484.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1484.2 +001800* X-55 SYSTEM PRINTER * SQ1484.2 +001900* X-82 SOURCE-COMPUTER * SQ1484.2 +002000* X-83 OBJECT-COMPUTER * SQ1484.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1484.2 +002200* * SQ1484.2 +002300**************************************************************** SQ1484.2 +002400* * SQ1484.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1484.2 +002600* A FILE OPEN IN THE OUTPUT MODE. THE TEST FOR CORRECT * SQ1484.2 +002700* I-O STATUS CODE 47 IS IN THE DECLARATIVES. AN ABNORMAL * SQ1484.2 +002800* TERMINATION IS POSSIBLE AFTER THE TEST OF THE I-O STATUS * SQ1484.2 +002900* CODE IS ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO * SQ1484.2 +003000* THE MAIN LINE CODE. * SQ1484.2 +003100* * SQ1484.2 +003200**************************************************************** SQ1484.2 +003300* SQ1484.2 +003400 ENVIRONMENT DIVISION. SQ1484.2 +003500 CONFIGURATION SECTION. SQ1484.2 +003600 SOURCE-COMPUTER. SQ1484.2 +003700 XXXXX082. SQ1484.2 +003800 OBJECT-COMPUTER. SQ1484.2 +003900 XXXXX083. SQ1484.2 +004000* SQ1484.2 +004100 INPUT-OUTPUT SECTION. SQ1484.2 +004200 FILE-CONTROL. SQ1484.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1484.2 +004400 XXXXX055. SQ1484.2 +004500* SQ1484.2 +004600 SELECT SQ-FS4 SQ1484.2 +004700 ASSIGN SQ1484.2 +004800 XXXXX014 SQ1484.2 +004900 FILE STATUS SQ-FS4-STATUS SQ1484.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1484.2 +005100 . SQ1484.2 +005200* SQ1484.2 +005300* SQ1484.2 +005400 DATA DIVISION. SQ1484.2 +005500 FILE SECTION. SQ1484.2 +005600 FD PRINT-FILE SQ1484.2 +005700C LABEL RECORDS SQ1484.2 +005800C XXXXX084 SQ1484.2 +005900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1484.2 +006000 . SQ1484.2 +006100 01 PRINT-REC PICTURE X(120). SQ1484.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ1484.2 +006300* SQ1484.2 +006400 FD SQ-FS4 SQ1484.2 +006500C LABEL RECORD IS STANDARD SQ1484.2 +006600 BLOCK CONTAINS 120 CHARACTERS SQ1484.2 +006700 RECORD CONTAINS 120 CHARACTERS SQ1484.2 +006800 . SQ1484.2 +006900 01 SQ-FS4R1-F-G-120. SQ1484.2 +007000 05 FFILE-RECORD-INFO-P1-120. SQ1484.2 +007100 07 FILLER PIC X(5). SQ1484.2 +007200 07 FFILE-NAME PIC X(6). SQ1484.2 +007300 07 FILLER PIC X(8). SQ1484.2 +007400 07 FRECORD-NAME PIC X(6). SQ1484.2 +007500 07 FILLER PIC X(1). SQ1484.2 +007600 07 FREELUNIT-NUMBER PIC 9(1). SQ1484.2 +007700 07 FILLER PIC X(7). SQ1484.2 +007800 07 FRECORD-NUMBER PIC 9(6). SQ1484.2 +007900 07 FILLER PIC X(6). SQ1484.2 +008000 07 FUPDATE-NUMBER PIC 9(2). SQ1484.2 +008100 07 FILLER PIC X(5). SQ1484.2 +008200 07 FODO-NUMBER PIC 9(4). SQ1484.2 +008300 07 FILLER PIC X(5). SQ1484.2 +008400 07 FPROGRAM-NAME PIC X(5). SQ1484.2 +008500 07 FILLER PIC X(7). SQ1484.2 +008600 07 FRECORD-LENGTH PIC 9(6). SQ1484.2 +008700 07 FILLER PIC X(7). SQ1484.2 +008800 07 FCHARS-OR-RECORDS PIC X(2). SQ1484.2 +008900 07 FILLER PIC X(1). SQ1484.2 +009000 07 FBLOCK-SIZE PIC 9(4). SQ1484.2 +009100 07 FILLER PIC X(6). SQ1484.2 +009200 07 FRECORDS-IN-FILE PIC 9(6). SQ1484.2 +009300 07 FILLER PIC X(5). SQ1484.2 +009400 07 FFILE-ORGANIZATION PIC X(2). SQ1484.2 +009500 07 FILLER PIC X(6). SQ1484.2 +009600 07 FLABEL-TYPE PIC X(1). SQ1484.2 +009700* SQ1484.2 +009800 WORKING-STORAGE SECTION. SQ1484.2 +009900* SQ1484.2 +010000*************************************************************** SQ1484.2 +010100* * SQ1484.2 +010200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1484.2 +010300* * SQ1484.2 +010400*************************************************************** SQ1484.2 +010500* SQ1484.2 +010600 01 STATUS-GROUP. SQ1484.2 +010700 04 SQ-FS4-STATUS. SQ1484.2 +010800 07 SQ-FS4-KEY-1 PIC X. SQ1484.2 +010900 07 SQ-FS4-KEY-2 PIC X. SQ1484.2 +011000* SQ1484.2 +011100*************************************************************** SQ1484.2 +011200* * SQ1484.2 +011300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1484.2 +011400* * SQ1484.2 +011500*************************************************************** SQ1484.2 +011600* SQ1484.2 +011700 01 REC-SKEL-SUB PIC 99. SQ1484.2 +011800* SQ1484.2 +011900 01 FILE-RECORD-INFORMATION-REC. SQ1484.2 +012000 03 FILE-RECORD-INFO-SKELETON. SQ1484.2 +012100 05 FILLER PICTURE X(48) VALUE SQ1484.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1484.2 +012300 05 FILLER PICTURE X(46) VALUE SQ1484.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1484.2 +012500 05 FILLER PICTURE X(26) VALUE SQ1484.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". SQ1484.2 +012700 05 FILLER PICTURE X(37) VALUE SQ1484.2 +012800 ",RECKEY= ". SQ1484.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1484.2 +013000 ",ALTKEY1= ". SQ1484.2 +013100 05 FILLER PICTURE X(38) VALUE SQ1484.2 +013200 ",ALTKEY2= ". SQ1484.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1484.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1484.2 +013500 05 FILE-RECORD-INFO-P1-120. SQ1484.2 +013600 07 FILLER PIC X(5). SQ1484.2 +013700 07 XFILE-NAME PIC X(6). SQ1484.2 +013800 07 FILLER PIC X(8). SQ1484.2 +013900 07 XRECORD-NAME PIC X(6). SQ1484.2 +014000 07 FILLER PIC X(1). SQ1484.2 +014100 07 REELUNIT-NUMBER PIC 9(1). SQ1484.2 +014200 07 FILLER PIC X(7). SQ1484.2 +014300 07 XRECORD-NUMBER PIC 9(6). SQ1484.2 +014400 07 FILLER PIC X(6). SQ1484.2 +014500 07 UPDATE-NUMBER PIC 9(2). SQ1484.2 +014600 07 FILLER PIC X(5). SQ1484.2 +014700 07 ODO-NUMBER PIC 9(4). SQ1484.2 +014800 07 FILLER PIC X(5). SQ1484.2 +014900 07 XPROGRAM-NAME PIC X(5). SQ1484.2 +015000 07 FILLER PIC X(7). SQ1484.2 +015100 07 XRECORD-LENGTH PIC 9(6). SQ1484.2 +015200 07 FILLER PIC X(7). SQ1484.2 +015300 07 CHARS-OR-RECORDS PIC X(2). SQ1484.2 +015400 07 FILLER PIC X(1). SQ1484.2 +015500 07 XBLOCK-SIZE PIC 9(4). SQ1484.2 +015600 07 FILLER PIC X(6). SQ1484.2 +015700 07 RECORDS-IN-FILE PIC 9(6). SQ1484.2 +015800 07 FILLER PIC X(5). SQ1484.2 +015900 07 XFILE-ORGANIZATION PIC X(2). SQ1484.2 +016000 07 FILLER PIC X(6). SQ1484.2 +016100 07 XLABEL-TYPE PIC X(1). SQ1484.2 +016200 05 FILE-RECORD-INFO-P121-240. SQ1484.2 +016300 07 FILLER PIC X(8). SQ1484.2 +016400 07 XRECORD-KEY PIC X(29). SQ1484.2 +016500 07 FILLER PIC X(9). SQ1484.2 +016600 07 ALTERNATE-KEY1 PIC X(29). SQ1484.2 +016700 07 FILLER PIC X(9). SQ1484.2 +016800 07 ALTERNATE-KEY2 PIC X(29). SQ1484.2 +016900 07 FILLER PIC X(7). SQ1484.2 +017000* SQ1484.2 +017100 01 TEST-RESULTS. SQ1484.2 +017200 02 FILLER PIC X VALUE SPACE. SQ1484.2 +017300 02 PAR-NAME. SQ1484.2 +017400 03 FILLER PIC X(14) VALUE SPACE. SQ1484.2 +017500 03 PARDOT-X PIC X VALUE SPACE. SQ1484.2 +017600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1484.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1484.2 +017800 02 FEATURE PIC X(24) VALUE SPACE. SQ1484.2 +017900 02 FILLER PIC X VALUE SPACE. SQ1484.2 +018000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1484.2 +018100 02 FILLER PIC X(9) VALUE SPACE. SQ1484.2 +018200 02 RE-MARK PIC X(61). SQ1484.2 +018300 01 TEST-COMPUTED. SQ1484.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ1484.2 +018500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1484.2 +018600 02 COMPUTED-X. SQ1484.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1484.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1484.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1484.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1484.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1484.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1484.2 +019300 04 COMPUTED-18V0 PIC -9(18). SQ1484.2 +019400 04 FILLER PIC X. SQ1484.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ1484.2 +019600 01 TEST-CORRECT. SQ1484.2 +019700 02 FILLER PIC X(30) VALUE SPACE. SQ1484.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1484.2 +019900 02 CORRECT-X. SQ1484.2 +020000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1484.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1484.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1484.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1484.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1484.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. SQ1484.2 +020600 04 CORRECT-18V0 PIC -9(18). SQ1484.2 +020700 04 FILLER PIC X. SQ1484.2 +020800 03 FILLER PIC X(2) VALUE SPACE. SQ1484.2 +020900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1484.2 +021000* SQ1484.2 +021100 01 CCVS-C-1. SQ1484.2 +021200 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021300 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1484.2 +021400 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021500 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1484.2 +021600 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021700 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1484.2 +021800 02 FILLER PIC IS X(9) VALUE SPACE. SQ1484.2 +021900 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1484.2 +022000 01 CCVS-C-2. SQ1484.2 +022100 02 FILLER PIC X(19) VALUE SPACE. SQ1484.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". SQ1484.2 +022300 02 FILLER PIC X(19) VALUE SPACE. SQ1484.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". SQ1484.2 +022500 02 FILLER PIC X(72) VALUE SPACE. SQ1484.2 +022600* SQ1484.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1484.2 +022800 01 REC-CT PIC 99 VALUE ZERO. SQ1484.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1484.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1484.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1484.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1484.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1484.2 +023800 01 CCVS-H-1. SQ1484.2 +023900 02 FILLER PIC X(39) VALUE SPACES. SQ1484.2 +024000 02 FILLER PIC X(42) VALUE SQ1484.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1484.2 +024200 02 FILLER PIC X(39) VALUE SPACES. SQ1484.2 +024300 01 CCVS-H-2A. SQ1484.2 +024400 02 FILLER PIC X(40) VALUE SPACE. SQ1484.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1484.2 +024600 02 FILLER PIC XXXX VALUE SQ1484.2 +024700 "4.2 ". SQ1484.2 +024800 02 FILLER PIC X(28) VALUE SQ1484.2 +024900 " COPY - NOT FOR DISTRIBUTION". SQ1484.2 +025000 02 FILLER PIC X(41) VALUE SPACE. SQ1484.2 +025100* SQ1484.2 +025200 01 CCVS-H-2B. SQ1484.2 +025300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1484.2 +025400 02 TEST-ID PIC X(9). SQ1484.2 +025500 02 FILLER PIC X(4) VALUE " IN ". SQ1484.2 +025600 02 FILLER PIC X(12) VALUE SQ1484.2 +025700 " HIGH ". SQ1484.2 +025800 02 FILLER PIC X(22) VALUE SQ1484.2 +025900 " LEVEL VALIDATION FOR ". SQ1484.2 +026000 02 FILLER PIC X(58) VALUE SQ1484.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +026200 01 CCVS-H-3. SQ1484.2 +026300 02 FILLER PIC X(34) VALUE SQ1484.2 +026400 " FOR OFFICIAL USE ONLY ". SQ1484.2 +026500 02 FILLER PIC X(58) VALUE SQ1484.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1484.2 +026700 02 FILLER PIC X(28) VALUE SQ1484.2 +026800 " COPYRIGHT 1985,1986 ". SQ1484.2 +026900 01 CCVS-E-1. SQ1484.2 +027000 02 FILLER PIC X(52) VALUE SPACE. SQ1484.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1484.2 +027200 02 ID-AGAIN PIC X(9). SQ1484.2 +027300 02 FILLER PIC X(45) VALUE SPACES. SQ1484.2 +027400 01 CCVS-E-2. SQ1484.2 +027500 02 FILLER PIC X(31) VALUE SPACE. SQ1484.2 +027600 02 FILLER PIC X(21) VALUE SPACE. SQ1484.2 +027700 02 CCVS-E-2-2. SQ1484.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1484.2 +027900 03 FILLER PIC X VALUE SPACE. SQ1484.2 +028000 03 ENDER-DESC PIC X(44) VALUE SQ1484.2 +028100 "ERRORS ENCOUNTERED". SQ1484.2 +028200 01 CCVS-E-3. SQ1484.2 +028300 02 FILLER PIC X(22) VALUE SQ1484.2 +028400 " FOR OFFICIAL USE ONLY". SQ1484.2 +028500 02 FILLER PIC X(12) VALUE SPACE. SQ1484.2 +028600 02 FILLER PIC X(58) VALUE SQ1484.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +028800 02 FILLER PIC X(8) VALUE SPACE. SQ1484.2 +028900 02 FILLER PIC X(20) VALUE SQ1484.2 +029000 " COPYRIGHT 1985,1986". SQ1484.2 +029100 01 CCVS-E-4. SQ1484.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1484.2 +029300 02 FILLER PIC X(4) VALUE " OF ". SQ1484.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1484.2 +029500 02 FILLER PIC X(40) VALUE SQ1484.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1484.2 +029700 01 XXINFO. SQ1484.2 +029800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1484.2 +029900 02 INFO-TEXT. SQ1484.2 +030000 04 FILLER PIC X(8) VALUE SPACE. SQ1484.2 +030100 04 XXCOMPUTED PIC X(20). SQ1484.2 +030200 04 FILLER PIC X(5) VALUE SPACE. SQ1484.2 +030300 04 XXCORRECT PIC X(20). SQ1484.2 +030400 02 INF-ANSI-REFERENCE PIC X(48). SQ1484.2 +030500 01 HYPHEN-LINE. SQ1484.2 +030600 02 FILLER PIC IS X VALUE IS SPACE. SQ1484.2 +030700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1484.2 +030800- "*****************************************". SQ1484.2 +030900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1484.2 +031000- "******************************". SQ1484.2 +031100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1484.2 +031200 "SQ148A". SQ1484.2 +031300* SQ1484.2 +031400* SQ1484.2 +031500 PROCEDURE DIVISION. SQ1484.2 +031600 DECLARATIVES. SQ1484.2 +031700* SQ1484.2 +031800 SQ148A-DECLARATIVE-001-SECT SECTION. SQ1484.2 +031900 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1484.2 +032000 READ-ERROR-PROCESS. SQ1484.2 +032100 IF SQ-FS4-STATUS = "47" SQ1484.2 +032200 PERFORM DECL-PASS SQ1484.2 +032300 GO TO DECL-ABNORMAL-TERM SQ1484.2 +032400 ELSE SQ1484.2 +032500 MOVE "47" TO CORRECT-A SQ1484.2 +032600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1484.2 +032700 MOVE "STATUS FOR READ OF FILE OPEN OUTPUT INCORRECT" SQ1484.2 +032800 TO RE-MARK SQ1484.2 +032900 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ1484.2 +033000 PERFORM DECL-FAIL SQ1484.2 +033100 GO TO DECL-ABNORMAL-TERM SQ1484.2 +033200 END-IF. SQ1484.2 +033300* SQ1484.2 +033400 DECL-PASS. SQ1484.2 +033500 MOVE "PASS " TO P-OR-F. SQ1484.2 +033600 ADD 1 TO PASS-COUNTER. SQ1484.2 +033700 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +033800* SQ1484.2 +033900 DECL-FAIL. SQ1484.2 +034000 MOVE "FAIL*" TO P-OR-F. SQ1484.2 +034100 ADD 1 TO ERROR-COUNTER. SQ1484.2 +034200 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +034300* SQ1484.2 +034400 DECL-DE-LETE. SQ1484.2 +034500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1484.2 +034600 MOVE "*****" TO P-OR-F. SQ1484.2 +034700 ADD 1 TO DELETE-COUNTER. SQ1484.2 +034800 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +034900* SQ1484.2 +035000 DECL-PRINT-DETAIL. SQ1484.2 +035100 IF REC-CT NOT EQUAL TO ZERO SQ1484.2 +035200 MOVE "." TO PARDOT-X SQ1484.2 +035300 MOVE REC-CT TO DOTVALUE. SQ1484.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. SQ1484.2 +035500 PERFORM DECL-WRITE-LINE. SQ1484.2 +035600 IF P-OR-F EQUAL TO "FAIL*" SQ1484.2 +035700 PERFORM DECL-WRITE-LINE SQ1484.2 +035800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1484.2 +035900 ELSE SQ1484.2 +036000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1484.2 +036100 MOVE SPACE TO P-OR-F. SQ1484.2 +036200 MOVE SPACE TO COMPUTED-X. SQ1484.2 +036300 MOVE SPACE TO CORRECT-X. SQ1484.2 +036400 IF REC-CT EQUAL TO ZERO SQ1484.2 +036500 MOVE SPACE TO PAR-NAME. SQ1484.2 +036600 MOVE SPACE TO RE-MARK. SQ1484.2 +036700* SQ1484.2 +036800 DECL-WRITE-LINE. SQ1484.2 +036900 ADD 1 TO RECORD-COUNT. SQ1484.2 +037000Y IF RECORD-COUNT GREATER 50 SQ1484.2 +037100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1484.2 +037200Y MOVE SPACE TO DUMMY-RECORD SQ1484.2 +037300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1484.2 +037400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1484.2 +037500Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1484.2 +037600Y PERFORM DECL-WRT-LN 2 TIMES SQ1484.2 +037700Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1484.2 +037800Y PERFORM DECL-WRT-LN SQ1484.2 +037900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1484.2 +038000Y MOVE ZERO TO RECORD-COUNT. SQ1484.2 +038100 PERFORM DECL-WRT-LN. SQ1484.2 +038200* SQ1484.2 +038300 DECL-WRT-LN. SQ1484.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1484.2 +038500 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +038600* SQ1484.2 +038700 DECL-FAIL-ROUTINE. SQ1484.2 +038800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1484.2 +038900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1484.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +039100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1484.2 +039200 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +039300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +039400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +039500 GO TO DECL-FAIL-EX. SQ1484.2 +039600 DECL-FAIL-WRITE. SQ1484.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC SQ1484.2 +039800 PERFORM DECL-WRITE-LINE SQ1484.2 +039900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1484.2 +040000 MOVE TEST-CORRECT TO PRINT-REC SQ1484.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +040200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1484.2 +040300 DECL-FAIL-EX. SQ1484.2 +040400 EXIT. SQ1484.2 +040500* SQ1484.2 +040600 DECL-BAIL. SQ1484.2 +040700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1484.2 +040800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1484.2 +040900 DECL-BAIL-WRITE. SQ1484.2 +041000 MOVE CORRECT-A TO XXCORRECT. SQ1484.2 +041100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1484.2 +041200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +041300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +041400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +041500 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1484.2 +041600 DECL-BAIL-EX. SQ1484.2 +041700 EXIT. SQ1484.2 +041800* SQ1484.2 +041900 DECL-ABNORMAL-TERM. SQ1484.2 +042000 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +042100 PERFORM DECL-WRITE-LINE. SQ1484.2 +042200 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1484.2 +042300 TO DUMMY-RECORD. SQ1484.2 +042400 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1484.2 +042500* SQ1484.2 +042600 END-DECLS. SQ1484.2 +042700 EXIT. SQ1484.2 +042800 END DECLARATIVES. SQ1484.2 +042900* SQ1484.2 +043000* SQ1484.2 +043100 CCVS1 SECTION. SQ1484.2 +043200 OPEN-FILES. SQ1484.2 +043300 OPEN OUTPUT PRINT-FILE. SQ1484.2 +043400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1484.2 +043500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1484.2 +043600 MOVE SPACE TO TEST-RESULTS. SQ1484.2 +043700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1484.2 +043800 MOVE ZERO TO REC-SKEL-SUB. SQ1484.2 +043900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1484.2 +044000 GO TO CCVS1-EXIT. SQ1484.2 +044100* SQ1484.2 +044200 CCVS-INIT-FILE. SQ1484.2 +044300 ADD 1 TO REC-SKL-SUB. SQ1484.2 +044400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1484.2 +044500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1484.2 +044600* SQ1484.2 +044700 CLOSE-FILES. SQ1484.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1484.2 +044900 CLOSE PRINT-FILE. SQ1484.2 +045000 TERMINATE-CCVS. SQ1484.2 +045100 STOP RUN. SQ1484.2 +045200* SQ1484.2 +045300 INSPT. SQ1484.2 +045400 MOVE "INSPT" TO P-OR-F. SQ1484.2 +045500 ADD 1 TO INSPECT-COUNTER. SQ1484.2 +045600 PERFORM PRINT-DETAIL. SQ1484.2 +045700* SQ1484.2 +045800 PASS. SQ1484.2 +045900 MOVE "PASS " TO P-OR-F. SQ1484.2 +046000 ADD 1 TO PASS-COUNTER. SQ1484.2 +046100 PERFORM PRINT-DETAIL. SQ1484.2 +046200* SQ1484.2 +046300 FAIL. SQ1484.2 +046400 MOVE "FAIL*" TO P-OR-F. SQ1484.2 +046500 ADD 1 TO ERROR-COUNTER. SQ1484.2 +046600 PERFORM PRINT-DETAIL. SQ1484.2 +046700* SQ1484.2 +046800 DE-LETE. SQ1484.2 +046900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1484.2 +047000 MOVE "*****" TO P-OR-F. SQ1484.2 +047100 ADD 1 TO DELETE-COUNTER. SQ1484.2 +047200 PERFORM PRINT-DETAIL. SQ1484.2 +047300* SQ1484.2 +047400 PRINT-DETAIL. SQ1484.2 +047500 IF REC-CT NOT EQUAL TO ZERO SQ1484.2 +047600 MOVE "." TO PARDOT-X SQ1484.2 +047700 MOVE REC-CT TO DOTVALUE. SQ1484.2 +047800 MOVE TEST-RESULTS TO PRINT-REC. SQ1484.2 +047900 PERFORM WRITE-LINE. SQ1484.2 +048000 IF P-OR-F EQUAL TO "FAIL*" SQ1484.2 +048100 PERFORM WRITE-LINE SQ1484.2 +048200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1484.2 +048300 ELSE SQ1484.2 +048400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1484.2 +048500 MOVE SPACE TO P-OR-F. SQ1484.2 +048600 MOVE SPACE TO COMPUTED-X. SQ1484.2 +048700 MOVE SPACE TO CORRECT-X. SQ1484.2 +048800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1484.2 +048900 MOVE SPACE TO RE-MARK. SQ1484.2 +049000* SQ1484.2 +049100 HEAD-ROUTINE. SQ1484.2 +049200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1484.2 +049500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1484.2 +049600 COLUMN-NAMES-ROUTINE. SQ1484.2 +049700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +049800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +050000 END-ROUTINE. SQ1484.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1484.2 +050200 PERFORM WRITE-LINE 5 TIMES. SQ1484.2 +050300 END-RTN-EXIT. SQ1484.2 +050400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1484.2 +050500 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +050600* SQ1484.2 +050700 END-ROUTINE-1. SQ1484.2 +050800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1484.2 +050900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1484.2 +051000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1484.2 +051100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1484.2 +051200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1484.2 +051300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1484.2 +051400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1484.2 +051500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1484.2 +051600 PERFORM WRITE-LINE. SQ1484.2 +051700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1484.2 +051800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1484.2 +051900 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +052000 ELSE SQ1484.2 +052100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1484.2 +052200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1484.2 +052300 PERFORM WRITE-LINE. SQ1484.2 +052400 END-ROUTINE-13. SQ1484.2 +052500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1484.2 +052600 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +052700 ELSE SQ1484.2 +052800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1484.2 +052900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1484.2 +053000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1484.2 +053100 PERFORM WRITE-LINE. SQ1484.2 +053200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1484.2 +053300 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +053400 ELSE SQ1484.2 +053500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1484.2 +053600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1484.2 +053700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +053800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +053900* SQ1484.2 +054000 WRITE-LINE. SQ1484.2 +054100 ADD 1 TO RECORD-COUNT. SQ1484.2 +054200Y IF RECORD-COUNT GREATER 50 SQ1484.2 +054300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1484.2 +054400Y MOVE SPACE TO DUMMY-RECORD SQ1484.2 +054500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1484.2 +054600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1484.2 +054700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1484.2 +054800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1484.2 +054900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1484.2 +055000Y MOVE ZERO TO RECORD-COUNT. SQ1484.2 +055100 PERFORM WRT-LN. SQ1484.2 +055200* SQ1484.2 +055300 WRT-LN. SQ1484.2 +055400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1484.2 +055500 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +055600 BLANK-LINE-PRINT. SQ1484.2 +055700 PERFORM WRT-LN. SQ1484.2 +055800 FAIL-ROUTINE. SQ1484.2 +055900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1484.2 +056000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1484.2 +056100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +056200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1484.2 +056300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +056400 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +056500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +056600 GO TO FAIL-ROUTINE-EX. SQ1484.2 +056700 FAIL-ROUTINE-WRITE. SQ1484.2 +056800 MOVE TEST-COMPUTED TO PRINT-REC SQ1484.2 +056900 PERFORM WRITE-LINE SQ1484.2 +057000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1484.2 +057100 MOVE TEST-CORRECT TO PRINT-REC SQ1484.2 +057200 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +057300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1484.2 +057400 FAIL-ROUTINE-EX. SQ1484.2 +057500 EXIT. SQ1484.2 +057600 BAIL-OUT. SQ1484.2 +057700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1484.2 +057800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1484.2 +057900 BAIL-OUT-WRITE. SQ1484.2 +058000 MOVE CORRECT-A TO XXCORRECT. SQ1484.2 +058100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1484.2 +058200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +058300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +058400 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +058500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +058600 BAIL-OUT-EX. SQ1484.2 +058700 EXIT. SQ1484.2 +058800 CCVS1-EXIT. SQ1484.2 +058900 EXIT. SQ1484.2 +059000* SQ1484.2 +059100**************************************************************** SQ1484.2 +059200* * SQ1484.2 +059300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1484.2 +059400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1484.2 +059500* * SQ1484.2 +059600**************************************************************** SQ1484.2 +059700* SQ1484.2 +059800 SECT-SQ148A-0002 SECTION. SQ1484.2 +059900 STA-INIT. SQ1484.2 +060000* SQ1484.2 +060100 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1484.2 +060200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1484.2 +060300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1484.2 +060400 MOVE 120 TO XRECORD-LENGTH (1). SQ1484.2 +060500 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1484.2 +060600 MOVE 1 TO XBLOCK-SIZE (1). SQ1484.2 +060700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1484.2 +060800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1484.2 +060900 MOVE "S" TO XLABEL-TYPE (1). SQ1484.2 +061000* SQ1484.2 +061100* OPEN THE FILE IN THE OUTPUT MODE SQ1484.2 +061200* SQ1484.2 +061300 SEQ-INIT-01. SQ1484.2 +061400 MOVE 1 TO REC-CT. SQ1484.2 +061500 MOVE "**" TO SQ-FS4-STATUS. SQ1484.2 +061600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1484.2 +061700 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1484.2 +061800 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1484.2 +061900 SEQ-TEST-OP-01. SQ1484.2 +062000 OPEN OUTPUT SQ-FS4. SQ1484.2 +062100* SQ1484.2 +062200* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1484.2 +062300* SQ1484.2 +062400 SEQ-TEST-OP-01-01. SQ1484.2 +062500 IF SQ-FS4-STATUS = "00" SQ1484.2 +062600 PERFORM PASS SQ1484.2 +062700 ELSE SQ1484.2 +062800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1484.2 +062900 MOVE "00" TO CORRECT-A SQ1484.2 +063000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1484.2 +063100 TO RE-MARK SQ1484.2 +063200 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1484.2 +063300 PERFORM FAIL. SQ1484.2 +063400 SEQ-TEST-01-01-END. SQ1484.2 +063500* SQ1484.2 +063600* SQ1484.2 +063700* A NEW FILE IS OPEN. WE NOW ATTEMPT TO READ A RECORD. SQ1484.2 +063800* SQ1484.2 +063900 SEQ-INIT-02. SQ1484.2 +064000 MOVE 1 TO REC-CT. SQ1484.2 +064100 MOVE "**" TO SQ-FS4-STATUS. SQ1484.2 +064200 MOVE "READ IN OUTPUT MODE" TO FEATURE. SQ1484.2 +064300 MOVE "SEQ-TEST-RD-02" TO PAR-NAME. SQ1484.2 +064400 SEQ-TEST-RD-02. SQ1484.2 +064500 READ SQ-FS4. SQ1484.2 +064600* SQ1484.2 +064700 CLOSE-TEST-03. SQ1484.2 +064800 CLOSE SQ-FS4. SQ1484.2 +064900* SQ1484.2 +065000 CCVS-EXIT SECTION. SQ1484.2 +065100 CCVS-999999. SQ1484.2 +065200 GO TO CLOSE-FILES. SQ1484.2 +*END-OF,SQ148A +*HEADER,COBOL,SQ149A +000100 IDENTIFICATION DIVISION. SQ1494.2 +000200 PROGRAM-ID. SQ1494.2 +000300 SQ149A. SQ1494.2 +000400**************************************************************** SQ1494.2 +000500* * SQ1494.2 +000600* VALIDATION FOR:- * SQ1494.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +000800* USING CCVS85 VERSION 3.0. * SQ1494.2 +000900* * SQ1494.2 +001000* CREATION DATE / VALIDATION DATE * SQ1494.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1494.2 +001200* * SQ1494.2 +001300**************************************************************** SQ1494.2 +001400* * SQ1494.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1494.2 +001600* * SQ1494.2 +001700* X-01 SEQUENTIAL TAPE * SQ1494.2 +001800* X-55 SYSTEM PRINTER * SQ1494.2 +001900* X-82 SOURCE-COMPUTER * SQ1494.2 +002000* X-83 OBJECT-COMPUTER. * SQ1494.2 +002100* X-84 LABEL RECORDS OPTION * SQ1494.2 +002200* * SQ1494.2 +002300**************************************************************** SQ1494.2 +002400* * SQ1494.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1494.2 +002600* A FILE THAT IS NOT OPEN (NOT OPEN IN THE INPUT OR I-O * SQ1494.2 +002700* MODE). THE TEST FOR CORRECT I-O STATUS CODE 47 IS IN THE * SQ1494.2 +002800* MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ1494.2 +002900* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ1494.2 +003000* ACCOMPLISHED. * SQ1494.2 +003100* * SQ1494.2 +003200**************************************************************** SQ1494.2 +003300* SQ1494.2 +003400 ENVIRONMENT DIVISION. SQ1494.2 +003500 CONFIGURATION SECTION. SQ1494.2 +003600 SOURCE-COMPUTER. SQ1494.2 +003700 XXXXX082. SQ1494.2 +003800 OBJECT-COMPUTER. SQ1494.2 +003900 XXXXX083. SQ1494.2 +004000* SQ1494.2 +004100 INPUT-OUTPUT SECTION. SQ1494.2 +004200 FILE-CONTROL. SQ1494.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1494.2 +004400 XXXXX055. SQ1494.2 +004500* SQ1494.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1494.2 +004700 XXXXX001 SQ1494.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1494.2 +004900* SQ1494.2 +005000* SQ1494.2 +005100 DATA DIVISION. SQ1494.2 +005200 FILE SECTION. SQ1494.2 +005300 FD PRINT-FILE SQ1494.2 +005400C LABEL RECORDS SQ1494.2 +005500C XXXXX084 SQ1494.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1494.2 +005700 . SQ1494.2 +005800 01 PRINT-REC PICTURE X(120). SQ1494.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1494.2 +006000* SQ1494.2 +006100 FD SQ-FS1 SQ1494.2 +006200C LABEL RECORD IS STANDARD SQ1494.2 +006300 . SQ1494.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1494.2 +006500* SQ1494.2 +006600 WORKING-STORAGE SECTION. SQ1494.2 +006700* SQ1494.2 +006800*************************************************************** SQ1494.2 +006900* * SQ1494.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1494.2 +007100* * SQ1494.2 +007200*************************************************************** SQ1494.2 +007300* SQ1494.2 +007400 01 SQ-FS1-STATUS. SQ1494.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1494.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1494.2 +007700* SQ1494.2 +007800*************************************************************** SQ1494.2 +007900* * SQ1494.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1494.2 +008100* * SQ1494.2 +008200*************************************************************** SQ1494.2 +008300* SQ1494.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1494.2 +008500* SQ1494.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1494.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1494.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1494.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1494.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1494.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1494.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1494.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1494.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1494.2 +009500 ",RECKEY= ". SQ1494.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1494.2 +009700 ",ALTKEY1= ". SQ1494.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1494.2 +009900 ",ALTKEY2= ". SQ1494.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1494.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1494.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1494.2 +010300 07 FILLER PIC X(5). SQ1494.2 +010400 07 XFILE-NAME PIC X(6). SQ1494.2 +010500 07 FILLER PIC X(8). SQ1494.2 +010600 07 XRECORD-NAME PIC X(6). SQ1494.2 +010700 07 FILLER PIC X(1). SQ1494.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1494.2 +010900 07 FILLER PIC X(7). SQ1494.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1494.2 +011100 07 FILLER PIC X(6). SQ1494.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1494.2 +011300 07 FILLER PIC X(5). SQ1494.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1494.2 +011500 07 FILLER PIC X(5). SQ1494.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1494.2 +011700 07 FILLER PIC X(7). SQ1494.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1494.2 +011900 07 FILLER PIC X(7). SQ1494.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1494.2 +012100 07 FILLER PIC X(1). SQ1494.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1494.2 +012300 07 FILLER PIC X(6). SQ1494.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1494.2 +012500 07 FILLER PIC X(5). SQ1494.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1494.2 +012700 07 FILLER PIC X(6). SQ1494.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1494.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1494.2 +013000 07 FILLER PIC X(8). SQ1494.2 +013100 07 XRECORD-KEY PIC X(29). SQ1494.2 +013200 07 FILLER PIC X(9). SQ1494.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1494.2 +013400 07 FILLER PIC X(9). SQ1494.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1494.2 +013600 07 FILLER PIC X(7). SQ1494.2 +013700* SQ1494.2 +013800 01 TEST-RESULTS. SQ1494.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1494.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1494.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014400 02 PAR-NAME. SQ1494.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1494.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1494.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1494.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1494.2 +014900 02 RE-MARK PIC X(61). SQ1494.2 +015000 01 TEST-COMPUTED. SQ1494.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1494.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1494.2 +015300 02 COMPUTED-X. SQ1494.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1494.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1494.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1494.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1494.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1494.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1494.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1494.2 +016100 04 FILLER PIC X. SQ1494.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1494.2 +016300 01 TEST-CORRECT. SQ1494.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1494.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1494.2 +016600 02 CORRECT-X. SQ1494.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1494.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1494.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1494.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1494.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1494.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1494.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1494.2 +017400 04 FILLER PIC X. SQ1494.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1494.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1494.2 +017700 01 CCVS-C-1. SQ1494.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1494.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1494.2 +018000- "SS PARAGRAPH-NAME SQ1494.2 +018100- " REMARKS". SQ1494.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1494.2 +018300 01 CCVS-C-2. SQ1494.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1494.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1494.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1494.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1494.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1494.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1494.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1494.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1494.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1494.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1494.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1494.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1494.2 +020000 01 CCVS-H-1. SQ1494.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1494.2 +020200 02 FILLER PIC X(42) VALUE SQ1494.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1494.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1494.2 +020500 01 CCVS-H-2A. SQ1494.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1494.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1494.2 +020800 02 FILLER PIC XXXX VALUE SQ1494.2 +020900 "4.2 ". SQ1494.2 +021000 02 FILLER PIC X(28) VALUE SQ1494.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1494.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1494.2 +021300* SQ1494.2 +021400 01 CCVS-H-2B. SQ1494.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1494.2 +021600 02 TEST-ID PIC X(9). SQ1494.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1494.2 +021800 02 FILLER PIC X(12) VALUE SQ1494.2 +021900 " HIGH ". SQ1494.2 +022000 02 FILLER PIC X(22) VALUE SQ1494.2 +022100 " LEVEL VALIDATION FOR ". SQ1494.2 +022200 02 FILLER PIC X(58) VALUE SQ1494.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +022400 01 CCVS-H-3. SQ1494.2 +022500 02 FILLER PIC X(34) VALUE SQ1494.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1494.2 +022700 02 FILLER PIC X(58) VALUE SQ1494.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1494.2 +022900 02 FILLER PIC X(28) VALUE SQ1494.2 +023000 " COPYRIGHT 1985,1986 ". SQ1494.2 +023100 01 CCVS-E-1. SQ1494.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1494.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1494.2 +023400 02 ID-AGAIN PIC X(9). SQ1494.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1494.2 +023600 01 CCVS-E-2. SQ1494.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1494.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1494.2 +023900 02 CCVS-E-2-2. SQ1494.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1494.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1494.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1494.2 +024300 "ERRORS ENCOUNTERED". SQ1494.2 +024400 01 CCVS-E-3. SQ1494.2 +024500 02 FILLER PIC X(22) VALUE SQ1494.2 +024600 " FOR OFFICIAL USE ONLY". SQ1494.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1494.2 +024800 02 FILLER PIC X(58) VALUE SQ1494.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1494.2 +025100 02 FILLER PIC X(20) VALUE SQ1494.2 +025200 " COPYRIGHT 1985,1986". SQ1494.2 +025300 01 CCVS-E-4. SQ1494.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1494.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1494.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1494.2 +025700 02 FILLER PIC X(40) VALUE SQ1494.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1494.2 +025900 01 XXINFO. SQ1494.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1494.2 +026100 02 INFO-TEXT. SQ1494.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1494.2 +026300 04 XXCOMPUTED PIC X(20). SQ1494.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1494.2 +026500 04 XXCORRECT PIC X(20). SQ1494.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1494.2 +026700 01 HYPHEN-LINE. SQ1494.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1494.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1494.2 +027000- "*****************************************". SQ1494.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1494.2 +027200- "******************************". SQ1494.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1494.2 +027400 "SQ149A". SQ1494.2 +027500* SQ1494.2 +027600 PROCEDURE DIVISION. SQ1494.2 +027700 CCVS1 SECTION. SQ1494.2 +027800 OPEN-FILES. SQ1494.2 +027900 OPEN OUTPUT PRINT-FILE. SQ1494.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1494.2 +028100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1494.2 +028200 MOVE SPACE TO TEST-RESULTS. SQ1494.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1494.2 +028400 MOVE ZERO TO REC-SKEL-SUB. SQ1494.2 +028500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1494.2 +028600 GO TO CCVS1-EXIT. SQ1494.2 +028700* SQ1494.2 +028800 CCVS-INIT-FILE. SQ1494.2 +028900 ADD 1 TO REC-SKL-SUB. SQ1494.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1494.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1494.2 +029200* SQ1494.2 +029300 CLOSE-FILES. SQ1494.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1494.2 +029500 CLOSE PRINT-FILE. SQ1494.2 +029600 TERMINATE-CCVS. SQ1494.2 +029700 STOP RUN. SQ1494.2 +029800* SQ1494.2 +029900 INSPT. SQ1494.2 +030000 MOVE "INSPT" TO P-OR-F. SQ1494.2 +030100 ADD 1 TO INSPECT-COUNTER. SQ1494.2 +030200 PERFORM PRINT-DETAIL. SQ1494.2 +030300 SQ1494.2 +030400 PASS. SQ1494.2 +030500 MOVE "PASS " TO P-OR-F. SQ1494.2 +030600 ADD 1 TO PASS-COUNTER. SQ1494.2 +030700 PERFORM PRINT-DETAIL. SQ1494.2 +030800* SQ1494.2 +030900 FAIL. SQ1494.2 +031000 MOVE "FAIL*" TO P-OR-F. SQ1494.2 +031100 ADD 1 TO ERROR-COUNTER. SQ1494.2 +031200 PERFORM PRINT-DETAIL. SQ1494.2 +031300* SQ1494.2 +031400 DE-LETE. SQ1494.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1494.2 +031600 MOVE "*****" TO P-OR-F. SQ1494.2 +031700 ADD 1 TO DELETE-COUNTER. SQ1494.2 +031800 PERFORM PRINT-DETAIL. SQ1494.2 +031900* SQ1494.2 +032000 PRINT-DETAIL. SQ1494.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1494.2 +032200 MOVE "." TO PARDOT-X SQ1494.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1494.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. SQ1494.2 +032500 PERFORM WRITE-LINE. SQ1494.2 +032600 IF P-OR-F EQUAL TO "FAIL*" SQ1494.2 +032700 PERFORM WRITE-LINE SQ1494.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1494.2 +032900 ELSE SQ1494.2 +033000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1494.2 +033100 MOVE SPACE TO P-OR-F. SQ1494.2 +033200 MOVE SPACE TO COMPUTED-X. SQ1494.2 +033300 MOVE SPACE TO CORRECT-X. SQ1494.2 +033400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1494.2 +033500 MOVE SPACE TO RE-MARK. SQ1494.2 +033600* SQ1494.2 +033700 HEAD-ROUTINE. SQ1494.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +034200 COLUMN-NAMES-ROUTINE. SQ1494.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +034600 END-ROUTINE. SQ1494.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1494.2 +034800 PERFORM WRITE-LINE 5 TIMES. SQ1494.2 +034900 END-RTN-EXIT. SQ1494.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1494.2 +035100 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +035200* SQ1494.2 +035300 END-ROUTINE-1. SQ1494.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1494.2 +035500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1494.2 +035600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1494.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1494.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1494.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1494.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1494.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1494.2 +036200 PERFORM WRITE-LINE. SQ1494.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1494.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1494.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +036600 ELSE SQ1494.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1494.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1494.2 +036900 PERFORM WRITE-LINE. SQ1494.2 +037000 END-ROUTINE-13. SQ1494.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1494.2 +037200 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +037300 ELSE SQ1494.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1494.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1494.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1494.2 +037700 PERFORM WRITE-LINE. SQ1494.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1494.2 +037900 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +038000 ELSE SQ1494.2 +038100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1494.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1494.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +038500* SQ1494.2 +038600 WRITE-LINE. SQ1494.2 +038700 ADD 1 TO RECORD-COUNT. SQ1494.2 +038800Y IF RECORD-COUNT GREATER 50 SQ1494.2 +038900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1494.2 +039000Y MOVE SPACE TO DUMMY-RECORD SQ1494.2 +039100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1494.2 +039200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1494.2 +039300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1494.2 +039400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1494.2 +039500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1494.2 +039600Y MOVE ZERO TO RECORD-COUNT. SQ1494.2 +039700 PERFORM WRT-LN. SQ1494.2 +039800* SQ1494.2 +039900 WRT-LN. SQ1494.2 +040000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1494.2 +040100 MOVE SPACE TO DUMMY-RECORD. SQ1494.2 +040200 BLANK-LINE-PRINT. SQ1494.2 +040300 PERFORM WRT-LN. SQ1494.2 +040400 FAIL-ROUTINE. SQ1494.2 +040500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1494.2 +040600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1494.2 +040700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1494.2 +040800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1494.2 +040900 MOVE XXINFO TO DUMMY-RECORD. SQ1494.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +041100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1494.2 +041200 GO TO FAIL-ROUTINE-EX. SQ1494.2 +041300 FAIL-ROUTINE-WRITE. SQ1494.2 +041400 MOVE TEST-COMPUTED TO PRINT-REC SQ1494.2 +041500 PERFORM WRITE-LINE SQ1494.2 +041600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1494.2 +041700 MOVE TEST-CORRECT TO PRINT-REC SQ1494.2 +041800 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +041900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1494.2 +042000 FAIL-ROUTINE-EX. SQ1494.2 +042100 EXIT. SQ1494.2 +042200 BAIL-OUT. SQ1494.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1494.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1494.2 +042500 BAIL-OUT-WRITE. SQ1494.2 +042600 MOVE CORRECT-A TO XXCORRECT. SQ1494.2 +042700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1494.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1494.2 +042900 MOVE XXINFO TO DUMMY-RECORD. SQ1494.2 +043000 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1494.2 +043200 BAIL-OUT-EX. SQ1494.2 +043300 EXIT. SQ1494.2 +043400 CCVS1-EXIT. SQ1494.2 +043500 EXIT. SQ1494.2 +043600* SQ1494.2 +043700**************************************************************** SQ1494.2 +043800* * SQ1494.2 +043900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1494.2 +044000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1494.2 +044100* * SQ1494.2 +044200**************************************************************** SQ1494.2 +044300* SQ1494.2 +044400 SECT-SQ149A-0001 SECTION. SQ1494.2 +044500 WRITE-INIT-GF-01. SQ1494.2 +044600* SQ1494.2 +044700* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1494.2 +044800* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1494.2 +044900* SQ1494.2 +045000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1494.2 +045100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1494.2 +045200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1494.2 +045300 MOVE 120 TO XRECORD-LENGTH (1). SQ1494.2 +045400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1494.2 +045500 MOVE 1 TO XBLOCK-SIZE (1). SQ1494.2 +045600 MOVE 1 TO RECORDS-IN-FILE (1). SQ1494.2 +045700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1494.2 +045800 MOVE "S" TO XLABEL-TYPE (1). SQ1494.2 +045900 MOVE 1 TO XRECORD-NUMBER (1). SQ1494.2 +046000* SQ1494.2 +046100 WRITE-OPEN-01. SQ1494.2 +046200 OPEN OUTPUT SQ-FS1. SQ1494.2 +046300* SQ1494.2 +046400* WRITE A SINGLE RECORD TO THE FILE SQ1494.2 +046500* SQ1494.2 +046600 WRITE-INIT-01. SQ1494.2 +046700 WRITE-TEST-01-01. SQ1494.2 +046800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1494.2 +046900 WRITE SQ-FS1R1-F-G-120. SQ1494.2 +047000* SQ1494.2 +047100* CLOSE THE FILE. SQ1494.2 +047200* SQ1494.2 +047300 CLOSE-INIT-01. SQ1494.2 +047400 CLOSE-TEST-01. SQ1494.2 +047500 CLOSE SQ-FS1. SQ1494.2 +047600* SQ1494.2 +047700 READ-INIT-01. SQ1494.2 +047800* SQ1494.2 +047900* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE SQ1494.2 +048000* CLOSED FILE. I-O STATUS 47 SHOULD BE GENERATED. SQ1494.2 +048100* SQ1494.2 +048200 MOVE "READ CLOSED FILE" TO FEATURE. SQ1494.2 +048300 MOVE "**" TO SQ-FS1-STATUS. SQ1494.2 +048400 MOVE "READ-TEST-01" TO PAR-NAME. SQ1494.2 +048500 MOVE 1 TO REC-CT. SQ1494.2 +048600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1494.2 +048700 TO DUMMY-RECORD. SQ1494.2 +048800 PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +048900* SQ1494.2 +049000 READ-TEST-01. SQ1494.2 +049100 READ SQ-FS1 AT END CONTINUE. SQ1494.2 +049200 IF SQ-FS1-STATUS = "47" SQ1494.2 +049300 PERFORM PASS SQ1494.2 +049400 ELSE SQ1494.2 +049500 MOVE "47" TO CORRECT-A SQ1494.2 +049600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1494.2 +049700 MOVE "STATUS FOR READ OF CLOSED FILE INCORRECT" SQ1494.2 +049800 TO RE-MARK SQ1494.2 +049900 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1494.2 +050000 PERFORM FAIL SQ1494.2 +050100 END-IF. SQ1494.2 +050200* SQ1494.2 +050300 CCVS-EXIT SECTION. SQ1494.2 +050400 CCVS-999999. SQ1494.2 +050500 GO TO CLOSE-FILES. SQ1494.2 +*END-OF,SQ149A +*HEADER,COBOL,SQ150A +000100 IDENTIFICATION DIVISION. SQ1504.2 +000200 PROGRAM-ID. SQ1504.2 +000300 SQ150A. SQ1504.2 +000400**************************************************************** SQ1504.2 +000500* * SQ1504.2 +000600* VALIDATION FOR:- * SQ1504.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +000800* USING CCVS85 VERSION 3.0. * SQ1504.2 +000900* * SQ1504.2 +001000* CREATION DATE / VALIDATION DATE * SQ1504.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1504.2 +001200* * SQ1504.2 +001300**************************************************************** SQ1504.2 +001400* * SQ1504.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1504.2 +001600* * SQ1504.2 +001700* X-01 SEQUENTIAL TAPE * SQ1504.2 +001800* X-55 SYSTEM PRINTER * SQ1504.2 +001900* X-82 SOURCE-COMPUTER * SQ1504.2 +002000* X-83 OBJECT-COMPUTER. * SQ1504.2 +002100* X-84 LABEL RECORDS OPTION * SQ1504.2 +002200* * SQ1504.2 +002300**************************************************************** SQ1504.2 +002400* * SQ1504.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1504.2 +002600* A FILE OPEN IN THE OUTPUT MODE. THE TEST FOR CORRECT I-O * SQ1504.2 +002700* STATUS CODE 47 IS IN THE MAIN LINE CODE, THEREFORE AN * SQ1504.2 +002800* ABNORMAL TERMINATION IS POSSIBLE BEFORE THE TEST OF THE * SQ1504.2 +002900* I-O STATUS CODE IS ACCOMPLISHED. * SQ1504.2 +003000* * SQ1504.2 +003100**************************************************************** SQ1504.2 +003200* SQ1504.2 +003300 ENVIRONMENT DIVISION. SQ1504.2 +003400 CONFIGURATION SECTION. SQ1504.2 +003500 SOURCE-COMPUTER. SQ1504.2 +003600 XXXXX082. SQ1504.2 +003700 OBJECT-COMPUTER. SQ1504.2 +003800 XXXXX083. SQ1504.2 +003900* SQ1504.2 +004000 INPUT-OUTPUT SECTION. SQ1504.2 +004100 FILE-CONTROL. SQ1504.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1504.2 +004300 XXXXX055. SQ1504.2 +004400* SQ1504.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1504.2 +004600 XXXXX001 SQ1504.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1504.2 +004800* SQ1504.2 +004900* SQ1504.2 +005000 DATA DIVISION. SQ1504.2 +005100 FILE SECTION. SQ1504.2 +005200 FD PRINT-FILE SQ1504.2 +005300C LABEL RECORDS SQ1504.2 +005400C XXXXX084 SQ1504.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1504.2 +005600 . SQ1504.2 +005700 01 PRINT-REC PICTURE X(120). SQ1504.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1504.2 +005900* SQ1504.2 +006000 FD SQ-FS1 SQ1504.2 +006100C LABEL RECORD IS STANDARD SQ1504.2 +006200 . SQ1504.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1504.2 +006400* SQ1504.2 +006500 WORKING-STORAGE SECTION. SQ1504.2 +006600* SQ1504.2 +006700*************************************************************** SQ1504.2 +006800* * SQ1504.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1504.2 +007000* * SQ1504.2 +007100*************************************************************** SQ1504.2 +007200* SQ1504.2 +007300 01 SQ-FS1-STATUS. SQ1504.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1504.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1504.2 +007600* SQ1504.2 +007700*************************************************************** SQ1504.2 +007800* * SQ1504.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1504.2 +008000* * SQ1504.2 +008100*************************************************************** SQ1504.2 +008200* SQ1504.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1504.2 +008400* SQ1504.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1504.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1504.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1504.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1504.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1504.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1504.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1504.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1504.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1504.2 +009400 ",RECKEY= ". SQ1504.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1504.2 +009600 ",ALTKEY1= ". SQ1504.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1504.2 +009800 ",ALTKEY2= ". SQ1504.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1504.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1504.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1504.2 +010200 07 FILLER PIC X(5). SQ1504.2 +010300 07 XFILE-NAME PIC X(6). SQ1504.2 +010400 07 FILLER PIC X(8). SQ1504.2 +010500 07 XRECORD-NAME PIC X(6). SQ1504.2 +010600 07 FILLER PIC X(1). SQ1504.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1504.2 +010800 07 FILLER PIC X(7). SQ1504.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1504.2 +011000 07 FILLER PIC X(6). SQ1504.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1504.2 +011200 07 FILLER PIC X(5). SQ1504.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1504.2 +011400 07 FILLER PIC X(5). SQ1504.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1504.2 +011600 07 FILLER PIC X(7). SQ1504.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1504.2 +011800 07 FILLER PIC X(7). SQ1504.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1504.2 +012000 07 FILLER PIC X(1). SQ1504.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1504.2 +012200 07 FILLER PIC X(6). SQ1504.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1504.2 +012400 07 FILLER PIC X(5). SQ1504.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1504.2 +012600 07 FILLER PIC X(6). SQ1504.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1504.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1504.2 +012900 07 FILLER PIC X(8). SQ1504.2 +013000 07 XRECORD-KEY PIC X(29). SQ1504.2 +013100 07 FILLER PIC X(9). SQ1504.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1504.2 +013300 07 FILLER PIC X(9). SQ1504.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1504.2 +013500 07 FILLER PIC X(7). SQ1504.2 +013600* SQ1504.2 +013700 01 TEST-RESULTS. SQ1504.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1504.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1504.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1504.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1504.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1504.2 +014300 02 PAR-NAME. SQ1504.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1504.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1504.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1504.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1504.2 +014800 02 RE-MARK PIC X(61). SQ1504.2 +014900 01 TEST-COMPUTED. SQ1504.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1504.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1504.2 +015200 02 COMPUTED-X. SQ1504.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1504.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1504.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1504.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1504.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1504.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1504.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1504.2 +016000 04 FILLER PIC X. SQ1504.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1504.2 +016200 01 TEST-CORRECT. SQ1504.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1504.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1504.2 +016500 02 CORRECT-X. SQ1504.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1504.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1504.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1504.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1504.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1504.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1504.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1504.2 +017300 04 FILLER PIC X. SQ1504.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1504.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1504.2 +017600 01 CCVS-C-1. SQ1504.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1504.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1504.2 +017900- "SS PARAGRAPH-NAME SQ1504.2 +018000- " REMARKS". SQ1504.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1504.2 +018200 01 CCVS-C-2. SQ1504.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1504.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1504.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1504.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1504.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1504.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1504.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1504.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1504.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1504.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1504.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1504.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1504.2 +019900 01 CCVS-H-1. SQ1504.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1504.2 +020100 02 FILLER PIC X(42) VALUE SQ1504.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1504.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1504.2 +020400 01 CCVS-H-2A. SQ1504.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1504.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1504.2 +020700 02 FILLER PIC XXXX VALUE SQ1504.2 +020800 "4.2 ". SQ1504.2 +020900 02 FILLER PIC X(28) VALUE SQ1504.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1504.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1504.2 +021200* SQ1504.2 +021300 01 CCVS-H-2B. SQ1504.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1504.2 +021500 02 TEST-ID PIC X(9). SQ1504.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1504.2 +021700 02 FILLER PIC X(12) VALUE SQ1504.2 +021800 " HIGH ". SQ1504.2 +021900 02 FILLER PIC X(22) VALUE SQ1504.2 +022000 " LEVEL VALIDATION FOR ". SQ1504.2 +022100 02 FILLER PIC X(58) VALUE SQ1504.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +022300 01 CCVS-H-3. SQ1504.2 +022400 02 FILLER PIC X(34) VALUE SQ1504.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1504.2 +022600 02 FILLER PIC X(58) VALUE SQ1504.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1504.2 +022800 02 FILLER PIC X(28) VALUE SQ1504.2 +022900 " COPYRIGHT 1985,1986 ". SQ1504.2 +023000 01 CCVS-E-1. SQ1504.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1504.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1504.2 +023300 02 ID-AGAIN PIC X(9). SQ1504.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1504.2 +023500 01 CCVS-E-2. SQ1504.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1504.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1504.2 +023800 02 CCVS-E-2-2. SQ1504.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1504.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1504.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1504.2 +024200 "ERRORS ENCOUNTERED". SQ1504.2 +024300 01 CCVS-E-3. SQ1504.2 +024400 02 FILLER PIC X(22) VALUE SQ1504.2 +024500 " FOR OFFICIAL USE ONLY". SQ1504.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1504.2 +024700 02 FILLER PIC X(58) VALUE SQ1504.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1504.2 +025000 02 FILLER PIC X(20) VALUE SQ1504.2 +025100 " COPYRIGHT 1985,1986". SQ1504.2 +025200 01 CCVS-E-4. SQ1504.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1504.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1504.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1504.2 +025600 02 FILLER PIC X(40) VALUE SQ1504.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1504.2 +025800 01 XXINFO. SQ1504.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1504.2 +026000 02 INFO-TEXT. SQ1504.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1504.2 +026200 04 XXCOMPUTED PIC X(20). SQ1504.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1504.2 +026400 04 XXCORRECT PIC X(20). SQ1504.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1504.2 +026600 01 HYPHEN-LINE. SQ1504.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1504.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1504.2 +026900- "*****************************************". SQ1504.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1504.2 +027100- "******************************". SQ1504.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1504.2 +027300 "SQ150A". SQ1504.2 +027400* SQ1504.2 +027500 PROCEDURE DIVISION. SQ1504.2 +027600 CCVS1 SECTION. SQ1504.2 +027700 OPEN-FILES. SQ1504.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1504.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1504.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1504.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1504.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1504.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1504.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1504.2 +028500 GO TO CCVS1-EXIT. SQ1504.2 +028600* SQ1504.2 +028700 CCVS-INIT-FILE. SQ1504.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1504.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1504.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1504.2 +029100* SQ1504.2 +029200 CLOSE-FILES. SQ1504.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1504.2 +029400 CLOSE PRINT-FILE. SQ1504.2 +029500 TERMINATE-CCVS. SQ1504.2 +029600 STOP RUN. SQ1504.2 +029700* SQ1504.2 +029800 INSPT. SQ1504.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1504.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1504.2 +030100 PERFORM PRINT-DETAIL. SQ1504.2 +030200 SQ1504.2 +030300 PASS. SQ1504.2 +030400 MOVE "PASS " TO P-OR-F. SQ1504.2 +030500 ADD 1 TO PASS-COUNTER. SQ1504.2 +030600 PERFORM PRINT-DETAIL. SQ1504.2 +030700* SQ1504.2 +030800 FAIL. SQ1504.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1504.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1504.2 +031100 PERFORM PRINT-DETAIL. SQ1504.2 +031200* SQ1504.2 +031300 DE-LETE. SQ1504.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1504.2 +031500 MOVE "*****" TO P-OR-F. SQ1504.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1504.2 +031700 PERFORM PRINT-DETAIL. SQ1504.2 +031800* SQ1504.2 +031900 PRINT-DETAIL. SQ1504.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1504.2 +032100 MOVE "." TO PARDOT-X SQ1504.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1504.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1504.2 +032400 PERFORM WRITE-LINE. SQ1504.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1504.2 +032600 PERFORM WRITE-LINE SQ1504.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1504.2 +032800 ELSE SQ1504.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1504.2 +033000 MOVE SPACE TO P-OR-F. SQ1504.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1504.2 +033200 MOVE SPACE TO CORRECT-X. SQ1504.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1504.2 +033400 MOVE SPACE TO RE-MARK. SQ1504.2 +033500* SQ1504.2 +033600 HEAD-ROUTINE. SQ1504.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +034100 COLUMN-NAMES-ROUTINE. SQ1504.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +034500 END-ROUTINE. SQ1504.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1504.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1504.2 +034800 END-RTN-EXIT. SQ1504.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1504.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +035100* SQ1504.2 +035200 END-ROUTINE-1. SQ1504.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1504.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1504.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1504.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1504.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1504.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1504.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1504.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1504.2 +036100 PERFORM WRITE-LINE. SQ1504.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1504.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1504.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +036500 ELSE SQ1504.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1504.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1504.2 +036800 PERFORM WRITE-LINE. SQ1504.2 +036900 END-ROUTINE-13. SQ1504.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1504.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +037200 ELSE SQ1504.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1504.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1504.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1504.2 +037600 PERFORM WRITE-LINE. SQ1504.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1504.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +037900 ELSE SQ1504.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1504.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1504.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +038400* SQ1504.2 +038500 WRITE-LINE. SQ1504.2 +038600 ADD 1 TO RECORD-COUNT. SQ1504.2 +038700Y IF RECORD-COUNT GREATER 50 SQ1504.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1504.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ1504.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1504.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1504.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1504.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1504.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1504.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ1504.2 +039600 PERFORM WRT-LN. SQ1504.2 +039700* SQ1504.2 +039800 WRT-LN. SQ1504.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1504.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1504.2 +040100 BLANK-LINE-PRINT. SQ1504.2 +040200 PERFORM WRT-LN. SQ1504.2 +040300 FAIL-ROUTINE. SQ1504.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1504.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1504.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1504.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1504.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1504.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1504.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1504.2 +041200 FAIL-ROUTINE-WRITE. SQ1504.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1504.2 +041400 PERFORM WRITE-LINE SQ1504.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1504.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1504.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1504.2 +041900 FAIL-ROUTINE-EX. SQ1504.2 +042000 EXIT. SQ1504.2 +042100 BAIL-OUT. SQ1504.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1504.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1504.2 +042400 BAIL-OUT-WRITE. SQ1504.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1504.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1504.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1504.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1504.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1504.2 +043100 BAIL-OUT-EX. SQ1504.2 +043200 EXIT. SQ1504.2 +043300 CCVS1-EXIT. SQ1504.2 +043400 EXIT. SQ1504.2 +043500* SQ1504.2 +043600**************************************************************** SQ1504.2 +043700* * SQ1504.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1504.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1504.2 +044000* * SQ1504.2 +044100**************************************************************** SQ1504.2 +044200* SQ1504.2 +044300 SECT-SQ150A-0001 SECTION. SQ1504.2 +044400 WRITE-INIT-GF-01. SQ1504.2 +044500* SQ1504.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1504.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1504.2 +044800* SQ1504.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1504.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1504.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1504.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1504.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1504.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1504.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1504.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1504.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1504.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1504.2 +045900* SQ1504.2 +046000 WRITE-OPEN-01. SQ1504.2 +046100 OPEN OUTPUT SQ-FS1. SQ1504.2 +046200* SQ1504.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1504.2 +046400* SQ1504.2 +046500 WRITE-INIT-01. SQ1504.2 +046600 WRITE-TEST-01-01. SQ1504.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1504.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ1504.2 +046900* SQ1504.2 +047000* CLOSE THE FILE. SQ1504.2 +047100* SQ1504.2 +047200 CLOSE-INIT-01. SQ1504.2 +047300 CLOSE-TEST-01. SQ1504.2 +047400 CLOSE SQ-FS1. SQ1504.2 +047500* SQ1504.2 +047600* HAVING CLOSED THE FILE, WE NOW TRY TO REOPEN IT IN THE SQ1504.2 +047700* OUTPUT MODE. SQ1504.2 +047800* SQ1504.2 +047900 OPEN-INIT-01. SQ1504.2 +048000* SQ1504.2 +048100 OPEN-TEST-01. SQ1504.2 +048200 OPEN OUTPUT SQ-FS1. SQ1504.2 +048300* SQ1504.2 +048400 READ-INIT-01. SQ1504.2 +048500* SQ1504.2 +048600* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE FILE. SQ1504.2 +048700* I-O STATUS CODE 47 SHOULD BE GENERATED. SQ1504.2 +048800* SQ1504.2 +048900 MOVE "READ FILE OPENED OUTPUT" TO FEATURE. SQ1504.2 +049000 MOVE "**" TO SQ-FS1-STATUS. SQ1504.2 +049100 MOVE "READ-TEST-01" TO PAR-NAME. SQ1504.2 +049200 MOVE 1 TO REC-CT. SQ1504.2 +049300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1504.2 +049400 TO DUMMY-RECORD. SQ1504.2 +049500 PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +049600* SQ1504.2 +049700 READ-TEST-01. SQ1504.2 +049800 READ SQ-FS1 AT END CONTINUE. SQ1504.2 +049900 IF SQ-FS1-STATUS = "47" SQ1504.2 +050000 PERFORM PASS SQ1504.2 +050100 ELSE SQ1504.2 +050200 MOVE "47" TO CORRECT-A SQ1504.2 +050300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1504.2 +050400 MOVE "STATUS FOR READ OF FILE OPEN OUTPUT INCORRECT" SQ1504.2 +050500 TO RE-MARK SQ1504.2 +050600 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1504.2 +050700 PERFORM FAIL SQ1504.2 +050800 END-IF. SQ1504.2 +050900* SQ1504.2 +051000 CCVS-EXIT SECTION. SQ1504.2 +051100 CCVS-999999. SQ1504.2 +051200 GO TO CLOSE-FILES. SQ1504.2 +*END-OF,SQ150A +*HEADER,COBOL,SQ151A +000100 IDENTIFICATION DIVISION. SQ1514.2 +000200 PROGRAM-ID. SQ1514.2 +000300 SQ151A. SQ1514.2 +000400**************************************************************** SQ1514.2 +000500* * SQ1514.2 +000600* VALIDATION FOR:- * SQ1514.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +000800* USING CCVS85 VERSION 3.0. * SQ1514.2 +000900* * SQ1514.2 +001000* CREATION DATE / VALIDATION DATE * SQ1514.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1514.2 +001200* * SQ1514.2 +001300**************************************************************** SQ1514.2 +001400* * SQ1514.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1514.2 +001600* * SQ1514.2 +001700* X-01 SEQUENTIAL TAPE * SQ1514.2 +001800* X-55 SYSTEM PRINTER * SQ1514.2 +001900* X-82 SOURCE-COMPUTER * SQ1514.2 +002000* X-83 OBJECT-COMPUTER * SQ1514.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1514.2 +002200* * SQ1514.2 +002300**************************************************************** SQ1514.2 +002400* * SQ1514.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING * SQ1514.2 +002600* A CLOSED FILE. THE TEST FOR CORRECT I-O STATUS CODE 48 * SQ1514.2 +002700* IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1514.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1514.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1514.2 +003000* LINE CODE. * SQ1514.2 +003100* * SQ1514.2 +003200**************************************************************** SQ1514.2 +003300* SQ1514.2 +003400 ENVIRONMENT DIVISION. SQ1514.2 +003500 CONFIGURATION SECTION. SQ1514.2 +003600 SOURCE-COMPUTER. SQ1514.2 +003700 XXXXX082. SQ1514.2 +003800 OBJECT-COMPUTER. SQ1514.2 +003900 XXXXX083. SQ1514.2 +004000* SQ1514.2 +004100 INPUT-OUTPUT SECTION. SQ1514.2 +004200 FILE-CONTROL. SQ1514.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1514.2 +004400 XXXXX055. SQ1514.2 +004500* SQ1514.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1514.2 +004700 XXXXX001 SQ1514.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1514.2 +004900* SQ1514.2 +005000* SQ1514.2 +005100 DATA DIVISION. SQ1514.2 +005200 FILE SECTION. SQ1514.2 +005300 FD PRINT-FILE SQ1514.2 +005400C LABEL RECORDS SQ1514.2 +005500C XXXXX084 SQ1514.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1514.2 +005700 . SQ1514.2 +005800 01 PRINT-REC PICTURE X(120). SQ1514.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1514.2 +006000* SQ1514.2 +006100 FD SQ-FS1 SQ1514.2 +006200C LABEL RECORD IS STANDARD SQ1514.2 +006300 . SQ1514.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1514.2 +006500* SQ1514.2 +006600 WORKING-STORAGE SECTION. SQ1514.2 +006700* SQ1514.2 +006800*************************************************************** SQ1514.2 +006900* * SQ1514.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1514.2 +007100* * SQ1514.2 +007200*************************************************************** SQ1514.2 +007300* SQ1514.2 +007400 01 SQ-FS1-STATUS. SQ1514.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1514.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1514.2 +007700* SQ1514.2 +007800*************************************************************** SQ1514.2 +007900* * SQ1514.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1514.2 +008100* * SQ1514.2 +008200*************************************************************** SQ1514.2 +008300* SQ1514.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1514.2 +008500* SQ1514.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1514.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1514.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1514.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1514.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1514.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1514.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1514.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1514.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1514.2 +009500 ",RECKEY= ". SQ1514.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1514.2 +009700 ",ALTKEY1= ". SQ1514.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1514.2 +009900 ",ALTKEY2= ". SQ1514.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1514.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1514.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1514.2 +010300 07 FILLER PIC X(5). SQ1514.2 +010400 07 XFILE-NAME PIC X(6). SQ1514.2 +010500 07 FILLER PIC X(8). SQ1514.2 +010600 07 XRECORD-NAME PIC X(6). SQ1514.2 +010700 07 FILLER PIC X(1). SQ1514.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1514.2 +010900 07 FILLER PIC X(7). SQ1514.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1514.2 +011100 07 FILLER PIC X(6). SQ1514.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1514.2 +011300 07 FILLER PIC X(5). SQ1514.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1514.2 +011500 07 FILLER PIC X(5). SQ1514.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1514.2 +011700 07 FILLER PIC X(7). SQ1514.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1514.2 +011900 07 FILLER PIC X(7). SQ1514.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1514.2 +012100 07 FILLER PIC X(1). SQ1514.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1514.2 +012300 07 FILLER PIC X(6). SQ1514.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1514.2 +012500 07 FILLER PIC X(5). SQ1514.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1514.2 +012700 07 FILLER PIC X(6). SQ1514.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1514.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1514.2 +013000 07 FILLER PIC X(8). SQ1514.2 +013100 07 XRECORD-KEY PIC X(29). SQ1514.2 +013200 07 FILLER PIC X(9). SQ1514.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1514.2 +013400 07 FILLER PIC X(9). SQ1514.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1514.2 +013600 07 FILLER PIC X(7). SQ1514.2 +013700* SQ1514.2 +013800 01 TEST-RESULTS. SQ1514.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1514.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1514.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014400 02 PAR-NAME. SQ1514.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1514.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1514.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1514.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1514.2 +014900 02 RE-MARK PIC X(61). SQ1514.2 +015000 01 TEST-COMPUTED. SQ1514.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1514.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1514.2 +015300 02 COMPUTED-X. SQ1514.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1514.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1514.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1514.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1514.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1514.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1514.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1514.2 +016100 04 FILLER PIC X. SQ1514.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1514.2 +016300 01 TEST-CORRECT. SQ1514.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1514.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1514.2 +016600 02 CORRECT-X. SQ1514.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1514.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1514.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1514.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1514.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1514.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1514.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1514.2 +017400 04 FILLER PIC X. SQ1514.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1514.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1514.2 +017700 01 CCVS-C-1. SQ1514.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1514.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1514.2 +018000- "SS PARAGRAPH-NAME SQ1514.2 +018100- " REMARKS". SQ1514.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1514.2 +018300 01 CCVS-C-2. SQ1514.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1514.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1514.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1514.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1514.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1514.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1514.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1514.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1514.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1514.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1514.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1514.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1514.2 +020000 01 CCVS-H-1. SQ1514.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1514.2 +020200 02 FILLER PIC X(42) VALUE SQ1514.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1514.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1514.2 +020500 01 CCVS-H-2A. SQ1514.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1514.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1514.2 +020800 02 FILLER PIC XXXX VALUE SQ1514.2 +020900 "4.2 ". SQ1514.2 +021000 02 FILLER PIC X(28) VALUE SQ1514.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1514.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1514.2 +021300* SQ1514.2 +021400 01 CCVS-H-2B. SQ1514.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1514.2 +021600 02 TEST-ID PIC X(9). SQ1514.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1514.2 +021800 02 FILLER PIC X(12) VALUE SQ1514.2 +021900 " HIGH ". SQ1514.2 +022000 02 FILLER PIC X(22) VALUE SQ1514.2 +022100 " LEVEL VALIDATION FOR ". SQ1514.2 +022200 02 FILLER PIC X(58) VALUE SQ1514.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +022400 01 CCVS-H-3. SQ1514.2 +022500 02 FILLER PIC X(34) VALUE SQ1514.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1514.2 +022700 02 FILLER PIC X(58) VALUE SQ1514.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1514.2 +022900 02 FILLER PIC X(28) VALUE SQ1514.2 +023000 " COPYRIGHT 1985,1986 ". SQ1514.2 +023100 01 CCVS-E-1. SQ1514.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1514.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1514.2 +023400 02 ID-AGAIN PIC X(9). SQ1514.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1514.2 +023600 01 CCVS-E-2. SQ1514.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1514.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1514.2 +023900 02 CCVS-E-2-2. SQ1514.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1514.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1514.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1514.2 +024300 "ERRORS ENCOUNTERED". SQ1514.2 +024400 01 CCVS-E-3. SQ1514.2 +024500 02 FILLER PIC X(22) VALUE SQ1514.2 +024600 " FOR OFFICIAL USE ONLY". SQ1514.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1514.2 +024800 02 FILLER PIC X(58) VALUE SQ1514.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1514.2 +025100 02 FILLER PIC X(20) VALUE SQ1514.2 +025200 " COPYRIGHT 1985,1986". SQ1514.2 +025300 01 CCVS-E-4. SQ1514.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1514.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1514.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1514.2 +025700 02 FILLER PIC X(40) VALUE SQ1514.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1514.2 +025900 01 XXINFO. SQ1514.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1514.2 +026100 02 INFO-TEXT. SQ1514.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1514.2 +026300 04 XXCOMPUTED PIC X(20). SQ1514.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1514.2 +026500 04 XXCORRECT PIC X(20). SQ1514.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1514.2 +026700 01 HYPHEN-LINE. SQ1514.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1514.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1514.2 +027000- "*****************************************". SQ1514.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1514.2 +027200- "******************************". SQ1514.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1514.2 +027400 "SQ151A". SQ1514.2 +027500* SQ1514.2 +027600 PROCEDURE DIVISION. SQ1514.2 +027700 DECLARATIVES. SQ1514.2 +027800 SQ-FS1-DECLARATIVE SECTION. SQ1514.2 +027900 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1. SQ1514.2 +028000 OUTPUT-ERROR-PROCESS. SQ1514.2 +028100 IF SQ-FS1-STATUS = "48" SQ1514.2 +028200 PERFORM DECL-PASS SQ1514.2 +028300 GO TO DECL-ABNORMAL-TERM SQ1514.2 +028400 ELSE SQ1514.2 +028500 MOVE "48" TO CORRECT-A SQ1514.2 +028600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1514.2 +028700 MOVE "STATUS FOR WRITE TO CLOSED FILE INCORRECT" SQ1514.2 +028800 TO RE-MARK SQ1514.2 +028900 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1514.2 +029000 PERFORM DECL-FAIL SQ1514.2 +029100 GO TO DECL-ABNORMAL-TERM SQ1514.2 +029200 END-IF. SQ1514.2 +029300* SQ1514.2 +029400 DECL-PASS. SQ1514.2 +029500 MOVE "PASS " TO P-OR-F. SQ1514.2 +029600 ADD 1 TO PASS-COUNTER. SQ1514.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ1514.2 +029800* SQ1514.2 +029900 DECL-FAIL. SQ1514.2 +030000 MOVE "FAIL*" TO P-OR-F. SQ1514.2 +030100 ADD 1 TO ERROR-COUNTER. SQ1514.2 +030200 PERFORM DECL-PRINT-DETAIL. SQ1514.2 +030300* SQ1514.2 +030400 DECL-PRINT-DETAIL. SQ1514.2 +030500 IF REC-CT NOT EQUAL TO ZERO SQ1514.2 +030600 MOVE "." TO PARDOT-X SQ1514.2 +030700 MOVE REC-CT TO DOTVALUE. SQ1514.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. SQ1514.2 +030900 PERFORM DECL-WRITE-LINE. SQ1514.2 +031000 IF P-OR-F EQUAL TO "FAIL*" SQ1514.2 +031100 PERFORM DECL-WRITE-LINE SQ1514.2 +031200 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1514.2 +031300 ELSE SQ1514.2 +031400 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1514.2 +031500 MOVE SPACE TO P-OR-F. SQ1514.2 +031600 MOVE SPACE TO COMPUTED-X. SQ1514.2 +031700 MOVE SPACE TO CORRECT-X. SQ1514.2 +031800 IF REC-CT EQUAL TO ZERO SQ1514.2 +031900 MOVE SPACE TO PAR-NAME. SQ1514.2 +032000 MOVE SPACE TO RE-MARK. SQ1514.2 +032100* SQ1514.2 +032200 DECL-WRITE-LINE. SQ1514.2 +032300 ADD 1 TO RECORD-COUNT. SQ1514.2 +032400Y IF RECORD-COUNT GREATER 50 SQ1514.2 +032500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1514.2 +032600Y MOVE SPACE TO DUMMY-RECORD SQ1514.2 +032700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1514.2 +032800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1514.2 +032900Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1514.2 +033000Y PERFORM DECL-WRT-LN 2 TIMES SQ1514.2 +033100Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1514.2 +033200Y PERFORM DECL-WRT-LN SQ1514.2 +033300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1514.2 +033400Y MOVE ZERO TO RECORD-COUNT. SQ1514.2 +033500 PERFORM DECL-WRT-LN. SQ1514.2 +033600* SQ1514.2 +033700 DECL-WRT-LN. SQ1514.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1514.2 +033900 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +034000* SQ1514.2 +034100 DECL-FAIL-ROUTINE. SQ1514.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1514.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1514.2 +034400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +034500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1514.2 +034600 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +034700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +034800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +034900 GO TO DECL-FAIL-EX. SQ1514.2 +035000 DECL-FAIL-WRITE. SQ1514.2 +035100 MOVE TEST-COMPUTED TO PRINT-REC SQ1514.2 +035200 PERFORM DECL-WRITE-LINE SQ1514.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1514.2 +035400 MOVE TEST-CORRECT TO PRINT-REC SQ1514.2 +035500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +035600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1514.2 +035700 DECL-FAIL-EX. SQ1514.2 +035800 EXIT. SQ1514.2 +035900* SQ1514.2 +036000 DECL-BAIL. SQ1514.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1514.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1514.2 +036300 DECL-BAIL-WRITE. SQ1514.2 +036400 MOVE CORRECT-A TO XXCORRECT. SQ1514.2 +036500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1514.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +036900 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1514.2 +037000 DECL-BAIL-EX. SQ1514.2 +037100 EXIT. SQ1514.2 +037200* SQ1514.2 +037300 DECL-ABNORMAL-TERM. SQ1514.2 +037400 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +037500 PERFORM DECL-WRITE-LINE. SQ1514.2 +037600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1514.2 +037700 TO DUMMY-RECORD. SQ1514.2 +037800 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1514.2 +037900* SQ1514.2 +038000 END-DECLS. SQ1514.2 +038100 EXIT. SQ1514.2 +038200 END DECLARATIVES. SQ1514.2 +038300* SQ1514.2 +038400* SQ1514.2 +038500 CCVS1 SECTION. SQ1514.2 +038600 OPEN-FILES. SQ1514.2 +038700 OPEN OUTPUT PRINT-FILE. SQ1514.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1514.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1514.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ1514.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1514.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ1514.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1514.2 +039400 GO TO CCVS1-EXIT. SQ1514.2 +039500* SQ1514.2 +039600 CCVS-INIT-FILE. SQ1514.2 +039700 ADD 1 TO REC-SKL-SUB. SQ1514.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1514.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1514.2 +040000* SQ1514.2 +040100 CLOSE-FILES. SQ1514.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1514.2 +040300 CLOSE PRINT-FILE. SQ1514.2 +040400 TERMINATE-CCVS. SQ1514.2 +040500 STOP RUN. SQ1514.2 +040600* SQ1514.2 +040700 INSPT. SQ1514.2 +040800 MOVE "INSPT" TO P-OR-F. SQ1514.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ1514.2 +041000 PERFORM PRINT-DETAIL. SQ1514.2 +041100 SQ1514.2 +041200 PASS. SQ1514.2 +041300 MOVE "PASS " TO P-OR-F. SQ1514.2 +041400 ADD 1 TO PASS-COUNTER. SQ1514.2 +041500 PERFORM PRINT-DETAIL. SQ1514.2 +041600* SQ1514.2 +041700 FAIL. SQ1514.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ1514.2 +041900 ADD 1 TO ERROR-COUNTER. SQ1514.2 +042000 PERFORM PRINT-DETAIL. SQ1514.2 +042100* SQ1514.2 +042200 DE-LETE. SQ1514.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1514.2 +042400 MOVE "*****" TO P-OR-F. SQ1514.2 +042500 ADD 1 TO DELETE-COUNTER. SQ1514.2 +042600 PERFORM PRINT-DETAIL. SQ1514.2 +042700* SQ1514.2 +042800 PRINT-DETAIL. SQ1514.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ1514.2 +043000 MOVE "." TO PARDOT-X SQ1514.2 +043100 MOVE REC-CT TO DOTVALUE. SQ1514.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ1514.2 +043300 PERFORM WRITE-LINE. SQ1514.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ1514.2 +043500 PERFORM WRITE-LINE SQ1514.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1514.2 +043700 ELSE SQ1514.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1514.2 +043900 MOVE SPACE TO P-OR-F. SQ1514.2 +044000 MOVE SPACE TO COMPUTED-X. SQ1514.2 +044100 MOVE SPACE TO CORRECT-X. SQ1514.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1514.2 +044300 MOVE SPACE TO RE-MARK. SQ1514.2 +044400* SQ1514.2 +044500 HEAD-ROUTINE. SQ1514.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1514.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1514.2 +045000 COLUMN-NAMES-ROUTINE. SQ1514.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +045400 END-ROUTINE. SQ1514.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1514.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ1514.2 +045700 END-RTN-EXIT. SQ1514.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1514.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +046000* SQ1514.2 +046100 END-ROUTINE-1. SQ1514.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1514.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1514.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1514.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1514.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1514.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1514.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1514.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1514.2 +047000 PERFORM WRITE-LINE. SQ1514.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1514.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1514.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +047400 ELSE SQ1514.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1514.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1514.2 +047700 PERFORM WRITE-LINE. SQ1514.2 +047800 END-ROUTINE-13. SQ1514.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1514.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +048100 ELSE SQ1514.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1514.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1514.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1514.2 +048500 PERFORM WRITE-LINE. SQ1514.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1514.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +048800 ELSE SQ1514.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1514.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1514.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +049300* SQ1514.2 +049400 WRITE-LINE. SQ1514.2 +049500 ADD 1 TO RECORD-COUNT. SQ1514.2 +049600Y IF RECORD-COUNT GREATER 50 SQ1514.2 +049700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1514.2 +049800Y MOVE SPACE TO DUMMY-RECORD SQ1514.2 +049900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1514.2 +050000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1514.2 +050100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1514.2 +050200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1514.2 +050300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1514.2 +050400Y MOVE ZERO TO RECORD-COUNT. SQ1514.2 +050500 PERFORM WRT-LN. SQ1514.2 +050600* SQ1514.2 +050700 WRT-LN. SQ1514.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1514.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +051000 BLANK-LINE-PRINT. SQ1514.2 +051100 PERFORM WRT-LN. SQ1514.2 +051200 FAIL-ROUTINE. SQ1514.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1514.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1514.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1514.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +052000 GO TO FAIL-ROUTINE-EX. SQ1514.2 +052100 FAIL-ROUTINE-WRITE. SQ1514.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ1514.2 +052300 PERFORM WRITE-LINE SQ1514.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1514.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ1514.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1514.2 +052800 FAIL-ROUTINE-EX. SQ1514.2 +052900 EXIT. SQ1514.2 +053000 BAIL-OUT. SQ1514.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1514.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1514.2 +053300 BAIL-OUT-WRITE. SQ1514.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ1514.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1514.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +054000 BAIL-OUT-EX. SQ1514.2 +054100 EXIT. SQ1514.2 +054200 CCVS1-EXIT. SQ1514.2 +054300 EXIT. SQ1514.2 +054400* SQ1514.2 +054500**************************************************************** SQ1514.2 +054600* * SQ1514.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1514.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1514.2 +054900* * SQ1514.2 +055000**************************************************************** SQ1514.2 +055100* SQ1514.2 +055200 SECT-SQ151A-0001 SECTION. SQ1514.2 +055300 WRITE-INIT-GF-01. SQ1514.2 +055400* SQ1514.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ1514.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1514.2 +055700* SQ1514.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1514.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1514.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1514.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ1514.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1514.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ1514.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1514.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1514.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ1514.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ1514.2 +056800* SQ1514.2 +056900 WRITE-OPEN-01. SQ1514.2 +057000 OPEN OUTPUT SQ-FS1. SQ1514.2 +057100* SQ1514.2 +057200* WRITE A SINGLE RECORD TO THE FILE SQ1514.2 +057300* SQ1514.2 +057400 WRITE-TEST-01-01. SQ1514.2 +057500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1514.2 +057600 WRITE SQ-FS1R1-F-G-120. SQ1514.2 +057700* SQ1514.2 +057800* CLOSE THE FILE. SQ1514.2 +057900* SQ1514.2 +058000 CLOSE-INIT-01. SQ1514.2 +058100 CLOSE-TEST-01. SQ1514.2 +058200 CLOSE SQ-FS1. SQ1514.2 +058300* SQ1514.2 +058400* WE WILL NOW ATTEMPT TO WRITE A RECORD TO THE CLOSED SQ1514.2 +058500* FILE. I-O STATUS 48 SHOULD BE GENERATED. SQ1514.2 +058600* SQ1514.2 +058700 WRITE-INIT-01. SQ1514.2 +058800* SQ1514.2 +058900 MOVE "WRITE CLOSED FILE" TO FEATURE. SQ1514.2 +059000 MOVE "**" TO SQ-FS1-STATUS. SQ1514.2 +059100 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1514.2 +059200 MOVE 1 TO REC-CT. SQ1514.2 +059300 WRITE-TEST-01. SQ1514.2 +059400 WRITE SQ-FS1R1-F-G-120. SQ1514.2 +059500* SQ1514.2 +059600 CCVS-EXIT SECTION. SQ1514.2 +059700 CCVS-999999. SQ1514.2 +059800 GO TO CLOSE-FILES. SQ1514.2 +*END-OF,SQ151A +*HEADER,COBOL,SQ152A +000100 IDENTIFICATION DIVISION. SQ1524.2 +000200 PROGRAM-ID. SQ1524.2 +000300 SQ152A. SQ1524.2 +000400**************************************************************** SQ1524.2 +000500* * SQ1524.2 +000600* VALIDATION FOR:- * SQ1524.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +000800* USING CCVS85 VERSION 3.0. * SQ1524.2 +000900* * SQ1524.2 +001000* CREATION DATE / VALIDATION DATE * SQ1524.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1524.2 +001200* * SQ1524.2 +001300**************************************************************** SQ1524.2 +001400* * SQ1524.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1524.2 +001600* * SQ1524.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ1524.2 +001800* X-55 SYSTEM PRINTER * SQ1524.2 +001900* X-82 SOURCE-COMPUTER * SQ1524.2 +002000* X-83 OBJECT-COMPUTER. * SQ1524.2 +002100* X-84 LABEL RECORDS OPTION SQ1524.2 +002200* * SQ1524.2 +002300**************************************************************** SQ1524.2 +002400* * SQ1524.2 +002500* * SQ1524.2 +002600* SPLIT FROM SQ215A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1524.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1524.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1524.2 +002900* ATTEMPT TO WRITE TO A FILE NOT OPEN IN THE OUTPUT OR * SQ1524.2 +003000* EXTEND MODE. I-O STATUS 48 IS EXPECTED AND TESTED IN * SQ1524.2 +003100* THE DECLARATIVES. * SQ1524.2 +003200* * SQ1524.2 +003300**************************************************************** SQ1524.2 +003400* SQ1524.2 +003500 ENVIRONMENT DIVISION. SQ1524.2 +003600 CONFIGURATION SECTION. SQ1524.2 +003700 SOURCE-COMPUTER. SQ1524.2 +003800 XXXXX082. SQ1524.2 +003900 OBJECT-COMPUTER. SQ1524.2 +004000 XXXXX083. SQ1524.2 +004100* SQ1524.2 +004200 INPUT-OUTPUT SECTION. SQ1524.2 +004300 FILE-CONTROL. SQ1524.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1524.2 +004500 XXXXX055. SQ1524.2 +004600* SQ1524.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ1524.2 +004800 XXXXX014 SQ1524.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ1524.2 +005000* SQ1524.2 +005100* SQ1524.2 +005200 DATA DIVISION. SQ1524.2 +005300 FILE SECTION. SQ1524.2 +005400 FD PRINT-FILE SQ1524.2 +005500C LABEL RECORDS SQ1524.2 +005600C XXXXX084 SQ1524.2 +005700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1524.2 +005800 . SQ1524.2 +005900 01 PRINT-REC PICTURE X(120). SQ1524.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1524.2 +006100* SQ1524.2 +006200 FD SQ-FS1 SQ1524.2 +006300C LABEL RECORD IS STANDARD SQ1524.2 +006400 . SQ1524.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1524.2 +006600* SQ1524.2 +006700 WORKING-STORAGE SECTION. SQ1524.2 +006800* SQ1524.2 +006900*************************************************************** SQ1524.2 +007000* * SQ1524.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1524.2 +007200* * SQ1524.2 +007300*************************************************************** SQ1524.2 +007400* SQ1524.2 +007500 01 SQ-FS1-STATUS. SQ1524.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ1524.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ1524.2 +007800* SQ1524.2 +007900*************************************************************** SQ1524.2 +008000* * SQ1524.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1524.2 +008200* * SQ1524.2 +008300*************************************************************** SQ1524.2 +008400* SQ1524.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1524.2 +008600* SQ1524.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1524.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1524.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1524.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1524.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1524.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1524.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1524.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1524.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1524.2 +009600 ",RECKEY= ". SQ1524.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1524.2 +009800 ",ALTKEY1= ". SQ1524.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1524.2 +010000 ",ALTKEY2= ". SQ1524.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1524.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1524.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1524.2 +010400 07 FILLER PIC X(5). SQ1524.2 +010500 07 XFILE-NAME PIC X(6). SQ1524.2 +010600 07 FILLER PIC X(8). SQ1524.2 +010700 07 XRECORD-NAME PIC X(6). SQ1524.2 +010800 07 FILLER PIC X(1). SQ1524.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1524.2 +011000 07 FILLER PIC X(7). SQ1524.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1524.2 +011200 07 FILLER PIC X(6). SQ1524.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1524.2 +011400 07 FILLER PIC X(5). SQ1524.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1524.2 +011600 07 FILLER PIC X(5). SQ1524.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1524.2 +011800 07 FILLER PIC X(7). SQ1524.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1524.2 +012000 07 FILLER PIC X(7). SQ1524.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1524.2 +012200 07 FILLER PIC X(1). SQ1524.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1524.2 +012400 07 FILLER PIC X(6). SQ1524.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1524.2 +012600 07 FILLER PIC X(5). SQ1524.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1524.2 +012800 07 FILLER PIC X(6). SQ1524.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1524.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1524.2 +013100 07 FILLER PIC X(8). SQ1524.2 +013200 07 XRECORD-KEY PIC X(29). SQ1524.2 +013300 07 FILLER PIC X(9). SQ1524.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1524.2 +013500 07 FILLER PIC X(9). SQ1524.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1524.2 +013700 07 FILLER PIC X(7). SQ1524.2 +013800* SQ1524.2 +013900 01 TEST-RESULTS. SQ1524.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ1524.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ1524.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014500 02 PAR-NAME. SQ1524.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1524.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1524.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1524.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1524.2 +015000 02 RE-MARK PIC X(61). SQ1524.2 +015100 01 TEST-COMPUTED. SQ1524.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1524.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1524.2 +015400 02 COMPUTED-X. SQ1524.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1524.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1524.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1524.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1524.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1524.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1524.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1524.2 +016200 04 FILLER PIC X. SQ1524.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1524.2 +016400 01 TEST-CORRECT. SQ1524.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1524.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1524.2 +016700 02 CORRECT-X. SQ1524.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1524.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1524.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1524.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1524.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1524.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1524.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1524.2 +017500 04 FILLER PIC X. SQ1524.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1524.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1524.2 +017800 01 CCVS-C-1. SQ1524.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ1524.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1524.2 +018100- "SS PARAGRAPH-NAME SQ1524.2 +018200- " REMARKS". SQ1524.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ1524.2 +018400 01 CCVS-C-2. SQ1524.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ1524.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ1524.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ1524.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ1524.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ1524.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1524.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ1524.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1524.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1524.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1524.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1524.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1524.2 +020100 01 CCVS-H-1. SQ1524.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1524.2 +020300 02 FILLER PIC X(42) VALUE SQ1524.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1524.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ1524.2 +020600 01 CCVS-H-2A. SQ1524.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ1524.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1524.2 +020900 02 FILLER PIC XXXX VALUE SQ1524.2 +021000 "4.2 ". SQ1524.2 +021100 02 FILLER PIC X(28) VALUE SQ1524.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ1524.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ1524.2 +021400* SQ1524.2 +021500 01 CCVS-H-2B. SQ1524.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1524.2 +021700 02 TEST-ID PIC X(9). SQ1524.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ1524.2 +021900 02 FILLER PIC X(12) VALUE SQ1524.2 +022000 " HIGH ". SQ1524.2 +022100 02 FILLER PIC X(22) VALUE SQ1524.2 +022200 " LEVEL VALIDATION FOR ". SQ1524.2 +022300 02 FILLER PIC X(58) VALUE SQ1524.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +022500 01 CCVS-H-3. SQ1524.2 +022600 02 FILLER PIC X(34) VALUE SQ1524.2 +022700 " FOR OFFICIAL USE ONLY ". SQ1524.2 +022800 02 FILLER PIC X(58) VALUE SQ1524.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1524.2 +023000 02 FILLER PIC X(28) VALUE SQ1524.2 +023100 " COPYRIGHT 1985,1986 ". SQ1524.2 +023200 01 CCVS-E-1. SQ1524.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ1524.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1524.2 +023500 02 ID-AGAIN PIC X(9). SQ1524.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ1524.2 +023700 01 CCVS-E-2. SQ1524.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ1524.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ1524.2 +024000 02 CCVS-E-2-2. SQ1524.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1524.2 +024200 03 FILLER PIC X VALUE SPACE. SQ1524.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ1524.2 +024400 "ERRORS ENCOUNTERED". SQ1524.2 +024500 01 CCVS-E-3. SQ1524.2 +024600 02 FILLER PIC X(22) VALUE SQ1524.2 +024700 " FOR OFFICIAL USE ONLY". SQ1524.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ1524.2 +024900 02 FILLER PIC X(58) VALUE SQ1524.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ1524.2 +025200 02 FILLER PIC X(20) VALUE SQ1524.2 +025300 " COPYRIGHT 1985,1986". SQ1524.2 +025400 01 CCVS-E-4. SQ1524.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1524.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ1524.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1524.2 +025800 02 FILLER PIC X(40) VALUE SQ1524.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1524.2 +026000 01 XXINFO. SQ1524.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1524.2 +026200 02 INFO-TEXT. SQ1524.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ1524.2 +026400 04 XXCOMPUTED PIC X(20). SQ1524.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ1524.2 +026600 04 XXCORRECT PIC X(20). SQ1524.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ1524.2 +026800 01 HYPHEN-LINE. SQ1524.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ1524.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ1524.2 +027100- "*****************************************". SQ1524.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ1524.2 +027300- "******************************". SQ1524.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ1524.2 +027500 "SQ152A". SQ1524.2 +027600* SQ1524.2 +027700 PROCEDURE DIVISION. SQ1524.2 +027800 DECLARATIVES. SQ1524.2 +027900 SQ-FS1-DECLARATIVE SECTION. SQ1524.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ1524.2 +028100 OUTPUT-ERROR-PROCESS. SQ1524.2 +028200 IF SQ-FS1-STATUS = "48" SQ1524.2 +028300 PERFORM PASS-DECL SQ1524.2 +028400 GO TO ABNORMAL-TERM-DECL SQ1524.2 +028500 ELSE SQ1524.2 +028600 MOVE "48" TO CORRECT-A SQ1524.2 +028700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1524.2 +028800 MOVE "STATUS AFTER OPEN AFTER LOCK INCORRECT" SQ1524.2 +028900 TO RE-MARK SQ1524.2 +029000 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1524.2 +029100 PERFORM FAIL-DECL SQ1524.2 +029200 GO TO ABNORMAL-TERM-DECL SQ1524.2 +029300 END-IF. SQ1524.2 +029400* SQ1524.2 +029500 PASS-DECL. SQ1524.2 +029600 MOVE "PASS " TO P-OR-F. SQ1524.2 +029700 ADD 1 TO PASS-COUNTER. SQ1524.2 +029800 PERFORM PRINT-DETAIL-DECL. SQ1524.2 +029900* SQ1524.2 +030000 FAIL-DECL. SQ1524.2 +030100 MOVE "FAIL*" TO P-OR-F. SQ1524.2 +030200 ADD 1 TO ERROR-COUNTER. SQ1524.2 +030300 PERFORM PRINT-DETAIL-DECL. SQ1524.2 +030400* SQ1524.2 +030500 PRINT-DETAIL-DECL. SQ1524.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ1524.2 +030700 MOVE "." TO PARDOT-X SQ1524.2 +030800 MOVE REC-CT TO DOTVALUE. SQ1524.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ1524.2 +031000 PERFORM WRITE-LINE-DECL. SQ1524.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ1524.2 +031200 PERFORM WRITE-LINE-DECL SQ1524.2 +031300 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ1524.2 +031400 ELSE SQ1524.2 +031500 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ1524.2 +031600 MOVE SPACE TO P-OR-F. SQ1524.2 +031700 MOVE SPACE TO COMPUTED-X. SQ1524.2 +031800 MOVE SPACE TO CORRECT-X. SQ1524.2 +031900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1524.2 +032000 MOVE SPACE TO RE-MARK. SQ1524.2 +032100* SQ1524.2 +032200 WRITE-LINE-DECL. SQ1524.2 +032300 ADD 1 TO RECORD-COUNT. SQ1524.2 +032400Y IF RECORD-COUNT GREATER 50 SQ1524.2 +032500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1524.2 +032600Y MOVE SPACE TO DUMMY-RECORD SQ1524.2 +032700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1524.2 +032800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1524.2 +032900Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1524.2 +033000Y PERFORM WRT-LN-DECL 2 TIMES SQ1524.2 +033100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1524.2 +033200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1524.2 +033300Y MOVE ZERO TO RECORD-COUNT. SQ1524.2 +033400 PERFORM WRT-LN-DECL. SQ1524.2 +033500* SQ1524.2 +033600 WRT-LN-DECL. SQ1524.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1524.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +033900 BLANK-LINE-PRINT-DECL. SQ1524.2 +034000 PERFORM WRT-LN-DECL. SQ1524.2 +034100 FAIL-ROUTINE-DECL. SQ1524.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE SQ1524.2 +034300 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE SQ1524.2 +034500 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1524.2 +034800 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +034900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +035100 GO TO FAIL-ROUTINE-EX-DECL. SQ1524.2 +035200 FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC SQ1524.2 +035400 PERFORM WRITE-LINE-DECL SQ1524.2 +035500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1524.2 +035600 MOVE TEST-CORRECT TO PRINT-REC SQ1524.2 +035700 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1524.2 +035900 FAIL-ROUTINE-EX-DECL. SQ1524.2 +036000 EXIT. SQ1524.2 +036100 BAIL-OUT-DECL. SQ1524.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ1524.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ1524.2 +036400 BAIL-OUT-WRITE-DECL. SQ1524.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ1524.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1524.2 +036700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +036800 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +036900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +037000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +037100 BAIL-OUT-EX-DECL. SQ1524.2 +037200 EXIT. SQ1524.2 +037300* SQ1524.2 +037400 ABNORMAL-TERM-DECL. SQ1524.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +037600 PERFORM WRITE-LINE-DECL. SQ1524.2 +037700 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1524.2 +037800 TO DUMMY-RECORD. SQ1524.2 +037900 PERFORM WRITE-LINE-DECL 3 TIMES. SQ1524.2 +038000* SQ1524.2 +038100 EXIT-DECL. SQ1524.2 +038200 EXIT. SQ1524.2 +038300 END DECLARATIVES. SQ1524.2 +038400* SQ1524.2 +038500 CCVS1 SECTION. SQ1524.2 +038600 OPEN-FILES. SQ1524.2 +038700 OPEN OUTPUT PRINT-FILE. SQ1524.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1524.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1524.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ1524.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1524.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ1524.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1524.2 +039400 GO TO CCVS1-EXIT. SQ1524.2 +039500* SQ1524.2 +039600 CCVS-INIT-FILE. SQ1524.2 +039700 ADD 1 TO REC-SKL-SUB. SQ1524.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1524.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1524.2 +040000* SQ1524.2 +040100 CLOSE-FILES. SQ1524.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1524.2 +040300 CLOSE PRINT-FILE. SQ1524.2 +040400 TERMINATE-CCVS. SQ1524.2 +040500 STOP RUN. SQ1524.2 +040600* SQ1524.2 +040700 INSPT. SQ1524.2 +040800 MOVE "INSPT" TO P-OR-F. SQ1524.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ1524.2 +041000 PERFORM PRINT-DETAIL. SQ1524.2 +041100 SQ1524.2 +041200 PASS. SQ1524.2 +041300 MOVE "PASS " TO P-OR-F. SQ1524.2 +041400 ADD 1 TO PASS-COUNTER. SQ1524.2 +041500 PERFORM PRINT-DETAIL. SQ1524.2 +041600* SQ1524.2 +041700 FAIL. SQ1524.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ1524.2 +041900 ADD 1 TO ERROR-COUNTER. SQ1524.2 +042000 PERFORM PRINT-DETAIL. SQ1524.2 +042100* SQ1524.2 +042200 DE-LETE. SQ1524.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1524.2 +042400 MOVE "*****" TO P-OR-F. SQ1524.2 +042500 ADD 1 TO DELETE-COUNTER. SQ1524.2 +042600 PERFORM PRINT-DETAIL. SQ1524.2 +042700* SQ1524.2 +042800 PRINT-DETAIL. SQ1524.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ1524.2 +043000 MOVE "." TO PARDOT-X SQ1524.2 +043100 MOVE REC-CT TO DOTVALUE. SQ1524.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ1524.2 +043300 PERFORM WRITE-LINE. SQ1524.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ1524.2 +043500 PERFORM WRITE-LINE SQ1524.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1524.2 +043700 ELSE SQ1524.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1524.2 +043900 MOVE SPACE TO P-OR-F. SQ1524.2 +044000 MOVE SPACE TO COMPUTED-X. SQ1524.2 +044100 MOVE SPACE TO CORRECT-X. SQ1524.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1524.2 +044300 MOVE SPACE TO RE-MARK. SQ1524.2 +044400* SQ1524.2 +044500 HEAD-ROUTINE. SQ1524.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1524.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1524.2 +045000 COLUMN-NAMES-ROUTINE. SQ1524.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +045400 END-ROUTINE. SQ1524.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1524.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ1524.2 +045700 END-RTN-EXIT. SQ1524.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1524.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +046000* SQ1524.2 +046100 END-ROUTINE-1. SQ1524.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1524.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1524.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1524.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1524.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1524.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1524.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1524.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1524.2 +047000 PERFORM WRITE-LINE. SQ1524.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1524.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1524.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +047400 ELSE SQ1524.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1524.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1524.2 +047700 PERFORM WRITE-LINE. SQ1524.2 +047800 END-ROUTINE-13. SQ1524.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1524.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +048100 ELSE SQ1524.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1524.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1524.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1524.2 +048500 PERFORM WRITE-LINE. SQ1524.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1524.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +048800 ELSE SQ1524.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1524.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1524.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +049300* SQ1524.2 +049400 WRITE-LINE. SQ1524.2 +049500 ADD 1 TO RECORD-COUNT. SQ1524.2 +049600Y IF RECORD-COUNT GREATER 50 SQ1524.2 +049700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1524.2 +049800Y MOVE SPACE TO DUMMY-RECORD SQ1524.2 +049900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1524.2 +050000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1524.2 +050100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1524.2 +050200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1524.2 +050300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1524.2 +050400Y MOVE ZERO TO RECORD-COUNT. SQ1524.2 +050500 PERFORM WRT-LN. SQ1524.2 +050600* SQ1524.2 +050700 WRT-LN. SQ1524.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1524.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +051000 BLANK-LINE-PRINT. SQ1524.2 +051100 PERFORM WRT-LN. SQ1524.2 +051200 FAIL-ROUTINE. SQ1524.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1524.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1524.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1524.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +052000 GO TO FAIL-ROUTINE-EX. SQ1524.2 +052100 FAIL-ROUTINE-WRITE. SQ1524.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ1524.2 +052300 PERFORM WRITE-LINE SQ1524.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1524.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ1524.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1524.2 +052800 FAIL-ROUTINE-EX. SQ1524.2 +052900 EXIT. SQ1524.2 +053000 BAIL-OUT. SQ1524.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1524.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1524.2 +053300 BAIL-OUT-WRITE. SQ1524.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ1524.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1524.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +054000 BAIL-OUT-EX. SQ1524.2 +054100 EXIT. SQ1524.2 +054200 CCVS1-EXIT. SQ1524.2 +054300 EXIT. SQ1524.2 +054400* SQ1524.2 +054500**************************************************************** SQ1524.2 +054600* * SQ1524.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1524.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1524.2 +054900* * SQ1524.2 +055000**************************************************************** SQ1524.2 +055100* SQ1524.2 +055200 SECT-SQ152A-0001 SECTION. SQ1524.2 +055300 WRITE-INIT-GF-01. SQ1524.2 +055400* SQ1524.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1524.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1524.2 +055700* SQ1524.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1524.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1524.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1524.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ1524.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1524.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ1524.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1524.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1524.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ1524.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ1524.2 +056800* SQ1524.2 +056900 WRITE-OPEN-01. SQ1524.2 +057000 OPEN OUTPUT SQ-FS1. SQ1524.2 +057100 WRITE-INIT-01. SQ1524.2 +057200 WRITE-TEST-01-01. SQ1524.2 +057300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1524.2 +057400 WRITE SQ-FS1R1-F-G-120. SQ1524.2 +057500 CLOSE-INIT-01. SQ1524.2 +057600 CLOSE-TEST-01. SQ1524.2 +057700 CLOSE SQ-FS1. SQ1524.2 +057800 OPEN-INIT-01. SQ1524.2 +057900* SQ1524.2 +058000 OPEN-TEST-01. SQ1524.2 +058100 OPEN INPUT SQ-FS1. SQ1524.2 +058200* SQ1524.2 +058300* THIS TEST OPENS THE FILE JUST CREATED IN THE INPUT SQ1524.2 +058400* MODE. WE ATTEMPT TO WRITE ANOTHER RECORD AND EXAMINE SQ1524.2 +058500* IN A DECLARACTIVE THE I-O STATUS RETURNED. IT IS SQ1524.2 +058600* POSSIBLE THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ1524.2 +058700* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. SQ1524.2 +058800* THE RECORD NUMBER FIELD IN THE RECORD TO BE WRITTEN IS SQ1524.2 +058900* CHANGED FROM THAT IN THE RECORD ORIGINALLY WRITTEN, TO SQ1524.2 +059000* AID IN ESTABLISHING THE ORIGIN OF THE RECORD IN ANY SQ1524.2 +059100* SUBSEQUENT EXAMINATION OF THE FILE. SQ1524.2 +059200* SQ1524.2 +059300 WRITE-INIT-02. SQ1524.2 +059400 MOVE 1 TO REC-CT. SQ1524.2 +059500 MOVE "WRITE-TEST-02" TO PAR-NAME SQ1524.2 +059600 MOVE "WRITE TO INPUT FILE" TO FEATURE. SQ1524.2 +059700 MOVE 2 TO XRECORD-NUMBER (1). SQ1524.2 +059800 WRITE-TEST-02-01. SQ1524.2 +059900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1524.2 +060000 WRITE SQ-FS1R1-F-G-120. SQ1524.2 +060100 CLOSE-INIT-02. SQ1524.2 +060200 CLOSE-TEST-02. SQ1524.2 +060300 CLOSE SQ-FS1. SQ1524.2 +060400* SQ1524.2 +060500 CCVS-EXIT SECTION. SQ1524.2 +060600 CCVS-999999. SQ1524.2 +060700 GO TO CLOSE-FILES. SQ1524.2 +*END-OF,SQ152A +*HEADER,COBOL,SQ153A +000100 IDENTIFICATION DIVISION. SQ1534.2 +000200 PROGRAM-ID. SQ1534.2 +000300 SQ153A. SQ1534.2 +000400**************************************************************** SQ1534.2 +000500* * SQ1534.2 +000600* VALIDATION FOR:- * SQ1534.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +000800* USING CCVS85 VERSION 3.0. * SQ1534.2 +000900* * SQ1534.2 +001000* CREATION DATE / VALIDATION DATE * SQ1534.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1534.2 +001200* * SQ1534.2 +001300**************************************************************** SQ1534.2 +001400* * SQ1534.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1534.2 +001600* * SQ1534.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1534.2 +001800* X-55 SYSTEM PRINTER * SQ1534.2 +001900* X-82 SOURCE-COMPUTER * SQ1534.2 +002000* X-83 OBJECT-COMPUTER * SQ1534.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1534.2 +002200* * SQ1534.2 +002300**************************************************************** SQ1534.2 +002400* * SQ1534.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1534.2 +002600* A FILE OPEN IN THE I-O MODE. THE TEST FOR CORRECT I-O * SQ1534.2 +002700* STATUS 48 IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION* SQ1534.2 +002800* IS POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1534.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1534.2 +003000* LINE CODE. * SQ1534.2 +003100* * SQ1534.2 +003200**************************************************************** SQ1534.2 +003300* SQ1534.2 +003400 ENVIRONMENT DIVISION. SQ1534.2 +003500 CONFIGURATION SECTION. SQ1534.2 +003600 SOURCE-COMPUTER. SQ1534.2 +003700 XXXXX082. SQ1534.2 +003800 OBJECT-COMPUTER. SQ1534.2 +003900 XXXXX083. SQ1534.2 +004000* SQ1534.2 +004100 INPUT-OUTPUT SECTION. SQ1534.2 +004200 FILE-CONTROL. SQ1534.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1534.2 +004400 XXXXX055. SQ1534.2 +004500* SQ1534.2 +004600 SELECT SQ-FS4 SQ1534.2 +004700 ASSIGN SQ1534.2 +004800 XXXXX014 SQ1534.2 +004900 FILE STATUS SQ-FS4-STATUS SQ1534.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1534.2 +005100 . SQ1534.2 +005200* SQ1534.2 +005300* SQ1534.2 +005400 DATA DIVISION. SQ1534.2 +005500 FILE SECTION. SQ1534.2 +005600 FD PRINT-FILE SQ1534.2 +005700C LABEL RECORDS SQ1534.2 +005800C XXXXX084 SQ1534.2 +005900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1534.2 +006000 . SQ1534.2 +006100 01 PRINT-REC PICTURE X(120). SQ1534.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ1534.2 +006300* SQ1534.2 +006400 FD SQ-FS4 SQ1534.2 +006500C LABEL RECORD IS STANDARD SQ1534.2 +006600 BLOCK CONTAINS 120 CHARACTERS SQ1534.2 +006700 RECORD CONTAINS 120 CHARACTERS SQ1534.2 +006800 . SQ1534.2 +006900 01 SQ-FS4R1-F-G-120. SQ1534.2 +007000 05 FFILE-RECORD-INFO-P1-120 PICTURE X(120). SQ1534.2 +007100* SQ1534.2 +007200 WORKING-STORAGE SECTION. SQ1534.2 +007300* SQ1534.2 +007400*************************************************************** SQ1534.2 +007500* * SQ1534.2 +007600* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1534.2 +007700* * SQ1534.2 +007800*************************************************************** SQ1534.2 +007900* SQ1534.2 +008000 01 STATUS-GROUP. SQ1534.2 +008100 04 SQ-FS4-STATUS PICTURE XX. SQ1534.2 +008200* SQ1534.2 +008300*************************************************************** SQ1534.2 +008400* * SQ1534.2 +008500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1534.2 +008600* * SQ1534.2 +008700*************************************************************** SQ1534.2 +008800* SQ1534.2 +008900 01 FILE-RECORD-INFORMATION-REC. SQ1534.2 +009000 03 FILE-RECORD-INFO-SKELETON. SQ1534.2 +009100 05 FILLER PICTURE X(48) VALUE SQ1534.2 +009200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1534.2 +009300 05 FILLER PICTURE X(46) VALUE SQ1534.2 +009400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1534.2 +009500 05 FILLER PICTURE X(26) VALUE SQ1534.2 +009600 ",LFIL=000000,ORG= ,LBLR= ". SQ1534.2 +009700 05 FILLER PICTURE X(37) VALUE SQ1534.2 +009800 ",RECKEY= ". SQ1534.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1534.2 +010000 ",ALTKEY1= ". SQ1534.2 +010100 05 FILLER PICTURE X(38) VALUE SQ1534.2 +010200 ",ALTKEY2= ". SQ1534.2 +010300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1534.2 +010400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1534.2 +010500 05 FILE-RECORD-INFO-P1-120. SQ1534.2 +010600 07 FILLER PIC X(5). SQ1534.2 +010700 07 XFILE-NAME PIC X(6). SQ1534.2 +010800 07 FILLER PIC X(8). SQ1534.2 +010900 07 XRECORD-NAME PIC X(6). SQ1534.2 +011000 07 FILLER PIC X(1). SQ1534.2 +011100 07 REELUNIT-NUMBER PIC 9(1). SQ1534.2 +011200 07 FILLER PIC X(7). SQ1534.2 +011300 07 XRECORD-NUMBER PIC 9(6). SQ1534.2 +011400 07 FILLER PIC X(6). SQ1534.2 +011500 07 UPDATE-NUMBER PIC 9(2). SQ1534.2 +011600 07 FILLER PIC X(5). SQ1534.2 +011700 07 ODO-NUMBER PIC 9(4). SQ1534.2 +011800 07 FILLER PIC X(5). SQ1534.2 +011900 07 XPROGRAM-NAME PIC X(5). SQ1534.2 +012000 07 FILLER PIC X(7). SQ1534.2 +012100 07 XRECORD-LENGTH PIC 9(6). SQ1534.2 +012200 07 FILLER PIC X(7). SQ1534.2 +012300 07 CHARS-OR-RECORDS PIC X(2). SQ1534.2 +012400 07 FILLER PIC X(1). SQ1534.2 +012500 07 XBLOCK-SIZE PIC 9(4). SQ1534.2 +012600 07 FILLER PIC X(6). SQ1534.2 +012700 07 RECORDS-IN-FILE PIC 9(6). SQ1534.2 +012800 07 FILLER PIC X(5). SQ1534.2 +012900 07 XFILE-ORGANIZATION PIC X(2). SQ1534.2 +013000 07 FILLER PIC X(6). SQ1534.2 +013100 07 XLABEL-TYPE PIC X(1). SQ1534.2 +013200 05 FILE-RECORD-INFO-P121-240. SQ1534.2 +013300 07 FILLER PIC X(8). SQ1534.2 +013400 07 XRECORD-KEY PIC X(29). SQ1534.2 +013500 07 FILLER PIC X(9). SQ1534.2 +013600 07 ALTERNATE-KEY1 PIC X(29). SQ1534.2 +013700 07 FILLER PIC X(9). SQ1534.2 +013800 07 ALTERNATE-KEY2 PIC X(29). SQ1534.2 +013900 07 FILLER PIC X(7). SQ1534.2 +014000* SQ1534.2 +014100 01 TEST-RESULTS. SQ1534.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1534.2 +014300 02 PAR-NAME. SQ1534.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1534.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1534.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1534.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1534.2 +014800 02 FEATURE PIC X(24) VALUE SPACE. SQ1534.2 +014900 02 FILLER PIC X VALUE SPACE. SQ1534.2 +015000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1534.2 +015100 02 FILLER PIC X(9) VALUE SPACE. SQ1534.2 +015200 02 RE-MARK PIC X(61). SQ1534.2 +015300 01 TEST-COMPUTED. SQ1534.2 +015400 02 FILLER PIC X(30) VALUE SPACE. SQ1534.2 +015500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1534.2 +015600 02 COMPUTED-X. SQ1534.2 +015700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1534.2 +015800 03 FILLER PIC X(50) VALUE SPACE. SQ1534.2 +015900 01 TEST-CORRECT. SQ1534.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ1534.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1534.2 +016200 02 CORRECT-X. SQ1534.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1534.2 +016400 03 FILLER PIC X(2) VALUE SPACE. SQ1534.2 +016500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1534.2 +016600* SQ1534.2 +016700 01 CCVS-C-1. SQ1534.2 +016800 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +016900 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1534.2 +017000 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +017100 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1534.2 +017200 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +017300 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1534.2 +017400 02 FILLER PIC IS X(9) VALUE SPACE. SQ1534.2 +017500 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1534.2 +017600 01 CCVS-C-2. SQ1534.2 +017700 02 FILLER PIC X(19) VALUE SPACE. SQ1534.2 +017800 02 FILLER PIC X(6) VALUE "TESTED". SQ1534.2 +017900 02 FILLER PIC X(19) VALUE SPACE. SQ1534.2 +018000 02 FILLER PIC X(4) VALUE "FAIL". SQ1534.2 +018100 02 FILLER PIC X(72) VALUE SPACE. SQ1534.2 +018200* SQ1534.2 +018300 01 REC-CT PIC 99 VALUE ZERO. SQ1534.2 +018400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1534.2 +018900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1534.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1534.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1534.2 +019200 01 CCVS-H-1. SQ1534.2 +019300 02 FILLER PIC X(39) VALUE SPACES. SQ1534.2 +019400 02 FILLER PIC X(42) VALUE SQ1534.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1534.2 +019600 02 FILLER PIC X(39) VALUE SPACES. SQ1534.2 +019700 01 CCVS-H-2A. SQ1534.2 +019800 02 FILLER PIC X(40) VALUE SPACE. SQ1534.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1534.2 +020000 02 FILLER PIC XXXX VALUE SQ1534.2 +020100 "4.2 ". SQ1534.2 +020200 02 FILLER PIC X(28) VALUE SQ1534.2 +020300 " COPY - NOT FOR DISTRIBUTION". SQ1534.2 +020400 02 FILLER PIC X(41) VALUE SPACE. SQ1534.2 +020500* SQ1534.2 +020600 01 CCVS-H-2B. SQ1534.2 +020700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1534.2 +020800 02 TEST-ID PIC X(9). SQ1534.2 +020900 02 FILLER PIC X(4) VALUE " IN ". SQ1534.2 +021000 02 FILLER PIC X(12) VALUE SQ1534.2 +021100 " HIGH ". SQ1534.2 +021200 02 FILLER PIC X(22) VALUE SQ1534.2 +021300 " LEVEL VALIDATION FOR ". SQ1534.2 +021400 02 FILLER PIC X(58) VALUE SQ1534.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +021600 01 CCVS-H-3. SQ1534.2 +021700 02 FILLER PIC X(34) VALUE SQ1534.2 +021800 " FOR OFFICIAL USE ONLY ". SQ1534.2 +021900 02 FILLER PIC X(58) VALUE SQ1534.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1534.2 +022100 02 FILLER PIC X(28) VALUE SQ1534.2 +022200 " COPYRIGHT 1985,1986 ". SQ1534.2 +022300 01 CCVS-E-1. SQ1534.2 +022400 02 FILLER PIC X(52) VALUE SPACE. SQ1534.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1534.2 +022600 02 ID-AGAIN PIC X(9). SQ1534.2 +022700 02 FILLER PIC X(45) VALUE SPACES. SQ1534.2 +022800 01 CCVS-E-2. SQ1534.2 +022900 02 FILLER PIC X(31) VALUE SPACE. SQ1534.2 +023000 02 FILLER PIC X(21) VALUE SPACE. SQ1534.2 +023100 02 CCVS-E-2-2. SQ1534.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1534.2 +023300 03 FILLER PIC X VALUE SPACE. SQ1534.2 +023400 03 ENDER-DESC PIC X(44) VALUE SQ1534.2 +023500 "ERRORS ENCOUNTERED". SQ1534.2 +023600 01 CCVS-E-3. SQ1534.2 +023700 02 FILLER PIC X(22) VALUE SQ1534.2 +023800 " FOR OFFICIAL USE ONLY". SQ1534.2 +023900 02 FILLER PIC X(12) VALUE SPACE. SQ1534.2 +024000 02 FILLER PIC X(58) VALUE SQ1534.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +024200 02 FILLER PIC X(8) VALUE SPACE. SQ1534.2 +024300 02 FILLER PIC X(20) VALUE SQ1534.2 +024400 " COPYRIGHT 1985,1986". SQ1534.2 +024500 01 CCVS-E-4. SQ1534.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1534.2 +024700 02 FILLER PIC X(4) VALUE " OF ". SQ1534.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1534.2 +024900 02 FILLER PIC X(40) VALUE SQ1534.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1534.2 +025100 01 XXINFO. SQ1534.2 +025200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1534.2 +025300 02 INFO-TEXT. SQ1534.2 +025400 04 FILLER PIC X(8) VALUE SPACE. SQ1534.2 +025500 04 XXCOMPUTED PIC X(20). SQ1534.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ1534.2 +025700 04 XXCORRECT PIC X(20). SQ1534.2 +025800 02 INF-ANSI-REFERENCE PIC X(48). SQ1534.2 +025900 01 HYPHEN-LINE. SQ1534.2 +026000 02 FILLER PIC IS X VALUE IS SPACE. SQ1534.2 +026100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1534.2 +026200- "*****************************************". SQ1534.2 +026300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1534.2 +026400- "******************************". SQ1534.2 +026500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1534.2 +026600 "SQ153A". SQ1534.2 +026700* SQ1534.2 +026800* SQ1534.2 +026900 PROCEDURE DIVISION. SQ1534.2 +027000 DECLARATIVES. SQ1534.2 +027100* SQ1534.2 +027200 SECT-SQ153A-0001 SECTION. SQ1534.2 +027300 USE AFTER STANDARD EXCEPTION PROCEDURE I-O. SQ1534.2 +027400 O-ERROR-PROCESS. SQ1534.2 +027500 IF SQ-FS4-STATUS = "48" SQ1534.2 +027600 PERFORM DECL-PASS SQ1534.2 +027700 GO TO ABNORMAL-TERM-DECL SQ1534.2 +027800 ELSE SQ1534.2 +027900 MOVE "48" TO CORRECT-A SQ1534.2 +028000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1534.2 +028100 MOVE "STATUS FOR WRITE OF FILE OPEN I-O INCORRECT" SQ1534.2 +028200 TO RE-MARK SQ1534.2 +028300 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1534.2 +028400 PERFORM DECL-FAIL SQ1534.2 +028500 GO TO ABNORMAL-TERM-DECL SQ1534.2 +028600 END-IF. SQ1534.2 +028700* SQ1534.2 +028800* SQ1534.2 +028900 DECL-PASS. SQ1534.2 +029000 MOVE "PASS " TO P-OR-F. SQ1534.2 +029100 ADD 1 TO PASS-COUNTER. SQ1534.2 +029200 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +029300* SQ1534.2 +029400 DECL-FAIL. SQ1534.2 +029500 MOVE "FAIL*" TO P-OR-F. SQ1534.2 +029600 ADD 1 TO ERROR-COUNTER. SQ1534.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +029800* SQ1534.2 +029900 DECL-DE-LETE. SQ1534.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1534.2 +030100 MOVE "*****" TO P-OR-F. SQ1534.2 +030200 ADD 1 TO DELETE-COUNTER. SQ1534.2 +030300 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +030400* SQ1534.2 +030500 DECL-PRINT-DETAIL. SQ1534.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ1534.2 +030700 MOVE "." TO PARDOT-X SQ1534.2 +030800 MOVE REC-CT TO DOTVALUE. SQ1534.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ1534.2 +031000 PERFORM DECL-WRITE-LINE. SQ1534.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ1534.2 +031200 PERFORM DECL-WRITE-LINE SQ1534.2 +031300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1534.2 +031400 ELSE SQ1534.2 +031500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1534.2 +031600 MOVE SPACE TO P-OR-F. SQ1534.2 +031700 MOVE SPACE TO COMPUTED-X. SQ1534.2 +031800 MOVE SPACE TO CORRECT-X. SQ1534.2 +031900 IF REC-CT EQUAL TO ZERO SQ1534.2 +032000 MOVE SPACE TO PAR-NAME. SQ1534.2 +032100 MOVE SPACE TO RE-MARK. SQ1534.2 +032200* SQ1534.2 +032300 DECL-WRITE-LINE. SQ1534.2 +032400 ADD 1 TO RECORD-COUNT. SQ1534.2 +032500Y IF RECORD-COUNT GREATER 50 SQ1534.2 +032600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1534.2 +032700Y MOVE SPACE TO DUMMY-RECORD SQ1534.2 +032800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1534.2 +032900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1534.2 +033000Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ1534.2 +033100Y PERFORM DECL-WRT-LN 2 TIMES SQ1534.2 +033200Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1534.2 +033300Y PERFORM DECL-WRT-LN SQ1534.2 +033400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1534.2 +033500Y MOVE ZERO TO RECORD-COUNT. SQ1534.2 +033600 PERFORM DECL-WRT-LN. SQ1534.2 +033700* SQ1534.2 +033800 DECL-WRT-LN. SQ1534.2 +033900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1534.2 +034000 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +034100* SQ1534.2 +034200 DECL-FAIL-ROUTINE. SQ1534.2 +034300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1534.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1534.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +034600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1534.2 +034700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +034800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +034900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +035000 GO TO DECL-FAIL-EX. SQ1534.2 +035100 DECL-FAIL-WRITE. SQ1534.2 +035200 MOVE TEST-COMPUTED TO PRINT-REC SQ1534.2 +035300 PERFORM DECL-WRITE-LINE SQ1534.2 +035400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1534.2 +035500 MOVE TEST-CORRECT TO PRINT-REC SQ1534.2 +035600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +035700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1534.2 +035800 DECL-FAIL-EX. SQ1534.2 +035900 EXIT. SQ1534.2 +036000* SQ1534.2 +036100 DECL-BAIL. SQ1534.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1534.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1534.2 +036400 DECL-BAIL-WRITE. SQ1534.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ1534.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1534.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +036900 DECL-BAIL-EX. SQ1534.2 +037000 EXIT. SQ1534.2 +037100* SQ1534.2 +037200 ABNORMAL-TERM-DECL. SQ1534.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +037400 PERFORM DECL-WRITE-LINE. SQ1534.2 +037500 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1534.2 +037600 TO DUMMY-RECORD. SQ1534.2 +037700 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1534.2 +037800* SQ1534.2 +037900 END DECLARATIVES. SQ1534.2 +038000* SQ1534.2 +038100* SQ1534.2 +038200 CCVS1 SECTION. SQ1534.2 +038300 OPEN-FILES. SQ1534.2 +038400 OPEN OUTPUT PRINT-FILE. SQ1534.2 +038500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1534.2 +038600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1534.2 +038700 MOVE SPACE TO TEST-RESULTS. SQ1534.2 +038800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1534.2 +038900 GO TO CCVS1-EXIT. SQ1534.2 +039000* SQ1534.2 +039100 CLOSE-FILES. SQ1534.2 +039200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1534.2 +039300 CLOSE PRINT-FILE. SQ1534.2 +039400 TERMINATE-CCVS. SQ1534.2 +039500 STOP RUN. SQ1534.2 +039600* SQ1534.2 +039700 INSPT. SQ1534.2 +039800 MOVE "INSPT" TO P-OR-F. SQ1534.2 +039900 ADD 1 TO INSPECT-COUNTER. SQ1534.2 +040000 PERFORM PRINT-DETAIL. SQ1534.2 +040100* SQ1534.2 +040200 PASS. SQ1534.2 +040300 MOVE "PASS " TO P-OR-F. SQ1534.2 +040400 ADD 1 TO PASS-COUNTER. SQ1534.2 +040500 PERFORM PRINT-DETAIL. SQ1534.2 +040600* SQ1534.2 +040700 FAIL. SQ1534.2 +040800 MOVE "FAIL*" TO P-OR-F. SQ1534.2 +040900 ADD 1 TO ERROR-COUNTER. SQ1534.2 +041000 PERFORM PRINT-DETAIL. SQ1534.2 +041100* SQ1534.2 +041200 DE-LETE. SQ1534.2 +041300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1534.2 +041400 MOVE "*****" TO P-OR-F. SQ1534.2 +041500 ADD 1 TO DELETE-COUNTER. SQ1534.2 +041600 PERFORM PRINT-DETAIL. SQ1534.2 +041700* SQ1534.2 +041800 PRINT-DETAIL. SQ1534.2 +041900 IF REC-CT NOT EQUAL TO ZERO SQ1534.2 +042000 MOVE "." TO PARDOT-X SQ1534.2 +042100 MOVE REC-CT TO DOTVALUE. SQ1534.2 +042200 MOVE TEST-RESULTS TO PRINT-REC. SQ1534.2 +042300 PERFORM WRITE-LINE. SQ1534.2 +042400 IF P-OR-F EQUAL TO "FAIL*" SQ1534.2 +042500 PERFORM WRITE-LINE SQ1534.2 +042600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1534.2 +042700 ELSE SQ1534.2 +042800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1534.2 +042900 MOVE SPACE TO P-OR-F. SQ1534.2 +043000 MOVE SPACE TO COMPUTED-X. SQ1534.2 +043100 MOVE SPACE TO CORRECT-X. SQ1534.2 +043200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1534.2 +043300 MOVE SPACE TO RE-MARK. SQ1534.2 +043400* SQ1534.2 +043500 HEAD-ROUTINE. SQ1534.2 +043600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +043700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +043800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1534.2 +043900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1534.2 +044000 COLUMN-NAMES-ROUTINE. SQ1534.2 +044100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +044200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +044300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +044400 END-ROUTINE. SQ1534.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1534.2 +044600 PERFORM WRITE-LINE 5 TIMES. SQ1534.2 +044700 END-RTN-EXIT. SQ1534.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1534.2 +044900 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +045000* SQ1534.2 +045100 END-ROUTINE-1. SQ1534.2 +045200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1534.2 +045300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1534.2 +045400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1534.2 +045500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1534.2 +045600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1534.2 +045700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1534.2 +045800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1534.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1534.2 +046000 PERFORM WRITE-LINE. SQ1534.2 +046100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1534.2 +046200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1534.2 +046300 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +046400 ELSE SQ1534.2 +046500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1534.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1534.2 +046700 PERFORM WRITE-LINE. SQ1534.2 +046800 END-ROUTINE-13. SQ1534.2 +046900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1534.2 +047000 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +047100 ELSE SQ1534.2 +047200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1534.2 +047300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1534.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1534.2 +047500 PERFORM WRITE-LINE. SQ1534.2 +047600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1534.2 +047700 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +047800 ELSE SQ1534.2 +047900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1534.2 +048000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1534.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +048200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +048300* SQ1534.2 +048400 WRITE-LINE. SQ1534.2 +048500 ADD 1 TO RECORD-COUNT. SQ1534.2 +048600Y IF RECORD-COUNT GREATER 50 SQ1534.2 +048700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1534.2 +048800Y MOVE SPACE TO DUMMY-RECORD SQ1534.2 +048900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1534.2 +049000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1534.2 +049100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1534.2 +049200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1534.2 +049300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1534.2 +049400Y MOVE ZERO TO RECORD-COUNT. SQ1534.2 +049500 PERFORM WRT-LN. SQ1534.2 +049600* SQ1534.2 +049700 WRT-LN. SQ1534.2 +049800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1534.2 +049900 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +050000 BLANK-LINE-PRINT. SQ1534.2 +050100 PERFORM WRT-LN. SQ1534.2 +050200 FAIL-ROUTINE. SQ1534.2 +050300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1534.2 +050400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1534.2 +050500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +050600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1534.2 +050700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +050800 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +051000 GO TO FAIL-ROUTINE-EX. SQ1534.2 +051100 FAIL-ROUTINE-WRITE. SQ1534.2 +051200 MOVE TEST-COMPUTED TO PRINT-REC SQ1534.2 +051300 PERFORM WRITE-LINE SQ1534.2 +051400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1534.2 +051500 MOVE TEST-CORRECT TO PRINT-REC SQ1534.2 +051600 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1534.2 +051800 FAIL-ROUTINE-EX. SQ1534.2 +051900 EXIT. SQ1534.2 +052000 BAIL-OUT. SQ1534.2 +052100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1534.2 +052200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1534.2 +052300 BAIL-OUT-WRITE. SQ1534.2 +052400 MOVE CORRECT-A TO XXCORRECT. SQ1534.2 +052500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1534.2 +052600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +052700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +052800 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +052900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +053000 BAIL-OUT-EX. SQ1534.2 +053100 EXIT. SQ1534.2 +053200 CCVS1-EXIT. SQ1534.2 +053300 EXIT. SQ1534.2 +053400* SQ1534.2 +053500**************************************************************** SQ1534.2 +053600* * SQ1534.2 +053700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1534.2 +053800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1534.2 +053900* * SQ1534.2 +054000**************************************************************** SQ1534.2 +054100* SQ1534.2 +054200 SECT-SQ153A-0002 SECTION. SQ1534.2 +054300* SQ1534.2 +054400* THIS TEST CREATES FILE SQ-FS4 AND CLOSES IT. SQ1534.2 +054500* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1534.2 +054600* SQ1534.2 +054700 WRITE-INIT-GF-01. SQ1534.2 +054800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1534.2 +054900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1534.2 +055000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1534.2 +055100 MOVE 120 TO XRECORD-LENGTH (1). SQ1534.2 +055200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1534.2 +055300 MOVE 1 TO XBLOCK-SIZE (1). SQ1534.2 +055400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1534.2 +055500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1534.2 +055600 MOVE "S" TO XLABEL-TYPE (1). SQ1534.2 +055700 MOVE 1 TO XRECORD-NUMBER (1). SQ1534.2 +055800* SQ1534.2 +055900 WRITE-OPEN-01. SQ1534.2 +056000 OPEN OUTPUT SQ-FS4. SQ1534.2 +056100* SQ1534.2 +056200 WRITE-TEST-01-01. SQ1534.2 +056300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1534.2 +056400 WRITE SQ-FS4R1-F-G-120. SQ1534.2 +056500* SQ1534.2 +056600 CLOSE-TEST-01. SQ1534.2 +056700 CLOSE SQ-FS4. SQ1534.2 +056800* SQ1534.2 +056900 OPEN-TEST-02. SQ1534.2 +057000 OPEN I-O SQ-FS4. SQ1534.2 +057100* SQ1534.2 +057200* THIS TEST OPENS THE FILE JUST CREATED IN THE I-O MODE. SQ1534.2 +057300* WE ATTEMPT TO WRITE ANOTHER RECORD AND EXAMINE IN A SQ1534.2 +057400* DECLARATIVE THE I-O STATUS RETURNED. IT IS POSSIBLE SQ1534.2 +057500* THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ1534.2 +057600* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. THE SQ1534.2 +057700* RECORD NUMBER FIELD IN THE RECORD TO BE WRITTEN IS SQ1534.2 +057800* CHANGED FROM THAT IN THE RECORD ORIGINALLY WRITTEN TO SQ1534.2 +057900* AID IN ESTABLISHING THE ORIGIN OF THE RECORD IN ANY SQ1534.2 +058000* SUBSEQUENT EXAMINATION OF THE FILE. SQ1534.2 +058100* SQ1534.2 +058200 WRITE-INIT-02. SQ1534.2 +058300 MOVE 1 TO REC-CT. SQ1534.2 +058400 MOVE "WRITE-TEST-02" TO PAR-NAME. SQ1534.2 +058500 MOVE "WRITE TO I-O FILE" TO FEATURE. SQ1534.2 +058600 MOVE 2 TO XRECORD-NUMBER (1). SQ1534.2 +058700 WRITE-TEST-02. SQ1534.2 +058800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1534.2 +058900 WRITE SQ-FS4R1-F-G-120. SQ1534.2 +059000* SQ1534.2 +059100 CLOSE-TEST-02. SQ1534.2 +059200 CLOSE SQ-FS4. SQ1534.2 +059300* SQ1534.2 +059400 CCVS-EXIT SECTION. SQ1534.2 +059500 CCVS-999999. SQ1534.2 +059600 GO TO CLOSE-FILES. SQ1534.2 +*END-OF,SQ153A +*HEADER,COBOL,SQ154A +000100 IDENTIFICATION DIVISION. SQ1544.2 +000200 PROGRAM-ID. SQ1544.2 +000300 SQ154A. SQ1544.2 +000400**************************************************************** SQ1544.2 +000500* * SQ1544.2 +000600* VALIDATION FOR:- * SQ1544.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +000800* USING CCVS85 VERSION 3.0. * SQ1544.2 +000900* * SQ1544.2 +001000* CREATION DATE / VALIDATION DATE * SQ1544.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1544.2 +001200* * SQ1544.2 +001300**************************************************************** SQ1544.2 +001400* * SQ1544.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1544.2 +001600* * SQ1544.2 +001700* X-01 SEQUENTIAL TAPE * SQ1544.2 +001800* X-55 SYSTEM PRINTER * SQ1544.2 +001900* X-82 SOURCE-COMPUTER * SQ1544.2 +002000* X-83 OBJECT-COMPUTER * SQ1544.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1544.2 +002200* * SQ1544.2 +002300**************************************************************** SQ1544.2 +002400* * SQ1544.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1544.2 +002600* A FILE THAT IS NOT OPEN (NOT OPEN IN THE OUTPUT OR EXTEND * SQ1544.2 +002700* MODE). THE TEST FOR CORRECT I-O STATUS CODE 48 IS IN THE * SQ1544.2 +002800* MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ1544.2 +002900* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ1544.2 +003000* ACCOMPLISHED. * SQ1544.2 +003100* * SQ1544.2 +003200**************************************************************** SQ1544.2 +003300* SQ1544.2 +003400 ENVIRONMENT DIVISION. SQ1544.2 +003500 CONFIGURATION SECTION. SQ1544.2 +003600 SOURCE-COMPUTER. SQ1544.2 +003700 XXXXX082. SQ1544.2 +003800 OBJECT-COMPUTER. SQ1544.2 +003900 XXXXX083. SQ1544.2 +004000* SQ1544.2 +004100 INPUT-OUTPUT SECTION. SQ1544.2 +004200 FILE-CONTROL. SQ1544.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1544.2 +004400 XXXXX055. SQ1544.2 +004500* SQ1544.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1544.2 +004700 XXXXX001 SQ1544.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1544.2 +004900* SQ1544.2 +005000* SQ1544.2 +005100 DATA DIVISION. SQ1544.2 +005200 FILE SECTION. SQ1544.2 +005300 FD PRINT-FILE SQ1544.2 +005400C LABEL RECORDS SQ1544.2 +005500C XXXXX084 SQ1544.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1544.2 +005700 . SQ1544.2 +005800 01 PRINT-REC PICTURE X(120). SQ1544.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1544.2 +006000* SQ1544.2 +006100 FD SQ-FS1 SQ1544.2 +006200C LABEL RECORD IS STANDARD SQ1544.2 +006300 . SQ1544.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1544.2 +006500* SQ1544.2 +006600 WORKING-STORAGE SECTION. SQ1544.2 +006700* SQ1544.2 +006800*************************************************************** SQ1544.2 +006900* * SQ1544.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1544.2 +007100* * SQ1544.2 +007200*************************************************************** SQ1544.2 +007300* SQ1544.2 +007400 01 SQ-FS1-STATUS. SQ1544.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1544.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1544.2 +007700* SQ1544.2 +007800*************************************************************** SQ1544.2 +007900* * SQ1544.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1544.2 +008100* * SQ1544.2 +008200*************************************************************** SQ1544.2 +008300* SQ1544.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1544.2 +008500* SQ1544.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1544.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1544.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1544.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1544.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1544.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1544.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1544.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1544.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1544.2 +009500 ",RECKEY= ". SQ1544.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1544.2 +009700 ",ALTKEY1= ". SQ1544.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1544.2 +009900 ",ALTKEY2= ". SQ1544.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1544.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1544.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1544.2 +010300 07 FILLER PIC X(5). SQ1544.2 +010400 07 XFILE-NAME PIC X(6). SQ1544.2 +010500 07 FILLER PIC X(8). SQ1544.2 +010600 07 XRECORD-NAME PIC X(6). SQ1544.2 +010700 07 FILLER PIC X(1). SQ1544.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1544.2 +010900 07 FILLER PIC X(7). SQ1544.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1544.2 +011100 07 FILLER PIC X(6). SQ1544.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1544.2 +011300 07 FILLER PIC X(5). SQ1544.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1544.2 +011500 07 FILLER PIC X(5). SQ1544.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1544.2 +011700 07 FILLER PIC X(7). SQ1544.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1544.2 +011900 07 FILLER PIC X(7). SQ1544.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1544.2 +012100 07 FILLER PIC X(1). SQ1544.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1544.2 +012300 07 FILLER PIC X(6). SQ1544.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1544.2 +012500 07 FILLER PIC X(5). SQ1544.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1544.2 +012700 07 FILLER PIC X(6). SQ1544.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1544.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1544.2 +013000 07 FILLER PIC X(8). SQ1544.2 +013100 07 XRECORD-KEY PIC X(29). SQ1544.2 +013200 07 FILLER PIC X(9). SQ1544.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1544.2 +013400 07 FILLER PIC X(9). SQ1544.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1544.2 +013600 07 FILLER PIC X(7). SQ1544.2 +013700* SQ1544.2 +013800 01 TEST-RESULTS. SQ1544.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1544.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1544.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014400 02 PAR-NAME. SQ1544.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1544.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1544.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1544.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1544.2 +014900 02 RE-MARK PIC X(61). SQ1544.2 +015000 01 TEST-COMPUTED. SQ1544.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1544.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1544.2 +015300 02 COMPUTED-X. SQ1544.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1544.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1544.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1544.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1544.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1544.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1544.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1544.2 +016100 04 FILLER PIC X. SQ1544.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1544.2 +016300 01 TEST-CORRECT. SQ1544.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1544.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1544.2 +016600 02 CORRECT-X. SQ1544.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1544.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1544.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1544.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1544.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1544.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1544.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1544.2 +017400 04 FILLER PIC X. SQ1544.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1544.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1544.2 +017700 01 CCVS-C-1. SQ1544.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1544.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1544.2 +018000- "SS PARAGRAPH-NAME SQ1544.2 +018100- " REMARKS". SQ1544.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1544.2 +018300 01 CCVS-C-2. SQ1544.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1544.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1544.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1544.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1544.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1544.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1544.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1544.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1544.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1544.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1544.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1544.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1544.2 +020000 01 CCVS-H-1. SQ1544.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1544.2 +020200 02 FILLER PIC X(42) VALUE SQ1544.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1544.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1544.2 +020500 01 CCVS-H-2A. SQ1544.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1544.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1544.2 +020800 02 FILLER PIC XXXX VALUE SQ1544.2 +020900 "4.2 ". SQ1544.2 +021000 02 FILLER PIC X(28) VALUE SQ1544.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1544.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1544.2 +021300* SQ1544.2 +021400 01 CCVS-H-2B. SQ1544.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1544.2 +021600 02 TEST-ID PIC X(9). SQ1544.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1544.2 +021800 02 FILLER PIC X(12) VALUE SQ1544.2 +021900 " HIGH ". SQ1544.2 +022000 02 FILLER PIC X(22) VALUE SQ1544.2 +022100 " LEVEL VALIDATION FOR ". SQ1544.2 +022200 02 FILLER PIC X(58) VALUE SQ1544.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +022400 01 CCVS-H-3. SQ1544.2 +022500 02 FILLER PIC X(34) VALUE SQ1544.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1544.2 +022700 02 FILLER PIC X(58) VALUE SQ1544.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1544.2 +022900 02 FILLER PIC X(28) VALUE SQ1544.2 +023000 " COPYRIGHT 1985,1986 ". SQ1544.2 +023100 01 CCVS-E-1. SQ1544.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1544.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1544.2 +023400 02 ID-AGAIN PIC X(9). SQ1544.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1544.2 +023600 01 CCVS-E-2. SQ1544.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1544.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1544.2 +023900 02 CCVS-E-2-2. SQ1544.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1544.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1544.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1544.2 +024300 "ERRORS ENCOUNTERED". SQ1544.2 +024400 01 CCVS-E-3. SQ1544.2 +024500 02 FILLER PIC X(22) VALUE SQ1544.2 +024600 " FOR OFFICIAL USE ONLY". SQ1544.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1544.2 +024800 02 FILLER PIC X(58) VALUE SQ1544.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1544.2 +025100 02 FILLER PIC X(20) VALUE SQ1544.2 +025200 " COPYRIGHT 1985,1986". SQ1544.2 +025300 01 CCVS-E-4. SQ1544.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1544.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1544.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1544.2 +025700 02 FILLER PIC X(40) VALUE SQ1544.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1544.2 +025900 01 XXINFO. SQ1544.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1544.2 +026100 02 INFO-TEXT. SQ1544.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1544.2 +026300 04 XXCOMPUTED PIC X(20). SQ1544.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1544.2 +026500 04 XXCORRECT PIC X(20). SQ1544.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1544.2 +026700 01 HYPHEN-LINE. SQ1544.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1544.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1544.2 +027000- "*****************************************". SQ1544.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1544.2 +027200- "******************************". SQ1544.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1544.2 +027400 "SQ154A". SQ1544.2 +027500* SQ1544.2 +027600 PROCEDURE DIVISION. SQ1544.2 +027700 CCVS1 SECTION. SQ1544.2 +027800 OPEN-FILES. SQ1544.2 +027900 OPEN OUTPUT PRINT-FILE. SQ1544.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1544.2 +028100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1544.2 +028200 MOVE SPACE TO TEST-RESULTS. SQ1544.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1544.2 +028400 MOVE ZERO TO REC-SKEL-SUB. SQ1544.2 +028500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1544.2 +028600 GO TO CCVS1-EXIT. SQ1544.2 +028700* SQ1544.2 +028800 CCVS-INIT-FILE. SQ1544.2 +028900 ADD 1 TO REC-SKL-SUB. SQ1544.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1544.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1544.2 +029200* SQ1544.2 +029300 CLOSE-FILES. SQ1544.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1544.2 +029500 CLOSE PRINT-FILE. SQ1544.2 +029600 TERMINATE-CCVS. SQ1544.2 +029700 STOP RUN. SQ1544.2 +029800* SQ1544.2 +029900 INSPT. SQ1544.2 +030000 MOVE "INSPT" TO P-OR-F. SQ1544.2 +030100 ADD 1 TO INSPECT-COUNTER. SQ1544.2 +030200 PERFORM PRINT-DETAIL. SQ1544.2 +030300 SQ1544.2 +030400 PASS. SQ1544.2 +030500 MOVE "PASS " TO P-OR-F. SQ1544.2 +030600 ADD 1 TO PASS-COUNTER. SQ1544.2 +030700 PERFORM PRINT-DETAIL. SQ1544.2 +030800* SQ1544.2 +030900 FAIL. SQ1544.2 +031000 MOVE "FAIL*" TO P-OR-F. SQ1544.2 +031100 ADD 1 TO ERROR-COUNTER. SQ1544.2 +031200 PERFORM PRINT-DETAIL. SQ1544.2 +031300* SQ1544.2 +031400 DE-LETE. SQ1544.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1544.2 +031600 MOVE "*****" TO P-OR-F. SQ1544.2 +031700 ADD 1 TO DELETE-COUNTER. SQ1544.2 +031800 PERFORM PRINT-DETAIL. SQ1544.2 +031900* SQ1544.2 +032000 PRINT-DETAIL. SQ1544.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1544.2 +032200 MOVE "." TO PARDOT-X SQ1544.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1544.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. SQ1544.2 +032500 PERFORM WRITE-LINE. SQ1544.2 +032600 IF P-OR-F EQUAL TO "FAIL*" SQ1544.2 +032700 PERFORM WRITE-LINE SQ1544.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1544.2 +032900 ELSE SQ1544.2 +033000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1544.2 +033100 MOVE SPACE TO P-OR-F. SQ1544.2 +033200 MOVE SPACE TO COMPUTED-X. SQ1544.2 +033300 MOVE SPACE TO CORRECT-X. SQ1544.2 +033400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1544.2 +033500 MOVE SPACE TO RE-MARK. SQ1544.2 +033600* SQ1544.2 +033700 HEAD-ROUTINE. SQ1544.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +034200 COLUMN-NAMES-ROUTINE. SQ1544.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +034600 END-ROUTINE. SQ1544.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1544.2 +034800 PERFORM WRITE-LINE 5 TIMES. SQ1544.2 +034900 END-RTN-EXIT. SQ1544.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1544.2 +035100 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +035200* SQ1544.2 +035300 END-ROUTINE-1. SQ1544.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1544.2 +035500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1544.2 +035600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1544.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1544.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1544.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1544.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1544.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1544.2 +036200 PERFORM WRITE-LINE. SQ1544.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1544.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1544.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +036600 ELSE SQ1544.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1544.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1544.2 +036900 PERFORM WRITE-LINE. SQ1544.2 +037000 END-ROUTINE-13. SQ1544.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1544.2 +037200 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +037300 ELSE SQ1544.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1544.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1544.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1544.2 +037700 PERFORM WRITE-LINE. SQ1544.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1544.2 +037900 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +038000 ELSE SQ1544.2 +038100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1544.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1544.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +038500* SQ1544.2 +038600 WRITE-LINE. SQ1544.2 +038700 ADD 1 TO RECORD-COUNT. SQ1544.2 +038800Y IF RECORD-COUNT GREATER 50 SQ1544.2 +038900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1544.2 +039000Y MOVE SPACE TO DUMMY-RECORD SQ1544.2 +039100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1544.2 +039200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1544.2 +039300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1544.2 +039400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1544.2 +039500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1544.2 +039600Y MOVE ZERO TO RECORD-COUNT. SQ1544.2 +039700 PERFORM WRT-LN. SQ1544.2 +039800* SQ1544.2 +039900 WRT-LN. SQ1544.2 +040000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1544.2 +040100 MOVE SPACE TO DUMMY-RECORD. SQ1544.2 +040200 BLANK-LINE-PRINT. SQ1544.2 +040300 PERFORM WRT-LN. SQ1544.2 +040400 FAIL-ROUTINE. SQ1544.2 +040500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1544.2 +040600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1544.2 +040700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1544.2 +040800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1544.2 +040900 MOVE XXINFO TO DUMMY-RECORD. SQ1544.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +041100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1544.2 +041200 GO TO FAIL-ROUTINE-EX. SQ1544.2 +041300 FAIL-ROUTINE-WRITE. SQ1544.2 +041400 MOVE TEST-COMPUTED TO PRINT-REC SQ1544.2 +041500 PERFORM WRITE-LINE SQ1544.2 +041600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1544.2 +041700 MOVE TEST-CORRECT TO PRINT-REC SQ1544.2 +041800 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +041900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1544.2 +042000 FAIL-ROUTINE-EX. SQ1544.2 +042100 EXIT. SQ1544.2 +042200 BAIL-OUT. SQ1544.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1544.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1544.2 +042500 BAIL-OUT-WRITE. SQ1544.2 +042600 MOVE CORRECT-A TO XXCORRECT. SQ1544.2 +042700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1544.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1544.2 +042900 MOVE XXINFO TO DUMMY-RECORD. SQ1544.2 +043000 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1544.2 +043200 BAIL-OUT-EX. SQ1544.2 +043300 EXIT. SQ1544.2 +043400 CCVS1-EXIT. SQ1544.2 +043500 EXIT. SQ1544.2 +043600* SQ1544.2 +043700**************************************************************** SQ1544.2 +043800* * SQ1544.2 +043900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1544.2 +044000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1544.2 +044100* * SQ1544.2 +044200**************************************************************** SQ1544.2 +044300* SQ1544.2 +044400 SECT-SQ154A-0001 SECTION. SQ1544.2 +044500 WRITE-INIT-GF-01. SQ1544.2 +044600* SQ1544.2 +044700* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1544.2 +044800* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1544.2 +044900* SQ1544.2 +045000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1544.2 +045100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1544.2 +045200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1544.2 +045300 MOVE 120 TO XRECORD-LENGTH (1). SQ1544.2 +045400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1544.2 +045500 MOVE 1 TO XBLOCK-SIZE (1). SQ1544.2 +045600 MOVE 1 TO RECORDS-IN-FILE (1). SQ1544.2 +045700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1544.2 +045800 MOVE "S" TO XLABEL-TYPE (1). SQ1544.2 +045900 MOVE 1 TO XRECORD-NUMBER (1). SQ1544.2 +046000* SQ1544.2 +046100 WRITE-OPEN-01. SQ1544.2 +046200 OPEN OUTPUT SQ-FS1. SQ1544.2 +046300* SQ1544.2 +046400* WRITE A SINGLE RECORD TO THE FILE SQ1544.2 +046500* SQ1544.2 +046600 WRITE-TEST-01-01. SQ1544.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1544.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ1544.2 +046900* SQ1544.2 +047000* CLOSE THE FILE. SQ1544.2 +047100* SQ1544.2 +047200 CLOSE-INIT-01. SQ1544.2 +047300 CLOSE-TEST-01. SQ1544.2 +047400 CLOSE SQ-FS1. SQ1544.2 +047500* SQ1544.2 +047600 WRITE-INIT-01. SQ1544.2 +047700* WE WILL NOW ATTEMPT TO WRITE A RECORD TO THE SQ1544.2 +047800* CLOSED FILE. I-O STATUS 48 SHOULD BE GENERATED. SQ1544.2 +047900* SQ1544.2 +048000 MOVE "WRITE TO CLOSED FILE" TO FEATURE. SQ1544.2 +048100 MOVE "**" TO SQ-FS1-STATUS. SQ1544.2 +048200 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1544.2 +048300 MOVE 1 TO REC-CT. SQ1544.2 +048400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1544.2 +048500 TO DUMMY-RECORD SQ1544.2 +048600 PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +048700* SQ1544.2 +048800 WRITE-TEST-01. SQ1544.2 +048900 WRITE SQ-FS1R1-F-G-120. SQ1544.2 +049000 IF SQ-FS1-STATUS = "48" SQ1544.2 +049100 PERFORM PASS SQ1544.2 +049200 ELSE SQ1544.2 +049300 MOVE "48" TO CORRECT-A SQ1544.2 +049400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1544.2 +049500 MOVE "STATUS FOR WRITE TO CLOSED FILE INCORRECT" SQ1544.2 +049600 TO RE-MARK SQ1544.2 +049700 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1544.2 +049800 PERFORM FAIL SQ1544.2 +049900 END-IF. SQ1544.2 +050000* SQ1544.2 +050100 CCVS-EXIT SECTION. SQ1544.2 +050200 CCVS-999999. SQ1544.2 +050300 GO TO CLOSE-FILES. SQ1544.2 +*END-OF,SQ154A +*HEADER,COBOL,SQ155A +000100 IDENTIFICATION DIVISION. SQ1554.2 +000200 PROGRAM-ID. SQ1554.2 +000300 SQ155A. SQ1554.2 +000400**************************************************************** SQ1554.2 +000500* * SQ1554.2 +000600* VALIDATION FOR:- * SQ1554.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +000800* USING CCVS85 VERSION 3.0. * SQ1554.2 +000900* * SQ1554.2 +001000* CREATION DATE / VALIDATION DATE * SQ1554.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1554.2 +001200* * SQ1554.2 +001300**************************************************************** SQ1554.2 +001400* * SQ1554.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1554.2 +001600* * SQ1554.2 +001700* X-01 SEQUENTIAL TAPE * SQ1554.2 +001800* X-55 SYSTEM PRINTER * SQ1554.2 +001900* X-82 SOURCE-COMPUTER * SQ1554.2 +002000* X-83 OBJECT-COMPUTER * SQ1554.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1554.2 +002200* * SQ1554.2 +002300**************************************************************** SQ1554.2 +002400* * SQ1554.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1554.2 +002600* A FILE OPEN IN THE INPUT MODE. THE TEST FOR CORRECT I-O * SQ1554.2 +002700* STATUS 48 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1554.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1554.2 +002900* CODE IS ACCOMPLISHED. * SQ1554.2 +003000* * SQ1554.2 +003100**************************************************************** SQ1554.2 +003200* SQ1554.2 +003300 ENVIRONMENT DIVISION. SQ1554.2 +003400 CONFIGURATION SECTION. SQ1554.2 +003500 SOURCE-COMPUTER. SQ1554.2 +003600 XXXXX082. SQ1554.2 +003700 OBJECT-COMPUTER. SQ1554.2 +003800 XXXXX083. SQ1554.2 +003900* SQ1554.2 +004000 INPUT-OUTPUT SECTION. SQ1554.2 +004100 FILE-CONTROL. SQ1554.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1554.2 +004300 XXXXX055. SQ1554.2 +004400* SQ1554.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1554.2 +004600 XXXXX001 SQ1554.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1554.2 +004800* SQ1554.2 +004900* SQ1554.2 +005000 DATA DIVISION. SQ1554.2 +005100 FILE SECTION. SQ1554.2 +005200 FD PRINT-FILE SQ1554.2 +005300C LABEL RECORDS SQ1554.2 +005400C XXXXX084 SQ1554.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1554.2 +005600 . SQ1554.2 +005700 01 PRINT-REC PICTURE X(120). SQ1554.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1554.2 +005900* SQ1554.2 +006000 FD SQ-FS1 SQ1554.2 +006100C LABEL RECORD IS STANDARD SQ1554.2 +006200 . SQ1554.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1554.2 +006400* SQ1554.2 +006500 WORKING-STORAGE SECTION. SQ1554.2 +006600* SQ1554.2 +006700*************************************************************** SQ1554.2 +006800* * SQ1554.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1554.2 +007000* * SQ1554.2 +007100*************************************************************** SQ1554.2 +007200* SQ1554.2 +007300 01 SQ-FS1-STATUS. SQ1554.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1554.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1554.2 +007600* SQ1554.2 +007700*************************************************************** SQ1554.2 +007800* * SQ1554.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1554.2 +008000* * SQ1554.2 +008100*************************************************************** SQ1554.2 +008200* SQ1554.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1554.2 +008400* SQ1554.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1554.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1554.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1554.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1554.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1554.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1554.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1554.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1554.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1554.2 +009400 ",RECKEY= ". SQ1554.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1554.2 +009600 ",ALTKEY1= ". SQ1554.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1554.2 +009800 ",ALTKEY2= ". SQ1554.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1554.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1554.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1554.2 +010200 07 FILLER PIC X(5). SQ1554.2 +010300 07 XFILE-NAME PIC X(6). SQ1554.2 +010400 07 FILLER PIC X(8). SQ1554.2 +010500 07 XRECORD-NAME PIC X(6). SQ1554.2 +010600 07 FILLER PIC X(1). SQ1554.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1554.2 +010800 07 FILLER PIC X(7). SQ1554.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1554.2 +011000 07 FILLER PIC X(6). SQ1554.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1554.2 +011200 07 FILLER PIC X(5). SQ1554.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1554.2 +011400 07 FILLER PIC X(5). SQ1554.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1554.2 +011600 07 FILLER PIC X(7). SQ1554.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1554.2 +011800 07 FILLER PIC X(7). SQ1554.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1554.2 +012000 07 FILLER PIC X(1). SQ1554.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1554.2 +012200 07 FILLER PIC X(6). SQ1554.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1554.2 +012400 07 FILLER PIC X(5). SQ1554.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1554.2 +012600 07 FILLER PIC X(6). SQ1554.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1554.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1554.2 +012900 07 FILLER PIC X(8). SQ1554.2 +013000 07 XRECORD-KEY PIC X(29). SQ1554.2 +013100 07 FILLER PIC X(9). SQ1554.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1554.2 +013300 07 FILLER PIC X(9). SQ1554.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1554.2 +013500 07 FILLER PIC X(7). SQ1554.2 +013600* SQ1554.2 +013700 01 TEST-RESULTS. SQ1554.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1554.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1554.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1554.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1554.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1554.2 +014300 02 PAR-NAME. SQ1554.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1554.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1554.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1554.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1554.2 +014800 02 RE-MARK PIC X(61). SQ1554.2 +014900 01 TEST-COMPUTED. SQ1554.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1554.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1554.2 +015200 02 COMPUTED-X. SQ1554.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1554.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1554.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1554.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1554.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1554.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1554.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1554.2 +016000 04 FILLER PIC X. SQ1554.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1554.2 +016200 01 TEST-CORRECT. SQ1554.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1554.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1554.2 +016500 02 CORRECT-X. SQ1554.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1554.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1554.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1554.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1554.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1554.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1554.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1554.2 +017300 04 FILLER PIC X. SQ1554.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1554.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1554.2 +017600 01 CCVS-C-1. SQ1554.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1554.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1554.2 +017900- "SS PARAGRAPH-NAME SQ1554.2 +018000- " REMARKS". SQ1554.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1554.2 +018200 01 CCVS-C-2. SQ1554.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1554.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1554.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1554.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1554.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1554.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1554.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1554.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1554.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1554.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1554.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1554.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1554.2 +019900 01 CCVS-H-1. SQ1554.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1554.2 +020100 02 FILLER PIC X(42) VALUE SQ1554.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1554.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1554.2 +020400 01 CCVS-H-2A. SQ1554.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1554.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1554.2 +020700 02 FILLER PIC XXXX VALUE SQ1554.2 +020800 "4.2 ". SQ1554.2 +020900 02 FILLER PIC X(28) VALUE SQ1554.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1554.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1554.2 +021200* SQ1554.2 +021300 01 CCVS-H-2B. SQ1554.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1554.2 +021500 02 TEST-ID PIC X(9). SQ1554.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1554.2 +021700 02 FILLER PIC X(12) VALUE SQ1554.2 +021800 " HIGH ". SQ1554.2 +021900 02 FILLER PIC X(22) VALUE SQ1554.2 +022000 " LEVEL VALIDATION FOR ". SQ1554.2 +022100 02 FILLER PIC X(58) VALUE SQ1554.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +022300 01 CCVS-H-3. SQ1554.2 +022400 02 FILLER PIC X(34) VALUE SQ1554.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1554.2 +022600 02 FILLER PIC X(58) VALUE SQ1554.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1554.2 +022800 02 FILLER PIC X(28) VALUE SQ1554.2 +022900 " COPYRIGHT 1985,1986 ". SQ1554.2 +023000 01 CCVS-E-1. SQ1554.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1554.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1554.2 +023300 02 ID-AGAIN PIC X(9). SQ1554.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1554.2 +023500 01 CCVS-E-2. SQ1554.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1554.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1554.2 +023800 02 CCVS-E-2-2. SQ1554.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1554.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1554.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1554.2 +024200 "ERRORS ENCOUNTERED". SQ1554.2 +024300 01 CCVS-E-3. SQ1554.2 +024400 02 FILLER PIC X(22) VALUE SQ1554.2 +024500 " FOR OFFICIAL USE ONLY". SQ1554.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1554.2 +024700 02 FILLER PIC X(58) VALUE SQ1554.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1554.2 +025000 02 FILLER PIC X(20) VALUE SQ1554.2 +025100 " COPYRIGHT 1985,1986". SQ1554.2 +025200 01 CCVS-E-4. SQ1554.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1554.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1554.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1554.2 +025600 02 FILLER PIC X(40) VALUE SQ1554.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1554.2 +025800 01 XXINFO. SQ1554.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1554.2 +026000 02 INFO-TEXT. SQ1554.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1554.2 +026200 04 XXCOMPUTED PIC X(20). SQ1554.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1554.2 +026400 04 XXCORRECT PIC X(20). SQ1554.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1554.2 +026600 01 HYPHEN-LINE. SQ1554.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1554.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1554.2 +026900- "*****************************************". SQ1554.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1554.2 +027100- "******************************". SQ1554.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1554.2 +027300 "SQ155A". SQ1554.2 +027400* SQ1554.2 +027500 PROCEDURE DIVISION. SQ1554.2 +027600 CCVS1 SECTION. SQ1554.2 +027700 OPEN-FILES. SQ1554.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1554.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1554.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1554.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1554.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1554.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1554.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1554.2 +028500 GO TO CCVS1-EXIT. SQ1554.2 +028600* SQ1554.2 +028700 CCVS-INIT-FILE. SQ1554.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1554.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1554.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1554.2 +029100* SQ1554.2 +029200 CLOSE-FILES. SQ1554.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1554.2 +029400 CLOSE PRINT-FILE. SQ1554.2 +029500 TERMINATE-CCVS. SQ1554.2 +029600 STOP RUN. SQ1554.2 +029700* SQ1554.2 +029800 INSPT. SQ1554.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1554.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1554.2 +030100 PERFORM PRINT-DETAIL. SQ1554.2 +030200 SQ1554.2 +030300 PASS. SQ1554.2 +030400 MOVE "PASS " TO P-OR-F. SQ1554.2 +030500 ADD 1 TO PASS-COUNTER. SQ1554.2 +030600 PERFORM PRINT-DETAIL. SQ1554.2 +030700* SQ1554.2 +030800 FAIL. SQ1554.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1554.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1554.2 +031100 PERFORM PRINT-DETAIL. SQ1554.2 +031200* SQ1554.2 +031300 DE-LETE. SQ1554.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1554.2 +031500 MOVE "*****" TO P-OR-F. SQ1554.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1554.2 +031700 PERFORM PRINT-DETAIL. SQ1554.2 +031800* SQ1554.2 +031900 PRINT-DETAIL. SQ1554.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1554.2 +032100 MOVE "." TO PARDOT-X SQ1554.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1554.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1554.2 +032400 PERFORM WRITE-LINE. SQ1554.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1554.2 +032600 PERFORM WRITE-LINE SQ1554.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1554.2 +032800 ELSE SQ1554.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1554.2 +033000 MOVE SPACE TO P-OR-F. SQ1554.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1554.2 +033200 MOVE SPACE TO CORRECT-X. SQ1554.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1554.2 +033400 MOVE SPACE TO RE-MARK. SQ1554.2 +033500* SQ1554.2 +033600 HEAD-ROUTINE. SQ1554.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +034100 COLUMN-NAMES-ROUTINE. SQ1554.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +034500 END-ROUTINE. SQ1554.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1554.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1554.2 +034800 END-RTN-EXIT. SQ1554.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1554.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +035100* SQ1554.2 +035200 END-ROUTINE-1. SQ1554.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1554.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1554.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1554.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1554.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1554.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1554.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1554.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1554.2 +036100 PERFORM WRITE-LINE. SQ1554.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1554.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1554.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +036500 ELSE SQ1554.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1554.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1554.2 +036800 PERFORM WRITE-LINE. SQ1554.2 +036900 END-ROUTINE-13. SQ1554.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1554.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +037200 ELSE SQ1554.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1554.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1554.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1554.2 +037600 PERFORM WRITE-LINE. SQ1554.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1554.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +037900 ELSE SQ1554.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1554.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1554.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +038400* SQ1554.2 +038500 WRITE-LINE. SQ1554.2 +038600 ADD 1 TO RECORD-COUNT. SQ1554.2 +038700Y IF RECORD-COUNT GREATER 50 SQ1554.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1554.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ1554.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1554.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1554.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1554.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1554.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1554.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ1554.2 +039600 PERFORM WRT-LN. SQ1554.2 +039700* SQ1554.2 +039800 WRT-LN. SQ1554.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1554.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1554.2 +040100 BLANK-LINE-PRINT. SQ1554.2 +040200 PERFORM WRT-LN. SQ1554.2 +040300 FAIL-ROUTINE. SQ1554.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1554.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1554.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1554.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1554.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1554.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1554.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1554.2 +041200 FAIL-ROUTINE-WRITE. SQ1554.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1554.2 +041400 PERFORM WRITE-LINE SQ1554.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1554.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1554.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1554.2 +041900 FAIL-ROUTINE-EX. SQ1554.2 +042000 EXIT. SQ1554.2 +042100 BAIL-OUT. SQ1554.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1554.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1554.2 +042400 BAIL-OUT-WRITE. SQ1554.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1554.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1554.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1554.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1554.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1554.2 +043100 BAIL-OUT-EX. SQ1554.2 +043200 EXIT. SQ1554.2 +043300 CCVS1-EXIT. SQ1554.2 +043400 EXIT. SQ1554.2 +043500* SQ1554.2 +043600**************************************************************** SQ1554.2 +043700* * SQ1554.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1554.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1554.2 +044000* * SQ1554.2 +044100**************************************************************** SQ1554.2 +044200* SQ1554.2 +044300 SECT-SQ155A-0001 SECTION. SQ1554.2 +044400 WRITE-INIT-GF-01. SQ1554.2 +044500* SQ1554.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1554.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1554.2 +044800* SQ1554.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1554.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1554.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1554.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1554.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1554.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1554.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1554.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1554.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1554.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1554.2 +045900* SQ1554.2 +046000 WRITE-OPEN-01. SQ1554.2 +046100 OPEN OUTPUT SQ-FS1. SQ1554.2 +046200* SQ1554.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1554.2 +046400* SQ1554.2 +046500 WRITE-TEST-01-01. SQ1554.2 +046600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1554.2 +046700 WRITE SQ-FS1R1-F-G-120. SQ1554.2 +046800* SQ1554.2 +046900* CLOSE THE FILE. SQ1554.2 +047000* SQ1554.2 +047100 CLOSE-INIT-01. SQ1554.2 +047200 CLOSE-TEST-01. SQ1554.2 +047300 CLOSE SQ-FS1. SQ1554.2 +047400* SQ1554.2 +047500 OPEN-INIT-01. SQ1554.2 +047600* SQ1554.2 +047700 OPEN-TEST-01. SQ1554.2 +047800 OPEN INPUT SQ-FS1. SQ1554.2 +047900* SQ1554.2 +048000 WRITE-INIT-01. SQ1554.2 +048100* SQ1554.2 +048200* HAVING REOPENED THE FILE JUST CREATED IN THE INPUT MODE, SQ1554.2 +048300* WE WILL NOW ATTEMPT TO WRITE ANOTHER RECORD TO THE FILE. SQ1554.2 +048400* I-O STATUS CODE 48 SHOULD BE GENERATED. SQ1554.2 +048500* SQ1554.2 +048600 MOVE "WRITE TO INPUT FILE" TO FEATURE. SQ1554.2 +048700 MOVE "**" TO SQ-FS1-STATUS. SQ1554.2 +048800 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1554.2 +048900 MOVE 1 TO REC-CT. SQ1554.2 +049000 MOVE 2 TO XRECORD-NUMBER (1). SQ1554.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1554.2 +049200 TO DUMMY-RECORD. SQ1554.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +049400* SQ1554.2 +049500 WRITE-TEST-01. SQ1554.2 +049600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1554.2 +049700 WRITE SQ-FS1R1-F-G-120. SQ1554.2 +049800 IF SQ-FS1-STATUS = "48" SQ1554.2 +049900 PERFORM PASS SQ1554.2 +050000 ELSE SQ1554.2 +050100 MOVE "48" TO CORRECT-A SQ1554.2 +050200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1554.2 +050300 MOVE "STATUS FOR WRITE TO INPUT FILE INCORRECT" SQ1554.2 +050400 TO RE-MARK SQ1554.2 +050500 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1554.2 +050600 PERFORM FAIL SQ1554.2 +050700 END-IF. SQ1554.2 +050800* SQ1554.2 +050900 CLOSE-INIT-02. SQ1554.2 +051000* SQ1554.2 +051100 CLOSE-TEST-02. SQ1554.2 +051200 CLOSE SQ-FS1. SQ1554.2 +051300* SQ1554.2 +051400 CCVS-EXIT SECTION. SQ1554.2 +051500 CCVS-999999. SQ1554.2 +051600 GO TO CLOSE-FILES. SQ1554.2 +*END-OF,SQ155A +*HEADER,COBOL,SQ156A +000100 IDENTIFICATION DIVISION. SQ1564.2 +000200 PROGRAM-ID. SQ1564.2 +000300 SQ156A. SQ1564.2 +000400**************************************************************** SQ1564.2 +000500* * SQ1564.2 +000600* VALIDATION FOR:- * SQ1564.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +000800* USING CCVS85 VERSION 3.0. * SQ1564.2 +000900* * SQ1564.2 +001000* CREATION DATE / VALIDATION DATE * SQ1564.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1564.2 +001200* * SQ1564.2 +001300**************************************************************** SQ1564.2 +001400* * SQ1564.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1564.2 +001600* * SQ1564.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1564.2 +001800* X-55 SYSTEM PRINTER * SQ1564.2 +001900* X-82 SOURCE-COMPUTER * SQ1564.2 +002000* X-83 OBJECT-COMPUTER * SQ1564.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1564.2 +002200* * SQ1564.2 +002300**************************************************************** SQ1564.2 +002400* * SQ1564.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1564.2 +002600* A FILE OPEN IN THE I-O MODE. THE TEST FOR CORRECT I-O * SQ1564.2 +002700* STATUS 48 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1564.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1564.2 +002900* CODE IS ACCOMPLISHED. * SQ1564.2 +003000* * SQ1564.2 +003100**************************************************************** SQ1564.2 +003200* SQ1564.2 +003300 ENVIRONMENT DIVISION. SQ1564.2 +003400 CONFIGURATION SECTION. SQ1564.2 +003500 SOURCE-COMPUTER. SQ1564.2 +003600 XXXXX082. SQ1564.2 +003700 OBJECT-COMPUTER. SQ1564.2 +003800 XXXXX083. SQ1564.2 +003900* SQ1564.2 +004000 INPUT-OUTPUT SECTION. SQ1564.2 +004100 FILE-CONTROL. SQ1564.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1564.2 +004300 XXXXX055. SQ1564.2 +004400* SQ1564.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1564.2 +004600 XXXXX014 SQ1564.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1564.2 +004800* SQ1564.2 +004900* SQ1564.2 +005000 DATA DIVISION. SQ1564.2 +005100 FILE SECTION. SQ1564.2 +005200 FD PRINT-FILE SQ1564.2 +005300C LABEL RECORDS SQ1564.2 +005400C XXXXX084 SQ1564.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1564.2 +005600 . SQ1564.2 +005700 01 PRINT-REC PICTURE X(120). SQ1564.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1564.2 +005900* SQ1564.2 +006000 FD SQ-FS1 SQ1564.2 +006100C LABEL RECORD IS STANDARD SQ1564.2 +006200 . SQ1564.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1564.2 +006400* SQ1564.2 +006500 WORKING-STORAGE SECTION. SQ1564.2 +006600* SQ1564.2 +006700*************************************************************** SQ1564.2 +006800* * SQ1564.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1564.2 +007000* * SQ1564.2 +007100*************************************************************** SQ1564.2 +007200* SQ1564.2 +007300 01 SQ-FS1-STATUS. SQ1564.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1564.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1564.2 +007600* SQ1564.2 +007700*************************************************************** SQ1564.2 +007800* * SQ1564.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1564.2 +008000* * SQ1564.2 +008100*************************************************************** SQ1564.2 +008200* SQ1564.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1564.2 +008400* SQ1564.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1564.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1564.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1564.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1564.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1564.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1564.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1564.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1564.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1564.2 +009400 ",RECKEY= ". SQ1564.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1564.2 +009600 ",ALTKEY1= ". SQ1564.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1564.2 +009800 ",ALTKEY2= ". SQ1564.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1564.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1564.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1564.2 +010200 07 FILLER PIC X(5). SQ1564.2 +010300 07 XFILE-NAME PIC X(6). SQ1564.2 +010400 07 FILLER PIC X(8). SQ1564.2 +010500 07 XRECORD-NAME PIC X(6). SQ1564.2 +010600 07 FILLER PIC X(1). SQ1564.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1564.2 +010800 07 FILLER PIC X(7). SQ1564.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1564.2 +011000 07 FILLER PIC X(6). SQ1564.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1564.2 +011200 07 FILLER PIC X(5). SQ1564.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1564.2 +011400 07 FILLER PIC X(5). SQ1564.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1564.2 +011600 07 FILLER PIC X(7). SQ1564.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1564.2 +011800 07 FILLER PIC X(7). SQ1564.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1564.2 +012000 07 FILLER PIC X(1). SQ1564.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1564.2 +012200 07 FILLER PIC X(6). SQ1564.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1564.2 +012400 07 FILLER PIC X(5). SQ1564.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1564.2 +012600 07 FILLER PIC X(6). SQ1564.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1564.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1564.2 +012900 07 FILLER PIC X(8). SQ1564.2 +013000 07 XRECORD-KEY PIC X(29). SQ1564.2 +013100 07 FILLER PIC X(9). SQ1564.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1564.2 +013300 07 FILLER PIC X(9). SQ1564.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1564.2 +013500 07 FILLER PIC X(7). SQ1564.2 +013600* SQ1564.2 +013700 01 TEST-RESULTS. SQ1564.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1564.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1564.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1564.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1564.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1564.2 +014300 02 PAR-NAME. SQ1564.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1564.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1564.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1564.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1564.2 +014800 02 RE-MARK PIC X(61). SQ1564.2 +014900 01 TEST-COMPUTED. SQ1564.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1564.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1564.2 +015200 02 COMPUTED-X. SQ1564.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1564.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1564.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1564.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1564.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1564.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1564.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1564.2 +016000 04 FILLER PIC X. SQ1564.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1564.2 +016200 01 TEST-CORRECT. SQ1564.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1564.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1564.2 +016500 02 CORRECT-X. SQ1564.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1564.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1564.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1564.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1564.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1564.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1564.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1564.2 +017300 04 FILLER PIC X. SQ1564.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1564.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1564.2 +017600 01 CCVS-C-1. SQ1564.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1564.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1564.2 +017900- "SS PARAGRAPH-NAME SQ1564.2 +018000- " REMARKS". SQ1564.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1564.2 +018200 01 CCVS-C-2. SQ1564.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1564.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1564.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1564.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1564.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1564.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1564.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1564.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1564.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1564.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1564.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1564.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1564.2 +019900 01 CCVS-H-1. SQ1564.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1564.2 +020100 02 FILLER PIC X(42) VALUE SQ1564.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1564.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1564.2 +020400 01 CCVS-H-2A. SQ1564.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1564.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1564.2 +020700 02 FILLER PIC XXXX VALUE SQ1564.2 +020800 "4.2 ". SQ1564.2 +020900 02 FILLER PIC X(28) VALUE SQ1564.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1564.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1564.2 +021200* SQ1564.2 +021300 01 CCVS-H-2B. SQ1564.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1564.2 +021500 02 TEST-ID PIC X(9). SQ1564.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1564.2 +021700 02 FILLER PIC X(12) VALUE SQ1564.2 +021800 " HIGH ". SQ1564.2 +021900 02 FILLER PIC X(22) VALUE SQ1564.2 +022000 " LEVEL VALIDATION FOR ". SQ1564.2 +022100 02 FILLER PIC X(58) VALUE SQ1564.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +022300 01 CCVS-H-3. SQ1564.2 +022400 02 FILLER PIC X(34) VALUE SQ1564.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1564.2 +022600 02 FILLER PIC X(58) VALUE SQ1564.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1564.2 +022800 02 FILLER PIC X(28) VALUE SQ1564.2 +022900 " COPYRIGHT 1985,1986 ". SQ1564.2 +023000 01 CCVS-E-1. SQ1564.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1564.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1564.2 +023300 02 ID-AGAIN PIC X(9). SQ1564.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1564.2 +023500 01 CCVS-E-2. SQ1564.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1564.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1564.2 +023800 02 CCVS-E-2-2. SQ1564.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1564.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1564.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1564.2 +024200 "ERRORS ENCOUNTERED". SQ1564.2 +024300 01 CCVS-E-3. SQ1564.2 +024400 02 FILLER PIC X(22) VALUE SQ1564.2 +024500 " FOR OFFICIAL USE ONLY". SQ1564.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1564.2 +024700 02 FILLER PIC X(58) VALUE SQ1564.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1564.2 +025000 02 FILLER PIC X(20) VALUE SQ1564.2 +025100 " COPYRIGHT 1985,1986". SQ1564.2 +025200 01 CCVS-E-4. SQ1564.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1564.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1564.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1564.2 +025600 02 FILLER PIC X(40) VALUE SQ1564.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1564.2 +025800 01 XXINFO. SQ1564.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1564.2 +026000 02 INFO-TEXT. SQ1564.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1564.2 +026200 04 XXCOMPUTED PIC X(20). SQ1564.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1564.2 +026400 04 XXCORRECT PIC X(20). SQ1564.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1564.2 +026600 01 HYPHEN-LINE. SQ1564.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1564.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1564.2 +026900- "*****************************************". SQ1564.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1564.2 +027100- "******************************". SQ1564.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1564.2 +027300 "SQ156A". SQ1564.2 +027400* SQ1564.2 +027500 PROCEDURE DIVISION. SQ1564.2 +027600 CCVS1 SECTION. SQ1564.2 +027700 OPEN-FILES. SQ1564.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1564.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1564.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1564.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1564.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1564.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1564.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1564.2 +028500 GO TO CCVS1-EXIT. SQ1564.2 +028600* SQ1564.2 +028700 CCVS-INIT-FILE. SQ1564.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1564.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1564.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1564.2 +029100* SQ1564.2 +029200 CLOSE-FILES. SQ1564.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1564.2 +029400 CLOSE PRINT-FILE. SQ1564.2 +029500 TERMINATE-CCVS. SQ1564.2 +029600 STOP RUN. SQ1564.2 +029700* SQ1564.2 +029800 INSPT. SQ1564.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1564.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1564.2 +030100 PERFORM PRINT-DETAIL. SQ1564.2 +030200 SQ1564.2 +030300 PASS. SQ1564.2 +030400 MOVE "PASS " TO P-OR-F. SQ1564.2 +030500 ADD 1 TO PASS-COUNTER. SQ1564.2 +030600 PERFORM PRINT-DETAIL. SQ1564.2 +030700* SQ1564.2 +030800 FAIL. SQ1564.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1564.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1564.2 +031100 PERFORM PRINT-DETAIL. SQ1564.2 +031200* SQ1564.2 +031300 DE-LETE. SQ1564.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1564.2 +031500 MOVE "*****" TO P-OR-F. SQ1564.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1564.2 +031700 PERFORM PRINT-DETAIL. SQ1564.2 +031800* SQ1564.2 +031900 PRINT-DETAIL. SQ1564.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1564.2 +032100 MOVE "." TO PARDOT-X SQ1564.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1564.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1564.2 +032400 PERFORM WRITE-LINE. SQ1564.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1564.2 +032600 PERFORM WRITE-LINE SQ1564.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1564.2 +032800 ELSE SQ1564.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1564.2 +033000 MOVE SPACE TO P-OR-F. SQ1564.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1564.2 +033200 MOVE SPACE TO CORRECT-X. SQ1564.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1564.2 +033400 MOVE SPACE TO RE-MARK. SQ1564.2 +033500* SQ1564.2 +033600 HEAD-ROUTINE. SQ1564.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +034100 COLUMN-NAMES-ROUTINE. SQ1564.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +034500 END-ROUTINE. SQ1564.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1564.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1564.2 +034800 END-RTN-EXIT. SQ1564.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1564.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +035100* SQ1564.2 +035200 END-ROUTINE-1. SQ1564.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1564.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1564.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1564.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1564.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1564.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1564.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1564.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1564.2 +036100 PERFORM WRITE-LINE. SQ1564.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1564.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1564.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +036500 ELSE SQ1564.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1564.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1564.2 +036800 PERFORM WRITE-LINE. SQ1564.2 +036900 END-ROUTINE-13. SQ1564.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1564.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +037200 ELSE SQ1564.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1564.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1564.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1564.2 +037600 PERFORM WRITE-LINE. SQ1564.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1564.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +037900 ELSE SQ1564.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1564.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1564.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +038400* SQ1564.2 +038500 WRITE-LINE. SQ1564.2 +038600 ADD 1 TO RECORD-COUNT. SQ1564.2 +038700Y IF RECORD-COUNT GREATER 50 SQ1564.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1564.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ1564.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1564.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1564.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1564.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1564.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1564.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ1564.2 +039600 PERFORM WRT-LN. SQ1564.2 +039700* SQ1564.2 +039800 WRT-LN. SQ1564.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1564.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1564.2 +040100 BLANK-LINE-PRINT. SQ1564.2 +040200 PERFORM WRT-LN. SQ1564.2 +040300 FAIL-ROUTINE. SQ1564.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1564.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1564.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1564.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1564.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1564.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1564.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1564.2 +041200 FAIL-ROUTINE-WRITE. SQ1564.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1564.2 +041400 PERFORM WRITE-LINE SQ1564.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1564.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1564.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1564.2 +041900 FAIL-ROUTINE-EX. SQ1564.2 +042000 EXIT. SQ1564.2 +042100 BAIL-OUT. SQ1564.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1564.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1564.2 +042400 BAIL-OUT-WRITE. SQ1564.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1564.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1564.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1564.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1564.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1564.2 +043100 BAIL-OUT-EX. SQ1564.2 +043200 EXIT. SQ1564.2 +043300 CCVS1-EXIT. SQ1564.2 +043400 EXIT. SQ1564.2 +043500* SQ1564.2 +043600**************************************************************** SQ1564.2 +043700* * SQ1564.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1564.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1564.2 +044000* * SQ1564.2 +044100**************************************************************** SQ1564.2 +044200* SQ1564.2 +044300 SECT-SQ156A-0001 SECTION. SQ1564.2 +044400 WRITE-INIT-GF-01. SQ1564.2 +044500* SQ1564.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1564.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1564.2 +044800* SQ1564.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1564.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1564.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1564.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1564.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1564.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1564.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1564.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1564.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1564.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1564.2 +045900* SQ1564.2 +046000 WRITE-OPEN-01. SQ1564.2 +046100 OPEN OUTPUT SQ-FS1. SQ1564.2 +046200* SQ1564.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1564.2 +046400* SQ1564.2 +046500 WRITE-TEST-01-01. SQ1564.2 +046600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1564.2 +046700 WRITE SQ-FS1R1-F-G-120. SQ1564.2 +046800* SQ1564.2 +046900* CLOSE THE FILE. SQ1564.2 +047000* SQ1564.2 +047100 CLOSE-INIT-01. SQ1564.2 +047200 CLOSE-TEST-01. SQ1564.2 +047300 CLOSE SQ-FS1. SQ1564.2 +047400* SQ1564.2 +047500 OPEN-INIT-01. SQ1564.2 +047600* SQ1564.2 +047700 OPEN-TEST-01. SQ1564.2 +047800 OPEN I-O SQ-FS1. SQ1564.2 +047900* SQ1564.2 +048000 WRITE-INIT-01. SQ1564.2 +048100* SQ1564.2 +048200* HAVING REOPENED THE FILE JUST CREATED IN THE I-O MODE, SQ1564.2 +048300* WE WILL NOW ATTEMPT TO WRITE ANOTHER RECORD TO THE FILE. SQ1564.2 +048400* I-O STATUS CODE 48 SHOULD BE GENERATED. SQ1564.2 +048500* SQ1564.2 +048600 MOVE "WRITE TO I-O FILE" TO FEATURE. SQ1564.2 +048700 MOVE "**" TO SQ-FS1-STATUS. SQ1564.2 +048800 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1564.2 +048900 MOVE 1 TO REC-CT. SQ1564.2 +049000 MOVE 2 TO XRECORD-NUMBER (1). SQ1564.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1564.2 +049200 TO DUMMY-RECORD. SQ1564.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +049400* SQ1564.2 +049500 WRITE-TEST-01. SQ1564.2 +049600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1564.2 +049700 WRITE SQ-FS1R1-F-G-120. SQ1564.2 +049800 IF SQ-FS1-STATUS = "48" SQ1564.2 +049900 PERFORM PASS SQ1564.2 +050000 ELSE SQ1564.2 +050100 MOVE "48" TO CORRECT-A SQ1564.2 +050200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1564.2 +050300 MOVE "STATUS FOR WRITE TO I-O FILE INCORRECT" SQ1564.2 +050400 TO RE-MARK SQ1564.2 +050500 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1564.2 +050600 PERFORM FAIL SQ1564.2 +050700 END-IF. SQ1564.2 +050800* SQ1564.2 +050900 CLOSE-INIT-02. SQ1564.2 +051000* SQ1564.2 +051100 CLOSE-TEST-02. SQ1564.2 +051200 CLOSE SQ-FS1. SQ1564.2 +051300* SQ1564.2 +051400 CCVS-EXIT SECTION. SQ1564.2 +051500 CCVS-999999. SQ1564.2 +051600 GO TO CLOSE-FILES. SQ1564.2 +*END-OF,SQ156A +*HEADER,COBOL,SQ201M +000100 IDENTIFICATION DIVISION. SQ2014.2 +000200 PROGRAM-ID. SQ2014.2 +000300 SQ201M. SQ2014.2 +000400**************************************************************** SQ2014.2 +000500* * SQ2014.2 +000600* VALIDATION FOR:- * SQ2014.2 +000700* " HIGH ". SQ2014.2 +000800* * SQ2014.2 +000900* CREATION DATE / VALIDATION DATE * SQ2014.2 +001000* "4.2 ". SQ2014.2 +001100* * SQ2014.2 +001200* THIS ROUTINE TESTS THE WRITE ... ADVANCIN STATEMENT IN SQ2014.2 +001300* COMBINATION WITH THE SQ2014.2 +001400* NOT AT END-OF-PAGE SQ2014.2 +001500* AND THE SQ2014.2 +001600* END-WRITE CLAUSES. SQ2014.2 +001700* SQ2014.2 +001800* THE ROUTINE SQ201M TESTS THE USE OF THE LEVEL 2 WRITE SQ2014.2 +001900* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2014.2 +002000* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2014.2 +002100* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2014.2 +002200* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A SQ2014.2 +002300* LOGICAL PRINT PAGE. SQ201M TESTS (1) THE ACCURACY OF THE SQ2014.2 +002400* LINAGE-COUNTER, (2) THE WRITE ADVANCING PAGE, AND (3) THE SQ2014.2 +002500* FOUR COMBINATIONS OF THE END-OF-PAGE PHRASE. IT IS ASSUMED SQ2014.2 +002600* THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE IN TESTING SQ2014.2 +002700* SQ201M. A LINAGE CLAUSE WITH COMPLETE FOOTING, TOP, AND SQ2014.2 +002800* BOTTOM SECTIONS AND UTILIZING INTEGER ITEMS IS USED WITH SQ2014.2 +002900* THIS TEST. SQ2014.2 +003000 ENVIRONMENT DIVISION. SQ2014.2 +003100 CONFIGURATION SECTION. SQ2014.2 +003200 SOURCE-COMPUTER. SQ2014.2 +003300 XXXXX082. SQ2014.2 +003400 OBJECT-COMPUTER. SQ2014.2 +003500 XXXXX083. SQ2014.2 +003600 INPUT-OUTPUT SECTION. SQ2014.2 +003700 FILE-CONTROL. SQ2014.2 +003800P SELECT RAW-DATA ASSIGN TO SQ2014.2 +003900P XXXXX062 SQ2014.2 +004000P ORGANIZATION IS INDEXED SQ2014.2 +004100P ACCESS MODE IS RANDOM SQ2014.2 +004200P RECORD KEY IS RAW-DATA-KEY. SQ2014.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2014.2 +004400 XXXXX055. SQ2014.2 +004500 DATA DIVISION. SQ2014.2 +004600 FILE SECTION. SQ2014.2 +004700P SQ2014.2 +004800PFD RAW-DATA. SQ2014.2 +004900P SQ2014.2 +005000P01 RAW-DATA-SATZ. SQ2014.2 +005100P 05 RAW-DATA-KEY PIC X(6). SQ2014.2 +005200P 05 C-DATE PIC 9(6). SQ2014.2 +005300P 05 C-TIME PIC 9(8). SQ2014.2 +005400P 05 C-NO-OF-TESTS PIC 99. SQ2014.2 +005500P 05 C-OK PIC 999. SQ2014.2 +005600P 05 C-ALL PIC 999. SQ2014.2 +005700P 05 C-FAIL PIC 999. SQ2014.2 +005800P 05 C-DELETED PIC 999. SQ2014.2 +005900P 05 C-INSPECT PIC 999. SQ2014.2 +006000P 05 C-NOTE PIC X(13). SQ2014.2 +006100P 05 C-INDENT PIC X. SQ2014.2 +006200P 05 C-ABORT PIC X(8). SQ2014.2 +006300 FD PRINT-FILE SQ2014.2 +006400C LABEL RECORDS SQ2014.2 +006500C XXXXX084 SQ2014.2 +006600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2014.2 +006700 LINAGE IS 50 LINES SQ2014.2 +006800 WITH FOOTING AT 45 SQ2014.2 +006900 LINES AT TOP 10 SQ2014.2 +007000 LINES AT BOTTOM 6. SQ2014.2 +007100 01 PRINT-REC PICTURE X(120). SQ2014.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2014.2 +007300 WORKING-STORAGE SECTION. SQ2014.2 +007400 01 WRITE-SWITCH PIC 9 VALUE 0. SQ2014.2 +007500 01 END-WRITE-SWITCH PIC 9 VALUE 1. SQ2014.2 +007600 01 LC-HOLD PIC 99. SQ2014.2 +007700 01 IDENTIFIER-2 PIC 99. SQ2014.2 +007800 01 TOP-LINE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ2014.2 +007900- "BY A WRITE ADVANCING PAGE OPERATION. IT SHOULD APPEAR AS THSQ2014.2 +008000- "E FIRST LINE OF A NEW LOGICAL PAGE.". SQ2014.2 +008100 01 DETAIL-LINE. SQ2014.2 +008200 02 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +008300 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2014.2 +008400 02 DETAIL-LINE-NO PIC 999. SQ2014.2 +008500 02 FILLER PIC X(52) VALUE " OF 132 DETAIL LINES.".SQ2014.2 +008600 02 FILLER PIC X(18) VALUE "LINAGE-COUNTER IS ". SQ2014.2 +008700 02 DETAIL-LC PIC 99. SQ2014.2 +008800 02 FILLER PIC X(12) VALUE ".". SQ2014.2 +008900 01 FOOT-LINE. SQ2014.2 +009000 02 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +009100 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2014.2 +009200 02 FOOT-COUNT PIC 999. SQ2014.2 +009300 02 FILLER PIC X(47) VALUE " OF 6 FOOTING LINES. SQ2014.2 +009400- "LINAGE-COUNTER SHOULD BE ". SQ2014.2 +009500 02 FOOT-LINE-NO PIC 99. SQ2014.2 +009600 02 FILLER PIC X(21) VALUE ". LINAGE-COUNTER IS ".SQ2014.2 +009700 02 FOOT-LC PIC 99. SQ2014.2 +009800 02 FILLER PIC X(12) VALUE ".". SQ2014.2 +009900 01 EOP-MESSAGE-1 PIC X(120) VALUE " THIS IS A TESQ2014.2 +010000- "ST FOR THE EOP PHRASE. 50 LINES SHOULD PRINT IN THE PAGE BOSQ2014.2 +010100- "DY INCLUDING 44 DETAIL LINES AND". SQ2014.2 +010200 01 EOP-MESSAGE-2 PIC X(120) VALUE " 6 FOOTING LISQ2014.2 +010300- "NES. THESE LINES SHOULD BE CONSECUTIVE ON ONE LOGICAL PAGE SQ2014.2 +010400- "AND BE FOLLOWED BY 16 TOP AND BOTTOM". SQ2014.2 +010500 01 EOP-MESSAGE-3 PIC X(120) VALUE " BLANK LINES.SQ2014.2 +010600- " THE CORRECT AND COMPUTED LINAGE-COUNTER VALUES IN THE FOOTSQ2014.2 +010700- "ING LINES SHOULD BE EQUAL.". SQ2014.2 +010800 01 TEST-RESULTS. SQ2014.2 +010900 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2014.2 +011100 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2014.2 +011300 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011400 02 PAR-NAME. SQ2014.2 +011500 03 FILLER PICTURE X(12) VALUE SPACE. SQ2014.2 +011600 03 PARDOT-X PICTURE X VALUE SPACE. SQ2014.2 +011700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2014.2 +011800 03 FILLER PIC X(5) VALUE SPACE. SQ2014.2 +011900 02 FILLER PIC X(10) VALUE SPACE. SQ2014.2 +012000 02 RE-MARK PIC X(61). SQ2014.2 +012100 01 TEST-COMPUTED. SQ2014.2 +012200 02 FILLER PIC X(30) VALUE SPACE. SQ2014.2 +012300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2014.2 +012400 02 COMPUTED-X. SQ2014.2 +012500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2014.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2014.2 +012700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2014.2 +012800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2014.2 +012900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2014.2 +013000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2014.2 +013100 04 COMPUTED-18V0 PICTURE -9(18). SQ2014.2 +013200 04 FILLER PICTURE X. SQ2014.2 +013300 03 FILLER PIC X(50) VALUE SPACE. SQ2014.2 +013400 01 TEST-CORRECT. SQ2014.2 +013500 02 FILLER PIC X(30) VALUE SPACE. SQ2014.2 +013600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2014.2 +013700 02 CORRECT-X. SQ2014.2 +013800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2014.2 +013900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2014.2 +014000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2014.2 +014100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2014.2 +014200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2014.2 +014300 03 CR-18V0 REDEFINES CORRECT-A. SQ2014.2 +014400 04 CORRECT-18V0 PICTURE -9(18). SQ2014.2 +014500 04 FILLER PICTURE X. SQ2014.2 +014600 03 FILLER PIC X(50) VALUE SPACE. SQ2014.2 +014700 01 CCVS-C-1. SQ2014.2 +014800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2014.2 +014900- "SS PARAGRAPH-NAME SQ2014.2 +015000- " REMARKS". SQ2014.2 +015100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2014.2 +015200 01 CCVS-C-2. SQ2014.2 +015300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +015400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2014.2 +015500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2014.2 +015600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2014.2 +015700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2014.2 +015800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2014.2 +015900 01 REC-CT PICTURE 99 VALUE ZERO. SQ2014.2 +016000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2014.2 +016100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2014.2 +016200 01 INSPECT-COUNTER PIC 999 VALUE 11. SQ2014.2 +016300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2014.2 +016400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2014.2 +016500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2014.2 +016600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2014.2 +016700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2014.2 +016800 01 CCVS-H-1. SQ2014.2 +016900 02 FILLER PICTURE X(27) VALUE SPACE. SQ2014.2 +017000 02 FILLER PICTURE X(67) VALUE SQ2014.2 +017100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2014.2 +017200- " SYSTEM". SQ2014.2 +017300 02 FILLER PICTURE X(26) VALUE SPACE. SQ2014.2 +017400 01 CCVS-H-2. SQ2014.2 +017500 02 FILLER PICTURE X(52) VALUE IS SQ2014.2 +017600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2014.2 +017700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2014.2 +017800 02 TEST-ID PICTURE IS X(9). SQ2014.2 +017900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2014.2 +018000 01 CCVS-H-3. SQ2014.2 +018100 02 FILLER PICTURE X(34) VALUE SQ2014.2 +018200 " FOR OFFICIAL USE ONLY ". SQ2014.2 +018300 02 FILLER PICTURE X(58) VALUE SQ2014.2 +018400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2014.2 +018500 02 FILLER PICTURE X(28) VALUE SQ2014.2 +018600 " COPYRIGHT 1985 ". SQ2014.2 +018700 01 CCVS-E-1. SQ2014.2 +018800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2014.2 +018900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2014.2 +019000 02 ID-AGAIN PICTURE IS X(9). SQ2014.2 +019100 02 FILLER PICTURE X(45) VALUE IS SQ2014.2 +019200 " NTIS DISTRIBUTION COBOL 85". SQ2014.2 +019300 01 CCVS-E-2. SQ2014.2 +019400 02 FILLER PICTURE X(31) VALUE SQ2014.2 +019500 SPACE. SQ2014.2 +019600 02 FILLER PICTURE X(21) VALUE SPACE. SQ2014.2 +019700 02 CCVS-E-2-2. SQ2014.2 +019800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2014.2 +019900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +020000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2014.2 +020100 01 CCVS-E-3. SQ2014.2 +020200 02 FILLER PICTURE X(22) VALUE SQ2014.2 +020300 " FOR OFFICIAL USE ONLY". SQ2014.2 +020400 02 FILLER PICTURE X(12) VALUE SPACE. SQ2014.2 +020500 02 FILLER PICTURE X(58) VALUE SQ2014.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2014.2 +020700 02 FILLER PICTURE X(13) VALUE SPACE. SQ2014.2 +020800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2014.2 +020900 01 CCVS-E-4. SQ2014.2 +021000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2014.2 +021100 02 FILLER PIC XXXX VALUE " OF ". SQ2014.2 +021200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2014.2 +021300 02 FILLER PIC X(40) VALUE SQ2014.2 +021400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2014.2 +021500 01 XXINFO. SQ2014.2 +021600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2014.2 +021700 02 INFO-TEXT. SQ2014.2 +021800 04 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +021900 04 XXCOMPUTED PIC X(20). SQ2014.2 +022000 04 FILLER PIC X(5) VALUE SPACE. SQ2014.2 +022100 04 XXCORRECT PIC X(20). SQ2014.2 +022200 01 HYPHEN-LINE. SQ2014.2 +022300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +022400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2014.2 +022500- "*****************************************". SQ2014.2 +022600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2014.2 +022700- "******************************". SQ2014.2 +022800 01 CCVS-PGM-ID PIC X(6) VALUE SQ2014.2 +022900 "SQ201M". SQ2014.2 +023000 PROCEDURE DIVISION. SQ2014.2 +023100 CCVS1 SECTION. SQ2014.2 +023200 OPEN-FILES. SQ2014.2 +023300P OPEN I-O RAW-DATA. SQ2014.2 +023400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2014.2 +023500P MOVE "ABORTED " TO C-ABORT. SQ2014.2 +023600P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2014.2 +023700P MOVE "ABORTED " TO C-ABORT. SQ2014.2 +023800P ADD 1 TO C-NO-OF-TESTS. SQ2014.2 +023900P ACCEPT C-DATE FROM DATE. SQ2014.2 +024000P ACCEPT C-TIME FROM TIME. SQ2014.2 +024100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2014.2 +024200PEND-E-1. SQ2014.2 +024300P CLOSE RAW-DATA. SQ2014.2 +024400 OPEN OUTPUT PRINT-FILE. SQ2014.2 +024500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2014.2 +024600 MOVE SPACE TO TEST-RESULTS. SQ2014.2 +024700 GO TO CCVS1-EXIT. SQ2014.2 +024800 CLOSE-FILES. SQ2014.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2014.2 +025000P OPEN I-O RAW-DATA. SQ2014.2 +025100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2014.2 +025200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2014.2 +025300P MOVE "OK. " TO C-ABORT. SQ2014.2 +025400P MOVE PASS-COUNTER TO C-OK. SQ2014.2 +025500P MOVE ERROR-HOLD TO C-ALL. SQ2014.2 +025600P MOVE ERROR-COUNTER TO C-FAIL. SQ2014.2 +025700P MOVE DELETE-CNT TO C-DELETED. SQ2014.2 +025800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2014.2 +025900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2014.2 +026000PEND-E-2. SQ2014.2 +026100P CLOSE RAW-DATA. SQ2014.2 +026200 TERMINATE-CCVS. SQ2014.2 +026300S EXIT PROGRAM. SQ2014.2 +026400STERMINATE-CALL. SQ2014.2 +026500 STOP RUN. SQ2014.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2014.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2014.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2014.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2014.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2014.2 +027100 PRINT-DETAIL. SQ2014.2 +027200 IF REC-CT NOT EQUAL TO ZERO SQ2014.2 +027300 MOVE "." TO PARDOT-X SQ2014.2 +027400 MOVE REC-CT TO DOTVALUE. SQ2014.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2014.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2014.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2014.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2014.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2014.2 +028000 MOVE SPACE TO CORRECT-X. SQ2014.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2014.2 +028200 MOVE SPACE TO RE-MARK. SQ2014.2 +028300 HEAD-ROUTINE. SQ2014.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +028500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2014.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2014.2 +028700 COLUMN-NAMES-ROUTINE. SQ2014.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +029100 END-ROUTINE. SQ2014.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2014.2 +029300 END-RTN-EXIT. SQ2014.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +029500 END-ROUTINE-1. SQ2014.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2014.2 +029700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2014.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2014.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2014.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2014.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2014.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2014.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2014.2 +030400 END-ROUTINE-12. SQ2014.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2014.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2014.2 +030700 MOVE "NO " TO ERROR-TOTAL SQ2014.2 +030800 ELSE SQ2014.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2014.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2014.2 +031100 PERFORM WRITE-LINE. SQ2014.2 +031200 END-ROUTINE-13. SQ2014.2 +031300 IF DELETE-CNT IS EQUAL TO ZERO SQ2014.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2014.2 +031500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2014.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2014.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2014.2 +031900 MOVE "NO " TO ERROR-TOTAL SQ2014.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2014.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2014.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +032400 WRITE-LINE. SQ2014.2 +032500 ADD 1 TO RECORD-COUNT. SQ2014.2 +032600Y IF RECORD-COUNT GREATER 50 SQ2014.2 +032700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2014.2 +032800Y MOVE SPACE TO DUMMY-RECORD SQ2014.2 +032900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2014.2 +033000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2014.2 +033100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2014.2 +033200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2014.2 +033300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2014.2 +033400Y MOVE ZERO TO RECORD-COUNT. SQ2014.2 +033500 PERFORM WRT-LN. SQ2014.2 +033600 WRT-LN. SQ2014.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2014.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +033900 BLANK-LINE-PRINT. SQ2014.2 +034000 PERFORM WRT-LN. SQ2014.2 +034100 FAIL-ROUTINE. SQ2014.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2014.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2014.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2014.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +034600 GO TO FAIL-ROUTINE-EX. SQ2014.2 +034700 FAIL-ROUTINE-WRITE. SQ2014.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2014.2 +034900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +035000 FAIL-ROUTINE-EX. EXIT. SQ2014.2 +035100 BAIL-OUT. SQ2014.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2014.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2014.2 +035400 BAIL-OUT-WRITE. SQ2014.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2014.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +035700 BAIL-OUT-EX. EXIT. SQ2014.2 +035800 CCVS1-EXIT. SQ2014.2 +035900 EXIT. SQ2014.2 +036000 SECT-SQ201M-0001 SECTION. SQ2014.2 +036100 WRT-TEST-001. SQ2014.2 +036200* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +036300* OF AN OPEN COMMAND. IT SHOULD BE EQUAL TO 1. SQ2014.2 +036400 CLOSE PRINT-FILE. SQ2014.2 +036500 OPEN OUTPUT PRINT-FILE. SQ2014.2 +036600 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +036700 PERFORM PASS SQ2014.2 +036800 GO TO WRT-WRITE-001. SQ2014.2 +036900 GO TO WRT-FAIL-001. SQ2014.2 +037000 WRT-DELETE-001. SQ2014.2 +037100 PERFORM DE-LETE. SQ2014.2 +037200 GO TO WRT-WRITE-001. SQ2014.2 +037300 WRT-FAIL-001. SQ2014.2 +037400 MOVE "VII-5 1.3.8; VII-29 D." TO RE-MARK. SQ2014.2 +037500 PERFORM FAIL. SQ2014.2 +037600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +037700 MOVE 1 TO CORRECT-18V0. SQ2014.2 +037800 WRT-WRITE-001. SQ2014.2 +037900 MOVE "LINAGE-CT AFTER OPEN" TO FEATURE. SQ2014.2 +038000 MOVE "WRT-TEST-01" TO PAR-NAME. SQ2014.2 +038100 MOVE "FILE IS CLOSED, THEN OPENED" TO RE-MARK. SQ2014.2 +038200 PERFORM PRINT-DETAIL. SQ2014.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +038400 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +038500 WRT-INIT-GF-001. SQ2014.2 +038600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2014.2 +038700 MOVE "TEST WRT-TEST-01 MUST BE PRINTED BEFORE THE HEADER OF TSQ2014.2 +038800- "HIS LIST" TO PRINT-REC. SQ2014.2 +038900 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +039000 MOVE "THIS PROGRAM TESTS THE STATEMENT:" TO PRINT-REC. SQ2014.2 +039100 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +039200 MOVE " WRITE ... ADVANCING ... " TO PRINT-REC. SQ2014.2 +039300 WRITE PRINT-REC AFTER ADVANCING 2 LINE. SQ2014.2 +039400 MOVE "THE RULES ARE DESCRIBED ON PAGE VII-52 THROUGH VII-56."SQ2014.2 +039500 TO PRINT-REC. SQ2014.2 +039600 WRITE PRINT-REC AFTER ADVANCING 2 LINE. SQ2014.2 +039700 MOVE "THE LOGICAL PAGE SIZE IS EQUAL TO 66" SQ2014.2 +039800 TO PRINT-REC. SQ2014.2 +039900 WRITE PRINT-REC AFTER ADVANCING 4 LINE. SQ2014.2 +040000 WRT-TEST-002. SQ2014.2 +040100* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +040200* OF A WRITE ADVANCING PAGE OPERATION. SQ2014.2 +040300* IT SHOULD BE EQUAL TO 1. SQ2014.2 +040400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE. SQ2014.2 +040600 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +040700 PERFORM PASS SQ2014.2 +040800 GO TO WRT-WRITE-002. SQ2014.2 +040900 GO TO WRT-FAIL-002. SQ2014.2 +041000 WRT-DELETE-002. SQ2014.2 +041100 PERFORM DE-LETE. SQ2014.2 +041200 GO TO WRT-WRITE-002. SQ2014.2 +041300 WRT-FAIL-002. SQ2014.2 +041400 MOVE "VII-5 1.3.8; VII-28 C (1)" TO RE-MARK. SQ2014.2 +041500 PERFORM FAIL. SQ2014.2 +041600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +041700 MOVE 1 TO CORRECT-18V0. SQ2014.2 +041800 WRT-WRITE-002. SQ2014.2 +041900 MOVE "L-C AFTER WRITE PAGE" TO FEATURE. SQ2014.2 +042000 MOVE "WRT-TEST-02" TO PAR-NAME. SQ2014.2 +042100 PERFORM PRINT-DETAIL. SQ2014.2 +042200 WRT-TEST-003. SQ2014.2 +042300* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +042400* OF A WRITE AFTER ADVANCING 1 LINE OPERATION ON WHICHSQ2014.2 +042500* LOGICAL PAGE OVERFLOW OCCURS. IT SHOULD EQUAL 1. SQ2014.2 +042600 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE. SQ2014.2 +042800 PERFORM BLANK-LINE-PRINT 50 TIMES. SQ2014.2 +042900 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +043000 PERFORM PASS SQ2014.2 +043100 GO TO WRT-WRITE-003. SQ2014.2 +043200 GO TO WRT-FAIL-003. SQ2014.2 +043300 WRT-DELETE-003. SQ2014.2 +043400 PERFORM DE-LETE. SQ2014.2 +043500 GO TO WRT-WRITE-003. SQ2014.2 +043600 WRT-FAIL-003. SQ2014.2 +043700 MOVE "VII-5 1.3.8; VII-29 C 4)" TO RE-MARK. SQ2014.2 +043800 PERFORM FAIL. SQ2014.2 +043900 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +044000 MOVE 1 TO CORRECT-18V0. SQ2014.2 +044100 WRT-WRITE-003. SQ2014.2 +044200 MOVE "L-C AFT PAGE OVERFLW" TO FEATURE. SQ2014.2 +044300 MOVE "WRT-TEST-03" TO PAR-NAME. SQ2014.2 +044400 PERFORM PRINT-DETAIL. SQ2014.2 +044500 WRT-TEST-004. SQ2014.2 +044600* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +044700* OF A WRITE OPERATION WITHOUT AN ADVANCING PHRASE. SQ2014.2 +044800* IT SHOULD BE INCREMENTED BY 1. SQ2014.2 +044900 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +045000 ADD 1 TO LC-HOLD. SQ2014.2 +045100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +045200 WRITE DUMMY-RECORD. SQ2014.2 +045300 IF LC-HOLD EQUAL TO LINAGE-COUNTER SQ2014.2 +045400 PERFORM PASS SQ2014.2 +045500 GO TO WRT-WRITE-004. SQ2014.2 +045600 GO TO WRT-FAIL-004. SQ2014.2 +045700 WRT-DELETE-004. SQ2014.2 +045800 PERFORM DE-LETE. SQ2014.2 +045900 GO TO WRT-WRITE-004. SQ2014.2 +046000 WRT-FAIL-004. SQ2014.2 +046100 MOVE "VII-5 1.3.8; VII-29 C 3)" TO RE-MARK. SQ2014.2 +046200 PERFORM FAIL. SQ2014.2 +046300 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +046400 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +046500 WRT-WRITE-004. SQ2014.2 +046600 MOVE "L-C AFT WRT W/O ADV" TO FEATURE. SQ2014.2 +046700 MOVE "WRT-TEST-04" TO PAR-NAME. SQ2014.2 +046800 PERFORM PRINT-DETAIL. SQ2014.2 +046900 WRT-TEST-005. SQ2014.2 +047000* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +047100* OF A WRITE ADVANCING INTEGER LINE OPERATION. SQ2014.2 +047200 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +047300 ADD 5 TO LC-HOLD. SQ2014.2 +047400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +047500 WRITE DUMMY-RECORD BEFORE ADVANCING 5 LINE. SQ2014.2 +047600 IF LINAGE-COUNTER EQUAL TO LC-HOLD SQ2014.2 +047700 PERFORM PASS SQ2014.2 +047800 GO TO WRT-WRITE-005. SQ2014.2 +047900 GO TO WRT-FAIL-005. SQ2014.2 +048000 WRT-DELETE-005. SQ2014.2 +048100 PERFORM DE-LETE. SQ2014.2 +048200 GO TO WRT-WRITE-005. SQ2014.2 +048300 WRT-FAIL-005. SQ2014.2 +048400 MOVE "VII-5 1.3.8; VII-28 (9) C 1) INTEGER" TO RE-MARK. SQ2014.2 +048500 PERFORM FAIL. SQ2014.2 +048600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +048700 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +048800 WRT-WRITE-005. SQ2014.2 +048900 MOVE "L-C AFT WRT ADV INT" TO FEATURE. SQ2014.2 +049000 MOVE "WRT-TEST-05" TO PAR-NAME. SQ2014.2 +049100 PERFORM PRINT-DETAIL. SQ2014.2 +049200 WRT-TEST-006. SQ2014.2 +049300* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +049400* OF A WRITE IDENTIFIER-2 LINES OPERATION. SQ2014.2 +049500 MOVE 4 TO IDENTIFIER-2. SQ2014.2 +049600 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +049700 ADD 4 TO LC-HOLD. SQ2014.2 +049800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +049900 WRITE DUMMY-RECORD BEFORE ADVANCING IDENTIFIER-2 LINES. SQ2014.2 +050000 IF LINAGE-COUNTER EQUAL TO LC-HOLD SQ2014.2 +050100 PERFORM PASS SQ2014.2 +050200 GO TO WRT-WRITE-006. SQ2014.2 +050300 GO TO WRT-FAIL-006. SQ2014.2 +050400 WRT-DELETE-006. SQ2014.2 +050500 PERFORM DE-LETE. SQ2014.2 +050600 GO TO WRT-WRITE-006. SQ2014.2 +050700 WRT-FAIL-006. SQ2014.2 +050800 MOVE "VII-5 1.3.8; VII-29 (9) C 2) IDENTIFIER-2" TO RE-MARK.SQ2014.2 +050900 PERFORM FAIL. SQ2014.2 +051000 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +051100 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +051200 WRT-WRITE-006. SQ2014.2 +051300 MOVE "L-C AFT WRT ADV ID-2" TO FEATURE. SQ2014.2 +051400 MOVE "WRT-TEST-06" TO PAR-NAME. SQ2014.2 +051500 PERFORM PRINT-DETAIL. SQ2014.2 +051600 WRT-INIT-007. SQ2014.2 +051700 PERFORM BLANK-LINE-PRINT 10 TIMES. SQ2014.2 +051800 MOVE "THE FOLLOWING SQ201M TESTS CANNOT BE TESTED USING THE NSQ2014.2 +051900- "ORMAL PASS/FAIL METHODS. A VISUAL CHECK WILL HAVE TO TO BE SQ2014.2 +052000- "MADE" TO PRINT-REC. SQ2014.2 +052100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +052200 MOVE "TO DETERMINE THE ACCURACY OF EACH TEST" TO PRINT-REC. SQ2014.2 +052300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +052400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +052500 PERFORM BLANK-LINE-PRINT 10 TIMES. SQ2014.2 +052600 WRT-TEST-007. SQ2014.2 +052700* THIS IS A TEST FOR WRITE AFTER ADVANCING PAGE. SQ2014.2 +052800* THE RECORD SHOULD PRINT ON THE FIRST LINE OF THE SQ2014.2 +052900* NEXT LOGICAL PAGE. SQ2014.2 +053000 MOVE "WRT AFT ADV PAGE" TO FEATURE. SQ2014.2 +053100 MOVE "WRT-TEST-07" TO PAR-NAME. SQ2014.2 +053200 PERFORM PRINT-DETAIL. SQ2014.2 +053300 MOVE TOP-LINE TO PRINT-REC. SQ2014.2 +053400 WRITE PRINT-REC AFTER ADVANCING PAGE. SQ2014.2 +053500 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +053600 WRT-TEST-008. SQ2014.2 +053700******************************************************************SQ2014.2 +053800* *SQ2014.2 +053900* THIS IS A TEST FOR WRITE ... NOT AT END-OF-PAGE... *SQ2014.2 +054000* --- *SQ2014.2 +054100******************************************************************SQ2014.2 +054200 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +054300 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +054400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +054500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +054600 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +054700 PERFORM EOP-TEST-1 132 TIMES. SQ2014.2 +054800 VAR-TEST-008. SQ2014.2 +054900 IF WRITE-SWITCH NOT = 1 SQ2014.2 +055000 GO TO VAR-FAIL-008. SQ2014.2 +055100 VAR-PASS-008. SQ2014.2 +055200 PERFORM PASS. SQ2014.2 +055300 GO TO VAR-WRITE-008. SQ2014.2 +055400 VAR-FAIL-008. SQ2014.2 +055500 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" SQ2014.2 +055600 TO RE-MARK. SQ2014.2 +055700 PERFORM FAIL. SQ2014.2 +055800 VAR-WRITE-008. SQ2014.2 +055900 MOVE "NOT END-OF-PAGE" TO FEATURE. SQ2014.2 +056000 MOVE "VAR-TEST-008" TO PAR-NAME. SQ2014.2 +056100 PERFORM PRINT-DETAIL. SQ2014.2 +056200 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +056300 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +056400 WRT-TEST-009. SQ2014.2 +056500* THIS IS A TEST FOR WRITE ...; AT EOP ... SQ2014.2 +056600******************************************************************SQ2014.2 +056700* *SQ2014.2 +056800* THIS IS A TEST FOR WRITE ... NOT AT EOP ... *SQ2014.2 +056900* --- *SQ2014.2 +057000******************************************************************SQ2014.2 +057100 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +057200 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +057300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +057400 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +057500 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +057600 PERFORM EOP-TEST-2 132 TIMES. SQ2014.2 +057700 VAR-TEST-009. SQ2014.2 +057800 IF WRITE-SWITCH NOT = 1 SQ2014.2 +057900 GO TO VAR-FAIL-009. SQ2014.2 +058000 VAR-PASS-009. SQ2014.2 +058100 PERFORM PASS. SQ2014.2 +058200 GO TO VAR-WRITE-009. SQ2014.2 +058300 VAR-FAIL-009. SQ2014.2 +058400 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" TO RE-MARKSQ2014.2 +058500 PERFORM FAIL. SQ2014.2 +058600 VAR-WRITE-009. SQ2014.2 +058700 MOVE "NOT AT EOP" TO FEATURE. SQ2014.2 +058800 MOVE "VAR-TEST-009" TO PAR-NAME. SQ2014.2 +058900 PERFORM PRINT-DETAIL. SQ2014.2 +059000 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +059100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +059200 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +059300 WRT-TEST-010. SQ2014.2 +059400* THIS IS A TEST FOR WRITE... ; END-OF-PAGE ... SQ2014.2 +059500******************************************************************SQ2014.2 +059600* *SQ2014.2 +059700* THIS IS A TEST FOR WRITE ... NOT END-OF-PAGE ... *SQ2014.2 +059800* --- *SQ2014.2 +059900* AND END-WRITE *SQ2014.2 +060000******************************************************************SQ2014.2 +060100 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +060200 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +060300 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +060400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +060500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +060600 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +060700 PERFORM EOP-TEST-3 132 TIMES. SQ2014.2 +060800 VAR-TEST-010. SQ2014.2 +060900 IF WRITE-SWITCH NOT = 1 SQ2014.2 +061000 GO TO VAR-FAIL-010. SQ2014.2 +061100 VAR-PASS-010. SQ2014.2 +061200 PERFORM PASS. SQ2014.2 +061300 GO TO VAR-WRITE-010. SQ2014.2 +061400 VAR-FAIL-010. SQ2014.2 +061500 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" SQ2014.2 +061600 TO RE-MARK. SQ2014.2 +061700 PERFORM FAIL. SQ2014.2 +061800 VAR-WRITE-010. SQ2014.2 +061900 MOVE "NOT END-OF-PAGE" TO FEATURE. SQ2014.2 +062000 MOVE "VAR-TEST-010" TO PAR-NAME. SQ2014.2 +062100 PERFORM PRINT-DETAIL. SQ2014.2 +062200 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +062300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +062400 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +062500 VAR-TEST-010-1. SQ2014.2 +062600 IF END-WRITE-SWITCH NOT EQUAL TO 1 SQ2014.2 +062700 GO TO VAR-FAIL-010-1. SQ2014.2 +062800 VAR-PASS-010-1. SQ2014.2 +062900 PERFORM PASS. SQ2014.2 +063000 GO TO VAR-WRITE-010-1. SQ2014.2 +063100 VAR-FAIL-010-1. SQ2014.2 +063200 MOVE " NOT CORRECT; IV-27 4.4.4" TO RE-MARK. SQ2014.2 +063300 PERFORM FAIL. SQ2014.2 +063400 VAR-WRITE-010-1. SQ2014.2 +063500 MOVE "END-WRITE;NOT END-OF" TO FEATURE. SQ2014.2 +063600 MOVE "VAR-TEST-010-1" TO PAR-NAME. SQ2014.2 +063700 PERFORM PRINT-DETAIL. SQ2014.2 +063800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +063900 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +064000 WRT-TEST-011. SQ2014.2 +064100* THIS IS A TEST FOR WRITE ...EOP... SQ2014.2 +064200******************************************************************SQ2014.2 +064300* *SQ2014.2 +064400* THIS IS A TEST FOR WRITE ... NOT EOP ... *SQ2014.2 +064500* --- *SQ2014.2 +064600******************************************************************SQ2014.2 +064700 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +064800 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +064900* MOVE "EOP" TO FEATURE. SQ2014.2 +065000* MOVE "WRT-TEST-11" TO PAR-NAME. SQ2014.2 +065100* PERFORM PRINT-DETAIL. SQ2014.2 +065200 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +065300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +065400 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +065500 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +065600 PERFORM EOP-TEST-4 132 TIMES. SQ2014.2 +065700 VAR-TEST-011. SQ2014.2 +065800 IF WRITE-SWITCH NOT = 1 SQ2014.2 +065900 GO TO VAR-FAIL-011. SQ2014.2 +066000 VAR-PASS-011. SQ2014.2 +066100 PERFORM PASS. SQ2014.2 +066200 GO TO VAR-WRITE-011. SQ2014.2 +066300 VAR-FAIL-011. SQ2014.2 +066400 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" TO RE-MARK. SQ2014.2 +066500 PERFORM FAIL. SQ2014.2 +066600 VAR-WRITE-011. SQ2014.2 +066700 MOVE "NOT EOP" TO FEATURE. SQ2014.2 +066800 MOVE "VAR-TEST-011" TO PAR-NAME. SQ2014.2 +066900 PERFORM PRINT-DETAIL. SQ2014.2 +067000 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +067100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +067200 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +067300 VAR-TEST-011-1. SQ2014.2 +067400 IF END-WRITE-SWITCH NOT EQUAL TO 1 SQ2014.2 +067500 GO TO VAR-FAIL-011-1. SQ2014.2 +067600 VAR-PASS-011-1. SQ2014.2 +067700 PERFORM PASS. SQ2014.2 +067800 GO TO VAR-WRITE-011-1. SQ2014.2 +067900 VAR-FAIL-011-1. SQ2014.2 +068000 MOVE " NOT CORRECT; IV-27 4.4.4" TO RE-MARK. SQ2014.2 +068100 PERFORM FAIL. SQ2014.2 +068200 VAR-WRITE-011-1. SQ2014.2 +068300 MOVE "END-WRITE; NOT EOP" TO FEATURE. SQ2014.2 +068400 MOVE "VAR-TEST-011-1" TO PAR-NAME. SQ2014.2 +068500 PERFORM PRINT-DETAIL. SQ2014.2 +068600 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +068700 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +068800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +068900 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +069000 SQ201M-END-ROUTINE. SQ2014.2 +069100 MOVE "END OF SQ201M VALIDATION TESTS" TO PRINT-REC. SQ2014.2 +069200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +069300 GO TO CCVS-EXIT. SQ2014.2 +069400 EOP-TEST-1. SQ2014.2 +069500 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +069600 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +069700 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT END-OF-PAGE SQ2014.2 +069800 MOVE 1 TO FOOT-COUNT SQ2014.2 +069900 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +070000 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +070100******************************************************************SQ2014.2 +070200* *SQ2014.2 +070300* NEW: NOT AT END-OF-PAGE *SQ2014.2 +070400* --- *SQ2014.2 +070500******************************************************************SQ2014.2 +070600 NOT AT END-OF-PAGE SQ2014.2 +070700 MOVE 1 TO WRITE-SWITCH. SQ2014.2 +070800 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +070900 EOP-TEST-2. SQ2014.2 +071000 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +071100 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +071200 WRITE PRINT-REC BEFORE ADVANCING 1 LINE ; AT EOP SQ2014.2 +071300 MOVE 1 TO FOOT-COUNT SQ2014.2 +071400 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +071500 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +071600******************************************************************SQ2014.2 +071700* *SQ2014.2 +071800* NEW: NOT AT EOP *SQ2014.2 +071900* *SQ2014.2 +072000******************************************************************SQ2014.2 +072100 NOT AT EOP SQ2014.2 +072200 MOVE 1 TO WRITE-SWITCH. SQ2014.2 +072300 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +072400 EOP-TEST-3. SQ2014.2 +072500 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +072600 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +072700 IF END-WRITE-SWITCH EQUAL TO 1 OR END-WRITE-SWITCH EQUAL TO 0SQ2014.2 +072800 WRITE PRINT-REC BEFORE ADVANCING 1 LINE ; END-OF-PAGE SQ2014.2 +072900 MOVE 1 TO FOOT-COUNT SQ2014.2 +073000 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +073100 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +073200******************************************************************SQ2014.2 +073300* *SQ2014.2 +073400* NEW: NOT END-OF-PAGE *SQ2014.2 +073500* --- *SQ2014.2 +073600******************************************************************SQ2014.2 +073700 NOT END-OF-PAGE SQ2014.2 +073800 MOVE 1 TO WRITE-SWITCH SQ2014.2 +073900 END-WRITE SQ2014.2 +074000 MOVE 1 TO END-WRITE-SWITCH. SQ2014.2 +074100 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +074200 EOP-TEST-4. SQ2014.2 +074300 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +074400 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +074500 IF END-WRITE-SWITCH EQUAL TO 1 OR END-WRITE-SWITCH EQUAL TO 0SQ2014.2 +074600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE EOP SQ2014.2 +074700 MOVE 1 TO FOOT-COUNT SQ2014.2 +074800 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +074900 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +075000******************************************************************SQ2014.2 +075100* *SQ2014.2 +075200* NEW: NOT EOP *SQ2014.2 +075300* --- *SQ2014.2 +075400******************************************************************SQ2014.2 +075500 NOT EOP SQ2014.2 +075600 MOVE 1 TO WRITE-SWITCH SQ2014.2 +075700 END-WRITE SQ2014.2 +075800 MOVE 1 TO END-WRITE-SWITCH. SQ2014.2 +075900 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +076000 PRINT-FOOTING. SQ2014.2 +076100 MOVE LINAGE-COUNTER TO FOOT-LC. SQ2014.2 +076200 MOVE FOOT-LINE TO PRINT-REC. SQ2014.2 +076300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +076400 ADD 1 TO FOOT-COUNT. SQ2014.2 +076500 ADD 1 TO FOOT-LINE-NO. SQ2014.2 +076600 WRITE-EOP-MESSAGE. SQ2014.2 +076700 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +076800 MOVE EOP-MESSAGE-1 TO PRINT-REC. SQ2014.2 +076900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077000 MOVE EOP-MESSAGE-2 TO PRINT-REC. SQ2014.2 +077100 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077200 MOVE EOP-MESSAGE-3 TO PRINT-REC. SQ2014.2 +077300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +077500 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +077600 CCVS-EXIT SECTION. SQ2014.2 +077700 CCVS-999999. SQ2014.2 +077800 GO TO CLOSE-FILES. SQ2014.2 +*END-OF,SQ201M +*HEADER,COBOL,SQ202A +000100 IDENTIFICATION DIVISION. SQ2024.2 +000200 PROGRAM-ID. SQ2024.2 +000300 SQ202A. SQ2024.2 +000400**************************************************************** SQ2024.2 +000500* * SQ2024.2 +000600* VALIDATION FOR:- * SQ2024.2 +000700* " HIGH ". SQ2024.2 +000800* * SQ2024.2 +000900* CREATION DATE / VALIDATION DATE * SQ2024.2 +001000* "4.2 ". SQ2024.2 +001100* * SQ2024.2 +001200* THE ROUTINE SQ202A (OLD SQ203) CREATES A MAGNETIC TAPE FILE ANDSQ2024.2 +001300* PASSES IT ON TO SQ203A TO BE OPENED AS INPUT UNDER A SELECT SQ2024.2 +001400* OPTIONAL CLAUSE. SQ2024.2 +001500 ENVIRONMENT DIVISION. SQ2024.2 +001600 CONFIGURATION SECTION. SQ2024.2 +001700 SOURCE-COMPUTER. SQ2024.2 +001800 XXXXX082. SQ2024.2 +001900 OBJECT-COMPUTER. SQ2024.2 +002000 XXXXX083. SQ2024.2 +002100 INPUT-OUTPUT SECTION. SQ2024.2 +002200 FILE-CONTROL. SQ2024.2 +002300P SELECT RAW-DATA ASSIGN TO SQ2024.2 +002400P XXXXX062 SQ2024.2 +002500P ORGANIZATION IS INDEXED SQ2024.2 +002600P ACCESS MODE IS RANDOM SQ2024.2 +002700P RECORD KEY IS RAW-DATA-KEY. SQ2024.2 +002800 SELECT PRINT-FILE ASSIGN TO SQ2024.2 +002900 XXXXX055. SQ2024.2 +003000 SELECT SQ-FS1 ASSIGN TO SQ2024.2 +003100 XXXXP001. SQ2024.2 +003200 DATA DIVISION. SQ2024.2 +003300 FILE SECTION. SQ2024.2 +003400P SQ2024.2 +003500PFD RAW-DATA. SQ2024.2 +003600P SQ2024.2 +003700P01 RAW-DATA-SATZ. SQ2024.2 +003800P 05 RAW-DATA-KEY PIC X(6). SQ2024.2 +003900P 05 C-DATE PIC 9(6). SQ2024.2 +004000P 05 C-TIME PIC 9(8). SQ2024.2 +004100P 05 C-NO-OF-TESTS PIC 99. SQ2024.2 +004200P 05 C-OK PIC 999. SQ2024.2 +004300P 05 C-ALL PIC 999. SQ2024.2 +004400P 05 C-FAIL PIC 999. SQ2024.2 +004500P 05 C-DELETED PIC 999. SQ2024.2 +004600P 05 C-INSPECT PIC 999. SQ2024.2 +004700P 05 C-NOTE PIC X(13). SQ2024.2 +004800P 05 C-INDENT PIC X. SQ2024.2 +004900P 05 C-ABORT PIC X(8). SQ2024.2 +005000 FD PRINT-FILE SQ2024.2 +005100C LABEL RECORDS SQ2024.2 +005200C XXXXX084 SQ2024.2 +005300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2024.2 +005400 . SQ2024.2 +005500 01 PRINT-REC PICTURE X(120). SQ2024.2 +005600 01 DUMMY-RECORD PICTURE X(120). SQ2024.2 +005700 FD SQ-FS1 SQ2024.2 +005800C LABEL RECORD STANDARD SQ2024.2 +005900 BLOCK CONTAINS 120 CHARACTERS. SQ2024.2 +006000 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2024.2 +006100 WORKING-STORAGE SECTION. SQ2024.2 +006200 77 RECORD-OUT-COUNT PIC 999. SQ2024.2 +006300 77 RECORDS-IN-ERROR PIC 999. SQ2024.2 +006400 01 COUNT-OF-RECS PIC 9999. SQ2024.2 +006500 01 FILE-RECORD-INFORMATION-REC. SQ2024.2 +006600 03 FILE-RECORD-INFO-SKELETON. SQ2024.2 +006700 05 FILLER PICTURE X(48) VALUE SQ2024.2 +006800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2024.2 +006900 05 FILLER PICTURE X(46) VALUE SQ2024.2 +007000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2024.2 +007100 05 FILLER PICTURE X(26) VALUE SQ2024.2 +007200 ",LFIL=000000,ORG= ,LBLR= ". SQ2024.2 +007300 05 FILLER PICTURE X(37) VALUE SQ2024.2 +007400 ",RECKEY= ". SQ2024.2 +007500 05 FILLER PICTURE X(38) VALUE SQ2024.2 +007600 ",ALTKEY1= ". SQ2024.2 +007700 05 FILLER PICTURE X(38) VALUE SQ2024.2 +007800 ",ALTKEY2= ". SQ2024.2 +007900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2024.2 +008000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2024.2 +008100 05 FILE-RECORD-INFO-P1-120. SQ2024.2 +008200 07 FILLER PIC X(5). SQ2024.2 +008300 07 XFILE-NAME PIC X(6). SQ2024.2 +008400 07 FILLER PIC X(8). SQ2024.2 +008500 07 XRECORD-NAME PIC X(6). SQ2024.2 +008600 07 FILLER PIC X(1). SQ2024.2 +008700 07 REELUNIT-NUMBER PIC 9(1). SQ2024.2 +008800 07 FILLER PIC X(7). SQ2024.2 +008900 07 XRECORD-NUMBER PIC 9(6). SQ2024.2 +009000 07 FILLER PIC X(6). SQ2024.2 +009100 07 UPDATE-NUMBER PIC 9(2). SQ2024.2 +009200 07 FILLER PIC X(5). SQ2024.2 +009300 07 ODO-NUMBER PIC 9(4). SQ2024.2 +009400 07 FILLER PIC X(5). SQ2024.2 +009500 07 XPROGRAM-NAME PIC X(5). SQ2024.2 +009600 07 FILLER PIC X(7). SQ2024.2 +009700 07 XRECORD-LENGTH PIC 9(6). SQ2024.2 +009800 07 FILLER PIC X(7). SQ2024.2 +009900 07 CHARS-OR-RECORDS PIC X(2). SQ2024.2 +010000 07 FILLER PIC X(1). SQ2024.2 +010100 07 XBLOCK-SIZE PIC 9(4). SQ2024.2 +010200 07 FILLER PIC X(6). SQ2024.2 +010300 07 RECORDS-IN-FILE PIC 9(6). SQ2024.2 +010400 07 FILLER PIC X(5). SQ2024.2 +010500 07 XFILE-ORGANIZATION PIC X(2). SQ2024.2 +010600 07 FILLER PIC X(6). SQ2024.2 +010700 07 XLABEL-TYPE PIC X(1). SQ2024.2 +010800 05 FILE-RECORD-INFO-P121-240. SQ2024.2 +010900 07 FILLER PIC X(8). SQ2024.2 +011000 07 XRECORD-KEY PIC X(29). SQ2024.2 +011100 07 FILLER PIC X(9). SQ2024.2 +011200 07 ALTERNATE-KEY1 PIC X(29). SQ2024.2 +011300 07 FILLER PIC X(9). SQ2024.2 +011400 07 ALTERNATE-KEY2 PIC X(29). SQ2024.2 +011500 07 FILLER PIC X(7). SQ2024.2 +011600 01 TEST-RESULTS. SQ2024.2 +011700 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +011800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2024.2 +011900 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +012000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2024.2 +012100 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +012200 02 PAR-NAME. SQ2024.2 +012300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2024.2 +012400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2024.2 +012500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2024.2 +012600 03 FILLER PIC X(5) VALUE SPACE. SQ2024.2 +012700 02 FILLER PIC X(10) VALUE SPACE. SQ2024.2 +012800 02 RE-MARK PIC X(61). SQ2024.2 +012900 01 TEST-COMPUTED. SQ2024.2 +013000 02 FILLER PIC X(30) VALUE SPACE. SQ2024.2 +013100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2024.2 +013200 02 COMPUTED-X. SQ2024.2 +013300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2024.2 +013400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2024.2 +013500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2024.2 +013600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2024.2 +013700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2024.2 +013800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2024.2 +013900 04 COMPUTED-18V0 PICTURE -9(18). SQ2024.2 +014000 04 FILLER PICTURE X. SQ2024.2 +014100 03 FILLER PIC X(50) VALUE SPACE. SQ2024.2 +014200 01 TEST-CORRECT. SQ2024.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SQ2024.2 +014400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2024.2 +014500 02 CORRECT-X. SQ2024.2 +014600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2024.2 +014700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2024.2 +014800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2024.2 +014900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2024.2 +015000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2024.2 +015100 03 CR-18V0 REDEFINES CORRECT-A. SQ2024.2 +015200 04 CORRECT-18V0 PICTURE -9(18). SQ2024.2 +015300 04 FILLER PICTURE X. SQ2024.2 +015400 03 FILLER PIC X(50) VALUE SPACE. SQ2024.2 +015500 01 CCVS-C-1. SQ2024.2 +015600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2024.2 +015700- "SS PARAGRAPH-NAME SQ2024.2 +015800- " REMARKS". SQ2024.2 +015900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2024.2 +016000 01 CCVS-C-2. SQ2024.2 +016100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +016200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2024.2 +016300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2024.2 +016400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2024.2 +016500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2024.2 +016600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2024.2 +016700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2024.2 +016800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2024.2 +016900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2024.2 +017000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2024.2 +017100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2024.2 +017200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2024.2 +017300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2024.2 +017400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2024.2 +017500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2024.2 +017600 01 CCVS-H-1. SQ2024.2 +017700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2024.2 +017800 02 FILLER PICTURE X(67) VALUE SQ2024.2 +017900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2024.2 +018000- " SYSTEM". SQ2024.2 +018100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2024.2 +018200 01 CCVS-H-2. SQ2024.2 +018300 02 FILLER PICTURE X(52) VALUE IS SQ2024.2 +018400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2024.2 +018500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2024.2 +018600 02 TEST-ID PICTURE IS X(9). SQ2024.2 +018700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2024.2 +018800 01 CCVS-H-3. SQ2024.2 +018900 02 FILLER PICTURE X(34) VALUE SQ2024.2 +019000 " FOR OFFICIAL USE ONLY ". SQ2024.2 +019100 02 FILLER PICTURE X(58) VALUE SQ2024.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2024.2 +019300 02 FILLER PICTURE X(28) VALUE SQ2024.2 +019400 " COPYRIGHT 1985 ". SQ2024.2 +019500 01 CCVS-E-1. SQ2024.2 +019600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2024.2 +019700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2024.2 +019800 02 ID-AGAIN PICTURE IS X(9). SQ2024.2 +019900 02 FILLER PICTURE X(45) VALUE IS SQ2024.2 +020000 " NTIS DISTRIBUTION COBOL 85". SQ2024.2 +020100 01 CCVS-E-2. SQ2024.2 +020200 02 FILLER PICTURE X(31) VALUE SQ2024.2 +020300 SPACE. SQ2024.2 +020400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2024.2 +020500 02 CCVS-E-2-2. SQ2024.2 +020600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2024.2 +020700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +020800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2024.2 +020900 01 CCVS-E-3. SQ2024.2 +021000 02 FILLER PICTURE X(22) VALUE SQ2024.2 +021100 " FOR OFFICIAL USE ONLY". SQ2024.2 +021200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2024.2 +021300 02 FILLER PICTURE X(58) VALUE SQ2024.2 +021400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2024.2 +021500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2024.2 +021600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2024.2 +021700 01 CCVS-E-4. SQ2024.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2024.2 +021900 02 FILLER PIC XXXX VALUE " OF ". SQ2024.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2024.2 +022100 02 FILLER PIC X(40) VALUE SQ2024.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2024.2 +022300 01 XXINFO. SQ2024.2 +022400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2024.2 +022500 02 INFO-TEXT. SQ2024.2 +022600 04 FILLER PIC X(20) VALUE SPACE. SQ2024.2 +022700 04 XXCOMPUTED PIC X(20). SQ2024.2 +022800 04 FILLER PIC X(5) VALUE SPACE. SQ2024.2 +022900 04 XXCORRECT PIC X(20). SQ2024.2 +023000 01 HYPHEN-LINE. SQ2024.2 +023100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +023200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2024.2 +023300- "*****************************************". SQ2024.2 +023400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2024.2 +023500- "******************************". SQ2024.2 +023600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2024.2 +023700 "SQ202A". SQ2024.2 +023800 PROCEDURE DIVISION. SQ2024.2 +023900 CCVS1 SECTION. SQ2024.2 +024000 OPEN-FILES. SQ2024.2 +024100P OPEN I-O RAW-DATA. SQ2024.2 +024200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2024.2 +024300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2024.2 +024400P MOVE "ABORTED " TO C-ABORT. SQ2024.2 +024500P ADD 1 TO C-NO-OF-TESTS. SQ2024.2 +024600P ACCEPT C-DATE FROM DATE. SQ2024.2 +024700P ACCEPT C-TIME FROM TIME. SQ2024.2 +024800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2024.2 +024900PEND-E-1. SQ2024.2 +025000P CLOSE RAW-DATA. SQ2024.2 +025100 OPEN OUTPUT PRINT-FILE. SQ2024.2 +025200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2024.2 +025300 MOVE SPACE TO TEST-RESULTS. SQ2024.2 +025400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2024.2 +025500 MOVE ZERO TO REC-SKL-SUB. SQ2024.2 +025600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2024.2 +025700 CCVS-INIT-FILE. SQ2024.2 +025800 ADD 1 TO REC-SKL-SUB. SQ2024.2 +025900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2024.2 +026000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2024.2 +026100 CCVS-INIT-EXIT. SQ2024.2 +026200 GO TO CCVS1-EXIT. SQ2024.2 +026300 CLOSE-FILES. SQ2024.2 +026400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2024.2 +026500P OPEN I-O RAW-DATA. SQ2024.2 +026600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2024.2 +026700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2024.2 +026800P MOVE "OK. " TO C-ABORT. SQ2024.2 +026900P MOVE PASS-COUNTER TO C-OK. SQ2024.2 +027000P MOVE ERROR-HOLD TO C-ALL. SQ2024.2 +027100P MOVE ERROR-COUNTER TO C-FAIL. SQ2024.2 +027200P MOVE DELETE-CNT TO C-DELETED. SQ2024.2 +027300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2024.2 +027400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2024.2 +027500PEND-E-2. SQ2024.2 +027600P CLOSE RAW-DATA. SQ2024.2 +027700 TERMINATE-CCVS. SQ2024.2 +027800S EXIT PROGRAM. SQ2024.2 +027900STERMINATE-CALL. SQ2024.2 +028000 STOP RUN. SQ2024.2 +028100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2024.2 +028200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2024.2 +028300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2024.2 +028400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2024.2 +028500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2024.2 +028600 PRINT-DETAIL. SQ2024.2 +028700 IF REC-CT NOT EQUAL TO ZERO SQ2024.2 +028800 MOVE "." TO PARDOT-X SQ2024.2 +028900 MOVE REC-CT TO DOTVALUE. SQ2024.2 +029000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2024.2 +029100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2024.2 +029200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2024.2 +029300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2024.2 +029400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2024.2 +029500 MOVE SPACE TO CORRECT-X. SQ2024.2 +029600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2024.2 +029700 MOVE SPACE TO RE-MARK. SQ2024.2 +029800 HEAD-ROUTINE. SQ2024.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +030000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2024.2 +030100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2024.2 +030200 COLUMN-NAMES-ROUTINE. SQ2024.2 +030300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +030400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +030500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +030600 END-ROUTINE. SQ2024.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2024.2 +030800 END-RTN-EXIT. SQ2024.2 +030900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +031000 END-ROUTINE-1. SQ2024.2 +031100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2024.2 +031200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2024.2 +031300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2024.2 +031400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2024.2 +031500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2024.2 +031600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2024.2 +031700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2024.2 +031800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2024.2 +031900 END-ROUTINE-12. SQ2024.2 +032000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2024.2 +032100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2024.2 +032200 MOVE "NO " TO ERROR-TOTAL SQ2024.2 +032300 ELSE SQ2024.2 +032400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2024.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2024.2 +032600 PERFORM WRITE-LINE. SQ2024.2 +032700 END-ROUTINE-13. SQ2024.2 +032800 IF DELETE-CNT IS EQUAL TO ZERO SQ2024.2 +032900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2024.2 +033000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2024.2 +033100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2024.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2024.2 +033400 MOVE "NO " TO ERROR-TOTAL SQ2024.2 +033500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2024.2 +033600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2024.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033900 WRITE-LINE. SQ2024.2 +034000 ADD 1 TO RECORD-COUNT. SQ2024.2 +034100Y IF RECORD-COUNT GREATER 50 SQ2024.2 +034200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2024.2 +034300Y MOVE SPACE TO DUMMY-RECORD SQ2024.2 +034400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2024.2 +034500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2024.2 +034600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2024.2 +034700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2024.2 +034800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2024.2 +034900Y MOVE ZERO TO RECORD-COUNT. SQ2024.2 +035000 PERFORM WRT-LN. SQ2024.2 +035100 WRT-LN. SQ2024.2 +035200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2024.2 +035300 MOVE SPACE TO DUMMY-RECORD. SQ2024.2 +035400 BLANK-LINE-PRINT. SQ2024.2 +035500 PERFORM WRT-LN. SQ2024.2 +035600 FAIL-ROUTINE. SQ2024.2 +035700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2024.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2024.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2024.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +036100 GO TO FAIL-ROUTINE-EX. SQ2024.2 +036200 FAIL-ROUTINE-WRITE. SQ2024.2 +036300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2024.2 +036400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +036500 FAIL-ROUTINE-EX. EXIT. SQ2024.2 +036600 BAIL-OUT. SQ2024.2 +036700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2024.2 +036800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2024.2 +036900 BAIL-OUT-WRITE. SQ2024.2 +037000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2024.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +037200 BAIL-OUT-EX. EXIT. SQ2024.2 +037300 CCVS1-EXIT. SQ2024.2 +037400 EXIT. SQ2024.2 +037500 SECTION-SQ202A-0001 SECTION. SQ2024.2 +037600 WRI-INIT-001. SQ2024.2 +037700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2024.2 +037800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2024.2 +037900 MOVE "SQ202A" TO XPROGRAM-NAME (1). SQ2024.2 +038000 MOVE 120 TO XRECORD-LENGTH (1). SQ2024.2 +038100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2024.2 +038200 MOVE 1 TO XBLOCK-SIZE (1). SQ2024.2 +038300 MOVE 750 TO RECORDS-IN-FILE (1). SQ2024.2 +038400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2024.2 +038500 MOVE "S" TO XLABEL-TYPE (1). SQ2024.2 +038600 MOVE 1 TO XRECORD-NUMBER (1). SQ2024.2 +038700 OPEN OUTPUT SQ-FS1. SQ2024.2 +038800 WRI-TEST-001. SQ2024.2 +038900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2024.2 +039000 WRITE SQ-FS1R1-F-G-120. SQ2024.2 +039100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2024.2 +039200 GO TO WRI-WRITE-001. SQ2024.2 +039300 ADD 1 TO XRECORD-NUMBER (1). SQ2024.2 +039400 GO TO WRI-TEST-001. SQ2024.2 +039500 WRI-WRITE-001. SQ2024.2 +039600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2024.2 +039700 MOVE "WRI-TEST-001" TO PAR-NAME. SQ2024.2 +039800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2024.2 +039900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2024.2 +040000 PERFORM PRINT-DETAIL. SQ2024.2 +040100 WRI-CLOSE-001. SQ2024.2 +040200 CLOSE SQ-FS1. SQ2024.2 +040300 READ-INIT-001. SQ2024.2 +040400 MOVE 0 TO RECORD-OUT-COUNT, RECORDS-IN-ERROR. SQ2024.2 +040500 OPEN INPUT SQ-FS1. SQ2024.2 +040600 READ-TEST-001. SQ2024.2 +040700 READ SQ-FS1 AT END GO TO READ-TEST-001-01. SQ2024.2 +040800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2024.2 +040900 ADD 1 TO RECORD-OUT-COUNT SQ2024.2 +041000 IF RECORD-OUT-COUNT GREATER THAN 750 SQ2024.2 +041100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2024.2 +041200 GO TO READ-FAIL-001. SQ2024.2 +041300 IF RECORD-OUT-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2024.2 +041400 ADD 1 TO RECORDS-IN-ERROR SQ2024.2 +041500 GO TO READ-TEST-001. SQ2024.2 +041600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2024.2 +041700 ADD 1 TO RECORDS-IN-ERROR SQ2024.2 +041800 GO TO READ-TEST-001. SQ2024.2 +041900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2024.2 +042000 ADD 1 TO RECORDS-IN-ERROR. SQ2024.2 +042100 GO TO READ-TEST-001. SQ2024.2 +042200 READ-TEST-001-01. SQ2024.2 +042300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2024.2 +042400 GO TO READ-PASS-001. SQ2024.2 +042500 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2024.2 +042600 READ-FAIL-001. SQ2024.2 +042700 MOVE "RECORDS IN ERROR" TO COMPUTED-A. SQ2024.2 +042800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2024.2 +042900 PERFORM FAIL. SQ2024.2 +043000 GO TO READ-WRITE-001. SQ2024.2 +043100 READ-PASS-001. SQ2024.2 +043200 PERFORM PASS. SQ2024.2 +043300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2024.2 +043400 MOVE RECORD-OUT-COUNT TO CORRECT-18V0. SQ2024.2 +043500 READ-WRITE-001. SQ2024.2 +043600 MOVE "READ-TEST-001" TO PAR-NAME. SQ2024.2 +043700 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2024.2 +043800 PERFORM PRINT-DETAIL. SQ2024.2 +043900 READ-CLOSE-001. SQ2024.2 +044000 CLOSE SQ-FS1. SQ2024.2 +044100 SQ202A-END-ROUTINE. SQ2024.2 +044200 MOVE "END OF SQ202A VALIDATION TESTS" TO PRINT-REC. SQ2024.2 +044300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2024.2 +044400 TERMINATE-SQ202A. SQ2024.2 +044500 EXIT. SQ2024.2 +044600 CCVS-EXIT SECTION. SQ2024.2 +044700 CCVS-999999. SQ2024.2 +044800 GO TO CLOSE-FILES. SQ2024.2 +*END-OF,SQ202A +*HEADER,COBOL,SQ202A,SUBPRG,SQ203A +000100 IDENTIFICATION DIVISION. SQ2034.2 +000200 PROGRAM-ID. SQ2034.2 +000300 SQ203A. SQ2034.2 +000400**************************************************************** SQ2034.2 +000500* * SQ2034.2 +000600* VALIDATION FOR:- * SQ2034.2 +000700* " HIGH ". SQ2034.2 +000800* * SQ2034.2 +000900* CREATION DATE / VALIDATION DATE * SQ2034.2 +001000* "4.2 ". SQ2034.2 +001100* * SQ2034.2 +001200* THE ROUTINE SQ203A TESTS THE USE OF THE OPTIONAL CLAUSE SQ2034.2 +001300* IN THE SELECT CLAUSE OF A FILE CONTROL ENTRY. THE TEST IS SQ2034.2 +001400* MADE WHEN THE OPTIONAL FILE IS BOTH PRESENT AND ABSENT. SQ2034.2 +001500* THE RESERVE INTEGER AREA CLAUSE IS ALSO INCLUDE IN THIS TEST.SQ2034.2 +001600 ENVIRONMENT DIVISION. SQ2034.2 +001700 CONFIGURATION SECTION. SQ2034.2 +001800 SOURCE-COMPUTER. SQ2034.2 +001900 XXXXX082. SQ2034.2 +002000 OBJECT-COMPUTER. SQ2034.2 +002100 XXXXX083. SQ2034.2 +002200 INPUT-OUTPUT SECTION. SQ2034.2 +002300 FILE-CONTROL. SQ2034.2 +002400P SELECT RAW-DATA ASSIGN TO SQ2034.2 +002500P XXXXX062 SQ2034.2 +002600P ORGANIZATION IS INDEXED SQ2034.2 +002700P ACCESS MODE IS RANDOM SQ2034.2 +002800P RECORD KEY IS RAW-DATA-KEY. SQ2034.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ2034.2 +003000 XXXXX055. SQ2034.2 +003100 SELECT OPTIONAL SQ-FS1 SQ2034.2 +003200 ASSIGN TO SQ2034.2 +003300 XXXXD001 SQ2034.2 +003400 RESERVE 8 AREAS SQ2034.2 +003500 ORGANIZATION IS SEQUENTIAL SQ2034.2 +003600 ACCESS MODE IS SEQUENTIAL SQ2034.2 +003700 FILE STATUS GRP-STATUS-KEY-1. SQ2034.2 +003800 SELECT OPTIONAL SQ-FS2 SQ2034.2 +003900 ASSIGN TO SQ2034.2 +004000 XXXXX018 SQ2034.2 +004100 STATUS GRP-STATUS-KEY-2. SQ2034.2 +004200 SELECT SQ-FS3 ASSIGN TO SQ2034.2 +004300 XXXXX003 SQ2034.2 +004400 RESERVE 7 AREA SQ2034.2 +004500 ORGANIZATION SEQUENTIAL SQ2034.2 +004600 ACCESS SEQUENTIAL SQ2034.2 +004700 FILE STATUS IS GRP-STATUS-KEY-3. SQ2034.2 +004800 SELECT OPTIONAL SQ-FS4 ASSIGN TO SQ2034.2 +004900 XXXXX017 SQ2034.2 +005000 ORGANIZATION IS SEQUENTIAL. SQ2034.2 +005100 DATA DIVISION. SQ2034.2 +005200 FILE SECTION. SQ2034.2 +005300P SQ2034.2 +005400PFD RAW-DATA. SQ2034.2 +005500P SQ2034.2 +005600P01 RAW-DATA-SATZ. SQ2034.2 +005700P 05 RAW-DATA-KEY PIC X(6). SQ2034.2 +005800P 05 C-DATE PIC 9(6). SQ2034.2 +005900P 05 C-TIME PIC 9(8). SQ2034.2 +006000P 05 C-NO-OF-TESTS PIC 99. SQ2034.2 +006100P 05 C-OK PIC 999. SQ2034.2 +006200P 05 C-ALL PIC 999. SQ2034.2 +006300P 05 C-FAIL PIC 999. SQ2034.2 +006400P 05 C-DELETED PIC 999. SQ2034.2 +006500P 05 C-INSPECT PIC 999. SQ2034.2 +006600P 05 C-NOTE PIC X(13). SQ2034.2 +006700P 05 C-INDENT PIC X. SQ2034.2 +006800P 05 C-ABORT PIC X(8). SQ2034.2 +006900 FD PRINT-FILE SQ2034.2 +007000C LABEL RECORDS SQ2034.2 +007100C XXXXX084 SQ2034.2 +007200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2034.2 +007300 . SQ2034.2 +007400 01 PRINT-REC PICTURE X(120). SQ2034.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2034.2 +007600 FD SQ-FS1 SQ2034.2 +007700C LABEL RECORDS ARE STANDARD SQ2034.2 +007800 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +007900 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2034.2 +008000 FD SQ-FS2 SQ2034.2 +008100C LABEL RECORDS ARE STANDARD SQ2034.2 +008200 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +008300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2034.2 +008400 FD SQ-FS3 SQ2034.2 +008500C LABEL RECORDS ARE STANDARD SQ2034.2 +008600 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +008700 01 SQ-FS3R1-F-G-120 PIC X(120). SQ2034.2 +008800 FD SQ-FS4 SQ2034.2 +008900C LABEL RECORDS ARE STANDARD SQ2034.2 +009000 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +009100 01 SQ-FS4R1-F-G-120 PIC X(120). SQ2034.2 +009200 WORKING-STORAGE SECTION. SQ2034.2 +009300 01 COUNT-OF-RECS PIC 9999. SQ2034.2 +009400 01 EOF-FLAG PIC 99 VALUE 0. SQ2034.2 +009500 01 GRP-STATUS-KEY-1. SQ2034.2 +009600 02 WRK-XN-00001-KEY-1 PIC X. SQ2034.2 +009700 02 FILLER PIC X. SQ2034.2 +009800 01 GRP-STATUS-KEY-2. SQ2034.2 +009900 02 WRK-XN-00001-KEY-2 PIC X. SQ2034.2 +010000 02 FILLER PIC X. SQ2034.2 +010100 01 GRP-STATUS-KEY-3. SQ2034.2 +010200 02 WRK-XN-00001-KEY-3 PIC X. SQ2034.2 +010300 02 FILLER PIC X. SQ2034.2 +010400 01 FILE-RECORD-INFORMATION-REC. SQ2034.2 +010500 03 FILE-RECORD-INFO-SKELETON. SQ2034.2 +010600 05 FILLER PICTURE X(48) VALUE SQ2034.2 +010700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2034.2 +010800 05 FILLER PICTURE X(46) VALUE SQ2034.2 +010900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2034.2 +011000 05 FILLER PICTURE X(26) VALUE SQ2034.2 +011100 ",LFIL=000000,ORG= ,LBLR= ". SQ2034.2 +011200 05 FILLER PICTURE X(37) VALUE SQ2034.2 +011300 ",RECKEY= ". SQ2034.2 +011400 05 FILLER PICTURE X(38) VALUE SQ2034.2 +011500 ",ALTKEY1= ". SQ2034.2 +011600 05 FILLER PICTURE X(38) VALUE SQ2034.2 +011700 ",ALTKEY2= ". SQ2034.2 +011800 05 FILLER PICTURE X(7) VALUE SPACE.SQ2034.2 +011900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2034.2 +012000 05 FILE-RECORD-INFO-P1-120. SQ2034.2 +012100 07 FILLER PIC X(5). SQ2034.2 +012200 07 XFILE-NAME PIC X(6). SQ2034.2 +012300 07 FILLER PIC X(8). SQ2034.2 +012400 07 XRECORD-NAME PIC X(6). SQ2034.2 +012500 07 FILLER PIC X(1). SQ2034.2 +012600 07 REELUNIT-NUMBER PIC 9(1). SQ2034.2 +012700 07 FILLER PIC X(7). SQ2034.2 +012800 07 XRECORD-NUMBER PIC 9(6). SQ2034.2 +012900 07 FILLER PIC X(6). SQ2034.2 +013000 07 UPDATE-NUMBER PIC 9(2). SQ2034.2 +013100 07 FILLER PIC X(5). SQ2034.2 +013200 07 ODO-NUMBER PIC 9(4). SQ2034.2 +013300 07 FILLER PIC X(5). SQ2034.2 +013400 07 XPROGRAM-NAME PIC X(5). SQ2034.2 +013500 07 FILLER PIC X(7). SQ2034.2 +013600 07 XRECORD-LENGTH PIC 9(6). SQ2034.2 +013700 07 FILLER PIC X(7). SQ2034.2 +013800 07 CHARS-OR-RECORDS PIC X(2). SQ2034.2 +013900 07 FILLER PIC X(1). SQ2034.2 +014000 07 XBLOCK-SIZE PIC 9(4). SQ2034.2 +014100 07 FILLER PIC X(6). SQ2034.2 +014200 07 RECORDS-IN-FILE PIC 9(6). SQ2034.2 +014300 07 FILLER PIC X(5). SQ2034.2 +014400 07 XFILE-ORGANIZATION PIC X(2). SQ2034.2 +014500 07 FILLER PIC X(6). SQ2034.2 +014600 07 XLABEL-TYPE PIC X(1). SQ2034.2 +014700 05 FILE-RECORD-INFO-P121-240. SQ2034.2 +014800 07 FILLER PIC X(8). SQ2034.2 +014900 07 XRECORD-KEY PIC X(29). SQ2034.2 +015000 07 FILLER PIC X(9). SQ2034.2 +015100 07 ALTERNATE-KEY1 PIC X(29). SQ2034.2 +015200 07 FILLER PIC X(9). SQ2034.2 +015300 07 ALTERNATE-KEY2 PIC X(29). SQ2034.2 +015400 07 FILLER PIC X(7). SQ2034.2 +015500 01 TEST-RESULTS. SQ2034.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +015700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2034.2 +015800 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +015900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2034.2 +016000 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +016100 02 PAR-NAME. SQ2034.2 +016200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2034.2 +016300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2034.2 +016400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2034.2 +016500 03 FILLER PIC X(5) VALUE SPACE. SQ2034.2 +016600 02 FILLER PIC X(10) VALUE SPACE. SQ2034.2 +016700 02 RE-MARK PIC X(61). SQ2034.2 +016800 01 TEST-COMPUTED. SQ2034.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ2034.2 +017000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2034.2 +017100 02 COMPUTED-X. SQ2034.2 +017200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2034.2 +017300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2034.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2034.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2034.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2034.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2034.2 +017800 04 COMPUTED-18V0 PICTURE -9(18). SQ2034.2 +017900 04 FILLER PICTURE X. SQ2034.2 +018000 03 FILLER PIC X(50) VALUE SPACE. SQ2034.2 +018100 01 TEST-CORRECT. SQ2034.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ2034.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2034.2 +018400 02 CORRECT-X. SQ2034.2 +018500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2034.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2034.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2034.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2034.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2034.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. SQ2034.2 +019100 04 CORRECT-18V0 PICTURE -9(18). SQ2034.2 +019200 04 FILLER PICTURE X. SQ2034.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ2034.2 +019400 01 CCVS-C-1. SQ2034.2 +019500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2034.2 +019600- "SS PARAGRAPH-NAME SQ2034.2 +019700- " REMARKS". SQ2034.2 +019800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2034.2 +019900 01 CCVS-C-2. SQ2034.2 +020000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +020100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2034.2 +020200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2034.2 +020300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2034.2 +020400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2034.2 +020500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2034.2 +020600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2034.2 +020700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2034.2 +020800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2034.2 +021500 01 CCVS-H-1. SQ2034.2 +021600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2034.2 +021700 02 FILLER PICTURE X(67) VALUE SQ2034.2 +021800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2034.2 +021900- " SYSTEM". SQ2034.2 +022000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2034.2 +022100 01 CCVS-H-2. SQ2034.2 +022200 02 FILLER PICTURE X(52) VALUE IS SQ2034.2 +022300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2034.2 +022400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2034.2 +022500 02 TEST-ID PICTURE IS X(9). SQ2034.2 +022600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2034.2 +022700 01 CCVS-H-3. SQ2034.2 +022800 02 FILLER PICTURE X(34) VALUE SQ2034.2 +022900 " FOR OFFICIAL USE ONLY ". SQ2034.2 +023000 02 FILLER PICTURE X(58) VALUE SQ2034.2 +023100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2034.2 +023200 02 FILLER PICTURE X(28) VALUE SQ2034.2 +023300 " COPYRIGHT 1985 ". SQ2034.2 +023400 01 CCVS-E-1. SQ2034.2 +023500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2034.2 +023600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2034.2 +023700 02 ID-AGAIN PICTURE IS X(9). SQ2034.2 +023800 02 FILLER PICTURE X(45) VALUE IS SQ2034.2 +023900 " NTIS DISTRIBUTION COBOL 85". SQ2034.2 +024000 01 CCVS-E-2. SQ2034.2 +024100 02 FILLER PICTURE X(31) VALUE SQ2034.2 +024200 SPACE. SQ2034.2 +024300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2034.2 +024400 02 CCVS-E-2-2. SQ2034.2 +024500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2034.2 +024600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +024700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2034.2 +024800 01 CCVS-E-3. SQ2034.2 +024900 02 FILLER PICTURE X(22) VALUE SQ2034.2 +025000 " FOR OFFICIAL USE ONLY". SQ2034.2 +025100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2034.2 +025200 02 FILLER PICTURE X(58) VALUE SQ2034.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2034.2 +025400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2034.2 +025500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2034.2 +025600 01 CCVS-E-4. SQ2034.2 +025700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2034.2 +025800 02 FILLER PIC XXXX VALUE " OF ". SQ2034.2 +025900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2034.2 +026000 02 FILLER PIC X(40) VALUE SQ2034.2 +026100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2034.2 +026200 01 XXINFO. SQ2034.2 +026300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2034.2 +026400 02 INFO-TEXT. SQ2034.2 +026500 04 FILLER PIC X(20) VALUE SPACE. SQ2034.2 +026600 04 XXCOMPUTED PIC X(20). SQ2034.2 +026700 04 FILLER PIC X(5) VALUE SPACE. SQ2034.2 +026800 04 XXCORRECT PIC X(20). SQ2034.2 +026900 01 HYPHEN-LINE. SQ2034.2 +027000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +027100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2034.2 +027200- "*****************************************". SQ2034.2 +027300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2034.2 +027400- "******************************". SQ2034.2 +027500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2034.2 +027600 "SQ203A". SQ2034.2 +027700 PROCEDURE DIVISION. SQ2034.2 +027800 DECLARATIVES. SQ2034.2 +027900 USE-1 SECTION. SQ2034.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ2034.2 +028100 USE-1-PROCEDURE. SQ2034.2 +028200 IF WRK-XN-00001-KEY-2 EQUAL TO "1" SQ2034.2 +028300 MOVE 1 TO EOF-FLAG. SQ2034.2 +028400 END DECLARATIVES. SQ2034.2 +028500 CCVS1 SECTION. SQ2034.2 +028600 OPEN-FILES. SQ2034.2 +028700P OPEN I-O RAW-DATA. SQ2034.2 +028800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2034.2 +028900P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2034.2 +029000P MOVE "ABORTED " TO C-ABORT. SQ2034.2 +029100P ADD 1 TO C-NO-OF-TESTS. SQ2034.2 +029200P ACCEPT C-DATE FROM DATE. SQ2034.2 +029300P ACCEPT C-TIME FROM TIME. SQ2034.2 +029400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2034.2 +029500PEND-E-1. SQ2034.2 +029600P CLOSE RAW-DATA. SQ2034.2 +029700 OPEN OUTPUT PRINT-FILE. SQ2034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2034.2 +029900 MOVE SPACE TO TEST-RESULTS. SQ2034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2034.2 +030100 MOVE ZERO TO REC-SKL-SUB. SQ2034.2 +030200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2034.2 +030300 CCVS-INIT-FILE. SQ2034.2 +030400 ADD 1 TO REC-SKL-SUB. SQ2034.2 +030500 MOVE FILE-RECORD-INFO-SKELETON TO SQ2034.2 +030600 FILE-RECORD-INFO (REC-SKL-SUB). SQ2034.2 +030700 CCVS-INIT-EXIT. SQ2034.2 +030800 GO TO CCVS1-EXIT. SQ2034.2 +030900 CLOSE-FILES. SQ2034.2 +031000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2034.2 +031100P OPEN I-O RAW-DATA. SQ2034.2 +031200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2034.2 +031300P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2034.2 +031400P MOVE "OK. " TO C-ABORT. SQ2034.2 +031500P MOVE PASS-COUNTER TO C-OK. SQ2034.2 +031600P MOVE ERROR-HOLD TO C-ALL. SQ2034.2 +031700P MOVE ERROR-COUNTER TO C-FAIL. SQ2034.2 +031800P MOVE DELETE-CNT TO C-DELETED. SQ2034.2 +031900P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2034.2 +032000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2034.2 +032100PEND-E-2. SQ2034.2 +032200P CLOSE RAW-DATA. SQ2034.2 +032300 TERMINATE-CCVS. SQ2034.2 +032400S EXIT PROGRAM. SQ2034.2 +032500STERMINATE-CALL. SQ2034.2 +032600 STOP RUN. SQ2034.2 +032700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2034.2 +032800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2034.2 +032900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2034.2 +033000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2034.2 +033100 MOVE "****TEST DELETED****" TO RE-MARK. SQ2034.2 +033200 PRINT-DETAIL. SQ2034.2 +033300 IF REC-CT NOT EQUAL TO ZERO SQ2034.2 +033400 MOVE "." TO PARDOT-X SQ2034.2 +033500 MOVE REC-CT TO DOTVALUE. SQ2034.2 +033600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2034.2 +033700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2034.2 +033800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2034.2 +033900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2034.2 +034000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2034.2 +034100 MOVE SPACE TO CORRECT-X. SQ2034.2 +034200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2034.2 +034300 MOVE SPACE TO RE-MARK. SQ2034.2 +034400 HEAD-ROUTINE. SQ2034.2 +034500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +034600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2034.2 +034700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2034.2 +034800 COLUMN-NAMES-ROUTINE. SQ2034.2 +034900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +035000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +035200 END-ROUTINE. SQ2034.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2034.2 +035400 END-RTN-EXIT. SQ2034.2 +035500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +035600 END-ROUTINE-1. SQ2034.2 +035700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2034.2 +035800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2034.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2034.2 +036000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2034.2 +036100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2034.2 +036200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2034.2 +036300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2034.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2034.2 +036500 END-ROUTINE-12. SQ2034.2 +036600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2034.2 +036700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2034.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ2034.2 +036900 ELSE SQ2034.2 +037000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2034.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2034.2 +037200 PERFORM WRITE-LINE. SQ2034.2 +037300 END-ROUTINE-13. SQ2034.2 +037400 IF DELETE-CNT IS EQUAL TO ZERO SQ2034.2 +037500 MOVE "NO " TO ERROR-TOTAL ELSE SQ2034.2 +037600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2034.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2034.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO SQ2034.2 +038000 MOVE "NO " TO ERROR-TOTAL SQ2034.2 +038100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2034.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2034.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +038500 WRITE-LINE. SQ2034.2 +038600 ADD 1 TO RECORD-COUNT. SQ2034.2 +038700Y IF RECORD-COUNT GREATER 50 SQ2034.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2034.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ2034.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2034.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2034.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2034.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2034.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2034.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ2034.2 +039600 PERFORM WRT-LN. SQ2034.2 +039700 WRT-LN. SQ2034.2 +039800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2034.2 +039900 MOVE SPACE TO DUMMY-RECORD. SQ2034.2 +040000 BLANK-LINE-PRINT. SQ2034.2 +040100 PERFORM WRT-LN. SQ2034.2 +040200 FAIL-ROUTINE. SQ2034.2 +040300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2034.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2034.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2034.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +040700 GO TO FAIL-ROUTINE-EX. SQ2034.2 +040800 FAIL-ROUTINE-WRITE. SQ2034.2 +040900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2034.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +041100 FAIL-ROUTINE-EX. EXIT. SQ2034.2 +041200 BAIL-OUT. SQ2034.2 +041300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2034.2 +041400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2034.2 +041500 BAIL-OUT-WRITE. SQ2034.2 +041600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2034.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +041800 BAIL-OUT-EX. EXIT. SQ2034.2 +041900 CCVS1-EXIT. SQ2034.2 +042000 EXIT. SQ2034.2 +042100 SECT-SQ203A-0001 SECTION. SQ2034.2 +042200 READ-INIT-GF-01. SQ2034.2 +042300* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS1. IN SQ2034.2 +042400* THIS TEST THE FILE IS PRESENT THEREFORE IT SHOULD SQ2034.2 +042500* OPEN AND HAVE THE FIRST RECORD READ CORRECTLY SQ2034.2 +042600* WITHOUT TRANSFERING CONTROL TO THE AT END CONDITION.SQ2034.2 +042700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2034.2 +042800 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +042900 MOVE "FILE PRESENT" TO RE-MARK. SQ2034.2 +043000 READ-TEST-GF-01. SQ2034.2 +043100 OPEN INPUT SQ-FS1. SQ2034.2 +043200 READ SQ-FS1 ; AT END GO TO READ-FAIL-GF-01. SQ2034.2 +043300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2034.2 +043400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2034.2 +043500 MOVE "INVALID XFILE-NAME" TO RE-MARK SQ2034.2 +043600 GO TO READ-FAIL-GF-01. SQ2034.2 +043700 IF XRECORD-NUMBER (1) NOT EQUAL TO 1 SQ2034.2 +043800 MOVE "INVALID RECORD NUMBER" TO RE-MARK SQ2034.2 +043900 GO TO READ-FAIL-GF-01. SQ2034.2 +044000 GO TO READ-PASS-GF-01. SQ2034.2 +044100 READ-DELETE-GF-01. SQ2034.2 +044200 PERFORM DE-LETE. SQ2034.2 +044300 GO TO READ-WRITE-GF-01. SQ2034.2 +044400 READ-FAIL-GF-01. SQ2034.2 +044500 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +044600 TO RE-MARK. SQ2034.2 +044700 PERFORM FAIL. SQ2034.2 +044800 CLOSE SQ-FS1. SQ2034.2 +044900 GO TO READ-WRITE-GF-01. SQ2034.2 +045000 READ-PASS-GF-01. SQ2034.2 +045100 PERFORM PASS. SQ2034.2 +045200 CLOSE SQ-FS1. SQ2034.2 +045300 READ-WRITE-GF-01. SQ2034.2 +045400 PERFORM PRINT-DETAIL. SQ2034.2 +045500 READ-INIT-GF-02. SQ2034.2 +045600* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS4 IN SQ2034.2 +045700* WHICH THE FIRST READ STATEMENT HAS AN AT END PHRASE.SQ2034.2 +045800* IN THIS TEST THE SELECTED FILE IS NOT PRESENT. SQ2034.2 +045900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2034.2 +046000 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +046100 MOVE "FILE NOT PRESENT" TO RE-MARK. SQ2034.2 +046200 READ-TEST-GF-02. SQ2034.2 +046300 OPEN INPUT SQ-FS4. SQ2034.2 +046400 READ SQ-FS4 ; AT END GO TO READ-PASS-GF-02. SQ2034.2 +046500 GO TO READ-FAIL-GF-02. SQ2034.2 +046600 READ-DELETE-GF-02. SQ2034.2 +046700 PERFORM DE-LETE. SQ2034.2 +046800 GO TO READ-WRITE-GF-02. SQ2034.2 +046900 READ-FAIL-GF-02. SQ2034.2 +047000 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +047100 TO RE-MARK. SQ2034.2 +047200 PERFORM FAIL. SQ2034.2 +047300 CLOSE SQ-FS4. SQ2034.2 +047400 GO TO READ-WRITE-GF-02. SQ2034.2 +047500 READ-PASS-GF-02. SQ2034.2 +047600 PERFORM PASS. SQ2034.2 +047700 CLOSE SQ-FS4. SQ2034.2 +047800 READ-WRITE-GF-02. SQ2034.2 +047900 PERFORM PRINT-DETAIL. SQ2034.2 +048000 READ-INIT-GF-03. SQ2034.2 +048100* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS2 IN SQ2034.2 +048200* WHICH THE FIRST READ STATEMENT DOES NOT HAVE AN AT SQ2034.2 +048300* END PHRASE. INSTEAD A USE STATEMENT IS SPECIFIED. SQ2034.2 +048400* IN THIS TEST THE SELECTED FILE IS NOT PRESENT. SQ2034.2 +048500 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2034.2 +048600 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +048700 MOVE "FILE NOT PRESENT" TO RE-MARK. SQ2034.2 +048800 READ-TEST-GF-03. SQ2034.2 +048900 OPEN INPUT SQ-FS2. SQ2034.2 +049000 READ SQ-FS2. SQ2034.2 +049100 IF EOF-FLAG EQUAL TO 1 SQ2034.2 +049200 GO TO READ-PASS-GF-03. SQ2034.2 +049300 GO TO READ-FAIL-GF-03. SQ2034.2 +049400 READ-DELETE-GF-03. SQ2034.2 +049500 PERFORM DE-LETE. SQ2034.2 +049600 GO TO READ-WRITE-GF-03. SQ2034.2 +049700 READ-FAIL-GF-03. SQ2034.2 +049800 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +049900 TO RE-MARK. SQ2034.2 +050000 PERFORM FAIL. SQ2034.2 +050100 MOVE WRK-XN-00001-KEY-2 TO COMPUTED-A. SQ2034.2 +050200 MOVE "1" TO CORRECT-A. SQ2034.2 +050300 CLOSE SQ-FS2. SQ2034.2 +050400 GO TO READ-WRITE-GF-03. SQ2034.2 +050500 READ-PASS-GF-03. SQ2034.2 +050600 PERFORM PASS. SQ2034.2 +050700 MOVE WRK-XN-00001-KEY-2 TO COMPUTED-A. SQ2034.2 +050800 MOVE "1" TO CORRECT-A. SQ2034.2 +050900 CLOSE SQ-FS2. SQ2034.2 +051000 READ-WRITE-GF-03. SQ2034.2 +051100 PERFORM PRINT-DETAIL. SQ2034.2 +051200 READ-INIT-GF-04. SQ2034.2 +051300* THIS TEST IS USED TO CHECK OUT THE RESERVE INTEGER SQ2034.2 +051400* AREA CLAUSE IN THE FILE-CONTROL ENTRY. SQ2034.2 +051500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ2034.2 +051600 MOVE "RESERVE INTEGER AREA" TO FEATURE. SQ2034.2 +051700 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ2034.2 +051800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2034.2 +051900 MOVE "SQ203A" TO XPROGRAM-NAME (1). SQ2034.2 +052000 MOVE 000120 TO XRECORD-LENGTH (1). SQ2034.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2034.2 +052200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2034.2 +052300 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2034.2 +052400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2034.2 +052500 MOVE "S" TO XLABEL-TYPE (1). SQ2034.2 +052600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2034.2 +052700 READ-TEST-GF-04-01. SQ2034.2 +052800 OPEN OUTPUT SQ-FS3. SQ2034.2 +052900 READ-TEST-GF-04-02. SQ2034.2 +053000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ2034.2 +053100 WRITE SQ-FS3R1-F-G-120. SQ2034.2 +053200 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2034.2 +053300 GO TO READ-TEST-GF-04-03. SQ2034.2 +053400 ADD 1 TO XRECORD-NUMBER (1). SQ2034.2 +053500 GO TO READ-TEST-GF-04-02. SQ2034.2 +053600 READ-TEST-GF-04-03. SQ2034.2 +053700 CLOSE SQ-FS3. SQ2034.2 +053800 PERFORM PASS. SQ2034.2 +053900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2034.2 +054000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2034.2 +054100 GO TO READ-WRITE-GF-04. SQ2034.2 +054200 READ-DELETE-GF-04. SQ2034.2 +054300 PERFORM DE-LETE. SQ2034.2 +054400 READ-WRITE-GF-04. SQ2034.2 +054500 PERFORM PRINT-DETAIL. SQ2034.2 +054600 SQ203A-END-ROUTINE. SQ2034.2 +054700 MOVE "END OF SQ203A VALIDATION TESTS" TO PRINT-REC. SQ2034.2 +054800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2034.2 +054900 TERMINATE-SQ203A. SQ2034.2 +055000 EXIT. SQ2034.2 +055100 CCVS-EXIT SECTION. SQ2034.2 +055200 CCVS-999999. SQ2034.2 +055300 GO TO CLOSE-FILES. SQ2034.2 +*END-OF,SQ203A +*HEADER,COBOL,SQ204A +000100 IDENTIFICATION DIVISION. SQ2044.2 +000200 PROGRAM-ID. SQ2044.2 +000300 SQ204A. SQ2044.2 +000400**************************************************************** SQ2044.2 +000500* * SQ2044.2 +000600* VALIDATION FOR:- * SQ2044.2 +000700* " HIGH ". SQ2044.2 +000800* * SQ2044.2 +000900* CREATION DATE / VALIDATION DATE * SQ2044.2 +001000* "4.2 ". SQ2044.2 +001100* * SQ2044.2 +001200* THIS ROUTINE TESTS THE USE OF THE OPEN EXTEND SQ2044.2 +001300* STATEMENT FOR BOTH MAGNETIC TAPE AND MASS STORAGE. FILES SQ2044.2 +001400* ARE FIRST CREATED USING THE NORMAL OPEN OUTPUT STATEMENT SQ2044.2 +001500* SQ2044.2 +001600 ENVIRONMENT DIVISION. SQ2044.2 +001700 CONFIGURATION SECTION. SQ2044.2 +001800 SOURCE-COMPUTER. SQ2044.2 +001900 XXXXX082. SQ2044.2 +002000 OBJECT-COMPUTER. SQ2044.2 +002100 XXXXX083. SQ2044.2 +002200 INPUT-OUTPUT SECTION. SQ2044.2 +002300 FILE-CONTROL. SQ2044.2 +002400P SELECT RAW-DATA ASSIGN TO SQ2044.2 +002500P XXXXX062 SQ2044.2 +002600P ORGANIZATION IS INDEXED SQ2044.2 +002700P ACCESS MODE IS RANDOM SQ2044.2 +002800P RECORD KEY IS RAW-DATA-KEY. SQ2044.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ2044.2 +003000 XXXXX055. SQ2044.2 +003100 SELECT SQ-FS1 ASSIGN TO SQ2044.2 +003200 XXXXX001 SQ2044.2 +003300 ORGANIZATION IS SEQUENTIAL SQ2044.2 +003400 ACCESS MODE IS SEQUENTIAL. SQ2044.2 +003500 SELECT SQ-FS2 ASSIGN TO SQ2044.2 +003600 XXXXX014 SQ2044.2 +003700 ORGANIZATION IS SEQUENTIAL SQ2044.2 +003800 ACCESS MODE IS SEQUENTIAL. SQ2044.2 +003900 DATA DIVISION. SQ2044.2 +004000 FILE SECTION. SQ2044.2 +004100P SQ2044.2 +004200PFD RAW-DATA. SQ2044.2 +004300P SQ2044.2 +004400P01 RAW-DATA-SATZ. SQ2044.2 +004500P 05 RAW-DATA-KEY PIC X(6). SQ2044.2 +004600P 05 C-DATE PIC 9(6). SQ2044.2 +004700P 05 C-TIME PIC 9(8). SQ2044.2 +004800P 05 C-NO-OF-TESTS PIC 99. SQ2044.2 +004900P 05 C-OK PIC 999. SQ2044.2 +005000P 05 C-ALL PIC 999. SQ2044.2 +005100P 05 C-FAIL PIC 999. SQ2044.2 +005200P 05 C-DELETED PIC 999. SQ2044.2 +005300P 05 C-INSPECT PIC 999. SQ2044.2 +005400P 05 C-NOTE PIC X(13). SQ2044.2 +005500P 05 C-INDENT PIC X. SQ2044.2 +005600P 05 C-ABORT PIC X(8). SQ2044.2 +005700 FD PRINT-FILE SQ2044.2 +005800C LABEL RECORDS SQ2044.2 +005900C XXXXX084 SQ2044.2 +006000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2044.2 +006100 . SQ2044.2 +006200 01 PRINT-REC PICTURE X(120). SQ2044.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ2044.2 +006400 FD SQ-FS1 SQ2044.2 +006500C LABEL RECORDS ARE STANDARD SQ2044.2 +006600 BLOCK CONTAINS 126 CHARACTERS. SQ2044.2 +006700 01 SQ-FS1R1-F-G-126. SQ2044.2 +006800 02 SQ-FS1R1-F-G-120 PIC X(120). SQ2044.2 +006900 02 SQ-FS1R1-F-G-006 PIC X(6). SQ2044.2 +007000 FD SQ-FS2 SQ2044.2 +007100C LABEL RECORDS ARE STANDARD SQ2044.2 +007200 BLOCK CONTAINS 126 CHARACTERS. SQ2044.2 +007300 01 SQ-FS2R1-F-G-126. SQ2044.2 +007400 02 SQ-FS2R1-F-G-120 PIC X(120). SQ2044.2 +007500 02 SQ-FS2R1-F-G-006 PIC X(6). SQ2044.2 +007600 WORKING-STORAGE SECTION. SQ2044.2 +007700 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2044.2 +007800 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2044.2 +007900 01 COUNT-OF-RECS PIC 9999. SQ2044.2 +008000 01 FILE-RECORD-INFORMATION-REC. SQ2044.2 +008100 03 FILE-RECORD-INFO-SKELETON. SQ2044.2 +008200 05 FILLER PICTURE X(48) VALUE SQ2044.2 +008300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2044.2 +008400 05 FILLER PICTURE X(46) VALUE SQ2044.2 +008500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2044.2 +008600 05 FILLER PICTURE X(26) VALUE SQ2044.2 +008700 ",LFIL=000000,ORG= ,LBLR= ". SQ2044.2 +008800 05 FILLER PICTURE X(37) VALUE SQ2044.2 +008900 ",RECKEY= ". SQ2044.2 +009000 05 FILLER PICTURE X(38) VALUE SQ2044.2 +009100 ",ALTKEY1= ". SQ2044.2 +009200 05 FILLER PICTURE X(38) VALUE SQ2044.2 +009300 ",ALTKEY2= ". SQ2044.2 +009400 05 FILLER PICTURE X(7) VALUE SPACE.SQ2044.2 +009500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2044.2 +009600 05 FILE-RECORD-INFO-P1-120. SQ2044.2 +009700 07 FILLER PIC X(5). SQ2044.2 +009800 07 XFILE-NAME PIC X(6). SQ2044.2 +009900 07 FILLER PIC X(8). SQ2044.2 +010000 07 XRECORD-NAME PIC X(6). SQ2044.2 +010100 07 FILLER PIC X(1). SQ2044.2 +010200 07 REELUNIT-NUMBER PIC 9(1). SQ2044.2 +010300 07 FILLER PIC X(7). SQ2044.2 +010400 07 XRECORD-NUMBER PIC 9(6). SQ2044.2 +010500 07 FILLER PIC X(6). SQ2044.2 +010600 07 UPDATE-NUMBER PIC 9(2). SQ2044.2 +010700 07 FILLER PIC X(5). SQ2044.2 +010800 07 ODO-NUMBER PIC 9(4). SQ2044.2 +010900 07 FILLER PIC X(5). SQ2044.2 +011000 07 XPROGRAM-NAME PIC X(5). SQ2044.2 +011100 07 FILLER PIC X(7). SQ2044.2 +011200 07 XRECORD-LENGTH PIC 9(6). SQ2044.2 +011300 07 FILLER PIC X(7). SQ2044.2 +011400 07 CHARS-OR-RECORDS PIC X(2). SQ2044.2 +011500 07 FILLER PIC X(1). SQ2044.2 +011600 07 XBLOCK-SIZE PIC 9(4). SQ2044.2 +011700 07 FILLER PIC X(6). SQ2044.2 +011800 07 RECORDS-IN-FILE PIC 9(6). SQ2044.2 +011900 07 FILLER PIC X(5). SQ2044.2 +012000 07 XFILE-ORGANIZATION PIC X(2). SQ2044.2 +012100 07 FILLER PIC X(6). SQ2044.2 +012200 07 XLABEL-TYPE PIC X(1). SQ2044.2 +012300 05 FILE-RECORD-INFO-P121-240. SQ2044.2 +012400 07 FILLER PIC X(8). SQ2044.2 +012500 07 XRECORD-KEY PIC X(29). SQ2044.2 +012600 07 FILLER PIC X(9). SQ2044.2 +012700 07 ALTERNATE-KEY1 PIC X(29). SQ2044.2 +012800 07 FILLER PIC X(9). SQ2044.2 +012900 07 ALTERNATE-KEY2 PIC X(29). SQ2044.2 +013000 07 FILLER PIC X(7). SQ2044.2 +013100 01 TEST-RESULTS. SQ2044.2 +013200 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2044.2 +013400 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2044.2 +013600 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013700 02 PAR-NAME. SQ2044.2 +013800 03 FILLER PICTURE X(12) VALUE SPACE. SQ2044.2 +013900 03 PARDOT-X PICTURE X VALUE SPACE. SQ2044.2 +014000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2044.2 +014100 03 FILLER PIC X(5) VALUE SPACE. SQ2044.2 +014200 02 FILLER PIC X(10) VALUE SPACE. SQ2044.2 +014300 02 RE-MARK PIC X(61). SQ2044.2 +014400 01 TEST-COMPUTED. SQ2044.2 +014500 02 FILLER PIC X(30) VALUE SPACE. SQ2044.2 +014600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2044.2 +014700 02 COMPUTED-X. SQ2044.2 +014800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2044.2 +014900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2044.2 +015000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2044.2 +015100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2044.2 +015200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2044.2 +015300 03 CM-18V0 REDEFINES COMPUTED-A. SQ2044.2 +015400 04 COMPUTED-18V0 PICTURE -9(18). SQ2044.2 +015500 04 FILLER PICTURE X. SQ2044.2 +015600 03 FILLER PIC X(50) VALUE SPACE. SQ2044.2 +015700 01 TEST-CORRECT. SQ2044.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2044.2 +015900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2044.2 +016000 02 CORRECT-X. SQ2044.2 +016100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2044.2 +016200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2044.2 +016300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2044.2 +016400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2044.2 +016500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2044.2 +016600 03 CR-18V0 REDEFINES CORRECT-A. SQ2044.2 +016700 04 CORRECT-18V0 PICTURE -9(18). SQ2044.2 +016800 04 FILLER PICTURE X. SQ2044.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2044.2 +017000 01 CCVS-C-1. SQ2044.2 +017100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2044.2 +017200- "SS PARAGRAPH-NAME SQ2044.2 +017300- " REMARKS". SQ2044.2 +017400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2044.2 +017500 01 CCVS-C-2. SQ2044.2 +017600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +017700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2044.2 +017800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2044.2 +017900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2044.2 +018000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2044.2 +018100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2044.2 +018200 01 REC-CT PICTURE 99 VALUE ZERO. SQ2044.2 +018300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2044.2 +018400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2044.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2044.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2044.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2044.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2044.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2044.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2044.2 +019100 01 CCVS-H-1. SQ2044.2 +019200 02 FILLER PICTURE X(27) VALUE SPACE. SQ2044.2 +019300 02 FILLER PICTURE X(67) VALUE SQ2044.2 +019400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2044.2 +019500- " SYSTEM". SQ2044.2 +019600 02 FILLER PICTURE X(26) VALUE SPACE. SQ2044.2 +019700 01 CCVS-H-2. SQ2044.2 +019800 02 FILLER PICTURE X(52) VALUE IS SQ2044.2 +019900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2044.2 +020000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2044.2 +020100 02 TEST-ID PICTURE IS X(9). SQ2044.2 +020200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2044.2 +020300 01 CCVS-H-3. SQ2044.2 +020400 02 FILLER PICTURE X(34) VALUE SQ2044.2 +020500 " FOR OFFICIAL USE ONLY ". SQ2044.2 +020600 02 FILLER PICTURE X(58) VALUE SQ2044.2 +020700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2044.2 +020800 02 FILLER PICTURE X(28) VALUE SQ2044.2 +020900 " COPYRIGHT 1985 ". SQ2044.2 +021000 01 CCVS-E-1. SQ2044.2 +021100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2044.2 +021200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2044.2 +021300 02 ID-AGAIN PICTURE IS X(9). SQ2044.2 +021400 02 FILLER PICTURE X(45) VALUE IS SQ2044.2 +021500 " NTIS DISTRIBUTION COBOL 85". SQ2044.2 +021600 01 CCVS-E-2. SQ2044.2 +021700 02 FILLER PICTURE X(31) VALUE SQ2044.2 +021800 SPACE. SQ2044.2 +021900 02 FILLER PICTURE X(21) VALUE SPACE. SQ2044.2 +022000 02 CCVS-E-2-2. SQ2044.2 +022100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2044.2 +022200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +022300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2044.2 +022400 01 CCVS-E-3. SQ2044.2 +022500 02 FILLER PICTURE X(22) VALUE SQ2044.2 +022600 " FOR OFFICIAL USE ONLY". SQ2044.2 +022700 02 FILLER PICTURE X(12) VALUE SPACE. SQ2044.2 +022800 02 FILLER PICTURE X(58) VALUE SQ2044.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2044.2 +023000 02 FILLER PICTURE X(13) VALUE SPACE. SQ2044.2 +023100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2044.2 +023200 01 CCVS-E-4. SQ2044.2 +023300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2044.2 +023400 02 FILLER PIC XXXX VALUE " OF ". SQ2044.2 +023500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2044.2 +023600 02 FILLER PIC X(40) VALUE SQ2044.2 +023700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2044.2 +023800 01 XXINFO. SQ2044.2 +023900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2044.2 +024000 02 INFO-TEXT. SQ2044.2 +024100 04 FILLER PIC X(20) VALUE SPACE. SQ2044.2 +024200 04 XXCOMPUTED PIC X(20). SQ2044.2 +024300 04 FILLER PIC X(5) VALUE SPACE. SQ2044.2 +024400 04 XXCORRECT PIC X(20). SQ2044.2 +024500 01 HYPHEN-LINE. SQ2044.2 +024600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +024700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2044.2 +024800- "*****************************************". SQ2044.2 +024900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2044.2 +025000- "******************************". SQ2044.2 +025100 01 CCVS-PGM-ID PIC X(6) VALUE SQ2044.2 +025200 "SQ204A". SQ2044.2 +025300 PROCEDURE DIVISION. SQ2044.2 +025400 CCVS1 SECTION. SQ2044.2 +025500 OPEN-FILES. SQ2044.2 +025600P OPEN I-O RAW-DATA. SQ2044.2 +025700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2044.2 +025800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2044.2 +025900P MOVE "ABORTED " TO C-ABORT. SQ2044.2 +026000P ADD 1 TO C-NO-OF-TESTS. SQ2044.2 +026100P ACCEPT C-DATE FROM DATE. SQ2044.2 +026200P ACCEPT C-TIME FROM TIME. SQ2044.2 +026300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2044.2 +026400PEND-E-1. SQ2044.2 +026500P CLOSE RAW-DATA. SQ2044.2 +026600 OPEN OUTPUT PRINT-FILE. SQ2044.2 +026700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2044.2 +026800 MOVE SPACE TO TEST-RESULTS. SQ2044.2 +026900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2044.2 +027000 MOVE ZERO TO REC-SKL-SUB. SQ2044.2 +027100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2044.2 +027200 CCVS-INIT-FILE. SQ2044.2 +027300 ADD 1 TO REC-SKL-SUB. SQ2044.2 +027400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2044.2 +027500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2044.2 +027600 CCVS-INIT-EXIT. SQ2044.2 +027700 GO TO CCVS1-EXIT. SQ2044.2 +027800 CLOSE-FILES. SQ2044.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2044.2 +028000P OPEN I-O RAW-DATA. SQ2044.2 +028100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2044.2 +028200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2044.2 +028300P MOVE "OK. " TO C-ABORT. SQ2044.2 +028400P MOVE PASS-COUNTER TO C-OK. SQ2044.2 +028500P MOVE ERROR-HOLD TO C-ALL. SQ2044.2 +028600P MOVE ERROR-COUNTER TO C-FAIL. SQ2044.2 +028700P MOVE DELETE-CNT TO C-DELETED. SQ2044.2 +028800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2044.2 +028900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2044.2 +029000PEND-E-2. SQ2044.2 +029100P CLOSE RAW-DATA. SQ2044.2 +029200 TERMINATE-CCVS. SQ2044.2 +029300S EXIT PROGRAM. SQ2044.2 +029400STERMINATE-CALL. SQ2044.2 +029500 STOP RUN. SQ2044.2 +029600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2044.2 +029700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2044.2 +029800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2044.2 +029900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2044.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2044.2 +030100 PRINT-DETAIL. SQ2044.2 +030200 IF REC-CT NOT EQUAL TO ZERO SQ2044.2 +030300 MOVE "." TO PARDOT-X SQ2044.2 +030400 MOVE REC-CT TO DOTVALUE. SQ2044.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2044.2 +030600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2044.2 +030700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2044.2 +030800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2044.2 +030900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2044.2 +031000 MOVE SPACE TO CORRECT-X. SQ2044.2 +031100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2044.2 +031200 MOVE SPACE TO RE-MARK. SQ2044.2 +031300 HEAD-ROUTINE. SQ2044.2 +031400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +031500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2044.2 +031600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2044.2 +031700 COLUMN-NAMES-ROUTINE. SQ2044.2 +031800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +031900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +032100 END-ROUTINE. SQ2044.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2044.2 +032300 END-RTN-EXIT. SQ2044.2 +032400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +032500 END-ROUTINE-1. SQ2044.2 +032600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2044.2 +032700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2044.2 +032800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2044.2 +032900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2044.2 +033000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2044.2 +033100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2044.2 +033200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2044.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2044.2 +033400 END-ROUTINE-12. SQ2044.2 +033500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2044.2 +033600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2044.2 +033700 MOVE "NO " TO ERROR-TOTAL SQ2044.2 +033800 ELSE SQ2044.2 +033900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2044.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2044.2 +034100 PERFORM WRITE-LINE. SQ2044.2 +034200 END-ROUTINE-13. SQ2044.2 +034300 IF DELETE-CNT IS EQUAL TO ZERO SQ2044.2 +034400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2044.2 +034500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2044.2 +034600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2044.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +034800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2044.2 +034900 MOVE "NO " TO ERROR-TOTAL SQ2044.2 +035000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2044.2 +035100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2044.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +035300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +035400 WRITE-LINE. SQ2044.2 +035500 ADD 1 TO RECORD-COUNT. SQ2044.2 +035600Y IF RECORD-COUNT GREATER 50 SQ2044.2 +035700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2044.2 +035800Y MOVE SPACE TO DUMMY-RECORD SQ2044.2 +035900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2044.2 +036000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2044.2 +036100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2044.2 +036200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2044.2 +036300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2044.2 +036400Y MOVE ZERO TO RECORD-COUNT. SQ2044.2 +036500 PERFORM WRT-LN. SQ2044.2 +036600 WRT-LN. SQ2044.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2044.2 +036800 MOVE SPACE TO DUMMY-RECORD. SQ2044.2 +036900 BLANK-LINE-PRINT. SQ2044.2 +037000 PERFORM WRT-LN. SQ2044.2 +037100 FAIL-ROUTINE. SQ2044.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2044.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2044.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2044.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +037600 GO TO FAIL-ROUTINE-EX. SQ2044.2 +037700 FAIL-ROUTINE-WRITE. SQ2044.2 +037800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2044.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +038000 FAIL-ROUTINE-EX. EXIT. SQ2044.2 +038100 BAIL-OUT. SQ2044.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2044.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2044.2 +038400 BAIL-OUT-WRITE. SQ2044.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2044.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +038700 BAIL-OUT-EX. EXIT. SQ2044.2 +038800 CCVS1-EXIT. SQ2044.2 +038900 EXIT. SQ2044.2 +039000 SECT-SQ204A-0001 SECTION. SQ2044.2 +039100 WRITE-INIT-GF-01. SQ2044.2 +039200* THIS IS A TEST FOR OPEN EXTEND FOR MAGNETIC TAPE. SQ2044.2 +039300* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2044.2 +039400* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2044.2 +039500* THE FILE IS THEN READ AND VALIDATED. SQ2044.2 +039600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2044.2 +039700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2044.2 +039800 MOVE "SQ204A" TO XPROGRAM-NAME (1). SQ2044.2 +039900 MOVE 000126 TO XRECORD-LENGTH (1). SQ2044.2 +040000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2044.2 +040100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2044.2 +040200 MOVE 001000 TO RECORDS-IN-FILE (1). SQ2044.2 +040300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2044.2 +040400 MOVE "S" TO XLABEL-TYPE (1). SQ2044.2 +040500 MOVE 000001 TO XRECORD-NUMBER (1). SQ2044.2 +040600 OPEN OUTPUT SQ-FS1. SQ2044.2 +040700 WRITE-TEST-001-01. SQ2044.2 +040800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2044.2 +040900 MOVE SPACES TO SQ-FS1R1-F-G-006. SQ2044.2 +041000 WRITE SQ-FS1R1-F-G-126. SQ2044.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2044.2 +041200 GO TO WRITE-TEST-GF-01-1. SQ2044.2 +041300 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +041400 GO TO WRITE-TEST-001-01. SQ2044.2 +041500 WRITE-TEST-GF-01-1. SQ2044.2 +041600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2044.2 +041700 MOVE "WRITE-TEST-GF-01-1" TO PAR-NAME. SQ2044.2 +041800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2044.2 +041900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2044.2 +042000 PERFORM PRINT-DETAIL. SQ2044.2 +042100 CLOSE SQ-FS1. SQ2044.2 +042200 WRITE-TEST-001-03. SQ2044.2 +042300 OPEN EXTEND SQ-FS1. SQ2044.2 +042400 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +042500 WRITE-TEST-001-04. SQ2044.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2044.2 +042700 MOVE "EXTEND" TO SQ-FS1R1-F-G-006. SQ2044.2 +042800 WRITE SQ-FS1R1-F-G-126. SQ2044.2 +042900 IF XRECORD-NUMBER (1) EQUAL 1000 SQ2044.2 +043000 GO TO WRITE-TEST-GF-01-2. SQ2044.2 +043100 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +043200 GO TO WRITE-TEST-001-04. SQ2044.2 +043300 WRITE-TEST-GF-01-2. SQ2044.2 +043400 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2044.2 +043500 MOVE "WRITE-TEST-GF-01-2" TO PAR-NAME. SQ2044.2 +043600 MOVE "FILE EXTENDED, RECS =" TO COMPUTED-A. SQ2044.2 +043700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2044.2 +043800 PERFORM PRINT-DETAIL. SQ2044.2 +043900 CLOSE SQ-FS1. SQ2044.2 +044000 READ-TEST-001-06. SQ2044.2 +044100 OPEN INPUT SQ-FS1. SQ2044.2 +044200 MOVE ZERO TO WRK-RECORD-COUNT. SQ2044.2 +044300 READ-TEST-GF-01-07. SQ2044.2 +044400 READ SQ-FS1 SQ2044.2 +044500 ; AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2044.2 +044600 PERFORM FAIL SQ2044.2 +044700 GO TO READ-WRITE-GF-01. SQ2044.2 +044800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2044.2 +044900 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +045000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2044.2 +045100 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +045200 GO TO READ-TEST-GF-01-08. SQ2044.2 +045300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2044.2 +045400 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +045500 GO TO READ-TEST-GF-01-08. SQ2044.2 +045600 IF SQ-FS1R1-F-G-006 NOT EQUAL TO SPACES SQ2044.2 +045700 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +045800 READ-TEST-GF-01-08. SQ2044.2 +045900 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2044.2 +046000 GO TO READ-TEST-GF-01-07. SQ2044.2 +046100 READ-TEST-GF-01-09. SQ2044.2 +046200 READ SQ-FS1 RECORD SQ2044.2 +046300 ; END GO TO READ-TEST-GF-01. SQ2044.2 +046400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2044.2 +046500 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2044.2 +046700 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +046800 GO TO READ-TEST-GF-01-09. SQ2044.2 +046900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2044.2 +047000 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +047100 GO TO READ-TEST-GF-01-09. SQ2044.2 +047200 IF SQ-FS1R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2044.2 +047300 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +047400 GO TO READ-TEST-GF-01-09. SQ2044.2 +047500 READ-TEST-GF-01. SQ2044.2 +047600 IF RECORDS-IN-ERROR EQUAL ZERO SQ2044.2 +047700 GO TO READ-PASS-GF-01. SQ2044.2 +047800 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2044.2 +047900 GO TO READ-FAIL-GF-01. SQ2044.2 +048000 READ-DELETE-GF-01. SQ2044.2 +048100 PERFORM DE-LETE. SQ2044.2 +048200 GO TO READ-WRITE-GF-01. SQ2044.2 +048300 READ-FAIL-GF-01. SQ2044.2 +048400 MOVE "VII-44 READ OR VII-52 WRITE INCORRECTLY EXECUTED" SQ2044.2 +048500 TO RE-MARK. SQ2044.2 +048600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2044.2 +048700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2044.2 +048800 PERFORM FAIL. SQ2044.2 +048900 GO TO READ-WRITE-GF-01. SQ2044.2 +049000 READ-PASS-GF-01. SQ2044.2 +049100 PERFORM PASS. SQ2044.2 +049200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2044.2 +049300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2044.2 +049400 READ-WRITE-GF-01. SQ2044.2 +049500 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2044.2 +049600 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2044.2 +049700 PERFORM PRINT-DETAIL. SQ2044.2 +049800 READ-CLOSE-GF-01. SQ2044.2 +049900 CLOSE SQ-FS1. SQ2044.2 +050000 WRITE-INIT-GF-02. SQ2044.2 +050100* THIS IS A TEST FOR OPEN EXTEND FOR MASS STORAGE. SQ2044.2 +050200* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2044.2 +050300* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2044.2 +050400* THE FILE IS THEN READ AND VALIDATED. SQ2044.2 +050500 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2044.2 +050600 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2044.2 +050700 MOVE "SQ204A" TO XPROGRAM-NAME (2). SQ2044.2 +050800 MOVE 000126 TO XRECORD-LENGTH (2). SQ2044.2 +050900 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2044.2 +051000 MOVE 0001 TO XBLOCK-SIZE (2). SQ2044.2 +051100 MOVE 001000 TO RECORDS-IN-FILE (2). SQ2044.2 +051200 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2044.2 +051300 MOVE "S" TO XLABEL-TYPE (2). SQ2044.2 +051400 MOVE 000001 TO XRECORD-NUMBER (2). SQ2044.2 +051500 OPEN OUTPUT SQ-FS2. SQ2044.2 +051600 WRITE-TEST-GF-02-01. SQ2044.2 +051700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2044.2 +051800 MOVE SPACES TO SQ-FS2R1-F-G-006. SQ2044.2 +051900 WRITE SQ-FS2R1-F-G-126. SQ2044.2 +052000 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2044.2 +052100 GO TO WRITE-TEST-GF-02-1. SQ2044.2 +052200 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +052300 GO TO WRITE-TEST-GF-02-01. SQ2044.2 +052400 WRITE-TEST-GF-02-1. SQ2044.2 +052500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2044.2 +052600 MOVE "WRITE-TEST-GF-02-1" TO PAR-NAME. SQ2044.2 +052700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2044.2 +052800 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2044.2 +052900 PERFORM PRINT-DETAIL. SQ2044.2 +053000 CLOSE SQ-FS2. SQ2044.2 +053100 WRITE-TEST-GF-02-03. SQ2044.2 +053200 OPEN EXTEND SQ-FS2. SQ2044.2 +053300 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +053400 WRITE-TEST-GF-02-04. SQ2044.2 +053500 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2044.2 +053600 MOVE "EXTEND" TO SQ-FS2R1-F-G-006. SQ2044.2 +053700 WRITE SQ-FS2R1-F-G-126. SQ2044.2 +053800 IF XRECORD-NUMBER (2) EQUAL 1000 SQ2044.2 +053900 GO TO WRITE-TEST-GF-02-2. SQ2044.2 +054000 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +054100 GO TO WRITE-TEST-GF-02-04. SQ2044.2 +054200 WRITE-TEST-GF-02-2. SQ2044.2 +054300 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2044.2 +054400 MOVE "WRITE-TEST-GF-02-2" TO PAR-NAME. SQ2044.2 +054500 MOVE "FILE EXTENDED, RECS =" TO COMPUTED-A. SQ2044.2 +054600 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2044.2 +054700 PERFORM PRINT-DETAIL. SQ2044.2 +054800 CLOSE SQ-FS2. SQ2044.2 +054900 READ-TEST-GF-02-06. SQ2044.2 +055000 OPEN INPUT SQ-FS2. SQ2044.2 +055100 MOVE ZERO TO WRK-RECORD-COUNT. SQ2044.2 +055200 MOVE ZERO TO RECORDS-IN-ERROR. SQ2044.2 +055300 READ-TEST-GF-02-07. SQ2044.2 +055400 READ SQ-FS2 SQ2044.2 +055500 AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2044.2 +055600 PERFORM FAIL SQ2044.2 +055700 GO TO READ-WRITE-GF-02. SQ2044.2 +055800 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ2044.2 +055900 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +056000 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2044.2 +056100 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +056200 GO TO READ-TEST-GF-02-08. SQ2044.2 +056300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2044.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +056500 GO TO READ-TEST-GF-02-08. SQ2044.2 +056600 IF SQ-FS2R1-F-G-006 NOT EQUAL TO SPACES SQ2044.2 +056700 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +056800 READ-TEST-GF-02-08. SQ2044.2 +056900 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2044.2 +057000 GO TO READ-TEST-GF-02-07. SQ2044.2 +057100 READ-TEST-GF-02-09. SQ2044.2 +057200 READ SQ-FS2 RECORD SQ2044.2 +057300 AT END GO TO READ-TEST-GF-02. SQ2044.2 +057400 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2) SQ2044.2 +057500 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +057600 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2044.2 +057700 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +057800 GO TO READ-TEST-GF-02-09. SQ2044.2 +057900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2044.2 +058000 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +058100 GO TO READ-TEST-GF-02-09. SQ2044.2 +058200 IF SQ-FS2R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2044.2 +058300 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +058400 GO TO READ-TEST-GF-02-09. SQ2044.2 +058500 READ-TEST-GF-02. SQ2044.2 +058600 IF RECORDS-IN-ERROR EQUAL ZERO SQ2044.2 +058700 GO TO READ-PASS-GF-02. SQ2044.2 +058800 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. SQ2044.2 +058900 GO TO READ-FAIL-GF-02. SQ2044.2 +059000 READ-DELETE-GF-02. SQ2044.2 +059100 PERFORM DE-LETE. SQ2044.2 +059200 GO TO READ-WRITE-GF-02. SQ2044.2 +059300 READ-FAIL-GF-02. SQ2044.2 +059400 MOVE "VII-44 READ OR VII-52 WRITE INCORRECTLY EXECUTED" SQ2044.2 +059500 TO RE-MARK. SQ2044.2 +059600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2044.2 +059700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2044.2 +059800 PERFORM FAIL. SQ2044.2 +059900 GO TO READ-WRITE-GF-02. SQ2044.2 +060000 READ-PASS-GF-02. SQ2044.2 +060100 PERFORM PASS. SQ2044.2 +060200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2044.2 +060300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2044.2 +060400 READ-WRITE-GF-02. SQ2044.2 +060500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2044.2 +060600 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2044.2 +060700 PERFORM PRINT-DETAIL. SQ2044.2 +060800 READ-CLOSE-GF-02. SQ2044.2 +060900 CLOSE SQ-FS2. SQ2044.2 +061000 SQ204A-END-ROUTINE. SQ2044.2 +061100 MOVE "END OF SQ204A VALIDATION TESTS" TO PRINT-REC. SQ2044.2 +061200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2044.2 +061300 TERMINATE-SQ204A. SQ2044.2 +061400 EXIT. SQ2044.2 +061500 CCVS-EXIT SECTION. SQ2044.2 +061600 CCVS-999999. SQ2044.2 +061700 GO TO CLOSE-FILES. SQ2044.2 +*END-OF,SQ204A +*HEADER,COBOL,SQ205A +000100 IDENTIFICATION DIVISION. SQ2054.2 +000200 PROGRAM-ID. SQ2054.2 +000300 SQ205A. SQ2054.2 +000400**************************************************************** SQ2054.2 +000500* * SQ2054.2 +000600* VALIDATION FOR:- * SQ2054.2 +000700* " HIGH ". SQ2054.2 +000800* * SQ2054.2 +000900* CREATION DATE / VALIDATION DATE * SQ2054.2 +001000* "4.2 ". SQ2054.2 +001100* * SQ2054.2 +001200* THIS ROUTINE (OLD: SQ210) TESTS THE USE STATEMENT WITH XFILE-NASQ2054.2 +001300* SERIES. A MASS STORAGE AND TAPE FILE ARE CREATED AND THEN SQ2054.2 +001400* READ. AN AT END CONDITION IS USED TO CAUSE THE USE PROCEDURESQ2054.2 +001500* TO BE EXECUTED. BOTH FILES HAVE A FILE STATUS CLAUSE IN THE SQ2054.2 +001600* SELECT CLAUSE IN THE FILE-CONTROL PARAGRAPH. SQ2054.2 +001700 ENVIRONMENT DIVISION. SQ2054.2 +001800 CONFIGURATION SECTION. SQ2054.2 +001900 SOURCE-COMPUTER. SQ2054.2 +002000 XXXXX082. SQ2054.2 +002100 OBJECT-COMPUTER. SQ2054.2 +002200 XXXXX083. SQ2054.2 +002300 INPUT-OUTPUT SECTION. SQ2054.2 +002400 FILE-CONTROL. SQ2054.2 +002500P SELECT RAW-DATA ASSIGN TO SQ2054.2 +002600P XXXXX062 SQ2054.2 +002700P ORGANIZATION IS INDEXED SQ2054.2 +002800P ACCESS MODE IS RANDOM SQ2054.2 +002900P RECORD KEY IS RAW-DATA-KEY. SQ2054.2 +003000 SELECT PRINT-FILE ASSIGN TO SQ2054.2 +003100 XXXXX055. SQ2054.2 +003200 SELECT SQ-FS1 ASSIGN TO SQ2054.2 +003300 XXXXX001 SQ2054.2 +003400 ORGANIZATION SEQUENTIAL SQ2054.2 +003500 ACCESS SEQUENTIAL SQ2054.2 +003600 STATUS GRP-STATUS-KEY-1. SQ2054.2 +003700 SELECT SQ-FS2 ASSIGN TO SQ2054.2 +003800 XXXXX014 SQ2054.2 +003900 ORGANIZATION IS SEQUENTIAL SQ2054.2 +004000 FILE STATUS GRP-STATUS-KEY-2. SQ2054.2 +004100 DATA DIVISION. SQ2054.2 +004200 FILE SECTION. SQ2054.2 +004300P SQ2054.2 +004400PFD RAW-DATA. SQ2054.2 +004500P SQ2054.2 +004600P01 RAW-DATA-SATZ. SQ2054.2 +004700P 05 RAW-DATA-KEY PIC X(6). SQ2054.2 +004800P 05 C-DATE PIC 9(6). SQ2054.2 +004900P 05 C-TIME PIC 9(8). SQ2054.2 +005000P 05 C-NO-OF-TESTS PIC 99. SQ2054.2 +005100P 05 C-OK PIC 999. SQ2054.2 +005200P 05 C-ALL PIC 999. SQ2054.2 +005300P 05 C-FAIL PIC 999. SQ2054.2 +005400P 05 C-DELETED PIC 999. SQ2054.2 +005500P 05 C-INSPECT PIC 999. SQ2054.2 +005600P 05 C-NOTE PIC X(13). SQ2054.2 +005700P 05 C-INDENT PIC X. SQ2054.2 +005800P 05 C-ABORT PIC X(8). SQ2054.2 +005900 FD PRINT-FILE SQ2054.2 +006000C LABEL RECORDS SQ2054.2 +006100C XXXXX084 SQ2054.2 +006200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2054.2 +006300 . SQ2054.2 +006400 01 PRINT-REC PICTURE X(120). SQ2054.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ2054.2 +006600 FD SQ-FS1 SQ2054.2 +006700C LABEL RECORD IS STANDARD SQ2054.2 +006800 BLOCK CONTAINS 5 RECORDS. SQ2054.2 +006900 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2054.2 +007000 FD SQ-FS2 SQ2054.2 +007100C LABEL RECORD IS STANDARD SQ2054.2 +007200 BLOCK CONTAINS 5 RECORDS. SQ2054.2 +007300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2054.2 +007400 WORKING-STORAGE SECTION. SQ2054.2 +007500 77 SQ-FS1-ERRORS PIC 999 VALUE ZERO. SQ2054.2 +007600 77 SQ-FS2-ERRORS PIC 999 VALUE ZERO. SQ2054.2 +007700 77 SQ-FS1-EOF-STATUS PIC 9 VALUE ZERO. SQ2054.2 +007800 77 SQ-FS2-EOF-STATUS PIC 9 VALUE ZERO. SQ2054.2 +007900 77 WRK-RECORD-COUNT PIC 999 VALUE ZERO. SQ2054.2 +008000 77 RECORDS-IN-ERROR PIC 999 VALUE ZERO. SQ2054.2 +008100 01 COUNT-OF-RECS PIC 9999 VALUE 0. SQ2054.2 +008200 01 GRP-STATUS-KEY-1. SQ2054.2 +008300 02 WRK-XN-00001-KEY-1 PIC XX. SQ2054.2 +008400* 02 FILLER PIC X. SQ2054.2 +008500 01 GRP-STATUS-KEY-2. SQ2054.2 +008600 02 WRK-XN-00001-KEY-2 PIC XX. SQ2054.2 +008700* 02 FILLER PIC X. SQ2054.2 +008800 01 FILE-RECORD-INFORMATION-REC. SQ2054.2 +008900 03 FILE-RECORD-INFO-SKELETON. SQ2054.2 +009000 05 FILLER PICTURE X(48) VALUE SQ2054.2 +009100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2054.2 +009200 05 FILLER PICTURE X(46) VALUE SQ2054.2 +009300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2054.2 +009400 05 FILLER PICTURE X(26) VALUE SQ2054.2 +009500 ",LFIL=000000,ORG= ,LBLR= ". SQ2054.2 +009600 05 FILLER PICTURE X(37) VALUE SQ2054.2 +009700 ",RECKEY= ". SQ2054.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2054.2 +009900 ",ALTKEY1= ". SQ2054.2 +010000 05 FILLER PICTURE X(38) VALUE SQ2054.2 +010100 ",ALTKEY2= ". SQ2054.2 +010200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2054.2 +010300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2054.2 +010400 05 FILE-RECORD-INFO-P1-120. SQ2054.2 +010500 07 FILLER PIC X(5). SQ2054.2 +010600 07 XFILE-NAME PIC X(6). SQ2054.2 +010700 07 FILLER PIC X(8). SQ2054.2 +010800 07 XRECORD-NAME PIC X(6). SQ2054.2 +010900 07 FILLER PIC X(1). SQ2054.2 +011000 07 REELUNIT-NUMBER PIC 9(1). SQ2054.2 +011100 07 FILLER PIC X(7). SQ2054.2 +011200 07 XRECORD-NUMBER PIC 9(6). SQ2054.2 +011300 07 FILLER PIC X(6). SQ2054.2 +011400 07 UPDATE-NUMBER PIC 9(2). SQ2054.2 +011500 07 FILLER PIC X(5). SQ2054.2 +011600 07 ODO-NUMBER PIC 9(4). SQ2054.2 +011700 07 FILLER PIC X(5). SQ2054.2 +011800 07 XPROGRAM-NAME PIC X(5). SQ2054.2 +011900 07 FILLER PIC X(7). SQ2054.2 +012000 07 XRECORD-LENGTH PIC 9(6). SQ2054.2 +012100 07 FILLER PIC X(7). SQ2054.2 +012200 07 CHARS-OR-RECORDS PIC X(2). SQ2054.2 +012300 07 FILLER PIC X(1). SQ2054.2 +012400 07 XBLOCK-SIZE PIC 9(4). SQ2054.2 +012500 07 FILLER PIC X(6). SQ2054.2 +012600 07 RECORDS-IN-FILE PIC 9(6). SQ2054.2 +012700 07 FILLER PIC X(5). SQ2054.2 +012800 07 XFILE-ORGANIZATION PIC X(2). SQ2054.2 +012900 07 FILLER PIC X(6). SQ2054.2 +013000 07 XLABEL-TYPE PIC X(1). SQ2054.2 +013100 05 FILE-RECORD-INFO-P121-240. SQ2054.2 +013200 07 FILLER PIC X(8). SQ2054.2 +013300 07 XRECORD-KEY PIC X(29). SQ2054.2 +013400 07 FILLER PIC X(9). SQ2054.2 +013500 07 ALTERNATE-KEY1 PIC X(29). SQ2054.2 +013600 07 FILLER PIC X(9). SQ2054.2 +013700 07 ALTERNATE-KEY2 PIC X(29). SQ2054.2 +013800 07 FILLER PIC X(7). SQ2054.2 +013900 01 TEST-RESULTS. SQ2054.2 +014000 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2054.2 +014200 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2054.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014500 02 PAR-NAME. SQ2054.2 +014600 03 FILLER PICTURE X(12) VALUE SPACE. SQ2054.2 +014700 03 PARDOT-X PICTURE X VALUE SPACE. SQ2054.2 +014800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2054.2 +014900 03 FILLER PIC X(5) VALUE SPACE. SQ2054.2 +015000 02 FILLER PIC X(10) VALUE SPACE. SQ2054.2 +015100 02 RE-MARK PIC X(61). SQ2054.2 +015200 01 TEST-COMPUTED. SQ2054.2 +015300 02 FILLER PIC X(30) VALUE SPACE. SQ2054.2 +015400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2054.2 +015500 02 COMPUTED-X. SQ2054.2 +015600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2054.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2054.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2054.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2054.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2054.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2054.2 +016200 04 COMPUTED-18V0 PICTURE -9(18). SQ2054.2 +016300 04 FILLER PICTURE X. SQ2054.2 +016400 03 FILLER PIC X(50) VALUE SPACE. SQ2054.2 +016500 01 TEST-CORRECT. SQ2054.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ2054.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2054.2 +016800 02 CORRECT-X. SQ2054.2 +016900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2054.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2054.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2054.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2054.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2054.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. SQ2054.2 +017500 04 CORRECT-18V0 PICTURE -9(18). SQ2054.2 +017600 04 FILLER PICTURE X. SQ2054.2 +017700 03 FILLER PIC X(50) VALUE SPACE. SQ2054.2 +017800 01 CCVS-C-1. SQ2054.2 +017900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2054.2 +018000- "SS PARAGRAPH-NAME SQ2054.2 +018100- " REMARKS". SQ2054.2 +018200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2054.2 +018300 01 CCVS-C-2. SQ2054.2 +018400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +018500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2054.2 +018600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2054.2 +018700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2054.2 +018800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2054.2 +018900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2054.2 +019000 01 REC-CT PICTURE 99 VALUE ZERO. SQ2054.2 +019100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2054.2 +019200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2054.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2054.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2054.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2054.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2054.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2054.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2054.2 +019900 01 CCVS-H-1. SQ2054.2 +020000 02 FILLER PICTURE X(27) VALUE SPACE. SQ2054.2 +020100 02 FILLER PICTURE X(67) VALUE SQ2054.2 +020200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2054.2 +020300- " SYSTEM". SQ2054.2 +020400 02 FILLER PICTURE X(26) VALUE SPACE. SQ2054.2 +020500 01 CCVS-H-2. SQ2054.2 +020600 02 FILLER PICTURE X(52) VALUE IS SQ2054.2 +020700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2054.2 +020800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2054.2 +020900 02 TEST-ID PICTURE IS X(9). SQ2054.2 +021000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2054.2 +021100 01 CCVS-H-3. SQ2054.2 +021200 02 FILLER PICTURE X(34) VALUE SQ2054.2 +021300 " FOR OFFICIAL USE ONLY ". SQ2054.2 +021400 02 FILLER PICTURE X(58) VALUE SQ2054.2 +021500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2054.2 +021600 02 FILLER PICTURE X(28) VALUE SQ2054.2 +021700 " COPYRIGHT 1985 ". SQ2054.2 +021800 01 CCVS-E-1. SQ2054.2 +021900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2054.2 +022000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2054.2 +022100 02 ID-AGAIN PICTURE IS X(9). SQ2054.2 +022200 02 FILLER PICTURE X(45) VALUE IS SQ2054.2 +022300 " NTIS DISTRIBUTION COBOL 85". SQ2054.2 +022400 01 CCVS-E-2. SQ2054.2 +022500 02 FILLER PICTURE X(31) VALUE SQ2054.2 +022600 SPACE. SQ2054.2 +022700 02 FILLER PICTURE X(21) VALUE SPACE. SQ2054.2 +022800 02 CCVS-E-2-2. SQ2054.2 +022900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2054.2 +023000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +023100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2054.2 +023200 01 CCVS-E-3. SQ2054.2 +023300 02 FILLER PICTURE X(22) VALUE SQ2054.2 +023400 " FOR OFFICIAL USE ONLY". SQ2054.2 +023500 02 FILLER PICTURE X(12) VALUE SPACE. SQ2054.2 +023600 02 FILLER PICTURE X(58) VALUE SQ2054.2 +023700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2054.2 +023800 02 FILLER PICTURE X(13) VALUE SPACE. SQ2054.2 +023900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2054.2 +024000 01 CCVS-E-4. SQ2054.2 +024100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2054.2 +024200 02 FILLER PIC XXXX VALUE " OF ". SQ2054.2 +024300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2054.2 +024400 02 FILLER PIC X(40) VALUE SQ2054.2 +024500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2054.2 +024600 01 XXINFO. SQ2054.2 +024700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2054.2 +024800 02 INFO-TEXT. SQ2054.2 +024900 04 FILLER PIC X(20) VALUE SPACE. SQ2054.2 +025000 04 XXCOMPUTED PIC X(20). SQ2054.2 +025100 04 FILLER PIC X(5) VALUE SPACE. SQ2054.2 +025200 04 XXCORRECT PIC X(20). SQ2054.2 +025300 01 HYPHEN-LINE. SQ2054.2 +025400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +025500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2054.2 +025600- "*****************************************". SQ2054.2 +025700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2054.2 +025800- "******************************". SQ2054.2 +025900 01 CCVS-PGM-ID PIC X(6) VALUE SQ2054.2 +026000 "SQ205A". SQ2054.2 +026100 PROCEDURE DIVISION. SQ2054.2 +026200 DECLARATIVES. SQ2054.2 +026300 SEQ-USE SECTION. SQ2054.2 +026400 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1, SQ-FS2. SQ2054.2 +026500 SEQ-USE-001. SQ2054.2 +026600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" GO TO SEQ-USE-002. SQ2054.2 +026700 IF WRK-XN-00001-KEY-1 EQUAL TO "10" SQ2054.2 +026800 MOVE 1 TO SQ-FS1-EOF-STATUS SQ2054.2 +026900 GO TO SEQ-USE-EXIT. SQ2054.2 +027000 ADD 1 TO SQ-FS1-ERRORS. SQ2054.2 +027100 GO TO SEQ-USE-EXIT. SQ2054.2 +027200 SEQ-USE-002. SQ2054.2 +027300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" GO TO SEQ-USE-EXIT. SQ2054.2 +027400 IF WRK-XN-00001-KEY-2 EQUAL TO "10" SQ2054.2 +027500 MOVE 1 TO SQ-FS2-EOF-STATUS SQ2054.2 +027600 GO TO SEQ-USE-EXIT. SQ2054.2 +027700 ADD 1 TO SQ-FS2-ERRORS. SQ2054.2 +027800 SEQ-USE-EXIT. SQ2054.2 +027900 EXIT. SQ2054.2 +028000 END DECLARATIVES. SQ2054.2 +028100 CCVS1 SECTION. SQ2054.2 +028200 OPEN-FILES. SQ2054.2 +028300P OPEN I-O RAW-DATA. SQ2054.2 +028400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2054.2 +028500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2054.2 +028600P MOVE "ABORTED " TO C-ABORT. SQ2054.2 +028700P ADD 1 TO C-NO-OF-TESTS. SQ2054.2 +028800P ACCEPT C-DATE FROM DATE. SQ2054.2 +028900P ACCEPT C-TIME FROM TIME. SQ2054.2 +029000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2054.2 +029100PEND-E-1. SQ2054.2 +029200P CLOSE RAW-DATA. SQ2054.2 +029300 OPEN OUTPUT PRINT-FILE. SQ2054.2 +029400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2054.2 +029500 MOVE SPACE TO TEST-RESULTS. SQ2054.2 +029600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2054.2 +029700 MOVE ZERO TO REC-SKL-SUB. SQ2054.2 +029800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2054.2 +029900 CCVS-INIT-FILE. SQ2054.2 +030000 ADD 1 TO REC-SKL-SUB. SQ2054.2 +030100 MOVE FILE-RECORD-INFO-SKELETON TO SQ2054.2 +030200 FILE-RECORD-INFO (REC-SKL-SUB). SQ2054.2 +030300 CCVS-INIT-EXIT. SQ2054.2 +030400 GO TO CCVS1-EXIT. SQ2054.2 +030500 CLOSE-FILES. SQ2054.2 +030600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2054.2 +030700P OPEN I-O RAW-DATA. SQ2054.2 +030800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2054.2 +030900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2054.2 +031000P MOVE "OK. " TO C-ABORT. SQ2054.2 +031100P MOVE PASS-COUNTER TO C-OK. SQ2054.2 +031200P MOVE ERROR-HOLD TO C-ALL. SQ2054.2 +031300P MOVE ERROR-COUNTER TO C-FAIL. SQ2054.2 +031400P MOVE DELETE-CNT TO C-DELETED. SQ2054.2 +031500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2054.2 +031600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2054.2 +031700PEND-E-2. SQ2054.2 +031800P CLOSE RAW-DATA. SQ2054.2 +031900 TERMINATE-CCVS. SQ2054.2 +032000S EXIT PROGRAM. SQ2054.2 +032100STERMINATE-CALL. SQ2054.2 +032200 STOP RUN. SQ2054.2 +032300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2054.2 +032400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2054.2 +032500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2054.2 +032600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2054.2 +032700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2054.2 +032800 PRINT-DETAIL. SQ2054.2 +032900 IF REC-CT NOT EQUAL TO ZERO SQ2054.2 +033000 MOVE "." TO PARDOT-X SQ2054.2 +033100 MOVE REC-CT TO DOTVALUE. SQ2054.2 +033200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2054.2 +033300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2054.2 +033400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2054.2 +033500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2054.2 +033600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2054.2 +033700 MOVE SPACE TO CORRECT-X. SQ2054.2 +033800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2054.2 +033900 MOVE SPACE TO RE-MARK. SQ2054.2 +034000 HEAD-ROUTINE. SQ2054.2 +034100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +034200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2054.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2054.2 +034400 COLUMN-NAMES-ROUTINE. SQ2054.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +034800 END-ROUTINE. SQ2054.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2054.2 +035000 END-RTN-EXIT. SQ2054.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +035200 END-ROUTINE-1. SQ2054.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2054.2 +035400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2054.2 +035500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2054.2 +035600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2054.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2054.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2054.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2054.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2054.2 +036100 END-ROUTINE-12. SQ2054.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2054.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2054.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2054.2 +036500 ELSE SQ2054.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2054.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2054.2 +036800 PERFORM WRITE-LINE. SQ2054.2 +036900 END-ROUTINE-13. SQ2054.2 +037000 IF DELETE-CNT IS EQUAL TO ZERO SQ2054.2 +037100 MOVE "NO " TO ERROR-TOTAL ELSE SQ2054.2 +037200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2054.2 +037300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2054.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +037500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2054.2 +037600 MOVE "NO " TO ERROR-TOTAL SQ2054.2 +037700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2054.2 +037800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2054.2 +037900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +038000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +038100 WRITE-LINE. SQ2054.2 +038200 ADD 1 TO RECORD-COUNT. SQ2054.2 +038300Y IF RECORD-COUNT GREATER 50 SQ2054.2 +038400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2054.2 +038500Y MOVE SPACE TO DUMMY-RECORD SQ2054.2 +038600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2054.2 +038700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2054.2 +038800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2054.2 +038900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2054.2 +039000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2054.2 +039100Y MOVE ZERO TO RECORD-COUNT. SQ2054.2 +039200 PERFORM WRT-LN. SQ2054.2 +039300 WRT-LN. SQ2054.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2054.2 +039500 MOVE SPACE TO DUMMY-RECORD. SQ2054.2 +039600 BLANK-LINE-PRINT. SQ2054.2 +039700 PERFORM WRT-LN. SQ2054.2 +039800 FAIL-ROUTINE. SQ2054.2 +039900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2054.2 +040000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2054.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2054.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +040300 GO TO FAIL-ROUTINE-EX. SQ2054.2 +040400 FAIL-ROUTINE-WRITE. SQ2054.2 +040500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2054.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +040700 FAIL-ROUTINE-EX. EXIT. SQ2054.2 +040800 BAIL-OUT. SQ2054.2 +040900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2054.2 +041000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2054.2 +041100 BAIL-OUT-WRITE. SQ2054.2 +041200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2054.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +041400 BAIL-OUT-EX. EXIT. SQ2054.2 +041500 CCVS1-EXIT. SQ2054.2 +041600 EXIT. SQ2054.2 +041700 SECT-SQ205A-0001 SECTION. SQ2054.2 +041800 WRITE-INIT-GF-01. SQ2054.2 +041900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2054.2 +042000 MOVE "SQ205" TO XPROGRAM-NAME (1). SQ2054.2 +042100 MOVE 0120 TO XRECORD-LENGTH (1). SQ2054.2 +042200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2054.2 +042300 MOVE 5 TO XBLOCK-SIZE (1). SQ2054.2 +042400 MOVE 500 TO RECORDS-IN-FILE (1). SQ2054.2 +042500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2054.2 +042600 MOVE "S" TO XLABEL-TYPE (1). SQ2054.2 +042700 MOVE 1 TO XRECORD-NUMBER (1). SQ2054.2 +042800 OPEN OUTPUT SQ-FS1 , SQ-FS2. SQ2054.2 +042900 WRITE-TEST-GF-01-01. SQ2054.2 +043000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2054.2 +043100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2054.2 +043200 WRITE SQ-FS1R1-F-G-120. SQ2054.2 +043300 MOVE "SQ-FS2" TO XFILE-NAME (1). SQ2054.2 +043400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. SQ2054.2 +043500 WRITE SQ-FS2R1-F-G-120. SQ2054.2 +043600 IF XRECORD-NUMBER (1) EQUAL TO 500 SQ2054.2 +043700 GO TO WRITE-TEST-GF-01-02. SQ2054.2 +043800 ADD 1 TO XRECORD-NUMBER (1). SQ2054.2 +043900 GO TO WRITE-TEST-GF-01-01. SQ2054.2 +044000 WRITE-TEST-GF-01-02. SQ2054.2 +044100 MOVE "CREATE FILE SQ-FS1,2" TO FEATURE. SQ2054.2 +044200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2054.2 +044300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2054.2 +044400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2054.2 +044500 PERFORM PRINT-DETAIL. SQ2054.2 +044600 CLOSE SQ-FS1 , SQ-FS2. SQ2054.2 +044700 READ-INIT-GF-01. SQ2054.2 +044800 OPEN INPUT SQ-FS1. SQ2054.2 +044900 READ-TEST-GF-01-01. SQ2054.2 +045000 READ SQ-FS1. SQ2054.2 +045100 IF SQ-FS1-EOF-STATUS EQUAL TO 1 SQ2054.2 +045200 GO TO READ-TEST-GF-01-02. SQ2054.2 +045300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2054.2 +045400 ADD 1 TO WRK-RECORD-COUNT. SQ2054.2 +045500 IF WRK-RECORD-COUNT GREATER THAN 500 SQ2054.2 +045600 MOVE "MORE THAN 500 RECORDS" TO RE-MARK SQ2054.2 +045700 MOVE "RECORDS READ=" TO COMPUTED-A SQ2054.2 +045800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +045900 GO TO READ-FAIL-GF-01. SQ2054.2 +046000 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2054.2 +046100 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +046200 GO TO READ-TEST-GF-01-01. SQ2054.2 +046300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2054.2 +046400 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +046500 GO TO READ-TEST-GF-01-01. SQ2054.2 +046600 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2054.2 +046700 ADD 1 TO RECORDS-IN-ERROR. SQ2054.2 +046800 GO TO READ-TEST-GF-01-01. SQ2054.2 +046900 READ-TEST-GF-01-02. SQ2054.2 +047000 IF WRK-RECORD-COUNT LESS THAN 500 SQ2054.2 +047100 MOVE "LESS THAN 500 RECORDS;VII-52 OR VII-44" SQ2054.2 +047200 TO RE-MARK SQ2054.2 +047300 MOVE "RECORDS READ=" TO COMPUTED-A SQ2054.2 +047400 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +047500 GO TO READ-FAIL-GF-01. SQ2054.2 +047600 IF SQ-FS1-ERRORS NOT EQUAL TO ZERO SQ2054.2 +047700 MOVE "PERM/IMPL ERRORS ENCOUNTERED;VII-44 OR VII-52"SQ2054.2 +047800 TO RE-MARK SQ2054.2 +047900 MOVE "RECORDS IN ERROR=" TO COMPUTED-A SQ2054.2 +048000 MOVE SQ-FS1-ERRORS TO CORRECT-18V0 SQ2054.2 +048100 GO TO READ-FAIL-GF-01. SQ2054.2 +048200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2054.2 +048300 MOVE "ERRORS IN READING SQ-FS1; VII-44 OR VII-52" SQ2054.2 +048400 TO RE-MARK SQ2054.2 +048500 MOVE "RECORDS IN ERROR=" TO COMPUTED-A SQ2054.2 +048600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2054.2 +048700 GO TO READ-FAIL-GF-01. SQ2054.2 +048800 GO TO READ-PASS-GF-01. SQ2054.2 +048900 READ-DELETE-GF-01. SQ2054.2 +049000 PERFORM DE-LETE. SQ2054.2 +049100 GO TO READ-WRITE-GF-01. SQ2054.2 +049200 READ-FAIL-GF-01. SQ2054.2 +049300 PERFORM FAIL. SQ2054.2 +049400 GO TO READ-WRITE-GF-01. SQ2054.2 +049500 READ-PASS-GF-01. SQ2054.2 +049600 PERFORM PASS. SQ2054.2 +049700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2054.2 +049800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2054.2 +049900 READ-WRITE-GF-01. SQ2054.2 +050000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2054.2 +050100 MOVE "VERIFY SQ-FS1;F-S:10" TO FEATURE. SQ2054.2 +050200 PERFORM PRINT-DETAIL. SQ2054.2 +050300 READ-CLOSE-GF-01. SQ2054.2 +050400 CLOSE SQ-FS1. SQ2054.2 +050500 READ-INIT-GF-02. SQ2054.2 +050600 MOVE ZERO TO WRK-RECORD-COUNT. SQ2054.2 +050700 OPEN INPUT SQ-FS2. SQ2054.2 +050800 READ-TEST-GF-02-01. SQ2054.2 +050900 READ SQ-FS2 RECORD. SQ2054.2 +051000 IF SQ-FS2-EOF-STATUS EQUAL 1 SQ2054.2 +051100 GO TO READ-TEST-GF-02-02. SQ2054.2 +051200 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2054.2 +051300 ADD 1 TO WRK-RECORD-COUNT. SQ2054.2 +051400 IF WRK-RECORD-COUNT GREATER THAN 500 SQ2054.2 +051500 MOVE "MORE THAN 500 RECORDS" TO RE-MARK SQ2054.2 +051600 MOVE "RECORDS READ =" TO COMPUTED-A SQ2054.2 +051700 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +051800 GO TO READ-FAIL-GF-02. SQ2054.2 +051900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2054.2 +052000 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +052100 GO TO READ-TEST-GF-02-01. SQ2054.2 +052200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" SQ2054.2 +052300 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +052400 GO TO READ-TEST-GF-02-01. SQ2054.2 +052500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2054.2 +052600 ADD 1 TO RECORDS-IN-ERROR. SQ2054.2 +052700 GO TO READ-TEST-GF-02-01. SQ2054.2 +052800 READ-TEST-GF-02-02. SQ2054.2 +052900 IF WRK-RECORD-COUNT LESS THAN 500 SQ2054.2 +053000 MOVE "LESS THAN 500 RECORDS; VII-44 OR VII-52" SQ2054.2 +053100 TO RE-MARK SQ2054.2 +053200 MOVE "RECORDS READ =" TO COMPUTED-A SQ2054.2 +053300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +053400 GO TO READ-FAIL-GF-02. SQ2054.2 +053500 IF SQ-FS2-ERRORS NOT EQUAL TO ZERO SQ2054.2 +053600 MOVE "PERM/IMPL ERRORS ENCOUNTERED;VII-44 OR -52" SQ2054.2 +053700 TO RE-MARK SQ2054.2 +053800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2054.2 +053900 MOVE SQ-FS2-ERRORS TO CORRECT-18V0 SQ2054.2 +054000 GO TO READ-FAIL-GF-02. SQ2054.2 +054100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2054.2 +054200 MOVE "ERRORS IN READING SQ-FS2; VII-44 OR VII-52" SQ2054.2 +054300 TO RE-MARK SQ2054.2 +054400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2054.2 +054500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2054.2 +054600 GO TO READ-FAIL-GF-02. SQ2054.2 +054700 GO TO READ-PASS-GF-02. SQ2054.2 +054800 READ-DELETE-GF-02. SQ2054.2 +054900 PERFORM DE-LETE. SQ2054.2 +055000 GO TO READ-WRITE-GF-02. SQ2054.2 +055100 READ-FAIL-GF-02. SQ2054.2 +055200 PERFORM FAIL. SQ2054.2 +055300 GO TO READ-WRITE-GF-02. SQ2054.2 +055400 READ-PASS-GF-02. SQ2054.2 +055500 PERFORM PASS. SQ2054.2 +055600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2054.2 +055700 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2054.2 +055800 READ-WRITE-GF-02. SQ2054.2 +055900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2054.2 +056000 MOVE "VERIFY SQ-FS2;F-S:10" TO FEATURE. SQ2054.2 +056100 PERFORM PRINT-DETAIL. SQ2054.2 +056200 READ-CLOSE-GF-02. SQ2054.2 +056300 CLOSE SQ-FS2. SQ2054.2 +056400 SQ205A-END-ROUTINE. SQ2054.2 +056500 MOVE "END OF SQ205A VALIDATION TESTS" TO PRINT-REC. SQ2054.2 +056600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2054.2 +056700 TERMINATE-SQ205A. SQ2054.2 +056800 EXIT. SQ2054.2 +056900 CCVS-EXIT SECTION. SQ2054.2 +057000 CCVS-999999. SQ2054.2 +057100 GO TO CLOSE-FILES. SQ2054.2 +*END-OF,SQ205A +*HEADER,COBOL,SQ206A +000100 IDENTIFICATION DIVISION. SQ2064.2 +000200 PROGRAM-ID. SQ2064.2 +000300 SQ206A. SQ2064.2 +000400**************************************************************** SQ2064.2 +000500* * SQ2064.2 +000600* VALIDATION FOR:- * SQ2064.2 +000700* " HIGH ". SQ2064.2 +000800* * SQ2064.2 +000900* CREATION DATE / VALIDATION DATE * SQ2064.2 +001000* "4.2 ". SQ2064.2 +001100* * SQ2064.2 +001200* THE ROUTINE SQ206A TESTS THE USE OF THE CLAUSES SAME SQ2064.2 +001300* RECORD AREA AND SAME AREA OF THE I-O-CONTROL PARAGRAPH. SQ2064.2 +001400* TAPE FILES AND MASS-STORAGE FILES ARE CREATED WHICH SQ2064.2 +001500* REFERENCE THE SAME RECORD AREA OR ARE NAMED IN A SAME AREA SQ2064.2 +001600* CLAUSE. THE FILES ARE PROCESSED AND THE CONTENTS OF THE SQ2064.2 +001700* RECORDS VERIFIED AGAINST THE EXPECTED RESULTS. SQ2064.2 +001800 ENVIRONMENT DIVISION. SQ2064.2 +001900 CONFIGURATION SECTION. SQ2064.2 +002000 SOURCE-COMPUTER. SQ2064.2 +002100 XXXXX082. SQ2064.2 +002200 OBJECT-COMPUTER. SQ2064.2 +002300 XXXXX083. SQ2064.2 +002400 INPUT-OUTPUT SECTION. SQ2064.2 +002500 FILE-CONTROL. SQ2064.2 +002600P SELECT RAW-DATA ASSIGN TO SQ2064.2 +002700P XXXXX062 SQ2064.2 +002800P ORGANIZATION IS INDEXED SQ2064.2 +002900P ACCESS MODE IS RANDOM SQ2064.2 +003000P RECORD KEY IS RAW-DATA-KEY. SQ2064.2 +003100 SELECT PRINT-FILE ASSIGN TO SQ2064.2 +003200 XXXXX055. SQ2064.2 +003300 SELECT SQ-FS1 ASSIGN TO SQ2064.2 +003400 XXXXX001 SQ2064.2 +003500 ORGANIZATION SEQUENTIAL. SQ2064.2 +003600 SELECT SQ-FS2 ASSIGN SQ2064.2 +003700 XXXXX014 SQ2064.2 +003800 ACCESS IS SEQUENTIAL. SQ2064.2 +003900 SELECT SQ-FS3 ASSIGN TO SQ2064.2 +004000 XXXXX015 SQ2064.2 +004100 ORGANIZATION IS SEQUENTIAL SQ2064.2 +004200 ACCESS MODE SEQUENTIAL. SQ2064.2 +004300 SELECT SQ-FS4 ASSIGN SQ2064.2 +004400 XXXXX002 SQ2064.2 +004500 ORGANIZATION SEQUENTIAL SQ2064.2 +004600 ACCESS SEQUENTIAL. SQ2064.2 +004700 I-O-CONTROL. SQ2064.2 +004800 SAME SQ-FS1, SQ-FS2 SQ2064.2 +004900 SAME RECORD AREA FOR SQ-FS1, SQ-FS2, SQ-FS3, SQ-FS4. SQ2064.2 +005000 DATA DIVISION. SQ2064.2 +005100 FILE SECTION. SQ2064.2 +005200P SQ2064.2 +005300PFD RAW-DATA. SQ2064.2 +005400P SQ2064.2 +005500P01 RAW-DATA-SATZ. SQ2064.2 +005600P 05 RAW-DATA-KEY PIC X(6). SQ2064.2 +005700P 05 C-DATE PIC 9(6). SQ2064.2 +005800P 05 C-TIME PIC 9(8). SQ2064.2 +005900P 05 C-NO-OF-TESTS PIC 99. SQ2064.2 +006000P 05 C-OK PIC 999. SQ2064.2 +006100P 05 C-ALL PIC 999. SQ2064.2 +006200P 05 C-FAIL PIC 999. SQ2064.2 +006300P 05 C-DELETED PIC 999. SQ2064.2 +006400P 05 C-INSPECT PIC 999. SQ2064.2 +006500P 05 C-NOTE PIC X(13). SQ2064.2 +006600P 05 C-INDENT PIC X. SQ2064.2 +006700P 05 C-ABORT PIC X(8). SQ2064.2 +006800 FD PRINT-FILE SQ2064.2 +006900C LABEL RECORDS SQ2064.2 +007000C XXXXX084 SQ2064.2 +007100C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2064.2 +007200 . SQ2064.2 +007300 01 PRINT-REC PICTURE X(120). SQ2064.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ2064.2 +007500 FD SQ-FS1 SQ2064.2 +007600C LABEL RECORDS ARE STANDARD SQ2064.2 +007700 BLOCK CONTAINS 120 CHARACTERS. SQ2064.2 +007800 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2064.2 +007900 FD SQ-FS2 SQ2064.2 +008000C LABEL RECORD IS STANDARD SQ2064.2 +008100 . SQ2064.2 +008200 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2064.2 +008300 FD SQ-FS3 SQ2064.2 +008400C LABEL RECORD STANDARD SQ2064.2 +008500 . SQ2064.2 +008600 01 SQ-FS3R1-F-G-120 PIC X(120). SQ2064.2 +008700 FD SQ-FS4 SQ2064.2 +008800C LABEL RECORDS STANDARD SQ2064.2 +008900 . SQ2064.2 +009000 01 SQ-FS4R1-F-G-120 PIC X(120). SQ2064.2 +009100 WORKING-STORAGE SECTION. SQ2064.2 +009200 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2064.2 +009300 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2064.2 +009400 01 COUNT-OF-RECS PIC 9999. SQ2064.2 +009500 01 FILE-RECORD-INFORMATION-REC. SQ2064.2 +009600 03 FILE-RECORD-INFO-SKELETON. SQ2064.2 +009700 05 FILLER PICTURE X(48) VALUE SQ2064.2 +009800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2064.2 +009900 05 FILLER PICTURE X(46) VALUE SQ2064.2 +010000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2064.2 +010100 05 FILLER PICTURE X(26) VALUE SQ2064.2 +010200 ",LFIL=000000,ORG= ,LBLR= ". SQ2064.2 +010300 05 FILLER PICTURE X(37) VALUE SQ2064.2 +010400 ",RECKEY= ". SQ2064.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2064.2 +010600 ",ALTKEY1= ". SQ2064.2 +010700 05 FILLER PICTURE X(38) VALUE SQ2064.2 +010800 ",ALTKEY2= ". SQ2064.2 +010900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2064.2 +011000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2064.2 +011100 05 FILE-RECORD-INFO-P1-120. SQ2064.2 +011200 07 FILLER PIC X(5). SQ2064.2 +011300 07 XFILE-NAME PIC X(6). SQ2064.2 +011400 07 FILLER PIC X(8). SQ2064.2 +011500 07 XRECORD-NAME PIC X(6). SQ2064.2 +011600 07 FILLER PIC X(1). SQ2064.2 +011700 07 REELUNIT-NUMBER PIC 9(1). SQ2064.2 +011800 07 FILLER PIC X(7). SQ2064.2 +011900 07 XRECORD-NUMBER PIC 9(6). SQ2064.2 +012000 07 FILLER PIC X(6). SQ2064.2 +012100 07 UPDATE-NUMBER PIC 9(2). SQ2064.2 +012200 07 FILLER PIC X(5). SQ2064.2 +012300 07 ODO-NUMBER PIC 9(4). SQ2064.2 +012400 07 FILLER PIC X(5). SQ2064.2 +012500 07 XPROGRAM-NAME PIC X(5). SQ2064.2 +012600 07 FILLER PIC X(7). SQ2064.2 +012700 07 XRECORD-LENGTH PIC 9(6). SQ2064.2 +012800 07 FILLER PIC X(7). SQ2064.2 +012900 07 CHARS-OR-RECORDS PIC X(2). SQ2064.2 +013000 07 FILLER PIC X(1). SQ2064.2 +013100 07 XBLOCK-SIZE PIC 9(4). SQ2064.2 +013200 07 FILLER PIC X(6). SQ2064.2 +013300 07 RECORDS-IN-FILE PIC 9(6). SQ2064.2 +013400 07 FILLER PIC X(5). SQ2064.2 +013500 07 XFILE-ORGANIZATION PIC X(2). SQ2064.2 +013600 07 FILLER PIC X(6). SQ2064.2 +013700 07 XLABEL-TYPE PIC X(1). SQ2064.2 +013800 05 FILE-RECORD-INFO-P121-240. SQ2064.2 +013900 07 FILLER PIC X(8). SQ2064.2 +014000 07 XRECORD-KEY PIC X(29). SQ2064.2 +014100 07 FILLER PIC X(9). SQ2064.2 +014200 07 ALTERNATE-KEY1 PIC X(29). SQ2064.2 +014300 07 FILLER PIC X(9). SQ2064.2 +014400 07 ALTERNATE-KEY2 PIC X(29). SQ2064.2 +014500 07 FILLER PIC X(7). SQ2064.2 +014600 01 TEST-RESULTS. SQ2064.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +014800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2064.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +015000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2064.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +015200 02 PAR-NAME. SQ2064.2 +015300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2064.2 +015400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2064.2 +015500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2064.2 +015600 03 FILLER PIC X(5) VALUE SPACE. SQ2064.2 +015700 02 FILLER PIC X(10) VALUE SPACE. SQ2064.2 +015800 02 RE-MARK PIC X(61). SQ2064.2 +015900 01 TEST-COMPUTED. SQ2064.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ2064.2 +016100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2064.2 +016200 02 COMPUTED-X. SQ2064.2 +016300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2064.2 +016400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2064.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2064.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2064.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2064.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2064.2 +016900 04 COMPUTED-18V0 PICTURE -9(18). SQ2064.2 +017000 04 FILLER PICTURE X. SQ2064.2 +017100 03 FILLER PIC X(50) VALUE SPACE. SQ2064.2 +017200 01 TEST-CORRECT. SQ2064.2 +017300 02 FILLER PIC X(30) VALUE SPACE. SQ2064.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2064.2 +017500 02 CORRECT-X. SQ2064.2 +017600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2064.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2064.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2064.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2064.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2064.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. SQ2064.2 +018200 04 CORRECT-18V0 PICTURE -9(18). SQ2064.2 +018300 04 FILLER PICTURE X. SQ2064.2 +018400 03 FILLER PIC X(50) VALUE SPACE. SQ2064.2 +018500 01 CCVS-C-1. SQ2064.2 +018600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2064.2 +018700- "SS PARAGRAPH-NAME SQ2064.2 +018800- " REMARKS". SQ2064.2 +018900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2064.2 +019000 01 CCVS-C-2. SQ2064.2 +019100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +019200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2064.2 +019300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2064.2 +019400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2064.2 +019500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2064.2 +019600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2064.2 +019700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2064.2 +019800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2064.2 +019900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2064.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2064.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2064.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2064.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2064.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2064.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2064.2 +020600 01 CCVS-H-1. SQ2064.2 +020700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2064.2 +020800 02 FILLER PICTURE X(67) VALUE SQ2064.2 +020900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2064.2 +021000- " SYSTEM". SQ2064.2 +021100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2064.2 +021200 01 CCVS-H-2. SQ2064.2 +021300 02 FILLER PICTURE X(52) VALUE IS SQ2064.2 +021400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2064.2 +021500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2064.2 +021600 02 TEST-ID PICTURE IS X(9). SQ2064.2 +021700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2064.2 +021800 01 CCVS-H-3. SQ2064.2 +021900 02 FILLER PICTURE X(34) VALUE SQ2064.2 +022000 " FOR OFFICIAL USE ONLY ". SQ2064.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2064.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2064.2 +022300 02 FILLER PICTURE X(28) VALUE SQ2064.2 +022400 " COPYRIGHT 1985 ". SQ2064.2 +022500 01 CCVS-E-1. SQ2064.2 +022600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2064.2 +022700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2064.2 +022800 02 ID-AGAIN PICTURE IS X(9). SQ2064.2 +022900 02 FILLER PICTURE X(45) VALUE IS SQ2064.2 +023000 " NTIS DISTRIBUTION COBOL 85". SQ2064.2 +023100 01 CCVS-E-2. SQ2064.2 +023200 02 FILLER PICTURE X(31) VALUE SQ2064.2 +023300 SPACE. SQ2064.2 +023400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2064.2 +023500 02 CCVS-E-2-2. SQ2064.2 +023600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2064.2 +023700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +023800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2064.2 +023900 01 CCVS-E-3. SQ2064.2 +024000 02 FILLER PICTURE X(22) VALUE SQ2064.2 +024100 " FOR OFFICIAL USE ONLY". SQ2064.2 +024200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2064.2 +024300 02 FILLER PICTURE X(58) VALUE SQ2064.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2064.2 +024500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2064.2 +024600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2064.2 +024700 01 CCVS-E-4. SQ2064.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2064.2 +024900 02 FILLER PIC XXXX VALUE " OF ". SQ2064.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2064.2 +025100 02 FILLER PIC X(40) VALUE SQ2064.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2064.2 +025300 01 XXINFO. SQ2064.2 +025400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2064.2 +025500 02 INFO-TEXT. SQ2064.2 +025600 04 FILLER PIC X(20) VALUE SPACE. SQ2064.2 +025700 04 XXCOMPUTED PIC X(20). SQ2064.2 +025800 04 FILLER PIC X(5) VALUE SPACE. SQ2064.2 +025900 04 XXCORRECT PIC X(20). SQ2064.2 +026000 01 HYPHEN-LINE. SQ2064.2 +026100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +026200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2064.2 +026300- "*****************************************". SQ2064.2 +026400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2064.2 +026500- "******************************". SQ2064.2 +026600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2064.2 +026700 "SQ206A". SQ2064.2 +026800 PROCEDURE DIVISION. SQ2064.2 +026900 CCVS1 SECTION. SQ2064.2 +027000 OPEN-FILES. SQ2064.2 +027100P OPEN I-O RAW-DATA. SQ2064.2 +027200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2064.2 +027300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2064.2 +027400P MOVE "ABORTED " TO C-ABORT. SQ2064.2 +027500P ADD 1 TO C-NO-OF-TESTS. SQ2064.2 +027600P ACCEPT C-DATE FROM DATE. SQ2064.2 +027700P ACCEPT C-TIME FROM TIME. SQ2064.2 +027800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2064.2 +027900PEND-E-1. SQ2064.2 +028000P CLOSE RAW-DATA. SQ2064.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2064.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2064.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ2064.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2064.2 +028500 MOVE ZERO TO REC-SKL-SUB. SQ2064.2 +028600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2064.2 +028700 CCVS-INIT-FILE. SQ2064.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2064.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2064.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2064.2 +029100 CCVS-INIT-EXIT. SQ2064.2 +029200 GO TO CCVS1-EXIT. SQ2064.2 +029300 CLOSE-FILES. SQ2064.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2064.2 +029500P OPEN I-O RAW-DATA. SQ2064.2 +029600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2064.2 +029700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2064.2 +029800P MOVE "OK. " TO C-ABORT. SQ2064.2 +029900P MOVE PASS-COUNTER TO C-OK. SQ2064.2 +030000P MOVE ERROR-HOLD TO C-ALL. SQ2064.2 +030100P MOVE ERROR-COUNTER TO C-FAIL. SQ2064.2 +030200P MOVE DELETE-CNT TO C-DELETED. SQ2064.2 +030300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2064.2 +030400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2064.2 +030500PEND-E-2. SQ2064.2 +030600P CLOSE RAW-DATA. SQ2064.2 +030700 TERMINATE-CCVS. SQ2064.2 +030800S EXIT PROGRAM. SQ2064.2 +030900STERMINATE-CALL. SQ2064.2 +031000 STOP RUN. SQ2064.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2064.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2064.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2064.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2064.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2064.2 +031600 PRINT-DETAIL. SQ2064.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2064.2 +031800 MOVE "." TO PARDOT-X SQ2064.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2064.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2064.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2064.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2064.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2064.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2064.2 +032500 MOVE SPACE TO CORRECT-X. SQ2064.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2064.2 +032700 MOVE SPACE TO RE-MARK. SQ2064.2 +032800 HEAD-ROUTINE. SQ2064.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2064.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2064.2 +033200 COLUMN-NAMES-ROUTINE. SQ2064.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +033600 END-ROUTINE. SQ2064.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2064.2 +033800 END-RTN-EXIT. SQ2064.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +034000 END-ROUTINE-1. SQ2064.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2064.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2064.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2064.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2064.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2064.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2064.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2064.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2064.2 +034900 END-ROUTINE-12. SQ2064.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2064.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2064.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2064.2 +035300 ELSE SQ2064.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2064.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2064.2 +035600 PERFORM WRITE-LINE. SQ2064.2 +035700 END-ROUTINE-13. SQ2064.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2064.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2064.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2064.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2064.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2064.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2064.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2064.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2064.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036900 WRITE-LINE. SQ2064.2 +037000 ADD 1 TO RECORD-COUNT. SQ2064.2 +037100Y IF RECORD-COUNT GREATER 50 SQ2064.2 +037200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2064.2 +037300Y MOVE SPACE TO DUMMY-RECORD SQ2064.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2064.2 +037500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2064.2 +037600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2064.2 +037700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2064.2 +037800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2064.2 +037900Y MOVE ZERO TO RECORD-COUNT. SQ2064.2 +038000 PERFORM WRT-LN. SQ2064.2 +038100 WRT-LN. SQ2064.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2064.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2064.2 +038400 BLANK-LINE-PRINT. SQ2064.2 +038500 PERFORM WRT-LN. SQ2064.2 +038600 FAIL-ROUTINE. SQ2064.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2064.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2064.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2064.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2064.2 +039200 FAIL-ROUTINE-WRITE. SQ2064.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2064.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2064.2 +039600 BAIL-OUT. SQ2064.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2064.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2064.2 +039900 BAIL-OUT-WRITE. SQ2064.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2064.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +040200 BAIL-OUT-EX. EXIT. SQ2064.2 +040300 CCVS1-EXIT. SQ2064.2 +040400 EXIT. SQ2064.2 +040500 SECT-SQ206A-0001 SECTION. SQ2064.2 +040600 WRITE-INIT-GF-01. SQ2064.2 +040700* IN THIS TEST TWO FILES ARE CREATED USING THE SAME SQ2064.2 +040800* RECORD AREA. THE LOGICAL RECORD WRITTEN ON SQ-FS1 SQ2064.2 +040900* REMAINS IN THE RECORD AREA TO BE WRITTEN ON SQ-FS3. SQ2064.2 +041000* ONLY THE FILE NAMES CHANGE. SQ2064.2 +041100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2064.2 +041200 MOVE "SQ206" TO XPROGRAM-NAME (1). SQ2064.2 +041300 MOVE 120 TO XRECORD-LENGTH (1). SQ2064.2 +041400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2064.2 +041500 MOVE 1 TO XBLOCK-SIZE (1). SQ2064.2 +041600 MOVE 750 TO RECORDS-IN-FILE (1). SQ2064.2 +041700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2064.2 +041800 MOVE "S" TO XLABEL-TYPE (1). SQ2064.2 +041900 MOVE 1 TO XRECORD-NUMBER (1). SQ2064.2 +042000 OPEN OUTPUT SQ-FS1, SQ-FS3. SQ2064.2 +042100 WRITE-TEST-GF-01. SQ2064.2 +042200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2064.2 +042300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2064.2 +042400 WRITE SQ-FS1R1-F-G-120. SQ2064.2 +042500 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ2064.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ2064.2 +042700 WRITE SQ-FS3R1-F-G-120. SQ2064.2 +042800 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2064.2 +042900 GO TO WRITE-WRITE-GF-01. SQ2064.2 +043000 ADD 1 TO XRECORD-NUMBER (1). SQ2064.2 +043100 GO TO WRITE-TEST-GF-01. SQ2064.2 +043200 WRITE-DELETE-GF-01. SQ2064.2 +043300 PERFORM DE-LETE. SQ2064.2 +043400 WRITE-WRITE-GF-01. SQ2064.2 +043500 MOVE "CREATE SQ-FS1,SQ-FS3" TO FEATURE. SQ2064.2 +043600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2064.2 +043700 MOVE "FILES CREATED RECS =" TO COMPUTED-A. SQ2064.2 +043800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2064.2 +043900 PERFORM PRINT-DETAIL. SQ2064.2 +044000 CLOSE SQ-FS1, SQ-FS3. SQ2064.2 +044100 WRITE-INIT-GF-02. SQ2064.2 +044200 MOVE "SQ-FS4" TO XFILE-NAME (2). SQ2064.2 +044300 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2064.2 +044400 MOVE "SQ206" TO XPROGRAM-NAME (2). SQ2064.2 +044500 MOVE 120 TO XRECORD-LENGTH (2). SQ2064.2 +044600 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2064.2 +044700 MOVE 1 TO XBLOCK-SIZE (2). SQ2064.2 +044800 MOVE 750 TO RECORDS-IN-FILE (2). SQ2064.2 +044900 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2064.2 +045000 MOVE "S" TO XLABEL-TYPE (2). SQ2064.2 +045100 MOVE 1 TO XRECORD-NUMBER (2). SQ2064.2 +045200 OPEN INPUT SQ-FS1, SQ-FS3 SQ2064.2 +045300 OUTPUT SQ-FS4. SQ2064.2 +045400 WRITE-TEST-GF-02. SQ2064.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS4R1-F-G-120. SQ2064.2 +045600 WRITE SQ-FS4R1-F-G-120. SQ2064.2 +045700 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2064.2 +045800 GO TO WRITE-WRITE-GF-02. SQ2064.2 +045900 ADD 1 TO XRECORD-NUMBER (2). SQ2064.2 +046000 GO TO WRITE-TEST-GF-02. SQ2064.2 +046100 WRITE-DELETE-GF-02. SQ2064.2 +046200 PERFORM DE-LETE. SQ2064.2 +046300 WRITE-WRITE-GF-02. SQ2064.2 +046400 MOVE "CREATE FILE SQ-FS4" TO FEATURE. SQ2064.2 +046500 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2064.2 +046600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2064.2 +046700 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2064.2 +046800 PERFORM PRINT-DETAIL. SQ2064.2 +046900 CLOSE SQ-FS4. SQ2064.2 +047000 READ-INIT-GF-01. SQ2064.2 +047100* THIS TEST READS AND VALIDATES SQ-FS1 WHICH WAS SQ2064.2 +047200* CREATED IN WRITE-TEST-GF-01. SQ-FS1 IS OPENED FOR SQ2064.2 +047300* INPUT IN WRITE-INIT-GF-02. SQ2064.2 +047400 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +047500 READ-TEST-GF-01. SQ2064.2 +047600 READ SQ-FS1 SQ2064.2 +047700 AT END GO TO READ-TEST-GF-01-01. SQ2064.2 +047800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2064.2 +047900 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +048000 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +048100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +048200 GO TO READ-FAIL-GF-01. SQ2064.2 +048300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2064.2 +048400 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +048500 GO TO READ-TEST-GF-01. SQ2064.2 +048600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2064.2 +048700 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +048800 GO TO READ-TEST-GF-01. SQ2064.2 +048900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2064.2 +049000 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +049100 GO TO READ-TEST-GF-01. SQ2064.2 +049200 READ-TEST-GF-01-01. SQ2064.2 +049300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +049400 GO TO READ-PASS-GF-01. SQ2064.2 +049500 MOVE "ERRORS IN READING-SQ-FS1" TO RE-MARK. SQ2064.2 +049600 GO TO READ-FAIL-GF-01. SQ2064.2 +049700 READ-DELETE-GF-01. SQ2064.2 +049800 PERFORM DE-LETE. SQ2064.2 +049900 GO TO READ-WRITE-GF-01. SQ2064.2 +050000 READ-FAIL-GF-01. SQ2064.2 +050100 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +050200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +050300 PERFORM FAIL. SQ2064.2 +050400 GO TO READ-WRITE-GF-01. SQ2064.2 +050500 READ-PASS-GF-01. SQ2064.2 +050600 PERFORM PASS. SQ2064.2 +050700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +050800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +050900 READ-WRITE-GF-01. SQ2064.2 +051000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2064.2 +051100 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2064.2 +051200 PERFORM PRINT-DETAIL. SQ2064.2 +051300 READ-CLOSE-GF-01. SQ2064.2 +051400 CLOSE SQ-FS1. SQ2064.2 +051500 READ-INIT-GF-02. SQ2064.2 +051600* THIS TEST READS AND VALIDATES SQ-FS3 WHICH WAS SQ2064.2 +051700* CREATED IN WRITE-TEST-GF-01. SQ-FS3 IS OPENED FOR SQ2064.2 +051800* INPUT IN WRITE-INIT-GF-02. SQ2064.2 +051900 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +052000 READ-TEST-GF-02. SQ2064.2 +052100 READ SQ-FS3 SQ2064.2 +052200 AT END GO TO READ-TEST-GF-02-01. SQ2064.2 +052300 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (3). SQ2064.2 +052400 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +052500 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +052600 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +052700 GO TO READ-FAIL-GF-02. SQ2064.2 +052800 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (3) SQ2064.2 +052900 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +053000 GO TO READ-TEST-GF-02. SQ2064.2 +053100 IF XFILE-NAME (3) NOT EQUAL TO "SQ-FS3" SQ2064.2 +053200 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +053300 GO TO READ-TEST-GF-02. SQ2064.2 +053400 IF XLABEL-TYPE (3) NOT EQUAL TO "S" SQ2064.2 +053500 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +053600 GO TO READ-TEST-GF-02. SQ2064.2 +053700 READ-TEST-GF-02-01. SQ2064.2 +053800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +053900 GO TO READ-PASS-GF-02. SQ2064.2 +054000 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ2064.2 +054100 GO TO READ-FAIL-GF-02. SQ2064.2 +054200 READ-DELETE-GF-02. SQ2064.2 +054300 PERFORM DE-LETE. SQ2064.2 +054400 GO TO READ-WRITE-GF-02. SQ2064.2 +054500 READ-FAIL-GF-02. SQ2064.2 +054600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +054700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +054800 PERFORM FAIL. SQ2064.2 +054900 GO TO READ-WRITE-GF-02. SQ2064.2 +055000 READ-PASS-GF-02. SQ2064.2 +055100 PERFORM PASS. SQ2064.2 +055200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +055300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +055400 READ-WRITE-GF-02. SQ2064.2 +055500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2064.2 +055600 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ2064.2 +055700 PERFORM PRINT-DETAIL. SQ2064.2 +055800 READ-CLOSE-GF-02. SQ2064.2 +055900 CLOSE SQ-FS3. SQ2064.2 +056000 READ-INIT-GF-03. SQ2064.2 +056100* IN THIS TEST SQ-FS2 IS CREATED AND SQ-FS4 IS READ SQ2064.2 +056200* AND VALIDATED USING SAME RECORD AREA. SQ-FS4 WAS SQ2064.2 +056300* CREATED IN WRITE-TEST-GF-02. SQ2064.2 +056400 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2064.2 +056500 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2064.2 +056600 MOVE "SQ206" TO XPROGRAM-NAME (2). SQ2064.2 +056700 MOVE 120 TO XRECORD-LENGTH (2). SQ2064.2 +056800 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2064.2 +056900 MOVE 1 TO XBLOCK-SIZE (2). SQ2064.2 +057000 MOVE 750 TO RECORDS-IN-FILE (2). SQ2064.2 +057100 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2064.2 +057200 MOVE "S" TO XLABEL-TYPE (2). SQ2064.2 +057300 MOVE 1 TO XRECORD-NUMBER (2). SQ2064.2 +057400 OPEN INPUT SQ-FS4 SQ2064.2 +057500 OUTPUT SQ-FS2. SQ2064.2 +057600 READ-TEST-GF-03. SQ2064.2 +057700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2064.2 +057800 WRITE SQ-FS2R1-F-G-120. SQ2064.2 +057900 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2064.2 +058000 GO TO READ-WRITE-GF-03. SQ2064.2 +058100 ADD 1 TO XRECORD-NUMBER (2). SQ2064.2 +058200 GO TO READ-TEST-GF-03. SQ2064.2 +058300 READ-DELETE-GF-03. SQ2064.2 +058400 PERFORM DE-LETE. SQ2064.2 +058500 READ-WRITE-GF-03. SQ2064.2 +058600 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2064.2 +058700 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2064.2 +058800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2064.2 +058900 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2064.2 +059000 PERFORM PRINT-DETAIL. SQ2064.2 +059100 CLOSE SQ-FS2. SQ2064.2 +059200 READ-INIT-GF-04. SQ2064.2 +059300* THIS TEST READS AND VALIDATES SQ-FS4 WHICH WAS SQ2064.2 +059400* CREATED IN WRITE-TEST-GF-02. SQ-FS4 IS OPENED FOR SQ2064.2 +059500* INPUT IN WRITE-INIT-GF-03. SQ2064.2 +059600 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +059700 READ-TEST-GF-04. SQ2064.2 +059800 READ SQ-FS4 SQ2064.2 +059900 AT END GO TO READ-TEST-GF-04-01. SQ2064.2 +060000 MOVE SQ-FS4R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (4). SQ2064.2 +060100 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +060200 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +060300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +060400 GO TO READ-FAIL-GF-04. SQ2064.2 +060500 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (4) SQ2064.2 +060600 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +060700 GO TO READ-TEST-GF-04. SQ2064.2 +060800 IF XFILE-NAME (4) NOT EQUAL TO "SQ-FS4" SQ2064.2 +060900 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +061000 GO TO READ-TEST-GF-04. SQ2064.2 +061100 IF XLABEL-TYPE (4) NOT EQUAL TO "S" SQ2064.2 +061200 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +061300 GO TO READ-TEST-GF-04. SQ2064.2 +061400 READ-TEST-GF-04-01. SQ2064.2 +061500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +061600 GO TO READ-PASS-GF-04. SQ2064.2 +061700 MOVE "ERRORS IN READING SQ-FS4" TO RE-MARK. SQ2064.2 +061800 GO TO READ-FAIL-GF-04. SQ2064.2 +061900 READ-DELETE-GF-04. SQ2064.2 +062000 PERFORM DE-LETE. SQ2064.2 +062100 GO TO READ-WRITE-GF-04. SQ2064.2 +062200 READ-FAIL-GF-04. SQ2064.2 +062300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +062400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +062500 PERFORM FAIL. SQ2064.2 +062600 GO TO READ-WRITE-GF-04. SQ2064.2 +062700 READ-PASS-GF-04. SQ2064.2 +062800 PERFORM PASS. SQ2064.2 +062900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +063000 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +063100 READ-WRITE-GF-04. SQ2064.2 +063200 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ2064.2 +063300 MOVE "VERIFY FILE SQ-FS4" TO FEATURE. SQ2064.2 +063400 PERFORM PRINT-DETAIL. SQ2064.2 +063500 READ-CLOSE-GF-04. SQ2064.2 +063600 CLOSE SQ-FS4. SQ2064.2 +063700 READ-INIT-GF-05. SQ2064.2 +063800* THIS TEST READS AND VALIDATE SQ-FS2 WHICH WAS SQ2064.2 +063900* CREATED IN WRITE-TEST-GF-02. SQ2064.2 +064000 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +064100 OPEN INPUT SQ-FS2. SQ2064.2 +064200 READ-TEST-GF-05. SQ2064.2 +064300 READ SQ-FS2 SQ2064.2 +064400 AT END GO TO READ-TEST-GF-05-01. SQ2064.2 +064500 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ2064.2 +064600 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +064700 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +064800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +064900 GO TO READ-FAIL-GF-05. SQ2064.2 +065000 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2064.2 +065100 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +065200 GO TO READ-TEST-GF-05. SQ2064.2 +065300 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2064.2 +065400 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +065500 GO TO READ-TEST-GF-05. SQ2064.2 +065600 IF XLABEL-TYPE (2) NOT EQUAL TO "S" SQ2064.2 +065700 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +065800 GO TO READ-TEST-GF-05. SQ2064.2 +065900 READ-TEST-GF-05-01. SQ2064.2 +066000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +066100 GO TO READ-PASS-GF-05. SQ2064.2 +066200 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. SQ2064.2 +066300 GO TO READ-FAIL-GF-05. SQ2064.2 +066400 READ-DELETE-GF-05. SQ2064.2 +066500 PERFORM DE-LETE. SQ2064.2 +066600 GO TO READ-WRITE-GF-05. SQ2064.2 +066700 READ-FAIL-GF-05. SQ2064.2 +066800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +066900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +067000 PERFORM FAIL. SQ2064.2 +067100 GO TO READ-WRITE-GF-05. SQ2064.2 +067200 READ-PASS-GF-05. SQ2064.2 +067300 PERFORM PASS. SQ2064.2 +067400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +067500 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +067600 READ-WRITE-GF-05. SQ2064.2 +067700 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ2064.2 +067800 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2064.2 +067900 PERFORM PRINT-DETAIL. SQ2064.2 +068000 READ-CLOSE-GF-05. SQ2064.2 +068100 CLOSE SQ-FS2. SQ2064.2 +068200 SQ206A-END-ROUTINE. SQ2064.2 +068300 MOVE "END OF SQ206A VALIDATION TESTS" TO PRINT-REC. SQ2064.2 +068400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2064.2 +068500 TERMINATE-SQ206A. SQ2064.2 +068600 EXIT. SQ2064.2 +068700 CCVS-EXIT SECTION. SQ2064.2 +068800 CCVS-999999. SQ2064.2 +068900 GO TO CLOSE-FILES. SQ2064.2 +*END-OF,SQ206A +*HEADER,COBOL,SQ207M +000100 IDENTIFICATION DIVISION. SQ2074.2 +000200 PROGRAM-ID. SQ2074.2 +000300 SQ207M. SQ2074.2 +000400**************************************************************** SQ2074.2 +000500* * SQ2074.2 +000600* VALIDATION FOR:- * SQ2074.2 +000700* " HIGH ". SQ2074.2 +000800* * SQ2074.2 +000900* CREATION DATE / VALIDATION DATE * SQ2074.2 +001000* "4.2 ". SQ2074.2 +001100* * SQ2074.2 +001200* THE ROUTINE SQ207M TESTS THE USE OF THE LEVEL 2 WRITE SQ2074.2 +001300* STATEMENT FOR A FILE DESIGNATED AS PRINTER OUTPUT. THESE SQ2074.2 +001400* WRITE STATEMENTS CONTROL THE VERTICAL POSITIONING OF EACH SQ2074.2 +001500* LINE ON A PRINTED PAGE. SQ207M TESTS ALL POSSIBLE LEVEL 2 SQ2074.2 +001600* COMBINATIONS OF THE FROM AND ADVANCING PHRASES USING MNEMONICSQ2074.2 +001700* NAME. IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE SQ2074.2 +001800* AVAILABLE IN TESTING SQ207M. THE VARIABLES IN THE TESTS ARE SQ2074.2 +001900* IDENTIFIER-1 AND MNEMONIC-NAME. HOWEVER, BECAUSE ONLY ONE SQ2074.2 +002000* MNEMONIC-NAME IS DEFINED IN THE SPECIAL-NAMES PARAGRAPH, SQ2074.2 +002100* SEPARATE RUNS MUST BE MADE FOR EACH MNEMONIC-NAME TESTED. SQ2074.2 +002200* IDENTIFIER-1 IS A 77, 01, OR SUBGROUP IDENTIFIER IN THE SQ2074.2 +002300* WORKING-STORAGE SECTION. THIS TEST MAY BE DELETED IF NO SQ2074.2 +002400* MNEMONIC-NAMES EXIST FOR THE SYSTEM BEING VALIDATED. SQ2074.2 +002500* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2074.2 +002600* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2074.2 +002700* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2074.2 +002800* ACCURACY OF THE VARIOUS WRITE OPTIONS. SQ2074.2 +002900 ENVIRONMENT DIVISION. SQ2074.2 +003000 CONFIGURATION SECTION. SQ2074.2 +003100 SOURCE-COMPUTER. SQ2074.2 +003200 XXXXX082. SQ2074.2 +003300 OBJECT-COMPUTER. SQ2074.2 +003400 XXXXX083. SQ2074.2 +003500 SPECIAL-NAMES. SQ2074.2 +003600 XXXXX073 SQ2074.2 +003700 IS MNEMONIC-NAME. SQ2074.2 +003800 INPUT-OUTPUT SECTION. SQ2074.2 +003900 FILE-CONTROL. SQ2074.2 +004000P SELECT RAW-DATA ASSIGN TO SQ2074.2 +004100P XXXXX062 SQ2074.2 +004200P ORGANIZATION IS INDEXED SQ2074.2 +004300P ACCESS MODE IS RANDOM SQ2074.2 +004400P RECORD KEY IS RAW-DATA-KEY. SQ2074.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2074.2 +004600 XXXXX055. SQ2074.2 +004700 DATA DIVISION. SQ2074.2 +004800 FILE SECTION. SQ2074.2 +004900P SQ2074.2 +005000PFD RAW-DATA. SQ2074.2 +005100P SQ2074.2 +005200P01 RAW-DATA-SATZ. SQ2074.2 +005300P 05 RAW-DATA-KEY PIC X(6). SQ2074.2 +005400P 05 C-DATE PIC 9(6). SQ2074.2 +005500P 05 C-TIME PIC 9(8). SQ2074.2 +005600P 05 C-NO-OF-TESTS PIC 99. SQ2074.2 +005700P 05 C-OK PIC 999. SQ2074.2 +005800P 05 C-ALL PIC 999. SQ2074.2 +005900P 05 C-FAIL PIC 999. SQ2074.2 +006000P 05 C-DELETED PIC 999. SQ2074.2 +006100P 05 C-INSPECT PIC 999. SQ2074.2 +006200P 05 C-NOTE PIC X(13). SQ2074.2 +006300P 05 C-INDENT PIC X. SQ2074.2 +006400P 05 C-ABORT PIC X(8). SQ2074.2 +006500 FD PRINT-FILE SQ2074.2 +006600C LABEL RECORDS SQ2074.2 +006700C XXXXX084 SQ2074.2 +006800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2074.2 +006900 . SQ2074.2 +007000 01 PRINT-REC PICTURE X(120). SQ2074.2 +007100 01 DUMMY-RECORD PICTURE X(120). SQ2074.2 +007200 WORKING-STORAGE SECTION. SQ2074.2 +007300 77 BEFORE-MSG-1 PIC X(120) VALUE " THIS LINE SQ2074.2 +007400- "IS PRINTED BEFORE ADVANCING THE MNEMONIC-NAME SPACING. IT SSQ2074.2 +007500- "HOULD BE 1 LINE BELOW THE WRT-TEST LINE.". SQ2074.2 +007600 01 BEFORE-MSG-2 PIC X(120) VALUE " THIS LINE SQ2074.2 +007700- "IS PRINTED BEFORE ADVANCING THE MNEMONIC-NAME SPACING. IT SSQ2074.2 +007800- "HOULD BE 1 LINE BELOW THE WRT-TEST LINE.". SQ2074.2 +007900 01 BEFORE-MSG-3 PIC X(120) VALUE " THIS LINE SQ2074.2 +008000- "SHOULD BE WRITTEN ON THE LINE POSITIONED TO BY THE WRITE MNESQ2074.2 +008100- "MONIC-NAME OPTION BEING TESTED.". SQ2074.2 +008200 01 LEVEL-ONE. SQ2074.2 +008300 02 LEVEL-TWO. SQ2074.2 +008400 03 AFTER-MSG-1. SQ2074.2 +008500 04 FILLER PIC X(10) VALUE SPACES. SQ2074.2 +008600 04 FILLER PIC X(110) VALUE "THIS LINE IS PRINTED ASQ2074.2 +008700- "FTER ADVANCING THE MNEMONIC-NAME SPACING. IT SHOULSQ2074.2 +008800- "D BE WRITTEN ON THE LINE POSITIONED". SQ2074.2 +008900 03 AFTER-MSG-2. SQ2074.2 +009000 04 FILLER PIC X(10) VALUE SPACE. SQ2074.2 +009100 04 FILLER PIC X(110) VALUE "TO BY THE WRITE MNEMONSQ2074.2 +009200- "IC-NAME OPTION BEING TESTED.". SQ2074.2 +009300 01 NOTE-1. SQ2074.2 +009400 02 FILLER PIC X(40) VALUE "BECAUSE OF THE NATURE SQ2074.2 +009500- "OF THESE TESTS A ". SQ2074.2 +009600 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +009700 02 FILLER PIC X(4) VALUE "PASS". SQ2074.2 +009800 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +009900 02 FILLER PIC X(4) VALUE " OR ". SQ2074.2 +010000 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". SQ2074.2 +010200 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +010300 02 FILLER PIC X(64) VALUE " CANNOT BE DETERMINED SQ2074.2 +010400- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ2074.2 +010500 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2074.2 +010600- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2074.2 +010700- "IONS. VII-52 4.7.3 (3, 6, 7, 8, 9)". SQ2074.2 +010800 01 TEST-RESULTS. SQ2074.2 +010900 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2074.2 +011100 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2074.2 +011300 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011400 02 PAR-NAME. SQ2074.2 +011500 03 FILLER PICTURE X(12) VALUE SPACE. SQ2074.2 +011600 03 PARDOT-X PICTURE X VALUE SPACE. SQ2074.2 +011700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2074.2 +011800 03 FILLER PIC X(5) VALUE SPACE. SQ2074.2 +011900 02 FILLER PIC X(10) VALUE SPACE. SQ2074.2 +012000 02 RE-MARK PIC X(61). SQ2074.2 +012100 01 TEST-COMPUTED. SQ2074.2 +012200 02 FILLER PIC X(30) VALUE SPACE. SQ2074.2 +012300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2074.2 +012400 02 COMPUTED-X. SQ2074.2 +012500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2074.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2074.2 +012700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2074.2 +012800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2074.2 +012900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2074.2 +013000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2074.2 +013100 04 COMPUTED-18V0 PICTURE -9(18). SQ2074.2 +013200 04 FILLER PICTURE X. SQ2074.2 +013300 03 FILLER PIC X(50) VALUE SPACE. SQ2074.2 +013400 01 TEST-CORRECT. SQ2074.2 +013500 02 FILLER PIC X(30) VALUE SPACE. SQ2074.2 +013600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2074.2 +013700 02 CORRECT-X. SQ2074.2 +013800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2074.2 +013900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2074.2 +014000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2074.2 +014100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2074.2 +014200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2074.2 +014300 03 CR-18V0 REDEFINES CORRECT-A. SQ2074.2 +014400 04 CORRECT-18V0 PICTURE -9(18). SQ2074.2 +014500 04 FILLER PICTURE X. SQ2074.2 +014600 03 FILLER PIC X(50) VALUE SPACE. SQ2074.2 +014700 01 CCVS-C-1. SQ2074.2 +014800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2074.2 +014900- "SS PARAGRAPH-NAME SQ2074.2 +015000- " REMARKS". SQ2074.2 +015100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2074.2 +015200 01 CCVS-C-2. SQ2074.2 +015300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +015400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2074.2 +015500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2074.2 +015600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2074.2 +015700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2074.2 +015800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2074.2 +015900 01 REC-CT PICTURE 99 VALUE ZERO. SQ2074.2 +016000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2074.2 +016100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2074.2 +016200 01 INSPECT-COUNTER PIC 999 VALUE 8. SQ2074.2 +016300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2074.2 +016400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2074.2 +016500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2074.2 +016600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2074.2 +016700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2074.2 +016800 01 CCVS-H-1. SQ2074.2 +016900 02 FILLER PICTURE X(27) VALUE SPACE. SQ2074.2 +017000 02 FILLER PICTURE X(67) VALUE SQ2074.2 +017100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2074.2 +017200- " SYSTEM". SQ2074.2 +017300 02 FILLER PICTURE X(26) VALUE SPACE. SQ2074.2 +017400 01 CCVS-H-2. SQ2074.2 +017500 02 FILLER PICTURE X(52) VALUE IS SQ2074.2 +017600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2074.2 +017700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2074.2 +017800 02 TEST-ID PICTURE IS X(9). SQ2074.2 +017900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2074.2 +018000 01 CCVS-H-3. SQ2074.2 +018100 02 FILLER PICTURE X(34) VALUE SQ2074.2 +018200 " FOR OFFICIAL USE ONLY ". SQ2074.2 +018300 02 FILLER PICTURE X(58) VALUE SQ2074.2 +018400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2074.2 +018500 02 FILLER PICTURE X(28) VALUE SQ2074.2 +018600 " COPYRIGHT 1985 ". SQ2074.2 +018700 01 CCVS-E-1. SQ2074.2 +018800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2074.2 +018900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2074.2 +019000 02 ID-AGAIN PICTURE IS X(9). SQ2074.2 +019100 02 FILLER PICTURE X(45) VALUE IS SQ2074.2 +019200 " NTIS DISTRIBUTION COBOL 85". SQ2074.2 +019300 01 CCVS-E-2. SQ2074.2 +019400 02 FILLER PICTURE X(31) VALUE SQ2074.2 +019500 SPACE. SQ2074.2 +019600 02 FILLER PICTURE X(21) VALUE SPACE. SQ2074.2 +019700 02 CCVS-E-2-2. SQ2074.2 +019800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2074.2 +019900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +020000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2074.2 +020100 01 CCVS-E-3. SQ2074.2 +020200 02 FILLER PICTURE X(22) VALUE SQ2074.2 +020300 " FOR OFFICIAL USE ONLY". SQ2074.2 +020400 02 FILLER PICTURE X(12) VALUE SPACE. SQ2074.2 +020500 02 FILLER PICTURE X(58) VALUE SQ2074.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2074.2 +020700 02 FILLER PICTURE X(13) VALUE SPACE. SQ2074.2 +020800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2074.2 +020900 01 CCVS-E-4. SQ2074.2 +021000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2074.2 +021100 02 FILLER PIC XXXX VALUE " OF ". SQ2074.2 +021200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2074.2 +021300 02 FILLER PIC X(40) VALUE SQ2074.2 +021400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2074.2 +021500 01 XXINFO. SQ2074.2 +021600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2074.2 +021700 02 INFO-TEXT. SQ2074.2 +021800 04 FILLER PIC X(20) VALUE SPACE. SQ2074.2 +021900 04 XXCOMPUTED PIC X(20). SQ2074.2 +022000 04 FILLER PIC X(5) VALUE SPACE. SQ2074.2 +022100 04 XXCORRECT PIC X(20). SQ2074.2 +022200 01 HYPHEN-LINE. SQ2074.2 +022300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +022400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2074.2 +022500- "*****************************************". SQ2074.2 +022600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2074.2 +022700- "******************************". SQ2074.2 +022800 01 CCVS-PGM-ID PIC X(6) VALUE SQ2074.2 +022900 "SQ207M". SQ2074.2 +023000 PROCEDURE DIVISION. SQ2074.2 +023100 CCVS1 SECTION. SQ2074.2 +023200 OPEN-FILES. SQ2074.2 +023300P OPEN I-O RAW-DATA. SQ2074.2 +023400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2074.2 +023500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2074.2 +023600P MOVE "ABORTED " TO C-ABORT. SQ2074.2 +023700P ADD 1 TO C-NO-OF-TESTS. SQ2074.2 +023800P ACCEPT C-DATE FROM DATE. SQ2074.2 +023900P ACCEPT C-TIME FROM TIME. SQ2074.2 +024000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2074.2 +024100PEND-E-1. SQ2074.2 +024200P CLOSE RAW-DATA. SQ2074.2 +024300 OPEN OUTPUT PRINT-FILE. SQ2074.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2074.2 +024500 MOVE SPACE TO TEST-RESULTS. SQ2074.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2074.2 +024700 GO TO CCVS1-EXIT. SQ2074.2 +024800 CLOSE-FILES. SQ2074.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2074.2 +025000P OPEN I-O RAW-DATA. SQ2074.2 +025100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2074.2 +025200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2074.2 +025300P MOVE "OK. " TO C-ABORT. SQ2074.2 +025400P MOVE PASS-COUNTER TO C-OK. SQ2074.2 +025500P MOVE ERROR-HOLD TO C-ALL. SQ2074.2 +025600P MOVE ERROR-COUNTER TO C-FAIL. SQ2074.2 +025700P MOVE DELETE-CNT TO C-DELETED. SQ2074.2 +025800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2074.2 +025900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2074.2 +026000PEND-E-2. SQ2074.2 +026100P CLOSE RAW-DATA. SQ2074.2 +026200 TERMINATE-CCVS. SQ2074.2 +026300S EXIT PROGRAM. SQ2074.2 +026400STERMINATE-CALL. SQ2074.2 +026500 STOP RUN. SQ2074.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2074.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2074.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2074.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2074.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2074.2 +027100 PRINT-DETAIL. SQ2074.2 +027200 IF REC-CT NOT EQUAL TO ZERO SQ2074.2 +027300 MOVE "." TO PARDOT-X SQ2074.2 +027400 MOVE REC-CT TO DOTVALUE. SQ2074.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2074.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2074.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2074.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2074.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2074.2 +028000 MOVE SPACE TO CORRECT-X. SQ2074.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2074.2 +028200 MOVE SPACE TO RE-MARK. SQ2074.2 +028300 HEAD-ROUTINE. SQ2074.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +028500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2074.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2074.2 +028700 COLUMN-NAMES-ROUTINE. SQ2074.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +029100 END-ROUTINE. SQ2074.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2074.2 +029300 END-RTN-EXIT. SQ2074.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +029500 END-ROUTINE-1. SQ2074.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2074.2 +029700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2074.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2074.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2074.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2074.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2074.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2074.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2074.2 +030400 END-ROUTINE-12. SQ2074.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2074.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2074.2 +030700 MOVE "NO " TO ERROR-TOTAL SQ2074.2 +030800 ELSE SQ2074.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2074.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2074.2 +031100 PERFORM WRITE-LINE. SQ2074.2 +031200 END-ROUTINE-13. SQ2074.2 +031300 IF DELETE-CNT IS EQUAL TO ZERO SQ2074.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2074.2 +031500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2074.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2074.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2074.2 +031900 MOVE "NO " TO ERROR-TOTAL SQ2074.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2074.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2074.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +032400 WRITE-LINE. SQ2074.2 +032500 ADD 1 TO RECORD-COUNT. SQ2074.2 +032600Y IF RECORD-COUNT GREATER 50 SQ2074.2 +032700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2074.2 +032800Y MOVE SPACE TO DUMMY-RECORD SQ2074.2 +032900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2074.2 +033000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2074.2 +033100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2074.2 +033200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2074.2 +033300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2074.2 +033400Y MOVE ZERO TO RECORD-COUNT. SQ2074.2 +033500 PERFORM WRT-LN. SQ2074.2 +033600 WRT-LN. SQ2074.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2074.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2074.2 +033900 BLANK-LINE-PRINT. SQ2074.2 +034000 PERFORM WRT-LN. SQ2074.2 +034100 FAIL-ROUTINE. SQ2074.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2074.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2074.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2074.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +034600 GO TO FAIL-ROUTINE-EX. SQ2074.2 +034700 FAIL-ROUTINE-WRITE. SQ2074.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2074.2 +034900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +035000 FAIL-ROUTINE-EX. EXIT. SQ2074.2 +035100 BAIL-OUT. SQ2074.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2074.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2074.2 +035400 BAIL-OUT-WRITE. SQ2074.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2074.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +035700 BAIL-OUT-EX. EXIT. SQ2074.2 +035800 CCVS1-EXIT. SQ2074.2 +035900 EXIT. SQ2074.2 +036000 SECT-SQ207M-0001 SECTION. SQ2074.2 +036100 WRITE-INIT-GF-01. SQ2074.2 +036200 MOVE NOTE-1 TO PRINT-REC. SQ2074.2 +036300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +036400 MOVE NOTE-2 TO PRINT-REC. SQ2074.2 +036500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +036600 MOVE SPACE TO DUMMY-RECORD. SQ2074.2 +036700 PERFORM BLANK-LINE-PRINT. SQ2074.2 +036800 WRITE-TEST-GF-01. SQ2074.2 +036900 MOVE "WRT FRM BFR ADV MNC" TO FEATURE. SQ2074.2 +037000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2074.2 +037100 MOVE "FROM 77 LEVEL" TO RE-MARK. SQ2074.2 +037200 PERFORM WRITE-TEST-LINE. SQ2074.2 +037300 WRITE PRINT-REC FROM BEFORE-MSG-1 BEFORE ADVANCING SQ2074.2 +037400 MNEMONIC-NAME. SQ2074.2 +037500 WRITE PRINT-REC FROM BEFORE-MSG-3 BEFORE ADVANCING 0 LINE. SQ2074.2 +037600 WRITE-TEST-GF-02. SQ2074.2 +037700 MOVE "WRT FRM BFR MNC" TO FEATURE. SQ2074.2 +037800 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2074.2 +037900 MOVE "FROM 01 LEVEL" TO RE-MARK. SQ2074.2 +038000 PERFORM WRITE-TEST-LINE. SQ2074.2 +038100 WRITE PRINT-REC FROM BEFORE-MSG-2 BEFORE MNEMONIC-NAME. SQ2074.2 +038200 WRITE PRINT-REC FROM BEFORE-MSG-3 BEFORE ADVANCING 0 LINE. SQ2074.2 +038300 WRITE-TEST-GF-03. SQ2074.2 +038400 MOVE "WRT FRM AFT ADV MNC" TO FEATURE. SQ2074.2 +038500 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2074.2 +038600 MOVE "FROM 03 LEVEL" TO RE-MARK. SQ2074.2 +038700 PERFORM WRITE-TEST-LINE. SQ2074.2 +038800 WRITE PRINT-REC FROM AFTER-MSG-1 AFTER ADVANCING SQ2074.2 +038900 MNEMONIC-NAME. SQ2074.2 +039000 WRITE PRINT-REC FROM AFTER-MSG-2 AFTER ADVANCING 1 LINE. SQ2074.2 +039100 WRITE-TEST-GF-04. SQ2074.2 +039200 MOVE "WRT FRM AFT MNC" TO FEATURE. SQ2074.2 +039300 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. SQ2074.2 +039400 PERFORM WRITE-TEST-LINE. SQ2074.2 +039500 WRITE PRINT-REC FROM AFTER-MSG-1 AFTER MNEMONIC-NAME. SQ2074.2 +039600 WRITE PRINT-REC FROM AFTER-MSG-2 AFTER ADVANCING 1 LINE. SQ2074.2 +039700 WRITE-TEST-GF-05. SQ2074.2 +039800 MOVE "WRT BFR ADV MNC" TO FEATURE. SQ2074.2 +039900 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. SQ2074.2 +040000 PERFORM WRITE-TEST-LINE. SQ2074.2 +040100 MOVE BEFORE-MSG-1 TO PRINT-REC. SQ2074.2 +040200 WRITE PRINT-REC BEFORE ADVANCING MNEMONIC-NAME. SQ2074.2 +040300 MOVE BEFORE-MSG-3 TO PRINT-REC. SQ2074.2 +040400 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ2074.2 +040500 WRITE-TEST-GF-06. SQ2074.2 +040600 MOVE "WRT BFR MNC" TO FEATURE. SQ2074.2 +040700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. SQ2074.2 +040800 PERFORM WRITE-TEST-LINE. SQ2074.2 +040900 MOVE BEFORE-MSG-2 TO PRINT-REC. SQ2074.2 +041000 WRITE PRINT-REC BEFORE MNEMONIC-NAME. SQ2074.2 +041100 MOVE BEFORE-MSG-3 TO PRINT-REC. SQ2074.2 +041200 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ2074.2 +041300 WRITE-TEST-GF-07. SQ2074.2 +041400 MOVE "WRT AFT ADV MNC" TO FEATURE. SQ2074.2 +041500 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. SQ2074.2 +041600 MOVE "RECORD-NAME IS QUALIFIED (IN)" TO RE-MARK. SQ2074.2 +041700 PERFORM WRITE-TEST-LINE. SQ2074.2 +041800 MOVE AFTER-MSG-1 TO PRINT-REC. SQ2074.2 +041900 WRITE PRINT-REC IN PRINT-FILE AFTER ADVANCING MNEMONIC-NAME. SQ2074.2 +042000 MOVE AFTER-MSG-2 TO PRINT-REC. SQ2074.2 +042100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +042200 WRITE-TEST-GF-08. SQ2074.2 +042300 MOVE "WRT AFT MNC" TO FEATURE. SQ2074.2 +042400 MOVE "WRITE-TEST-GF-08" TO PAR-NAME. SQ2074.2 +042500 MOVE "RECORD-NAME IS QUALIFIED (OF)" TO RE-MARK. SQ2074.2 +042600 PERFORM WRITE-TEST-LINE. SQ2074.2 +042700 MOVE AFTER-MSG-1 TO PRINT-REC. SQ2074.2 +042800 WRITE PRINT-REC OF PRINT-FILE AFTER MNEMONIC-NAME. SQ2074.2 +042900 MOVE AFTER-MSG-2 TO PRINT-REC. SQ2074.2 +043000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +043100 SQ207M-END-ROUTINE. SQ2074.2 +043200 MOVE "END OF SQ207M VALIDATION TESTS" TO PRINT-REC. SQ2074.2 +043300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +043400 GO TO CCVS-EXIT. SQ2074.2 +043500 WRITE-TEST-LINE. SQ2074.2 +043600 PERFORM PRINT-DETAIL. SQ2074.2 +043700 PERFORM BLANK-LINE-PRINT. SQ2074.2 +043800 CCVS-EXIT SECTION. SQ2074.2 +043900 CCVS-999999. SQ2074.2 +044000 GO TO CLOSE-FILES. SQ2074.2 +*END-OF,SQ207M +*HEADER,COBOL,SQ208M +000100 IDENTIFICATION DIVISION. SQ2084.2 +000200 PROGRAM-ID. SQ2084.2 +000300 SQ208M. SQ2084.2 +000400**************************************************************** SQ2084.2 +000500* * SQ2084.2 +000600* VALIDATION FOR:- * SQ2084.2 +000700* " HIGH ". SQ2084.2 +000800* * SQ2084.2 +000900* CREATION DATE / VALIDATION DATE * SQ2084.2 +001000* "4.2 ". SQ2084.2 +001100* * SQ2084.2 +001200* THE ROUTINE SQ208M TESTS THE USE OF THE LEVEL 2 WRITE SQ2084.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2084.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2084.2 +001500* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2084.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A LOGICALSQ2084.2 +001700* PRINT PAGE. SQ208M TESTS THE USE OF DATA-NAMES IN THE LINAGE,SQ2084.2 +001800* FOOTING, TOP, AND BOTTOM PHRASES. VALUES OF DATA-NAMES ARE SQ2084.2 +001900* CHANGED IN ORDER TO CHECK REDEFINITION OF LOGICAL PAGE SQ2084.2 +002000* FORMATS AFTER OVERFLOW OR WRITE ADVANCING PAGE OPERATIONS. SQ2084.2 +002100* IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE SQ2084.2 +002200* IN TESTING SQ208M. SQ2084.2 +002300* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2084.2 +002400* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2084.2 +002500* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2084.2 +002600* ACCURACY OF THE VARIOUS WRITE AND LINAGE OPTIONS. SQ2084.2 +002700 ENVIRONMENT DIVISION. SQ2084.2 +002800 CONFIGURATION SECTION. SQ2084.2 +002900 SOURCE-COMPUTER. SQ2084.2 +003000 XXXXX082. SQ2084.2 +003100 OBJECT-COMPUTER. SQ2084.2 +003200 XXXXX083. SQ2084.2 +003300 INPUT-OUTPUT SECTION. SQ2084.2 +003400 FILE-CONTROL. SQ2084.2 +003500P SELECT RAW-DATA ASSIGN TO SQ2084.2 +003600P XXXXX062 SQ2084.2 +003700P ORGANIZATION IS INDEXED SQ2084.2 +003800P ACCESS MODE IS RANDOM SQ2084.2 +003900P RECORD KEY IS RAW-DATA-KEY. SQ2084.2 +004000 SELECT PRINT-FILE ASSIGN TO SQ2084.2 +004100 XXXXX055. SQ2084.2 +004200 DATA DIVISION. SQ2084.2 +004300 FILE SECTION. SQ2084.2 +004400P SQ2084.2 +004500PFD RAW-DATA. SQ2084.2 +004600P SQ2084.2 +004700P01 RAW-DATA-SATZ. SQ2084.2 +004800P 05 RAW-DATA-KEY PIC X(6). SQ2084.2 +004900P 05 C-DATE PIC 9(6). SQ2084.2 +005000P 05 C-TIME PIC 9(8). SQ2084.2 +005100P 05 C-NO-OF-TESTS PIC 99. SQ2084.2 +005200P 05 C-OK PIC 999. SQ2084.2 +005300P 05 C-ALL PIC 999. SQ2084.2 +005400P 05 C-FAIL PIC 999. SQ2084.2 +005500P 05 C-DELETED PIC 999. SQ2084.2 +005600P 05 C-INSPECT PIC 999. SQ2084.2 +005700P 05 C-NOTE PIC X(13). SQ2084.2 +005800P 05 C-INDENT PIC X. SQ2084.2 +005900P 05 C-ABORT PIC X(8). SQ2084.2 +006000 FD PRINT-FILE SQ2084.2 +006100C LABEL RECORDS SQ2084.2 +006200C XXXXX084 SQ2084.2 +006300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2084.2 +006400 LINAGE LINAGE-CTR SQ2084.2 +006500 FOOTING FOOT-CTR SQ2084.2 +006600 TOP TOP-CTR SQ2084.2 +006700 BOTTOM BOTTOM-CTR. SQ2084.2 +006800 01 PRINT-REC PICTURE X(120). SQ2084.2 +006900 01 DUMMY-RECORD PICTURE X(120). SQ2084.2 +007000 WORKING-STORAGE SECTION. SQ2084.2 +007100 77 LINAGE-CTR PIC 999 VALUE 66. SQ2084.2 +007200 01 FOOT-CTR PIC 999 VALUE 66. SQ2084.2 +007300 01 SPACING-CTR. SQ2084.2 +007400 02 TOP-CTR PIC 999 VALUE 0. SQ2084.2 +007500 02 BOTTOM-CTR PIC 999 VALUE 0. SQ2084.2 +007600 01 DETAIL-LINE-1. SQ2084.2 +007700 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +007800 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +007900 02 DL1-LINE-NO PIC 999. SQ2084.2 +008000 02 FILLER PIC X(4) VALUE " OF ". SQ2084.2 +008100 02 DL1-TOTAL-LINES PIC 999. SQ2084.2 +008200 02 FILLER PIC X(34) VALUE " DETAIL LINES. LINAGESQ2084.2 +008300- "-COUNTER IS ". SQ2084.2 +008400 02 DL1-LC PIC 999. SQ2084.2 +008500 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +008600 01 DETAIL-LINE-2. SQ2084.2 +008700 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +008800 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +008900 02 DL2-LINE-NO PIC 999. SQ2084.2 +009000 02 FILLER PIC X(41) VALUE " OF 010 DETAIL LINES. SQ2084.2 +009100- " LINAGE-COUNTER IS ". SQ2084.2 +009200 02 DL2-LC PIC 999. SQ2084.2 +009300 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +009400 01 DETAIL-LINE-3. SQ2084.2 +009500 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +009600 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +009700 02 DL3-LINE-NO PIC 99. SQ2084.2 +009800 02 FILLER PIC X(40) VALUE " OF 60 DETAIL LINES. SQ2084.2 +009900- "LINAGE-COUNTER IS ". SQ2084.2 +010000 02 DL3-LC PIC 999. SQ2084.2 +010100 02 FILLER PIC X(42) VALUE ".". SQ2084.2 +010200 01 FOOT-LINE-1. SQ2084.2 +010300 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +010400 02 FILLER PIC X(57) VALUE "THIS IS LINE 001 OF 00SQ2084.2 +010500- "1 FOOTING LINES. LINAGE-COUNTER IS ". SQ2084.2 +010600 02 FL1-LC PIC 999. SQ2084.2 +010700 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +010800 01 FOOT-LINE-3. SQ2084.2 +010900 02 FILLER PIC X(103) VALUE "THIS LINE WAS PRINTED SQ2084.2 +011000- "FROM AN EOP CLAUSE. THE VALUE OF THE LINAGE-COUNTER PRIOR TSQ2084.2 +011100- "O THIS EXECUTION IS ". SQ2084.2 +011200 02 FL3-LC PIC 999. SQ2084.2 +011300 02 FILLER PIC X(14) VALUE ".". SQ2084.2 +011400 01 INFO-LINE-1 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +011500- "TO TEST THE OVERFLOW RESULTS OF A WRITE BEFORE ADVANCING OPESQ2084.2 +011600- "RATION CONTAINING AN EOP PHRASE.". SQ2084.2 +011700 01 INFO-LINE-2 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +011800- "TO TEST THE OVERFLOW RESULTS OF A WRITE AFTER ADVANCING OPERSQ2084.2 +011900- "ATION CONTAINING AN EOP PHRASE.". SQ2084.2 +012000 01 INFO-LINE-3 PIC X(120) VALUE "FOR THIS TEST LINAGE ASQ2084.2 +012100- "ND FOOTING VALUES ARE 40.". SQ2084.2 +012200 01 INFO-LINE-4 PIC X(120) VALUE "39 DETAIL LINES SHOULDSQ2084.2 +012300- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 21 DETAIL LSQ2084.2 +012400- "INES ON THE 2ND LOGICAL PAGE.". SQ2084.2 +012500 01 INFO-LINE-6 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2084.2 +012600- "LLOW DETAIL LINE 39 AND BE THE LAST LINE ON THE 1ST LOGICAL SQ2084.2 +012700- "PAGE.". SQ2084.2 +012800 01 INFO-LINE-7 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2084.2 +012900- "LLOW DETAIL LINE 39 AND BE THE FIRST LINE ON THE 2ND LOGICALSQ2084.2 +013000- " PAGE.". SQ2084.2 +013100 01 INFO-LINE-8 PIC X(120) VALUE "ALL LINAGE-COUNTER VALSQ2084.2 +013200- "UES REPRESENT VALUES PRIOR TO EXECUTION OF THE WRITE OPERATISQ2084.2 +013300- "ON. NO MODIFICATIONS HAVE BEEN MADE.". SQ2084.2 +013400 01 COMMENT-LINE-1 PIC X(120) VALUE "BECAUSE OF THE NATURE SQ2084.2 +013500- "OF THESE TESTS A PASS OR FAIL CANNOT BE DETERMINED WITHIN THSQ2084.2 +013600- "E PROGRAM. THE USER MUST VISUALLY". SQ2084.2 +013700 01 COMMENT-LINE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2084.2 +013800- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2084.2 +013900- "IONS. VII-22, 3.2.2 LINAGE, VII-27-29". SQ2084.2 +014000 01 COMMENT-LINE-3 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +014100- " LOGICAL PAGE SHOULD CONTAIN 65 DETAIL LINES.". SQ2084.2 +014200 01 COMMENT-LINE-4 PIC X(120) VALUE "1 FOOTING LINE AND BE SQ2084.2 +014300- "FOLLOWED BY 1 BLANK LINE. ALL SUCCEEDING LOGICAL PAGES SHOUSQ2084.2 +014400- "LD CONTAIN 29 DETAIL LINES, 1 FOOTING". SQ2084.2 +014500 01 COMMENT-LINE-5 PIC X(120) VALUE "LINE AND BE SEPARATED SQ2084.2 +014600- "BY 3 BLANK LINES". SQ2084.2 +014700 01 COMMENT-LINE-6 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +014800- " LOGICAL PAGE SHOULD CONTAIN 19 DETAIL LINES, 1 FOOTING LINESQ2084.2 +014900- ", BE PRECEDED BY 2 BLANK LINES, AND". SQ2084.2 +015000 01 COMMENT-LINE-7 PIC X(120) VALUE "BE FOLLOWED BY 4 BLANKSQ2084.2 +015100- " LINES. ALL SUCCEEDING LOGICAL PAGES SHOULD CONTAIN 39 DETASQ2084.2 +015200- "IL LINES, 1 FOOTING LINE, AND BE". SQ2084.2 +015300 01 COMMENT-LINE-8 PIC X(120) VALUE "SEPARATED BY 3 BLANK LSQ2084.2 +015400- "INES.". SQ2084.2 +015500 01 COMMENT-LINE-9 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +015600- " LOGICAL PAGE SHOULD CONTAIN 15 DETAIL LINES, BE PRECEDED BYSQ2084.2 +015700- " 2 BLANK LINES, AND BE FOLLOWED BY". SQ2084.2 +015800 01 COMMENT-LINE-10 PIC X(120) VALUE "9 BLANK LINES. ALL SUSQ2084.2 +015900- "CCEEDING LOGICAL PAGES SHOULD CONTAIN 40 DETAIL LINES AND BESQ2084.2 +016000- " SEPARATED BY 3 BLANK LINES.". SQ2084.2 +016100 01 COMMENT-LINE-11 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +016200- "TO TEST THE MINIMUM LINAGE VALUE OF 1 AND THE MINIMUM TOP VASQ2084.2 +016300- "LUE OF ZERO. EACH LOGICAL PAGE SHOULD". SQ2084.2 +016400 01 COMMENT-LINE-12 PIC X(120) VALUE "CONTAIN 1 DETAIL LINE SQ2084.2 +016500- "AND BE SEPARATED BY 2 BLANK LINES. THE FIRST PAGE SHOULD NOSQ2084.2 +016600- "T BE PRECEDED BY ANY BLANK LINES.". SQ2084.2 +016700 01 COMMENT-LINE-13 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +016800- "TO TEST THE MINIMUM FOOTING LINE VALUE OF 1 AND MINIMUM BOTTSQ2084.2 +016900- "OM VALUE OF ZERO. EACH LOGICAL PAGE". SQ2084.2 +017000 01 COMMENT-LINE-14 PIC X(120) VALUE "SHOULD CONTAIN 1 DETAISQ2084.2 +017100- "L LINE, 1 FOOTING LINE, AND BE SEPARATED BY 1 BLANK LINE.". SQ2084.2 +017200 01 LAST-LINE PIC X(120) VALUE "THIS IS THE LAST LINE SQ2084.2 +017300- "IN THE PAGE BODY OF THIS LOGICAL PAGE. USE IT AS A REFERENCSQ2084.2 +017400- "E POINT FOR THE FOLLOWING TEST PAGES.". SQ2084.2 +017500 01 TEST-RESULTS. SQ2084.2 +017600 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +017700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2084.2 +017800 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +017900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2084.2 +018000 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +018100 02 PAR-NAME. SQ2084.2 +018200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2084.2 +018300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2084.2 +018400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2084.2 +018500 03 FILLER PIC X(5) VALUE SPACE. SQ2084.2 +018600 02 FILLER PIC X(10) VALUE SPACE. SQ2084.2 +018700 02 RE-MARK PIC X(61). SQ2084.2 +018800 01 TEST-COMPUTED. SQ2084.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ2084.2 +019000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2084.2 +019100 02 COMPUTED-X. SQ2084.2 +019200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2084.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2084.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2084.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2084.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2084.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2084.2 +019800 04 COMPUTED-18V0 PICTURE -9(18). SQ2084.2 +019900 04 FILLER PICTURE X. SQ2084.2 +020000 03 FILLER PIC X(50) VALUE SPACE. SQ2084.2 +020100 01 TEST-CORRECT. SQ2084.2 +020200 02 FILLER PIC X(30) VALUE SPACE. SQ2084.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2084.2 +020400 02 CORRECT-X. SQ2084.2 +020500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2084.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2084.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2084.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2084.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2084.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. SQ2084.2 +021100 04 CORRECT-18V0 PICTURE -9(18). SQ2084.2 +021200 04 FILLER PICTURE X. SQ2084.2 +021300 03 FILLER PIC X(50) VALUE SPACE. SQ2084.2 +021400 01 CCVS-C-1. SQ2084.2 +021500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2084.2 +021600- "SS PARAGRAPH-NAME SQ2084.2 +021700- " REMARKS". SQ2084.2 +021800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2084.2 +021900 01 CCVS-C-2. SQ2084.2 +022000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +022100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2084.2 +022200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2084.2 +022300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2084.2 +022400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2084.2 +022500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2084.2 +022600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2084.2 +022700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2084.2 +022800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2084.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE 7. SQ2084.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2084.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2084.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2084.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2084.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2084.2 +023500 01 CCVS-H-1. SQ2084.2 +023600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2084.2 +023700 02 FILLER PICTURE X(67) VALUE SQ2084.2 +023800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2084.2 +023900- " SYSTEM". SQ2084.2 +024000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2084.2 +024100 01 CCVS-H-2. SQ2084.2 +024200 02 FILLER PICTURE X(52) VALUE IS SQ2084.2 +024300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2084.2 +024400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2084.2 +024500 02 TEST-ID PICTURE IS X(9). SQ2084.2 +024600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2084.2 +024700 01 CCVS-H-3. SQ2084.2 +024800 02 FILLER PICTURE X(34) VALUE SQ2084.2 +024900 " FOR OFFICIAL USE ONLY ". SQ2084.2 +025000 02 FILLER PICTURE X(58) VALUE SQ2084.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2084.2 +025200 02 FILLER PICTURE X(28) VALUE SQ2084.2 +025300 " COPYRIGHT 1985 ". SQ2084.2 +025400 01 CCVS-E-1. SQ2084.2 +025500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2084.2 +025600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2084.2 +025700 02 ID-AGAIN PICTURE IS X(9). SQ2084.2 +025800 02 FILLER PICTURE X(45) VALUE IS SQ2084.2 +025900 " NTIS DISTRIBUTION COBOL 85". SQ2084.2 +026000 01 CCVS-E-2. SQ2084.2 +026100 02 FILLER PICTURE X(31) VALUE SQ2084.2 +026200 SPACE. SQ2084.2 +026300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2084.2 +026400 02 CCVS-E-2-2. SQ2084.2 +026500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2084.2 +026600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +026700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2084.2 +026800 01 CCVS-E-3. SQ2084.2 +026900 02 FILLER PICTURE X(22) VALUE SQ2084.2 +027000 " FOR OFFICIAL USE ONLY". SQ2084.2 +027100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2084.2 +027200 02 FILLER PICTURE X(58) VALUE SQ2084.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2084.2 +027400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2084.2 +027500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2084.2 +027600 01 CCVS-E-4. SQ2084.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2084.2 +027800 02 FILLER PIC XXXX VALUE " OF ". SQ2084.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2084.2 +028000 02 FILLER PIC X(40) VALUE SQ2084.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2084.2 +028200 01 XXINFO. SQ2084.2 +028300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2084.2 +028400 02 INFO-TEXT. SQ2084.2 +028500 04 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +028600 04 XXCOMPUTED PIC X(20). SQ2084.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ2084.2 +028800 04 XXCORRECT PIC X(20). SQ2084.2 +028900 01 HYPHEN-LINE. SQ2084.2 +029000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +029100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2084.2 +029200- "*****************************************". SQ2084.2 +029300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2084.2 +029400- "******************************". SQ2084.2 +029500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2084.2 +029600 "SQ208M". SQ2084.2 +029700 PROCEDURE DIVISION. SQ2084.2 +029800 CCVS1 SECTION. SQ2084.2 +029900 OPEN-FILES. SQ2084.2 +030000P OPEN I-O RAW-DATA. SQ2084.2 +030100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2084.2 +030200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2084.2 +030300P MOVE "ABORTED " TO C-ABORT. SQ2084.2 +030400P ADD 1 TO C-NO-OF-TESTS. SQ2084.2 +030500P ACCEPT C-DATE FROM DATE. SQ2084.2 +030600P ACCEPT C-TIME FROM TIME. SQ2084.2 +030700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2084.2 +030800PEND-E-1. SQ2084.2 +030900P CLOSE RAW-DATA. SQ2084.2 +031000 OPEN OUTPUT PRINT-FILE. SQ2084.2 +031100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2084.2 +031200 MOVE SPACE TO TEST-RESULTS. SQ2084.2 +031300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2084.2 +031400 GO TO CCVS1-EXIT. SQ2084.2 +031500 CLOSE-FILES. SQ2084.2 +031600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2084.2 +031700P OPEN I-O RAW-DATA. SQ2084.2 +031800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2084.2 +031900P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2084.2 +032000P MOVE "OK. " TO C-ABORT. SQ2084.2 +032100P MOVE PASS-COUNTER TO C-OK. SQ2084.2 +032200P MOVE ERROR-HOLD TO C-ALL. SQ2084.2 +032300P MOVE ERROR-COUNTER TO C-FAIL. SQ2084.2 +032400P MOVE DELETE-CNT TO C-DELETED. SQ2084.2 +032500P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2084.2 +032600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2084.2 +032700PEND-E-2. SQ2084.2 +032800P CLOSE RAW-DATA. SQ2084.2 +032900 TERMINATE-CCVS. SQ2084.2 +033000S EXIT PROGRAM. SQ2084.2 +033100STERMINATE-CALL. SQ2084.2 +033200 STOP RUN. SQ2084.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2084.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2084.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2084.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2084.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2084.2 +033800 PRINT-DETAIL. SQ2084.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ2084.2 +034000 MOVE "." TO PARDOT-X SQ2084.2 +034100 MOVE REC-CT TO DOTVALUE. SQ2084.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2084.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2084.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2084.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2084.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2084.2 +034700 MOVE SPACE TO CORRECT-X. SQ2084.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2084.2 +034900 MOVE SPACE TO RE-MARK. SQ2084.2 +035000 HEAD-ROUTINE. SQ2084.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +035200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2084.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2084.2 +035400 COLUMN-NAMES-ROUTINE. SQ2084.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +035800 END-ROUTINE. SQ2084.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2084.2 +036000 END-RTN-EXIT. SQ2084.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +036200 END-ROUTINE-1. SQ2084.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2084.2 +036400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2084.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2084.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2084.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2084.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2084.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2084.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2084.2 +037100 END-ROUTINE-12. SQ2084.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2084.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2084.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ2084.2 +037500 ELSE SQ2084.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2084.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2084.2 +037800 PERFORM WRITE-LINE. SQ2084.2 +037900 END-ROUTINE-13. SQ2084.2 +038000 IF DELETE-CNT IS EQUAL TO ZERO SQ2084.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE SQ2084.2 +038200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2084.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2084.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2084.2 +038600 MOVE "NO " TO ERROR-TOTAL SQ2084.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2084.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2084.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +039100 WRITE-LINE. SQ2084.2 +039200 ADD 1 TO RECORD-COUNT. SQ2084.2 +039300Y IF RECORD-COUNT GREATER 50 SQ2084.2 +039400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2084.2 +039500Y MOVE SPACE TO DUMMY-RECORD SQ2084.2 +039600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2084.2 +039700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2084.2 +039800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2084.2 +039900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2084.2 +040000Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2084.2 +040100Y MOVE ZERO TO RECORD-COUNT. SQ2084.2 +040200 PERFORM WRT-LN. SQ2084.2 +040300 WRT-LN. SQ2084.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2084.2 +040500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +040600 BLANK-LINE-PRINT. SQ2084.2 +040700 PERFORM WRT-LN. SQ2084.2 +040800 FAIL-ROUTINE. SQ2084.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2084.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2084.2 +041100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2084.2 +041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +041300 GO TO FAIL-ROUTINE-EX. SQ2084.2 +041400 FAIL-ROUTINE-WRITE. SQ2084.2 +041500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2084.2 +041600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +041700 FAIL-ROUTINE-EX. EXIT. SQ2084.2 +041800 BAIL-OUT. SQ2084.2 +041900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2084.2 +042000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2084.2 +042100 BAIL-OUT-WRITE. SQ2084.2 +042200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2084.2 +042300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +042400 BAIL-OUT-EX. EXIT. SQ2084.2 +042500 CCVS1-EXIT. SQ2084.2 +042600 EXIT. SQ2084.2 +042700 SECT-SQ208M-0001 SECTION. SQ2084.2 +042800 WRITE-INIT-GF-01. SQ2084.2 +042900 MOVE COMMENT-LINE-1 TO PRINT-REC. SQ2084.2 +043000 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +043100 MOVE COMMENT-LINE-2 TO PRINT-REC. SQ2084.2 +043200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +043300 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +043400 PERFORM BLANK-LINE-PRINT. SQ2084.2 +043500 WRITE-TEST-GF-01. SQ2084.2 +043600* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +043700* OF THE DATA-NAMES IN THE LINAGE CLAUSE AFTER AN SQ2084.2 +043800* OPEN OUTPUT PRINT-FILE. SQ2084.2 +043900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +044000 PERFORM INITIALIZE-PAGE. SQ2084.2 +044100 MOVE "LINAGE AFTER OPEN" TO FEATURE. SQ2084.2 +044200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2084.2 +044300 PERFORM PRINT-DETAIL. SQ2084.2 +044400 MOVE COMMENT-LINE-3 TO PRINT-REC. SQ2084.2 +044500 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +044600 MOVE COMMENT-LINE-4 TO PRINT-REC. SQ2084.2 +044700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +044800 MOVE COMMENT-LINE-5 TO PRINT-REC. SQ2084.2 +044900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +045000 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +045100 PERFORM PRINT-LAST-LINE. SQ2084.2 +045200 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +045300 PERFORM BLANK-LINE-PRINT. SQ2084.2 +045400 MOVE 30 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +045500 MOVE 1 TO TOP-CTR. SQ2084.2 +045600 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +045700 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +045800 MOVE 123 TO DL1-TOTAL-LINES. SQ2084.2 +045900 PERFORM PRINT-DETAIL-1 123 TIMES. SQ2084.2 +046000 WRITE-TEST-GF-02. SQ2084.2 +046100* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +046200* OF THE DATA-NAMES IN THE LINAGE CLAUSE PRIOR TO A SQ2084.2 +046300* PAGE OVERFLOW. SQ2084.2 +046400 PERFORM INITIALIZE-PAGE. SQ2084.2 +046500 MOVE "LINAGE AFT OVERFLOW" TO FEATURE. SQ2084.2 +046600 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2084.2 +046700 PERFORM PRINT-DETAIL. SQ2084.2 +046800 MOVE COMMENT-LINE-6 TO PRINT-REC. SQ2084.2 +046900 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +047000 MOVE COMMENT-LINE-7 TO PRINT-REC. SQ2084.2 +047100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +047200 MOVE COMMENT-LINE-8 TO PRINT-REC. SQ2084.2 +047300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +047400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +047500 PERFORM PRINT-LAST-LINE. SQ2084.2 +047600 MOVE 20 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +047700 MOVE 2 TO TOP-CTR. SQ2084.2 +047800 MOVE 3 TO BOTTOM-CTR. SQ2084.2 +047900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +048000 PERFORM BLANK-LINE-PRINT. SQ2084.2 +048100 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +048200 MOVE 1 TO TOP-CTR. SQ2084.2 +048300 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +048400 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +048500 MOVE 136 TO DL1-TOTAL-LINES. SQ2084.2 +048600 PERFORM PRINT-DETAIL-1 136 TIMES. SQ2084.2 +048700 WRITE-TEST-GF-03. SQ2084.2 +048800* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +048900* OF THE DATA-NAMES IN THE LINAGE-CLAUSE PRIOR TO A SQ2084.2 +049000* WRITE ADVANCING PAGE OPERATION. SQ2084.2 +049100 PERFORM INITIALIZE-PAGE. SQ2084.2 +049200 MOVE "LINAGE AFT WRT PAGE" TO FEATURE. SQ2084.2 +049300 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2084.2 +049400 PERFORM PRINT-DETAIL. SQ2084.2 +049500 MOVE COMMENT-LINE-9 TO PRINT-REC. SQ2084.2 +049600 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +049700 MOVE COMMENT-LINE-10 TO PRINT-REC. SQ2084.2 +049800 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +049900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +050000 PERFORM PRINT-LAST-LINE. SQ2084.2 +050100 MOVE 20 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +050200 MOVE 2 TO TOP-CTR. SQ2084.2 +050300 MOVE 3 TO BOTTOM-CTR. SQ2084.2 +050400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +050500 PERFORM BLANK-LINE-PRINT. SQ2084.2 +050600 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +050700 MOVE 135 TO DL1-TOTAL-LINES. SQ2084.2 +050800 PERFORM PRINT-DETAIL-2 15 TIMES. SQ2084.2 +050900 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +051000 MOVE 1 TO TOP-CTR. SQ2084.2 +051100 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +051200 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +051300 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2084.2 +051400 MOVE 16 TO DL1-LINE-NO. SQ2084.2 +051500 PERFORM PRINT-DETAIL-2 120 TIMES. SQ2084.2 +051600 WRITE-TEST-GF-04. SQ2084.2 +051700* THIS TEST CHECKS THE MINIMUM LINAGE VALUE OF 1 SQ2084.2 +051800* AND THE MINIMUM TOP VALUE OF ZERO. SQ2084.2 +051900 PERFORM INITIALIZE-PAGE. SQ2084.2 +052000 MOVE "MIN LINAGE / 0 TOP" TO FEATURE. SQ2084.2 +052100 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. SQ2084.2 +052200 PERFORM PRINT-DETAIL. SQ2084.2 +052300 MOVE COMMENT-LINE-11 TO PRINT-REC. SQ2084.2 +052400 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +052500 MOVE COMMENT-LINE-12 TO PRINT-REC. SQ2084.2 +052600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +052700 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +052800 PERFORM PRINT-LAST-LINE. SQ2084.2 +052900 MOVE 1 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +053000 MOVE 0 TO TOP-CTR. SQ2084.2 +053100 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +053200 MOVE 1 TO DL2-LINE-NO. SQ2084.2 +053300 PERFORM PRINT-DETAIL-3 10 TIMES. SQ2084.2 +053400 WRITE-TEST-GF-05. SQ2084.2 +053500* THIS TEST CHECKS THE MINIMUM FOOTING VALUE OF 1 SQ2084.2 +053600* AND THE MINIMUM BOTTOM VALUE OF ZERO. SQ2084.2 +053700 PERFORM INITIALIZE-PAGE. SQ2084.2 +053800 MOVE "MIN FOOTING / 0 BOTM" TO FEATURE. SQ2084.2 +053900 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. SQ2084.2 +054000 PERFORM PRINT-DETAIL. SQ2084.2 +054100 MOVE COMMENT-LINE-13 TO PRINT-REC. SQ2084.2 +054200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +054300 MOVE COMMENT-LINE-14 TO PRINT-REC. SQ2084.2 +054400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +054500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +054600 PERFORM PRINT-LAST-LINE. SQ2084.2 +054700 MOVE 2 TO LINAGE-CTR. SQ2084.2 +054800 MOVE 1 TO FOOT-CTR, TOP-CTR. SQ2084.2 +054900 MOVE 0 TO BOTTOM-CTR. SQ2084.2 +055000 MOVE 1 TO DL2-LINE-NO. SQ2084.2 +055100 PERFORM PRINT-DETAIL-4 10 TIMES. SQ2084.2 +055200 WRITE-TEST-GF-06. SQ2084.2 +055300* THIS TEST SHOWS THE RESULTS OF A WRITE BEFORE SQ2084.2 +055400* OPERATION WITH AN EOP PHRASE. LINAGE AND FOOTING SQ2084.2 +055500* VALUES ARE SPECIFIED AND EQUAL. SQ2084.2 +055600 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +055700 PERFORM INITIALIZE-PAGE. SQ2084.2 +055800 MOVE "WRITE BEFORE" TO FEATURE. SQ2084.2 +055900 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. SQ2084.2 +056000 PERFORM PRINT-DETAIL. SQ2084.2 +056100 MOVE INFO-LINE-1 TO PRINT-REC. SQ2084.2 +056200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +056300 MOVE INFO-LINE-3 TO PRINT-REC. SQ2084.2 +056400 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +056500 MOVE INFO-LINE-4 TO PRINT-REC. SQ2084.2 +056600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +056700 MOVE INFO-LINE-6 TO PRINT-REC. SQ2084.2 +056800 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +056900 MOVE INFO-LINE-8 TO PRINT-REC. SQ2084.2 +057000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +057100 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +057200 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2084.2 +057300 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +057400 MOVE 1 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +057500 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +057600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +057700 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +057800 MOVE 1 TO DL3-LINE-NO. SQ2084.2 +057900 PERFORM WRITE-BEFORE 60 TIMES. SQ2084.2 +058000 WRITE-TEST-GF-07. SQ2084.2 +058100* THIS TEST SHOWS THE RESULTS OF A WRITE AFTER SQ2084.2 +058200* OPERATION WITH AN EOP PHRASE. LINAGE AND FOOTING SQ2084.2 +058300* VALUES ARE SPECIFIED AND EQUAL. SQ2084.2 +058400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +058500 PERFORM INITIALIZE-PAGE. SQ2084.2 +058600 MOVE "WRITE AFTER" TO FEATURE. SQ2084.2 +058700 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. SQ2084.2 +058800 PERFORM PRINT-DETAIL. SQ2084.2 +058900 MOVE INFO-LINE-2 TO PRINT-REC. SQ2084.2 +059000 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +059100 MOVE INFO-LINE-3 TO PRINT-REC. SQ2084.2 +059200 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +059300 MOVE INFO-LINE-4 TO PRINT-REC. SQ2084.2 +059400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +059500 MOVE INFO-LINE-7 TO PRINT-REC. SQ2084.2 +059600 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +059700 MOVE INFO-LINE-8 TO PRINT-REC. SQ2084.2 +059800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +059900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +060000 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2084.2 +060100 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +060200 MOVE 1 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +060300 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +060400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +060500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +060600 MOVE 1 TO DL3-LINE-NO. SQ2084.2 +060700 PERFORM WRITE-AFTER 60 TIMES. SQ2084.2 +060800 SQ208M-END-ROUTINE. SQ2084.2 +060900 MOVE "END OF SQ208M VALIDATION TESTS" TO PRINT-REC. SQ2084.2 +061000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +061100 GO TO CCVS-EXIT. SQ2084.2 +061200 INITIALIZE-PAGE. SQ2084.2 +061300 MOVE 0 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +061400 MOVE 66 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +061500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2084.2 +061600 PRINT-LAST-LINE. SQ2084.2 +061700 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 65. SQ2084.2 +061800 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +061900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +062000 PRINT-DETAIL-1. SQ2084.2 +062100 MOVE LINAGE-COUNTER TO DL1-LC. SQ2084.2 +062200 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2084.2 +062300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT END-OF-PAGE SQ2084.2 +062400 MOVE LINAGE-COUNTER TO FL1-LC SQ2084.2 +062500 MOVE FOOT-LINE-1 TO PRINT-REC SQ2084.2 +062600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +062700 ADD 1 TO DL1-LINE-NO. SQ2084.2 +062800 PRINT-DETAIL-2. SQ2084.2 +062900 MOVE LINAGE-COUNTER TO DL1-LC. SQ2084.2 +063000 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2084.2 +063100 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +063200 ADD 1 TO DL1-LINE-NO. SQ2084.2 +063300 PRINT-DETAIL-3. SQ2084.2 +063400 MOVE LINAGE-COUNTER TO DL2-LC. SQ2084.2 +063500 MOVE DETAIL-LINE-2 TO PRINT-REC. SQ2084.2 +063600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +063700 ADD 1 TO DL2-LINE-NO. SQ2084.2 +063800 PRINT-DETAIL-4. SQ2084.2 +063900 MOVE LINAGE-COUNTER TO DL2-LC. SQ2084.2 +064000 MOVE DETAIL-LINE-2 TO PRINT-REC. SQ2084.2 +064100 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2084.2 +064200 MOVE LINAGE-COUNTER TO FL1-LC SQ2084.2 +064300 MOVE FOOT-LINE-1 TO PRINT-REC SQ2084.2 +064400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +064500 ADD 1 TO DL2-LINE-NO. SQ2084.2 +064600 WRITE-BEFORE. SQ2084.2 +064700 MOVE LINAGE-COUNTER TO DL3-LC. SQ2084.2 +064800 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2084.2 +064900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT EOP SQ2084.2 +065000 MOVE LINAGE-COUNTER TO FL3-LC SQ2084.2 +065100 MOVE FOOT-LINE-3 TO PRINT-REC SQ2084.2 +065200 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +065300 ADD 1 TO DL3-LINE-NO. SQ2084.2 +065400 WRITE-AFTER. SQ2084.2 +065500 MOVE LINAGE-COUNTER TO DL3-LC. SQ2084.2 +065600 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2084.2 +065700 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2084.2 +065800 MOVE LINAGE-COUNTER TO FL3-LC SQ2084.2 +065900 MOVE FOOT-LINE-3 TO PRINT-REC SQ2084.2 +066000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +066100 ADD 1 TO DL3-LINE-NO. SQ2084.2 +066200 CCVS-EXIT SECTION. SQ2084.2 +066300 CCVS-999999. SQ2084.2 +066400 GO TO CLOSE-FILES. SQ2084.2 +*END-OF,SQ208M +*HEADER,COBOL,SQ209M +000100 IDENTIFICATION DIVISION. SQ2094.2 +000200 PROGRAM-ID. SQ2094.2 +000300 SQ209M. SQ2094.2 +000400**************************************************************** SQ2094.2 +000500* * SQ2094.2 +000600* VALIDATION FOR:- * SQ2094.2 +000700* " HIGH ". SQ2094.2 +000800* * SQ2094.2 +000900* CREATION DATE / VALIDATION DATE * SQ2094.2 +001000* "4.2 ". SQ2094.2 +001100* * SQ2094.2 +001200* THE ROUTINE SQ209M TESTS THE USE OF THE LEVEL 2 WRITE SQ2094.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2094.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2094.2 +001500* POSITONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2094.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A LOGICALSQ2094.2 +001700* PRINT PAGE. SQ209M IS DESIGNED TO TEST THE MINIMUM SQ2094.2 +001800* CONFIGURATION OF THE LINAGE CLAUSE. IT IS ASSUMED THAT ALL SQ2094.2 +001900* LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE IN TESTING SQ210. SQ2094.2 +002000* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2094.2 +002100* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2094.2 +002200* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2094.2 +002300* ACCURACY OF THE VARIOUS WRITE OPTIONS. SQ2094.2 +002400 ENVIRONMENT DIVISION. SQ2094.2 +002500 CONFIGURATION SECTION. SQ2094.2 +002600 SOURCE-COMPUTER. SQ2094.2 +002700 XXXXX082. SQ2094.2 +002800 OBJECT-COMPUTER. SQ2094.2 +002900 XXXXX083. SQ2094.2 +003000 INPUT-OUTPUT SECTION. SQ2094.2 +003100 FILE-CONTROL. SQ2094.2 +003200P SELECT RAW-DATA ASSIGN TO SQ2094.2 +003300P XXXXX062 SQ2094.2 +003400P ORGANIZATION IS INDEXED SQ2094.2 +003500P ACCESS MODE IS RANDOM SQ2094.2 +003600P RECORD KEY IS RAW-DATA-KEY. SQ2094.2 +003700 SELECT PRINT-FILE ASSIGN TO SQ2094.2 +003800 XXXXX055. SQ2094.2 +003900 DATA DIVISION. SQ2094.2 +004000 FILE SECTION. SQ2094.2 +004100P SQ2094.2 +004200PFD RAW-DATA. SQ2094.2 +004300P SQ2094.2 +004400P01 RAW-DATA-SATZ. SQ2094.2 +004500P 05 RAW-DATA-KEY PIC X(6). SQ2094.2 +004600P 05 C-DATE PIC 9(6). SQ2094.2 +004700P 05 C-TIME PIC 9(8). SQ2094.2 +004800P 05 C-NO-OF-TESTS PIC 99. SQ2094.2 +004900P 05 C-OK PIC 999. SQ2094.2 +005000P 05 C-ALL PIC 999. SQ2094.2 +005100P 05 C-FAIL PIC 999. SQ2094.2 +005200P 05 C-DELETED PIC 999. SQ2094.2 +005300P 05 C-INSPECT PIC 999. SQ2094.2 +005400P 05 C-NOTE PIC X(13). SQ2094.2 +005500P 05 C-INDENT PIC X. SQ2094.2 +005600P 05 C-ABORT PIC X(8). SQ2094.2 +005700 FD PRINT-FILE SQ2094.2 +005800C LABEL RECORDS SQ2094.2 +005900C XXXXX084 SQ2094.2 +006000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2094.2 +006100 LINAGE 40 SQ2094.2 +006200 TOP 2. SQ2094.2 +006300 01 PRINT-REC PICTURE X(120). SQ2094.2 +006400 01 DUMMY-RECORD PICTURE X(120). SQ2094.2 +006500 WORKING-STORAGE SECTION. SQ2094.2 +006600 77 ONE PIC 9 VALUE 1. SQ2094.2 +006700 01 NOTE-1. SQ2094.2 +006800 02 FILLER PIC X(39) VALUE "BECAUSE OF THE NATURE SQ2094.2 +006900- "OF THESE TESTS A ". SQ2094.2 +007000 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007100 02 FILLER PIC X(4) VALUE "PASS". SQ2094.2 +007200 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007300 02 FILLER PIC X(4) VALUE " OR ". SQ2094.2 +007400 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007500 02 FILLER PIC X(4) VALUE "FAIL". SQ2094.2 +007600 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007700 02 FILLER PIC X(65) VALUE " CANNOT BE DETERMINED SQ2094.2 +007800- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ2094.2 +007900 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2094.2 +008000- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2094.2 +008100- "IONS. VII-27 TO 29 LINAGE ". SQ2094.2 +008200 01 LAST-LINE-1 PIC X(120) VALUE "THIS LINE SHOULD PRINTSQ2094.2 +008300- " AS THE LAST LINE ON THIS LOGICAL PAGE. TWO BLANK LINES SHOUSQ2094.2 +008400- "LD FOLLOW.". SQ2094.2 +008500 01 FIRST-LINE-1 PIC X(120) VALUE "THIS LINE SHOULD PRINTSQ2094.2 +008600- " AS THE FIRST LINE ON A NEW LOGICAL PAGE. IT SHOULD BE THREESQ2094.2 +008700- " LINES BELOW THE PREVIOUS LINE.". SQ2094.2 +008800 01 DETAIL-LINE-3. SQ2094.2 +008900 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2094.2 +009000 02 DL3-LINE-NO PIC 99. SQ2094.2 +009100 02 FILLER PIC X(40) VALUE " OF 60 DETAIL LINES. SQ2094.2 +009200- "LINAGE-COUNTER IS ". SQ2094.2 +009300 02 DL3-LC PIC 99. SQ2094.2 +009400 02 FILLER PIC X(63) VALUE ".". SQ2094.2 +009500 01 FOOT-LINE-3. SQ2094.2 +009600 02 FILLER PIC X(103) VALUE "THIS LINE WAS PRINTED SQ2094.2 +009700- "FROM AN EOP CLAUSE. THE VALUE OF THE LINAGE-COUNTER PRIOR TSQ2094.2 +009800- "O THIS EXECUTION IS ". SQ2094.2 +009900 02 FL3-LC PIC 99. SQ2094.2 +010000 02 FILLER PIC X(15) VALUE ".". SQ2094.2 +010100 01 INFO-LINE-1 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2094.2 +010200- "TO TEST THE OVERFLOW RESULTS OF A WRITE BEFORE ADVANCING OPESQ2094.2 +010300- "RATION CONTAINING AN EOP PHRASE.". SQ2094.2 +010400 01 INFO-LINE-2 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2094.2 +010500- "TO TEST THE OVERFLOW RESULTS OF A WRITE AFTER ADVANCING OPERSQ2094.2 +010600- "ATION CONTAINING AN EOP PHRASE.". SQ2094.2 +010700 01 INFO-LINE-3 PIC X(120) VALUE "FOR THIS TEST LINAGE VSQ2094.2 +010800- "ALUE IS 40. NO FOOTING PHRASE IS SPECIFIED.". SQ2094.2 +010900 01 INFO-LINE-4 PIC X(120) VALUE "39 DETAIL LINES SHOULDSQ2094.2 +011000- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 21 DETAIL LSQ2094.2 +011100- "INES ON THE 2ND LOGICAL PAGE.". SQ2094.2 +011200 01 INFO-LINE-5 PIC X(120) VALUE "40 DETAIL LINES SHOULDSQ2094.2 +011300- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 20 DETAIL LSQ2094.2 +011400- "INES ON THE 2ND LOGICAL PAGE.". SQ2094.2 +011500 01 INFO-LINE-6 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2094.2 +011600- "LLOW DETAIL LINE 40 AND BE THE FIRST LINE ON THE 2ND LOGICALSQ2094.2 +011700- " PAGE.". SQ2094.2 +011800 01 INFO-LINE-7 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2094.2 +011900- "LLOW DETAIL LINE 40 AND BE THE 2ND LINE ON THE 2ND LOGICAL PSQ2094.2 +012000- "AGE.". SQ2094.2 +012100 01 INFO-LINE-8 PIC X(120) VALUE "ALL LINAGE-COUNTER VALSQ2094.2 +012200- "UES REPRESENT VALUES PRIOR TO EXECUTION OF THE WRITE OPERATISQ2094.2 +012300- "ON. NO MODIFICATIONS HAVE BEEN MADE.". SQ2094.2 +012400 01 TEST-RESULTS. SQ2094.2 +012500 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +012600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2094.2 +012700 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +012800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2094.2 +012900 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +013000 02 PAR-NAME. SQ2094.2 +013100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2094.2 +013200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2094.2 +013300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2094.2 +013400 03 FILLER PIC X(5) VALUE SPACE. SQ2094.2 +013500 02 FILLER PIC X(10) VALUE SPACE. SQ2094.2 +013600 02 RE-MARK PIC X(61). SQ2094.2 +013700 01 TEST-COMPUTED. SQ2094.2 +013800 02 FILLER PIC X(30) VALUE SPACE. SQ2094.2 +013900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2094.2 +014000 02 COMPUTED-X. SQ2094.2 +014100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2094.2 +014200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2094.2 +014300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2094.2 +014400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2094.2 +014500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2094.2 +014600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2094.2 +014700 04 COMPUTED-18V0 PICTURE -9(18). SQ2094.2 +014800 04 FILLER PICTURE X. SQ2094.2 +014900 03 FILLER PIC X(50) VALUE SPACE. SQ2094.2 +015000 01 TEST-CORRECT. SQ2094.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ2094.2 +015200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2094.2 +015300 02 CORRECT-X. SQ2094.2 +015400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2094.2 +015500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2094.2 +015600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2094.2 +015700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2094.2 +015800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2094.2 +015900 03 CR-18V0 REDEFINES CORRECT-A. SQ2094.2 +016000 04 CORRECT-18V0 PICTURE -9(18). SQ2094.2 +016100 04 FILLER PICTURE X. SQ2094.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ2094.2 +016300 01 CCVS-C-1. SQ2094.2 +016400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2094.2 +016500- "SS PARAGRAPH-NAME SQ2094.2 +016600- " REMARKS". SQ2094.2 +016700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2094.2 +016800 01 CCVS-C-2. SQ2094.2 +016900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +017000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2094.2 +017100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2094.2 +017200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2094.2 +017300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2094.2 +017400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2094.2 +017500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2094.2 +017600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2094.2 +017700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2094.2 +017800 01 INSPECT-COUNTER PIC 999 VALUE 3. SQ2094.2 +017900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2094.2 +018000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2094.2 +018100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2094.2 +018200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2094.2 +018300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2094.2 +018400 01 CCVS-H-1. SQ2094.2 +018500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2094.2 +018600 02 FILLER PICTURE X(67) VALUE SQ2094.2 +018700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2094.2 +018800- " SYSTEM". SQ2094.2 +018900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2094.2 +019000 01 CCVS-H-2. SQ2094.2 +019100 02 FILLER PICTURE X(52) VALUE IS SQ2094.2 +019200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2094.2 +019300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2094.2 +019400 02 TEST-ID PICTURE IS X(9). SQ2094.2 +019500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2094.2 +019600 01 CCVS-H-3. SQ2094.2 +019700 02 FILLER PICTURE X(34) VALUE SQ2094.2 +019800 " FOR OFFICIAL USE ONLY ". SQ2094.2 +019900 02 FILLER PICTURE X(58) VALUE SQ2094.2 +020000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2094.2 +020100 02 FILLER PICTURE X(28) VALUE SQ2094.2 +020200 " COPYRIGHT 1985 ". SQ2094.2 +020300 01 CCVS-E-1. SQ2094.2 +020400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2094.2 +020500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2094.2 +020600 02 ID-AGAIN PICTURE IS X(9). SQ2094.2 +020700 02 FILLER PICTURE X(45) VALUE IS SQ2094.2 +020800 " NTIS DISTRIBUTION COBOL 85". SQ2094.2 +020900 01 CCVS-E-2. SQ2094.2 +021000 02 FILLER PICTURE X(31) VALUE SQ2094.2 +021100 SPACE. SQ2094.2 +021200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2094.2 +021300 02 CCVS-E-2-2. SQ2094.2 +021400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2094.2 +021500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +021600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2094.2 +021700 01 CCVS-E-3. SQ2094.2 +021800 02 FILLER PICTURE X(22) VALUE SQ2094.2 +021900 " FOR OFFICIAL USE ONLY". SQ2094.2 +022000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2094.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2094.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2094.2 +022300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2094.2 +022400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2094.2 +022500 01 CCVS-E-4. SQ2094.2 +022600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2094.2 +022700 02 FILLER PIC XXXX VALUE " OF ". SQ2094.2 +022800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2094.2 +022900 02 FILLER PIC X(40) VALUE SQ2094.2 +023000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2094.2 +023100 01 XXINFO. SQ2094.2 +023200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2094.2 +023300 02 INFO-TEXT. SQ2094.2 +023400 04 FILLER PIC X(20) VALUE SPACE. SQ2094.2 +023500 04 XXCOMPUTED PIC X(20). SQ2094.2 +023600 04 FILLER PIC X(5) VALUE SPACE. SQ2094.2 +023700 04 XXCORRECT PIC X(20). SQ2094.2 +023800 01 HYPHEN-LINE. SQ2094.2 +023900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +024000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2094.2 +024100- "*****************************************". SQ2094.2 +024200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2094.2 +024300- "******************************". SQ2094.2 +024400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2094.2 +024500 "SQ209M". SQ2094.2 +024600 PROCEDURE DIVISION. SQ2094.2 +024700 CCVS1 SECTION. SQ2094.2 +024800 OPEN-FILES. SQ2094.2 +024900P OPEN I-O RAW-DATA. SQ2094.2 +025000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2094.2 +025100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2094.2 +025200P MOVE "ABORTED " TO C-ABORT. SQ2094.2 +025300P ADD 1 TO C-NO-OF-TESTS. SQ2094.2 +025400P ACCEPT C-DATE FROM DATE. SQ2094.2 +025500P ACCEPT C-TIME FROM TIME. SQ2094.2 +025600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2094.2 +025700PEND-E-1. SQ2094.2 +025800P CLOSE RAW-DATA. SQ2094.2 +025900 OPEN OUTPUT PRINT-FILE. SQ2094.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2094.2 +026100 MOVE SPACE TO TEST-RESULTS. SQ2094.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2094.2 +026300 GO TO CCVS1-EXIT. SQ2094.2 +026400 CLOSE-FILES. SQ2094.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2094.2 +026600P OPEN I-O RAW-DATA. SQ2094.2 +026700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2094.2 +026800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2094.2 +026900P MOVE "OK. " TO C-ABORT. SQ2094.2 +027000P MOVE PASS-COUNTER TO C-OK. SQ2094.2 +027100P MOVE ERROR-HOLD TO C-ALL. SQ2094.2 +027200P MOVE ERROR-COUNTER TO C-FAIL. SQ2094.2 +027300P MOVE DELETE-CNT TO C-DELETED. SQ2094.2 +027400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2094.2 +027500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2094.2 +027600PEND-E-2. SQ2094.2 +027700P CLOSE RAW-DATA. SQ2094.2 +027800 TERMINATE-CCVS. SQ2094.2 +027900S EXIT PROGRAM. SQ2094.2 +028000STERMINATE-CALL. SQ2094.2 +028100 STOP RUN. SQ2094.2 +028200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2094.2 +028300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2094.2 +028400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2094.2 +028500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2094.2 +028600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2094.2 +028700 PRINT-DETAIL. SQ2094.2 +028800 IF REC-CT NOT EQUAL TO ZERO SQ2094.2 +028900 MOVE "." TO PARDOT-X SQ2094.2 +029000 MOVE REC-CT TO DOTVALUE. SQ2094.2 +029100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2094.2 +029200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2094.2 +029300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2094.2 +029400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2094.2 +029500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2094.2 +029600 MOVE SPACE TO CORRECT-X. SQ2094.2 +029700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2094.2 +029800 MOVE SPACE TO RE-MARK. SQ2094.2 +029900 HEAD-ROUTINE. SQ2094.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +030100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2094.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2094.2 +030300 COLUMN-NAMES-ROUTINE. SQ2094.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +030700 END-ROUTINE. SQ2094.2 +030800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2094.2 +030900 END-RTN-EXIT. SQ2094.2 +031000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +031100 END-ROUTINE-1. SQ2094.2 +031200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2094.2 +031300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2094.2 +031400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2094.2 +031500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2094.2 +031600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2094.2 +031700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2094.2 +031800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2094.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2094.2 +032000 END-ROUTINE-12. SQ2094.2 +032100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2094.2 +032200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2094.2 +032300 MOVE "NO " TO ERROR-TOTAL SQ2094.2 +032400 ELSE SQ2094.2 +032500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2094.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2094.2 +032700 PERFORM WRITE-LINE. SQ2094.2 +032800 END-ROUTINE-13. SQ2094.2 +032900 IF DELETE-CNT IS EQUAL TO ZERO SQ2094.2 +033000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2094.2 +033100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2094.2 +033200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2094.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +033400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2094.2 +033500 MOVE "NO " TO ERROR-TOTAL SQ2094.2 +033600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2094.2 +033700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2094.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +033900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +034000 WRITE-LINE. SQ2094.2 +034100 ADD 1 TO RECORD-COUNT. SQ2094.2 +034200Y IF RECORD-COUNT GREATER 50 SQ2094.2 +034300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2094.2 +034400Y MOVE SPACE TO DUMMY-RECORD SQ2094.2 +034500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2094.2 +034600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2094.2 +034700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2094.2 +034800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2094.2 +034900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2094.2 +035000Y MOVE ZERO TO RECORD-COUNT. SQ2094.2 +035100 PERFORM WRT-LN. SQ2094.2 +035200 WRT-LN. SQ2094.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2094.2 +035400 MOVE SPACE TO DUMMY-RECORD. SQ2094.2 +035500 BLANK-LINE-PRINT. SQ2094.2 +035600 PERFORM WRT-LN. SQ2094.2 +035700 FAIL-ROUTINE. SQ2094.2 +035800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2094.2 +035900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2094.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2094.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +036200 GO TO FAIL-ROUTINE-EX. SQ2094.2 +036300 FAIL-ROUTINE-WRITE. SQ2094.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2094.2 +036500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +036600 FAIL-ROUTINE-EX. EXIT. SQ2094.2 +036700 BAIL-OUT. SQ2094.2 +036800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2094.2 +036900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2094.2 +037000 BAIL-OUT-WRITE. SQ2094.2 +037100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2094.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +037300 BAIL-OUT-EX. EXIT. SQ2094.2 +037400 CCVS1-EXIT. SQ2094.2 +037500 EXIT. SQ2094.2 +037600 SECT-SQ209M-0001 SECTION. SQ2094.2 +037700 WRITE-INIT-001. SQ2094.2 +037800 MOVE NOTE-1 TO PRINT-REC. SQ2094.2 +037900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +038000 MOVE NOTE-2 TO PRINT-REC. SQ2094.2 +038100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +038200 MOVE SPACE TO DUMMY-RECORD. SQ2094.2 +038300 PERFORM BLANK-LINE-PRINT. SQ2094.2 +038400 WRITE-TEST-GF-01. SQ2094.2 +038500* THIS TEST CHECKS THE VERTICAL SPACING BETWEEN SQ2094.2 +038600* LOGICAL PAGES. BECAUSE ONLY THE TOP PHRASE IS SQ2094.2 +038700* SPECIFIED THERE SHOULD BE TWO SPACES BETWEEN PAGES. SQ2094.2 +038800 MOVE "SPACE BTWN LOG PAGES" TO FEATURE. SQ2094.2 +038900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2094.2 +039000 PERFORM PRINT-DETAIL. SQ2094.2 +039100 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 39. SQ2094.2 +039200 MOVE LAST-LINE-1 TO PRINT-REC. SQ2094.2 +039300 WRITE PRINT-REC AFTER ONE LINE. SQ2094.2 +039400 WRITE PRINT-REC FROM FIRST-LINE-1 AFTER ADVANCING PAGE. SQ2094.2 +039500 WRITE-TEST-GF-02. SQ2094.2 +039600* THIS TEST SHOWS THE RESULTS OF A WRITE BEFORE SQ2094.2 +039700* OPERATION WITH AN EOP PHRASE. ONLY LINAGE IS SQ2094.2 +039800* SPECIFIED. SQ2094.2 +039900 MOVE "WRITE BEFORE" TO FEATURE. SQ2094.2 +040000 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2094.2 +040100 PERFORM PRINT-DETAIL. SQ2094.2 +040200 MOVE INFO-LINE-1 TO PRINT-REC. SQ2094.2 +040300 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2094.2 +040400 MOVE INFO-LINE-3 TO PRINT-REC. SQ2094.2 +040500 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +040600 MOVE INFO-LINE-5 TO PRINT-REC. SQ2094.2 +040700 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +040800 MOVE INFO-LINE-6 TO PRINT-REC. SQ2094.2 +040900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +041000 MOVE INFO-LINE-8 TO PRINT-REC. SQ2094.2 +041100 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +041200 MOVE SPACES TO PRINT-REC. SQ2094.2 +041300 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2094.2 +041400 MOVE 1 TO DL3-LINE-NO. SQ2094.2 +041500 PERFORM WRITE-BEFORE 60 TIMES. SQ2094.2 +041600 WRITE-TEST-GF-03. SQ2094.2 +041700* THIS TEST SHOWS THE RESULTS OF A WRITE AFTER SQ2094.2 +041800* OPERATION WITH AN EOP PHRASE. ONLY LINAGE IS SQ2094.2 +041900* SPECIFIED. SQ2094.2 +042000 MOVE "WRITE AFTER" TO FEATURE. SQ2094.2 +042100 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2094.2 +042200 PERFORM PRINT-DETAIL. SQ2094.2 +042300 MOVE INFO-LINE-2 TO PRINT-REC. SQ2094.2 +042400 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2094.2 +042500 MOVE INFO-LINE-3 TO PRINT-REC. SQ2094.2 +042600 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +042700 MOVE INFO-LINE-4 TO PRINT-REC. SQ2094.2 +042800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +042900 MOVE INFO-LINE-7 TO PRINT-REC. SQ2094.2 +043000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +043100 MOVE INFO-LINE-8 TO PRINT-REC. SQ2094.2 +043200 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +043300 MOVE SPACES TO PRINT-REC. SQ2094.2 +043400 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2094.2 +043500 MOVE 1 TO DL3-LINE-NO. SQ2094.2 +043600 PERFORM WRITE-AFTER 60 TIMES. SQ2094.2 +043700 SQ209M-END-ROUTINE. SQ2094.2 +043800 MOVE "END OF SQ209M VALIDATION TESTS" TO PRINT-REC. SQ2094.2 +043900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +044000 GO TO CCVS-EXIT. SQ2094.2 +044100 WRITE-BEFORE. SQ2094.2 +044200 MOVE LINAGE-COUNTER TO DL3-LC. SQ2094.2 +044300 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2094.2 +044400 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT EOP SQ2094.2 +044500 MOVE LINAGE-COUNTER TO FL3-LC SQ2094.2 +044600 MOVE FOOT-LINE-3 TO PRINT-REC SQ2094.2 +044700 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2094.2 +044800 ADD 1 TO DL3-LINE-NO. SQ2094.2 +044900 WRITE-AFTER. SQ2094.2 +045000 MOVE LINAGE-COUNTER TO DL3-LC. SQ2094.2 +045100 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2094.2 +045200 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2094.2 +045300 MOVE LINAGE-COUNTER TO FL3-LC SQ2094.2 +045400 MOVE FOOT-LINE-3 TO PRINT-REC SQ2094.2 +045500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +045600 ADD 1 TO DL3-LINE-NO. SQ2094.2 +045700 CCVS-EXIT SECTION. SQ2094.2 +045800 CCVS-999999. SQ2094.2 +045900 GO TO CLOSE-FILES. SQ2094.2 +*END-OF,SQ209M +*HEADER,COBOL,SQ210M +000100 IDENTIFICATION DIVISION. SQ2104.2 +000200 PROGRAM-ID. SQ2104.2 +000300 SQ210M. SQ2104.2 +000400**************************************************************** SQ2104.2 +000500* * SQ2104.2 +000600* VALIDATION FOR:- * SQ2104.2 +000700* " HIGH ". SQ2104.2 +000800* * SQ2104.2 +000900* CREATION DATE / VALIDATION DATE * SQ2104.2 +001000* "4.2 ". SQ2104.2 +001100* * SQ2104.2 +001200* THE ROUTINE SQ210M TESTS THE USE OF THE LEVEL 2 WRITE SQ2104.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2104.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2104.2 +001500* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2104.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF LOGICAL SQ2104.2 +001700* PRINT PAGE. SQ210M TESTS THE USE OF A MIXTURE OF INTEGER ANDSQ2104.2 +001800* DATA-NAME ITEMS IN THE LINAGE CLAUSE. VALUES OF DATA-NAMES SQ2104.2 +001900* ARE CHANGED IN ORDER TO CHECK REDEFINITION OF LOGICAL PAGE SQ2104.2 +002000* FORMATS. IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS SQ2104.2 +002100* ARE AVAILABLE IN TESTING SQ210M. SQ2104.2 +002200 ENVIRONMENT DIVISION. SQ2104.2 +002300 CONFIGURATION SECTION. SQ2104.2 +002400 SOURCE-COMPUTER. SQ2104.2 +002500 XXXXX082. SQ2104.2 +002600 OBJECT-COMPUTER. SQ2104.2 +002700 XXXXX083. SQ2104.2 +002800 INPUT-OUTPUT SECTION. SQ2104.2 +002900 FILE-CONTROL. SQ2104.2 +003000P SELECT RAW-DATA ASSIGN TO SQ2104.2 +003100P XXXXX062 SQ2104.2 +003200P ORGANIZATION IS INDEXED SQ2104.2 +003300P ACCESS MODE IS RANDOM SQ2104.2 +003400P RECORD KEY IS RAW-DATA-KEY. SQ2104.2 +003500 SELECT PRINT-FILE ASSIGN TO SQ2104.2 +003600 XXXXX055. SQ2104.2 +003700 DATA DIVISION. SQ2104.2 +003800 FILE SECTION. SQ2104.2 +003900P SQ2104.2 +004000PFD RAW-DATA. SQ2104.2 +004100P SQ2104.2 +004200P01 RAW-DATA-SATZ. SQ2104.2 +004300P 05 RAW-DATA-KEY PIC X(6). SQ2104.2 +004400P 05 C-DATE PIC 9(6). SQ2104.2 +004500P 05 C-TIME PIC 9(8). SQ2104.2 +004600P 05 C-NO-OF-TESTS PIC 99. SQ2104.2 +004700P 05 C-OK PIC 999. SQ2104.2 +004800P 05 C-ALL PIC 999. SQ2104.2 +004900P 05 C-FAIL PIC 999. SQ2104.2 +005000P 05 C-DELETED PIC 999. SQ2104.2 +005100P 05 C-INSPECT PIC 999. SQ2104.2 +005200P 05 C-NOTE PIC X(13). SQ2104.2 +005300P 05 C-INDENT PIC X. SQ2104.2 +005400P 05 C-ABORT PIC X(8). SQ2104.2 +005500 FD PRINT-FILE SQ2104.2 +005600C LABEL RECORDS SQ2104.2 +005700C XXXXX084 SQ2104.2 +005800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2104.2 +005900 LINAGE IS LINAGE-CTR LINES SQ2104.2 +006000 TOP 5. SQ2104.2 +006100 01 PRINT-REC PICTURE X(120). SQ2104.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ2104.2 +006300 WORKING-STORAGE SECTION. SQ2104.2 +006400 77 LINAGE-CTR PIC 99 VALUE 66. SQ2104.2 +006500 01 DETAIL-LINE-1. SQ2104.2 +006600 02 FILLER PIC X(20) VALUE SPACE. SQ2104.2 +006700 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2104.2 +006800 02 DL1-LINE-NO PIC 99. SQ2104.2 +006900 02 FILLER PIC X(40) VALUE " OF 80 DETAIL LINES. SQ2104.2 +007000- "LINAGE-COUNTER IS ". SQ2104.2 +007100 02 DL1-LC PIC 99. SQ2104.2 +007200 02 FILLER PIC X(43) VALUE ".". SQ2104.2 +007300 01 COMMENT-LINE-1 PIC X(120) VALUE "BECAUSE OF THE NATURE SQ2104.2 +007400- "OF THESE TESTS A PASS OR FAIL CANNOT BE DETERMINED WITHIN THSQ2104.2 +007500- "E PROGRAM. THE USER MUST VISUALLY". SQ2104.2 +007600 01 COMMENT-LINE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2104.2 +007700- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2104.2 +007800- "IONS. VII-27 TO 29". SQ2104.2 +007900 01 COMMENT-LINE-3 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2104.2 +008000- " LOGICAL PAGE SHOULD CONTAIN 20 DETAIL LINES. ALL SUCCEEDINSQ2104.2 +008100- "G LOGICAL PAGES SHOULD CONTAIN 30". SQ2104.2 +008200 01 COMMENT-LINE-4 PIC X(120) VALUE "DETAIL LINES. ALL LOGSQ2104.2 +008300- "ICAL PAGES SHOULD BE SEPARATED BY 5 BLANK LINES.". SQ2104.2 +008400 01 LAST-LINE PIC X(120) VALUE "THIS IS THE LAST LINE SQ2104.2 +008500- "IN THE PAGE BODY OF THIS LOGICAL PAGE. USE IT AS A REFERENCSQ2104.2 +008600- "E POINT FOR THE FOLLOWING TEST PAGES.". SQ2104.2 +008700 01 TEST-RESULTS. SQ2104.2 +008800 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +008900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2104.2 +009000 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +009100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2104.2 +009200 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +009300 02 PAR-NAME. SQ2104.2 +009400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2104.2 +009500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2104.2 +009600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2104.2 +009700 03 FILLER PIC X(5) VALUE SPACE. SQ2104.2 +009800 02 FILLER PIC X(10) VALUE SPACE. SQ2104.2 +009900 02 RE-MARK PIC X(61). SQ2104.2 +010000 01 TEST-COMPUTED. SQ2104.2 +010100 02 FILLER PIC X(30) VALUE SPACE. SQ2104.2 +010200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2104.2 +010300 02 COMPUTED-X. SQ2104.2 +010400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2104.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2104.2 +010600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2104.2 +010700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2104.2 +010800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2104.2 +010900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2104.2 +011000 04 COMPUTED-18V0 PICTURE -9(18). SQ2104.2 +011100 04 FILLER PICTURE X. SQ2104.2 +011200 03 FILLER PIC X(50) VALUE SPACE. SQ2104.2 +011300 01 TEST-CORRECT. SQ2104.2 +011400 02 FILLER PIC X(30) VALUE SPACE. SQ2104.2 +011500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2104.2 +011600 02 CORRECT-X. SQ2104.2 +011700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2104.2 +011800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2104.2 +011900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2104.2 +012000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2104.2 +012100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2104.2 +012200 03 CR-18V0 REDEFINES CORRECT-A. SQ2104.2 +012300 04 CORRECT-18V0 PICTURE -9(18). SQ2104.2 +012400 04 FILLER PICTURE X. SQ2104.2 +012500 03 FILLER PIC X(50) VALUE SPACE. SQ2104.2 +012600 01 CCVS-C-1. SQ2104.2 +012700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2104.2 +012800- "SS PARAGRAPH-NAME SQ2104.2 +012900- " REMARKS". SQ2104.2 +013000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2104.2 +013100 01 CCVS-C-2. SQ2104.2 +013200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +013300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2104.2 +013400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2104.2 +013500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2104.2 +013600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2104.2 +013700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2104.2 +013800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2104.2 +013900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2104.2 +014000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2104.2 +014100 01 INSPECT-COUNTER PIC 999 VALUE 3. SQ2104.2 +014200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2104.2 +014300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2104.2 +014400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2104.2 +014500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2104.2 +014600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2104.2 +014700 01 CCVS-H-1. SQ2104.2 +014800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2104.2 +014900 02 FILLER PICTURE X(67) VALUE SQ2104.2 +015000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2104.2 +015100- " SYSTEM". SQ2104.2 +015200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2104.2 +015300 01 CCVS-H-2. SQ2104.2 +015400 02 FILLER PICTURE X(52) VALUE IS SQ2104.2 +015500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2104.2 +015600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2104.2 +015700 02 TEST-ID PICTURE IS X(9). SQ2104.2 +015800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2104.2 +015900 01 CCVS-H-3. SQ2104.2 +016000 02 FILLER PICTURE X(34) VALUE SQ2104.2 +016100 " FOR OFFICIAL USE ONLY ". SQ2104.2 +016200 02 FILLER PICTURE X(58) VALUE SQ2104.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2104.2 +016400 02 FILLER PICTURE X(28) VALUE SQ2104.2 +016500 " COPYRIGHT 1985 ". SQ2104.2 +016600 01 CCVS-E-1. SQ2104.2 +016700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2104.2 +016800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2104.2 +016900 02 ID-AGAIN PICTURE IS X(9). SQ2104.2 +017000 02 FILLER PICTURE X(45) VALUE IS SQ2104.2 +017100 " NTIS DISTRIBUTION COBOL 85". SQ2104.2 +017200 01 CCVS-E-2. SQ2104.2 +017300 02 FILLER PICTURE X(31) VALUE SQ2104.2 +017400 SPACE. SQ2104.2 +017500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2104.2 +017600 02 CCVS-E-2-2. SQ2104.2 +017700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2104.2 +017800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +017900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2104.2 +018000 01 CCVS-E-3. SQ2104.2 +018100 02 FILLER PICTURE X(22) VALUE SQ2104.2 +018200 " FOR OFFICIAL USE ONLY". SQ2104.2 +018300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2104.2 +018400 02 FILLER PICTURE X(58) VALUE SQ2104.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2104.2 +018600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2104.2 +018700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2104.2 +018800 01 CCVS-E-4. SQ2104.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2104.2 +019000 02 FILLER PIC XXXX VALUE " OF ". SQ2104.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2104.2 +019200 02 FILLER PIC X(40) VALUE SQ2104.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2104.2 +019400 01 XXINFO. SQ2104.2 +019500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2104.2 +019600 02 INFO-TEXT. SQ2104.2 +019700 04 FILLER PIC X(20) VALUE SPACE. SQ2104.2 +019800 04 XXCOMPUTED PIC X(20). SQ2104.2 +019900 04 FILLER PIC X(5) VALUE SPACE. SQ2104.2 +020000 04 XXCORRECT PIC X(20). SQ2104.2 +020100 01 HYPHEN-LINE. SQ2104.2 +020200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +020300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2104.2 +020400- "*****************************************". SQ2104.2 +020500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2104.2 +020600- "******************************". SQ2104.2 +020700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2104.2 +020800 "SQ210M". SQ2104.2 +020900 PROCEDURE DIVISION. SQ2104.2 +021000 CCVS1 SECTION. SQ2104.2 +021100 OPEN-FILES. SQ2104.2 +021200P OPEN I-O RAW-DATA. SQ2104.2 +021300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2104.2 +021400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2104.2 +021500P MOVE "ABORTED " TO C-ABORT. SQ2104.2 +021600P ADD 1 TO C-NO-OF-TESTS. SQ2104.2 +021700P ACCEPT C-DATE FROM DATE. SQ2104.2 +021800P ACCEPT C-TIME FROM TIME. SQ2104.2 +021900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2104.2 +022000PEND-E-1. SQ2104.2 +022100P CLOSE RAW-DATA. SQ2104.2 +022200 OPEN OUTPUT PRINT-FILE. SQ2104.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2104.2 +022400 MOVE SPACE TO TEST-RESULTS. SQ2104.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2104.2 +022600 GO TO CCVS1-EXIT. SQ2104.2 +022700 CLOSE-FILES. SQ2104.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2104.2 +022900P OPEN I-O RAW-DATA. SQ2104.2 +023000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2104.2 +023100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2104.2 +023200P MOVE "OK. " TO C-ABORT. SQ2104.2 +023300P MOVE PASS-COUNTER TO C-OK. SQ2104.2 +023400P MOVE ERROR-HOLD TO C-ALL. SQ2104.2 +023500P MOVE ERROR-COUNTER TO C-FAIL. SQ2104.2 +023600P MOVE DELETE-CNT TO C-DELETED. SQ2104.2 +023700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2104.2 +023800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2104.2 +023900PEND-E-2. SQ2104.2 +024000P CLOSE RAW-DATA. SQ2104.2 +024100 TERMINATE-CCVS. SQ2104.2 +024200S EXIT PROGRAM. SQ2104.2 +024300STERMINATE-CALL. SQ2104.2 +024400 STOP RUN. SQ2104.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2104.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2104.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2104.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2104.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. SQ2104.2 +025000 PRINT-DETAIL. SQ2104.2 +025100 IF REC-CT NOT EQUAL TO ZERO SQ2104.2 +025200 MOVE "." TO PARDOT-X SQ2104.2 +025300 MOVE REC-CT TO DOTVALUE. SQ2104.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2104.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2104.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2104.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2104.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2104.2 +025900 MOVE SPACE TO CORRECT-X. SQ2104.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2104.2 +026100 MOVE SPACE TO RE-MARK. SQ2104.2 +026200 HEAD-ROUTINE. SQ2104.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +026400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2104.2 +026500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2104.2 +026600 COLUMN-NAMES-ROUTINE. SQ2104.2 +026700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +026800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +027000 END-ROUTINE. SQ2104.2 +027100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2104.2 +027200 END-RTN-EXIT. SQ2104.2 +027300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +027400 END-ROUTINE-1. SQ2104.2 +027500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2104.2 +027600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2104.2 +027700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2104.2 +027800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2104.2 +027900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2104.2 +028000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2104.2 +028100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2104.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2104.2 +028300 END-ROUTINE-12. SQ2104.2 +028400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2104.2 +028500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2104.2 +028600 MOVE "NO " TO ERROR-TOTAL SQ2104.2 +028700 ELSE SQ2104.2 +028800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2104.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2104.2 +029000 PERFORM WRITE-LINE. SQ2104.2 +029100 END-ROUTINE-13. SQ2104.2 +029200 IF DELETE-CNT IS EQUAL TO ZERO SQ2104.2 +029300 MOVE "NO " TO ERROR-TOTAL ELSE SQ2104.2 +029400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2104.2 +029500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2104.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +029700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2104.2 +029800 MOVE "NO " TO ERROR-TOTAL SQ2104.2 +029900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2104.2 +030000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2104.2 +030100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +030200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +030300 WRITE-LINE. SQ2104.2 +030400 ADD 1 TO RECORD-COUNT. SQ2104.2 +030500Y IF RECORD-COUNT GREATER 50 SQ2104.2 +030600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2104.2 +030700Y MOVE SPACE TO DUMMY-RECORD SQ2104.2 +030800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2104.2 +030900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2104.2 +031000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2104.2 +031100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2104.2 +031200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2104.2 +031300Y MOVE ZERO TO RECORD-COUNT. SQ2104.2 +031400 PERFORM WRT-LN. SQ2104.2 +031500 WRT-LN. SQ2104.2 +031600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2104.2 +031700 MOVE SPACE TO DUMMY-RECORD. SQ2104.2 +031800 BLANK-LINE-PRINT. SQ2104.2 +031900 PERFORM WRT-LN. SQ2104.2 +032000 FAIL-ROUTINE. SQ2104.2 +032100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2104.2 +032200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2104.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2104.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +032500 GO TO FAIL-ROUTINE-EX. SQ2104.2 +032600 FAIL-ROUTINE-WRITE. SQ2104.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2104.2 +032800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +032900 FAIL-ROUTINE-EX. EXIT. SQ2104.2 +033000 BAIL-OUT. SQ2104.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2104.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2104.2 +033300 BAIL-OUT-WRITE. SQ2104.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2104.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +033600 BAIL-OUT-EX. EXIT. SQ2104.2 +033700 CCVS1-EXIT. SQ2104.2 +033800 EXIT. SQ2104.2 +033900 SECT-SQ210M-0001 SECTION. SQ2104.2 +034000 WRITE-INIT-GF-01. SQ2104.2 +034100 MOVE COMMENT-LINE-1 TO PRINT-REC. SQ2104.2 +034200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2104.2 +034300 MOVE COMMENT-LINE-2 TO PRINT-REC. SQ2104.2 +034400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +034500 WRITE-TEST-GF-01. SQ2104.2 +034600* THIS TEST CHECKS A LINAGE CLAUSE WHICH CONTAINS SQ2104.2 +034700* PHRASES WITH BOTH INTEGER AND DATA NAME ITEMS. SQ2104.2 +034800 MOVE "LINAGE INT / D-N MIX" TO FEATURE. SQ2104.2 +034900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2104.2 +035000 PERFORM PRINT-DETAIL. SQ2104.2 +035100 MOVE COMMENT-LINE-3 TO PRINT-REC. SQ2104.2 +035200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2104.2 +035300 MOVE COMMENT-LINE-4 TO PRINT-REC. SQ2104.2 +035400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +035500 MOVE SPACE TO DUMMY-RECORD. SQ2104.2 +035600 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2104.2 +035700 MOVE 20 TO LINAGE-CTR. SQ2104.2 +035800 MOVE LAST-LINE TO PRINT-REC. SQ2104.2 +035900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2104.2 +036000 MOVE 30 TO LINAGE-CTR. SQ2104.2 +036100 MOVE 1 TO DL1-LINE-NO. SQ2104.2 +036200 PERFORM PRINT-DETAIL-1 80 TIMES. SQ2104.2 +036300 SQ210M-END-ROUTINE. SQ2104.2 +036400 MOVE "END OF SQ210M VALIDATION TESTS" TO PRINT-REC. SQ2104.2 +036500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +036600 GO TO CCVS-EXIT. SQ2104.2 +036700 PRINT-DETAIL-1. SQ2104.2 +036800 MOVE LINAGE-COUNTER TO DL1-LC. SQ2104.2 +036900 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2104.2 +037000 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2104.2 +037100 ADD 1 TO DL1-LINE-NO. SQ2104.2 +037200 CCVS-EXIT SECTION. SQ2104.2 +037300 CCVS-999999. SQ2104.2 +037400 GO TO CLOSE-FILES. SQ2104.2 +*END-OF,SQ210M +*HEADER,COBOL,SQ211A +000100 IDENTIFICATION DIVISION. SQ2114.2 +000200 PROGRAM-ID. SQ2114.2 +000300 SQ211A. SQ2114.2 +000400**************************************************************** SQ2114.2 +000500* * SQ2114.2 +000600* VALIDATION FOR:- * SQ2114.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +000800* USING CCVS85 VERSION 3.0. * SQ2114.2 +000900* * SQ2114.2 +001000* CREATION DATE / VALIDATION DATE * SQ2114.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2114.2 +001200* * SQ2114.2 +001300**************************************************************** SQ2114.2 +001400* * SQ2114.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2114.2 +001600* * SQ2114.2 +001700* X-01 SEQUENTIAL TAPE * SQ2114.2 +001800* X-55 SYSTEM PRINTER * SQ2114.2 +001900* X-82 SOURCE-COMPUTER * SQ2114.2 +002000* X-83 OBJECT-COMPUTER. * SQ2114.2 +002100* X-84 LABEL RECORDS OPTION * SQ2114.2 +002200* * SQ2114.2 +002300**************************************************************** SQ2114.2 +002400* * SQ2114.2 +002500* SQ211A TESTS THE CLOSE STATEMENT WITH THE WITH LOCK PHRASE* SQ2114.2 +002600* A MAGNETIC TAPE FILE WITH ONE RECORD IS CREATED AND IS * SQ2114.2 +002700* CLOSED WITH LOCK. THE FILE IS THEN RE-OPENED AFTER IT HAS* SQ2114.2 +002800* BEEN CLOSED WITH LOCK. THERE ARE NO DECLARATIVE * SQ2114.2 +002900* PROCEDURES. THE TEST FOR CORRECT I-O STATUS CODE IS IN * SQ2114.2 +003000* THE MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ2114.2 +003100* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ2114.2 +003200* ACCOMPLISHED. * SQ2114.2 +003300* * SQ2114.2 +003400**************************************************************** SQ2114.2 +003500* SQ2114.2 +003600 ENVIRONMENT DIVISION. SQ2114.2 +003700 CONFIGURATION SECTION. SQ2114.2 +003800 SOURCE-COMPUTER. SQ2114.2 +003900 XXXXX082. SQ2114.2 +004000 OBJECT-COMPUTER. SQ2114.2 +004100 XXXXX083. SQ2114.2 +004200* SQ2114.2 +004300 INPUT-OUTPUT SECTION. SQ2114.2 +004400 FILE-CONTROL. SQ2114.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2114.2 +004600 XXXXX055. SQ2114.2 +004700* SQ2114.2 +004800 SELECT SQ-FS1 ASSIGN TO SQ2114.2 +004900 XXXXX001 SQ2114.2 +005000 FILE STATUS IS SQ-FS1-STATUS. SQ2114.2 +005100* SQ2114.2 +005200* SQ2114.2 +005300 DATA DIVISION. SQ2114.2 +005400 FILE SECTION. SQ2114.2 +005500 FD PRINT-FILE SQ2114.2 +005600C LABEL RECORDS SQ2114.2 +005700C XXXXX084 SQ2114.2 +005800C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2114.2 +005900 . SQ2114.2 +006000 01 PRINT-REC PICTURE X(120). SQ2114.2 +006100 01 DUMMY-RECORD PICTURE X(120). SQ2114.2 +006200* SQ2114.2 +006300 FD SQ-FS1 SQ2114.2 +006400C LABEL RECORD IS STANDARD SQ2114.2 +006500 . SQ2114.2 +006600 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2114.2 +006700* SQ2114.2 +006800 WORKING-STORAGE SECTION. SQ2114.2 +006900* SQ2114.2 +007000*************************************************************** SQ2114.2 +007100* * SQ2114.2 +007200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2114.2 +007300* * SQ2114.2 +007400*************************************************************** SQ2114.2 +007500* SQ2114.2 +007600 01 SQ-FS1-STATUS. SQ2114.2 +007700 03 SQ-FS1-KEY-1 PIC X. SQ2114.2 +007800 03 SQ-FS1-KEY-2 PIC X. SQ2114.2 +007900* SQ2114.2 +008000*************************************************************** SQ2114.2 +008100* * SQ2114.2 +008200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2114.2 +008300* * SQ2114.2 +008400*************************************************************** SQ2114.2 +008500* SQ2114.2 +008600 01 REC-SKEL-SUB PIC 99. SQ2114.2 +008700* SQ2114.2 +008800 01 FILE-RECORD-INFORMATION-REC. SQ2114.2 +008900 03 FILE-RECORD-INFO-SKELETON. SQ2114.2 +009000 05 FILLER PICTURE X(48) VALUE SQ2114.2 +009100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2114.2 +009200 05 FILLER PICTURE X(46) VALUE SQ2114.2 +009300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2114.2 +009400 05 FILLER PICTURE X(26) VALUE SQ2114.2 +009500 ",LFIL=000000,ORG= ,LBLR= ". SQ2114.2 +009600 05 FILLER PICTURE X(37) VALUE SQ2114.2 +009700 ",RECKEY= ". SQ2114.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2114.2 +009900 ",ALTKEY1= ". SQ2114.2 +010000 05 FILLER PICTURE X(38) VALUE SQ2114.2 +010100 ",ALTKEY2= ". SQ2114.2 +010200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2114.2 +010300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2114.2 +010400 05 FILE-RECORD-INFO-P1-120. SQ2114.2 +010500 07 FILLER PIC X(5). SQ2114.2 +010600 07 XFILE-NAME PIC X(6). SQ2114.2 +010700 07 FILLER PIC X(8). SQ2114.2 +010800 07 XRECORD-NAME PIC X(6). SQ2114.2 +010900 07 FILLER PIC X(1). SQ2114.2 +011000 07 REELUNIT-NUMBER PIC 9(1). SQ2114.2 +011100 07 FILLER PIC X(7). SQ2114.2 +011200 07 XRECORD-NUMBER PIC 9(6). SQ2114.2 +011300 07 FILLER PIC X(6). SQ2114.2 +011400 07 UPDATE-NUMBER PIC 9(2). SQ2114.2 +011500 07 FILLER PIC X(5). SQ2114.2 +011600 07 ODO-NUMBER PIC 9(4). SQ2114.2 +011700 07 FILLER PIC X(5). SQ2114.2 +011800 07 XPROGRAM-NAME PIC X(5). SQ2114.2 +011900 07 FILLER PIC X(7). SQ2114.2 +012000 07 XRECORD-LENGTH PIC 9(6). SQ2114.2 +012100 07 FILLER PIC X(7). SQ2114.2 +012200 07 CHARS-OR-RECORDS PIC X(2). SQ2114.2 +012300 07 FILLER PIC X(1). SQ2114.2 +012400 07 XBLOCK-SIZE PIC 9(4). SQ2114.2 +012500 07 FILLER PIC X(6). SQ2114.2 +012600 07 RECORDS-IN-FILE PIC 9(6). SQ2114.2 +012700 07 FILLER PIC X(5). SQ2114.2 +012800 07 XFILE-ORGANIZATION PIC X(2). SQ2114.2 +012900 07 FILLER PIC X(6). SQ2114.2 +013000 07 XLABEL-TYPE PIC X(1). SQ2114.2 +013100 05 FILE-RECORD-INFO-P121-240. SQ2114.2 +013200 07 FILLER PIC X(8). SQ2114.2 +013300 07 XRECORD-KEY PIC X(29). SQ2114.2 +013400 07 FILLER PIC X(9). SQ2114.2 +013500 07 ALTERNATE-KEY1 PIC X(29). SQ2114.2 +013600 07 FILLER PIC X(9). SQ2114.2 +013700 07 ALTERNATE-KEY2 PIC X(29). SQ2114.2 +013800 07 FILLER PIC X(7). SQ2114.2 +013900* SQ2114.2 +014000 01 TEST-RESULTS. SQ2114.2 +014100 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014200 02 FEATURE PIC X(24) VALUE SPACE. SQ2114.2 +014300 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014400 02 P-OR-F PIC X(5) VALUE SPACE. SQ2114.2 +014500 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014600 02 PAR-NAME. SQ2114.2 +014700 03 FILLER PIC X(14) VALUE SPACE. SQ2114.2 +014800 03 PARDOT-X PIC X VALUE SPACE. SQ2114.2 +014900 03 DOTVALUE PIC 99 VALUE ZERO. SQ2114.2 +015000 02 FILLER PIC X(9) VALUE SPACE. SQ2114.2 +015100 02 RE-MARK PIC X(61). SQ2114.2 +015200 01 TEST-COMPUTED. SQ2114.2 +015300 02 FILLER PIC X(30) VALUE SPACE. SQ2114.2 +015400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2114.2 +015500 02 COMPUTED-X. SQ2114.2 +015600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2114.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2114.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2114.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2114.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2114.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2114.2 +016200 04 COMPUTED-18V0 PIC -9(18). SQ2114.2 +016300 04 FILLER PIC X. SQ2114.2 +016400 03 FILLER PIC X(50) VALUE SPACE. SQ2114.2 +016500 01 TEST-CORRECT. SQ2114.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ2114.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2114.2 +016800 02 CORRECT-X. SQ2114.2 +016900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2114.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2114.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2114.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2114.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2114.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. SQ2114.2 +017500 04 CORRECT-18V0 PIC -9(18). SQ2114.2 +017600 04 FILLER PIC X. SQ2114.2 +017700 03 FILLER PIC X(2) VALUE SPACE. SQ2114.2 +017800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2114.2 +017900 01 CCVS-C-1. SQ2114.2 +018000 02 FILLER PIC IS X(4) VALUE SPACE. SQ2114.2 +018100 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2114.2 +018200- "SS PARAGRAPH-NAME SQ2114.2 +018300- " REMARKS". SQ2114.2 +018400 02 FILLER PIC X(17) VALUE SPACE. SQ2114.2 +018500 01 CCVS-C-2. SQ2114.2 +018600 02 FILLER PIC XXXX VALUE SPACE. SQ2114.2 +018700 02 FILLER PIC X(6) VALUE "TESTED". SQ2114.2 +018800 02 FILLER PIC X(16) VALUE SPACE. SQ2114.2 +018900 02 FILLER PIC X(4) VALUE "FAIL". SQ2114.2 +019000 02 FILLER PIC X(90) VALUE SPACE. SQ2114.2 +019100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2114.2 +019200 01 REC-CT PIC 99 VALUE ZERO. SQ2114.2 +019300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2114.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2114.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2114.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2114.2 +020100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2114.2 +020200 01 CCVS-H-1. SQ2114.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ2114.2 +020400 02 FILLER PIC X(42) VALUE SQ2114.2 +020500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2114.2 +020600 02 FILLER PIC X(39) VALUE SPACES. SQ2114.2 +020700 01 CCVS-H-2A. SQ2114.2 +020800 02 FILLER PIC X(40) VALUE SPACE. SQ2114.2 +020900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2114.2 +021000 02 FILLER PIC XXXX VALUE SQ2114.2 +021100 "4.2 ". SQ2114.2 +021200 02 FILLER PIC X(28) VALUE SQ2114.2 +021300 " COPY - NOT FOR DISTRIBUTION". SQ2114.2 +021400 02 FILLER PIC X(41) VALUE SPACE. SQ2114.2 +021500* SQ2114.2 +021600 01 CCVS-H-2B. SQ2114.2 +021700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2114.2 +021800 02 TEST-ID PIC X(9). SQ2114.2 +021900 02 FILLER PIC X(4) VALUE " IN ". SQ2114.2 +022000 02 FILLER PIC X(12) VALUE SQ2114.2 +022100 " HIGH ". SQ2114.2 +022200 02 FILLER PIC X(22) VALUE SQ2114.2 +022300 " LEVEL VALIDATION FOR ". SQ2114.2 +022400 02 FILLER PIC X(58) VALUE SQ2114.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +022600 01 CCVS-H-3. SQ2114.2 +022700 02 FILLER PIC X(34) VALUE SQ2114.2 +022800 " FOR OFFICIAL USE ONLY ". SQ2114.2 +022900 02 FILLER PIC X(58) VALUE SQ2114.2 +023000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2114.2 +023100 02 FILLER PIC X(28) VALUE SQ2114.2 +023200 " COPYRIGHT 1985,1986 ". SQ2114.2 +023300 01 CCVS-E-1. SQ2114.2 +023400 02 FILLER PIC X(52) VALUE SPACE. SQ2114.2 +023500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2114.2 +023600 02 ID-AGAIN PIC X(9). SQ2114.2 +023700 02 FILLER PIC X(45) VALUE SPACES. SQ2114.2 +023800 01 CCVS-E-2. SQ2114.2 +023900 02 FILLER PIC X(31) VALUE SPACE. SQ2114.2 +024000 02 FILLER PIC X(21) VALUE SPACE. SQ2114.2 +024100 02 CCVS-E-2-2. SQ2114.2 +024200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2114.2 +024300 03 FILLER PIC X VALUE SPACE. SQ2114.2 +024400 03 ENDER-DESC PIC X(44) VALUE SQ2114.2 +024500 "ERRORS ENCOUNTERED". SQ2114.2 +024600 01 CCVS-E-3. SQ2114.2 +024700 02 FILLER PIC X(22) VALUE SQ2114.2 +024800 " FOR OFFICIAL USE ONLY". SQ2114.2 +024900 02 FILLER PIC X(12) VALUE SPACE. SQ2114.2 +025000 02 FILLER PIC X(58) VALUE SQ2114.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +025200 02 FILLER PIC X(8) VALUE SPACE. SQ2114.2 +025300 02 FILLER PIC X(20) VALUE SQ2114.2 +025400 " COPYRIGHT 1985,1986". SQ2114.2 +025500 01 CCVS-E-4. SQ2114.2 +025600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2114.2 +025700 02 FILLER PIC X(4) VALUE " OF ". SQ2114.2 +025800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2114.2 +025900 02 FILLER PIC X(40) VALUE SQ2114.2 +026000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2114.2 +026100 01 XXINFO. SQ2114.2 +026200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2114.2 +026300 02 INFO-TEXT. SQ2114.2 +026400 04 FILLER PIC X(8) VALUE SPACE. SQ2114.2 +026500 04 XXCOMPUTED PIC X(20). SQ2114.2 +026600 04 FILLER PIC X(5) VALUE SPACE. SQ2114.2 +026700 04 XXCORRECT PIC X(20). SQ2114.2 +026800 02 INF-ANSI-REFERENCE PIC X(48). SQ2114.2 +026900 01 HYPHEN-LINE. SQ2114.2 +027000 02 FILLER PIC IS X VALUE IS SPACE. SQ2114.2 +027100 02 FILLER PIC IS X(65) VALUE IS "************************SQ2114.2 +027200- "*****************************************". SQ2114.2 +027300 02 FILLER PIC IS X(54) VALUE IS "************************SQ2114.2 +027400- "******************************". SQ2114.2 +027500 01 CCVS-PGM-ID PIC X(9) VALUE SQ2114.2 +027600 "SQ211A". SQ2114.2 +027700* SQ2114.2 +027800 PROCEDURE DIVISION. SQ2114.2 +027900 CCVS1 SECTION. SQ2114.2 +028000 OPEN-FILES. SQ2114.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2114.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. SQ2114.2 +028300 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2114.2 +028400 MOVE SPACE TO TEST-RESULTS. SQ2114.2 +028500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2114.2 +028600 MOVE ZERO TO REC-SKEL-SUB. SQ2114.2 +028700 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2114.2 +028800 GO TO CCVS1-EXIT. SQ2114.2 +028900* SQ2114.2 +029000 CCVS-INIT-FILE. SQ2114.2 +029100 ADD 1 TO REC-SKL-SUB. SQ2114.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ2114.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ2114.2 +029400* SQ2114.2 +029500 CLOSE-FILES. SQ2114.2 +029600 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2114.2 +029700 CLOSE PRINT-FILE. SQ2114.2 +029800 TERMINATE-CCVS. SQ2114.2 +029900 STOP RUN. SQ2114.2 +030000* SQ2114.2 +030100 INSPT. SQ2114.2 +030200 MOVE "INSPT" TO P-OR-F. SQ2114.2 +030300 ADD 1 TO INSPECT-COUNTER. SQ2114.2 +030400 PERFORM PRINT-DETAIL. SQ2114.2 +030500 SQ2114.2 +030600 PASS. SQ2114.2 +030700 MOVE "PASS " TO P-OR-F. SQ2114.2 +030800 ADD 1 TO PASS-COUNTER. SQ2114.2 +030900 PERFORM PRINT-DETAIL. SQ2114.2 +031000* SQ2114.2 +031100 FAIL. SQ2114.2 +031200 MOVE "FAIL*" TO P-OR-F. SQ2114.2 +031300 ADD 1 TO ERROR-COUNTER. SQ2114.2 +031400 PERFORM PRINT-DETAIL. SQ2114.2 +031500* SQ2114.2 +031600 DE-LETE. SQ2114.2 +031700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2114.2 +031800 MOVE "*****" TO P-OR-F. SQ2114.2 +031900 ADD 1 TO DELETE-COUNTER. SQ2114.2 +032000 PERFORM PRINT-DETAIL. SQ2114.2 +032100* SQ2114.2 +032200 PRINT-DETAIL. SQ2114.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ2114.2 +032400 MOVE "." TO PARDOT-X SQ2114.2 +032500 MOVE REC-CT TO DOTVALUE. SQ2114.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. SQ2114.2 +032700 PERFORM WRITE-LINE. SQ2114.2 +032800 IF P-OR-F EQUAL TO "FAIL*" SQ2114.2 +032900 PERFORM WRITE-LINE SQ2114.2 +033000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2114.2 +033100 ELSE SQ2114.2 +033200 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2114.2 +033300 MOVE SPACE TO P-OR-F. SQ2114.2 +033400 MOVE SPACE TO COMPUTED-X. SQ2114.2 +033500 MOVE SPACE TO CORRECT-X. SQ2114.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2114.2 +033700 MOVE SPACE TO RE-MARK. SQ2114.2 +033800* SQ2114.2 +033900 HEAD-ROUTINE. SQ2114.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +034400 COLUMN-NAMES-ROUTINE. SQ2114.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +034800 END-ROUTINE. SQ2114.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2114.2 +035000 PERFORM WRITE-LINE 5 TIMES. SQ2114.2 +035100 END-RTN-EXIT. SQ2114.2 +035200 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2114.2 +035300 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +035400* SQ2114.2 +035500 END-ROUTINE-1. SQ2114.2 +035600 ADD ERROR-COUNTER TO ERROR-HOLD SQ2114.2 +035700 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2114.2 +035800 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2114.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2114.2 +036000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2114.2 +036100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2114.2 +036200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2114.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2114.2 +036400 PERFORM WRITE-LINE. SQ2114.2 +036500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2114.2 +036600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2114.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +036800 ELSE SQ2114.2 +036900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2114.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2114.2 +037100 PERFORM WRITE-LINE. SQ2114.2 +037200 END-ROUTINE-13. SQ2114.2 +037300 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2114.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +037500 ELSE SQ2114.2 +037600 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2114.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2114.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2114.2 +037900 PERFORM WRITE-LINE. SQ2114.2 +038000 IF INSPECT-COUNTER EQUAL TO ZERO SQ2114.2 +038100 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +038200 ELSE SQ2114.2 +038300 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2114.2 +038400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2114.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +038600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +038700* SQ2114.2 +038800 WRITE-LINE. SQ2114.2 +038900 ADD 1 TO RECORD-COUNT. SQ2114.2 +039000Y IF RECORD-COUNT GREATER 50 SQ2114.2 +039100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2114.2 +039200Y MOVE SPACE TO DUMMY-RECORD SQ2114.2 +039300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2114.2 +039400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2114.2 +039500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2114.2 +039600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2114.2 +039700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2114.2 +039800Y MOVE ZERO TO RECORD-COUNT. SQ2114.2 +039900 PERFORM WRT-LN. SQ2114.2 +040000* SQ2114.2 +040100 WRT-LN. SQ2114.2 +040200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2114.2 +040300 MOVE SPACE TO DUMMY-RECORD. SQ2114.2 +040400 BLANK-LINE-PRINT. SQ2114.2 +040500 PERFORM WRT-LN. SQ2114.2 +040600 FAIL-ROUTINE. SQ2114.2 +040700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2114.2 +040800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2114.2 +040900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2114.2 +041000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2114.2 +041100 MOVE XXINFO TO DUMMY-RECORD. SQ2114.2 +041200 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +041300 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2114.2 +041400 GO TO FAIL-ROUTINE-EX. SQ2114.2 +041500 FAIL-ROUTINE-WRITE. SQ2114.2 +041600 MOVE TEST-COMPUTED TO PRINT-REC SQ2114.2 +041700 PERFORM WRITE-LINE SQ2114.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2114.2 +041900 MOVE TEST-CORRECT TO PRINT-REC SQ2114.2 +042000 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +042100 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2114.2 +042200 FAIL-ROUTINE-EX. SQ2114.2 +042300 EXIT. SQ2114.2 +042400 BAIL-OUT. SQ2114.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2114.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2114.2 +042700 BAIL-OUT-WRITE. SQ2114.2 +042800 MOVE CORRECT-A TO XXCORRECT. SQ2114.2 +042900 MOVE COMPUTED-A TO XXCOMPUTED. SQ2114.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2114.2 +043100 MOVE XXINFO TO DUMMY-RECORD. SQ2114.2 +043200 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +043300 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2114.2 +043400 BAIL-OUT-EX. SQ2114.2 +043500 EXIT. SQ2114.2 +043600 CCVS1-EXIT. SQ2114.2 +043700 EXIT. SQ2114.2 +043800* SQ2114.2 +043900**************************************************************** SQ2114.2 +044000* * SQ2114.2 +044100* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2114.2 +044200* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2114.2 +044300* * SQ2114.2 +044400**************************************************************** SQ2114.2 +044500* SQ2114.2 +044600 SECT-SQ211A-0001 SECTION. SQ2114.2 +044700 WRITE-INIT-GF-01. SQ2114.2 +044800* SQ2114.2 +044900* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ2114.2 +045000* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2114.2 +045100* SQ2114.2 +045200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2114.2 +045300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2114.2 +045400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2114.2 +045500 MOVE 120 TO XRECORD-LENGTH (1). SQ2114.2 +045600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2114.2 +045700 MOVE 1 TO XBLOCK-SIZE (1). SQ2114.2 +045800 MOVE 1 TO RECORDS-IN-FILE (1). SQ2114.2 +045900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2114.2 +046000 MOVE "S" TO XLABEL-TYPE (1). SQ2114.2 +046100 MOVE 1 TO XRECORD-NUMBER (1). SQ2114.2 +046200* SQ2114.2 +046300 WRITE-OPEN-01. SQ2114.2 +046400 MOVE 1 TO REC-CT. SQ2114.2 +046500 MOVE "WRITE-OPEN-01" TO PAR-NAME. SQ2114.2 +046600 MOVE "OPEN OUTPUT - NEW FILE" TO FEATURE. SQ2114.2 +046700 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +046800 OPEN OUTPUT SQ-FS1. SQ2114.2 +046900 IF SQ-FS1-STATUS = "00" SQ2114.2 +047000 PERFORM PASS SQ2114.2 +047100 ELSE SQ2114.2 +047200 MOVE "00" TO CORRECT-A SQ2114.2 +047300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +047400 MOVE "FILE OPEN FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +047500 TO RE-MARK SQ2114.2 +047600 MOVE "VII-3, VII-40, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +047700 PERFORM FAIL SQ2114.2 +047800 GO TO CCVS-EXIT SQ2114.2 +047900 END-IF. SQ2114.2 +048000* SQ2114.2 +048100* WRITE A SINGLE RECORD TO THE FILE SQ2114.2 +048200* SQ2114.2 +048300 WRITE-INIT-01. SQ2114.2 +048400 MOVE 1 TO REC-CT. SQ2114.2 +048500 MOVE "WRITE-TEST-01" TO PAR-NAME SQ2114.2 +048600 MOVE "SEQUENTIAL WRITE" TO FEATURE. SQ2114.2 +048700 WRITE-TEST-01-01. SQ2114.2 +048800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2114.2 +048900 WRITE SQ-FS1R1-F-G-120. SQ2114.2 +049000 IF SQ-FS1-STATUS = "00" SQ2114.2 +049100 PERFORM PASS SQ2114.2 +049200 ELSE SQ2114.2 +049300 MOVE "00" TO CORRECT-A SQ2114.2 +049400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +049500 MOVE "WRITING FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +049600 TO RE-MARK SQ2114.2 +049700 MOVE "VII-3, VII-53, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +049800 PERFORM FAIL SQ2114.2 +049900 GO TO CCVS-EXIT SQ2114.2 +050000 END-IF. SQ2114.2 +050100* SQ2114.2 +050200* CLOSE THE FILE WITH LOCK, SO IT SHOULD NOT REOPEN SQ2114.2 +050300* SQ2114.2 +050400 CLOSE-INIT-01. SQ2114.2 +050500 MOVE 1 TO REC-CT. SQ2114.2 +050600 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ2114.2 +050700 MOVE "CLOSE WITH LOCK" TO FEATURE. SQ2114.2 +050800 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +050900 CLOSE-TEST-01. SQ2114.2 +051000 CLOSE SQ-FS1 WITH LOCK. SQ2114.2 +051100 IF SQ-FS1-STATUS = "00" SQ2114.2 +051200 PERFORM PASS SQ2114.2 +051300 ELSE SQ2114.2 +051400 MOVE "00" TO CORRECT-A SQ2114.2 +051500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +051600 MOVE "CLOSE WITH LOCK FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +051700 TO RE-MARK SQ2114.2 +051800 MOVE "VII-3, VII-38, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +051900 PERFORM FAIL SQ2114.2 +052000 GO TO CCVS-EXIT SQ2114.2 +052100 END-IF. SQ2114.2 +052200* SQ2114.2 +052300* HAVING LOCKED THE FILE, WE NOW TRY TO REOPEN IT. SQ2114.2 +052400* THE TEST PASSES IF THE FILE CANNOT BE OPENED AND SQ2114.2 +052500* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ2114.2 +052600* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF THE SQ2114.2 +052700* PROGRAM ON EXIT FROM THE DECLARATIVE ASSOCIATED SQ2114.2 +052800* WITH THE FILE, OR MAY RETURN CONTROL TO THE SQ2114.2 +052900* STATEMENT FOLLOWING THE OPEN STATEMENT. SQ2114.2 +053000* SQ2114.2 +053100 OPEN-INIT-01. SQ2114.2 +053200* SQ2114.2 +053300 MOVE "OPEN AFTER LOCK" TO FEATURE. SQ2114.2 +053400 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +053500 OPEN-TEST-01. SQ2114.2 +053600 MOVE 1 TO REC-CT. SQ2114.2 +053700 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ2114.2 +053800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2114.2 +053900 TO DUMMY-RECORD. SQ2114.2 +054000 PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +054100 OPEN INPUT SQ-FS1. SQ2114.2 +054200 IF SQ-FS1-STATUS = "38" SQ2114.2 +054300 PERFORM PASS SQ2114.2 +054400 ELSE SQ2114.2 +054500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +054600 MOVE "38" TO CORRECT-A SQ2114.2 +054700 MOVE "STATUS OF OPEN AFTER CLOSE WITH LOCK INCORRECT" SQ2114.2 +054800 TO RE-MARK SQ2114.2 +054900 PERFORM FAIL SQ2114.2 +055000 END-IF. SQ2114.2 +055100* SQ2114.2 +055200 CCVS-EXIT SECTION. SQ2114.2 +055300 CCVS-999999. SQ2114.2 +055400 GO TO CLOSE-FILES. SQ2114.2 +*END-OF,SQ211A +*HEADER,COBOL,SQ212A +000100 IDENTIFICATION DIVISION. SQ2124.2 +000200 PROGRAM-ID. SQ2124.2 +000300 SQ212A. SQ2124.2 +000400**************************************************************** SQ2124.2 +000500* * SQ2124.2 +000600* VALIDATION FOR:- * SQ2124.2 +000700* " HIGH ". SQ2124.2 +000800* * SQ2124.2 +000900* CREATION DATE / VALIDATION DATE * SQ2124.2 +001000* "4.2 ". SQ2124.2 +001100* * SQ2124.2 +001200* THIS ROUTINE CHECKS THE SQ2124.2 +001300* FILE STATUS VALUE 44 (BOUNDARY VIOLATION) SQ2124.2 +001400* SQ2124.2 +001500* FOR: WRITE SMALLER OR LAGER RECORDS SQ2124.2 +001600* AND: REWRITE SMALLER OR LAGER RECORDS SQ2124.2 +001700* SQ2124.2 +001800* FOR A FILE WITH VARIABLE LENGTH RECORDS FOLLOWING: SQ2124.2 +001900* SQ2124.2 +002000* RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2124.2 +002100* DEPENDING ON DATA-NAME-1. SQ2124.2 +002200* SQ2124.2 +002300* AN ATTEMPT IS MADE TO WRITE 3 SMALLER RECORDS. THEN 2031 SQ2124.2 +002400* RECORDS SHOULD BE WRITTEN AND THEN FUTHER 9 LARGER RECORDS SQ2124.2 +002500* SHOULD CAUSE A BOUNDARY VIOLATION WITH STATUS CODE 44. SQ2124.2 +002600* THEN THE FILE IS CLOSED AND OPENED AGAIN FOR INPUT. SQ2124.2 +002700* 2031 RECORDS WILL BE READ. THEN THE RECORD NO 2031 IS TRIED SQ2124.2 +002800* BE READ. THIS READ STATEMENT MUST CAUSE THE AT END SQ2124.2 +002900* CONDITION. IF THERE IS ANOTHER RECORD, IT DOES MEAN THAT SQ2124.2 +003000* EITHER A SMALLER OR A LARGER RECORD HAVE BEEN WRITTEN. SQ2124.2 +003100* (SEE VII-5; 1.3.7 AND VII-54; GR (13) ). SQ2124.2 +003200* SQ2124.2 +003300* SQ2124.2 +003400* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE WHICH SQ2124.2 +003500* CONTAINS 2031 RECORDS OF A LENGTH OF 18 TO 2048 CHARACTERS. SQ2124.2 +003600* THE MASS STORAGE FILE IS READ AND FIELDS IN THE RECORDS ARE SQ2124.2 +003700* CHECKED AGAINST THE EXPECTED VALUES. SQ2124.2 +003800* SQ2124.2 +003900 ENVIRONMENT DIVISION. SQ2124.2 +004000 CONFIGURATION SECTION. SQ2124.2 +004100 SOURCE-COMPUTER. SQ2124.2 +004200 XXXXX082. SQ2124.2 +004300 OBJECT-COMPUTER. SQ2124.2 +004400 XXXXX083. SQ2124.2 +004500 INPUT-OUTPUT SECTION. SQ2124.2 +004600 FILE-CONTROL. SQ2124.2 +004700P SELECT RAW-DATA ASSIGN TO SQ2124.2 +004800P XXXXX062 SQ2124.2 +004900P ORGANIZATION IS INDEXED SQ2124.2 +005000P ACCESS MODE IS RANDOM SQ2124.2 +005100P RECORD KEY IS RAW-DATA-KEY. SQ2124.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ2124.2 +005300 XXXXX055. SQ2124.2 +005400 SELECT SQ-VS7 ASSIGN TO SQ2124.2 +005500 XXXXX014 SQ2124.2 +005600 ORGANIZATION SEQUENTIAL SQ2124.2 +005700 ACCESS SEQUENTIAL SQ2124.2 +005800 STATUS IS SQ-VS7-STATUS. SQ2124.2 +005900 DATA DIVISION. SQ2124.2 +006000 FILE SECTION. SQ2124.2 +006100P SQ2124.2 +006200PFD RAW-DATA. SQ2124.2 +006300P SQ2124.2 +006400P01 RAW-DATA-SATZ. SQ2124.2 +006500P 05 RAW-DATA-KEY PIC X(6). SQ2124.2 +006600P 05 C-DATE PIC 9(6). SQ2124.2 +006700P 05 C-TIME PIC 9(8). SQ2124.2 +006800P 05 C-NO-OF-TESTS PIC 99. SQ2124.2 +006900P 05 C-OK PIC 999. SQ2124.2 +007000P 05 C-ALL PIC 999. SQ2124.2 +007100P 05 C-FAIL PIC 999. SQ2124.2 +007200P 05 C-DELETED PIC 999. SQ2124.2 +007300P 05 C-INSPECT PIC 999. SQ2124.2 +007400P 05 C-NOTE PIC X(13). SQ2124.2 +007500P 05 C-INDENT PIC X. SQ2124.2 +007600P 05 C-ABORT PIC X(8). SQ2124.2 +007700 FD PRINT-FILE SQ2124.2 +007800C LABEL RECORDS SQ2124.2 +007900C XXXXX084 SQ2124.2 +008000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2124.2 +008100 . SQ2124.2 +008200 01 PRINT-REC PICTURE X(120). SQ2124.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ2124.2 +008400 FD SQ-VS7 SQ2124.2 +008500C LABEL RECORDS ARE STANDARD SQ2124.2 +008600 RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2124.2 +008700 DEPENDING ON RECORD-LENGTH. SQ2124.2 +008800 01 SQ-VSR7R1-M-G-2048. SQ2124.2 +008900 02 SQ-VS7R1-FIRST PICTURE X(2048). SQ2124.2 +009000 WORKING-STORAGE SECTION. SQ2124.2 +009100 01 SWITCH-WRITE-REWRITE PICTURE 9 VALUE ZERO. SQ2124.2 +009200 01 RECORD-LENGTH PICTURE 9999 VALUE ZERO. SQ2124.2 +009300 01 SQ-VS7-STATUS PICTURE XX VALUE SPACES. SQ2124.2 +009400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2124.2 +009500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2124.2 +009600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL SQ2124.2 +009700 VALUE ZERO. SQ2124.2 +009800 01 ERROR-FLAG PICTURE 9. SQ2124.2 +009900 01 EOF-FLAG PICTURE 9. SQ2124.2 +010000 01 DUMP-AREA. SQ2124.2 +010100 02 TYPE-OF-REC PICTURE X(5). SQ2124.2 +010200 02 RECNO PICTURE 9(5). SQ2124.2 +010300 02 REC-FILLER PICTURE X(21). SQ2124.2 +010400 02 REC-FILLER PICTURE X(21). SQ2124.2 +010500 01 VAR-RECORD-18-2048. SQ2124.2 +010600 05 FILLER PIC X(13) VALUE "SQ-VS7LENGTH=". SQ2124.2 +010700 05 RECORD-NUMBER PIC 9999 VALUE ZERO. SQ2124.2 +010800 05 FILLER PIC X(100) VALUE SQ2124.2 +010900 "........10........20........30........40........50........60SQ2124.2 +011000- "........70........80........90.......100". SQ2124.2 +011100 05 FILLER PIC X(100) VALUE SQ2124.2 +011200 ".......110.......120.......130.......140.......150.......160SQ2124.2 +011300- ".......170.......180.......190.......200". SQ2124.2 +011400 05 FILLER PIC X(100) VALUE SQ2124.2 +011500 ".......210.......220.......230.......240.......250.......260SQ2124.2 +011600- ".......270.......280.......290.......300". SQ2124.2 +011700 05 FILLER PIC X(100) VALUE SQ2124.2 +011800 ".......310.......320.......330.......340.......350.......360SQ2124.2 +011900- ".......370.......380.......390.......400". SQ2124.2 +012000 05 FILLER PIC X(100) VALUE SQ2124.2 +012100 ".......410.......420.......430.......440.......450.......460SQ2124.2 +012200- ".......470.......480.......490.......500". SQ2124.2 +012300 05 FILLER PIC X(100) VALUE SQ2124.2 +012400 ".......510.......520.......530.......540.......550.......560SQ2124.2 +012500- ".......570.......580.......590.......600". SQ2124.2 +012600 05 FILLER PIC X(100) VALUE SQ2124.2 +012700 ".......610.......620.......630.......640.......650.......660SQ2124.2 +012800- ".......670.......680.......690.......700". SQ2124.2 +012900 05 FILLER PIC X(100) VALUE SQ2124.2 +013000 ".......710.......720.......730.......740.......750.......760SQ2124.2 +013100- ".......770.......780.......790.......800". SQ2124.2 +013200 05 FILLER PIC X(100) VALUE SQ2124.2 +013300 ".......810.......820.......830.......840.......850.......860SQ2124.2 +013400- ".......870.......880.......890.......900". SQ2124.2 +013500 05 FILLER PIC X(100) VALUE SQ2124.2 +013600 ".......910.......920.......930.......940.......950.......960SQ2124.2 +013700- ".......970.......980.......990......1000". SQ2124.2 +013800 05 FILLER PIC X(100) VALUE SQ2124.2 +013900 "......1010......1020......1030......1040......1050......1060SQ2124.2 +014000- "......1070......1080......1090......1100". SQ2124.2 +014100 05 FILLER PIC X(100) VALUE SQ2124.2 +014200 "......1110......1120......1130......1140......1150......1160SQ2124.2 +014300- "......1170......1180......1190......1200". SQ2124.2 +014400 05 FILLER PIC X(100) VALUE SQ2124.2 +014500 "......1210......1220......1230......1240......1250......1260SQ2124.2 +014600- ".......270.......280.......290.......300". SQ2124.2 +014700 05 FILLER PIC X(100) VALUE SQ2124.2 +014800 "......1310......1320......1330......1340......1350......1360SQ2124.2 +014900- "......1370......1380......1390......1400". SQ2124.2 +015000 05 FILLER PIC X(100) VALUE SQ2124.2 +015100 "......1410......1420......1430......1440......1450......1460SQ2124.2 +015200- "......1470......1480......1490......1500". SQ2124.2 +015300 05 FILLER PIC X(100) VALUE SQ2124.2 +015400 "......1510......1520......1530......1540......1550......1560SQ2124.2 +015500- "......1570......1580......1590......1600". SQ2124.2 +015600 05 FILLER PIC X(100) VALUE SQ2124.2 +015700 "......1610......1620......1630......1640......1650......1660SQ2124.2 +015800- "......1670......1680......1690......1700". SQ2124.2 +015900 05 FILLER PIC X(100) VALUE SQ2124.2 +016000 "......1710......1720......1730......1740......1750......1760SQ2124.2 +016100- "......1770......1780......1790......1800". SQ2124.2 +016200 05 FILLER PIC X(100) VALUE SQ2124.2 +016300 "......1810......1820......1830......1840......1850......1860SQ2124.2 +016400- "......1870......1880......1890......1900". SQ2124.2 +016500 05 FILLER PIC X(100) VALUE SQ2124.2 +016600 "......1910......1920......1930......1940......1950......1960SQ2124.2 +016700- "......1970......1980......1990......2000". SQ2124.2 +016800 05 FILLER PIC X(100) VALUE SQ2124.2 +016900 "......2010......2020......2030......2040....,...". SQ2124.2 +017000 01 TEST-RESULTS. SQ2124.2 +017100 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2124.2 +017300 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2124.2 +017500 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017600 02 PAR-NAME. SQ2124.2 +017700 03 FILLER PICTURE X(12) VALUE SPACE. SQ2124.2 +017800 03 PARDOT-X PICTURE X VALUE SPACE. SQ2124.2 +017900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2124.2 +018000 03 FILLER PIC X(5) VALUE SPACE. SQ2124.2 +018100 02 FILLER PIC X(10) VALUE SPACE. SQ2124.2 +018200 02 RE-MARK PIC X(61). SQ2124.2 +018300 01 TEST-COMPUTED. SQ2124.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ2124.2 +018500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2124.2 +018600 02 COMPUTED-X. SQ2124.2 +018700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2124.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2124.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2124.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2124.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2124.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. SQ2124.2 +019300 04 COMPUTED-18V0 PICTURE -9(18). SQ2124.2 +019400 04 FILLER PICTURE X. SQ2124.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ2124.2 +019600 01 TEST-CORRECT. SQ2124.2 +019700 02 FILLER PIC X(30) VALUE SPACE. SQ2124.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2124.2 +019900 02 CORRECT-X. SQ2124.2 +020000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2124.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2124.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2124.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2124.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2124.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. SQ2124.2 +020600 04 CORRECT-18V0 PICTURE -9(18). SQ2124.2 +020700 04 FILLER PICTURE X. SQ2124.2 +020800 03 FILLER PIC X(50) VALUE SPACE. SQ2124.2 +020900 01 CCVS-C-1. SQ2124.2 +021000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2124.2 +021100- "SS PARAGRAPH-NAME SQ2124.2 +021200- " REMARKS". SQ2124.2 +021300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2124.2 +021400 01 CCVS-C-2. SQ2124.2 +021500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +021600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2124.2 +021700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2124.2 +021800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2124.2 +021900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2124.2 +022000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2124.2 +022100 01 REC-CT PICTURE 99 VALUE ZERO. SQ2124.2 +022200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2124.2 +022300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2124.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2124.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2124.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2124.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2124.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2124.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2124.2 +023000 01 CCVS-H-1. SQ2124.2 +023100 02 FILLER PICTURE X(27) VALUE SPACE. SQ2124.2 +023200 02 FILLER PICTURE X(67) VALUE SQ2124.2 +023300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2124.2 +023400- " SYSTEM". SQ2124.2 +023500 02 FILLER PICTURE X(26) VALUE SPACE. SQ2124.2 +023600 01 CCVS-H-2. SQ2124.2 +023700 02 FILLER PICTURE X(52) VALUE IS SQ2124.2 +023800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2124.2 +023900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2124.2 +024000 02 TEST-ID PICTURE IS X(9). SQ2124.2 +024100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2124.2 +024200 01 CCVS-H-3. SQ2124.2 +024300 02 FILLER PICTURE X(34) VALUE SQ2124.2 +024400 " FOR OFFICIAL USE ONLY ". SQ2124.2 +024500 02 FILLER PICTURE X(58) VALUE SQ2124.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2124.2 +024700 02 FILLER PICTURE X(28) VALUE SQ2124.2 +024800 " COPYRIGHT 1985 ". SQ2124.2 +024900 01 CCVS-E-1. SQ2124.2 +025000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2124.2 +025100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2124.2 +025200 02 ID-AGAIN PICTURE IS X(9). SQ2124.2 +025300 02 FILLER PICTURE X(45) VALUE IS SQ2124.2 +025400 " NTIS DISTRIBUTION COBOL 85". SQ2124.2 +025500 01 CCVS-E-2. SQ2124.2 +025600 02 FILLER PICTURE X(31) VALUE SQ2124.2 +025700 SPACE. SQ2124.2 +025800 02 FILLER PICTURE X(21) VALUE SPACE. SQ2124.2 +025900 02 CCVS-E-2-2. SQ2124.2 +026000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2124.2 +026100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +026200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2124.2 +026300 01 CCVS-E-3. SQ2124.2 +026400 02 FILLER PICTURE X(22) VALUE SQ2124.2 +026500 " FOR OFFICIAL USE ONLY". SQ2124.2 +026600 02 FILLER PICTURE X(12) VALUE SPACE. SQ2124.2 +026700 02 FILLER PICTURE X(58) VALUE SQ2124.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2124.2 +026900 02 FILLER PICTURE X(13) VALUE SPACE. SQ2124.2 +027000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2124.2 +027100 01 CCVS-E-4. SQ2124.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2124.2 +027300 02 FILLER PIC XXXX VALUE " OF ". SQ2124.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2124.2 +027500 02 FILLER PIC X(40) VALUE SQ2124.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2124.2 +027700 01 XXINFO. SQ2124.2 +027800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2124.2 +027900 02 INFO-TEXT. SQ2124.2 +028000 04 FILLER PIC X(20) VALUE SPACE. SQ2124.2 +028100 04 XXCOMPUTED PIC X(20). SQ2124.2 +028200 04 FILLER PIC X(5) VALUE SPACE. SQ2124.2 +028300 04 XXCORRECT PIC X(20). SQ2124.2 +028400 01 HYPHEN-LINE. SQ2124.2 +028500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +028600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2124.2 +028700- "*****************************************". SQ2124.2 +028800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2124.2 +028900- "******************************". SQ2124.2 +029000 01 CCVS-PGM-ID PIC X(6) VALUE SQ2124.2 +029100 "SQ212A". SQ2124.2 +029200 PROCEDURE DIVISION. SQ2124.2 +029300 DECLARATIVES. SQ2124.2 +029400 SECT-SQ212A-0001 SECTION. SQ2124.2 +029500 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-VS7. SQ2124.2 +029600 TEST-STATUS-44-00. SQ2124.2 +029700 IF SWITCH-WRITE-REWRITE = 1 SQ2124.2 +029800 GO TO TEST-STATUS-44-0. SQ2124.2 +029900 GO TO TEST-STATUS-44-1-0. SQ2124.2 +030000 TEST-STATUS-44-0. SQ2124.2 +030100 IF SQ-VS7-STATUS = "44" SQ2124.2 +030200 GO TO TEST-STATUS-44-PASS. SQ2124.2 +030300 TEST-STATUS-44-FAIL. SQ2124.2 +030400 MOVE "VII-4 (3) D. 1)" TO RE-MARK. SQ2124.2 +030500 PERFORM FAIL1. SQ2124.2 +030600 MOVE SQ-VS7-STATUS TO COMPUTED-A. SQ2124.2 +030700 MOVE "44" TO CORRECT-A. SQ2124.2 +030800 GO TO TEST-STATUS-44-WRITE. SQ2124.2 +030900 TEST-STATUS-44-PASS. SQ2124.2 +031000 PERFORM PASS1. SQ2124.2 +031100 TEST-STATUS-44-WRITE. SQ2124.2 +031200 MOVE "DECL-STATUS-44-0" TO PAR-NAME. SQ2124.2 +031300 PERFORM PRINT-DETAIL1. SQ2124.2 +031400 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +031500 GO TO EXIT-PARA. SQ2124.2 +031600 TEST-STATUS-44-1-0. SQ2124.2 +031700 IF SQ-VS7-STATUS = "44" SQ2124.2 +031800 GO TO TEST-STATUS-44-1-PASS. SQ2124.2 +031900 TEST-STATUS-44-1-FAIL. SQ2124.2 +032000 MOVE "VII-4 (3) D. 1)" TO RE-MARK. SQ2124.2 +032100 PERFORM FAIL1. SQ2124.2 +032200 MOVE SQ-VS7-STATUS TO COMPUTED-A. SQ2124.2 +032300 MOVE "44" TO CORRECT-A. SQ2124.2 +032400 GO TO TEST-STATUS-44-1-WRITE. SQ2124.2 +032500 TEST-STATUS-44-1-PASS. SQ2124.2 +032600 PERFORM PASS1. SQ2124.2 +032700 TEST-STATUS-44-1-WRITE. SQ2124.2 +032800* RWRT SHORTER & LONGER SQ2124.2 +032900 PERFORM PRINT-DETAIL1. SQ2124.2 +033000 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +033100 GO TO EXIT-PARA. SQ2124.2 +033200 PASS1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2124.2 +033300 FAIL1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2124.2 +033400 PRINT-DETAIL1. SQ2124.2 +033500 IF REC-CT NOT EQUAL TO ZERO SQ2124.2 +033600 MOVE "." TO PARDOT-X SQ2124.2 +033700 MOVE REC-CT TO DOTVALUE. SQ2124.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE1. SQ2124.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE1 SQ2124.2 +034000 PERFORM FAIL-ROUTINE1 THRU FAIL-ROUTINE-EX1 SQ2124.2 +034100 ELSE PERFORM BAIL-OUT1 THRU BAIL-OUT-EX1. SQ2124.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2124.2 +034300 MOVE SPACE TO CORRECT-X. SQ2124.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2124.2 +034500 MOVE SPACE TO RE-MARK. SQ2124.2 +034600 END-ROUTINE1. SQ2124.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2124.2 +034800 PERFORM WRITE-LINE1 5 TIMES. SQ2124.2 +034900 END-RTN1-EXIT. SQ2124.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +035100 END-ROUTINE1-1. SQ2124.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2124.2 +035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2124.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2124.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE1-12. SQ2124.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2124.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2124.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2124.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE1. SQ2124.2 +036000 END-ROUTINE1-12. SQ2124.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2124.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2124.2 +036300 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +036400 ELSE SQ2124.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2124.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2124.2 +036700 PERFORM WRITE-LINE1. SQ2124.2 +036800 END-ROUTINE1-13. SQ2124.2 +036900 IF DELETE-CNT IS EQUAL TO ZERO SQ2124.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2124.2 +037100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2124.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2124.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2124.2 +037500 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2124.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2124.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +038000 WRITE-LINE1. SQ2124.2 +038100 ADD 1 TO RECORD-COUNT. SQ2124.2 +038200Y IF RECORD-COUNT GREATER 50 SQ2124.2 +038300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2124.2 +038400Y MOVE SPACE TO DUMMY-RECORD SQ2124.2 +038500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2124.2 +038600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN1 SQ2124.2 +038700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN1 2 TIMES SQ2124.2 +038800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN1 SQ2124.2 +038900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2124.2 +039000Y MOVE ZERO TO RECORD-COUNT. SQ2124.2 +039100 PERFORM WRT-LN1. SQ2124.2 +039200 WRT-LN1. SQ2124.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2124.2 +039400 MOVE SPACE TO DUMMY-RECORD. SQ2124.2 +039500 FAIL-ROUTINE1. SQ2124.2 +039600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE1. SQ2124.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE1. SQ2124.2 +039800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2124.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +040000 GO TO FAIL-ROUTINE-EX1. SQ2124.2 +040100 FAIL-ROUTINE-WRITE1. SQ2124.2 +040200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE1 SQ2124.2 +040300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +040400 FAIL-ROUTINE-EX1. EXIT. SQ2124.2 +040500 BAIL-OUT1. SQ2124.2 +040600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE1. SQ2124.2 +040700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX1. SQ2124.2 +040800 BAIL-OUT-WRITE1. SQ2124.2 +040900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2124.2 +041000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +041100 BAIL-OUT-EX1. EXIT. SQ2124.2 +041200 EXIT-PARA. SQ2124.2 +041300 EXIT. SQ2124.2 +041400 CLOSE-FILES1. SQ2124.2 +041500 PERFORM END-ROUTINE1 THRU END-ROUTINE1-13. CLOSE PRINT-FILE. SQ2124.2 +041600P OPEN I-O RAW-DATA. SQ2124.2 +041700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +041800P READ RAW-DATA INVALID KEY GO TO END1-E-2. SQ2124.2 +041900P MOVE "OK. " TO C-ABORT. SQ2124.2 +042000P MOVE PASS-COUNTER TO C-OK. SQ2124.2 +042100P MOVE ERROR-HOLD TO C-ALL. SQ2124.2 +042200P MOVE ERROR-COUNTER TO C-FAIL. SQ2124.2 +042300P MOVE DELETE-CNT TO C-DELETED. SQ2124.2 +042400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2124.2 +042500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END1-E-2. SQ2124.2 +042600PEND1-E-2. SQ2124.2 +042700P CLOSE RAW-DATA. SQ2124.2 +042800 TERMINATE1-CCVS. SQ2124.2 +042900S EXIT PROGRAM. SQ2124.2 +043000STERMINATE1-CALL. SQ2124.2 +043100 STOP RUN. SQ2124.2 +043200 END DECLARATIVES. SQ2124.2 +043300 CCVS1 SECTION. SQ2124.2 +043400 OPEN-FILES. SQ2124.2 +043500P OPEN I-O RAW-DATA. SQ2124.2 +043600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +043700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2124.2 +043800P MOVE "ABORTED " TO C-ABORT. SQ2124.2 +043900P ADD 1 TO C-NO-OF-TESTS. SQ2124.2 +044000P ACCEPT C-DATE FROM DATE. SQ2124.2 +044100P ACCEPT C-TIME FROM TIME. SQ2124.2 +044200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2124.2 +044300PEND-E-1. SQ2124.2 +044400P CLOSE RAW-DATA. SQ2124.2 +044500 OPEN OUTPUT PRINT-FILE. SQ2124.2 +044600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2124.2 +044700 MOVE SPACE TO TEST-RESULTS. SQ2124.2 +044800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2124.2 +044900 MOVE ZERO TO REC-SKL-SUB. SQ2124.2 +045000 CCVS-INIT-EXIT. SQ2124.2 +045100 GO TO CCVS1-EXIT. SQ2124.2 +045200 CLOSE-FILES. SQ2124.2 +045300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2124.2 +045400P OPEN I-O RAW-DATA. SQ2124.2 +045500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +045600P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2124.2 +045700P MOVE "OK. " TO C-ABORT. SQ2124.2 +045800P MOVE PASS-COUNTER TO C-OK. SQ2124.2 +045900P MOVE ERROR-HOLD TO C-ALL. SQ2124.2 +046000P MOVE ERROR-COUNTER TO C-FAIL. SQ2124.2 +046100P MOVE DELETE-CNT TO C-DELETED. SQ2124.2 +046200P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2124.2 +046300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2124.2 +046400PEND-E-2. SQ2124.2 +046500P CLOSE RAW-DATA. SQ2124.2 +046600 TERMINATE-CCVS. SQ2124.2 +046700S EXIT PROGRAM. SQ2124.2 +046800STERMINATE-CALL. SQ2124.2 +046900 STOP RUN. SQ2124.2 +047000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2124.2 +047100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2124.2 +047200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2124.2 +047300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2124.2 +047400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2124.2 +047500 PRINT-DETAIL. SQ2124.2 +047600 IF REC-CT NOT EQUAL TO ZERO SQ2124.2 +047700 MOVE "." TO PARDOT-X SQ2124.2 +047800 MOVE REC-CT TO DOTVALUE. SQ2124.2 +047900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2124.2 +048000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2124.2 +048100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2124.2 +048200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2124.2 +048300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2124.2 +048400 MOVE SPACE TO CORRECT-X. SQ2124.2 +048500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2124.2 +048600 MOVE SPACE TO RE-MARK. SQ2124.2 +048700 HEAD-ROUTINE. SQ2124.2 +048800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +048900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2124.2 +049000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2124.2 +049100 COLUMN-NAMES-ROUTINE. SQ2124.2 +049200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +049300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +049400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +049500 END-ROUTINE. SQ2124.2 +049600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2124.2 +049700 END-RTN-EXIT. SQ2124.2 +049800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +049900 END-ROUTINE-1. SQ2124.2 +050000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2124.2 +050100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2124.2 +050200 ADD PASS-COUNTER TO ERROR-HOLD. SQ2124.2 +050300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2124.2 +050400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2124.2 +050500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2124.2 +050600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2124.2 +050700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2124.2 +050800 END-ROUTINE-12. SQ2124.2 +050900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2124.2 +051000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2124.2 +051100 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +051200 ELSE SQ2124.2 +051300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2124.2 +051400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2124.2 +051500 PERFORM WRITE-LINE. SQ2124.2 +051600 END-ROUTINE-13. SQ2124.2 +051700 IF DELETE-CNT IS EQUAL TO ZERO SQ2124.2 +051800 MOVE "NO " TO ERROR-TOTAL ELSE SQ2124.2 +051900 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2124.2 +052000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2124.2 +052100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052200 IF INSPECT-COUNTER EQUAL TO ZERO SQ2124.2 +052300 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +052400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2124.2 +052500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2124.2 +052600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052800 WRITE-LINE. SQ2124.2 +052900 ADD 1 TO RECORD-COUNT. SQ2124.2 +053000Y IF RECORD-COUNT GREATER 50 SQ2124.2 +053100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2124.2 +053200Y MOVE SPACE TO DUMMY-RECORD SQ2124.2 +053300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2124.2 +053400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2124.2 +053500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2124.2 +053600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2124.2 +053700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2124.2 +053800Y MOVE ZERO TO RECORD-COUNT. SQ2124.2 +053900 PERFORM WRT-LN. SQ2124.2 +054000 WRT-LN. SQ2124.2 +054100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2124.2 +054200 MOVE SPACE TO DUMMY-RECORD. SQ2124.2 +054300 BLANK-LINE-PRINT. SQ2124.2 +054400 PERFORM WRT-LN. SQ2124.2 +054500 FAIL-ROUTINE. SQ2124.2 +054600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2124.2 +054700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2124.2 +054800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2124.2 +054900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +055000 GO TO FAIL-ROUTINE-EX. SQ2124.2 +055100 FAIL-ROUTINE-WRITE. SQ2124.2 +055200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2124.2 +055300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +055400 FAIL-ROUTINE-EX. EXIT. SQ2124.2 +055500 BAIL-OUT. SQ2124.2 +055600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2124.2 +055700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2124.2 +055800 BAIL-OUT-WRITE. SQ2124.2 +055900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2124.2 +056000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +056100 BAIL-OUT-EX. EXIT. SQ2124.2 +056200 CCVS1-EXIT. SQ2124.2 +056300 EXIT. SQ2124.2 +056400 SECT-SQ212A-0002 SECTION. SQ2124.2 +056500 WRITE-INIT-GF-01. SQ2124.2 +056600 MOVE ZERO TO COUNT-OF-RECS. SQ2124.2 +056700******************************************************************SQ2124.2 +056800* *SQ2124.2 +056900* ATTEMPT IS MADE TO WRITE 3 SHORTER RECORDS. *SQ2124.2 +057000* *SQ2124.2 +057100******************************************************************SQ2124.2 +057200 MOVE "3 SHORTER RECORDS" TO RE-MARK. SQ2124.2 +057300 MOVE 14 TO RECORD-LENGTH. SQ2124.2 +057400 MOVE 1 TO SWITCH-WRITE-REWRITE. SQ2124.2 +057500 OPEN OUTPUT SQ-VS7. SQ2124.2 +057600 MOVE "WRITE SHORTER RECORDS" TO FEATURE. SQ2124.2 +057700 PERFORM WRITE-RECORDS-1 3 TIMES. SQ2124.2 +057800 MOVE 0 TO COUNT-OF-RECS. SQ2124.2 +057900 WRITE-TEST-GF-01. SQ2124.2 +058000 PERFORM WRITE-RECORDS-1 1030 TIMES. SQ2124.2 +058100 PERFORM WRITE-RECORDS-2 1001 TIMES. SQ2124.2 +058200 WRITE-WRITE-GF-01. SQ2124.2 +058300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2124.2 +058400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2124.2 +058500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2124.2 +058600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2124.2 +058700 MOVE "FILE CONTAINS 18 THRU 2048 CHAR RECS" TO RE-MARK. SQ2124.2 +058800 PERFORM PRINT-DETAIL. SQ2124.2 +058900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 2031 SQ2124.2 +059000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2124.2 +059100* OF 18 THROUGH 2048 CHARACTERS BEGINNING WITH THE 18 CHAR RECSQ2124.2 +059200* AND ENDING WITH THE 2048 CHAR REC. SQ2124.2 +059300* SQ2124.2 +059400******************************************************************SQ2124.2 +059500* *SQ2124.2 +059600* RECORD NO. 2031 TO 2080 SHOULD NOT BE WRITTEN *SQ2124.2 +059700* *SQ2124.2 +059800******************************************************************SQ2124.2 +059900 TEST-STATUS-44. SQ2124.2 +060000 MOVE "9 LONGER RECORDS" TO RE-MARK. SQ2124.2 +060100 MOVE "WRITE LONGER RECORDS" TO FEATURE. SQ2124.2 +060200 PERFORM WRITE-RECORDS-1 9 TIMES. SQ2124.2 +060300 WRITE-CLOSE-GF-01. SQ2124.2 +060400 CLOSE SQ-VS7. SQ2124.2 +060500 GO TO READ-INIT-F1-01. SQ2124.2 +060600 WRITE-RECORDS-1. SQ2124.2 +060700******************************************************************SQ2124.2 +060800* MOVE ... TO OUTPUT-RECORD 1030 RECORDS *SQ2124.2 +060900* WRITE OUTPUT-RECORD. *SQ2124.2 +061000******************************************************************SQ2124.2 +061100 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +061200 ADD 1 TO RECORD-LENGTH. SQ2124.2 +061300 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2124.2 +061400 MOVE VAR-RECORD-18-2048 TO SQ-VS7R1-FIRST. SQ2124.2 +061500 MOVE SPACE TO SQ-VS7-STATUS. SQ2124.2 +061600 WRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +061700 WRITE-RECORDS-2. SQ2124.2 +061800******************************************************************SQ2124.2 +061900*WRITE ... FROM .... . 1000 RECORDS *SQ2124.2 +062000******************************************************************SQ2124.2 +062100 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +062200 ADD 1 TO RECORD-LENGTH. SQ2124.2 +062300 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2124.2 +062400 WRITE SQ-VSR7R1-M-G-2048 FROM VAR-RECORD-18-2048. SQ2124.2 +062500 READ-INIT-F1-01. SQ2124.2 +062600 MOVE 17 TO RECORD-LENGTH. SQ2124.2 +062700 MOVE ZERO TO COUNT-OF-RECS. SQ2124.2 +062800 MOVE ZERO TO EOF-FLAG. SQ2124.2 +062900 MOVE ZERO TO RECORDS-IN-ERROR. SQ2124.2 +063000 MOVE ZERO TO ERROR-FLAG. SQ2124.2 +063100 OPEN INPUT SQ-VS7. SQ2124.2 +063200 READ-TEST-F1-01. SQ2124.2 +063300 PERFORM READ-REC-1 THRU READ-REC-1-EXIT 1030 TIMES. SQ2124.2 +063400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +063500 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2124.2 +063600 GO TO READ-EOF-F1-03. SQ2124.2 +063700 IF ERROR-FLAG EQUAL TO 1 SQ2124.2 +063800 GO TO READ-FAIL-F1-01. SQ2124.2 +063900 READ-PASS-F1-01. SQ2124.2 +064000 PERFORM PASS. SQ2124.2 +064100 GO TO READ-WRITE-F1-01. SQ2124.2 +064200 READ-FAIL-F1-01. SQ2124.2 +064300 MOVE "VII-30 FORMAT 2" TO RE-MARK. SQ2124.2 +064400 PERFORM FAIL. SQ2124.2 +064500 READ-WRITE-F1-01. SQ2124.2 +064600 MOVE "READ 1030 RECORDS" TO FEATURE. SQ2124.2 +064700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2124.2 +064800 PERFORM PRINT-DETAIL. SQ2124.2 +064900 GO TO READ-INIT-F1-02. SQ2124.2 +065000 READ-REC-1. SQ2124.2 +065100******************************************************************SQ2124.2 +065200* READ AT END ... *SQ2124.2 +065300******************************************************************SQ2124.2 +065400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +065500 GO TO READ-REC-1-EXIT. SQ2124.2 +065600 READ SQ-VS7 AT END SQ2124.2 +065700 MOVE 1 TO EOF-FLAG SQ2124.2 +065800 GO TO READ-REC-1-EXIT. SQ2124.2 +065900 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +066000 MOVE SQ-VS7R1-FIRST TO VAR-RECORD-18-2048. SQ2124.2 +066100 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +066200 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2124.2 +066300 GO TO READ-REC-1-ERROR. SQ2124.2 +066400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +066500 GO TO READ-REC-1-EXIT. SQ2124.2 +066600 READ-REC-1-ERROR. SQ2124.2 +066700 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +066800 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +066900 MOVE 1 TO ERROR-FLAG. SQ2124.2 +067000 READ-REC-1-EXIT. SQ2124.2 +067100 EXIT. SQ2124.2 +067200 READ-REC-2. SQ2124.2 +067300******************************************************************SQ2124.2 +067400* READ INTO .... AT END *SQ2124.2 +067500******************************************************************SQ2124.2 +067600 READ SQ-VS7 INTO VAR-RECORD-18-2048 AT END SQ2124.2 +067700 MOVE 1 TO EOF-FLAG SQ2124.2 +067800 GO TO READ-REC-2-EXIT. SQ2124.2 +067900 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +068000 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +068100 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2124.2 +068200 GO TO READ-REC-2-ERROR. SQ2124.2 +068300 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +068400 GO TO READ-REC-2-EXIT. SQ2124.2 +068500 READ-REC-2-ERROR. SQ2124.2 +068600 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +068700 MOVE 1 TO ERROR-FLAG. SQ2124.2 +068800 READ-REC-2-EXIT. SQ2124.2 +068900 EXIT. SQ2124.2 +069000 READ-INIT-F1-02. SQ2124.2 +069100 MOVE ZERO TO ERROR-FLAG. SQ2124.2 +069200 READ-TEST-F1-02. SQ2124.2 +069300 PERFORM READ-REC-2 THRU READ-REC-2-EXIT 1001 TIMES. SQ2124.2 +069400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +069500 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2124.2 +069600 GO TO READ-EOF-F1-03. SQ2124.2 +069700 IF ERROR-FLAG EQUAL TO 1 SQ2124.2 +069800 GO TO READ-FAIL-F1-02. SQ2124.2 +069900 READ-PASS-F1-02. SQ2124.2 +070000 PERFORM PASS. SQ2124.2 +070100 GO TO READ-WRITE-F1-02. SQ2124.2 +070200 READ-FAIL-F1-02. SQ2124.2 +070300 MOVE "VII-30 FORMAT 2" TO RE-MARK. SQ2124.2 +070400 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2124.2 +070500 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +070600 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2124.2 +070700 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +070800 PERFORM FAIL. SQ2124.2 +070900 READ-WRITE-F1-02. SQ2124.2 +071000 MOVE "READ 1001 RECORDS" TO FEATURE. SQ2124.2 +071100 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2124.2 +071200 PERFORM PRINT-DETAIL. SQ2124.2 +071300 READ-INIT-F1-03. SQ2124.2 +071400 READ SQ-VS7 RECORD END SQ2124.2 +071500 GO TO READ-TEST-F1-03. SQ2124.2 +071600 MOVE "MORE THAN 2031 RECORDS" TO RE-MARK. SQ2124.2 +071700 READ-EOF-F1-03. SQ2124.2 +071800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2124.2 +071900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2124.2 +072000 GO TO READ-FAIL-F1-03. SQ2124.2 +072100 READ-TEST-F1-03. SQ2124.2 +072200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2124.2 +072300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2124.2 +072400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2124.2 +072500 GO TO READ-FAIL-F1-03. SQ2124.2 +072600 READ-PASS-F1-03. SQ2124.2 +072700 PERFORM PASS. SQ2124.2 +072800 GO TO READ-WRITE-F1-03. SQ2124.2 +072900 READ-FAIL-F1-03. SQ2124.2 +073000 MOVE "VII-30 FORMAT 2; TOO MUCH RECORDS" TO RE-MARK. SQ2124.2 +073100 PERFORM FAIL. SQ2124.2 +073200 READ-WRITE-F1-03. SQ2124.2 +073300 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2124.2 +073400 MOVE "AT END " TO FEATURE. SQ2124.2 +073500 PERFORM PRINT-DETAIL. SQ2124.2 +073600 READ-CLOSE-F1-03. SQ2124.2 +073700 CLOSE SQ-VS7. SQ2124.2 +073800 REWRITE-44-1. SQ2124.2 +073900 OPEN I-O SQ-VS7. SQ2124.2 +074000******************************************************************SQ2124.2 +074100* *SQ2124.2 +074200* READ 1ST RECORD; REWRITE SMALLER RECORD. *SQ2124.2 +074300* *SQ2124.2 +074400******************************************************************SQ2124.2 +074500 READ SQ-VS7 SQ2124.2 +074600 MOVE 15 TO RECORD-LENGTH. SQ2124.2 +074700 MOVE 2 TO SWITCH-WRITE-REWRITE. SQ2124.2 +074800 MOVE "REWRITE-44-1" TO PAR-NAME. SQ2124.2 +074900 MOVE "RWRT SMALLER RECORD" TO FEATURE. SQ2124.2 +075000 REWRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +075100 REWRITE-44-2. SQ2124.2 +075200******************************************************************SQ2124.2 +075300* *SQ2124.2 +075400* READ 2ND RECORD; REWRITE LARGER RECORD. *SQ2124.2 +075500* *SQ2124.2 +075600******************************************************************SQ2124.2 +075700 READ SQ-VS7. SQ2124.2 +075800 MOVE 2500 TO RECORD-LENGTH. SQ2124.2 +075900 MOVE "REWRITE-44-2" TO PAR-NAME. SQ2124.2 +076000 MOVE "RWRT LARGER RECORD" TO FEATURE. SQ2124.2 +076100 REWRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +076200 CLOSE SQ-VS7. SQ2124.2 +076300 TERMINATE-ROUTINE. SQ2124.2 +076400 EXIT. SQ2124.2 +076500 CCVS-EXIT SECTION. SQ2124.2 +076600 CCVS-999999. SQ2124.2 +076700 GO TO CLOSE-FILES. SQ2124.2 +*END-OF,SQ212A +*HEADER,COBOL,SQ213A +000100 IDENTIFICATION DIVISION. SQ2134.2 +000200 PROGRAM-ID. SQ2134.2 +000300 SQ213A. SQ2134.2 +000400**************************************************************** SQ2134.2 +000500* * SQ2134.2 +000600* VALIDATION FOR:- * SQ2134.2 +000700* " HIGH ". SQ2134.2 +000800* * SQ2134.2 +000900* CREATION DATE / VALIDATION DATE * SQ2134.2 +001000* "4.2 ". SQ2134.2 +001100* * SQ2134.2 +001200* THE ROUTINE SQ213A TESTS THE USE OF THE USE AFTER ERROR SQ2134.2 +001300* PROCEDURE FOR EXTEND AND FILE-NAME SERIES. SQ213A IS SQ2134.2 +001400* BASICALLY A REWRITE OF SQ205 WITH THE ADDITION OF THE USE SQ2134.2 +001500* PROCEDURES. MAGNETIC TAPE FILE SQ-FS1 IS FIRST CREATED WITH SQ2134.2 +001600* 750 RECORDS. THEN IT IS REOPENED WITH EXTEND AND AN SQ2134.2 +001700* ADDITIONAL 250 RECORDS ARE WRITTEN. FINALLY IT IS READ AND SQ2134.2 +001800* VALIDATED FOR CORRECTNESS. MASS-STORAGE FILE SQ-FS2 IS SQ2134.2 +001900* CREATED AS A SINGLE OUTPUT FILE WITH 1000 RECORDS, AFTERWHICHSQ2134.2 +002000* IT IS READ AND VALIDATED FOR CORRECTNESS. THE TEST FOR THE SQ2134.2 +002100* USE PROCEDURE MERELY INDICATES WHETHER OR NOT THE USE SQ2134.2 +002200* PROCEDURES WERE REFERENCED. SQ2134.2 +002300 ENVIRONMENT DIVISION. SQ2134.2 +002400 CONFIGURATION SECTION. SQ2134.2 +002500 SOURCE-COMPUTER. SQ2134.2 +002600 XXXXX082. SQ2134.2 +002700 OBJECT-COMPUTER. SQ2134.2 +002800 XXXXX083. SQ2134.2 +002900 INPUT-OUTPUT SECTION. SQ2134.2 +003000 FILE-CONTROL. SQ2134.2 +003100P SELECT RAW-DATA ASSIGN TO SQ2134.2 +003200P XXXXX062 SQ2134.2 +003300P ORGANIZATION IS INDEXED SQ2134.2 +003400P ACCESS MODE IS RANDOM SQ2134.2 +003500P RECORD KEY IS RAW-DATA-KEY. SQ2134.2 +003600 SELECT PRINT-FILE ASSIGN TO SQ2134.2 +003700 XXXXX055. SQ2134.2 +003800 SELECT SQ-FS1 ASSIGN TO SQ2134.2 +003900 XXXXX001 SQ2134.2 +004000 ORGANIZATION IS SEQUENTIAL SQ2134.2 +004100 ACCESS MODE IS SEQUENTIAL. SQ2134.2 +004200 SELECT SQ-FS2 ASSIGN TO SQ2134.2 +004300 XXXXX014 SQ2134.2 +004400 ORGANIZATION IS SEQUENTIAL SQ2134.2 +004500 ACCESS MODE IS SEQUENTIAL. SQ2134.2 +004600 DATA DIVISION. SQ2134.2 +004700 FILE SECTION. SQ2134.2 +004800P SQ2134.2 +004900PFD RAW-DATA. SQ2134.2 +005000P SQ2134.2 +005100P01 RAW-DATA-SATZ. SQ2134.2 +005200P 05 RAW-DATA-KEY PIC X(6). SQ2134.2 +005300P 05 C-DATE PIC 9(6). SQ2134.2 +005400P 05 C-TIME PIC 9(8). SQ2134.2 +005500P 05 C-NO-OF-TESTS PIC 99. SQ2134.2 +005600P 05 C-OK PIC 999. SQ2134.2 +005700P 05 C-ALL PIC 999. SQ2134.2 +005800P 05 C-FAIL PIC 999. SQ2134.2 +005900P 05 C-DELETED PIC 999. SQ2134.2 +006000P 05 C-INSPECT PIC 999. SQ2134.2 +006100P 05 C-NOTE PIC X(13). SQ2134.2 +006200P 05 C-INDENT PIC X. SQ2134.2 +006300P 05 C-ABORT PIC X(8). SQ2134.2 +006400 FD PRINT-FILE SQ2134.2 +006500C LABEL RECORDS SQ2134.2 +006600C XXXXX084 SQ2134.2 +006700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2134.2 +006800 . SQ2134.2 +006900 01 PRINT-REC PICTURE X(120). SQ2134.2 +007000 01 DUMMY-RECORD PICTURE X(120). SQ2134.2 +007100 FD SQ-FS1 SQ2134.2 +007200C LABEL RECORDS ARE STANDARD SQ2134.2 +007300 RECORD CONTAINS 126 CHARACTERS SQ2134.2 +007400 BLOCK CONTAINS 126 CHARACTERS. SQ2134.2 +007500 01 SQ-FS1R1-F-G-126. SQ2134.2 +007600 02 SQ-FS1R1-F-G-120 PIC X(120). SQ2134.2 +007700 02 SQ-FS1R1-F-G-006 PIC X(6). SQ2134.2 +007800 FD SQ-FS2 SQ2134.2 +007900C LABEL RECORDS ARE STANDARD SQ2134.2 +008000 RECORD 126 SQ2134.2 +008100 BLOCK CONTAINS 126 CHARACTERS. SQ2134.2 +008200 01 SQ-FS2R1-F-G-126. SQ2134.2 +008300 02 SQ-FS2R1-F-G-120 PIC X(120). SQ2134.2 +008400 02 SQ-FS2R1-F-G-006 PIC X(6). SQ2134.2 +008500 WORKING-STORAGE SECTION. SQ2134.2 +008600 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2134.2 +008700 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2134.2 +008800 01 COUNT-OF-RECS PIC 9999. SQ2134.2 +008900 01 EXTEND-ERROR PIC 9999 VALUE 0. SQ2134.2 +009000 01 FN-SERIES-ERROR PIC 9999 VALUE 0. SQ2134.2 +009100 01 FILE-RECORD-INFORMATION-REC. SQ2134.2 +009200 03 FILE-RECORD-INFO-SKELETON. SQ2134.2 +009300 05 FILLER PICTURE X(48) VALUE SQ2134.2 +009400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2134.2 +009500 05 FILLER PICTURE X(46) VALUE SQ2134.2 +009600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2134.2 +009700 05 FILLER PICTURE X(26) VALUE SQ2134.2 +009800 ",LFIL=000000,ORG= ,LBLR= ". SQ2134.2 +009900 05 FILLER PICTURE X(37) VALUE SQ2134.2 +010000 ",RECKEY= ". SQ2134.2 +010100 05 FILLER PICTURE X(38) VALUE SQ2134.2 +010200 ",ALTKEY1= ". SQ2134.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2134.2 +010400 ",ALTKEY2= ". SQ2134.2 +010500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2134.2 +010600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2134.2 +010700 05 FILE-RECORD-INFO-P1-120. SQ2134.2 +010800 07 FILLER PIC X(5). SQ2134.2 +010900 07 XFILE-NAME PIC X(6). SQ2134.2 +011000 07 FILLER PIC X(8). SQ2134.2 +011100 07 XRECORD-NAME PIC X(6). SQ2134.2 +011200 07 FILLER PIC X(1). SQ2134.2 +011300 07 REELUNIT-NUMBER PIC 9(1). SQ2134.2 +011400 07 FILLER PIC X(7). SQ2134.2 +011500 07 XRECORD-NUMBER PIC 9(6). SQ2134.2 +011600 07 FILLER PIC X(6). SQ2134.2 +011700 07 UPDATE-NUMBER PIC 9(2). SQ2134.2 +011800 07 FILLER PIC X(5). SQ2134.2 +011900 07 ODO-NUMBER PIC 9(4). SQ2134.2 +012000 07 FILLER PIC X(5). SQ2134.2 +012100 07 XPROGRAM-NAME PIC X(5). SQ2134.2 +012200 07 FILLER PIC X(7). SQ2134.2 +012300 07 XRECORD-LENGTH PIC 9(6). SQ2134.2 +012400 07 FILLER PIC X(7). SQ2134.2 +012500 07 CHARS-OR-RECORDS PIC X(2). SQ2134.2 +012600 07 FILLER PIC X(1). SQ2134.2 +012700 07 XBLOCK-SIZE PIC 9(4). SQ2134.2 +012800 07 FILLER PIC X(6). SQ2134.2 +012900 07 RECORDS-IN-FILE PIC 9(6). SQ2134.2 +013000 07 FILLER PIC X(5). SQ2134.2 +013100 07 XFILE-ORGANIZATION PIC X(2). SQ2134.2 +013200 07 FILLER PIC X(6). SQ2134.2 +013300 07 XLABEL-TYPE PIC X(1). SQ2134.2 +013400 05 FILE-RECORD-INFO-P121-240. SQ2134.2 +013500 07 FILLER PIC X(8). SQ2134.2 +013600 07 XRECORD-KEY PIC X(29). SQ2134.2 +013700 07 FILLER PIC X(9). SQ2134.2 +013800 07 ALTERNATE-KEY1 PIC X(29). SQ2134.2 +013900 07 FILLER PIC X(9). SQ2134.2 +014000 07 ALTERNATE-KEY2 PIC X(29). SQ2134.2 +014100 07 FILLER PIC X(7). SQ2134.2 +014200 01 TEST-RESULTS. SQ2134.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014400 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2134.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014600 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2134.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014800 02 PAR-NAME. SQ2134.2 +014900 03 FILLER PICTURE X(12) VALUE SPACE. SQ2134.2 +015000 03 PARDOT-X PICTURE X VALUE SPACE. SQ2134.2 +015100 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2134.2 +015200 03 FILLER PIC X(5) VALUE SPACE. SQ2134.2 +015300 02 FILLER PIC X(10) VALUE SPACE. SQ2134.2 +015400 02 RE-MARK PIC X(61). SQ2134.2 +015500 01 TEST-COMPUTED. SQ2134.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ2134.2 +015700 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2134.2 +015800 02 COMPUTED-X. SQ2134.2 +015900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2134.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2134.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2134.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2134.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2134.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2134.2 +016500 04 COMPUTED-18V0 PICTURE -9(18). SQ2134.2 +016600 04 FILLER PICTURE X. SQ2134.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ2134.2 +016800 01 TEST-CORRECT. SQ2134.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ2134.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2134.2 +017100 02 CORRECT-X. SQ2134.2 +017200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2134.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2134.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2134.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2134.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2134.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. SQ2134.2 +017800 04 CORRECT-18V0 PICTURE -9(18). SQ2134.2 +017900 04 FILLER PICTURE X. SQ2134.2 +018000 03 FILLER PIC X(50) VALUE SPACE. SQ2134.2 +018100 01 CCVS-C-1. SQ2134.2 +018200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2134.2 +018300- "SS PARAGRAPH-NAME SQ2134.2 +018400- " REMARKS". SQ2134.2 +018500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2134.2 +018600 01 CCVS-C-2. SQ2134.2 +018700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +018800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2134.2 +018900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2134.2 +019000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2134.2 +019100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2134.2 +019200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2134.2 +019300 01 REC-CT PICTURE 99 VALUE ZERO. SQ2134.2 +019400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2134.2 +019500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2134.2 +019600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2134.2 +019700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2134.2 +019800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2134.2 +019900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2134.2 +020000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2134.2 +020100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2134.2 +020200 01 CCVS-H-1. SQ2134.2 +020300 02 FILLER PICTURE X(27) VALUE SPACE. SQ2134.2 +020400 02 FILLER PICTURE X(67) VALUE SQ2134.2 +020500 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2134.2 +020600- " SYSTEM". SQ2134.2 +020700 02 FILLER PICTURE X(26) VALUE SPACE. SQ2134.2 +020800 01 CCVS-H-2. SQ2134.2 +020900 02 FILLER PICTURE X(52) VALUE IS SQ2134.2 +021000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2134.2 +021100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2134.2 +021200 02 TEST-ID PICTURE IS X(9). SQ2134.2 +021300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2134.2 +021400 01 CCVS-H-3. SQ2134.2 +021500 02 FILLER PICTURE X(34) VALUE SQ2134.2 +021600 " FOR OFFICIAL USE ONLY ". SQ2134.2 +021700 02 FILLER PICTURE X(58) VALUE SQ2134.2 +021800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2134.2 +021900 02 FILLER PICTURE X(28) VALUE SQ2134.2 +022000 " COPYRIGHT 1985 ". SQ2134.2 +022100 01 CCVS-E-1. SQ2134.2 +022200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2134.2 +022300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2134.2 +022400 02 ID-AGAIN PICTURE IS X(9). SQ2134.2 +022500 02 FILLER PICTURE X(45) VALUE IS SQ2134.2 +022600 " NTIS DISTRIBUTION COBOL 85". SQ2134.2 +022700 01 CCVS-E-2. SQ2134.2 +022800 02 FILLER PICTURE X(31) VALUE SQ2134.2 +022900 SPACE. SQ2134.2 +023000 02 FILLER PICTURE X(21) VALUE SPACE. SQ2134.2 +023100 02 CCVS-E-2-2. SQ2134.2 +023200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2134.2 +023300 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +023400 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2134.2 +023500 01 CCVS-E-3. SQ2134.2 +023600 02 FILLER PICTURE X(22) VALUE SQ2134.2 +023700 " FOR OFFICIAL USE ONLY". SQ2134.2 +023800 02 FILLER PICTURE X(12) VALUE SPACE. SQ2134.2 +023900 02 FILLER PICTURE X(58) VALUE SQ2134.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2134.2 +024100 02 FILLER PICTURE X(13) VALUE SPACE. SQ2134.2 +024200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2134.2 +024300 01 CCVS-E-4. SQ2134.2 +024400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2134.2 +024500 02 FILLER PIC XXXX VALUE " OF ". SQ2134.2 +024600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2134.2 +024700 02 FILLER PIC X(40) VALUE SQ2134.2 +024800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2134.2 +024900 01 XXINFO. SQ2134.2 +025000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2134.2 +025100 02 INFO-TEXT. SQ2134.2 +025200 04 FILLER PIC X(20) VALUE SPACE. SQ2134.2 +025300 04 XXCOMPUTED PIC X(20). SQ2134.2 +025400 04 FILLER PIC X(5) VALUE SPACE. SQ2134.2 +025500 04 XXCORRECT PIC X(20). SQ2134.2 +025600 01 HYPHEN-LINE. SQ2134.2 +025700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +025800 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2134.2 +025900- "*****************************************". SQ2134.2 +026000 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2134.2 +026100- "******************************". SQ2134.2 +026200 01 CCVS-PGM-ID PIC X(6) VALUE SQ2134.2 +026300 "SQ213A". SQ2134.2 +026400 PROCEDURE DIVISION. SQ2134.2 +026500 DECLARATIVES. SQ2134.2 +026600 SECT-SQ213A-0001 SECTION. SQ2134.2 +026700 USE AFTER ERROR PROCEDURE EXTEND. SQ2134.2 +026800 EXTEND-ERROR-PROCESS. SQ2134.2 +026900 MOVE 1 TO EXTEND-ERROR. SQ2134.2 +027000 SECT-SQ213A-0002 SECTION. SQ2134.2 +027100 USE AFTER EXCEPTION PROCEDURE ON SQ-FS2, PRINT-FILE. SQ2134.2 +027200 FN-SERIES-ERROR-PROCESS. SQ2134.2 +027300 MOVE 1 TO FN-SERIES-ERROR. SQ2134.2 +027400 END DECLARATIVES. SQ2134.2 +027500 CCVS1 SECTION. SQ2134.2 +027600 OPEN-FILES. SQ2134.2 +027700P OPEN I-O RAW-DATA. SQ2134.2 +027800P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2134.2 +027900P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2134.2 +028000P MOVE "ABORTED " TO C-ABORT. SQ2134.2 +028100P ADD 1 TO C-NO-OF-TESTS. SQ2134.2 +028200P ACCEPT C-DATE FROM DATE. SQ2134.2 +028300P ACCEPT C-TIME FROM TIME. SQ2134.2 +028400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2134.2 +028500PEND-E-1. SQ2134.2 +028600P CLOSE RAW-DATA. SQ2134.2 +028700 OPEN OUTPUT PRINT-FILE. SQ2134.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2134.2 +028900 MOVE SPACE TO TEST-RESULTS. SQ2134.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2134.2 +029100 MOVE ZERO TO REC-SKL-SUB. SQ2134.2 +029200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2134.2 +029300 CCVS-INIT-FILE. SQ2134.2 +029400 ADD 1 TO REC-SKL-SUB. SQ2134.2 +029500 MOVE FILE-RECORD-INFO-SKELETON TO SQ2134.2 +029600 FILE-RECORD-INFO (REC-SKL-SUB). SQ2134.2 +029700 CCVS-INIT-EXIT. SQ2134.2 +029800 GO TO CCVS1-EXIT. SQ2134.2 +029900 CLOSE-FILES. SQ2134.2 +030000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2134.2 +030100P OPEN I-O RAW-DATA. SQ2134.2 +030200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2134.2 +030300P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2134.2 +030400P MOVE "OK. " TO C-ABORT. SQ2134.2 +030500P MOVE PASS-COUNTER TO C-OK. SQ2134.2 +030600P MOVE ERROR-HOLD TO C-ALL. SQ2134.2 +030700P MOVE ERROR-COUNTER TO C-FAIL. SQ2134.2 +030800P MOVE DELETE-CNT TO C-DELETED. SQ2134.2 +030900P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2134.2 +031000P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2134.2 +031100PEND-E-2. SQ2134.2 +031200P CLOSE RAW-DATA. SQ2134.2 +031300 TERMINATE-CCVS. SQ2134.2 +031400S EXIT PROGRAM. SQ2134.2 +031500STERMINATE-CALL. SQ2134.2 +031600 STOP RUN. SQ2134.2 +031700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2134.2 +031800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2134.2 +031900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2134.2 +032000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2134.2 +032100 MOVE "****TEST DELETED****" TO RE-MARK. SQ2134.2 +032200 PRINT-DETAIL. SQ2134.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ2134.2 +032400 MOVE "." TO PARDOT-X SQ2134.2 +032500 MOVE REC-CT TO DOTVALUE. SQ2134.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2134.2 +032700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2134.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2134.2 +032900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2134.2 +033000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2134.2 +033100 MOVE SPACE TO CORRECT-X. SQ2134.2 +033200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2134.2 +033300 MOVE SPACE TO RE-MARK. SQ2134.2 +033400 HEAD-ROUTINE. SQ2134.2 +033500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +033600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2134.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2134.2 +033800 COLUMN-NAMES-ROUTINE. SQ2134.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +034200 END-ROUTINE. SQ2134.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2134.2 +034400 END-RTN-EXIT. SQ2134.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +034600 END-ROUTINE-1. SQ2134.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2134.2 +034800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2134.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2134.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2134.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2134.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2134.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2134.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2134.2 +035500 END-ROUTINE-12. SQ2134.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2134.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2134.2 +035800 MOVE "NO " TO ERROR-TOTAL SQ2134.2 +035900 ELSE SQ2134.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2134.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2134.2 +036200 PERFORM WRITE-LINE. SQ2134.2 +036300 END-ROUTINE-13. SQ2134.2 +036400 IF DELETE-CNT IS EQUAL TO ZERO SQ2134.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE SQ2134.2 +036600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2134.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2134.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO SQ2134.2 +037000 MOVE "NO " TO ERROR-TOTAL SQ2134.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2134.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2134.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +037500 WRITE-LINE. SQ2134.2 +037600 ADD 1 TO RECORD-COUNT. SQ2134.2 +037700Y IF RECORD-COUNT GREATER 50 SQ2134.2 +037800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2134.2 +037900Y MOVE SPACE TO DUMMY-RECORD SQ2134.2 +038000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2134.2 +038100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2134.2 +038200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2134.2 +038300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2134.2 +038400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2134.2 +038500Y MOVE ZERO TO RECORD-COUNT. SQ2134.2 +038600 PERFORM WRT-LN. SQ2134.2 +038700 WRT-LN. SQ2134.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2134.2 +038900 MOVE SPACE TO DUMMY-RECORD. SQ2134.2 +039000 BLANK-LINE-PRINT. SQ2134.2 +039100 PERFORM WRT-LN. SQ2134.2 +039200 FAIL-ROUTINE. SQ2134.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2134.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2134.2 +039500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2134.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +039700 GO TO FAIL-ROUTINE-EX. SQ2134.2 +039800 FAIL-ROUTINE-WRITE. SQ2134.2 +039900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2134.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +040100 FAIL-ROUTINE-EX. EXIT. SQ2134.2 +040200 BAIL-OUT. SQ2134.2 +040300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2134.2 +040400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2134.2 +040500 BAIL-OUT-WRITE. SQ2134.2 +040600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2134.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +040800 BAIL-OUT-EX. EXIT. SQ2134.2 +040900 CCVS1-EXIT. SQ2134.2 +041000 EXIT. SQ2134.2 +041100 SECT-SQ213A-0003 SECTION. SQ2134.2 +041200 OPEN-INIT-GF-01. SQ2134.2 +041300* THIS IS A TEST FOR OPEN EXTEND FOR MAGNETIC TAPE. SQ2134.2 +041400* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2134.2 +041500* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2134.2 +041600* THE FILE IS THEN READ AND VALIDATED. SQ2134.2 +041700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2134.2 +041800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2134.2 +041900 MOVE "SQ213" TO XPROGRAM-NAME (1). SQ2134.2 +042000 MOVE 000126 TO XRECORD-LENGTH (1). SQ2134.2 +042100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2134.2 +042200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2134.2 +042300 MOVE 001000 TO RECORDS-IN-FILE (1). SQ2134.2 +042400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2134.2 +042500 MOVE "S" TO XLABEL-TYPE (1). SQ2134.2 +042600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2134.2 +042700 OPEN OUTPUT SQ-FS1. SQ2134.2 +042800 OPEN-TEST-01-01. SQ2134.2 +042900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2134.2 +043000 MOVE SPACES TO SQ-FS1R1-F-G-006. SQ2134.2 +043100 WRITE SQ-FS1R1-F-G-126. SQ2134.2 +043200 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2134.2 +043300 GO TO OPEN-TEST-01-02. SQ2134.2 +043400 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +043500 GO TO OPEN-TEST-01-01. SQ2134.2 +043600 OPEN-TEST-01-02. SQ2134.2 +043700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2134.2 +043800 MOVE "OPEN-TEST-GF-01-02" TO PAR-NAME. SQ2134.2 +043900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2134.2 +044000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2134.2 +044100 PERFORM PASS. SQ2134.2 +044200 PERFORM PRINT-DETAIL. SQ2134.2 +044300 CLOSE SQ-FS1. SQ2134.2 +044400 OPEN-TEST-01-03. SQ2134.2 +044500 OPEN EXTEND SQ-FS1. SQ2134.2 +044600 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +044700 OPEN-TEST-01-04. SQ2134.2 +044800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2134.2 +044900 MOVE "EXTEND" TO SQ-FS1R1-F-G-006. SQ2134.2 +045000 WRITE SQ-FS1R1-F-G-126. SQ2134.2 +045100 IF XRECORD-NUMBER (1) EQUAL 1000 SQ2134.2 +045200 GO TO OPEN-TEST-GF-01-05. SQ2134.2 +045300 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +045400 GO TO OPEN-TEST-01-04. SQ2134.2 +045500 OPEN-TEST-GF-01-05. SQ2134.2 +045600 MOVE "OPEN O SQ-FS1 EXTEND" TO FEATURE. SQ2134.2 +045700 MOVE "OPEN-TEST-GF-01-03" TO PAR-NAME. SQ2134.2 +045800 MOVE "FILE EXTENDED RECS=" TO COMPUTED-A. SQ2134.2 +045900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2134.2 +046000 PERFORM PASS. SQ2134.2 +046100 PERFORM PRINT-DETAIL. SQ2134.2 +046200 CLOSE SQ-FS1. SQ2134.2 +046300 READ-TEST-F1-01. SQ2134.2 +046400 OPEN INPUT SQ-FS1. SQ2134.2 +046500 MOVE ZERO TO WRK-RECORD-COUNT. SQ2134.2 +046600 READ-TEST-F1-01-07. SQ2134.2 +046700 READ SQ-FS1 SQ2134.2 +046800 ; AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2134.2 +046900 PERFORM FAIL SQ2134.2 +047000 GO TO READ-WRITE-F1-01. SQ2134.2 +047100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2134.2 +047200 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +047300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2134.2 +047400 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +047500 GO TO READ-TEST-F1-01-08. SQ2134.2 +047600 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2134.2 +047700 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +047800 GO TO READ-TEST-F1-01-08. SQ2134.2 +047900 IF SQ-FS1R1-F-G-006 NOT EQUAL TO SPACES SQ2134.2 +048000 ADD 1 TO RECORDS-IN-ERROR. SQ2134.2 +048100 READ-TEST-F1-01-08. SQ2134.2 +048200 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2134.2 +048300 GO TO READ-TEST-F1-01-07. SQ2134.2 +048400 READ-TEST-F1-01-09. SQ2134.2 +048500 READ SQ-FS1 RECORD SQ2134.2 +048600 ; END GO TO READ-TEST-F1-01-10. SQ2134.2 +048700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2134.2 +048800 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +048900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2134.2 +049000 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +049100 GO TO READ-TEST-F1-01-09. SQ2134.2 +049200 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2134.2 +049300 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +049400 GO TO READ-TEST-F1-01-09. SQ2134.2 +049500 IF SQ-FS1R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2134.2 +049600 ADD 1 TO RECORDS-IN-ERROR. SQ2134.2 +049700 GO TO READ-TEST-F1-01-09. SQ2134.2 +049800 READ-TEST-F1-01-10. SQ2134.2 +049900 IF RECORDS-IN-ERROR EQUAL ZERO SQ2134.2 +050000 GO TO READ-PASS-F1-01. SQ2134.2 +050100 GO TO READ-FAIL-F1-01. SQ2134.2 +050200 READ-DELETE-F1-01. SQ2134.2 +050300 PERFORM DE-LETE. SQ2134.2 +050400 GO TO READ-WRITE-F1-01. SQ2134.2 +050500 READ-FAIL-F1-01. SQ2134.2 +050600 MOVE "ERRORS IN READING SQ-FS1; VII-39; OPEN .. EXTEND" SQ2134.2 +050700 TO RE-MARK. SQ2134.2 +050800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +050900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +051000 PERFORM FAIL. SQ2134.2 +051100 GO TO READ-WRITE-F1-01. SQ2134.2 +051200 READ-PASS-F1-01. SQ2134.2 +051300 PERFORM PASS. SQ2134.2 +051400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +051500 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +051600 READ-WRITE-F1-01. SQ2134.2 +051700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2134.2 +051800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2134.2 +051900 PERFORM PRINT-DETAIL. SQ2134.2 +052000 READ-CLOSE-F1-01. SQ2134.2 +052100 CLOSE SQ-FS1. SQ2134.2 +052200 WRITE-INIT-002. SQ2134.2 +052300* THIS TEST CREATES A MASS-STORAGE FILE OF 1000 RECORDS. SQ2134.2 +052400* THEN IT IS READ AND VALIDATED FOR CORRECTNESS. SQ2134.2 +052500 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2134.2 +052600 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2134.2 +052700 MOVE "SQ213" TO XPROGRAM-NAME (2). SQ2134.2 +052800 MOVE 000126 TO XRECORD-LENGTH (2). SQ2134.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2134.2 +053000 MOVE 0001 TO XBLOCK-SIZE (2). SQ2134.2 +053100 MOVE 001000 TO RECORDS-IN-FILE (2). SQ2134.2 +053200 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2134.2 +053300 MOVE "S" TO XLABEL-TYPE (2). SQ2134.2 +053400 MOVE 000001 TO XRECORD-NUMBER (2). SQ2134.2 +053500 OPEN OUTPUT SQ-FS2. SQ2134.2 +053600 WRITE-TEST-GF-01-1. SQ2134.2 +053700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2134.2 +053800 MOVE SPACES TO SQ-FS2R1-F-G-006. SQ2134.2 +053900 WRITE SQ-FS2R1-F-G-126. SQ2134.2 +054000 IF XRECORD-NUMBER (2) EQUAL TO 1000 SQ2134.2 +054100 GO TO WRITE-TEST-GF-01-2. SQ2134.2 +054200 ADD 1 TO XRECORD-NUMBER (2). SQ2134.2 +054300 GO TO WRITE-TEST-GF-01-1. SQ2134.2 +054400 WRITE-TEST-GF-01-2. SQ2134.2 +054500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2134.2 +054600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +054700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2134.2 +054800 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2134.2 +054900 PERFORM PASS. PERFORM PRINT-DETAIL. SQ2134.2 +055000 CLOSE SQ-FS2. SQ2134.2 +055100 READ-INIT-F1-02. SQ2134.2 +055200 OPEN INPUT SQ-FS2. SQ2134.2 +055300 MOVE ZERO TO WRK-RECORD-COUNT. SQ2134.2 +055400 MOVE ZERO TO RECORDS-IN-ERROR. SQ2134.2 +055500 READ-TEST-F1-02-09. SQ2134.2 +055600 READ SQ-FS2 RECORD SQ2134.2 +055700 AT END GO TO READ-TEST-F1-02-10. SQ2134.2 +055800 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2) SQ2134.2 +055900 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +056000 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2134.2 +056100 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +056200 GO TO READ-TEST-F1-02-09. SQ2134.2 +056300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2134.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +056500 GO TO READ-TEST-F1-02-09. SQ2134.2 +056600 GO TO READ-TEST-F1-02-09. SQ2134.2 +056700 READ-TEST-F1-02-10. SQ2134.2 +056800 IF RECORDS-IN-ERROR EQUAL ZERO SQ2134.2 +056900 GO TO READ-PASS-F1-02. SQ2134.2 +057000 GO TO READ-FAIL-F1-02. SQ2134.2 +057100 READ-DELETE-F1-02. SQ2134.2 +057200 PERFORM DE-LETE. SQ2134.2 +057300 GO TO READ-WRITE-F1-02. SQ2134.2 +057400 READ-FAIL-F1-02. SQ2134.2 +057500 MOVE "ERRORS IN READING SQ-FS2; VII-39, -52, -44" TO RE-MARK.SQ2134.2 +057600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +057700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +057800 PERFORM FAIL. SQ2134.2 +057900 GO TO READ-WRITE-F1-02. SQ2134.2 +058000 READ-PASS-F1-02. SQ2134.2 +058100 PERFORM PASS. SQ2134.2 +058200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +058300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +058400 READ-WRITE-F1-02. SQ2134.2 +058500 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2134.2 +058600 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2134.2 +058700 PERFORM PRINT-DETAIL. SQ2134.2 +058800 READ-CLOSE-F1-02. SQ2134.2 +058900 CLOSE SQ-FS2. SQ2134.2 +059000 USE-INIT-GF-01. SQ2134.2 +059100 MOVE "USE PROCEDURE TESTS" TO FEATURE. SQ2134.2 +059200 MOVE "USE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +059300 USE-TEST-GF-01-01. SQ2134.2 +059400 IF EXTEND-ERROR EQUAL ZERO SQ2134.2 +059500 GO TO USE-PASS-GF-01. SQ2134.2 +059600 GO TO USE-FAIL-GF-01. SQ2134.2 +059700 USE-DELETE-GF-01. SQ2134.2 +059800 PERFORM DE-LETE. SQ2134.2 +059900 GO TO USE-WRITE-GF-01. SQ2134.2 +060000 USE-FAIL-GF-01. SQ2134.2 +060100 MOVE "VII-50 -51; UNEXSPECTED USE PERFORMED" TO RE-MARK. SQ2134.2 +060200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +060300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +060400 PERFORM FAIL. SQ2134.2 +060500 GO TO USE-WRITE-GF-01. SQ2134.2 +060600 USE-PASS-GF-01. SQ2134.2 +060700 PERFORM PASS. SQ2134.2 +060800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +060900 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +061000 USE-WRITE-GF-01. SQ2134.2 +061100 MOVE "USE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +061200 PERFORM PRINT-DETAIL. SQ2134.2 +061300 USE-TEST-GF-02. SQ2134.2 +061400 IF FN-SERIES-ERROR EQUAL ZERO SQ2134.2 +061500 GO TO USE-PASS-GF-02. SQ2134.2 +061600 GO TO USE-FAIL-GF-02. SQ2134.2 +061700 USE-DELETE-GF-02. SQ2134.2 +061800 PERFORM DE-LETE. SQ2134.2 +061900 GO TO USE-WRITE-GF-02. SQ2134.2 +062000 USE-FAIL-GF-02. SQ2134.2 +062100 MOVE "VII-50 -51; UNEXSPECTED USE PERFORMED" TO RE-MARK. SQ2134.2 +062200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +062300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +062400 PERFORM FAIL. SQ2134.2 +062500 GO TO USE-WRITE-GF-02. SQ2134.2 +062600 USE-PASS-GF-02. SQ2134.2 +062700 PERFORM PASS. SQ2134.2 +062800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +062900 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +063000 USE-WRITE-GF-02. SQ2134.2 +063100 MOVE "USE-TEST-GF-02" TO PAR-NAME. SQ2134.2 +063200 PERFORM PRINT-DETAIL. SQ2134.2 +063300 SQ213A-END-ROUTINE. SQ2134.2 +063400 MOVE "END OF SQ213A VALIDATION TESTS" TO PRINT-REC. SQ2134.2 +063500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2134.2 +063600 TERMINATE-SQ213A. SQ2134.2 +063700 EXIT. SQ2134.2 +063800 CCVS-EXIT SECTION. SQ2134.2 +063900 CCVS-999999. SQ2134.2 +064000 GO TO CLOSE-FILES. SQ2134.2 +*END-OF,SQ213A +*HEADER,COBOL,SQ214A +000100 IDENTIFICATION DIVISION. SQ2144.2 +000200 PROGRAM-ID. SQ2144.2 +000300 SQ214A. SQ2144.2 +000400**************************************************************** SQ2144.2 +000500* * SQ2144.2 +000600* VALIDATION FOR:- * SQ2144.2 +000700* " HIGH ". SQ2144.2 +000800* * SQ2144.2 +000900* CREATION DATE / VALIDATION DATE * SQ2144.2 +001000* "4.2 ". SQ2144.2 +001100* * SQ2144.2 +001200* SQ2144.2 +001300* SQ2144.2 +001400* SQ214A TESTS OPERATIONS INVOLVING FORMAT 2 OCCURS CLAUSES, SQ2144.2 +001500* I.E. ...OCCURS INTEGER-1 TO INTEGER-2 TIMES DEPENDING ON SQ2144.2 +001600* DATA-NAME-1 .... SQ2144.2 +001700* X3.23-1976, PAGE III-4, 2.1.4(3) STATES, IN PART, THAT SQ2144.2 +001800* INTEGER-2 REPRESENTS THE MAXIMUM NUMBER OF OCCURRENCES AND SQ2144.2 +001900* THAT ONLY THE NUMBER OF OCCURRENCES, AND NOT THE ITEM LENGTH,SQ2144.2 +002000* IS VARIABLE. WHENEVER THE PARENT GROUP ITEM IS REFERENCED, SQ2144.2 +002100* ONLY THE PORTION OF THE TABLE SPECIFIED BY THE CURRENT VALUE SQ2144.2 +002200* OF DATA-NAME-1 WILL BE USED IN THE OPERATION. SQ2144.2 +002300* SQ2144.2 +002400* THE FOLLOWING VERBS ARE EXERCIZED, SQ2144.2 +002500* READ SQ2144.2 +002600* WRITE SQ2144.2 +002700* SQ2144.2 +002800* SQ2144.2 +002900 ENVIRONMENT DIVISION. SQ2144.2 +003000 CONFIGURATION SECTION. SQ2144.2 +003100 SOURCE-COMPUTER. SQ2144.2 +003200 XXXXX082. SQ2144.2 +003300 OBJECT-COMPUTER. SQ2144.2 +003400 XXXXX083. SQ2144.2 +003500 INPUT-OUTPUT SECTION. SQ2144.2 +003600 FILE-CONTROL. SQ2144.2 +003700P SELECT RAW-DATA ASSIGN TO SQ2144.2 +003800P XXXXX062 SQ2144.2 +003900P ORGANIZATION IS INDEXED SQ2144.2 +004000P ACCESS MODE IS RANDOM SQ2144.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ2144.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2144.2 +004300 XXXXX055. SQ2144.2 +004400 SELECT SQ-FS1 ASSIGN TO SQ2144.2 +004500 XXXXX014. SQ2144.2 +004600 DATA DIVISION. SQ2144.2 +004700 FILE SECTION. SQ2144.2 +004800P SQ2144.2 +004900PFD RAW-DATA. SQ2144.2 +005000P SQ2144.2 +005100P01 RAW-DATA-SATZ. SQ2144.2 +005200P 05 RAW-DATA-KEY PIC X(6). SQ2144.2 +005300P 05 C-DATE PIC 9(6). SQ2144.2 +005400P 05 C-TIME PIC 9(8). SQ2144.2 +005500P 05 C-NO-OF-TESTS PIC 99. SQ2144.2 +005600P 05 C-OK PIC 999. SQ2144.2 +005700P 05 C-ALL PIC 999. SQ2144.2 +005800P 05 C-FAIL PIC 999. SQ2144.2 +005900P 05 C-DELETED PIC 999. SQ2144.2 +006000P 05 C-INSPECT PIC 999. SQ2144.2 +006100P 05 C-NOTE PIC X(13). SQ2144.2 +006200P 05 C-INDENT PIC X. SQ2144.2 +006300P 05 C-ABORT PIC X(8). SQ2144.2 +006400 FD PRINT-FILE SQ2144.2 +006500C LABEL RECORDS SQ2144.2 +006600C XXXXX084 SQ2144.2 +006700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2144.2 +006800 . SQ2144.2 +006900 01 PRINT-REC PICTURE X(120). SQ2144.2 +007000 01 DUMMY-RECORD PICTURE X(120). SQ2144.2 +007100 FD SQ-FS1 SQ2144.2 +007200C LABEL RECORD IS STANDARD SQ2144.2 +007300 . SQ2144.2 +007400 01 SQ-FS1R1-F-G-140. SQ2144.2 +007500 02 FS1R1-XN-120 PIC X(120). SQ2144.2 +007600 02 FS1R1-XN-20. SQ2144.2 +007700 03 FS1R1-XN-13 PIC X(13). SQ2144.2 +007800 03 FS1R1-XN-6 PIC X(6). SQ2144.2 +007900 03 FILLER PIC X. SQ2144.2 +008000 WORKING-STORAGE SECTION. SQ2144.2 +008100 01 ODO-RECORD. SQ2144.2 +008200 02 FILLER PIC X(120). SQ2144.2 +008300 02 GRP-ODO. SQ2144.2 +008400 03 DOI-DU-01V00 PIC 9. SQ2144.2 +008500 03 ODO-XN-00009 PIC X(9). SQ2144.2 +008600 03 ODO-GRP-00009. SQ2144.2 +008700 04 ODO-XN-00001-O009D OCCURS 1 TO 9 TIMES DEPENDING ON SQ2144.2 +008800 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D SQ2144.2 +008900 INDEXED BY ODO-IX PIC X. SQ2144.2 +009000 01 STATIC-VALUE. SQ2144.2 +009100 02 FILLER PIC 9 VALUE 9. SQ2144.2 +009200 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". SQ2144.2 +009300 01 WRK-GRP-00019. SQ2144.2 +009400 02 WRK-DU-01V00 PIC 9. SQ2144.2 +009500 02 WRK-XN-00009-1 PIC X(9). SQ2144.2 +009600 02 WRK-XN-00009-2 PIC X(9). SQ2144.2 +009700 01 WRK-GRP-00009. SQ2144.2 +009800 02 ODO-XN-00007 PIC X(7). SQ2144.2 +009900 02 ODO-XN-00002 PIC XX. SQ2144.2 +010000 01 WRK-GRP-00009A REDEFINES WRK-GRP-00009. SQ2144.2 +010100 02 ODO-XN-00005 PIC X(5). SQ2144.2 +010200 02 ODO-XN-00004 PIC X(4). SQ2144.2 +010300 01 WRK-DU-05V00 PIC 9(5). SQ2144.2 +010400 01 WRK-XN-00020 PIC X(20). SQ2144.2 +010500 01 WRK-XN-00010 PIC X(10). SQ2144.2 +010600 01 FILE-RECORD-INFORMATION-REC. SQ2144.2 +010700 03 FILE-RECORD-INFO-SKELETON. SQ2144.2 +010800 05 FILLER PICTURE X(48) VALUE SQ2144.2 +010900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2144.2 +011000 05 FILLER PICTURE X(46) VALUE SQ2144.2 +011100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2144.2 +011200 05 FILLER PICTURE X(26) VALUE SQ2144.2 +011300 ",LFIL=000000,ORG= ,LBLR= ". SQ2144.2 +011400 05 FILLER PICTURE X(37) VALUE SQ2144.2 +011500 ",RECKEY= ". SQ2144.2 +011600 05 FILLER PICTURE X(38) VALUE SQ2144.2 +011700 ",ALTKEY1= ". SQ2144.2 +011800 05 FILLER PICTURE X(38) VALUE SQ2144.2 +011900 ",ALTKEY2= ". SQ2144.2 +012000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2144.2 +012100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2144.2 +012200 05 FILE-RECORD-INFO-P1-120. SQ2144.2 +012300 07 FILLER PIC X(5). SQ2144.2 +012400 07 XFILE-NAME PIC X(6). SQ2144.2 +012500 07 FILLER PIC X(8). SQ2144.2 +012600 07 XRECORD-NAME PIC X(6). SQ2144.2 +012700 07 FILLER PIC X(1). SQ2144.2 +012800 07 REELUNIT-NUMBER PIC 9(1). SQ2144.2 +012900 07 FILLER PIC X(7). SQ2144.2 +013000 07 XRECORD-NUMBER PIC 9(6). SQ2144.2 +013100 07 FILLER PIC X(6). SQ2144.2 +013200 07 UPDATE-NUMBER PIC 9(2). SQ2144.2 +013300 07 FILLER PIC X(5). SQ2144.2 +013400 07 ODO-NUMBER PIC 9(4). SQ2144.2 +013500 07 FILLER PIC X(5). SQ2144.2 +013600 07 XPROGRAM-NAME PIC X(5). SQ2144.2 +013700 07 FILLER PIC X(7). SQ2144.2 +013800 07 XRECORD-LENGTH PIC 9(6). SQ2144.2 +013900 07 FILLER PIC X(7). SQ2144.2 +014000 07 CHARS-OR-RECORDS PIC X(2). SQ2144.2 +014100 07 FILLER PIC X(1). SQ2144.2 +014200 07 XBLOCK-SIZE PIC 9(4). SQ2144.2 +014300 07 FILLER PIC X(6). SQ2144.2 +014400 07 RECORDS-IN-FILE PIC 9(6). SQ2144.2 +014500 07 FILLER PIC X(5). SQ2144.2 +014600 07 XFILE-ORGANIZATION PIC X(2). SQ2144.2 +014700 07 FILLER PIC X(6). SQ2144.2 +014800 07 XLABEL-TYPE PIC X(1). SQ2144.2 +014900 05 FILE-RECORD-INFO-P121-240. SQ2144.2 +015000 07 FILLER PIC X(8). SQ2144.2 +015100 07 XRECORD-KEY PIC X(29). SQ2144.2 +015200 07 FILLER PIC X(9). SQ2144.2 +015300 07 ALTERNATE-KEY1 PIC X(29). SQ2144.2 +015400 07 FILLER PIC X(9). SQ2144.2 +015500 07 ALTERNATE-KEY2 PIC X(29). SQ2144.2 +015600 07 FILLER PIC X(7). SQ2144.2 +015700 01 TEST-RESULTS. SQ2144.2 +015800 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +015900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2144.2 +016000 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +016100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2144.2 +016200 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +016300 02 PAR-NAME. SQ2144.2 +016400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2144.2 +016500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2144.2 +016600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2144.2 +016700 03 FILLER PIC X(5) VALUE SPACE. SQ2144.2 +016800 02 FILLER PIC X(10) VALUE SPACE. SQ2144.2 +016900 02 RE-MARK PIC X(61). SQ2144.2 +017000 01 TEST-COMPUTED. SQ2144.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2144.2 +017200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2144.2 +017300 02 COMPUTED-X. SQ2144.2 +017400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2144.2 +017500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2144.2 +017600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2144.2 +017700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2144.2 +017800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2144.2 +017900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2144.2 +018000 04 COMPUTED-18V0 PICTURE -9(18). SQ2144.2 +018100 04 FILLER PICTURE X. SQ2144.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2144.2 +018300 01 TEST-CORRECT. SQ2144.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ2144.2 +018500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2144.2 +018600 02 CORRECT-X. SQ2144.2 +018700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2144.2 +018800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2144.2 +018900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2144.2 +019000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2144.2 +019100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2144.2 +019200 03 CR-18V0 REDEFINES CORRECT-A. SQ2144.2 +019300 04 CORRECT-18V0 PICTURE -9(18). SQ2144.2 +019400 04 FILLER PICTURE X. SQ2144.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ2144.2 +019600 01 CCVS-C-1. SQ2144.2 +019700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2144.2 +019800- "SS PARAGRAPH-NAME SQ2144.2 +019900- " REMARKS". SQ2144.2 +020000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2144.2 +020100 01 CCVS-C-2. SQ2144.2 +020200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +020300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2144.2 +020400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2144.2 +020500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2144.2 +020600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2144.2 +020700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2144.2 +020800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2144.2 +020900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2144.2 +021000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2144.2 +021100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2144.2 +021200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2144.2 +021300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2144.2 +021400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2144.2 +021500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2144.2 +021600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2144.2 +021700 01 CCVS-H-1. SQ2144.2 +021800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2144.2 +021900 02 FILLER PICTURE X(67) VALUE SQ2144.2 +022000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2144.2 +022100- " SYSTEM". SQ2144.2 +022200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2144.2 +022300 01 CCVS-H-2. SQ2144.2 +022400 02 FILLER PICTURE X(52) VALUE IS SQ2144.2 +022500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2144.2 +022600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2144.2 +022700 02 TEST-ID PICTURE IS X(9). SQ2144.2 +022800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2144.2 +022900 01 CCVS-H-3. SQ2144.2 +023000 02 FILLER PICTURE X(34) VALUE SQ2144.2 +023100 " FOR OFFICIAL USE ONLY ". SQ2144.2 +023200 02 FILLER PICTURE X(58) VALUE SQ2144.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2144.2 +023400 02 FILLER PICTURE X(28) VALUE SQ2144.2 +023500 " COPYRIGHT 1985 ". SQ2144.2 +023600 01 CCVS-E-1. SQ2144.2 +023700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2144.2 +023800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2144.2 +023900 02 ID-AGAIN PICTURE IS X(9). SQ2144.2 +024000 02 FILLER PICTURE X(45) VALUE IS SQ2144.2 +024100 " NTIS DISTRIBUTION COBOL 85". SQ2144.2 +024200 01 CCVS-E-2. SQ2144.2 +024300 02 FILLER PICTURE X(31) VALUE SQ2144.2 +024400 SPACE. SQ2144.2 +024500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2144.2 +024600 02 CCVS-E-2-2. SQ2144.2 +024700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2144.2 +024800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +024900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2144.2 +025000 01 CCVS-E-3. SQ2144.2 +025100 02 FILLER PICTURE X(22) VALUE SQ2144.2 +025200 " FOR OFFICIAL USE ONLY". SQ2144.2 +025300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2144.2 +025400 02 FILLER PICTURE X(58) VALUE SQ2144.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2144.2 +025600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2144.2 +025700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2144.2 +025800 01 CCVS-E-4. SQ2144.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2144.2 +026000 02 FILLER PIC XXXX VALUE " OF ". SQ2144.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2144.2 +026200 02 FILLER PIC X(40) VALUE SQ2144.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2144.2 +026400 01 XXINFO. SQ2144.2 +026500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2144.2 +026600 02 INFO-TEXT. SQ2144.2 +026700 04 FILLER PIC X(20) VALUE SPACE. SQ2144.2 +026800 04 XXCOMPUTED PIC X(20). SQ2144.2 +026900 04 FILLER PIC X(5) VALUE SPACE. SQ2144.2 +027000 04 XXCORRECT PIC X(20). SQ2144.2 +027100 01 HYPHEN-LINE. SQ2144.2 +027200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +027300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2144.2 +027400- "*****************************************". SQ2144.2 +027500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2144.2 +027600- "******************************". SQ2144.2 +027700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2144.2 +027800 "SQ214A". SQ2144.2 +027900 PROCEDURE DIVISION. SQ2144.2 +028000 CCVS1 SECTION. SQ2144.2 +028100 OPEN-FILES. SQ2144.2 +028200P OPEN I-O RAW-DATA. SQ2144.2 +028300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2144.2 +028400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2144.2 +028500P MOVE "ABORTED " TO C-ABORT. SQ2144.2 +028600P ADD 1 TO C-NO-OF-TESTS. SQ2144.2 +028700P ACCEPT C-DATE FROM DATE. SQ2144.2 +028800P ACCEPT C-TIME FROM TIME. SQ2144.2 +028900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2144.2 +029000PEND-E-1. SQ2144.2 +029100P CLOSE RAW-DATA. SQ2144.2 +029200 OPEN OUTPUT PRINT-FILE. SQ2144.2 +029300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2144.2 +029400 MOVE SPACE TO TEST-RESULTS. SQ2144.2 +029500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2144.2 +029600 MOVE ZERO TO REC-SKL-SUB. SQ2144.2 +029700 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2144.2 +029800 CCVS-INIT-FILE. SQ2144.2 +029900 ADD 1 TO REC-SKL-SUB. SQ2144.2 +030000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2144.2 +030100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2144.2 +030200 CCVS-INIT-EXIT. SQ2144.2 +030300 GO TO CCVS1-EXIT. SQ2144.2 +030400 CLOSE-FILES. SQ2144.2 +030500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2144.2 +030600P OPEN I-O RAW-DATA. SQ2144.2 +030700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2144.2 +030800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2144.2 +030900P MOVE "OK. " TO C-ABORT. SQ2144.2 +031000P MOVE PASS-COUNTER TO C-OK. SQ2144.2 +031100P MOVE ERROR-HOLD TO C-ALL. SQ2144.2 +031200P MOVE ERROR-COUNTER TO C-FAIL. SQ2144.2 +031300P MOVE DELETE-CNT TO C-DELETED. SQ2144.2 +031400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2144.2 +031500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2144.2 +031600PEND-E-2. SQ2144.2 +031700P CLOSE RAW-DATA. SQ2144.2 +031800 TERMINATE-CCVS. SQ2144.2 +031900S EXIT PROGRAM. SQ2144.2 +032000STERMINATE-CALL. SQ2144.2 +032100 STOP RUN. SQ2144.2 +032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2144.2 +032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2144.2 +032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2144.2 +032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2144.2 +032600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2144.2 +032700 PRINT-DETAIL. SQ2144.2 +032800 IF REC-CT NOT EQUAL TO ZERO SQ2144.2 +032900 MOVE "." TO PARDOT-X SQ2144.2 +033000 MOVE REC-CT TO DOTVALUE. SQ2144.2 +033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2144.2 +033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2144.2 +033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2144.2 +033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2144.2 +033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2144.2 +033600 MOVE SPACE TO CORRECT-X. SQ2144.2 +033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2144.2 +033800 MOVE SPACE TO RE-MARK. SQ2144.2 +033900 HEAD-ROUTINE. SQ2144.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +034100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2144.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2144.2 +034300 COLUMN-NAMES-ROUTINE. SQ2144.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +034700 END-ROUTINE. SQ2144.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2144.2 +034900 END-RTN-EXIT. SQ2144.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +035100 END-ROUTINE-1. SQ2144.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2144.2 +035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2144.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2144.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2144.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2144.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2144.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2144.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2144.2 +036000 END-ROUTINE-12. SQ2144.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2144.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2144.2 +036300 MOVE "NO " TO ERROR-TOTAL SQ2144.2 +036400 ELSE SQ2144.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2144.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2144.2 +036700 PERFORM WRITE-LINE. SQ2144.2 +036800 END-ROUTINE-13. SQ2144.2 +036900 IF DELETE-CNT IS EQUAL TO ZERO SQ2144.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2144.2 +037100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2144.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2144.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2144.2 +037500 MOVE "NO " TO ERROR-TOTAL SQ2144.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2144.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2144.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +038000 WRITE-LINE. SQ2144.2 +038100 ADD 1 TO RECORD-COUNT. SQ2144.2 +038200Y IF RECORD-COUNT GREATER 50 SQ2144.2 +038300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2144.2 +038400Y MOVE SPACE TO DUMMY-RECORD SQ2144.2 +038500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2144.2 +038600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2144.2 +038700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2144.2 +038800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2144.2 +038900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2144.2 +039000Y MOVE ZERO TO RECORD-COUNT. SQ2144.2 +039100 PERFORM WRT-LN. SQ2144.2 +039200 WRT-LN. SQ2144.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2144.2 +039400 MOVE SPACE TO DUMMY-RECORD. SQ2144.2 +039500 BLANK-LINE-PRINT. SQ2144.2 +039600 PERFORM WRT-LN. SQ2144.2 +039700 FAIL-ROUTINE. SQ2144.2 +039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2144.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2144.2 +040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2144.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +040200 GO TO FAIL-ROUTINE-EX. SQ2144.2 +040300 FAIL-ROUTINE-WRITE. SQ2144.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2144.2 +040500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +040600 FAIL-ROUTINE-EX. EXIT. SQ2144.2 +040700 BAIL-OUT. SQ2144.2 +040800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2144.2 +040900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2144.2 +041000 BAIL-OUT-WRITE. SQ2144.2 +041100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2144.2 +041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +041300 BAIL-OUT-EX. EXIT. SQ2144.2 +041400 CCVS1-EXIT. SQ2144.2 +041500 EXIT. SQ2144.2 +041600 BEGIN-SQ214A-TESTS SECTION. SQ2144.2 +041700 WRITE-INIT-GF-01. SQ2144.2 +041800 MOVE STATIC-VALUE TO WRK-GRP-00019. SQ2144.2 +041900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +042000 MOVE " ACTIVE: " TO ODO-XN-00009. SQ2144.2 +042100 MOVE "1" TO ODO-XN-00001-O009D (1). SQ2144.2 +042200 MOVE "2" TO ODO-XN-00001-O009D (2). SQ2144.2 +042300 MOVE "3" TO ODO-XN-00001-O009D (3). SQ2144.2 +042400 MOVE "4" TO ODO-XN-00001-O009D (4). SQ2144.2 +042500 MOVE "5" TO ODO-XN-00001-O009D (5). SQ2144.2 +042600 MOVE "6" TO ODO-XN-00001-O009D (6). SQ2144.2 +042700 MOVE "7" TO ODO-XN-00001-O009D (7). SQ2144.2 +042800 MOVE "8" TO ODO-XN-00001-O009D (8). SQ2144.2 +042900 MOVE "9" TO ODO-XN-00001-O009D (9). SQ2144.2 +043000 WRITE-SQ-FS1 SECTION. SQ2144.2 +043100 WRITE-SQ-FS1-PARA1. SQ2144.2 +043200 OPEN OUTPUT SQ-FS1. SQ2144.2 +043300 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2144.2 +043400 MOVE "FS1R1 " TO XRECORD-NAME (1). SQ2144.2 +043500 MOVE "SQ214" TO XPROGRAM-NAME (1). SQ2144.2 +043600 MOVE 140 TO XRECORD-LENGTH (1). SQ2144.2 +043700 MOVE "1R" TO CHARS-OR-RECORDS (1). SQ2144.2 +043800 MOVE 4000 TO RECORDS-IN-FILE (1). SQ2144.2 +043900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2144.2 +044000 MOVE "S" TO XLABEL-TYPE (1). SQ2144.2 +044100 MOVE 1 TO XRECORD-NUMBER (1). SQ2144.2 +044200 MOVE 3 TO ODO-NUMBER (1). SQ2144.2 +044300 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +044400 PERFORM WRITE-INIT-GF-01. SQ2144.2 +044500 MOVE 3 TO DOI-DU-01V00. SQ2144.2 +044600 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +044700 MOVE 2 TO XRECORD-NUMBER (1). SQ2144.2 +044800 MOVE 7 TO ODO-NUMBER (1). SQ2144.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +045000 PERFORM WRITE-INIT-GF-01. SQ2144.2 +045100 MOVE 7 TO DOI-DU-01V00. SQ2144.2 +045200 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +045300 PERFORM WRITE-SQ-FS1-PARA2 VARYING ODO-IX FROM 3 BY 1 SQ2144.2 +045400 UNTIL ODO-IX IS GREATER THAN 4000. SQ2144.2 +045500 GO TO WRITE-SQ-FS1-PARA3. SQ2144.2 +045600 WRITE-SQ-FS1-PARA2. SQ2144.2 +045700 SET XRECORD-NUMBER (1) TO ODO-IX. SQ2144.2 +045800 MOVE 9 TO ODO-NUMBER (1). SQ2144.2 +045900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +046000 PERFORM WRITE-INIT-GF-01. SQ2144.2 +046100 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +046200 WRITE-SQ-FS1-PARA3. SQ2144.2 +046300 CLOSE SQ-FS1. SQ2144.2 +046400 OPEN INPUT SQ-FS1. SQ2144.2 +046500 MOVE "OCCURS DEPENDING ON" TO FEATURE. SQ2144.2 +046600 END-OF-WRITE-SQ-FS1 SECTION. SQ2144.2 +046700 WRITE-TEST-GF-01. SQ2144.2 +046800 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +046900 READ SQ-FS1 AT END GO TO WRITE-DELETE-GF-01. SQ2144.2 +047000 IF FS1R1-XN-13 IS EQUAL TO "3 ACTIVE: 123" AND SQ2144.2 +047100 FS1R1-XN-6 IS NOT EQUAL TO "456789" SQ2144.2 +047200 PERFORM PASS SQ2144.2 +047300 ELSE SQ2144.2 +047400 PERFORM FAIL SQ2144.2 +047500 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +047600 MOVE "3 ACTIVE: 123" TO CORRECT-A SQ2144.2 +047700 MOVE FS1R1-XN-20 TO COMPUTED-A. SQ2144.2 +047800 GO TO WRITE-WRITE-GF-01. SQ2144.2 +047900 WRITE-DELETE-GF-01. SQ2144.2 +048000 PERFORM DE-LETE. SQ2144.2 +048100 WRITE-WRITE-GF-01. SQ2144.2 +048200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2144.2 +048300 MOVE "WRITE FROM PARTIAL ODO" TO RE-MARK. SQ2144.2 +048400 PERFORM PRINT-DETAIL. SQ2144.2 +048500 READ-TEST-GF-01. SQ2144.2 +048600 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +048700 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +048800 MOVE SPACES TO ODO-RECORD. SQ2144.2 +048900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +049000 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-01. SQ2144.2 +049100 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +049200 MOVE ODO-GRP-00009 TO WRK-GRP-00009. SQ2144.2 +049300 IF ODO-XN-00007 IS EQUAL TO "1234567" AND SQ2144.2 +049400 ODO-XN-00002 IS NOT EQUAL TO "89" SQ2144.2 +049500 PERFORM PASS SQ2144.2 +049600 ELSE SQ2144.2 +049700 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +049800 PERFORM FAIL SQ2144.2 +049900 MOVE "1234567" TO CORRECT-A SQ2144.2 +050000 MOVE ODO-GRP-00009 TO COMPUTED-A. SQ2144.2 +050100 GO TO READ-WRITE-GF-01. SQ2144.2 +050200 READ-DELETE-GF-01. SQ2144.2 +050300 PERFORM DE-LETE. SQ2144.2 +050400 READ-WRITE-GF-01. SQ2144.2 +050500 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2144.2 +050600 MOVE "READ PARTIAL ODO INTO FULL ODO" TO RE-MARK. SQ2144.2 +050700 PERFORM PRINT-DETAIL. SQ2144.2 +050800 WRITE-TEST-GF-02. SQ2144.2 +050900 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +051000 READ SQ-FS1 AT END GO TO WRITE-DELETE-GF-02. SQ2144.2 +051100 IF FS1R1-XN-20 IS EQUAL TO "9 ACTIVE: 123456789" SQ2144.2 +051200 PERFORM PASS SQ2144.2 +051300 ELSE SQ2144.2 +051400 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +051500 PERFORM FAIL SQ2144.2 +051600 MOVE "9 ACTIVE: 123456789" TO CORRECT-A SQ2144.2 +051700 MOVE FS1R1-XN-20 TO COMPUTED-A. SQ2144.2 +051800 GO TO WRITE-WRITE-GF-02. SQ2144.2 +051900 WRITE-DELETE-GF-02. SQ2144.2 +052000 PERFORM DE-LETE. SQ2144.2 +052100 WRITE-WRITE-GF-02. SQ2144.2 +052200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2144.2 +052300 MOVE "WRITE FROM FULL ODO" TO RE-MARK. SQ2144.2 +052400 PERFORM PRINT-DETAIL. SQ2144.2 +052500 READ-TEST-GF-02. SQ2144.2 +052600 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +052700 MOVE SPACES TO SQ-FS1R1-F-G-140 ODO-RECORD. SQ2144.2 +052800 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +052900 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-02. SQ2144.2 +053000 IF GRP-ODO IS EQUAL TO "9 ACTIVE: 123456789" SQ2144.2 +053100 PERFORM PASS SQ2144.2 +053200 ELSE SQ2144.2 +053300 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +053400 PERFORM FAIL SQ2144.2 +053500 MOVE "9 ACTIVE: 123456789" TO CORRECT-A SQ2144.2 +053600 MOVE GRP-ODO TO COMPUTED-A. SQ2144.2 +053700 GO TO READ-WRITE-GF-02. SQ2144.2 +053800 READ-DELETE-GF-02. SQ2144.2 +053900 PERFORM DE-LETE. SQ2144.2 +054000 READ-WRITE-GF-02. SQ2144.2 +054100 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2144.2 +054200 MOVE "READ FULL ODO INTO FULL ODO" TO RE-MARK. SQ2144.2 +054300 PERFORM PRINT-DETAIL. SQ2144.2 +054400 READ-TEST-GF-03. SQ2144.2 +054500 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +054600 MOVE SPACES TO SQ-FS1R1-F-G-140 ODO-RECORD. SQ2144.2 +054700 MOVE 5 TO DOI-DU-01V00. SQ2144.2 +054800 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-03. SQ2144.2 +054900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +055000 MOVE ODO-GRP-00009 TO WRK-GRP-00009. SQ2144.2 +055100 IF ODO-XN-00005 IS EQUAL TO "12345" AND SQ2144.2 +055200 ODO-XN-00004 IS EQUAL TO "6789" SQ2144.2 +055300 PERFORM PASS SQ2144.2 +055400 ELSE SQ2144.2 +055500 MOVE "VI-28 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +055600 PERFORM FAIL SQ2144.2 +055700 MOVE "123456789" TO CORRECT-A SQ2144.2 +055800 MOVE ODO-GRP-00009 TO COMPUTED-A. SQ2144.2 +055900 GO TO READ-WRITE-GF-03. SQ2144.2 +056000 READ-DELETE-GF-03. SQ2144.2 +056100 PERFORM DE-LETE. SQ2144.2 +056200 READ-WRITE-GF-03. SQ2144.2 +056300 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2144.2 +056400 MOVE "READ FULL ODO INTO PARTIAL ODO" TO RE-MARK. SQ2144.2 +056500 PERFORM PRINT-DETAIL. SQ2144.2 +056600 END-OF-SQ214A-TESTS. SQ2144.2 +056700 CLOSE SQ-FS1. SQ2144.2 +056800 CCVS-EXIT SECTION. SQ2144.2 +056900 CCVS-999999. SQ2144.2 +057000 GO TO CLOSE-FILES. SQ2144.2 +*END-OF,SQ214A +*HEADER,COBOL,SQ215A +000100 IDENTIFICATION DIVISION. SQ2154.2 +000200 PROGRAM-ID. SQ2154.2 +000300 SQ215A. SQ2154.2 +000400**************************************************************** SQ2154.2 +000500* * SQ2154.2 +000600* VALIDATION FOR:- * SQ2154.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +000800* USING CCVS85 VERSION 3.0. * SQ2154.2 +000900* * SQ2154.2 +001000* CREATION DATE / VALIDATION DATE * SQ2154.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2154.2 +001200* * SQ2154.2 +001300**************************************************************** SQ2154.2 +001400* * SQ2154.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2154.2 +001600* * SQ2154.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ2154.2 +001800* X-55 SYSTEM PRINTER * SQ2154.2 +001900* X-82 SOURCE-COMPUTER * SQ2154.2 +002000* X-83 OBJECT-COMPUTER * SQ2154.2 +002100* X-84 LABEL RECORDS OPTION * SQ2154.2 +002200* * SQ2154.2 +002300**************************************************************** SQ2154.2 +002400* * SQ2154.2 +002500* SQ215A TESTS THE CLOSE STATEMENT WITH THE WITH LOCK PHRASE* SQ2154.2 +002600* A MASS STORAGE FILE IS CREATED, ONE RECORD IS WRITTEN * SQ2154.2 +002700* TO IT, AND IT IS CLOSED WITH LOCK. AN ATTEMPT IS THEN * SQ2154.2 +002800* MADE TO REOPEN THE FILE. I-O STATUS 38 IS EXPECTED AND * SQ2154.2 +002900* TESTED IN THE DECLARATIVES. * SQ2154.2 +003000* * SQ2154.2 +003100* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ2154.2 +003200* THE NEW PROGRAMS ARE SQ229A AND SQ230A. * SQ2154.2 +003300**************************************************************** SQ2154.2 +003400* * SQ2154.2 +003500* SQ2154.2 +003600 ENVIRONMENT DIVISION. SQ2154.2 +003700 CONFIGURATION SECTION. SQ2154.2 +003800 SOURCE-COMPUTER. SQ2154.2 +003900 XXXXX082. SQ2154.2 +004000 OBJECT-COMPUTER. SQ2154.2 +004100 XXXXX083. SQ2154.2 +004200* SQ2154.2 +004300 INPUT-OUTPUT SECTION. SQ2154.2 +004400 FILE-CONTROL. SQ2154.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2154.2 +004600 XXXXX055. SQ2154.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ2154.2 +004800 XXXXX014 SQ2154.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ2154.2 +005000* SQ2154.2 +005100* SQ2154.2 +005200 DATA DIVISION. SQ2154.2 +005300 FILE SECTION. SQ2154.2 +005400 FD PRINT-FILE SQ2154.2 +005500C LABEL RECORDS SQ2154.2 +005600C XXXXX084 SQ2154.2 +005700C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2154.2 +005800 . SQ2154.2 +005900 01 PRINT-REC PICTURE X(120). SQ2154.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ2154.2 +006100* SQ2154.2 +006200 FD SQ-FS1 SQ2154.2 +006300C LABEL RECORD IS STANDARD SQ2154.2 +006400 . SQ2154.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2154.2 +006600* SQ2154.2 +006700 WORKING-STORAGE SECTION. SQ2154.2 +006800* SQ2154.2 +006900*************************************************************** SQ2154.2 +007000* * SQ2154.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2154.2 +007200* * SQ2154.2 +007300*************************************************************** SQ2154.2 +007400* SQ2154.2 +007500 01 SQ-FS1-STATUS. SQ2154.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ2154.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ2154.2 +007800* SQ2154.2 +007900*************************************************************** SQ2154.2 +008000* * SQ2154.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2154.2 +008200* * SQ2154.2 +008300*************************************************************** SQ2154.2 +008400* SQ2154.2 +008500 01 REC-SKEL-SUB PIC 99. SQ2154.2 +008600* SQ2154.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ2154.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ2154.2 +008900 05 FILLER PICTURE X(48) VALUE SQ2154.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2154.2 +009100 05 FILLER PICTURE X(46) VALUE SQ2154.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2154.2 +009300 05 FILLER PICTURE X(26) VALUE SQ2154.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ2154.2 +009500 05 FILLER PICTURE X(37) VALUE SQ2154.2 +009600 ",RECKEY= ". SQ2154.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2154.2 +009800 ",ALTKEY1= ". SQ2154.2 +009900 05 FILLER PICTURE X(38) VALUE SQ2154.2 +010000 ",ALTKEY2= ". SQ2154.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ2154.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2154.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ2154.2 +010400 07 FILLER PIC X(5). SQ2154.2 +010500 07 XFILE-NAME PIC X(6). SQ2154.2 +010600 07 FILLER PIC X(8). SQ2154.2 +010700 07 XRECORD-NAME PIC X(6). SQ2154.2 +010800 07 FILLER PIC X(1). SQ2154.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ2154.2 +011000 07 FILLER PIC X(7). SQ2154.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ2154.2 +011200 07 FILLER PIC X(6). SQ2154.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ2154.2 +011400 07 FILLER PIC X(5). SQ2154.2 +011500 07 ODO-NUMBER PIC 9(4). SQ2154.2 +011600 07 FILLER PIC X(5). SQ2154.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ2154.2 +011800 07 FILLER PIC X(7). SQ2154.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ2154.2 +012000 07 FILLER PIC X(7). SQ2154.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ2154.2 +012200 07 FILLER PIC X(1). SQ2154.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ2154.2 +012400 07 FILLER PIC X(6). SQ2154.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ2154.2 +012600 07 FILLER PIC X(5). SQ2154.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ2154.2 +012800 07 FILLER PIC X(6). SQ2154.2 +012900 07 XLABEL-TYPE PIC X(1). SQ2154.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ2154.2 +013100 07 FILLER PIC X(8). SQ2154.2 +013200 07 XRECORD-KEY PIC X(29). SQ2154.2 +013300 07 FILLER PIC X(9). SQ2154.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ2154.2 +013500 07 FILLER PIC X(9). SQ2154.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ2154.2 +013700 07 FILLER PIC X(7). SQ2154.2 +013800* SQ2154.2 +013900 01 TEST-RESULTS. SQ2154.2 +014000 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ2154.2 +014200 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ2154.2 +014400 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014500 02 PAR-NAME. SQ2154.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ2154.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ2154.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2154.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ2154.2 +015000 02 RE-MARK PIC X(61). SQ2154.2 +015100 01 TEST-COMPUTED. SQ2154.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ2154.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2154.2 +015400 02 COMPUTED-X. SQ2154.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2154.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2154.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2154.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2154.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2154.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2154.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ2154.2 +016200 04 FILLER PIC X. SQ2154.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ2154.2 +016400 01 TEST-CORRECT. SQ2154.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ2154.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2154.2 +016700 02 CORRECT-X. SQ2154.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2154.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2154.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2154.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2154.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2154.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ2154.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ2154.2 +017500 04 FILLER PIC X. SQ2154.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ2154.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2154.2 +017800 01 CCVS-C-1. SQ2154.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ2154.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2154.2 +018100- "SS PARAGRAPH-NAME SQ2154.2 +018200- " REMARKS". SQ2154.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ2154.2 +018400 01 CCVS-C-2. SQ2154.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ2154.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ2154.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ2154.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ2154.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ2154.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2154.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ2154.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2154.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2154.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2154.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2154.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2154.2 +020100 01 CCVS-H-1. SQ2154.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ2154.2 +020300 02 FILLER PIC X(42) VALUE SQ2154.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2154.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ2154.2 +020600 01 CCVS-H-2A. SQ2154.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ2154.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2154.2 +020900 02 FILLER PIC XXXX VALUE SQ2154.2 +021000 "4.2 ". SQ2154.2 +021100 02 FILLER PIC X(28) VALUE SQ2154.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ2154.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ2154.2 +021400* SQ2154.2 +021500 01 CCVS-H-2B. SQ2154.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2154.2 +021700 02 TEST-ID PIC X(9). SQ2154.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ2154.2 +021900 02 FILLER PIC X(12) VALUE SQ2154.2 +022000 " HIGH ". SQ2154.2 +022100 02 FILLER PIC X(22) VALUE SQ2154.2 +022200 " LEVEL VALIDATION FOR ". SQ2154.2 +022300 02 FILLER PIC X(58) VALUE SQ2154.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +022500 01 CCVS-H-3. SQ2154.2 +022600 02 FILLER PIC X(34) VALUE SQ2154.2 +022700 " FOR OFFICIAL USE ONLY ". SQ2154.2 +022800 02 FILLER PIC X(58) VALUE SQ2154.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2154.2 +023000 02 FILLER PIC X(28) VALUE SQ2154.2 +023100 " COPYRIGHT 1985,1986 ". SQ2154.2 +023200 01 CCVS-E-1. SQ2154.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ2154.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2154.2 +023500 02 ID-AGAIN PIC X(9). SQ2154.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ2154.2 +023700 01 CCVS-E-2. SQ2154.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ2154.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ2154.2 +024000 02 CCVS-E-2-2. SQ2154.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2154.2 +024200 03 FILLER PIC X VALUE SPACE. SQ2154.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ2154.2 +024400 "ERRORS ENCOUNTERED". SQ2154.2 +024500 01 CCVS-E-3. SQ2154.2 +024600 02 FILLER PIC X(22) VALUE SQ2154.2 +024700 " FOR OFFICIAL USE ONLY". SQ2154.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ2154.2 +024900 02 FILLER PIC X(58) VALUE SQ2154.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ2154.2 +025200 02 FILLER PIC X(20) VALUE SQ2154.2 +025300 " COPYRIGHT 1985,1986". SQ2154.2 +025400 01 CCVS-E-4. SQ2154.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2154.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ2154.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2154.2 +025800 02 FILLER PIC X(40) VALUE SQ2154.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2154.2 +026000 01 XXINFO. SQ2154.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2154.2 +026200 02 INFO-TEXT. SQ2154.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ2154.2 +026400 04 XXCOMPUTED PIC X(20). SQ2154.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ2154.2 +026600 04 XXCORRECT PIC X(20). SQ2154.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ2154.2 +026800 01 HYPHEN-LINE. SQ2154.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ2154.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ2154.2 +027100- "*****************************************". SQ2154.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ2154.2 +027300- "******************************". SQ2154.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ2154.2 +027500 "SQ215A". SQ2154.2 +027600* SQ2154.2 +027700 PROCEDURE DIVISION. SQ2154.2 +027800 DECLARATIVES. SQ2154.2 +027900 SQ-FS1-DECLARATIVE SECTION. SQ2154.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ2154.2 +028100 OUTPUT-ERROR-PROCESS. SQ2154.2 +028200 IF SQ-FS1-STATUS = "38" SQ2154.2 +028300 PERFORM PASS-DECL SQ2154.2 +028400 GO TO ABNORMAL-TERM-DECL SQ2154.2 +028500 ELSE SQ2154.2 +028600 MOVE "38" TO CORRECT-A SQ2154.2 +028700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +028800 MOVE "STATUS AFTER OPEN AFTER LOCK INCORRECT" SQ2154.2 +028900 TO RE-MARK SQ2154.2 +029000 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +029100 PERFORM FAIL-DECL SQ2154.2 +029200 GO TO ABNORMAL-TERM-DECL SQ2154.2 +029300 END-IF. SQ2154.2 +029400* SQ2154.2 +029500 PASS-DECL. SQ2154.2 +029600 MOVE "PASS " TO P-OR-F. SQ2154.2 +029700 ADD 1 TO PASS-COUNTER. SQ2154.2 +029800 PERFORM PRINT-DETAIL-DECL. SQ2154.2 +029900* SQ2154.2 +030000 FAIL-DECL. SQ2154.2 +030100 MOVE "FAIL*" TO P-OR-F. SQ2154.2 +030200 ADD 1 TO ERROR-COUNTER. SQ2154.2 +030300 PERFORM PRINT-DETAIL-DECL. SQ2154.2 +030400* SQ2154.2 +030500 PRINT-DETAIL-DECL. SQ2154.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ2154.2 +030700 MOVE "." TO PARDOT-X SQ2154.2 +030800 MOVE REC-CT TO DOTVALUE. SQ2154.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ2154.2 +031000 PERFORM WRITE-LINE-DECL. SQ2154.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ2154.2 +031200 PERFORM WRITE-LINE-DECL SQ2154.2 +031300 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ2154.2 +031400 ELSE SQ2154.2 +031500 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ2154.2 +031600 MOVE SPACE TO P-OR-F. SQ2154.2 +031700 MOVE SPACE TO COMPUTED-X. SQ2154.2 +031800 MOVE SPACE TO CORRECT-X. SQ2154.2 +031900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2154.2 +032000 MOVE SPACE TO RE-MARK. SQ2154.2 +032100* SQ2154.2 +032200 WRITE-LINE-DECL. SQ2154.2 +032300 ADD 1 TO RECORD-COUNT. SQ2154.2 +032400Y IF RECORD-COUNT GREATER 50 SQ2154.2 +032500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2154.2 +032600Y MOVE SPACE TO DUMMY-RECORD SQ2154.2 +032700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2154.2 +032800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ2154.2 +032900Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2154.2 +033000Y PERFORM WRT-LN-DECL 2 TIMES SQ2154.2 +033100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ2154.2 +033200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2154.2 +033300Y MOVE ZERO TO RECORD-COUNT. SQ2154.2 +033400 PERFORM WRT-LN-DECL. SQ2154.2 +033500* SQ2154.2 +033600 WRT-LN-DECL. SQ2154.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2154.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2154.2 +033900 BLANK-LINE-PRINT-DECL. SQ2154.2 +034000 PERFORM WRT-LN-DECL. SQ2154.2 +034100 FAIL-ROUTINE-DECL. SQ2154.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE SQ2154.2 +034300 GO TO FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE SQ2154.2 +034500 GO TO FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2154.2 +034800 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +034900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +035100 GO TO FAIL-ROUTINE-EX-DECL. SQ2154.2 +035200 FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC SQ2154.2 +035400 PERFORM WRITE-LINE-DECL SQ2154.2 +035500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2154.2 +035600 MOVE TEST-CORRECT TO PRINT-REC SQ2154.2 +035700 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2154.2 +035900 FAIL-ROUTINE-EX-DECL. SQ2154.2 +036000 EXIT. SQ2154.2 +036100 BAIL-OUT-DECL. SQ2154.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ2154.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ2154.2 +036400 BAIL-OUT-WRITE-DECL. SQ2154.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ2154.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2154.2 +036700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +036800 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +036900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +037000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +037100 BAIL-OUT-EX-DECL. SQ2154.2 +037200 EXIT. SQ2154.2 +037300* SQ2154.2 +037400 ABNORMAL-TERM-DECL. SQ2154.2 +037500 MOVE SPACE TO DUMMY-RECORD SQ2154.2 +037600 PERFORM WRITE-LINE-DECL SQ2154.2 +037700 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2154.2 +037800 TO DUMMY-RECORD SQ2154.2 +037900 PERFORM WRITE-LINE-DECL 3 TIMES. SQ2154.2 +038000* SQ2154.2 +038100 EXIT-DECL. SQ2154.2 +038200 EXIT. SQ2154.2 +038300 END DECLARATIVES. SQ2154.2 +038400* SQ2154.2 +038500 CCVS1 SECTION. SQ2154.2 +038600 OPEN-FILES. SQ2154.2 +038700 OPEN OUTPUT PRINT-FILE. SQ2154.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ2154.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2154.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ2154.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2154.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ2154.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2154.2 +039400 GO TO CCVS1-EXIT. SQ2154.2 +039500* SQ2154.2 +039600 CCVS-INIT-FILE. SQ2154.2 +039700 ADD 1 TO REC-SKL-SUB. SQ2154.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2154.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2154.2 +040000* SQ2154.2 +040100 CLOSE-FILES. SQ2154.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2154.2 +040300 CLOSE PRINT-FILE. SQ2154.2 +040400 TERMINATE-CCVS. SQ2154.2 +040500 STOP RUN. SQ2154.2 +040600* SQ2154.2 +040700 INSPT. SQ2154.2 +040800 MOVE "INSPT" TO P-OR-F. SQ2154.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ2154.2 +041000 PERFORM PRINT-DETAIL. SQ2154.2 +041100 SQ2154.2 +041200 PASS. SQ2154.2 +041300 MOVE "PASS " TO P-OR-F. SQ2154.2 +041400 ADD 1 TO PASS-COUNTER. SQ2154.2 +041500 PERFORM PRINT-DETAIL. SQ2154.2 +041600* SQ2154.2 +041700 FAIL. SQ2154.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ2154.2 +041900 ADD 1 TO ERROR-COUNTER. SQ2154.2 +042000 PERFORM PRINT-DETAIL. SQ2154.2 +042100* SQ2154.2 +042200 DE-LETE. SQ2154.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2154.2 +042400 MOVE "*****" TO P-OR-F. SQ2154.2 +042500 ADD 1 TO DELETE-COUNTER. SQ2154.2 +042600 PERFORM PRINT-DETAIL. SQ2154.2 +042700* SQ2154.2 +042800 PRINT-DETAIL. SQ2154.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ2154.2 +043000 MOVE "." TO PARDOT-X SQ2154.2 +043100 MOVE REC-CT TO DOTVALUE. SQ2154.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ2154.2 +043300 PERFORM WRITE-LINE. SQ2154.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ2154.2 +043500 PERFORM WRITE-LINE SQ2154.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2154.2 +043700 ELSE SQ2154.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2154.2 +043900 MOVE SPACE TO P-OR-F. SQ2154.2 +044000 MOVE SPACE TO COMPUTED-X. SQ2154.2 +044100 MOVE SPACE TO CORRECT-X. SQ2154.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2154.2 +044300 MOVE SPACE TO RE-MARK. SQ2154.2 +044400* SQ2154.2 +044500 HEAD-ROUTINE. SQ2154.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2154.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2154.2 +045000 COLUMN-NAMES-ROUTINE. SQ2154.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +045400 END-ROUTINE. SQ2154.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2154.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ2154.2 +045700 END-RTN-EXIT. SQ2154.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2154.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +046000* SQ2154.2 +046100 END-ROUTINE-1. SQ2154.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ2154.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2154.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2154.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2154.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2154.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2154.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2154.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2154.2 +047000 PERFORM WRITE-LINE. SQ2154.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2154.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2154.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +047400 ELSE SQ2154.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2154.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2154.2 +047700 PERFORM WRITE-LINE. SQ2154.2 +047800 END-ROUTINE-13. SQ2154.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2154.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +048100 ELSE SQ2154.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2154.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2154.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2154.2 +048500 PERFORM WRITE-LINE. SQ2154.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2154.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +048800 ELSE SQ2154.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2154.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2154.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +049300* SQ2154.2 +049400 WRITE-LINE. SQ2154.2 +049500 ADD 1 TO RECORD-COUNT. SQ2154.2 +049600* IF RECORD-COUNT GREATER 50 SQ2154.2 +049700* MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2154.2 +049800* MOVE SPACE TO DUMMY-RECORD SQ2154.2 +049900* WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2154.2 +050000* MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2154.2 +050100* MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2154.2 +050200* MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2154.2 +050300* MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2154.2 +050400* MOVE ZERO TO RECORD-COUNT. SQ2154.2 +050500 PERFORM WRT-LN. SQ2154.2 +050600* SQ2154.2 +050700 WRT-LN. SQ2154.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2154.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ2154.2 +051000 BLANK-LINE-PRINT. SQ2154.2 +051100 PERFORM WRT-LN. SQ2154.2 +051200 FAIL-ROUTINE. SQ2154.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2154.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2154.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2154.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +052000 GO TO FAIL-ROUTINE-EX. SQ2154.2 +052100 FAIL-ROUTINE-WRITE. SQ2154.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ2154.2 +052300 PERFORM WRITE-LINE SQ2154.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2154.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ2154.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2154.2 +052800 FAIL-ROUTINE-EX. SQ2154.2 +052900 EXIT. SQ2154.2 +053000 BAIL-OUT. SQ2154.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2154.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2154.2 +053300 BAIL-OUT-WRITE. SQ2154.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ2154.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2154.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +054000 BAIL-OUT-EX. SQ2154.2 +054100 EXIT. SQ2154.2 +054200 CCVS1-EXIT. SQ2154.2 +054300 EXIT. SQ2154.2 +054400* SQ2154.2 +054500**************************************************************** SQ2154.2 +054600* * SQ2154.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2154.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2154.2 +054900* * SQ2154.2 +055000**************************************************************** SQ2154.2 +055100* SQ2154.2 +055200 SECT-SQ215A-0001 SECTION. SQ2154.2 +055300 WRITE-INIT-GF-01. SQ2154.2 +055400* SQ2154.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ2154.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2154.2 +055700* SQ2154.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2154.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2154.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2154.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ2154.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2154.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ2154.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2154.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2154.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ2154.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ2154.2 +056800* SQ2154.2 +056900 WRITE-OPEN-01. SQ2154.2 +057000 MOVE 1 TO REC-CT. SQ2154.2 +057100 MOVE "WRITE-OPEN-01" TO PAR-NAME. SQ2154.2 +057200 MOVE "OPEN OUTPUT - NEW FILE" TO FEATURE. SQ2154.2 +057300 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +057400 OPEN OUTPUT SQ-FS1. SQ2154.2 +057500 IF SQ-FS1-STATUS = "00" SQ2154.2 +057600 PERFORM PASS SQ2154.2 +057700 ELSE SQ2154.2 +057800 MOVE "00" TO CORRECT-A SQ2154.2 +057900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +058000 MOVE "FILE OPEN FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +058100 TO RE-MARK SQ2154.2 +058200 MOVE "VII-3, VII-40, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +058300 PERFORM FAIL SQ2154.2 +058400 GO TO CCVS-EXIT SQ2154.2 +058500 END-IF. SQ2154.2 +058600* SQ2154.2 +058700* WRITE A SINGLE RECORD TO THE FILE SQ2154.2 +058800* SQ2154.2 +058900 WRITE-INIT-01. SQ2154.2 +059000 MOVE 1 TO REC-CT. SQ2154.2 +059100 MOVE "WRITE-TEST-01" TO PAR-NAME SQ2154.2 +059200 MOVE "SEQUENTIAL WRITE" TO FEATURE. SQ2154.2 +059300 WRITE-TEST-01-01. SQ2154.2 +059400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2154.2 +059500 WRITE SQ-FS1R1-F-G-120. SQ2154.2 +059600 IF SQ-FS1-STATUS = "00" SQ2154.2 +059700 PERFORM PASS SQ2154.2 +059800 ELSE SQ2154.2 +059900 MOVE "00" TO CORRECT-A SQ2154.2 +060000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +060100 MOVE "WRITING FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +060200 TO RE-MARK SQ2154.2 +060300 MOVE "VII-3, VII-53, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +060400 PERFORM FAIL SQ2154.2 +060500 GO TO CCVS-EXIT SQ2154.2 +060600 END-IF. SQ2154.2 +060700* SQ2154.2 +060800* CLOSE THE FILE WITH LOCK, SO IT SHOULD NOT REOPEN SQ2154.2 +060900* SQ2154.2 +061000 CLOSE-INIT-01. SQ2154.2 +061100 MOVE 1 TO REC-CT. SQ2154.2 +061200 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ2154.2 +061300 MOVE "CLOSE WITH LOCK" TO FEATURE. SQ2154.2 +061400 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +061500 CLOSE-TEST-01. SQ2154.2 +061600 CLOSE SQ-FS1 WITH LOCK. SQ2154.2 +061700 IF SQ-FS1-STATUS = "00" SQ2154.2 +061800 PERFORM PASS SQ2154.2 +061900 ELSE SQ2154.2 +062000 MOVE "00" TO CORRECT-A SQ2154.2 +062100 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +062200 MOVE "CLOSE WITH LOCK FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +062300 TO RE-MARK SQ2154.2 +062400 MOVE "VII-3, VII-38, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +062500 PERFORM FAIL SQ2154.2 +062600 GO TO CCVS-EXIT SQ2154.2 +062700 END-IF. SQ2154.2 +062800* SQ2154.2 +062900* HAVING LOCKED THE FILE, WE NOW TRY TO REOPEN IT. SQ2154.2 +063000* THE TEST PASSES IF THE FILE CANNOT BE OPENED AND SQ2154.2 +063100* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ2154.2 +063200* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF A SQ2154.2 +063300* PROGRAM WHICH ATTEMPTS TO REOPEN A LOCKED FILE, SQ2154.2 +063400* OR MAY RETURN CONTROL TO THE STATEMENT FOLLOWING SQ2154.2 +063500* THE OPEN STATEMENT. SQ2154.2 +063600* SQ2154.2 +063700 OPEN-INIT-01. SQ2154.2 +063800* SQ2154.2 +063900 MOVE 1 TO REC-CT. SQ2154.2 +064000 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ2154.2 +064100 MOVE "OPEN AFTER LOCK" TO FEATURE. SQ2154.2 +064200 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +064300 OPEN-TEST-01. SQ2154.2 +064400 OPEN OUTPUT SQ-FS1. SQ2154.2 +064500* SQ2154.2 +064600 CCVS-EXIT SECTION. SQ2154.2 +064700 CCVS-999999. SQ2154.2 +064800 GO TO CLOSE-FILES. SQ2154.2 +*END-OF,SQ215A +*HEADER,COBOL,SQ216A +000100 IDENTIFICATION DIVISION. SQ2164.2 +000200 PROGRAM-ID. SQ2164.2 +000300 SQ216A. SQ2164.2 +000400**************************************************************** SQ2164.2 +000500* * SQ2164.2 +000600* VALIDATION FOR:- * SQ2164.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2164.2 +000800* * SQ2164.2 +000900* CREATION DATE / VALIDATION DATE * SQ2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2164.2 +001100* * SQ2164.2 +001200* THIS ROUTINE TESTS THE CLAUSE: SQ2164.2 +001300* PADDING CHARACTER IS "9" (LITERAL). SQ2164.2 +001400* SQ2164.2 +001500* THE ROUTINE SQ216A CREATES A TAPE FILE WHICH HAS 750 FIXESQ2164.2 +001600* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ2164.2 +001700* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ2164.2 +001800* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ2164.2 +001900* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ2164.2 +002000* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ2164.2 +002100* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ2164.2 +002200* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ2164.2 +002300* LEVEL TWO PADDING CHARCTER IS "9". SQ2164.2 +002400* SQ2164.2 +002500* THE LAST 9 RECORDS MUST BE FILLED WITH THE PADDING CHARACTER SQ2164.2 +002600* "9". SQ2164.2 +002700* SQ2164.2 +002800 ENVIRONMENT DIVISION. SQ2164.2 +002900 CONFIGURATION SECTION. SQ2164.2 +003000 SOURCE-COMPUTER. SQ2164.2 +003100 XXXXX082. SQ2164.2 +003200 OBJECT-COMPUTER. SQ2164.2 +003300 XXXXX083. SQ2164.2 +003400 INPUT-OUTPUT SECTION. SQ2164.2 +003500 FILE-CONTROL. SQ2164.2 +003600P SELECT RAW-DATA ASSIGN TO SQ2164.2 +003700P XXXXX062 SQ2164.2 +003800P ORGANIZATION IS INDEXED SQ2164.2 +003900P ACCESS MODE IS RANDOM SQ2164.2 +004000P RECORD KEY IS RAW-DATA-KEY. SQ2164.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ2164.2 +004200 XXXXX055. SQ2164.2 +004300 SELECT SQ-FS1 ASSIGN TO SQ2164.2 +004400 XXXXX001 SQ2164.2 +004500 ORGANIZATION IS SEQUENTIAL SQ2164.2 +004600 PADDING CHARACTER IS "9" SQ2164.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ2164.2 +004800 DATA DIVISION. SQ2164.2 +004900 FILE SECTION. SQ2164.2 +005000P SQ2164.2 +005100PFD RAW-DATA. SQ2164.2 +005200P SQ2164.2 +005300P01 RAW-DATA-SATZ. SQ2164.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ2164.2 +005500P 05 C-DATE PIC 9(6). SQ2164.2 +005600P 05 C-TIME PIC 9(8). SQ2164.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ2164.2 +005800P 05 C-OK PIC 999. SQ2164.2 +005900P 05 C-ALL PIC 999. SQ2164.2 +006000P 05 C-FAIL PIC 999. SQ2164.2 +006100P 05 C-DELETED PIC 999. SQ2164.2 +006200P 05 C-INSPECT PIC 999. SQ2164.2 +006300P 05 C-NOTE PIC X(13). SQ2164.2 +006400P 05 C-INDENT PIC X. SQ2164.2 +006500P 05 C-ABORT PIC X(8). SQ2164.2 +006600 FD PRINT-FILE SQ2164.2 +006700C LABEL RECORDS SQ2164.2 +006800C XXXXX084 SQ2164.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2164.2 +007000 . SQ2164.2 +007100 01 PRINT-REC PICTURE X(120). SQ2164.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2164.2 +007300 FD SQ-FS1 SQ2164.2 +007400C LABEL RECORD STANDARD SQ2164.2 +007500 RECORD CONTAINS 120 CHARACTERS SQ2164.2 +007600 BLOCK CONTAINS 13 RECORDS. SQ2164.2 +007700 01 SQ-FS1R1-F-G-120. SQ2164.2 +007800 02 FILLER PIC X(120). SQ2164.2 +007900 WORKING-STORAGE SECTION. SQ2164.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ2164.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ2164.2 +008200 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ2164.2 +008300 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ2164.2 +008400 01 FILE-RECORD-INFORMATION-REC. SQ2164.2 +008500 03 FILE-RECORD-INFO-SKELETON. SQ2164.2 +008600 05 FILLER PICTURE X(48) VALUE SQ2164.2 +008700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2164.2 +008800 05 FILLER PICTURE X(46) VALUE SQ2164.2 +008900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2164.2 +009000 05 FILLER PICTURE X(26) VALUE SQ2164.2 +009100 ",LFIL=000000,ORG= ,LBLR= ". SQ2164.2 +009200 05 FILLER PICTURE X(37) VALUE SQ2164.2 +009300 ",RECKEY= ". SQ2164.2 +009400 05 FILLER PICTURE X(38) VALUE SQ2164.2 +009500 ",ALTKEY1= ". SQ2164.2 +009600 05 FILLER PICTURE X(38) VALUE SQ2164.2 +009700 ",ALTKEY2= ". SQ2164.2 +009800 05 FILLER PICTURE X(7) VALUE SPACE.SQ2164.2 +009900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2164.2 +010000 05 FILE-RECORD-INFO-P1-120. SQ2164.2 +010100 07 FILLER PIC X(5). SQ2164.2 +010200 07 XFILE-NAME PIC X(6). SQ2164.2 +010300 07 FILLER PIC X(8). SQ2164.2 +010400 07 XRECORD-NAME PIC X(6). SQ2164.2 +010500 07 FILLER PIC X(1). SQ2164.2 +010600 07 REELUNIT-NUMBER PIC 9(1). SQ2164.2 +010700 07 FILLER PIC X(7). SQ2164.2 +010800 07 XRECORD-NUMBER PIC 9(6). SQ2164.2 +010900 07 FILLER PIC X(6). SQ2164.2 +011000 07 UPDATE-NUMBER PIC 9(2). SQ2164.2 +011100 07 FILLER PIC X(5). SQ2164.2 +011200 07 ODO-NUMBER PIC 9(4). SQ2164.2 +011300 07 FILLER PIC X(5). SQ2164.2 +011400 07 XPROGRAM-NAME PIC X(5). SQ2164.2 +011500 07 FILLER PIC X(7). SQ2164.2 +011600 07 XRECORD-LENGTH PIC 9(6). SQ2164.2 +011700 07 FILLER PIC X(7). SQ2164.2 +011800 07 CHARS-OR-RECORDS PIC X(2). SQ2164.2 +011900 07 FILLER PIC X(1). SQ2164.2 +012000 07 XBLOCK-SIZE PIC 9(4). SQ2164.2 +012100 07 FILLER PIC X(6). SQ2164.2 +012200 07 RECORDS-IN-FILE PIC 9(6). SQ2164.2 +012300 07 FILLER PIC X(5). SQ2164.2 +012400 07 XFILE-ORGANIZATION PIC X(2). SQ2164.2 +012500 07 FILLER PIC X(6). SQ2164.2 +012600 07 XLABEL-TYPE PIC X(1). SQ2164.2 +012700 05 FILE-RECORD-INFO-P121-240. SQ2164.2 +012800 07 FILLER PIC X(8). SQ2164.2 +012900 07 XRECORD-KEY PIC X(29). SQ2164.2 +013000 07 FILLER PIC X(9). SQ2164.2 +013100 07 ALTERNATE-KEY1 PIC X(29). SQ2164.2 +013200 07 FILLER PIC X(9). SQ2164.2 +013300 07 ALTERNATE-KEY2 PIC X(29). SQ2164.2 +013400 07 FILLER PIC X(7). SQ2164.2 +013500 01 TEST-RESULTS. SQ2164.2 +013600 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +013700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2164.2 +013800 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +013900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2164.2 +014000 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +014100 02 PAR-NAME. SQ2164.2 +014200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2164.2 +014300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2164.2 +014400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2164.2 +014500 03 FILLER PIC X(5) VALUE SPACE. SQ2164.2 +014600 02 FILLER PIC X(10) VALUE SPACE. SQ2164.2 +014700 02 RE-MARK PIC X(61). SQ2164.2 +014800 01 TEST-COMPUTED. SQ2164.2 +014900 02 FILLER PIC X(30) VALUE SPACE. SQ2164.2 +015000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2164.2 +015100 02 COMPUTED-X. SQ2164.2 +015200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2164.2 +015300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2164.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2164.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2164.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2164.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2164.2 +015800 04 COMPUTED-18V0 PICTURE -9(18). SQ2164.2 +015900 04 FILLER PICTURE X. SQ2164.2 +016000 03 FILLER PIC X(50) VALUE SPACE. SQ2164.2 +016100 01 TEST-CORRECT. SQ2164.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ2164.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2164.2 +016400 02 CORRECT-X. SQ2164.2 +016500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2164.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2164.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2164.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2164.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2164.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. SQ2164.2 +017100 04 CORRECT-18V0 PICTURE -9(18). SQ2164.2 +017200 04 FILLER PICTURE X. SQ2164.2 +017300 03 FILLER PIC X(50) VALUE SPACE. SQ2164.2 +017400 01 CCVS-C-1. SQ2164.2 +017500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2164.2 +017600- "SS PARAGRAPH-NAME SQ2164.2 +017700- " REMARKS". SQ2164.2 +017800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2164.2 +017900 01 CCVS-C-2. SQ2164.2 +018000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +018100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2164.2 +018200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2164.2 +018300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2164.2 +018400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2164.2 +018500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2164.2 +018600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2164.2 +018700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2164.2 +018800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2164.2 +018900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2164.2 +019000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2164.2 +019100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2164.2 +019200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2164.2 +019300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2164.2 +019400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2164.2 +019500 01 CCVS-H-1. SQ2164.2 +019600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2164.2 +019700 02 FILLER PICTURE X(67) VALUE SQ2164.2 +019800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2164.2 +019900- " SYSTEM". SQ2164.2 +020000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2164.2 +020100 01 CCVS-H-2. SQ2164.2 +020200 02 FILLER PICTURE X(52) VALUE IS SQ2164.2 +020300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2164.2 +020400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2164.2 +020500 02 TEST-ID PICTURE IS X(9). SQ2164.2 +020600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2164.2 +020700 01 CCVS-H-3. SQ2164.2 +020800 02 FILLER PICTURE X(34) VALUE SQ2164.2 +020900 " FOR OFFICIAL USE ONLY ". SQ2164.2 +021000 02 FILLER PICTURE X(58) VALUE SQ2164.2 +021100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2164.2 +021200 02 FILLER PICTURE X(28) VALUE SQ2164.2 +021300 " COPYRIGHT 1985 ". SQ2164.2 +021400 01 CCVS-E-1. SQ2164.2 +021500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2164.2 +021600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2164.2 +021700 02 ID-AGAIN PICTURE IS X(9). SQ2164.2 +021800 02 FILLER PICTURE X(45) VALUE IS SQ2164.2 +021900 " NTIS DISTRIBUTION COBOL 85". SQ2164.2 +022000 01 CCVS-E-2. SQ2164.2 +022100 02 FILLER PICTURE X(31) VALUE SQ2164.2 +022200 SPACE. SQ2164.2 +022300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2164.2 +022400 02 CCVS-E-2-2. SQ2164.2 +022500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2164.2 +022600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +022700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2164.2 +022800 01 CCVS-E-3. SQ2164.2 +022900 02 FILLER PICTURE X(22) VALUE SQ2164.2 +023000 " FOR OFFICIAL USE ONLY". SQ2164.2 +023100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2164.2 +023200 02 FILLER PICTURE X(58) VALUE SQ2164.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2164.2 +023400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2164.2 +023500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2164.2 +023600 01 CCVS-E-4. SQ2164.2 +023700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2164.2 +023800 02 FILLER PIC XXXX VALUE " OF ". SQ2164.2 +023900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2164.2 +024000 02 FILLER PIC X(40) VALUE SQ2164.2 +024100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2164.2 +024200 01 XXINFO. SQ2164.2 +024300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2164.2 +024400 02 INFO-TEXT. SQ2164.2 +024500 04 FILLER PIC X(20) VALUE SPACE. SQ2164.2 +024600 04 XXCOMPUTED PIC X(20). SQ2164.2 +024700 04 FILLER PIC X(5) VALUE SPACE. SQ2164.2 +024800 04 XXCORRECT PIC X(20). SQ2164.2 +024900 01 HYPHEN-LINE. SQ2164.2 +025000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +025100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2164.2 +025200- "*****************************************". SQ2164.2 +025300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2164.2 +025400- "******************************". SQ2164.2 +025500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2164.2 +025600 "SQ216A". SQ2164.2 +025700 PROCEDURE DIVISION. SQ2164.2 +025800 CCVS1 SECTION. SQ2164.2 +025900 OPEN-FILES. SQ2164.2 +026000P OPEN I-O RAW-DATA. SQ2164.2 +026100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2164.2 +026200P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2164.2 +026300P MOVE "ABORTED " TO C-ABORT. SQ2164.2 +026400P ADD 1 TO C-NO-OF-TESTS. SQ2164.2 +026500P ACCEPT C-DATE FROM DATE. SQ2164.2 +026600P ACCEPT C-TIME FROM TIME. SQ2164.2 +026700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2164.2 +026800PEND-E-1. SQ2164.2 +026900P CLOSE RAW-DATA. SQ2164.2 +027000 OPEN OUTPUT PRINT-FILE. SQ2164.2 +027100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2164.2 +027200 MOVE SPACE TO TEST-RESULTS. SQ2164.2 +027300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2164.2 +027400 MOVE ZERO TO REC-SKL-SUB. SQ2164.2 +027500 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2164.2 +027600 CCVS-INIT-FILE. SQ2164.2 +027700 ADD 1 TO REC-SKL-SUB. SQ2164.2 +027800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2164.2 +027900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2164.2 +028000 CCVS-INIT-EXIT. SQ2164.2 +028100 GO TO CCVS1-EXIT. SQ2164.2 +028200 CLOSE-FILES. SQ2164.2 +028300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2164.2 +028400P OPEN I-O RAW-DATA. SQ2164.2 +028500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2164.2 +028600P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2164.2 +028700P MOVE "OK. " TO C-ABORT. SQ2164.2 +028800P MOVE PASS-COUNTER TO C-OK. SQ2164.2 +028900P MOVE ERROR-HOLD TO C-ALL. SQ2164.2 +029000P MOVE ERROR-COUNTER TO C-FAIL. SQ2164.2 +029100P MOVE DELETE-CNT TO C-DELETED. SQ2164.2 +029200P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2164.2 +029300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2164.2 +029400PEND-E-2. SQ2164.2 +029500P CLOSE RAW-DATA. SQ2164.2 +029600 TERMINATE-CCVS. SQ2164.2 +029700S EXIT PROGRAM. SQ2164.2 +029800STERMINATE-CALL. SQ2164.2 +029900 STOP RUN. SQ2164.2 +030000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2164.2 +030100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2164.2 +030200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2164.2 +030300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2164.2 +030400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2164.2 +030500 PRINT-DETAIL. SQ2164.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ2164.2 +030700 MOVE "." TO PARDOT-X SQ2164.2 +030800 MOVE REC-CT TO DOTVALUE. SQ2164.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2164.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2164.2 +031100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2164.2 +031200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2164.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2164.2 +031400 MOVE SPACE TO CORRECT-X. SQ2164.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2164.2 +031600 MOVE SPACE TO RE-MARK. SQ2164.2 +031700 HEAD-ROUTINE. SQ2164.2 +031800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +031900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2164.2 +032000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2164.2 +032100 COLUMN-NAMES-ROUTINE. SQ2164.2 +032200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +032300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +032500 END-ROUTINE. SQ2164.2 +032600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2164.2 +032700 END-RTN-EXIT. SQ2164.2 +032800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +032900 END-ROUTINE-1. SQ2164.2 +033000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2164.2 +033100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2164.2 +033200 ADD PASS-COUNTER TO ERROR-HOLD. SQ2164.2 +033300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2164.2 +033400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2164.2 +033500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2164.2 +033600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2164.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2164.2 +033800 END-ROUTINE-12. SQ2164.2 +033900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2164.2 +034000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2164.2 +034100 MOVE "NO " TO ERROR-TOTAL SQ2164.2 +034200 ELSE SQ2164.2 +034300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2164.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2164.2 +034500 PERFORM WRITE-LINE. SQ2164.2 +034600 END-ROUTINE-13. SQ2164.2 +034700 IF DELETE-CNT IS EQUAL TO ZERO SQ2164.2 +034800 MOVE "NO " TO ERROR-TOTAL ELSE SQ2164.2 +034900 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2164.2 +035000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2164.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035200 IF INSPECT-COUNTER EQUAL TO ZERO SQ2164.2 +035300 MOVE "NO " TO ERROR-TOTAL SQ2164.2 +035400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2164.2 +035500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2164.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035800 WRITE-LINE. SQ2164.2 +035900 ADD 1 TO RECORD-COUNT. SQ2164.2 +036000Y IF RECORD-COUNT GREATER 50 SQ2164.2 +036100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2164.2 +036200Y MOVE SPACE TO DUMMY-RECORD SQ2164.2 +036300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2164.2 +036400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2164.2 +036500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2164.2 +036600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2164.2 +036700Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2164.2 +036800Y MOVE ZERO TO RECORD-COUNT. SQ2164.2 +036900 PERFORM WRT-LN. SQ2164.2 +037000 WRT-LN. SQ2164.2 +037100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2164.2 +037200 MOVE SPACE TO DUMMY-RECORD. SQ2164.2 +037300 BLANK-LINE-PRINT. SQ2164.2 +037400 PERFORM WRT-LN. SQ2164.2 +037500 FAIL-ROUTINE. SQ2164.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2164.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2164.2 +037800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2164.2 +037900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +038000 GO TO FAIL-ROUTINE-EX. SQ2164.2 +038100 FAIL-ROUTINE-WRITE. SQ2164.2 +038200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2164.2 +038300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +038400 FAIL-ROUTINE-EX. EXIT. SQ2164.2 +038500 BAIL-OUT. SQ2164.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2164.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2164.2 +038800 BAIL-OUT-WRITE. SQ2164.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2164.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +039100 BAIL-OUT-EX. EXIT. SQ2164.2 +039200 CCVS1-EXIT. SQ2164.2 +039300 EXIT. SQ2164.2 +039400 SECT-SQ216A-0001 SECTION. SQ2164.2 +039500 WRITE-INIT-GF-01. SQ2164.2 +039600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2164.2 +039700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2164.2 +039800 MOVE "SQ216" TO XPROGRAM-NAME (1). SQ2164.2 +039900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2164.2 +040000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2164.2 +040100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2164.2 +040200 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2164.2 +040300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2164.2 +040400 MOVE "S" TO XLABEL-TYPE (1). SQ2164.2 +040500 MOVE 000001 TO XRECORD-NUMBER (1). SQ2164.2 +040600 OPEN OUTPUT SQ-FS1. SQ2164.2 +040700 WRITE-TEST-GF-01. SQ2164.2 +040800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2164.2 +040900 WRITE SQ-FS1R1-F-G-120. SQ2164.2 +041000 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2164.2 +041100 GO TO WRITE-WRITE-GF-01. SQ2164.2 +041200 ADD 1 TO XRECORD-NUMBER (1). SQ2164.2 +041300 GO TO WRITE-TEST-GF-01. SQ2164.2 +041400 WRITE-WRITE-GF-01. SQ2164.2 +041500 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2164.2 +041600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2164.2 +041700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2164.2 +041800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2164.2 +041900 PERFORM PASS. SQ2164.2 +042000 PERFORM PRINT-DETAIL. SQ2164.2 +042100 CLOSE SQ-FS1. SQ2164.2 +042200* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ2164.2 +042300* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ2164.2 +042400 READ-INIT-F1-01. SQ2164.2 +042500 MOVE ZERO TO WRK-CS-09V00. SQ2164.2 +042600* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ2164.2 +042700* WRITE-TEST-GF-01. SQ2164.2 +042800 OPEN INPUT SQ-FS1. SQ2164.2 +042900 READ-TEST-F1-01. SQ2164.2 +043000 READ SQ-FS1 SQ2164.2 +043100 AT END GO TO READ-TEST-F1-01-1. SQ2164.2 +043200 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2164.2 +043300 ADD 1 TO WRK-CS-09V00. SQ2164.2 +043400 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +043500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2164.2 +043600 GO TO READ-FAIL-F1-01. SQ2164.2 +043700 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2164.2 +043800 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +043900 GO TO READ-TEST-F1-01. SQ2164.2 +044000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2164.2 +044100 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +044200 GO TO READ-TEST-F1-01. SQ2164.2 +044300 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2164.2 +044400 ADD 1 TO RECORDS-IN-ERROR. SQ2164.2 +044500 GO TO READ-TEST-F1-01. SQ2164.2 +044600 READ-TEST-F1-01-1. SQ2164.2 +044700 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2164.2 +044800 GO TO READ-PASS-F1-01. SQ2164.2 +044900 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2164.2 +045000 READ-FAIL-F1-01. SQ2164.2 +045100 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +045200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2164.2 +045300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2164.2 +045400 PERFORM FAIL. SQ2164.2 +045500 GO TO READ-WRITE-F1-01. SQ2164.2 +045600 READ-PASS-F1-01. SQ2164.2 +045700 PERFORM PASS. SQ2164.2 +045800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2164.2 +045900 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2164.2 +046000 READ-WRITE-F1-01. SQ2164.2 +046100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2164.2 +046200 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2164.2 +046300 PERFORM PRINT-DETAIL. SQ2164.2 +046400 READ-CLOSE-F1-01. SQ2164.2 +046500 CLOSE SQ-FS1. SQ2164.2 +046600 READ-INIT-F1-02. SQ2164.2 +046700 MOVE ZERO TO WRK-CS-09V00. SQ2164.2 +046800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2164.2 +046900 OPEN INPUT SQ-FS1. SQ2164.2 +047000* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ2164.2 +047100* IN THIS SERIES OF TESTS. SQ2164.2 +047200 MOVE "LEV 2 PADDING CHARS " TO FEATURE. SQ2164.2 +047300 MOVE "READ...RECORD AT END ..." TO RE-MARK. SQ2164.2 +047400 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2164.2 +047500 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +047600 READ-TEST-F1-02. SQ2164.2 +047700 READ SQ-FS1 RECORD AT END SQ2164.2 +047800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +047900 MOVE 1 TO EOF-FLAG SQ2164.2 +048000 GO TO READ-FAIL-F1-02. SQ2164.2 +048100 PERFORM RECORD-CHECK. SQ2164.2 +048200 IF WRK-CS-09V00 EQUAL TO 200 SQ2164.2 +048300 GO TO READ-TEST-F1-02-1. SQ2164.2 +048400 GO TO READ-TEST-F1-02. SQ2164.2 +048500 RECORD-CHECK. SQ2164.2 +048600 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2164.2 +048700 ADD 1 TO WRK-CS-09V00. SQ2164.2 +048800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2164.2 +048900 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +049000 MOVE 1 TO ERROR-FLAG. SQ2164.2 +049100 READ-TEST-F1-02-1. SQ2164.2 +049200 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +049300 GO TO READ-PASS-F1-02. SQ2164.2 +049400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +049500 READ-FAIL-F1-02. SQ2164.2 +049600 PERFORM FAIL. SQ2164.2 +049700 GO TO READ-WRITE-F1-02. SQ2164.2 +049800 READ-PASS-F1-02. SQ2164.2 +049900 PERFORM PASS. SQ2164.2 +050000 READ-WRITE-F1-02. SQ2164.2 +050100 PERFORM PRINT-DETAIL. SQ2164.2 +050200 READ-INIT-F1-F1-03. SQ2164.2 +050300 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +050400 GO TO READ-EOF-06. SQ2164.2 +050500 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +050600 MOVE "READ...AT END..." TO RE-MARK. SQ2164.2 +050700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2164.2 +050800 READ-TEST-F1-03. SQ2164.2 +050900 READ SQ-FS1 AT END SQ2164.2 +051000 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +051100 MOVE 1 TO EOF-FLAG SQ2164.2 +051200 GO TO READ-FAIL-F1-03. SQ2164.2 +051300 PERFORM RECORD-CHECK. SQ2164.2 +051400 IF WRK-CS-09V00 EQUAL TO 400 SQ2164.2 +051500 GO TO READ-TEST-F1-03-1. SQ2164.2 +051600 GO TO READ-TEST-F1-03. SQ2164.2 +051700 READ-TEST-F1-03-1. SQ2164.2 +051800 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +051900 GO TO READ-PASS-F1-03. SQ2164.2 +052000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +052100 READ-FAIL-F1-03. SQ2164.2 +052200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +052300 PERFORM FAIL. SQ2164.2 +052400 GO TO READ-WRITE-F1-03. SQ2164.2 +052500 READ-PASS-F1-03. SQ2164.2 +052600 PERFORM PASS. SQ2164.2 +052700 READ-WRITE-F1-03. SQ2164.2 +052800 PERFORM PRINT-DETAIL. SQ2164.2 +052900 READ-INIT-F1-04. SQ2164.2 +053000 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +053100 GO TO READ-EOF-06. SQ2164.2 +053200 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +053300 MOVE "READ...RECORD END..." TO RE-MARK. SQ2164.2 +053400 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2164.2 +053500 READ-TEST-F1-04. SQ2164.2 +053600 READ SQ-FS1 RECORD END SQ2164.2 +053700 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +053800 MOVE 1 TO EOF-FLAG SQ2164.2 +053900 GO TO READ-FAIL-F1-04. SQ2164.2 +054000 PERFORM RECORD-CHECK. SQ2164.2 +054100 IF WRK-CS-09V00 EQUAL TO 600 SQ2164.2 +054200 GO TO READ-TEST-F1-04-1. SQ2164.2 +054300 GO TO READ-TEST-F1-04. SQ2164.2 +054400 READ-TEST-F1-04-1. SQ2164.2 +054500 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +054600 GO TO READ-PASS-F1-04. SQ2164.2 +054700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +054800 READ-FAIL-F1-04. SQ2164.2 +054900 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +055000 PERFORM FAIL. SQ2164.2 +055100 GO TO READ-WRITE-F1-04. SQ2164.2 +055200 READ-PASS-F1-04. SQ2164.2 +055300 PERFORM PASS. SQ2164.2 +055400 READ-WRITE-F1-04. SQ2164.2 +055500 PERFORM PRINT-DETAIL. SQ2164.2 +055600 READ-INIT-F1-05. SQ2164.2 +055700 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +055800 GO TO READ-EOF-06. SQ2164.2 +055900 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +056000 MOVE "READ...END..." TO RE-MARK. SQ2164.2 +056100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2164.2 +056200 READ-TEST-F1-05. SQ2164.2 +056300 READ SQ-FS1 END GO TO READ-TEST-F1-05-1. SQ2164.2 +056400 PERFORM RECORD-CHECK. SQ2164.2 +056500 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +056600 GO TO READ-TEST-F1-05-1. SQ2164.2 +056700 GO TO READ-TEST-F1-05. SQ2164.2 +056800 READ-TEST-F1-05-1. SQ2164.2 +056900 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +057000 GO TO READ-PASS-F1-05. SQ2164.2 +057100 READ-FAIL-F1-05. SQ2164.2 +057200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +057300 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +057400 PERFORM FAIL. SQ2164.2 +057500 GO TO READ-WRITE-F1-05. SQ2164.2 +057600 READ-PASS-F1-05. SQ2164.2 +057700 PERFORM PASS. SQ2164.2 +057800 READ-WRITE-F1-05. SQ2164.2 +057900 PERFORM PRINT-DETAIL. SQ2164.2 +058000 READ-TEST-06. SQ2164.2 +058100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2164.2 +058200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2164.2 +058300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK SQ2164.2 +058400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2164.2 +058500 GO TO READ-FAIL-06. SQ2164.2 +058600 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +058700 MOVE "MORE THAN 750 RECORDS; VII-12 PADDING CHARS" TO RE-MARKSQ2164.2 +058800 GO TO READ-FAIL-06. SQ2164.2 +058900 READ-PASS-06. SQ2164.2 +059000 PERFORM PASS. SQ2164.2 +059100 GO TO READ-WRITE-06. SQ2164.2 +059200 READ-EOF-06. SQ2164.2 +059300 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ2164.2 +059400 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2164.2 +059500 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2164.2 +059600 READ-FAIL-06. SQ2164.2 +059700 PERFORM FAIL. SQ2164.2 +059800 READ-WRITE-06. SQ2164.2 +059900 MOVE "READ-TEST-06 " TO PAR-NAME. SQ2164.2 +060000 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ2164.2 +060100 PERFORM PRINT-DETAIL. SQ2164.2 +060200 READ-CLOSE-003. SQ2164.2 +060300 CLOSE SQ-FS1. SQ2164.2 +060400 TERMINATE-ROUTINE. SQ2164.2 +060500 EXIT. SQ2164.2 +060600 CCVS-EXIT SECTION. SQ2164.2 +060700 CCVS-999999. SQ2164.2 +060800 GO TO CLOSE-FILES. SQ2164.2 +*END-OF,SQ216A +*HEADER,COBOL,SQ217A +000100 IDENTIFICATION DIVISION. SQ2174.2 +000200 PROGRAM-ID. SQ2174.2 +000300 SQ217A. SQ2174.2 +000400**************************************************************** SQ2174.2 +000500* * SQ2174.2 +000600* VALIDATION FOR:- * SQ2174.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2174.2 +000800* * SQ2174.2 +000900* CREATION DATE / VALIDATION DATE * SQ2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2174.2 +001100* * SQ2174.2 +001200* THIS ROUTINE TESTS THE CLAUSE: SQ2174.2 +001300* PADDING CHARACTER IS DATA-NAME-1 (VALUE "Z"). SQ2174.2 +001400* SQ2174.2 +001500* THE ROUTINE SQ217A CREATES A TAPE FILE WHICH HAS 750 FIXESQ2174.2 +001600* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ2174.2 +001700* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ2174.2 +001800* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ2174.2 +001900* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ2174.2 +002000* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ2174.2 +002100* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ2174.2 +002200* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ2174.2 +002300* LEVEL TWO PADDING CHARCTER IS "Z". SQ2174.2 +002400* SQ2174.2 +002500* THE LAST 9 RECORDS MUST BE FILLED WITH THE PADDING CHARACTER SQ2174.2 +002600* PADDING-CHARACTER PIC X VALUE "Z". SQ2174.2 +002700* SQ2174.2 +002800 ENVIRONMENT DIVISION. SQ2174.2 +002900 CONFIGURATION SECTION. SQ2174.2 +003000 SOURCE-COMPUTER. SQ2174.2 +003100 XXXXX082. SQ2174.2 +003200 OBJECT-COMPUTER. SQ2174.2 +003300 XXXXX083. SQ2174.2 +003400 INPUT-OUTPUT SECTION. SQ2174.2 +003500 FILE-CONTROL. SQ2174.2 +003600P SELECT RAW-DATA ASSIGN TO SQ2174.2 +003700P XXXXX062 SQ2174.2 +003800P ORGANIZATION IS INDEXED SQ2174.2 +003900P ACCESS MODE IS RANDOM SQ2174.2 +004000P RECORD KEY IS RAW-DATA-KEY. SQ2174.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ2174.2 +004200 XXXXX055. SQ2174.2 +004300 SELECT SQ-FS1 ASSIGN TO SQ2174.2 +004400 XXXXX001 SQ2174.2 +004500 ORGANIZATION IS SEQUENTIAL SQ2174.2 +004600 PADDING PADDING-CHARACTER SQ2174.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ2174.2 +004800 DATA DIVISION. SQ2174.2 +004900 FILE SECTION. SQ2174.2 +005000P SQ2174.2 +005100PFD RAW-DATA. SQ2174.2 +005200P SQ2174.2 +005300P01 RAW-DATA-SATZ. SQ2174.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ2174.2 +005500P 05 C-DATE PIC 9(6). SQ2174.2 +005600P 05 C-TIME PIC 9(8). SQ2174.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ2174.2 +005800P 05 C-OK PIC 999. SQ2174.2 +005900P 05 C-ALL PIC 999. SQ2174.2 +006000P 05 C-FAIL PIC 999. SQ2174.2 +006100P 05 C-DELETED PIC 999. SQ2174.2 +006200P 05 C-INSPECT PIC 999. SQ2174.2 +006300P 05 C-NOTE PIC X(13). SQ2174.2 +006400P 05 C-INDENT PIC X. SQ2174.2 +006500P 05 C-ABORT PIC X(8). SQ2174.2 +006600 FD PRINT-FILE SQ2174.2 +006700C LABEL RECORDS SQ2174.2 +006800C XXXXX084 SQ2174.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2174.2 +007000 . SQ2174.2 +007100 01 PRINT-REC PICTURE X(120). SQ2174.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2174.2 +007300 FD SQ-FS1 SQ2174.2 +007400C LABEL RECORD STANDARD SQ2174.2 +007500 RECORD CONTAINS 120 CHARACTERS SQ2174.2 +007600 BLOCK CONTAINS 13 RECORDS. SQ2174.2 +007700 01 SQ-FS1R1-F-G-120. SQ2174.2 +007800 02 FILLER PIC X(120). SQ2174.2 +007900 WORKING-STORAGE SECTION. SQ2174.2 +008000 01 PADDING-CHARACTER PIC X VALUE "Z". SQ2174.2 +008100 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ2174.2 +008200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ2174.2 +008300 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ2174.2 +008400 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ2174.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ2174.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ2174.2 +008700 05 FILLER PICTURE X(48) VALUE SQ2174.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2174.2 +008900 05 FILLER PICTURE X(46) VALUE SQ2174.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2174.2 +009100 05 FILLER PICTURE X(26) VALUE SQ2174.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ2174.2 +009300 05 FILLER PICTURE X(37) VALUE SQ2174.2 +009400 ",RECKEY= ". SQ2174.2 +009500 05 FILLER PICTURE X(38) VALUE SQ2174.2 +009600 ",ALTKEY1= ". SQ2174.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2174.2 +009800 ",ALTKEY2= ". SQ2174.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2174.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2174.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ2174.2 +010200 07 FILLER PIC X(5). SQ2174.2 +010300 07 XFILE-NAME PIC X(6). SQ2174.2 +010400 07 FILLER PIC X(8). SQ2174.2 +010500 07 XRECORD-NAME PIC X(6). SQ2174.2 +010600 07 FILLER PIC X(1). SQ2174.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ2174.2 +010800 07 FILLER PIC X(7). SQ2174.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ2174.2 +011000 07 FILLER PIC X(6). SQ2174.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ2174.2 +011200 07 FILLER PIC X(5). SQ2174.2 +011300 07 ODO-NUMBER PIC 9(4). SQ2174.2 +011400 07 FILLER PIC X(5). SQ2174.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ2174.2 +011600 07 FILLER PIC X(7). SQ2174.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ2174.2 +011800 07 FILLER PIC X(7). SQ2174.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ2174.2 +012000 07 FILLER PIC X(1). SQ2174.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ2174.2 +012200 07 FILLER PIC X(6). SQ2174.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ2174.2 +012400 07 FILLER PIC X(5). SQ2174.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ2174.2 +012600 07 FILLER PIC X(6). SQ2174.2 +012700 07 XLABEL-TYPE PIC X(1). SQ2174.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ2174.2 +012900 07 FILLER PIC X(8). SQ2174.2 +013000 07 XRECORD-KEY PIC X(29). SQ2174.2 +013100 07 FILLER PIC X(9). SQ2174.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ2174.2 +013300 07 FILLER PIC X(9). SQ2174.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ2174.2 +013500 07 FILLER PIC X(7). SQ2174.2 +013600 01 TEST-RESULTS. SQ2174.2 +013700 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +013800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2174.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +014000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2174.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +014200 02 PAR-NAME. SQ2174.2 +014300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2174.2 +014400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2174.2 +014500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2174.2 +014600 03 FILLER PIC X(5) VALUE SPACE. SQ2174.2 +014700 02 FILLER PIC X(10) VALUE SPACE. SQ2174.2 +014800 02 RE-MARK PIC X(61). SQ2174.2 +014900 01 TEST-COMPUTED. SQ2174.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ2174.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2174.2 +015200 02 COMPUTED-X. SQ2174.2 +015300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2174.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2174.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2174.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2174.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2174.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2174.2 +015900 04 COMPUTED-18V0 PICTURE -9(18). SQ2174.2 +016000 04 FILLER PICTURE X. SQ2174.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ2174.2 +016200 01 TEST-CORRECT. SQ2174.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2174.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2174.2 +016500 02 CORRECT-X. SQ2174.2 +016600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2174.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2174.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2174.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2174.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2174.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ2174.2 +017200 04 CORRECT-18V0 PICTURE -9(18). SQ2174.2 +017300 04 FILLER PICTURE X. SQ2174.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ2174.2 +017500 01 CCVS-C-1. SQ2174.2 +017600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2174.2 +017700- "SS PARAGRAPH-NAME SQ2174.2 +017800- " REMARKS". SQ2174.2 +017900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2174.2 +018000 01 CCVS-C-2. SQ2174.2 +018100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +018200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2174.2 +018300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2174.2 +018400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2174.2 +018500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2174.2 +018600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2174.2 +018700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2174.2 +018800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2174.2 +018900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2174.2 +019000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2174.2 +019100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2174.2 +019200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2174.2 +019300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2174.2 +019400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2174.2 +019500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2174.2 +019600 01 CCVS-H-1. SQ2174.2 +019700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2174.2 +019800 02 FILLER PICTURE X(67) VALUE SQ2174.2 +019900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2174.2 +020000- " SYSTEM". SQ2174.2 +020100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2174.2 +020200 01 CCVS-H-2. SQ2174.2 +020300 02 FILLER PICTURE X(52) VALUE IS SQ2174.2 +020400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2174.2 +020500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2174.2 +020600 02 TEST-ID PICTURE IS X(9). SQ2174.2 +020700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2174.2 +020800 01 CCVS-H-3. SQ2174.2 +020900 02 FILLER PICTURE X(34) VALUE SQ2174.2 +021000 " FOR OFFICIAL USE ONLY ". SQ2174.2 +021100 02 FILLER PICTURE X(58) VALUE SQ2174.2 +021200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2174.2 +021300 02 FILLER PICTURE X(28) VALUE SQ2174.2 +021400 " COPYRIGHT 1985 ". SQ2174.2 +021500 01 CCVS-E-1. SQ2174.2 +021600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2174.2 +021700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2174.2 +021800 02 ID-AGAIN PICTURE IS X(9). SQ2174.2 +021900 02 FILLER PICTURE X(45) VALUE IS SQ2174.2 +022000 " NTIS DISTRIBUTION COBOL 85". SQ2174.2 +022100 01 CCVS-E-2. SQ2174.2 +022200 02 FILLER PICTURE X(31) VALUE SQ2174.2 +022300 SPACE. SQ2174.2 +022400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2174.2 +022500 02 CCVS-E-2-2. SQ2174.2 +022600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2174.2 +022700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +022800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2174.2 +022900 01 CCVS-E-3. SQ2174.2 +023000 02 FILLER PICTURE X(22) VALUE SQ2174.2 +023100 " FOR OFFICIAL USE ONLY". SQ2174.2 +023200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2174.2 +023300 02 FILLER PICTURE X(58) VALUE SQ2174.2 +023400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2174.2 +023500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2174.2 +023600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2174.2 +023700 01 CCVS-E-4. SQ2174.2 +023800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2174.2 +023900 02 FILLER PIC XXXX VALUE " OF ". SQ2174.2 +024000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2174.2 +024100 02 FILLER PIC X(40) VALUE SQ2174.2 +024200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2174.2 +024300 01 XXINFO. SQ2174.2 +024400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2174.2 +024500 02 INFO-TEXT. SQ2174.2 +024600 04 FILLER PIC X(20) VALUE SPACE. SQ2174.2 +024700 04 XXCOMPUTED PIC X(20). SQ2174.2 +024800 04 FILLER PIC X(5) VALUE SPACE. SQ2174.2 +024900 04 XXCORRECT PIC X(20). SQ2174.2 +025000 01 HYPHEN-LINE. SQ2174.2 +025100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +025200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2174.2 +025300- "*****************************************". SQ2174.2 +025400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2174.2 +025500- "******************************". SQ2174.2 +025600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2174.2 +025700 "SQ217A". SQ2174.2 +025800 PROCEDURE DIVISION. SQ2174.2 +025900 CCVS1 SECTION. SQ2174.2 +026000 OPEN-FILES. SQ2174.2 +026100P OPEN I-O RAW-DATA. SQ2174.2 +026200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2174.2 +026300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2174.2 +026400P MOVE "ABORTED " TO C-ABORT. SQ2174.2 +026500P ADD 1 TO C-NO-OF-TESTS. SQ2174.2 +026600P ACCEPT C-DATE FROM DATE. SQ2174.2 +026700P ACCEPT C-TIME FROM TIME. SQ2174.2 +026800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2174.2 +026900PEND-E-1. SQ2174.2 +027000P CLOSE RAW-DATA. SQ2174.2 +027100 OPEN OUTPUT PRINT-FILE. SQ2174.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2174.2 +027300 MOVE SPACE TO TEST-RESULTS. SQ2174.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2174.2 +027500 MOVE ZERO TO REC-SKL-SUB. SQ2174.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2174.2 +027700 CCVS-INIT-FILE. SQ2174.2 +027800 ADD 1 TO REC-SKL-SUB. SQ2174.2 +027900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2174.2 +028000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2174.2 +028100 CCVS-INIT-EXIT. SQ2174.2 +028200 GO TO CCVS1-EXIT. SQ2174.2 +028300 CLOSE-FILES. SQ2174.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2174.2 +028500P OPEN I-O RAW-DATA. SQ2174.2 +028600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2174.2 +028700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2174.2 +028800P MOVE "OK. " TO C-ABORT. SQ2174.2 +028900P MOVE PASS-COUNTER TO C-OK. SQ2174.2 +029000P MOVE ERROR-HOLD TO C-ALL. SQ2174.2 +029100P MOVE ERROR-COUNTER TO C-FAIL. SQ2174.2 +029200P MOVE DELETE-CNT TO C-DELETED. SQ2174.2 +029300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2174.2 +029400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2174.2 +029500PEND-E-2. SQ2174.2 +029600P CLOSE RAW-DATA. SQ2174.2 +029700 TERMINATE-CCVS. SQ2174.2 +029800S EXIT PROGRAM. SQ2174.2 +029900STERMINATE-CALL. SQ2174.2 +030000 STOP RUN. SQ2174.2 +030100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2174.2 +030200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2174.2 +030300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2174.2 +030400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2174.2 +030500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2174.2 +030600 PRINT-DETAIL. SQ2174.2 +030700 IF REC-CT NOT EQUAL TO ZERO SQ2174.2 +030800 MOVE "." TO PARDOT-X SQ2174.2 +030900 MOVE REC-CT TO DOTVALUE. SQ2174.2 +031000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2174.2 +031100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2174.2 +031200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2174.2 +031300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2174.2 +031400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2174.2 +031500 MOVE SPACE TO CORRECT-X. SQ2174.2 +031600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2174.2 +031700 MOVE SPACE TO RE-MARK. SQ2174.2 +031800 HEAD-ROUTINE. SQ2174.2 +031900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +032000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2174.2 +032100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2174.2 +032200 COLUMN-NAMES-ROUTINE. SQ2174.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +032600 END-ROUTINE. SQ2174.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2174.2 +032800 END-RTN-EXIT. SQ2174.2 +032900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +033000 END-ROUTINE-1. SQ2174.2 +033100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2174.2 +033200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2174.2 +033300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2174.2 +033400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2174.2 +033500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2174.2 +033600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2174.2 +033700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2174.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2174.2 +033900 END-ROUTINE-12. SQ2174.2 +034000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2174.2 +034100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2174.2 +034200 MOVE "NO " TO ERROR-TOTAL SQ2174.2 +034300 ELSE SQ2174.2 +034400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2174.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2174.2 +034600 PERFORM WRITE-LINE. SQ2174.2 +034700 END-ROUTINE-13. SQ2174.2 +034800 IF DELETE-CNT IS EQUAL TO ZERO SQ2174.2 +034900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2174.2 +035000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2174.2 +035100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2174.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2174.2 +035400 MOVE "NO " TO ERROR-TOTAL SQ2174.2 +035500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2174.2 +035600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2174.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035900 WRITE-LINE. SQ2174.2 +036000 ADD 1 TO RECORD-COUNT. SQ2174.2 +036100Y IF RECORD-COUNT GREATER 50 SQ2174.2 +036200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2174.2 +036300Y MOVE SPACE TO DUMMY-RECORD SQ2174.2 +036400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2174.2 +036500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2174.2 +036600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2174.2 +036700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2174.2 +036800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2174.2 +036900Y MOVE ZERO TO RECORD-COUNT. SQ2174.2 +037000 PERFORM WRT-LN. SQ2174.2 +037100 WRT-LN. SQ2174.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2174.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ2174.2 +037400 BLANK-LINE-PRINT. SQ2174.2 +037500 PERFORM WRT-LN. SQ2174.2 +037600 FAIL-ROUTINE. SQ2174.2 +037700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2174.2 +037800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2174.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2174.2 +038000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +038100 GO TO FAIL-ROUTINE-EX. SQ2174.2 +038200 FAIL-ROUTINE-WRITE. SQ2174.2 +038300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2174.2 +038400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +038500 FAIL-ROUTINE-EX. EXIT. SQ2174.2 +038600 BAIL-OUT. SQ2174.2 +038700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2174.2 +038800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2174.2 +038900 BAIL-OUT-WRITE. SQ2174.2 +039000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2174.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +039200 BAIL-OUT-EX. EXIT. SQ2174.2 +039300 CCVS1-EXIT. SQ2174.2 +039400 EXIT. SQ2174.2 +039500 SECT-SQ217A-0001 SECTION. SQ2174.2 +039600 WRITE-INIT-GF-01. SQ2174.2 +039700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2174.2 +039800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2174.2 +039900 MOVE "SQ217" TO XPROGRAM-NAME (1). SQ2174.2 +040000 MOVE 000120 TO XRECORD-LENGTH (1). SQ2174.2 +040100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2174.2 +040200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2174.2 +040300 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2174.2 +040400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2174.2 +040500 MOVE "S" TO XLABEL-TYPE (1). SQ2174.2 +040600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2174.2 +040700 OPEN OUTPUT SQ-FS1. SQ2174.2 +040800 WRITE-TEST-GF-01. SQ2174.2 +040900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2174.2 +041000 WRITE SQ-FS1R1-F-G-120. SQ2174.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2174.2 +041200 GO TO WRITE-WRITE-GF-01. SQ2174.2 +041300 ADD 1 TO XRECORD-NUMBER (1). SQ2174.2 +041400 GO TO WRITE-TEST-GF-01. SQ2174.2 +041500 WRITE-WRITE-GF-01. SQ2174.2 +041600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2174.2 +041700 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2174.2 +041800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2174.2 +041900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2174.2 +042000 PERFORM PASS. SQ2174.2 +042100 PERFORM PRINT-DETAIL. SQ2174.2 +042200 CLOSE SQ-FS1. SQ2174.2 +042300* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ2174.2 +042400* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ2174.2 +042500 READ-INIT-F1-01. SQ2174.2 +042600 MOVE ZERO TO WRK-CS-09V00. SQ2174.2 +042700* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ2174.2 +042800* WRITE-TEST-GF-01. SQ2174.2 +042900 OPEN INPUT SQ-FS1. SQ2174.2 +043000 READ-TEST-F1-01. SQ2174.2 +043100 READ SQ-FS1 SQ2174.2 +043200 AT END GO TO READ-TEST-F1-01-1. SQ2174.2 +043300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2174.2 +043400 ADD 1 TO WRK-CS-09V00. SQ2174.2 +043500 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +043600 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2174.2 +043700 GO TO READ-FAIL-F1-01. SQ2174.2 +043800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2174.2 +043900 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +044000 GO TO READ-TEST-F1-01. SQ2174.2 +044100 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2174.2 +044200 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +044300 GO TO READ-TEST-F1-01. SQ2174.2 +044400 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2174.2 +044500 ADD 1 TO RECORDS-IN-ERROR. SQ2174.2 +044600 GO TO READ-TEST-F1-01. SQ2174.2 +044700 READ-TEST-F1-01-1. SQ2174.2 +044800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2174.2 +044900 GO TO READ-PASS-F1-01. SQ2174.2 +045000 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2174.2 +045100 READ-FAIL-F1-01. SQ2174.2 +045200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +045300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2174.2 +045400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2174.2 +045500 PERFORM FAIL. SQ2174.2 +045600 GO TO READ-WRITE-F1-01. SQ2174.2 +045700 READ-PASS-F1-01. SQ2174.2 +045800 PERFORM PASS. SQ2174.2 +045900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2174.2 +046000 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2174.2 +046100 READ-WRITE-F1-01. SQ2174.2 +046200 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2174.2 +046300 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2174.2 +046400 PERFORM PRINT-DETAIL. SQ2174.2 +046500 READ-CLOSE-F1-01. SQ2174.2 +046600 CLOSE SQ-FS1. SQ2174.2 +046700 READ-INIT-F1-02. SQ2174.2 +046800 MOVE ZERO TO WRK-CS-09V00. SQ2174.2 +046900 MOVE ZERO TO RECORDS-IN-ERROR. SQ2174.2 +047000 OPEN INPUT SQ-FS1. SQ2174.2 +047100* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ2174.2 +047200* IN THIS SERIES OF TESTS. SQ2174.2 +047300 MOVE "LEV 2 PADDING CHARS " TO FEATURE. SQ2174.2 +047400 MOVE "READ...RECORD AT END ..." TO RE-MARK. SQ2174.2 +047500 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2174.2 +047600 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +047700 READ-TEST-F1-02. SQ2174.2 +047800 READ SQ-FS1 RECORD AT END SQ2174.2 +047900 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +048000 MOVE 1 TO EOF-FLAG SQ2174.2 +048100 GO TO READ-FAIL-F1-02. SQ2174.2 +048200 PERFORM RECORD-CHECK. SQ2174.2 +048300 IF WRK-CS-09V00 EQUAL TO 200 SQ2174.2 +048400 GO TO READ-TEST-F1-02-1. SQ2174.2 +048500 GO TO READ-TEST-F1-02. SQ2174.2 +048600 RECORD-CHECK. SQ2174.2 +048700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2174.2 +048800 ADD 1 TO WRK-CS-09V00. SQ2174.2 +048900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2174.2 +049000 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +049100 MOVE 1 TO ERROR-FLAG. SQ2174.2 +049200 READ-TEST-F1-02-1. SQ2174.2 +049300 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +049400 GO TO READ-PASS-F1-02. SQ2174.2 +049500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +049600 READ-FAIL-F1-02. SQ2174.2 +049700 PERFORM FAIL. SQ2174.2 +049800 GO TO READ-WRITE-F1-02. SQ2174.2 +049900 READ-PASS-F1-02. SQ2174.2 +050000 PERFORM PASS. SQ2174.2 +050100 READ-WRITE-F1-02. SQ2174.2 +050200 PERFORM PRINT-DETAIL. SQ2174.2 +050300 READ-INIT-F1-F1-03. SQ2174.2 +050400 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +050500 GO TO READ-EOF-06. SQ2174.2 +050600 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +050700 MOVE "READ...AT END..." TO RE-MARK. SQ2174.2 +050800 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2174.2 +050900 READ-TEST-F1-03. SQ2174.2 +051000 READ SQ-FS1 AT END SQ2174.2 +051100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +051200 MOVE 1 TO EOF-FLAG SQ2174.2 +051300 GO TO READ-FAIL-F1-03. SQ2174.2 +051400 PERFORM RECORD-CHECK. SQ2174.2 +051500 IF WRK-CS-09V00 EQUAL TO 400 SQ2174.2 +051600 GO TO READ-TEST-F1-03-1. SQ2174.2 +051700 GO TO READ-TEST-F1-03. SQ2174.2 +051800 READ-TEST-F1-03-1. SQ2174.2 +051900 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +052000 GO TO READ-PASS-F1-03. SQ2174.2 +052100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +052200 READ-FAIL-F1-03. SQ2174.2 +052300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +052400 PERFORM FAIL. SQ2174.2 +052500 GO TO READ-WRITE-F1-03. SQ2174.2 +052600 READ-PASS-F1-03. SQ2174.2 +052700 PERFORM PASS. SQ2174.2 +052800 READ-WRITE-F1-03. SQ2174.2 +052900 PERFORM PRINT-DETAIL. SQ2174.2 +053000 READ-INIT-F1-04. SQ2174.2 +053100 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +053200 GO TO READ-EOF-06. SQ2174.2 +053300 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +053400 MOVE "READ...RECORD END..." TO RE-MARK. SQ2174.2 +053500 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2174.2 +053600 READ-TEST-F1-04. SQ2174.2 +053700 READ SQ-FS1 RECORD END SQ2174.2 +053800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +053900 MOVE 1 TO EOF-FLAG SQ2174.2 +054000 GO TO READ-FAIL-F1-04. SQ2174.2 +054100 PERFORM RECORD-CHECK. SQ2174.2 +054200 IF WRK-CS-09V00 EQUAL TO 600 SQ2174.2 +054300 GO TO READ-TEST-F1-04-1. SQ2174.2 +054400 GO TO READ-TEST-F1-04. SQ2174.2 +054500 READ-TEST-F1-04-1. SQ2174.2 +054600 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +054700 GO TO READ-PASS-F1-04. SQ2174.2 +054800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +054900 READ-FAIL-F1-04. SQ2174.2 +055000 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +055100 PERFORM FAIL. SQ2174.2 +055200 GO TO READ-WRITE-F1-04. SQ2174.2 +055300 READ-PASS-F1-04. SQ2174.2 +055400 PERFORM PASS. SQ2174.2 +055500 READ-WRITE-F1-04. SQ2174.2 +055600 PERFORM PRINT-DETAIL. SQ2174.2 +055700 READ-INIT-F1-05. SQ2174.2 +055800 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +055900 GO TO READ-EOF-06. SQ2174.2 +056000 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +056100 MOVE "READ...END..." TO RE-MARK. SQ2174.2 +056200 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2174.2 +056300 READ-TEST-F1-05. SQ2174.2 +056400 READ SQ-FS1 END GO TO READ-TEST-F1-05-1. SQ2174.2 +056500 PERFORM RECORD-CHECK. SQ2174.2 +056600 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +056700 GO TO READ-TEST-F1-05-1. SQ2174.2 +056800 GO TO READ-TEST-F1-05. SQ2174.2 +056900 READ-TEST-F1-05-1. SQ2174.2 +057000 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +057100 GO TO READ-PASS-F1-05. SQ2174.2 +057200 READ-FAIL-F1-05. SQ2174.2 +057300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +057400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +057500 PERFORM FAIL. SQ2174.2 +057600 GO TO READ-WRITE-F1-05. SQ2174.2 +057700 READ-PASS-F1-05. SQ2174.2 +057800 PERFORM PASS. SQ2174.2 +057900 READ-WRITE-F1-05. SQ2174.2 +058000 PERFORM PRINT-DETAIL. SQ2174.2 +058100 READ-TEST-06. SQ2174.2 +058200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2174.2 +058300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2174.2 +058400 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK SQ2174.2 +058500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2174.2 +058600 GO TO READ-FAIL-06. SQ2174.2 +058700 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +058800 MOVE "MORE THAN 750 RECORDS; VII-12 PADDING CHARS" TO RE-MARKSQ2174.2 +058900 GO TO READ-FAIL-06. SQ2174.2 +059000 READ-PASS-06. SQ2174.2 +059100 PERFORM PASS. SQ2174.2 +059200 GO TO READ-WRITE-06. SQ2174.2 +059300 READ-EOF-06. SQ2174.2 +059400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ2174.2 +059500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2174.2 +059600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2174.2 +059700 READ-FAIL-06. SQ2174.2 +059800 PERFORM FAIL. SQ2174.2 +059900 READ-WRITE-06. SQ2174.2 +060000 MOVE "READ-TEST-06 " TO PAR-NAME. SQ2174.2 +060100 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ2174.2 +060200 PERFORM PRINT-DETAIL. SQ2174.2 +060300 READ-CLOSE-003. SQ2174.2 +060400 CLOSE SQ-FS1. SQ2174.2 +060500 TERMINATE-ROUTINE. SQ2174.2 +060600 EXIT. SQ2174.2 +060700 CCVS-EXIT SECTION. SQ2174.2 +060800 CCVS-999999. SQ2174.2 +060900 GO TO CLOSE-FILES. SQ2174.2 +*END-OF,SQ217A +*HEADER,COBOL,SQ218A +000100 IDENTIFICATION DIVISION. SQ2184.2 +000200 PROGRAM-ID. SQ2184.2 +000300 SQ218A. SQ2184.2 +000400**************************************************************** SQ2184.2 +000500* * SQ2184.2 +000600* VALIDATION FOR:- * SQ2184.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2184.2 +000800* * SQ2184.2 +000900* CREATION DATE / VALIDATION DATE * SQ2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2184.2 +001100* * SQ2184.2 +001200* THIS ROUTINE CHECKS THE SQ2184.2 +001300* RECORD DELIMITER IS STANDARD-1 CLAUSE. SQ2184.2 +001400* SQ2184.2 +001500* SEE VII-13. SQ2184.2 +001600* SQ2184.2 +001700* SQ2184.2 +001800* THIS ROUTINE BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS SQ2184.2 +001900* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. THE TAPE SQ2184.2 +002000* CONSISTS OF 1 SHORT, 1 LONG, 10 SHORT, 100 LONG, AND 338 SQ2184.2 +002100* SHORT RECORDS FOR A TOTAL OF 450 RECORDS IN THE FILE. SQ2184.2 +002200* THE TAPE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2184.2 +002300* AGAINST THE EXPECTED VALUES. SQ2184.2 +002400* SQ2184.2 +002500* AN INFORMATION SECTION AT THE END OF THE ROUTINE CHECKS SQ2184.2 +002600* THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. THIS FIELD IS SQ2184.2 +002700* PART OF A LONG RECORD ONLY. IF THE XRECORD-NUMBER IS THERE SQ2184.2 +002800* FOR A SHORT RECORD, IT MEANS THE MAXIMUM SIZE RECORD IS SQ2184.2 +002900* ALWAYS WRITTEN. SQ2184.2 +003000 ENVIRONMENT DIVISION. SQ2184.2 +003100 CONFIGURATION SECTION. SQ2184.2 +003200 SOURCE-COMPUTER. SQ2184.2 +003300 XXXXX082. SQ2184.2 +003400 OBJECT-COMPUTER. SQ2184.2 +003500 XXXXX083. SQ2184.2 +003600 INPUT-OUTPUT SECTION. SQ2184.2 +003700 FILE-CONTROL. SQ2184.2 +003800P SELECT RAW-DATA ASSIGN TO SQ2184.2 +003900P XXXXX062 SQ2184.2 +004000P ORGANIZATION IS INDEXED SQ2184.2 +004100P ACCESS MODE IS RANDOM SQ2184.2 +004200P RECORD KEY IS RAW-DATA-KEY. SQ2184.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2184.2 +004400 XXXXX055. SQ2184.2 +004500 SELECT SQ-VS6 ASSIGN SQ2184.2 +004600 XXXXX001 SQ2184.2 +004700 ORGANIZATION IS SEQUENTIAL SQ2184.2 +004800 RECORD DELIMITER IS STANDARD-1. SQ2184.2 +004900 DATA DIVISION. SQ2184.2 +005000 FILE SECTION. SQ2184.2 +005100P SQ2184.2 +005200PFD RAW-DATA. SQ2184.2 +005300P SQ2184.2 +005400P01 RAW-DATA-SATZ. SQ2184.2 +005500P 05 RAW-DATA-KEY PIC X(6). SQ2184.2 +005600P 05 C-DATE PIC 9(6). SQ2184.2 +005700P 05 C-TIME PIC 9(8). SQ2184.2 +005800P 05 C-NO-OF-TESTS PIC 99. SQ2184.2 +005900P 05 C-OK PIC 999. SQ2184.2 +006000P 05 C-ALL PIC 999. SQ2184.2 +006100P 05 C-FAIL PIC 999. SQ2184.2 +006200P 05 C-DELETED PIC 999. SQ2184.2 +006300P 05 C-INSPECT PIC 999. SQ2184.2 +006400P 05 C-NOTE PIC X(13). SQ2184.2 +006500P 05 C-INDENT PIC X. SQ2184.2 +006600P 05 C-ABORT PIC X(8). SQ2184.2 +006700 FD PRINT-FILE SQ2184.2 +006800C LABEL RECORDS SQ2184.2 +006900C XXXXX084 SQ2184.2 +007000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2184.2 +007100 . SQ2184.2 +007200 01 PRINT-REC PICTURE X(120). SQ2184.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2184.2 +007400 FD SQ-VS6 SQ2184.2 +007500 RECORD CONTAINS 120 TO 151 CHARACTERS SQ2184.2 +007600C LABEL RECORDS ARE STANDARD SQ2184.2 +007700C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ2184.2 +007800 . SQ2184.2 +007900 01 SQ-VS6R1-M-G-120. SQ2184.2 +008000 02 SQ-VS6R1-FIRST PIC X(120). SQ2184.2 +008100 01 SQ-VS6R2-M-G-151. SQ2184.2 +008200 02 SQ-VS6R2-FIRST PIC X(120). SQ2184.2 +008300 02 LONG-OR-SHORT PIC X(5). SQ2184.2 +008400 02 SQ-VS6-RECNO PIC X(5). SQ2184.2 +008500 02 SQ-VS6-FILLER PIC X(21). SQ2184.2 +008600 WORKING-STORAGE SECTION. SQ2184.2 +008700 01 SAVE-COUNT-OF-RECS PIC X(5). SQ2184.2 +008800 01 COUNT-OF-RECS PIC S9(5) COMP. SQ2184.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) COMP. SQ2184.2 +009000 01 ERROR-FLAG PIC 9. SQ2184.2 +009100 01 EOF-FLAG PIC 9. SQ2184.2 +009200 01 DUMP-AREA. SQ2184.2 +009300 02 TYPE-OF-REC PICTURE X(5). SQ2184.2 +009400 02 RECNO PIC 9(5). SQ2184.2 +009500 02 REC-FILLER PIC X(21). SQ2184.2 +009600 01 FILE-RECORD-INFORMATION-REC. SQ2184.2 +009700 03 FILE-RECORD-INFO-SKELETON. SQ2184.2 +009800 05 FILLER PICTURE X(48) VALUE SQ2184.2 +009900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2184.2 +010000 05 FILLER PICTURE X(46) VALUE SQ2184.2 +010100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2184.2 +010200 05 FILLER PICTURE X(26) VALUE SQ2184.2 +010300 ",LFIL=000000,ORG= ,LBLR= ". SQ2184.2 +010400 05 FILLER PICTURE X(37) VALUE SQ2184.2 +010500 ",RECKEY= ". SQ2184.2 +010600 05 FILLER PICTURE X(38) VALUE SQ2184.2 +010700 ",ALTKEY1= ". SQ2184.2 +010800 05 FILLER PICTURE X(38) VALUE SQ2184.2 +010900 ",ALTKEY2= ". SQ2184.2 +011000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2184.2 +011100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2184.2 +011200 05 FILE-RECORD-INFO-P1-120. SQ2184.2 +011300 07 FILLER PIC X(5). SQ2184.2 +011400 07 XFILE-NAME PIC X(6). SQ2184.2 +011500 07 FILLER PIC X(8). SQ2184.2 +011600 07 XRECORD-NAME PIC X(6). SQ2184.2 +011700 07 FILLER PIC X(1). SQ2184.2 +011800 07 REELUNIT-NUMBER PIC 9(1). SQ2184.2 +011900 07 FILLER PIC X(7). SQ2184.2 +012000 07 XRECORD-NUMBER PIC 9(6). SQ2184.2 +012100 07 FILLER PIC X(6). SQ2184.2 +012200 07 UPDATE-NUMBER PIC 9(2). SQ2184.2 +012300 07 FILLER PIC X(5). SQ2184.2 +012400 07 ODO-NUMBER PIC 9(4). SQ2184.2 +012500 07 FILLER PIC X(5). SQ2184.2 +012600 07 XPROGRAM-NAME PIC X(5). SQ2184.2 +012700 07 FILLER PIC X(7). SQ2184.2 +012800 07 XRECORD-LENGTH PIC 9(6). SQ2184.2 +012900 07 FILLER PIC X(7). SQ2184.2 +013000 07 CHARS-OR-RECORDS PIC X(2). SQ2184.2 +013100 07 FILLER PIC X(1). SQ2184.2 +013200 07 XBLOCK-SIZE PIC 9(4). SQ2184.2 +013300 07 FILLER PIC X(6). SQ2184.2 +013400 07 RECORDS-IN-FILE PIC 9(6). SQ2184.2 +013500 07 FILLER PIC X(5). SQ2184.2 +013600 07 XFILE-ORGANIZATION PIC X(2). SQ2184.2 +013700 07 FILLER PIC X(6). SQ2184.2 +013800 07 XLABEL-TYPE PIC X(1). SQ2184.2 +013900 05 FILE-RECORD-INFO-P121-240. SQ2184.2 +014000 07 FILLER PIC X(8). SQ2184.2 +014100 07 XRECORD-KEY PIC X(29). SQ2184.2 +014200 07 FILLER PIC X(9). SQ2184.2 +014300 07 ALTERNATE-KEY1 PIC X(29). SQ2184.2 +014400 07 FILLER PIC X(9). SQ2184.2 +014500 07 ALTERNATE-KEY2 PIC X(29). SQ2184.2 +014600 07 FILLER PIC X(7). SQ2184.2 +014700 01 TEST-RESULTS. SQ2184.2 +014800 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +014900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2184.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +015100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2184.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +015300 02 PAR-NAME. SQ2184.2 +015400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2184.2 +015500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2184.2 +015600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2184.2 +015700 03 FILLER PIC X(5) VALUE SPACE. SQ2184.2 +015800 02 FILLER PIC X(10) VALUE SPACE. SQ2184.2 +015900 02 RE-MARK PIC X(61). SQ2184.2 +016000 01 TEST-COMPUTED. SQ2184.2 +016100 02 FILLER PIC X(30) VALUE SPACE. SQ2184.2 +016200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2184.2 +016300 02 COMPUTED-X. SQ2184.2 +016400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2184.2 +016500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2184.2 +016600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2184.2 +016700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2184.2 +016800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2184.2 +016900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2184.2 +017000 04 COMPUTED-18V0 PICTURE -9(18). SQ2184.2 +017100 04 FILLER PICTURE X. SQ2184.2 +017200 03 FILLER PIC X(50) VALUE SPACE. SQ2184.2 +017300 01 TEST-CORRECT. SQ2184.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ2184.2 +017500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2184.2 +017600 02 CORRECT-X. SQ2184.2 +017700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2184.2 +017800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2184.2 +017900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2184.2 +018000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2184.2 +018100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2184.2 +018200 03 CR-18V0 REDEFINES CORRECT-A. SQ2184.2 +018300 04 CORRECT-18V0 PICTURE -9(18). SQ2184.2 +018400 04 FILLER PICTURE X. SQ2184.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ2184.2 +018600 01 CCVS-C-1. SQ2184.2 +018700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2184.2 +018800- "SS PARAGRAPH-NAME SQ2184.2 +018900- " REMARKS". SQ2184.2 +019000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2184.2 +019100 01 CCVS-C-2. SQ2184.2 +019200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +019300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2184.2 +019400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2184.2 +019500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2184.2 +019600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2184.2 +019700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2184.2 +019800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2184.2 +019900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2184.2 +020000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2184.2 +020100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2184.2 +020200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2184.2 +020300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2184.2 +020400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2184.2 +020500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2184.2 +020600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2184.2 +020700 01 CCVS-H-1. SQ2184.2 +020800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2184.2 +020900 02 FILLER PICTURE X(67) VALUE SQ2184.2 +021000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2184.2 +021100- " SYSTEM". SQ2184.2 +021200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2184.2 +021300 01 CCVS-H-2. SQ2184.2 +021400 02 FILLER PICTURE X(52) VALUE IS SQ2184.2 +021500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2184.2 +021600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2184.2 +021700 02 TEST-ID PICTURE IS X(9). SQ2184.2 +021800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2184.2 +021900 01 CCVS-H-3. SQ2184.2 +022000 02 FILLER PICTURE X(34) VALUE SQ2184.2 +022100 " FOR OFFICIAL USE ONLY ". SQ2184.2 +022200 02 FILLER PICTURE X(58) VALUE SQ2184.2 +022300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2184.2 +022400 02 FILLER PICTURE X(28) VALUE SQ2184.2 +022500 " COPYRIGHT 1985 ". SQ2184.2 +022600 01 CCVS-E-1. SQ2184.2 +022700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2184.2 +022800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2184.2 +022900 02 ID-AGAIN PICTURE IS X(9). SQ2184.2 +023000 02 FILLER PICTURE X(45) VALUE IS SQ2184.2 +023100 " NTIS DISTRIBUTION COBOL 85". SQ2184.2 +023200 01 CCVS-E-2. SQ2184.2 +023300 02 FILLER PICTURE X(31) VALUE SQ2184.2 +023400 SPACE. SQ2184.2 +023500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2184.2 +023600 02 CCVS-E-2-2. SQ2184.2 +023700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2184.2 +023800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +023900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2184.2 +024000 01 CCVS-E-3. SQ2184.2 +024100 02 FILLER PICTURE X(22) VALUE SQ2184.2 +024200 " FOR OFFICIAL USE ONLY". SQ2184.2 +024300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2184.2 +024400 02 FILLER PICTURE X(58) VALUE SQ2184.2 +024500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2184.2 +024600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2184.2 +024700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2184.2 +024800 01 CCVS-E-4. SQ2184.2 +024900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2184.2 +025000 02 FILLER PIC XXXX VALUE " OF ". SQ2184.2 +025100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2184.2 +025200 02 FILLER PIC X(40) VALUE SQ2184.2 +025300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2184.2 +025400 01 XXINFO. SQ2184.2 +025500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2184.2 +025600 02 INFO-TEXT. SQ2184.2 +025700 04 FILLER PIC X(20) VALUE SPACE. SQ2184.2 +025800 04 XXCOMPUTED PIC X(20). SQ2184.2 +025900 04 FILLER PIC X(5) VALUE SPACE. SQ2184.2 +026000 04 XXCORRECT PIC X(20). SQ2184.2 +026100 01 HYPHEN-LINE. SQ2184.2 +026200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +026300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2184.2 +026400- "*****************************************". SQ2184.2 +026500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2184.2 +026600- "******************************". SQ2184.2 +026700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2184.2 +026800 "SQ218A". SQ2184.2 +026900 PROCEDURE DIVISION. SQ2184.2 +027000 CCVS1 SECTION. SQ2184.2 +027100 OPEN-FILES. SQ2184.2 +027200P OPEN I-O RAW-DATA. SQ2184.2 +027300P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2184.2 +027400P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2184.2 +027500P MOVE "ABORTED " TO C-ABORT. SQ2184.2 +027600P ADD 1 TO C-NO-OF-TESTS. SQ2184.2 +027700P ACCEPT C-DATE FROM DATE. SQ2184.2 +027800P ACCEPT C-TIME FROM TIME. SQ2184.2 +027900P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2184.2 +028000PEND-E-1. SQ2184.2 +028100P CLOSE RAW-DATA. SQ2184.2 +028200 OPEN OUTPUT PRINT-FILE. SQ2184.2 +028300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2184.2 +028400 MOVE SPACE TO TEST-RESULTS. SQ2184.2 +028500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2184.2 +028600 MOVE ZERO TO REC-SKL-SUB. SQ2184.2 +028700 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2184.2 +028800 CCVS-INIT-FILE. SQ2184.2 +028900 ADD 1 TO REC-SKL-SUB. SQ2184.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2184.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2184.2 +029200 CCVS-INIT-EXIT. SQ2184.2 +029300 GO TO CCVS1-EXIT. SQ2184.2 +029400 CLOSE-FILES. SQ2184.2 +029500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2184.2 +029600P OPEN I-O RAW-DATA. SQ2184.2 +029700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2184.2 +029800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2184.2 +029900P MOVE "OK. " TO C-ABORT. SQ2184.2 +030000P MOVE PASS-COUNTER TO C-OK. SQ2184.2 +030100P MOVE ERROR-HOLD TO C-ALL. SQ2184.2 +030200P MOVE ERROR-COUNTER TO C-FAIL. SQ2184.2 +030300P MOVE DELETE-CNT TO C-DELETED. SQ2184.2 +030400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2184.2 +030500P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2184.2 +030600PEND-E-2. SQ2184.2 +030700P CLOSE RAW-DATA. SQ2184.2 +030800 TERMINATE-CCVS. SQ2184.2 +030900S EXIT PROGRAM. SQ2184.2 +031000STERMINATE-CALL. SQ2184.2 +031100 STOP RUN. SQ2184.2 +031200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2184.2 +031300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2184.2 +031400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2184.2 +031500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2184.2 +031600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2184.2 +031700 PRINT-DETAIL. SQ2184.2 +031800 IF REC-CT NOT EQUAL TO ZERO SQ2184.2 +031900 MOVE "." TO PARDOT-X SQ2184.2 +032000 MOVE REC-CT TO DOTVALUE. SQ2184.2 +032100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2184.2 +032200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2184.2 +032300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2184.2 +032400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2184.2 +032500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2184.2 +032600 MOVE SPACE TO CORRECT-X. SQ2184.2 +032700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2184.2 +032800 MOVE SPACE TO RE-MARK. SQ2184.2 +032900 HEAD-ROUTINE. SQ2184.2 +033000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +033100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2184.2 +033200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2184.2 +033300 COLUMN-NAMES-ROUTINE. SQ2184.2 +033400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +033500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +033600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +033700 END-ROUTINE. SQ2184.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2184.2 +033900 END-RTN-EXIT. SQ2184.2 +034000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +034100 END-ROUTINE-1. SQ2184.2 +034200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2184.2 +034300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2184.2 +034400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2184.2 +034500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2184.2 +034600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2184.2 +034700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2184.2 +034800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2184.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2184.2 +035000 END-ROUTINE-12. SQ2184.2 +035100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2184.2 +035200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2184.2 +035300 MOVE "NO " TO ERROR-TOTAL SQ2184.2 +035400 ELSE SQ2184.2 +035500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2184.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2184.2 +035700 PERFORM WRITE-LINE. SQ2184.2 +035800 END-ROUTINE-13. SQ2184.2 +035900 IF DELETE-CNT IS EQUAL TO ZERO SQ2184.2 +036000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2184.2 +036100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2184.2 +036200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2184.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +036400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2184.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ2184.2 +036600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2184.2 +036700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2184.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +036900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +037000 WRITE-LINE. SQ2184.2 +037100 ADD 1 TO RECORD-COUNT. SQ2184.2 +037200Y IF RECORD-COUNT GREATER 50 SQ2184.2 +037300Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2184.2 +037400Y MOVE SPACE TO DUMMY-RECORD SQ2184.2 +037500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2184.2 +037600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2184.2 +037700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2184.2 +037800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2184.2 +037900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2184.2 +038000Y MOVE ZERO TO RECORD-COUNT. SQ2184.2 +038100 PERFORM WRT-LN. SQ2184.2 +038200 WRT-LN. SQ2184.2 +038300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2184.2 +038400 MOVE SPACE TO DUMMY-RECORD. SQ2184.2 +038500 BLANK-LINE-PRINT. SQ2184.2 +038600 PERFORM WRT-LN. SQ2184.2 +038700 FAIL-ROUTINE. SQ2184.2 +038800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2184.2 +038900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2184.2 +039000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2184.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +039200 GO TO FAIL-ROUTINE-EX. SQ2184.2 +039300 FAIL-ROUTINE-WRITE. SQ2184.2 +039400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2184.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +039600 FAIL-ROUTINE-EX. EXIT. SQ2184.2 +039700 BAIL-OUT. SQ2184.2 +039800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2184.2 +039900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2184.2 +040000 BAIL-OUT-WRITE. SQ2184.2 +040100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2184.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +040300 BAIL-OUT-EX. EXIT. SQ2184.2 +040400 CCVS1-EXIT. SQ2184.2 +040500 EXIT. SQ2184.2 +040600 SECT-SQ218A-0001 SECTION. SQ2184.2 +040700 WRITE-INIT-GF-01. SQ2184.2 +040800 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ2184.2 +040900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2184.2 +041000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2184.2 +041100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2184.2 +041200 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2184.2 +041300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2184.2 +041400 MOVE "S" TO XLABEL-TYPE (1). SQ2184.2 +041500 MOVE 000000 TO XRECORD-NUMBER (1). SQ2184.2 +041600 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +041700 OPEN OUTPUT SQ-VS6. SQ2184.2 +041800 MOVE "MULTIPLE LENGTH RECS " TO SQ-VS6-FILLER. SQ2184.2 +041900 WRITE-TEST-GF-01. SQ2184.2 +042000 PERFORM WRITE-SHORT-REC. SQ2184.2 +042100 PERFORM WRITE-LONG-REC. SQ2184.2 +042200 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2184.2 +042300 PERFORM WRITE-LONG-REC 100 TIMES. SQ2184.2 +042400 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2184.2 +042500 WRITE-WRITE-GF-01. SQ2184.2 +042600 MOVE "CREATE FILE SQ-VS6" TO FEATURE. SQ2184.2 +042700 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2184.2 +042800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2184.2 +042900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2184.2 +043000 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2184.2 +043100 PERFORM PRINT-DETAIL. SQ2184.2 +043200* A SEQUENTIAL TAPE FILE CONTAINING 450 RECORDS HAS SQ2184.2 +043300* BEEN CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS SQ2184.2 +043400* AND RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ2184.2 +043500* RECORDS WERE WRITTEN IS S-L-10S-100L-338S. SQ2184.2 +043600 WRITE-CLOSE-GF-01. SQ2184.2 +043700 CLOSE SQ-VS6. SQ2184.2 +043800 GO TO READ-INIT-F1-01. SQ2184.2 +043900 WRITE-SHORT-REC. SQ2184.2 +044000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2184.2 +044100 MOVE 000120 TO XRECORD-LENGTH (1). SQ2184.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +044300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2184.2 +044400 MOVE "SHORT" TO LONG-OR-SHORT. SQ2184.2 +044500 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2184.2 +044600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R1-FIRST. SQ2184.2 +044700 WRITE SQ-VS6R1-M-G-120. SQ2184.2 +044800 WRITE-LONG-REC. SQ2184.2 +044900 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2184.2 +045000 MOVE 000151 TO XRECORD-LENGTH (1). SQ2184.2 +045100 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +045200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2184.2 +045300 MOVE "LONG" TO LONG-OR-SHORT. SQ2184.2 +045400 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2184.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ2184.2 +045600 WRITE SQ-VS6R2-M-G-151. SQ2184.2 +045700 READ-INIT-F1-01. SQ2184.2 +045800 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +045900 MOVE ZERO TO EOF-FLAG. SQ2184.2 +046000 MOVE ZERO TO RECORDS-IN-ERROR. SQ2184.2 +046100 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +046200 OPEN INPUT SQ-VS6. SQ2184.2 +046300 READ-TEST-F1-01. SQ2184.2 +046400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2184.2 +046500 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +046600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2184.2 +046700 GO TO READ-EOF-F1-06. SQ2184.2 +046800 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +046900 GO TO READ-FAIL-F1-01. SQ2184.2 +047000 READ-PASS-F1-01. SQ2184.2 +047100 PERFORM PASS. SQ2184.2 +047200 GO TO READ-WRITE-F1-01. SQ2184.2 +047300 READ-FAIL-F1-01. SQ2184.2 +047400 MOVE "ERROR ON FIRST READ;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +047500 PERFORM FAIL. SQ2184.2 +047600 READ-WRITE-F1-01. SQ2184.2 +047700 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +047800 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2184.2 +047900 PERFORM PRINT-DETAIL. SQ2184.2 +048000 GO TO READ-INIT-F1-02. SQ2184.2 +048100 READ-SHORT-REC. SQ2184.2 +048200 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +048300 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +048400 READ SQ-VS6 AT END SQ2184.2 +048500 MOVE 1 TO EOF-FLAG SQ2184.2 +048600 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +048700 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +048800 MOVE SQ-VS6R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2184.2 +048900 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2184.2 +049000 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049100 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2184.2 +049200 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2184.2 +049400 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049500 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2184.2 +049600 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +049700 READ-SHORT-REC-ERROR. SQ2184.2 +049800 ADD 1 TO RECORDS-IN-ERROR. SQ2184.2 +049900 MOVE 1 TO ERROR-FLAG. SQ2184.2 +050000 READ-SHORT-REC-EXIT. SQ2184.2 +050100 EXIT. SQ2184.2 +050200 READ-INIT-F1-02. SQ2184.2 +050300 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +050400 READ-TEST-F1-02. SQ2184.2 +050500 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2184.2 +050600 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +050700 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2184.2 +050800 GO TO READ-EOF-F1-06. SQ2184.2 +050900 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +051000 GO TO READ-FAIL-F1-02. SQ2184.2 +051100 READ-PASS-F1-02. SQ2184.2 +051200 PERFORM PASS. SQ2184.2 +051300 GO TO READ-WRITE-F1-02. SQ2184.2 +051400 READ-FAIL-F1-02. SQ2184.2 +051500 MOVE "ERROR ON SEC READ; VII-13 SR (2), GR (1,2)" TO RE-MARK SQ2184.2 +051600 PERFORM FAIL. SQ2184.2 +051700 READ-WRITE-F1-02. SQ2184.2 +051800 MOVE "READ LONG RECORD" TO FEATURE. SQ2184.2 +051900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2184.2 +052000 PERFORM PRINT-DETAIL. SQ2184.2 +052100 GO TO READ-INIT-F1-03. SQ2184.2 +052200 READ-LONG-REC. SQ2184.2 +052300 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +052400 GO TO READ-LONG-REC-EXIT. SQ2184.2 +052500 READ SQ-VS6 END SQ2184.2 +052600 MOVE 1 TO EOF-FLAG SQ2184.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2184.2 +052800 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +052900 MOVE SQ-VS6R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2184.2 +053000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2184.2 +053100 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2184.2 +053300 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2184.2 +053500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS6-RECNO SQ2184.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2184.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2184.2 +053900 READ-LONG-REC-ERROR. SQ2184.2 +054000 ADD 1 TO RECORDS-IN-ERROR. SQ2184.2 +054100 MOVE 1 TO ERROR-FLAG. SQ2184.2 +054200 READ-LONG-REC-EXIT. SQ2184.2 +054300 EXIT. SQ2184.2 +054400 READ-INIT-F1-03. SQ2184.2 +054500 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +054600 READ-TEST-F1-03. SQ2184.2 +054700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2184.2 +054800 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +054900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +055000 GO TO READ-EOF-F1-06. SQ2184.2 +055100 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +055200 GO TO READ-FAIL-F1-03. SQ2184.2 +055300 READ-PASS-F1-03. SQ2184.2 +055400 PERFORM PASS. SQ2184.2 +055500 GO TO READ-WRITE-F1-03. SQ2184.2 +055600 READ-FAIL-F1-03. SQ2184.2 +055700 MOVE "ERROR REA SHORT REC;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +055800 PERFORM FAIL. SQ2184.2 +055900 READ-WRITE-F1-03. SQ2184.2 +056000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2184.2 +056100 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2184.2 +056200 PERFORM PRINT-DETAIL. SQ2184.2 +056300 READ-INIT-F1-04. SQ2184.2 +056400 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +056500 READ-TEST-F1-04. SQ2184.2 +056600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2184.2 +056700 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +056800 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +056900 GO TO READ-EOF-F1-06. SQ2184.2 +057000 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +057100 GO TO READ-FAIL-F1-04. SQ2184.2 +057200 READ-PASS-F1-04. SQ2184.2 +057300 PERFORM PASS. SQ2184.2 +057400 GO TO READ-WRITE-F1-04. SQ2184.2 +057500 READ-FAIL-F1-04. SQ2184.2 +057600 PERFORM FAIL. SQ2184.2 +057700 MOVE "ERROR READING LONG RECORD" TO RE-MARK. SQ2184.2 +057800 READ-WRITE-F1-04. SQ2184.2 +057900 MOVE "READ LONG RECORDS" TO FEATURE. SQ2184.2 +058000 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2184.2 +058100 PERFORM PRINT-DETAIL. SQ2184.2 +058200 READ-INIT-F1-05. SQ2184.2 +058300 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +058400 READ-TEST-F1-05. SQ2184.2 +058500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2184.2 +058600 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +058700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +058800 GO TO READ-EOF-F1-06. SQ2184.2 +058900 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +059000 GO TO READ-FAIL-F1-05. SQ2184.2 +059100 READ-PASS-F1-05. SQ2184.2 +059200 PERFORM PASS. SQ2184.2 +059300 GO TO READ-WRITE-F1-05. SQ2184.2 +059400 READ-FAIL-F1-05. SQ2184.2 +059500 MOVE "ERROR READING SHORT;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +059600 PERFORM FAIL. SQ2184.2 +059700 READ-WRITE-F1-05. SQ2184.2 +059800 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2184.2 +059900 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2184.2 +060000 PERFORM PRINT-DETAIL. SQ2184.2 +060100 READ-INIT-F1-06. SQ2184.2 +060200 READ SQ-VS6 RECORD END SQ2184.2 +060300 GO TO READ-TEST-F1-06. SQ2184.2 +060400 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2184.2 +060500 GO TO READ-FAIL-F1-06. SQ2184.2 +060600 READ-EOF-F1-06. SQ2184.2 +060700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2184.2 +060800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2184.2 +060900 GO TO READ-FAIL-F1-06. SQ2184.2 +061000 READ-TEST-F1-06. SQ2184.2 +061100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2184.2 +061200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2184.2 +061300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2184.2 +061400 GO TO READ-FAIL-F1-06. SQ2184.2 +061500 READ-PASS-F1-06. SQ2184.2 +061600 PERFORM PASS. SQ2184.2 +061700 GO TO READ-WRITE-F1-06. SQ2184.2 +061800 READ-FAIL-F1-06. SQ2184.2 +061900 MOVE "VII-13 SR (2), GR (1,2)" TO RE-MARK. SQ2184.2 +062000 PERFORM FAIL. SQ2184.2 +062100 READ-WRITE-F1-06. SQ2184.2 +062200 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2184.2 +062300 MOVE "VERIFY FILE SQ-VS6" TO FEATURE. SQ2184.2 +062400 PERFORM PRINT-DETAIL. SQ2184.2 +062500 READ-CLOSE-F1-06. SQ2184.2 +062600 CLOSE SQ-VS6. SQ2184.2 +062700 SECT-SQ218A-0002 SECTION. SQ2184.2 +062800* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS WRITTEN SQ2184.2 +062900* ON THE OUTPUT DEVICE WHEN A SHORT RECORD IS WRITTEN. THE SQ2184.2 +063000* RECORD NUMBER IN CHARACTERS 126 THROUGH 130 IS UNIQUE SQ2184.2 +063100* FOR EACH RECORD. SQ2184.2 +063200 INFO-INIT-001. SQ2184.2 +063300 OPEN INPUT SQ-VS6. SQ2184.2 +063400 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +063500 INFO-TEST-001. SQ2184.2 +063600 READ SQ-VS6 AT END SQ2184.2 +063700 GO TO INFO-END. SQ2184.2 +063800 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +063900 IF SQ-VS6-RECNO NOT EQUAL TO "00001" SQ2184.2 +064000 GO TO NO-INFO-001. SQ2184.2 +064100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +064200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +064300 MOVE 0001 TO CORRECT-18V0. SQ2184.2 +064400 GO TO INFO-WRITE-001. SQ2184.2 +064500 NO-INFO-001. SQ2184.2 +064600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +064700 INFO-WRITE-001. SQ2184.2 +064800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +064900 MOVE "INFO-TEST-001" TO PAR-NAME. SQ2184.2 +065000 PERFORM PRINT-DETAIL. SQ2184.2 +065100 INFO-INIT-002. SQ2184.2 +065200 READ SQ-VS6 RECORD AT END SQ2184.2 +065300 GO TO INFO-END. SQ2184.2 +065400 READ SQ-VS6 END SQ2184.2 +065500 GO TO INFO-END. SQ2184.2 +065600 INFO-TEST-002. SQ2184.2 +065700 READ SQ-VS6 AT END SQ2184.2 +065800 GO TO INFO-END. SQ2184.2 +065900 IF SQ-VS6-RECNO NOT EQUAL TO "00004" SQ2184.2 +066000 GO TO NO-INFO-002. SQ2184.2 +066100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +066200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +066300 MOVE 0004 TO CORRECT-18V0. SQ2184.2 +066400 GO TO INFO-WRITE-002. SQ2184.2 +066500 NO-INFO-002. SQ2184.2 +066600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +066700 INFO-WRITE-002. SQ2184.2 +066800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +066900 MOVE "INFO-TEST-002" TO PAR-NAME. SQ2184.2 +067000 PERFORM PRINT-DETAIL. SQ2184.2 +067100 INFO-INIT-003. SQ2184.2 +067200 ADD 3 TO COUNT-OF-RECS. SQ2184.2 +067300 INFO-INIT-003-1. SQ2184.2 +067400 READ SQ-VS6 RECORD SQ2184.2 +067500 END GO TO INFO-END. SQ2184.2 +067600 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +067700 IF COUNT-OF-RECS EQUAL TO 450 SQ2184.2 +067800 GO TO INFO-TEST-003. SQ2184.2 +067900 GO TO INFO-INIT-003-1. SQ2184.2 +068000 INFO-TEST-003. SQ2184.2 +068100 IF SQ-VS6-RECNO NOT EQUAL TO "00450" SQ2184.2 +068200 GO TO NO-INFO-003. SQ2184.2 +068300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +068400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +068500 MOVE 0450 TO CORRECT-18V0. SQ2184.2 +068600 GO TO INFO-WRITE-003. SQ2184.2 +068700 NO-INFO-003. SQ2184.2 +068800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +068900 INFO-WRITE-003. SQ2184.2 +069000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +069100 MOVE "INFO-TEST-003" TO PAR-NAME. SQ2184.2 +069200 PERFORM PRINT-DETAIL. SQ2184.2 +069300 INFO-END. SQ2184.2 +069400 CLOSE SQ-VS6. SQ2184.2 +069500 TERMINATE-ROUTINE. SQ2184.2 +069600 EXIT. SQ2184.2 +069700 CCVS-EXIT SECTION. SQ2184.2 +069800 CCVS-999999. SQ2184.2 +069900 GO TO CLOSE-FILES. SQ2184.2 +*END-OF,SQ218A +*HEADER,COBOL,SQ219A +000100 IDENTIFICATION DIVISION. SQ2194.2 +000200 PROGRAM-ID. SQ2194.2 +000300 SQ219A. SQ2194.2 +000400**************************************************************** SQ2194.2 +000500* * SQ2194.2 +000600* VALIDATION FOR:- * SQ2194.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2194.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2194.2 +000900* * SQ2194.2 +001000* CREATION DATE / VALIDATION DATE * SQ2194.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2194.2 +001200* * SQ2194.2 +001300* THIS ROUTINE CHECKS THE SQ2194.2 +001400* RECORD DELIMITER IS IMPLEMENTOR-NAME LAUSE. SQ2194.2 +001500* SQ2194.2 +001600* SEE VII-13. SQ2194.2 +001700* SQ2194.2 +001800* SQ2194.2 +001900* THIS ROUTINE BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS SQ2194.2 +002000* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. THE TAPE SQ2194.2 +002100* CONSISTS OF 1 SHORT, 1 LONG, 10 SHORT, 100 LONG, AND 338 SQ2194.2 +002200* SHORT RECORDS FOR A TOTAL OF 450 RECORDS IN THE FILE. SQ2194.2 +002300* THE TAPE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2194.2 +002400* AGAINST THE EXPECTED VALUES. SQ2194.2 +002500* SQ2194.2 +002600* AN INFORMATION SECTION AT THE END OF THE ROUTINE CHECKS SQ2194.2 +002700* THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. THIS FIELD IS SQ2194.2 +002800* PART OF A LONG RECORD ONLY. IF THE XRECORD-NUMBER IS THERE SQ2194.2 +002900* FOR A SHORT RECORD, IT MEANS THE MAXIMUM SIZE RECORD IS SQ2194.2 +003000* ALWAYS WRITTEN. SQ2194.2 +003100 ENVIRONMENT DIVISION. SQ2194.2 +003200 CONFIGURATION SECTION. SQ2194.2 +003300 SOURCE-COMPUTER. SQ2194.2 +003400 XXXXX082. SQ2194.2 +003500 OBJECT-COMPUTER. SQ2194.2 +003600 XXXXX083. SQ2194.2 +003700 INPUT-OUTPUT SECTION. SQ2194.2 +003800 FILE-CONTROL. SQ2194.2 +003900P SELECT RAW-DATA ASSIGN TO SQ2194.2 +004000P XXXXX062 SQ2194.2 +004100P ORGANIZATION IS INDEXED SQ2194.2 +004200P ACCESS MODE IS RANDOM SQ2194.2 +004300P RECORD KEY IS RAW-DATA-KEY. SQ2194.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ2194.2 +004500 XXXXX055. SQ2194.2 +004600 SELECT SQ-VS6 ASSIGN SQ2194.2 +004700 XXXXX001 SQ2194.2 +004800 RECORD DELIMITER SQ2194.2 +004900 XXXXX070 SQ2194.2 +005000 ORGANIZATION IS SEQUENTIAL. SQ2194.2 +005100 DATA DIVISION. SQ2194.2 +005200 FILE SECTION. SQ2194.2 +005300P SQ2194.2 +005400PFD RAW-DATA. SQ2194.2 +005500P SQ2194.2 +005600P01 RAW-DATA-SATZ. SQ2194.2 +005700P 05 RAW-DATA-KEY PIC X(6). SQ2194.2 +005800P 05 C-DATE PIC 9(6). SQ2194.2 +005900P 05 C-TIME PIC 9(8). SQ2194.2 +006000P 05 C-NO-OF-TESTS PIC 99. SQ2194.2 +006100P 05 C-OK PIC 999. SQ2194.2 +006200P 05 C-ALL PIC 999. SQ2194.2 +006300P 05 C-FAIL PIC 999. SQ2194.2 +006400P 05 C-DELETED PIC 999. SQ2194.2 +006500P 05 C-INSPECT PIC 999. SQ2194.2 +006600P 05 C-NOTE PIC X(13). SQ2194.2 +006700P 05 C-INDENT PIC X. SQ2194.2 +006800P 05 C-ABORT PIC X(8). SQ2194.2 +006900 FD PRINT-FILE SQ2194.2 +007000C LABEL RECORDS SQ2194.2 +007100C XXXXX084 SQ2194.2 +007200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2194.2 +007300 . SQ2194.2 +007400 01 PRINT-REC PICTURE X(120). SQ2194.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2194.2 +007600 SQ2194.2 +007700 FD SQ-VS6 SQ2194.2 +007800 RECORD CONTAINS 120 TO 151 CHARACTERS SQ2194.2 +007900C LABEL RECORDS ARE STANDARD SQ2194.2 +008000C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ2194.2 +008100 . SQ2194.2 +008200 01 SQ-VS6R1-M-G-120. SQ2194.2 +008300 02 SQ-VS6R1-FIRST PIC X(120). SQ2194.2 +008400 01 SQ-VS6R2-M-G-151. SQ2194.2 +008500 02 SQ-VS6R2-FIRST PIC X(120). SQ2194.2 +008600 02 LONG-OR-SHORT PIC X(5). SQ2194.2 +008700 02 SQ-VS6-RECNO PIC X(5). SQ2194.2 +008800 02 SQ-VS6-FILLER PIC X(21). SQ2194.2 +008900 WORKING-STORAGE SECTION. SQ2194.2 +009000 01 SAVE-COUNT-OF-RECS PIC X(5). SQ2194.2 +009100 01 COUNT-OF-RECS PIC S9(5) COMP. SQ2194.2 +009200 01 RECORDS-IN-ERROR PIC S9(5) COMP. SQ2194.2 +009300 01 ERROR-FLAG PIC 9. SQ2194.2 +009400 01 EOF-FLAG PIC 9. SQ2194.2 +009500 01 DUMP-AREA. SQ2194.2 +009600 02 TYPE-OF-REC PICTURE X(5). SQ2194.2 +009700 02 RECNO PIC 9(5). SQ2194.2 +009800 02 REC-FILLER PIC X(21). SQ2194.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ2194.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ2194.2 +010100 05 FILLER PICTURE X(48) VALUE SQ2194.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2194.2 +010300 05 FILLER PICTURE X(46) VALUE SQ2194.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2194.2 +010500 05 FILLER PICTURE X(26) VALUE SQ2194.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ2194.2 +010700 05 FILLER PICTURE X(37) VALUE SQ2194.2 +010800 ",RECKEY= ". SQ2194.2 +010900 05 FILLER PICTURE X(38) VALUE SQ2194.2 +011000 ",ALTKEY1= ". SQ2194.2 +011100 05 FILLER PICTURE X(38) VALUE SQ2194.2 +011200 ",ALTKEY2= ". SQ2194.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ2194.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2194.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ2194.2 +011600 07 FILLER PIC X(5). SQ2194.2 +011700 07 XFILE-NAME PIC X(6). SQ2194.2 +011800 07 FILLER PIC X(8). SQ2194.2 +011900 07 XRECORD-NAME PIC X(6). SQ2194.2 +012000 07 FILLER PIC X(1). SQ2194.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ2194.2 +012200 07 FILLER PIC X(7). SQ2194.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ2194.2 +012400 07 FILLER PIC X(6). SQ2194.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ2194.2 +012600 07 FILLER PIC X(5). SQ2194.2 +012700 07 ODO-NUMBER PIC 9(4). SQ2194.2 +012800 07 FILLER PIC X(5). SQ2194.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ2194.2 +013000 07 FILLER PIC X(7). SQ2194.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ2194.2 +013200 07 FILLER PIC X(7). SQ2194.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ2194.2 +013400 07 FILLER PIC X(1). SQ2194.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ2194.2 +013600 07 FILLER PIC X(6). SQ2194.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ2194.2 +013800 07 FILLER PIC X(5). SQ2194.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ2194.2 +014000 07 FILLER PIC X(6). SQ2194.2 +014100 07 XLABEL-TYPE PIC X(1). SQ2194.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ2194.2 +014300 07 FILLER PIC X(8). SQ2194.2 +014400 07 XRECORD-KEY PIC X(29). SQ2194.2 +014500 07 FILLER PIC X(9). SQ2194.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ2194.2 +014700 07 FILLER PIC X(9). SQ2194.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ2194.2 +014900 07 FILLER PIC X(7). SQ2194.2 +015000 01 TEST-RESULTS. SQ2194.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2194.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2194.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015600 02 PAR-NAME. SQ2194.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ2194.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ2194.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2194.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ2194.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ2194.2 +016200 02 RE-MARK PIC X(61). SQ2194.2 +016300 01 TEST-COMPUTED. SQ2194.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ2194.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2194.2 +016600 02 COMPUTED-X. SQ2194.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2194.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2194.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2194.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2194.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2194.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ2194.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ2194.2 +017400 04 FILLER PICTURE X. SQ2194.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ2194.2 +017600 01 TEST-CORRECT. SQ2194.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ2194.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2194.2 +017900 02 CORRECT-X. SQ2194.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2194.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2194.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2194.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2194.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2194.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ2194.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ2194.2 +018700 04 FILLER PICTURE X. SQ2194.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ2194.2 +018900 01 CCVS-C-1. SQ2194.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2194.2 +019100- "SS PARAGRAPH-NAME SQ2194.2 +019200- " REMARKS". SQ2194.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2194.2 +019400 01 CCVS-C-2. SQ2194.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2194.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2194.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2194.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2194.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2194.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ2194.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2194.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2194.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2194.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2194.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2194.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2194.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2194.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2194.2 +021000 01 CCVS-H-1. SQ2194.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ2194.2 +021200 02 FILLER PICTURE X(67) VALUE SQ2194.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2194.2 +021400- " SYSTEM". SQ2194.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ2194.2 +021600 01 CCVS-H-2. SQ2194.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ2194.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2194.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2194.2 +022000 02 TEST-ID PICTURE IS X(9). SQ2194.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2194.2 +022200 01 CCVS-H-3. SQ2194.2 +022300 02 FILLER PICTURE X(34) VALUE SQ2194.2 +022400 " FOR OFFICIAL USE ONLY ". SQ2194.2 +022500 02 FILLER PICTURE X(58) VALUE SQ2194.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2194.2 +022700 02 FILLER PICTURE X(28) VALUE SQ2194.2 +022800 " COPYRIGHT 1985 ". SQ2194.2 +022900 01 CCVS-E-1. SQ2194.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2194.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2194.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ2194.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ2194.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ2194.2 +023500 01 CCVS-E-2. SQ2194.2 +023600 02 FILLER PICTURE X(31) VALUE SQ2194.2 +023700 SPACE. SQ2194.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ2194.2 +023900 02 CCVS-E-2-2. SQ2194.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2194.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2194.2 +024300 01 CCVS-E-3. SQ2194.2 +024400 02 FILLER PICTURE X(22) VALUE SQ2194.2 +024500 " FOR OFFICIAL USE ONLY". SQ2194.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ2194.2 +024700 02 FILLER PICTURE X(58) VALUE SQ2194.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2194.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ2194.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2194.2 +025100 01 CCVS-E-4. SQ2194.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2194.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ2194.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2194.2 +025500 02 FILLER PIC X(40) VALUE SQ2194.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2194.2 +025700 01 XXINFO. SQ2194.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2194.2 +025900 02 INFO-TEXT. SQ2194.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ2194.2 +026100 04 XXCOMPUTED PIC X(20). SQ2194.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ2194.2 +026300 04 XXCORRECT PIC X(20). SQ2194.2 +026400 01 HYPHEN-LINE. SQ2194.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2194.2 +026700- "*****************************************". SQ2194.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2194.2 +026900- "******************************". SQ2194.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ2194.2 +027100 "SQ219A". SQ2194.2 +027200 PROCEDURE DIVISION. SQ2194.2 +027300 CCVS1 SECTION. SQ2194.2 +027400 OPEN-FILES. SQ2194.2 +027500P OPEN I-O RAW-DATA. SQ2194.2 +027600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2194.2 +027700P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2194.2 +027800P MOVE "ABORTED " TO C-ABORT. SQ2194.2 +027900P ADD 1 TO C-NO-OF-TESTS. SQ2194.2 +028000P ACCEPT C-DATE FROM DATE. SQ2194.2 +028100P ACCEPT C-TIME FROM TIME. SQ2194.2 +028200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2194.2 +028300PEND-E-1. SQ2194.2 +028400P CLOSE RAW-DATA. SQ2194.2 +028500 OPEN OUTPUT PRINT-FILE. SQ2194.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2194.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ2194.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2194.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ2194.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2194.2 +029100 CCVS-INIT-FILE. SQ2194.2 +029200 ADD 1 TO REC-SKL-SUB. SQ2194.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ2194.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ2194.2 +029500 CCVS-INIT-EXIT. SQ2194.2 +029600 GO TO CCVS1-EXIT. SQ2194.2 +029700 CLOSE-FILES. SQ2194.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2194.2 +029900P OPEN I-O RAW-DATA. SQ2194.2 +030000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2194.2 +030100P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2194.2 +030200P MOVE "OK. " TO C-ABORT. SQ2194.2 +030300P MOVE PASS-COUNTER TO C-OK. SQ2194.2 +030400P MOVE ERROR-HOLD TO C-ALL. SQ2194.2 +030500P MOVE ERROR-COUNTER TO C-FAIL. SQ2194.2 +030600P MOVE DELETE-CNT TO C-DELETED. SQ2194.2 +030700P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2194.2 +030800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2194.2 +030900PEND-E-2. SQ2194.2 +031000P CLOSE RAW-DATA. SQ2194.2 +031100 TERMINATE-CCVS. SQ2194.2 +031200S EXIT PROGRAM. SQ2194.2 +031300STERMINATE-CALL. SQ2194.2 +031400 STOP RUN. SQ2194.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2194.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2194.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2194.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2194.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ2194.2 +032000 PRINT-DETAIL. SQ2194.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ2194.2 +032200 MOVE "." TO PARDOT-X SQ2194.2 +032300 MOVE REC-CT TO DOTVALUE. SQ2194.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2194.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2194.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2194.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2194.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2194.2 +032900 MOVE SPACE TO CORRECT-X. SQ2194.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2194.2 +033100 MOVE SPACE TO RE-MARK. SQ2194.2 +033200 HEAD-ROUTINE. SQ2194.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2194.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2194.2 +033600 COLUMN-NAMES-ROUTINE. SQ2194.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +034000 END-ROUTINE. SQ2194.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2194.2 +034200 END-RTN-EXIT. SQ2194.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +034400 END-ROUTINE-1. SQ2194.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2194.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2194.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2194.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2194.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2194.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2194.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2194.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2194.2 +035300 END-ROUTINE-12. SQ2194.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2194.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2194.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ2194.2 +035700 ELSE SQ2194.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2194.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2194.2 +036000 PERFORM WRITE-LINE. SQ2194.2 +036100 END-ROUTINE-13. SQ2194.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ2194.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ2194.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2194.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2194.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2194.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ2194.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2194.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2194.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +037300 WRITE-LINE. SQ2194.2 +037400 ADD 1 TO RECORD-COUNT. SQ2194.2 +037500Y IF RECORD-COUNT GREATER 50 SQ2194.2 +037600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2194.2 +037700Y MOVE SPACE TO DUMMY-RECORD SQ2194.2 +037800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2194.2 +037900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2194.2 +038000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2194.2 +038100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2194.2 +038200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2194.2 +038300Y MOVE ZERO TO RECORD-COUNT. SQ2194.2 +038400 PERFORM WRT-LN. SQ2194.2 +038500 WRT-LN. SQ2194.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2194.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ2194.2 +038800 BLANK-LINE-PRINT. SQ2194.2 +038900 PERFORM WRT-LN. SQ2194.2 +039000 FAIL-ROUTINE. SQ2194.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2194.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2194.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2194.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +039500 GO TO FAIL-ROUTINE-EX. SQ2194.2 +039600 FAIL-ROUTINE-WRITE. SQ2194.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2194.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ2194.2 +040000 BAIL-OUT. SQ2194.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2194.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2194.2 +040300 BAIL-OUT-WRITE. SQ2194.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2194.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +040600 BAIL-OUT-EX. EXIT. SQ2194.2 +040700 CCVS1-EXIT. SQ2194.2 +040800 EXIT. SQ2194.2 +040900 SECT-SQ219A-0001 SECTION. SQ2194.2 +041000 WRITE-INIT-GF-01. SQ2194.2 +041100 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ2194.2 +041200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2194.2 +041300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2194.2 +041400 MOVE 0001 TO XBLOCK-SIZE (1). SQ2194.2 +041500 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2194.2 +041600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2194.2 +041700 MOVE "S" TO XLABEL-TYPE (1). SQ2194.2 +041800 MOVE 000000 TO XRECORD-NUMBER (1). SQ2194.2 +041900 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +042000 OPEN OUTPUT SQ-VS6. SQ2194.2 +042100 MOVE "MULTIPLE LENGTH RECS " TO SQ-VS6-FILLER. SQ2194.2 +042200 WRITE-TEST-GF-01. SQ2194.2 +042300 PERFORM WRITE-SHORT-REC. SQ2194.2 +042400 PERFORM WRITE-LONG-REC. SQ2194.2 +042500 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2194.2 +042600 PERFORM WRITE-LONG-REC 100 TIMES. SQ2194.2 +042700 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2194.2 +042800 WRITE-WRITE-GF-01. SQ2194.2 +042900 MOVE "CREATE FILE SQ-VS6" TO FEATURE. SQ2194.2 +043000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2194.2 +043100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2194.2 +043200 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2194.2 +043300 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2194.2 +043400 PERFORM PRINT-DETAIL. SQ2194.2 +043500* A SEQUENTIAL TAPE FILE CONTAINING 450 RECORDS HAS SQ2194.2 +043600* BEEN CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS SQ2194.2 +043700* AND RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ2194.2 +043800* RECORDS WERE WRITTEN IS S-L-10S-100L-338S. SQ2194.2 +043900 WRITE-CLOSE-GF-01. SQ2194.2 +044000 CLOSE SQ-VS6. SQ2194.2 +044100 GO TO READ-INIT-F1-01. SQ2194.2 +044200 WRITE-SHORT-REC. SQ2194.2 +044300 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2194.2 +044400 MOVE 000120 TO XRECORD-LENGTH (1). SQ2194.2 +044500 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +044600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2194.2 +044700 MOVE "SHORT" TO LONG-OR-SHORT. SQ2194.2 +044800 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2194.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R1-FIRST. SQ2194.2 +045000 WRITE SQ-VS6R1-M-G-120. SQ2194.2 +045100 WRITE-LONG-REC. SQ2194.2 +045200 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2194.2 +045300 MOVE 000151 TO XRECORD-LENGTH (1). SQ2194.2 +045400 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +045500 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2194.2 +045600 MOVE "LONG" TO LONG-OR-SHORT. SQ2194.2 +045700 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2194.2 +045800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ2194.2 +045900 WRITE SQ-VS6R2-M-G-151. SQ2194.2 +046000 READ-INIT-F1-01. SQ2194.2 +046100 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +046200 MOVE ZERO TO EOF-FLAG. SQ2194.2 +046300 MOVE ZERO TO RECORDS-IN-ERROR. SQ2194.2 +046400 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +046500 OPEN INPUT SQ-VS6. SQ2194.2 +046600 READ-TEST-F1-01. SQ2194.2 +046700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2194.2 +046800 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +046900 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2194.2 +047000 GO TO READ-EOF-F1-06. SQ2194.2 +047100 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +047200 GO TO READ-FAIL-F1-01. SQ2194.2 +047300 READ-PASS-F1-01. SQ2194.2 +047400 PERFORM PASS. SQ2194.2 +047500 GO TO READ-WRITE-F1-01. SQ2194.2 +047600 READ-FAIL-F1-01. SQ2194.2 +047700 MOVE "ERROR ON FIRST READ;VII-13 GR (3) " TO RE-MARKSQ2194.2 +047800 PERFORM FAIL. SQ2194.2 +047900 READ-WRITE-F1-01. SQ2194.2 +048000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2194.2 +048200 PERFORM PRINT-DETAIL. SQ2194.2 +048300 GO TO READ-INIT-F1-02. SQ2194.2 +048400 READ-SHORT-REC. SQ2194.2 +048500 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +048600 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +048700 READ SQ-VS6 AT END SQ2194.2 +048800 MOVE 1 TO EOF-FLAG SQ2194.2 +048900 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +049000 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +049100 MOVE SQ-VS6R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2194.2 +049200 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2194.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049400 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2194.2 +049500 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049600 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2194.2 +049700 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049800 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2194.2 +049900 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +050000 READ-SHORT-REC-ERROR. SQ2194.2 +050100 ADD 1 TO RECORDS-IN-ERROR. SQ2194.2 +050200 MOVE 1 TO ERROR-FLAG. SQ2194.2 +050300 READ-SHORT-REC-EXIT. SQ2194.2 +050400 EXIT. SQ2194.2 +050500 READ-INIT-F1-02. SQ2194.2 +050600 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +050700 READ-TEST-F1-02. SQ2194.2 +050800 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2194.2 +050900 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +051000 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2194.2 +051100 GO TO READ-EOF-F1-06. SQ2194.2 +051200 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +051300 GO TO READ-FAIL-F1-02. SQ2194.2 +051400 READ-PASS-F1-02. SQ2194.2 +051500 PERFORM PASS. SQ2194.2 +051600 GO TO READ-WRITE-F1-02. SQ2194.2 +051700 READ-FAIL-F1-02. SQ2194.2 +051800 MOVE "ERROR ON SEC READ; VII-13 GR (3 " TO RE-MARK SQ2194.2 +051900 PERFORM FAIL. SQ2194.2 +052000 READ-WRITE-F1-02. SQ2194.2 +052100 MOVE "READ LONG RECORD" TO FEATURE. SQ2194.2 +052200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2194.2 +052300 PERFORM PRINT-DETAIL. SQ2194.2 +052400 GO TO READ-INIT-F1-03. SQ2194.2 +052500 READ-LONG-REC. SQ2194.2 +052600 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2194.2 +052800 READ SQ-VS6 END SQ2194.2 +052900 MOVE 1 TO EOF-FLAG SQ2194.2 +053000 GO TO READ-LONG-REC-EXIT. SQ2194.2 +053100 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +053200 MOVE SQ-VS6R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2194.2 +053300 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2194.2 +053400 GO TO READ-LONG-REC-ERROR. SQ2194.2 +053500 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2194.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2194.2 +053700 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2194.2 +053800 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS6-RECNO SQ2194.2 +053900 GO TO READ-LONG-REC-ERROR. SQ2194.2 +054000 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2194.2 +054100 GO TO READ-LONG-REC-EXIT. SQ2194.2 +054200 READ-LONG-REC-ERROR. SQ2194.2 +054300 ADD 1 TO RECORDS-IN-ERROR. SQ2194.2 +054400 MOVE 1 TO ERROR-FLAG. SQ2194.2 +054500 READ-LONG-REC-EXIT. SQ2194.2 +054600 EXIT. SQ2194.2 +054700 READ-INIT-F1-03. SQ2194.2 +054800 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +054900 READ-TEST-F1-03. SQ2194.2 +055000 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2194.2 +055100 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +055200 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +055300 GO TO READ-EOF-F1-06. SQ2194.2 +055400 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +055500 GO TO READ-FAIL-F1-03. SQ2194.2 +055600 READ-PASS-F1-03. SQ2194.2 +055700 PERFORM PASS. SQ2194.2 +055800 GO TO READ-WRITE-F1-03. SQ2194.2 +055900 READ-FAIL-F1-03. SQ2194.2 +056000 MOVE "ERROR REA SHORT REC; VII-13 SR (3) " TO RE-MARKSQ2194.2 +056100 PERFORM FAIL. SQ2194.2 +056200 READ-WRITE-F1-03. SQ2194.2 +056300 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2194.2 +056400 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2194.2 +056500 PERFORM PRINT-DETAIL. SQ2194.2 +056600 READ-INIT-F1-04. SQ2194.2 +056700 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +056800 READ-TEST-F1-04. SQ2194.2 +056900 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2194.2 +057000 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +057100 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +057200 GO TO READ-EOF-F1-06. SQ2194.2 +057300 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +057400 GO TO READ-FAIL-F1-04. SQ2194.2 +057500 READ-PASS-F1-04. SQ2194.2 +057600 PERFORM PASS. SQ2194.2 +057700 GO TO READ-WRITE-F1-04. SQ2194.2 +057800 READ-FAIL-F1-04. SQ2194.2 +057900 PERFORM FAIL. SQ2194.2 +058000 MOVE "ERROR READING LONG RECORD" TO RE-MARK. SQ2194.2 +058100 READ-WRITE-F1-04. SQ2194.2 +058200 MOVE "READ LONG RECORDS" TO FEATURE. SQ2194.2 +058300 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2194.2 +058400 PERFORM PRINT-DETAIL. SQ2194.2 +058500 READ-INIT-F1-05. SQ2194.2 +058600 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +058700 READ-TEST-F1-05. SQ2194.2 +058800 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2194.2 +058900 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +059000 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +059100 GO TO READ-EOF-F1-06. SQ2194.2 +059200 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +059300 GO TO READ-FAIL-F1-05. SQ2194.2 +059400 READ-PASS-F1-05. SQ2194.2 +059500 PERFORM PASS. SQ2194.2 +059600 GO TO READ-WRITE-F1-05. SQ2194.2 +059700 READ-FAIL-F1-05. SQ2194.2 +059800 MOVE "ERROR READING SHORT;VII-13 GR (3) " TO RE-MARKSQ2194.2 +059900 PERFORM FAIL. SQ2194.2 +060000 READ-WRITE-F1-05. SQ2194.2 +060100 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2194.2 +060200 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2194.2 +060300 PERFORM PRINT-DETAIL. SQ2194.2 +060400 READ-INIT-F1-06. SQ2194.2 +060500 READ SQ-VS6 RECORD END SQ2194.2 +060600 GO TO READ-TEST-F1-06. SQ2194.2 +060700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2194.2 +060800 GO TO READ-FAIL-F1-06. SQ2194.2 +060900 READ-EOF-F1-06. SQ2194.2 +061000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2194.2 +061100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2194.2 +061200 GO TO READ-FAIL-F1-06. SQ2194.2 +061300 READ-TEST-F1-06. SQ2194.2 +061400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2194.2 +061500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2194.2 +061600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2194.2 +061700 GO TO READ-FAIL-F1-06. SQ2194.2 +061800 READ-PASS-F1-06. SQ2194.2 +061900 PERFORM PASS. SQ2194.2 +062000 GO TO READ-WRITE-F1-06. SQ2194.2 +062100 READ-FAIL-F1-06. SQ2194.2 +062200 MOVE "VII-13 GR (3) " TO RE-MARK. SQ2194.2 +062300 PERFORM FAIL. SQ2194.2 +062400 READ-WRITE-F1-06. SQ2194.2 +062500 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2194.2 +062600 MOVE "VERIFY FILE SQ-VS6" TO FEATURE. SQ2194.2 +062700 PERFORM PRINT-DETAIL. SQ2194.2 +062800 READ-CLOSE-F1-06. SQ2194.2 +062900 CLOSE SQ-VS6. SQ2194.2 +063000 SECT-SQ219A-0002 SECTION. SQ2194.2 +063100* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS WRITTEN SQ2194.2 +063200* ON THE OUTPUT DEVICE WHEN A SHORT RECORD IS WRITTEN. THE SQ2194.2 +063300* RECORD NUMBER IN CHARACTERS 126 THROUGH 130 IS UNIQUE SQ2194.2 +063400* FOR EACH RECORD. SQ2194.2 +063500 INFO-INIT-001. SQ2194.2 +063600 OPEN INPUT SQ-VS6. SQ2194.2 +063700 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +063800 INFO-TEST-001. SQ2194.2 +063900 READ SQ-VS6 AT END SQ2194.2 +064000 GO TO INFO-END. SQ2194.2 +064100 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +064200 IF SQ-VS6-RECNO NOT EQUAL TO "00001" SQ2194.2 +064300 GO TO NO-INFO-001. SQ2194.2 +064400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +064500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +064600 MOVE 0001 TO CORRECT-18V0. SQ2194.2 +064700 GO TO INFO-WRITE-001. SQ2194.2 +064800 NO-INFO-001. SQ2194.2 +064900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +065000 INFO-WRITE-001. SQ2194.2 +065100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +065200 MOVE "INFO-TEST-001" TO PAR-NAME. SQ2194.2 +065300 PERFORM PRINT-DETAIL. SQ2194.2 +065400 INFO-INIT-002. SQ2194.2 +065500 READ SQ-VS6 RECORD AT END SQ2194.2 +065600 GO TO INFO-END. SQ2194.2 +065700 READ SQ-VS6 END SQ2194.2 +065800 GO TO INFO-END. SQ2194.2 +065900 INFO-TEST-002. SQ2194.2 +066000 READ SQ-VS6 AT END SQ2194.2 +066100 GO TO INFO-END. SQ2194.2 +066200 IF SQ-VS6-RECNO NOT EQUAL TO "00004" SQ2194.2 +066300 GO TO NO-INFO-002. SQ2194.2 +066400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +066500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +066600 MOVE 0004 TO CORRECT-18V0. SQ2194.2 +066700 GO TO INFO-WRITE-002. SQ2194.2 +066800 NO-INFO-002. SQ2194.2 +066900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +067000 INFO-WRITE-002. SQ2194.2 +067100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +067200 MOVE "INFO-TEST-002" TO PAR-NAME. SQ2194.2 +067300 PERFORM PRINT-DETAIL. SQ2194.2 +067400 INFO-INIT-003. SQ2194.2 +067500 ADD 3 TO COUNT-OF-RECS. SQ2194.2 +067600 INFO-INIT-003-1. SQ2194.2 +067700 READ SQ-VS6 RECORD SQ2194.2 +067800 END GO TO INFO-END. SQ2194.2 +067900 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +068000 IF COUNT-OF-RECS EQUAL TO 450 SQ2194.2 +068100 GO TO INFO-TEST-003. SQ2194.2 +068200 GO TO INFO-INIT-003-1. SQ2194.2 +068300 INFO-TEST-003. SQ2194.2 +068400 IF SQ-VS6-RECNO NOT EQUAL TO "00450" SQ2194.2 +068500 GO TO NO-INFO-003. SQ2194.2 +068600 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +068700 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +068800 MOVE 0450 TO CORRECT-18V0. SQ2194.2 +068900 GO TO INFO-WRITE-003. SQ2194.2 +069000 NO-INFO-003. SQ2194.2 +069100 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +069200 INFO-WRITE-003. SQ2194.2 +069300 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +069400 MOVE "INFO-TEST-003" TO PAR-NAME. SQ2194.2 +069500 PERFORM PRINT-DETAIL. SQ2194.2 +069600 INFO-END. SQ2194.2 +069700 CLOSE SQ-VS6. SQ2194.2 +069800 TERMINATE-ROUTINE. SQ2194.2 +069900 EXIT. SQ2194.2 +070000 CCVS-EXIT SECTION. SQ2194.2 +070100 CCVS-999999. SQ2194.2 +070200 GO TO CLOSE-FILES. SQ2194.2 +*END-OF,SQ219A +*HEADER,COBOL,SQ220A +000100 IDENTIFICATION DIVISION. SQ2204.2 +000200 PROGRAM-ID. SQ2204.2 +000300 SQ220A. SQ2204.2 +000400**************************************************************** SQ2204.2 +000500* * SQ2204.2 +000600* VALIDATION FOR:- * SQ2204.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2204.2 +000800* * SQ2204.2 +000900* CREATION DATE / VALIDATION DATE * SQ2204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2204.2 +001100* * SQ2204.2 +001200* THIS ROUTINE CHECKS THE SQ2204.2 +001300* SQ2204.2 +001400* RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS SQ2204.2 +001500* DEPENDING ON DATA-NAME-1 SQ2204.2 +001600* AND THE SQ2204.2 +001700* NEXT RECORD CLAUSE. SQ2204.2 +001800* SQ2204.2 +001900* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2204.2 +002000* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2204.2 +002100* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2204.2 +002200* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2204.2 +002300* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2204.2 +002400* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2204.2 +002500* AGAINST THE EXPECTED VALUES. SQ2204.2 +002600* SQ2204.2 +002700* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2204.2 +002800* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2204.2 +002900* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2204.2 +003000* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2204.2 +003100* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2204.2 +003200 ENVIRONMENT DIVISION. SQ2204.2 +003300 CONFIGURATION SECTION. SQ2204.2 +003400 SOURCE-COMPUTER. SQ2204.2 +003500 XXXXX082. SQ2204.2 +003600 OBJECT-COMPUTER. SQ2204.2 +003700 XXXXX083. SQ2204.2 +003800 INPUT-OUTPUT SECTION. SQ2204.2 +003900 FILE-CONTROL. SQ2204.2 +004000P SELECT RAW-DATA ASSIGN TO SQ2204.2 +004100P XXXXX062 SQ2204.2 +004200P ORGANIZATION IS INDEXED SQ2204.2 +004300P ACCESS MODE IS RANDOM SQ2204.2 +004400P RECORD KEY IS RAW-DATA-KEY. SQ2204.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2204.2 +004600 XXXXX055. SQ2204.2 +004700 SELECT SQ-VS7 ASSIGN TO SQ2204.2 +004800 XXXXX014 SQ2204.2 +004900 ORGANIZATION SEQUENTIAL SQ2204.2 +005000 ACCESS SEQUENTIAL. SQ2204.2 +005100 DATA DIVISION. SQ2204.2 +005200 FILE SECTION. SQ2204.2 +005300P SQ2204.2 +005400PFD RAW-DATA. SQ2204.2 +005500P SQ2204.2 +005600P01 RAW-DATA-SATZ. SQ2204.2 +005700P 05 RAW-DATA-KEY PIC X(6). SQ2204.2 +005800P 05 C-DATE PIC 9(6). SQ2204.2 +005900P 05 C-TIME PIC 9(8). SQ2204.2 +006000P 05 C-NO-OF-TESTS PIC 99. SQ2204.2 +006100P 05 C-OK PIC 999. SQ2204.2 +006200P 05 C-ALL PIC 999. SQ2204.2 +006300P 05 C-FAIL PIC 999. SQ2204.2 +006400P 05 C-DELETED PIC 999. SQ2204.2 +006500P 05 C-INSPECT PIC 999. SQ2204.2 +006600P 05 C-NOTE PIC X(13). SQ2204.2 +006700P 05 C-INDENT PIC X. SQ2204.2 +006800P 05 C-ABORT PIC X(8). SQ2204.2 +006900 FD PRINT-FILE SQ2204.2 +007000C LABEL RECORDS SQ2204.2 +007100C XXXXX084 SQ2204.2 +007200C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2204.2 +007300 . SQ2204.2 +007400 01 PRINT-REC PICTURE X(120). SQ2204.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2204.2 +007600 FD SQ-VS7 SQ2204.2 +007700C LABEL RECORDS ARE STANDARD SQ2204.2 +007800 RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS SQ2204.2 +007900 DEPENDING ON RECORD-LENGTH. SQ2204.2 +008000 01 SQ-VS7R1-M-G-120. SQ2204.2 +008100 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2204.2 +008200 01 SQ-VS7R2-M-G-151. SQ2204.2 +008300 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2204.2 +008400 02 LONG-OR-SHORT PICTURE X(5). SQ2204.2 +008500 02 SQ-VS7-RECNO PICTURE X(5). SQ2204.2 +008600 02 SQ-VS7-FILLER PICTURE X(21). SQ2204.2 +008700 WORKING-STORAGE SECTION. SQ2204.2 +008800 01 RECORD-LENGTH PICTURE 999 VALUE ZERO. SQ2204.2 +008900 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2204.2 +009000 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2204.2 +009100 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2204.2 +009200 01 ERROR-FLAG PICTURE 9. SQ2204.2 +009300 01 EOF-FLAG PICTURE 9. SQ2204.2 +009400 01 DUMP-AREA. SQ2204.2 +009500 02 TYPE-OF-REC PICTURE X(5). SQ2204.2 +009600 02 RECNO PICTURE 9(5). SQ2204.2 +009700 02 REC-FILLER PICTURE X(21). SQ2204.2 +009800 01 FILE-RECORD-INFORMATION-REC. SQ2204.2 +009900 03 FILE-RECORD-INFO-SKELETON. SQ2204.2 +010000 05 FILLER PICTURE X(48) VALUE SQ2204.2 +010100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2204.2 +010200 05 FILLER PICTURE X(46) VALUE SQ2204.2 +010300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2204.2 +010400 05 FILLER PICTURE X(26) VALUE SQ2204.2 +010500 ",LFIL=000000,ORG= ,LBLR= ". SQ2204.2 +010600 05 FILLER PICTURE X(37) VALUE SQ2204.2 +010700 ",RECKEY= ". SQ2204.2 +010800 05 FILLER PICTURE X(38) VALUE SQ2204.2 +010900 ",ALTKEY1= ". SQ2204.2 +011000 05 FILLER PICTURE X(38) VALUE SQ2204.2 +011100 ",ALTKEY2= ". SQ2204.2 +011200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2204.2 +011300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2204.2 +011400 05 FILE-RECORD-INFO-P1-120. SQ2204.2 +011500 07 FILLER PIC X(5). SQ2204.2 +011600 07 XFILE-NAME PIC X(6). SQ2204.2 +011700 07 FILLER PIC X(8). SQ2204.2 +011800 07 XRECORD-NAME PIC X(6). SQ2204.2 +011900 07 FILLER PIC X(1). SQ2204.2 +012000 07 REELUNIT-NUMBER PIC 9(1). SQ2204.2 +012100 07 FILLER PIC X(7). SQ2204.2 +012200 07 XRECORD-NUMBER PIC 9(6). SQ2204.2 +012300 07 FILLER PIC X(6). SQ2204.2 +012400 07 UPDATE-NUMBER PIC 9(2). SQ2204.2 +012500 07 FILLER PIC X(5). SQ2204.2 +012600 07 ODO-NUMBER PIC 9(4). SQ2204.2 +012700 07 FILLER PIC X(5). SQ2204.2 +012800 07 XPROGRAM-NAME PIC X(5). SQ2204.2 +012900 07 FILLER PIC X(7). SQ2204.2 +013000 07 XRECORD-LENGTH PIC 9(6). SQ2204.2 +013100 07 FILLER PIC X(7). SQ2204.2 +013200 07 CHARS-OR-RECORDS PIC X(2). SQ2204.2 +013300 07 FILLER PIC X(1). SQ2204.2 +013400 07 XBLOCK-SIZE PIC 9(4). SQ2204.2 +013500 07 FILLER PIC X(6). SQ2204.2 +013600 07 RECORDS-IN-FILE PIC 9(6). SQ2204.2 +013700 07 FILLER PIC X(5). SQ2204.2 +013800 07 XFILE-ORGANIZATION PIC X(2). SQ2204.2 +013900 07 FILLER PIC X(6). SQ2204.2 +014000 07 XLABEL-TYPE PIC X(1). SQ2204.2 +014100 05 FILE-RECORD-INFO-P121-240. SQ2204.2 +014200 07 FILLER PIC X(8). SQ2204.2 +014300 07 XRECORD-KEY PIC X(29). SQ2204.2 +014400 07 FILLER PIC X(9). SQ2204.2 +014500 07 ALTERNATE-KEY1 PIC X(29). SQ2204.2 +014600 07 FILLER PIC X(9). SQ2204.2 +014700 07 ALTERNATE-KEY2 PIC X(29). SQ2204.2 +014800 07 FILLER PIC X(7). SQ2204.2 +014900 01 TEST-RESULTS. SQ2204.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2204.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2204.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015500 02 PAR-NAME. SQ2204.2 +015600 03 FILLER PICTURE X(12) VALUE SPACE. SQ2204.2 +015700 03 PARDOT-X PICTURE X VALUE SPACE. SQ2204.2 +015800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2204.2 +015900 03 FILLER PIC X(5) VALUE SPACE. SQ2204.2 +016000 02 FILLER PIC X(10) VALUE SPACE. SQ2204.2 +016100 02 RE-MARK PIC X(61). SQ2204.2 +016200 01 TEST-COMPUTED. SQ2204.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2204.2 +016400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2204.2 +016500 02 COMPUTED-X. SQ2204.2 +016600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2204.2 +016700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2204.2 +016800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2204.2 +016900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2204.2 +017000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2204.2 +017100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2204.2 +017200 04 COMPUTED-18V0 PICTURE -9(18). SQ2204.2 +017300 04 FILLER PICTURE X. SQ2204.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ2204.2 +017500 01 TEST-CORRECT. SQ2204.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ2204.2 +017700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2204.2 +017800 02 CORRECT-X. SQ2204.2 +017900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2204.2 +018000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2204.2 +018100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2204.2 +018200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2204.2 +018300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2204.2 +018400 03 CR-18V0 REDEFINES CORRECT-A. SQ2204.2 +018500 04 CORRECT-18V0 PICTURE -9(18). SQ2204.2 +018600 04 FILLER PICTURE X. SQ2204.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ2204.2 +018800 01 CCVS-C-1. SQ2204.2 +018900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2204.2 +019000- "SS PARAGRAPH-NAME SQ2204.2 +019100- " REMARKS". SQ2204.2 +019200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2204.2 +019300 01 CCVS-C-2. SQ2204.2 +019400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +019500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2204.2 +019600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2204.2 +019700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2204.2 +019800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2204.2 +019900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2204.2 +020000 01 REC-CT PICTURE 99 VALUE ZERO. SQ2204.2 +020100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2204.2 +020200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2204.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2204.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2204.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2204.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2204.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2204.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2204.2 +020900 01 CCVS-H-1. SQ2204.2 +021000 02 FILLER PICTURE X(27) VALUE SPACE. SQ2204.2 +021100 02 FILLER PICTURE X(67) VALUE SQ2204.2 +021200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2204.2 +021300- " SYSTEM". SQ2204.2 +021400 02 FILLER PICTURE X(26) VALUE SPACE. SQ2204.2 +021500 01 CCVS-H-2. SQ2204.2 +021600 02 FILLER PICTURE X(52) VALUE IS SQ2204.2 +021700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2204.2 +021800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2204.2 +021900 02 TEST-ID PICTURE IS X(9). SQ2204.2 +022000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2204.2 +022100 01 CCVS-H-3. SQ2204.2 +022200 02 FILLER PICTURE X(34) VALUE SQ2204.2 +022300 " FOR OFFICIAL USE ONLY ". SQ2204.2 +022400 02 FILLER PICTURE X(58) VALUE SQ2204.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2204.2 +022600 02 FILLER PICTURE X(28) VALUE SQ2204.2 +022700 " COPYRIGHT 1985 ". SQ2204.2 +022800 01 CCVS-E-1. SQ2204.2 +022900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2204.2 +023000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2204.2 +023100 02 ID-AGAIN PICTURE IS X(9). SQ2204.2 +023200 02 FILLER PICTURE X(45) VALUE IS SQ2204.2 +023300 " NTIS DISTRIBUTION COBOL 85". SQ2204.2 +023400 01 CCVS-E-2. SQ2204.2 +023500 02 FILLER PICTURE X(31) VALUE SQ2204.2 +023600 SPACE. SQ2204.2 +023700 02 FILLER PICTURE X(21) VALUE SPACE. SQ2204.2 +023800 02 CCVS-E-2-2. SQ2204.2 +023900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2204.2 +024000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +024100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2204.2 +024200 01 CCVS-E-3. SQ2204.2 +024300 02 FILLER PICTURE X(22) VALUE SQ2204.2 +024400 " FOR OFFICIAL USE ONLY". SQ2204.2 +024500 02 FILLER PICTURE X(12) VALUE SPACE. SQ2204.2 +024600 02 FILLER PICTURE X(58) VALUE SQ2204.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2204.2 +024800 02 FILLER PICTURE X(13) VALUE SPACE. SQ2204.2 +024900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2204.2 +025000 01 CCVS-E-4. SQ2204.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2204.2 +025200 02 FILLER PIC XXXX VALUE " OF ". SQ2204.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2204.2 +025400 02 FILLER PIC X(40) VALUE SQ2204.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2204.2 +025600 01 XXINFO. SQ2204.2 +025700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2204.2 +025800 02 INFO-TEXT. SQ2204.2 +025900 04 FILLER PIC X(20) VALUE SPACE. SQ2204.2 +026000 04 XXCOMPUTED PIC X(20). SQ2204.2 +026100 04 FILLER PIC X(5) VALUE SPACE. SQ2204.2 +026200 04 XXCORRECT PIC X(20). SQ2204.2 +026300 01 HYPHEN-LINE. SQ2204.2 +026400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +026500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2204.2 +026600- "*****************************************". SQ2204.2 +026700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2204.2 +026800- "******************************". SQ2204.2 +026900 01 CCVS-PGM-ID PIC X(6) VALUE SQ2204.2 +027000 "SQ220A". SQ2204.2 +027100 PROCEDURE DIVISION. SQ2204.2 +027200 CCVS1 SECTION. SQ2204.2 +027300 OPEN-FILES. SQ2204.2 +027400P OPEN I-O RAW-DATA. SQ2204.2 +027500P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2204.2 +027600P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2204.2 +027700P MOVE "ABORTED " TO C-ABORT. SQ2204.2 +027800P ADD 1 TO C-NO-OF-TESTS. SQ2204.2 +027900P ACCEPT C-DATE FROM DATE. SQ2204.2 +028000P ACCEPT C-TIME FROM TIME. SQ2204.2 +028100P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2204.2 +028200PEND-E-1. SQ2204.2 +028300P CLOSE RAW-DATA. SQ2204.2 +028400 OPEN OUTPUT PRINT-FILE. SQ2204.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2204.2 +028600 MOVE SPACE TO TEST-RESULTS. SQ2204.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2204.2 +028800 MOVE ZERO TO REC-SKL-SUB. SQ2204.2 +028900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2204.2 +029000 CCVS-INIT-FILE. SQ2204.2 +029100 ADD 1 TO REC-SKL-SUB. SQ2204.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ2204.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ2204.2 +029400 CCVS-INIT-EXIT. SQ2204.2 +029500 GO TO CCVS1-EXIT. SQ2204.2 +029600 CLOSE-FILES. SQ2204.2 +029700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2204.2 +029800P OPEN I-O RAW-DATA. SQ2204.2 +029900P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2204.2 +030000P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2204.2 +030100P MOVE "OK. " TO C-ABORT. SQ2204.2 +030200P MOVE PASS-COUNTER TO C-OK. SQ2204.2 +030300P MOVE ERROR-HOLD TO C-ALL. SQ2204.2 +030400P MOVE ERROR-COUNTER TO C-FAIL. SQ2204.2 +030500P MOVE DELETE-CNT TO C-DELETED. SQ2204.2 +030600P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2204.2 +030700P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2204.2 +030800PEND-E-2. SQ2204.2 +030900P CLOSE RAW-DATA. SQ2204.2 +031000 TERMINATE-CCVS. SQ2204.2 +031100S EXIT PROGRAM. SQ2204.2 +031200STERMINATE-CALL. SQ2204.2 +031300 STOP RUN. SQ2204.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2204.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2204.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2204.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2204.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2204.2 +031900 PRINT-DETAIL. SQ2204.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ2204.2 +032100 MOVE "." TO PARDOT-X SQ2204.2 +032200 MOVE REC-CT TO DOTVALUE. SQ2204.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2204.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2204.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2204.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2204.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2204.2 +032800 MOVE SPACE TO CORRECT-X. SQ2204.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2204.2 +033000 MOVE SPACE TO RE-MARK. SQ2204.2 +033100 HEAD-ROUTINE. SQ2204.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +033300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2204.2 +033400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2204.2 +033500 COLUMN-NAMES-ROUTINE. SQ2204.2 +033600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +033700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +033900 END-ROUTINE. SQ2204.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2204.2 +034100 END-RTN-EXIT. SQ2204.2 +034200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +034300 END-ROUTINE-1. SQ2204.2 +034400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2204.2 +034500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2204.2 +034600 ADD PASS-COUNTER TO ERROR-HOLD. SQ2204.2 +034700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2204.2 +034800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2204.2 +034900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2204.2 +035000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2204.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2204.2 +035200 END-ROUTINE-12. SQ2204.2 +035300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2204.2 +035400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2204.2 +035500 MOVE "NO " TO ERROR-TOTAL SQ2204.2 +035600 ELSE SQ2204.2 +035700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2204.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2204.2 +035900 PERFORM WRITE-LINE. SQ2204.2 +036000 END-ROUTINE-13. SQ2204.2 +036100 IF DELETE-CNT IS EQUAL TO ZERO SQ2204.2 +036200 MOVE "NO " TO ERROR-TOTAL ELSE SQ2204.2 +036300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2204.2 +036400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2204.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +036600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2204.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ2204.2 +036800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2204.2 +036900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2204.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +037100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +037200 WRITE-LINE. SQ2204.2 +037300 ADD 1 TO RECORD-COUNT. SQ2204.2 +037400Y IF RECORD-COUNT GREATER 50 SQ2204.2 +037500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2204.2 +037600Y MOVE SPACE TO DUMMY-RECORD SQ2204.2 +037700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2204.2 +037800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2204.2 +037900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2204.2 +038000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2204.2 +038100Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2204.2 +038200Y MOVE ZERO TO RECORD-COUNT. SQ2204.2 +038300 PERFORM WRT-LN. SQ2204.2 +038400 WRT-LN. SQ2204.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2204.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ2204.2 +038700 BLANK-LINE-PRINT. SQ2204.2 +038800 PERFORM WRT-LN. SQ2204.2 +038900 FAIL-ROUTINE. SQ2204.2 +039000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2204.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2204.2 +039200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2204.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +039400 GO TO FAIL-ROUTINE-EX. SQ2204.2 +039500 FAIL-ROUTINE-WRITE. SQ2204.2 +039600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2204.2 +039700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +039800 FAIL-ROUTINE-EX. EXIT. SQ2204.2 +039900 BAIL-OUT. SQ2204.2 +040000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2204.2 +040100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2204.2 +040200 BAIL-OUT-WRITE. SQ2204.2 +040300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2204.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +040500 BAIL-OUT-EX. EXIT. SQ2204.2 +040600 CCVS1-EXIT. SQ2204.2 +040700 EXIT. SQ2204.2 +040800 SECT-SQ220A-0001 SECTION. SQ2204.2 +040900 WRITE-INIT-GF-01. SQ2204.2 +041000 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2204.2 +041100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2204.2 +041200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2204.2 +041300 MOVE 0001 TO XBLOCK-SIZE (1). SQ2204.2 +041400 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2204.2 +041500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2204.2 +041600 MOVE "S" TO XLABEL-TYPE (1). SQ2204.2 +041700 MOVE 000000 TO XRECORD-NUMBER (1). SQ2204.2 +041800 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +041900 OPEN OUTPUT SQ-VS7. SQ2204.2 +042000 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2204.2 +042100 WRITE-TEST-GF-01. SQ2204.2 +042200 PERFORM WRITE-SHORT-REC. SQ2204.2 +042300 PERFORM WRITE-LONG-REC. SQ2204.2 +042400 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2204.2 +042500 PERFORM WRITE-LONG-REC 100 TIMES. SQ2204.2 +042600 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2204.2 +042700 WRITE-WRITE-GF-01. SQ2204.2 +042800 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2204.2 +042900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2204.2 +043000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2204.2 +043100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2204.2 +043200 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2204.2 +043300 PERFORM PRINT-DETAIL. SQ2204.2 +043400* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2204.2 +043500* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2204.2 +043600* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2204.2 +043700* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2204.2 +043800* 100L-338S. SQ2204.2 +043900 WRITE-CLOSE-GF-01. SQ2204.2 +044000 CLOSE SQ-VS7. SQ2204.2 +044100 GO TO READ-INIT-F1-01. SQ2204.2 +044200 WRITE-SHORT-REC. SQ2204.2 +044300 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2204.2 +044400 MOVE 000120 TO XRECORD-LENGTH (1). SQ2204.2 +044500 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +044600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2204.2 +044700 MOVE "SHORT" TO LONG-OR-SHORT. SQ2204.2 +044800 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2204.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2204.2 +045000 MOVE 120 TO RECORD-LENGTH. SQ2204.2 +045100 WRITE SQ-VS7R1-M-G-120. SQ2204.2 +045200 WRITE-LONG-REC. SQ2204.2 +045300 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2204.2 +045400 MOVE 000151 TO XRECORD-LENGTH (1). SQ2204.2 +045500 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +045600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2204.2 +045700 MOVE "LONG" TO LONG-OR-SHORT. SQ2204.2 +045800 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2204.2 +045900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2204.2 +046000 MOVE 151 TO RECORD-LENGTH. SQ2204.2 +046100 WRITE SQ-VS7R2-M-G-151. SQ2204.2 +046200 READ-INIT-F1-01. SQ2204.2 +046300 MOVE ZERO TO RECORD-LENGTH. SQ2204.2 +046400 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +046500 MOVE ZERO TO EOF-FLAG. SQ2204.2 +046600 MOVE ZERO TO RECORDS-IN-ERROR. SQ2204.2 +046700 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +046800 OPEN INPUT SQ-VS7. SQ2204.2 +046900 READ-TEST-F1-01. SQ2204.2 +047000 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2204.2 +047100 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +047200 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2204.2 +047300 GO TO READ-EOF-F1-06. SQ2204.2 +047400 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +047500 GO TO READ-FAIL-F1-01. SQ2204.2 +047600 READ-PASS-F1-01. SQ2204.2 +047700 PERFORM PASS. SQ2204.2 +047800 GO TO READ-WRITE-F1-01. SQ2204.2 +047900 READ-FAIL-F1-01. SQ2204.2 +048000 MOVE " FILE NOT OK. SEE PROGRAM & VII-52 OR -44" TO RE-MARK. SQ2204.2 +048100 PERFORM FAIL. SQ2204.2 +048200 READ-WRITE-F1-01. SQ2204.2 +048300 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +048400 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2204.2 +048500 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +048600 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +048700 MOVE 120 TO CORRECT-N. SQ2204.2 +048800 PERFORM PRINT-DETAIL. SQ2204.2 +048900 GO TO READ-INIT-F1-02. SQ2204.2 +049000 READ-SHORT-REC. SQ2204.2 +049100* READ NEXT RECORD AT END *SQ2204.2 +049200******************************************************************SQ2204.2 +049300 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +049400 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +049500 READ SQ-VS7 NEXT RECORD AT END SQ2204.2 +049600 MOVE 1 TO EOF-FLAG SQ2204.2 +049700 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +049800 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +049900 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2204.2 +050000 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2204.2 +050100 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050200 IF RECORD-LENGTH NOT EQUAL TO 120 SQ2204.2 +050300 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050400 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2204.2 +050500 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050600 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2204.2 +050700 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +050800 READ-SHORT-REC-ERROR. SQ2204.2 +050900 ADD 1 TO RECORDS-IN-ERROR. SQ2204.2 +051000 MOVE 1 TO ERROR-FLAG. SQ2204.2 +051100 READ-SHORT-REC-EXIT. SQ2204.2 +051200 EXIT. SQ2204.2 +051300 READ-INIT-F1-02. SQ2204.2 +051400 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +051500 READ-TEST-F1-02. SQ2204.2 +051600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2204.2 +051700 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +051800 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2204.2 +051900 GO TO READ-EOF-F1-06. SQ2204.2 +052000 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +052100 GO TO READ-FAIL-F1-02. SQ2204.2 +052200 READ-PASS-F1-02. SQ2204.2 +052300 PERFORM PASS. SQ2204.2 +052400 GO TO READ-WRITE-F1-02. SQ2204.2 +052500 READ-FAIL-F1-02. SQ2204.2 +052600 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2204.2 +052700 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +052800 MOVE 151 TO CORRECT-N. SQ2204.2 +052900 PERFORM FAIL. SQ2204.2 +053000 READ-WRITE-F1-02. SQ2204.2 +053100 MOVE "READ LONG RECORD" TO FEATURE. SQ2204.2 +053200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2204.2 +053300 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2204.2 +053400 PERFORM PRINT-DETAIL. SQ2204.2 +053500 GO TO READ-INIT-F1-03. SQ2204.2 +053600 READ-LONG-REC. SQ2204.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2204.2 +053900 READ SQ-VS7 END SQ2204.2 +054000 MOVE 1 TO EOF-FLAG SQ2204.2 +054100 GO TO READ-LONG-REC-EXIT. SQ2204.2 +054200 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +054300 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2204.2 +054400 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2204.2 +054500 GO TO READ-LONG-REC-ERROR. SQ2204.2 +054600 IF RECORD-LENGTH NOT EQUAL TO 151 SQ2204.2 +054700 GO TO READ-LONG-REC-ERROR. SQ2204.2 +054800 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2204.2 +054900 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2204.2 +055000 GO TO READ-LONG-REC-ERROR. SQ2204.2 +055100 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2204.2 +055200 GO TO READ-LONG-REC-EXIT. SQ2204.2 +055300 READ-LONG-REC-ERROR. SQ2204.2 +055400 ADD 1 TO RECORDS-IN-ERROR. SQ2204.2 +055500 MOVE 1 TO ERROR-FLAG. SQ2204.2 +055600 READ-LONG-REC-EXIT. SQ2204.2 +055700 EXIT. SQ2204.2 +055800 READ-INIT-F1-03. SQ2204.2 +055900 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +056000 READ-TEST-F1-03. SQ2204.2 +056100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2204.2 +056200 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +056300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +056400 GO TO READ-EOF-F1-06. SQ2204.2 +056500 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +056600 GO TO READ-FAIL-F1-03. SQ2204.2 +056700 READ-PASS-F1-03. SQ2204.2 +056800 PERFORM PASS. SQ2204.2 +056900 GO TO READ-WRITE-F1-03. SQ2204.2 +057000 READ-FAIL-F1-03. SQ2204.2 +057100 MOVE "SEE VII-52 WRITE SHORT REC OR VII-44 READ" TO RE-MARKSQ2204.2 +057200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +057300 MOVE 120 TO CORRECT-N. SQ2204.2 +057400 PERFORM FAIL. SQ2204.2 +057500 READ-WRITE-F1-03. SQ2204.2 +057600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2204.2 +057700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2204.2 +057800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +057900 PERFORM PRINT-DETAIL. SQ2204.2 +058000 READ-INIT-F1-04. SQ2204.2 +058100 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +058200 READ-TEST-F1-04. SQ2204.2 +058300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2204.2 +058400 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +058500 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +058600 GO TO READ-EOF-F1-06. SQ2204.2 +058700 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +058800 GO TO READ-FAIL-F1-04. SQ2204.2 +058900 READ-PASS-F1-04. SQ2204.2 +059000 PERFORM PASS. SQ2204.2 +059100 GO TO READ-WRITE-F1-04. SQ2204.2 +059200 READ-FAIL-F1-04. SQ2204.2 +059300 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +059400 MOVE 151 TO CORRECT-N. SQ2204.2 +059500 PERFORM FAIL. SQ2204.2 +059600 READ-WRITE-F1-04. SQ2204.2 +059700 MOVE "READ LONG RECORDS" TO FEATURE. SQ2204.2 +059800 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2204.2 +059900 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2204.2 +060000 PERFORM PRINT-DETAIL. SQ2204.2 +060100 READ-INIT-F1-05. SQ2204.2 +060200 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +060300 READ-TEST-F1-05. SQ2204.2 +060400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2204.2 +060500 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +060600 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +060700 GO TO READ-EOF-F1-06. SQ2204.2 +060800 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +060900 GO TO READ-FAIL-F1-05. SQ2204.2 +061000 READ-PASS-F1-05. SQ2204.2 +061100 PERFORM PASS. SQ2204.2 +061200 GO TO READ-WRITE-F1-05. SQ2204.2 +061300 READ-FAIL-F1-05. SQ2204.2 +061400 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2204.2 +061500 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +061600 MOVE 120 TO CORRECT-N. SQ2204.2 +061700 PERFORM FAIL. SQ2204.2 +061800 READ-WRITE-F1-05. SQ2204.2 +061900 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2204.2 +062000 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2204.2 +062100 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +062200 PERFORM PRINT-DETAIL. SQ2204.2 +062300 READ-INIT-F1-06. SQ2204.2 +062400 READ SQ-VS7 RECORD END SQ2204.2 +062500 GO TO READ-TEST-F1-06. SQ2204.2 +062600 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2204.2 +062700 GO TO READ-FAIL-F1-06. SQ2204.2 +062800 READ-EOF-F1-06. SQ2204.2 +062900 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2204.2 +063000 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2204.2 +063100 GO TO READ-FAIL-F1-06. SQ2204.2 +063200 READ-TEST-F1-06. SQ2204.2 +063300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2204.2 +063400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2204.2 +063500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2204.2 +063600 GO TO READ-FAIL-F1-06. SQ2204.2 +063700 READ-PASS-F1-06. SQ2204.2 +063800 PERFORM PASS. SQ2204.2 +063900 GO TO READ-WRITE-F1-06. SQ2204.2 +064000 READ-FAIL-F1-06. SQ2204.2 +064100 PERFORM FAIL. SQ2204.2 +064200 READ-WRITE-F1-06. SQ2204.2 +064300 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2204.2 +064400 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2204.2 +064500 PERFORM PRINT-DETAIL. SQ2204.2 +064600 READ-CLOSE-F1-06. SQ2204.2 +064700 CLOSE SQ-VS7. SQ2204.2 +064800 SECT-SQ220A-0002 SECTION. SQ2204.2 +064900* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2204.2 +065000* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2204.2 +065100* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2204.2 +065200* 130 IS UNIQUE FOR EACH RECORD. SQ2204.2 +065300 INFO-INIT-01. SQ2204.2 +065400 OPEN INPUT SQ-VS7. SQ2204.2 +065500 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +065600 INFO-TEST-01. SQ2204.2 +065700 READ SQ-VS7 AT END SQ2204.2 +065800 GO TO INFO-END. SQ2204.2 +065900 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +066000 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2204.2 +066100 GO TO NO-INFO-01. SQ2204.2 +066200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +066300 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +066400 MOVE 0001 TO CORRECT-18V0. SQ2204.2 +066500 GO TO INFO-WRITE-01. SQ2204.2 +066600 NO-INFO-01. SQ2204.2 +066700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +066800 INFO-WRITE-01. SQ2204.2 +066900 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +067000 MOVE "INFO-TEST-01" TO PAR-NAME. SQ2204.2 +067100 PERFORM PRINT-DETAIL. SQ2204.2 +067200 INFO-INIT-02. SQ2204.2 +067300 READ SQ-VS7 RECORD AT END SQ2204.2 +067400 GO TO INFO-END. SQ2204.2 +067500 READ SQ-VS7 END SQ2204.2 +067600 GO TO INFO-END. SQ2204.2 +067700 INFO-TEST-02. SQ2204.2 +067800 READ SQ-VS7 AT END SQ2204.2 +067900 GO TO INFO-END. SQ2204.2 +068000 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2204.2 +068100 GO TO NO-INFO-02. SQ2204.2 +068200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +068300 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +068400 MOVE 0004 TO CORRECT-18V0. SQ2204.2 +068500 GO TO INFO-WRITE-02. SQ2204.2 +068600 NO-INFO-02. SQ2204.2 +068700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +068800 INFO-WRITE-02. SQ2204.2 +068900 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +069000 MOVE "INFO-TEST-02" TO PAR-NAME. SQ2204.2 +069100 PERFORM PRINT-DETAIL. SQ2204.2 +069200 INFO-INIT-03. SQ2204.2 +069300 ADD 3 TO COUNT-OF-RECS. SQ2204.2 +069400 INFO-INIT-03-1. SQ2204.2 +069500 READ SQ-VS7 RECORD SQ2204.2 +069600 END GO TO INFO-END. SQ2204.2 +069700 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +069800 IF COUNT-OF-RECS EQUAL TO 450 SQ2204.2 +069900 GO TO INFO-TEST-03. SQ2204.2 +070000 GO TO INFO-INIT-03-1. SQ2204.2 +070100 INFO-TEST-03. SQ2204.2 +070200 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2204.2 +070300 GO TO NO-INFO-03. SQ2204.2 +070400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +070500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +070600 MOVE 0450 TO CORRECT-18V0. SQ2204.2 +070700 GO TO INFO-WRITE-03. SQ2204.2 +070800 NO-INFO-03. SQ2204.2 +070900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +071000 INFO-WRITE-03. SQ2204.2 +071100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +071200 MOVE "INFO-TEST-03" TO PAR-NAME. SQ2204.2 +071300 PERFORM PRINT-DETAIL. SQ2204.2 +071400 INFO-END. SQ2204.2 +071500 CLOSE SQ-VS7. SQ2204.2 +071600 TERMINATE-ROUTINE. SQ2204.2 +071700 EXIT. SQ2204.2 +071800 CCVS-EXIT SECTION. SQ2204.2 +071900 CCVS-999999. SQ2204.2 +072000 GO TO CLOSE-FILES. SQ2204.2 +*END-OF,SQ220A +*HEADER,COBOL,SQ221A +000100 IDENTIFICATION DIVISION. SQ2214.2 +000200 PROGRAM-ID. SQ2214.2 +000300 SQ221A. SQ2214.2 +000400**************************************************************** SQ2214.2 +000500* * SQ2214.2 +000600* VALIDATION FOR:- * SQ2214.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2214.2 +000800* * SQ2214.2 +000900* CREATION DATE / VALIDATION DATE * SQ2214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2214.2 +001100* * SQ2214.2 +001200* THIS ROUTINE CHECKS: SQ2214.2 +001300* SQ2214.2 +001400* RECORD VARYING DEPENDING RECORD-LENGTH SQ2214.2 +001500* SQ2214.2 +001600* SQ2214.2 +001700* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2214.2 +001800* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2214.2 +001900* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2214.2 +002000* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2214.2 +002100* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2214.2 +002200* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2214.2 +002300* AGAINST THE EXPECTED VALUES. SQ2214.2 +002400* SQ2214.2 +002500* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2214.2 +002600* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2214.2 +002700* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2214.2 +002800* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2214.2 +002900* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2214.2 +003000 ENVIRONMENT DIVISION. SQ2214.2 +003100 CONFIGURATION SECTION. SQ2214.2 +003200 SOURCE-COMPUTER. SQ2214.2 +003300 XXXXX082. SQ2214.2 +003400 OBJECT-COMPUTER. SQ2214.2 +003500 XXXXX083. SQ2214.2 +003600 INPUT-OUTPUT SECTION. SQ2214.2 +003700 FILE-CONTROL. SQ2214.2 +003800P SELECT RAW-DATA ASSIGN TO SQ2214.2 +003900P XXXXX062 SQ2214.2 +004000P ORGANIZATION IS INDEXED SQ2214.2 +004100P ACCESS MODE IS RANDOM SQ2214.2 +004200P RECORD KEY IS RAW-DATA-KEY. SQ2214.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2214.2 +004400 XXXXX055. SQ2214.2 +004500 SELECT SQ-VS7 ASSIGN TO SQ2214.2 +004600 XXXXX014 SQ2214.2 +004700 ORGANIZATION SEQUENTIAL SQ2214.2 +004800 ACCESS SEQUENTIAL. SQ2214.2 +004900 DATA DIVISION. SQ2214.2 +005000 FILE SECTION. SQ2214.2 +005100P SQ2214.2 +005200PFD RAW-DATA. SQ2214.2 +005300P SQ2214.2 +005400P01 RAW-DATA-SATZ. SQ2214.2 +005500P 05 RAW-DATA-KEY PIC X(6). SQ2214.2 +005600P 05 C-DATE PIC 9(6). SQ2214.2 +005700P 05 C-TIME PIC 9(8). SQ2214.2 +005800P 05 C-NO-OF-TESTS PIC 99. SQ2214.2 +005900P 05 C-OK PIC 999. SQ2214.2 +006000P 05 C-ALL PIC 999. SQ2214.2 +006100P 05 C-FAIL PIC 999. SQ2214.2 +006200P 05 C-DELETED PIC 999. SQ2214.2 +006300P 05 C-INSPECT PIC 999. SQ2214.2 +006400P 05 C-NOTE PIC X(13). SQ2214.2 +006500P 05 C-INDENT PIC X. SQ2214.2 +006600P 05 C-ABORT PIC X(8). SQ2214.2 +006700 FD PRINT-FILE SQ2214.2 +006800C LABEL RECORDS SQ2214.2 +006900C XXXXX084 SQ2214.2 +007000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2214.2 +007100 . SQ2214.2 +007200 01 PRINT-REC PICTURE X(120). SQ2214.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2214.2 +007400 FD SQ-VS7 SQ2214.2 +007500C LABEL RECORDS ARE STANDARD SQ2214.2 +007600 RECORD VARYING DEPENDING RECORD-LENGTH. SQ2214.2 +007700 01 SQ-VS7R1-M-G-120. SQ2214.2 +007800 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2214.2 +007900 01 SQ-VS7R2-M-G-151. SQ2214.2 +008000 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2214.2 +008100 02 LONG-OR-SHORT PICTURE X(5). SQ2214.2 +008200 02 SQ-VS7-RECNO PICTURE X(5). SQ2214.2 +008300 02 SQ-VS7-FILLER PICTURE X(21). SQ2214.2 +008400 WORKING-STORAGE SECTION. SQ2214.2 +008500 01 RECORD-LENGTH PICTURE 999 VALUE ZERO. SQ2214.2 +008600 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2214.2 +008700 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2214.2 +008800 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2214.2 +008900 01 ERROR-FLAG PICTURE 9. SQ2214.2 +009000 01 EOF-FLAG PICTURE 9. SQ2214.2 +009100 01 DUMP-AREA. SQ2214.2 +009200 02 TYPE-OF-REC PICTURE X(5). SQ2214.2 +009300 02 RECNO PICTURE 9(5). SQ2214.2 +009400 02 REC-FILLER PICTURE X(21). SQ2214.2 +009500 01 FILE-RECORD-INFORMATION-REC. SQ2214.2 +009600 03 FILE-RECORD-INFO-SKELETON. SQ2214.2 +009700 05 FILLER PICTURE X(48) VALUE SQ2214.2 +009800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2214.2 +009900 05 FILLER PICTURE X(46) VALUE SQ2214.2 +010000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2214.2 +010100 05 FILLER PICTURE X(26) VALUE SQ2214.2 +010200 ",LFIL=000000,ORG= ,LBLR= ". SQ2214.2 +010300 05 FILLER PICTURE X(37) VALUE SQ2214.2 +010400 ",RECKEY= ". SQ2214.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2214.2 +010600 ",ALTKEY1= ". SQ2214.2 +010700 05 FILLER PICTURE X(38) VALUE SQ2214.2 +010800 ",ALTKEY2= ". SQ2214.2 +010900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2214.2 +011000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2214.2 +011100 05 FILE-RECORD-INFO-P1-120. SQ2214.2 +011200 07 FILLER PIC X(5). SQ2214.2 +011300 07 XFILE-NAME PIC X(6). SQ2214.2 +011400 07 FILLER PIC X(8). SQ2214.2 +011500 07 XRECORD-NAME PIC X(6). SQ2214.2 +011600 07 FILLER PIC X(1). SQ2214.2 +011700 07 REELUNIT-NUMBER PIC 9(1). SQ2214.2 +011800 07 FILLER PIC X(7). SQ2214.2 +011900 07 XRECORD-NUMBER PIC 9(6). SQ2214.2 +012000 07 FILLER PIC X(6). SQ2214.2 +012100 07 UPDATE-NUMBER PIC 9(2). SQ2214.2 +012200 07 FILLER PIC X(5). SQ2214.2 +012300 07 ODO-NUMBER PIC 9(4). SQ2214.2 +012400 07 FILLER PIC X(5). SQ2214.2 +012500 07 XPROGRAM-NAME PIC X(5). SQ2214.2 +012600 07 FILLER PIC X(7). SQ2214.2 +012700 07 XRECORD-LENGTH PIC 9(6). SQ2214.2 +012800 07 FILLER PIC X(7). SQ2214.2 +012900 07 CHARS-OR-RECORDS PIC X(2). SQ2214.2 +013000 07 FILLER PIC X(1). SQ2214.2 +013100 07 XBLOCK-SIZE PIC 9(4). SQ2214.2 +013200 07 FILLER PIC X(6). SQ2214.2 +013300 07 RECORDS-IN-FILE PIC 9(6). SQ2214.2 +013400 07 FILLER PIC X(5). SQ2214.2 +013500 07 XFILE-ORGANIZATION PIC X(2). SQ2214.2 +013600 07 FILLER PIC X(6). SQ2214.2 +013700 07 XLABEL-TYPE PIC X(1). SQ2214.2 +013800 05 FILE-RECORD-INFO-P121-240. SQ2214.2 +013900 07 FILLER PIC X(8). SQ2214.2 +014000 07 XRECORD-KEY PIC X(29). SQ2214.2 +014100 07 FILLER PIC X(9). SQ2214.2 +014200 07 ALTERNATE-KEY1 PIC X(29). SQ2214.2 +014300 07 FILLER PIC X(9). SQ2214.2 +014400 07 ALTERNATE-KEY2 PIC X(29). SQ2214.2 +014500 07 FILLER PIC X(7). SQ2214.2 +014600 01 TEST-RESULTS. SQ2214.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +014800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2214.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +015000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2214.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +015200 02 PAR-NAME. SQ2214.2 +015300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2214.2 +015400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2214.2 +015500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2214.2 +015600 03 FILLER PIC X(5) VALUE SPACE. SQ2214.2 +015700 02 FILLER PIC X(10) VALUE SPACE. SQ2214.2 +015800 02 RE-MARK PIC X(61). SQ2214.2 +015900 01 TEST-COMPUTED. SQ2214.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ2214.2 +016100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2214.2 +016200 02 COMPUTED-X. SQ2214.2 +016300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2214.2 +016400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2214.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2214.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2214.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2214.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2214.2 +016900 04 COMPUTED-18V0 PICTURE -9(18). SQ2214.2 +017000 04 FILLER PICTURE X. SQ2214.2 +017100 03 FILLER PIC X(50) VALUE SPACE. SQ2214.2 +017200 01 TEST-CORRECT. SQ2214.2 +017300 02 FILLER PIC X(30) VALUE SPACE. SQ2214.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2214.2 +017500 02 CORRECT-X. SQ2214.2 +017600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2214.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2214.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2214.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2214.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2214.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. SQ2214.2 +018200 04 CORRECT-18V0 PICTURE -9(18). SQ2214.2 +018300 04 FILLER PICTURE X. SQ2214.2 +018400 03 FILLER PIC X(50) VALUE SPACE. SQ2214.2 +018500 01 CCVS-C-1. SQ2214.2 +018600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2214.2 +018700- "SS PARAGRAPH-NAME SQ2214.2 +018800- " REMARKS". SQ2214.2 +018900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2214.2 +019000 01 CCVS-C-2. SQ2214.2 +019100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +019200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2214.2 +019300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2214.2 +019400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2214.2 +019500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2214.2 +019600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2214.2 +019700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2214.2 +019800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2214.2 +019900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2214.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2214.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2214.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2214.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2214.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2214.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2214.2 +020600 01 CCVS-H-1. SQ2214.2 +020700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2214.2 +020800 02 FILLER PICTURE X(67) VALUE SQ2214.2 +020900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2214.2 +021000- " SYSTEM". SQ2214.2 +021100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2214.2 +021200 01 CCVS-H-2. SQ2214.2 +021300 02 FILLER PICTURE X(52) VALUE IS SQ2214.2 +021400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2214.2 +021500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2214.2 +021600 02 TEST-ID PICTURE IS X(9). SQ2214.2 +021700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2214.2 +021800 01 CCVS-H-3. SQ2214.2 +021900 02 FILLER PICTURE X(34) VALUE SQ2214.2 +022000 " FOR OFFICIAL USE ONLY ". SQ2214.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2214.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2214.2 +022300 02 FILLER PICTURE X(28) VALUE SQ2214.2 +022400 " COPYRIGHT 1985 ". SQ2214.2 +022500 01 CCVS-E-1. SQ2214.2 +022600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2214.2 +022700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2214.2 +022800 02 ID-AGAIN PICTURE IS X(9). SQ2214.2 +022900 02 FILLER PICTURE X(45) VALUE IS SQ2214.2 +023000 " NTIS DISTRIBUTION COBOL 85". SQ2214.2 +023100 01 CCVS-E-2. SQ2214.2 +023200 02 FILLER PICTURE X(31) VALUE SQ2214.2 +023300 SPACE. SQ2214.2 +023400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2214.2 +023500 02 CCVS-E-2-2. SQ2214.2 +023600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2214.2 +023700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +023800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2214.2 +023900 01 CCVS-E-3. SQ2214.2 +024000 02 FILLER PICTURE X(22) VALUE SQ2214.2 +024100 " FOR OFFICIAL USE ONLY". SQ2214.2 +024200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2214.2 +024300 02 FILLER PICTURE X(58) VALUE SQ2214.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2214.2 +024500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2214.2 +024600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2214.2 +024700 01 CCVS-E-4. SQ2214.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2214.2 +024900 02 FILLER PIC XXXX VALUE " OF ". SQ2214.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2214.2 +025100 02 FILLER PIC X(40) VALUE SQ2214.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2214.2 +025300 01 XXINFO. SQ2214.2 +025400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2214.2 +025500 02 INFO-TEXT. SQ2214.2 +025600 04 FILLER PIC X(20) VALUE SPACE. SQ2214.2 +025700 04 XXCOMPUTED PIC X(20). SQ2214.2 +025800 04 FILLER PIC X(5) VALUE SPACE. SQ2214.2 +025900 04 XXCORRECT PIC X(20). SQ2214.2 +026000 01 HYPHEN-LINE. SQ2214.2 +026100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +026200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2214.2 +026300- "*****************************************". SQ2214.2 +026400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2214.2 +026500- "******************************". SQ2214.2 +026600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2214.2 +026700 "SQ221A". SQ2214.2 +026800 PROCEDURE DIVISION. SQ2214.2 +026900 CCVS1 SECTION. SQ2214.2 +027000 OPEN-FILES. SQ2214.2 +027100P OPEN I-O RAW-DATA. SQ2214.2 +027200P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2214.2 +027300P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2214.2 +027400P MOVE "ABORTED " TO C-ABORT. SQ2214.2 +027500P ADD 1 TO C-NO-OF-TESTS. SQ2214.2 +027600P ACCEPT C-DATE FROM DATE. SQ2214.2 +027700P ACCEPT C-TIME FROM TIME. SQ2214.2 +027800P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2214.2 +027900PEND-E-1. SQ2214.2 +028000P CLOSE RAW-DATA. SQ2214.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2214.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2214.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ2214.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2214.2 +028500 MOVE ZERO TO REC-SKL-SUB. SQ2214.2 +028600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2214.2 +028700 CCVS-INIT-FILE. SQ2214.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2214.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2214.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2214.2 +029100 CCVS-INIT-EXIT. SQ2214.2 +029200 GO TO CCVS1-EXIT. SQ2214.2 +029300 CLOSE-FILES. SQ2214.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2214.2 +029500P OPEN I-O RAW-DATA. SQ2214.2 +029600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2214.2 +029700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2214.2 +029800P MOVE "OK. " TO C-ABORT. SQ2214.2 +029900P MOVE PASS-COUNTER TO C-OK. SQ2214.2 +030000P MOVE ERROR-HOLD TO C-ALL. SQ2214.2 +030100P MOVE ERROR-COUNTER TO C-FAIL. SQ2214.2 +030200P MOVE DELETE-CNT TO C-DELETED. SQ2214.2 +030300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2214.2 +030400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2214.2 +030500PEND-E-2. SQ2214.2 +030600P CLOSE RAW-DATA. SQ2214.2 +030700 TERMINATE-CCVS. SQ2214.2 +030800S EXIT PROGRAM. SQ2214.2 +030900STERMINATE-CALL. SQ2214.2 +031000 STOP RUN. SQ2214.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2214.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2214.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2214.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2214.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2214.2 +031600 PRINT-DETAIL. SQ2214.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2214.2 +031800 MOVE "." TO PARDOT-X SQ2214.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2214.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2214.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2214.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2214.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2214.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2214.2 +032500 MOVE SPACE TO CORRECT-X. SQ2214.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2214.2 +032700 MOVE SPACE TO RE-MARK. SQ2214.2 +032800 HEAD-ROUTINE. SQ2214.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2214.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2214.2 +033200 COLUMN-NAMES-ROUTINE. SQ2214.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +033600 END-ROUTINE. SQ2214.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2214.2 +033800 END-RTN-EXIT. SQ2214.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +034000 END-ROUTINE-1. SQ2214.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2214.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2214.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2214.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2214.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2214.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2214.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2214.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2214.2 +034900 END-ROUTINE-12. SQ2214.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2214.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2214.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2214.2 +035300 ELSE SQ2214.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2214.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2214.2 +035600 PERFORM WRITE-LINE. SQ2214.2 +035700 END-ROUTINE-13. SQ2214.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2214.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2214.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2214.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2214.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2214.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2214.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2214.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2214.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036900 WRITE-LINE. SQ2214.2 +037000 ADD 1 TO RECORD-COUNT. SQ2214.2 +037100Y IF RECORD-COUNT GREATER 50 SQ2214.2 +037200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2214.2 +037300Y MOVE SPACE TO DUMMY-RECORD SQ2214.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2214.2 +037500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2214.2 +037600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2214.2 +037700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2214.2 +037800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2214.2 +037900Y MOVE ZERO TO RECORD-COUNT. SQ2214.2 +038000 PERFORM WRT-LN. SQ2214.2 +038100 WRT-LN. SQ2214.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2214.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2214.2 +038400 BLANK-LINE-PRINT. SQ2214.2 +038500 PERFORM WRT-LN. SQ2214.2 +038600 FAIL-ROUTINE. SQ2214.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2214.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2214.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2214.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2214.2 +039200 FAIL-ROUTINE-WRITE. SQ2214.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2214.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2214.2 +039600 BAIL-OUT. SQ2214.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2214.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2214.2 +039900 BAIL-OUT-WRITE. SQ2214.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2214.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +040200 BAIL-OUT-EX. EXIT. SQ2214.2 +040300 CCVS1-EXIT. SQ2214.2 +040400 EXIT. SQ2214.2 +040500 SECT-SQ221A-0001 SECTION. SQ2214.2 +040600 WRITE-INIT-GF-01. SQ2214.2 +040700 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2214.2 +040800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2214.2 +040900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2214.2 +041000 MOVE 0001 TO XBLOCK-SIZE (1). SQ2214.2 +041100 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2214.2 +041200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2214.2 +041300 MOVE "S" TO XLABEL-TYPE (1). SQ2214.2 +041400 MOVE 000000 TO XRECORD-NUMBER (1). SQ2214.2 +041500 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +041600 OPEN OUTPUT SQ-VS7. SQ2214.2 +041700 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2214.2 +041800 WRITE-TEST-GF-01. SQ2214.2 +041900 PERFORM WRITE-SHORT-REC. SQ2214.2 +042000 PERFORM WRITE-LONG-REC. SQ2214.2 +042100 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2214.2 +042200 PERFORM WRITE-LONG-REC 100 TIMES. SQ2214.2 +042300 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2214.2 +042400 WRITE-WRITE-GF-01. SQ2214.2 +042500 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2214.2 +042600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2214.2 +042700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2214.2 +042800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2214.2 +042900 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2214.2 +043000 PERFORM PRINT-DETAIL. SQ2214.2 +043100* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2214.2 +043200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2214.2 +043300* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2214.2 +043400* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2214.2 +043500* 100L-338S. SQ2214.2 +043600 WRITE-CLOSE-GF-01. SQ2214.2 +043700 CLOSE SQ-VS7. SQ2214.2 +043800 GO TO READ-INIT-F1-01. SQ2214.2 +043900 WRITE-SHORT-REC. SQ2214.2 +044000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2214.2 +044100 MOVE 000120 TO XRECORD-LENGTH (1). SQ2214.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +044300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2214.2 +044400 MOVE "SHORT" TO LONG-OR-SHORT. SQ2214.2 +044500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2214.2 +044600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2214.2 +044700 MOVE 120 TO RECORD-LENGTH. SQ2214.2 +044800 WRITE SQ-VS7R1-M-G-120. SQ2214.2 +044900 WRITE-LONG-REC. SQ2214.2 +045000 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2214.2 +045100 MOVE 000151 TO XRECORD-LENGTH (1). SQ2214.2 +045200 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +045300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2214.2 +045400 MOVE "LONG" TO LONG-OR-SHORT. SQ2214.2 +045500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2214.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2214.2 +045700 MOVE 151 TO RECORD-LENGTH. SQ2214.2 +045800 WRITE SQ-VS7R2-M-G-151. SQ2214.2 +045900 READ-INIT-F1-01. SQ2214.2 +046000 MOVE ZERO TO RECORD-LENGTH. SQ2214.2 +046100 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +046200 MOVE ZERO TO EOF-FLAG. SQ2214.2 +046300 MOVE ZERO TO RECORDS-IN-ERROR. SQ2214.2 +046400 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +046500 OPEN INPUT SQ-VS7. SQ2214.2 +046600 READ-TEST-F1-01. SQ2214.2 +046700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2214.2 +046800 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +046900 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2214.2 +047000 GO TO READ-EOF-F1-06. SQ2214.2 +047100 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +047200 GO TO READ-FAIL-F1-01. SQ2214.2 +047300 READ-PASS-F1-01. SQ2214.2 +047400 PERFORM PASS. SQ2214.2 +047500 GO TO READ-WRITE-F1-01. SQ2214.2 +047600 READ-FAIL-F1-01. SQ2214.2 +047700 MOVE " FILE NOT OK. SEE PROGRAM & VII-52 OR -44" TO RE-MARK. SQ2214.2 +047800 PERFORM FAIL. SQ2214.2 +047900 READ-WRITE-F1-01. SQ2214.2 +048000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2214.2 +048200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +048300 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +048400 MOVE 120 TO CORRECT-N. SQ2214.2 +048500 PERFORM PRINT-DETAIL. SQ2214.2 +048600 GO TO READ-INIT-F1-02. SQ2214.2 +048700 READ-SHORT-REC. SQ2214.2 +048800* READ NEXT RECORD AT END *SQ2214.2 +048900******************************************************************SQ2214.2 +049000 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +049100 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +049200 READ SQ-VS7 NEXT RECORD AT END SQ2214.2 +049300 MOVE 1 TO EOF-FLAG SQ2214.2 +049400 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +049500 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +049600 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2214.2 +049700 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2214.2 +049800 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +049900 IF RECORD-LENGTH NOT EQUAL TO 120 SQ2214.2 +050000 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +050100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2214.2 +050200 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +050300 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2214.2 +050400 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +050500 READ-SHORT-REC-ERROR. SQ2214.2 +050600 ADD 1 TO RECORDS-IN-ERROR. SQ2214.2 +050700 MOVE 1 TO ERROR-FLAG. SQ2214.2 +050800 READ-SHORT-REC-EXIT. SQ2214.2 +050900 EXIT. SQ2214.2 +051000 READ-INIT-F1-02. SQ2214.2 +051100 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +051200 READ-TEST-F1-02. SQ2214.2 +051300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2214.2 +051400 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +051500 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2214.2 +051600 GO TO READ-EOF-F1-06. SQ2214.2 +051700 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +051800 GO TO READ-FAIL-F1-02. SQ2214.2 +051900 READ-PASS-F1-02. SQ2214.2 +052000 PERFORM PASS. SQ2214.2 +052100 GO TO READ-WRITE-F1-02. SQ2214.2 +052200 READ-FAIL-F1-02. SQ2214.2 +052300 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2214.2 +052400 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +052500 MOVE 151 TO CORRECT-N. SQ2214.2 +052600 PERFORM FAIL. SQ2214.2 +052700 READ-WRITE-F1-02. SQ2214.2 +052800 MOVE "READ LONG RECORD" TO FEATURE. SQ2214.2 +052900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2214.2 +053000 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2214.2 +053100 PERFORM PRINT-DETAIL. SQ2214.2 +053200 GO TO READ-INIT-F1-03. SQ2214.2 +053300 READ-LONG-REC. SQ2214.2 +053400 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +053500 GO TO READ-LONG-REC-EXIT. SQ2214.2 +053600 READ SQ-VS7 END SQ2214.2 +053700 MOVE 1 TO EOF-FLAG SQ2214.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2214.2 +053900 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +054000 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2214.2 +054100 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2214.2 +054200 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054300 IF RECORD-LENGTH NOT EQUAL TO 151 SQ2214.2 +054400 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054500 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2214.2 +054600 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2214.2 +054700 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054800 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2214.2 +054900 GO TO READ-LONG-REC-EXIT. SQ2214.2 +055000 READ-LONG-REC-ERROR. SQ2214.2 +055100 ADD 1 TO RECORDS-IN-ERROR. SQ2214.2 +055200 MOVE 1 TO ERROR-FLAG. SQ2214.2 +055300 READ-LONG-REC-EXIT. SQ2214.2 +055400 EXIT. SQ2214.2 +055500 READ-INIT-F1-03. SQ2214.2 +055600 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +055700 READ-TEST-F1-03. SQ2214.2 +055800 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2214.2 +055900 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +056000 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +056100 GO TO READ-EOF-F1-06. SQ2214.2 +056200 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +056300 GO TO READ-FAIL-F1-03. SQ2214.2 +056400 READ-PASS-F1-03. SQ2214.2 +056500 PERFORM PASS. SQ2214.2 +056600 GO TO READ-WRITE-F1-03. SQ2214.2 +056700 READ-FAIL-F1-03. SQ2214.2 +056800 MOVE "SEE VII-52 WRITE SHORT REC OR VII-44 READ" TO RE-MARKSQ2214.2 +056900 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +057000 MOVE 120 TO CORRECT-N. SQ2214.2 +057100 PERFORM FAIL. SQ2214.2 +057200 READ-WRITE-F1-03. SQ2214.2 +057300 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2214.2 +057400 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2214.2 +057500 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +057600 PERFORM PRINT-DETAIL. SQ2214.2 +057700 READ-INIT-F1-04. SQ2214.2 +057800 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +057900 READ-TEST-F1-04. SQ2214.2 +058000 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2214.2 +058100 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +058200 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +058300 GO TO READ-EOF-F1-06. SQ2214.2 +058400 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +058500 GO TO READ-FAIL-F1-04. SQ2214.2 +058600 READ-PASS-F1-04. SQ2214.2 +058700 PERFORM PASS. SQ2214.2 +058800 GO TO READ-WRITE-F1-04. SQ2214.2 +058900 READ-FAIL-F1-04. SQ2214.2 +059000 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +059100 MOVE 151 TO CORRECT-N. SQ2214.2 +059200 PERFORM FAIL. SQ2214.2 +059300 READ-WRITE-F1-04. SQ2214.2 +059400 MOVE "READ LONG RECORDS" TO FEATURE. SQ2214.2 +059500 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2214.2 +059600 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2214.2 +059700 PERFORM PRINT-DETAIL. SQ2214.2 +059800 READ-INIT-F1-05. SQ2214.2 +059900 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +060000 READ-TEST-F1-05. SQ2214.2 +060100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2214.2 +060200 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +060300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +060400 GO TO READ-EOF-F1-06. SQ2214.2 +060500 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +060600 GO TO READ-FAIL-F1-05. SQ2214.2 +060700 READ-PASS-F1-05. SQ2214.2 +060800 PERFORM PASS. SQ2214.2 +060900 GO TO READ-WRITE-F1-05. SQ2214.2 +061000 READ-FAIL-F1-05. SQ2214.2 +061100 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2214.2 +061200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +061300 MOVE 120 TO CORRECT-N. SQ2214.2 +061400 PERFORM FAIL. SQ2214.2 +061500 READ-WRITE-F1-05. SQ2214.2 +061600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2214.2 +061700 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2214.2 +061800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +061900 PERFORM PRINT-DETAIL. SQ2214.2 +062000 READ-INIT-F1-06. SQ2214.2 +062100 READ SQ-VS7 RECORD END SQ2214.2 +062200 GO TO READ-TEST-F1-06. SQ2214.2 +062300 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2214.2 +062400 GO TO READ-FAIL-F1-06. SQ2214.2 +062500 READ-EOF-F1-06. SQ2214.2 +062600 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2214.2 +062700 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2214.2 +062800 GO TO READ-FAIL-F1-06. SQ2214.2 +062900 READ-TEST-F1-06. SQ2214.2 +063000 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2214.2 +063100 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2214.2 +063200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2214.2 +063300 GO TO READ-FAIL-F1-06. SQ2214.2 +063400 READ-PASS-F1-06. SQ2214.2 +063500 PERFORM PASS. SQ2214.2 +063600 GO TO READ-WRITE-F1-06. SQ2214.2 +063700 READ-FAIL-F1-06. SQ2214.2 +063800 PERFORM FAIL. SQ2214.2 +063900 READ-WRITE-F1-06. SQ2214.2 +064000 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2214.2 +064100 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2214.2 +064200 PERFORM PRINT-DETAIL. SQ2214.2 +064300 READ-CLOSE-F1-06. SQ2214.2 +064400 CLOSE SQ-VS7. SQ2214.2 +064500 SECT-SQ221A-0002 SECTION. SQ2214.2 +064600* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2214.2 +064700* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2214.2 +064800* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2214.2 +064900* 130 IS UNIQUE FOR EACH RECORD. SQ2214.2 +065000 INFO-INIT-01. SQ2214.2 +065100 OPEN INPUT SQ-VS7. SQ2214.2 +065200 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +065300 INFO-TEST-01. SQ2214.2 +065400 READ SQ-VS7 AT END SQ2214.2 +065500 GO TO INFO-END. SQ2214.2 +065600 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +065700 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2214.2 +065800 GO TO NO-INFO-01. SQ2214.2 +065900 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +066000 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +066100 MOVE 0001 TO CORRECT-18V0. SQ2214.2 +066200 GO TO INFO-WRITE-01. SQ2214.2 +066300 NO-INFO-01. SQ2214.2 +066400 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +066500 INFO-WRITE-01. SQ2214.2 +066600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +066700 MOVE "INFO-TEST-01" TO PAR-NAME. SQ2214.2 +066800 PERFORM PRINT-DETAIL. SQ2214.2 +066900 INFO-INIT-02. SQ2214.2 +067000 READ SQ-VS7 RECORD AT END SQ2214.2 +067100 GO TO INFO-END. SQ2214.2 +067200 READ SQ-VS7 END SQ2214.2 +067300 GO TO INFO-END. SQ2214.2 +067400 INFO-TEST-02. SQ2214.2 +067500 READ SQ-VS7 AT END SQ2214.2 +067600 GO TO INFO-END. SQ2214.2 +067700 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2214.2 +067800 GO TO NO-INFO-02. SQ2214.2 +067900 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +068000 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +068100 MOVE 0004 TO CORRECT-18V0. SQ2214.2 +068200 GO TO INFO-WRITE-02. SQ2214.2 +068300 NO-INFO-02. SQ2214.2 +068400 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +068500 INFO-WRITE-02. SQ2214.2 +068600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +068700 MOVE "INFO-TEST-02" TO PAR-NAME. SQ2214.2 +068800 PERFORM PRINT-DETAIL. SQ2214.2 +068900 INFO-INIT-03. SQ2214.2 +069000 ADD 3 TO COUNT-OF-RECS. SQ2214.2 +069100 INFO-INIT-03-1. SQ2214.2 +069200 READ SQ-VS7 RECORD SQ2214.2 +069300 END GO TO INFO-END. SQ2214.2 +069400 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +069500 IF COUNT-OF-RECS EQUAL TO 450 SQ2214.2 +069600 GO TO INFO-TEST-03. SQ2214.2 +069700 GO TO INFO-INIT-03-1. SQ2214.2 +069800 INFO-TEST-03. SQ2214.2 +069900 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2214.2 +070000 GO TO NO-INFO-03. SQ2214.2 +070100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +070200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +070300 MOVE 0450 TO CORRECT-18V0. SQ2214.2 +070400 GO TO INFO-WRITE-03. SQ2214.2 +070500 NO-INFO-03. SQ2214.2 +070600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +070700 INFO-WRITE-03. SQ2214.2 +070800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +070900 MOVE "INFO-TEST-03" TO PAR-NAME. SQ2214.2 +071000 PERFORM PRINT-DETAIL. SQ2214.2 +071100 INFO-END. SQ2214.2 +071200 CLOSE SQ-VS7. SQ2214.2 +071300 TERMINATE-ROUTINE. SQ2214.2 +071400 EXIT. SQ2214.2 +071500 CCVS-EXIT SECTION. SQ2214.2 +071600 CCVS-999999. SQ2214.2 +071700 GO TO CLOSE-FILES. SQ2214.2 +*END-OF,SQ221A +*HEADER,COBOL,SQ222A +000100 IDENTIFICATION DIVISION. SQ2224.2 +000200 PROGRAM-ID. SQ2224.2 +000300 SQ222A. SQ2224.2 +000400**************************************************************** SQ2224.2 +000500* * SQ2224.2 +000600* VALIDATION FOR:- * SQ2224.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2224.2 +000800* * SQ2224.2 +000900* CREATION DATE / VALIDATION DATE * SQ2224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2224.2 +001100* * SQ2224.2 +001200* THIS ROUTINE CHECKS: SQ2224.2 +001300* SQ2224.2 +001400* RECORD VARYING. SQ2224.2 +001500* SQ2224.2 +001600* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2224.2 +001700* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2224.2 +001800* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2224.2 +001900* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2224.2 +002000* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2224.2 +002100* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2224.2 +002200* AGAINST THE EXPECTED VALUES. SQ2224.2 +002300* SQ2224.2 +002400* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2224.2 +002500* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2224.2 +002600* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2224.2 +002700* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2224.2 +002800* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2224.2 +002900 ENVIRONMENT DIVISION. SQ2224.2 +003000 CONFIGURATION SECTION. SQ2224.2 +003100 SOURCE-COMPUTER. SQ2224.2 +003200 XXXXX082. SQ2224.2 +003300 OBJECT-COMPUTER. SQ2224.2 +003400 XXXXX083. SQ2224.2 +003500 INPUT-OUTPUT SECTION. SQ2224.2 +003600 FILE-CONTROL. SQ2224.2 +003700P SELECT RAW-DATA ASSIGN TO SQ2224.2 +003800P XXXXX062 SQ2224.2 +003900P ORGANIZATION IS INDEXED SQ2224.2 +004000P ACCESS MODE IS RANDOM SQ2224.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ2224.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2224.2 +004300 XXXXX055. SQ2224.2 +004400 SELECT SQ-VS7 ASSIGN TO SQ2224.2 +004500 XXXXX014 SQ2224.2 +004600 ORGANIZATION SEQUENTIAL SQ2224.2 +004700 ACCESS SEQUENTIAL. SQ2224.2 +004800 DATA DIVISION. SQ2224.2 +004900 FILE SECTION. SQ2224.2 +005000P SQ2224.2 +005100PFD RAW-DATA. SQ2224.2 +005200P SQ2224.2 +005300P01 RAW-DATA-SATZ. SQ2224.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ2224.2 +005500P 05 C-DATE PIC 9(6). SQ2224.2 +005600P 05 C-TIME PIC 9(8). SQ2224.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ2224.2 +005800P 05 C-OK PIC 999. SQ2224.2 +005900P 05 C-ALL PIC 999. SQ2224.2 +006000P 05 C-FAIL PIC 999. SQ2224.2 +006100P 05 C-DELETED PIC 999. SQ2224.2 +006200P 05 C-INSPECT PIC 999. SQ2224.2 +006300P 05 C-NOTE PIC X(13). SQ2224.2 +006400P 05 C-INDENT PIC X. SQ2224.2 +006500P 05 C-ABORT PIC X(8). SQ2224.2 +006600 FD PRINT-FILE SQ2224.2 +006700C LABEL RECORDS SQ2224.2 +006800C XXXXX084 SQ2224.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2224.2 +007000 . SQ2224.2 +007100 01 PRINT-REC PICTURE X(120). SQ2224.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2224.2 +007300 FD SQ-VS7 SQ2224.2 +007400C LABEL RECORDS ARE STANDARD SQ2224.2 +007500 RECORD VARYING. SQ2224.2 +007600 01 SQ-VS7R1-M-G-120. SQ2224.2 +007700 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2224.2 +007800 01 SQ-VS7R2-M-G-151. SQ2224.2 +007900 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2224.2 +008000 02 LONG-OR-SHORT PICTURE X(5). SQ2224.2 +008100 02 SQ-VS7-RECNO PICTURE X(5). SQ2224.2 +008200 02 SQ-VS7-FILLER PICTURE X(21). SQ2224.2 +008300 WORKING-STORAGE SECTION. SQ2224.2 +008400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2224.2 +008500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2224.2 +008600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2224.2 +008700 01 ERROR-FLAG PICTURE 9. SQ2224.2 +008800 01 EOF-FLAG PICTURE 9. SQ2224.2 +008900 01 DUMP-AREA. SQ2224.2 +009000 02 TYPE-OF-REC PICTURE X(5). SQ2224.2 +009100 02 RECNO PICTURE 9(5). SQ2224.2 +009200 02 REC-FILLER PICTURE X(21). SQ2224.2 +009300 01 FILE-RECORD-INFORMATION-REC. SQ2224.2 +009400 03 FILE-RECORD-INFO-SKELETON. SQ2224.2 +009500 05 FILLER PICTURE X(48) VALUE SQ2224.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2224.2 +009700 05 FILLER PICTURE X(46) VALUE SQ2224.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2224.2 +009900 05 FILLER PICTURE X(26) VALUE SQ2224.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". SQ2224.2 +010100 05 FILLER PICTURE X(37) VALUE SQ2224.2 +010200 ",RECKEY= ". SQ2224.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2224.2 +010400 ",ALTKEY1= ". SQ2224.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2224.2 +010600 ",ALTKEY2= ". SQ2224.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.SQ2224.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2224.2 +010900 05 FILE-RECORD-INFO-P1-120. SQ2224.2 +011000 07 FILLER PIC X(5). SQ2224.2 +011100 07 XFILE-NAME PIC X(6). SQ2224.2 +011200 07 FILLER PIC X(8). SQ2224.2 +011300 07 XRECORD-NAME PIC X(6). SQ2224.2 +011400 07 FILLER PIC X(1). SQ2224.2 +011500 07 REELUNIT-NUMBER PIC 9(1). SQ2224.2 +011600 07 FILLER PIC X(7). SQ2224.2 +011700 07 XRECORD-NUMBER PIC 9(6). SQ2224.2 +011800 07 FILLER PIC X(6). SQ2224.2 +011900 07 UPDATE-NUMBER PIC 9(2). SQ2224.2 +012000 07 FILLER PIC X(5). SQ2224.2 +012100 07 ODO-NUMBER PIC 9(4). SQ2224.2 +012200 07 FILLER PIC X(5). SQ2224.2 +012300 07 XPROGRAM-NAME PIC X(5). SQ2224.2 +012400 07 FILLER PIC X(7). SQ2224.2 +012500 07 XRECORD-LENGTH PIC 9(6). SQ2224.2 +012600 07 FILLER PIC X(7). SQ2224.2 +012700 07 CHARS-OR-RECORDS PIC X(2). SQ2224.2 +012800 07 FILLER PIC X(1). SQ2224.2 +012900 07 XBLOCK-SIZE PIC 9(4). SQ2224.2 +013000 07 FILLER PIC X(6). SQ2224.2 +013100 07 RECORDS-IN-FILE PIC 9(6). SQ2224.2 +013200 07 FILLER PIC X(5). SQ2224.2 +013300 07 XFILE-ORGANIZATION PIC X(2). SQ2224.2 +013400 07 FILLER PIC X(6). SQ2224.2 +013500 07 XLABEL-TYPE PIC X(1). SQ2224.2 +013600 05 FILE-RECORD-INFO-P121-240. SQ2224.2 +013700 07 FILLER PIC X(8). SQ2224.2 +013800 07 XRECORD-KEY PIC X(29). SQ2224.2 +013900 07 FILLER PIC X(9). SQ2224.2 +014000 07 ALTERNATE-KEY1 PIC X(29). SQ2224.2 +014100 07 FILLER PIC X(9). SQ2224.2 +014200 07 ALTERNATE-KEY2 PIC X(29). SQ2224.2 +014300 07 FILLER PIC X(7). SQ2224.2 +014400 01 TEST-RESULTS. SQ2224.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +014600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2224.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +014800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2224.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +015000 02 PAR-NAME. SQ2224.2 +015100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2224.2 +015200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2224.2 +015300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2224.2 +015400 03 FILLER PIC X(5) VALUE SPACE. SQ2224.2 +015500 02 FILLER PIC X(10) VALUE SPACE. SQ2224.2 +015600 02 RE-MARK PIC X(61). SQ2224.2 +015700 01 TEST-COMPUTED. SQ2224.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2224.2 +015900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2224.2 +016000 02 COMPUTED-X. SQ2224.2 +016100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2224.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2224.2 +016300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2224.2 +016400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2224.2 +016500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2224.2 +016600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2224.2 +016700 04 COMPUTED-18V0 PICTURE -9(18). SQ2224.2 +016800 04 FILLER PICTURE X. SQ2224.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2224.2 +017000 01 TEST-CORRECT. SQ2224.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2224.2 +017200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2224.2 +017300 02 CORRECT-X. SQ2224.2 +017400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2224.2 +017500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2224.2 +017600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2224.2 +017700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2224.2 +017800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2224.2 +017900 03 CR-18V0 REDEFINES CORRECT-A. SQ2224.2 +018000 04 CORRECT-18V0 PICTURE -9(18). SQ2224.2 +018100 04 FILLER PICTURE X. SQ2224.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2224.2 +018300 01 CCVS-C-1. SQ2224.2 +018400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2224.2 +018500- "SS PARAGRAPH-NAME SQ2224.2 +018600- " REMARKS". SQ2224.2 +018700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2224.2 +018800 01 CCVS-C-2. SQ2224.2 +018900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +019000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2224.2 +019100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2224.2 +019200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2224.2 +019300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2224.2 +019400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2224.2 +019500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2224.2 +019600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2224.2 +019700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2224.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2224.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2224.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2224.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2224.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2224.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2224.2 +020400 01 CCVS-H-1. SQ2224.2 +020500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2224.2 +020600 02 FILLER PICTURE X(67) VALUE SQ2224.2 +020700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2224.2 +020800- " SYSTEM". SQ2224.2 +020900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2224.2 +021000 01 CCVS-H-2. SQ2224.2 +021100 02 FILLER PICTURE X(52) VALUE IS SQ2224.2 +021200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2224.2 +021300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2224.2 +021400 02 TEST-ID PICTURE IS X(9). SQ2224.2 +021500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2224.2 +021600 01 CCVS-H-3. SQ2224.2 +021700 02 FILLER PICTURE X(34) VALUE SQ2224.2 +021800 " FOR OFFICIAL USE ONLY ". SQ2224.2 +021900 02 FILLER PICTURE X(58) VALUE SQ2224.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2224.2 +022100 02 FILLER PICTURE X(28) VALUE SQ2224.2 +022200 " COPYRIGHT 1985 ". SQ2224.2 +022300 01 CCVS-E-1. SQ2224.2 +022400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2224.2 +022500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2224.2 +022600 02 ID-AGAIN PICTURE IS X(9). SQ2224.2 +022700 02 FILLER PICTURE X(45) VALUE IS SQ2224.2 +022800 " NTIS DISTRIBUTION COBOL 85". SQ2224.2 +022900 01 CCVS-E-2. SQ2224.2 +023000 02 FILLER PICTURE X(31) VALUE SQ2224.2 +023100 SPACE. SQ2224.2 +023200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2224.2 +023300 02 CCVS-E-2-2. SQ2224.2 +023400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2224.2 +023500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +023600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2224.2 +023700 01 CCVS-E-3. SQ2224.2 +023800 02 FILLER PICTURE X(22) VALUE SQ2224.2 +023900 " FOR OFFICIAL USE ONLY". SQ2224.2 +024000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2224.2 +024100 02 FILLER PICTURE X(58) VALUE SQ2224.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2224.2 +024300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2224.2 +024400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2224.2 +024500 01 CCVS-E-4. SQ2224.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2224.2 +024700 02 FILLER PIC XXXX VALUE " OF ". SQ2224.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2224.2 +024900 02 FILLER PIC X(40) VALUE SQ2224.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2224.2 +025100 01 XXINFO. SQ2224.2 +025200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2224.2 +025300 02 INFO-TEXT. SQ2224.2 +025400 04 FILLER PIC X(20) VALUE SPACE. SQ2224.2 +025500 04 XXCOMPUTED PIC X(20). SQ2224.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ2224.2 +025700 04 XXCORRECT PIC X(20). SQ2224.2 +025800 01 HYPHEN-LINE. SQ2224.2 +025900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +026000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2224.2 +026100- "*****************************************". SQ2224.2 +026200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2224.2 +026300- "******************************". SQ2224.2 +026400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2224.2 +026500 "SQ222A". SQ2224.2 +026600 PROCEDURE DIVISION. SQ2224.2 +026700 CCVS1 SECTION. SQ2224.2 +026800 OPEN-FILES. SQ2224.2 +026900P OPEN I-O RAW-DATA. SQ2224.2 +027000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2224.2 +027100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2224.2 +027200P MOVE "ABORTED " TO C-ABORT. SQ2224.2 +027300P ADD 1 TO C-NO-OF-TESTS. SQ2224.2 +027400P ACCEPT C-DATE FROM DATE. SQ2224.2 +027500P ACCEPT C-TIME FROM TIME. SQ2224.2 +027600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2224.2 +027700PEND-E-1. SQ2224.2 +027800P CLOSE RAW-DATA. SQ2224.2 +027900 OPEN OUTPUT PRINT-FILE. SQ2224.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2224.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2224.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2224.2 +028300 MOVE ZERO TO REC-SKL-SUB. SQ2224.2 +028400 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2224.2 +028500 CCVS-INIT-FILE. SQ2224.2 +028600 ADD 1 TO REC-SKL-SUB. SQ2224.2 +028700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2224.2 +028800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2224.2 +028900 CCVS-INIT-EXIT. SQ2224.2 +029000 GO TO CCVS1-EXIT. SQ2224.2 +029100 CLOSE-FILES. SQ2224.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2224.2 +029300P OPEN I-O RAW-DATA. SQ2224.2 +029400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2224.2 +029500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2224.2 +029600P MOVE "OK. " TO C-ABORT. SQ2224.2 +029700P MOVE PASS-COUNTER TO C-OK. SQ2224.2 +029800P MOVE ERROR-HOLD TO C-ALL. SQ2224.2 +029900P MOVE ERROR-COUNTER TO C-FAIL. SQ2224.2 +030000P MOVE DELETE-CNT TO C-DELETED. SQ2224.2 +030100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2224.2 +030200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2224.2 +030300PEND-E-2. SQ2224.2 +030400P CLOSE RAW-DATA. SQ2224.2 +030500 TERMINATE-CCVS. SQ2224.2 +030600S EXIT PROGRAM. SQ2224.2 +030700STERMINATE-CALL. SQ2224.2 +030800 STOP RUN. SQ2224.2 +030900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2224.2 +031000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2224.2 +031100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2224.2 +031200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2224.2 +031300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2224.2 +031400 PRINT-DETAIL. SQ2224.2 +031500 IF REC-CT NOT EQUAL TO ZERO SQ2224.2 +031600 MOVE "." TO PARDOT-X SQ2224.2 +031700 MOVE REC-CT TO DOTVALUE. SQ2224.2 +031800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2224.2 +031900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2224.2 +032000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2224.2 +032100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2224.2 +032200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2224.2 +032300 MOVE SPACE TO CORRECT-X. SQ2224.2 +032400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2224.2 +032500 MOVE SPACE TO RE-MARK. SQ2224.2 +032600 HEAD-ROUTINE. SQ2224.2 +032700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +032800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2224.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2224.2 +033000 COLUMN-NAMES-ROUTINE. SQ2224.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +033400 END-ROUTINE. SQ2224.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2224.2 +033600 END-RTN-EXIT. SQ2224.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +033800 END-ROUTINE-1. SQ2224.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2224.2 +034000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2224.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SQ2224.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2224.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2224.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2224.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2224.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2224.2 +034700 END-ROUTINE-12. SQ2224.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2224.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2224.2 +035000 MOVE "NO " TO ERROR-TOTAL SQ2224.2 +035100 ELSE SQ2224.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2224.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2224.2 +035400 PERFORM WRITE-LINE. SQ2224.2 +035500 END-ROUTINE-13. SQ2224.2 +035600 IF DELETE-CNT IS EQUAL TO ZERO SQ2224.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SQ2224.2 +035800 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2224.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2224.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2224.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ2224.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2224.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2224.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036700 WRITE-LINE. SQ2224.2 +036800 ADD 1 TO RECORD-COUNT. SQ2224.2 +036900Y IF RECORD-COUNT GREATER 50 SQ2224.2 +037000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2224.2 +037100Y MOVE SPACE TO DUMMY-RECORD SQ2224.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2224.2 +037300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2224.2 +037400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2224.2 +037500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2224.2 +037600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2224.2 +037700Y MOVE ZERO TO RECORD-COUNT. SQ2224.2 +037800 PERFORM WRT-LN. SQ2224.2 +037900 WRT-LN. SQ2224.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2224.2 +038100 MOVE SPACE TO DUMMY-RECORD. SQ2224.2 +038200 BLANK-LINE-PRINT. SQ2224.2 +038300 PERFORM WRT-LN. SQ2224.2 +038400 FAIL-ROUTINE. SQ2224.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2224.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2224.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2224.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +038900 GO TO FAIL-ROUTINE-EX. SQ2224.2 +039000 FAIL-ROUTINE-WRITE. SQ2224.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2224.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +039300 FAIL-ROUTINE-EX. EXIT. SQ2224.2 +039400 BAIL-OUT. SQ2224.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2224.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2224.2 +039700 BAIL-OUT-WRITE. SQ2224.2 +039800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2224.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +040000 BAIL-OUT-EX. EXIT. SQ2224.2 +040100 CCVS1-EXIT. SQ2224.2 +040200 EXIT. SQ2224.2 +040300 SECT-SQ222A-0001 SECTION. SQ2224.2 +040400 WRITE-INIT-GF-01. SQ2224.2 +040500 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2224.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2224.2 +040700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2224.2 +040800 MOVE 0001 TO XBLOCK-SIZE (1). SQ2224.2 +040900 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2224.2 +041000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2224.2 +041100 MOVE "S" TO XLABEL-TYPE (1). SQ2224.2 +041200 MOVE 000000 TO XRECORD-NUMBER (1). SQ2224.2 +041300 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +041400 OPEN OUTPUT SQ-VS7. SQ2224.2 +041500 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2224.2 +041600 WRITE-TEST-GF-01. SQ2224.2 +041700 PERFORM WRITE-SHORT-REC. SQ2224.2 +041800 PERFORM WRITE-LONG-REC. SQ2224.2 +041900 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2224.2 +042000 PERFORM WRITE-LONG-REC 100 TIMES. SQ2224.2 +042100 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2224.2 +042200 WRITE-WRITE-GF-01. SQ2224.2 +042300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2224.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2224.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2224.2 +042600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2224.2 +042700 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2224.2 +042800 PERFORM PRINT-DETAIL. SQ2224.2 +042900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2224.2 +043000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2224.2 +043100* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2224.2 +043200* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2224.2 +043300* 100L-338S. SQ2224.2 +043400 WRITE-CLOSE-GF-01. SQ2224.2 +043500 CLOSE SQ-VS7. SQ2224.2 +043600 GO TO READ-INIT-F1-01. SQ2224.2 +043700 WRITE-SHORT-REC. SQ2224.2 +043800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2224.2 +043900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2224.2 +044000 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +044100 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2224.2 +044200 MOVE "SHORT" TO LONG-OR-SHORT. SQ2224.2 +044300 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2224.2 +044400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2224.2 +044500 WRITE SQ-VS7R1-M-G-120. SQ2224.2 +044600 WRITE-LONG-REC. SQ2224.2 +044700 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2224.2 +044800 MOVE 000151 TO XRECORD-LENGTH (1). SQ2224.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +045000 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2224.2 +045100 MOVE "LONG" TO LONG-OR-SHORT. SQ2224.2 +045200 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2224.2 +045300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2224.2 +045400 WRITE SQ-VS7R2-M-G-151. SQ2224.2 +045500 READ-INIT-F1-01. SQ2224.2 +045600 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +045700 MOVE ZERO TO EOF-FLAG. SQ2224.2 +045800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2224.2 +045900 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +046000 OPEN INPUT SQ-VS7. SQ2224.2 +046100 READ-TEST-F1-01. SQ2224.2 +046200 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2224.2 +046300 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +046400 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2224.2 +046500 GO TO READ-EOF-F1-06. SQ2224.2 +046600 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +046700 GO TO READ-FAIL-F1-01. SQ2224.2 +046800 READ-PASS-F1-01. SQ2224.2 +046900 PERFORM PASS. SQ2224.2 +047000 GO TO READ-WRITE-F1-01. SQ2224.2 +047100 READ-FAIL-F1-01. SQ2224.2 +047200 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +047300 PERFORM FAIL. SQ2224.2 +047400 READ-WRITE-F1-01. SQ2224.2 +047500 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +047600 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2224.2 +047700 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +047800 PERFORM PRINT-DETAIL. SQ2224.2 +047900 GO TO READ-INIT-F1-02. SQ2224.2 +048000 READ-SHORT-REC. SQ2224.2 +048100 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +048200 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +048300 READ SQ-VS7 AT END SQ2224.2 +048400 MOVE 1 TO EOF-FLAG SQ2224.2 +048500 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +048600 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +048700 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2224.2 +048800 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2224.2 +048900 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049000 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2224.2 +049100 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049200 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2224.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049400 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2224.2 +049500 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +049600 READ-SHORT-REC-ERROR. SQ2224.2 +049700 ADD 1 TO RECORDS-IN-ERROR. SQ2224.2 +049800 MOVE 1 TO ERROR-FLAG. SQ2224.2 +049900 READ-SHORT-REC-EXIT. SQ2224.2 +050000 EXIT. SQ2224.2 +050100 READ-INIT-F1-02. SQ2224.2 +050200 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +050300 READ-TEST-F1-02. SQ2224.2 +050400 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2224.2 +050500 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +050600 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2224.2 +050700 GO TO READ-EOF-F1-06. SQ2224.2 +050800 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +050900 GO TO READ-FAIL-F1-02. SQ2224.2 +051000 READ-PASS-F1-02. SQ2224.2 +051100 PERFORM PASS. SQ2224.2 +051200 GO TO READ-WRITE-F1-02. SQ2224.2 +051300 READ-FAIL-F1-02. SQ2224.2 +051400 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +051500 PERFORM FAIL. SQ2224.2 +051600 READ-WRITE-F1-02. SQ2224.2 +051700 MOVE "READ LONG RECORD" TO FEATURE. SQ2224.2 +051800 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2224.2 +051900 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2224.2 +052000 PERFORM PRINT-DETAIL. SQ2224.2 +052100 GO TO READ-INIT-F1-03. SQ2224.2 +052200 READ-LONG-REC. SQ2224.2 +052300 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +052400 GO TO READ-LONG-REC-EXIT. SQ2224.2 +052500 READ SQ-VS7 END SQ2224.2 +052600 MOVE 1 TO EOF-FLAG SQ2224.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2224.2 +052800 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +052900 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2224.2 +053000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2224.2 +053100 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2224.2 +053300 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2224.2 +053500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2224.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2224.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2224.2 +053900 READ-LONG-REC-ERROR. SQ2224.2 +054000 ADD 1 TO RECORDS-IN-ERROR. SQ2224.2 +054100 MOVE 1 TO ERROR-FLAG. SQ2224.2 +054200 READ-LONG-REC-EXIT. SQ2224.2 +054300 EXIT. SQ2224.2 +054400 READ-INIT-F1-03. SQ2224.2 +054500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +054600 READ-TEST-F1-03. SQ2224.2 +054700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2224.2 +054800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +054900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +055000 GO TO READ-EOF-F1-06. SQ2224.2 +055100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +055200 GO TO READ-FAIL-F1-03. SQ2224.2 +055300 READ-PASS-F1-03. SQ2224.2 +055400 PERFORM PASS. SQ2224.2 +055500 GO TO READ-WRITE-F1-03. SQ2224.2 +055600 READ-FAIL-F1-03. SQ2224.2 +055700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +055800 PERFORM FAIL. SQ2224.2 +055900 READ-WRITE-F1-03. SQ2224.2 +056000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2224.2 +056100 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2224.2 +056200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +056300 PERFORM PRINT-DETAIL. SQ2224.2 +056400 READ-INIT-F1-04. SQ2224.2 +056500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +056600 READ-TEST-F1-04. SQ2224.2 +056700 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2224.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +056900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +057000 GO TO READ-EOF-F1-06. SQ2224.2 +057100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +057200 GO TO READ-FAIL-F1-04. SQ2224.2 +057300 READ-PASS-F1-04. SQ2224.2 +057400 PERFORM PASS. SQ2224.2 +057500 GO TO READ-WRITE-F1-04. SQ2224.2 +057600 READ-FAIL-F1-04. SQ2224.2 +057700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +057800 PERFORM FAIL. SQ2224.2 +057900 READ-WRITE-F1-04. SQ2224.2 +058000 MOVE "READ LONG RECORDS" TO FEATURE. SQ2224.2 +058100 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2224.2 +058200 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2224.2 +058300 PERFORM PRINT-DETAIL. SQ2224.2 +058400 READ-INIT-F1-05. SQ2224.2 +058500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +058600 READ-TEST-F1-05. SQ2224.2 +058700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2224.2 +058800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +058900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +059000 GO TO READ-EOF-F1-06. SQ2224.2 +059100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +059200 GO TO READ-FAIL-F1-05. SQ2224.2 +059300 READ-PASS-F1-05. SQ2224.2 +059400 PERFORM PASS. SQ2224.2 +059500 GO TO READ-WRITE-F1-05. SQ2224.2 +059600 READ-FAIL-F1-05. SQ2224.2 +059700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +059800 PERFORM FAIL. SQ2224.2 +059900 READ-WRITE-F1-05. SQ2224.2 +060000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2224.2 +060100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2224.2 +060200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +060300 PERFORM PRINT-DETAIL. SQ2224.2 +060400 READ-INIT-F1-06. SQ2224.2 +060500 READ SQ-VS7 RECORD END SQ2224.2 +060600 GO TO READ-TEST-F1-06. SQ2224.2 +060700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2224.2 +060800 GO TO READ-FAIL-F1-06. SQ2224.2 +060900 READ-EOF-F1-06. SQ2224.2 +061000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2224.2 +061100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2224.2 +061200 GO TO READ-FAIL-F1-06. SQ2224.2 +061300 READ-TEST-F1-06. SQ2224.2 +061400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2224.2 +061500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2224.2 +061600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2224.2 +061700 GO TO READ-FAIL-F1-06. SQ2224.2 +061800 READ-PASS-F1-06. SQ2224.2 +061900 PERFORM PASS. SQ2224.2 +062000 GO TO READ-WRITE-F1-06. SQ2224.2 +062100 READ-FAIL-F1-06. SQ2224.2 +062200 PERFORM FAIL. SQ2224.2 +062300 READ-WRITE-F1-06. SQ2224.2 +062400 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2224.2 +062500 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2224.2 +062600 PERFORM PRINT-DETAIL. SQ2224.2 +062700 READ-CLOSE-F1-06. SQ2224.2 +062800 CLOSE SQ-VS7. SQ2224.2 +062900 SECT-SQ222A-0002 SECTION. SQ2224.2 +063000* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2224.2 +063100* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2224.2 +063200* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2224.2 +063300* 130 IS UNIQUE FOR EACH RECORD. SQ2224.2 +063400 INFO-INIT-01. SQ2224.2 +063500 OPEN INPUT SQ-VS7. SQ2224.2 +063600 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +063700 INFO-TEST-01. SQ2224.2 +063800 READ SQ-VS7 AT END SQ2224.2 +063900 GO TO INFO-END. SQ2224.2 +064000 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +064100 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2224.2 +064200 GO TO NO-INFO-01. SQ2224.2 +064300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +064400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +064500 MOVE 0001 TO CORRECT-18V0. SQ2224.2 +064600 GO TO INFO-WRITE-01. SQ2224.2 +064700 NO-INFO-01. SQ2224.2 +064800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +064900 INFO-WRITE-01. SQ2224.2 +065000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +065100 MOVE "SEQ-INFO-01 " TO PAR-NAME. SQ2224.2 +065200 PERFORM PRINT-DETAIL. SQ2224.2 +065300 INFO-INIT-02. SQ2224.2 +065400 READ SQ-VS7 RECORD AT END SQ2224.2 +065500 GO TO INFO-END. SQ2224.2 +065600 READ SQ-VS7 END SQ2224.2 +065700 GO TO INFO-END. SQ2224.2 +065800 INFO-TEST-02. SQ2224.2 +065900 READ SQ-VS7 AT END SQ2224.2 +066000 GO TO INFO-END. SQ2224.2 +066100 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2224.2 +066200 GO TO NO-INFO-02. SQ2224.2 +066300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +066400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +066500 MOVE 0004 TO CORRECT-18V0. SQ2224.2 +066600 GO TO INFO-WRITE-02. SQ2224.2 +066700 NO-INFO-02. SQ2224.2 +066800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +066900 INFO-WRITE-02. SQ2224.2 +067000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +067100 MOVE "SEQ-INFO-02 " TO PAR-NAME. SQ2224.2 +067200 PERFORM PRINT-DETAIL. SQ2224.2 +067300 INFO-INIT-03. SQ2224.2 +067400 ADD 3 TO COUNT-OF-RECS. SQ2224.2 +067500 INFO-INIT-03-1. SQ2224.2 +067600 READ SQ-VS7 RECORD SQ2224.2 +067700 END GO TO INFO-END. SQ2224.2 +067800 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +067900 IF COUNT-OF-RECS EQUAL TO 450 SQ2224.2 +068000 GO TO INFO-TEST-03. SQ2224.2 +068100 GO TO INFO-INIT-03-1. SQ2224.2 +068200 INFO-TEST-03. SQ2224.2 +068300 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2224.2 +068400 GO TO NO-INFO-03. SQ2224.2 +068500 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +068600 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +068700 MOVE 0450 TO CORRECT-18V0. SQ2224.2 +068800 GO TO INFO-WRITE-03. SQ2224.2 +068900 NO-INFO-03. SQ2224.2 +069000 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +069100 INFO-WRITE-03. SQ2224.2 +069200 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +069300 MOVE "SEQ-INFO-03 " TO PAR-NAME. SQ2224.2 +069400 PERFORM PRINT-DETAIL. SQ2224.2 +069500 INFO-END. SQ2224.2 +069600 CLOSE SQ-VS7. SQ2224.2 +069700 TERMINATE-ROUTINE. SQ2224.2 +069800 EXIT. SQ2224.2 +069900 CCVS-EXIT SECTION. SQ2224.2 +070000 CCVS-999999. SQ2224.2 +070100 GO TO CLOSE-FILES. SQ2224.2 +*END-OF,SQ222A +*HEADER,COBOL,SQ223A +000100 IDENTIFICATION DIVISION. SQ2234.2 +000200 PROGRAM-ID. SQ2234.2 +000300 SQ223A. SQ2234.2 +000400**************************************************************** SQ2234.2 +000500* * SQ2234.2 +000600* VALIDATION FOR:- * SQ2234.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2234.2 +000800* * SQ2234.2 +000900* CREATION DATE / VALIDATION DATE * SQ2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2234.2 +001100* * SQ2234.2 +001200* THIS ROUTINE CHECKS: SQ2234.2 +001300* SQ2234.2 +001400* RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS. SQ2234.2 +001500* SQ2234.2 +001600* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2234.2 +001700* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2234.2 +001800* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2234.2 +001900* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2234.2 +002000* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2234.2 +002100* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2234.2 +002200* AGAINST THE EXPECTED VALUES. SQ2234.2 +002300* SQ2234.2 +002400* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2234.2 +002500* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2234.2 +002600* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2234.2 +002700* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2234.2 +002800* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2234.2 +002900 ENVIRONMENT DIVISION. SQ2234.2 +003000 CONFIGURATION SECTION. SQ2234.2 +003100 SOURCE-COMPUTER. SQ2234.2 +003200 XXXXX082. SQ2234.2 +003300 OBJECT-COMPUTER. SQ2234.2 +003400 XXXXX083. SQ2234.2 +003500 INPUT-OUTPUT SECTION. SQ2234.2 +003600 FILE-CONTROL. SQ2234.2 +003700P SELECT RAW-DATA ASSIGN TO SQ2234.2 +003800P XXXXX062 SQ2234.2 +003900P ORGANIZATION IS INDEXED SQ2234.2 +004000P ACCESS MODE IS RANDOM SQ2234.2 +004100P RECORD KEY IS RAW-DATA-KEY. SQ2234.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2234.2 +004300 XXXXX055. SQ2234.2 +004400 SELECT SQ-VS7 ASSIGN TO SQ2234.2 +004500 XXXXX014 SQ2234.2 +004600 ORGANIZATION SEQUENTIAL SQ2234.2 +004700 ACCESS SEQUENTIAL. SQ2234.2 +004800 DATA DIVISION. SQ2234.2 +004900 FILE SECTION. SQ2234.2 +005000P SQ2234.2 +005100PFD RAW-DATA. SQ2234.2 +005200P SQ2234.2 +005300P01 RAW-DATA-SATZ. SQ2234.2 +005400P 05 RAW-DATA-KEY PIC X(6). SQ2234.2 +005500P 05 C-DATE PIC 9(6). SQ2234.2 +005600P 05 C-TIME PIC 9(8). SQ2234.2 +005700P 05 C-NO-OF-TESTS PIC 99. SQ2234.2 +005800P 05 C-OK PIC 999. SQ2234.2 +005900P 05 C-ALL PIC 999. SQ2234.2 +006000P 05 C-FAIL PIC 999. SQ2234.2 +006100P 05 C-DELETED PIC 999. SQ2234.2 +006200P 05 C-INSPECT PIC 999. SQ2234.2 +006300P 05 C-NOTE PIC X(13). SQ2234.2 +006400P 05 C-INDENT PIC X. SQ2234.2 +006500P 05 C-ABORT PIC X(8). SQ2234.2 +006600 FD PRINT-FILE SQ2234.2 +006700C LABEL RECORDS SQ2234.2 +006800C XXXXX084 SQ2234.2 +006900C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2234.2 +007000 . SQ2234.2 +007100 01 PRINT-REC PICTURE X(120). SQ2234.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2234.2 +007300 FD SQ-VS7 SQ2234.2 +007400C LABEL RECORDS ARE STANDARD SQ2234.2 +007500 RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS. SQ2234.2 +007600 01 SQ-VS7R1-M-G-120. SQ2234.2 +007700 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2234.2 +007800 01 SQ-VS7R2-M-G-151. SQ2234.2 +007900 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2234.2 +008000 02 LONG-OR-SHORT PICTURE X(5). SQ2234.2 +008100 02 SQ-VS7-RECNO PICTURE X(5). SQ2234.2 +008200 02 SQ-VS7-FILLER PICTURE X(21). SQ2234.2 +008300 WORKING-STORAGE SECTION. SQ2234.2 +008400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2234.2 +008500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2234.2 +008600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2234.2 +008700 01 ERROR-FLAG PICTURE 9. SQ2234.2 +008800 01 EOF-FLAG PICTURE 9. SQ2234.2 +008900 01 DUMP-AREA. SQ2234.2 +009000 02 TYPE-OF-REC PICTURE X(5). SQ2234.2 +009100 02 RECNO PICTURE 9(5). SQ2234.2 +009200 02 REC-FILLER PICTURE X(21). SQ2234.2 +009300 01 FILE-RECORD-INFORMATION-REC. SQ2234.2 +009400 03 FILE-RECORD-INFO-SKELETON. SQ2234.2 +009500 05 FILLER PICTURE X(48) VALUE SQ2234.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2234.2 +009700 05 FILLER PICTURE X(46) VALUE SQ2234.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2234.2 +009900 05 FILLER PICTURE X(26) VALUE SQ2234.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". SQ2234.2 +010100 05 FILLER PICTURE X(37) VALUE SQ2234.2 +010200 ",RECKEY= ". SQ2234.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2234.2 +010400 ",ALTKEY1= ". SQ2234.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2234.2 +010600 ",ALTKEY2= ". SQ2234.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.SQ2234.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2234.2 +010900 05 FILE-RECORD-INFO-P1-120. SQ2234.2 +011000 07 FILLER PIC X(5). SQ2234.2 +011100 07 XFILE-NAME PIC X(6). SQ2234.2 +011200 07 FILLER PIC X(8). SQ2234.2 +011300 07 XRECORD-NAME PIC X(6). SQ2234.2 +011400 07 FILLER PIC X(1). SQ2234.2 +011500 07 REELUNIT-NUMBER PIC 9(1). SQ2234.2 +011600 07 FILLER PIC X(7). SQ2234.2 +011700 07 XRECORD-NUMBER PIC 9(6). SQ2234.2 +011800 07 FILLER PIC X(6). SQ2234.2 +011900 07 UPDATE-NUMBER PIC 9(2). SQ2234.2 +012000 07 FILLER PIC X(5). SQ2234.2 +012100 07 ODO-NUMBER PIC 9(4). SQ2234.2 +012200 07 FILLER PIC X(5). SQ2234.2 +012300 07 XPROGRAM-NAME PIC X(5). SQ2234.2 +012400 07 FILLER PIC X(7). SQ2234.2 +012500 07 XRECORD-LENGTH PIC 9(6). SQ2234.2 +012600 07 FILLER PIC X(7). SQ2234.2 +012700 07 CHARS-OR-RECORDS PIC X(2). SQ2234.2 +012800 07 FILLER PIC X(1). SQ2234.2 +012900 07 XBLOCK-SIZE PIC 9(4). SQ2234.2 +013000 07 FILLER PIC X(6). SQ2234.2 +013100 07 RECORDS-IN-FILE PIC 9(6). SQ2234.2 +013200 07 FILLER PIC X(5). SQ2234.2 +013300 07 XFILE-ORGANIZATION PIC X(2). SQ2234.2 +013400 07 FILLER PIC X(6). SQ2234.2 +013500 07 XLABEL-TYPE PIC X(1). SQ2234.2 +013600 05 FILE-RECORD-INFO-P121-240. SQ2234.2 +013700 07 FILLER PIC X(8). SQ2234.2 +013800 07 XRECORD-KEY PIC X(29). SQ2234.2 +013900 07 FILLER PIC X(9). SQ2234.2 +014000 07 ALTERNATE-KEY1 PIC X(29). SQ2234.2 +014100 07 FILLER PIC X(9). SQ2234.2 +014200 07 ALTERNATE-KEY2 PIC X(29). SQ2234.2 +014300 07 FILLER PIC X(7). SQ2234.2 +014400 01 TEST-RESULTS. SQ2234.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +014600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2234.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +014800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2234.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +015000 02 PAR-NAME. SQ2234.2 +015100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2234.2 +015200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2234.2 +015300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2234.2 +015400 03 FILLER PIC X(5) VALUE SPACE. SQ2234.2 +015500 02 FILLER PIC X(10) VALUE SPACE. SQ2234.2 +015600 02 RE-MARK PIC X(61). SQ2234.2 +015700 01 TEST-COMPUTED. SQ2234.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2234.2 +015900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2234.2 +016000 02 COMPUTED-X. SQ2234.2 +016100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2234.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2234.2 +016300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2234.2 +016400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2234.2 +016500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2234.2 +016600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2234.2 +016700 04 COMPUTED-18V0 PICTURE -9(18). SQ2234.2 +016800 04 FILLER PICTURE X. SQ2234.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2234.2 +017000 01 TEST-CORRECT. SQ2234.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2234.2 +017200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2234.2 +017300 02 CORRECT-X. SQ2234.2 +017400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2234.2 +017500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2234.2 +017600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2234.2 +017700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2234.2 +017800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2234.2 +017900 03 CR-18V0 REDEFINES CORRECT-A. SQ2234.2 +018000 04 CORRECT-18V0 PICTURE -9(18). SQ2234.2 +018100 04 FILLER PICTURE X. SQ2234.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2234.2 +018300 01 CCVS-C-1. SQ2234.2 +018400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2234.2 +018500- "SS PARAGRAPH-NAME SQ2234.2 +018600- " REMARKS". SQ2234.2 +018700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2234.2 +018800 01 CCVS-C-2. SQ2234.2 +018900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +019000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2234.2 +019100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2234.2 +019200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2234.2 +019300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2234.2 +019400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2234.2 +019500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2234.2 +019600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2234.2 +019700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2234.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2234.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2234.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2234.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2234.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2234.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2234.2 +020400 01 CCVS-H-1. SQ2234.2 +020500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2234.2 +020600 02 FILLER PICTURE X(67) VALUE SQ2234.2 +020700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2234.2 +020800- " SYSTEM". SQ2234.2 +020900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2234.2 +021000 01 CCVS-H-2. SQ2234.2 +021100 02 FILLER PICTURE X(52) VALUE IS SQ2234.2 +021200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2234.2 +021300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2234.2 +021400 02 TEST-ID PICTURE IS X(9). SQ2234.2 +021500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2234.2 +021600 01 CCVS-H-3. SQ2234.2 +021700 02 FILLER PICTURE X(34) VALUE SQ2234.2 +021800 " FOR OFFICIAL USE ONLY ". SQ2234.2 +021900 02 FILLER PICTURE X(58) VALUE SQ2234.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2234.2 +022100 02 FILLER PICTURE X(28) VALUE SQ2234.2 +022200 " COPYRIGHT 1985 ". SQ2234.2 +022300 01 CCVS-E-1. SQ2234.2 +022400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2234.2 +022500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2234.2 +022600 02 ID-AGAIN PICTURE IS X(9). SQ2234.2 +022700 02 FILLER PICTURE X(45) VALUE IS SQ2234.2 +022800 " NTIS DISTRIBUTION COBOL 85". SQ2234.2 +022900 01 CCVS-E-2. SQ2234.2 +023000 02 FILLER PICTURE X(31) VALUE SQ2234.2 +023100 SPACE. SQ2234.2 +023200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2234.2 +023300 02 CCVS-E-2-2. SQ2234.2 +023400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2234.2 +023500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +023600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2234.2 +023700 01 CCVS-E-3. SQ2234.2 +023800 02 FILLER PICTURE X(22) VALUE SQ2234.2 +023900 " FOR OFFICIAL USE ONLY". SQ2234.2 +024000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2234.2 +024100 02 FILLER PICTURE X(58) VALUE SQ2234.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2234.2 +024300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2234.2 +024400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2234.2 +024500 01 CCVS-E-4. SQ2234.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2234.2 +024700 02 FILLER PIC XXXX VALUE " OF ". SQ2234.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2234.2 +024900 02 FILLER PIC X(40) VALUE SQ2234.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2234.2 +025100 01 XXINFO. SQ2234.2 +025200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2234.2 +025300 02 INFO-TEXT. SQ2234.2 +025400 04 FILLER PIC X(20) VALUE SPACE. SQ2234.2 +025500 04 XXCOMPUTED PIC X(20). SQ2234.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ2234.2 +025700 04 XXCORRECT PIC X(20). SQ2234.2 +025800 01 HYPHEN-LINE. SQ2234.2 +025900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +026000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2234.2 +026100- "*****************************************". SQ2234.2 +026200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2234.2 +026300- "******************************". SQ2234.2 +026400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2234.2 +026500 "SQ223A". SQ2234.2 +026600 PROCEDURE DIVISION. SQ2234.2 +026700 CCVS1 SECTION. SQ2234.2 +026800 OPEN-FILES. SQ2234.2 +026900P OPEN I-O RAW-DATA. SQ2234.2 +027000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2234.2 +027100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2234.2 +027200P MOVE "ABORTED " TO C-ABORT. SQ2234.2 +027300P ADD 1 TO C-NO-OF-TESTS. SQ2234.2 +027400P ACCEPT C-DATE FROM DATE. SQ2234.2 +027500P ACCEPT C-TIME FROM TIME. SQ2234.2 +027600P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2234.2 +027700PEND-E-1. SQ2234.2 +027800P CLOSE RAW-DATA. SQ2234.2 +027900 OPEN OUTPUT PRINT-FILE. SQ2234.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2234.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2234.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2234.2 +028300 MOVE ZERO TO REC-SKL-SUB. SQ2234.2 +028400 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2234.2 +028500 CCVS-INIT-FILE. SQ2234.2 +028600 ADD 1 TO REC-SKL-SUB. SQ2234.2 +028700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2234.2 +028800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2234.2 +028900 CCVS-INIT-EXIT. SQ2234.2 +029000 GO TO CCVS1-EXIT. SQ2234.2 +029100 CLOSE-FILES. SQ2234.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2234.2 +029300P OPEN I-O RAW-DATA. SQ2234.2 +029400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2234.2 +029500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2234.2 +029600P MOVE "OK. " TO C-ABORT. SQ2234.2 +029700P MOVE PASS-COUNTER TO C-OK. SQ2234.2 +029800P MOVE ERROR-HOLD TO C-ALL. SQ2234.2 +029900P MOVE ERROR-COUNTER TO C-FAIL. SQ2234.2 +030000P MOVE DELETE-CNT TO C-DELETED. SQ2234.2 +030100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2234.2 +030200P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2234.2 +030300PEND-E-2. SQ2234.2 +030400P CLOSE RAW-DATA. SQ2234.2 +030500 TERMINATE-CCVS. SQ2234.2 +030600S EXIT PROGRAM. SQ2234.2 +030700STERMINATE-CALL. SQ2234.2 +030800 STOP RUN. SQ2234.2 +030900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2234.2 +031000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2234.2 +031100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2234.2 +031200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2234.2 +031300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2234.2 +031400 PRINT-DETAIL. SQ2234.2 +031500 IF REC-CT NOT EQUAL TO ZERO SQ2234.2 +031600 MOVE "." TO PARDOT-X SQ2234.2 +031700 MOVE REC-CT TO DOTVALUE. SQ2234.2 +031800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2234.2 +031900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2234.2 +032000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2234.2 +032100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2234.2 +032200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2234.2 +032300 MOVE SPACE TO CORRECT-X. SQ2234.2 +032400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2234.2 +032500 MOVE SPACE TO RE-MARK. SQ2234.2 +032600 HEAD-ROUTINE. SQ2234.2 +032700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +032800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2234.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2234.2 +033000 COLUMN-NAMES-ROUTINE. SQ2234.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +033400 END-ROUTINE. SQ2234.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2234.2 +033600 END-RTN-EXIT. SQ2234.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +033800 END-ROUTINE-1. SQ2234.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2234.2 +034000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2234.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SQ2234.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2234.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2234.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2234.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2234.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2234.2 +034700 END-ROUTINE-12. SQ2234.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2234.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2234.2 +035000 MOVE "NO " TO ERROR-TOTAL SQ2234.2 +035100 ELSE SQ2234.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2234.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2234.2 +035400 PERFORM WRITE-LINE. SQ2234.2 +035500 END-ROUTINE-13. SQ2234.2 +035600 IF DELETE-CNT IS EQUAL TO ZERO SQ2234.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SQ2234.2 +035800 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2234.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2234.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2234.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ2234.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2234.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2234.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036700 WRITE-LINE. SQ2234.2 +036800 ADD 1 TO RECORD-COUNT. SQ2234.2 +036900Y IF RECORD-COUNT GREATER 50 SQ2234.2 +037000Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2234.2 +037100Y MOVE SPACE TO DUMMY-RECORD SQ2234.2 +037200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2234.2 +037300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2234.2 +037400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2234.2 +037500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2234.2 +037600Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2234.2 +037700Y MOVE ZERO TO RECORD-COUNT. SQ2234.2 +037800 PERFORM WRT-LN. SQ2234.2 +037900 WRT-LN. SQ2234.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2234.2 +038100 MOVE SPACE TO DUMMY-RECORD. SQ2234.2 +038200 BLANK-LINE-PRINT. SQ2234.2 +038300 PERFORM WRT-LN. SQ2234.2 +038400 FAIL-ROUTINE. SQ2234.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2234.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2234.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2234.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +038900 GO TO FAIL-ROUTINE-EX. SQ2234.2 +039000 FAIL-ROUTINE-WRITE. SQ2234.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2234.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +039300 FAIL-ROUTINE-EX. EXIT. SQ2234.2 +039400 BAIL-OUT. SQ2234.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2234.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2234.2 +039700 BAIL-OUT-WRITE. SQ2234.2 +039800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2234.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +040000 BAIL-OUT-EX. EXIT. SQ2234.2 +040100 CCVS1-EXIT. SQ2234.2 +040200 EXIT. SQ2234.2 +040300 SECT-SQ223A-0001 SECTION. SQ2234.2 +040400 WRITE-INIT-GF-01. SQ2234.2 +040500 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2234.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2234.2 +040700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2234.2 +040800 MOVE 0001 TO XBLOCK-SIZE (1). SQ2234.2 +040900 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2234.2 +041000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2234.2 +041100 MOVE "S" TO XLABEL-TYPE (1). SQ2234.2 +041200 MOVE 000000 TO XRECORD-NUMBER (1). SQ2234.2 +041300 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +041400 OPEN OUTPUT SQ-VS7. SQ2234.2 +041500 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2234.2 +041600 WRITE-TEST-GF-01. SQ2234.2 +041700 PERFORM WRITE-SHORT-REC. SQ2234.2 +041800 PERFORM WRITE-LONG-REC. SQ2234.2 +041900 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2234.2 +042000 PERFORM WRITE-LONG-REC 100 TIMES. SQ2234.2 +042100 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2234.2 +042200 WRITE-WRITE-GF-01. SQ2234.2 +042300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2234.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2234.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2234.2 +042600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2234.2 +042700 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2234.2 +042800 PERFORM PRINT-DETAIL. SQ2234.2 +042900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2234.2 +043000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2234.2 +043100* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2234.2 +043200* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2234.2 +043300* 100L-338S. SQ2234.2 +043400 WRITE-CLOSE-GF-01. SQ2234.2 +043500 CLOSE SQ-VS7. SQ2234.2 +043600 GO TO READ-INIT-F1-01. SQ2234.2 +043700 WRITE-SHORT-REC. SQ2234.2 +043800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2234.2 +043900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2234.2 +044000 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +044100 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2234.2 +044200 MOVE "SHORT" TO LONG-OR-SHORT. SQ2234.2 +044300 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2234.2 +044400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2234.2 +044500 WRITE SQ-VS7R1-M-G-120. SQ2234.2 +044600 WRITE-LONG-REC. SQ2234.2 +044700 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2234.2 +044800 MOVE 000151 TO XRECORD-LENGTH (1). SQ2234.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +045000 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2234.2 +045100 MOVE "LONG" TO LONG-OR-SHORT. SQ2234.2 +045200 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2234.2 +045300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2234.2 +045400 WRITE SQ-VS7R2-M-G-151. SQ2234.2 +045500 READ-INIT-F1-01. SQ2234.2 +045600 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +045700 MOVE ZERO TO EOF-FLAG. SQ2234.2 +045800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2234.2 +045900 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +046000 OPEN INPUT SQ-VS7. SQ2234.2 +046100 READ-TEST-F1-01. SQ2234.2 +046200 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2234.2 +046300 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +046400 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2234.2 +046500 GO TO READ-EOF-F1-06. SQ2234.2 +046600 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +046700 GO TO READ-FAIL-F1-01. SQ2234.2 +046800 READ-PASS-F1-01. SQ2234.2 +046900 PERFORM PASS. SQ2234.2 +047000 GO TO READ-WRITE-F1-01. SQ2234.2 +047100 READ-FAIL-F1-01. SQ2234.2 +047200 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +047300- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +047400 PERFORM FAIL. SQ2234.2 +047500 READ-WRITE-F1-01. SQ2234.2 +047600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +047700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2234.2 +047800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +047900 MOVE 120 TO CORRECT-N. SQ2234.2 +048000 PERFORM PRINT-DETAIL. SQ2234.2 +048100 GO TO READ-INIT-F1-02. SQ2234.2 +048200 READ-SHORT-REC. SQ2234.2 +048300 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +048400 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +048500 READ SQ-VS7 AT END SQ2234.2 +048600 MOVE 1 TO EOF-FLAG SQ2234.2 +048700 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +048800 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +048900 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2234.2 +049000 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2234.2 +049100 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049200 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2234.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049400 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2234.2 +049500 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049600 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2234.2 +049700 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +049800 READ-SHORT-REC-ERROR. SQ2234.2 +049900 ADD 1 TO RECORDS-IN-ERROR. SQ2234.2 +050000 MOVE 1 TO ERROR-FLAG. SQ2234.2 +050100 READ-SHORT-REC-EXIT. SQ2234.2 +050200 EXIT. SQ2234.2 +050300 READ-INIT-F1-02. SQ2234.2 +050400 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +050500 READ-TEST-F1-02. SQ2234.2 +050600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2234.2 +050700 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +050800 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2234.2 +050900 GO TO READ-EOF-F1-06. SQ2234.2 +051000 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +051100 GO TO READ-FAIL-F1-02. SQ2234.2 +051200 READ-PASS-F1-02. SQ2234.2 +051300 PERFORM PASS. SQ2234.2 +051400 GO TO READ-WRITE-F1-02. SQ2234.2 +051500 READ-FAIL-F1-02. SQ2234.2 +051600 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +051700- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +051800 MOVE 151 TO CORRECT-N. SQ2234.2 +051900 PERFORM FAIL. SQ2234.2 +052000 READ-WRITE-F1-02. SQ2234.2 +052100 MOVE "READ LONG RECORD" TO FEATURE. SQ2234.2 +052200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2234.2 +052300 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2234.2 +052400 PERFORM PRINT-DETAIL. SQ2234.2 +052500 GO TO READ-INIT-F1-03. SQ2234.2 +052600 READ-LONG-REC. SQ2234.2 +052700 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +052800 GO TO READ-LONG-REC-EXIT. SQ2234.2 +052900 READ SQ-VS7 END SQ2234.2 +053000 MOVE 1 TO EOF-FLAG SQ2234.2 +053100 GO TO READ-LONG-REC-EXIT. SQ2234.2 +053200 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +053300 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2234.2 +053400 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2234.2 +053500 GO TO READ-LONG-REC-ERROR. SQ2234.2 +053600 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2234.2 +053700 GO TO READ-LONG-REC-ERROR. SQ2234.2 +053800 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2234.2 +053900 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2234.2 +054000 GO TO READ-LONG-REC-ERROR. SQ2234.2 +054100 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2234.2 +054200 GO TO READ-LONG-REC-EXIT. SQ2234.2 +054300 READ-LONG-REC-ERROR. SQ2234.2 +054400 ADD 1 TO RECORDS-IN-ERROR. SQ2234.2 +054500 MOVE 1 TO ERROR-FLAG. SQ2234.2 +054600 READ-LONG-REC-EXIT. SQ2234.2 +054700 EXIT. SQ2234.2 +054800 READ-INIT-F1-03. SQ2234.2 +054900 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +055000 READ-TEST-F1-03. SQ2234.2 +055100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2234.2 +055200 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +055300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +055400 GO TO READ-EOF-F1-06. SQ2234.2 +055500 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +055600 GO TO READ-FAIL-F1-03. SQ2234.2 +055700 READ-PASS-F1-03. SQ2234.2 +055800 PERFORM PASS. SQ2234.2 +055900 GO TO READ-WRITE-F1-03. SQ2234.2 +056000 READ-FAIL-F1-03. SQ2234.2 +056100 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +056200- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +056300 MOVE 120 TO CORRECT-N. SQ2234.2 +056400 PERFORM FAIL. SQ2234.2 +056500 READ-WRITE-F1-03. SQ2234.2 +056600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2234.2 +056700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2234.2 +056800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +056900 PERFORM PRINT-DETAIL. SQ2234.2 +057000 READ-INIT-F1-04. SQ2234.2 +057100 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +057200 READ-TEST-F1-04. SQ2234.2 +057300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2234.2 +057400 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +057500 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +057600 GO TO READ-EOF-F1-06. SQ2234.2 +057700 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +057800 GO TO READ-FAIL-F1-04. SQ2234.2 +057900 READ-PASS-F1-04. SQ2234.2 +058000 PERFORM PASS. SQ2234.2 +058100 GO TO READ-WRITE-F1-04. SQ2234.2 +058200 READ-FAIL-F1-04. SQ2234.2 +058300 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +058400- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +058500 MOVE 151 TO CORRECT-N. SQ2234.2 +058600 PERFORM FAIL. SQ2234.2 +058700 READ-WRITE-F1-04. SQ2234.2 +058800 MOVE "READ LONG RECORDS" TO FEATURE. SQ2234.2 +058900 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2234.2 +059000 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2234.2 +059100 PERFORM PRINT-DETAIL. SQ2234.2 +059200 READ-INIT-F1-05. SQ2234.2 +059300 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +059400 READ-TEST-F1-05. SQ2234.2 +059500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2234.2 +059600 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +059700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +059800 GO TO READ-EOF-F1-06. SQ2234.2 +059900 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +060000 GO TO READ-FAIL-F1-05. SQ2234.2 +060100 READ-PASS-F1-05. SQ2234.2 +060200 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +060300- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +060400 PERFORM PASS. SQ2234.2 +060500 GO TO READ-WRITE-F1-05. SQ2234.2 +060600 READ-FAIL-F1-05. SQ2234.2 +060700 MOVE 120 TO CORRECT-N. SQ2234.2 +060800 PERFORM FAIL. SQ2234.2 +060900 READ-WRITE-F1-05. SQ2234.2 +061000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2234.2 +061100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2234.2 +061200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +061300 PERFORM PRINT-DETAIL. SQ2234.2 +061400 READ-INIT-F1-06. SQ2234.2 +061500 READ SQ-VS7 RECORD END SQ2234.2 +061600 GO TO READ-TEST-F1-06. SQ2234.2 +061700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2234.2 +061800 GO TO READ-FAIL-F1-06. SQ2234.2 +061900 READ-EOF-F1-06. SQ2234.2 +062000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2234.2 +062100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2234.2 +062200 GO TO READ-FAIL-F1-06. SQ2234.2 +062300 READ-TEST-F1-06. SQ2234.2 +062400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2234.2 +062500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2234.2 +062600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2234.2 +062700 GO TO READ-FAIL-F1-06. SQ2234.2 +062800 READ-PASS-F1-06. SQ2234.2 +062900 PERFORM PASS. SQ2234.2 +063000 GO TO READ-WRITE-F1-06. SQ2234.2 +063100 READ-FAIL-F1-06. SQ2234.2 +063200 PERFORM FAIL. SQ2234.2 +063300 READ-WRITE-F1-06. SQ2234.2 +063400 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2234.2 +063500 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2234.2 +063600 PERFORM PRINT-DETAIL. SQ2234.2 +063700 READ-CLOSE-F1-06. SQ2234.2 +063800 CLOSE SQ-VS7. SQ2234.2 +063900 SECT-SQ223A-0002 SECTION. SQ2234.2 +064000* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2234.2 +064100* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2234.2 +064200* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2234.2 +064300* 130 IS UNIQUE FOR EACH RECORD. SQ2234.2 +064400 INFO-INIT-01. SQ2234.2 +064500 OPEN INPUT SQ-VS7. SQ2234.2 +064600 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +064700 INFO-TEST-01. SQ2234.2 +064800 READ SQ-VS7 AT END SQ2234.2 +064900 GO TO INFO-END. SQ2234.2 +065000 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +065100 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2234.2 +065200 GO TO NO-INFO-01. SQ2234.2 +065300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +065400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +065500 MOVE 0001 TO CORRECT-18V0. SQ2234.2 +065600 GO TO INFO-WRITE-01. SQ2234.2 +065700 NO-INFO-01. SQ2234.2 +065800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +065900 INFO-WRITE-01. SQ2234.2 +066000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +066100 MOVE "SEQ-INFO-01 " TO PAR-NAME. SQ2234.2 +066200 PERFORM PRINT-DETAIL. SQ2234.2 +066300 INFO-INIT-02. SQ2234.2 +066400 READ SQ-VS7 RECORD AT END SQ2234.2 +066500 GO TO INFO-END. SQ2234.2 +066600 READ SQ-VS7 END SQ2234.2 +066700 GO TO INFO-END. SQ2234.2 +066800 INFO-TEST-02. SQ2234.2 +066900 READ SQ-VS7 AT END SQ2234.2 +067000 GO TO INFO-END. SQ2234.2 +067100 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2234.2 +067200 GO TO NO-INFO-02. SQ2234.2 +067300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +067400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +067500 MOVE 0004 TO CORRECT-18V0. SQ2234.2 +067600 GO TO INFO-WRITE-02. SQ2234.2 +067700 NO-INFO-02. SQ2234.2 +067800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +067900 INFO-WRITE-02. SQ2234.2 +068000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +068100 MOVE "SEQ-INFO-02 " TO PAR-NAME. SQ2234.2 +068200 PERFORM PRINT-DETAIL. SQ2234.2 +068300 INFO-INIT-03. SQ2234.2 +068400 ADD 3 TO COUNT-OF-RECS. SQ2234.2 +068500 INFO-INIT-03-1. SQ2234.2 +068600 READ SQ-VS7 RECORD SQ2234.2 +068700 END GO TO INFO-END. SQ2234.2 +068800 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +068900 IF COUNT-OF-RECS EQUAL TO 450 SQ2234.2 +069000 GO TO INFO-TEST-03. SQ2234.2 +069100 GO TO INFO-INIT-03-1. SQ2234.2 +069200 INFO-TEST-03. SQ2234.2 +069300 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2234.2 +069400 GO TO NO-INFO-03. SQ2234.2 +069500 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +069600 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +069700 MOVE 0450 TO CORRECT-18V0. SQ2234.2 +069800 GO TO INFO-WRITE-03. SQ2234.2 +069900 NO-INFO-03. SQ2234.2 +070000 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +070100 INFO-WRITE-03. SQ2234.2 +070200 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +070300 MOVE "SEQ-INFO-03 " TO PAR-NAME. SQ2234.2 +070400 PERFORM PRINT-DETAIL. SQ2234.2 +070500 INFO-END. SQ2234.2 +070600 CLOSE SQ-VS7. SQ2234.2 +070700 TERMINATE-ROUTINE. SQ2234.2 +070800 EXIT. SQ2234.2 +070900 CCVS-EXIT SECTION. SQ2234.2 +071000 CCVS-999999. SQ2234.2 +071100 GO TO CLOSE-FILES. SQ2234.2 +*END-OF,SQ223A +*HEADER,COBOL,SQ224A +000100 IDENTIFICATION DIVISION. SQ2244.2 +000200 PROGRAM-ID. SQ2244.2 +000300 SQ224A. SQ2244.2 +000400**************************************************************** SQ2244.2 +000500* * SQ2244.2 +000600* VALIDATION FOR:- * SQ2244.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2244.2 +000800* * SQ2244.2 +000900* CREATION DATE / VALIDATION DATE * SQ2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2244.2 +001100* * SQ2244.2 +001200* THIS ROUTINE CHECKS: SQ2244.2 +001300* SQ2244.2 +001400* RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2244.2 +001500* DEPENDING ON DATA-NAME-1. SQ2244.2 +001600* SQ2244.2 +001700* THE WRITE STATEMENT IS USED WITH AND WITHOUT THE INTO CLAUSE.SQ2244.2 +001800* SQ2244.2 +001900* THE READ STATEMENT IS USED WITH AND WITHOUT THE INTO CLAUSE. SQ2244.2 +002000* SQ2244.2 +002100* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE WHICH SQ2244.2 +002200* CONTAINS 2031 RECORDS OF A LENGTH OF 18 TO 2048 CHARACTERS. SQ2244.2 +002300* THE MASS STORAGE FILE IS READ AND FIELDS IN THE RECORDS ARE SQ2244.2 +002400* CHECKED AGAINST THE EXPECTED VALUES. SQ2244.2 +002500* SQ2244.2 +002600 ENVIRONMENT DIVISION. SQ2244.2 +002700 CONFIGURATION SECTION. SQ2244.2 +002800 SOURCE-COMPUTER. SQ2244.2 +002900 XXXXX082. SQ2244.2 +003000 OBJECT-COMPUTER. SQ2244.2 +003100 XXXXX083. SQ2244.2 +003200 INPUT-OUTPUT SECTION. SQ2244.2 +003300 FILE-CONTROL. SQ2244.2 +003400P SELECT RAW-DATA ASSIGN TO SQ2244.2 +003500P XXXXX062 SQ2244.2 +003600P ORGANIZATION IS INDEXED SQ2244.2 +003700P ACCESS MODE IS RANDOM SQ2244.2 +003800P RECORD KEY IS RAW-DATA-KEY. SQ2244.2 +003900 SELECT PRINT-FILE ASSIGN TO SQ2244.2 +004000 XXXXX055. SQ2244.2 +004100 SELECT SQ-VS7 ASSIGN TO SQ2244.2 +004200 XXXXX014 SQ2244.2 +004300 ORGANIZATION SEQUENTIAL SQ2244.2 +004400 ACCESS SEQUENTIAL. SQ2244.2 +004500 DATA DIVISION. SQ2244.2 +004600 FILE SECTION. SQ2244.2 +004700PFD RAW-DATA. SQ2244.2 +004800P SQ2244.2 +004900P01 RAW-DATA-SATZ. SQ2244.2 +005000P 05 RAW-DATA-KEY PIC X(6). SQ2244.2 +005100P 05 C-DATE PIC 9(6). SQ2244.2 +005200P 05 C-TIME PIC 9(8). SQ2244.2 +005300P 05 C-NO-OF-TESTS PIC 99. SQ2244.2 +005400P 05 C-OK PIC 999. SQ2244.2 +005500P 05 C-ALL PIC 999. SQ2244.2 +005600P 05 C-FAIL PIC 999. SQ2244.2 +005700P 05 C-DELETED PIC 999. SQ2244.2 +005800P 05 C-INSPECT PIC 999. SQ2244.2 +005900P 05 C-NOTE PIC X(13). SQ2244.2 +006000P 05 C-INDENT PIC X. SQ2244.2 +006100P 05 C-ABORT PIC X(8). SQ2244.2 +006200 FD PRINT-FILE SQ2244.2 +006300C LABEL RECORDS SQ2244.2 +006400C XXXXX084 SQ2244.2 +006500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2244.2 +006600 . SQ2244.2 +006700 01 PRINT-REC PICTURE X(120). SQ2244.2 +006800 01 DUMMY-RECORD PICTURE X(120). SQ2244.2 +006900 FD SQ-VS7 SQ2244.2 +007000C LABEL RECORDS ARE STANDARD SQ2244.2 +007100 RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2244.2 +007200 DEPENDING ON RECORD-LENGTH. SQ2244.2 +007300 01 SQ-VSR7R1-M-G-2048. SQ2244.2 +007400 02 SQ-VS7R1-FIRST PICTURE X(2048). SQ2244.2 +007500 WORKING-STORAGE SECTION. SQ2244.2 +007600 01 RECORD-LENGTH PICTURE 9999 VALUE ZERO. SQ2244.2 +007700 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2244.2 +007800 01 COUNT-OF-RECS PICTURE S9(4) COMPUTATIONAL. SQ2244.2 +007900 01 RECORDS-IN-ERROR PICTURE S9(4) COMPUTATIONAL. SQ2244.2 +008000 01 ERROR-FLAG PICTURE 9. SQ2244.2 +008100 01 EOF-FLAG PICTURE 9. SQ2244.2 +008200 01 DUMP-AREA. SQ2244.2 +008300 02 TYPE-OF-REC PICTURE X(5). SQ2244.2 +008400 02 RECNO PICTURE 9(5). SQ2244.2 +008500 02 REC-FILLER PICTURE X(21). SQ2244.2 +008600 01 VAR-RECORD-18-2048. SQ2244.2 +008700 05 FILLER PIC X(13) VALUE "SQ-VS7LENGTH=". SQ2244.2 +008800 05 RECORD-NUMBER PIC 9999 VALUE ZERO. SQ2244.2 +008900 05 FILLER PIC X(100) VALUE SQ2244.2 +009000 "........10........20........30........40........50........60SQ2244.2 +009100- "........70........80........90.......100". SQ2244.2 +009200 05 FILLER PIC X(100) VALUE SQ2244.2 +009300 ".......110.......120.......130.......140.......150.......160SQ2244.2 +009400- ".......170.......180.......190.......200". SQ2244.2 +009500 05 FILLER PIC X(100) VALUE SQ2244.2 +009600 ".......210.......220.......230.......240.......250.......260SQ2244.2 +009700- ".......270.......280.......290.......300". SQ2244.2 +009800 05 FILLER PIC X(100) VALUE SQ2244.2 +009900 ".......310.......320.......330.......340.......350.......360SQ2244.2 +010000- ".......370.......380.......390.......400". SQ2244.2 +010100 05 FILLER PIC X(100) VALUE SQ2244.2 +010200 ".......410.......420.......430.......440.......450.......460SQ2244.2 +010300- ".......470.......480.......490.......500". SQ2244.2 +010400 05 FILLER PIC X(100) VALUE SQ2244.2 +010500 ".......510.......520.......530.......540.......550.......560SQ2244.2 +010600- ".......570.......580.......590.......600". SQ2244.2 +010700 05 FILLER PIC X(100) VALUE SQ2244.2 +010800 ".......610.......620.......630.......640.......650.......660SQ2244.2 +010900- ".......670.......680.......690.......700". SQ2244.2 +011000 05 FILLER PIC X(100) VALUE SQ2244.2 +011100 ".......710.......720.......730.......740.......750.......760SQ2244.2 +011200- ".......770.......780.......790.......800". SQ2244.2 +011300 05 FILLER PIC X(100) VALUE SQ2244.2 +011400 ".......810.......820.......830.......840.......850.......860SQ2244.2 +011500- ".......870.......880.......890.......900". SQ2244.2 +011600 05 FILLER PIC X(100) VALUE SQ2244.2 +011700 ".......910.......920.......930.......940.......950.......960SQ2244.2 +011800- ".......970.......980.......990......1000". SQ2244.2 +011900 05 FILLER PIC X(100) VALUE SQ2244.2 +012000 "......1010......1020......1030......1040......1050......1060SQ2244.2 +012100- "......1070......1080......1090......1100". SQ2244.2 +012200 05 FILLER PIC X(100) VALUE SQ2244.2 +012300 "......1110......1120......1130......1140......1150......1160SQ2244.2 +012400- "......1170......1180......1190......1200". SQ2244.2 +012500 05 FILLER PIC X(100) VALUE SQ2244.2 +012600 "......1210......1220......1230......1240......1250......1260SQ2244.2 +012700- ".......270.......280.......290.......300". SQ2244.2 +012800 05 FILLER PIC X(100) VALUE SQ2244.2 +012900 "......1310......1320......1330......1340......1350......1360SQ2244.2 +013000- "......1370......1380......1390......1400". SQ2244.2 +013100 05 FILLER PIC X(100) VALUE SQ2244.2 +013200 "......1410......1420......1430......1440......1450......1460SQ2244.2 +013300- "......1470......1480......1490......1500". SQ2244.2 +013400 05 FILLER PIC X(100) VALUE SQ2244.2 +013500 "......1510......1520......1530......1540......1550......1560SQ2244.2 +013600- "......1570......1580......1590......1600". SQ2244.2 +013700 05 FILLER PIC X(100) VALUE SQ2244.2 +013800 "......1610......1620......1630......1640......1650......1660SQ2244.2 +013900- "......1670......1680......1690......1700". SQ2244.2 +014000 05 FILLER PIC X(100) VALUE SQ2244.2 +014100 "......1710......1720......1730......1740......1750......1760SQ2244.2 +014200- "......1770......1780......1790......1800". SQ2244.2 +014300 05 FILLER PIC X(100) VALUE SQ2244.2 +014400 "......1810......1820......1830......1840......1850......1860SQ2244.2 +014500- "......1870......1880......1890......1900". SQ2244.2 +014600 05 FILLER PIC X(100) VALUE SQ2244.2 +014700 "......1910......1920......1930......1940......1950......1960SQ2244.2 +014800- "......1970......1980......1990......2000". SQ2244.2 +014900 05 FILLER PIC X(048) VALUE SQ2244.2 +015000 "......2010......2020......2030......2040....,...". SQ2244.2 +015100 01 TEST-RESULTS. SQ2244.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2244.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2244.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015700 02 PAR-NAME. SQ2244.2 +015800 03 FILLER PICTURE X(12) VALUE SPACE. SQ2244.2 +015900 03 PARDOT-X PICTURE X VALUE SPACE. SQ2244.2 +016000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2244.2 +016100 03 FILLER PIC X(5) VALUE SPACE. SQ2244.2 +016200 02 FILLER PIC X(10) VALUE SPACE. SQ2244.2 +016300 02 RE-MARK PIC X(61). SQ2244.2 +016400 01 TEST-COMPUTED. SQ2244.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ2244.2 +016600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2244.2 +016700 02 COMPUTED-X. SQ2244.2 +016800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2244.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2244.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2244.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2244.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2244.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. SQ2244.2 +017400 04 COMPUTED-18V0 PICTURE -9(18). SQ2244.2 +017500 04 FILLER PICTURE X. SQ2244.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ2244.2 +017700 01 TEST-CORRECT. SQ2244.2 +017800 02 FILLER PIC X(30) VALUE SPACE. SQ2244.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2244.2 +018000 02 CORRECT-X. SQ2244.2 +018100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2244.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2244.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2244.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2244.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2244.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. SQ2244.2 +018700 04 CORRECT-18V0 PICTURE -9(18). SQ2244.2 +018800 04 FILLER PICTURE X. SQ2244.2 +018900 03 FILLER PIC X(50) VALUE SPACE. SQ2244.2 +019000 01 CCVS-C-1. SQ2244.2 +019100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2244.2 +019200- "SS PARAGRAPH-NAME SQ2244.2 +019300- " REMARKS". SQ2244.2 +019400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2244.2 +019500 01 CCVS-C-2. SQ2244.2 +019600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +019700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2244.2 +019800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2244.2 +019900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2244.2 +020000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2244.2 +020100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2244.2 +020200 01 REC-CT PICTURE 99 VALUE ZERO. SQ2244.2 +020300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2244.2 +020400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2244.2 +020500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2244.2 +020600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2244.2 +020700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2244.2 +020800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2244.2 +020900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2244.2 +021000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2244.2 +021100 01 CCVS-H-1. SQ2244.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. SQ2244.2 +021300 02 FILLER PICTURE X(67) VALUE SQ2244.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2244.2 +021500- " SYSTEM". SQ2244.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. SQ2244.2 +021700 01 CCVS-H-2. SQ2244.2 +021800 02 FILLER PICTURE X(52) VALUE IS SQ2244.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2244.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2244.2 +022100 02 TEST-ID PICTURE IS X(9). SQ2244.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2244.2 +022300 01 CCVS-H-3. SQ2244.2 +022400 02 FILLER PICTURE X(34) VALUE SQ2244.2 +022500 " FOR OFFICIAL USE ONLY ". SQ2244.2 +022600 02 FILLER PICTURE X(58) VALUE SQ2244.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2244.2 +022800 02 FILLER PICTURE X(28) VALUE SQ2244.2 +022900 " COPYRIGHT 1985 ". SQ2244.2 +023000 01 CCVS-E-1. SQ2244.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2244.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2244.2 +023300 02 ID-AGAIN PICTURE IS X(9). SQ2244.2 +023400 02 FILLER PICTURE X(45) VALUE IS SQ2244.2 +023500 " NTIS DISTRIBUTION COBOL 85". SQ2244.2 +023600 01 CCVS-E-2. SQ2244.2 +023700 02 FILLER PICTURE X(31) VALUE SQ2244.2 +023800 SPACE. SQ2244.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. SQ2244.2 +024000 02 CCVS-E-2-2. SQ2244.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2244.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2244.2 +024400 01 CCVS-E-3. SQ2244.2 +024500 02 FILLER PICTURE X(22) VALUE SQ2244.2 +024600 " FOR OFFICIAL USE ONLY". SQ2244.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. SQ2244.2 +024800 02 FILLER PICTURE X(58) VALUE SQ2244.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2244.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. SQ2244.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2244.2 +025200 01 CCVS-E-4. SQ2244.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2244.2 +025400 02 FILLER PIC XXXX VALUE " OF ". SQ2244.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2244.2 +025600 02 FILLER PIC X(40) VALUE SQ2244.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2244.2 +025800 01 XXINFO. SQ2244.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2244.2 +026000 02 INFO-TEXT. SQ2244.2 +026100 04 FILLER PIC X(20) VALUE SPACE. SQ2244.2 +026200 04 XXCOMPUTED PIC X(20). SQ2244.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ2244.2 +026400 04 XXCORRECT PIC X(20). SQ2244.2 +026500 01 HYPHEN-LINE. SQ2244.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2244.2 +026800- "*****************************************". SQ2244.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2244.2 +027000- "******************************". SQ2244.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE SQ2244.2 +027200 "SQ224A". SQ2244.2 +027300 PROCEDURE DIVISION. SQ2244.2 +027400 CCVS1 SECTION. SQ2244.2 +027500 OPEN-FILES. SQ2244.2 +027600P OPEN I-O RAW-DATA. SQ2244.2 +027700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2244.2 +027800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2244.2 +027900P MOVE "ABORTED " TO C-ABORT. SQ2244.2 +028000P ADD 1 TO C-NO-OF-TESTS. SQ2244.2 +028100P ACCEPT C-DATE FROM DATE. SQ2244.2 +028200P ACCEPT C-TIME FROM TIME. SQ2244.2 +028300P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2244.2 +028400PEND-E-1. SQ2244.2 +028500P CLOSE RAW-DATA. SQ2244.2 +028600 OPEN OUTPUT PRINT-FILE. SQ2244.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2244.2 +028800 MOVE SPACE TO TEST-RESULTS. SQ2244.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2244.2 +029000 MOVE ZERO TO REC-SKL-SUB. SQ2244.2 +029100 CCVS-INIT-EXIT. SQ2244.2 +029200 GO TO CCVS1-EXIT. SQ2244.2 +029300 CLOSE-FILES. SQ2244.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2244.2 +029500P OPEN I-O RAW-DATA. SQ2244.2 +029600P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2244.2 +029700P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2244.2 +029800P MOVE "OK. " TO C-ABORT. SQ2244.2 +029900P MOVE PASS-COUNTER TO C-OK. SQ2244.2 +030000P MOVE ERROR-HOLD TO C-ALL. SQ2244.2 +030100P MOVE ERROR-COUNTER TO C-FAIL. SQ2244.2 +030200P MOVE DELETE-CNT TO C-DELETED. SQ2244.2 +030300P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2244.2 +030400P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2244.2 +030500PEND-E-2. SQ2244.2 +030600P CLOSE RAW-DATA. SQ2244.2 +030700 TERMINATE-CCVS. SQ2244.2 +030800S EXIT PROGRAM. SQ2244.2 +030900STERMINATE-CALL. SQ2244.2 +031000 STOP RUN. SQ2244.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2244.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2244.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2244.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2244.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2244.2 +031600 PRINT-DETAIL. SQ2244.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2244.2 +031800 MOVE "." TO PARDOT-X SQ2244.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2244.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2244.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2244.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2244.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2244.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2244.2 +032500 MOVE SPACE TO CORRECT-X. SQ2244.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2244.2 +032700 MOVE SPACE TO RE-MARK. SQ2244.2 +032800 HEAD-ROUTINE. SQ2244.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2244.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2244.2 +033200 COLUMN-NAMES-ROUTINE. SQ2244.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +033600 END-ROUTINE. SQ2244.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2244.2 +033800 END-RTN-EXIT. SQ2244.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +034000 END-ROUTINE-1. SQ2244.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2244.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2244.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2244.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2244.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2244.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2244.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2244.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2244.2 +034900 END-ROUTINE-12. SQ2244.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2244.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2244.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2244.2 +035300 ELSE SQ2244.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2244.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2244.2 +035600 PERFORM WRITE-LINE. SQ2244.2 +035700 END-ROUTINE-13. SQ2244.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2244.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2244.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2244.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2244.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2244.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2244.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2244.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2244.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036900 WRITE-LINE. SQ2244.2 +037000 ADD 1 TO RECORD-COUNT. SQ2244.2 +037100Y IF RECORD-COUNT GREATER 50 SQ2244.2 +037200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2244.2 +037300Y MOVE SPACE TO DUMMY-RECORD SQ2244.2 +037400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2244.2 +037500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2244.2 +037600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2244.2 +037700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2244.2 +037800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2244.2 +037900Y MOVE ZERO TO RECORD-COUNT. SQ2244.2 +038000 PERFORM WRT-LN. SQ2244.2 +038100 WRT-LN. SQ2244.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2244.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2244.2 +038400 BLANK-LINE-PRINT. SQ2244.2 +038500 PERFORM WRT-LN. SQ2244.2 +038600 FAIL-ROUTINE. SQ2244.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2244.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2244.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2244.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2244.2 +039200 FAIL-ROUTINE-WRITE. SQ2244.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2244.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2244.2 +039600 BAIL-OUT. SQ2244.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2244.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2244.2 +039900 BAIL-OUT-WRITE. SQ2244.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2244.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +040200 BAIL-OUT-EX. EXIT. SQ2244.2 +040300 CCVS1-EXIT. SQ2244.2 +040400 EXIT. SQ2244.2 +040500 SECT-SQ224A-0001 SECTION. SQ2244.2 +040600 WRITE-INIT-GF-01. SQ2244.2 +040700 MOVE ZERO TO COUNT-OF-RECS. SQ2244.2 +040800 MOVE 17 TO RECORD-LENGTH. SQ2244.2 +040900 OPEN OUTPUT SQ-VS7. SQ2244.2 +041000 WRITE-TEST-GF-01. SQ2244.2 +041100 PERFORM WRITE-RECORDS-1 1030 TIMES. SQ2244.2 +041200 PERFORM WRITE-RECORDS-2 1001 TIMES. SQ2244.2 +041300 WRITE-WRITE-GF-01. SQ2244.2 +041400 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2244.2 +041500 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2244.2 +041600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2244.2 +041700 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2244.2 +041800 MOVE "FILE HAS 18 THRU 2048 CHAR RECS" TO RE-MARK. SQ2244.2 +041900 PERFORM PRINT-DETAIL. SQ2244.2 +042000* A SEQUENTIAL MASS STORAGE FILE CONTAINING 2031 SQ2244.2 +042100* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2244.2 +042200* OF 18 THROUGH 2048 CHARACTERS BEGINNING WITH THE 18 CHAR RECSQ2244.2 +042300* AND ENDING WITH THE 2048 CHAR REC. SQ2244.2 +042400* SQ2244.2 +042500 WRITE-CLOSE-GF-01. SQ2244.2 +042600 CLOSE SQ-VS7. SQ2244.2 +042700 GO TO READ-INIT-F1-01. SQ2244.2 +042800 WRITE-RECORDS-1. SQ2244.2 +042900******************************************************************SQ2244.2 +043000* MOVE ... TO OUTPUT-RECORD 1030 RECORDS *SQ2244.2 +043100* WRITE OUTPUT-RECORD. *SQ2244.2 +043200******************************************************************SQ2244.2 +043300 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +043400 ADD 1 TO RECORD-LENGTH. SQ2244.2 +043500 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2244.2 +043600 MOVE VAR-RECORD-18-2048 TO SQ-VS7R1-FIRST. SQ2244.2 +043700 WRITE SQ-VSR7R1-M-G-2048. SQ2244.2 +043800 WRITE-RECORDS-2. SQ2244.2 +043900******************************************************************SQ2244.2 +044000*WRITE ... FROM .... . 1001 RECORDS *SQ2244.2 +044100******************************************************************SQ2244.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +044300 ADD 1 TO RECORD-LENGTH. SQ2244.2 +044400 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2244.2 +044500 WRITE SQ-VSR7R1-M-G-2048 FROM VAR-RECORD-18-2048. SQ2244.2 +044600 READ-INIT-F1-01. SQ2244.2 +044700 MOVE 17 TO RECORD-LENGTH. SQ2244.2 +044800 MOVE ZERO TO COUNT-OF-RECS. SQ2244.2 +044900 MOVE ZERO TO EOF-FLAG. SQ2244.2 +045000 MOVE ZERO TO RECORDS-IN-ERROR. SQ2244.2 +045100 MOVE ZERO TO ERROR-FLAG. SQ2244.2 +045200 OPEN INPUT SQ-VS7. SQ2244.2 +045300 READ-TEST-F1-01. SQ2244.2 +045400 PERFORM READ-REC-1 THRU READ-REC-1-EXIT 1030 TIMES. SQ2244.2 +045500 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +045600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2244.2 +045700 GO TO READ-EOF-F1-03. SQ2244.2 +045800 IF ERROR-FLAG EQUAL TO 1 SQ2244.2 +045900 GO TO READ-FAIL-F1-01. SQ2244.2 +046000 READ-PASS-F1-01. SQ2244.2 +046100 PERFORM PASS. SQ2244.2 +046200 GO TO READ-WRITE-F1-01. SQ2244.2 +046300 READ-FAIL-F1-01. SQ2244.2 +046400 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2244.2 +046500- "RECORD VARYING . DEPENDING " TO RE-MARK. SQ2244.2 +046600 PERFORM FAIL. SQ2244.2 +046700 READ-WRITE-F1-01. SQ2244.2 +046800 MOVE "READ 1030 RECORDS" TO FEATURE. SQ2244.2 +046900 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2244.2 +047000 MOVE "EXPECTED RECORD LENGTH: 18 TO 1047" TO RE-MARK. SQ2244.2 +047100 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2244.2 +047200 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +047300 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2244.2 +047400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +047500 PERFORM PRINT-DETAIL. SQ2244.2 +047600 GO TO READ-INIT-F1-02. SQ2244.2 +047700 READ-REC-1. SQ2244.2 +047800******************************************************************SQ2244.2 +047900* READ AT END ... *SQ2244.2 +048000******************************************************************SQ2244.2 +048100 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +048200 GO TO READ-REC-1-EXIT. SQ2244.2 +048300 READ SQ-VS7 AT END SQ2244.2 +048400 MOVE 1 TO EOF-FLAG SQ2244.2 +048500 GO TO READ-REC-1-EXIT. SQ2244.2 +048600 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +048700 MOVE SQ-VS7R1-FIRST TO VAR-RECORD-18-2048. SQ2244.2 +048800 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +048900 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2244.2 +049000 GO TO READ-REC-1-ERROR. SQ2244.2 +049100 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +049200 GO TO READ-REC-1-EXIT. SQ2244.2 +049300 READ-REC-1-ERROR. SQ2244.2 +049400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +049500 ADD 1 TO RECORDS-IN-ERROR. SQ2244.2 +049600 MOVE 1 TO ERROR-FLAG. SQ2244.2 +049700 READ-REC-1-EXIT. SQ2244.2 +049800 EXIT. SQ2244.2 +049900 READ-REC-2. SQ2244.2 +050000******************************************************************SQ2244.2 +050100* READ INTO .... AT END *SQ2244.2 +050200******************************************************************SQ2244.2 +050300 READ SQ-VS7 INTO VAR-RECORD-18-2048 AT END SQ2244.2 +050400 MOVE 1 TO EOF-FLAG SQ2244.2 +050500 GO TO READ-REC-2-EXIT. SQ2244.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +050700 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +050800 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2244.2 +050900 GO TO READ-REC-2-ERROR. SQ2244.2 +051000 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +051100 GO TO READ-REC-2-EXIT. SQ2244.2 +051200 READ-REC-2-ERROR. SQ2244.2 +051300 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +051400 MOVE 1 TO ERROR-FLAG. SQ2244.2 +051500 READ-REC-2-EXIT. SQ2244.2 +051600 EXIT. SQ2244.2 +051700 READ-INIT-F1-02. SQ2244.2 +051800 MOVE ZERO TO ERROR-FLAG. SQ2244.2 +051900 READ-TEST-F1-02. SQ2244.2 +052000 PERFORM READ-REC-2 THRU READ-REC-2-EXIT 1001 TIMES. SQ2244.2 +052100 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +052200 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2244.2 +052300 GO TO READ-EOF-F1-03. SQ2244.2 +052400 IF ERROR-FLAG EQUAL TO 1 SQ2244.2 +052500 GO TO READ-FAIL-F1-02. SQ2244.2 +052600 READ-PASS-F1-02. SQ2244.2 +052700 PERFORM PASS. SQ2244.2 +052800 GO TO READ-WRITE-F1-02. SQ2244.2 +052900 READ-FAIL-F1-02. SQ2244.2 +053000 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2244.2 +053100- "RECORD VARYING . DEPENDING " TO RE-MARK. SQ2244.2 +053200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2244.2 +053300 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +053400 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2244.2 +053500 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +053600 PERFORM FAIL. SQ2244.2 +053700 READ-WRITE-F1-02. SQ2244.2 +053800 MOVE "READ 1000 RECORD" TO FEATURE. SQ2244.2 +053900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2244.2 +054000 MOVE "EXPECTED RECORD LENGTH: 1049 TO 2048" TO RE-MARK. SQ2244.2 +054100 PERFORM PRINT-DETAIL. SQ2244.2 +054200 READ-INIT-F1-03. SQ2244.2 +054300 READ SQ-VS7 RECORD END SQ2244.2 +054400 GO TO READ-TEST-F1-03. SQ2244.2 +054500 MOVE "MORE THAN 2031 RECORDS" TO RE-MARK. SQ2244.2 +054600 GO TO READ-FAIL-F1-03. SQ2244.2 +054700 READ-EOF-F1-03. SQ2244.2 +054800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2244.2 +054900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2244.2 +055000 GO TO READ-FAIL-F1-03. SQ2244.2 +055100 READ-TEST-F1-03. SQ2244.2 +055200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2244.2 +055300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2244.2 +055400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2244.2 +055500 GO TO READ-FAIL-F1-03. SQ2244.2 +055600 READ-PASS-F1-03. SQ2244.2 +055700 PERFORM PASS. SQ2244.2 +055800 GO TO READ-WRITE-F1-03. SQ2244.2 +055900 READ-FAIL-F1-03. SQ2244.2 +056000 PERFORM FAIL. SQ2244.2 +056100 READ-WRITE-F1-03. SQ2244.2 +056200 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2244.2 +056300 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2244.2 +056400 PERFORM PRINT-DETAIL. SQ2244.2 +056500 READ-CLOSE-F1-03. SQ2244.2 +056600 CLOSE SQ-VS7. SQ2244.2 +056700 TERMINATE-ROUTINE. SQ2244.2 +056800 EXIT. SQ2244.2 +056900 CCVS-EXIT SECTION. SQ2244.2 +057000 CCVS-999999. SQ2244.2 +057100 GO TO CLOSE-FILES. SQ2244.2 +*END-OF,SQ224A +*HEADER,COBOL,SQ225A +000100 IDENTIFICATION DIVISION. SQ2254.2 +000200 PROGRAM-ID. SQ2254.2 +000300 SQ225A. SQ2254.2 +000400**************************************************************** SQ2254.2 +000500* * SQ2254.2 +000600* VALIDATION FOR:- * SQ2254.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2254.2 +000900* REVISED 1986, AUGUST * SQ2254.2 +001000* * SQ2254.2 +001100* CREATION DATE / VALIDATION DATE * SQ2254.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2254.2 +001300* * SQ2254.2 +001400**************************************************************** SQ2254.2 +001500* * SQ2254.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2254.2 +001700* * SQ2254.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ2254.2 +001900* X-55 SYSTEM PRINTER * SQ2254.2 +002000* X-82 SOURCE-COMPUTER * SQ2254.2 +002100* X-83 OBJECT-COMPUTER. * SQ2254.2 +002200* * SQ2254.2 +002300* * SQ2254.2 +002400**************************************************************** SQ2254.2 +002500* * SQ2254.2 +002600* SQ225A ATTEMPTS TO OPEN FOR EXTEND A MASS STORAGE FILE * SQ2254.2 +002700* WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A PERMANENT * SQ2254.2 +002800* ERROR AND AN I-O STATUS OF "35". THE PROGRAM CONTAINS AN * SQ2254.2 +002900* APPLICABLE DECLARATIVE PROCEDURE, WHICH SHOULD BE * SQ2254.2 +003000* EXECUTED. THE STANDARD ALLOWS THE IMPLEMENTOR TO * SQ2254.2 +003100* TERMINATE EXECUTION ON EXIT FROM THE DECLARATIVE, OR TO * SQ2254.2 +003200* CONTINUE EXECUTION IN THE MAIN PROGRAM. * SQ2254.2 +003300* * SQ2254.2 +003400**************************************************************** SQ2254.2 +003500* SQ2254.2 +003600 ENVIRONMENT DIVISION. SQ2254.2 +003700 CONFIGURATION SECTION. SQ2254.2 +003800 SOURCE-COMPUTER. SQ2254.2 +003900 XXXXX082. SQ2254.2 +004000 OBJECT-COMPUTER. SQ2254.2 +004100 XXXXX083. SQ2254.2 +004200* SQ2254.2 +004300 INPUT-OUTPUT SECTION. SQ2254.2 +004400 FILE-CONTROL. SQ2254.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2254.2 +004600 XXXXX055. SQ2254.2 +004700* SQ2254.2 +004800P SELECT RAW-DATA ASSIGN TO SQ2254.2 +004900P XXXXX062 SQ2254.2 +005000P ORGANIZATION IS INDEXED SQ2254.2 +005100P ACCESS MODE IS RANDOM SQ2254.2 +005200P RECORD-KEY IS RAW-DATA-KEY. SQ2254.2 +005300P SQ2254.2 +005400 SELECT SQ-FS1 ASSIGN TO SQ2254.2 +005500 XXXXX014 SQ2254.2 +005600 FILE STATUS IS SQ-FS1-STATUS. SQ2254.2 +005700* SQ2254.2 +005800* SQ2254.2 +005900 DATA DIVISION. SQ2254.2 +006000 FILE SECTION. SQ2254.2 +006100 FD PRINT-FILE SQ2254.2 +006200C LABEL RECORDS SQ2254.2 +006300C XXXXX084 SQ2254.2 +006400C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2254.2 +006500 . SQ2254.2 +006600 01 PRINT-REC PICTURE X(120). SQ2254.2 +006700 01 DUMMY-RECORD PICTURE X(120). SQ2254.2 +006800P SQ2254.2 +006900PFD RAW-DATA. SQ2254.2 +007000P01 RAW-DATA-SATZ. SQ2254.2 +007100P 05 RAW-DATA-KEY PIC X(6). SQ2254.2 +007200P 05 C-DATE PIC 9(6). SQ2254.2 +007300P 05 C-TIME PIC 9(8). SQ2254.2 +007400P 05 NO-OF-TESTS PIC 99. SQ2254.2 +007500P 05 C-OK PIC 999. SQ2254.2 +007600P 05 C-ALL PIC 999. SQ2254.2 +007700P 05 C-FAIL PIC 999. SQ2254.2 +007800P 05 C-DELETED PIC 999. SQ2254.2 +007900P 05 C-INSPECT PIC 999. SQ2254.2 +008000P 05 C-NOTE PIC X(13). SQ2254.2 +008100P 05 C-INDENT PIC X. SQ2254.2 +008200P 05 C-ABORT PIC X(8). SQ2254.2 +008300* SQ2254.2 +008400 FD SQ-FS1 SQ2254.2 +008500C LABEL RECORD IS STANDARD SQ2254.2 +008600 . SQ2254.2 +008700 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2254.2 +008800* SQ2254.2 +008900 WORKING-STORAGE SECTION. SQ2254.2 +009000* SQ2254.2 +009100*************************************************************** SQ2254.2 +009200* * SQ2254.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2254.2 +009400* * SQ2254.2 +009500*************************************************************** SQ2254.2 +009600* SQ2254.2 +009700 01 SQ-FS1-STATUS. SQ2254.2 +009800 03 SQ-FS1-KEY-1 PIC X. SQ2254.2 +009900 03 SQ-FS1-KEY-2 PIC X. SQ2254.2 +010000* SQ2254.2 +010100 01 DECL-EXEC-SW PIC 9. SQ2254.2 +010200* SQ2254.2 +010300*************************************************************** SQ2254.2 +010400* * SQ2254.2 +010500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2254.2 +010600* * SQ2254.2 +010700*************************************************************** SQ2254.2 +010800* SQ2254.2 +010900 01 REC-SKEL-SUB PIC 99. SQ2254.2 +011000* SQ2254.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ2254.2 +011200 03 FILE-RECORD-INFO-SKELETON. SQ2254.2 +011300 05 FILLER PICTURE X(48) VALUE SQ2254.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2254.2 +011500 05 FILLER PICTURE X(46) VALUE SQ2254.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2254.2 +011700 05 FILLER PICTURE X(26) VALUE SQ2254.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ2254.2 +011900 05 FILLER PICTURE X(37) VALUE SQ2254.2 +012000 ",RECKEY= ". SQ2254.2 +012100 05 FILLER PICTURE X(38) VALUE SQ2254.2 +012200 ",ALTKEY1= ". SQ2254.2 +012300 05 FILLER PICTURE X(38) VALUE SQ2254.2 +012400 ",ALTKEY2= ". SQ2254.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2254.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2254.2 +012700 05 FILE-RECORD-INFO-P1-120. SQ2254.2 +012800 07 FILLER PIC X(5). SQ2254.2 +012900 07 XFILE-NAME PIC X(6). SQ2254.2 +013000 07 FILLER PIC X(8). SQ2254.2 +013100 07 XRECORD-NAME PIC X(6). SQ2254.2 +013200 07 FILLER PIC X(1). SQ2254.2 +013300 07 REELUNIT-NUMBER PIC 9(1). SQ2254.2 +013400 07 FILLER PIC X(7). SQ2254.2 +013500 07 XRECORD-NUMBER PIC 9(6). SQ2254.2 +013600 07 FILLER PIC X(6). SQ2254.2 +013700 07 UPDATE-NUMBER PIC 9(2). SQ2254.2 +013800 07 FILLER PIC X(5). SQ2254.2 +013900 07 ODO-NUMBER PIC 9(4). SQ2254.2 +014000 07 FILLER PIC X(5). SQ2254.2 +014100 07 XPROGRAM-NAME PIC X(5). SQ2254.2 +014200 07 FILLER PIC X(7). SQ2254.2 +014300 07 XRECORD-LENGTH PIC 9(6). SQ2254.2 +014400 07 FILLER PIC X(7). SQ2254.2 +014500 07 CHARS-OR-RECORDS PIC X(2). SQ2254.2 +014600 07 FILLER PIC X(1). SQ2254.2 +014700 07 XBLOCK-SIZE PIC 9(4). SQ2254.2 +014800 07 FILLER PIC X(6). SQ2254.2 +014900 07 RECORDS-IN-FILE PIC 9(6). SQ2254.2 +015000 07 FILLER PIC X(5). SQ2254.2 +015100 07 XFILE-ORGANIZATION PIC X(2). SQ2254.2 +015200 07 FILLER PIC X(6). SQ2254.2 +015300 07 XLABEL-TYPE PIC X(1). SQ2254.2 +015400 05 FILE-RECORD-INFO-P121-240. SQ2254.2 +015500 07 FILLER PIC X(8). SQ2254.2 +015600 07 XRECORD-KEY PIC X(29). SQ2254.2 +015700 07 FILLER PIC X(9). SQ2254.2 +015800 07 ALTERNATE-KEY1 PIC X(29). SQ2254.2 +015900 07 FILLER PIC X(9). SQ2254.2 +016000 07 ALTERNATE-KEY2 PIC X(29). SQ2254.2 +016100 07 FILLER PIC X(7). SQ2254.2 +016200* SQ2254.2 +016300 01 TEST-RESULTS. SQ2254.2 +016400 02 FILLER PIC X VALUE SPACE. SQ2254.2 +016500 02 PAR-NAME. SQ2254.2 +016600 03 FILLER PIC X(14) VALUE SPACE. SQ2254.2 +016700 03 PARDOT-X PIC X VALUE SPACE. SQ2254.2 +016800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2254.2 +016900 02 FILLER PIC X VALUE SPACE. SQ2254.2 +017000 02 FEATURE PIC X(24) VALUE SPACE. SQ2254.2 +017100 02 FILLER PIC X VALUE SPACE. SQ2254.2 +017200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2254.2 +017300 02 FILLER PIC X(9) VALUE SPACE. SQ2254.2 +017400 02 RE-MARK PIC X(61). SQ2254.2 +017500 01 TEST-COMPUTED. SQ2254.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ2254.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2254.2 +017800 02 COMPUTED-X. SQ2254.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2254.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2254.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2254.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2254.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2254.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2254.2 +018500 04 COMPUTED-18V0 PIC -9(18). SQ2254.2 +018600 04 FILLER PIC X. SQ2254.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ2254.2 +018800 01 TEST-CORRECT. SQ2254.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ2254.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2254.2 +019100 02 CORRECT-X. SQ2254.2 +019200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2254.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2254.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2254.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2254.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2254.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SQ2254.2 +019800 04 CORRECT-18V0 PIC -9(18). SQ2254.2 +019900 04 FILLER PIC X. SQ2254.2 +020000 03 FILLER PIC X(2) VALUE SPACE. SQ2254.2 +020100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2254.2 +020200* SQ2254.2 +020300 01 CCVS-C-1. SQ2254.2 +020400 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2254.2 +020600 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2254.2 +020800 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2254.2 +021000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2254.2 +021100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2254.2 +021200 01 CCVS-C-2. SQ2254.2 +021300 02 FILLER PIC X(19) VALUE SPACE. SQ2254.2 +021400 02 FILLER PIC X(6) VALUE "TESTED". SQ2254.2 +021500 02 FILLER PIC X(19) VALUE SPACE. SQ2254.2 +021600 02 FILLER PIC X(4) VALUE "FAIL". SQ2254.2 +021700 02 FILLER PIC X(72) VALUE SPACE. SQ2254.2 +021800* SQ2254.2 +021900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2254.2 +022000 01 REC-CT PIC 99 VALUE ZERO. SQ2254.2 +022100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2254.2 +022600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2254.2 +022700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2254.2 +022800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2254.2 +022900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2254.2 +023000 01 CCVS-H-1. SQ2254.2 +023100 02 FILLER PIC X(39) VALUE SPACES. SQ2254.2 +023200 02 FILLER PIC X(42) VALUE SQ2254.2 +023300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2254.2 +023400 02 FILLER PIC X(39) VALUE SPACES. SQ2254.2 +023500 01 CCVS-H-2A. SQ2254.2 +023600 02 FILLER PIC X(40) VALUE SPACE. SQ2254.2 +023700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2254.2 +023800 02 FILLER PIC XXXX VALUE SQ2254.2 +023900 "4.2 ". SQ2254.2 +024000 02 FILLER PIC X(28) VALUE SQ2254.2 +024100 " COPY - NOT FOR DISTRIBUTION". SQ2254.2 +024200 02 FILLER PIC X(41) VALUE SPACE. SQ2254.2 +024300* SQ2254.2 +024400 01 CCVS-H-2B. SQ2254.2 +024500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2254.2 +024600 02 TEST-ID PIC X(9). SQ2254.2 +024700 02 FILLER PIC X(4) VALUE " IN ". SQ2254.2 +024800 02 FILLER PIC X(12) VALUE SQ2254.2 +024900 " HIGH ". SQ2254.2 +025000 02 FILLER PIC X(22) VALUE SQ2254.2 +025100 " LEVEL VALIDATION FOR ". SQ2254.2 +025200 02 FILLER PIC X(58) VALUE SQ2254.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +025400 01 CCVS-H-3. SQ2254.2 +025500 02 FILLER PIC X(34) VALUE SQ2254.2 +025600 " FOR OFFICIAL USE ONLY ". SQ2254.2 +025700 02 FILLER PIC X(58) VALUE SQ2254.2 +025800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2254.2 +025900 02 FILLER PIC X(28) VALUE SQ2254.2 +026000 " COPYRIGHT 1985,1986 ". SQ2254.2 +026100 01 CCVS-E-1. SQ2254.2 +026200 02 FILLER PIC X(52) VALUE SPACE. SQ2254.2 +026300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2254.2 +026400 02 ID-AGAIN PIC X(9). SQ2254.2 +026500 02 FILLER PIC X(45) VALUE SPACES. SQ2254.2 +026600 01 CCVS-E-2. SQ2254.2 +026700 02 FILLER PIC X(31) VALUE SPACE. SQ2254.2 +026800 02 FILLER PIC X(21) VALUE SPACE. SQ2254.2 +026900 02 CCVS-E-2-2. SQ2254.2 +027000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2254.2 +027100 03 FILLER PIC X VALUE SPACE. SQ2254.2 +027200 03 ENDER-DESC PIC X(44) VALUE SQ2254.2 +027300 "ERRORS ENCOUNTERED". SQ2254.2 +027400 01 CCVS-E-3. SQ2254.2 +027500 02 FILLER PIC X(22) VALUE SQ2254.2 +027600 " FOR OFFICIAL USE ONLY". SQ2254.2 +027700 02 FILLER PIC X(12) VALUE SPACE. SQ2254.2 +027800 02 FILLER PIC X(58) VALUE SQ2254.2 +027900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +028000 02 FILLER PIC X(8) VALUE SPACE. SQ2254.2 +028100 02 FILLER PIC X(20) VALUE SQ2254.2 +028200 " COPYRIGHT 1985,1986". SQ2254.2 +028300 01 CCVS-E-4. SQ2254.2 +028400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2254.2 +028500 02 FILLER PIC X(4) VALUE " OF ". SQ2254.2 +028600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2254.2 +028700 02 FILLER PIC X(40) VALUE SQ2254.2 +028800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2254.2 +028900 01 XXINFO. SQ2254.2 +029000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2254.2 +029100 02 INFO-TEXT. SQ2254.2 +029200 04 FILLER PIC X(8) VALUE SPACE. SQ2254.2 +029300 04 XXCOMPUTED PIC X(20). SQ2254.2 +029400 04 FILLER PIC X(5) VALUE SPACE. SQ2254.2 +029500 04 XXCORRECT PIC X(20). SQ2254.2 +029600 02 INF-ANSI-REFERENCE PIC X(48). SQ2254.2 +029700 01 HYPHEN-LINE. SQ2254.2 +029800 02 FILLER PIC IS X VALUE IS SPACE. SQ2254.2 +029900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2254.2 +030000- "*****************************************". SQ2254.2 +030100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2254.2 +030200- "******************************". SQ2254.2 +030300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2254.2 +030400 "SQ225A". SQ2254.2 +030500* SQ2254.2 +030600* SQ2254.2 +030700 PROCEDURE DIVISION. SQ2254.2 +030800 DECLARATIVES. SQ2254.2 +030900 SQ225A-DECLARATIVE-001-SECT SECTION. SQ2254.2 +031000 USE AFTER ERROR PROCEDURE EXTEND. SQ2254.2 +031100 INPUT-ERROR-PROCEDURE. SQ2254.2 +031200 IF DECL-EXEC-SW NOT = 9 SQ2254.2 +031300 GO TO NOT-DECL-9. SQ2254.2 +031400* SQ2254.2 +031500* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ2254.2 +031600* SQ2254.2 +031700 DECL-OPEN-TEST. SQ2254.2 +031800 MOVE "EXEC USE ON OPEN FAILURE" TO FEATURE. SQ2254.2 +031900 MOVE "DECL-OPEN-TEST" TO PAR-NAME. SQ2254.2 +032000 MOVE 1 TO REC-CT. SQ2254.2 +032100 IF SQ-FS1-STATUS = "35" SQ2254.2 +032200 PERFORM DECL-PASS SQ2254.2 +032300 ELSE SQ2254.2 +032400 MOVE "35" TO CORRECT-A SQ2254.2 +032500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2254.2 +032600 MOVE "INCORRECT FILE STATUS FOR NON-AVAILABLE FILE" SQ2254.2 +032700 TO RE-MARK SQ2254.2 +032800 PERFORM DECL-FAIL. SQ2254.2 +032900 MOVE SPACE TO DUMMY-RECORD SQ2254.2 +033000 PERFORM DECL-WRITE-LINE SQ2254.2 +033100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2254.2 +033200 TO DUMMY-RECORD SQ2254.2 +033300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2254.2 +033400 GO TO END-DECLS. SQ2254.2 +033500* SQ2254.2 +033600* SQ2254.2 +033700 NOT-DECL-9. SQ2254.2 +033800 MOVE "NOT-DECL-9" TO PAR-NAME. SQ2254.2 +033900 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ2254.2 +034000 MOVE 9 TO CORRECT-18V0. SQ2254.2 +034100 PERFORM DECL-FAIL. SQ2254.2 +034200 GO TO END-DECLS. SQ2254.2 +034300* SQ2254.2 +034400* SQ2254.2 +034500 DECL-PASS. SQ2254.2 +034600 MOVE "PASS " TO P-OR-F. SQ2254.2 +034700 ADD 1 TO PASS-COUNTER. SQ2254.2 +034800 PERFORM DECL-PRINT-DETAIL. SQ2254.2 +034900* SQ2254.2 +035000 DECL-FAIL. SQ2254.2 +035100 MOVE "FAIL*" TO P-OR-F. SQ2254.2 +035200 ADD 1 TO ERROR-COUNTER. SQ2254.2 +035300 PERFORM DECL-PRINT-DETAIL. SQ2254.2 +035400* SQ2254.2 +035500 DECL-PRINT-DETAIL. SQ2254.2 +035600 IF REC-CT NOT EQUAL TO ZERO SQ2254.2 +035700 MOVE "." TO PARDOT-X SQ2254.2 +035800 MOVE REC-CT TO DOTVALUE. SQ2254.2 +035900 MOVE TEST-RESULTS TO PRINT-REC. SQ2254.2 +036000 PERFORM DECL-WRITE-LINE. SQ2254.2 +036100 IF P-OR-F EQUAL TO "FAIL*" SQ2254.2 +036200 PERFORM DECL-WRITE-LINE SQ2254.2 +036300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2254.2 +036400 ELSE SQ2254.2 +036500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2254.2 +036600 MOVE SPACE TO P-OR-F. SQ2254.2 +036700 MOVE SPACE TO COMPUTED-X. SQ2254.2 +036800 MOVE SPACE TO CORRECT-X. SQ2254.2 +036900 IF REC-CT EQUAL TO ZERO SQ2254.2 +037000 MOVE SPACE TO PAR-NAME. SQ2254.2 +037100 MOVE SPACE TO RE-MARK. SQ2254.2 +037200* SQ2254.2 +037300 DECL-WRITE-LINE. SQ2254.2 +037400 ADD 1 TO RECORD-COUNT. SQ2254.2 +037500Y IF RECORD-COUNT GREATER 50 SQ2254.2 +037600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2254.2 +037700Y MOVE SPACE TO DUMMY-RECORD SQ2254.2 +037800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2254.2 +037900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2254.2 +038000Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2254.2 +038100Y PERFORM DECL-WRT-LN 2 TIMES SQ2254.2 +038200Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2254.2 +038300Y PERFORM DECL-WRT-LN SQ2254.2 +038400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2254.2 +038500Y MOVE ZERO TO RECORD-COUNT. SQ2254.2 +038600 PERFORM DECL-WRT-LN. SQ2254.2 +038700* SQ2254.2 +038800 DECL-WRT-LN. SQ2254.2 +038900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2254.2 +039000 MOVE SPACE TO DUMMY-RECORD. SQ2254.2 +039100* SQ2254.2 +039200 DECL-FAIL-ROUTINE. SQ2254.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2254.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2254.2 +039500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +039600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2254.2 +039700 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +039800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +039900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +040000 GO TO DECL-FAIL-EX. SQ2254.2 +040100 DECL-FAIL-WRITE. SQ2254.2 +040200 MOVE TEST-COMPUTED TO PRINT-REC SQ2254.2 +040300 PERFORM DECL-WRITE-LINE SQ2254.2 +040400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2254.2 +040500 MOVE TEST-CORRECT TO PRINT-REC SQ2254.2 +040600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2254.2 +040800 DECL-FAIL-EX. SQ2254.2 +040900 EXIT. SQ2254.2 +041000* SQ2254.2 +041100 DECL-BAIL. SQ2254.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2254.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2254.2 +041400 DECL-BAIL-WRITE. SQ2254.2 +041500 MOVE CORRECT-A TO XXCORRECT. SQ2254.2 +041600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2254.2 +041700 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +041800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +041900 DECL-BAIL-EX. SQ2254.2 +042000 EXIT. SQ2254.2 +042100* SQ2254.2 +042200 END-DECLS. SQ2254.2 +042300 MOVE ZERO TO DECL-EXEC-SW. SQ2254.2 +042400 END DECLARATIVES. SQ2254.2 +042500* SQ2254.2 +042600* SQ2254.2 +042700 CCVS1 SECTION. SQ2254.2 +042800 OPEN-FILES. SQ2254.2 +042900P OPEN I-O RAW-DATA. SQ2254.2 +043000P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2254.2 +043100P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2254.2 +043200P MOVE "ABORTED " TO C-ABORT. SQ2254.2 +043300P ADD 1 TO C-NO-OF-TESTS. SQ2254.2 +043400P ACCEPT C-DATE FROM DATE. SQ2254.2 +043500P ACCEPT C-TIME FROM TIME. SQ2254.2 +043600P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2254.2 +043700PEND-E-1. SQ2254.2 +043800P CLOSE RAW-DATA. SQ2254.2 +043900 OPEN OUTPUT PRINT-FILE. SQ2254.2 +044000 MOVE CCVS-PGM-ID TO TEST-ID. SQ2254.2 +044100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2254.2 +044200 MOVE SPACE TO TEST-RESULTS. SQ2254.2 +044300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2254.2 +044400 MOVE ZERO TO REC-SKEL-SUB. SQ2254.2 +044500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2254.2 +044600 GO TO CCVS1-EXIT. SQ2254.2 +044700* SQ2254.2 +044800 CCVS-INIT-FILE. SQ2254.2 +044900 ADD 1 TO REC-SKL-SUB. SQ2254.2 +045000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2254.2 +045100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2254.2 +045200* SQ2254.2 +045300 CLOSE-FILES. SQ2254.2 +045400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2254.2 +045500 CLOSE PRINT-FILE. SQ2254.2 +045600P OPEN I-O RAW-DATA. SQ2254.2 +045700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2254.2 +045800P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2254.2 +045900P MOVE "OK. " TO C-ABORT. SQ2254.2 +046000P MOVE PASS-COUNTER TO C-OK. SQ2254.2 +046100P MOVE ERROR-HOLD TO C-ALL. SQ2254.2 +046200P MOVE ERROR-COUNTER TO C-FAIL. SQ2254.2 +046300P MOVE DELETE-CNT TO C-DELETED. SQ2254.2 +046400P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2254.2 +046500P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2254.2 +046600PEND-E-2. SQ2254.2 +046700P CLOSE RAW-DATA. SQ2254.2 +046800 TERMINATE-CCVS. SQ2254.2 +046900S EXIT PROGRAM. SQ2254.2 +047000 STOP RUN. SQ2254.2 +047100* SQ2254.2 +047200 INSPT. SQ2254.2 +047300 MOVE "INSPT" TO P-OR-F. SQ2254.2 +047400 ADD 1 TO INSPECT-COUNTER. SQ2254.2 +047500 PERFORM PRINT-DETAIL. SQ2254.2 +047600 SQ2254.2 +047700 PASS. SQ2254.2 +047800 MOVE "PASS " TO P-OR-F. SQ2254.2 +047900 ADD 1 TO PASS-COUNTER. SQ2254.2 +048000 PERFORM PRINT-DETAIL. SQ2254.2 +048100* SQ2254.2 +048200 FAIL. SQ2254.2 +048300 MOVE "FAIL*" TO P-OR-F. SQ2254.2 +048400 ADD 1 TO ERROR-COUNTER. SQ2254.2 +048500 PERFORM PRINT-DETAIL. SQ2254.2 +048600* SQ2254.2 +048700 DE-LETE. SQ2254.2 +048800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2254.2 +048900 MOVE "*****" TO P-OR-F. SQ2254.2 +049000 ADD 1 TO DELETE-COUNTER. SQ2254.2 +049100 PERFORM PRINT-DETAIL. SQ2254.2 +049200* SQ2254.2 +049300 PRINT-DETAIL. SQ2254.2 +049400 IF REC-CT NOT EQUAL TO ZERO SQ2254.2 +049500 MOVE "." TO PARDOT-X SQ2254.2 +049600 MOVE REC-CT TO DOTVALUE. SQ2254.2 +049700 MOVE TEST-RESULTS TO PRINT-REC. SQ2254.2 +049800 PERFORM WRITE-LINE. SQ2254.2 +049900 IF P-OR-F EQUAL TO "FAIL*" SQ2254.2 +050000 PERFORM WRITE-LINE SQ2254.2 +050100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2254.2 +050200 ELSE SQ2254.2 +050300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2254.2 +050400 MOVE SPACE TO P-OR-F. SQ2254.2 +050500 MOVE SPACE TO COMPUTED-X. SQ2254.2 +050600 MOVE SPACE TO CORRECT-X. SQ2254.2 +050700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2254.2 +050800 MOVE SPACE TO RE-MARK. SQ2254.2 +050900* SQ2254.2 +051000 HEAD-ROUTINE. SQ2254.2 +051100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2254.2 +051400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2254.2 +051500 COLUMN-NAMES-ROUTINE. SQ2254.2 +051600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +051700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +051900 END-ROUTINE. SQ2254.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2254.2 +052100 PERFORM WRITE-LINE 5 TIMES. SQ2254.2 +052200 END-RTN-EXIT. SQ2254.2 +052300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2254.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +052500* SQ2254.2 +052600 END-ROUTINE-1. SQ2254.2 +052700 ADD ERROR-COUNTER TO ERROR-HOLD SQ2254.2 +052800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2254.2 +052900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2254.2 +053000 ADD PASS-COUNTER TO ERROR-HOLD. SQ2254.2 +053100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2254.2 +053200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2254.2 +053300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2254.2 +053400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2254.2 +053500 PERFORM WRITE-LINE. SQ2254.2 +053600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2254.2 +053700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2254.2 +053800 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +053900 ELSE SQ2254.2 +054000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2254.2 +054100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2254.2 +054200 PERFORM WRITE-LINE. SQ2254.2 +054300 END-ROUTINE-13. SQ2254.2 +054400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2254.2 +054500 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +054600 ELSE SQ2254.2 +054700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2254.2 +054800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2254.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2254.2 +055000 PERFORM WRITE-LINE. SQ2254.2 +055100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2254.2 +055200 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +055300 ELSE SQ2254.2 +055400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2254.2 +055500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2254.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +055700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +055800* SQ2254.2 +055900 WRITE-LINE. SQ2254.2 +056000 ADD 1 TO RECORD-COUNT. SQ2254.2 +056100Y IF RECORD-COUNT GREATER 50 SQ2254.2 +056200Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2254.2 +056300Y MOVE SPACE TO DUMMY-RECORD SQ2254.2 +056400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2254.2 +056500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2254.2 +056600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2254.2 +056700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2254.2 +056800Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2254.2 +056900Y MOVE ZERO TO RECORD-COUNT. SQ2254.2 +057000 PERFORM WRT-LN. SQ2254.2 +057100* SQ2254.2 +057200 WRT-LN. SQ2254.2 +057300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2254.2 +057400 MOVE SPACE TO DUMMY-RECORD. SQ2254.2 +057500 BLANK-LINE-PRINT. SQ2254.2 +057600 PERFORM WRT-LN. SQ2254.2 +057700 FAIL-ROUTINE. SQ2254.2 +057800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2254.2 +057900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2254.2 +058000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +058100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2254.2 +058200 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +058300 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +058400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +058500 GO TO FAIL-ROUTINE-EX. SQ2254.2 +058600 FAIL-ROUTINE-WRITE. SQ2254.2 +058700 MOVE TEST-COMPUTED TO PRINT-REC SQ2254.2 +058800 PERFORM WRITE-LINE SQ2254.2 +058900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2254.2 +059000 MOVE TEST-CORRECT TO PRINT-REC SQ2254.2 +059100 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +059200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2254.2 +059300 FAIL-ROUTINE-EX. SQ2254.2 +059400 EXIT. SQ2254.2 +059500 BAIL-OUT. SQ2254.2 +059600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2254.2 +059700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2254.2 +059800 BAIL-OUT-WRITE. SQ2254.2 +059900 MOVE CORRECT-A TO XXCORRECT. SQ2254.2 +060000 MOVE COMPUTED-A TO XXCOMPUTED. SQ2254.2 +060100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +060200 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +060300 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +060400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +060500 BAIL-OUT-EX. SQ2254.2 +060600 EXIT. SQ2254.2 +060700 CCVS1-EXIT. SQ2254.2 +060800 EXIT. SQ2254.2 +060900* SQ2254.2 +061000**************************************************************** SQ2254.2 +061100* * SQ2254.2 +061200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2254.2 +061300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2254.2 +061400* * SQ2254.2 +061500**************************************************************** SQ2254.2 +061600* SQ2254.2 +061700 SECT-SQ225A-MAIN SECTION. SQ2254.2 +061800 OPEN-INIT-01. SQ2254.2 +061900* SQ2254.2 +062000* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ2254.2 +062100* PRESENT AND AVAILABLE TO IT. SQ2254.2 +062200* SQ2254.2 +062300 MOVE 9 TO DECL-EXEC-SW SQ2254.2 +062400 MOVE "**" TO SQ-FS1-STATUS. SQ2254.2 +062500 OPEN-TEST-01. SQ2254.2 +062600 OPEN EXTEND SQ-FS1. SQ2254.2 +062700 MOVE 1 TO REC-CT SQ2254.2 +062800 MOVE "OPEN ABSENT FILE EXTEND" TO FEATURE SQ2254.2 +062900 MOVE "OPEN-TEST-01" TO PAR-NAME SQ2254.2 +063000 IF DECL-EXEC-SW = 0 SQ2254.2 +063100 PERFORM PASS SQ2254.2 +063200 ELSE SQ2254.2 +063300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ2254.2 +063400 MOVE ZERO TO CORRECT-18V0 SQ2254.2 +063500 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ2254.2 +063600 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ2254.2 +063700 PERFORM FAIL. SQ2254.2 +063800* SQ2254.2 +063900 ADD 1 TO REC-CT. SQ2254.2 +064000 IF SQ-FS1-STATUS NOT = "35" SQ2254.2 +064100 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ2254.2 +064200 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ2254.2 +064300 MOVE "35" TO CORRECT-A SQ2254.2 +064400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2254.2 +064500 PERFORM FAIL SQ2254.2 +064600 ELSE SQ2254.2 +064700 PERFORM PASS. SQ2254.2 +064800* SQ2254.2 +064900* SQ2254.2 +065000 CCVS-EXIT SECTION. SQ2254.2 +065100 CCVS-999999. SQ2254.2 +065200 GO TO CLOSE-FILES. SQ2254.2 +*END-OF,SQ225A +*HEADER,COBOL,SQ226A +000100 IDENTIFICATION DIVISION. SQ2264.2 +000200 PROGRAM-ID. SQ2264.2 +000300 SQ226A. SQ2264.2 +000400**************************************************************** SQ2264.2 +000500* * SQ2264.2 +000600* VALIDATION FOR:- * SQ2264.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2264.2 +000900* REVISED 1986, AUGUST * SQ2264.2 +001000* * SQ2264.2 +001100* CREATION DATE / VALIDATION DATE * SQ2264.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2264.2 +001300* * SQ2264.2 +001400**************************************************************** SQ2264.2 +001500* * SQ2264.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2264.2 +001700* * SQ2264.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2264.2 +001900* X-55 SYSTEM PRINTER * SQ2264.2 +002000* X-82 SOURCE-COMPUTER * SQ2264.2 +002100* X-83 OBJECT-COMPUTER. * SQ2264.2 +002200* * SQ2264.2 +002300**************************************************************** SQ2264.2 +002400* * SQ2264.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ2264.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ2264.2 +002700* THE FILE. THE FILE IS THEN OPENED FOR INPUT, AND TWO * SQ2264.2 +002800* READ STATEMENTS EXECUTED. THE SECOND SHOULD CAUSE AN * SQ2264.2 +002900* AT END CONDITION. AN OPEN EXTEND STATEMENT IS THEN * SQ2264.2 +003000* EXECUTED. THIS SHOULD CAUSE AN EXCEPTION CONDITION, * SQ2264.2 +003100* WITH I-O STATUS "41" AND ENTRY TO THE APPLICABLE ERROR * SQ2264.2 +003200* DECLARATIVE. THERE ARE DECLARATIVES FOR ALL FOUR OPEN * SQ2264.2 +003300* MODES, AND EITHER THE "INPUT" OR THE "EXTEND" DECLARATIVE * SQ2264.2 +003400* COULD BE CONSIDERED APPLICABLE. THE STANDARD IS * SQ2264.2 +003500* AMBIGUOUS ON THIS POINT, SEE PAGE VII-51, 4.6.4, GENERAL * SQ2264.2 +003600* RULE (5), SUB-RULES B AND E. THE PROGRAM ACCEPTS * SQ2264.2 +003700* EXECUTION OF EITHER DECLARATIVE AS CORRECT, SO LONG AS * SQ2264.2 +003800* ONLY ONE OF THEM IS EXECUTED. * SQ2264.2 +003900* * SQ2264.2 +004000**************************************************************** SQ2264.2 +004100* SQ2264.2 +004200 ENVIRONMENT DIVISION. SQ2264.2 +004300 CONFIGURATION SECTION. SQ2264.2 +004400 SOURCE-COMPUTER. SQ2264.2 +004500 XXXXX082. SQ2264.2 +004600 OBJECT-COMPUTER. SQ2264.2 +004700 XXXXX083. SQ2264.2 +004800* SQ2264.2 +004900 INPUT-OUTPUT SECTION. SQ2264.2 +005000 FILE-CONTROL. SQ2264.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ2264.2 +005200 XXXXX055. SQ2264.2 +005300* SQ2264.2 +005400P SELECT RAW-DATA ASSIGN TO SQ2264.2 +005500P XXXXX062 SQ2264.2 +005600P ORGANIZATION IS INDEXED SQ2264.2 +005700P ACCESS MODE IS RANDOM SQ2264.2 +005800P RECORD-KEY IS RAW-DATA-KEY. SQ2264.2 +005900P SQ2264.2 +006000 SELECT SQ-FS4 SQ2264.2 +006100 RESERVE 1 SQ2264.2 +006200 ASSIGN SQ2264.2 +006300 XXXXX014 SQ2264.2 +006400 SEQUENTIAL SQ2264.2 +006500 STATUS IS SQ-FS4-STATUS OF STATUS-GROUP. SQ2264.2 +006600* SQ2264.2 +006700* SQ2264.2 +006800 DATA DIVISION. SQ2264.2 +006900 FILE SECTION. SQ2264.2 +007000 FD PRINT-FILE SQ2264.2 +007100C LABEL RECORDS SQ2264.2 +007200C XXXXX084 SQ2264.2 +007300C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2264.2 +007400 . SQ2264.2 +007500 01 PRINT-REC PICTURE X(120). SQ2264.2 +007600 01 DUMMY-RECORD PICTURE X(120). SQ2264.2 +007700P SQ2264.2 +007800PFD RAW-DATA. SQ2264.2 +007900P01 RAW-DATA-SATZ. SQ2264.2 +008000P 05 RAW-DATA-KEY PIC X(6). SQ2264.2 +008100P 05 C-DATE PIC 9(6). SQ2264.2 +008200P 05 C-TIME PIC 9(8). SQ2264.2 +008300P 05 NO-OF-TESTS PIC 99. SQ2264.2 +008400P 05 C-OK PIC 999. SQ2264.2 +008500P 05 C-ALL PIC 999. SQ2264.2 +008600P 05 C-FAIL PIC 999. SQ2264.2 +008700P 05 C-DELETED PIC 999. SQ2264.2 +008800P 05 C-INSPECT PIC 999. SQ2264.2 +008900P 05 C-NOTE PIC X(13). SQ2264.2 +009000P 05 C-INDENT PIC X. SQ2264.2 +009100P 05 C-ABORT PIC X(8). SQ2264.2 +009200* SQ2264.2 +009300 FD SQ-FS4 SQ2264.2 +009400C LABEL RECORD IS STANDARD SQ2264.2 +009500 BLOCK 120 SQ2264.2 +009600 RECORD 120 SQ2264.2 +009700 . SQ2264.2 +009800 01 SQ-FS4R1-F-G-120. SQ2264.2 +009900 05 FFILE-RECORD-INFO-P1-120. SQ2264.2 +010000 07 FILLER PIC X(5). SQ2264.2 +010100 07 FFILE-NAME PIC X(6). SQ2264.2 +010200 07 FILLER PIC X(8). SQ2264.2 +010300 07 FRECORD-NAME PIC X(6). SQ2264.2 +010400 07 FILLER PIC X(1). SQ2264.2 +010500 07 FREELUNIT-NUMBER PIC 9(1). SQ2264.2 +010600 07 FILLER PIC X(7). SQ2264.2 +010700 07 FRECORD-NUMBER PIC 9(6). SQ2264.2 +010800 07 FILLER PIC X(6). SQ2264.2 +010900 07 FUPDATE-NUMBER PIC 9(2). SQ2264.2 +011000 07 FILLER PIC X(5). SQ2264.2 +011100 07 FODO-NUMBER PIC 9(4). SQ2264.2 +011200 07 FILLER PIC X(5). SQ2264.2 +011300 07 FPROGRAM-NAME PIC X(5). SQ2264.2 +011400 07 FILLER PIC X(7). SQ2264.2 +011500 07 FRECORD-LENGTH PIC 9(6). SQ2264.2 +011600 07 FILLER PIC X(7). SQ2264.2 +011700 07 FCHARS-OR-RECORDS PIC X(2). SQ2264.2 +011800 07 FILLER PIC X(1). SQ2264.2 +011900 07 FBLOCK-SIZE PIC 9(4). SQ2264.2 +012000 07 FILLER PIC X(6). SQ2264.2 +012100 07 FRECORDS-IN-FILE PIC 9(6). SQ2264.2 +012200 07 FILLER PIC X(5). SQ2264.2 +012300 07 FFILE-ORGANIZATION PIC X(2). SQ2264.2 +012400 07 FILLER PIC X(6). SQ2264.2 +012500 07 FLABEL-TYPE PIC X(1). SQ2264.2 +012600* SQ2264.2 +012700 WORKING-STORAGE SECTION. SQ2264.2 +012800* SQ2264.2 +012900*************************************************************** SQ2264.2 +013000* * SQ2264.2 +013100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2264.2 +013200* * SQ2264.2 +013300*************************************************************** SQ2264.2 +013400* SQ2264.2 +013500 01 STATUS-GROUP. SQ2264.2 +013600 04 SQ-FS4-STATUS. SQ2264.2 +013700 07 SQ-FS4-KEY-1 PIC X. SQ2264.2 +013800 07 SQ-FS4-KEY-2 PIC X. SQ2264.2 +013900* SQ2264.2 +014000 01 DELETE-SW. SQ2264.2 +014100 03 DELETE-SW-1 PIC X. SQ2264.2 +014200 03 DELETE-SW-1-GROUP. SQ2264.2 +014300 05 DELETE-SW-2 PIC X. SQ2264.2 +014400* SQ2264.2 +014500 01 DECL-EXEC-E PIC X(12). SQ2264.2 +014600 01 DECL-EXEC-I PIC X(12). SQ2264.2 +014700 01 DECL-EXEC-I-O PIC X(12). SQ2264.2 +014800 01 DECL-EXEC-O PIC X(12). SQ2264.2 +014900* SQ2264.2 +015000 01 DECL-EXEC-SW PIC X. SQ2264.2 +015100 01 DECL-EXEC-CT PIC 9. SQ2264.2 +015200* SQ2264.2 +015300*************************************************************** SQ2264.2 +015400* * SQ2264.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2264.2 +015600* * SQ2264.2 +015700*************************************************************** SQ2264.2 +015800* SQ2264.2 +015900 01 REC-SKEL-SUB PIC 99. SQ2264.2 +016000* SQ2264.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ2264.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ2264.2 +016300 05 FILLER PICTURE X(48) VALUE SQ2264.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2264.2 +016500 05 FILLER PICTURE X(46) VALUE SQ2264.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2264.2 +016700 05 FILLER PICTURE X(26) VALUE SQ2264.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ2264.2 +016900 05 FILLER PICTURE X(37) VALUE SQ2264.2 +017000 ",RECKEY= ". SQ2264.2 +017100 05 FILLER PICTURE X(38) VALUE SQ2264.2 +017200 ",ALTKEY1= ". SQ2264.2 +017300 05 FILLER PICTURE X(38) VALUE SQ2264.2 +017400 ",ALTKEY2= ". SQ2264.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2264.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2264.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ2264.2 +017800 07 FILLER PIC X(5). SQ2264.2 +017900 07 XFILE-NAME PIC X(6). SQ2264.2 +018000 07 FILLER PIC X(8). SQ2264.2 +018100 07 XRECORD-NAME PIC X(6). SQ2264.2 +018200 07 FILLER PIC X(1). SQ2264.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ2264.2 +018400 07 FILLER PIC X(7). SQ2264.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ2264.2 +018600 07 FILLER PIC X(6). SQ2264.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ2264.2 +018800 07 FILLER PIC X(5). SQ2264.2 +018900 07 ODO-NUMBER PIC 9(4). SQ2264.2 +019000 07 FILLER PIC X(5). SQ2264.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ2264.2 +019200 07 FILLER PIC X(7). SQ2264.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ2264.2 +019400 07 FILLER PIC X(7). SQ2264.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ2264.2 +019600 07 FILLER PIC X(1). SQ2264.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ2264.2 +019800 07 FILLER PIC X(6). SQ2264.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ2264.2 +020000 07 FILLER PIC X(5). SQ2264.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ2264.2 +020200 07 FILLER PIC X(6). SQ2264.2 +020300 07 XLABEL-TYPE PIC X(1). SQ2264.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ2264.2 +020500 07 FILLER PIC X(8). SQ2264.2 +020600 07 XRECORD-KEY PIC X(29). SQ2264.2 +020700 07 FILLER PIC X(9). SQ2264.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ2264.2 +020900 07 FILLER PIC X(9). SQ2264.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ2264.2 +021100 07 FILLER PIC X(7). SQ2264.2 +021200* SQ2264.2 +021300 01 TEST-RESULTS. SQ2264.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2264.2 +021500 02 PAR-NAME. SQ2264.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ2264.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ2264.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2264.2 +021900 02 FILLER PIC X VALUE SPACE. SQ2264.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ2264.2 +022100 02 FILLER PIC X VALUE SPACE. SQ2264.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2264.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ2264.2 +022400 02 RE-MARK PIC X(61). SQ2264.2 +022500 01 TEST-COMPUTED. SQ2264.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ2264.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2264.2 +022800 02 COMPUTED-X. SQ2264.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2264.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2264.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2264.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2264.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2264.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2264.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ2264.2 +023600 04 FILLER PIC X. SQ2264.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ2264.2 +023800 01 TEST-CORRECT. SQ2264.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ2264.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2264.2 +024100 02 CORRECT-X. SQ2264.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2264.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2264.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2264.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2264.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2264.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ2264.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ2264.2 +024900 04 FILLER PIC X. SQ2264.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ2264.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2264.2 +025200* SQ2264.2 +025300 01 CCVS-C-1. SQ2264.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2264.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2264.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2264.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2264.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2264.2 +026200 01 CCVS-C-2. SQ2264.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ2264.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ2264.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ2264.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ2264.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ2264.2 +026800* SQ2264.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2264.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ2264.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2264.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2264.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2264.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2264.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2264.2 +028000 01 CCVS-H-1. SQ2264.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ2264.2 +028200 02 FILLER PIC X(42) VALUE SQ2264.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2264.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ2264.2 +028500 01 CCVS-H-2A. SQ2264.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ2264.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2264.2 +028800 02 FILLER PIC XXXX VALUE SQ2264.2 +028900 "4.2 ". SQ2264.2 +029000 02 FILLER PIC X(28) VALUE SQ2264.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ2264.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ2264.2 +029300* SQ2264.2 +029400 01 CCVS-H-2B. SQ2264.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2264.2 +029600 02 TEST-ID PIC X(9). SQ2264.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ2264.2 +029800 02 FILLER PIC X(12) VALUE SQ2264.2 +029900 " HIGH ". SQ2264.2 +030000 02 FILLER PIC X(22) VALUE SQ2264.2 +030100 " LEVEL VALIDATION FOR ". SQ2264.2 +030200 02 FILLER PIC X(58) VALUE SQ2264.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +030400 01 CCVS-H-3. SQ2264.2 +030500 02 FILLER PIC X(34) VALUE SQ2264.2 +030600 " FOR OFFICIAL USE ONLY ". SQ2264.2 +030700 02 FILLER PIC X(58) VALUE SQ2264.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2264.2 +030900 02 FILLER PIC X(28) VALUE SQ2264.2 +031000 " COPYRIGHT 1985,1986 ". SQ2264.2 +031100 01 CCVS-E-1. SQ2264.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ2264.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2264.2 +031400 02 ID-AGAIN PIC X(9). SQ2264.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ2264.2 +031600 01 CCVS-E-2. SQ2264.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ2264.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ2264.2 +031900 02 CCVS-E-2-2. SQ2264.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2264.2 +032100 03 FILLER PIC X VALUE SPACE. SQ2264.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ2264.2 +032300 "ERRORS ENCOUNTERED". SQ2264.2 +032400 01 CCVS-E-3. SQ2264.2 +032500 02 FILLER PIC X(22) VALUE SQ2264.2 +032600 " FOR OFFICIAL USE ONLY". SQ2264.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ2264.2 +032800 02 FILLER PIC X(58) VALUE SQ2264.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ2264.2 +033100 02 FILLER PIC X(20) VALUE SQ2264.2 +033200 " COPYRIGHT 1985,1986". SQ2264.2 +033300 01 CCVS-E-4. SQ2264.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2264.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ2264.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2264.2 +033700 02 FILLER PIC X(40) VALUE SQ2264.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2264.2 +033900 01 XXINFO. SQ2264.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2264.2 +034100 02 INFO-TEXT. SQ2264.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ2264.2 +034300 04 XXCOMPUTED PIC X(20). SQ2264.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ2264.2 +034500 04 XXCORRECT PIC X(20). SQ2264.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ2264.2 +034700 01 HYPHEN-LINE. SQ2264.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ2264.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2264.2 +035000- "*****************************************". SQ2264.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2264.2 +035200- "******************************". SQ2264.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2264.2 +035400 "SQ226A". SQ2264.2 +035500* SQ2264.2 +035600* SQ2264.2 +035700 PROCEDURE DIVISION. SQ2264.2 +035800 DECLARATIVES. SQ2264.2 +035900* SQ2264.2 +036000* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ2264.2 +036100* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ2264.2 +036200* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ2264.2 +036300* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ2264.2 +036400* SQ2264.2 +036500 SECT-SQ226A-0000 SECTION. SQ2264.2 +036600 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ2264.2 +036700 PRINT-FILE-ERROR-PROCESS. SQ2264.2 +036800 EXIT. SQ2264.2 +036900* SQ2264.2 +037000 SECT-SQ226A-0001 SECTION. SQ2264.2 +037100 USE AFTER EXCEPTION PROCEDURE EXTEND. SQ2264.2 +037200 EXTEND-ERROR-PROCESS. SQ2264.2 +037300 MOVE "EXECUTED" TO DECL-EXEC-E. SQ2264.2 +037400 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +037500 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +037600* SQ2264.2 +037700 SECT-SQ226A-0002 SECTION. SQ2264.2 +037800 USE AFTER STANDARD ERROR PROCEDURE ON INPUT. SQ2264.2 +037900 INPUT-ERROR-PROCESS. SQ2264.2 +038000 MOVE "EXECUTED" TO DECL-EXEC-I. SQ2264.2 +038100 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +038200 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +038300* SQ2264.2 +038400 SECT-SQ226A-0003 SECTION. SQ2264.2 +038500 USE AFTER EXCEPTION PROCEDURE I-O. SQ2264.2 +038600 I-O-ERROR-PROCESS. SQ2264.2 +038700 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +038800 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +038900 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +039000* SQ2264.2 +039100 SECT-SQ226A-0004 SECTION. SQ2264.2 +039200 USE AFTER ERROR PROCEDURE OUTPUT. SQ2264.2 +039300 OUTPUT-ERROR-PROCESS. SQ2264.2 +039400 IF DECL-EXEC-CT = 0 SQ2264.2 +039500 MOVE "EXECUTED" TO DECL-EXEC-O SQ2264.2 +039600 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +039700* SQ2264.2 +039800 IF DECL-EXEC-SW NOT = SPACE SQ2264.2 +039900 GO TO END-DECLS. SQ2264.2 +040000* SQ2264.2 +040100 MOVE 1 TO REC-CT. SQ2264.2 +040200 MOVE "OPEN EXTEND OPEN FILE" TO FEATURE. SQ2264.2 +040300 MOVE "DECL-OPEN-02" TO PAR-NAME. SQ2264.2 +040400 GO TO DECL-OPEN-02. SQ2264.2 +040500 DECL-DELETE-02. SQ2264.2 +040600 PERFORM DECL-DE-LETE. SQ2264.2 +040700 GO TO DECL-TEST-01-END. SQ2264.2 +040800 DECL-OPEN-02. SQ2264.2 +040900 IF SQ-FS4-STATUS = "41" SQ2264.2 +041000 PERFORM DECL-PASS SQ2264.2 +041100 ELSE SQ2264.2 +041200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +041300 MOVE "41" TO CORRECT-A SQ2264.2 +041400 MOVE "UNEXPECTED I-O STATUS ON OPEN OF OPEN FILE" SQ2264.2 +041500 TO RE-MARK SQ2264.2 +041600 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ2264.2 +041700 PERFORM DECL-FAIL. SQ2264.2 +041800 DECL-TEST-01-END. SQ2264.2 +041900* SQ2264.2 +042000 PERFORM DECL-WRITE-LINE. SQ2264.2 +042100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2264.2 +042200 TO DUMMY-RECORD. SQ2264.2 +042300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2264.2 +042400 GO TO END-DECLS. SQ2264.2 +042500* SQ2264.2 +042600* SQ2264.2 +042700 DECL-PASS. SQ2264.2 +042800 MOVE "PASS " TO P-OR-F. SQ2264.2 +042900 ADD 1 TO PASS-COUNTER. SQ2264.2 +043000 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +043100* SQ2264.2 +043200 DECL-FAIL. SQ2264.2 +043300 MOVE "FAIL*" TO P-OR-F. SQ2264.2 +043400 ADD 1 TO ERROR-COUNTER. SQ2264.2 +043500 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +043600* SQ2264.2 +043700 DECL-DE-LETE. SQ2264.2 +043800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2264.2 +043900 MOVE "*****" TO P-OR-F. SQ2264.2 +044000 ADD 1 TO DELETE-COUNTER. SQ2264.2 +044100 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +044200* SQ2264.2 +044300 DECL-PRINT-DETAIL. SQ2264.2 +044400 IF REC-CT NOT EQUAL TO ZERO SQ2264.2 +044500 MOVE "." TO PARDOT-X SQ2264.2 +044600 MOVE REC-CT TO DOTVALUE. SQ2264.2 +044700 MOVE TEST-RESULTS TO PRINT-REC. SQ2264.2 +044800 PERFORM DECL-WRITE-LINE. SQ2264.2 +044900 IF P-OR-F EQUAL TO "FAIL*" SQ2264.2 +045000 PERFORM DECL-WRITE-LINE SQ2264.2 +045100 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2264.2 +045200 ELSE SQ2264.2 +045300 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2264.2 +045400 MOVE SPACE TO P-OR-F. SQ2264.2 +045500 MOVE SPACE TO COMPUTED-X. SQ2264.2 +045600 MOVE SPACE TO CORRECT-X. SQ2264.2 +045700 IF REC-CT EQUAL TO ZERO SQ2264.2 +045800 MOVE SPACE TO PAR-NAME. SQ2264.2 +045900 MOVE SPACE TO RE-MARK. SQ2264.2 +046000* SQ2264.2 +046100 DECL-WRITE-LINE. SQ2264.2 +046200 ADD 1 TO RECORD-COUNT. SQ2264.2 +046300Y IF RECORD-COUNT GREATER 50 SQ2264.2 +046400Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2264.2 +046500Y MOVE SPACE TO DUMMY-RECORD SQ2264.2 +046600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2264.2 +046700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2264.2 +046800Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2264.2 +046900Y PERFORM DECL-WRT-LN 2 TIMES SQ2264.2 +047000Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2264.2 +047100Y PERFORM DECL-WRT-LN SQ2264.2 +047200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2264.2 +047300Y MOVE ZERO TO RECORD-COUNT. SQ2264.2 +047400 PERFORM DECL-WRT-LN. SQ2264.2 +047500* SQ2264.2 +047600 DECL-WRT-LN. SQ2264.2 +047700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2264.2 +047800 MOVE SPACE TO DUMMY-RECORD. SQ2264.2 +047900* SQ2264.2 +048000 DECL-FAIL-ROUTINE. SQ2264.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2264.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2264.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2264.2 +048500 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +048600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +048800 GO TO DECL-FAIL-EX. SQ2264.2 +048900 DECL-FAIL-WRITE. SQ2264.2 +049000 MOVE TEST-COMPUTED TO PRINT-REC SQ2264.2 +049100 PERFORM DECL-WRITE-LINE SQ2264.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2264.2 +049300 MOVE TEST-CORRECT TO PRINT-REC SQ2264.2 +049400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +049500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2264.2 +049600 DECL-FAIL-EX. SQ2264.2 +049700 EXIT. SQ2264.2 +049800* SQ2264.2 +049900 DECL-BAIL. SQ2264.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2264.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2264.2 +050200 DECL-BAIL-WRITE. SQ2264.2 +050300 MOVE CORRECT-A TO XXCORRECT. SQ2264.2 +050400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2264.2 +050500 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +050600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +050700 DECL-BAIL-EX. SQ2264.2 +050800 EXIT. SQ2264.2 +050900* SQ2264.2 +051000 END-DECLS. SQ2264.2 +051100 END DECLARATIVES. SQ2264.2 +051200* SQ2264.2 +051300* SQ2264.2 +051400 CCVS1 SECTION. SQ2264.2 +051500 OPEN-FILES. SQ2264.2 +051600P OPEN I-O RAW-DATA. SQ2264.2 +051700P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2264.2 +051800P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2264.2 +051900P MOVE "ABORTED " TO C-ABORT. SQ2264.2 +052000P ADD 1 TO C-NO-OF-TESTS. SQ2264.2 +052100P ACCEPT C-DATE FROM DATE. SQ2264.2 +052200P ACCEPT C-TIME FROM TIME. SQ2264.2 +052300P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2264.2 +052400PEND-E-1. SQ2264.2 +052500P CLOSE RAW-DATA. SQ2264.2 +052600 OPEN OUTPUT PRINT-FILE. SQ2264.2 +052700 MOVE CCVS-PGM-ID TO TEST-ID. SQ2264.2 +052800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2264.2 +052900 MOVE SPACE TO TEST-RESULTS. SQ2264.2 +053000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2264.2 +053100 MOVE ZERO TO REC-SKEL-SUB. SQ2264.2 +053200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2264.2 +053300 GO TO CCVS1-EXIT. SQ2264.2 +053400* SQ2264.2 +053500 CCVS-INIT-FILE. SQ2264.2 +053600 ADD 1 TO REC-SKL-SUB. SQ2264.2 +053700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2264.2 +053800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2264.2 +053900* SQ2264.2 +054000 CLOSE-FILES. SQ2264.2 +054100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2264.2 +054200 CLOSE PRINT-FILE. SQ2264.2 +054300P OPEN I-O RAW-DATA. SQ2264.2 +054400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2264.2 +054500P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2264.2 +054600P MOVE "OK. " TO C-ABORT. SQ2264.2 +054700P MOVE PASS-COUNTER TO C-OK. SQ2264.2 +054800P MOVE ERROR-HOLD TO C-ALL. SQ2264.2 +054900P MOVE ERROR-COUNTER TO C-FAIL. SQ2264.2 +055000P MOVE DELETE-CNT TO C-DELETED. SQ2264.2 +055100P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2264.2 +055200P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2264.2 +055300PEND-E-2. SQ2264.2 +055400P CLOSE RAW-DATA. SQ2264.2 +055500 TERMINATE-CCVS. SQ2264.2 +055600S EXIT PROGRAM. SQ2264.2 +055700 STOP RUN. SQ2264.2 +055800* SQ2264.2 +055900 INSPT. SQ2264.2 +056000 MOVE "INSPT" TO P-OR-F. SQ2264.2 +056100 ADD 1 TO INSPECT-COUNTER. SQ2264.2 +056200 PERFORM PRINT-DETAIL. SQ2264.2 +056300* SQ2264.2 +056400 PASS. SQ2264.2 +056500 MOVE "PASS " TO P-OR-F. SQ2264.2 +056600 ADD 1 TO PASS-COUNTER. SQ2264.2 +056700 PERFORM PRINT-DETAIL. SQ2264.2 +056800* SQ2264.2 +056900 FAIL. SQ2264.2 +057000 MOVE "FAIL*" TO P-OR-F. SQ2264.2 +057100 ADD 1 TO ERROR-COUNTER. SQ2264.2 +057200 PERFORM PRINT-DETAIL. SQ2264.2 +057300* SQ2264.2 +057400 DE-LETE. SQ2264.2 +057500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2264.2 +057600 MOVE "*****" TO P-OR-F. SQ2264.2 +057700 ADD 1 TO DELETE-COUNTER. SQ2264.2 +057800 PERFORM PRINT-DETAIL. SQ2264.2 +057900* SQ2264.2 +058000 PRINT-DETAIL. SQ2264.2 +058100 IF REC-CT NOT EQUAL TO ZERO SQ2264.2 +058200 MOVE "." TO PARDOT-X SQ2264.2 +058300 MOVE REC-CT TO DOTVALUE. SQ2264.2 +058400 MOVE TEST-RESULTS TO PRINT-REC. SQ2264.2 +058500 PERFORM WRITE-LINE. SQ2264.2 +058600 IF P-OR-F EQUAL TO "FAIL*" SQ2264.2 +058700 PERFORM WRITE-LINE SQ2264.2 +058800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2264.2 +058900 ELSE SQ2264.2 +059000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2264.2 +059100 MOVE SPACE TO P-OR-F. SQ2264.2 +059200 MOVE SPACE TO COMPUTED-X. SQ2264.2 +059300 MOVE SPACE TO CORRECT-X. SQ2264.2 +059400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2264.2 +059500 MOVE SPACE TO RE-MARK. SQ2264.2 +059600* SQ2264.2 +059700 HEAD-ROUTINE. SQ2264.2 +059800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +059900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +060000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2264.2 +060100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2264.2 +060200 COLUMN-NAMES-ROUTINE. SQ2264.2 +060300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +060400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +060600 END-ROUTINE. SQ2264.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2264.2 +060800 PERFORM WRITE-LINE 5 TIMES. SQ2264.2 +060900 END-RTN-EXIT. SQ2264.2 +061000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2264.2 +061100 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +061200* SQ2264.2 +061300 END-ROUTINE-1. SQ2264.2 +061400 ADD ERROR-COUNTER TO ERROR-HOLD SQ2264.2 +061500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2264.2 +061600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2264.2 +061700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2264.2 +061800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2264.2 +061900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2264.2 +062000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2264.2 +062100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2264.2 +062200 PERFORM WRITE-LINE. SQ2264.2 +062300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2264.2 +062400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2264.2 +062500 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +062600 ELSE SQ2264.2 +062700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2264.2 +062800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2264.2 +062900 PERFORM WRITE-LINE. SQ2264.2 +063000 END-ROUTINE-13. SQ2264.2 +063100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2264.2 +063200 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +063300 ELSE SQ2264.2 +063400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2264.2 +063500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2264.2 +063600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2264.2 +063700 PERFORM WRITE-LINE. SQ2264.2 +063800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2264.2 +063900 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +064000 ELSE SQ2264.2 +064100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2264.2 +064200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2264.2 +064300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +064400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +064500* SQ2264.2 +064600 WRITE-LINE. SQ2264.2 +064700 ADD 1 TO RECORD-COUNT. SQ2264.2 +064800Y IF RECORD-COUNT GREATER 50 SQ2264.2 +064900Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2264.2 +065000Y MOVE SPACE TO DUMMY-RECORD SQ2264.2 +065100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2264.2 +065200Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2264.2 +065300Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2264.2 +065400Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2264.2 +065500Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2264.2 +065600Y MOVE ZERO TO RECORD-COUNT. SQ2264.2 +065700 PERFORM WRT-LN. SQ2264.2 +065800* SQ2264.2 +065900 WRT-LN. SQ2264.2 +066000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2264.2 +066100 MOVE SPACE TO DUMMY-RECORD. SQ2264.2 +066200 BLANK-LINE-PRINT. SQ2264.2 +066300 PERFORM WRT-LN. SQ2264.2 +066400 FAIL-ROUTINE. SQ2264.2 +066500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2264.2 +066600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2264.2 +066700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +066800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2264.2 +066900 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +067000 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +067100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +067200 GO TO FAIL-ROUTINE-EX. SQ2264.2 +067300 FAIL-ROUTINE-WRITE. SQ2264.2 +067400 MOVE TEST-COMPUTED TO PRINT-REC SQ2264.2 +067500 PERFORM WRITE-LINE SQ2264.2 +067600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2264.2 +067700 MOVE TEST-CORRECT TO PRINT-REC SQ2264.2 +067800 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +067900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2264.2 +068000 FAIL-ROUTINE-EX. SQ2264.2 +068100 EXIT. SQ2264.2 +068200 BAIL-OUT. SQ2264.2 +068300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2264.2 +068400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2264.2 +068500 BAIL-OUT-WRITE. SQ2264.2 +068600 MOVE CORRECT-A TO XXCORRECT. SQ2264.2 +068700 MOVE COMPUTED-A TO XXCOMPUTED. SQ2264.2 +068800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +068900 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +069000 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +069100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +069200 BAIL-OUT-EX. SQ2264.2 +069300 EXIT. SQ2264.2 +069400 CCVS1-EXIT. SQ2264.2 +069500 EXIT. SQ2264.2 +069600* SQ2264.2 +069700**************************************************************** SQ2264.2 +069800* * SQ2264.2 +069900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2264.2 +070000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2264.2 +070100* * SQ2264.2 +070200**************************************************************** SQ2264.2 +070300* SQ2264.2 +070400 SECT-SQ226A-0005 SECTION. SQ2264.2 +070500 STA-INIT. SQ2264.2 +070600 MOVE SPACE TO DELETE-SW. SQ2264.2 +070700* SQ2264.2 +070800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2264.2 +070900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2264.2 +071000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2264.2 +071100 MOVE 120 TO XRECORD-LENGTH (1). SQ2264.2 +071200 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2264.2 +071300 MOVE 1 TO XBLOCK-SIZE (1). SQ2264.2 +071400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2264.2 +071500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2264.2 +071600 MOVE "S" TO XLABEL-TYPE (1). SQ2264.2 +071700* SQ2264.2 +071800* OPEN THE FILE IN THE OUTPUT MODE SQ2264.2 +071900* SQ2264.2 +072000 SEQ-INIT-01. SQ2264.2 +072100 MOVE 0 TO REC-CT. SQ2264.2 +072200 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +072300 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +072400 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +072500 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +072600 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +072700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +072800 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +072900 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +073000 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2264.2 +073100 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2264.2 +073200 GO TO SEQ-TEST-OP-01. SQ2264.2 +073300 SEQ-DELETE-01. SQ2264.2 +073400 MOVE "*" TO DELETE-SW-1. SQ2264.2 +073500 GO TO SEQ-DELETE-01-01. SQ2264.2 +073600 SEQ-TEST-OP-01. SQ2264.2 +073700 OPEN OUTPUT SQ-FS4. SQ2264.2 +073800* SQ2264.2 +073900* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ2264.2 +074000* SQ2264.2 +074100 ADD 1 TO REC-CT. SQ2264.2 +074200 IF DELETE-SW NOT = SPACE SQ2264.2 +074300 GO TO SEQ-DELETE-01-01. SQ2264.2 +074400 GO TO SEQ-TEST-OP-01-01. SQ2264.2 +074500 SEQ-DELETE-01-01. SQ2264.2 +074600 PERFORM DE-LETE. SQ2264.2 +074700 GO TO SEQ-TEST-01-01-END. SQ2264.2 +074800 SEQ-TEST-OP-01-01. SQ2264.2 +074900 IF SQ-FS4-STATUS = "00" SQ2264.2 +075000 PERFORM PASS SQ2264.2 +075100 ELSE SQ2264.2 +075200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +075300 MOVE "00" TO CORRECT-A SQ2264.2 +075400 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ2264.2 +075500 TO RE-MARK SQ2264.2 +075600 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ2264.2 +075700 PERFORM FAIL. SQ2264.2 +075800 SEQ-TEST-01-01-END. SQ2264.2 +075900* SQ2264.2 +076000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +076100* SQ2264.2 +076200 ADD 1 TO REC-CT. SQ2264.2 +076300 IF DELETE-SW NOT = SPACE SQ2264.2 +076400 GO TO SEQ-DELETE-01-02. SQ2264.2 +076500 GO TO SEQ-TEST-OP-01-02. SQ2264.2 +076600 SEQ-DELETE-01-02. SQ2264.2 +076700 PERFORM DE-LETE. SQ2264.2 +076800 GO TO SEQ-TEST-01-02-END. SQ2264.2 +076900 SEQ-TEST-OP-01-02. SQ2264.2 +077000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +077100 PERFORM PASS SQ2264.2 +077200 ELSE SQ2264.2 +077300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +077400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +077500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +077600 TO RE-MARK SQ2264.2 +077700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +077800 PERFORM FAIL. SQ2264.2 +077900 SEQ-TEST-01-02-END. SQ2264.2 +078000* SQ2264.2 +078100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +078200* SQ2264.2 +078300 ADD 1 TO REC-CT. SQ2264.2 +078400 IF DELETE-SW NOT = SPACE SQ2264.2 +078500 GO TO SEQ-DELETE-01-03. SQ2264.2 +078600 GO TO SEQ-TEST-OP-01-03. SQ2264.2 +078700 SEQ-DELETE-01-03. SQ2264.2 +078800 PERFORM DE-LETE. SQ2264.2 +078900 GO TO SEQ-TEST-01-03-END. SQ2264.2 +079000 SEQ-TEST-OP-01-03. SQ2264.2 +079100 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +079200 PERFORM PASS SQ2264.2 +079300 ELSE SQ2264.2 +079400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +079500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +079600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +079700 TO RE-MARK SQ2264.2 +079800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +079900 PERFORM FAIL. SQ2264.2 +080000 SEQ-TEST-01-03-END. SQ2264.2 +080100* SQ2264.2 +080200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +080300* SQ2264.2 +080400 ADD 1 TO REC-CT. SQ2264.2 +080500 IF DELETE-SW NOT = SPACE SQ2264.2 +080600 GO TO SEQ-DELETE-01-04. SQ2264.2 +080700 GO TO SEQ-TEST-OP-01-04. SQ2264.2 +080800 SEQ-DELETE-01-04. SQ2264.2 +080900 PERFORM DE-LETE. SQ2264.2 +081000 GO TO SEQ-TEST-01-04-END. SQ2264.2 +081100 SEQ-TEST-OP-01-04. SQ2264.2 +081200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +081300 PERFORM PASS SQ2264.2 +081400 ELSE SQ2264.2 +081500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +081600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +081700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +081800 TO RE-MARK SQ2264.2 +081900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +082000 PERFORM FAIL. SQ2264.2 +082100 SEQ-TEST-01-04-END. SQ2264.2 +082200* SQ2264.2 +082300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +082400* SQ2264.2 +082500 ADD 1 TO REC-CT. SQ2264.2 +082600 IF DELETE-SW NOT = SPACE SQ2264.2 +082700 GO TO SEQ-DELETE-01-05. SQ2264.2 +082800 GO TO SEQ-TEST-OP-01-05. SQ2264.2 +082900 SEQ-DELETE-01-05. SQ2264.2 +083000 PERFORM DE-LETE. SQ2264.2 +083100 GO TO SEQ-TEST-01-05-END. SQ2264.2 +083200 SEQ-TEST-OP-01-05. SQ2264.2 +083300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +083400 PERFORM PASS SQ2264.2 +083500 ELSE SQ2264.2 +083600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +083700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +083800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +083900 TO RE-MARK SQ2264.2 +084000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +084100 PERFORM FAIL. SQ2264.2 +084200 SEQ-TEST-01-05-END. SQ2264.2 +084300* SQ2264.2 +084400* SQ2264.2 +084500* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD. SQ2264.2 +084600* SQ2264.2 +084700 SEQ-INIT-02. SQ2264.2 +084800 MOVE 0 TO REC-CT. SQ2264.2 +084900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +085000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +085100 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +085200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +085300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +085400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +085500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +085600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +085700 MOVE "WRITE A RECORD" TO FEATURE. SQ2264.2 +085800 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2264.2 +085900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +086000 GO TO SEQ-DELETE-02. SQ2264.2 +086100 GO TO SEQ-TEST-WR-02. SQ2264.2 +086200 SEQ-DELETE-02. SQ2264.2 +086300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +086400 GO TO SEQ-DELETE-02-01. SQ2264.2 +086500 SEQ-TEST-WR-02. SQ2264.2 +086600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2264.2 +086700 WRITE SQ-FS4R1-F-G-120. SQ2264.2 +086800* SQ2264.2 +086900* CHECK I-O STATUS RETURNED FROM WRITE SQ2264.2 +087000* SQ2264.2 +087100 ADD 1 TO REC-CT. SQ2264.2 +087200 IF DELETE-SW NOT = SPACE SQ2264.2 +087300 GO TO SEQ-DELETE-02-01. SQ2264.2 +087400 GO TO SEQ-TEST-WR-02-01. SQ2264.2 +087500 SEQ-DELETE-02-01. SQ2264.2 +087600 PERFORM DE-LETE. SQ2264.2 +087700 GO TO SEQ-TEST-02-01-END. SQ2264.2 +087800 SEQ-TEST-WR-02-01. SQ2264.2 +087900 IF SQ-FS4-STATUS = "00" SQ2264.2 +088000 PERFORM PASS SQ2264.2 +088100 ELSE SQ2264.2 +088200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +088300 MOVE "00" TO CORRECT-A SQ2264.2 +088400 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ2264.2 +088500 TO RE-MARK SQ2264.2 +088600 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ2264.2 +088700 PERFORM FAIL. SQ2264.2 +088800 SEQ-TEST-02-01-END. SQ2264.2 +088900* SQ2264.2 +089000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +089100* SQ2264.2 +089200 ADD 1 TO REC-CT. SQ2264.2 +089300 IF DELETE-SW NOT = SPACE SQ2264.2 +089400 GO TO SEQ-DELETE-02-02. SQ2264.2 +089500 GO TO SEQ-TEST-WR-02-02. SQ2264.2 +089600 SEQ-DELETE-02-02. SQ2264.2 +089700 PERFORM DE-LETE. SQ2264.2 +089800 GO TO SEQ-TEST-02-02-END. SQ2264.2 +089900 SEQ-TEST-WR-02-02. SQ2264.2 +090000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +090100 PERFORM PASS SQ2264.2 +090200 ELSE SQ2264.2 +090300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +090400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +090500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +090600 TO RE-MARK SQ2264.2 +090700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +090800 PERFORM FAIL. SQ2264.2 +090900 SEQ-TEST-02-02-END. SQ2264.2 +091000* SQ2264.2 +091100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +091200* SQ2264.2 +091300 ADD 1 TO REC-CT. SQ2264.2 +091400 IF DELETE-SW NOT = SPACE SQ2264.2 +091500 GO TO SEQ-DELETE-02-03. SQ2264.2 +091600 GO TO SEQ-TEST-WR-02-03. SQ2264.2 +091700 SEQ-DELETE-02-03. SQ2264.2 +091800 PERFORM DE-LETE. SQ2264.2 +091900 GO TO SEQ-TEST-02-03-END. SQ2264.2 +092000 SEQ-TEST-WR-02-03. SQ2264.2 +092100 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +092200 PERFORM PASS SQ2264.2 +092300 ELSE SQ2264.2 +092400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +092500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +092600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +092700 TO RE-MARK SQ2264.2 +092800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +092900 PERFORM FAIL. SQ2264.2 +093000 SEQ-TEST-02-03-END. SQ2264.2 +093100* SQ2264.2 +093200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +093300* SQ2264.2 +093400 ADD 1 TO REC-CT. SQ2264.2 +093500 IF DELETE-SW NOT = SPACE SQ2264.2 +093600 GO TO SEQ-DELETE-02-04. SQ2264.2 +093700 GO TO SEQ-TEST-WR-02-04. SQ2264.2 +093800 SEQ-DELETE-02-04. SQ2264.2 +093900 PERFORM DE-LETE. SQ2264.2 +094000 GO TO SEQ-TEST-02-04-END. SQ2264.2 +094100 SEQ-TEST-WR-02-04. SQ2264.2 +094200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +094300 PERFORM PASS SQ2264.2 +094400 ELSE SQ2264.2 +094500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +094600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +094700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +094800 TO RE-MARK SQ2264.2 +094900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +095000 PERFORM FAIL. SQ2264.2 +095100 SEQ-TEST-02-04-END. SQ2264.2 +095200* SQ2264.2 +095300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +095400* SQ2264.2 +095500 ADD 1 TO REC-CT. SQ2264.2 +095600 IF DELETE-SW NOT = SPACE SQ2264.2 +095700 GO TO SEQ-DELETE-02-05. SQ2264.2 +095800 GO TO SEQ-TEST-WR-02-05. SQ2264.2 +095900 SEQ-DELETE-02-05. SQ2264.2 +096000 PERFORM DE-LETE. SQ2264.2 +096100 GO TO SEQ-TEST-02-05-END. SQ2264.2 +096200 SEQ-TEST-WR-02-05. SQ2264.2 +096300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +096400 PERFORM PASS SQ2264.2 +096500 ELSE SQ2264.2 +096600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +096700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +096800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +096900 TO RE-MARK SQ2264.2 +097000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +097100 PERFORM FAIL. SQ2264.2 +097200 SEQ-TEST-02-05-END. SQ2264.2 +097300 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +097400* SQ2264.2 +097500* SQ2264.2 +097600* NOW CLOSE THE FILE. SQ2264.2 +097700* SQ2264.2 +097800 SEQ-INIT-03. SQ2264.2 +097900 MOVE 0 TO REC-CT. SQ2264.2 +098000 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +098100 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +098200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +098300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +098400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +098500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +098600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +098700 MOVE "CLOSE FILE" TO FEATURE. SQ2264.2 +098800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2264.2 +098900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +099000 GO TO SEQ-DELETE-03. SQ2264.2 +099100 GO TO SEQ-TEST-CL-03. SQ2264.2 +099200 SEQ-DELETE-03. SQ2264.2 +099300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +099400 GO TO SEQ-DELETE-03-01. SQ2264.2 +099500 SEQ-TEST-CL-03. SQ2264.2 +099600 CLOSE SQ-FS4. SQ2264.2 +099700* SQ2264.2 +099800* CHECK I-O STATUS RETURNED FROM CLOSE SQ2264.2 +099900* SQ2264.2 +100000 ADD 1 TO REC-CT. SQ2264.2 +100100 IF DELETE-SW NOT = SPACE SQ2264.2 +100200 GO TO SEQ-DELETE-03-01. SQ2264.2 +100300 GO TO SEQ-TEST-CL-03-01. SQ2264.2 +100400 SEQ-DELETE-03-01. SQ2264.2 +100500 PERFORM DE-LETE. SQ2264.2 +100600 GO TO SEQ-TEST-03-01-END. SQ2264.2 +100700 SEQ-TEST-CL-03-01. SQ2264.2 +100800 IF SQ-FS4-STATUS = "00" SQ2264.2 +100900 PERFORM PASS SQ2264.2 +101000 ELSE SQ2264.2 +101100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +101200 MOVE "00" TO CORRECT-A SQ2264.2 +101300 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ2264.2 +101400 TO RE-MARK SQ2264.2 +101500 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ2264.2 +101600 PERFORM FAIL. SQ2264.2 +101700 SEQ-TEST-03-01-END. SQ2264.2 +101800* SQ2264.2 +101900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +102000* SQ2264.2 +102100 ADD 1 TO REC-CT. SQ2264.2 +102200 IF DELETE-SW NOT = SPACE SQ2264.2 +102300 GO TO SEQ-DELETE-03-02. SQ2264.2 +102400 GO TO SEQ-TEST-CL-03-02. SQ2264.2 +102500 SEQ-DELETE-03-02. SQ2264.2 +102600 PERFORM DE-LETE. SQ2264.2 +102700 GO TO SEQ-TEST-03-02-END. SQ2264.2 +102800 SEQ-TEST-CL-03-02. SQ2264.2 +102900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +103000 PERFORM PASS SQ2264.2 +103100 ELSE SQ2264.2 +103200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +103300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +103400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +103500 TO RE-MARK SQ2264.2 +103600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +103700 PERFORM FAIL. SQ2264.2 +103800 SEQ-TEST-03-02-END. SQ2264.2 +103900* SQ2264.2 +104000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +104100* SQ2264.2 +104200 ADD 1 TO REC-CT. SQ2264.2 +104300 IF DELETE-SW NOT = SPACE SQ2264.2 +104400 GO TO SEQ-DELETE-03-03. SQ2264.2 +104500 GO TO SEQ-TEST-CL-03-03. SQ2264.2 +104600 SEQ-DELETE-03-03. SQ2264.2 +104700 PERFORM DE-LETE. SQ2264.2 +104800 GO TO SEQ-TEST-03-03-END. SQ2264.2 +104900 SEQ-TEST-CL-03-03. SQ2264.2 +105000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +105100 PERFORM PASS SQ2264.2 +105200 ELSE SQ2264.2 +105300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +105400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +105500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +105600 TO RE-MARK SQ2264.2 +105700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +105800 PERFORM FAIL. SQ2264.2 +105900 SEQ-TEST-03-03-END. SQ2264.2 +106000* SQ2264.2 +106100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +106200* SQ2264.2 +106300 ADD 1 TO REC-CT. SQ2264.2 +106400 IF DELETE-SW NOT = SPACE SQ2264.2 +106500 GO TO SEQ-DELETE-03-04. SQ2264.2 +106600 GO TO SEQ-TEST-CL-03-04. SQ2264.2 +106700 SEQ-DELETE-03-04. SQ2264.2 +106800 PERFORM DE-LETE. SQ2264.2 +106900 GO TO SEQ-TEST-03-04-END. SQ2264.2 +107000 SEQ-TEST-CL-03-04. SQ2264.2 +107100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +107200 PERFORM PASS SQ2264.2 +107300 ELSE SQ2264.2 +107400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +107500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +107600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +107700 TO RE-MARK SQ2264.2 +107800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +107900 PERFORM FAIL. SQ2264.2 +108000 SEQ-TEST-03-04-END. SQ2264.2 +108100* SQ2264.2 +108200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +108300* SQ2264.2 +108400 ADD 1 TO REC-CT. SQ2264.2 +108500 IF DELETE-SW NOT = SPACE SQ2264.2 +108600 GO TO SEQ-DELETE-03-05. SQ2264.2 +108700 GO TO SEQ-TEST-CL-03-05. SQ2264.2 +108800 SEQ-DELETE-03-05. SQ2264.2 +108900 PERFORM DE-LETE. SQ2264.2 +109000 GO TO SEQ-TEST-03-05-END. SQ2264.2 +109100 SEQ-TEST-CL-03-05. SQ2264.2 +109200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +109300 PERFORM PASS SQ2264.2 +109400 ELSE SQ2264.2 +109500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +109600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +109700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +109800 TO RE-MARK SQ2264.2 +109900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +110000 PERFORM FAIL. SQ2264.2 +110100 SEQ-TEST-03-05-END. SQ2264.2 +110200 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +110300* SQ2264.2 +110400* SQ2264.2 +110500* OPEN THE FILE IN THE INPUT MODE SQ2264.2 +110600* SQ2264.2 +110700 SEQ-INIT-04. SQ2264.2 +110800 MOVE 0 TO REC-CT. SQ2264.2 +110900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +111000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +111100 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +111200 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +111300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +111400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +111500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +111600 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +111700 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ2264.2 +111800 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2264.2 +111900 IF DELETE-SW NOT = SPACE SQ2264.2 +112000 GO TO SEQ-DELETE-04-01. SQ2264.2 +112100 GO TO SEQ-TEST-OP-04. SQ2264.2 +112200 SEQ-DELETE-04. SQ2264.2 +112300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +112400 GO TO SEQ-DELETE-04-01. SQ2264.2 +112500 SEQ-TEST-OP-04. SQ2264.2 +112600 OPEN INPUT SQ-FS4. SQ2264.2 +112700* SQ2264.2 +112800* CHECK I-O STATUS RETURNED FROM OPEN INPUT SQ2264.2 +112900* SQ2264.2 +113000 ADD 1 TO REC-CT. SQ2264.2 +113100 IF DELETE-SW NOT = SPACE SQ2264.2 +113200 GO TO SEQ-DELETE-04-01. SQ2264.2 +113300 GO TO SEQ-TEST-OP-04-01. SQ2264.2 +113400 SEQ-DELETE-04-01. SQ2264.2 +113500 PERFORM DE-LETE. SQ2264.2 +113600 GO TO SEQ-TEST-04-01-END. SQ2264.2 +113700 SEQ-TEST-OP-04-01. SQ2264.2 +113800 IF SQ-FS4-STATUS = "00" SQ2264.2 +113900 PERFORM PASS SQ2264.2 +114000 ELSE SQ2264.2 +114100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +114200 MOVE "00" TO CORRECT-A SQ2264.2 +114300 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ2264.2 +114400 TO RE-MARK SQ2264.2 +114500 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ2264.2 +114600 PERFORM FAIL. SQ2264.2 +114700 SEQ-TEST-04-01-END. SQ2264.2 +114800* SQ2264.2 +114900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +115000* SQ2264.2 +115100 ADD 1 TO REC-CT. SQ2264.2 +115200 IF DELETE-SW NOT = SPACE SQ2264.2 +115300 GO TO SEQ-DELETE-04-02. SQ2264.2 +115400 GO TO SEQ-TEST-OP-04-02. SQ2264.2 +115500 SEQ-DELETE-04-02. SQ2264.2 +115600 PERFORM DE-LETE. SQ2264.2 +115700 GO TO SEQ-TEST-04-02-END. SQ2264.2 +115800 SEQ-TEST-OP-04-02. SQ2264.2 +115900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +116000 PERFORM PASS SQ2264.2 +116100 ELSE SQ2264.2 +116200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +116300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +116400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +116500 TO RE-MARK SQ2264.2 +116600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +116700 PERFORM FAIL. SQ2264.2 +116800 SEQ-TEST-04-02-END. SQ2264.2 +116900* SQ2264.2 +117000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +117100* SQ2264.2 +117200 ADD 1 TO REC-CT. SQ2264.2 +117300 IF DELETE-SW NOT = SPACE SQ2264.2 +117400 GO TO SEQ-DELETE-04-03. SQ2264.2 +117500 GO TO SEQ-TEST-OP-04-03. SQ2264.2 +117600 SEQ-DELETE-04-03. SQ2264.2 +117700 PERFORM DE-LETE. SQ2264.2 +117800 GO TO SEQ-TEST-04-03-END. SQ2264.2 +117900 SEQ-TEST-OP-04-03. SQ2264.2 +118000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +118100 PERFORM PASS SQ2264.2 +118200 ELSE SQ2264.2 +118300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +118400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +118500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +118600 TO RE-MARK SQ2264.2 +118700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +118800 PERFORM FAIL. SQ2264.2 +118900 SEQ-TEST-04-03-END. SQ2264.2 +119000* SQ2264.2 +119100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +119200* SQ2264.2 +119300 ADD 1 TO REC-CT. SQ2264.2 +119400 IF DELETE-SW NOT = SPACE SQ2264.2 +119500 GO TO SEQ-DELETE-04-04. SQ2264.2 +119600 GO TO SEQ-TEST-OP-04-04. SQ2264.2 +119700 SEQ-DELETE-04-04. SQ2264.2 +119800 PERFORM DE-LETE. SQ2264.2 +119900 GO TO SEQ-TEST-04-04-END. SQ2264.2 +120000 SEQ-TEST-OP-04-04. SQ2264.2 +120100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +120200 PERFORM PASS SQ2264.2 +120300 ELSE SQ2264.2 +120400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +120500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +120600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +120700 TO RE-MARK SQ2264.2 +120800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +120900 PERFORM FAIL. SQ2264.2 +121000 SEQ-TEST-04-04-END. SQ2264.2 +121100* SQ2264.2 +121200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +121300* SQ2264.2 +121400 ADD 1 TO REC-CT. SQ2264.2 +121500 IF DELETE-SW NOT = SPACE SQ2264.2 +121600 GO TO SEQ-DELETE-04-05. SQ2264.2 +121700 GO TO SEQ-TEST-OP-04-05. SQ2264.2 +121800 SEQ-DELETE-04-05. SQ2264.2 +121900 PERFORM DE-LETE. SQ2264.2 +122000 GO TO SEQ-TEST-04-05-END. SQ2264.2 +122100 SEQ-TEST-OP-04-05. SQ2264.2 +122200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +122300 PERFORM PASS SQ2264.2 +122400 ELSE SQ2264.2 +122500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +122600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +122700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +122800 TO RE-MARK SQ2264.2 +122900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +123000 PERFORM FAIL. SQ2264.2 +123100 SEQ-TEST-04-05-END. SQ2264.2 +123200* SQ2264.2 +123300* SQ2264.2 +123400* THE FILE IS OPEN FOR INPUT. WE READ THE ONLY RECORD. SQ2264.2 +123500* SQ2264.2 +123600 SEQ-INIT-05. SQ2264.2 +123700 MOVE 0 TO REC-CT. SQ2264.2 +123800 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +123900 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +124000 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +124100 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +124200 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +124300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +124400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +124500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +124600 MOVE "READ FIRST RECORD" TO FEATURE. SQ2264.2 +124700 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2264.2 +124800 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +124900 GO TO SEQ-DELETE-05. SQ2264.2 +125000 GO TO SEQ-TEST-RD-05. SQ2264.2 +125100 SEQ-DELETE-05. SQ2264.2 +125200 MOVE "*" TO DELETE-SW-2. SQ2264.2 +125300 GO TO SEQ-DELETE-05-01. SQ2264.2 +125400 SEQ-TEST-RD-05. SQ2264.2 +125500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ2264.2 +125600 READ SQ-FS4. SQ2264.2 +125700* SQ2264.2 +125800* CHECK I-O STATUS RETURNED FROM READ SQ2264.2 +125900* SQ2264.2 +126000 ADD 1 TO REC-CT. SQ2264.2 +126100 IF DELETE-SW NOT = SPACE SQ2264.2 +126200 GO TO SEQ-DELETE-05-01. SQ2264.2 +126300 GO TO SEQ-TEST-RD-05-01. SQ2264.2 +126400 SEQ-DELETE-05-01. SQ2264.2 +126500 PERFORM DE-LETE. SQ2264.2 +126600 GO TO SEQ-TEST-05-01-END. SQ2264.2 +126700 SEQ-TEST-RD-05-01. SQ2264.2 +126800 IF SQ-FS4-STATUS = "00" SQ2264.2 +126900 PERFORM PASS SQ2264.2 +127000 ELSE SQ2264.2 +127100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +127200 MOVE "00" TO CORRECT-A SQ2264.2 +127300 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ2264.2 +127400 TO RE-MARK SQ2264.2 +127500 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2264.2 +127600 PERFORM FAIL. SQ2264.2 +127700 SEQ-TEST-05-01-END. SQ2264.2 +127800* SQ2264.2 +127900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +128000* SQ2264.2 +128100 ADD 1 TO REC-CT. SQ2264.2 +128200 IF DELETE-SW NOT = SPACE SQ2264.2 +128300 GO TO SEQ-DELETE-05-02. SQ2264.2 +128400 GO TO SEQ-TEST-RD-05-02. SQ2264.2 +128500 SEQ-DELETE-05-02. SQ2264.2 +128600 PERFORM DE-LETE. SQ2264.2 +128700 GO TO SEQ-TEST-05-02-END. SQ2264.2 +128800 SEQ-TEST-RD-05-02. SQ2264.2 +128900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +129000 PERFORM PASS SQ2264.2 +129100 ELSE SQ2264.2 +129200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +129300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +129400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +129500 TO RE-MARK SQ2264.2 +129600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +129700 PERFORM FAIL. SQ2264.2 +129800 SEQ-TEST-05-02-END. SQ2264.2 +129900* SQ2264.2 +130000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +130100* SQ2264.2 +130200 ADD 1 TO REC-CT. SQ2264.2 +130300 IF DELETE-SW NOT = SPACE SQ2264.2 +130400 GO TO SEQ-DELETE-05-03. SQ2264.2 +130500 GO TO SEQ-TEST-RD-05-03. SQ2264.2 +130600 SEQ-DELETE-05-03. SQ2264.2 +130700 PERFORM DE-LETE. SQ2264.2 +130800 GO TO SEQ-TEST-05-03-END. SQ2264.2 +130900 SEQ-TEST-RD-05-03. SQ2264.2 +131000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +131100 PERFORM PASS SQ2264.2 +131200 ELSE SQ2264.2 +131300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +131400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +131500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +131600 TO RE-MARK SQ2264.2 +131700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +131800 PERFORM FAIL. SQ2264.2 +131900 SEQ-TEST-05-03-END. SQ2264.2 +132000* SQ2264.2 +132100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +132200* SQ2264.2 +132300 ADD 1 TO REC-CT. SQ2264.2 +132400 IF DELETE-SW NOT = SPACE SQ2264.2 +132500 GO TO SEQ-DELETE-05-04. SQ2264.2 +132600 GO TO SEQ-TEST-RD-05-04. SQ2264.2 +132700 SEQ-DELETE-05-04. SQ2264.2 +132800 PERFORM DE-LETE. SQ2264.2 +132900 GO TO SEQ-TEST-05-04-END. SQ2264.2 +133000 SEQ-TEST-RD-05-04. SQ2264.2 +133100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +133200 PERFORM PASS SQ2264.2 +133300 ELSE SQ2264.2 +133400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +133500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +133600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +133700 TO RE-MARK SQ2264.2 +133800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +133900 PERFORM FAIL. SQ2264.2 +134000 SEQ-TEST-05-04-END. SQ2264.2 +134100* SQ2264.2 +134200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +134300* SQ2264.2 +134400 ADD 1 TO REC-CT. SQ2264.2 +134500 IF DELETE-SW NOT = SPACE SQ2264.2 +134600 GO TO SEQ-DELETE-05-05. SQ2264.2 +134700 GO TO SEQ-TEST-RD-05-05. SQ2264.2 +134800 SEQ-DELETE-05-05. SQ2264.2 +134900 PERFORM DE-LETE. SQ2264.2 +135000 GO TO SEQ-TEST-05-05-END. SQ2264.2 +135100 SEQ-TEST-RD-05-05. SQ2264.2 +135200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +135300 PERFORM PASS SQ2264.2 +135400 ELSE SQ2264.2 +135500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +135600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +135700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +135800 TO RE-MARK SQ2264.2 +135900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +136000 PERFORM FAIL. SQ2264.2 +136100 SEQ-TEST-05-05-END. SQ2264.2 +136200* SQ2264.2 +136300* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ2264.2 +136400* CHECKING THE RECORD-NUMBER FIELD. SQ2264.2 +136500* SQ2264.2 +136600 ADD 1 TO REC-CT. SQ2264.2 +136700 IF DELETE-SW NOT = SPACE SQ2264.2 +136800 GO TO SEQ-DELETE-05-06. SQ2264.2 +136900 GO TO SEQ-TEST-RD-05-06. SQ2264.2 +137000 SEQ-DELETE-05-06. SQ2264.2 +137100 PERFORM DE-LETE. SQ2264.2 +137200 GO TO SEQ-TEST-05-06-END. SQ2264.2 +137300 SEQ-TEST-RD-05-06. SQ2264.2 +137400 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ2264.2 +137500 PERFORM PASS SQ2264.2 +137600 ELSE SQ2264.2 +137700 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ2264.2 +137800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ2264.2 +137900 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ2264.2 +138000 PERFORM FAIL. SQ2264.2 +138100 SEQ-TEST-05-06-END. SQ2264.2 +138200 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +138300* SQ2264.2 +138400* SQ2264.2 +138500* ANOTHER READ SHOULD CAUSE THE AT END CONDITION. SQ2264.2 +138600* SQ2264.2 +138700 SEQ-INIT-06. SQ2264.2 +138800 MOVE 0 TO REC-CT. SQ2264.2 +138900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +139000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +139100 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +139200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +139300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +139400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +139500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +139600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +139700 MOVE "READ GIVING AT END" TO FEATURE. SQ2264.2 +139800 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ2264.2 +139900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +140000 GO TO SEQ-DELETE-06. SQ2264.2 +140100 GO TO SEQ-TEST-RD-06. SQ2264.2 +140200 SEQ-DELETE-06. SQ2264.2 +140300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +140400 GO TO SEQ-DELETE-06-01. SQ2264.2 +140500 SEQ-TEST-RD-06. SQ2264.2 +140600 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ2264.2 +140700 READ SQ-FS4 RECORD. SQ2264.2 +140800* SQ2264.2 +140900* CHECK I-O STATUS RETURNED FROM READ SQ2264.2 +141000* SQ2264.2 +141100 ADD 1 TO REC-CT. SQ2264.2 +141200 IF DELETE-SW NOT = SPACE SQ2264.2 +141300 GO TO SEQ-DELETE-06-01. SQ2264.2 +141400 GO TO SEQ-TEST-RD-06-01. SQ2264.2 +141500 SEQ-DELETE-06-01. SQ2264.2 +141600 PERFORM DE-LETE. SQ2264.2 +141700 GO TO SEQ-TEST-06-01-END. SQ2264.2 +141800 SEQ-TEST-RD-06-01. SQ2264.2 +141900 IF SQ-FS4-STATUS = "10" SQ2264.2 +142000 PERFORM PASS SQ2264.2 +142100 ELSE SQ2264.2 +142200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +142300 MOVE "10" TO CORRECT-A SQ2264.2 +142400 MOVE "AT END STATUS NOT RETURNED FROM READ" SQ2264.2 +142500 TO RE-MARK SQ2264.2 +142600 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2264.2 +142700 PERFORM FAIL. SQ2264.2 +142800 SEQ-TEST-06-01-END. SQ2264.2 +142900* SQ2264.2 +143000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +143100* SQ2264.2 +143200 ADD 1 TO REC-CT. SQ2264.2 +143300 IF DELETE-SW NOT = SPACE SQ2264.2 +143400 GO TO SEQ-DELETE-06-02. SQ2264.2 +143500 GO TO SEQ-TEST-RD-06-02. SQ2264.2 +143600 SEQ-DELETE-06-02. SQ2264.2 +143700 PERFORM DE-LETE. SQ2264.2 +143800 GO TO SEQ-TEST-06-02-END. SQ2264.2 +143900 SEQ-TEST-RD-06-02. SQ2264.2 +144000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +144100 PERFORM PASS SQ2264.2 +144200 ELSE SQ2264.2 +144300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +144400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +144500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +144600 TO RE-MARK SQ2264.2 +144700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +144800 PERFORM FAIL. SQ2264.2 +144900 SEQ-TEST-06-02-END. SQ2264.2 +145000* SQ2264.2 +145100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +145200* SQ2264.2 +145300 ADD 1 TO REC-CT. SQ2264.2 +145400 IF DELETE-SW NOT = SPACE SQ2264.2 +145500 GO TO SEQ-DELETE-06-03. SQ2264.2 +145600 GO TO SEQ-TEST-RD-06-03. SQ2264.2 +145700 SEQ-DELETE-06-03. SQ2264.2 +145800 PERFORM DE-LETE. SQ2264.2 +145900 GO TO SEQ-TEST-06-03-END. SQ2264.2 +146000 SEQ-TEST-RD-06-03. SQ2264.2 +146100 IF DECL-EXEC-I = "EXECUTED" SQ2264.2 +146200 PERFORM PASS SQ2264.2 +146300 ELSE SQ2264.2 +146400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +146500 MOVE "EXECUTED" TO CORRECT-A SQ2264.2 +146600 MOVE "INPUT DECLARATIVE NOT EXECUTED AT END OF FILE" SQ2264.2 +146700 TO RE-MARK SQ2264.2 +146800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +146900 PERFORM FAIL. SQ2264.2 +147000 SEQ-TEST-06-03-END. SQ2264.2 +147100* SQ2264.2 +147200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +147300* SQ2264.2 +147400 ADD 1 TO REC-CT. SQ2264.2 +147500 IF DELETE-SW NOT = SPACE SQ2264.2 +147600 GO TO SEQ-DELETE-06-04. SQ2264.2 +147700 GO TO SEQ-TEST-RD-06-04. SQ2264.2 +147800 SEQ-DELETE-06-04. SQ2264.2 +147900 PERFORM DE-LETE. SQ2264.2 +148000 GO TO SEQ-TEST-06-04-END. SQ2264.2 +148100 SEQ-TEST-RD-06-04. SQ2264.2 +148200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +148300 PERFORM PASS SQ2264.2 +148400 ELSE SQ2264.2 +148500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +148600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +148700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +148800 TO RE-MARK SQ2264.2 +148900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +149000 PERFORM FAIL. SQ2264.2 +149100 SEQ-TEST-06-04-END. SQ2264.2 +149200* SQ2264.2 +149300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +149400* SQ2264.2 +149500 ADD 1 TO REC-CT. SQ2264.2 +149600 IF DELETE-SW NOT = SPACE SQ2264.2 +149700 GO TO SEQ-DELETE-06-05. SQ2264.2 +149800 GO TO SEQ-TEST-RD-06-05. SQ2264.2 +149900 SEQ-DELETE-06-05. SQ2264.2 +150000 PERFORM DE-LETE. SQ2264.2 +150100 GO TO SEQ-TEST-06-05-END. SQ2264.2 +150200 SEQ-TEST-RD-06-05. SQ2264.2 +150300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +150400 PERFORM PASS SQ2264.2 +150500 ELSE SQ2264.2 +150600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +150700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +150800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +150900 TO RE-MARK SQ2264.2 +151000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +151100 PERFORM FAIL. SQ2264.2 +151200 SEQ-TEST-06-05-END. SQ2264.2 +151300 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +151400* SQ2264.2 +151500* SQ2264.2 +151600* FINALLY, TRY TO OPEN THE FILE AGAIN, IN THE EXTEND MODE SQ2264.2 +151700* SQ2264.2 +151800 SEQ-INIT-07. SQ2264.2 +151900 MOVE 0 TO REC-CT. SQ2264.2 +152000 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +152100 MOVE SPACE TO DECL-EXEC-SW. SQ2264.2 +152200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +152300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +152400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +152500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +152600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +152700 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +152800 MOVE "OPEN FILE SECOND TIME" TO FEATURE. SQ2264.2 +152900 MOVE "SEQ-TEST-OP-07" TO PAR-NAME. SQ2264.2 +153000 IF DELETE-SW NOT = SPACE SQ2264.2 +153100 GO TO SEQ-DELETE-07-01. SQ2264.2 +153200 GO TO SEQ-TEST-OP-07. SQ2264.2 +153300 SEQ-DELETE-07. SQ2264.2 +153400 MOVE "*" TO DELETE-SW-2. SQ2264.2 +153500 GO TO SEQ-DELETE-07-01. SQ2264.2 +153600 SEQ-TEST-OP-07. SQ2264.2 +153700 OPEN EXTEND SQ-FS4. SQ2264.2 +153800 MOVE 0 TO REC-CT. SQ2264.2 +153900 MOVE "OPEN FILE SECOND TIME" TO FEATURE. SQ2264.2 +154000 MOVE "SEQ-TEST-OP-07" TO PAR-NAME. SQ2264.2 +154100* SQ2264.2 +154200* CHECK I-O STATUS RETURNED FROM OPEN EXTEND SQ2264.2 +154300* SQ2264.2 +154400 ADD 1 TO REC-CT. SQ2264.2 +154500 IF DELETE-SW NOT = SPACE SQ2264.2 +154600 GO TO SEQ-DELETE-07-01. SQ2264.2 +154700 GO TO SEQ-TEST-OP-07-01. SQ2264.2 +154800 SEQ-DELETE-07-01. SQ2264.2 +154900 PERFORM DE-LETE. SQ2264.2 +155000 GO TO SEQ-TEST-07-01-END. SQ2264.2 +155100 SEQ-TEST-OP-07-01. SQ2264.2 +155200 IF SQ-FS4-STATUS = "41" SQ2264.2 +155300 PERFORM PASS SQ2264.2 +155400 ELSE SQ2264.2 +155500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +155600 MOVE "41" TO CORRECT-A SQ2264.2 +155700 MOVE "UNEXPECTED STATUS CODE FROM SECOND OPEN" SQ2264.2 +155800 TO RE-MARK SQ2264.2 +155900 MOVE "VII-4,1.5.3(4)A, VII-40" TO ANSI-REFERENCE SQ2264.2 +156000 PERFORM FAIL. SQ2264.2 +156100 SEQ-TEST-07-01-END. SQ2264.2 +156200* SQ2264.2 +156300* CHECK EXECUTION OF EXTEND AND INPUT DECLARATIVES SQ2264.2 +156400* SQ2264.2 +156500 ADD 1 TO REC-CT. SQ2264.2 +156600 IF DELETE-SW NOT = SPACE SQ2264.2 +156700 GO TO SEQ-DELETE-07-02. SQ2264.2 +156800 GO TO SEQ-TEST-OP-07-02. SQ2264.2 +156900 SEQ-DELETE-07-02. SQ2264.2 +157000 PERFORM DE-LETE. SQ2264.2 +157100 GO TO SEQ-TEST-07-02-END. SQ2264.2 +157200 SEQ-TEST-OP-07-02. SQ2264.2 +157300 IF DECL-EXEC-E = "EXECUTED" OR DECL-EXEC-I = "EXECUTED" SQ2264.2 +157400 PERFORM PASS SQ2264.2 +157500 ELSE SQ2264.2 +157600 MOVE "DECL NOT EXECUTED" TO COMPUTED-A SQ2264.2 +157700 MOVE "EXECUTED" TO CORRECT-A SQ2264.2 +157800 MOVE "EXECUTION OF ONE DECLARATIVE EXPECTED" SQ2264.2 +157900 TO RE-MARK SQ2264.2 +158000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +158100 PERFORM FAIL. SQ2264.2 +158200 SEQ-TEST-07-02-END. SQ2264.2 +158300* SQ2264.2 +158400* CHECK NUMBER OF DECLARATIVES EXECUTED SQ2264.2 +158500* SQ2264.2 +158600 ADD 1 TO REC-CT. SQ2264.2 +158700 IF DELETE-SW NOT = SPACE SQ2264.2 +158800 GO TO SEQ-DELETE-07-03. SQ2264.2 +158900 GO TO SEQ-TEST-OP-07-03. SQ2264.2 +159000 SEQ-DELETE-07-03. SQ2264.2 +159100 PERFORM DE-LETE. SQ2264.2 +159200 GO TO SEQ-TEST-07-03-END. SQ2264.2 +159300 SEQ-TEST-OP-07-03. SQ2264.2 +159400 IF DECL-EXEC-CT = 1 SQ2264.2 +159500 PERFORM PASS SQ2264.2 +159600 ELSE SQ2264.2 +159700 MOVE DECL-EXEC-CT TO COMPUTED-18V0 SQ2264.2 +159800 MOVE 1 TO CORRECT-18V0 SQ2264.2 +159900 MOVE "ONLY ONE EXECUTION OF A DECLARATIVE EXPECTED" SQ2264.2 +160000 TO RE-MARK SQ2264.2 +160100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +160200 PERFORM FAIL. SQ2264.2 +160300 SEQ-TEST-07-03-END. SQ2264.2 +160400* SQ2264.2 +160500* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +160600* SQ2264.2 +160700 ADD 1 TO REC-CT. SQ2264.2 +160800 IF DELETE-SW NOT = SPACE SQ2264.2 +160900 GO TO SEQ-DELETE-07-04. SQ2264.2 +161000 GO TO SEQ-TEST-OP-07-04. SQ2264.2 +161100 SEQ-DELETE-07-04. SQ2264.2 +161200 PERFORM DE-LETE. SQ2264.2 +161300 GO TO SEQ-TEST-07-04-END. SQ2264.2 +161400 SEQ-TEST-OP-07-04. SQ2264.2 +161500 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +161600 PERFORM PASS SQ2264.2 +161700 ELSE SQ2264.2 +161800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +161900 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +162000 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +162100 TO RE-MARK SQ2264.2 +162200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +162300 PERFORM FAIL. SQ2264.2 +162400 SEQ-TEST-07-04-END. SQ2264.2 +162500* SQ2264.2 +162600* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +162700* SQ2264.2 +162800 ADD 1 TO REC-CT. SQ2264.2 +162900 IF DELETE-SW NOT = SPACE SQ2264.2 +163000 GO TO SEQ-DELETE-07-05. SQ2264.2 +163100 GO TO SEQ-TEST-OP-07-05. SQ2264.2 +163200 SEQ-DELETE-07-05. SQ2264.2 +163300 PERFORM DE-LETE. SQ2264.2 +163400 GO TO SEQ-TEST-07-05-END. SQ2264.2 +163500 SEQ-TEST-OP-07-05. SQ2264.2 +163600 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +163700 PERFORM PASS SQ2264.2 +163800 ELSE SQ2264.2 +163900 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +164000 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +164100 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +164200 TO RE-MARK SQ2264.2 +164300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +164400 PERFORM FAIL. SQ2264.2 +164500 SEQ-TEST-07-05-END. SQ2264.2 +164600* SQ2264.2 +164700* SQ2264.2 +164800 CCVS-EXIT SECTION. SQ2264.2 +164900 CCVS-999999. SQ2264.2 +165000 GO TO CLOSE-FILES. SQ2264.2 +*END-OF,SQ226A +*HEADER,COBOL,SQ227A +000100 IDENTIFICATION DIVISION. SQ2274.2 +000200 PROGRAM-ID. SQ2274.2 +000300 SQ227A. SQ2274.2 +000400**************************************************************** SQ2274.2 +000500* * SQ2274.2 +000600* VALIDATION FOR:- * SQ2274.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2274.2 +000900* REVISED 1986, AUGUST * SQ2274.2 +001000* * SQ2274.2 +001100* CREATION DATE / VALIDATION DATE * SQ2274.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2274.2 +001300* * SQ2274.2 +001400**************************************************************** SQ2274.2 +001500* * SQ2274.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2274.2 +001700* * SQ2274.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2274.2 +001900* X-55 SYSTEM PRINTER * SQ2274.2 +002000* X-82 SOURCE-COMPUTER * SQ2274.2 +002100* X-83 OBJECT-COMPUTER. * SQ2274.2 +002200* * SQ2274.2 +002300**************************************************************** SQ2274.2 +002400* * SQ2274.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ2274.2 +002600* TO A MASS STORAGE MEDIUM. ONE RECORD IS THEN WRITTEN TO * SQ2274.2 +002700* THIS FILE WHICH IS THEN CLOSED. THE FILE IS THEN OPENED * SQ2274.2 +002800* FOR I-O, AND A READ STATEMENT ON THE FILE IS CARRIED OUT. * SQ2274.2 +002900* A REWRITE ON A RECORD THAT IS TOO LONG FOR THE FILE IS * SQ2274.2 +003000* ATTEMPTED WHICH SHOULD CAUSE AN EXCEPTION CONDITION WITH * SQ2274.2 +003100* I-O STATUS "44". THIS LOGIC ERROR SHOULD CAUSE ENTRY TO * SQ2274.2 +003200* THE APPLICABLE ERROR DECLARATIVE. * SQ2274.2 +003300* * SQ2274.2 +003400* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ2274.2 +003500* THE NEW PROGRAM IS SQ228A. * SQ2274.2 +003600**************************************************************** SQ2274.2 +003700* SQ2274.2 +003800 ENVIRONMENT DIVISION. SQ2274.2 +003900 CONFIGURATION SECTION. SQ2274.2 +004000 SOURCE-COMPUTER. SQ2274.2 +004100 XXXXX082. SQ2274.2 +004200 OBJECT-COMPUTER. SQ2274.2 +004300 XXXXX083. SQ2274.2 +004400* SQ2274.2 +004500 INPUT-OUTPUT SECTION. SQ2274.2 +004600 FILE-CONTROL. SQ2274.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ2274.2 +004800 XXXXX055. SQ2274.2 +004900* SQ2274.2 +005000P SELECT RAW-DATA ASSIGN TO SQ2274.2 +005100P XXXXX062 SQ2274.2 +005200P ORGANIZATION IS INDEXED SQ2274.2 +005300P ACCESS MODE IS RANDOM SQ2274.2 +005400P RECORD-KEY IS RAW-DATA-KEY. SQ2274.2 +005500P SQ2274.2 +005600 SELECT SQ-FS4 SQ2274.2 +005700 ASSIGN SQ2274.2 +005800 XXXXX014 SQ2274.2 +005900 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ2274.2 +006000 ACCESS MODE IS SEQUENTIAL SQ2274.2 +006100 ORGANIZATION IS SEQUENTIAL SQ2274.2 +006200 . SQ2274.2 +006300* SQ2274.2 +006400* SQ2274.2 +006500 DATA DIVISION. SQ2274.2 +006600 FILE SECTION. SQ2274.2 +006700 FD PRINT-FILE SQ2274.2 +006800C LABEL RECORDS SQ2274.2 +006900C XXXXX084 SQ2274.2 +007000C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2274.2 +007100 . SQ2274.2 +007200 01 PRINT-REC PICTURE X(120). SQ2274.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2274.2 +007400P SQ2274.2 +007500PFD RAW-DATA. SQ2274.2 +007600P01 RAW-DATA-SATZ. SQ2274.2 +007700P 05 RAW-DATA-KEY PIC X(6). SQ2274.2 +007800P 05 C-DATE PIC 9(6). SQ2274.2 +007900P 05 C-TIME PIC 9(8). SQ2274.2 +008000P 05 NO-OF-TESTS PIC 99. SQ2274.2 +008100P 05 C-OK PIC 999. SQ2274.2 +008200P 05 C-ALL PIC 999. SQ2274.2 +008300P 05 C-FAIL PIC 999. SQ2274.2 +008400P 05 C-DELETED PIC 999. SQ2274.2 +008500P 05 C-INSPECT PIC 999. SQ2274.2 +008600P 05 C-NOTE PIC X(13). SQ2274.2 +008700P 05 C-INDENT PIC X. SQ2274.2 +008800P 05 C-ABORT PIC X(8). SQ2274.2 +008900* SQ2274.2 +009000 FD SQ-FS4 SQ2274.2 +009100C LABEL RECORD IS STANDARD SQ2274.2 +009200 BLOCK CONTAINS 138 CHARACTERS SQ2274.2 +009300 RECORD VARYING SIZE FROM 50 TO 138 CHARACTERS SQ2274.2 +009400 DEPENDING ON SQ-FS4-RECSIZE SQ2274.2 +009500 . SQ2274.2 +009600 01 SQ-FS4R1-F-G-120. SQ2274.2 +009700 05 FFILE-RECORD-INFO-P1-120. SQ2274.2 +009800 07 FILLER PIC X(5). SQ2274.2 +009900 07 FFILE-NAME PIC X(6). SQ2274.2 +010000 07 FILLER PIC X(8). SQ2274.2 +010100 07 FRECORD-NAME PIC X(6). SQ2274.2 +010200 07 FILLER PIC X(1). SQ2274.2 +010300 07 FREELUNIT-NUMBER PIC 9(1). SQ2274.2 +010400 07 FILLER PIC X(7). SQ2274.2 +010500 07 FRECORD-NUMBER PIC 9(6). SQ2274.2 +010600 07 FILLER PIC X(6). SQ2274.2 +010700 07 FUPDATE-NUMBER PIC 9(2). SQ2274.2 +010800 07 FILLER PIC X(5). SQ2274.2 +010900 07 FODO-NUMBER PIC 9(4). SQ2274.2 +011000 07 FILLER PIC X(5). SQ2274.2 +011100 07 FPROGRAM-NAME PIC X(5). SQ2274.2 +011200 07 FILLER PIC X(7). SQ2274.2 +011300 07 FRECORD-LENGTH PIC 9(6). SQ2274.2 +011400 07 FILLER PIC X(7). SQ2274.2 +011500 07 FCHARS-OR-RECORDS PIC X(2). SQ2274.2 +011600 07 FILLER PIC X(1). SQ2274.2 +011700 07 FBLOCK-SIZE PIC 9(4). SQ2274.2 +011800 07 FILLER PIC X(6). SQ2274.2 +011900 07 FRECORDS-IN-FILE PIC 9(6). SQ2274.2 +012000 07 FILLER PIC X(5). SQ2274.2 +012100 07 FFILE-ORGANIZATION PIC X(2). SQ2274.2 +012200 07 FILLER PIC X(6). SQ2274.2 +012300 07 FLABEL-TYPE PIC X(1). SQ2274.2 +012400* SQ2274.2 +012500 01 SQ-FS4R2-F-G-138. SQ2274.2 +012600 03 FILLER PIC X(120). SQ2274.2 +012700 03 EXT-18 PIC X(18). SQ2274.2 +012800* SQ2274.2 +012900 WORKING-STORAGE SECTION. SQ2274.2 +013000* SQ2274.2 +013100*************************************************************** SQ2274.2 +013200* * SQ2274.2 +013300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2274.2 +013400* * SQ2274.2 +013500*************************************************************** SQ2274.2 +013600* SQ2274.2 +013700 01 STATUS-GROUP. SQ2274.2 +013800 04 SQ-FS4-STATUS. SQ2274.2 +013900 07 SQ-FS4-KEY-1 PIC X. SQ2274.2 +014000 07 SQ-FS4-KEY-2 PIC X. SQ2274.2 +014100* SQ2274.2 +014200 01 DELETE-SW. SQ2274.2 +014300 03 DELETE-SW-1 PIC X. SQ2274.2 +014400 03 DELETE-SW-1-GROUP. SQ2274.2 +014500 05 DELETE-SW-2 PIC X. SQ2274.2 +014600* SQ2274.2 +014700 01 DECL-EXEC-I-O PIC X(12). SQ2274.2 +014800* SQ2274.2 +014900 01 DECL-EXEC-SW PIC X. SQ2274.2 +015000* SQ2274.2 +015100 01 SQ-FS4-RECSIZE PIC 999. SQ2274.2 +015200* SQ2274.2 +015300*************************************************************** SQ2274.2 +015400* * SQ2274.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2274.2 +015600* * SQ2274.2 +015700*************************************************************** SQ2274.2 +015800* SQ2274.2 +015900 01 REC-SKEL-SUB PIC 99. SQ2274.2 +016000* SQ2274.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ2274.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ2274.2 +016300 05 FILLER PICTURE X(48) VALUE SQ2274.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2274.2 +016500 05 FILLER PICTURE X(46) VALUE SQ2274.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2274.2 +016700 05 FILLER PICTURE X(26) VALUE SQ2274.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ2274.2 +016900 05 FILLER PICTURE X(37) VALUE SQ2274.2 +017000 ",RECKEY= ". SQ2274.2 +017100 05 FILLER PICTURE X(38) VALUE SQ2274.2 +017200 ",ALTKEY1= ". SQ2274.2 +017300 05 FILLER PICTURE X(38) VALUE SQ2274.2 +017400 ",ALTKEY2= ". SQ2274.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2274.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2274.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ2274.2 +017800 07 FILLER PIC X(5). SQ2274.2 +017900 07 XFILE-NAME PIC X(6). SQ2274.2 +018000 07 FILLER PIC X(8). SQ2274.2 +018100 07 XRECORD-NAME PIC X(6). SQ2274.2 +018200 07 FILLER PIC X(1). SQ2274.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ2274.2 +018400 07 FILLER PIC X(7). SQ2274.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ2274.2 +018600 07 FILLER PIC X(6). SQ2274.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ2274.2 +018800 07 FILLER PIC X(5). SQ2274.2 +018900 07 ODO-NUMBER PIC 9(4). SQ2274.2 +019000 07 FILLER PIC X(5). SQ2274.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ2274.2 +019200 07 FILLER PIC X(7). SQ2274.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ2274.2 +019400 07 FILLER PIC X(7). SQ2274.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ2274.2 +019600 07 FILLER PIC X(1). SQ2274.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ2274.2 +019800 07 FILLER PIC X(6). SQ2274.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ2274.2 +020000 07 FILLER PIC X(5). SQ2274.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ2274.2 +020200 07 FILLER PIC X(6). SQ2274.2 +020300 07 XLABEL-TYPE PIC X(1). SQ2274.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ2274.2 +020500 07 FILLER PIC X(8). SQ2274.2 +020600 07 XRECORD-KEY PIC X(29). SQ2274.2 +020700 07 FILLER PIC X(9). SQ2274.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ2274.2 +020900 07 FILLER PIC X(9). SQ2274.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ2274.2 +021100 07 FILLER PIC X(7). SQ2274.2 +021200* SQ2274.2 +021300 01 TEST-RESULTS. SQ2274.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2274.2 +021500 02 PAR-NAME. SQ2274.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ2274.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ2274.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2274.2 +021900 02 FILLER PIC X VALUE SPACE. SQ2274.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ2274.2 +022100 02 FILLER PIC X VALUE SPACE. SQ2274.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2274.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ2274.2 +022400 02 RE-MARK PIC X(61). SQ2274.2 +022500 01 TEST-COMPUTED. SQ2274.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ2274.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2274.2 +022800 02 COMPUTED-X. SQ2274.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2274.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2274.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2274.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2274.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2274.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2274.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ2274.2 +023600 04 FILLER PIC X. SQ2274.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ2274.2 +023800 01 TEST-CORRECT. SQ2274.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ2274.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2274.2 +024100 02 CORRECT-X. SQ2274.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2274.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2274.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2274.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2274.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2274.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ2274.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ2274.2 +024900 04 FILLER PIC X. SQ2274.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ2274.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2274.2 +025200* SQ2274.2 +025300 01 CCVS-C-1. SQ2274.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2274.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2274.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2274.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2274.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2274.2 +026200 01 CCVS-C-2. SQ2274.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ2274.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ2274.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ2274.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ2274.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ2274.2 +026800* SQ2274.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2274.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ2274.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2274.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2274.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2274.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2274.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2274.2 +028000 01 CCVS-H-1. SQ2274.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ2274.2 +028200 02 FILLER PIC X(42) VALUE SQ2274.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2274.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ2274.2 +028500 01 CCVS-H-2A. SQ2274.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ2274.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2274.2 +028800 02 FILLER PIC XXXX VALUE SQ2274.2 +028900 "4.2 ". SQ2274.2 +029000 02 FILLER PIC X(28) VALUE SQ2274.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ2274.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ2274.2 +029300* SQ2274.2 +029400 01 CCVS-H-2B. SQ2274.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2274.2 +029600 02 TEST-ID PIC X(9). SQ2274.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ2274.2 +029800 02 FILLER PIC X(12) VALUE SQ2274.2 +029900 " HIGH ". SQ2274.2 +030000 02 FILLER PIC X(22) VALUE SQ2274.2 +030100 " LEVEL VALIDATION FOR ". SQ2274.2 +030200 02 FILLER PIC X(58) VALUE SQ2274.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +030400 01 CCVS-H-3. SQ2274.2 +030500 02 FILLER PIC X(34) VALUE SQ2274.2 +030600 " FOR OFFICIAL USE ONLY ". SQ2274.2 +030700 02 FILLER PIC X(58) VALUE SQ2274.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2274.2 +030900 02 FILLER PIC X(28) VALUE SQ2274.2 +031000 " COPYRIGHT 1985,1986 ". SQ2274.2 +031100 01 CCVS-E-1. SQ2274.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ2274.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2274.2 +031400 02 ID-AGAIN PIC X(9). SQ2274.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ2274.2 +031600 01 CCVS-E-2. SQ2274.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ2274.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ2274.2 +031900 02 CCVS-E-2-2. SQ2274.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2274.2 +032100 03 FILLER PIC X VALUE SPACE. SQ2274.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ2274.2 +032300 "ERRORS ENCOUNTERED". SQ2274.2 +032400 01 CCVS-E-3. SQ2274.2 +032500 02 FILLER PIC X(22) VALUE SQ2274.2 +032600 " FOR OFFICIAL USE ONLY". SQ2274.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ2274.2 +032800 02 FILLER PIC X(58) VALUE SQ2274.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ2274.2 +033100 02 FILLER PIC X(20) VALUE SQ2274.2 +033200 " COPYRIGHT 1985,1986". SQ2274.2 +033300 01 CCVS-E-4. SQ2274.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2274.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ2274.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2274.2 +033700 02 FILLER PIC X(40) VALUE SQ2274.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2274.2 +033900 01 XXINFO. SQ2274.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2274.2 +034100 02 INFO-TEXT. SQ2274.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ2274.2 +034300 04 XXCOMPUTED PIC X(20). SQ2274.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ2274.2 +034500 04 XXCORRECT PIC X(20). SQ2274.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ2274.2 +034700 01 HYPHEN-LINE. SQ2274.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ2274.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2274.2 +035000- "*****************************************". SQ2274.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2274.2 +035200- "******************************". SQ2274.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2274.2 +035400 "SQ227A". SQ2274.2 +035500* SQ2274.2 +035600* SQ2274.2 +035700 PROCEDURE DIVISION. SQ2274.2 +035800 DECLARATIVES. SQ2274.2 +035900* SQ2274.2 +036000 SECT-SQ227A-0001 SECTION. SQ2274.2 +036100 USE AFTER EXCEPTION PROCEDURE I-O. SQ2274.2 +036200 I-O-ERROR-PROCESS. SQ2274.2 +036300 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +036400 IF DECL-EXEC-SW NOT = SPACE SQ2274.2 +036500 GO TO END-DECLS. SQ2274.2 +036600* SQ2274.2 +036700 MOVE 1 TO REC-CT. SQ2274.2 +036800 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ2274.2 +036900 GO TO DCL-REWRITE-01-01. SQ2274.2 +037000 DECL-DELETE-01-01. SQ2274.2 +037100 PERFORM DECL-DE-LETE. SQ2274.2 +037200 GO TO DECL-TEST-01-01-END. SQ2274.2 +037300 DCL-REWRITE-01-01. SQ2274.2 +037400 IF SQ-FS4-STATUS = "44" SQ2274.2 +037500 PERFORM DECL-PASS SQ2274.2 +037600 ELSE SQ2274.2 +037700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +037800 MOVE "44" TO CORRECT-A SQ2274.2 +037900 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ2274.2 +038000 TO RE-MARK SQ2274.2 +038100 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ2274.2 +038200 PERFORM DECL-FAIL. SQ2274.2 +038300 DECL-TEST-01-01-END. SQ2274.2 +038400* SQ2274.2 +038500 ADD 1 TO REC-CT. SQ2274.2 +038600 GO TO DCL-REWRITE-01-02. SQ2274.2 +038700 DECL-DELETE-01-02. SQ2274.2 +038800 PERFORM DECL-DE-LETE. SQ2274.2 +038900 GO TO DECL-TEST-01-02-END. SQ2274.2 +039000 DCL-REWRITE-01-02. SQ2274.2 +039100 IF SQ-FS4R1-F-G-120 = FILE-RECORD-INFO-P1-120 (1) SQ2274.2 +039200 PERFORM DECL-PASS SQ2274.2 +039300 ELSE SQ2274.2 +039400 MOVE "FIRST 120 CHARACTERS OF RECORD AREA CHANGED" SQ2274.2 +039500 TO RE-MARK SQ2274.2 +039600 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ2274.2 +039700 PERFORM DECL-FAIL. SQ2274.2 +039800 DECL-TEST-01-02-END. SQ2274.2 +039900* SQ2274.2 +040000 ADD 1 TO REC-CT. SQ2274.2 +040100 GO TO DCL-REWRITE-01-03. SQ2274.2 +040200 DECL-DELETE-01-03. SQ2274.2 +040300 PERFORM DECL-DE-LETE. SQ2274.2 +040400 GO TO DECL-TEST-01-03-END. SQ2274.2 +040500 DCL-REWRITE-01-03. SQ2274.2 +040600 IF EXT-18 = "ABCDEFGHIJKLMNOPQR" SQ2274.2 +040700 PERFORM DECL-PASS SQ2274.2 +040800 ELSE SQ2274.2 +040900 MOVE EXT-18 TO COMPUTED-A SQ2274.2 +041000 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A SQ2274.2 +041100 MOVE "LAST 18 CHARACTERS OF RECORD CHANGED" SQ2274.2 +041200 TO RE-MARK SQ2274.2 +041300 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ2274.2 +041400 PERFORM DECL-FAIL. SQ2274.2 +041500 DECL-TEST-01-03-END. SQ2274.2 +041600* SQ2274.2 +041700 PERFORM DECL-WRITE-LINE. SQ2274.2 +041800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2274.2 +041900 TO DUMMY-RECORD. SQ2274.2 +042000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2274.2 +042100 GO TO END-DECLS. SQ2274.2 +042200* SQ2274.2 +042300* SQ2274.2 +042400 DECL-PASS. SQ2274.2 +042500 MOVE "PASS " TO P-OR-F. SQ2274.2 +042600 ADD 1 TO PASS-COUNTER. SQ2274.2 +042700 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +042800* SQ2274.2 +042900 DECL-FAIL. SQ2274.2 +043000 MOVE "FAIL*" TO P-OR-F. SQ2274.2 +043100 ADD 1 TO ERROR-COUNTER. SQ2274.2 +043200 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +043300* SQ2274.2 +043400 DECL-DE-LETE. SQ2274.2 +043500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2274.2 +043600 MOVE "*****" TO P-OR-F. SQ2274.2 +043700 ADD 1 TO DELETE-COUNTER. SQ2274.2 +043800 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +043900* SQ2274.2 +044000 DECL-PRINT-DETAIL. SQ2274.2 +044100 IF REC-CT NOT EQUAL TO ZERO SQ2274.2 +044200 MOVE "." TO PARDOT-X SQ2274.2 +044300 MOVE REC-CT TO DOTVALUE. SQ2274.2 +044400 MOVE TEST-RESULTS TO PRINT-REC. SQ2274.2 +044500 PERFORM DECL-WRITE-LINE. SQ2274.2 +044600 IF P-OR-F EQUAL TO "FAIL*" SQ2274.2 +044700 PERFORM DECL-WRITE-LINE SQ2274.2 +044800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2274.2 +044900 ELSE SQ2274.2 +045000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2274.2 +045100 MOVE SPACE TO P-OR-F. SQ2274.2 +045200 MOVE SPACE TO COMPUTED-X. SQ2274.2 +045300 MOVE SPACE TO CORRECT-X. SQ2274.2 +045400 IF REC-CT EQUAL TO ZERO SQ2274.2 +045500 MOVE SPACE TO PAR-NAME. SQ2274.2 +045600 MOVE SPACE TO RE-MARK. SQ2274.2 +045700* SQ2274.2 +045800 DECL-WRITE-LINE. SQ2274.2 +045900 ADD 1 TO RECORD-COUNT. SQ2274.2 +046000Y IF RECORD-COUNT GREATER 50 SQ2274.2 +046100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2274.2 +046200Y MOVE SPACE TO DUMMY-RECORD SQ2274.2 +046300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2274.2 +046400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2274.2 +046500Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2274.2 +046600Y PERFORM DECL-WRT-LN 2 TIMES SQ2274.2 +046700Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2274.2 +046800Y PERFORM DECL-WRT-LN SQ2274.2 +046900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2274.2 +047000Y MOVE ZERO TO RECORD-COUNT. SQ2274.2 +047100 PERFORM DECL-WRT-LN. SQ2274.2 +047200* SQ2274.2 +047300 DECL-WRT-LN. SQ2274.2 +047400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2274.2 +047500 MOVE SPACE TO DUMMY-RECORD. SQ2274.2 +047600* SQ2274.2 +047700 DECL-FAIL-ROUTINE. SQ2274.2 +047800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2274.2 +047900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2274.2 +048000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +048100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2274.2 +048200 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +048300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +048500 GO TO DECL-FAIL-EX. SQ2274.2 +048600 DECL-FAIL-WRITE. SQ2274.2 +048700 MOVE TEST-COMPUTED TO PRINT-REC SQ2274.2 +048800 PERFORM DECL-WRITE-LINE SQ2274.2 +048900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2274.2 +049000 MOVE TEST-CORRECT TO PRINT-REC SQ2274.2 +049100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +049200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2274.2 +049300 DECL-FAIL-EX. SQ2274.2 +049400 EXIT. SQ2274.2 +049500* SQ2274.2 +049600 DECL-BAIL. SQ2274.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2274.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2274.2 +049900 DECL-BAIL-WRITE. SQ2274.2 +050000 MOVE CORRECT-A TO XXCORRECT. SQ2274.2 +050100 MOVE COMPUTED-A TO XXCOMPUTED. SQ2274.2 +050200 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +050300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +050400 DECL-BAIL-EX. SQ2274.2 +050500 EXIT. SQ2274.2 +050600* SQ2274.2 +050700 END-DECLS. SQ2274.2 +050800 END DECLARATIVES. SQ2274.2 +050900* SQ2274.2 +051000* SQ2274.2 +051100 CCVS1 SECTION. SQ2274.2 +051200 OPEN-FILES. SQ2274.2 +051300P OPEN I-O RAW-DATA. SQ2274.2 +051400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2274.2 +051500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2274.2 +051600P MOVE "ABORTED " TO C-ABORT. SQ2274.2 +051700P ADD 1 TO C-NO-OF-TESTS. SQ2274.2 +051800P ACCEPT C-DATE FROM DATE. SQ2274.2 +051900P ACCEPT C-TIME FROM TIME. SQ2274.2 +052000P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2274.2 +052100PEND-E-1. SQ2274.2 +052200P CLOSE RAW-DATA. SQ2274.2 +052300 OPEN OUTPUT PRINT-FILE. SQ2274.2 +052400 MOVE CCVS-PGM-ID TO TEST-ID. SQ2274.2 +052500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2274.2 +052600 MOVE SPACE TO TEST-RESULTS. SQ2274.2 +052700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2274.2 +052800 MOVE ZERO TO REC-SKEL-SUB. SQ2274.2 +052900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2274.2 +053000 GO TO CCVS1-EXIT. SQ2274.2 +053100* SQ2274.2 +053200 CCVS-INIT-FILE. SQ2274.2 +053300 ADD 1 TO REC-SKL-SUB. SQ2274.2 +053400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2274.2 +053500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2274.2 +053600* SQ2274.2 +053700 CLOSE-FILES. SQ2274.2 +053800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2274.2 +053900 CLOSE PRINT-FILE. SQ2274.2 +054000P OPEN I-O RAW-DATA. SQ2274.2 +054100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2274.2 +054200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2274.2 +054300P MOVE "OK. " TO C-ABORT. SQ2274.2 +054400P MOVE PASS-COUNTER TO C-OK. SQ2274.2 +054500P MOVE ERROR-HOLD TO C-ALL. SQ2274.2 +054600P MOVE ERROR-COUNTER TO C-FAIL. SQ2274.2 +054700P MOVE DELETE-CNT TO C-DELETED. SQ2274.2 +054800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2274.2 +054900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2274.2 +055000PEND-E-2. SQ2274.2 +055100P CLOSE RAW-DATA. SQ2274.2 +055200 TERMINATE-CCVS. SQ2274.2 +055300S EXIT PROGRAM. SQ2274.2 +055400 STOP RUN. SQ2274.2 +055500* SQ2274.2 +055600 INSPT. SQ2274.2 +055700 MOVE "INSPT" TO P-OR-F. SQ2274.2 +055800 ADD 1 TO INSPECT-COUNTER. SQ2274.2 +055900 PERFORM PRINT-DETAIL. SQ2274.2 +056000* SQ2274.2 +056100 PASS. SQ2274.2 +056200 MOVE "PASS " TO P-OR-F. SQ2274.2 +056300 ADD 1 TO PASS-COUNTER. SQ2274.2 +056400 PERFORM PRINT-DETAIL. SQ2274.2 +056500* SQ2274.2 +056600 FAIL. SQ2274.2 +056700 MOVE "FAIL*" TO P-OR-F. SQ2274.2 +056800 ADD 1 TO ERROR-COUNTER. SQ2274.2 +056900 PERFORM PRINT-DETAIL. SQ2274.2 +057000* SQ2274.2 +057100 DE-LETE. SQ2274.2 +057200 MOVE "****TEST DELETED****" TO RE-MARK. SQ2274.2 +057300 MOVE "*****" TO P-OR-F. SQ2274.2 +057400 ADD 1 TO DELETE-COUNTER. SQ2274.2 +057500 PERFORM PRINT-DETAIL. SQ2274.2 +057600* SQ2274.2 +057700 PRINT-DETAIL. SQ2274.2 +057800 IF REC-CT NOT EQUAL TO ZERO SQ2274.2 +057900 MOVE "." TO PARDOT-X SQ2274.2 +058000 MOVE REC-CT TO DOTVALUE. SQ2274.2 +058100 MOVE TEST-RESULTS TO PRINT-REC. SQ2274.2 +058200 PERFORM WRITE-LINE. SQ2274.2 +058300 IF P-OR-F EQUAL TO "FAIL*" SQ2274.2 +058400 PERFORM WRITE-LINE SQ2274.2 +058500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2274.2 +058600 ELSE SQ2274.2 +058700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2274.2 +058800 MOVE SPACE TO P-OR-F. SQ2274.2 +058900 MOVE SPACE TO COMPUTED-X. SQ2274.2 +059000 MOVE SPACE TO CORRECT-X. SQ2274.2 +059100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2274.2 +059200 MOVE SPACE TO RE-MARK. SQ2274.2 +059300* SQ2274.2 +059400 HEAD-ROUTINE. SQ2274.2 +059500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +059600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +059700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2274.2 +059800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2274.2 +059900 COLUMN-NAMES-ROUTINE. SQ2274.2 +060000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +060100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +060200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +060300 END-ROUTINE. SQ2274.2 +060400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2274.2 +060500 PERFORM WRITE-LINE 5 TIMES. SQ2274.2 +060600 END-RTN-EXIT. SQ2274.2 +060700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2274.2 +060800 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +060900* SQ2274.2 +061000 END-ROUTINE-1. SQ2274.2 +061100 ADD ERROR-COUNTER TO ERROR-HOLD SQ2274.2 +061200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2274.2 +061300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2274.2 +061400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2274.2 +061500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2274.2 +061600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2274.2 +061700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2274.2 +061800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2274.2 +061900 PERFORM WRITE-LINE. SQ2274.2 +062000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2274.2 +062100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2274.2 +062200 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +062300 ELSE SQ2274.2 +062400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2274.2 +062500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2274.2 +062600 PERFORM WRITE-LINE. SQ2274.2 +062700 END-ROUTINE-13. SQ2274.2 +062800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2274.2 +062900 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +063000 ELSE SQ2274.2 +063100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2274.2 +063200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2274.2 +063300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2274.2 +063400 PERFORM WRITE-LINE. SQ2274.2 +063500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2274.2 +063600 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +063700 ELSE SQ2274.2 +063800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2274.2 +063900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2274.2 +064000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +064100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +064200* SQ2274.2 +064300 WRITE-LINE. SQ2274.2 +064400 ADD 1 TO RECORD-COUNT. SQ2274.2 +064500Y IF RECORD-COUNT GREATER 50 SQ2274.2 +064600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2274.2 +064700Y MOVE SPACE TO DUMMY-RECORD SQ2274.2 +064800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2274.2 +064900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2274.2 +065000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2274.2 +065100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2274.2 +065200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2274.2 +065300Y MOVE ZERO TO RECORD-COUNT. SQ2274.2 +065400 PERFORM WRT-LN. SQ2274.2 +065500* SQ2274.2 +065600 WRT-LN. SQ2274.2 +065700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2274.2 +065800 MOVE SPACE TO DUMMY-RECORD. SQ2274.2 +065900 BLANK-LINE-PRINT. SQ2274.2 +066000 PERFORM WRT-LN. SQ2274.2 +066100 FAIL-ROUTINE. SQ2274.2 +066200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2274.2 +066300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2274.2 +066400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +066500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2274.2 +066600 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +066700 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +066800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +066900 GO TO FAIL-ROUTINE-EX. SQ2274.2 +067000 FAIL-ROUTINE-WRITE. SQ2274.2 +067100 MOVE TEST-COMPUTED TO PRINT-REC SQ2274.2 +067200 PERFORM WRITE-LINE SQ2274.2 +067300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2274.2 +067400 MOVE TEST-CORRECT TO PRINT-REC SQ2274.2 +067500 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +067600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2274.2 +067700 FAIL-ROUTINE-EX. SQ2274.2 +067800 EXIT. SQ2274.2 +067900 BAIL-OUT. SQ2274.2 +068000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2274.2 +068100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2274.2 +068200 BAIL-OUT-WRITE. SQ2274.2 +068300 MOVE CORRECT-A TO XXCORRECT. SQ2274.2 +068400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2274.2 +068500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +068600 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +068700 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +068800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +068900 BAIL-OUT-EX. SQ2274.2 +069000 EXIT. SQ2274.2 +069100 CCVS1-EXIT. SQ2274.2 +069200 EXIT. SQ2274.2 +069300* SQ2274.2 +069400**************************************************************** SQ2274.2 +069500* * SQ2274.2 +069600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2274.2 +069700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2274.2 +069800* * SQ2274.2 +069900**************************************************************** SQ2274.2 +070000* SQ2274.2 +070100 SECT-SQ227A-0002 SECTION. SQ2274.2 +070200 STA-INIT. SQ2274.2 +070300 MOVE SPACE TO DELETE-SW. SQ2274.2 +070400* SQ2274.2 +070500 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2274.2 +070600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2274.2 +070700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2274.2 +070800 MOVE 120 TO XRECORD-LENGTH (1). SQ2274.2 +070900 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2274.2 +071000 MOVE 1 TO XBLOCK-SIZE (1). SQ2274.2 +071100 MOVE 1 TO RECORDS-IN-FILE (1). SQ2274.2 +071200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2274.2 +071300 MOVE "S" TO XLABEL-TYPE (1). SQ2274.2 +071400* SQ2274.2 +071500* OPEN THE FILE IN THE OUTPUT MODE SQ2274.2 +071600* SQ2274.2 +071700 SEQ-INIT-01. SQ2274.2 +071800 MOVE 0 TO REC-CT. SQ2274.2 +071900 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +072000 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +072100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +072200 MOVE ZERO TO XRECORD-NUMBER (1). SQ2274.2 +072300 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2274.2 +072400 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2274.2 +072500 GO TO SEQ-TEST-OP-01. SQ2274.2 +072600 SEQ-DELETE-01. SQ2274.2 +072700 MOVE "*" TO DELETE-SW-1. SQ2274.2 +072800 GO TO SEQ-DELETE-01-01. SQ2274.2 +072900 SEQ-TEST-OP-01. SQ2274.2 +073000 OPEN OUTPUT SQ-FS4. SQ2274.2 +073100* SQ2274.2 +073200* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ2274.2 +073300* SQ2274.2 +073400 ADD 1 TO REC-CT. SQ2274.2 +073500 IF DELETE-SW NOT = SPACE SQ2274.2 +073600 GO TO SEQ-DELETE-01-01. SQ2274.2 +073700 GO TO SEQ-TEST-OP-01-01. SQ2274.2 +073800 SEQ-DELETE-01-01. SQ2274.2 +073900 PERFORM DE-LETE. SQ2274.2 +074000 GO TO SEQ-TEST-01-01-END. SQ2274.2 +074100 SEQ-TEST-OP-01-01. SQ2274.2 +074200 IF SQ-FS4-STATUS = "00" SQ2274.2 +074300 PERFORM PASS SQ2274.2 +074400 ELSE SQ2274.2 +074500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +074600 MOVE "00" TO CORRECT-A SQ2274.2 +074700 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ2274.2 +074800 TO RE-MARK SQ2274.2 +074900 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ2274.2 +075000 PERFORM FAIL. SQ2274.2 +075100 SEQ-TEST-01-01-END. SQ2274.2 +075200* SQ2274.2 +075300* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +075400* SQ2274.2 +075500 ADD 1 TO REC-CT. SQ2274.2 +075600 IF DELETE-SW NOT = SPACE SQ2274.2 +075700 GO TO SEQ-DELETE-01-02. SQ2274.2 +075800 GO TO SEQ-TEST-OP-01-02. SQ2274.2 +075900 SEQ-DELETE-01-02. SQ2274.2 +076000 PERFORM DE-LETE. SQ2274.2 +076100 GO TO SEQ-TEST-01-02-END. SQ2274.2 +076200 SEQ-TEST-OP-01-02. SQ2274.2 +076300 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +076400 PERFORM PASS SQ2274.2 +076500 ELSE SQ2274.2 +076600 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +076700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +076800 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +076900 TO RE-MARK SQ2274.2 +077000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +077100 PERFORM FAIL. SQ2274.2 +077200 SEQ-TEST-01-02-END. SQ2274.2 +077300* SQ2274.2 +077400* SQ2274.2 +077500* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD OF 120 CHARS. SQ2274.2 +077600* SQ2274.2 +077700 SEQ-INIT-02. SQ2274.2 +077800 MOVE 0 TO REC-CT. SQ2274.2 +077900 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +078000 ADD 1 TO XRECORD-NUMBER (1). SQ2274.2 +078100 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +078200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +078300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2274.2 +078400 MOVE "987654321123456789" TO EXT-18. SQ2274.2 +078500 MOVE 120 TO SQ-FS4-RECSIZE. SQ2274.2 +078600 MOVE "WRITE A RECORD" TO FEATURE. SQ2274.2 +078700 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2274.2 +078800 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +078900 GO TO SEQ-DELETE-02. SQ2274.2 +079000 GO TO SEQ-TEST-WR-02. SQ2274.2 +079100 SEQ-DELETE-02. SQ2274.2 +079200 MOVE "*" TO DELETE-SW-2. SQ2274.2 +079300 GO TO SEQ-DELETE-02-01. SQ2274.2 +079400 SEQ-TEST-WR-02. SQ2274.2 +079500 WRITE SQ-FS4R2-F-G-138. SQ2274.2 +079600* SQ2274.2 +079700* CHECK I-O STATUS RETURNED FROM WRITE SQ2274.2 +079800* SQ2274.2 +079900 ADD 1 TO REC-CT. SQ2274.2 +080000 IF DELETE-SW NOT = SPACE SQ2274.2 +080100 GO TO SEQ-DELETE-02-01. SQ2274.2 +080200 GO TO SEQ-TEST-WR-02-01. SQ2274.2 +080300 SEQ-DELETE-02-01. SQ2274.2 +080400 PERFORM DE-LETE. SQ2274.2 +080500 GO TO SEQ-TEST-02-01-END. SQ2274.2 +080600 SEQ-TEST-WR-02-01. SQ2274.2 +080700 IF SQ-FS4-STATUS = "00" SQ2274.2 +080800 PERFORM PASS SQ2274.2 +080900 ELSE SQ2274.2 +081000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +081100 MOVE "00" TO CORRECT-A SQ2274.2 +081200 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ2274.2 +081300 TO RE-MARK SQ2274.2 +081400 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ2274.2 +081500 PERFORM FAIL. SQ2274.2 +081600 SEQ-TEST-02-01-END. SQ2274.2 +081700* SQ2274.2 +081800* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +081900* SQ2274.2 +082000 ADD 1 TO REC-CT. SQ2274.2 +082100 IF DELETE-SW NOT = SPACE SQ2274.2 +082200 GO TO SEQ-DELETE-02-02. SQ2274.2 +082300 GO TO SEQ-TEST-WR-02-02. SQ2274.2 +082400 SEQ-DELETE-02-02. SQ2274.2 +082500 PERFORM DE-LETE. SQ2274.2 +082600 GO TO SEQ-TEST-02-02-END. SQ2274.2 +082700 SEQ-TEST-WR-02-02. SQ2274.2 +082800 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +082900 PERFORM PASS SQ2274.2 +083000 ELSE SQ2274.2 +083100 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +083200 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +083300 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +083400 TO RE-MARK SQ2274.2 +083500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +083600 PERFORM FAIL. SQ2274.2 +083700 SEQ-TEST-02-02-END. SQ2274.2 +083800* SQ2274.2 +083900* SQ2274.2 +084000* NOW CLOSE THE FILE. SQ2274.2 +084100* SQ2274.2 +084200 SEQ-INIT-03. SQ2274.2 +084300 MOVE 0 TO REC-CT. SQ2274.2 +084400 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +084500 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +084600 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +084700 MOVE "CLOSE FILE" TO FEATURE. SQ2274.2 +084800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2274.2 +084900 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +085000 GO TO SEQ-DELETE-03. SQ2274.2 +085100 GO TO SEQ-TEST-CL-03. SQ2274.2 +085200 SEQ-DELETE-03. SQ2274.2 +085300 MOVE "*" TO DELETE-SW-2. SQ2274.2 +085400 GO TO SEQ-DELETE-03-01. SQ2274.2 +085500 SEQ-TEST-CL-03. SQ2274.2 +085600 CLOSE SQ-FS4. SQ2274.2 +085700* SQ2274.2 +085800* CHECK I-O STATUS RETURNED FROM CLOSE SQ2274.2 +085900* SQ2274.2 +086000 ADD 1 TO REC-CT. SQ2274.2 +086100 IF DELETE-SW NOT = SPACE SQ2274.2 +086200 GO TO SEQ-DELETE-03-01. SQ2274.2 +086300 GO TO SEQ-TEST-CL-03-01. SQ2274.2 +086400 SEQ-DELETE-03-01. SQ2274.2 +086500 PERFORM DE-LETE. SQ2274.2 +086600 GO TO SEQ-TEST-03-01-END. SQ2274.2 +086700 SEQ-TEST-CL-03-01. SQ2274.2 +086800 IF SQ-FS4-STATUS = "00" SQ2274.2 +086900 PERFORM PASS SQ2274.2 +087000 ELSE SQ2274.2 +087100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +087200 MOVE "00" TO CORRECT-A SQ2274.2 +087300 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ2274.2 +087400 TO RE-MARK SQ2274.2 +087500 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ2274.2 +087600 PERFORM FAIL. SQ2274.2 +087700 SEQ-TEST-03-01-END. SQ2274.2 +087800* SQ2274.2 +087900* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +088000* SQ2274.2 +088100 ADD 1 TO REC-CT. SQ2274.2 +088200 IF DELETE-SW NOT = SPACE SQ2274.2 +088300 GO TO SEQ-DELETE-03-02. SQ2274.2 +088400 GO TO SEQ-TEST-CL-03-02. SQ2274.2 +088500 SEQ-DELETE-03-02. SQ2274.2 +088600 PERFORM DE-LETE. SQ2274.2 +088700 GO TO SEQ-TEST-03-02-END. SQ2274.2 +088800 SEQ-TEST-CL-03-02. SQ2274.2 +088900 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +089000 PERFORM PASS SQ2274.2 +089100 ELSE SQ2274.2 +089200 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +089300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +089400 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +089500 TO RE-MARK SQ2274.2 +089600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +089700 PERFORM FAIL. SQ2274.2 +089800 SEQ-TEST-03-02-END. SQ2274.2 +089900 MOVE SPACE TO DELETE-SW-2. SQ2274.2 +090000* SQ2274.2 +090100* SQ2274.2 +090200* OPEN THE FILE IN THE I-O MODE SQ2274.2 +090300* SQ2274.2 +090400 SEQ-INIT-04. SQ2274.2 +090500 MOVE 0 TO REC-CT. SQ2274.2 +090600 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +090700 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +090800 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +090900 MOVE ZERO TO XRECORD-NUMBER (1). SQ2274.2 +091000 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ2274.2 +091100 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2274.2 +091200 IF DELETE-SW NOT = SPACE SQ2274.2 +091300 GO TO SEQ-DELETE-04-01. SQ2274.2 +091400 GO TO SEQ-TEST-OP-04. SQ2274.2 +091500 SEQ-DELETE-04. SQ2274.2 +091600 MOVE "*" TO DELETE-SW-2. SQ2274.2 +091700 GO TO SEQ-DELETE-04-01. SQ2274.2 +091800 SEQ-TEST-OP-04. SQ2274.2 +091900 OPEN I-O SQ-FS4. SQ2274.2 +092000* SQ2274.2 +092100* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ2274.2 +092200* SQ2274.2 +092300 ADD 1 TO REC-CT. SQ2274.2 +092400 IF DELETE-SW NOT = SPACE SQ2274.2 +092500 GO TO SEQ-DELETE-04-01. SQ2274.2 +092600 GO TO SEQ-TEST-OP-04-01. SQ2274.2 +092700 SEQ-DELETE-04-01. SQ2274.2 +092800 PERFORM DE-LETE. SQ2274.2 +092900 GO TO SEQ-TEST-04-01-END. SQ2274.2 +093000 SEQ-TEST-OP-04-01. SQ2274.2 +093100 IF SQ-FS4-STATUS = "00" SQ2274.2 +093200 PERFORM PASS SQ2274.2 +093300 ELSE SQ2274.2 +093400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +093500 MOVE "00" TO CORRECT-A SQ2274.2 +093600 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ2274.2 +093700 TO RE-MARK SQ2274.2 +093800 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ2274.2 +093900 PERFORM FAIL. SQ2274.2 +094000 SEQ-TEST-04-01-END. SQ2274.2 +094100* SQ2274.2 +094200 ADD 1 TO REC-CT. SQ2274.2 +094300 IF DELETE-SW NOT = SPACE SQ2274.2 +094400 GO TO SEQ-DELETE-04-02. SQ2274.2 +094500 GO TO SEQ-TEST-OP-04-02. SQ2274.2 +094600 SEQ-DELETE-04-02. SQ2274.2 +094700 PERFORM DE-LETE. SQ2274.2 +094800 GO TO SEQ-TEST-04-02-END. SQ2274.2 +094900 SEQ-TEST-OP-04-02. SQ2274.2 +095000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +095100 PERFORM PASS SQ2274.2 +095200 ELSE SQ2274.2 +095300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +095400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +095500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE ON OPEN" SQ2274.2 +095600 TO RE-MARK SQ2274.2 +095700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +095800 PERFORM FAIL. SQ2274.2 +095900 SEQ-TEST-04-02-END. SQ2274.2 +096000* SQ2274.2 +096100* SQ2274.2 +096200* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ2274.2 +096300* SQ2274.2 +096400 SEQ-INIT-05. SQ2274.2 +096500 MOVE 0 TO REC-CT. SQ2274.2 +096600 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +096700 ADD 1 TO XRECORD-NUMBER (1). SQ2274.2 +096800 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +096900 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +097000 MOVE ZERO TO SQ-FS4-RECSIZE. SQ2274.2 +097100 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ2274.2 +097200 MOVE "READ FIRST RECORD" TO FEATURE. SQ2274.2 +097300 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2274.2 +097400 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +097500 GO TO SEQ-DELETE-05. SQ2274.2 +097600 GO TO SEQ-TEST-RD-05. SQ2274.2 +097700 SEQ-DELETE-05. SQ2274.2 +097800 MOVE "*" TO DELETE-SW-2. SQ2274.2 +097900 GO TO SEQ-DELETE-05-01. SQ2274.2 +098000 SEQ-TEST-RD-05. SQ2274.2 +098100 READ SQ-FS4. SQ2274.2 +098200* SQ2274.2 +098300* CHECK I-O STATUS RETURNED FROM READ SQ2274.2 +098400* SQ2274.2 +098500 ADD 1 TO REC-CT. SQ2274.2 +098600 IF DELETE-SW NOT = SPACE SQ2274.2 +098700 GO TO SEQ-DELETE-05-01. SQ2274.2 +098800 GO TO SEQ-TEST-RD-05-01. SQ2274.2 +098900 SEQ-DELETE-05-01. SQ2274.2 +099000 PERFORM DE-LETE. SQ2274.2 +099100 GO TO SEQ-TEST-05-01-END. SQ2274.2 +099200 SEQ-TEST-RD-05-01. SQ2274.2 +099300 IF SQ-FS4-STATUS = "00" SQ2274.2 +099400 PERFORM PASS SQ2274.2 +099500 ELSE SQ2274.2 +099600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +099700 MOVE "00" TO CORRECT-A SQ2274.2 +099800 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ2274.2 +099900 TO RE-MARK SQ2274.2 +100000 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2274.2 +100100 PERFORM FAIL. SQ2274.2 +100200 SEQ-TEST-05-01-END. SQ2274.2 +100300* SQ2274.2 +100400* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +100500* SQ2274.2 +100600 ADD 1 TO REC-CT. SQ2274.2 +100700 IF DELETE-SW NOT = SPACE SQ2274.2 +100800 GO TO SEQ-DELETE-05-02. SQ2274.2 +100900 GO TO SEQ-TEST-RD-05-02. SQ2274.2 +101000 SEQ-DELETE-05-02. SQ2274.2 +101100 PERFORM DE-LETE. SQ2274.2 +101200 GO TO SEQ-TEST-05-02-END. SQ2274.2 +101300 SEQ-TEST-RD-05-02. SQ2274.2 +101400 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +101500 PERFORM PASS SQ2274.2 +101600 ELSE SQ2274.2 +101700 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +101800 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +101900 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +102000 TO RE-MARK SQ2274.2 +102100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +102200 PERFORM FAIL. SQ2274.2 +102300 SEQ-TEST-05-02-END. SQ2274.2 +102400* SQ2274.2 +102500* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ2274.2 +102600* CHECKING THE RECORD-NUMBER FIELD. SQ2274.2 +102700* SQ2274.2 +102800 ADD 1 TO REC-CT. SQ2274.2 +102900 IF DELETE-SW NOT = SPACE SQ2274.2 +103000 GO TO SEQ-DELETE-05-03. SQ2274.2 +103100 GO TO SEQ-TEST-RD-05-03. SQ2274.2 +103200 SEQ-DELETE-05-03. SQ2274.2 +103300 PERFORM DE-LETE. SQ2274.2 +103400 GO TO SEQ-TEST-05-03-END. SQ2274.2 +103500 SEQ-TEST-RD-05-03. SQ2274.2 +103600 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ2274.2 +103700 PERFORM PASS SQ2274.2 +103800 ELSE SQ2274.2 +103900 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ2274.2 +104000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ2274.2 +104100 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ2274.2 +104200 PERFORM FAIL. SQ2274.2 +104300 SEQ-TEST-05-03-END. SQ2274.2 +104400* SQ2274.2 +104500* CHECK THE LENGTH OF THE RECORD RETURNED SQ2274.2 +104600* SQ2274.2 +104700 ADD 1 TO REC-CT. SQ2274.2 +104800 IF DELETE-SW NOT = SPACE SQ2274.2 +104900 GO TO SEQ-DELETE-05-04. SQ2274.2 +105000 GO TO SEQ-TEST-RD-05-04. SQ2274.2 +105100 SEQ-DELETE-05-04. SQ2274.2 +105200 PERFORM DE-LETE. SQ2274.2 +105300 GO TO SEQ-TEST-05-04-END. SQ2274.2 +105400 SEQ-TEST-RD-05-04. SQ2274.2 +105500 IF SQ-FS4-RECSIZE = 120 SQ2274.2 +105600 PERFORM PASS SQ2274.2 +105700 ELSE SQ2274.2 +105800 MOVE SQ-FS4-RECSIZE TO COMPUTED-18V0 SQ2274.2 +105900 MOVE 120 TO CORRECT-18V0 SQ2274.2 +106000 MOVE "INCORRECT RECORD LENGTH RETURNED" TO RE-MARK SQ2274.2 +106100 MOVE "VII-32, 3.8.4(11)" TO ANSI-REFERENCE SQ2274.2 +106200 PERFORM FAIL. SQ2274.2 +106300 SEQ-TEST-05-04-END. SQ2274.2 +106400 MOVE SPACE TO DELETE-SW-2. SQ2274.2 +106500* SQ2274.2 +106600* SQ2274.2 +106700* TRY TO WRITE A RECORD OF A DIFFERENT SIZE THAN READ SQ2274.2 +106800* SQ2274.2 +106900 SEQ-INIT-06. SQ2274.2 +107000 MOVE 0 TO REC-CT. SQ2274.2 +107100 MOVE SPACE TO DECL-EXEC-SW. SQ2274.2 +107200 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +107300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +107400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2274.2 +107500 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ2274.2 +107600 MOVE 130 TO SQ-FS4-RECSIZE. SQ2274.2 +107700 MOVE "REWRITE DIFFERENT SIZE REC" TO FEATURE. SQ2274.2 +107800 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ2274.2 +107900 IF DELETE-SW NOT = SPACE SQ2274.2 +108000 GO TO SEQ-DELETE-06-01. SQ2274.2 +108100 GO TO SEQ-TEST-RW-06. SQ2274.2 +108200 SEQ-DELETE-06. SQ2274.2 +108300 MOVE "*" TO DELETE-SW-2. SQ2274.2 +108400 GO TO SEQ-DELETE-06-01. SQ2274.2 +108500 SEQ-TEST-RW-06. SQ2274.2 +108600 REWRITE SQ-FS4R1-F-G-120. SQ2274.2 +108700 MOVE 0 TO REC-CT. SQ2274.2 +108800* SQ2274.2 +108900* CHECK I-O STATUS RETURNED FROM REWRITE SQ2274.2 +109000* SQ2274.2 +109100 ADD 1 TO REC-CT. SQ2274.2 +109200 IF DELETE-SW NOT = SPACE SQ2274.2 +109300 GO TO SEQ-DELETE-06-01. SQ2274.2 +109400 GO TO SEQ-TEST-RW-06-01. SQ2274.2 +109500 SEQ-DELETE-06-01. SQ2274.2 +109600 PERFORM DE-LETE. SQ2274.2 +109700 GO TO SEQ-TEST-06-01-END. SQ2274.2 +109800 SEQ-TEST-RW-06-01. SQ2274.2 +109900 IF SQ-FS4-STATUS = "44" SQ2274.2 +110000 PERFORM PASS SQ2274.2 +110100 ELSE SQ2274.2 +110200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +110300 MOVE "44" TO CORRECT-A SQ2274.2 +110400 MOVE "UNEXPECTED STATUS CODE FROM REWRITE SQ2274.2 +110500- "OF DIFF SZ REC THAN READ" SQ2274.2 +110600 TO RE-MARK SQ2274.2 +110700 MOVE "VII-41.3.5(4)D, VII-48" TO ANSI-REFERENCE SQ2274.2 +110800 PERFORM FAIL. SQ2274.2 +110900 SEQ-TEST-06-01-END. SQ2274.2 +111000 CCVS-EXIT SECTION. SQ2274.2 +111100 CCVS-999999. SQ2274.2 +111200 GO TO CLOSE-FILES. SQ2274.2 +*END-OF,SQ227A +*HEADER,COBOL,SQ228A +000100 IDENTIFICATION DIVISION. SQ2284.2 +000200 PROGRAM-ID. SQ2284.2 +000300 SQ228A. SQ2284.2 +000400**************************************************************** SQ2284.2 +000500* * SQ2284.2 +000600* VALIDATION FOR:- * SQ2284.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2284.2 +000900* REVISED 1986, AUGUST * SQ2284.2 +001000* * SQ2284.2 +001100* CREATION DATE / VALIDATION DATE * SQ2284.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2284.2 +001300* * SQ2284.2 +001400**************************************************************** SQ2284.2 +001500* * SQ2284.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2284.2 +001700* * SQ2284.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2284.2 +001900* X-55 SYSTEM PRINTER * SQ2284.2 +002000* X-82 SOURCE-COMPUTER * SQ2284.2 +002100* X-83 OBJECT-COMPUTER. * SQ2284.2 +002200* * SQ2284.2 +002300**************************************************************** SQ2284.2 +002400* * SQ2284.2 +002500* SPLIT FROM SQ227A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ2284.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ2284.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO A * SQ2284.2 +002800* RE-WRITE ON A RECORD THAT IS TOO LONG FOR THE FILE. * SQ2284.2 +002900* (SEE SQ227A). * SQ2284.2 +003000* * SQ2284.2 +003100**************************************************************** SQ2284.2 +003200* SQ2284.2 +003300 ENVIRONMENT DIVISION. SQ2284.2 +003400 CONFIGURATION SECTION. SQ2284.2 +003500 SOURCE-COMPUTER. SQ2284.2 +003600 XXXXX082. SQ2284.2 +003700 OBJECT-COMPUTER. SQ2284.2 +003800 XXXXX083. SQ2284.2 +003900* SQ2284.2 +004000 INPUT-OUTPUT SECTION. SQ2284.2 +004100 FILE-CONTROL. SQ2284.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2284.2 +004300 XXXXX055. SQ2284.2 +004400* SQ2284.2 +004500P SELECT RAW-DATA ASSIGN TO SQ2284.2 +004600P XXXXX062 SQ2284.2 +004700P ORGANIZATION IS INDEXED SQ2284.2 +004800P ACCESS MODE IS RANDOM SQ2284.2 +004900P RECORD-KEY IS RAW-DATA-KEY. SQ2284.2 +005000P SQ2284.2 +005100 SELECT SQ-FS4 SQ2284.2 +005200 ASSIGN SQ2284.2 +005300 XXXXX014 SQ2284.2 +005400 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ2284.2 +005500 ACCESS MODE IS SEQUENTIAL SQ2284.2 +005600 ORGANIZATION IS SEQUENTIAL SQ2284.2 +005700 . SQ2284.2 +005800* SQ2284.2 +005900* SQ2284.2 +006000 DATA DIVISION. SQ2284.2 +006100 FILE SECTION. SQ2284.2 +006200 FD PRINT-FILE SQ2284.2 +006300C LABEL RECORDS SQ2284.2 +006400C XXXXX084 SQ2284.2 +006500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2284.2 +006600 . SQ2284.2 +006700 01 PRINT-REC PICTURE X(120). SQ2284.2 +006800 01 DUMMY-RECORD PICTURE X(120). SQ2284.2 +006900P SQ2284.2 +007000PFD RAW-DATA. SQ2284.2 +007100P01 RAW-DATA-SATZ. SQ2284.2 +007200P 05 RAW-DATA-KEY PIC X(6). SQ2284.2 +007300P 05 C-DATE PIC 9(6). SQ2284.2 +007400P 05 C-TIME PIC 9(8). SQ2284.2 +007500P 05 NO-OF-TESTS PIC 99. SQ2284.2 +007600P 05 C-OK PIC 999. SQ2284.2 +007700P 05 C-ALL PIC 999. SQ2284.2 +007800P 05 C-FAIL PIC 999. SQ2284.2 +007900P 05 C-DELETED PIC 999. SQ2284.2 +008000P 05 C-INSPECT PIC 999. SQ2284.2 +008100P 05 C-NOTE PIC X(13). SQ2284.2 +008200P 05 C-INDENT PIC X. SQ2284.2 +008300P 05 C-ABORT PIC X(8). SQ2284.2 +008400* SQ2284.2 +008500 FD SQ-FS4 SQ2284.2 +008600C LABEL RECORD IS STANDARD SQ2284.2 +008700 BLOCK 138 CHARACTERS SQ2284.2 +008800 RECORD VARYING SIZE FROM 50 TO 138 CHARACTERS SQ2284.2 +008900 DEPENDING ON SQ-FS4-RECSIZE SQ2284.2 +009000 . SQ2284.2 +009100 01 SQ-FS4R1-F-G-120. SQ2284.2 +009200 05 FFILE-RECORD-INFO-P1-120. SQ2284.2 +009300 07 FILLER PIC X(5). SQ2284.2 +009400 07 FFILE-NAME PIC X(6). SQ2284.2 +009500 07 FILLER PIC X(8). SQ2284.2 +009600 07 FRECORD-NAME PIC X(6). SQ2284.2 +009700 07 FILLER PIC X(1). SQ2284.2 +009800 07 FREELUNIT-NUMBER PIC 9(1). SQ2284.2 +009900 07 FILLER PIC X(7). SQ2284.2 +010000 07 FRECORD-NUMBER PIC 9(6). SQ2284.2 +010100 07 FILLER PIC X(6). SQ2284.2 +010200 07 FUPDATE-NUMBER PIC 9(2). SQ2284.2 +010300 07 FILLER PIC X(5). SQ2284.2 +010400 07 FODO-NUMBER PIC 9(4). SQ2284.2 +010500 07 FILLER PIC X(5). SQ2284.2 +010600 07 FPROGRAM-NAME PIC X(5). SQ2284.2 +010700 07 FILLER PIC X(7). SQ2284.2 +010800 07 FRECORD-LENGTH PIC 9(6). SQ2284.2 +010900 07 FILLER PIC X(7). SQ2284.2 +011000 07 FCHARS-OR-RECORDS PIC X(2). SQ2284.2 +011100 07 FILLER PIC X(1). SQ2284.2 +011200 07 FBLOCK-SIZE PIC 9(4). SQ2284.2 +011300 07 FILLER PIC X(6). SQ2284.2 +011400 07 FRECORDS-IN-FILE PIC 9(6). SQ2284.2 +011500 07 FILLER PIC X(5). SQ2284.2 +011600 07 FFILE-ORGANIZATION PIC X(2). SQ2284.2 +011700 07 FILLER PIC X(6). SQ2284.2 +011800 07 FLABEL-TYPE PIC X(1). SQ2284.2 +011900* SQ2284.2 +012000 01 SQ-FS4R2-F-G-138. SQ2284.2 +012100 03 FILLER PIC X(120). SQ2284.2 +012200 03 EXT-18 PIC X(18). SQ2284.2 +012300* SQ2284.2 +012400 WORKING-STORAGE SECTION. SQ2284.2 +012500* SQ2284.2 +012600*************************************************************** SQ2284.2 +012700* * SQ2284.2 +012800* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2284.2 +012900* * SQ2284.2 +013000*************************************************************** SQ2284.2 +013100* SQ2284.2 +013200 01 STATUS-GROUP. SQ2284.2 +013300 04 SQ-FS4-STATUS. SQ2284.2 +013400 07 SQ-FS4-KEY-1 PIC X. SQ2284.2 +013500 07 SQ-FS4-KEY-2 PIC X. SQ2284.2 +013600* SQ2284.2 +013700 01 DELETE-SW. SQ2284.2 +013800 03 DELETE-SW-1 PIC X. SQ2284.2 +013900 03 DELETE-SW-1-GROUP. SQ2284.2 +014000 05 DELETE-SW-2 PIC X. SQ2284.2 +014100* SQ2284.2 +014200 01 DECL-EXEC-I-O PIC X(12). SQ2284.2 +014300* SQ2284.2 +014400 01 DECL-EXEC-SW PIC X. SQ2284.2 +014500* SQ2284.2 +014600 01 SQ-FS4-RECSIZE PIC 999. SQ2284.2 +014700* SQ2284.2 +014800*************************************************************** SQ2284.2 +014900* * SQ2284.2 +015000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2284.2 +015100* * SQ2284.2 +015200*************************************************************** SQ2284.2 +015300* SQ2284.2 +015400 01 REC-SKEL-SUB PIC 99. SQ2284.2 +015500* SQ2284.2 +015600 01 FILE-RECORD-INFORMATION-REC. SQ2284.2 +015700 03 FILE-RECORD-INFO-SKELETON. SQ2284.2 +015800 05 FILLER PICTURE X(48) VALUE SQ2284.2 +015900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2284.2 +016000 05 FILLER PICTURE X(46) VALUE SQ2284.2 +016100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2284.2 +016200 05 FILLER PICTURE X(26) VALUE SQ2284.2 +016300 ",LFIL=000000,ORG= ,LBLR= ". SQ2284.2 +016400 05 FILLER PICTURE X(37) VALUE SQ2284.2 +016500 ",RECKEY= ". SQ2284.2 +016600 05 FILLER PICTURE X(38) VALUE SQ2284.2 +016700 ",ALTKEY1= ". SQ2284.2 +016800 05 FILLER PICTURE X(38) VALUE SQ2284.2 +016900 ",ALTKEY2= ". SQ2284.2 +017000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2284.2 +017100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2284.2 +017200 05 FILE-RECORD-INFO-P1-120. SQ2284.2 +017300 07 FILLER PIC X(5). SQ2284.2 +017400 07 XFILE-NAME PIC X(6). SQ2284.2 +017500 07 FILLER PIC X(8). SQ2284.2 +017600 07 XRECORD-NAME PIC X(6). SQ2284.2 +017700 07 FILLER PIC X(1). SQ2284.2 +017800 07 REELUNIT-NUMBER PIC 9(1). SQ2284.2 +017900 07 FILLER PIC X(7). SQ2284.2 +018000 07 XRECORD-NUMBER PIC 9(6). SQ2284.2 +018100 07 FILLER PIC X(6). SQ2284.2 +018200 07 UPDATE-NUMBER PIC 9(2). SQ2284.2 +018300 07 FILLER PIC X(5). SQ2284.2 +018400 07 ODO-NUMBER PIC 9(4). SQ2284.2 +018500 07 FILLER PIC X(5). SQ2284.2 +018600 07 XPROGRAM-NAME PIC X(5). SQ2284.2 +018700 07 FILLER PIC X(7). SQ2284.2 +018800 07 XRECORD-LENGTH PIC 9(6). SQ2284.2 +018900 07 FILLER PIC X(7). SQ2284.2 +019000 07 CHARS-OR-RECORDS PIC X(2). SQ2284.2 +019100 07 FILLER PIC X(1). SQ2284.2 +019200 07 XBLOCK-SIZE PIC 9(4). SQ2284.2 +019300 07 FILLER PIC X(6). SQ2284.2 +019400 07 RECORDS-IN-FILE PIC 9(6). SQ2284.2 +019500 07 FILLER PIC X(5). SQ2284.2 +019600 07 XFILE-ORGANIZATION PIC X(2). SQ2284.2 +019700 07 FILLER PIC X(6). SQ2284.2 +019800 07 XLABEL-TYPE PIC X(1). SQ2284.2 +019900 05 FILE-RECORD-INFO-P121-240. SQ2284.2 +020000 07 FILLER PIC X(8). SQ2284.2 +020100 07 XRECORD-KEY PIC X(29). SQ2284.2 +020200 07 FILLER PIC X(9). SQ2284.2 +020300 07 ALTERNATE-KEY1 PIC X(29). SQ2284.2 +020400 07 FILLER PIC X(9). SQ2284.2 +020500 07 ALTERNATE-KEY2 PIC X(29). SQ2284.2 +020600 07 FILLER PIC X(7). SQ2284.2 +020700* SQ2284.2 +020800 01 TEST-RESULTS. SQ2284.2 +020900 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021000 02 PAR-NAME. SQ2284.2 +021100 03 FILLER PIC X(14) VALUE SPACE. SQ2284.2 +021200 03 PARDOT-X PIC X VALUE SPACE. SQ2284.2 +021300 03 DOTVALUE PIC 99 VALUE ZERO. SQ2284.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021500 02 FEATURE PIC X(24) VALUE SPACE. SQ2284.2 +021600 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021700 02 P-OR-F PIC X(5) VALUE SPACE. SQ2284.2 +021800 02 FILLER PIC X(9) VALUE SPACE. SQ2284.2 +021900 02 RE-MARK PIC X(61). SQ2284.2 +022000 01 TEST-COMPUTED. SQ2284.2 +022100 02 FILLER PIC X(30) VALUE SPACE. SQ2284.2 +022200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2284.2 +022300 02 COMPUTED-X. SQ2284.2 +022400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2284.2 +022500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2284.2 +022600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2284.2 +022700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2284.2 +022800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2284.2 +022900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2284.2 +023000 04 COMPUTED-18V0 PIC -9(18). SQ2284.2 +023100 04 FILLER PIC X. SQ2284.2 +023200 03 FILLER PIC X(50) VALUE SPACE. SQ2284.2 +023300 01 TEST-CORRECT. SQ2284.2 +023400 02 FILLER PIC X(30) VALUE SPACE. SQ2284.2 +023500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2284.2 +023600 02 CORRECT-X. SQ2284.2 +023700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2284.2 +023800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2284.2 +023900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2284.2 +024000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2284.2 +024100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2284.2 +024200 03 CR-18V0 REDEFINES CORRECT-A. SQ2284.2 +024300 04 CORRECT-18V0 PIC -9(18). SQ2284.2 +024400 04 FILLER PIC X. SQ2284.2 +024500 03 FILLER PIC X(2) VALUE SPACE. SQ2284.2 +024600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2284.2 +024700* SQ2284.2 +024800 01 CCVS-C-1. SQ2284.2 +024900 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2284.2 +025100 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2284.2 +025300 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2284.2 +025500 02 FILLER PIC IS X(9) VALUE SPACE. SQ2284.2 +025600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2284.2 +025700 01 CCVS-C-2. SQ2284.2 +025800 02 FILLER PIC X(19) VALUE SPACE. SQ2284.2 +025900 02 FILLER PIC X(6) VALUE "TESTED". SQ2284.2 +026000 02 FILLER PIC X(19) VALUE SPACE. SQ2284.2 +026100 02 FILLER PIC X(4) VALUE "FAIL". SQ2284.2 +026200 02 FILLER PIC X(72) VALUE SPACE. SQ2284.2 +026300* SQ2284.2 +026400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2284.2 +026500 01 REC-CT PIC 99 VALUE ZERO. SQ2284.2 +026600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +027000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2284.2 +027100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2284.2 +027200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2284.2 +027300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2284.2 +027400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2284.2 +027500 01 CCVS-H-1. SQ2284.2 +027600 02 FILLER PIC X(39) VALUE SPACES. SQ2284.2 +027700 02 FILLER PIC X(42) VALUE SQ2284.2 +027800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2284.2 +027900 02 FILLER PIC X(39) VALUE SPACES. SQ2284.2 +028000 01 CCVS-H-2A. SQ2284.2 +028100 02 FILLER PIC X(40) VALUE SPACE. SQ2284.2 +028200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2284.2 +028300 02 FILLER PIC XXXX VALUE SQ2284.2 +028400 "4.2 ". SQ2284.2 +028500 02 FILLER PIC X(28) VALUE SQ2284.2 +028600 " COPY - NOT FOR DISTRIBUTION". SQ2284.2 +028700 02 FILLER PIC X(41) VALUE SPACE. SQ2284.2 +028800* SQ2284.2 +028900 01 CCVS-H-2B. SQ2284.2 +029000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2284.2 +029100 02 TEST-ID PIC X(9). SQ2284.2 +029200 02 FILLER PIC X(4) VALUE " IN ". SQ2284.2 +029300 02 FILLER PIC X(12) VALUE SQ2284.2 +029400 " HIGH ". SQ2284.2 +029500 02 FILLER PIC X(22) VALUE SQ2284.2 +029600 " LEVEL VALIDATION FOR ". SQ2284.2 +029700 02 FILLER PIC X(58) VALUE SQ2284.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +029900 01 CCVS-H-3. SQ2284.2 +030000 02 FILLER PIC X(34) VALUE SQ2284.2 +030100 " FOR OFFICIAL USE ONLY ". SQ2284.2 +030200 02 FILLER PIC X(58) VALUE SQ2284.2 +030300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2284.2 +030400 02 FILLER PIC X(28) VALUE SQ2284.2 +030500 " COPYRIGHT 1985,1986 ". SQ2284.2 +030600 01 CCVS-E-1. SQ2284.2 +030700 02 FILLER PIC X(52) VALUE SPACE. SQ2284.2 +030800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2284.2 +030900 02 ID-AGAIN PIC X(9). SQ2284.2 +031000 02 FILLER PIC X(45) VALUE SPACES. SQ2284.2 +031100 01 CCVS-E-2. SQ2284.2 +031200 02 FILLER PIC X(31) VALUE SPACE. SQ2284.2 +031300 02 FILLER PIC X(21) VALUE SPACE. SQ2284.2 +031400 02 CCVS-E-2-2. SQ2284.2 +031500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2284.2 +031600 03 FILLER PIC X VALUE SPACE. SQ2284.2 +031700 03 ENDER-DESC PIC X(44) VALUE SQ2284.2 +031800 "ERRORS ENCOUNTERED". SQ2284.2 +031900 01 CCVS-E-3. SQ2284.2 +032000 02 FILLER PIC X(22) VALUE SQ2284.2 +032100 " FOR OFFICIAL USE ONLY". SQ2284.2 +032200 02 FILLER PIC X(12) VALUE SPACE. SQ2284.2 +032300 02 FILLER PIC X(58) VALUE SQ2284.2 +032400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +032500 02 FILLER PIC X(8) VALUE SPACE. SQ2284.2 +032600 02 FILLER PIC X(20) VALUE SQ2284.2 +032700 " COPYRIGHT 1985,1986". SQ2284.2 +032800 01 CCVS-E-4. SQ2284.2 +032900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2284.2 +033000 02 FILLER PIC X(4) VALUE " OF ". SQ2284.2 +033100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2284.2 +033200 02 FILLER PIC X(40) VALUE SQ2284.2 +033300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2284.2 +033400 01 XXINFO. SQ2284.2 +033500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2284.2 +033600 02 INFO-TEXT. SQ2284.2 +033700 04 FILLER PIC X(8) VALUE SPACE. SQ2284.2 +033800 04 XXCOMPUTED PIC X(20). SQ2284.2 +033900 04 FILLER PIC X(5) VALUE SPACE. SQ2284.2 +034000 04 XXCORRECT PIC X(20). SQ2284.2 +034100 02 INF-ANSI-REFERENCE PIC X(48). SQ2284.2 +034200 01 HYPHEN-LINE. SQ2284.2 +034300 02 FILLER PIC IS X VALUE IS SPACE. SQ2284.2 +034400 02 FILLER PIC IS X(65) VALUE IS "************************SQ2284.2 +034500- "*****************************************". SQ2284.2 +034600 02 FILLER PIC IS X(54) VALUE IS "************************SQ2284.2 +034700- "******************************". SQ2284.2 +034800 01 CCVS-PGM-ID PIC X(9) VALUE SQ2284.2 +034900 "SQ228A". SQ2284.2 +035000* SQ2284.2 +035100* SQ2284.2 +035200 PROCEDURE DIVISION. SQ2284.2 +035300 DECLARATIVES. SQ2284.2 +035400* SQ2284.2 +035500 SECT-SQ228A-0001 SECTION. SQ2284.2 +035600 USE AFTER EXCEPTION PROCEDURE I-O. SQ2284.2 +035700 I-O-ERROR-PROCESS. SQ2284.2 +035800 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +035900 IF DECL-EXEC-SW NOT = SPACE SQ2284.2 +036000 GO TO END-DECLS. SQ2284.2 +036100* SQ2284.2 +036200 MOVE 1 TO REC-CT. SQ2284.2 +036300 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ2284.2 +036400 GO TO DCL-REWRITE-01-01. SQ2284.2 +036500 DECL-DELETE-01-01. SQ2284.2 +036600 PERFORM DECL-DE-LETE. SQ2284.2 +036700 GO TO DECL-TEST-01-01-END. SQ2284.2 +036800 DCL-REWRITE-01-01. SQ2284.2 +036900 DECL-TEST-01-01-END. SQ2284.2 +037000* SQ2284.2 +037100 ADD 1 TO REC-CT. SQ2284.2 +037200 GO TO DCL-REWRITE-01-02. SQ2284.2 +037300 DECL-DELETE-01-02. SQ2284.2 +037400 PERFORM DECL-DE-LETE. SQ2284.2 +037500 GO TO DECL-TEST-01-02-END. SQ2284.2 +037600 DCL-REWRITE-01-02. SQ2284.2 +037700 DECL-TEST-01-02-END. SQ2284.2 +037800* SQ2284.2 +037900 ADD 1 TO REC-CT. SQ2284.2 +038000 GO TO DCL-REWRITE-01-03. SQ2284.2 +038100 DECL-DELETE-01-03. SQ2284.2 +038200 PERFORM DECL-DE-LETE. SQ2284.2 +038300 GO TO DECL-TEST-01-03-END. SQ2284.2 +038400 DCL-REWRITE-01-03. SQ2284.2 +038500 DECL-TEST-01-03-END. SQ2284.2 +038600* SQ2284.2 +038700 PERFORM DECL-WRITE-LINE. SQ2284.2 +038800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2284.2 +038900 TO DUMMY-RECORD. SQ2284.2 +039000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2284.2 +039100 GO TO END-DECLS. SQ2284.2 +039200* SQ2284.2 +039300* SQ2284.2 +039400 DECL-PASS. SQ2284.2 +039500 MOVE "PASS " TO P-OR-F. SQ2284.2 +039600 ADD 1 TO PASS-COUNTER. SQ2284.2 +039700 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +039800* SQ2284.2 +039900 DECL-FAIL. SQ2284.2 +040000 MOVE "FAIL*" TO P-OR-F. SQ2284.2 +040100 ADD 1 TO ERROR-COUNTER. SQ2284.2 +040200 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +040300* SQ2284.2 +040400 DECL-DE-LETE. SQ2284.2 +040500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2284.2 +040600 MOVE "*****" TO P-OR-F. SQ2284.2 +040700 ADD 1 TO DELETE-COUNTER. SQ2284.2 +040800 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +040900* SQ2284.2 +041000 DECL-PRINT-DETAIL. SQ2284.2 +041100 IF REC-CT NOT EQUAL TO ZERO SQ2284.2 +041200 MOVE "." TO PARDOT-X SQ2284.2 +041300 MOVE REC-CT TO DOTVALUE. SQ2284.2 +041400 MOVE TEST-RESULTS TO PRINT-REC. SQ2284.2 +041500 PERFORM DECL-WRITE-LINE. SQ2284.2 +041600 IF P-OR-F EQUAL TO "FAIL*" SQ2284.2 +041700 PERFORM DECL-WRITE-LINE SQ2284.2 +041800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2284.2 +041900 ELSE SQ2284.2 +042000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2284.2 +042100 MOVE SPACE TO P-OR-F. SQ2284.2 +042200 MOVE SPACE TO COMPUTED-X. SQ2284.2 +042300 MOVE SPACE TO CORRECT-X. SQ2284.2 +042400 IF REC-CT EQUAL TO ZERO SQ2284.2 +042500 MOVE SPACE TO PAR-NAME. SQ2284.2 +042600 MOVE SPACE TO RE-MARK. SQ2284.2 +042700* SQ2284.2 +042800 DECL-WRITE-LINE. SQ2284.2 +042900 ADD 1 TO RECORD-COUNT. SQ2284.2 +043000Y IF RECORD-COUNT GREATER 50 SQ2284.2 +043100Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2284.2 +043200Y MOVE SPACE TO DUMMY-RECORD SQ2284.2 +043300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2284.2 +043400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2284.2 +043500Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2284.2 +043600Y PERFORM DECL-WRT-LN 2 TIMES SQ2284.2 +043700Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2284.2 +043800Y PERFORM DECL-WRT-LN SQ2284.2 +043900Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2284.2 +044000Y MOVE ZERO TO RECORD-COUNT. SQ2284.2 +044100 PERFORM DECL-WRT-LN. SQ2284.2 +044200* SQ2284.2 +044300 DECL-WRT-LN. SQ2284.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2284.2 +044500 MOVE SPACE TO DUMMY-RECORD. SQ2284.2 +044600* SQ2284.2 +044700 DECL-FAIL-ROUTINE. SQ2284.2 +044800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2284.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2284.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2284.2 +045200 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +045300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +045400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +045500 GO TO DECL-FAIL-EX. SQ2284.2 +045600 DECL-FAIL-WRITE. SQ2284.2 +045700 MOVE TEST-COMPUTED TO PRINT-REC SQ2284.2 +045800 PERFORM DECL-WRITE-LINE SQ2284.2 +045900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2284.2 +046000 MOVE TEST-CORRECT TO PRINT-REC SQ2284.2 +046100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2284.2 +046300 DECL-FAIL-EX. SQ2284.2 +046400 EXIT. SQ2284.2 +046500* SQ2284.2 +046600 DECL-BAIL. SQ2284.2 +046700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2284.2 +046800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2284.2 +046900 DECL-BAIL-WRITE. SQ2284.2 +047000 MOVE CORRECT-A TO XXCORRECT. SQ2284.2 +047100 MOVE COMPUTED-A TO XXCOMPUTED. SQ2284.2 +047200 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +047300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +047400 DECL-BAIL-EX. SQ2284.2 +047500 EXIT. SQ2284.2 +047600* SQ2284.2 +047700 END-DECLS. SQ2284.2 +047800 END DECLARATIVES. SQ2284.2 +047900* SQ2284.2 +048000* SQ2284.2 +048100 CCVS1 SECTION. SQ2284.2 +048200 OPEN-FILES. SQ2284.2 +048300P OPEN I-O RAW-DATA. SQ2284.2 +048400P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2284.2 +048500P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2284.2 +048600P MOVE "ABORTED " TO C-ABORT. SQ2284.2 +048700P ADD 1 TO C-NO-OF-TESTS. SQ2284.2 +048800P ACCEPT C-DATE FROM DATE. SQ2284.2 +048900P ACCEPT C-TIME FROM TIME. SQ2284.2 +049000P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2284.2 +049100PEND-E-1. SQ2284.2 +049200P CLOSE RAW-DATA. SQ2284.2 +049300 OPEN OUTPUT PRINT-FILE. SQ2284.2 +049400 MOVE CCVS-PGM-ID TO TEST-ID. SQ2284.2 +049500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2284.2 +049600 MOVE SPACE TO TEST-RESULTS. SQ2284.2 +049700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2284.2 +049800 MOVE ZERO TO REC-SKEL-SUB. SQ2284.2 +049900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2284.2 +050000 GO TO CCVS1-EXIT. SQ2284.2 +050100* SQ2284.2 +050200 CCVS-INIT-FILE. SQ2284.2 +050300 ADD 1 TO REC-SKL-SUB. SQ2284.2 +050400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2284.2 +050500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2284.2 +050600* SQ2284.2 +050700 CLOSE-FILES. SQ2284.2 +050800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2284.2 +050900 CLOSE PRINT-FILE. SQ2284.2 +051000P OPEN I-O RAW-DATA. SQ2284.2 +051100P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2284.2 +051200P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2284.2 +051300P MOVE "OK. " TO C-ABORT. SQ2284.2 +051400P MOVE PASS-COUNTER TO C-OK. SQ2284.2 +051500P MOVE ERROR-HOLD TO C-ALL. SQ2284.2 +051600P MOVE ERROR-COUNTER TO C-FAIL. SQ2284.2 +051700P MOVE DELETE-CNT TO C-DELETED. SQ2284.2 +051800P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2284.2 +051900P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2284.2 +052000PEND-E-2. SQ2284.2 +052100P CLOSE RAW-DATA. SQ2284.2 +052200 TERMINATE-CCVS. SQ2284.2 +052300S EXIT PROGRAM. SQ2284.2 +052400 STOP RUN. SQ2284.2 +052500* SQ2284.2 +052600 INSPT. SQ2284.2 +052700 MOVE "INSPT" TO P-OR-F. SQ2284.2 +052800 ADD 1 TO INSPECT-COUNTER. SQ2284.2 +052900 PERFORM PRINT-DETAIL. SQ2284.2 +053000* SQ2284.2 +053100 PASS. SQ2284.2 +053200 MOVE "PASS " TO P-OR-F. SQ2284.2 +053300 ADD 1 TO PASS-COUNTER. SQ2284.2 +053400 PERFORM PRINT-DETAIL. SQ2284.2 +053500* SQ2284.2 +053600 FAIL. SQ2284.2 +053700 MOVE "FAIL*" TO P-OR-F. SQ2284.2 +053800 ADD 1 TO ERROR-COUNTER. SQ2284.2 +053900 PERFORM PRINT-DETAIL. SQ2284.2 +054000* SQ2284.2 +054100 DE-LETE. SQ2284.2 +054200 MOVE "****TEST DELETED****" TO RE-MARK. SQ2284.2 +054300 MOVE "*****" TO P-OR-F. SQ2284.2 +054400 ADD 1 TO DELETE-COUNTER. SQ2284.2 +054500 PERFORM PRINT-DETAIL. SQ2284.2 +054600* SQ2284.2 +054700 PRINT-DETAIL. SQ2284.2 +054800 IF REC-CT NOT EQUAL TO ZERO SQ2284.2 +054900 MOVE "." TO PARDOT-X SQ2284.2 +055000 MOVE REC-CT TO DOTVALUE. SQ2284.2 +055100 MOVE TEST-RESULTS TO PRINT-REC. SQ2284.2 +055200 PERFORM WRITE-LINE. SQ2284.2 +055300 IF P-OR-F EQUAL TO "FAIL*" SQ2284.2 +055400 PERFORM WRITE-LINE SQ2284.2 +055500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2284.2 +055600 ELSE SQ2284.2 +055700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2284.2 +055800 MOVE SPACE TO P-OR-F. SQ2284.2 +055900 MOVE SPACE TO COMPUTED-X. SQ2284.2 +056000 MOVE SPACE TO CORRECT-X. SQ2284.2 +056100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2284.2 +056200 MOVE SPACE TO RE-MARK. SQ2284.2 +056300* SQ2284.2 +056400 HEAD-ROUTINE. SQ2284.2 +056500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +056600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +056700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2284.2 +056800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2284.2 +056900 COLUMN-NAMES-ROUTINE. SQ2284.2 +057000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +057100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +057200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +057300 END-ROUTINE. SQ2284.2 +057400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2284.2 +057500 PERFORM WRITE-LINE 5 TIMES. SQ2284.2 +057600 END-RTN-EXIT. SQ2284.2 +057700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2284.2 +057800 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +057900* SQ2284.2 +058000 END-ROUTINE-1. SQ2284.2 +058100 ADD ERROR-COUNTER TO ERROR-HOLD SQ2284.2 +058200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2284.2 +058300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2284.2 +058400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2284.2 +058500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2284.2 +058600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2284.2 +058700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2284.2 +058800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2284.2 +058900 PERFORM WRITE-LINE. SQ2284.2 +059000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2284.2 +059100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2284.2 +059200 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +059300 ELSE SQ2284.2 +059400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2284.2 +059500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2284.2 +059600 PERFORM WRITE-LINE. SQ2284.2 +059700 END-ROUTINE-13. SQ2284.2 +059800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2284.2 +059900 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +060000 ELSE SQ2284.2 +060100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2284.2 +060200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2284.2 +060300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2284.2 +060400 PERFORM WRITE-LINE. SQ2284.2 +060500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2284.2 +060600 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +060700 ELSE SQ2284.2 +060800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2284.2 +060900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2284.2 +061000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +061100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +061200* SQ2284.2 +061300 WRITE-LINE. SQ2284.2 +061400 ADD 1 TO RECORD-COUNT. SQ2284.2 +061500Y IF RECORD-COUNT GREATER 50 SQ2284.2 +061600Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2284.2 +061700Y MOVE SPACE TO DUMMY-RECORD SQ2284.2 +061800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2284.2 +061900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2284.2 +062000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2284.2 +062100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2284.2 +062200Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2284.2 +062300Y MOVE ZERO TO RECORD-COUNT. SQ2284.2 +062400 PERFORM WRT-LN. SQ2284.2 +062500* SQ2284.2 +062600 WRT-LN. SQ2284.2 +062700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2284.2 +062800 MOVE SPACE TO DUMMY-RECORD. SQ2284.2 +062900 BLANK-LINE-PRINT. SQ2284.2 +063000 PERFORM WRT-LN. SQ2284.2 +063100 FAIL-ROUTINE. SQ2284.2 +063200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2284.2 +063300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2284.2 +063400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +063500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2284.2 +063600 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +063700 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +063800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +063900 GO TO FAIL-ROUTINE-EX. SQ2284.2 +064000 FAIL-ROUTINE-WRITE. SQ2284.2 +064100 MOVE TEST-COMPUTED TO PRINT-REC SQ2284.2 +064200 PERFORM WRITE-LINE SQ2284.2 +064300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2284.2 +064400 MOVE TEST-CORRECT TO PRINT-REC SQ2284.2 +064500 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +064600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2284.2 +064700 FAIL-ROUTINE-EX. SQ2284.2 +064800 EXIT. SQ2284.2 +064900 BAIL-OUT. SQ2284.2 +065000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2284.2 +065100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2284.2 +065200 BAIL-OUT-WRITE. SQ2284.2 +065300 MOVE CORRECT-A TO XXCORRECT. SQ2284.2 +065400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2284.2 +065500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +065600 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +065700 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +065800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +065900 BAIL-OUT-EX. SQ2284.2 +066000 EXIT. SQ2284.2 +066100 CCVS1-EXIT. SQ2284.2 +066200 EXIT. SQ2284.2 +066300* SQ2284.2 +066400**************************************************************** SQ2284.2 +066500* * SQ2284.2 +066600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2284.2 +066700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2284.2 +066800* * SQ2284.2 +066900**************************************************************** SQ2284.2 +067000* SQ2284.2 +067100 SECT-SQ228A-0002 SECTION. SQ2284.2 +067200 STA-INIT. SQ2284.2 +067300 MOVE SPACE TO DELETE-SW. SQ2284.2 +067400* SQ2284.2 +067500 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2284.2 +067600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2284.2 +067700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2284.2 +067800 MOVE 120 TO XRECORD-LENGTH (1). SQ2284.2 +067900 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2284.2 +068000 MOVE 1 TO XBLOCK-SIZE (1). SQ2284.2 +068100 MOVE 1 TO RECORDS-IN-FILE (1). SQ2284.2 +068200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2284.2 +068300 MOVE "S" TO XLABEL-TYPE (1). SQ2284.2 +068400* SQ2284.2 +068500* OPEN THE FILE IN THE OUTPUT MODE SQ2284.2 +068600* SQ2284.2 +068700 SEQ-INIT-01. SQ2284.2 +068800 MOVE 0 TO REC-CT. SQ2284.2 +068900 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +069000 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +069100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +069200 MOVE ZERO TO XRECORD-NUMBER (1). SQ2284.2 +069300 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2284.2 +069400 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2284.2 +069500 GO TO SEQ-TEST-OP-01. SQ2284.2 +069600 SEQ-TEST-OP-01. SQ2284.2 +069700 OPEN OUTPUT SQ-FS4. SQ2284.2 +069800 SEQ-INIT-02. SQ2284.2 +069900 MOVE 0 TO REC-CT. SQ2284.2 +070000 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +070100 ADD 1 TO XRECORD-NUMBER (1). SQ2284.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +070400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2284.2 +070500 MOVE "987654321123456789" TO EXT-18. SQ2284.2 +070600 MOVE 120 TO SQ-FS4-RECSIZE. SQ2284.2 +070700 MOVE "WRITE A RECORD" TO FEATURE. SQ2284.2 +070800 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2284.2 +070900 SEQ-TEST-WR-02. SQ2284.2 +071000 WRITE SQ-FS4R2-F-G-138. SQ2284.2 +071100 SEQ-INIT-03. SQ2284.2 +071200 MOVE 0 TO REC-CT. SQ2284.2 +071300 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +071400 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +071500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +071600 MOVE "CLOSE FILE" TO FEATURE. SQ2284.2 +071700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2284.2 +071800 SEQ-TEST-CL-03. SQ2284.2 +071900 CLOSE SQ-FS4. SQ2284.2 +072000 SEQ-INIT-04. SQ2284.2 +072100 MOVE 0 TO REC-CT. SQ2284.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +072500 MOVE ZERO TO XRECORD-NUMBER (1). SQ2284.2 +072600 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ2284.2 +072700 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2284.2 +072800 SEQ-TEST-OP-04. SQ2284.2 +072900 OPEN I-O SQ-FS4. SQ2284.2 +073000 SEQ-INIT-05. SQ2284.2 +073100 MOVE 0 TO REC-CT. SQ2284.2 +073200 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +073300 ADD 1 TO XRECORD-NUMBER (1). SQ2284.2 +073400 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +073500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +073600 MOVE ZERO TO SQ-FS4-RECSIZE. SQ2284.2 +073700 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ2284.2 +073800 MOVE "READ FIRST RECORD" TO FEATURE. SQ2284.2 +073900 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2284.2 +074000 SEQ-TEST-RD-05. SQ2284.2 +074100 READ SQ-FS4. SQ2284.2 +074200 SEQ-INIT-06. SQ2284.2 +074300 MOVE 0 TO REC-CT. SQ2284.2 +074400 MOVE SPACE TO DECL-EXEC-SW. SQ2284.2 +074500 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +074600 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +074700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2284.2 +074800 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ2284.2 +074900 MOVE 130 TO SQ-FS4-RECSIZE. SQ2284.2 +075000 MOVE "REWRITE DIFFERENT SIZE REC" TO FEATURE. SQ2284.2 +075100 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ2284.2 +075200 SEQ-TEST-RW-06. SQ2284.2 +075300 REWRITE SQ-FS4R1-F-G-120. SQ2284.2 +075400 MOVE 0 TO REC-CT. SQ2284.2 +075500* SQ2284.2 +075600* CHECK I-O STATUS RETURNED FROM REWRITE SQ2284.2 +075700* SQ2284.2 +075800 ADD 1 TO REC-CT. SQ2284.2 +075900 SEQ-TEST-06-01-END. SQ2284.2 +076000* SQ2284.2 +076100* CHECK EXECUTION OF I-O DECLARATIVE SQ2284.2 +076200* SQ2284.2 +076300 ADD 1 TO REC-CT. SQ2284.2 +076400 IF DELETE-SW NOT = SPACE SQ2284.2 +076500 GO TO SEQ-DELETE-06-02. SQ2284.2 +076600 GO TO SEQ-TEST-RW-06-02. SQ2284.2 +076700 SEQ-DELETE-06-02. SQ2284.2 +076800 PERFORM DE-LETE. SQ2284.2 +076900 GO TO SEQ-TEST-06-02-END. SQ2284.2 +077000 SEQ-TEST-RW-06-02. SQ2284.2 +077100 IF DECL-EXEC-I-O = "EXECUTED" SQ2284.2 +077200 PERFORM PASS SQ2284.2 +077300 ELSE SQ2284.2 +077400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2284.2 +077500 MOVE "EXECUTED" TO CORRECT-A SQ2284.2 +077600 MOVE "DECLARATIVE NOT EXECUTED ON REWRITE" SQ2284.2 +077700 TO RE-MARK SQ2284.2 +077800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2284.2 +077900 PERFORM FAIL. SQ2284.2 +078000 SEQ-TEST-06-02-END. SQ2284.2 +078100 CCVS-EXIT SECTION. SQ2284.2 +078200 CCVS-999999. SQ2284.2 +078300 GO TO CLOSE-FILES. SQ2284.2 +*END-OF,SQ228A +*HEADER,COBOL,SQ229A +000100 IDENTIFICATION DIVISION. SQ2294.2 +000200 PROGRAM-ID. SQ2294.2 +000300 SQ229A. SQ2294.2 +000400**************************************************************** SQ2294.2 +000500* * SQ2294.2 +000600* VALIDATION FOR:- * SQ2294.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +000800* USING CCVS85 VERSION 3.0. * SQ2294.2 +000900* * SQ2294.2 +001000* CREATION DATE / VALIDATION DATE * SQ2294.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2294.2 +001200* * SQ2294.2 +001300**************************************************************** SQ2294.2 +001400* * SQ2294.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2294.2 +001600* * SQ2294.2 +001700* X-01 SEQUENTIAL TAPE * SQ2294.2 +001800* X-55 SYSTEM PRINTER * SQ2294.2 +001900* X-82 SOURCE-COMPUTER * SQ2294.2 +002000* X-83 OBJECT-COMPUTER * SQ2294.2 +002100* X-84 LABEL RECORDS OPTION. * SQ2294.2 +002200* * SQ2294.2 +002300**************************************************************** SQ2294.2 +002400* * SQ2294.2 +002500* THIS PROGRM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ2294.2 +002600* A FILE OPEN IN THE EXTEND MODE. THE TEST FOR CORRECT * SQ2294.2 +002700* I-O STATUS CODE 47 IS IN THE DECLARATIVES. AN ABNORMAL * SQ2294.2 +002800* TERMINATION IS POSSIBLE AFTER THE TEST OF THE I-O STATUS * SQ2294.2 +002900* CODE IS ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE* SQ2294.2 +003000* MAIN LINE CODE. * SQ2294.2 +003100* * SQ2294.2 +003200**************************************************************** SQ2294.2 +003300* SQ2294.2 +003400 ENVIRONMENT DIVISION. SQ2294.2 +003500 CONFIGURATION SECTION. SQ2294.2 +003600 SOURCE-COMPUTER. SQ2294.2 +003700 XXXXX082. SQ2294.2 +003800 OBJECT-COMPUTER. SQ2294.2 +003900 XXXXX083. SQ2294.2 +004000* SQ2294.2 +004100 INPUT-OUTPUT SECTION. SQ2294.2 +004200 FILE-CONTROL. SQ2294.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2294.2 +004400 XXXXX055. SQ2294.2 +004500* SQ2294.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ2294.2 +004700 XXXXX001 SQ2294.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ2294.2 +004900* SQ2294.2 +005000* SQ2294.2 +005100 DATA DIVISION. SQ2294.2 +005200 FILE SECTION. SQ2294.2 +005300 FD PRINT-FILE SQ2294.2 +005400C LABEL RECORDS SQ2294.2 +005500C XXXXX084 SQ2294.2 +005600C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2294.2 +005700 . SQ2294.2 +005800 01 PRINT-REC PICTURE X(120). SQ2294.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ2294.2 +006000* SQ2294.2 +006100 FD SQ-FS1 SQ2294.2 +006200C LABEL RECORD IS STANDARD SQ2294.2 +006300 . SQ2294.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2294.2 +006500* SQ2294.2 +006600 WORKING-STORAGE SECTION. SQ2294.2 +006700* SQ2294.2 +006800*************************************************************** SQ2294.2 +006900* * SQ2294.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2294.2 +007100* * SQ2294.2 +007200*************************************************************** SQ2294.2 +007300* SQ2294.2 +007400 01 SQ-FS1-STATUS. SQ2294.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ2294.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ2294.2 +007700* SQ2294.2 +007800*************************************************************** SQ2294.2 +007900* * SQ2294.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2294.2 +008100* * SQ2294.2 +008200*************************************************************** SQ2294.2 +008300* SQ2294.2 +008400 01 REC-SKEL-SUB PIC 99. SQ2294.2 +008500* SQ2294.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ2294.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ2294.2 +008800 05 FILLER PICTURE X(48) VALUE SQ2294.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2294.2 +009000 05 FILLER PICTURE X(46) VALUE SQ2294.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2294.2 +009200 05 FILLER PICTURE X(26) VALUE SQ2294.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ2294.2 +009400 05 FILLER PICTURE X(37) VALUE SQ2294.2 +009500 ",RECKEY= ". SQ2294.2 +009600 05 FILLER PICTURE X(38) VALUE SQ2294.2 +009700 ",ALTKEY1= ". SQ2294.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2294.2 +009900 ",ALTKEY2= ". SQ2294.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2294.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2294.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ2294.2 +010300 07 FILLER PIC X(5). SQ2294.2 +010400 07 XFILE-NAME PIC X(6). SQ2294.2 +010500 07 FILLER PIC X(8). SQ2294.2 +010600 07 XRECORD-NAME PIC X(6). SQ2294.2 +010700 07 FILLER PIC X(1). SQ2294.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ2294.2 +010900 07 FILLER PIC X(7). SQ2294.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ2294.2 +011100 07 FILLER PIC X(6). SQ2294.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ2294.2 +011300 07 FILLER PIC X(5). SQ2294.2 +011400 07 ODO-NUMBER PIC 9(4). SQ2294.2 +011500 07 FILLER PIC X(5). SQ2294.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ2294.2 +011700 07 FILLER PIC X(7). SQ2294.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ2294.2 +011900 07 FILLER PIC X(7). SQ2294.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ2294.2 +012100 07 FILLER PIC X(1). SQ2294.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ2294.2 +012300 07 FILLER PIC X(6). SQ2294.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ2294.2 +012500 07 FILLER PIC X(5). SQ2294.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ2294.2 +012700 07 FILLER PIC X(6). SQ2294.2 +012800 07 XLABEL-TYPE PIC X(1). SQ2294.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ2294.2 +013000 07 FILLER PIC X(8). SQ2294.2 +013100 07 XRECORD-KEY PIC X(29). SQ2294.2 +013200 07 FILLER PIC X(9). SQ2294.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ2294.2 +013400 07 FILLER PIC X(9). SQ2294.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ2294.2 +013600 07 FILLER PIC X(7). SQ2294.2 +013700* SQ2294.2 +013800 01 TEST-RESULTS. SQ2294.2 +013900 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ2294.2 +014100 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2294.2 +014300 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014400 02 PAR-NAME. SQ2294.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ2294.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ2294.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ2294.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ2294.2 +014900 02 RE-MARK PIC X(61). SQ2294.2 +015000 01 TEST-COMPUTED. SQ2294.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ2294.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2294.2 +015300 02 COMPUTED-X. SQ2294.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2294.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2294.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2294.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2294.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2294.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2294.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ2294.2 +016100 04 FILLER PIC X. SQ2294.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ2294.2 +016300 01 TEST-CORRECT. SQ2294.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ2294.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2294.2 +016600 02 CORRECT-X. SQ2294.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2294.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2294.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2294.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2294.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2294.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ2294.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ2294.2 +017400 04 FILLER PIC X. SQ2294.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ2294.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2294.2 +017700 01 CCVS-C-1. SQ2294.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ2294.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2294.2 +018000- "SS PARAGRAPH-NAME SQ2294.2 +018100- " REMARKS". SQ2294.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ2294.2 +018300 01 CCVS-C-2. SQ2294.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ2294.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ2294.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ2294.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ2294.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ2294.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2294.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ2294.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2294.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2294.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2294.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2294.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2294.2 +020000 01 CCVS-H-1. SQ2294.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ2294.2 +020200 02 FILLER PIC X(42) VALUE SQ2294.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2294.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ2294.2 +020500 01 CCVS-H-2A. SQ2294.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ2294.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2294.2 +020800 02 FILLER PIC XXXX VALUE SQ2294.2 +020900 "4.2 ". SQ2294.2 +021000 02 FILLER PIC X(28) VALUE SQ2294.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ2294.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ2294.2 +021300* SQ2294.2 +021400 01 CCVS-H-2B. SQ2294.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2294.2 +021600 02 TEST-ID PIC X(9). SQ2294.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ2294.2 +021800 02 FILLER PIC X(12) VALUE SQ2294.2 +021900 " HIGH ". SQ2294.2 +022000 02 FILLER PIC X(22) VALUE SQ2294.2 +022100 " LEVEL VALIDATION FOR ". SQ2294.2 +022200 02 FILLER PIC X(58) VALUE SQ2294.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +022400 01 CCVS-H-3. SQ2294.2 +022500 02 FILLER PIC X(34) VALUE SQ2294.2 +022600 " FOR OFFICIAL USE ONLY ". SQ2294.2 +022700 02 FILLER PIC X(58) VALUE SQ2294.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2294.2 +022900 02 FILLER PIC X(28) VALUE SQ2294.2 +023000 " COPYRIGHT 1985,1986 ". SQ2294.2 +023100 01 CCVS-E-1. SQ2294.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ2294.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2294.2 +023400 02 ID-AGAIN PIC X(9). SQ2294.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ2294.2 +023600 01 CCVS-E-2. SQ2294.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ2294.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ2294.2 +023900 02 CCVS-E-2-2. SQ2294.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2294.2 +024100 03 FILLER PIC X VALUE SPACE. SQ2294.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ2294.2 +024300 "ERRORS ENCOUNTERED". SQ2294.2 +024400 01 CCVS-E-3. SQ2294.2 +024500 02 FILLER PIC X(22) VALUE SQ2294.2 +024600 " FOR OFFICIAL USE ONLY". SQ2294.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ2294.2 +024800 02 FILLER PIC X(58) VALUE SQ2294.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ2294.2 +025100 02 FILLER PIC X(20) VALUE SQ2294.2 +025200 " COPYRIGHT 1985,1986". SQ2294.2 +025300 01 CCVS-E-4. SQ2294.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2294.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ2294.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2294.2 +025700 02 FILLER PIC X(40) VALUE SQ2294.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2294.2 +025900 01 XXINFO. SQ2294.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2294.2 +026100 02 INFO-TEXT. SQ2294.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ2294.2 +026300 04 XXCOMPUTED PIC X(20). SQ2294.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ2294.2 +026500 04 XXCORRECT PIC X(20). SQ2294.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ2294.2 +026700 01 HYPHEN-LINE. SQ2294.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ2294.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2294.2 +027000- "*****************************************". SQ2294.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2294.2 +027200- "******************************". SQ2294.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2294.2 +027400 "SQ229A". SQ2294.2 +027500* SQ2294.2 +027600 PROCEDURE DIVISION. SQ2294.2 +027700 DECLARATIVES. SQ2294.2 +027800 SQ-FS1-DECLARATIVE SECTION. SQ2294.2 +027900 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1. SQ2294.2 +028000 INPUT-ERROR-PROCESS. SQ2294.2 +028100 IF SQ-FS1-STATUS = "47" SQ2294.2 +028200 PERFORM DECL-PASS SQ2294.2 +028300 GO TO DECL-ABNORMAL-TERM SQ2294.2 +028400 ELSE SQ2294.2 +028500 MOVE "47" TO CORRECT-A SQ2294.2 +028600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2294.2 +028700 MOVE "STATUS FOR READ OF FILE OPEN EXTEND INCORRECT" SQ2294.2 +028800 TO RE-MARK SQ2294.2 +028900 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ2294.2 +029000 PERFORM DECL-FAIL SQ2294.2 +029100 GO TO DECL-ABNORMAL-TERM SQ2294.2 +029200 END-IF. SQ2294.2 +029300* SQ2294.2 +029400 DECL-PASS. SQ2294.2 +029500 MOVE "PASS " TO P-OR-F. SQ2294.2 +029600 ADD 1 TO PASS-COUNTER. SQ2294.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ2294.2 +029800* SQ2294.2 +029900 DECL-FAIL. SQ2294.2 +030000 MOVE "FAIL*" TO P-OR-F. SQ2294.2 +030100 ADD 1 TO ERROR-COUNTER. SQ2294.2 +030200 PERFORM DECL-PRINT-DETAIL. SQ2294.2 +030300* SQ2294.2 +030400 DECL-PRINT-DETAIL. SQ2294.2 +030500 IF REC-CT NOT EQUAL TO ZERO SQ2294.2 +030600 MOVE "." TO PARDOT-X SQ2294.2 +030700 MOVE REC-CT TO DOTVALUE. SQ2294.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. SQ2294.2 +030900 PERFORM DECL-WRITE-LINE. SQ2294.2 +031000 IF P-OR-F EQUAL TO "FAIL*" SQ2294.2 +031100 PERFORM DECL-WRITE-LINE SQ2294.2 +031200 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2294.2 +031300 ELSE SQ2294.2 +031400 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2294.2 +031500 MOVE SPACE TO P-OR-F. SQ2294.2 +031600 MOVE SPACE TO COMPUTED-X. SQ2294.2 +031700 MOVE SPACE TO CORRECT-X. SQ2294.2 +031800 IF REC-CT EQUAL TO ZERO SQ2294.2 +031900 MOVE SPACE TO PAR-NAME. SQ2294.2 +032000 MOVE SPACE TO RE-MARK. SQ2294.2 +032100* SQ2294.2 +032200 DECL-WRITE-LINE. SQ2294.2 +032300 ADD 1 TO RECORD-COUNT. SQ2294.2 +032400Y IF RECORD-COUNT GREATER 50 SQ2294.2 +032500Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2294.2 +032600Y MOVE SPACE TO DUMMY-RECORD SQ2294.2 +032700Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2294.2 +032800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2294.2 +032900Y MOVE CCVS-C-2 TO DUMMY-RECORD SQ2294.2 +033000Y PERFORM DECL-WRT-LN 2 TIMES SQ2294.2 +033100Y MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2294.2 +033200Y PERFORM DECL-WRT-LN SQ2294.2 +033300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2294.2 +033400Y MOVE ZERO TO RECORD-COUNT. SQ2294.2 +033500 PERFORM DECL-WRT-LN. SQ2294.2 +033600* SQ2294.2 +033700 DECL-WRT-LN. SQ2294.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2294.2 +033900 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +034000* SQ2294.2 +034100 DECL-FAIL-ROUTINE. SQ2294.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2294.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2294.2 +034400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +034500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2294.2 +034600 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +034700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +034800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +034900 GO TO DECL-FAIL-EX. SQ2294.2 +035000 DECL-FAIL-WRITE. SQ2294.2 +035100 MOVE TEST-COMPUTED TO PRINT-REC SQ2294.2 +035200 PERFORM DECL-WRITE-LINE SQ2294.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2294.2 +035400 MOVE TEST-CORRECT TO PRINT-REC SQ2294.2 +035500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +035600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2294.2 +035700 DECL-FAIL-EX. SQ2294.2 +035800 EXIT. SQ2294.2 +035900* SQ2294.2 +036000 DECL-BAIL. SQ2294.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2294.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2294.2 +036300 DECL-BAIL-WRITE. SQ2294.2 +036400 MOVE CORRECT-A TO XXCORRECT. SQ2294.2 +036500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2294.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE SQ2294.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +036900 MOVE SPACE TO INF-ANSI-REFERENCE. SQ2294.2 +037000 DECL-BAIL-EX. SQ2294.2 +037100 EXIT. SQ2294.2 +037200* SQ2294.2 +037300 DECL-ABNORMAL-TERM. SQ2294.2 +037400 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +037500 PERFORM DECL-WRITE-LINE. SQ2294.2 +037600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2294.2 +037700 TO DUMMY-RECORD. SQ2294.2 +037800 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2294.2 +037900* SQ2294.2 +038000 END-DECLS. SQ2294.2 +038100 EXIT. SQ2294.2 +038200 END DECLARATIVES. SQ2294.2 +038300* SQ2294.2 +038400* SQ2294.2 +038500 CCVS1 SECTION. SQ2294.2 +038600 OPEN-FILES. SQ2294.2 +038700 OPEN OUTPUT PRINT-FILE. SQ2294.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ2294.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2294.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ2294.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2294.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ2294.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2294.2 +039400 GO TO CCVS1-EXIT. SQ2294.2 +039500* SQ2294.2 +039600 CCVS-INIT-FILE. SQ2294.2 +039700 ADD 1 TO REC-SKL-SUB. SQ2294.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2294.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2294.2 +040000* SQ2294.2 +040100 CLOSE-FILES. SQ2294.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2294.2 +040300 CLOSE PRINT-FILE. SQ2294.2 +040400 TERMINATE-CCVS. SQ2294.2 +040500 STOP RUN. SQ2294.2 +040600* SQ2294.2 +040700 INSPT. SQ2294.2 +040800 MOVE "INSPT" TO P-OR-F. SQ2294.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ2294.2 +041000 PERFORM PRINT-DETAIL. SQ2294.2 +041100 SQ2294.2 +041200 PASS. SQ2294.2 +041300 MOVE "PASS " TO P-OR-F. SQ2294.2 +041400 ADD 1 TO PASS-COUNTER. SQ2294.2 +041500 PERFORM PRINT-DETAIL. SQ2294.2 +041600* SQ2294.2 +041700 FAIL. SQ2294.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ2294.2 +041900 ADD 1 TO ERROR-COUNTER. SQ2294.2 +042000 PERFORM PRINT-DETAIL. SQ2294.2 +042100* SQ2294.2 +042200 DE-LETE. SQ2294.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2294.2 +042400 MOVE "*****" TO P-OR-F. SQ2294.2 +042500 ADD 1 TO DELETE-COUNTER. SQ2294.2 +042600 PERFORM PRINT-DETAIL. SQ2294.2 +042700* SQ2294.2 +042800 PRINT-DETAIL. SQ2294.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ2294.2 +043000 MOVE "." TO PARDOT-X SQ2294.2 +043100 MOVE REC-CT TO DOTVALUE. SQ2294.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ2294.2 +043300 PERFORM WRITE-LINE. SQ2294.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ2294.2 +043500 PERFORM WRITE-LINE SQ2294.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2294.2 +043700 ELSE SQ2294.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2294.2 +043900 MOVE SPACE TO P-OR-F. SQ2294.2 +044000 MOVE SPACE TO COMPUTED-X. SQ2294.2 +044100 MOVE SPACE TO CORRECT-X. SQ2294.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2294.2 +044300 MOVE SPACE TO RE-MARK. SQ2294.2 +044400* SQ2294.2 +044500 HEAD-ROUTINE. SQ2294.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2294.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2294.2 +045000 COLUMN-NAMES-ROUTINE. SQ2294.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +045400 END-ROUTINE. SQ2294.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2294.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ2294.2 +045700 END-RTN-EXIT. SQ2294.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2294.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +046000* SQ2294.2 +046100 END-ROUTINE-1. SQ2294.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ2294.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2294.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2294.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2294.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2294.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2294.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2294.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2294.2 +047000 PERFORM WRITE-LINE. SQ2294.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2294.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2294.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +047400 ELSE SQ2294.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2294.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2294.2 +047700 PERFORM WRITE-LINE. SQ2294.2 +047800 END-ROUTINE-13. SQ2294.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2294.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +048100 ELSE SQ2294.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2294.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2294.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2294.2 +048500 PERFORM WRITE-LINE. SQ2294.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2294.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +048800 ELSE SQ2294.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2294.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2294.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +049300* SQ2294.2 +049400 WRITE-LINE. SQ2294.2 +049500 ADD 1 TO RECORD-COUNT. SQ2294.2 +049600Y IF RECORD-COUNT GREATER 50 SQ2294.2 +049700Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2294.2 +049800Y MOVE SPACE TO DUMMY-RECORD SQ2294.2 +049900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2294.2 +050000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2294.2 +050100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2294.2 +050200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2294.2 +050300Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2294.2 +050400Y MOVE ZERO TO RECORD-COUNT. SQ2294.2 +050500 PERFORM WRT-LN. SQ2294.2 +050600* SQ2294.2 +050700 WRT-LN. SQ2294.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2294.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +051000 BLANK-LINE-PRINT. SQ2294.2 +051100 PERFORM WRT-LN. SQ2294.2 +051200 FAIL-ROUTINE. SQ2294.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2294.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2294.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2294.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +052000 GO TO FAIL-ROUTINE-EX. SQ2294.2 +052100 FAIL-ROUTINE-WRITE. SQ2294.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ2294.2 +052300 PERFORM WRITE-LINE SQ2294.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2294.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ2294.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2294.2 +052800 FAIL-ROUTINE-EX. SQ2294.2 +052900 EXIT. SQ2294.2 +053000 BAIL-OUT. SQ2294.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2294.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2294.2 +053300 BAIL-OUT-WRITE. SQ2294.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ2294.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2294.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +054000 BAIL-OUT-EX. SQ2294.2 +054100 EXIT. SQ2294.2 +054200 CCVS1-EXIT. SQ2294.2 +054300 EXIT. SQ2294.2 +054400* SQ2294.2 +054500**************************************************************** SQ2294.2 +054600* * SQ2294.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2294.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2294.2 +054900* * SQ2294.2 +055000**************************************************************** SQ2294.2 +055100* SQ2294.2 +055200 SECT-SQ229A-0001 SECTION. SQ2294.2 +055300 WRITE-INIT-GF-01. SQ2294.2 +055400* SQ2294.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ2294.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2294.2 +055700* SQ2294.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2294.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2294.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2294.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ2294.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2294.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ2294.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2294.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2294.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ2294.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ2294.2 +056800* SQ2294.2 +056900 WRITE-OPEN-01. SQ2294.2 +057000 OPEN OUTPUT SQ-FS1. SQ2294.2 +057100* SQ2294.2 +057200* WRITE A SINGLE RECORD TO THE FILE SQ2294.2 +057300* SQ2294.2 +057400 WRITE-INIT-01. SQ2294.2 +057500 WRITE-TEST-01-01. SQ2294.2 +057600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2294.2 +057700 WRITE SQ-FS1R1-F-G-120. SQ2294.2 +057800* SQ2294.2 +057900 CLOSE-INIT-01. SQ2294.2 +058000 CLOSE-TEST-01. SQ2294.2 +058100 CLOSE SQ-FS1. SQ2294.2 +058200* SQ2294.2 +058300* THIS TEST OPENS THE FILE JUST CREATED IN THE EXTEND SQ2294.2 +058400* MODE. WE ATTEMPT TO READ A RECORD FROM THE FILE AND SQ2294.2 +058500* EXAMINE IN A DECLARATIVE THE I-O STATUS RETURNED. IT IS SQ2294.2 +058600* POSSIBLE THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ2294.2 +058700* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. SQ2294.2 +058800* SQ2294.2 +058900 OPEN-INIT-01. SQ2294.2 +059000* SQ2294.2 +059100 OPEN-TEST-01. SQ2294.2 +059200 OPEN EXTEND SQ-FS1. SQ2294.2 +059300* SQ2294.2 +059400 READ-INIT-01. SQ2294.2 +059500 MOVE 1 TO REC-CT. SQ2294.2 +059600 MOVE "**" TO SQ-FS1-STATUS. SQ2294.2 +059700 MOVE "READ-TEST-01" TO PAR-NAME. SQ2294.2 +059800 MOVE "READ OF EXTEND FILE" TO FEATURE. SQ2294.2 +059900* SQ2294.2 +060000 READ-TEST-01. SQ2294.2 +060100 READ SQ-FS1. SQ2294.2 +060200* SQ2294.2 +060300 CLOSE-INIT-02. SQ2294.2 +060400 CLOSE-TEST-02. SQ2294.2 +060500 CLOSE SQ-FS1. SQ2294.2 +060600* SQ2294.2 +060700 CCVS-EXIT SECTION. SQ2294.2 +060800 CCVS-999999. SQ2294.2 +060900 GO TO CLOSE-FILES. SQ2294.2 +*END-OF,SQ229A +*HEADER,COBOL,SQ230A +000100 IDENTIFICATION DIVISION. SQ2304.2 +000200 PROGRAM-ID. SQ2304.2 +000300 SQ230A. SQ2304.2 +000400**************************************************************** SQ2304.2 +000500* * SQ2304.2 +000600* VALIDATION FOR:- * SQ2304.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +000800* USING CCVS85 VERSION 3.0. * SQ2304.2 +000900* * SQ2304.2 +001000* CREATION DATE / VALIDATION DATE * SQ2304.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2304.2 +001200* * SQ2304.2 +001300**************************************************************** SQ2304.2 +001400* * SQ2304.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2304.2 +001600* * SQ2304.2 +001700* X-01 SEQUENTIAL TAPE * SQ2304.2 +001800* X-55 SYSTEM PRINTER * SQ2304.2 +001900* X-82 SOURCE-COMPUTER * SQ2304.2 +002000* X-83 OBJECT-COMPUTER. * SQ2304.2 +002100* X-84 LABEL RECORDS OPTION * SQ2304.2 +002200* * SQ2304.2 +002300**************************************************************** SQ2304.2 +002400* * SQ2304.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ2304.2 +002600* A FILE OPEN IN THE EXTEND MODE. THE TEST FOR CORRECT I-O * SQ2304.2 +002700* STATUS CODE 47 IS IN THE MAIN LINE CODE, THEREFORE AN * SQ2304.2 +002800* ABNORMAL TERMINATION IS POSSIBLE BEFORE THE TEST OF THE * SQ2304.2 +002900* I-O STATUS CODE IS ACCOMPLISHED. * SQ2304.2 +003000* * SQ2304.2 +003100**************************************************************** SQ2304.2 +003200* SQ2304.2 +003300 ENVIRONMENT DIVISION. SQ2304.2 +003400 CONFIGURATION SECTION. SQ2304.2 +003500 SOURCE-COMPUTER. SQ2304.2 +003600 XXXXX082. SQ2304.2 +003700 OBJECT-COMPUTER. SQ2304.2 +003800 XXXXX083. SQ2304.2 +003900* SQ2304.2 +004000 INPUT-OUTPUT SECTION. SQ2304.2 +004100 FILE-CONTROL. SQ2304.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2304.2 +004300 XXXXX055. SQ2304.2 +004400* SQ2304.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ2304.2 +004600 XXXXX001 SQ2304.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ2304.2 +004800* SQ2304.2 +004900* SQ2304.2 +005000 DATA DIVISION. SQ2304.2 +005100 FILE SECTION. SQ2304.2 +005200 FD PRINT-FILE SQ2304.2 +005300C LABEL RECORDS SQ2304.2 +005400C XXXXX084 SQ2304.2 +005500C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2304.2 +005600 . SQ2304.2 +005700 01 PRINT-REC PICTURE X(120). SQ2304.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ2304.2 +005900* SQ2304.2 +006000 FD SQ-FS1 SQ2304.2 +006100C LABEL RECORD IS STANDARD SQ2304.2 +006200 . SQ2304.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2304.2 +006400* SQ2304.2 +006500 WORKING-STORAGE SECTION. SQ2304.2 +006600* SQ2304.2 +006700*************************************************************** SQ2304.2 +006800* * SQ2304.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2304.2 +007000* * SQ2304.2 +007100*************************************************************** SQ2304.2 +007200* SQ2304.2 +007300 01 SQ-FS1-STATUS. SQ2304.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ2304.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ2304.2 +007600* SQ2304.2 +007700*************************************************************** SQ2304.2 +007800* * SQ2304.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2304.2 +008000* * SQ2304.2 +008100*************************************************************** SQ2304.2 +008200* SQ2304.2 +008300 01 REC-SKEL-SUB PIC 99. SQ2304.2 +008400* SQ2304.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ2304.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ2304.2 +008700 05 FILLER PICTURE X(48) VALUE SQ2304.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2304.2 +008900 05 FILLER PICTURE X(46) VALUE SQ2304.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2304.2 +009100 05 FILLER PICTURE X(26) VALUE SQ2304.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ2304.2 +009300 05 FILLER PICTURE X(37) VALUE SQ2304.2 +009400 ",RECKEY= ". SQ2304.2 +009500 05 FILLER PICTURE X(38) VALUE SQ2304.2 +009600 ",ALTKEY1= ". SQ2304.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2304.2 +009800 ",ALTKEY2= ". SQ2304.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2304.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2304.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ2304.2 +010200 07 FILLER PIC X(5). SQ2304.2 +010300 07 XFILE-NAME PIC X(6). SQ2304.2 +010400 07 FILLER PIC X(8). SQ2304.2 +010500 07 XRECORD-NAME PIC X(6). SQ2304.2 +010600 07 FILLER PIC X(1). SQ2304.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ2304.2 +010800 07 FILLER PIC X(7). SQ2304.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ2304.2 +011000 07 FILLER PIC X(6). SQ2304.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ2304.2 +011200 07 FILLER PIC X(5). SQ2304.2 +011300 07 ODO-NUMBER PIC 9(4). SQ2304.2 +011400 07 FILLER PIC X(5). SQ2304.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ2304.2 +011600 07 FILLER PIC X(7). SQ2304.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ2304.2 +011800 07 FILLER PIC X(7). SQ2304.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ2304.2 +012000 07 FILLER PIC X(1). SQ2304.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ2304.2 +012200 07 FILLER PIC X(6). SQ2304.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ2304.2 +012400 07 FILLER PIC X(5). SQ2304.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ2304.2 +012600 07 FILLER PIC X(6). SQ2304.2 +012700 07 XLABEL-TYPE PIC X(1). SQ2304.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ2304.2 +012900 07 FILLER PIC X(8). SQ2304.2 +013000 07 XRECORD-KEY PIC X(29). SQ2304.2 +013100 07 FILLER PIC X(9). SQ2304.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ2304.2 +013300 07 FILLER PIC X(9). SQ2304.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ2304.2 +013500 07 FILLER PIC X(7). SQ2304.2 +013600* SQ2304.2 +013700 01 TEST-RESULTS. SQ2304.2 +013800 02 FILLER PIC X VALUE SPACE. SQ2304.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ2304.2 +014000 02 FILLER PIC X VALUE SPACE. SQ2304.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ2304.2 +014200 02 FILLER PIC X VALUE SPACE. SQ2304.2 +014300 02 PAR-NAME. SQ2304.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ2304.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ2304.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ2304.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ2304.2 +014800 02 RE-MARK PIC X(61). SQ2304.2 +014900 01 TEST-COMPUTED. SQ2304.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ2304.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2304.2 +015200 02 COMPUTED-X. SQ2304.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2304.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2304.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2304.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2304.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2304.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2304.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ2304.2 +016000 04 FILLER PIC X. SQ2304.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ2304.2 +016200 01 TEST-CORRECT. SQ2304.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2304.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2304.2 +016500 02 CORRECT-X. SQ2304.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2304.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2304.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2304.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2304.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2304.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ2304.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ2304.2 +017300 04 FILLER PIC X. SQ2304.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ2304.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2304.2 +017600 01 CCVS-C-1. SQ2304.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ2304.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2304.2 +017900- "SS PARAGRAPH-NAME SQ2304.2 +018000- " REMARKS". SQ2304.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ2304.2 +018200 01 CCVS-C-2. SQ2304.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ2304.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ2304.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ2304.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ2304.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ2304.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2304.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ2304.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2304.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2304.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2304.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2304.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2304.2 +019900 01 CCVS-H-1. SQ2304.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ2304.2 +020100 02 FILLER PIC X(42) VALUE SQ2304.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2304.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ2304.2 +020400 01 CCVS-H-2A. SQ2304.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ2304.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2304.2 +020700 02 FILLER PIC XXXX VALUE SQ2304.2 +020800 "4.2 ". SQ2304.2 +020900 02 FILLER PIC X(28) VALUE SQ2304.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ2304.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ2304.2 +021200* SQ2304.2 +021300 01 CCVS-H-2B. SQ2304.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2304.2 +021500 02 TEST-ID PIC X(9). SQ2304.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ2304.2 +021700 02 FILLER PIC X(12) VALUE SQ2304.2 +021800 " HIGH ". SQ2304.2 +021900 02 FILLER PIC X(22) VALUE SQ2304.2 +022000 " LEVEL VALIDATION FOR ". SQ2304.2 +022100 02 FILLER PIC X(58) VALUE SQ2304.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +022300 01 CCVS-H-3. SQ2304.2 +022400 02 FILLER PIC X(34) VALUE SQ2304.2 +022500 " FOR OFFICIAL USE ONLY ". SQ2304.2 +022600 02 FILLER PIC X(58) VALUE SQ2304.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2304.2 +022800 02 FILLER PIC X(28) VALUE SQ2304.2 +022900 " COPYRIGHT 1985,1986 ". SQ2304.2 +023000 01 CCVS-E-1. SQ2304.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ2304.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2304.2 +023300 02 ID-AGAIN PIC X(9). SQ2304.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ2304.2 +023500 01 CCVS-E-2. SQ2304.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ2304.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ2304.2 +023800 02 CCVS-E-2-2. SQ2304.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2304.2 +024000 03 FILLER PIC X VALUE SPACE. SQ2304.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ2304.2 +024200 "ERRORS ENCOUNTERED". SQ2304.2 +024300 01 CCVS-E-3. SQ2304.2 +024400 02 FILLER PIC X(22) VALUE SQ2304.2 +024500 " FOR OFFICIAL USE ONLY". SQ2304.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ2304.2 +024700 02 FILLER PIC X(58) VALUE SQ2304.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ2304.2 +025000 02 FILLER PIC X(20) VALUE SQ2304.2 +025100 " COPYRIGHT 1985,1986". SQ2304.2 +025200 01 CCVS-E-4. SQ2304.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2304.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ2304.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2304.2 +025600 02 FILLER PIC X(40) VALUE SQ2304.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2304.2 +025800 01 XXINFO. SQ2304.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2304.2 +026000 02 INFO-TEXT. SQ2304.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ2304.2 +026200 04 XXCOMPUTED PIC X(20). SQ2304.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ2304.2 +026400 04 XXCORRECT PIC X(20). SQ2304.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ2304.2 +026600 01 HYPHEN-LINE. SQ2304.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ2304.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ2304.2 +026900- "*****************************************". SQ2304.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ2304.2 +027100- "******************************". SQ2304.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ2304.2 +027300 "SQ230A". SQ2304.2 +027400* SQ2304.2 +027500 PROCEDURE DIVISION. SQ2304.2 +027600 CCVS1 SECTION. SQ2304.2 +027700 OPEN-FILES. SQ2304.2 +027800 OPEN OUTPUT PRINT-FILE. SQ2304.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ2304.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2304.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2304.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2304.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ2304.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2304.2 +028500 GO TO CCVS1-EXIT. SQ2304.2 +028600* SQ2304.2 +028700 CCVS-INIT-FILE. SQ2304.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2304.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2304.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2304.2 +029100* SQ2304.2 +029200 CLOSE-FILES. SQ2304.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2304.2 +029400 CLOSE PRINT-FILE. SQ2304.2 +029500 TERMINATE-CCVS. SQ2304.2 +029600 STOP RUN. SQ2304.2 +029700* SQ2304.2 +029800 INSPT. SQ2304.2 +029900 MOVE "INSPT" TO P-OR-F. SQ2304.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ2304.2 +030100 PERFORM PRINT-DETAIL. SQ2304.2 +030200 SQ2304.2 +030300 PASS. SQ2304.2 +030400 MOVE "PASS " TO P-OR-F. SQ2304.2 +030500 ADD 1 TO PASS-COUNTER. SQ2304.2 +030600 PERFORM PRINT-DETAIL. SQ2304.2 +030700* SQ2304.2 +030800 FAIL. SQ2304.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ2304.2 +031000 ADD 1 TO ERROR-COUNTER. SQ2304.2 +031100 PERFORM PRINT-DETAIL. SQ2304.2 +031200* SQ2304.2 +031300 DE-LETE. SQ2304.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2304.2 +031500 MOVE "*****" TO P-OR-F. SQ2304.2 +031600 ADD 1 TO DELETE-COUNTER. SQ2304.2 +031700 PERFORM PRINT-DETAIL. SQ2304.2 +031800* SQ2304.2 +031900 PRINT-DETAIL. SQ2304.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ2304.2 +032100 MOVE "." TO PARDOT-X SQ2304.2 +032200 MOVE REC-CT TO DOTVALUE. SQ2304.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ2304.2 +032400 PERFORM WRITE-LINE. SQ2304.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ2304.2 +032600 PERFORM WRITE-LINE SQ2304.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2304.2 +032800 ELSE SQ2304.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2304.2 +033000 MOVE SPACE TO P-OR-F. SQ2304.2 +033100 MOVE SPACE TO COMPUTED-X. SQ2304.2 +033200 MOVE SPACE TO CORRECT-X. SQ2304.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2304.2 +033400 MOVE SPACE TO RE-MARK. SQ2304.2 +033500* SQ2304.2 +033600 HEAD-ROUTINE. SQ2304.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +034100 COLUMN-NAMES-ROUTINE. SQ2304.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +034500 END-ROUTINE. SQ2304.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2304.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ2304.2 +034800 END-RTN-EXIT. SQ2304.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2304.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +035100* SQ2304.2 +035200 END-ROUTINE-1. SQ2304.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ2304.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2304.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2304.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ2304.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2304.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2304.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2304.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2304.2 +036100 PERFORM WRITE-LINE. SQ2304.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2304.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2304.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +036500 ELSE SQ2304.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2304.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2304.2 +036800 PERFORM WRITE-LINE. SQ2304.2 +036900 END-ROUTINE-13. SQ2304.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2304.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +037200 ELSE SQ2304.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2304.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2304.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2304.2 +037600 PERFORM WRITE-LINE. SQ2304.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2304.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +037900 ELSE SQ2304.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2304.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2304.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +038400* SQ2304.2 +038500 WRITE-LINE. SQ2304.2 +038600 ADD 1 TO RECORD-COUNT. SQ2304.2 +038700Y IF RECORD-COUNT GREATER 50 SQ2304.2 +038800Y MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2304.2 +038900Y MOVE SPACE TO DUMMY-RECORD SQ2304.2 +039000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2304.2 +039100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2304.2 +039200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2304.2 +039300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2304.2 +039400Y MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2304.2 +039500Y MOVE ZERO TO RECORD-COUNT. SQ2304.2 +039600 PERFORM WRT-LN. SQ2304.2 +039700* SQ2304.2 +039800 WRT-LN. SQ2304.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2304.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ2304.2 +040100 BLANK-LINE-PRINT. SQ2304.2 +040200 PERFORM WRT-LN. SQ2304.2 +040300 FAIL-ROUTINE. SQ2304.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2304.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2304.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2304.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2304.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ2304.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2304.2 +041100 GO TO FAIL-ROUTINE-EX. SQ2304.2 +041200 FAIL-ROUTINE-WRITE. SQ2304.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ2304.2 +041400 PERFORM WRITE-LINE SQ2304.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2304.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ2304.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2304.2 +041900 FAIL-ROUTINE-EX. SQ2304.2 +042000 EXIT. SQ2304.2 +042100 BAIL-OUT. SQ2304.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2304.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2304.2 +042400 BAIL-OUT-WRITE. SQ2304.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ2304.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2304.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2304.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ2304.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2304.2 +043100 BAIL-OUT-EX. SQ2304.2 +043200 EXIT. SQ2304.2 +043300 CCVS1-EXIT. SQ2304.2 +043400 EXIT. SQ2304.2 +043500* SQ2304.2 +043600**************************************************************** SQ2304.2 +043700* * SQ2304.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2304.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2304.2 +044000* * SQ2304.2 +044100**************************************************************** SQ2304.2 +044200* SQ2304.2 +044300 SECT-SQ230A-0001 SECTION. SQ2304.2 +044400 WRITE-INIT-GF-01. SQ2304.2 +044500* SQ2304.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ2304.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2304.2 +044800* SQ2304.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2304.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2304.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2304.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ2304.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2304.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ2304.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ2304.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2304.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ2304.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ2304.2 +045900* SQ2304.2 +046000 WRITE-OPEN-01. SQ2304.2 +046100 OPEN OUTPUT SQ-FS1. SQ2304.2 +046200* SQ2304.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ2304.2 +046400* SQ2304.2 +046500 WRITE-INIT-01. SQ2304.2 +046600 WRITE-TEST-01-01. SQ2304.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2304.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ2304.2 +046900* SQ2304.2 +047000* CLOSE THE FILE. SQ2304.2 +047100* SQ2304.2 +047200 CLOSE-INIT-01. SQ2304.2 +047300 CLOSE-TEST-01. SQ2304.2 +047400 CLOSE SQ-FS1. SQ2304.2 +047500* SQ2304.2 +047600* HAVING CLOSED THE FILE, WE NOW REOPEN IT IN THE SQ2304.2 +047700* EXTEND MODE. SQ2304.2 +047800* SQ2304.2 +047900 OPEN-INIT-01. SQ2304.2 +048000* SQ2304.2 +048100 OPEN-TEST-01. SQ2304.2 +048200 OPEN EXTEND SQ-FS1. SQ2304.2 +048300* SQ2304.2 +048400 READ-INIT-01. SQ2304.2 +048500* SQ2304.2 +048600* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE FILE. SQ2304.2 +048700* I-O STATUS CODE 47 SHOULD BE GENERATED. SQ2304.2 +048800* SQ2304.2 +048900 MOVE "READ FILE OPENED EXTEND" TO FEATURE. SQ2304.2 +049000 MOVE "**" TO SQ-FS1-STATUS. SQ2304.2 +049100 MOVE "READ-TEST-01" TO PAR-NAME. SQ2304.2 +049200 MOVE 1 TO REC-CT. SQ2304.2 +049300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2304.2 +049400 TO DUMMY-RECORD. SQ2304.2 +049500 PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +049600* SQ2304.2 +049700 READ-TEST-01. SQ2304.2 +049800 READ SQ-FS1 AT END CONTINUE. SQ2304.2 +049900 IF SQ-FS1-STATUS = "47" SQ2304.2 +050000 PERFORM PASS SQ2304.2 +050100 ELSE SQ2304.2 +050200 MOVE "47" TO CORRECT-A SQ2304.2 +050300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2304.2 +050400 MOVE "STATUS FOR READ OF FILE OPEN EXTEND INCORRECT" SQ2304.2 +050500 TO RE-MARK SQ2304.2 +050600 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ2304.2 +050700 PERFORM FAIL SQ2304.2 +050800 END-IF. SQ2304.2 +050900* SQ2304.2 +051000 CCVS-EXIT SECTION. SQ2304.2 +051100 CCVS-999999. SQ2304.2 +051200 GO TO CLOSE-FILES. SQ2304.2 +*END-OF,SQ230A +*HEADER,COBOL,SQ302M +000100 IDENTIFICATION DIVISION. SQ3024.2 +000200 PROGRAM-ID. SQ3024.2 +000300 SQ302M. SQ3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SQ3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN MINIMUM SUBSET SQ3024.2 +000600*SEQUENTIAL INPUT-OUTPUT. SQ3024.2 +000700 ENVIRONMENT DIVISION. SQ3024.2 +000800 CONFIGURATION SECTION. SQ3024.2 +000900 SOURCE-COMPUTER. SQ3024.2 +001000 XXXXX082. SQ3024.2 +001100 OBJECT-COMPUTER. SQ3024.2 +001200 XXXXX083. SQ3024.2 +001300 INPUT-OUTPUT SECTION. SQ3024.2 +001400 FILE-CONTROL. SQ3024.2 +001500 SELECT TFIL ASSIGN SQ3024.2 +001600 XXXXX014 SQ3024.2 +001700 ORGANIZATION IS SEQUENTIAL SQ3024.2 +001800 ACCESS MODE IS SEQUENTIAL. SQ3024.2 +001900 SQ3024.2 +002000 SELECT SQ-FRR ASSIGN SQ3024.2 +002100 XXXXX013 SQ3024.2 +002200 ORGANIZATION IS SEQUENTIAL. SQ3024.2 +002300 SQ3024.2 +002400 SELECT RR-FS1 ASSIGN SQ3024.2 +002500 XXXXX014 SQ3024.2 +002600 ORGANIZATION IS SEQUENTIAL. SQ3024.2 +002700 SQ3024.2 +002800 I-O-CONTROL. SQ3024.2 +002900 XXXXX053. SQ3024.2 +003000*Message expected for above statement: OBSOLETE SQ3024.2 +003100 SQ3024.2 +003200 DATA DIVISION. SQ3024.2 +003300 FILE SECTION. SQ3024.2 +003400 FD TFIL SQ3024.2 +003500 LABEL RECORDS STANDARD SQ3024.2 +003600*Message expected for above statement: OBSOLETE SQ3024.2 +003700 VALUE OF SQ3024.2 +003800 XXXXX074 SQ3024.2 +003900 IS SQ3024.2 +004000 XXXXX075 SQ3024.2 +004100*Message expected for above statement: OBSOLETE SQ3024.2 +004200 DATA RECORDS ARE FREC. SQ3024.2 +004300*Message expected for above statement: OBSOLETE SQ3024.2 +004400 SQ3024.2 +004500 01 FREC. SQ3024.2 +004600 03 RKEY PIC 9(8). SQ3024.2 +004700 SQ3024.2 +004800 FD SQ-FRR. SQ3024.2 +004900 01 SREC. SQ3024.2 +005000 03 SKEY PIC X(8). SQ3024.2 +005100 SQ3024.2 +005200 FD RR-FS1. SQ3024.2 +005300 01 RREC. SQ3024.2 +005400 03 FKEY PIC X(8). SQ3024.2 +005500 SQ3024.2 +005600 WORKING-STORAGE SECTION. SQ3024.2 +005700 SQ3024.2 +005800 01 VARIABLES. SQ3024.2 +005900 03 VKEY PIC 9(8) VALUE ZERO. SQ3024.2 +006000 03 DKEY PIC 9(8) VALUE ZERO. SQ3024.2 +006100 SQ3024.2 +006200 PROCEDURE DIVISION. SQ3024.2 +006300 SQ3024.2 +006400 SQ302M-CONTROL. SQ3024.2 +006500 DISPLAY "THIS IS A DUMMY PARAGRAPH". SQ3024.2 +006600 STOP RUN. SQ3024.2 +006700 SQ3024.2 +006800*TOTAL NUMBER OF FLAGS EXPECTED = 4. SQ3024.2 +*END-OF,SQ302M +*HEADER,COBOL,SQ303M +000100 IDENTIFICATION DIVISION. SQ3034.2 +000200 PROGRAM-ID. SQ3034.2 +000300 SQ303M. SQ3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SQ3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN HIGH SUBSET SEQUENTIAL SQ3034.2 +000600*INPUT-OUTPUT. SQ3034.2 +000700 ENVIRONMENT DIVISION. SQ3034.2 +000800 CONFIGURATION SECTION. SQ3034.2 +000900 SOURCE-COMPUTER. SQ3034.2 +001000 XXXXX082. SQ3034.2 +001100 OBJECT-COMPUTER. SQ3034.2 +001200 XXXXX083. SQ3034.2 +001300 INPUT-OUTPUT SECTION. SQ3034.2 +001400 FILE-CONTROL. SQ3034.2 +001500 SELECT TFIL ASSIGN SQ3034.2 +001600 XXXXX014 SQ3034.2 +001700 ORGANIZATION IS SEQUENTIAL SQ3034.2 +001800 ACCESS MODE IS SEQUENTIAL. SQ3034.2 +001900 SQ3034.2 +002000 SELECT TFIL2 ASSIGN SQ3034.2 +002100 XXXXX008 SQ3034.2 +002200 ORGANIZATION IS SEQUENTIAL SQ3034.2 +002300 ACCESS MODE IS SEQUENTIAL. SQ3034.2 +002400 SQ3034.2 +002500 I-O-CONTROL. SQ3034.2 +002600 MULTIPLE FILE TAPE CONTAINS TFIL2. SQ3034.2 +002700*Message expected for above statement: OBSOLETE SQ3034.2 +002800 SQ3034.2 +002900 DATA DIVISION. SQ3034.2 +003000 FILE SECTION. SQ3034.2 +003100 FD TFIL. SQ3034.2 +003200 01 FREC. SQ3034.2 +003300 03 RKEY PIC 9(8). SQ3034.2 +003400 SQ3034.2 +003500 FD TFIL2. SQ3034.2 +003600 01 FREC2. SQ3034.2 +003700 03 RKEY2 PIC 9(8). SQ3034.2 +003800 SQ3034.2 +003900 PROCEDURE DIVISION. SQ3034.2 +004000 SQ3034.2 +004100 SQ303M-CONTROL. SQ3034.2 +004200 OPEN INPUT TFIL REVERSED. SQ3034.2 +004300*Message expected for above statement: OBSOLETE SQ3034.2 +004400 SQ3034.2 +004500 CLOSE TFIL. SQ3034.2 +004600 STOP RUN. SQ3034.2 +004700 SQ3034.2 +004800 SQ3034.2 +004900*TOTAL NUMBER OF FLAGS EXPECTED = 2. SQ3034.2 +*END-OF,SQ303M +*HEADER,COBOL,SQ401M +000100 IDENTIFICATION DIVISION. SQ4014.2 +000200 PROGRAM-ID. SQ4014.2 +000300 SQ401M. SQ4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH SQ4014.2 +000500*SUBSET FEATURES THAT ARE USED IN SEQUENTIAL SQ4014.2 +000600*INPUT-OUTPUT. SQ4014.2 +000700 ENVIRONMENT DIVISION. SQ4014.2 +000800 CONFIGURATION SECTION. SQ4014.2 +000900 SOURCE-COMPUTER. SQ4014.2 +001000 XXXXX082. SQ4014.2 +001100 OBJECT-COMPUTER. SQ4014.2 +001200 XXXXX083. SQ4014.2 +001300 INPUT-OUTPUT SECTION. SQ4014.2 +001400 FILE-CONTROL. SQ4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN SQ4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +001700 SQ4014.2 +001800 XXXXX002 SQ4014.2 +001900 RESERVE 2 AREAS SQ4014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002100 SQ4014.2 +002200 ORGANIZATION IS SEQUENTIAL SQ4014.2 +002300 PADDING CHARACTER IS "P" SQ4014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002500 SQ4014.2 +002600 RECORD DELIMITER IS STANDARD-1 SQ4014.2 +002700*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002800 SQ4014.2 +002900 ACCESS MODE IS SEQUENTIAL. SQ4014.2 +003000 SQ4014.2 +003100 SELECT TFIL2 ASSIGN SQ4014.2 +003200 XXXXX008 SQ4014.2 +003300 ORGANIZATION IS SEQUENTIAL SQ4014.2 +003400 ACCESS MODE IS SEQUENTIAL. SQ4014.2 +003500 SQ4014.2 +003600 SQ4014.2 +003700 SELECT TFIL3 ASSIGN SQ4014.2 +003800 XXXXX003. SQ4014.2 +003900 SQ4014.2 +004000 I-O-CONTROL. SQ4014.2 +004100 SAME RECORD AREA FOR TFIL2, TFIL SQ4014.2 +004200*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +004300 SQ4014.2 +004400 MULTIPLE FILE TAPE CONTAINS TFIL2. SQ4014.2 +004500*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +004600 SQ4014.2 +004700 DATA DIVISION. SQ4014.2 +004800 FILE SECTION. SQ4014.2 +004900 FD TFIL SQ4014.2 +005000 BLOCK CONTAINS 1 TO 8 RECORDS SQ4014.2 +005100*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005200 SQ4014.2 +005300 RECORD VARYING IN SIZE FROM 1 TO 8 CHARACTERS SQ4014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005500 SQ4014.2 +005600 LINAGE IS 20 LINES SQ4014.2 +005700*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005800 SQ4014.2 +005900 LABEL RECORDS ARE STANDARD SQ4014.2 +006000 VALUE OF SQ4014.2 +006100 XXXXX074 SQ4014.2 +006200 IS VKEY. SQ4014.2 +006300*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +006400 SQ4014.2 +006500 01 FREC. SQ4014.2 +006600 03 RKEY PIC 9(8). SQ4014.2 +006700 SQ4014.2 +006800 FD TFIL2. SQ4014.2 +006900 01 FREC2. SQ4014.2 +007000 03 RKEY2 PIC 9(8). SQ4014.2 +007100 SQ4014.2 +007200 SQ4014.2 +007300 FD TFIL3. SQ4014.2 +007400 01 FREC3. SQ4014.2 +007500 02 RKEY3 PIC 9(8). SQ4014.2 +007600 SQ4014.2 +007700 WORKING-STORAGE SECTION. SQ4014.2 +007800 SQ4014.2 +007900 01 VARIABLES. SQ4014.2 +008000 SQ4014.2 +008100 03 VKEY SQ4014.2 +008200 XXXXX086. SQ4014.2 +008300 SQ4014.2 +008400 SQ4014.2 +008500 PROCEDURE DIVISION. SQ4014.2 +008600 SQ4014.2 +008700 SQ401M-CONTROL. SQ4014.2 +008800 OPEN INPUT TFIL. SQ4014.2 +008900 PERFORM SQ401M-CLOSEREMOV THRU SQ401M-WRITEEOP. SQ4014.2 +009000 CLOSE TFIL. SQ4014.2 +009100 CLOSE TFIL2. SQ4014.2 +009200 STOP RUN. SQ4014.2 +009300 SQ4014.2 +009400 SQ401M-CLOSEREMOV. SQ4014.2 +009500 CLOSE TFIL REEL FOR REMOVAL. SQ4014.2 +009600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +009700 SQ4014.2 +009800 SQ401M-CLOSENRW. SQ4014.2 +009900 OPEN INPUT TFIL. SQ4014.2 +010000 CLOSE TFIL WITH NO REWIND. SQ4014.2 +010100*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +010200 SQ4014.2 +010300 SQ401M-CLOSELOCK. SQ4014.2 +010400 OPEN INPUT TFIL. SQ4014.2 +010500 CLOSE TFIL WITH LOCK. SQ4014.2 +010600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +010700 SQ4014.2 +010800 SQ401M-OPENREV. SQ4014.2 +010900 OPEN INPUT TFIL REVERSED. SQ4014.2 +011000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +011100 SQ4014.2 +011200 SQ401M-OPENNOREW. SQ4014.2 +011300 CLOSE TFIL. SQ4014.2 +011400 OPEN INPUT TFIL WITH NO REWIND. SQ4014.2 +011500*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +011600 SQ4014.2 +011700 SQ401M-EXTEND. SQ4014.2 +011800 CLOSE TFIL. SQ4014.2 +011900 OPEN EXTEND TFIL3. SQ4014.2 +012000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +012100 SQ4014.2 +012200 SQ401M-READNEXT. SQ4014.2 +012300 OPEN INPUT TFIL. SQ4014.2 +012400 READ TFIL NEXT RECORD SQ4014.2 +012500 AT END DISPLAY "AT END". SQ4014.2 +012600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +012700 SQ4014.2 +012800 CLOSE TFIL. SQ4014.2 +012900 SQ4014.2 +013000 SQ401M-WRITEEOP. SQ4014.2 +013100 OPEN OUTPUT TFIL. SQ4014.2 +013200 WRITE FREC AT END-OF-PAGE DISPLAY "HELLO". SQ4014.2 +013300*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +013400 SQ4014.2 +013500 SQ4014.2 +013600 SQ4014.2 +013700*TOTAL NUMBER OF FLAGS EXPECTED = 18. SQ4014.2 +*END-OF,SQ401M +*HEADER,COBOL,ST101A +000100 IDENTIFICATION DIVISION. ST1014.2 +000200 PROGRAM-ID. ST1014.2 +000300 ST101A. ST1014.2 +000400**************************************************************** ST1014.2 +000500* * ST1014.2 +000600* VALIDATION FOR:- * ST1014.2 +000700* * ST1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +000900* * ST1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1014.2 +001100* * ST1014.2 +001200**************************************************************** ST1014.2 +001300* * ST1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1014.2 +001500* * ST1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1014.2 +001900* * ST1014.2 +002000**************************************************************** ST1014.2 +002100 ENVIRONMENT DIVISION. ST1014.2 +002200 CONFIGURATION SECTION. ST1014.2 +002300 SOURCE-COMPUTER. ST1014.2 +002400 XXXXX082. ST1014.2 +002500 OBJECT-COMPUTER. ST1014.2 +002600 XXXXX083. ST1014.2 +002700 INPUT-OUTPUT SECTION. ST1014.2 +002800 FILE-CONTROL. ST1014.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1014.2 +003000 XXXXX055. ST1014.2 +003100 SELECT SORTFILE-1A ASSIGN TO ST1014.2 +003200 XXXXX027. ST1014.2 +003300 SELECT SORTOUT-1A ASSIGN TO ST1014.2 +003400 XXXXP001. ST1014.2 +003500 DATA DIVISION. ST1014.2 +003600 FILE SECTION. ST1014.2 +003700 FD PRINT-FILE. ST1014.2 +003800 01 PRINT-REC PICTURE X(120). ST1014.2 +003900 01 DUMMY-RECORD PICTURE X(120). ST1014.2 +004000 SD SORTFILE-1A ST1014.2 +004100 DATA RECORD IS S-RECORD. ST1014.2 +004200 01 S-RECORD. ST1014.2 +004300 02 KEYS-GROUP. ST1014.2 +004400 03 KEY-1 PICTURE 9. ST1014.2 +004500 03 KEY-2 PICTURE 99. ST1014.2 +004600 03 KEY-3 PICTURE 999. ST1014.2 +004700 03 KEY-4 PICTURE 9999. ST1014.2 +004800 03 KEY-5 PICTURE 9(5). ST1014.2 +004900 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). ST1014.2 +005000 02 FILLER PICTURE X(105). ST1014.2 +005100 FD SORTOUT-1A ST1014.2 +005200 BLOCK CONTAINS 10 RECORDS ST1014.2 +005300 LABEL RECORDS ARE STANDARD ST1014.2 +005400C VALUE OF ST1014.2 +005500C XXXXX074 ST1014.2 +005600C IS ST1014.2 +005700C XXXXX075 ST1014.2 +005800G XXXXX069 ST1014.2 +005900 DATA RECORD IS SORTED. ST1014.2 +006000 01 SORTED PICTURE X(120). ST1014.2 +006100 WORKING-STORAGE SECTION. ST1014.2 +006200 77 C0 PICTURE 9 VALUE 0. ST1014.2 +006300 77 C1 PICTURE 9 VALUE 1. ST1014.2 +006400 77 C2 PICTURE 9 VALUE 2. ST1014.2 +006500 77 C6 PICTURE 9 VALUE 6. ST1014.2 +006600 77 C3 PICTURE 9 VALUE 3. ST1014.2 +006700 77 COMMENT-SENTENCE PIC X(116) VALUE " THE FILE BUILT IN ST101AST1014.2 +006800- " IS USED BY ST102A. ST102A DOES NOT PRODUCE A REPORT- THE R ST1014.2 +006900- "ESULTS ARE CHECKED IN ST103A.". ST1014.2 +007000 01 WKEYS-GROUP. ST1014.2 +007100 02 WKEY-1 PICTURE 9. ST1014.2 +007200 02 WKEY-2 PICTURE 99. ST1014.2 +007300 02 WKEY-3 PICTURE 999. ST1014.2 +007400 02 WKEY-4 PICTURE 9999. ST1014.2 +007500 02 WKEY-5 PICTURE 9(5). ST1014.2 +007600 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). ST1014.2 +007700 01 TEST-RESULTS. ST1014.2 +007800 02 FILLER PIC X VALUE SPACE. ST1014.2 +007900 02 FEATURE PIC X(20) VALUE SPACE. ST1014.2 +008000 02 FILLER PIC X VALUE SPACE. ST1014.2 +008100 02 P-OR-F PIC X(5) VALUE SPACE. ST1014.2 +008200 02 FILLER PIC X VALUE SPACE. ST1014.2 +008300 02 PAR-NAME. ST1014.2 +008400 03 FILLER PIC X(19) VALUE SPACE. ST1014.2 +008500 03 PARDOT-X PIC X VALUE SPACE. ST1014.2 +008600 03 DOTVALUE PIC 99 VALUE ZERO. ST1014.2 +008700 02 FILLER PIC X(8) VALUE SPACE. ST1014.2 +008800 02 RE-MARK PIC X(61). ST1014.2 +008900 01 TEST-COMPUTED. ST1014.2 +009000 02 FILLER PIC X(30) VALUE SPACE. ST1014.2 +009100 02 FILLER PIC X(17) VALUE ST1014.2 +009200 " COMPUTED=". ST1014.2 +009300 02 COMPUTED-X. ST1014.2 +009400 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1014.2 +009500 03 COMPUTED-N REDEFINES COMPUTED-A ST1014.2 +009600 PIC -9(9).9(9). ST1014.2 +009700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1014.2 +009800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1014.2 +009900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1014.2 +010000 03 CM-18V0 REDEFINES COMPUTED-A. ST1014.2 +010100 04 COMPUTED-18V0 PIC -9(18). ST1014.2 +010200 04 FILLER PIC X. ST1014.2 +010300 03 FILLER PIC X(50) VALUE SPACE. ST1014.2 +010400 01 TEST-CORRECT. ST1014.2 +010500 02 FILLER PIC X(30) VALUE SPACE. ST1014.2 +010600 02 FILLER PIC X(17) VALUE " CORRECT =". ST1014.2 +010700 02 CORRECT-X. ST1014.2 +010800 03 CORRECT-A PIC X(20) VALUE SPACE. ST1014.2 +010900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1014.2 +011000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1014.2 +011100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1014.2 +011200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1014.2 +011300 03 CR-18V0 REDEFINES CORRECT-A. ST1014.2 +011400 04 CORRECT-18V0 PIC -9(18). ST1014.2 +011500 04 FILLER PIC X. ST1014.2 +011600 03 FILLER PIC X(2) VALUE SPACE. ST1014.2 +011700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1014.2 +011800 01 CCVS-C-1. ST1014.2 +011900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1014.2 +012000- "SS PARAGRAPH-NAME ST1014.2 +012100- " REMARKS". ST1014.2 +012200 02 FILLER PIC X(20) VALUE SPACE. ST1014.2 +012300 01 CCVS-C-2. ST1014.2 +012400 02 FILLER PIC X VALUE SPACE. ST1014.2 +012500 02 FILLER PIC X(6) VALUE "TESTED". ST1014.2 +012600 02 FILLER PIC X(15) VALUE SPACE. ST1014.2 +012700 02 FILLER PIC X(4) VALUE "FAIL". ST1014.2 +012800 02 FILLER PIC X(94) VALUE SPACE. ST1014.2 +012900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1014.2 +013000 01 REC-CT PIC 99 VALUE ZERO. ST1014.2 +013100 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013200 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013400 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013500 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1014.2 +013600 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1014.2 +013700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1014.2 +013800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1014.2 +013900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1014.2 +014000 01 CCVS-H-1. ST1014.2 +014100 02 FILLER PIC X(39) VALUE SPACES. ST1014.2 +014200 02 FILLER PIC X(42) VALUE ST1014.2 +014300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1014.2 +014400 02 FILLER PIC X(39) VALUE SPACES. ST1014.2 +014500 01 CCVS-H-2A. ST1014.2 +014600 02 FILLER PIC X(40) VALUE SPACE. ST1014.2 +014700 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1014.2 +014800 02 FILLER PIC XXXX VALUE ST1014.2 +014900 "4.2 ". ST1014.2 +015000 02 FILLER PIC X(28) VALUE ST1014.2 +015100 " COPY - NOT FOR DISTRIBUTION". ST1014.2 +015200 02 FILLER PIC X(41) VALUE SPACE. ST1014.2 +015300 ST1014.2 +015400 01 CCVS-H-2B. ST1014.2 +015500 02 FILLER PIC X(15) VALUE ST1014.2 +015600 "TEST RESULT OF ". ST1014.2 +015700 02 TEST-ID PIC X(9). ST1014.2 +015800 02 FILLER PIC X(4) VALUE ST1014.2 +015900 " IN ". ST1014.2 +016000 02 FILLER PIC X(12) VALUE ST1014.2 +016100 " HIGH ". ST1014.2 +016200 02 FILLER PIC X(22) VALUE ST1014.2 +016300 " LEVEL VALIDATION FOR ". ST1014.2 +016400 02 FILLER PIC X(58) VALUE ST1014.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +016600 01 CCVS-H-3. ST1014.2 +016700 02 FILLER PIC X(34) VALUE ST1014.2 +016800 " FOR OFFICIAL USE ONLY ". ST1014.2 +016900 02 FILLER PIC X(58) VALUE ST1014.2 +017000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1014.2 +017100 02 FILLER PIC X(28) VALUE ST1014.2 +017200 " COPYRIGHT 1985 ". ST1014.2 +017300 01 CCVS-E-1. ST1014.2 +017400 02 FILLER PIC X(52) VALUE SPACE. ST1014.2 +017500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1014.2 +017600 02 ID-AGAIN PIC X(9). ST1014.2 +017700 02 FILLER PIC X(45) VALUE SPACES. ST1014.2 +017800 01 CCVS-E-2. ST1014.2 +017900 02 FILLER PIC X(31) VALUE SPACE. ST1014.2 +018000 02 FILLER PIC X(21) VALUE SPACE. ST1014.2 +018100 02 CCVS-E-2-2. ST1014.2 +018200 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1014.2 +018300 03 FILLER PIC X VALUE SPACE. ST1014.2 +018400 03 ENDER-DESC PIC X(44) VALUE ST1014.2 +018500 "ERRORS ENCOUNTERED". ST1014.2 +018600 01 CCVS-E-3. ST1014.2 +018700 02 FILLER PIC X(22) VALUE ST1014.2 +018800 " FOR OFFICIAL USE ONLY". ST1014.2 +018900 02 FILLER PIC X(12) VALUE SPACE. ST1014.2 +019000 02 FILLER PIC X(58) VALUE ST1014.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +019200 02 FILLER PIC X(13) VALUE SPACE. ST1014.2 +019300 02 FILLER PIC X(15) VALUE ST1014.2 +019400 " COPYRIGHT 1985". ST1014.2 +019500 01 CCVS-E-4. ST1014.2 +019600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1014.2 +019700 02 FILLER PIC X(4) VALUE " OF ". ST1014.2 +019800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1014.2 +019900 02 FILLER PIC X(40) VALUE ST1014.2 +020000 " TESTS WERE EXECUTED SUCCESSFULLY". ST1014.2 +020100 01 XXINFO. ST1014.2 +020200 02 FILLER PIC X(19) VALUE ST1014.2 +020300 "*** INFORMATION ***". ST1014.2 +020400 02 INFO-TEXT. ST1014.2 +020500 04 FILLER PIC X(8) VALUE SPACE. ST1014.2 +020600 04 XXCOMPUTED PIC X(20). ST1014.2 +020700 04 FILLER PIC X(5) VALUE SPACE. ST1014.2 +020800 04 XXCORRECT PIC X(20). ST1014.2 +020900 02 INF-ANSI-REFERENCE PIC X(48). ST1014.2 +021000 01 HYPHEN-LINE. ST1014.2 +021100 02 FILLER PIC IS X VALUE IS SPACE. ST1014.2 +021200 02 FILLER PIC IS X(65) VALUE IS "************************ST1014.2 +021300- "*****************************************". ST1014.2 +021400 02 FILLER PIC IS X(54) VALUE IS "************************ST1014.2 +021500- "******************************". ST1014.2 +021600 01 CCVS-PGM-ID PIC X(9) VALUE ST1014.2 +021700 "ST101A". ST1014.2 +021800 PROCEDURE DIVISION. ST1014.2 +021900 SORT-INIT SECTION. ST1014.2 +022000 I-1. ST1014.2 +022100 SORT SORTFILE-1A ST1014.2 +022200 ON ASCENDING KEY KEY-1 ST1014.2 +022300 ON DESCENDING KEY KEY-2 ST1014.2 +022400 ON ASCENDING KEY KEY-3 ST1014.2 +022500 DESCENDING KEY-4 KEY-5 ST1014.2 +022600 INPUT PROCEDURE IS INSORT ST1014.2 +022700 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. ST1014.2 +022800 I-2. ST1014.2 +022900 STOP RUN. ST1014.2 +023000 INSORT SECTION. ST1014.2 +023100 IN-1. ST1014.2 +023200* NOTE. ST1014.2 +023300* KEYS 1 AND 3 THRU 5 WILL VARY IN VALUE BETWEEN 1 AND 2. ST1014.2 +023400* KEY 2 VARIES FROM 1 THRU 6. THUS 96 RECORDS ARE CREATED ST1014.2 +023500* IN REVERSE SEQUENCE OF SORTING ORDER. TWO RECORDS ARE ST1014.2 +023600* ADDED TO EACH END OF THE SORTED STRING FOR HI-LOW CONTROL.ST1014.2 +023700* THE SORT STATEMENT TESTS THE SERIES AND THRU OPTIONS WITH ST1014.2 +023800* INCLUSION AND OMISSION OF OPTIONAL WORDS. THE SORT ST1014.2 +023900* STATEMENT REPRESENTS BASIC SORTING PERMITTED BY LEVEL 1 OFST1014.2 +024000* THE SORT MODULE. ST1014.2 +024100 IN-2. ST1014.2 +024200 MOVE 900009000000000 TO RDF-KEYS. ST1014.2 +024300 RELEASE S-RECORD. ST1014.2 +024400 MOVE 009000000900009 TO RDF-KEYS. ST1014.2 +024500 RELEASE S-RECORD. ST1014.2 +024600 MOVE 900008000000000 TO RDF-KEYS. ST1014.2 +024700 RELEASE S-RECORD. ST1014.2 +024800 MOVE 009000000900008 TO RDF-KEYS. ST1014.2 +024900 RELEASE S-RECORD. ST1014.2 +025000* NOTE HI-LOW CONTROL RECORDS DONE. ST1014.2 +025100 MOVE 300003000000000 TO WKEYS-RDF. ST1014.2 +025200 IN-3. ST1014.2 +025300 PERFORM IN-4 2 TIMES. ST1014.2 +025400 GO TO IN-EXIT. ST1014.2 +025500 IN-4. ST1014.2 +025600 SUBTRACT C1 FROM WKEY-1. ST1014.2 +025700 PERFORM IN-5 6 TIMES. ST1014.2 +025800 IN-5. ST1014.2 +025900 IF WKEY-2 IS EQUAL TO C6 ST1014.2 +026000 MOVE C0 TO WKEY-2. ST1014.2 +026100 ADD C1 TO WKEY-2. ST1014.2 +026200 PERFORM IN-6 2 TIMES. ST1014.2 +026300 IN-6. ST1014.2 +026400 IF WKEY-3 IS EQUAL TO C1 ST1014.2 +026500 MOVE C3 TO WKEY-3. ST1014.2 +026600 SUBTRACT C1 FROM WKEY-3. ST1014.2 +026700 PERFORM IN-7 2 TIMES. ST1014.2 +026800 IN-7. ST1014.2 +026900 IF WKEY-4 IS EQUAL TO C2 ST1014.2 +027000 MOVE C0 TO WKEY-4. ST1014.2 +027100 ADD C1 TO WKEY-4. ST1014.2 +027200 PERFORM IN-8 2 TIMES. ST1014.2 +027300 IN-8. ST1014.2 +027400 IF WKEY-5 IS EQUAL TO C2 ST1014.2 +027500 MOVE C0 TO WKEY-5. ST1014.2 +027600 ADD C1 TO WKEY-5. ST1014.2 +027700 MOVE WKEYS-RDF TO RDF-KEYS. ST1014.2 +027800 RELEASE S-RECORD. ST1014.2 +027900 IN-EXIT. ST1014.2 +028000 EXIT. ST1014.2 +028100 OUTP1 SECTION. ST1014.2 +028200 SORTING-TEST. ST1014.2 +028300 OPEN OUTPUT SORTOUT-1A. ST1014.2 +028400 OPEN-FILES. ST1014.2 +028500 OPEN OUTPUT PRINT-FILE. ST1014.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1014.2 +028700 MOVE SPACE TO TEST-RESULTS. ST1014.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1014.2 +028900 GO TO CCVS1-EXIT. ST1014.2 +029000 CLOSE-FILES. ST1014.2 +029100 MOVE SPACES TO TEST-RESULTS. ST1014.2 +029200 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1014.2 +029300 PERFORM PRINT-DETAIL. ST1014.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1014.2 +029500 MOVE SPACES TO TEST-RESULTS. ST1014.2 +029600 TERMINATE-CCVS. ST1014.2 +029700S EXIT PROGRAM. ST1014.2 +029800STERMINATE-CALL. ST1014.2 +029900 STOP RUN. ST1014.2 +030000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1014.2 +030100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1014.2 +030200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1014.2 +030300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1014.2 +030400 MOVE "****TEST DELETED****" TO RE-MARK. ST1014.2 +030500 PRINT-DETAIL. ST1014.2 +030600 IF REC-CT NOT EQUAL TO ZERO ST1014.2 +030700 MOVE "." TO PARDOT-X ST1014.2 +030800 MOVE REC-CT TO DOTVALUE. ST1014.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1014.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1014.2 +031100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1014.2 +031200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1014.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1014.2 +031400 MOVE SPACE TO CORRECT-X. ST1014.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1014.2 +031600 MOVE SPACE TO RE-MARK. ST1014.2 +031700 HEAD-ROUTINE. ST1014.2 +031800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +031900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +032000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1014.2 +032100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1014.2 +032200 COLUMN-NAMES-ROUTINE. ST1014.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +032600 END-ROUTINE. ST1014.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1014.2 +032800 END-RTN-EXIT. ST1014.2 +032900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +033000 END-ROUTINE-1. ST1014.2 +033100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1014.2 +033200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1014.2 +033300 ADD PASS-COUNTER TO ERROR-HOLD. ST1014.2 +033400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1014.2 +033500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1014.2 +033600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1014.2 +033700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1014.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1014.2 +033900 END-ROUTINE-12. ST1014.2 +034000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1014.2 +034100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1014.2 +034200 MOVE "NO " TO ERROR-TOTAL ST1014.2 +034300 ELSE ST1014.2 +034400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1014.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1014.2 +034600 PERFORM WRITE-LINE. ST1014.2 +034700 END-ROUTINE-13. ST1014.2 +034800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1014.2 +034900 MOVE "NO " TO ERROR-TOTAL ELSE ST1014.2 +035000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1014.2 +035100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1014.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035300 IF INSPECT-COUNTER EQUAL TO ZERO ST1014.2 +035400 MOVE "NO " TO ERROR-TOTAL ST1014.2 +035500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1014.2 +035600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1014.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035900 WRITE-LINE. ST1014.2 +036000 ADD 1 TO RECORD-COUNT. ST1014.2 +036100Y IF RECORD-COUNT GREATER 42 ST1014.2 +036200Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1014.2 +036300Y MOVE SPACE TO DUMMY-RECORD ST1014.2 +036400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1014.2 +036500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1014.2 +036600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1014.2 +036700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1014.2 +036800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1014.2 +036900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037200Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1014.2 +037300Y MOVE ZERO TO RECORD-COUNT. ST1014.2 +037400 PERFORM WRT-LN. ST1014.2 +037500 WRT-LN. ST1014.2 +037600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1014.2 +037700 MOVE SPACE TO DUMMY-RECORD. ST1014.2 +037800 BLANK-LINE-PRINT. ST1014.2 +037900 PERFORM WRT-LN. ST1014.2 +038000 FAIL-ROUTINE. ST1014.2 +038100 IF COMPUTED-X NOT EQUAL TO SPACE ST1014.2 +038200 GO TO FAIL-ROUTINE-WRITE. ST1014.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1014.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1014.2 +038500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1014.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1014.2 +038800 GO TO FAIL-ROUTINE-EX. ST1014.2 +038900 FAIL-ROUTINE-WRITE. ST1014.2 +039000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1014.2 +039100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1014.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1014.2 +039300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1014.2 +039400 FAIL-ROUTINE-EX. EXIT. ST1014.2 +039500 BAIL-OUT. ST1014.2 +039600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1014.2 +039700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1014.2 +039800 BAIL-OUT-WRITE. ST1014.2 +039900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1014.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1014.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +040200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1014.2 +040300 BAIL-OUT-EX. EXIT. ST1014.2 +040400 CCVS1-EXIT. ST1014.2 +040500 EXIT. ST1014.2 +040600 ST101-0001-01. ST1014.2 +040700 MOVE "ST101 GENERATES OUTPUT" TO RE-MARK. ST1014.2 +040800 PERFORM PRINT-DETAIL. ST1014.2 +040900 MOVE "WHICH AFFECTS PROGRAMS" TO RE-MARK. ST1014.2 +041000 PERFORM PRINT-DETAIL. ST1014.2 +041100 MOVE "ST102 AND ST103." TO RE-MARK. ST1014.2 +041200 PERFORM PRINT-DETAIL. ST1014.2 +041300 MOVE "SORT --- FIVE KEYS" TO FEATURE. ST1014.2 +041400 SORT-TEST-1. ST1014.2 +041500 PERFORM RET-1. ST1014.2 +041600 IF RDF-KEYS EQUAL TO 009000000900009 ST1014.2 +041700 PERFORM PASS GO TO SORT-WRITE-1. ST1014.2 +041800 GO TO SORT-FAIL-1. ST1014.2 +041900 SORT-DELETE-1. ST1014.2 +042000 PERFORM DE-LETE. ST1014.2 +042100 GO TO SORT-WRITE-1. ST1014.2 +042200 SORT-FAIL-1. ST1014.2 +042300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +042400 MOVE 009000000900009 TO CORRECT-18V0. ST1014.2 +042500 PERFORM FAIL. ST1014.2 +042600 SORT-WRITE-1. ST1014.2 +042700 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1014.2 +042800 PERFORM PRINT-DETAIL. ST1014.2 +042900 SORT-TEST-2. ST1014.2 +043000 PERFORM RET-1. ST1014.2 +043100 IF RDF-KEYS EQUAL TO 009000000900008 ST1014.2 +043200 PERFORM PASS GO TO SORT-WRITE-2. ST1014.2 +043300 GO TO SORT-FAIL-2. ST1014.2 +043400 SORT-DELETE-2. ST1014.2 +043500 PERFORM DE-LETE. ST1014.2 +043600 GO TO SORT-WRITE-2. ST1014.2 +043700 SORT-FAIL-2. ST1014.2 +043800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +043900 MOVE 009000000900009 TO CORRECT-18V0. ST1014.2 +044000 PERFORM FAIL. ST1014.2 +044100 SORT-WRITE-2. ST1014.2 +044200 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1014.2 +044300 PERFORM PRINT-DETAIL. ST1014.2 +044400 SORT-TEST-3. ST1014.2 +044500 PERFORM RET-1. ST1014.2 +044600 IF RDF-KEYS EQUAL TO 106001000200002 ST1014.2 +044700 PERFORM PASS GO TO SORT-WRITE-3. ST1014.2 +044800 GO TO SORT-FAIL-3. ST1014.2 +044900 SORT-DELETE-3. ST1014.2 +045000 PERFORM DE-LETE. ST1014.2 +045100 GO TO SORT-WRITE-3. ST1014.2 +045200 SORT-FAIL-3. ST1014.2 +045300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +045400 MOVE 106001000200002 TO CORRECT-18V0. ST1014.2 +045500 PERFORM FAIL. ST1014.2 +045600 SORT-WRITE-3. ST1014.2 +045700 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1014.2 +045800 PERFORM PRINT-DETAIL. ST1014.2 +045900 OUTP2 SECTION. ST1014.2 +046000 SORT-TEST-4. ST1014.2 +046100 PERFORM RET-2 48 TIMES. ST1014.2 +046200 IF RDF-KEYS EQUAL TO 206001000200002 ST1014.2 +046300 PERFORM PASS GO TO SORT-WRITE-4. ST1014.2 +046400 GO TO SORT-FAIL-4. ST1014.2 +046500 SORT-DELETE-4. ST1014.2 +046600 PERFORM DE-LETE. ST1014.2 +046700 GO TO SORT-WRITE-4. ST1014.2 +046800 SORT-FAIL-4. ST1014.2 +046900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +047000 MOVE 206001000200002 TO CORRECT-18V0. ST1014.2 +047100 PERFORM FAIL. ST1014.2 +047200 SORT-WRITE-4. ST1014.2 +047300 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1014.2 +047400 PERFORM PRINT-DETAIL. ST1014.2 +047500 SORT-TEST-5. ST1014.2 +047600 PERFORM RET-2 40 TIMES. ST1014.2 +047700 IF RDF-KEYS EQUAL TO 201001000200002 ST1014.2 +047800 PERFORM PASS GO TO SORT-WRITE-5. ST1014.2 +047900 GO TO SORT-FAIL-5. ST1014.2 +048000 SORT-DELETE-5. ST1014.2 +048100 PERFORM DE-LETE. ST1014.2 +048200 GO TO SORT-WRITE-5. ST1014.2 +048300 SORT-FAIL-5. ST1014.2 +048400 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +048500 MOVE 201001000200002 TO CORRECT-18V0. ST1014.2 +048600 PERFORM FAIL. ST1014.2 +048700 SORT-WRITE-5. ST1014.2 +048800 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1014.2 +048900 PERFORM PRINT-DETAIL. ST1014.2 +049000 SORT-TEST-6. ST1014.2 +049100 PERFORM RET-2 7 TIMES. ST1014.2 +049200 IF RDF-KEYS EQUAL TO 201002000100001 ST1014.2 +049300 PERFORM PASS GO TO SORT-WRITE-6. ST1014.2 +049400 GO TO SORT-FAIL-6. ST1014.2 +049500 SORT-DELETE-6. ST1014.2 +049600 PERFORM DE-LETE. ST1014.2 +049700 GO TO SORT-WRITE-6. ST1014.2 +049800 SORT-FAIL-6. ST1014.2 +049900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +050000 MOVE 201002000100001 TO CORRECT-18V0. ST1014.2 +050100 PERFORM FAIL. ST1014.2 +050200 SORT-WRITE-6. ST1014.2 +050300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1014.2 +050400 PERFORM PRINT-DETAIL. ST1014.2 +050500 SORT-TEST-7. ST1014.2 +050600 PERFORM RET-2. ST1014.2 +050700 IF RDF-KEYS EQUAL TO 900008000000000 ST1014.2 +050800 PERFORM PASS GO TO SORT-WRITE-7. ST1014.2 +050900 GO TO SORT-FAIL-7. ST1014.2 +051000 SORT-DELETE-7. ST1014.2 +051100 PERFORM DE-LETE. ST1014.2 +051200 GO TO SORT-WRITE-7. ST1014.2 +051300 SORT-FAIL-7. ST1014.2 +051400 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +051500 MOVE 900008000000000 TO CORRECT-18V0. ST1014.2 +051600 PERFORM FAIL. ST1014.2 +051700 SORT-WRITE-7. ST1014.2 +051800 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1014.2 +051900 PERFORM PRINT-DETAIL. ST1014.2 +052000 SORT-TEST-8. ST1014.2 +052100 PERFORM RET-2. ST1014.2 +052200 IF RDF-KEYS EQUAL TO 900009000000000 ST1014.2 +052300 PERFORM PASS GO TO SORT-WRITE-8. ST1014.2 +052400 GO TO SORT-FAIL-8. ST1014.2 +052500 SORT-DELETE-8. ST1014.2 +052600 PERFORM DE-LETE. ST1014.2 +052700 GO TO SORT-WRITE-8. ST1014.2 +052800 SORT-FAIL-8. ST1014.2 +052900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +053000 MOVE 900009000000000 TO CORRECT-18V0. ST1014.2 +053100 PERFORM FAIL. ST1014.2 +053200 SORT-WRITE-8. ST1014.2 +053300 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1014.2 +053400 PERFORM PRINT-DETAIL. ST1014.2 +053500 SORT-TEST-9. ST1014.2 +053600 RETURN SORTFILE-1A AT END ST1014.2 +053700 PERFORM PASS GO TO SORT-WRITE-9. ST1014.2 +053800 GO TO SORT-FAIL-9. ST1014.2 +053900 SORT-DELETE-9. ST1014.2 +054000 PERFORM DE-LETE. ST1014.2 +054100 GO TO SORT-WRITE-9. ST1014.2 +054200 SORT-FAIL-9. ST1014.2 +054300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +054400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1014.2 +054500 PERFORM FAIL. ST1014.2 +054600 SORT-WRITE-9. ST1014.2 +054700 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1014.2 +054800 PERFORM PRINT-DETAIL. ST1014.2 +054900 OUTP3 SECTION. ST1014.2 +055000 ST101-0002-01. ST1014.2 +055100 CLOSE SORTOUT-1A. ST1014.2 +055200 GO TO OUTP3-EXIT. ST1014.2 +055300 BAD-FILE. ST1014.2 +055400 MOVE "BAD-FILE" TO PAR-NAME. ST1014.2 +055500 PERFORM FAIL. ST1014.2 +055600 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1014.2 +055700 PERFORM PRINT-DETAIL. ST1014.2 +055800 MOVE "REACHED, PREVIOUS TEST WAS" TO RE-MARK. ST1014.2 +055900 PERFORM PRINT-DETAIL. ST1014.2 +056000 MOVE "THE LAST SUCCESSFUL TEST." TO RE-MARK. ST1014.2 +056100 PERFORM PRINT-DETAIL. ST1014.2 +056200 MOVE SPACE TO FEATURE. ST1014.2 +056300 GO TO OUTP3-EXIT. ST1014.2 +056400 RET-1. ST1014.2 +056500 RETURN SORTFILE-1A RECORD AT END GO TO BAD-FILE. ST1014.2 +056600 MOVE S-RECORD TO SORTED. ST1014.2 +056700 WRITE SORTED. ST1014.2 +056800* NOTE THE RETURN VERB WITH ALL OPTIONAL WORDS. ST1014.2 +056900 RET-2. ST1014.2 +057000 RETURN SORTFILE-1A END GO TO BAD-FILE. ST1014.2 +057100 MOVE S-RECORD TO SORTED. ST1014.2 +057200 WRITE SORTED. ST1014.2 +057300* NOTE THE RETURN VERB WITHOUT OPTIONAL WORDS. ST1014.2 +057400 OUTP3-EXIT. ST1014.2 +057500 PERFORM CLOSE-FILES. ST1014.2 +*END-OF,ST101A +*HEADER,COBOL,ST101A,SUBPRG,ST102A +000100 IDENTIFICATION DIVISION. ST1024.2 +000200 PROGRAM-ID. ST1024.2 +000300 ST102A. ST1024.2 +000400**************************************************************** ST1024.2 +000500* * ST1024.2 +000600* VALIDATION FOR:- * ST1024.2 +000700* * ST1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1024.2 +000900* * ST1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1024.2 +001100* * ST1024.2 +001200**************************************************************** ST1024.2 +001300* * ST1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1024.2 +001500* * ST1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1024.2 +001900* * ST1024.2 +002000**************************************************************** ST1024.2 +002100 ENVIRONMENT DIVISION. ST1024.2 +002200 CONFIGURATION SECTION. ST1024.2 +002300 SOURCE-COMPUTER. ST1024.2 +002400 XXXXX082. ST1024.2 +002500 OBJECT-COMPUTER. ST1024.2 +002600 XXXXX083. ST1024.2 +002700 INPUT-OUTPUT SECTION. ST1024.2 +002800 FILE-CONTROL. ST1024.2 +002900 SELECT SORTFILE-1B ASSIGN TO ST1024.2 +003000 XXXXX027. ST1024.2 +003100 SELECT SORTIN-1B ASSIGN TO ST1024.2 +003200 XXXXD001. ST1024.2 +003300 SELECT SORTOUT-1B ASSIGN TO ST1024.2 +003400 XXXXP002. ST1024.2 +003500 DATA DIVISION. ST1024.2 +003600 FILE SECTION. ST1024.2 +003700 SD SORTFILE-1B ST1024.2 +003800 RECORD CONTAINS 120 CHARACTERS ST1024.2 +003900 DATA RECORD S-RECORD. ST1024.2 +004000 01 S-RECORD. ST1024.2 +004100 02 KEYS-GROUP. ST1024.2 +004200 03 KEY-1 PICTURE 9. ST1024.2 +004300 03 KEY-2 PICTURE 99. ST1024.2 +004400 03 KEY-3 PICTURE 999. ST1024.2 +004500 03 KEY-4 PICTURE 9999. ST1024.2 +004600 03 KEY-5 PICTURE 9(5). ST1024.2 +004700 02 FILLER PICTURE X(105). ST1024.2 +004800 FD SORTIN-1B ST1024.2 +004900 BLOCK CONTAINS 10 RECORDS ST1024.2 +005000 LABEL RECORDS ARE STANDARD ST1024.2 +005100C VALUE OF ST1024.2 +005200C XXXXX074 ST1024.2 +005300C IS ST1024.2 +005400C XXXXX075 ST1024.2 +005500G XXXXX069 ST1024.2 +005600 DATA RECORD IS INSORT. ST1024.2 +005700 01 INSORT PICTURE X(120). ST1024.2 +005800 FD SORTOUT-1B ST1024.2 +005900 BLOCK CONTAINS 10 RECORDS ST1024.2 +006000 LABEL RECORD STANDARD ST1024.2 +006100C VALUE OF ST1024.2 +006200C XXXXX074 ST1024.2 +006300C IS ST1024.2 +006400C XXXXX076 ST1024.2 +006500G XXXXX069 ST1024.2 +006600 DATA RECORD OUTSORT. ST1024.2 +006700 01 OUTSORT PICTURE X(120). ST1024.2 +006800 PROCEDURE DIVISION. ST1024.2 +006900 SORT-STATEMENT. ST1024.2 +007000 SORT SORTFILE-1B ST1024.2 +007100 ON DESCENDING KEY KEY-1 ST1024.2 +007200 ON ASCENDING KEY KEY-2 ST1024.2 +007300 ON DESCENDING KEY KEY-3 ST1024.2 +007400 ASCENDING KEY-4 KEY-5 ST1024.2 +007500 USING SORTIN-1B ST1024.2 +007600 GIVING SORTOUT-1B. ST1024.2 +007700 STOP-RUN-STATEMENT. ST1024.2 +007800 STOP RUN. ST1024.2 +*END-OF,ST102A +*HEADER,COBOL,ST101A,SUBPRG,ST103A +000100 IDENTIFICATION DIVISION. ST1034.2 +000200 PROGRAM-ID. ST1034.2 +000300 ST103A. ST1034.2 +000400**************************************************************** ST1034.2 +000500* * ST1034.2 +000600* VALIDATION FOR:- * ST1034.2 +000700* * ST1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +000900* * ST1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1034.2 +001100* * ST1034.2 +001200**************************************************************** ST1034.2 +001300* * ST1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1034.2 +001500* * ST1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1034.2 +001900* * ST1034.2 +002000**************************************************************** ST1034.2 +002100 ENVIRONMENT DIVISION. ST1034.2 +002200 CONFIGURATION SECTION. ST1034.2 +002300 SOURCE-COMPUTER. ST1034.2 +002400 XXXXX082. ST1034.2 +002500 OBJECT-COMPUTER. ST1034.2 +002600 XXXXX083. ST1034.2 +002700 INPUT-OUTPUT SECTION. ST1034.2 +002800 FILE-CONTROL. ST1034.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1034.2 +003000 XXXXX055. ST1034.2 +003100 SELECT SORTIN-1C ASSIGN TO ST1034.2 +003200 XXXXD002. ST1034.2 +003300 DATA DIVISION. ST1034.2 +003400 FILE SECTION. ST1034.2 +003500 FD PRINT-FILE. ST1034.2 +003600 01 PRINT-REC PICTURE X(120). ST1034.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1034.2 +003800 FD SORTIN-1C ST1034.2 +003900 BLOCK CONTAINS 10 RECORDS ST1034.2 +004000 LABEL RECORD STANDARD ST1034.2 +004100C VALUE OF ST1034.2 +004200C XXXXX074 ST1034.2 +004300C IS ST1034.2 +004400C XXXXX076 ST1034.2 +004500G XXXXX069 ST1034.2 +004600 DATA RECORD IS SORTIN-REC. ST1034.2 +004700 01 SORTIN-REC. ST1034.2 +004800 02 KEYS-GROUP PICTURE 9(15). ST1034.2 +004900 02 FILLER PICTURE X(105). ST1034.2 +005000 WORKING-STORAGE SECTION. ST1034.2 +005100 01 TEST-RESULTS. ST1034.2 +005200 02 FILLER PIC X VALUE SPACE. ST1034.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. ST1034.2 +005400 02 FILLER PIC X VALUE SPACE. ST1034.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. ST1034.2 +005600 02 FILLER PIC X VALUE SPACE. ST1034.2 +005700 02 PAR-NAME. ST1034.2 +005800 03 FILLER PIC X(19) VALUE SPACE. ST1034.2 +005900 03 PARDOT-X PIC X VALUE SPACE. ST1034.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. ST1034.2 +006100 02 FILLER PIC X(8) VALUE SPACE. ST1034.2 +006200 02 RE-MARK PIC X(61). ST1034.2 +006300 01 TEST-COMPUTED. ST1034.2 +006400 02 FILLER PIC X(30) VALUE SPACE. ST1034.2 +006500 02 FILLER PIC X(17) VALUE ST1034.2 +006600 " COMPUTED=". ST1034.2 +006700 02 COMPUTED-X. ST1034.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1034.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A ST1034.2 +007000 PIC -9(9).9(9). ST1034.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1034.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1034.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1034.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. ST1034.2 +007500 04 COMPUTED-18V0 PIC -9(18). ST1034.2 +007600 04 FILLER PIC X. ST1034.2 +007700 03 FILLER PIC X(50) VALUE SPACE. ST1034.2 +007800 01 TEST-CORRECT. ST1034.2 +007900 02 FILLER PIC X(30) VALUE SPACE. ST1034.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1034.2 +008100 02 CORRECT-X. ST1034.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1034.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1034.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1034.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1034.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1034.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. ST1034.2 +008800 04 CORRECT-18V0 PIC -9(18). ST1034.2 +008900 04 FILLER PIC X. ST1034.2 +009000 03 FILLER PIC X(2) VALUE SPACE. ST1034.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1034.2 +009200 01 CCVS-C-1. ST1034.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1034.2 +009400- "SS PARAGRAPH-NAME ST1034.2 +009500- " REMARKS". ST1034.2 +009600 02 FILLER PIC X(20) VALUE SPACE. ST1034.2 +009700 01 CCVS-C-2. ST1034.2 +009800 02 FILLER PIC X VALUE SPACE. ST1034.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". ST1034.2 +010000 02 FILLER PIC X(15) VALUE SPACE. ST1034.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". ST1034.2 +010200 02 FILLER PIC X(94) VALUE SPACE. ST1034.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1034.2 +010400 01 REC-CT PIC 99 VALUE ZERO. ST1034.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1034.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1034.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1034.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1034.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1034.2 +011400 01 CCVS-H-1. ST1034.2 +011500 02 FILLER PIC X(39) VALUE SPACES. ST1034.2 +011600 02 FILLER PIC X(42) VALUE ST1034.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1034.2 +011800 02 FILLER PIC X(39) VALUE SPACES. ST1034.2 +011900 01 CCVS-H-2A. ST1034.2 +012000 02 FILLER PIC X(40) VALUE SPACE. ST1034.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1034.2 +012200 02 FILLER PIC XXXX VALUE ST1034.2 +012300 "4.2 ". ST1034.2 +012400 02 FILLER PIC X(28) VALUE ST1034.2 +012500 " COPY - NOT FOR DISTRIBUTION". ST1034.2 +012600 02 FILLER PIC X(41) VALUE SPACE. ST1034.2 +012700 ST1034.2 +012800 01 CCVS-H-2B. ST1034.2 +012900 02 FILLER PIC X(15) VALUE ST1034.2 +013000 "TEST RESULT OF ". ST1034.2 +013100 02 TEST-ID PIC X(9). ST1034.2 +013200 02 FILLER PIC X(4) VALUE ST1034.2 +013300 " IN ". ST1034.2 +013400 02 FILLER PIC X(12) VALUE ST1034.2 +013500 " HIGH ". ST1034.2 +013600 02 FILLER PIC X(22) VALUE ST1034.2 +013700 " LEVEL VALIDATION FOR ". ST1034.2 +013800 02 FILLER PIC X(58) VALUE ST1034.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +014000 01 CCVS-H-3. ST1034.2 +014100 02 FILLER PIC X(34) VALUE ST1034.2 +014200 " FOR OFFICIAL USE ONLY ". ST1034.2 +014300 02 FILLER PIC X(58) VALUE ST1034.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1034.2 +014500 02 FILLER PIC X(28) VALUE ST1034.2 +014600 " COPYRIGHT 1985 ". ST1034.2 +014700 01 CCVS-E-1. ST1034.2 +014800 02 FILLER PIC X(52) VALUE SPACE. ST1034.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1034.2 +015000 02 ID-AGAIN PIC X(9). ST1034.2 +015100 02 FILLER PIC X(45) VALUE SPACES. ST1034.2 +015200 01 CCVS-E-2. ST1034.2 +015300 02 FILLER PIC X(31) VALUE SPACE. ST1034.2 +015400 02 FILLER PIC X(21) VALUE SPACE. ST1034.2 +015500 02 CCVS-E-2-2. ST1034.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1034.2 +015700 03 FILLER PIC X VALUE SPACE. ST1034.2 +015800 03 ENDER-DESC PIC X(44) VALUE ST1034.2 +015900 "ERRORS ENCOUNTERED". ST1034.2 +016000 01 CCVS-E-3. ST1034.2 +016100 02 FILLER PIC X(22) VALUE ST1034.2 +016200 " FOR OFFICIAL USE ONLY". ST1034.2 +016300 02 FILLER PIC X(12) VALUE SPACE. ST1034.2 +016400 02 FILLER PIC X(58) VALUE ST1034.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +016600 02 FILLER PIC X(13) VALUE SPACE. ST1034.2 +016700 02 FILLER PIC X(15) VALUE ST1034.2 +016800 " COPYRIGHT 1985". ST1034.2 +016900 01 CCVS-E-4. ST1034.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1034.2 +017100 02 FILLER PIC X(4) VALUE " OF ". ST1034.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1034.2 +017300 02 FILLER PIC X(40) VALUE ST1034.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1034.2 +017500 01 XXINFO. ST1034.2 +017600 02 FILLER PIC X(19) VALUE ST1034.2 +017700 "*** INFORMATION ***". ST1034.2 +017800 02 INFO-TEXT. ST1034.2 +017900 04 FILLER PIC X(8) VALUE SPACE. ST1034.2 +018000 04 XXCOMPUTED PIC X(20). ST1034.2 +018100 04 FILLER PIC X(5) VALUE SPACE. ST1034.2 +018200 04 XXCORRECT PIC X(20). ST1034.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). ST1034.2 +018400 01 HYPHEN-LINE. ST1034.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. ST1034.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************ST1034.2 +018700- "*****************************************". ST1034.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************ST1034.2 +018900- "******************************". ST1034.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE ST1034.2 +019100 "ST103A". ST1034.2 +019200 PROCEDURE DIVISION. ST1034.2 +019300 CCVS1 SECTION. ST1034.2 +019400 OPEN-FILES. ST1034.2 +019500 OPEN OUTPUT PRINT-FILE. ST1034.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1034.2 +019700 MOVE SPACE TO TEST-RESULTS. ST1034.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1034.2 +019900 GO TO CCVS1-EXIT. ST1034.2 +020000 CLOSE-FILES. ST1034.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1034.2 +020200 TERMINATE-CCVS. ST1034.2 +020300S EXIT PROGRAM. ST1034.2 +020400STERMINATE-CALL. ST1034.2 +020500 STOP RUN. ST1034.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1034.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1034.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1034.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1034.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. ST1034.2 +021100 PRINT-DETAIL. ST1034.2 +021200 IF REC-CT NOT EQUAL TO ZERO ST1034.2 +021300 MOVE "." TO PARDOT-X ST1034.2 +021400 MOVE REC-CT TO DOTVALUE. ST1034.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1034.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1034.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1034.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1034.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1034.2 +022000 MOVE SPACE TO CORRECT-X. ST1034.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1034.2 +022200 MOVE SPACE TO RE-MARK. ST1034.2 +022300 HEAD-ROUTINE. ST1034.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1034.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1034.2 +022800 COLUMN-NAMES-ROUTINE. ST1034.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +023200 END-ROUTINE. ST1034.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1034.2 +023400 END-RTN-EXIT. ST1034.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +023600 END-ROUTINE-1. ST1034.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1034.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1034.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. ST1034.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1034.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1034.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1034.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1034.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1034.2 +024500 END-ROUTINE-12. ST1034.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1034.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1034.2 +024800 MOVE "NO " TO ERROR-TOTAL ST1034.2 +024900 ELSE ST1034.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1034.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1034.2 +025200 PERFORM WRITE-LINE. ST1034.2 +025300 END-ROUTINE-13. ST1034.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1034.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE ST1034.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1034.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1034.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO ST1034.2 +026000 MOVE "NO " TO ERROR-TOTAL ST1034.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1034.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +026500 WRITE-LINE. ST1034.2 +026600 ADD 1 TO RECORD-COUNT. ST1034.2 +026700Y IF RECORD-COUNT GREATER 42 ST1034.2 +026800Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1034.2 +026900Y MOVE SPACE TO DUMMY-RECORD ST1034.2 +027000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1034.2 +027100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1034.2 +027200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1034.2 +027300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1034.2 +027400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1034.2 +027500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027800Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1034.2 +027900Y MOVE ZERO TO RECORD-COUNT. ST1034.2 +028000 PERFORM WRT-LN. ST1034.2 +028100 WRT-LN. ST1034.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1034.2 +028300 MOVE SPACE TO DUMMY-RECORD. ST1034.2 +028400 BLANK-LINE-PRINT. ST1034.2 +028500 PERFORM WRT-LN. ST1034.2 +028600 FAIL-ROUTINE. ST1034.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE ST1034.2 +028800 GO TO FAIL-ROUTINE-WRITE. ST1034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1034.2 +029400 GO TO FAIL-ROUTINE-EX. ST1034.2 +029500 FAIL-ROUTINE-WRITE. ST1034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1034.2 +030000 FAIL-ROUTINE-EX. EXIT. ST1034.2 +030100 BAIL-OUT. ST1034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1034.2 +030400 BAIL-OUT-WRITE. ST1034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1034.2 +030900 BAIL-OUT-EX. EXIT. ST1034.2 +031000 CCVS1-EXIT. ST1034.2 +031100 EXIT. ST1034.2 +031200 SECT-ST103-0001 SECTION. ST1034.2 +031300 ST103-0001-01. ST1034.2 +031400 OPEN INPUT SORTIN-1C. ST1034.2 +031500 MOVE "THIS PROGRAM TESTS THE" TO RE-MARK. ST1034.2 +031600 PERFORM PRINT-DETAIL. ST1034.2 +031700 MOVE "OUTPUT GENERATED BY ST102," TO RE-MARK. ST1034.2 +031800 PERFORM PRINT-DETAIL. ST1034.2 +031900 MOVE "WHICH WAS IN TURN GENERATED" TO RE-MARK. ST1034.2 +032000 PERFORM PRINT-DETAIL. ST1034.2 +032100 MOVE "IN ST101." TO RE-MARK. ST1034.2 +032200 PERFORM PRINT-DETAIL. ST1034.2 +032300 MOVE "SORT - USING, GIVING" TO FEATURE. ST1034.2 +032400 SORT-TEST-1. ST1034.2 +032500 PERFORM READ-SORTED-FILE. ST1034.2 +032600 IF KEYS-GROUP EQUAL TO 900009000000000 ST1034.2 +032700 PERFORM PASS GO TO SORT-WRITE-1. ST1034.2 +032800 GO TO SORT-FAIL-1. ST1034.2 +032900 SORT-DELETE-1. ST1034.2 +033000 PERFORM DE-LETE. ST1034.2 +033100 GO TO SORT-WRITE-1. ST1034.2 +033200 SORT-FAIL-1. ST1034.2 +033300 PERFORM FAIL. ST1034.2 +033400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +033500 MOVE 900009000000000 TO CORRECT-18V0. ST1034.2 +033600 SORT-WRITE-1. ST1034.2 +033700 MOVE "SORT-TEST-1" TO PAR-NAME. ST1034.2 +033800 PERFORM PRINT-DETAIL. ST1034.2 +033900 SORT-TEST-2. ST1034.2 +034000 PERFORM READ-SORTED-FILE. ST1034.2 +034100 IF KEYS-GROUP EQUAL TO 900008000000000 ST1034.2 +034200 PERFORM PASS GO TO SORT-WRITE-2. ST1034.2 +034300 GO TO SORT-FAIL-2. ST1034.2 +034400 SORT-DELETE-2. ST1034.2 +034500 PERFORM DE-LETE. ST1034.2 +034600 GO TO SORT-WRITE-2. ST1034.2 +034700 SORT-FAIL-2. ST1034.2 +034800 PERFORM FAIL. ST1034.2 +034900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +035000 MOVE 900008000000000 TO CORRECT-18V0. ST1034.2 +035100 SORT-WRITE-2. ST1034.2 +035200 MOVE "SORT-TEST-2" TO PAR-NAME. ST1034.2 +035300 PERFORM PRINT-DETAIL. ST1034.2 +035400 SORT-TEST-3. ST1034.2 +035500 PERFORM READ-SORTED-FILE. ST1034.2 +035600 IF KEYS-GROUP EQUAL TO 201002000100001 ST1034.2 +035700 PERFORM PASS GO TO SORT-WRITE-3. ST1034.2 +035800 GO TO SORT-FAIL-3. ST1034.2 +035900 SORT-DELETE-3. ST1034.2 +036000 PERFORM DE-LETE. ST1034.2 +036100 GO TO SORT-WRITE-3. ST1034.2 +036200 SORT-FAIL-3. ST1034.2 +036300 PERFORM FAIL. ST1034.2 +036400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +036500 MOVE 201002000100001 TO CORRECT-18V0. ST1034.2 +036600 SORT-WRITE-3. ST1034.2 +036700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1034.2 +036800 PERFORM PRINT-DETAIL. ST1034.2 +036900 SORT-TEST-4. ST1034.2 +037000 PERFORM READ-SORTED-FILE 48 TIMES. ST1034.2 +037100 IF KEYS-GROUP EQUAL TO 101002000100001 ST1034.2 +037200 PERFORM PASS GO TO SORT-WRITE-4. ST1034.2 +037300 GO TO SORT-FAIL-4. ST1034.2 +037400 SORT-DELETE-4. ST1034.2 +037500 PERFORM DE-LETE. ST1034.2 +037600 GO TO SORT-WRITE-4. ST1034.2 +037700 SORT-FAIL-4. ST1034.2 +037800 PERFORM FAIL. ST1034.2 +037900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +038000 MOVE 101002000100001 TO CORRECT-18V0. ST1034.2 +038100 SORT-WRITE-4. ST1034.2 +038200 MOVE "SORT-TEST-4" TO PAR-NAME. ST1034.2 +038300 PERFORM PRINT-DETAIL. ST1034.2 +038400 SORT-TEST-5. ST1034.2 +038500 PERFORM READ-SORTED-FILE 40 TIMES. ST1034.2 +038600 IF KEYS-GROUP EQUAL TO 106002000100001 ST1034.2 +038700 PERFORM PASS GO TO SORT-WRITE-5. ST1034.2 +038800 GO TO SORT-FAIL-5. ST1034.2 +038900 SORT-DELETE-5. ST1034.2 +039000 PERFORM DE-LETE. ST1034.2 +039100 GO TO SORT-WRITE-5. ST1034.2 +039200 SORT-FAIL-5. ST1034.2 +039300 PERFORM FAIL. ST1034.2 +039400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +039500 MOVE 106002000100001 TO CORRECT-18V0. ST1034.2 +039600 SORT-WRITE-5. ST1034.2 +039700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1034.2 +039800 PERFORM PRINT-DETAIL. ST1034.2 +039900 SORT-TEST-6. ST1034.2 +040000 PERFORM READ-SORTED-FILE 7 TIMES. ST1034.2 +040100 IF KEYS-GROUP EQUAL TO 106001000200002 ST1034.2 +040200 PERFORM PASS GO TO SORT-WRITE-6. ST1034.2 +040300 GO TO SORT-FAIL-6. ST1034.2 +040400 SORT-DELETE-6. ST1034.2 +040500 PERFORM DE-LETE. ST1034.2 +040600 GO TO SORT-WRITE-6. ST1034.2 +040700 SORT-FAIL-6. ST1034.2 +040800 PERFORM FAIL. ST1034.2 +040900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +041000 MOVE 106001000200002 TO CORRECT-18V0. ST1034.2 +041100 SORT-WRITE-6. ST1034.2 +041200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1034.2 +041300 PERFORM PRINT-DETAIL. ST1034.2 +041400 SORT-TEST-7. ST1034.2 +041500 PERFORM READ-SORTED-FILE. ST1034.2 +041600 IF KEYS-GROUP EQUAL TO 009000000900008 ST1034.2 +041700 PERFORM PASS GO TO SORT-WRITE-7. ST1034.2 +041800 GO TO SORT-FAIL-7. ST1034.2 +041900 SORT-DELETE-7. ST1034.2 +042000 PERFORM DE-LETE. ST1034.2 +042100 GO TO SORT-WRITE-7. ST1034.2 +042200 SORT-FAIL-7. ST1034.2 +042300 PERFORM FAIL. ST1034.2 +042400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +042500 MOVE 009000000900008 TO CORRECT-18V0. ST1034.2 +042600 SORT-WRITE-7. ST1034.2 +042700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1034.2 +042800 PERFORM PRINT-DETAIL. ST1034.2 +042900 SORT-TEST-8. ST1034.2 +043000 PERFORM READ-SORTED-FILE. ST1034.2 +043100 IF KEYS-GROUP EQUAL TO 009000000900009 ST1034.2 +043200 PERFORM PASS GO TO SORT-WRITE-8. ST1034.2 +043300 GO TO SORT-FAIL-8. ST1034.2 +043400 SORT-DELETE-8. ST1034.2 +043500 PERFORM DE-LETE. ST1034.2 +043600 GO TO SORT-WRITE-8. ST1034.2 +043700 SORT-FAIL-8. ST1034.2 +043800 PERFORM FAIL. ST1034.2 +043900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +044000 MOVE 009000000900009 TO CORRECT-18V0. ST1034.2 +044100 SORT-WRITE-8. ST1034.2 +044200 MOVE "SORT-TEST-8" TO PAR-NAME. ST1034.2 +044300 PERFORM PRINT-DETAIL. ST1034.2 +044400 SORT-TEST-9. ST1034.2 +044500 READ SORTIN-1C AT END ST1034.2 +044600 PERFORM PASS GO TO SORT-WRITE-9. ST1034.2 +044700* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. ST1034.2 +044800 PERFORM FAIL. ST1034.2 +044900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +045000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1034.2 +045100 GO TO SORT-WRITE-9. ST1034.2 +045200 SORT-DELETE-9. ST1034.2 +045300 PERFORM DE-LETE. ST1034.2 +045400 SORT-WRITE-9. ST1034.2 +045500 MOVE "SORT-TEST-9" TO PAR-NAME. ST1034.2 +045600 PERFORM PRINT-DETAIL. ST1034.2 +045700 CLOSE SORTIN-1C. ST1034.2 +045800 GO TO CCVS-EXIT. ST1034.2 +045900 READ-SORTED-FILE. ST1034.2 +046000 READ SORTIN-1C AT END GO TO BAD-FILE. ST1034.2 +046100 BAD-FILE. ST1034.2 +046200 PERFORM FAIL. ST1034.2 +046300 MOVE "BAD-FILE" TO PAR-NAME. ST1034.2 +046400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1034.2 +046500 PERFORM PRINT-DETAIL. ST1034.2 +046600 MOVE SPACE TO FEATURE. ST1034.2 +046700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1034.2 +046800 PERFORM PRINT-DETAIL. ST1034.2 +046900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1034.2 +047000 PERFORM PRINT-DETAIL. ST1034.2 +047100 CCVS-EXIT SECTION. ST1034.2 +047200 CCVS-999999. ST1034.2 +047300 GO TO CLOSE-FILES. ST1034.2 +*END-OF,ST103A +*HEADER,COBOL,ST104A +000100 IDENTIFICATION DIVISION. ST1044.2 +000200 PROGRAM-ID. ST1044.2 +000300 ST104A. ST1044.2 +000400**************************************************************** ST1044.2 +000500* * ST1044.2 +000600* VALIDATION FOR:- * ST1044.2 +000700* * ST1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +000900* * ST1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1044.2 +001100* * ST1044.2 +001200**************************************************************** ST1044.2 +001300* * ST1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1044.2 +001500* * ST1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1044.2 +001900* * ST1044.2 +002000**************************************************************** ST1044.2 +002100 ENVIRONMENT DIVISION. ST1044.2 +002200 CONFIGURATION SECTION. ST1044.2 +002300 SOURCE-COMPUTER. ST1044.2 +002400 XXXXX082. ST1044.2 +002500 OBJECT-COMPUTER. ST1044.2 +002600 XXXXX083. ST1044.2 +002700 INPUT-OUTPUT SECTION. ST1044.2 +002800 FILE-CONTROL. ST1044.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1044.2 +003000 XXXXX055. ST1044.2 +003100 SELECT SORTOUT-1D ASSIGN TO ST1044.2 +003200 XXXXP001. ST1044.2 +003300 DATA DIVISION. ST1044.2 +003400 FILE SECTION. ST1044.2 +003500 FD PRINT-FILE. ST1044.2 +003600 01 PRINT-REC PICTURE X(120). ST1044.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1044.2 +003800 FD SORTOUT-1D ST1044.2 +003900 LABEL RECORDS STANDARD ST1044.2 +004000C VALUE OF ST1044.2 +004100C XXXXX074 ST1044.2 +004200C IS ST1044.2 +004300C XXXXX075 ST1044.2 +004400G XXXXX069 ST1044.2 +004500 DATA RECORD IS SORTOUT-REC. ST1044.2 +004600 01 SORTOUT-REC. ST1044.2 +004700 02 KEY-ITEM PICTURE S999V999. ST1044.2 +004800 02 NON-KEY-ITEM PICTURE S9(12). ST1044.2 +004900 WORKING-STORAGE SECTION. ST1044.2 +005000 77 U-TILITY PICTURE 999V999 VALUE ZERO. ST1044.2 +005100 77 UTIL-SW PICTURE 9 VALUE ZERO. ST1044.2 +005200 77 WRITE-COUNTER PICTURE 999 VALUE ZERO. ST1044.2 +005300 01 TEST-RESULTS. ST1044.2 +005400 02 FILLER PIC X VALUE SPACE. ST1044.2 +005500 02 FEATURE PIC X(20) VALUE SPACE. ST1044.2 +005600 02 FILLER PIC X VALUE SPACE. ST1044.2 +005700 02 P-OR-F PIC X(5) VALUE SPACE. ST1044.2 +005800 02 FILLER PIC X VALUE SPACE. ST1044.2 +005900 02 PAR-NAME. ST1044.2 +006000 03 FILLER PIC X(19) VALUE SPACE. ST1044.2 +006100 03 PARDOT-X PIC X VALUE SPACE. ST1044.2 +006200 03 DOTVALUE PIC 99 VALUE ZERO. ST1044.2 +006300 02 FILLER PIC X(8) VALUE SPACE. ST1044.2 +006400 02 RE-MARK PIC X(61). ST1044.2 +006500 01 TEST-COMPUTED. ST1044.2 +006600 02 FILLER PIC X(30) VALUE SPACE. ST1044.2 +006700 02 FILLER PIC X(17) VALUE ST1044.2 +006800 " COMPUTED=". ST1044.2 +006900 02 COMPUTED-X. ST1044.2 +007000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1044.2 +007100 03 COMPUTED-N REDEFINES COMPUTED-A ST1044.2 +007200 PIC -9(9).9(9). ST1044.2 +007300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1044.2 +007400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1044.2 +007500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1044.2 +007600 03 CM-18V0 REDEFINES COMPUTED-A. ST1044.2 +007700 04 COMPUTED-18V0 PIC -9(18). ST1044.2 +007800 04 FILLER PIC X. ST1044.2 +007900 03 FILLER PIC X(50) VALUE SPACE. ST1044.2 +008000 01 TEST-CORRECT. ST1044.2 +008100 02 FILLER PIC X(30) VALUE SPACE. ST1044.2 +008200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1044.2 +008300 02 CORRECT-X. ST1044.2 +008400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1044.2 +008500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1044.2 +008600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1044.2 +008700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1044.2 +008800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1044.2 +008900 03 CR-18V0 REDEFINES CORRECT-A. ST1044.2 +009000 04 CORRECT-18V0 PIC -9(18). ST1044.2 +009100 04 FILLER PIC X. ST1044.2 +009200 03 FILLER PIC X(2) VALUE SPACE. ST1044.2 +009300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1044.2 +009400 01 CCVS-C-1. ST1044.2 +009500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1044.2 +009600- "SS PARAGRAPH-NAME ST1044.2 +009700- " REMARKS". ST1044.2 +009800 02 FILLER PIC X(20) VALUE SPACE. ST1044.2 +009900 01 CCVS-C-2. ST1044.2 +010000 02 FILLER PIC X VALUE SPACE. ST1044.2 +010100 02 FILLER PIC X(6) VALUE "TESTED". ST1044.2 +010200 02 FILLER PIC X(15) VALUE SPACE. ST1044.2 +010300 02 FILLER PIC X(4) VALUE "FAIL". ST1044.2 +010400 02 FILLER PIC X(94) VALUE SPACE. ST1044.2 +010500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1044.2 +010600 01 REC-CT PIC 99 VALUE ZERO. ST1044.2 +010700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1044.2 +010800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1044.2 +010900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1044.2 +011000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1044.2 +011100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1044.2 +011200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1044.2 +011300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1044.2 +011400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1044.2 +011500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1044.2 +011600 01 CCVS-H-1. ST1044.2 +011700 02 FILLER PIC X(39) VALUE SPACES. ST1044.2 +011800 02 FILLER PIC X(42) VALUE ST1044.2 +011900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1044.2 +012000 02 FILLER PIC X(39) VALUE SPACES. ST1044.2 +012100 01 CCVS-H-2A. ST1044.2 +012200 02 FILLER PIC X(40) VALUE SPACE. ST1044.2 +012300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1044.2 +012400 02 FILLER PIC XXXX VALUE ST1044.2 +012500 "4.2 ". ST1044.2 +012600 02 FILLER PIC X(28) VALUE ST1044.2 +012700 " COPY - NOT FOR DISTRIBUTION". ST1044.2 +012800 02 FILLER PIC X(41) VALUE SPACE. ST1044.2 +012900 ST1044.2 +013000 01 CCVS-H-2B. ST1044.2 +013100 02 FILLER PIC X(15) VALUE ST1044.2 +013200 "TEST RESULT OF ". ST1044.2 +013300 02 TEST-ID PIC X(9). ST1044.2 +013400 02 FILLER PIC X(4) VALUE ST1044.2 +013500 " IN ". ST1044.2 +013600 02 FILLER PIC X(12) VALUE ST1044.2 +013700 " HIGH ". ST1044.2 +013800 02 FILLER PIC X(22) VALUE ST1044.2 +013900 " LEVEL VALIDATION FOR ". ST1044.2 +014000 02 FILLER PIC X(58) VALUE ST1044.2 +014100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +014200 01 CCVS-H-3. ST1044.2 +014300 02 FILLER PIC X(34) VALUE ST1044.2 +014400 " FOR OFFICIAL USE ONLY ". ST1044.2 +014500 02 FILLER PIC X(58) VALUE ST1044.2 +014600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1044.2 +014700 02 FILLER PIC X(28) VALUE ST1044.2 +014800 " COPYRIGHT 1985 ". ST1044.2 +014900 01 CCVS-E-1. ST1044.2 +015000 02 FILLER PIC X(52) VALUE SPACE. ST1044.2 +015100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1044.2 +015200 02 ID-AGAIN PIC X(9). ST1044.2 +015300 02 FILLER PIC X(45) VALUE SPACES. ST1044.2 +015400 01 CCVS-E-2. ST1044.2 +015500 02 FILLER PIC X(31) VALUE SPACE. ST1044.2 +015600 02 FILLER PIC X(21) VALUE SPACE. ST1044.2 +015700 02 CCVS-E-2-2. ST1044.2 +015800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1044.2 +015900 03 FILLER PIC X VALUE SPACE. ST1044.2 +016000 03 ENDER-DESC PIC X(44) VALUE ST1044.2 +016100 "ERRORS ENCOUNTERED". ST1044.2 +016200 01 CCVS-E-3. ST1044.2 +016300 02 FILLER PIC X(22) VALUE ST1044.2 +016400 " FOR OFFICIAL USE ONLY". ST1044.2 +016500 02 FILLER PIC X(12) VALUE SPACE. ST1044.2 +016600 02 FILLER PIC X(58) VALUE ST1044.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +016800 02 FILLER PIC X(13) VALUE SPACE. ST1044.2 +016900 02 FILLER PIC X(15) VALUE ST1044.2 +017000 " COPYRIGHT 1985". ST1044.2 +017100 01 CCVS-E-4. ST1044.2 +017200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1044.2 +017300 02 FILLER PIC X(4) VALUE " OF ". ST1044.2 +017400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1044.2 +017500 02 FILLER PIC X(40) VALUE ST1044.2 +017600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1044.2 +017700 01 XXINFO. ST1044.2 +017800 02 FILLER PIC X(19) VALUE ST1044.2 +017900 "*** INFORMATION ***". ST1044.2 +018000 02 INFO-TEXT. ST1044.2 +018100 04 FILLER PIC X(8) VALUE SPACE. ST1044.2 +018200 04 XXCOMPUTED PIC X(20). ST1044.2 +018300 04 FILLER PIC X(5) VALUE SPACE. ST1044.2 +018400 04 XXCORRECT PIC X(20). ST1044.2 +018500 02 INF-ANSI-REFERENCE PIC X(48). ST1044.2 +018600 01 HYPHEN-LINE. ST1044.2 +018700 02 FILLER PIC IS X VALUE IS SPACE. ST1044.2 +018800 02 FILLER PIC IS X(65) VALUE IS "************************ST1044.2 +018900- "*****************************************". ST1044.2 +019000 02 FILLER PIC IS X(54) VALUE IS "************************ST1044.2 +019100- "******************************". ST1044.2 +019200 01 CCVS-PGM-ID PIC X(9) VALUE ST1044.2 +019300 "ST104A". ST1044.2 +019400 PROCEDURE DIVISION. ST1044.2 +019500 CCVS1 SECTION. ST1044.2 +019600 OPEN-FILES. ST1044.2 +019700 OPEN OUTPUT PRINT-FILE. ST1044.2 +019800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1044.2 +019900 MOVE SPACE TO TEST-RESULTS. ST1044.2 +020000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1044.2 +020100 GO TO CCVS1-EXIT. ST1044.2 +020200 CLOSE-FILES. ST1044.2 +020300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1044.2 +020400 TERMINATE-CCVS. ST1044.2 +020500S EXIT PROGRAM. ST1044.2 +020600STERMINATE-CALL. ST1044.2 +020700 STOP RUN. ST1044.2 +020800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1044.2 +020900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1044.2 +021000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1044.2 +021100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1044.2 +021200 MOVE "****TEST DELETED****" TO RE-MARK. ST1044.2 +021300 PRINT-DETAIL. ST1044.2 +021400 IF REC-CT NOT EQUAL TO ZERO ST1044.2 +021500 MOVE "." TO PARDOT-X ST1044.2 +021600 MOVE REC-CT TO DOTVALUE. ST1044.2 +021700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1044.2 +021800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1044.2 +021900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1044.2 +022000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1044.2 +022100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1044.2 +022200 MOVE SPACE TO CORRECT-X. ST1044.2 +022300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1044.2 +022400 MOVE SPACE TO RE-MARK. ST1044.2 +022500 HEAD-ROUTINE. ST1044.2 +022600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +022700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +022800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1044.2 +022900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1044.2 +023000 COLUMN-NAMES-ROUTINE. ST1044.2 +023100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +023200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +023400 END-ROUTINE. ST1044.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1044.2 +023600 END-RTN-EXIT. ST1044.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +023800 END-ROUTINE-1. ST1044.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1044.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1044.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. ST1044.2 +024200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1044.2 +024300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1044.2 +024400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1044.2 +024500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1044.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1044.2 +024700 END-ROUTINE-12. ST1044.2 +024800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1044.2 +024900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1044.2 +025000 MOVE "NO " TO ERROR-TOTAL ST1044.2 +025100 ELSE ST1044.2 +025200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1044.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1044.2 +025400 PERFORM WRITE-LINE. ST1044.2 +025500 END-ROUTINE-13. ST1044.2 +025600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1044.2 +025700 MOVE "NO " TO ERROR-TOTAL ELSE ST1044.2 +025800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1044.2 +025900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1044.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026100 IF INSPECT-COUNTER EQUAL TO ZERO ST1044.2 +026200 MOVE "NO " TO ERROR-TOTAL ST1044.2 +026300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1044.2 +026400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1044.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026700 WRITE-LINE. ST1044.2 +026800 ADD 1 TO RECORD-COUNT. ST1044.2 +026900Y IF RECORD-COUNT GREATER 42 ST1044.2 +027000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1044.2 +027100Y MOVE SPACE TO DUMMY-RECORD ST1044.2 +027200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1044.2 +027300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1044.2 +027400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1044.2 +027500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1044.2 +027600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1044.2 +027700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +027800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +027900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +028000Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1044.2 +028100Y MOVE ZERO TO RECORD-COUNT. ST1044.2 +028200 PERFORM WRT-LN. ST1044.2 +028300 WRT-LN. ST1044.2 +028400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1044.2 +028500 MOVE SPACE TO DUMMY-RECORD. ST1044.2 +028600 BLANK-LINE-PRINT. ST1044.2 +028700 PERFORM WRT-LN. ST1044.2 +028800 FAIL-ROUTINE. ST1044.2 +028900 IF COMPUTED-X NOT EQUAL TO SPACE ST1044.2 +029000 GO TO FAIL-ROUTINE-WRITE. ST1044.2 +029100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1044.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1044.2 +029300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1044.2 +029400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +029500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1044.2 +029600 GO TO FAIL-ROUTINE-EX. ST1044.2 +029700 FAIL-ROUTINE-WRITE. ST1044.2 +029800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1044.2 +029900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1044.2 +030000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1044.2 +030100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1044.2 +030200 FAIL-ROUTINE-EX. EXIT. ST1044.2 +030300 BAIL-OUT. ST1044.2 +030400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1044.2 +030500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1044.2 +030600 BAIL-OUT-WRITE. ST1044.2 +030700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1044.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1044.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1044.2 +031100 BAIL-OUT-EX. EXIT. ST1044.2 +031200 CCVS1-EXIT. ST1044.2 +031300 EXIT. ST1044.2 +031400 SECT-ST104-0001 SECTION. ST1044.2 +031500 ST104-0001-01. ST1044.2 +031600 OPEN OUTPUT SORTOUT-1D. ST1044.2 +031700 BUILD-FILE. ST1044.2 +031800 MOVE +987654321078 TO NON-KEY-ITEM. ST1044.2 +031900 MOVE U-TILITY TO KEY-ITEM. ST1044.2 +032000 IF U-TILITY GREATER THAN 214.200 ST1044.2 +032100 MOVE 1 TO UTIL-SW. ST1044.2 +032200 WRITE SORTOUT-REC. ST1044.2 +032300 ADD 1 TO WRITE-COUNTER ON SIZE ERROR ST1044.2 +032400 MOVE "SIZE ERROR ENCOUNTERED" TO RE-MARK ST1044.2 +032500 GO TO BUILD-FILE-FAIL. ST1044.2 +032600 IF UTIL-SW EQUAL TO 1 ST1044.2 +032700 SUBTRACT 002.142 FROM U-TILITY ST1044.2 +032800 ELSE ST1044.2 +032900 ADD 002.142 TO U-TILITY. ST1044.2 +033000 IF U-TILITY NOT EQUAL TO ZERO ST1044.2 +033100 GO TO BUILD-FILE. ST1044.2 +033200 MOVE +987654321078 TO NON-KEY-ITEM. ST1044.2 +033300 MOVE U-TILITY TO KEY-ITEM. ST1044.2 +033400 WRITE SORTOUT-REC. ST1044.2 +033500 ADD 1 TO WRITE-COUNTER ON SIZE ERROR ST1044.2 +033600 MOVE "SIZE ERROR FOUND" TO RE-MARK ST1044.2 +033700 GO TO BUILD-FILE-FAIL. ST1044.2 +033800 BUILD-FILE-TEST. ST1044.2 +033900 IF WRITE-COUNTER EQUAL TO 203 ST1044.2 +034000 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1044.2 +034100 BUILD-FILE-FAIL. ST1044.2 +034200 MOVE WRITE-COUNTER TO COMPUTED-N. ST1044.2 +034300 MOVE 203 TO CORRECT-N. ST1044.2 +034400 PERFORM FAIL. ST1044.2 +034500 BUILD-FILE-WRITE. ST1044.2 +034600 MOVE "TAPE BEING BUILT" TO FEATURE. ST1044.2 +034700 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1044.2 +034800 PERFORM PRINT-DETAIL. ST1044.2 +034900 CLOSE SORTOUT-1D. ST1044.2 +035000 CCVS-EXIT SECTION. ST1044.2 +035100 CCVS-999999. ST1044.2 +035200 GO TO CLOSE-FILES. ST1044.2 +*END-OF,ST104A +*HEADER,COBOL,ST104A,SUBPRG,ST105A +000100 IDENTIFICATION DIVISION. ST1054.2 +000200 PROGRAM-ID. ST1054.2 +000300 ST105A. ST1054.2 +000400**************************************************************** ST1054.2 +000500* * ST1054.2 +000600* VALIDATION FOR:- * ST1054.2 +000700* * ST1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +000900* * ST1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1054.2 +001100* * ST1054.2 +001200**************************************************************** ST1054.2 +001300* * ST1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1054.2 +001500* * ST1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1054.2 +001900* * ST1054.2 +002000**************************************************************** ST1054.2 +002100* THIS PROGRAM TESTS THE SORT WITH USING AND OUTPUT PROCEDURE. ST1054.2 +002200* SORTIN-1E, THE INPUT FILE, WAS CREATED IN ST104 EXPRESSLY FORST1054.2 +002300* USE IN THIS PROGRAM. EACH RECORD PASSED TO SORTOUT-1E, THE ST1054.2 +002400* OUTPUT FILE, IS CHECKED BY THIS PROGRAM. SORTOUT-1E WILL NOT ST1054.2 +002500* BE USED BY ANY FURTHER PROGRAM. ST1054.2 +002600* RECORDS ARE RETURNED USING THE "RETURN INTO" PHRASE. ST1054.2 +002700* SORTIN-1E CONTAINS 203 RECORDS, ARRANGED SO THAT THE KEYS ST1054.2 +002800* START AT 000.000 AND RISE IN INCREMENTS OF 2.142 UNTIL THEY ST1054.2 +002900* REACH 216.342, AND THEN DESCEND TO 000.000 IN THE SAME ST1054.2 +003000* INCREMENTS. ALL RECORDS CONTAIN THE NUMBER +987654321078 ST1054.2 +003100* IN A NON-KEY AREA. ST1054.2 +003200* SORTOUT-1E WILL BE SORTED IN DESCENDING ORDER. ALL RECORDS ST1054.2 +003300* OCCUR IN IDENTICAL PAIRS EXCEPT THE FIRST ONE. ST1054.2 +003400* ST1054.2 +003500* * * * * * * * * * * * * * * * * * * * * *.ST1054.2 +003600 ST1054.2 +003700 ENVIRONMENT DIVISION. ST1054.2 +003800 CONFIGURATION SECTION. ST1054.2 +003900 SOURCE-COMPUTER. ST1054.2 +004000 XXXXX082. ST1054.2 +004100 OBJECT-COMPUTER. ST1054.2 +004200 XXXXX083. ST1054.2 +004300 INPUT-OUTPUT SECTION. ST1054.2 +004400 FILE-CONTROL. ST1054.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1054.2 +004600 XXXXX055. ST1054.2 +004700 SELECT SORTIN-1E ASSIGN TO ST1054.2 +004800 XXXXD001. ST1054.2 +004900 SELECT SORTOUT-1E ASSIGN TO ST1054.2 +005000 XXXXX002. ST1054.2 +005100 SELECT SORTFILE-1E ASSIGN TO ST1054.2 +005200 XXXXX027. ST1054.2 +005300 DATA DIVISION. ST1054.2 +005400 FILE SECTION. ST1054.2 +005500 FD PRINT-FILE. ST1054.2 +005600 01 PRINT-REC PICTURE X(120). ST1054.2 +005700 01 DUMMY-RECORD PICTURE X(120). ST1054.2 +005800 FD SORTIN-1E ST1054.2 +005900 LABEL RECORDS STANDARD ST1054.2 +006000C VALUE OF ST1054.2 +006100C XXXXX074 ST1054.2 +006200C IS ST1054.2 +006300C XXXXX075 ST1054.2 +006400G XXXXX069 ST1054.2 +006500 DATA RECORD IS SORTIN-REC. ST1054.2 +006600 01 SORTIN-REC. ST1054.2 +006700 02 FILLER PICTURE X(18). ST1054.2 +006800 FD SORTOUT-1E ST1054.2 +006900 LABEL RECORDS STANDARD ST1054.2 +007000C VALUE OF ST1054.2 +007100C XXXXX074 ST1054.2 +007200C IS ST1054.2 +007300C XXXXX076 ST1054.2 +007400G XXXXX069 ST1054.2 +007500 DATA RECORD IS SORTOUT-REC. ST1054.2 +007600 01 SORTOUT-REC. ST1054.2 +007700 02 FILLER PICTURE X(18). ST1054.2 +007800 SD SORTFILE-1E ST1054.2 +007900 DATA RECORD IS GRP-RECORD. ST1054.2 +008000 01 GRP-RECORD. ST1054.2 +008100 02 KEY-ITEM PICTURE S999V999. ST1054.2 +008200 02 NON-KEY-ITEM PICTURE S9(12). ST1054.2 +008300 WORKING-STORAGE SECTION. ST1054.2 +008400 77 U-TILITY PICTURE S999V999 VALUE 216.342. ST1054.2 +008500 77 UTIL-SW PICTURE 9 VALUE ZERO. ST1054.2 +008600 77 RECORD-NUMBER PICTURE 999 VALUE 203. ST1054.2 +008700 77 WRITE-COUNTER PICTURE 999 VALUE ZERO. ST1054.2 +008800 01 FEATURE-BUILDER. ST1054.2 +008900 02 NON PICTURE X(4). ST1054.2 +009000 02 FILLER PICTURE X(13) VALUE "KEY-ITEM NO. ". ST1054.2 +009100 02 EDITED-NUMBER PICTURE ZZ9. ST1054.2 +009200 01 TEST-RESULTS. ST1054.2 +009300 02 FILLER PIC X VALUE SPACE. ST1054.2 +009400 02 FEATURE PIC X(20) VALUE SPACE. ST1054.2 +009500 02 FILLER PIC X VALUE SPACE. ST1054.2 +009600 02 P-OR-F PIC X(5) VALUE SPACE. ST1054.2 +009700 02 FILLER PIC X VALUE SPACE. ST1054.2 +009800 02 PAR-NAME. ST1054.2 +009900 03 FILLER PIC X(19) VALUE SPACE. ST1054.2 +010000 03 PARDOT-X PIC X VALUE SPACE. ST1054.2 +010100 03 DOTVALUE PIC 99 VALUE ZERO. ST1054.2 +010200 02 FILLER PIC X(8) VALUE SPACE. ST1054.2 +010300 02 RE-MARK PIC X(61). ST1054.2 +010400 01 TEST-COMPUTED. ST1054.2 +010500 02 FILLER PIC X(30) VALUE SPACE. ST1054.2 +010600 02 FILLER PIC X(17) VALUE ST1054.2 +010700 " COMPUTED=". ST1054.2 +010800 02 COMPUTED-X. ST1054.2 +010900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1054.2 +011000 03 COMPUTED-N REDEFINES COMPUTED-A ST1054.2 +011100 PIC -9(9).9(9). ST1054.2 +011200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1054.2 +011300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1054.2 +011400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1054.2 +011500 03 CM-18V0 REDEFINES COMPUTED-A. ST1054.2 +011600 04 COMPUTED-18V0 PIC -9(18). ST1054.2 +011700 04 FILLER PIC X. ST1054.2 +011800 03 FILLER PIC X(50) VALUE SPACE. ST1054.2 +011900 01 TEST-CORRECT. ST1054.2 +012000 02 FILLER PIC X(30) VALUE SPACE. ST1054.2 +012100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1054.2 +012200 02 CORRECT-X. ST1054.2 +012300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1054.2 +012400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1054.2 +012500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1054.2 +012600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1054.2 +012700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1054.2 +012800 03 CR-18V0 REDEFINES CORRECT-A. ST1054.2 +012900 04 CORRECT-18V0 PIC -9(18). ST1054.2 +013000 04 FILLER PIC X. ST1054.2 +013100 03 FILLER PIC X(2) VALUE SPACE. ST1054.2 +013200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1054.2 +013300 01 CCVS-C-1. ST1054.2 +013400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1054.2 +013500- "SS PARAGRAPH-NAME ST1054.2 +013600- " REMARKS". ST1054.2 +013700 02 FILLER PIC X(20) VALUE SPACE. ST1054.2 +013800 01 CCVS-C-2. ST1054.2 +013900 02 FILLER PIC X VALUE SPACE. ST1054.2 +014000 02 FILLER PIC X(6) VALUE "TESTED". ST1054.2 +014100 02 FILLER PIC X(15) VALUE SPACE. ST1054.2 +014200 02 FILLER PIC X(4) VALUE "FAIL". ST1054.2 +014300 02 FILLER PIC X(94) VALUE SPACE. ST1054.2 +014400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1054.2 +014500 01 REC-CT PIC 99 VALUE ZERO. ST1054.2 +014600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1054.2 +015000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1054.2 +015100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1054.2 +015200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1054.2 +015300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1054.2 +015400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1054.2 +015500 01 CCVS-H-1. ST1054.2 +015600 02 FILLER PIC X(39) VALUE SPACES. ST1054.2 +015700 02 FILLER PIC X(42) VALUE ST1054.2 +015800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1054.2 +015900 02 FILLER PIC X(39) VALUE SPACES. ST1054.2 +016000 01 CCVS-H-2A. ST1054.2 +016100 02 FILLER PIC X(40) VALUE SPACE. ST1054.2 +016200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1054.2 +016300 02 FILLER PIC XXXX VALUE ST1054.2 +016400 "4.2 ". ST1054.2 +016500 02 FILLER PIC X(28) VALUE ST1054.2 +016600 " COPY - NOT FOR DISTRIBUTION". ST1054.2 +016700 02 FILLER PIC X(41) VALUE SPACE. ST1054.2 +016800 ST1054.2 +016900 01 CCVS-H-2B. ST1054.2 +017000 02 FILLER PIC X(15) VALUE ST1054.2 +017100 "TEST RESULT OF ". ST1054.2 +017200 02 TEST-ID PIC X(9). ST1054.2 +017300 02 FILLER PIC X(4) VALUE ST1054.2 +017400 " IN ". ST1054.2 +017500 02 FILLER PIC X(12) VALUE ST1054.2 +017600 " HIGH ". ST1054.2 +017700 02 FILLER PIC X(22) VALUE ST1054.2 +017800 " LEVEL VALIDATION FOR ". ST1054.2 +017900 02 FILLER PIC X(58) VALUE ST1054.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +018100 01 CCVS-H-3. ST1054.2 +018200 02 FILLER PIC X(34) VALUE ST1054.2 +018300 " FOR OFFICIAL USE ONLY ". ST1054.2 +018400 02 FILLER PIC X(58) VALUE ST1054.2 +018500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1054.2 +018600 02 FILLER PIC X(28) VALUE ST1054.2 +018700 " COPYRIGHT 1985 ". ST1054.2 +018800 01 CCVS-E-1. ST1054.2 +018900 02 FILLER PIC X(52) VALUE SPACE. ST1054.2 +019000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1054.2 +019100 02 ID-AGAIN PIC X(9). ST1054.2 +019200 02 FILLER PIC X(45) VALUE SPACES. ST1054.2 +019300 01 CCVS-E-2. ST1054.2 +019400 02 FILLER PIC X(31) VALUE SPACE. ST1054.2 +019500 02 FILLER PIC X(21) VALUE SPACE. ST1054.2 +019600 02 CCVS-E-2-2. ST1054.2 +019700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1054.2 +019800 03 FILLER PIC X VALUE SPACE. ST1054.2 +019900 03 ENDER-DESC PIC X(44) VALUE ST1054.2 +020000 "ERRORS ENCOUNTERED". ST1054.2 +020100 01 CCVS-E-3. ST1054.2 +020200 02 FILLER PIC X(22) VALUE ST1054.2 +020300 " FOR OFFICIAL USE ONLY". ST1054.2 +020400 02 FILLER PIC X(12) VALUE SPACE. ST1054.2 +020500 02 FILLER PIC X(58) VALUE ST1054.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +020700 02 FILLER PIC X(13) VALUE SPACE. ST1054.2 +020800 02 FILLER PIC X(15) VALUE ST1054.2 +020900 " COPYRIGHT 1985". ST1054.2 +021000 01 CCVS-E-4. ST1054.2 +021100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1054.2 +021200 02 FILLER PIC X(4) VALUE " OF ". ST1054.2 +021300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1054.2 +021400 02 FILLER PIC X(40) VALUE ST1054.2 +021500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1054.2 +021600 01 XXINFO. ST1054.2 +021700 02 FILLER PIC X(19) VALUE ST1054.2 +021800 "*** INFORMATION ***". ST1054.2 +021900 02 INFO-TEXT. ST1054.2 +022000 04 FILLER PIC X(8) VALUE SPACE. ST1054.2 +022100 04 XXCOMPUTED PIC X(20). ST1054.2 +022200 04 FILLER PIC X(5) VALUE SPACE. ST1054.2 +022300 04 XXCORRECT PIC X(20). ST1054.2 +022400 02 INF-ANSI-REFERENCE PIC X(48). ST1054.2 +022500 01 HYPHEN-LINE. ST1054.2 +022600 02 FILLER PIC IS X VALUE IS SPACE. ST1054.2 +022700 02 FILLER PIC IS X(65) VALUE IS "************************ST1054.2 +022800- "*****************************************". ST1054.2 +022900 02 FILLER PIC IS X(54) VALUE IS "************************ST1054.2 +023000- "******************************". ST1054.2 +023100 01 CCVS-PGM-ID PIC X(9) VALUE ST1054.2 +023200 "ST105A". ST1054.2 +023300 PROCEDURE DIVISION. ST1054.2 +023400 SORTPARA SECTION. ST1054.2 +023500 SORT-PARAGRAPH. ST1054.2 +023600 SORT SORTFILE-1E ON ST1054.2 +023700 DESCENDING ST1054.2 +023800 KEY-ITEM ST1054.2 +023900 USING SORTIN-1E ST1054.2 +024000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1054.2 +024100 STOP RUN. ST1054.2 +024200 OUTPROC SECTION. ST1054.2 +024300 OPEN-FILES. ST1054.2 +024400 OPEN OUTPUT PRINT-FILE. ST1054.2 +024500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1054.2 +024600 MOVE SPACE TO TEST-RESULTS. ST1054.2 +024700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1054.2 +024800 GO TO CCVS1-EXIT. ST1054.2 +024900 CLOSE-FILES. ST1054.2 +025000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1054.2 +025100 TERMINATE-CCVS. ST1054.2 +025200S EXIT PROGRAM. ST1054.2 +025300STERMINATE-CALL. ST1054.2 +025400 STOP RUN. ST1054.2 +025500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1054.2 +025600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1054.2 +025700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1054.2 +025800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1054.2 +025900 MOVE "****TEST DELETED****" TO RE-MARK. ST1054.2 +026000 PRINT-DETAIL. ST1054.2 +026100 IF REC-CT NOT EQUAL TO ZERO ST1054.2 +026200 MOVE "." TO PARDOT-X ST1054.2 +026300 MOVE REC-CT TO DOTVALUE. ST1054.2 +026400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1054.2 +026500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1054.2 +026600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1054.2 +026700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1054.2 +026800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1054.2 +026900 MOVE SPACE TO CORRECT-X. ST1054.2 +027000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1054.2 +027100 MOVE SPACE TO RE-MARK. ST1054.2 +027200 HEAD-ROUTINE. ST1054.2 +027300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +027400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +027500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1054.2 +027600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1054.2 +027700 COLUMN-NAMES-ROUTINE. ST1054.2 +027800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +027900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +028000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +028100 END-ROUTINE. ST1054.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1054.2 +028300 END-RTN-EXIT. ST1054.2 +028400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +028500 END-ROUTINE-1. ST1054.2 +028600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1054.2 +028700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1054.2 +028800 ADD PASS-COUNTER TO ERROR-HOLD. ST1054.2 +028900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1054.2 +029000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1054.2 +029100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1054.2 +029200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1054.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1054.2 +029400 END-ROUTINE-12. ST1054.2 +029500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1054.2 +029600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1054.2 +029700 MOVE "NO " TO ERROR-TOTAL ST1054.2 +029800 ELSE ST1054.2 +029900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1054.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1054.2 +030100 PERFORM WRITE-LINE. ST1054.2 +030200 END-ROUTINE-13. ST1054.2 +030300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1054.2 +030400 MOVE "NO " TO ERROR-TOTAL ELSE ST1054.2 +030500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1054.2 +030600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1054.2 +030700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +030800 IF INSPECT-COUNTER EQUAL TO ZERO ST1054.2 +030900 MOVE "NO " TO ERROR-TOTAL ST1054.2 +031000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1054.2 +031100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1054.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +031300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +031400 WRITE-LINE. ST1054.2 +031500 ADD 1 TO RECORD-COUNT. ST1054.2 +031600Y IF RECORD-COUNT GREATER 42 ST1054.2 +031700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1054.2 +031800Y MOVE SPACE TO DUMMY-RECORD ST1054.2 +031900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1054.2 +032000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1054.2 +032100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1054.2 +032200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1054.2 +032300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1054.2 +032400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032700Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1054.2 +032800Y MOVE ZERO TO RECORD-COUNT. ST1054.2 +032900 PERFORM WRT-LN. ST1054.2 +033000 WRT-LN. ST1054.2 +033100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1054.2 +033200 MOVE SPACE TO DUMMY-RECORD. ST1054.2 +033300 BLANK-LINE-PRINT. ST1054.2 +033400 PERFORM WRT-LN. ST1054.2 +033500 FAIL-ROUTINE. ST1054.2 +033600 IF COMPUTED-X NOT EQUAL TO SPACE ST1054.2 +033700 GO TO FAIL-ROUTINE-WRITE. ST1054.2 +033800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1054.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1054.2 +034000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1054.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1054.2 +034300 GO TO FAIL-ROUTINE-EX. ST1054.2 +034400 FAIL-ROUTINE-WRITE. ST1054.2 +034500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1054.2 +034600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1054.2 +034700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1054.2 +034800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1054.2 +034900 FAIL-ROUTINE-EX. EXIT. ST1054.2 +035000 BAIL-OUT. ST1054.2 +035100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1054.2 +035200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1054.2 +035300 BAIL-OUT-WRITE. ST1054.2 +035400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1054.2 +035500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1054.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +035700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1054.2 +035800 BAIL-OUT-EX. EXIT. ST1054.2 +035900 CCVS1-EXIT. ST1054.2 +036000 EXIT. ST1054.2 +036100 ST105-0001-01. ST1054.2 +036200 OPEN OUTPUT SORTOUT-1E. ST1054.2 +036300 MOVE "THIS PROGRAM CHECKS ALL" TO RE-MARK. ST1054.2 +036400 PERFORM PRINT-DETAIL. ST1054.2 +036500 MOVE "203 RECORDS, TWO ITEMS" TO RE-MARK. ST1054.2 +036600 PERFORM PRINT-DETAIL. ST1054.2 +036700 MOVE "PER RECORD." TO RE-MARK. ST1054.2 +036800 PERFORM PRINT-DETAIL. ST1054.2 +036900 MOVE "SORT, USING-OUTPROC" TO FEATURE. ST1054.2 +037000 PERFORM PRINT-DETAIL. ST1054.2 +037100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1054.2 +037200 SORT-TEST-1. ST1054.2 +037300 RETURN SORTFILE-1E INTO SORTOUT-REC ST1054.2 +037400 AT END GO TO OUTPROC-EXIT. ST1054.2 +037500 WRITE SORTOUT-REC. ST1054.2 +037600 IF NON-KEY-ITEM EQUAL TO +987654321078 ST1054.2 +037700 PERFORM PASS-1 ELSE PERFORM FAIL-1. ST1054.2 +037800 IF KEY-ITEM EQUAL TO U-TILITY ST1054.2 +037900 PERFORM PASS-2 ELSE PERFORM FAIL-2. ST1054.2 +038000 SUBTRACT 1 FROM RECORD-NUMBER. ST1054.2 +038100 IF U-TILITY GREATER THAN 214.200 GO TO NEW-PAIR. ST1054.2 +038200 IF UTIL-SW EQUAL TO 1 GO TO NEW-PAIR. ST1054.2 +038300 CONTINUE-PAIR. ST1054.2 +038400 MOVE 1 TO UTIL-SW. ST1054.2 +038500 GO TO SORT-TEST-1. ST1054.2 +038600 NEW-PAIR. ST1054.2 +038700 MOVE 0 TO UTIL-SW. ST1054.2 +038800 SUBTRACT +002.142 FROM U-TILITY. ST1054.2 +038900 GO TO SORT-TEST-1. ST1054.2 +039000 SUP-PORT SECTION. ST1054.2 +039100 PASS-1. ST1054.2 +039200 MOVE "PASS" TO P-OR-F. ST1054.2 +039300 MOVE "NON-" TO NON. ST1054.2 +039400 PERFORM PRINT-FEATURE. ST1054.2 +039500 PERFORM PRINT-DETAIL. ST1054.2 +039600 FAIL-1. ST1054.2 +039700 MOVE "FAIL" TO P-OR-F. ST1054.2 +039800 ADD 1 TO ERROR-COUNTER. ST1054.2 +039900 MOVE "NON-" TO NON. ST1054.2 +040000 MOVE NON-KEY-ITEM TO COMPUTED-18V0. ST1054.2 +040100 MOVE +987654321078 TO CORRECT-18V0. ST1054.2 +040200 PERFORM PRINT-FEATURE. ST1054.2 +040300 PERFORM PRINT-DETAIL. ST1054.2 +040400 PASS-2. ST1054.2 +040500 MOVE SPACE TO NON. ST1054.2 +040600 MOVE "PASS" TO P-OR-F. ST1054.2 +040700 PERFORM PRINT-FEATURE. ST1054.2 +040800 PERFORM PRINT-DETAIL. ST1054.2 +040900 FAIL-2. ST1054.2 +041000 MOVE SPACE TO NON. ST1054.2 +041100 MOVE "FAIL" TO P-OR-F. ST1054.2 +041200 ADD 1 TO ERROR-COUNTER. ST1054.2 +041300 MOVE KEY-ITEM TO COMPUTED-N. ST1054.2 +041400 MOVE U-TILITY TO CORRECT-N. ST1054.2 +041500 PERFORM PRINT-FEATURE. ST1054.2 +041600 PERFORM PRINT-DETAIL. ST1054.2 +041700 PRINT-FEATURE. ST1054.2 +041800 MOVE RECORD-NUMBER TO EDITED-NUMBER. ST1054.2 +041900 MOVE FEATURE-BUILDER TO FEATURE. ST1054.2 +042000 OUTPROC-EXIT SECTION. ST1054.2 +042100 SORT-INIT-A. ST1054.2 +042200 MOVE "LAST SORTED RECORD" TO FEATURE. ST1054.2 +042300 SORT-TEST-2. ST1054.2 +042400 IF U-TILITY EQUAL TO -002.142 ST1054.2 +042500 PERFORM PASS GO TO SORT-WRITE-2. ST1054.2 +042600 SORT-FAIL-2. ST1054.2 +042700 MOVE U-TILITY TO COMPUTED-N. ST1054.2 +042800 MOVE -002.142 TO CORRECT-N. ST1054.2 +042900 PERFORM FAIL. ST1054.2 +043000 SORT-WRITE-2. ST1054.2 +043100 MOVE "SORT-TEST-2" TO PAR-NAME. ST1054.2 +043200 PERFORM PRINT-DETAIL. ST1054.2 +043300 SORT-TEST-3. ST1054.2 +043400 IF UTIL-SW EQUAL TO ZERO ST1054.2 +043500 PERFORM PASS GO TO SORT-WRITE-3. ST1054.2 +043600 SORT-FAIL-3. ST1054.2 +043700 MOVE UTIL-SW TO COMPUTED-N. ST1054.2 +043800 MOVE ZERO TO CORRECT-N. ST1054.2 +043900 MOVE "LAST RECORDS NOT IN PAIRS" TO RE-MARK. ST1054.2 +044000 PERFORM FAIL. ST1054.2 +044100 SORT-WRITE-3. ST1054.2 +044200 MOVE "SORT-TEST-3" TO PAR-NAME. ST1054.2 +044300 PERFORM PRINT-DETAIL. ST1054.2 +044400 CLOSE SORTOUT-1E. ST1054.2 +044500 PERFORM CLOSE-FILES. ST1054.2 +*END-OF,ST105A +*HEADER,COBOL,ST106A +000100 IDENTIFICATION DIVISION. ST1064.2 +000200 PROGRAM-ID. ST1064.2 +000300 ST106A. ST1064.2 +000400**************************************************************** ST1064.2 +000500* * ST1064.2 +000600* VALIDATION FOR:- * ST1064.2 +000700* * ST1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +000900* * ST1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1064.2 +001100* * ST1064.2 +001200**************************************************************** ST1064.2 +001300* * ST1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1064.2 +001500* * ST1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1064.2 +001900* * ST1064.2 +002000**************************************************************** ST1064.2 +002100* ) IS RIGHT PARENTHESIS ST1064.2 +002200* ( IS LEFT PARENTHESIS ST1064.2 +002300* " IS QUOTE ST1064.2 +002400* + IS PLUS ST1064.2 +002500* ST1064.2 +002600* THIS PROGRAM BUILDS A FILE OF NINE RECORDS. EACH RECORD HAS ST1064.2 +002700* THREE KEYS, AND THE VALUES OF THE RECORDS ARE SHOWN BELOW- ST1064.2 +002800* S ST1064.2 +002900* O ST1064.2 +003000* R SORT ST1064.2 +003100* T SORT KEY ST1064.2 +003200* K KEY -2 ST1064.2 +003300* E -1 .. ST1064.2 +003400* Y .. . . ST1064.2 +003500* - . . . . ST1064.2 +003600* 3 . . . . ST1064.2 +003700* .. .. . ST1064.2 +003800* 11111112888888888888888888 ST1064.2 +003900* 11111112999999999999999999 ST1064.2 +004000* 11111112999999999999999999 ST1064.2 +004100* 00000001999999999999999999 ST1064.2 +004200* 000000001999999999999999999 ST1064.2 +004300* 000000001999999999999999999 ST1064.2 +004400* 000000001999999999999999999 ST1064.2 +004500* 000000001999999999999999999 ST1064.2 +004600* 000000001999999999999999999 ST1064.2 +004700* THERE IS AN ASSUMED DECIMAL POINT BETWEEN THE FIRST AND ST1064.2 +004800* SECOND COLUMNS OF SORTKEY-1. ST1064.2 +004900* THIS FILE IS BUILT AND SORTED BY THIS PROGRAM AND THE OUTPUT ST1064.2 +005000* IS PASSED ON TO ST107 FOR CHECKING. ST1064.2 +005100 ST1064.2 +005200 ENVIRONMENT DIVISION. ST1064.2 +005300 CONFIGURATION SECTION. ST1064.2 +005400 SOURCE-COMPUTER. ST1064.2 +005500 XXXXX082. ST1064.2 +005600 OBJECT-COMPUTER. ST1064.2 +005700 XXXXX083. ST1064.2 +005800 INPUT-OUTPUT SECTION. ST1064.2 +005900 FILE-CONTROL. ST1064.2 +006000 SELECT PRINT-FILE ASSIGN TO ST1064.2 +006100 XXXXX055. ST1064.2 +006200 SELECT SORTFILE-1F ASSIGN TO ST1064.2 +006300 XXXXX027. ST1064.2 +006400 SELECT SORTOUT-1F ASSIGN TO ST1064.2 +006500 XXXXP001. ST1064.2 +006600 DATA DIVISION. ST1064.2 +006700 FILE SECTION. ST1064.2 +006800 FD PRINT-FILE. ST1064.2 +006900 01 PRINT-REC PICTURE X(120). ST1064.2 +007000 01 DUMMY-RECORD PICTURE X(120). ST1064.2 +007100 FD SORTOUT-1F ST1064.2 +007200 LABEL RECORDS STANDARD ST1064.2 +007300C VALUE OF ST1064.2 +007400C XXXXX074 ST1064.2 +007500C IS ST1064.2 +007600C XXXXX075 ST1064.2 +007700G XXXXX069 ST1064.2 +007800 RECORD CONTAINS 27 CHARACTERS ST1064.2 +007900 DATA RECORD IS SORTOUT-REC. ST1064.2 +008000 01 SORTOUT-REC. ST1064.2 +008100 02 FILLER PICTURE X(27). ST1064.2 +008200 SD SORTFILE-1F ST1064.2 +008300 RECORD CONTAINS 27 CHARACTERS ST1064.2 +008400 DATA RECORD IS SORT-GROUP. ST1064.2 +008500 01 SORT-GROUP. ST1064.2 +008600 02 SORTKEY-3 PICTURE X. ST1064.2 +008700 02 SORTKEY-1 PICTURE S9V9(7). ST1064.2 +008800 02 SORTKEY-2 PICTURE 9(18). ST1064.2 +008900 WORKING-STORAGE SECTION. ST1064.2 +009000 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1064.2 +009100 77 UTILITY-1 PICTURE S9V9(7) VALUE +1.1111112. ST1064.2 +009200 77 UTILITY-2 PICTURE 9(018) VALUE 888888888888888888. ST1064.2 +009300 77 UTILITY-3 PICTURE X VALUE SPACE. ST1064.2 +009400 01 TEST-RESULTS. ST1064.2 +009500 02 FILLER PIC X VALUE SPACE. ST1064.2 +009600 02 FEATURE PIC X(20) VALUE SPACE. ST1064.2 +009700 02 FILLER PIC X VALUE SPACE. ST1064.2 +009800 02 P-OR-F PIC X(5) VALUE SPACE. ST1064.2 +009900 02 FILLER PIC X VALUE SPACE. ST1064.2 +010000 02 PAR-NAME. ST1064.2 +010100 03 FILLER PIC X(19) VALUE SPACE. ST1064.2 +010200 03 PARDOT-X PIC X VALUE SPACE. ST1064.2 +010300 03 DOTVALUE PIC 99 VALUE ZERO. ST1064.2 +010400 02 FILLER PIC X(8) VALUE SPACE. ST1064.2 +010500 02 RE-MARK PIC X(61). ST1064.2 +010600 01 TEST-COMPUTED. ST1064.2 +010700 02 FILLER PIC X(30) VALUE SPACE. ST1064.2 +010800 02 FILLER PIC X(17) VALUE ST1064.2 +010900 " COMPUTED=". ST1064.2 +011000 02 COMPUTED-X. ST1064.2 +011100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1064.2 +011200 03 COMPUTED-N REDEFINES COMPUTED-A ST1064.2 +011300 PIC -9(9).9(9). ST1064.2 +011400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1064.2 +011500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1064.2 +011600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1064.2 +011700 03 CM-18V0 REDEFINES COMPUTED-A. ST1064.2 +011800 04 COMPUTED-18V0 PIC -9(18). ST1064.2 +011900 04 FILLER PIC X. ST1064.2 +012000 03 FILLER PIC X(50) VALUE SPACE. ST1064.2 +012100 01 TEST-CORRECT. ST1064.2 +012200 02 FILLER PIC X(30) VALUE SPACE. ST1064.2 +012300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1064.2 +012400 02 CORRECT-X. ST1064.2 +012500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1064.2 +012600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1064.2 +012700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1064.2 +012800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1064.2 +012900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1064.2 +013000 03 CR-18V0 REDEFINES CORRECT-A. ST1064.2 +013100 04 CORRECT-18V0 PIC -9(18). ST1064.2 +013200 04 FILLER PIC X. ST1064.2 +013300 03 FILLER PIC X(2) VALUE SPACE. ST1064.2 +013400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1064.2 +013500 01 CCVS-C-1. ST1064.2 +013600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1064.2 +013700- "SS PARAGRAPH-NAME ST1064.2 +013800- " REMARKS". ST1064.2 +013900 02 FILLER PIC X(20) VALUE SPACE. ST1064.2 +014000 01 CCVS-C-2. ST1064.2 +014100 02 FILLER PIC X VALUE SPACE. ST1064.2 +014200 02 FILLER PIC X(6) VALUE "TESTED". ST1064.2 +014300 02 FILLER PIC X(15) VALUE SPACE. ST1064.2 +014400 02 FILLER PIC X(4) VALUE "FAIL". ST1064.2 +014500 02 FILLER PIC X(94) VALUE SPACE. ST1064.2 +014600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1064.2 +014700 01 REC-CT PIC 99 VALUE ZERO. ST1064.2 +014800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1064.2 +014900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1064.2 +015300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1064.2 +015400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1064.2 +015500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1064.2 +015600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1064.2 +015700 01 CCVS-H-1. ST1064.2 +015800 02 FILLER PIC X(39) VALUE SPACES. ST1064.2 +015900 02 FILLER PIC X(42) VALUE ST1064.2 +016000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1064.2 +016100 02 FILLER PIC X(39) VALUE SPACES. ST1064.2 +016200 01 CCVS-H-2A. ST1064.2 +016300 02 FILLER PIC X(40) VALUE SPACE. ST1064.2 +016400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1064.2 +016500 02 FILLER PIC XXXX VALUE ST1064.2 +016600 "4.2 ". ST1064.2 +016700 02 FILLER PIC X(28) VALUE ST1064.2 +016800 " COPY - NOT FOR DISTRIBUTION". ST1064.2 +016900 02 FILLER PIC X(41) VALUE SPACE. ST1064.2 +017000 ST1064.2 +017100 01 CCVS-H-2B. ST1064.2 +017200 02 FILLER PIC X(15) VALUE ST1064.2 +017300 "TEST RESULT OF ". ST1064.2 +017400 02 TEST-ID PIC X(9). ST1064.2 +017500 02 FILLER PIC X(4) VALUE ST1064.2 +017600 " IN ". ST1064.2 +017700 02 FILLER PIC X(12) VALUE ST1064.2 +017800 " HIGH ". ST1064.2 +017900 02 FILLER PIC X(22) VALUE ST1064.2 +018000 " LEVEL VALIDATION FOR ". ST1064.2 +018100 02 FILLER PIC X(58) VALUE ST1064.2 +018200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +018300 01 CCVS-H-3. ST1064.2 +018400 02 FILLER PIC X(34) VALUE ST1064.2 +018500 " FOR OFFICIAL USE ONLY ". ST1064.2 +018600 02 FILLER PIC X(58) VALUE ST1064.2 +018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1064.2 +018800 02 FILLER PIC X(28) VALUE ST1064.2 +018900 " COPYRIGHT 1985 ". ST1064.2 +019000 01 CCVS-E-1. ST1064.2 +019100 02 FILLER PIC X(52) VALUE SPACE. ST1064.2 +019200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1064.2 +019300 02 ID-AGAIN PIC X(9). ST1064.2 +019400 02 FILLER PIC X(45) VALUE SPACES. ST1064.2 +019500 01 CCVS-E-2. ST1064.2 +019600 02 FILLER PIC X(31) VALUE SPACE. ST1064.2 +019700 02 FILLER PIC X(21) VALUE SPACE. ST1064.2 +019800 02 CCVS-E-2-2. ST1064.2 +019900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1064.2 +020000 03 FILLER PIC X VALUE SPACE. ST1064.2 +020100 03 ENDER-DESC PIC X(44) VALUE ST1064.2 +020200 "ERRORS ENCOUNTERED". ST1064.2 +020300 01 CCVS-E-3. ST1064.2 +020400 02 FILLER PIC X(22) VALUE ST1064.2 +020500 " FOR OFFICIAL USE ONLY". ST1064.2 +020600 02 FILLER PIC X(12) VALUE SPACE. ST1064.2 +020700 02 FILLER PIC X(58) VALUE ST1064.2 +020800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +020900 02 FILLER PIC X(13) VALUE SPACE. ST1064.2 +021000 02 FILLER PIC X(15) VALUE ST1064.2 +021100 " COPYRIGHT 1985". ST1064.2 +021200 01 CCVS-E-4. ST1064.2 +021300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1064.2 +021400 02 FILLER PIC X(4) VALUE " OF ". ST1064.2 +021500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1064.2 +021600 02 FILLER PIC X(40) VALUE ST1064.2 +021700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1064.2 +021800 01 XXINFO. ST1064.2 +021900 02 FILLER PIC X(19) VALUE ST1064.2 +022000 "*** INFORMATION ***". ST1064.2 +022100 02 INFO-TEXT. ST1064.2 +022200 04 FILLER PIC X(8) VALUE SPACE. ST1064.2 +022300 04 XXCOMPUTED PIC X(20). ST1064.2 +022400 04 FILLER PIC X(5) VALUE SPACE. ST1064.2 +022500 04 XXCORRECT PIC X(20). ST1064.2 +022600 02 INF-ANSI-REFERENCE PIC X(48). ST1064.2 +022700 01 HYPHEN-LINE. ST1064.2 +022800 02 FILLER PIC IS X VALUE IS SPACE. ST1064.2 +022900 02 FILLER PIC IS X(65) VALUE IS "************************ST1064.2 +023000- "*****************************************". ST1064.2 +023100 02 FILLER PIC IS X(54) VALUE IS "************************ST1064.2 +023200- "******************************". ST1064.2 +023300 01 CCVS-PGM-ID PIC X(9) VALUE ST1064.2 +023400 "ST106A". ST1064.2 +023500 PROCEDURE DIVISION. ST1064.2 +023600 SORTPARA SECTION. ST1064.2 +023700 SORT-PARAGRAPH. ST1064.2 +023800 SORT SORTFILE-1F ON ST1064.2 +023900 ASCENDING SORTKEY-1 ST1064.2 +024000 DESCENDING SORTKEY-2 ST1064.2 +024100 ASCENDING SORTKEY-3 ST1064.2 +024200 INPUT PROCEDURE INPROC THRU INPROC-EXIT ST1064.2 +024300 GIVING SORTOUT-1F. ST1064.2 +024400 STOP RUN. ST1064.2 +024500 INPROC SECTION. ST1064.2 +024600 OPEN-FILES. ST1064.2 +024700 OPEN OUTPUT PRINT-FILE. ST1064.2 +024800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1064.2 +024900 MOVE SPACE TO TEST-RESULTS. ST1064.2 +025000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1064.2 +025100 GO TO CCVS1-EXIT. ST1064.2 +025200 CLOSE-FILES. ST1064.2 +025300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1064.2 +025400 TERMINATE-CCVS. ST1064.2 +025500S EXIT PROGRAM. ST1064.2 +025600STERMINATE-CALL. ST1064.2 +025700 STOP RUN. ST1064.2 +025800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1064.2 +025900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1064.2 +026000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1064.2 +026100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1064.2 +026200 MOVE "****TEST DELETED****" TO RE-MARK. ST1064.2 +026300 PRINT-DETAIL. ST1064.2 +026400 IF REC-CT NOT EQUAL TO ZERO ST1064.2 +026500 MOVE "." TO PARDOT-X ST1064.2 +026600 MOVE REC-CT TO DOTVALUE. ST1064.2 +026700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1064.2 +026800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1064.2 +026900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1064.2 +027000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1064.2 +027100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1064.2 +027200 MOVE SPACE TO CORRECT-X. ST1064.2 +027300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1064.2 +027400 MOVE SPACE TO RE-MARK. ST1064.2 +027500 HEAD-ROUTINE. ST1064.2 +027600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +027700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +027800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1064.2 +027900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1064.2 +028000 COLUMN-NAMES-ROUTINE. ST1064.2 +028100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +028200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +028300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +028400 END-ROUTINE. ST1064.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1064.2 +028600 END-RTN-EXIT. ST1064.2 +028700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +028800 END-ROUTINE-1. ST1064.2 +028900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1064.2 +029000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1064.2 +029100 ADD PASS-COUNTER TO ERROR-HOLD. ST1064.2 +029200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1064.2 +029300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1064.2 +029400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1064.2 +029500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1064.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1064.2 +029700 END-ROUTINE-12. ST1064.2 +029800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1064.2 +029900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1064.2 +030000 MOVE "NO " TO ERROR-TOTAL ST1064.2 +030100 ELSE ST1064.2 +030200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1064.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1064.2 +030400 PERFORM WRITE-LINE. ST1064.2 +030500 END-ROUTINE-13. ST1064.2 +030600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1064.2 +030700 MOVE "NO " TO ERROR-TOTAL ELSE ST1064.2 +030800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1064.2 +030900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1064.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031100 IF INSPECT-COUNTER EQUAL TO ZERO ST1064.2 +031200 MOVE "NO " TO ERROR-TOTAL ST1064.2 +031300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1064.2 +031400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1064.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031700 WRITE-LINE. ST1064.2 +031800 ADD 1 TO RECORD-COUNT. ST1064.2 +031900Y IF RECORD-COUNT GREATER 42 ST1064.2 +032000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1064.2 +032100Y MOVE SPACE TO DUMMY-RECORD ST1064.2 +032200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1064.2 +032300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1064.2 +032400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1064.2 +032500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1064.2 +032600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1064.2 +032700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +032800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +032900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +033000Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1064.2 +033100Y MOVE ZERO TO RECORD-COUNT. ST1064.2 +033200 PERFORM WRT-LN. ST1064.2 +033300 WRT-LN. ST1064.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1064.2 +033500 MOVE SPACE TO DUMMY-RECORD. ST1064.2 +033600 BLANK-LINE-PRINT. ST1064.2 +033700 PERFORM WRT-LN. ST1064.2 +033800 FAIL-ROUTINE. ST1064.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE ST1064.2 +034000 GO TO FAIL-ROUTINE-WRITE. ST1064.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1064.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1064.2 +034300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1064.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1064.2 +034600 GO TO FAIL-ROUTINE-EX. ST1064.2 +034700 FAIL-ROUTINE-WRITE. ST1064.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1064.2 +034900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1064.2 +035000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1064.2 +035100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1064.2 +035200 FAIL-ROUTINE-EX. EXIT. ST1064.2 +035300 BAIL-OUT. ST1064.2 +035400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1064.2 +035500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1064.2 +035600 BAIL-OUT-WRITE. ST1064.2 +035700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1064.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1064.2 +035900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +036000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1064.2 +036100 BAIL-OUT-EX. EXIT. ST1064.2 +036200 CCVS1-EXIT. ST1064.2 +036300 EXIT. ST1064.2 +036400 ST106-0001-01. ST1064.2 +036500 OPEN OUTPUT SORTOUT-1F. ST1064.2 +036600 MOVE "THIS PROGRAM BUILDS AND" TO RE-MARK. ST1064.2 +036700 PERFORM PRINT-DETAIL. ST1064.2 +036800 MOVE "SORTS A FILE AND PASSES" TO RE-MARK. ST1064.2 +036900 PERFORM PRINT-DETAIL. ST1064.2 +037000 MOVE "THE OUTPUT TO ST107." TO RE-MARK. ST1064.2 +037100 PERFORM PRINT-DETAIL. ST1064.2 +037200 BUILD-FILE. ST1064.2 +037300 ADD 1 TO UTIL-CTR ST1064.2 +037400 IF UTIL-CTR EQUAL TO 2 ST1064.2 +037500 MOVE 999999999999999999 TO UTILITY-2. ST1064.2 +037600 IF UTIL-CTR EQUAL TO 4 ST1064.2 +037700 ADD -1.1111111 TO UTILITY-1. ST1064.2 +037800 IF UTIL-CTR EQUAL TO 5 ST1064.2 +037900 MOVE ZERO TO UTILITY-3. ST1064.2 +038000 MOVE UTILITY-1 TO SORTKEY-1. ST1064.2 +038100 MOVE UTILITY-3 TO SORTKEY-3. ST1064.2 +038200 MOVE UTILITY-2 TO SORTKEY-2. ST1064.2 +038300 RELEASE SORT-GROUP. ST1064.2 +038400 IF UTIL-CTR LESS THAN 9 GO TO BUILD-FILE. ST1064.2 +038500 BUILD-FILE-TEST. ST1064.2 +038600 IF UTIL-CTR EQUAL TO 9 ST1064.2 +038700 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1064.2 +038800 BUILD-FILE-FAIL. ST1064.2 +038900 MOVE UTIL-CTR TO COMPUTED-N. ST1064.2 +039000 MOVE 9 TO CORRECT-N. ST1064.2 +039100 PERFORM FAIL. ST1064.2 +039200 BUILD-FILE-WRITE. ST1064.2 +039300 MOVE "CREATE A FILE" TO FEATURE. ST1064.2 +039400 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1064.2 +039500 PERFORM PRINT-DETAIL. ST1064.2 +039600 CLOSE SORTOUT-1F. ST1064.2 +039700 GO TO INPROC-EXIT. ST1064.2 +039800 INPROC-EXIT SECTION. ST1064.2 +039900 EXITPARA. ST1064.2 +040000 PERFORM CLOSE-FILES. ST1064.2 +*END-OF,ST106A +*HEADER,COBOL,ST106A,SUBPRG,ST107A +000100 IDENTIFICATION DIVISION. ST1074.2 +000200 PROGRAM-ID. ST1074.2 +000300 ST107A. ST1074.2 +000400**************************************************************** ST1074.2 +000500* * ST1074.2 +000600* VALIDATION FOR:- * ST1074.2 +000700* * ST1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +000900* * ST1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1074.2 +001100* * ST1074.2 +001200**************************************************************** ST1074.2 +001300* * ST1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1074.2 +001500* * ST1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1074.2 +001900* * ST1074.2 +002000**************************************************************** ST1074.2 +002100 ENVIRONMENT DIVISION. ST1074.2 +002200 CONFIGURATION SECTION. ST1074.2 +002300 SOURCE-COMPUTER. ST1074.2 +002400 XXXXX082. ST1074.2 +002500 OBJECT-COMPUTER. ST1074.2 +002600 XXXXX083. ST1074.2 +002700 INPUT-OUTPUT SECTION. ST1074.2 +002800 FILE-CONTROL. ST1074.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1074.2 +003000 XXXXX055. ST1074.2 +003100 SELECT SORTIN-1G ASSIGN TO ST1074.2 +003200 XXXXD001. ST1074.2 +003300 DATA DIVISION. ST1074.2 +003400 FILE SECTION. ST1074.2 +003500 FD PRINT-FILE. ST1074.2 +003600 01 PRINT-REC PICTURE X(120). ST1074.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1074.2 +003800 FD SORTIN-1G ST1074.2 +003900 LABEL RECORDS STANDARD ST1074.2 +004000C VALUE OF ST1074.2 +004100C XXXXX074 ST1074.2 +004200C IS ST1074.2 +004300C XXXXX075 ST1074.2 +004400G XXXXX069 ST1074.2 +004500 RECORD CONTAINS 27 CHARACTERS. ST1074.2 +004600 01 SORTIN-REC. ST1074.2 +004700 02 SORTKEY-3 PICTURE X. ST1074.2 +004800 02 SORTKEY-1 PICTURE S9V9(7). ST1074.2 +004900 02 SORTKEY-2 PICTURE 9(18). ST1074.2 +005000 WORKING-STORAGE SECTION. ST1074.2 +005100 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1074.2 +005200 77 ITEM-3 PICTURE X(27) VALUE "FIRST OF 3 ITEMS IN RECORD ". ST1074.2 +005300 77 ITEM-1 PICTURE X(27) VALUE " SECOND OF 3 ITEMS ". ST1074.2 +005400 77 ITEM-2 PICTURE X(27) VALUE " THIRD OF 3 ITEMS ". ST1074.2 +005500 77 DUM-MY PICTURE X(27) VALUE "TEST UNNECESSARY - BYPASSED". ST1074.2 +005600 77 ZER-O PICTURE X VALUE "0". ST1074.2 +005700 77 SPAC-E PICTURE X VALUE " ". ST1074.2 +005800 01 UTILITY-KEYS. ST1074.2 +005900 02 UTILITY-3 PICTURE X. ST1074.2 +006000 02 UTILITY-1 PICTURE S9V9(7). ST1074.2 +006100 02 UTILITY-2 PICTURE 9(018). ST1074.2 +006200 01 TEST-RESULTS. ST1074.2 +006300 02 FILLER PIC X VALUE SPACE. ST1074.2 +006400 02 FEATURE PIC X(20) VALUE SPACE. ST1074.2 +006500 02 FILLER PIC X VALUE SPACE. ST1074.2 +006600 02 P-OR-F PIC X(5) VALUE SPACE. ST1074.2 +006700 02 FILLER PIC X VALUE SPACE. ST1074.2 +006800 02 PAR-NAME. ST1074.2 +006900 03 FILLER PIC X(19) VALUE SPACE. ST1074.2 +007000 03 PARDOT-X PIC X VALUE SPACE. ST1074.2 +007100 03 DOTVALUE PIC 99 VALUE ZERO. ST1074.2 +007200 02 FILLER PIC X(8) VALUE SPACE. ST1074.2 +007300 02 RE-MARK PIC X(61). ST1074.2 +007400 01 TEST-COMPUTED. ST1074.2 +007500 02 FILLER PIC X(30) VALUE SPACE. ST1074.2 +007600 02 FILLER PIC X(17) VALUE ST1074.2 +007700 " COMPUTED=". ST1074.2 +007800 02 COMPUTED-X. ST1074.2 +007900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1074.2 +008000 03 COMPUTED-N REDEFINES COMPUTED-A ST1074.2 +008100 PIC -9(9).9(9). ST1074.2 +008200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1074.2 +008300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1074.2 +008400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1074.2 +008500 03 CM-18V0 REDEFINES COMPUTED-A. ST1074.2 +008600 04 COMPUTED-18V0 PIC -9(18). ST1074.2 +008700 04 FILLER PIC X. ST1074.2 +008800 03 FILLER PIC X(50) VALUE SPACE. ST1074.2 +008900 01 TEST-CORRECT. ST1074.2 +009000 02 FILLER PIC X(30) VALUE SPACE. ST1074.2 +009100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1074.2 +009200 02 CORRECT-X. ST1074.2 +009300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1074.2 +009400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1074.2 +009500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1074.2 +009600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1074.2 +009700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1074.2 +009800 03 CR-18V0 REDEFINES CORRECT-A. ST1074.2 +009900 04 CORRECT-18V0 PIC -9(18). ST1074.2 +010000 04 FILLER PIC X. ST1074.2 +010100 03 FILLER PIC X(2) VALUE SPACE. ST1074.2 +010200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1074.2 +010300 01 CCVS-C-1. ST1074.2 +010400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1074.2 +010500- "SS PARAGRAPH-NAME ST1074.2 +010600- " REMARKS". ST1074.2 +010700 02 FILLER PIC X(20) VALUE SPACE. ST1074.2 +010800 01 CCVS-C-2. ST1074.2 +010900 02 FILLER PIC X VALUE SPACE. ST1074.2 +011000 02 FILLER PIC X(6) VALUE "TESTED". ST1074.2 +011100 02 FILLER PIC X(15) VALUE SPACE. ST1074.2 +011200 02 FILLER PIC X(4) VALUE "FAIL". ST1074.2 +011300 02 FILLER PIC X(94) VALUE SPACE. ST1074.2 +011400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1074.2 +011500 01 REC-CT PIC 99 VALUE ZERO. ST1074.2 +011600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1074.2 +012000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1074.2 +012100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1074.2 +012200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1074.2 +012300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1074.2 +012400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1074.2 +012500 01 CCVS-H-1. ST1074.2 +012600 02 FILLER PIC X(39) VALUE SPACES. ST1074.2 +012700 02 FILLER PIC X(42) VALUE ST1074.2 +012800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1074.2 +012900 02 FILLER PIC X(39) VALUE SPACES. ST1074.2 +013000 01 CCVS-H-2A. ST1074.2 +013100 02 FILLER PIC X(40) VALUE SPACE. ST1074.2 +013200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1074.2 +013300 02 FILLER PIC XXXX VALUE ST1074.2 +013400 "4.2 ". ST1074.2 +013500 02 FILLER PIC X(28) VALUE ST1074.2 +013600 " COPY - NOT FOR DISTRIBUTION". ST1074.2 +013700 02 FILLER PIC X(41) VALUE SPACE. ST1074.2 +013800 ST1074.2 +013900 01 CCVS-H-2B. ST1074.2 +014000 02 FILLER PIC X(15) VALUE ST1074.2 +014100 "TEST RESULT OF ". ST1074.2 +014200 02 TEST-ID PIC X(9). ST1074.2 +014300 02 FILLER PIC X(4) VALUE ST1074.2 +014400 " IN ". ST1074.2 +014500 02 FILLER PIC X(12) VALUE ST1074.2 +014600 " HIGH ". ST1074.2 +014700 02 FILLER PIC X(22) VALUE ST1074.2 +014800 " LEVEL VALIDATION FOR ". ST1074.2 +014900 02 FILLER PIC X(58) VALUE ST1074.2 +015000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +015100 01 CCVS-H-3. ST1074.2 +015200 02 FILLER PIC X(34) VALUE ST1074.2 +015300 " FOR OFFICIAL USE ONLY ". ST1074.2 +015400 02 FILLER PIC X(58) VALUE ST1074.2 +015500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1074.2 +015600 02 FILLER PIC X(28) VALUE ST1074.2 +015700 " COPYRIGHT 1985 ". ST1074.2 +015800 01 CCVS-E-1. ST1074.2 +015900 02 FILLER PIC X(52) VALUE SPACE. ST1074.2 +016000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1074.2 +016100 02 ID-AGAIN PIC X(9). ST1074.2 +016200 02 FILLER PIC X(45) VALUE SPACES. ST1074.2 +016300 01 CCVS-E-2. ST1074.2 +016400 02 FILLER PIC X(31) VALUE SPACE. ST1074.2 +016500 02 FILLER PIC X(21) VALUE SPACE. ST1074.2 +016600 02 CCVS-E-2-2. ST1074.2 +016700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1074.2 +016800 03 FILLER PIC X VALUE SPACE. ST1074.2 +016900 03 ENDER-DESC PIC X(44) VALUE ST1074.2 +017000 "ERRORS ENCOUNTERED". ST1074.2 +017100 01 CCVS-E-3. ST1074.2 +017200 02 FILLER PIC X(22) VALUE ST1074.2 +017300 " FOR OFFICIAL USE ONLY". ST1074.2 +017400 02 FILLER PIC X(12) VALUE SPACE. ST1074.2 +017500 02 FILLER PIC X(58) VALUE ST1074.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +017700 02 FILLER PIC X(13) VALUE SPACE. ST1074.2 +017800 02 FILLER PIC X(15) VALUE ST1074.2 +017900 " COPYRIGHT 1985". ST1074.2 +018000 01 CCVS-E-4. ST1074.2 +018100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1074.2 +018200 02 FILLER PIC X(4) VALUE " OF ". ST1074.2 +018300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1074.2 +018400 02 FILLER PIC X(40) VALUE ST1074.2 +018500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1074.2 +018600 01 XXINFO. ST1074.2 +018700 02 FILLER PIC X(19) VALUE ST1074.2 +018800 "*** INFORMATION ***". ST1074.2 +018900 02 INFO-TEXT. ST1074.2 +019000 04 FILLER PIC X(8) VALUE SPACE. ST1074.2 +019100 04 XXCOMPUTED PIC X(20). ST1074.2 +019200 04 FILLER PIC X(5) VALUE SPACE. ST1074.2 +019300 04 XXCORRECT PIC X(20). ST1074.2 +019400 02 INF-ANSI-REFERENCE PIC X(48). ST1074.2 +019500 01 HYPHEN-LINE. ST1074.2 +019600 02 FILLER PIC IS X VALUE IS SPACE. ST1074.2 +019700 02 FILLER PIC IS X(65) VALUE IS "************************ST1074.2 +019800- "*****************************************". ST1074.2 +019900 02 FILLER PIC IS X(54) VALUE IS "************************ST1074.2 +020000- "******************************". ST1074.2 +020100 01 CCVS-PGM-ID PIC X(9) VALUE ST1074.2 +020200 "ST107A". ST1074.2 +020300 PROCEDURE DIVISION. ST1074.2 +020400 CCVS1 SECTION. ST1074.2 +020500 OPEN-FILES. ST1074.2 +020600 OPEN OUTPUT PRINT-FILE. ST1074.2 +020700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1074.2 +020800 MOVE SPACE TO TEST-RESULTS. ST1074.2 +020900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1074.2 +021000 GO TO CCVS1-EXIT. ST1074.2 +021100 CLOSE-FILES. ST1074.2 +021200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1074.2 +021300 TERMINATE-CCVS. ST1074.2 +021400S EXIT PROGRAM. ST1074.2 +021500STERMINATE-CALL. ST1074.2 +021600 STOP RUN. ST1074.2 +021700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1074.2 +021800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1074.2 +021900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1074.2 +022000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1074.2 +022100 MOVE "****TEST DELETED****" TO RE-MARK. ST1074.2 +022200 PRINT-DETAIL. ST1074.2 +022300 IF REC-CT NOT EQUAL TO ZERO ST1074.2 +022400 MOVE "." TO PARDOT-X ST1074.2 +022500 MOVE REC-CT TO DOTVALUE. ST1074.2 +022600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1074.2 +022700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1074.2 +022800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1074.2 +022900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1074.2 +023000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1074.2 +023100 MOVE SPACE TO CORRECT-X. ST1074.2 +023200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1074.2 +023300 MOVE SPACE TO RE-MARK. ST1074.2 +023400 HEAD-ROUTINE. ST1074.2 +023500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +023600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +023700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1074.2 +023800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1074.2 +023900 COLUMN-NAMES-ROUTINE. ST1074.2 +024000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +024100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +024200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +024300 END-ROUTINE. ST1074.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1074.2 +024500 END-RTN-EXIT. ST1074.2 +024600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +024700 END-ROUTINE-1. ST1074.2 +024800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1074.2 +024900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1074.2 +025000 ADD PASS-COUNTER TO ERROR-HOLD. ST1074.2 +025100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1074.2 +025200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1074.2 +025300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1074.2 +025400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1074.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1074.2 +025600 END-ROUTINE-12. ST1074.2 +025700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1074.2 +025800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1074.2 +025900 MOVE "NO " TO ERROR-TOTAL ST1074.2 +026000 ELSE ST1074.2 +026100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1074.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1074.2 +026300 PERFORM WRITE-LINE. ST1074.2 +026400 END-ROUTINE-13. ST1074.2 +026500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1074.2 +026600 MOVE "NO " TO ERROR-TOTAL ELSE ST1074.2 +026700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1074.2 +026800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1074.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027000 IF INSPECT-COUNTER EQUAL TO ZERO ST1074.2 +027100 MOVE "NO " TO ERROR-TOTAL ST1074.2 +027200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1074.2 +027300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1074.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027600 WRITE-LINE. ST1074.2 +027700 ADD 1 TO RECORD-COUNT. ST1074.2 +027800Y IF RECORD-COUNT GREATER 42 ST1074.2 +027900Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1074.2 +028000Y MOVE SPACE TO DUMMY-RECORD ST1074.2 +028100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1074.2 +028200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1074.2 +028300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1074.2 +028400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1074.2 +028500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1074.2 +028600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028900Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1074.2 +029000Y MOVE ZERO TO RECORD-COUNT. ST1074.2 +029100 PERFORM WRT-LN. ST1074.2 +029200 WRT-LN. ST1074.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1074.2 +029400 MOVE SPACE TO DUMMY-RECORD. ST1074.2 +029500 BLANK-LINE-PRINT. ST1074.2 +029600 PERFORM WRT-LN. ST1074.2 +029700 FAIL-ROUTINE. ST1074.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE ST1074.2 +029900 GO TO FAIL-ROUTINE-WRITE. ST1074.2 +030000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1074.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1074.2 +030200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1074.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1074.2 +030500 GO TO FAIL-ROUTINE-EX. ST1074.2 +030600 FAIL-ROUTINE-WRITE. ST1074.2 +030700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1074.2 +030800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1074.2 +030900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1074.2 +031000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1074.2 +031100 FAIL-ROUTINE-EX. EXIT. ST1074.2 +031200 BAIL-OUT. ST1074.2 +031300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1074.2 +031400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1074.2 +031500 BAIL-OUT-WRITE. ST1074.2 +031600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1074.2 +031700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1074.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1074.2 +032000 BAIL-OUT-EX. EXIT. ST1074.2 +032100 CCVS1-EXIT. ST1074.2 +032200 EXIT. ST1074.2 +032300 ST107-0001-01. ST1074.2 +032400 OPEN INPUT SORTIN-1G. ST1074.2 +032500 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1074.2 +032600 IF ZER-O IS LESS THAN SPAC-E ST1074.2 +032700 GO TO ZERO-IS-LESS-THAN-SPACE. ST1074.2 +032800 SPACE-IS-LESS-THAN-ZERO SECTION. ST1074.2 +032900 SORT-INIT-A. ST1074.2 +033000 MOVE +0.0000001 TO UTILITY-1. ST1074.2 +033100 MOVE 999999999999999999 TO UTILITY-2. ST1074.2 +033200 MOVE SPACE TO UTILITY-3. ST1074.2 +033300 SORT-TEST-1. ST1074.2 +033400 PERFORM READ-SORTIN. ST1074.2 +033500 MOVE "SORT-TEST-1" TO PAR-NAME. ST1074.2 +033600 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +033700 PERFORM PASS GO TO SORT-WRITE-1. ST1074.2 +033800 SORT-FAIL-1. ST1074.2 +033900 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +034000 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +034100 MOVE ITEM-3 TO RE-MARK. ST1074.2 +034200 PERFORM PRINT-DETAIL. ST1074.2 +034300 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +034400 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +034500 MOVE ITEM-1 TO RE-MARK. ST1074.2 +034600 PERFORM PRINT-DETAIL. ST1074.2 +034700 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +034800 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +034900 MOVE ITEM-2 TO RE-MARK. ST1074.2 +035000 PERFORM FAIL. ST1074.2 +035100 SORT-WRITE-1. ST1074.2 +035200 PERFORM PRINT-DETAIL. ST1074.2 +035300 SORT-INIT-B. ST1074.2 +035400 MOVE ZERO TO UTILITY-3. ST1074.2 +035500 PERFORM READ-SORTIN 4 TIMES. ST1074.2 +035600* NOTE SORT-TEST-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1074.2 +035700 SORT-TEST-2. ST1074.2 +035800 PERFORM READ-SORTIN. ST1074.2 +035900 MOVE "SORT-TEST-2" TO PAR-NAME. ST1074.2 +036000 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +036100 PERFORM PASS GO TO SORT-WRITE-2. ST1074.2 +036200 SORT-FAIL-2. ST1074.2 +036300 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +036400 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +036500 MOVE ITEM-3 TO RE-MARK. ST1074.2 +036600 PERFORM PRINT-DETAIL. ST1074.2 +036700 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +036800 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +036900 MOVE ITEM-1 TO RE-MARK. ST1074.2 +037000 PERFORM PRINT-DETAIL. ST1074.2 +037100 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +037200 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +037300 MOVE ITEM-2 TO RE-MARK. ST1074.2 +037400 PERFORM FAIL. ST1074.2 +037500 SORT-WRITE-2. ST1074.2 +037600 PERFORM PRINT-DETAIL. ST1074.2 +037700 DUMMY-3-AND-4. ST1074.2 +037800 MOVE "SORT-TEST-3" TO PAR-NAME. ST1074.2 +037900 MOVE DUM-MY TO RE-MARK. ST1074.2 +038000 PERFORM PRINT-DETAIL. ST1074.2 +038100 MOVE "SORT-TEST-4" TO PAR-NAME. ST1074.2 +038200 MOVE DUM-MY TO RE-MARK. ST1074.2 +038300 PERFORM PRINT-DETAIL. ST1074.2 +038400 GO TO CONTINUE-TESTING. ST1074.2 +038500 ZERO-IS-LESS-THAN-SPACE SECTION. ST1074.2 +038600 SORT-INIT-C. ST1074.2 +038700 MOVE +0.0000001 TO UTILITY-1. ST1074.2 +038800 MOVE 999999999999999999 TO UTILITY-2. ST1074.2 +038900 MOVE ZERO TO UTILITY-3. ST1074.2 +039000 DUMMY-1-AND-2. ST1074.2 +039100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1074.2 +039200 MOVE DUM-MY TO RE-MARK. ST1074.2 +039300 PERFORM PRINT-DETAIL. ST1074.2 +039400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1074.2 +039500 MOVE DUM-MY TO RE-MARK. ST1074.2 +039600 PERFORM PRINT-DETAIL. ST1074.2 +039700 SORT-TEST-3. ST1074.2 +039800 PERFORM READ-SORTIN. ST1074.2 +039900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1074.2 +040000 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +040100 PERFORM PASS GO TO SORT-WRITE-3. ST1074.2 +040200 SORT-FAIL-3. ST1074.2 +040300 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +040400 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +040500 MOVE ITEM-3 TO RE-MARK. ST1074.2 +040600 PERFORM PRINT-DETAIL. ST1074.2 +040700 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +040800 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +040900 MOVE ITEM-1 TO RE-MARK. ST1074.2 +041000 PERFORM PRINT-DETAIL. ST1074.2 +041100 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +041200 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +041300 MOVE ITEM-2 TO RE-MARK. ST1074.2 +041400 PERFORM FAIL. ST1074.2 +041500 SORT-WRITE-3. ST1074.2 +041600 PERFORM PRINT-DETAIL. ST1074.2 +041700 SORT-INIT-D. ST1074.2 +041800 PERFORM READ-SORTIN 4 TIMES. ST1074.2 +041900 MOVE SPACE TO UTILITY-3. ST1074.2 +042000* NOTE SORT-TEST-4 CHECKS THE SIXTH RECORD IN THE FILE. ST1074.2 +042100 SORT-TEST-4. ST1074.2 +042200 PERFORM READ-SORTIN. ST1074.2 +042300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1074.2 +042400 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +042500 PERFORM PASS GO TO SORT-WRITE-4. ST1074.2 +042600 SORT-FAIL-4. ST1074.2 +042700 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +042800 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +042900 MOVE ITEM-3 TO RE-MARK. ST1074.2 +043000 PERFORM PRINT-DETAIL. ST1074.2 +043100 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +043200 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +043300 MOVE ITEM-1 TO RE-MARK. ST1074.2 +043400 PERFORM PRINT-DETAIL. ST1074.2 +043500 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +043600 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +043700 MOVE ITEM-2 TO RE-MARK. ST1074.2 +043800 PERFORM FAIL. ST1074.2 +043900 SORT-WRITE-4. ST1074.2 +044000 PERFORM PRINT-DETAIL. ST1074.2 +044100 CONTINUE-TESTING SECTION. ST1074.2 +044200 SORT-INIT-E. ST1074.2 +044300 MOVE +1.1111112 TO UTILITY-1. ST1074.2 +044400 MOVE SPACE TO UTILITY-3. ST1074.2 +044500* NOTE SORT-TEST-5 CHECKS THE SEVENTH RECORD IN THE FILE. ST1074.2 +044600 SORT-TEST-5. ST1074.2 +044700 PERFORM READ-SORTIN. ST1074.2 +044800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1074.2 +044900 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +045000 PERFORM PASS GO TO SORT-WRITE-5. ST1074.2 +045100 SORT-FAIL-5. ST1074.2 +045200 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +045300 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +045400 MOVE ITEM-3 TO RE-MARK. ST1074.2 +045500 PERFORM PRINT-DETAIL. ST1074.2 +045600 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +045700 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +045800 MOVE ITEM-1 TO RE-MARK. ST1074.2 +045900 PERFORM PRINT-DETAIL. ST1074.2 +046000 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +046100 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +046200 MOVE ITEM-2 TO RE-MARK. ST1074.2 +046300 PERFORM FAIL. ST1074.2 +046400 SORT-WRITE-5. ST1074.2 +046500 PERFORM PRINT-DETAIL. ST1074.2 +046600 SORT-INIT-F. ST1074.2 +046700 PERFORM READ-SORTIN. ST1074.2 +046800 MOVE 888888888888888888 TO UTILITY-2. ST1074.2 +046900* NOTE SORT-TEST-6 CHECKS THE NINTH RECORD IN THE FILE. ST1074.2 +047000 SORT-TEST-6. ST1074.2 +047100 PERFORM READ-SORTIN. ST1074.2 +047200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1074.2 +047300 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +047400 PERFORM PASS GO TO SORT-WRITE-6. ST1074.2 +047500 SORT-FAIL-6. ST1074.2 +047600 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +047700 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +047800 MOVE ITEM-3 TO RE-MARK. ST1074.2 +047900 PERFORM PRINT-DETAIL. ST1074.2 +048000 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +048100 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +048200 MOVE ITEM-1 TO RE-MARK. ST1074.2 +048300 PERFORM PRINT-DETAIL. ST1074.2 +048400 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +048500 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +048600 MOVE ITEM-2 TO RE-MARK. ST1074.2 +048700 PERFORM FAIL. ST1074.2 +048800 SORT-WRITE-6. ST1074.2 +048900 PERFORM PRINT-DETAIL. ST1074.2 +049000 SORT-TEST-7. ST1074.2 +049100 READ SORTIN-1G AT END ST1074.2 +049200 PERFORM PASS GO TO SORT-WRITE-7. ST1074.2 +049300 SORT-FAIL-7. ST1074.2 +049400 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +049500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1074.2 +049600 PERFORM FAIL. ST1074.2 +049700 SORT-WRITE-7. ST1074.2 +049800 MOVE "SORT-TEST-7" TO PAR-NAME. ST1074.2 +049900 PERFORM PRINT-DETAIL. ST1074.2 +050000 SORT-TEST-8. ST1074.2 +050100 IF UTIL-CTR EQUAL TO 9 ST1074.2 +050200 PERFORM PASS GO TO SORT-WRITE-8. ST1074.2 +050300 SORT-FAIL-8. ST1074.2 +050400 MOVE UTIL-CTR TO COMPUTED-4V14. ST1074.2 +050500 MOVE 9 TO CORRECT-4V14. ST1074.2 +050600 PERFORM FAIL. ST1074.2 +050700 SORT-WRITE-8. ST1074.2 +050800 MOVE "SORT-TEST-8" TO PAR-NAME. ST1074.2 +050900 PERFORM PRINT-DETAIL. ST1074.2 +051000 CLOSE SORTIN-1G. ST1074.2 +051100 GO TO CCVS-EXIT. ST1074.2 +051200 READ-SORTIN. ST1074.2 +051300 READ SORTIN-1G AT END GO TO READ-ERROR. ST1074.2 +051400 ADD 1 TO UTIL-CTR. ST1074.2 +051500 READ-ERROR. ST1074.2 +051600 MOVE "READ-ERROR" TO PAR-NAME. ST1074.2 +051700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1074.2 +051800 PERFORM FAIL. ST1074.2 +051900 PERFORM PRINT-DETAIL. ST1074.2 +052000 CCVS-EXIT SECTION. ST1074.2 +052100 CCVS-999999. ST1074.2 +052200 GO TO CLOSE-FILES. ST1074.2 +*END-OF,ST107A +*HEADER,COBOL,ST108A +000100 IDENTIFICATION DIVISION. ST1084.2 +000200 PROGRAM-ID. ST1084.2 +000300 ST108A. ST1084.2 +000400**************************************************************** ST1084.2 +000500* * ST1084.2 +000600* VALIDATION FOR:- * ST1084.2 +000700* * ST1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +000900* * ST1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1084.2 +001100* * ST1084.2 +001200**************************************************************** ST1084.2 +001300* * ST1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1084.2 +001500* * ST1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1084.2 +001900* * ST1084.2 +002000**************************************************************** ST1084.2 +002100* ST108 IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1084.2 +002200* PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE ST1084.2 +002300* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1084.2 +002400* REPORT. ST1084.2 +002500* SORT SORT SORT SORT SORT SORT SORT SORT ST1084.2 +002600* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8ST1084.2 +002700* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 ST1084.2 +002800* USAGE JUST JUST USAGEST1084.2 +002900* COMP RIGHT RIGHT COMP ST1084.2 +003000* ST1084.2 +003100* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003200* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003300* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003400* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1084.2 +003500* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1084.2 +003600* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1084.2 +003700* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1084.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1084.2 +003900* ST1084.2 +004000* THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT ST1084.2 +004100* ASCENDING KEYS IN ONE FILE. ST1084.2 +004200 ST1084.2 +004300 ENVIRONMENT DIVISION. ST1084.2 +004400 CONFIGURATION SECTION. ST1084.2 +004500 SOURCE-COMPUTER. ST1084.2 +004600 XXXXX082. ST1084.2 +004700 OBJECT-COMPUTER. ST1084.2 +004800 XXXXX083. ST1084.2 +004900 INPUT-OUTPUT SECTION. ST1084.2 +005000 FILE-CONTROL. ST1084.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1084.2 +005200 XXXXX055. ST1084.2 +005300 SELECT SORTFILE-1H ASSIGN TO ST1084.2 +005400 XXXXX027. ST1084.2 +005500 DATA DIVISION. ST1084.2 +005600 FILE SECTION. ST1084.2 +005700 FD PRINT-FILE. ST1084.2 +005800 01 PRINT-REC PICTURE X(120). ST1084.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1084.2 +006000 SD SORTFILE-1H ST1084.2 +006100 DATA RECORD IS SORTFILE-REC. ST1084.2 +006200 01 SORTFILE-REC. ST1084.2 +006300 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. ST1084.2 +006400 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. ST1084.2 +006500 02 SORTKEY-7 PICTURE 999. ST1084.2 +006600 02 SORTKEY-3 PICTURE SV9(16). ST1084.2 +006700 02 FILLER PICTURE XX. ST1084.2 +006800 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1084.2 +006900 02 SORTKEY-6 PICTURE X(10). ST1084.2 +007000 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1084.2 +007100 02 SORTKEY-5 PICTURE A(20). ST1084.2 +007200 02 FILLER PICTURE XXX. ST1084.2 +007300 WORKING-STORAGE SECTION. ST1084.2 +007400 77 UTIL-CTR PICTURE S99999. ST1084.2 +007500 77 SPAC-E PICTURE X VALUE " ". ST1084.2 +007600 01 TEST-RESULTS. ST1084.2 +007700 02 FILLER PIC X VALUE SPACE. ST1084.2 +007800 02 FEATURE PIC X(20) VALUE SPACE. ST1084.2 +007900 02 FILLER PIC X VALUE SPACE. ST1084.2 +008000 02 P-OR-F PIC X(5) VALUE SPACE. ST1084.2 +008100 02 FILLER PIC X VALUE SPACE. ST1084.2 +008200 02 PAR-NAME. ST1084.2 +008300 03 FILLER PIC X(19) VALUE SPACE. ST1084.2 +008400 03 PARDOT-X PIC X VALUE SPACE. ST1084.2 +008500 03 DOTVALUE PIC 99 VALUE ZERO. ST1084.2 +008600 02 FILLER PIC X(8) VALUE SPACE. ST1084.2 +008700 02 RE-MARK PIC X(61). ST1084.2 +008800 01 TEST-COMPUTED. ST1084.2 +008900 02 FILLER PIC X(30) VALUE SPACE. ST1084.2 +009000 02 FILLER PIC X(17) VALUE ST1084.2 +009100 " COMPUTED=". ST1084.2 +009200 02 COMPUTED-X. ST1084.2 +009300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1084.2 +009400 03 COMPUTED-N REDEFINES COMPUTED-A ST1084.2 +009500 PIC -9(9).9(9). ST1084.2 +009600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1084.2 +009700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1084.2 +009800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1084.2 +009900 03 CM-18V0 REDEFINES COMPUTED-A. ST1084.2 +010000 04 COMPUTED-18V0 PIC -9(18). ST1084.2 +010100 04 FILLER PIC X. ST1084.2 +010200 03 FILLER PIC X(50) VALUE SPACE. ST1084.2 +010300 01 TEST-CORRECT. ST1084.2 +010400 02 FILLER PIC X(30) VALUE SPACE. ST1084.2 +010500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1084.2 +010600 02 CORRECT-X. ST1084.2 +010700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1084.2 +010800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1084.2 +010900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1084.2 +011000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1084.2 +011100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1084.2 +011200 03 CR-18V0 REDEFINES CORRECT-A. ST1084.2 +011300 04 CORRECT-18V0 PIC -9(18). ST1084.2 +011400 04 FILLER PIC X. ST1084.2 +011500 03 FILLER PIC X(2) VALUE SPACE. ST1084.2 +011600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1084.2 +011700 01 CCVS-C-1. ST1084.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1084.2 +011900- "SS PARAGRAPH-NAME ST1084.2 +012000- " REMARKS". ST1084.2 +012100 02 FILLER PIC X(20) VALUE SPACE. ST1084.2 +012200 01 CCVS-C-2. ST1084.2 +012300 02 FILLER PIC X VALUE SPACE. ST1084.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". ST1084.2 +012500 02 FILLER PIC X(15) VALUE SPACE. ST1084.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". ST1084.2 +012700 02 FILLER PIC X(94) VALUE SPACE. ST1084.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1084.2 +012900 01 REC-CT PIC 99 VALUE ZERO. ST1084.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1084.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1084.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1084.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1084.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1084.2 +013900 01 CCVS-H-1. ST1084.2 +014000 02 FILLER PIC X(39) VALUE SPACES. ST1084.2 +014100 02 FILLER PIC X(42) VALUE ST1084.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1084.2 +014300 02 FILLER PIC X(39) VALUE SPACES. ST1084.2 +014400 01 CCVS-H-2A. ST1084.2 +014500 02 FILLER PIC X(40) VALUE SPACE. ST1084.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1084.2 +014700 02 FILLER PIC XXXX VALUE ST1084.2 +014800 "4.2 ". ST1084.2 +014900 02 FILLER PIC X(28) VALUE ST1084.2 +015000 " COPY - NOT FOR DISTRIBUTION". ST1084.2 +015100 02 FILLER PIC X(41) VALUE SPACE. ST1084.2 +015200 ST1084.2 +015300 01 CCVS-H-2B. ST1084.2 +015400 02 FILLER PIC X(15) VALUE ST1084.2 +015500 "TEST RESULT OF ". ST1084.2 +015600 02 TEST-ID PIC X(9). ST1084.2 +015700 02 FILLER PIC X(4) VALUE ST1084.2 +015800 " IN ". ST1084.2 +015900 02 FILLER PIC X(12) VALUE ST1084.2 +016000 " HIGH ". ST1084.2 +016100 02 FILLER PIC X(22) VALUE ST1084.2 +016200 " LEVEL VALIDATION FOR ". ST1084.2 +016300 02 FILLER PIC X(58) VALUE ST1084.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +016500 01 CCVS-H-3. ST1084.2 +016600 02 FILLER PIC X(34) VALUE ST1084.2 +016700 " FOR OFFICIAL USE ONLY ". ST1084.2 +016800 02 FILLER PIC X(58) VALUE ST1084.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1084.2 +017000 02 FILLER PIC X(28) VALUE ST1084.2 +017100 " COPYRIGHT 1985 ". ST1084.2 +017200 01 CCVS-E-1. ST1084.2 +017300 02 FILLER PIC X(52) VALUE SPACE. ST1084.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1084.2 +017500 02 ID-AGAIN PIC X(9). ST1084.2 +017600 02 FILLER PIC X(45) VALUE SPACES. ST1084.2 +017700 01 CCVS-E-2. ST1084.2 +017800 02 FILLER PIC X(31) VALUE SPACE. ST1084.2 +017900 02 FILLER PIC X(21) VALUE SPACE. ST1084.2 +018000 02 CCVS-E-2-2. ST1084.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1084.2 +018200 03 FILLER PIC X VALUE SPACE. ST1084.2 +018300 03 ENDER-DESC PIC X(44) VALUE ST1084.2 +018400 "ERRORS ENCOUNTERED". ST1084.2 +018500 01 CCVS-E-3. ST1084.2 +018600 02 FILLER PIC X(22) VALUE ST1084.2 +018700 " FOR OFFICIAL USE ONLY". ST1084.2 +018800 02 FILLER PIC X(12) VALUE SPACE. ST1084.2 +018900 02 FILLER PIC X(58) VALUE ST1084.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +019100 02 FILLER PIC X(13) VALUE SPACE. ST1084.2 +019200 02 FILLER PIC X(15) VALUE ST1084.2 +019300 " COPYRIGHT 1985". ST1084.2 +019400 01 CCVS-E-4. ST1084.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1084.2 +019600 02 FILLER PIC X(4) VALUE " OF ". ST1084.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1084.2 +019800 02 FILLER PIC X(40) VALUE ST1084.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1084.2 +020000 01 XXINFO. ST1084.2 +020100 02 FILLER PIC X(19) VALUE ST1084.2 +020200 "*** INFORMATION ***". ST1084.2 +020300 02 INFO-TEXT. ST1084.2 +020400 04 FILLER PIC X(8) VALUE SPACE. ST1084.2 +020500 04 XXCOMPUTED PIC X(20). ST1084.2 +020600 04 FILLER PIC X(5) VALUE SPACE. ST1084.2 +020700 04 XXCORRECT PIC X(20). ST1084.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). ST1084.2 +020900 01 HYPHEN-LINE. ST1084.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. ST1084.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************ST1084.2 +021200- "*****************************************". ST1084.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************ST1084.2 +021400- "******************************". ST1084.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE ST1084.2 +021600 "ST108A". ST1084.2 +021700 PROCEDURE DIVISION. ST1084.2 +021800 SORT-PARA SECTION. ST1084.2 +021900 SORT-PARAGRAPH. ST1084.2 +022000 SORT SORTFILE-1H ON ST1084.2 +022100 ASCENDING KEY SORTKEY-1 ST1084.2 +022200 ASCENDING SORTKEY-2 ST1084.2 +022300 ASCENDING SORTKEY-3 ST1084.2 +022400 ASCENDING SORTKEY-4 ST1084.2 +022500 ASCENDING SORTKEY-5 ST1084.2 +022600 ASCENDING SORTKEY-6 ST1084.2 +022700 ASCENDING SORTKEY-7 ST1084.2 +022800 ASCENDING SORTKEY-8 ST1084.2 +022900 INPUT PROCEDURE INPROC ST1084.2 +023000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1084.2 +023100 STOP RUN. ST1084.2 +023200 INPROC SECTION. ST1084.2 +023300 BUILD-FILE. ST1084.2 +023400 PERFORM BUILD-RECORD. ST1084.2 +023500 MOVE +123456 TO SORTKEY-1. ST1084.2 +023600 PERFORM RELEASE-RECORD. ST1084.2 +023700 PERFORM BUILD-RECORD. ST1084.2 +023800 MOVE "X" TO SORTKEY-2. ST1084.2 +023900 PERFORM RELEASE-RECORD. ST1084.2 +024000 PERFORM BUILD-RECORD. ST1084.2 +024100 MOVE +.6 TO SORTKEY-3. ST1084.2 +024200 PERFORM RELEASE-RECORD. ST1084.2 +024300 PERFORM BUILD-RECORD. ST1084.2 +024400 MOVE "X" TO SORTKEY-4. ST1084.2 +024500 PERFORM RELEASE-RECORD. ST1084.2 +024600 PERFORM BUILD-RECORD. ST1084.2 +024700 MOVE "Z" TO SORTKEY-5. ST1084.2 +024800 PERFORM RELEASE-RECORD. ST1084.2 +024900 PERFORM BUILD-RECORD. ST1084.2 +025000 MOVE "Z" TO SORTKEY-6. ST1084.2 +025100 PERFORM RELEASE-RECORD. ST1084.2 +025200 PERFORM BUILD-RECORD. ST1084.2 +025300 MOVE +418 TO SORTKEY-7. ST1084.2 +025400 PERFORM RELEASE-RECORD. ST1084.2 +025500 PERFORM BUILD-RECORD. ST1084.2 +025600 MOVE -14 TO SORTKEY-8. ST1084.2 +025700 PERFORM RELEASE-RECORD. ST1084.2 +025800 GO TO BUILD-EXIT. ST1084.2 +025900 BUILD-RECORD. ST1084.2 +026000 MOVE -054321 TO SORTKEY-1. ST1084.2 +026100 MOVE "BBB" TO SORTKEY-2. ST1084.2 +026200 MOVE -.1234567890123456 TO SORTKEY-3. ST1084.2 +026300 MOVE "BBBBBB" TO SORTKEY-4. ST1084.2 +026400 MOVE "A" TO SORTKEY-5. ST1084.2 +026500 MOVE "AAAAAAAA" TO SORTKEY-6. ST1084.2 +026600 MOVE -501 TO SORTKEY-7. ST1084.2 +026700* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1084.2 +026800* FIELD. ST1084.2 +026900 MOVE +99 TO SORTKEY-8. ST1084.2 +027000 RELEASE-RECORD. ST1084.2 +027100 RELEASE SORTFILE-REC. ST1084.2 +027200 BUILD-EXIT. ST1084.2 +027300 EXIT. ST1084.2 +027400 OUTPROC SECTION. ST1084.2 +027500 OPEN-FILES. ST1084.2 +027600 OPEN OUTPUT PRINT-FILE. ST1084.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1084.2 +027800 MOVE SPACE TO TEST-RESULTS. ST1084.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1084.2 +028000 IF SPAC-E IS LESS THAN "B" ST1084.2 +028100 GO TO SPACE-IS-LESS-THAN-B. ST1084.2 +028200 B-IS-LESS-THAN-SPACE SECTION. ST1084.2 +028300 SORT-INIT-A. ST1084.2 +028400 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +028500* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1084.2 +028600* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1084.2 +028700* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1084.2 +028800* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1084.2 +028900 SORT-TEST-1. ST1084.2 +029000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +029100 IF SORTKEY-7 EQUAL TO 418 ST1084.2 +029200 PERFORM PASS GO TO SORT-WRITE-1. ST1084.2 +029300 SORT-FAIL-1. ST1084.2 +029400 PERFORM FAIL. ST1084.2 +029500 MOVE SORTKEY-7 TO COMPUTED-N. ST1084.2 +029600 MOVE 418 TO CORRECT-N. ST1084.2 +029700 SORT-WRITE-1. ST1084.2 +029800 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1084.2 +029900 PERFORM PRINT-DETAIL. ST1084.2 +030000 SORT-TEST-2. ST1084.2 +030100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +030200 IF SORTKEY-8 EQUAL TO -14 ST1084.2 +030300 PERFORM PASS GO TO SORT-WRITE-2. ST1084.2 +030400 SORT-FAIL-2. ST1084.2 +030500 PERFORM FAIL. ST1084.2 +030600 MOVE SORTKEY-8 TO COMPUTED-N. ST1084.2 +030700 MOVE -14 TO CORRECT-N. ST1084.2 +030800 SORT-WRITE-2. ST1084.2 +030900 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1084.2 +031000 PERFORM PRINT-DETAIL. ST1084.2 +031100 SORT-TEST-3. ST1084.2 +031200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +031300 IF SORTKEY-6 EQUAL TO "Z " ST1084.2 +031400 PERFORM PASS GO TO SORT-WRITE-3. ST1084.2 +031500 SORT-FAIL-3. ST1084.2 +031600 PERFORM FAIL. ST1084.2 +031700 MOVE SORTKEY-6 TO COMPUTED-A. ST1084.2 +031800 MOVE "Z " TO CORRECT-A. ST1084.2 +031900 SORT-WRITE-3. ST1084.2 +032000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1084.2 +032100 PERFORM PRINT-DETAIL. ST1084.2 +032200 SORT-TEST-4. ST1084.2 +032300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +032400 IF SORTKEY-5 EQUAL TO "Z " ST1084.2 +032500 PERFORM PASS GO TO SORT-WRITE-4. ST1084.2 +032600 SORT-FAIL-4. ST1084.2 +032700 PERFORM FAIL. ST1084.2 +032800 MOVE SORTKEY-5 TO COMPUTED-A. ST1084.2 +032900 MOVE "Z " TO CORRECT-A. ST1084.2 +033000 SORT-WRITE-4. ST1084.2 +033100 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1084.2 +033200 PERFORM PRINT-DETAIL. ST1084.2 +033300 SORT-TEST-5. ST1084.2 +033400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +033500 IF SORTKEY-4 EQUAL TO " X" ST1084.2 +033600 PERFORM PASS GO TO SORT-WRITE-5. ST1084.2 +033700 SORT-FAIL-5. ST1084.2 +033800 PERFORM FAIL. ST1084.2 +033900 MOVE SORTKEY-4 TO COMPUTED-A. ST1084.2 +034000 MOVE " X" TO CORRECT-A. ST1084.2 +034100 SORT-WRITE-5. ST1084.2 +034200 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1084.2 +034300 PERFORM PRINT-DETAIL. ST1084.2 +034400 SORT-TEST-6. ST1084.2 +034500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +034600 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1084.2 +034700 PERFORM PASS GO TO SORT-WRITE-6. ST1084.2 +034800 SORT-FAIL-6. ST1084.2 +034900 PERFORM FAIL. ST1084.2 +035000 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1084.2 +035100 MOVE +.6000000000000000 TO CORRECT-0V18. ST1084.2 +035200 SORT-WRITE-6. ST1084.2 +035300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1084.2 +035400 PERFORM PRINT-DETAIL. ST1084.2 +035500 SORT-TEST-7. ST1084.2 +035600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +035700 IF SORTKEY-2 EQUAL TO " X" ST1084.2 +035800 PERFORM PASS GO TO SORT-WRITE-7. ST1084.2 +035900 SORT-FAIL-7. ST1084.2 +036000 PERFORM FAIL. ST1084.2 +036100 MOVE SORTKEY-2 TO COMPUTED-A. ST1084.2 +036200 MOVE " X" TO CORRECT-A. ST1084.2 +036300 SORT-WRITE-7. ST1084.2 +036400 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1084.2 +036500 PERFORM PRINT-DETAIL. ST1084.2 +036600 SORT-TEST-8. ST1084.2 +036700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +036800 IF SORTKEY-1 EQUAL TO +123456 ST1084.2 +036900 PERFORM PASS GO TO SORT-WRITE-8. ST1084.2 +037000 SORT-FAIL-8. ST1084.2 +037100 PERFORM FAIL. ST1084.2 +037200 MOVE SORTKEY-1 TO COMPUTED-N. ST1084.2 +037300 MOVE +123456 TO CORRECT-N. ST1084.2 +037400 SORT-WRITE-8. ST1084.2 +037500 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1084.2 +037600 PERFORM PRINT-DETAIL. ST1084.2 +037700 SORT-REMARK-A. ST1084.2 +037800 MOVE SPACE TO FEATURE. ST1084.2 +037900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1084.2 +038000 PERFORM PRINT-DETAIL. ST1084.2 +038100 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1084.2 +038200 PERFORM PRINT-DETAIL. ST1084.2 +038300 MOVE "UNNECESSARY." TO RE-MARK. ST1084.2 +038400 PERFORM PRINT-DETAIL. ST1084.2 +038500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +038600 GO TO CONTINUE-TESTING. ST1084.2 +038700 SPACE-IS-LESS-THAN-B SECTION. ST1084.2 +038800 SORT-REMARK-B. ST1084.2 +038900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1084.2 +039000 PERFORM PRINT-DETAIL. ST1084.2 +039100 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1084.2 +039200 PERFORM PRINT-DETAIL. ST1084.2 +039300 MOVE "UNNECESSARY." TO RE-MARK. ST1084.2 +039400 PERFORM PRINT-DETAIL. ST1084.2 +039500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +039600* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1084.2 +039700* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1084.2 +039800* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1084.2 +039900* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1084.2 +040000 SORT-TEST-9. ST1084.2 +040100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +040200 IF SORTKEY-2 EQUAL TO " X" ST1084.2 +040300 PERFORM PASS GO TO SORT-WRITE-9. ST1084.2 +040400 SORT-FAIL-9. ST1084.2 +040500 PERFORM FAIL. ST1084.2 +040600 MOVE SORTKEY-2 TO COMPUTED-A. ST1084.2 +040700 MOVE " X" TO CORRECT-A. ST1084.2 +040800 SORT-WRITE-9. ST1084.2 +040900 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1084.2 +041000 PERFORM PRINT-DETAIL. ST1084.2 +041100 SORT-TEST-10. ST1084.2 +041200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +041300 IF SORTKEY-4 EQUAL TO " X" ST1084.2 +041400 PERFORM PASS GO TO SORT-WRITE-10. ST1084.2 +041500 SORT-FAIL-10. ST1084.2 +041600 PERFORM FAIL. ST1084.2 +041700 MOVE SORTKEY-4 TO COMPUTED-A. ST1084.2 +041800 MOVE " X" TO CORRECT-A. ST1084.2 +041900 SORT-WRITE-10. ST1084.2 +042000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1084.2 +042100 PERFORM PRINT-DETAIL. ST1084.2 +042200 SORT-TEST-11. ST1084.2 +042300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +042400 IF SORTKEY-7 EQUAL TO 418 ST1084.2 +042500 PERFORM PASS GO TO SORT-WRITE-11. ST1084.2 +042600 SORT-FAIL-11. ST1084.2 +042700 PERFORM FAIL. ST1084.2 +042800 MOVE SORTKEY-7 TO COMPUTED-N ST1084.2 +042900 MOVE 418 TO CORRECT-N. ST1084.2 +043000 SORT-WRITE-11. ST1084.2 +043100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1084.2 +043200 PERFORM PRINT-DETAIL. ST1084.2 +043300 SORT-TEST-12. ST1084.2 +043400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +043500 IF SORTKEY-8 EQUAL TO -14 ST1084.2 +043600 PERFORM PASS GO TO SORT-WRITE-12. ST1084.2 +043700 SORT-FAIL-12. ST1084.2 +043800 PERFORM FAIL. ST1084.2 +043900 MOVE SORTKEY-8 TO COMPUTED-N. ST1084.2 +044000 MOVE -14 TO CORRECT-N. ST1084.2 +044100 SORT-WRITE-12. ST1084.2 +044200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1084.2 +044300 PERFORM PRINT-DETAIL. ST1084.2 +044400 SORT-TEST-13. ST1084.2 +044500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +044600 IF SORTKEY-6 EQUAL TO "Z " ST1084.2 +044700 PERFORM PASS GO TO SORT-WRITE-13. ST1084.2 +044800 SORT-FAIL-13. ST1084.2 +044900 PERFORM FAIL. ST1084.2 +045000 MOVE SORTKEY-6 TO COMPUTED-A. ST1084.2 +045100 MOVE "Z " TO CORRECT-A. ST1084.2 +045200 SORT-WRITE-13. ST1084.2 +045300 MOVE "SORT-TEST-13" TO PAR-NAME. ST1084.2 +045400 PERFORM PRINT-DETAIL. ST1084.2 +045500 SORT-TEST-14. ST1084.2 +045600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +045700 IF SORTKEY-5 EQUAL TO "Z " ST1084.2 +045800 PERFORM PASS GO TO SORT-WRITE-14. ST1084.2 +045900 SORT-FAIL-14. ST1084.2 +046000 PERFORM FAIL. ST1084.2 +046100 MOVE SORTKEY-5 TO COMPUTED-A. ST1084.2 +046200 MOVE "Z " TO CORRECT-A. ST1084.2 +046300 SORT-WRITE-14. ST1084.2 +046400 MOVE "SORT-TEST-14" TO PAR-NAME. ST1084.2 +046500 PERFORM PRINT-DETAIL. ST1084.2 +046600 SORT-TEST-15. ST1084.2 +046700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +046800 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1084.2 +046900 PERFORM PASS GO TO SORT-WRITE-15. ST1084.2 +047000 SORT-FAIL-15. ST1084.2 +047100 PERFORM FAIL. ST1084.2 +047200 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1084.2 +047300 MOVE +.6000000000000000 TO CORRECT-0V18. ST1084.2 +047400 SORT-WRITE-15. ST1084.2 +047500 MOVE "SORT-TEST-15" TO PAR-NAME. ST1084.2 +047600 PERFORM PRINT-DETAIL. ST1084.2 +047700 SORT-TEST-16. ST1084.2 +047800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +047900 IF SORTKEY-1 EQUAL TO +123456 ST1084.2 +048000 PERFORM PASS GO TO SORT-WRITE-16. ST1084.2 +048100 SORT-FAIL-16. ST1084.2 +048200 PERFORM FAIL. ST1084.2 +048300 MOVE SORTKEY-1 TO COMPUTED-N. ST1084.2 +048400 MOVE +123456 TO CORRECT-N. ST1084.2 +048500 SORT-WRITE-16. ST1084.2 +048600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1084.2 +048700 PERFORM PRINT-DETAIL. ST1084.2 +048800 CONTINUE-TESTING SECTION. ST1084.2 +048900 SORT-TEST-17. ST1084.2 +049000 RETURN SORTFILE-1H AT END ST1084.2 +049100 PERFORM PASS GO TO SORT-WRITE-17. ST1084.2 +049200 SORT-FAIL-17. ST1084.2 +049300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1084.2 +049400 PERFORM FAIL. ST1084.2 +049500 SORT-WRITE-17. ST1084.2 +049600 MOVE "SORT-TEST-17" TO PAR-NAME. ST1084.2 +049700 PERFORM PRINT-DETAIL. ST1084.2 +049800 GO TO OUTPROC-EXIT. ST1084.2 +049900 RETURN-ERROR. ST1084.2 +050000 MOVE "RETURN-ERROR" TO PAR-NAME. ST1084.2 +050100 PERFORM FAIL. ST1084.2 +050200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1084.2 +050300 PERFORM PRINT-DETAIL. ST1084.2 +050400 GO TO CCVS1-EXIT. ST1084.2 +050500 CLOSE-FILES. ST1084.2 +050600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1084.2 +050700 TERMINATE-CCVS. ST1084.2 +050800S EXIT PROGRAM. ST1084.2 +050900STERMINATE-CALL. ST1084.2 +051000 STOP RUN. ST1084.2 +051100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1084.2 +051200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1084.2 +051300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1084.2 +051400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1084.2 +051500 MOVE "****TEST DELETED****" TO RE-MARK. ST1084.2 +051600 PRINT-DETAIL. ST1084.2 +051700 IF REC-CT NOT EQUAL TO ZERO ST1084.2 +051800 MOVE "." TO PARDOT-X ST1084.2 +051900 MOVE REC-CT TO DOTVALUE. ST1084.2 +052000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1084.2 +052100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1084.2 +052200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1084.2 +052300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1084.2 +052400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1084.2 +052500 MOVE SPACE TO CORRECT-X. ST1084.2 +052600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1084.2 +052700 MOVE SPACE TO RE-MARK. ST1084.2 +052800 HEAD-ROUTINE. ST1084.2 +052900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1084.2 +053200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1084.2 +053300 COLUMN-NAMES-ROUTINE. ST1084.2 +053400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +053500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +053700 END-ROUTINE. ST1084.2 +053800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1084.2 +053900 END-RTN-EXIT. ST1084.2 +054000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +054100 END-ROUTINE-1. ST1084.2 +054200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1084.2 +054300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1084.2 +054400 ADD PASS-COUNTER TO ERROR-HOLD. ST1084.2 +054500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1084.2 +054600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1084.2 +054700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1084.2 +054800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1084.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1084.2 +055000 END-ROUTINE-12. ST1084.2 +055100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1084.2 +055200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1084.2 +055300 MOVE "NO " TO ERROR-TOTAL ST1084.2 +055400 ELSE ST1084.2 +055500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1084.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1084.2 +055700 PERFORM WRITE-LINE. ST1084.2 +055800 END-ROUTINE-13. ST1084.2 +055900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1084.2 +056000 MOVE "NO " TO ERROR-TOTAL ELSE ST1084.2 +056100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1084.2 +056200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1084.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +056400 IF INSPECT-COUNTER EQUAL TO ZERO ST1084.2 +056500 MOVE "NO " TO ERROR-TOTAL ST1084.2 +056600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1084.2 +056700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1084.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +056900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +057000 WRITE-LINE. ST1084.2 +057100 ADD 1 TO RECORD-COUNT. ST1084.2 +057200Y IF RECORD-COUNT GREATER 42 ST1084.2 +057300Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1084.2 +057400Y MOVE SPACE TO DUMMY-RECORD ST1084.2 +057500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1084.2 +057600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1084.2 +057700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1084.2 +057800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1084.2 +057900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1084.2 +058000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1084.2 +058400Y MOVE ZERO TO RECORD-COUNT. ST1084.2 +058500 PERFORM WRT-LN. ST1084.2 +058600 WRT-LN. ST1084.2 +058700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1084.2 +058800 MOVE SPACE TO DUMMY-RECORD. ST1084.2 +058900 BLANK-LINE-PRINT. ST1084.2 +059000 PERFORM WRT-LN. ST1084.2 +059100 FAIL-ROUTINE. ST1084.2 +059200 IF COMPUTED-X NOT EQUAL TO SPACE ST1084.2 +059300 GO TO FAIL-ROUTINE-WRITE. ST1084.2 +059400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1084.2 +059500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1084.2 +059600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1084.2 +059700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +059800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1084.2 +059900 GO TO FAIL-ROUTINE-EX. ST1084.2 +060000 FAIL-ROUTINE-WRITE. ST1084.2 +060100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1084.2 +060200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1084.2 +060300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1084.2 +060400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1084.2 +060500 FAIL-ROUTINE-EX. EXIT. ST1084.2 +060600 BAIL-OUT. ST1084.2 +060700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1084.2 +060800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1084.2 +060900 BAIL-OUT-WRITE. ST1084.2 +061000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1084.2 +061100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1084.2 +061200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +061300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1084.2 +061400 BAIL-OUT-EX. EXIT. ST1084.2 +061500 CCVS1-EXIT. ST1084.2 +061600 EXIT. ST1084.2 +061700 OUTPROC-EXIT SECTION. ST1084.2 +061800 EXIT-ONLY. ST1084.2 +061900 PERFORM CLOSE-FILES. ST1084.2 +*END-OF,ST108A +*HEADER,COBOL,ST109A +000100 IDENTIFICATION DIVISION. ST1094.2 +000200 PROGRAM-ID. ST1094.2 +000300 ST109A. ST1094.2 +000400**************************************************************** ST1094.2 +000500* * ST1094.2 +000600* VALIDATION FOR:- * ST1094.2 +000700* * ST1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +000900* * ST1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1094.2 +001100* * ST1094.2 +001200**************************************************************** ST1094.2 +001300* * ST1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1094.2 +001500* * ST1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1094.2 +001900* * ST1094.2 +002000**************************************************************** ST1094.2 +002100* ST109 BUILDS A FILE WHICH IS SORTED IN ST110 AND CHECKED IN ST1094.2 +002200* ST111. THE CREATED FILE CONSISTS OF 40 RECORDS OF VARYING ST1094.2 +002300* LENGTH (50, 75, 100 CHARACTERS). THE THREE RECORDS SHOWN ST1094.2 +002400* BELOW REOCCUR UNTIL 40 IS REACHED. ST1094.2 +002500* NON-KEY KEY-1 KEY-2 FILLER ST1094.2 +002600* X(2) X(10) X(38) ST1094.2 +002700* ST1094.2 +002800* "BB" "LOWEST TWO" "MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1094.2 +002900* "CC" "LOWEST TWO" "MIDDLE TWO-SECOND" X(50) VALUE QUOTE ST1094.2 +003000* "AA" "LOWEST ONE" "MIDDLE ONE-ONLY" (NONE) ST1094.2 +003100* ST1094.2 +003200* * * * * * * * * * * * * * * * * * * * * *.ST1094.2 +003300 ST1094.2 +003400 ENVIRONMENT DIVISION. ST1094.2 +003500 CONFIGURATION SECTION. ST1094.2 +003600 SOURCE-COMPUTER. ST1094.2 +003700 XXXXX082. ST1094.2 +003800 OBJECT-COMPUTER. ST1094.2 +003900 XXXXX083. ST1094.2 +004000 INPUT-OUTPUT SECTION. ST1094.2 +004100 FILE-CONTROL. ST1094.2 +004200 SELECT PRINT-FILE ASSIGN TO ST1094.2 +004300 XXXXX055. ST1094.2 +004400 SELECT SORTOUT-1I ASSIGN TO ST1094.2 +004500 XXXXP001. ST1094.2 +004600 DATA DIVISION. ST1094.2 +004700 FILE SECTION. ST1094.2 +004800 FD PRINT-FILE. ST1094.2 +004900 01 PRINT-REC PICTURE X(120). ST1094.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1094.2 +005100 FD SORTOUT-1I ST1094.2 +005200 LABEL RECORDS STANDARD ST1094.2 +005300C VALUE OF ST1094.2 +005400C XXXXX074 ST1094.2 +005500C IS ST1094.2 +005600C XXXXX075 ST1094.2 +005700G XXXXX069 ST1094.2 +005800 RECORD CONTAINS 50 TO 100 CHARACTERS ST1094.2 +005900 DATA RECORDS ARE SHORT-RECORD ST1094.2 +006000 MEDIUM-RECORD ST1094.2 +006100 LONG-RECORD. ST1094.2 +006200 01 SHORT-RECORD PICTURE X(50). ST1094.2 +006300 01 MEDIUM-RECORD PICTURE X(75). ST1094.2 +006400 01 LONG-RECORD PICTURE X(100). ST1094.2 +006500 WORKING-STORAGE SECTION. ST1094.2 +006600 77 COMMENT-SENTENCE PICTURE X(116) VALUE " ST109 HAS CREATED A ST1094.2 +006700- "FILE OF 40 VARIABLE-LENGTH-RECORDS. THESE RECORDS WILL BE SOST1094.2 +006800- "RTED IN ST110 AND CHECKED IN ST111.". ST1094.2 +006900 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1094.2 +007000 01 SHORT-WORK. ST1094.2 +007100 02 FILLER PICTURE XX VALUE "AA". ST1094.2 +007200 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1094.2 +007300 02 FILLER PICTURE X(38) VALUE "MIDDLE ONE-ONLY". ST1094.2 +007400 01 MEDIUM-WORK. ST1094.2 +007500 02 FILLER PICTURE XX VALUE "BB". ST1094.2 +007600 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1094.2 +007700 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-FIRST". ST1094.2 +007800 02 FILLER PICTURE X(25) VALUE ZERO. ST1094.2 +007900 01 LONG-WORK. ST1094.2 +008000 02 FILLER PICTURE XX VALUE "CC". ST1094.2 +008100 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1094.2 +008200 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-SECOND". ST1094.2 +008300 02 FILLER PICTURE X(50) VALUE QUOTE. ST1094.2 +008400 01 TEST-RESULTS. ST1094.2 +008500 02 FILLER PIC X VALUE SPACE. ST1094.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. ST1094.2 +008700 02 FILLER PIC X VALUE SPACE. ST1094.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. ST1094.2 +008900 02 FILLER PIC X VALUE SPACE. ST1094.2 +009000 02 PAR-NAME. ST1094.2 +009100 03 FILLER PIC X(19) VALUE SPACE. ST1094.2 +009200 03 PARDOT-X PIC X VALUE SPACE. ST1094.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. ST1094.2 +009400 02 FILLER PIC X(8) VALUE SPACE. ST1094.2 +009500 02 RE-MARK PIC X(61). ST1094.2 +009600 01 TEST-COMPUTED. ST1094.2 +009700 02 FILLER PIC X(30) VALUE SPACE. ST1094.2 +009800 02 FILLER PIC X(17) VALUE ST1094.2 +009900 " COMPUTED=". ST1094.2 +010000 02 COMPUTED-X. ST1094.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1094.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A ST1094.2 +010300 PIC -9(9).9(9). ST1094.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1094.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1094.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1094.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. ST1094.2 +010800 04 COMPUTED-18V0 PIC -9(18). ST1094.2 +010900 04 FILLER PIC X. ST1094.2 +011000 03 FILLER PIC X(50) VALUE SPACE. ST1094.2 +011100 01 TEST-CORRECT. ST1094.2 +011200 02 FILLER PIC X(30) VALUE SPACE. ST1094.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1094.2 +011400 02 CORRECT-X. ST1094.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1094.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1094.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1094.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1094.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1094.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. ST1094.2 +012100 04 CORRECT-18V0 PIC -9(18). ST1094.2 +012200 04 FILLER PIC X. ST1094.2 +012300 03 FILLER PIC X(2) VALUE SPACE. ST1094.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1094.2 +012500 01 CCVS-C-1. ST1094.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1094.2 +012700- "SS PARAGRAPH-NAME ST1094.2 +012800- " REMARKS". ST1094.2 +012900 02 FILLER PIC X(20) VALUE SPACE. ST1094.2 +013000 01 CCVS-C-2. ST1094.2 +013100 02 FILLER PIC X VALUE SPACE. ST1094.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". ST1094.2 +013300 02 FILLER PIC X(15) VALUE SPACE. ST1094.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". ST1094.2 +013500 02 FILLER PIC X(94) VALUE SPACE. ST1094.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1094.2 +013700 01 REC-CT PIC 99 VALUE ZERO. ST1094.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1094.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1094.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1094.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1094.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1094.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1094.2 +014700 01 CCVS-H-1. ST1094.2 +014800 02 FILLER PIC X(39) VALUE SPACES. ST1094.2 +014900 02 FILLER PIC X(42) VALUE ST1094.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1094.2 +015100 02 FILLER PIC X(39) VALUE SPACES. ST1094.2 +015200 01 CCVS-H-2A. ST1094.2 +015300 02 FILLER PIC X(40) VALUE SPACE. ST1094.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1094.2 +015500 02 FILLER PIC XXXX VALUE ST1094.2 +015600 "4.2 ". ST1094.2 +015700 02 FILLER PIC X(28) VALUE ST1094.2 +015800 " COPY - NOT FOR DISTRIBUTION". ST1094.2 +015900 02 FILLER PIC X(41) VALUE SPACE. ST1094.2 +016000 ST1094.2 +016100 01 CCVS-H-2B. ST1094.2 +016200 02 FILLER PIC X(15) VALUE ST1094.2 +016300 "TEST RESULT OF ". ST1094.2 +016400 02 TEST-ID PIC X(9). ST1094.2 +016500 02 FILLER PIC X(4) VALUE ST1094.2 +016600 " IN ". ST1094.2 +016700 02 FILLER PIC X(12) VALUE ST1094.2 +016800 " HIGH ". ST1094.2 +016900 02 FILLER PIC X(22) VALUE ST1094.2 +017000 " LEVEL VALIDATION FOR ". ST1094.2 +017100 02 FILLER PIC X(58) VALUE ST1094.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +017300 01 CCVS-H-3. ST1094.2 +017400 02 FILLER PIC X(34) VALUE ST1094.2 +017500 " FOR OFFICIAL USE ONLY ". ST1094.2 +017600 02 FILLER PIC X(58) VALUE ST1094.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1094.2 +017800 02 FILLER PIC X(28) VALUE ST1094.2 +017900 " COPYRIGHT 1985 ". ST1094.2 +018000 01 CCVS-E-1. ST1094.2 +018100 02 FILLER PIC X(52) VALUE SPACE. ST1094.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1094.2 +018300 02 ID-AGAIN PIC X(9). ST1094.2 +018400 02 FILLER PIC X(45) VALUE SPACES. ST1094.2 +018500 01 CCVS-E-2. ST1094.2 +018600 02 FILLER PIC X(31) VALUE SPACE. ST1094.2 +018700 02 FILLER PIC X(21) VALUE SPACE. ST1094.2 +018800 02 CCVS-E-2-2. ST1094.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1094.2 +019000 03 FILLER PIC X VALUE SPACE. ST1094.2 +019100 03 ENDER-DESC PIC X(44) VALUE ST1094.2 +019200 "ERRORS ENCOUNTERED". ST1094.2 +019300 01 CCVS-E-3. ST1094.2 +019400 02 FILLER PIC X(22) VALUE ST1094.2 +019500 " FOR OFFICIAL USE ONLY". ST1094.2 +019600 02 FILLER PIC X(12) VALUE SPACE. ST1094.2 +019700 02 FILLER PIC X(58) VALUE ST1094.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +019900 02 FILLER PIC X(13) VALUE SPACE. ST1094.2 +020000 02 FILLER PIC X(15) VALUE ST1094.2 +020100 " COPYRIGHT 1985". ST1094.2 +020200 01 CCVS-E-4. ST1094.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1094.2 +020400 02 FILLER PIC X(4) VALUE " OF ". ST1094.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1094.2 +020600 02 FILLER PIC X(40) VALUE ST1094.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1094.2 +020800 01 XXINFO. ST1094.2 +020900 02 FILLER PIC X(19) VALUE ST1094.2 +021000 "*** INFORMATION ***". ST1094.2 +021100 02 INFO-TEXT. ST1094.2 +021200 04 FILLER PIC X(8) VALUE SPACE. ST1094.2 +021300 04 XXCOMPUTED PIC X(20). ST1094.2 +021400 04 FILLER PIC X(5) VALUE SPACE. ST1094.2 +021500 04 XXCORRECT PIC X(20). ST1094.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). ST1094.2 +021700 01 HYPHEN-LINE. ST1094.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. ST1094.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************ST1094.2 +022000- "*****************************************". ST1094.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************ST1094.2 +022200- "******************************". ST1094.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE ST1094.2 +022400 "ST109A". ST1094.2 +022500 PROCEDURE DIVISION. ST1094.2 +022600 CCVS1 SECTION. ST1094.2 +022700 OPEN-FILES. ST1094.2 +022800 OPEN OUTPUT PRINT-FILE. ST1094.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1094.2 +023000 MOVE SPACE TO TEST-RESULTS. ST1094.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1094.2 +023200 GO TO CCVS1-EXIT. ST1094.2 +023300 CLOSE-FILES. ST1094.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1094.2 +023500 TERMINATE-CCVS. ST1094.2 +023600S EXIT PROGRAM. ST1094.2 +023700STERMINATE-CALL. ST1094.2 +023800 STOP RUN. ST1094.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1094.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1094.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1094.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1094.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. ST1094.2 +024400 PRINT-DETAIL. ST1094.2 +024500 IF REC-CT NOT EQUAL TO ZERO ST1094.2 +024600 MOVE "." TO PARDOT-X ST1094.2 +024700 MOVE REC-CT TO DOTVALUE. ST1094.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1094.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1094.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1094.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1094.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1094.2 +025300 MOVE SPACE TO CORRECT-X. ST1094.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1094.2 +025500 MOVE SPACE TO RE-MARK. ST1094.2 +025600 HEAD-ROUTINE. ST1094.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1094.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1094.2 +026100 COLUMN-NAMES-ROUTINE. ST1094.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +026500 END-ROUTINE. ST1094.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1094.2 +026700 END-RTN-EXIT. ST1094.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +026900 END-ROUTINE-1. ST1094.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1094.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1094.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. ST1094.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1094.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1094.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1094.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1094.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1094.2 +027800 END-ROUTINE-12. ST1094.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1094.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO ST1094.2 +028100 MOVE "NO " TO ERROR-TOTAL ST1094.2 +028200 ELSE ST1094.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1094.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1094.2 +028500 PERFORM WRITE-LINE. ST1094.2 +028600 END-ROUTINE-13. ST1094.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO ST1094.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE ST1094.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1094.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1094.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO ST1094.2 +029300 MOVE "NO " TO ERROR-TOTAL ST1094.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1094.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1094.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029800 WRITE-LINE. ST1094.2 +029900 ADD 1 TO RECORD-COUNT. ST1094.2 +030000Y IF RECORD-COUNT GREATER 42 ST1094.2 +030100Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1094.2 +030200Y MOVE SPACE TO DUMMY-RECORD ST1094.2 +030300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1094.2 +030400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1094.2 +030500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1094.2 +030600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1094.2 +030700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1094.2 +030800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +030900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +031000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +031100Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1094.2 +031200Y MOVE ZERO TO RECORD-COUNT. ST1094.2 +031300 PERFORM WRT-LN. ST1094.2 +031400 WRT-LN. ST1094.2 +031500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1094.2 +031600 MOVE SPACE TO DUMMY-RECORD. ST1094.2 +031700 BLANK-LINE-PRINT. ST1094.2 +031800 PERFORM WRT-LN. ST1094.2 +031900 FAIL-ROUTINE. ST1094.2 +032000 IF COMPUTED-X NOT EQUAL TO SPACE ST1094.2 +032100 GO TO FAIL-ROUTINE-WRITE. ST1094.2 +032200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1094.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1094.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1094.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1094.2 +032700 GO TO FAIL-ROUTINE-EX. ST1094.2 +032800 FAIL-ROUTINE-WRITE. ST1094.2 +032900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1094.2 +033000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1094.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1094.2 +033200 MOVE SPACES TO COR-ANSI-REFERENCE. ST1094.2 +033300 FAIL-ROUTINE-EX. EXIT. ST1094.2 +033400 BAIL-OUT. ST1094.2 +033500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1094.2 +033600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1094.2 +033700 BAIL-OUT-WRITE. ST1094.2 +033800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1094.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1094.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1094.2 +034200 BAIL-OUT-EX. EXIT. ST1094.2 +034300 CCVS1-EXIT. ST1094.2 +034400 EXIT. ST1094.2 +034500 ST109-0001-01. ST1094.2 +034600 OPEN OUTPUT SORTOUT-1I. ST1094.2 +034700 BUILD-LOOP. ST1094.2 +034800 MOVE MEDIUM-WORK TO MEDIUM-RECORD. ST1094.2 +034900 WRITE MEDIUM-RECORD. ST1094.2 +035000 ADD 1 TO UTIL-CTR. ST1094.2 +035100 IF UTIL-CTR GREATER 39 ST1094.2 +035200 GO TO ST109-0002-01. ST1094.2 +035300 MOVE LONG-WORK TO LONG-RECORD. ST1094.2 +035400 WRITE LONG-RECORD. ST1094.2 +035500 ADD 1 TO UTIL-CTR. ST1094.2 +035600 MOVE SHORT-WORK TO SHORT-RECORD. ST1094.2 +035700 WRITE SHORT-RECORD. ST1094.2 +035800 ADD 1 TO UTIL-CTR. ST1094.2 +035900 GO TO BUILD-LOOP. ST1094.2 +036000 ST109-0002-01. ST1094.2 +036100 MOVE SPACES TO TEST-RESULTS. ST1094.2 +036200 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1094.2 +036300 PERFORM PRINT-DETAIL. ST1094.2 +036400 MOVE SPACES TO TEST-RESULTS. ST1094.2 +036500 CLOSE SORTOUT-1I. ST1094.2 +036600 CCVS-EXIT SECTION. ST1094.2 +036700 CCVS-999999. ST1094.2 +036800 GO TO CLOSE-FILES. ST1094.2 +*END-OF,ST109A +*HEADER,COBOL,ST109A,SUBPRG,ST110A +000100 IDENTIFICATION DIVISION. ST1104.2 +000200 PROGRAM-ID. ST1104.2 +000300 ST110A. ST1104.2 +000400**************************************************************** ST1104.2 +000500* * ST1104.2 +000600* VALIDATION FOR:- * ST1104.2 +000700* * ST1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1104.2 +000900* * ST1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1104.2 +001100* * ST1104.2 +001200**************************************************************** ST1104.2 +001300* * ST1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1104.2 +001500* * ST1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1104.2 +001900* * ST1104.2 +002000**************************************************************** ST1104.2 +002100 ENVIRONMENT DIVISION. ST1104.2 +002200 CONFIGURATION SECTION. ST1104.2 +002300 SOURCE-COMPUTER. ST1104.2 +002400 XXXXX082. ST1104.2 +002500 OBJECT-COMPUTER. ST1104.2 +002600 XXXXX083. ST1104.2 +002700 INPUT-OUTPUT SECTION. ST1104.2 +002800 FILE-CONTROL. ST1104.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1104.2 +003000 XXXXX055. ST1104.2 +003100 SELECT SORTIN-1J ASSIGN TO ST1104.2 +003200 XXXXD001. ST1104.2 +003300 SELECT SORTOUT-1J ASSIGN TO ST1104.2 +003400 XXXXP002. ST1104.2 +003500 SELECT SORTFILE-1J ASSIGN TO ST1104.2 +003600 XXXXX027. ST1104.2 +003700 DATA DIVISION. ST1104.2 +003800 FILE SECTION. ST1104.2 +003900 FD PRINT-FILE. ST1104.2 +004000 01 PRINT-REC PICTURE X(120). ST1104.2 +004100 01 DUMMY-RECORD PICTURE X(120). ST1104.2 +004200 FD SORTIN-1J ST1104.2 +004300 LABEL RECORDS STANDARD ST1104.2 +004400C VALUE OF ST1104.2 +004500C XXXXX074 ST1104.2 +004600C IS ST1104.2 +004700C XXXXX075 ST1104.2 +004800G XXXXX069 ST1104.2 +004900 RECORD CONTAINS 50 TO 100 CHARACTERS ST1104.2 +005000 DATA RECORDS ARE SHORT-IN ST1104.2 +005100 MEDIUM-IN ST1104.2 +005200 LONG-IN. ST1104.2 +005300 01 SHORT-IN PICTURE X(50). ST1104.2 +005400 01 MEDIUM-IN PICTURE X(75). ST1104.2 +005500 01 LONG-IN. ST1104.2 +005600 02 FALSE-LENGTH-1 PICTURE X(25). ST1104.2 +005700 02 FALSE-LENGTH-2 PICTURE A(20). ST1104.2 +005800 02 FALSE-LENGTH-3 PICTURE 9(15). ST1104.2 +005900 02 FALSE-LENGTH-4 PICTURE X(40). ST1104.2 +006000 FD SORTOUT-1J ST1104.2 +006100 LABEL RECORDS ARE STANDARD ST1104.2 +006200C VALUE OF ST1104.2 +006300C XXXXX074 ST1104.2 +006400C IS ST1104.2 +006500C XXXXX076 ST1104.2 +006600G XXXXX069 ST1104.2 +006700 RECORD CONTAINS 50 TO 100 CHARACTERS ST1104.2 +006800 DATA RECORD SHORT-OUT ST1104.2 +006900 MEDIUM-OUT ST1104.2 +007000 LONG-OUT. ST1104.2 +007100 01 SHORT-OUT. ST1104.2 +007200 02 FAKE-LENGTH-1 PICTURE X(10). ST1104.2 +007300 02 FAKE-LENGTH-2 PICTURE A(10). ST1104.2 +007400 02 FAKE-LENGTH-3 PICTURE 9(10). ST1104.2 +007500 02 FAKE-LENGTH-4 PICTURE X(20). ST1104.2 +007600 01 MEDIUM-OUT PICTURE X(75). ST1104.2 +007700 01 LONG-OUT PICTURE X(100). ST1104.2 +007800 SD SORTFILE-1J ST1104.2 +007900 RECORD 50 TO 100 ST1104.2 +008000 DATA RECORD SHORT-SORT ST1104.2 +008100 MEDIUM-SORT ST1104.2 +008200 LONG-SORT. ST1104.2 +008300 01 SHORT-SORT. ST1104.2 +008400 02 SHORT-NON-KEY PICTURE XX. ST1104.2 +008500 02 SHORT-KEY-1 PICTURE X(10). ST1104.2 +008600 02 SHORT-KEY-2 PICTURE X(38). ST1104.2 +008700 01 MEDIUM-SORT. ST1104.2 +008800 02 MEDIUM-NON-KEY PICTURE XX. ST1104.2 +008900 02 MEDIUM-KEY-1 PICTURE X(10). ST1104.2 +009000 02 MEDIUM-KEY-2 PICTURE X(38). ST1104.2 +009100 02 MEDIUM-FILLER PICTURE X(25). ST1104.2 +009200 01 LONG-SORT. ST1104.2 +009300 02 LONG-NON-KEY PICTURE XX. ST1104.2 +009400 02 LONG-KEY-1 PICTURE X(10). ST1104.2 +009500 02 LONG-KEY-2 PICTURE X(38). ST1104.2 +009600 02 LONG-FILLER PICTURE X(50). ST1104.2 +009700 PROCEDURE DIVISION. ST1104.2 +009800 SORT-PARAGRAPH. ST1104.2 +009900 SORT SORTFILE-1J ST1104.2 +010000 DESCENDING KEY ST1104.2 +010100 MEDIUM-KEY-1 ST1104.2 +010200 MEDIUM-KEY-2 ST1104.2 +010300 USING SORTIN-1J ST1104.2 +010400 GIVING SORTOUT-1J. ST1104.2 +010500 STOP RUN. ST1104.2 +*END-OF,ST110A +*HEADER,COBOL,ST109A,SUBPRG,ST111A +000100 IDENTIFICATION DIVISION. ST1114.2 +000200 PROGRAM-ID. ST1114.2 +000300 ST111A. ST1114.2 +000400**************************************************************** ST1114.2 +000500* * ST1114.2 +000600* VALIDATION FOR:- * ST1114.2 +000700* * ST1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +000900* * ST1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1114.2 +001100* * ST1114.2 +001200**************************************************************** ST1114.2 +001300* * ST1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1114.2 +001500* * ST1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1114.2 +001900* * ST1114.2 +002000**************************************************************** ST1114.2 +002100* ST111 CHECKS THE OUTPUT FROM ST110. WHICH IN TURN USED INPUT ST1114.2 +002200* FROM ST109. 40 VARIABLE-LENGTH RECORDS HAVE BEEN SORTED AND ST1114.2 +002300* SHOULD APPEAR AS SHOWN ST1114.2 +002400* NON-KEY KEY-1 KEY-2 FILLER ST1114.2 +002500* X(2) X(10) X(38) ST1114.2 +002600* ST1114.2 +002700* FIRST 13 RECORDS --- ST1114.2 +002800* "CC""LOWEST TWO""MIDDLE TWO-SECOND" X(50) VALUE QUOTEST1114.2 +002900* NEXT 14 RECORDS --- ST1114.2 +003000* "BB""LOWEST TWO""MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1114.2 +003100* LAST 13 RECORDS --- ST1114.2 +003200* "AA""LOWEST ONE""MIDDLE ONE-ONLY" (NONE) ST1114.2 +003300 ST1114.2 +003400 ENVIRONMENT DIVISION. ST1114.2 +003500 CONFIGURATION SECTION. ST1114.2 +003600 SOURCE-COMPUTER. ST1114.2 +003700 XXXXX082. ST1114.2 +003800 OBJECT-COMPUTER. ST1114.2 +003900 XXXXX083. ST1114.2 +004000 INPUT-OUTPUT SECTION. ST1114.2 +004100 FILE-CONTROL. ST1114.2 +004200 SELECT PRINT-FILE ASSIGN TO ST1114.2 +004300 XXXXX055. ST1114.2 +004400 SELECT SORTIN-1K ASSIGN TO ST1114.2 +004500 XXXXP002. ST1114.2 +004600 DATA DIVISION. ST1114.2 +004700 FILE SECTION. ST1114.2 +004800 FD PRINT-FILE. ST1114.2 +004900 01 PRINT-REC PICTURE X(120). ST1114.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1114.2 +005100 FD SORTIN-1K ST1114.2 +005200 LABEL RECORDS STANDARD ST1114.2 +005300C VALUE OF ST1114.2 +005400C XXXXX074 ST1114.2 +005500C IS ST1114.2 +005600C XXXXX076 ST1114.2 +005700G XXXXX069 ST1114.2 +005800 RECORD CONTAINS 50 TO 100 CHARACTERS ST1114.2 +005900 DATA RECORDS ARE SHORT-RECORD ST1114.2 +006000 MEDIUM-RECORD ST1114.2 +006100 LONG-RECORD. ST1114.2 +006200 01 SHORT-RECORD PICTURE X(50). ST1114.2 +006300 01 MEDIUM-RECORD PICTURE X(75). ST1114.2 +006400 01 LONG-RECORD PICTURE X(100). ST1114.2 +006500 WORKING-STORAGE SECTION. ST1114.2 +006600 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1114.2 +006700 01 SHORT-WORK. ST1114.2 +006800 02 FILLER PICTURE XX VALUE "AA". ST1114.2 +006900 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1114.2 +007000 02 FILLER PICTURE X(38) ST1114.2 +007100 VALUE "MIDDLE ONE-ONLY ". ST1114.2 +007200 01 MEDIUM-WORK. ST1114.2 +007300 02 FILLER PICTURE XX VALUE "BB". ST1114.2 +007400 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1114.2 +007500 02 FILLER PICTURE X(38) ST1114.2 +007600 VALUE "MIDDLE TWO-FIRST ". ST1114.2 +007700 02 FILLER PICTURE X(25) VALUE ZERO. ST1114.2 +007800 01 LONG-WORK. ST1114.2 +007900 02 FILLER PICTURE XX VALUE "CC". ST1114.2 +008000 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1114.2 +008100 02 FILLER PICTURE X(38) ST1114.2 +008200 VALUE "MIDDLE TWO-SECOND ". ST1114.2 +008300 02 FILLER PICTURE X(50) VALUE QUOTE. ST1114.2 +008400 01 BREAKDOWN-LIMIT PICTURE 999. ST1114.2 +008500 01 COMPUTED-BREAKDOWN. ST1114.2 +008600 02 FIRST-20-CM PICTURE X(20). ST1114.2 +008700 02 SECOND-20-CM PICTURE X(20). ST1114.2 +008800 02 THIRD-20-CM PICTURE X(20). ST1114.2 +008900 02 FOURTH-20-CM PICTURE X(20). ST1114.2 +009000 02 FIFTH-20-CM PICTURE X(20). ST1114.2 +009100 01 CORRECT-BREAKDOWN. ST1114.2 +009200 02 FIRST-20-CR PICTURE X(20). ST1114.2 +009300 02 SECOND-20-CR PICTURE X(20). ST1114.2 +009400 02 THIRD-20-CR PICTURE X(20). ST1114.2 +009500 02 FOURTH-20-CR PICTURE X(20). ST1114.2 +009600 02 FIFTH-20-CR PICTURE X(20). ST1114.2 +009700 01 TEST-RESULTS. ST1114.2 +009800 02 FILLER PIC X VALUE SPACE. ST1114.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. ST1114.2 +010000 02 FILLER PIC X VALUE SPACE. ST1114.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. ST1114.2 +010200 02 FILLER PIC X VALUE SPACE. ST1114.2 +010300 02 PAR-NAME. ST1114.2 +010400 03 FILLER PIC X(19) VALUE SPACE. ST1114.2 +010500 03 PARDOT-X PIC X VALUE SPACE. ST1114.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. ST1114.2 +010700 02 FILLER PIC X(8) VALUE SPACE. ST1114.2 +010800 02 RE-MARK PIC X(61). ST1114.2 +010900 01 TEST-COMPUTED. ST1114.2 +011000 02 FILLER PIC X(30) VALUE SPACE. ST1114.2 +011100 02 FILLER PIC X(17) VALUE ST1114.2 +011200 " COMPUTED=". ST1114.2 +011300 02 COMPUTED-X. ST1114.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1114.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A ST1114.2 +011600 PIC -9(9).9(9). ST1114.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1114.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1114.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1114.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. ST1114.2 +012100 04 COMPUTED-18V0 PIC -9(18). ST1114.2 +012200 04 FILLER PIC X. ST1114.2 +012300 03 FILLER PIC X(50) VALUE SPACE. ST1114.2 +012400 01 TEST-CORRECT. ST1114.2 +012500 02 FILLER PIC X(30) VALUE SPACE. ST1114.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". ST1114.2 +012700 02 CORRECT-X. ST1114.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. ST1114.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1114.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1114.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1114.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1114.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. ST1114.2 +013400 04 CORRECT-18V0 PIC -9(18). ST1114.2 +013500 04 FILLER PIC X. ST1114.2 +013600 03 FILLER PIC X(2) VALUE SPACE. ST1114.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1114.2 +013800 01 CCVS-C-1. ST1114.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1114.2 +014000- "SS PARAGRAPH-NAME ST1114.2 +014100- " REMARKS". ST1114.2 +014200 02 FILLER PIC X(20) VALUE SPACE. ST1114.2 +014300 01 CCVS-C-2. ST1114.2 +014400 02 FILLER PIC X VALUE SPACE. ST1114.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". ST1114.2 +014600 02 FILLER PIC X(15) VALUE SPACE. ST1114.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". ST1114.2 +014800 02 FILLER PIC X(94) VALUE SPACE. ST1114.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1114.2 +015000 01 REC-CT PIC 99 VALUE ZERO. ST1114.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1114.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1114.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1114.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1114.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1114.2 +016000 01 CCVS-H-1. ST1114.2 +016100 02 FILLER PIC X(39) VALUE SPACES. ST1114.2 +016200 02 FILLER PIC X(42) VALUE ST1114.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1114.2 +016400 02 FILLER PIC X(39) VALUE SPACES. ST1114.2 +016500 01 CCVS-H-2A. ST1114.2 +016600 02 FILLER PIC X(40) VALUE SPACE. ST1114.2 +016700 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1114.2 +016800 02 FILLER PIC XXXX VALUE ST1114.2 +016900 "4.2 ". ST1114.2 +017000 02 FILLER PIC X(28) VALUE ST1114.2 +017100 " COPY - NOT FOR DISTRIBUTION". ST1114.2 +017200 02 FILLER PIC X(41) VALUE SPACE. ST1114.2 +017300 ST1114.2 +017400 01 CCVS-H-2B. ST1114.2 +017500 02 FILLER PIC X(15) VALUE ST1114.2 +017600 "TEST RESULT OF ". ST1114.2 +017700 02 TEST-ID PIC X(9). ST1114.2 +017800 02 FILLER PIC X(4) VALUE ST1114.2 +017900 " IN ". ST1114.2 +018000 02 FILLER PIC X(12) VALUE ST1114.2 +018100 " HIGH ". ST1114.2 +018200 02 FILLER PIC X(22) VALUE ST1114.2 +018300 " LEVEL VALIDATION FOR ". ST1114.2 +018400 02 FILLER PIC X(58) VALUE ST1114.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +018600 01 CCVS-H-3. ST1114.2 +018700 02 FILLER PIC X(34) VALUE ST1114.2 +018800 " FOR OFFICIAL USE ONLY ". ST1114.2 +018900 02 FILLER PIC X(58) VALUE ST1114.2 +019000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1114.2 +019100 02 FILLER PIC X(28) VALUE ST1114.2 +019200 " COPYRIGHT 1985 ". ST1114.2 +019300 01 CCVS-E-1. ST1114.2 +019400 02 FILLER PIC X(52) VALUE SPACE. ST1114.2 +019500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1114.2 +019600 02 ID-AGAIN PIC X(9). ST1114.2 +019700 02 FILLER PIC X(45) VALUE SPACES. ST1114.2 +019800 01 CCVS-E-2. ST1114.2 +019900 02 FILLER PIC X(31) VALUE SPACE. ST1114.2 +020000 02 FILLER PIC X(21) VALUE SPACE. ST1114.2 +020100 02 CCVS-E-2-2. ST1114.2 +020200 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1114.2 +020300 03 FILLER PIC X VALUE SPACE. ST1114.2 +020400 03 ENDER-DESC PIC X(44) VALUE ST1114.2 +020500 "ERRORS ENCOUNTERED". ST1114.2 +020600 01 CCVS-E-3. ST1114.2 +020700 02 FILLER PIC X(22) VALUE ST1114.2 +020800 " FOR OFFICIAL USE ONLY". ST1114.2 +020900 02 FILLER PIC X(12) VALUE SPACE. ST1114.2 +021000 02 FILLER PIC X(58) VALUE ST1114.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +021200 02 FILLER PIC X(13) VALUE SPACE. ST1114.2 +021300 02 FILLER PIC X(15) VALUE ST1114.2 +021400 " COPYRIGHT 1985". ST1114.2 +021500 01 CCVS-E-4. ST1114.2 +021600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1114.2 +021700 02 FILLER PIC X(4) VALUE " OF ". ST1114.2 +021800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1114.2 +021900 02 FILLER PIC X(40) VALUE ST1114.2 +022000 " TESTS WERE EXECUTED SUCCESSFULLY". ST1114.2 +022100 01 XXINFO. ST1114.2 +022200 02 FILLER PIC X(19) VALUE ST1114.2 +022300 "*** INFORMATION ***". ST1114.2 +022400 02 INFO-TEXT. ST1114.2 +022500 04 FILLER PIC X(8) VALUE SPACE. ST1114.2 +022600 04 XXCOMPUTED PIC X(20). ST1114.2 +022700 04 FILLER PIC X(5) VALUE SPACE. ST1114.2 +022800 04 XXCORRECT PIC X(20). ST1114.2 +022900 02 INF-ANSI-REFERENCE PIC X(48). ST1114.2 +023000 01 HYPHEN-LINE. ST1114.2 +023100 02 FILLER PIC IS X VALUE IS SPACE. ST1114.2 +023200 02 FILLER PIC IS X(65) VALUE IS "************************ST1114.2 +023300- "*****************************************". ST1114.2 +023400 02 FILLER PIC IS X(54) VALUE IS "************************ST1114.2 +023500- "******************************". ST1114.2 +023600 01 CCVS-PGM-ID PIC X(9) VALUE ST1114.2 +023700 "ST111A". ST1114.2 +023800 PROCEDURE DIVISION. ST1114.2 +023900 CCVS1 SECTION. ST1114.2 +024000 OPEN-FILES. ST1114.2 +024100 OPEN OUTPUT PRINT-FILE. ST1114.2 +024200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1114.2 +024300 MOVE SPACE TO TEST-RESULTS. ST1114.2 +024400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1114.2 +024500 GO TO CCVS1-EXIT. ST1114.2 +024600 CLOSE-FILES. ST1114.2 +024700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1114.2 +024800 TERMINATE-CCVS. ST1114.2 +024900S EXIT PROGRAM. ST1114.2 +025000STERMINATE-CALL. ST1114.2 +025100 STOP RUN. ST1114.2 +025200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1114.2 +025300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1114.2 +025400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1114.2 +025500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1114.2 +025600 MOVE "****TEST DELETED****" TO RE-MARK. ST1114.2 +025700 PRINT-DETAIL. ST1114.2 +025800 IF REC-CT NOT EQUAL TO ZERO ST1114.2 +025900 MOVE "." TO PARDOT-X ST1114.2 +026000 MOVE REC-CT TO DOTVALUE. ST1114.2 +026100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1114.2 +026200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1114.2 +026300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1114.2 +026400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1114.2 +026500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1114.2 +026600 MOVE SPACE TO CORRECT-X. ST1114.2 +026700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1114.2 +026800 MOVE SPACE TO RE-MARK. ST1114.2 +026900 HEAD-ROUTINE. ST1114.2 +027000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1114.2 +027300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1114.2 +027400 COLUMN-NAMES-ROUTINE. ST1114.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +027800 END-ROUTINE. ST1114.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1114.2 +028000 END-RTN-EXIT. ST1114.2 +028100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +028200 END-ROUTINE-1. ST1114.2 +028300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1114.2 +028400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1114.2 +028500 ADD PASS-COUNTER TO ERROR-HOLD. ST1114.2 +028600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1114.2 +028700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1114.2 +028800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1114.2 +028900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1114.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1114.2 +029100 END-ROUTINE-12. ST1114.2 +029200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1114.2 +029300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1114.2 +029400 MOVE "NO " TO ERROR-TOTAL ST1114.2 +029500 ELSE ST1114.2 +029600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1114.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1114.2 +029800 PERFORM WRITE-LINE. ST1114.2 +029900 END-ROUTINE-13. ST1114.2 +030000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1114.2 +030100 MOVE "NO " TO ERROR-TOTAL ELSE ST1114.2 +030200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1114.2 +030300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1114.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +030500 IF INSPECT-COUNTER EQUAL TO ZERO ST1114.2 +030600 MOVE "NO " TO ERROR-TOTAL ST1114.2 +030700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1114.2 +030800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1114.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +031000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +031100 WRITE-LINE. ST1114.2 +031200 ADD 1 TO RECORD-COUNT. ST1114.2 +031300Y IF RECORD-COUNT GREATER 42 ST1114.2 +031400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1114.2 +031500Y MOVE SPACE TO DUMMY-RECORD ST1114.2 +031600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1114.2 +031700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1114.2 +031800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1114.2 +031900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1114.2 +032000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1114.2 +032100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1114.2 +032500Y MOVE ZERO TO RECORD-COUNT. ST1114.2 +032600 PERFORM WRT-LN. ST1114.2 +032700 WRT-LN. ST1114.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1114.2 +032900 MOVE SPACE TO DUMMY-RECORD. ST1114.2 +033000 BLANK-LINE-PRINT. ST1114.2 +033100 PERFORM WRT-LN. ST1114.2 +033200 FAIL-ROUTINE. ST1114.2 +033300 IF COMPUTED-X NOT EQUAL TO SPACE ST1114.2 +033400 GO TO FAIL-ROUTINE-WRITE. ST1114.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1114.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1114.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1114.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1114.2 +034000 GO TO FAIL-ROUTINE-EX. ST1114.2 +034100 FAIL-ROUTINE-WRITE. ST1114.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1114.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1114.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1114.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1114.2 +034600 FAIL-ROUTINE-EX. EXIT. ST1114.2 +034700 BAIL-OUT. ST1114.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1114.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1114.2 +035000 BAIL-OUT-WRITE. ST1114.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1114.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1114.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1114.2 +035500 BAIL-OUT-EX. EXIT. ST1114.2 +035600 CCVS1-EXIT. ST1114.2 +035700 EXIT. ST1114.2 +035800 SECT-ST111-0001 SECTION. ST1114.2 +035900 ST111-0001-01. ST1114.2 +036000 OPEN INPUT SORTIN-1K. ST1114.2 +036100 MOVE " ***** ST110 DOES NOT PRODUCE A PRINTED REPORT ***ST1114.2 +036200- "**" TO TEST-RESULTS. ST1114.2 +036300 PERFORM PRINT-DETAIL. ST1114.2 +036400 MOVE SPACE TO TEST-RESULTS. ST1114.2 +036500 PERFORM END-ROUTINE. ST1114.2 +036600 MOVE "SORT VARIABLE RECORD" TO FEATURE. ST1114.2 +036700 SORT-TEST-1. ST1114.2 +036800 MOVE "SORT-TEST-1" TO PAR-NAME. ST1114.2 +036900 PERFORM READ-SORTIN. ST1114.2 +037000 IF LONG-RECORD EQUAL TO LONG-WORK ST1114.2 +037100 PERFORM PASS GO TO SORT-WRITE-1. ST1114.2 +037200* NOTE FIRST RECORD. ST1114.2 +037300 SORT-FAIL-1. ST1114.2 +037400 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +037500 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +037600 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1114.2 +037700 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +037800 SORT-WRITE-1. ST1114.2 +037900 PERFORM PRINT-DETAIL. ST1114.2 +038000 SORT-TEST-2. ST1114.2 +038100 MOVE "SORT-TEST-2" TO PAR-NAME. ST1114.2 +038200 PERFORM READ-SORTIN 12 TIMES. ST1114.2 +038300 IF LONG-RECORD EQUAL TO LONG-WORK ST1114.2 +038400 PERFORM PASS GO TO SORT-WRITE-2. ST1114.2 +038500* NOTE THIRTEENTH RECORD. ST1114.2 +038600 SORT-FAIL-2. ST1114.2 +038700 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +038800 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +038900 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1114.2 +039000 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +039100 SORT-WRITE-2. ST1114.2 +039200 PERFORM PRINT-DETAIL. ST1114.2 +039300 SORT-TEST-3. ST1114.2 +039400 MOVE "SORT-TEST-3" TO PAR-NAME. ST1114.2 +039500 PERFORM READ-SORTIN. ST1114.2 +039600 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1114.2 +039700 PERFORM PASS GO TO SORT-WRITE-3. ST1114.2 +039800* NOTE FOURTEENTH RECORD. ST1114.2 +039900 SORT-FAIL-3. ST1114.2 +040000 MOVE 75 TO BREAKDOWN-LIMIT. ST1114.2 +040100 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +040200 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1114.2 +040300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +040400 SORT-WRITE-3. ST1114.2 +040500 PERFORM PRINT-DETAIL. ST1114.2 +040600 SORT-TEST-4. ST1114.2 +040700 MOVE "SORT-TEST-4" TO PAR-NAME. ST1114.2 +040800 PERFORM READ-SORTIN 13 TIMES. ST1114.2 +040900 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1114.2 +041000 PERFORM PASS GO TO SORT-WRITE-4. ST1114.2 +041100* NOTE TWENTY-SEVENTH RECORD. ST1114.2 +041200 SORT-FAIL-4. ST1114.2 +041300 MOVE 75 TO BREAKDOWN-LIMIT. ST1114.2 +041400 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +041500 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1114.2 +041600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +041700 SORT-WRITE-4. ST1114.2 +041800 PERFORM PRINT-DETAIL. ST1114.2 +041900 SORT-TEST-5. ST1114.2 +042000 MOVE "SORT-TEST-5" TO PAR-NAME. ST1114.2 +042100 PERFORM READ-SORTIN. ST1114.2 +042200 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1114.2 +042300 PERFORM PASS GO TO SORT-WRITE-5. ST1114.2 +042400* NOTE TWENTY-EIGHTH RECORD. ST1114.2 +042500 SORT-FAIL-5. ST1114.2 +042600 MOVE 50 TO BREAKDOWN-LIMIT. ST1114.2 +042700 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +042800 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1114.2 +042900 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +043000 SORT-WRITE-5. ST1114.2 +043100 PERFORM PRINT-DETAIL. ST1114.2 +043200 SORT-TEST-6. ST1114.2 +043300 MOVE "SORT-TEST-6" TO PAR-NAME. ST1114.2 +043400 PERFORM READ-SORTIN 12 TIMES. ST1114.2 +043500 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1114.2 +043600 PERFORM PASS GO TO SORT-WRITE-6. ST1114.2 +043700* NOTE FORTIETH RECORD. ST1114.2 +043800 SORT-FAIL-6. ST1114.2 +043900 MOVE 50 TO BREAKDOWN-LIMIT. ST1114.2 +044000 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +044100 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1114.2 +044200 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +044300 SORT-WRITE-6. ST1114.2 +044400 PERFORM PRINT-DETAIL. ST1114.2 +044500 SORT-TEST-7. ST1114.2 +044600 MOVE "SORT-TEST-7" TO PAR-NAME. ST1114.2 +044700 READ SORTIN-1K AT END ST1114.2 +044800 PERFORM PASS GO TO SORT-WRITE-7. ST1114.2 +044900 SORT-FAIL-7. ST1114.2 +045000 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +045100 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +045200 MOVE SPACE TO CORRECT-BREAKDOWN. ST1114.2 +045300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +045400 PERFORM PRINT-DETAIL. ST1114.2 +045500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1114.2 +045600 SORT-WRITE-7. ST1114.2 +045700 PERFORM PRINT-DETAIL. ST1114.2 +045800 CLOSE SORTIN-1K. ST1114.2 +045900 GO TO CCVS-EXIT. ST1114.2 +046000 BREAKDOWN-PARA. ST1114.2 +046100 PERFORM FAIL. ST1114.2 +046200 MOVE FIRST-20-CM TO COMPUTED-A. ST1114.2 +046300 MOVE FIRST-20-CR TO CORRECT-A. ST1114.2 +046400 MOVE "FIRST TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +046500 PERFORM PRINT-DETAIL. ST1114.2 +046600 MOVE SECOND-20-CM TO COMPUTED-A. ST1114.2 +046700 MOVE SECOND-20-CR TO CORRECT-A. ST1114.2 +046800 MOVE "SECOND TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +046900 PERFORM PRINT-DETAIL. ST1114.2 +047000 MOVE THIRD-20-CM TO COMPUTED-A. ST1114.2 +047100 MOVE THIRD-20-CR TO CORRECT-A. ST1114.2 +047200 MOVE "THIRD TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +047300 PERFORM PRINT-DETAIL. ST1114.2 +047400 IF BREAKDOWN-LIMIT LESS THAN 61 GO TO BREAKDOWN-EXIT. ST1114.2 +047500 MOVE FOURTH-20-CM TO COMPUTED-A. ST1114.2 +047600 MOVE FOURTH-20-CR TO CORRECT-A. ST1114.2 +047700 MOVE "FOURTH TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +047800 PERFORM PRINT-DETAIL. ST1114.2 +047900 IF BREAKDOWN-LIMIT LESS THAN 81 GO TO BREAKDOWN-EXIT. ST1114.2 +048000 MOVE FIFTH-20-CM TO COMPUTED-A. ST1114.2 +048100 MOVE FIFTH-20-CR TO CORRECT-A. ST1114.2 +048200 MOVE "FIFTH TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +048300 BREAKDOWN-EXIT. ST1114.2 +048400 EXIT. ST1114.2 +048500 READ-SORTIN. ST1114.2 +048600 READ SORTIN-1K AT END GO TO READ-ERROR. ST1114.2 +048700 ADD 1 TO UTIL-CTR. ST1114.2 +048800 READ-ERROR. ST1114.2 +048900 MOVE UTIL-CTR TO COMPUTED-N. ST1114.2 +049000 MOVE 40 TO CORRECT-N. ST1114.2 +049100 MOVE "TOO FEW INPUT RECORDS" TO RE-MARK. ST1114.2 +049200 MOVE "READ-SORTIN" TO PAR-NAME. ST1114.2 +049300 PERFORM FAIL. ST1114.2 +049400 PERFORM PRINT-DETAIL. ST1114.2 +049500 CCVS-EXIT SECTION. ST1114.2 +049600 CCVS-999999. ST1114.2 +049700 GO TO CLOSE-FILES. ST1114.2 +*END-OF,ST111A +*HEADER,COBOL,ST112M +000100 IDENTIFICATION DIVISION. ST1124.2 +000200 PROGRAM-ID. ST1124.2 +000300 ST112M. ST1124.2 +000400**************************************************************** ST1124.2 +000500* * ST1124.2 +000600* VALIDATION FOR:- * ST1124.2 +000700* * ST1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +000900* * ST1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1124.2 +001100* * ST1124.2 +001200**************************************************************** ST1124.2 +001300* * ST1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1124.2 +001500* * ST1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1124.2 +001900* * ST1124.2 +002000**************************************************************** ST1124.2 +002100 ENVIRONMENT DIVISION. ST1124.2 +002200 CONFIGURATION SECTION. ST1124.2 +002300 SOURCE-COMPUTER. ST1124.2 +002400 XXXXX082. ST1124.2 +002500 OBJECT-COMPUTER. ST1124.2 +002600 XXXXX083. ST1124.2 +002700 INPUT-OUTPUT SECTION. ST1124.2 +002800 FILE-CONTROL. ST1124.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1124.2 +003000 XXXXX055. ST1124.2 +003100 SELECT SORTOUT-1L ASSIGN TO ST1124.2 +003200 XXXXD006. ST1124.2 +003300 DATA DIVISION. ST1124.2 +003400 FILE SECTION. ST1124.2 +003500 FD PRINT-FILE. ST1124.2 +003600 01 PRINT-REC PICTURE X(120). ST1124.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1124.2 +003800 FD SORTOUT-1L ST1124.2 +003900 LABEL RECORDS STANDARD ST1124.2 +004000C VALUE OF ST1124.2 +004100C XXXXX074 ST1124.2 +004200C IS ST1124.2 +004300C XXXXX079 ST1124.2 +004400G XXXXX069 ST1124.2 +004500 DATA RECORD IS SORT-KEY. ST1124.2 +004600 01 SORT-KEY PIC X(33). ST1124.2 +004700 WORKING-STORAGE SECTION. ST1124.2 +004800 77 UTIL-CTR PIC S99999 VALUE ZERO. ST1124.2 +004900 77 COMMENT-SENTENCE PICTURE X(118) VALUE "ST112M HAS CREATED A ST1124.2 +005000- "3-REEL FILE WHICH WILL BE PASSED TO ST113 FOR SORTING. THIS ST1124.2 +005100- "COMMENT IS THE ONLY OUTPUT FOR ST112". ST1124.2 +005200 01 TEST-RESULTS. ST1124.2 +005300 02 FILLER PIC X VALUE SPACE. ST1124.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. ST1124.2 +005500 02 FILLER PIC X VALUE SPACE. ST1124.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. ST1124.2 +005700 02 FILLER PIC X VALUE SPACE. ST1124.2 +005800 02 PAR-NAME. ST1124.2 +005900 03 FILLER PIC X(19) VALUE SPACE. ST1124.2 +006000 03 PARDOT-X PIC X VALUE SPACE. ST1124.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. ST1124.2 +006200 02 FILLER PIC X(8) VALUE SPACE. ST1124.2 +006300 02 RE-MARK PIC X(61). ST1124.2 +006400 01 TEST-COMPUTED. ST1124.2 +006500 02 FILLER PIC X(30) VALUE SPACE. ST1124.2 +006600 02 FILLER PIC X(17) VALUE ST1124.2 +006700 " COMPUTED=". ST1124.2 +006800 02 COMPUTED-X. ST1124.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1124.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A ST1124.2 +007100 PIC -9(9).9(9). ST1124.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1124.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1124.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1124.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. ST1124.2 +007600 04 COMPUTED-18V0 PIC -9(18). ST1124.2 +007700 04 FILLER PIC X. ST1124.2 +007800 03 FILLER PIC X(50) VALUE SPACE. ST1124.2 +007900 01 TEST-CORRECT. ST1124.2 +008000 02 FILLER PIC X(30) VALUE SPACE. ST1124.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1124.2 +008200 02 CORRECT-X. ST1124.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1124.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1124.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1124.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1124.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1124.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. ST1124.2 +008900 04 CORRECT-18V0 PIC -9(18). ST1124.2 +009000 04 FILLER PIC X. ST1124.2 +009100 03 FILLER PIC X(2) VALUE SPACE. ST1124.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1124.2 +009300 01 CCVS-C-1. ST1124.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1124.2 +009500- "SS PARAGRAPH-NAME ST1124.2 +009600- " REMARKS". ST1124.2 +009700 02 FILLER PIC X(20) VALUE SPACE. ST1124.2 +009800 01 CCVS-C-2. ST1124.2 +009900 02 FILLER PIC X VALUE SPACE. ST1124.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". ST1124.2 +010100 02 FILLER PIC X(15) VALUE SPACE. ST1124.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". ST1124.2 +010300 02 FILLER PIC X(94) VALUE SPACE. ST1124.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1124.2 +010500 01 REC-CT PIC 99 VALUE ZERO. ST1124.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1124.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1124.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1124.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1124.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1124.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1124.2 +011500 01 CCVS-H-1. ST1124.2 +011600 02 FILLER PIC X(39) VALUE SPACES. ST1124.2 +011700 02 FILLER PIC X(42) VALUE ST1124.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1124.2 +011900 02 FILLER PIC X(39) VALUE SPACES. ST1124.2 +012000 01 CCVS-H-2A. ST1124.2 +012100 02 FILLER PIC X(40) VALUE SPACE. ST1124.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1124.2 +012300 02 FILLER PIC XXXX VALUE ST1124.2 +012400 "4.2 ". ST1124.2 +012500 02 FILLER PIC X(28) VALUE ST1124.2 +012600 " COPY - NOT FOR DISTRIBUTION". ST1124.2 +012700 02 FILLER PIC X(41) VALUE SPACE. ST1124.2 +012800 ST1124.2 +012900 01 CCVS-H-2B. ST1124.2 +013000 02 FILLER PIC X(15) VALUE ST1124.2 +013100 "TEST RESULT OF ". ST1124.2 +013200 02 TEST-ID PIC X(9). ST1124.2 +013300 02 FILLER PIC X(4) VALUE ST1124.2 +013400 " IN ". ST1124.2 +013500 02 FILLER PIC X(12) VALUE ST1124.2 +013600 " HIGH ". ST1124.2 +013700 02 FILLER PIC X(22) VALUE ST1124.2 +013800 " LEVEL VALIDATION FOR ". ST1124.2 +013900 02 FILLER PIC X(58) VALUE ST1124.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +014100 01 CCVS-H-3. ST1124.2 +014200 02 FILLER PIC X(34) VALUE ST1124.2 +014300 " FOR OFFICIAL USE ONLY ". ST1124.2 +014400 02 FILLER PIC X(58) VALUE ST1124.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1124.2 +014600 02 FILLER PIC X(28) VALUE ST1124.2 +014700 " COPYRIGHT 1985 ". ST1124.2 +014800 01 CCVS-E-1. ST1124.2 +014900 02 FILLER PIC X(52) VALUE SPACE. ST1124.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1124.2 +015100 02 ID-AGAIN PIC X(9). ST1124.2 +015200 02 FILLER PIC X(45) VALUE SPACES. ST1124.2 +015300 01 CCVS-E-2. ST1124.2 +015400 02 FILLER PIC X(31) VALUE SPACE. ST1124.2 +015500 02 FILLER PIC X(21) VALUE SPACE. ST1124.2 +015600 02 CCVS-E-2-2. ST1124.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1124.2 +015800 03 FILLER PIC X VALUE SPACE. ST1124.2 +015900 03 ENDER-DESC PIC X(44) VALUE ST1124.2 +016000 "ERRORS ENCOUNTERED". ST1124.2 +016100 01 CCVS-E-3. ST1124.2 +016200 02 FILLER PIC X(22) VALUE ST1124.2 +016300 " FOR OFFICIAL USE ONLY". ST1124.2 +016400 02 FILLER PIC X(12) VALUE SPACE. ST1124.2 +016500 02 FILLER PIC X(58) VALUE ST1124.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +016700 02 FILLER PIC X(13) VALUE SPACE. ST1124.2 +016800 02 FILLER PIC X(15) VALUE ST1124.2 +016900 " COPYRIGHT 1985". ST1124.2 +017000 01 CCVS-E-4. ST1124.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1124.2 +017200 02 FILLER PIC X(4) VALUE " OF ". ST1124.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1124.2 +017400 02 FILLER PIC X(40) VALUE ST1124.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1124.2 +017600 01 XXINFO. ST1124.2 +017700 02 FILLER PIC X(19) VALUE ST1124.2 +017800 "*** INFORMATION ***". ST1124.2 +017900 02 INFO-TEXT. ST1124.2 +018000 04 FILLER PIC X(8) VALUE SPACE. ST1124.2 +018100 04 XXCOMPUTED PIC X(20). ST1124.2 +018200 04 FILLER PIC X(5) VALUE SPACE. ST1124.2 +018300 04 XXCORRECT PIC X(20). ST1124.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). ST1124.2 +018500 01 HYPHEN-LINE. ST1124.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. ST1124.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************ST1124.2 +018800- "*****************************************". ST1124.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************ST1124.2 +019000- "******************************". ST1124.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE ST1124.2 +019200 "ST112M". ST1124.2 +019300 PROCEDURE DIVISION. ST1124.2 +019400 CCVS1 SECTION. ST1124.2 +019500 OPEN-FILES. ST1124.2 +019600 OPEN OUTPUT PRINT-FILE. ST1124.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1124.2 +019800 MOVE SPACE TO TEST-RESULTS. ST1124.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1124.2 +020000 GO TO CCVS1-EXIT. ST1124.2 +020100 CLOSE-FILES. ST1124.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1124.2 +020300 TERMINATE-CCVS. ST1124.2 +020400S EXIT PROGRAM. ST1124.2 +020500STERMINATE-CALL. ST1124.2 +020600 STOP RUN. ST1124.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1124.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1124.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1124.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1124.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. ST1124.2 +021200 PRINT-DETAIL. ST1124.2 +021300 IF REC-CT NOT EQUAL TO ZERO ST1124.2 +021400 MOVE "." TO PARDOT-X ST1124.2 +021500 MOVE REC-CT TO DOTVALUE. ST1124.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1124.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1124.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1124.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1124.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1124.2 +022100 MOVE SPACE TO CORRECT-X. ST1124.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1124.2 +022300 MOVE SPACE TO RE-MARK. ST1124.2 +022400 HEAD-ROUTINE. ST1124.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1124.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1124.2 +022900 COLUMN-NAMES-ROUTINE. ST1124.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +023300 END-ROUTINE. ST1124.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1124.2 +023500 END-RTN-EXIT. ST1124.2 +023600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +023700 END-ROUTINE-1. ST1124.2 +023800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1124.2 +023900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1124.2 +024000 ADD PASS-COUNTER TO ERROR-HOLD. ST1124.2 +024100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1124.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1124.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1124.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1124.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1124.2 +024600 END-ROUTINE-12. ST1124.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1124.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1124.2 +024900 MOVE "NO " TO ERROR-TOTAL ST1124.2 +025000 ELSE ST1124.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1124.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1124.2 +025300 PERFORM WRITE-LINE. ST1124.2 +025400 END-ROUTINE-13. ST1124.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1124.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE ST1124.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1124.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1124.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO ST1124.2 +026100 MOVE "NO " TO ERROR-TOTAL ST1124.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1124.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1124.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026600 WRITE-LINE. ST1124.2 +026700 ADD 1 TO RECORD-COUNT. ST1124.2 +026800Y IF RECORD-COUNT GREATER 42 ST1124.2 +026900Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1124.2 +027000Y MOVE SPACE TO DUMMY-RECORD ST1124.2 +027100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1124.2 +027200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1124.2 +027300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1124.2 +027400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1124.2 +027500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1124.2 +027600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027900Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1124.2 +028000Y MOVE ZERO TO RECORD-COUNT. ST1124.2 +028100 PERFORM WRT-LN. ST1124.2 +028200 WRT-LN. ST1124.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1124.2 +028400 MOVE SPACE TO DUMMY-RECORD. ST1124.2 +028500 BLANK-LINE-PRINT. ST1124.2 +028600 PERFORM WRT-LN. ST1124.2 +028700 FAIL-ROUTINE. ST1124.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE ST1124.2 +028900 GO TO FAIL-ROUTINE-WRITE. ST1124.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1124.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1124.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1124.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1124.2 +029500 GO TO FAIL-ROUTINE-EX. ST1124.2 +029600 FAIL-ROUTINE-WRITE. ST1124.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1124.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1124.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1124.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1124.2 +030100 FAIL-ROUTINE-EX. EXIT. ST1124.2 +030200 BAIL-OUT. ST1124.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1124.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1124.2 +030500 BAIL-OUT-WRITE. ST1124.2 +030600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1124.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1124.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1124.2 +031000 BAIL-OUT-EX. EXIT. ST1124.2 +031100 CCVS1-EXIT. ST1124.2 +031200 EXIT. ST1124.2 +031300 SECT-ST112M-001 SECTION. ST1124.2 +031400 ST112M-001-01. ST1124.2 +031500 OPEN OUTPUT SORTOUT-1L. ST1124.2 +031600 BUILD-REEL. ST1124.2 +031700 MOVE ALL "A" TO SORT-KEY. ST1124.2 +031800 PERFORM WRITE-SORT-KEY. ST1124.2 +031900 MOVE ALL "B" TO SORT-KEY. ST1124.2 +032000 PERFORM WRITE-SORT-KEY. ST1124.2 +032100 MOVE ALL "C" TO SORT-KEY. ST1124.2 +032200 PERFORM WRITE-SORT-KEY. ST1124.2 +032300 MOVE ALL "D" TO SORT-KEY. ST1124.2 +032400 PERFORM WRITE-SORT-KEY. ST1124.2 +032500 MOVE ALL "E" TO SORT-KEY. ST1124.2 +032600 PERFORM WRITE-SORT-KEY. ST1124.2 +032700 MOVE ALL "F" TO SORT-KEY. ST1124.2 +032800 PERFORM WRITE-SORT-KEY. ST1124.2 +032900 MOVE ALL "G" TO SORT-KEY. ST1124.2 +033000 PERFORM WRITE-SORT-KEY. ST1124.2 +033100 MOVE ALL "H" TO SORT-KEY. ST1124.2 +033200 PERFORM WRITE-SORT-KEY. ST1124.2 +033300 MOVE ALL "I" TO SORT-KEY. ST1124.2 +033400 PERFORM WRITE-SORT-KEY. ST1124.2 +033500 MOVE ALL "J" TO SORT-KEY. ST1124.2 +033600 PERFORM WRITE-SORT-KEY. ST1124.2 +033700 MOVE ALL "K" TO SORT-KEY. ST1124.2 +033800 PERFORM WRITE-SORT-KEY. ST1124.2 +033900 MOVE ALL "L" TO SORT-KEY. ST1124.2 +034000 PERFORM WRITE-SORT-KEY. ST1124.2 +034100 MOVE ALL "M" TO SORT-KEY. ST1124.2 +034200 PERFORM WRITE-SORT-KEY. ST1124.2 +034300 MOVE ALL "N" TO SORT-KEY. ST1124.2 +034400 PERFORM WRITE-SORT-KEY. ST1124.2 +034500 MOVE ALL "O" TO SORT-KEY. ST1124.2 +034600 PERFORM WRITE-SORT-KEY. ST1124.2 +034700 MOVE ALL "P" TO SORT-KEY. ST1124.2 +034800 PERFORM WRITE-SORT-KEY. ST1124.2 +034900 MOVE ALL "Q" TO SORT-KEY. ST1124.2 +035000 PERFORM WRITE-SORT-KEY. ST1124.2 +035100 MOVE ALL "R" TO SORT-KEY. ST1124.2 +035200 PERFORM WRITE-SORT-KEY. ST1124.2 +035300 MOVE ALL "S" TO SORT-KEY. ST1124.2 +035400 PERFORM WRITE-SORT-KEY. ST1124.2 +035500 MOVE ALL "T" TO SORT-KEY. ST1124.2 +035600 PERFORM WRITE-SORT-KEY. ST1124.2 +035700 MOVE ALL "U" TO SORT-KEY. ST1124.2 +035800 PERFORM WRITE-SORT-KEY. ST1124.2 +035900 MOVE ALL "V" TO SORT-KEY. ST1124.2 +036000 PERFORM WRITE-SORT-KEY. ST1124.2 +036100 MOVE ALL "W" TO SORT-KEY. ST1124.2 +036200 PERFORM WRITE-SORT-KEY. ST1124.2 +036300 MOVE ALL "X" TO SORT-KEY. ST1124.2 +036400 PERFORM WRITE-SORT-KEY. ST1124.2 +036500 MOVE ALL "Y" TO SORT-KEY. ST1124.2 +036600 PERFORM WRITE-SORT-KEY. ST1124.2 +036700 MOVE ALL "Z" TO SORT-KEY. ST1124.2 +036800 PERFORM WRITE-SORT-KEY. ST1124.2 +036900 CLOSE-REEL. ST1124.2 +037000 ADD 1 TO UTIL-CTR. ST1124.2 +037100 IF UTIL-CTR = 3 ST1124.2 +037200 GO TO ST112M-002-01. ST1124.2 +037300H CLOSE SORTOUT-1L REEL. ST1124.2 +037400* THE FOLLOWING OPTION CARDS APPEAR ONLY FOR *OPT3 = I (NO ST1124.2 +037500* CLOSE REEL) ST1124.2 +037600 GO TO BUILD-REEL. ST1124.2 +037700 ST112M-002-01. ST1124.2 +037800 MOVE COMMENT-SENTENCE TO PRINT-REC. ST1124.2 +037900 PERFORM WRITE-LINE. ST1124.2 +038000 CLOSE SORTOUT-1L. ST1124.2 +038100 GO TO CCVS-EXIT. ST1124.2 +038200 WRITE-SORT-KEY. ST1124.2 +038300 WRITE SORT-KEY. ST1124.2 +038400 CCVS-EXIT SECTION. ST1124.2 +038500 CCVS-999999. ST1124.2 +038600 GO TO CLOSE-FILES. ST1124.2 +*END-OF,ST112M +*HEADER,COBOL,ST112M,SUBPRG,ST113M +000100 IDENTIFICATION DIVISION. ST1134.2 +000200 PROGRAM-ID. ST1134.2 +000300 ST113M. ST1134.2 +000400**************************************************************** ST1134.2 +000500* * ST1134.2 +000600* VALIDATION FOR:- * ST1134.2 +000700* * ST1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1134.2 +000900* * ST1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1134.2 +001100* * ST1134.2 +001200**************************************************************** ST1134.2 +001300* * ST1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1134.2 +001500* * ST1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1134.2 +001900* * ST1134.2 +002000**************************************************************** ST1134.2 +002100 ENVIRONMENT DIVISION. ST1134.2 +002200 CONFIGURATION SECTION. ST1134.2 +002300 SOURCE-COMPUTER. ST1134.2 +002400 XXXXX082. ST1134.2 +002500 OBJECT-COMPUTER. ST1134.2 +002600 XXXXX083. ST1134.2 +002700 INPUT-OUTPUT SECTION. ST1134.2 +002800 FILE-CONTROL. ST1134.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1134.2 +003000 XXXXX055. ST1134.2 +003100 SELECT SORTIN-1M ASSIGN TO ST1134.2 +003200 XXXXP006. ST1134.2 +003300 SELECT SORTOUT-1M ASSIGN TO ST1134.2 +003400 XXXXP001. ST1134.2 +003500 SELECT SORTFILE-1M ASSIGN TO ST1134.2 +003600 XXXXX027. ST1134.2 +003700 DATA DIVISION. ST1134.2 +003800 FILE SECTION. ST1134.2 +003900 FD PRINT-FILE. ST1134.2 +004000 01 PRINT-REC PICTURE X(120). ST1134.2 +004100 01 DUMMY-RECORD PICTURE X(120). ST1134.2 +004200 FD SORTIN-1M ST1134.2 +004300C VALUE OF ST1134.2 +004400C XXXXX074 ST1134.2 +004500C IS ST1134.2 +004600C XXXXX079 ST1134.2 +004700G XXXXX069 ST1134.2 +004800 . ST1134.2 +004900 01 SORT-KEY-IN PICTURE X(33). ST1134.2 +005000 FD SORTOUT-1M ST1134.2 +005100C VALUE OF ST1134.2 +005200C XXXXX074 ST1134.2 +005300C IS ST1134.2 +005400C XXXXX075 ST1134.2 +005500G XXXXX069 ST1134.2 +005600 . ST1134.2 +005700 01 SORT-KEY-OUT PICTURE X(33). ST1134.2 +005800 SD SORTFILE-1M. ST1134.2 +005900 01 SORT-KEY PICTURE X(33). ST1134.2 +006000 PROCEDURE DIVISION. ST1134.2 +006100 SORT-PARA SECTION. ST1134.2 +006200 SORT-PARAGRAPH. ST1134.2 +006300 SORT SORTFILE-1M DESCENDING ST1134.2 +006400 SORT-KEY ST1134.2 +006500 USING SORTIN-1M ST1134.2 +006600 GIVING SORTOUT-1M. ST1134.2 +006700 STOP RUN. ST1134.2 +*END-OF,ST113M +*HEADER,COBOL,ST112M,SUBPRG,ST114M +000100 IDENTIFICATION DIVISION. ST1144.2 +000200 PROGRAM-ID. ST1144.2 +000300 ST114M. ST1144.2 +000400**************************************************************** ST1144.2 +000500* * ST1144.2 +000600* VALIDATION FOR:- * ST1144.2 +000700* * ST1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +000900* * ST1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1144.2 +001100* * ST1144.2 +001200**************************************************************** ST1144.2 +001300* * ST1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1144.2 +001500* * ST1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1144.2 +001900* * ST1144.2 +002000**************************************************************** ST1144.2 +002100 ENVIRONMENT DIVISION. ST1144.2 +002200 CONFIGURATION SECTION. ST1144.2 +002300 SOURCE-COMPUTER. ST1144.2 +002400 XXXXX082. ST1144.2 +002500 OBJECT-COMPUTER. ST1144.2 +002600 XXXXX083. ST1144.2 +002700 INPUT-OUTPUT SECTION. ST1144.2 +002800 FILE-CONTROL. ST1144.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1144.2 +003000 XXXXX055. ST1144.2 +003100 SELECT SORTIN-1N ASSIGN TO ST1144.2 +003200 XXXXD001. ST1144.2 +003300 DATA DIVISION. ST1144.2 +003400 FILE SECTION. ST1144.2 +003500 FD PRINT-FILE. ST1144.2 +003600 01 PRINT-REC PICTURE X(120). ST1144.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1144.2 +003800 FD SORTIN-1N ST1144.2 +003900 LABEL RECORDS STANDARD ST1144.2 +004000C VALUE OF ST1144.2 +004100C XXXXX074 ST1144.2 +004200C IS ST1144.2 +004300C XXXXX075 ST1144.2 +004400G XXXXX069 ST1144.2 +004500 DATA RECORDS ARE SORT-KEY. ST1144.2 +004600 01 SORT-KEY PICTURE X(33). ST1144.2 +004700 WORKING-STORAGE SECTION. ST1144.2 +004800 77 ALL-A PICTURE X(33) VALUE ST1144.2 +004900 ALL "A". ST1144.2 +005000 77 ALL-N PICTURE X(33) VALUE ST1144.2 +005100 ALL "N". ST1144.2 +005200 77 ALL-Z PICTURE X(33) VALUE ST1144.2 +005300 ALL "Z". ST1144.2 +005400 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1144.2 +005500 01 COMPUTED-BREAKDOWN. ST1144.2 +005600 02 FIRST-20-CM PICTURE X(20). ST1144.2 +005700 02 SECOND-20-CM PICTURE X(20). ST1144.2 +005800 01 CORRECT-BREAKDOWN. ST1144.2 +005900 02 FIRST-20-CR PICTURE X(20). ST1144.2 +006000 02 SECOND-20-CR PICTURE X(20). ST1144.2 +006100 01 TEST-RESULTS. ST1144.2 +006200 02 FILLER PIC X VALUE SPACE. ST1144.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. ST1144.2 +006400 02 FILLER PIC X VALUE SPACE. ST1144.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. ST1144.2 +006600 02 FILLER PIC X VALUE SPACE. ST1144.2 +006700 02 PAR-NAME. ST1144.2 +006800 03 FILLER PIC X(19) VALUE SPACE. ST1144.2 +006900 03 PARDOT-X PIC X VALUE SPACE. ST1144.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. ST1144.2 +007100 02 FILLER PIC X(8) VALUE SPACE. ST1144.2 +007200 02 RE-MARK PIC X(61). ST1144.2 +007300 01 TEST-COMPUTED. ST1144.2 +007400 02 FILLER PIC X(30) VALUE SPACE. ST1144.2 +007500 02 FILLER PIC X(17) VALUE ST1144.2 +007600 " COMPUTED=". ST1144.2 +007700 02 COMPUTED-X. ST1144.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1144.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A ST1144.2 +008000 PIC -9(9).9(9). ST1144.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1144.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1144.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1144.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. ST1144.2 +008500 04 COMPUTED-18V0 PIC -9(18). ST1144.2 +008600 04 FILLER PIC X. ST1144.2 +008700 03 FILLER PIC X(50) VALUE SPACE. ST1144.2 +008800 01 TEST-CORRECT. ST1144.2 +008900 02 FILLER PIC X(30) VALUE SPACE. ST1144.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1144.2 +009100 02 CORRECT-X. ST1144.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1144.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1144.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1144.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1144.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1144.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. ST1144.2 +009800 04 CORRECT-18V0 PIC -9(18). ST1144.2 +009900 04 FILLER PIC X. ST1144.2 +010000 03 FILLER PIC X(2) VALUE SPACE. ST1144.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1144.2 +010200 01 CCVS-C-1. ST1144.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1144.2 +010400- "SS PARAGRAPH-NAME ST1144.2 +010500- " REMARKS". ST1144.2 +010600 02 FILLER PIC X(20) VALUE SPACE. ST1144.2 +010700 01 CCVS-C-2. ST1144.2 +010800 02 FILLER PIC X VALUE SPACE. ST1144.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". ST1144.2 +011000 02 FILLER PIC X(15) VALUE SPACE. ST1144.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". ST1144.2 +011200 02 FILLER PIC X(94) VALUE SPACE. ST1144.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1144.2 +011400 01 REC-CT PIC 99 VALUE ZERO. ST1144.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1144.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1144.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1144.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1144.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1144.2 +012400 01 CCVS-H-1. ST1144.2 +012500 02 FILLER PIC X(39) VALUE SPACES. ST1144.2 +012600 02 FILLER PIC X(42) VALUE ST1144.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1144.2 +012800 02 FILLER PIC X(39) VALUE SPACES. ST1144.2 +012900 01 CCVS-H-2A. ST1144.2 +013000 02 FILLER PIC X(40) VALUE SPACE. ST1144.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1144.2 +013200 02 FILLER PIC XXXX VALUE ST1144.2 +013300 "4.2 ". ST1144.2 +013400 02 FILLER PIC X(28) VALUE ST1144.2 +013500 " COPY - NOT FOR DISTRIBUTION". ST1144.2 +013600 02 FILLER PIC X(41) VALUE SPACE. ST1144.2 +013700 ST1144.2 +013800 01 CCVS-H-2B. ST1144.2 +013900 02 FILLER PIC X(15) VALUE ST1144.2 +014000 "TEST RESULT OF ". ST1144.2 +014100 02 TEST-ID PIC X(9). ST1144.2 +014200 02 FILLER PIC X(4) VALUE ST1144.2 +014300 " IN ". ST1144.2 +014400 02 FILLER PIC X(12) VALUE ST1144.2 +014500 " HIGH ". ST1144.2 +014600 02 FILLER PIC X(22) VALUE ST1144.2 +014700 " LEVEL VALIDATION FOR ". ST1144.2 +014800 02 FILLER PIC X(58) VALUE ST1144.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +015000 01 CCVS-H-3. ST1144.2 +015100 02 FILLER PIC X(34) VALUE ST1144.2 +015200 " FOR OFFICIAL USE ONLY ". ST1144.2 +015300 02 FILLER PIC X(58) VALUE ST1144.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1144.2 +015500 02 FILLER PIC X(28) VALUE ST1144.2 +015600 " COPYRIGHT 1985 ". ST1144.2 +015700 01 CCVS-E-1. ST1144.2 +015800 02 FILLER PIC X(52) VALUE SPACE. ST1144.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1144.2 +016000 02 ID-AGAIN PIC X(9). ST1144.2 +016100 02 FILLER PIC X(45) VALUE SPACES. ST1144.2 +016200 01 CCVS-E-2. ST1144.2 +016300 02 FILLER PIC X(31) VALUE SPACE. ST1144.2 +016400 02 FILLER PIC X(21) VALUE SPACE. ST1144.2 +016500 02 CCVS-E-2-2. ST1144.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1144.2 +016700 03 FILLER PIC X VALUE SPACE. ST1144.2 +016800 03 ENDER-DESC PIC X(44) VALUE ST1144.2 +016900 "ERRORS ENCOUNTERED". ST1144.2 +017000 01 CCVS-E-3. ST1144.2 +017100 02 FILLER PIC X(22) VALUE ST1144.2 +017200 " FOR OFFICIAL USE ONLY". ST1144.2 +017300 02 FILLER PIC X(12) VALUE SPACE. ST1144.2 +017400 02 FILLER PIC X(58) VALUE ST1144.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +017600 02 FILLER PIC X(13) VALUE SPACE. ST1144.2 +017700 02 FILLER PIC X(15) VALUE ST1144.2 +017800 " COPYRIGHT 1985". ST1144.2 +017900 01 CCVS-E-4. ST1144.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1144.2 +018100 02 FILLER PIC X(4) VALUE " OF ". ST1144.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1144.2 +018300 02 FILLER PIC X(40) VALUE ST1144.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1144.2 +018500 01 XXINFO. ST1144.2 +018600 02 FILLER PIC X(19) VALUE ST1144.2 +018700 "*** INFORMATION ***". ST1144.2 +018800 02 INFO-TEXT. ST1144.2 +018900 04 FILLER PIC X(8) VALUE SPACE. ST1144.2 +019000 04 XXCOMPUTED PIC X(20). ST1144.2 +019100 04 FILLER PIC X(5) VALUE SPACE. ST1144.2 +019200 04 XXCORRECT PIC X(20). ST1144.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). ST1144.2 +019400 01 HYPHEN-LINE. ST1144.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. ST1144.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************ST1144.2 +019700- "*****************************************". ST1144.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************ST1144.2 +019900- "******************************". ST1144.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE ST1144.2 +020100 "ST114M". ST1144.2 +020200 PROCEDURE DIVISION. ST1144.2 +020300 CCVS1 SECTION. ST1144.2 +020400 OPEN-FILES. ST1144.2 +020500 OPEN OUTPUT PRINT-FILE. ST1144.2 +020600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1144.2 +020700 MOVE SPACE TO TEST-RESULTS. ST1144.2 +020800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1144.2 +020900 GO TO CCVS1-EXIT. ST1144.2 +021000 CLOSE-FILES. ST1144.2 +021100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1144.2 +021200 TERMINATE-CCVS. ST1144.2 +021300S EXIT PROGRAM. ST1144.2 +021400STERMINATE-CALL. ST1144.2 +021500 STOP RUN. ST1144.2 +021600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1144.2 +021700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1144.2 +021800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1144.2 +021900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1144.2 +022000 MOVE "****TEST DELETED****" TO RE-MARK. ST1144.2 +022100 PRINT-DETAIL. ST1144.2 +022200 IF REC-CT NOT EQUAL TO ZERO ST1144.2 +022300 MOVE "." TO PARDOT-X ST1144.2 +022400 MOVE REC-CT TO DOTVALUE. ST1144.2 +022500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1144.2 +022600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1144.2 +022700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1144.2 +022800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1144.2 +022900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1144.2 +023000 MOVE SPACE TO CORRECT-X. ST1144.2 +023100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1144.2 +023200 MOVE SPACE TO RE-MARK. ST1144.2 +023300 HEAD-ROUTINE. ST1144.2 +023400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +023500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +023600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1144.2 +023700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1144.2 +023800 COLUMN-NAMES-ROUTINE. ST1144.2 +023900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +024000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +024200 END-ROUTINE. ST1144.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1144.2 +024400 END-RTN-EXIT. ST1144.2 +024500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +024600 END-ROUTINE-1. ST1144.2 +024700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1144.2 +024800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1144.2 +024900 ADD PASS-COUNTER TO ERROR-HOLD. ST1144.2 +025000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1144.2 +025100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1144.2 +025200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1144.2 +025300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1144.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1144.2 +025500 END-ROUTINE-12. ST1144.2 +025600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1144.2 +025700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1144.2 +025800 MOVE "NO " TO ERROR-TOTAL ST1144.2 +025900 ELSE ST1144.2 +026000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1144.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1144.2 +026200 PERFORM WRITE-LINE. ST1144.2 +026300 END-ROUTINE-13. ST1144.2 +026400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1144.2 +026500 MOVE "NO " TO ERROR-TOTAL ELSE ST1144.2 +026600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1144.2 +026700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1144.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +026900 IF INSPECT-COUNTER EQUAL TO ZERO ST1144.2 +027000 MOVE "NO " TO ERROR-TOTAL ST1144.2 +027100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1144.2 +027200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1144.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +027400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +027500 WRITE-LINE. ST1144.2 +027600 ADD 1 TO RECORD-COUNT. ST1144.2 +027700Y IF RECORD-COUNT GREATER 42 ST1144.2 +027800Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1144.2 +027900Y MOVE SPACE TO DUMMY-RECORD ST1144.2 +028000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1144.2 +028100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1144.2 +028200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1144.2 +028300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1144.2 +028400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1144.2 +028500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028800Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1144.2 +028900Y MOVE ZERO TO RECORD-COUNT. ST1144.2 +029000 PERFORM WRT-LN. ST1144.2 +029100 WRT-LN. ST1144.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1144.2 +029300 MOVE SPACE TO DUMMY-RECORD. ST1144.2 +029400 BLANK-LINE-PRINT. ST1144.2 +029500 PERFORM WRT-LN. ST1144.2 +029600 FAIL-ROUTINE. ST1144.2 +029700 IF COMPUTED-X NOT EQUAL TO SPACE ST1144.2 +029800 GO TO FAIL-ROUTINE-WRITE. ST1144.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1144.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1144.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1144.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1144.2 +030400 GO TO FAIL-ROUTINE-EX. ST1144.2 +030500 FAIL-ROUTINE-WRITE. ST1144.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1144.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1144.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1144.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1144.2 +031000 FAIL-ROUTINE-EX. EXIT. ST1144.2 +031100 BAIL-OUT. ST1144.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1144.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1144.2 +031400 BAIL-OUT-WRITE. ST1144.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1144.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1144.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1144.2 +031900 BAIL-OUT-EX. EXIT. ST1144.2 +032000 CCVS1-EXIT. ST1144.2 +032100 EXIT. ST1144.2 +032200 SECT-ST114-0001 SECTION. ST1144.2 +032300 ST114-0001-01. ST1144.2 +032400 OPEN INPUT SORTIN-1N. ST1144.2 +032500 MOVE " ************ ST113 WILL NOT PRODUCE ANY PRST1144.2 +032600- "INTED REPORT ************" TO TEST-RESULTS. ST1144.2 +032700 PERFORM PRINT-DETAIL. ST1144.2 +032800 MOVE SPACE TO TEST-RESULTS. ST1144.2 +032900 PERFORM END-ROUTINE. ST1144.2 +033000 PERFORM BLANK-LINE-PRINT. ST1144.2 +033100 SORT-INIT-A. ST1144.2 +033200 MOVE "SORT, MULTIPLE REEL" TO FEATURE. ST1144.2 +033300 SORT-TEST-1. ST1144.2 +033400 MOVE "SORT-TEST-1" TO PAR-NAME. ST1144.2 +033500 PERFORM READ-SORTIN. ST1144.2 +033600 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +033700 PERFORM PASS GO TO SORT-WRITE-1. ST1144.2 +033800 SORT-FAIL-1. ST1144.2 +033900 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +034000 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +034100 PERFORM BREAKDOWN-PARA. ST1144.2 +034200 SORT-WRITE-1. ST1144.2 +034300 PERFORM PRINT-DETAIL. ST1144.2 +034400 SORT-TEST-2. ST1144.2 +034500 MOVE "SORT-TEST-2" TO PAR-NAME. ST1144.2 +034600 PERFORM READ-SORTIN. ST1144.2 +034700 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +034800 PERFORM PASS GO TO SORT-WRITE-2. ST1144.2 +034900 SORT-FAIL-2. ST1144.2 +035000 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +035100 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +035200 PERFORM BREAKDOWN-PARA. ST1144.2 +035300 SORT-WRITE-2. ST1144.2 +035400 PERFORM PRINT-DETAIL. ST1144.2 +035500 SORT-TEST-3. ST1144.2 +035600 MOVE "SORT-TEST-3" TO PAR-NAME. ST1144.2 +035700 PERFORM READ-SORTIN. ST1144.2 +035800 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +035900 PERFORM PASS GO TO SORT-WRITE-3. ST1144.2 +036000 SORT-FAIL-3. ST1144.2 +036100 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +036200 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +036300 PERFORM BREAKDOWN-PARA. ST1144.2 +036400 SORT-WRITE-3. ST1144.2 +036500 PERFORM PRINT-DETAIL. ST1144.2 +036600 SORT-TEST-4. ST1144.2 +036700 MOVE "SORT-TEST-4" TO PAR-NAME. ST1144.2 +036800 PERFORM READ-SORTIN 34 TIMES. ST1144.2 +036900 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +037000 PERFORM PASS GO TO SORT-WRITE-4. ST1144.2 +037100 SORT-FAIL-4. ST1144.2 +037200 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +037300 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +037400 PERFORM BREAKDOWN-PARA. ST1144.2 +037500 SORT-WRITE-4. ST1144.2 +037600 PERFORM PRINT-DETAIL. ST1144.2 +037700 SORT-TEST-5. ST1144.2 +037800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1144.2 +037900 PERFORM READ-SORTIN. ST1144.2 +038000 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +038100 PERFORM PASS GO TO SORT-WRITE-5. ST1144.2 +038200 SORT-FAIL-5. ST1144.2 +038300 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +038400 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +038500 PERFORM BREAKDOWN-PARA. ST1144.2 +038600 SORT-WRITE-5. ST1144.2 +038700 PERFORM PRINT-DETAIL. ST1144.2 +038800 SORT-TEST-6. ST1144.2 +038900 PERFORM READ-SORTIN. ST1144.2 +039000 MOVE "SORT-TEST-6" TO PAR-NAME. ST1144.2 +039100 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +039200 PERFORM PASS GO TO SORT-WRITE-6. ST1144.2 +039300 SORT-FAIL-6. ST1144.2 +039400 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +039500 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +039600 PERFORM BREAKDOWN-PARA. ST1144.2 +039700 SORT-WRITE-6. ST1144.2 +039800 PERFORM PRINT-DETAIL. ST1144.2 +039900 SORT-TEST-7. ST1144.2 +040000 MOVE "SORT-TEST-7" TO PAR-NAME. ST1144.2 +040100 PERFORM READ-SORTIN 37 TIMES. ST1144.2 +040200 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +040300 PERFORM PASS GO TO SORT-WRITE-7. ST1144.2 +040400 SORT-FAIL-7. ST1144.2 +040500 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +040600 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +040700 PERFORM BREAKDOWN-PARA. ST1144.2 +040800 SORT-WRITE-7. ST1144.2 +040900 PERFORM PRINT-DETAIL. ST1144.2 +041000 SORT-TEST-8. ST1144.2 +041100 MOVE "SORT-TEST-8" TO PAR-NAME. ST1144.2 +041200 PERFORM READ-SORTIN. ST1144.2 +041300 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +041400 PERFORM PASS GO TO SORT-WRITE-8. ST1144.2 +041500 SORT-FAIL-8. ST1144.2 +041600 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +041700 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +041800 PERFORM BREAKDOWN-PARA. ST1144.2 +041900 SORT-WRITE-8. ST1144.2 +042000 PERFORM PRINT-DETAIL. ST1144.2 +042100 SORT-TEST-9. ST1144.2 +042200 MOVE "SORT-TEST-9" TO PAR-NAME. ST1144.2 +042300 PERFORM READ-SORTIN. ST1144.2 +042400 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +042500 PERFORM PASS GO TO SORT-WRITE-9. ST1144.2 +042600 SORT-FAIL-9. ST1144.2 +042700 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +042800 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +042900 PERFORM BREAKDOWN-PARA. ST1144.2 +043000 SORT-WRITE-9. ST1144.2 +043100 PERFORM PRINT-DETAIL. ST1144.2 +043200 SORT-TEST-10. ST1144.2 +043300 MOVE "SORT-TEST-10" TO PAR-NAME. ST1144.2 +043400 READ SORTIN-1N AT END ST1144.2 +043500 PERFORM PASS GO TO SORT-WRITE-10. ST1144.2 +043600 SORT-FAIL-10. ST1144.2 +043700 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +043800 MOVE SPACE TO CORRECT-BREAKDOWN. ST1144.2 +043900 PERFORM BREAKDOWN-PARA. ST1144.2 +044000 PERFORM PRINT-DETAIL. ST1144.2 +044100 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1144.2 +044200 SORT-WRITE-10. ST1144.2 +044300 PERFORM PRINT-DETAIL. ST1144.2 +044400 CLOSE SORTIN-1N. ST1144.2 +044500 GO TO CCVS-EXIT. ST1144.2 +044600 BREAKDOWN-PARA. ST1144.2 +044700 PERFORM FAIL. ST1144.2 +044800 MOVE FIRST-20-CM TO COMPUTED-A. ST1144.2 +044900 MOVE FIRST-20-CR TO CORRECT-A. ST1144.2 +045000 MOVE "FIRST 20 CHARACTERS" TO RE-MARK. ST1144.2 +045100 PERFORM PRINT-DETAIL. ST1144.2 +045200 MOVE SECOND-20-CM TO COMPUTED-A. ST1144.2 +045300 MOVE SECOND-20-CR TO CORRECT-A. ST1144.2 +045400 MOVE "LAST 13 CHARACTERS" TO RE-MARK. ST1144.2 +045500 READ-SORTIN. ST1144.2 +045600 READ SORTIN-1N AT END GO TO READ-ERROR. ST1144.2 +045700 ADD 1 TO UTIL-CTR. ST1144.2 +045800 READ-ERROR. ST1144.2 +045900 MOVE "READ-SORTIN" TO PAR-NAME. ST1144.2 +046000 PERFORM FAIL. ST1144.2 +046100 MOVE UTIL-CTR TO COMPUTED-N. ST1144.2 +046200 MOVE 78 TO CORRECT-N. ST1144.2 +046300 MOVE "TOO FEW RECORDS IN FILE" TO RE-MARK. ST1144.2 +046400 PERFORM PRINT-DETAIL. ST1144.2 +046500 CCVS-EXIT SECTION. ST1144.2 +046600 CCVS-999999. ST1144.2 +046700 GO TO CLOSE-FILES. ST1144.2 +*END-OF,ST114M +*HEADER,COBOL,ST115A +000100 IDENTIFICATION DIVISION. ST1154.2 +000200 PROGRAM-ID. ST1154.2 +000300 ST115A. ST1154.2 +000400**************************************************************** ST1154.2 +000500* * ST1154.2 +000600* VALIDATION FOR:- * ST1154.2 +000700* * ST1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +000900* * ST1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1154.2 +001100* * ST1154.2 +001200**************************************************************** ST1154.2 +001300* * ST1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1154.2 +001500* * ST1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1154.2 +001900* X-XXXP01 SQ-FS1 * ST1154.2 +002000* X-XXX065 4 DIGIT INTEGER FOR THE NUMBER * ST1154.2 +002100* RECORDS IN THE FILE SQ-FS1. * ST1154.2 +002200* * ST1154.2 +002300* * ST1154.2 +002400**************************************************************** ST1154.2 +002500* ST1154.2 +002600* ST1154.2 +002700* OBJECTIVE - ST1154.2 +002800* ROUTINE ST115 BUILDS A SEQUENTIAL FILE SQ-FS1 WHICH ST1154.2 +002900* IS THEN PASSED TO ST116 TO BE SORTED. ST1154.2 +003000* ST1154.2 +003100* ST1154.2 +003200* FEATURES TESTED - ST1154.2 +003300* * FIXED LENGTH RECORDS ST1154.2 +003400* * OCCURS CLAUSES ST1154.2 +003500* ST1154.2 +003600* ST1154.2 +003700* ST1154.2 +003800* FILES USED - ST1154.2 +003900* * FILE SQ-FS1 CAN BE ON MAGNETIC TAPE OR MASS-STORAGE. ST1154.2 +004000* ST1154.2 +004100* SQ-FS1 - ST1154.2 +004200* THE NUMBER OF RECORDS ON SQ-FS1 IS A VARIABLE (X-65). THIS ST1154.2 +004300* NUMBER SHOULD BE LARGE ENOUGH TO FORCE THE SORT ROUTINE ST1154.2 +004400* IN ST116 TO BE NON-CORE RESIDENT. THAT IS FORCE ST1154.2 +004500* THE SYSTEM TO USE SOME MEANS OF AUX. STORAGE FOR THE SORTST1154.2 +004600* SUB-STRINGS. ST1154.2 +004700* FIXED LENGTH RECORDS ( 507 CHARACTERS PER RECORD ) ST1154.2 +004800* BLOCKED 1 ST1154.2 +004900* RESERVE 2 AREAS ST1154.2 +005000* ST1154.2 +005100* ST1154.2 +005200* ST1154.2 +005300* OPTIONS RECOMMENDED - ST1154.2 +005400* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1154.2 +005500* FILE SQ-FS1 ONCE IT HAS BEEN CREATED. ST1154.2 +005600* ST1154.2 +005700* ST1154.2 +005800* TEST DESCRIPTIONS - ST1154.2 +005900* NOT APPLICABLE. ST1154.2 +006000* ST1154.2 +006100* ST1154.2 +006200* ************************************************************ ST1154.2 +006300 ENVIRONMENT DIVISION. ST1154.2 +006400 CONFIGURATION SECTION. ST1154.2 +006500 SOURCE-COMPUTER. ST1154.2 +006600 XXXXX082. ST1154.2 +006700 OBJECT-COMPUTER. ST1154.2 +006800 XXXXX083. ST1154.2 +006900 INPUT-OUTPUT SECTION. ST1154.2 +007000 FILE-CONTROL. ST1154.2 +007100 SELECT PRINT-FILE ASSIGN TO ST1154.2 +007200 XXXXX055. ST1154.2 +007300 SELECT SQ-FS1 ASSIGN TO ST1154.2 +007400 XXXXP001 ST1154.2 +007500 ORGANIZATION IS SEQUENTIAL ST1154.2 +007600 ACCESS MODE IS SEQUENTIAL. ST1154.2 +007700 DATA DIVISION. ST1154.2 +007800 FILE SECTION. ST1154.2 +007900 FD PRINT-FILE. ST1154.2 +008000 01 PRINT-REC PICTURE X(120). ST1154.2 +008100 01 DUMMY-RECORD PICTURE X(120). ST1154.2 +008200 FD SQ-FS1 ST1154.2 +008300 LABEL RECORDS STANDARD ST1154.2 +008400C VALUE OF ST1154.2 +008500C XXXXX074 ST1154.2 +008600C IS ST1154.2 +008700C XXXXX075 ST1154.2 +008800G XXXXX069 ST1154.2 +008900 BLOCK CONTAINS 1 RECORDS ST1154.2 +009000 RECORD CONTAINS 507 CHARACTERS ST1154.2 +009100 DATA RECORD IS SQ-FS1R1-F-G-507. ST1154.2 +009200 01 SQ-FS1R1-F-G-507. ST1154.2 +009300 10 REC-PREAMBLE PIC X(120). ST1154.2 +009400 10 LENGTH-1 PIC 999. ST1154.2 +009500 10 THE-THREE-KEYS. ST1154.2 +009600 20 KEY-1. ST1154.2 +009700 30 ALPHAN-KEY PIC X. ST1154.2 +009800 30 NUM-KEY PIC 999. ST1154.2 +009900 20 KEY-2. ST1154.2 +010000 30 ALPHAN-KEY PIC X. ST1154.2 +010100 30 NUM-KEY PIC 999. ST1154.2 +010200 20 KEY-3. ST1154.2 +010300 30 ALPHAN-KEY PIC X. ST1154.2 +010400 30 NUM-KEY PIC 999. ST1154.2 +010500 10 STUFF-1 OCCURS ST1154.2 +010600 31 TIMES. ST1154.2 +010700 30 FILL-ME-UPS PIC X(12). ST1154.2 +010800 WORKING-STORAGE SECTION. ST1154.2 +010900 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1154.2 +011000 77 WRK-DU-999-0001 PIC 999. ST1154.2 +011100 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1154.2 +011200 77 WRK-DU-999-0002 PIC 999 VALUE 0. ST1154.2 +011300 77 WRK-DU-04V00 PIC 9(4) VALUE ZERO. ST1154.2 +011400X77 COUNT-OF-RECS PIC 9(6) VALUE ZERO. ST1154.2 +011500 01 WRK-XN-0001 PIC X(51) VALUE ST1154.2 +011600 "/A.Z-B,Y+C*X)D(W$E$V F0U1G2T3H4S5I6R7J8Q9K;PMN". ST1154.2 +011700 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1154.2 +011800 02 CHAR PIC X OCCURS 51 TIMES. ST1154.2 +011900 01 FILE-RECORD-INFORMATION-REC. ST1154.2 +012000 03 FILE-RECORD-INFO-SKELETON. ST1154.2 +012100 05 FILLER PICTURE X(48) VALUE ST1154.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1154.2 +012300 05 FILLER PICTURE X(46) VALUE ST1154.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1154.2 +012500 05 FILLER PICTURE X(26) VALUE ST1154.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". ST1154.2 +012700 05 FILLER PICTURE X(37) VALUE ST1154.2 +012800 ",RECKEY= ". ST1154.2 +012900 05 FILLER PICTURE X(38) VALUE ST1154.2 +013000 ",ALTKEY1= ". ST1154.2 +013100 05 FILLER PICTURE X(38) VALUE ST1154.2 +013200 ",ALTKEY2= ". ST1154.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.ST1154.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1154.2 +013500 05 FILE-RECORD-INFO-P1-120. ST1154.2 +013600 07 FILLER PIC X(5). ST1154.2 +013700 07 XFILE-NAME PIC X(6). ST1154.2 +013800 07 FILLER PIC X(8). ST1154.2 +013900 07 XRECORD-NAME PIC X(6). ST1154.2 +014000 07 FILLER PIC X(1). ST1154.2 +014100 07 REELUNIT-NUMBER PIC 9(1). ST1154.2 +014200 07 FILLER PIC X(7). ST1154.2 +014300 07 XRECORD-NUMBER PIC 9(6). ST1154.2 +014400 07 FILLER PIC X(6). ST1154.2 +014500 07 UPDATE-NUMBER PIC 9(2). ST1154.2 +014600 07 FILLER PIC X(5). ST1154.2 +014700 07 ODO-NUMBER PIC 9(4). ST1154.2 +014800 07 FILLER PIC X(5). ST1154.2 +014900 07 XPROGRAM-NAME PIC X(5). ST1154.2 +015000 07 FILLER PIC X(7). ST1154.2 +015100 07 XRECORD-LENGTH PIC 9(6). ST1154.2 +015200 07 FILLER PIC X(7). ST1154.2 +015300 07 CHARS-OR-RECORDS PIC X(2). ST1154.2 +015400 07 FILLER PIC X(1). ST1154.2 +015500 07 XBLOCK-SIZE PIC 9(4). ST1154.2 +015600 07 FILLER PIC X(6). ST1154.2 +015700 07 RECORDS-IN-FILE PIC 9(6). ST1154.2 +015800 07 FILLER PIC X(5). ST1154.2 +015900 07 XFILE-ORGANIZATION PIC X(2). ST1154.2 +016000 07 FILLER PIC X(6). ST1154.2 +016100 07 XLABEL-TYPE PIC X(1). ST1154.2 +016200 05 FILE-RECORD-INFO-P121-240. ST1154.2 +016300 07 FILLER PIC X(8). ST1154.2 +016400 07 XRECORD-KEY PIC X(29). ST1154.2 +016500 07 FILLER PIC X(9). ST1154.2 +016600 07 ALTERNATE-KEY1 PIC X(29). ST1154.2 +016700 07 FILLER PIC X(9). ST1154.2 +016800 07 ALTERNATE-KEY2 PIC X(29). ST1154.2 +016900 07 FILLER PIC X(7). ST1154.2 +017000 01 TEST-RESULTS. ST1154.2 +017100 02 FILLER PIC X VALUE SPACE. ST1154.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. ST1154.2 +017300 02 FILLER PIC X VALUE SPACE. ST1154.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. ST1154.2 +017500 02 FILLER PIC X VALUE SPACE. ST1154.2 +017600 02 PAR-NAME. ST1154.2 +017700 03 FILLER PIC X(19) VALUE SPACE. ST1154.2 +017800 03 PARDOT-X PIC X VALUE SPACE. ST1154.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. ST1154.2 +018000 02 FILLER PIC X(8) VALUE SPACE. ST1154.2 +018100 02 RE-MARK PIC X(61). ST1154.2 +018200 01 TEST-COMPUTED. ST1154.2 +018300 02 FILLER PIC X(30) VALUE SPACE. ST1154.2 +018400 02 FILLER PIC X(17) VALUE ST1154.2 +018500 " COMPUTED=". ST1154.2 +018600 02 COMPUTED-X. ST1154.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1154.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A ST1154.2 +018900 PIC -9(9).9(9). ST1154.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1154.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1154.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1154.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. ST1154.2 +019400 04 COMPUTED-18V0 PIC -9(18). ST1154.2 +019500 04 FILLER PIC X. ST1154.2 +019600 03 FILLER PIC X(50) VALUE SPACE. ST1154.2 +019700 01 TEST-CORRECT. ST1154.2 +019800 02 FILLER PIC X(30) VALUE SPACE. ST1154.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1154.2 +020000 02 CORRECT-X. ST1154.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1154.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1154.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1154.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1154.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1154.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. ST1154.2 +020700 04 CORRECT-18V0 PIC -9(18). ST1154.2 +020800 04 FILLER PIC X. ST1154.2 +020900 03 FILLER PIC X(2) VALUE SPACE. ST1154.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1154.2 +021100 01 CCVS-C-1. ST1154.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1154.2 +021300- "SS PARAGRAPH-NAME ST1154.2 +021400- " REMARKS". ST1154.2 +021500 02 FILLER PIC X(20) VALUE SPACE. ST1154.2 +021600 01 CCVS-C-2. ST1154.2 +021700 02 FILLER PIC X VALUE SPACE. ST1154.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". ST1154.2 +021900 02 FILLER PIC X(15) VALUE SPACE. ST1154.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". ST1154.2 +022100 02 FILLER PIC X(94) VALUE SPACE. ST1154.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1154.2 +022300 01 REC-CT PIC 99 VALUE ZERO. ST1154.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1154.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1154.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1154.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1154.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1154.2 +023300 01 CCVS-H-1. ST1154.2 +023400 02 FILLER PIC X(39) VALUE SPACES. ST1154.2 +023500 02 FILLER PIC X(42) VALUE ST1154.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1154.2 +023700 02 FILLER PIC X(39) VALUE SPACES. ST1154.2 +023800 01 CCVS-H-2A. ST1154.2 +023900 02 FILLER PIC X(40) VALUE SPACE. ST1154.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1154.2 +024100 02 FILLER PIC XXXX VALUE ST1154.2 +024200 "4.2 ". ST1154.2 +024300 02 FILLER PIC X(28) VALUE ST1154.2 +024400 " COPY - NOT FOR DISTRIBUTION". ST1154.2 +024500 02 FILLER PIC X(41) VALUE SPACE. ST1154.2 +024600 ST1154.2 +024700 01 CCVS-H-2B. ST1154.2 +024800 02 FILLER PIC X(15) VALUE ST1154.2 +024900 "TEST RESULT OF ". ST1154.2 +025000 02 TEST-ID PIC X(9). ST1154.2 +025100 02 FILLER PIC X(4) VALUE ST1154.2 +025200 " IN ". ST1154.2 +025300 02 FILLER PIC X(12) VALUE ST1154.2 +025400 " HIGH ". ST1154.2 +025500 02 FILLER PIC X(22) VALUE ST1154.2 +025600 " LEVEL VALIDATION FOR ". ST1154.2 +025700 02 FILLER PIC X(58) VALUE ST1154.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +025900 01 CCVS-H-3. ST1154.2 +026000 02 FILLER PIC X(34) VALUE ST1154.2 +026100 " FOR OFFICIAL USE ONLY ". ST1154.2 +026200 02 FILLER PIC X(58) VALUE ST1154.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1154.2 +026400 02 FILLER PIC X(28) VALUE ST1154.2 +026500 " COPYRIGHT 1985 ". ST1154.2 +026600 01 CCVS-E-1. ST1154.2 +026700 02 FILLER PIC X(52) VALUE SPACE. ST1154.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1154.2 +026900 02 ID-AGAIN PIC X(9). ST1154.2 +027000 02 FILLER PIC X(45) VALUE SPACES. ST1154.2 +027100 01 CCVS-E-2. ST1154.2 +027200 02 FILLER PIC X(31) VALUE SPACE. ST1154.2 +027300 02 FILLER PIC X(21) VALUE SPACE. ST1154.2 +027400 02 CCVS-E-2-2. ST1154.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1154.2 +027600 03 FILLER PIC X VALUE SPACE. ST1154.2 +027700 03 ENDER-DESC PIC X(44) VALUE ST1154.2 +027800 "ERRORS ENCOUNTERED". ST1154.2 +027900 01 CCVS-E-3. ST1154.2 +028000 02 FILLER PIC X(22) VALUE ST1154.2 +028100 " FOR OFFICIAL USE ONLY". ST1154.2 +028200 02 FILLER PIC X(12) VALUE SPACE. ST1154.2 +028300 02 FILLER PIC X(58) VALUE ST1154.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +028500 02 FILLER PIC X(13) VALUE SPACE. ST1154.2 +028600 02 FILLER PIC X(15) VALUE ST1154.2 +028700 " COPYRIGHT 1985". ST1154.2 +028800 01 CCVS-E-4. ST1154.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1154.2 +029000 02 FILLER PIC X(4) VALUE " OF ". ST1154.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1154.2 +029200 02 FILLER PIC X(40) VALUE ST1154.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1154.2 +029400 01 XXINFO. ST1154.2 +029500 02 FILLER PIC X(19) VALUE ST1154.2 +029600 "*** INFORMATION ***". ST1154.2 +029700 02 INFO-TEXT. ST1154.2 +029800 04 FILLER PIC X(8) VALUE SPACE. ST1154.2 +029900 04 XXCOMPUTED PIC X(20). ST1154.2 +030000 04 FILLER PIC X(5) VALUE SPACE. ST1154.2 +030100 04 XXCORRECT PIC X(20). ST1154.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). ST1154.2 +030300 01 HYPHEN-LINE. ST1154.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. ST1154.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************ST1154.2 +030600- "*****************************************". ST1154.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************ST1154.2 +030800- "******************************". ST1154.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE ST1154.2 +031000 "ST115A". ST1154.2 +031100 PROCEDURE DIVISION. ST1154.2 +031200 CCVS1 SECTION. ST1154.2 +031300 OPEN-FILES. ST1154.2 +031400 OPEN OUTPUT PRINT-FILE. ST1154.2 +031500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1154.2 +031600 MOVE SPACE TO TEST-RESULTS. ST1154.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1154.2 +031800 MOVE ZERO TO REC-SKL-SUB. ST1154.2 +031900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1154.2 +032000 CCVS-INIT-FILE. ST1154.2 +032100 ADD 1 TO REC-SKL-SUB. ST1154.2 +032200 MOVE FILE-RECORD-INFO-SKELETON ST1154.2 +032300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1154.2 +032400 CCVS-INIT-EXIT. ST1154.2 +032500 GO TO CCVS1-EXIT. ST1154.2 +032600 CLOSE-FILES. ST1154.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1154.2 +032800 TERMINATE-CCVS. ST1154.2 +032900S EXIT PROGRAM. ST1154.2 +033000STERMINATE-CALL. ST1154.2 +033100 STOP RUN. ST1154.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1154.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1154.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1154.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1154.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. ST1154.2 +033700 PRINT-DETAIL. ST1154.2 +033800 IF REC-CT NOT EQUAL TO ZERO ST1154.2 +033900 MOVE "." TO PARDOT-X ST1154.2 +034000 MOVE REC-CT TO DOTVALUE. ST1154.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1154.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1154.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1154.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1154.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1154.2 +034600 MOVE SPACE TO CORRECT-X. ST1154.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1154.2 +034800 MOVE SPACE TO RE-MARK. ST1154.2 +034900 HEAD-ROUTINE. ST1154.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1154.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1154.2 +035400 COLUMN-NAMES-ROUTINE. ST1154.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +035800 END-ROUTINE. ST1154.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1154.2 +036000 END-RTN-EXIT. ST1154.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +036200 END-ROUTINE-1. ST1154.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1154.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1154.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. ST1154.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1154.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1154.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1154.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1154.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1154.2 +037100 END-ROUTINE-12. ST1154.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1154.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1154.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1154.2 +037500 ELSE ST1154.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1154.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1154.2 +037800 PERFORM WRITE-LINE. ST1154.2 +037900 END-ROUTINE-13. ST1154.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1154.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE ST1154.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1154.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1154.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO ST1154.2 +038600 MOVE "NO " TO ERROR-TOTAL ST1154.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1154.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1154.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +039100 WRITE-LINE. ST1154.2 +039200 ADD 1 TO RECORD-COUNT. ST1154.2 +039300Y IF RECORD-COUNT GREATER 42 ST1154.2 +039400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1154.2 +039500Y MOVE SPACE TO DUMMY-RECORD ST1154.2 +039600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1154.2 +039700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1154.2 +039800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1154.2 +039900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1154.2 +040000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1154.2 +040100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1154.2 +040500Y MOVE ZERO TO RECORD-COUNT. ST1154.2 +040600 PERFORM WRT-LN. ST1154.2 +040700 WRT-LN. ST1154.2 +040800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +040900 MOVE SPACE TO DUMMY-RECORD. ST1154.2 +041000 BLANK-LINE-PRINT. ST1154.2 +041100 PERFORM WRT-LN. ST1154.2 +041200 FAIL-ROUTINE. ST1154.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE ST1154.2 +041400 GO TO FAIL-ROUTINE-WRITE. ST1154.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1154.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1154.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1154.2 +041800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +041900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1154.2 +042000 GO TO FAIL-ROUTINE-EX. ST1154.2 +042100 FAIL-ROUTINE-WRITE. ST1154.2 +042200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1154.2 +042300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1154.2 +042400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1154.2 +042500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1154.2 +042600 FAIL-ROUTINE-EX. EXIT. ST1154.2 +042700 BAIL-OUT. ST1154.2 +042800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1154.2 +042900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1154.2 +043000 BAIL-OUT-WRITE. ST1154.2 +043100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1154.2 +043200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1154.2 +043300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +043400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1154.2 +043500 BAIL-OUT-EX. EXIT. ST1154.2 +043600 CCVS1-EXIT. ST1154.2 +043700 EXIT. ST1154.2 +043800 SECT-ST115-0001 SECTION. ST1154.2 +043900 SRT-INIT-001. ST1154.2 +044000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1154.2 +044100 OPEN OUTPUT SQ-FS1. ST1154.2 +044200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1154.2 +044300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1154.2 +044400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1154.2 +044500 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1154.2 +044600 MOVE 0001 TO XBLOCK-SIZE (1). ST1154.2 +044700 MOVE ST1154.2 +044800 XXXXX065 ST1154.2 +044900 TO RECORDS-IN-FILE (1). ST1154.2 +045000 MOVE 507 TO XRECORD-LENGTH (1). ST1154.2 +045100 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1154.2 +045200 MOVE "S" TO XLABEL-TYPE (1). ST1154.2 +045300 MOVE 000000 TO XRECORD-NUMBER (1). ST1154.2 +045400 SRT-TEST-001. ST1154.2 +045500 MOVE 001 TO WRK-DU-999-0001. ST1154.2 +045600 MOVE 1 TO WRK-DU-04V00. ST1154.2 +045700 SRT-TEST-001-01. ST1154.2 +045800 PERFORM SRT-TEST-001-BUILD. ST1154.2 +045900 ADD 1 TO WRK-DU-04V00. ST1154.2 +046000 IF WRK-DU-04V00 IS GREATER THAN ST1154.2 +046100 XXXXX065 ST1154.2 +046200 GO TO SRT-WRITE-001. ST1154.2 +046300 GO TO SRT-TEST-001-01. ST1154.2 +046400 SRT-TEST-001-BUILD. ST1154.2 +046500 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1154.2 +046600 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1154.2 +046700 MOVE WRK-DU-04V00 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1154.2 +046800 NUM-KEY OF KEY-3. ST1154.2 +046900 MOVE 507 TO LENGTH-1. ST1154.2 +047000 PERFORM PAD-THE-RECORD-LENGTH VARYING WRK-DU-999-0002 ST1154.2 +047100 FROM 1 BY 1 UNTIL WRK-DU-999-0002 IS GREATER THAN ST1154.2 +047200 31. ST1154.2 +047300 ADD 1 TO XRECORD-NUMBER (1). ST1154.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1154.2 +047500 ADD 001 TO WRK-DU-999-0001. ST1154.2 +047600 IF WRK-DU-999-0001 IS GREATER THAN 51 ST1154.2 +047700 MOVE 001 TO WRK-DU-999-0001. ST1154.2 +047800 WRITE SQ-FS1R1-F-G-507. ST1154.2 +047900 PAD-THE-RECORD-LENGTH. ST1154.2 +048000 MOVE THE-THREE-KEYS TO STUFF-1 (WRK-DU-999-0002). ST1154.2 +048100 SRT-DELETE-001. ST1154.2 +048200 PERFORM DE-LETE. ST1154.2 +048300 SRT-WRITE-001. ST1154.2 +048400 MOVE "FILE-CREATE" TO PAR-NAME. ST1154.2 +048500 MOVE "SQ-FS1 FILE CREATED" TO COMPUTED-A. ST1154.2 +048600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1154.2 +048700 MOVE "PASSED TO ST116 FOR SORTING" TO RE-MARK. ST1154.2 +048800 PERFORM PRINT-DETAIL. ST1154.2 +048900 MOVE " ************ ST116 WILL NOT PRODUCE ANY PRST1154.2 +049000- "INTED REPORT ************" TO PRINT-REC. ST1154.2 +049100 WRITE PRINT-REC AFTER ADVANCING 1 LINES. ST1154.2 +049200 CLOSE SQ-FS1. ST1154.2 +049300XFILEDUMP SECTION. ST1154.2 +049400XFILE-1-DUMP-INIT. ST1154.2 +049500X OPEN INPUT SQ-FS1. ST1154.2 +049600X MOVE ZERO TO COUNT-OF-RECS. ST1154.2 +049700XFILE-1-DUMP. ST1154.2 +049800X READ SQ-FS1 RECORD ST1154.2 +049900X AT END GO TO FILE-1-DUMP-END. ST1154.2 +050000X ADD 1 TO COUNT-OF-RECS. ST1154.2 +050100X IF COUNT-OF-RECS GREATER THAN ST1154.2 +050200X XXXXX065 ST1154.2 +050300X GO TO FILE-1-DUMP-END. ST1154.2 +050400X PERFORM FILE-1-DUMP-WRITE. ST1154.2 +050500X GO TO FILE-1-DUMP. ST1154.2 +050600XFILE-1-DUMP-WRITE. ST1154.2 +050700X MOVE SQ-FS1R1-F-G-507 TO DUMMY-RECORD. ST1154.2 +050800X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +050900XFILE-1-DUMP-END. ST1154.2 +051000X MOVE " SQ-FS1 RECORDS TO SORTED BY ST116 SHOWN BELOW" ST1154.2 +051100X TO DUMMY-RECORD. ST1154.2 +051200X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +051300X MOVE COUNT-OF-RECS TO DUMMY-RECORD. ST1154.2 +051400X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +051500X CLOSE SQ-FS1. ST1154.2 +051600 CCVS-EXIT SECTION. ST1154.2 +051700 CCVS-999999. ST1154.2 +051800 GO TO CLOSE-FILES. ST1154.2 +*END-OF,ST115A +*HEADER,COBOL,ST115A,SUBPRG,ST116A +000100 IDENTIFICATION DIVISION. ST1164.2 +000200 PROGRAM-ID. ST1164.2 +000300 ST116A. ST1164.2 +000400**************************************************************** ST1164.2 +000500* * ST1164.2 +000600* VALIDATION FOR:- * ST1164.2 +000700* * ST1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1164.2 +000900* * ST1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1164.2 +001100* * ST1164.2 +001200**************************************************************** ST1164.2 +001300* * ST1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1164.2 +001500* * ST1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1164.2 +001900* X-XXXD01 - SQ-FS1 * ST1164.2 +002000* X-XXXP02 - SQ-FS2 * ST1164.2 +002100* X-XXX027 - SORT FILE ST-FS1 * ST1164.2 +002200* * ST1164.2 +002300**************************************************************** ST1164.2 +002400******************************************************************ST1164.2 +002500* ST1164.2 +002600* ST1164.2 +002700* ST116 ST1164.2 +002800* ST1164.2 +002900* ST1164.2 +003000* OBJECTIVE - ST1164.2 +003100* ROUTINE ST116 IS A TEST OF THE SORT STATEMENT USING ST1164.2 +003200* FIXED LENGTH RECORDS ( 507 CHARACTERS PER RECORD ). ST1164.2 +003300* ST1164.2 +003400* ST1164.2 +003500* FEATURES TESTED - ST1164.2 +003600* * COLLATING SEQUENCE IS NATIVE. NO COLLATING SEQUENCE ST1164.2 +003700* STATEMENT IS USED IN THE ACTUAL SORT STATEMENT. ST1164.2 +003800* * FIXED LENGTH RECORDS ST1164.2 +003900* * OCCURS CLAUSES ST1164.2 +004000* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1164.2 +004100* ST1164.2 +004200* * SORT SORT-FILE-NAME ST1164.2 +004300* ON ASCENDING KEY KEY-1 OF DATA-NAME-1 ST1164.2 +004400* ASCENDING KEY-2 OF DATA-NAME-2 ST1164.2 +004500* USING FILE-NAME-1 ST1164.2 +004600* GIVING FILE-NAME-2. ST1164.2 +004700* ST1164.2 +004800* ST1164.2 +004900* ANSI X3.23-1974 REFERENCES - ST1164.2 +005000* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1164.2 +005100* ST1164.2 +005200* ST1164.2 +005300* FILES USED - ST1164.2 +005400* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1164.2 +005500* ST1164.2 +005600* FILE SQ-FS1 IS CREATED IN ST115 AND PASSED TO ST116. THE ST1164.2 +005700* FILE SQ-FS2 IS PASSED TO ROUTINE ST117 FOR CHECKING. ST1164.2 +005800* ST1164.2 +005900* SQ-FS1 - ST1164.2 +006000* NUMBER OF RECORDS IS SET BY THE INTEGER X-65. ST1164.2 +006100* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1164.2 +006200* BLOCKED 1 ST1164.2 +006300* RESERVE 2 AREAS ST1164.2 +006400* ST1164.2 +006500* SQ-FS1 IS SORTED GIVING SQ-FS2. ST1164.2 +006600* ST1164.2 +006700* SQ-FS2 - ST1164.2 +006800* SAME NUMBER OF RECORDS AS IN SQ-FS1 ( SET BY X-65 ) ST1164.2 +006900* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1164.2 +007000* BLOCKED 2 ST1164.2 +007100* RESERVE 4 AREAS ST1164.2 +007200* ST1164.2 +007300* ST1164.2 +007400* ST1164.2 +007500* ST1164.2 +007600* OPTIONS RECOMMENDED - ST1164.2 +007700* NOT APPLICABLE. ST1164.2 +007800* ST1164.2 +007900* ST1164.2 +008000* TEST DESCRIPTIONS - ST1164.2 +008100* NOT APPLICABLE. ROUTINE ST116 ONLY CONTAINS THE SORT. ST1164.2 +008200* ST1164.2 +008300* ST1164.2 +008400* ************************************************************ ST1164.2 +008500 ENVIRONMENT DIVISION. ST1164.2 +008600 CONFIGURATION SECTION. ST1164.2 +008700 SOURCE-COMPUTER. ST1164.2 +008800 XXXXX082. ST1164.2 +008900 OBJECT-COMPUTER. ST1164.2 +009000 XXXXX083. ST1164.2 +009100 INPUT-OUTPUT SECTION. ST1164.2 +009200 FILE-CONTROL. ST1164.2 +009300 SELECT SQ-FS1 ASSIGN TO ST1164.2 +009400 XXXXD001 ST1164.2 +009500 ORGANIZATION IS SEQUENTIAL ST1164.2 +009600 ACCESS MODE IS SEQUENTIAL. ST1164.2 +009700 SELECT SQ-FS2 ASSIGN TO ST1164.2 +009800 XXXXP002 ST1164.2 +009900 ORGANIZATION IS SEQUENTIAL ST1164.2 +010000 ACCESS MODE IS SEQUENTIAL. ST1164.2 +010100 SELECT ST-FS1 ASSIGN TO ST1164.2 +010200 XXXXX027. ST1164.2 +010300 DATA DIVISION. ST1164.2 +010400 FILE SECTION. ST1164.2 +010500 FD SQ-FS1 ST1164.2 +010600 LABEL RECORDS STANDARD ST1164.2 +010700C VALUE OF ST1164.2 +010800C XXXXX074 ST1164.2 +010900C IS ST1164.2 +011000C XXXXX075 ST1164.2 +011100G XXXXX069 ST1164.2 +011200 BLOCK CONTAINS 1 RECORDS ST1164.2 +011300 RECORD CONTAINS 507 CHARACTERS ST1164.2 +011400 DATA RECORD IS SQ-FS1R1-F-G-507. ST1164.2 +011500 01 SQ-FS1R1-F-G-507. ST1164.2 +011600 10 REC-PREAMBLE PIC X(120). ST1164.2 +011700 10 LENGTH-1 PIC 999. ST1164.2 +011800 10 THE-THREE-KEYS. ST1164.2 +011900 20 KEY-1. ST1164.2 +012000 30 ALPHAN-KEY PIC X. ST1164.2 +012100 30 NUM-KEY PIC 999. ST1164.2 +012200 20 KEY-2. ST1164.2 +012300 30 ALPHAN-KEY PIC X. ST1164.2 +012400 30 NUM-KEY PIC 999. ST1164.2 +012500 20 KEY-3. ST1164.2 +012600 30 ALPHAN-KEY PIC X. ST1164.2 +012700 30 NUM-KEY PIC 999. ST1164.2 +012800 10 STUFF-1 OCCURS ST1164.2 +012900 31 TIMES. ST1164.2 +013000 30 FILL-ME-UPS PIC X(12). ST1164.2 +013100 FD SQ-FS2 ST1164.2 +013200 LABEL RECORDS STANDARD ST1164.2 +013300C VALUE OF ST1164.2 +013400C XXXXX074 ST1164.2 +013500C IS ST1164.2 +013600C XXXXX076 ST1164.2 +013700G XXXXX069 ST1164.2 +013800 BLOCK CONTAINS 2 RECORDS ST1164.2 +013900 RECORD CONTAINS 507 CHARACTERS ST1164.2 +014000 DATA RECORD IS SQ-FS2R1-F-G-507. ST1164.2 +014100 01 SQ-FS2R1-F-G-507. ST1164.2 +014200 10 REC-PRE-2 PIC X(120). ST1164.2 +014300 10 LENGTH-2 PIC 999. ST1164.2 +014400 10 THE-NEW-KEYS. ST1164.2 +014500 20 KEY-4. ST1164.2 +014600 30 ALPHAN-KEY PIC X. ST1164.2 +014700 30 NUM-KEY PIC 999. ST1164.2 +014800 20 KEY-5. ST1164.2 +014900 30 ALPHAN-KEY PIC X. ST1164.2 +015000 30 NUM-KEY PIC 999. ST1164.2 +015100 20 KEY-6. ST1164.2 +015200 30 ALPHAN-KEY PIC X. ST1164.2 +015300 30 NUM-KEY PIC 999. ST1164.2 +015400 10 STUFF-2 OCCURS ST1164.2 +015500 31 TIMES. ST1164.2 +015600 30 FILLER PIC X(12). ST1164.2 +015700 SD ST-FS1 ST1164.2 +015800 RECORD CONTAINS 507 CHARACTERS ST1164.2 +015900 DATA RECORD IS ST-FS1R1-F-G-507. ST1164.2 +016000 01 ST-FS1R1-F-G-507. ST1164.2 +016100 02 FILLER PIC X(120). ST1164.2 +016200 02 LENGTH-3 PIC 999. ST1164.2 +016300 02 NON-KEY-1. ST1164.2 +016400 03 A-KEY-NK1 PIC X. ST1164.2 +016500 03 N-KEY-NK1 PIC 999. ST1164.2 +016600 02 SORT-KEY. ST1164.2 +016700 03 A-KEY-SK PIC X. ST1164.2 +016800 03 N-KEY-SK PIC 999. ST1164.2 +016900 02 NON-KEY-2. ST1164.2 +017000 03 A-KEY-NK2 PIC X. ST1164.2 +017100 03 N-KEY-NK2 PIC 999. ST1164.2 +017200 02 STUFF-3 OCCURS ST1164.2 +017300 31 TIMES. ST1164.2 +017400 03 FILLER PIC X(12). ST1164.2 +017500 PROCEDURE DIVISION. ST1164.2 +017600 SECT-ST116-0001 SECTION. ST1164.2 +017700 SRT-INIT-001. ST1164.2 +017800 SORT ST-FS1 ST1164.2 +017900 ON ASCENDING KEY A-KEY-SK ST1164.2 +018000 ASCENDING N-KEY-NK2 ST1164.2 +018100 USING SQ-FS1 ST1164.2 +018200 GIVING SQ-FS2. ST1164.2 +018300 STOP-THE-RUN. ST1164.2 +018400 STOP RUN. ST1164.2 +*END-OF,ST116A +*HEADER,COBOL,ST115A,SUBPRG,ST117A +000100 IDENTIFICATION DIVISION. ST1174.2 +000200 PROGRAM-ID. ST1174.2 +000300 ST117A. ST1174.2 +000400**************************************************************** ST1174.2 +000500* * ST1174.2 +000600* VALIDATION FOR:- * ST1174.2 +000700* * ST1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +000900* * ST1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2 +001100* * ST1174.2 +001200**************************************************************** ST1174.2 +001300* * ST1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1174.2 +001500* * ST1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1174.2 +001900* * ST1174.2 +002000**************************************************************** ST1174.2 +002100* ST1174.2 +002200* ST1174.2 +002300* ST117 ST1174.2 +002400* ST1174.2 +002500* ST1174.2 +002600* OBJECTIVE - ST1174.2 +002700* ROUTINE ST117 CHECKS THE FILE ( SQ-FS2 ) WHICH IS GIVEN ST1174.2 +002800* BY THE SORT IN ST116. THE ALPHANUMERIC KEYS AND NUMERIC KEYSST1174.2 +002900* ARE BOTH CHECKED BY ST117. ST1174.2 +003000* ST1174.2 +003100* ST1174.2 +003200* FEATURES TESTED - ST1174.2 +003300* * FIXED LENGTH RECORDS ST1174.2 +003400* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1174.2 +003500* ST1174.2 +003600* ST1174.2 +003700* ST1174.2 +003800* ANSI X3.23-1974 REFERENCES - ST1174.2 +003900* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1174.2 +004000* ST1174.2 +004100* ST1174.2 +004200* FILES USED - ST1174.2 +004300* * FILE SQ-FS2 CAN BE ON MAGNETIC TAPE OR MASS-STORAGE. ST1174.2 +004400* ST1174.2 +004500* SQ-FS2 - ST1174.2 +004600* NUMBER OF RECORDS IS SET IN X-65 ST1174.2 +004700* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1174.2 +004800* BLOCKED 2 ST1174.2 +004900* RESERVE 4 AREAS ST1174.2 +005000* ST1174.2 +005100* ST1174.2 +005200* X-CARDS USED - ST1174.2 +005300* X-XXXD02 SQ-FS2 ST1174.2 +005400* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER (NOTE ST1174.2 +005500* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-63 ST1174.2 +005600* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1174.2 +005700* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1174.2 +005800* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1174.2 +005900* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-63 CARD..... ST1174.2 +006000* ST1174.2 +006100* X-63 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1174.2 +006200* ST1174.2 +006300* X-XXX065 4 DIGIT INTEGER FOR THE NUMBER OF RECORDS IN ST1174.2 +006400* THE FILE SQ-FS2. ST1174.2 +006500* ST1174.2 +006600* ST1174.2 +006700* OPTIONS RECOMMENDED - ST1174.2 +006800* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1174.2 +006900* FILE SQ-FS2. ST1174.2 +007000* ST1174.2 +007100* ST1174.2 +007200* TEST DESCRIPTIONS - ST1174.2 +007300* THE INTEGER X-65 IS DIVIDED BY 51. THIS IS THE NUMBER ST1174.2 +007400* OF DUPLICATE RECORD KEYS THAT ARE EXPECTED IN SQ-FS2. THESE ST1174.2 +007500* KEYS SHOULD BE THE LOWEST CHARACTER IN THE NATIVE COLLATING ST1174.2 +007600* SEQUENCE. ALL OF THE NUMERIC KEYS FOR THESE RECORDS SHOULD ST1174.2 +007700* BE IN ASCENDING ORDER. ST1174.2 +007800* ST1174.2 +007900* ST1174.2 +008000* ************************************************************ ST1174.2 +008100 ENVIRONMENT DIVISION. ST1174.2 +008200 CONFIGURATION SECTION. ST1174.2 +008300 SOURCE-COMPUTER. ST1174.2 +008400 XXXXX082. ST1174.2 +008500 OBJECT-COMPUTER. ST1174.2 +008600 XXXXX083. ST1174.2 +008700 INPUT-OUTPUT SECTION. ST1174.2 +008800 FILE-CONTROL. ST1174.2 +008900 SELECT PRINT-FILE ASSIGN TO ST1174.2 +009000 XXXXX055. ST1174.2 +009100 SELECT SQ-FS2 ASSIGN TO ST1174.2 +009200 XXXXD002 ST1174.2 +009300 ORGANIZATION IS SEQUENTIAL ST1174.2 +009400 ACCESS MODE IS SEQUENTIAL. ST1174.2 +009500 DATA DIVISION. ST1174.2 +009600 FILE SECTION. ST1174.2 +009700 FD PRINT-FILE. ST1174.2 +009800 01 PRINT-REC PICTURE X(120). ST1174.2 +009900 01 DUMMY-RECORD PICTURE X(120). ST1174.2 +010000 FD SQ-FS2 ST1174.2 +010100 LABEL RECORDS STANDARD ST1174.2 +010200C VALUE OF ST1174.2 +010300C XXXXX074 ST1174.2 +010400C IS ST1174.2 +010500C XXXXX076 ST1174.2 +010600G XXXXX069 ST1174.2 +010700 BLOCK CONTAINS 2 RECORDS ST1174.2 +010800 RECORD CONTAINS 507 CHARACTERS ST1174.2 +010900 DATA RECORD SQ-FS2R1-F-G-507. ST1174.2 +011000 01 SQ-FS2R1-F-G-507. ST1174.2 +011100 10 REC-PRE-2 PIC X(120). ST1174.2 +011200 10 LENGTH-2 PIC 999. ST1174.2 +011300 10 THOSE-LOVABLE-KEYS. ST1174.2 +011400 20 KEY-4. ST1174.2 +011500 30 ALPHAN-KEY-K4 PIC X. ST1174.2 +011600 30 NUM-KEY-K4 PIC 999. ST1174.2 +011700 20 KEY-5. ST1174.2 +011800 30 ALPHAN-KEY-K5 PIC X. ST1174.2 +011900 30 NUM-KEY-K5 PIC 999. ST1174.2 +012000 20 KEY-6. ST1174.2 +012100 30 ALPHAN-KEY-K6 PIC X. ST1174.2 +012200 30 NUM-KEY-K6 PIC 999. ST1174.2 +012300 10 STUFF-FOR-FUN OCCURS ST1174.2 +012400 31 TIMES. ST1174.2 +012500 30 FILLER PIC X(12). ST1174.2 +012600 WORKING-STORAGE SECTION. ST1174.2 +012700 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1174.2 +012800 77 WRK-DU-9-2 PIC 9 VALUE 0. ST1174.2 +012900 77 WRK-DU-999-0001 PIC 999. ST1174.2 +013000 77 WRK-DU-999-2 PIC 999 VALUE 000. ST1174.2 +013100 77 WRK-DU-999-3 PIC 999 VALUE ZERO. ST1174.2 +013200 77 NUMBER-OF-SETS PIC 999 VALUE ZERO. ST1174.2 +013300X77 COUNT-OF-RECS PIC 9(6) VALUE ZERO. ST1174.2 +013400 01 WRK-XN-2 PIC X(51) VALUE ST1174.2 +013500 " * G BAIRD, USNAVY ". ST1174.2 +013600 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1174.2 +013700 02 ANSWER PIC X OCCURS 51 TIMES. ST1174.2 +013800 01 FILE-RECORD-INFORMATION-REC. ST1174.2 +013900 03 FILE-RECORD-INFO-SKELETON. ST1174.2 +014000 05 FILLER PICTURE X(48) VALUE ST1174.2 +014100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1174.2 +014200 05 FILLER PICTURE X(46) VALUE ST1174.2 +014300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1174.2 +014400 05 FILLER PICTURE X(26) VALUE ST1174.2 +014500 ",LFIL=000000,ORG= ,LBLR= ". ST1174.2 +014600 05 FILLER PICTURE X(37) VALUE ST1174.2 +014700 ",RECKEY= ". ST1174.2 +014800 05 FILLER PICTURE X(38) VALUE ST1174.2 +014900 ",ALTKEY1= ". ST1174.2 +015000 05 FILLER PICTURE X(38) VALUE ST1174.2 +015100 ",ALTKEY2= ". ST1174.2 +015200 05 FILLER PICTURE X(7) VALUE SPACE.ST1174.2 +015300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1174.2 +015400 05 FILE-RECORD-INFO-P1-120. ST1174.2 +015500 07 FILLER PIC X(5). ST1174.2 +015600 07 XFILE-NAME PIC X(6). ST1174.2 +015700 07 FILLER PIC X(8). ST1174.2 +015800 07 XRECORD-NAME PIC X(6). ST1174.2 +015900 07 FILLER PIC X(1). ST1174.2 +016000 07 REELUNIT-NUMBER PIC 9(1). ST1174.2 +016100 07 FILLER PIC X(7). ST1174.2 +016200 07 XRECORD-NUMBER PIC 9(6). ST1174.2 +016300 07 FILLER PIC X(6). ST1174.2 +016400 07 UPDATE-NUMBER PIC 9(2). ST1174.2 +016500 07 FILLER PIC X(5). ST1174.2 +016600 07 ODO-NUMBER PIC 9(4). ST1174.2 +016700 07 FILLER PIC X(5). ST1174.2 +016800 07 XPROGRAM-NAME PIC X(5). ST1174.2 +016900 07 FILLER PIC X(7). ST1174.2 +017000 07 XRECORD-LENGTH PIC 9(6). ST1174.2 +017100 07 FILLER PIC X(7). ST1174.2 +017200 07 CHARS-OR-RECORDS PIC X(2). ST1174.2 +017300 07 FILLER PIC X(1). ST1174.2 +017400 07 XBLOCK-SIZE PIC 9(4). ST1174.2 +017500 07 FILLER PIC X(6). ST1174.2 +017600 07 RECORDS-IN-FILE PIC 9(6). ST1174.2 +017700 07 FILLER PIC X(5). ST1174.2 +017800 07 XFILE-ORGANIZATION PIC X(2). ST1174.2 +017900 07 FILLER PIC X(6). ST1174.2 +018000 07 XLABEL-TYPE PIC X(1). ST1174.2 +018100 05 FILE-RECORD-INFO-P121-240. ST1174.2 +018200 07 FILLER PIC X(8). ST1174.2 +018300 07 XRECORD-KEY PIC X(29). ST1174.2 +018400 07 FILLER PIC X(9). ST1174.2 +018500 07 ALTERNATE-KEY1 PIC X(29). ST1174.2 +018600 07 FILLER PIC X(9). ST1174.2 +018700 07 ALTERNATE-KEY2 PIC X(29). ST1174.2 +018800 07 FILLER PIC X(7). ST1174.2 +018900 01 TEST-RESULTS. ST1174.2 +019000 02 FILLER PIC X VALUE SPACE. ST1174.2 +019100 02 FEATURE PIC X(20) VALUE SPACE. ST1174.2 +019200 02 FILLER PIC X VALUE SPACE. ST1174.2 +019300 02 P-OR-F PIC X(5) VALUE SPACE. ST1174.2 +019400 02 FILLER PIC X VALUE SPACE. ST1174.2 +019500 02 PAR-NAME. ST1174.2 +019600 03 FILLER PIC X(19) VALUE SPACE. ST1174.2 +019700 03 PARDOT-X PIC X VALUE SPACE. ST1174.2 +019800 03 DOTVALUE PIC 99 VALUE ZERO. ST1174.2 +019900 02 FILLER PIC X(8) VALUE SPACE. ST1174.2 +020000 02 RE-MARK PIC X(61). ST1174.2 +020100 01 TEST-COMPUTED. ST1174.2 +020200 02 FILLER PIC X(30) VALUE SPACE. ST1174.2 +020300 02 FILLER PIC X(17) VALUE ST1174.2 +020400 " COMPUTED=". ST1174.2 +020500 02 COMPUTED-X. ST1174.2 +020600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1174.2 +020700 03 COMPUTED-N REDEFINES COMPUTED-A ST1174.2 +020800 PIC -9(9).9(9). ST1174.2 +020900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1174.2 +021000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1174.2 +021100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1174.2 +021200 03 CM-18V0 REDEFINES COMPUTED-A. ST1174.2 +021300 04 COMPUTED-18V0 PIC -9(18). ST1174.2 +021400 04 FILLER PIC X. ST1174.2 +021500 03 FILLER PIC X(50) VALUE SPACE. ST1174.2 +021600 01 TEST-CORRECT. ST1174.2 +021700 02 FILLER PIC X(30) VALUE SPACE. ST1174.2 +021800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1174.2 +021900 02 CORRECT-X. ST1174.2 +022000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1174.2 +022100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1174.2 +022200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1174.2 +022300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1174.2 +022400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1174.2 +022500 03 CR-18V0 REDEFINES CORRECT-A. ST1174.2 +022600 04 CORRECT-18V0 PIC -9(18). ST1174.2 +022700 04 FILLER PIC X. ST1174.2 +022800 03 FILLER PIC X(2) VALUE SPACE. ST1174.2 +022900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1174.2 +023000 01 CCVS-C-1. ST1174.2 +023100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1174.2 +023200- "SS PARAGRAPH-NAME ST1174.2 +023300- " REMARKS". ST1174.2 +023400 02 FILLER PIC X(20) VALUE SPACE. ST1174.2 +023500 01 CCVS-C-2. ST1174.2 +023600 02 FILLER PIC X VALUE SPACE. ST1174.2 +023700 02 FILLER PIC X(6) VALUE "TESTED". ST1174.2 +023800 02 FILLER PIC X(15) VALUE SPACE. ST1174.2 +023900 02 FILLER PIC X(4) VALUE "FAIL". ST1174.2 +024000 02 FILLER PIC X(94) VALUE SPACE. ST1174.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1174.2 +024200 01 REC-CT PIC 99 VALUE ZERO. ST1174.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1174.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1174.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1174.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1174.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1174.2 +025200 01 CCVS-H-1. ST1174.2 +025300 02 FILLER PIC X(39) VALUE SPACES. ST1174.2 +025400 02 FILLER PIC X(42) VALUE ST1174.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1174.2 +025600 02 FILLER PIC X(39) VALUE SPACES. ST1174.2 +025700 01 CCVS-H-2A. ST1174.2 +025800 02 FILLER PIC X(40) VALUE SPACE. ST1174.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1174.2 +026000 02 FILLER PIC XXXX VALUE ST1174.2 +026100 "4.2 ". ST1174.2 +026200 02 FILLER PIC X(28) VALUE ST1174.2 +026300 " COPY - NOT FOR DISTRIBUTION". ST1174.2 +026400 02 FILLER PIC X(41) VALUE SPACE. ST1174.2 +026500 ST1174.2 +026600 01 CCVS-H-2B. ST1174.2 +026700 02 FILLER PIC X(15) VALUE ST1174.2 +026800 "TEST RESULT OF ". ST1174.2 +026900 02 TEST-ID PIC X(9). ST1174.2 +027000 02 FILLER PIC X(4) VALUE ST1174.2 +027100 " IN ". ST1174.2 +027200 02 FILLER PIC X(12) VALUE ST1174.2 +027300 " HIGH ". ST1174.2 +027400 02 FILLER PIC X(22) VALUE ST1174.2 +027500 " LEVEL VALIDATION FOR ". ST1174.2 +027600 02 FILLER PIC X(58) VALUE ST1174.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +027800 01 CCVS-H-3. ST1174.2 +027900 02 FILLER PIC X(34) VALUE ST1174.2 +028000 " FOR OFFICIAL USE ONLY ". ST1174.2 +028100 02 FILLER PIC X(58) VALUE ST1174.2 +028200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2 +028300 02 FILLER PIC X(28) VALUE ST1174.2 +028400 " COPYRIGHT 1985 ". ST1174.2 +028500 01 CCVS-E-1. ST1174.2 +028600 02 FILLER PIC X(52) VALUE SPACE. ST1174.2 +028700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1174.2 +028800 02 ID-AGAIN PIC X(9). ST1174.2 +028900 02 FILLER PIC X(45) VALUE SPACES. ST1174.2 +029000 01 CCVS-E-2. ST1174.2 +029100 02 FILLER PIC X(31) VALUE SPACE. ST1174.2 +029200 02 FILLER PIC X(21) VALUE SPACE. ST1174.2 +029300 02 CCVS-E-2-2. ST1174.2 +029400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1174.2 +029500 03 FILLER PIC X VALUE SPACE. ST1174.2 +029600 03 ENDER-DESC PIC X(44) VALUE ST1174.2 +029700 "ERRORS ENCOUNTERED". ST1174.2 +029800 01 CCVS-E-3. ST1174.2 +029900 02 FILLER PIC X(22) VALUE ST1174.2 +030000 " FOR OFFICIAL USE ONLY". ST1174.2 +030100 02 FILLER PIC X(12) VALUE SPACE. ST1174.2 +030200 02 FILLER PIC X(58) VALUE ST1174.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +030400 02 FILLER PIC X(13) VALUE SPACE. ST1174.2 +030500 02 FILLER PIC X(15) VALUE ST1174.2 +030600 " COPYRIGHT 1985". ST1174.2 +030700 01 CCVS-E-4. ST1174.2 +030800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1174.2 +030900 02 FILLER PIC X(4) VALUE " OF ". ST1174.2 +031000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1174.2 +031100 02 FILLER PIC X(40) VALUE ST1174.2 +031200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1174.2 +031300 01 XXINFO. ST1174.2 +031400 02 FILLER PIC X(19) VALUE ST1174.2 +031500 "*** INFORMATION ***". ST1174.2 +031600 02 INFO-TEXT. ST1174.2 +031700 04 FILLER PIC X(8) VALUE SPACE. ST1174.2 +031800 04 XXCOMPUTED PIC X(20). ST1174.2 +031900 04 FILLER PIC X(5) VALUE SPACE. ST1174.2 +032000 04 XXCORRECT PIC X(20). ST1174.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). ST1174.2 +032200 01 HYPHEN-LINE. ST1174.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. ST1174.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************ST1174.2 +032500- "*****************************************". ST1174.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************ST1174.2 +032700- "******************************". ST1174.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE ST1174.2 +032900 "ST117A". ST1174.2 +033000 PROCEDURE DIVISION. ST1174.2 +033100 CCVS1 SECTION. ST1174.2 +033200 OPEN-FILES. ST1174.2 +033300 OPEN OUTPUT PRINT-FILE. ST1174.2 +033400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1174.2 +033500 MOVE SPACE TO TEST-RESULTS. ST1174.2 +033600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1174.2 +033700 MOVE ZERO TO REC-SKL-SUB. ST1174.2 +033800 PERFORM CCVS-INIT-FILE 9 TIMES. ST1174.2 +033900 CCVS-INIT-FILE. ST1174.2 +034000 ADD 1 TO REC-SKL-SUB. ST1174.2 +034100 MOVE FILE-RECORD-INFO-SKELETON ST1174.2 +034200 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1174.2 +034300 CCVS-INIT-EXIT. ST1174.2 +034400 GO TO CCVS1-EXIT. ST1174.2 +034500 CLOSE-FILES. ST1174.2 +034600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1174.2 +034700 TERMINATE-CCVS. ST1174.2 +034800S EXIT PROGRAM. ST1174.2 +034900STERMINATE-CALL. ST1174.2 +035000 STOP RUN. ST1174.2 +035100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1174.2 +035200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1174.2 +035300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1174.2 +035400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1174.2 +035500 MOVE "****TEST DELETED****" TO RE-MARK. ST1174.2 +035600 PRINT-DETAIL. ST1174.2 +035700 IF REC-CT NOT EQUAL TO ZERO ST1174.2 +035800 MOVE "." TO PARDOT-X ST1174.2 +035900 MOVE REC-CT TO DOTVALUE. ST1174.2 +036000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1174.2 +036100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1174.2 +036200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1174.2 +036300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1174.2 +036400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1174.2 +036500 MOVE SPACE TO CORRECT-X. ST1174.2 +036600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1174.2 +036700 MOVE SPACE TO RE-MARK. ST1174.2 +036800 HEAD-ROUTINE. ST1174.2 +036900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2 +037200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2 +037300 COLUMN-NAMES-ROUTINE. ST1174.2 +037400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +037500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +037700 END-ROUTINE. ST1174.2 +037800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1174.2 +037900 END-RTN-EXIT. ST1174.2 +038000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +038100 END-ROUTINE-1. ST1174.2 +038200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1174.2 +038300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1174.2 +038400 ADD PASS-COUNTER TO ERROR-HOLD. ST1174.2 +038500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1174.2 +038600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1174.2 +038700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1174.2 +038800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1174.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1174.2 +039000 END-ROUTINE-12. ST1174.2 +039100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1174.2 +039200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1174.2 +039300 MOVE "NO " TO ERROR-TOTAL ST1174.2 +039400 ELSE ST1174.2 +039500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1174.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1174.2 +039700 PERFORM WRITE-LINE. ST1174.2 +039800 END-ROUTINE-13. ST1174.2 +039900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1174.2 +040000 MOVE "NO " TO ERROR-TOTAL ELSE ST1174.2 +040100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1174.2 +040200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1174.2 +040300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +040400 IF INSPECT-COUNTER EQUAL TO ZERO ST1174.2 +040500 MOVE "NO " TO ERROR-TOTAL ST1174.2 +040600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1174.2 +040700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1174.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +040900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +041000 WRITE-LINE. ST1174.2 +041100 ADD 1 TO RECORD-COUNT. ST1174.2 +041200Y IF RECORD-COUNT GREATER 42 ST1174.2 +041300Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1174.2 +041400Y MOVE SPACE TO DUMMY-RECORD ST1174.2 +041500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1174.2 +041600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2 +041700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2 +041800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2 +041900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2 +042000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1174.2 +042400Y MOVE ZERO TO RECORD-COUNT. ST1174.2 +042500 PERFORM WRT-LN. ST1174.2 +042600 WRT-LN. ST1174.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +042800 MOVE SPACE TO DUMMY-RECORD. ST1174.2 +042900 BLANK-LINE-PRINT. ST1174.2 +043000 PERFORM WRT-LN. ST1174.2 +043100 FAIL-ROUTINE. ST1174.2 +043200 IF COMPUTED-X NOT EQUAL TO SPACE ST1174.2 +043300 GO TO FAIL-ROUTINE-WRITE. ST1174.2 +043400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1174.2 +043500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2 +043600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1174.2 +043700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +043800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2 +043900 GO TO FAIL-ROUTINE-EX. ST1174.2 +044000 FAIL-ROUTINE-WRITE. ST1174.2 +044100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1174.2 +044200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1174.2 +044300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1174.2 +044400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1174.2 +044500 FAIL-ROUTINE-EX. EXIT. ST1174.2 +044600 BAIL-OUT. ST1174.2 +044700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1174.2 +044800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1174.2 +044900 BAIL-OUT-WRITE. ST1174.2 +045000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1174.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2 +045400 BAIL-OUT-EX. EXIT. ST1174.2 +045500 CCVS1-EXIT. ST1174.2 +045600 EXIT. ST1174.2 +045700 SECT-ST117-0001 SECTION. ST1174.2 +045800 SRT-INIT. ST1174.2 +045900 OPEN INPUT SQ-FS2. ST1174.2 +046000 MOVE "BIG-SORT" TO PAR-NAME. ST1174.2 +046100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1174.2 +046200 MOVE 0 TO WRK-DU-9-0001. ST1174.2 +046300 MOVE 0 TO WRK-DU-9-2. ST1174.2 +046400 MOVE 0 TO WRK-DU-999-3. ST1174.2 +046500 DIVIDE ST1174.2 +046600 XXXXX065 ST1174.2 +046700 BY 51 GIVING NUMBER-OF-SETS. ST1174.2 +046800* ST1174.2 +046900* FOR EVERY SET OF 51 RECORDS CREATED AS THE ORIGINAL INPUT ST1174.2 +047000* FILE FOR THE SORT ( X-65 / 51 ), THEN THERE SHOULD BE AT ST1174.2 +047100* LEAST THAT NUMBER OF DUPLICATE ALPHANUMERIC KEYS AS THE ST1174.2 +047200* FIRST N RECORDS IN THE SORTED FILE SQ-FS2. THAT MANY ST1174.2 +047300* RECORDS WILL BE READ AND THE KEYS SHOULD BE THE LOWEST ST1174.2 +047400* CHARACTER IN THE NATIVE COLLATING SEQUENCE. THE NUMERIC ST1174.2 +047500* KEYS SHOULD ALWAYS BE ASCENDING. ST1174.2 +047600* ST1174.2 +047700 MOVE 1 TO WRK-DU-999-0001. ST1174.2 +047800 SRT-INIT-01. ST1174.2 +047900 PERFORM RD-2 THRU R2-EXIT. ST1174.2 +048000 ADD 1 TO WRK-DU-999-0001. ST1174.2 +048100 IF WRK-DU-999-0001 IS NOT GREATER THAN NUMBER-OF-SETS ST1174.2 +048200 GO TO SRT-INIT-01. ST1174.2 +048300 IF WRK-DU-9-2 IS EQUAL TO 0 ST1174.2 +048400 PERFORM PASS ST1174.2 +048500 GO TO SRT-WRITE ST1174.2 +048600 ELSE ST1174.2 +048700 PERFORM FAIL ST1174.2 +048800 MOVE "ERROR AT RECORD" TO COMPUTED-A ST1174.2 +048900 MOVE WRK-DU-999-2 TO CORRECT-18V0 ST1174.2 +049000 MOVE "FILE SQ-FS2 PASSED FROM ST116" TO RE-MARK ST1174.2 +049100 GO TO SRT-WRITE. ST1174.2 +049200 SRT-DELETE. ST1174.2 +049300 PERFORM DE-LETE. ST1174.2 +049400 SRT-WRITE. ST1174.2 +049500 PERFORM PRINT-DETAIL. ST1174.2 +049600 CLOSE SQ-FS2. ST1174.2 +049700 GO TO ST117-END. ST1174.2 +049800 RD-2. ST1174.2 +049900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1174.2 +050000 GO TO R2-EXIT. ST1174.2 +050100 READ SQ-FS2 AT END GO TO PREMATURE-EOF. ST1174.2 +050200 IF ALPHAN-KEY-K6 IS NOT EQUAL TO ANSWER (1) ST1174.2 +050300 MOVE 1 TO WRK-DU-9-2 ST1174.2 +050400 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2 +050500 MOVE 1 TO WRK-DU-9-0001. ST1174.2 +050600 IF NUM-KEY-K6 IS NOT GREATER THAN WRK-DU-999-3 ST1174.2 +050700 MOVE 1 TO WRK-DU-9-2 ST1174.2 +050800 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2 +050900 MOVE 1 TO WRK-DU-9-0001 ST1174.2 +051000 ELSE ST1174.2 +051100 MOVE NUM-KEY-K6 TO WRK-DU-999-3 ST1174.2 +051200 GO TO R2-EXIT. ST1174.2 +051300 PREMATURE-EOF. ST1174.2 +051400 MOVE 1 TO WRK-DU-9-0001. ST1174.2 +051500 PERFORM FAIL. ST1174.2 +051600 MOVE "AT RECORD" TO COMPUTED-A. ST1174.2 +051700 MOVE WRK-DU-999-0001 TO CORRECT-18V0. ST1174.2 +051800 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1174.2 +051900 R2-EXIT. ST1174.2 +052000 EXIT. ST1174.2 +052100 ST117-END. ST1174.2 +052200 EXIT. ST1174.2 +052300XFILEDUMP SECTION. ST1174.2 +052400XFILE-2-DUMP-INIT. ST1174.2 +052500X OPEN INPUT SQ-FS2. ST1174.2 +052600X MOVE ZERO TO COUNT-OF-RECS. ST1174.2 +052700XFILE-2-DUMP. ST1174.2 +052800X READ SQ-FS2 RECORD ST1174.2 +052900X AT END GO TO FILE-2-DUMP-END. ST1174.2 +053000X ADD 1 TO COUNT-OF-RECS. ST1174.2 +053100X IF COUNT-OF-RECS GREATER THAN ST1174.2 +053200X XXXXX065 ST1174.2 +053300X MOVE " TOO MANY RECORDS" TO DUMMY-RECORD ST1174.2 +053400X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES ST1174.2 +053500X GO TO FILE-2-DUMP-END. ST1174.2 +053600X PERFORM FILE-2-DUMP-WRITE. ST1174.2 +053700X GO TO FILE-2-DUMP. ST1174.2 +053800XFILE-2-DUMP-WRITE. ST1174.2 +053900X MOVE SQ-FS2R1-F-G-507 TO DUMMY-RECORD. ST1174.2 +054000X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054100XFILE-2-DUMP-END. ST1174.2 +054200X MOVE " NUMBER OF SORTED RECORDS ON SQ-FS2 SHOWN BELOW" ST1174.2 +054300X TO DUMMY-RECORD. ST1174.2 +054400X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054500X MOVE COUNT-OF-RECS TO DUMMY-RECORD. ST1174.2 +054600X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054700X CLOSE SQ-FS2. ST1174.2 +054800 CCVS-EXIT SECTION. ST1174.2 +054900 CCVS-999999. ST1174.2 +055000 GO TO CLOSE-FILES. ST1174.2 +*END-OF,ST117A +*HEADER,COBOL,ST118A +000100 IDENTIFICATION DIVISION. ST1184.2 +000200 PROGRAM-ID. ST1184.2 +000300 ST118A. ST1184.2 +000400**************************************************************** ST1184.2 +000500* * ST1184.2 +000600* VALIDATION FOR:- * ST1184.2 +000700* * ST1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +000900* * ST1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1184.2 +001100* * ST1184.2 +001200**************************************************************** ST1184.2 +001300* * ST1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1184.2 +001500* * ST1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1184.2 +001900* * ST1184.2 +002000**************************************************************** ST1184.2 +002100* ST118 IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1184.2 +002200* PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE ST1184.2 +002300* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1184.2 +002400* REPORT. ST1184.2 +002500* SORT SORT SORT SORT SORT SORT SORT SORT ST1184.2 +002600* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8ST1184.2 +002700* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 ST1184.2 +002800* SIGN JUST SIGN JUST SIGN ST1184.2 +002900* LEADING RIGHT TRAILIN RIGHT TRAIL ST1184.2 +003000* SEPARAT SEPARAT ST1184.2 +003100* ST1184.2 +003200* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003300* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003400* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003500* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1184.2 +003600* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1184.2 +003700* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1184.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1184.2 +003900* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1184.2 +004000* ST1184.2 +004100* THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT ST1184.2 +004200* ASCENDING KEYS IN ONE FILE. ST1184.2 +004300* ST1184.2 +004400* ASCENDING KEYS IN ONE FILE. EACH OF THE KEYS IDENTIFIED ST1184.2 +004500* IN THE SORT STATEMENT ARE ELEMENTARY DATA ITEMS AND USE ST1184.2 +004600* VARIOUS COMBINATIONS OF PICTURE CHARACTER-STRING SYMBOLS AND ST1184.2 +004700* CLAUSES FOR DESCRIBING THE GENERAL CHARACTERISTICS OF THE ST1184.2 +004800* DATA ITEM. ST1184.2 +004900* THIS PROGRAM IS A REWRITE OF ST108. THE PURPOSE OF THIS ST1184.2 +005000* PROGRAM IS TO VERIFY THAT RECORDS ARE PROPERLY SORTED WHEN ST1184.2 +005100* THE SORT KEYS OF THE SORT STATEMENT USE DATA DEFINITIONS ST1184.2 +005200* WHICH INCLUDE THE SIGN CLAUSE. ST1184.2 +005300 ENVIRONMENT DIVISION. ST1184.2 +005400 CONFIGURATION SECTION. ST1184.2 +005500 SOURCE-COMPUTER. ST1184.2 +005600 XXXXX082. ST1184.2 +005700 OBJECT-COMPUTER. ST1184.2 +005800 XXXXX083. ST1184.2 +005900 INPUT-OUTPUT SECTION. ST1184.2 +006000 FILE-CONTROL. ST1184.2 +006100 SELECT PRINT-FILE ASSIGN TO ST1184.2 +006200 XXXXX055. ST1184.2 +006300 SELECT SORTFILE-1H ASSIGN TO ST1184.2 +006400 XXXXX027. ST1184.2 +006500 DATA DIVISION. ST1184.2 +006600 FILE SECTION. ST1184.2 +006700 FD PRINT-FILE. ST1184.2 +006800 01 PRINT-REC PICTURE X(120). ST1184.2 +006900 01 DUMMY-RECORD PICTURE X(120). ST1184.2 +007000 SD SORTFILE-1H ST1184.2 +007100 DATA RECORD IS SORTFILE-REC. ST1184.2 +007200 01 SORTFILE-REC. ST1184.2 +007300 02 SORTKEY-8 PICTURE S99 SIGN IS TRAILING. ST1184.2 +007400 02 SORTKEY-1 PICTURE S9(6) SIGN IS LEADING SEPARATE. ST1184.2 +007500 02 SORTKEY-7 PICTURE 999. ST1184.2 +007600 02 SORTKEY-3 PICTURE SV9(16) SIGN IS TRAILING SEPARATE. ST1184.2 +007700 02 FILLER PICTURE XX. ST1184.2 +007800 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1184.2 +007900 02 SORTKEY-6 PICTURE X(10). ST1184.2 +008000 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1184.2 +008100 02 SORTKEY-5 PICTURE A(20). ST1184.2 +008200 02 FILLER PICTURE XXX. ST1184.2 +008300 WORKING-STORAGE SECTION. ST1184.2 +008400 77 UTIL-CTR PICTURE S99999. ST1184.2 +008500 77 SPAC-E PICTURE X VALUE " ". ST1184.2 +008600 01 TEST-RESULTS. ST1184.2 +008700 02 FILLER PIC X VALUE SPACE. ST1184.2 +008800 02 FEATURE PIC X(20) VALUE SPACE. ST1184.2 +008900 02 FILLER PIC X VALUE SPACE. ST1184.2 +009000 02 P-OR-F PIC X(5) VALUE SPACE. ST1184.2 +009100 02 FILLER PIC X VALUE SPACE. ST1184.2 +009200 02 PAR-NAME. ST1184.2 +009300 03 FILLER PIC X(19) VALUE SPACE. ST1184.2 +009400 03 PARDOT-X PIC X VALUE SPACE. ST1184.2 +009500 03 DOTVALUE PIC 99 VALUE ZERO. ST1184.2 +009600 02 FILLER PIC X(8) VALUE SPACE. ST1184.2 +009700 02 RE-MARK PIC X(61). ST1184.2 +009800 01 TEST-COMPUTED. ST1184.2 +009900 02 FILLER PIC X(30) VALUE SPACE. ST1184.2 +010000 02 FILLER PIC X(17) VALUE ST1184.2 +010100 " COMPUTED=". ST1184.2 +010200 02 COMPUTED-X. ST1184.2 +010300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1184.2 +010400 03 COMPUTED-N REDEFINES COMPUTED-A ST1184.2 +010500 PIC -9(9).9(9). ST1184.2 +010600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1184.2 +010700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1184.2 +010800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1184.2 +010900 03 CM-18V0 REDEFINES COMPUTED-A. ST1184.2 +011000 04 COMPUTED-18V0 PIC -9(18). ST1184.2 +011100 04 FILLER PIC X. ST1184.2 +011200 03 FILLER PIC X(50) VALUE SPACE. ST1184.2 +011300 01 TEST-CORRECT. ST1184.2 +011400 02 FILLER PIC X(30) VALUE SPACE. ST1184.2 +011500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1184.2 +011600 02 CORRECT-X. ST1184.2 +011700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1184.2 +011800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1184.2 +011900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1184.2 +012000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1184.2 +012100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1184.2 +012200 03 CR-18V0 REDEFINES CORRECT-A. ST1184.2 +012300 04 CORRECT-18V0 PIC -9(18). ST1184.2 +012400 04 FILLER PIC X. ST1184.2 +012500 03 FILLER PIC X(2) VALUE SPACE. ST1184.2 +012600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1184.2 +012700 01 CCVS-C-1. ST1184.2 +012800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1184.2 +012900- "SS PARAGRAPH-NAME ST1184.2 +013000- " REMARKS". ST1184.2 +013100 02 FILLER PIC X(20) VALUE SPACE. ST1184.2 +013200 01 CCVS-C-2. ST1184.2 +013300 02 FILLER PIC X VALUE SPACE. ST1184.2 +013400 02 FILLER PIC X(6) VALUE "TESTED". ST1184.2 +013500 02 FILLER PIC X(15) VALUE SPACE. ST1184.2 +013600 02 FILLER PIC X(4) VALUE "FAIL". ST1184.2 +013700 02 FILLER PIC X(94) VALUE SPACE. ST1184.2 +013800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1184.2 +013900 01 REC-CT PIC 99 VALUE ZERO. ST1184.2 +014000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1184.2 +014500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1184.2 +014600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1184.2 +014700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1184.2 +014800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1184.2 +014900 01 CCVS-H-1. ST1184.2 +015000 02 FILLER PIC X(39) VALUE SPACES. ST1184.2 +015100 02 FILLER PIC X(42) VALUE ST1184.2 +015200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1184.2 +015300 02 FILLER PIC X(39) VALUE SPACES. ST1184.2 +015400 01 CCVS-H-2A. ST1184.2 +015500 02 FILLER PIC X(40) VALUE SPACE. ST1184.2 +015600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1184.2 +015700 02 FILLER PIC XXXX VALUE ST1184.2 +015800 "4.2 ". ST1184.2 +015900 02 FILLER PIC X(28) VALUE ST1184.2 +016000 " COPY - NOT FOR DISTRIBUTION". ST1184.2 +016100 02 FILLER PIC X(41) VALUE SPACE. ST1184.2 +016200 ST1184.2 +016300 01 CCVS-H-2B. ST1184.2 +016400 02 FILLER PIC X(15) VALUE ST1184.2 +016500 "TEST RESULT OF ". ST1184.2 +016600 02 TEST-ID PIC X(9). ST1184.2 +016700 02 FILLER PIC X(4) VALUE ST1184.2 +016800 " IN ". ST1184.2 +016900 02 FILLER PIC X(12) VALUE ST1184.2 +017000 " HIGH ". ST1184.2 +017100 02 FILLER PIC X(22) VALUE ST1184.2 +017200 " LEVEL VALIDATION FOR ". ST1184.2 +017300 02 FILLER PIC X(58) VALUE ST1184.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +017500 01 CCVS-H-3. ST1184.2 +017600 02 FILLER PIC X(34) VALUE ST1184.2 +017700 " FOR OFFICIAL USE ONLY ". ST1184.2 +017800 02 FILLER PIC X(58) VALUE ST1184.2 +017900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1184.2 +018000 02 FILLER PIC X(28) VALUE ST1184.2 +018100 " COPYRIGHT 1985 ". ST1184.2 +018200 01 CCVS-E-1. ST1184.2 +018300 02 FILLER PIC X(52) VALUE SPACE. ST1184.2 +018400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1184.2 +018500 02 ID-AGAIN PIC X(9). ST1184.2 +018600 02 FILLER PIC X(45) VALUE SPACES. ST1184.2 +018700 01 CCVS-E-2. ST1184.2 +018800 02 FILLER PIC X(31) VALUE SPACE. ST1184.2 +018900 02 FILLER PIC X(21) VALUE SPACE. ST1184.2 +019000 02 CCVS-E-2-2. ST1184.2 +019100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1184.2 +019200 03 FILLER PIC X VALUE SPACE. ST1184.2 +019300 03 ENDER-DESC PIC X(44) VALUE ST1184.2 +019400 "ERRORS ENCOUNTERED". ST1184.2 +019500 01 CCVS-E-3. ST1184.2 +019600 02 FILLER PIC X(22) VALUE ST1184.2 +019700 " FOR OFFICIAL USE ONLY". ST1184.2 +019800 02 FILLER PIC X(12) VALUE SPACE. ST1184.2 +019900 02 FILLER PIC X(58) VALUE ST1184.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +020100 02 FILLER PIC X(13) VALUE SPACE. ST1184.2 +020200 02 FILLER PIC X(15) VALUE ST1184.2 +020300 " COPYRIGHT 1985". ST1184.2 +020400 01 CCVS-E-4. ST1184.2 +020500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1184.2 +020600 02 FILLER PIC X(4) VALUE " OF ". ST1184.2 +020700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1184.2 +020800 02 FILLER PIC X(40) VALUE ST1184.2 +020900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1184.2 +021000 01 XXINFO. ST1184.2 +021100 02 FILLER PIC X(19) VALUE ST1184.2 +021200 "*** INFORMATION ***". ST1184.2 +021300 02 INFO-TEXT. ST1184.2 +021400 04 FILLER PIC X(8) VALUE SPACE. ST1184.2 +021500 04 XXCOMPUTED PIC X(20). ST1184.2 +021600 04 FILLER PIC X(5) VALUE SPACE. ST1184.2 +021700 04 XXCORRECT PIC X(20). ST1184.2 +021800 02 INF-ANSI-REFERENCE PIC X(48). ST1184.2 +021900 01 HYPHEN-LINE. ST1184.2 +022000 02 FILLER PIC IS X VALUE IS SPACE. ST1184.2 +022100 02 FILLER PIC IS X(65) VALUE IS "************************ST1184.2 +022200- "*****************************************". ST1184.2 +022300 02 FILLER PIC IS X(54) VALUE IS "************************ST1184.2 +022400- "******************************". ST1184.2 +022500 01 CCVS-PGM-ID PIC X(9) VALUE ST1184.2 +022600 "ST118A". ST1184.2 +022700 PROCEDURE DIVISION. ST1184.2 +022800 SORT-PARA SECTION. ST1184.2 +022900 SORT-PARAGRAPH. ST1184.2 +023000 SORT SORTFILE-1H ON ST1184.2 +023100 ASCENDING KEY SORTKEY-1 ST1184.2 +023200 ASCENDING SORTKEY-2 ST1184.2 +023300 ASCENDING SORTKEY-3 ST1184.2 +023400 ASCENDING SORTKEY-4 ST1184.2 +023500 ASCENDING SORTKEY-5 ST1184.2 +023600 ASCENDING SORTKEY-6 ST1184.2 +023700 ASCENDING SORTKEY-7 ST1184.2 +023800 ASCENDING SORTKEY-8 ST1184.2 +023900 INPUT PROCEDURE INPROC ST1184.2 +024000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1184.2 +024100 STOP RUN. ST1184.2 +024200 INPROC SECTION. ST1184.2 +024300 BUILD-FILE. ST1184.2 +024400 PERFORM BUILD-RECORD. ST1184.2 +024500 MOVE +123456 TO SORTKEY-1. ST1184.2 +024600 PERFORM RELEASE-RECORD. ST1184.2 +024700 PERFORM BUILD-RECORD. ST1184.2 +024800 MOVE "X" TO SORTKEY-2. ST1184.2 +024900 PERFORM RELEASE-RECORD. ST1184.2 +025000 PERFORM BUILD-RECORD. ST1184.2 +025100 MOVE +.6 TO SORTKEY-3. ST1184.2 +025200 PERFORM RELEASE-RECORD. ST1184.2 +025300 PERFORM BUILD-RECORD. ST1184.2 +025400 MOVE "X" TO SORTKEY-4. ST1184.2 +025500 PERFORM RELEASE-RECORD. ST1184.2 +025600 PERFORM BUILD-RECORD. ST1184.2 +025700 MOVE "Z" TO SORTKEY-5. ST1184.2 +025800 PERFORM RELEASE-RECORD. ST1184.2 +025900 PERFORM BUILD-RECORD. ST1184.2 +026000 MOVE "Z" TO SORTKEY-6. ST1184.2 +026100 PERFORM RELEASE-RECORD. ST1184.2 +026200 PERFORM BUILD-RECORD. ST1184.2 +026300 MOVE +418 TO SORTKEY-7. ST1184.2 +026400 PERFORM RELEASE-RECORD. ST1184.2 +026500 PERFORM BUILD-RECORD. ST1184.2 +026600 MOVE -14 TO SORTKEY-8. ST1184.2 +026700 PERFORM RELEASE-RECORD. ST1184.2 +026800 GO TO BUILD-EXIT. ST1184.2 +026900 BUILD-RECORD. ST1184.2 +027000 MOVE -054321 TO SORTKEY-1. ST1184.2 +027100 MOVE "BBB" TO SORTKEY-2. ST1184.2 +027200 MOVE -.1234567890123456 TO SORTKEY-3. ST1184.2 +027300 MOVE "BBBBBB" TO SORTKEY-4. ST1184.2 +027400 MOVE "A" TO SORTKEY-5. ST1184.2 +027500 MOVE "AAAAAAAA" TO SORTKEY-6. ST1184.2 +027600 MOVE -501 TO SORTKEY-7. ST1184.2 +027700* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1184.2 +027800* FIELD. ST1184.2 +027900 MOVE +99 TO SORTKEY-8. ST1184.2 +028000 RELEASE-RECORD. ST1184.2 +028100 RELEASE SORTFILE-REC. ST1184.2 +028200 BUILD-EXIT. ST1184.2 +028300 EXIT. ST1184.2 +028400 OUTPROC SECTION. ST1184.2 +028500 OPEN-FILES. ST1184.2 +028600 OPEN OUTPUT PRINT-FILE. ST1184.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1184.2 +028800 MOVE SPACE TO TEST-RESULTS. ST1184.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1184.2 +029000 IF SPAC-E IS LESS THAN "B" ST1184.2 +029100 GO TO SPACE-IS-LESS-THAN-B. ST1184.2 +029200 B-IS-LESS-THAN-SPACE SECTION. ST1184.2 +029300 SORT-INIT-A. ST1184.2 +029400 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +029500* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1184.2 +029600* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1184.2 +029700* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1184.2 +029800* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1184.2 +029900 SORT-TEST-1. ST1184.2 +030000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +030100 IF SORTKEY-7 EQUAL TO 418 ST1184.2 +030200 PERFORM PASS GO TO SORT-WRITE-1. ST1184.2 +030300 SORT-FAIL-1. ST1184.2 +030400 PERFORM FAIL. ST1184.2 +030500 MOVE SORTKEY-7 TO COMPUTED-N. ST1184.2 +030600 MOVE 418 TO CORRECT-N. ST1184.2 +030700 SORT-WRITE-1. ST1184.2 +030800 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1184.2 +030900 PERFORM PRINT-DETAIL. ST1184.2 +031000 SORT-TEST-2. ST1184.2 +031100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +031200 IF SORTKEY-8 EQUAL TO -14 ST1184.2 +031300 PERFORM PASS GO TO SORT-WRITE-2. ST1184.2 +031400 SORT-FAIL-2. ST1184.2 +031500 PERFORM FAIL. ST1184.2 +031600 MOVE SORTKEY-8 TO COMPUTED-N. ST1184.2 +031700 MOVE -14 TO CORRECT-N. ST1184.2 +031800 SORT-WRITE-2. ST1184.2 +031900 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1184.2 +032000 PERFORM PRINT-DETAIL. ST1184.2 +032100 SORT-TEST-3. ST1184.2 +032200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +032300 IF SORTKEY-6 EQUAL TO "Z " ST1184.2 +032400 PERFORM PASS GO TO SORT-WRITE-3. ST1184.2 +032500 SORT-FAIL-3. ST1184.2 +032600 PERFORM FAIL. ST1184.2 +032700 MOVE SORTKEY-6 TO COMPUTED-A. ST1184.2 +032800 MOVE "Z " TO CORRECT-A. ST1184.2 +032900 SORT-WRITE-3. ST1184.2 +033000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1184.2 +033100 PERFORM PRINT-DETAIL. ST1184.2 +033200 SORT-TEST-4. ST1184.2 +033300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +033400 IF SORTKEY-5 EQUAL TO "Z " ST1184.2 +033500 PERFORM PASS GO TO SORT-WRITE-4. ST1184.2 +033600 SORT-FAIL-4. ST1184.2 +033700 PERFORM FAIL. ST1184.2 +033800 MOVE SORTKEY-5 TO COMPUTED-A. ST1184.2 +033900 MOVE "Z " TO CORRECT-A. ST1184.2 +034000 SORT-WRITE-4. ST1184.2 +034100 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1184.2 +034200 PERFORM PRINT-DETAIL. ST1184.2 +034300 SORT-TEST-5. ST1184.2 +034400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +034500 IF SORTKEY-4 EQUAL TO " X" ST1184.2 +034600 PERFORM PASS GO TO SORT-WRITE-5. ST1184.2 +034700 SORT-FAIL-5. ST1184.2 +034800 PERFORM FAIL. ST1184.2 +034900 MOVE SORTKEY-4 TO COMPUTED-A. ST1184.2 +035000 MOVE " X" TO CORRECT-A. ST1184.2 +035100 SORT-WRITE-5. ST1184.2 +035200 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1184.2 +035300 PERFORM PRINT-DETAIL. ST1184.2 +035400 SORT-TEST-6. ST1184.2 +035500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +035600 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1184.2 +035700 PERFORM PASS GO TO SORT-WRITE-6. ST1184.2 +035800 SORT-FAIL-6. ST1184.2 +035900 PERFORM FAIL. ST1184.2 +036000 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1184.2 +036100 MOVE +.6000000000000000 TO CORRECT-0V18. ST1184.2 +036200 SORT-WRITE-6. ST1184.2 +036300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1184.2 +036400 PERFORM PRINT-DETAIL. ST1184.2 +036500 SORT-TEST-7. ST1184.2 +036600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +036700 IF SORTKEY-2 EQUAL TO " X" ST1184.2 +036800 PERFORM PASS GO TO SORT-WRITE-7. ST1184.2 +036900 SORT-FAIL-7. ST1184.2 +037000 PERFORM FAIL. ST1184.2 +037100 MOVE SORTKEY-2 TO COMPUTED-A. ST1184.2 +037200 MOVE " X" TO CORRECT-A. ST1184.2 +037300 SORT-WRITE-7. ST1184.2 +037400 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1184.2 +037500 PERFORM PRINT-DETAIL. ST1184.2 +037600 SORT-TEST-8. ST1184.2 +037700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +037800 IF SORTKEY-1 EQUAL TO +123456 ST1184.2 +037900 PERFORM PASS GO TO SORT-WRITE-8. ST1184.2 +038000 SORT-FAIL-8. ST1184.2 +038100 PERFORM FAIL. ST1184.2 +038200 MOVE SORTKEY-1 TO COMPUTED-N. ST1184.2 +038300 MOVE +123456 TO CORRECT-N. ST1184.2 +038400 SORT-WRITE-8. ST1184.2 +038500 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1184.2 +038600 PERFORM PRINT-DETAIL. ST1184.2 +038700 SORT-REMARK-A. ST1184.2 +038800 MOVE SPACE TO FEATURE. ST1184.2 +038900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1184.2 +039000 PERFORM PRINT-DETAIL. ST1184.2 +039100 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1184.2 +039200 PERFORM PRINT-DETAIL. ST1184.2 +039300 MOVE "UNNECESSARY." TO RE-MARK. ST1184.2 +039400 PERFORM PRINT-DETAIL. ST1184.2 +039500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +039600 GO TO CONTINUE-TESTING. ST1184.2 +039700 SPACE-IS-LESS-THAN-B SECTION. ST1184.2 +039800 SORT-REMARK-B. ST1184.2 +039900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1184.2 +040000 PERFORM PRINT-DETAIL. ST1184.2 +040100 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1184.2 +040200 PERFORM PRINT-DETAIL. ST1184.2 +040300 MOVE "UNNECESSARY." TO RE-MARK. ST1184.2 +040400 PERFORM PRINT-DETAIL. ST1184.2 +040500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +040600* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1184.2 +040700* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1184.2 +040800* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1184.2 +040900* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1184.2 +041000 SORT-TEST-9. ST1184.2 +041100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +041200 IF SORTKEY-2 EQUAL TO " X" ST1184.2 +041300 PERFORM PASS GO TO SORT-WRITE-9. ST1184.2 +041400 SORT-FAIL-9. ST1184.2 +041500 PERFORM FAIL. ST1184.2 +041600 MOVE SORTKEY-2 TO COMPUTED-A. ST1184.2 +041700 MOVE " X" TO CORRECT-A. ST1184.2 +041800 SORT-WRITE-9. ST1184.2 +041900 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1184.2 +042000 PERFORM PRINT-DETAIL. ST1184.2 +042100 SORT-TEST-10. ST1184.2 +042200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +042300 IF SORTKEY-4 EQUAL TO " X" ST1184.2 +042400 PERFORM PASS GO TO SORT-WRITE-10. ST1184.2 +042500 SORT-FAIL-10. ST1184.2 +042600 PERFORM FAIL. ST1184.2 +042700 MOVE SORTKEY-4 TO COMPUTED-A. ST1184.2 +042800 MOVE " X" TO CORRECT-A. ST1184.2 +042900 SORT-WRITE-10. ST1184.2 +043000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1184.2 +043100 PERFORM PRINT-DETAIL. ST1184.2 +043200 SORT-TEST-11. ST1184.2 +043300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +043400 IF SORTKEY-7 EQUAL TO 418 ST1184.2 +043500 PERFORM PASS GO TO SORT-WRITE-11. ST1184.2 +043600 SORT-FAIL-11. ST1184.2 +043700 PERFORM FAIL. ST1184.2 +043800 MOVE SORTKEY-7 TO COMPUTED-N ST1184.2 +043900 MOVE 418 TO CORRECT-N. ST1184.2 +044000 SORT-WRITE-11. ST1184.2 +044100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1184.2 +044200 PERFORM PRINT-DETAIL. ST1184.2 +044300 SORT-TEST-12. ST1184.2 +044400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +044500 IF SORTKEY-8 EQUAL TO -14 ST1184.2 +044600 PERFORM PASS GO TO SORT-WRITE-12. ST1184.2 +044700 SORT-FAIL-12. ST1184.2 +044800 PERFORM FAIL. ST1184.2 +044900 MOVE SORTKEY-8 TO COMPUTED-N. ST1184.2 +045000 MOVE -14 TO CORRECT-N. ST1184.2 +045100 SORT-WRITE-12. ST1184.2 +045200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1184.2 +045300 PERFORM PRINT-DETAIL. ST1184.2 +045400 SORT-TEST-13. ST1184.2 +045500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +045600 IF SORTKEY-6 EQUAL TO "Z " ST1184.2 +045700 PERFORM PASS GO TO SORT-WRITE-13. ST1184.2 +045800 SORT-FAIL-13. ST1184.2 +045900 PERFORM FAIL. ST1184.2 +046000 MOVE SORTKEY-6 TO COMPUTED-A. ST1184.2 +046100 MOVE "Z " TO CORRECT-A. ST1184.2 +046200 SORT-WRITE-13. ST1184.2 +046300 MOVE "SORT-TEST-13" TO PAR-NAME. ST1184.2 +046400 PERFORM PRINT-DETAIL. ST1184.2 +046500 SORT-TEST-14. ST1184.2 +046600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +046700 IF SORTKEY-5 EQUAL TO "Z " ST1184.2 +046800 PERFORM PASS GO TO SORT-WRITE-14. ST1184.2 +046900 SORT-FAIL-14. ST1184.2 +047000 PERFORM FAIL. ST1184.2 +047100 MOVE SORTKEY-5 TO COMPUTED-A. ST1184.2 +047200 MOVE "Z " TO CORRECT-A. ST1184.2 +047300 SORT-WRITE-14. ST1184.2 +047400 MOVE "SORT-TEST-14" TO PAR-NAME. ST1184.2 +047500 PERFORM PRINT-DETAIL. ST1184.2 +047600 SORT-TEST-15. ST1184.2 +047700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +047800 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1184.2 +047900 PERFORM PASS GO TO SORT-WRITE-15. ST1184.2 +048000 SORT-FAIL-15. ST1184.2 +048100 PERFORM FAIL. ST1184.2 +048200 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1184.2 +048300 MOVE +.6000000000000000 TO CORRECT-0V18. ST1184.2 +048400 SORT-WRITE-15. ST1184.2 +048500 MOVE "SORT-TEST-15" TO PAR-NAME. ST1184.2 +048600 PERFORM PRINT-DETAIL. ST1184.2 +048700 SORT-TEST-16. ST1184.2 +048800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +048900 IF SORTKEY-1 EQUAL TO +123456 ST1184.2 +049000 PERFORM PASS GO TO SORT-WRITE-16. ST1184.2 +049100 SORT-FAIL-16. ST1184.2 +049200 PERFORM FAIL. ST1184.2 +049300 MOVE SORTKEY-1 TO COMPUTED-N. ST1184.2 +049400 MOVE +123456 TO CORRECT-N. ST1184.2 +049500 SORT-WRITE-16. ST1184.2 +049600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1184.2 +049700 PERFORM PRINT-DETAIL. ST1184.2 +049800 CONTINUE-TESTING SECTION. ST1184.2 +049900 SORT-TEST-17. ST1184.2 +050000 RETURN SORTFILE-1H AT END ST1184.2 +050100 PERFORM PASS GO TO SORT-WRITE-17. ST1184.2 +050200 SORT-FAIL-17. ST1184.2 +050300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1184.2 +050400 PERFORM FAIL. ST1184.2 +050500 SORT-WRITE-17. ST1184.2 +050600 MOVE "SORT-TEST-17" TO PAR-NAME. ST1184.2 +050700 PERFORM PRINT-DETAIL. ST1184.2 +050800 GO TO OUTPROC-EXIT. ST1184.2 +050900 RETURN-ERROR. ST1184.2 +051000 MOVE "RETURN-ERROR" TO PAR-NAME. ST1184.2 +051100 PERFORM FAIL. ST1184.2 +051200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1184.2 +051300 PERFORM PRINT-DETAIL. ST1184.2 +051400 GO TO CCVS1-EXIT. ST1184.2 +051500 CLOSE-FILES. ST1184.2 +051600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1184.2 +051700 TERMINATE-CCVS. ST1184.2 +051800S EXIT PROGRAM. ST1184.2 +051900STERMINATE-CALL. ST1184.2 +052000 STOP RUN. ST1184.2 +052100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1184.2 +052200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1184.2 +052300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1184.2 +052400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1184.2 +052500 MOVE "****TEST DELETED****" TO RE-MARK. ST1184.2 +052600 PRINT-DETAIL. ST1184.2 +052700 IF REC-CT NOT EQUAL TO ZERO ST1184.2 +052800 MOVE "." TO PARDOT-X ST1184.2 +052900 MOVE REC-CT TO DOTVALUE. ST1184.2 +053000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1184.2 +053100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1184.2 +053200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1184.2 +053300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1184.2 +053400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1184.2 +053500 MOVE SPACE TO CORRECT-X. ST1184.2 +053600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1184.2 +053700 MOVE SPACE TO RE-MARK. ST1184.2 +053800 HEAD-ROUTINE. ST1184.2 +053900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1184.2 +054200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1184.2 +054300 COLUMN-NAMES-ROUTINE. ST1184.2 +054400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +054500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +054700 END-ROUTINE. ST1184.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1184.2 +054900 END-RTN-EXIT. ST1184.2 +055000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +055100 END-ROUTINE-1. ST1184.2 +055200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1184.2 +055300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1184.2 +055400 ADD PASS-COUNTER TO ERROR-HOLD. ST1184.2 +055500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1184.2 +055600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1184.2 +055700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1184.2 +055800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1184.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1184.2 +056000 END-ROUTINE-12. ST1184.2 +056100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1184.2 +056200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1184.2 +056300 MOVE "NO " TO ERROR-TOTAL ST1184.2 +056400 ELSE ST1184.2 +056500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1184.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1184.2 +056700 PERFORM WRITE-LINE. ST1184.2 +056800 END-ROUTINE-13. ST1184.2 +056900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1184.2 +057000 MOVE "NO " TO ERROR-TOTAL ELSE ST1184.2 +057100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1184.2 +057200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1184.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +057400 IF INSPECT-COUNTER EQUAL TO ZERO ST1184.2 +057500 MOVE "NO " TO ERROR-TOTAL ST1184.2 +057600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1184.2 +057700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1184.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +057900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +058000 WRITE-LINE. ST1184.2 +058100 ADD 1 TO RECORD-COUNT. ST1184.2 +058200Y IF RECORD-COUNT GREATER 42 ST1184.2 +058300Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1184.2 +058400Y MOVE SPACE TO DUMMY-RECORD ST1184.2 +058500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1184.2 +058600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1184.2 +058700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1184.2 +058800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1184.2 +058900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1184.2 +059000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1184.2 +059400Y MOVE ZERO TO RECORD-COUNT. ST1184.2 +059500 PERFORM WRT-LN. ST1184.2 +059600 WRT-LN. ST1184.2 +059700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1184.2 +059800 MOVE SPACE TO DUMMY-RECORD. ST1184.2 +059900 BLANK-LINE-PRINT. ST1184.2 +060000 PERFORM WRT-LN. ST1184.2 +060100 FAIL-ROUTINE. ST1184.2 +060200 IF COMPUTED-X NOT EQUAL TO SPACE ST1184.2 +060300 GO TO FAIL-ROUTINE-WRITE. ST1184.2 +060400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1184.2 +060500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1184.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1184.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +060800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1184.2 +060900 GO TO FAIL-ROUTINE-EX. ST1184.2 +061000 FAIL-ROUTINE-WRITE. ST1184.2 +061100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1184.2 +061200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1184.2 +061300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1184.2 +061400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1184.2 +061500 FAIL-ROUTINE-EX. EXIT. ST1184.2 +061600 BAIL-OUT. ST1184.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1184.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1184.2 +061900 BAIL-OUT-WRITE. ST1184.2 +062000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1184.2 +062100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1184.2 +062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +062300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1184.2 +062400 BAIL-OUT-EX. EXIT. ST1184.2 +062500 CCVS1-EXIT. ST1184.2 +062600 EXIT. ST1184.2 +062700 OUTPROC-EXIT SECTION. ST1184.2 +062800 EXIT-ONLY. ST1184.2 +062900 PERFORM CLOSE-FILES. ST1184.2 +*END-OF,ST118A +*HEADER,COBOL,ST119A +000100 IDENTIFICATION DIVISION. ST1194.2 +000200 PROGRAM-ID. ST1194.2 +000300 ST119A. ST1194.2 +000400**************************************************************** ST1194.2 +000500* * ST1194.2 +000600* VALIDATION FOR:- * ST1194.2 +000700* * ST1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +000900* * ST1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1194.2 +001100* * ST1194.2 +001200**************************************************************** ST1194.2 +001300* * ST1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1194.2 +001500* * ST1194.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1194.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1194.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1194.2 +001900* * ST1194.2 +002000**************************************************************** ST1194.2 +002100 ENVIRONMENT DIVISION. ST1194.2 +002200 CONFIGURATION SECTION. ST1194.2 +002300 SOURCE-COMPUTER. ST1194.2 +002400 XXXXX082. ST1194.2 +002500 OBJECT-COMPUTER. ST1194.2 +002600 XXXXX083. ST1194.2 +002700 INPUT-OUTPUT SECTION. ST1194.2 +002800 FILE-CONTROL. ST1194.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1194.2 +003000 XXXXX055. ST1194.2 +003100 SELECT SORTFILE-1A ASSIGN TO ST1194.2 +003200 XXXXX027. ST1194.2 +003300 SELECT SORTOUT-1A ASSIGN TO ST1194.2 +003400 XXXXP001. ST1194.2 +003500 DATA DIVISION. ST1194.2 +003600 FILE SECTION. ST1194.2 +003700 FD PRINT-FILE. ST1194.2 +003800 01 PRINT-REC PICTURE X(120). ST1194.2 +003900 01 DUMMY-RECORD PICTURE X(120). ST1194.2 +004000 SD SORTFILE-1A ST1194.2 +004100 DATA RECORD IS S-RECORD. ST1194.2 +004200 01 S-RECORD. ST1194.2 +004300 02 KEYS-GROUP. ST1194.2 +004400 03 KEY-1 PICTURE 9. ST1194.2 +004500 03 KEY-2 PICTURE 99. ST1194.2 +004600 03 KEY-3 PICTURE 999. ST1194.2 +004700 03 KEY-4 PICTURE 9999. ST1194.2 +004800 03 KEY-5 PICTURE 9(5). ST1194.2 +004900 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). ST1194.2 +005000 02 FILLER PICTURE X(105). ST1194.2 +005100 FD SORTOUT-1A ST1194.2 +005200 BLOCK CONTAINS 10 RECORDS ST1194.2 +005300 LABEL RECORDS ARE STANDARD ST1194.2 +005400C VALUE OF ST1194.2 +005500C XXXXX074 ST1194.2 +005600C IS ST1194.2 +005700C XXXXX075 ST1194.2 +005800G XXXXX069 ST1194.2 +005900 DATA RECORD IS SORTED. ST1194.2 +006000 01 SORTED PICTURE X(120). ST1194.2 +006100 WORKING-STORAGE SECTION. ST1194.2 +006200 77 COMMENT-SENTENCE PIC X(120) VALUE " THE FILE BUILT IN ST119A ST1194.2 +006300- "IS SORTED IN ST120A. ST120A DOES NOT PRODUCE A REPORT - THEST1194.2 +006400- " RESULTS ARE CHECKED IN ST121A.". ST1194.2 +006500 77 WRK-XN-00001-1 PIC X. ST1194.2 +006600 77 WRK-XN-00001-2 PIC X. ST1194.2 +006700 77 WRK-XN-00001-3 PIC X. ST1194.2 +006800 77 C0 PICTURE 9 VALUE 0. ST1194.2 +006900 77 C1 PICTURE 9 VALUE 1. ST1194.2 +007000 77 C2 PICTURE 9 VALUE 2. ST1194.2 +007100 77 C6 PICTURE 9 VALUE 6. ST1194.2 +007200 77 C3 PICTURE 9 VALUE 3. ST1194.2 +007300 01 WKEYS-GROUP. ST1194.2 +007400 02 WKEY-1 PICTURE 9. ST1194.2 +007500 02 WKEY-2 PICTURE 99. ST1194.2 +007600 02 WKEY-3 PICTURE 999. ST1194.2 +007700 02 WKEY-4 PICTURE 9999. ST1194.2 +007800 02 WKEY-5 PICTURE 9(5). ST1194.2 +007900 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). ST1194.2 +008000 01 TEST-RESULTS. ST1194.2 +008100 02 FILLER PIC X VALUE SPACE. ST1194.2 +008200 02 FEATURE PIC X(20) VALUE SPACE. ST1194.2 +008300 02 FILLER PIC X VALUE SPACE. ST1194.2 +008400 02 P-OR-F PIC X(5) VALUE SPACE. ST1194.2 +008500 02 FILLER PIC X VALUE SPACE. ST1194.2 +008600 02 PAR-NAME. ST1194.2 +008700 03 FILLER PIC X(19) VALUE SPACE. ST1194.2 +008800 03 PARDOT-X PIC X VALUE SPACE. ST1194.2 +008900 03 DOTVALUE PIC 99 VALUE ZERO. ST1194.2 +009000 02 FILLER PIC X(8) VALUE SPACE. ST1194.2 +009100 02 RE-MARK PIC X(61). ST1194.2 +009200 01 TEST-COMPUTED. ST1194.2 +009300 02 FILLER PIC X(30) VALUE SPACE. ST1194.2 +009400 02 FILLER PIC X(17) VALUE ST1194.2 +009500 " COMPUTED=". ST1194.2 +009600 02 COMPUTED-X. ST1194.2 +009700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1194.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A ST1194.2 +009900 PIC -9(9).9(9). ST1194.2 +010000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1194.2 +010100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1194.2 +010200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1194.2 +010300 03 CM-18V0 REDEFINES COMPUTED-A. ST1194.2 +010400 04 COMPUTED-18V0 PIC -9(18). ST1194.2 +010500 04 FILLER PIC X. ST1194.2 +010600 03 FILLER PIC X(50) VALUE SPACE. ST1194.2 +010700 01 TEST-CORRECT. ST1194.2 +010800 02 FILLER PIC X(30) VALUE SPACE. ST1194.2 +010900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1194.2 +011000 02 CORRECT-X. ST1194.2 +011100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1194.2 +011200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1194.2 +011300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1194.2 +011400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1194.2 +011500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1194.2 +011600 03 CR-18V0 REDEFINES CORRECT-A. ST1194.2 +011700 04 CORRECT-18V0 PIC -9(18). ST1194.2 +011800 04 FILLER PIC X. ST1194.2 +011900 03 FILLER PIC X(2) VALUE SPACE. ST1194.2 +012000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1194.2 +012100 01 CCVS-C-1. ST1194.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1194.2 +012300- "SS PARAGRAPH-NAME ST1194.2 +012400- " REMARKS". ST1194.2 +012500 02 FILLER PIC X(20) VALUE SPACE. ST1194.2 +012600 01 CCVS-C-2. ST1194.2 +012700 02 FILLER PIC X VALUE SPACE. ST1194.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". ST1194.2 +012900 02 FILLER PIC X(15) VALUE SPACE. ST1194.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". ST1194.2 +013100 02 FILLER PIC X(94) VALUE SPACE. ST1194.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1194.2 +013300 01 REC-CT PIC 99 VALUE ZERO. ST1194.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1194.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1194.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1194.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1194.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1194.2 +014300 01 CCVS-H-1. ST1194.2 +014400 02 FILLER PIC X(39) VALUE SPACES. ST1194.2 +014500 02 FILLER PIC X(42) VALUE ST1194.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1194.2 +014700 02 FILLER PIC X(39) VALUE SPACES. ST1194.2 +014800 01 CCVS-H-2A. ST1194.2 +014900 02 FILLER PIC X(40) VALUE SPACE. ST1194.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1194.2 +015100 02 FILLER PIC XXXX VALUE ST1194.2 +015200 "4.2 ". ST1194.2 +015300 02 FILLER PIC X(28) VALUE ST1194.2 +015400 " COPY - NOT FOR DISTRIBUTION". ST1194.2 +015500 02 FILLER PIC X(41) VALUE SPACE. ST1194.2 +015600 ST1194.2 +015700 01 CCVS-H-2B. ST1194.2 +015800 02 FILLER PIC X(15) VALUE ST1194.2 +015900 "TEST RESULT OF ". ST1194.2 +016000 02 TEST-ID PIC X(9). ST1194.2 +016100 02 FILLER PIC X(4) VALUE ST1194.2 +016200 " IN ". ST1194.2 +016300 02 FILLER PIC X(12) VALUE ST1194.2 +016400 " HIGH ". ST1194.2 +016500 02 FILLER PIC X(22) VALUE ST1194.2 +016600 " LEVEL VALIDATION FOR ". ST1194.2 +016700 02 FILLER PIC X(58) VALUE ST1194.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +016900 01 CCVS-H-3. ST1194.2 +017000 02 FILLER PIC X(34) VALUE ST1194.2 +017100 " FOR OFFICIAL USE ONLY ". ST1194.2 +017200 02 FILLER PIC X(58) VALUE ST1194.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1194.2 +017400 02 FILLER PIC X(28) VALUE ST1194.2 +017500 " COPYRIGHT 1985 ". ST1194.2 +017600 01 CCVS-E-1. ST1194.2 +017700 02 FILLER PIC X(52) VALUE SPACE. ST1194.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1194.2 +017900 02 ID-AGAIN PIC X(9). ST1194.2 +018000 02 FILLER PIC X(45) VALUE SPACES. ST1194.2 +018100 01 CCVS-E-2. ST1194.2 +018200 02 FILLER PIC X(31) VALUE SPACE. ST1194.2 +018300 02 FILLER PIC X(21) VALUE SPACE. ST1194.2 +018400 02 CCVS-E-2-2. ST1194.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1194.2 +018600 03 FILLER PIC X VALUE SPACE. ST1194.2 +018700 03 ENDER-DESC PIC X(44) VALUE ST1194.2 +018800 "ERRORS ENCOUNTERED". ST1194.2 +018900 01 CCVS-E-3. ST1194.2 +019000 02 FILLER PIC X(22) VALUE ST1194.2 +019100 " FOR OFFICIAL USE ONLY". ST1194.2 +019200 02 FILLER PIC X(12) VALUE SPACE. ST1194.2 +019300 02 FILLER PIC X(58) VALUE ST1194.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +019500 02 FILLER PIC X(13) VALUE SPACE. ST1194.2 +019600 02 FILLER PIC X(15) VALUE ST1194.2 +019700 " COPYRIGHT 1985". ST1194.2 +019800 01 CCVS-E-4. ST1194.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1194.2 +020000 02 FILLER PIC X(4) VALUE " OF ". ST1194.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1194.2 +020200 02 FILLER PIC X(40) VALUE ST1194.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1194.2 +020400 01 XXINFO. ST1194.2 +020500 02 FILLER PIC X(19) VALUE ST1194.2 +020600 "*** INFORMATION ***". ST1194.2 +020700 02 INFO-TEXT. ST1194.2 +020800 04 FILLER PIC X(8) VALUE SPACE. ST1194.2 +020900 04 XXCOMPUTED PIC X(20). ST1194.2 +021000 04 FILLER PIC X(5) VALUE SPACE. ST1194.2 +021100 04 XXCORRECT PIC X(20). ST1194.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). ST1194.2 +021300 01 HYPHEN-LINE. ST1194.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. ST1194.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************ST1194.2 +021600- "*****************************************". ST1194.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************ST1194.2 +021800- "******************************". ST1194.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE ST1194.2 +022000 "ST119A". ST1194.2 +022100 PROCEDURE DIVISION. ST1194.2 +022200 CCVS1 SECTION. ST1194.2 +022300 OPEN-FILES. ST1194.2 +022400 OPEN OUTPUT PRINT-FILE. ST1194.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1194.2 +022600 MOVE SPACE TO TEST-RESULTS. ST1194.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1194.2 +022800 GO TO CCVS1-EXIT. ST1194.2 +022900 CLOSE-FILES. ST1194.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1194.2 +023100 TERMINATE-CCVS. ST1194.2 +023200S EXIT PROGRAM. ST1194.2 +023300STERMINATE-CALL. ST1194.2 +023400 STOP RUN. ST1194.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1194.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1194.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1194.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1194.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. ST1194.2 +024000 PRINT-DETAIL. ST1194.2 +024100 IF REC-CT NOT EQUAL TO ZERO ST1194.2 +024200 MOVE "." TO PARDOT-X ST1194.2 +024300 MOVE REC-CT TO DOTVALUE. ST1194.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1194.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1194.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1194.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1194.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1194.2 +024900 MOVE SPACE TO CORRECT-X. ST1194.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1194.2 +025100 MOVE SPACE TO RE-MARK. ST1194.2 +025200 HEAD-ROUTINE. ST1194.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1194.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1194.2 +025700 COLUMN-NAMES-ROUTINE. ST1194.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +026100 END-ROUTINE. ST1194.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1194.2 +026300 END-RTN-EXIT. ST1194.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +026500 END-ROUTINE-1. ST1194.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1194.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1194.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. ST1194.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1194.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1194.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1194.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1194.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1194.2 +027400 END-ROUTINE-12. ST1194.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1194.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1194.2 +027700 MOVE "NO " TO ERROR-TOTAL ST1194.2 +027800 ELSE ST1194.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1194.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1194.2 +028100 PERFORM WRITE-LINE. ST1194.2 +028200 END-ROUTINE-13. ST1194.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1194.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE ST1194.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1194.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1194.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO ST1194.2 +028900 MOVE "NO " TO ERROR-TOTAL ST1194.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1194.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1194.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +029400 WRITE-LINE. ST1194.2 +029500 ADD 1 TO RECORD-COUNT. ST1194.2 +029600Y IF RECORD-COUNT GREATER 42 ST1194.2 +029700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1194.2 +029800Y MOVE SPACE TO DUMMY-RECORD ST1194.2 +029900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1194.2 +030000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1194.2 +030100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1194.2 +030200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1194.2 +030300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1194.2 +030400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030700Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1194.2 +030800Y MOVE ZERO TO RECORD-COUNT. ST1194.2 +030900 PERFORM WRT-LN. ST1194.2 +031000 WRT-LN. ST1194.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1194.2 +031200 MOVE SPACE TO DUMMY-RECORD. ST1194.2 +031300 BLANK-LINE-PRINT. ST1194.2 +031400 PERFORM WRT-LN. ST1194.2 +031500 FAIL-ROUTINE. ST1194.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE ST1194.2 +031700 GO TO FAIL-ROUTINE-WRITE. ST1194.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1194.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1194.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1194.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1194.2 +032300 GO TO FAIL-ROUTINE-EX. ST1194.2 +032400 FAIL-ROUTINE-WRITE. ST1194.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1194.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1194.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1194.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1194.2 +032900 FAIL-ROUTINE-EX. EXIT. ST1194.2 +033000 BAIL-OUT. ST1194.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1194.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1194.2 +033300 BAIL-OUT-WRITE. ST1194.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1194.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1194.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1194.2 +033800 BAIL-OUT-EX. EXIT. ST1194.2 +033900 CCVS1-EXIT. ST1194.2 +034000 EXIT. ST1194.2 +034100 ST1194.2 +034200 SORT-INIT SECTION. ST1194.2 +034300 MAIN-SORT-PARAGRAPH. ST1194.2 +034400 SORT SORTFILE-1A ST1194.2 +034500 ON ASCENDING KEY KEY-1 ST1194.2 +034600 ON DESCENDING KEY KEY-2 ST1194.2 +034700 ON ASCENDING KEY KEY-3 ST1194.2 +034800 DESCENDING KEY-4 KEY-5 ST1194.2 +034900 INPUT PROCEDURE IS IN-1 THROUGH IN-EXIT ST1194.2 +035000 OUTPUT PROCEDURE IS OUT-PROC-1 THRU SORT-END. ST1194.2 +035100 ST1194.2 +035200 INTERNAL-OUTPUT-PROC-CODE SECTION. ST1194.2 +035300*================================= ST1194.2 +035400 INT-INIT-1. ST1194.2 +035500* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +035600 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +035700 MOVE "INT-TEST-1" TO PAR-NAME. ST1194.2 +035800 MOVE "INTNL CODE PERFORMED" TO FEATURE. ST1194.2 +035900 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +036000 PERFORM INTERNAL-CODE-1. ST1194.2 +036100 GO TO INT-TEST-1. ST1194.2 +036200 INT-DELETE-1. ST1194.2 +036300 PERFORM DE-LETE. ST1194.2 +036400 PERFORM PRINT-DETAIL. ST1194.2 +036500 GO TO INT-INIT-2. ST1194.2 +036600 INT-TEST-1. ST1194.2 +036700 IF WRK-XN-00001-1 = "C" ST1194.2 +036800 PERFORM PASS ST1194.2 +036900 PERFORM PRINT-DETAIL ST1194.2 +037000 ELSE ST1194.2 +037100 MOVE "INTERNAL OUTPUT PROC CODE NOT PERFORMED" ST1194.2 +037200 TO RE-MARK ST1194.2 +037300 MOVE "C" TO CORRECT-X ST1194.2 +037400 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +037500 PERFORM FAIL ST1194.2 +037600 PERFORM PRINT-DETAIL. ST1194.2 +037700 ST1194.2 +037800 INT-INIT-2. ST1194.2 +037900* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +038000 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +038100 MOVE "INT-TEST-2-1" TO PAR-NAME. ST1194.2 +038200 MOVE "GO TO INTERNAL CODE" TO FEATURE. ST1194.2 +038300 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +038400 MOVE "Y" TO WRK-XN-00001-2. ST1194.2 +038500 MOVE 1 TO REC-CT. ST1194.2 +038600 GO TO INTERNAL-CODE-2. ST1194.2 +038700 INT-FAIL-2-1. ST1194.2 +038800 MOVE "X" TO WRK-XN-00001-2. ST1194.2 +038900 GO TO INT-TEST-2-2. ST1194.2 +039000 INT-DELETE-2-1. ST1194.2 +039100 PERFORM DE-LETE. ST1194.2 +039200 PERFORM PRINT-DETAIL. ST1194.2 +039300 GO TO INT-INIT-3. ST1194.2 +039400 INT-TEST-2-1. ST1194.2 +039500 IF WRK-XN-00001-2 = "Y" ST1194.2 +039600 PERFORM PASS ST1194.2 +039700 PERFORM PRINT-DETAIL ST1194.2 +039800 GO TO INT-TEST-2-2. ST1194.2 +039900 MOVE "GO TO INTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +040000 TO RE-MARK. ST1194.2 +040100 MOVE "Y" TO CORRECT-X. ST1194.2 +040200 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +040300 PERFORM FAIL. ST1194.2 +040400 PERFORM PRINT-DETAIL. ST1194.2 +040500 INT-TEST-2-2. ST1194.2 +040600 MOVE "INT-TEST-2-1" TO PAR-NAME. ST1194.2 +040700 ADD 1 TO REC-CT. ST1194.2 +040800 IF WRK-XN-00001-1 = "D" ST1194.2 +040900 PERFORM PASS ST1194.2 +041000 PERFORM PRINT-DETAIL ST1194.2 +041100 ELSE ST1194.2 +041200 MOVE "GO TO INTERNAL OUTPUT PROC. CODE ERROR" ST1194.2 +041300 TO RE-MARK ST1194.2 +041400 MOVE "D" TO CORRECT-X ST1194.2 +041500 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +041600 PERFORM FAIL ST1194.2 +041700 PERFORM PRINT-DETAIL. ST1194.2 +041800 ST1194.2 +041900 INTERNAL-INPUT-PROC-CODE SECTION. ST1194.2 +042000*================================ ST1194.2 +042100 INT-INIT-3. ST1194.2 +042200* ===--> ACCESSING OF CODE WITHIN THE INPUT PROCEDURE <--=== ST1194.2 +042300 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +042400 MOVE "INT-TEST-3" TO PAR-NAME. ST1194.2 +042500 MOVE "INTNL CODE PERFORMED" TO FEATURE. ST1194.2 +042600 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +042700 PERFORM INTERNAL-CODE-3. ST1194.2 +042800 GO TO INT-TEST-3. ST1194.2 +042900 INT-DELETE-3. ST1194.2 +043000 PERFORM DE-LETE. ST1194.2 +043100 PERFORM PRINT-DETAIL. ST1194.2 +043200 GO TO INT-INIT-4. ST1194.2 +043300 INT-TEST-3. ST1194.2 +043400 IF WRK-XN-00001-1 = "L" ST1194.2 +043500 PERFORM PASS ST1194.2 +043600 PERFORM PRINT-DETAIL ST1194.2 +043700 ELSE ST1194.2 +043800 MOVE "INTERNAL INPUT PROC CODE NOT PERFORMED" ST1194.2 +043900 TO RE-MARK ST1194.2 +044000 MOVE "L" TO CORRECT-X ST1194.2 +044100 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +044200 PERFORM FAIL ST1194.2 +044300 PERFORM PRINT-DETAIL. ST1194.2 +044400 ST1194.2 +044500 INT-INIT-4. ST1194.2 +044600* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +044700 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +044800 MOVE "INT-TEST-4-1" TO PAR-NAME. ST1194.2 +044900 MOVE "GO TO INTERNAL CODE" TO FEATURE. ST1194.2 +045000 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +045100 MOVE "N" TO WRK-XN-00001-2. ST1194.2 +045200 MOVE 1 TO REC-CT. ST1194.2 +045300 GO TO INTERNAL-CODE-4. ST1194.2 +045400 INT-FAIL-4-1. ST1194.2 +045500 MOVE "O" TO WRK-XN-00001-2. ST1194.2 +045600 GO TO INT-TEST-4-1. ST1194.2 +045700 INT-DELETE-4. ST1194.2 +045800 PERFORM DE-LETE. ST1194.2 +045900 PERFORM PRINT-DETAIL. ST1194.2 +046000 GO TO I-2. ST1194.2 +046100 INT-TEST-4-1. ST1194.2 +046200 IF WRK-XN-00001-2 = "N" ST1194.2 +046300 PERFORM PASS ST1194.2 +046400 PERFORM PRINT-DETAIL ST1194.2 +046500 GO TO INT-TEST-4-2. ST1194.2 +046600 MOVE "GO TO INTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +046700 TO RE-MARK. ST1194.2 +046800 MOVE "N" TO CORRECT-X. ST1194.2 +046900 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +047000 PERFORM FAIL. ST1194.2 +047100 PERFORM PRINT-DETAIL. ST1194.2 +047200 INT-TEST-4-2. ST1194.2 +047300 MOVE "INT-TEST-4-2" TO PAR-NAME. ST1194.2 +047400 ADD 1 TO REC-CT. ST1194.2 +047500 IF WRK-XN-00001-1 = "M" ST1194.2 +047600 PERFORM PASS ST1194.2 +047700 PERFORM PRINT-DETAIL ST1194.2 +047800 ELSE ST1194.2 +047900 MOVE "GO TO INTERNAL OUTPUT PROC. CODE ERROR" ST1194.2 +048000 TO RE-MARK ST1194.2 +048100 MOVE "M" TO CORRECT-X ST1194.2 +048200 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +048300 PERFORM FAIL ST1194.2 +048400 PERFORM PRINT-DETAIL. ST1194.2 +048500 ST1194.2 +048600 I-2. ST1194.2 +048700 GO TO CCVS-EXIT. ST1194.2 +048800 ST1194.2 +048900 IN-1. ST1194.2 +049000 INPT-INIT-1. ST1194.2 +049100* ===--> ACCESSING OF CODE OUTSIDE THE INPUT PROCEDURE <--=== ST1194.2 +049200 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +049300 MOVE "INPT-TEST-1" TO PAR-NAME. ST1194.2 +049400 MOVE "PERFORM EXTNL CODE" TO FEATURE. ST1194.2 +049500 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +049600 PERFORM EXTERNAL-CODE-3. ST1194.2 +049700 GO TO INPT-TEST-1. ST1194.2 +049800 INPT-DELETE-1. ST1194.2 +049900 PERFORM DE-LETE. ST1194.2 +050000 PERFORM PRINT-DETAIL. ST1194.2 +050100 GO TO INPT-INIT-2. ST1194.2 +050200 INPT-TEST-1. ST1194.2 +050300 IF WRK-XN-00001-1 = "J" ST1194.2 +050400 PERFORM PASS ST1194.2 +050500 PERFORM PRINT-DETAIL ST1194.2 +050600 ELSE ST1194.2 +050700 MOVE "EXTERNAL CODE NOT PERFORMED FROM INPUT PROC" ST1194.2 +050800 TO RE-MARK ST1194.2 +050900 MOVE "J" TO CORRECT-X ST1194.2 +051000 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +051100 PERFORM FAIL ST1194.2 +051200 PERFORM PRINT-DETAIL. ST1194.2 +051300 ST1194.2 +051400 INPT-INIT-2. ST1194.2 +051500 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +051600 MOVE "INPT-TEST-2-1" TO PAR-NAME. ST1194.2 +051700 MOVE "GO TO EXTERNAL CODE" TO FEATURE. ST1194.2 +051800 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +051900 MOVE "S" TO WRK-XN-00001-2. ST1194.2 +052000 MOVE 1 TO REC-CT. ST1194.2 +052100 GO TO EXTERNAL-CODE-4. ST1194.2 +052200 INPT-FAIL-2-1. ST1194.2 +052300 MOVE "W" TO WRK-XN-00001-1. ST1194.2 +052400 GO TO INPT-TEST-2-1. ST1194.2 +052500 INPT-DELETE-2. ST1194.2 +052600 PERFORM DE-LETE. ST1194.2 +052700 PERFORM PRINT-DETAIL. ST1194.2 +052800 GO TO IN-2. ST1194.2 +052900 INPT-TEST-2-1. ST1194.2 +053000 IF WRK-XN-00001-2 = "S" ST1194.2 +053100 PERFORM PASS ST1194.2 +053200 PERFORM PRINT-DETAIL ST1194.2 +053300 GO TO INPT-TEST-2-2. ST1194.2 +053400 MOVE "GO TO EXTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +053500 TO RE-MARK. ST1194.2 +053600 MOVE "S" TO CORRECT-X. ST1194.2 +053700 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +053800 PERFORM FAIL. ST1194.2 +053900 PERFORM PRINT-DETAIL. ST1194.2 +054000 INPT-TEST-2-2. ST1194.2 +054100 MOVE "INPT-TEST-2-1" TO PAR-NAME. ST1194.2 +054200 ADD 1 TO REC-CT. ST1194.2 +054300 IF WRK-XN-00001-1 = "K" ST1194.2 +054400 PERFORM PASS ST1194.2 +054500 PERFORM PRINT-DETAIL ST1194.2 +054600 ELSE ST1194.2 +054700 MOVE "GO TO EXTERNAL CODE ERROR" ST1194.2 +054800 TO RE-MARK ST1194.2 +054900 MOVE "K" TO CORRECT-X ST1194.2 +055000 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +055100 PERFORM FAIL ST1194.2 +055200 PERFORM PRINT-DETAIL. ST1194.2 +055300 GO TO IN-2. ST1194.2 +055400* ST1194.2 +055500* THE FOLLOWING CODE IS ACCESSED FROM OUTSIDE THE INPUT ST1194.2 +055600* PROCEEDURE: ST1194.2 +055700* ST1194.2 +055800 INTERNAL-CODE-3. ST1194.2 +055900 MOVE "L" TO WRK-XN-00001-1. ST1194.2 +056000 INTERNAL-CODE-4. ST1194.2 +056100 MOVE "M" TO WRK-XN-00001-1. ST1194.2 +056200 GO TO INT-TEST-4-1. ST1194.2 +056300* ST1194.2 +056400* NOTE. ST1194.2 +056500* KEYS 1 AND 3 THRU 5 WILL VARY IN VALUE BETWEEN 1 AND 2. ST1194.2 +056600* KEY 2 VARIES FROM 1 THRU 6. THUS 96 RECORDS ARE CREATED ST1194.2 +056700* IN REVERSE SEQUENCE OF SORTING ORDER. TWO RECORDS ARE ST1194.2 +056800* ADDED TO EACH END OF THE SORTED STRING FOR HI-LOW CONTROL.ST1194.2 +056900* THE SORT STATEMENT TESTS THE SERIES AND THRU OPTIONS WITH ST1194.2 +057000* INCLUSION AND OMISSION OF OPTIONAL WORDS. THE SORT ST1194.2 +057100* STATEMENT REPRESENTS BASIC SORTING PERMITTED BY LEVEL 1 OFST1194.2 +057200* THE SORT MODULE. ST1194.2 +057300 IN-2. ST1194.2 +057400 MOVE 900009000000000 TO RDF-KEYS. ST1194.2 +057500 RELEASE S-RECORD. ST1194.2 +057600 MOVE 009000000900009 TO RDF-KEYS. ST1194.2 +057700 RELEASE S-RECORD. ST1194.2 +057800 MOVE 900008000000000 TO RDF-KEYS. ST1194.2 +057900 RELEASE S-RECORD. ST1194.2 +058000 MOVE 009000000900008 TO RDF-KEYS. ST1194.2 +058100 RELEASE S-RECORD. ST1194.2 +058200* NOTE HI-LOW CONTROL RECORDS DONE. ST1194.2 +058300 MOVE 300003000000000 TO WKEYS-RDF. ST1194.2 +058400 IN-3. ST1194.2 +058500 PERFORM IN-4 2 TIMES. ST1194.2 +058600 GO TO IN-EXIT. ST1194.2 +058700 IN-4. ST1194.2 +058800 SUBTRACT C1 FROM WKEY-1. ST1194.2 +058900 PERFORM IN-5 6 TIMES. ST1194.2 +059000 IN-5. ST1194.2 +059100 IF WKEY-2 IS EQUAL TO C6 ST1194.2 +059200 MOVE C0 TO WKEY-2. ST1194.2 +059300 ADD C1 TO WKEY-2. ST1194.2 +059400 PERFORM IN-6 2 TIMES. ST1194.2 +059500 IN-6. ST1194.2 +059600 IF WKEY-3 IS EQUAL TO C1 ST1194.2 +059700 MOVE C3 TO WKEY-3. ST1194.2 +059800 SUBTRACT C1 FROM WKEY-3. ST1194.2 +059900 PERFORM IN-7 2 TIMES. ST1194.2 +060000 IN-7. ST1194.2 +060100 IF WKEY-4 IS EQUAL TO C2 ST1194.2 +060200 MOVE C0 TO WKEY-4. ST1194.2 +060300 ADD C1 TO WKEY-4. ST1194.2 +060400 PERFORM IN-8 2 TIMES. ST1194.2 +060500 IN-8. ST1194.2 +060600 IF WKEY-5 IS EQUAL TO C2 ST1194.2 +060700 MOVE C0 TO WKEY-5. ST1194.2 +060800 ADD C1 TO WKEY-5. ST1194.2 +060900 MOVE WKEYS-RDF TO RDF-KEYS. ST1194.2 +061000 RELEASE S-RECORD. ST1194.2 +061100 IN-EXIT. ST1194.2 +061200 EXIT. ST1194.2 +061300 ST1194.2 +061400 OUT-PROC-1. ST1194.2 +061500 MOVE SPACES TO PAR-NAME. ST1194.2 +061600 MOVE SPACES TO FEATURE. ST1194.2 +061700 MOVE ZERO TO REC-CT. ST1194.2 +061800 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +061900 MOVE "ST119 GENERATES OUTPUT" TO RE-MARK. ST1194.2 +062000 PERFORM PRINT-DETAIL. ST1194.2 +062100 MOVE "WHICH AFFECTS PROGRAMS" TO RE-MARK. ST1194.2 +062200 PERFORM PRINT-DETAIL. ST1194.2 +062300 MOVE "ST120 AND ST121." TO RE-MARK. ST1194.2 +062400 PERFORM PRINT-DETAIL. ST1194.2 +062500 MOVE "SORT --- FIVE KEYS" TO FEATURE. ST1194.2 +062600 OPEN OUTPUT SORTOUT-1A. ST1194.2 +062700 SORT-TEST-1. ST1194.2 +062800 PERFORM RET-1. ST1194.2 +062900 IF RDF-KEYS EQUAL TO 009000000900009 ST1194.2 +063000 PERFORM PASS GO TO SORT-WRITE-1. ST1194.2 +063100 GO TO SORT-FAIL-1. ST1194.2 +063200 SORT-DELETE-1. ST1194.2 +063300 PERFORM DE-LETE. ST1194.2 +063400 GO TO SORT-WRITE-1. ST1194.2 +063500 SORT-FAIL-1. ST1194.2 +063600 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +063700 MOVE 009000000900009 TO CORRECT-18V0. ST1194.2 +063800 PERFORM FAIL. ST1194.2 +063900 SORT-WRITE-1. ST1194.2 +064000 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1194.2 +064100 PERFORM PRINT-DETAIL. ST1194.2 +064200 SORT-TEST-2. ST1194.2 +064300 PERFORM RET-1. ST1194.2 +064400 IF RDF-KEYS EQUAL TO 009000000900008 ST1194.2 +064500 PERFORM PASS GO TO SORT-WRITE-2. ST1194.2 +064600 GO TO SORT-FAIL-2. ST1194.2 +064700 SORT-DELETE-2. ST1194.2 +064800 PERFORM DE-LETE. ST1194.2 +064900 GO TO SORT-WRITE-2. ST1194.2 +065000 SORT-FAIL-2. ST1194.2 +065100 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +065200 MOVE 009000000900009 TO CORRECT-18V0. ST1194.2 +065300 PERFORM FAIL. ST1194.2 +065400 SORT-WRITE-2. ST1194.2 +065500 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1194.2 +065600 PERFORM PRINT-DETAIL. ST1194.2 +065700 SORT-TEST-3. ST1194.2 +065800 PERFORM RET-1. ST1194.2 +065900 IF RDF-KEYS EQUAL TO 106001000200002 ST1194.2 +066000 PERFORM PASS GO TO SORT-WRITE-3. ST1194.2 +066100 GO TO SORT-FAIL-3. ST1194.2 +066200 SORT-DELETE-3. ST1194.2 +066300 PERFORM DE-LETE. ST1194.2 +066400 GO TO SORT-WRITE-3. ST1194.2 +066500 SORT-FAIL-3. ST1194.2 +066600 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +066700 MOVE 106001000200002 TO CORRECT-18V0. ST1194.2 +066800 PERFORM FAIL. ST1194.2 +066900 SORT-WRITE-3. ST1194.2 +067000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1194.2 +067100 PERFORM PRINT-DETAIL. ST1194.2 +067200 ST1194.2 +067300 SORT-TEST-4. ST1194.2 +067400 PERFORM RET-2 48 TIMES. ST1194.2 +067500 IF RDF-KEYS EQUAL TO 206001000200002 ST1194.2 +067600 PERFORM PASS GO TO SORT-WRITE-4. ST1194.2 +067700 GO TO SORT-FAIL-4. ST1194.2 +067800 SORT-DELETE-4. ST1194.2 +067900 PERFORM DE-LETE. ST1194.2 +068000 GO TO SORT-WRITE-4. ST1194.2 +068100 SORT-FAIL-4. ST1194.2 +068200 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +068300 MOVE 206001000200002 TO CORRECT-18V0. ST1194.2 +068400 PERFORM FAIL. ST1194.2 +068500 SORT-WRITE-4. ST1194.2 +068600 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1194.2 +068700 PERFORM PRINT-DETAIL. ST1194.2 +068800 SORT-TEST-5. ST1194.2 +068900 PERFORM RET-2 40 TIMES. ST1194.2 +069000 IF RDF-KEYS EQUAL TO 201001000200002 ST1194.2 +069100 PERFORM PASS GO TO SORT-WRITE-5. ST1194.2 +069200 GO TO SORT-FAIL-5. ST1194.2 +069300 SORT-DELETE-5. ST1194.2 +069400 PERFORM DE-LETE. ST1194.2 +069500 GO TO SORT-WRITE-5. ST1194.2 +069600 SORT-FAIL-5. ST1194.2 +069700 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +069800 MOVE 201001000200002 TO CORRECT-18V0. ST1194.2 +069900 PERFORM FAIL. ST1194.2 +070000 SORT-WRITE-5. ST1194.2 +070100 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1194.2 +070200 PERFORM PRINT-DETAIL. ST1194.2 +070300 SORT-TEST-6. ST1194.2 +070400 PERFORM RET-2. ST1194.2 +070500 PERFORM RET-3 THRU RET-3-EXIT. ST1194.2 +070600 PERFORM RET-4 THRU RET-4-EXIT. ST1194.2 +070700 PERFORM RET-5 THRU RET-5-EXIT. ST1194.2 +070800 PERFORM RET-6 THRU RET-6-EXIT. ST1194.2 +070900 PERFORM RET-7 THRU RET-7-EXIT. ST1194.2 +071000 PERFORM RET-8 THRU RET-8-EXIT. ST1194.2 +071100 IF RDF-KEYS EQUAL TO 201002000100001 ST1194.2 +071200 PERFORM PASS GO TO SORT-WRITE-6. ST1194.2 +071300 GO TO SORT-FAIL-6. ST1194.2 +071400 SORT-DELETE-6. ST1194.2 +071500 PERFORM DE-LETE. ST1194.2 +071600 GO TO SORT-WRITE-6. ST1194.2 +071700 SORT-FAIL-6. ST1194.2 +071800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +071900 MOVE 201002000100001 TO CORRECT-18V0. ST1194.2 +072000 PERFORM FAIL. ST1194.2 +072100 SORT-WRITE-6. ST1194.2 +072200 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1194.2 +072300 PERFORM PRINT-DETAIL. ST1194.2 +072400 SORT-TEST-7. ST1194.2 +072500 PERFORM RET-2. ST1194.2 +072600 IF RDF-KEYS EQUAL TO 900008000000000 ST1194.2 +072700 PERFORM PASS GO TO SORT-WRITE-7. ST1194.2 +072800 GO TO SORT-FAIL-7. ST1194.2 +072900 SORT-DELETE-7. ST1194.2 +073000 PERFORM DE-LETE. ST1194.2 +073100 GO TO SORT-WRITE-7. ST1194.2 +073200 SORT-FAIL-7. ST1194.2 +073300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +073400 MOVE 900008000000000 TO CORRECT-18V0. ST1194.2 +073500 PERFORM FAIL. ST1194.2 +073600 SORT-WRITE-7. ST1194.2 +073700 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1194.2 +073800 PERFORM PRINT-DETAIL. ST1194.2 +073900 SORT-TEST-8. ST1194.2 +074000 PERFORM RET-2. ST1194.2 +074100 IF RDF-KEYS EQUAL TO 900009000000000 ST1194.2 +074200 PERFORM PASS GO TO SORT-WRITE-8. ST1194.2 +074300 GO TO SORT-FAIL-8. ST1194.2 +074400 SORT-DELETE-8. ST1194.2 +074500 PERFORM DE-LETE. ST1194.2 +074600 GO TO SORT-WRITE-8. ST1194.2 +074700 SORT-FAIL-8. ST1194.2 +074800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +074900 MOVE 900009000000000 TO CORRECT-18V0. ST1194.2 +075000 PERFORM FAIL. ST1194.2 +075100 SORT-WRITE-8. ST1194.2 +075200 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1194.2 +075300 PERFORM PRINT-DETAIL. ST1194.2 +075400 SORT-TEST-9. ST1194.2 +075500 RETURN SORTFILE-1A AT END ST1194.2 +075600 PERFORM PASS GO TO SORT-WRITE-9. ST1194.2 +075700 GO TO SORT-FAIL-9. ST1194.2 +075800 SORT-DELETE-9. ST1194.2 +075900 PERFORM DE-LETE. ST1194.2 +076000 GO TO SORT-WRITE-9. ST1194.2 +076100 SORT-FAIL-9. ST1194.2 +076200 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +076300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1194.2 +076400 PERFORM FAIL. ST1194.2 +076500 SORT-WRITE-9. ST1194.2 +076600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1194.2 +076700 PERFORM PRINT-DETAIL. ST1194.2 +076800 SORT-INIT-10. ST1194.2 +076900 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +077000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1194.2 +077100 MOVE "PERFORM EXTNL CODE" TO FEATURE. ST1194.2 +077200 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +077300 PERFORM EXTERNAL-CODE-1. ST1194.2 +077400 GO TO SORT-TEST-10. ST1194.2 +077500 SORT-DELETE-10. ST1194.2 +077600 PERFORM DE-LETE. ST1194.2 +077700 PERFORM PRINT-DETAIL. ST1194.2 +077800 GO TO SORT-INIT-11. ST1194.2 +077900 SORT-TEST-10. ST1194.2 +078000 IF WRK-XN-00001-1 = "A" ST1194.2 +078100 PERFORM PASS ST1194.2 +078200 PERFORM PRINT-DETAIL ST1194.2 +078300 ELSE ST1194.2 +078400 MOVE "EXTERNAL CODE NOT PERFORMED FROM OUTPUT PROC"ST1194.2 +078500 TO RE-MARK ST1194.2 +078600 MOVE "A" TO CORRECT-X ST1194.2 +078700 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +078800 PERFORM FAIL ST1194.2 +078900 PERFORM PRINT-DETAIL. ST1194.2 +079000 ST1194.2 +079100 SORT-INIT-11. ST1194.2 +079200 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +079300 MOVE "SORT-TEST-11-1" TO PAR-NAME. ST1194.2 +079400 MOVE "GO TO EXTERNAL CODE" TO FEATURE. ST1194.2 +079500 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +079600 MOVE "D" TO WRK-XN-00001-2. ST1194.2 +079700 MOVE 1 TO REC-CT. ST1194.2 +079800 GO TO EXTERNAL-CODE-2. ST1194.2 +079900 SORT-FAIL-11-1. ST1194.2 +080000 MOVE "Z" TO WRK-XN-00001-2. ST1194.2 +080100 GO TO SORT-TEST-11-1. ST1194.2 +080200 SORT-DELETE-11. ST1194.2 +080300 PERFORM DE-LETE. ST1194.2 +080400 PERFORM PRINT-DETAIL. ST1194.2 +080500 GO TO SORT-INIT-11. ST1194.2 +080600 SORT-TEST-11-1. ST1194.2 +080700 IF WRK-XN-00001-2 = "D" ST1194.2 +080800 PERFORM PASS ST1194.2 +080900 PERFORM PRINT-DETAIL ST1194.2 +081000 GO TO SORT-TEST-11-2. ST1194.2 +081100 MOVE "GO TO EXTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +081200 TO RE-MARK. ST1194.2 +081300 MOVE "D" TO CORRECT-X. ST1194.2 +081400 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +081500 PERFORM FAIL. ST1194.2 +081600 PERFORM PRINT-DETAIL. ST1194.2 +081700 SORT-TEST-11-2. ST1194.2 +081800 MOVE "SORT-TEST-11-2" TO PAR-NAME. ST1194.2 +081900 ADD 1 TO REC-CT. ST1194.2 +082000 IF WRK-XN-00001-1 = "B" ST1194.2 +082100 PERFORM PASS ST1194.2 +082200 PERFORM PRINT-DETAIL ST1194.2 +082300 ELSE ST1194.2 +082400 MOVE "GO TO EXTERNAL CODE ERROR" ST1194.2 +082500 TO RE-MARK ST1194.2 +082600 MOVE "B" TO CORRECT-X ST1194.2 +082700 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +082800 PERFORM FAIL ST1194.2 +082900 PERFORM PRINT-DETAIL. ST1194.2 +083000 GO TO SORT-END. ST1194.2 +083100* ST1194.2 +083200* THE FOLLOWING CODE IS ACCESSED FROM OUTSIDE THE OUTPUT ST1194.2 +083300* PROCEEDURE: ST1194.2 +083400* ST1194.2 +083500 INTERNAL-CODE-1. ST1194.2 +083600 MOVE "C" TO WRK-XN-00001-1. ST1194.2 +083700 INTERNAL-CODE-2. ST1194.2 +083800 MOVE "D" TO WRK-XN-00001-1. ST1194.2 +083900 GO TO INT-TEST-2-1. ST1194.2 +084000 ST1194.2 +084100 SORT-END. ST1194.2 +084200 CLOSE SORTOUT-1A. ST1194.2 +084300 ST1194.2 +084400 BAD-FILE. ST1194.2 +084500 MOVE "BAD-FILE" TO PAR-NAME. ST1194.2 +084600 PERFORM FAIL. ST1194.2 +084700 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1194.2 +084800 PERFORM PRINT-DETAIL. ST1194.2 +084900 MOVE "REACHED, PREVIOUS TEST WAS" TO RE-MARK. ST1194.2 +085000 PERFORM PRINT-DETAIL. ST1194.2 +085100 MOVE "THE LAST SUCCESSFUL TEST." TO RE-MARK. ST1194.2 +085200 PERFORM PRINT-DETAIL. ST1194.2 +085300 MOVE SPACE TO FEATURE. ST1194.2 +085400 GO TO CCVS-EXIT. ST1194.2 +085500 RET-1. ST1194.2 +085600 RETURN SORTFILE-1A RECORD AT END GO TO BAD-FILE. ST1194.2 +085700 MOVE S-RECORD TO SORTED. ST1194.2 +085800 WRITE SORTED. ST1194.2 +085900* NOTE THE RETURN VERB WITH ALL OPTIONAL WORDS. ST1194.2 +086000 RET-2. ST1194.2 +086100 RETURN SORTFILE-1A END GO TO BAD-FILE. ST1194.2 +086200 MOVE S-RECORD TO SORTED. ST1194.2 +086300 WRITE SORTED. ST1194.2 +086400* NOTE THE RETURN VERB WITHOUT OPTIONAL WORDS. ST1194.2 +086500 RET-3. ST1194.2 +086600 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +086700 MOVE "RET-3" TO PAR-NAME. ST1194.2 +086800 RETURN SORTFILE-1A ST1194.2 +086900 AT END GO TO BAD-FILE ST1194.2 +087000 NOT AT END ST1194.2 +087100 PERFORM PASS ST1194.2 +087200 PERFORM PRINT-DETAIL ST1194.2 +087300 MOVE S-RECORD TO SORTED ST1194.2 +087400 WRITE SORTED ST1194.2 +087500 GO TO RET-3-EXIT. ST1194.2 +087600 RET-3-EXIT. ST1194.2 +087700 EXIT. ST1194.2 +087800 RET-4. ST1194.2 +087900 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +088000 MOVE "RET-4" TO PAR-NAME. ST1194.2 +088100 MOVE "A" TO WRK-XN-00001-3. ST1194.2 +088200 RETURN SORTFILE-1A ST1194.2 +088300 AT END GO TO BAD-FILE ST1194.2 +088400 END-RETURN ST1194.2 +088500 MOVE "S" TO WRK-XN-00001-3. ST1194.2 +088600 MOVE S-RECORD TO SORTED. ST1194.2 +088700 WRITE SORTED. ST1194.2 +088800 IF WRK-XN-00001-3 = "S" ST1194.2 +088900 PERFORM PASS ST1194.2 +089000 PERFORM PRINT-DETAIL ST1194.2 +089100 ELSE ST1194.2 +089200 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +089300 MOVE "S" TO CORRECT-X ST1194.2 +089400 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +089500 PERFORM FAIL ST1194.2 +089600 PERFORM PRINT-DETAIL. ST1194.2 +089700 RET-4-EXIT. ST1194.2 +089800 EXIT. ST1194.2 +089900 RET-5. ST1194.2 +090000 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +090100 MOVE "RET-5" TO PAR-NAME. ST1194.2 +090200 RETURN SORTFILE-1A ST1194.2 +090300 AT END ST1194.2 +090400 PERFORM FAIL ST1194.2 +090500 PERFORM PRINT-DETAIL ST1194.2 +090600 GO TO BAD-FILE ST1194.2 +090700 NOT AT END ST1194.2 +090800 PERFORM PASS ST1194.2 +090900 PERFORM PRINT-DETAIL ST1194.2 +091000 MOVE S-RECORD TO SORTED ST1194.2 +091100 WRITE SORTED. ST1194.2 +091200 RET-5-EXIT. ST1194.2 +091300 EXIT. ST1194.2 +091400 RET-6. ST1194.2 +091500 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +091600 MOVE "RET-6" TO PAR-NAME. ST1194.2 +091700 MOVE "V" TO WRK-XN-00001-3. ST1194.2 +091800 RETURN SORTFILE-1A ST1194.2 +091900 AT END ST1194.2 +092000 GO TO BAD-FILE ST1194.2 +092100 END-RETURN ST1194.2 +092200 MOVE "W" TO WRK-XN-00001-3. ST1194.2 +092300 MOVE S-RECORD TO SORTED. ST1194.2 +092400 WRITE SORTED. ST1194.2 +092500 IF WRK-XN-00001-3 = "W" ST1194.2 +092600 PERFORM PASS ST1194.2 +092700 PERFORM PRINT-DETAIL ST1194.2 +092800 ELSE ST1194.2 +092900 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +093000 MOVE "W" TO CORRECT-X ST1194.2 +093100 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +093200 PERFORM FAIL ST1194.2 +093300 PERFORM PRINT-DETAIL. ST1194.2 +093400 RET-6-EXIT. ST1194.2 +093500 EXIT. ST1194.2 +093600 RET-7. ST1194.2 +093700 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +093800 MOVE "RET-7" TO PAR-NAME. ST1194.2 +093900 MOVE "G" TO WRK-XN-00001-3. ST1194.2 +094000 RETURN SORTFILE-1A ST1194.2 +094100 AT END GO TO BAD-FILE ST1194.2 +094200 NOT AT END ST1194.2 +094300 MOVE S-RECORD TO SORTED ST1194.2 +094400 WRITE SORTED ST1194.2 +094500 END-RETURN ST1194.2 +094600 MOVE "K" TO WRK-XN-00001-3. ST1194.2 +094700 IF WRK-XN-00001-3 = "K" ST1194.2 +094800 PERFORM PASS ST1194.2 +094900 PERFORM PRINT-DETAIL ST1194.2 +095000 ELSE ST1194.2 +095100 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +095200 MOVE "K" TO CORRECT-X ST1194.2 +095300 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +095400 PERFORM FAIL ST1194.2 +095500 PERFORM PRINT-DETAIL. ST1194.2 +095600 RET-7-EXIT. ST1194.2 +095700 EXIT. ST1194.2 +095800 RET-8. ST1194.2 +095900 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +096000 MOVE "RET-8" TO PAR-NAME. ST1194.2 +096100 MOVE "X" TO WRK-XN-00001-3. ST1194.2 +096200 RETURN SORTFILE-1A ST1194.2 +096300 AT END ST1194.2 +096400 GO TO BAD-FILE ST1194.2 +096500 NOT AT END ST1194.2 +096600 MOVE S-RECORD TO SORTED ST1194.2 +096700 WRITE SORTED ST1194.2 +096800 END-RETURN ST1194.2 +096900 MOVE "T" TO WRK-XN-00001-3. ST1194.2 +097000 IF WRK-XN-00001-3 = "T" ST1194.2 +097100 PERFORM PASS ST1194.2 +097200 PERFORM PRINT-DETAIL ST1194.2 +097300 ELSE ST1194.2 +097400 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +097500 MOVE "T" TO CORRECT-X ST1194.2 +097600 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +097700 PERFORM FAIL ST1194.2 +097800 PERFORM PRINT-DETAIL. ST1194.2 +097900 MOVE SPACES TO TEST-RESULTS. ST1194.2 +098000 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1194.2 +098100 PERFORM PRINT-DETAIL. ST1194.2 +098200 MOVE SPACES TO TEST-RESULTS. ST1194.2 +098300 RET-8-EXIT. ST1194.2 +098400 EXIT. ST1194.2 +098500 ST1194.2 +098600 EXTERNAL-CODE-1. ST1194.2 +098700 MOVE "A" TO WRK-XN-00001-1. ST1194.2 +098800 EXTERNAL-CODE-2. ST1194.2 +098900 MOVE "B" TO WRK-XN-00001-1. ST1194.2 +099000 GO TO SORT-TEST-11-1. ST1194.2 +099100 EXTERNAL-CODE-3. ST1194.2 +099200 MOVE "J" TO WRK-XN-00001-1. ST1194.2 +099300 EXTERNAL-CODE-4. ST1194.2 +099400 MOVE "K" TO WRK-XN-00001-1. ST1194.2 +099500 GO TO INPT-TEST-2-1. ST1194.2 +099600 ST1194.2 +099700 CCVS-EXIT SECTION. ST1194.2 +099800 CCVS-9999. ST1194.2 +099900 GO TO CLOSE-FILES. ST1194.2 +*END-OF,ST119A +*HEADER,COBOL,ST119A,SUBPRG,ST120A +000100 IDENTIFICATION DIVISION. ST1204.2 +000200 PROGRAM-ID. ST1204.2 +000300 ST120A. ST1204.2 +000400**************************************************************** ST1204.2 +000500* * ST1204.2 +000600* VALIDATION FOR:- * ST1204.2 +000700* * ST1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1204.2 +000900* * ST1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1204.2 +001100* * ST1204.2 +001200**************************************************************** ST1204.2 +001300* * ST1204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1204.2 +001500* * ST1204.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1204.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1204.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1204.2 +001900* * ST1204.2 +002000**************************************************************** ST1204.2 +002100 ENVIRONMENT DIVISION. ST1204.2 +002200 CONFIGURATION SECTION. ST1204.2 +002300 SOURCE-COMPUTER. ST1204.2 +002400 XXXXX082. ST1204.2 +002500 OBJECT-COMPUTER. ST1204.2 +002600 XXXXX083. ST1204.2 +002700 INPUT-OUTPUT SECTION. ST1204.2 +002800 FILE-CONTROL. ST1204.2 +002900 SELECT SORTFILE-1B ASSIGN TO ST1204.2 +003000 XXXXX027. ST1204.2 +003100 SELECT SORTIN-1B ASSIGN TO ST1204.2 +003200 XXXXD001. ST1204.2 +003300 SELECT SORTOUT-1B ASSIGN TO ST1204.2 +003400 XXXXP002. ST1204.2 +003500 DATA DIVISION. ST1204.2 +003600 FILE SECTION. ST1204.2 +003700 SD SORTFILE-1B ST1204.2 +003800 RECORD CONTAINS 120 CHARACTERS ST1204.2 +003900 DATA RECORD S-RECORD. ST1204.2 +004000 01 S-RECORD. ST1204.2 +004100 02 KEYS-GROUP. ST1204.2 +004200 03 KEY-1 PICTURE 9. ST1204.2 +004300 03 KEY-2 PICTURE 99. ST1204.2 +004400 03 KEY-3 PICTURE 999. ST1204.2 +004500 03 KEY-4 PICTURE 9999. ST1204.2 +004600 03 KEY-5 PICTURE 9(5). ST1204.2 +004700 02 FILLER PICTURE X(105). ST1204.2 +004800 FD SORTIN-1B ST1204.2 +004900 BLOCK CONTAINS 10 RECORDS ST1204.2 +005000 LABEL RECORDS ARE STANDARD ST1204.2 +005100C VALUE OF ST1204.2 +005200C XXXXX074 ST1204.2 +005300C IS ST1204.2 +005400C XXXXX075 ST1204.2 +005500G XXXXX069 ST1204.2 +005600 DATA RECORD IS INSORT. ST1204.2 +005700 01 INSORT PICTURE X(120). ST1204.2 +005800 FD SORTOUT-1B ST1204.2 +005900 BLOCK CONTAINS 10 RECORDS ST1204.2 +006000 LABEL RECORD STANDARD ST1204.2 +006100C VALUE OF ST1204.2 +006200C XXXXX074 ST1204.2 +006300C IS ST1204.2 +006400C XXXXX076 ST1204.2 +006500G XXXXX069 ST1204.2 +006600 DATA RECORD OUTSORT. ST1204.2 +006700 01 OUTSORT PICTURE X(120). ST1204.2 +006800 PROCEDURE DIVISION. ST1204.2 +006900 SORT-STATEMENT. ST1204.2 +007000 SORT SORTFILE-1B ST1204.2 +007100 ON DESCENDING KEY KEY-1 ST1204.2 +007200 ON ASCENDING KEY KEY-2 ST1204.2 +007300 ON DESCENDING KEY KEY-3 ST1204.2 +007400 ASCENDING KEY-4 KEY-5 ST1204.2 +007500 USING SORTIN-1B ST1204.2 +007600 GIVING SORTOUT-1B. ST1204.2 +007700 STOP-RUN-STATEMENT. ST1204.2 +007800 STOP RUN. ST1204.2 +*END-OF,ST120A +*HEADER,COBOL,ST119A,SUBPRG,ST121A +000100 IDENTIFICATION DIVISION. ST1214.2 +000200 PROGRAM-ID. ST1214.2 +000300 ST121A. ST1214.2 +000400**************************************************************** ST1214.2 +000500* * ST1214.2 +000600* VALIDATION FOR:- * ST1214.2 +000700* * ST1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +000900* * ST1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1214.2 +001100* * ST1214.2 +001200**************************************************************** ST1214.2 +001300* * ST1214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1214.2 +001500* * ST1214.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1214.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1214.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1214.2 +001900* * ST1214.2 +002000**************************************************************** ST1214.2 +002100 ENVIRONMENT DIVISION. ST1214.2 +002200 CONFIGURATION SECTION. ST1214.2 +002300 SOURCE-COMPUTER. ST1214.2 +002400 XXXXX082. ST1214.2 +002500 OBJECT-COMPUTER. ST1214.2 +002600 XXXXX083. ST1214.2 +002700 INPUT-OUTPUT SECTION. ST1214.2 +002800 FILE-CONTROL. ST1214.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1214.2 +003000 XXXXX055. ST1214.2 +003100 SELECT SORTIN-1C ASSIGN TO ST1214.2 +003200 XXXXD002. ST1214.2 +003300 DATA DIVISION. ST1214.2 +003400 FILE SECTION. ST1214.2 +003500 FD PRINT-FILE. ST1214.2 +003600 01 PRINT-REC PICTURE X(120). ST1214.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1214.2 +003800 FD SORTIN-1C ST1214.2 +003900 BLOCK CONTAINS 10 RECORDS ST1214.2 +004000 LABEL RECORD STANDARD ST1214.2 +004100C VALUE OF ST1214.2 +004200C XXXXX074 ST1214.2 +004300C IS ST1214.2 +004400C XXXXX076 ST1214.2 +004500G XXXXX069 ST1214.2 +004600 DATA RECORD IS SORTIN-REC. ST1214.2 +004700 01 SORTIN-REC. ST1214.2 +004800 02 KEYS-GROUP PICTURE 9(15). ST1214.2 +004900 02 FILLER PICTURE X(105). ST1214.2 +005000 WORKING-STORAGE SECTION. ST1214.2 +005100 01 TEST-RESULTS. ST1214.2 +005200 02 FILLER PIC X VALUE SPACE. ST1214.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. ST1214.2 +005400 02 FILLER PIC X VALUE SPACE. ST1214.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. ST1214.2 +005600 02 FILLER PIC X VALUE SPACE. ST1214.2 +005700 02 PAR-NAME. ST1214.2 +005800 03 FILLER PIC X(19) VALUE SPACE. ST1214.2 +005900 03 PARDOT-X PIC X VALUE SPACE. ST1214.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. ST1214.2 +006100 02 FILLER PIC X(8) VALUE SPACE. ST1214.2 +006200 02 RE-MARK PIC X(61). ST1214.2 +006300 01 TEST-COMPUTED. ST1214.2 +006400 02 FILLER PIC X(30) VALUE SPACE. ST1214.2 +006500 02 FILLER PIC X(17) VALUE ST1214.2 +006600 " COMPUTED=". ST1214.2 +006700 02 COMPUTED-X. ST1214.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1214.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A ST1214.2 +007000 PIC -9(9).9(9). ST1214.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1214.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1214.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1214.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. ST1214.2 +007500 04 COMPUTED-18V0 PIC -9(18). ST1214.2 +007600 04 FILLER PIC X. ST1214.2 +007700 03 FILLER PIC X(50) VALUE SPACE. ST1214.2 +007800 01 TEST-CORRECT. ST1214.2 +007900 02 FILLER PIC X(30) VALUE SPACE. ST1214.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1214.2 +008100 02 CORRECT-X. ST1214.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1214.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1214.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1214.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1214.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1214.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. ST1214.2 +008800 04 CORRECT-18V0 PIC -9(18). ST1214.2 +008900 04 FILLER PIC X. ST1214.2 +009000 03 FILLER PIC X(2) VALUE SPACE. ST1214.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1214.2 +009200 01 CCVS-C-1. ST1214.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1214.2 +009400- "SS PARAGRAPH-NAME ST1214.2 +009500- " REMARKS". ST1214.2 +009600 02 FILLER PIC X(20) VALUE SPACE. ST1214.2 +009700 01 CCVS-C-2. ST1214.2 +009800 02 FILLER PIC X VALUE SPACE. ST1214.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". ST1214.2 +010000 02 FILLER PIC X(15) VALUE SPACE. ST1214.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". ST1214.2 +010200 02 FILLER PIC X(94) VALUE SPACE. ST1214.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1214.2 +010400 01 REC-CT PIC 99 VALUE ZERO. ST1214.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1214.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1214.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1214.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1214.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1214.2 +011400 01 CCVS-H-1. ST1214.2 +011500 02 FILLER PIC X(39) VALUE SPACES. ST1214.2 +011600 02 FILLER PIC X(42) VALUE ST1214.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1214.2 +011800 02 FILLER PIC X(39) VALUE SPACES. ST1214.2 +011900 01 CCVS-H-2A. ST1214.2 +012000 02 FILLER PIC X(40) VALUE SPACE. ST1214.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1214.2 +012200 02 FILLER PIC XXXX VALUE ST1214.2 +012300 "4.2 ". ST1214.2 +012400 02 FILLER PIC X(28) VALUE ST1214.2 +012500 " COPY - NOT FOR DISTRIBUTION". ST1214.2 +012600 02 FILLER PIC X(41) VALUE SPACE. ST1214.2 +012700 ST1214.2 +012800 01 CCVS-H-2B. ST1214.2 +012900 02 FILLER PIC X(15) VALUE ST1214.2 +013000 "TEST RESULT OF ". ST1214.2 +013100 02 TEST-ID PIC X(9). ST1214.2 +013200 02 FILLER PIC X(4) VALUE ST1214.2 +013300 " IN ". ST1214.2 +013400 02 FILLER PIC X(12) VALUE ST1214.2 +013500 " HIGH ". ST1214.2 +013600 02 FILLER PIC X(22) VALUE ST1214.2 +013700 " LEVEL VALIDATION FOR ". ST1214.2 +013800 02 FILLER PIC X(58) VALUE ST1214.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +014000 01 CCVS-H-3. ST1214.2 +014100 02 FILLER PIC X(34) VALUE ST1214.2 +014200 " FOR OFFICIAL USE ONLY ". ST1214.2 +014300 02 FILLER PIC X(58) VALUE ST1214.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1214.2 +014500 02 FILLER PIC X(28) VALUE ST1214.2 +014600 " COPYRIGHT 1985 ". ST1214.2 +014700 01 CCVS-E-1. ST1214.2 +014800 02 FILLER PIC X(52) VALUE SPACE. ST1214.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1214.2 +015000 02 ID-AGAIN PIC X(9). ST1214.2 +015100 02 FILLER PIC X(45) VALUE SPACES. ST1214.2 +015200 01 CCVS-E-2. ST1214.2 +015300 02 FILLER PIC X(31) VALUE SPACE. ST1214.2 +015400 02 FILLER PIC X(21) VALUE SPACE. ST1214.2 +015500 02 CCVS-E-2-2. ST1214.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1214.2 +015700 03 FILLER PIC X VALUE SPACE. ST1214.2 +015800 03 ENDER-DESC PIC X(44) VALUE ST1214.2 +015900 "ERRORS ENCOUNTERED". ST1214.2 +016000 01 CCVS-E-3. ST1214.2 +016100 02 FILLER PIC X(22) VALUE ST1214.2 +016200 " FOR OFFICIAL USE ONLY". ST1214.2 +016300 02 FILLER PIC X(12) VALUE SPACE. ST1214.2 +016400 02 FILLER PIC X(58) VALUE ST1214.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +016600 02 FILLER PIC X(13) VALUE SPACE. ST1214.2 +016700 02 FILLER PIC X(15) VALUE ST1214.2 +016800 " COPYRIGHT 1985". ST1214.2 +016900 01 CCVS-E-4. ST1214.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1214.2 +017100 02 FILLER PIC X(4) VALUE " OF ". ST1214.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1214.2 +017300 02 FILLER PIC X(40) VALUE ST1214.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1214.2 +017500 01 XXINFO. ST1214.2 +017600 02 FILLER PIC X(19) VALUE ST1214.2 +017700 "*** INFORMATION ***". ST1214.2 +017800 02 INFO-TEXT. ST1214.2 +017900 04 FILLER PIC X(8) VALUE SPACE. ST1214.2 +018000 04 XXCOMPUTED PIC X(20). ST1214.2 +018100 04 FILLER PIC X(5) VALUE SPACE. ST1214.2 +018200 04 XXCORRECT PIC X(20). ST1214.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). ST1214.2 +018400 01 HYPHEN-LINE. ST1214.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. ST1214.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************ST1214.2 +018700- "*****************************************". ST1214.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************ST1214.2 +018900- "******************************". ST1214.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE ST1214.2 +019100 "ST121A". ST1214.2 +019200 PROCEDURE DIVISION. ST1214.2 +019300 CCVS1 SECTION. ST1214.2 +019400 OPEN-FILES. ST1214.2 +019500 OPEN OUTPUT PRINT-FILE. ST1214.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1214.2 +019700 MOVE SPACE TO TEST-RESULTS. ST1214.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1214.2 +019900 GO TO CCVS1-EXIT. ST1214.2 +020000 CLOSE-FILES. ST1214.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1214.2 +020200 TERMINATE-CCVS. ST1214.2 +020300S EXIT PROGRAM. ST1214.2 +020400STERMINATE-CALL. ST1214.2 +020500 STOP RUN. ST1214.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1214.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1214.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1214.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1214.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. ST1214.2 +021100 PRINT-DETAIL. ST1214.2 +021200 IF REC-CT NOT EQUAL TO ZERO ST1214.2 +021300 MOVE "." TO PARDOT-X ST1214.2 +021400 MOVE REC-CT TO DOTVALUE. ST1214.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1214.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1214.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1214.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1214.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1214.2 +022000 MOVE SPACE TO CORRECT-X. ST1214.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1214.2 +022200 MOVE SPACE TO RE-MARK. ST1214.2 +022300 HEAD-ROUTINE. ST1214.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1214.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1214.2 +022800 COLUMN-NAMES-ROUTINE. ST1214.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +023200 END-ROUTINE. ST1214.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1214.2 +023400 END-RTN-EXIT. ST1214.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +023600 END-ROUTINE-1. ST1214.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1214.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1214.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. ST1214.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1214.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1214.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1214.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1214.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1214.2 +024500 END-ROUTINE-12. ST1214.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1214.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1214.2 +024800 MOVE "NO " TO ERROR-TOTAL ST1214.2 +024900 ELSE ST1214.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1214.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1214.2 +025200 PERFORM WRITE-LINE. ST1214.2 +025300 END-ROUTINE-13. ST1214.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1214.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE ST1214.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1214.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1214.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO ST1214.2 +026000 MOVE "NO " TO ERROR-TOTAL ST1214.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1214.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1214.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +026500 WRITE-LINE. ST1214.2 +026600 ADD 1 TO RECORD-COUNT. ST1214.2 +026700Y IF RECORD-COUNT GREATER 42 ST1214.2 +026800Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1214.2 +026900Y MOVE SPACE TO DUMMY-RECORD ST1214.2 +027000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1214.2 +027100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1214.2 +027200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1214.2 +027300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1214.2 +027400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1214.2 +027500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027800Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1214.2 +027900Y MOVE ZERO TO RECORD-COUNT. ST1214.2 +028000 PERFORM WRT-LN. ST1214.2 +028100 WRT-LN. ST1214.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1214.2 +028300 MOVE SPACE TO DUMMY-RECORD. ST1214.2 +028400 BLANK-LINE-PRINT. ST1214.2 +028500 PERFORM WRT-LN. ST1214.2 +028600 FAIL-ROUTINE. ST1214.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE ST1214.2 +028800 GO TO FAIL-ROUTINE-WRITE. ST1214.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1214.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1214.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1214.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1214.2 +029400 GO TO FAIL-ROUTINE-EX. ST1214.2 +029500 FAIL-ROUTINE-WRITE. ST1214.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1214.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1214.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1214.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1214.2 +030000 FAIL-ROUTINE-EX. EXIT. ST1214.2 +030100 BAIL-OUT. ST1214.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1214.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1214.2 +030400 BAIL-OUT-WRITE. ST1214.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1214.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1214.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1214.2 +030900 BAIL-OUT-EX. EXIT. ST1214.2 +031000 CCVS1-EXIT. ST1214.2 +031100 EXIT. ST1214.2 +031200 SECT-ST119A-0001 SECTION. ST1214.2 +031300 ST119A-0001-01. ST1214.2 +031400 OPEN INPUT SORTIN-1C. ST1214.2 +031500 MOVE "THIS PROGRAM TESTS THE" TO RE-MARK. ST1214.2 +031600 PERFORM PRINT-DETAIL. ST1214.2 +031700 MOVE "OUTPUT GENERATED BY ST120A," TO RE-MARK. ST1214.2 +031800 PERFORM PRINT-DETAIL. ST1214.2 +031900 MOVE "WHICH WAS IN TURN GENERATED" TO RE-MARK. ST1214.2 +032000 PERFORM PRINT-DETAIL. ST1214.2 +032100 MOVE "IN ST119A." TO RE-MARK. ST1214.2 +032200 PERFORM PRINT-DETAIL. ST1214.2 +032300 MOVE "SORT - USING, GIVING" TO FEATURE. ST1214.2 +032400 SORT-TEST-1. ST1214.2 +032500 PERFORM READ-SORTED-FILE. ST1214.2 +032600 IF KEYS-GROUP EQUAL TO 900009000000000 ST1214.2 +032700 PERFORM PASS GO TO SORT-WRITE-1. ST1214.2 +032800 GO TO SORT-FAIL-1. ST1214.2 +032900 SORT-DELETE-1. ST1214.2 +033000 PERFORM DE-LETE. ST1214.2 +033100 GO TO SORT-WRITE-1. ST1214.2 +033200 SORT-FAIL-1. ST1214.2 +033300 PERFORM FAIL. ST1214.2 +033400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +033500 MOVE 900009000000000 TO CORRECT-18V0. ST1214.2 +033600 SORT-WRITE-1. ST1214.2 +033700 MOVE "SORT-TEST-1" TO PAR-NAME. ST1214.2 +033800 PERFORM PRINT-DETAIL. ST1214.2 +033900 SORT-TEST-2. ST1214.2 +034000 PERFORM READ-SORTED-FILE. ST1214.2 +034100 IF KEYS-GROUP EQUAL TO 900008000000000 ST1214.2 +034200 PERFORM PASS GO TO SORT-WRITE-2. ST1214.2 +034300 GO TO SORT-FAIL-2. ST1214.2 +034400 SORT-DELETE-2. ST1214.2 +034500 PERFORM DE-LETE. ST1214.2 +034600 GO TO SORT-WRITE-2. ST1214.2 +034700 SORT-FAIL-2. ST1214.2 +034800 PERFORM FAIL. ST1214.2 +034900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +035000 MOVE 900008000000000 TO CORRECT-18V0. ST1214.2 +035100 SORT-WRITE-2. ST1214.2 +035200 MOVE "SORT-TEST-2" TO PAR-NAME. ST1214.2 +035300 PERFORM PRINT-DETAIL. ST1214.2 +035400 SORT-TEST-3. ST1214.2 +035500 PERFORM READ-SORTED-FILE. ST1214.2 +035600 IF KEYS-GROUP EQUAL TO 201002000100001 ST1214.2 +035700 PERFORM PASS GO TO SORT-WRITE-3. ST1214.2 +035800 GO TO SORT-FAIL-3. ST1214.2 +035900 SORT-DELETE-3. ST1214.2 +036000 PERFORM DE-LETE. ST1214.2 +036100 GO TO SORT-WRITE-3. ST1214.2 +036200 SORT-FAIL-3. ST1214.2 +036300 PERFORM FAIL. ST1214.2 +036400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +036500 MOVE 201002000100001 TO CORRECT-18V0. ST1214.2 +036600 SORT-WRITE-3. ST1214.2 +036700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1214.2 +036800 PERFORM PRINT-DETAIL. ST1214.2 +036900 SORT-TEST-4. ST1214.2 +037000 PERFORM READ-SORTED-FILE 48 TIMES. ST1214.2 +037100 IF KEYS-GROUP EQUAL TO 101002000100001 ST1214.2 +037200 PERFORM PASS GO TO SORT-WRITE-4. ST1214.2 +037300 GO TO SORT-FAIL-4. ST1214.2 +037400 SORT-DELETE-4. ST1214.2 +037500 PERFORM DE-LETE. ST1214.2 +037600 GO TO SORT-WRITE-4. ST1214.2 +037700 SORT-FAIL-4. ST1214.2 +037800 PERFORM FAIL. ST1214.2 +037900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +038000 MOVE 101002000100001 TO CORRECT-18V0. ST1214.2 +038100 SORT-WRITE-4. ST1214.2 +038200 MOVE "SORT-TEST-4" TO PAR-NAME. ST1214.2 +038300 PERFORM PRINT-DETAIL. ST1214.2 +038400 SORT-TEST-5. ST1214.2 +038500 PERFORM READ-SORTED-FILE 40 TIMES. ST1214.2 +038600 IF KEYS-GROUP EQUAL TO 106002000100001 ST1214.2 +038700 PERFORM PASS GO TO SORT-WRITE-5. ST1214.2 +038800 GO TO SORT-FAIL-5. ST1214.2 +038900 SORT-DELETE-5. ST1214.2 +039000 PERFORM DE-LETE. ST1214.2 +039100 GO TO SORT-WRITE-5. ST1214.2 +039200 SORT-FAIL-5. ST1214.2 +039300 PERFORM FAIL. ST1214.2 +039400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +039500 MOVE 106002000100001 TO CORRECT-18V0. ST1214.2 +039600 SORT-WRITE-5. ST1214.2 +039700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1214.2 +039800 PERFORM PRINT-DETAIL. ST1214.2 +039900 SORT-TEST-6. ST1214.2 +040000 PERFORM READ-SORTED-FILE 7 TIMES. ST1214.2 +040100 IF KEYS-GROUP EQUAL TO 106001000200002 ST1214.2 +040200 PERFORM PASS GO TO SORT-WRITE-6. ST1214.2 +040300 GO TO SORT-FAIL-6. ST1214.2 +040400 SORT-DELETE-6. ST1214.2 +040500 PERFORM DE-LETE. ST1214.2 +040600 GO TO SORT-WRITE-6. ST1214.2 +040700 SORT-FAIL-6. ST1214.2 +040800 PERFORM FAIL. ST1214.2 +040900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +041000 MOVE 106001000200002 TO CORRECT-18V0. ST1214.2 +041100 SORT-WRITE-6. ST1214.2 +041200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1214.2 +041300 PERFORM PRINT-DETAIL. ST1214.2 +041400 SORT-TEST-7. ST1214.2 +041500 PERFORM READ-SORTED-FILE. ST1214.2 +041600 IF KEYS-GROUP EQUAL TO 009000000900008 ST1214.2 +041700 PERFORM PASS GO TO SORT-WRITE-7. ST1214.2 +041800 GO TO SORT-FAIL-7. ST1214.2 +041900 SORT-DELETE-7. ST1214.2 +042000 PERFORM DE-LETE. ST1214.2 +042100 GO TO SORT-WRITE-7. ST1214.2 +042200 SORT-FAIL-7. ST1214.2 +042300 PERFORM FAIL. ST1214.2 +042400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +042500 MOVE 009000000900008 TO CORRECT-18V0. ST1214.2 +042600 SORT-WRITE-7. ST1214.2 +042700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1214.2 +042800 PERFORM PRINT-DETAIL. ST1214.2 +042900 SORT-TEST-8. ST1214.2 +043000 PERFORM READ-SORTED-FILE. ST1214.2 +043100 IF KEYS-GROUP EQUAL TO 009000000900009 ST1214.2 +043200 PERFORM PASS GO TO SORT-WRITE-8. ST1214.2 +043300 GO TO SORT-FAIL-8. ST1214.2 +043400 SORT-DELETE-8. ST1214.2 +043500 PERFORM DE-LETE. ST1214.2 +043600 GO TO SORT-WRITE-8. ST1214.2 +043700 SORT-FAIL-8. ST1214.2 +043800 PERFORM FAIL. ST1214.2 +043900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +044000 MOVE 009000000900009 TO CORRECT-18V0. ST1214.2 +044100 SORT-WRITE-8. ST1214.2 +044200 MOVE "SORT-TEST-8" TO PAR-NAME. ST1214.2 +044300 PERFORM PRINT-DETAIL. ST1214.2 +044400 SORT-TEST-9. ST1214.2 +044500 READ SORTIN-1C AT END ST1214.2 +044600 PERFORM PASS GO TO SORT-WRITE-9. ST1214.2 +044700* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. ST1214.2 +044800 PERFORM FAIL. ST1214.2 +044900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +045000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1214.2 +045100 GO TO SORT-WRITE-9. ST1214.2 +045200 SORT-DELETE-9. ST1214.2 +045300 PERFORM DE-LETE. ST1214.2 +045400 SORT-WRITE-9. ST1214.2 +045500 MOVE "SORT-TEST-9" TO PAR-NAME. ST1214.2 +045600 PERFORM PRINT-DETAIL. ST1214.2 +045700 CLOSE SORTIN-1C. ST1214.2 +045800 GO TO CCVS-EXIT. ST1214.2 +045900 READ-SORTED-FILE. ST1214.2 +046000 READ SORTIN-1C AT END GO TO BAD-FILE. ST1214.2 +046100 BAD-FILE. ST1214.2 +046200 PERFORM FAIL. ST1214.2 +046300 MOVE "BAD-FILE" TO PAR-NAME. ST1214.2 +046400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1214.2 +046500 PERFORM PRINT-DETAIL. ST1214.2 +046600 MOVE SPACE TO FEATURE. ST1214.2 +046700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1214.2 +046800 PERFORM PRINT-DETAIL. ST1214.2 +046900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1214.2 +047000 PERFORM PRINT-DETAIL. ST1214.2 +047100 CCVS-EXIT SECTION. ST1214.2 +047200 CCVS-999999. ST1214.2 +047300 GO TO CLOSE-FILES. ST1214.2 +*END-OF,ST121A +*HEADER,COBOL,ST122A +000100 IDENTIFICATION DIVISION. ST1224.2 +000200 PROGRAM-ID. ST1224.2 +000300 ST122A. ST1224.2 +000400**************************************************************** ST1224.2 +000500* * ST1224.2 +000600* VALIDATION FOR:- * ST1224.2 +000700* * ST1224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +000900* * ST1224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1224.2 +001100* * ST1224.2 +001200**************************************************************** ST1224.2 +001300* * ST1224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1224.2 +001500* * ST1224.2 +001600* X-01 * ST1224.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1224.2 +001800* X-69 * ST1224.2 +001900* X-74 * ST1224.2 +002000* X-75 * ST1224.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1224.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1224.2 +002300* * ST1224.2 +002400**************************************************************** ST1224.2 +002500* ST122 BUILDS A FILE WHICH IS SORTED IN ST123 AND CHECKED IN* ST1224.2 +002600* ST124. THE CREATED FILE CONSISTS OF 40 RECORDS OF VARYING * ST1224.2 +002700* LENGTH (50, 75, 100 CHARACTERS). THE THREE RECORDS SHOWN * ST1224.2 +002800* BELOW REOCCUR UNTIL 40 IS REACHED. * ST1224.2 +002900* NON-KEY KEY-1 KEY-2 FILLER * ST1224.2 +003000* X(2) X(10) X(38) * ST1224.2 +003100* * ST1224.2 +003200* "BB" "LOWEST TWO" "MIDDLE TWO-FIRST" X(25) VALUE ZERO * ST1224.2 +003300* "CC" "LOWEST TWO" "MIDDLE TWO-SECOND" X(50) VALUE QUOTE* ST1224.2 +003400* "AA" "LOWEST ONE" "MIDDLE ONE-ONLY" (NONE) * ST1224.2 +003500* * ST1224.2 +003600* PROGRAMS ST122A, ST123A AND ST124A WILL BE USED * ST1224.2 +003700* ONLY IF LEVEL 2 OF THE SEQUENTIAL I-O MODULE IS SUPPORTED * ST1224.2 +003800* AS THE "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN * ST1224.2 +003900* ST123A. * ST1224.2 +004000* * ST1224.2 +004100**************************************************************** ST1224.2 +004200 ST1224.2 +004300 ENVIRONMENT DIVISION. ST1224.2 +004400 CONFIGURATION SECTION. ST1224.2 +004500 SOURCE-COMPUTER. ST1224.2 +004600 XXXXX082. ST1224.2 +004700 OBJECT-COMPUTER. ST1224.2 +004800 XXXXX083. ST1224.2 +004900 INPUT-OUTPUT SECTION. ST1224.2 +005000 FILE-CONTROL. ST1224.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1224.2 +005200 XXXXX055. ST1224.2 +005300 SELECT SORTOUT-1I ASSIGN TO ST1224.2 +005400 XXXXP001. ST1224.2 +005500 DATA DIVISION. ST1224.2 +005600 FILE SECTION. ST1224.2 +005700 FD PRINT-FILE. ST1224.2 +005800 01 PRINT-REC PICTURE X(120). ST1224.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1224.2 +006000 FD SORTOUT-1I ST1224.2 +006100 LABEL RECORDS STANDARD ST1224.2 +006200C VALUE OF ST1224.2 +006300C XXXXX074 ST1224.2 +006400C IS ST1224.2 +006500C XXXXX075 ST1224.2 +006600G XXXXX069 ST1224.2 +006700 RECORD IS VARYING IN SIZE FROM 50 TO 100 CHARACTERS ST1224.2 +006800 DATA RECORDS ARE SHORT-RECORD ST1224.2 +006900 MEDIUM-RECORD ST1224.2 +007000 LONG-RECORD. ST1224.2 +007100 01 SHORT-RECORD PICTURE X(50). ST1224.2 +007200 01 MEDIUM-RECORD PICTURE X(75). ST1224.2 +007300 01 LONG-RECORD PICTURE X(100). ST1224.2 +007400 WORKING-STORAGE SECTION. ST1224.2 +007500 77 COMMENT-SENTENCE PICTURE X(119) VALUE " ST122A HAS CREATED AST1224.2 +007600- "FILE OF 40 VARIABLE-LENGTH-RECORDS. THESE RECORDS WILL BE SOST1224.2 +007700- "RTED IN ST123A AND CHECKED IN ST124A.". ST1224.2 +007800 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1224.2 +007900 01 SHORT-WORK. ST1224.2 +008000 02 FILLER PICTURE XX VALUE "AA". ST1224.2 +008100 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1224.2 +008200 02 FILLER PICTURE X(38) VALUE "MIDDLE ONE-ONLY". ST1224.2 +008300 01 MEDIUM-WORK. ST1224.2 +008400 02 FILLER PICTURE XX VALUE "BB". ST1224.2 +008500 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1224.2 +008600 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-FIRST". ST1224.2 +008700 02 FILLER PICTURE X(25) VALUE ZERO. ST1224.2 +008800 01 LONG-WORK. ST1224.2 +008900 02 FILLER PICTURE XX VALUE "CC". ST1224.2 +009000 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1224.2 +009100 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-SECOND". ST1224.2 +009200 02 FILLER PICTURE X(50) VALUE QUOTE. ST1224.2 +009300 01 TEST-RESULTS. ST1224.2 +009400 02 FILLER PIC X VALUE SPACE. ST1224.2 +009500 02 FEATURE PIC X(20) VALUE SPACE. ST1224.2 +009600 02 FILLER PIC X VALUE SPACE. ST1224.2 +009700 02 P-OR-F PIC X(5) VALUE SPACE. ST1224.2 +009800 02 FILLER PIC X VALUE SPACE. ST1224.2 +009900 02 PAR-NAME. ST1224.2 +010000 03 FILLER PIC X(19) VALUE SPACE. ST1224.2 +010100 03 PARDOT-X PIC X VALUE SPACE. ST1224.2 +010200 03 DOTVALUE PIC 99 VALUE ZERO. ST1224.2 +010300 02 FILLER PIC X(8) VALUE SPACE. ST1224.2 +010400 02 RE-MARK PIC X(61). ST1224.2 +010500 01 TEST-COMPUTED. ST1224.2 +010600 02 FILLER PIC X(30) VALUE SPACE. ST1224.2 +010700 02 FILLER PIC X(17) VALUE ST1224.2 +010800 " COMPUTED=". ST1224.2 +010900 02 COMPUTED-X. ST1224.2 +011000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1224.2 +011100 03 COMPUTED-N REDEFINES COMPUTED-A ST1224.2 +011200 PIC -9(9).9(9). ST1224.2 +011300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1224.2 +011400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1224.2 +011500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1224.2 +011600 03 CM-18V0 REDEFINES COMPUTED-A. ST1224.2 +011700 04 COMPUTED-18V0 PIC -9(18). ST1224.2 +011800 04 FILLER PIC X. ST1224.2 +011900 03 FILLER PIC X(50) VALUE SPACE. ST1224.2 +012000 01 TEST-CORRECT. ST1224.2 +012100 02 FILLER PIC X(30) VALUE SPACE. ST1224.2 +012200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1224.2 +012300 02 CORRECT-X. ST1224.2 +012400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1224.2 +012500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1224.2 +012600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1224.2 +012700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1224.2 +012800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1224.2 +012900 03 CR-18V0 REDEFINES CORRECT-A. ST1224.2 +013000 04 CORRECT-18V0 PIC -9(18). ST1224.2 +013100 04 FILLER PIC X. ST1224.2 +013200 03 FILLER PIC X(2) VALUE SPACE. ST1224.2 +013300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1224.2 +013400 01 CCVS-C-1. ST1224.2 +013500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1224.2 +013600- "SS PARAGRAPH-NAME ST1224.2 +013700- " REMARKS". ST1224.2 +013800 02 FILLER PIC X(20) VALUE SPACE. ST1224.2 +013900 01 CCVS-C-2. ST1224.2 +014000 02 FILLER PIC X VALUE SPACE. ST1224.2 +014100 02 FILLER PIC X(6) VALUE "TESTED". ST1224.2 +014200 02 FILLER PIC X(15) VALUE SPACE. ST1224.2 +014300 02 FILLER PIC X(4) VALUE "FAIL". ST1224.2 +014400 02 FILLER PIC X(94) VALUE SPACE. ST1224.2 +014500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1224.2 +014600 01 REC-CT PIC 99 VALUE ZERO. ST1224.2 +014700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1224.2 +014800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1224.2 +014900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1224.2 +015000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1224.2 +015100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1224.2 +015200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1224.2 +015300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1224.2 +015400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1224.2 +015500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1224.2 +015600 01 CCVS-H-1. ST1224.2 +015700 02 FILLER PIC X(39) VALUE SPACES. ST1224.2 +015800 02 FILLER PIC X(42) VALUE ST1224.2 +015900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1224.2 +016000 02 FILLER PIC X(39) VALUE SPACES. ST1224.2 +016100 01 CCVS-H-2A. ST1224.2 +016200 02 FILLER PIC X(40) VALUE SPACE. ST1224.2 +016300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1224.2 +016400 02 FILLER PIC XXXX VALUE ST1224.2 +016500 "4.2 ". ST1224.2 +016600 02 FILLER PIC X(28) VALUE ST1224.2 +016700 " COPY - NOT FOR DISTRIBUTION". ST1224.2 +016800 02 FILLER PIC X(41) VALUE SPACE. ST1224.2 +016900 ST1224.2 +017000 01 CCVS-H-2B. ST1224.2 +017100 02 FILLER PIC X(15) VALUE ST1224.2 +017200 "TEST RESULT OF ". ST1224.2 +017300 02 TEST-ID PIC X(9). ST1224.2 +017400 02 FILLER PIC X(4) VALUE ST1224.2 +017500 " IN ". ST1224.2 +017600 02 FILLER PIC X(12) VALUE ST1224.2 +017700 " HIGH ". ST1224.2 +017800 02 FILLER PIC X(22) VALUE ST1224.2 +017900 " LEVEL VALIDATION FOR ". ST1224.2 +018000 02 FILLER PIC X(58) VALUE ST1224.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +018200 01 CCVS-H-3. ST1224.2 +018300 02 FILLER PIC X(34) VALUE ST1224.2 +018400 " FOR OFFICIAL USE ONLY ". ST1224.2 +018500 02 FILLER PIC X(58) VALUE ST1224.2 +018600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1224.2 +018700 02 FILLER PIC X(28) VALUE ST1224.2 +018800 " COPYRIGHT 1985 ". ST1224.2 +018900 01 CCVS-E-1. ST1224.2 +019000 02 FILLER PIC X(52) VALUE SPACE. ST1224.2 +019100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1224.2 +019200 02 ID-AGAIN PIC X(9). ST1224.2 +019300 02 FILLER PIC X(45) VALUE SPACES. ST1224.2 +019400 01 CCVS-E-2. ST1224.2 +019500 02 FILLER PIC X(31) VALUE SPACE. ST1224.2 +019600 02 FILLER PIC X(21) VALUE SPACE. ST1224.2 +019700 02 CCVS-E-2-2. ST1224.2 +019800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1224.2 +019900 03 FILLER PIC X VALUE SPACE. ST1224.2 +020000 03 ENDER-DESC PIC X(44) VALUE ST1224.2 +020100 "ERRORS ENCOUNTERED". ST1224.2 +020200 01 CCVS-E-3. ST1224.2 +020300 02 FILLER PIC X(22) VALUE ST1224.2 +020400 " FOR OFFICIAL USE ONLY". ST1224.2 +020500 02 FILLER PIC X(12) VALUE SPACE. ST1224.2 +020600 02 FILLER PIC X(58) VALUE ST1224.2 +020700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +020800 02 FILLER PIC X(13) VALUE SPACE. ST1224.2 +020900 02 FILLER PIC X(15) VALUE ST1224.2 +021000 " COPYRIGHT 1985". ST1224.2 +021100 01 CCVS-E-4. ST1224.2 +021200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1224.2 +021300 02 FILLER PIC X(4) VALUE " OF ". ST1224.2 +021400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1224.2 +021500 02 FILLER PIC X(40) VALUE ST1224.2 +021600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1224.2 +021700 01 XXINFO. ST1224.2 +021800 02 FILLER PIC X(19) VALUE ST1224.2 +021900 "*** INFORMATION ***". ST1224.2 +022000 02 INFO-TEXT. ST1224.2 +022100 04 FILLER PIC X(8) VALUE SPACE. ST1224.2 +022200 04 XXCOMPUTED PIC X(20). ST1224.2 +022300 04 FILLER PIC X(5) VALUE SPACE. ST1224.2 +022400 04 XXCORRECT PIC X(20). ST1224.2 +022500 02 INF-ANSI-REFERENCE PIC X(48). ST1224.2 +022600 01 HYPHEN-LINE. ST1224.2 +022700 02 FILLER PIC IS X VALUE IS SPACE. ST1224.2 +022800 02 FILLER PIC IS X(65) VALUE IS "************************ST1224.2 +022900- "*****************************************". ST1224.2 +023000 02 FILLER PIC IS X(54) VALUE IS "************************ST1224.2 +023100- "******************************". ST1224.2 +023200 01 CCVS-PGM-ID PIC X(9) VALUE ST1224.2 +023300 "ST122A". ST1224.2 +023400 PROCEDURE DIVISION. ST1224.2 +023500 CCVS1 SECTION. ST1224.2 +023600 OPEN-FILES. ST1224.2 +023700 OPEN OUTPUT PRINT-FILE. ST1224.2 +023800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1224.2 +023900 MOVE SPACE TO TEST-RESULTS. ST1224.2 +024000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1224.2 +024100 GO TO CCVS1-EXIT. ST1224.2 +024200 CLOSE-FILES. ST1224.2 +024300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1224.2 +024400 TERMINATE-CCVS. ST1224.2 +024500S EXIT PROGRAM. ST1224.2 +024600STERMINATE-CALL. ST1224.2 +024700 STOP RUN. ST1224.2 +024800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1224.2 +024900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1224.2 +025000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1224.2 +025100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1224.2 +025200 MOVE "****TEST DELETED****" TO RE-MARK. ST1224.2 +025300 PRINT-DETAIL. ST1224.2 +025400 IF REC-CT NOT EQUAL TO ZERO ST1224.2 +025500 MOVE "." TO PARDOT-X ST1224.2 +025600 MOVE REC-CT TO DOTVALUE. ST1224.2 +025700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1224.2 +025800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1224.2 +025900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1224.2 +026000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1224.2 +026100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1224.2 +026200 MOVE SPACE TO CORRECT-X. ST1224.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1224.2 +026400 MOVE SPACE TO RE-MARK. ST1224.2 +026500 HEAD-ROUTINE. ST1224.2 +026600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +026700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +026800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1224.2 +026900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1224.2 +027000 COLUMN-NAMES-ROUTINE. ST1224.2 +027100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +027200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +027300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +027400 END-ROUTINE. ST1224.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1224.2 +027600 END-RTN-EXIT. ST1224.2 +027700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +027800 END-ROUTINE-1. ST1224.2 +027900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1224.2 +028000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1224.2 +028100 ADD PASS-COUNTER TO ERROR-HOLD. ST1224.2 +028200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1224.2 +028300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1224.2 +028400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1224.2 +028500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1224.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1224.2 +028700 END-ROUTINE-12. ST1224.2 +028800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1224.2 +028900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1224.2 +029000 MOVE "NO " TO ERROR-TOTAL ST1224.2 +029100 ELSE ST1224.2 +029200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1224.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1224.2 +029400 PERFORM WRITE-LINE. ST1224.2 +029500 END-ROUTINE-13. ST1224.2 +029600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1224.2 +029700 MOVE "NO " TO ERROR-TOTAL ELSE ST1224.2 +029800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1224.2 +029900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1224.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030100 IF INSPECT-COUNTER EQUAL TO ZERO ST1224.2 +030200 MOVE "NO " TO ERROR-TOTAL ST1224.2 +030300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1224.2 +030400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1224.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030700 WRITE-LINE. ST1224.2 +030800 ADD 1 TO RECORD-COUNT. ST1224.2 +030900Y IF RECORD-COUNT GREATER 42 ST1224.2 +031000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1224.2 +031100Y MOVE SPACE TO DUMMY-RECORD ST1224.2 +031200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1224.2 +031300Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1224.2 +031400Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1224.2 +031500Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1224.2 +031600Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1224.2 +031700Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +031800Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +031900Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +032000Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1224.2 +032100Y MOVE ZERO TO RECORD-COUNT. ST1224.2 +032200 PERFORM WRT-LN. ST1224.2 +032300 WRT-LN. ST1224.2 +032400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1224.2 +032500 MOVE SPACE TO DUMMY-RECORD. ST1224.2 +032600 BLANK-LINE-PRINT. ST1224.2 +032700 PERFORM WRT-LN. ST1224.2 +032800 FAIL-ROUTINE. ST1224.2 +032900 IF COMPUTED-X NOT EQUAL TO SPACE ST1224.2 +033000 GO TO FAIL-ROUTINE-WRITE. ST1224.2 +033100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1224.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1224.2 +033300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1224.2 +033400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +033500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1224.2 +033600 GO TO FAIL-ROUTINE-EX. ST1224.2 +033700 FAIL-ROUTINE-WRITE. ST1224.2 +033800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1224.2 +033900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1224.2 +034000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1224.2 +034100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1224.2 +034200 FAIL-ROUTINE-EX. EXIT. ST1224.2 +034300 BAIL-OUT. ST1224.2 +034400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1224.2 +034500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1224.2 +034600 BAIL-OUT-WRITE. ST1224.2 +034700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1224.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1224.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1224.2 +035100 BAIL-OUT-EX. EXIT. ST1224.2 +035200 CCVS1-EXIT. ST1224.2 +035300 EXIT. ST1224.2 +035400 ST122A-0001-01. ST1224.2 +035500 OPEN OUTPUT SORTOUT-1I. ST1224.2 +035600 BUILD-LOOP. ST1224.2 +035700 MOVE MEDIUM-WORK TO MEDIUM-RECORD. ST1224.2 +035800 WRITE MEDIUM-RECORD. ST1224.2 +035900 ADD 1 TO UTIL-CTR. ST1224.2 +036000 IF UTIL-CTR GREATER 39 ST1224.2 +036100 GO TO ST122A-0002-01. ST1224.2 +036200 MOVE LONG-WORK TO LONG-RECORD. ST1224.2 +036300 WRITE LONG-RECORD. ST1224.2 +036400 ADD 1 TO UTIL-CTR. ST1224.2 +036500 MOVE SHORT-WORK TO SHORT-RECORD. ST1224.2 +036600 WRITE SHORT-RECORD. ST1224.2 +036700 ADD 1 TO UTIL-CTR. ST1224.2 +036800 GO TO BUILD-LOOP. ST1224.2 +036900 ST122A-0002-01. ST1224.2 +037000 MOVE SPACES TO TEST-RESULTS. ST1224.2 +037100 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1224.2 +037200 PERFORM PRINT-DETAIL. ST1224.2 +037300 MOVE SPACES TO TEST-RESULTS. ST1224.2 +037400 CLOSE SORTOUT-1I. ST1224.2 +037500 CCVS-EXIT SECTION. ST1224.2 +037600 CCVS-999999. ST1224.2 +037700 GO TO CLOSE-FILES. ST1224.2 +*END-OF,ST122A +*HEADER,COBOL,ST122A,SUBPRG,ST123A +000100 IDENTIFICATION DIVISION. ST1234.2 +000200 PROGRAM-ID. ST1234.2 +000300 ST123A. ST1234.2 +000400**************************************************************** ST1234.2 +000500* * ST1234.2 +000600* VALIDATION FOR:- * ST1234.2 +000700* * ST1234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1234.2 +000900* * ST1234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1234.2 +001100* * ST1234.2 +001200**************************************************************** ST1234.2 +001300* * ST1234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1234.2 +001500* * ST1234.2 +001600* X-01 * ST1234.2 +001700* X-02 * ST1234.2 +001800* X-27 * ST1234.2 +001900* X-55 - SYSTEM PRINTER NAME. * ST1234.2 +002000* X-69 * ST1234.2 +002100* X-74 * ST1234.2 +002200* X-75 * ST1234.2 +002300* X-76 * ST1234.2 +002400* X-82 - SOURCE COMPUTER NAME. * ST1234.2 +002500* X-83 - OBJECT COMPUTER NAME. * ST1234.2 +002600* * ST1234.2 +002700**************************************************************** ST1234.2 +002800* * ST1234.2 +002900* PROGRAM ST123A TESTS THE SORTING OF VARIABLE LENGTH * ST1234.2 +003000* RECORDS. THIS PROGRAM CAN BE USED ONLY IF LEVEL 2 OF THE * ST1234.2 +003100* SEQUENTIAL I-O MODULE IS SUPPORTED AS THE * ST1234.2 +003200* "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN THE SD * ST1234.2 +003300* ENTRY. (ST123A WILL BE RUN AS PART OF THE SET ST122A, * ST1234.2 +003400* ST123A, ST124A). * ST1234.2 +003500* * ST1234.2 +003600**************************************************************** ST1234.2 +003700 ENVIRONMENT DIVISION. ST1234.2 +003800 CONFIGURATION SECTION. ST1234.2 +003900 SOURCE-COMPUTER. ST1234.2 +004000 XXXXX082. ST1234.2 +004100 OBJECT-COMPUTER. ST1234.2 +004200 XXXXX083. ST1234.2 +004300 INPUT-OUTPUT SECTION. ST1234.2 +004400 FILE-CONTROL. ST1234.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1234.2 +004600 XXXXX055. ST1234.2 +004700 SELECT SORTIN-1J ASSIGN TO ST1234.2 +004800 XXXXD001. ST1234.2 +004900 SELECT SORTOUT-1J ASSIGN TO ST1234.2 +005000 XXXXP002. ST1234.2 +005100 SELECT SORTFILE-1J ASSIGN TO ST1234.2 +005200 XXXXX027. ST1234.2 +005300 DATA DIVISION. ST1234.2 +005400 FILE SECTION. ST1234.2 +005500 FD PRINT-FILE. ST1234.2 +005600 01 PRINT-REC PICTURE X(120). ST1234.2 +005700 01 DUMMY-RECORD PICTURE X(120). ST1234.2 +005800 FD SORTIN-1J ST1234.2 +005900 LABEL RECORDS STANDARD ST1234.2 +006000C VALUE OF ST1234.2 +006100C XXXXX074 ST1234.2 +006200C IS ST1234.2 +006300C XXXXX075 ST1234.2 +006400G XXXXX069 ST1234.2 +006500 RECORD IS VARYING IN SIZE ST1234.2 +006600 DATA RECORDS ARE SHORT-IN ST1234.2 +006700 MEDIUM-IN ST1234.2 +006800 LONG-IN. ST1234.2 +006900 01 SHORT-IN PICTURE X(50). ST1234.2 +007000 01 MEDIUM-IN PICTURE X(75). ST1234.2 +007100 01 LONG-IN. ST1234.2 +007200 02 FALSE-LENGTH-1 PICTURE X(25). ST1234.2 +007300 02 FALSE-LENGTH-2 PICTURE A(20). ST1234.2 +007400 02 FALSE-LENGTH-3 PICTURE 9(15). ST1234.2 +007500 02 FALSE-LENGTH-4 PICTURE X(40). ST1234.2 +007600 FD SORTOUT-1J ST1234.2 +007700 LABEL RECORDS ARE STANDARD ST1234.2 +007800C VALUE OF ST1234.2 +007900C XXXXX074 ST1234.2 +008000C IS ST1234.2 +008100C XXXXX076 ST1234.2 +008200G XXXXX069 ST1234.2 +008300 RECORD IS VARYING IN SIZE ST1234.2 +008400 DATA RECORD SHORT-OUT ST1234.2 +008500 MEDIUM-OUT ST1234.2 +008600 LONG-OUT. ST1234.2 +008700 01 SHORT-OUT. ST1234.2 +008800 02 FAKE-LENGTH-1 PICTURE X(10). ST1234.2 +008900 02 FAKE-LENGTH-2 PICTURE A(10). ST1234.2 +009000 02 FAKE-LENGTH-3 PICTURE 9(10). ST1234.2 +009100 02 FAKE-LENGTH-4 PICTURE X(20). ST1234.2 +009200 01 MEDIUM-OUT PICTURE X(75). ST1234.2 +009300 01 LONG-OUT PICTURE X(100). ST1234.2 +009400 SD SORTFILE-1J ST1234.2 +009500 RECORD IS VARYING IN SIZE ST1234.2 +009600 DATA RECORD SHORT-SORT ST1234.2 +009700 MEDIUM-SORT ST1234.2 +009800 LONG-SORT. ST1234.2 +009900 01 SHORT-SORT. ST1234.2 +010000 02 SHORT-NON-KEY PICTURE XX. ST1234.2 +010100 02 SHORT-KEY-1 PICTURE X(10). ST1234.2 +010200 02 SHORT-KEY-2 PICTURE X(38). ST1234.2 +010300 01 MEDIUM-SORT. ST1234.2 +010400 02 MEDIUM-NON-KEY PICTURE XX. ST1234.2 +010500 02 MEDIUM-KEY-1 PICTURE X(10). ST1234.2 +010600 02 MEDIUM-KEY-2 PICTURE X(38). ST1234.2 +010700 02 MEDIUM-FILLER PICTURE X(25). ST1234.2 +010800 01 LONG-SORT. ST1234.2 +010900 02 LONG-NON-KEY PICTURE XX. ST1234.2 +011000 02 LONG-KEY-1 PICTURE X(10). ST1234.2 +011100 02 LONG-KEY-2 PICTURE X(38). ST1234.2 +011200 02 LONG-FILLER PICTURE X(50). ST1234.2 +011300 PROCEDURE DIVISION. ST1234.2 +011400 SORT-PARAGRAPH. ST1234.2 +011500 SORT SORTFILE-1J ST1234.2 +011600 DESCENDING KEY ST1234.2 +011700 MEDIUM-KEY-1 ST1234.2 +011800 MEDIUM-KEY-2 ST1234.2 +011900 USING SORTIN-1J ST1234.2 +012000 GIVING SORTOUT-1J. ST1234.2 +012100 STOP RUN. ST1234.2 +*END-OF,ST123A +*HEADER,COBOL,ST122A,SUBPRG,ST124A +000100 IDENTIFICATION DIVISION. ST1244.2 +000200 PROGRAM-ID. ST1244.2 +000300 ST124A. ST1244.2 +000400**************************************************************** ST1244.2 +000500* * ST1244.2 +000600* VALIDATION FOR:- * ST1244.2 +000700* * ST1244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +000900* * ST1244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1244.2 +001100* * ST1244.2 +001200**************************************************************** ST1244.2 +001300* * ST1244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1244.2 +001500* * ST1244.2 +001600* X-02 ST1244.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1244.2 +001800* X-69 * ST1244.2 +001900* X-74 * ST1244.2 +002000* X-76 * ST1244.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1244.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1244.2 +002300* * ST1244.2 +002400**************************************************************** ST1244.2 +002500* * ST1244.2 +002600* PROGRAM ST124A TESTS THE CONTENTS OF THE FILE PRODUCED BY * ST1244.2 +002700* ST123A. PROGRAMS ST122A, ST123A AND ST124A WILL BE USED * ST1244.2 +002800* ONLY IF LEVEL 2 OF THE SEQUENTIAL I-O MODULE IS SUPPORTED * ST1244.2 +002900* AS THE "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN * ST1244.2 +003000* ST123A. * ST1244.2 +003100* * ST1244.2 +003200**************************************************************** ST1244.2 +003300* ST124A CHECKS THE OUTPUT FROM ST123A, WHICH IN TURN USED ST1244.2 +003400* INPUT FROM ST122A. ST1244.2 +003500* 40 VARIABLE-LENGTH RECORDS HAVE BEEN SORTED ST1244.2 +003600* SORTED AND SHOULD APPEAR AS SHOWN ST1244.2 +003700* NON-KEY KEY-1 KEY-2 FILLER ST1244.2 +003800* X(2) X(10) X(38) ST1244.2 +003900* ST1244.2 +004000* FIRST 13 RECORDS --- ST1244.2 +004100* "CC""LOWEST TWO""MIDDLE TWO-SECOND" X(50) VALUE QUOTEST1244.2 +004200* NEXT 14 RECORDS --- ST1244.2 +004300* "BB""LOWEST TWO""MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1244.2 +004400* LAST 13 RECORDS --- ST1244.2 +004500* "AA""LOWEST ONE""MIDDLE ONE-ONLY" (NONE) ST1244.2 +004600* ST1244.2 +004700 ENVIRONMENT DIVISION. ST1244.2 +004800 CONFIGURATION SECTION. ST1244.2 +004900 SOURCE-COMPUTER. ST1244.2 +005000 XXXXX082. ST1244.2 +005100 OBJECT-COMPUTER. ST1244.2 +005200 XXXXX083. ST1244.2 +005300 INPUT-OUTPUT SECTION. ST1244.2 +005400 FILE-CONTROL. ST1244.2 +005500 SELECT PRINT-FILE ASSIGN TO ST1244.2 +005600 XXXXX055. ST1244.2 +005700 SELECT SORTIN-1K ASSIGN TO ST1244.2 +005800 XXXXP002. ST1244.2 +005900 DATA DIVISION. ST1244.2 +006000 FILE SECTION. ST1244.2 +006100 FD PRINT-FILE. ST1244.2 +006200 01 PRINT-REC PICTURE X(120). ST1244.2 +006300 01 DUMMY-RECORD PICTURE X(120). ST1244.2 +006400 FD SORTIN-1K ST1244.2 +006500 LABEL RECORDS STANDARD ST1244.2 +006600C VALUE OF ST1244.2 +006700C XXXXX074 ST1244.2 +006800C IS ST1244.2 +006900C XXXXX076 ST1244.2 +007000G XXXXX069 ST1244.2 +007100 RECORD IS VARYING IN SIZE FROM 50 TO 100 CHARACTERS ST1244.2 +007200 DATA RECORDS ARE SHORT-RECORD ST1244.2 +007300 MEDIUM-RECORD ST1244.2 +007400 LONG-RECORD. ST1244.2 +007500 01 SHORT-RECORD PICTURE X(50). ST1244.2 +007600 01 MEDIUM-RECORD PICTURE X(75). ST1244.2 +007700 01 LONG-RECORD PICTURE X(100). ST1244.2 +007800 WORKING-STORAGE SECTION. ST1244.2 +007900 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1244.2 +008000 01 SHORT-WORK. ST1244.2 +008100 02 FILLER PICTURE XX VALUE "AA". ST1244.2 +008200 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1244.2 +008300 02 FILLER PICTURE X(38) ST1244.2 +008400 VALUE "MIDDLE ONE-ONLY ". ST1244.2 +008500 01 MEDIUM-WORK. ST1244.2 +008600 02 FILLER PICTURE XX VALUE "BB". ST1244.2 +008700 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1244.2 +008800 02 FILLER PICTURE X(38) ST1244.2 +008900 VALUE "MIDDLE TWO-FIRST ". ST1244.2 +009000 02 FILLER PICTURE X(25) VALUE ZERO. ST1244.2 +009100 01 LONG-WORK. ST1244.2 +009200 02 FILLER PICTURE XX VALUE "CC". ST1244.2 +009300 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1244.2 +009400 02 FILLER PICTURE X(38) ST1244.2 +009500 VALUE "MIDDLE TWO-SECOND ". ST1244.2 +009600 02 FILLER PICTURE X(50) VALUE QUOTE. ST1244.2 +009700 01 BREAKDOWN-LIMIT PICTURE 999. ST1244.2 +009800 01 COMPUTED-BREAKDOWN. ST1244.2 +009900 02 FIRST-20-CM PICTURE X(20). ST1244.2 +010000 02 SECOND-20-CM PICTURE X(20). ST1244.2 +010100 02 THIRD-20-CM PICTURE X(20). ST1244.2 +010200 02 FOURTH-20-CM PICTURE X(20). ST1244.2 +010300 02 FIFTH-20-CM PICTURE X(20). ST1244.2 +010400 01 CORRECT-BREAKDOWN. ST1244.2 +010500 02 FIRST-20-CR PICTURE X(20). ST1244.2 +010600 02 SECOND-20-CR PICTURE X(20). ST1244.2 +010700 02 THIRD-20-CR PICTURE X(20). ST1244.2 +010800 02 FOURTH-20-CR PICTURE X(20). ST1244.2 +010900 02 FIFTH-20-CR PICTURE X(20). ST1244.2 +011000 01 TEST-RESULTS. ST1244.2 +011100 02 FILLER PIC X VALUE SPACE. ST1244.2 +011200 02 FEATURE PIC X(20) VALUE SPACE. ST1244.2 +011300 02 FILLER PIC X VALUE SPACE. ST1244.2 +011400 02 P-OR-F PIC X(5) VALUE SPACE. ST1244.2 +011500 02 FILLER PIC X VALUE SPACE. ST1244.2 +011600 02 PAR-NAME. ST1244.2 +011700 03 FILLER PIC X(19) VALUE SPACE. ST1244.2 +011800 03 PARDOT-X PIC X VALUE SPACE. ST1244.2 +011900 03 DOTVALUE PIC 99 VALUE ZERO. ST1244.2 +012000 02 FILLER PIC X(8) VALUE SPACE. ST1244.2 +012100 02 RE-MARK PIC X(61). ST1244.2 +012200 01 TEST-COMPUTED. ST1244.2 +012300 02 FILLER PIC X(30) VALUE SPACE. ST1244.2 +012400 02 FILLER PIC X(17) VALUE ST1244.2 +012500 " COMPUTED=". ST1244.2 +012600 02 COMPUTED-X. ST1244.2 +012700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1244.2 +012800 03 COMPUTED-N REDEFINES COMPUTED-A ST1244.2 +012900 PIC -9(9).9(9). ST1244.2 +013000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1244.2 +013100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1244.2 +013200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1244.2 +013300 03 CM-18V0 REDEFINES COMPUTED-A. ST1244.2 +013400 04 COMPUTED-18V0 PIC -9(18). ST1244.2 +013500 04 FILLER PIC X. ST1244.2 +013600 03 FILLER PIC X(50) VALUE SPACE. ST1244.2 +013700 01 TEST-CORRECT. ST1244.2 +013800 02 FILLER PIC X(30) VALUE SPACE. ST1244.2 +013900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1244.2 +014000 02 CORRECT-X. ST1244.2 +014100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1244.2 +014200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1244.2 +014300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1244.2 +014400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1244.2 +014500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1244.2 +014600 03 CR-18V0 REDEFINES CORRECT-A. ST1244.2 +014700 04 CORRECT-18V0 PIC -9(18). ST1244.2 +014800 04 FILLER PIC X. ST1244.2 +014900 03 FILLER PIC X(2) VALUE SPACE. ST1244.2 +015000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1244.2 +015100 01 CCVS-C-1. ST1244.2 +015200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1244.2 +015300- "SS PARAGRAPH-NAME ST1244.2 +015400- " REMARKS". ST1244.2 +015500 02 FILLER PIC X(20) VALUE SPACE. ST1244.2 +015600 01 CCVS-C-2. ST1244.2 +015700 02 FILLER PIC X VALUE SPACE. ST1244.2 +015800 02 FILLER PIC X(6) VALUE "TESTED". ST1244.2 +015900 02 FILLER PIC X(15) VALUE SPACE. ST1244.2 +016000 02 FILLER PIC X(4) VALUE "FAIL". ST1244.2 +016100 02 FILLER PIC X(94) VALUE SPACE. ST1244.2 +016200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1244.2 +016300 01 REC-CT PIC 99 VALUE ZERO. ST1244.2 +016400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1244.2 +016900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1244.2 +017000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1244.2 +017100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1244.2 +017200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1244.2 +017300 01 CCVS-H-1. ST1244.2 +017400 02 FILLER PIC X(39) VALUE SPACES. ST1244.2 +017500 02 FILLER PIC X(42) VALUE ST1244.2 +017600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1244.2 +017700 02 FILLER PIC X(39) VALUE SPACES. ST1244.2 +017800 01 CCVS-H-2A. ST1244.2 +017900 02 FILLER PIC X(40) VALUE SPACE. ST1244.2 +018000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1244.2 +018100 02 FILLER PIC XXXX VALUE ST1244.2 +018200 "4.2 ". ST1244.2 +018300 02 FILLER PIC X(28) VALUE ST1244.2 +018400 " COPY - NOT FOR DISTRIBUTION". ST1244.2 +018500 02 FILLER PIC X(41) VALUE SPACE. ST1244.2 +018600 ST1244.2 +018700 01 CCVS-H-2B. ST1244.2 +018800 02 FILLER PIC X(15) VALUE ST1244.2 +018900 "TEST RESULT OF ". ST1244.2 +019000 02 TEST-ID PIC X(9). ST1244.2 +019100 02 FILLER PIC X(4) VALUE ST1244.2 +019200 " IN ". ST1244.2 +019300 02 FILLER PIC X(12) VALUE ST1244.2 +019400 " HIGH ". ST1244.2 +019500 02 FILLER PIC X(22) VALUE ST1244.2 +019600 " LEVEL VALIDATION FOR ". ST1244.2 +019700 02 FILLER PIC X(58) VALUE ST1244.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +019900 01 CCVS-H-3. ST1244.2 +020000 02 FILLER PIC X(34) VALUE ST1244.2 +020100 " FOR OFFICIAL USE ONLY ". ST1244.2 +020200 02 FILLER PIC X(58) VALUE ST1244.2 +020300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1244.2 +020400 02 FILLER PIC X(28) VALUE ST1244.2 +020500 " COPYRIGHT 1985 ". ST1244.2 +020600 01 CCVS-E-1. ST1244.2 +020700 02 FILLER PIC X(52) VALUE SPACE. ST1244.2 +020800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1244.2 +020900 02 ID-AGAIN PIC X(9). ST1244.2 +021000 02 FILLER PIC X(45) VALUE SPACES. ST1244.2 +021100 01 CCVS-E-2. ST1244.2 +021200 02 FILLER PIC X(31) VALUE SPACE. ST1244.2 +021300 02 FILLER PIC X(21) VALUE SPACE. ST1244.2 +021400 02 CCVS-E-2-2. ST1244.2 +021500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1244.2 +021600 03 FILLER PIC X VALUE SPACE. ST1244.2 +021700 03 ENDER-DESC PIC X(44) VALUE ST1244.2 +021800 "ERRORS ENCOUNTERED". ST1244.2 +021900 01 CCVS-E-3. ST1244.2 +022000 02 FILLER PIC X(22) VALUE ST1244.2 +022100 " FOR OFFICIAL USE ONLY". ST1244.2 +022200 02 FILLER PIC X(12) VALUE SPACE. ST1244.2 +022300 02 FILLER PIC X(58) VALUE ST1244.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +022500 02 FILLER PIC X(13) VALUE SPACE. ST1244.2 +022600 02 FILLER PIC X(15) VALUE ST1244.2 +022700 " COPYRIGHT 1985". ST1244.2 +022800 01 CCVS-E-4. ST1244.2 +022900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1244.2 +023000 02 FILLER PIC X(4) VALUE " OF ". ST1244.2 +023100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1244.2 +023200 02 FILLER PIC X(40) VALUE ST1244.2 +023300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1244.2 +023400 01 XXINFO. ST1244.2 +023500 02 FILLER PIC X(19) VALUE ST1244.2 +023600 "*** INFORMATION ***". ST1244.2 +023700 02 INFO-TEXT. ST1244.2 +023800 04 FILLER PIC X(8) VALUE SPACE. ST1244.2 +023900 04 XXCOMPUTED PIC X(20). ST1244.2 +024000 04 FILLER PIC X(5) VALUE SPACE. ST1244.2 +024100 04 XXCORRECT PIC X(20). ST1244.2 +024200 02 INF-ANSI-REFERENCE PIC X(48). ST1244.2 +024300 01 HYPHEN-LINE. ST1244.2 +024400 02 FILLER PIC IS X VALUE IS SPACE. ST1244.2 +024500 02 FILLER PIC IS X(65) VALUE IS "************************ST1244.2 +024600- "*****************************************". ST1244.2 +024700 02 FILLER PIC IS X(54) VALUE IS "************************ST1244.2 +024800- "******************************". ST1244.2 +024900 01 CCVS-PGM-ID PIC X(9) VALUE ST1244.2 +025000 "ST124A". ST1244.2 +025100 PROCEDURE DIVISION. ST1244.2 +025200 CCVS1 SECTION. ST1244.2 +025300 OPEN-FILES. ST1244.2 +025400 OPEN OUTPUT PRINT-FILE. ST1244.2 +025500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1244.2 +025600 MOVE SPACE TO TEST-RESULTS. ST1244.2 +025700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1244.2 +025800 GO TO CCVS1-EXIT. ST1244.2 +025900 CLOSE-FILES. ST1244.2 +026000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1244.2 +026100 TERMINATE-CCVS. ST1244.2 +026200S EXIT PROGRAM. ST1244.2 +026300STERMINATE-CALL. ST1244.2 +026400 STOP RUN. ST1244.2 +026500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1244.2 +026600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1244.2 +026700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1244.2 +026800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1244.2 +026900 MOVE "****TEST DELETED****" TO RE-MARK. ST1244.2 +027000 PRINT-DETAIL. ST1244.2 +027100 IF REC-CT NOT EQUAL TO ZERO ST1244.2 +027200 MOVE "." TO PARDOT-X ST1244.2 +027300 MOVE REC-CT TO DOTVALUE. ST1244.2 +027400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1244.2 +027500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1244.2 +027600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1244.2 +027700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1244.2 +027800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1244.2 +027900 MOVE SPACE TO CORRECT-X. ST1244.2 +028000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1244.2 +028100 MOVE SPACE TO RE-MARK. ST1244.2 +028200 HEAD-ROUTINE. ST1244.2 +028300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +028400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +028500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1244.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1244.2 +028700 COLUMN-NAMES-ROUTINE. ST1244.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +029100 END-ROUTINE. ST1244.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1244.2 +029300 END-RTN-EXIT. ST1244.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +029500 END-ROUTINE-1. ST1244.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1244.2 +029700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1244.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. ST1244.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1244.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1244.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1244.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1244.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1244.2 +030400 END-ROUTINE-12. ST1244.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1244.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1244.2 +030700 MOVE "NO " TO ERROR-TOTAL ST1244.2 +030800 ELSE ST1244.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1244.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1244.2 +031100 PERFORM WRITE-LINE. ST1244.2 +031200 END-ROUTINE-13. ST1244.2 +031300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1244.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE ST1244.2 +031500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1244.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1244.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO ST1244.2 +031900 MOVE "NO " TO ERROR-TOTAL ST1244.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1244.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1244.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +032400 WRITE-LINE. ST1244.2 +032500 ADD 1 TO RECORD-COUNT. ST1244.2 +032600Y IF RECORD-COUNT GREATER 42 ST1244.2 +032700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1244.2 +032800Y MOVE SPACE TO DUMMY-RECORD ST1244.2 +032900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1244.2 +033000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1244.2 +033100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1244.2 +033200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1244.2 +033300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1244.2 +033400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033700Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1244.2 +033800Y MOVE ZERO TO RECORD-COUNT. ST1244.2 +033900 PERFORM WRT-LN. ST1244.2 +034000 WRT-LN. ST1244.2 +034100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1244.2 +034200 MOVE SPACE TO DUMMY-RECORD. ST1244.2 +034300 BLANK-LINE-PRINT. ST1244.2 +034400 PERFORM WRT-LN. ST1244.2 +034500 FAIL-ROUTINE. ST1244.2 +034600 IF COMPUTED-X NOT EQUAL TO SPACE ST1244.2 +034700 GO TO FAIL-ROUTINE-WRITE. ST1244.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1244.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1244.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1244.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1244.2 +035300 GO TO FAIL-ROUTINE-EX. ST1244.2 +035400 FAIL-ROUTINE-WRITE. ST1244.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1244.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1244.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1244.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1244.2 +035900 FAIL-ROUTINE-EX. EXIT. ST1244.2 +036000 BAIL-OUT. ST1244.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1244.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1244.2 +036300 BAIL-OUT-WRITE. ST1244.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1244.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1244.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1244.2 +036800 BAIL-OUT-EX. EXIT. ST1244.2 +036900 CCVS1-EXIT. ST1244.2 +037000 EXIT. ST1244.2 +037100 SECT-ST111-0001 SECTION. ST1244.2 +037200 ST124A-0001-01. ST1244.2 +037300 OPEN INPUT SORTIN-1K. ST1244.2 +037400 MOVE " ***** ST123A DOES NOT PRODUCE A PRINTED REPORT ST1244.2 +037500- "*****" TO TEST-RESULTS. ST1244.2 +037600 PERFORM PRINT-DETAIL. ST1244.2 +037700 MOVE SPACE TO TEST-RESULTS. ST1244.2 +037800 PERFORM END-ROUTINE. ST1244.2 +037900 MOVE "SORT VARIABLE RECORD" TO FEATURE. ST1244.2 +038000 SORT-TEST-1. ST1244.2 +038100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1244.2 +038200 PERFORM READ-SORTIN. ST1244.2 +038300 IF LONG-RECORD EQUAL TO LONG-WORK ST1244.2 +038400 PERFORM PASS GO TO SORT-WRITE-1. ST1244.2 +038500* NOTE FIRST RECORD. ST1244.2 +038600 SORT-FAIL-1. ST1244.2 +038700 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +038800 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +038900 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1244.2 +039000 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +039100 SORT-WRITE-1. ST1244.2 +039200 PERFORM PRINT-DETAIL. ST1244.2 +039300 SORT-TEST-2. ST1244.2 +039400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1244.2 +039500 PERFORM READ-SORTIN 12 TIMES. ST1244.2 +039600 IF LONG-RECORD EQUAL TO LONG-WORK ST1244.2 +039700 PERFORM PASS GO TO SORT-WRITE-2. ST1244.2 +039800* NOTE THIRTEENTH RECORD. ST1244.2 +039900 SORT-FAIL-2. ST1244.2 +040000 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +040100 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +040200 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1244.2 +040300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +040400 SORT-WRITE-2. ST1244.2 +040500 PERFORM PRINT-DETAIL. ST1244.2 +040600 SORT-TEST-3. ST1244.2 +040700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1244.2 +040800 PERFORM READ-SORTIN. ST1244.2 +040900 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1244.2 +041000 PERFORM PASS GO TO SORT-WRITE-3. ST1244.2 +041100* NOTE FOURTEENTH RECORD. ST1244.2 +041200 SORT-FAIL-3. ST1244.2 +041300 MOVE 75 TO BREAKDOWN-LIMIT. ST1244.2 +041400 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +041500 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1244.2 +041600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +041700 SORT-WRITE-3. ST1244.2 +041800 PERFORM PRINT-DETAIL. ST1244.2 +041900 SORT-TEST-4. ST1244.2 +042000 MOVE "SORT-TEST-4" TO PAR-NAME. ST1244.2 +042100 PERFORM READ-SORTIN 13 TIMES. ST1244.2 +042200 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1244.2 +042300 PERFORM PASS GO TO SORT-WRITE-4. ST1244.2 +042400* NOTE TWENTY-SEVENTH RECORD. ST1244.2 +042500 SORT-FAIL-4. ST1244.2 +042600 MOVE 75 TO BREAKDOWN-LIMIT. ST1244.2 +042700 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +042800 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1244.2 +042900 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +043000 SORT-WRITE-4. ST1244.2 +043100 PERFORM PRINT-DETAIL. ST1244.2 +043200 SORT-TEST-5. ST1244.2 +043300 MOVE "SORT-TEST-5" TO PAR-NAME. ST1244.2 +043400 PERFORM READ-SORTIN. ST1244.2 +043500 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1244.2 +043600 PERFORM PASS GO TO SORT-WRITE-5. ST1244.2 +043700* NOTE TWENTY-EIGHTH RECORD. ST1244.2 +043800 SORT-FAIL-5. ST1244.2 +043900 MOVE 50 TO BREAKDOWN-LIMIT. ST1244.2 +044000 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +044100 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1244.2 +044200 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +044300 SORT-WRITE-5. ST1244.2 +044400 PERFORM PRINT-DETAIL. ST1244.2 +044500 SORT-TEST-6. ST1244.2 +044600 MOVE "SORT-TEST-6" TO PAR-NAME. ST1244.2 +044700 PERFORM READ-SORTIN 12 TIMES. ST1244.2 +044800 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1244.2 +044900 PERFORM PASS GO TO SORT-WRITE-6. ST1244.2 +045000* NOTE FORTIETH RECORD. ST1244.2 +045100 SORT-FAIL-6. ST1244.2 +045200 MOVE 50 TO BREAKDOWN-LIMIT. ST1244.2 +045300 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +045400 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1244.2 +045500 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +045600 SORT-WRITE-6. ST1244.2 +045700 PERFORM PRINT-DETAIL. ST1244.2 +045800 SORT-TEST-7. ST1244.2 +045900 MOVE "SORT-TEST-7" TO PAR-NAME. ST1244.2 +046000 READ SORTIN-1K AT END ST1244.2 +046100 PERFORM PASS GO TO SORT-WRITE-7. ST1244.2 +046200 SORT-FAIL-7. ST1244.2 +046300 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +046400 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +046500 MOVE SPACE TO CORRECT-BREAKDOWN. ST1244.2 +046600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +046700 PERFORM PRINT-DETAIL. ST1244.2 +046800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1244.2 +046900 SORT-WRITE-7. ST1244.2 +047000 PERFORM PRINT-DETAIL. ST1244.2 +047100 CLOSE SORTIN-1K. ST1244.2 +047200 GO TO CCVS-EXIT. ST1244.2 +047300 BREAKDOWN-PARA. ST1244.2 +047400 PERFORM FAIL. ST1244.2 +047500 MOVE FIRST-20-CM TO COMPUTED-A. ST1244.2 +047600 MOVE FIRST-20-CR TO CORRECT-A. ST1244.2 +047700 MOVE "FIRST TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +047800 PERFORM PRINT-DETAIL. ST1244.2 +047900 MOVE SECOND-20-CM TO COMPUTED-A. ST1244.2 +048000 MOVE SECOND-20-CR TO CORRECT-A. ST1244.2 +048100 MOVE "SECOND TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +048200 PERFORM PRINT-DETAIL. ST1244.2 +048300 MOVE THIRD-20-CM TO COMPUTED-A. ST1244.2 +048400 MOVE THIRD-20-CR TO CORRECT-A. ST1244.2 +048500 MOVE "THIRD TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +048600 PERFORM PRINT-DETAIL. ST1244.2 +048700 IF BREAKDOWN-LIMIT LESS THAN 61 GO TO BREAKDOWN-EXIT. ST1244.2 +048800 MOVE FOURTH-20-CM TO COMPUTED-A. ST1244.2 +048900 MOVE FOURTH-20-CR TO CORRECT-A. ST1244.2 +049000 MOVE "FOURTH TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +049100 PERFORM PRINT-DETAIL. ST1244.2 +049200 IF BREAKDOWN-LIMIT LESS THAN 81 GO TO BREAKDOWN-EXIT. ST1244.2 +049300 MOVE FIFTH-20-CM TO COMPUTED-A. ST1244.2 +049400 MOVE FIFTH-20-CR TO CORRECT-A. ST1244.2 +049500 MOVE "FIFTH TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +049600 BREAKDOWN-EXIT. ST1244.2 +049700 EXIT. ST1244.2 +049800 READ-SORTIN. ST1244.2 +049900 READ SORTIN-1K AT END GO TO READ-ERROR. ST1244.2 +050000 ADD 1 TO UTIL-CTR. ST1244.2 +050100 READ-ERROR. ST1244.2 +050200 MOVE UTIL-CTR TO COMPUTED-N. ST1244.2 +050300 MOVE 40 TO CORRECT-N. ST1244.2 +050400 MOVE "TOO FEW INPUT RECORDS" TO RE-MARK. ST1244.2 +050500 MOVE "READ-SORTIN" TO PAR-NAME. ST1244.2 +050600 PERFORM FAIL. ST1244.2 +050700 PERFORM PRINT-DETAIL. ST1244.2 +050800 CCVS-EXIT SECTION. ST1244.2 +050900 CCVS-999999. ST1244.2 +051000 GO TO CLOSE-FILES. ST1244.2 +*END-OF,ST124A TES05680 +*HEADER,COBOL,ST125A +000100 IDENTIFICATION DIVISION. ST1254.2 +000200 PROGRAM-ID. ST1254.2 +000300 ST125A. ST1254.2 +000400**************************************************************** ST1254.2 +000500* * ST1254.2 +000600* VALIDATION FOR:- * ST1254.2 +000700* * ST1254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +000900* * ST1254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1254.2 +001100* * ST1254.2 +001200**************************************************************** ST1254.2 +001300* * ST1254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1254.2 +001500* * ST1254.2 +001600* X-01 * ST1254.2 +001700* X-02 * ST1254.2 +001800* X-03 * ST1254.2 +001900* X-27 * ST1254.2 +002000* X-55 - SYSTEM PRINTER NAME. * ST1254.2 +002100* X-69 * ST1254.2 +002200* X-74 * ST1254.2 +002300* X-75 * ST1254.2 +002400* X-82 - SOURCE COMPUTER NAME. * ST1254.2 +002500* X-83 - OBJECT COMPUTER NAME. * ST1254.2 +002600* * ST1254.2 +002700**************************************************************** ST1254.2 +002800* ST1254.2 +002900* THIS PROGRAM TESTS THE FACILITY OF MULTIPLE FILES IN THE ST1254.2 +003000* "GIVING" PHRASE OF THE "SORT" STATEMENT. ST1254.2 +003100* THE CONTENT OF THE 3 OUTPUT FILES WILL BE VERIFIED IN ST1254.2 +003200* PROGRAM ST126A. ST1254.2 +003300* THIS PROGRAM BUILDS A FILE OF NINE RECORDS. EACH RECORD HAS ST1254.2 +003400* THREE KEYS, AND THE VALUES OF THE RECORDS ARE SHOWN BELOW- ST1254.2 +003500* S ST1254.2 +003600* O ST1254.2 +003700* R SORT ST1254.2 +003800* T SORT KEY ST1254.2 +003900* K KEY -2 ST1254.2 +004000* E -1 .. ST1254.2 +004100* Y .. . . ST1254.2 +004200* - . . . . ST1254.2 +004300* 3 . . . . ST1254.2 +004400* .. .. . ST1254.2 +004500* 11111112888888888888888888 ST1254.2 +004600* 11111112999999999999999999 ST1254.2 +004700* 11111112999999999999999999 ST1254.2 +004800* 00000001999999999999999999 ST1254.2 +004900* 000000001999999999999999999 ST1254.2 +005000* 000000001999999999999999999 ST1254.2 +005100* 000000001999999999999999999 ST1254.2 +005200* 000000001999999999999999999 ST1254.2 +005300* 000000001999999999999999999 ST1254.2 +005400* THERE IS AN ASSUMED DECIMAL POINT BETWEEN THE FIRST AND ST1254.2 +005500* SECOND COLUMNS OF SORTKEY-1. ST1254.2 +005600* ST1254.2 +005700 ENVIRONMENT DIVISION. ST1254.2 +005800 CONFIGURATION SECTION. ST1254.2 +005900 SOURCE-COMPUTER. ST1254.2 +006000 XXXXX082. ST1254.2 +006100 OBJECT-COMPUTER. ST1254.2 +006200 XXXXX083. ST1254.2 +006300 INPUT-OUTPUT SECTION. ST1254.2 +006400 FILE-CONTROL. ST1254.2 +006500 SELECT PRINT-FILE ASSIGN TO ST1254.2 +006600 XXXXX055. ST1254.2 +006700 SELECT SORTFILE-1F ASSIGN TO ST1254.2 +006800 XXXXX027. ST1254.2 +006900 SELECT SORTOUT-1F ASSIGN TO ST1254.2 +007000 XXXXP001. ST1254.2 +007100 SELECT SORTOUT-2F ASSIGN TO ST1254.2 +007200 XXXXP002. ST1254.2 +007300 SELECT SORTOUT-3F ASSIGN TO ST1254.2 +007400 XXXXP003. ST1254.2 +007500 DATA DIVISION. ST1254.2 +007600 FILE SECTION. ST1254.2 +007700 FD PRINT-FILE. ST1254.2 +007800 01 PRINT-REC PICTURE X(120). ST1254.2 +007900 01 DUMMY-RECORD PICTURE X(120). ST1254.2 +008000 FD SORTOUT-1F ST1254.2 +008100 LABEL RECORDS STANDARD ST1254.2 +008200C VALUE OF ST1254.2 +008300C XXXXX074 ST1254.2 +008400C IS ST1254.2 +008500C XXXXX075 ST1254.2 +008600G XXXXX069 ST1254.2 +008700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +008800 01 SORTOUT-REC-1. ST1254.2 +008900 02 FILLER PICTURE X(27). ST1254.2 +009000 FD SORTOUT-2F ST1254.2 +009100 LABEL RECORDS STANDARD ST1254.2 +009200C VALUE OF ST1254.2 +009300C XXXXX074 ST1254.2 +009400C IS ST1254.2 +009500C XXXXX075 ST1254.2 +009600G XXXXX069 ST1254.2 +009700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +009800 01 SORTOUT-REC-2. ST1254.2 +009900 02 FILLER PICTURE X(27). ST1254.2 +010000 FD SORTOUT-3F ST1254.2 +010100 LABEL RECORDS STANDARD ST1254.2 +010200C VALUE OF ST1254.2 +010300C XXXXX074 ST1254.2 +010400C IS ST1254.2 +010500C XXXXX075 ST1254.2 +010600G XXXXX069 ST1254.2 +010700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +010800 01 SORTOUT-REC-3. ST1254.2 +010900 02 FILLER PICTURE X(27). ST1254.2 +011000 SD SORTFILE-1F ST1254.2 +011100 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +011200 01 SORT-GROUP. ST1254.2 +011300 02 SORTKEY-3 PICTURE X. ST1254.2 +011400 02 SORTKEY-1 PICTURE S9V9(7). ST1254.2 +011500 02 SORTKEY-2 PICTURE 9(18). ST1254.2 +011600 WORKING-STORAGE SECTION. ST1254.2 +011700 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1254.2 +011800 77 UTILITY-1 PICTURE S9V9(7) VALUE +1.1111112. ST1254.2 +011900 77 UTILITY-2 PICTURE 9(018) VALUE 888888888888888888. ST1254.2 +012000 77 UTILITY-3 PICTURE X VALUE SPACE. ST1254.2 +012100 01 TEST-RESULTS. ST1254.2 +012200 02 FILLER PIC X VALUE SPACE. ST1254.2 +012300 02 FEATURE PIC X(20) VALUE SPACE. ST1254.2 +012400 02 FILLER PIC X VALUE SPACE. ST1254.2 +012500 02 P-OR-F PIC X(5) VALUE SPACE. ST1254.2 +012600 02 FILLER PIC X VALUE SPACE. ST1254.2 +012700 02 PAR-NAME. ST1254.2 +012800 03 FILLER PIC X(19) VALUE SPACE. ST1254.2 +012900 03 PARDOT-X PIC X VALUE SPACE. ST1254.2 +013000 03 DOTVALUE PIC 99 VALUE ZERO. ST1254.2 +013100 02 FILLER PIC X(8) VALUE SPACE. ST1254.2 +013200 02 RE-MARK PIC X(61). ST1254.2 +013300 01 TEST-COMPUTED. ST1254.2 +013400 02 FILLER PIC X(30) VALUE SPACE. ST1254.2 +013500 02 FILLER PIC X(17) VALUE ST1254.2 +013600 " COMPUTED=". ST1254.2 +013700 02 COMPUTED-X. ST1254.2 +013800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1254.2 +013900 03 COMPUTED-N REDEFINES COMPUTED-A ST1254.2 +014000 PIC -9(9).9(9). ST1254.2 +014100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1254.2 +014200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1254.2 +014300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1254.2 +014400 03 CM-18V0 REDEFINES COMPUTED-A. ST1254.2 +014500 04 COMPUTED-18V0 PIC -9(18). ST1254.2 +014600 04 FILLER PIC X. ST1254.2 +014700 03 FILLER PIC X(50) VALUE SPACE. ST1254.2 +014800 01 TEST-CORRECT. ST1254.2 +014900 02 FILLER PIC X(30) VALUE SPACE. ST1254.2 +015000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1254.2 +015100 02 CORRECT-X. ST1254.2 +015200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1254.2 +015300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1254.2 +015400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1254.2 +015500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1254.2 +015600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1254.2 +015700 03 CR-18V0 REDEFINES CORRECT-A. ST1254.2 +015800 04 CORRECT-18V0 PIC -9(18). ST1254.2 +015900 04 FILLER PIC X. ST1254.2 +016000 03 FILLER PIC X(2) VALUE SPACE. ST1254.2 +016100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1254.2 +016200 01 CCVS-C-1. ST1254.2 +016300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1254.2 +016400- "SS PARAGRAPH-NAME ST1254.2 +016500- " REMARKS". ST1254.2 +016600 02 FILLER PIC X(20) VALUE SPACE. ST1254.2 +016700 01 CCVS-C-2. ST1254.2 +016800 02 FILLER PIC X VALUE SPACE. ST1254.2 +016900 02 FILLER PIC X(6) VALUE "TESTED". ST1254.2 +017000 02 FILLER PIC X(15) VALUE SPACE. ST1254.2 +017100 02 FILLER PIC X(4) VALUE "FAIL". ST1254.2 +017200 02 FILLER PIC X(94) VALUE SPACE. ST1254.2 +017300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1254.2 +017400 01 REC-CT PIC 99 VALUE ZERO. ST1254.2 +017500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1254.2 +018000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1254.2 +018100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1254.2 +018200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1254.2 +018300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1254.2 +018400 01 CCVS-H-1. ST1254.2 +018500 02 FILLER PIC X(39) VALUE SPACES. ST1254.2 +018600 02 FILLER PIC X(42) VALUE ST1254.2 +018700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1254.2 +018800 02 FILLER PIC X(39) VALUE SPACES. ST1254.2 +018900 01 CCVS-H-2A. ST1254.2 +019000 02 FILLER PIC X(40) VALUE SPACE. ST1254.2 +019100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1254.2 +019200 02 FILLER PIC XXXX VALUE ST1254.2 +019300 "4.2 ". ST1254.2 +019400 02 FILLER PIC X(28) VALUE ST1254.2 +019500 " COPY - NOT FOR DISTRIBUTION". ST1254.2 +019600 02 FILLER PIC X(41) VALUE SPACE. ST1254.2 +019700 ST1254.2 +019800 01 CCVS-H-2B. ST1254.2 +019900 02 FILLER PIC X(15) VALUE ST1254.2 +020000 "TEST RESULT OF ". ST1254.2 +020100 02 TEST-ID PIC X(9). ST1254.2 +020200 02 FILLER PIC X(4) VALUE ST1254.2 +020300 " IN ". ST1254.2 +020400 02 FILLER PIC X(12) VALUE ST1254.2 +020500 " HIGH ". ST1254.2 +020600 02 FILLER PIC X(22) VALUE ST1254.2 +020700 " LEVEL VALIDATION FOR ". ST1254.2 +020800 02 FILLER PIC X(58) VALUE ST1254.2 +020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +021000 01 CCVS-H-3. ST1254.2 +021100 02 FILLER PIC X(34) VALUE ST1254.2 +021200 " FOR OFFICIAL USE ONLY ". ST1254.2 +021300 02 FILLER PIC X(58) VALUE ST1254.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1254.2 +021500 02 FILLER PIC X(28) VALUE ST1254.2 +021600 " COPYRIGHT 1985 ". ST1254.2 +021700 01 CCVS-E-1. ST1254.2 +021800 02 FILLER PIC X(52) VALUE SPACE. ST1254.2 +021900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1254.2 +022000 02 ID-AGAIN PIC X(9). ST1254.2 +022100 02 FILLER PIC X(45) VALUE SPACES. ST1254.2 +022200 01 CCVS-E-2. ST1254.2 +022300 02 FILLER PIC X(31) VALUE SPACE. ST1254.2 +022400 02 FILLER PIC X(21) VALUE SPACE. ST1254.2 +022500 02 CCVS-E-2-2. ST1254.2 +022600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1254.2 +022700 03 FILLER PIC X VALUE SPACE. ST1254.2 +022800 03 ENDER-DESC PIC X(44) VALUE ST1254.2 +022900 "ERRORS ENCOUNTERED". ST1254.2 +023000 01 CCVS-E-3. ST1254.2 +023100 02 FILLER PIC X(22) VALUE ST1254.2 +023200 " FOR OFFICIAL USE ONLY". ST1254.2 +023300 02 FILLER PIC X(12) VALUE SPACE. ST1254.2 +023400 02 FILLER PIC X(58) VALUE ST1254.2 +023500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +023600 02 FILLER PIC X(13) VALUE SPACE. ST1254.2 +023700 02 FILLER PIC X(15) VALUE ST1254.2 +023800 " COPYRIGHT 1985". ST1254.2 +023900 01 CCVS-E-4. ST1254.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1254.2 +024100 02 FILLER PIC X(4) VALUE " OF ". ST1254.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1254.2 +024300 02 FILLER PIC X(40) VALUE ST1254.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1254.2 +024500 01 XXINFO. ST1254.2 +024600 02 FILLER PIC X(19) VALUE ST1254.2 +024700 "*** INFORMATION ***". ST1254.2 +024800 02 INFO-TEXT. ST1254.2 +024900 04 FILLER PIC X(8) VALUE SPACE. ST1254.2 +025000 04 XXCOMPUTED PIC X(20). ST1254.2 +025100 04 FILLER PIC X(5) VALUE SPACE. ST1254.2 +025200 04 XXCORRECT PIC X(20). ST1254.2 +025300 02 INF-ANSI-REFERENCE PIC X(48). ST1254.2 +025400 01 HYPHEN-LINE. ST1254.2 +025500 02 FILLER PIC IS X VALUE IS SPACE. ST1254.2 +025600 02 FILLER PIC IS X(65) VALUE IS "************************ST1254.2 +025700- "*****************************************". ST1254.2 +025800 02 FILLER PIC IS X(54) VALUE IS "************************ST1254.2 +025900- "******************************". ST1254.2 +026000 01 CCVS-PGM-ID PIC X(9) VALUE ST1254.2 +026100 "ST125A". ST1254.2 +026200 PROCEDURE DIVISION. ST1254.2 +026300 SORTPARA SECTION. ST1254.2 +026400 SORT-PARAGRAPH. ST1254.2 +026500 SORT SORTFILE-1F ON ST1254.2 +026600 ASCENDING SORTKEY-1 ST1254.2 +026700 DESCENDING SORTKEY-2 ST1254.2 +026800 ASCENDING SORTKEY-3 ST1254.2 +026900 INPUT PROCEDURE INPROC THRU INPROC-EXIT ST1254.2 +027000 GIVING SORTOUT-1F ST1254.2 +027100 SORTOUT-2F ST1254.2 +027200 SORTOUT-3F. ST1254.2 +027300 STOP RUN. ST1254.2 +027400 INPROC SECTION. ST1254.2 +027500 OPEN-FILES. ST1254.2 +027600 OPEN OUTPUT PRINT-FILE. ST1254.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1254.2 +027800 MOVE SPACE TO TEST-RESULTS. ST1254.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1254.2 +028000 GO TO CCVS1-EXIT. ST1254.2 +028100 CLOSE-FILES. ST1254.2 +028200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1254.2 +028300 TERMINATE-CCVS. ST1254.2 +028400S EXIT PROGRAM. ST1254.2 +028500STERMINATE-CALL. ST1254.2 +028600 STOP RUN. ST1254.2 +028700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1254.2 +028800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1254.2 +028900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1254.2 +029000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1254.2 +029100 MOVE "****TEST DELETED****" TO RE-MARK. ST1254.2 +029200 PRINT-DETAIL. ST1254.2 +029300 IF REC-CT NOT EQUAL TO ZERO ST1254.2 +029400 MOVE "." TO PARDOT-X ST1254.2 +029500 MOVE REC-CT TO DOTVALUE. ST1254.2 +029600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1254.2 +029700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1254.2 +029800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1254.2 +029900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1254.2 +030000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1254.2 +030100 MOVE SPACE TO CORRECT-X. ST1254.2 +030200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1254.2 +030300 MOVE SPACE TO RE-MARK. ST1254.2 +030400 HEAD-ROUTINE. ST1254.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1254.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1254.2 +030900 COLUMN-NAMES-ROUTINE. ST1254.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +031300 END-ROUTINE. ST1254.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1254.2 +031500 END-RTN-EXIT. ST1254.2 +031600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +031700 END-ROUTINE-1. ST1254.2 +031800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1254.2 +031900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1254.2 +032000 ADD PASS-COUNTER TO ERROR-HOLD. ST1254.2 +032100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1254.2 +032200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1254.2 +032300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1254.2 +032400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1254.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1254.2 +032600 END-ROUTINE-12. ST1254.2 +032700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1254.2 +032800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1254.2 +032900 MOVE "NO " TO ERROR-TOTAL ST1254.2 +033000 ELSE ST1254.2 +033100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1254.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1254.2 +033300 PERFORM WRITE-LINE. ST1254.2 +033400 END-ROUTINE-13. ST1254.2 +033500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1254.2 +033600 MOVE "NO " TO ERROR-TOTAL ELSE ST1254.2 +033700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1254.2 +033800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1254.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034000 IF INSPECT-COUNTER EQUAL TO ZERO ST1254.2 +034100 MOVE "NO " TO ERROR-TOTAL ST1254.2 +034200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1254.2 +034300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1254.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034600 WRITE-LINE. ST1254.2 +034700 ADD 1 TO RECORD-COUNT. ST1254.2 +034800Y IF RECORD-COUNT GREATER 42 ST1254.2 +034900Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1254.2 +035000Y MOVE SPACE TO DUMMY-RECORD ST1254.2 +035100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1254.2 +035200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1254.2 +035300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1254.2 +035400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1254.2 +035500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1254.2 +035600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035900Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1254.2 +036000Y MOVE ZERO TO RECORD-COUNT. ST1254.2 +036100 PERFORM WRT-LN. ST1254.2 +036200 WRT-LN. ST1254.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1254.2 +036400 MOVE SPACE TO DUMMY-RECORD. ST1254.2 +036500 BLANK-LINE-PRINT. ST1254.2 +036600 PERFORM WRT-LN. ST1254.2 +036700 FAIL-ROUTINE. ST1254.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE ST1254.2 +036900 GO TO FAIL-ROUTINE-WRITE. ST1254.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1254.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1254.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1254.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1254.2 +037500 GO TO FAIL-ROUTINE-EX. ST1254.2 +037600 FAIL-ROUTINE-WRITE. ST1254.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1254.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1254.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1254.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1254.2 +038100 FAIL-ROUTINE-EX. EXIT. ST1254.2 +038200 BAIL-OUT. ST1254.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1254.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1254.2 +038500 BAIL-OUT-WRITE. ST1254.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1254.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1254.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1254.2 +039000 BAIL-OUT-EX. EXIT. ST1254.2 +039100 CCVS1-EXIT. ST1254.2 +039200 EXIT. ST1254.2 +039300 ST125A-001-01. ST1254.2 +039400 MOVE "XI-20 4.4.4 GR(12)" TO ANSI-REFERENCE. ST1254.2 +039500 OPEN OUTPUT SORTOUT-1F. ST1254.2 +039600 OPEN OUTPUT SORTOUT-2F. ST1254.2 +039700 OPEN OUTPUT SORTOUT-3F. ST1254.2 +039800 MOVE "THIS PROGRAM BUILDS AND" TO RE-MARK. ST1254.2 +039900 PERFORM PRINT-DETAIL. ST1254.2 +040000 MOVE "SORTS 3 FILES AND PASSES" TO RE-MARK. ST1254.2 +040100 PERFORM PRINT-DETAIL. ST1254.2 +040200 MOVE "THE OUTPUT TO ST126A." TO RE-MARK. ST1254.2 +040300 PERFORM PRINT-DETAIL. ST1254.2 +040400 BUILD-FILE. ST1254.2 +040500 ADD 1 TO UTIL-CTR ST1254.2 +040600 IF UTIL-CTR EQUAL TO 2 ST1254.2 +040700 MOVE 999999999999999999 TO UTILITY-2. ST1254.2 +040800 IF UTIL-CTR EQUAL TO 4 ST1254.2 +040900 ADD -1.1111111 TO UTILITY-1. ST1254.2 +041000 IF UTIL-CTR EQUAL TO 5 ST1254.2 +041100 MOVE ZERO TO UTILITY-3. ST1254.2 +041200 MOVE UTILITY-1 TO SORTKEY-1. ST1254.2 +041300 MOVE UTILITY-3 TO SORTKEY-3. ST1254.2 +041400 MOVE UTILITY-2 TO SORTKEY-2. ST1254.2 +041500 RELEASE SORT-GROUP. ST1254.2 +041600 IF UTIL-CTR LESS THAN 9 GO TO BUILD-FILE. ST1254.2 +041700 BUILD-FILE-TEST. ST1254.2 +041800 IF UTIL-CTR EQUAL TO 9 ST1254.2 +041900 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1254.2 +042000 BUILD-FILE-FAIL. ST1254.2 +042100 MOVE UTIL-CTR TO COMPUTED-N. ST1254.2 +042200 MOVE 9 TO CORRECT-N. ST1254.2 +042300 PERFORM FAIL. ST1254.2 +042400 BUILD-FILE-WRITE. ST1254.2 +042500 MOVE "CREATE A FILE" TO FEATURE. ST1254.2 +042600 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1254.2 +042700 PERFORM PRINT-DETAIL. ST1254.2 +042800 CLOSE SORTOUT-1F. ST1254.2 +042900 CLOSE SORTOUT-2F. ST1254.2 +043000 CLOSE SORTOUT-3F. ST1254.2 +043100 ST1254.2 +043200 INPROC-EXIT SECTION. ST1254.2 +043300 EXITPARA. ST1254.2 +043400 PERFORM CLOSE-FILES. ST1254.2 +*END-OF,ST125A +*HEADER,COBOL,ST125A,SUBPRG,ST126A +000100 IDENTIFICATION DIVISION. ST1264.2 +000200 PROGRAM-ID. ST1264.2 +000300 ST126A. ST1264.2 +000400**************************************************************** ST1264.2 +000500* * ST1264.2 +000600* VALIDATION FOR:- * ST1264.2 +000700* * ST1264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +000900* * ST1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1264.2 +001100* * ST1264.2 +001200**************************************************************** ST1264.2 +001300* * ST1264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1264.2 +001500* * ST1264.2 +001600* X-01 * ST1264.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1264.2 +001800* X-69 * ST1264.2 +001900* X-74 * ST1264.2 +002000* X-75 * ST1264.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1264.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1264.2 +002300* * ST1264.2 +002400**************************************************************** ST1264.2 +002500* * ST1264.2 +002600* PROGRAM ST126A VERIFIES THE CONTENT OF THE THREE FILES * ST1264.2 +002700* PRODUCED BY ST125A. * ST1264.2 +002800* * ST1264.2 +002900**************************************************************** ST1264.2 +003000 ENVIRONMENT DIVISION. ST1264.2 +003100 CONFIGURATION SECTION. ST1264.2 +003200 SOURCE-COMPUTER. ST1264.2 +003300 XXXXX082. ST1264.2 +003400 OBJECT-COMPUTER. ST1264.2 +003500 XXXXX083. ST1264.2 +003600 INPUT-OUTPUT SECTION. ST1264.2 +003700 FILE-CONTROL. ST1264.2 +003800 SELECT PRINT-FILE ASSIGN TO ST1264.2 +003900 XXXXX055. ST1264.2 +004000 SELECT SORTIN-1G ASSIGN TO ST1264.2 +004100 XXXXD001. ST1264.2 +004200 SELECT SORTIN-2G ASSIGN TO ST1264.2 +004300 XXXXD002. ST1264.2 +004400 SELECT SORTIN-3G ASSIGN TO ST1264.2 +004500 XXXXD003. ST1264.2 +004600 DATA DIVISION. ST1264.2 +004700 FILE SECTION. ST1264.2 +004800 FD PRINT-FILE. ST1264.2 +004900 01 PRINT-REC PICTURE X(120). ST1264.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1264.2 +005100 FD SORTIN-1G ST1264.2 +005200 LABEL RECORDS STANDARD ST1264.2 +005300C VALUE OF ST1264.2 +005400C XXXXX074 ST1264.2 +005500C IS ST1264.2 +005600C XXXXX075 ST1264.2 +005700G XXXXX069 ST1264.2 +005800 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +005900 01 SORTIN-REC-1. ST1264.2 +006000 02 SORTKEY-3-1 PICTURE X. ST1264.2 +006100 02 SORTKEY-1-1 PICTURE S9V9(7). ST1264.2 +006200 02 SORTKEY-2-1 PICTURE 9(18). ST1264.2 +006300 FD SORTIN-2G ST1264.2 +006400 LABEL RECORDS STANDARD ST1264.2 +006500C VALUE OF ST1264.2 +006600C XXXXX074 ST1264.2 +006700C IS ST1264.2 +006800C XXXXX075 ST1264.2 +006900G XXXXX069 ST1264.2 +007000 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +007100 01 SORTIN-REC-2. ST1264.2 +007200 02 SORTKEY-3-2 PICTURE X. ST1264.2 +007300 02 SORTKEY-1-2 PICTURE S9V9(7). ST1264.2 +007400 02 SORTKEY-2-2 PICTURE 9(18). ST1264.2 +007500 FD SORTIN-3G ST1264.2 +007600 LABEL RECORDS STANDARD ST1264.2 +007700C VALUE OF ST1264.2 +007800C XXXXX074 ST1264.2 +007900C IS ST1264.2 +008000C XXXXX075 ST1264.2 +008100G XXXXX069 ST1264.2 +008200 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +008300 01 SORTIN-REC-3. ST1264.2 +008400 02 SORTKEY-3-3 PICTURE X. ST1264.2 +008500 02 SORTKEY-1-3 PICTURE S9V9(7). ST1264.2 +008600 02 SORTKEY-2-3 PICTURE 9(18). ST1264.2 +008700 WORKING-STORAGE SECTION. ST1264.2 +008800 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1264.2 +008900 77 ITEM-3 PICTURE X(27) VALUE "FIRST OF 3 ITEMS IN RECORD ". ST1264.2 +009000 77 ITEM-1 PICTURE X(27) VALUE " SECOND OF 3 ITEMS ". ST1264.2 +009100 77 ITEM-2 PICTURE X(27) VALUE " THIRD OF 3 ITEMS ". ST1264.2 +009200 77 DUM-MY PICTURE X(27) VALUE "TEST UNNECESSARY - BYPASSED". ST1264.2 +009300 77 ZER-O PICTURE X VALUE "0". ST1264.2 +009400 77 SPAC-E PICTURE X VALUE " ". ST1264.2 +009500 01 UTILITY-KEYS. ST1264.2 +009600 02 UTILITY-3 PICTURE X. ST1264.2 +009700 02 UTILITY-1 PICTURE S9V9(7). ST1264.2 +009800 02 UTILITY-2 PICTURE 9(018). ST1264.2 +009900 01 TEST-RESULTS. ST1264.2 +010000 02 FILLER PIC X VALUE SPACE. ST1264.2 +010100 02 FEATURE PIC X(20) VALUE SPACE. ST1264.2 +010200 02 FILLER PIC X VALUE SPACE. ST1264.2 +010300 02 P-OR-F PIC X(5) VALUE SPACE. ST1264.2 +010400 02 FILLER PIC X VALUE SPACE. ST1264.2 +010500 02 PAR-NAME. ST1264.2 +010600 03 FILLER PIC X(19) VALUE SPACE. ST1264.2 +010700 03 PARDOT-X PIC X VALUE SPACE. ST1264.2 +010800 03 DOTVALUE PIC 99 VALUE ZERO. ST1264.2 +010900 02 FILLER PIC X(8) VALUE SPACE. ST1264.2 +011000 02 RE-MARK PIC X(61). ST1264.2 +011100 01 TEST-COMPUTED. ST1264.2 +011200 02 FILLER PIC X(30) VALUE SPACE. ST1264.2 +011300 02 FILLER PIC X(17) VALUE ST1264.2 +011400 " COMPUTED=". ST1264.2 +011500 02 COMPUTED-X. ST1264.2 +011600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1264.2 +011700 03 COMPUTED-N REDEFINES COMPUTED-A ST1264.2 +011800 PIC -9(9).9(9). ST1264.2 +011900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1264.2 +012000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1264.2 +012100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1264.2 +012200 03 CM-18V0 REDEFINES COMPUTED-A. ST1264.2 +012300 04 COMPUTED-18V0 PIC -9(18). ST1264.2 +012400 04 FILLER PIC X. ST1264.2 +012500 03 FILLER PIC X(50) VALUE SPACE. ST1264.2 +012600 01 TEST-CORRECT. ST1264.2 +012700 02 FILLER PIC X(30) VALUE SPACE. ST1264.2 +012800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1264.2 +012900 02 CORRECT-X. ST1264.2 +013000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1264.2 +013100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1264.2 +013200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1264.2 +013300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1264.2 +013400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1264.2 +013500 03 CR-18V0 REDEFINES CORRECT-A. ST1264.2 +013600 04 CORRECT-18V0 PIC -9(18). ST1264.2 +013700 04 FILLER PIC X. ST1264.2 +013800 03 FILLER PIC X(2) VALUE SPACE. ST1264.2 +013900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1264.2 +014000 01 CCVS-C-1. ST1264.2 +014100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1264.2 +014200- "SS PARAGRAPH-NAME ST1264.2 +014300- " REMARKS". ST1264.2 +014400 02 FILLER PIC X(20) VALUE SPACE. ST1264.2 +014500 01 CCVS-C-2. ST1264.2 +014600 02 FILLER PIC X VALUE SPACE. ST1264.2 +014700 02 FILLER PIC X(6) VALUE "TESTED". ST1264.2 +014800 02 FILLER PIC X(15) VALUE SPACE. ST1264.2 +014900 02 FILLER PIC X(4) VALUE "FAIL". ST1264.2 +015000 02 FILLER PIC X(94) VALUE SPACE. ST1264.2 +015100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1264.2 +015200 01 REC-CT PIC 99 VALUE ZERO. ST1264.2 +015300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1264.2 +015800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1264.2 +015900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1264.2 +016000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1264.2 +016100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1264.2 +016200 01 CCVS-H-1. ST1264.2 +016300 02 FILLER PIC X(39) VALUE SPACES. ST1264.2 +016400 02 FILLER PIC X(42) VALUE ST1264.2 +016500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1264.2 +016600 02 FILLER PIC X(39) VALUE SPACES. ST1264.2 +016700 01 CCVS-H-2A. ST1264.2 +016800 02 FILLER PIC X(40) VALUE SPACE. ST1264.2 +016900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1264.2 +017000 02 FILLER PIC XXXX VALUE ST1264.2 +017100 "4.2 ". ST1264.2 +017200 02 FILLER PIC X(28) VALUE ST1264.2 +017300 " COPY - NOT FOR DISTRIBUTION". ST1264.2 +017400 02 FILLER PIC X(41) VALUE SPACE. ST1264.2 +017500 ST1264.2 +017600 01 CCVS-H-2B. ST1264.2 +017700 02 FILLER PIC X(15) VALUE ST1264.2 +017800 "TEST RESULT OF ". ST1264.2 +017900 02 TEST-ID PIC X(9). ST1264.2 +018000 02 FILLER PIC X(4) VALUE ST1264.2 +018100 " IN ". ST1264.2 +018200 02 FILLER PIC X(12) VALUE ST1264.2 +018300 " HIGH ". ST1264.2 +018400 02 FILLER PIC X(22) VALUE ST1264.2 +018500 " LEVEL VALIDATION FOR ". ST1264.2 +018600 02 FILLER PIC X(58) VALUE ST1264.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +018800 01 CCVS-H-3. ST1264.2 +018900 02 FILLER PIC X(34) VALUE ST1264.2 +019000 " FOR OFFICIAL USE ONLY ". ST1264.2 +019100 02 FILLER PIC X(58) VALUE ST1264.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1264.2 +019300 02 FILLER PIC X(28) VALUE ST1264.2 +019400 " COPYRIGHT 1985 ". ST1264.2 +019500 01 CCVS-E-1. ST1264.2 +019600 02 FILLER PIC X(52) VALUE SPACE. ST1264.2 +019700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1264.2 +019800 02 ID-AGAIN PIC X(9). ST1264.2 +019900 02 FILLER PIC X(45) VALUE SPACES. ST1264.2 +020000 01 CCVS-E-2. ST1264.2 +020100 02 FILLER PIC X(31) VALUE SPACE. ST1264.2 +020200 02 FILLER PIC X(21) VALUE SPACE. ST1264.2 +020300 02 CCVS-E-2-2. ST1264.2 +020400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1264.2 +020500 03 FILLER PIC X VALUE SPACE. ST1264.2 +020600 03 ENDER-DESC PIC X(44) VALUE ST1264.2 +020700 "ERRORS ENCOUNTERED". ST1264.2 +020800 01 CCVS-E-3. ST1264.2 +020900 02 FILLER PIC X(22) VALUE ST1264.2 +021000 " FOR OFFICIAL USE ONLY". ST1264.2 +021100 02 FILLER PIC X(12) VALUE SPACE. ST1264.2 +021200 02 FILLER PIC X(58) VALUE ST1264.2 +021300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +021400 02 FILLER PIC X(13) VALUE SPACE. ST1264.2 +021500 02 FILLER PIC X(15) VALUE ST1264.2 +021600 " COPYRIGHT 1985". ST1264.2 +021700 01 CCVS-E-4. ST1264.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1264.2 +021900 02 FILLER PIC X(4) VALUE " OF ". ST1264.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1264.2 +022100 02 FILLER PIC X(40) VALUE ST1264.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1264.2 +022300 01 XXINFO. ST1264.2 +022400 02 FILLER PIC X(19) VALUE ST1264.2 +022500 "*** INFORMATION ***". ST1264.2 +022600 02 INFO-TEXT. ST1264.2 +022700 04 FILLER PIC X(8) VALUE SPACE. ST1264.2 +022800 04 XXCOMPUTED PIC X(20). ST1264.2 +022900 04 FILLER PIC X(5) VALUE SPACE. ST1264.2 +023000 04 XXCORRECT PIC X(20). ST1264.2 +023100 02 INF-ANSI-REFERENCE PIC X(48). ST1264.2 +023200 01 HYPHEN-LINE. ST1264.2 +023300 02 FILLER PIC IS X VALUE IS SPACE. ST1264.2 +023400 02 FILLER PIC IS X(65) VALUE IS "************************ST1264.2 +023500- "*****************************************". ST1264.2 +023600 02 FILLER PIC IS X(54) VALUE IS "************************ST1264.2 +023700- "******************************". ST1264.2 +023800 01 CCVS-PGM-ID PIC X(9) VALUE ST1264.2 +023900 "ST126A". ST1264.2 +024000 PROCEDURE DIVISION. ST1264.2 +024100 CCVS1 SECTION. ST1264.2 +024200 OPEN-FILES. ST1264.2 +024300 OPEN OUTPUT PRINT-FILE. ST1264.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1264.2 +024500 MOVE SPACE TO TEST-RESULTS. ST1264.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1264.2 +024700 GO TO CCVS1-EXIT. ST1264.2 +024800 CLOSE-FILES. ST1264.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1264.2 +025000 TERMINATE-CCVS. ST1264.2 +025100S EXIT PROGRAM. ST1264.2 +025200STERMINATE-CALL. ST1264.2 +025300 STOP RUN. ST1264.2 +025400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1264.2 +025500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1264.2 +025600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1264.2 +025700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1264.2 +025800 MOVE "****TEST DELETED****" TO RE-MARK. ST1264.2 +025900 PRINT-DETAIL. ST1264.2 +026000 IF REC-CT NOT EQUAL TO ZERO ST1264.2 +026100 MOVE "." TO PARDOT-X ST1264.2 +026200 MOVE REC-CT TO DOTVALUE. ST1264.2 +026300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1264.2 +026400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1264.2 +026500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1264.2 +026600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1264.2 +026700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1264.2 +026800 MOVE SPACE TO CORRECT-X. ST1264.2 +026900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1264.2 +027000 MOVE SPACE TO RE-MARK. ST1264.2 +027100 HEAD-ROUTINE. ST1264.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1264.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1264.2 +027600 COLUMN-NAMES-ROUTINE. ST1264.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +028000 END-ROUTINE. ST1264.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1264.2 +028200 END-RTN-EXIT. ST1264.2 +028300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +028400 END-ROUTINE-1. ST1264.2 +028500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1264.2 +028600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1264.2 +028700 ADD PASS-COUNTER TO ERROR-HOLD. ST1264.2 +028800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1264.2 +028900 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1264.2 +029000 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1264.2 +029100 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1264.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1264.2 +029300 END-ROUTINE-12. ST1264.2 +029400 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1264.2 +029500 IF ERROR-COUNTER IS EQUAL TO ZERO ST1264.2 +029600 MOVE "NO " TO ERROR-TOTAL ST1264.2 +029700 ELSE ST1264.2 +029800 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1264.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1264.2 +030000 PERFORM WRITE-LINE. ST1264.2 +030100 END-ROUTINE-13. ST1264.2 +030200 IF DELETE-COUNTER IS EQUAL TO ZERO ST1264.2 +030300 MOVE "NO " TO ERROR-TOTAL ELSE ST1264.2 +030400 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1264.2 +030500 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1264.2 +030600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +030700 IF INSPECT-COUNTER EQUAL TO ZERO ST1264.2 +030800 MOVE "NO " TO ERROR-TOTAL ST1264.2 +030900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1264.2 +031000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1264.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +031200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +031300 WRITE-LINE. ST1264.2 +031400 ADD 1 TO RECORD-COUNT. ST1264.2 +031500Y IF RECORD-COUNT GREATER 42 ST1264.2 +031600Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1264.2 +031700Y MOVE SPACE TO DUMMY-RECORD ST1264.2 +031800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1264.2 +031900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1264.2 +032000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1264.2 +032100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1264.2 +032200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1264.2 +032300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032600Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1264.2 +032700Y MOVE ZERO TO RECORD-COUNT. ST1264.2 +032800 PERFORM WRT-LN. ST1264.2 +032900 WRT-LN. ST1264.2 +033000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1264.2 +033100 MOVE SPACE TO DUMMY-RECORD. ST1264.2 +033200 BLANK-LINE-PRINT. ST1264.2 +033300 PERFORM WRT-LN. ST1264.2 +033400 FAIL-ROUTINE. ST1264.2 +033500 IF COMPUTED-X NOT EQUAL TO SPACE ST1264.2 +033600 GO TO FAIL-ROUTINE-WRITE. ST1264.2 +033700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1264.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1264.2 +033900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1264.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1264.2 +034200 GO TO FAIL-ROUTINE-EX. ST1264.2 +034300 FAIL-ROUTINE-WRITE. ST1264.2 +034400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1264.2 +034500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1264.2 +034600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1264.2 +034700 MOVE SPACES TO COR-ANSI-REFERENCE. ST1264.2 +034800 FAIL-ROUTINE-EX. EXIT. ST1264.2 +034900 BAIL-OUT. ST1264.2 +035000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1264.2 +035100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1264.2 +035200 BAIL-OUT-WRITE. ST1264.2 +035300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1264.2 +035400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1264.2 +035500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +035600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1264.2 +035700 BAIL-OUT-EX. EXIT. ST1264.2 +035800 CCVS1-EXIT. ST1264.2 +035900 EXIT. ST1264.2 +036000 ST126A-001-01. ST1264.2 +036100 MOVE "XI-20 4.4.4 GR(12)" TO ANSI-REFERENCE. ST1264.2 +036200 OPEN INPUT SORTIN-1G. ST1264.2 +036300 OPEN INPUT SORTIN-2G. ST1264.2 +036400 OPEN INPUT SORTIN-3G. ST1264.2 +036500 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +036600 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +036700 GO TO ZERO-IS-LESS-THAN-SPACE. ST1264.2 +036800 SPACE-IS-LESS-THAN-ZERO SECTION. ST1264.2 +036900 SORT-INIT-A. ST1264.2 +037000 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +037100 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +037200 MOVE SPACE TO UTILITY-3. ST1264.2 +037300 SORT-TEST-1. ST1264.2 +037400 PERFORM READ-SORTIN. ST1264.2 +037500 MOVE "SORT-TEST-1" TO PAR-NAME. ST1264.2 +037600 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +037700 PERFORM PASS GO TO SORT-WRITE-1. ST1264.2 +037800 SORT-FAIL-1. ST1264.2 +037900 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +038000 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +038100 MOVE ITEM-3 TO RE-MARK. ST1264.2 +038200 PERFORM PRINT-DETAIL. ST1264.2 +038300 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +038400 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +038500 MOVE ITEM-1 TO RE-MARK. ST1264.2 +038600 PERFORM PRINT-DETAIL. ST1264.2 +038700 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +038800 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +038900 MOVE ITEM-2 TO RE-MARK. ST1264.2 +039000 PERFORM FAIL. ST1264.2 +039100 SORT-WRITE-1. ST1264.2 +039200 PERFORM PRINT-DETAIL. ST1264.2 +039300 SORT-INIT-B. ST1264.2 +039400 MOVE ZERO TO UTILITY-3. ST1264.2 +039500 PERFORM READ-SORTIN 4 TIMES. ST1264.2 +039600* NOTE SORT-TEST-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +039700 SORT-TEST-2. ST1264.2 +039800 PERFORM READ-SORTIN. ST1264.2 +039900 MOVE "SORT-TEST-2" TO PAR-NAME. ST1264.2 +040000 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +040100 PERFORM PASS GO TO SORT-WRITE-2. ST1264.2 +040200 SORT-FAIL-2. ST1264.2 +040300 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +040400 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +040500 MOVE ITEM-3 TO RE-MARK. ST1264.2 +040600 PERFORM PRINT-DETAIL. ST1264.2 +040700 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +040800 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +040900 MOVE ITEM-1 TO RE-MARK. ST1264.2 +041000 PERFORM PRINT-DETAIL. ST1264.2 +041100 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +041200 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +041300 MOVE ITEM-2 TO RE-MARK. ST1264.2 +041400 PERFORM FAIL. ST1264.2 +041500 SORT-WRITE-2. ST1264.2 +041600 PERFORM PRINT-DETAIL. ST1264.2 +041700 DUMMY-3-AND-4. ST1264.2 +041800 MOVE "SORT-TEST-3" TO PAR-NAME. ST1264.2 +041900 MOVE DUM-MY TO RE-MARK. ST1264.2 +042000 PERFORM PRINT-DETAIL. ST1264.2 +042100 MOVE "SORT-TEST-4" TO PAR-NAME. ST1264.2 +042200 MOVE DUM-MY TO RE-MARK. ST1264.2 +042300 PERFORM PRINT-DETAIL. ST1264.2 +042400 GO TO CONTINUE-TESTING. ST1264.2 +042500 ZERO-IS-LESS-THAN-SPACE SECTION. ST1264.2 +042600 SORT-INIT-C. ST1264.2 +042700 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +042800 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +042900 MOVE ZERO TO UTILITY-3. ST1264.2 +043000 DUMMY-1-AND-2. ST1264.2 +043100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1264.2 +043200 MOVE DUM-MY TO RE-MARK. ST1264.2 +043300 PERFORM PRINT-DETAIL. ST1264.2 +043400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1264.2 +043500 MOVE DUM-MY TO RE-MARK. ST1264.2 +043600 PERFORM PRINT-DETAIL. ST1264.2 +043700 SORT-TEST-3. ST1264.2 +043800 PERFORM READ-SORTIN. ST1264.2 +043900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1264.2 +044000 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +044100 PERFORM PASS GO TO SORT-WRITE-3. ST1264.2 +044200 SORT-FAIL-3. ST1264.2 +044300 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +044400 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +044500 MOVE ITEM-3 TO RE-MARK. ST1264.2 +044600 PERFORM PRINT-DETAIL. ST1264.2 +044700 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +044800 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +044900 MOVE ITEM-1 TO RE-MARK. ST1264.2 +045000 PERFORM PRINT-DETAIL. ST1264.2 +045100 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +045200 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +045300 MOVE ITEM-2 TO RE-MARK. ST1264.2 +045400 PERFORM FAIL. ST1264.2 +045500 SORT-WRITE-3. ST1264.2 +045600 PERFORM PRINT-DETAIL. ST1264.2 +045700 SORT-INIT-D. ST1264.2 +045800 PERFORM READ-SORTIN 4 TIMES. ST1264.2 +045900 MOVE SPACE TO UTILITY-3. ST1264.2 +046000* NOTE SORT-TEST-4 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +046100 SORT-TEST-4. ST1264.2 +046200 PERFORM READ-SORTIN. ST1264.2 +046300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1264.2 +046400 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +046500 PERFORM PASS GO TO SORT-WRITE-4. ST1264.2 +046600 SORT-FAIL-4. ST1264.2 +046700 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +046800 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +046900 MOVE ITEM-3 TO RE-MARK. ST1264.2 +047000 PERFORM PRINT-DETAIL. ST1264.2 +047100 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +047200 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +047300 MOVE ITEM-1 TO RE-MARK. ST1264.2 +047400 PERFORM PRINT-DETAIL. ST1264.2 +047500 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +047600 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +047700 MOVE ITEM-2 TO RE-MARK. ST1264.2 +047800 PERFORM FAIL. ST1264.2 +047900 SORT-WRITE-4. ST1264.2 +048000 PERFORM PRINT-DETAIL. ST1264.2 +048100 CONTINUE-TESTING SECTION. ST1264.2 +048200 SORT-INIT-E. ST1264.2 +048300 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +048400 MOVE SPACE TO UTILITY-3. ST1264.2 +048500* NOTE SORT-TEST-5 CHECKS THE SEVENTH RECORD IN THE FILE. ST1264.2 +048600 SORT-TEST-5. ST1264.2 +048700 PERFORM READ-SORTIN. ST1264.2 +048800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1264.2 +048900 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +049000 PERFORM PASS GO TO SORT-WRITE-5. ST1264.2 +049100 SORT-FAIL-5. ST1264.2 +049200 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +049300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +049400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +049500 PERFORM PRINT-DETAIL. ST1264.2 +049600 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +049700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +049800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +049900 PERFORM PRINT-DETAIL. ST1264.2 +050000 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +050100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +050200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +050300 PERFORM FAIL. ST1264.2 +050400 SORT-WRITE-5. ST1264.2 +050500 PERFORM PRINT-DETAIL. ST1264.2 +050600 SORT-INIT-F. ST1264.2 +050700 PERFORM READ-SORTIN. ST1264.2 +050800 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +050900* NOTE SORT-TEST-6 CHECKS THE NINTH RECORD IN THE FILE. ST1264.2 +051000 SORT-TEST-6. ST1264.2 +051100 PERFORM READ-SORTIN. ST1264.2 +051200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1264.2 +051300 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +051400 PERFORM PASS GO TO SORT-WRITE-6. ST1264.2 +051500 SORT-FAIL-6. ST1264.2 +051600 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +051700 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +051800 MOVE ITEM-3 TO RE-MARK. ST1264.2 +051900 PERFORM PRINT-DETAIL. ST1264.2 +052000 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +052100 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +052200 MOVE ITEM-1 TO RE-MARK. ST1264.2 +052300 PERFORM PRINT-DETAIL. ST1264.2 +052400 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +052500 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +052600 MOVE ITEM-2 TO RE-MARK. ST1264.2 +052700 PERFORM FAIL. ST1264.2 +052800 SORT-WRITE-6. ST1264.2 +052900 PERFORM PRINT-DETAIL. ST1264.2 +053000 SORT-TEST-7. ST1264.2 +053100 READ SORTIN-1G AT END ST1264.2 +053200 PERFORM PASS GO TO SORT-WRITE-7. ST1264.2 +053300 SORT-FAIL-7. ST1264.2 +053400 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +053500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +053600 PERFORM FAIL. ST1264.2 +053700 SORT-WRITE-7. ST1264.2 +053800 MOVE "SORT-TEST-7" TO PAR-NAME. ST1264.2 +053900 PERFORM PRINT-DETAIL. ST1264.2 +054000 SORT-TEST-8. ST1264.2 +054100 IF UTIL-CTR EQUAL TO 9 ST1264.2 +054200 PERFORM PASS GO TO SORT-WRITE-8. ST1264.2 +054300 SORT-FAIL-8. ST1264.2 +054400 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +054500 MOVE 9 TO CORRECT-4V14. ST1264.2 +054600 PERFORM FAIL. ST1264.2 +054700 SORT-WRITE-8. ST1264.2 +054800 MOVE "SORT-TEST-8" TO PAR-NAME. ST1264.2 +054900 PERFORM PRINT-DETAIL. ST1264.2 +055000 CLOSE SORTIN-1G. ST1264.2 +055100 GO TO ST126A-001-02. ST1264.2 +055200 READ-SORTIN. ST1264.2 +055300 READ SORTIN-1G AT END GO TO READ-ERROR. ST1264.2 +055400 ADD 1 TO UTIL-CTR. ST1264.2 +055500 READ-ERROR. ST1264.2 +055600 MOVE "READ-ERROR" TO PAR-NAME. ST1264.2 +055700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +055800 PERFORM FAIL. ST1264.2 +055900 PERFORM PRINT-DETAIL. ST1264.2 +056000* ST1264.2 +056100* ST1264.2 +056200 ST126A-001-02. ST1264.2 +056300 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +056400 MOVE ZERO TO UTIL-CTR. ST1264.2 +056500 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +056600 GO TO ZERO-IS-LESS-THAN-SPACE-2. ST1264.2 +056700 SPACE-IS-LESS-THAN-ZERO-2 SECTION. ST1264.2 +056800 SORT-INIT-A-2. ST1264.2 +056900 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +057000 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +057100 MOVE SPACE TO UTILITY-3. ST1264.2 +057200 SORT-TEST-1-2. ST1264.2 +057300 PERFORM READ-SORTIN-2. ST1264.2 +057400 MOVE "SORT-TEST-1-2" TO PAR-NAME. ST1264.2 +057500 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +057600 PERFORM PASS GO TO SORT-WRITE-1-2. ST1264.2 +057700 SORT-FAIL-1-2. ST1264.2 +057800 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +057900 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +058000 MOVE ITEM-3 TO RE-MARK. ST1264.2 +058100 PERFORM PRINT-DETAIL. ST1264.2 +058200 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +058300 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +058400 MOVE ITEM-1 TO RE-MARK. ST1264.2 +058500 PERFORM PRINT-DETAIL. ST1264.2 +058600 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +058700 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +058800 MOVE ITEM-2 TO RE-MARK. ST1264.2 +058900 PERFORM FAIL. ST1264.2 +059000 SORT-WRITE-1-2. ST1264.2 +059100 PERFORM PRINT-DETAIL. ST1264.2 +059200 SORT-INIT-B-2. ST1264.2 +059300 MOVE ZERO TO UTILITY-3. ST1264.2 +059400 PERFORM READ-SORTIN-2 4 TIMES. ST1264.2 +059500* NOTE SORT-TEST-2-2 CHECKS THE 6TH RECORD IN THE FILE. ST1264.2 +059600 SORT-TEST-2-2. ST1264.2 +059700 PERFORM READ-SORTIN-2. ST1264.2 +059800 MOVE "SORT-TEST-2-2" TO PAR-NAME. ST1264.2 +059900 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +060000 PERFORM PASS GO TO SORT-WRITE-2-2. ST1264.2 +060100 SORT-FAIL-2-2. ST1264.2 +060200 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +060300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +060400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +060500 PERFORM PRINT-DETAIL. ST1264.2 +060600 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +060700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +060800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +060900 PERFORM PRINT-DETAIL. ST1264.2 +061000 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +061100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +061200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +061300 PERFORM FAIL. ST1264.2 +061400 SORT-WRITE-2-2. ST1264.2 +061500 PERFORM PRINT-DETAIL. ST1264.2 +061600 DUMMY-3-AND-4-2. ST1264.2 +061700 MOVE "SORT-TEST-3-2" TO PAR-NAME. ST1264.2 +061800 MOVE DUM-MY TO RE-MARK. ST1264.2 +061900 PERFORM PRINT-DETAIL. ST1264.2 +062000 MOVE "SORT-TEST-4-2" TO PAR-NAME. ST1264.2 +062100 MOVE DUM-MY TO RE-MARK. ST1264.2 +062200 PERFORM PRINT-DETAIL. ST1264.2 +062300 GO TO CONTINUE-TESTING-2. ST1264.2 +062400 ZERO-IS-LESS-THAN-SPACE-2 SECTION. ST1264.2 +062500 SORT-INIT-C-2. ST1264.2 +062600 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +062700 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +062800 MOVE ZERO TO UTILITY-3. ST1264.2 +062900 DUMMY-1-AND-2-2. ST1264.2 +063000 MOVE "SORT-TEST-1-2" TO PAR-NAME. ST1264.2 +063100 MOVE DUM-MY TO RE-MARK. ST1264.2 +063200 PERFORM PRINT-DETAIL. ST1264.2 +063300 MOVE "SORT-TEST-2-2" TO PAR-NAME. ST1264.2 +063400 MOVE DUM-MY TO RE-MARK. ST1264.2 +063500 PERFORM PRINT-DETAIL. ST1264.2 +063600 SORT-TEST-3-2. ST1264.2 +063700 PERFORM READ-SORTIN-2. ST1264.2 +063800 MOVE "SORT-TEST-3-2" TO PAR-NAME. ST1264.2 +063900 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +064000 PERFORM PASS GO TO SORT-WRITE-3-2. ST1264.2 +064100 SORT-FAIL-3-2. ST1264.2 +064200 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +064300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +064400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +064500 PERFORM PRINT-DETAIL. ST1264.2 +064600 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +064700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +064800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +064900 PERFORM PRINT-DETAIL. ST1264.2 +065000 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +065100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +065200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +065300 PERFORM FAIL. ST1264.2 +065400 SORT-WRITE-3-2. ST1264.2 +065500 PERFORM PRINT-DETAIL. ST1264.2 +065600 SORT-INIT-D-2. ST1264.2 +065700 PERFORM READ-SORTIN-2 4 TIMES. ST1264.2 +065800 MOVE SPACE TO UTILITY-3. ST1264.2 +065900* NOTE SORT-TEST-4-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +066000 SORT-TEST-4-2. ST1264.2 +066100 PERFORM READ-SORTIN-2. ST1264.2 +066200 MOVE "SORT-TEST-4-2" TO PAR-NAME. ST1264.2 +066300 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +066400 PERFORM PASS GO TO SORT-WRITE-4-2. ST1264.2 +066500 SORT-FAIL-4-2. ST1264.2 +066600 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +066700 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +066800 MOVE ITEM-3 TO RE-MARK. ST1264.2 +066900 PERFORM PRINT-DETAIL. ST1264.2 +067000 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +067100 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +067200 MOVE ITEM-1 TO RE-MARK. ST1264.2 +067300 PERFORM PRINT-DETAIL. ST1264.2 +067400 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +067500 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +067600 MOVE ITEM-2 TO RE-MARK. ST1264.2 +067700 PERFORM FAIL. ST1264.2 +067800 SORT-WRITE-4-2. ST1264.2 +067900 PERFORM PRINT-DETAIL. ST1264.2 +068000 CONTINUE-TESTING-2 SECTION. ST1264.2 +068100 SORT-INIT-E-2. ST1264.2 +068200 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +068300 MOVE SPACE TO UTILITY-3. ST1264.2 +068400* NOTE SORT-TEST-5-2 CHECKS THE 7TH RECORD IN THE FILE. ST1264.2 +068500 SORT-TEST-5-2. ST1264.2 +068600 PERFORM READ-SORTIN-2. ST1264.2 +068700 MOVE "SORT-TEST-5-2" TO PAR-NAME. ST1264.2 +068800 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +068900 PERFORM PASS GO TO SORT-WRITE-5-2. ST1264.2 +069000 SORT-FAIL-5-2. ST1264.2 +069100 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +069200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +069300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +069400 PERFORM PRINT-DETAIL. ST1264.2 +069500 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +069600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +069700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +069800 PERFORM PRINT-DETAIL. ST1264.2 +069900 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +070000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +070100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +070200 PERFORM FAIL. ST1264.2 +070300 SORT-WRITE-5-2. ST1264.2 +070400 PERFORM PRINT-DETAIL. ST1264.2 +070500 SORT-INIT-F-2. ST1264.2 +070600 PERFORM READ-SORTIN-2. ST1264.2 +070700 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +070800* NOTE SORT-TEST-6-2 CHECKS THE 9TH RECORD IN THE FILE. ST1264.2 +070900 SORT-TEST-6-2. ST1264.2 +071000 PERFORM READ-SORTIN-2. ST1264.2 +071100 MOVE "SORT-TEST-6-2" TO PAR-NAME. ST1264.2 +071200 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +071300 PERFORM PASS GO TO SORT-WRITE-6-2. ST1264.2 +071400 SORT-FAIL-6-2. ST1264.2 +071500 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +071600 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +071700 MOVE ITEM-3 TO RE-MARK. ST1264.2 +071800 PERFORM PRINT-DETAIL. ST1264.2 +071900 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +072000 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +072100 MOVE ITEM-1 TO RE-MARK. ST1264.2 +072200 PERFORM PRINT-DETAIL. ST1264.2 +072300 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +072400 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +072500 MOVE ITEM-2 TO RE-MARK. ST1264.2 +072600 PERFORM FAIL. ST1264.2 +072700 SORT-WRITE-6-2. ST1264.2 +072800 PERFORM PRINT-DETAIL. ST1264.2 +072900 SORT-TEST-7-2. ST1264.2 +073000 READ SORTIN-2G AT END ST1264.2 +073100 PERFORM PASS GO TO SORT-WRITE-7-2. ST1264.2 +073200 SORT-FAIL-7-2. ST1264.2 +073300 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +073400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +073500 PERFORM FAIL. ST1264.2 +073600 SORT-WRITE-7-2. ST1264.2 +073700 MOVE "SORT-TEST-7-2" TO PAR-NAME. ST1264.2 +073800 PERFORM PRINT-DETAIL. ST1264.2 +073900 SORT-TEST-8-2. ST1264.2 +074000 IF UTIL-CTR EQUAL TO 9 ST1264.2 +074100 PERFORM PASS GO TO SORT-WRITE-8-2. ST1264.2 +074200 SORT-FAIL-8-2. ST1264.2 +074300 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +074400 MOVE 9 TO CORRECT-4V14. ST1264.2 +074500 PERFORM FAIL. ST1264.2 +074600 SORT-WRITE-8-2. ST1264.2 +074700 MOVE "SORT-TEST-8-2" TO PAR-NAME. ST1264.2 +074800 PERFORM PRINT-DETAIL. ST1264.2 +074900 CLOSE SORTIN-2G. ST1264.2 +075000 GO TO ST126A-001-03. ST1264.2 +075100 READ-SORTIN-2. ST1264.2 +075200 READ SORTIN-2G AT END GO TO READ-ERROR-2. ST1264.2 +075300 ADD 1 TO UTIL-CTR. ST1264.2 +075400 READ-ERROR-2. ST1264.2 +075500 MOVE "READ-ERROR-2" TO PAR-NAME. ST1264.2 +075600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +075700 PERFORM FAIL. ST1264.2 +075800 PERFORM PRINT-DETAIL. ST1264.2 +075900* ST1264.2 +076000* ST1264.2 +076100 ST126A-001-03. ST1264.2 +076200 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +076300 MOVE ZERO TO UTIL-CTR. ST1264.2 +076400 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +076500 GO TO ZERO-IS-LESS-THAN-SPACE-3. ST1264.2 +076600 SPACE-IS-LESS-THAN-ZERO-3 SECTION. ST1264.2 +076700 SORT-INIT-A-3. ST1264.2 +076800 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +076900 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +077000 MOVE SPACE TO UTILITY-3. ST1264.2 +077100 SORT-TEST-1-3. ST1264.2 +077200 PERFORM READ-SORTIN-3. ST1264.2 +077300 MOVE "SORT-TEST-1-3" TO PAR-NAME. ST1264.2 +077400 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +077500 PERFORM PASS GO TO SORT-WRITE-1-3. ST1264.2 +077600 SORT-FAIL-1-3. ST1264.2 +077700 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +077800 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +077900 MOVE ITEM-3 TO RE-MARK. ST1264.2 +078000 PERFORM PRINT-DETAIL. ST1264.2 +078100 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +078200 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +078300 MOVE ITEM-1 TO RE-MARK. ST1264.2 +078400 PERFORM PRINT-DETAIL. ST1264.2 +078500 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +078600 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +078700 MOVE ITEM-2 TO RE-MARK. ST1264.2 +078800 PERFORM FAIL. ST1264.2 +078900 SORT-WRITE-1-3. ST1264.2 +079000 PERFORM PRINT-DETAIL. ST1264.2 +079100 SORT-INIT-B-3. ST1264.2 +079200 MOVE ZERO TO UTILITY-3. ST1264.2 +079300 PERFORM READ-SORTIN-3 4 TIMES. ST1264.2 +079400* NOTE SORT-TEST-2-3 CHECKS THE 6TH RECORD IN THE FILE. ST1264.2 +079500 SORT-TEST-2-3. ST1264.2 +079600 PERFORM READ-SORTIN-3. ST1264.2 +079700 MOVE "SORT-TEST-2-3" TO PAR-NAME. ST1264.2 +079800 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +079900 PERFORM PASS GO TO SORT-WRITE-2-3. ST1264.2 +080000 SORT-FAIL-2-3. ST1264.2 +080100 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +080200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +080300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +080400 PERFORM PRINT-DETAIL. ST1264.2 +080500 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +080600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +080700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +080800 PERFORM PRINT-DETAIL. ST1264.2 +080900 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +081000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +081100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +081200 PERFORM FAIL. ST1264.2 +081300 SORT-WRITE-2-3. ST1264.2 +081400 PERFORM PRINT-DETAIL. ST1264.2 +081500 DUMMY-3-AND-4-3. ST1264.2 +081600 MOVE "SORT-TEST-3-3" TO PAR-NAME. ST1264.2 +081700 MOVE DUM-MY TO RE-MARK. ST1264.2 +081800 PERFORM PRINT-DETAIL. ST1264.2 +081900 MOVE "SORT-TEST-4-3" TO PAR-NAME. ST1264.2 +082000 MOVE DUM-MY TO RE-MARK. ST1264.2 +082100 PERFORM PRINT-DETAIL. ST1264.2 +082200 GO TO CONTINUE-TESTING-3. ST1264.2 +082300 ZERO-IS-LESS-THAN-SPACE-3 SECTION. ST1264.2 +082400 SORT-INIT-C-3. ST1264.2 +082500 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +082600 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +082700 MOVE ZERO TO UTILITY-3. ST1264.2 +082800 DUMMY-1-AND-2-3. ST1264.2 +082900 MOVE "SORT-TEST-1-3" TO PAR-NAME. ST1264.2 +083000 MOVE DUM-MY TO RE-MARK. ST1264.2 +083100 PERFORM PRINT-DETAIL. ST1264.2 +083200 MOVE "SORT-TEST-2-3" TO PAR-NAME. ST1264.2 +083300 MOVE DUM-MY TO RE-MARK. ST1264.2 +083400 PERFORM PRINT-DETAIL. ST1264.2 +083500 SORT-TEST-3-3. ST1264.2 +083600 PERFORM READ-SORTIN-3. ST1264.2 +083700 MOVE "SORT-TEST-3-3" TO PAR-NAME. ST1264.2 +083800 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +083900 PERFORM PASS GO TO SORT-WRITE-3-3. ST1264.2 +084000 SORT-FAIL-3-3. ST1264.2 +084100 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +084200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +084300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +084400 PERFORM PRINT-DETAIL. ST1264.2 +084500 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +084600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +084700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +084800 PERFORM PRINT-DETAIL. ST1264.2 +084900 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +085000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +085100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +085200 PERFORM FAIL. ST1264.2 +085300 SORT-WRITE-3-3. ST1264.2 +085400 PERFORM PRINT-DETAIL. ST1264.2 +085500 SORT-INIT-D-3. ST1264.2 +085600 PERFORM READ-SORTIN-3 4 TIMES. ST1264.2 +085700 MOVE SPACE TO UTILITY-3. ST1264.2 +085800* NOTE SORT-TEST-4-3 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +085900 SORT-TEST-4-3. ST1264.2 +086000 PERFORM READ-SORTIN-3. ST1264.2 +086100 MOVE "SORT-TEST-4-3" TO PAR-NAME. ST1264.2 +086200 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +086300 PERFORM PASS GO TO SORT-WRITE-4-3. ST1264.2 +086400 SORT-FAIL-4-3. ST1264.2 +086500 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +086600 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +086700 MOVE ITEM-3 TO RE-MARK. ST1264.2 +086800 PERFORM PRINT-DETAIL. ST1264.2 +086900 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +087000 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +087100 MOVE ITEM-1 TO RE-MARK. ST1264.2 +087200 PERFORM PRINT-DETAIL. ST1264.2 +087300 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +087400 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +087500 MOVE ITEM-2 TO RE-MARK. ST1264.2 +087600 PERFORM FAIL. ST1264.2 +087700 SORT-WRITE-4-3. ST1264.2 +087800 PERFORM PRINT-DETAIL. ST1264.2 +087900 CONTINUE-TESTING-3 SECTION. ST1264.2 +088000 SORT-INIT-E-3. ST1264.2 +088100 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +088200 MOVE SPACE TO UTILITY-3. ST1264.2 +088300* NOTE SORT-TEST-5-3 CHECKS THE 7TH RECORD IN THE FILE. ST1264.2 +088400 SORT-TEST-5-3. ST1264.2 +088500 PERFORM READ-SORTIN-3. ST1264.2 +088600 MOVE "SORT-TEST-5-3" TO PAR-NAME. ST1264.2 +088700 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +088800 PERFORM PASS GO TO SORT-WRITE-5-3. ST1264.2 +088900 SORT-FAIL-5-3. ST1264.2 +089000 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +089100 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +089200 MOVE ITEM-3 TO RE-MARK. ST1264.2 +089300 PERFORM PRINT-DETAIL. ST1264.2 +089400 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +089500 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +089600 MOVE ITEM-1 TO RE-MARK. ST1264.2 +089700 PERFORM PRINT-DETAIL. ST1264.2 +089800 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +089900 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +090000 MOVE ITEM-2 TO RE-MARK. ST1264.2 +090100 PERFORM FAIL. ST1264.2 +090200 SORT-WRITE-5-3. ST1264.2 +090300 PERFORM PRINT-DETAIL. ST1264.2 +090400 SORT-INIT-F-3. ST1264.2 +090500 PERFORM READ-SORTIN-3. ST1264.2 +090600 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +090700* NOTE SORT-TEST-6-3 CHECKS THE 9TH RECORD IN THE FILE. ST1264.2 +090800 SORT-TEST-6-3. ST1264.2 +090900 PERFORM READ-SORTIN-3. ST1264.2 +091000 MOVE "SORT-TEST-6-3" TO PAR-NAME. ST1264.2 +091100 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +091200 PERFORM PASS GO TO SORT-WRITE-6-3. ST1264.2 +091300 SORT-FAIL-6-3. ST1264.2 +091400 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +091500 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +091600 MOVE ITEM-3 TO RE-MARK. ST1264.2 +091700 PERFORM PRINT-DETAIL. ST1264.2 +091800 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +091900 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +092000 MOVE ITEM-1 TO RE-MARK. ST1264.2 +092100 PERFORM PRINT-DETAIL. ST1264.2 +092200 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +092300 MOVE UTILITY-3 TO CORRECT-18V0. ST1264.2 +092400 MOVE ITEM-2 TO RE-MARK. ST1264.2 +092500 PERFORM FAIL. ST1264.2 +092600 SORT-WRITE-6-3. ST1264.2 +092700 PERFORM PRINT-DETAIL. ST1264.2 +092800 SORT-TEST-7-3. ST1264.2 +092900 READ SORTIN-3G AT END ST1264.2 +093000 PERFORM PASS GO TO SORT-WRITE-7-3. ST1264.2 +093100 SORT-FAIL-7-3. ST1264.2 +093200 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +093300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +093400 PERFORM FAIL. ST1264.2 +093500 SORT-WRITE-7-3. ST1264.2 +093600 MOVE "SORT-TEST-7-3" TO PAR-NAME. ST1264.2 +093700 PERFORM PRINT-DETAIL. ST1264.2 +093800 SORT-TEST-8-3. ST1264.2 +093900 IF UTIL-CTR EQUAL TO 9 ST1264.2 +094000 PERFORM PASS GO TO SORT-WRITE-8-3. ST1264.2 +094100 SORT-FAIL-8-3. ST1264.2 +094200 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +094300 MOVE 9 TO CORRECT-4V14. ST1264.2 +094400 PERFORM FAIL. ST1264.2 +094500 SORT-WRITE-8-3. ST1264.2 +094600 MOVE "SORT-TEST-8-3" TO PAR-NAME. ST1264.2 +094700 PERFORM PRINT-DETAIL. ST1264.2 +094800 CLOSE SORTIN-3G. ST1264.2 +094900 GO TO CCVS-EXIT. ST1264.2 +095000 READ-SORTIN-3. ST1264.2 +095100 READ SORTIN-3G AT END GO TO READ-ERROR-3. ST1264.2 +095200 ADD 1 TO UTIL-CTR. ST1264.2 +095300 READ-ERROR-3. ST1264.2 +095400 MOVE "READ-ERROR-3" TO PAR-NAME. ST1264.2 +095500 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +095600 PERFORM FAIL. ST1264.2 +095700 PERFORM PRINT-DETAIL. ST1264.2 +095800 CCVS-EXIT SECTION. ST1264.2 +095900 CCVS-999999. ST1264.2 +096000 GO TO CLOSE-FILES. ST1264.2 +*END-OF,ST126A +*HEADER,COBOL,ST127A +000100 IDENTIFICATION DIVISION. ST1274.2 +000200 PROGRAM-ID. ST1274.2 +000300 ST127A. ST1274.2 +000400**************************************************************** ST1274.2 +000500* * ST1274.2 +000600* VALIDATION FOR:- * ST1274.2 +000700* * ST1274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +000900* * ST1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1274.2 +001100* * ST1274.2 +001200**************************************************************** ST1274.2 +001300* * ST1274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1274.2 +001500* * ST1274.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1274.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1274.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1274.2 +001900* X-27 - SORT-FILE-NAME-1 * ST1274.2 +002000* * ST1274.2 +002100**************************************************************** ST1274.2 +002200* ST127A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1274.2 +002300* PROCEDURE BUILDS THE 17-RECORD FILE SHOWN BELOW. THE ST1274.2 +002400* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1274.2 +002500* REPORT. ST1274.2 +002600* SORT SORT SORT SORT SORT SORT SORT SORT LAST ST1274.2 +002700* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8 CHAR ST1274.2 +002800* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 PIC XST1274.2 +002900* USAGE JUST JUST USAGE ST1274.2 +003000* COMP RIGHT RIGHT COMP ST1274.2 +003100* ST1274.2 +003200* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 1 ST1274.2 +003300* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003400* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 2 ST1274.2 +003500* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003600* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 3 ST1274.2 +003700* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 4 ST1274.2 +003900* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1274.2 +004000* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 5 ST1274.2 +004100* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1274.2 +004200* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 6 ST1274.2 +004300* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1274.2 +004400* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 7 ST1274.2 +004500* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1274.2 +004600* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 8 ST1274.2 +004700* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1274.2 +004800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 9 ST1274.2 +004900* ST1274.2 +005000* THIS PROGRAM TESTS THE USE OF THE "DUPLICATES" PHRASE OF ST1274.2 +005100* THE "SORT" STATEMENT. THE ORDER OF RECORDS HAVING ST1274.2 +005200* DUPLICATE KEYS AFTER THE EXECUTION OF A "SORT" STATEMENT ST1274.2 +005300* MUST BE THE SAME AS THE ORDER OF THOSE RECORDS ON INPUT ST1274.2 +005400* TO THE "SORT" STATEMENT. ST1274.2 +005500 ST1274.2 +005600 ENVIRONMENT DIVISION. ST1274.2 +005700 CONFIGURATION SECTION. ST1274.2 +005800 SOURCE-COMPUTER. ST1274.2 +005900 XXXXX082. ST1274.2 +006000 OBJECT-COMPUTER. ST1274.2 +006100 XXXXX083. ST1274.2 +006200 INPUT-OUTPUT SECTION. ST1274.2 +006300 FILE-CONTROL. ST1274.2 +006400 SELECT PRINT-FILE ASSIGN TO ST1274.2 +006500 XXXXX055. ST1274.2 +006600 SELECT SORTFILE-1H ASSIGN TO ST1274.2 +006700 XXXXX027. ST1274.2 +006800 DATA DIVISION. ST1274.2 +006900 FILE SECTION. ST1274.2 +007000 FD PRINT-FILE. ST1274.2 +007100 01 PRINT-REC PICTURE X(120). ST1274.2 +007200 01 DUMMY-RECORD PICTURE X(120). ST1274.2 +007300 SD SORTFILE-1H ST1274.2 +007400 DATA RECORD IS SORTFILE-REC. ST1274.2 +007500 01 SORTFILE-REC. ST1274.2 +007600 05 SORT-1. ST1274.2 +007700 10 SORTKEY-8 PICTURE S99 COMPUTATIONAL. ST1274.2 +007800 10 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. ST1274.2 +007900 10 SORTKEY-7 PICTURE 999. ST1274.2 +008000 10 SORTKEY-3 PICTURE SV9(16). ST1274.2 +008100 10 FILLER PICTURE XX. ST1274.2 +008200 10 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1274.2 +008300 10 SORTKEY-6 PICTURE X(10). ST1274.2 +008400 10 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1274.2 +008500 10 SORTKEY-5 PICTURE A(20). ST1274.2 +008600 10 FILLER PICTURE XXX. ST1274.2 +008700 05 SORT-IDENTIFIER PICTURE X. ST1274.2 +008800 WORKING-STORAGE SECTION. ST1274.2 +008900 77 WS-IDENTIFIER PIC 9. ST1274.2 +009000 01 WS-SORTFILE-REC. ST1274.2 +009100 02 WS-8 PICTURE S99 COMPUTATIONAL. ST1274.2 +009200 02 WS-1 PICTURE S9(6) COMPUTATIONAL. ST1274.2 +009300 02 WS-7 PICTURE 999. ST1274.2 +009400 02 WS-3 PICTURE SV9(16). ST1274.2 +009500 02 FILLER PICTURE XX. ST1274.2 +009600 02 WS-4 PICTURE X(10) JUSTIFIED RIGHT. ST1274.2 +009700 02 WS-6 PICTURE X(10). ST1274.2 +009800 02 WS-2 PICTURE A(05) JUSTIFIED RIGHT. ST1274.2 +009900 02 WS-5 PICTURE A(20). ST1274.2 +010000 02 FILLER PICTURE XXX. ST1274.2 +010100 77 UTIL-CTR PICTURE S99999. ST1274.2 +010200 77 SPAC-E PICTURE X VALUE " ". ST1274.2 +010300 01 TEST-RESULTS. ST1274.2 +010400 02 FILLER PIC X VALUE SPACE. ST1274.2 +010500 02 FEATURE PIC X(20) VALUE SPACE. ST1274.2 +010600 02 FILLER PIC X VALUE SPACE. ST1274.2 +010700 02 P-OR-F PIC X(5) VALUE SPACE. ST1274.2 +010800 02 FILLER PIC X VALUE SPACE. ST1274.2 +010900 02 PAR-NAME. ST1274.2 +011000 03 FILLER PIC X(19) VALUE SPACE. ST1274.2 +011100 03 PARDOT-X PIC X VALUE SPACE. ST1274.2 +011200 03 DOTVALUE PIC 99 VALUE ZERO. ST1274.2 +011300 02 FILLER PIC X(8) VALUE SPACE. ST1274.2 +011400 02 RE-MARK PIC X(61). ST1274.2 +011500 01 TEST-COMPUTED. ST1274.2 +011600 02 FILLER PIC X(30) VALUE SPACE. ST1274.2 +011700 02 FILLER PIC X(17) VALUE ST1274.2 +011800 " COMPUTED=". ST1274.2 +011900 02 COMPUTED-X. ST1274.2 +012000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1274.2 +012100 03 COMPUTED-N REDEFINES COMPUTED-A ST1274.2 +012200 PIC -9(9).9(9). ST1274.2 +012300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1274.2 +012400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1274.2 +012500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1274.2 +012600 03 CM-18V0 REDEFINES COMPUTED-A. ST1274.2 +012700 04 COMPUTED-18V0 PIC -9(18). ST1274.2 +012800 04 FILLER PIC X. ST1274.2 +012900 03 FILLER PIC X(50) VALUE SPACE. ST1274.2 +013000 01 TEST-CORRECT. ST1274.2 +013100 02 FILLER PIC X(30) VALUE SPACE. ST1274.2 +013200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1274.2 +013300 02 CORRECT-X. ST1274.2 +013400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1274.2 +013500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1274.2 +013600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1274.2 +013700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1274.2 +013800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1274.2 +013900 03 CR-18V0 REDEFINES CORRECT-A. ST1274.2 +014000 04 CORRECT-18V0 PIC -9(18). ST1274.2 +014100 04 FILLER PIC X. ST1274.2 +014200 03 FILLER PIC X(2) VALUE SPACE. ST1274.2 +014300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1274.2 +014400 01 CCVS-C-1. ST1274.2 +014500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1274.2 +014600- "SS PARAGRAPH-NAME ST1274.2 +014700- " REMARKS". ST1274.2 +014800 02 FILLER PIC X(20) VALUE SPACE. ST1274.2 +014900 01 CCVS-C-2. ST1274.2 +015000 02 FILLER PIC X VALUE SPACE. ST1274.2 +015100 02 FILLER PIC X(6) VALUE "TESTED". ST1274.2 +015200 02 FILLER PIC X(15) VALUE SPACE. ST1274.2 +015300 02 FILLER PIC X(4) VALUE "FAIL". ST1274.2 +015400 02 FILLER PIC X(94) VALUE SPACE. ST1274.2 +015500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1274.2 +015600 01 REC-CT PIC 99 VALUE ZERO. ST1274.2 +015700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1274.2 +015800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1274.2 +015900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1274.2 +016000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1274.2 +016100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1274.2 +016200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1274.2 +016300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1274.2 +016400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1274.2 +016500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1274.2 +016600 01 CCVS-H-1. ST1274.2 +016700 02 FILLER PIC X(39) VALUE SPACES. ST1274.2 +016800 02 FILLER PIC X(42) VALUE ST1274.2 +016900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1274.2 +017000 02 FILLER PIC X(39) VALUE SPACES. ST1274.2 +017100 01 CCVS-H-2A. ST1274.2 +017200 02 FILLER PIC X(40) VALUE SPACE. ST1274.2 +017300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1274.2 +017400 02 FILLER PIC XXXX VALUE ST1274.2 +017500 "4.2 ". ST1274.2 +017600 02 FILLER PIC X(28) VALUE ST1274.2 +017700 " COPY - NOT FOR DISTRIBUTION". ST1274.2 +017800 02 FILLER PIC X(41) VALUE SPACE. ST1274.2 +017900 ST1274.2 +018000 01 CCVS-H-2B. ST1274.2 +018100 02 FILLER PIC X(15) VALUE ST1274.2 +018200 "TEST RESULT OF ". ST1274.2 +018300 02 TEST-ID PIC X(9). ST1274.2 +018400 02 FILLER PIC X(4) VALUE ST1274.2 +018500 " IN ". ST1274.2 +018600 02 FILLER PIC X(12) VALUE ST1274.2 +018700 " HIGH ". ST1274.2 +018800 02 FILLER PIC X(22) VALUE ST1274.2 +018900 " LEVEL VALIDATION FOR ". ST1274.2 +019000 02 FILLER PIC X(58) VALUE ST1274.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +019200 01 CCVS-H-3. ST1274.2 +019300 02 FILLER PIC X(34) VALUE ST1274.2 +019400 " FOR OFFICIAL USE ONLY ". ST1274.2 +019500 02 FILLER PIC X(58) VALUE ST1274.2 +019600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1274.2 +019700 02 FILLER PIC X(28) VALUE ST1274.2 +019800 " COPYRIGHT 1985 ". ST1274.2 +019900 01 CCVS-E-1. ST1274.2 +020000 02 FILLER PIC X(52) VALUE SPACE. ST1274.2 +020100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1274.2 +020200 02 ID-AGAIN PIC X(9). ST1274.2 +020300 02 FILLER PIC X(45) VALUE SPACES. ST1274.2 +020400 01 CCVS-E-2. ST1274.2 +020500 02 FILLER PIC X(31) VALUE SPACE. ST1274.2 +020600 02 FILLER PIC X(21) VALUE SPACE. ST1274.2 +020700 02 CCVS-E-2-2. ST1274.2 +020800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1274.2 +020900 03 FILLER PIC X VALUE SPACE. ST1274.2 +021000 03 ENDER-DESC PIC X(44) VALUE ST1274.2 +021100 "ERRORS ENCOUNTERED". ST1274.2 +021200 01 CCVS-E-3. ST1274.2 +021300 02 FILLER PIC X(22) VALUE ST1274.2 +021400 " FOR OFFICIAL USE ONLY". ST1274.2 +021500 02 FILLER PIC X(12) VALUE SPACE. ST1274.2 +021600 02 FILLER PIC X(58) VALUE ST1274.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +021800 02 FILLER PIC X(13) VALUE SPACE. ST1274.2 +021900 02 FILLER PIC X(15) VALUE ST1274.2 +022000 " COPYRIGHT 1985". ST1274.2 +022100 01 CCVS-E-4. ST1274.2 +022200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1274.2 +022300 02 FILLER PIC X(4) VALUE " OF ". ST1274.2 +022400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1274.2 +022500 02 FILLER PIC X(40) VALUE ST1274.2 +022600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1274.2 +022700 01 XXINFO. ST1274.2 +022800 02 FILLER PIC X(19) VALUE ST1274.2 +022900 "*** INFORMATION ***". ST1274.2 +023000 02 INFO-TEXT. ST1274.2 +023100 04 FILLER PIC X(8) VALUE SPACE. ST1274.2 +023200 04 XXCOMPUTED PIC X(20). ST1274.2 +023300 04 FILLER PIC X(5) VALUE SPACE. ST1274.2 +023400 04 XXCORRECT PIC X(20). ST1274.2 +023500 02 INF-ANSI-REFERENCE PIC X(48). ST1274.2 +023600 01 HYPHEN-LINE. ST1274.2 +023700 02 FILLER PIC IS X VALUE IS SPACE. ST1274.2 +023800 02 FILLER PIC IS X(65) VALUE IS "************************ST1274.2 +023900- "*****************************************". ST1274.2 +024000 02 FILLER PIC IS X(54) VALUE IS "************************ST1274.2 +024100- "******************************". ST1274.2 +024200 01 CCVS-PGM-ID PIC X(9) VALUE ST1274.2 +024300 "ST127A". ST1274.2 +024400 PROCEDURE DIVISION. ST1274.2 +024500 SORT-PARA SECTION. ST1274.2 +024600 SORT-PARAGRAPH. ST1274.2 +024700 MOVE "XI-18 4.4.4 GR(3)b" TO ANSI-REFERENCE. ST1274.2 +024800 SORT SORTFILE-1H ON ST1274.2 +024900 ASCENDING KEY SORTKEY-1 ST1274.2 +025000 ASCENDING SORTKEY-2 ST1274.2 +025100 ASCENDING SORTKEY-3 ST1274.2 +025200 ASCENDING SORTKEY-4 ST1274.2 +025300 ASCENDING SORTKEY-5 ST1274.2 +025400 ASCENDING SORTKEY-6 ST1274.2 +025500 ASCENDING SORTKEY-7 ST1274.2 +025600 ASCENDING SORTKEY-8 ST1274.2 +025700 WITH DUPLICATES IN ORDER ST1274.2 +025800 INPUT PROCEDURE INPROC ST1274.2 +025900 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1274.2 +026000 STOP RUN. ST1274.2 +026100 INPROC SECTION. ST1274.2 +026200 BUILD-FILE. ST1274.2 +026300 MOVE ZERO TO WS-IDENTIFIER. ST1274.2 +026400 PERFORM BUILD-RECORD. ST1274.2 +026500 MOVE SORT-1 TO WS-SORTFILE-REC. ST1274.2 +026600 ADD 1 TO WS-IDENTIFIER. ST1274.2 +026700 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +026800 PERFORM RELEASE-RECORD. ST1274.2 +026900 MOVE +123456 TO SORTKEY-1. ST1274.2 +027000 PERFORM RELEASE-RECORD. ST1274.2 +027100 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +027200 ADD 1 TO WS-IDENTIFIER. ST1274.2 +027300 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +027400 PERFORM RELEASE-RECORD. ST1274.2 +027500 PERFORM BUILD-RECORD. ST1274.2 +027600 MOVE "X" TO SORTKEY-2. ST1274.2 +027700 PERFORM RELEASE-RECORD. ST1274.2 +027800 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +027900 ADD 1 TO WS-IDENTIFIER. ST1274.2 +028000 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +028100 PERFORM RELEASE-RECORD. ST1274.2 +028200 PERFORM BUILD-RECORD. ST1274.2 +028300 MOVE +.6 TO SORTKEY-3. ST1274.2 +028400 PERFORM RELEASE-RECORD. ST1274.2 +028500 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +028600 ADD 1 TO WS-IDENTIFIER. ST1274.2 +028700 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +028800 PERFORM RELEASE-RECORD. ST1274.2 +028900 PERFORM BUILD-RECORD. ST1274.2 +029000 MOVE "X" TO SORTKEY-4. ST1274.2 +029100 PERFORM RELEASE-RECORD. ST1274.2 +029200 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +029300 ADD 1 TO WS-IDENTIFIER. ST1274.2 +029400 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +029500 PERFORM RELEASE-RECORD. ST1274.2 +029600 PERFORM BUILD-RECORD. ST1274.2 +029700 MOVE "Z" TO SORTKEY-5. ST1274.2 +029800 PERFORM RELEASE-RECORD. ST1274.2 +029900 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +030000 ADD 1 TO WS-IDENTIFIER. ST1274.2 +030100 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +030200 PERFORM RELEASE-RECORD. ST1274.2 +030300 PERFORM BUILD-RECORD. ST1274.2 +030400 MOVE "Z" TO SORTKEY-6. ST1274.2 +030500 PERFORM RELEASE-RECORD. ST1274.2 +030600 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +030700 ADD 1 TO WS-IDENTIFIER. ST1274.2 +030800 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +030900 PERFORM RELEASE-RECORD. ST1274.2 +031000 PERFORM BUILD-RECORD. ST1274.2 +031100 MOVE +418 TO SORTKEY-7. ST1274.2 +031200 PERFORM RELEASE-RECORD. ST1274.2 +031300 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +031400 ADD 1 TO WS-IDENTIFIER. ST1274.2 +031500 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +031600 PERFORM RELEASE-RECORD. ST1274.2 +031700 PERFORM BUILD-RECORD. ST1274.2 +031800 MOVE -14 TO SORTKEY-8. ST1274.2 +031900 PERFORM RELEASE-RECORD. ST1274.2 +032000 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +032100 ADD 1 TO WS-IDENTIFIER. ST1274.2 +032200 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +032300 PERFORM RELEASE-RECORD. ST1274.2 +032400 GO TO BUILD-EXIT. ST1274.2 +032500 BUILD-RECORD. ST1274.2 +032600 MOVE -054321 TO SORTKEY-1. ST1274.2 +032700 MOVE "BBB" TO SORTKEY-2. ST1274.2 +032800 MOVE -.1234567890123456 TO SORTKEY-3. ST1274.2 +032900 MOVE "BBBBBB" TO SORTKEY-4. ST1274.2 +033000 MOVE "A" TO SORTKEY-5. ST1274.2 +033100 MOVE "AAAAAAAA" TO SORTKEY-6. ST1274.2 +033200 MOVE -501 TO SORTKEY-7. ST1274.2 +033300* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1274.2 +033400* FIELD. ST1274.2 +033500 MOVE +99 TO SORTKEY-8. ST1274.2 +033600 MOVE SPACE TO SORT-IDENTIFIER. ST1274.2 +033700 RELEASE-RECORD. ST1274.2 +033800 RELEASE SORTFILE-REC. ST1274.2 +033900 BUILD-EXIT. ST1274.2 +034000 EXIT. ST1274.2 +034100 OUTPROC SECTION. ST1274.2 +034200 OPEN-FILES. ST1274.2 +034300 OPEN OUTPUT PRINT-FILE. ST1274.2 +034400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1274.2 +034500 MOVE SPACE TO TEST-RESULTS. ST1274.2 +034600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1274.2 +034700 IF SPAC-E IS LESS THAN "B" ST1274.2 +034800 GO TO SPACE-IS-LESS-THAN-B. ST1274.2 +034900 B-IS-LESS-THAN-SPACE SECTION. ST1274.2 +035000 SORT-INIT-A. ST1274.2 +035100 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +035200* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +035300* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1274.2 +035400* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1274.2 +035500* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1274.2 +035600 SORT-TEST-1. ST1274.2 +035700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +035800 IF SORTKEY-7 EQUAL TO 418 ST1274.2 +035900 PERFORM PASS GO TO SORT-WRITE-1. ST1274.2 +036000 SORT-FAIL-1. ST1274.2 +036100 PERFORM FAIL. ST1274.2 +036200 MOVE SORTKEY-7 TO COMPUTED-N. ST1274.2 +036300 MOVE 418 TO CORRECT-N. ST1274.2 +036400 SORT-WRITE-1. ST1274.2 +036500 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1274.2 +036600 PERFORM PRINT-DETAIL. ST1274.2 +036700 SORT-TEST-2. ST1274.2 +036800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +036900 IF SORTKEY-8 EQUAL TO -14 ST1274.2 +037000 PERFORM PASS GO TO SORT-WRITE-2. ST1274.2 +037100 SORT-FAIL-2. ST1274.2 +037200 PERFORM FAIL. ST1274.2 +037300 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +037400 MOVE -14 TO CORRECT-N. ST1274.2 +037500 SORT-WRITE-2. ST1274.2 +037600 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1274.2 +037700 PERFORM PRINT-DETAIL. ST1274.2 +037800 SORT-TEST-3. ST1274.2 +037900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +038000 IF SORTKEY-6 EQUAL TO "Z " ST1274.2 +038100 PERFORM PASS GO TO SORT-WRITE-3. ST1274.2 +038200 SORT-FAIL-3. ST1274.2 +038300 PERFORM FAIL. ST1274.2 +038400 MOVE SORTKEY-6 TO COMPUTED-A. ST1274.2 +038500 MOVE "Z " TO CORRECT-A. ST1274.2 +038600 SORT-WRITE-3. ST1274.2 +038700 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1274.2 +038800 PERFORM PRINT-DETAIL. ST1274.2 +038900 SORT-TEST-4. ST1274.2 +039000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +039100 IF SORTKEY-5 EQUAL TO "Z " ST1274.2 +039200 PERFORM PASS GO TO SORT-WRITE-4. ST1274.2 +039300 SORT-FAIL-4. ST1274.2 +039400 PERFORM FAIL. ST1274.2 +039500 MOVE SORTKEY-5 TO COMPUTED-A. ST1274.2 +039600 MOVE "Z " TO CORRECT-A. ST1274.2 +039700 SORT-WRITE-4. ST1274.2 +039800 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1274.2 +039900 PERFORM PRINT-DETAIL. ST1274.2 +040000 SORT-TEST-5. ST1274.2 +040100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +040200 IF SORTKEY-4 EQUAL TO " X" ST1274.2 +040300 PERFORM PASS GO TO SORT-WRITE-5. ST1274.2 +040400 SORT-FAIL-5. ST1274.2 +040500 PERFORM FAIL. ST1274.2 +040600 MOVE SORTKEY-4 TO COMPUTED-A. ST1274.2 +040700 MOVE " X" TO CORRECT-A. ST1274.2 +040800 SORT-WRITE-5. ST1274.2 +040900 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1274.2 +041000 PERFORM PRINT-DETAIL. ST1274.2 +041100 SORT-TEST-6. ST1274.2 +041200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +041300 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1274.2 +041400 PERFORM PASS GO TO SORT-WRITE-6. ST1274.2 +041500 SORT-FAIL-6. ST1274.2 +041600 PERFORM FAIL. ST1274.2 +041700 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1274.2 +041800 MOVE +.6000000000000000 TO CORRECT-0V18. ST1274.2 +041900 SORT-WRITE-6. ST1274.2 +042000 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1274.2 +042100 PERFORM PRINT-DETAIL. ST1274.2 +042200 SORT-TEST-7. ST1274.2 +042300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +042400 IF SORTKEY-2 EQUAL TO " X" ST1274.2 +042500 PERFORM PASS GO TO SORT-WRITE-7. ST1274.2 +042600 SORT-FAIL-7. ST1274.2 +042700 PERFORM FAIL. ST1274.2 +042800 MOVE SORTKEY-2 TO COMPUTED-A. ST1274.2 +042900 MOVE " X" TO CORRECT-A. ST1274.2 +043000 SORT-WRITE-7. ST1274.2 +043100 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1274.2 +043200 PERFORM PRINT-DETAIL. ST1274.2 +043300 SORT-TEST-8. ST1274.2 +043400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +043500 IF SORTKEY-1 EQUAL TO +123456 ST1274.2 +043600 PERFORM PASS GO TO SORT-WRITE-8. ST1274.2 +043700 SORT-FAIL-8. ST1274.2 +043800 PERFORM FAIL. ST1274.2 +043900 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +044000 MOVE +123456 TO CORRECT-N. ST1274.2 +044100 SORT-WRITE-8. ST1274.2 +044200 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1274.2 +044300 PERFORM PRINT-DETAIL. ST1274.2 +044400 SORT-REMARK-A. ST1274.2 +044500 MOVE SPACE TO FEATURE. ST1274.2 +044600 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1274.2 +044700 PERFORM PRINT-DETAIL. ST1274.2 +044800 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1274.2 +044900 PERFORM PRINT-DETAIL. ST1274.2 +045000 MOVE "UNNECESSARY." TO RE-MARK. ST1274.2 +045100 PERFORM PRINT-DETAIL. ST1274.2 +045200 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +045300 GO TO CONTINUE-TESTING. ST1274.2 +045400 SPACE-IS-LESS-THAN-B SECTION. ST1274.2 +045500 SORT-REMARK-B. ST1274.2 +045600 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1274.2 +045700 PERFORM PRINT-DETAIL. ST1274.2 +045800 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1274.2 +045900 PERFORM PRINT-DETAIL. ST1274.2 +046000 MOVE "UNNECESSARY." TO RE-MARK. ST1274.2 +046100 PERFORM PRINT-DETAIL. ST1274.2 +046200 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +046300* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +046400* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1274.2 +046500* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1274.2 +046600* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1274.2 +046700 SORT-TEST-9. ST1274.2 +046800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +046900 IF SORTKEY-2 EQUAL TO " X" ST1274.2 +047000 PERFORM PASS GO TO SORT-WRITE-9. ST1274.2 +047100 SORT-FAIL-9. ST1274.2 +047200 PERFORM FAIL. ST1274.2 +047300 MOVE SORTKEY-2 TO COMPUTED-A. ST1274.2 +047400 MOVE " X" TO CORRECT-A. ST1274.2 +047500 SORT-WRITE-9. ST1274.2 +047600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1274.2 +047700 PERFORM PRINT-DETAIL. ST1274.2 +047800* ST1274.2 +047900* PERFORM RETURN-DUPLICATE-RECORDS. ST1274.2 +048000* ST1274.2 +048100 SORT-TEST-10. ST1274.2 +048200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +048300 IF SORTKEY-4 EQUAL TO " X" ST1274.2 +048400 PERFORM PASS GO TO SORT-WRITE-10. ST1274.2 +048500 SORT-FAIL-10. ST1274.2 +048600 PERFORM FAIL. ST1274.2 +048700 MOVE SORTKEY-4 TO COMPUTED-A. ST1274.2 +048800 MOVE " X" TO CORRECT-A. ST1274.2 +048900 SORT-WRITE-10. ST1274.2 +049000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1274.2 +049100 PERFORM PRINT-DETAIL. ST1274.2 +049200 SORT-TEST-11. ST1274.2 +049300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +049400 IF SORTKEY-7 EQUAL TO 418 ST1274.2 +049500 PERFORM PASS GO TO SORT-WRITE-11. ST1274.2 +049600 SORT-FAIL-11. ST1274.2 +049700 PERFORM FAIL. ST1274.2 +049800 MOVE SORTKEY-7 TO COMPUTED-N ST1274.2 +049900 MOVE 418 TO CORRECT-N. ST1274.2 +050000 SORT-WRITE-11. ST1274.2 +050100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1274.2 +050200 PERFORM PRINT-DETAIL. ST1274.2 +050300 SORT-TEST-12. ST1274.2 +050400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +050500 IF SORTKEY-8 EQUAL TO -14 ST1274.2 +050600 PERFORM PASS GO TO SORT-WRITE-12. ST1274.2 +050700 SORT-FAIL-12. ST1274.2 +050800 PERFORM FAIL. ST1274.2 +050900 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +051000 MOVE -14 TO CORRECT-N. ST1274.2 +051100 SORT-WRITE-12. ST1274.2 +051200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1274.2 +051300 PERFORM PRINT-DETAIL. ST1274.2 +051400 PERFORM RETURN-DUPLICATE-RECORDS. ST1274.2 +051500 SORT-TEST-13. ST1274.2 +051600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +051700 IF SORTKEY-6 EQUAL TO "Z " ST1274.2 +051800 PERFORM PASS GO TO SORT-WRITE-13. ST1274.2 +051900 SORT-FAIL-13. ST1274.2 +052000 PERFORM FAIL. ST1274.2 +052100 MOVE SORTKEY-6 TO COMPUTED-A. ST1274.2 +052200 MOVE "Z " TO CORRECT-A. ST1274.2 +052300 SORT-WRITE-13. ST1274.2 +052400 MOVE "SORT-TEST-13" TO PAR-NAME. ST1274.2 +052500 PERFORM PRINT-DETAIL. ST1274.2 +052600 SORT-TEST-14. ST1274.2 +052700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +052800 IF SORTKEY-5 EQUAL TO "Z " ST1274.2 +052900 PERFORM PASS GO TO SORT-WRITE-14. ST1274.2 +053000 SORT-FAIL-14. ST1274.2 +053100 PERFORM FAIL. ST1274.2 +053200 MOVE SORTKEY-5 TO COMPUTED-A. ST1274.2 +053300 MOVE "Z " TO CORRECT-A. ST1274.2 +053400 SORT-WRITE-14. ST1274.2 +053500 MOVE "SORT-TEST-14" TO PAR-NAME. ST1274.2 +053600 PERFORM PRINT-DETAIL. ST1274.2 +053700 SORT-TEST-15. ST1274.2 +053800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +053900 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1274.2 +054000 PERFORM PASS GO TO SORT-WRITE-15. ST1274.2 +054100 SORT-FAIL-15. ST1274.2 +054200 PERFORM FAIL. ST1274.2 +054300 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1274.2 +054400 MOVE +.6000000000000000 TO CORRECT-0V18. ST1274.2 +054500 SORT-WRITE-15. ST1274.2 +054600 MOVE "SORT-TEST-15" TO PAR-NAME. ST1274.2 +054700 PERFORM PRINT-DETAIL. ST1274.2 +054800 SORT-TEST-16. ST1274.2 +054900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +055000 IF SORTKEY-1 EQUAL TO +123456 ST1274.2 +055100 PERFORM PASS GO TO SORT-WRITE-16. ST1274.2 +055200 SORT-FAIL-16. ST1274.2 +055300 PERFORM FAIL. ST1274.2 +055400 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +055500 MOVE +123456 TO CORRECT-N. ST1274.2 +055600 SORT-WRITE-16. ST1274.2 +055700 MOVE "SORT-TEST-16" TO PAR-NAME. ST1274.2 +055800 PERFORM PRINT-DETAIL. ST1274.2 +055900 CONTINUE-TESTING SECTION. ST1274.2 +056000 SORT-TEST-17. ST1274.2 +056100 RETURN SORTFILE-1H AT END ST1274.2 +056200 PERFORM PASS GO TO SORT-WRITE-17. ST1274.2 +056300 SORT-FAIL-17. ST1274.2 +056400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1274.2 +056500 PERFORM FAIL. ST1274.2 +056600 SORT-WRITE-17. ST1274.2 +056700 MOVE "SORT-TEST-17" TO PAR-NAME. ST1274.2 +056800 PERFORM PRINT-DETAIL. ST1274.2 +056900 GO TO OUTPROC-EXIT. ST1274.2 +057000 RETURN-ERROR. ST1274.2 +057100 MOVE "RETURN-ERROR" TO PAR-NAME. ST1274.2 +057200 PERFORM FAIL. ST1274.2 +057300 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1274.2 +057400 PERFORM PRINT-DETAIL. ST1274.2 +057500 GO TO CCVS1-EXIT. ST1274.2 +057600 CLOSE-FILES. ST1274.2 +057700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1274.2 +057800 TERMINATE-CCVS. ST1274.2 +057900S EXIT PROGRAM. ST1274.2 +058000STERMINATE-CALL. ST1274.2 +058100 STOP RUN. ST1274.2 +058200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1274.2 +058300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1274.2 +058400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1274.2 +058500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1274.2 +058600 MOVE "****TEST DELETED****" TO RE-MARK. ST1274.2 +058700 PRINT-DETAIL. ST1274.2 +058800 IF REC-CT NOT EQUAL TO ZERO ST1274.2 +058900 MOVE "." TO PARDOT-X ST1274.2 +059000 MOVE REC-CT TO DOTVALUE. ST1274.2 +059100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1274.2 +059200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1274.2 +059300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1274.2 +059400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1274.2 +059500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1274.2 +059600 MOVE SPACE TO CORRECT-X. ST1274.2 +059700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1274.2 +059800 MOVE SPACE TO RE-MARK. ST1274.2 +059900 HEAD-ROUTINE. ST1274.2 +060000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1274.2 +060300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1274.2 +060400 COLUMN-NAMES-ROUTINE. ST1274.2 +060500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +060600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +060800 END-ROUTINE. ST1274.2 +060900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1274.2 +061000 END-RTN-EXIT. ST1274.2 +061100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +061200 END-ROUTINE-1. ST1274.2 +061300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1274.2 +061400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1274.2 +061500 ADD PASS-COUNTER TO ERROR-HOLD. ST1274.2 +061600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1274.2 +061700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1274.2 +061800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1274.2 +061900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1274.2 +062000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1274.2 +062100 END-ROUTINE-12. ST1274.2 +062200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1274.2 +062300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1274.2 +062400 MOVE "NO " TO ERROR-TOTAL ST1274.2 +062500 ELSE ST1274.2 +062600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1274.2 +062700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1274.2 +062800 PERFORM WRITE-LINE. ST1274.2 +062900 END-ROUTINE-13. ST1274.2 +063000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1274.2 +063100 MOVE "NO " TO ERROR-TOTAL ELSE ST1274.2 +063200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1274.2 +063300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1274.2 +063400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +063500 IF INSPECT-COUNTER EQUAL TO ZERO ST1274.2 +063600 MOVE "NO " TO ERROR-TOTAL ST1274.2 +063700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1274.2 +063800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1274.2 +063900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +064000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +064100 WRITE-LINE. ST1274.2 +064200 ADD 1 TO RECORD-COUNT. ST1274.2 +064300Y IF RECORD-COUNT GREATER 42 ST1274.2 +064400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1274.2 +064500Y MOVE SPACE TO DUMMY-RECORD ST1274.2 +064600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1274.2 +064700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1274.2 +064800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1274.2 +064900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1274.2 +065000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1274.2 +065100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1274.2 +065500Y MOVE ZERO TO RECORD-COUNT. ST1274.2 +065600 PERFORM WRT-LN. ST1274.2 +065700 WRT-LN. ST1274.2 +065800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1274.2 +065900 MOVE SPACE TO DUMMY-RECORD. ST1274.2 +066000 BLANK-LINE-PRINT. ST1274.2 +066100 PERFORM WRT-LN. ST1274.2 +066200 FAIL-ROUTINE. ST1274.2 +066300 IF COMPUTED-X NOT EQUAL TO SPACE ST1274.2 +066400 GO TO FAIL-ROUTINE-WRITE. ST1274.2 +066500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1274.2 +066600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1274.2 +066700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1274.2 +066800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +066900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1274.2 +067000 GO TO FAIL-ROUTINE-EX. ST1274.2 +067100 FAIL-ROUTINE-WRITE. ST1274.2 +067200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1274.2 +067300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1274.2 +067400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1274.2 +067500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1274.2 +067600 FAIL-ROUTINE-EX. EXIT. ST1274.2 +067700 BAIL-OUT. ST1274.2 +067800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1274.2 +067900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1274.2 +068000 BAIL-OUT-WRITE. ST1274.2 +068100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1274.2 +068200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1274.2 +068300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +068400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1274.2 +068500 BAIL-OUT-EX. EXIT. ST1274.2 +068600 CCVS1-EXIT. ST1274.2 +068700 EXIT. ST1274.2 +068800* ST1274.2 +068900 OUTPROC-EXIT SECTION. ST1274.2 +069000 EXIT-ONLY. ST1274.2 +069100 PERFORM CLOSE-FILES. ST1274.2 +069200* ST1274.2 +069300 RETURN-DUPLICATE-RECORDS SECTION. ST1274.2 +069400*================================ ST1274.2 +069500 SORT-INIT-18. ST1274.2 +069600 MOVE "DUPLICATE KEYS" TO FEATURE. ST1274.2 +069700* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +069800* ORDER OF THE LAST CHARACTER OF THE RECORD: ST1274.2 +069900* ---- 1 2 3 4 5 6 7 8 9 --- ST1274.2 +070000 SORT-TEST-18-1. ST1274.2 +070100 MOVE "SORT-TEST-18-1" TO PAR-NAME. ST1274.2 +070200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +070300 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +070400 PERFORM PASS ST1274.2 +070500 PERFORM PRINT-DETAIL ST1274.2 +070600 GO TO SORT-TEST-18-2. ST1274.2 +070700 SORT-FAIL-18-1. ST1274.2 +070800 PERFORM FAIL. ST1274.2 +070900 PERFORM CHECK-KEYS. ST1274.2 +071000 SORT-TEST-18-2. ST1274.2 +071100 MOVE "SORT-TEST-18-2" TO PAR-NAME. ST1274.2 +071200 IF SORT-IDENTIFIER = "1" ST1274.2 +071300 PERFORM PASS ST1274.2 +071400 PERFORM PRINT-DETAIL ST1274.2 +071500 GO TO SORT-TEST-19-1. ST1274.2 +071600 SORT-FAIL-18-2. ST1274.2 +071700 PERFORM FAIL. ST1274.2 +071800 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +071900 MOVE "1" TO CORRECT-X. ST1274.2 +072000 PERFORM PRINT-DETAIL. ST1274.2 +072100* ST1274.2 +072200 SORT-TEST-19-1. ST1274.2 +072300 MOVE "SORT-TEST-19-1" TO PAR-NAME. ST1274.2 +072400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +072500 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +072600 PERFORM PASS ST1274.2 +072700 PERFORM PRINT-DETAIL ST1274.2 +072800 GO TO SORT-TEST-19-2. ST1274.2 +072900 SORT-FAIL-19-1. ST1274.2 +073000 PERFORM FAIL. ST1274.2 +073100 PERFORM CHECK-KEYS. ST1274.2 +073200 SORT-TEST-19-2. ST1274.2 +073300 MOVE "SORT-TEST-19-2" TO PAR-NAME. ST1274.2 +073400 IF SORT-IDENTIFIER = "2" ST1274.2 +073500 PERFORM PASS ST1274.2 +073600 PERFORM PRINT-DETAIL ST1274.2 +073700 GO TO SORT-TEST-20-1. ST1274.2 +073800 SORT-FAIL-19-2. ST1274.2 +073900 PERFORM FAIL. ST1274.2 +074000 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +074100 MOVE "2" TO CORRECT-X. ST1274.2 +074200 PERFORM PRINT-DETAIL. ST1274.2 +074300* ST1274.2 +074400 SORT-TEST-20-1. ST1274.2 +074500 MOVE "SORT-TEST-20-1" TO PAR-NAME. ST1274.2 +074600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +074700 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +074800 PERFORM PASS ST1274.2 +074900 PERFORM PRINT-DETAIL ST1274.2 +075000 GO TO SORT-TEST-20-2. ST1274.2 +075100 SORT-FAIL-20-1. ST1274.2 +075200 PERFORM FAIL. ST1274.2 +075300 PERFORM CHECK-KEYS. ST1274.2 +075400 SORT-TEST-20-2. ST1274.2 +075500 MOVE "SORT-TEST-20-2" TO PAR-NAME. ST1274.2 +075600 IF SORT-IDENTIFIER = "3" ST1274.2 +075700 PERFORM PASS ST1274.2 +075800 PERFORM PRINT-DETAIL ST1274.2 +075900 GO TO SORT-TEST-21-1. ST1274.2 +076000 SORT-FAIL-20-2. ST1274.2 +076100 PERFORM FAIL. ST1274.2 +076200 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +076300 MOVE "3" TO CORRECT-X. ST1274.2 +076400 PERFORM PRINT-DETAIL. ST1274.2 +076500* ST1274.2 +076600 SORT-TEST-21-1. ST1274.2 +076700 MOVE "SORT-TEST-21-1" TO PAR-NAME. ST1274.2 +076800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +076900 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +077000 PERFORM PASS ST1274.2 +077100 PERFORM PRINT-DETAIL ST1274.2 +077200 GO TO SORT-TEST-21-2. ST1274.2 +077300 SORT-FAIL-21-1. ST1274.2 +077400 PERFORM FAIL. ST1274.2 +077500 PERFORM CHECK-KEYS. ST1274.2 +077600 SORT-TEST-21-2. ST1274.2 +077700 MOVE "SORT-TEST-21-2" TO PAR-NAME. ST1274.2 +077800 IF SORT-IDENTIFIER = "4" ST1274.2 +077900 PERFORM PASS ST1274.2 +078000 PERFORM PRINT-DETAIL ST1274.2 +078100 GO TO SORT-TEST-22-1. ST1274.2 +078200 SORT-FAIL-21-2. ST1274.2 +078300 PERFORM FAIL. ST1274.2 +078400 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +078500 MOVE "4" TO CORRECT-X. ST1274.2 +078600 PERFORM PRINT-DETAIL. ST1274.2 +078700* ST1274.2 +078800 SORT-TEST-22-1. ST1274.2 +078900 MOVE "SORT-TEST-22-1" TO PAR-NAME. ST1274.2 +079000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +079100 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +079200 PERFORM PASS ST1274.2 +079300 PERFORM PRINT-DETAIL ST1274.2 +079400 GO TO SORT-TEST-22-2. ST1274.2 +079500 SORT-FAIL-22-1. ST1274.2 +079600 PERFORM FAIL. ST1274.2 +079700 PERFORM CHECK-KEYS. ST1274.2 +079800 SORT-TEST-22-2. ST1274.2 +079900 MOVE "SORT-TEST-22-2" TO PAR-NAME. ST1274.2 +080000 IF SORT-IDENTIFIER = "5" ST1274.2 +080100 PERFORM PASS ST1274.2 +080200 PERFORM PRINT-DETAIL ST1274.2 +080300 GO TO SORT-TEST-23-1. ST1274.2 +080400 SORT-FAIL-22-2. ST1274.2 +080500 PERFORM FAIL. ST1274.2 +080600 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +080700 MOVE "5" TO CORRECT-X. ST1274.2 +080800 PERFORM PRINT-DETAIL. ST1274.2 +080900* ST1274.2 +081000 SORT-TEST-23-1. ST1274.2 +081100 MOVE "SORT-TEST-23-1" TO PAR-NAME. ST1274.2 +081200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +081300 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +081400 PERFORM PASS ST1274.2 +081500 PERFORM PRINT-DETAIL ST1274.2 +081600 GO TO SORT-TEST-23-2. ST1274.2 +081700 SORT-FAIL-23-1. ST1274.2 +081800 PERFORM FAIL. ST1274.2 +081900 PERFORM CHECK-KEYS. ST1274.2 +082000 SORT-TEST-23-2. ST1274.2 +082100 MOVE "SORT-TEST-23-2" TO PAR-NAME. ST1274.2 +082200 IF SORT-IDENTIFIER = "6" ST1274.2 +082300 PERFORM PASS ST1274.2 +082400 PERFORM PRINT-DETAIL ST1274.2 +082500 GO TO SORT-TEST-24-1. ST1274.2 +082600 SORT-FAIL-23-2. ST1274.2 +082700 PERFORM FAIL. ST1274.2 +082800 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +082900 MOVE "6" TO CORRECT-X. ST1274.2 +083000 PERFORM PRINT-DETAIL. ST1274.2 +083100* ST1274.2 +083200 SORT-TEST-24-1. ST1274.2 +083300 MOVE "SORT-TEST-24-1" TO PAR-NAME. ST1274.2 +083400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +083500 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +083600 PERFORM PASS ST1274.2 +083700 PERFORM PRINT-DETAIL ST1274.2 +083800 GO TO SORT-TEST-24-2. ST1274.2 +083900 SORT-FAIL-24-1. ST1274.2 +084000 PERFORM FAIL. ST1274.2 +084100 PERFORM CHECK-KEYS. ST1274.2 +084200 SORT-TEST-24-2. ST1274.2 +084300 MOVE "SORT-TEST-24-2" TO PAR-NAME. ST1274.2 +084400 IF SORT-IDENTIFIER = "7" ST1274.2 +084500 PERFORM PASS ST1274.2 +084600 PERFORM PRINT-DETAIL ST1274.2 +084700 GO TO SORT-TEST-25-1. ST1274.2 +084800 SORT-FAIL-24-2. ST1274.2 +084900 PERFORM FAIL. ST1274.2 +085000 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +085100 MOVE "7" TO CORRECT-X. ST1274.2 +085200 PERFORM PRINT-DETAIL. ST1274.2 +085300* ST1274.2 +085400 SORT-TEST-25-1. ST1274.2 +085500 MOVE "SORT-TEST-25-1" TO PAR-NAME. ST1274.2 +085600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +085700 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +085800 PERFORM PASS ST1274.2 +085900 PERFORM PRINT-DETAIL ST1274.2 +086000 GO TO SORT-TEST-25-2. ST1274.2 +086100 SORT-FAIL-25-1. ST1274.2 +086200 PERFORM FAIL. ST1274.2 +086300 PERFORM CHECK-KEYS. ST1274.2 +086400 SORT-TEST-25-2. ST1274.2 +086500 MOVE "SORT-TEST-25-2" TO PAR-NAME. ST1274.2 +086600 IF SORT-IDENTIFIER = "8" ST1274.2 +086700 PERFORM PASS ST1274.2 +086800 PERFORM PRINT-DETAIL ST1274.2 +086900 GO TO SORT-TEST-26-1. ST1274.2 +087000 SORT-FAIL-25-2. ST1274.2 +087100 PERFORM FAIL. ST1274.2 +087200 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +087300 MOVE "8" TO CORRECT-X. ST1274.2 +087400 PERFORM PRINT-DETAIL. ST1274.2 +087500* ST1274.2 +087600 SORT-TEST-26-1. ST1274.2 +087700 MOVE "SORT-TEST-26-1" TO PAR-NAME. ST1274.2 +087800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +087900 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +088000 PERFORM PASS ST1274.2 +088100 PERFORM PRINT-DETAIL ST1274.2 +088200 GO TO SORT-TEST-26-2. ST1274.2 +088300 SORT-FAIL-26-1. ST1274.2 +088400 PERFORM FAIL. ST1274.2 +088500 PERFORM CHECK-KEYS. ST1274.2 +088600 SORT-TEST-26-2. ST1274.2 +088700 MOVE "SORT-TEST-26-2" TO PAR-NAME. ST1274.2 +088800 IF SORT-IDENTIFIER = "9" ST1274.2 +088900 PERFORM PASS ST1274.2 +089000 PERFORM PRINT-DETAIL ST1274.2 +089100 GO TO DUPLICATE-RECORD-EXIT. ST1274.2 +089200 SORT-FAIL-26-2. ST1274.2 +089300 PERFORM FAIL. ST1274.2 +089400 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +089500 MOVE "9" TO CORRECT-X. ST1274.2 +089600 PERFORM PRINT-DETAIL. ST1274.2 +089700 ST1274.2 +089800* ST1274.2 +089900 DUPLICATE-RECORD-EXIT. ST1274.2 +090000 EXIT. ST1274.2 +090100* ST1274.2 +090200* ST1274.2 +090300 CHECK-KEYS SECTION. ST1274.2 +090400*================== ST1274.2 +090500 CHK-TEST-1. ST1274.2 +090600 MOVE "CHK-TEST-1" TO PAR-NAME. ST1274.2 +090700 IF SORTKEY-1 = WS-1 ST1274.2 +090800 PERFORM PASS ST1274.2 +090900 PERFORM PRINT-DETAIL ST1274.2 +091000 GO TO CHK-TEST-2. ST1274.2 +091100 CHK-FAIL-1. ST1274.2 +091200 PERFORM FAIL. ST1274.2 +091300 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +091400 MOVE WS-1 TO CORRECT-N. ST1274.2 +091500 PERFORM PRINT-DETAIL. ST1274.2 +091600* ST1274.2 +091700 CHK-TEST-2. ST1274.2 +091800 MOVE "CHK-TEST-2" TO PAR-NAME. ST1274.2 +091900 IF SORTKEY-2 = WS-2 ST1274.2 +092000 PERFORM PASS ST1274.2 +092100 PERFORM PRINT-DETAIL ST1274.2 +092200 GO TO CHK-TEST-3. ST1274.2 +092300 CHK-FAIL-2. ST1274.2 +092400 PERFORM FAIL. ST1274.2 +092500 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +092600 MOVE WS-1 TO CORRECT-N. ST1274.2 +092700 PERFORM PRINT-DETAIL. ST1274.2 +092800* ST1274.2 +092900 CHK-TEST-3. ST1274.2 +093000 MOVE "CHK-TEST-3" TO PAR-NAME. ST1274.2 +093100 IF SORTKEY-3 = WS-3 ST1274.2 +093200 PERFORM PASS ST1274.2 +093300 PERFORM PRINT-DETAIL ST1274.2 +093400 GO TO CHK-TEST-4. ST1274.2 +093500 CHK-FAIL-3. ST1274.2 +093600 PERFORM FAIL. ST1274.2 +093700 MOVE SORTKEY-3 TO COMPUTED-X. ST1274.2 +093800 MOVE WS-1 TO CORRECT-X. ST1274.2 +093900 PERFORM PRINT-DETAIL. ST1274.2 +094000* ST1274.2 +094100 CHK-TEST-4. ST1274.2 +094200 MOVE "CHK-TEST-4" TO PAR-NAME. ST1274.2 +094300 IF SORTKEY-4 = WS-4 ST1274.2 +094400 PERFORM PASS ST1274.2 +094500 PERFORM PRINT-DETAIL ST1274.2 +094600 GO TO CHK-TEST-5. ST1274.2 +094700 CHK-FAIL-4. ST1274.2 +094800 PERFORM FAIL. ST1274.2 +094900 MOVE SORTKEY-4 TO COMPUTED-X. ST1274.2 +095000 MOVE WS-4 TO CORRECT-X. ST1274.2 +095100 PERFORM PRINT-DETAIL. ST1274.2 +095200 ST1274.2 +095300 CHK-TEST-5. ST1274.2 +095400 MOVE "CHK-TEST-5" TO PAR-NAME. ST1274.2 +095500 IF SORTKEY-5 = WS-5 ST1274.2 +095600 PERFORM PASS ST1274.2 +095700 PERFORM PRINT-DETAIL ST1274.2 +095800 GO TO CHK-TEST-6. ST1274.2 +095900 CHK-FAIL-5. ST1274.2 +096000 PERFORM FAIL. ST1274.2 +096100 MOVE SORTKEY-5 TO COMPUTED-X. ST1274.2 +096200 MOVE WS-5 TO CORRECT-X. ST1274.2 +096300 PERFORM PRINT-DETAIL. ST1274.2 +096400* ST1274.2 +096500 CHK-TEST-6. ST1274.2 +096600 MOVE "CHK-TEST-6" TO PAR-NAME. ST1274.2 +096700 IF SORTKEY-6 = WS-6 ST1274.2 +096800 PERFORM PASS ST1274.2 +096900 PERFORM PRINT-DETAIL ST1274.2 +097000 GO TO CHK-TEST-7. ST1274.2 +097100 CHK-FAIL-6. ST1274.2 +097200 PERFORM FAIL. ST1274.2 +097300 MOVE SORTKEY-6 TO COMPUTED-X. ST1274.2 +097400 MOVE WS-6 TO CORRECT-X. ST1274.2 +097500 PERFORM PRINT-DETAIL. ST1274.2 +097600* ST1274.2 +097700 CHK-TEST-7. ST1274.2 +097800 MOVE "CHK-TEST-7" TO PAR-NAME. ST1274.2 +097900 IF SORTKEY-7 = WS-7 ST1274.2 +098000 PERFORM PASS ST1274.2 +098100 PERFORM PRINT-DETAIL ST1274.2 +098200 GO TO CHK-TEST-8. ST1274.2 +098300 CHK-FAIL-7. ST1274.2 +098400 PERFORM FAIL. ST1274.2 +098500 MOVE SORTKEY-7 TO COMPUTED-X. ST1274.2 +098600 MOVE WS-7 TO CORRECT-X. ST1274.2 +098700 PERFORM PRINT-DETAIL. ST1274.2 +098800* ST1274.2 +098900 CHK-TEST-8. ST1274.2 +099000 MOVE "CHK-TEST-8" TO PAR-NAME. ST1274.2 +099100 IF SORTKEY-8 = WS-8 ST1274.2 +099200 PERFORM PASS ST1274.2 +099300 PERFORM PRINT-DETAIL ST1274.2 +099400 GO TO CHECK-KEYS-EXIT. ST1274.2 +099500 CHK-FAIL-8. ST1274.2 +099600 PERFORM FAIL. ST1274.2 +099700 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +099800 MOVE WS-8 TO CORRECT-N. ST1274.2 +099900 PERFORM PRINT-DETAIL. ST1274.2 +100000 CHECK-KEYS-EXIT. ST1274.2 +100100 EXIT. ST1274.2 +*END-OF,ST127A +*HEADER,COBOL,ST131A +000100 IDENTIFICATION DIVISION. ST1314.2 +000200 PROGRAM-ID. ST1314.2 +000300 ST131A. ST1314.2 +000400**************************************************************** ST1314.2 +000500* * ST1314.2 +000600* VALIDATION FOR:- * ST1314.2 +000700* * ST1314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +000900* * ST1314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1314.2 +001100* * ST1314.2 +001200**************************************************************** ST1314.2 +001300* * ST1314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1314.2 +001500* * ST1314.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1314.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1314.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1314.2 +001900* * ST1314.2 +002000**************************************************************** ST1314.2 +002100* THIS PROGRAM CONTAINS 3 SORTS USING NUMERIC OR ALPHABETIC ST1314.2 +002200* KEYS - BUT NOT BOTH IN THE SAME KEY DUE TO DIFFERING ST1314.2 +002300* COLLATING SEQUENCES AMONG COMPUTERS. EXTERNAL FILES ARE ST1314.2 +002400* GENERATED INTERNALLY FOR SUBSEQUENT USE. THE SELECT CLAUSE ST1314.2 +002500* IS HIGHLY DEPENDENT ON HARDWARE. THE USER SHOULD EXERCISE THEST1314.2 +002600* VARIOUS OPTIONS OF HARDWARE ASSIGNMENTS TO THE EXTENT THEY ST1314.2 +002700* ARE AVAILABLE. THE SORT OF A MULTI-REEL FILE IS EXERCISED ST1314.2 +002800* IN PROGRAM ST202. HOWEVER THE EXERCISE OF THE "FOR MULTIPLE ST1314.2 +002900* REEL-UNIT" OF THE GIVING OPTION IS NOT DUE TO THE INDETER- ST1314.2 +003000* MINATE LENGTH OF SUCH A FILE (E.G. RECORDING DENSITY OR SIZE ST1314.2 +003100* OF UNIT) AND PROCESSING COST. SORT INPUT-OUTPUT OPTIONS ST1314.2 +003200* WILL BE EXERCISED AS FOLLOWS. ST1314.2 +003300* SORT 1 USING GIVING ST1314.2 +003400* SORT 2 INPUT PROC GIVING ST1314.2 +003500* SORT 3 INPUT PROC OUTPUT PROC ST1314.2 +003600 ST1314.2 +003700 ENVIRONMENT DIVISION. ST1314.2 +003800 CONFIGURATION SECTION. ST1314.2 +003900 SOURCE-COMPUTER. ST1314.2 +004000 XXXXX082. ST1314.2 +004100 OBJECT-COMPUTER. ST1314.2 +004200 XXXXX083. ST1314.2 +004300 INPUT-OUTPUT SECTION. ST1314.2 +004400 FILE-CONTROL. ST1314.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1314.2 +004600 XXXXX055. ST1314.2 +004700 SELECT SORT1 ASSIGN TO ST1314.2 +004800 XXXXX027. ST1314.2 +004900 SELECT SORT2 ASSIGN TO ST1314.2 +005000 XXXXX028. ST1314.2 +005100 SELECT SORT3 ASSIGN TO ST1314.2 +005200 XXXXX029. ST1314.2 +005300 SELECT FILE1 ASSIGN TO ST1314.2 +005400 XXXXX001. ST1314.2 +005500 SELECT FILE2 ASSIGN TO ST1314.2 +005600 XXXXX014. ST1314.2 +005700 SELECT FILE3 ASSIGN TO ST1314.2 +005800 XXXXX015. ST1314.2 +005900 I-O-CONTROL. ST1314.2 +006000 SAME RECORD AREA FOR SORT1 SORT2 ST1314.2 +006100 SAME RECORD AREA FOR SORT3 FILE3. ST1314.2 +006200 DATA DIVISION. ST1314.2 +006300 FILE SECTION. ST1314.2 +006400 FD PRINT-FILE. ST1314.2 +006500 01 PRINT-REC PICTURE X(120). ST1314.2 +006600 01 DUMMY-RECORD PICTURE X(120). ST1314.2 +006700 FD FILE1 ST1314.2 +006800C LABEL RECORDS ARE STANDARD ST1314.2 +006900C VALUE OF ST1314.2 +007000C XXXXX074 ST1314.2 +007100C IS ST1314.2 +007200C XXXXX075 ST1314.2 +007300 BLOCK CONTAINS 10 RECORDS ST1314.2 +007400C DATA RECORD R1 ST1314.2 +007500 . ST1314.2 +007600 01 R1. ST1314.2 +007700 02 FILLER PICTURE X(120). ST1314.2 +007800 FD FILE2 ST1314.2 +007900C LABEL RECORDS ARE STANDARD ST1314.2 +008000C VALUE OF ST1314.2 +008100C XXXXX074 ST1314.2 +008200C IS ST1314.2 +008300C XXXXX076 ST1314.2 +008400 BLOCK CONTAINS 10 RECORDS ST1314.2 +008500C DATA RECORD R2 ST1314.2 +008600 . ST1314.2 +008700 01 R2. ST1314.2 +008800 02 R2-KEYS. ST1314.2 +008900 03 R2-1 PICTURE 999. ST1314.2 +009000 03 R2-2 PICTURE AA. ST1314.2 +009100 03 R2-3 PICTURE AA. ST1314.2 +009200 02 FILLER PICTURE X(113). ST1314.2 +009300 FD FILE3 ST1314.2 +009400 BLOCK CONTAINS 10 RECORDS ST1314.2 +009500C LABEL RECORDS ARE STANDARD ST1314.2 +009600C VALUE OF ST1314.2 +009700C XXXXX074 ST1314.2 +009800C IS ST1314.2 +009900C XXXXX077 ST1314.2 +010000C DATA RECORD IS R3 ST1314.2 +010100 . ST1314.2 +010200 01 R3. ST1314.2 +010300 02 R3-KEYS. ST1314.2 +010400 03 R3-1 PICTURE 999. ST1314.2 +010500 03 R3-2 PICTURE AA. ST1314.2 +010600 03 R3-3 PICTURE AA. ST1314.2 +010700 03 R3-4 PICTURE 9999. ST1314.2 +010800 02 FILLER PICTURE X(109). ST1314.2 +010900 SD SORT1 ST1314.2 +011000 RECORD CONTAINS 120 CHARACTERS ST1314.2 +011100 DATA RECORD IS S1. ST1314.2 +011200 01 S1. ST1314.2 +011300 02 S1-KEYS. ST1314.2 +011400 03 S1-1 PICTURE 999. ST1314.2 +011500 03 S1-2 PICTURE AA. ST1314.2 +011600 02 FILLER PICTURE X(115). ST1314.2 +011700 SD SORT2 ST1314.2 +011800 RECORD 120 ST1314.2 +011900 DATA RECORD IS S2. ST1314.2 +012000 01 S2. ST1314.2 +012100 02 S2-KEYS. ST1314.2 +012200 03 S2-1 PICTURE 999. ST1314.2 +012300 03 S2-2 PICTURE AA. ST1314.2 +012400 03 S2-3 PICTURE AA. ST1314.2 +012500 02 FILLER PICTURE X(113). ST1314.2 +012600 SD SORT3 ST1314.2 +012700 RECORD 120 CHARACTERS ST1314.2 +012800 DATA RECORD S3. ST1314.2 +012900 01 S3. ST1314.2 +013000 02 S3-KEYS. ST1314.2 +013100 03 S3-1 PICTURE 999. ST1314.2 +013200 03 S3-2 PICTURE AA. ST1314.2 +013300 03 S3-3 PICTURE AA. ST1314.2 +013400 03 S3-4 PICTURE 9999. ST1314.2 +013500 02 FILLER PICTURE X(109). ST1314.2 +013600 WORKING-STORAGE SECTION. ST1314.2 +013700 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1314.2 +013800 77 C0 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1314.2 +013900 77 C1 PICTURE 99 COMPUTATIONAL VALUE 1. ST1314.2 +014000 77 CA PICTURE A VALUE "A". ST1314.2 +014100 77 CB PICTURE A VALUE "B". ST1314.2 +014200 01 ALPHA-TABLE. ST1314.2 +014300 02 ALPHA-TAB PICTURE IS A(25) VALUE IS "ABCDEFGHIJKLMNPQRSTUST1314.2 +014400- "VWXYZ". ST1314.2 +014500 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. ST1314.2 +014600 01 W-KEYS. ST1314.2 +014700 02 W-S3-KEYS. ST1314.2 +014800 03 W-S2-KEYS. ST1314.2 +014900 04 W-S1-KEYS. ST1314.2 +015000 05 S1-1W PICTURE 999 VALUE 567. ST1314.2 +015100 05 S1-2W. ST1314.2 +015200 06 S1-2W-A PICTURE A. ST1314.2 +015300 06 S1-2W-B PICTURE A. ST1314.2 +015400 04 S2-3W. ST1314.2 +015500 05 S2-3W-A PICTURE A. ST1314.2 +015600 05 S2-3W-B PICTURE A. ST1314.2 +015700 03 S3-4W PICTURE 9999 VALUE 7051. ST1314.2 +015800 01 FILE-RECORD-INFORMATION-REC. ST1314.2 +015900 03 FILE-RECORD-INFO-SKELETON. ST1314.2 +016000 05 FILLER PICTURE X(48) VALUE ST1314.2 +016100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1314.2 +016200 05 FILLER PICTURE X(46) VALUE ST1314.2 +016300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1314.2 +016400 05 FILLER PICTURE X(26) VALUE ST1314.2 +016500 ",LFIL=000000,ORG= ,LBLR= ". ST1314.2 +016600 05 FILLER PICTURE X(37) VALUE ST1314.2 +016700 ",RECKEY= ". ST1314.2 +016800 05 FILLER PICTURE X(38) VALUE ST1314.2 +016900 ",ALTKEY1= ". ST1314.2 +017000 05 FILLER PICTURE X(38) VALUE ST1314.2 +017100 ",ALTKEY2= ". ST1314.2 +017200 05 FILLER PICTURE X(7) VALUE SPACE.ST1314.2 +017300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1314.2 +017400 05 FILE-RECORD-INFO-P1-120. ST1314.2 +017500 07 FILLER PIC X(5). ST1314.2 +017600 07 XFILE-NAME PIC X(6). ST1314.2 +017700 07 FILLER PIC X(8). ST1314.2 +017800 07 XRECORD-NAME PIC X(6). ST1314.2 +017900 07 FILLER PIC X(1). ST1314.2 +018000 07 REELUNIT-NUMBER PIC 9(1). ST1314.2 +018100 07 FILLER PIC X(7). ST1314.2 +018200 07 XRECORD-NUMBER PIC 9(6). ST1314.2 +018300 07 FILLER PIC X(6). ST1314.2 +018400 07 UPDATE-NUMBER PIC 9(2). ST1314.2 +018500 07 FILLER PIC X(5). ST1314.2 +018600 07 ODO-NUMBER PIC 9(4). ST1314.2 +018700 07 FILLER PIC X(5). ST1314.2 +018800 07 XPROGRAM-NAME PIC X(5). ST1314.2 +018900 07 FILLER PIC X(7). ST1314.2 +019000 07 XRECORD-LENGTH PIC 9(6). ST1314.2 +019100 07 FILLER PIC X(7). ST1314.2 +019200 07 CHARS-OR-RECORDS PIC X(2). ST1314.2 +019300 07 FILLER PIC X(1). ST1314.2 +019400 07 XBLOCK-SIZE PIC 9(4). ST1314.2 +019500 07 FILLER PIC X(6). ST1314.2 +019600 07 RECORDS-IN-FILE PIC 9(6). ST1314.2 +019700 07 FILLER PIC X(5). ST1314.2 +019800 07 XFILE-ORGANIZATION PIC X(2). ST1314.2 +019900 07 FILLER PIC X(6). ST1314.2 +020000 07 XLABEL-TYPE PIC X(1). ST1314.2 +020100 05 FILE-RECORD-INFO-P121-240. ST1314.2 +020200 07 FILLER PIC X(8). ST1314.2 +020300 07 XRECORD-KEY PIC X(29). ST1314.2 +020400 07 FILLER PIC X(9). ST1314.2 +020500 07 ALTERNATE-KEY1 PIC X(29). ST1314.2 +020600 07 FILLER PIC X(9). ST1314.2 +020700 07 ALTERNATE-KEY2 PIC X(29). ST1314.2 +020800 07 FILLER PIC X(7). ST1314.2 +020900 01 TEST-RESULTS. ST1314.2 +021000 02 FILLER PIC X VALUE SPACE. ST1314.2 +021100 02 FEATURE PIC X(20) VALUE SPACE. ST1314.2 +021200 02 FILLER PIC X VALUE SPACE. ST1314.2 +021300 02 P-OR-F PIC X(5) VALUE SPACE. ST1314.2 +021400 02 FILLER PIC X VALUE SPACE. ST1314.2 +021500 02 PAR-NAME. ST1314.2 +021600 03 FILLER PIC X(19) VALUE SPACE. ST1314.2 +021700 03 PARDOT-X PIC X VALUE SPACE. ST1314.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. ST1314.2 +021900 02 FILLER PIC X(8) VALUE SPACE. ST1314.2 +022000 02 RE-MARK PIC X(61). ST1314.2 +022100 01 TEST-COMPUTED. ST1314.2 +022200 02 FILLER PIC X(30) VALUE SPACE. ST1314.2 +022300 02 FILLER PIC X(17) VALUE ST1314.2 +022400 " COMPUTED=". ST1314.2 +022500 02 COMPUTED-X. ST1314.2 +022600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1314.2 +022700 03 COMPUTED-N REDEFINES COMPUTED-A ST1314.2 +022800 PIC -9(9).9(9). ST1314.2 +022900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1314.2 +023000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1314.2 +023100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1314.2 +023200 03 CM-18V0 REDEFINES COMPUTED-A. ST1314.2 +023300 04 COMPUTED-18V0 PIC -9(18). ST1314.2 +023400 04 FILLER PIC X. ST1314.2 +023500 03 FILLER PIC X(50) VALUE SPACE. ST1314.2 +023600 01 TEST-CORRECT. ST1314.2 +023700 02 FILLER PIC X(30) VALUE SPACE. ST1314.2 +023800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1314.2 +023900 02 CORRECT-X. ST1314.2 +024000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1314.2 +024100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1314.2 +024200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1314.2 +024300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1314.2 +024400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1314.2 +024500 03 CR-18V0 REDEFINES CORRECT-A. ST1314.2 +024600 04 CORRECT-18V0 PIC -9(18). ST1314.2 +024700 04 FILLER PIC X. ST1314.2 +024800 03 FILLER PIC X(2) VALUE SPACE. ST1314.2 +024900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1314.2 +025000 01 CCVS-C-1. ST1314.2 +025100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1314.2 +025200- "SS PARAGRAPH-NAME ST1314.2 +025300- " REMARKS". ST1314.2 +025400 02 FILLER PIC X(20) VALUE SPACE. ST1314.2 +025500 01 CCVS-C-2. ST1314.2 +025600 02 FILLER PIC X VALUE SPACE. ST1314.2 +025700 02 FILLER PIC X(6) VALUE "TESTED". ST1314.2 +025800 02 FILLER PIC X(15) VALUE SPACE. ST1314.2 +025900 02 FILLER PIC X(4) VALUE "FAIL". ST1314.2 +026000 02 FILLER PIC X(94) VALUE SPACE. ST1314.2 +026100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1314.2 +026200 01 REC-CT PIC 99 VALUE ZERO. ST1314.2 +026300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1314.2 +026800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1314.2 +026900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1314.2 +027000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1314.2 +027100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1314.2 +027200 01 CCVS-H-1. ST1314.2 +027300 02 FILLER PIC X(39) VALUE SPACES. ST1314.2 +027400 02 FILLER PIC X(42) VALUE ST1314.2 +027500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1314.2 +027600 02 FILLER PIC X(39) VALUE SPACES. ST1314.2 +027700 01 CCVS-H-2A. ST1314.2 +027800 02 FILLER PIC X(40) VALUE SPACE. ST1314.2 +027900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1314.2 +028000 02 FILLER PIC XXXX VALUE ST1314.2 +028100 "4.2 ". ST1314.2 +028200 02 FILLER PIC X(28) VALUE ST1314.2 +028300 " COPY - NOT FOR DISTRIBUTION". ST1314.2 +028400 02 FILLER PIC X(41) VALUE SPACE. ST1314.2 +028500 ST1314.2 +028600 01 CCVS-H-2B. ST1314.2 +028700 02 FILLER PIC X(15) VALUE ST1314.2 +028800 "TEST RESULT OF ". ST1314.2 +028900 02 TEST-ID PIC X(9). ST1314.2 +029000 02 FILLER PIC X(4) VALUE ST1314.2 +029100 " IN ". ST1314.2 +029200 02 FILLER PIC X(12) VALUE ST1314.2 +029300 " HIGH ". ST1314.2 +029400 02 FILLER PIC X(22) VALUE ST1314.2 +029500 " LEVEL VALIDATION FOR ". ST1314.2 +029600 02 FILLER PIC X(58) VALUE ST1314.2 +029700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +029800 01 CCVS-H-3. ST1314.2 +029900 02 FILLER PIC X(34) VALUE ST1314.2 +030000 " FOR OFFICIAL USE ONLY ". ST1314.2 +030100 02 FILLER PIC X(58) VALUE ST1314.2 +030200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1314.2 +030300 02 FILLER PIC X(28) VALUE ST1314.2 +030400 " COPYRIGHT 1985 ". ST1314.2 +030500 01 CCVS-E-1. ST1314.2 +030600 02 FILLER PIC X(52) VALUE SPACE. ST1314.2 +030700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1314.2 +030800 02 ID-AGAIN PIC X(9). ST1314.2 +030900 02 FILLER PIC X(45) VALUE SPACES. ST1314.2 +031000 01 CCVS-E-2. ST1314.2 +031100 02 FILLER PIC X(31) VALUE SPACE. ST1314.2 +031200 02 FILLER PIC X(21) VALUE SPACE. ST1314.2 +031300 02 CCVS-E-2-2. ST1314.2 +031400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1314.2 +031500 03 FILLER PIC X VALUE SPACE. ST1314.2 +031600 03 ENDER-DESC PIC X(44) VALUE ST1314.2 +031700 "ERRORS ENCOUNTERED". ST1314.2 +031800 01 CCVS-E-3. ST1314.2 +031900 02 FILLER PIC X(22) VALUE ST1314.2 +032000 " FOR OFFICIAL USE ONLY". ST1314.2 +032100 02 FILLER PIC X(12) VALUE SPACE. ST1314.2 +032200 02 FILLER PIC X(58) VALUE ST1314.2 +032300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +032400 02 FILLER PIC X(13) VALUE SPACE. ST1314.2 +032500 02 FILLER PIC X(15) VALUE ST1314.2 +032600 " COPYRIGHT 1985". ST1314.2 +032700 01 CCVS-E-4. ST1314.2 +032800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1314.2 +032900 02 FILLER PIC X(4) VALUE " OF ". ST1314.2 +033000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1314.2 +033100 02 FILLER PIC X(40) VALUE ST1314.2 +033200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1314.2 +033300 01 XXINFO. ST1314.2 +033400 02 FILLER PIC X(19) VALUE ST1314.2 +033500 "*** INFORMATION ***". ST1314.2 +033600 02 INFO-TEXT. ST1314.2 +033700 04 FILLER PIC X(8) VALUE SPACE. ST1314.2 +033800 04 XXCOMPUTED PIC X(20). ST1314.2 +033900 04 FILLER PIC X(5) VALUE SPACE. ST1314.2 +034000 04 XXCORRECT PIC X(20). ST1314.2 +034100 02 INF-ANSI-REFERENCE PIC X(48). ST1314.2 +034200 01 HYPHEN-LINE. ST1314.2 +034300 02 FILLER PIC IS X VALUE IS SPACE. ST1314.2 +034400 02 FILLER PIC IS X(65) VALUE IS "************************ST1314.2 +034500- "*****************************************". ST1314.2 +034600 02 FILLER PIC IS X(54) VALUE IS "************************ST1314.2 +034700- "******************************". ST1314.2 +034800 01 CCVS-PGM-ID PIC X(9) VALUE ST1314.2 +034900 "ST131A". ST1314.2 +035000 PROCEDURE DIVISION. ST1314.2 +035100 CCVS1 SECTION. ST1314.2 +035200 OPEN-FILES. ST1314.2 +035300 OPEN OUTPUT PRINT-FILE. ST1314.2 +035400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1314.2 +035500 MOVE SPACE TO TEST-RESULTS. ST1314.2 +035600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1314.2 +035700 GO TO CCVS1-EXIT. ST1314.2 +035800 CLOSE-FILES. ST1314.2 +035900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1314.2 +036000 TERMINATE-CCVS. ST1314.2 +036100S EXIT PROGRAM. ST1314.2 +036200STERMINATE-CALL. ST1314.2 +036300 STOP RUN. ST1314.2 +036400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +036500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +036600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +036700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +036800 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +036900 PRINT-DETAIL. ST1314.2 +037000 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +037100 MOVE "." TO PARDOT-X ST1314.2 +037200 MOVE REC-CT TO DOTVALUE. ST1314.2 +037300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1314.2 +037400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1314.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1314.2 +037600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1314.2 +037700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +037800 MOVE SPACE TO CORRECT-X. ST1314.2 +037900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +038000 MOVE SPACE TO RE-MARK. ST1314.2 +038100 HEAD-ROUTINE. ST1314.2 +038200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1314.2 +038500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1314.2 +038600 COLUMN-NAMES-ROUTINE. ST1314.2 +038700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +038800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +039000 END-ROUTINE. ST1314.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1314.2 +039200 END-RTN-EXIT. ST1314.2 +039300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +039400 END-ROUTINE-1. ST1314.2 +039500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1314.2 +039600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1314.2 +039700 ADD PASS-COUNTER TO ERROR-HOLD. ST1314.2 +039800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1314.2 +039900 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1314.2 +040000 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1314.2 +040100 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1314.2 +040200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1314.2 +040300 END-ROUTINE-12. ST1314.2 +040400 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1314.2 +040500 IF ERROR-COUNTER IS EQUAL TO ZERO ST1314.2 +040600 MOVE "NO " TO ERROR-TOTAL ST1314.2 +040700 ELSE ST1314.2 +040800 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1314.2 +040900 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1314.2 +041000 PERFORM WRITE-LINE. ST1314.2 +041100 END-ROUTINE-13. ST1314.2 +041200 IF DELETE-COUNTER IS EQUAL TO ZERO ST1314.2 +041300 MOVE "NO " TO ERROR-TOTAL ELSE ST1314.2 +041400 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1314.2 +041500 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1314.2 +041600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +041700 IF INSPECT-COUNTER EQUAL TO ZERO ST1314.2 +041800 MOVE "NO " TO ERROR-TOTAL ST1314.2 +041900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1314.2 +042000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1314.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +042200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +042300 WRITE-LINE. ST1314.2 +042400 ADD 1 TO RECORD-COUNT. ST1314.2 +042500Y IF RECORD-COUNT GREATER 42 ST1314.2 +042600Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +042700Y MOVE SPACE TO DUMMY-RECORD ST1314.2 +042800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +042900Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1314.2 +043000Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1314.2 +043100Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1314.2 +043200Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1314.2 +043300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043600Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +043700Y MOVE ZERO TO RECORD-COUNT. ST1314.2 +043800 PERFORM WRT-LN. ST1314.2 +043900 WRT-LN. ST1314.2 +044000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +044100 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +044200 BLANK-LINE-PRINT. ST1314.2 +044300 PERFORM WRT-LN. ST1314.2 +044400 FAIL-ROUTINE. ST1314.2 +044500 IF COMPUTED-X NOT EQUAL TO SPACE ST1314.2 +044600 GO TO FAIL-ROUTINE-WRITE. ST1314.2 +044700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1314.2 +044800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1314.2 +044900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +045000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +045100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1314.2 +045200 GO TO FAIL-ROUTINE-EX. ST1314.2 +045300 FAIL-ROUTINE-WRITE. ST1314.2 +045400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1314.2 +045500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1314.2 +045600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1314.2 +045700 MOVE SPACES TO COR-ANSI-REFERENCE. ST1314.2 +045800 FAIL-ROUTINE-EX. EXIT. ST1314.2 +045900 BAIL-OUT. ST1314.2 +046000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1314.2 +046100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1314.2 +046200 BAIL-OUT-WRITE. ST1314.2 +046300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +046400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1314.2 +046500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +046600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1314.2 +046700 BAIL-OUT-EX. EXIT. ST1314.2 +046800 CCVS1-EXIT. ST1314.2 +046900 EXIT. ST1314.2 +047000 P1-CREATE-F1. ST1314.2 +047100 OPEN OUTPUT FILE1. ST1314.2 +047200 MOVE CA TO S1-2W-A. ST1314.2 +047300 MOVE CB TO S2-3W-A. ST1314.2 +047400 P2-CREATE-F1. ST1314.2 +047500 PERFORM P4-CREATE-F1 2 TIMES. ST1314.2 +047600 P3-CREATE-F1. ST1314.2 +047700 MOVE CA TO S2-3W-A. ST1314.2 +047800 PERFORM P4-CREATE-F1 2 TIMES. ST1314.2 +047900 CLOSE FILE1. ST1314.2 +048000 GO TO FIRST-SORT. ST1314.2 +048100 P4-CREATE-F1. ST1314.2 +048200 MOVE C0 TO SUBSCRIPT-1. ST1314.2 +048300 PERFORM P5-CREATE-F1 25 TIMES. ST1314.2 +048400 P5-CREATE-F1. ST1314.2 +048500 ADD C1 TO SUBSCRIPT-1. ST1314.2 +048600 SUBTRACT C1 FROM S3-4W. ST1314.2 +048700 MOVE ALPHA-TBL (SUBSCRIPT-1) TO S1-2W-B S2-3W-B. ST1314.2 +048800 MOVE W-S3-KEYS TO R1. ST1314.2 +048900 WRITE R1. ST1314.2 +049000 F1-NOTE. ST1314.2 +049100* NOTE. ST1314.2 +049200* KEY-1 WILL BE 567 IN ALL RECORDS. ST1314.2 +049300* KEY-2 WILL BE >A> IN FIRST LETTER WITH 4 OCCURRENCES OF THEST1314.2 +049400* ALPHABET IN THE SECOND LETTER. ST1314.2 +049500* KEY-3 WILL BE >A> OR >B> IN FIRST LETTER WITH 2 OCCURRENCESST1314.2 +049600* OF THE ALPHABET FOR EACH IN THE SECOND LETTER. ST1314.2 +049700* KEY-4 WILL VARY FROM 7050 THRU 6951. ST1314.2 +049800* THE LETTER "O" HAS BEEN OMITTED. ST1314.2 +049900 SRT-1 SECTION. ST1314.2 +050000 FIRST-SORT. ST1314.2 +050100 SORT SORT1 ST1314.2 +050200 ON DESCENDING KEY S1-1 ST1314.2 +050300 ON ASCENDING KEY S1-2 ST1314.2 +050400 USING FILE1 ST1314.2 +050500 GIVING FILE2. ST1314.2 +050600* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS. ST1314.2 +050700* NOTE OUTPUT WILL BE TESTED IN THE FOLLOWING INPUT PROCEDURE. ST1314.2 +050800 SRT-2 SECTION. ST1314.2 +050900 SECOND-SORT. ST1314.2 +051000 SORT SORT2 ST1314.2 +051100 ASCENDING S2-1 ST1314.2 +051200 DESCENDING S2-2 ST1314.2 +051300 ASCENDING S2-3 ST1314.2 +051400 INPUT PROCEDURE SRT-2-INPUT ST1314.2 +051500 GIVING FILE3. ST1314.2 +051600* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS OMITTED. ST1314.2 +051700 GO TO SRT-3. ST1314.2 +051800 SRT-2-INPUT SECTION. ST1314.2 +051900 OPEN-1. ST1314.2 +052000 OPEN INPUT FILE2. ST1314.2 +052100 MOVE "SORT, INPUT PROC" TO FEATURE. ST1314.2 +052200 SORT-TEST-1. ST1314.2 +052300 PERFORM READ-RELEASE-FILE2. ST1314.2 +052400 IF W-S1-KEYS EQUAL TO "567AA" ST1314.2 +052500 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1314.2 +052600 GO TO SORT-FAIL-1. ST1314.2 +052700 SORT-DELETE-1. ST1314.2 +052800 PERFORM DE-LETE-1. ST1314.2 +052900 GO TO SORT-WRITE-1. ST1314.2 +053000 SORT-FAIL-1. ST1314.2 +053100 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +053200 MOVE "567AA" TO CORRECT-A. ST1314.2 +053300 PERFORM FAIL-1. ST1314.2 +053400 SORT-WRITE-1. ST1314.2 +053500 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1314.2 +053600 PERFORM PRINT-DETAIL-1. ST1314.2 +053700 SORT-TEST-2. ST1314.2 +053800 PERFORM READ-RELEASE-FILE2 35 TIMES. ST1314.2 +053900 IF W-S1-KEYS EQUAL TO "567AI" ST1314.2 +054000 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1314.2 +054100 GO TO SORT-FAIL-2. ST1314.2 +054200 SORT-DELETE-2. ST1314.2 +054300 PERFORM DE-LETE-1. ST1314.2 +054400 GO TO SORT-WRITE-2. ST1314.2 +054500 SORT-FAIL-2. ST1314.2 +054600 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +054700 MOVE "567AI" TO CORRECT-A. ST1314.2 +054800 PERFORM FAIL-1. ST1314.2 +054900 SORT-WRITE-2. ST1314.2 +055000 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1314.2 +055100 PERFORM PRINT-DETAIL-1. ST1314.2 +055200 SORT-TEST-3. ST1314.2 +055300 PERFORM READ-RELEASE-FILE2 35 TIMES. ST1314.2 +055400 IF W-S1-KEYS EQUAL TO "567AS" ST1314.2 +055500 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1314.2 +055600 GO TO SORT-FAIL-3. ST1314.2 +055700 SORT-DELETE-3. ST1314.2 +055800 PERFORM DE-LETE-1. ST1314.2 +055900 GO TO SORT-WRITE-3. ST1314.2 +056000 SORT-FAIL-3. ST1314.2 +056100 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +056200 MOVE "567AS" TO CORRECT-A. ST1314.2 +056300 PERFORM FAIL-1. ST1314.2 +056400 SORT-WRITE-3. ST1314.2 +056500 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1314.2 +056600 PERFORM PRINT-DETAIL-1. ST1314.2 +056700 SORT-TEST-4. ST1314.2 +056800 PERFORM READ-RELEASE-FILE2 29 TIMES. ST1314.2 +056900 IF W-S1-KEYS EQUAL TO "567AZ" ST1314.2 +057000 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1314.2 +057100 GO TO SORT-FAIL-4. ST1314.2 +057200 SORT-DELETE-4. ST1314.2 +057300 PERFORM DE-LETE-1. ST1314.2 +057400 GO TO SORT-WRITE-4. ST1314.2 +057500 SORT-FAIL-4. ST1314.2 +057600 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +057700 MOVE "567AZ" TO CORRECT-A. ST1314.2 +057800 PERFORM FAIL-1. ST1314.2 +057900 SORT-WRITE-4. ST1314.2 +058000 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1314.2 +058100 PERFORM PRINT-DETAIL-1. ST1314.2 +058200 CLOSE-1. ST1314.2 +058300 CLOSE FILE2. ST1314.2 +058400 GO TO EXIT-1. ST1314.2 +058500 READ-RELEASE-FILE2. ST1314.2 +058600 READ FILE2 AT END GO TO TERMINAL-1. ST1314.2 +058700 MOVE R2 TO W-S3-KEYS. ST1314.2 +058800 RELEASE S2 FROM R2. ST1314.2 +058900 TERMINAL-1. ST1314.2 +059000 PERFORM FAIL-1. ST1314.2 +059100 MOVE "TERMINAL-1" TO PAR-NAME. ST1314.2 +059200 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +059300 PERFORM PRINT-DETAIL-1. ST1314.2 +059400 MOVE SPACE TO FEATURE. ST1314.2 +059500 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +059600 PERFORM PRINT-DETAIL-1. ST1314.2 +059700 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1314.2 +059800 PERFORM PRINT-DETAIL-1. ST1314.2 +059900 GO TO CLOSE-1. ST1314.2 +060000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +060100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +060200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +060300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +060400 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +060500 PRINT-DETAIL-1. ST1314.2 +060600 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +060700 MOVE "." TO PARDOT-X ST1314.2 +060800 MOVE REC-CT TO DOTVALUE. ST1314.2 +060900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1314.2 +061000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1314.2 +061100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1314.2 +061200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1314.2 +061300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +061400 MOVE SPACE TO CORRECT-X. ST1314.2 +061500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +061600 MOVE SPACE TO RE-MARK. ST1314.2 +061700 WRITE-LINE-1. ST1314.2 +061800 ADD 1 TO RECORD-COUNT. ST1314.2 +061900Y IF RECORD-COUNT GREATER 50 ST1314.2 +062000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +062100Y MOVE SPACE TO DUMMY-RECORD ST1314.2 +062200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +062300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1314.2 +062400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1314.2 +062500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1314.2 +062600Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +062700Y MOVE ZERO TO RECORD-COUNT. ST1314.2 +062800 PERFORM WRT-LN-1. ST1314.2 +062900 WRT-LN-1. ST1314.2 +063000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +063100 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +063200 BLANK-LINE-PRINT-1. ST1314.2 +063300 PERFORM WRT-LN-1. ST1314.2 +063400 FAIL-ROUTINE-1. ST1314.2 +063500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1314.2 +063600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1314.2 +063700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +063800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +063900 GO TO FAIL-ROUTINE-EX-1. ST1314.2 +064000 FAIL-RTN-WRITE-1. ST1314.2 +064100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1314.2 +064200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +064300 FAIL-ROUTINE-EX-1. EXIT. ST1314.2 +064400 BAIL-OUT-1. ST1314.2 +064500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1314.2 +064600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1314.2 +064700 BAIL-OUT-WRITE-1. ST1314.2 +064800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +064900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +065000 BAIL-OUT-EX-1. EXIT. ST1314.2 +065100 EXIT-1. ST1314.2 +065200 EXIT. ST1314.2 +065300 SRT-3 SECTION. ST1314.2 +065400 THIRD-SORT. ST1314.2 +065500 SORT SORT3 ST1314.2 +065600 ON DESCENDING KEY S3-1 S3-2 S3-3 ST1314.2 +065700 ASCENDING S3-4 ST1314.2 +065800 INPUT PROCEDURE IS SRT3-INPUT ST1314.2 +065900 OUTPUT PROCEDURE SRT3-OUTPUT-1 THRU SRT3-OUTPUT-2. ST1314.2 +066000 NOTE-SORT-3. ST1314.2 +066100* NOTE SORT STATEMENT WITH INCLUSION-OMISSION OF OPTIONAL ST1314.2 +066200* WORDS AND THRU OPTION. THE OUTPUT OF SRT-2 IS TESTED ST1314.2 +066300* IN THE INPUT PROCEDURE OF THIS (THIRD) SORT. THE OUTPUT ST1314.2 +066400* OF THE THIRD SORT IS TESTED IN THE OUTPUT PROCEDURE ST1314.2 +066500* WITHOUT THE GENERATION OF AN OUTPUT FILE. ST1314.2 +066600 END-FIRST-PROGRAM. ST1314.2 +066700 GO TO CCVS-EXIT. ST1314.2 +066800 SRT3-INPUT SECTION. ST1314.2 +066900 OPEN-2. ST1314.2 +067000 OPEN INPUT FILE3. ST1314.2 +067100 MOVE "SORT, INPUT PROC" TO FEATURE. ST1314.2 +067200 SORT-TEST-5. ST1314.2 +067300 PERFORM READ-RELEASE-FILE3. ST1314.2 +067400 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +067500 IF W-S2-KEYS EQUAL TO "567AZAZ" ST1314.2 +067600 PERFORM PASS-2 GO TO SORT-WRITE-5. ST1314.2 +067700 GO TO SORT-FAIL-5. ST1314.2 +067800 SORT-DELETE-5. ST1314.2 +067900 PERFORM DE-LETE-2. ST1314.2 +068000 GO TO SORT-WRITE-5. ST1314.2 +068100 SORT-FAIL-5. ST1314.2 +068200 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +068300 MOVE "567AZAZ" TO CORRECT-A. ST1314.2 +068400 PERFORM FAIL-2. ST1314.2 +068500 SORT-WRITE-5. ST1314.2 +068600 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1314.2 +068700 PERFORM PRINT-DETAIL-2. ST1314.2 +068800 SORT-TEST-6. ST1314.2 +068900 PERFORM READ-RELEASE-FILE3 35 TIMES. ST1314.2 +069000 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +069100 IF W-S2-KEYS EQUAL TO "567ARBR" ST1314.2 +069200 PERFORM PASS-2 GO TO SORT-WRITE-6. ST1314.2 +069300 GO TO SORT-FAIL-6. ST1314.2 +069400 SORT-DELETE-6. ST1314.2 +069500 PERFORM DE-LETE-2. ST1314.2 +069600 GO TO SORT-WRITE-6. ST1314.2 +069700 SORT-FAIL-6. ST1314.2 +069800 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +069900 MOVE "567ARBR" TO CORRECT-A. ST1314.2 +070000 PERFORM FAIL-2. ST1314.2 +070100 SORT-WRITE-6. ST1314.2 +070200 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1314.2 +070300 PERFORM PRINT-DETAIL-2. ST1314.2 +070400 SORT-TEST-7. ST1314.2 +070500 PERFORM READ-RELEASE-FILE3 35 TIMES. ST1314.2 +070600 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +070700 IF W-S2-KEYS EQUAL TO "567AHBH" ST1314.2 +070800 PERFORM PASS-2 GO TO SORT-WRITE-7. ST1314.2 +070900 GO TO SORT-FAIL-7. ST1314.2 +071000 SORT-DELETE-7. ST1314.2 +071100 PERFORM DE-LETE-2. ST1314.2 +071200 GO TO SORT-WRITE-7. ST1314.2 +071300 SORT-FAIL-7. ST1314.2 +071400 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +071500 MOVE "567AHBH" TO CORRECT-A. ST1314.2 +071600 PERFORM FAIL-2. ST1314.2 +071700 SORT-WRITE-7. ST1314.2 +071800 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1314.2 +071900 PERFORM PRINT-DETAIL-2. ST1314.2 +072000 SORT-TEST-8. ST1314.2 +072100 PERFORM READ-RELEASE-FILE3 29 TIMES. ST1314.2 +072200 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +072300 IF W-S2-KEYS EQUAL TO "567AABA" ST1314.2 +072400 PERFORM PASS-2 GO TO SORT-WRITE-8. ST1314.2 +072500 GO TO SORT-FAIL-8. ST1314.2 +072600 SORT-DELETE-8. ST1314.2 +072700 PERFORM DE-LETE-2. ST1314.2 +072800 GO TO SORT-WRITE-8. ST1314.2 +072900 SORT-FAIL-8. ST1314.2 +073000 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +073100 MOVE "567AABA" TO CORRECT-A. ST1314.2 +073200 PERFORM FAIL-2. ST1314.2 +073300 SORT-WRITE-8. ST1314.2 +073400 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1314.2 +073500 PERFORM PRINT-DETAIL-2. ST1314.2 +073600 CLOSE-2. ST1314.2 +073700 CLOSE FILE3. ST1314.2 +073800 GO TO EXIT-2. ST1314.2 +073900 READ-RELEASE-FILE3. ST1314.2 +074000 READ FILE3 AT END GO TO TERMINAL-2. ST1314.2 +074100 RELEASE S3. ST1314.2 +074200* NOTE READ AND RELEASE ARE THE ONLY STATEMENTS NECESSARY ST1314.2 +074300* TO USE FILE3 AS INPUT TO THE THIRD SORT. THIS IS SINCE ST1314.2 +074400* THE RECORD AREAS ARE THE SAME FROM THE CLAUSE ST1314.2 +074500* SAME RECORD AREA SORT3 FILE3. ST1314.2 +074600 TERMINAL-2. ST1314.2 +074700 PERFORM FAIL-2. ST1314.2 +074800 MOVE "TERMINAL-2" TO PAR-NAME. ST1314.2 +074900 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +075000 PERFORM PRINT-DETAIL-2. ST1314.2 +075100 MOVE SPACE TO FEATURE. ST1314.2 +075200 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +075300 PERFORM PRINT-DETAIL-2. ST1314.2 +075400 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. ST1314.2 +075500 PERFORM PRINT-DETAIL-2. ST1314.2 +075600 GO TO CLOSE-2. ST1314.2 +075700 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +075800 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +075900 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +076000 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +076100 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +076200 PRINT-DETAIL-2. ST1314.2 +076300 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +076400 MOVE "." TO PARDOT-X ST1314.2 +076500 MOVE REC-CT TO DOTVALUE. ST1314.2 +076600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. ST1314.2 +076700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 ST1314.2 +076800 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 ST1314.2 +076900 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. ST1314.2 +077000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +077100 MOVE SPACE TO CORRECT-X. ST1314.2 +077200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +077300 MOVE SPACE TO RE-MARK. ST1314.2 +077400 WRITE-LINE-2. ST1314.2 +077500 ADD 1 TO RECORD-COUNT. ST1314.2 +077600Y IF RECORD-COUNT GREATER 50 ST1314.2 +077700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +077800Y MOVE SPACE TO DUMMY-RECORD ST1314.2 +077900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +078000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 ST1314.2 +078100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES ST1314.2 +078200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 ST1314.2 +078300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +078400Y MOVE ZERO TO RECORD-COUNT. ST1314.2 +078500 PERFORM WRT-LN-2. ST1314.2 +078600 WRT-LN-2. ST1314.2 +078700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +078800 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +078900 BLANK-LINE-PRINT-2. ST1314.2 +079000 PERFORM WRT-LN-2. ST1314.2 +079100 FAIL-ROUTINE-2. ST1314.2 +079200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1314.2 +079300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1314.2 +079400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +079500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +079600 GO TO FAIL-ROUTINE-EX-2. ST1314.2 +079700 FAIL-RTN-WRITE-2. ST1314.2 +079800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 ST1314.2 +079900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +080000 FAIL-ROUTINE-EX-2. EXIT. ST1314.2 +080100 BAIL-OUT-2. ST1314.2 +080200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. ST1314.2 +080300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. ST1314.2 +080400 BAIL-OUT-WRITE-2. ST1314.2 +080500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +080600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +080700 BAIL-OUT-EX-2. EXIT. ST1314.2 +080800 EXIT-2. ST1314.2 +080900 EXIT. ST1314.2 +081000 SRT3-OUTPUT-1 SECTION. ST1314.2 +081100 INIT-3. ST1314.2 +081200 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1314.2 +081300 SORT-TEST-9. ST1314.2 +081400 PERFORM RETURN-SORT3. ST1314.2 +081500 IF S3-KEYS EQUAL TO "567AZBZ7001" ST1314.2 +081600 PERFORM PASS-3 GO TO SORT-WRITE-9. ST1314.2 +081700 GO TO SORT-FAIL-9. ST1314.2 +081800 SORT-DELETE-9. ST1314.2 +081900 PERFORM DE-LETE-3. ST1314.2 +082000 GO TO SORT-WRITE-9. ST1314.2 +082100 SORT-FAIL-9. ST1314.2 +082200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +082300 MOVE "567AZBZ7001" TO CORRECT-A. ST1314.2 +082400 PERFORM FAIL-3. ST1314.2 +082500 SORT-WRITE-9. ST1314.2 +082600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1314.2 +082700 PERFORM PRINT-DETAIL-3. ST1314.2 +082800 SORT-TEST-10. ST1314.2 +082900 PERFORM RETURN-SORT3. ST1314.2 +083000 IF S3-KEYS EQUAL TO "567AZBZ7026" ST1314.2 +083100 PERFORM PASS-3 GO TO SORT-WRITE-10. ST1314.2 +083200 GO TO SORT-FAIL-10. ST1314.2 +083300 SORT-DELETE-10. ST1314.2 +083400 PERFORM DE-LETE-3. ST1314.2 +083500 GO TO SORT-WRITE-10. ST1314.2 +083600 SORT-FAIL-10. ST1314.2 +083700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +083800 MOVE "567AZBZ7026" TO CORRECT-A. ST1314.2 +083900 PERFORM FAIL-3. ST1314.2 +084000 SORT-WRITE-10. ST1314.2 +084100 MOVE "SORT-TEST-10" TO PAR-NAME. ST1314.2 +084200 PERFORM PRINT-DETAIL-3. ST1314.2 +084300 SORT-TEST-11. ST1314.2 +084400 PERFORM RETURN-SORT3 35 TIMES. ST1314.2 +084500 IF S3-KEYS EQUAL TO "567AQBQ7010" ST1314.2 +084600 PERFORM PASS-3 GO TO SORT-WRITE-11. ST1314.2 +084700 GO TO SORT-FAIL-11. ST1314.2 +084800 SORT-DELETE-11. ST1314.2 +084900 PERFORM DE-LETE-3. ST1314.2 +085000 GO TO SORT-WRITE-11. ST1314.2 +085100 SORT-FAIL-11. ST1314.2 +085200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +085300 MOVE "567AQBQ7010" TO CORRECT-A. ST1314.2 +085400 PERFORM FAIL-3. ST1314.2 +085500 SORT-WRITE-11. ST1314.2 +085600 MOVE "SORT-TEST-11" TO PAR-NAME. ST1314.2 +085700 PERFORM PRINT-DETAIL-3. ST1314.2 +085800 SORT-TEST-12. ST1314.2 +085900 PERFORM RETURN-SORT3. ST1314.2 +086000 IF S3-KEYS EQUAL TO "567AQBQ7035" ST1314.2 +086100 PERFORM PASS-3 GO TO SORT-WRITE-12. ST1314.2 +086200 GO TO SORT-FAIL-12. ST1314.2 +086300 SORT-DELETE-12. ST1314.2 +086400 PERFORM DE-LETE-3. ST1314.2 +086500 GO TO SORT-WRITE-12. ST1314.2 +086600 SORT-FAIL-12. ST1314.2 +086700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +086800 MOVE "567AQBQ7035" TO CORRECT-A. ST1314.2 +086900 PERFORM FAIL-3. ST1314.2 +087000 SORT-WRITE-12. ST1314.2 +087100 MOVE "SORT-TEST-12" TO PAR-NAME. ST1314.2 +087200 PERFORM PRINT-DETAIL-3. ST1314.2 +087300 SORT-TEST-13. ST1314.2 +087400 PERFORM RETURN-SORT3 35 TIMES. ST1314.2 +087500 IF S3-KEYS EQUAL TO "567AGBG7019" ST1314.2 +087600 PERFORM PASS-3 GO TO SORT-WRITE-13. ST1314.2 +087700 GO TO SORT-FAIL-13. ST1314.2 +087800 SORT-DELETE-13. ST1314.2 +087900 PERFORM DE-LETE-3. ST1314.2 +088000 GO TO SORT-WRITE-13. ST1314.2 +088100 SORT-FAIL-13. ST1314.2 +088200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +088300 MOVE "567AGBG7019" TO CORRECT-A. ST1314.2 +088400 PERFORM FAIL-3. ST1314.2 +088500 SORT-WRITE-13. ST1314.2 +088600 MOVE "SORT-TEST-13" TO PAR-NAME. ST1314.2 +088700 PERFORM PRINT-DETAIL-3. ST1314.2 +088800 SORT-TEST-14. ST1314.2 +088900 PERFORM RETURN-SORT3 27 TIMES. ST1314.2 +089000 IF S3-KEYS EQUAL TO "567AAAA7000" ST1314.2 +089100 PERFORM PASS-3 GO TO SORT-WRITE-14. ST1314.2 +089200 GO TO SORT-FAIL-14. ST1314.2 +089300 SORT-DELETE-14. ST1314.2 +089400 PERFORM DE-LETE-3. ST1314.2 +089500 GO TO SORT-WRITE-14. ST1314.2 +089600 SORT-FAIL-14. ST1314.2 +089700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +089800 MOVE "567AAAA7000" TO CORRECT-A. ST1314.2 +089900 PERFORM FAIL-3. ST1314.2 +090000 SORT-WRITE-14. ST1314.2 +090100 MOVE "SORT-TEST-14" TO PAR-NAME. ST1314.2 +090200 PERFORM PRINT-DETAIL-3. ST1314.2 +090300 SORT-TEST-15. ST1314.2 +090400 RETURN SORT3 RECORD AT END ST1314.2 +090500 PERFORM PASS-3 GO TO SORT-WRITE-15. ST1314.2 +090600* NOTE THE FOLLOWING SENTENCES SHOULD NOT BE EXECUTED. ST1314.2 +090700 PERFORM FAIL-3. ST1314.2 +090800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1314.2 +090900 GO TO SORT-WRITE-15. ST1314.2 +091000 SORT-DELETE-15. ST1314.2 +091100 PERFORM DE-LETE-3. ST1314.2 +091200 SORT-WRITE-15. ST1314.2 +091300 MOVE "SORT-TEST-15" TO PAR-NAME. ST1314.2 +091400 PERFORM PRINT-DETAIL-3. ST1314.2 +091500 CLOSE-3. ST1314.2 +091600 GO TO EXIT-3. ST1314.2 +091700 SRT3-OUTPUT-2 SECTION. ST1314.2 +091800 RETURN-SORT3. ST1314.2 +091900 RETURN SORT3 RECORD AT END GO TO TERMINAL-3. ST1314.2 +092000* NOTE RETURN VERB WITH ALL OPTIONS EXCEPT INTO. ST1314.2 +092100 TERMINAL-3. ST1314.2 +092200 PERFORM FAIL-3. ST1314.2 +092300 MOVE "TERMINAL-3" TO PAR-NAME. ST1314.2 +092400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +092500 PERFORM PRINT-DETAIL-3. ST1314.2 +092600 MOVE SPACE TO FEATURE. ST1314.2 +092700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +092800 PERFORM PRINT-DETAIL-3. ST1314.2 +092900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK ST1314.2 +093000 PERFORM PRINT-DETAIL-3. ST1314.2 +093100 GO TO CLOSE-3. ST1314.2 +093200 PASS-3. ST1314.2 +093300 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +093400 FAIL-3. ST1314.2 +093500 ADD 1 TO ERROR-COUNTER. ST1314.2 +093600 MOVE "FAIL*" TO P-OR-F. ST1314.2 +093700 DE-LETE-3. ST1314.2 +093800 MOVE SPACE TO P-OR-F. ST1314.2 +093900 MOVE " ************ " TO COMPUTED-A. ST1314.2 +094000 MOVE " ************ " TO CORRECT-A. ST1314.2 +094100 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +094200 ADD 1 TO DELETE-COUNTER. ST1314.2 +094300 PRINT-DETAIL-3. ST1314.2 +094400 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +094500 MOVE "." TO PARDOT-X ST1314.2 +094600 MOVE REC-CT TO DOTVALUE. ST1314.2 +094700 MOVE TEST-RESULTS TO PRINT-REC. ST1314.2 +094800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +094900 MOVE SPACE TO P-OR-F. ST1314.2 +095000 MOVE SPACE TO COMPUTED-A. ST1314.2 +095100 MOVE SPACE TO CORRECT-A. ST1314.2 +095200 IF REC-CT EQUAL TO ZERO ST1314.2 +095300 MOVE SPACE TO PAR-NAME. ST1314.2 +095400 MOVE SPACE TO RE-MARK. ST1314.2 +095500 EXIT-3. ST1314.2 +095600 EXIT. ST1314.2 +095700 END-CCVS SECTION. ST1314.2 +095800 CCVS-EXIT SECTION. ST1314.2 +095900 CCVS-999999. ST1314.2 +096000 GO TO CLOSE-FILES. ST1314.2 +*END-OF,ST131A +*HEADER,COBOL,ST132A +000100 IDENTIFICATION DIVISION. ST1324.2 +000200 PROGRAM-ID. ST1324.2 +000300 ST132A. ST1324.2 +000400**************************************************************** ST1324.2 +000500* * ST1324.2 +000600* VALIDATION FOR:- * ST1324.2 +000700* * ST1324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +000900* * ST1324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1324.2 +001100* * ST1324.2 +001200**************************************************************** ST1324.2 +001300* * ST1324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1324.2 +001500* * ST1324.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1324.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1324.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1324.2 +001900* * ST1324.2 +002000**************************************************************** ST1324.2 +002100* ST1324.2 +002200* THIS PROGRAM EXERCISES THE FOLLOWING ST1324.2 +002300* SAME SORT AREA CLAUSE ST1324.2 +002400* USING-OUTPUT PROCEDURE COMBINATION ST1324.2 +002500* MULTI REEL SORT ST1324.2 +002600* RELEASE FROM ST1324.2 +002700* RETURN INTO. ST1324.2 +002800* THERE ARE 3 SORTS. THE FIRST GENERATES THE INPUT DATA IN THE ST1324.2 +002900* INPUT PROCEDURE. THE SORT RESULTS ARE TESTED IN THE ST1324.2 +003000* OUTPUT PROCEDURE WHICH ALSO CREATES A 2-REEL FILE (VIA ST1324.2 +003100* CLOSE REEL) FOR INPUT TO THE SECOND SORT. ST1324.2 +003200* THE SECOND SORT (USING-OUTPUT PROCEDURE) IS TESTED IN THE ST1324.2 +003300* OUTPUT PROCEDURE. ST1324.2 +003400* THE THIRD SORT EXERCISES A SORT-FILE FOR THE SECOND TIME. ST1324.2 +003500* SUCCESSFUL EXECUTION IS THE SOLE TEST OF THIS SORT. ST1324.2 +003600 ST1324.2 +003700 ENVIRONMENT DIVISION. ST1324.2 +003800 CONFIGURATION SECTION. ST1324.2 +003900 SOURCE-COMPUTER. ST1324.2 +004000 XXXXX082. ST1324.2 +004100 OBJECT-COMPUTER. ST1324.2 +004200 XXXXX083. ST1324.2 +004300 INPUT-OUTPUT SECTION. ST1324.2 +004400 FILE-CONTROL. ST1324.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1324.2 +004600 XXXXX055. ST1324.2 +004700 SELECT SORT4 ASSIGN TO ST1324.2 +004800 XXXXX027. ST1324.2 +004900 SELECT SORT5 ASSIGN TO ST1324.2 +005000 XXXXX028. ST1324.2 +005100 SELECT FILE4 ASSIGN TO ST1324.2 +005200 XXXXX006. ST1324.2 +005300 I-O-CONTROL. ST1324.2 +005400 SAME SORT AREA FOR SORT5 SORT4. ST1324.2 +005500 DATA DIVISION. ST1324.2 +005600 FILE SECTION. ST1324.2 +005700 FD PRINT-FILE. ST1324.2 +005800 01 PRINT-REC PICTURE X(120). ST1324.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1324.2 +006000 FD FILE4 ST1324.2 +006100 BLOCK CONTAINS 10 RECORDS ST1324.2 +006200 LABEL RECORDS ARE STANDARD ST1324.2 +006300C VALUE OF ST1324.2 +006400C XXXXX074 ST1324.2 +006500C IS ST1324.2 +006600C XXXXX075 ST1324.2 +006700G XXXXX069 ST1324.2 +006800 DATA RECORD IS R4. ST1324.2 +006900 01 R4 PICTURE X(120). ST1324.2 +007000 SD SORT4 ST1324.2 +007100 RECORD CONTAINS 120 ST1324.2 +007200 DATA RECORD IS S4. ST1324.2 +007300 01 S4. ST1324.2 +007400 02 S4-KEYS. ST1324.2 +007500 03 S4-KEY1 PICTURE A(10). ST1324.2 +007600 03 S4-KEY2 PICTURE 9(10). ST1324.2 +007700 02 FILLER PICTURE X(100). ST1324.2 +007800 SD SORT5 ST1324.2 +007900 RECORD 120 ST1324.2 +008000 DATA RECORD S5. ST1324.2 +008100 01 S5. ST1324.2 +008200 02 S5-KEYS. ST1324.2 +008300 03 S5-KEY1 PICTURE A(10). ST1324.2 +008400 03 S5-KEY2 PICTURE 9(10). ST1324.2 +008500 02 FILLER PICTURE X(100). ST1324.2 +008600 WORKING-STORAGE SECTION. ST1324.2 +008700 77 C0 PICTURE 9 COMPUTATIONAL VALUE ZERO. ST1324.2 +008800 77 C1 PICTURE 9 COMPUTATIONAL VALUE 1. ST1324.2 +008900 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1324.2 +009000 77 SUBSCRIPT-2 PICTURE 99 COMPUTATIONAL. ST1324.2 +009100 01 ALPHA-TABLE. ST1324.2 +009200 02 ALPHA-TAB PICTURE A(25) ST1324.2 +009300 VALUE "ABCDEFGHIJKLMNPQRSTUVWXYZ". ST1324.2 +009400 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. ST1324.2 +009500 01 WKEYS. ST1324.2 +009600 02 WKEY-1. ST1324.2 +009700 03 FILLER PICTURE AAA VALUE "PQR". ST1324.2 +009800 03 WKEY-1A PICTURE A. ST1324.2 +009900 03 FILLER PICTURE A(5) VALUE "ABCDE". ST1324.2 +010000 03 WKEY-1B PICTURE A. ST1324.2 +010100 02 WKEY-2. ST1324.2 +010200 03 FILLER PICTURE 9 VALUE 7. ST1324.2 +010300 03 WKEY-2A PICTURE 9 VALUE ZERO. ST1324.2 +010400 03 FILLER PICTURE 9(7) VALUE 1234567. ST1324.2 +010500 03 WKEY-2B PICTURE 9 VALUE ZERO. ST1324.2 +010600 02 FILLER PICTURE X(100). ST1324.2 +010700 01 FILE-RECORD-INFORMATION-REC. ST1324.2 +010800 03 FILE-RECORD-INFO-SKELETON. ST1324.2 +010900 05 FILLER PICTURE X(48) VALUE ST1324.2 +011000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1324.2 +011100 05 FILLER PICTURE X(46) VALUE ST1324.2 +011200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1324.2 +011300 05 FILLER PICTURE X(26) VALUE ST1324.2 +011400 ",LFIL=000000,ORG= ,LBLR= ". ST1324.2 +011500 05 FILLER PICTURE X(37) VALUE ST1324.2 +011600 ",RECKEY= ". ST1324.2 +011700 05 FILLER PICTURE X(38) VALUE ST1324.2 +011800 ",ALTKEY1= ". ST1324.2 +011900 05 FILLER PICTURE X(38) VALUE ST1324.2 +012000 ",ALTKEY2= ". ST1324.2 +012100 05 FILLER PICTURE X(7) VALUE SPACE.ST1324.2 +012200 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1324.2 +012300 05 FILE-RECORD-INFO-P1-120. ST1324.2 +012400 07 FILLER PIC X(5). ST1324.2 +012500 07 XFILE-NAME PIC X(6). ST1324.2 +012600 07 FILLER PIC X(8). ST1324.2 +012700 07 XRECORD-NAME PIC X(6). ST1324.2 +012800 07 FILLER PIC X(1). ST1324.2 +012900 07 REELUNIT-NUMBER PIC 9(1). ST1324.2 +013000 07 FILLER PIC X(7). ST1324.2 +013100 07 XRECORD-NUMBER PIC 9(6). ST1324.2 +013200 07 FILLER PIC X(6). ST1324.2 +013300 07 UPDATE-NUMBER PIC 9(2). ST1324.2 +013400 07 FILLER PIC X(5). ST1324.2 +013500 07 ODO-NUMBER PIC 9(4). ST1324.2 +013600 07 FILLER PIC X(5). ST1324.2 +013700 07 XPROGRAM-NAME PIC X(5). ST1324.2 +013800 07 FILLER PIC X(7). ST1324.2 +013900 07 XRECORD-LENGTH PIC 9(6). ST1324.2 +014000 07 FILLER PIC X(7). ST1324.2 +014100 07 CHARS-OR-RECORDS PIC X(2). ST1324.2 +014200 07 FILLER PIC X(1). ST1324.2 +014300 07 XBLOCK-SIZE PIC 9(4). ST1324.2 +014400 07 FILLER PIC X(6). ST1324.2 +014500 07 RECORDS-IN-FILE PIC 9(6). ST1324.2 +014600 07 FILLER PIC X(5). ST1324.2 +014700 07 XFILE-ORGANIZATION PIC X(2). ST1324.2 +014800 07 FILLER PIC X(6). ST1324.2 +014900 07 XLABEL-TYPE PIC X(1). ST1324.2 +015000 05 FILE-RECORD-INFO-P121-240. ST1324.2 +015100 07 FILLER PIC X(8). ST1324.2 +015200 07 XRECORD-KEY PIC X(29). ST1324.2 +015300 07 FILLER PIC X(9). ST1324.2 +015400 07 ALTERNATE-KEY1 PIC X(29). ST1324.2 +015500 07 FILLER PIC X(9). ST1324.2 +015600 07 ALTERNATE-KEY2 PIC X(29). ST1324.2 +015700 07 FILLER PIC X(7). ST1324.2 +015800 01 TEST-RESULTS. ST1324.2 +015900 02 FILLER PIC X VALUE SPACE. ST1324.2 +016000 02 FEATURE PIC X(20) VALUE SPACE. ST1324.2 +016100 02 FILLER PIC X VALUE SPACE. ST1324.2 +016200 02 P-OR-F PIC X(5) VALUE SPACE. ST1324.2 +016300 02 FILLER PIC X VALUE SPACE. ST1324.2 +016400 02 PAR-NAME. ST1324.2 +016500 03 FILLER PIC X(19) VALUE SPACE. ST1324.2 +016600 03 PARDOT-X PIC X VALUE SPACE. ST1324.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. ST1324.2 +016800 02 FILLER PIC X(8) VALUE SPACE. ST1324.2 +016900 02 RE-MARK PIC X(61). ST1324.2 +017000 01 TEST-COMPUTED. ST1324.2 +017100 02 FILLER PIC X(30) VALUE SPACE. ST1324.2 +017200 02 FILLER PIC X(17) VALUE ST1324.2 +017300 " COMPUTED=". ST1324.2 +017400 02 COMPUTED-X. ST1324.2 +017500 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1324.2 +017600 03 COMPUTED-N REDEFINES COMPUTED-A ST1324.2 +017700 PIC -9(9).9(9). ST1324.2 +017800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1324.2 +017900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1324.2 +018000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1324.2 +018100 03 CM-18V0 REDEFINES COMPUTED-A. ST1324.2 +018200 04 COMPUTED-18V0 PIC -9(18). ST1324.2 +018300 04 FILLER PIC X. ST1324.2 +018400 03 FILLER PIC X(50) VALUE SPACE. ST1324.2 +018500 01 TEST-CORRECT. ST1324.2 +018600 02 FILLER PIC X(30) VALUE SPACE. ST1324.2 +018700 02 FILLER PIC X(17) VALUE " CORRECT =". ST1324.2 +018800 02 CORRECT-X. ST1324.2 +018900 03 CORRECT-A PIC X(20) VALUE SPACE. ST1324.2 +019000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1324.2 +019100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1324.2 +019200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1324.2 +019300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1324.2 +019400 03 CR-18V0 REDEFINES CORRECT-A. ST1324.2 +019500 04 CORRECT-18V0 PIC -9(18). ST1324.2 +019600 04 FILLER PIC X. ST1324.2 +019700 03 FILLER PIC X(2) VALUE SPACE. ST1324.2 +019800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1324.2 +019900 01 CCVS-C-1. ST1324.2 +020000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1324.2 +020100- "SS PARAGRAPH-NAME ST1324.2 +020200- " REMARKS". ST1324.2 +020300 02 FILLER PIC X(20) VALUE SPACE. ST1324.2 +020400 01 CCVS-C-2. ST1324.2 +020500 02 FILLER PIC X VALUE SPACE. ST1324.2 +020600 02 FILLER PIC X(6) VALUE "TESTED". ST1324.2 +020700 02 FILLER PIC X(15) VALUE SPACE. ST1324.2 +020800 02 FILLER PIC X(4) VALUE "FAIL". ST1324.2 +020900 02 FILLER PIC X(94) VALUE SPACE. ST1324.2 +021000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1324.2 +021100 01 REC-CT PIC 99 VALUE ZERO. ST1324.2 +021200 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021300 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021500 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021600 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1324.2 +021700 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1324.2 +021800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1324.2 +021900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1324.2 +022000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1324.2 +022100 01 CCVS-H-1. ST1324.2 +022200 02 FILLER PIC X(39) VALUE SPACES. ST1324.2 +022300 02 FILLER PIC X(42) VALUE ST1324.2 +022400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1324.2 +022500 02 FILLER PIC X(39) VALUE SPACES. ST1324.2 +022600 01 CCVS-H-2A. ST1324.2 +022700 02 FILLER PIC X(40) VALUE SPACE. ST1324.2 +022800 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1324.2 +022900 02 FILLER PIC XXXX VALUE ST1324.2 +023000 "4.2 ". ST1324.2 +023100 02 FILLER PIC X(28) VALUE ST1324.2 +023200 " COPY - NOT FOR DISTRIBUTION". ST1324.2 +023300 02 FILLER PIC X(41) VALUE SPACE. ST1324.2 +023400 ST1324.2 +023500 01 CCVS-H-2B. ST1324.2 +023600 02 FILLER PIC X(15) VALUE ST1324.2 +023700 "TEST RESULT OF ". ST1324.2 +023800 02 TEST-ID PIC X(9). ST1324.2 +023900 02 FILLER PIC X(4) VALUE ST1324.2 +024000 " IN ". ST1324.2 +024100 02 FILLER PIC X(12) VALUE ST1324.2 +024200 " HIGH ". ST1324.2 +024300 02 FILLER PIC X(22) VALUE ST1324.2 +024400 " LEVEL VALIDATION FOR ". ST1324.2 +024500 02 FILLER PIC X(58) VALUE ST1324.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +024700 01 CCVS-H-3. ST1324.2 +024800 02 FILLER PIC X(34) VALUE ST1324.2 +024900 " FOR OFFICIAL USE ONLY ". ST1324.2 +025000 02 FILLER PIC X(58) VALUE ST1324.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1324.2 +025200 02 FILLER PIC X(28) VALUE ST1324.2 +025300 " COPYRIGHT 1985 ". ST1324.2 +025400 01 CCVS-E-1. ST1324.2 +025500 02 FILLER PIC X(52) VALUE SPACE. ST1324.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1324.2 +025700 02 ID-AGAIN PIC X(9). ST1324.2 +025800 02 FILLER PIC X(45) VALUE SPACES. ST1324.2 +025900 01 CCVS-E-2. ST1324.2 +026000 02 FILLER PIC X(31) VALUE SPACE. ST1324.2 +026100 02 FILLER PIC X(21) VALUE SPACE. ST1324.2 +026200 02 CCVS-E-2-2. ST1324.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1324.2 +026400 03 FILLER PIC X VALUE SPACE. ST1324.2 +026500 03 ENDER-DESC PIC X(44) VALUE ST1324.2 +026600 "ERRORS ENCOUNTERED". ST1324.2 +026700 01 CCVS-E-3. ST1324.2 +026800 02 FILLER PIC X(22) VALUE ST1324.2 +026900 " FOR OFFICIAL USE ONLY". ST1324.2 +027000 02 FILLER PIC X(12) VALUE SPACE. ST1324.2 +027100 02 FILLER PIC X(58) VALUE ST1324.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +027300 02 FILLER PIC X(13) VALUE SPACE. ST1324.2 +027400 02 FILLER PIC X(15) VALUE ST1324.2 +027500 " COPYRIGHT 1985". ST1324.2 +027600 01 CCVS-E-4. ST1324.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1324.2 +027800 02 FILLER PIC X(4) VALUE " OF ". ST1324.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1324.2 +028000 02 FILLER PIC X(40) VALUE ST1324.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". ST1324.2 +028200 01 XXINFO. ST1324.2 +028300 02 FILLER PIC X(19) VALUE ST1324.2 +028400 "*** INFORMATION ***". ST1324.2 +028500 02 INFO-TEXT. ST1324.2 +028600 04 FILLER PIC X(8) VALUE SPACE. ST1324.2 +028700 04 XXCOMPUTED PIC X(20). ST1324.2 +028800 04 FILLER PIC X(5) VALUE SPACE. ST1324.2 +028900 04 XXCORRECT PIC X(20). ST1324.2 +029000 02 INF-ANSI-REFERENCE PIC X(48). ST1324.2 +029100 01 HYPHEN-LINE. ST1324.2 +029200 02 FILLER PIC IS X VALUE IS SPACE. ST1324.2 +029300 02 FILLER PIC IS X(65) VALUE IS "************************ST1324.2 +029400- "*****************************************". ST1324.2 +029500 02 FILLER PIC IS X(54) VALUE IS "************************ST1324.2 +029600- "******************************". ST1324.2 +029700 01 CCVS-PGM-ID PIC X(9) VALUE ST1324.2 +029800 "ST132A". ST1324.2 +029900 PROCEDURE DIVISION. ST1324.2 +030000 CCVS1 SECTION. ST1324.2 +030100 OPEN-FILES. ST1324.2 +030200 OPEN OUTPUT PRINT-FILE. ST1324.2 +030300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1324.2 +030400 MOVE SPACE TO TEST-RESULTS. ST1324.2 +030500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1324.2 +030600 MOVE ZERO TO REC-SKL-SUB. ST1324.2 +030700 PERFORM CCVS-INIT-FILE 9 TIMES. ST1324.2 +030800 CCVS-INIT-FILE. ST1324.2 +030900 ADD 1 TO REC-SKL-SUB. ST1324.2 +031000 MOVE FILE-RECORD-INFO-SKELETON ST1324.2 +031100 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1324.2 +031200 CCVS-INIT-EXIT. ST1324.2 +031300 GO TO CCVS1-EXIT. ST1324.2 +031400 CLOSE-FILES. ST1324.2 +031500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1324.2 +031600 TERMINATE-CCVS. ST1324.2 +031700S EXIT PROGRAM. ST1324.2 +031800STERMINATE-CALL. ST1324.2 +031900 STOP RUN. ST1324.2 +032000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +032100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +032200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +032300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +032400 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +032500 PRINT-DETAIL. ST1324.2 +032600 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +032700 MOVE "." TO PARDOT-X ST1324.2 +032800 MOVE REC-CT TO DOTVALUE. ST1324.2 +032900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1324.2 +033000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1324.2 +033100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1324.2 +033200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1324.2 +033300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +033400 MOVE SPACE TO CORRECT-X. ST1324.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +033600 MOVE SPACE TO RE-MARK. ST1324.2 +033700 HEAD-ROUTINE. ST1324.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1324.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1324.2 +034200 COLUMN-NAMES-ROUTINE. ST1324.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +034600 END-ROUTINE. ST1324.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1324.2 +034800 END-RTN-EXIT. ST1324.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +035000 END-ROUTINE-1. ST1324.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1324.2 +035200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1324.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. ST1324.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1324.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1324.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1324.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1324.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1324.2 +035900 END-ROUTINE-12. ST1324.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1324.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1324.2 +036200 MOVE "NO " TO ERROR-TOTAL ST1324.2 +036300 ELSE ST1324.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1324.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1324.2 +036600 PERFORM WRITE-LINE. ST1324.2 +036700 END-ROUTINE-13. ST1324.2 +036800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1324.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE ST1324.2 +037000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1324.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1324.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO ST1324.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1324.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1324.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1324.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037900 WRITE-LINE. ST1324.2 +038000 ADD 1 TO RECORD-COUNT. ST1324.2 +038100Y IF RECORD-COUNT GREATER 42 ST1324.2 +038200Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +038300Y MOVE SPACE TO DUMMY-RECORD ST1324.2 +038400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +038500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1324.2 +038600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1324.2 +038700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1324.2 +038800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1324.2 +038900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039200Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +039300Y MOVE ZERO TO RECORD-COUNT. ST1324.2 +039400 PERFORM WRT-LN. ST1324.2 +039500 WRT-LN. ST1324.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +039700 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +039800 BLANK-LINE-PRINT. ST1324.2 +039900 PERFORM WRT-LN. ST1324.2 +040000 FAIL-ROUTINE. ST1324.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE ST1324.2 +040200 GO TO FAIL-ROUTINE-WRITE. ST1324.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1324.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1324.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1324.2 +040800 GO TO FAIL-ROUTINE-EX. ST1324.2 +040900 FAIL-ROUTINE-WRITE. ST1324.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1324.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1324.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1324.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1324.2 +041400 FAIL-ROUTINE-EX. EXIT. ST1324.2 +041500 BAIL-OUT. ST1324.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1324.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1324.2 +041800 BAIL-OUT-WRITE. ST1324.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1324.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1324.2 +042300 BAIL-OUT-EX. EXIT. ST1324.2 +042400 CCVS1-EXIT. ST1324.2 +042500 EXIT. ST1324.2 +042600 SRT-4 SECTION. ST1324.2 +042700 FOURTH-SORT. ST1324.2 +042800 SORT SORT4 ST1324.2 +042900 DESCENDING S4-KEY1 S4-KEY2 ST1324.2 +043000 INPUT PROCEDURE SRT-4-INPUT ST1324.2 +043100 OUTPUT PROCEDURE SRT-4-OUTPUT. ST1324.2 +043200 GO TO SRT-5. ST1324.2 +043300 SRT-4-INPUT SECTION. ST1324.2 +043400 P1-CREATE-S4. ST1324.2 +043500 ADD C1 TO SUBSCRIPT-1. ST1324.2 +043600 PERFORM P3-CREATE-S4 2 TIMES. ST1324.2 +043700 P2-CREATE-S4. ST1324.2 +043800 PERFORM P1-CREATE-S4. ST1324.2 +043900 GO TO SRT-4-IN-EXIT. ST1324.2 +044000 P3-CREATE-S4. ST1324.2 +044100 MOVE ALPHA-TBL (SUBSCRIPT-1) TO WKEY-1A. ST1324.2 +044200 MOVE C0 TO SUBSCRIPT-2. ST1324.2 +044300 PERFORM P4-CREATE-S4 25 TIMES. ST1324.2 +044400 P4-CREATE-S4. ST1324.2 +044500 ADD C1 TO SUBSCRIPT-2. ST1324.2 +044600 MOVE ALPHA-TBL (SUBSCRIPT-2) TO WKEY-1B. ST1324.2 +044700 MOVE WKEYS TO S4. ST1324.2 +044800 RELEASE S4. ST1324.2 +044900 IF WKEY-2B IS EQUAL TO 9 ST1324.2 +045000 IF WKEY-2A IS EQUAL TO 9 ST1324.2 +045100 MOVE 0 TO WKEY-2A ST1324.2 +045200 ELSE ST1324.2 +045300 ADD C1 TO WKEY-2A ST1324.2 +045400 END-IF ST1324.2 +045500 MOVE C0 TO WKEY-2B ST1324.2 +045600 ELSE ADD C1 TO WKEY-2B. ST1324.2 +045700 SRT-4-IN-EXIT. ST1324.2 +045800 EXIT. ST1324.2 +045900 SRT-4-OUTPUT SECTION. ST1324.2 +046000 OPEN-SRT4-OUT. ST1324.2 +046100 OPEN OUTPUT FILE4. ST1324.2 +046200 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1324.2 +046300 SORT-TEST-16. ST1324.2 +046400 PERFORM RETURN-SORT4. ST1324.2 +046500 IF S4-KEYS EQUAL TO "PQRBABCDEZ7912345679" ST1324.2 +046600 PERFORM PASS-1 GO TO SORT-WRITE-16. ST1324.2 +046700 GO TO SORT-FAIL-16. ST1324.2 +046800 SORT-DELETE-16. ST1324.2 +046900 PERFORM DE-LETE-1. ST1324.2 +047000 GO TO SORT-WRITE-16. ST1324.2 +047100 SORT-FAIL-16. ST1324.2 +047200 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +047300 MOVE "PQRBABCDEZ7912345679" TO CORRECT-A. ST1324.2 +047400 PERFORM FAIL-1. ST1324.2 +047500 SORT-WRITE-16. ST1324.2 +047600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1324.2 +047700 PERFORM PRINT-DETAIL-1. ST1324.2 +047800 SORT-TEST-17. ST1324.2 +047900 PERFORM RETURN-SORT4 59 TIMES. ST1324.2 +048000 IF S4-KEYS EQUAL TO "PQRAABCDEV7212345670" ST1324.2 +048100 PERFORM PASS-1 GO TO SORT-WRITE-17. ST1324.2 +048200 GO TO SORT-FAIL-17. ST1324.2 +048300 SORT-DELETE-17. ST1324.2 +048400 PERFORM DE-LETE-1. ST1324.2 +048500 GO TO SORT-WRITE-17. ST1324.2 +048600 SORT-FAIL-17. ST1324.2 +048700 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +048800 MOVE "PQRAABCDEV7212345670" TO CORRECT-A. ST1324.2 +048900 PERFORM FAIL-1. ST1324.2 +049000 SORT-WRITE-17. ST1324.2 +049100 MOVE "SORT-TEST-17" TO PAR-NAME. ST1324.2 +049200 PERFORM PRINT-DETAIL-1. ST1324.2 +049300 SORT-TEST-18. ST1324.2 +049400H CLOSE FILE4 REEL. ST1324.2 +049500 ST1324.2 +049600I MOVE "MINOR *CLOSE REEL* DELETED" TO RE-MARK. ST1324.2 +049700* NOTE CLOSE REEL DELETED FOR THIS RUN XXXXX XXXXX. ST1324.2 +049800 PERFORM RETURN-SORT4 40 TIMES. ST1324.2 +049900 IF S4-KEYS EQUAL TO "PQRAABCDEA7012345670" ST1324.2 +050000 PERFORM PASS-1 GO TO SORT-WRITE-18. ST1324.2 +050100 GO TO SORT-FAIL-18. ST1324.2 +050200 SORT-DELETE-18. ST1324.2 +050300 PERFORM DE-LETE-1. ST1324.2 +050400 GO TO SORT-WRITE-18. ST1324.2 +050500 SORT-FAIL-18. ST1324.2 +050600 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +050700 MOVE "PQRAABCDEA7012345670" TO CORRECT-A. ST1324.2 +050800 PERFORM FAIL-1. ST1324.2 +050900 SORT-WRITE-18. ST1324.2 +051000 MOVE "SORT-TEST-18" TO PAR-NAME. ST1324.2 +051100 PERFORM PRINT-DETAIL-1. ST1324.2 +051200 CLOSE-1. ST1324.2 +051300 CLOSE FILE4. ST1324.2 +051400 GO TO EXIT-1. ST1324.2 +051500 RETURN-SORT4. ST1324.2 +051600 RETURN SORT4 RECORD INTO R4 AT END GO TO TERMINAL-1. ST1324.2 +051700* NOTE RETURN WITH ALL OPTIONAL WORDS. ST1324.2 +051800 WRITE R4. ST1324.2 +051900 TERMINAL-1. ST1324.2 +052000 PERFORM FAIL-1. ST1324.2 +052100 MOVE "TERMINAL-1" TO PAR-NAME. ST1324.2 +052200 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1324.2 +052300 PERFORM PRINT-DETAIL-1. ST1324.2 +052400 MOVE SPACE TO FEATURE. ST1324.2 +052500 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1324.2 +052600 PERFORM PRINT-DETAIL-1. ST1324.2 +052700 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. ST1324.2 +052800 PERFORM PRINT-DETAIL-1. ST1324.2 +052900 GO TO CLOSE-1. ST1324.2 +053000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +053100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +053200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +053300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +053400 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +053500 PRINT-DETAIL-1. ST1324.2 +053600 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +053700 MOVE "." TO PARDOT-X ST1324.2 +053800 MOVE REC-CT TO DOTVALUE. ST1324.2 +053900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1324.2 +054000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1324.2 +054100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1324.2 +054200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1324.2 +054300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +054400 MOVE SPACE TO CORRECT-X. ST1324.2 +054500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +054600 MOVE SPACE TO RE-MARK. ST1324.2 +054700 WRITE-LINE-1. ST1324.2 +054800 ADD 1 TO RECORD-COUNT. ST1324.2 +054900Y IF RECORD-COUNT GREATER 50 ST1324.2 +055000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +055100Y MOVE SPACE TO DUMMY-RECORD ST1324.2 +055200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +055300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1324.2 +055400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1324.2 +055500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1324.2 +055600Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +055700Y MOVE ZERO TO RECORD-COUNT. ST1324.2 +055800 PERFORM WRT-LN-1. ST1324.2 +055900 WRT-LN-1. ST1324.2 +056000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +056100 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +056200 BLANK-LINE-PRINT-1. ST1324.2 +056300 PERFORM WRT-LN-1. ST1324.2 +056400 FAIL-ROUTINE-1. ST1324.2 +056500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1324.2 +056600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1324.2 +056700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +056800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +056900 GO TO FAIL-ROUTINE-EX-1. ST1324.2 +057000 FAIL-RTN-WRITE-1. ST1324.2 +057100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1324.2 +057200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +057300 FAIL-ROUTINE-EX-1. EXIT. ST1324.2 +057400 BAIL-OUT-1. ST1324.2 +057500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1324.2 +057600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1324.2 +057700 BAIL-OUT-WRITE-1. ST1324.2 +057800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +057900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +058000 BAIL-OUT-EX-1. EXIT. ST1324.2 +058100 EXIT-1. ST1324.2 +058200 EXIT. ST1324.2 +058300 SRT-5 SECTION. ST1324.2 +058400 FIFTH-SORT. ST1324.2 +058500 SORT SORT5 ST1324.2 +058600 ASCENDING S5-KEY1 S5-KEY2 ST1324.2 +058700 USING FILE4 ST1324.2 +058800 OUTPUT PROCEDURE SRT-5-OUTPUT. ST1324.2 +058900 GO TO SRT-6. ST1324.2 +059000 SRT-5-OUTPUT SECTION. ST1324.2 +059100 OPEN-SRT5-OUT. ST1324.2 +059200 OPEN OUTPUT FILE4. ST1324.2 +059300 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1324.2 +059400 SORT-TEST-19. ST1324.2 +059500 PERFORM RETURN-SORT5. ST1324.2 +059600 IF S5-KEYS EQUAL TO "PQRAABCDEA7012345670" ST1324.2 +059700 PERFORM PASS-2 GO TO SORT-WRITE-19. ST1324.2 +059800 GO TO SORT-FAIL-19. ST1324.2 +059900 SORT-DELETE-19. ST1324.2 +060000 PERFORM DE-LETE-2. ST1324.2 +060100 GO TO SORT-WRITE-19. ST1324.2 +060200 SORT-FAIL-19. ST1324.2 +060300 MOVE S5-KEYS TO COMPUTED-A. ST1324.2 +060400 MOVE "PQRAABCDEA7012345670" TO CORRECT-A. ST1324.2 +060500 PERFORM FAIL-2. ST1324.2 +060600 SORT-WRITE-19. ST1324.2 +060700 MOVE "SORT-TEST-19" TO PAR-NAME. ST1324.2 +060800 PERFORM PRINT-DETAIL-2. ST1324.2 +060900 SORT-TEST-20. ST1324.2 +061000 PERFORM RETURN-SORT5 99 TIMES. ST1324.2 +061100 IF S5-KEYS EQUAL TO "PQRBABCDEZ7912345679" ST1324.2 +061200 PERFORM PASS-2 GO TO SORT-WRITE-20. ST1324.2 +061300 GO TO SORT-FAIL-20. ST1324.2 +061400 SORT-DELETE-20. ST1324.2 +061500 PERFORM DE-LETE-2. ST1324.2 +061600 GO TO SORT-WRITE-20. ST1324.2 +061700 SORT-FAIL-20. ST1324.2 +061800 MOVE S5-KEYS TO COMPUTED-A. ST1324.2 +061900 MOVE "PQRBABCDEZ7912345679" TO CORRECT-A. ST1324.2 +062000 PERFORM FAIL-2. ST1324.2 +062100 SORT-WRITE-20. ST1324.2 +062200 MOVE "SORT-TEST-20" TO PAR-NAME. ST1324.2 +062300 PERFORM PRINT-DETAIL-2. ST1324.2 +062400 CLOSE-2. ST1324.2 +062500 CLOSE FILE4. ST1324.2 +062600 GO TO EXIT-2. ST1324.2 +062700 RETURN-SORT5. ST1324.2 +062800 RETURN SORT5 INTO R4 END GO TO TERMINAL-2. ST1324.2 +062900* NOTE RETURN WITHOUT OPTIONAL WORDS. ST1324.2 +063000 WRITE R4. ST1324.2 +063100 TERMINAL-2. ST1324.2 +063200 PERFORM FAIL-2. ST1324.2 +063300 MOVE "TERMINAL-2" TO PAR-NAME. ST1324.2 +063400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1324.2 +063500 PERFORM PRINT-DETAIL-2. ST1324.2 +063600 MOVE SPACE TO FEATURE. ST1324.2 +063700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1324.2 +063800 PERFORM PRINT-DETAIL-2. ST1324.2 +063900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1324.2 +064000 PERFORM PRINT-DETAIL-2. ST1324.2 +064100 GO TO CLOSE-2. ST1324.2 +064200 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +064300 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +064400 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +064500 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +064600 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +064700 PRINT-DETAIL-2. ST1324.2 +064800 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +064900 MOVE "." TO PARDOT-X ST1324.2 +065000 MOVE REC-CT TO DOTVALUE. ST1324.2 +065100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. ST1324.2 +065200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 ST1324.2 +065300 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 ST1324.2 +065400 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. ST1324.2 +065500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +065600 MOVE SPACE TO CORRECT-X. ST1324.2 +065700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +065800 MOVE SPACE TO RE-MARK. ST1324.2 +065900 WRITE-LINE-2. ST1324.2 +066000 ADD 1 TO RECORD-COUNT. ST1324.2 +066100Y IF RECORD-COUNT GREATER 50 ST1324.2 +066200Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +066300Y MOVE SPACE TO DUMMY-RECORD ST1324.2 +066400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +066500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 ST1324.2 +066600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES ST1324.2 +066700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 ST1324.2 +066800Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +066900Y MOVE ZERO TO RECORD-COUNT. ST1324.2 +067000 PERFORM WRT-LN-2. ST1324.2 +067100 WRT-LN-2. ST1324.2 +067200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +067300 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +067400 BLANK-LINE-PRINT-2. ST1324.2 +067500 PERFORM WRT-LN-2. ST1324.2 +067600 FAIL-ROUTINE-2. ST1324.2 +067700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1324.2 +067800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1324.2 +067900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +068000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +068100 GO TO FAIL-ROUTINE-EX-2. ST1324.2 +068200 FAIL-RTN-WRITE-2. ST1324.2 +068300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 ST1324.2 +068400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +068500 FAIL-ROUTINE-EX-2. EXIT. ST1324.2 +068600 BAIL-OUT-2. ST1324.2 +068700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. ST1324.2 +068800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. ST1324.2 +068900 BAIL-OUT-WRITE-2. ST1324.2 +069000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +069100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +069200 BAIL-OUT-EX-2. EXIT. ST1324.2 +069300 EXIT-2. ST1324.2 +069400 EXIT. ST1324.2 +069500 SRT-6 SECTION. ST1324.2 +069600 SIXTH-SORT. ST1324.2 +069700 SORT SORT4 ST1324.2 +069800 ASCENDING S4-KEY2 ST1324.2 +069900 USING FILE4 ST1324.2 +070000 OUTPUT PROCEDURE SRT-6-OUTPUT. ST1324.2 +070100 STOP-RUN. ST1324.2 +070200 GO TO CCVS-EXIT. ST1324.2 +070300 SRT-6-OUTPUT SECTION. ST1324.2 +070400 SORT-TEST-21. ST1324.2 +070500 PERFORM PASS-3. ST1324.2 +070600 MOVE "2 SORTS ON ONE FILE" TO FEATURE. ST1324.2 +070700 MOVE "SORT-TEST-21" TO PAR-NAME. ST1324.2 +070800 PERFORM PRINT-DETAIL-3. ST1324.2 +070900* NOTE THIS TESTS THE ABILITY TO SORT A FILE A SECOND TIME.ST1324.2 +071000 GO TO EXIT-3. ST1324.2 +071100 RETURN-FOR-THE-HELLUVIT. ST1324.2 +071200 RETURN SORT4 AT END GO TO PASS-3. ST1324.2 +071300* NOTE THE STANDARD REQUIRES THAT EVERY OUTPUT PROCEDURE ST1324.2 +071400* HAVE AT LEAST ONE RETURN STATEMENT --- THE ABOVE ST1324.2 +071500* STATEMENT IS COMPILED BUT NEVER EXECUTED. ST1324.2 +071600 PASS-3. ST1324.2 +071700 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +071800 FAIL-3. ST1324.2 +071900 ADD 1 TO ERROR-COUNTER. ST1324.2 +072000 MOVE "FAIL*" TO P-OR-F. ST1324.2 +072100 DE-LETE-3. ST1324.2 +072200 MOVE SPACE TO P-OR-F. ST1324.2 +072300 MOVE " ************ " TO COMPUTED-A. ST1324.2 +072400 MOVE " ************ " TO CORRECT-A. ST1324.2 +072500 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +072600 ADD 1 TO DELETE-COUNTER. ST1324.2 +072700 PRINT-DETAIL-3. ST1324.2 +072800 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +072900 MOVE "." TO PARDOT-X ST1324.2 +073000 MOVE REC-CT TO DOTVALUE. ST1324.2 +073100 MOVE TEST-RESULTS TO PRINT-REC. ST1324.2 +073200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +073300 MOVE SPACE TO P-OR-F. ST1324.2 +073400 MOVE SPACE TO COMPUTED-A. ST1324.2 +073500 MOVE SPACE TO CORRECT-A. ST1324.2 +073600 IF REC-CT EQUAL TO ZERO ST1324.2 +073700 MOVE SPACE TO PAR-NAME. ST1324.2 +073800 MOVE SPACE TO RE-MARK. ST1324.2 +073900 EXIT-3. ST1324.2 +074000 EXIT. ST1324.2 +074100 CCVS-EXIT SECTION. ST1324.2 +074200 CCVS-999999. ST1324.2 +074300 GO TO CLOSE-FILES. ST1324.2 +*END-OF,ST132A +*HEADER,COBOL,ST133A +000100 IDENTIFICATION DIVISION. ST1334.2 +000200 PROGRAM-ID. ST1334.2 +000300 ST133A. ST1334.2 +000400**************************************************************** ST1334.2 +000500* * ST1334.2 +000600* VALIDATION FOR:- * ST1334.2 +000700* * ST1334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +000900* * ST1334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1334.2 +001100* * ST1334.2 +001200**************************************************************** ST1334.2 +001300* * ST1334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1334.2 +001500* * ST1334.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1334.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1334.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1334.2 +001900* * ST1334.2 +002000**************************************************************** ST1334.2 +002100* ST1334.2 +002200* ST133 DOES TWO SORTS ON THE SAME SET OF 80-CHARACTER RECORDS.ST1334.2 +002300* THESE RECORDS ARE SHOWN BELOW. THE FIRST SORT EMPLOYS THE ST1334.2 +002400* COMBINATION INPUT PROCEDURE, GIVING. THE SECOND SORT EMPLOYS ST1334.2 +002500* USING, OUTPUT PROCEDURE. THE OUTPUT FILE FROM THE FIRST SORT ST1334.2 +002600* BECOMES THE INPUT FILE FOR THE SECOND SORT. ST1334.2 +002700* ST1334.2 +002800* THE RESULTS OF BOTH SORTS ARE REFLECTED IN THE INPUT AND ST1334.2 +002900* OUTPUT FILES ASSOCIATED WITH THE SECOND SORT. BECAUSE OF ST1334.2 +003000* THIS, THE CONTENTS OF BOTH FILES ARE SPOT-CHECKED IN THE ST1334.2 +003100* OUTPUT PROCEDURE. TO DO THIS, IT IS NECESSARY TO REFER TO ST1334.2 +003200* BOTH FILES IN THE OUTPUT PROCEDURE. IN ADDITION, BOTH FILES ST1334.2 +003300* ARE REFERENCED IN THE MAINLINE BETWEEN THE SORTS. ST1334.2 +003400* BEFORE SORTS AFTER FIRST SORT AFTER SECOND SORT ST1334.2 +003500* NON-KEY KEY NON-KEY KEY NON-KEY KEY ST1334.2 +003600* X(72) S9(8) X(72) S9(8) X(72) S9(8) ST1334.2 +003700* ST1334.2 +003800* A 00000000 A +00000099 A -00000199 ST1334.2 +003900* A +00000001 A +00000098 A -00000198 ST1334.2 +004000* A +00000002 A +00000097 A -00000197 ST1334.2 +004100* . . . . . . ST1334.2 +004200* . . . . . . ST1334.2 +004300* . . . . . . ST1334.2 +004400* A +00000098 A +00000001 A -00000101 ST1334.2 +004500* A +00000099 A 00000000 A -00000100 ST1334.2 +004600* A -00000100 A -00000100 A 00000000 ST1334.2 +004700* A -00000101 A -00000101 A +00000001 ST1334.2 +004800* . . . . . . ST1334.2 +004900* . . . . . . ST1334.2 +005000* . . . . . . ST1334.2 +005100* A -00000199 A -00000199 A +00000099 ST1334.2 +005200* THE NON-KEY ITEMS ARE ALL JUSTIFIED RIGHT. ST1334.2 +005300* ST1334.2 +005400* THE SAME SORT AREA CLAUSE IS EXERCISED IN THIS PROGRAM. ST1334.2 +005500* ST1334.2 +005600 ENVIRONMENT DIVISION. ST1334.2 +005700 CONFIGURATION SECTION. ST1334.2 +005800 SOURCE-COMPUTER. ST1334.2 +005900 XXXXX082. ST1334.2 +006000 OBJECT-COMPUTER. ST1334.2 +006100 XXXXX083. ST1334.2 +006200 INPUT-OUTPUT SECTION. ST1334.2 +006300 FILE-CONTROL. ST1334.2 +006400 SELECT PRINT-FILE ASSIGN TO ST1334.2 +006500 XXXXX055. ST1334.2 +006600 SELECT FIRST-SORTFILE ASSIGN TO ST1334.2 +006700 XXXXX027. ST1334.2 +006800 SELECT SECOND-SORTFILE ASSIGN TO ST1334.2 +006900 XXXXX028. ST1334.2 +007000 SELECT SORTIN-2C ASSIGN TO ST1334.2 +007100 XXXXX001. ST1334.2 +007200 SELECT SORTOUT-2C ASSIGN TO ST1334.2 +007300 XXXXX002. ST1334.2 +007400 I-O-CONTROL. ST1334.2 +007500 SAME SORT AREA FOR FIRST-SORTFILE ST1334.2 +007600 SECOND-SORTFILE. ST1334.2 +007700 DATA DIVISION. ST1334.2 +007800 FILE SECTION. ST1334.2 +007900 FD PRINT-FILE. ST1334.2 +008000 01 PRINT-REC PICTURE X(120). ST1334.2 +008100 01 DUMMY-RECORD PICTURE X(120). ST1334.2 +008200 FD SORTIN-2C ST1334.2 +008300 LABEL RECORDS STANDARD ST1334.2 +008400C VALUE OF ST1334.2 +008500C XXXXX074 ST1334.2 +008600C IS ST1334.2 +008700C XXXXX075 ST1334.2 +008800G XXXXX069 ST1334.2 +008900 DATA RECORD IS SORTIN-REC. ST1334.2 +009000 01 SORTIN-REC. ST1334.2 +009100 02 SORTIN-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +009200 02 SORTIN-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +009300 FD SORTOUT-2C ST1334.2 +009400 LABEL RECORDS STANDARD ST1334.2 +009500C VALUE OF ST1334.2 +009600C XXXXX074 ST1334.2 +009700C IS ST1334.2 +009800C XXXXX076 ST1334.2 +009900G XXXXX069 ST1334.2 +010000 DATA RECORD IS SORTOUT-REC. ST1334.2 +010100 01 SORTOUT-REC. ST1334.2 +010200 02 SORTOUT-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +010300 02 SORTOUT-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +010400 SD FIRST-SORTFILE ST1334.2 +010500 DATA RECORD IS FIRST-SORTFILE-REC. ST1334.2 +010600 01 FIRST-SORTFILE-REC. ST1334.2 +010700 02 FIRST-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +010800 02 FIRST-KEY PICTURE S9(8) USAGE IS COMPUTATIONAL. ST1334.2 +010900 SD SECOND-SORTFILE. ST1334.2 +011000 01 SECOND-SORTFILE-REC. ST1334.2 +011100 02 SECOND-NON-KEY PICTURE X(72) JUSTIFIED. ST1334.2 +011200 02 SECOND-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +011300 WORKING-STORAGE SECTION. ST1334.2 +011400 77 BREAKDOWN-SWITCH PICTURE 9 VALUE ZERO. ST1334.2 +011500 77 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1334.2 +011600 77 UTIL-CTR PICTURE S99999. ST1334.2 +011700 77 JUSTIFIED-A PICTURE X(72) VALUE " ST1334.2 +011800- " A". ST1334.2 +011900 01 COMPUTED-BREAKDOWN. ST1334.2 +012000 02 FIRST-20 PICTURE X(20). ST1334.2 +012100 02 SECOND-20 PICTURE X(20). ST1334.2 +012200 02 THIRD-20 PICTURE X(20). ST1334.2 +012300 02 FOURTH-20 PICTURE X(20). ST1334.2 +012400 01 FILE-RECORD-INFORMATION-REC. ST1334.2 +012500 03 FILE-RECORD-INFO-SKELETON. ST1334.2 +012600 05 FILLER PICTURE X(48) VALUE ST1334.2 +012700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1334.2 +012800 05 FILLER PICTURE X(46) VALUE ST1334.2 +012900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1334.2 +013000 05 FILLER PICTURE X(26) VALUE ST1334.2 +013100 ",LFIL=000000,ORG= ,LBLR= ". ST1334.2 +013200 05 FILLER PICTURE X(37) VALUE ST1334.2 +013300 ",RECKEY= ". ST1334.2 +013400 05 FILLER PICTURE X(38) VALUE ST1334.2 +013500 ",ALTKEY1= ". ST1334.2 +013600 05 FILLER PICTURE X(38) VALUE ST1334.2 +013700 ",ALTKEY2= ". ST1334.2 +013800 05 FILLER PICTURE X(7) VALUE SPACE.ST1334.2 +013900 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1334.2 +014000 05 FILE-RECORD-INFO-P1-120. ST1334.2 +014100 07 FILLER PIC X(5). ST1334.2 +014200 07 XFILE-NAME PIC X(6). ST1334.2 +014300 07 FILLER PIC X(8). ST1334.2 +014400 07 XRECORD-NAME PIC X(6). ST1334.2 +014500 07 FILLER PIC X(1). ST1334.2 +014600 07 REELUNIT-NUMBER PIC 9(1). ST1334.2 +014700 07 FILLER PIC X(7). ST1334.2 +014800 07 XRECORD-NUMBER PIC 9(6). ST1334.2 +014900 07 FILLER PIC X(6). ST1334.2 +015000 07 UPDATE-NUMBER PIC 9(2). ST1334.2 +015100 07 FILLER PIC X(5). ST1334.2 +015200 07 ODO-NUMBER PIC 9(4). ST1334.2 +015300 07 FILLER PIC X(5). ST1334.2 +015400 07 XPROGRAM-NAME PIC X(5). ST1334.2 +015500 07 FILLER PIC X(7). ST1334.2 +015600 07 XRECORD-LENGTH PIC 9(6). ST1334.2 +015700 07 FILLER PIC X(7). ST1334.2 +015800 07 CHARS-OR-RECORDS PIC X(2). ST1334.2 +015900 07 FILLER PIC X(1). ST1334.2 +016000 07 XBLOCK-SIZE PIC 9(4). ST1334.2 +016100 07 FILLER PIC X(6). ST1334.2 +016200 07 RECORDS-IN-FILE PIC 9(6). ST1334.2 +016300 07 FILLER PIC X(5). ST1334.2 +016400 07 XFILE-ORGANIZATION PIC X(2). ST1334.2 +016500 07 FILLER PIC X(6). ST1334.2 +016600 07 XLABEL-TYPE PIC X(1). ST1334.2 +016700 05 FILE-RECORD-INFO-P121-240. ST1334.2 +016800 07 FILLER PIC X(8). ST1334.2 +016900 07 XRECORD-KEY PIC X(29). ST1334.2 +017000 07 FILLER PIC X(9). ST1334.2 +017100 07 ALTERNATE-KEY1 PIC X(29). ST1334.2 +017200 07 FILLER PIC X(9). ST1334.2 +017300 07 ALTERNATE-KEY2 PIC X(29). ST1334.2 +017400 07 FILLER PIC X(7). ST1334.2 +017500 01 TEST-RESULTS. ST1334.2 +017600 02 FILLER PIC X VALUE SPACE. ST1334.2 +017700 02 FEATURE PIC X(20) VALUE SPACE. ST1334.2 +017800 02 FILLER PIC X VALUE SPACE. ST1334.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. ST1334.2 +018000 02 FILLER PIC X VALUE SPACE. ST1334.2 +018100 02 PAR-NAME. ST1334.2 +018200 03 FILLER PIC X(19) VALUE SPACE. ST1334.2 +018300 03 PARDOT-X PIC X VALUE SPACE. ST1334.2 +018400 03 DOTVALUE PIC 99 VALUE ZERO. ST1334.2 +018500 02 FILLER PIC X(8) VALUE SPACE. ST1334.2 +018600 02 RE-MARK PIC X(61). ST1334.2 +018700 01 TEST-COMPUTED. ST1334.2 +018800 02 FILLER PIC X(30) VALUE SPACE. ST1334.2 +018900 02 FILLER PIC X(17) VALUE ST1334.2 +019000 " COMPUTED=". ST1334.2 +019100 02 COMPUTED-X. ST1334.2 +019200 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1334.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A ST1334.2 +019400 PIC -9(9).9(9). ST1334.2 +019500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1334.2 +019600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1334.2 +019700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1334.2 +019800 03 CM-18V0 REDEFINES COMPUTED-A. ST1334.2 +019900 04 COMPUTED-18V0 PIC -9(18). ST1334.2 +020000 04 FILLER PIC X. ST1334.2 +020100 03 FILLER PIC X(50) VALUE SPACE. ST1334.2 +020200 01 TEST-CORRECT. ST1334.2 +020300 02 FILLER PIC X(30) VALUE SPACE. ST1334.2 +020400 02 FILLER PIC X(17) VALUE " CORRECT =". ST1334.2 +020500 02 CORRECT-X. ST1334.2 +020600 03 CORRECT-A PIC X(20) VALUE SPACE. ST1334.2 +020700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1334.2 +020800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1334.2 +020900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1334.2 +021000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1334.2 +021100 03 CR-18V0 REDEFINES CORRECT-A. ST1334.2 +021200 04 CORRECT-18V0 PIC -9(18). ST1334.2 +021300 04 FILLER PIC X. ST1334.2 +021400 03 FILLER PIC X(2) VALUE SPACE. ST1334.2 +021500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1334.2 +021600 01 CCVS-C-1. ST1334.2 +021700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1334.2 +021800- "SS PARAGRAPH-NAME ST1334.2 +021900- " REMARKS". ST1334.2 +022000 02 FILLER PIC X(20) VALUE SPACE. ST1334.2 +022100 01 CCVS-C-2. ST1334.2 +022200 02 FILLER PIC X VALUE SPACE. ST1334.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". ST1334.2 +022400 02 FILLER PIC X(15) VALUE SPACE. ST1334.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". ST1334.2 +022600 02 FILLER PIC X(94) VALUE SPACE. ST1334.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1334.2 +022800 01 REC-CT PIC 99 VALUE ZERO. ST1334.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1334.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1334.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1334.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1334.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1334.2 +023800 01 CCVS-H-1. ST1334.2 +023900 02 FILLER PIC X(39) VALUE SPACES. ST1334.2 +024000 02 FILLER PIC X(42) VALUE ST1334.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1334.2 +024200 02 FILLER PIC X(39) VALUE SPACES. ST1334.2 +024300 01 CCVS-H-2A. ST1334.2 +024400 02 FILLER PIC X(40) VALUE SPACE. ST1334.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1334.2 +024600 02 FILLER PIC XXXX VALUE ST1334.2 +024700 "4.2 ". ST1334.2 +024800 02 FILLER PIC X(28) VALUE ST1334.2 +024900 " COPY - NOT FOR DISTRIBUTION". ST1334.2 +025000 02 FILLER PIC X(41) VALUE SPACE. ST1334.2 +025100 ST1334.2 +025200 01 CCVS-H-2B. ST1334.2 +025300 02 FILLER PIC X(15) VALUE ST1334.2 +025400 "TEST RESULT OF ". ST1334.2 +025500 02 TEST-ID PIC X(9). ST1334.2 +025600 02 FILLER PIC X(4) VALUE ST1334.2 +025700 " IN ". ST1334.2 +025800 02 FILLER PIC X(12) VALUE ST1334.2 +025900 " HIGH ". ST1334.2 +026000 02 FILLER PIC X(22) VALUE ST1334.2 +026100 " LEVEL VALIDATION FOR ". ST1334.2 +026200 02 FILLER PIC X(58) VALUE ST1334.2 +026300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +026400 01 CCVS-H-3. ST1334.2 +026500 02 FILLER PIC X(34) VALUE ST1334.2 +026600 " FOR OFFICIAL USE ONLY ". ST1334.2 +026700 02 FILLER PIC X(58) VALUE ST1334.2 +026800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1334.2 +026900 02 FILLER PIC X(28) VALUE ST1334.2 +027000 " COPYRIGHT 1985 ". ST1334.2 +027100 01 CCVS-E-1. ST1334.2 +027200 02 FILLER PIC X(52) VALUE SPACE. ST1334.2 +027300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1334.2 +027400 02 ID-AGAIN PIC X(9). ST1334.2 +027500 02 FILLER PIC X(45) VALUE SPACES. ST1334.2 +027600 01 CCVS-E-2. ST1334.2 +027700 02 FILLER PIC X(31) VALUE SPACE. ST1334.2 +027800 02 FILLER PIC X(21) VALUE SPACE. ST1334.2 +027900 02 CCVS-E-2-2. ST1334.2 +028000 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1334.2 +028100 03 FILLER PIC X VALUE SPACE. ST1334.2 +028200 03 ENDER-DESC PIC X(44) VALUE ST1334.2 +028300 "ERRORS ENCOUNTERED". ST1334.2 +028400 01 CCVS-E-3. ST1334.2 +028500 02 FILLER PIC X(22) VALUE ST1334.2 +028600 " FOR OFFICIAL USE ONLY". ST1334.2 +028700 02 FILLER PIC X(12) VALUE SPACE. ST1334.2 +028800 02 FILLER PIC X(58) VALUE ST1334.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +029000 02 FILLER PIC X(13) VALUE SPACE. ST1334.2 +029100 02 FILLER PIC X(15) VALUE ST1334.2 +029200 " COPYRIGHT 1985". ST1334.2 +029300 01 CCVS-E-4. ST1334.2 +029400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1334.2 +029500 02 FILLER PIC X(4) VALUE " OF ". ST1334.2 +029600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1334.2 +029700 02 FILLER PIC X(40) VALUE ST1334.2 +029800 " TESTS WERE EXECUTED SUCCESSFULLY". ST1334.2 +029900 01 XXINFO. ST1334.2 +030000 02 FILLER PIC X(19) VALUE ST1334.2 +030100 "*** INFORMATION ***". ST1334.2 +030200 02 INFO-TEXT. ST1334.2 +030300 04 FILLER PIC X(8) VALUE SPACE. ST1334.2 +030400 04 XXCOMPUTED PIC X(20). ST1334.2 +030500 04 FILLER PIC X(5) VALUE SPACE. ST1334.2 +030600 04 XXCORRECT PIC X(20). ST1334.2 +030700 02 INF-ANSI-REFERENCE PIC X(48). ST1334.2 +030800 01 HYPHEN-LINE. ST1334.2 +030900 02 FILLER PIC IS X VALUE IS SPACE. ST1334.2 +031000 02 FILLER PIC IS X(65) VALUE IS "************************ST1334.2 +031100- "*****************************************". ST1334.2 +031200 02 FILLER PIC IS X(54) VALUE IS "************************ST1334.2 +031300- "******************************". ST1334.2 +031400 01 CCVS-PGM-ID PIC X(9) VALUE ST1334.2 +031500 "ST133A". ST1334.2 +031600 PROCEDURE DIVISION. ST1334.2 +031700 CCVS1 SECTION. ST1334.2 +031800 OPEN-FILES. ST1334.2 +031900 OPEN OUTPUT PRINT-FILE. ST1334.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1334.2 +032100 MOVE SPACE TO TEST-RESULTS. ST1334.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1334.2 +032300 GO TO CCVS1-EXIT. ST1334.2 +032400 CLOSE-FILES. ST1334.2 +032500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1334.2 +032600 TERMINATE-CCVS. ST1334.2 +032700S EXIT PROGRAM. ST1334.2 +032800STERMINATE-CALL. ST1334.2 +032900 STOP RUN. ST1334.2 +033000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1334.2 +033100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1334.2 +033200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1334.2 +033300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1334.2 +033400 MOVE "****TEST DELETED****" TO RE-MARK. ST1334.2 +033500 PRINT-DETAIL. ST1334.2 +033600 IF REC-CT NOT EQUAL TO ZERO ST1334.2 +033700 MOVE "." TO PARDOT-X ST1334.2 +033800 MOVE REC-CT TO DOTVALUE. ST1334.2 +033900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1334.2 +034000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1334.2 +034100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1334.2 +034200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1334.2 +034300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1334.2 +034400 MOVE SPACE TO CORRECT-X. ST1334.2 +034500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1334.2 +034600 MOVE SPACE TO RE-MARK. ST1334.2 +034700 HEAD-ROUTINE. ST1334.2 +034800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +034900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +035000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1334.2 +035100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1334.2 +035200 COLUMN-NAMES-ROUTINE. ST1334.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +035600 END-ROUTINE. ST1334.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1334.2 +035800 END-RTN-EXIT. ST1334.2 +035900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +036000 END-ROUTINE-1. ST1334.2 +036100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1334.2 +036200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1334.2 +036300 ADD PASS-COUNTER TO ERROR-HOLD. ST1334.2 +036400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1334.2 +036500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1334.2 +036600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1334.2 +036700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1334.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1334.2 +036900 END-ROUTINE-12. ST1334.2 +037000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1334.2 +037100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1334.2 +037200 MOVE "NO " TO ERROR-TOTAL ST1334.2 +037300 ELSE ST1334.2 +037400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1334.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1334.2 +037600 PERFORM WRITE-LINE. ST1334.2 +037700 END-ROUTINE-13. ST1334.2 +037800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1334.2 +037900 MOVE "NO " TO ERROR-TOTAL ELSE ST1334.2 +038000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1334.2 +038100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1334.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038300 IF INSPECT-COUNTER EQUAL TO ZERO ST1334.2 +038400 MOVE "NO " TO ERROR-TOTAL ST1334.2 +038500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1334.2 +038600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1334.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038900 WRITE-LINE. ST1334.2 +039000 ADD 1 TO RECORD-COUNT. ST1334.2 +039100Y IF RECORD-COUNT GREATER 42 ST1334.2 +039200Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1334.2 +039300Y MOVE SPACE TO DUMMY-RECORD ST1334.2 +039400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1334.2 +039500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1334.2 +039600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1334.2 +039700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1334.2 +039800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1334.2 +039900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040200Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1334.2 +040300Y MOVE ZERO TO RECORD-COUNT. ST1334.2 +040400 PERFORM WRT-LN. ST1334.2 +040500 WRT-LN. ST1334.2 +040600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1334.2 +040700 MOVE SPACE TO DUMMY-RECORD. ST1334.2 +040800 BLANK-LINE-PRINT. ST1334.2 +040900 PERFORM WRT-LN. ST1334.2 +041000 FAIL-ROUTINE. ST1334.2 +041100 IF COMPUTED-X NOT EQUAL TO SPACE ST1334.2 +041200 GO TO FAIL-ROUTINE-WRITE. ST1334.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1334.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1334.2 +041500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1334.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1334.2 +041800 GO TO FAIL-ROUTINE-EX. ST1334.2 +041900 FAIL-ROUTINE-WRITE. ST1334.2 +042000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1334.2 +042100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1334.2 +042200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1334.2 +042300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1334.2 +042400 FAIL-ROUTINE-EX. EXIT. ST1334.2 +042500 BAIL-OUT. ST1334.2 +042600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1334.2 +042700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1334.2 +042800 BAIL-OUT-WRITE. ST1334.2 +042900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1334.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1334.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1334.2 +043300 BAIL-OUT-EX. EXIT. ST1334.2 +043400 CCVS1-EXIT. ST1334.2 +043500 EXIT. ST1334.2 +043600 MAINLINE SECTION. ST1334.2 +043700 FIRST-SORT-PARA. ST1334.2 +043800 SORT FIRST-SORTFILE ON DESCENDING KEY ST1334.2 +043900 FIRST-KEY ST1334.2 +044000 INPUT PROCEDURE INPROC ST1334.2 +044100 GIVING SORTOUT-2C. ST1334.2 +044200 MOVE "FIRST SORT DONE" TO FEATURE. ST1334.2 +044300 PERFORM PRINT-DETAIL. ST1334.2 +044400 TAPECOPY-OPEN. ST1334.2 +044500 OPEN INPUT SORTOUT-2C. ST1334.2 +044600 OPEN OUTPUT SORTIN-2C. ST1334.2 +044700 TAPECOPY-LOOP. ST1334.2 +044800 READ SORTOUT-2C AT END GO TO TAPECOPY-CLOSE. ST1334.2 +044900 MOVE SORTOUT-REC TO SORTIN-REC. ST1334.2 +045000 WRITE SORTIN-REC. ST1334.2 +045100 GO TO TAPECOPY-LOOP. ST1334.2 +045200 TAPECOPY-CLOSE. ST1334.2 +045300 CLOSE SORTIN-2C. ST1334.2 +045400 CLOSE SORTOUT-2C. ST1334.2 +045500 MOVE "TAPE COPY DONE" TO FEATURE. ST1334.2 +045600 PERFORM PRINT-DETAIL. ST1334.2 +045700* NOTE THIS TAPECOPY ROUTINE HAS NO EFFECT ON THE SORTS ---ST1334.2 +045800* ITS ONLY FUNCTION IS TO EXERCISE THE OPEN, CLOSE, ST1334.2 +045900* READ, AND WRITE VERBS IN THE MAINLINE. ST1334.2 +046000 SECOND-SORT-PARA. ST1334.2 +046100 SORT SECOND-SORTFILE ON ASCENDING KEY ST1334.2 +046200 SECOND-KEY ST1334.2 +046300 USING SORTOUT-2C ST1334.2 +046400 OUTPUT PROCEDURE OUTPROC. ST1334.2 +046500 MOVE "SECOND SORT DONE" TO FEATURE. ST1334.2 +046600 PERFORM PRINT-DETAIL. ST1334.2 +046700 GO TO CCVS-EXIT. ST1334.2 +046800 INPROC SECTION. ST1334.2 +046900 INPROC-INIT. ST1334.2 +047000 MOVE ZERO TO UTIL-CTR. ST1334.2 +047100 INPROC-LOOP. ST1334.2 +047200 IF UTIL-CTR LESS THAN 100 ST1334.2 +047300 MOVE UTIL-CTR TO FIRST-KEY ST1334.2 +047400 ELSE ST1334.2 +047500 MULTIPLY UTIL-CTR BY -1 GIVING FIRST-KEY. ST1334.2 +047600 MOVE "A" TO FIRST-NON-KEY. ST1334.2 +047700 RELEASE FIRST-SORTFILE-REC. ST1334.2 +047800 ADD 1 TO UTIL-CTR. ST1334.2 +047900 IF UTIL-CTR LESS THAN 200 GO TO INPROC-LOOP. ST1334.2 +048000 INPROC-EXIT. ST1334.2 +048100 EXIT. ST1334.2 +048200 OUTPROC SECTION. ST1334.2 +048300 SORT-INIT-1. ST1334.2 +048400 MOVE ZERO TO UTIL-CTR. ST1334.2 +048500 SORT-TEST-1. ST1334.2 +048600 MOVE "NUMERIC KEY CHECKS" TO FEATURE. ST1334.2 +048700 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1334.2 +048800 PERFORM RETURN-SORTFILE. ST1334.2 +048900 IF SECOND-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-1. ST1334.2 +049000 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +049100 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1334.2 +049200 SORT-FAIL-1. ST1334.2 +049300 PERFORM FAIL-1. ST1334.2 +049400 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +049500 MOVE -199 TO CORRECT-N ST1334.2 +049600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +049700 PERFORM PRINT-DETAIL-1. ST1334.2 +049800 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +049900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +050000 SORT-WRITE-1. ST1334.2 +050100 PERFORM PRINT-DETAIL-1. ST1334.2 +050200 SORT-TEST-2. ST1334.2 +050300 MOVE "SORT-TEST-2" TO PAR-NAME. ST1334.2 +050400 PERFORM RETURN-SORTFILE. ST1334.2 +050500 IF SECOND-KEY NOT EQUAL TO -198 GO TO SORT-FAIL-2. ST1334.2 +050600 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +050700 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1334.2 +050800 SORT-FAIL-2. ST1334.2 +050900 PERFORM FAIL-1. ST1334.2 +051000 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +051100 MOVE -198 TO CORRECT-N ST1334.2 +051200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +051300 PERFORM PRINT-DETAIL-1. ST1334.2 +051400 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +051500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +051600 SORT-WRITE-2. ST1334.2 +051700 PERFORM PRINT-DETAIL-1. ST1334.2 +051800 SORT-TEST-3. ST1334.2 +051900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1334.2 +052000 PERFORM RETURN-SORTFILE 98 TIMES. ST1334.2 +052100 IF SECOND-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-3. ST1334.2 +052200 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +052300 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1334.2 +052400 SORT-FAIL-3. ST1334.2 +052500 PERFORM FAIL-1. ST1334.2 +052600 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +052700 MOVE -100 TO CORRECT-N. ST1334.2 +052800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +052900 PERFORM PRINT-DETAIL-1. ST1334.2 +053000 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +053100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +053200 SORT-WRITE-3. ST1334.2 +053300 PERFORM PRINT-DETAIL-1. ST1334.2 +053400 SORT-TEST-4. ST1334.2 +053500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1334.2 +053600 PERFORM RETURN-SORTFILE. ST1334.2 +053700 IF SECOND-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-4. ST1334.2 +053800 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +053900 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1334.2 +054000 SORT-FAIL-4. ST1334.2 +054100 PERFORM FAIL-1. ST1334.2 +054200 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +054300 MOVE ZERO TO CORRECT-N. ST1334.2 +054400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +054500 PERFORM PRINT-DETAIL-1. ST1334.2 +054600 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +054700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +054800 SORT-WRITE-4. ST1334.2 +054900 PERFORM PRINT-DETAIL-1. ST1334.2 +055000 SORT-TEST-5. ST1334.2 +055100 MOVE "SORT-TEST-5" TO PAR-NAME. ST1334.2 +055200 PERFORM RETURN-SORTFILE 99 TIMES. ST1334.2 +055300 IF SECOND-KEY NOT EQUAL TO 99 GO TO SORT-FAIL-5. ST1334.2 +055400 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +055500 PERFORM PASS-1 GO TO SORT-WRITE-5. ST1334.2 +055600 SORT-FAIL-5. ST1334.2 +055700 PERFORM FAIL-1. ST1334.2 +055800 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +055900 MOVE +99 TO CORRECT-N ST1334.2 +056000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +056100 PERFORM PRINT-DETAIL-1. ST1334.2 +056200 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +056300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +056400 SORT-WRITE-5. ST1334.2 +056500 PERFORM PRINT-DETAIL-1. ST1334.2 +056600 SORT-TEST-6. ST1334.2 +056700 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1334.2 +056800 RETURN SECOND-SORTFILE AT END ST1334.2 +056900 PERFORM PASS-1 GO TO SORT-WRITE-6. ST1334.2 +057000 SORT-FAIL-6. ST1334.2 +057100 PERFORM FAIL-1. ST1334.2 +057200 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +057300 MOVE 201 TO CORRECT-N. ST1334.2 +057400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +057500 PERFORM PRINT-DETAIL-1. ST1334.2 +057600 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +057700 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +057800 PERFORM PRINT-DETAIL-1. ST1334.2 +057900 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +058000 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +058100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +058200 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +058300 SORT-WRITE-6. ST1334.2 +058400 PERFORM PRINT-DETAIL-1. ST1334.2 +058500 SORT-EXIT-A. ST1334.2 +058600 EXIT. ST1334.2 +058700 SORT-INIT-B. ST1334.2 +058800 MOVE ZERO TO UTIL-CTR. ST1334.2 +058900 OPEN INPUT SORTOUT-2C. ST1334.2 +059000 SORT-TEST-7. ST1334.2 +059100 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1334.2 +059200 PERFORM READ-SORTOUT. ST1334.2 +059300 IF SORTOUT-KEY NOT EQUAL TO +99 GO TO SORT-FAIL-7. ST1334.2 +059400 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +059500 PERFORM PASS-1 GO TO SORT-WRITE-7. ST1334.2 +059600 SORT-FAIL-7. ST1334.2 +059700 PERFORM FAIL-1. ST1334.2 +059800 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +059900 MOVE +99 TO CORRECT-N ST1334.2 +060000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +060100 PERFORM PRINT-DETAIL-1. ST1334.2 +060200 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +060300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +060400 SORT-WRITE-7. ST1334.2 +060500 PERFORM PRINT-DETAIL-1. ST1334.2 +060600 SORT-TEST-8. ST1334.2 +060700 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1334.2 +060800 PERFORM READ-SORTOUT. ST1334.2 +060900 IF SORTOUT-KEY NOT EQUAL TO +98 GO TO SORT-FAIL-8. ST1334.2 +061000 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +061100 PERFORM PASS-1 GO TO SORT-WRITE-8. ST1334.2 +061200 SORT-FAIL-8. ST1334.2 +061300 PERFORM FAIL-1. ST1334.2 +061400 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +061500 MOVE +98 TO CORRECT-N ST1334.2 +061600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +061700 PERFORM PRINT-DETAIL-1. ST1334.2 +061800 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +061900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +062000 SORT-WRITE-8. ST1334.2 +062100 PERFORM PRINT-DETAIL-1. ST1334.2 +062200 SORT-TEST-9. ST1334.2 +062300 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1334.2 +062400 PERFORM READ-SORTOUT 98 TIMES. ST1334.2 +062500 IF SORTOUT-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-9. ST1334.2 +062600 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +062700 PERFORM PASS-1 GO TO SORT-WRITE-9. ST1334.2 +062800 SORT-FAIL-9. ST1334.2 +062900 PERFORM FAIL-1. ST1334.2 +063000 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +063100 MOVE ZERO TO CORRECT-N ST1334.2 +063200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +063300 PERFORM PRINT-DETAIL-1. ST1334.2 +063400 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +063500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +063600 SORT-WRITE-9. ST1334.2 +063700 PERFORM PRINT-DETAIL-1. ST1334.2 +063800 SORT-TEST-10. ST1334.2 +063900 MOVE "SORT-TEST-10 " TO PAR-NAME. ST1334.2 +064000 PERFORM READ-SORTOUT. ST1334.2 +064100 IF SORTOUT-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-11. ST1334.2 +064200 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +064300 PERFORM PASS-1 GO TO SORT-WRITE-10. ST1334.2 +064400 SORT-FAIL-10. ST1334.2 +064500 PERFORM FAIL-1. ST1334.2 +064600 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +064700 MOVE -100 TO CORRECT-N ST1334.2 +064800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +064900 PERFORM PRINT-DETAIL-1. ST1334.2 +065000 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +065100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +065200 SORT-WRITE-10. ST1334.2 +065300 PERFORM PRINT-DETAIL-1. ST1334.2 +065400 SORT-TEST-11. ST1334.2 +065500 MOVE "SORT-TEST-11 " TO PAR-NAME. ST1334.2 +065600 PERFORM READ-SORTOUT 99 TIMES. ST1334.2 +065700 IF SORTOUT-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-12. ST1334.2 +065800 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +065900 PERFORM PASS-1 GO TO SORT-WRITE-11. ST1334.2 +066000 SORT-FAIL-11. ST1334.2 +066100 PERFORM FAIL-1. ST1334.2 +066200 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +066300 MOVE -199 TO CORRECT-N ST1334.2 +066400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +066500 PERFORM PRINT-DETAIL-1. ST1334.2 +066600 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +066700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +066800 SORT-WRITE-11. ST1334.2 +066900 PERFORM PRINT-DETAIL-1. ST1334.2 +067000 SORT-TEST-12. ST1334.2 +067100 MOVE "SORT-TEST-12 " TO PAR-NAME. ST1334.2 +067200 READ SORTOUT-2C AT END ST1334.2 +067300 PERFORM PASS-1 GO TO SORT-WRITE-12. ST1334.2 +067400 SORT-FAIL-12. ST1334.2 +067500 PERFORM FAIL-1. ST1334.2 +067600 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +067700 MOVE 201 TO CORRECT-N. ST1334.2 +067800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +067900 PERFORM PRINT-DETAIL-1. ST1334.2 +068000 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +068100 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +068200 PERFORM PRINT-DETAIL-1. ST1334.2 +068300 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +068400 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +068500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +068600 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +068700 SORT-WRITE-12. ST1334.2 +068800 PERFORM PRINT-DETAIL-1. ST1334.2 +068900 SORT-EXIT-B. ST1334.2 +069000 EXIT. ST1334.2 +069100 SORT-INIT-C. ST1334.2 +069200 OPEN INPUT SORTIN-2C. ST1334.2 +069300 MOVE ZERO TO UTIL-CTR. ST1334.2 +069400 SORT-TEST-13. ST1334.2 +069500 MOVE "SORT-TEST-13 " TO PAR-NAME. ST1334.2 +069600 PERFORM READ-SORTIN. ST1334.2 +069700 IF SORTIN-KEY NOT EQUAL TO +99 GO TO SORT-FAIL-13. ST1334.2 +069800 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +069900 PERFORM PASS-1 GO TO SORT-WRITE-13. ST1334.2 +070000 SORT-FAIL-13. ST1334.2 +070100 PERFORM FAIL-1. ST1334.2 +070200 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +070300 MOVE +99 TO CORRECT-N ST1334.2 +070400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +070500 PERFORM PRINT-DETAIL-1. ST1334.2 +070600 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +070700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +070800 SORT-WRITE-13. ST1334.2 +070900 PERFORM PRINT-DETAIL-1. ST1334.2 +071000 SORT-TEST-14. ST1334.2 +071100 MOVE "SORT-TEST-14 " TO PAR-NAME. ST1334.2 +071200 PERFORM READ-SORTIN. ST1334.2 +071300 IF SORTIN-KEY NOT EQUAL TO +98 GO TO SORT-FAIL-14. ST1334.2 +071400 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +071500 PERFORM PASS-1 GO TO SORT-WRITE-14. ST1334.2 +071600 SORT-FAIL-14. ST1334.2 +071700 PERFORM FAIL-1. ST1334.2 +071800 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +071900 MOVE +98 TO CORRECT-N ST1334.2 +072000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +072100 PERFORM PRINT-DETAIL-1. ST1334.2 +072200 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +072300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +072400 SORT-WRITE-14. ST1334.2 +072500 PERFORM PRINT-DETAIL-1. ST1334.2 +072600 SORT-TEST-15. ST1334.2 +072700 MOVE "SORT-TEST-15 " TO PAR-NAME. ST1334.2 +072800 PERFORM READ-SORTIN 98 TIMES. ST1334.2 +072900 IF SORTIN-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-15. ST1334.2 +073000 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +073100 PERFORM PASS-1 GO TO SORT-WRITE-15. ST1334.2 +073200 SORT-FAIL-15. ST1334.2 +073300 PERFORM FAIL-1. ST1334.2 +073400 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +073500 MOVE ZERO TO CORRECT-N ST1334.2 +073600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +073700 PERFORM PRINT-DETAIL-1. ST1334.2 +073800 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +073900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +074000 SORT-WRITE-15. ST1334.2 +074100 PERFORM PRINT-DETAIL-1. ST1334.2 +074200 SORT-TEST-16. ST1334.2 +074300 MOVE "SORT-TEST-16 " TO PAR-NAME. ST1334.2 +074400 PERFORM READ-SORTIN. ST1334.2 +074500 IF SORTIN-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-16. ST1334.2 +074600 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +074700 PERFORM PASS-1 GO TO SORT-WRITE-16. ST1334.2 +074800 SORT-FAIL-16. ST1334.2 +074900 PERFORM FAIL-1. ST1334.2 +075000 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +075100 MOVE -100 TO CORRECT-N ST1334.2 +075200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +075300 PERFORM PRINT-DETAIL-1. ST1334.2 +075400 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +075500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +075600 SORT-WRITE-16. ST1334.2 +075700 PERFORM PRINT-DETAIL-1. ST1334.2 +075800 SORT-TEST-17. ST1334.2 +075900 MOVE "SORT-TEST-17 " TO PAR-NAME. ST1334.2 +076000 PERFORM READ-SORTIN 99 TIMES. ST1334.2 +076100 IF SORTIN-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-17. ST1334.2 +076200 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +076300 PERFORM PASS-1 GO TO SORT-WRITE-17. ST1334.2 +076400 SORT-FAIL-17. ST1334.2 +076500 PERFORM FAIL-1. ST1334.2 +076600 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +076700 MOVE -199 TO CORRECT-N ST1334.2 +076800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +076900 PERFORM PRINT-DETAIL-1. ST1334.2 +077000 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +077100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +077200 SORT-WRITE-17. ST1334.2 +077300 PERFORM PRINT-DETAIL-1. ST1334.2 +077400 SORT-TEST-18. ST1334.2 +077500 MOVE "SORT-TEST-18" TO PAR-NAME. ST1334.2 +077600 READ SORTIN-2C AT END ST1334.2 +077700 PERFORM PASS-1 GO TO SORT-WRITE-18. ST1334.2 +077800 SORT-FAIL-18. ST1334.2 +077900 PERFORM FAIL-1. ST1334.2 +078000 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +078100 MOVE 201 TO CORRECT-N. ST1334.2 +078200 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +078300 PERFORM PRINT-DETAIL-1. ST1334.2 +078400 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +078500 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +078600 PERFORM PRINT-DETAIL-1. ST1334.2 +078700 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +078800 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +078900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +079000 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +079100 SORT-WRITE-18. ST1334.2 +079200 PERFORM PRINT-DETAIL-1. ST1334.2 +079300 SORT-CLOSE-19. ST1334.2 +079400 CLOSE SORTIN-2C. ST1334.2 +079500 CLOSE SORTOUT-2C. ST1334.2 +079600 GO TO OUTPROC-EXIT. ST1334.2 +079700 NON-KEY-BREAKDOWN. ST1334.2 +079800 MOVE FIRST-20 TO COMPUTED-A. ST1334.2 +079900 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +080000 MOVE SP-ACE TO CORRECT-A. ST1334.2 +080100 MOVE "FIRST 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +080200 PERFORM PRINT-DETAIL-1. ST1334.2 +080300 MOVE SECOND-20 TO COMPUTED-A. ST1334.2 +080400 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +080500 MOVE SP-ACE TO CORRECT-A. ST1334.2 +080600 MOVE "SECOND 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +080700 PERFORM PRINT-DETAIL-1. ST1334.2 +080800 MOVE THIRD-20 TO COMPUTED-A. ST1334.2 +080900 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +081000 MOVE SP-ACE TO CORRECT-A. ST1334.2 +081100 MOVE "THIRD 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +081200 PERFORM PRINT-DETAIL-1. ST1334.2 +081300 MOVE FOURTH-20 TO COMPUTED-A. ST1334.2 +081400 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +081500 MOVE " A" TO CORRECT-A. ST1334.2 +081600 MOVE "LAST 12 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +081700 RETURN-SORTFILE. ST1334.2 +081800 ADD 1 TO UTIL-CTR. ST1334.2 +081900 RETURN SECOND-SORTFILE AT END GO TO RETURN-ERROR. ST1334.2 +082000 RETURN-ERROR. ST1334.2 +082100 MOVE "RETURN-ERROR" TO PAR-NAME. ST1334.2 +082200 PERFORM FAIL-1. ST1334.2 +082300 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +082400 MOVE 201 TO CORRECT-N. ST1334.2 +082500 MOVE "END OF SORT FILE PREMATURE" TO RE-MARK. ST1334.2 +082600 PERFORM PRINT-DETAIL-1. ST1334.2 +082700 GO TO SORT-EXIT-A. ST1334.2 +082800 READ-SORTOUT. ST1334.2 +082900 ADD 1 TO UTIL-CTR. ST1334.2 +083000 READ SORTOUT-2C AT END GO TO READ-SORTOUT-ERROR. ST1334.2 +083100 READ-SORTOUT-ERROR. ST1334.2 +083200 MOVE "READ-SORTOUT-ERROR" TO PAR-NAME. ST1334.2 +083300 PERFORM FAIL-1. ST1334.2 +083400 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +083500 MOVE 201 TO CORRECT-N. ST1334.2 +083600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1334.2 +083700 PERFORM PRINT-DETAIL-1. ST1334.2 +083800 GO TO SORT-EXIT-B. ST1334.2 +083900 READ-SORTIN. ST1334.2 +084000 ADD 1 TO UTIL-CTR. ST1334.2 +084100 READ SORTIN-2C AT END GO TO READ-SORTIN-ERROR. ST1334.2 +084200 READ-SORTIN-ERROR. ST1334.2 +084300 MOVE "READ-SORTIN-ERROR" TO PAR-NAME. ST1334.2 +084400 PERFORM FAIL-1. ST1334.2 +084500 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +084600 MOVE 201 TO CORRECT-N. ST1334.2 +084700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1334.2 +084800 PERFORM PRINT-DETAIL-1. ST1334.2 +084900 GO TO SORT-CLOSE-19. ST1334.2 +085000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1334.2 +085100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1334.2 +085200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1334.2 +085300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1334.2 +085400 MOVE "****TEST DELETED****" TO RE-MARK. ST1334.2 +085500 PRINT-DETAIL-1. ST1334.2 +085600 IF REC-CT NOT EQUAL TO ZERO ST1334.2 +085700 MOVE "." TO PARDOT-X ST1334.2 +085800 MOVE REC-CT TO DOTVALUE. ST1334.2 +085900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1334.2 +086000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1334.2 +086100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1334.2 +086200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1334.2 +086300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1334.2 +086400 MOVE SPACE TO CORRECT-X. ST1334.2 +086500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1334.2 +086600 MOVE SPACE TO RE-MARK. ST1334.2 +086700 WRITE-LINE-1. ST1334.2 +086800 ADD 1 TO RECORD-COUNT. ST1334.2 +086900Y IF RECORD-COUNT GREATER 50 ST1334.2 +087000Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1334.2 +087100Y MOVE SPACE TO DUMMY-RECORD ST1334.2 +087200Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1334.2 +087300Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1334.2 +087400Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1334.2 +087500Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1334.2 +087600Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1334.2 +087700Y MOVE ZERO TO RECORD-COUNT. ST1334.2 +087800 PERFORM WRT-LN-1. ST1334.2 +087900 WRT-LN-1. ST1334.2 +088000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1334.2 +088100 MOVE SPACE TO DUMMY-RECORD. ST1334.2 +088200 BLANK-LINE-PRINT-1. ST1334.2 +088300 PERFORM WRT-LN-1. ST1334.2 +088400 FAIL-ROUTINE-1. ST1334.2 +088500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1334.2 +088600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1334.2 +088700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1334.2 +088800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +088900 GO TO FAIL-ROUTINE-EX-1. ST1334.2 +089000 FAIL-RTN-WRITE-1. ST1334.2 +089100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1334.2 +089200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +089300 FAIL-ROUTINE-EX-1. EXIT. ST1334.2 +089400 BAIL-OUT-1. ST1334.2 +089500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1334.2 +089600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1334.2 +089700 BAIL-OUT-WRITE-1. ST1334.2 +089800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1334.2 +089900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +090000 BAIL-OUT-EX-1. EXIT. ST1334.2 +090100 OUTPROC-EXIT. ST1334.2 +090200 EXIT. ST1334.2 +090300 CCVS-EXIT SECTION. ST1334.2 +090400 CCVS-999999. ST1334.2 +090500 GO TO CLOSE-FILES. ST1334.2 +*END-OF,ST133A +*HEADER,COBOL,ST134A +000100 IDENTIFICATION DIVISION. ST1344.2 +000200 PROGRAM-ID. ST1344.2 +000300 ST134A. ST1344.2 +000400**************************************************************** ST1344.2 +000500* * ST1344.2 +000600* VALIDATION FOR:- * ST1344.2 +000700* * ST1344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +000900* * ST1344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1344.2 +001100* * ST1344.2 +001200**************************************************************** ST1344.2 +001300* * ST1344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1344.2 +001500* * ST1344.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1344.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1344.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1344.2 +001900* * ST1344.2 +002000**************************************************************** ST1344.2 +002100* ST134A DOES THE FOLLOWING --- ST1344.2 +002200* 1. CREATES A FILE CONSISTING OF RECORDS WITH A KEY ITEMST1344.2 +002300* AND TWO NON-KEY ITEMS. THIS CREATION OCCURS IN AN ST1344.2 +002400* INDEPENDENT SECTION OF THE PROGRAM. ST1344.2 +002500* 2. SORTS THE FILE, EMPLOYING INPUT AND OUTPUT ST1344.2 +002600* PROCEDURES. THESE PROCEDURES ARE EQUIVALENT TO THE ST1344.2 +002700* PROCEDURES GENERATED BY USING AND GIVING CLAUSES. ST1344.2 +002800* THE SORTED FILE IS IN THE SAME SEQUENCE AS THE ST1344.2 +002900* ORIGINAL FILE. ST1344.2 +003000* 3. SPOT-CHECKS THE RESULTS OF THE SORT IN ANOTHER ST1344.2 +003100* INDEPENDENT SECTION OF THE PROGRAM. ST1344.2 +003200* THE FILES SORTIN-2C AND SORTOUT-2C HAVE THE SAME RECORD AREA.ST1344.2 +003300* TEN RECORDS ARE SORTED. THE KEY ITEMS ARE SHOWN BELOW. ST1344.2 +003400* ST1344.2 +003500* -100 -80 -60 -40 -20 ZERO +20 +40 +60 +80 ST1344.2 +003600 ST1344.2 +003700 ENVIRONMENT DIVISION. ST1344.2 +003800 CONFIGURATION SECTION. ST1344.2 +003900 SOURCE-COMPUTER. ST1344.2 +004000 XXXXX082. ST1344.2 +004100 OBJECT-COMPUTER. ST1344.2 +004200 XXXXX083. ST1344.2 +004300 INPUT-OUTPUT SECTION. ST1344.2 +004400 FILE-CONTROL. ST1344.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1344.2 +004600 XXXXX055. ST1344.2 +004700 SELECT SORTFILE-2D ASSIGN TO ST1344.2 +004800 XXXXX027. ST1344.2 +004900 SELECT SORTIN-2D ASSIGN TO ST1344.2 +005000 XXXXX001. ST1344.2 +005100 SELECT SORTOUT-2D ASSIGN TO ST1344.2 +005200 XXXXX002. ST1344.2 +005300 I-O-CONTROL. ST1344.2 +005400 SAME RECORD AREA FOR ST1344.2 +005500 SORTIN-2D ST1344.2 +005600 SORTOUT-2D. ST1344.2 +005700 DATA DIVISION. ST1344.2 +005800 FILE SECTION. ST1344.2 +005900 FD PRINT-FILE. ST1344.2 +006000 01 PRINT-REC PICTURE X(120). ST1344.2 +006100 01 DUMMY-RECORD PICTURE X(120). ST1344.2 +006200 SD SORTFILE-2D ST1344.2 +006300 DATA RECORD IS SORTFILE-REC. ST1344.2 +006400 01 SORTFILE-REC. ST1344.2 +006500 02 SORTFILE-NON-KEY-1 PICTURE X(60). ST1344.2 +006600 02 SORTFILE-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +006700 02 SORTFILE-NON-KEY-2 PICTURE X(12). ST1344.2 +006800 FD SORTIN-2D ST1344.2 +006900 LABEL RECORDS STANDARD ST1344.2 +007000C VALUE OF ST1344.2 +007100C XXXXX074 ST1344.2 +007200C IS ST1344.2 +007300C XXXXX075 ST1344.2 +007400G XXXXX069 ST1344.2 +007500 DATA RECORD IS SORTIN-REC. ST1344.2 +007600 01 SORTIN-REC. ST1344.2 +007700 02 SORTIN-NON-KEY-1 PICTURE X(60). ST1344.2 +007800 02 SORTIN-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +007900 02 SORTIN-NON-KEY-2 PICTURE X(12). ST1344.2 +008000 FD SORTOUT-2D ST1344.2 +008100 LABEL RECORDS STANDARD ST1344.2 +008200C VALUE OF ST1344.2 +008300C XXXXX074 ST1344.2 +008400C IS ST1344.2 +008500C XXXXX076 ST1344.2 +008600G XXXXX069 ST1344.2 +008700 DATA RECORD IS SORTOUT-REC. ST1344.2 +008800 01 SORTOUT-REC. ST1344.2 +008900 02 SORTOUT-NON-KEY-1 PICTURE X(60). ST1344.2 +009000 02 SORTOUT-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +009100 02 SORTOUT-NON-KEY-2 PICTURE X(12). ST1344.2 +009200 WORKING-STORAGE SECTION. ST1344.2 +009300 77 UTIL-CTR PICTURE S99999. ST1344.2 +009400 01 LITERALS. ST1344.2 +009500 02 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1344.2 +009600 02 LITERAL-A PICTURE X(60) VALUE "A ST1344.2 +009700- " ". ST1344.2 +009800 02 LITERAL-B PICTURE X(12) VALUE "B ". ST1344.2 +009900 01 COMPUTED-BREAKDOWN. ST1344.2 +010000 02 FIRST-20 PICTURE X(20). ST1344.2 +010100 02 SECOND-20 PICTURE X(20). ST1344.2 +010200 02 THIRD-20 PICTURE X(20). ST1344.2 +010300 01 FILE-RECORD-INFORMATION-REC. ST1344.2 +010400 03 FILE-RECORD-INFO-SKELETON. ST1344.2 +010500 05 FILLER PICTURE X(48) VALUE ST1344.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1344.2 +010700 05 FILLER PICTURE X(46) VALUE ST1344.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1344.2 +010900 05 FILLER PICTURE X(26) VALUE ST1344.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". ST1344.2 +011100 05 FILLER PICTURE X(37) VALUE ST1344.2 +011200 ",RECKEY= ". ST1344.2 +011300 05 FILLER PICTURE X(38) VALUE ST1344.2 +011400 ",ALTKEY1= ". ST1344.2 +011500 05 FILLER PICTURE X(38) VALUE ST1344.2 +011600 ",ALTKEY2= ". ST1344.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.ST1344.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1344.2 +011900 05 FILE-RECORD-INFO-P1-120. ST1344.2 +012000 07 FILLER PIC X(5). ST1344.2 +012100 07 XFILE-NAME PIC X(6). ST1344.2 +012200 07 FILLER PIC X(8). ST1344.2 +012300 07 XRECORD-NAME PIC X(6). ST1344.2 +012400 07 FILLER PIC X(1). ST1344.2 +012500 07 REELUNIT-NUMBER PIC 9(1). ST1344.2 +012600 07 FILLER PIC X(7). ST1344.2 +012700 07 XRECORD-NUMBER PIC 9(6). ST1344.2 +012800 07 FILLER PIC X(6). ST1344.2 +012900 07 UPDATE-NUMBER PIC 9(2). ST1344.2 +013000 07 FILLER PIC X(5). ST1344.2 +013100 07 ODO-NUMBER PIC 9(4). ST1344.2 +013200 07 FILLER PIC X(5). ST1344.2 +013300 07 XPROGRAM-NAME PIC X(5). ST1344.2 +013400 07 FILLER PIC X(7). ST1344.2 +013500 07 XRECORD-LENGTH PIC 9(6). ST1344.2 +013600 07 FILLER PIC X(7). ST1344.2 +013700 07 CHARS-OR-RECORDS PIC X(2). ST1344.2 +013800 07 FILLER PIC X(1). ST1344.2 +013900 07 XBLOCK-SIZE PIC 9(4). ST1344.2 +014000 07 FILLER PIC X(6). ST1344.2 +014100 07 RECORDS-IN-FILE PIC 9(6). ST1344.2 +014200 07 FILLER PIC X(5). ST1344.2 +014300 07 XFILE-ORGANIZATION PIC X(2). ST1344.2 +014400 07 FILLER PIC X(6). ST1344.2 +014500 07 XLABEL-TYPE PIC X(1). ST1344.2 +014600 05 FILE-RECORD-INFO-P121-240. ST1344.2 +014700 07 FILLER PIC X(8). ST1344.2 +014800 07 XRECORD-KEY PIC X(29). ST1344.2 +014900 07 FILLER PIC X(9). ST1344.2 +015000 07 ALTERNATE-KEY1 PIC X(29). ST1344.2 +015100 07 FILLER PIC X(9). ST1344.2 +015200 07 ALTERNATE-KEY2 PIC X(29). ST1344.2 +015300 07 FILLER PIC X(7). ST1344.2 +015400 01 TEST-RESULTS. ST1344.2 +015500 02 FILLER PIC X VALUE SPACE. ST1344.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. ST1344.2 +015700 02 FILLER PIC X VALUE SPACE. ST1344.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. ST1344.2 +015900 02 FILLER PIC X VALUE SPACE. ST1344.2 +016000 02 PAR-NAME. ST1344.2 +016100 03 FILLER PIC X(19) VALUE SPACE. ST1344.2 +016200 03 PARDOT-X PIC X VALUE SPACE. ST1344.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. ST1344.2 +016400 02 FILLER PIC X(8) VALUE SPACE. ST1344.2 +016500 02 RE-MARK PIC X(61). ST1344.2 +016600 01 TEST-COMPUTED. ST1344.2 +016700 02 FILLER PIC X(30) VALUE SPACE. ST1344.2 +016800 02 FILLER PIC X(17) VALUE ST1344.2 +016900 " COMPUTED=". ST1344.2 +017000 02 COMPUTED-X. ST1344.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1344.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A ST1344.2 +017300 PIC -9(9).9(9). ST1344.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1344.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1344.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1344.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. ST1344.2 +017800 04 COMPUTED-18V0 PIC -9(18). ST1344.2 +017900 04 FILLER PIC X. ST1344.2 +018000 03 FILLER PIC X(50) VALUE SPACE. ST1344.2 +018100 01 TEST-CORRECT. ST1344.2 +018200 02 FILLER PIC X(30) VALUE SPACE. ST1344.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1344.2 +018400 02 CORRECT-X. ST1344.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1344.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1344.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1344.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1344.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1344.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. ST1344.2 +019100 04 CORRECT-18V0 PIC -9(18). ST1344.2 +019200 04 FILLER PIC X. ST1344.2 +019300 03 FILLER PIC X(2) VALUE SPACE. ST1344.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1344.2 +019500 01 CCVS-C-1. ST1344.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1344.2 +019700- "SS PARAGRAPH-NAME ST1344.2 +019800- " REMARKS". ST1344.2 +019900 02 FILLER PIC X(20) VALUE SPACE. ST1344.2 +020000 01 CCVS-C-2. ST1344.2 +020100 02 FILLER PIC X VALUE SPACE. ST1344.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". ST1344.2 +020300 02 FILLER PIC X(15) VALUE SPACE. ST1344.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". ST1344.2 +020500 02 FILLER PIC X(94) VALUE SPACE. ST1344.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1344.2 +020700 01 REC-CT PIC 99 VALUE ZERO. ST1344.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1344.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1344.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1344.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1344.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1344.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1344.2 +021700 01 CCVS-H-1. ST1344.2 +021800 02 FILLER PIC X(39) VALUE SPACES. ST1344.2 +021900 02 FILLER PIC X(42) VALUE ST1344.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1344.2 +022100 02 FILLER PIC X(39) VALUE SPACES. ST1344.2 +022200 01 CCVS-H-2A. ST1344.2 +022300 02 FILLER PIC X(40) VALUE SPACE. ST1344.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1344.2 +022500 02 FILLER PIC XXXX VALUE ST1344.2 +022600 "4.2 ". ST1344.2 +022700 02 FILLER PIC X(28) VALUE ST1344.2 +022800 " COPY - NOT FOR DISTRIBUTION". ST1344.2 +022900 02 FILLER PIC X(41) VALUE SPACE. ST1344.2 +023000 ST1344.2 +023100 01 CCVS-H-2B. ST1344.2 +023200 02 FILLER PIC X(15) VALUE ST1344.2 +023300 "TEST RESULT OF ". ST1344.2 +023400 02 TEST-ID PIC X(9). ST1344.2 +023500 02 FILLER PIC X(4) VALUE ST1344.2 +023600 " IN ". ST1344.2 +023700 02 FILLER PIC X(12) VALUE ST1344.2 +023800 " HIGH ". ST1344.2 +023900 02 FILLER PIC X(22) VALUE ST1344.2 +024000 " LEVEL VALIDATION FOR ". ST1344.2 +024100 02 FILLER PIC X(58) VALUE ST1344.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +024300 01 CCVS-H-3. ST1344.2 +024400 02 FILLER PIC X(34) VALUE ST1344.2 +024500 " FOR OFFICIAL USE ONLY ". ST1344.2 +024600 02 FILLER PIC X(58) VALUE ST1344.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1344.2 +024800 02 FILLER PIC X(28) VALUE ST1344.2 +024900 " COPYRIGHT 1985 ". ST1344.2 +025000 01 CCVS-E-1. ST1344.2 +025100 02 FILLER PIC X(52) VALUE SPACE. ST1344.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1344.2 +025300 02 ID-AGAIN PIC X(9). ST1344.2 +025400 02 FILLER PIC X(45) VALUE SPACES. ST1344.2 +025500 01 CCVS-E-2. ST1344.2 +025600 02 FILLER PIC X(31) VALUE SPACE. ST1344.2 +025700 02 FILLER PIC X(21) VALUE SPACE. ST1344.2 +025800 02 CCVS-E-2-2. ST1344.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1344.2 +026000 03 FILLER PIC X VALUE SPACE. ST1344.2 +026100 03 ENDER-DESC PIC X(44) VALUE ST1344.2 +026200 "ERRORS ENCOUNTERED". ST1344.2 +026300 01 CCVS-E-3. ST1344.2 +026400 02 FILLER PIC X(22) VALUE ST1344.2 +026500 " FOR OFFICIAL USE ONLY". ST1344.2 +026600 02 FILLER PIC X(12) VALUE SPACE. ST1344.2 +026700 02 FILLER PIC X(58) VALUE ST1344.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +026900 02 FILLER PIC X(13) VALUE SPACE. ST1344.2 +027000 02 FILLER PIC X(15) VALUE ST1344.2 +027100 " COPYRIGHT 1985". ST1344.2 +027200 01 CCVS-E-4. ST1344.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1344.2 +027400 02 FILLER PIC X(4) VALUE " OF ". ST1344.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1344.2 +027600 02 FILLER PIC X(40) VALUE ST1344.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1344.2 +027800 01 XXINFO. ST1344.2 +027900 02 FILLER PIC X(19) VALUE ST1344.2 +028000 "*** INFORMATION ***". ST1344.2 +028100 02 INFO-TEXT. ST1344.2 +028200 04 FILLER PIC X(8) VALUE SPACE. ST1344.2 +028300 04 XXCOMPUTED PIC X(20). ST1344.2 +028400 04 FILLER PIC X(5) VALUE SPACE. ST1344.2 +028500 04 XXCORRECT PIC X(20). ST1344.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). ST1344.2 +028700 01 HYPHEN-LINE. ST1344.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. ST1344.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************ST1344.2 +029000- "*****************************************". ST1344.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************ST1344.2 +029200- "******************************". ST1344.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE ST1344.2 +029400 "ST134A". ST1344.2 +029500 PROCEDURE DIVISION. ST1344.2 +029600 CCVS1 SECTION. ST1344.2 +029700 OPEN-FILES. ST1344.2 +029800 OPEN OUTPUT PRINT-FILE. ST1344.2 +029900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1344.2 +030000 MOVE SPACE TO TEST-RESULTS. ST1344.2 +030100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1344.2 +030200 MOVE ZERO TO REC-SKL-SUB. ST1344.2 +030300 PERFORM CCVS-INIT-FILE 9 TIMES. ST1344.2 +030400 CCVS-INIT-FILE. ST1344.2 +030500 ADD 1 TO REC-SKL-SUB. ST1344.2 +030600 MOVE FILE-RECORD-INFO-SKELETON ST1344.2 +030700 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1344.2 +030800 CCVS-INIT-EXIT. ST1344.2 +030900 GO TO CCVS1-EXIT. ST1344.2 +031000 CLOSE-FILES. ST1344.2 +031100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1344.2 +031200 TERMINATE-CCVS. ST1344.2 +031300S EXIT PROGRAM. ST1344.2 +031400STERMINATE-CALL. ST1344.2 +031500 STOP RUN. ST1344.2 +031600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1344.2 +031700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1344.2 +031800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1344.2 +031900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1344.2 +032000 MOVE "****TEST DELETED****" TO RE-MARK. ST1344.2 +032100 PRINT-DETAIL. ST1344.2 +032200 IF REC-CT NOT EQUAL TO ZERO ST1344.2 +032300 MOVE "." TO PARDOT-X ST1344.2 +032400 MOVE REC-CT TO DOTVALUE. ST1344.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1344.2 +032600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1344.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1344.2 +032800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1344.2 +032900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1344.2 +033000 MOVE SPACE TO CORRECT-X. ST1344.2 +033100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1344.2 +033200 MOVE SPACE TO RE-MARK. ST1344.2 +033300 HEAD-ROUTINE. ST1344.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +033500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +033600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1344.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1344.2 +033800 COLUMN-NAMES-ROUTINE. ST1344.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +034200 END-ROUTINE. ST1344.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1344.2 +034400 END-RTN-EXIT. ST1344.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +034600 END-ROUTINE-1. ST1344.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1344.2 +034800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1344.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. ST1344.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1344.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1344.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1344.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1344.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1344.2 +035500 END-ROUTINE-12. ST1344.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1344.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1344.2 +035800 MOVE "NO " TO ERROR-TOTAL ST1344.2 +035900 ELSE ST1344.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1344.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1344.2 +036200 PERFORM WRITE-LINE. ST1344.2 +036300 END-ROUTINE-13. ST1344.2 +036400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1344.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE ST1344.2 +036600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1344.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1344.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO ST1344.2 +037000 MOVE "NO " TO ERROR-TOTAL ST1344.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1344.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1344.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +037500 WRITE-LINE. ST1344.2 +037600 ADD 1 TO RECORD-COUNT. ST1344.2 +037700Y IF RECORD-COUNT GREATER 42 ST1344.2 +037800Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2 +037900Y MOVE SPACE TO DUMMY-RECORD ST1344.2 +038000Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2 +038100Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2 +038200Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2 +038300Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2 +038400Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2 +038500Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038600Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038700Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038800Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2 +038900Y MOVE ZERO TO RECORD-COUNT. ST1344.2 +039000 PERFORM WRT-LN. ST1344.2 +039100 WRT-LN. ST1344.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1344.2 +039300 MOVE SPACE TO DUMMY-RECORD. ST1344.2 +039400 BLANK-LINE-PRINT. ST1344.2 +039500 PERFORM WRT-LN. ST1344.2 +039600 FAIL-ROUTINE. ST1344.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE ST1344.2 +039800 GO TO FAIL-ROUTINE-WRITE. ST1344.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1344.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1344.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1344.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1344.2 +040400 GO TO FAIL-ROUTINE-EX. ST1344.2 +040500 FAIL-ROUTINE-WRITE. ST1344.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1344.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1344.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1344.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1344.2 +041000 FAIL-ROUTINE-EX. EXIT. ST1344.2 +041100 BAIL-OUT. ST1344.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1344.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1344.2 +041400 BAIL-OUT-WRITE. ST1344.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1344.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1344.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1344.2 +041900 BAIL-OUT-EX. EXIT. ST1344.2 +042000 CCVS1-EXIT. ST1344.2 +042100 EXIT. ST1344.2 +042200 MAIN-LINE SECTION. ST1344.2 +042300 MAIN-LINE-INIT. ST1344.2 +042400 PERFORM CREATE-INPUT-FILE. ST1344.2 +042500 SORT-PARAGRAPH. ST1344.2 +042600 SORT SORTFILE-2D ON ASCENDING ST1344.2 +042700 SORTFILE-KEY ST1344.2 +042800 INPUT PROCEDURE IS INPROC ST1344.2 +042900 OUTPUT PROCEDURE IS OUTPROC. ST1344.2 +043000 AFTER-SORT-PARA. ST1344.2 +043100 PERFORM SORT-TESTS. ST1344.2 +043200 GO TO CLOSE-AND-STOP. ST1344.2 +043300 CREATE-INPUT-FILE SECTION. ST1344.2 +043400 CREATE-INIT. ST1344.2 +043500 OPEN OUTPUT SORTIN-2D. ST1344.2 +043600 MOVE -100 TO UTIL-CTR. ST1344.2 +043700 CREATE-LOOP. ST1344.2 +043800 MOVE UTIL-CTR TO SORTIN-KEY. ST1344.2 +043900 MOVE "A" TO SORTIN-NON-KEY-1. ST1344.2 +044000 MOVE "B" TO SORTIN-NON-KEY-2. ST1344.2 +044100 WRITE SORTIN-REC. ST1344.2 +044200 ADD 20 TO UTIL-CTR. ST1344.2 +044300 IF UTIL-CTR LESS THAN +100 GO TO CREATE-LOOP. ST1344.2 +044400 CLOSE SORTIN-2D. ST1344.2 +044500 INPROC SECTION. ST1344.2 +044600 INPROC-INIT. ST1344.2 +044700 OPEN INPUT SORTIN-2D. ST1344.2 +044800 INPROC-LOOP. ST1344.2 +044900 READ SORTIN-2D AT END GO TO INPROC-EXIT. ST1344.2 +045000 MOVE SORTIN-REC TO SORTFILE-REC. ST1344.2 +045100 RELEASE SORTFILE-REC. ST1344.2 +045200 GO TO INPROC-LOOP. ST1344.2 +045300 INPROC-EXIT. ST1344.2 +045400 CLOSE SORTIN-2D. ST1344.2 +045500 OUTPROC SECTION. ST1344.2 +045600 OUTPROC-INIT. ST1344.2 +045700 OPEN OUTPUT SORTOUT-2D. ST1344.2 +045800 OUTPROC-LOOP. ST1344.2 +045900 RETURN SORTFILE-2D AT END GO TO OUTPROC-EXIT. ST1344.2 +046000 MOVE SORTFILE-REC TO SORTOUT-REC. ST1344.2 +046100 WRITE SORTOUT-REC. ST1344.2 +046200 GO TO OUTPROC-LOOP. ST1344.2 +046300 OUTPROC-EXIT. ST1344.2 +046400 CLOSE SORTOUT-2D. ST1344.2 +046500 SORT-TESTS SECTION. ST1344.2 +046600 SORT-INIT-A. ST1344.2 +046700 MOVE ZERO TO UTIL-CTR ST1344.2 +046800 OPEN INPUT SORTOUT-2D. ST1344.2 +046900 MOVE "SORT, SAME REC AREA" TO FEATURE. ST1344.2 +047000 PERFORM PRINT-DETAIL-1. ST1344.2 +047100 SORT-TEST-1. ST1344.2 +047200 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +047300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1344.2 +047400 PERFORM READ-SORTOUT. ST1344.2 +047500 IF SORTOUT-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-1. ST1344.2 +047600 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +047700 GO TO SORT-FAIL-1. ST1344.2 +047800 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +047900 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1344.2 +048000 SORT-FAIL-1. ST1344.2 +048100 MOVE -100 TO CORRECT-N. ST1344.2 +048200 PERFORM BREAKDOWN-PARA. ST1344.2 +048300 SORT-WRITE-1. ST1344.2 +048400 PERFORM PRINT-DETAIL-1. ST1344.2 +048500 SORT-TEST-2. ST1344.2 +048600 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +048700 MOVE "SORT-TEST-2" TO PAR-NAME. ST1344.2 +048800 PERFORM READ-SORTOUT 5 TIMES. ST1344.2 +048900 IF SORTOUT-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-2. ST1344.2 +049000 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +049100 GO TO SORT-FAIL-2. ST1344.2 +049200 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +049300 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1344.2 +049400 SORT-FAIL-2. ST1344.2 +049500 MOVE ZERO TO CORRECT-N. ST1344.2 +049600 PERFORM BREAKDOWN-PARA. ST1344.2 +049700 SORT-WRITE-2. ST1344.2 +049800 PERFORM PRINT-DETAIL-1. ST1344.2 +049900 SORT-TEST-3. ST1344.2 +050000 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +050100 MOVE "SORT-TEST-3" TO PAR-NAME. ST1344.2 +050200 PERFORM READ-SORTOUT 4 TIMES. ST1344.2 +050300 IF SORTOUT-KEY NOT EQUAL TO +80 GO TO SORT-FAIL-3. ST1344.2 +050400 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +050500 GO TO SORT-FAIL-3. ST1344.2 +050600 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +050700 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1344.2 +050800 SORT-FAIL-3. ST1344.2 +050900 MOVE +80 TO CORRECT-N. ST1344.2 +051000 PERFORM BREAKDOWN-PARA. ST1344.2 +051100 SORT-WRITE-3. ST1344.2 +051200 PERFORM PRINT-DETAIL-1. ST1344.2 +051300 SORT-TEST-4. ST1344.2 +051400 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +051500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1344.2 +051600 READ SORTOUT-2D AT END ST1344.2 +051700 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1344.2 +051800 SORT-FAIL-4. ST1344.2 +051900 MOVE SPACE TO LITERALS. ST1344.2 +052000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1344.2 +052100 PERFORM PRINT-DETAIL-1. ST1344.2 +052200 PERFORM BREAKDOWN-PARA. ST1344.2 +052300 SORT-WRITE-4. ST1344.2 +052400 PERFORM PRINT-DETAIL-1. ST1344.2 +052500 SORT-EXIT. ST1344.2 +052600 EXIT. ST1344.2 +052700 CLOSE-AND-STOP SECTION. ST1344.2 +052800 CLOSE-AND-STOP-PARA. ST1344.2 +052900 CLOSE SORTOUT-2D. ST1344.2 +053000 GO TO CCVS-EXIT. ST1344.2 +053100 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1344.2 +053200 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1344.2 +053300 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1344.2 +053400 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1344.2 +053500 MOVE "****TEST DELETED****" TO RE-MARK. ST1344.2 +053600 PRINT-DETAIL-1. ST1344.2 +053700 IF REC-CT NOT EQUAL TO ZERO ST1344.2 +053800 MOVE "." TO PARDOT-X ST1344.2 +053900 MOVE REC-CT TO DOTVALUE. ST1344.2 +054000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1344.2 +054100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1344.2 +054200 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1344.2 +054300 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1344.2 +054400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1344.2 +054500 MOVE SPACE TO CORRECT-X. ST1344.2 +054600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1344.2 +054700 MOVE SPACE TO RE-MARK. ST1344.2 +054800 WRITE-LINE-1. ST1344.2 +054900 ADD 1 TO RECORD-COUNT. ST1344.2 +055000Y IF RECORD-COUNT GREATER 50 ST1344.2 +055100Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2 +055200Y MOVE SPACE TO DUMMY-RECORD ST1344.2 +055300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2 +055400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2 +055500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1344.2 +055600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2 +055700Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2 +055800Y MOVE ZERO TO RECORD-COUNT. ST1344.2 +055900 PERFORM WRT-LN-1. ST1344.2 +056000 WRT-LN-1. ST1344.2 +056100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1344.2 +056200 MOVE SPACE TO DUMMY-RECORD. ST1344.2 +056300 BLANK-LINE-PRINT-1. ST1344.2 +056400 PERFORM WRT-LN-1. ST1344.2 +056500 FAIL-ROUTINE-1. ST1344.2 +056600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1344.2 +056700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1344.2 +056800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1344.2 +056900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +057000 GO TO FAIL-ROUTINE-EX-1. ST1344.2 +057100 FAIL-RTN-WRITE-1. ST1344.2 +057200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1344.2 +057300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +057400 FAIL-ROUTINE-EX-1. EXIT. ST1344.2 +057500 BAIL-OUT-1. ST1344.2 +057600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1344.2 +057700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1344.2 +057800 BAIL-OUT-WRITE-1. ST1344.2 +057900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1344.2 +058000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +058100 BAIL-OUT-EX-1. EXIT. ST1344.2 +058200 BREAKDOWN-PARA. ST1344.2 +058300 MOVE SORTOUT-KEY TO COMPUTED-N. ST1344.2 +058400 PERFORM FAIL-1. ST1344.2 +058500 MOVE "KEY AREA" TO RE-MARK. ST1344.2 +058600 PERFORM PRINT-DETAIL-1. ST1344.2 +058700 MOVE SPACE TO FEATURE. ST1344.2 +058800 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-BREAKDOWN. ST1344.2 +058900 MOVE FIRST-20 TO COMPUTED-A. ST1344.2 +059000 MOVE LITERAL-A TO CORRECT-A. ST1344.2 +059100 MOVE "A 60-CHARACTER NON-KEY AREA" TO RE-MARK. ST1344.2 +059200 PERFORM PRINT-DETAIL-1. ST1344.2 +059300 MOVE SECOND-20 TO COMPUTED-A. ST1344.2 +059400 MOVE SP-ACE TO CORRECT-A. ST1344.2 +059500 MOVE "IS HERE SHOWN AS THREE" TO RE-MARK. ST1344.2 +059600 PERFORM PRINT-DETAIL-1. ST1344.2 +059700 MOVE THIRD-20 TO COMPUTED-A. ST1344.2 +059800 MOVE SP-ACE TO CORRECT-A. ST1344.2 +059900 MOVE "20-CHARACTER FIELDS." TO RE-MARK. ST1344.2 +060000 PERFORM PRINT-DETAIL-1. ST1344.2 +060100 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-A. ST1344.2 +060200 MOVE LITERAL-B TO CORRECT-A. ST1344.2 +060300 MOVE "12-CHARACTER NON-KEY AREA" TO RE-MARK. ST1344.2 +060400 READ-SORTOUT. ST1344.2 +060500 READ SORTOUT-2D AT END GO TO SORTOUT-ERROR. ST1344.2 +060600 ADD 1 TO UTIL-CTR. ST1344.2 +060700 SORTOUT-ERROR. ST1344.2 +060800 MOVE "SORTOUT-ERROR" TO PAR-NAME. ST1344.2 +060900 PERFORM FAIL-1. ST1344.2 +061000 MOVE UTIL-CTR TO COMPUTED-N. ST1344.2 +061100 MOVE 10 TO CORRECT-N. ST1344.2 +061200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1344.2 +061300 PERFORM PRINT-DETAIL-1. ST1344.2 +061400 GO TO CLOSE-AND-STOP-PARA. ST1344.2 +061500 CCVS-EXIT SECTION. ST1344.2 +061600 CCVS-999999. ST1344.2 +061700 GO TO CLOSE-FILES. ST1344.2 +*END-OF,ST134A +*HEADER,COBOL,ST135A +000100 IDENTIFICATION DIVISION. ST1354.2 +000200 PROGRAM-ID. ST1354.2 +000300 ST135A. ST1354.2 +000400**************************************************************** ST1354.2 +000500* * ST1354.2 +000600* VALIDATION FOR:- * ST1354.2 +000700* * ST1354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +000900* * ST1354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1354.2 +001100* * ST1354.2 +001200**************************************************************** ST1354.2 +001300* * ST1354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1354.2 +001500* * ST1354.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1354.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1354.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1354.2 +001900* * ST1354.2 +002000**************************************************************** ST1354.2 +002100* ST1354.2 +002200* ST205 BUILDS A FILE, SORTS IT, AND CHECKS IT IN AN OUTPUT ST1354.2 +002300* PROCEDURE. THE UNUSUAL FEATURE OF THIS PROGRAM IS THAT THE ST1354.2 +002400* FILES SHARE A NETWORK OF SAME AREA, SAME RECORD AREA, AND ST1354.2 +002500* SAME SORT AREA. IN ORDER TO THOROUGHLY EXERCISE THE "SAME" ST1354.2 +002600* OPTIONS, TWO DUMMY FILES, CALLED USELESS-FILE AND DEADWEIGHT-ST1354.2 +002700* FILE, ARE OPENED, CLOSED, READ, AND WRITTEN UPON. HOWEVER, ST1354.2 +002800* THE CONTENTS OF THESE TWO FILES ARE NEVER CHECKED. ST1354.2 +002900* SEE THE I-O-CONTROL PARAGRAPH FOR THE ACTUAL ORGANIZATION. ST1354.2 +003000 ST1354.2 +003100 ENVIRONMENT DIVISION. ST1354.2 +003200 CONFIGURATION SECTION. ST1354.2 +003300 SOURCE-COMPUTER. ST1354.2 +003400 XXXXX082. ST1354.2 +003500 OBJECT-COMPUTER. ST1354.2 +003600 XXXXX083. ST1354.2 +003700 INPUT-OUTPUT SECTION. ST1354.2 +003800 FILE-CONTROL. ST1354.2 +003900 SELECT PRINT-FILE ASSIGN TO ST1354.2 +004000 XXXXX055. ST1354.2 +004100 SELECT SORTIN-2E ASSIGN TO ST1354.2 +004200 XXXXX001. ST1354.2 +004300 SELECT SORTOUT-2E ASSIGN TO ST1354.2 +004400 XXXXX002. ST1354.2 +004500 SELECT USELESS-FILE ASSIGN TO ST1354.2 +004600 XXXXX003. ST1354.2 +004700 SELECT DEADWEIGHT-FILE ASSIGN TO ST1354.2 +004800 XXXXX004. ST1354.2 +004900 SELECT SORTFILE-2E ASSIGN TO ST1354.2 +005000 XXXXX027. ST1354.2 +005100 I-O-CONTROL. ST1354.2 +005200 SAME RECORD AREA FOR ST1354.2 +005300 USELESS-FILE ST1354.2 +005400 DEADWEIGHT-FILE ST1354.2 +005500 SAME SORT ST1354.2 +005600 SORTFILE-2E ST1354.2 +005700 USELESS-FILE ST1354.2 +005800 SAME ST1354.2 +005900 SORTIN-2E ST1354.2 +006000 SORTOUT-2E. ST1354.2 +006100 DATA DIVISION. ST1354.2 +006200 FILE SECTION. ST1354.2 +006300 FD PRINT-FILE. ST1354.2 +006400 01 PRINT-REC PICTURE X(120). ST1354.2 +006500 01 DUMMY-RECORD PICTURE X(120). ST1354.2 +006600 FD SORTIN-2E ST1354.2 +006700 LABEL RECORDS STANDARD ST1354.2 +006800C VALUE OF ST1354.2 +006900C XXXXX074 ST1354.2 +007000C IS ST1354.2 +007100C XXXXX075 ST1354.2 +007200G XXXXX069 ST1354.2 +007300 DATA RECORD IS SORTIN-REC. ST1354.2 +007400 01 SORTIN-REC. ST1354.2 +007500 02 SORTIN-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +007600 02 SORTIN-KEY PICTURE 9(8) USAGE DISPLAY. ST1354.2 +007700 02 SORTIN-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +007800 FD SORTOUT-2E ST1354.2 +007900 LABEL RECORDS STANDARD ST1354.2 +008000C VALUE OF ST1354.2 +008100C XXXXX074 ST1354.2 +008200C IS ST1354.2 +008300C XXXXX076 ST1354.2 +008400G XXXXX069 ST1354.2 +008500 DATA RECORD IS SORTOUT-REC. ST1354.2 +008600 01 SORTOUT-REC. ST1354.2 +008700 02 SORTOUT-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +008800 02 SORTOUT-KEY PICTURE 9(8). ST1354.2 +008900 02 SORTOUT-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +009000 FD USELESS-FILE ST1354.2 +009100 LABEL RECORDS STANDARD ST1354.2 +009200C VALUE OF ST1354.2 +009300C XXXXX074 ST1354.2 +009400C IS ST1354.2 +009500C XXXXX077 ST1354.2 +009600G XXXXX069 ST1354.2 +009700 DATA RECORD IS USELESS-REC. ST1354.2 +009800 01 USELESS-REC. ST1354.2 +009900 02 FILLER PICTURE X(80). ST1354.2 +010000 FD DEADWEIGHT-FILE ST1354.2 +010100 LABEL RECORDS STANDARD ST1354.2 +010200C VALUE OF ST1354.2 +010300C XXXXX074 ST1354.2 +010400C IS ST1354.2 +010500C XXXXX078 ST1354.2 +010600G XXXXX069 ST1354.2 +010700 DATA RECORD IS DEADWEIGHT-REC. ST1354.2 +010800 01 DEADWEIGHT-REC PICTURE X(80). ST1354.2 +010900 SD SORTFILE-2E ST1354.2 +011000 DATA RECORD IS SORTFILE-REC. ST1354.2 +011100 01 SORTFILE-REC. ST1354.2 +011200 02 SORTFILE-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +011300 02 SORTFILE-KEY PICTURE 9(8). ST1354.2 +011400 02 SORTFILE-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +011500 WORKING-STORAGE SECTION. ST1354.2 +011600 77 COMMENT-1 PICTURE X(27) VALUE "FIRST 20 OF 36-CHAR FIELD ". ST1354.2 +011700 77 COMMENT-2 PICTURE X(27) VALUE "LAST 16 OF 36-CHAR FIELD ". ST1354.2 +011800 77 UTIL-CTR PICTURE S99999. ST1354.2 +011900 01 LITERALS. ST1354.2 +012000 02 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1354.2 +012100 02 LITERAL-A PICTURE X(16) VALUE " A". ST1354.2 +012200 02 LITERAL-B PICTURE X(16) VALUE " B". ST1354.2 +012300 01 COMPUTED-BREAKDOWN. ST1354.2 +012400 02 FIRST-20 PICTURE X(20). ST1354.2 +012500 02 LAST-20 PICTURE X(20). ST1354.2 +012600 01 TEST-RESULTS. ST1354.2 +012700 02 FILLER PIC X VALUE SPACE. ST1354.2 +012800 02 FEATURE PIC X(20) VALUE SPACE. ST1354.2 +012900 02 FILLER PIC X VALUE SPACE. ST1354.2 +013000 02 P-OR-F PIC X(5) VALUE SPACE. ST1354.2 +013100 02 FILLER PIC X VALUE SPACE. ST1354.2 +013200 02 PAR-NAME. ST1354.2 +013300 03 FILLER PIC X(19) VALUE SPACE. ST1354.2 +013400 03 PARDOT-X PIC X VALUE SPACE. ST1354.2 +013500 03 DOTVALUE PIC 99 VALUE ZERO. ST1354.2 +013600 02 FILLER PIC X(8) VALUE SPACE. ST1354.2 +013700 02 RE-MARK PIC X(61). ST1354.2 +013800 01 TEST-COMPUTED. ST1354.2 +013900 02 FILLER PIC X(30) VALUE SPACE. ST1354.2 +014000 02 FILLER PIC X(17) VALUE ST1354.2 +014100 " COMPUTED=". ST1354.2 +014200 02 COMPUTED-X. ST1354.2 +014300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1354.2 +014400 03 COMPUTED-N REDEFINES COMPUTED-A ST1354.2 +014500 PIC -9(9).9(9). ST1354.2 +014600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1354.2 +014700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1354.2 +014800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1354.2 +014900 03 CM-18V0 REDEFINES COMPUTED-A. ST1354.2 +015000 04 COMPUTED-18V0 PIC -9(18). ST1354.2 +015100 04 FILLER PIC X. ST1354.2 +015200 03 FILLER PIC X(50) VALUE SPACE. ST1354.2 +015300 01 TEST-CORRECT. ST1354.2 +015400 02 FILLER PIC X(30) VALUE SPACE. ST1354.2 +015500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1354.2 +015600 02 CORRECT-X. ST1354.2 +015700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1354.2 +015800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1354.2 +015900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1354.2 +016000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1354.2 +016100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1354.2 +016200 03 CR-18V0 REDEFINES CORRECT-A. ST1354.2 +016300 04 CORRECT-18V0 PIC -9(18). ST1354.2 +016400 04 FILLER PIC X. ST1354.2 +016500 03 FILLER PIC X(2) VALUE SPACE. ST1354.2 +016600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1354.2 +016700 01 CCVS-C-1. ST1354.2 +016800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1354.2 +016900- "SS PARAGRAPH-NAME ST1354.2 +017000- " REMARKS". ST1354.2 +017100 02 FILLER PIC X(20) VALUE SPACE. ST1354.2 +017200 01 CCVS-C-2. ST1354.2 +017300 02 FILLER PIC X VALUE SPACE. ST1354.2 +017400 02 FILLER PIC X(6) VALUE "TESTED". ST1354.2 +017500 02 FILLER PIC X(15) VALUE SPACE. ST1354.2 +017600 02 FILLER PIC X(4) VALUE "FAIL". ST1354.2 +017700 02 FILLER PIC X(94) VALUE SPACE. ST1354.2 +017800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1354.2 +017900 01 REC-CT PIC 99 VALUE ZERO. ST1354.2 +018000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1354.2 +018500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1354.2 +018600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1354.2 +018700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1354.2 +018800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1354.2 +018900 01 CCVS-H-1. ST1354.2 +019000 02 FILLER PIC X(39) VALUE SPACES. ST1354.2 +019100 02 FILLER PIC X(42) VALUE ST1354.2 +019200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1354.2 +019300 02 FILLER PIC X(39) VALUE SPACES. ST1354.2 +019400 01 CCVS-H-2A. ST1354.2 +019500 02 FILLER PIC X(40) VALUE SPACE. ST1354.2 +019600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1354.2 +019700 02 FILLER PIC XXXX VALUE ST1354.2 +019800 "4.2 ". ST1354.2 +019900 02 FILLER PIC X(28) VALUE ST1354.2 +020000 " COPY - NOT FOR DISTRIBUTION". ST1354.2 +020100 02 FILLER PIC X(41) VALUE SPACE. ST1354.2 +020200 ST1354.2 +020300 01 CCVS-H-2B. ST1354.2 +020400 02 FILLER PIC X(15) VALUE ST1354.2 +020500 "TEST RESULT OF ". ST1354.2 +020600 02 TEST-ID PIC X(9). ST1354.2 +020700 02 FILLER PIC X(4) VALUE ST1354.2 +020800 " IN ". ST1354.2 +020900 02 FILLER PIC X(12) VALUE ST1354.2 +021000 " HIGH ". ST1354.2 +021100 02 FILLER PIC X(22) VALUE ST1354.2 +021200 " LEVEL VALIDATION FOR ". ST1354.2 +021300 02 FILLER PIC X(58) VALUE ST1354.2 +021400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +021500 01 CCVS-H-3. ST1354.2 +021600 02 FILLER PIC X(34) VALUE ST1354.2 +021700 " FOR OFFICIAL USE ONLY ". ST1354.2 +021800 02 FILLER PIC X(58) VALUE ST1354.2 +021900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1354.2 +022000 02 FILLER PIC X(28) VALUE ST1354.2 +022100 " COPYRIGHT 1985 ". ST1354.2 +022200 01 CCVS-E-1. ST1354.2 +022300 02 FILLER PIC X(52) VALUE SPACE. ST1354.2 +022400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1354.2 +022500 02 ID-AGAIN PIC X(9). ST1354.2 +022600 02 FILLER PIC X(45) VALUE SPACES. ST1354.2 +022700 01 CCVS-E-2. ST1354.2 +022800 02 FILLER PIC X(31) VALUE SPACE. ST1354.2 +022900 02 FILLER PIC X(21) VALUE SPACE. ST1354.2 +023000 02 CCVS-E-2-2. ST1354.2 +023100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1354.2 +023200 03 FILLER PIC X VALUE SPACE. ST1354.2 +023300 03 ENDER-DESC PIC X(44) VALUE ST1354.2 +023400 "ERRORS ENCOUNTERED". ST1354.2 +023500 01 CCVS-E-3. ST1354.2 +023600 02 FILLER PIC X(22) VALUE ST1354.2 +023700 " FOR OFFICIAL USE ONLY". ST1354.2 +023800 02 FILLER PIC X(12) VALUE SPACE. ST1354.2 +023900 02 FILLER PIC X(58) VALUE ST1354.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +024100 02 FILLER PIC X(13) VALUE SPACE. ST1354.2 +024200 02 FILLER PIC X(15) VALUE ST1354.2 +024300 " COPYRIGHT 1985". ST1354.2 +024400 01 CCVS-E-4. ST1354.2 +024500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1354.2 +024600 02 FILLER PIC X(4) VALUE " OF ". ST1354.2 +024700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1354.2 +024800 02 FILLER PIC X(40) VALUE ST1354.2 +024900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1354.2 +025000 01 XXINFO. ST1354.2 +025100 02 FILLER PIC X(19) VALUE ST1354.2 +025200 "*** INFORMATION ***". ST1354.2 +025300 02 INFO-TEXT. ST1354.2 +025400 04 FILLER PIC X(8) VALUE SPACE. ST1354.2 +025500 04 XXCOMPUTED PIC X(20). ST1354.2 +025600 04 FILLER PIC X(5) VALUE SPACE. ST1354.2 +025700 04 XXCORRECT PIC X(20). ST1354.2 +025800 02 INF-ANSI-REFERENCE PIC X(48). ST1354.2 +025900 01 HYPHEN-LINE. ST1354.2 +026000 02 FILLER PIC IS X VALUE IS SPACE. ST1354.2 +026100 02 FILLER PIC IS X(65) VALUE IS "************************ST1354.2 +026200- "*****************************************". ST1354.2 +026300 02 FILLER PIC IS X(54) VALUE IS "************************ST1354.2 +026400- "******************************". ST1354.2 +026500 01 CCVS-PGM-ID PIC X(9) VALUE ST1354.2 +026600 "ST135A". ST1354.2 +026700 PROCEDURE DIVISION. ST1354.2 +026800 CCVS1 SECTION. ST1354.2 +026900 OPEN-FILES. ST1354.2 +027000 OPEN OUTPUT PRINT-FILE. ST1354.2 +027100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1354.2 +027200 MOVE SPACE TO TEST-RESULTS. ST1354.2 +027300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1354.2 +027400 GO TO CCVS1-EXIT. ST1354.2 +027500 CLOSE-FILES. ST1354.2 +027600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1354.2 +027700 TERMINATE-CCVS. ST1354.2 +027800S EXIT PROGRAM. ST1354.2 +027900STERMINATE-CALL. ST1354.2 +028000 STOP RUN. ST1354.2 +028100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1354.2 +028200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1354.2 +028300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1354.2 +028400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1354.2 +028500 MOVE "****TEST DELETED****" TO RE-MARK. ST1354.2 +028600 PRINT-DETAIL. ST1354.2 +028700 IF REC-CT NOT EQUAL TO ZERO ST1354.2 +028800 MOVE "." TO PARDOT-X ST1354.2 +028900 MOVE REC-CT TO DOTVALUE. ST1354.2 +029000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1354.2 +029100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1354.2 +029200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1354.2 +029300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1354.2 +029400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1354.2 +029500 MOVE SPACE TO CORRECT-X. ST1354.2 +029600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1354.2 +029700 MOVE SPACE TO RE-MARK. ST1354.2 +029800 HEAD-ROUTINE. ST1354.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1354.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1354.2 +030300 COLUMN-NAMES-ROUTINE. ST1354.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +030700 END-ROUTINE. ST1354.2 +030800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1354.2 +030900 END-RTN-EXIT. ST1354.2 +031000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +031100 END-ROUTINE-1. ST1354.2 +031200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1354.2 +031300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1354.2 +031400 ADD PASS-COUNTER TO ERROR-HOLD. ST1354.2 +031500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1354.2 +031600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1354.2 +031700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1354.2 +031800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1354.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1354.2 +032000 END-ROUTINE-12. ST1354.2 +032100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1354.2 +032200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1354.2 +032300 MOVE "NO " TO ERROR-TOTAL ST1354.2 +032400 ELSE ST1354.2 +032500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1354.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1354.2 +032700 PERFORM WRITE-LINE. ST1354.2 +032800 END-ROUTINE-13. ST1354.2 +032900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1354.2 +033000 MOVE "NO " TO ERROR-TOTAL ELSE ST1354.2 +033100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1354.2 +033200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1354.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +033400 IF INSPECT-COUNTER EQUAL TO ZERO ST1354.2 +033500 MOVE "NO " TO ERROR-TOTAL ST1354.2 +033600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1354.2 +033700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1354.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +033900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +034000 WRITE-LINE. ST1354.2 +034100 ADD 1 TO RECORD-COUNT. ST1354.2 +034200Y IF RECORD-COUNT GREATER 42 ST1354.2 +034300Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1354.2 +034400Y MOVE SPACE TO DUMMY-RECORD ST1354.2 +034500Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1354.2 +034600Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1354.2 +034700Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1354.2 +034800Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1354.2 +034900Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1354.2 +035000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1354.2 +035400Y MOVE ZERO TO RECORD-COUNT. ST1354.2 +035500 PERFORM WRT-LN. ST1354.2 +035600 WRT-LN. ST1354.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1354.2 +035800 MOVE SPACE TO DUMMY-RECORD. ST1354.2 +035900 BLANK-LINE-PRINT. ST1354.2 +036000 PERFORM WRT-LN. ST1354.2 +036100 FAIL-ROUTINE. ST1354.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE ST1354.2 +036300 GO TO FAIL-ROUTINE-WRITE. ST1354.2 +036400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1354.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1354.2 +036600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1354.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1354.2 +036900 GO TO FAIL-ROUTINE-EX. ST1354.2 +037000 FAIL-ROUTINE-WRITE. ST1354.2 +037100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1354.2 +037200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1354.2 +037300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1354.2 +037400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1354.2 +037500 FAIL-ROUTINE-EX. EXIT. ST1354.2 +037600 BAIL-OUT. ST1354.2 +037700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1354.2 +037800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1354.2 +037900 BAIL-OUT-WRITE. ST1354.2 +038000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1354.2 +038100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1354.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1354.2 +038400 BAIL-OUT-EX. EXIT. ST1354.2 +038500 CCVS1-EXIT. ST1354.2 +038600 EXIT. ST1354.2 +038700 BUILD-AND-SORT-AND-CHECK SECTION. ST1354.2 +038800 BASAC. ST1354.2 +038900 OPEN OUTPUT SORTIN-2E. ST1354.2 +039000 OPEN OUTPUT USELESS-FILE. ST1354.2 +039100 OPEN OUTPUT DEADWEIGHT-FILE. ST1354.2 +039200 MOVE +10 TO UTIL-CTR. ST1354.2 +039300 BUILD-LOOP. ST1354.2 +039400 MOVE UTIL-CTR TO SORTIN-KEY. ST1354.2 +039500* NOTE UTIL-CTR IS INTENTIONALLY MOVED TO AN UNSIGNED ITEM.ST1354.2 +039600 MOVE "A" TO SORTIN-NON-KEY-1. ST1354.2 +039700 MOVE "B" TO SORTIN-NON-KEY-2. ST1354.2 +039800 WRITE SORTIN-REC. ST1354.2 +039900 MOVE SPACE TO USELESS-REC. ST1354.2 +040000 MOVE SPACE TO DEADWEIGHT-REC. ST1354.2 +040100 WRITE USELESS-REC. ST1354.2 +040200 WRITE DEADWEIGHT-REC. ST1354.2 +040300 SUBTRACT +1 FROM UTIL-CTR. ST1354.2 +040400 IF UTIL-CTR GREATER THAN -11 GO TO BUILD-LOOP. ST1354.2 +040500 CLOSE SORTIN-2E. ST1354.2 +040600 CLOSE USELESS-FILE. ST1354.2 +040700 CLOSE DEADWEIGHT-FILE. ST1354.2 +040800 BUILD-TEST. ST1354.2 +040900 IF UTIL-CTR EQUAL TO -11 ST1354.2 +041000 PERFORM PASS GO TO BUILD-WRITE. ST1354.2 +041100 BUILD-FAIL. ST1354.2 +041200 PERFORM FAIL. ST1354.2 +041300 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +041400 MOVE -11 TO CORRECT-N. ST1354.2 +041500 BUILD-WRITE. ST1354.2 +041600 MOVE "TAPE BEING BUILT" TO FEATURE. ST1354.2 +041700 MOVE "BUILD-TEST" TO PAR-NAME. ST1354.2 +041800 PERFORM PRINT-DETAIL. ST1354.2 +041900 SORT-PARAGRAPH. ST1354.2 +042000 SORT SORTFILE-2E ON ASCENDING ST1354.2 +042100 SORTFILE-KEY ST1354.2 +042200 USING SORTIN-2E ST1354.2 +042300 OUTPUT PROCEDURE OUTPROC. ST1354.2 +042400 SORT-INIT. ST1354.2 +042500 OPEN INPUT SORTOUT-2E. ST1354.2 +042600 OPEN INPUT USELESS-FILE. ST1354.2 +042700 OPEN INPUT DEADWEIGHT-FILE. ST1354.2 +042800 MOVE +0 TO UTIL-CTR. ST1354.2 +042900 MOVE "SORT ---" TO FEATURE. ST1354.2 +043000 PERFORM PRINT-DETAIL. ST1354.2 +043100 MOVE " SAME AREA" TO FEATURE. ST1354.2 +043200 SORT-TEST-1. ST1354.2 +043300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1354.2 +043400 PERFORM READ-SORTOUT. ST1354.2 +043500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +043600- " A" GO TO SORT-FAIL-1. ST1354.2 +043700 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +043800- " B" GO TO SORT-FAIL-1. ST1354.2 +043900 IF SORTOUT-KEY EQUAL TO ZERO ST1354.2 +044000 PERFORM PASS GO TO SORT-WRITE-1. ST1354.2 +044100 SORT-FAIL-1. ST1354.2 +044200 MOVE ZERO TO CORRECT-N. ST1354.2 +044300 PERFORM BREAKDOWN-PARA. ST1354.2 +044400 SORT-WRITE-1. ST1354.2 +044500 PERFORM PRINT-DETAIL. ST1354.2 +044600 SORT-TEST-2. ST1354.2 +044700 MOVE "SORT-TEST-2" TO PAR-NAME. ST1354.2 +044800 PERFORM READ-SORTOUT. ST1354.2 +044900 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +045000- " A" GO TO SORT-FAIL-2. ST1354.2 +045100 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +045200- " B" GO TO SORT-FAIL-2. ST1354.2 +045300 IF SORTOUT-KEY EQUAL TO 1 ST1354.2 +045400 PERFORM PASS GO TO SORT-WRITE-2. ST1354.2 +045500 SORT-FAIL-2. ST1354.2 +045600 MOVE 1 TO CORRECT-N. ST1354.2 +045700 PERFORM BREAKDOWN-PARA. ST1354.2 +045800 SORT-WRITE-2. ST1354.2 +045900 PERFORM PRINT-DETAIL. ST1354.2 +046000 SORT-TEST-3. ST1354.2 +046100 MOVE "SORT-TEST-3" TO PAR-NAME. ST1354.2 +046200 PERFORM READ-SORTOUT. ST1354.2 +046300 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +046400- " A" GO TO SORT-FAIL-3. ST1354.2 +046500 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +046600- " B" GO TO SORT-FAIL-3. ST1354.2 +046700 IF SORTOUT-KEY EQUAL TO 1 ST1354.2 +046800 PERFORM PASS GO TO SORT-WRITE-3. ST1354.2 +046900 SORT-FAIL-3. ST1354.2 +047000 MOVE 1 TO CORRECT-N. ST1354.2 +047100 PERFORM BREAKDOWN-PARA. ST1354.2 +047200 SORT-WRITE-3. ST1354.2 +047300 PERFORM PRINT-DETAIL. ST1354.2 +047400 SORT-TEST-4. ST1354.2 +047500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1354.2 +047600 PERFORM READ-SORTOUT 10 TIMES. ST1354.2 +047700 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +047800- " A" GO TO SORT-FAIL-4. ST1354.2 +047900 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +048000- " B" GO TO SORT-FAIL-4. ST1354.2 +048100 IF SORTOUT-KEY EQUAL TO 6 ST1354.2 +048200 PERFORM PASS GO TO SORT-WRITE-4. ST1354.2 +048300 SORT-FAIL-4. ST1354.2 +048400 MOVE 6 TO CORRECT-N. ST1354.2 +048500 PERFORM BREAKDOWN-PARA. ST1354.2 +048600 SORT-WRITE-4. ST1354.2 +048700 PERFORM PRINT-DETAIL. ST1354.2 +048800 SORT-TEST-5. ST1354.2 +048900 MOVE "SORT-TEST-5" TO PAR-NAME. ST1354.2 +049000 PERFORM READ-SORTOUT. ST1354.2 +049100 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +049200- " A" GO TO SORT-FAIL-5. ST1354.2 +049300 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +049400- " B" GO TO SORT-FAIL-5. ST1354.2 +049500 IF SORTOUT-KEY EQUAL TO 7 ST1354.2 +049600 PERFORM PASS GO TO SORT-WRITE-5. ST1354.2 +049700 SORT-FAIL-5. ST1354.2 +049800 MOVE 7 TO CORRECT-N. ST1354.2 +049900 PERFORM BREAKDOWN-PARA. ST1354.2 +050000 SORT-WRITE-5. ST1354.2 +050100 PERFORM PRINT-DETAIL. ST1354.2 +050200 SORT-TEST-6. ST1354.2 +050300 MOVE "SORT-TEST-6" TO PAR-NAME. ST1354.2 +050400 PERFORM READ-SORTOUT 6 TIMES ST1354.2 +050500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +050600- " A" GO TO SORT-FAIL-6. ST1354.2 +050700 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +050800- " B" GO TO SORT-FAIL-6. ST1354.2 +050900 IF SORTOUT-KEY EQUAL TO 10 ST1354.2 +051000 PERFORM PASS GO TO SORT-WRITE-6. ST1354.2 +051100 SORT-FAIL-6. ST1354.2 +051200 MOVE 10 TO CORRECT-N. ST1354.2 +051300 PERFORM BREAKDOWN-PARA. ST1354.2 +051400 SORT-WRITE-6. ST1354.2 +051500 PERFORM PRINT-DETAIL. ST1354.2 +051600 SORT-TEST-7. ST1354.2 +051700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1354.2 +051800 PERFORM READ-SORTOUT. ST1354.2 +051900 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +052000- " A" GO TO SORT-FAIL-7. ST1354.2 +052100 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +052200- " B" GO TO SORT-FAIL-7. ST1354.2 +052300 IF SORTOUT-KEY EQUAL TO 10 ST1354.2 +052400 PERFORM PASS GO TO SORT-WRITE-7. ST1354.2 +052500 SORT-FAIL-7. ST1354.2 +052600 MOVE 10 TO CORRECT-N. ST1354.2 +052700 PERFORM BREAKDOWN-PARA. ST1354.2 +052800 SORT-WRITE-7. ST1354.2 +052900 PERFORM PRINT-DETAIL. ST1354.2 +053000 SORT-TEST-8. ST1354.2 +053100 MOVE "SORT-TEST-8" TO PAR-NAME. ST1354.2 +053200 READ SORTOUT-2E AT END ST1354.2 +053300 PERFORM PASS GO TO SORT-WRITE-8. ST1354.2 +053400 SORT-FAIL-8. ST1354.2 +053500 MOVE SPACE TO LITERALS. ST1354.2 +053600 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +053700 MOVE 21 TO CORRECT-N. ST1354.2 +053800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1354.2 +053900 PERFORM PRINT-DETAIL. ST1354.2 +054000 PERFORM BREAKDOWN-PARA. ST1354.2 +054100 SORT-WRITE-8. ST1354.2 +054200 PERFORM PRINT-DETAIL. ST1354.2 +054300 CLOSE-SORT-FILES. ST1354.2 +054400 CLOSE USELESS-FILE. ST1354.2 +054500 CLOSE DEADWEIGHT-FILE. ST1354.2 +054600 CLOSE SORTOUT-2E. ST1354.2 +054700 GO TO CCVS-EXIT. ST1354.2 +054800 BREAKDOWN-PARA. ST1354.2 +054900 MOVE SORTOUT-KEY TO COMPUTED-N. ST1354.2 +055000 PERFORM FAIL. ST1354.2 +055100 MOVE "KEY AREA" TO RE-MARK. ST1354.2 +055200 PERFORM PRINT-DETAIL. ST1354.2 +055300 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-BREAKDOWN. ST1354.2 +055400 MOVE FIRST-20 TO COMPUTED-A. ST1354.2 +055500 MOVE SP-ACE TO CORRECT-A. ST1354.2 +055600 MOVE COMMENT-1 TO RE-MARK. ST1354.2 +055700 PERFORM PRINT-DETAIL. ST1354.2 +055800 MOVE LAST-20 TO COMPUTED-A. ST1354.2 +055900 MOVE LITERAL-A TO CORRECT-A. ST1354.2 +056000 MOVE COMMENT-2 TO RE-MARK. ST1354.2 +056100 PERFORM PRINT-DETAIL. ST1354.2 +056200 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1354.2 +056300 MOVE FIRST-20 TO COMPUTED-A. ST1354.2 +056400 MOVE SP-ACE TO CORRECT-A. ST1354.2 +056500 MOVE COMMENT-1 TO RE-MARK. ST1354.2 +056600 PERFORM PRINT-DETAIL. ST1354.2 +056700 MOVE LAST-20 TO COMPUTED-A. ST1354.2 +056800 MOVE SP-ACE TO CORRECT-A. ST1354.2 +056900 MOVE COMMENT-2 TO RE-MARK. ST1354.2 +057000 READ-SORTOUT. ST1354.2 +057100 READ SORTOUT-2E AT END GO TO READ-ERROR. ST1354.2 +057200 ADD 1 TO UTIL-CTR. ST1354.2 +057300 READ-ERROR. ST1354.2 +057400 PERFORM FAIL. ST1354.2 +057500 MOVE "READ-ERROR" TO PAR-NAME. ST1354.2 +057600 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +057700 MOVE 21 TO CORRECT-N. ST1354.2 +057800 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1354.2 +057900 PERFORM PRINT-DETAIL. ST1354.2 +058000 GO TO CLOSE-SORT-FILES. ST1354.2 +058100 OUTPROC SECTION. ST1354.2 +058200 OUTPROC-OPEN. ST1354.2 +058300 OPEN OUTPUT SORTOUT-2E. ST1354.2 +058400 OUTPROC-RETURN. ST1354.2 +058500 RETURN SORTFILE-2E AT END GO TO OUTPROC-CLOSE. ST1354.2 +058600 MOVE SORTFILE-REC TO SORTOUT-REC. ST1354.2 +058700 WRITE SORTOUT-REC. ST1354.2 +058800 GO TO OUTPROC-RETURN. ST1354.2 +058900 OUTPROC-CLOSE. ST1354.2 +059000 CLOSE SORTOUT-2E. ST1354.2 +059100 CCVS-EXIT SECTION. ST1354.2 +059200 CCVS-999999. ST1354.2 +059300 GO TO CLOSE-FILES. ST1354.2 +*END-OF,ST135A TES06520 +*HEADER,COBOL,ST136A +000100 IDENTIFICATION DIVISION. ST1364.2 +000200 PROGRAM-ID. ST1364.2 +000300 ST136A. ST1364.2 +000400 ST1364.2 +000500**************************************************************** ST1364.2 +000600* * ST1364.2 +000700* VALIDATION FOR:- * ST1364.2 +000800* * ST1364.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +001000* * ST1364.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1364.2 +001200* * ST1364.2 +001300**************************************************************** ST1364.2 +001400* * ST1364.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * ST1364.2 +001600* * ST1364.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1364.2 +001800* X-82 - SOURCE COMPUTER NAME. * ST1364.2 +001900* X-83 - OBJECT COMPUTER NAME. * ST1364.2 +002000* * ST1364.2 +002100**************************************************************** ST1364.2 +002200* ST206 TESTS THE FROM OPTION OF THE RELEASE VERB. TEN RECORDS ST1364.2 +002300* ARE CREATED WITH THE NUMERICAL KEY DESCENDING FROM 10 THRU 1.ST1364.2 +002400* THE RECORDS ARE THEN SORTED INTO ASCENDING SEQUENCE AND THE ST1364.2 +002500* RESULTS ARE SPOT-CHECKED. ST1364.2 +002600* ST1364.2 +002700 ENVIRONMENT DIVISION. ST1364.2 +002800 CONFIGURATION SECTION. ST1364.2 +002900 SOURCE-COMPUTER. ST1364.2 +003000 XXXXX082. ST1364.2 +003100 OBJECT-COMPUTER. ST1364.2 +003200 XXXXX083. ST1364.2 +003300 INPUT-OUTPUT SECTION. ST1364.2 +003400 FILE-CONTROL. ST1364.2 +003500 SELECT PRINT-FILE ASSIGN TO ST1364.2 +003600 XXXXX055. ST1364.2 +003700 SELECT SORTOUT-2F ASSIGN TO ST1364.2 +003800 XXXXX001. ST1364.2 +003900 SELECT SORTFILE-2F ASSIGN TO ST1364.2 +004000 XXXXX027. ST1364.2 +004100 DATA DIVISION. ST1364.2 +004200 FILE SECTION. ST1364.2 +004300 FD PRINT-FILE. ST1364.2 +004400 01 PRINT-REC PICTURE X(120). ST1364.2 +004500 01 DUMMY-RECORD PICTURE X(120). ST1364.2 +004600 FD SORTOUT-2F ST1364.2 +004700 LABEL RECORDS STANDARD ST1364.2 +004800C VALUE OF ST1364.2 +004900C XXXXX074 ST1364.2 +005000C IS ST1364.2 +005100C XXXXX075 ST1364.2 +005200G XXXXX069 ST1364.2 +005300 DATA RECORD IS SORTOUT-REC. ST1364.2 +005400 01 SORTOUT-REC. ST1364.2 +005500 02 SORTOUT-NON-KEY-1 PICTURE A(12). ST1364.2 +005600 02 SORTOUT-KEY PICTURE S9(8). ST1364.2 +005700 02 SORTOUT-NON-KEY-2 PICTURE A(60). ST1364.2 +005800 SD SORTFILE-2F ST1364.2 +005900 DATA RECORD IS SORTFILE-REC. ST1364.2 +006000 01 SORTFILE-REC. ST1364.2 +006100 02 SORTFILE-NON-KEY-1 PICTURE X(12). ST1364.2 +006200 02 SORTFILE-KEY PICTURE S9(8). ST1364.2 +006300 02 SORTFILE-NON-KEY-2 PICTURE X(60). ST1364.2 +006400 WORKING-STORAGE SECTION. ST1364.2 +006500 77 LITERAL-B PICTURE X(12) VALUE "B ". ST1364.2 +006600 77 UTIL-CTR PICTURE S99999. ST1364.2 +006700 77 COMMENT-1 PICTURE X(27) VALUE "KEY AREA ". ST1364.2 +006800 77 COMMENT-2 PICTURE X(27) VALUE "FIRST 20 OF 60-CHAR FIELD ". ST1364.2 +006900 77 COMMENT-3 PICTURE X(27) VALUE "SECOND 20 OF 60-CHAR FIELD ". ST1364.2 +007000 77 COMMENT-4 PICTURE X(27) VALUE "THIRD 20 OF 60-CHAR FIELD ". ST1364.2 +007100 77 ALL-A PICTURE X(60) VALUE ALL "A". ST1364.2 +007200 77 ALL-X PICTURE X(60) VALUE ALL "X". ST1364.2 +007300 77 ALL-Z PICTURE X(60) VALUE ALL "Z". ST1364.2 +007400 01 WORK-REC. ST1364.2 +007500 02 WORK-NON-KEY-1 PICTURE X(12). ST1364.2 +007600 02 WORK-KEY PICTURE S9(8). ST1364.2 +007700 02 WORK-NON-KEY-2 PICTURE X(60). ST1364.2 +007800 01 COMPUTED-BREAKDOWN. ST1364.2 +007900 02 FIRST-20CM PICTURE X(20). ST1364.2 +008000 02 SECOND-20CM PICTURE X(20). ST1364.2 +008100 02 THIRD-20CM PICTURE X(20). ST1364.2 +008200 01 CORRECT-BREAKDOWN. ST1364.2 +008300 02 FIRST-20CR PICTURE X(20). ST1364.2 +008400 02 SECOND-20CR PICTURE X(20). ST1364.2 +008500 02 THIRD-20CR PICTURE X(20). ST1364.2 +008600 01 HOLD-REC. ST1364.2 +008700 02 HOLD-NON-KEY-1 PICTURE X(12). ST1364.2 +008800 02 HOLD-KEY PICTURE S9(8). ST1364.2 +008900 02 HOLD-NON-KEY-2 PICTURE X(60). ST1364.2 +009000 01 TEST-RESULTS. ST1364.2 +009100 02 FILLER PIC X VALUE SPACE. ST1364.2 +009200 02 FEATURE PIC X(20) VALUE SPACE. ST1364.2 +009300 02 FILLER PIC X VALUE SPACE. ST1364.2 +009400 02 P-OR-F PIC X(5) VALUE SPACE. ST1364.2 +009500 02 FILLER PIC X VALUE SPACE. ST1364.2 +009600 02 PAR-NAME. ST1364.2 +009700 03 FILLER PIC X(19) VALUE SPACE. ST1364.2 +009800 03 PARDOT-X PIC X VALUE SPACE. ST1364.2 +009900 03 DOTVALUE PIC 99 VALUE ZERO. ST1364.2 +010000 02 FILLER PIC X(8) VALUE SPACE. ST1364.2 +010100 02 RE-MARK PIC X(61). ST1364.2 +010200 01 TEST-COMPUTED. ST1364.2 +010300 02 FILLER PIC X(30) VALUE SPACE. ST1364.2 +010400 02 FILLER PIC X(17) VALUE ST1364.2 +010500 " COMPUTED=". ST1364.2 +010600 02 COMPUTED-X. ST1364.2 +010700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1364.2 +010800 03 COMPUTED-N REDEFINES COMPUTED-A ST1364.2 +010900 PIC -9(9).9(9). ST1364.2 +011000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1364.2 +011100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1364.2 +011200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1364.2 +011300 03 CM-18V0 REDEFINES COMPUTED-A. ST1364.2 +011400 04 COMPUTED-18V0 PIC -9(18). ST1364.2 +011500 04 FILLER PIC X. ST1364.2 +011600 03 FILLER PIC X(50) VALUE SPACE. ST1364.2 +011700 01 TEST-CORRECT. ST1364.2 +011800 02 FILLER PIC X(30) VALUE SPACE. ST1364.2 +011900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1364.2 +012000 02 CORRECT-X. ST1364.2 +012100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1364.2 +012200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1364.2 +012300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1364.2 +012400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1364.2 +012500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1364.2 +012600 03 CR-18V0 REDEFINES CORRECT-A. ST1364.2 +012700 04 CORRECT-18V0 PIC -9(18). ST1364.2 +012800 04 FILLER PIC X. ST1364.2 +012900 03 FILLER PIC X(2) VALUE SPACE. ST1364.2 +013000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1364.2 +013100 01 CCVS-C-1. ST1364.2 +013200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1364.2 +013300- "SS PARAGRAPH-NAME ST1364.2 +013400- " REMARKS". ST1364.2 +013500 02 FILLER PIC X(20) VALUE SPACE. ST1364.2 +013600 01 CCVS-C-2. ST1364.2 +013700 02 FILLER PIC X VALUE SPACE. ST1364.2 +013800 02 FILLER PIC X(6) VALUE "TESTED". ST1364.2 +013900 02 FILLER PIC X(15) VALUE SPACE. ST1364.2 +014000 02 FILLER PIC X(4) VALUE "FAIL". ST1364.2 +014100 02 FILLER PIC X(94) VALUE SPACE. ST1364.2 +014200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1364.2 +014300 01 REC-CT PIC 99 VALUE ZERO. ST1364.2 +014400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1364.2 +014900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1364.2 +015000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1364.2 +015100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1364.2 +015200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1364.2 +015300 01 CCVS-H-1. ST1364.2 +015400 02 FILLER PIC X(39) VALUE SPACES. ST1364.2 +015500 02 FILLER PIC X(42) VALUE ST1364.2 +015600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1364.2 +015700 02 FILLER PIC X(39) VALUE SPACES. ST1364.2 +015800 01 CCVS-H-2A. ST1364.2 +015900 02 FILLER PIC X(40) VALUE SPACE. ST1364.2 +016000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1364.2 +016100 02 FILLER PIC XXXX VALUE ST1364.2 +016200 "4.2 ". ST1364.2 +016300 02 FILLER PIC X(28) VALUE ST1364.2 +016400 " COPY - NOT FOR DISTRIBUTION". ST1364.2 +016500 02 FILLER PIC X(41) VALUE SPACE. ST1364.2 +016600 ST1364.2 +016700 01 CCVS-H-2B. ST1364.2 +016800 02 FILLER PIC X(15) VALUE ST1364.2 +016900 "TEST RESULT OF ". ST1364.2 +017000 02 TEST-ID PIC X(9). ST1364.2 +017100 02 FILLER PIC X(4) VALUE ST1364.2 +017200 " IN ". ST1364.2 +017300 02 FILLER PIC X(12) VALUE ST1364.2 +017400 " HIGH ". ST1364.2 +017500 02 FILLER PIC X(22) VALUE ST1364.2 +017600 " LEVEL VALIDATION FOR ". ST1364.2 +017700 02 FILLER PIC X(58) VALUE ST1364.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +017900 01 CCVS-H-3. ST1364.2 +018000 02 FILLER PIC X(34) VALUE ST1364.2 +018100 " FOR OFFICIAL USE ONLY ". ST1364.2 +018200 02 FILLER PIC X(58) VALUE ST1364.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1364.2 +018400 02 FILLER PIC X(28) VALUE ST1364.2 +018500 " COPYRIGHT 1985 ". ST1364.2 +018600 01 CCVS-E-1. ST1364.2 +018700 02 FILLER PIC X(52) VALUE SPACE. ST1364.2 +018800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1364.2 +018900 02 ID-AGAIN PIC X(9). ST1364.2 +019000 02 FILLER PIC X(45) VALUE SPACES. ST1364.2 +019100 01 CCVS-E-2. ST1364.2 +019200 02 FILLER PIC X(31) VALUE SPACE. ST1364.2 +019300 02 FILLER PIC X(21) VALUE SPACE. ST1364.2 +019400 02 CCVS-E-2-2. ST1364.2 +019500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1364.2 +019600 03 FILLER PIC X VALUE SPACE. ST1364.2 +019700 03 ENDER-DESC PIC X(44) VALUE ST1364.2 +019800 "ERRORS ENCOUNTERED". ST1364.2 +019900 01 CCVS-E-3. ST1364.2 +020000 02 FILLER PIC X(22) VALUE ST1364.2 +020100 " FOR OFFICIAL USE ONLY". ST1364.2 +020200 02 FILLER PIC X(12) VALUE SPACE. ST1364.2 +020300 02 FILLER PIC X(58) VALUE ST1364.2 +020400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +020500 02 FILLER PIC X(13) VALUE SPACE. ST1364.2 +020600 02 FILLER PIC X(15) VALUE ST1364.2 +020700 " COPYRIGHT 1985". ST1364.2 +020800 01 CCVS-E-4. ST1364.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1364.2 +021000 02 FILLER PIC X(4) VALUE " OF ". ST1364.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1364.2 +021200 02 FILLER PIC X(40) VALUE ST1364.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1364.2 +021400 01 XXINFO. ST1364.2 +021500 02 FILLER PIC X(19) VALUE ST1364.2 +021600 "*** INFORMATION ***". ST1364.2 +021700 02 INFO-TEXT. ST1364.2 +021800 04 FILLER PIC X(8) VALUE SPACE. ST1364.2 +021900 04 XXCOMPUTED PIC X(20). ST1364.2 +022000 04 FILLER PIC X(5) VALUE SPACE. ST1364.2 +022100 04 XXCORRECT PIC X(20). ST1364.2 +022200 02 INF-ANSI-REFERENCE PIC X(48). ST1364.2 +022300 01 HYPHEN-LINE. ST1364.2 +022400 02 FILLER PIC IS X VALUE IS SPACE. ST1364.2 +022500 02 FILLER PIC IS X(65) VALUE IS "************************ST1364.2 +022600- "*****************************************". ST1364.2 +022700 02 FILLER PIC IS X(54) VALUE IS "************************ST1364.2 +022800- "******************************". ST1364.2 +022900 01 CCVS-PGM-ID PIC X(9) VALUE ST1364.2 +023000 "ST136A". ST1364.2 +023100 PROCEDURE DIVISION. ST1364.2 +023200 CCVS1 SECTION. ST1364.2 +023300 OPEN-FILES. ST1364.2 +023400 OPEN OUTPUT PRINT-FILE. ST1364.2 +023500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1364.2 +023600 MOVE SPACE TO TEST-RESULTS. ST1364.2 +023700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1364.2 +023800 GO TO CCVS1-EXIT. ST1364.2 +023900 CLOSE-FILES. ST1364.2 +024000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1364.2 +024100 TERMINATE-CCVS. ST1364.2 +024200S EXIT PROGRAM. ST1364.2 +024300STERMINATE-CALL. ST1364.2 +024400 STOP RUN. ST1364.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1364.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1364.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1364.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1364.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. ST1364.2 +025000 PRINT-DETAIL. ST1364.2 +025100 IF REC-CT NOT EQUAL TO ZERO ST1364.2 +025200 MOVE "." TO PARDOT-X ST1364.2 +025300 MOVE REC-CT TO DOTVALUE. ST1364.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1364.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1364.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1364.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1364.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1364.2 +025900 MOVE SPACE TO CORRECT-X. ST1364.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1364.2 +026100 MOVE SPACE TO RE-MARK. ST1364.2 +026200 HEAD-ROUTINE. ST1364.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1364.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1364.2 +026700 COLUMN-NAMES-ROUTINE. ST1364.2 +026800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +026900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +027100 END-ROUTINE. ST1364.2 +027200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1364.2 +027300 END-RTN-EXIT. ST1364.2 +027400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +027500 END-ROUTINE-1. ST1364.2 +027600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1364.2 +027700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1364.2 +027800 ADD PASS-COUNTER TO ERROR-HOLD. ST1364.2 +027900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1364.2 +028000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1364.2 +028100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1364.2 +028200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1364.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1364.2 +028400 END-ROUTINE-12. ST1364.2 +028500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1364.2 +028600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1364.2 +028700 MOVE "NO " TO ERROR-TOTAL ST1364.2 +028800 ELSE ST1364.2 +028900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1364.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1364.2 +029100 PERFORM WRITE-LINE. ST1364.2 +029200 END-ROUTINE-13. ST1364.2 +029300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1364.2 +029400 MOVE "NO " TO ERROR-TOTAL ELSE ST1364.2 +029500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1364.2 +029600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1364.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +029800 IF INSPECT-COUNTER EQUAL TO ZERO ST1364.2 +029900 MOVE "NO " TO ERROR-TOTAL ST1364.2 +030000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1364.2 +030100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1364.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +030300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +030400 WRITE-LINE. ST1364.2 +030500 ADD 1 TO RECORD-COUNT. ST1364.2 +030600Y IF RECORD-COUNT GREATER 42 ST1364.2 +030700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1364.2 +030800Y MOVE SPACE TO DUMMY-RECORD ST1364.2 +030900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1364.2 +031000Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1364.2 +031100Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1364.2 +031200Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1364.2 +031300Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1364.2 +031400Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031500Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031600Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031700Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1364.2 +031800Y MOVE ZERO TO RECORD-COUNT. ST1364.2 +031900 PERFORM WRT-LN. ST1364.2 +032000 WRT-LN. ST1364.2 +032100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1364.2 +032200 MOVE SPACE TO DUMMY-RECORD. ST1364.2 +032300 BLANK-LINE-PRINT. ST1364.2 +032400 PERFORM WRT-LN. ST1364.2 +032500 FAIL-ROUTINE. ST1364.2 +032600 IF COMPUTED-X NOT EQUAL TO SPACE ST1364.2 +032700 GO TO FAIL-ROUTINE-WRITE. ST1364.2 +032800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1364.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1364.2 +033000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1364.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1364.2 +033300 GO TO FAIL-ROUTINE-EX. ST1364.2 +033400 FAIL-ROUTINE-WRITE. ST1364.2 +033500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1364.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1364.2 +033700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1364.2 +033800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1364.2 +033900 FAIL-ROUTINE-EX. EXIT. ST1364.2 +034000 BAIL-OUT. ST1364.2 +034100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1364.2 +034200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1364.2 +034300 BAIL-OUT-WRITE. ST1364.2 +034400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1364.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1364.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1364.2 +034800 BAIL-OUT-EX. EXIT. ST1364.2 +034900 CCVS1-EXIT. ST1364.2 +035000 EXIT. ST1364.2 +035100 SORT-PARA SECTION. ST1364.2 +035200 SORT-PARAGRAPH. ST1364.2 +035300 SORT SORTFILE-2F ON ASCENDING KEY ST1364.2 +035400 SORTFILE-KEY ST1364.2 +035500 INPUT PROCEDURE INPROC ST1364.2 +035600 GIVING SORTOUT-2F. ST1364.2 +035700 GO TO SORT-TESTS. ST1364.2 +035800 INPROC SECTION. ST1364.2 +035900 INPROC-SYSIN. ST1364.2 +036000 MOVE "RELEASE FROM" TO FEATURE. ST1364.2 +036100 MOVE 10 TO UTIL-CTR. ST1364.2 +036200 SORT-TEST-1. ST1364.2 +036300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1364.2 +036400 PERFORM RELEASE-SORTFILE-REC. ST1364.2 +036500 IF WORK-REC EQUAL TO HOLD-REC ST1364.2 +036600 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1364.2 +036700 SORT-FAIL-1. ST1364.2 +036800 MOVE WORK-NON-KEY-1 TO COMPUTED-A. ST1364.2 +036900 MOVE HOLD-NON-KEY-1 TO CORRECT-A. ST1364.2 +037000 PERFORM FAIL-1. ST1364.2 +037100 PERFORM PRINT-DETAIL-1. ST1364.2 +037200 MOVE WORK-KEY TO COMPUTED-N. ST1364.2 +037300 MOVE HOLD-KEY TO CORRECT-N. ST1364.2 +037400 MOVE COMMENT-1 TO RE-MARK. ST1364.2 +037500 PERFORM PRINT-DETAIL-1. ST1364.2 +037600 MOVE WORK-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1364.2 +037700 MOVE HOLD-NON-KEY-2 TO CORRECT-BREAKDOWN. ST1364.2 +037800 MOVE FIRST-20CM TO COMPUTED-A. ST1364.2 +037900 MOVE FIRST-20CR TO CORRECT-A. ST1364.2 +038000 MOVE COMMENT-2 TO RE-MARK. ST1364.2 +038100 PERFORM PRINT-DETAIL-1. ST1364.2 +038200 MOVE SECOND-20CM TO COMPUTED-A. ST1364.2 +038300 MOVE SECOND-20CR TO CORRECT-A. ST1364.2 +038400 MOVE COMMENT-3 TO RE-MARK. ST1364.2 +038500 PERFORM PRINT-DETAIL-1. ST1364.2 +038600 MOVE THIRD-20CM TO COMPUTED-A. ST1364.2 +038700 MOVE THIRD-20CR TO CORRECT-A. ST1364.2 +038800 MOVE COMMENT-4 TO RE-MARK. ST1364.2 +038900 SORT-WRITE-1. ST1364.2 +039000 PERFORM PRINT-DETAIL-1. ST1364.2 +039100 INPROC-CONTINUE. ST1364.2 +039200 PERFORM RELEASE-SORTFILE-REC 9 TIMES. ST1364.2 +039300 GO TO INPROC-EXIT. ST1364.2 +039400 RELEASE-SORTFILE-REC. ST1364.2 +039500 MOVE ALL-A TO WORK-NON-KEY-2. ST1364.2 +039600 MOVE UTIL-CTR TO WORK-KEY. ST1364.2 +039700 MOVE "B" TO WORK-NON-KEY-1. ST1364.2 +039800 MOVE ALL-Z TO SORTFILE-NON-KEY-1. ST1364.2 +039900 MOVE -12345 TO SORTFILE-KEY. ST1364.2 +040000 MOVE ALL-X TO SORTFILE-NON-KEY-2. ST1364.2 +040100* NOTE A FALSE RECORD HAS BEEN MOVED TO SORTFILE-REC --- ST1364.2 +040200* THE RELEASE STATEMENT WHICH FOLLOWS SHOULD CLOBBER ST1364.2 +040300* IT COMPLETELY. ST1364.2 +040400 MOVE WORK-REC TO HOLD-REC. ST1364.2 +040500 RELEASE SORTFILE-REC FROM WORK-REC. ST1364.2 +040600 SUBTRACT 1 FROM UTIL-CTR. ST1364.2 +040700 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1364.2 +040800 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1364.2 +040900 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1364.2 +041000 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1364.2 +041100 MOVE "****TEST DELETED****" TO RE-MARK. ST1364.2 +041200 PRINT-DETAIL-1. ST1364.2 +041300 IF REC-CT NOT EQUAL TO ZERO ST1364.2 +041400 MOVE "." TO PARDOT-X ST1364.2 +041500 MOVE REC-CT TO DOTVALUE. ST1364.2 +041600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1364.2 +041700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1364.2 +041800 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1364.2 +041900 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1364.2 +042000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1364.2 +042100 MOVE SPACE TO CORRECT-X. ST1364.2 +042200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1364.2 +042300 MOVE SPACE TO RE-MARK. ST1364.2 +042400 WRITE-LINE-1. ST1364.2 +042500 ADD 1 TO RECORD-COUNT. ST1364.2 +042600Y IF RECORD-COUNT GREATER 50 ST1364.2 +042700Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1364.2 +042800Y MOVE SPACE TO DUMMY-RECORD ST1364.2 +042900Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1364.2 +043000Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1364.2 +043100Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1364.2 +043200Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1364.2 +043300Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1364.2 +043400Y MOVE ZERO TO RECORD-COUNT. ST1364.2 +043500 PERFORM WRT-LN-1. ST1364.2 +043600 WRT-LN-1. ST1364.2 +043700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1364.2 +043800 MOVE SPACE TO DUMMY-RECORD. ST1364.2 +043900 BLANK-LINE-PRINT-1. ST1364.2 +044000 PERFORM WRT-LN-1. ST1364.2 +044100 FAIL-ROUTINE-1. ST1364.2 +044200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1364.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1364.2 +044400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1364.2 +044500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +044600 GO TO FAIL-ROUTINE-EX-1. ST1364.2 +044700 FAIL-RTN-WRITE-1. ST1364.2 +044800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1364.2 +044900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +045000 FAIL-ROUTINE-EX-1. EXIT. ST1364.2 +045100 BAIL-OUT-1. ST1364.2 +045200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1364.2 +045300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1364.2 +045400 BAIL-OUT-WRITE-1. ST1364.2 +045500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1364.2 +045600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +045700 BAIL-OUT-EX-1. EXIT. ST1364.2 +045800 INPROC-EXIT. ST1364.2 +045900 EXIT. ST1364.2 +046000 SORT-TESTS SECTION. ST1364.2 +046100 SORT-INIT. ST1364.2 +046200 OPEN INPUT SORTOUT-2F. ST1364.2 +046300 MOVE ZERO TO UTIL-CTR. ST1364.2 +046400 SORT-TEST-2. ST1364.2 +046500 MOVE "SORT-TEST-2" TO PAR-NAME. ST1364.2 +046600 PERFORM READ-SORTOUT. ST1364.2 +046700 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +046800 GO TO SORT-FAIL-2. ST1364.2 +046900 IF SORTOUT-KEY NOT EQUAL TO 1 ST1364.2 +047000 GO TO SORT-FAIL-2. ST1364.2 +047100 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +047200 PERFORM PASS GO TO SORT-WRITE-2. ST1364.2 +047300 SORT-FAIL-2. ST1364.2 +047400 MOVE 1 TO CORRECT-N. ST1364.2 +047500 PERFORM BREAKDOWN-PARA. ST1364.2 +047600 SORT-WRITE-2. ST1364.2 +047700 PERFORM PRINT-DETAIL. ST1364.2 +047800 SORT-TEST-3. ST1364.2 +047900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1364.2 +048000 PERFORM READ-SORTOUT 6 TIMES. ST1364.2 +048100 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +048200 GO TO SORT-FAIL-3. ST1364.2 +048300 IF SORTOUT-KEY NOT EQUAL TO 7 ST1364.2 +048400 GO TO SORT-FAIL-3. ST1364.2 +048500 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +048600 PERFORM PASS GO TO SORT-WRITE-3. ST1364.2 +048700 SORT-FAIL-3. ST1364.2 +048800 MOVE 7 TO CORRECT-N. ST1364.2 +048900 PERFORM BREAKDOWN-PARA. ST1364.2 +049000 SORT-WRITE-3. ST1364.2 +049100 PERFORM PRINT-DETAIL. ST1364.2 +049200 SORT-TEST-4. ST1364.2 +049300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1364.2 +049400 PERFORM READ-SORTOUT 3 TIMES. ST1364.2 +049500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +049600 GO TO SORT-FAIL-4. ST1364.2 +049700 IF SORTOUT-KEY NOT EQUAL TO 10 ST1364.2 +049800 GO TO SORT-FAIL-4. ST1364.2 +049900 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +050000 PERFORM PASS GO TO SORT-WRITE-4. ST1364.2 +050100 SORT-FAIL-4. ST1364.2 +050200 MOVE 10 TO CORRECT-N. ST1364.2 +050300 PERFORM BREAKDOWN-PARA. ST1364.2 +050400 SORT-WRITE-4. ST1364.2 +050500 PERFORM PRINT-DETAIL. ST1364.2 +050600 SORT-TEST-5. ST1364.2 +050700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1364.2 +050800 READ SORTOUT-2F AT END ST1364.2 +050900 PERFORM PASS GO TO SORT-WRITE-5. ST1364.2 +051000 SORT-FAIL-5. ST1364.2 +051100 MOVE SPACE TO ALL-A. ST1364.2 +051200 MOVE SPACE TO LITERAL-B ST1364.2 +051300 PERFORM BREAKDOWN-PARA. ST1364.2 +051400 PERFORM PRINT-DETAIL. ST1364.2 +051500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1364.2 +051600 SORT-WRITE-5. ST1364.2 +051700 PERFORM PRINT-DETAIL. ST1364.2 +051800 CLOSE-SORT-FILES. ST1364.2 +051900 CLOSE SORTOUT-2F. ST1364.2 +052000 GO TO CCVS-EXIT. ST1364.2 +052100 BREAKDOWN-PARA. ST1364.2 +052200 MOVE SORTOUT-KEY TO COMPUTED-N. ST1364.2 +052300 MOVE COMMENT-1 TO RE-MARK. ST1364.2 +052400 PERFORM FAIL. ST1364.2 +052500 PERFORM PRINT-DETAIL. ST1364.2 +052600 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-A. ST1364.2 +052700 MOVE LITERAL-B TO CORRECT-A. ST1364.2 +052800 PERFORM PRINT-DETAIL. ST1364.2 +052900 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1364.2 +053000 MOVE FIRST-20CM TO COMPUTED-A. ST1364.2 +053100 MOVE ALL-A TO CORRECT-A. ST1364.2 +053200 MOVE COMMENT-2 TO RE-MARK. ST1364.2 +053300 PERFORM PRINT-DETAIL. ST1364.2 +053400 MOVE SECOND-20CM TO COMPUTED-A. ST1364.2 +053500 MOVE ALL-A TO CORRECT-A. ST1364.2 +053600 MOVE COMMENT-3 TO RE-MARK. ST1364.2 +053700 PERFORM PRINT-DETAIL. ST1364.2 +053800 MOVE THIRD-20CM TO COMPUTED-A. ST1364.2 +053900 MOVE ALL-A TO CORRECT-A. ST1364.2 +054000 MOVE COMMENT-4 TO RE-MARK. ST1364.2 +054100 READ-SORTOUT. ST1364.2 +054200 READ SORTOUT-2F AT END GO TO READ-ERROR. ST1364.2 +054300 ADD 1 TO UTIL-CTR. ST1364.2 +054400 READ-ERROR. ST1364.2 +054500 MOVE UTIL-CTR TO COMPUTED-N. ST1364.2 +054600 MOVE 10 TO CORRECT-N. ST1364.2 +054700 MOVE "TOO FEW RECORDS IN FILE" TO RE-MARK. ST1364.2 +054800 PERFORM FAIL. ST1364.2 +054900 MOVE "READ-ERROR" TO PAR-NAME ST1364.2 +055000 PERFORM PRINT-DETAIL. ST1364.2 +055100 GO TO CLOSE-SORT-FILES. ST1364.2 +055200 CCVS-EXIT SECTION. ST1364.2 +055300 CCVS-999999. ST1364.2 +055400 GO TO CLOSE-FILES. ST1364.2 +*END-OF,ST136A +*HEADER,COBOL,ST137A +000100 IDENTIFICATION DIVISION. ST1374.2 +000200 PROGRAM-ID. ST1374.2 +000300 ST137A. ST1374.2 +000400**************************************************************** ST1374.2 +000500* * ST1374.2 +000600* VALIDATION FOR:- * ST1374.2 +000700* * ST1374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +000900* * ST1374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1374.2 +001100* * ST1374.2 +001200**************************************************************** ST1374.2 +001300* OBJECTIVE - ST1374.2 +001400* ROUTINE ST207 IS A TEST OF THE SORT STATEMENT USING ST1374.2 +001500* VARIABLE LENGTH RECORDS WHICH CONTAIN ODO (OCCURS DEPENDING ST1374.2 +001600* ON) CLAUSES IN THEIR RECORD DESCRIPTIONS. ST1374.2 +001700* ST1374.2 +001800* ST1374.2 +001900* FEATURES TESTED - ST1374.2 +002000* * COLLATING SEQUENCE IS NATIVE. NO COLLATING SEQUENCE ST1374.2 +002100* STATEMENT IS USED IN THE ACTUAL SORT STATEMENT. ST1374.2 +002200* * VARIABLE LENGTH RECORDS ST1374.2 +002300* * OCCURS DEPENDING ON CLAUSES ST1374.2 +002400* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1374.2 +002500* ST1374.2 +002600* * SORT SORT-FILE-NAME ST1374.2 +002700* ON ASCENDING KEY KEY-1 OF DATA-NAME-1 ST1374.2 +002800* ASCENDING KEY-2 OF DATA-NAME-2 ST1374.2 +002900* USING FILE-NAME-1 ST1374.2 +003000* GIVING FILE-NAME-2. ST1374.2 +003100* ST1374.2 +003200* ST1374.2 +003300* ANSI X3.23-1974 REFERENCES - ST1374.2 +003400* * SECTION 2.1 OCCURS DEPENDING ON PAGE III-2 ST1374.2 +003500* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1374.2 +003600* ST1374.2 +003700* ST1374.2 +003800* FILES USED - ST1374.2 +003900* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1374.2 +004000* ARE FIRST CREATED BY ROUTINE ST207. THE FIRST FILE (SQ-FS1) ST1374.2 +004100* IS THEN SORTED GIVING THE SECOND FILE (SQ-FS2). ST1374.2 +004200* ST1374.2 +004300* SQ-FS1 - ST1374.2 +004400* 51 RECORDS ST1374.2 +004500* VARIABLE LENGTH RECORDS (148 TO 1435 CHARACTERS) USING ODO ST1374.2 +004600* BLOCKED 1 ST1374.2 +004700* RESERVE 2 AREAS ST1374.2 +004800* ST1374.2 +004900* SQ-FS2 - ST1374.2 +005000* 51 RECORDS ST1374.2 +005100* VARIABLE LENGTH RECORDS FORMAT WITH ODO BUT ACTUALLY ALL ST1374.2 +005200* RECORDS ARE FIXED LENGTH 148 CHARACTERS. ST1374.2 +005300* BLOCKED 2 ST1374.2 +005400* RESERVE 4 AREAS ST1374.2 +005500* ST1374.2 +005600* NOTE THAT SQ-FS2 IS OVERWRITTEN AS A RESULT OF THE SORT ST1374.2 +005700* AND SHOULD CONTAIN A FINAL TOTAL OF 51 RECORDS. ST1374.2 +005800* ST1374.2 +005900* ST1374.2 +006000* X-CARDS USED - ST1374.2 +006100* X-XXX014 SQ-FS1 ST1374.2 +006200* X-XXX015 SQ-FS2 ST1374.2 +006300* X-XXX027 SORT FILE ST-FS1 ST1374.2 +006400* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER (NOTE ST1374.2 +006500* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-63 ST1374.2 +006600* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1374.2 +006700* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1374.2 +006800* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1374.2 +006900* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-63 CARD..... ST1374.2 +007000* ST1374.2 +007100* X-63 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1374.2 +007200* ST1374.2 +007300* ST1374.2 +007400* OPTIONS RECOMMENDED - ST1374.2 +007500* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1374.2 +007600* FILES AS THEY ARE CREATED AND READ DURING ST1374.2 +007700* TESTS 3 THRU 6. ST1374.2 +007800* ST1374.2 +007900* ST1374.2 +008000* TEST DESCRIPTIONS - ST1374.2 +008100* SRT-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1374.2 +008200* SRT-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1374.2 +008300* SRT-TEST-003 TESTS RECORDS 1-20 ON SORTED SQ-FS2 ST1374.2 +008400* SRT-TEST-004 TESTS RECORDS 21-40 ON SORTED SQ-FS2 ST1374.2 +008500* SRT-TEST-005 TESTS RECORDS 41-51 ON SORTED SQ-FS2 ST1374.2 +008600* SRT-TEST-006 AN EOF CHECK ON SQ-FS2 ST1374.2 +008700* ST1374.2 +008800* ST1374.2 +008900* ************************************************************ ST1374.2 +009000 ENVIRONMENT DIVISION. ST1374.2 +009100 CONFIGURATION SECTION. ST1374.2 +009200 SOURCE-COMPUTER. ST1374.2 +009300 XXXXX082. ST1374.2 +009400 OBJECT-COMPUTER. ST1374.2 +009500 XXXXX083. ST1374.2 +009600 INPUT-OUTPUT SECTION. ST1374.2 +009700 FILE-CONTROL. ST1374.2 +009800 SELECT PRINT-FILE ASSIGN TO ST1374.2 +009900 XXXXX055. ST1374.2 +010000 SELECT SQ-FS1 ASSIGN TO ST1374.2 +010100 XXXXX014 ST1374.2 +010200 ORGANIZATION IS SEQUENTIAL ST1374.2 +010300 ACCESS MODE IS SEQUENTIAL ST1374.2 +010400 RESERVE 2 AREAS. ST1374.2 +010500 SELECT SQ-FS2 ASSIGN TO ST1374.2 +010600 XXXXX015 ST1374.2 +010700 ORGANIZATION IS SEQUENTIAL ST1374.2 +010800 ACCESS MODE IS SEQUENTIAL ST1374.2 +010900 RESERVE 4 AREAS. ST1374.2 +011000 SELECT ST-FS1 ASSIGN TO ST1374.2 +011100 XXXXX027. ST1374.2 +011200 DATA DIVISION. ST1374.2 +011300 FILE SECTION. ST1374.2 +011400 FD PRINT-FILE. ST1374.2 +011500 01 PRINT-REC PICTURE X(120). ST1374.2 +011600 01 DUMMY-RECORD PICTURE X(120). ST1374.2 +011700 FD SQ-FS1 ST1374.2 +011800 LABEL RECORDS STANDARD ST1374.2 +011900C VALUE OF ST1374.2 +012000C XXXXX074 ST1374.2 +012100C IS ST1374.2 +012200C XXXXX075 ST1374.2 +012300G XXXXX069 ST1374.2 +012400 BLOCK CONTAINS 1 RECORDS ST1374.2 +012500 RECORD CONTAINS 148 TO 1435 CHARACTERS. ST1374.2 +012600 01 SQ-FS1R1-F-G-132. ST1374.2 +012700 10 REC-PREAMBLE PIC X(120). ST1374.2 +012800 10 REST-OF-1. ST1374.2 +012900 20 LENGTH-1 PIC 999. ST1374.2 +013000 20 KEY-1. ST1374.2 +013100 30 ALPHAN-KEY PIC X. ST1374.2 +013200 30 NUM-KEY PIC 999. ST1374.2 +013300 20 KEY-2. ST1374.2 +013400 30 ALPHAN-KEY PIC X. ST1374.2 +013500 30 NUM-KEY PIC 999. ST1374.2 +013600 20 KEY-3. ST1374.2 +013700 30 ALPHAN-KEY PIC X. ST1374.2 +013800 30 NUM-KEY PIC 999. ST1374.2 +013900 20 STUFF-1 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-1. ST1374.2 +014000 30 FILLER PIC X(13). ST1374.2 +014100 FD SQ-FS2 ST1374.2 +014200 LABEL RECORDS STANDARD ST1374.2 +014300C VALUE OF ST1374.2 +014400C XXXXX074 ST1374.2 +014500C IS ST1374.2 +014600C XXXXX076 ST1374.2 +014700G XXXXX069 ST1374.2 +014800 BLOCK CONTAINS 2 RECORDS ST1374.2 +014900 RECORD CONTAINS 148 TO 1435 CHARACTERS ST1374.2 +015000 DATA RECORD SQ-FS2R1-F-G-132. ST1374.2 +015100 01 SQ-FS2R1-F-G-132. ST1374.2 +015200 10 REC-PRE-2 PIC X(120). ST1374.2 +015300 10 REST-OF-2. ST1374.2 +015400 20 LENGTH-2 PIC 999. ST1374.2 +015500 20 KEY-4. ST1374.2 +015600 30 ALPHAN-KEY PIC X. ST1374.2 +015700 30 NUM-KEY PIC 999. ST1374.2 +015800 20 KEY-5. ST1374.2 +015900 30 ALPHAN-KEY PIC X. ST1374.2 +016000 30 NUM-KEY PIC 999. ST1374.2 +016100 20 KEY-6. ST1374.2 +016200 30 ALPHAN-KEY PIC X. ST1374.2 +016300 30 NUM-KEY PIC 999. ST1374.2 +016400 20 STUFF-2 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-100. ST1374.2 +016500 30 FILLER PIC X(13). ST1374.2 +016600 SD ST-FS1 ST1374.2 +016700 RECORD CONTAINS 148 TO 1435 CHARACTERS ST1374.2 +016800 DATA RECORD IS ST-FS1R1-F-G-132. ST1374.2 +016900 01 ST-FS1R1-F-G-132. ST1374.2 +017000 02 FILLER PIC X(120). ST1374.2 +017100 02 LENGTH-3 PIC 999. ST1374.2 +017200 02 NON-KEY-1. ST1374.2 +017300 03 A-KEY PIC X. ST1374.2 +017400 03 N-KEY PIC 999. ST1374.2 +017500 02 SORT-KEY. ST1374.2 +017600 03 A-KEY PIC X. ST1374.2 +017700 03 N-KEY PIC 999. ST1374.2 +017800 02 NON-KEY-2. ST1374.2 +017900 03 A-KEY PIC X. ST1374.2 +018000 03 N-KEY PIC 999. ST1374.2 +018100 02 STUFF-3 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-100. ST1374.2 +018200 03 FILLER PIC X(13). ST1374.2 +018300 WORKING-STORAGE SECTION. ST1374.2 +018400 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1374.2 +018500 77 WRK-DU-999-0001 PIC 999. ST1374.2 +018600 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1374.2 +018700 77 WRK-DU-999-0002 PIC 999 VALUE 0. ST1374.2 +018800 77 LENGTH-100 PIC 999 VALUE 100. ST1374.2 +018900 01 WRK-XN-0001 PIC X(51) VALUE ST1374.2 +019000 "/A.Z-B,Y+C*X)D(W$E$V F0U1G2T3H4S5I6R7J8Q9K;PMN". ST1374.2 +019100 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1374.2 +019200 02 CHAR PIC X OCCURS 51 TIMES. ST1374.2 +019300 01 WRK-XN-2 PIC X(51) VALUE ST1374.2 +019400 XXXXX063. ST1374.2 +019500 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1374.2 +019600 02 ASCIIS PIC X OCCURS 51 TIMES. ST1374.2 +019700 01 WRK-XN-O020F-0001. ST1374.2 +019800 02 COMPU PIC X OCCURS 20 TIMES. ST1374.2 +019900 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1374.2 +020000 02 FILLER PIC X(20). ST1374.2 +020100 01 WRK-XN-O120F-1. ST1374.2 +020200 02 COLLS PIC X OCCURS 120 TIMES. ST1374.2 +020300 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1374.2 +020400 02 WRK-XN-0002 PIC X(20). ST1374.2 +020500 02 WRK-XN-0003 PIC X(20). ST1374.2 +020600 02 WRK-XN-0004 PIC X(20). ST1374.2 +020700 02 WRK-XN-0005 PIC X(20). ST1374.2 +020800 02 WRK-XN-0006 PIC X(20). ST1374.2 +020900 02 WRK-XN-0007 PIC X(20). ST1374.2 +021000 01 FILE-RECORD-INFORMATION-REC. ST1374.2 +021100 03 FILE-RECORD-INFO-SKELETON. ST1374.2 +021200 05 FILLER PICTURE X(48) VALUE ST1374.2 +021300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1374.2 +021400 05 FILLER PICTURE X(46) VALUE ST1374.2 +021500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1374.2 +021600 05 FILLER PICTURE X(26) VALUE ST1374.2 +021700 ",LFIL=000000,ORG= ,LBLR= ". ST1374.2 +021800 05 FILLER PICTURE X(37) VALUE ST1374.2 +021900 ",RECKEY= ". ST1374.2 +022000 05 FILLER PICTURE X(38) VALUE ST1374.2 +022100 ",ALTKEY1= ". ST1374.2 +022200 05 FILLER PICTURE X(38) VALUE ST1374.2 +022300 ",ALTKEY2= ". ST1374.2 +022400 05 FILLER PICTURE X(7) VALUE SPACE.ST1374.2 +022500 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1374.2 +022600 05 FILE-RECORD-INFO-P1-120. ST1374.2 +022700 07 FILLER PIC X(5). ST1374.2 +022800 07 XFILE-NAME PIC X(6). ST1374.2 +022900 07 FILLER PIC X(8). ST1374.2 +023000 07 XRECORD-NAME PIC X(6). ST1374.2 +023100 07 FILLER PIC X(1). ST1374.2 +023200 07 REELUNIT-NUMBER PIC 9(1). ST1374.2 +023300 07 FILLER PIC X(7). ST1374.2 +023400 07 XRECORD-NUMBER PIC 9(6). ST1374.2 +023500 07 FILLER PIC X(6). ST1374.2 +023600 07 UPDATE-NUMBER PIC 9(2). ST1374.2 +023700 07 FILLER PIC X(5). ST1374.2 +023800 07 ODO-NUMBER PIC 9(4). ST1374.2 +023900 07 FILLER PIC X(5). ST1374.2 +024000 07 XPROGRAM-NAME PIC X(5). ST1374.2 +024100 07 FILLER PIC X(7). ST1374.2 +024200 07 XRECORD-LENGTH PIC 9(6). ST1374.2 +024300 07 FILLER PIC X(7). ST1374.2 +024400 07 CHARS-OR-RECORDS PIC X(2). ST1374.2 +024500 07 FILLER PIC X(1). ST1374.2 +024600 07 XBLOCK-SIZE PIC 9(4). ST1374.2 +024700 07 FILLER PIC X(6). ST1374.2 +024800 07 RECORDS-IN-FILE PIC 9(6). ST1374.2 +024900 07 FILLER PIC X(5). ST1374.2 +025000 07 XFILE-ORGANIZATION PIC X(2). ST1374.2 +025100 07 FILLER PIC X(6). ST1374.2 +025200 07 XLABEL-TYPE PIC X(1). ST1374.2 +025300 05 FILE-RECORD-INFO-P121-240. ST1374.2 +025400 07 FILLER PIC X(8). ST1374.2 +025500 07 XRECORD-KEY PIC X(29). ST1374.2 +025600 07 FILLER PIC X(9). ST1374.2 +025700 07 ALTERNATE-KEY1 PIC X(29). ST1374.2 +025800 07 FILLER PIC X(9). ST1374.2 +025900 07 ALTERNATE-KEY2 PIC X(29). ST1374.2 +026000 07 FILLER PIC X(7). ST1374.2 +026100 01 TEST-RESULTS. ST1374.2 +026200 02 FILLER PIC X VALUE SPACE. ST1374.2 +026300 02 FEATURE PIC X(20) VALUE SPACE. ST1374.2 +026400 02 FILLER PIC X VALUE SPACE. ST1374.2 +026500 02 P-OR-F PIC X(5) VALUE SPACE. ST1374.2 +026600 02 FILLER PIC X VALUE SPACE. ST1374.2 +026700 02 PAR-NAME. ST1374.2 +026800 03 FILLER PIC X(19) VALUE SPACE. ST1374.2 +026900 03 PARDOT-X PIC X VALUE SPACE. ST1374.2 +027000 03 DOTVALUE PIC 99 VALUE ZERO. ST1374.2 +027100 02 FILLER PIC X(8) VALUE SPACE. ST1374.2 +027200 02 RE-MARK PIC X(61). ST1374.2 +027300 01 TEST-COMPUTED. ST1374.2 +027400 02 FILLER PIC X(30) VALUE SPACE. ST1374.2 +027500 02 FILLER PIC X(17) VALUE ST1374.2 +027600 " COMPUTED=". ST1374.2 +027700 02 COMPUTED-X. ST1374.2 +027800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1374.2 +027900 03 COMPUTED-N REDEFINES COMPUTED-A ST1374.2 +028000 PIC -9(9).9(9). ST1374.2 +028100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1374.2 +028200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1374.2 +028300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1374.2 +028400 03 CM-18V0 REDEFINES COMPUTED-A. ST1374.2 +028500 04 COMPUTED-18V0 PIC -9(18). ST1374.2 +028600 04 FILLER PIC X. ST1374.2 +028700 03 FILLER PIC X(50) VALUE SPACE. ST1374.2 +028800 01 TEST-CORRECT. ST1374.2 +028900 02 FILLER PIC X(30) VALUE SPACE. ST1374.2 +029000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1374.2 +029100 02 CORRECT-X. ST1374.2 +029200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1374.2 +029300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1374.2 +029400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1374.2 +029500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1374.2 +029600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1374.2 +029700 03 CR-18V0 REDEFINES CORRECT-A. ST1374.2 +029800 04 CORRECT-18V0 PIC -9(18). ST1374.2 +029900 04 FILLER PIC X. ST1374.2 +030000 03 FILLER PIC X(2) VALUE SPACE. ST1374.2 +030100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1374.2 +030200 01 CCVS-C-1. ST1374.2 +030300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1374.2 +030400- "SS PARAGRAPH-NAME ST1374.2 +030500- " REMARKS". ST1374.2 +030600 02 FILLER PIC X(20) VALUE SPACE. ST1374.2 +030700 01 CCVS-C-2. ST1374.2 +030800 02 FILLER PIC X VALUE SPACE. ST1374.2 +030900 02 FILLER PIC X(6) VALUE "TESTED". ST1374.2 +031000 02 FILLER PIC X(15) VALUE SPACE. ST1374.2 +031100 02 FILLER PIC X(4) VALUE "FAIL". ST1374.2 +031200 02 FILLER PIC X(94) VALUE SPACE. ST1374.2 +031300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1374.2 +031400 01 REC-CT PIC 99 VALUE ZERO. ST1374.2 +031500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1374.2 +032000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1374.2 +032100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1374.2 +032200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1374.2 +032300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1374.2 +032400 01 CCVS-H-1. ST1374.2 +032500 02 FILLER PIC X(39) VALUE SPACES. ST1374.2 +032600 02 FILLER PIC X(42) VALUE ST1374.2 +032700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1374.2 +032800 02 FILLER PIC X(39) VALUE SPACES. ST1374.2 +032900 01 CCVS-H-2A. ST1374.2 +033000 02 FILLER PIC X(40) VALUE SPACE. ST1374.2 +033100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1374.2 +033200 02 FILLER PIC XXXX VALUE ST1374.2 +033300 "4.2 ". ST1374.2 +033400 02 FILLER PIC X(28) VALUE ST1374.2 +033500 " COPY - NOT FOR DISTRIBUTION". ST1374.2 +033600 02 FILLER PIC X(41) VALUE SPACE. ST1374.2 +033700 ST1374.2 +033800 01 CCVS-H-2B. ST1374.2 +033900 02 FILLER PIC X(15) VALUE ST1374.2 +034000 "TEST RESULT OF ". ST1374.2 +034100 02 TEST-ID PIC X(9). ST1374.2 +034200 02 FILLER PIC X(4) VALUE ST1374.2 +034300 " IN ". ST1374.2 +034400 02 FILLER PIC X(12) VALUE ST1374.2 +034500 " HIGH ". ST1374.2 +034600 02 FILLER PIC X(22) VALUE ST1374.2 +034700 " LEVEL VALIDATION FOR ". ST1374.2 +034800 02 FILLER PIC X(58) VALUE ST1374.2 +034900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +035000 01 CCVS-H-3. ST1374.2 +035100 02 FILLER PIC X(34) VALUE ST1374.2 +035200 " FOR OFFICIAL USE ONLY ". ST1374.2 +035300 02 FILLER PIC X(58) VALUE ST1374.2 +035400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1374.2 +035500 02 FILLER PIC X(28) VALUE ST1374.2 +035600 " COPYRIGHT 1985 ". ST1374.2 +035700 01 CCVS-E-1. ST1374.2 +035800 02 FILLER PIC X(52) VALUE SPACE. ST1374.2 +035900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1374.2 +036000 02 ID-AGAIN PIC X(9). ST1374.2 +036100 02 FILLER PIC X(45) VALUE SPACES. ST1374.2 +036200 01 CCVS-E-2. ST1374.2 +036300 02 FILLER PIC X(31) VALUE SPACE. ST1374.2 +036400 02 FILLER PIC X(21) VALUE SPACE. ST1374.2 +036500 02 CCVS-E-2-2. ST1374.2 +036600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1374.2 +036700 03 FILLER PIC X VALUE SPACE. ST1374.2 +036800 03 ENDER-DESC PIC X(44) VALUE ST1374.2 +036900 "ERRORS ENCOUNTERED". ST1374.2 +037000 01 CCVS-E-3. ST1374.2 +037100 02 FILLER PIC X(22) VALUE ST1374.2 +037200 " FOR OFFICIAL USE ONLY". ST1374.2 +037300 02 FILLER PIC X(12) VALUE SPACE. ST1374.2 +037400 02 FILLER PIC X(58) VALUE ST1374.2 +037500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +037600 02 FILLER PIC X(13) VALUE SPACE. ST1374.2 +037700 02 FILLER PIC X(15) VALUE ST1374.2 +037800 " COPYRIGHT 1985". ST1374.2 +037900 01 CCVS-E-4. ST1374.2 +038000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1374.2 +038100 02 FILLER PIC X(4) VALUE " OF ". ST1374.2 +038200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1374.2 +038300 02 FILLER PIC X(40) VALUE ST1374.2 +038400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1374.2 +038500 01 XXINFO. ST1374.2 +038600 02 FILLER PIC X(19) VALUE ST1374.2 +038700 "*** INFORMATION ***". ST1374.2 +038800 02 INFO-TEXT. ST1374.2 +038900 04 FILLER PIC X(8) VALUE SPACE. ST1374.2 +039000 04 XXCOMPUTED PIC X(20). ST1374.2 +039100 04 FILLER PIC X(5) VALUE SPACE. ST1374.2 +039200 04 XXCORRECT PIC X(20). ST1374.2 +039300 02 INF-ANSI-REFERENCE PIC X(48). ST1374.2 +039400 01 HYPHEN-LINE. ST1374.2 +039500 02 FILLER PIC IS X VALUE IS SPACE. ST1374.2 +039600 02 FILLER PIC IS X(65) VALUE IS "************************ST1374.2 +039700- "*****************************************". ST1374.2 +039800 02 FILLER PIC IS X(54) VALUE IS "************************ST1374.2 +039900- "******************************". ST1374.2 +040000 01 CCVS-PGM-ID PIC X(9) VALUE ST1374.2 +040100 "ST137A". ST1374.2 +040200 PROCEDURE DIVISION. ST1374.2 +040300 DECLARATIVES. ST1374.2 +040400 SECT-ST216-DEC SECTION. ST1374.2 +040500 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1374.2 +040600 SRT-WRITE-DEC. ST1374.2 +040700 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1374.2 +040800 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1374.2 +040900 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1374.2 +041000 STOP RUN. ST1374.2 +041100 END DECLARATIVES. ST1374.2 +041200 CCVS1 SECTION. ST1374.2 +041300 OPEN-FILES. ST1374.2 +041400 OPEN OUTPUT PRINT-FILE. ST1374.2 +041500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1374.2 +041600 MOVE SPACE TO TEST-RESULTS. ST1374.2 +041700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1374.2 +041800 MOVE ZERO TO REC-SKL-SUB. ST1374.2 +041900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1374.2 +042000 CCVS-INIT-FILE. ST1374.2 +042100 ADD 1 TO REC-SKL-SUB. ST1374.2 +042200 MOVE FILE-RECORD-INFO-SKELETON ST1374.2 +042300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1374.2 +042400 CCVS-INIT-EXIT. ST1374.2 +042500 GO TO CCVS1-EXIT. ST1374.2 +042600 CLOSE-FILES. ST1374.2 +042700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1374.2 +042800 TERMINATE-CCVS. ST1374.2 +042900S EXIT PROGRAM. ST1374.2 +043000STERMINATE-CALL. ST1374.2 +043100 STOP RUN. ST1374.2 +043200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1374.2 +043300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1374.2 +043400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1374.2 +043500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1374.2 +043600 MOVE "****TEST DELETED****" TO RE-MARK. ST1374.2 +043700 PRINT-DETAIL. ST1374.2 +043800 IF REC-CT NOT EQUAL TO ZERO ST1374.2 +043900 MOVE "." TO PARDOT-X ST1374.2 +044000 MOVE REC-CT TO DOTVALUE. ST1374.2 +044100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1374.2 +044200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1374.2 +044300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1374.2 +044400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1374.2 +044500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1374.2 +044600 MOVE SPACE TO CORRECT-X. ST1374.2 +044700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1374.2 +044800 MOVE SPACE TO RE-MARK. ST1374.2 +044900 HEAD-ROUTINE. ST1374.2 +045000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1374.2 +045300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1374.2 +045400 COLUMN-NAMES-ROUTINE. ST1374.2 +045500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +045600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +045800 END-ROUTINE. ST1374.2 +045900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1374.2 +046000 END-RTN-EXIT. ST1374.2 +046100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +046200 END-ROUTINE-1. ST1374.2 +046300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1374.2 +046400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1374.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. ST1374.2 +046600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1374.2 +046700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1374.2 +046800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1374.2 +046900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1374.2 +047000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1374.2 +047100 END-ROUTINE-12. ST1374.2 +047200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1374.2 +047300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1374.2 +047400 MOVE "NO " TO ERROR-TOTAL ST1374.2 +047500 ELSE ST1374.2 +047600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1374.2 +047700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1374.2 +047800 PERFORM WRITE-LINE. ST1374.2 +047900 END-ROUTINE-13. ST1374.2 +048000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1374.2 +048100 MOVE "NO " TO ERROR-TOTAL ELSE ST1374.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1374.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1374.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +048500 IF INSPECT-COUNTER EQUAL TO ZERO ST1374.2 +048600 MOVE "NO " TO ERROR-TOTAL ST1374.2 +048700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1374.2 +048800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1374.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +049000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +049100 WRITE-LINE. ST1374.2 +049200 ADD 1 TO RECORD-COUNT. ST1374.2 +049300Y IF RECORD-COUNT GREATER 42 ST1374.2 +049400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1374.2 +049500Y MOVE SPACE TO DUMMY-RECORD ST1374.2 +049600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1374.2 +049700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1374.2 +049800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1374.2 +049900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1374.2 +050000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1374.2 +050100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1374.2 +050500Y MOVE ZERO TO RECORD-COUNT. ST1374.2 +050600 PERFORM WRT-LN. ST1374.2 +050700 WRT-LN. ST1374.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1374.2 +050900 MOVE SPACE TO DUMMY-RECORD. ST1374.2 +051000 BLANK-LINE-PRINT. ST1374.2 +051100 PERFORM WRT-LN. ST1374.2 +051200 FAIL-ROUTINE. ST1374.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE ST1374.2 +051400 GO TO FAIL-ROUTINE-WRITE. ST1374.2 +051500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1374.2 +051600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1374.2 +051700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1374.2 +051800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1374.2 +052000 GO TO FAIL-ROUTINE-EX. ST1374.2 +052100 FAIL-ROUTINE-WRITE. ST1374.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1374.2 +052300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1374.2 +052400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1374.2 +052500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1374.2 +052600 FAIL-ROUTINE-EX. EXIT. ST1374.2 +052700 BAIL-OUT. ST1374.2 +052800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1374.2 +052900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1374.2 +053000 BAIL-OUT-WRITE. ST1374.2 +053100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1374.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1374.2 +053300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +053400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1374.2 +053500 BAIL-OUT-EX. EXIT. ST1374.2 +053600 CCVS1-EXIT. ST1374.2 +053700 EXIT. ST1374.2 +053800 SECT-ST216-0001 SECTION. ST1374.2 +053900 SRT-INIT-001. ST1374.2 +054000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1374.2 +054100 OPEN OUTPUT SQ-FS1. ST1374.2 +054200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1374.2 +054300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1374.2 +054400 MOVE ".XXX." TO XPROGRAM-NAME (1). ST1374.2 +054500 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1374.2 +054600 MOVE 0001 TO XBLOCK-SIZE (1). ST1374.2 +054700 MOVE 000051 TO RECORDS-IN-FILE (1). ST1374.2 +054800 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1374.2 +054900 MOVE "S" TO XLABEL-TYPE (1). ST1374.2 +055000 MOVE 000001 TO XRECORD-NUMBER (1). ST1374.2 +055100 MOVE SPACES TO WRK-XN-O120F-1. ST1374.2 +055200 SRT-TEST-001. ST1374.2 +055300 PERFORM SRT-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1374.2 +055400 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1374.2 +055500X MOVE SPACES TO PRINT-REC. ST1374.2 +055600X WRITE PRINT-REC. ST1374.2 +055700 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1374.2 +055800 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1374.2 +055900 ELSE ST1374.2 +056000 PERFORM PASS. ST1374.2 +056100 GO TO SRT-WRITE-001. ST1374.2 +056200 SRT-TEST-001-BUILD. ST1374.2 +056300 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1374.2 +056400 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1374.2 +056500 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1374.2 +056600 NUM-KEY OF KEY-3. ST1374.2 +056700 MULTIPLY WRK-DU-999-0001 BY 13 ST1374.2 +056800 GIVING XRECORD-LENGTH (1) ROUNDED. ST1374.2 +056900 ADD 135 TO XRECORD-LENGTH (1). ST1374.2 +057000 MOVE WRK-DU-999-0001 TO LENGTH-1. ST1374.2 +057100 PERFORM STUFF-IT VARYING WRK-DU-999-0002 ST1374.2 +057200 FROM 1 BY 1 UNTIL WRK-DU-999-0002 IS GREATER THAN ST1374.2 +057300 WRK-DU-999-0001. ST1374.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1374.2 +057500 ADD 1 TO XRECORD-NUMBER (1). ST1374.2 +057600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1374.2 +057700 ADD 1 TO WRK-DU-999-2. ST1374.2 +057800X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1374.2 +057900X WRITE PRINT-REC FROM REST-OF-1. ST1374.2 +058000X MOVE SPACES TO PRINT-REC. ST1374.2 +058100 WRITE SQ-FS1R1-F-G-132. ST1374.2 +058200 STUFF-IT. ST1374.2 +058300 MOVE WRK-DU-999-0002 TO STUFF-1 (WRK-DU-999-0002). ST1374.2 +058400 SRT-DELETE-001. ST1374.2 +058500 PERFORM DE-LETE. ST1374.2 +058600 SRT-WRITE-001. ST1374.2 +058700 MOVE "SRT-TEST-001" TO PAR-NAME. ST1374.2 +058800 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1374.2 +058900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1374.2 +059000 PERFORM PRINT-DETAIL. ST1374.2 +059100X MOVE SPACES TO PRINT-REC. ST1374.2 +059200X WRITE PRINT-REC. ST1374.2 +059300 CLOSE SQ-FS1. ST1374.2 +059400 SRT-INIT-002. ST1374.2 +059500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1374.2 +059600 OPEN OUTPUT SQ-FS2. ST1374.2 +059700 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1374.2 +059800 MOVE 000001 TO XRECORD-NUMBER (1). ST1374.2 +059900 MOVE 000148 TO XRECORD-LENGTH (1). ST1374.2 +060000 MOVE 0002 TO XBLOCK-SIZE (1). ST1374.2 +060100 SRT-TEST-002. ST1374.2 +060200 PERFORM SRT-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1374.2 +060300 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1374.2 +060400X MOVE SPACES TO PRINT-REC. ST1374.2 +060500X WRITE PRINT-REC. ST1374.2 +060600 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1374.2 +060700 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1374.2 +060800 ELSE ST1374.2 +060900 PERFORM PASS. ST1374.2 +061000 GO TO SRT-WRITE-002. ST1374.2 +061100 SRT-TEST-002-BUILD. ST1374.2 +061200 MOVE 100 TO LENGTH-2. ST1374.2 +061300 MOVE SPACES TO STUFF-2 (1). ST1374.2 +061400 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1374.2 +061500 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1374.2 +061600 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1374.2 +061700 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1374.2 +061800 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1374.2 +061900 ADD 000001 TO XRECORD-NUMBER (1). ST1374.2 +062000X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1374.2 +062100X WRITE PRINT-REC FROM REST-OF-2. ST1374.2 +062200X MOVE SPACES TO PRINT-REC. ST1374.2 +062300 WRITE SQ-FS2R1-F-G-132. ST1374.2 +062400 SRT-DELETE-002. ST1374.2 +062500 PERFORM DE-LETE. ST1374.2 +062600 SRT-WRITE-002. ST1374.2 +062700 MOVE "SRT-TEST-002" TO PAR-NAME. ST1374.2 +062800 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1374.2 +062900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1374.2 +063000 PERFORM PRINT-DETAIL. ST1374.2 +063100X MOVE SPACES TO PRINT-REC. ST1374.2 +063200X WRITE PRINT-REC. ST1374.2 +063300 CLOSE SQ-FS2. ST1374.2 +063400 SRT-INIT-003. ST1374.2 +063500 MOVE 100 TO LENGTH-100. ST1374.2 +063600 SORT ST-FS1 ST1374.2 +063700 ON ASCENDING KEY A-KEY OF SORT-KEY ST1374.2 +063800 ASCENDING N-KEY OF NON-KEY-2 ST1374.2 +063900 USING SQ-FS1 ST1374.2 +064000 GIVING SQ-FS2. ST1374.2 +064100 SRT-TEST-003. ST1374.2 +064200 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +064300 OPEN INPUT SQ-FS2. ST1374.2 +064400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +064500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1374.2 +064600X MOVE SPACES TO PRINT-REC. ST1374.2 +064700X WRITE PRINT-REC. ST1374.2 +064800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1374.2 +064900 PERFORM FAIL GO TO SRT-FAIL-003 ST1374.2 +065000 ELSE ST1374.2 +065100 PERFORM PASS. ST1374.2 +065200 GO TO SRT-WRITE-003. ST1374.2 +065300 SRT-DELETE-003. ST1374.2 +065400 PERFORM DE-LETE. ST1374.2 +065500 GO TO SRT-WRITE-003. ST1374.2 +065600 SRT-FAIL-003. ST1374.2 +065700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +065800 MOVE WRK-XN-0002 TO CORRECT-A. ST1374.2 +065900 SRT-WRITE-003. ST1374.2 +066000 MOVE "SRT-TEST-003" TO PAR-NAME. ST1374.2 +066100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +066200 PERFORM PRINT-DETAIL. ST1374.2 +066300X MOVE SPACES TO PRINT-REC. ST1374.2 +066400X WRITE PRINT-REC. ST1374.2 +066500 SRT-INIT-004. ST1374.2 +066600 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +066700 SRT-TEST-004. ST1374.2 +066800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +066900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1374.2 +067000X MOVE SPACES TO PRINT-REC. ST1374.2 +067100X WRITE PRINT-REC. ST1374.2 +067200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1374.2 +067300 PERFORM FAIL GO TO SRT-FAIL-004 ST1374.2 +067400 ELSE ST1374.2 +067500 PERFORM PASS. ST1374.2 +067600 GO TO SRT-WRITE-004. ST1374.2 +067700 SRT-DELETE-004. ST1374.2 +067800 PERFORM DE-LETE. ST1374.2 +067900 GO TO SRT-WRITE-004. ST1374.2 +068000 SRT-FAIL-004. ST1374.2 +068100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +068200 MOVE WRK-XN-0003 TO CORRECT-A. ST1374.2 +068300 SRT-WRITE-004. ST1374.2 +068400 MOVE "SRT-TEST-004" TO PAR-NAME. ST1374.2 +068500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +068600 PERFORM PRINT-DETAIL. ST1374.2 +068700X MOVE SPACES TO PRINT-REC. ST1374.2 +068800X WRITE PRINT-REC. ST1374.2 +068900 SRT-INIT-005. ST1374.2 +069000 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +069100 SRT-TEST-005. ST1374.2 +069200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +069300 UNTIL WRK-DU-999-0001 IS GREATER THAN 11. ST1374.2 +069400X MOVE SPACES TO PRINT-REC. ST1374.2 +069500X WRITE PRINT-REC. ST1374.2 +069600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1374.2 +069700 PERFORM FAIL GO TO SRT-FAIL-005 ST1374.2 +069800 ELSE ST1374.2 +069900 PERFORM PASS. ST1374.2 +070000 GO TO SRT-WRITE-005. ST1374.2 +070100 SRT-DELETE-005. ST1374.2 +070200 PERFORM DE-LETE. ST1374.2 +070300 GO TO SRT-WRITE-005. ST1374.2 +070400 SRT-FAIL-005. ST1374.2 +070500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +070600 MOVE WRK-XN-0004 TO CORRECT-A. ST1374.2 +070700 SRT-WRITE-005. ST1374.2 +070800 MOVE "SRT-TEST-005" TO PAR-NAME. ST1374.2 +070900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +071000 PERFORM PRINT-DETAIL. ST1374.2 +071100 SRT-TEST-006. ST1374.2 +071200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1374.2 +071300 GO TO SRT-FAIL-006. ST1374.2 +071400 READ SQ-FS2 AT END PERFORM PASS ST1374.2 +071500 GO TO SRT-WRITE-006. ST1374.2 +071600 GO TO SRT-FAIL-006. ST1374.2 +071700 SRT-DELETE-006. ST1374.2 +071800 PERFORM DE-LETE. ST1374.2 +071900 SRT-FAIL-006. ST1374.2 +072000 MOVE "EOF NOT FOUND" TO RE-MARK. ST1374.2 +072100 PERFORM FAIL . ST1374.2 +072200 SRT-WRITE-006. ST1374.2 +072300 MOVE "EOF CHECK SQ-FS2" TO FEATURE. ST1374.2 +072400 MOVE "SRT-TEST-006" TO PAR-NAME. ST1374.2 +072500 PERFORM PRINT-DETAIL. ST1374.2 +072600 CLOSE SQ-FS2. ST1374.2 +072700 GO TO CCVS-999999. ST1374.2 +072800 READ-SQ-FS1 SECTION. ST1374.2 +072900 RD-1. ST1374.2 +073000 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1374.2 +073100 GO TO R1-EXIT. ST1374.2 +073200 READ SQ-FS2 AT END GO TO PREMATURE-EOF. ST1374.2 +073300X MOVE LENGTH-2 TO LENGTH-100. ST1374.2 +073400X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1374.2 +073500X WRITE PRINT-REC FROM REST-OF-2. ST1374.2 +073600X MOVE 100 TO LENGTH-100. ST1374.2 +073700X MOVE SPACES TO PRINT-REC. ST1374.2 +073800 MOVE ALPHAN-KEY OF KEY-6 TO COMPU (WRK-DU-999-0001). ST1374.2 +073900 GO TO R1-EXIT. ST1374.2 +074000 PREMATURE-EOF. ST1374.2 +074100 MOVE 1 TO WRK-DU-9-0001. ST1374.2 +074200 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1374.2 +074300 R1-EXIT. ST1374.2 +074400 EXIT. ST1374.2 +074500 CCVS-EXIT SECTION. ST1374.2 +074600 CCVS-999999. ST1374.2 +074700 GO TO CLOSE-FILES. ST1374.2 +*END-OF,ST137A +*HEADER,COBOL,ST139A +000100 IDENTIFICATION DIVISION. ST1394.2 +000200 PROGRAM-ID. ST1394.2 +000300 ST139A. ST1394.2 +000400**************************************************************** ST1394.2 +000500* * ST1394.2 +000600* VALIDATION FOR:- * ST1394.2 +000700* * ST1394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +000900* * ST1394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1394.2 +001100* * ST1394.2 +001200**************************************************************** ST1394.2 +001300* ST1394.2 +001400* OBJECTIVE - ST1394.2 +001500* ROUTINE ST209 IS A TEST OF THE MERGE STATEMENT USING ST1394.2 +001600* THE ASCII COLLATING SEQUENCE AND FIXED LENGTH RECORDS. ST1394.2 +001700* ST1394.2 +001800* TWO FILES ARE FIRST CREATED BY THE ROUTINE IN ASCENDING ST1394.2 +001900* ASCII ORDER. THE ALPHABET NAME CLAUSE AND MERGE STATEMENT ST1394.2 +002000* WITH THE COLLATING SEQUENCE PHRASE ARE USED TO TEST THE ST1394.2 +002100* ABILITY OF THE COMPILER TO MERGE THE TWO FILES INTO A THIRD ST1394.2 +002200* FILE IN ASCENDING ASCII ORDER. ST1394.2 +002300* ST1394.2 +002400* ST1394.2 +002500* FEATURES TESTED - ST1394.2 +002600* * ALPHABET-NAME IS STANDARD-1 (THE ASCII COLLATING SEQ.) ST1394.2 +002700* * COLLATING SEQUENCE IS ALPHABET-NAME ST1394.2 +002800* * FIXED LENGTH RECORDS ST1394.2 +002900* * SAME SORT-MERGE AREA IN THE I-O-CONTROL PARAGRAPH ST1394.2 +003000* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1394.2 +003100* * USING FILE-NAME SERIES ST1394.2 +003200* ST1394.2 +003300* * MERGE MERGE-FILE-NAME ST1394.2 +003400* ASCENDING KEY-1 OF DATA-NAME-1 ST1394.2 +003500* ON ASCENDING KEY KEY-2 OF DATA-NAME-2 ST1394.2 +003600* SEQUENCE ALPHABET-ASCII-NAME ST1394.2 +003700* USING FILE-NAME-2 FILE-NAME-1 ST1394.2 +003800* GIVING FILE-NAME-3. ST1394.2 +003900* ST1394.2 +004000* ST1394.2 +004100* FILES USED - ST1394.2 +004200* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1394.2 +004300* ARE FIRST CREATED BY ROUTINE ST209. THE MERGE STATEMENT ST1394.2 +004400* USES BOTH OF THE FILES AND CREATES A THIRD FILE SQ-FS3. ST1394.2 +004500* ST1394.2 +004600* SQ-FS1 ST1394.2 +004700* 51 RECORDS ST1394.2 +004800* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +004900* BLOCKED 1 ST1394.2 +005000* RESERVE 2 AREAS ST1394.2 +005100* ST1394.2 +005200* SQ-FS2 ST1394.2 +005300* 51 RECORDS ST1394.2 +005400* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +005500* BLOCKED 2 ST1394.2 +005600* RESERVE 4 AREAS ST1394.2 +005700* ST1394.2 +005800* SQ-FS3 ST1394.2 +005900* FINAL TOTAL OF 102 RECORDS ST1394.2 +006000* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +006100* BLOCKED 3 ST1394.2 +006200* RESERVE 4 AREAS ST1394.2 +006300* ST1394.2 +006400* NOTE THAT SQ-FS3 IS THE RESULT OF MERGING SQ-FS1 AND ST1394.2 +006500* SQ-FS2. THE RECORDS IN SQ-FS3 SHOULD ALTERNATE BETWEEN ST1394.2 +006600* SQ-FS1 AND SQ-FS2 BECAUSE THE ALPHANUMERIC KEYS ARE THE SAME ST1394.2 +006700* FOR BOTH FILES AND THE NUMERIC KEYS WERE MERGED INTO ST1394.2 +006800* ASCENDING ORDER. ST1394.2 +006900* ST1394.2 +007000* ST1394.2 +007100* X-CARDS USED - ST1394.2 +007200* X-XXX014 SQ-FS1 ST1394.2 +007300* X-XXX015 SQ-FS2 ST1394.2 +007400* X-XXX016 SQ-FS3 ST1394.2 +007500* X-XXX060 SQ-FS4 ST1394.2 +007600* X-XXX027 MERGE FILE ST-FS1 ST1394.2 +007700* X-55 SYSTEM PRINTER NAME. ST1394.2 +007800* X-82 SOURCE COMPUTER NAME. ST1394.2 +007900* X-83 OBJECT COMPUTER NAME. ST1394.2 +008000* ST1394.2 +008100* ST1394.2 +008200* OPTIONS RECOMMENDED - ST1394.2 +008300* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1394.2 +008400* FILES AS THEY ARE CREATED AND READ DURING ST1394.2 +008500* TESTS 3 THRU 8. ST1394.2 +008600* ST1394.2 +008700* ST1394.2 +008800* TEST DESCRIPTIONS - ST1394.2 +008900* MRG-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1394.2 +009000* MRG-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1394.2 +009100* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS3 ST1394.2 +009200* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS3 ST1394.2 +009300* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS3 ST1394.2 +009400* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS3 ST1394.2 +009500* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS3 ST1394.2 +009600* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS3ST1394.2 +009700* MRG-TEST-009 AN EOF CHECK ON SQ-FS3 ST1394.2 +009800* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1394.2 +009900* RECORD ON SQ-FS3 EQUALS 102 ST1394.2 +010000* ST1394.2 +010100* ST1394.2 +010200* ************************************************************ ST1394.2 +010300 ENVIRONMENT DIVISION. ST1394.2 +010400 CONFIGURATION SECTION. ST1394.2 +010500 SOURCE-COMPUTER. ST1394.2 +010600 XXXXX082. ST1394.2 +010700 OBJECT-COMPUTER. ST1394.2 +010800 XXXXX083. ST1394.2 +010900 SPECIAL-NAMES. ST1394.2 +011000 ALPHABET MY-FAVORITE-ALPHABET IS STANDARD-1. ST1394.2 +011100 INPUT-OUTPUT SECTION. ST1394.2 +011200 FILE-CONTROL. ST1394.2 +011300 SELECT PRINT-FILE ASSIGN TO ST1394.2 +011400 XXXXX055. ST1394.2 +011500 SELECT SQ-FS1 ASSIGN ST1394.2 +011600 XXXXX014 ST1394.2 +011700 ; ORGANIZATION IS SEQUENTIAL ST1394.2 +011800 ; ACCESS MODE SEQUENTIAL ST1394.2 +011900 ; RESERVE 2 AREAS. ST1394.2 +012000 SELECT SQ-FS2 ASSIGN TO ST1394.2 +012100 XXXXX015 ST1394.2 +012200 ORGANIZATION IS SEQUENTIAL ST1394.2 +012300 ACCESS MODE IS SEQUENTIAL ST1394.2 +012400 RESERVE 4 AREAS. ST1394.2 +012500 SELECT SQ-FS3 ASSIGN TO ST1394.2 +012600 XXXXX016 ST1394.2 +012700 ORGANIZATION IS SEQUENTIAL ST1394.2 +012800 ; ACCESS MODE IS SEQUENTIAL ST1394.2 +012900 RESERVE 4 AREAS. ST1394.2 +013000 SELECT SQ-FS4 ASSIGN ST1394.2 +013100 XXXXX060. ST1394.2 +013200 SELECT ST-FS1 ASSIGN TO ST1394.2 +013300 XXXXX027. ST1394.2 +013400 I-O-CONTROL. ST1394.2 +013500 SAME SORT-MERGE AREA FOR SQ-FS4, ST-FS1. ST1394.2 +013600 DATA DIVISION. ST1394.2 +013700 FILE SECTION. ST1394.2 +013800 FD PRINT-FILE. ST1394.2 +013900 01 PRINT-REC PICTURE X(120). ST1394.2 +014000 01 DUMMY-RECORD PICTURE X(120). ST1394.2 +014100 FD SQ-FS1 ST1394.2 +014200 LABEL RECORDS STANDARD ST1394.2 +014300C VALUE OF ST1394.2 +014400C XXXXX074 ST1394.2 +014500C XXXXX075 ST1394.2 +014600C BLOCK CONTAINS 1 RECORDS ST1394.2 +014700G XXXXX069 ST1394.2 +014800 RECORD CONTAINS 132 CHARACTERS. ST1394.2 +014900 01 SQ-FS1R1-F-G-132. ST1394.2 +015000 10 REC-PREAMBLE PIC X(120). ST1394.2 +015100 10 REST-OF-1. ST1394.2 +015200 20 KEY-1. ST1394.2 +015300 30 ALPHAN-KEY PIC X. ST1394.2 +015400 30 NUM-KEY PIC 999. ST1394.2 +015500 20 KEY-2. ST1394.2 +015600 30 ALPHAN-KEY PIC X. ST1394.2 +015700 30 NUM-KEY PIC 999. ST1394.2 +015800 20 KEY-3. ST1394.2 +015900 30 ALPHAN-KEY PIC X. ST1394.2 +016000 30 NUM-KEY PIC 999. ST1394.2 +016100 FD SQ-FS2 ST1394.2 +016200 LABEL RECORD IS STANDARD ST1394.2 +016300C ; VALUE OF ST1394.2 +016400C XXXXX074 ST1394.2 +016500C IS ST1394.2 +016600C XXXXX076 ST1394.2 +016700G XXXXX069 ST1394.2 +016800 ; BLOCK CONTAINS 2 RECORDS ST1394.2 +016900 ; RECORD CONTAINS 132 CHARACTERS ST1394.2 +017000 DATA RECORD SQ-FS2R1-F-G-132. ST1394.2 +017100 01 SQ-FS2R1-F-G-132. ST1394.2 +017200 10 REC-PRE-2 PIC X(120). ST1394.2 +017300 10 REST-OF-2. ST1394.2 +017400 20 KEY-4. ST1394.2 +017500 30 ALPHAN-KEY PIC X. ST1394.2 +017600 30 NUM-KEY PIC 999. ST1394.2 +017700 20 KEY-5. ST1394.2 +017800 30 ALPHAN-KEY PIC X. ST1394.2 +017900 30 NUM-KEY PIC 999. ST1394.2 +018000 20 KEY-6. ST1394.2 +018100 30 ALPHAN-KEY PIC X. ST1394.2 +018200 30 NUM-KEY PIC 999. ST1394.2 +018300 FD SQ-FS3 ST1394.2 +018400 LABEL RECORD IS STANDARD ST1394.2 +018500C ; VALUE OF ST1394.2 +018600C XXXXX074 ST1394.2 +018700C IS ST1394.2 +018800C XXXXX077 ST1394.2 +018900G XXXXX069 ST1394.2 +019000 ; BLOCK CONTAINS 3 RECORDS ST1394.2 +019100 RECORD CONTAINS 132 CHARACTERS ST1394.2 +019200 DATA RECORD SQ-FS3R1-F-G-132. ST1394.2 +019300 01 SQ-FS3R1-F-G-132. ST1394.2 +019400 10 REC-PRE-3 PIC X(120). ST1394.2 +019500 10 REST-OF-3. ST1394.2 +019600 20 KEY-7. ST1394.2 +019700 30 ALPHAN-KEY PIC X. ST1394.2 +019800 30 NUM-KEY PIC 999. ST1394.2 +019900 20 KEY-8. ST1394.2 +020000 30 ALPHAN-KEY PIC X. ST1394.2 +020100 30 NUM-KEY PIC 999. ST1394.2 +020200 20 KEY-9. ST1394.2 +020300 30 ALPHAN-KEY PIC X. ST1394.2 +020400 30 NUM-KEY PIC 999. ST1394.2 +020500 FD SQ-FS4. ST1394.2 +020600 01 SQ-FS4R1-F-6-132. ST1394.2 +020700 02 REC-2 PIC X(132). ST1394.2 +020800 SD ST-FS1 ST1394.2 +020900 RECORD CONTAINS 132 CHARACTERS ST1394.2 +021000 DATA RECORD IS ST-FS1R1-F-G-132. ST1394.2 +021100 01 ST-FS1R1-F-G-132. ST1394.2 +021200 02 FILLER PIC X(120). ST1394.2 +021300 02 NON-KEY-1. ST1394.2 +021400 03 A-KEY PIC X. ST1394.2 +021500 03 N-KEY PIC 999. ST1394.2 +021600 02 SORT-KEY. ST1394.2 +021700 03 A-KEY PIC X. ST1394.2 +021800 03 N-KEY PIC 999. ST1394.2 +021900 02 NON-KEY-2. ST1394.2 +022000 03 A-KEY PIC X. ST1394.2 +022100 03 N-KEY PIC 999. ST1394.2 +022200 WORKING-STORAGE SECTION. ST1394.2 +022300 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1394.2 +022400 77 WRK-DU-999-0001 PIC 999. ST1394.2 +022500 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1394.2 +022600 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1394.2 +022700 01 WRK-XN-0001 PIC X(51) VALUE ST1394.2 +022800 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1394.2 +022900 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1394.2 +023000 02 CHAR PIC X OCCURS 51 TIMES. ST1394.2 +023100 01 WRK-XN-2 PIC X(51) VALUE ST1394.2 +023200 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1394.2 +023300 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1394.2 +023400 02 ASCIIS PIC X OCCURS 51 TIMES. ST1394.2 +023500 01 WRK-XN-O020F-0001. ST1394.2 +023600 02 COMPU PIC X OCCURS 20 TIMES. ST1394.2 +023700 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1394.2 +023800 02 FILLER PIC X(20). ST1394.2 +023900 01 WRK-XN-O120F-1. ST1394.2 +024000 02 COLLS PIC X OCCURS 120 TIMES. ST1394.2 +024100 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1394.2 +024200 02 WRK-XN-0002 PIC X(20). ST1394.2 +024300 02 WRK-XN-0003 PIC X(20). ST1394.2 +024400 02 WRK-XN-0004 PIC X(20). ST1394.2 +024500 02 WRK-XN-0005 PIC X(20). ST1394.2 +024600 02 WRK-XN-0006 PIC X(20). ST1394.2 +024700 02 WRK-XN-0007 PIC X(20). ST1394.2 +024800 01 FILE-RECORD-INFORMATION-REC. ST1394.2 +024900 03 FILE-RECORD-INFO-SKELETON. ST1394.2 +025000 05 FILLER PICTURE X(48) VALUE ST1394.2 +025100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1394.2 +025200 05 FILLER PICTURE X(46) VALUE ST1394.2 +025300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1394.2 +025400 05 FILLER PICTURE X(26) VALUE ST1394.2 +025500 ",LFIL=000000,ORG= ,LBLR= ". ST1394.2 +025600 05 FILLER PICTURE X(37) VALUE ST1394.2 +025700 ",RECKEY= ". ST1394.2 +025800 05 FILLER PICTURE X(38) VALUE ST1394.2 +025900 ",ALTKEY1= ". ST1394.2 +026000 05 FILLER PICTURE X(38) VALUE ST1394.2 +026100 ",ALTKEY2= ". ST1394.2 +026200 05 FILLER PICTURE X(7) VALUE SPACE.ST1394.2 +026300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1394.2 +026400 05 FILE-RECORD-INFO-P1-120. ST1394.2 +026500 07 FILLER PIC X(5). ST1394.2 +026600 07 XFILE-NAME PIC X(6). ST1394.2 +026700 07 FILLER PIC X(8). ST1394.2 +026800 07 XRECORD-NAME PIC X(6). ST1394.2 +026900 07 FILLER PIC X(1). ST1394.2 +027000 07 REELUNIT-NUMBER PIC 9(1). ST1394.2 +027100 07 FILLER PIC X(7). ST1394.2 +027200 07 XRECORD-NUMBER PIC 9(6). ST1394.2 +027300 07 FILLER PIC X(6). ST1394.2 +027400 07 UPDATE-NUMBER PIC 9(2). ST1394.2 +027500 07 FILLER PIC X(5). ST1394.2 +027600 07 ODO-NUMBER PIC 9(4). ST1394.2 +027700 07 FILLER PIC X(5). ST1394.2 +027800 07 XPROGRAM-NAME PIC X(5). ST1394.2 +027900 07 FILLER PIC X(7). ST1394.2 +028000 07 XRECORD-LENGTH PIC 9(6). ST1394.2 +028100 07 FILLER PIC X(7). ST1394.2 +028200 07 CHARS-OR-RECORDS PIC X(2). ST1394.2 +028300 07 FILLER PIC X(1). ST1394.2 +028400 07 XBLOCK-SIZE PIC 9(4). ST1394.2 +028500 07 FILLER PIC X(6). ST1394.2 +028600 07 RECORDS-IN-FILE PIC 9(6). ST1394.2 +028700 07 FILLER PIC X(5). ST1394.2 +028800 07 XFILE-ORGANIZATION PIC X(2). ST1394.2 +028900 07 FILLER PIC X(6). ST1394.2 +029000 07 XLABEL-TYPE PIC X(1). ST1394.2 +029100 05 FILE-RECORD-INFO-P121-240. ST1394.2 +029200 07 FILLER PIC X(8). ST1394.2 +029300 07 XRECORD-KEY PIC X(29). ST1394.2 +029400 07 FILLER PIC X(9). ST1394.2 +029500 07 ALTERNATE-KEY1 PIC X(29). ST1394.2 +029600 07 FILLER PIC X(9). ST1394.2 +029700 07 ALTERNATE-KEY2 PIC X(29). ST1394.2 +029800 07 FILLER PIC X(7). ST1394.2 +029900 01 TEST-RESULTS. ST1394.2 +030000 02 FILLER PIC X VALUE SPACE. ST1394.2 +030100 02 FEATURE PIC X(20) VALUE SPACE. ST1394.2 +030200 02 FILLER PIC X VALUE SPACE. ST1394.2 +030300 02 P-OR-F PIC X(5) VALUE SPACE. ST1394.2 +030400 02 FILLER PIC X VALUE SPACE. ST1394.2 +030500 02 PAR-NAME. ST1394.2 +030600 03 FILLER PIC X(19) VALUE SPACE. ST1394.2 +030700 03 PARDOT-X PIC X VALUE SPACE. ST1394.2 +030800 03 DOTVALUE PIC 99 VALUE ZERO. ST1394.2 +030900 02 FILLER PIC X(8) VALUE SPACE. ST1394.2 +031000 02 RE-MARK PIC X(61). ST1394.2 +031100 01 TEST-COMPUTED. ST1394.2 +031200 02 FILLER PIC X(30) VALUE SPACE. ST1394.2 +031300 02 FILLER PIC X(17) VALUE ST1394.2 +031400 " COMPUTED=". ST1394.2 +031500 02 COMPUTED-X. ST1394.2 +031600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1394.2 +031700 03 COMPUTED-N REDEFINES COMPUTED-A ST1394.2 +031800 PIC -9(9).9(9). ST1394.2 +031900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1394.2 +032000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1394.2 +032100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1394.2 +032200 03 CM-18V0 REDEFINES COMPUTED-A. ST1394.2 +032300 04 COMPUTED-18V0 PIC -9(18). ST1394.2 +032400 04 FILLER PIC X. ST1394.2 +032500 03 FILLER PIC X(50) VALUE SPACE. ST1394.2 +032600 01 TEST-CORRECT. ST1394.2 +032700 02 FILLER PIC X(30) VALUE SPACE. ST1394.2 +032800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1394.2 +032900 02 CORRECT-X. ST1394.2 +033000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1394.2 +033100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1394.2 +033200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1394.2 +033300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1394.2 +033400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1394.2 +033500 03 CR-18V0 REDEFINES CORRECT-A. ST1394.2 +033600 04 CORRECT-18V0 PIC -9(18). ST1394.2 +033700 04 FILLER PIC X. ST1394.2 +033800 03 FILLER PIC X(2) VALUE SPACE. ST1394.2 +033900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1394.2 +034000 01 CCVS-C-1. ST1394.2 +034100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1394.2 +034200- "SS PARAGRAPH-NAME ST1394.2 +034300- " REMARKS". ST1394.2 +034400 02 FILLER PIC X(20) VALUE SPACE. ST1394.2 +034500 01 CCVS-C-2. ST1394.2 +034600 02 FILLER PIC X VALUE SPACE. ST1394.2 +034700 02 FILLER PIC X(6) VALUE "TESTED". ST1394.2 +034800 02 FILLER PIC X(15) VALUE SPACE. ST1394.2 +034900 02 FILLER PIC X(4) VALUE "FAIL". ST1394.2 +035000 02 FILLER PIC X(94) VALUE SPACE. ST1394.2 +035100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1394.2 +035200 01 REC-CT PIC 99 VALUE ZERO. ST1394.2 +035300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1394.2 +035800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1394.2 +035900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1394.2 +036000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1394.2 +036100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1394.2 +036200 01 CCVS-H-1. ST1394.2 +036300 02 FILLER PIC X(39) VALUE SPACES. ST1394.2 +036400 02 FILLER PIC X(42) VALUE ST1394.2 +036500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1394.2 +036600 02 FILLER PIC X(39) VALUE SPACES. ST1394.2 +036700 01 CCVS-H-2A. ST1394.2 +036800 02 FILLER PIC X(40) VALUE SPACE. ST1394.2 +036900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1394.2 +037000 02 FILLER PIC XXXX VALUE ST1394.2 +037100 "4.2 ". ST1394.2 +037200 02 FILLER PIC X(28) VALUE ST1394.2 +037300 " COPY - NOT FOR DISTRIBUTION". ST1394.2 +037400 02 FILLER PIC X(41) VALUE SPACE. ST1394.2 +037500 ST1394.2 +037600 01 CCVS-H-2B. ST1394.2 +037700 02 FILLER PIC X(15) VALUE ST1394.2 +037800 "TEST RESULT OF ". ST1394.2 +037900 02 TEST-ID PIC X(9). ST1394.2 +038000 02 FILLER PIC X(4) VALUE ST1394.2 +038100 " IN ". ST1394.2 +038200 02 FILLER PIC X(12) VALUE ST1394.2 +038300 " HIGH ". ST1394.2 +038400 02 FILLER PIC X(22) VALUE ST1394.2 +038500 " LEVEL VALIDATION FOR ". ST1394.2 +038600 02 FILLER PIC X(58) VALUE ST1394.2 +038700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +038800 01 CCVS-H-3. ST1394.2 +038900 02 FILLER PIC X(34) VALUE ST1394.2 +039000 " FOR OFFICIAL USE ONLY ". ST1394.2 +039100 02 FILLER PIC X(58) VALUE ST1394.2 +039200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1394.2 +039300 02 FILLER PIC X(28) VALUE ST1394.2 +039400 " COPYRIGHT 1985 ". ST1394.2 +039500 01 CCVS-E-1. ST1394.2 +039600 02 FILLER PIC X(52) VALUE SPACE. ST1394.2 +039700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1394.2 +039800 02 ID-AGAIN PIC X(9). ST1394.2 +039900 02 FILLER PIC X(45) VALUE SPACES. ST1394.2 +040000 01 CCVS-E-2. ST1394.2 +040100 02 FILLER PIC X(31) VALUE SPACE. ST1394.2 +040200 02 FILLER PIC X(21) VALUE SPACE. ST1394.2 +040300 02 CCVS-E-2-2. ST1394.2 +040400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1394.2 +040500 03 FILLER PIC X VALUE SPACE. ST1394.2 +040600 03 ENDER-DESC PIC X(44) VALUE ST1394.2 +040700 "ERRORS ENCOUNTERED". ST1394.2 +040800 01 CCVS-E-3. ST1394.2 +040900 02 FILLER PIC X(22) VALUE ST1394.2 +041000 " FOR OFFICIAL USE ONLY". ST1394.2 +041100 02 FILLER PIC X(12) VALUE SPACE. ST1394.2 +041200 02 FILLER PIC X(58) VALUE ST1394.2 +041300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +041400 02 FILLER PIC X(13) VALUE SPACE. ST1394.2 +041500 02 FILLER PIC X(15) VALUE ST1394.2 +041600 " COPYRIGHT 1985". ST1394.2 +041700 01 CCVS-E-4. ST1394.2 +041800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1394.2 +041900 02 FILLER PIC X(4) VALUE " OF ". ST1394.2 +042000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1394.2 +042100 02 FILLER PIC X(40) VALUE ST1394.2 +042200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1394.2 +042300 01 XXINFO. ST1394.2 +042400 02 FILLER PIC X(19) VALUE ST1394.2 +042500 "*** INFORMATION ***". ST1394.2 +042600 02 INFO-TEXT. ST1394.2 +042700 04 FILLER PIC X(8) VALUE SPACE. ST1394.2 +042800 04 XXCOMPUTED PIC X(20). ST1394.2 +042900 04 FILLER PIC X(5) VALUE SPACE. ST1394.2 +043000 04 XXCORRECT PIC X(20). ST1394.2 +043100 02 INF-ANSI-REFERENCE PIC X(48). ST1394.2 +043200 01 HYPHEN-LINE. ST1394.2 +043300 02 FILLER PIC IS X VALUE IS SPACE. ST1394.2 +043400 02 FILLER PIC IS X(65) VALUE IS "************************ST1394.2 +043500- "*****************************************". ST1394.2 +043600 02 FILLER PIC IS X(54) VALUE IS "************************ST1394.2 +043700- "******************************". ST1394.2 +043800 01 CCVS-PGM-ID PIC X(9) VALUE ST1394.2 +043900 "ST139A". ST1394.2 +044000 PROCEDURE DIVISION. ST1394.2 +044100 DECLARATIVES. ST1394.2 +044200 SECT-ST209-DEC SECTION. ST1394.2 +044300 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1394.2 +044400 MRG-WRITE-DEC. ST1394.2 +044500 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1394.2 +044600 MOVE "MRG-TEST-DEC" TO PAR-NAME. ST1394.2 +044700 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1394.2 +044800 STOP RUN. ST1394.2 +044900 END DECLARATIVES. ST1394.2 +045000 CCVS1 SECTION. ST1394.2 +045100 OPEN-FILES. ST1394.2 +045200 OPEN OUTPUT PRINT-FILE. ST1394.2 +045300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1394.2 +045400 MOVE SPACE TO TEST-RESULTS. ST1394.2 +045500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1394.2 +045600 MOVE ZERO TO REC-SKL-SUB. ST1394.2 +045700 PERFORM CCVS-INIT-FILE 9 TIMES. ST1394.2 +045800 CCVS-INIT-FILE. ST1394.2 +045900 ADD 1 TO REC-SKL-SUB. ST1394.2 +046000 MOVE FILE-RECORD-INFO-SKELETON ST1394.2 +046100 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1394.2 +046200 CCVS-INIT-EXIT. ST1394.2 +046300 GO TO CCVS1-EXIT. ST1394.2 +046400 CLOSE-FILES. ST1394.2 +046500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1394.2 +046600 TERMINATE-CCVS. ST1394.2 +046700S EXIT PROGRAM. ST1394.2 +046800STERMINATE-CALL. ST1394.2 +046900 STOP RUN. ST1394.2 +047000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1394.2 +047100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1394.2 +047200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1394.2 +047300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1394.2 +047400 MOVE "****TEST DELETED****" TO RE-MARK. ST1394.2 +047500 PRINT-DETAIL. ST1394.2 +047600 IF REC-CT NOT EQUAL TO ZERO ST1394.2 +047700 MOVE "." TO PARDOT-X ST1394.2 +047800 MOVE REC-CT TO DOTVALUE. ST1394.2 +047900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1394.2 +048000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1394.2 +048100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1394.2 +048200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1394.2 +048300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1394.2 +048400 MOVE SPACE TO CORRECT-X. ST1394.2 +048500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1394.2 +048600 MOVE SPACE TO RE-MARK. ST1394.2 +048700 HEAD-ROUTINE. ST1394.2 +048800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +048900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +049000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1394.2 +049100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1394.2 +049200 COLUMN-NAMES-ROUTINE. ST1394.2 +049300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +049400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +049500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +049600 END-ROUTINE. ST1394.2 +049700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1394.2 +049800 END-RTN-EXIT. ST1394.2 +049900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +050000 END-ROUTINE-1. ST1394.2 +050100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1394.2 +050200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1394.2 +050300 ADD PASS-COUNTER TO ERROR-HOLD. ST1394.2 +050400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1394.2 +050500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1394.2 +050600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1394.2 +050700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1394.2 +050800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1394.2 +050900 END-ROUTINE-12. ST1394.2 +051000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1394.2 +051100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1394.2 +051200 MOVE "NO " TO ERROR-TOTAL ST1394.2 +051300 ELSE ST1394.2 +051400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1394.2 +051500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1394.2 +051600 PERFORM WRITE-LINE. ST1394.2 +051700 END-ROUTINE-13. ST1394.2 +051800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1394.2 +051900 MOVE "NO " TO ERROR-TOTAL ELSE ST1394.2 +052000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1394.2 +052100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1394.2 +052200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052300 IF INSPECT-COUNTER EQUAL TO ZERO ST1394.2 +052400 MOVE "NO " TO ERROR-TOTAL ST1394.2 +052500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1394.2 +052600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1394.2 +052700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052900 WRITE-LINE. ST1394.2 +053000 ADD 1 TO RECORD-COUNT. ST1394.2 +053100Y IF RECORD-COUNT GREATER 42 ST1394.2 +053200Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1394.2 +053300Y MOVE SPACE TO DUMMY-RECORD ST1394.2 +053400Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1394.2 +053500Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1394.2 +053600Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1394.2 +053700Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1394.2 +053800Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1394.2 +053900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054200Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1394.2 +054300Y MOVE ZERO TO RECORD-COUNT. ST1394.2 +054400 PERFORM WRT-LN. ST1394.2 +054500 WRT-LN. ST1394.2 +054600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1394.2 +054700 MOVE SPACE TO DUMMY-RECORD. ST1394.2 +054800 BLANK-LINE-PRINT. ST1394.2 +054900 PERFORM WRT-LN. ST1394.2 +055000 FAIL-ROUTINE. ST1394.2 +055100 IF COMPUTED-X NOT EQUAL TO SPACE ST1394.2 +055200 GO TO FAIL-ROUTINE-WRITE. ST1394.2 +055300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1394.2 +055400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1394.2 +055500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1394.2 +055600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +055700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1394.2 +055800 GO TO FAIL-ROUTINE-EX. ST1394.2 +055900 FAIL-ROUTINE-WRITE. ST1394.2 +056000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1394.2 +056100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1394.2 +056200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1394.2 +056300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1394.2 +056400 FAIL-ROUTINE-EX. EXIT. ST1394.2 +056500 BAIL-OUT. ST1394.2 +056600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1394.2 +056700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1394.2 +056800 BAIL-OUT-WRITE. ST1394.2 +056900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1394.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1394.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +057200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1394.2 +057300 BAIL-OUT-EX. EXIT. ST1394.2 +057400 CCVS1-EXIT. ST1394.2 +057500 EXIT. ST1394.2 +057600 SECT-ST209-0001 SECTION. ST1394.2 +057700 MRG-INIT-001. ST1394.2 +057800 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1394.2 +057900 OPEN OUTPUT SQ-FS1. ST1394.2 +058000 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1394.2 +058100 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1394.2 +058200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1394.2 +058300 MOVE 000132 TO XRECORD-LENGTH (1). ST1394.2 +058400 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1394.2 +058500 MOVE 0001 TO XBLOCK-SIZE (1). ST1394.2 +058600 MOVE 000051 TO RECORDS-IN-FILE (1). ST1394.2 +058700 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1394.2 +058800 MOVE "S" TO XLABEL-TYPE (1). ST1394.2 +058900 MOVE 000001 TO XRECORD-NUMBER (1). ST1394.2 +059000 MOVE SPACES TO WRK-XN-O120F-1. ST1394.2 +059100 MRG-TEST-001. ST1394.2 +059200 PERFORM MRG-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1394.2 +059300 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1394.2 +059400X MOVE SPACES TO PRINT-REC. ST1394.2 +059500X WRITE PRINT-REC. ST1394.2 +059600 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1394.2 +059700 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1394.2 +059800 ELSE ST1394.2 +059900 PERFORM PASS. ST1394.2 +060000 GO TO MRG-WRITE-001. ST1394.2 +060100 MRG-TEST-001-BUILD. ST1394.2 +060200 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1394.2 +060300 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1394.2 +060400 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1394.2 +060500 NUM-KEY OF KEY-3. ST1394.2 +060600 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1394.2 +060700 ADD 1 TO XRECORD-NUMBER (1). ST1394.2 +060800 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1394.2 +060900 ADD 1 TO WRK-DU-999-2. ST1394.2 +061000 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1394.2 +061100 ADD 1 TO WRK-DU-999-2. ST1394.2 +061200X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1394.2 +061300X WRITE PRINT-REC FROM REST-OF-1. ST1394.2 +061400X MOVE SPACES TO PRINT-REC. ST1394.2 +061500 WRITE SQ-FS1R1-F-G-132. ST1394.2 +061600 MRG-DELETE-001. ST1394.2 +061700 PERFORM DE-LETE. ST1394.2 +061800 MRG-WRITE-001. ST1394.2 +061900 MOVE "MRG-TEST-001" TO PAR-NAME. ST1394.2 +062000 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1394.2 +062100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1394.2 +062200 PERFORM PRINT-DETAIL. ST1394.2 +062300X MOVE SPACES TO PRINT-REC. ST1394.2 +062400X WRITE PRINT-REC. ST1394.2 +062500 CLOSE SQ-FS1. ST1394.2 +062600 MRG-INIT-002. ST1394.2 +062700 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1394.2 +062800 OPEN OUTPUT SQ-FS2. ST1394.2 +062900 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1394.2 +063000 MOVE 000001 TO XRECORD-NUMBER (1). ST1394.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). ST1394.2 +063200 MRG-TEST-002. ST1394.2 +063300 PERFORM MRG-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1394.2 +063400 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1394.2 +063500X MOVE SPACES TO PRINT-REC. ST1394.2 +063600X WRITE PRINT-REC. ST1394.2 +063700 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1394.2 +063800 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1394.2 +063900 ELSE ST1394.2 +064000 PERFORM PASS. ST1394.2 +064100 GO TO MRG-WRITE-002. ST1394.2 +064200 MRG-TEST-002-BUILD. ST1394.2 +064300 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1394.2 +064400 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1394.2 +064500 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1394.2 +064600 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1394.2 +064700 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1394.2 +064800 ADD 000001 TO XRECORD-NUMBER (1). ST1394.2 +064900X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1394.2 +065000X WRITE PRINT-REC FROM REST-OF-2. ST1394.2 +065100X MOVE SPACES TO PRINT-REC. ST1394.2 +065200 WRITE SQ-FS2R1-F-G-132. ST1394.2 +065300 MRG-DELETE-002. ST1394.2 +065400 PERFORM DE-LETE. ST1394.2 +065500 MRG-WRITE-002. ST1394.2 +065600 MOVE "MRG-TEST-002" TO PAR-NAME. ST1394.2 +065700 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1394.2 +065800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1394.2 +065900 PERFORM PRINT-DETAIL. ST1394.2 +066000X MOVE SPACES TO PRINT-REC. ST1394.2 +066100X WRITE PRINT-REC. ST1394.2 +066200 CLOSE SQ-FS2. ST1394.2 +066300 MRG-INIT-003. ST1394.2 +066400 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +066500 MERGE ST-FS1 ST1394.2 +066600 ASCENDING A-KEY OF SORT-KEY ST1394.2 +066700 ON ASCENDING KEY N-KEY OF NON-KEY-1 ST1394.2 +066800 SEQUENCE MY-FAVORITE-ALPHABET ST1394.2 +066900 USING SQ-FS2 SQ-FS1 ST1394.2 +067000 GIVING SQ-FS3. ST1394.2 +067100 MRG-TEST-003. ST1394.2 +067200 OPEN INPUT SQ-FS3. ST1394.2 +067300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +067400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +067500X MOVE SPACES TO PRINT-REC. ST1394.2 +067600X WRITE PRINT-REC. ST1394.2 +067700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1394.2 +067800 PERFORM FAIL GO TO MRG-FAIL-003 ST1394.2 +067900 ELSE ST1394.2 +068000 PERFORM PASS. ST1394.2 +068100 GO TO MRG-WRITE-003. ST1394.2 +068200 MRG-DELETE-003. ST1394.2 +068300 PERFORM DE-LETE. ST1394.2 +068400 GO TO MRG-WRITE-003. ST1394.2 +068500 MRG-FAIL-003. ST1394.2 +068600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +068700 MOVE WRK-XN-0002 TO CORRECT-A. ST1394.2 +068800 MRG-WRITE-003. ST1394.2 +068900 MOVE "MRG-TEST-003" TO PAR-NAME. ST1394.2 +069000 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +069100 PERFORM PRINT-DETAIL. ST1394.2 +069200X MOVE SPACES TO PRINT-REC. ST1394.2 +069300X WRITE PRINT-REC. ST1394.2 +069400 MRG-INIT-004. ST1394.2 +069500 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +069600 MRG-TEST-004. ST1394.2 +069700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +069800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +069900X MOVE SPACES TO PRINT-REC. ST1394.2 +070000X WRITE PRINT-REC. ST1394.2 +070100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1394.2 +070200 PERFORM FAIL GO TO MRG-FAIL-004 ST1394.2 +070300 ELSE ST1394.2 +070400 PERFORM PASS. ST1394.2 +070500 GO TO MRG-WRITE-004. ST1394.2 +070600 MRG-DELETE-004. ST1394.2 +070700 PERFORM DE-LETE. ST1394.2 +070800 GO TO MRG-WRITE-004. ST1394.2 +070900 MRG-FAIL-004. ST1394.2 +071000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +071100 MOVE WRK-XN-0003 TO CORRECT-A. ST1394.2 +071200 MRG-WRITE-004. ST1394.2 +071300 MOVE "MRG-TEST-004" TO PAR-NAME. ST1394.2 +071400 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +071500 PERFORM PRINT-DETAIL. ST1394.2 +071600X MOVE SPACES TO PRINT-REC. ST1394.2 +071700X WRITE PRINT-REC. ST1394.2 +071800 MRG-INIT-005. ST1394.2 +071900 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +072000 MRG-TEST-005. ST1394.2 +072100 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +072200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +072300X MOVE SPACES TO PRINT-REC. ST1394.2 +072400X WRITE PRINT-REC. ST1394.2 +072500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1394.2 +072600 PERFORM FAIL GO TO MRG-FAIL-005 ST1394.2 +072700 ELSE ST1394.2 +072800 PERFORM PASS. ST1394.2 +072900 GO TO MRG-WRITE-005. ST1394.2 +073000 MRG-DELETE-005. ST1394.2 +073100 PERFORM DE-LETE. ST1394.2 +073200 GO TO MRG-WRITE-005. ST1394.2 +073300 MRG-FAIL-005. ST1394.2 +073400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +073500 MOVE WRK-XN-0004 TO CORRECT-A. ST1394.2 +073600 MRG-WRITE-005. ST1394.2 +073700 MOVE "MRG-TEST-005" TO PAR-NAME. ST1394.2 +073800 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +073900 PERFORM PRINT-DETAIL. ST1394.2 +074000X MOVE SPACES TO PRINT-REC. ST1394.2 +074100X WRITE PRINT-REC. ST1394.2 +074200 MRG-INIT-006. ST1394.2 +074300 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +074400 MRG-TEST-006. ST1394.2 +074500 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +074600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +074700X MOVE SPACES TO PRINT-REC. ST1394.2 +074800X WRITE PRINT-REC. ST1394.2 +074900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1394.2 +075000 PERFORM FAIL GO TO MRG-FAIL-006 ST1394.2 +075100 ELSE ST1394.2 +075200 PERFORM PASS. ST1394.2 +075300 GO TO MRG-WRITE-006. ST1394.2 +075400 MRG-DELETE-006. ST1394.2 +075500 PERFORM DE-LETE. ST1394.2 +075600 GO TO MRG-WRITE-006. ST1394.2 +075700 MRG-FAIL-006. ST1394.2 +075800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +075900 MOVE WRK-XN-0005 TO CORRECT-A. ST1394.2 +076000 MRG-WRITE-006. ST1394.2 +076100 MOVE "MRG-TEST-006" TO PAR-NAME. ST1394.2 +076200 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +076300 PERFORM PRINT-DETAIL. ST1394.2 +076400X MOVE SPACES TO PRINT-REC. ST1394.2 +076500X WRITE PRINT-REC. ST1394.2 +076600 MRG-INIT-007. ST1394.2 +076700 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +076800 MRG-TEST-007. ST1394.2 +076900 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +077000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +077100X MOVE SPACES TO PRINT-REC. ST1394.2 +077200X WRITE PRINT-REC. ST1394.2 +077300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1394.2 +077400 PERFORM FAIL GO TO MRG-FAIL-007 ST1394.2 +077500 ELSE ST1394.2 +077600 PERFORM PASS. ST1394.2 +077700 GO TO MRG-WRITE-007. ST1394.2 +077800 MRG-DELETE-007. ST1394.2 +077900 PERFORM DE-LETE. ST1394.2 +078000 GO TO MRG-WRITE-007. ST1394.2 +078100 MRG-FAIL-007. ST1394.2 +078200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +078300 MOVE WRK-XN-0006 TO CORRECT-A. ST1394.2 +078400 MRG-WRITE-007. ST1394.2 +078500 MOVE "MRG-TEST-007" TO PAR-NAME. ST1394.2 +078600 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +078700 PERFORM PRINT-DETAIL. ST1394.2 +078800X MOVE SPACES TO PRINT-REC. ST1394.2 +078900X WRITE PRINT-REC. ST1394.2 +079000 MRG-INIT-008. ST1394.2 +079100 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +079200 MRG-TEST-008. ST1394.2 +079300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +079400 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1394.2 +079500X MOVE SPACES TO PRINT-REC. ST1394.2 +079600X WRITE PRINT-REC. ST1394.2 +079700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1394.2 +079800 PERFORM FAIL GO TO MRG-FAIL-008 ST1394.2 +079900 ELSE ST1394.2 +080000 PERFORM PASS. ST1394.2 +080100 GO TO MRG-WRITE-008. ST1394.2 +080200 MRG-DELETE-008. ST1394.2 +080300 PERFORM DE-LETE. ST1394.2 +080400 GO TO MRG-WRITE-008. ST1394.2 +080500 MRG-FAIL-008. ST1394.2 +080600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +080700 MOVE WRK-XN-0007 TO CORRECT-A. ST1394.2 +080800 MRG-WRITE-008. ST1394.2 +080900 MOVE "MRG-TEST-008" TO PAR-NAME. ST1394.2 +081000 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +081100 PERFORM PRINT-DETAIL. ST1394.2 +081200 MOVE NUM-KEY OF KEY-7 TO LAST-REC-NUM. ST1394.2 +081300 MRG-TEST-009. ST1394.2 +081400 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1394.2 +081500 GO TO MRG-FAIL-009. ST1394.2 +081600 READ SQ-FS3 END PERFORM PASS ST1394.2 +081700 GO TO MRG-WRITE-009. ST1394.2 +081800 GO TO MRG-FAIL-009. ST1394.2 +081900 MRG-DELETE-009. ST1394.2 +082000 PERFORM DE-LETE. ST1394.2 +082100 GO TO MRG-WRITE-009. ST1394.2 +082200 MRG-FAIL-009. ST1394.2 +082300 MOVE "EOF NOT FOUND" TO RE-MARK. ST1394.2 +082400 PERFORM FAIL . ST1394.2 +082500 MRG-WRITE-009. ST1394.2 +082600 MOVE "EOF CHECK SQ-FS3" TO FEATURE. ST1394.2 +082700 MOVE "MRG-TEST-009" TO PAR-NAME. ST1394.2 +082800 PERFORM PRINT-DETAIL. ST1394.2 +082900 MRG-TEST-010. ST1394.2 +083000 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1394.2 +083100 PERFORM FAIL GO TO MRG-FAIL-010 ST1394.2 +083200 ELSE ST1394.2 +083300 PERFORM PASS. ST1394.2 +083400 GO TO MRG-WRITE-010. ST1394.2 +083500 MRG-DELETE-010. ST1394.2 +083600 PERFORM DE-LETE. ST1394.2 +083700 GO TO MRG-WRITE-010. ST1394.2 +083800 MRG-FAIL-010. ST1394.2 +083900 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1394.2 +084000 MOVE 102 TO CR-18V0. ST1394.2 +084100 MRG-WRITE-010. ST1394.2 +084200 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1394.2 +084300 MOVE "MRG-TEST-010" TO PAR-NAME. ST1394.2 +084400 PERFORM PRINT-DETAIL. ST1394.2 +084500 CLOSE SQ-FS3. ST1394.2 +084600 GO TO CCVS-999999. ST1394.2 +084700 READ-SQ-FS1 SECTION. ST1394.2 +084800 RD-1. ST1394.2 +084900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1394.2 +085000 GO TO R1-EXIT. ST1394.2 +085100 READ SQ-FS3 AT END GO TO PREMATURE-EOF. ST1394.2 +085200X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1394.2 +085300X WRITE PRINT-REC FROM REST-OF-3. ST1394.2 +085400X MOVE SPACES TO PRINT-REC. ST1394.2 +085500 MOVE ALPHAN-KEY OF KEY-8 TO COMPU (WRK-DU-999-0001). ST1394.2 +085600 GO TO R1-EXIT. ST1394.2 +085700 PREMATURE-EOF. ST1394.2 +085800 MOVE 1 TO WRK-DU-9-0001. ST1394.2 +085900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1394.2 +086000 R1-EXIT. ST1394.2 +086100 EXIT. ST1394.2 +086200 CCVS-EXIT SECTION. ST1394.2 +086300 CCVS-999999. ST1394.2 +086400 GO TO CLOSE-FILES. ST1394.2 +*END-OF,ST139A +*HEADER,COBOL,ST140A TES00010 +000100 IDENTIFICATION DIVISION. ST1404.2 +000200 PROGRAM-ID. ST1404.2 +000300 ST140A. ST1404.2 +000400**************************************************************** ST1404.2 +000500* * ST1404.2 +000600* VALIDATION FOR:- * ST1404.2 +000700* * ST1404.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +000900* * ST1404.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1404.2 +001100* * ST1404.2 +001200**************************************************************** ST1404.2 +001300* ST1404.2 +001400* OBJECTIVE - ST1404.2 +001500* ROUTINE ST210 IS A TEST OF THE MERGE STATEMENT USING ST1404.2 +001600* THE ASCII COLLATING SEQUENCE AND MULTIPLE FILE TAPE. ST1404.2 +001700* THIS ROUTINE IS A TEST OF THE COMPILERS ABILITY TO MERGE ST1404.2 +001800* THE SECOND FILE OF A MULTI-FILE REEL WITH A MASS-STORAGE ST1404.2 +001900* FILE TO PRODUCE A MASS-STORAGE FILE. ST1404.2 +002000* ST1404.2 +002100* ST1404.2 +002200* FEATURES TESTED - ST1404.2 +002300* * ALPHABET-NAME IS STANDARD-1 (THE ASCII COLLATING SEQ.) ST1404.2 +002400* * COLLATING SEQUENCE IS ALPHABET-NAME ST1404.2 +002500* * MULTIPLE FILE TAPE ST1404.2 +002600* * FIXED LENGTH RECORDS ST1404.2 +002700* * SAME SORT AREA IN THE I-O-CONTROL PARAGRAPH ST1404.2 +002800* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1404.2 +002900* * USING FILE-NAME SERIES ST1404.2 +003000* * OUTPUT PROCEDURE IS SECTION-NAME ST1404.2 +003100* * RETURN RECORD INTO PART OF THE OUTPUT PROCEDURE ST1404.2 +003200* ST1404.2 +003300* * MERGE MERGE-FILE-NAME ST1404.2 +003400* ON DESCENDING KEY KEY-1 OF DATA-NAME-1 ST1404.2 +003500* ASCENDING KEY-2 OF DATA-NAME-2 ST1404.2 +003600* COLLATING SEQUENCE IS ALPHABET-NAME ST1404.2 +003700* OUTPUT PROCEDURE IS SECTION-NAME. ST1404.2 +003800* ST1404.2 +003900* ST1404.2 +004000* ST1404.2 +004100* ST1404.2 +004200* FILES USED - ST1404.2 +004300* * FILES SQ-FS1 AND SQ-FS3 ARE WRITTEN ONTO A MULTIPLE ST1404.2 +004400* FILE TAPE. FILE SQ-FS2 IS WRITTEN ONTO MASS-STORAGE. ST1404.2 +004500* THEN THE MERGE STATEMENT USES SQ-FS3 AND SQ-FS2 TO CREATE A ST1404.2 +004600* NEW MASS-STORAGE FILE SQ-FS4. ALL FILES HAVE FIXED LENGTH ST1404.2 +004700* RECORDS AND 132 CHARACTERS PER RECORD. ST1404.2 +004800* ST1404.2 +004900* SQ-FS1 ST1404.2 +005000* 51 RECORDS ST1404.2 +005100* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +005200* BLOCKED 1 ST1404.2 +005300* RESERVE 2 AREAS ST1404.2 +005400* ST1404.2 +005500* SQ-FS2 ST1404.2 +005600* 51 RECORDS ST1404.2 +005700* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +005800* BLOCKED 2 ST1404.2 +005900* RESERVE 4 AREAS ST1404.2 +006000* ST1404.2 +006100* SQ-FS3 ST1404.2 +006200* 51 RECORDS ST1404.2 +006300* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +006400* BLOCKED 1 ST1404.2 +006500* RESERVE 6 AREAS ST1404.2 +006600* ST1404.2 +006700* NOTE THAT FILE SQ-FS3 IS THE SECOND POSITION ST1404.2 +006800* ON A MULTIPLE FILE TAPE. BOTH FILES SQ-FS1 AND SQ-FS3 ARE ST1404.2 +006900* ON THE SAME MULTIPLE FILE TAPE. ST1404.2 +007000* ST1404.2 +007100* SQ-FS4 ST1404.2 +007200* FINAL TOTAL OF 102 RECORDS AS A RESULT OF THE MERGE ST1404.2 +007300* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +007400* BLOCKED 3 ST1404.2 +007500* RESERVE 4 AREAS ST1404.2 +007600* ST1404.2 +007700* ST1404.2 +007800* X-CARDS USED - ST1404.2 +007900* X-XXX008 SQ-FS1 ST1404.2 +008000* X-XXX014 SQ-FS2 ST1404.2 +008100* X-XXX009 SQ-FS3 ST1404.2 +008200* X-XXX015 SQ-FS4 ST1404.2 +008300* X-XXX027 MERGE FILE ST-FS1 ST1404.2 +008400* X-55 SYSTEM PRINTER NAME. ST1404.2 +008500* X-82 SOURCE COMPUTER NAME. ST1404.2 +008600* X-83 OBJECT COMPUTER NAME. ST1404.2 +008700* ST1404.2 +008800* ST1404.2 +008900* OPTIONS RECOMMENDED - ST1404.2 +009000* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1404.2 +009100* FILES AS THEY ARE CREATED AND READ DURING ST1404.2 +009200* MRG-TESTS 3 THRU 8. ST1404.2 +009300* ST1404.2 +009400* ST1404.2 +009500* TEST DESCRIPTIONS - ST1404.2 +009600* BLD-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1404.2 +009700* BLD-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1404.2 +009800* BLD-TEST-003 CHECKS THE CREATION OF SQ-FS3 ST1404.2 +009900* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS4 ST1404.2 +010000* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS4 ST1404.2 +010100* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS4 ST1404.2 +010200* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS4 ST1404.2 +010300* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS4 ST1404.2 +010400* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS4ST1404.2 +010500* MRG-TEST-009 AN EOF CHECK ON SQ-FS4 ST1404.2 +010600* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1404.2 +010700* RECORD ON SQ-FS4 EQUALS 102 ST1404.2 +010800* ST1404.2 +010900* ST1404.2 +011000* ************************************************************ ST1404.2 +011100 ENVIRONMENT DIVISION. ST1404.2 +011200 CONFIGURATION SECTION. ST1404.2 +011300 SOURCE-COMPUTER. ST1404.2 +011400 XXXXX082. ST1404.2 +011500 OBJECT-COMPUTER. ST1404.2 +011600 XXXXX083. ST1404.2 +011700 SPECIAL-NAMES. ST1404.2 +011800 ALPHABET MY-FAVORITE-ALPHABET IS STANDARD-1. ST1404.2 +011900 INPUT-OUTPUT SECTION. ST1404.2 +012000 FILE-CONTROL. ST1404.2 +012100 SELECT PRINT-FILE ASSIGN TO ST1404.2 +012200 XXXXX055. ST1404.2 +012300 SELECT SQ-FS1 ASSIGN ST1404.2 +012400 XXXXX008 ST1404.2 +012500 ; ORGANIZATION IS SEQUENTIAL ST1404.2 +012600 ACCESS MODE SEQUENTIAL ST1404.2 +012700 RESERVE 2 AREAS. ST1404.2 +012800 SELECT SQ-FS2 ASSIGN TO ST1404.2 +012900 XXXXX014 ST1404.2 +013000 ORGANIZATION IS SEQUENTIAL ST1404.2 +013100 ACCESS MODE IS SEQUENTIAL ST1404.2 +013200 RESERVE 4 AREAS. ST1404.2 +013300 SELECT SQ-FS3 ASSIGN TO ST1404.2 +013400 XXXXX009 ST1404.2 +013500 ORGANIZATION SEQUENTIAL ST1404.2 +013600 ; ACCESS MODE IS SEQUENTIAL ST1404.2 +013700 RESERVE 6 AREAS. ST1404.2 +013800 SELECT SQ-FS4 ASSIGN TO ST1404.2 +013900 XXXXX015 ST1404.2 +014000 ORGANIZATION IS SEQUENTIAL ST1404.2 +014100 ; ACCESS MODE IS SEQUENTIAL ST1404.2 +014200 RESERVE 4 AREAS. ST1404.2 +014300 SELECT ST-FS1 ASSIGN TO ST1404.2 +014400 XXXXX027. ST1404.2 +014500 I-O-CONTROL. ST1404.2 +014600 SAME SORT AREA FOR SQ-FS1 ST-FS1, ST1404.2 +014700 MULTIPLE FILE TAPE CONTAINS SQ-FS1 POSITION 1 ST1404.2 +014800 SQ-FS3 POSITION 2. ST1404.2 +014900 DATA DIVISION. ST1404.2 +015000 FILE SECTION. ST1404.2 +015100 FD PRINT-FILE. ST1404.2 +015200 01 PRINT-REC PICTURE X(120). ST1404.2 +015300 01 DUMMY-RECORD PICTURE X(120). ST1404.2 +015400 FD SQ-FS1 ST1404.2 +015500 LABEL RECORDS STANDARD ST1404.2 +015600C VALUE OF ST1404.2 +015700C XXXXX074 ST1404.2 +015800C IS ST1404.2 +015900C XXXXX075 ST1404.2 +016000G XXXXX069 ST1404.2 +016100 BLOCK CONTAINS 1 RECORDS ST1404.2 +016200 RECORD CONTAINS 132 CHARACTERS ST1404.2 +016300 DATA RECORDS SQ-FS1R1-F-G-132, SQ-FS1R2-F-G-132. ST1404.2 +016400 01 SQ-FS1R1-F-G-132. ST1404.2 +016500 10 REC-PREAMBLE PIC X(120). ST1404.2 +016600 10 REST-OF-1. ST1404.2 +016700 20 KEY-1. ST1404.2 +016800 30 ALPHAN-KEY PIC X. ST1404.2 +016900 30 NUM-KEY PIC 999. ST1404.2 +017000 20 KEY-2. ST1404.2 +017100 30 ALPHAN-KEY PIC X. ST1404.2 +017200 30 NUM-KEY PIC 999. ST1404.2 +017300 20 KEY-3. ST1404.2 +017400 30 ALPHAN-KEY PIC X. ST1404.2 +017500 30 NUM-KEY PIC 999. ST1404.2 +017600 01 SQ-FS1R2-F-G-132. ST1404.2 +017700 02 FILLER PIC X(120). ST1404.2 +017800 02 GARBAGE PIC X(12). ST1404.2 +017900 FD SQ-FS2 ST1404.2 +018000 LABEL RECORD STANDARD ST1404.2 +018100C VALUE OF ST1404.2 +018200C XXXXX074 ST1404.2 +018300C IS ST1404.2 +018400C XXXXX076 ST1404.2 +018500G XXXXX069 ST1404.2 +018600 BLOCK CONTAINS 2 RECORDS ST1404.2 +018700 RECORD CONTAINS 132 CHARACTERS ST1404.2 +018800 DATA RECORD SQ-FS2R1-F-G-132. ST1404.2 +018900 01 SQ-FS2R1-F-G-132. ST1404.2 +019000 10 REC-PRE-2 PIC X(120). ST1404.2 +019100 10 REST-OF-2. ST1404.2 +019200 20 KEY-4. ST1404.2 +019300 30 ALPHAN-KEY PIC X. ST1404.2 +019400 30 NUM-KEY PIC 999. ST1404.2 +019500 20 KEY-5. ST1404.2 +019600 30 ALPHAN-KEY PIC X. ST1404.2 +019700 30 NUM-KEY PIC 999. ST1404.2 +019800 20 KEY-6. ST1404.2 +019900 30 ALPHAN-KEY PIC X. ST1404.2 +020000 30 NUM-KEY PIC 999. ST1404.2 +020100 FD SQ-FS3 ST1404.2 +020200 LABEL RECORDS STANDARD ST1404.2 +020300C VALUE OF ST1404.2 +020400C XXXXX074 ST1404.2 +020500C IS ST1404.2 +020600C XXXXX077 ST1404.2 +020700G XXXXX069 ST1404.2 +020800 BLOCK CONTAINS 1 RECORDS ST1404.2 +020900 RECORD CONTAINS 132 CHARACTERS ST1404.2 +021000 DATA RECORD SQ-FS3R1-F-G-132. ST1404.2 +021100 01 SQ-FS3R1-F-G-132. ST1404.2 +021200 10 REC-PRE-3 PIC X(120). ST1404.2 +021300 10 REST-OF-3. ST1404.2 +021400 20 KEY-7. ST1404.2 +021500 30 ALPHAN-KEY PIC X. ST1404.2 +021600 30 NUM-KEY PIC 999. ST1404.2 +021700 20 KEY-8. ST1404.2 +021800 30 ALPHAN-KEY PIC X. ST1404.2 +021900 30 NUM-KEY PIC 999. ST1404.2 +022000 20 KEY-9. ST1404.2 +022100 30 ALPHAN-KEY PIC X. ST1404.2 +022200 30 NUM-KEY PIC 999. ST1404.2 +022300 FD SQ-FS4 ST1404.2 +022400 LABEL RECORD IS STANDARD ST1404.2 +022500C ; VALUE OF ST1404.2 +022600C XXXXX074 ST1404.2 +022700C IS ST1404.2 +022800C XXXXX078 ST1404.2 +022900G XXXXX069 ST1404.2 +023000 ; BLOCK CONTAINS 3 RECORDS ST1404.2 +023100 RECORD CONTAINS 132 CHARACTERS ST1404.2 +023200 DATA RECORD SQ-FS4R1-F-G-132. ST1404.2 +023300 01 SQ-FS4R1-F-G-132. ST1404.2 +023400 10 REC-PRE-4 PIC X(120). ST1404.2 +023500 10 REST-OF-4. ST1404.2 +023600 20 KEY-10. ST1404.2 +023700 30 ALPHAN-KEY PIC X. ST1404.2 +023800 30 NUM-KEY PIC 999. ST1404.2 +023900 20 KEY-11. ST1404.2 +024000 30 ALPHAN-KEY PIC X. ST1404.2 +024100 30 NUM-KEY PIC 999. ST1404.2 +024200 20 KEY-12. ST1404.2 +024300 30 ALPHAN-KEY PIC X. ST1404.2 +024400 30 NUM-KEY PIC 999. ST1404.2 +024500 SD ST-FS1 ST1404.2 +024600 RECORD CONTAINS 132 CHARACTERS ST1404.2 +024700 DATA RECORD IS ST-FS1R1-F-G-132. ST1404.2 +024800 01 ST-FS1R1-F-G-132. ST1404.2 +024900 02 FILLER PIC X(120). ST1404.2 +025000 02 NON-KEY-1. ST1404.2 +025100 03 A-KEY PIC X. ST1404.2 +025200 03 N-KEY PIC 999. ST1404.2 +025300 02 SORT-KEY. ST1404.2 +025400 03 A-KEY PIC X. ST1404.2 +025500 03 N-KEY PIC 999. ST1404.2 +025600 02 NON-KEY-2. ST1404.2 +025700 03 A-KEY PIC X. ST1404.2 +025800 03 N-KEY PIC 999. ST1404.2 +025900 WORKING-STORAGE SECTION. ST1404.2 +026000 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1404.2 +026100 77 WRK-DU-999-0001 PIC 999. ST1404.2 +026200 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1404.2 +026300 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1404.2 +026400 01 WRK-XN-0001 PIC X(51) VALUE ST1404.2 +026500 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1404.2 +026600 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1404.2 +026700 02 CHAR PIC X OCCURS 51 TIMES. ST1404.2 +026800 01 WRK-XN-2 PIC X(51) VALUE ST1404.2 +026900 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1404.2 +027000 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1404.2 +027100 02 ASCIIS PIC X OCCURS 51 TIMES. ST1404.2 +027200 01 WRK-XN-O020F-0001. ST1404.2 +027300 02 COMPU PIC X OCCURS 20 TIMES. ST1404.2 +027400 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1404.2 +027500 02 FILLER PIC X(20). ST1404.2 +027600 01 WRK-XN-O120F-1. ST1404.2 +027700 02 COLLS PIC X OCCURS 120 TIMES. ST1404.2 +027800 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1404.2 +027900 02 WRK-XN-0002 PIC X(20). ST1404.2 +028000 02 WRK-XN-0003 PIC X(20). ST1404.2 +028100 02 WRK-XN-0004 PIC X(20). ST1404.2 +028200 02 WRK-XN-0005 PIC X(20). ST1404.2 +028300 02 WRK-XN-0006 PIC X(20). ST1404.2 +028400 02 WRK-XN-0007 PIC X(20). ST1404.2 +028500 01 FILE-RECORD-INFORMATION-REC. ST1404.2 +028600 03 FILE-RECORD-INFO-SKELETON. ST1404.2 +028700 05 FILLER PICTURE X(48) VALUE ST1404.2 +028800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1404.2 +028900 05 FILLER PICTURE X(46) VALUE ST1404.2 +029000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1404.2 +029100 05 FILLER PICTURE X(26) VALUE ST1404.2 +029200 ",LFIL=000000,ORG= ,LBLR= ". ST1404.2 +029300 05 FILLER PICTURE X(37) VALUE ST1404.2 +029400 ",RECKEY= ". ST1404.2 +029500 05 FILLER PICTURE X(38) VALUE ST1404.2 +029600 ",ALTKEY1= ". ST1404.2 +029700 05 FILLER PICTURE X(38) VALUE ST1404.2 +029800 ",ALTKEY2= ". ST1404.2 +029900 05 FILLER PICTURE X(7) VALUE SPACE.ST1404.2 +030000 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1404.2 +030100 05 FILE-RECORD-INFO-P1-120. ST1404.2 +030200 07 FILLER PIC X(5). ST1404.2 +030300 07 XFILE-NAME PIC X(6). ST1404.2 +030400 07 FILLER PIC X(8). ST1404.2 +030500 07 XRECORD-NAME PIC X(6). ST1404.2 +030600 07 FILLER PIC X(1). ST1404.2 +030700 07 REELUNIT-NUMBER PIC 9(1). ST1404.2 +030800 07 FILLER PIC X(7). ST1404.2 +030900 07 XRECORD-NUMBER PIC 9(6). ST1404.2 +031000 07 FILLER PIC X(6). ST1404.2 +031100 07 UPDATE-NUMBER PIC 9(2). ST1404.2 +031200 07 FILLER PIC X(5). ST1404.2 +031300 07 ODO-NUMBER PIC 9(4). ST1404.2 +031400 07 FILLER PIC X(5). ST1404.2 +031500 07 XPROGRAM-NAME PIC X(5). ST1404.2 +031600 07 FILLER PIC X(7). ST1404.2 +031700 07 XRECORD-LENGTH PIC 9(6). ST1404.2 +031800 07 FILLER PIC X(7). ST1404.2 +031900 07 CHARS-OR-RECORDS PIC X(2). ST1404.2 +032000 07 FILLER PIC X(1). ST1404.2 +032100 07 XBLOCK-SIZE PIC 9(4). ST1404.2 +032200 07 FILLER PIC X(6). ST1404.2 +032300 07 RECORDS-IN-FILE PIC 9(6). ST1404.2 +032400 07 FILLER PIC X(5). ST1404.2 +032500 07 XFILE-ORGANIZATION PIC X(2). ST1404.2 +032600 07 FILLER PIC X(6). ST1404.2 +032700 07 XLABEL-TYPE PIC X(1). ST1404.2 +032800 05 FILE-RECORD-INFO-P121-240. ST1404.2 +032900 07 FILLER PIC X(8). ST1404.2 +033000 07 XRECORD-KEY PIC X(29). ST1404.2 +033100 07 FILLER PIC X(9). ST1404.2 +033200 07 ALTERNATE-KEY1 PIC X(29). ST1404.2 +033300 07 FILLER PIC X(9). ST1404.2 +033400 07 ALTERNATE-KEY2 PIC X(29). ST1404.2 +033500 07 FILLER PIC X(7). ST1404.2 +033600 01 TEST-RESULTS. ST1404.2 +033700 02 FILLER PIC X VALUE SPACE. ST1404.2 +033800 02 FEATURE PIC X(20) VALUE SPACE. ST1404.2 +033900 02 FILLER PIC X VALUE SPACE. ST1404.2 +034000 02 P-OR-F PIC X(5) VALUE SPACE. ST1404.2 +034100 02 FILLER PIC X VALUE SPACE. ST1404.2 +034200 02 PAR-NAME. ST1404.2 +034300 03 FILLER PIC X(19) VALUE SPACE. ST1404.2 +034400 03 PARDOT-X PIC X VALUE SPACE. ST1404.2 +034500 03 DOTVALUE PIC 99 VALUE ZERO. ST1404.2 +034600 02 FILLER PIC X(8) VALUE SPACE. ST1404.2 +034700 02 RE-MARK PIC X(61). ST1404.2 +034800 01 TEST-COMPUTED. ST1404.2 +034900 02 FILLER PIC X(30) VALUE SPACE. ST1404.2 +035000 02 FILLER PIC X(17) VALUE ST1404.2 +035100 " COMPUTED=". ST1404.2 +035200 02 COMPUTED-X. ST1404.2 +035300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1404.2 +035400 03 COMPUTED-N REDEFINES COMPUTED-A ST1404.2 +035500 PIC -9(9).9(9). ST1404.2 +035600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1404.2 +035700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1404.2 +035800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1404.2 +035900 03 CM-18V0 REDEFINES COMPUTED-A. ST1404.2 +036000 04 COMPUTED-18V0 PIC -9(18). ST1404.2 +036100 04 FILLER PIC X. ST1404.2 +036200 03 FILLER PIC X(50) VALUE SPACE. ST1404.2 +036300 01 TEST-CORRECT. ST1404.2 +036400 02 FILLER PIC X(30) VALUE SPACE. ST1404.2 +036500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1404.2 +036600 02 CORRECT-X. ST1404.2 +036700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1404.2 +036800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1404.2 +036900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1404.2 +037000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1404.2 +037100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1404.2 +037200 03 CR-18V0 REDEFINES CORRECT-A. ST1404.2 +037300 04 CORRECT-18V0 PIC -9(18). ST1404.2 +037400 04 FILLER PIC X. ST1404.2 +037500 03 FILLER PIC X(2) VALUE SPACE. ST1404.2 +037600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1404.2 +037700 01 CCVS-C-1. ST1404.2 +037800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1404.2 +037900- "SS PARAGRAPH-NAME ST1404.2 +038000- " REMARKS". ST1404.2 +038100 02 FILLER PIC X(20) VALUE SPACE. ST1404.2 +038200 01 CCVS-C-2. ST1404.2 +038300 02 FILLER PIC X VALUE SPACE. ST1404.2 +038400 02 FILLER PIC X(6) VALUE "TESTED". ST1404.2 +038500 02 FILLER PIC X(15) VALUE SPACE. ST1404.2 +038600 02 FILLER PIC X(4) VALUE "FAIL". ST1404.2 +038700 02 FILLER PIC X(94) VALUE SPACE. ST1404.2 +038800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1404.2 +038900 01 REC-CT PIC 99 VALUE ZERO. ST1404.2 +039000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1404.2 +039500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1404.2 +039600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1404.2 +039700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1404.2 +039800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1404.2 +039900 01 CCVS-H-1. ST1404.2 +040000 02 FILLER PIC X(39) VALUE SPACES. ST1404.2 +040100 02 FILLER PIC X(42) VALUE ST1404.2 +040200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1404.2 +040300 02 FILLER PIC X(39) VALUE SPACES. ST1404.2 +040400 01 CCVS-H-2A. ST1404.2 +040500 02 FILLER PIC X(40) VALUE SPACE. ST1404.2 +040600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1404.2 +040700 02 FILLER PIC XXXX VALUE ST1404.2 +040800 "4.2 ". ST1404.2 +040900 02 FILLER PIC X(28) VALUE ST1404.2 +041000 " COPY - NOT FOR DISTRIBUTION". ST1404.2 +041100 02 FILLER PIC X(41) VALUE SPACE. ST1404.2 +041200 ST1404.2 +041300 01 CCVS-H-2B. ST1404.2 +041400 02 FILLER PIC X(15) VALUE ST1404.2 +041500 "TEST RESULT OF ". ST1404.2 +041600 02 TEST-ID PIC X(9). ST1404.2 +041700 02 FILLER PIC X(4) VALUE ST1404.2 +041800 " IN ". ST1404.2 +041900 02 FILLER PIC X(12) VALUE ST1404.2 +042000 " HIGH ". ST1404.2 +042100 02 FILLER PIC X(22) VALUE ST1404.2 +042200 " LEVEL VALIDATION FOR ". ST1404.2 +042300 02 FILLER PIC X(58) VALUE ST1404.2 +042400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +042500 01 CCVS-H-3. ST1404.2 +042600 02 FILLER PIC X(34) VALUE ST1404.2 +042700 " FOR OFFICIAL USE ONLY ". ST1404.2 +042800 02 FILLER PIC X(58) VALUE ST1404.2 +042900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1404.2 +043000 02 FILLER PIC X(28) VALUE ST1404.2 +043100 " COPYRIGHT 1985 ". ST1404.2 +043200 01 CCVS-E-1. ST1404.2 +043300 02 FILLER PIC X(52) VALUE SPACE. ST1404.2 +043400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1404.2 +043500 02 ID-AGAIN PIC X(9). ST1404.2 +043600 02 FILLER PIC X(45) VALUE SPACES. ST1404.2 +043700 01 CCVS-E-2. ST1404.2 +043800 02 FILLER PIC X(31) VALUE SPACE. ST1404.2 +043900 02 FILLER PIC X(21) VALUE SPACE. ST1404.2 +044000 02 CCVS-E-2-2. ST1404.2 +044100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1404.2 +044200 03 FILLER PIC X VALUE SPACE. ST1404.2 +044300 03 ENDER-DESC PIC X(44) VALUE ST1404.2 +044400 "ERRORS ENCOUNTERED". ST1404.2 +044500 01 CCVS-E-3. ST1404.2 +044600 02 FILLER PIC X(22) VALUE ST1404.2 +044700 " FOR OFFICIAL USE ONLY". ST1404.2 +044800 02 FILLER PIC X(12) VALUE SPACE. ST1404.2 +044900 02 FILLER PIC X(58) VALUE ST1404.2 +045000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +045100 02 FILLER PIC X(13) VALUE SPACE. ST1404.2 +045200 02 FILLER PIC X(15) VALUE ST1404.2 +045300 " COPYRIGHT 1985". ST1404.2 +045400 01 CCVS-E-4. ST1404.2 +045500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1404.2 +045600 02 FILLER PIC X(4) VALUE " OF ". ST1404.2 +045700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1404.2 +045800 02 FILLER PIC X(40) VALUE ST1404.2 +045900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1404.2 +046000 01 XXINFO. ST1404.2 +046100 02 FILLER PIC X(19) VALUE ST1404.2 +046200 "*** INFORMATION ***". ST1404.2 +046300 02 INFO-TEXT. ST1404.2 +046400 04 FILLER PIC X(8) VALUE SPACE. ST1404.2 +046500 04 XXCOMPUTED PIC X(20). ST1404.2 +046600 04 FILLER PIC X(5) VALUE SPACE. ST1404.2 +046700 04 XXCORRECT PIC X(20). ST1404.2 +046800 02 INF-ANSI-REFERENCE PIC X(48). ST1404.2 +046900 01 HYPHEN-LINE. ST1404.2 +047000 02 FILLER PIC IS X VALUE IS SPACE. ST1404.2 +047100 02 FILLER PIC IS X(65) VALUE IS "************************ST1404.2 +047200- "*****************************************". ST1404.2 +047300 02 FILLER PIC IS X(54) VALUE IS "************************ST1404.2 +047400- "******************************". ST1404.2 +047500 01 CCVS-PGM-ID PIC X(9) VALUE ST1404.2 +047600 "ST140A". ST1404.2 +047700 PROCEDURE DIVISION. ST1404.2 +047800 DECLARATIVES. ST1404.2 +047900 SECT-ST210-DEC SECTION. ST1404.2 +048000 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. ST1404.2 +048100 SRT-WRITE-DEC. ST1404.2 +048200 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1404.2 +048300 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1404.2 +048400 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1404.2 +048500 STOP RUN. ST1404.2 +048600 END DECLARATIVES. ST1404.2 +048700 CCVS1 SECTION. ST1404.2 +048800 OPEN-FILES. ST1404.2 +048900 OPEN OUTPUT PRINT-FILE. ST1404.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1404.2 +049100 MOVE SPACE TO TEST-RESULTS. ST1404.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1404.2 +049300 MOVE ZERO TO REC-SKL-SUB. ST1404.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. ST1404.2 +049500 CCVS-INIT-FILE. ST1404.2 +049600 ADD 1 TO REC-SKL-SUB. ST1404.2 +049700 MOVE FILE-RECORD-INFO-SKELETON ST1404.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1404.2 +049900 CCVS-INIT-EXIT. ST1404.2 +050000 GO TO CCVS1-EXIT. ST1404.2 +050100 CLOSE-FILES. ST1404.2 +050200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1404.2 +050300 TERMINATE-CCVS. ST1404.2 +050400S EXIT PROGRAM. ST1404.2 +050500STERMINATE-CALL. ST1404.2 +050600 STOP RUN. ST1404.2 +050700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1404.2 +050800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1404.2 +050900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1404.2 +051000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1404.2 +051100 MOVE "****TEST DELETED****" TO RE-MARK. ST1404.2 +051200 PRINT-DETAIL. ST1404.2 +051300 IF REC-CT NOT EQUAL TO ZERO ST1404.2 +051400 MOVE "." TO PARDOT-X ST1404.2 +051500 MOVE REC-CT TO DOTVALUE. ST1404.2 +051600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1404.2 +051700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1404.2 +051800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1404.2 +051900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1404.2 +052000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1404.2 +052100 MOVE SPACE TO CORRECT-X. ST1404.2 +052200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1404.2 +052300 MOVE SPACE TO RE-MARK. ST1404.2 +052400 HEAD-ROUTINE. ST1404.2 +052500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +052600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +052700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1404.2 +052800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1404.2 +052900 COLUMN-NAMES-ROUTINE. ST1404.2 +053000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +053100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +053200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +053300 END-ROUTINE. ST1404.2 +053400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1404.2 +053500 END-RTN-EXIT. ST1404.2 +053600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +053700 END-ROUTINE-1. ST1404.2 +053800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1404.2 +053900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1404.2 +054000 ADD PASS-COUNTER TO ERROR-HOLD. ST1404.2 +054100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1404.2 +054200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1404.2 +054300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1404.2 +054400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1404.2 +054500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1404.2 +054600 END-ROUTINE-12. ST1404.2 +054700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1404.2 +054800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1404.2 +054900 MOVE "NO " TO ERROR-TOTAL ST1404.2 +055000 ELSE ST1404.2 +055100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1404.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1404.2 +055300 PERFORM WRITE-LINE. ST1404.2 +055400 END-ROUTINE-13. ST1404.2 +055500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1404.2 +055600 MOVE "NO " TO ERROR-TOTAL ELSE ST1404.2 +055700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1404.2 +055800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1404.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056000 IF INSPECT-COUNTER EQUAL TO ZERO ST1404.2 +056100 MOVE "NO " TO ERROR-TOTAL ST1404.2 +056200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1404.2 +056300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1404.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056600 WRITE-LINE. ST1404.2 +056700 ADD 1 TO RECORD-COUNT. ST1404.2 +056800Y IF RECORD-COUNT GREATER 42 ST1404.2 +056900Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1404.2 +057000Y MOVE SPACE TO DUMMY-RECORD ST1404.2 +057100Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1404.2 +057200Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1404.2 +057300Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1404.2 +057400Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1404.2 +057500Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1404.2 +057600Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057700Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057800Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057900Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1404.2 +058000Y MOVE ZERO TO RECORD-COUNT. ST1404.2 +058100 PERFORM WRT-LN. ST1404.2 +058200 WRT-LN. ST1404.2 +058300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1404.2 +058400 MOVE SPACE TO DUMMY-RECORD. ST1404.2 +058500 BLANK-LINE-PRINT. ST1404.2 +058600 PERFORM WRT-LN. ST1404.2 +058700 FAIL-ROUTINE. ST1404.2 +058800 IF COMPUTED-X NOT EQUAL TO SPACE ST1404.2 +058900 GO TO FAIL-ROUTINE-WRITE. ST1404.2 +059000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1404.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1404.2 +059200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1404.2 +059300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1404.2 +059500 GO TO FAIL-ROUTINE-EX. ST1404.2 +059600 FAIL-ROUTINE-WRITE. ST1404.2 +059700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1404.2 +059800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1404.2 +059900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1404.2 +060000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1404.2 +060100 FAIL-ROUTINE-EX. EXIT. ST1404.2 +060200 BAIL-OUT. ST1404.2 +060300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1404.2 +060400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1404.2 +060500 BAIL-OUT-WRITE. ST1404.2 +060600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1404.2 +060700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1404.2 +060800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +060900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1404.2 +061000 BAIL-OUT-EX. EXIT. ST1404.2 +061100 CCVS1-EXIT. ST1404.2 +061200 EXIT. ST1404.2 +061300 SECT-ST210-0001 SECTION. ST1404.2 +061400 BLD-INIT-001. ST1404.2 +061500 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1404.2 +061600 OPEN OUTPUT SQ-FS1. ST1404.2 +061700 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1404.2 +061800 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1404.2 +061900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1404.2 +062000 MOVE 000132 TO XRECORD-LENGTH (1). ST1404.2 +062100 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1404.2 +062200 MOVE 0001 TO XBLOCK-SIZE (1). ST1404.2 +062300 MOVE 000051 TO RECORDS-IN-FILE (1). ST1404.2 +062400 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1404.2 +062500 MOVE "S" TO XLABEL-TYPE (1). ST1404.2 +062600 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +062700 MOVE SPACES TO WRK-XN-O120F-1. ST1404.2 +062800 BLD-TEST-001. ST1404.2 +062900 PERFORM BLD-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1404.2 +063000 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +063100X MOVE SPACES TO PRINT-REC. ST1404.2 +063200X WRITE PRINT-REC. ST1404.2 +063300 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1404.2 +063400 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +063500 ELSE ST1404.2 +063600 PERFORM PASS. ST1404.2 +063700 GO TO BLD-WRITE-001. ST1404.2 +063800 BLD-TEST-001-BUILD. ST1404.2 +063900 MOVE "JUNKSLOPJUNK" TO GARBAGE. ST1404.2 +064000 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1404.2 +064100 NUM-KEY OF KEY-3. ST1404.2 +064200 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1404.2 +064300 ADD 1 TO XRECORD-NUMBER (1). ST1404.2 +064400 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1404.2 +064500 ADD 1 TO WRK-DU-999-2. ST1404.2 +064600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1404.2 +064700 ADD 1 TO WRK-DU-999-2. ST1404.2 +064800X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1404.2 +064900X WRITE PRINT-REC FROM REST-OF-1. ST1404.2 +065000X MOVE SPACES TO PRINT-REC. ST1404.2 +065100 WRITE SQ-FS1R1-F-G-132. ST1404.2 +065200 BLD-DELETE-001. ST1404.2 +065300 PERFORM DE-LETE. ST1404.2 +065400 BLD-WRITE-001. ST1404.2 +065500 MOVE "BLD-TEST-001" TO PAR-NAME. ST1404.2 +065600 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1404.2 +065700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +065800 PERFORM PRINT-DETAIL. ST1404.2 +065900X MOVE SPACES TO PRINT-REC. ST1404.2 +066000X WRITE PRINT-REC. ST1404.2 +066100 CLOSE SQ-FS1 WITH NO REWIND. ST1404.2 +066200 BLD-INIT-002. ST1404.2 +066300 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1404.2 +066400 OPEN OUTPUT SQ-FS2. ST1404.2 +066500 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1404.2 +066600 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +066700 MOVE 0002 TO XBLOCK-SIZE (1). ST1404.2 +066800 BLD-TEST-002. ST1404.2 +066900 PERFORM BLD-TEST-002-BUILD VARYING WRK-DU-999-0001 FROM ST1404.2 +067000 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +067100X MOVE SPACES TO PRINT-REC. ST1404.2 +067200X WRITE PRINT-REC. ST1404.2 +067300 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1404.2 +067400 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +067500 ELSE ST1404.2 +067600 PERFORM PASS. ST1404.2 +067700 GO TO BLD-WRITE-002. ST1404.2 +067800 BLD-TEST-002-BUILD. ST1404.2 +067900 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1404.2 +068000 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1404.2 +068100 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1404.2 +068200 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1404.2 +068300 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1404.2 +068400 ADD 000001 TO XRECORD-NUMBER (1). ST1404.2 +068500X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1404.2 +068600X WRITE PRINT-REC FROM REST-OF-2. ST1404.2 +068700X MOVE SPACES TO PRINT-REC. ST1404.2 +068800 WRITE SQ-FS2R1-F-G-132. ST1404.2 +068900 BLD-DELETE-002. ST1404.2 +069000 PERFORM DE-LETE. ST1404.2 +069100 BLD-WRITE-002. ST1404.2 +069200 MOVE "BLD-TEST-002" TO PAR-NAME. ST1404.2 +069300 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1404.2 +069400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +069500 PERFORM PRINT-DETAIL. ST1404.2 +069600X MOVE SPACES TO PRINT-REC. ST1404.2 +069700X WRITE PRINT-REC. ST1404.2 +069800 CLOSE SQ-FS2. ST1404.2 +069900 BLD-INIT-003. ST1404.2 +070000 MOVE "CREATE FILE SQ-FS3" TO FEATURE. ST1404.2 +070100 MOVE "SQ-FS3" TO XFILE-NAME (1). ST1404.2 +070200 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +070300 MOVE 0001 TO XBLOCK-SIZE (1). ST1404.2 +070400 OPEN OUTPUT SQ-FS3. ST1404.2 +070500 BLD-TEST-003. ST1404.2 +070600 PERFORM BLD-TEST-003-BUILD VARYING WRK-DU-999-0001 FROM ST1404.2 +070700 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +070800X MOVE SPACES TO PRINT-REC. ST1404.2 +070900X WRITE PRINT-REC. ST1404.2 +071000 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1404.2 +071100 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +071200 ELSE ST1404.2 +071300 PERFORM PASS. ST1404.2 +071400 GO TO BLD-WRITE-003. ST1404.2 +071500 BLD-TEST-003-BUILD. ST1404.2 +071600 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-7 ST1404.2 +071700 ALPHAN-KEY OF KEY-8 ALPHAN-KEY OF KEY-9. ST1404.2 +071800 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-7 NUM-KEY OF KEY-8 ST1404.2 +071900 NUM-KEY OF KEY-9. ST1404.2 +072000 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-3. ST1404.2 +072100 ADD 000001 TO XRECORD-NUMBER (1). ST1404.2 +072200X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1404.2 +072300X WRITE PRINT-REC FROM REST-OF-3. ST1404.2 +072400X MOVE SPACES TO PRINT-REC. ST1404.2 +072500 WRITE SQ-FS3R1-F-G-132. ST1404.2 +072600 BLD-DELETE-003. ST1404.2 +072700 PERFORM DE-LETE. ST1404.2 +072800 BLD-WRITE-003. ST1404.2 +072900 MOVE "BLD-TEST-003" TO PAR-NAME. ST1404.2 +073000 MOVE "3RD FILE CREATED" TO COMPUTED-A. ST1404.2 +073100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +073200 PERFORM PRINT-DETAIL. ST1404.2 +073300X MOVE SPACES TO PRINT-REC. ST1404.2 +073400X WRITE PRINT-REC. ST1404.2 +073500 CLOSE SQ-FS3. ST1404.2 +073600 MRG-INIT-001. ST1404.2 +073700 MERGE ST-FS1 ST1404.2 +073800 ON DESCENDING KEY A-KEY OF SORT-KEY ST1404.2 +073900 ASCENDING N-KEY OF NON-KEY-2 ST1404.2 +074000 COLLATING SEQUENCE IS MY-FAVORITE-ALPHABET ST1404.2 +074100 USING SQ-FS2, SQ-FS3 ST1404.2 +074200 OUTPUT PROCEDURE IS SECT-ST210-0002. ST1404.2 +074300 SRT-TEST-003. ST1404.2 +074400 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +074500 OPEN INPUT SQ-FS4. ST1404.2 +074600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +074700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +074800X MOVE SPACES TO PRINT-REC. ST1404.2 +074900X WRITE PRINT-REC. ST1404.2 +075000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1404.2 +075100 PERFORM FAIL GO TO SRT-FAIL-003 ST1404.2 +075200 ELSE ST1404.2 +075300 PERFORM PASS. ST1404.2 +075400 GO TO SRT-WRITE-003. ST1404.2 +075500 SRT-DELETE-003. ST1404.2 +075600 PERFORM DE-LETE. ST1404.2 +075700 GO TO SRT-WRITE-003. ST1404.2 +075800 SRT-FAIL-003. ST1404.2 +075900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +076000 MOVE WRK-XN-0002 TO CORRECT-A. ST1404.2 +076100 SRT-WRITE-003. ST1404.2 +076200 MOVE "MRG-TEST-003" TO PAR-NAME. ST1404.2 +076300 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +076400 PERFORM PRINT-DETAIL. ST1404.2 +076500X MOVE SPACES TO PRINT-REC. ST1404.2 +076600X WRITE PRINT-REC. ST1404.2 +076700 SRT-INIT-004. ST1404.2 +076800 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +076900 SRT-TEST-004. ST1404.2 +077000 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +077100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +077200X MOVE SPACES TO PRINT-REC. ST1404.2 +077300X WRITE PRINT-REC. ST1404.2 +077400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1404.2 +077500 PERFORM FAIL GO TO SRT-FAIL-004 ST1404.2 +077600 ELSE ST1404.2 +077700 PERFORM PASS. ST1404.2 +077800 GO TO SRT-WRITE-004. ST1404.2 +077900 SRT-DELETE-004. ST1404.2 +078000 PERFORM DE-LETE. ST1404.2 +078100 GO TO SRT-WRITE-004. ST1404.2 +078200 SRT-FAIL-004. ST1404.2 +078300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +078400 MOVE WRK-XN-0003 TO CORRECT-A. ST1404.2 +078500 SRT-WRITE-004. ST1404.2 +078600 MOVE "MRG-TEST-004" TO PAR-NAME. ST1404.2 +078700 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +078800 PERFORM PRINT-DETAIL. ST1404.2 +078900X MOVE SPACES TO PRINT-REC. ST1404.2 +079000X WRITE PRINT-REC. ST1404.2 +079100 SRT-INIT-005. ST1404.2 +079200 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +079300 SRT-TEST-005. ST1404.2 +079400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +079500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +079600X MOVE SPACES TO PRINT-REC. ST1404.2 +079700X WRITE PRINT-REC. ST1404.2 +079800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1404.2 +079900 PERFORM FAIL GO TO SRT-FAIL-005 ST1404.2 +080000 ELSE ST1404.2 +080100 PERFORM PASS. ST1404.2 +080200 GO TO SRT-WRITE-005. ST1404.2 +080300 SRT-DELETE-005. ST1404.2 +080400 PERFORM DE-LETE. ST1404.2 +080500 GO TO SRT-WRITE-005. ST1404.2 +080600 SRT-FAIL-005. ST1404.2 +080700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +080800 MOVE WRK-XN-0004 TO CORRECT-A. ST1404.2 +080900 SRT-WRITE-005. ST1404.2 +081000 MOVE "MRG-TEST-005" TO PAR-NAME. ST1404.2 +081100 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +081200 PERFORM PRINT-DETAIL. ST1404.2 +081300X MOVE SPACES TO PRINT-REC. ST1404.2 +081400X WRITE PRINT-REC. ST1404.2 +081500 SRT-INIT-006. ST1404.2 +081600 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +081700 SRT-TEST-006. ST1404.2 +081800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +081900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +082000X MOVE SPACES TO PRINT-REC. ST1404.2 +082100X WRITE PRINT-REC. ST1404.2 +082200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1404.2 +082300 PERFORM FAIL GO TO SRT-FAIL-006 ST1404.2 +082400 ELSE ST1404.2 +082500 PERFORM PASS. ST1404.2 +082600 GO TO SRT-WRITE-006. ST1404.2 +082700 SRT-DELETE-006. ST1404.2 +082800 PERFORM DE-LETE. ST1404.2 +082900 GO TO SRT-WRITE-006. ST1404.2 +083000 SRT-FAIL-006. ST1404.2 +083100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +083200 MOVE WRK-XN-0005 TO CORRECT-A. ST1404.2 +083300 SRT-WRITE-006. ST1404.2 +083400 MOVE "MRG-TEST-006" TO PAR-NAME. ST1404.2 +083500 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +083600 PERFORM PRINT-DETAIL. ST1404.2 +083700X MOVE SPACES TO PRINT-REC. ST1404.2 +083800X WRITE PRINT-REC. ST1404.2 +083900 SRT-INIT-007. ST1404.2 +084000 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +084100 SRT-TEST-007. ST1404.2 +084200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +084300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +084400X MOVE SPACES TO PRINT-REC. ST1404.2 +084500X WRITE PRINT-REC. ST1404.2 +084600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1404.2 +084700 PERFORM FAIL GO TO SRT-FAIL-007 ST1404.2 +084800 ELSE ST1404.2 +084900 PERFORM PASS. ST1404.2 +085000 GO TO SRT-WRITE-007. ST1404.2 +085100 SRT-DELETE-007. ST1404.2 +085200 PERFORM DE-LETE. ST1404.2 +085300 GO TO SRT-WRITE-007. ST1404.2 +085400 SRT-FAIL-007. ST1404.2 +085500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +085600 MOVE WRK-XN-0006 TO CORRECT-A. ST1404.2 +085700 SRT-WRITE-007. ST1404.2 +085800 MOVE "MRG-TEST-007" TO PAR-NAME. ST1404.2 +085900 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +086000 PERFORM PRINT-DETAIL. ST1404.2 +086100X MOVE SPACES TO PRINT-REC. ST1404.2 +086200X WRITE PRINT-REC. ST1404.2 +086300 SRT-INIT-008. ST1404.2 +086400 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +086500 SRT-TEST-008. ST1404.2 +086600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +086700 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1404.2 +086800X MOVE SPACES TO PRINT-REC. ST1404.2 +086900X WRITE PRINT-REC. ST1404.2 +087000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1404.2 +087100 PERFORM FAIL GO TO SRT-FAIL-008 ST1404.2 +087200 ELSE ST1404.2 +087300 PERFORM PASS. ST1404.2 +087400 GO TO SRT-WRITE-008. ST1404.2 +087500 SRT-DELETE-008. ST1404.2 +087600 PERFORM DE-LETE. ST1404.2 +087700 GO TO SRT-WRITE-008. ST1404.2 +087800 SRT-FAIL-008. ST1404.2 +087900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +088000 MOVE WRK-XN-0007 TO CORRECT-A. ST1404.2 +088100 SRT-WRITE-008. ST1404.2 +088200 MOVE "MRG-TEST-008" TO PAR-NAME. ST1404.2 +088300 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +088400 PERFORM PRINT-DETAIL. ST1404.2 +088500 MOVE NUM-KEY OF KEY-11 TO LAST-REC-NUM. ST1404.2 +088600 SRT-TEST-009. ST1404.2 +088700 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1404.2 +088800 GO TO SRT-FAIL-009. ST1404.2 +088900 READ SQ-FS4 AT END PERFORM PASS ST1404.2 +089000 GO TO SRT-WRITE-009. ST1404.2 +089100 GO TO SRT-FAIL-009. ST1404.2 +089200 SRT-DELETE-009. ST1404.2 +089300 PERFORM DE-LETE. ST1404.2 +089400 GO TO SRT-WRITE-009. ST1404.2 +089500 SRT-FAIL-009. ST1404.2 +089600 MOVE "EOF NOT FOUND" TO RE-MARK. ST1404.2 +089700 PERFORM FAIL . ST1404.2 +089800 SRT-WRITE-009. ST1404.2 +089900 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1404.2 +090000 MOVE "MRG-TEST-009" TO PAR-NAME. ST1404.2 +090100 PERFORM PRINT-DETAIL. ST1404.2 +090200 SRT-TEST-010. ST1404.2 +090300 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1404.2 +090400 PERFORM FAIL GO TO SRT-FAIL-010 ST1404.2 +090500 ELSE ST1404.2 +090600 PERFORM PASS. ST1404.2 +090700 GO TO SRT-WRITE-010. ST1404.2 +090800 SRT-DELETE-010. ST1404.2 +090900 PERFORM DE-LETE. ST1404.2 +091000 GO TO SRT-WRITE-010. ST1404.2 +091100 SRT-FAIL-010. ST1404.2 +091200 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1404.2 +091300 MOVE 102 TO CR-18V0. ST1404.2 +091400 SRT-WRITE-010. ST1404.2 +091500 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1404.2 +091600 MOVE "MRG-TEST-010" TO PAR-NAME. ST1404.2 +091700 PERFORM PRINT-DETAIL. ST1404.2 +091800 CLOSE SQ-FS4. ST1404.2 +091900 GO TO CCVS-999999. ST1404.2 +092000 READ-SQ-FS1 SECTION. ST1404.2 +092100 RD-1. ST1404.2 +092200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1404.2 +092300 GO TO R1-EXIT. ST1404.2 +092400 READ SQ-FS4 AT END GO TO PREMATURE-EOF. ST1404.2 +092500 MOVE ALPHAN-KEY OF KEY-12 TO COMPU (WRK-DU-999-0001). ST1404.2 +092600 GO TO R1-EXIT. ST1404.2 +092700 PREMATURE-EOF. ST1404.2 +092800 MOVE 1 TO WRK-DU-9-0001. ST1404.2 +092900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1404.2 +093000 R1-EXIT. ST1404.2 +093100 EXIT. ST1404.2 +093200 SECT-ST210-0002 SECTION. ST1404.2 +093300 SORT-OUTPUT-PROC. ST1404.2 +093400 OPEN OUTPUT SQ-FS4. ST1404.2 +093500 RETURN-THE-OLD-RECORDS. ST1404.2 +093600 RETURN ST-FS1 RECORD INTO SQ-FS4R1-F-G-132 ST1404.2 +093700 AT END GO TO CLOSE-AFTER-SORT. ST1404.2 +093800X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1404.2 +093900X WRITE PRINT-REC FROM REST-OF-4. ST1404.2 +094000X MOVE SPACES TO PRINT-REC. ST1404.2 +094100 WRITE SQ-FS4R1-F-G-132. ST1404.2 +094200 GO TO RETURN-THE-OLD-RECORDS. ST1404.2 +094300 CLOSE-AFTER-SORT. ST1404.2 +094400 CLOSE SQ-FS4. ST1404.2 +094500 CCVS-EXIT SECTION. ST1404.2 +094600 CCVS-999999. ST1404.2 +094700 GO TO CLOSE-FILES. ST1404.2 +*END-OF,ST140A TES10060 +*HEADER,COBOL,ST144A +000100 IDENTIFICATION DIVISION. ST1444.2 +000200 PROGRAM-ID. ST1444.2 +000300 ST144A. ST1444.2 +000400**************************************************************** ST1444.2 +000500* * ST1444.2 +000600* VALIDATION FOR:- * ST1444.2 +000700* * ST1444.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +000900* * ST1444.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1444.2 +001100* * ST1444.2 +001200**************************************************************** ST1444.2 +001300* ST1444.2 +001400* OBJECTIVE - ST1444.2 +001500* ROUTINE ST144A IS A TEST OF THE MERGE STATEMENT USING ST1444.2 +001600* A NATIVE COLLATING SEQUENCE AND MULTIPLE FILE TAPE. ST1444.2 +001700* THIS ROUTINE IS A TEST OF THE COMPILERS ABILITY TO MERGE ST1444.2 +001800* THE SECOND FILE OF A MULTI-FILE REEL WITH A MASS-STORAGE ST1444.2 +001900* FILE TO PRODUCE A MASS-STORAGE FILE. ST1444.2 +002000* ST1444.2 +002100* ST1444.2 +002200* FEATURES TESTED - ST1444.2 +002300* * MULTIPLE FILE TAPE ST1444.2 +002400* * FIXED LENGTH RECORDS ST1444.2 +002500* * SAME SORT AREA IN THE I-O-CONTROL PARAGRAPH ST1444.2 +002600* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1444.2 +002700* * USING FILE-NAME SERIES ST1444.2 +002800* * OUTPUT PROCEDURE IS SECTION-NAME ST1444.2 +002900* * RETURN RECORD INTO PART OF THE OUTPUT PROCEDURE ST1444.2 +003000* ST1444.2 +003100* * MERGE MERGE-FILE-NAME ST1444.2 +003200* ON DESCENDING KEY KEY-1 OF DATA-NAME-1 ST1444.2 +003300* ASCENDING KEY-2 OF DATA-NAME-2 ST1444.2 +003400* USING FILE-NAME-2, FILE-NAME-3 ST1444.2 +003500* OUTPUT PROCEDURE IS SECTION-NAME. ST1444.2 +003600* ST1444.2 +003700* ST1444.2 +003800* FILES USED - ST1444.2 +003900* * FILES SQ-FS1 AND SQ-FS3 ARE WRITTEN ONTO A MULTIPLE ST1444.2 +004000* FILE TAPE. FILE SQ-FS2 IS WRITTEN ONTO MASS-STORAGE. ST1444.2 +004100* THEN THE MERGE STATEMENT USES SQ-FS3 AND SQ-FS2 TO CREATE A ST1444.2 +004200* NEW MASS-STORAGE FILE SQ-FS4. ALL FILES HAVE FIXED LENGTH ST1444.2 +004300* RECORDS AND 132 CHARACTERS PER RECORD. ST1444.2 +004400* ST1444.2 +004500* SQ-FS1 ST1444.2 +004600* 51 RECORDS ST1444.2 +004700* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +004800* BLOCKED 1 ST1444.2 +004900* RESERVE 2 AREAS ST1444.2 +005000* ST1444.2 +005100* SQ-FS2 ST1444.2 +005200* 51 RECORDS ST1444.2 +005300* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +005400* BLOCKED 2 ST1444.2 +005500* RESERVE 4 AREAS ST1444.2 +005600* ST1444.2 +005700* SQ-FS3 ST1444.2 +005800* 51 RECORDS ST1444.2 +005900* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +006000* BLOCKED 1 ST1444.2 +006100* RESERVE 6 AREAS ST1444.2 +006200* ST1444.2 +006300* NOTE THAT FILE SQ-FS3 IS THE SECOND POSITION ST1444.2 +006400* ON A MULTIPLE FILE TAPE. BOTH FILES SQ-FS1 AND SQ-FS3 ARE ST1444.2 +006500* ON THE SAME MULTIPLE FILE TAPE. ST1444.2 +006600* ST1444.2 +006700* SQ-FS4 ST1444.2 +006800* FINAL TOTAL OF 102 RECORDS AS A RESULT OF THE MERGE ST1444.2 +006900* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +007000* BLOCKED 3 ST1444.2 +007100* RESERVE 4 AREAS ST1444.2 +007200* ST1444.2 +007300* ST1444.2 +007400* X-CARDS USED - ST1444.2 +007500* X-XXX008 SQ-FS1 ST1444.2 +007600* X-XXX014 SQ-FS2 ST1444.2 +007700* X-XXX009 SQ-FS3 ST1444.2 +007800* X-XXX015 SQ-FS4 ST1444.2 +007900* X-XXX027 MERGE FILE ST-FS1 ST1444.2 +008000* X-55 SYSTEM PRINTER NAME. ST1444.2 +008100* X-XXX064 NATIVE COLLATING SEQUENCE DESCENDING ORDER-NOTE ST1444.2 +008200* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-64 ST1444.2 +008300* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1444.2 +008400* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1444.2 +008500* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1444.2 +008600* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-64 CARD..... ST1444.2 +008700* ST1444.2 +008800* X-64 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1444.2 +008900* X-82 SOURCE COMPUTER NAME. ST1444.2 +009000* X-83 OBJECT COMPUTER NAME. ST1444.2 +009100* ST1444.2 +009200* ST1444.2 +009300* OPTIONS RECOMMENDED - ST1444.2 +009400* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1444.2 +009500* FILES AS THEY ARE CREATED AND READ DURING ST1444.2 +009600* MRG-TESTS 3 THRU 8. ST1444.2 +009700* ST1444.2 +009800* ST1444.2 +009900* TEST DESCRIPTIONS - ST1444.2 +010000* BLD-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1444.2 +010100* BLD-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1444.2 +010200* BLD-TEST-003 CHECKS THE CREATION OF SQ-FS3 ST1444.2 +010300* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS4 ST1444.2 +010400* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS4 ST1444.2 +010500* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS4 ST1444.2 +010600* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS4 ST1444.2 +010700* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS4 ST1444.2 +010800* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS4ST1444.2 +010900* MRG-TEST-009 AN EOF CHECK ON SQ-FS4 ST1444.2 +011000* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1444.2 +011100* RECORD ON SQ-FS4 EQUALS 102 ST1444.2 +011200* ST1444.2 +011300* ST1444.2 +011400* ************************************************************ ST1444.2 +011500 ENVIRONMENT DIVISION. ST1444.2 +011600 CONFIGURATION SECTION. ST1444.2 +011700 SOURCE-COMPUTER. ST1444.2 +011800 XXXXX082. ST1444.2 +011900 OBJECT-COMPUTER. ST1444.2 +012000 XXXXX083. ST1444.2 +012100 INPUT-OUTPUT SECTION. ST1444.2 +012200 FILE-CONTROL. ST1444.2 +012300 SELECT PRINT-FILE ASSIGN TO ST1444.2 +012400 XXXXX055. ST1444.2 +012500 SELECT SQ-FS1 ASSIGN ST1444.2 +012600 XXXXX008 ST1444.2 +012700 ; ORGANIZATION IS SEQUENTIAL ST1444.2 +012800 ACCESS MODE SEQUENTIAL ST1444.2 +012900 RESERVE 2 AREAS. ST1444.2 +013000 SELECT SQ-FS2 ASSIGN TO ST1444.2 +013100 XXXXX014 ST1444.2 +013200 ORGANIZATION IS SEQUENTIAL ST1444.2 +013300 ACCESS MODE IS SEQUENTIAL ST1444.2 +013400 RESERVE 4 AREAS. ST1444.2 +013500 SELECT SQ-FS3 ASSIGN TO ST1444.2 +013600 XXXXX009 ST1444.2 +013700 ORGANIZATION SEQUENTIAL ST1444.2 +013800 ; ACCESS MODE IS SEQUENTIAL ST1444.2 +013900 RESERVE 6 AREAS. ST1444.2 +014000 SELECT SQ-FS4 ASSIGN TO ST1444.2 +014100 XXXXX015 ST1444.2 +014200 ORGANIZATION IS SEQUENTIAL ST1444.2 +014300 ; ACCESS MODE IS SEQUENTIAL ST1444.2 +014400 RESERVE 4 AREAS. ST1444.2 +014500 SELECT ST-FS1 ASSIGN TO ST1444.2 +014600 XXXXX027. ST1444.2 +014700 I-O-CONTROL. ST1444.2 +014800 SAME SORT AREA FOR SQ-FS1 ST-FS1, ST1444.2 +014900 MULTIPLE FILE TAPE CONTAINS SQ-FS1 POSITION 1 ST1444.2 +015000 SQ-FS3 POSITION 2. ST1444.2 +015100 DATA DIVISION. ST1444.2 +015200 FILE SECTION. ST1444.2 +015300 FD PRINT-FILE. ST1444.2 +015400 01 PRINT-REC PICTURE X(120). ST1444.2 +015500 01 DUMMY-RECORD PICTURE X(120). ST1444.2 +015600 FD SQ-FS1 ST1444.2 +015700 LABEL RECORDS STANDARD ST1444.2 +015800C VALUE OF ST1444.2 +015900C XXXXX074 ST1444.2 +016000C IS ST1444.2 +016100C XXXXX075 ST1444.2 +016200G XXXXX069 ST1444.2 +016300 BLOCK CONTAINS 1 RECORDS ST1444.2 +016400 RECORD CONTAINS 132 CHARACTERS ST1444.2 +016500 DATA RECORDS SQ-FS1R1-F-G-132, SQ-FS1R2-F-G-132. ST1444.2 +016600 01 SQ-FS1R1-F-G-132. ST1444.2 +016700 10 REC-PREAMBLE PIC X(120). ST1444.2 +016800 10 REST-OF-1. ST1444.2 +016900 20 KEY-1. ST1444.2 +017000 30 ALPHAN-KEY PIC X. ST1444.2 +017100 30 NUM-KEY PIC 999. ST1444.2 +017200 20 KEY-2. ST1444.2 +017300 30 ALPHAN-KEY PIC X. ST1444.2 +017400 30 NUM-KEY PIC 999. ST1444.2 +017500 20 KEY-3. ST1444.2 +017600 30 ALPHAN-KEY PIC X. ST1444.2 +017700 30 NUM-KEY PIC 999. ST1444.2 +017800 01 SQ-FS1R2-F-G-132. ST1444.2 +017900 02 FILLER PIC X(120). ST1444.2 +018000 02 GARBAGE PIC X(12). ST1444.2 +018100 FD SQ-FS2 ST1444.2 +018200 LABEL RECORD STANDARD ST1444.2 +018300C VALUE OF ST1444.2 +018400C XXXXX074 ST1444.2 +018500C IS ST1444.2 +018600C XXXXX076 ST1444.2 +018700G XXXXX069 ST1444.2 +018800 BLOCK CONTAINS 2 RECORDS ST1444.2 +018900 RECORD CONTAINS 132 CHARACTERS ST1444.2 +019000 DATA RECORD SQ-FS2R1-F-G-132. ST1444.2 +019100 01 SQ-FS2R1-F-G-132. ST1444.2 +019200 10 REC-PRE-2 PIC X(120). ST1444.2 +019300 10 REST-OF-2. ST1444.2 +019400 20 KEY-4. ST1444.2 +019500 30 ALPHAN-KEY PIC X. ST1444.2 +019600 30 NUM-KEY PIC 999. ST1444.2 +019700 20 KEY-5. ST1444.2 +019800 30 ALPHAN-KEY PIC X. ST1444.2 +019900 30 NUM-KEY PIC 999. ST1444.2 +020000 20 KEY-6. ST1444.2 +020100 30 ALPHAN-KEY PIC X. ST1444.2 +020200 30 NUM-KEY PIC 999. ST1444.2 +020300 FD SQ-FS3 ST1444.2 +020400 LABEL RECORDS STANDARD ST1444.2 +020500C VALUE OF ST1444.2 +020600C XXXXX074 ST1444.2 +020700C IS ST1444.2 +020800C XXXXX077 ST1444.2 +020900G XXXXX069 ST1444.2 +021000 BLOCK CONTAINS 1 RECORDS ST1444.2 +021100 RECORD CONTAINS 132 CHARACTERS ST1444.2 +021200 DATA RECORD SQ-FS3R1-F-G-132. ST1444.2 +021300 01 SQ-FS3R1-F-G-132. ST1444.2 +021400 10 REC-PRE-3 PIC X(120). ST1444.2 +021500 10 REST-OF-3. ST1444.2 +021600 20 KEY-7. ST1444.2 +021700 30 ALPHAN-KEY PIC X. ST1444.2 +021800 30 NUM-KEY PIC 999. ST1444.2 +021900 20 KEY-8. ST1444.2 +022000 30 ALPHAN-KEY PIC X. ST1444.2 +022100 30 NUM-KEY PIC 999. ST1444.2 +022200 20 KEY-9. ST1444.2 +022300 30 ALPHAN-KEY PIC X. ST1444.2 +022400 30 NUM-KEY PIC 999. ST1444.2 +022500 FD SQ-FS4 ST1444.2 +022600 LABEL RECORD IS STANDARD ST1444.2 +022700C ; VALUE OF ST1444.2 +022800C XXXXX074 ST1444.2 +022900C IS ST1444.2 +023000C XXXXX078 ST1444.2 +023100G XXXXX069 ST1444.2 +023200 ; BLOCK CONTAINS 3 RECORDS ST1444.2 +023300 RECORD CONTAINS 132 CHARACTERS ST1444.2 +023400 DATA RECORD SQ-FS4R1-F-G-132. ST1444.2 +023500 01 SQ-FS4R1-F-G-132. ST1444.2 +023600 10 REC-PRE-4 PIC X(120). ST1444.2 +023700 10 REST-OF-4. ST1444.2 +023800 20 KEY-10. ST1444.2 +023900 30 ALPHAN-KEY PIC X. ST1444.2 +024000 30 NUM-KEY PIC 999. ST1444.2 +024100 20 KEY-11. ST1444.2 +024200 30 ALPHAN-KEY PIC X. ST1444.2 +024300 30 NUM-KEY PIC 999. ST1444.2 +024400 20 KEY-12. ST1444.2 +024500 30 ALPHAN-KEY PIC X. ST1444.2 +024600 30 NUM-KEY PIC 999. ST1444.2 +024700 SD ST-FS1 ST1444.2 +024800 RECORD CONTAINS 132 CHARACTERS ST1444.2 +024900 DATA RECORD IS ST-FS1R1-F-G-132. ST1444.2 +025000 01 ST-FS1R1-F-G-132. ST1444.2 +025100 02 FILLER PIC X(120). ST1444.2 +025200 02 NON-KEY-1. ST1444.2 +025300 03 A-KEY PIC X. ST1444.2 +025400 03 N-KEY PIC 999. ST1444.2 +025500 02 SORT-KEY. ST1444.2 +025600 03 A-KEY PIC X. ST1444.2 +025700 03 N-KEY PIC 999. ST1444.2 +025800 02 NON-KEY-2. ST1444.2 +025900 03 A-KEY PIC X. ST1444.2 +026000 03 N-KEY PIC 999. ST1444.2 +026100 WORKING-STORAGE SECTION. ST1444.2 +026200 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1444.2 +026300 77 WRK-DU-999-0001 PIC 999. ST1444.2 +026400 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1444.2 +026500 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1444.2 +026600 01 WRK-XN-0001 PIC X(51) VALUE ST1444.2 +026700 XXXXX064. ST1444.2 +026800 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1444.2 +026900 02 CHAR PIC X OCCURS 51 TIMES. ST1444.2 +027000 01 WRK-XN-2 PIC X(51) VALUE ST1444.2 +027100 XXXXX064. ST1444.2 +027200 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1444.2 +027300 02 ASCIIS PIC X OCCURS 51 TIMES. ST1444.2 +027400 01 WRK-XN-O020F-0001. ST1444.2 +027500 02 COMPU PIC X OCCURS 20 TIMES. ST1444.2 +027600 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1444.2 +027700 02 FILLER PIC X(20). ST1444.2 +027800 01 WRK-XN-O120F-1. ST1444.2 +027900 02 COLLS PIC X OCCURS 120 TIMES. ST1444.2 +028000 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1444.2 +028100 02 WRK-XN-0002 PIC X(20). ST1444.2 +028200 02 WRK-XN-0003 PIC X(20). ST1444.2 +028300 02 WRK-XN-0004 PIC X(20). ST1444.2 +028400 02 WRK-XN-0005 PIC X(20). ST1444.2 +028500 02 WRK-XN-0006 PIC X(20). ST1444.2 +028600 02 WRK-XN-0007 PIC X(20). ST1444.2 +028700 01 FILE-RECORD-INFORMATION-REC. ST1444.2 +028800 03 FILE-RECORD-INFO-SKELETON. ST1444.2 +028900 05 FILLER PICTURE X(48) VALUE ST1444.2 +029000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1444.2 +029100 05 FILLER PICTURE X(46) VALUE ST1444.2 +029200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1444.2 +029300 05 FILLER PICTURE X(26) VALUE ST1444.2 +029400 ",LFIL=000000,ORG= ,LBLR= ". ST1444.2 +029500 05 FILLER PICTURE X(37) VALUE ST1444.2 +029600 ",RECKEY= ". ST1444.2 +029700 05 FILLER PICTURE X(38) VALUE ST1444.2 +029800 ",ALTKEY1= ". ST1444.2 +029900 05 FILLER PICTURE X(38) VALUE ST1444.2 +030000 ",ALTKEY2= ". ST1444.2 +030100 05 FILLER PICTURE X(7) VALUE SPACE.ST1444.2 +030200 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1444.2 +030300 05 FILE-RECORD-INFO-P1-120. ST1444.2 +030400 07 FILLER PIC X(5). ST1444.2 +030500 07 XFILE-NAME PIC X(6). ST1444.2 +030600 07 FILLER PIC X(8). ST1444.2 +030700 07 XRECORD-NAME PIC X(6). ST1444.2 +030800 07 FILLER PIC X(1). ST1444.2 +030900 07 REELUNIT-NUMBER PIC 9(1). ST1444.2 +031000 07 FILLER PIC X(7). ST1444.2 +031100 07 XRECORD-NUMBER PIC 9(6). ST1444.2 +031200 07 FILLER PIC X(6). ST1444.2 +031300 07 UPDATE-NUMBER PIC 9(2). ST1444.2 +031400 07 FILLER PIC X(5). ST1444.2 +031500 07 ODO-NUMBER PIC 9(4). ST1444.2 +031600 07 FILLER PIC X(5). ST1444.2 +031700 07 XPROGRAM-NAME PIC X(5). ST1444.2 +031800 07 FILLER PIC X(7). ST1444.2 +031900 07 XRECORD-LENGTH PIC 9(6). ST1444.2 +032000 07 FILLER PIC X(7). ST1444.2 +032100 07 CHARS-OR-RECORDS PIC X(2). ST1444.2 +032200 07 FILLER PIC X(1). ST1444.2 +032300 07 XBLOCK-SIZE PIC 9(4). ST1444.2 +032400 07 FILLER PIC X(6). ST1444.2 +032500 07 RECORDS-IN-FILE PIC 9(6). ST1444.2 +032600 07 FILLER PIC X(5). ST1444.2 +032700 07 XFILE-ORGANIZATION PIC X(2). ST1444.2 +032800 07 FILLER PIC X(6). ST1444.2 +032900 07 XLABEL-TYPE PIC X(1). ST1444.2 +033000 05 FILE-RECORD-INFO-P121-240. ST1444.2 +033100 07 FILLER PIC X(8). ST1444.2 +033200 07 XRECORD-KEY PIC X(29). ST1444.2 +033300 07 FILLER PIC X(9). ST1444.2 +033400 07 ALTERNATE-KEY1 PIC X(29). ST1444.2 +033500 07 FILLER PIC X(9). ST1444.2 +033600 07 ALTERNATE-KEY2 PIC X(29). ST1444.2 +033700 07 FILLER PIC X(7). ST1444.2 +033800 01 TEST-RESULTS. ST1444.2 +033900 02 FILLER PIC X VALUE SPACE. ST1444.2 +034000 02 FEATURE PIC X(20) VALUE SPACE. ST1444.2 +034100 02 FILLER PIC X VALUE SPACE. ST1444.2 +034200 02 P-OR-F PIC X(5) VALUE SPACE. ST1444.2 +034300 02 FILLER PIC X VALUE SPACE. ST1444.2 +034400 02 PAR-NAME. ST1444.2 +034500 03 FILLER PIC X(19) VALUE SPACE. ST1444.2 +034600 03 PARDOT-X PIC X VALUE SPACE. ST1444.2 +034700 03 DOTVALUE PIC 99 VALUE ZERO. ST1444.2 +034800 02 FILLER PIC X(8) VALUE SPACE. ST1444.2 +034900 02 RE-MARK PIC X(61). ST1444.2 +035000 01 TEST-COMPUTED. ST1444.2 +035100 02 FILLER PIC X(30) VALUE SPACE. ST1444.2 +035200 02 FILLER PIC X(17) VALUE ST1444.2 +035300 " COMPUTED=". ST1444.2 +035400 02 COMPUTED-X. ST1444.2 +035500 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1444.2 +035600 03 COMPUTED-N REDEFINES COMPUTED-A ST1444.2 +035700 PIC -9(9).9(9). ST1444.2 +035800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1444.2 +035900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1444.2 +036000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1444.2 +036100 03 CM-18V0 REDEFINES COMPUTED-A. ST1444.2 +036200 04 COMPUTED-18V0 PIC -9(18). ST1444.2 +036300 04 FILLER PIC X. ST1444.2 +036400 03 FILLER PIC X(50) VALUE SPACE. ST1444.2 +036500 01 TEST-CORRECT. ST1444.2 +036600 02 FILLER PIC X(30) VALUE SPACE. ST1444.2 +036700 02 FILLER PIC X(17) VALUE " CORRECT =". ST1444.2 +036800 02 CORRECT-X. ST1444.2 +036900 03 CORRECT-A PIC X(20) VALUE SPACE. ST1444.2 +037000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1444.2 +037100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1444.2 +037200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1444.2 +037300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1444.2 +037400 03 CR-18V0 REDEFINES CORRECT-A. ST1444.2 +037500 04 CORRECT-18V0 PIC -9(18). ST1444.2 +037600 04 FILLER PIC X. ST1444.2 +037700 03 FILLER PIC X(2) VALUE SPACE. ST1444.2 +037800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1444.2 +037900 01 CCVS-C-1. ST1444.2 +038000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1444.2 +038100- "SS PARAGRAPH-NAME ST1444.2 +038200- " REMARKS". ST1444.2 +038300 02 FILLER PIC X(20) VALUE SPACE. ST1444.2 +038400 01 CCVS-C-2. ST1444.2 +038500 02 FILLER PIC X VALUE SPACE. ST1444.2 +038600 02 FILLER PIC X(6) VALUE "TESTED". ST1444.2 +038700 02 FILLER PIC X(15) VALUE SPACE. ST1444.2 +038800 02 FILLER PIC X(4) VALUE "FAIL". ST1444.2 +038900 02 FILLER PIC X(94) VALUE SPACE. ST1444.2 +039000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1444.2 +039100 01 REC-CT PIC 99 VALUE ZERO. ST1444.2 +039200 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039300 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039500 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039600 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1444.2 +039700 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1444.2 +039800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1444.2 +039900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1444.2 +040000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1444.2 +040100 01 CCVS-H-1. ST1444.2 +040200 02 FILLER PIC X(39) VALUE SPACES. ST1444.2 +040300 02 FILLER PIC X(42) VALUE ST1444.2 +040400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1444.2 +040500 02 FILLER PIC X(39) VALUE SPACES. ST1444.2 +040600 01 CCVS-H-2A. ST1444.2 +040700 02 FILLER PIC X(40) VALUE SPACE. ST1444.2 +040800 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1444.2 +040900 02 FILLER PIC XXXX VALUE ST1444.2 +041000 "4.2 ". ST1444.2 +041100 02 FILLER PIC X(28) VALUE ST1444.2 +041200 " COPY - NOT FOR DISTRIBUTION". ST1444.2 +041300 02 FILLER PIC X(41) VALUE SPACE. ST1444.2 +041400 ST1444.2 +041500 01 CCVS-H-2B. ST1444.2 +041600 02 FILLER PIC X(15) VALUE ST1444.2 +041700 "TEST RESULT OF ". ST1444.2 +041800 02 TEST-ID PIC X(9). ST1444.2 +041900 02 FILLER PIC X(4) VALUE ST1444.2 +042000 " IN ". ST1444.2 +042100 02 FILLER PIC X(12) VALUE ST1444.2 +042200 " HIGH ". ST1444.2 +042300 02 FILLER PIC X(22) VALUE ST1444.2 +042400 " LEVEL VALIDATION FOR ". ST1444.2 +042500 02 FILLER PIC X(58) VALUE ST1444.2 +042600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +042700 01 CCVS-H-3. ST1444.2 +042800 02 FILLER PIC X(34) VALUE ST1444.2 +042900 " FOR OFFICIAL USE ONLY ". ST1444.2 +043000 02 FILLER PIC X(58) VALUE ST1444.2 +043100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1444.2 +043200 02 FILLER PIC X(28) VALUE ST1444.2 +043300 " COPYRIGHT 1985 ". ST1444.2 +043400 01 CCVS-E-1. ST1444.2 +043500 02 FILLER PIC X(52) VALUE SPACE. ST1444.2 +043600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1444.2 +043700 02 ID-AGAIN PIC X(9). ST1444.2 +043800 02 FILLER PIC X(45) VALUE SPACES. ST1444.2 +043900 01 CCVS-E-2. ST1444.2 +044000 02 FILLER PIC X(31) VALUE SPACE. ST1444.2 +044100 02 FILLER PIC X(21) VALUE SPACE. ST1444.2 +044200 02 CCVS-E-2-2. ST1444.2 +044300 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1444.2 +044400 03 FILLER PIC X VALUE SPACE. ST1444.2 +044500 03 ENDER-DESC PIC X(44) VALUE ST1444.2 +044600 "ERRORS ENCOUNTERED". ST1444.2 +044700 01 CCVS-E-3. ST1444.2 +044800 02 FILLER PIC X(22) VALUE ST1444.2 +044900 " FOR OFFICIAL USE ONLY". ST1444.2 +045000 02 FILLER PIC X(12) VALUE SPACE. ST1444.2 +045100 02 FILLER PIC X(58) VALUE ST1444.2 +045200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +045300 02 FILLER PIC X(13) VALUE SPACE. ST1444.2 +045400 02 FILLER PIC X(15) VALUE ST1444.2 +045500 " COPYRIGHT 1985". ST1444.2 +045600 01 CCVS-E-4. ST1444.2 +045700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1444.2 +045800 02 FILLER PIC X(4) VALUE " OF ". ST1444.2 +045900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1444.2 +046000 02 FILLER PIC X(40) VALUE ST1444.2 +046100 " TESTS WERE EXECUTED SUCCESSFULLY". ST1444.2 +046200 01 XXINFO. ST1444.2 +046300 02 FILLER PIC X(19) VALUE ST1444.2 +046400 "*** INFORMATION ***". ST1444.2 +046500 02 INFO-TEXT. ST1444.2 +046600 04 FILLER PIC X(8) VALUE SPACE. ST1444.2 +046700 04 XXCOMPUTED PIC X(20). ST1444.2 +046800 04 FILLER PIC X(5) VALUE SPACE. ST1444.2 +046900 04 XXCORRECT PIC X(20). ST1444.2 +047000 02 INF-ANSI-REFERENCE PIC X(48). ST1444.2 +047100 01 HYPHEN-LINE. ST1444.2 +047200 02 FILLER PIC IS X VALUE IS SPACE. ST1444.2 +047300 02 FILLER PIC IS X(65) VALUE IS "************************ST1444.2 +047400- "*****************************************". ST1444.2 +047500 02 FILLER PIC IS X(54) VALUE IS "************************ST1444.2 +047600- "******************************". ST1444.2 +047700 01 CCVS-PGM-ID PIC X(9) VALUE ST1444.2 +047800 "ST144A". ST1444.2 +047900 PROCEDURE DIVISION. ST1444.2 +048000 DECLARATIVES. ST1444.2 +048100 SECT-ST214-DEC SECTION. ST1444.2 +048200 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. ST1444.2 +048300 SRT-WRITE-DEC. ST1444.2 +048400 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1444.2 +048500 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1444.2 +048600 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1444.2 +048700 STOP RUN. ST1444.2 +048800 END DECLARATIVES. ST1444.2 +048900 CCVS1 SECTION. ST1444.2 +049000 OPEN-FILES. ST1444.2 +049100 OPEN OUTPUT PRINT-FILE. ST1444.2 +049200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1444.2 +049300 MOVE SPACE TO TEST-RESULTS. ST1444.2 +049400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1444.2 +049500 MOVE ZERO TO REC-SKL-SUB. ST1444.2 +049600 PERFORM CCVS-INIT-FILE 9 TIMES. ST1444.2 +049700 CCVS-INIT-FILE. ST1444.2 +049800 ADD 1 TO REC-SKL-SUB. ST1444.2 +049900 MOVE FILE-RECORD-INFO-SKELETON ST1444.2 +050000 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1444.2 +050100 CCVS-INIT-EXIT. ST1444.2 +050200 GO TO CCVS1-EXIT. ST1444.2 +050300 CLOSE-FILES. ST1444.2 +050400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1444.2 +050500 TERMINATE-CCVS. ST1444.2 +050600S EXIT PROGRAM. ST1444.2 +050700STERMINATE-CALL. ST1444.2 +050800 STOP RUN. ST1444.2 +050900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1444.2 +051000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1444.2 +051100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1444.2 +051200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1444.2 +051300 MOVE "****TEST DELETED****" TO RE-MARK. ST1444.2 +051400 PRINT-DETAIL. ST1444.2 +051500 IF REC-CT NOT EQUAL TO ZERO ST1444.2 +051600 MOVE "." TO PARDOT-X ST1444.2 +051700 MOVE REC-CT TO DOTVALUE. ST1444.2 +051800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1444.2 +051900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1444.2 +052000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1444.2 +052100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1444.2 +052200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1444.2 +052300 MOVE SPACE TO CORRECT-X. ST1444.2 +052400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1444.2 +052500 MOVE SPACE TO RE-MARK. ST1444.2 +052600 HEAD-ROUTINE. ST1444.2 +052700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +052800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +052900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1444.2 +053000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1444.2 +053100 COLUMN-NAMES-ROUTINE. ST1444.2 +053200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +053300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +053400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +053500 END-ROUTINE. ST1444.2 +053600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1444.2 +053700 END-RTN-EXIT. ST1444.2 +053800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +053900 END-ROUTINE-1. ST1444.2 +054000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1444.2 +054100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1444.2 +054200 ADD PASS-COUNTER TO ERROR-HOLD. ST1444.2 +054300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1444.2 +054400 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1444.2 +054500 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1444.2 +054600 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1444.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1444.2 +054800 END-ROUTINE-12. ST1444.2 +054900 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1444.2 +055000 IF ERROR-COUNTER IS EQUAL TO ZERO ST1444.2 +055100 MOVE "NO " TO ERROR-TOTAL ST1444.2 +055200 ELSE ST1444.2 +055300 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1444.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1444.2 +055500 PERFORM WRITE-LINE. ST1444.2 +055600 END-ROUTINE-13. ST1444.2 +055700 IF DELETE-COUNTER IS EQUAL TO ZERO ST1444.2 +055800 MOVE "NO " TO ERROR-TOTAL ELSE ST1444.2 +055900 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1444.2 +056000 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1444.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056200 IF INSPECT-COUNTER EQUAL TO ZERO ST1444.2 +056300 MOVE "NO " TO ERROR-TOTAL ST1444.2 +056400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1444.2 +056500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1444.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056800 WRITE-LINE. ST1444.2 +056900 ADD 1 TO RECORD-COUNT. ST1444.2 +057000Y IF RECORD-COUNT GREATER 42 ST1444.2 +057100Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1444.2 +057200Y MOVE SPACE TO DUMMY-RECORD ST1444.2 +057300Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1444.2 +057400Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1444.2 +057500Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1444.2 +057600Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1444.2 +057700Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1444.2 +057800Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +057900Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +058000Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +058100Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1444.2 +058200Y MOVE ZERO TO RECORD-COUNT. ST1444.2 +058300 PERFORM WRT-LN. ST1444.2 +058400 WRT-LN. ST1444.2 +058500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1444.2 +058600 MOVE SPACE TO DUMMY-RECORD. ST1444.2 +058700 BLANK-LINE-PRINT. ST1444.2 +058800 PERFORM WRT-LN. ST1444.2 +058900 FAIL-ROUTINE. ST1444.2 +059000 IF COMPUTED-X NOT EQUAL TO SPACE ST1444.2 +059100 GO TO FAIL-ROUTINE-WRITE. ST1444.2 +059200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1444.2 +059300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1444.2 +059400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1444.2 +059500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +059600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1444.2 +059700 GO TO FAIL-ROUTINE-EX. ST1444.2 +059800 FAIL-ROUTINE-WRITE. ST1444.2 +059900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1444.2 +060000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1444.2 +060100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1444.2 +060200 MOVE SPACES TO COR-ANSI-REFERENCE. ST1444.2 +060300 FAIL-ROUTINE-EX. EXIT. ST1444.2 +060400 BAIL-OUT. ST1444.2 +060500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1444.2 +060600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1444.2 +060700 BAIL-OUT-WRITE. ST1444.2 +060800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1444.2 +060900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1444.2 +061000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +061100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1444.2 +061200 BAIL-OUT-EX. EXIT. ST1444.2 +061300 CCVS1-EXIT. ST1444.2 +061400 EXIT. ST1444.2 +061500 SECT-ST214-0001 SECTION. ST1444.2 +061600 BLD-INIT-001. ST1444.2 +061700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1444.2 +061800 OPEN OUTPUT SQ-FS1. ST1444.2 +061900 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1444.2 +062000 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1444.2 +062100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1444.2 +062200 MOVE 000132 TO XRECORD-LENGTH (1). ST1444.2 +062300 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1444.2 +062400 MOVE 0001 TO XBLOCK-SIZE (1). ST1444.2 +062500 MOVE 000051 TO RECORDS-IN-FILE (1). ST1444.2 +062600 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1444.2 +062700 MOVE "S" TO XLABEL-TYPE (1). ST1444.2 +062800 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +062900 MOVE SPACES TO WRK-XN-O120F-1. ST1444.2 +063000 BLD-TEST-001. ST1444.2 +063100 PERFORM BLD-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1444.2 +063200 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +063300X MOVE SPACES TO PRINT-REC. ST1444.2 +063400X WRITE PRINT-REC. ST1444.2 +063500 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1444.2 +063600 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +063700 ELSE ST1444.2 +063800 PERFORM PASS. ST1444.2 +063900 GO TO BLD-WRITE-001. ST1444.2 +064000 BLD-TEST-001-BUILD. ST1444.2 +064100 MOVE "JUNKSLOPJUNK" TO GARBAGE. ST1444.2 +064200 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1444.2 +064300 NUM-KEY OF KEY-3. ST1444.2 +064400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1444.2 +064500 ADD 1 TO XRECORD-NUMBER (1). ST1444.2 +064600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1444.2 +064700 ADD 1 TO WRK-DU-999-2. ST1444.2 +064800 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1444.2 +064900 ADD 1 TO WRK-DU-999-2. ST1444.2 +065000X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1444.2 +065100X WRITE PRINT-REC FROM REST-OF-1. ST1444.2 +065200X MOVE SPACES TO PRINT-REC. ST1444.2 +065300 WRITE SQ-FS1R1-F-G-132. ST1444.2 +065400 BLD-DELETE-001. ST1444.2 +065500 PERFORM DE-LETE. ST1444.2 +065600 BLD-WRITE-001. ST1444.2 +065700 MOVE "BLD-TEST-001" TO PAR-NAME. ST1444.2 +065800 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1444.2 +065900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +066000 PERFORM PRINT-DETAIL. ST1444.2 +066100X MOVE SPACES TO PRINT-REC. ST1444.2 +066200X WRITE PRINT-REC. ST1444.2 +066300 CLOSE SQ-FS1 WITH NO REWIND. ST1444.2 +066400 BLD-INIT-002. ST1444.2 +066500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1444.2 +066600 OPEN OUTPUT SQ-FS2. ST1444.2 +066700 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1444.2 +066800 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +066900 MOVE 0002 TO XBLOCK-SIZE (1). ST1444.2 +067000 BLD-TEST-002. ST1444.2 +067100 PERFORM BLD-TEST-002-BUILD VARYING WRK-DU-999-0001 FROM ST1444.2 +067200 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +067300X MOVE SPACES TO PRINT-REC. ST1444.2 +067400X WRITE PRINT-REC. ST1444.2 +067500 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1444.2 +067600 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +067700 ELSE ST1444.2 +067800 PERFORM PASS. ST1444.2 +067900 GO TO BLD-WRITE-002. ST1444.2 +068000 BLD-TEST-002-BUILD. ST1444.2 +068100 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1444.2 +068200 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1444.2 +068300 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1444.2 +068400 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1444.2 +068500 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1444.2 +068600 ADD 000001 TO XRECORD-NUMBER (1). ST1444.2 +068700X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1444.2 +068800X WRITE PRINT-REC FROM REST-OF-2. ST1444.2 +068900X MOVE SPACES TO PRINT-REC. ST1444.2 +069000 WRITE SQ-FS2R1-F-G-132. ST1444.2 +069100 BLD-DELETE-002. ST1444.2 +069200 PERFORM DE-LETE. ST1444.2 +069300 BLD-WRITE-002. ST1444.2 +069400 MOVE "BLD-TEST-002" TO PAR-NAME. ST1444.2 +069500 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1444.2 +069600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +069700 PERFORM PRINT-DETAIL. ST1444.2 +069800X MOVE SPACES TO PRINT-REC. ST1444.2 +069900X WRITE PRINT-REC. ST1444.2 +070000 CLOSE SQ-FS2. ST1444.2 +070100 BLD-INIT-003. ST1444.2 +070200 MOVE "CREATE FILE SQ-FS3" TO FEATURE. ST1444.2 +070300 OPEN OUTPUT SQ-FS3. ST1444.2 +070400 MOVE "SQ-FS3" TO XFILE-NAME (1). ST1444.2 +070500 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +070600 MOVE 0001 TO XBLOCK-SIZE (1). ST1444.2 +070700 BLD-TEST-003. ST1444.2 +070800 PERFORM BLD-TEST-003-BUILD VARYING WRK-DU-999-0001 FROM ST1444.2 +070900 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +071000X MOVE SPACES TO PRINT-REC. ST1444.2 +071100X WRITE PRINT-REC. ST1444.2 +071200 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1444.2 +071300 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +071400 ELSE ST1444.2 +071500 PERFORM PASS. ST1444.2 +071600 GO TO BLD-WRITE-003. ST1444.2 +071700 BLD-TEST-003-BUILD. ST1444.2 +071800 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-7 ST1444.2 +071900 ALPHAN-KEY OF KEY-8 ALPHAN-KEY OF KEY-9. ST1444.2 +072000 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-7 NUM-KEY OF KEY-8 ST1444.2 +072100 NUM-KEY OF KEY-9. ST1444.2 +072200 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-3. ST1444.2 +072300 ADD 000001 TO XRECORD-NUMBER (1). ST1444.2 +072400X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1444.2 +072500X WRITE PRINT-REC FROM REST-OF-3. ST1444.2 +072600X MOVE SPACES TO PRINT-REC. ST1444.2 +072700 WRITE SQ-FS3R1-F-G-132. ST1444.2 +072800 BLD-DELETE-003. ST1444.2 +072900 PERFORM DE-LETE. ST1444.2 +073000 BLD-WRITE-003. ST1444.2 +073100 MOVE "BLD-TEST-003" TO PAR-NAME. ST1444.2 +073200 MOVE "3RD FILE CREATED" TO COMPUTED-A. ST1444.2 +073300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +073400 PERFORM PRINT-DETAIL. ST1444.2 +073500X MOVE SPACES TO PRINT-REC. ST1444.2 +073600X WRITE PRINT-REC. ST1444.2 +073700 CLOSE SQ-FS3. ST1444.2 +073800 MRG-INIT-001. ST1444.2 +073900 MERGE ST-FS1 ST1444.2 +074000 ON DESCENDING KEY A-KEY OF SORT-KEY ST1444.2 +074100 ASCENDING N-KEY OF NON-KEY-2 ST1444.2 +074200 USING SQ-FS2, SQ-FS3 ST1444.2 +074300 OUTPUT PROCEDURE IS SECT-ST214-0002. ST1444.2 +074400 SRT-TEST-003. ST1444.2 +074500 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +074600 OPEN INPUT SQ-FS4. ST1444.2 +074700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +074800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +074900X MOVE SPACES TO PRINT-REC. ST1444.2 +075000X WRITE PRINT-REC. ST1444.2 +075100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1444.2 +075200 PERFORM FAIL GO TO SRT-FAIL-003 ST1444.2 +075300 ELSE ST1444.2 +075400 PERFORM PASS. ST1444.2 +075500 GO TO SRT-WRITE-003. ST1444.2 +075600 SRT-DELETE-003. ST1444.2 +075700 PERFORM DE-LETE. ST1444.2 +075800 GO TO SRT-WRITE-003. ST1444.2 +075900 SRT-FAIL-003. ST1444.2 +076000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +076100 MOVE WRK-XN-0002 TO CORRECT-A. ST1444.2 +076200 SRT-WRITE-003. ST1444.2 +076300 MOVE "MRG-TEST-003" TO PAR-NAME. ST1444.2 +076400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +076500 PERFORM PRINT-DETAIL. ST1444.2 +076600X MOVE SPACES TO PRINT-REC. ST1444.2 +076700X WRITE PRINT-REC. ST1444.2 +076800 SRT-INIT-004. ST1444.2 +076900 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +077000 SRT-TEST-004. ST1444.2 +077100 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +077200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +077300X MOVE SPACES TO PRINT-REC. ST1444.2 +077400X WRITE PRINT-REC. ST1444.2 +077500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1444.2 +077600 PERFORM FAIL GO TO SRT-FAIL-004 ST1444.2 +077700 ELSE ST1444.2 +077800 PERFORM PASS. ST1444.2 +077900 GO TO SRT-WRITE-004. ST1444.2 +078000 SRT-DELETE-004. ST1444.2 +078100 PERFORM DE-LETE. ST1444.2 +078200 GO TO SRT-WRITE-004. ST1444.2 +078300 SRT-FAIL-004. ST1444.2 +078400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +078500 MOVE WRK-XN-0003 TO CORRECT-A. ST1444.2 +078600 SRT-WRITE-004. ST1444.2 +078700 MOVE "MRG-TEST-004" TO PAR-NAME. ST1444.2 +078800 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +078900 PERFORM PRINT-DETAIL. ST1444.2 +079000X MOVE SPACES TO PRINT-REC. ST1444.2 +079100X WRITE PRINT-REC. ST1444.2 +079200 SRT-INIT-005. ST1444.2 +079300 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +079400 SRT-TEST-005. ST1444.2 +079500 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +079600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +079700X MOVE SPACES TO PRINT-REC. ST1444.2 +079800X WRITE PRINT-REC. ST1444.2 +079900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1444.2 +080000 PERFORM FAIL GO TO SRT-FAIL-005 ST1444.2 +080100 ELSE ST1444.2 +080200 PERFORM PASS. ST1444.2 +080300 GO TO SRT-WRITE-005. ST1444.2 +080400 SRT-DELETE-005. ST1444.2 +080500 PERFORM DE-LETE. ST1444.2 +080600 GO TO SRT-WRITE-005. ST1444.2 +080700 SRT-FAIL-005. ST1444.2 +080800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +080900 MOVE WRK-XN-0004 TO CORRECT-A. ST1444.2 +081000 SRT-WRITE-005. ST1444.2 +081100 MOVE "MRG-TEST-005" TO PAR-NAME. ST1444.2 +081200 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +081300 PERFORM PRINT-DETAIL. ST1444.2 +081400X MOVE SPACES TO PRINT-REC. ST1444.2 +081500X WRITE PRINT-REC. ST1444.2 +081600 SRT-INIT-006. ST1444.2 +081700 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +081800 SRT-TEST-006. ST1444.2 +081900 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +082000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +082100X MOVE SPACES TO PRINT-REC. ST1444.2 +082200X WRITE PRINT-REC. ST1444.2 +082300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1444.2 +082400 PERFORM FAIL GO TO SRT-FAIL-006 ST1444.2 +082500 ELSE ST1444.2 +082600 PERFORM PASS. ST1444.2 +082700 GO TO SRT-WRITE-006. ST1444.2 +082800 SRT-DELETE-006. ST1444.2 +082900 PERFORM DE-LETE. ST1444.2 +083000 GO TO SRT-WRITE-006. ST1444.2 +083100 SRT-FAIL-006. ST1444.2 +083200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +083300 MOVE WRK-XN-0005 TO CORRECT-A. ST1444.2 +083400 SRT-WRITE-006. ST1444.2 +083500 MOVE "MRG-TEST-006" TO PAR-NAME. ST1444.2 +083600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +083700 PERFORM PRINT-DETAIL. ST1444.2 +083800X MOVE SPACES TO PRINT-REC. ST1444.2 +083900X WRITE PRINT-REC. ST1444.2 +084000 SRT-INIT-007. ST1444.2 +084100 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +084200 SRT-TEST-007. ST1444.2 +084300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +084400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +084500X MOVE SPACES TO PRINT-REC. ST1444.2 +084600X WRITE PRINT-REC. ST1444.2 +084700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1444.2 +084800 PERFORM FAIL GO TO SRT-FAIL-007 ST1444.2 +084900 ELSE ST1444.2 +085000 PERFORM PASS. ST1444.2 +085100 GO TO SRT-WRITE-007. ST1444.2 +085200 SRT-DELETE-007. ST1444.2 +085300 PERFORM DE-LETE. ST1444.2 +085400 GO TO SRT-WRITE-007. ST1444.2 +085500 SRT-FAIL-007. ST1444.2 +085600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +085700 MOVE WRK-XN-0006 TO CORRECT-A. ST1444.2 +085800 SRT-WRITE-007. ST1444.2 +085900 MOVE "MRG-TEST-007" TO PAR-NAME. ST1444.2 +086000 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +086100 PERFORM PRINT-DETAIL. ST1444.2 +086200X MOVE SPACES TO PRINT-REC. ST1444.2 +086300X WRITE PRINT-REC. ST1444.2 +086400 SRT-INIT-008. ST1444.2 +086500 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +086600 SRT-TEST-008. ST1444.2 +086700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +086800 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1444.2 +086900X MOVE SPACES TO PRINT-REC. ST1444.2 +087000X WRITE PRINT-REC. ST1444.2 +087100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1444.2 +087200 PERFORM FAIL GO TO SRT-FAIL-008 ST1444.2 +087300 ELSE ST1444.2 +087400 PERFORM PASS. ST1444.2 +087500 GO TO SRT-WRITE-008. ST1444.2 +087600 SRT-DELETE-008. ST1444.2 +087700 PERFORM DE-LETE. ST1444.2 +087800 GO TO SRT-WRITE-008. ST1444.2 +087900 SRT-FAIL-008. ST1444.2 +088000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +088100 MOVE WRK-XN-0007 TO CORRECT-A. ST1444.2 +088200 SRT-WRITE-008. ST1444.2 +088300 MOVE "MRG-TEST-008" TO PAR-NAME. ST1444.2 +088400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +088500 PERFORM PRINT-DETAIL. ST1444.2 +088600 MOVE NUM-KEY OF KEY-11 TO LAST-REC-NUM. ST1444.2 +088700 SRT-TEST-009. ST1444.2 +088800 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1444.2 +088900 GO TO SRT-FAIL-009. ST1444.2 +089000 READ SQ-FS4 AT END PERFORM PASS ST1444.2 +089100 GO TO SRT-WRITE-009. ST1444.2 +089200 GO TO SRT-FAIL-009. ST1444.2 +089300 SRT-DELETE-009. ST1444.2 +089400 PERFORM DE-LETE. ST1444.2 +089500 GO TO SRT-WRITE-009. ST1444.2 +089600 SRT-FAIL-009. ST1444.2 +089700 MOVE "EOF NOT FOUND" TO RE-MARK. ST1444.2 +089800 PERFORM FAIL . ST1444.2 +089900 SRT-WRITE-009. ST1444.2 +090000 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1444.2 +090100 MOVE "MRG-TEST-009" TO PAR-NAME. ST1444.2 +090200 PERFORM PRINT-DETAIL. ST1444.2 +090300 SRT-TEST-010. ST1444.2 +090400 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1444.2 +090500 PERFORM FAIL GO TO SRT-FAIL-010 ST1444.2 +090600 ELSE ST1444.2 +090700 PERFORM PASS. ST1444.2 +090800 GO TO SRT-WRITE-010. ST1444.2 +090900 SRT-DELETE-010. ST1444.2 +091000 PERFORM DE-LETE. ST1444.2 +091100 GO TO SRT-WRITE-010. ST1444.2 +091200 SRT-FAIL-010. ST1444.2 +091300 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1444.2 +091400 MOVE 102 TO CR-18V0. ST1444.2 +091500 SRT-WRITE-010. ST1444.2 +091600 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1444.2 +091700 MOVE "MRG-TEST-010" TO PAR-NAME. ST1444.2 +091800 PERFORM PRINT-DETAIL. ST1444.2 +091900 CLOSE SQ-FS4. ST1444.2 +092000 GO TO CCVS-999999. ST1444.2 +092100 READ-SQ-FS1 SECTION. ST1444.2 +092200 RD-1. ST1444.2 +092300 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1444.2 +092400 GO TO R1-EXIT. ST1444.2 +092500 READ SQ-FS4 AT END GO TO PREMATURE-EOF. ST1444.2 +092600X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1444.2 +092700X WRITE PRINT-REC FROM REST-OF-4. ST1444.2 +092800X MOVE SPACES TO PRINT-REC. ST1444.2 +092900 MOVE ALPHAN-KEY OF KEY-12 TO COMPU (WRK-DU-999-0001). ST1444.2 +093000 GO TO R1-EXIT. ST1444.2 +093100 PREMATURE-EOF. ST1444.2 +093200 MOVE 1 TO WRK-DU-9-0001. ST1444.2 +093300 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1444.2 +093400 R1-EXIT. ST1444.2 +093500 EXIT. ST1444.2 +093600 SECT-ST214-0002 SECTION. ST1444.2 +093700 SORT-OUTPUT-PROC. ST1444.2 +093800 OPEN OUTPUT SQ-FS4. ST1444.2 +093900 RETURN-THE-OLD-RECORDS. ST1444.2 +094000 RETURN ST-FS1 RECORD INTO SQ-FS4R1-F-G-132 ST1444.2 +094100 AT END GO TO CLOSE-AFTER-SORT. ST1444.2 +094200X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1444.2 +094300X WRITE PRINT-REC FROM REST-OF-4. ST1444.2 +094400X MOVE SPACES TO PRINT-REC. ST1444.2 +094500 WRITE SQ-FS4R1-F-G-132. ST1444.2 +094600 GO TO RETURN-THE-OLD-RECORDS. ST1444.2 +094700 CLOSE-AFTER-SORT. ST1444.2 +094800 CLOSE SQ-FS4. ST1444.2 +094900 CCVS-EXIT SECTION. ST1444.2 +095000 CCVS-999999. ST1444.2 +095100 GO TO CLOSE-FILES. ST1444.2 +*END-OF,ST144A +*HEADER,COBOL,ST146A TES00010 +000100 IDENTIFICATION DIVISION. ST1464.2 +000200 PROGRAM-ID. ST1464.2 +000300 ST146A. ST1464.2 +000400**************************************************************** ST1464.2 +000500* * ST1464.2 +000600* VALIDATION FOR:- * ST1464.2 +000700* * ST1464.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +000900* * ST1464.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1464.2 +001100* * ST1464.2 +001200**************************************************************** ST1464.2 +001300* * ST1464.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1464.2 +001500* * ST1464.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1464.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1464.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1464.2 +001900* * ST1464.2 +002000**************************************************************** ST1464.2 +002100* ST1464.2 +002200* ST146A TESTS OPERATIONS INVOLVING FORMAT 2 OCCURS CLAUSES, ST1464.2 +002300* I.E. ...OCCURS INTEGER-1 TO INTEGER-2 TIMES DEPENDING ON ST1464.2 +002400* DATA-NAME-1 .... ST1464.2 +002500* X3.23-1976, PAGE III-4, 2.1.4(3) STATES, IN PART, THAT ST1464.2 +002600* INTEGER-2 REPRESENTS THE MAXIMUM NUMBER OF OCCURRENCES AND ST1464.2 +002700* THAT ONLY THE NUMBER OF OCCURRENCES, AND NOT THE ITEM LENGTH,ST1464.2 +002800* IS VARIABLE. WHENEVER THE PARENT GROUP ITEM IS REFERENCED, ST1464.2 +002900* ONLY THE PORTION OF THE TABLE SPECIFIED BY THE CURRENT VALUE ST1464.2 +003000* OF DATA-NAME-1 WILL BE USED IN THE OPERATION. ST1464.2 +003100* ST1464.2 +003200* THE SORT VERB IS EXERCIZED BUT NOT CHECKED FOR ITS ST1464.2 +003300* CAPABILITY TO MEANINGFULLY SORT A FILE. INSTEAD, THE ST1464.2 +003400* OBJECT OF ST146A IS TO CHECK THE BEHAVIOR OF VARIABLE ST1464.2 +003500* LENGTH TABLES BEING HANDLED IN THE IMPLICIT MOVES ST1464.2 +003600* RESULTING FROM ST1464.2 +003700* RELEASE ... FROM ... ST1464.2 +003800* AND ST1464.2 +003900* RETURN ... INTO ... ST1464.2 +004000* STATEMENTS. ST1464.2 +004100* ST1464.2 +004200* ST1464.2 +004300 ENVIRONMENT DIVISION. ST1464.2 +004400 CONFIGURATION SECTION. ST1464.2 +004500 SOURCE-COMPUTER. ST1464.2 +004600 XXXXX082. ST1464.2 +004700 OBJECT-COMPUTER. ST1464.2 +004800 XXXXX083. ST1464.2 +004900 INPUT-OUTPUT SECTION. ST1464.2 +005000 FILE-CONTROL. ST1464.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1464.2 +005200 XXXXX055. ST1464.2 +005300 SELECT SQ-FS1 ASSIGN TO ST1464.2 +005400 XXXXX014. ST1464.2 +005500 SELECT SQ-FS2 ASSIGN TO ST1464.2 +005600 XXXXX015. ST1464.2 +005700 SELECT ST-FR1 ASSIGN TO ST1464.2 +005800 XXXXX027. ST1464.2 +005900 DATA DIVISION. ST1464.2 +006000 FILE SECTION. ST1464.2 +006100 FD PRINT-FILE. ST1464.2 +006200 01 PRINT-REC PICTURE X(120). ST1464.2 +006300 01 DUMMY-RECORD PICTURE X(120). ST1464.2 +006400 FD SQ-FS1 ST1464.2 +006500C VALUE OF ST1464.2 +006600C XXXXX074 ST1464.2 +006700C IS ST1464.2 +006800C XXXXX075 ST1464.2 +006900G XXXXX069 ST1464.2 +007000 LABEL RECORD IS STANDARD. ST1464.2 +007100 01 SQ-FS1R1-F-G-140. ST1464.2 +007200 02 FS1R1-XN-120 PIC X(120). ST1464.2 +007300 02 FS1R1-XN-20 PIC X(20). ST1464.2 +007400 FD SQ-FS2 ST1464.2 +007500C VALUE OF ST1464.2 +007600C XXXXX074 ST1464.2 +007700C IS ST1464.2 +007800C XXXXX076 ST1464.2 +007900G XXXXX069 ST1464.2 +008000 LABEL RECORD IS STANDARD. ST1464.2 +008100 01 SQ-FS2R1-F-G-140. ST1464.2 +008200 02 FS2R1-XN-120 PIC X(120). ST1464.2 +008300 02 FS2R1-XN-20 PIC X(20). ST1464.2 +008400 SD ST-FR1. ST1464.2 +008500 01 ST-FR1R1-F-G-140. ST1464.2 +008600 02 FILLER PIC X(34). ST1464.2 +008700 02 SORT-KEY-FIELD-XN-00006 PIC X(6). ST1464.2 +008800 02 FILLER PIC X(100). ST1464.2 +008900 WORKING-STORAGE SECTION. ST1464.2 +009000 01 ODO-RECORD. ST1464.2 +009100 02 FILLER PIC X(5). ST1464.2 +009200 02 SO-FILE-NAME PIC X(6). ST1464.2 +009300 02 FILLER PIC X(23). ST1464.2 +009400 02 SO-RECNO PIC X(6). ST1464.2 +009500 02 FILLER PIC X(80). ST1464.2 +009600 02 GRP-ODO. ST1464.2 +009700 03 DOI-DU-01V00 PIC 9. ST1464.2 +009800 03 ODO-XN-00009 PIC X(9). ST1464.2 +009900 03 ODO-GRP-00009. ST1464.2 +010000 04 ODO-XN-00001-O009D OCCURS 1 TO 9 TIMES DEPENDING ON ST1464.2 +010100 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D ST1464.2 +010200 INDEXED BY ODO-IX PIC X. ST1464.2 +010300 01 STATIC-VALUE. ST1464.2 +010400 02 FILLER PIC 9 VALUE 9. ST1464.2 +010500 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". ST1464.2 +010600 01 WRK-GRP-00019. ST1464.2 +010700 02 WRK-DU-01V00 PIC 9. ST1464.2 +010800 02 WRK-XN-00009-1 PIC X(9). ST1464.2 +010900 02 WRK-XN-00009-2 PIC X(9). ST1464.2 +011000 01 WRK-GRP-00009. ST1464.2 +011100 02 ODO-XN-00003 PIC X(3). ST1464.2 +011200 02 ODO-XN-00006 PIC X(6). ST1464.2 +011300 01 WRK-GRP-0009A REDEFINES WRK-GRP-00009. ST1464.2 +011400 02 ODO-XN-00005 PIC X(5). ST1464.2 +011500 02 ODO-XN-00004 PIC X(4). ST1464.2 +011600 01 WRK-DU-05V00 PIC 9(5). ST1464.2 +011700 01 WRK-XN-00020 PIC X(20). ST1464.2 +011800 01 WRK-XN-00010 PIC X(10). ST1464.2 +011900 01 FILE-RECORD-INFORMATION-REC. ST1464.2 +012000 03 FILE-RECORD-INFO-SKELETON. ST1464.2 +012100 05 FILLER PICTURE X(48) VALUE ST1464.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1464.2 +012300 05 FILLER PICTURE X(46) VALUE ST1464.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1464.2 +012500 05 FILLER PICTURE X(26) VALUE ST1464.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". ST1464.2 +012700 05 FILLER PICTURE X(37) VALUE ST1464.2 +012800 ",RECKEY= ". ST1464.2 +012900 05 FILLER PICTURE X(38) VALUE ST1464.2 +013000 ",ALTKEY1= ". ST1464.2 +013100 05 FILLER PICTURE X(38) VALUE ST1464.2 +013200 ",ALTKEY2= ". ST1464.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.ST1464.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1464.2 +013500 05 FILE-RECORD-INFO-P1-120. ST1464.2 +013600 07 FILLER PIC X(5). ST1464.2 +013700 07 XFILE-NAME PIC X(6). ST1464.2 +013800 07 FILLER PIC X(8). ST1464.2 +013900 07 XRECORD-NAME PIC X(6). ST1464.2 +014000 07 FILLER PIC X(1). ST1464.2 +014100 07 REELUNIT-NUMBER PIC 9(1). ST1464.2 +014200 07 FILLER PIC X(7). ST1464.2 +014300 07 XRECORD-NUMBER PIC 9(6). ST1464.2 +014400 07 FILLER PIC X(6). ST1464.2 +014500 07 UPDATE-NUMBER PIC 9(2). ST1464.2 +014600 07 FILLER PIC X(5). ST1464.2 +014700 07 ODO-NUMBER PIC 9(4). ST1464.2 +014800 07 FILLER PIC X(5). ST1464.2 +014900 07 XPROGRAM-NAME PIC X(5). ST1464.2 +015000 07 FILLER PIC X(7). ST1464.2 +015100 07 XRECORD-LENGTH PIC 9(6). ST1464.2 +015200 07 FILLER PIC X(7). ST1464.2 +015300 07 CHARS-OR-RECORDS PIC X(2). ST1464.2 +015400 07 FILLER PIC X(1). ST1464.2 +015500 07 XBLOCK-SIZE PIC 9(4). ST1464.2 +015600 07 FILLER PIC X(6). ST1464.2 +015700 07 RECORDS-IN-FILE PIC 9(6). ST1464.2 +015800 07 FILLER PIC X(5). ST1464.2 +015900 07 XFILE-ORGANIZATION PIC X(2). ST1464.2 +016000 07 FILLER PIC X(6). ST1464.2 +016100 07 XLABEL-TYPE PIC X(1). ST1464.2 +016200 05 FILE-RECORD-INFO-P121-240. ST1464.2 +016300 07 FILLER PIC X(8). ST1464.2 +016400 07 XRECORD-KEY PIC X(29). ST1464.2 +016500 07 FILLER PIC X(9). ST1464.2 +016600 07 ALTERNATE-KEY1 PIC X(29). ST1464.2 +016700 07 FILLER PIC X(9). ST1464.2 +016800 07 ALTERNATE-KEY2 PIC X(29). ST1464.2 +016900 07 FILLER PIC X(7). ST1464.2 +017000 01 TEST-RESULTS. ST1464.2 +017100 02 FILLER PIC X VALUE SPACE. ST1464.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. ST1464.2 +017300 02 FILLER PIC X VALUE SPACE. ST1464.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. ST1464.2 +017500 02 FILLER PIC X VALUE SPACE. ST1464.2 +017600 02 PAR-NAME. ST1464.2 +017700 03 FILLER PIC X(19) VALUE SPACE. ST1464.2 +017800 03 PARDOT-X PIC X VALUE SPACE. ST1464.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. ST1464.2 +018000 02 FILLER PIC X(8) VALUE SPACE. ST1464.2 +018100 02 RE-MARK PIC X(61). ST1464.2 +018200 01 TEST-COMPUTED. ST1464.2 +018300 02 FILLER PIC X(30) VALUE SPACE. ST1464.2 +018400 02 FILLER PIC X(17) VALUE ST1464.2 +018500 " COMPUTED=". ST1464.2 +018600 02 COMPUTED-X. ST1464.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1464.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A ST1464.2 +018900 PIC -9(9).9(9). ST1464.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1464.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1464.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1464.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. ST1464.2 +019400 04 COMPUTED-18V0 PIC -9(18). ST1464.2 +019500 04 FILLER PIC X. ST1464.2 +019600 03 FILLER PIC X(50) VALUE SPACE. ST1464.2 +019700 01 TEST-CORRECT. ST1464.2 +019800 02 FILLER PIC X(30) VALUE SPACE. ST1464.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1464.2 +020000 02 CORRECT-X. ST1464.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1464.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1464.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1464.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1464.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1464.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. ST1464.2 +020700 04 CORRECT-18V0 PIC -9(18). ST1464.2 +020800 04 FILLER PIC X. ST1464.2 +020900 03 FILLER PIC X(2) VALUE SPACE. ST1464.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1464.2 +021100 01 CCVS-C-1. ST1464.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1464.2 +021300- "SS PARAGRAPH-NAME ST1464.2 +021400- " REMARKS". ST1464.2 +021500 02 FILLER PIC X(20) VALUE SPACE. ST1464.2 +021600 01 CCVS-C-2. ST1464.2 +021700 02 FILLER PIC X VALUE SPACE. ST1464.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". ST1464.2 +021900 02 FILLER PIC X(15) VALUE SPACE. ST1464.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". ST1464.2 +022100 02 FILLER PIC X(94) VALUE SPACE. ST1464.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1464.2 +022300 01 REC-CT PIC 99 VALUE ZERO. ST1464.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1464.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1464.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1464.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1464.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1464.2 +023300 01 CCVS-H-1. ST1464.2 +023400 02 FILLER PIC X(39) VALUE SPACES. ST1464.2 +023500 02 FILLER PIC X(42) VALUE ST1464.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1464.2 +023700 02 FILLER PIC X(39) VALUE SPACES. ST1464.2 +023800 01 CCVS-H-2A. ST1464.2 +023900 02 FILLER PIC X(40) VALUE SPACE. ST1464.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1464.2 +024100 02 FILLER PIC XXXX VALUE ST1464.2 +024200 "4.2 ". ST1464.2 +024300 02 FILLER PIC X(28) VALUE ST1464.2 +024400 " COPY - NOT FOR DISTRIBUTION". ST1464.2 +024500 02 FILLER PIC X(41) VALUE SPACE. ST1464.2 +024600 ST1464.2 +024700 01 CCVS-H-2B. ST1464.2 +024800 02 FILLER PIC X(15) VALUE ST1464.2 +024900 "TEST RESULT OF ". ST1464.2 +025000 02 TEST-ID PIC X(9). ST1464.2 +025100 02 FILLER PIC X(4) VALUE ST1464.2 +025200 " IN ". ST1464.2 +025300 02 FILLER PIC X(12) VALUE ST1464.2 +025400 " HIGH ". ST1464.2 +025500 02 FILLER PIC X(22) VALUE ST1464.2 +025600 " LEVEL VALIDATION FOR ". ST1464.2 +025700 02 FILLER PIC X(58) VALUE ST1464.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +025900 01 CCVS-H-3. ST1464.2 +026000 02 FILLER PIC X(34) VALUE ST1464.2 +026100 " FOR OFFICIAL USE ONLY ". ST1464.2 +026200 02 FILLER PIC X(58) VALUE ST1464.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1464.2 +026400 02 FILLER PIC X(28) VALUE ST1464.2 +026500 " COPYRIGHT 1985 ". ST1464.2 +026600 01 CCVS-E-1. ST1464.2 +026700 02 FILLER PIC X(52) VALUE SPACE. ST1464.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1464.2 +026900 02 ID-AGAIN PIC X(9). ST1464.2 +027000 02 FILLER PIC X(45) VALUE SPACES. ST1464.2 +027100 01 CCVS-E-2. ST1464.2 +027200 02 FILLER PIC X(31) VALUE SPACE. ST1464.2 +027300 02 FILLER PIC X(21) VALUE SPACE. ST1464.2 +027400 02 CCVS-E-2-2. ST1464.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1464.2 +027600 03 FILLER PIC X VALUE SPACE. ST1464.2 +027700 03 ENDER-DESC PIC X(44) VALUE ST1464.2 +027800 "ERRORS ENCOUNTERED". ST1464.2 +027900 01 CCVS-E-3. ST1464.2 +028000 02 FILLER PIC X(22) VALUE ST1464.2 +028100 " FOR OFFICIAL USE ONLY". ST1464.2 +028200 02 FILLER PIC X(12) VALUE SPACE. ST1464.2 +028300 02 FILLER PIC X(58) VALUE ST1464.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +028500 02 FILLER PIC X(13) VALUE SPACE. ST1464.2 +028600 02 FILLER PIC X(15) VALUE ST1464.2 +028700 " COPYRIGHT 1985". ST1464.2 +028800 01 CCVS-E-4. ST1464.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1464.2 +029000 02 FILLER PIC X(4) VALUE " OF ". ST1464.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1464.2 +029200 02 FILLER PIC X(40) VALUE ST1464.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1464.2 +029400 01 XXINFO. ST1464.2 +029500 02 FILLER PIC X(19) VALUE ST1464.2 +029600 "*** INFORMATION ***". ST1464.2 +029700 02 INFO-TEXT. ST1464.2 +029800 04 FILLER PIC X(8) VALUE SPACE. ST1464.2 +029900 04 XXCOMPUTED PIC X(20). ST1464.2 +030000 04 FILLER PIC X(5) VALUE SPACE. ST1464.2 +030100 04 XXCORRECT PIC X(20). ST1464.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). ST1464.2 +030300 01 HYPHEN-LINE. ST1464.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. ST1464.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************ST1464.2 +030600- "*****************************************". ST1464.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************ST1464.2 +030800- "******************************". ST1464.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE ST1464.2 +031000 "ST146A". ST1464.2 +031100 PROCEDURE DIVISION. ST1464.2 +031200 CCVS1 SECTION. ST1464.2 +031300 OPEN-FILES. ST1464.2 +031400 OPEN OUTPUT PRINT-FILE. ST1464.2 +031500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1464.2 +031600 MOVE SPACE TO TEST-RESULTS. ST1464.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1464.2 +031800 MOVE ZERO TO REC-SKL-SUB. ST1464.2 +031900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1464.2 +032000 CCVS-INIT-FILE. ST1464.2 +032100 ADD 1 TO REC-SKL-SUB. ST1464.2 +032200 MOVE FILE-RECORD-INFO-SKELETON ST1464.2 +032300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1464.2 +032400 CCVS-INIT-EXIT. ST1464.2 +032500 GO TO CCVS1-EXIT. ST1464.2 +032600 CLOSE-FILES. ST1464.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1464.2 +032800 TERMINATE-CCVS. ST1464.2 +032900S EXIT PROGRAM. ST1464.2 +033000STERMINATE-CALL. ST1464.2 +033100 STOP RUN. ST1464.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1464.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1464.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1464.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1464.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. ST1464.2 +033700 PRINT-DETAIL. ST1464.2 +033800 IF REC-CT NOT EQUAL TO ZERO ST1464.2 +033900 MOVE "." TO PARDOT-X ST1464.2 +034000 MOVE REC-CT TO DOTVALUE. ST1464.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1464.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1464.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1464.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1464.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1464.2 +034600 MOVE SPACE TO CORRECT-X. ST1464.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1464.2 +034800 MOVE SPACE TO RE-MARK. ST1464.2 +034900 HEAD-ROUTINE. ST1464.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1464.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1464.2 +035400 COLUMN-NAMES-ROUTINE. ST1464.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +035800 END-ROUTINE. ST1464.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1464.2 +036000 END-RTN-EXIT. ST1464.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +036200 END-ROUTINE-1. ST1464.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1464.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1464.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. ST1464.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1464.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1464.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1464.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1464.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1464.2 +037100 END-ROUTINE-12. ST1464.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1464.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1464.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1464.2 +037500 ELSE ST1464.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1464.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1464.2 +037800 PERFORM WRITE-LINE. ST1464.2 +037900 END-ROUTINE-13. ST1464.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1464.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE ST1464.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1464.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1464.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO ST1464.2 +038600 MOVE "NO " TO ERROR-TOTAL ST1464.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1464.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1464.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +039100 WRITE-LINE. ST1464.2 +039200 ADD 1 TO RECORD-COUNT. ST1464.2 +039300Y IF RECORD-COUNT GREATER 42 ST1464.2 +039400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1464.2 +039500Y MOVE SPACE TO DUMMY-RECORD ST1464.2 +039600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1464.2 +039700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1464.2 +039800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1464.2 +039900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1464.2 +040000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1464.2 +040100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1464.2 +040500Y MOVE ZERO TO RECORD-COUNT. ST1464.2 +040600 PERFORM WRT-LN. ST1464.2 +040700 WRT-LN. ST1464.2 +040800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1464.2 +040900 MOVE SPACE TO DUMMY-RECORD. ST1464.2 +041000 BLANK-LINE-PRINT. ST1464.2 +041100 PERFORM WRT-LN. ST1464.2 +041200 FAIL-ROUTINE. ST1464.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE ST1464.2 +041400 GO TO FAIL-ROUTINE-WRITE. ST1464.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1464.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1464.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1464.2 +041800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +041900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1464.2 +042000 GO TO FAIL-ROUTINE-EX. ST1464.2 +042100 FAIL-ROUTINE-WRITE. ST1464.2 +042200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1464.2 +042300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1464.2 +042400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1464.2 +042500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1464.2 +042600 FAIL-ROUTINE-EX. EXIT. ST1464.2 +042700 BAIL-OUT. ST1464.2 +042800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1464.2 +042900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1464.2 +043000 BAIL-OUT-WRITE. ST1464.2 +043100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1464.2 +043200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1464.2 +043300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +043400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1464.2 +043500 BAIL-OUT-EX. EXIT. ST1464.2 +043600 CCVS1-EXIT. ST1464.2 +043700 EXIT. ST1464.2 +043800 BEGIN-ST216-TESTS SECTION. ST1464.2 +043900 INIT-WRK-AREA. ST1464.2 +044000 MOVE STATIC-VALUE TO WRK-GRP-00019. ST1464.2 +044100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +044200 MOVE " ACTIVE: " TO ODO-XN-00009. ST1464.2 +044300 MOVE "1" TO ODO-XN-00001-O009D (1). ST1464.2 +044400 MOVE "2" TO ODO-XN-00001-O009D (2). ST1464.2 +044500 MOVE "3" TO ODO-XN-00001-O009D (3). ST1464.2 +044600 MOVE "4" TO ODO-XN-00001-O009D (4). ST1464.2 +044700 MOVE "5" TO ODO-XN-00001-O009D (5). ST1464.2 +044800 MOVE "6" TO ODO-XN-00001-O009D (6). ST1464.2 +044900 MOVE "7" TO ODO-XN-00001-O009D (7). ST1464.2 +045000 MOVE "8" TO ODO-XN-00001-O009D (8). ST1464.2 +045100 MOVE "9" TO ODO-XN-00001-O009D (9). ST1464.2 +045200 BUILD-SQ-FS1 SECTION. ST1464.2 +045300 BUILD-SQ-FS1-PARA1. ST1464.2 +045400 OPEN OUTPUT SQ-FS1. ST1464.2 +045500 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1464.2 +045600 MOVE "FS1R1 " TO XRECORD-NAME (1). ST1464.2 +045700 MOVE "ST216" TO XPROGRAM-NAME (1). ST1464.2 +045800 MOVE 140 TO XRECORD-LENGTH (1). ST1464.2 +045900 MOVE "1R" TO CHARS-OR-RECORDS (1). ST1464.2 +046000 MOVE 4000 TO RECORDS-IN-FILE (1). ST1464.2 +046100 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1464.2 +046200 MOVE "S" TO XLABEL-TYPE (1). ST1464.2 +046300 PERFORM BUILD-SQ-FS1-PARA2 VARYING ODO-IX FROM 1 BY 1 ST1464.2 +046400 UNTIL ODO-IX IS GREATER THAN 1000. ST1464.2 +046500 GO TO BUILD-SQ-FS1-PARA3. ST1464.2 +046600 BUILD-SQ-FS1-PARA2. ST1464.2 +046700 SET XRECORD-NUMBER (1) TO ODO-IX. ST1464.2 +046800 MOVE 9 TO ODO-NUMBER (1). ST1464.2 +046900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. ST1464.2 +047000 PERFORM INIT-WRK-AREA. ST1464.2 +047100 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +047200 BUILD-SQ-FS1-PARA3. ST1464.2 +047300 CLOSE SQ-FS1. ST1464.2 +047400 END-OF-BUILD-SQ-FS1 SECTION. ST1464.2 +047500 EXECUTE-THE-SORT. ST1464.2 +047600 SORT ST-FR1 ON ASCENDING KEY SORT-KEY-FIELD-XN-00006 ST1464.2 +047700 INPUT PROCEDURE IS SORT-INPUT-PROCEDURES ST1464.2 +047800 OUTPUT PROCEDURE IS SORT-OUTPUT-PROCEDURES. ST1464.2 +047900XFILE-DUMP SECTION. ST1464.2 +048000XF-D-1. ST1464.2 +048100X PERFORM END-ROUTINE. ST1464.2 +048200X MOVE " DUMP OF FIRST 10 (OF 1000) RECORDS FROM SQ-FS1:" ST1464.2 +048300X TO PRINT-REC. ST1464.2 +048400X PERFORM WRITE-LINE. ST1464.2 +048500X PERFORM F-D-2 10 TIMES. ST1464.2 +048600X GO TO F-D-3. ST1464.2 +048700XF-D-2. ST1464.2 +048800X READ SQ-FS1 AT END GO TO F-D-3. ST1464.2 +048900X MOVE FS1R1-XN-120 TO PRINT-REC. ST1464.2 +049000X PERFORM WRITE-LINE. ST1464.2 +049100X MOVE FS1R1-XN-20 TO PRINT-REC. ST1464.2 +049200X PERFORM WRITE-LINE. ST1464.2 +049300XF-D-3. ST1464.2 +049400X CLOSE SQ-FS1. ST1464.2 +049500X OPEN INPUT SQ-FS2. ST1464.2 +049600X PERFORM END-ROUTINE. ST1464.2 +049700X MOVE " DUMP OF FIRST 10 (OF 1000) RECORDS FROM SQ-FS2:" ST1464.2 +049800X TO PRINT-REC. ST1464.2 +049900X PERFORM WRITE-LINE. ST1464.2 +050000X PERFORM F-D-4 10 TIMES. ST1464.2 +050100X GO TO F-D-5. ST1464.2 +050200XF-D-4. ST1464.2 +050300X READ SQ-FS2 AT END GO TO F-D-5. ST1464.2 +050400X MOVE FS2R1-XN-120 TO PRINT-REC. ST1464.2 +050500X PERFORM WRITE-LINE. ST1464.2 +050600X MOVE FS2R1-XN-20 TO PRINT-REC. ST1464.2 +050700X PERFORM WRITE-LINE. ST1464.2 +050800XF-D-5. ST1464.2 +050900X CLOSE SQ-FS2. ST1464.2 +051000 CCVS-EXIT SECTION. ST1464.2 +051100 CCVS-999999. ST1464.2 +051200 GO TO CLOSE-FILES. ST1464.2 +051300 SORT-INPUT-PROCEDURES SECTION. ST1464.2 +051400 S-I-P-1. ST1464.2 +051500 OPEN INPUT SQ-FS1. ST1464.2 +051600 MOVE 9 TO DOI-DU-01V00. ST1464.2 +051700 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +051800 MOVE 3 TO ODO-NUMBER (1). ST1464.2 +051900 MOVE 3 TO DOI-DU-01V00. ST1464.2 +052000 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +052100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +052200 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +052300 MOVE 7 TO ODO-NUMBER (1). ST1464.2 +052400 MOVE 7 TO DOI-DU-01V00. ST1464.2 +052500 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +052600 S-I-P-2. ST1464.2 +052700 MOVE 9 TO DOI-DU-01V00. ST1464.2 +052800 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +052900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +053000 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +053100 GO TO S-I-P-2. ST1464.2 +053200 S-I-P-3. ST1464.2 +053300 CLOSE SQ-FS1. ST1464.2 +053400 SORT-OUTPUT-PROCEDURES SECTION. ST1464.2 +053500 S-O-P-1. ST1464.2 +053600 OPEN OUTPUT SQ-FS2. ST1464.2 +053700 MOVE "OCCURS DEPENDING ON" TO FEATURE. ST1464.2 +053800 CLEAR-ODO-RECORD. ST1464.2 +053900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054000 MOVE SPACES TO ODO-RECORD. ST1464.2 +054100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054200 RELEASE-TEST-1. ST1464.2 +054300 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RELEASE-DELETE-1. ST1464.2 +054400 IF SO-RECNO NOT EQUAL TO "000001" GO TO RELEASE-DELETE-1. ST1464.2 +054500 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054600 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +054700 IF ODO-XN-00003 IS EQUAL TO "123" AND ST1464.2 +054800 ODO-XN-00006 IS NOT EQUAL TO "456789" ST1464.2 +054900 PERFORM PASS-1 ST1464.2 +055000 ELSE ST1464.2 +055100 PERFORM FAIL-1 ST1464.2 +055200 MOVE "3 ACTIVE: 123" TO CORRECT-A ST1464.2 +055300 MOVE 9 TO DOI-DU-01V00 ST1464.2 +055400 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +055500 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +055600 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +055700 GO TO RELEASE-WRITE-1. ST1464.2 +055800 RELEASE-DELETE-1. ST1464.2 +055900 PERFORM DE-LETE-1. ST1464.2 +056000 RELEASE-WRITE-1. ST1464.2 +056100 MOVE "RELEASE-TEST-1" TO PAR-NAME. ST1464.2 +056200 MOVE "RELEASE 3 ODO - RETURN 9 ODO" TO RE-MARK. ST1464.2 +056300 PERFORM PRINT-DETAIL-1. ST1464.2 +056400 RETURN-TEST-1. ST1464.2 +056500 PERFORM CLEAR-ODO-RECORD. ST1464.2 +056600 MOVE 5 TO DOI-DU-01V00. ST1464.2 +056700 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RETURN-DELETE-1. ST1464.2 +056800 IF SO-RECNO NOT EQUAL TO "000002" GO TO RETURN-DELETE-1. ST1464.2 +056900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +057000 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +057100 IF ODO-XN-00005 IS EQUAL TO "12345" AND ST1464.2 +057200 ODO-XN-00004 IS NOT EQUAL TO "6789" ST1464.2 +057300 PERFORM PASS-1 ST1464.2 +057400 ELSE ST1464.2 +057500 PERFORM FAIL-1 ST1464.2 +057600 MOVE "7 ACTIVE: 12345" TO CORRECT-A ST1464.2 +057700 MOVE 7 TO DOI-DU-01V00 ST1464.2 +057800 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +057900 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +058000 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +058100 GO TO RETURN-WRITE-1. ST1464.2 +058200 RETURN-DELETE-1. ST1464.2 +058300 PERFORM DE-LETE-1. ST1464.2 +058400 RETURN-WRITE-1. ST1464.2 +058500 MOVE "RETURN-TEST-1" TO PAR-NAME. ST1464.2 +058600 MOVE "RELEASE 7 ODO - RETURN 5 ODO" TO RE-MARK. ST1464.2 +058700 PERFORM PRINT-DETAIL-1. ST1464.2 +058800 RELEASE-TEST-2. ST1464.2 +058900 PERFORM CLEAR-ODO-RECORD. ST1464.2 +059000 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RELEASE-DELETE-2. ST1464.2 +059100 IF SO-RECNO NOT EQUAL TO "000003" GO TO RELEASE-DELETE-2. ST1464.2 +059200 IF GRP-ODO IS EQUAL TO "9 ACTIVE: 123456789" ST1464.2 +059300 PERFORM PASS-1 ST1464.2 +059400 ELSE ST1464.2 +059500 PERFORM FAIL-1 ST1464.2 +059600 MOVE "9 ACTIVE: 123456789" TO CORRECT-A ST1464.2 +059700 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +059800 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +059900 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +060000 GO TO RELEASE-WRITE-2. ST1464.2 +060100 RELEASE-DELETE-2. ST1464.2 +060200 PERFORM DE-LETE-1. ST1464.2 +060300 RELEASE-WRITE-2. ST1464.2 +060400 MOVE "RELEASE-TEST-2" TO PAR-NAME. ST1464.2 +060500 MOVE "RELEASE 9 ODO - RETURN 9 ODO" TO RE-MARK. ST1464.2 +060600 PERFORM PRINT-DETAIL-1. ST1464.2 +060700 RETURN-TEST-2. ST1464.2 +060800 PERFORM CLEAR-ODO-RECORD. ST1464.2 +060900 MOVE 3 TO DOI-DU-01V00. ST1464.2 +061000 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RETURN-DELETE-2. ST1464.2 +061100 IF SO-RECNO NOT EQUAL TO "000004" GO TO RETURN-DELETE-2. ST1464.2 +061200 MOVE 9 TO DOI-DU-01V00. ST1464.2 +061300 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +061400 IF ODO-XN-00003 IS EQUAL TO "123" AND ST1464.2 +061500 ODO-XN-00006 IS EQUAL TO "456789" ST1464.2 +061600 PERFORM PASS-1 ST1464.2 +061700 ELSE ST1464.2 +061800 PERFORM FAIL-1 ST1464.2 +061900 MOVE "9 ACTIVE: 123456789" TO CORRECT-A ST1464.2 +062000 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +062100 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +062200 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +062300 GO TO RETURN-WRITE-2. ST1464.2 +062400 RETURN-DELETE-2. ST1464.2 +062500 PERFORM DE-LETE-1. ST1464.2 +062600 RETURN-WRITE-2. ST1464.2 +062700 MOVE "RETURN-TEST-2" TO PAR-NAME. ST1464.2 +062800 MOVE "RELEASE 9 ODO - RETURN 6 ODO" TO RE-MARK. ST1464.2 +062900 PERFORM PRINT-DETAIL-1. ST1464.2 +063000 S-O-P-2. ST1464.2 +063100 PERFORM CLEAR-ODO-RECORD. ST1464.2 +063200 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO S-O-P-3. ST1464.2 +063300 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +063400 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +063500 GO TO S-O-P-2. ST1464.2 +063600 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1464.2 +063700 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1464.2 +063800 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1464.2 +063900 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1464.2 +064000 MOVE "****TEST DELETED****" TO RE-MARK. ST1464.2 +064100 PRINT-DETAIL-1. ST1464.2 +064200 IF REC-CT NOT EQUAL TO ZERO ST1464.2 +064300 MOVE "." TO PARDOT-X ST1464.2 +064400 MOVE REC-CT TO DOTVALUE. ST1464.2 +064500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1464.2 +064600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1464.2 +064700 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1464.2 +064800 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1464.2 +064900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1464.2 +065000 MOVE SPACE TO CORRECT-X. ST1464.2 +065100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1464.2 +065200 MOVE SPACE TO RE-MARK. ST1464.2 +065300 WRITE-LINE-1. ST1464.2 +065400 ADD 1 TO RECORD-COUNT. ST1464.2 +065500Y IF RECORD-COUNT GREATER 50 ST1464.2 +065600Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1464.2 +065700Y MOVE SPACE TO DUMMY-RECORD ST1464.2 +065800Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1464.2 +065900Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1464.2 +066000Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1464.2 +066100Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1464.2 +066200Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1464.2 +066300Y MOVE ZERO TO RECORD-COUNT. ST1464.2 +066400 PERFORM WRT-LN-1. ST1464.2 +066500 WRT-LN-1. ST1464.2 +066600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1464.2 +066700 MOVE SPACE TO DUMMY-RECORD. ST1464.2 +066800 BLANK-LINE-PRINT-1. ST1464.2 +066900 PERFORM WRT-LN-1. ST1464.2 +067000 FAIL-ROUTINE-1. ST1464.2 +067100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1464.2 +067200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1464.2 +067300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1464.2 +067400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +067500 GO TO FAIL-ROUTINE-EX-1. ST1464.2 +067600 FAIL-RTN-WRITE-1. ST1464.2 +067700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1464.2 +067800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +067900 FAIL-ROUTINE-EX-1. EXIT. ST1464.2 +068000 BAIL-OUT-1. ST1464.2 +068100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1464.2 +068200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1464.2 +068300 BAIL-OUT-WRITE-1. ST1464.2 +068400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1464.2 +068500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +068600 BAIL-OUT-EX-1. EXIT. ST1464.2 +068700 S-O-P-3. ST1464.2 +068800 CLOSE SQ-FS2. ST1464.2 +*END-OF,ST146A TES07470 +*HEADER,COBOL,ST147A +000100 IDENTIFICATION DIVISION. ST1474.2 +000200 PROGRAM-ID. ST1474.2 +000300 ST147A. ST1474.2 +000400**************************************************************** ST1474.2 +000500* * ST1474.2 +000600* VALIDATION FOR:- * ST1474.2 +000700* * ST1474.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +000900* * ST1474.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1474.2 +001100* * ST1474.2 +001200**************************************************************** ST1474.2 +001300* ST1474.2 +001400* OBJECTIVE - ST1474.2 +001500* ROUTINE ST147A IS A TEST OF THE MERGE STATEMENT USING ST1474.2 +001600* A NATIVE COLLATING SEQUENCE AND FIXED LENGTH RECORDS. ST1474.2 +001700* ST1474.2 +001800* TWO FILES ARE FIRST CREATED BY THE ROUTINE IN DESCENDING ST1474.2 +001900* NATIVE ORDER. THE MERGE STATEMENT IS USED TO MERGE THE TWO ST1474.2 +002000* FILES AND PRODUCE, IN DESCENDING NATIVE COLLATING ST1474.2 +002100* SEQUENCE ORDER, 3 OUTPUT FILES FROM A SINGLE "MERGE" ST1474.2 +002200* STATEMENT. ST1474.2 +002300* ST1474.2 +002400* FEATURES TESTED - ST1474.2 +002500* * FIXED LENGTH RECORDS ST1474.2 +002600* * SAME SORT-MERGE AREA IN THE I-O-CONTROL PARAGRAPH ST1474.2 +002700* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1474.2 +002800* * USING FILE-NAME SERIES ST1474.2 +002900* ST1474.2 +003000* * MERGE MERGE-FILE-NAME ST1474.2 +003100* DESCENDING KEY-1 OF DATA-NAME-1 ST1474.2 +003200* ON DESCENDING KEY KEY-2 OF DATA-NAME-2 ST1474.2 +003300* USING FILE-NAME-2 FILE-NAME-1 ST1474.2 +003400* GIVING FILE-NAME-3, FILE-NAME-4, FILE-NAME-5. ST1474.2 +003500* ST1474.2 +003600* FILES USED - ST1474.2 +003700* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1474.2 +003800* ARE FIRST CREATED. THE MERGE STATEMENT ST1474.2 +003900* USES BOTH OF THESE FILES AND CREATES OUTPUT FILES ST1474.2 +004000* SQ-FS3, SQ-FS4 AND SQ-FS5. ST1474.2 +004100* ST1474.2 +004200* SQ-FS1 ST1474.2 +004300* 51 RECORDS ST1474.2 +004400* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +004500* BLOCKED 1 ST1474.2 +004600* RESERVE 2 AREAS ST1474.2 +004700* ST1474.2 +004800* SQ-FS2 ST1474.2 +004900* 51 RECORDS ST1474.2 +005000* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +005100* BLOCKED 2 ST1474.2 +005200* RESERVE 4 AREAS ST1474.2 +005300* ST1474.2 +005400* SQ-FS3, SQ-FS4 AND SQ-FS5 ST1474.2 +005500* FINAL TOTAL OF 102 RECORDS ST1474.2 +005600* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +005700* BLOCKED 3 ST1474.2 +005800* RESERVE 4 AREAS ST1474.2 +005900* ST1474.2 +006000* NOTE THAT SQ-FS3 IS THE RESULT OF MERGING SQ-FS1 AND ST1474.2 +006100* SQ-FS2. THE RECORDS IN SQ-FS3 SHOULD ALTERNATE BETWEEN ST1474.2 +006200* SQ-FS1 AND SQ-FS2 BECAUSE THE ALPHANUMERIC KEYS ARE THE SAME ST1474.2 +006300* FOR BOTH FILES AND THE NUMERIC KEYS WERE MERGED INTO ST1474.2 +006400* DESCENDING ORDER. FILES SQ-FS4 AND SQ-FS5 ARE ST1474.2 +006500* IDENTICAL TO SQ-FS3. ST1474.2 +006600* ST1474.2 +006700* X-CARDS USED - ST1474.2 +006800* X-XXX014 SQ-FS1 ST1474.2 +006900* X-XXX015 SQ-FS2 ST1474.2 +007000* X-XXX016 SQ-FS3 ST1474.2 +007100* X-XXX018 SQ-FS5 ST1474.2 +007200* X-XXX027 MERGE FILE ST-FS1 ST1474.2 +007300* X-55 SYSTEM PRINTER NAME. ST1474.2 +007400* X-60 SQ-FS4 ST1474.2 +007500* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER-NOTE ST1474.2 +007600* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-64 ST1474.2 +007700* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1474.2 +007800* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1474.2 +007900* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1474.2 +008000* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-64 CARD..... ST1474.2 +008100* ST1474.2 +008200* X-63 " $$()*+,./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1474.2 +008300* X-69 OPTIONAL VALUE OF CLAUSE ST1474.2 +008400* X-74 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008500* X-75 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008600* X-76 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008700* X-77 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008800* X-78 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008900* X-79 VALUE OF CLAUSE NAME PHRASES ST1474.2 +009000* X-82 SOURCE COMPUTER NAME. ST1474.2 +009100* X-83 OBJECT COMPUTER NAME. ST1474.2 +009200* ST1474.2 +009300* ST1474.2 +009400* OPTIONS RECOMMENDED - ST1474.2 +009500* * OPT SW6 - X TO BE USED IF NECESSARY TO DUMP THE ST1474.2 +009600* FILES AS THEY ARE CREATED AND READ ST1474.2 +009700* DURING TESTS 3 THRU 8, 11 THRU 16, ST1474.2 +009800* AND 19 THRU 24. ST1474.2 +009900* ST1474.2 +010000* TEST DESCRIPTIONS - ST1474.2 +010100* MRG-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1474.2 +010200* MRG-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1474.2 +010300* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS3 ST1474.2 +010400* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS3 ST1474.2 +010500* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS3 ST1474.2 +010600* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS3 ST1474.2 +010700* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS3 ST1474.2 +010800* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS3ST1474.2 +010900* MRG-TEST-009 AN EOF CHECK ON SQ-FS3 ST1474.2 +011000* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1474.2 +011100* RECORD ON SQ-FS3 EQUALS 51 ST1474.2 +011200* MRG-TEST-011 ST1474.2 +011300* TO ST1474.2 +011400* MRG-TEST-018 SAME TESTS ON SQ-FS4 ST1474.2 +011500* MRG-TEST-019 ST1474.2 +011600* TO ST1474.2 +011700* MRG-TEST-026 SAME TESTS ON SQ-FS5 ST1474.2 +011800* ST1474.2 +011900* ************************************************************ ST1474.2 +012000 ENVIRONMENT DIVISION. ST1474.2 +012100 CONFIGURATION SECTION. ST1474.2 +012200 SOURCE-COMPUTER. ST1474.2 +012300 XXXXX082. ST1474.2 +012400 OBJECT-COMPUTER. ST1474.2 +012500 XXXXX083. ST1474.2 +012600 INPUT-OUTPUT SECTION. ST1474.2 +012700 FILE-CONTROL. ST1474.2 +012800 SELECT PRINT-FILE ASSIGN TO ST1474.2 +012900 XXXXX055. ST1474.2 +013000 SELECT SQ-FS1 ASSIGN ST1474.2 +013100 XXXXX014 ST1474.2 +013200 ; ORGANIZATION IS SEQUENTIAL ST1474.2 +013300 ; ACCESS MODE SEQUENTIAL ST1474.2 +013400 ; RESERVE 2 AREAS. ST1474.2 +013500 SELECT SQ-FS2 ASSIGN TO ST1474.2 +013600 XXXXX015 ST1474.2 +013700 ORGANIZATION IS SEQUENTIAL ST1474.2 +013800 ACCESS MODE IS SEQUENTIAL ST1474.2 +013900 RESERVE 4 AREAS. ST1474.2 +014000 SELECT SQ-FS3 ASSIGN TO ST1474.2 +014100 XXXXX016 ST1474.2 +014200 ORGANIZATION IS SEQUENTIAL ST1474.2 +014300 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +014400 RESERVE 4 AREAS. ST1474.2 +014500 SELECT SQ-FS4 ASSIGN TO ST1474.2 +014600 XXXXX060 ST1474.2 +014700 ORGANIZATION IS SEQUENTIAL ST1474.2 +014800 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +014900 RESERVE 4 AREAS. ST1474.2 +015000 SELECT SQ-FS5 ASSIGN TO ST1474.2 +015100 XXXXX018 ST1474.2 +015200 ORGANIZATION IS SEQUENTIAL ST1474.2 +015300 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +015400 RESERVE 4 AREAS. ST1474.2 +015500 SELECT ST-FS1 ASSIGN TO ST1474.2 +015600 XXXXX027. ST1474.2 +015700 I-O-CONTROL. ST1474.2 +015800* SAME SORT-MERGE AREA FOR SQ-FS1, ST-FS1. ST1474.2 +015900 DATA DIVISION. ST1474.2 +016000 FILE SECTION. ST1474.2 +016100 FD PRINT-FILE. ST1474.2 +016200 01 PRINT-REC PICTURE X(120). ST1474.2 +016300 01 DUMMY-RECORD PICTURE X(120). ST1474.2 +016400 FD SQ-FS1 ST1474.2 +016500 LABEL RECORDS STANDARD ST1474.2 +016600C VALUE OF ST1474.2 +016700C XXXXX074 ST1474.2 +016800C XXXXX075 ST1474.2 +016900C BLOCK CONTAINS 1 RECORDS ST1474.2 +017000G XXXXX069 ST1474.2 +017100 RECORD CONTAINS 132 CHARACTERS. ST1474.2 +017200 01 SQ-FS1R1-F-G-132. ST1474.2 +017300 10 REC-PREAMBLE PIC X(120). ST1474.2 +017400 10 REST-OF-1. ST1474.2 +017500 20 KEY-1. ST1474.2 +017600 30 ALPHAN-KEY PIC X. ST1474.2 +017700 30 NUM-KEY PIC 999. ST1474.2 +017800 20 KEY-2. ST1474.2 +017900 30 ALPHAN-KEY PIC X. ST1474.2 +018000 30 NUM-KEY PIC 999. ST1474.2 +018100 20 KEY-3. ST1474.2 +018200 30 ALPHAN-KEY PIC X. ST1474.2 +018300 30 NUM-KEY PIC 999. ST1474.2 +018400 FD SQ-FS2 ST1474.2 +018500 LABEL RECORD IS STANDARD ST1474.2 +018600C ; VALUE OF ST1474.2 +018700C XXXXX074 ST1474.2 +018800C IS ST1474.2 +018900C XXXXX076 ST1474.2 +019000G XXXXX069 ST1474.2 +019100 ; BLOCK CONTAINS 2 RECORDS ST1474.2 +019200 ; RECORD CONTAINS 132 CHARACTERS ST1474.2 +019300 DATA RECORD SQ-FS2R1-F-G-132. ST1474.2 +019400 01 SQ-FS2R1-F-G-132. ST1474.2 +019500 10 REC-PRE-2 PIC X(120). ST1474.2 +019600 10 REST-OF-2. ST1474.2 +019700 20 KEY-4. ST1474.2 +019800 30 ALPHAN-KEY PIC X. ST1474.2 +019900 30 NUM-KEY PIC 999. ST1474.2 +020000 20 KEY-5. ST1474.2 +020100 30 ALPHAN-KEY PIC X. ST1474.2 +020200 30 NUM-KEY PIC 999. ST1474.2 +020300 20 KEY-6. ST1474.2 +020400 30 ALPHAN-KEY PIC X. ST1474.2 +020500 30 NUM-KEY PIC 999. ST1474.2 +020600 FD SQ-FS3 ST1474.2 +020700 LABEL RECORD IS STANDARD ST1474.2 +020800C ; VALUE OF ST1474.2 +020900C XXXXX074 ST1474.2 +021000C IS ST1474.2 +021100C XXXXX077 ST1474.2 +021200G XXXXX069 ST1474.2 +021300 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +021400 RECORD CONTAINS 132 CHARACTERS ST1474.2 +021500 DATA RECORD SQ-FS3R1-F-G-132. ST1474.2 +021600 01 SQ-FS3R1-F-G-132. ST1474.2 +021700 10 REC-PRE-3 PIC X(120). ST1474.2 +021800 10 REST-OF-3. ST1474.2 +021900 20 KEY-7. ST1474.2 +022000 30 ALPHAN-KEY PIC X. ST1474.2 +022100 30 NUM-KEY PIC 999. ST1474.2 +022200 20 KEY-8. ST1474.2 +022300 30 ALPHAN-KEY PIC X. ST1474.2 +022400 30 NUM-KEY PIC 999. ST1474.2 +022500 20 KEY-9. ST1474.2 +022600 30 ALPHAN-KEY PIC X. ST1474.2 +022700 30 NUM-KEY PIC 999. ST1474.2 +022800 FD SQ-FS4 ST1474.2 +022900 LABEL RECORD IS STANDARD ST1474.2 +023000C ; VALUE OF ST1474.2 +023100C XXXXX074 ST1474.2 +023200C IS ST1474.2 +023300C XXXXX078 ST1474.2 +023400G XXXXX069 ST1474.2 +023500 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +023600 RECORD CONTAINS 132 CHARACTERS ST1474.2 +023700 DATA RECORD SQ-FS4R1-F-G-132. ST1474.2 +023800 01 SQ-FS4R1-F-G-132. ST1474.2 +023900 10 REC-PRE-4 PIC X(120). ST1474.2 +024000 10 REST-OF-4. ST1474.2 +024100 20 KEY-10. ST1474.2 +024200 30 ALPHAN-KEY PIC X. ST1474.2 +024300 30 NUM-KEY PIC 999. ST1474.2 +024400 20 KEY-11. ST1474.2 +024500 30 ALPHAN-KEY PIC X. ST1474.2 +024600 30 NUM-KEY PIC 999. ST1474.2 +024700 20 KEY-12. ST1474.2 +024800 30 ALPHAN-KEY PIC X. ST1474.2 +024900 30 NUM-KEY PIC 999. ST1474.2 +025000 FD SQ-FS5 ST1474.2 +025100 LABEL RECORD IS STANDARD ST1474.2 +025200C ; VALUE OF ST1474.2 +025300C XXXXX074 ST1474.2 +025400C IS ST1474.2 +025500C XXXXX079 ST1474.2 +025600G XXXXX069 ST1474.2 +025700 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +025800 RECORD CONTAINS 132 CHARACTERS ST1474.2 +025900 DATA RECORD SQ-FS5R1-F-G-132. ST1474.2 +026000 01 SQ-FS5R1-F-G-132. ST1474.2 +026100 10 REC-PRE-5 PIC X(120). ST1474.2 +026200 10 REST-OF-5. ST1474.2 +026300 20 KEY-13. ST1474.2 +026400 30 ALPHAN-KEY PIC X. ST1474.2 +026500 30 NUM-KEY PIC 999. ST1474.2 +026600 20 KEY-14. ST1474.2 +026700 30 ALPHAN-KEY PIC X. ST1474.2 +026800 30 NUM-KEY PIC 999. ST1474.2 +026900 20 KEY-15. ST1474.2 +027000 30 ALPHAN-KEY PIC X. ST1474.2 +027100 30 NUM-KEY PIC 999. ST1474.2 +027200 SD ST-FS1 ST1474.2 +027300 RECORD CONTAINS 132 CHARACTERS ST1474.2 +027400 DATA RECORD IS ST-FS1R1-F-G-132. ST1474.2 +027500 01 ST-FS1R1-F-G-132. ST1474.2 +027600 02 FILLER PIC X(120). ST1474.2 +027700 02 NON-KEY-1. ST1474.2 +027800 03 A-KEY PIC X. ST1474.2 +027900 03 N-KEY PIC 999. ST1474.2 +028000 02 SORT-KEY. ST1474.2 +028100 03 A-KEY PIC X. ST1474.2 +028200 03 N-KEY PIC 999. ST1474.2 +028300 02 NON-KEY-2. ST1474.2 +028400 03 A-KEY PIC X. ST1474.2 +028500 03 N-KEY PIC 999. ST1474.2 +028600 WORKING-STORAGE SECTION. ST1474.2 +028700 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1474.2 +028800 77 WRK-DU-999-0001 PIC 999. ST1474.2 +028900 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1474.2 +029000 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1474.2 +029100 01 WRK-XN-0001 PIC X(51) VALUE ST1474.2 +029200 XXXXX063. ST1474.2 +029300 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1474.2 +029400 02 CHAR PIC X OCCURS 51 TIMES. ST1474.2 +029500 01 WRK-XN-2 PIC X(51) VALUE ST1474.2 +029600 XXXXX063. ST1474.2 +029700 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1474.2 +029800 02 ASCIIS PIC X OCCURS 51 TIMES. ST1474.2 +029900 01 WRK-XN-O020F-0001. ST1474.2 +030000 02 COMPU PIC X OCCURS 20 TIMES. ST1474.2 +030100 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1474.2 +030200 02 FILLER PIC X(20). ST1474.2 +030300 01 WRK-XN-O120F-1. ST1474.2 +030400 02 COLLS PIC X OCCURS 120 TIMES. ST1474.2 +030500 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1474.2 +030600 02 WRK-XN-0002 PIC X(20). ST1474.2 +030700 02 WRK-XN-0003 PIC X(20). ST1474.2 +030800 02 WRK-XN-0004 PIC X(20). ST1474.2 +030900 02 WRK-XN-0005 PIC X(20). ST1474.2 +031000 02 WRK-XN-0006 PIC X(20). ST1474.2 +031100 02 WRK-XN-0007 PIC X(20). ST1474.2 +031200 01 FILE-RECORD-INFORMATION-REC. ST1474.2 +031300 03 FILE-RECORD-INFO-SKELETON. ST1474.2 +031400 05 FILLER PICTURE X(48) VALUE ST1474.2 +031500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1474.2 +031600 05 FILLER PICTURE X(46) VALUE ST1474.2 +031700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1474.2 +031800 05 FILLER PICTURE X(26) VALUE ST1474.2 +031900 ",LFIL=000000,ORG= ,LBLR= ". ST1474.2 +032000 05 FILLER PICTURE X(37) VALUE ST1474.2 +032100 ",RECKEY= ". ST1474.2 +032200 05 FILLER PICTURE X(38) VALUE ST1474.2 +032300 ",ALTKEY1= ". ST1474.2 +032400 05 FILLER PICTURE X(38) VALUE ST1474.2 +032500 ",ALTKEY2= ". ST1474.2 +032600 05 FILLER PICTURE X(7) VALUE SPACE.ST1474.2 +032700 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1474.2 +032800 05 FILE-RECORD-INFO-P1-120. ST1474.2 +032900 07 FILLER PIC X(5). ST1474.2 +033000 07 XFILE-NAME PIC X(6). ST1474.2 +033100 07 FILLER PIC X(8). ST1474.2 +033200 07 XRECORD-NAME PIC X(6). ST1474.2 +033300 07 FILLER PIC X(1). ST1474.2 +033400 07 REELUNIT-NUMBER PIC 9(1). ST1474.2 +033500 07 FILLER PIC X(7). ST1474.2 +033600 07 XRECORD-NUMBER PIC 9(6). ST1474.2 +033700 07 FILLER PIC X(6). ST1474.2 +033800 07 UPDATE-NUMBER PIC 9(2). ST1474.2 +033900 07 FILLER PIC X(5). ST1474.2 +034000 07 ODO-NUMBER PIC 9(4). ST1474.2 +034100 07 FILLER PIC X(5). ST1474.2 +034200 07 XPROGRAM-NAME PIC X(5). ST1474.2 +034300 07 FILLER PIC X(7). ST1474.2 +034400 07 XRECORD-LENGTH PIC 9(6). ST1474.2 +034500 07 FILLER PIC X(7). ST1474.2 +034600 07 CHARS-OR-RECORDS PIC X(2). ST1474.2 +034700 07 FILLER PIC X(1). ST1474.2 +034800 07 XBLOCK-SIZE PIC 9(4). ST1474.2 +034900 07 FILLER PIC X(6). ST1474.2 +035000 07 RECORDS-IN-FILE PIC 9(6). ST1474.2 +035100 07 FILLER PIC X(5). ST1474.2 +035200 07 XFILE-ORGANIZATION PIC X(2). ST1474.2 +035300 07 FILLER PIC X(6). ST1474.2 +035400 07 XLABEL-TYPE PIC X(1). ST1474.2 +035500 05 FILE-RECORD-INFO-P121-240. ST1474.2 +035600 07 FILLER PIC X(8). ST1474.2 +035700 07 XRECORD-KEY PIC X(29). ST1474.2 +035800 07 FILLER PIC X(9). ST1474.2 +035900 07 ALTERNATE-KEY1 PIC X(29). ST1474.2 +036000 07 FILLER PIC X(9). ST1474.2 +036100 07 ALTERNATE-KEY2 PIC X(29). ST1474.2 +036200 07 FILLER PIC X(7). ST1474.2 +036300 01 TEST-RESULTS. ST1474.2 +036400 02 FILLER PIC X VALUE SPACE. ST1474.2 +036500 02 FEATURE PIC X(20) VALUE SPACE. ST1474.2 +036600 02 FILLER PIC X VALUE SPACE. ST1474.2 +036700 02 P-OR-F PIC X(5) VALUE SPACE. ST1474.2 +036800 02 FILLER PIC X VALUE SPACE. ST1474.2 +036900 02 PAR-NAME. ST1474.2 +037000 03 FILLER PIC X(19) VALUE SPACE. ST1474.2 +037100 03 PARDOT-X PIC X VALUE SPACE. ST1474.2 +037200 03 DOTVALUE PIC 99 VALUE ZERO. ST1474.2 +037300 02 FILLER PIC X(8) VALUE SPACE. ST1474.2 +037400 02 RE-MARK PIC X(61). ST1474.2 +037500 01 TEST-COMPUTED. ST1474.2 +037600 02 FILLER PIC X(30) VALUE SPACE. ST1474.2 +037700 02 FILLER PIC X(17) VALUE ST1474.2 +037800 " COMPUTED=". ST1474.2 +037900 02 COMPUTED-X. ST1474.2 +038000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1474.2 +038100 03 COMPUTED-N REDEFINES COMPUTED-A ST1474.2 +038200 PIC -9(9).9(9). ST1474.2 +038300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1474.2 +038400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1474.2 +038500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1474.2 +038600 03 CM-18V0 REDEFINES COMPUTED-A. ST1474.2 +038700 04 COMPUTED-18V0 PIC -9(18). ST1474.2 +038800 04 FILLER PIC X. ST1474.2 +038900 03 FILLER PIC X(50) VALUE SPACE. ST1474.2 +039000 01 TEST-CORRECT. ST1474.2 +039100 02 FILLER PIC X(30) VALUE SPACE. ST1474.2 +039200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1474.2 +039300 02 CORRECT-X. ST1474.2 +039400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1474.2 +039500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1474.2 +039600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1474.2 +039700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1474.2 +039800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1474.2 +039900 03 CR-18V0 REDEFINES CORRECT-A. ST1474.2 +040000 04 CORRECT-18V0 PIC -9(18). ST1474.2 +040100 04 FILLER PIC X. ST1474.2 +040200 03 FILLER PIC X(2) VALUE SPACE. ST1474.2 +040300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1474.2 +040400 01 CCVS-C-1. ST1474.2 +040500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1474.2 +040600- "SS PARAGRAPH-NAME ST1474.2 +040700- " REMARKS". ST1474.2 +040800 02 FILLER PIC X(20) VALUE SPACE. ST1474.2 +040900 01 CCVS-C-2. ST1474.2 +041000 02 FILLER PIC X VALUE SPACE. ST1474.2 +041100 02 FILLER PIC X(6) VALUE "TESTED". ST1474.2 +041200 02 FILLER PIC X(15) VALUE SPACE. ST1474.2 +041300 02 FILLER PIC X(4) VALUE "FAIL". ST1474.2 +041400 02 FILLER PIC X(94) VALUE SPACE. ST1474.2 +041500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1474.2 +041600 01 REC-CT PIC 99 VALUE ZERO. ST1474.2 +041700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1474.2 +041800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1474.2 +041900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1474.2 +042000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1474.2 +042100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1474.2 +042200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1474.2 +042300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1474.2 +042400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1474.2 +042500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1474.2 +042600 01 CCVS-H-1. ST1474.2 +042700 02 FILLER PIC X(39) VALUE SPACES. ST1474.2 +042800 02 FILLER PIC X(42) VALUE ST1474.2 +042900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1474.2 +043000 02 FILLER PIC X(39) VALUE SPACES. ST1474.2 +043100 01 CCVS-H-2A. ST1474.2 +043200 02 FILLER PIC X(40) VALUE SPACE. ST1474.2 +043300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1474.2 +043400 02 FILLER PIC XXXX VALUE ST1474.2 +043500 "4.2 ". ST1474.2 +043600 02 FILLER PIC X(28) VALUE ST1474.2 +043700 " COPY - NOT FOR DISTRIBUTION". ST1474.2 +043800 02 FILLER PIC X(41) VALUE SPACE. ST1474.2 +043900 ST1474.2 +044000 01 CCVS-H-2B. ST1474.2 +044100 02 FILLER PIC X(15) VALUE ST1474.2 +044200 "TEST RESULT OF ". ST1474.2 +044300 02 TEST-ID PIC X(9). ST1474.2 +044400 02 FILLER PIC X(4) VALUE ST1474.2 +044500 " IN ". ST1474.2 +044600 02 FILLER PIC X(12) VALUE ST1474.2 +044700 " HIGH ". ST1474.2 +044800 02 FILLER PIC X(22) VALUE ST1474.2 +044900 " LEVEL VALIDATION FOR ". ST1474.2 +045000 02 FILLER PIC X(58) VALUE ST1474.2 +045100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +045200 01 CCVS-H-3. ST1474.2 +045300 02 FILLER PIC X(34) VALUE ST1474.2 +045400 " FOR OFFICIAL USE ONLY ". ST1474.2 +045500 02 FILLER PIC X(58) VALUE ST1474.2 +045600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1474.2 +045700 02 FILLER PIC X(28) VALUE ST1474.2 +045800 " COPYRIGHT 1985 ". ST1474.2 +045900 01 CCVS-E-1. ST1474.2 +046000 02 FILLER PIC X(52) VALUE SPACE. ST1474.2 +046100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1474.2 +046200 02 ID-AGAIN PIC X(9). ST1474.2 +046300 02 FILLER PIC X(45) VALUE SPACES. ST1474.2 +046400 01 CCVS-E-2. ST1474.2 +046500 02 FILLER PIC X(31) VALUE SPACE. ST1474.2 +046600 02 FILLER PIC X(21) VALUE SPACE. ST1474.2 +046700 02 CCVS-E-2-2. ST1474.2 +046800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1474.2 +046900 03 FILLER PIC X VALUE SPACE. ST1474.2 +047000 03 ENDER-DESC PIC X(44) VALUE ST1474.2 +047100 "ERRORS ENCOUNTERED". ST1474.2 +047200 01 CCVS-E-3. ST1474.2 +047300 02 FILLER PIC X(22) VALUE ST1474.2 +047400 " FOR OFFICIAL USE ONLY". ST1474.2 +047500 02 FILLER PIC X(12) VALUE SPACE. ST1474.2 +047600 02 FILLER PIC X(58) VALUE ST1474.2 +047700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +047800 02 FILLER PIC X(13) VALUE SPACE. ST1474.2 +047900 02 FILLER PIC X(15) VALUE ST1474.2 +048000 " COPYRIGHT 1985". ST1474.2 +048100 01 CCVS-E-4. ST1474.2 +048200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1474.2 +048300 02 FILLER PIC X(4) VALUE " OF ". ST1474.2 +048400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1474.2 +048500 02 FILLER PIC X(40) VALUE ST1474.2 +048600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1474.2 +048700 01 XXINFO. ST1474.2 +048800 02 FILLER PIC X(19) VALUE ST1474.2 +048900 "*** INFORMATION ***". ST1474.2 +049000 02 INFO-TEXT. ST1474.2 +049100 04 FILLER PIC X(8) VALUE SPACE. ST1474.2 +049200 04 XXCOMPUTED PIC X(20). ST1474.2 +049300 04 FILLER PIC X(5) VALUE SPACE. ST1474.2 +049400 04 XXCORRECT PIC X(20). ST1474.2 +049500 02 INF-ANSI-REFERENCE PIC X(48). ST1474.2 +049600 01 HYPHEN-LINE. ST1474.2 +049700 02 FILLER PIC IS X VALUE IS SPACE. ST1474.2 +049800 02 FILLER PIC IS X(65) VALUE IS "************************ST1474.2 +049900- "*****************************************". ST1474.2 +050000 02 FILLER PIC IS X(54) VALUE IS "************************ST1474.2 +050100- "******************************". ST1474.2 +050200 01 CCVS-PGM-ID PIC X(9) VALUE ST1474.2 +050300 "ST147A". ST1474.2 +050400 PROCEDURE DIVISION. ST1474.2 +050500 DECLARATIVES. ST1474.2 +050600 SECT-ST209-DEC SECTION. ST1474.2 +050700 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1474.2 +050800 MRG-WRITE-DEC. ST1474.2 +050900 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1474.2 +051000 MOVE "MRG-TEST-DEC" TO PAR-NAME. ST1474.2 +051100 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1474.2 +051200 STOP RUN. ST1474.2 +051300 END DECLARATIVES. ST1474.2 +051400 CCVS1 SECTION. ST1474.2 +051500 OPEN-FILES. ST1474.2 +051600 OPEN OUTPUT PRINT-FILE. ST1474.2 +051700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1474.2 +051800 MOVE SPACE TO TEST-RESULTS. ST1474.2 +051900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1474.2 +052000 MOVE ZERO TO REC-SKL-SUB. ST1474.2 +052100 PERFORM CCVS-INIT-FILE 9 TIMES. ST1474.2 +052200 CCVS-INIT-FILE. ST1474.2 +052300 ADD 1 TO REC-SKL-SUB. ST1474.2 +052400 MOVE FILE-RECORD-INFO-SKELETON ST1474.2 +052500 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1474.2 +052600 CCVS-INIT-EXIT. ST1474.2 +052700 GO TO CCVS1-EXIT. ST1474.2 +052800 CLOSE-FILES. ST1474.2 +052900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1474.2 +053000 TERMINATE-CCVS. ST1474.2 +053100 STOP RUN. ST1474.2 +053200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1474.2 +053300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1474.2 +053400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1474.2 +053500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1474.2 +053600 MOVE "****TEST DELETED****" TO RE-MARK. ST1474.2 +053700 PRINT-DETAIL. ST1474.2 +053800 IF REC-CT NOT EQUAL TO ZERO ST1474.2 +053900 MOVE "." TO PARDOT-X ST1474.2 +054000 MOVE REC-CT TO DOTVALUE. ST1474.2 +054100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1474.2 +054200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1474.2 +054300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1474.2 +054400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1474.2 +054500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1474.2 +054600 MOVE SPACE TO CORRECT-X. ST1474.2 +054700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1474.2 +054800 MOVE SPACE TO RE-MARK. ST1474.2 +054900 HEAD-ROUTINE. ST1474.2 +055000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1474.2 +055300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1474.2 +055400 COLUMN-NAMES-ROUTINE. ST1474.2 +055500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +055600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +055800 END-ROUTINE. ST1474.2 +055900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1474.2 +056000 END-RTN-EXIT. ST1474.2 +056100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +056200 END-ROUTINE-1. ST1474.2 +056300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1474.2 +056400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1474.2 +056500 ADD PASS-COUNTER TO ERROR-HOLD. ST1474.2 +056600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1474.2 +056700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1474.2 +056800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1474.2 +056900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1474.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1474.2 +057100 END-ROUTINE-12. ST1474.2 +057200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1474.2 +057300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1474.2 +057400 MOVE "NO " TO ERROR-TOTAL ST1474.2 +057500 ELSE ST1474.2 +057600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1474.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1474.2 +057800 PERFORM WRITE-LINE. ST1474.2 +057900 END-ROUTINE-13. ST1474.2 +058000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1474.2 +058100 MOVE "NO " TO ERROR-TOTAL ELSE ST1474.2 +058200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1474.2 +058300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1474.2 +058400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +058500 IF INSPECT-COUNTER EQUAL TO ZERO ST1474.2 +058600 MOVE "NO " TO ERROR-TOTAL ST1474.2 +058700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1474.2 +058800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1474.2 +058900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +059000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +059100 WRITE-LINE. ST1474.2 +059200 ADD 1 TO RECORD-COUNT. ST1474.2 +059300Y IF RECORD-COUNT GREATER 42 ST1474.2 +059400Y MOVE DUMMY-RECORD TO DUMMY-HOLD ST1474.2 +059500Y MOVE SPACE TO DUMMY-RECORD ST1474.2 +059600Y WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1474.2 +059700Y MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1474.2 +059800Y MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1474.2 +059900Y MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1474.2 +060000Y MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1474.2 +060100Y MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060200Y MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060300Y MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060400Y MOVE DUMMY-HOLD TO DUMMY-RECORD ST1474.2 +060500Y MOVE ZERO TO RECORD-COUNT. ST1474.2 +060600 PERFORM WRT-LN. ST1474.2 +060700 WRT-LN. ST1474.2 +060800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1474.2 +060900 MOVE SPACE TO DUMMY-RECORD. ST1474.2 +061000 BLANK-LINE-PRINT. ST1474.2 +061100 PERFORM WRT-LN. ST1474.2 +061200 FAIL-ROUTINE. ST1474.2 +061300 IF COMPUTED-X NOT EQUAL TO SPACE ST1474.2 +061400 GO TO FAIL-ROUTINE-WRITE. ST1474.2 +061500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1474.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1474.2 +061700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1474.2 +061800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +061900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1474.2 +062000 GO TO FAIL-ROUTINE-EX. ST1474.2 +062100 FAIL-ROUTINE-WRITE. ST1474.2 +062200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1474.2 +062300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1474.2 +062400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1474.2 +062500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1474.2 +062600 FAIL-ROUTINE-EX. EXIT. ST1474.2 +062700 BAIL-OUT. ST1474.2 +062800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1474.2 +062900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1474.2 +063000 BAIL-OUT-WRITE. ST1474.2 +063100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1474.2 +063200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1474.2 +063300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +063400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1474.2 +063500 BAIL-OUT-EX. EXIT. ST1474.2 +063600 CCVS1-EXIT. ST1474.2 +063700 EXIT. ST1474.2 +063800 SECT-ST417-001 SECTION. ST1474.2 +063900 MRG-INIT-001. ST1474.2 +064000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1474.2 +064100 OPEN OUTPUT SQ-FS1. ST1474.2 +064200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1474.2 +064300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1474.2 +064400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1474.2 +064500 MOVE 000132 TO XRECORD-LENGTH (1). ST1474.2 +064600 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1474.2 +064700 MOVE 0001 TO XBLOCK-SIZE (1). ST1474.2 +064800 MOVE 000051 TO RECORDS-IN-FILE (1). ST1474.2 +064900 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1474.2 +065000 MOVE "S" TO XLABEL-TYPE (1). ST1474.2 +065100 MOVE 000001 TO XRECORD-NUMBER (1). ST1474.2 +065200 MOVE SPACES TO WRK-XN-O120F-1. ST1474.2 +065300 MRG-TEST-001. ST1474.2 +065400 PERFORM MRG-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1474.2 +065500 FROM 51 BY -1 UNTIL WRK-DU-999-0001 IS LESS THAN 1. ST1474.2 +065600X MOVE SPACES TO PRINT-REC. ST1474.2 +065700X WRITE PRINT-REC. ST1474.2 +065800 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1474.2 +065900 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1474.2 +066000 ELSE ST1474.2 +066100 PERFORM PASS. ST1474.2 +066200 GO TO MRG-WRITE-001. ST1474.2 +066300 MRG-TEST-001-BUILD. ST1474.2 +066400 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1474.2 +066500 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1474.2 +066600 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1474.2 +066700 NUM-KEY OF KEY-3. ST1474.2 +066800 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1474.2 +066900 ADD 1 TO XRECORD-NUMBER (1). ST1474.2 +067000 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1474.2 +067100 ADD 1 TO WRK-DU-999-2. ST1474.2 +067200 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1474.2 +067300 ADD 1 TO WRK-DU-999-2. ST1474.2 +067400X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1474.2 +067500X WRITE PRINT-REC FROM REST-OF-1. ST1474.2 +067600X MOVE SPACES TO PRINT-REC. ST1474.2 +067700 WRITE SQ-FS1R1-F-G-132. ST1474.2 +067800 MRG-DELETE-001. ST1474.2 +067900 PERFORM DE-LETE. ST1474.2 +068000 MRG-WRITE-001. ST1474.2 +068100 MOVE "MRG-TEST-001" TO PAR-NAME. ST1474.2 +068200 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1474.2 +068300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1474.2 +068400 PERFORM PRINT-DETAIL. ST1474.2 +068500X MOVE SPACES TO PRINT-REC. ST1474.2 +068600X WRITE PRINT-REC. ST1474.2 +068700 CLOSE SQ-FS1. ST1474.2 +068800 MRG-INIT-002. ST1474.2 +068900 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1474.2 +069000 OPEN OUTPUT SQ-FS2. ST1474.2 +069100 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1474.2 +069200 MOVE 000001 TO XRECORD-NUMBER (1). ST1474.2 +069300 MOVE 0002 TO XBLOCK-SIZE (1). ST1474.2 +069400 MRG-TEST-002. ST1474.2 +069500 PERFORM MRG-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1474.2 +069600 FROM 51 BY -1 UNTIL WRK-DU-999-0001 IS LESS THAN 1. ST1474.2 +069700X MOVE SPACES TO PRINT-REC. ST1474.2 +069800X WRITE PRINT-REC. ST1474.2 +069900 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1474.2 +070000 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1474.2 +070100 ELSE ST1474.2 +070200 PERFORM PASS. ST1474.2 +070300 GO TO MRG-WRITE-002. ST1474.2 +070400 MRG-TEST-002-BUILD. ST1474.2 +070500 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1474.2 +070600 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1474.2 +070700 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1474.2 +070800 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1474.2 +070900 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1474.2 +071000 ADD 000001 TO XRECORD-NUMBER (1). ST1474.2 +071100X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1474.2 +071200X WRITE PRINT-REC FROM REST-OF-2. ST1474.2 +071300X MOVE SPACES TO PRINT-REC. ST1474.2 +071400 WRITE SQ-FS2R1-F-G-132. ST1474.2 +071500 MRG-DELETE-002. ST1474.2 +071600 PERFORM DE-LETE. ST1474.2 +071700 MRG-WRITE-002. ST1474.2 +071800 MOVE "MRG-TEST-002" TO PAR-NAME. ST1474.2 +071900 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1474.2 +072000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1474.2 +072100 PERFORM PRINT-DETAIL. ST1474.2 +072200X MOVE SPACES TO PRINT-REC. ST1474.2 +072300X WRITE PRINT-REC. ST1474.2 +072400 CLOSE SQ-FS2. ST1474.2 +072500 MRG-INIT-003. ST1474.2 +072600* ==--> MULTIPLE "GIVING" FILES <--== ST1474.2 +072700 MOVE "XI-11 4.1.4 GR (11)" TO ANSI-REFERENCE. ST1474.2 +072800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +072900 MERGE ST-FS1 ST1474.2 +073000 DESCENDING A-KEY OF SORT-KEY ST1474.2 +073100 ON DESCENDING KEY N-KEY OF NON-KEY-1 ST1474.2 +073200 USING SQ-FS2 SQ-FS1 ST1474.2 +073300 GIVING SQ-FS3 SQ-FS4 SQ-FS5. ST1474.2 +073400 MRG-TEST-003. ST1474.2 +073500 OPEN INPUT SQ-FS3. ST1474.2 +073600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +073700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +073800X MOVE SPACES TO PRINT-REC. ST1474.2 +073900X WRITE PRINT-REC. ST1474.2 +074000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +074100 PERFORM FAIL GO TO MRG-FAIL-003 ST1474.2 +074200 ELSE ST1474.2 +074300 PERFORM PASS. ST1474.2 +074400 GO TO MRG-WRITE-003. ST1474.2 +074500 MRG-DELETE-003. ST1474.2 +074600 PERFORM DE-LETE. ST1474.2 +074700 GO TO MRG-WRITE-003. ST1474.2 +074800 MRG-FAIL-003. ST1474.2 +074900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +075000 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +075100 MRG-WRITE-003. ST1474.2 +075200 MOVE "MRG-TEST-003" TO PAR-NAME. ST1474.2 +075300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +075400 PERFORM PRINT-DETAIL. ST1474.2 +075500X MOVE SPACES TO PRINT-REC. ST1474.2 +075600X WRITE PRINT-REC. ST1474.2 +075700 MRG-INIT-004. ST1474.2 +075800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +075900 MRG-TEST-004. ST1474.2 +076000 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +076100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +076200X MOVE SPACES TO PRINT-REC. ST1474.2 +076300X WRITE PRINT-REC. ST1474.2 +076400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +076500 PERFORM FAIL GO TO MRG-FAIL-004 ST1474.2 +076600 ELSE ST1474.2 +076700 PERFORM PASS. ST1474.2 +076800 GO TO MRG-WRITE-004. ST1474.2 +076900 MRG-DELETE-004. ST1474.2 +077000 PERFORM DE-LETE. ST1474.2 +077100 GO TO MRG-WRITE-004. ST1474.2 +077200 MRG-FAIL-004. ST1474.2 +077300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +077400 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +077500 MRG-WRITE-004. ST1474.2 +077600 MOVE "MRG-TEST-004" TO PAR-NAME. ST1474.2 +077700 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +077800 PERFORM PRINT-DETAIL. ST1474.2 +077900X MOVE SPACES TO PRINT-REC. ST1474.2 +078000X WRITE PRINT-REC. ST1474.2 +078100 MRG-INIT-005. ST1474.2 +078200 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +078300 MRG-TEST-005. ST1474.2 +078400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +078500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +078600X MOVE SPACES TO PRINT-REC. ST1474.2 +078700X WRITE PRINT-REC. ST1474.2 +078800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +078900 PERFORM FAIL GO TO MRG-FAIL-005 ST1474.2 +079000 ELSE ST1474.2 +079100 PERFORM PASS. ST1474.2 +079200 GO TO MRG-WRITE-005. ST1474.2 +079300 MRG-DELETE-005. ST1474.2 +079400 PERFORM DE-LETE. ST1474.2 +079500 GO TO MRG-WRITE-005. ST1474.2 +079600 MRG-FAIL-005. ST1474.2 +079700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +079800 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +079900 MRG-WRITE-005. ST1474.2 +080000 MOVE "MRG-TEST-005" TO PAR-NAME. ST1474.2 +080100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +080200 PERFORM PRINT-DETAIL. ST1474.2 +080300X MOVE SPACES TO PRINT-REC. ST1474.2 +080400X WRITE PRINT-REC. ST1474.2 +080500 MRG-INIT-006. ST1474.2 +080600 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +080700 MRG-TEST-006. ST1474.2 +080800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +080900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +081000X MOVE SPACES TO PRINT-REC. ST1474.2 +081100X WRITE PRINT-REC. ST1474.2 +081200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +081300 PERFORM FAIL GO TO MRG-FAIL-006 ST1474.2 +081400 ELSE ST1474.2 +081500 PERFORM PASS. ST1474.2 +081600 GO TO MRG-WRITE-006. ST1474.2 +081700 MRG-DELETE-006. ST1474.2 +081800 PERFORM DE-LETE. ST1474.2 +081900 GO TO MRG-WRITE-006. ST1474.2 +082000 MRG-FAIL-006. ST1474.2 +082100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +082200 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +082300 MRG-WRITE-006. ST1474.2 +082400 MOVE "MRG-TEST-006" TO PAR-NAME. ST1474.2 +082500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +082600 PERFORM PRINT-DETAIL. ST1474.2 +082700X MOVE SPACES TO PRINT-REC. ST1474.2 +082800X WRITE PRINT-REC. ST1474.2 +082900 MRG-INIT-007. ST1474.2 +083000 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +083100 MRG-TEST-007. ST1474.2 +083200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +083300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +083400X MOVE SPACES TO PRINT-REC. ST1474.2 +083500X WRITE PRINT-REC. ST1474.2 +083600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +083700 PERFORM FAIL GO TO MRG-FAIL-007 ST1474.2 +083800 ELSE ST1474.2 +083900 PERFORM PASS. ST1474.2 +084000 GO TO MRG-WRITE-007. ST1474.2 +084100 MRG-DELETE-007. ST1474.2 +084200 PERFORM DE-LETE. ST1474.2 +084300 GO TO MRG-WRITE-007. ST1474.2 +084400 MRG-FAIL-007. ST1474.2 +084500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +084600 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +084700 MRG-WRITE-007. ST1474.2 +084800 MOVE "MRG-TEST-007" TO PAR-NAME. ST1474.2 +084900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +085000 PERFORM PRINT-DETAIL. ST1474.2 +085100X MOVE SPACES TO PRINT-REC. ST1474.2 +085200X WRITE PRINT-REC. ST1474.2 +085300 MRG-INIT-008. ST1474.2 +085400 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +085500 MRG-TEST-008. ST1474.2 +085600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +085700 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +085800X MOVE SPACES TO PRINT-REC. ST1474.2 +085900X WRITE PRINT-REC. ST1474.2 +086000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +086100 PERFORM FAIL GO TO MRG-FAIL-008 ST1474.2 +086200 ELSE ST1474.2 +086300 PERFORM PASS. ST1474.2 +086400 GO TO MRG-WRITE-008. ST1474.2 +086500 MRG-DELETE-008. ST1474.2 +086600 PERFORM DE-LETE. ST1474.2 +086700 GO TO MRG-WRITE-008. ST1474.2 +086800 MRG-FAIL-008. ST1474.2 +086900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +087000 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +087100 MRG-WRITE-008. ST1474.2 +087200 MOVE "MRG-TEST-008" TO PAR-NAME. ST1474.2 +087300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +087400 PERFORM PRINT-DETAIL. ST1474.2 +087500 MOVE NUM-KEY OF KEY-7 TO LAST-REC-NUM. ST1474.2 +087600 MRG-TEST-009. ST1474.2 +087700 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +087800 GO TO MRG-FAIL-009. ST1474.2 +087900 READ SQ-FS3 END PERFORM PASS ST1474.2 +088000 GO TO MRG-WRITE-009. ST1474.2 +088100 GO TO MRG-FAIL-009. ST1474.2 +088200 MRG-DELETE-009. ST1474.2 +088300 PERFORM DE-LETE. ST1474.2 +088400 GO TO MRG-WRITE-009. ST1474.2 +088500 MRG-FAIL-009. ST1474.2 +088600 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +088700 PERFORM FAIL . ST1474.2 +088800 MRG-WRITE-009. ST1474.2 +088900 MOVE "MRG-TEST-009" TO PAR-NAME. ST1474.2 +089000 MOVE "EOF CHECK SQ-FS3" TO FEATURE. ST1474.2 +089100 PERFORM PRINT-DETAIL. ST1474.2 +089200 MRG-TEST-010. ST1474.2 +089300 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +089400 PERFORM FAIL GO TO MRG-FAIL-010 ST1474.2 +089500 ELSE ST1474.2 +089600 PERFORM PASS. ST1474.2 +089700 GO TO MRG-WRITE-010. ST1474.2 +089800 MRG-DELETE-010. ST1474.2 +089900 PERFORM DE-LETE. ST1474.2 +090000 GO TO MRG-WRITE-010. ST1474.2 +090100 MRG-FAIL-010. ST1474.2 +090200 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +090300 MOVE 1 TO CR-18V0. ST1474.2 +090400 MRG-WRITE-010. ST1474.2 +090500 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +090600 MOVE "MRG-TEST-010" TO PAR-NAME. ST1474.2 +090700 PERFORM PRINT-DETAIL. ST1474.2 +090800 CLOSE SQ-FS3. ST1474.2 +090900 GO TO MRG-TEST-011. ST1474.2 +091000 READ-SQ-FS3 SECTION. ST1474.2 +091100 RD-1. ST1474.2 +091200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +091300 GO TO R1-EXIT. ST1474.2 +091400 READ SQ-FS3 AT END GO TO PREMATURE-EOF-1. ST1474.2 +091500X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1474.2 +091600X WRITE PRINT-REC FROM REST-OF-3. ST1474.2 +091700X MOVE SPACES TO PRINT-REC. ST1474.2 +091800 MOVE ALPHAN-KEY OF KEY-8 TO COMPU (WRK-DU-999-0001). ST1474.2 +091900 GO TO R1-EXIT. ST1474.2 +092000 PREMATURE-EOF-1. ST1474.2 +092100 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +092200 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +092300 R1-EXIT. ST1474.2 +092400 EXIT. ST1474.2 +092500* ST1474.2 +092600* ST1474.2 +092700 MRG-TEST-011. ST1474.2 +092800 OPEN INPUT SQ-FS4. ST1474.2 +092900 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +093000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +093100X MOVE SPACES TO PRINT-REC. ST1474.2 +093200X WRITE PRINT-REC. ST1474.2 +093300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +093400 PERFORM FAIL GO TO MRG-FAIL-011 ST1474.2 +093500 ELSE ST1474.2 +093600 PERFORM PASS. ST1474.2 +093700 GO TO MRG-WRITE-011. ST1474.2 +093800 MRG-DELETE-011. ST1474.2 +093900 PERFORM DE-LETE. ST1474.2 +094000 GO TO MRG-WRITE-011. ST1474.2 +094100 MRG-FAIL-011. ST1474.2 +094200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +094300 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +094400 MRG-WRITE-011. ST1474.2 +094500 MOVE "MRG-TEST-011" TO PAR-NAME. ST1474.2 +094600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +094700 PERFORM PRINT-DETAIL. ST1474.2 +094800X MOVE SPACES TO PRINT-REC. ST1474.2 +094900X WRITE PRINT-REC. ST1474.2 +095000 MRG-INIT-012. ST1474.2 +095100 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +095200 MRG-TEST-012. ST1474.2 +095300 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +095400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +095500X MOVE SPACES TO PRINT-REC. ST1474.2 +095600X WRITE PRINT-REC. ST1474.2 +095700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +095800 PERFORM FAIL GO TO MRG-FAIL-012 ST1474.2 +095900 ELSE ST1474.2 +096000 PERFORM PASS. ST1474.2 +096100 GO TO MRG-WRITE-012. ST1474.2 +096200 MRG-DELETE-012. ST1474.2 +096300 PERFORM DE-LETE. ST1474.2 +096400 GO TO MRG-WRITE-012. ST1474.2 +096500 MRG-FAIL-012. ST1474.2 +096600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +096700 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +096800 MRG-WRITE-012. ST1474.2 +096900 MOVE "MRG-TEST-012" TO PAR-NAME. ST1474.2 +097000 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +097100 PERFORM PRINT-DETAIL. ST1474.2 +097200X MOVE SPACES TO PRINT-REC. ST1474.2 +097300X WRITE PRINT-REC. ST1474.2 +097400 MRG-INIT-013. ST1474.2 +097500 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +097600 MRG-TEST-013. ST1474.2 +097700 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +097800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +097900X MOVE SPACES TO PRINT-REC. ST1474.2 +098000X WRITE PRINT-REC. ST1474.2 +098100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +098200 PERFORM FAIL GO TO MRG-FAIL-013 ST1474.2 +098300 ELSE ST1474.2 +098400 PERFORM PASS. ST1474.2 +098500 GO TO MRG-WRITE-013. ST1474.2 +098600 MRG-DELETE-013. ST1474.2 +098700 PERFORM DE-LETE. ST1474.2 +098800 GO TO MRG-WRITE-013. ST1474.2 +098900 MRG-FAIL-013. ST1474.2 +099000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +099100 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +099200 MRG-WRITE-013. ST1474.2 +099300 MOVE "MRG-TEST-013" TO PAR-NAME. ST1474.2 +099400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +099500 PERFORM PRINT-DETAIL. ST1474.2 +099600X MOVE SPACES TO PRINT-REC. ST1474.2 +099700X WRITE PRINT-REC. ST1474.2 +099800 MRG-INIT-014. ST1474.2 +099900 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +100000 MRG-TEST-014. ST1474.2 +100100 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +100200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +100300X MOVE SPACES TO PRINT-REC. ST1474.2 +100400X WRITE PRINT-REC. ST1474.2 +100500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +100600 PERFORM FAIL GO TO MRG-FAIL-014 ST1474.2 +100700 ELSE ST1474.2 +100800 PERFORM PASS. ST1474.2 +100900 GO TO MRG-WRITE-014. ST1474.2 +101000 MRG-DELETE-014. ST1474.2 +101100 PERFORM DE-LETE. ST1474.2 +101200 GO TO MRG-WRITE-014. ST1474.2 +101300 MRG-FAIL-014. ST1474.2 +101400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +101500 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +101600 MRG-WRITE-014. ST1474.2 +101700 MOVE "MRG-TEST-014" TO PAR-NAME. ST1474.2 +101800 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +101900 PERFORM PRINT-DETAIL. ST1474.2 +102000X MOVE SPACES TO PRINT-REC. ST1474.2 +102100X WRITE PRINT-REC. ST1474.2 +102200 MRG-INIT-015. ST1474.2 +102300 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +102400 MRG-TEST-015. ST1474.2 +102500 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +102600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +102700X MOVE SPACES TO PRINT-REC. ST1474.2 +102800X WRITE PRINT-REC. ST1474.2 +102900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +103000 PERFORM FAIL GO TO MRG-FAIL-015 ST1474.2 +103100 ELSE ST1474.2 +103200 PERFORM PASS. ST1474.2 +103300 GO TO MRG-WRITE-015. ST1474.2 +103400 MRG-DELETE-015. ST1474.2 +103500 PERFORM DE-LETE. ST1474.2 +103600 GO TO MRG-WRITE-015. ST1474.2 +103700 MRG-FAIL-015. ST1474.2 +103800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +103900 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +104000 MRG-WRITE-015. ST1474.2 +104100 MOVE "MRG-TEST-015" TO PAR-NAME. ST1474.2 +104200 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +104300 PERFORM PRINT-DETAIL. ST1474.2 +104400X MOVE SPACES TO PRINT-REC. ST1474.2 +104500X WRITE PRINT-REC. ST1474.2 +104600 MRG-INIT-016. ST1474.2 +104700 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +104800 MRG-TEST-016. ST1474.2 +104900 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +105000 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +105100X MOVE SPACES TO PRINT-REC. ST1474.2 +105200X WRITE PRINT-REC. ST1474.2 +105300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +105400 PERFORM FAIL GO TO MRG-FAIL-016 ST1474.2 +105500 ELSE ST1474.2 +105600 PERFORM PASS. ST1474.2 +105700 GO TO MRG-WRITE-016. ST1474.2 +105800 MRG-DELETE-016. ST1474.2 +105900 PERFORM DE-LETE. ST1474.2 +106000 GO TO MRG-WRITE-016. ST1474.2 +106100 MRG-FAIL-016. ST1474.2 +106200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +106300 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +106400 MRG-WRITE-016. ST1474.2 +106500 MOVE "MRG-TEST-016" TO PAR-NAME. ST1474.2 +106600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +106700 PERFORM PRINT-DETAIL. ST1474.2 +106800 MOVE NUM-KEY OF KEY-10 TO LAST-REC-NUM. ST1474.2 +106900 MRG-TEST-017. ST1474.2 +107000 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +107100 GO TO MRG-FAIL-017. ST1474.2 +107200 READ SQ-FS4 END PERFORM PASS ST1474.2 +107300 GO TO MRG-WRITE-017. ST1474.2 +107400 GO TO MRG-FAIL-017. ST1474.2 +107500 MRG-DELETE-017. ST1474.2 +107600 PERFORM DE-LETE. ST1474.2 +107700 GO TO MRG-WRITE-017. ST1474.2 +107800 MRG-FAIL-017. ST1474.2 +107900 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +108000 PERFORM FAIL . ST1474.2 +108100 MRG-WRITE-017. ST1474.2 +108200 MOVE "MRG-TEST-017" TO PAR-NAME. ST1474.2 +108300 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1474.2 +108400 PERFORM PRINT-DETAIL. ST1474.2 +108500 MRG-TEST-018. ST1474.2 +108600 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +108700 PERFORM FAIL GO TO MRG-FAIL-018 ST1474.2 +108800 ELSE ST1474.2 +108900 PERFORM PASS. ST1474.2 +109000 GO TO MRG-WRITE-018. ST1474.2 +109100 MRG-DELETE-018. ST1474.2 +109200 PERFORM DE-LETE. ST1474.2 +109300 GO TO MRG-WRITE-018. ST1474.2 +109400 MRG-FAIL-018. ST1474.2 +109500 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +109600 MOVE 1 TO CR-18V0. ST1474.2 +109700 MRG-WRITE-018. ST1474.2 +109800 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +109900 MOVE "MRG-TEST-018" TO PAR-NAME. ST1474.2 +110000 PERFORM PRINT-DETAIL. ST1474.2 +110100 CLOSE SQ-FS4. ST1474.2 +110200 GO TO MRG-TEST-019. ST1474.2 +110300 READ-SQ-FS4 SECTION. ST1474.2 +110400 RD-2. ST1474.2 +110500 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +110600 GO TO R2-EXIT. ST1474.2 +110700 READ SQ-FS4 AT END GO TO PREMATURE-EOF-2. ST1474.2 +110800X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1474.2 +110900X WRITE PRINT-REC FROM REST-OF-4. ST1474.2 +111000X MOVE SPACES TO PRINT-REC. ST1474.2 +111100 MOVE ALPHAN-KEY OF KEY-11 TO COMPU (WRK-DU-999-0001). ST1474.2 +111200 GO TO R2-EXIT. ST1474.2 +111300 PREMATURE-EOF-2. ST1474.2 +111400 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +111500 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +111600 R2-EXIT. ST1474.2 +111700 EXIT. ST1474.2 +111800* ST1474.2 +111900* ST1474.2 +112000 MRG-TEST-019. ST1474.2 +112100 OPEN INPUT SQ-FS5. ST1474.2 +112200 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +112300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +112400X MOVE SPACES TO PRINT-REC. ST1474.2 +112500X WRITE PRINT-REC. ST1474.2 +112600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +112700 PERFORM FAIL GO TO MRG-FAIL-019 ST1474.2 +112800 ELSE ST1474.2 +112900 PERFORM PASS. ST1474.2 +113000 GO TO MRG-WRITE-019. ST1474.2 +113100 MRG-DELETE-019. ST1474.2 +113200 PERFORM DE-LETE. ST1474.2 +113300 GO TO MRG-WRITE-019. ST1474.2 +113400 MRG-FAIL-019. ST1474.2 +113500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +113600 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +113700 MRG-WRITE-019. ST1474.2 +113800 MOVE "MRG-TEST-019" TO PAR-NAME. ST1474.2 +113900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +114000 PERFORM PRINT-DETAIL. ST1474.2 +114100X MOVE SPACES TO PRINT-REC. ST1474.2 +114200X WRITE PRINT-REC. ST1474.2 +114300 MRG-INIT-020. ST1474.2 +114400 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +114500 MRG-TEST-020. ST1474.2 +114600 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +114700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +114800X MOVE SPACES TO PRINT-REC. ST1474.2 +114900X WRITE PRINT-REC. ST1474.2 +115000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +115100 PERFORM FAIL GO TO MRG-FAIL-020 ST1474.2 +115200 ELSE ST1474.2 +115300 PERFORM PASS. ST1474.2 +115400 GO TO MRG-WRITE-020. ST1474.2 +115500 MRG-DELETE-020. ST1474.2 +115600 PERFORM DE-LETE. ST1474.2 +115700 GO TO MRG-WRITE-020. ST1474.2 +115800 MRG-FAIL-020. ST1474.2 +115900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +116000 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +116100 MRG-WRITE-020. ST1474.2 +116200 MOVE "MRG-TEST-020" TO PAR-NAME. ST1474.2 +116300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +116400 PERFORM PRINT-DETAIL. ST1474.2 +116500X MOVE SPACES TO PRINT-REC. ST1474.2 +116600X WRITE PRINT-REC. ST1474.2 +116700 MRG-INIT-021. ST1474.2 +116800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +116900 MRG-TEST-021. ST1474.2 +117000 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +117100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +117200X MOVE SPACES TO PRINT-REC. ST1474.2 +117300X WRITE PRINT-REC. ST1474.2 +117400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +117500 PERFORM FAIL GO TO MRG-FAIL-021 ST1474.2 +117600 ELSE ST1474.2 +117700 PERFORM PASS. ST1474.2 +117800 GO TO MRG-WRITE-021. ST1474.2 +117900 MRG-DELETE-021. ST1474.2 +118000 PERFORM DE-LETE. ST1474.2 +118100 GO TO MRG-WRITE-021. ST1474.2 +118200 MRG-FAIL-021. ST1474.2 +118300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +118400 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +118500 MRG-WRITE-021. ST1474.2 +118600 MOVE "MRG-TEST-021" TO PAR-NAME. ST1474.2 +118700 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +118800 PERFORM PRINT-DETAIL. ST1474.2 +118900X MOVE SPACES TO PRINT-REC. ST1474.2 +119000X WRITE PRINT-REC. ST1474.2 +119100 MRG-INIT-022. ST1474.2 +119200 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +119300 MRG-TEST-022. ST1474.2 +119400 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +119500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +119600X MOVE SPACES TO PRINT-REC. ST1474.2 +119700X WRITE PRINT-REC. ST1474.2 +119800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +119900 PERFORM FAIL GO TO MRG-FAIL-022 ST1474.2 +120000 ELSE ST1474.2 +120100 PERFORM PASS. ST1474.2 +120200 GO TO MRG-WRITE-022. ST1474.2 +120300 MRG-DELETE-022. ST1474.2 +120400 PERFORM DE-LETE. ST1474.2 +120500 GO TO MRG-WRITE-022. ST1474.2 +120600 MRG-FAIL-022. ST1474.2 +120700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +120800 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +120900 MRG-WRITE-022. ST1474.2 +121000 MOVE "MRG-TEST-022" TO PAR-NAME. ST1474.2 +121100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +121200 PERFORM PRINT-DETAIL. ST1474.2 +121300X MOVE SPACES TO PRINT-REC. ST1474.2 +121400X WRITE PRINT-REC. ST1474.2 +121500 MRG-INIT-023. ST1474.2 +121600 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +121700 MRG-TEST-023. ST1474.2 +121800 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +121900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +122000X MOVE SPACES TO PRINT-REC. ST1474.2 +122100X WRITE PRINT-REC. ST1474.2 +122200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +122300 PERFORM FAIL GO TO MRG-FAIL-023 ST1474.2 +122400 ELSE ST1474.2 +122500 PERFORM PASS. ST1474.2 +122600 GO TO MRG-WRITE-023. ST1474.2 +122700 MRG-DELETE-023. ST1474.2 +122800 PERFORM DE-LETE. ST1474.2 +122900 GO TO MRG-WRITE-023. ST1474.2 +123000 MRG-FAIL-023. ST1474.2 +123100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +123200 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +123300 MRG-WRITE-023. ST1474.2 +123400 MOVE "MRG-TEST-023" TO PAR-NAME. ST1474.2 +123500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +123600 PERFORM PRINT-DETAIL. ST1474.2 +123700X MOVE SPACES TO PRINT-REC. ST1474.2 +123800X WRITE PRINT-REC. ST1474.2 +123900 MRG-INIT-024. ST1474.2 +124000 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +124100 MRG-TEST-024. ST1474.2 +124200 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +124300 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +124400X MOVE SPACES TO PRINT-REC. ST1474.2 +124500X WRITE PRINT-REC. ST1474.2 +124600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +124700 PERFORM FAIL GO TO MRG-FAIL-024 ST1474.2 +124800 ELSE ST1474.2 +124900 PERFORM PASS. ST1474.2 +125000 GO TO MRG-WRITE-024. ST1474.2 +125100 MRG-DELETE-024. ST1474.2 +125200 PERFORM DE-LETE. ST1474.2 +125300 GO TO MRG-WRITE-024. ST1474.2 +125400 MRG-FAIL-024. ST1474.2 +125500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +125600 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +125700 MRG-WRITE-024. ST1474.2 +125800 MOVE "MRG-TEST-024" TO PAR-NAME. ST1474.2 +125900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +126000 PERFORM PRINT-DETAIL. ST1474.2 +126100 MOVE NUM-KEY OF KEY-13 TO LAST-REC-NUM. ST1474.2 +126200 MRG-TEST-025. ST1474.2 +126300 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +126400 GO TO MRG-FAIL-025. ST1474.2 +126500 READ SQ-FS5 END PERFORM PASS ST1474.2 +126600 GO TO MRG-WRITE-025. ST1474.2 +126700 GO TO MRG-FAIL-025. ST1474.2 +126800 MRG-DELETE-025. ST1474.2 +126900 PERFORM DE-LETE. ST1474.2 +127000 GO TO MRG-WRITE-025. ST1474.2 +127100 MRG-FAIL-025. ST1474.2 +127200 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +127300 PERFORM FAIL . ST1474.2 +127400 MRG-WRITE-025. ST1474.2 +127500 MOVE "MRG-TEST-025" TO PAR-NAME. ST1474.2 +127600 MOVE "EOF CHECK SQ-FS5" TO FEATURE. ST1474.2 +127700 PERFORM PRINT-DETAIL. ST1474.2 +127800 MRG-TEST-026. ST1474.2 +127900 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +128000 PERFORM FAIL GO TO MRG-FAIL-026 ST1474.2 +128100 ELSE ST1474.2 +128200 PERFORM PASS. ST1474.2 +128300 GO TO MRG-WRITE-026. ST1474.2 +128400 MRG-DELETE-026. ST1474.2 +128500 PERFORM DE-LETE. ST1474.2 +128600 GO TO MRG-WRITE-026. ST1474.2 +128700 MRG-FAIL-026. ST1474.2 +128800 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +128900 MOVE 1 TO CR-18V0. ST1474.2 +129000 MRG-WRITE-026. ST1474.2 +129100 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +129200 MOVE "MRG-TEST-026" TO PAR-NAME. ST1474.2 +129300 PERFORM PRINT-DETAIL. ST1474.2 +129400 CLOSE SQ-FS5. ST1474.2 +129500 GO TO CLOSE-FILES. ST1474.2 +129600 ST1474.2 +129700 READ-SQ-FS5 SECTION. ST1474.2 +129800 RD-3. ST1474.2 +129900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +130000 GO TO R3-EXIT. ST1474.2 +130100 READ SQ-FS5 AT END GO TO PREMATURE-EOF-3. ST1474.2 +130200X WRITE PRINT-REC FROM SQ-FS5R1-F-G-132. ST1474.2 +130300X WRITE PRINT-REC FROM REST-OF-5. ST1474.2 +130400X MOVE SPACES TO PRINT-REC. ST1474.2 +130500 MOVE ALPHAN-KEY OF KEY-14 TO COMPU (WRK-DU-999-0001). ST1474.2 +130600 GO TO R3-EXIT. ST1474.2 +130700 PREMATURE-EOF-3. ST1474.2 +130800 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +130900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +131000 R3-EXIT. ST1474.2 +131100 EXIT. ST1474.2 +131200* ST1474.2 +131300 CCVS-EXIT SECTION. ST1474.2 +131400 CCVS-999999. ST1474.2 +131500 GO TO CLOSE-FILES. ST1474.2 +*END-OF,ST147A +*HEADER,COBOL,ST301M +000100 IDENTIFICATION DIVISION. ST3014.2 +000200 PROGRAM-ID. ST3014.2 +000300 ST301M. ST3014.2 +000400*The following program tests the flagging of intermediate ST3014.2 +000500*subset features that are used in sort-merge functions ST3014.2 +000600 ENVIRONMENT DIVISION. ST3014.2 +000700 CONFIGURATION SECTION. ST3014.2 +000800 SOURCE-COMPUTER. ST3014.2 +000900 XXXXX082. ST3014.2 +001000 OBJECT-COMPUTER. ST3014.2 +001100 XXXXX083. ST3014.2 +001200 INPUT-OUTPUT SECTION. ST3014.2 +001300 FILE-CONTROL. ST3014.2 +001400 SELECT TFIL ASSIGN ST3014.2 +001500 XXXXX027. ST3014.2 +001600 SELECT TFIL-2 ASSIGN ST3014.2 +001700 XXXXX001 ST3014.2 +001800 ACCESS MODE IS SEQUENTIAL. ST3014.2 +001900 SELECT TFIL-3 ASSIGN ST3014.2 +002000 XXXXX002 ST3014.2 +002100 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002200 SELECT TFIL-4 ASSIGN ST3014.2 +002300 XXXXX003 ST3014.2 +002400 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002500 SELECT TFIL-5 ASSIGN ST3014.2 +002600 XXXXX004 ST3014.2 +002700 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002800 ST3014.2 +002900 I-O-CONTROL. ST3014.2 +003000 SAME SORT-MERGE AREA FOR TFIL-5, TFIL. ST3014.2 +003100*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +003200 DATA DIVISION. ST3014.2 +003300 FILE SECTION. ST3014.2 +003400 SD TFIL. ST3014.2 +003500*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +003600 01 FREC. ST3014.2 +003700 03 DATA-1 PIC X(80). ST3014.2 +003800 ST3014.2 +003900 FD TFIL-2. ST3014.2 +004000 01 FREC-2. ST3014.2 +004100 03 DATA-2 PIC X(80). ST3014.2 +004200 ST3014.2 +004300 FD TFIL-3. ST3014.2 +004400 01 FREC-3. ST3014.2 +004500 03 DATA-3 PIC X(80). ST3014.2 +004600 ST3014.2 +004700 FD TFIL-4. ST3014.2 +004800 01 FREC-4. ST3014.2 +004900 03 DATA-4 PIC X(80). ST3014.2 +005000 ST3014.2 +005100 FD TFIL-5. ST3014.2 +005200 01 FREC-5. ST3014.2 +005300 03 DATA-5 PIC X(80). ST3014.2 +005400 ST3014.2 +005500 PROCEDURE DIVISION. ST3014.2 +005600 ST3014.2 +005700 ST301M-CONTROL. ST3014.2 +005800 PERFORM ST301M-MERGE THRU ST301M-SORT 1 TIMES. ST3014.2 +005900 STOP RUN. ST3014.2 +006000 ST3014.2 +006100 ST301M-MERGE. ST3014.2 +006200 MERGE TFIL ON ASCENDING KEY DATA-1 ST3014.2 +006300 USING TFIL-2 TFIL-3 ST3014.2 +006400 OUTPUT PROCEDURE IS ST301M-RETURN. ST3014.2 +006500 ST3014.2 +006600*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +006700 ST3014.2 +006800 ST301M-RELEASE. ST3014.2 +006900 RELEASE FREC. ST3014.2 +007000*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +007100 ST3014.2 +007200 ST301M-RETURN. ST3014.2 +007300 RETURN TFIL RECORD ST3014.2 +007400 AT END DISPLAY "AT END". ST3014.2 +007500*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +007600 ST3014.2 +007700 ST301M-SORT. ST3014.2 +007800 SORT TFIL ON ASCENDING KEY DATA-1 ST3014.2 +007900 INPUT PROCEDURE IS ST301M-RELEASE ST3014.2 +008000 GIVING TFIL-4. ST3014.2 +008100*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +008200 ST3014.2 +008300 ST3014.2 +008400*TOTAL NUMBER OF FLAGS EXPECTED = 6. ST3014.2 +*END-OF,ST301M + + + + + ST3014.2008400*TOTAL NUMBER OF FLAGS EXPECTED = 6. +*END-OF-POP \ No newline at end of file